diff --git a/.github/actions/tests-module-aerodyn/action.yml b/.github/actions/tests-module-aerodyn/action.yml index 950663ab85..3dd23d6c44 100644 --- a/.github/actions/tests-module-aerodyn/action.yml +++ b/.github/actions/tests-module-aerodyn/action.yml @@ -14,7 +14,7 @@ runs: - run: | if [[ ${{ inputs.test-target }} == "unit" ]] || [[ ${{ inputs.test-target }} == "all" ]]; then - ctest -VV -R fvw_utest + ctest -VV -R aerodyn_utest fi if [[ ${{ inputs.test-target }} == "regression" ]] || [[ ${{ inputs.test-target }} == "all" ]]; then diff --git a/.github/actions/tests-module-hydrodyn/action.yml b/.github/actions/tests-module-hydrodyn/action.yml index eb453ec203..edf61aeff3 100644 --- a/.github/actions/tests-module-hydrodyn/action.yml +++ b/.github/actions/tests-module-hydrodyn/action.yml @@ -4,6 +4,6 @@ author: 'Rafael Mudafort https://github.com/rafmudaf' runs: using: "composite" steps: - - run: ctest -VV -j7 -R hd_ -LE python + - run: ctest -VV -j6 -R hd_ -LE python working-directory: ${{runner.workspace}}/openfast/build shell: bash diff --git a/.github/actions/tests-module-seastate/action.yml b/.github/actions/tests-module-seastate/action.yml new file mode 100644 index 0000000000..c672bda37c --- /dev/null +++ b/.github/actions/tests-module-seastate/action.yml @@ -0,0 +1,9 @@ +name: 'SeaState module tests' +description: 'Run tests specific to the SeaState module' +author: 'Rafael Mudafort https://github.com/rafmudaf' +runs: + using: "composite" + steps: + - run: ctest -VV -j4 -R seastate_ -LE python + working-directory: ${{runner.workspace}}/openfast/build + shell: bash diff --git a/.github/workflows/automated-dev-tests.yml b/.github/workflows/automated-dev-tests.yml index 9028693e2a..723b585dad 100644 --- a/.github/workflows/automated-dev-tests.yml +++ b/.github/workflows/automated-dev-tests.yml @@ -43,7 +43,10 @@ jobs: uses: actions/setup-python@v5 with: python-version: '3.11' - # cache: 'pip' + - name: Set up MATLAB + uses: matlab-actions/setup-matlab@v2 + with: + products: Simulink - name: Install dependencies run: | pip install -r requirements.txt @@ -67,6 +70,7 @@ jobs: -DVARIABLE_TRACKING=OFF \ -DBUILD_TESTING:BOOL=ON \ -DCTEST_PLOT_ERRORS:BOOL=ON \ + -DBUILD_OPENFAST_SIMULINK_API=ON \ ${GITHUB_WORKSPACE} # -DDOUBLE_PRECISION=OFF \ - name: Build all @@ -128,7 +132,6 @@ jobs: uses: actions/setup-python@v5 with: python-version: '3.11' - # cache: 'pip' - name: Install dependencies run: | pip install -r requirements.txt @@ -173,13 +176,16 @@ jobs: uses: actions/setup-python@v5 with: python-version: '3.11' - # cache: 'pip' + - name: Set up MATLAB + uses: matlab-actions/setup-matlab@v2 + with: + products: Simulink - name: Install dependencies run: | pip install -r requirements.txt sudo apt-get update -y sudo apt-get install -y libopenblas-dev libopenblas-openmp-dev - sudo apt-get install -y libhdf5-dev libopenmpi-dev libyaml-cpp-dev # gcovr + sudo apt-get install -y libhdf5-dev libnetcdf-dev libopenmpi-dev libyaml-cpp-dev # gcovr - name: Setup workspace run: cmake -E make_directory ${{runner.workspace}}/openfast/build - name: Configure build @@ -203,6 +209,7 @@ jobs: -DBUILD_SHARED_LIBS:BOOL=OFF \ -DBUILD_TESTING:BOOL=ON \ -DCTEST_PLOT_ERRORS:BOOL=ON \ + -DBUILD_OPENFAST_SIMULINK_API=ON \ ${GITHUB_WORKSPACE} - name: Build openfast-postlib working-directory: ${{runner.workspace}}/openfast/build @@ -227,13 +234,12 @@ jobs: uses: actions/setup-python@v5 with: python-version: '3.11' - # cache: 'pip' - name: Install dependencies run: | pip install -r requirements.txt sudo apt-get update -y sudo apt-get install -y libopenblas-dev libopenblas-openmp-dev - sudo apt-get install -y libhdf5-dev libopenmpi-dev libyaml-cpp-dev + sudo apt-get install -y libhdf5-dev libnetcdf-dev libopenmpi-dev libyaml-cpp-dev - name: Configure build working-directory: ${{runner.workspace}}/openfast/build run: | @@ -264,13 +270,12 @@ jobs: uses: actions/setup-python@v5 with: python-version: '3.11' - # cache: 'pip' - name: Install dependencies run: | pip install -r requirements.txt sudo apt-get update -y sudo apt-get install -y libopenblas-dev libopenblas-openmp-dev - sudo apt-get install -y libhdf5-dev libopenmpi-dev libyaml-cpp-dev + sudo apt-get install -y libhdf5-dev libnetcdf-dev libopenmpi-dev libyaml-cpp-dev - name: Configure build working-directory: ${{runner.workspace}}/openfast/build run: | @@ -301,13 +306,12 @@ jobs: uses: actions/setup-python@v5 with: python-version: '3.11' - # cache: 'pip' - name: Install dependencies run: | pip install -r requirements.txt sudo apt-get update -y sudo apt-get install -y libopenblas-dev libopenblas-openmp-dev - sudo apt-get install -y libhdf5-dev libopenmpi-dev libyaml-cpp-dev + sudo apt-get install -y libhdf5-dev libnetcdf-dev libopenmpi-dev libyaml-cpp-dev - name: Configure build working-directory: ${{runner.workspace}}/openfast/build run: | @@ -329,7 +333,7 @@ jobs: ### BUILD AND TEST JOBS build-test-uadriver-debug: - # UA driver requires -DUA_OUTS, cannot be compiled with other + # UA driver used to require -DUA_OUTS runs-on: ubuntu-22.04 steps: - name: Checkout @@ -340,7 +344,6 @@ jobs: uses: actions/setup-python@v5 with: python-version: '3.11' - # cache: 'pip' - name: Install dependencies run: | pip install -r requirements.txt @@ -363,7 +366,6 @@ jobs: -DVARIABLE_TRACKING=OFF \ -DBUILD_TESTING:BOOL=ON \ -DCTEST_PLOT_ERRORS:BOOL=ON \ - -DCMAKE_Fortran_FLAGS="-DUA_OUTS=ON" \ ${GITHUB_WORKSPACE} - name: Build all working-directory: ${{runner.workspace}}/openfast/build @@ -401,13 +403,12 @@ jobs: uses: actions/setup-python@v5 with: python-version: '3.11' - # cache: 'pip' - name: Install dependencies run: | pip install -r requirements.txt sudo apt-get update -y sudo apt-get install -y libopenblas-dev libopenblas-openmp-dev - sudo apt-get install -y libhdf5-dev libopenmpi-dev libyaml-cpp-dev + sudo apt-get install -y libhdf5-dev libnetcdf-dev libopenmpi-dev libyaml-cpp-dev - name: Configure Tests working-directory: ${{runner.workspace}}/openfast/build run: | @@ -432,6 +433,8 @@ jobs: test-target: regression - name: Run MoorDyn tests uses: ./.github/actions/tests-module-moordyn + - name: Run SeaState tests + uses: ./.github/actions/tests-module-seastate - name: Run SubDyn tests uses: ./.github/actions/tests-module-subdyn - name: Failing test artifacts @@ -456,13 +459,12 @@ jobs: uses: actions/setup-python@v5 with: python-version: '3.11' - # cache: 'pip' - name: Install dependencies run: | pip install -r requirements.txt sudo apt-get update -y sudo apt-get install -y libopenblas-dev libopenblas-openmp-dev - sudo apt-get install -y libhdf5-dev libopenmpi-dev libyaml-cpp-dev + sudo apt-get install -y libhdf5-dev libnetcdf-dev libopenmpi-dev libyaml-cpp-dev - name: Configure Tests working-directory: ${{runner.workspace}}/openfast/build run: | @@ -487,6 +489,8 @@ jobs: uses: ./.github/actions/tests-module-moordyn - name: Run NWTC Library tests uses: ./.github/actions/tests-module-nwtclibrary + - name: Run SeaState tests + uses: ./.github/actions/tests-module-seastate - name: Run SubDyn tests uses: ./.github/actions/tests-module-subdyn - name: Run VersionInfo tests @@ -514,13 +518,12 @@ jobs: uses: actions/setup-python@v5 with: python-version: '3.11' - # cache: 'pip' - name: Install dependencies run: | pip install -r requirements.txt sudo apt-get update -y sudo apt-get install -y libopenblas-dev libopenblas-openmp-dev - sudo apt-get install -y libhdf5-dev libopenmpi-dev libyaml-cpp-dev + sudo apt-get install -y libhdf5-dev libnetcdf-dev libopenmpi-dev libyaml-cpp-dev - name: Configure Tests working-directory: ${{runner.workspace}}/openfast/build run: | @@ -532,7 +535,8 @@ jobs: - name: Run Interface / API tests working-directory: ${{runner.workspace}}/openfast/build run: | - ctest -VV -L "cpp|python|fastlib" + ctest -VV -L "cpp|python|fastlib" \ + -LE "openfast_io" - name: Failing test artifacts uses: actions/upload-artifact@v4 if: failure() @@ -561,13 +565,12 @@ jobs: uses: actions/setup-python@v5 with: python-version: '3.11' - # cache: 'pip' - name: Install dependencies run: | pip install -r requirements.txt sudo apt-get update -y sudo apt-get install -y libopenblas-dev libopenblas-openmp-dev - sudo apt-get install -y libhdf5-dev libopenmpi-dev libyaml-cpp-dev + sudo apt-get install -y libhdf5-dev libnetcdf-dev libopenmpi-dev libyaml-cpp-dev - name: Configure Tests working-directory: ${{runner.workspace}}/openfast/build run: | @@ -580,9 +583,9 @@ jobs: - name: Run 5MW tests working-directory: ${{runner.workspace}}/openfast/build run: | - ctest -VV \ + ctest -VV -j4 \ -L openfast \ - -LE "cpp|linear|python|fastlib" \ + -LE "cpp|linear|python|fastlib|aeromap" \ -E "5MW_OC4Semi_WSt_WavesWN|5MW_OC3Mnpl_DLL_WTurb_WavesIrr|5MW_OC4Jckt_DLL_WTurb_WavesIrr_MGrowth|5MW_OC3Trpd_DLL_WSt_WavesReg|5MW_Land_BD_DLL_WTurb" - name: Failing test artifacts uses: actions/upload-artifact@v4 @@ -599,8 +602,7 @@ jobs: !${{runner.workspace}}/openfast/build/reg_tests/glue-codes/openfast/UAE_VI !${{runner.workspace}}/openfast/build/reg_tests/glue-codes/openfast/WP_Baseline - - rtest-OF-5MW_OC4Semi_WSt_WavesWN: + rtest-openfast_io: runs-on: ubuntu-22.04 needs: build-openfast-release steps: @@ -613,13 +615,138 @@ jobs: uses: actions/setup-python@v5 with: python-version: '3.11' - # cache: 'pip' - name: Install dependencies run: | pip install -r requirements.txt sudo apt-get update -y sudo apt-get install -y libopenblas-dev libopenblas-openmp-dev + sudo apt-get install -y libhdf5-dev libnetcdf-dev libopenmpi-dev libyaml-cpp-dev + - name: Install openfast_io + working-directory: ${{runner.workspace}}/openfast/openfast_io + run: | + pip install -e . + - name: Configure Tests + working-directory: ${{runner.workspace}}/openfast/build + run: | + cmake \ + -DPython_ROOT_DIR:STRING=${{env.pythonLocation}} \ + -DBUILD_TESTING:BOOL=ON \ + -DCTEST_PLOT_ERRORS:BOOL=ON \ + ${GITHUB_WORKSPACE} + cmake --build . --target regression_test_controllers + - name: Run openfast_io tests + working-directory: ${{runner.workspace}}/openfast/build + run: | + ctest -VV -j4 \ + -L openfast_io + - name: Failing test artifacts + uses: actions/upload-artifact@v4 + if: failure() + with: + name: rtest-openfast_io + path: | + ${{runner.workspace}}/openfast/build/reg_tests/openfast_io + + + rtest-OF-simulink: + runs-on: ubuntu-22.04 + needs: build-openfast-release + steps: + - name: Cache the workspace + uses: actions/cache@v4 + with: + path: ${{runner.workspace}} + key: build-openfast-release-${{ github.sha }} + - name: Install dependencies + run: | + sudo apt-get update -y + sudo apt-get install -y libhdf5-dev libopenmpi-dev libyaml-cpp-dev libopenblas-dev libopenblas-openmp-dev + - name: Set up MATLAB + uses: matlab-actions/setup-matlab@v2 + with: + products: Simulink + - name: Build FAST_SFunc + working-directory: ${{runner.workspace}}/openfast/build + run: | + cmake \ + -DUSE_LOCAL_STATIC_LAPACK:BOOL=ON \ + ${GITHUB_WORKSPACE} + cmake --build . --target FAST_SFunc + - name: Run MATLAB tests and generate artifacts + uses: matlab-actions/run-tests@v2 + with: + source-folder: ${{runner.workspace}}/openfast/build/glue-codes/simulink; ${{runner.workspace}}/openfast/glue-codes/simulink/examples + test-results-junit: test-results/results.xml + code-coverage-cobertura: code-coverage/coverage.xml + + + rtest-OF-5MW_Land_AeroMap: + runs-on: ubuntu-22.04 + needs: build-openfast-release + steps: + - name: Cache the workspace + uses: actions/cache@v4 + with: + path: ${{runner.workspace}} + key: build-openfast-release-${{ github.sha }} + - name: Setup Python + uses: actions/setup-python@v5 + with: + python-version: '3.11' + - name: Install dependencies + run: | + python -m pip install --upgrade pip + pip install numpy "Bokeh>=2.4,!=3.0.0,!=3.0.1,!=3.0.2,!=3.0.3" + sudo apt-get update -y + sudo apt-get install -y libopenblas-dev libopenblas-openmp-dev sudo apt-get install -y libhdf5-dev libopenmpi-dev libyaml-cpp-dev + - name: Configure Tests + working-directory: ${{runner.workspace}}/openfast/build + run: | + cmake \ + -DPython_ROOT_DIR:STRING=${{env.pythonLocation}} \ + -DBUILD_TESTING:BOOL=ON \ + -DCTEST_PLOT_ERRORS:BOOL=ON \ + ${GITHUB_WORKSPACE} + - name: Run 5MW aero map tests + working-directory: ${{runner.workspace}}/openfast/build + run: | + ctest -VV -L aeromap -LE "cpp|linear|python" -R 5MW_Land_AeroMap + - name: Failing test artifacts + uses: actions/upload-artifact@v4 + if: failure() + with: + name: rtest-OF-5MW_Land_AeroMap + path: | + ${{runner.workspace}}/openfast/build/reg_tests/modules + ${{runner.workspace}}/openfast/build/reg_tests/glue-codes/openfast + !${{runner.workspace}}/openfast/build/reg_tests/glue-codes/openfast/5MW_Baseline + !${{runner.workspace}}/openfast/build/reg_tests/glue-codes/openfast/AOC + !${{runner.workspace}}/openfast/build/reg_tests/glue-codes/openfast/AWT27 + !${{runner.workspace}}/openfast/build/reg_tests/glue-codes/openfast/SWRT + !${{runner.workspace}}/openfast/build/reg_tests/glue-codes/openfast/UAE_VI + !${{runner.workspace}}/openfast/build/reg_tests/glue-codes/openfast/WP_Baseline + + + rtest-OF-5MW_OC4Semi_WSt_WavesWN: + runs-on: ubuntu-22.04 + needs: build-openfast-release + steps: + - name: Cache the workspace + uses: actions/cache@v4 + with: + path: ${{runner.workspace}} + key: build-openfast-release-${{ github.sha }} + - name: Setup Python + uses: actions/setup-python@v5 + with: + python-version: '3.10' + - name: Install dependencies + run: | + pip install -r requirements.txt + sudo apt-get update -y + sudo apt-get install -y libopenblas-dev libopenblas-openmp-dev + sudo apt-get install -y libhdf5-dev libnetcdf-dev libopenmpi-dev libyaml-cpp-dev - name: Configure Tests working-directory: ${{runner.workspace}}/openfast/build run: | @@ -662,13 +789,12 @@ jobs: uses: actions/setup-python@v5 with: python-version: '3.11' - # cache: 'pip' - name: Install dependencies run: | pip install -r requirements.txt sudo apt-get update -y sudo apt-get install -y libopenblas-dev libopenblas-openmp-dev - sudo apt-get install -y libhdf5-dev libopenmpi-dev libyaml-cpp-dev + sudo apt-get install -y libhdf5-dev libnetcdf-dev libopenmpi-dev libyaml-cpp-dev - name: Configure Tests working-directory: ${{runner.workspace}}/openfast/build run: | @@ -681,7 +807,7 @@ jobs: - name: Run 5MW tests working-directory: ${{runner.workspace}}/openfast/build run: | - ctest -VV -L openfast -LE "cpp|linear|python" -R 5MW_OC3Mnpl_DLL_WTurb_WavesIrr + ctest -VV -L openfast -LE "cpp|linear|python" -R 5MW_OC3Mnpl_DLL_WTurb_WavesIrr -j1 - name: Failing test artifacts uses: actions/upload-artifact@v4 if: failure() @@ -711,13 +837,12 @@ jobs: uses: actions/setup-python@v5 with: python-version: '3.11' - # cache: 'pip' - name: Install dependencies run: | pip install -r requirements.txt sudo apt-get update -y sudo apt-get install -y libopenblas-dev libopenblas-openmp-dev - sudo apt-get install -y libhdf5-dev libopenmpi-dev libyaml-cpp-dev + sudo apt-get install -y libhdf5-dev libnetcdf-dev libopenmpi-dev libyaml-cpp-dev - name: Configure Tests working-directory: ${{runner.workspace}}/openfast/build run: | @@ -760,13 +885,12 @@ jobs: uses: actions/setup-python@v5 with: python-version: '3.11' - # cache: 'pip' - name: Install dependencies run: | pip install -r requirements.txt sudo apt-get update -y sudo apt-get install -y libopenblas-dev libopenblas-openmp-dev - sudo apt-get install -y libhdf5-dev libopenmpi-dev libyaml-cpp-dev + sudo apt-get install -y libhdf5-dev libnetcdf-dev libopenmpi-dev libyaml-cpp-dev - name: Configure Tests working-directory: ${{runner.workspace}}/openfast/build run: | @@ -809,13 +933,12 @@ jobs: uses: actions/setup-python@v5 with: python-version: '3.11' - # cache: 'pip' - name: Install dependencies run: | pip install -r requirements.txt sudo apt-get update -y sudo apt-get install -y libopenblas-dev libopenblas-openmp-dev - sudo apt-get install -y libhdf5-dev libopenmpi-dev libyaml-cpp-dev + sudo apt-get install -y libhdf5-dev libnetcdf-dev libopenmpi-dev libyaml-cpp-dev - name: Configure Tests working-directory: ${{runner.workspace}}/openfast/build run: | @@ -858,13 +981,12 @@ jobs: uses: actions/setup-python@v5 with: python-version: '3.11' - # cache: 'pip' - name: Install dependencies run: | pip install -r requirements.txt sudo apt-get update -y sudo apt-get install -y libopenblas-dev libopenblas-openmp-dev - sudo apt-get install -y libhdf5-dev libopenmpi-dev libyaml-cpp-dev + sudo apt-get install -y libhdf5-dev libnetcdf-dev libopenmpi-dev libyaml-cpp-dev - name: Configure Tests working-directory: ${{runner.workspace}}/openfast/build run: | @@ -873,7 +995,6 @@ jobs: -DBUILD_TESTING:BOOL=ON \ -DCTEST_PLOT_ERRORS:BOOL=ON \ ${GITHUB_WORKSPACE} - cmake --build . --target regression_test_controllers - name: Run OpenFAST linearization tests working-directory: ${{runner.workspace}}/openfast/build run: | @@ -907,13 +1028,12 @@ jobs: uses: actions/setup-python@v5 with: python-version: '3.11' - # cache: 'pip' - name: Install dependencies run: | pip install -r requirements.txt sudo apt-get update -y sudo apt-get install -y libopenblas-dev libopenblas-openmp-dev - sudo apt-get install -y libhdf5-dev libopenmpi-dev libyaml-cpp-dev + sudo apt-get install -y libhdf5-dev libnetcdf-dev libopenmpi-dev libyaml-cpp-dev - name: Configure Tests working-directory: ${{runner.workspace}}/openfast/build run: | diff --git a/.github/workflows/deploy.yml b/.github/workflows/deploy.yml index f28aee59ce..87240dbce4 100644 --- a/.github/workflows/deploy.yml +++ b/.github/workflows/deploy.yml @@ -6,38 +6,75 @@ name: deploy on: workflow_dispatch: - + release: types: - released + jobs: - publish-to-pypi: + publish-to-pypi-test: runs-on: ubuntu-latest - permissions: - id-token: write - contents: read - + if: github.event_name == 'workflow_dispatch' steps: - - name: Checkout Repository - uses: actions/checkout@v4 + - uses: actions/checkout@v3 + + - name: Set up Python + uses: actions/setup-python@v4 + with: + python-version: '3.12' + cache: 'pip' - - name: Install Poetry - uses: snok/install-poetry@v1.3.4 + - name: Install Hatch + uses: pypa/hatch@install - - name: Build a binary wheel and a source tarball - run: poetry build - working-directory: openfast_python + - name: Install dependencies + run: pip install keyring[file] - - name: Publish package distributions to PyPI - uses: pypa/gh-action-pypi-publish@v1.8.14 + - name: Build package + run: hatch build + working-directory: openfast_io + + - name: Publish to PyPI test + env: + HATCH_INDEX_USER: __token__ + HATCH_INDEX_AUTH: ${{ secrets.PYPI_TEST_TOKEN }} + run: hatch publish -r test + working-directory: openfast_io + + publish-to-pypi: + runs-on: ubuntu-latest + if: github.event_name == 'release' + steps: + - uses: actions/checkout@v3 + + - name: Set up Python + uses: actions/setup-python@v4 with: - packages-dir: openfast_python/dist + python-version: '3.12' + cache: 'pip' + + - name: Install Hatch + uses: pypa/hatch@install + + - name: Install dependencies + run: pip install keyring[file] + + - name: Build package + run: hatch build + working-directory: openfast_io + - name: Publish to PyPI + env: + HATCH_INDEX_USER: __token__ + HATCH_INDEX_AUTH: ${{ secrets.PYPI_TOKEN }} + run: hatch publish + working-directory: openfast_io docker-build-and-push: runs-on: ubuntu-latest - timeout-minutes: 300 + if: github.event_name == 'release' + timeout-minutes: 500 env: DOCKERFILE_PATH: share/docker/Dockerfile DOCKERHUB_REPOSITORY: nrel/openfast diff --git a/.gitignore b/.gitignore index 11d116ec76..dd46aacb99 100644 --- a/.gitignore +++ b/.gitignore @@ -48,6 +48,7 @@ vs-build/ # backup files *.asv ~$*.xlsx +.*.swp # LaTeX compiling files *.aux @@ -57,3 +58,7 @@ vs-build/ #Simulink cache files varcache *.slxc + +# Python cache files +openfast_io/dist/ +openfast_io/openfast_io/_version.py \ No newline at end of file diff --git a/.gitmodules b/.gitmodules index 9650d9f067..e051a463bd 100644 --- a/.gitmodules +++ b/.gitmodules @@ -1,6 +1,3 @@ [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 + url = https://github.com/OpenFAST/r-test.git \ No newline at end of file diff --git a/CMakeLists.txt b/CMakeLists.txt index 0bd22f12a9..04a042661f 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -111,13 +111,8 @@ include(${CMAKE_SOURCE_DIR}/cmake/set_rpath.cmake) # OpenMP #------------------------------------------------------------------------------- -if (OPENMP OR BUILD_FASTFARM OR BUILD_OPENFAST_CPP_API) - if (OPENMP) - FIND_PACKAGE(OpenMP REQUIRED) - else() - # Optional for FF or the CPP interface - FIND_PACKAGE(OpenMP) - endif() +if (OPENMP) + FIND_PACKAGE(OpenMP REQUIRED) if (OpenMP_Fortran_FOUND) set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} ${OpenMP_Fortran_FLAGS}") link_libraries("${OpenMP_Fortran_LIBRARIES}") @@ -193,12 +188,14 @@ set(OPENFAST_MODULES nwtc-library version inflowwind + extloads aerodyn - aerodyn14 + aerodisk servodyn elastodyn beamdyn subdyn + seastate hydrodyn orcaflex-interface extptfm @@ -208,11 +205,13 @@ set(OPENFAST_MODULES icefloe wakedynamics awae + lindyn map turbsim supercontroller - openfoam + externalinflow openfast-library + simple-elastodyn ) set(OPENFAST_REGISTRY_INCLUDES "" CACHE INTERNAL "Registry includes paths") diff --git a/cmake/FindNetCDF.cmake b/cmake/FindNetCDF.cmake new file mode 100644 index 0000000000..f3d64cdeff --- /dev/null +++ b/cmake/FindNetCDF.cmake @@ -0,0 +1,124 @@ +# +# This file was copied from the VTK repository: +# https://github.com/Kitware/VTK/blob/master/CMake/FindNetCDF.cmake +# VTK is distributed under the OSI-approved BSD 3-clause License. +# +# +# - Find NetCDF +# Find the native NetCDF includes and library +# +# NETCDF_INCLUDE_DIR - user modifiable choice of where netcdf headers are +# NETCDF_LIBRARY - user modifiable choice of where netcdf libraries are +# +# Your package can require certain interfaces to be FOUND by setting these +# +# NETCDF_CXX - require the C++ interface and link the C++ library +# NETCDF_F77 - require the F77 interface and link the fortran library +# NETCDF_F90 - require the F90 interface and link the fortran library +# +# Or equivalently by calling FindNetCDF with a COMPONENTS argument containing one or +# more of "CXX;F77;F90". +# +# When interfaces are requested the user has access to interface specific hints: +# +# NETCDF_${LANG}_INCLUDE_DIR - where to search for interface header files +# NETCDF_${LANG}_LIBRARY - where to search for interface libraries +# +# This module returns these variables for the rest of the project to use. +# +# NETCDF_FOUND - True if NetCDF found including required interfaces (see below) +# NETCDF_LIBRARIES - All netcdf related libraries. +# NETCDF_INCLUDE_DIRS - All directories to include. +# NETCDF_HAS_INTERFACES - Whether requested interfaces were found or not. +# NETCDF_${LANG}_INCLUDE_DIRS/NETCDF_${LANG}_LIBRARIES - C/C++/F70/F90 only interface +# +# Normal usage would be: +# set (NETCDF_F90 "YES") +# find_package (NetCDF REQUIRED) +# target_link_libraries (uses_everthing ${NETCDF_LIBRARIES}) +# target_link_libraries (only_uses_f90 ${NETCDF_F90_LIBRARIES}) + +#search starting from user editable cache var +if (NETCDF_INCLUDE_DIR AND NETCDF_LIBRARY) + # Already in cache, be silent + set (NETCDF_FIND_QUIETLY TRUE) +endif () + +set(USE_DEFAULT_PATHS "NO_DEFAULT_PATH") +if(NETCDF_USE_DEFAULT_PATHS) + set(USE_DEFAULT_PATHS "") +endif() + +find_path (NETCDF_INCLUDE_DIR netcdf.h + HINTS "${NETCDF_DIR}/include") +mark_as_advanced (NETCDF_INCLUDE_DIR) +set (NETCDF_C_INCLUDE_DIRS ${NETCDF_INCLUDE_DIR}) + +find_library (NETCDF_LIBRARY NAMES netcdf + HINTS "${NETCDF_DIR}/lib") +mark_as_advanced (NETCDF_LIBRARY) + +set (NETCDF_C_LIBRARIES ${NETCDF_LIBRARY}) + +#start finding requested language components +set (NetCDF_libs "") +set (NetCDF_includes "${NETCDF_INCLUDE_DIR}") + +get_filename_component (NetCDF_lib_dirs "${NETCDF_LIBRARY}" PATH) +set (NETCDF_HAS_INTERFACES "YES") # will be set to NO if we're missing any interfaces + +macro (NetCDF_check_interface lang header libs) + if (NETCDF_${lang}) + #search starting from user modifiable cache var + find_path (NETCDF_${lang}_INCLUDE_DIR NAMES ${header} + HINTS "${NETCDF_INCLUDE_DIR}" + HINTS "${NETCDF_${lang}_ROOT}/include" + ${USE_DEFAULT_PATHS}) + + find_library (NETCDF_${lang}_LIBRARY NAMES ${libs} + HINTS "${NetCDF_lib_dirs}" + HINTS "${NETCDF_${lang}_ROOT}/lib" + ${USE_DEFAULT_PATHS}) + + mark_as_advanced (NETCDF_${lang}_INCLUDE_DIR NETCDF_${lang}_LIBRARY) + + #export to internal varS that rest of project can use directly + set (NETCDF_${lang}_LIBRARIES ${NETCDF_${lang}_LIBRARY}) + set (NETCDF_${lang}_INCLUDE_DIRS ${NETCDF_${lang}_INCLUDE_DIR}) + + if (NETCDF_${lang}_INCLUDE_DIR AND NETCDF_${lang}_LIBRARY) + list (APPEND NetCDF_libs ${NETCDF_${lang}_LIBRARY}) + list (APPEND NetCDF_includes ${NETCDF_${lang}_INCLUDE_DIR}) + else () + set (NETCDF_HAS_INTERFACES "NO") + message (STATUS "Failed to find NetCDF interface for ${lang}") + endif () + endif () +endmacro () + +list (FIND NetCDF_FIND_COMPONENTS "CXX" _nextcomp) +if (_nextcomp GREATER -1) + set (NETCDF_CXX 1) +endif () +list (FIND NetCDF_FIND_COMPONENTS "F77" _nextcomp) +if (_nextcomp GREATER -1) + set (NETCDF_F77 1) +endif () +list (FIND NetCDF_FIND_COMPONENTS "F90" _nextcomp) +if (_nextcomp GREATER -1) + set (NETCDF_F90 1) +endif () +NetCDF_check_interface (CXX netcdfcpp.h netcdf_c++) +NetCDF_check_interface (F77 netcdf.inc netcdff) +NetCDF_check_interface (F90 netcdf.mod netcdff) + +#export accumulated results to internal varS that rest of project can depend on +list (APPEND NetCDF_libs "${NETCDF_C_LIBRARIES}") +set (NETCDF_LIBRARIES ${NetCDF_libs}) +set (NETCDF_INCLUDE_DIRS ${NetCDF_includes}) + +# handle the QUIETLY and REQUIRED arguments and set NETCDF_FOUND to TRUE if +# all listed variables are TRUE +include (FindPackageHandleStandardArgs) +find_package_handle_standard_args (NetCDF + DEFAULT_MSG NETCDF_LIBRARIES NETCDF_INCLUDE_DIRS NETCDF_HAS_INTERFACES) diff --git a/cmake/OpenfastFortranOptions.cmake b/cmake/OpenfastFortranOptions.cmake index eba55e8dff..127e1d8783 100644 --- a/cmake/OpenfastFortranOptions.cmake +++ b/cmake/OpenfastFortranOptions.cmake @@ -109,9 +109,9 @@ endmacro(check_f2008_features) # macro(set_fast_gfortran) if(NOT WIN32) - set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -fpic ") - set(CMAKE_CXX_FLAGS "${CMAKE_CXX_FLAGS} -fpic") - set(CMAKE_C_FLAGS "${CMAKE_C_FLAGS} -fpic") + set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -fPIC ") + set(CMAKE_CXX_FLAGS "${CMAKE_CXX_FLAGS} -fPIC") + set(CMAKE_C_FLAGS "${CMAKE_C_FLAGS} -fPIC") endif(NOT WIN32) # Fix free-form compilation for OpenFAST diff --git a/docs/OtherSupporting/AeroDisk/AeroDisk_Plan_Rev2.doc b/docs/OtherSupporting/AeroDisk/AeroDisk_Plan_Rev2.doc new file mode 100644 index 0000000000..4c0cb580b8 Binary files /dev/null and b/docs/OtherSupporting/AeroDisk/AeroDisk_Plan_Rev2.doc differ diff --git a/docs/OtherSupporting/HydroDyn/HydroDyn_MacCamy-Fuchs.docx b/docs/OtherSupporting/HydroDyn/HydroDyn_MacCamy-Fuchs.docx new file mode 100644 index 0000000000..5a2f466c95 Binary files /dev/null and b/docs/OtherSupporting/HydroDyn/HydroDyn_MacCamy-Fuchs.docx differ diff --git a/docs/OtherSupporting/HydroDyn/HydroDyn_WaveStretching_Plan.docx b/docs/OtherSupporting/HydroDyn/HydroDyn_WaveStretching_Plan.docx index 9537a3f256..2b1c21814d 100644 Binary files a/docs/OtherSupporting/HydroDyn/HydroDyn_WaveStretching_Plan.docx and b/docs/OtherSupporting/HydroDyn/HydroDyn_WaveStretching_Plan.docx differ diff --git a/docs/OtherSupporting/OpenFAST_Algorithms/OpenFAST_Algorithms.pdf b/docs/OtherSupporting/OpenFAST_Algorithms/OpenFAST_Algorithms.pdf index 824ea4ca70..12e890f937 100644 Binary files a/docs/OtherSupporting/OpenFAST_Algorithms/OpenFAST_Algorithms.pdf and b/docs/OtherSupporting/OpenFAST_Algorithms/OpenFAST_Algorithms.pdf differ diff --git a/docs/OtherSupporting/OpenFAST_Algorithms/OpenFAST_Algorithms.tex b/docs/OtherSupporting/OpenFAST_Algorithms/OpenFAST_Algorithms.tex index 8defae0560..c6817cef8d 100644 --- a/docs/OtherSupporting/OpenFAST_Algorithms/OpenFAST_Algorithms.tex +++ b/docs/OtherSupporting/OpenFAST_Algorithms/OpenFAST_Algorithms.tex @@ -41,7 +41,6 @@ \section{Definitions and Nomenclature} \hline ElastoDyn & ED & ED \\ BeamDyn & BD & BD \\ - AeroDyn14 & AD14 & AD14 \\ AeroDyn & AD & AD \\ ServoDyn & SrvD & SrvD \\ SubDyn & SD & SD \\ diff --git a/docs/OtherSupporting/OutListParameters.xlsx b/docs/OtherSupporting/OutListParameters.xlsx index ff41b567f5..8d622a50d7 100644 Binary files a/docs/OtherSupporting/OutListParameters.xlsx and b/docs/OtherSupporting/OutListParameters.xlsx differ diff --git a/docs/OtherSupporting/SeaState/SeaState_Constrained_NewWave.docx b/docs/OtherSupporting/SeaState/SeaState_Constrained_NewWave.docx new file mode 100644 index 0000000000..a2081c6551 Binary files /dev/null and b/docs/OtherSupporting/SeaState/SeaState_Constrained_NewWave.docx differ diff --git a/docs/OtherSupporting/SeaState/SeaState_WaveMod7.docx b/docs/OtherSupporting/SeaState/SeaState_WaveMod7.docx new file mode 100644 index 0000000000..a8121f67f9 Binary files /dev/null and b/docs/OtherSupporting/SeaState/SeaState_WaveMod7.docx differ diff --git a/docs/OtherSupporting/TurbSim/Corrections.md b/docs/OtherSupporting/TurbSim/Corrections.md new file mode 100644 index 0000000000..8e735b0800 --- /dev/null +++ b/docs/OtherSupporting/TurbSim/Corrections.md @@ -0,0 +1,5 @@ +# Corrections to TurbSim_v2.00.pdf DRAFT + +## p. 34: Input file for User-Defined Profiles +The User-Defined profiles listed in the "Profiles" section contain horizontal angles, not wind direction, so it should say + `3. Horizontal wind angle (degrees, measured counter-clockwise from above)` \ No newline at end of file diff --git a/docs/changelogs/v2.4.0.md b/docs/changelogs/v2.4.0.md new file mode 100644 index 0000000000..a273a8c3af --- /dev/null +++ b/docs/changelogs/v2.4.0.md @@ -0,0 +1,38 @@ +### General +- #428 Improve CLI for OpenFAST (`openfast -v` and `openfast -h`) +- #350 Add offshore linearization capability +- #488 Improve Line2-to-Line2 or Line2-to-Point mapping +- #508 Support RANLUX as an optional pRNG +- #373 Support for channel names up to 20 characters +- #373 Allow mode shape visualization - [docs](https://github.com/OpenFAST/matlab-toolbox#mode-shapes-visualization) +- #373 Find a periodic steady-state trim solution where linearization will be performed +- Update documentation +- Bug fixes + +### AeroDyn +- #477 Add free vortex wake module - [docs](https://openfast.readthedocs.io/en/master/source/user/aerodyn-olaf/index.html) +- #515 Add aeroacoustics module - [docs](https://openfast.readthedocs.io/en/master/source/user/aerodyn-aeroacoustics/index.html) +- #373 Allow channel outputs at every blade node - [docs](https://openfast.readthedocs.io/en/master/source/user/aerodyn/input.html#ad-nodal-outputs) + +### BeamDyn +- #373 Allow channel outputs at every blade node - [docs](https://openfast.readthedocs.io/en/master/source/user/beamdyn/input_files.html#bd-nodal-outputs) + +### ElastoDyn +- #453 Bug fix: the rotational speed was doubled in the rotational velocity field of the blade output mesh +- #461 Add output channel for translational displacements of tower top at yaw bearing relative to the reference position +- #373 Allow channel outputs at every blade node - [docs](https://openfast.readthedocs.io/en/master/source/user/elastodyn/input.html#ed-nodal-outputs) + +### ExtPtfm +- #344 Use Craig-Bampton reduction of support structures for sequential load calculations + +### InflowWind +- #437 Add new HAWC wind profile input type for reading wind conditions without mean wind speed +- #437 Allow to shift the HAWC wind upstream or downstream + +### ServoDyn +- #456 Properly support yaw rate command integration from controller +- #460 Fix an issue in updating the states when a yaw maneuver is beginning + +### r-test +- #456 Update 5MW BeamDyn blade damping models + diff --git a/docs/changelogs/v2.5.0.md b/docs/changelogs/v2.5.0.md new file mode 100644 index 0000000000..0661a1b90b --- /dev/null +++ b/docs/changelogs/v2.5.0.md @@ -0,0 +1,57 @@ +### General +In v2.5.0, the `master` branch will become `main` and this will serve as the "trunk" or primary branch for OpenFAST. This is in line with current best practices in naming conventions (see [here](https://github.com/github/renaming)). + +### AeroDyn +- #538 Update AeroDyn to allow for linearized dynamic stall and dynamic inflow models +- #538 Disable BEM if TSR <= 1, blend BEM and non-BEM when 1 < TSR < 2, output the proportion of BEM in GeomPhi output channel +- #590 [BugFix] VTK folder location, Vx sign for OLAF +- #594 [BugFix] Close a file that was opened but not closed +- #623 [BugFix] Allocate array to size 0 before getting its size +- #627 [BugFix] Fix logic for setting size of arrays for airfoil tables + +### BeamDyn +- #560 Expand and improve BeamDyn unit tests +- #564 Documentation updates: Add BD OpenFAST solve section +- #576 Replace cubic spline with least squares fit +- #619 [BugFix] Regenerate Types files after registry file changes + +### FAST Library +- #550 Make channel length consistent between C and Fortran sides of interface +- #616 Fix potential memory leak and expand error handling + +### HydroDyn +- #582 Use RANLUX pRNG in offshore floating regression test cases +- #586 Hd Driver - Add Morrison mesh and standalone driver test cases +- #602 Vectorize a section of VariousWaves_Init (also #606) + +### InflowWind +- #578 InflowWind Updates (vertical flow angle, Bladed support, negetive height) +- #596 Add support for initializing InflowWind with string inputs + +### MoorDyn +- #565 Add active tensioning capabilities in MoorDyn +- #604 [BugFix] Fix position and tension node outputs +- #619 [BugFix] Regenerate Types files after registry file changes + +### NWTC Library +- #588 Add NWTC Library infrastructure for parsing inputs as strings +- #603 [BugFix] Fix order of variables declaration + +### Simulink +- #545 Support for GNU compiler on Linux systems +- #577 Updated examples for OpenFAST-Simulink Interface +- #616 Fix potential memory leak and add more error handling + +### Documentation +- #558 Refer to conda for installation ([docs](https://openfast.readthedocs.io/en/dev/source/install/index.html#download-binaries)) +- #559 Update unit test guidance ([docs](https://openfast.readthedocs.io/en/dev/source/testing/unit_test.html)) +- #614 [BugFix] Fix api_change.rst ([docs](https://openfast.readthedocs.io/en/dev/source/user/api_change.html)) + +### Build system +- #547 [BugFix] cmake configuration for Linux + Intel + Debug +- #583 CMake: set CMP0074 policy explicitly to avoid warnings +- #595 Disable gfortran stack-reuse compiler option +- #610 Prevent variable tracking in large Fortran modules + +### Testing +- #579 #599 #610 Improve GH Actions diff --git a/docs/changelogs/v2.6.0.md b/docs/changelogs/v2.6.0.md new file mode 100644 index 0000000000..9eedaeb57d --- /dev/null +++ b/docs/changelogs/v2.6.0.md @@ -0,0 +1,30 @@ +This release includes the following major enhancements: +- Support for flexible floating platforms and expansion of linearization capability (#537) + +### AeroDyn +#645 Add Eames tower shadow model to AD15 +#643 Support primary input file parsing through strings + +### BeamDyn +#615 [BugFix] Initialized error variables +#636 Add unit tests for BD_ComputeIniNodalCrv + +### HydroDyn +#537 Flexible floating platforms +#615 Morison performance improvement +#634 Fix HydroDyn linearization matrix multiplication using unallocated arrays + +### InflowWind +#642 [BugFix] Reenable InflowWind echo file lost in #596 + +### NWTC Library +#615 NWTC Lib bug fixes + +### Simulink Interface +#641 [BugFix] Simulink error message overwrite + +### Testing +#637 Use default runner and GFortran 10 +#635 Use Intel 2021 Toolset for regression test + + diff --git a/docs/changelogs/v3.0.0.md b/docs/changelogs/v3.0.0.md new file mode 100644 index 0000000000..de79528b87 --- /dev/null +++ b/docs/changelogs/v3.0.0.md @@ -0,0 +1,67 @@ +This release includes the following major enhancements: +- FAST.Farm (#584) +- ServoDyn structural control submodule (#607) + +### AeroDyn +#597 AD/AA: Add new TE definition, improve airfoil thickness calculation, simplify input +#647 Add ability to turn unsteady aero back on during a simulation +#648 OLAF improvements for WEIS +#672 Preliminary support for multiple rotors in AeroDyn +#728 AllBldOuts more forgiving and support for 0 + +### BeamDyn +#677 BD Driver bug fix and expand BeamDyn unit testing + +### ElastoDyn +#589 Allow one-blade turbine model +#653 Add YawBrTV[xyz]p output channels +#736 AllBldOuts more forgiving and support for 0 + +### FAST.Farm +#584 Incorporate FAST.Farm to OpenFAST +#726 Build FAST.Farm when configured via BUILD_FASTFARM +#749 Add Missing Attribute for sc_end in the FAST.Farm Super Controller + +### HydroDyn +#687 [BugFix] incorrect pitch/roll moments on tapered elements crossing water line +#713 [BugFix] Uninitialized variables in HydroDyn::Morisson calculations + +### NWTC Library +#668 [BugFix] Sys files for MATLAB +#683 Big fix in NWTC Library unit tests + +### OpenFAST Library +#744 Avoid gfortran 11 error in FAST_Solver.f90 + +### ServoDyn +#607 ServoDyn Structural control submodule (formerly TMD) +#690 [BugFix] Rename Structural Control driver program +#739 [BugFix] Logic error in glue code for StC loads on SD with no HD + +### Documentation +#678 Add documentation on input file parsing +#682 Update installation instructions +#696 Update the api_change for MoorDyn after PR #565 + +### C++ Inteface +#703 [BugFix] unallocated AD%y%Rotors when AD14 is used with cpp interface +#709 Remove unused import to C++ driver code + +### Simulink interface +#702 [BugFix] Correct the expected format of the output channel names array + +### Build systems +#698 Configure runtime path linking when using shared libraries +#706 Automate incrementing the dev-label conda build +#725 Updated linking dependencies for newer version of Visual Studio +#727 Update rules for Intel OneAPI compiler detection + +### Testing +#670 Enable regression tests for the C++ API +#686 Bug fix for regression tests without C++ API enabled +#689 Enable types generation in CI +#691 Add SubDyn and AeroDyn drivers regression tests to github action +#717 GH Actions: run module tests with debug build +#718 [BugFix] Raise an error if reg test results contain NaN or infinity +#741 CTest: Add FF reg tests when FF build is enabled + diff --git a/docs/changelogs/v3.1.0.md b/docs/changelogs/v3.1.0.md new file mode 100644 index 0000000000..1b97e16968 --- /dev/null +++ b/docs/changelogs/v3.1.0.md @@ -0,0 +1,66 @@ +# Release Notes + +### General +#707 Add environmental variables to driver input files +#734 OpenFAST Registry algorithm change: simplify USE statements +Others (#826, #835, #836, #911, #918, #971, #1019) + +### AeroDyn +#688 AeroDyn driver update for multiple wind turbines, with arbitrary motions and geometries +#729 New features for unsteady aerodynamics modeling +#834 Fix AD Driver unallocated variable error with GCC 11 +#863 AeroDyn cleanup +#917 AD15: add nodal outputs for VUnd{xyz}i in global coords +#919 Segment treecode +#920 Update in Computing Default Unsteady Airfoil Coefficients +#922 [BugFix] Minor bugfix in AirfoilInfo +#982 [BugFix] AD15 nacelle reference position was set to hub position +#1001 Remove conditional statement for initialization of BEMT variable +#1009 [BugFix] Nacelle position set inconsistently by glue code and AeroDyn driver + +### BeamDyn +#996 [BugFix] BeamDyn nodal outputs occasionally segfaulted + +### FAST Farm +#839 Fix Bug in FAST.Farm Causing Wake Bounce-Back +#860 Fix some memory leaks in FAST.Farm +#895 [BugFix] incorrect init of aggregated output index arrays in FAST.Farm +#923 [BugFix] error handling in AWAE module + +### HydroDyn +#756 HydroDyn primary input file passing and parsing +#831 HydroDyn Input/Output meshes: change from SWL to MSL for consistency with OF glue code +#838 [BugFix] segmentation fault in HD linearization +#915 [BugFix] Incorrect reference frame used in HD for WAMIT/WAMIT2 +#998 Fix HydroDyn summary file nodal data is incorrect when Member is flipped + +### InflowWind +#720 inflowWind C-bound interface and python wrapper +#769 Fix issue with interpolation that could cause a segmentation fault +#929 Fix issue with uninitialized variables in InflowWind's Direct Scaling method + +### NWTC Library +#1002 Increase line length in FileInfo parsing methods + +### OpenFAST Library +#716 [BugFix] Fix C++ API for restart, Error handling in FAST Library, and AeroDyn echo file lock +#958 Lin: CalcSteady, forcing linearization at end of simulation + +### ServoDyn +#664 Extended Bladed DLL interface, improved summary file including DLL channel usage, and cable controls for MD and SD +#902 Fixes for Intel in debug mode +#930 Stop OpenFAST for Simulink simulation when trim solution has been found + +### SubDyn +#859 Various improvements to SubDyn + +### Documentation +#740 Guidelines for performance considerations with Fortran +#753 Migrate the HydroDyn Manual to readthedocs +#805 Include legacy documentation in pdf and MS Word format - General & ElastoDyn +#828 Add instructions for adding new regression test cases +#858 Documentation for ExtPtfm +#951 Corrected the description of SkewModFactor in Documentation +#1020 Document AD outputs + + diff --git a/docs/changelogs/v3.2.0.md b/docs/changelogs/v3.2.0.md new file mode 100644 index 0000000000..9866c1ff14 --- /dev/null +++ b/docs/changelogs/v3.2.0.md @@ -0,0 +1,60 @@ +# Release Notes + +### General +#866 Include legacy documentation in pdf and MS Word format - Modules +#1021 Reg_tests python scripts: fix issue where directory returned is empty +#1062 Add documentation for community contribution +#1169 Update git-module urls +#1158 Update orientation differences in linear trim solution +#1177 Add documentation on 3D rotations in linearization +#1178 Corrections for 3.2.0 release + +### AeroDyn +#932 BugFix: UA update states that were not updated +#1032 AD: added more nodal outputs for debugging UA +#1039 [BugFix] Nacelle motion not passed between AeroDyn driver and AeroDyn +#1043 AeroDyn: combine some FVW and BEMT output calculations +#1045 OLAF: check for division by zero to avoid invalid calculations +#1141 Move AD module reg tests to a standalone job + +### BeamDyn +#1050 Fix aeroelastic stability analysis with BeamDyn + +### FAST.Farm +#1107 Fix Time-Step Delay in Super Controller within FAST.Farm + +### HydroDyn +#806 C-bindings interface for HydroDyn +#1047 Fix HydroDyn Jacobian outputs when LinOutJac is True +#1108 BugFix: Checks to populate matrix input to Newman's app were reversed +#1173 Bug Fix: rotation matrix perturbation with small angles was wrong + +### InflowWind +#1144 BugFix: Fix typo in DLLEXPORT attributes for IfW C interface + +### MAP++ +#1048 MAP: small fix based on MAP 1.3 +#1168 Fix MAP linearization operating point + +### NWTC Library +#1050 Fix aeroelastic stability analysis with BeamDyn -- changes to the library routines for angle perturbations during linearization +#1124 Updates to VersionInfo module and its dependencies +#1157 Fix for binary file compression + +### OpenFAST Library +#962 Add a Python glue-code interface +#1057 FAST Library: add access to hub position and velocity + +### ServoDyn +#803 Linearization of ServoDyn Structural control elements +#1074 [BugFix] ServoDyn StC control signal channels were not zeroed properly +#1089 BugFix: Fix API change line numbers +#1101 BugFix: ServoDyn API change docs +#1140 Add non-rotating hub forces to Bladed Interface +#1160 Correction to documentation on Extended Bladed DLL interface + +### TurbSim +#887 TurbSim modifications + + + diff --git a/docs/changelogs/v3.2.1.md b/docs/changelogs/v3.2.1.md new file mode 100644 index 0000000000..ad926bb6e1 --- /dev/null +++ b/docs/changelogs/v3.2.1.md @@ -0,0 +1,9 @@ +# Release Notes + +This release contains the following bug fixes: + +#1201 Include stdexcept in FastLibAPI driver +#1180 Add conditional compile for C++ / C definitions in OpenFAST Library +Revert #1169 Update git-module urls + + diff --git a/docs/changelogs/v3.3.0.md b/docs/changelogs/v3.3.0.md new file mode 100644 index 0000000000..5f9daf90ed --- /dev/null +++ b/docs/changelogs/v3.3.0.md @@ -0,0 +1,48 @@ +# Release Notes + +### General +#1183 Fix bugs and issues in the online documentation +#1248 OpenFAST Registry: allow pointers + +### AeroDyn +#1000 Updates of Unsteady Aero (UAMod=4) and DBEMT (DBEMT_Mod=3) for linearization +#1037 Bug fix: BEMT was disabled for negative inflow +#1042 AD: merge more of `TwrInfl` and `TwrInflArray` routines +#1061 Fix AeroDyn WriteOutput linearization (and cleanup some code) +#1078 Enable cavitation calculation and outputs using FVW +#1188 AD15 driver: add visualization option for line meshes in addition to surfaces +#1239 AeroAcoustics: fix BL-thickness for heavily-tripped airfoil + +### HydroDyn +#999 Fix HD added mass on member end (Close #992) +#1230 HD: increase max length of line read from kinematics files + +### MoorDyn +#1086 MoorDyn v2 + shared moorings + wave propagation in FAST.Farm + +### MAP++ +#1186 MAP: allow keyword `fixed` and `fix` + +### NWTC Library +#1254 NWTC Library and WriteOutput updates + +### Build System +#1198 Option to disable variable tracking with GNU compiler +#1228 r-test: Remove -m64 in CMAKE_Fortran_FLAG from r-test + +### Testing System +#1203 Add parallel branches to GitHub Actions +#1217 Consolidate regression test baseline set +#1222 Improvements to regression test python scripts +#1244 Reg-test scripts modification to help avoid race condition and cleanup of caselist +#1264 GitHub Workflow: adding build-all-debug-single to check type errors + +### C++ API +#1176 Simulink: add documentation of inputs to FAST_Library.h +#1211 Use dt_out when storing OpenFAST outputs in Python interface +#1227 Seg Fault due to hub model and external inflow + +### Linearization +#1199 Small improvements for -VTKLin visualization outputs + + diff --git a/docs/changelogs/v3.4.0.md b/docs/changelogs/v3.4.0.md new file mode 100644 index 0000000000..0149421800 --- /dev/null +++ b/docs/changelogs/v3.4.0.md @@ -0,0 +1,70 @@ +# Release Notes + +OpenFAST v3.4.0 includes several major new features and bug fixes. New features include a new curled-wake model in FAST.Farm (#931), buoyancy calculations in AeroDyn 15 for MHK turbines (#957), rotor and tail furling (#1277), and new library interfaces for AeroDyn 15 and MoorDyn to couple with other codes (#1110 & #848). One major bug fix is changing the CFD coupling to use only the AeroDyn 15 mesh information -- this had led to some discrepancies in CFD results (#1324). + +The full set of changes included in this version are further documented in the following listed pull requests. + + +### General +#889 Add a super-controller library target to CMake +#1303 Small reorganization and clean up FAST.Farm r-test input files, upload of artifact +#1311 NWTC_IO: nullifying DLL (on restart) if not present when packing +#1318 Allow Registry to generate extrap/interp routines for types without module nickname +#1327 add version info to c-binding libraries +#1332 Documentation fixes +#1357 CI: exclude bokeh 3.0.[0-3] -- broken plots +#1376 Add `regression_tests` to the ALL target. + +### Documentation +#1267 OLAF: documentation: updated guidelines and using nFWPanels instead of WakeLength +#1406 Update example InflowWind and FAST.Farm input files + +### Visualization +#1319 Cleanup OpenFAST VTK output for HydroDyn +#1321 Add safety checks to VTK output +#1330 VTKLin: being more forgiving with number of modes +#1333 NWTC_Lib: Adding Yaml and VTK to library (moved from SD and AD) + +### FAST.Farm +#931 Implementation of the curled-wake model in FAST.Farm +#1263 FAST.Farm WriteOutput: fix for Windows Intel OMP build +#1304 API changes for future curl wake implementation, WD restructuring (Cq, OMP, skew filt) +#1305 FF: Cartesian grid for AWAE and WD outputs +#1310 FF: additional OpenMP parallelizations in FAST.Farm +#1328 FF: update of guidelines for Curled wake dr and DT_low + +### OpenFAST +#1275 Linear Trim Solution Improvements (Linearization) + +### AeroDyn +#957 Calculate buoyancy for an MHK turbine +#1110 New AeroDynInflow module with c-bindings interface +#1276 Bug Fix: OLAF: particles are NaN when vortex segments have zero length +#1277 Reactivating rotor furling and tailfin aerodynamics (ElastoDyn also) +#1283 Add new projection method and BEM methods +#1293 Minor error handling and code cleanup (OLAF) +#1317 Fix for Visual Studio builds with ADI +#1347 AeroDyn/UnsteadyAero_Driver: Fix for bug #1346 +#1355 OLAF: Adding free near wake panels +#1356 AeroDyn/UnsteadyAero_Driver: Fix for bug #1346 +#1369 UA: adding UA_Driver outputs, fix separation function for UAMod=6, and adding r-tests + +### BeamDyn +#1335 BeamDyn: output summary file in yaml format + +### InflowWind +#1240 Improvements to the InflowWind disk averaged velocity calculations +#1266 Temporarily removing InflowWind parallelization + +### MoorDyn +#848 MoorDyn v2 C-bindings interface +#1371 MoorDyn bending bugfix and message updates for v2 + +### OpenFOAM +#1324 CFD coupling to use AD15 mesh only +#1365 OpFM: [bugfix] test for warning condition was broken +#1372 [BugFix] the DEBUG_OPENFOAM preprocessor directive was never updated for multiple AD15 rotors + +### TurbSim +#1361 TurbSim: User-defined time series updates + diff --git a/docs/changelogs/v3.4.1.md b/docs/changelogs/v3.4.1.md new file mode 100644 index 0000000000..7bfeb1a94d --- /dev/null +++ b/docs/changelogs/v3.4.1.md @@ -0,0 +1,11 @@ +# Release Notes + +OpenFAST 3.4.1 is a minor release to revert a channel name change in AeroDyn 15. This also contains minor fixes for documentation builds. + +### Documentation +#1442 `[BugFix] Doxygen builds failing on rtd, and locally. Documentation builds on readthedocs and local were failing due to a change in the backend of sphinx. This fixes local builds, but does not fix readthedocs builds. As a temporary workaround, doxygen is disabled on readthedocs. + +### AeroDyn15 +#1428 AD15: revert to Aero names for output channels (Fld is now an alias). This fixes an issue introduced in v3.4.0 (#957) + + diff --git a/docs/changelogs/v4.0.0.md b/docs/changelogs/v4.0.0.md new file mode 100644 index 0000000000..b84e6f4933 --- /dev/null +++ b/docs/changelogs/v4.0.0.md @@ -0,0 +1,563 @@ +**Feature or improvement description** +Pull request to merge `dev` into `main` for release version 4.0.0 + +See the milestone and project pages for additional information + + https://github.com/OpenFAST/openfast/milestone/3 + +Test results, if applicable +See GitHub Actions + +### Release checklist: +- [ ] Review GH projects and Milestones for outstanding items +- [ ] Update version info + - [ ] Update the documentation version in `docs/conf.py` + - [ ] Update the versions in `docs/source/user/api_change.rst` + - [ ] Update `openfast_io/pyproject.toml` +- [ ] Verify readthedocs builds correctly +- [ ] Create a merge commit in r-test and add a corresponding annotated tag +- [ ] Update pointer to r-test +- [ ] Merge PR +- [ ] Create release + - [ ] Check "create a discussion" box + - [ ] Create a new tag +- [ ] Compile executables for Windows builds + - [ ] AeroDisk_Driver_x64.exe + - [ ] AeroDyn_Driver_x64.exe + - [ ] AeroDyn_Driver_x64_OpenMP.exe + - [ ] AeroDyn_Inflow_C_Binding_x64.dll + - [ ] AeroDyn_Inflow_C_Binding_x64_OpenMP.dll + - [ ] BeamDyn_Driver_x64.exe + - [ ] DISCON.dll (x64) + - [ ] DISCON_ITIBarge.dll (x64) + - [ ] DISCON_OC3Hywind.dll (x64) + - [ ] DISCON_SC.dll (x64) + - [ ] FAST.Farm_x64.exe + - [ ] FAST.Farm_x64_OMP.exe + - [ ] FAST_SFunc.mexw64 + - [ ] HydroDynDriver_x64.exe + - [ ] HydroDyn_C_Binding_x64.dll + - [ ] IfW_C_Binding_x64.dll + - [ ] InflowWind_Driver_x64.exe + - [ ] InflowWind_Driver_x64_OpenMP.exe + - [ ] MoorDyn_Driver_x64.exe + - [ ] MoorDyn_C_Binding_x64.dll + - [ ] OpenFAST-Simulink_x64.dll + - [ ] openfast_x64.exe + - [ ] SeaState_driver_x64.exe + - [ ] SimpleElastodyn_driver_x64.exe + - [ ] Turbsim_x64.exe + + + +# Release Overview +------ +This release includes many architectural changes and physics improvements from the OpenFAST 3.5 series. Improvements and new features include large platform yaw dynamics, reduced order structural and aero modules (_Simplified-ElastoDyn_ (SED) and _AeroDisk_ (ADsk)), fluid-structure coupling with _AMR-Wind_, wake-added turbulence for _FAST.Farm_, linearization for MHK turbines, aeromap calculations, an updated Python library for _OpenFAST_ file handling, revised wind and wave data handling, removal of _AeroDyn14_, many hydrodynamic improvements including the splitting of the wave field (new _SeaState_ (SS) module) from HydroDyn, and many bug fixes. The number of changes to input files is very large, so we recommend reviewing the changelog below and notes in https://openfast.readthedocs.io/en/main/source/user/api_change.html for specifics about which files have changes. + + +### Contribution Acknowledgements +Thanks to @bjonkman, @jjonkman, @deslaughter, @luwang00, @RBergua, and @MattEHall for numerous code reviews and suggestions and testing. + +Many thanks to @jjonkman and others for theory development and guidance to developers. + +### Statistics (since 3.5.5) +* Total PR's unique to 4.0.0: 169 +* Total individual code contributors: 27 +* OpenFAST code/docs: 601 files changed, 220202 insertions(+), 445810 deletions(-) +* regression tests: 1587 files changed, 1214606 insertions(+), 537760 deletions(-) + + + +# Changelog +------ + +## General + +### Build systems +There were several updates to the `CMake` and Visual Studio build systems to support code revisions and improve support for compilers such as Flang. + +#### CMake + +#1630 Make CMake module libs STATIC (@deslaughter) + +#1989 Bug: openfastcpp executable is installed to lib directory instead of bin (@deslaughter) + +#1998 switch from -fpic to -fPIC for all gfortran builds (@gbarter) + +#2094 Support cross-compiling with Mingw (MAP++)(@pablo-benito) + +#2133 Remove linking of implicit Fortran libraries (@jrood-nrel) + +#2210 New registry needs C++14 (@deslaughter) + +#2229 CMake: OpenMP turned on only if requested (@andrew-platt) + +#2136 ADI: adilib was getting included in aerodynlib (@andrew-platt) + +#2256 Remove ModVar from dev as ROCm Flang compiler can't build it (@deslaughter) + +#2392 Install also the Map++ API headers (@sanguinariojoe) + +#2442 Fix path to installed MAP include files (@deslaughter) + +#1682 Fix missing symbols for Simulink and LAPACK build (@deslaughter) + + +#### Visual Studio (Windows) + +#1968 VS: update VS build process to include ExtLoads (@andrew-platt) + +#2187 Fix syntax errors in Visual Studio project file for AD driver (@bjonkman) + +#2189 More fixes for Visual Studio (@bjonkman) + +#2327 Remove AD14 from FASTlib Visual Studio project (@bjonkman) + +#2548 Build OpenFAST in Visual Studio 2022 using IFX (@deslaughter) + +#2589 VSbuild: updates for 4.0.0 release (binary output paths, OMP usage) (@andrew-platt) + + +### Docker + +#2183 Update GHCR doc, remove old Dockerfile (@mayankchetan) + +### Documentation +There were multiple improvements to documentation, notably with _TurbSim_, _SubDyn_, _HydroDyn_, and _SeaState_. + +#1664, #1665 TurbSim documentation (@bjonkman) + +#2212 Minor corrections to docs (@andrew-platt) + +#2315, #2336 Update SeaState and HydroDyn user documentation for OpenFAST 4.0 (@luwang00) + +#2366 Fixed typo in docs/source/install/index.rst (@Gjacquenot) + +#2372 SubDyn: Beam Element Formulation documentation (@RBergua) + +#2374 SubDyn documentation: Member Cosine Matrices (@RBergua) + +#2404 Update SubDyn User Documentation to reflect the removed input parameters (@luwang00) + +#2455 HydroDyn user documentation update for large platform rotation (@luwang00) + +#2587 Add release notes from v2.4 - v3.4.1 (@andrew-platt) + + + + +## Solvers + +### FAST.Farm +_FAST.Farm_ received a major upgrade with the addition of wake-added turbulence effects across the entire farm domain. This improves the turbulence characteristics of propagating turbine wakes. +* Input file changes + +#1624 Use pointers to couple InflowWind and FAST.Farm (@deslaughter) + +#1729 FF: fix plane output for wakedynamics (@ebranlard) + +#2202 Wake-added turbulence in FAST.Farm (@ebranlard, @andrew-platt) + +#2584 Visualization of shared moorings (@andrew-platt) + + +### OpenFAST +Several improvements to the _OpenFAST_ glue code include a major restructuring of the core routines for better integration into CFD, a revised initialization ordering, the addition of logic for new or replaced modules, new data passing for wave and wind data, and bug fixes. Module related updates to logic and restructuring for CFD is included in pull-requests related to those modules. +* Input file changes + +#1610 Remove TurbineType parameter (@hkross) + +#1707 Linear trim solution: add error check (@bjonkman) + +#2076 Move flag for WriteThisStep to `FAST_PreWork` (@bjonkman, @andrew-platt) + +#2078 Minor code cleanup (replace some non-standard Fortran 2003 code) (@bjonkman) + +#2186 [Bug] Writing checkpoint files created empty `fort.#` files (@deslaughter) + +#2219 Turn off "#Restoring here" messages in .out files during linearization visualization sims (@andrew-platt) + +#2338 Vis: Fix bug with vtk writing of non-square wave surface (@andrew-platt) + +#2350 Vis: Fix another bug with vtk writing of non-square wave surface (@luwang00) + +#2431 Enable linearization with MHK turbines (@andrew-platt) + +#2445 ExtInfw: relocate initialization to after `AD_Init` (@andrew-platt) + +#2478 [BugFix] Incorrect value of AirDens passed to `ExtInfw_Init` from `FAST_Subs.f90` (@andrew-platt) + + +### OpenFAST interfaces + +#### OpenFASTcpp +* Interface library changes + +#2245 Fix restart file index and nc write (@ndevelder) + + +#### Simulink + +#1703 Add tests for `FAST_SFunc` using Matlab action to integrate with CI (@deslaughter) + + + +## Modules + +### Multiple +There are several pull requests that affected multiple modules. Important features include the initial development of aeromaps (for controls development), initial development of the reduced order modules of _AeroDisk_ and _Simplified-ElastoDyn_ (overviews of each below). + + +#1295 Reduced order models: AeroDisk and Simplified-ElastoDyn (SED) (@andrew-platt) + +#1629 MHK: add parameters for readability (@bjonkman) + +#1631 Initial AeroMap changes for ElastoDyn and BeamDyn (@bjonkman) + +#2203 Support for large platform yaw offset in OpenFAST (ED, HD, SD) (@luwang00) + +#2254 Minor changes to FF input descriptions, re-enable test cases, update Simulink string compare (@andrew-platt) + +#2332 Minor bugfix: ED blade file parsing (no PichAxis column), AD warnings (@andrew-platt) + +#2415 Lidar bug fix + other minor changes (@bjonkman) + +#2416 SED+ADsk: update registry comments slightly (@andrew-platt) + + + +### AeroDyn 14 (deprecated, option replaced by AeroDisk) +_AeroDyn14_ has been removed from the code base as it has been superseded by _AeroDyn15_ (now called simply _AeroDyn_) for many years. + +#2267 AeroDyn14 removal (@andrew-platt) + + +### AeroDisk +_AeroDisk_ is a new module for a disk actuator aerodynamic module for modeling turbine aerodynamics as a simple actuator disk. This module assumes that the rotor is a rigid disk, and so, should be not be combined with _BeamDyn_ or _ElastoDyn_ with blade degrees of freedom enabled; it is meant to be used with the new _Simplified-ElastoDyn_ module. This is useful for modeling turbines that are not of interest in very large wind farms modeled by _FAST.Farm_, but whose wake dynamics are needed for turbines further into the wind farm that are of interest. We do not recommend using this module with standalone _OpenFAST_ simulations. +* New input file + +#2575 ADsk: correction to disk average velocity equations (@andrew-platt) + + + +### AeroDyn +_AeroDyn_ improvements include a new input file, new options in BEM to improve aerodynamics for skewed and sheared inflow and coned rotors, nacelle drag, visualization improvements, unsteady aero for tailfins, an improved unsteady airfoil aerodynamics driver, multi-rotor support in the interface library, a simple ground effect model for _OLAF_ wakes, using _InflowWind_ pointers for data access, and many bug fixes. With the removal of _AeroDyn14_, _AeroDyn15_ is now simply referred to as _AeroDyn_ in the input files and code (documentation may not be fully updated). +* _Major_ input file changes +* Driver input file changes +* Interface library API changes + +#2428 Single value of TI in AD15 Aeroacoustics (@ptrbortolotti) + +#1596 Use pointers to couple InflowWind and AeroDyn (IfW pointer) (@andrew-platt) + +#1715 AD: Initial AeroMap changes for AeroDyn and misc UA/DBEMT changes (@bjonkman) + +#1882 Remove IfW data from AD15 inputs (@andrew-platt) + +#1909 New AeroDyn input file exposing new BEM options (polar BEM, skew momentum correction, sector averaging) (@ebranlard) + +#1973 Use AD tower diameter for VTK visualization + minor improvements (@bjonkman) + +#2014 Fix linearization with AD15 and IfW (@andrew-platt) + +#2181 AD15: use current wind instead of extrapolated wind (IfW pointer) (@andrew-platt) + +#2283 Aero modifications (many small updates) (@bjonkman) + +#2358 Adding nacelle drag to AeroDyn (@mayankchetan) + +#2425 AD: Bug Fix: Twist in blades 2 and 3 wrong when using Polar BEM (@ebranlard) + +#2427 `DBEMT_Mod = -1` for linearization (@andrew-platt) + +#2429 Fix seg-fault for `DBEMT_Mod=-1` (@andrew-platt) + +#2456 Add safety checks in AirfoilInfo for ill-defined airfoils (@bjonkman) + +#2559 Bug Fix: AD: projection method should now depend on `BEM_Mod` (@ebranlard) + + +#### Unsteady + +#1874 Add unsteady aerodynamic model for turbine tail fin (@abhineet-gupta) + +#1910 Unsteady Aero Driver: adding 3 degrees of freedom for the motion of a genralized airfoil section (@ebranlard) + +#2091 Fix bug in new UA driver (array size) (@bjonkman) + +#2357 Bug Fix: UA driver aero-elastic simulation had wrong sign (@bjonkman) + +#2375 Tail fin aerodynamics: address changes requested in pull request #1874 (@abhineet-gupta) + + +#### OLAF + +#1791 Apply the FakeGroundEffect to all FWspan points (@rcorniglion) + +#2349 [OLAF] Bug Fix: Twist Not Computed in OLAF cases when Polar Projection is used, resulting in wrong Fn, Ft outputs (@ebranlard) + +#2581 OLAF out of bounds (@andrew-platt) + + +#### AeroDyn Driver / AeroDyn\_Inflow\_C\_Bindings interface + +#1784 Multi-rotor support in ADI c-bindings interface (@andrew-platt) + +#2108 Refactored Aerodyn inflow C binding interface to get blade resolved mesh information (@faisal-bhuiyan) + +#2140 ADI: disable OMP in `AeroDyn_Inflow.f90` (@andrew-platt) + +#2287 Bug Fix: AeroDyn driver output files contained wrong channel names (@bjonkman) + +#2370 Correct frequency error in AeroDyn driver prescribed motions (@hkross) + +#2457 Bug: AeroDyn-Inflow WriteOutput Value Ordering (@deslaughter) + +#2470 Add blade distributed load output to AeroDyn-InflowWind C bindings (@deslaughter) + +#2571 Add new routine and variables to init in the `ADI_c_binding` interface (@andrew-platt) + + + +### ElastoDyn +_ElastoDyn_ includes a new yaw friction model, new output channels, new platform cross-inertia terms, several bugfixes, and code cleanup. +* Input file changes + +#2017 Yaw friction implementation (@abhineet-gupta, @kevo331, @rdamiani) + +#1760 Add output channels of linear acceleration relative to g in ElastoDyn (@luwang00) + +#1426 Remove references to ADAMS coupling (@hkross) + +#2247 ED: Add inputs for the off-diagonal terms of the platform moment of inertia matrix (@luwang00) + +#2561 ED: Extended yaw-friction modeling (@luwang00) + + + +### ExtInflow (formerly OpenFOAM) +_ExtInflow_ (also called _ExternalInflow_) is the renamed _OpenFOAM_ module. The name change better reflects what this module does as it can couple to more than just the _OpenFOAM_ solver used in _SOWFA_. + +#1687 ExternalInflow: rename files, change names in files (@andrew-platt) + +#2443 Fixes in ExtInflw (heap-buffer-overflow, index flip, empty structure) (@marchdf) + + + +### ExtLoads +_ExtLoads_ is a new module for blade resolved fluid-structure interaction with CFD codes such as _AMR-Wind_. This module is accessed through the CPP interface to OpenFAST. + +#1932, #1946 Blade resolved loads from CFD (@gantech, @deslaughter, @psakievich, @jrood-nrel, @andrew-platt) + +#2001 ExtLoads: move integers from inputs to parameters (@andrew-platt) + +#2009 ExtLoads module: Use pointers for wind (@andrew-platt) + +#2226 Fix turbine indexing on ExtLoads Restart (@ndevelder) + +#2412 ExtLd: require use of InflowWind (@andrew-platt) + + +### HydroDyn +The _HydroDyn_ module was completely restructured with wave dynamics split out into a new module, _SeaState_ (documented below). _HydroDyn_ now accesses wave-field data through a pointer to the data held in the _SeaState_ module. Other improvements include large yaw angle dynamics, wave loads at the displaced position in surge/sway, MacCamy-Fuchs diffraction for strip-theory members, wave stretching (various models) with load smoothing, constrained New Wave theory, new strip-theory hydrostatic solution valid for near-horizontal members at the free surface, and bug fixes. +* _Major_ input file changes + +#1578 More updates to the Morison module (@luwang00) + +#1609 Use pointers to couple SeaState and HydroDyn (@luwang00) + +#1612 Force the numerical hydrostatic load calculation to use double precision (@luwang00) + +#1623 Ensure the estimated intersections between the free surface and the Morison members are treated as under water (@luwang00) + +#1804 Bug Fix with MSL2SWL (@luwang00) + +#1883 HD: Remove extra copy of WaveStMod from Morison (@bjonkman) + +#2031 HD Bug Fix for ExctnDisp and updates to CTestList.cmake with new r-tests (@luwang00) + +#2035 Backward compatibility for the AXIAL COEFFICIENTS section of the HydroDyn input file (@luwang00) + +#2069 HD bug fixes to the inertial loads from marine growth and ballast water on strip-theory members (@luwang00) + +#2073 HD bug fix to the inertial load from ballast water on strip-theory members (@luwang00) + +#2089 HD Bug Fix: Correct the indices of mean drift load components in WAMIT2 (@luwang00) + +#2098 More bug fixes in the WAMIT and WAMIT2 modules of HydroDyn with wave headings (@luwang00) + +#2341 HD: Initialization of the low-pass-filtered displacements of potential-flow bodies when `ExctnDisp = 2` (@luwang00) + +#2356 Fix a bug when reading WAMIT QTF files with multiple wave headings (@getChaos22) + +#2408 HD: Bug fix for potential-flow wave excitation with multiple bodies and large yaw offset (@luwang00) + +#2517 HD bug fix for depth-based axial hydrodynamic coefficients (@luwang00) + +#2444 HD: Reimplement the initialization of low-pass-filtered potential-flow body positions for `ExctnDisp=2` (@luwang00) + + +### InflowWind +The _InflowWind_ module data handling was updated so that _AeroDyn_, _ExtInflow_, and _Lidar_ can retrieve FlowField data through a pointer. The driver was updated to allow the export of VTK slices in XY planes at a chosen elevation from any wind format. This can be useful when visualizing wind flow in an _OpenFAST_ or _FAST.Farm_ simulation. +* Driver input file changes +* library API changes + +#1639 InflowWind pointers in AeroDyn, OpenFOAM (now ExtInflow), and Lidar (@deslaughter) + +#1684 [BugFix] change time handling to double precision for G4D timestep index (@deslaughter) + +#1869 IfW: check that uniform wind file time vector is always increasing (@andrew-platt) + +#2201 IfW: add VTK output of slice in XY to driver (@andrew-platt) + + + +### MAP++ +Several improvements were made to _MAP++_ to allow more modular coupling into other codes. + +#2394 Fixes to Map++ C API (@sanguinariojoe) + +#2405 [BugFix] remove extra summary file write from MAP++ (@sanguinariojoe, @andrew-platt) + +#2420 MAP: change `strncpy` to use macro `MAP_STRNCPY` (@andrew-platt) + + +### MoorDyn +_MoorDyn_ received several new features including coupled pinned bodies, ramping of inertial loads to better handle startup transients, updated body kinematics, linear damping for rod elements, and mooring line failures. Visualization of shared mooring lines for _FAST.Farm_ is also included. +* Input file changes + +#1967 MoorDyn: Coupled Pinned Bodies and bug fixes (@RyanDavies19) + +#1990 MD version update (@RyanDavies19) + +#2005 Removes MD driver standalone option, bug fix on initialization (@RyanDavies19) + +#2243 Initialize mass matrix to zeros in Moordyn (@faisal-bhuiyan) + +#2280 MD: ramp inertial loads during startup transients (@andrew-platt) + +#2294 Add MoorDyn module regression tests (@RyanDavies19) + +#2334 Updating MD Body Kinematics (@RyanDavies19) + +#2342 Linear damping for rod elements in MoorDyn (@RBergua, with contributions from Johyun Kyoung at Front Energies) + +#2400 MD: replace "save" variable with logical in MD\_Point (@andrew-platt) + +#2436 MD: Automatically detect the number of header lines in the WaveKin (wave elevation) file (@luwang00) + +#2459 MD: Adding Load dependent dynamic stiffness (@RyanDavies19) + +#2214 Mooring line failures added to MoorDyn (@RyanDavies19) + + +### NWTC-Library +There are a few minor bug fixes for the library. + +#2191 [BugFix] blank line not handled by InitFileInfo (@andrew-platt) + +#2223 SetErrStat referenced incorrectly in VTK.f90 (@andrew-platt) + + +### Registry +The _Registry_ was completely rewritten in C++ (included in #1609, @deslaughter) significantly cleaning up the code. New features include pointer handling and new data structures to streamline packing and unpacking for saves/restarts. + +#1618 [BugFix] OpenFAST Registry on Windows (@deslaughter) + +#1625 Add support for pointers in OpenFAST Registry generated Pack and Unpack subroutines (@deslaughter) + +#1919 Use int64 to index arrays for Registry pack/unpack routines (@deslaughter) + +#1986 Save registry structures to file without using a buffer (@deslaughter) + +#2249 Bug in OpenFAST Registry Unpacking Structures with `C_obj` data (@deslaughter) + +#2365 Bugfix for OpenFAST Registry incorrectly restoring pointers in modules with `CObjs` (ExtLd) (@deslaughter, @gantech) + +#2519 Use B4Ki to store array bounds during pack/restore of TurbineType to file (@deslaughter) + + +### SeaState +The _SeaState_ module contains all the wave dynamics previously included within _HydroDyn_. As a standalone module, data is stored in the _WaveField_ data structure which is accessible from other modules through pointers. The first implementation of this code was developed by @HaymanConsulting (#970). +* New input file + +#970 Initial split of HydroDyn into HydroDyn+SeaState (@HaymanConsulting) + - PR 1008 supersedes this, but GitHub does not show the full history so this is listed here for completeness (PR 970 was merged through PR 1008) + +#1008 Additional features for the new SeaState module and HydroDyn (@HaymanConsulting, @bjonkman, @luwang00) + +#1864 Cleanup HydroDyn and SeaState code (@bjonkman) + +#1992 SeaState: fix grid size in wave surface visualization (@andrew-platt) + +#2026 SeaState: combine `SeaSt_Interp` into `SeaSt_WaveField`, and bug fix (@andrew-platt) + +#2071 SeaSt Vis: corrections to PR #1992 (@bjonkman, @andrew-platt) + +#2113 SeaState: replace pointer attribute with allocatable (@bjonkman) + + +### Simplified-ElastoDyn +The _Simplified-ElastoDyn_ module (_SED_) is a one degree of freedom rigid structural model useful for cases where a full structural model is not needed (for example, leading turbines in a _FAST.Farm_ simulation). This speeds up computations significantly, but at the expense of accuracy. So it is only recommended that this be used within _FAST.Farm_ for turbines where load calculations are not needed. This is often paired with the _AeroDisk_ module. +* New input file + +#2406 Correct issues with SED (logic lost in prior merge) (@andrew-platt) + + +### SubDyn +_SubDyn_ improvements include a new 6x6 spring element, removal of some stiffness terms for cable pretension, a few bug fixes, and code cleanup. +* Input file changes + +#1889 New spring element in SubDyn: 6 by 6 stiffness matrix (@RBergua) + +#1911 SubDyn summary file: fixes (@RBergua) + +#2363 SD: Comment out the geometric stiffness terms associated with cable pretension to prevent unphysical results (@luwang00) + +#2401 SD: Remove the misleading CBMod input (@luwang00) + +#2458 SD: Bug fix for concentrated mass with CoG offset (@luwang00) + + + +## Testing and input file processing +There were several updates and improvements to the testing system and GitHub actions. + +### openfast_io +This Python based library provides _OpenFAST_ users with library to read and write _OpenFAST_ input files. This library will be able usable for updating input files starting with this release of _OpenFAST_ going forward. This is designed for inclusion in other workflows, such as _WEIS_. + +#2361 Updates to `openfast_io` to match current dev branch API (@mayankchetan) + +#2577 Refactor `openfast/openfast_python/openfast_io/turbsim_file.py` (new entry point) (@Gjacquenot) + + +### GitHub actions + +#2072 GH actions: update matlab-actions version (@andrew-platt) + +#2074 GH actions: remove extraneous "products:" from recipe (added in #2072) (@andrew-platt) + +#2154 GH actions: build docker on release instead of merge (@andrew-platt) + + +### Regression and Unit testing + +#1598 Reduce memory requirements for regression tests after PR #1008 (@andrew-platt) + +#1950 Option to turn off `unit_tests` from cmake (@andrew-platt) + +#2024 Improvements to linearization regression testing (@andrew-platt) + +#2182 Move test `seastate_wavemod5` to after test `seastate_wr_kin1` (@andrew-platt) + +#2250 Add CalcSteady Regression Test (@deslaughter) + +#2276 Replace pFUnit with test-drive for running unit tests (@deslaughter) + +#2329 Remove pfunit as a submodule (@bjonkman) + + + +## Input file changes +This release brings a large number of input file changes and rearrangements with multiple new modules. A partial list of changes can be found here: https://openfast.readthedocs.io/en/main/source/user/api_change.html. However, we recommend that if you start by comparing to the complete set of input files found in the regression tests: https://github.com/OpenFAST/r-test/tree/v4.0.0 (example input files from the regression testing) + diff --git a/docs/conf.py b/docs/conf.py index a1ce010114..a298c58f26 100644 --- a/docs/conf.py +++ b/docs/conf.py @@ -66,17 +66,20 @@ def runDoxygen(sourcfile, doxyfileIn, doxyfileOut): 'sphinxcontrib.doxylink', 'sphinxcontrib.bibtex', 'sphinxcontrib.mermaid', +# 'breathe', ] bibtex_bibfiles = [ 'source/user/aerodyn-aeroacoustics/references.bib', 'source/user/aerodyn-olaf/bibliography.bib', 'source/user/aerodyn/bibliography.bib', + 'source/user/elastodyn/bibliography.bib', 'source/user/beamdyn/references.bib', 'source/user/extptfm/bibliography.bib', 'source/user/fast.farm/bibliography.bib', 'source/user/hydrodyn/references.bib', 'source/user/servodyn-stc/StC_Refs.bib', - 'source/user/subdyn/references_SD.bib' + 'source/user/subdyn/references_SD.bib', + 'source/dev/cppapi/bibliography.bib' ] autodoc_default_flags = [ @@ -89,6 +92,11 @@ def runDoxygen(sourcfile, doxyfileIn, doxyfileOut): mathjax_path = 'https://cdn.mathjax.org/mathjax/latest/MathJax.js?config=TeX-AMS-MML_HTMLorMML' +## Breathe Configuration -- for cpp interface +#breathe_projects = {"cppapi": "source/dev/cppapi"} +#breathe_default_project = "cppapi" + + # FIXME: Naively assuming build directory one level up locally, and two up on readthedocs if useDoxygen: if readTheDocs: @@ -128,9 +136,9 @@ def runDoxygen(sourcfile, doxyfileIn, doxyfileOut): # built documents. # # The short X.Y version. -version = u'3.5' +version = u'4.0' # The full version, including alpha/beta/rc tags. -release = u'v3.5.5' +release = u'v4.0.0' # The language for content autogenerated by Sphinx. Refer to documentation # for a list of supported languages. @@ -176,7 +184,7 @@ def runDoxygen(sourcfile, doxyfileIn, doxyfileOut): # documentation. # html_theme_options = { - "analytics_id": "UA-68999653-10" + "analytics_id": "G-54J9QGXMGP" } # Add any paths that contain custom static files (such as style sheets) here, diff --git a/docs/index.rst b/docs/index.rst index 0b5f130b81..9dd5504e5f 100644 --- a/docs/index.rst +++ b/docs/index.rst @@ -51,8 +51,9 @@ package: source/this_doc.rst source/install/index.rst - source/testing/index.rst + source/working.rst source/user/index.rst + source/testing/index.rst source/dev/index.rst source/license.rst source/help.rst diff --git a/docs/source/dev/cppapi/README.txt b/docs/source/dev/cppapi/README.txt new file mode 100644 index 0000000000..c623c166fb --- /dev/null +++ b/docs/source/dev/cppapi/README.txt @@ -0,0 +1,8 @@ +2023.12.15 ADP + +We don't currently run doxygen on RTD due to some configuration issues. So the doxygen content for the cpp was manually run and stored (really not ideal and should be fixed). + +doxygenclass and doygenstruct are commented out in the following places. When doxygen is working, turn these back on. +api.rst:8: .. doxygenclass:: fast::OpenFAST +index.rst:18: .. doxygenclass:: fast::fastInputs +index.rst:27: .. doxygenstruct:: fast::turbineDataType diff --git a/docs/source/dev/cppapi/api.rst b/docs/source/dev/cppapi/api.rst new file mode 100644 index 0000000000..c1313d08e5 --- /dev/null +++ b/docs/source/dev/cppapi/api.rst @@ -0,0 +1,15 @@ +C++ API Documentation +===================== + +OpenFAST +-------- + + +FIXME: **doxygenclass** is needed to render the class structure + +.. + .. doxygenclass:: fast::OpenFAST + :members: + :protected-members: + :undoc-members: + diff --git a/docs/source/dev/cppapi/bibliography.bib b/docs/source/dev/cppapi/bibliography.bib new file mode 100644 index 0000000000..266ce94238 --- /dev/null +++ b/docs/source/dev/cppapi/bibliography.bib @@ -0,0 +1,122 @@ +%% This BibTeX bibliography file was created using BibDesk. +%% http://bibdesk.sourceforge.net/ + +%% Created for Vijayakumar, Ganesh at 2016-12-07 16:45:28 -0700 + + +%% Saved with string encoding Unicode (UTF-8) + +@inbook{cpp-churchfield2012, + Annote = {doi:10.2514/6.2012-537}, + Author = {Churchfield, Matthew and Lee, Sang and Moriarty, Patrick and Martinez, Luis and Leonardi, Stefano and Vijayakumar, Ganesh and Brasseur, James}, + Booktitle = {50th AIAA Aerospace Sciences Meeting including the New Horizons Forum and Aerospace Exposition}, + Doi = {doi:10.2514/6.2012-537}, + Month = {2017/07/18}, + Publisher = {American Institute of Aeronautics and Astronautics}, + Title = {A Large-Eddy Simulation of Wind-Plant Aerodynamics}, + Title1 = {Aerospace Sciences Meeting}, + Ty = {CHAP}, + Url = {https://doi.org/10.2514/6.2012-537}, + Year = {2012}} + + +@techreport{cpp-beamdynManual, + Author = {Wang, Q and Jonkman, Jason and Sprague, Michael A, and Jonkman, Bonnie}, + Date-Added = {2016-12-07 23:35:57 +0000}, + Date-Modified = {2016-12-07 23:37:15 +0000}, + Institution = {National Renewable Energy Laboratory}, + Month = {March}, + Title = {BeamDyn User's Guide and Theory Manual}, + Year = {2016}} + +@article{cpp-martinez2016, + Author = {Luis A. Martinez-Tossas and Matthew J. Churchfield and Charles Meneveau}, + Journal = {Journal of Physics: Conference Series}, + Number = {8}, + Pages = {082014}, + Title = {A Highly Resolved Large-Eddy Simulation of a Wind Turbine using an Actuator Line Model with Optimal Body Force Projection}, + Url = {http://stacks.iop.org/1742-6596/753/i=8/a=082014}, + Volume = {753}, + Year = {2016}} + +@techreport{cpp-fastProgrammersHandbook, + Author = {B.J. Jonkman and J. Michalakes and J.M. Jonkman and M.L. Buhl and Jr. and A. Platt and and M.A. Sprague}, + Institution = {National Renewable Energy Laboratory}, + Month = {July}, + Title = {NWTC Programmer's Handbook: A Guide for Software Development Within the FAST Computer-Aided Engineering Tool}, + Year = {2013}} + +@techreport{cpp-aerodynV15Manual, + Author = {J.M. Jonkman}, + Institution = {National Renewable Energy Laboratory}, + Month = {April}, + Title = {AeroDyn v15 User's Guide and Theory Manual}, + Year = {2016}} + +@techreport{cpp-naluDoc, + Address = {https://github.com/spdomin/NaluDoc}, + Author = {Stefan Domino}, + Institution = {Sandia National Laboratories Unclassified Unlimited Release (UUR)}, + Number = {SAND2015-3107W}, + Title = {Sierra Low Mach Module: Nalu Theory Manual 1.0}, + Year = {2015}} + +@techreport{cpp-fastv8AlgorithmsExamples, + Author = {Michael A. Sprague and Jason M. Jonkman and Bonnie J. Jonkman}, + Institution = {National Renewable Energy Laboratory}, + Month = {January}, + Number = {NREL/CP-2C00-63203}, + Title = {FAST Modular Framework for Wind Turbine Simulation: New Algorithms and Numerical Examples}, + Year = {2015}} + +@techreport{cpp-fastv8ModFramework, + Author = {Jason M. Jonkman}, + Date-Added = {2016-07-21 19:25:11 +0000}, + Date-Modified = {2016-07-21 19:26:24 +0000}, + Institution = {National Renewable Energy Laboratory}, + Month = {January}, + Number = {NREL/CP-5000-57228}, + Title = {The New Modularization Framework for the FAST Wind Turbine CAE Tool}, + Year = {2013}} + +@techreport{cpp-fastv8, + Author = {Jason M. Jonkman and Bonnie J. Jonkman}, + Date-Added = {2016-07-21 19:15:10 +0000}, + Date-Modified = {2016-07-21 19:28:31 +0000}, + Institution = {National Renewable Energy Laboratory}, + Month = {April}, + Title = {FAST v8: Changelog}, + Year = {2016}} + +@techreport{cpp-fastv7, + Author = {Jason M. Jonkman and Marshall L. Buhl Jr.}, + Date-Added = {2016-07-21 18:11:47 +0000}, + Date-Modified = {2016-07-21 18:13:07 +0000}, + Institution = {National Renewable Energy Laboratory}, + Month = {August}, + Number = {NREL/EL-500-38230}, + Title = {FAST User's Guide}, + Year = {2005}} + +@techreport{cpp-fleming2013, + Author = {Paul Fleming and Sang Lee and Matthew J. Churchfield and Andrew Scholbrock and John Michalakes and Kathryn Johnson and and Patrick Moriarty}, + Date-Added = {2016-07-21 18:05:29 +0000}, + Date-Modified = {2016-07-21 19:30:03 +0000}, + Institution = {National Renewable Energy Laboratory}, + Month = {January}, + Number = {NREL/CP-5000-57175}, + Title = {The SOWFA Super-Controller: A High-Fidelity Tool for Evaluating Wind Plant Control Approaches}, + Year = {2013}} + +@misc{cpp-MPI-3.1, + Author = {MPI Forum}, + Month = {June}, + Note = {available at: http://www.mpi-forum.org (Jun. 2015)}, + Title = {MPI: A Message-Passing Interface Standard. Version 3.1}, + Year = {2015}} + +@misc{cpp-hdf5, + Author = {The HDF Group}, + Note = {http://www.hdfgroup.org/HDF5/}, + Title = {Hierarchical Data Format, version 5}, + Year = {1997}} diff --git a/docs/source/dev/cppapi/files/FAST_Prog.cpp b/docs/source/dev/cppapi/files/FAST_Prog.cpp new file mode 100644 index 0000000000..91a21447b8 --- /dev/null +++ b/docs/source/dev/cppapi/files/FAST_Prog.cpp @@ -0,0 +1,54 @@ +#include "OpenFAST.H" +#include "yaml-cpp/yaml.h" +#include +#include + +void readTurbineData(int iTurb, fast::fastInputs & fi, YAML::Node turbNode) { + //Read turbine data for a given turbine using the YAML node +} + +void readInputFile(fast::fastInputs & fi, std::string cInterfaceInputFile, double * tEnd) { + //Read input data for a given turbine using the YAML node +} + +int main() { + int iErr; + int nProcs; + int rank; + + iErr = MPI_Init(NULL, NULL); + iErr = MPI_Comm_size( MPI_COMM_WORLD, &nProcs); + iErr = MPI_Comm_rank( MPI_COMM_WORLD, &rank); + + double tEnd ; // This doesn't belong in the OpenFAST - C++ API + int ntEnd ; // This doesn't belong in the OpenFAST - C++ API + + std::string cDriverInputFile="cDriver.i"; + fast::OpenFAST FAST; + fast::fastInputs fi ; + readInputFile(fi, cDriverInputFile, &tEnd); + ntEnd = tEnd/fi.dtFAST; //Calculate the last time step + + FAST.setInputs(fi); + // In a parallel simulation, multiple turbines have to be allocated to processors. + // The C++ API can handle any allocation of turbines on an arbitrary number of processors + FAST.allocateTurbinesToProcsSimple(); // Use this for a simple round robin allocation of turbines to processors. + // Or allocate turbines to procs by calling "setTurbineProcNo(iTurbGlob, procId)" for each turbine. + + FAST.init(); + if (FAST.isTimeZero()) { + FAST.solution0(); + } + + if( !FAST.isDryRun() ) { + for (int nt = FAST.get_ntStart(); nt < ntEnd; nt++) { + FAST.step(); + } + } + + FAST.end() ; + MPI_Finalize() ; + + return 0; + +} diff --git a/docs/source/dev/cppapi/files/actuatorLine_illustrationViz.pdf b/docs/source/dev/cppapi/files/actuatorLine_illustrationViz.pdf new file mode 100644 index 0000000000..fbb1fd5b4b Binary files /dev/null and b/docs/source/dev/cppapi/files/actuatorLine_illustrationViz.pdf differ diff --git a/docs/source/dev/cppapi/files/actuatorLine_illustrationViz.png b/docs/source/dev/cppapi/files/actuatorLine_illustrationViz.png new file mode 100644 index 0000000000..3efc1e2598 Binary files /dev/null and b/docs/source/dev/cppapi/files/actuatorLine_illustrationViz.png differ diff --git a/docs/source/dev/cppapi/files/css_actuatorline.pdf b/docs/source/dev/cppapi/files/css_actuatorline.pdf new file mode 100644 index 0000000000..0e9e49ed5b Binary files /dev/null and b/docs/source/dev/cppapi/files/css_actuatorline.pdf differ diff --git a/docs/source/dev/cppapi/files/css_actuatorline.png b/docs/source/dev/cppapi/files/css_actuatorline.png new file mode 100644 index 0000000000..a7510287b2 Binary files /dev/null and b/docs/source/dev/cppapi/files/css_actuatorline.png differ diff --git a/docs/source/dev/cppapi/files/thrustXActuatorForcePoints.png b/docs/source/dev/cppapi/files/thrustXActuatorForcePoints.png new file mode 100644 index 0000000000..5bf845481b Binary files /dev/null and b/docs/source/dev/cppapi/files/thrustXActuatorForcePoints.png differ diff --git a/docs/source/dev/cppapi/files/torqueXActuatorForcePoints.png b/docs/source/dev/cppapi/files/torqueXActuatorForcePoints.png new file mode 100644 index 0000000000..fa751ad1be Binary files /dev/null and b/docs/source/dev/cppapi/files/torqueXActuatorForcePoints.png differ diff --git a/docs/source/dev/cppapi/index.rst b/docs/source/dev/cppapi/index.rst new file mode 100644 index 0000000000..85d7d6e698 --- /dev/null +++ b/docs/source/dev/cppapi/index.rst @@ -0,0 +1,219 @@ +.. _cppapi: + +OpenFAST C++ Application Programming Interface +============================================== + +OpenFAST provides a C++ application programming interface (API) to drive wind turbine simulations from an external program in C++. The C++ API was developed mainly to integrate OpenFAST with Computational Fluid Dynamics (CFD) solvers for Fluid-Structure Interaction (FSI) applications. It currently supports FSI simulations using the actuator line method with plans to support blade-resolved FSI simulations in the near future. The C++ API can also be used to create an external driver program or glue code that runs OpenFAST simulations of several wind turbines in parallel. + +The C++ API is defined and implemented in the :class:`~fast::OpenFAST` class. Any user who wants to write a glue-code for OpenFAST in C++ should instantiate an object of the OpenFAST class and use it to drive the simulation of turbines. A sample glue-code `FAST_Prog.cpp `_ is provided as a demonstration of the usage of the C++ API. The glue-code allows for the simulation of multiple turbines using OpenFAST in serial or in parallel over multiple processors. The message passing interface (MPI) is used to run the different instances of turbines in parallel. An abbrievated version of FAST_Prog.cpp is shown below. The highlighted lines indicate the use of the OpenFAST class. + +.. literalinclude:: files/FAST_Prog.cpp + :emphasize-lines: 1,27,28,32,36,38,40,45,49 + :language: C++ + +All inputs to the OpenFAST class are expected through an object of the :class:`fast::fastInputs`. + + +FIXME: **doxygenclass** is needed to render the :class:`fast::fastInputs` class structure + +.. + .. doxygenclass:: fast::fastInputs + :members: + :private-members: + :protected-members: + :undoc-members: + +The object of :class:`~fast::fastInputs` class is expected hold a struct vector of type :class:`~fast::turbineDataType` and size of the number of turbines in the simulation. + +FIXME: **doxygenstruct** is needed to render the :class:`fast::turbineDataType` class structure + +.. + .. doxygenstruct:: fast::turbineDataType + :members: + :private-members: + + +Use of C++ API for Actuator Line Simulations +-------------------------------------------- + +The C++ API was developed mainly to integrate OpenFAST with Computational Fluid Dynamics (CFD) solvers for Fluid-Structure Interaction (FSI) applications. The workhorse FSI algorithm for wind energy applications today is the Actuator Line algorithm :cite:`cpp-churchfield2012`. The Actuator Line algorithm represents the effect of a turbine on a flow field as a series of point forces at **actuator points** along aerodynamic surfaces. The use of Blade Element Momentum theory in AeroDyn is modified to interface OpenFAST with CFD solvers for actuator line simulations. The CFD solver becomes the inflow module for OpenFAST that provides velocity information near the turbine. The calculation of the induction factors is turned off in OpenFAST and AeroDyn simply uses look up tables and an optional dynamic stall model to calculate the loads on the turbine based on the inflow field information received from the CFD solver. The induction model should be turned off in OpenFAST by selecting :samp:`WakeMod=0` in the AeroDyn input file. OpenFAST lumps the line forces along the blades and tower into a series of point forces for the actuator line algorithm. :numref:`actuatorline-viz` illustrates the transfer of information between OpenFAST and a CFD solver for actuator line applications. + +.. _actuatorline-viz: + +.. figure:: files/actuatorLine_illustrationViz.png + :align: center + :width: 100% + + Illustration of transfer of velocity, loads and deflection between a CFD solver and OpenFAST through the C++ API for actuator line applications. + +The CFD solver is expected to be the *driver program* for actuator line FSI simulations coupled to OpenFAST. The C++ API allows for *substepping* where the driver timestep is an integral multiple of the OpenFAST time step (:math:`\Delta_t^{CFD} = n \Delta_t^{OpenFAST}`). The current implementation of the C++ API for OpenFAST allows for a serial staggered FSI scheme between the fluid (CFD) and structural (OpenFAST) solver. :numref:`actuatorline-css` shows a suggested implementation of a loosely coupled serial staggered FSI scheme to move the simulation from time step `n` to `n+1` for actuator line applications. A strongly coupled FSI scheme can be constructed through the repetition of the coupling algorithm in :numref:`actuatorline-css` through "outer" iterations. + +.. _actuatorline-css: + +.. figure:: files/css_actuatorline.png + :align: center + :width: 100% + + A conventional serial staggered FSI scheme that can be constructed through the C++ API for actuator line applications. + + +OpenFAST uses different spatial meshes for the various modules :cite:`cpp-fastv8ModFramework`. We define the actuator points to be along the mesh defined in the structural model (ElastoDyn/BeamDyn) of the turbine. The user defines the required number of actuator points along each blade and the tower through the input parameters :samp:`numForcePtsBlade` and :samp:`numForcePtsTower` for each turbine. The number of actuator points have to be the same on all blades. The C++ API uses OpenFAST to create the requested number of actuator points through linear interpolation of the nodes in the structural model. The mesh mapping algorithm in OpenFAST :cite:`cpp-fastv8AlgorithmsExamples` is used to transfer deflections from the structural model and loads from AeroDyn to the actuator points. To distinguish the *actuator points* from the Aerodyn points, the OpenFAST C++ uses the term :samp:`forceNodes` for the actuator points and :samp:`velNodes` (velocity nodes) for the Aerodyn points. The following piece of code illustrates how one can use the C++ API to implement a strongly coupled FSI scheme with "outer" iterations for actuator line applications. This sample piece of code sets the velocity at the :samp:`velNodes` and access the coordinates and the lumped forces at the :samp:`forceNodes`. + +.. code-block:: c++ + + std::vector currentCoords(3); + std::vector sampleVel(3); + + for (int iOuter=0; iOuter < nOuterIterations; iOuter++) { + + FAST.predict_states(); //Predict the location and force at the actuator points at time step 'n+1'. + + for(iTurb=0; iTurb < nTurbines; iTurb++) { + for(int i=0; i < FAST.get_numVelPts(iTurb); i++) { + // Get actuator node co-ordinates at time step 'n+1' + FAST.getForceNodeCoordinates(currentCoords, i, iTurb, fast::np1); + //Move the actuator point to this co-ordinate if necessary + // Get force at actuator node at time step 'n+1' + FAST.getForce(actForce, i, iTurb, fast::np1); + //Do something with this force + } + } + + // Predict CFD solver to next time step here + + for(iTurb=0; iTurb < nTurbines; iTurb++) { + for(int i=0; i < FAST.get_numVelPts(iTurb); i++) { + // Get velocity node co-ordinates at time step 'n+1' + FAST.getVelNodeCoordinates(currentCoords, i, iTurb, fast::np1); + //Sample velocity from CFD solver at currentCoords into sampleVel here + // Set velocity at the velocity nodes at time step 'n+1' + FAST.setVelocity(sampleVel, i, iTurb, fast::np1); + } + } + + FAST.update_states_driver_time_step(); // Predict the state of OpenFAST at the next time step + + } + + // Move OpenFAST to next CFD time step + FAST.advance_to_next_driver_time_step(); + +.. toctree:: + :maxdepth: 1 + + api.rst + + +Implementation +-------------- + +The C++ API uses the C-Fortran interface to call the same functions as the Fortran driver internally to advance the OpenFAST in time. FAST_Library.f90 contains all the functions that can be called from the C++ API. Some of the corresponding functions between the C++ API and the Fortran module are shown in the following table. + +.. table:: + + +------------------------------------+---------------------------------+-------------------------------+ + | C++ API - OpenFAST.cpp | Fortran - FAST_Library.f90 | FAST_Subs.f90 | + +====================================+=================================+===============================+ + | init() | FAST_AL_CFD_Init | FAST_InitializeAll_T | + +------------------------------------+---------------------------------+-------------------------------+ + | solution0() | FAST_CFD_Solution0 | FAST_Solution0_T | + +------------------------------------+---------------------------------+-------------------------------+ + | prework() | FAST_CFD_Prework | FAST_Prework_T | + +------------------------------------+---------------------------------+-------------------------------+ + | | FAST_CFD_Store_SS | FAST_Store_SS | + +------------------------------------+---------------------------------+-------------------------------+ + | update_states_driver_time_step() | FAST_CFD_UpdateStates | FAST_UpdateStates_T | + +------------------------------------+---------------------------------+-------------------------------+ + | | FAST_CFD_Reset_SS | FAST_Reset_SS | + +------------------------------------+---------------------------------+-------------------------------+ + | advance_to_next_driver_time_step() | FAST_CFD_AdvanceToNextTimeStep | FAST_AdvanceToNextTimeStep_T | + +------------------------------------+---------------------------------+-------------------------------+ + +The `FAST_Solution_T` subroutine in `FAST_Subs.f90` is split into three different subroutines `FAST_Prework_T`, `FAST_UpdateStates_T` and `FAST_AdvanceToNextTimeStep_T` to allow for multiple *outer* iterations with external driver programs. Extra subroutines `FAST_Store_SS` and `FAST_Reset_SS` are introduced to move OpenFAST back by more than 1 time step when using *sub-stepping* with external driver programs. The typical order in which the Fortran subroutines will be accessed when using the C++ API from an external driver program is shown below. + +.. code-block:: fortran + + call FAST_AL_CFD_Init + + call FAST_CFD_Solution0 + + do i=1, nTimesteps + + if (nSubsteps .gt. 1) + call FAST_CFD_Store_SS + else + call FAST_CFD_Prework + end if + + do iOuter=1, nOuterIterations + + if (nSubsteps .gt. 1) + + if (iOuter .ne. 1) then + ! Reset OpenFAST back when not the first pass + call FAST_CFD_Reset_SS + + end if + + do j=1, nSubsteps + + ! Set external inputs into modules here for the substep + call FAST_CFD_Prework + call FAST_CFD_UpdateStates + call FAST_CFD_AdvanceToNextTimeStep + + end do !Substeps + + else + + call FAST_CFD_UpdateStates + + end if + + end do !Outer iterations + + if (nSubsteps .gt. 1) then + + ! Nothing to do here + + else + + call FAST_CFD_AdvanceToNextTimeStep + + end if + + end do + + + +The mapping of loads and deflections to the actuator points is performed in the :class:`ExternalInflow` module in OpenFAST. The C++ API supports the use of both BeamDyn and ElastoDyn to model the blades. When using BeamDyn to model the blade, the C++ API requires the use of only 1 finite element for each blade along with the choice of trapezoidal quadrature for actuator line simulations. + +Test for mapping procedure +-------------------------- + +The test for the implementation of the mapping procedure is as follows. OpenFAST is run using the C++ API to simulate the NREL-5MW turbine for one time step with a prescribed velocity of :math:`8 m/s` at all the velocity nodes and no induction (:samp:`WakeMod=0`). The number of actuator force nodes is varied from 10 to 100 while the number of velocity nodes is fixed at 17. :numref:`actuator-force-nodes-mapping-test-thrust` and :numref:`actuator-force-nodes-mapping-test-torque` show that the thrust and torque vary by less than :math:`1.1 \times 10^{-6}\%` and :math:`2 \times 10^{-6}\%` respectively when the number of actuator force nodes is varied from :math:`10-100`. + + +.. _actuator-force-nodes-mapping-test-thrust: + +.. figure:: files/thrustXActuatorForcePoints.png + :align: center + :width: 100% + + Variation of thrust using different number of actuator force nodes in `OpenFAST` for the same number of velocity nodes. + +.. _actuator-force-nodes-mapping-test-torque: + +.. figure:: files/torqueXActuatorForcePoints.png + :align: center + :width: 100% + + Variation of torque using different number of actuator force nodes in `OpenFAST` for the same number of velocity nodes. + + + +References +---------- + +.. bibliography:: bibliography.bib + :labelprefix: cpp- diff --git a/docs/source/dev/index.rst b/docs/source/dev/index.rst index a10aced968..dd833c8ef6 100644 --- a/docs/source/dev/index.rst +++ b/docs/source/dev/index.rst @@ -253,6 +253,17 @@ be found in the following pages: - `Index of Types <../../html/classes.html>`_ - `Source Files <../../html/files.html>`_ +C++ API Reference +~~~~~~~~~~~~~~~~~~~ +C++ API documentation is available. + +.. toctree:: + :maxdepth: 1 + + cppapi/index.rst + + + Other Documentation ~~~~~~~~~~~~~~~~~~~ Additional documentation exists that may be useful for developers seeking deeper diff --git a/docs/source/install/index.rst b/docs/source/install/index.rst index b394ed808d..6bd5b81ab6 100644 --- a/docs/source/install/index.rst +++ b/docs/source/install/index.rst @@ -217,17 +217,29 @@ You can also build your own custom images using our `Dockerfile` or base your im Install the ``openfast_io`` python wrapper ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The ``openfast_io`` python package is a wrapper comprising readers and writers for converting OpenFAST files to/from -python objects. You can install it with: +python objects. -.. code-block:: +To use `openfast_io` as a library for incorporation into other scripts or tools, it is available via (assuming that you have already setup your python environment): + +.. code-block:: bash pip install openfast_io -or +These instructions are for interaction directly with the `openfast_io` source code. + +1. Follow this step only if you have not cloned the OpenFAST repo: + +.. code-block:: bash + + git clone https://github.com/OpenFAST/OpenFAST.git + cd OpenFAST -.. code-block:: +2. Assuming you are within the OpenFAST directory: + +.. code-block:: bash - poetry add openfast_io + cd openfast_io + pip install -e . For more information and installation options, see the `OpenFAST Python readme `_. diff --git a/docs/source/testing/regression_test.rst b/docs/source/testing/regression_test.rst index 8af9408a97..0e975b055d 100644 --- a/docs/source/testing/regression_test.rst +++ b/docs/source/testing/regression_test.rst @@ -40,6 +40,7 @@ configuration as described in the following sections. In both modes of execution a directory is created in the build directory called ``reg_tests`` where all of the input files for the test cases are copied +(but not overwritten) and all of the locally generated outputs are stored. Ultimately, both CTest and the manual execution program call a series of Python scripts and libraries in ``reg_tests`` and ``reg_tests/lib``. One such script is ``lib/pass_fail.py`` @@ -223,11 +224,11 @@ Flags can be compounded making useful variations such as .. code-block:: bash - # Run all cases that use AeroDyn14 with verbose output - ctest -V -L aerodyn14 + # Run all cases that use SubDyn with verbose output + ctest -V -L subdyn - # Run all cases that use AeroDyn14 in 16 concurrent processes - ctest -j 16 -L aerodyn14 + # Run all cases that use SubDyn in 16 concurrent processes + ctest -j 16 -L subdyn # Run the case with name "5MW_DLL_Potential_WTurb" with verbose output ctest -V -R 5MW_DLL_Potential_WTurb diff --git a/docs/source/testing/unit_test.rst b/docs/source/testing/unit_test.rst index 314cc04466..0b3cb15a0a 100644 --- a/docs/source/testing/unit_test.rst +++ b/docs/source/testing/unit_test.rst @@ -8,10 +8,8 @@ tests. Through robust testing practices, the entire OpenFAST community can understand the intention behind code blocks and debug or expand functionality quicker and with more confidence and stability. -Unit testing in OpenFAST modules is accomplished through `pFUnit `__. -This framework provides a Fortran abstraction to the popular -`xUnit `__ structure. pFUnit is compiled -along with OpenFAST through CMake when the CMake variable ``BUILD_TESTING`` is +Unit testing in OpenFAST modules is accomplished through `test-drive `__. +test-drive is compiled along with OpenFAST through CMake when the CMake variable ``BUILD_TESTING`` is turned on (default off) and the CMake variable ``BUILD_UNIT_TESTING`` is on (turned on by default when ``BUILD_TEST`` is on). @@ -22,9 +20,8 @@ Dependencies ------------ The following packages are required for unit testing: -- Python 3.7+, <3.12 - CMake -- pFUnit - Included in OpenFAST repo through a git-submodule +- test-drive - Included in OpenFAST repo in unit_test/test-drive Compiling --------- @@ -39,7 +36,7 @@ framework named ``[module]_utest``. Then, ``make`` the target to test: make beamdyn_utest This creates a unit test executable at -``openfast/build/unit_tests/beamdyn/beamdyn_utest``. +``openfast/build/unit_tests/beamdyn_utest``. Executing --------- @@ -47,43 +44,34 @@ To execute a module's unit test, simply run the unit test binary. For example: .. code-block:: bash - >>>$ ./openfast/build/unit_tests/beamdyn/beamdyn_utest - ............. - Time: 0.018 seconds + >>>$ ./openfast/build/unit_tests/beamdyn_utest + All tests PASSED - OK - (14 tests) - -pFUnit will display a ``.`` for each unit test successfully completed -and a ``F`` for each failing test. If any tests do fail, the failure -criteria will be displayed listing which particular value caused -the failure. Failure cases display the following output: +the pass or fail status is provided for each test as it's run. An error message is output when the test fails. +Failure cases display the following output: .. code-block:: bash - >>>$ ./unit_tests/beamdyn/beamdyn_utest - .....F....... - Time: 0.008 seconds - - Failure - in: - test_BD_CrvMatrixH_suite.test_BD_CrvMatrixH - Location: - [test_BD_CrvMatrixH.F90:48] - simple rotation with known parameters: Pi on xaxis expected +0.5000000 but found: +0.4554637; difference: |+0.4453627E-01| > tolerance:+0.1000000E-13; first difference at element [1, 1]. - - FAILURES!!! - Tests run: 13, Failures: 1, Errors: 0 + >>>$ ./unit_tests/beamdyn_utest + # Testing: Crv + Starting test_BD_CheckRotMat ... (1/6) + ... test_BD_CheckRotMat [PASSED] + Starting test_BD_ComputeIniNodalCrv ... (2/6) + ... test_BD_ComputeIniNodalCrv [PASSED] + Starting test_BD_CrvCompose ... (3/6) + ... test_BD_CrvCompose [PASSED] + Starting test_BD_CrvExtractCrv ... (4/6) + ... test_BD_CrvExtractCrv [PASSED] + Starting test_BD_CrvMatrixH ... (5/6) + [Fatal] Uncaught error + Code: 1 Message: A(1,1) simple rotation with known parameters: Pi on xaxis: Note: The following floating-point exceptions are signalling: IEEE_INVALID_FLAG IEEE_DIVIDE_BY_ZERO - ERROR STOP *** Encountered 1 or more failures/errors during testing. *** + ERROR STOP Error termination. Backtrace: - #0 0x1073b958c - #1 0x1073ba295 - #2 0x1073bb1b6 - #3 0x106ecdd4f - #4 0x1063fabee - #5 0x10706691e + #0 0xffff9f70d08b in ??? + #1 0xffff9f70ddb3 in ??? + #2 0xffff9f70f333 in ??? Adding unit tests ----------------- @@ -104,31 +92,22 @@ structured as │ ├── SampleDyn.f90 │ └── SampleDyn_Subs.f90 └── tests/ - ├── test_SampleDyn_Subroutine1.F90 - ├── test_SampleDyn_Subroutine2.F90 - └── test_SampleDyn_Subroutine3.F90 - -Each unit test must be contained in a unique file called -``test_[SUBROUTINE].F90`` where ``[SUBROUTINE]`` is the code block being -tested. The new files should contain a Fortran `module` which itself -contains a Fortran `subroutine` for each specific test case. Generally, -multiple tests will be required to fully test one subroutine. - -Finally, update the CMake configuration for building a module's unit -test executable by copying an existing unit test CMake configuration -into a new module directory: - -.. code-block:: bash - - cp -r openfast/unit_tests/beamdyn openfast/unit_tests/[module] - -Then, modify the new ``CMakeLists.txt`` with the appropriate list of test -subroutines and module name variables. - -For reference, a template unit test file is included at -``openfast/unit_tests/test_SUBROUTINE.F90``. Each unit test should fully test -the target code block. If full test coverage is not easily achievable, it may -be an indication that refactoring would be beneficial. + ├── sampledyn_utest.F90 + ├── test_SampleDyn_Feature1.F90 + ├── test_SampleDyn_Feature2.F90 + └── test_SampleDyn_Feature3.F90 + +Each unit test file must contain a module that exports a function which populates +a list of unit tests in accordance with the ``test-drive`` documentation. These modules +contain subroutines which take an ``error`` argument that is populated by the ``check`` +subroutine provided by ``test-drive``. The ``sampledyn_utest.F90`` collects all of the +unit tests lists from the adjacent modules and runs them. These programs are compiled +via the ``unit_tests/CMakeLists.txt`` file so all relevant modules and programs are +specified there. + +Refer to existing unit tests for the ``BeamDyn`` or ``NWTC Library`` unit tests for examples +of how to structure and build the unit test drivers. Also review the ``test-drive`` documentation at +`test-drive `__. Some useful topics to consider when developing and testing for OpenFAST are: diff --git a/docs/source/user/aerodisk/index.rst b/docs/source/user/aerodisk/index.rst new file mode 100644 index 0000000000..816a0cd27b --- /dev/null +++ b/docs/source/user/aerodisk/index.rst @@ -0,0 +1,19 @@ +.. _ADsk: + +AeroDisk +======== + + +This document describes the AeroDisk (ADsk) module. + + +.. only:: html + + +.. toctree:: + :maxdepth: 2 + + input_files.rst + +.. + zrefs.rst diff --git a/docs/source/user/aerodisk/input_files.rst b/docs/source/user/aerodisk/input_files.rst new file mode 100644 index 0000000000..7cd1593c0c --- /dev/null +++ b/docs/source/user/aerodisk/input_files.rst @@ -0,0 +1,165 @@ +.. _adsk_input-files: + +Input and Output Files +====================== + + +Units +----- + +AeroDisk uses the SI system (kg, m, s, N). + +.. _adsk_input-file: + +Input file +---------- + +The AeroDisk input file defines the general inputs required for the actuator +disk calculations. The following inputs may be changed by the user to achieve +the desired behaviour. + +Simulation Control +~~~~~~~~~~~~~~~~~~ + +**echo** [switch] + + Write the input file contents to a file .ADsk.ech. This is useful + for diagnosing errors reported about the input file. + +**DT** [seconds] + + Integration time step for AeroDisk to use, or _"default"_ to use the glue code + time step. + +Environmental Conditions +~~~~~~~~~~~~~~~~~~~~~~~~ + +**AirDens** [kg/m^3] + + Air density, or _"default"_ to use the air density from the glue code + +Actuator Disk Properties +~~~~~~~~~~~~~~~~~~~~~~~~ + +**RotorRad** [m] + + Radius of the rotor, or _"default"_ to use the value passed from the glue + code + +The lookup table for the disk actuator forces and moments follows. The data in +this table is flexible as it allows for a very simple lookup based on a single +variable (**TSR** for example), or up to four variables. The last six columns +of the table must include the six force and moment coefficients that correspond +to a set of conditions given in the first set of columns. + +**InColNames** [-] + + Comma separated List of column names corresponding to the variable columns in + the input file. See below for options. + +**InColDims** [-] + + Comma separted list of the number unique entries for each of the named + variable column names. The number of rows in the table must be equal to the + product of all numbers given. Must be the same number of entries as given in + **InColNames** + + +For the input variable columns in the table, at least one column must be given, +with a maximum of four of the five listed below (**TSR** and **RtSpd** are +mutually exclusive). + +**TSR** [-] + + Tip Speed Ratio, cannot be used with _RtSpd_ + +**RtSpd** [rpm] + + Rotor speed, cannot be used with _TSR_ + +**VRel** [m/s] + + Relative velocity of wind normal to rotor + +**Pitch** [deg] + + Collective blade pitch + +**Skew** [deg] + + Skew angle of inflow. If this is not provided, the affect of skew is modeled + as :math:`(cos(\chi))^2` + + +The remaining six columns of the table must contain the force and moment +coefficents. See the example table below. + + + +Sample input file +~~~~~~~~~~~~~~~~~ + +Note that the table given below is for illustration of the format and does not +represent any particular turbine. + +.. code:: + + --- AERO DISK INPUT FILE ------- + Sample actuator disk input file + --- SIMULATION CONTROL --------- + FALSE echo - Echo input data to ".ADsk.ech" (flag) + "default" DT - Integration time step (s) + --- ENVIRONMENTAL CONDITIONS --- + 1.225 AirDens - Air density (kg/m^3) (or "default") + --- ACTUATOR DISK PROPERTIES --- + 63.0 RotorRad - Rotor radius (m) (or "default") + "RtSpd,VRel" InColNames - Input column headers (string) {may include a combination of "TSR, RtSpd, VRel, Pitch, Skew"} (up to 4 columns) [choose TSR or RtSpd,VRel; if Skew is absent, Skew is modeled as (COS(Skew))^2] + 9,2 InColDims - Number of unique values in each column (-) (must have same number of columns as InColName) [each >=2] + RtSpd VRel C_Fx C_Fy C_Fz C_Mx C_My C_Mz + (rpm) (m/s) (-) (-) (-) (-) (-) (-) + 3.0 9.0 0.2347 0.0 0.0 0.0306 0.0 0.0 + 4.0 9.0 0.2349 0.0 0.0 0.0314 0.0 0.0 + 5.0 9.0 0.2350 0.0 0.0 0.0322 0.0 0.0 + 6.0 9.0 0.2351 0.0 0.0 0.0330 0.0 0.0 + 7.0 9.0 0.2352 0.0 0.0 0.0338 0.0 0.0 + 8.0 9.0 0.2352 0.0 0.0 0.0346 0.0 0.0 + 9.0 9.0 0.2351 0.0 0.0 0.0353 0.0 0.0 + 10.0 9.0 0.2350 0.0 0.0 0.0361 0.0 0.0 + 11.0 9.0 0.2349 0.0 0.0 0.0368 0.0 0.0 + 3.0 12.0 0.7837 0.0 0.0 0.0663 0.0 0.0 + 4.0 12.0 0.7733 0.0 0.0 0.0663 0.0 0.0 + 5.0 12.0 0.7628 0.0 0.0 0.0663 0.0 0.0 + 6.0 12.0 0.7520 0.0 0.0 0.0662 0.0 0.0 + 7.0 12.0 0.7409 0.0 0.0 0.0660 0.0 0.0 + 8.0 12.0 0.7297 0.0 0.0 0.0658 0.0 0.0 + 9.0 12.0 0.7182 0.0 0.0 0.0656 0.0 0.0 + 10.0 12.0 0.7066 0.0 0.0 0.0653 0.0 0.0 + 11.0 12.0 0.6947 0.0 0.0 0.0649 0.0 0.0 + --- OUTPUTS -------------------- + OutList - The next line(s) contains a list of output parameters. See OutListParameters.xlsx for a listing of available output channels, (-) + END of input file (the word "END" must appear in the first 3 columns of this last OutList line) + -------------------------------- + + + + + + +.. _adsk_outputs: + +Outputs +------- + +The write outputs are: + - "ADSpeed": Actuator disk rotational speed (rpm) + - "ADTSR": Actuator disk tip-speed ratio (-) + - "ADPitch": Actuator-disk collective blade-pitch angle (deg) + - "ADVWindx, ADVWindy, ADVWindz": Actuator-disk-averaged wind velocity in the local coordinate system (m/s) + - "ADSTVx, ADSTVy, ADSTVz": Actuator-disk structural translational velocity in the local coordinate system (m/s) + - "ADVRel": Actuator-disk-averaged relative wind speed (m/s) + - "ADSkew": Actuator-disk inflow-skew angle (deg) + - "ADCp, ADCt, ADCq": Actuator-disk power, thrust, and torque coefficients (-) + - "ADFx, ADFy, ADFz": Actuator disk aerodynamic force loads in the local coordinate system (N) + - "ADMx, ADMy, ADMz": Actuator disk aerodynamic moment loads in the local coordinate system (N-m) + - "ADPower": Actuator disk power (W) + diff --git a/docs/source/user/aerodyn-aeroacoustics/02-noise-models.rst b/docs/source/user/aerodyn-aeroacoustics/02-noise-models.rst index 56f7faf9e5..8422a63b62 100644 --- a/docs/source/user/aerodyn-aeroacoustics/02-noise-models.rst +++ b/docs/source/user/aerodyn-aeroacoustics/02-noise-models.rst @@ -151,8 +151,8 @@ The formulations of :math:`{\overline{D}}_{h}\ `\ and :math:`{\overline{D}}_{l}` are presented in :numref:`aa-directivity`. The current implementation offers two approaches to estimate -:math:`I_{1}`. The first one is through a user-defined grid of -:math:`I_{1}`; see :numref:`aa-sec-TIgrid`. The second option is to have the code +:math:`I_{1}`. The first one is through a user-defined :math:`I_{1}`. +The second option is to have the code reconstructing :math:`I_{1}` from the turbulent wind grid, where the code computes the airfoil relative position of each blade section, :math:`i`, at every time instant and, given the rotor speed, diff --git a/docs/source/user/aerodyn-aeroacoustics/App-usage.rst b/docs/source/user/aerodyn-aeroacoustics/App-usage.rst index d442d13001..7d9394bed5 100644 --- a/docs/source/user/aerodyn-aeroacoustics/App-usage.rst +++ b/docs/source/user/aerodyn-aeroacoustics/App-usage.rst @@ -5,7 +5,7 @@ Using the Aeroacoustics Model in AeroDyn A live version of this documentation is available at https://openfast.readthedocs.io/. To run the aeroacoustics model, the -flag **CompAA** needs to be set to **True** at line 14 of the AeroDyn15 main +flag **CompAA** needs to be set to **True** at line 14 of the AeroDyn main input file in the inputs block **General Options**. When the flag is set to **True**, the following line must include the name of the file containing the inputs to the aeroacoustics model, which is discussed in @@ -14,9 +14,9 @@ turbine. .. container:: - :name: aa-tab:AD15 + :name: aa-tab:AeroDyn - .. literalinclude:: example/AD15.ipt + .. literalinclude:: example/AeroDyn.ipt :linenos: :language: none @@ -56,12 +56,14 @@ models: - **TICalcMeth** – Integer 1/2: flag to set the calculation method for the incident turbulence intensity. When set to 1, incident turbulence intensity is - defined in a user-defined grid; see :numref:`aa-sec-TIgrid`. When set to - 2, incident turbulence intensity is estimated from the time history of the - incident flow. + user-defined. When set to 2, incident turbulence intensity is + estimated from the time history of the incident flow. -- **TICalcTabFile** – String: name of the text file with the user-defined - turbulence intensity grid; see :numref:`aa-sec-TIgrid`. +- **TI** – Float: user-defined value of :math:`TI`, which is the rotor-incident + turbulence intensity used in the Amiet model. + +- **avgV** – Float: value of the average wind speed used to scale :math:`TI` + and convert it to a blade section incident turbulence intensity. - **Lturb** – Float: value of :math:`L_{turb}` used to estimate the turbulent lengthscale used in the Amiet model. @@ -255,32 +257,5 @@ is shown here: :language: none -.. _aa-sec-TIgrid: - -Turbulence Grid ---------------- - -When the flag **TICalcMeth** is set equal to 1, the grid of turbulence -intensity of the wind :math:`TI` must be defined by the user. This is -done by creating a file called **TIGrid_In.txt**, which mimics a TurbSim -output file and contains a grid of turbulence intensity, which is -defined as a fraction value. The file defines a grid centered at hub -height and oriented with the OpenFAST global inertial frame coordinate -system; see :numref:`aa-fig:ObsRefSys`. A user-defined number of lateral and vertical -points equally spaced by a user-defined number of meters must be -specified. Note that an average wind speed must be defined to convert -the turbulence intensity of the wind to the incident turbulent intensity :math:`I_{1}`. -An example file for a 160 (lateral) by 180 (vertical) meters -grid looks like the following: - - -.. container:: - :name: aa-tab:TIgrid - - .. literalinclude:: example/TIGrid.txt - :linenos: - :language: none - - .. [4] https://github.com/OpenFAST/python-toolbox diff --git a/docs/source/user/aerodyn-aeroacoustics/example/AeroAcousticsInput.dat b/docs/source/user/aerodyn-aeroacoustics/example/AeroAcousticsInput.dat index eebaa51625..4a2bae7582 100644 --- a/docs/source/user/aerodyn-aeroacoustics/example/AeroAcousticsInput.dat +++ b/docs/source/user/aerodyn-aeroacoustics/example/AeroAcousticsInput.dat @@ -8,8 +8,9 @@ False Echo - Echo the input to ".AD.NN.ech"? (flag) ====== Aeroacoustic Models ============================================================================ 2 TIMod - Turbulent Inflow noise model {0: none, 1: Amiet 2: Amiet + Simplified Guidati} (switch) 1 TICalcMeth - Method to estimate turbulence intensity incident to the profile {1: given table, 2: computed on the fly} (switch) [Only used if TIMod!=0] -"TIGrid_InVerify.txt" TICalcTabFile - Name of the file containing the table for incident turbulence intensity (-) [Only used if TiCalcMeth == 1] -0.5 SurfRoughness- Surface roughness value used to estimate the turbulent length scale in Amiet model (m) +0.1 TI - Rotor-incident wind turbulence intensity (-) [Only used if TiCalcMeth == 1] +8 avgV - Average wind speed used to compute the section-incident turbulence intensity (m/s) [Only used if TiCalcMeth == 1] +40 Lturb - Turbulent length scale in Amiet model (m) [Only used if TIMod!=0] 1 TBLTEMod - Turbulent Boundary Layer-Trailing Edge noise calculation {0: none, 1:BPM, 2: TNO} (switch) 1 BLMod - Calculation method for boundary layer properties, {1: BPM, 2: Pretabulated} (switch) 1 TripMod - Boundary layer trip model {0:no trip, 1: heavy trip, 2: light trip} (switch) [Only used if BLMod=1] @@ -18,9 +19,6 @@ False Echo - Echo the input to ".AD.NN.ech"? (flag) True RoundedTip - Logical indicating rounded tip (flag) [Only used if TipMod=1] 1.0 Alprat - Tip lift curve slope (Default = 1.0) [Only used if TipMod=1] 0 BluntMod - Trailing-edge-bluntness – Vortex-shedding model {0:none, 1: BPM} (switch) -"AABlade1.dat" AABlFile(1) - Name of file containing distributed aerodynamic properties for Blade #1 (-) -"AABlade1.dat" AABlFile(2) - Name of file containing distributed aerodynamic properties for Blade #2 (-) -"AABlade1.dat" AABlFile(3) - Name of file containing distributed aerodynamic properties for Blade #3 (-) ====== Observer Input =================================================================== "AA_ObserverLocations.dat" ObserverLocations - Name of file containing all observer locations X Y Z (-) ====== Outputs ==================================================================================== diff --git a/docs/source/user/aerodyn-aeroacoustics/example/AD15.ipt b/docs/source/user/aerodyn-aeroacoustics/example/AeroDyn.ipt similarity index 95% rename from docs/source/user/aerodyn-aeroacoustics/example/AD15.ipt rename to docs/source/user/aerodyn-aeroacoustics/example/AeroDyn.ipt index 57c3752e01..a7a30ffc94 100644 --- a/docs/source/user/aerodyn-aeroacoustics/example/AD15.ipt +++ b/docs/source/user/aerodyn-aeroacoustics/example/AeroDyn.ipt @@ -11,6 +11,7 @@ False TwrAero - Calculate tower aerodynamic loads? (flag) False FrozenWake - Assume frozen wake during linearization? (flag False CavitCheck - Perform cavitation check? (flag) False Buoyancy - Include buoyancy effects? (flag) +False NacelleDrag - Include Nacelle Drag effects? (flag) True CompAA - Flag to compute AeroAcoustics calculation "AeroAcousticsInput.dat" AA_InputFile ====== Environmental Conditions ========================================== diff --git a/docs/source/user/aerodyn-aeroacoustics/example/TIGrid.txt b/docs/source/user/aerodyn-aeroacoustics/example/TIGrid.txt deleted file mode 100644 index 4f01c54833..0000000000 --- a/docs/source/user/aerodyn-aeroacoustics/example/TIGrid.txt +++ /dev/null @@ -1,13 +0,0 @@ -Average Inflow Wind Speed -8.0 -Total Grid points In Y (lateral), Starts from - radius goes to + radius+ -4 -Total Grid points In Z (vertical), Starts from bottom tip (hub-radius) -3 -Grid spacing In Y (lateral) -40 -Grid spacing In Z (vertical) -60 -0.1200 0.1200 0.1200 0.1200 -0.1100 0.1100 0.1100 0.1100 -0.1000 0.1000 0.1000 0.1000 diff --git a/docs/source/user/aerodyn-dynamicStall/examples/UA-driver-timeseries.dat b/docs/source/user/aerodyn-dynamicStall/examples/UA-driver-timeseries.dat deleted file mode 100644 index 902354a4db..0000000000 --- a/docs/source/user/aerodyn-dynamicStall/examples/UA-driver-timeseries.dat +++ /dev/null @@ -1,11 +0,0 @@ -Example Time-Series Input File for UnsteadyAero Driver - - -This file has 8 header lines followed by three columns of data: - - -Time Angle of Attack VRel omega -(s) (deg) (m/s) (rad/s) -0.0 0 10 0 -0.01 0 10 0 -0.02 0 10 0 diff --git a/docs/source/user/aerodyn-dynamicStall/examples/UA-driver.dvr b/docs/source/user/aerodyn-dynamicStall/examples/UA-driver.dvr deleted file mode 100644 index 290e7e2245..0000000000 --- a/docs/source/user/aerodyn-dynamicStall/examples/UA-driver.dvr +++ /dev/null @@ -1,28 +0,0 @@ -UnsteadyAero Driver file for Unit NACA. k = 0.077 -------------------------------------------------------------------------------- -FALSE Echo - Echo the input file data (flag) ----------------------- ENVIRONMENTAL CONDITIONS ------------------------------- - 340.29 SpdSound - Speed of sound (m/s) ----------------------- UNSTEADYAERO ------------------------------------------- -"05014051_NACA" OutRootName - The name which prefixes all UnsteadyAero generated files (quoted string) - 40.36 InflowVel - Inflow velocity (m/s) - 1.48 Re - Reynolds number in millions (-) - 3 UAMod - Unsteady Aero Model Switch: 2 - Gonzalez’s variant (changes in Cn,Cc,Cm); 3 - Minnema/Pierce variant (changes in Cc and Cm) -TRUE Flookup – Flag to indicate whether a lookup for f’ will be calculated (TRUE) or whether best-fit exponential equations will be used (FALSE); if FALSE S1-S4 must be provided in airfoil input files -------------------- AIRFOIL PROPERTIES ---------------------------------------- -"05000051_AD15.dat" AirFoil - Airfoil table - 0.55 Chord - Chord length (m) -TRUE UseCm - Use Cm data in airfoil table -------------------- SIMULATION CONTROL ---------------------------------------- - 1 SimMod - Simulation model [ 1 - use reduced frequency model, 2 - use time series data stored in the TimeInputs file and ignore the remaining parameters ] - 3 NCycles - Number of angle-of-attack oscillations (cosine function) over the length of the simulation (-) - 720 StepsPerCycle - Number of timesteps per cycle (-) - 1.8 Frequency - Frequency for the airfoil oscillations (Hz) - 9.685 Amplitude - Amplitude of the oscillations (deg) - 15.195 Mean - Cycle mean (deg) - -180 Phase - Initial phase (num steps) -"UA-driver-timeseries.dat" InputsFile - Time series data in an ASCII input file (whitespace-separated data). 8 header lines, followed by column data. First column is time (sec), second column is angle-of-attack (deg), third column is InflowVel (m/s) -------------------- OUTPUT CONTROL -------------------------------------------- -True SumPrint - Write unsteady aerodynamics summary file (flag) -True WrAFITables - Write the tables of aerodynamic coefficients used internally, with extension ".Coeff.out" (flag) -END of driver input file diff --git a/docs/source/user/aerodyn-olaf/AppendixC.rst b/docs/source/user/aerodyn-olaf/AppendixC.rst index 66613d90b7..4066c8d3de 100644 --- a/docs/source/user/aerodyn-olaf/AppendixC.rst +++ b/docs/source/user/aerodyn-olaf/AppendixC.rst @@ -5,7 +5,7 @@ Appendix C: OLAF List of Output Channels This is a list of all possible output parameters from the OLAF module. The names are grouped by meaning, but can be ordered in the OUTPUTS -section of the *AeroDyn15* primary input file, as the user sees fit. +section of the *AeroDyn* primary input file, as the user sees fit. :math:`N\beta` refers to output node, :math:`\beta`, where :math:`\beta` is a number in the range [1,9], corresponding to entry, :math:`\beta`, in the **OutNd** list. :math:`B\alpha` is prefixed to each output name, diff --git a/docs/source/user/aerodyn-olaf/InputFiles.rst b/docs/source/user/aerodyn-olaf/InputFiles.rst index bd561525e8..a841fbf814 100644 --- a/docs/source/user/aerodyn-olaf/InputFiles.rst +++ b/docs/source/user/aerodyn-olaf/InputFiles.rst @@ -35,7 +35,7 @@ These methods are specified in :numref:`sec:vortconv`. **DTfvw** [sec] specifies the time interval at which the module will update the wake. The time interval must be a multiple of the time step used by -*AeroDyn15*. The blade circulation is updated at each intermediate time +*AeroDyn*. The blade circulation is updated at each intermediate time step based on the intermediate blades positions and wind velocities. The default value is :math:`dt_{aero}`, where :math:`dt_{aero}` is the time step used by AeroDyn. @@ -312,13 +312,13 @@ of a box of shape 5x20x30 and dimension 1200x300x295. The grid contains both th The two other grids are vertical and horizontal planes containing only the velocity. -AeroDyn15 Input File +AeroDyn Input File -------------------- Input file modifications ~~~~~~~~~~~~~~~~~~~~~~~~ -As OLAF is incorporated into the *AeroDyn15* module, a wake computation option -has been added to the *AeroDyn15* input file and a line has been added. These +As OLAF is incorporated into the *AeroDyn* module, a wake computation option +has been added to the *AeroDyn* input file and a line has been added. These additions are as follows. **WakeMod** specifies the type of wake model that is used. *WakeMod* = *[3]* has diff --git a/docs/source/user/aerodyn-olaf/Introduction.rst b/docs/source/user/aerodyn-olaf/Introduction.rst index 3a242306f3..426e07694e 100644 --- a/docs/source/user/aerodyn-olaf/Introduction.rst +++ b/docs/source/user/aerodyn-olaf/Introduction.rst @@ -50,7 +50,7 @@ to compute the aerodynamic forces on moving two- or three-bladed horizontal-axis wind turbines. This module has been incorporated into the National Renewable Energy Laboratory physics-based engineering tool, OpenFAST, which solves the aero-hydro-servo-elastic dynamics of individual wind turbines. OLAF is -incorporated into the OpenFAST module, *AeroDyn15*, as an alternative to the +incorporated into the OpenFAST module, *AeroDyn*, as an alternative to the traditional blade-element momentum (BEM) option, as shown in Figures :numref:`figOpenFAST_a` and :numref:`figOpenFAST_b`. @@ -70,7 +70,7 @@ Figures :numref:`figOpenFAST_a` and :numref:`figOpenFAST_b`. :width: 100% :align: center - OLAF and BEM integration with *AeroDyn15* + OLAF and BEM integration with *AeroDyn* Incorporating the OLAF module within OpenFAST allows for the modeling of highly flexible turbines along with the aero-hydro-servo-elastic @@ -127,13 +127,13 @@ truncation error is minimized~(:cite:`olaf-Leishman02_1`). The buffer zone is typically chosen as the convected distance over one rotor revolution. As part of OpenFAST, induced velocities at the lifting line/blade are -transferred to *AeroDyn15* and used to compute the effective blade angle of +transferred to *AeroDyn* and used to compute the effective blade angle of attack at each blade section, which is then used to compute the aerodynamic forces on the blades. The OLAF method returns the same information as the BEM method, but allows for more accurate calculations in areas where BEM assumptions are violated, such as those discussed above. As the OLAF method is more computationally expensive than BEM, both methods remain available in OpenFAST, -and the user may specify in the *AeroDyn15* input file which method is +and the user may specify in the *AeroDyn* input file which method is used. The OLAF input file defines the wake convection and circulation solution @@ -148,10 +148,10 @@ regularization parameter. Wake visualization output options are also available. This document is organized as follows. :numref:`Running-OLAF` covers downloading, compiling, and running OLAF. :numref:`OLAF-Input-Files` describes the -OLAF input file and modifications to the *AeroDyn15* input file. +OLAF input file and modifications to the *AeroDyn* input file. :numref:`Output-Files` details the OLAF output file. :numref:`OLAF-Theory` provides an overview of the OLAF theory, including the free vortex wake method -as well as integration into the *AeroDyn15* module. Example input files and a +as well as integration into the *AeroDyn* module. Example input files and a list of output channels are detailed in Appendices A, B, and C. diff --git a/docs/source/user/aerodyn-olaf/OutputFiles.rst b/docs/source/user/aerodyn-olaf/OutputFiles.rst index 98b5abb980..8f6b3f6eaf 100644 --- a/docs/source/user/aerodyn-olaf/OutputFiles.rst +++ b/docs/source/user/aerodyn-olaf/OutputFiles.rst @@ -4,7 +4,7 @@ Output Files ============ The OLAF module itself does not produce its own output file. However, additional -output channels are made available in *AeroDyn15*. As such, the *AeroDyn15* +output channels are made available in *AeroDyn*. As such, the *AeroDyn15* output file is briefly described as well as the outputs made available with OLAF. Visualization files are generated by using the parameter, **WrVTK**. This parameter is available in the OLAF input file, in which case the VTK files are @@ -18,10 +18,10 @@ outputs using **nGridOut** and the subsequent table. Results File ------------ -OpenFAST generates a master results file that includes the *AeroDyn15* +OpenFAST generates a master results file that includes the *AeroDyn* results. The results are in table format, where each column is a data channel, and each row corresponds to a simulation-output time step. The -data channels are specified in the *OUTPUTS* section in the *AeroDyn15* +data channels are specified in the *OUTPUTS* section in the *AeroDyn* primary input file. The column format of the AeroDyn-generated files is specified using the **OutFmt** parameter of the OpenFAST driver input file. diff --git a/docs/source/user/aerodyn-olaf/StateSpace.rst b/docs/source/user/aerodyn-olaf/StateSpace.rst index 501e939573..570bcc17e8 100644 --- a/docs/source/user/aerodyn-olaf/StateSpace.rst +++ b/docs/source/user/aerodyn-olaf/StateSpace.rst @@ -9,7 +9,7 @@ State, Constraint, Input, and Output Variables ---------------------------------------------- The OLAF module has been integrated into the latest version of OpenFAST via -*AeroDyn15*, following the OpenFAST modularization +*AeroDyn*, following the OpenFAST modularization framework (:cite:`olaf-Jonkman13_1,olaf-Sprague15_1`). To follow the OpenFAST framework, the vortex code is written as a module, and its formulation comprises state, constraint, and output equations. The data manipulated by the module include the @@ -151,25 +151,25 @@ diffusion is performed *a posteriori*. The velocity function, \vec{y}_2&=\vec{r}_{r} \end{aligned} -Integration with AeroDyn15 --------------------------- +Integration with AeroDyn +------------------------ The vortex code has been integrated as a submodule of the aerodynamic module of -OpenFAST, *AeroDyn15*. The data workflow between the different modules and -submodules of OpenFAST is illustrated in :numref:`AD15-OLAF`. +OpenFAST, *AeroDyn*. The data workflow between the different modules and +submodules of OpenFAST is illustrated in :numref:`AeroDyn-OLAF`. AeroDyn inputs such as BEM options (e.g., tip-loss factor), skew model, and dynamic inflow are discarded when the vortex code is used. The environmental conditions, tower shadow, and dynamic stall model options are used. This -integration required a restructuring of the *AeroDyn15* module to isolate the +integration required a restructuring of the *AeroDyn* module to isolate the parts of the code related to tower shadow modeling, induction computation, lifting-line-forces computations, and dynamic stall. The dynamic stall model is adapted when used in conjunction with the vortex code to ensure the effect of -shed vorticity is not accounted for twice. The interface between *AeroDyn15* and +shed vorticity is not accounted for twice. The interface between *AeroDyn* and the inflow module, *InflowWind*, was accommodated to include the additionally requested points by the vortex code. -.. _AD15-OLAF: +.. _AeroDyn-OLAF: .. figure:: Schematics/VortexCodeWorkFlow.png :alt: OpenFAST-FVW code integration workflow diff --git a/docs/source/user/aerodyn-olaf/index.rst b/docs/source/user/aerodyn-olaf/index.rst index 2c9595743a..fba13d5a7e 100644 --- a/docs/source/user/aerodyn-olaf/index.rst +++ b/docs/source/user/aerodyn-olaf/index.rst @@ -1,6 +1,6 @@ .. _OLAF: -OLAF User's Guide and Theory Manual (Free Vortex Wake in AeroDyn15) +OLAF User's Guide and Theory Manual (Free Vortex Wake in AeroDyn) =================================================================== .. only:: html diff --git a/docs/source/user/aerodyn/ADNodalOutputs.rst b/docs/source/user/aerodyn/ADNodalOutputs.rst index 72f7686d98..4c4e3a7c94 100644 --- a/docs/source/user/aerodyn/ADNodalOutputs.rst +++ b/docs/source/user/aerodyn/ADNodalOutputs.rst @@ -17,7 +17,11 @@ are 0 through the number of blades AeroDyn is modeling. If the value is set to 1, only blade 1 will be output, and if the value is 2, blades 1 and 2 will be output. -**BldNd_BlOutNd** specifies which nodes to output. This is currently unused. +**BldNd_BlOutNd** specifies which nodes to output (on all blades selected for +output). Valid entries are "ALL" (all blade nodes), "TIP" (only the last blade +node), "ROOT", (only the first blade node), or a list of numbers corresponding +to the node to output; valid numbers are 1 through the number of blade nodes +AeroDyn is modeling on each blade. The **OutList** section controls the nodal output quantities generated by AeroDyn. In this section, the user specifies the name of the channel family to @@ -29,8 +33,8 @@ channels will be named with the convention of **B**\ :math:`\mathbf{\beta}`\ the three digit node number. -Sample Nodal Outputs section -^^^^^^^^^^^^^^^^^^^^^^^^^^^^ +**Sample Nodal Outputs section** + This sample includes the ``END`` statement from the regular outputs section. diff --git a/docs/source/user/aerodyn/appendix.rst b/docs/source/user/aerodyn/appendix.rst index 0f60e7cf7d..ef7a0fbd09 100644 --- a/docs/source/user/aerodyn/appendix.rst +++ b/docs/source/user/aerodyn/appendix.rst @@ -27,7 +27,7 @@ outside of OpenFAST. 3) AeroDyn Primary Input File :download:`(primary input file example) `: -The primary AeroDyn input file defines modeling options, environmental conditions (except freestream flow), airfoils, tower nodal discretization and properties, tower, hub, and nacelle buoyancy properties, as well as output file specifications. +The primary AeroDyn input file defines modeling options, environmental conditions (except freestream flow), airfoils, tower nodal discretization and properties, tower, hub, and nacelle properties, as well as output file specifications. The file is organized into several functional sections. Each section corresponds to an aspect of the aerodynamics model. diff --git a/docs/source/user/aerodyn/bibliography.bib b/docs/source/user/aerodyn/bibliography.bib index dc79859eb4..56ea901810 100644 --- a/docs/source/user/aerodyn/bibliography.bib +++ b/docs/source/user/aerodyn/bibliography.bib @@ -16,6 +16,14 @@ @TECHREPORT{ad-AeroDyn:manualUnsteady note = {NREL/TP-5000-66347} } +@article{ad-UAElast:torquepaper, + title = {Aeroelastic stability of a generalized wind turbine cross-section including unsteady airfoil aerodynamic and dynamic inflow}, + author = {E. Branlard and J.Jonkman and B. Jonkman and M. Singh and E. Mayda and K.Dixon and J H. Porter and G. Vijayakumar}, + year = 2024, + journal = {Jounal of Physics: Conference Series}, +} + + @book{ad-Branlard:book, author = {E. Branlard}, title = {Wind Turbine Aerodynamics and Vorticity-Based Methods: Fundamentals and Recent Applications}, @@ -108,3 +116,10 @@ @article{ad-hammam2022 volume= 1, number=1 } + +@techreport{ad-hammam_NREL:2023, + title={Modeling the Yaw Behavior of Tail Fins for Small Wind Turbines: November 22, 2021-May 21, 2024}, + author={Hammam, Mohamed M and Wood, David and Summerville, Brent}, + year={2023}, + institution={National Renewable Energy Laboratory (NREL), Golden, CO (United States)} +} diff --git a/docs/source/user/aerodyn/driver.rst b/docs/source/user/aerodyn/driver.rst index 86469839f3..dec9b71aa3 100644 --- a/docs/source/user/aerodyn/driver.rst +++ b/docs/source/user/aerodyn/driver.rst @@ -375,24 +375,30 @@ An example is given below for two turbines, the first one having 3 blades, the s **Hub and nacelle inputs** -The sections defining the hub and nacelle buoyancy parameters must also be reproduced for each turbine. +The sections defining the hub and nacelle parameters must also be reproduced for each turbine. An example is given below for two turbines: .. code:: ====== Hub Properties ============================================================================== [used only when Buoyancy=True] - 7.0 VolHub - Hub volume (m^3) - 0.0 HubCenBx - Hub center of buoyancy x direction offset (m) + 7.0 VolHub - Hub volume (m^3) + 0.0 HubCenBx - Hub center of buoyancy x direction offset (m) ====== Hub Properties ============================================================================== [used only when Buoyancy=True] - 5.0 VolHub - Hub volume (m^3) - 0.2 HubCenBx - Hub center of buoyancy x direction offset (m) - ====== Nacelle Properties ========================================================================== [used only when Buoyancy=True] - 32.0 VolNac - Nacelle volume (m^3) - 0.3, 0.0, 0.05 NacCenB - Position of nacelle center of buoyancy from yaw bearing in nacelle coordinates (m) - ====== Nacelle Properties ========================================================================== [used only when Buoyancy=True] - 30.0 VolNac - Nacelle volume (m^3) - 0.5, 0.1, 0.05 NacCenB - Position of nacelle center of buoyancy from yaw bearing in nacelle coordinates (m) + 5.0 VolHub - Hub volume (m^3) + 0.2 HubCenBx - Hub center of buoyancy x direction offset (m) + ====== Nacelle Properties ========================================================================== [used only when Buoyancy=True or NacelleDrag=True] + 32.0 VolNac - Nacelle volume (m^3) + 0.3, 0.0, 0.05 NacCenB - Position of nacelle center of buoyancy from yaw bearing in nacelle coordinates (m) + 4.67, 20.15, 20.15 NacArea - Projected area of the nacelle in X, Y, Z in the nacelle coordinate system (m^2) + 0.5, 0.5, 0.5 NacCd - Drag coefficient for the nacelle areas defined above (-) + 0.43, 0, 0 NacDragAC - Position of aerodynamic center of nacelle drag in nacelle coordinates (m) + ====== Nacelle Properties ========================================================================== [used only when Buoyancy=True or NacelleDrag=True] + 32.0 VolNac - Nacelle volume (m^3) + 0.3, 0.0, 0.05 NacCenB - Position of nacelle center of buoyancy from yaw bearing in nacelle coordinates (m) + 4.67, 20.15, 20.15 NacArea - Projected area of the nacelle in X, Y, Z in the nacelle coordinate system (m^2) + 0.5, 0.5, 0.5 NacCd - Drag coefficient for the nacelle areas defined above (-) + 0.43, 0, 0 NacDragAC - Position of aerodynamic center of nacelle drag in nacelle coordinates (m) **Aerodynamic tower inputs** diff --git a/docs/source/user/aerodyn/examples/NodalOutputs.txt b/docs/source/user/aerodyn/examples/NodalOutputs.txt index 7929a50cac..6cbbcea551 100644 --- a/docs/source/user/aerodyn/examples/NodalOutputs.txt +++ b/docs/source/user/aerodyn/examples/NodalOutputs.txt @@ -1,7 +1,7 @@ END of input file (the word "END" must appear in the first 3 columns of this last OutList line) ---------------------- NODE OUTPUTS -------------------------------------------- - 3 BldNd_BladesOut - Blades to output - 99 BldNd_BlOutNd - Blade nodes on each blade (currently unused) + 3 BldNd_BladesOut - Number of blades to output all node information at. Up to number of blades on turbine. (-) + "ALL" BldNd_BlOutNd - Specify a portion of the nodes to output. {"ALL", "Tip", "Root", or a list of node numbers} (-) OutList - The next line(s) contains a list of output parameters. See OutListParameters.xlsx, AeroDyn_Nodes tab for a listing of available output channels, (-) "VUndx" - x-component of undisturbed wind velocity at each node "VUndy" - y-component of undisturbed wind velocity at each node diff --git a/docs/source/user/aerodyn/examples/ad_driver_example.dvr b/docs/source/user/aerodyn/examples/ad_driver_example.dvr index ea92c3edd1..c93fcfe122 100644 --- a/docs/source/user/aerodyn/examples/ad_driver_example.dvr +++ b/docs/source/user/aerodyn/examples/ad_driver_example.dvr @@ -6,7 +6,7 @@ False Echo - Echo input parameters to ".ech"? 3 AnalysisType - {1: multiple turbines, one simulation, 2: one turbine, one time-dependent simulation, 3: one turbine, combined cases} 11.0 TMax - Total run time [used only when AnalysisType/=3] (s) 0.5 DT - Simulation time step [used only when AnalysisType/=3] (s) -"./AD.dat" AeroFile - Name of the primary AeroDyn input file +"ad_primary_example.dat" AeroFile - Name of the primary AeroDyn input file ----- Environmental Conditions ---------------------------------------------------------- 1025 FldDens - Density of working fluid (kg/m^3) 1.4639E-05 KinVisc - Kinematic viscosity of working fluid (m^2/s) @@ -19,7 +19,7 @@ False Echo - Echo input parameters to ".ech"? "unused" InflowFile - Name of the InflowWind input file [used only when CompInflow=1] 9.0 HWindSpeed - Horizontal wind speed [used only when CompInflow=0 and AnalysisType=1] (m/s) 140 RefHt - Reference height for horizontal wind speed [used only when CompInflow=0] (m) - 0.10 PLExp - Power law exponent [used only when CompInflow=0 and AnalysisType=1] (-) + 0.10 PLExp - Power law exponent [used only when CompInflow=0 and AnalysisType=1] (-) ----- Turbine Data ---------------------------------------------------------------------- 1 NumTurbines - Number of turbines ----- Turbine(1) Geometry --------------------------------------------------------------- diff --git a/docs/source/user/aerodyn/examples/ad_primary_example.dat b/docs/source/user/aerodyn/examples/ad_primary_example.dat index 67a6035a3f..6505544349 100644 --- a/docs/source/user/aerodyn/examples/ad_primary_example.dat +++ b/docs/source/user/aerodyn/examples/ad_primary_example.dat @@ -1,17 +1,16 @@ -------- AERODYN v15 for OpenFAST INPUT FILE ----------------------------------------------- +------- AERODYN for OpenFAST INPUT FILE ------------------------------------------------------------- Description line that will be printed in the output file and written to the screen. ====== General Options ============================================================================ -True Echo - Echo the input to ".AD.ech"? (flag) +False Echo - Echo the input to ".AD.ech"? (flag) "default" DTAero - Time interval for aerodynamic calculations {or "default"} (s) - 1 WakeMod - Type of wake/induction model (switch) {0=none, 1=BEMT, 2=DBEMT, 3=OLAF} [WakeMod cannot be 2 or 3 when linearizing] - 1 AFAeroMod - Type of blade airfoil aerodynamics model (switch) {1=steady model, 2=Beddoes-Leishman unsteady model} [AFAeroMod must be 1 when linearizing] - 0 TwrPotent - Type of tower influence on wind based on potential flow around the tower (switch) {0=none, 1=baseline potential flow, 2=potential flow with Bak correction} + 1 Wake_Mod - Wake/induction model (switch) {0=none, 1=BEMT, 3=OLAF} [Wake_Mod cannot be 2 or 3 when linearizing] + 1 TwrPotent - Type tower influence on wind based on potential flow around the tower (switch) {0=none, 1=baseline potential flow, 2=potential flow with Bak correction} 0 TwrShadow - Calculate tower influence on wind based on downstream tower shadow (switch) {0=none, 1=Powles model, 2=Eames model} False TwrAero - Calculate tower aerodynamic loads? (flag) -False FrozenWake - Assume frozen wake during linearization? (flag) [used only when WakeMod=1 and when linearizing] -False CavitCheck - Perform cavitation check? (flag) [AFAeroMod must be 1 when CavitCheck=true] +False CavitCheck - Perform cavitation check? (flag) [UA_Mod must be 0 when CavitCheck=true] False Buoyancy - Include buoyancy effects? (flag) -False CompAA - Flag to compute AeroAcoustics calculation [used only when WakeMod = 1 or 2] +False NacelleDrag - Include Nacelle Drag effects? (flag) +False CompAA - Flag to compute AeroAcoustics calculation [used only when Wake_Mod = 1 or 2] "unused" AA_InputFile - AeroAcoustics input file [used only when CompAA=true] ====== Environmental Conditions =================================================================== "default" AirDens - Air density (kg/m^3) @@ -19,24 +18,39 @@ False CompAA - Flag to compute AeroAcoustics calculation [us "default" SpdSound - Speed of sound in working fluid (m/s) "default" Patm - Atmospheric pressure (Pa) [used only when CavitCheck=True] "default" Pvap - Vapour pressure of working fluid (Pa) [used only when CavitCheck=True] -====== Blade-Element/Momentum Theory Options ====================================================== [unused when WakeMod=0 or 3] - 1 SkewMod - Type of skewed-wake correction model (switch) {1=uncoupled, 2=Pitt/Peters, 3=coupled} [unused when WakeMod=0 or 3] -"default" SkewModFactor - Constant used in Pitt/Peters skewed wake model {or "default" is 15/32*pi} (-) [used only when SkewMod=2; unused when WakeMod=0 or 3] -f TipLoss - Use the Prandtl tip-loss model? (flag) [unused when WakeMod=0 or 3] -f HubLoss - Use the Prandtl hub-loss model? (flag) [unused when WakeMod=0 or 3] -True TanInd - Include tangential induction in BEMT calculations? (flag) [unused when WakeMod=0 or 3] -True AIDrag - Include the drag term in the axial-induction calculation? (flag) [unused when WakeMod=0 or 3] -True TIDrag - Include the drag term in the tangential-induction calculation? (flag) [unused when WakeMod=0,3 or TanInd=FALSE] - 1E-05 IndToler - Convergence tolerance for BEMT nonlinear solve residual equation {or "default"} (-) [unused when WakeMod=0 or 3] - 100 MaxIter - Maximum number of iteration steps (-) [unused when WakeMod=0] -====== Dynamic Blade-Element/Momentum Theory Options ============================================== [used only when WakeMod=2] - 2 DBEMT_Mod - Type of dynamic BEMT (DBEMT) model {1=constant tau1, 2=time-dependent tau1, 3=constant tau1 with continuous formulation} (-) [used only when WakeMod=2] - 4 tau1_const - Time constant for DBEMT (s) [used only when WakeMod=2 and DBEMT_Mod=1 or 3] -====== OLAF -- cOnvecting LAgrangian Filaments (Free Vortex Wake) Theory Options ================== [used only when WakeMod=3] -"unused" OLAFInputFileName - Input file for OLAF [used only when WakeMod=3] -====== Beddoes-Leishman Unsteady Airfoil Aerodynamics Options ===================================== [used only when AFAeroMod=2] - 1 UAMod - Unsteady Aero Model Switch (switch) {2=B-L Gonzalez, 3=B-L Minnema/Pierce, 4=B-L HGM 4-states, 5=B-L 5 states, 6=Oye, 7=Boeing-Vertol} [used only when AFAeroMod=2] -FALSE FLookup - Flag to indicate whether a lookup for f' will be calculated (TRUE) or whether best-fit exponential equations will be used (FALSE); if FALSE S1-S4 must be provided in airfoil input files (flag) [used only when AFAeroMod=2] +====== Blade-Element/Momentum Theory Options ====================================================== [unused when Wake_Mod=0 or 3, except for BEM_Mod] + 2 BEM_Mod - BEM model {1=legacy NoSweepPitchTwist, 2=polar} (switch) [used for all Wake_Mod to determine output coordinate system] +--- Skew correction + 1 Skew_Mod - Skew model {0=No skew model, -1=Remove non-normal component for linearization, 1=skew model active} +True SkewMomCorr - Turn the skew momentum correction on or off [used only when Skew_Mod=1] + 1 SkewRedistr_Mod - Type of skewed-wake correction model (switch) {0=no redistribution, 1=Glauert/Pitt/Peters, default=1} [used only when Skew_Mod=1] +"default" SkewRedistrFactor - Constant used in Pitt/Peters skewed wake model {or "default" is 15/32*pi} (-) [used only when Skew_Mod=1 and SkewRedistr_Mod=1] +--- BEM algorithm +True TipLoss - Use the Prandtl tip-loss model? (flag) [unused when Wake_Mod=0 or 3] +True HubLoss - Use the Prandtl hub-loss model? (flag) [unused when Wake_Mod=0 or 3] +True TanInd - Include tangential induction in BEMT calculations? (flag) [unused when Wake_Mod=0 or 3] +True AIDrag - Include the drag term in the axial-induction calculation? (flag) [unused when Wake_Mod=0 or 3] +True TIDrag - Include the drag term in the tangential-induction calculation? (flag) [unused when Wake_Mod=0,3 or TanInd=FALSE] +"Default" IndToler - Convergence tolerance for BEMT nonlinear solve residual equation {or "default"} (-) [unused when Wake_Mod=0 or 3] + 100 MaxIter - Maximum number of iteration steps (-) [unused when Wake_Mod=0] +--- Shear correction +False SectAvg - Use sector averaging (flag) +1 SectAvgWeighting - Weighting function for sector average {1=Uniform, default=1} within a sector centered on the blade (switch) [used only when SectAvg=True] +5 SectAvgNPoints - Number of points per sectors (-) {default=5} [used only when SectAvg=True] +-60 SectAvgPsiBwd - Backward azimuth relative to blade where the sector starts (<=0) {default=-60} (deg) [used only when SectAvg=True] + 60 SectAvgPsiFwd - Forward azimuth relative to blade where the sector ends (>=0) {default=60} (deg) [used only when SectAvg=True] +--- Dynamic wake/inflow + 2 DBEMT_Mod - Type of dynamic BEMT (DBEMT) model {0=No Dynamic Wake, -1=Frozen Wake for linearization, 1:constant tau1, 2=time-dependent tau1, 3=constant tau1 with continuous formulation} (-) + 20 tau1_const - Time constant for DBEMT (s) [used only when DBEMT_Mod=1 or 3] +====== OLAF -- cOnvecting LAgrangian Filaments (Free Vortex Wake) Theory Options ================== [used only when Wake_Mod=3] +"unused" OLAFInputFileName - Input file for OLAF [used only when Wake_Mod=3] +====== Unsteady Airfoil Aerodynamics Options ==================================================== +True AoA34 - Sample the angle of attack (AoA) at the 3/4 chord or the AC point {default=True} [always used] + 3 UA_Mod - Unsteady Aero Model Switch (switch) {0=Quasi-steady (no UA), 2=B-L Gonzalez, 3=B-L Minnema/Pierce, 4=B-L HGM 4-states, 5=B-L HGM+vortex 5 states, 6=Oye, 7=Boeing-Vertol} +True FLookup - Flag to indicate whether a lookup for f' will be calculated (TRUE) or whether best-fit exponential equations will be used (FALSE); if FALSE S1-S4 must be provided in airfoil input files (flag) [used only when UA_Mod=2 or UA_Mod=3] + 3 IntegrationMethod - Switch to indicate which integration method UA uses (1=RK4, 2=AB4, 3=ABM4, 4=BDF2) + 0 UAStartRad - Starting radius for dynamic stall (fraction of rotor radius [0.0,1.0]) [used only when UA_Mod>0; if line is missing UAStartRad=0] + 1 UAEndRad - Ending radius for dynamic stall (fraction of rotor radius [0.0,1.0]) [used only when UA_Mod>0; if line is missing UAEndRad=1] ====== Airfoil Information ========================================================================= 1 AFTabMod - Interpolation method for multiple airfoil tables {1=1D interpolation on AoA (first table only); 2=2D interpolation on AoA and Re; 3=2D interpolation on AoA and UserProp} (-) 1 InCol_Alfa - The column in the airfoil tables that contains the angle of attack (-) @@ -61,27 +75,33 @@ True UseBlCm - Include aerodynamic pitching moment in calcul "Test01_UAE_AeroDyn_blade.dat" ADBlFile(2) - Name of file containing distributed aerodynamic properties for Blade #2 (-) [unused if NumBl < 2] "Test01_UAE_AeroDyn_blade.dat" ADBlFile(3) - Name of file containing distributed aerodynamic properties for Blade #3 (-) [unused if NumBl < 3] ====== Hub Properties ============================================================================== [used only when Buoyancy=True] - 0.0 VolHub - Hub volume (m^3) - 0.0 HubCenBx - Hub center of buoyancy x direction offset (m) -====== Nacelle Properties ========================================================================== [used only when Buoyancy=True] - 0.0 VolNac - Nacelle volume (m^3) -0.0, 0.0, 0.0 NacCenB - Position of nacelle center of buoyancy from yaw bearing in nacelle coordinates (m) + 0 VolHub - Hub volume (m^3) + 0 HubCenBx - Hub center of buoyancy x direction offset (m) +====== Nacelle Properties ========================================================================== [used only when Buoyancy=True or NacelleDrag=True] + 0 VolNac - Nacelle volume (m^3) + 0, 0, 0 NacCenB - Position of nacelle center of buoyancy from yaw bearing in nacelle coordinates (m) + 0, 0, 0 NacArea - Projected area of the nacelle in X, Y, Z in the nacelle coordinate system (m^2) + 0, 0, 0 NacCd - Drag coefficient for the nacelle areas defined above (-) + 0, 0, 0 NacDragAC - Position of aerodynamic center of nacelle drag in nacelle coordinates (m) +====== Tail Fin Aerodynamics ======================================================================= +False TFinAero - Calculate tail fin aerodynamics model (flag) +"unused" TFinFile - Input file for tail fin aerodynamics [used only when TFinAero=True] ====== Tower Influence and Aerodynamics ============================================================ [used only when TwrPotent/=0, TwrShadow/=0, TwrAero=True, or Buoyancy=True] 5 NumTwrNds - Number of tower nodes used in the analysis (-) [used only when TwrPotent/=0, TwrShadow/=0, TwrAero=True, or Buoyancy=True] -TwrElev TwrDiam TwrCd TwrTI (used only with TwrShadow=2) TwrCb (used only with Buoyancy=True) -(m) (m) (-) (-) (-) -0.0000000E+00 6.0000000E+00 0.0000000E+00 1.0000000E-01 0.0 -2.0000000E+01 5.5000000E+00 0.0000000E+00 1.0000000E-01 0.0 -4.0000000E+01 5.0000000E+00 0.0000000E+00 1.0000000E-01 0.0 -6.0000000E+01 4.5000000E+00 0.0000000E+00 1.0000000E-01 0.0 -8.0000000E+01 4.0000000E+00 0.0000000E+00 1.0000000E-01 0.0 +TwrElev TwrDiam TwrCd TwrTI TwrCb ! TwrTI used only when TwrShadow=2; TwrCb used only when Buoyancy=True +(m) (m) (-) (-) (-) +0.0000000E+00 6.0000000E+00 0.0000000E+00 1.0000000E-01 0.0000000E+00 +2.0000000E+01 5.5000000E+00 0.0000000E+00 1.0000000E-01 0.0000000E+00 +4.0000000E+01 5.0000000E+00 0.0000000E+00 1.0000000E-01 0.0000000E+00 +6.0000000E+01 4.5000000E+00 0.0000000E+00 1.0000000E-01 0.0000000E+00 +8.0000000E+01 4.0000000E+00 0.0000000E+00 1.0000000E-01 0.0000000E+00 ====== Outputs ==================================================================================== -True SumPrint - Generate a summary file listing input options and interpolated properties to ".AD.sum"? (flag) +True SumPrint - Generate a summary file listing input options and interpolated properties to ".AD.sum"? (flag) 4 NBlOuts - Number of blade node outputs [0 - 9] (-) 1, 3, 4, 6 BlOutNd - Blade nodes whose values will be output (-) 0 NTwOuts - Number of tower node outputs [0 - 9] (-) 1 TwOutNd - Tower nodes whose values will be output (-) - OutList - The next line(s) contains a list of output parameters. See OutListParameters.xlsx for a listing of available output channels, (-) + OutList - The next line(s) contains a list of output parameters. See OutListParameters.xlsx for a listing of available output channels, (-) "B1N1VDisx, B1N1VDisy, B1N1VDisz" ! disturbed wind velocity at Blade 1, Node 1 "B1N2VDisx, B1N2VDisy, B1N2VDisz" ! disturbed wind velocity at Blade 1, Node 2 "B1N3VDisx, B1N3VDisy, B1N3VDisz" ! disturbed wind velocity at Blade 1, Node 3 @@ -93,18 +113,19 @@ True SumPrint - Generate a summary file listing input option "B1N1Alpha, B1N2Alpha, B1N3Alpha" "B1N1Theta, B1N2Theta, B1N3Theta" END of OutList section (the word "END" must appear in the first 3 columns of the last OutList line) -====== Outputs for all blade stations (same ending as above for B1N1.... ============================ [optional section] - 1 BldNd_BladesOut - Number of blades to output all node information at. Up to number of blades on turbine. (-) - "All" BldNd_BlOutNd - Future feature will allow selecting a portion of the nodes to output. Not implemented yet. (-) - OutList - The next line(s) contains a list of output parameters. See OutListParameters.xlsx for a listing of available output channels, (-) -"Fx, Fy" -"Vx, Vy" -Vrel -TnInd -AxInd -Theta -Phi -Vindx -Vindy -Alpha +====== Outputs for all blade stations (same ending as above for B1N1.... =========================== [optional section] + 1 BldNd_BladesOut - Number of blades to output all node information at. Up to number of blades on turbine. (-) +"All" BldNd_BlOutNd - Specify a portion of the nodes to output. {"ALL", "Tip", "Root", or a list of node numbers} (-) + OutList_Nodal - The next line(s) contains a list of output parameters. See OutListParameters.xlsx for a listing of available output channels, (-) +"Fx, Fy" +"Vx, Vy" +"Vrel" +"TnInd" +"AxInd" +"Theta" +"Phi" +"Vindx" +"Vindy" +"Alpha" END (the word "END" must appear in the first 3 columns of this last OutList line in the optional nodal output section) +==================================================================================================== diff --git a/docs/source/user/aerodyn/input.rst b/docs/source/user/aerodyn/input.rst index 3fe7ff7a38..000fc089fe 100644 --- a/docs/source/user/aerodyn/input.rst +++ b/docs/source/user/aerodyn/input.rst @@ -3,6 +3,19 @@ Input Files =========== +Important changes introduced in v4.0 +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +Some important changes have been introduced starting from version 4.0. +Please refer to :ref:`api_change_ad4x` to understand the link between the old and new inputs. + +The documentation below has been updated to incorporate these changes. + + + +Introduction +~~~~~~~~~~~~ + The user configures the aerodynamic model parameters via a primary AeroDyn input file, as well as separate input files for airfoil and blade data. When used in standalone mode, an additional driver input @@ -32,7 +45,7 @@ AeroDyn Primary Input File The primary AeroDyn input file defines modeling options, environmental conditions (except freestream flow), airfoils, tower nodal -discretization and properties, tower, hub, and nacelle buoyancy properties, +discretization and properties, tower, hub, and nacelle properties, as well as output file specifications. The file is organized into several functional sections. Each section @@ -43,6 +56,10 @@ primary input file is given in The input file begins with two lines of header information which is for your use, but is not used by the software. + + + + General Options ~~~~~~~~~~~~~~~ @@ -65,17 +82,23 @@ for ``DTAero`` may be used to indicate that AeroDyn should employ the time step prescribed by the driver code (OpenFAST or the standalone driver program). -Set ``WakeMod`` to 0 if you want to disable rotor wake/induction effects or 1 to -include these effects using the (quasi-steady) BEM theory model. When -``WakeMod`` is set to 2, a dynamic BEM theory model (DBEMT) is used (also -referred to as dynamic inflow or dynamic wake model, see :numref:`AD_DBEMT`). When ``WakeMod`` is set -to 3, the free vortex wake model is used, also referred to as OLAF (see -:numref:`OLAF`). ``WakeMod`` cannot be set to 2 or 3 during linearization -analyses. -Set ``AFAeroMod`` to 1 to include steady blade airfoil aerodynamics or 2 -to enable UA; ``AFAeroMod`` must be 1 during linearization analyses -with AeroDyn coupled to OpenFAST. +**Wake_Mod** +Set ``Wake_Mod`` to 0 if you want to have zero induced velocities. +Set it to 1 to include these effects using the BEM theory model. +When ``Wake_Mod`` is set to 3, the free vortex wake model is used, also referred to as OLAF (see +:numref:`OLAF`). ``Wake_Mod`` cannot be set to 3 during linearization analyses. + +.. note:: + Link to old inputs: The previous input `WakeMod` is removed, `WakeMod=2` used to mean DBEMT, but this now controlled using `DBEMT_Mod`. + `Wake_Mod=2` is a placeholder for future induction calculation method. + + +**~~AFAeroMod~~** +This input has been removed. See ``UA_Mod`` below. + +**~~FrozenWake~~** +This input has been removed. See ``DBEMT_Mod`` below. Set ``TwrPotent`` to 0 to disable the potential-flow influence of the tower on the fluid flow local to the @@ -93,15 +116,15 @@ Set the ``TwrAero`` flag to TRUE to calculate fluid drag loads on the tower or FALSE to disable these effects. During linearization analyses -with AeroDyn coupled OpenFAST and BEM enabled (``WakeMod = 1``), set the -``FrozenWake`` flag to TRUE to employ frozen-wake assumptions during -linearization (i.e. to fix the axial and tangential induces velocities, -and, at their operating-point values during linearization) or FALSE to -recalculate the induction during linearization using BEM theory. +with AeroDyn coupled OpenFAST and BEM enabled (``Wake_Mod = 1``), set the +``DBEMT_Mod=-1`` to employ frozen-wake assumptions +(i.e. to fix the axial and tangential induces velocities, and, at their operating-point values during linearization) +or +``DBEMT_Mod=3`` to use the continuous dynamic wake model. Set the ``CavitCheck`` flag to TRUE to perform a cavitation check for MHK turbines or FALSE to disable this calculation. If ``CavitCheck`` is -TRUE, ``AFAeroMod`` must be set to 1 because the cavitation check does +TRUE, ``UA_Mod`` must be set to 0 because the cavitation check does not function with unsteady airfoil aerodynamics. If ``CavitCheck`` is TRUE, the ``MHK`` flag in the AeroDyn or OpenFAST driver input file must be set to 1 or 2 to indicate an MHK turbine is being modeled. @@ -111,8 +134,11 @@ tower, nacelle, and hub of an MHK turbine or FALSE to disable this calculation. If ``Buoyancy`` is TRUE, the ``MHK`` flag in the AeroDyn or OpenFAST driver input file must be set to 1 or 2 to indicate an MHK turbine is being modeled. +Set the ``NacelleDrag`` flag to TRUE to calculate the drag loads on the nacelle +or FALSE to disable this calculation. + Set the ``CompAA`` flag to TRUE to run aero-acoustic calculations. This -option is only available for ``WakeMod = 1`` or ``2`` and is not available for +option is only available for ``Wake_Mod = 1`` and is not available for an MHK turbine. See section :numref:`AeroAcoustics` for information on how to use this feature. @@ -121,6 +147,7 @@ sub-module. See :numref:`AeroAcoustics` for information on how to use this feature. + Environmental Conditions ~~~~~~~~~~~~~~~~~~~~~~~~ @@ -147,17 +174,58 @@ around 2,000 Pa. Blade-Element/Momentum Theory Options ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -The input parameters in this section are not used when ``WakeMod = 0``. +**BEM_Mod** +Determines the kind of BEM algorithm to use. + +- ``BEM_Mod=2`` (recommended) uses the new AeroDyn BEM implementation using the local staggered polar grid coordinate system, which is more suitable for large coning. It also includes an optional momentum correction that is important for large skew (see ``SkewMomCorr``). The feature will be documented at a later time. +- ``BEM_Mod=1`` (for backward compatibility) uses the old AeroDyn BEM implementation using the NoSweepPitchTwist coordinate system. + + +.. note:: + Link to old inputs: previous implementation would have ``BEM_Mod=1`` implied. + + +.. warning:: + + ``BEM_Mod`` currently governs the coordinate system used for "ill-defined" outputs (outputs that don't have a specified coordinate system) such as the ones that ends with "x" and "y". Other ill-defined outputs are the typical BEM quantities such as "AxInd", "TnInd", "Phi", etc. These are defined in a different coordinate system depending on `BEM_Mod`. For consistency accross differents `Wake_Mod` (even when `Wake_Mod/=1`), we use `BEM_Mod` to determine the coordinate system of the ill-defined outputs. + +The following inputs in this section are only used when ``Wake_Mod = 1``. + + + +**Skew_Mod** +``Skew_Mod`` determines the skew correction model (for yaw and tilt): + +- ``Skew_Mod=1``: activates Glauert's skew model (recommended). This model has two components: a momentum correction (``SkewMomCorr` `), and a velocity redistribution model (``SkewRedistr_Mod``). +- ``Skew_Mod=0`` means no skew model at all (not recommended) +- ``Skew_Mod=-1`` throws away non-normal component (for linearization). This setting makes sure the wind speed is always normal to the rotor to limit periodic variation of the wind speed if the rotor is not perpendicular to the wind (e.g. tower top tilting or tilt). This is mostly needed for linearization. + +Currently (``Skew_Mod=0``) or (``Skew_Mod=1`` and ``SkewModCorr=False`` and ``SkewRedistr_Mod = 0``) are the same, both set of inputs turn off the skew correction entirely. + +.. note:: + Link to old inputs: Previous implementations always had the skew model on. `Skew_Mod=-1` replaces the old `SkewMod=0` (an option that few users were using). + + +**SkewMomCorr** +Turns the skew momentum correction on or off [used only when ``Skew_Mod=1``] +The feature will be documented at a later time. -``SkewMod`` determines the skewed-wake correction model. Set -``SkewMod`` to 1 to use the uncoupled BEM solution technique without -an additional skewed-wake correction. Set ``SkewMod`` to 2 to include -the Pitt/Peters correction model. **The coupled model ``SkewMod= -3`` is not available in this version of AeroDyn.** +.. note:: + Link to old inputs: the previous behavior would be `SkewMomCorr=False` -``SkewModFactor`` is used only when ``SkewMod = 2``. Enter a scaling factor to use -in the Pitt/Peters correction model, or enter ``"default"`` to use the default -value of :math:`\frac{15 \pi}{32}`. +**SkewRedistr_Mod** +``SkewRedistr_Mod`` allows to turn on and off the induced velocity redistribution model, and give room for other models to be selected/implemented. Default=1. + + - 0: no redistribution + - 1: Glauert (Pitt-Peters) redistribution model + +**SkewRedistrFactor** +Defines the constant used in the Glauert redistribution model (``SkewRedistr_Mod=1``). +Use ``"default"`` to use the default value of :math:`\frac{15 \pi}{32}`. + + +BEM Algorithm options +~~~~~~~~~~~~~~~~~~~~~ Set ``TipLoss`` to TRUE to include the Prandtl tip-loss model or FALSE to disable it. Likewise, set ``HubLoss`` to TRUE to include the @@ -185,29 +253,63 @@ the BEM solve is not less than or equal to ``IndToler`` in ``MaxIter``, AeroDyn will exit the BEM solver and return an error message. -Dynamic Blade-Element/Momentum Theory Options -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -The input parameters in this section are used only when ``WakeMod = 2``. +Shear corrections +~~~~~~~~~~~~~~~~~ + +The BEM algorithm may need to be corrected to account for shear. +Currently, a sector average correction is implemented, as a beta feature, to limit fluctuations associated with variations of wind speed as the blade rotates. + +The feature will be documented at a later time and is still at an experimental stage. + +**SectAvg** Use Sector Averaging (flag). +The method uses sectors expanding forward and backward relative to the current azimuth of the blade (see ``SectAvgPsiBwd`` and ``SectAvgPsiFwd``). +The velocity is averaged within this sector by attributing different weighting at different points in the sector (see ``SectAvgWeighting``). + +**SectAvgWeighting** Weighting function for sector average. +1=Uniform (switch) [used only when ``SectAvg=True``]. Default is 1. + +**SectAvgNPoints** Number of points per sectors (-) [used only when ``SectAvg=True``]. Default is 5. + +**SectAvgPsiBwd** Backward azimuth (in degrees) relative to the blade azimuth where the sector starts. Must be negative. [used only when SectAvg=True]. Default is -60 deg. + +**SectAvgPsiFwd** Forward azimuth (in degrees) relative to the blade azimuth where the sector ends. Must be positive. [used only when SectAvg=True]. Default is 60 deg. + + + + + +Dynamic Wake / Dynamic inflow model +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +The input parameters in this section are used only when ``Wake_Mod = 1``. The theory is described in :numref:`AD_DBEMT`. -There are three options available for ``DBEMT_Mod``: +The dynamic wake (also called dynamic inflow) model is governed by the input ``DBEMT_Mod``: +- ``0``: no dynamic wake, also called quasi-steady wake model (not recommended). +- ``-1``: frozen wake, the induced velocities at a given operating point will remain constant (useful for simplified linearization only). - ``1``: discrete-time Oye's model, with constant :math:`\tau_1` - ``2``: discrete-time Oye's model, with varying :math:`\tau_1`, automatically adjusted based on inflow. (recommended for time-domain simulations) - ``3``: continuous-time Oye's model, with constant :math:`\tau_1` (recommended for linearization) For ``DBEMT_Mod=1`` or ``DBEMT_Mod=3`` it is the user responsability to set the value of :math:`\tau_1` (i.e. ``tau1_const``) according to the expression given in :numref:`AD_DBEMT`, using an estimate of what the mean axial induction (:math:`\overline{a}`) and the mean relative wind velocity across the rotor (:math:`\overline{U_0}`) are for a given simulation. -The option ``DBEMT_Mod=3`` is the only one that can be used for linearization. +Only the options ``DBEMT_Mod={-1,3}`` can be used for linearization. +.. note:: + Link to old inputs: + The option `DBEMT_Mod=-1` has the same behavior as the old `FrozenWake=True`. + `DBEMT_Mod=0` has the same behavior as the previous `WakeMod=1` option. + `DBEMT_Mod=J` (`J` in `1,2,3`) , has the same behavior as the previous `WakeMod=2` & `DBEMT_Mod=J` + OLAF -- cOnvecting LAgrangian Filaments (Free Vortex Wake) Theory Options ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -The input parameters in this section are used only when ``WakeMod = 3``. +The input parameters in this section are used only when ``Wake_Mod = 3``. The settings for the free vortex wake model are set in the OLAF input file described in :numref:`OLAF-Input-Files`. ``OLAFInputFileName`` is the filename @@ -219,11 +321,23 @@ for this input file. Unsteady Airfoil Aerodynamics Options ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -The input parameters in this section are used only when ``AFAeroMod -= 2``. -``UAMod`` determines the UA model. It has the following options: +**AoA34** +Determine whether the baseline angle of attack is sampled at the 3/4 chord or at the aerodynamic center point. +Most ``UA_Mod`` will require `AoA34` to be set to true. But when using quasi-steady aerodynamics, the user may want to set it to true or false. + +.. warning:: + This feature is currently not implemented due to a lag between the `dev` and `dev-unstable` branch. + +.. note:: + Link to previous inputs: `AFAeroMod=1` implies `AoA34=False`. But to have a fair comparison between steady and unsteady aerodynamics model, it would be best to set `AoA34=True` when doing quasi-steady aero. + + + +``UA_Mod`` determines the UA model. It has the following options: + +- ``0``: no unsteady arifoil aerodynamics, - ``1``: the discrete-time model of Beddoes-Leishman (B-L) (**not currently functional**), - ``2``: the extensions to B-L developed by González (changes in Cn, Cc, Cm) - ``3``: the extensions to B-L developed by Minnema/Pierce (changes in Cc and Cm) @@ -232,8 +346,10 @@ The input parameters in this section are used only when ``AFAeroMod - ``6``: 1-state continuous-time developed by Oye - ``7``: discrete-time Boeing-Vertol (BV) model -Linearization is supported with ``UAMod=4,5,6`` (which use continuous-time states) but not with the other models. The different models are described in :numref:`AD_UA`. +Linearization is supported with ``UA_Mod=4,5,6`` (which use continuous-time states) but not with the other models. The different models are described in :numref:`AD_UA`. +.. note:: + Link to old inputs: If `UA_Mod>0`, then this is equivalent to the old `AFAeroMod=2`. **While all of the UA models are documented in this manual, the original B-L model is not yet functional. Testing has shown @@ -256,7 +372,7 @@ is determined via a lookup into the static lift-force coefficient and drag-force coefficient data. **Using best-fit exponential equations (``FLookup = FALSE``) is not yet available, so ``FLookup`` must be ``TRUE`` in this version of AeroDyn.** Note, ``FLookup`` is not used -when ``UAMod=4`` or ``UAMod=5``. +when ``UA_Mod=4`` or ``UA_Mod=5``. ``UAStartRad`` is the starting rotor radius where dynamic stall will be turned on. Enter a number between 0 and 1, representing a fraction of rotor radius, @@ -338,13 +454,18 @@ Since the hub and blades are joined elements, hub buoyancy should be turned on i Nacelle Properties ~~~~~~~~~~~~~~~~~~ -The input parameters in this section pertain to the calculation of buoyant loads -on the nacelle and are only used when ``Buoyancy = TRUE``. +The input parameters in this section pertain to the calculation of buoyant and drag loads +on the nacelle and are only used when ``Buoyancy = TRUE`` or ``NacelleDrag = TRUE``. ``VolNac`` is the volume of the nacelle and ``NacCenB``` is the position (x,y,z vector) of the nacelle center of buoyancy from the yaw bearing in local nacelle coordinates. To neglect buoyant -loads on the nacelle, set ``VolNac`` to 0. +loads on the nacelle, set ``VolNac`` to 0. Only used when ``Buoyancy = TRUE``. + +``NacArea`` are the projected areas (Ax,Ay,Az vector) of the nacelle in the nacelle coordinate system, +``NacCd`` are the drag coefficients (Cdx, Cdy, Cdz vector) for the three nacelle areas defined by ``NacArea``and ``NacDragAC`` is the +position (x,y,z vector) of the nacelle aerodynamic center from +the yaw bearing in local nacelle coordinates. Only used when ``NacelleDrag = TRUE``. Tail fin AeroDynamics ~~~~~~~~~~~~~~~~~~~~~ @@ -410,7 +531,7 @@ file with name ``.AD.sum``. ```` is either specified in the I/O SETTINGS section of the driver input file when running AeroDyn standalone, or by the OpenFAST program when running a coupled simulation. See :numref:`sec:ad_SumFile` for summary file details. -If ``AFAeroMod=2``, the unsteady aero module will also generate a file +If ``UAMod>0``, the unsteady aero module will also generate a file called ``.UA.sum`` that will list all of the UA parameters used in the airfoil tables. This allows the user to check what values are being used in case the code has computed the parameters @@ -528,7 +649,7 @@ if the keyword ``DEFAULT`` is entered in place of a numerical value, ``RelThickness`` is the non-dimensional thickness of the airfoil (thickness over chord ratio), expressed as a fraction (not a percentage), typically between 0.1 and 1. -The parameter is currently used when ``UAMod=7``, but might be used more in the future. +The parameter is currently used when ``UA_Mod=7``, but might be used more in the future. The default value of 0.2 if provided for convenience. ``NonDimArea`` is the nondimensional airfoil area (normalized by the @@ -583,24 +704,24 @@ or calculating it based on the polar coefficient data in the airfoil table: - ``alphaUpper`` specifies the AoA (in degrees) of the upper boundary of fully-attached region of the cn or cl curve. It is used to - compute the separation function when ``UAMod=5``. + compute the separation function when ``UA_Mod=5``. - ``alphaLower`` specifies the AoA (in degrees) of the lower boundary of fully-attached region of the cn or cl curve. It is used to - compute the separation function when ``UAMod=5``. (The separation function + compute the separation function when ``UA_Mod=5``. (The separation function will have a value of 1 between ``alphaUpper`` and ``alphaLower``.) - ``eta_e`` is the recovery factor and typically has a value in the - range [0.85 to 0.95] for ``UAMod = 1``; if the keyword ``DEFAULT`` is + range [0.85 to 0.95] for ``UA_Mod = 1``; if the keyword ``DEFAULT`` is entered in place of a numerical value, ``eta_e`` is set to 0.9 for - ``UAMod = 1``, but ``eta_e`` is set to 1.0 for other ``UAMod`` + ``UA_Mod = 1``, but ``eta_e`` is set to 1.0 for other ``UA_Mod`` values and whenever ``FLookup = TRUE``; - ``C_nalpha`` is the slope of the 2D normal force coefficient curve in the linear region; - ``C_lalpha`` is the slope of the 2D normal lift coefficient curve - in the linear region; Used for ``UAMod=4,6``. + in the linear region; Used for ``UA_Mod=4,6``. - ``T_f0`` is the initial value of the time constant associated with *Df* in the expressions of *Df* and *f’*; if the keyword ``DEFAULT`` is @@ -661,19 +782,19 @@ or calculating it based on the polar coefficient data in the airfoil table: to 1, based on experimental results; - ``S1`` is the constant in the best fit curve of *f* for - ``alpha0`` :math:`\le` AoA :math:`\le` ``alpha1`` for ``UAMod = 1`` (and is unused + ``alpha0`` :math:`\le` AoA :math:`\le` ``alpha1`` for ``UA_Mod = 1`` (and is unused otherwise); by definition, it depends on the airfoil; - ``S2`` is the constant in the best fit curve of *f* for AoA > - ``alpha1`` for ``UAMod = 1`` (and is unused otherwise); by + ``alpha1`` for ``UA_Mod = 1`` (and is unused otherwise); by definition, it depends on the airfoil; - ``S3`` is the constant in the best fit curve of *f* for - ``alpha2`` :math:`\le` AoA :math:`\le` ``alpha0`` for ``UAMod = 1`` (and is unused + ``alpha2`` :math:`\le` AoA :math:`\le` ``alpha0`` for ``UA_Mod = 1`` (and is unused otherwise); by definition, it depends on the airfoil; - ``S4`` is the constant in the best fit curve of *f* for AoA < - ``alpha2`` for ``UAMod = 1`` (and is unused otherwise); by + ``alpha2`` for ``UA_Mod = 1`` (and is unused otherwise); by definition, it depends on the airfoil; - ``Cn1`` is the critical value of :math:`C^{\prime}_n` at leading-edge separation for @@ -700,22 +821,22 @@ or calculating it based on the polar coefficient data in the airfoil table: location at zero-lift AoA, positive for nose up; - ``k0`` is a constant in the best fit curve of :math:`\hat{x}_{cp}` and equals for :math:`\hat{x}_{AC}-0.25` - ``UAMod = 1`` (and is unused otherwise); + ``UA_Mod = 1`` (and is unused otherwise); -- ``k1`` is a constant in the best fit curve of :math:`\hat{x}_{cp}` for ``UAMod = 1`` +- ``k1`` is a constant in the best fit curve of :math:`\hat{x}_{cp}` for ``UA_Mod = 1`` (and is unused otherwise); -- ``k2`` is a constant in the best fit curve of :math:`\hat{x}_{cp}` for ``UAMod = 1`` +- ``k2`` is a constant in the best fit curve of :math:`\hat{x}_{cp}` for ``UA_Mod = 1`` (and is unused otherwise); -- ``k3`` is a constant in the best fit curve of :math:`\hat{x}_{cp}` for ``UAMod = 1`` +- ``k3`` is a constant in the best fit curve of :math:`\hat{x}_{cp}` for ``UA_Mod = 1`` (and is unused otherwise); - ``k1_hat`` is a constant in the expression of *Cc* due to - leading-edge vortex effects for ``UAMod = 1`` (and is unused + leading-edge vortex effects for ``UA_Mod = 1`` (and is unused otherwise); -- ``x_cp_bar`` is a constant in the expression of :math:`\hat{x}_{cp}^{\nu}` for ``UAMod = +- ``x_cp_bar`` is a constant in the expression of :math:`\hat{x}_{cp}^{\nu}` for ``UA_Mod = 1`` (and is unused otherwise); if the keyword ``DEFAULT`` is entered in place of a numerical value, ``x_cp_bar`` is set to 0.2; and @@ -876,29 +997,33 @@ An example of tail fin input file is given below: Comment ====== General inputs ============================================================= 1 TFinMod - Tail fin aerodynamics model {0: none, 1: polar-based, 2: USB-based} (switch) - 0.5 TFinChord - Tail fin chord (m) [used only when TFinMod=1] - 0.3 TFinArea - Tail fin planform area (m^2) [used only when TFinMod=1] + 0.3 TFinArea - Tail fin planform area (m^2) 10.,0.,0. TFinRefP_n - Undeflected position of the tail fin reference point wrt the tower top (m) 0.,0.,0. TFinAngles - Tail fin chordline skew, tilt, and bank angles about the reference point (degrees) 0 TFinIndMod - Model for induced velocity calculation {0: none, 1:rotor-average} (switch) ====== Polar-based model ================================ [used only when TFinMod=1] - 1 TFinAFID - Index of Tail fin airfoil number [1 to NumAFfiles] - ====== Unsteady slender body model ===================== [used only when TFinMod=2] - [TODO inputs for model 2] + 1 TFinAFID - Index of Tail fin airfoil number [1 to NumAFfiles] + 0.5 TFinChord - Tail fin chord (m) + ====== Unsteady slender body model ===================== [used only when TFinMod=2] + 0.9 TFinKp - Tail fin potential flow coefficient (-) + 0.3,0.1,0.1 TFinSigma - Tail fin empirical constant for vortex separation functions (1/deg) + 40,60,60 TFinAStar - Tail fin initial angles for vortex separation functions (deg) + 3.1416 TFinKv - Tail fin vortex lift coefficient (-) + 1.3 TFinCDc - Tail fin drag coefficient (-) General inputs ~~~~~~~~~~~~~~ -**TFinMod** Switch to select a model for the tail fin aerodynamics: +``TFinMod`` is a switch to select a model for the tail fin aerodynamics: 0) none (the aerodynamic forces are zero), 1) polar-based, 2) USB-based (see :numref:`TF-aerotheory`). (switch) -**TFinArea** Area of the tail fin. (m^2) +``TFinArea`` is the area of the tail fin. (m^2) This is the plan form area of the tail fin plate used to relate the local dynamic pressure and airfoil coefficients to aerodynamic loads. This value must not be negative and is only used when TFinMod is set to 1. (m^2) -**TFinRefP_n** Undeflected position (:math:`x_{\text{ref},x_n},x_{\text{ref},y_n}, x_{\text{ref},z_n}`) of the tail fin from the tower top in nacelle coordinates. +``TFinRefP_n`` is the undeflected position (:math:`x_{\text{ref},x_n},x_{\text{ref},y_n}, x_{\text{ref},z_n}`) of the tail fin from the tower top in nacelle coordinates. (formerly defined using ``TFinCPxn``, ``TFinCPyn``, ``TFinCPzn``). The distances defines the configuration for a furl angle of zero. For a typical upwind wind turbine, @@ -908,7 +1033,7 @@ For a typical upwind wind turbine, See :numref:`figTFGeom` and :numref:`figTFcoord1`. (m) -**TFinAngles** Angles (:math:`\theta_\text{skew},\theta_\text{tilt}, \theta_\text{bank}`) of the tail fin +``TFinAngles`` are the angles (:math:`\theta_\text{skew},\theta_\text{tilt}, \theta_\text{bank}`) of the tail fin (formerly defined as ``TFinSkew``, ``TFinTilt``, ``TFinBank``). See :numref:`figTFGeom` and :numref:`figTFcoord1`. These angles define the chordline at a furl angle of zero, where the chordline is assumed to be passing through the reference point. @@ -925,7 +1050,7 @@ This value must be greater than -180 and less than or equal to 180 degrees. -**TFinIndMod** +``TFinIndMod`` Switch to select a model for the calculation of the velocity induced by the rotor and its wake on the tailfin (not the induced velocity from the tailfin wing). The options available are: 0) none (the induced velocity is zero) @@ -936,7 +1061,7 @@ The options available are: Polar-based model inputs ~~~~~~~~~~~~~~~~~~~~~~~~ -**TFinAFID** +``TFinAFID`` This integer tells AeroDyn which of the input airfoil files (``AFNames``) is assigned to the tail fin. For instance, a value of 2 means that the tail fin will use ``AFNames(2)`` for the local tail fin airfoil. This value must be @@ -945,7 +1070,21 @@ between 1 and ``NumAFfiles`` and is only used when TFinMod is set to 1. (-) Unsteady slender body (USB) model inputs ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Refer to :numref:`TF-aerotheory` and :cite:`ad-hammam_NREL:2023` for guidance on how to select parameters for the unsteady slender body theory based model. + +``TFinKp`` +Potential lift coefficient for unsteady aerodynamics. ``TFinKp`` is used to calculate the potential flow contribution to the unsteady aerodynamic force on the tail fin. + +``TFinSigma`` +Tail fin empirical constants characterizing the decay of separation functions used in the unsteady aerodynamic model. The separation functions and their dependence on ``TFinSigma`` are described in :numref:`TF-aerotheory`. + + +``TFinAStar`` +Tail fin characteristics angles for separation functions used in the unsteady aerodynamic model. The separation functions and their dependence on ``TFinAStar`` are described in :numref:`TF-aerotheory`. -This option is currently not available and will be documented in a future release. +``TFinKv`` +Vortex lift coefficient for unsteady aerodynamics. ``TFinKv`` is used to calculate the vortex flow contribution to the unsteady aerodynamic force on the tail fin. +``TFinCDc`` +Tail fin drag coefficient used for unsteady aerodynamic model. The drag on the tail fin significantly contributes to the normal force at high yaw angles. diff --git a/docs/source/user/aerodyn/introduction.rst b/docs/source/user/aerodyn/introduction.rst index c743fc2875..d4f845f374 100644 --- a/docs/source/user/aerodyn/introduction.rst +++ b/docs/source/user/aerodyn/introduction.rst @@ -69,7 +69,7 @@ driver code, without aero-elastic coupling. AeroDyn consists of six submodels: (1) rotor wake/induction, (2) blade airfoil aerodynamics, (3) tower influence on the fluid local to the -blade nodes, (4) tower drag, (5) aeroacoustics, +blade nodes, (4) tower and nacelle drag, (5) aeroacoustics, and (6) buoyancy on the blades, hub, nacelle, and tower (for MHK turbines). Nacelle, hub, and tail-vane fluid influence and loading (with the exception of nacelle and hub buoyant loads) and wake and array effects between @@ -179,9 +179,15 @@ structural motion, depending on features enabled). The tower drag load calculation is quasi-steady and independent from the tower influence on flow models. +Similarly, the aerodynamics drag loads on the nacelle is calculated using the +nacelle geometry, drag coefficients, and the local relative fluid +velocity between the freestream (undisturbed) flow and nacelle. The +nacelle drag load calculation is quasi-steady and independent from the +rotors influence on flow models. + The primary AeroDyn input file defines modeling options, environmental conditions (except freestream flow), airfoils, tower nodal -discretization and properties, tower, hub, and nacelle buoyancy properties, +discretization and properties, tower, hub, and nacelle properties, as well as output file specifications. Airfoil data properties are read from dedicated inputs files (one for each airfoil) and include coefficients of lift force, drag force, and optional pitching moment and minimum pressure diff --git a/docs/source/user/aerodyn/modeling.rst b/docs/source/user/aerodyn/modeling.rst index fa245af95c..95858d5d05 100644 --- a/docs/source/user/aerodyn/modeling.rst +++ b/docs/source/user/aerodyn/modeling.rst @@ -66,7 +66,7 @@ Model Options Under Operational and Parked/Idling Conditions ------------------------------------------------------------ To model an operational rotor, we recommend to include the dynamic BEM model -(``WakeMod = 2``) and UA (``AFAeroMod = 2``). Normally, the Pitt and +(``Wake_Mod = 1``) and UA (``AFAeroMod = 2``). Normally, the Pitt and Peters skewed-wake (``SkewMod = 2``), Prandtl tip-loss (``TipLoss = TRUE``), Prandtl hub-loss (``HubLoss = TRUE``), and tangential induction (``TanInd = TRUE``) models should all be enabled, but @@ -91,7 +91,7 @@ normal force, tangential force, and pitching-moment coefficient hysteresis and to adjust the UA model parameters appropriately.* To model a parked or idling rotor, we recommend to disable induction -(``WakeMod = 0``) and UA (``AFAeroMod = 1``), in which case the +(``Wake_Mod = 0``) and UA (``AFAeroMod = 1``), in which case the inflow velocity and angle are determined purely geometrically and the airfoil data is determined statically. @@ -110,10 +110,12 @@ Linearization When coupled to FAST, AeroDyn can be linearized as part of the -linearization of the full coupled solution. When induction is enabled -(``WakeMod = 1``), we recommend to base the linearized solution on the -frozen-wake assumption, by setting ``FrozenWake = TRUE``. The UA -models are not set up to support linearization, so, UA must be disabled -during linearization by setting ``AFAeroMod = 1``. Linearization is not -currently possible when modeling an MHK turbine, but we will attempt to -enable it in an upcoming release. +linearization of the full coupled solution. +A subset of the AeroDyn modules options are available. + +Dynamic wake can be linearized with +`DBEMT_Mod=-1` (frozen-wake) +`DBEMT_Mod=3` (dynamic continuous state-space model). + +Unsteady aerodynamics can be linearized with: +`UAMod={0, 4, 5, 7`} (no UA, or continuous state-space models). diff --git a/docs/source/user/aerodyn/theory_tailfin.rst b/docs/source/user/aerodyn/theory_tailfin.rst index 5c5a356a7e..f6c458e61b 100644 --- a/docs/source/user/aerodyn/theory_tailfin.rst +++ b/docs/source/user/aerodyn/theory_tailfin.rst @@ -34,7 +34,8 @@ The reference orientation (when the structure is un-deflected), the transformati \boldsymbol{R}_\text{tf,i} = \operatorname{EulerConstruct}(\theta_\text{bank}, \theta_\text{tilt}, \theta_\text{skew}) For a common application with a vertical fin, the three angles are zero. -:red:`TODO: The order of the angles might be different in the current implementation (3-2-1) instead of (1-2-3) above)` + +.. :red:`TODO: The order of the angles might be different in the current implementation (3-2-1) instead of (1-2-3) above)` **Velocities** @@ -45,7 +46,6 @@ The following velocity vectors (3D vectors in global coordinates) are defined (s Undisturbed Wind speed vector at the reference point - :math:`\boldsymbol{V}_\text{dist}`: Disturbed wind speed vector at the reference point (the disturbed wind contains the influence of the tower on the flow). AeroDyn has internal methods to compute :math:`\boldsymbol{V}_\text{dist}` from :math:`\boldsymbol{V}_\text{wind}`. - :red:`For now, we use "wind" but in the future we might use "dist". In the theory below we would simply replace all the "wind" by "dist"`. - :math:`\boldsymbol{V}_\text{elast}`: Structural translational velocity vector at the reference point - :math:`\boldsymbol{V}_\text{ind}`: @@ -53,6 +53,8 @@ The following velocity vectors (3D vectors in global coordinates) are defined (s - :math:`\boldsymbol{\omega}`: Structural rotational velocity of the fin +.. :red:`For now, we use "wind" but in the future we might use "dist". In the theory below we would simply replace all the "wind" by "dist"`. + All velocities (except for :math:`\boldsymbol{V}_\text{ind}` and :math:`\boldsymbol{V}_\text{dist}` which are computed internally by AeroDyn) are provided as input to the aerodynamic solver. The relative wind experienced by the airfoil is given by: @@ -145,13 +147,12 @@ The rotor-averaged induced velocity can also be used as an estimate (`TFinIndMod \boldsymbol{V}_\text{ind}=\frac{1}{n_B n_r}\sum_{i_b=1..n_B} \sum_{i_r=1..n_r} \boldsymbol{V}_{\text{ind},\text{blade}}[i_b, i_r] Where :math:`\boldsymbol{V}_{\text{ind},\text{blade}}[i_b, i_r]` is the induced velocity vector for blade :math:`i_b` and at the radial node :math:`i_r`. -:red:`NOTE: This averaging corresponds to what is done for the disk-average of the inflow in AeroDyn. In the future, we can use something weighted by the radius, or using precomputed coefficients, as done by Envision`. + +.. :red:`NOTE: This averaging corresponds to what is done for the disk-average of the inflow in AeroDyn. In the future, we can use something weighted by the radius, or using precomputed coefficients, as done by Envision`. More advanced models could set the induced velocity to zero when outside of the wake boundary, or include a tower-shadow-like wake model. Such option is not yet available. - - Polar-based model ----------------- @@ -163,9 +164,30 @@ The user only needs to indicate the index `TFinAFIndex` within the list `AFNames Unsteady slender body model --------------------------- -The unsteady slender body (USB) model is documented in :cite:`ad-hammam2022`. +The unsteady aerodynamics of the tail fin is modeled based on Unsteady Slender Body Theory. +The theory is extended to include the effect of high yaw angle :cite:`ad-hammam_NREL:2023`. +To simplify the implementation, it is assumed that that arm length of the tail fin is much greater than the chord and the characteristic time (chord/wind speed) is small. + +The normal force on the tail fin can be described as the sum of three contributions (potential lift, vortex lift, and drag), weighted by separation functions :math:`x_i` as: + +.. math:: + :label: tfusbforce + + N = \frac{\rho}{2} A_{tf} \bigg( K_p x_1 V_{\text{rel},x} V_{\text{rel},y} + \Big[x_2 K_v+(1- x_3)C_{Dc} \Big] V_{\text{rel},y}\big|V_{\text{rel},y}\big|\bigg) + +where :math:`\rho` is the density of air, :math:`A_{tf}` is the tail fin area, :math:`K_p` is the potential lift coefficient and :math:`K_v` is the vortex lift coefficient, and :math:`C_{Dc}` is the drag coefficient. +Note that the sign convnetion of OpenFAST is slightly different than used in :cite:`ad-hammam_NREL:2023`. +This is reflected in Equation :eq:`tfusbforce`. + + +:math:`x_i` are the separation functions calculated using a quasi-steady approximation as: + +.. math:: :label: TFUSBxiEquation -The theory will be implemented and documented in a future release. + x_i = (1+exp{[\sigma_i (|\gamma_{tf}|-\alpha^*_i)]})^{-1} +where :math:`\sigma_i` are empirical constants characterizing the decay of separation functions, :math:`\gamma_{tf}` is the yaw angle of the tail fin with respect to the free-stream wind (:math:`V_{\text{wind}}`), :math:`\alpha^*_i` are the characteristics angles for separation functions. +:math:`x_i` takes on a value between 0 and 1, and are used to activate or deactivate a the contribution of potential lift, vortex lift and drag to the normal force on the tail fin. +The normal force is assumed to act at the user defined reference point on the tail fin and the moment of the normal force is calculated accordingly. diff --git a/docs/source/user/aerodyn/theory_ua.rst b/docs/source/user/aerodyn/theory_ua.rst index 005e478fdd..2a67b8fdd5 100644 --- a/docs/source/user/aerodyn/theory_ua.rst +++ b/docs/source/user/aerodyn/theory_ua.rst @@ -25,6 +25,12 @@ speed increases, but stall is delayed. + + + +.. _ua_theory: + + Theory ------ @@ -489,6 +495,12 @@ where :math:`\alpha_{50}` is computed the same way as :math:`\alpha_{34}` (using + + + + +.. _UA_inputs: + Inputs ------ @@ -503,6 +515,10 @@ An example of profile data (containing some of the unsteady aerodynamic paramete :download:`(here) `. +The unsteady aerodynamic driver inputs are documented in :numref:`ua_driver`. + + + .. _UA_AFI_defaults: Calculating Default Airfoil Coefficients @@ -579,17 +595,195 @@ to set preprocessor variable ``UA_OUTS`` and recompile the program (OpenFAST, Ae The outputs are written in output files with extension `*.UA.out`. To activate these outputs with `cmake`, compile using ``-DCMAKE_Fortran_FLAGS="-DUA_OUTS=ON"`` +When using the driver, there is no need to use this preprocessor variable. + +.. _ua_aeroelasttheory: + +Aeroelastic simulation of a 2D section +-------------------------------------- + +Aeroelastic simulations of an isolated 2D section are possible using the driver in order to use the unsteady aerodynamic model in a simplified context. +See :numref:`ua_driver`. +The theory and description for the aeroelastic simulation can be found in +:cite:`ad-UAElast:torquepaper`. + + + + +.. _ua_driver: + Driver ------ -A driver is available to run simulations for a single airfoil, using sinusoidal variation of the angle of attack, -or user defined time series of angle of attack, relative wind speed and pitch rate. + +A driver is available to run simulations for a single airfoil. + +Different kind of simulations are possible: + + - using sinusoidal variation of the angle of attack, + - user defined time series of angle of attack, relative wind speed and pitch rate. + - aero elastic simulations with 3 degrees of freedom for the elastic motion of the section in it's 2D plane (flap, edge and torsion), with possibility to prescribe time series of the wind speed, or prescribe the motion of the section. + +The theory and description for the aeroelastic simulation can be found in :cite:`ad-UAElast:torquepaper`. + + + + + +Compilation +~~~~~~~~~~~ Using `cmake`, the driver is compiled using `make unsteadyaero_driver`, resulting as an executable in the `aerodyn` folder. -An example of driver input file is available here: :download:`here <../aerodyn-dynamicStall/examples/UA-driver.dvr>`. -An example of time series input is available here: :download:`here <../aerodyn-dynamicStall/examples/UA-driver-timeseries.dat>` + +Driver Inputs +~~~~~~~~~~~~~ + +An example of input file for the unsteady aerodynamic driver can be found in the `r-test repository `__. + + +The differente inputs are described below. + + + +**Environmental conditions** + + +``FldDens``: Density of working fluid (kg/m^3) + +``KinVisc``: Kinematic viscosity of working fluid (m^2/s) + +``SpdSound``: Speed of sound of working fluid (m/s) + + +**Unsteady aerodynamics options** + +``UAMod`` : Unsteady Aero Model Switch (switch) {2=B-L Gonzalez, 3=B-L Minnema/Pierce, 4=B-L HGM 4-states, 5=B-L 5 states, 6=Oye, 7=Boeing-Vertol} [used only when AFAeroMod=2] + +``FLookup`` : Flag to indicate whether a lookup for f' will be calculated (TRUE) or whether best-fit exponential equations will be used (FALSE); if FALSE S1-S4 must be provided in airfoil input files (flag) [used only when AFAeroMod=2] + + +**Airfoil properties** + +``AirFoil``: Airfoil table (Column 1: Angle of Attack (AoA), column 2: Lift coeff, column 3: Drag coeff). + +``Chord`` : Chord length (m) + +``Vec_AQ`` : Vector from reference point "A" to aerodynamic center (~quarter chord) "Q" in airfoil coordinates and in chord length. If "A" is at mid chord values are likely (0, -0.25) (-) + +``Vec_AT`` : Vector from reference point "A" to three-quarter chord point "T" in airfoil coordinates and in chord length. If "A" is at mid chord values are likely (0, 0.25) (-) + +``UseCm`` : Use Cm (moment coefficient) data in airfoil table {true/false} + + +**Simulation control** + +``SimMod``: Simulation model {1=reduced frequency model, 2=prescribed-aero time series, 3=elastic cross section} + + +**Reduced-frequency simulation** (``SimMod=1``) + +``InflowVel`` : Inflow velocity (m/s) + +``NCycles`` : Number of angle-of-attack oscillations over the length of the simulation (-) + +``StepsPerCycle`` : Number of timesteps per cycle (-) + +``Frequency`` : Frequency for the airfoil oscillations (Hz) + +``Amplitude`` : Amplitude of the angle of attack oscillations (deg) + +``Mean`` : Cycle mean (deg) + +``Phase`` : Initial phase (num steps). + + +**Prescribed aerodynamic simulation inputs** (``SimMod=2``) + +``TMax_PA`` : Total run time (s) + +``DT_PA`` : Recommended module time step (s) + +``AeroTSFile``: Time series data in delimited input file (e.g. csv) with 1 header line, 4 columns: Time (s), angle-of-attack (deg), InflowVel (m/s), Pitch rate (rad/s) + + +**Aeroelastic simulation** (``SimMod=3``) + +The theory for the aeroelastic simulation can be found in :numref:`ua_aeroelasttheory`. + +``TMax`` : Total run time (s) + +``DT`` : Time step (s). + +``ActiveDOF`` : List of Degrees of freedom that are active (true or false) + +``InitPos`` : List of initial positions for the elastic degrees of freedom (m, m and rad) + +``InitVel`` : List of initial velocities for the elastic degrees of freedom (m/s, m/s, and rad/s) + +``GFScalingL1`` : Generalized force scaling factors to convert from section loads to generalized loads (3x3). Three values per line. + +``MassMatrixL1`` : Mass matrix (3x3). Three values per line. + +``DampMatrixL1`` : Damping matrix (3x3). Three values per line. + +``StifMatrixL1`` : Stiffness matrix (3x3). Three values per line. + +``Twist`` : Fixed twist of the section when torsion degree of freedom is zero (deg) + +``InflowMod`` : Model for the inflow velocity. {1: constant velocity, 2: time series} + +``Inflow`` : Inflow velocity in x and y direction [used only when InflowMod=1] + +``InflowTSFile`` : Input file for inflow velocity. Delimited file (e.g. csv) with one header line, three columns: Time (s), Ux (m/s), Uy (m/s). [used only when InflowMod=2] + +``MotionMod`` : Model for the motion of the degrees of freedom {1: dynamic, 2: prescribed} + +``MotionTSFile`` : Input file for prescribed motion. Delimited file (e.g. csv) with one header line, 10 columns: Time (s), x (m), y (m), th (rad), velocities, and accelerations. [used only when InflowMod=2] + + +**Output control** + +``SumPrint`` : Write unsteady aerodynamics summary file (flag) + +``WrAFITables`` : Write back the aerodynamic coefficients used internally (flag) + + +**Example CSV input files** + +The unsteady aerodyn driver now relies on CSV files for it's input time series. +The time column does not need to be at a constant time step, but needs to be monotonously increasing. + +Prescribed aero input (``SimMod=2``): + +.. code: + + Time_[s] , Alpha_[deg] , VRel_[m/s] , omega_[rad/s] + 0.0 , 0 , 10 , 0 + 0.01 , 0 , 10 , 0 + + +Inflow file input (``SimMod=3``, ``InflowMod=2``): + +.. code: + + Time_[s] , Ux_[m/s], Uy_[m/s] + 0.0 , 1 , 10 + 1.0 , 2 , 10 + 5.0 , 2 , 8 + 10.0 , 1 , 12 + + +Motion file input (``SimMod=3``, ``MotionMod=2``) (note in this dummy exmaple velocities and accelerations are not provided, but preferably they should be): + +.. code: + + Time_[s] , x_[m] , y_[m] , th_[rad] , xd_[m/s] , yd_[m/s] , thd_[rad/s] , xdd_[m/s^2] , ydd_[m/s^2] , thdd_[rad/s^2] + 0.0 , 1 , 1 , 1 , 0 , 0 , 0 , 0 , 0 , 0 + 1.0 , 2 , 2 , 2 , 0 , 0 , 0 , 0 , 0 , 0 + 5.0 , 2 , 2 , 2 , 0 , 0 , 0 , 0 , 0 , 0 + 10.0 , 1 , 1 , 1 , 0 , 0 , 0 , 0 , 0 , 0 diff --git a/docs/source/user/aeromap/examples/AeroMap.dvr b/docs/source/user/aeromap/examples/AeroMap.dvr new file mode 100644 index 0000000000..303e9fe5f3 --- /dev/null +++ b/docs/source/user/aeromap/examples/AeroMap.dvr @@ -0,0 +1,40 @@ +------- OpenFAST AeroMap INPUT FILE ---------------------------------------------- +AeroMap generation for FAST Certification Test #18: NREL 5.0 MW Baseline Wind Turbine (Onshore) +---------------------- OpenFAST MODEL FILE --------------------------------------- +"openfast.fst" FstFile - Name of the primary OpenFAST input file (-) +---------------------- STEADY-STATE SIMULATION CONTROL -------------------------------------- +false Echo - Echo input data to .ech (flag) + 1e-4 Toler - Convergence tolerance for nonlinear solve residual equation [>0] (-) + 50 MaxIter - Maximum number of iteration steps for nonlinear solve [>0] (-) + 1 N_SSJac - Number of iteration steps to recalculate steady-state Jacobian (-) [1=every iteration step, 2=every other step] (Note: for large flexible blades, this almost always needs to be 1) + 1E+05 SSJacSclFact - Scaling factor used in steady-state Jacobians (-) [on order of blade mass in kg] +---------------------- STEADY-STATE CASES -------------------------------------- + 1 WindSpeedOrTSR - Choice of swept parameter (switch) { 1:wind speed; 2: TSR } + 25 NumCases - Number of cases to run +RotSpeed WndSpeedOrTSR Pitch +(rpm) (m/s or -) (deg) + 8.0000 3.0000 0.0000 + 8.0000 6.0000 0.0000 + 8.0000 9.0000 0.0000 + 8.0000 12.0000 0.0000 + 8.0000 15.0000 0.0000 + 8.0000 15.0000 3.0000 + 8.0000 12.0000 3.0000 + 8.0000 9.0000 3.0000 + 8.0000 6.0000 3.0000 + 8.0000 3.0000 3.0000 + 8.0000 3.0000 6.0000 + 8.0000 6.0000 6.0000 + 8.0000 9.0000 6.0000 + 8.0000 12.0000 6.0000 + 8.0000 15.0000 6.0000 + 8.0000 15.0000 9.0000 + 8.0000 12.0000 9.0000 + 8.0000 9.0000 9.0000 + 8.0000 6.0000 9.0000 + 8.0000 3.0000 9.0000 + 8.0000 3.0000 12.0000 + 8.0000 6.0000 12.0000 + 8.0000 9.0000 12.0000 + 8.0000 12.0000 12.0000 + 8.0000 15.0000 12.0000 diff --git a/docs/source/user/api_change.rst b/docs/source/user/api_change.rst index 242ab07a03..91cd6f0985 100644 --- a/docs/source/user/api_change.rst +++ b/docs/source/user/api_change.rst @@ -9,7 +9,125 @@ The changes are tabulated according to the module input file, line number, and f The line number corresponds to the resulting line number after all changes are implemented. Thus, be sure to implement each in order so that subsequent line numbers are correct. -OpenFAST v3.5.4 to OpenFAST v3.5.5 + + +OpenFAST v3.5.5 to OpenFAST 4.0.0 +--------------------------------- + +The HydroDyn module was split into HydroDyn and SeaState. This results in a +completely new input file for SeaState, and complete revision of the HydroDyn +input file. See examples in the regression tests for the new formats. + +New modules AeroDisk (see :numref:`ADsk`), Simplified-ElastoDyn (see +:numref:`SED`), and SeaState (see :numref:`SeaSt`) were added. See +documentation on those modules for exmple input files. + +============================================= ======== ==================== ======================================================================================================================================================================================================== +Modified in OpenFAST `dev` +------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------ +Module Line Flag Name Example Value +============================================= ======== ==================== ======================================================================================================================================================================================================== +OpenFAST 13 CompElast 3 CompElast - Compute structural dynamics (switch) {1=ElastoDyn; 2=ElastoDyn + BeamDyn for blades; 3=Simplified ElastoDyn} +OpenFAST 15 CompAero\** 2 CompAero - Compute aerodynamic loads (switch) {0=None; 1=AeroDisk; 2=AeroDyn; 3=ExtLoads} +OpenFAST 17 CompSeaSt 0 CompSeaSt - Compute sea state information (switch) {0=None; 1=SeaState} +OpenFAST 41 SeaStFile "unused" SeaStFile - Name of file containing sea state input parameters (quoted string) +AeroDyn all Complete restructuring of input file (see notes below) +AeroDyn Aeroacoustics 11\* TI 0.1 TI - Rotor-incident wind turbulence intensity (-) [Only used if TiCalcMeth == 1] +AeroDyn Aeroacoustics 12\* avgV 8 avgV - Average wind speed used to compute the section-incident turbulence intensity (m/s) [Only used if TiCalcMeth == 1] +HydroDyn all Complete restructuring of input file +SeaState all New module (split from HydroDyn, so contains some inputs previously found in HydroDyn) +AeroDisk all New module +Simplified-ElastoDyn all New module +ElastoDyn 84 PtfmXYIner 0 PtfmXYIner - Platform xy moment of inertia about the platform CM (=-int(xydm)) (kg m^2) +ElastoDyn 84 PtfmYZIner 0 PtfmYZIner - Platform yz moment of inertia about the platform CM (=-int(yzdm)) (kg m^2) +ElastoDyn 84 PtfmXZIner 0 PtfmXZIner - Platform xz moment of inertia about the platform CM (=-int(xzdm)) (kg m^2) +ElastoDyn 101 ---------------------- YAW-FRICTION -------------------------------------------- +ElastoDyn 102 YawFrctMod 0 YawFrctMod - Yaw-friction model {0: none, 1: friction independent of yaw-bearing force and bending moment, 2: friction with Coulomb terms depending on yaw-bearing force and bending moment... +ElastoDyn 103 M_CSmax 300 M_CSmax - Maximum static Coulomb friction torque (N-m) [M_CSmax when YawFrctMod=1; abs(Fz)*M_CSmax when YawFrctMod=2 and Fz<0] +ElastoDyn 104 M_FCSmax 0 M_FCSmax - Maximum static Coulomb friction torque proportional to yaw bearing shear force (N-m) [sqrt(Fx^2+Fy^2)*M_FCSmax; only used when YawFrctMod=2] +ElastoDyn 105 M_MCSmax 0 M_MCSmax - Maximum static Coulomb friction torque proportional to yaw bearing bending moment (N-m) [sqrt(Mx^2+My^2)*M_MCSmax; only used when YawFrctMod=2] +ElastoDyn 106 M_CD 40 M_CD - Dynamic Coulomb friction moment (N-m) [M_CD when YawFrctMod=1; abs(Fz)*M_CD when YawFrctMod=2 and Fz<0] +ElastoDyn 107 M_FCD 0 M_FCD - Dynamic Coulomb friction moment proportional to yaw bearing shear force (N-m) [sqrt(Fx^2+Fy^2)*M_FCD; only used when YawFrctMod=2] +ElastoDyn 108 M_MCD 0 M_MCD - Dynamic Coulomb friction moment proportional to yaw bearing bending moment (N-m) [sqrt(Mx^2+My^2)*M_MCD; only used when YawFrctMod=2] +ElastoDyn 109 sig_v 0 sig_v - Linear viscous friction coefficient (N-m/(rad/s)) +ElastoDyn 110 sig_v2 0 sig_v2 - Quadratic viscous friction coefficient (N-m/(rad/s)^2) +ElastoDyn 111 OmgCut 0 OmgCut - Yaw angular velocity cutoff below which viscous friction is linearized (rad/s) +ElastoDyn blade file 15 Removal of the `PitchAxis` input column +InflowWind driver 27 ---- Output VTK slices ------------------------------------------------------ +InflowWind driver 28 NOutWindXY 0 NOutWindXY -- Number of XY planes for output .XY.t.vtk (-) [0 to 9] +InflowWind driver 29 OutWindZ 90 OutWindZ -- Z coordinates of XY planes for output (m) [1 to NOutWindXY] [unused for NOutWindXY=0] +MoorDyn -- New optional sections (freeform file). See MoorDyn documentation for details +SubDyn 8 --removed-- removed: GuyanLoadCorrection +SubDyn 12 --removed-- removed: CBMod +SubDyn 56\* ----------------------- SPRING ELEMENT PROPERTIES ------------------------------------- +SubDyn 57\* NSpringPropSets 0 - Number of spring properties +SubDyn 58\* PropSetID k11 k12 k13 k14 k15 k16 k22 k23 k24 k25 k26 k33 k34 k35 k36 k44 k45 k46 k55 k56 k66 +SubDyn 59\* (-) (N/m) (N/m) (N/m) (N/rad) (N/rad) (N/rad) (N/m) (N/m) (N/rad) (N/rad) (N/rad) (N/m) (N/rad) (N/rad) (N/rad) (Nm/rad) (Nm/rad) (Nm/rad) (Nm/rad) (Nm/rad) (Nm/rad) +FAST.Farm 16 WrMooringVis true WrMooringVis - Write shared mooring visualization, at DT_Mooring timestep (-) [only used for Mod_SharedMooring=3] +FAST.Farm 48\* RotorDiamRef 125 RotorDiamRef - Reference turbine rotor diameter for wake calculations (m) [>0.0] +FAST.Farm 53\* k_vAmb DEFAULT k_vAmb - Calibrated parameters for the influence of the ambient turbulence in the eddy viscosity (set of 5 parameters: k, FMin, DMin, DMax, Exp) (-) [>=0.0, >=0.0 and <=1.0, >=0.0, >DMin, >0.0] or DEFAULT [DEFAULT=0.05, 1.0, 0.0, 1.0, 0.01] +FAST.Farm 54\* kvShr DEFAULT k_vShr - Calibrated parameters for the influence of the shear layer in the eddy viscosity (set of 5 parameters: k, FMin, DMin, DMax, Exp) (-) [>=0.0, >=0.0 and <=1.0, >=0.0, >DMin, >0.0] or DEFAULT [DEFAULT=0.016, 0.2, 3.0, 25.0, 0.1] +FAST.Farm 55-62\* --removed-- +FAST.Farm 69\* --- WAKE-ADDED TURBULENCE --- +FAST.Farm 70\* WAT 2 WAT - Switch between wake-added turbulence box options {0: no wake added turbulence, 1: predefined turbulence box, 2: user defined turbulence box} (switch) +FAST.Farm 71\* WAT_BoxFile "../WAT_MannBoxDB/FFDB_D100_512x512x64.u" WAT_BoxFile - Filepath to the file containing the u-component of the turbulence box (either predefined or user-defined) (quoted string) +FAST.Farm 72\* WAT_NxNyNz 512, 512, 64 WAT_NxNyNz - Number of points in the x, y, and z directions of the WAT_BoxFile [used only if WAT=2, derived value if WAT=1] (-) +FAST.Farm 73\* WAT_DxDyDz 5.0, 5.0, 5.0 WAT_DxDyDz - Distance (in meters) between points in the x, y, and z directions of the WAT_BoxFile [used only if WAT=2, derived value if WAT=1] (m) +FAST.Farm 74\* WAT_ScaleBox default WAT_ScaleBox - Flag to scale the input turbulence box to zero mean and unit standard deviation at every node [DEFAULT=False] (flag) +FAST.Farm 75\* WAT_k_Def default WAT_k_Def - Calibrated parameters for the influence of the maximum wake deficit on wake-added turbulence (set of 5 parameters: k_Def, FMin, DMin, DMax, Exp) (-) [>=0.0, >=0.0 and <=1.0, >=0.0, >DMin, >0.0] or DEFAULT [DEFAULT=[0.6, 0.0, 0.0, 2.0, 1.0 ]] +FAST.Farm 76\* WAT_k_Grad default WAT_k_Grad - Calibrated parameters for the influence of the radial velocity gradient of the wake deficit on wake-added turbulence (set of 5 parameters: k_Grad, FMin, DMin, DMax, Exp) (-) [>=0.0, >=0.0 and <=1.0, >=0.0, >DMin, >0.0] or DEFAULT [DEFAULT=[3.0, 0.0, 0.0, 12.0, 0.65] +============================================= ======== ==================== ======================================================================================================================================================================================================== + +\*Exact line number depends on number of entries in various preceeding tables. + +\*\* The AeroDyn 14 module has been removed and replaced with AeroDisk. AeroDyn15 renamed to AeroDyn + +New Modules +~~~~~~~~~~~ + +- AeroDisk -- reduced order actuator disk model (see :numref:`ADsk`) +- Simplified ElastoDyn -- a reduced order structural model with only yaw and rotor speed degrees of freedom (see :numref:`SED`) +- SeaState -- wave dynamics calculations (previously part of HydroDyn) + + +.. _api_change_ad4x: + +AeroDyn changes starting from v4.x +---------------------------------- + +The table below shows how to convert from the Old AeroDyn inputs to the new AeroDyn inputs. +Additional ressources: + +- The AeroDyn input file description (:numref:`ad_input`) for more details on the new inputs. + +- The `discussion `__ that led to these new inputs. + +- An example of AeroDyn input file at it's latest format: :download:`Example `: + +- A directory with a working example: `here `__ + +- An example python converter (v3.5.x to 4.x): `here `__ + + +=========================== ========================================================= +Old inputs Corresponding new inputs +=========================== ========================================================= +`WakeMod=0` `Wake_Mod=0` +`WakeMod=1` ("BEM") `Wake_Mod=1` and `DBEMT_Mod=0` and `BEM_Mod=1` +`WakeMod=2` ("DBEMT") `Wake_Mod=1` and `DBEMT_Mod={1,2,3}` +`WakeMod=3` ("OLAF") `Wake_Mod=3` +`AFAeroMod=1` `UA_Mod=0` and `AoA34=False` +`AFAeroMod=2` `UA_Mod>0` and `AoA34=True` and `UA_Mod=UAMod` +`FrozenWake=True` `DBEMT_Mod=-1` +`FrozenWake=False` `DBEMT_Mod=0` (quasi-steady) or `DBEMT_Mod>0` (dynamic) +`SkewMod=2` (Glauert) `Skew_Mod=1` and `SkewRedistr_Mod=1` +`SkewMod=0` (Orthogonal) `Skew_Mod=-1` +`SkewModFactor` `SkewRedistrFactor` +`UAMod={2-7}` `UA_Mod={2-7}` and `AoA34=True` +=========================== ========================================================= + + +OpenFAST v3.5.4 to OpenFAST v3.5.5 ---------------------------------- No input file changes were made. @@ -41,6 +159,7 @@ output channels: AeroDyn nodal outputs for another coordinate system, new MoorDyn output names (Connect changed to Point). + OpenFAST v3.4.0 to OpenFAST v3.5.0 ---------------------------------- @@ -78,6 +197,23 @@ changed to `Fld` in v3.4.0 which caused headaches for users. The `Fld` names are now aliases to the `Aero` names. +OpenFAST v3.4.0 to OpenFAST dev +---------------------------------- + +AeroDyn14 has been removed! + +============================================= ==== ================= ======================================================================================================================================================================================================== +Changed in OpenFAST `dev` +----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------- +Module Line Flag Name Example Value +============================================= ==== ================= ======================================================================================================================================================================================================== +OpenFAST 15 CompAero 2 CompAero - Compute aerodynamic loads (switch) {0=None; 2=AeroDyn v15} +============================================= ==== ================= ======================================================================================================================================================================================================== + + + + + OpenFAST v3.3.0 to OpenFAST v3.4.0 ---------------------------------- @@ -512,7 +648,7 @@ InflowWind 49 InitPosition(x) XOffset 0 XOffset OpenFAST v2.3.0 to OpenFAST v2.4.0 ---------------------------------- -Additional nodal output channels added for :ref:`AeroDyn15`, :ref:`BeamDyn`, and :ref:`ElastoDyn`. +Additional nodal output channels added for :ref:`AeroDyn`, :ref:`BeamDyn`, and :ref:`ElastoDyn`. ============== ==== ================== ============================================================================================================================================================================= Added in OpenFAST v2.4.0 diff --git a/docs/source/user/beamdyn/appendix.rst b/docs/source/user/beamdyn/appendix.rst index 41f3023cb6..3e282ce5ae 100644 --- a/docs/source/user/beamdyn/appendix.rst +++ b/docs/source/user/beamdyn/appendix.rst @@ -51,7 +51,7 @@ outputs are expressed in one of the following three coordinate systems: .. _bd-output-channel: -.. figure:: figs/bd_output_channel.pdf +.. figure:: figs/bd_output_channel.png :width: 500px :align: center diff --git a/docs/source/user/beamdyn/examples/bd_primary_nrel_5mw.inp b/docs/source/user/beamdyn/examples/bd_primary_nrel_5mw.inp index 1fcd7475e1..9850a2f21a 100644 --- a/docs/source/user/beamdyn/examples/bd_primary_nrel_5mw.inp +++ b/docs/source/user/beamdyn/examples/bd_primary_nrel_5mw.inp @@ -78,7 +78,7 @@ True RotStates - Orient states in the rotating frame during line ---------------------- PITCH ACTUATOR PARAMETERS ------------------------------- False UsePitchAct - Whether a pitch actuator should be used (flag) 200 PitchJ - Pitch actuator inertia (kg-m^2) [used only when UsePitchAct is true] - 2E+07 PitchK - Pitch actuator stiffness (kg-m^2/s^2) [used only when UsePitchAct is true] + 20000000 PitchK - Pitch actuator stiffness (kg-m^2/s^2) [used only when UsePitchAct is true] 500000 PitchC - Pitch actuator damping (kg-m^2/s) [used only when UsePitchAct is true] ---------------------- OUTPUTS ------------------------------------------------- True SumPrint - Print summary data to ".sum" (flag) @@ -92,17 +92,18 @@ True SumPrint - Print summary data to ".sum" (flag) "N1Mxl,N1Myl,N1Mzl" "TipTDxr, TipTDyr, TipTDzr" "TipRDxr, TipRDyr, TipRDzr" -END of input file (the word "END" must appear in the first 3 columns of the last OutList line) +END of OutList section (the word "END" must appear in the first 3 columns of the last OutList line) ====== Outputs for all blade stations (same ending as above for B1N1.... =========================== (optional section) - "All" BldNd_BlOutNd - Future feature will allow selecting a portion of the nodes to output. Not implemented yet. (-) +"All" BldNd_BlOutNd - Future feature will allow selecting a portion of the nodes to output. Not implemented yet. (-) OutList - The next line(s) contains a list of output parameters. See OutListParameters.xlsx for a listing of available output channels, (-) -"TDxr, TDyr, TDzr" -"TVxr, TVyr, TVzr" -"TAxr, TAyr, TAzr" -"RDxr, RDyr, RDzr" -"RVxr, RVyr, RVzr" -"RAxr, RAyr, RAzr" -"Fxr, Fyr, Fzr" +"TDxr, TDyr, TDzr" +"TVxr, TVyr, TVzr" +"TAxr, TAyr, TAzr" +"RDxr, RDyr, RDzr" +"RVxr, RVyr, RVzr" +"RAxr, RAyr, RAzr" +"Fxr, Fyr, Fzr" "TipTDxr, TipTDyr, TipTDzr" "TipRDxr, TipRDyr, TipRDzr" -END of input file (the word "END" must appear in the first 3 columns of this last OutList line) +END (the word "END" must appear in the first 3 columns of this last OutList line in the optional nodal output section) +-------------------------------------------------------------------------------- diff --git a/docs/source/user/beamdyn/figs/bd_frame.png b/docs/source/user/beamdyn/figs/bd_frame.png new file mode 100644 index 0000000000..be606ba0b8 Binary files /dev/null and b/docs/source/user/beamdyn/figs/bd_frame.png differ diff --git a/docs/source/user/beamdyn/figs/bd_output_channel.png b/docs/source/user/beamdyn/figs/bd_output_channel.png new file mode 100644 index 0000000000..b936c34881 Binary files /dev/null and b/docs/source/user/beamdyn/figs/bd_output_channel.png differ diff --git a/docs/source/user/beamdyn/figs/n4.png b/docs/source/user/beamdyn/figs/n4.png new file mode 100644 index 0000000000..40e646d32e Binary files /dev/null and b/docs/source/user/beamdyn/figs/n4.png differ diff --git a/docs/source/user/beamdyn/figs/n8.png b/docs/source/user/beamdyn/figs/n8.png new file mode 100644 index 0000000000..60a468b720 Binary files /dev/null and b/docs/source/user/beamdyn/figs/n8.png differ diff --git a/docs/source/user/beamdyn/theory.rst b/docs/source/user/beamdyn/theory.rst index 15ccb380b3..f8a80e1e1f 100644 --- a/docs/source/user/beamdyn/theory.rst +++ b/docs/source/user/beamdyn/theory.rst @@ -23,7 +23,7 @@ Coordinate Systems .. _bd-frame: -.. figure:: figs/bd_frame.pdf +.. figure:: figs/bd_frame.png :width: 100% :align: center @@ -312,7 +312,7 @@ References :cite:`Patera:1984,Ronquist:1987,Sprague:2003,Sprague:2004`. .. _N4_lsfe: -.. figure:: figs/n4.pdf +.. figure:: figs/n4.png :width: 47% :align: center @@ -320,7 +320,7 @@ References :cite:`Patera:1984,Ronquist:1987,Sprague:2003,Sprague:2004`. .. _N8_lsfe: -.. figure:: figs/n8.pdf +.. figure:: figs/n8.png :width: 47% :align: center diff --git a/docs/source/user/cppapi/files/cDriver.i b/docs/source/user/cppapi/files/cDriver.i index 6a13912191..917208c312 100644 --- a/docs/source/user/cppapi/files/cDriver.i +++ b/docs/source/user/cppapi/files/cDriver.i @@ -3,38 +3,45 @@ # C++ glue-code for OpenFAST - Example input file # -#Total number of turbines in the simulation -nTurbinesGlob: 3 -#Enable debug outputs if set to true -debug: False -#The simulation will not run if dryRun is set to true -dryRun: False -#Flag indicating whether the simulation starts from scratch or restart -simStart: init # init/trueRestart/restartDriverInitFAST -#Start time of the simulation -tStart: 0.0 -#End time of the simulation. tEnd <= tMax -tEnd: 1.0 -#Max time of the simulation -tMax: 4.0 -#Time step for FAST. All turbines should have the same time step. -dtFAST: 0.00625 -#Restart files will be written every so many time steps -nEveryCheckPoint: 160 +n_turbines_glob: 3 # Total number of turbines in the simulation + +debug: False # Enable debug outputs if set to true + +dry_run: False # The simulation will not run if dryRun is set to true + +sim_start: init # Flag indicating whether the simulation starts from scratch or restart + # [init | trueRestart | restartDriverInitFAST] + +coupling_mode: strong # Coupling mode + # [strong | classic] + +t_start: 0.0 # Start time of the simulation + +t_end: 1.0 # End time of the simulation; tEnd <= tMax. + +t_max: 4.0 # Max time of the simulation + +dt_FAST: 0.00625 # Time step for FAST. All turbines should have the same time step. + +n_substeps: 1 # Number of substeps per timestep of the glue-code + +n_checkpoint: 160 # Restart files will be written every so many time steps + +set_exp_law_wind: false # Set velocity at the the turbine using an exponential law profile. Turbine0: - #The position of the turbine base for actuator-line simulations - turbine_base_pos: [ 0.0, 0.0, 0.0 ] - #The number of actuator points along each blade for actuator-line simulations - num_force_pts_blade: 0 - #The number of actuator points along the tower for actuator-line simulations. - num_force_pts_tower: 0 - #The checkpoint file for this turbine when restarting a simulation - restart_filename: "banana" - #The FAST input file for this turbine - FAST_input_filename: "t1_Test05.fst" - #A unique turbine id for each turbine - turb_id: 1 + + turbine_base_pos: [ 0.0, 0.0, 0.0 ] # The position of the turbine base for actuator-line simulations + + num_force_pts_blade: 0 # The number of actuator points along each blade for actuator-line simulations + + num_force_pts_tower: 0 # The number of actuator points along the tower for actuator-line simulations. + + restart_filename: "banana" # The checkpoint file for this turbine when restarting a simulation + + FAST_input_filename: "t1_Test05.fst" # The FAST input file for this turbine + + turb_id: 1 # A unique turbine id for each turbine Turbine1: turbine_base_pos: [ 0.0, 0.0, 0.0 ] diff --git a/docs/source/user/cppapi/index.rst b/docs/source/user/cppapi/index.rst index f364465560..fe970d5aeb 100644 --- a/docs/source/user/cppapi/index.rst +++ b/docs/source/user/cppapi/index.rst @@ -26,7 +26,7 @@ Command line invocation Common input file options ------------------------- -.. confval:: nTurbinesGlob +.. confval:: n_turbines_glob Total number of turbines in the simulation. The input file must contain a number of turbine specific sections (`Turbine0`, `Turbine1`, ..., `Turbine(n-1)`) that is consistent with `nTurbinesGlob`. @@ -34,37 +34,49 @@ Common input file options Enable debug outputs if set to true -.. confval:: dryRun +.. confval:: dry_run The simulation will not run if dryRun is set to true. However, the simulation will read the input files, allocate turbines to processors and prepare to run the individual turbine instances. This flag is useful to test the setup of the simulation before running it. -.. confval:: simStart +.. confval:: sim_start - Flag indicating whether the simulation starts from scratch or restart. ``simStart`` takes on one of three values: + Flag indicating whether the simulation starts from scratch or restart. ``sim_start`` takes on one of three values: * ``init`` - Use this option when starting a simulation from `t=0s`. * ``trueRestart`` - While OpenFAST allows for restart of a turbine simulation, external components like the Bladed style controller may not. Use this option when all components of the simulation are known to restart. * ``restartDriverInitFAST`` - When the ``restartDriverInitFAST`` option is selected, the individual turbine models start from `t=0s` and run up to the specified restart time using the inflow data stored at the actuator nodes from a hdf5 file. The C++ API stores the inflow data at the actuator nodes in a hdf5 file at every OpenFAST time step and then reads it back when using this restart option. This restart option is especially useful when the glue code is a CFD solver. + +.. confval:: coupling_mode + + Choice of coupling mode. ``coupling_mode`` takes one of two values: ``strong`` or ``classic``. ``strong`` coupling mode uses 2 outer iterations for every driver time step while ``classic`` coupling mode calls the `step()` function to use the loose coupling mode. -.. confval:: tStart +.. confval:: t_start Start time of the simulation -.. confval:: tEnd +.. confval:: t_end - End time of the simulation. tEnd <= tMax + End time of the simulation. t_end <= t_max -.. confval:: tMax +.. confval:: t_max Max time of the simulation -.. confval:: dtFAST +.. confval:: dt_fast Time step for FAST. All turbines should have the same time step. -.. confval:: nEveryCheckPoint +.. confval:: n_substeps + + Number of sub-timesteps of OpenFAST per time step of the driver program. + +.. confval:: n_checkpoint + + Restart files will be written every so many time steps + +.. confval:: set_exp_law_wind - Restart files will be written every so many time steps + Boolean value of True/False. When true, set velocity at the Aerodyn nodes using a power law wind profile using an exponent of 0.2 and a reference wind speed of 10 m/s at 90 meters. This option is useful to test the setup for actuator line simulations in individual mode before running massive CFD simulations. Turbine specific input options ------------------------------ diff --git a/docs/source/user/elastodyn/bibliography.bib b/docs/source/user/elastodyn/bibliography.bib new file mode 100644 index 0000000000..e6c7d35319 --- /dev/null +++ b/docs/source/user/elastodyn/bibliography.bib @@ -0,0 +1,6 @@ +@techreport{ed-hammam2023, + title={Modeling the Yaw Behavior of Tail Fins for Small Wind Turbines: November 22, 2021-May 21, 2024}, + author={Hammam, Mohamed M and Wood, David and Summerville, Brent}, + year={2023}, + institution={National Renewable Energy Laboratory (NREL), Golden, CO (United States)} +} diff --git a/docs/source/user/elastodyn/figs/YawFrictionModel.jpg b/docs/source/user/elastodyn/figs/YawFrictionModel.jpg new file mode 100644 index 0000000000..4a89c6ca0a Binary files /dev/null and b/docs/source/user/elastodyn/figs/YawFrictionModel.jpg differ diff --git a/docs/source/user/elastodyn/index.rst b/docs/source/user/elastodyn/index.rst index c95aecd402..6b65d36e8e 100644 --- a/docs/source/user/elastodyn/index.rst +++ b/docs/source/user/elastodyn/index.rst @@ -58,3 +58,4 @@ equations of FAST v7 and the ElastoDyn module of FAST v8 and OpenFAST. coordsys.rst input.rst theory.rst + zrefs.rst diff --git a/docs/source/user/elastodyn/input.rst b/docs/source/user/elastodyn/input.rst index 97d1651845..c6a7c3b264 100644 --- a/docs/source/user/elastodyn/input.rst +++ b/docs/source/user/elastodyn/input.rst @@ -199,7 +199,11 @@ Mass and Inertia **PtfmYIner** - Platform inertia for yaw rotation about the platform CM (kg m^2) +**PtfmXYIner** - Platform roll-pitch moment of inertia (*Ixy=-∫xydm*) about the platform CM (kg m^2) +**PtfmYZIner** - Platform pitch-yaw moment of inertia (*Iyz=-∫yzdm*) about the platform CM (kg m^2) + +**PtfmXZIner** - Platform roll-yaw moment of inertia (*Ixz=-∫xzdm*) about the platform CM (kg m^2) Blade ~~~~~ @@ -231,6 +235,29 @@ Rotor-Teeter **TeetHSSp** - Rotor-teeter hard-stop linear-spring constant (N-m/rad) [used only for 2 blades and when TeetMod=1] +Yaw-Friction +~~~~~~~~~~~~ + +**YawFrctMod** - Yaw-friction model {0: none, 1: friction independent of yaw-bearing force and bending moment, 2: friction with Coulomb terms depending on yaw-bearing force and bending moment, 3: user defined model} + +**M_CSmax** - Maximum static Coulomb friction torque (N-m) [M_CSmax when YawFrctMod=1; -min(0,Fz)*M_CSmax when YawFrctMod=2] + +**M_FCSmax** - Maximum static Coulomb friction torque proportional to yaw bearing shear force (N-m) [sqrt(Fx^2+Fy^2)*M_FCSmax; only used when YawFrctMod=2] + +**M_MCSmax** - Maximum static Coulomb friction torque proportional to yaw bearing bending moment (N-m) [sqrt(Mx^2+My^2)*M_MCSmax; only used when YawFrctMod=2] + +**M_CD** - Dynamic Coulomb friction moment (N-m) [M_CD when YawFrctMod=1; -min(0,Fz)*M_CD when YawFrctMod=2] + +**M_FCD** - Dynamic Coulomb friction moment proportional to yaw bearing shear force (N-m) [sqrt(Fx^2+Fy^2)*M_FCD; only used when YawFrctMod=2] + +**M_MCD** - Dynamic Coulomb friction moment proportional to yaw bearing bending moment (N-m) [sqrt(Mx^2+My^2)*M_MCD; only used when YawFrctMod=2] + +**sig_v** - Linear viscous friction coefficient (N-m/(rad/s)) + +**sig_v2** - Quadratic viscous friction coefficient (N-m/(rad/s)^2) + +**OmgCut** - Yaw angular velocity cutoff below which viscous friction is linearized (rad/s) + Drivetrain ~~~~~~~~~~ diff --git a/docs/source/user/elastodyn/theory.rst b/docs/source/user/elastodyn/theory.rst index f687277333..d4756dd0cd 100644 --- a/docs/source/user/elastodyn/theory.rst +++ b/docs/source/user/elastodyn/theory.rst @@ -153,14 +153,77 @@ The total moment on the given degree of freedom is: .. math:: :label: TFTotTorque Q = Q_\text{lin} + Q_\text{stop,spr} + Q_\text{stop,dmp} - - - +.. _ed_yawfriction_theory: +Yaw-friction model +------------------ +A yaw-friction model is implemented in ElastoDyn based on a Coulomb-viscous approach. +The yaw-friction moment as a function of yaw rate (:math:`\omega`) is shown below in :numref:`figYawFriction` +.. _figYawFriction: +.. figure:: figs/YawFrictionModel.jpg + :width: 60% + + Yaw-friction model +When ``YawFrctMod`` = 1, the maximum static or dynamic Coulomb friction does not depend on the external load on the yaw bearing. The yaw-friction torque :math:`M_f` can be calculated as follows. +If :math:`\omega\neq0`, we have dynamic friction of the form + +.. math:: + M_f = -(\mu_d\bar{D})\cdot\textrm{sign}(\omega) - M_{f,vis}, + +where :math:`\bar{D}` is the effective yaw-bearing diameter and :math:`\mu_d` is the dynamic Coulomb friction coefficient. Their product, :math:`\mu_d\bar{D}`, is specified in the input file through ``M_CD``. The first term on the right-hand side is the dynamic Coulomb friction. +The viscous friction, :math:`M_{f,vis}`, is of the form + +.. math:: + M_{f,vis} = \sigma_v\omega + \sigma_{v2}\omega\left|\omega\right|\qquad\qquad\text{if}~\left|\omega\right|\ge\omega_c, + +or + +.. math:: + M_{f,vis} = (\sigma_v + \sigma_{v2}\omega_c)\omega\qquad\qquad\text{if}~\left|\omega\right|\le\omega_c, + +where :math:`\sigma_v` and :math:`\sigma_{v2}` are the linear and quadratic viscous friction coefficients and :math:`\omega_c` is the cutoff yaw rate below which viscous friction is linearized. Setting :math:`\omega_c=0` disables the linearization of viscous friction. + +If :math:`\omega=0` and :math:`\dot{\omega}\neq 0`, we have a slightly modified dynamic Coulomb friction of the form + +.. math:: + M_f = -\textrm{min}\!\left(\mu_d\bar{D},\left|M_z\right|\right)\cdot\textrm{sign}(M_z), + +where :math:`M_z` is the external yaw torque. +If :math:`\omega=0` and :math:`\dot{\omega}=0`, we have static Coulomb friction of the form + +.. math:: + M_f = -\textrm{min}\!\left(\mu_s\bar{D},\left|M_z\right|\right)\cdot\textrm{sign}(M_z), + +where :math:`\mu_s` is the static Coulomb friction coefficient. The product :math:`\mu_s\bar{D}` is specified in the input file through ``M_CSmax``. + + +When ``YawFrctMod`` = 2, the maximum static or dynamic Coulomb friction depends on the external load on the yaw bearing, with proportional contributions from :math:`\left|F_z\right|`, the magnitude of the bearing axial load, if :math:`F_z<0`, from the bearing shear force magnitude, :math:`\sqrt{F_x^2+F_y^2}`, and from the bearing bending moment magnitude, :math:`\sqrt{M_x^2+M_y^2}`. +If :math:`\omega\neq0`, we have dynamic friction of the form + +.. math:: + M_f = \left(\mu_d\bar{D}\cdot\textrm{min}\!\left(0,F_z\right)-\mu_{df}\bar{D}\sqrt{F_x^2+F_y^2}-\mu_{dm}\sqrt{M_x^2+M_y^2}\right)\cdot\textrm{sign}(\omega) - M_{f,vis}, + +where :math:`M_{f,vis}` is defined in the same way as when ``YawFrctMod`` = 1. The product :math:`\mu_{df}\bar{D}` and :math:`\mu_{dm}` are specified in the input file through ``M_FCD`` and ``M_MCD``, respectively. +If :math:`\omega=0` and :math:`\dot{\omega}\neq 0`, we have a modified dynamic Coulomb friction of the form + +.. math:: + M_f = -\textrm{min}\!\left(\mu_d\bar{D}\left|\textrm{min}(0,F_z)\right| + \mu_{df}\bar{D}\sqrt{F_x^2+F_y^2} + \mu_{dm}\sqrt{M_x^2+M_y^2},\left|M_z\right|\right)\cdot\textrm{sign}(M_z). + +If :math:`\omega=0` and :math:`\dot{\omega}=0`, we have static Coulomb friction of the form + +.. math:: + M_f = -\textrm{min}\!\left(\mu_s\bar{D}\left|\textrm{min}(0,F_z)\right| + \mu_{sf}\bar{D}\sqrt{F_x^2+F_y^2} + \mu_{sm}\sqrt{M_x^2+M_y^2},\left|M_z\right|\right)\cdot\textrm{sign}(M_z), + +where the product :math:`\mu_{sf}\bar{D}` and :math:`\mu_{sm}` are specified in the input file through ``M_FCSmax`` and ``M_MCSmax``, respectively. + +The static 'stiction' (where the static contribution exceeds the dynamic Coulomb friction) is only applied if both the yaw rotational velocity and acceleration at the current time-step are zero. +The static portion of the friction is omitted if the rotational acceleration is not null. +This is to account for the fact that a 'warm' joint may not feel stiction when crossing through zero velocity in a dynamic sense :cite:`ed-hammam2023`. +When :math:`\omega=0`, the yaw-bearing static or dynamic friction is formulated such that the frictional resistance opposes the external applied moment, :math:`M_z`, without overcoming it. .. _ed_dev_notes: diff --git a/docs/source/user/elastodyn/zrefs.rst b/docs/source/user/elastodyn/zrefs.rst new file mode 100644 index 0000000000..afb6844d57 --- /dev/null +++ b/docs/source/user/elastodyn/zrefs.rst @@ -0,0 +1,9 @@ +.. only:: html + + References + ---------- + +.. bibliography:: bibliography.bib + :labelprefix: ed- + + diff --git a/docs/source/user/fast.farm/FFarmTheory.rst b/docs/source/user/fast.farm/FFarmTheory.rst index 893ffe03c5..f07ab6e140 100644 --- a/docs/source/user/fast.farm/FFarmTheory.rst +++ b/docs/source/user/fast.farm/FFarmTheory.rst @@ -24,7 +24,8 @@ The main idea behind the DWM model is to capture key wake features pertinent to accurate prediction of wind farm power performance and wind turbine loads, including the wake-deficit evolution (important for performance) and the wake meandering and wake-added turbulence -(important for loads). Although fundamental laws of physics are applied, +(important for loads, see :numref:`FF:WAT`). +Although fundamental laws of physics are applied, appropriate simplifications have been made to minimize the computational expense, and HFM solutions are used to inform and calibrate the submodels. In the DWM model, the wake-flow processes are treated via the @@ -74,7 +75,7 @@ the wake. Wake-added turbulence is the additional small-scale turbulence generated from the turbulent mixing in the wake. It is often modeled in DWM by -scaling up the background (undisturbed) turbulence. +scaling up the background (undisturbed) turbulence (see :numref:`FF:WAT`). Several variations of DWM have been implemented, e.g., by the Technical University of Denmark (:cite:`ff-Madsen10_1,ff-Madsen16_1`) and the University @@ -288,7 +289,7 @@ sections below. | | For :math:`0 \le n_p \le N_p-1`: | - :math:`\gamma^\text{YawErr}` | - :math:`\vec{p}_{n_p}^\text{Plane}` | | | | - :math:`^\text{DiskAvg}V_x^\text{Rel}` | - :math:`V_{x_{n_p}}^\text{Wake}\left(r\right)` | | | - :math:`^\text{Filt}D_{n_p}^\text{Rotor}` | - :math:`^\text{AzimAvg}C_t\left(r\right)` | - :math:`V_{r_{n_p}}^\text{Wake}\left(r\right)` | - | | - :math:`^\text{Filt}\gamma_{n_p}^\text{YawErr}` | - :math:`\vec{V}_{n_p}^\text{Plane}` for :math:`0 \len_p \le N_p-1` | - :math:`D_{n_p}^\text{Wake}` | + | | - :math:`^\text{Filt}\gamma_{n_p}^\text{YawErr}` | - :math:`\vec{V}_{n_p}^\text{Plane}` for :math:`0\le n_p \le N_p-1` | - :math:`D_{n_p}^\text{Wake}` | | | - :math:`^\text{Filt}\vec{V}_{n_p}^\text{Plane}` | - :math:`^\text{DiskAvg}V_x^\text{Wind}` | | | | - :math:`^\text{FiltDiskAvg}V_{x_{n_p}}^\text{Wind}` | - :math:`TI_\text{Amb}` | | | | - :math:`^\text{Filt}TI_{\text{Amb}_{n_p}}` | | | @@ -1291,6 +1292,184 @@ the solution of the momentum equation), :math:`V_{r_{n_p,n_r-1}}^\text{Wake}\left[ n+1 \right]` for :math:`1\le n_r\le N_r-1`. [10]_ + + +.. _FF:WAT: + +Wake-Added Turbulence (WAT) +^^^^^^^^^^^^^^^^^^^^^^^^^^^ + +Wake-added turbulence is the additional small-scale turbulence generated +from the turbulent mixing in the wake. +It is modeled by scaling up a background (undisturbed) turbulence. + + +The theory for WAT will is presented in more detail in :cite:`ff-Branlard2024`. + +The basic principle for the wake-added turbulence is illustrated in :numref:`FF:WATSketch`. + +.. figure:: Pictures/FFWakeAddedTurbBoxCoord.svg + :alt: Wake Added turbulence + :name: FF:WATSketch + :width: 100% + :align: center + + Wake-added turbulence + +A scaling factor is computed at each wake plane, it is multiplied with a unit turbulence box +and added to the quasi steady wake to form the final wake with wake-added turbulence. +In this implementation, the scaling factors are computed in the meandering +frame, but assembled with the “global” unit turbulence box in the global +frame. More details follow. + + +**Scaling factor** + +The scaling factor, expressed in terms of the wake deficit :math:`V_x^{Wake}`, is determined at each wake plane as: + +.. math:: + \begin{aligned} + k_{} (x,y,z) = + \frac{k_\text{def}^\text{WAT} }{ \overline{U}} \left| V_x^{Wake}(x,y,z) \right| + + \frac{k_\text{grad}^\text{WAT}D}{2\overline{U}} \left[\left|{\frac{\partial {V_x^{Wake}(x,y,z)}}{\partial r}}\right| + \left|{\frac{1}{r}\frac{\partial {V_x^{Wake}(x,y,z)}}{\partial \theta}}\right| \right] + \end{aligned} + +where :math:`D` is a reference diameter, and :math:`\bar{U}` is the mean +velocity taken as the filtered velocity at the turbine location normal to the +rotor disk. The coordinates :math:`x,y,z` and :math:`r,\theta` are taken in the +meandering frame of reference. The parameters :math:`k_\text{def}^\text{WAT}` +and :math:`k_\text{grad}^\text{WAT}` are tuning paramters of the model +respectively multiplying the quasi-steady wake deficit and the gradient of the +wake deficit. These are based on an eddy-viscosity filter with five calibrated +parameters to give a more realistic dependence on downstream position. The +general form for both is given in Equation :eq:`eq:kDefGrad`, + +.. math:: + k_\text{def/grad}^\text{WAT} \left( \tilde{x}, k_\text{c}, f_\text{min}, D_\text{min}, D_\text{max}, e \right) = k_\text{c} \left( f_\text{min} + (1 - f_\text{min}) \left[ \frac{\tilde{x} - D_\text{min}}{D_\text{max} - D_\text{min}} \right]^e \right) + :label: eq:kDefGrad + +where :math:`\tilde{x} = x/D`, and :math:`k_\text{c}` is either +:math:`k_\text{def}` or :math:`k_\text{grad}`. This function is capped between +:math:`k_\text{c} f_\text{min}` and :math:`k_\text{c}` when :math:`\tilde{x}` is +not between :math:`D_\text{min}` and :math:`D_\text{max}`. The tuning +parameters are shown in :eq:`eq:kDefGradDefaults`. + +.. math:: + \begin{matrix} + & & k_\text{def/grad} & f_\text{min} & D_\text{min} & D_\text{max} & e \\ + & & (\gt 0) & (\ge 0, \le 1) & (\ge 0) & (\gt k_\text{min}) & (\gt 0) \\\hline + k_\text{def}^\text{WAT} & & 0.6 & 0 & 0 & 2 & 1 \\ + k_\text{grad}^\text{WAT} & & 3 & 0 & 0 & 12 & 0.65 \\ + \end{matrix} + :label: eq:kDefGradDefaults + +These parameters were chosen as they fit relatively well for stable and neutral +cases (prior studies have shown that FAST.Farm matches LES well for unstable +cases with high ambient turbulence where a WAT model seems unnecessary), as seen +in :numref:`FF:WAT:TuneParam`. + +.. figure:: Pictures/KFitDownstreamConcatNEW.png + :alt: Fitted tuning parameters + :name: FF:WAT:TuneParam + :width: 100% + :align: center + + Fitted tuning parameters as a function of downstream distance for different stability cases. Values for different fitting options and smoothing are shown with lighter colors, and the averages are shown with darker colors. The model and recommended default values are given as the black dashed line. Note that results for the unstable case beyond *8D* are uncertain due to the strong wake decay. + +We chose to enforce a zero value at :math:`\tilde{x}=0`, as this is the expected +behavior for a case with no background turbulence intensity. The progressive +ramp-up of the :math:`k` factors is characteristic of what would be expected as +the vortices progressively break down downstream as seen in +:numref:`FF:WAT:NoTI`. + +.. figure:: Pictures/FF-WakeNoTI.png + :alt: Single wind turbine with and without WAT + :name: FF:WAT:NoTI + :width: 100% + :align: center + + Instantaneous velocity field in the wake of one wind turbine in uniform 8 m/s inflow without (left) and with (right) WAT implemented in FAST.Farm. + + +**Unit turbulence boxes** + +The 3 turbulence Mann boxes are stored as a 4D +array :math:`\boldsymbol{u}_\text{unit}` of dimension +:math:`(3,n_x, n_y, n_z)`. +The turbulence boxes used for the WAT are isotropic turbulence boxes +with unit standard deviation, generated using the Mann +model :cite:`ff-Mann1994`. +To generate a box with unit standard deviation, the dissipation rate is set to: + +.. math:: + + \alpha\epsilon^{2/3}\approx \frac{1}{0.688 L^{2/3}} + +We have found that there is no dependency on the length scale. We nevertheless recommend to set it to the rotor diameter if the users generate their own boxes. + + +**Predefined boxes** + +A recommended practice for the high-resolution domain of FAST.Farm is to chose a grid +spacing equal to the maximum chord of the blade. +Based on the data from +different wind turbine, the max-chord can be approximated as: +:math:`c_\text{max}\approx 0.03D`. +Therefore we suggest to use this spacing in all three directions, and as a compromise to obtain a box +with sufficient extent but moderate size, we select: :math:`\Delta x = \Delta y = \Delta z = 0.03D`, +:math:`L_x = L_y=15D`, :math:`L_z= 2D`, :math:`n_x=n_y=512`, +:math:`n_z=64`, leading to a box size of :math:`65` Mb per wind +component. + +Users may generate their own Mann box using the guidelines presented in this paragraph and the one above. + + + +**Convection of the WAT box** + +There is only one WAT turbulence box stored for the entire wind farm. To +convect the WAT turbulence box, the AWAE module keeps track of a passive +tracer that is convected at each time step with the mean of the +rotor-average velocity of each wind turbine +:math:`(\boldsymbol{U}_\text{farm}`). The position of the passive +tracer, :math:`\boldsymbol{B}`, is defined as: + +.. math:: + + \frac{d\boldsymbol{B}}{dt} = \boldsymbol{U}_\text{farm}(t) + +where: + +.. math:: + + \boldsymbol{U}_\text{farm} = \operatorname{mean}\{ \overline{V}^\text{Low}_\text{Amb}[i_w], i_w =1\cdots n_{WT}\} + +where :math:`\overline{V}^\text{Low}_\text{Amb}[i_w]` is the rotor +averaged ambient wind speed. +The equation is integrated using a first order forward Euler scheme as follows: + +.. math:: + + \boldsymbol{B}^{n+1} = \boldsymbol{B}^{n} + \Delta t_\text{low}\, \boldsymbol{U}^{n}_\text{farm} + +where the superscript :math:`n` denotes the time step, and where the +tracer is assumed to be at the origin at :math:`t=0`: + +.. math:: + + \boldsymbol{B}^{0}=(0,0,0) + +The AWAE module needs the position of the tracer at intermediate, +high-res, time steps. The position at high-res time step is computed as +follows: + +.. math:: + + \boldsymbol{B}^{n,j} = \boldsymbol{B}^{n} - (n_h-j) \, \Delta t_\text{high}\, \boldsymbol{U}^{n-1}_\text{farm} + ,\qquad j\in{0,.., n_h-1} + + + .. _FF:AWAE: Ambient Wind and Array Effects (AWAE Module) @@ -1460,14 +1639,17 @@ spatial average is moderated by the low-pass time filter in the *WD* module. Using spatial averaging and the three vector components allows for atmospheric shear, wind veer, and other ambient wind characteristics to influence the eddy viscosity and wake-deficit evolution in the *WD* -module. The incorporation of wake-added turbulence is left for future -work. Note that Equation :eq:`eq:TI` uses the eight wind data +module. +Wake-added turbulence is described in :numref:`FF:WAT`. +Note that Equation :eq:`eq:TI` uses the eight wind data points from the low-resolution domain surrounding each point in the polar grid rather than interpolation. This is because calculating wind data in the polar grid on the wake plane via trilinear interpolation from the low-resolution domain would smooth out spatial variations and artificially reduce the calculated turbulence intensity. + + .. _FF:WMerging: Wake Merging @@ -1483,7 +1665,7 @@ submodel of the *AWAE* module identifies zones of wake overlap between all wakes across the wind farm by finding wake volumes that overlap in space. Wake deficits are superimposed in the axial direction based on the RSS method (:cite:`ff-Katic86_1`); transverse components -(radial wake deficits) are superimposed by vector sum. In Katic̀ et +(radial wake deficits) are superimposed by vector sum. In Katic et al. (:cite:`ff-Katic86_1`), the RSS method is applied to wakes with axial deficits that are uniform across the wake diameter and radial deficits are not considered. In contrast, the RSS method in FAST.Farm is diff --git a/docs/source/user/fast.farm/InputFiles.rst b/docs/source/user/fast.farm/InputFiles.rst index 6bae9fefac..9ecce9ce00 100644 --- a/docs/source/user/fast.farm/InputFiles.rst +++ b/docs/source/user/fast.farm/InputFiles.rst @@ -138,6 +138,10 @@ documentation for details on the input file at the farm level. **DT_Mooring** (sec) sets the timestep for the shared mooring connections with MoorDyn. +**WrMooringVis** [swithch] Write shared mooring line visualization, at +the global FAST.Farm time step + + .. _FF:Input:VTK: Ambient Wind: Precursor in Visualization Toolkit Format @@ -245,7 +249,7 @@ choose to use a time step that is an integer multiple smaller than or equal to **DT_Low**. When **Wake_Mod=2,3**, the stability of the algorithm will depend on the choice of **dr** and **DT_Low**. -(typically :math:`\textbf{DT_Low} \lessapprox \textbf{dr}/(2V_\text{Hub})`, +(typically :math:`DT_Low`__): .. math:: - \textbf{DT_Low} \lessapprox \frac{\textbf{dr}}{2 V_\text{Hub}} + DT_Low \lessapprox \frac{dr}{2 V_\text{Hub}} Spatial discretization convergence was assessed in the same manner as @@ -821,7 +821,7 @@ parameters: When **Wake_Mod=2,3**, for numerical stability, it is recommended to set the spacing with a value that (approximately) satisfies the following guideline (see Equation 20 of the following `paper `__): .. math:: - \textbf{dr} \ltrapprox \frac{D}{10} + \textbf{dr} < \frac{D}{10} diff --git a/docs/source/user/fast.farm/Pictures/FF-WakeNoTI.pdf b/docs/source/user/fast.farm/Pictures/FF-WakeNoTI.pdf new file mode 100644 index 0000000000..1b42c76a7c Binary files /dev/null and b/docs/source/user/fast.farm/Pictures/FF-WakeNoTI.pdf differ diff --git a/docs/source/user/fast.farm/Pictures/FF-WakeNoTI.png b/docs/source/user/fast.farm/Pictures/FF-WakeNoTI.png new file mode 100644 index 0000000000..f747d3cc13 Binary files /dev/null and b/docs/source/user/fast.farm/Pictures/FF-WakeNoTI.png differ diff --git a/docs/source/user/fast.farm/Pictures/FFWakeAddedTurbBoxCoord.svg b/docs/source/user/fast.farm/Pictures/FFWakeAddedTurbBoxCoord.svg new file mode 100644 index 0000000000..66461c88ac --- /dev/null +++ b/docs/source/user/fast.farm/Pictures/FFWakeAddedTurbBoxCoord.svg @@ -0,0 +1,2885 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + xg + yg + + + Global frame + + + + zg + + + + + Meandering frame + + + + yp + zp + xp + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + Quasi-steady wake + Scaling factor k + Unit turbulence + + diff --git a/docs/source/user/fast.farm/Pictures/KFitDownstreamConcatNEW.pdf b/docs/source/user/fast.farm/Pictures/KFitDownstreamConcatNEW.pdf new file mode 100644 index 0000000000..acb8dacf02 Binary files /dev/null and b/docs/source/user/fast.farm/Pictures/KFitDownstreamConcatNEW.pdf differ diff --git a/docs/source/user/fast.farm/Pictures/KFitDownstreamConcatNEW.png b/docs/source/user/fast.farm/Pictures/KFitDownstreamConcatNEW.png new file mode 100644 index 0000000000..9f246e491f Binary files /dev/null and b/docs/source/user/fast.farm/Pictures/KFitDownstreamConcatNEW.png differ diff --git a/docs/source/user/fast.farm/bibliography.bib b/docs/source/user/fast.farm/bibliography.bib index 63bffa6acd..509475f1f1 100644 --- a/docs/source/user/fast.farm/bibliography.bib +++ b/docs/source/user/fast.farm/bibliography.bib @@ -1,3 +1,24 @@ +@inproceedings{ff-Branlard2024, + title= {Development and Verification of an Improved Wake-Added Turbulence Model in FAST.Farm}, + author= {E. Branlard and J. Jonkman and A. Platt and R. Thedin and L. A. Martinez-Tossas and M. Kretschmer}, + series= {TORQUE 2024}, + date = {29-31}, + month = {May}, + year= {2024}, + publisher={EAWE}, + booktitle={}, + address= {Florence, Italy} +} + +@article{ff-Mann1994, + title={The spatial structure of neutral atmospheric surface-layer turbulence}, + author={J. Mann}, + year={1994}, + journal={Journal of Fluid Mechanics}, + volume = {273}, + pages={p141-168} +} + @article{ff-Larsen08_1, title= {Wake Meander: A Pragmatic Approach}, author= {G. C. Larsen and et al.}, diff --git a/docs/source/user/fast.farm/index.rst b/docs/source/user/fast.farm/index.rst index 1263a64144..7263a6c58a 100644 --- a/docs/source/user/fast.farm/index.rst +++ b/docs/source/user/fast.farm/index.rst @@ -15,7 +15,7 @@ Jonkman and Kelsey Shaler. .. toctree:: - :maxdepth: 2 + :maxdepth: 6 Nomenclature.rst Introduction.rst diff --git a/docs/source/user/general.rst b/docs/source/user/general.rst new file mode 100644 index 0000000000..b29f26adbb --- /dev/null +++ b/docs/source/user/general.rst @@ -0,0 +1,52 @@ + + +.. _general-reference-docs: + +General +~~~~~~~ +.. toctree:: + :maxdepth: 1 + + fast_to_openfast.rst + api_change.rst + input_file_overview.rst + +Workshop material, legacy documentation, and other resources are listed below. + +- `Overview of OpenFAST at NAWEA WindTech 2023 `_ +- `Overview of OpenFAST at NAWEA WindTech 2022 `_ +- `Practical Guide to OpenFAST at NAWEA WindTech 2022 `_ +- `Overview of OpenFAST at NAWEA WindTech 2019 `_ +- `Workshop Presentations `_ +- :download:`Old FAST v6 User's Guide <../../OtherSupporting/Old_FAST6_UsersGuide.pdf>` +- :download:`FAST v8 README <../../OtherSupporting/FAST8_README.pdf>` +- `Implementation of Substructure Flexibility and Member-Level Load Capabilities for Floating Offshore Wind Turbines in OpenFAST `_ +- `FAST modularization framework for wind turbine simulation: full-system linearization `_ +- `Full-System Linearization for Floating Offshore Wind Turbines in OpenFAST `_ +- :download:`FAST with Labview <../../OtherSupporting/UsingFAST4Labview.pdf>` +- :download:`OutListParameters.xlsx <../../OtherSupporting/OutListParameters.xlsx>` - Contains the full list of outputs for each module. + + + +Modularization Framework +************************ + +Information specific to the modularization framework of OpenFAST is provided here. These are a collection +of publications, presentations, and past studies on the subject. + +- `The New Modularization Framework for the FAST Wind Turbine CAE Tool `_ +- :download:`Example Module Implementation Plans <../../OtherSupporting/ModulePlan_GasmiPaperExamples.doc>` +- :download:`Module and Mesh-Mapping Linearization Implementation Plan <../../OtherSupporting/LinearizationOfMeshMapping_Rev18_Rev2.doc>` +- :download:`Interpolation of DCMs <../../OtherSupporting/DCM_Interpolation/DCM_Interpolation.pdf>` - A summary of the mathematics used in the interpolation of DCM (direction cosine matrices) using logarithmic mapping and matrix exponentials. +- :download:`Set-point Linearization Development Plan <../../OtherSupporting/DevelopmentPlan-SetPoint-Linearization.pdf>` + +.. - :download:`OpenFAST Steady State Solution <../../OtherSupporting/OpenFASTSteadyStateSolution_Rev7.doc>` + + +Glue Code and Mesh Mapping +************************** + +- `FAST Modular Wind Turbine CAE Tool: Nonmatching Spatial and Temporal Meshes `_ +- `FAST Modular Framework for Wind Turbine Simulation: New Algorithms and Numerical Examples `_ +- :download:`OpenFAST Algorithms <../../OtherSupporting/OpenFAST_Algorithms/OpenFAST_Algorithms.pdf>` - A summary of the solve method used in the glue code. +- :download:`Predictor-Corrector Approach <../../OtherSupporting/ProposedPCApproach_Rev4.docx>` diff --git a/docs/source/user/hydrodyn/appendix.rst b/docs/source/user/hydrodyn/appendix.rst index 21493a3ada..b58c4717b9 100644 --- a/docs/source/user/hydrodyn/appendix.rst +++ b/docs/source/user/hydrodyn/appendix.rst @@ -10,244 +10,220 @@ structure:: ------- HydroDyn Input File ---------------------------------------------------- NREL 5.0 MW offshore baseline floating platform HydroDyn input properties for the OC4 Semi-submersible. False Echo - Echo the input file data (flag) - ---------------------- ENVIRONMENTAL CONDITIONS -------------------------------- - "DEFAULT" WtrDens - Water density (kg/m^3) - "DEFAULT" WtrDpth - Water depth (meters) - "DEFAULT" MSL2SWL - Offset between still-water level and mean sea level (meters) [positive upward; unused when WaveMod = 6; must be zero if PotMod=1 or 2] - ---------------------- WAVES --------------------------------------------------- - 3 WaveMod - Incident wave kinematics model {0: none=still water, 1: regular (periodic), 1P#: regular with user-specified phase, 2: JONSWAP/Pierson-Moskowitz spectrum (irregular), 3: White noise spectrum (irregular), 4: user-defined spectrum from routine UserWaveSpctrm (irregular), 5: Externally generated wave-elevation time series, 6: Externally generated full wave-kinematics time series [option 6 is invalid for PotMod/=0]} (switch) - 0 WaveStMod - Model for stretching incident wave kinematics to instantaneous free surface {0: none=no stretching, 1: vertical stretching, 2: extrapolation stretching, 3: Wheeler stretching} (switch) [unused when WaveMod=0 or when PotMod/=0] - 4600 WaveTMax - Analysis time for incident wave calculations (sec) [unused when WaveMod=0; determines WaveDOmega=2Pi/WaveTMax in the IFFT] - 0.2 WaveDT - Time step for incident wave calculations (sec) [unused when WaveMod=0; 0.1<=WaveDT<=1.0 recommended; determines WaveOmegaMax=Pi/WaveDT in the IFFT] - 1.2646 WaveHs - Significant wave height of incident waves (meters) [used only when WaveMod=1, 2, or 3] - 10 WaveTp - Peak-spectral period of incident waves (sec) [used only when WaveMod=1 or 2] - "DEFAULT" WavePkShp - Peak-shape parameter of incident wave spectrum (-) or DEFAULT (string) [used only when WaveMod=2; use 1.0 for Pierson-Moskowitz] - 0.314159 WvLowCOff - Low cut-off frequency or lower frequency limit of the wave spectrum beyond which the wave spectrum is zeroed (rad/s) [unused when WaveMod=0, 1, or 6] - 1.570796 WvHiCOff - High cut-off frequency or upper frequency limit of the wave spectrum beyond which the wave spectrum is zeroed (rad/s) [unused when WaveMod=0, 1, or 6] - 0 WaveDir - Incident wave propagation heading direction (degrees) [unused when WaveMod=0 or 6] - 0 WaveDirMod - Directional spreading function {0: none, 1: COS2S} (-) [only used when WaveMod=2,3, or 4] - 1 WaveDirSpread - Wave direction spreading coefficient ( > 0 ) (-) [only used when WaveMod=2,3, or 4 and WaveDirMod=1] - 1 WaveNDir - Number of wave directions (-) [only used when WaveMod=2,3, or 4 and WaveDirMod=1; odd number only] - 0 WaveDirRange - Range of wave directions (full range: WaveDir +/- 1/2*WaveDirRange) (degrees) [only used when WaveMod=2,3,or 4 and WaveDirMod=1] - 123456789 WaveSeed(1) - First random seed of incident waves [-2147483648 to 2147483647] (-) [unused when WaveMod=0, 5, or 6] - 1011121314 WaveSeed(2) - Second random seed of incident waves [-2147483648 to 2147483647] (-) [unused when WaveMod=0, 5, or 6] - FALSE WaveNDAmp - Flag for normally distributed amplitudes (flag) [only used when WaveMod=2, 3, or 4] - "" WvKinFile - Root name of externally generated wave data file(s) (quoted string) [used only when WaveMod=5 or 6] - 1 NWaveElev - Number of points where the incident wave elevations can be computed (-) [maximum of 9 output locations] - 0 WaveElevxi - List of xi-coordinates for points where the incident wave elevations can be output (meters) [NWaveElev points, separated by commas or white space; usused if NWaveElev = 0] - 0 WaveElevyi - List of yi-coordinates for points where the incident wave elevations can be output (meters) [NWaveElev points, separated by commas or white space; usused if NWaveElev = 0] - ---------------------- 2ND-ORDER WAVES ----------------------------------------- [unused with WaveMod=0 or 6] - FALSE WvDiffQTF - Full difference-frequency 2nd-order wave kinematics (flag) - FALSE WvSumQTF - Full summation-frequency 2nd-order wave kinematics (flag) - 0 WvLowCOffD - Low frequency cutoff used in the difference-frequencies (rad/s) [Only used with a difference-frequency method] - 1.256637 WvHiCOffD - High frequency cutoff used in the difference-frequencies (rad/s) [Only used with a difference-frequency method] - 0.618319 WvLowCOffS - Low frequency cutoff used in the summation-frequencies (rad/s) [Only used with a summation-frequency method] - 3.141593 WvHiCOffS - High frequency cutoff used in the summation-frequencies (rad/s) [Only used with a summation-frequency method] - ---------------------- CURRENT ------------------------------------------------- [unused with WaveMod=6] - 0 CurrMod - Current profile model {0: none=no current, 1: standard, 2: user-defined from routine UserCurrent} (switch) - 0 CurrSSV0 - Sub-surface current velocity at still water level (m/s) [used only when CurrMod=1] - "DEFAULT" CurrSSDir - Sub-surface current heading direction (degrees) or DEFAULT (string) [used only when CurrMod=1] - 20 CurrNSRef - Near-surface current reference depth (meters) [used only when CurrMod=1] - 0 CurrNSV0 - Near-surface current velocity at still water level (m/s) [used only when CurrMod=1] - 0 CurrNSDir - Near-surface current heading direction (degrees) [used only when CurrMod=1] - 0 CurrDIV - Depth-independent current velocity (m/s) [used only when CurrMod=1] - 0 CurrDIDir - Depth-independent current heading direction (degrees) [used only when CurrMod=1] ---------------------- FLOATING PLATFORM --------------------------------------- [unused with WaveMod=6] - 1 PotMod - Potential-flow model {0: none=no potential flow, 1: frequency-to-time-domain transforms based on WAMIT output, 2: fluid-impulse theory (FIT)} (switch) - "HydroData/marin_semi" PotFile - Root name of potential-flow model data; WAMIT output files containing the linear, nondimensionalized, hydrostatic restoring matrix (.hst), frequency-dependent hydrodynamic added mass matrix and damping matrix (.1), and frequency- and direction-dependent wave excitation force vector per unit wave amplitude (.3) (quoted string) [MAKE SURE THE FREQUENCIES INHERENT IN THESE WAMIT FILES SPAN THE PHYSICALLY-SIGNIFICANT RANGE OF FREQUENCIES FOR THE GIVEN PLATFORM; THEY MUST CONTAIN THE ZERO- AND INFINITE-FREQUENCY LIMITS!] - 1 WAMITULEN - Characteristic body length scale used to redimensionalize WAMIT output (meters) [only used when PotMod=1] - 13917 PtfmVol0 - Displaced volume of water when the platform is in its undisplaced position (m^3) [only used when PotMod=1; USE THE SAME VALUE COMPUTED BY WAMIT AS OUTPUT IN THE .OUT FILE!] - 0 PtfmCOBxt - The xt offset of the center of buoyancy (COB) from the platform reference point (meters) [only used when PotMod=1] - 0 PtfmCOByt - The yt offset of the center of buoyancy (COB) from the platform reference point (meters) [only used when PotMod=1] - 1 ExctnMod - Wave Excitation model {0: None, 1: DFT, 2: state-space} (switch) [only used when PotMod=1; STATE-SPACE REQUIRES *.ssexctn INPUT FILE] - 1 RdtnMod - Radiation memory-effect model {0: no memory-effect calculation, 1: convolution, 2: state-space} (switch) [only used when PotMod=1; STATE-SPACE REQUIRES *.ss INPUT FILE] + 1 PotMod - Potential-flow model {0: none=no potential flow, 1: frequency-to-time-domain transforms based on WAMIT output, 2: fluid-impulse theory (FIT)} (switch) + 1 ExctnMod - Wave-excitation model {0: no wave-excitation calculation, 1: DFT, 2: state-space} (switch) [only used when PotMod=1; STATE-SPACE REQUIRES *.ssexctn INPUT FILE; if PtfmYMod=1, need ExctnMod=0 or 1] + 0 ExctnDisp - Method of computing Wave Excitation {0: use undisplaced position, 1: use displaced position, 2: use low-pass filtered displaced position) [only used when PotMod=1 and ExctnMod>0 and SeaState's WaveMod>0]} (switch) + 10 ExctnCutOff - Cutoff (corner) frequency of the low-pass time-filtered displaced position (Hz) [>0.0] [used only when PotMod=1, ExctnMod>0, and ExctnDisp=2]) [only used when PotMod=1 and ExctnMod>0 and SeaState's WaveMod>0]} (switch) + 0 PtfmYMod - Model for large platform yaw offset {0: Static reference yaw offset based on PtfmRefY, 1: dynamic reference yaw offset based on low-pass filtering the PRP yaw motion with cutoff frequency PtfmYCutOff} (switch) + 0 PtfmRefY - Constant (if PtfmYMod=0) or initial (if PtfmYMod=1) platform reference yaw offset (deg) + 0.01 PtfmYCutOff - Cutoff frequency for the low-pass filtering of PRP yaw motion when PtfmYMod=1 [>0.0; unused when PtfmYMod=0] (Hz) + 36 NExctnHdg - Number of evenly distributed platform yaw/heading angles over the range of [-180, 180) deg for which the wave excitation shall be computed [>=2; unused when PtfmYMod=0] (-) + 1 RdtnMod - Radiation memory-effect model {0: no memory-effect calculation, 1: convolution, 2: state-space} (switch) [only used when PotMod=1; STATE-SPACE REQUIRES *.ss INPUT FILE] 60 RdtnTMax - Analysis time for wave radiation kernel calculations (sec) [only used when PotMod=1 and RdtnMod>0; determines RdtnDOmega=Pi/RdtnTMax in the cosine transform; MAKE SURE THIS IS LONG ENOUGH FOR THE RADIATION IMPULSE RESPONSE FUNCTIONS TO DECAY TO NEAR-ZERO FOR THE GIVEN PLATFORM!] - "DEFAULT" RdtnDT - Time step for wave radiation kernel calculations (sec) [only used when PotMod=1 and RdtnMod=1; DT<=RdtnDT<=0.1 recommended; determines RdtnOmegaMax=Pi/RdtnDT in the cosine transform] + 0.0125 RdtnDT - Time step for wave radiation kernel calculations (sec) [only used when PotMod=1 and ExctnMod>0 or RdtnMod>0; DT<=RdtnDT<=0.1 recommended; determines RdtnOmegaMax=Pi/RdtnDT in the cosine transform] + 1 NBody - Number of WAMIT bodies to be used (-) [>=1; only used when PotMod=1. If NBodyMod=1, the WAMIT data contains a vector of size 6*NBody x 1 and matrices of size 6*NBody x 6*NBody; if NBodyMod>1, there are NBody sets of WAMIT data each with a vector of size 6 x 1 and matrices of size 6 x 6] + 1 NBodyMod - Body coupling model {1: include coupling terms between each body and NBody in HydroDyn equals NBODY in WAMIT, 2: neglect coupling terms between each body and NBODY=1 with XBODY=0 in WAMIT, 3: Neglect coupling terms between each body and NBODY=1 with XBODY=/0 in WAMIT} (switch) [only used when PotMod=1] + "marin_semi" PotFile - Root name of potential-flow model data; WAMIT output files containing the linear, nondimensionalized, hydrostatic restoring matrix (.hst), frequency-dependent hydrodynamic added mass matrix and damping matrix (.1), and frequency- and direction-dependent wave excitation force vector per unit wave amplitude (.3) (quoted string) [1 to NBody if NBodyMod>1] [MAKE SURE THE FREQUENCIES INHERENT IN THESE WAMIT FILES SPAN THE PHYSICALLY-SIGNIFICANT RANGE OF FREQUENCIES FOR THE GIVEN PLATFORM; THEY MUST CONTAIN THE ZERO- AND INFINITE-FREQUENCY LIMITS!] + 1 WAMITULEN - Characteristic body length scale used to redimensionalize WAMIT output (meters) [1 to NBody if NBodyMod>1] [only used when PotMod=1] + 0 PtfmRefxt - The xt offset of the body reference point(s) from (0,0,0) (meters) [1 to NBody] [only used when PotMod=1] + 0 PtfmRefyt - The yt offset of the body reference point(s) from (0,0,0) (meters) [1 to NBody] [only used when PotMod=1] + 0 PtfmRefzt - The zt offset of the body reference point(s) from (0,0,0) (meters) [1 to NBody] [only used when PotMod=1. If NBodyMod=2,PtfmRefzt=0.0] + 0 PtfmRefztRot - The rotation about zt of the body reference frame(s) from xt/yt (degrees) [1 to NBody] [only used when PotMod=1] + 13917 PtfmVol0 - Displaced volume of water when the body is in its undisplaced position (m^3) [1 to NBody] [only used when PotMod=1; USE THE SAME VALUE COMPUTED BY WAMIT AS OUTPUT IN THE .OUT FILE!] + 0 PtfmCOBxt - The xt offset of the center of buoyancy (COB) from (0,0) (meters) [1 to NBody] [only used when PotMod=1] + 0 PtfmCOByt - The yt offset of the center of buoyancy (COB) from (0,0) (meters) [1 to NBody] [only used when PotMod=1] ---------------------- 2ND-ORDER FLOATING PLATFORM FORCES ---------------------- [unused with WaveMod=0 or 6, or PotMod=0 or 2] - 0 MnDrift - Mean-drift 2nd-order forces computed {0: None; [7, 8, 9, 10, 11, or 12]: WAMIT file to use} [Only one of MnDrift, NewmanApp, or DiffQTF can be non-zero] - 0 NewmanApp - Mean- and slow-drift 2nd-order forces computed with Newman's approximation {0: None; [7, 8, 9, 10, 11, or 12]: WAMIT file to use} [Only one of MnDrift, NewmanApp, or DiffQTF can be non-zero. Used only when WaveDirMod=0] - 0 DiffQTF - Full difference-frequency 2nd-order forces computed with full QTF {0: None; [10, 11, or 12]: WAMIT file to use} [Only one of MnDrift, NewmanApp, or DiffQTF can be non-zero] - 0 SumQTF - Full summation -frequency 2nd-order forces computed with full QTF {0: None; [10, 11, or 12]: WAMIT file to use} - ---------------------- FLOATING PLATFORM FORCE FLAGS -------------------------- [unused with WaveMod=6] - True PtfmSgF - Platform horizontal surge translation force (flag) or DEFAULT - True PtfmSwF - Platform horizontal sway translation force (flag) or DEFAULT - True PtfmHvF - Platform vertical heave translation force (flag) or DEFAULT - True PtfmRF - Platform roll tilt rotation force (flag) or DEFAULT - True PtfmPF - Platform pitch tilt rotation force (flag) or DEFAULT - True PtfmYF - Platform yaw rotation force (flag) or DEFAULT - ---------------------- PLATFORM ADDITIONAL STIFFNESS AND DAMPING -------------- - 0 0 0 0 0 0 AddF0 - Additional preload (N, N-m) - 0 0 0 0 0 0 AddCLin - Additional linear stiffness (N/m, N/rad, N-m/m, N-m/rad) - 0 0 0 0 0 0 - 0 0 0 0 0 0 - 0 0 0 1451298897 0 0 - 0 0 0 0 1451298897 0 - 0 0 0 0 0 0 - 0 0 0 0 0 0 AddBLin - Additional linear damping(N/(m/s), N/(rad/s), N-m/(m/s), N-m/(rad/s)) - 0 0 0 0 0 0 - 0 0 0 0 0 0 - 0 0 0 0 0 0 - 0 0 0 0 0 0 - 0 0 0 0 0 0 - 0 0 0 0 0 0 AddBQuad - Additional quadratic drag(N/(m/s)^2, N/(rad/s)^2, N-m(m/s)^2, N-m/(rad/s)^2) - 0 0 0 0 0 0 - 0 0 0 0 0 0 - 0 0 0 0 0 0 - 0 0 0 0 0 0 - 0 0 0 0 0 0 + 0 MnDrift - Mean-drift 2nd-order forces computed {0: None; [7, 8, 9, 10, 11, or 12]: WAMIT file to use} [Only one of MnDrift, NewmanApp, or DiffQTF can be non-zero. If NBody>1, MnDrift /=8] + 0 NewmanApp - Mean- and slow-drift 2nd-order forces computed with Newman's approximation {0: None; [7, 8, 9, 10, 11, or 12]: WAMIT file to use} [Only one of MnDrift, NewmanApp, or DiffQTF can be non-zero. If NBody>1, NewmanApp/=8. Used only when WaveDirMod=0] + 0 DiffQTF - Full difference-frequency 2nd-order forces computed with full QTF {0: None; [10, 11, or 12]: WAMIT file to use} [Only one of MnDrift, NewmanApp, or DiffQTF can be non-zero. If PtfmYMod=1, need DiffQTF=0] + 0 SumQTF - Full summation -frequency 2nd-order forces computed with full QTF {0: None; [10, 11, or 12]: WAMIT file to use} [If PtfmYMod=1, need SumQTF=0] + ---------------------- PLATFORM ADDITIONAL STIFFNESS AND DAMPING -------------- [unused with PotMod=0 or 2] + 0 AddF0 - Additional preload (N, N-m) [If NBodyMod=1, one size 6*NBody x 1 vector; if NBodyMod>1, NBody size 6 x 1 vectors] + 0 + 0 + 0 + 0 + 0 + 0 0 0 0 0 0 AddCLin - Additional linear stiffness (N/m, N/rad, N-m/m, N-m/rad) [If NBodyMod=1, one size 6*NBody x 6*NBody matrix; if NBodyMod>1, NBody size 6 x 6 matrices] + 0 0 0 0 0 0 + 0 0 0 0 0 0 + 0 0 0 0 0 0 + 0 0 0 0 0 0 + 0 0 0 0 0 0 + 0 0 0 0 0 0 AddBLin - Additional linear damping (N/(m/s), N/(rad/s), N-m/(m/s), N-m/(rad/s)) [If NBodyMod=1, one size 6*NBody x 6*NBody matrix; if NBodyMod>1, NBody size 6 x 6 matrices] + 0 0 0 0 0 0 + 0 0 0 0 0 0 + 0 0 0 0 0 0 + 0 0 0 0 0 0 + 0 0 0 0 0 0 + 0 0 0 0 0 0 AddBQuad - Additional quadratic damping (N/(m/s)^2, N/(rad/s)^2, N-m(m/s)^2, N-m/(rad/s)^2) [If NBodyMod=1, one size 6*NBody x 6*NBody matrix; if NBodyMod>1, NBody size 6 x 6 matrices] + 0 0 0 0 0 0 + 0 0 0 0 0 0 + 0 0 0 0 0 0 + 0 0 0 0 0 0 + 0 0 0 0 0 0 + ---------------------- STRIP THEORY OPTIONS -------------------------------------- + 0 WaveDisp - Method of computing Wave Kinematics {0: use undisplaced position, 1: use displaced position) } (switch) [If PtfmYMod=1, need WaveDisp=1] + 0 AMMod - Method of computing distributed added-mass force. (0: Only and always on nodes below SWL at the undisplaced position. 2: Up to the instantaneous free surface) [overwrite to 0 when WaveMod = 0 or 6 or when WaveStMod = 0 in SeaState] ---------------------- AXIAL COEFFICIENTS -------------------------------------- - 2 NAxCoef - Number of axial coefficients (-) - AxCoefID AxCd AxCa AxCp - (-) (-) (-) (-) - 1 0.00 0.00 1.00 - 2 9.60 0.00 1.00 + 2 NAxCoef - Number of axial coefficients (-) + AxCoefID AxCd AxCa AxCp AxFDMod AxVnCOff AxFDLoFSc + (-) (-) (-) (-) (-) (-) (-) + 1 0.00 0.00 1.00 0 0.00 1.00 + 2 9.60 0.00 1.00 0 0.00 1.00 ---------------------- MEMBER JOINTS ------------------------------------------- 44 NJoints - Number of joints (-) [must be exactly 0 or at least 2] JointID Jointxi Jointyi Jointzi JointAxID JointOvrlp [JointOvrlp= 0: do nothing at joint, 1: eliminate overlaps by calculating super member] - (-) (m) (m) (m) (-) (switch) - 1 0.00000 0.00000 -20.00000 1 0 - 2 0.00000 0.00000 10.00000 1 0 - 3 14.43376 25.00000 -14.00000 1 0 - 4 14.43376 25.00000 12.00000 1 0 - 5 -28.86751 0.00000 -14.00000 1 0 - 6 -28.86751 0.00000 12.00000 1 0 - 7 14.43376 -25.00000 -14.00000 1 0 - 8 14.43376 -25.00000 12.00000 1 0 - 9 14.43375 25.00000 -20.00000 2 0 - 10 -28.86750 0.00000 -20.00000 2 0 - 11 14.43375 -25.00000 -20.00000 2 0 - 12 9.23760 22.00000 10.00000 1 0 - 13 -23.67130 3.00000 10.00000 1 0 - 14 -23.67130 -3.00000 10.00000 1 0 - 15 9.23760 -22.00000 10.00000 1 0 - 16 14.43375 -19.00000 10.00000 1 0 - 17 14.43375 19.00000 10.00000 1 0 - 18 4.04145 19.00000 -17.00000 1 0 - 19 -18.47520 6.00000 -17.00000 1 0 - 20 -18.47520 -6.00000 -17.00000 1 0 - 21 4.04145 -19.00000 -17.00000 1 0 - 22 14.43375 -13.00000 -17.00000 1 0 - 23 14.43375 13.00000 -17.00000 1 0 - 24 1.62500 2.81500 10.00000 1 0 - 25 11.43376 19.80385 10.00000 1 0 - 26 -3.25000 0.00000 10.00000 1 0 - 27 -22.87000 0.00000 10.00000 1 0 - 28 1.62500 -2.81500 10.00000 1 0 - 29 11.43376 -19.80385 10.00000 1 0 - 30 1.62500 2.81500 -17.00000 1 0 - 31 8.43376 14.60770 -17.00000 1 0 - 32 -3.25000 0.00000 -17.00000 1 0 - 33 -16.87000 0.00000 -17.00000 1 0 - 34 1.62500 -2.81500 -17.00000 1 0 - 35 8.43376 -14.60770 -17.00000 1 0 - 36 1.62500 2.81500 -16.20000 1 0 - 37 11.43376 19.80385 9.13000 1 0 - 38 -3.25000 0.00000 -16.20000 1 0 - 39 -22.87000 0.00000 9.13000 1 0 - 40 1.62500 -2.81500 -16.20000 1 0 - 41 11.43376 -19.80385 9.13000 1 0 - 42 14.43376 25.00000 -19.94000 1 0 - 43 -28.86751 0.00000 -19.94000 1 0 - 44 14.43376 -25.00000 -19.94000 1 0 + (-) (m) (m) (m) (-) (switch) + 1 0.00000 0.00000 -20.00000 1 0 + 2 0.00000 0.00000 10.00000 1 0 + 3 14.43376 25.00000 -14.00000 1 0 + 4 14.43376 25.00000 12.00000 1 0 + 5 -28.86751 0.00000 -14.00000 1 0 + 6 -28.86751 0.00000 12.00000 1 0 + 7 14.43376 -25.00000 -14.00000 1 0 + 8 14.43376 -25.00000 12.00000 1 0 + 9 14.43375 25.00000 -20.00000 2 0 + 10 -28.86750 0.00000 -20.00000 2 0 + 11 14.43375 -25.00000 -20.00000 2 0 + 12 9.23760 22.00000 10.00000 1 0 + 13 -23.67130 3.00000 10.00000 1 0 + 14 -23.67130 -3.00000 10.00000 1 0 + 15 9.23760 -22.00000 10.00000 1 0 + 16 14.43375 -19.00000 10.00000 1 0 + 17 14.43375 19.00000 10.00000 1 0 + 18 4.04145 19.00000 -17.00000 1 0 + 19 -18.47520 6.00000 -17.00000 1 0 + 20 -18.47520 -6.00000 -17.00000 1 0 + 21 4.04145 -19.00000 -17.00000 1 0 + 22 14.43375 -13.00000 -17.00000 1 0 + 23 14.43375 13.00000 -17.00000 1 0 + 24 1.62500 2.81500 10.00000 1 0 + 25 11.43376 19.80385 10.00000 1 0 + 26 -3.25000 0.00000 10.00000 1 0 + 27 -22.87000 0.00000 10.00000 1 0 + 28 1.62500 -2.81500 10.00000 1 0 + 29 11.43376 -19.80385 10.00000 1 0 + 30 1.62500 2.81500 -17.00000 1 0 + 31 8.43376 14.60770 -17.00000 1 0 + 32 -3.25000 0.00000 -17.00000 1 0 + 33 -16.87000 0.00000 -17.00000 1 0 + 34 1.62500 -2.81500 -17.00000 1 0 + 35 8.43376 -14.60770 -17.00000 1 0 + 36 1.62500 2.81500 -16.20000 1 0 + 37 11.43376 19.80385 9.13000 1 0 + 38 -3.25000 0.00000 -16.20000 1 0 + 39 -22.87000 0.00000 9.13000 1 0 + 40 1.62500 -2.81500 -16.20000 1 0 + 41 11.43376 -19.80385 9.13000 1 0 + 42 14.43376 25.00000 -19.94000 1 0 + 43 -28.86751 0.00000 -19.94000 1 0 + 44 14.43376 -25.00000 -19.94000 1 0 ---------------------- MEMBER CROSS-SECTION PROPERTIES ------------------------- - 4 NPropSets - Number of member property sets (-) + 4 NPropSets - Number of member property sets (-) PropSetID PropD PropThck - (-) (m) (m) - 1 6.50000 0.03000 ! Main Column - 2 12.00000 0.06000 ! Upper Columns - 3 24.00000 0.06000 ! Base Columns - 4 1.60000 0.01750 ! Pontoons + (-) (m) (m) + 1 6.50000 0.03000 ! Main Column + 2 12.00000 0.06000 ! Upper Columns + 3 24.00000 0.06000 ! Base Columns + 4 1.60000 0.01750 ! Pontoons ---------------------- SIMPLE HYDRODYNAMIC COEFFICIENTS (model 1) -------------- - SimplCd SimplCdMG SimplCa SimplCaMG SimplCp SimplCpMG SimplAxCa SimplAxCaMG SimplAxCp SimplAxCpMG - (-) (-) (-) (-) (-) (-) (-) (-) (-) (-) - 0.00 0.00 0.00 0.00 1.00 1.00 0.00 0.00 1.00 1.00 + SimplCd SimplCdMG SimplCa SimplCaMG SimplCp SimplCpMG SimplAxCd SimplAxCdMG SimplAxCa SimplAxCaMG SimplAxCp SimplAxCpMG SimplCb SimplCbMG + (-) (-) (-) (-) (-) (-) (-) (-) (-) (-) (-) (-) (-) (-) + 0.00 0.00 0.00 0.00 1.00 1.00 0.00 0.00 0.00 0.00 1.00 1.00 1.00 1.00 ---------------------- DEPTH-BASED HYDRODYNAMIC COEFFICIENTS (model 2) --------- - 0 NCoefDpth - Number of depth-dependent coefficients (-) - Dpth DpthCd DpthCdMG DpthCa DpthCaMG DpthCp DpthCpMG DpthAxCa DpthAxCaMG DpthAxCp DpthAxCpMG - (m) (-) (-) (-) (-) (-) (-) (-) (-) (-) (-) + 0 NCoefDpth - Number of depth-dependent coefficients (-) + Dpth DpthCd DpthCdMG DpthCa DpthCaMG DpthCp DpthCpMG DpthAxCd DpthAxCdMG DpthAxCa DpthAxCaMG DpthAxCp DpthAxCpMG DpthCb DpthCbMG + (m) (-) (-) (-) (-) (-) (-) (-) (-) (-) (-) (-) (-) (-) (-) ---------------------- MEMBER-BASED HYDRODYNAMIC COEFFICIENTS (model 3) -------- 25 NCoefMembers - Number of member-based coefficients (-) - MemberID MemberCd1 MemberCd2 MemberCdMG1 MemberCdMG2 MemberCa1 MemberCa2 MemberCaMG1 MemberCaMG2 MemberCp1 MemberCp2 MemberCpMG1 MemberCpMG2 MemberAxCa1 MemberAxCa2 MemberAxCaMG1 MemberAxCaMG2 MemberAxCp1 MemberAxCp2 MemberAxCpMG1 MemberAxCpMG2 - (-) (-) (-) (-) (-) (-) (-) (-) (-) (-) (-) (-) (-) (-) (-) (-) (-) (-) (-) (-) (-) ! Main Column - 1 0.56 0.56 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 ! Upper Column 1 - 2 0.61 0.61 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 ! Upper Column 2 - 3 0.61 0.61 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 ! Upper Column 3 - 4 0.61 0.61 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 ! Base Column 1 - 5 0.68 0.68 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 ! Base Column 2 - 6 0.68 0.68 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 ! Base Column 3 - 7 0.68 0.68 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 ! Base column cap 1 - 23 0.68 0.68 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 ! Base column cap 2 - 24 0.68 0.68 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 ! Base column cap 3 - 25 0.68 0.68 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 ! Delta Pontoon, Upper 1 - 8 0.63 0.63 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 ! Delta Pontoon, Upper 2 - 9 0.63 0.63 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 ! Delta Pontoon, Upper 3 - 10 0.63 0.63 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 ! Delta Pontoon, Lower 1 - 11 0.63 0.63 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 ! Delta Pontoon, Lower 2 - 12 0.63 0.63 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 ! Delta Pontoon, Lower 3 - 13 0.63 0.63 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 ! Y Pontoon, Upper 1 - 14 0.63 0.63 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 ! Y Pontoon, Upper 2 - 15 0.63 0.63 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 ! Y Pontoon, Upper 3 - 16 0.63 0.63 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 ! Y Pontoon, Lower 1 - 17 0.63 0.63 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 ! Y Pontoon, Lower 2 - 18 0.63 0.63 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 ! Y Pontoon, Lower 3 - 19 0.63 0.63 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 ! Cross Brace 1 - 20 0.63 0.63 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 ! Cross Brace 2 - 21 0.63 0.63 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 ! Cross Brace 3 - 22 0.63 0.63 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 + MemberID MemberCd1 MemberCd2 MemberCdMG1 MemberCdMG2 MemberCa1 MemberCa2 MemberCaMG1 MemberCaMG2 MemberCp1 MemberCp2 MemberCpMG1 MemberCpMG2 MemberAxCd1 MemberAxCd2 MemberAxCdMG1 MemberAxCdMG2 MemberAxCa1 MemberAxCa2 MemberAxCaMG1 MemberAxCaMG2 MemberAxCp1 MemberAxCp2 MemberAxCpMG1 MemberAxCpMG2 MemberCb1 MemberCb2 MemberCbMG1 MemberCbMG2 + (-) (-) (-) (-) (-) (-) (-) (-) (-) (-) (-) (-) (-) (-) (-) (-) (-) (-) (-) (-) (-) (-) (-) (-) (-) (-) (-) (-) (-) + 1 0.56 0.56 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 1.00 1.00 1.00 1.00 ! Main Column + 2 0.61 0.61 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 1.00 1.00 1.00 1.00 ! Upper Column 1 + 3 0.61 0.61 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 1.00 1.00 1.00 1.00 ! Upper Column 2 + 4 0.61 0.61 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 1.00 1.00 1.00 1.00 ! Upper Column 3 + 5 0.68 0.68 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 1.00 1.00 1.00 1.00 ! Base Column 1 + 6 0.68 0.68 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 1.00 1.00 1.00 1.00 ! Base Column 2 + 7 0.68 0.68 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 1.00 1.00 1.00 1.00 ! Base Column 3 + 23 0.68 0.68 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 1.00 1.00 1.00 1.00 ! Base column cap 1 + 24 0.68 0.68 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 1.00 1.00 1.00 1.00 ! Base column cap 2 + 25 0.68 0.68 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 1.00 1.00 1.00 1.00 ! Base column cap 3 + 8 0.63 0.63 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 1.00 1.00 1.00 1.00 ! Delta Pontoon, Upper 1 + 9 0.63 0.63 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 1.00 1.00 1.00 1.00 ! Delta Pontoon, Upper 2 + 10 0.63 0.63 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 1.00 1.00 1.00 1.00 ! Delta Pontoon, Upper 3 + 11 0.63 0.63 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 1.00 1.00 1.00 1.00 ! Delta Pontoon, Lower 1 + 12 0.63 0.63 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 1.00 1.00 1.00 1.00 ! Delta Pontoon, Lower 2 + 13 0.63 0.63 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 1.00 1.00 1.00 1.00 ! Delta Pontoon, Lower 3 + 14 0.63 0.63 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 1.00 1.00 1.00 1.00 ! Y Pontoon, Upper 1 + 15 0.63 0.63 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 1.00 1.00 1.00 1.00 ! Y Pontoon, Upper 2 + 16 0.63 0.63 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 1.00 1.00 1.00 1.00 ! Y Pontoon, Upper 3 + 17 0.63 0.63 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 1.00 1.00 1.00 1.00 ! Y Pontoon, Lower 1 + 18 0.63 0.63 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 1.00 1.00 1.00 1.00 ! Y Pontoon, Lower 2 + 19 0.63 0.63 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 1.00 1.00 1.00 1.00 ! Y Pontoon, Lower 3 + 20 0.63 0.63 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 1.00 1.00 1.00 1.00 ! Cross Brace 1 + 21 0.63 0.63 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 1.00 1.00 1.00 1.00 ! Cross Brace 2 + 22 0.63 0.63 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 1.00 1.00 1.00 1.00 ! Cross Brace 3 -------------------- MEMBERS ------------------------------------------------- 25 NMembers - Number of members (-) - MemberID MJointID1 MJointID2 MPropSetID1 MPropSetID2 MDivSize MCoefMod PropPot [MCoefMod=1: use simple coeff table, 2: use depth-based coeff table, 3: use member-based coeff table] [ PropPot/=0 if member is modeled with potential-flow theory] - (-) (-) (-) (-) (-) (m) (switch) (flag) - 1 1 2 1 1 1.0000 3 TRUE ! Main Column - 2 3 4 2 2 1.0000 3 TRUE ! Upper Column 1 - 3 5 6 2 2 1.0000 3 TRUE ! Upper Column 2 - 4 7 8 2 2 1.0000 3 TRUE ! Upper Column 3 - 5 42 3 3 3 1.0000 3 TRUE ! Base Column 1 - 6 43 5 3 3 1.0000 3 TRUE ! Base Column 2 - 7 44 7 3 3 1.0000 3 TRUE ! Base Column 3 - 23 9 42 3 3 1.0000 3 TRUE ! Base column cap 1 - 24 10 43 3 3 1.0000 3 TRUE ! Base column cap 2 - 25 11 44 3 3 1.0000 3 TRUE ! Base column cap 3 - 8 12 13 4 4 1.0000 3 TRUE ! Delta Pontoon, Upper 1 - 9 14 15 4 4 1.0000 3 TRUE ! Delta Pontoon, Upper 2 - 10 16 17 4 4 1.0000 3 TRUE ! Delta Pontoon, Upper 3 - 11 18 19 4 4 1.0000 3 TRUE ! Delta Pontoon, Lower 1 - 12 20 21 4 4 1.0000 3 TRUE ! Delta Pontoon, Lower 2 - 13 22 23 4 4 1.0000 3 TRUE ! Delta Pontoon, Lower 3 - 14 24 25 4 4 1.0000 3 TRUE ! Y Pontoon, Upper 1 - 15 26 27 4 4 1.0000 3 TRUE ! Y Pontoon, Upper 2 - 16 28 29 4 4 1.0000 3 TRUE ! Y Pontoon, Upper 3 - 17 30 31 4 4 1.0000 3 TRUE ! Y Pontoon, Lower 1 - 18 32 33 4 4 1.0000 3 TRUE ! Y Pontoon, Lower 2 - 19 34 35 4 4 1.0000 3 TRUE ! Y Pontoon, Lower 3 - 20 36 37 4 4 1.0000 3 TRUE ! Cross Brace 1 - 21 38 39 4 4 1.0000 3 TRUE ! Cross Brace 2 - 22 40 41 4 4 1.0000 3 TRUE ! Cross Brace 3 + MemberID MJointID1 MJointID2 MPropSetID1 MPropSetID2 MDivSize MCoefMod MHstLMod PropPot [MCoefMod=1: use simple coeff table, 2: use depth-based coeff table, 3: use member-based coeff table] [ PropPot/=0 if member is modeled with potential-flow theory] + (-) (-) (-) (-) (-) (m) (switch) (switch) (flag) + 1 1 2 1 1 1.0000 3 1 TRUE ! Main Column + 2 3 4 2 2 1.0000 3 1 TRUE ! Upper Column 1 + 3 5 6 2 2 1.0000 3 1 TRUE ! Upper Column 2 + 4 7 8 2 2 1.0000 3 1 TRUE ! Upper Column 3 + 5 42 3 3 3 1.0000 3 1 TRUE ! Base Column 1 + 6 43 5 3 3 1.0000 3 1 TRUE ! Base Column 2 + 7 44 7 3 3 1.0000 3 1 TRUE ! Base Column 3 + 23 9 42 3 3 1.0000 3 1 TRUE ! Base column cap 1 + 24 10 43 3 3 1.0000 3 1 TRUE ! Base column cap 2 + 25 11 44 3 3 1.0000 3 1 TRUE ! Base column cap 3 + 8 12 13 4 4 1.0000 3 1 TRUE ! Delta Pontoon, Upper 1 + 9 14 15 4 4 1.0000 3 1 TRUE ! Delta Pontoon, Upper 2 + 10 16 17 4 4 1.0000 3 1 TRUE ! Delta Pontoon, Upper 3 + 11 18 19 4 4 1.0000 3 1 TRUE ! Delta Pontoon, Lower 1 + 12 20 21 4 4 1.0000 3 1 TRUE ! Delta Pontoon, Lower 2 + 13 22 23 4 4 1.0000 3 1 TRUE ! Delta Pontoon, Lower 3 + 14 24 25 4 4 1.0000 3 1 TRUE ! Y Pontoon, Upper 1 + 15 26 27 4 4 1.0000 3 1 TRUE ! Y Pontoon, Upper 2 + 16 28 29 4 4 1.0000 3 1 TRUE ! Y Pontoon, Upper 3 + 17 30 31 4 4 1.0000 3 1 TRUE ! Y Pontoon, Lower 1 + 18 32 33 4 4 1.0000 3 1 TRUE ! Y Pontoon, Lower 2 + 19 34 35 4 4 1.0000 3 1 TRUE ! Y Pontoon, Lower 3 + 20 36 37 4 4 1.0000 3 1 TRUE ! Cross Brace 1 + 21 38 39 4 4 1.0000 3 1 TRUE ! Cross Brace 2 + 22 40 41 4 4 1.0000 3 1 TRUE ! Cross Brace 3 ---------------------- FILLED MEMBERS ------------------------------------------ - 2 NFillGroups - Number of filled member groups (-) [If FillDens = DEFAULT, then FillDens = WtrDens; FillFSLoc is related to MSL2SWL] - FillNumM FillMList FillFSLoc FillDens - (-) (-) (m) (kg/m^3) - 3 2 3 4 -6.17 1025 - 3 5 6 7 -14.89 1025 + 2 NFillGroups - Number of filled member groups (-) [If FillDens = DEFAULT, then FillDens = WtrDens; FillFSLoc is related to MSL2SWL] + FillNumM FillMList FillFSLoc FillDens + (-) (-) (m) (kg/m^3) + 3 2 3 4 -6.17 1025 + 3 5 6 7 -14.89 1025 ---------------------- MARINE GROWTH ------------------------------------------- - 0 NMGDepths - Number of marine-growth depths specified (-) + 0 NMGDepths - Number of marine-growth depths specified (-) MGDpth MGThck MGDens (m) (m) (kg/m^3) ---------------------- MEMBER OUTPUT LIST -------------------------------------- - 0 NMOutputs - Number of member outputs (-) [must be < 10] + 0 NMOutputs - Number of member outputs (-) [must be < 10] MemberID NOutLoc NodeLocs [NOutLoc < 10; node locations are normalized distance from the start of the member, and must be >=0 and <= 1] [unused if NMOutputs=0] - (-) (-) (-) + (-) (-) (-) ---------------------- JOINT OUTPUT LIST --------------------------------------- - 0 NJOutputs - Number of joint outputs [Must be < 10] - 0 JOutLst - List of JointIDs which are to be output (-)[unused if NJOutputs=0] + 0 NJOutputs - Number of joint outputs [Must be < 10] + JOutLst - List of JointIDs which are to be output (-)[unused if NJOutputs=0] ---------------------- OUTPUT -------------------------------------------------- True HDSum - Output a summary file [flag] False OutAll - Output all user-specified member and joint loads (only at each member end, not interior locations) [flag] - 1 OutSwtch - Output requested channels to: [1=Hydrodyn.out, 2=GlueCode.out, 3=both files] - "ES11.4e2" OutFmt - Output format for numerical results (quoted string) [not checked for validity!] + 2 OutSwtch - Output requested channels to: [1=Hydrodyn.out, 2=GlueCode.out, 3=both files] + "E16.8e2" OutFmt - Output format for numerical results (quoted string) [not checked for validity!] "A11" OutSFmt - Output format for header strings (quoted string) [not checked for validity!] ---------------------- OUTPUT CHANNELS ----------------------------------------- - "Wave1Elev" - Wave elevation at the platform reference point (0, 0) + HydroFxi + HydroFyi + HydroFzi + HydroMxi + HydroMyi + HydroMzi END of output channels and end of file. (the word "END" must appear in the first 3 columns of this line) Appendix B: OC4 Semi-submersible Input File @@ -255,38 +231,29 @@ Appendix B: OC4 Semi-submersible Input File The following is a HydroDyn driver input file for OC4 semi-submersible structure:: - HydroDyn Driver file for OC4 Semi-submersible. - Compatible with HydroDyn v2.03.* - TRUE Echo - Echo the input file data (flag) + ------- HydroDyn Driver Input File -------------------------------------------- + HydroDyn Driver file for OC4 Semi-submersible. + FALSE Echo - Echo the input file data (flag) ---------------------- ENVIRONMENTAL CONDITIONS ------------------------------- - 9.80665 Gravity - Gravity (m/s^2) - 1025 WtrDens - Water density (kg/m^3) - 200 WtrDpth - Water depth (meters) - 0 MSL2SWL - Offset between still-water level and mean sea level (meters) [positive upward; unused when WaveMod = 6; must be zero if PotMod=1 or 2] + 9.80665 Gravity - Gravity (m/s^2) + 1025 WtrDens - Water density (kg/m^3) + 200 WtrDpth - Water depth (m) + 0 MSL2SWL - Offset between still-water level and mean sea level (m) [positive upward] ---------------------- HYDRODYN ----------------------------------------------- - "./OC4Semi.dat" HDInputFile - Primary HydroDyn input file name (quoted string) - "./OC4Semi" OutRootName - The name which prefixes all HydroDyn generated files (quoted string) - 1 NSteps - Number of time steps in the simulations (-) - 0.025 TimeInterval - TimeInterval for the simulation (sec) - ---------------------- WAMIT INPUTS ------------------------------------------- - 1 WAMITInputsMod - Inputs model {0: all inputs are zero for every timestep, 1: steadystate inputs, 2: read inputs from a file (InputsFile)} (switch) - "" WAMITInputsFile - Name of the inputs file if InputsMod = 2 (quoted string) - ---------------------- WAMIT STEADY STATE INPUTS ----------------------------- - 1.0 2.0 3.0 4.0 5.0 6.0 uWAMITInSteady - input displacements and rotations at the platform reference point (m, rads) - 7.0 8.0 9.0 10.0 11.0 12.0 uDotWAMITInSteady - input translational and rotational velocities at the platform reference point (m/s, rads/s) - 13.0 14.0 15.0 16.0 17.0 18.0 uDotDotWAMITInSteady - input translational and rotational acccelerations at the platform reference point (m/s^2, rads/s^2) - ---------------------- MORISON INPUTS ----------------------------------------- - 0 MorisonInputsMod - Inputs model {0: all inputs are zero for every timestep, 1: steadystate inputs, 2: read inputs from a file (InputsFile)} (switch) - " " MorisonInputsFile - Name of the inputs file if InputsMod = 2 (quoted string) - ---------------------- MORISON STEADY STATE INPUTS --------------------------- - 1.0 2.0 3.0 4.0 5.0 6.0 uMorisonInSteady - input displacements and rotations for the morison elements (m, rads) - 7.0 8.0 9.0 10.0 11.0 12.0 uDotMorisonInSteady - input translational and rotational velocities for the morison elements (m/s, rads/s) - 13.0 14.0 15.0 16.0 17.0 18.0 uDotDotMorisonInSteady - input translational and rotational acccelerations for the morison elements (m/s^2, rads/s^2) - ---------------------- Waves multipoint elevation output ------------------------------- - TRUE WaveElevSeriesFlag - T/F flag to calculate the wave elevation field (for movies) - 5.0 5.0 WaveElevDX WaveElevDY - WaveElevSeries spacing -- WaveElevDX WaveElevDY - 3 3 WaveElevNX WaveElevNY - WaveElevSeries points -- WaveElevNX WaveElevNY - END of driver input file + "./OC4Semi.dat" HDInputFile - Primary HydroDyn input file name (quoted string) + "./SeaState.dat" SeaStateInputFile - Primary SeaState input file name (quoted string) + "./OC4Semi" OutRootName - The name which prefixes all HydroDyn generated files (quoted string) + FALSE Linearize - Flag to enable linearization + 4801 NSteps - Number of time steps in the simulation (-) [60 seconds total] + 0.0125 TimeInterval - Time step for the simulation (sec) + ---------------------- PRP INPUTS (Platform Reference Point) ------------------ + 0 PRPInputsMod - Model for the PRP (platform reference point) inputs {0: all inputs are zero for every timestep, 1: steady-state inputs, 2: read inputs from a file (InputsFile)} (switch) + 0 PtfmRefzt - Vertical distance from the ground level to the platform reference point (m) + "not_used" PRPInputsFile - Filename for the PRP HydroDyn input InputsMod = 2 (quoted string) + ---------------------- PRP STEADY STATE INPUTS ------------------------------- + 0, 0, 0, 0, 0, 0 uPRPInSteady - PRP Steady-state (3) displacements and (3) rotations at the platform reference point (m, m, m, rad, rad, rad) + 0, 0, 0, 0, 0, 0 uDotPRPInSteady - PRP Steady-state (3) translational and (3) rotational velocities at the platform reference point (m/s, rads/s) + 0, 0, 0, 0, 0, 0 uDotDotPRPInSteady - PRP Steady-state (3) translational and (3) rotational accelerations at the platform reference point (m/s^2, rads/s^2) .. _hd-output-channels: @@ -312,14 +279,11 @@ global inertial-frame coordinate. Channel Name(s) Units Description ================================================================ ========================================================================================================== ======================================================================================== **Wave and Current Kinematics** -WaveαElev (m) Total (first- plus second-order) wave elevations (up to 9 designated locations) -WaveαElv1 (m) First-order wave elevations (up to 9 designated locations) -WaveαElv2 (m) Second-order wave elevations (up to 9 designated locations) MαNβVxi, MαNβVyi, MαNβVzi (m/s), (m/s), (m/s) Total (first- plus second-order) fluid particle velocities at MαNβ -MαNβAxi, MαNβAyi, MαNβAzi (m/s\ :sup:`2`), (m/s\ :sup:`2`), (m/s\ :sup:`2`) Total (first- plus second-order) fluid particle accelerations at MαNβ +MαNβAxi, MαNβAyi, MαNβAzi (m/s\ :sup:`2`), (m/s\ :sup:`2`), (m/s\ :sup:`2`) Total (first- plus second-order) fluid particle accelerations at MαNβ MαNβDynP (Pa) Total (first- plus second-order) fluid particle dynamic pressure at MαNβ JαVxi, JαVyi, JαVzi (m/s), (m/s), (m/s) Total (first- plus second-order) fluid particle velocities at Jα -JαAxi, JαAyi, JαAzi (m/s\ :sup:`2`), (m/s\ :sup:`2`), (m/s\ :sup:`2`) Total (first- plus second-order) fluid particle accelerations at Jα +JαAxi, JαAyi, JαAzi (m/s\ :sup:`2`), (m/s\ :sup:`2`), (m/s\ :sup:`2`) Total (first- plus second-order) fluid particle accelerations at Jα JαDynP (Pa) Total (first- plus second-order) fluid particle dynamic pressure at Jα **Total and Additional Loads** BαAddFxi, BαAddFyi, BαAddFzi, BαAddMxi, BαAddMyi, BαAddMzi (N), (N), (N), (N·m), (N·m), (N·m) Loads due to additional preload, stiffness, and damping at Bα @@ -331,13 +295,16 @@ BαWvsF2xi, BαWvsF2yi, BαWvsF2zi, BαWvsM2xi, BαWvsM2yi, BαWvsM2zi (N), (N), BαHdSFxi, BαHdSFyi, BαHdSFzi, BαHdSMxi, BαHdSMyi, BαHdSMzi (N), (N), (N), (N·m), (N·m), (N·m) Hydrostatic loads at Bα BαRdtFxi, BαRdtFyi, BαRdtFzi, BαRdtMxi, BαRdtMyi, BαRdtMzi (N), (N), (N), (N·m), (N·m), (N·m) Wave-radiation loads at Bα **Structural Motions** +PRPSurge, PRPSway, PRPHeave, PRPRoll, PRPPitch, PRPYaw (m), (m), (m), (rad), (rad), (rad) Displacements and rotations at platform reference point (PRP) +PRPTVxi, PRPTVyi, PRPTVzi, PRPRVxi, PRPRVyi, PRPRVzi (m/s), (m/s), (m/s), (rad/s), (rad/s), (rad/s) Translational and rotational velocities of the PRP +PRPTAxi, PRPTAyi, PRPTAzi, PRPRAxi, PRPRAyi, PRPRAzi (m/s\ :sup:`2`), (m/s\ :sup:`2`), (m/s\ :sup:`2`), (rad/s\ :sup:`2`), (rad/s\ :sup:`2`), (rad/s\ :sup:`2`) Translational and rotational accelerations of the PRP BαSurge, BαSway, BαHeave, BαRoll, BαPitch BαYaw (m), (m), (m), (rad), (rad), (rad) Displacements and rotations at Bα BαTVxi, BαTVyi, BαTVzi, BαRVxi, BαRVyi, BαRVzi (m/s), (m/s), (m/s), (rad/s), (rad/s), (rad/s) Translational and rotational velocities at Bα BαTAxi, BαTAyi, BαTAzi, BαRAxi, BαRAyi, BαRAzi (m/s\ :sup:`2`), (m/s\ :sup:`2`), (m/s\ :sup:`2`), (rad/s\ :sup:`2`), (rad/s\ :sup:`2`), (rad/s\ :sup:`2`) Translational and rotational accelerations at Bα MαNβSTVxi, MαNβSTVyi, MαNβSTVzi (m/s), (m/s), (m/s) Structural translational velocities at MαNβ -MαNβSTAxi, MαNβSTAyi, MαNβSTAzi (m/s\ :sup:`2`), (m/s\ :sup:`2`), (m/s\ :sup:`2`) Structural translational accelerations at MαNβ +MαNβSTAxi, MαNβSTAyi, MαNβSTAzi (m/s\ :sup:`2`), (m/s\ :sup:`2`), (m/s\ :sup:`2`) Structural translational accelerations at MαNβ JαSTVxi, JαSTVyi, JαSTVzi (m/s), (m/s), (m/s) Structural translational velocities at Jα -JαSTAxi, JαSTAyi, JαSTAzi (m/s\ :sup:`2`), (m/s\ :sup:`2`), (m/s\ :sup:`2`) Structural translational accelerations at Jα +JαSTAxi, JαSTAyi, JαSTAzi (m/s\ :sup:`2`), (m/s\ :sup:`2`), (m/s\ :sup:`2`) Structural translational accelerations at Jα **Distributed Loads (Per Unit Length) on Members** MαNβFDxi, MαNβFDyi, MαNβFDzi (N/m), (N/m), (N/m) Viscous-drag forces at MαNβ MαNβFIxi, MαNβFIyi, MαNβFIzi (N/m), (N/m), (N/m) Fluid-inertia forces at MαNβ diff --git a/docs/source/user/hydrodyn/future_work.rst b/docs/source/user/hydrodyn/future_work.rst index dcefc5bdb0..bcd97534b2 100644 --- a/docs/source/user/hydrodyn/future_work.rst +++ b/docs/source/user/hydrodyn/future_work.rst @@ -9,8 +9,6 @@ releases: * Enable tight-coupling to FAST, including linearization. -* Enable wave stretching (**WaveStMod** > 0). - * Enable full support for floating platform force flags. * Enable joint overlap calculations (**JointOvrlp** = 1). @@ -24,22 +22,12 @@ releases: * Ensure that the output channels are written in the order they are entered. -* Allow for a WAMIT reference point location other than (0,0,0). - * Allow **RdtnDT** to be independent from the FAST simulation time step. -* Add distributed axial viscous-drag loads on tapered members. - * Add rotational inertia terms for fluid-filled members and marine growth. -* Calculate the effective 6x6 added-mass matrix from strip-theory - members and place in the HydroDyn summary file. - -* Add graphics/animation capability to visualize the substructure - geometry and motion, wave elevation, and hydrodynamic loads. - * Add convective fluid acceleration terms. * Allow for wave directional spreading to include energy spectra that @@ -51,8 +39,6 @@ releases: * Add breaking wave-impact loads for fixed-bottom substructures. -* Add floating platform hydro-elastics. - * Add pressure mapping for floating platforms. * Added automated computation and use of hydrostatic restoring matrix diff --git a/docs/source/user/hydrodyn/input_files.rst b/docs/source/user/hydrodyn/input_files.rst index 0d433b0430..49c0593d60 100644 --- a/docs/source/user/hydrodyn/input_files.rst +++ b/docs/source/user/hydrodyn/input_files.rst @@ -45,64 +45,96 @@ specified in the HydroDyn primary input file. **HDInputFile** is the filename of the primary HydroDyn input file. This name should be in quotations and can contain an absolute path or a -relative path. All HydroDyn-generated output files will be prefixed with -**OutRootName**. If this parameter includes a file path, the output will -be generated in that folder. **NSteps** specifies the number of -simulation time steps, and **TimeInterval** specifies the time between -steps. - -Setting **WAMITInputsMod** = 0 forces all WAMIT reference point (WRP) -input motions to zero for all time. If you set **WAMITInputsMod** = 1, -then you must set the steady-state inputs in the WAMIT STEADY STATE -INPUTS section of the file. Setting **WAMITInputsMod** = 2, requires the +relative path. Note that neither the standalone HydroDyn program nor HydroDyn +as part of OpenFAST can run without SeaState. Therefore, in addition to the +primary HydroDyn input file, the path to a SeaState input file must also +be provided through **SeaStateInputFile**. + +All HydroDyn-generated output files will be prefixed with **OutRootName**. +If this parameter includes a file path, the output will be generated in +that folder. **Linearize** can be set to either TRUE or FALSE. If TRUE, +linearized 6-by-6 stiffness, damping, and added-mass matrices will be +computed and printed to the calling terminal. **NSteps** specifies the +number of simulation time steps, and **TimeInterval** specifies the time +between steps. + +Motion of the structure can be specified in different ways according to +**PRPInputsMod**. Irrespective of the choice of **PRPInputsMod** (which +are explained below), the translational displacement, velocity, and +acceleration are always specified in the global inertial-frame coordinate +system. With OpenFAST now updated to support potentially large platform +rotation, the specification of rotation differs from previous versions. +HydroDyn now describes body rotation using Tait-Bryan roll, pitch, and +yaw angles with the convention of intrinsic (about body-fixed axis) yaw +rotation first, followed by pitch rotation, and roll last. Furthermore, +HydroDyn now expects the first and second time derivatives of the +Tait-Bryan roll, pitch, and yaw angles in place of angular velocity and +acceleration. The standalone HydroDyn driver will convert these inputs +to angular velocity and acceleration internally. + +Setting **PRPInputsMod** = 0 forces all platform reference point (PRP) +input motions to zero for all time. If you set **PRPInputsMod** = 1, +then you must set the steady-state inputs in the PRP STEADY STATE +INPUTS section of the file. Setting **PRPInputsMod** = 2 requires the time-series input file whose name is specified via the -**WAMITInputsFile** parameter. The WAMIT inputs file is a text-formatted +**PRPInputsFile** parameter. The PRP input file is a text-formatted file. This file has no header lines. Each data row corresponds to a given time step, and the whitespace separated columns of floating point values represent the necessary motion inputs as shown in -:numref:`hd-wamit_input_table`. All motions are specified in the global -inertial-frame coordinate system. +:numref:`hd-prp_input_table`. -.. _hd-wamit_input_table: +.. _hd-prp_input_table: -.. table:: WAMIT Inputs Time-Series Data File Contents +.. table:: PRP Inputs Time-Series Data File Contents (**PRPInputsMod** = 2) :widths: auto - ============= ================================================================================ ====================================== - Column Number Input Units - ============= ================================================================================ ====================================== - 1 Time step value .. math:: s - 2-4 Translational displacements along *X*, *Y*, and *Z* .. math:: m - 5-7 Rotational displacements about *X*, *Y*, and *Z* (small angle assumptions apply) .. math:: \text{radians} - 8-10 Translational velocities along *X*, *Y*, and *Z* .. math:: \frac{m}{s} - 11-13 Rotational velocities about *X*, *Y*, and *Z* .. math:: \frac{\text{radians}}{s} - 14-16 Translational accelerations along *X*, *Y*, and *Z* .. math:: \frac{m}{s^{2}} - 17-19 Rotational accelerations about *X*, *Y*, and *Z* .. math:: \frac{\text{radians}}{s^{2}} - ============= ================================================================================ ====================================== - -In a similar fashion, the input motions for the Morison members -(strip-theory model) are set to zero if **MorisonInputsMod** = 0. If you -select **MorsionInputsMod** = 1 then the motions at each substructure -joint are set to the steady-state values given in the MORISON STEADY -STATE INPUTS section. Currently, option 2 is unavailable for the Morison -inputs. - -The standalone HydroDyn does not check for physical consistency between -motions specified for the WRP and Morison members in the driver file. - -Setting **WaveElevSeriesFlag** to TRUE enables the outputting of a grid -of wave elevations to a text-based file with the name -``OutRootName.WaveElev.out``. The grid consists of **WaveElevNX** by -**WaveElevNY** wave elevations (centered at *X* = 0, *Y* = 0 i.e., -(0,0)) with a **dX** and **dY** spacing in the global inertial-frame -coordinate system. These wave elevations are distinct and output -separately from the wave elevations determined by **NWaveElev** in the -HydroDyn primary input file, such that the total number of wave -elevation outputs is **NWaveElev** + ( **WaveElevNX** × **WaveElevNY** -). The wave-elevation output file ``OutRootName.WaveElev.out`` -contains the total wave elevation, which is the sum of the first- and -second-order terms (when the second-order wave kinematics are optionally -enabled). + ============= ====================================================================== ====================================== + Column Number Input Units + ============= ====================================================================== ====================================== + 1 Time step value .. math:: s + 2-4 Translational displacements along *X*, *Y*, and *Z* .. math:: m + 5-7 Tait-Bryan roll, pitch, and yaw angles .. math:: \text{radians} + 8-10 Translational velocities along *X*, *Y*, and *Z* .. math:: \frac{m}{s} + 11-13 First time derivatives of the Tait-Bryan roll, pitch, and yaw angles .. math:: \frac{\text{radians}}{s} + 14-16 Translational accelerations along *X*, *Y*, and *Z* .. math:: \frac{m}{s^{2}} + 17-19 Second time derivatives of the Tait-Bryan roll, pitch, and yaw angles .. math:: \frac{\text{radians}}{s^{2}} + ============= ====================================================================== ====================================== + +With **PRPInputsMod** = 1 or 2, any potential-flow bodies and strip-theory +members defined in the primary HydroDyn input file will follow the prescribed +motion of the PRP according to rigid-body kinematics. The standalone HydroDyn +does not check for physical consistency between motions (displacement, velocity, +and acceleration) specified for the PRP in the driver file. The user is +responsible for generating consistent kinematics if that is important. + +If the HydroDyn model contains one or more potential-flow bodies, +**PRPInputsMod** can be set to a negative number with :math:`|\ \text{**PRPInputsMod**}\ | = \text{**NBody**}` +in the HydroDyn primary input file. In this case, an alternative form of +the PRP input file shown in :numref:`hd-prp_input_table_2` can be used +to specify different motions for the PRP, which controls the motion of +all strip-theory members based on rigid-body kinematics, and for each +potential-flow bodies separately. With this option, the user only specifies +the translational and rotational displacements. HydroDyn will compute the +velocity and acceleration by numerically differentiating the displacement +with respect to time. + +.. _hd-prp_input_table_2: + +.. table:: PRP Inputs Time-Series Data File Contents (**PRPInputsMod** < 0) + :widths: auto + + ============= =================================================================================== ======================== + Column Number Input Units + ============= =================================================================================== ======================== + 1 Time step value .. math:: s + 2-4 Translational displacements of the PRP along *X*, *Y*, and *Z* .. math:: m + 5-7 Tait-Bryan roll, pitch, and yaw angles of the PRP .. math:: \text{radians} + 8-10 Translational displacements of the 1st potential-flow body along *X*, *Y*, and *Z* .. math:: m + 11-13 Tait-Bryan roll, pitch, and yaw angles of the 1st potential-flow body .. math:: \text{radians} + 14-16 Translational displacements of the 2nd potential-flow body along *X*, *Y*, and *Z* .. math:: m + 17-19 Tait-Bryan roll, pitch, and yaw angles of the 2nd potential-flow body .. math:: \text{radians} + ... ... ... + ============= =================================================================================== ======================== .. _hd-primary-input: @@ -134,371 +166,15 @@ identifier for the table entry, and these IDs do not need to be consecutive or increasing, but they must be unique for a given table entry. -The input file begins with two lines of header information which is for -your use, but is not used by the software. On the next line, set the +The input file begins with two lines of header information for +your use, but they are not used by the software. On the next line, set the **Echo** flag to TRUE if you wish to have HydroDyn echo the contents of the HydroDyn input file (useful for debugging errors in the input file). The echo file has the naming convention of **OutRootName**\ *.HD.ech*. **OutRootName** is either specified in the HYDRODYN section of the -driver input file when running HydroDyn standalone, or by FAST when +driver input file when running HydroDyn standalone, or by OpenFAST when running a coupled simulation. -Environmental Conditions ------------------------- -Environmental conditions are now specified in the driver input file but are left in -the primary input file for legacy compatibility. Use the keyword -DEFAULT to pass in values specified by the driver input file. Otherwise, -values given in the primary input file will overwrite those given in the -driver input file. **WtrDens** specifies the water density and must be a value greater than -or equal to zero; a typical value of seawater is around 1025 -kg/m\ :sup:`3`. **WtrDpth** specifies the water depth (depth of the flat -seabed), based on the reference MSL, and must be a value greater than -zero. **MSL2SWL** is the offset between the MSL and SWL, positive -upward. This parameter is useful when simulating the effect of tides or -storm-surge sea-level variations without having to alter the -substructure geometry information. This parameter is unused with -**WaveMod** = 6 and must be set to zero if you are using a -potential-flow model (**PotMod** = 1 or 2). - -Waves ------ - -The WAVES section of the input file controls the internal generation of -first-order waves or the use of externally generated waves, used by both -the strip-theory and potential-flow solutions. The wave spectrum -settings in this section only pertain to the first-order wave frequency -components. When second-order terms are optionally enabled—see the -:ref:`hd-2nd_order_waves_input` and :ref:`hd-2nd_order_floating_platform_forces_input` -sections below—the second-order terms are calculated using the -first-order wave-component amplitudes and extra energy is added to the -wave spectrum (at the difference and sum frequencies). - -**WaveMod** specifies the incident wave kinematics model. The options -are: - -* 0: none = still water - -* 1: regular (periodic) waves - -* 1P#: regular (periodic) waves with user-specified phase, for example - 1P20.0 for regular waves with a 20˚ phase (without P#, the phase - will be random, based on **WaveSeed**); 0˚ phase represents a - cosine function, starting at the peak and decreasing in time - -* 2: Irregular (stochastic) waves based on the JONSWAP or - Pierson-Moskowitz frequency spectrum - -* 3: Irregular (stochastic) waves based on a white-noise frequency - spectrum - -* 4: Irregular (stochastic) waves based on a user-defined frequency - spectrum from routine *UserWaveSpctrm()*; see Appendix D for - compiling instructions - -* 5: Externally generated wave-elevation time series - -* 6: Externally generated full wave-kinematics time series - -Option 4 requires that the *UserWaveSpctrm()* subroutine of the -*Waves.f90* source file be implemented by the user, and will require -recompiling either the standalone HydroDyn program or FAST. Option 5 -allows the use of externally generated wave-elevation time series, from -which the hydrodynamic loads in the potential-flow solution or the wave -kinematics used in the strip-theory solution are derived internally. -Option 6 allows the use of full externally generated wave kinematics for -use with the strip-theory solution (but not the potential-flow -solution). With options 5 and 6, the externally generated wave data is -provided through input files, all of which have the root name given by -the **WvKinFile** parameter below. - -This version does not include the ability to model stretching of -internally generated incident wave kinematics to the instantaneous free -surface; you must set **WaveStMod** = 0. - -**WaveTMax** sets the length of the incident wave kinematics time -series, but it also determines the frequency step used in the inverse -FFT, from which the internal wave time series are derived (*Δω* = -2\ *π*/**WaveTMax**). If **WaveTMax** is less than the total simulation -time, HydroDyn implements repeating wave kinematics that have a period -of **WaveTMax**; **WaveTMax** must not be less than the total simulation -time when **WaveMod** = 5. **WaveDT** determines the time step for the -wave kinematics time series, but it also determines the maximum -frequency in the inverse FFT (*ω\ max* = *π*/**WaveDT**). When modeling -irregular sea states, we recommend that **WaveTMax** be set to at least -1 hour (3600 s) and that **WaveDT** be a value in the range between 0.1 -and 1.0 s to ensure sufficient resolution of the wave spectrum and wave -kinematics. When HydroDyn is coupled to FAST, **WaveDT** may be -specified arbitrarily independently from the glue code time step of FAST -(the wave kinematics will be interpolated in time as necessary); -**WaveDT** must equal the glue code time step of FAST when **WaveMod** = -6. - -For internally generated waves, the wave height (crest-to-trough, twice -the amplitude) for regular waves and the significant wave height for -irregular waves is set using **WaveHs** (only used when **WaveMod** = 1, -2, or 3). The wave period for regular waves and the peak-spectral wave -period for irregular waves is controlled with the **WaveTp** parameter -(only used when **WaveMod** = 1 or 2). **WavePkShp** is the peak-shape -parameter of JONSWAP irregular wave spectrum (only used when **WaveMod** -= 2). Set **WavePkShp** to DEFAULT to obtain the value recommended in -the IEC 61400-3 Annex B, derived based on the peak-spectral period and -significant wave height [IEC, 2009]. Set **WavePkShp** to 1.0 for the -Pierson-Moskowitz spectrum. - -**WvLowCOff** and **WvHiCOff** control the lower and upper cut-off -frequencies (in rad/s) of the first-order wave spectrum; the first-order -wave-component amplitudes are zeroed below and above these cut-off -frequencies, respectively. **WvLowCOff** may be set lower than the -low-energy limit of the first-order wave spectrum to minimize -computational expense. Setting a proper upper cut-off frequency -(**WvHiCOff**) also minimizes computational expense and is important to -prevent nonphysical effects when approaching of the breaking-wave limit -and to avoid nonphysical wave forces at high frequencies (i.e., at short -wavelengths) when using a strip-theory solution. **WvLowCOff** and -**WvHiCOff** are unused when **WaveMod** = 0, 1, or 6. - -**WaveDir** (unused when **WaveMod** = 0 or 6) is the mean wave -propagation heading direction (in degrees), and must be in the range -(-180,180]. A heading of 0 corresponds to wave propagation in the -positive X-axis direction. And a heading of 90 corresponds to wave -propagation in the positive Y-axis direction. **WaveDirMod** specifies -the wave directional spreading model (only used when **WaveMod** = 2, 3, -or 4). Setting **WaveDirMod** to 0 disables directional spreading, -resulting in long-crested (plane-progressive) sea states propagating in -the **WaveDir** direction. Setting **WaveDirMod** to 1 enables the -modeling of short-crested sea states, with a mean propagation direction -of **WaveDir**, through the commonly used cosine spreading function -(COS:sup:`2\ S`) to define the directional spreading spectrum, based on -the spreading coefficient (*S*) defined via **WaveDirSpread**. The wave -directional spreading spectrum is discretized with an equal-energy -method using **WaveNDir** number of equal-energy bins. **WaveNDir** is -an odd-valued integer greater or equal to 1 (1 or 3 or 5…), but HydroDyn -may slightly increase the specified value of **WaveNDir** to ensure that -there is the same number of wave components within each direction bin; -setting **WaveNDir** = 1 is equivalent to setting **WaveDirMod** = 0. -The range of the directional spread (in degrees) is defined via -**WaveDirSpread**. The equal-energy method assumes that the directional -spreading spectrum is the product of a frequency spectrum and a -spreading function i.e. *S*\ (*ω*,\ *β*) = *S*\ (*ω*)\ *D*\ (*β*). -Directional spreading is not permitted when using Newman’s approximation -of the second-order difference-frequency potential-flow loads. - -**WaveSeed(1)** and **WavedSeed(2)** (unused when **WaveMod** = 0, 5, or -6) combined determine the initial seed (starting point) for the internal -pseudorandom number generator (pRNG) needed to derive the internal wave -kinematics from the wave frequency and direction spectra. If both are -numeric values, the Fortran intrinsic pRNG is used. If **WaveSeed(2)** -is the string "RANLUX", an alternative pRNG included with the NWTC Library -is used and the value of **WaveSeed(1)** is the seed. If you want to -run different time-domain realizations for given boundary conditions (of -significant wave height, and peak-spectral period, etc.), you should -change one or both seeds between simulations. While the phase of each -wave frequency and direction component of the wave spectrum is always -based on a uniform distribution (except when using the 1P# **WaveMod** -option), the amplitude of the wave frequency spectrum can also be -randomized (following a normal distribution) by setting **WaveNDAmp** to -TRUE. Setting **WaveNDAmp** to FALSE means that the amplitude of the -wave frequency spectrum always matches the target spectrum. -**WaveNDAmp** is only used with **WaveMod** = 2, 3, or 4. - -When using externally generated wave data (**WaveMod** = 5 or 6), input -parameter **WvKinFile** should be set to the root name of the input -file(s) (without extension) containing the data. - -Using externally generated wave-elevation time series (**WaveMod** = 5) -requires a text-formatted input data file with the extension *.Elev* -containing two columns of data—the first is time (starting at zero) (in -s) and the second is the wave elevation at (0,0) (in m), separated by -whitespace. Header lines (identified as those not beginning with a -number) are ignored. The time series must be at least **WaveTMax** in -length and not less than the total simulation time and the time step -must match **WaveDT**. The wave-elevation time series specified is -assumed to be of first order and long-crested, but is not checked for -physical correctness. When second-order terms are optionally enabled—see -the 2\ :sup:`ND`-ORDER WAVES and 2\ :sup:`ND`-ORDER FLOATING PLATFORM -FORCES sections below—the second-order terms are calculated using the -wave-component amplitudes derived from the provided wave-elevation time -series and extra energy is added to the wave spectrum (at the difference -and sum frequencies). - -Using full externally generated wave kinematics (**WaveMod** = 6) -requires eight text-formatted input data files, all without headers. -Seven files with extensions *.Vxi*, *.Vyi*, *.Vzi*, *.Axi*, *.Ayi*, -*.Azi*, and *.DynP* correspond to the *X*, *Y*, and *Z* velocities (in -m/s) and accelerations (in m/s\ :sup:`2`) in the global inertial-frame -coordinate system and the dynamic pressure (in Pa) time series. Each of -these files must have exactly **WaveTMax**/**DT** rows and *N* -whitepace-separated columns, where *N* is the total number of internal -HydroDyn analysis nodes (corresponding exactly to those written to the -HydroDyn summary file). Time is absent from the files, but is assumed to -go from zero to **WaveTMax** – **WaveDT** in steps of **WaveDT**. To use -this feature, it is the burden of the user to generate wave kinematics -data at each of HydroDyn’s time steps and analysis nodes. HydroDyn will -not interpolate the data; as such, when HydroDyn is coupled to FAST, -**WaveDT** must equal the glue code time step of FAST. A numerical value -(including 0) in a file is assumed to be valid data (with 0 -corresponding to 0 m/s, 0 m/s\ :sup:`2`, or 0 Pa); a nonnumeric string -will designate that the node is outside of the water at that time step -(above the instantaneous water elevation or below the seabed)—externally -generated wave kinematics used with **WaveMod** = 6 are not limited to -the domain between a flat seabed and SWL and may consider wave -stretching, higher-order wave theories, or an uneven seabed. All seven -files must have nonnumeric strings in the same locations within the -file. The eighth file, with extension *.Elev*, must contain the wave -elevation (in m) at each of the **NWaveElev** points on the SWL where -wave elevations can be output—see below; this data is required for -output purposes only and is not used by HydroDyn for other means. This -file must have exactly **WaveTMax**/**DT** rows and **NWaveElev** -whitepace-separated columns and only valid numeric data is allowed (the -file will have **NWaveElev** + ( **WaveElevNX** × **WaveElevNY** ) -columns when HydroDyn is operated in standalone mode). The data in these -files is not processed (filtered, etc.) or checked for physical -correctness (other than for consistency in the location of the -nonnumeric strings). Full externally generated wave kinematics -(**WaveMod** = 6) cannot be used in conjunction with the potential-flow -solution. - -You can generate up to 9 wave elevation outputs. **NWaveElev** -determines the number (between 0 and 9), and the whitespace-separated -lists of **WaveElevxi** and **WaveElevyi** determine the locations of -these **NWaveElev** number of points on the SWL plane in the global -inertial-frame coordinate system. - -.. _hd-2nd_order_waves_input: - -2\ :sup:`nd`-Order Waves ------------------------- -The 2\ :sup:`ND`-ORDER WAVES section (unused when **WaveMod** = 0 or 6) -of the input file allows the option of adding second-order contributions -to the wave kinematics used by the strip-theory solution. When -second-order terms are optionally enabled, the second-order terms are -calculated using the first-order wave-component amplitudes and extra -energy is added to the wave spectrum (at the difference and sum -frequencies). The second-order terms cannot be computed without also -including the first-order terms from the WAVES section above. Enabling -the second-order terms allows one to capture some of the nonlinearities -of real surface waves, permitting more accurate modeling of sea states -and the associated wave loads at the expense of greater computational -effort (mostly at HydroDyn initialization). - -While the cut-off frequencies in this section apply to both the -second-order wave kinematics used by strip theory and the second-order -diffraction loads in potential-flow theory, the second-order terms -themselves are enabled separately. The second-order wave kinematics used -by strip theory are enabled in this section while the second-order -diffraction loads in potential-flow theory are enabled in the -:ref:`hd-2nd_order_floating_platform_forces_input` section below. While the -second-order effects are included when enabled, the wave elevations -output from HydroDyn will only include the second-order terms when the -second-order wave kinematics are enabled in this section. - -To use second-order wave kinematics in the strip-theory solution, set -**WvDiffQTF** and/or **WvSumQTF** to TRUE. When **WvDiffQTF** is set to -TRUE, second-order difference-frequency terms, calculated using the full -difference-frequency QTF, are incorporated in the wave kinematics. When -**WvSumQTF** is set to TRUE, second-order sum-frequency terms, -calculated using the full sum-frequency QTF, are incorporated in the -wave kinematics. The full difference- and sum-frequency wave kinematics -QTFs are implemented analytically following [Sharma and Dean, 1981], -which extends Stokes second-order theory to irregular multidirectional -waves. A setting of FALSE disregards the second-order contributions to -the wave kinematics in the strip-theory solution. - -**WvLowCOffD** and **WvHiCOffD** control the lower and upper cut-off -frequencies (in rad/s) of the second-order difference-frequency terms; -the second-order difference-frequency terms are zeroed below and above -these cut-off frequencies, respectively. The cut-offs apply directly to -the physical difference frequencies, not the two individual first-order -frequency components of the difference frequencies. When enabling -second-order potential-flow theory, a setting of **WvLowCOffD** = 0 is -advised to avoid eliminating the mean-drift term (second-order wave -kinematics do not have a nonzero mean). **WvHiCOffD** need not be set -higher than the peak-spectral frequency of the first-order wave spectrum -(*ω\ p* = 2\ *π*/**WaveTp**) to minimize computational expense. - -Likewise, **WvLowCOffS** and **WvHiCOffS** control the lower and upper -cut-off frequencies (in rad/s) of the second-order sum-frequency terms; -the second-order sum-frequency terms are zeroed below and above these -cut-off frequencies, respectively. The cut-offs apply directly to the -physical sum frequencies, not the two individual first-order frequency -components of the sum frequencies. **WvLowCOffS** need not be set lower -than the peak-spectral frequency of the first-order wave spectrum -(*ω\ p* = 2\ *π*/**WaveTp**) to minimize computational expense. Setting -a proper upper cut-off frequency (**WvHiCOffS**) also minimizes -computational expense and is important to (1) ensure convergence of the -second-order summations, (2) avoid unphysical "bumps" in the wave -troughs, (3) prevent nonphysical effects when approaching of the -breaking-wave limit, and (4) avoid nonphysical wave forces at high -frequencies (i.e., at short wavelengths) when using a strip-theory -solution. - -Because the second-order terms are calculated using the first-order -wave-component amplitudes, the second-order cut-off frequencies -(**WvLowCOffD**, **WvHiCOffD**, **WvLowCOffS**, and **WvHiCOffS**) are -used in conjunction with the first-order cut-off frequencies -(**WvLowCOff** and **WvHiCOff**) from the WAVES section. However, the -second-order cut-off frequencies are not used by Newman’s approximation -of the second-order difference-frequency potential-flow loads, which are -derived solely from first-order effects. - -Current -------- -You can include water velocity due to a current model by setting -**CurrMod** = 1. If **CurrMod** is set to zero, then the simulation will -not include current. **CurrMod** = 2 requires that the *UserCurrent()* -subroutine of the *Current.f90* source file be implemented by the user, -and will require recompiling either the standalone HydroDyn program or -FAST. Current induces steady hydrodynamic loads through the viscous-drag -terms (both distributed and lumped) of strip-theory members. Current is -not used in the potential-flow solution or when **WaveMod** = 6. - -HydroDyn’s standard current model includes three sub-models: -near-surface, sub-surface, and depth-independent, as illustrated in -:numref:`hd-fig:current_sub_model`. All three currents are vector summed, -along with the wave particle kinematics velocity. - -.. figure:: figs/current_sub_models.jpg - :align: center - :name: hd-fig:current_sub_model - - Standard Current Sub-Models - -The sub-surface current model follows a power law, - -.. math:: - :label: SubsurfacePowerLaw - - U_{SS}(Z) = U_{0_{SS}} \left( \frac{Z+d}{d} \right)^{ \frac{1}{7} } - -where :math:`Z` is the local depth below the SWL (negative downward), :math:`d` is the -water depth (equal to **WtrDpth** + **MSL2SWL**), and :math:`U_{0_{SS}}` is the current -velocity at SWL, corresponding to **CurrSSV0**. The heading of the -sub-surface current is defined using **CurrSSDir** following the same -convention as **WaveDir**. - -The near-surface current model follows a linear relationship down to a -reference depth such that, - -.. math:: - :label: NearsurfacePowerLaw - - U_{NS}(Z) = U_{0_{NS}} \left( \frac{Z+h_{ref}}{h_{ref}} \right), Z\in[-h_{ref},0] - -otherwise, - -.. math:: - :label: NearsurfaceDeep - - U_{NS}(Z) = 0 - -where :math:`h_{ref}` is the reference depth corresponding to **CurrNSRef** and must be -positive valued. :math:`U_{0_{NS}}` is the current velocity at SWL, corresponding to -**CurrNSV0**. The heading of the near-surface current is defined using -**CurrNSDir**, following the same convention as **WaveDir**. - -The depth-independent current velocity everywhere equals **CurrDIV**. -This current has a heading direction **CurrDIDir**, following the same -convention as **WaveDir**. Floating Platform ----------------- @@ -507,45 +183,112 @@ This and the next few sections of the input file have "Floating Platform" in the title, but the input parameters control the potential-flow model, regardless of whether the substructure is floating or not. The potential-flow solution cannot be used in conjunction with -nonzero **MSL2SWL** or **WaveMod** = 6. - -If the load contributions from potential-flow theory are to be used, set -**PotMod** to 1 for the use of frequency-to-time-domain transforms based -on WAMIT output or 2 for the use of FIT (FIT is not yet documented in -this manual). With **PotMod** = 1, include the root name (without -extensions) for the WAMIT-related output files in **PotFile**. These -files consist of the *.1*, *.3*,\ *.hst* and second-order files. These -are written by the WAMIT program and should not include any file -headers. When the linear state-space model is used in placed of -convolution, the *.ss* file generated by -`SS_Fitting `__ must have the same -root name as the other WAMIT-related files (see **RdtnMod** below). The -remaining parameters in this section are only used when **PotMod** = 1. - -The output files from WAMIT are in a standard nondimensional form that -HydroDyn will dimensionalize internally upon input. **WAMITULEN** is the -characteristic body length scale used to redimensionalize the WAMIT -output. The body motions and forces in these files are in relation to -the WAMIT reference point (WRP) in HydroDyn, which for the undisplaced -substructure is the same as the origin of the global inertial-frame -coordinate system (0,0,0). The *.hst* file contains the 6x6 linear -hydrostatic restoring (stiffness) matrix of the platform. The *.1* file -contains the 6x6 frequency-dependent hydrodynamic added-mass and damping -matrix of the platform from the radiation problem. The *.3* file -contains the 6x1 frequency- and direction-dependent first-order -wave-excitation force vector of the platform from the linear diffraction -problem. While HydroDyn expects hydrodynamic coefficients derived from -WAMIT, if you are not using WAMIT, it is recommended that you reformat -your data according to the WAMIT format (including -nondimensionalization) before inputting them to HydroDyn. Information on -the WAMIT format is available from Chapter 4 of the WAMIT User's Guide -:cite:`LeeNewman:2006`. - -**PtfmVol0** is the displaced volume of water when the platform is in -its undisplaced position. This value should be set equal to the value -computed by WAMIT as output in the WAMIT ``.out`` file. **PtfmCOBxt** and -**PtfmCOByt** are the *X* and *Y* offsets of the center of buoyancy from -the WRP. +nonzero **MSL2SWL** or **WaveMod** = 6 in SeaState. + +If the load contributions from potential-flow theory are to be included, set +**PotMod** to 1 to use frequency-to-time domain transforms based +on WAMIT output or 2 to use FIT (FIT is not yet documented in +this manual). The remaining parameters in this section are only used when +**PotMod** = 1. + +**ExctnMod** can be set to 0 for no wave excitation, 1 for +frequency-to-time domain wave excitation using discrete Fourier transform, +or 2 for the state-space wave-excitation model. Depending on the choice of +**ExctnMod**, suitable hydrodynamic input files must be provided through the +**PotFile** input. More information below. + +**ExctnDisp** specifies if and how structure displacement in the horizontal +plane should be considered when evaluating the potential-flow wave excitation. +Setting **ExctnDisp** = 0 ignores structure displacement, and wave +excitation will be computed using the undisplaced structure position as in +previous versions of OpenFAST. If **ExctnDisp** = 1, HydroDyn will compute +the potential-flow wave excitation using the unfiltered instantaneous PRP +position in the horizontal plane. If **ExctnDisp** = 2, HydroDyn will instead +compute the wave excitation based on the low-pass filtered PRP position in +the horizontal plane. The cutoff frequency is specified through **ExctnCutOff** +in Hz. This option is useful when second-order potential-flow wave excitation is +enabled. The cutoff frequency should be set to filter out as much of the +wave-frequency PRP motion as possible while retaining the low-frequency drift +motion to prevent double counting the contributions from first-order +structural motion already included in the second-order potential-flow wave +excitation. + +HydroDyn now supports large but slow (well below wave frequencies) +transient platform yaw motion with both strip-theory only and hybrid +potential-flow models. To enable this capability, the inputs +**PtfmYMod**, **PtfmRefY**, **PtfmYCutoff**, and **NExctnHdg** must +be set appropriately. Note that HydroDyn still requires the platform +roll and pitch angles to be small, i.e., within +/-15 deg. + +To conform with the first- and second-order potential-flow theory, +which limits the structure to small displacement about a reference +mean position, a constant or slowly varying reference platform yaw +orientation must be established. + +Setting **PtfmYMod** = 0 lets HydroDyn use a constant reference yaw +angle given by **PtfmRefY** in degrees. In this case, the platform +yaw rotation during the simulation, as given by the **PRPYaw** +output channel, must stay within +/-15 deg of **PtfmRefY** specified +by the user. A severe warning will be displayed if this requirement +is not met at any point during the simulation, while still allowing +the simulation to continue if possible. With a hybrid potential-flow +model, the potential-flow wave excitation input file needs to cover +a suitable range of wave headings relative to the platform after a +yaw offset of **PtfmRefY** is applied. + +Alternatively, **PtfmYMod** = 1 lets HydroDyn update the reference +yaw position **PtfmRefY** dynamically based on the low-pass-filtered +platform yaw rotation, analogous to the modeling of slow-drift motion +with **ExctnDisp** = 2 above. In this case, the **PtfmRefY** input +allows the user to specify the initial reference yaw position at +**t** = 0. The cutoff frequency of the first-order low-pass filter +for platform yaw rotation can be set with **PtfmYCutoff** in Hz. +Ideally, **PtfmYCutoff** should be placed between the wave frequency +region and the characteristic frequency of any slow but large change +in platform heading to filter out as much wave-frequency platform +motion as possible while minimizing the phase shift in the low-frequency +heading change. Throughout the simulation, the instantaneous +platform yaw rotation should stay within +/-15 deg of the now +time-dependent **PtfmRefY**. A severe warning will be displayed if +this requirement is not met at any point during the simulation, while +still allowing the simulation to continue if possible. + +With **PtfmYMod** = 1, HydroDyn requires the first- and second-order +(mean- or slow-drift loads from Newman's approximation only) +potential-flow wave excitation input file(s) to cover the full range +of possible wave headings with the first (smallest) wave heading being +exactly -180 deg and the last (largest) wave heading being exactly ++180 deg (the duplicated wave headings of +/-180 deg are intentional). +HydroDyn will error out if this requirement is not met by the input files. +HydroDyn uses this information to precompute the wave excitation on +the platform for **NExctnHdg** evenly distributed platform yaw/heading +angles over the range of [-180,+180) deg. For instance, with +**NExctnHdg** = 36, HydroDyn will precomupte the wave excitation for 0, +10, 20, ..., 350 deg platform heading. The instantaneous wave excitation +applied on the platform during the time-domain simulation is interpolated +from this data based on the instantaneous **PtfmRefY**. **NExctnHdg** +should be set appropriately to ensure adequate angular resolution in +platform heading. However, a high **NExctnHdg** can increase memory use +by OpenFAST substantially. + +Additional constraints on HydroDyn inputs apply when **PtfmYMod** = 1. +The strip-theory hydrodynamic load must be evaluated using the wave +kinematics and dynamic pressure at the displaced structure position +by setting **WaveDisp** = 1. State-space wave excitation cannot be used. +**ExctnMod** must be either 0 (no wave excitation) or 1 (frequency-to-time +domain transform using inverse discrete Fourier transform). Lastly, +full difference- and sum-frequency QTFs are not supported, requiring +both **DiffQTF** and **SumQTF** to be set to 0. However, mean- or +slow-drift loads based on Newman's approximation can be included through +the **MnDrift** or **NewmanApp** inputs explained below. + +Note that the inputs **PtfmYMod** and **PtfmRefY** also affect the +strip-theory hydrodynamic load. This is because the orientation of +the strip-theory members is updated based on **PtfmRefY** instead +of the instantaneous platform yaw rotation. Behavior of previous +versions of HydroDyn can be approximately recovered by setting +**PtfmYMod** = 0 and **PtfmRefY** = 0 deg, in which case, the +inputs **PtfmYCutoff** and **NExctnHdg** are not used. HydroDyn has two methods for calculating the radiation memory effect. Set **RdtnMod** to 1 for the convolution method, 2 for the linear @@ -566,8 +309,85 @@ method, **RdtnDT** is the time step for the radiation calculations the cosine transform. For the state-space model, **RdtnDT** is the time step to use for time integration of the linear state-space model. In this version of HydroDyn, **RdtnDT** must match the glue code -(FAST/driver program) simulation time step; the DEFAULT keyword can be -used for this. +(OpenFAST/driver program) simulation time step; the DEFAULT keyword can be +used for this. Depending on the choice of **RdtnMod**, suitable hydrodynamic +input files must be provided through the **PotFile** input. More +information below. + +HydroDyn supports the inclusion of multiple potential-flow bodies. +**NBody** specifies the number of potential-flow bodies present. +**NBodyMod** controls how multiple potential-flow bodies should be modeled. +HydroDyn will retain the full hydrodynamic coupling among the potential-flow +bodies if **NBodyMod** = 1. For this option, all bodies should be present +in the same WAMIT run with **NBody** in HydroDyn being equal to NBODY in the +WAMIT input file. The WAMIT output files should contain results for 6·NBody modes. +HydroDyn will neglect hydrodynamic coupling among the potential-flow bodies if +**NBodyMod** = 2 or 3. In either case, WAMIT should be run for each body separately +one at a time. If the WAMIT computation is run with each body centered at the +origin (XBODY=0 in WAMIT), **NBodyMod** = 2 should be used in HydroDyn. +In this case, HydroDyn will process the WAMIT outputs to account for the +shift in wave phase due to any offset of each potential-flow body from the +origin/PRP. HydroDyn will also rotate the WAMIT outputs according to the heading of +each body in HydroDyn. **NBodyMod** = 2 is convenient when, e.g., multiple +identical potential-flow bodies are present in the structure. If the hydrodynamic +coupling among the bodies can be neglected, the same set of WAMIT output files +can be used for each body by setting **NBodyMod** = 2. On the other hand, +**NBodyMod** = 3 should be used if each body is already positioned and oriented +correctly relative to the origin/PRP in WAMIT by setting XBODY in the WAMIT input +file. In this case, HydroDyn will use the provided WAMIT output as is. + +The **PotFile** input should contain the path and root name (without +extensions) for the WAMIT output files enclosed in quotation marks. These +files consist of the *.1*, *.3*, *.hst*, and second-order files. The +*.hst* file contains the hydrostatic restoring (stiffness) matrix. +The *.1* file contains the frequency-dependent hydrodynamic added-mass +and damping matrix from the wave radiation problem. The *.3* +file contains the frequency- and direction-dependent first-order +wave-excitation vector from the linear wave diffraction +problem. These are written by the WAMIT program and should not include +any file headers. When the linear state-space model is used in place of +frequency-to-time domain transformation for wave excitation or in place +of convolution for radiation, the *.ssexctn* file for wave excitation +(more information to be provided in the future) and/or the *.ss* file +for radiation generated by `SS_Fitting `__ +must have the same root name as the other WAMIT-related files. + +When **NBodyMod** = 1, **PotFile** should only contain one entry irrespective of +**NBody** because the hydrodynamic coefficients for all bodies with +hydrodynamic coupling should be contained within a single set of files. +When **NBodyMod** = 2 or 3, **PotFile** should contain **NBody** entries, +each enclosed in quotes and separated from each other with commas or spaces. +Each entry of **PotFile** corresponds to a single potential-flow body. + +In the reminder of this section, each input should contain **NBody** entries +separated by commas or spaces, irrespective of **NBodyMod**. + +The output files from WAMIT are in a standard nondimensional form that +HydroDyn will dimensionalize internally upon input. **WAMITULEN** is the +characteristic body length (in m) used to redimensionalize the WAMIT +output. The body motion and force/moment in these WAMIT files are always +resolved in the body-local frame of reference given by XBODY in the WAMIT +input file. To correctly interpret the WAMIT outputs, the position and +heading of each potential-flow body relative to the origin/PRP must be +specified using **PtfmRefxt**, **PtfmRefyt**, **PtfmRefzt**, and +**PtfmRefztRot** (in m or deg). With the exception of **NBodyMod** = 2, +these inputs must match XBODY in the WAMIT input file. When +**NBodyMod** = 2, these inputs can be set freely except for **PtfmRefzt**, +which must always be zero. + +While HydroDyn expects hydrodynamic coefficients derived from +WAMIT, if you are not using WAMIT, it is recommended that you reformat +your data according to the WAMIT format (including +nondimensionalization) before inputting them to HydroDyn. Information on +the WAMIT format is available from Chapter 4 of the WAMIT User's Guide +:cite:`LeeNewman:2006`. + +**PtfmVol0** is the displaced volume of water when the potential-flow body is in +its undisplaced position (in m\ :sup:`3`). This value should be set equal +to the value computed by WAMIT as output in the WAMIT ``.out`` file. +**PtfmCOBxt** and **PtfmCOByt** are the *X* and *Y* offsets (in m) of the +center of buoyancy of each body from the origin/PRP, NOT from +**PtfmRefxt** and **PtfmRefyt**. .. _hd-2nd_order_floating_platform_forces_input: @@ -577,26 +397,21 @@ The 2\ :sup:`ND`-ORDER FLOATING PLATFORM FORCES section of the input file allows the option of adding second-order contributions to the potential-flow solution. When second-order terms are optionally enabled, the second-order terms are calculated using the first-order -wave-component amplitudes and extra energy is added to the wave spectrum -(at the difference and sum frequencies). The second-order terms cannot +wave-component amplitudes and added to the first-order wave excitation +at the difference and/or sum frequencies. The second-order terms cannot be computed without also including the first-order terms from the FLOATING PLATFORM section above (**PotMod** = 1). Enabling the -second-order terms allows one to capture some of the nonlinearities of -real surface waves, permitting more accurate modeling of sea states and -the associated wave loads at the expense of greater computational effort -(mostly at HydroDyn initialization). +second-order terms allows one to capture some of the nonlinearities in the +wave loads, permitting more accurate modeling at the expense of greater +computational effort (mostly at HydroDyn initialization). -While the cut-off frequencies in the :ref:`hd-2nd_order_waves_input` section -above apply to both the second-order wave kinematics used by strip +While the cut-off frequencies in the :ref:`sea-2nd_order_waves_input` section +of the SeaState module apply to both the second-order wave kinematics used by strip theory and the second-order diffraction loads in potential-flow theory, the second-order terms themselves are enabled separately. The second-order wave kinematics used by strip theory are enabled in the -:ref:`hd-2nd_order_waves_input` section above while the second-order +:ref:`sea-2nd_order_waves_input` section while the second-order diffraction loads in potential-flow theory are enabled in this section. -While the second-order effects are included when enabled, the wave -elevations output from HydroDyn will only include the second-order terms -when the second-order wave kinematics are enabled in the -:ref:`hd-2nd_order_waves_input` section above. The second-order difference-frequency potential-flow terms can be enabled in one of three ways. To compute only the mean-drift term, set @@ -619,20 +434,20 @@ will be calculated from. Only one of **MnDrift**, **NewmanApp**, and difference-frequency contributions to the potential-flow solution. The .\ *7* WAMIT file refers to the mean-drift loads (diagonal of the -difference-frequency QTF) in all 6 DOFs derived from the control-surface +difference-frequency QTF) in all DOFs derived from the control-surface integration method based on the first-order solution. The .\ *8* WAMIT file refers to the mean-drift loads (diagonal of the -difference-frequency QTF) only in surge, sway, and roll derived from the +difference-frequency QTF) only in surge, sway, and yaw derived from the momentum conservation principle based on the first-order solution. The .\ *9* WAMIT file refers to the mean-drift loads (diagonal of the -difference-frequency QTF) in all six DOFs derived from the pressure +difference-frequency QTF) in all DOFs derived from the pressure integration method based on the first-order solution. For the difference-frequency terms, 10, 11, and 12 refer to the WAMIT .\ *10d*, .\ *11d*, and .\ *12d* files, corresponding to the full QTF of (.*10d*) -loads in all 6 DOFs associated with the quadratic interaction of +loads in all DOFs associated with the quadratic interaction of first-order quantities, (.*11d*) total (quadratic plus second-order -potential) loads in all 6 DOFs derived by the indirect method, and -(.*12d*) total (quadratic plus second-order potential) loads in all 6 +potential) loads in all DOFs derived by the indirect method, and +(.*12d*) total (quadratic plus second-order potential) loads in all DOFs derived by the direct method, respectively. The second-order sum-frequency potential-flow terms can only be enabled @@ -645,10 +460,14 @@ sum-frequency terms, 10, 11, and 12 refer to the WAMIT .\ *10s*, .\ *11s*, and .\ *12s* files, corresponding to the full QTF of (.*10s*) loads in all 6 DOFs associated with the quadratic interaction of first-order quantities, (.*11s*) total (quadratic plus second-order -potential) loads in all 6 DOFs derived by the indirect method, and -(.*12s*) total (quadratic plus second-order potential) loads in all 6 +potential) loads in all DOFs derived by the indirect method, and +(.*12s*) total (quadratic plus second-order potential) loads in all DOFs derived by the direct method, respectively. +Note that also apply here are the various considerations associated with +running WAMIT for multiple potential-flow bodies discussed in the +**FLOATING PLATFORM** section for first-order loads. + Platform Additional Stiffness and Damping ----------------------------------------- The vectors and matrices of this section are used to generate additional @@ -660,25 +479,62 @@ calculated by HydroDyn), per the following equation. \overrightarrow{F}_{Add} = \overrightarrow{F}_{0} - [C] \overrightarrow{q} - [B] \dot{\overrightarrow{q}} - [B_{quad}] ABS \left(\dot{\overrightarrow{q}}\right) \dot{\overrightarrow{q}} -where :math:`\overrightarrow{F}_{0}` corresponds to the **AddF0** 6x1 static load (preload) vector, -:math:`[C]` corresponds to the **AddCLin** 6x6 -linear restoring (stiffness) matrix, -:math:`[B]` corresponds to the **AddBLin** 6x6 -linear damping matrix, :math:`[B_{quad}]` -corresponds to the **AddBQuad** 6x6 quadratic drag matrix, and :math:`\overrightarrow{q}` -corresponds to the WRP 6x1 (six-DOF) displacement vector (three -translations and three rotations), where the overdot refers to the first -time-derivative. +where :math:`\overrightarrow{F}_{0}` corresponds to the **AddF0** static load (preload) vector, +:math:`[C]` corresponds to the **AddCLin** linear restoring (stiffness) matrix, +:math:`[B]` corresponds to the **AddBLin** linear damping matrix, +:math:`[B_{quad}]` corresponds to the **AddBQuad** quadratic drag matrix, and +:math:`\overrightarrow{q}` corresponds to the displacement vector of the potential-flow bodies +(translation and rotation), where the overdot refers to the first time-derivative. + +**AddF0** is either a column vector with 6\ **NBody** entries +if **NBodyMod** = 1 or **NBody** column vectors with six entries each +if **NBodyMod** = 2 or 3. In the former case, **AddF0** will span +6\ **NBody** lines with each line containing a single number in the +input file. In the latter case, **AddF0** will span six lines with each line +containing **NBody** numbers in the input file. + +**AddCLin**, **AddBLin**, and **AddBQuad** are either a single +6\ **NBody**\ -by-6\ **NBody** matrix if **NBodyMod** = 1 or +six 6-by-6 matrices if **NBodyMod** = 2 or 3. In the former case, +each matrix spans 6\ **NBody** lines in the input file with each line +containing 6\ **NBody** numbers. In the latter case, each matrix +spans six lines in the input file, with each line containing 6\ **NBody** +numbers. These terms can be used, e.g., to model a linearized mooring system, to augment strip-theory members with a linear hydrostatic restoring matrix -(see :numref:`hd-modeling-hydrostatic-restoring-strip-theory`), or to "tune" HydroDyn to match damping to -experimental results, such as free-decay tests. While likely most useful -for floating systems, these matrices can also be used for fixed-bottom -systems; in both cases, the resulting load is applied at the WRP, which -when HydroDyn is coupled to FAST, get applied to the platform in -ElastoDyn (bypassing SubDyn for fixed-bottom systems). See :ref:`hd-modeling-considerations` -for addition guidance for where these terms are necessary. +(see :numref:`hd-modeling-hydrostatic-restoring-strip-theory`), or to "tune" +HydroDyn to match damping to experimental results, such as free-decay tests. +While likely most useful for floating systems, these matrices can also be +used for fixed-bottom systems; in both cases, the resulting load is applied +at the reference point of each potential-flow body given by **PtfmRefxt**, +**PtfmRefyt**, and **PtfmRefzt**. + +Strip theory options +-------------------- +**WaveDisp** can be set to 0 to compute the strip-theory loads using the +wave kinematics and dynamic pressure at the undisplaced position of the +structure. If set to 1, the loads will be computed using the wave kinematics +and dynamic pressure at the instantaneous displaced positions of the strip-theory +members. Note that when wave stretching is not used (\ **WaveStMod** = 0 in +SeaState), only the *X*- and *Y*-displacements of the strip-theory member +nodes are considered when **WaveDisp** = 1, while the vertical *Z*-displacement is +ignored. This is done to avoid discontinuous nodal loads that can result in +unphysical structural vibration with a SubDyn substructure model. When +**WaveStMod** > 0 and **WaveDisp** = 1, displacements of strip-theory members +in all three directions are considered when computing the wave kinematics. +A load smoothing procedure is performed to avoid discontinuous nodal loads +in this case. + +**AMMod** controls the computation of distributed strip-theory added-mass force. +If **AMMod** = 0, the strip-theory added-mass force is always evaluated up +to the SWL while neglecting the vertical displacement of the strip-theory member +nodes, even if wave stretching is enabled. With **AMMod** = 1, the strip-theory +added-mass force is evaluated up to the instantaneous free surface if +**WaveStMod** > 0. The vertical displacement of strip-theory members will also be +accounted for if **WaveDisp** = 1. **AMMod** should only be set to 0 if wave +stretching is causing numerical instabilities with flexible fixed-bottom support +structures modeled in SubDyn. Axial Coefficients ------------------ @@ -687,7 +543,7 @@ strip-theory model for both fixed-bottom and floating substructures. HydroDyn computes lumped viscous-drag, added-mass, fluid-inertia, and static pressure loads at member ends (joints). The hydrodynamic -coefficients for the lumped the lumped loads at joints are referred to +coefficients for the lumped loads at joints are referred to as "axial coefficients" and include viscous-drag coefficients, **AxCd**, added-mass coefficients, **AxCa**, and dynamic-pressure coefficients, **AxCp**. **AxCa** influences both the added-mass loads and the @@ -695,6 +551,40 @@ scattering component of the fluid-inertia loads. Any number of separate axial coefficient sets, distinguished by **AxCoefID**, may be specified by setting **NAxCoef** > 1. +There are three optional inputs that affect the viscous drag force on +endplates. These are **AxFDMod**, **AxVnCOff**, and **AxFDLoFSc**. + +**AxFDMod** can be either 0 or 1. When set to 0, the drag force on +endplates will be computed as in previous versions of OpenFAST. +When set to 1, drag force will only be applied when the relative +flow is directed away from the endplate where flow separation is +expected, not when the relative flow is impinging on the endplate +where flow separation is unlikely. Option 0 is suitable for +strip-theory-only members, whereas option 1 might be better suited for +hybrid potential-flow members with drag force. Note that option 1 +uses a leading coefficient of 1/4 when computing the drag force, while +option 2 uses the more common leading coefficient of 1/2 since drag +is usually only applied to one of the two endplates of the member +instead of on both. + +**AxVnCOff** is the cutoff frequency in Hz for high-pass filtering +the relative normal flow velocity used to compute the endplate drag force. +This input parameter should be used together with the weighting factor +**AxFDLoFSc** (between 0 and 1). When **AxFDLoFSc** = 0, the endplate +drag force is computed purely based on the high-pass filtered relative +normal velocity. When **AxFDLoFSc** = 1, the endplate drag force is +computed purely based on the unfiltered relative normal velocity. This +formulation is added to allow the user to attenuate the drag force in +response to lower-frequency motion. In some cases, this approach can +help address the underprediction of low-frequency resonance motion. + +Users can opt to omit all three optional inputs. In this case, HydroDyn +will compute the endplate drag force as in previous versions of OpenFAST. +Alternatively, users can include only the optional parameter **AxFDMod**. +No velocity filtering will be applied in this case. Lastly, users can +include all three optional parameters to control the behavior of endplate +drag force as explained above. + Axial viscous-drag loads will be calculated for all specified member joints. Axial added-mass, fluid-inertia, and static-pressure loads will only be calculated for member joints of members not modeled with @@ -752,7 +642,7 @@ specified using any of three models, which we refer to as the simple model, a depth-based model, and a member-based model. All of these models require the specification of both transverse and axial hydrodynamic coefficients for viscous drag, added mass, and dynamic -pressure (axial viscous drag is not yet available). The added-mass +pressure. The added-mass coefficient influences both the added-mass loads and the scattering component of the fluid-inertia loads. There are separate set of hydrodynamic coefficients both with and without marine growth. A given @@ -769,12 +659,18 @@ However, different members can specify different coefficient models. In the hydrodynamic coefficient input parameters, **Cd**, **Ca**, and **Cp** refer to the viscous-drag, added-mass, and dynamic-pressure -coefficients, respectively, **MG** identifies the coefficients to be +coefficients, respectively. **MG** identifies the coefficients to be applied for members with marine growth (the standard values are identified without **MG**), and **Ax** identifies the axial coefficients to be applied for tapered members (the transverse coefficients are -identified without **Ax**). It is noted that for the transverse -coefficients, , the inertia coefficient. +identified without **Ax**). The **Cb** coefficients allow the user to +scale the hydrostatic load for, e.g., non-circular member cross sections. +To avoid unphysical hydrostatic loads, the **Cb** coefficients are not +used to directly scale the distributed hydrostatic load. Instead, the +local member diameter (with marine growth if specified) is scaled by +the square root of **Cb** when computing the hydrostatic load. This +scaling also affects the hydrostatic load on member endplates for +consistency. While the strip-theory solution assumes circular cross sections, the hydrodynamic coefficients can include shape corrections; however, there @@ -820,6 +716,45 @@ coefficients for a member distinguished by **MemberID** are as follows: joint of the member, respectively. Members use these hydrodynamic coefficients by setting **MCoefMod** = 3. +MacCamy-Fuchs diffraction load model +++++++++++++++++++++++++++++++++++++ +The MacCamy-Fuchs diffraction load model can be enabled for strip-theory +members using any of the three coefficient models listed above. To enable +the MacCamy-Fuchs model, all transverse **Cp** and **CpMG** coefficients +should be replaced with the keyword **MCF** instead of a numeric value. +For the simple model, this includes **SimplCp** and **SimplCpMG**. With +the depth-based model, **DpthCp** and **DpthCpMG** on all lines should have +the keyword **MCF**. Finally, for the member-based model, **MemberCp1**, +**MemberCp2**, **MemberCpMG1**, and **MemberCpMG2** should all have the keyword +**MCF** only for the members to use the MacCamy-Fuchs model. All other +coefficients can be specified as usual, including the added-mass +coefficients. With this configuration, the distributed transverse fluid-inertia force +on the members will simply follow the MacCamy-Fuchs diffraction load, +irrespective of the added-mass coefficient set by the user. In this case, +the added-mass coefficient only affects the force component proportional +to the structure acceleration, not the force component proportional to +the fluid acceleration. + +Strictly speaking, the MacCamy-Fuchs diffraction solution only applies to +fixed-bottom or deep-drafted vertical circular cylinders with a constant +diameter. To ensure it is approximately applicable while still allowing for some +flexibility, some constraints are placed on members when applying the MacCamy-Fuchs +model: + +* The member must be surface-piercing at least when the structure is undisplaced in calm water. + +* The member must be nearly vertical with an inclination from vertical less than 10 deg. + +* The member can be tapered slightly, but the diameter must be within +/-10% of **MCFD** in the SeaState input file. + +* The member must have a draft at least as large as 0.5\ **MCFD**. + +Because the MacCamy-Fuchs diffraction solution is based on linear potential-flow +theory, second-order contributions to the fluid acceleration are neglected when +computing the wave load even if second-order wave kinematics are enabled in SeaState. +However, the MacCamy-Fuchs diffraction model can be used in conjunction with any of +the available wave-stretching models. + .. _hd-members: Members @@ -835,17 +770,26 @@ specify the ending cross-section properties, allowing for tapered members. **MDivSize** determines the maximum spacing (in meters) between simulation nodes where the distributed loads are actually computed; the smaller the number, the finer the resolution and longer the -computational time. -Each member in your model will have hydrodynamic coefficients, which are -specified using one of the three models (**MCoefMod**). Model 1 uses a -single set of coefficients found in the SIMPLE HYDRODYNAMIC COEFFICIENTS -section. Model 2 is depth-based, and is determined via the table found +computational time. Each member in your model will have hydrodynamic +coefficients, which are specified using one of the three models (**MCoefMod**). +Model 1 uses a single set of coefficients found in the SIMPLE HYDRODYNAMIC +COEFFICIENTS section. Model 2 is depth-based, and is determined via the table found in the DEPTH-BASED HYDRODYNAMIC COEFFICIENTS section. Model 3 specifies coefficients for a particular member, by referring to the MEMBER-BASED -HYDRODYNAMIC COEFFICIENTS section. The **PropPot** flag indicates -whether the corresponding member coincides with the body represented by -the potential-flow solution. When **PropPot** = TRUE, only viscous-drag -loads, and ballasting loads will be computed for that member. +HYDRODYNAMIC COEFFICIENTS section. The **MHstLMod** switch controls the +computation of hydrostatic loads on strip-theory members when **PropPot** += FALSE. Setting **MHstLMod** to 0 disables hydrostatic load. If set to 1, +hydrostatic loads will be computed analytically. This approach is efficient, +but it only works for fully submerged or surface-piercing members +that are far from horizontal without partially wetted endplates. +For nearly horizontal members close to the free surface or members that experience +partially wetted endplates, a semi-numerical approach for hydrostatic load +can be selected by setting **MHstLMod** to 2. This approach works with any +member positioning in relation to the free surface at the cost of slightly +longer computing time. The **PropPot** flag indicates whether the corresponding +member coincides with the body represented by the potential-flow solution. +When **PropPot** = TRUE, only viscous-drag loads and ballasting loads will +be computed for that member. .. TODO 7.5.2 is the theory section which does not yet exist. .. Section 7.5.2 discusses the difference between the user-supplied discretization and the simulation discretization. @@ -932,7 +876,7 @@ Output Specifying **HDSum** = TRUE causes HydroDyn to generate a summary file with name **OutRootname**\ *.HD.sum*. **OutRootName** is either specified in the HYDRODYN section of the driver input file when running -HydroDyn standalone, or by the FAST program when running a coupled +HydroDyn standalone, or by the OpenFAST program when running a coupled simulation. See :numref:`hd-summary-file` for summary file details. For this version, **OutAll** must be set to FALSE. In future versions, @@ -941,7 +885,7 @@ for every joint and member in the input file. If **OutSwtch** is set to 1, outputs are sent to a file with the name ``OutRootname.HD.out``. If **OutSwtch** is set to 2, outputs are -sent to the calling program (FAST) for writing. If **OutSwtch** is set +sent to the calling program (OpenFAST) for writing. If **OutSwtch** is set to 3, both file outputs occur. In standalone mode, setting **OutSwitch** to 2 results in no output file being produced. diff --git a/docs/source/user/hydrodyn/output_files.rst b/docs/source/user/hydrodyn/output_files.rst index 0e692b3f1d..c3212f62c9 100644 --- a/docs/source/user/hydrodyn/output_files.rst +++ b/docs/source/user/hydrodyn/output_files.rst @@ -2,9 +2,9 @@ Output Files ============ -HydroDyn produces four types of output files: an echo file, a -wave-elevations file, a summary file, and a time-series results file. -The following sections detail the purpose and contents of these files. +HydroDyn produces three types of output files: an echo file, a summary +file, and a time-series file. The following sections detail the +purpose and contents of these files. Echo Files ~~~~~~~~~~ @@ -13,28 +13,12 @@ HydroDyn primary input file, the contents of those files will be echoed to a file with the naming conventions, **OutRootName**\ *.dvr.ech* for the driver input file and **OutRootName**\ *.HD.ech* for the HydroDyn primary input file. **OutRootName** is either specified in the HYDRODYN -section of the driver input file, or by the FAST program. The echo files +section of the driver input file, or by the OpenFAST program. The echo files are helpful for debugging your input files. The contents of an echo file will be truncated if HydroDyn encounters an error while parsing an input file. The error usually corresponds to the line after the last successfully echoed line. -Wave-Elevations File -~~~~~~~~~~~~~~~~~~~~ -Setting **WaveElevSeriesFlag** in the driver file to TRUE enables the -outputting of a grid of wave elevations to a text-based file with the -name ``OutRootName.WaveElev.out``. The grid consists of -**WaveElevNX** by **WaveElevNY** wave elevations (centered at *X* = 0, -*Y* = 0) with a **dX** and **dY** spacing in the global inertial-frame -coordinate system. These wave elevations are distinct and output -separately from the wave elevations determined by **NWaveElev** in the -HydroDyn primary input file, such that the total number of wave -elevation outputs is **NWaveElev** + ( **WaveElevNX** × **WaveElevNY** -). The wave-elevation output file ``OutRootName.WaveElev.out`` -contains the total wave elevation, which is the sum of the first- and -second-order terms (when the second-order wave kinematics are optionally -enabled). - .. _hd-summary-file: Summary File @@ -43,35 +27,35 @@ HydroDyn generates a summary file with the naming convention, **OutRootName**\ *.HD.sum* if the **HDSum** parameter is set to TRUE. This file summarizes key information about your hydrodynamics model, including buoyancy, substructure volumes, marine growth weight, the -simulation mesh and its properties, first-order wave frequency -components, and the radiation kernel. +simulation mesh and its properties, and the radiation kernel for +potential-flow bodies. When the text refers to an index, it is referring to a given row in a table. The indexing starts at 1 and increases consecutively down the rows. -WAMIT-model volume and buoyancy information +WAMIT-Model Volume and Buoyancy Information ------------------------------------------- -This section summarizes the buoyancy of the potential-flow-model -platform in its undisplaced configuration. For a hybrid -potential-flow/strip-theory model, these buoyancy values must be added -to any strip-theory member buoyancy reported in the subsequent sections -to obtain the total buoyancy of the platform. +This section summarizes the buoyancy of each potential-flow body in +its undisplaced position. For a hybrid potential-flow/strip-theory +model, these buoyancy values must be added to any strip-theory member +buoyancy reported in the subsequent sections to obtain the total +buoyancy of the platform. -Substructure Volume Calculations +Strip-Theory Volume Calculations -------------------------------- -This section contains a summary of the total substructure volume, the +This section contains a summary of the combined total volume, submerged volume, volume of any marine growth, and fluid-filled -(flooded/ballasted) volume for the substructure in its undisplaced -configuration. Except for the fluid-filled volume value, the reported +(flooded/ballasted) volume of all strip-theory members in their undisplaced +positions. Except for the fluid-filled volume value, the reported volumes are only for members that have the **PropPot** flag set to FALSE. The flooded/ballasted volume applies to any fluid-filled member, regardless of its **PropPot** flag. -Integrated Buoyancy Loads +Total Buoyancy Loads ------------------------- This section details the buoyancy loads of the undisplaced substructure -when summed about the WRP (0,0,0). The external buoyancy includes the +when summed about (0,0,0). The external buoyancy includes the effects of marine growth, and only applies to members whose **PropPot** flag is set to FALSE. The internal buoyancy is the negative effect on buoyancy due to flooding or ballasting and is independent of the @@ -80,64 +64,58 @@ buoyancy due to flooding or ballasting and is independent of the Integrated Marine Growth Weights -------------------------------- This section details the marine growth weight loads of the undisplaced -substructure when summed about the WRP (0,0,0). - -Simulation Node Table ---------------------- -This table details the undisplaced nodal information and properties for -all internal analysis nodes used by the HydroDyn model. The node index -is provided in the first column. The second column maps the node to the -input joint index (not to be confused with the **JointID**). If a value -of -1 is found in this column, the node is an interior node and results -from an input member being split somewhere along its length due to the -requirements of the **MDivSize** parameter in the primary input file -members table. -The third column indicates if this node is part of a Super -Member (**JointOvrlp** = 1). The next column tells you the corresponding -input member index (not to be confused with the **MemberID**). **Nxi**, -**Nyi**, and **Nzi**, provide the (*X*,\ *Y*,\ *Z*) coordinates in the -global inertial-frame coordinate system. **InpMbrDist** provides the -normalized distance to the node from the start of the input member. -**R** is the outer radius of the member at the node (excluding marine -growth), and **t** is the member wall thickness at the node. **dRdZ** is -the taper of the member at the node, **tMG** is the marine growth -thickness, and **MGDens** is the marine growth density. **PropPot** -indicates whether the element attached to this node is modeled using -potential-flow theory. If **FilledFlag** is TRUE, then **FillDens** -gives the filled fluid density and **FillFSLoc** indicates the -free-surface height (*Z*-coordinate). **Cd**, **Ca**, **Cp**, **AxCa**, -**AxCp**, **JAxCd**, **JAxCa**, and **JAxCp** are the viscous-drag, -added-mass, dynamic-pressure, axial added-mass, axial dynamic-pressure, -end-effect axial viscous-drag, end-effect axial added-mass, and -end-effect axial dynamic-pressure coefficients, respectively. **NConn** -gives the number of elements connected to node, and **Connection List** -is the list of element indexes attached to the node. +substructure when summed about (0,0,0). + +Strip-Theory Node Table +----------------------- +This table details the undisplaced strip-theory nodal information and properties for +all user defined joints and internal analysis nodes generated by HydroDyn. +The internal nodes are generated by splitting input members somewhere +along its length to meet the requirements of the **MDivSize** parameter in +the primary input file member table. The node index is provided in the +first column. The second column provides the input member index (not to be +confused with the **MemberID**) each internal node belongs to. +User-defined joints do not necessarily belong to a specific member, so no +information is provided on this column for these joints. **Nxi**, **Nyi**, and **Nzi** +provide the (*X*,\ *Y*,\ *Z*) coordinates in the global inertial-frame +coordinate system. **R** is the outer radius of the member at the node +(excluding marine growth), and **t** is the member wall thickness at the node. +**tMG** is the marine growth thickness, and **MGDens** is the marine growth +density. **PropPot** indicates whether the element attached to this node +is modeled using potential-flow theory. If **FilledFlag** is TRUE, then **FillMass** +gives the filled fluid mass assigned to the node. **Cd**, **Ca**, **Cp**, **Cb**, **AxCd**, **AxCa**, +**AxCp**, **JAxCd**, **JAxCa**, and **JAxCp** are the transverse drag, +transverse added-mass, transverse dynamic-pressure, buoyancy-scaling, axial drag, axial added-mass, +axial dynamic-pressure, endplate axial drag, endplate axial added-mass, and +endplate axial dynamic-pressure coefficients, respectively. Note that some of the columns +are only populated for user-defined joints, while other columns are only populated +for internal analysis nodes belonging to a single member. .. TODO 7.5.2 is the theory section which does not yet exist. .. See Section 7.5.2 for the member splitting rules used by HydroDyn. -Simulation Element Table ------------------------- -This section details the undisplaced simulation elements and their +Strip-Theory Member Table +------------------------- +This section details the undisplaced strip-theory members and their associated properties. A suffix of 1 or 2 in a column heading refers to -the element’s starting or ending node, respectively. The first column is -the element index. **node1** and **node2** refer to the node index found -in the node table of the previous section. Next are the element -**Length** and exterior **Volume**. This exterior volume calculation -includes any effects of marine growth. **MGVolume** provides the volume -contribution due to marine growth. The cross-sectional properties of -outer radius (excluding marine growth), marine growth thickness, and -wall thickness for each node are given by **R1**, **tMG1**, **t1**, -**R2**, **tMG2**, and **t2**, respectively. **MGDens1** and **MGDens2** -are the marine growth density at node 1 and 2. **PropPot** indicates if -the element is modeled using potential-flow theory. If the element is +the starting or ending node of the member, respectively. The first column is +the member index. **joint1** and **joint2** refer to the node index found +in the node table of the previous section. Next are the member +**Length**, the number of subdivided elements **NElem** to meet the +**MDivSize** requirement, and the exterior **Volume**. This exterior volume +calculation includes any marine growth volume on the member. **MGVolume** provides the volume +contribution due to marine growth. **Volume** and **MGVolume** will be zeros +for members modeled by potential flow, i.e., with **PropPot** = T for TRUE. +The cross-sectional properties of outer radius (including marine growth) and wall thickness for each +node are given by **R1**, **t1**, **R2**, and **t2**, respectively. **PropPot** indicates if +the member is modeled using potential-flow theory. If the element is fluid-filled (has flooding or ballasting), **FilledFlag** is set to -**T** for TRUE. **FillDensity** and **FillFSLoc** are the filled fluid -density and the free-surface location’s *Z*-coordinate in the global -inertial-frame coordinate system. **FillMass** is calculated by +T for TRUE. **FillDensity** and **FillFSLoc** are the filled fluid +density and the free-surface location (*Z*-coordinate in the global +inertial-frame coordinate system). **FillMass** is calculated by multiplying the **FillDensity** value by the element’s interior volume. -Finally, the element hydrodynamic coefficients are listed. These are the -same coefficients listed in the node table (above). +Finally, the hydrodynamic coefficients at the two end joints are listed. +These are the same coefficients listed in the node table (above). Summary of User-Requested Outputs --------------------------------- @@ -146,73 +124,57 @@ joint output channels. Member Outputs ++++++++++++++ -The first column lists the data channel’s string label, as entered in +The first column lists the string labels of the data channels, as entered in the OUTPUT CHANNELS section of the HydroDyn input file. **Xi**, **Yi**, -**Zi**, provide the output’s undisplaced spatial location in the global -inertial-frame coordinate system. The next column, **InpMbrIndx**, tells -you the corresponding input member index (not to be confused with the -**MemberID**). Next are the coordinates of the starting (**StartXi**, -**StartYi**, **StartZi**) and ending (**EndXi**, **EndYi**, **EndZi**) -nodes of the element containing this output location. **Loc** is the -normalized distance from the starting node of this element. +and **Zi** provide the coordinates of the output location in the global +inertial-frame system when the structure is not displaced. The next column, +**MemberID**, tells you the corresponding input member index. Next are +the coordinates of the starting (**StartXi**, **StartYi**, **StartZi**) +and ending (**EndXi**, **EndYi**, **EndZi**) nodes of the member containing +this output location. **Loc** is the normalized distance from the starting +node of this member. Joint Outputs +++++++++++++ -The first column lists the data channel’s string label, as entered in +The first column lists the string labels of the data channels, as entered in the OUTPUT CHANNELS section of the HydroDyn input file. **Xi**, **Yi**, -**Zi**, provide the output’s undisplaced spatial location in the global -inertial-frame coordinate system. **InpJointID** specifies the -**JointID** for the output as given in the MEMBER JOINTS table of the -HydroDyn input file. - -The Wave Number and Complex Values of the Wave Elevations as a Function of Frequency ------------------------------------------------------------------------------------- -This section provides the frequency-domain description (in terms of a -Discrete Fourier Transform or DFT) of the first-order wave elevation at -(0,0) on the free surface, but is not written when **WaveMod** = 0 or 6. -The first column, **m**, identifies the index of each wave frequency -component. The finite-depth wave number, frequency, and direction of the -wave component are given by **k**, **Omega**, and **Direction**, -respectively. The last two columns provide the real -(**REAL(DFT{WaveElev})**) and imaginary (**IMAG(DFT{WaveElev})**) -components of the DFT of the first-order wave elevation. The DFT -produces includes both the negative- and positive-frequency components. -The negative-frequency components are complex conjugates of the positive -frequency components because the time-domain wave elevation is -real-valued. The relationships between the negative- and -positive-frequency components of the DFT are given by -:math:`k\left( - \omega \right) = - k\left( \omega \right)` and -:math:`H\left( - \omega \right) = {H\left( \omega \right)}^{*}`, where -*H* is the DFT of the wave elevation and *\** denotes the complex -conjugate. +and **Zi** provide the coordinates of the output joint in the global +inertial-frame system when the structure is not displaced. **InpJointID** +specifies the **JointID** for the output as given in the MEMBER JOINTS table +of the HydroDyn input file. Radiation Memory Effect Convolution Kernel ------------------------------------------ - In the potential-flow solution based on frequency-to-time-domain transforms, HydroDyn computes the radiation kernel used by the convolution method for calculating the radiation memory effect through -the cosine transform of the 6x6 frequency-dependent hydrodynamic damping +the cosine transform of the frequency-dependent hydrodynamic damping matrix from the radiation problem. The resulting time-domain radiation -kernel (radiation impulse-response function)—which is a 6x6 -time-dependent matrix—is provided in this section. **n** and **t** give -the time-step index and time, which are followed by the elements +kernel (radiation impulse-response function), a time-dependent +matrix, is provided in this section. **n** and **t** give +the time-step index and time, which are followed by the entries of the matrix (**K11**, **K12**, etc.) of the radiation kernel associated with that time. Because the frequency-dependent hydrodynamic damping matrix is symmetric, so is the radiation kernel; thus, only the diagonal and upper-triangular portion of the matrix are provided. The radiation kernel should decay to zero after a short amount of time, which should -aid in selecting an appropriate value of **RdtnTMax**. +aid in selecting an appropriate value of **RdtnTMax**. The dimensions of the +radiation kernel matrix depend on the number of potential-flow bodies +present (**NBody**) and **NBodyMod** in the HydroDyn primary input file. If +**NBodyMod** = 1 (full hydrodynamic coupling), the summary file will contain +data for a single 6\ **NBody**-by-6\ **NBody** matrix. If **NBodyMod** > 1 +(no hydrodynamic coupling), the summary file will contain data for **NBody** +6-by-6 radiation kernal matrices. Results File ~~~~~~~~~~~~ The HydroDyn time-series results are written to a text-based file with the naming convention ``OutRootName.HD.out`` when **OutSwtch** is -set to either 1 or 3. If HydroDyn is coupled to FAST and **OutSwtch** is -set to 2 or 3, then FAST will generate a master results file that +set to either 1 or 3. If HydroDyn is coupled to OpenFAST and **OutSwtch** is +set to 2 or 3, then OpenFAST will generate a master results file that includes the HydroDyn results. The results are in table format, where -each column is a data channel (the first column always being the +each column is a data channel (the first column is always the simulation time), and each row corresponds to a simulation output time step. The data channels are specified in the OUTPUT CHANNELS section of the HydroDyn primary input file. The column format of the diff --git a/docs/source/user/index.rst b/docs/source/user/index.rst index 65a9a4badc..f2d22f797d 100644 --- a/docs/source/user/index.rst +++ b/docs/source/user/index.rst @@ -3,63 +3,39 @@ User Documentation ================== -We are in the process of transitioning legacy FAST v8 documentation, which can be found at https://www.nrel.gov/wind/nwtc.html. - .. note:: + We are in the process of transitioning legacy FAST v8 documentation to this online documentation. The legacy FAST v8 documentation can be found at https://www.nrel.gov/wind/nwtc.html. - Much of the documentation here is legacy documentation from FAST v8. While most of it is still - directly applicable to OpenFAST, portions may be out of date. +This section contains documentation for the OpenFAST module-coupling environment and its underlying modules. Documentation covers usage of models, underlying theory, and in some cases module verification. -.. _general-reference-docs: - -General -~~~~~~~ -.. toctree:: - :maxdepth: 1 - - fast_to_openfast.rst - api_change.rst - input_file_overview.rst - -Workshop material, legacy documentation, and other resources are listed below. - -- `Overview of OpenFAST at NAWEA WindTech 2022 `_ -- `Practical Guide to OpenFAST at NAWEA WindTech 2022 `_ -- `Overview of OpenFAST at NAWEA WindTech 2019 `_ -- `Workshop Presentations `_ -- :download:`Old FAST v6 User's Guide <../../OtherSupporting/Old_FAST6_UsersGuide.pdf>` -- :download:`FAST v8 README <../../OtherSupporting/FAST8_README.pdf>` -- `Implementation of Substructure Flexibility and Member-Level Load Capabilities for Floating Offshore Wind Turbines in OpenFAST `_ -- `FAST modularization framework for wind turbine simulation: full-system linearization `_ -- `Full-System Linearization for Floating Offshore Wind Turbines in OpenFAST `_ -- :download:`FAST with Labview <../../OtherSupporting/UsingFAST4Labview.pdf>` -- :download:`OutListParameters.xlsx <../../OtherSupporting/OutListParameters.xlsx>` - Contains the full list of outputs for each module. - - -Module Documentation -~~~~~~~~~~~~~~~~~~~~ -This section contains documentation for the OpenFAST module-coupling environment and its underlying modules. -Documentation covers usage of models, underlying theory, and in some cases module verification. .. toctree:: :maxdepth: 1 + General considerations AeroDyn OLAF Aeroacoustics + AeroDisk BeamDyn SubDyn ExtPtfm ElastoDyn HydroDyn + SeaState InflowWind MoorDyn ServoDyn + Simplified ElastoDyn Structural Control TurbSim - C++ API FAST.Farm + C++ API + + +Additional module documentation +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The following modules do not currently have formal documentation or are contributed to OpenFAST from organizations @@ -78,10 +54,6 @@ with the information for the new documentation. - :download:`Theory Manual <../../OtherSupporting/FEAMooring/FEAM_Theory_Manual.pdf>` - :download:`User's Guide <../../OtherSupporting/FEAMooring/FEAM_Users_Guide.pdf>` -- MoorDyn - - - `Official User's Guide `_ - - OrcaFlex Interface: - :download:`User's Guide <../../OtherSupporting/OrcaFlex/User_Guide_OrcaFlexInterface.pdf>` @@ -94,32 +66,7 @@ with the information for the new documentation. - :download:`Draft: FAST Ice Module Manual <../../OtherSupporting/IceDyn/IceDyn_Manual.pdf>` -- TurbSim - - - :download:`User's Guide <../../OtherSupporting/TurbSim/TurbSim_v2.00.pdf>` - -Modularization Framework -~~~~~~~~~~~~~~~~~~~~~~~~ - -Information specific to the modularization framework of OpenFAST is provided here. These are a collection -of publications, presentations, and past studies on the subject. - -- `The New Modularization Framework for the FAST Wind Turbine CAE Tool `_ -- :download:`Example Module Implementation Plans <../../OtherSupporting/ModulePlan_GasmiPaperExamples.doc>` -- :download:`Module and Mesh-Mapping Linearization Implementation Plan <../../OtherSupporting/LinearizationOfMeshMapping_Rev18_Rev2.doc>` -- :download:`Interpolation of DCMs <../../OtherSupporting/DCM_Interpolation/DCM_Interpolation.pdf>` - A summary of the mathematics used in the interpolation of DCM (direction cosine matrices) using logarithmic mapping and matrix exponentials. -- :download:`Set-point Linearization Development Plan <../../OtherSupporting/DevelopmentPlan-SetPoint-Linearization.pdf>` - -.. - :download:`OpenFAST Steady State Solution <../../OtherSupporting/OpenFASTSteadyStateSolution_Rev7.doc>` - - -Glue Code and Mesh Mapping -~~~~~~~~~~~~~~~~~~~~~~~~~~ -- `FAST Modular Wind Turbine CAE Tool: Nonmatching Spatial and Temporal Meshes `_ -- `FAST Modular Framework for Wind Turbine Simulation: New Algorithms and Numerical Examples `_ -- :download:`OpenFAST Algorithms <../../OtherSupporting/OpenFAST_Algorithms/OpenFAST_Algorithms.pdf>` - A summary of the solve method used in the glue code. -- :download:`Predictor-Corrector Approach <../../OtherSupporting/ProposedPCApproach_Rev4.docx>` NWTC Subroutine Library diff --git a/docs/source/user/inflowwind/driver.rst b/docs/source/user/inflowwind/driver.rst index c4a92c4873..901b17648a 100644 --- a/docs/source/user/inflowwind/driver.rst +++ b/docs/source/user/inflowwind/driver.rst @@ -166,7 +166,7 @@ Purpose When InflowWind is coupled to OpenFAST, wind points corresponding to the free vortex wake module (OLAF) in AeroDyn 15 and LidarSim module may be outside the full-field wind data. No other wind data points may be outside the grid -(AeroDyn15 blades must be within the wind box). The wake from OLAF may over +(AeroDyn blades must be within the wind box). The wake from OLAF may over time stray outside the full-field wind box, in which case it should be sufficiently far from the turbine that any inacuracies in the reported wind value should have little to no effect on the turbine. The method employed here diff --git a/docs/source/user/inflowwind/examples/inflowwind_driver_example.inp b/docs/source/user/inflowwind/examples/inflowwind_driver_example.inp index ada6a15427..6f10820ae7 100644 --- a/docs/source/user/inflowwind/examples/inflowwind_driver_example.inp +++ b/docs/source/user/inflowwind/examples/inflowwind_driver_example.inp @@ -24,4 +24,11 @@ InflowWind driver input file. 6,0,15 GridCtrCoord -- coordinate of center of grid (m) 1,1,0 GridDx,GridDY,GridDZ -- Step size of grid (m) 1,1,0 GridNx,GridNY,GridNZ -- number of grid points in X, Y and Z directions (-) +---- Output VTK slices ------------------------------------------------------ + 0 NOutWindXY -- Number of XY planes for output .XY.t.vtk (-) [0 to 9] + 90 OutWindZ -- Z coordinates of XY planes for output (m) [1 to NOutWindXY] [unused for NOutWindXY=0] + 0 NOutWindXZ -- Number of XZ planes for output .YZ.t.vtk (-) [0 to 9] + 0 OutWindY -- Y coordinates of XZ planes for output (m) [1 to NOutWindXZ] [unused for NOutWindXZ=0] + 0 NOutWindYZ -- Number of YZ planes for output .YZ.t.vtk (-) [0 to 9] + 0 OutWindX -- X coordinates of YZ planes for output (m) [1 to NOutWindYZ] [unused for NOutWindYZ=0] END of driver input file diff --git a/docs/source/user/input_file_overview.rst b/docs/source/user/input_file_overview.rst index 8bcdd63417..1474c54718 100644 --- a/docs/source/user/input_file_overview.rst +++ b/docs/source/user/input_file_overview.rst @@ -80,7 +80,7 @@ modules use the *value column* format): ============== ========================================================== Module Input file ============== ========================================================== -AeroDyn Main AD15 input file +AeroDyn Main AeroDyn input file AeroDyn Airfoil files HydroDyn Main HD input file InflowWind Main IfW input file diff --git a/docs/source/user/moordyn/index.rst b/docs/source/user/moordyn/index.rst index 9306aeaa96..140df93874 100644 --- a/docs/source/user/moordyn/index.rst +++ b/docs/source/user/moordyn/index.rst @@ -11,3 +11,7 @@ usage of MoorDyn at the FAST.Farm level (`MoorDyn with FAST.Farm `_), and links to publications with the relevant theory. + +The user guide can be downloaded below. + +`Official User's Guide `_ diff --git a/docs/source/user/seastate/appendix.rst b/docs/source/user/seastate/appendix.rst new file mode 100644 index 0000000000..27e93d3da1 --- /dev/null +++ b/docs/source/user/seastate/appendix.rst @@ -0,0 +1,140 @@ + +.. _ss-primary-input_example: + +Appendix A: Example SeaState primary input file +=============================================== + +The following is a SeaState primary input file generating irregular (JONSWAP) waves internally +structure:: + + ------- SeaState v1.00.* Input File -------------------------------------------- + Example SeaState primary input file + False Echo - Echo the input file data (flag) + ---------------------- ENVIRONMENTAL CONDITIONS -------------------------------- + "default" WtrDens - Water density (kg/m^3) + "default" WtrDpth - Water depth (meters) relative to MSL + "default" MSL2SWL - Offset between still-water level and mean sea level (meters) [positive upward; unused when WaveMod = 6; must be zero if PotMod=1 or 2] + ---------------------- SPATIAL DISCRETIZATION --------------------------------------------------- + 30.0 X_HalfWidth – Half-width of the domain in the X direction (m) [>0, NOTE: X[nX] = nX*dX, where nX = {-NX+1,-NX+2,…,NX-1} and dX = X_HalfWidth/(NX-1)] + 30.0 Y_HalfWidth – Half-width of the domain in the Y direction (m) [>0, NOTE: Y[nY] = nY*dY, where nY = {-NY+1,-NY+2,…,NY-1} and dY = Y_HalfWidth/(NY-1)] + 25.0 Z_Depth – Depth of the domain the Z direction (m) relative to SWL [0 < Z_Depth <= WtrDpth+MSL2SWL; "default": Z_Depth = WtrDpth+MSL2SWL; Z[nZ] = ( COS( nZ*dthetaZ ) – 1 )*Z_Depth, where nZ = {0,1,…NZ-1} and dthetaZ = pi/( 2*(NZ-1) )] + 10 NX – Number of nodes in half of the X-direction domain (-) [>=2] + 10 NY – Number of nodes in half of the Y-direction domain (-) [>=2] + 10 NZ – Number of nodes in the Z direction (-) [>=2] + ---------------------- WAVES --------------------------------------------------- + 2 WaveMod - Incident wave kinematics model {0: none=still water, 1: regular (periodic), 1P#: regular with user-specified phase, 2: JONSWAP/Pierson-Moskowitz spectrum (irregular), 3: White noise spectrum (irregular), 4: user-defined spectrum from routine UserWaveSpctrm (irregular), 5: Externally generated wave-elevation time series, 6: Externally generated full wave-kinematics time series [option 6 is invalid for PotMod/=0], 7: User-defined wave frequency components} (switch) + 1 WaveStMod - Model for stretching incident wave kinematics to instantaneous free surface {0: none=no stretching, 1: vertical stretching, 2: extrapolation stretching, 3: Wheeler stretching} (switch) [unused when WaveMod=0 or when PotMod/=0] + 600 WaveTMax - Analysis time for incident wave calculations (sec) [unused when WaveMod=0; determines WaveDOmega=2Pi/WaveTMax in the IFFT] + 0.2 WaveDT - Time step for incident wave calculations (sec) [unused when WaveMod=0 or 7; 0.1<=WaveDT<=1.0 recommended; determines WaveOmegaMax=Pi/WaveDT in the IFFT] + 2.0 WaveHs - Significant wave height of incident waves (meters) [used only when WaveMod=1, 2, or 3] + 10 WaveTp - Peak-spectral period of incident waves (sec) [used only when WaveMod=1 or 2] + "DEFAULT" WavePkShp - Peak-shape parameter of incident wave spectrum (-) or DEFAULT (string) [used only when WaveMod=2; use 1.0 for Pierson-Moskowitz] + 0.314159 WvLowCOff - Low cut-off frequency or lower frequency limit of the wave spectrum beyond which the wave spectrum is zeroed (rad/s) [unused when WaveMod=0, 1, or 6] + 1.570796 WvHiCOff - High cut-off frequency or upper frequency limit of the wave spectrum beyond which the wave spectrum is zeroed (rad/s) [unused when WaveMod=0, 1, or 6] + 0 WaveDir - Incident wave propagation heading direction (degrees) [unused when WaveMod=0 or 6] + 0 WaveDirMod - Directional spreading function {0: none, 1: COS2S} (-) [only used when WaveMod=2,3, or 4] + 1 WaveDirSpread - Wave direction spreading coefficient ( > 0 ) (-) [only used when WaveMod=2,3, or 4 and WaveDirMod=1] + 1 WaveNDir - Number of wave directions (-) [only used when WaveMod=2,3, or 4 and WaveDirMod=1; odd number only] + 0 WaveDirRange - Range of wave directions (full range: WaveDir +/- 1/2*WaveDirRange) (degrees) [only used when WaveMod=2,3,or 4 and WaveDirMod=1] + 123456789 WaveSeed(1) - First random seed of incident waves [-2147483648 to 2147483647] (-) [unused when WaveMod=0, 5, or 6] + RANLUX WaveSeed(2) - Second random seed of incident waves [-2147483648 to 2147483647] for intrinsic pRNG, or an alternative pRNG: "RanLux" (-) [unused when WaveMod=0, 5, or 6] + FALSE WaveNDAmp - Flag for normally distributed amplitudes (flag) [only used when WaveMod=2, 3, or 4] + "unused" WvKinFile - Root name of externally generated wave data file(s) (quoted string) [used only when WaveMod=5 or 6] + ---------------------- 2ND-ORDER WAVES ----------------------------------------- [unused with WaveMod=0 or 6] + FALSE WvDiffQTF - Full difference-frequency 2nd-order wave kinematics (flag) + FALSE WvSumQTF - Full summation-frequency 2nd-order wave kinematics (flag) + 0 WvLowCOffD - Low frequency cutoff used in the difference-frequencies (rad/s) [Only used with a difference-frequency method] + 1.256637 WvHiCOffD - High frequency cutoff used in the difference-frequencies (rad/s) [Only used with a difference-frequency method] + 0.618319 WvLowCOffS - Low frequency cutoff used in the summation-frequencies (rad/s) [Only used with a summation-frequency method] + 3.141593 WvHiCOffS - High frequency cutoff used in the summation-frequencies (rad/s) [Only used with a summation-frequency method] + ---------------------- CONSTRAINED WAVES --------------------------------------- + 0 ConstWaveMod - Constrained wave model: 0=none; 1=Constrained wave with specified crest elevation, alpha; 2=Constrained wave with guaranteed peak-to-trough crest height, HCrest (flag) + 3 CrestHmax - Crest height (2*alpha for ConstWaveMod=1 or HCrest for ConstWaveMod=2), must be larger than WaveHs (m) [unused when ConstWaveMod=0] + 60 CrestTime - Time at which the crest appears (s) [unused when ConstWaveMod=0] + 0 CrestXi - X-position of the crest (m) [unused when ConstWaveMod=0] + 0 CrestYi - Y-position of the crest (m) [unused when ConstWaveMod=0] + ---------------------- CURRENT ------------------------------------------------- [unused with WaveMod=6] + 0 CurrMod - Current profile model {0: none=no current, 1: standard, 2: user-defined from routine UserCurrent} (switch) + 0 CurrSSV0 - Sub-surface current velocity at still water level (m/s) [used only when CurrMod=1] + "DEFAULT" CurrSSDir - Sub-surface current heading direction (degrees) or DEFAULT (string) [used only when CurrMod=1] + 20 CurrNSRef - Near-surface current reference depth (meters) [used only when CurrMod=1] + 0 CurrNSV0 - Near-surface current velocity at still water level (m/s) [used only when CurrMod=1] + 0 CurrNSDir - Near-surface current heading direction (degrees) [used only when CurrMod=1] + 0 CurrDIV - Depth-independent current velocity (m/s) [used only when CurrMod=1] + 0 CurrDIDir - Depth-independent current heading direction (degrees) [used only when CurrMod=1] + ---------------------- MacCamy-Fuchs diffraction model ------------------------- + 0 MCFD - MacCamy-Fuchs member radius (ignored if radius <= 0) [must be 0 when WaveMod 0 or 6] + ---------------------- OUTPUT -------------------------------------------------- + False SeaStSum - Output a summary file [flag] + 3 OutSwtch - Output requested channels to: [1=SeaState.out, 2=GlueCode.out, 3=both files] + "E15.7e2" OutFmt - Output format for numerical results (quoted string) [not checked for validity!] + "A15" OutSFmt - Output format for header strings (quoted string) [not checked for validity!] + 2 NWaveElev - Number of points where the incident wave elevations can be computed (-) [maximum of 9 output locations] + 0.0, 5.0 WaveElevxi - List of xi-coordinates for points where the incident wave elevations can be output (meters) [NWaveElev points, separated by commas or white space; usused if NWaveElev = 0] + 0.0, 0.0 WaveElevyi - List of yi-coordinates for points where the incident wave elevations can be output (meters) [NWaveElev points, separated by commas or white space; usused if NWaveElev = 0] + 2 NWaveKin - Number of points where the wave kinematics can be output (-) [maximum of 9 output locations] + 0.0, 0.0 WaveKinxi - List of xi-coordinates for points where the wave kinematics can be output (meters) [NWaveKin points, separated by commas or white space; usused if NWaveKin = 0] + 0.0, 5.0 WaveKinyi - List of yi-coordinates for points where the wave kinematics can be output (meters) [NWaveKin points, separated by commas or white space; usused if NWaveKin = 0] + -14.0, -17.0 WaveKinzi - List of zi-coordinates for points where the wave kinematics can be output (meters) [NWaveKin points, separated by commas or white space; usused if NWaveKin = 0] + ---------------------- OUTPUT CHANNELS ----------------------------------------- + "Wave1Elev, Wave1Elv1, Wave1Elv2" - Wave elevation + "Wave2Elev, Wave2Elv1, Wave2Elv2" + "FVel1xi, FVel1yi, FVel1zi" - fluid velocity at location 1 + "FAcc1xi, FAcc1yi, FAcc1zi" - fluid accelerations at location 1 + "FDynP1" - fluid dynamic pressure at location 1 + "FVel2xi, FVel2yi, FVel2zi" - fluid velocity at location 2 + "FAcc2xi, FAcc2yi, FAcc2zi" - fluid accelerations at location 2 + "FDynP2" + END + +Appendix B: Example SeaState driver input file +============================================== +The following is a SeaState driver input file +structure:: + + Seastate driver file + Compatible with SeaState v1.00 + FALSE Echo - Echo the input file data (flag) + ---------------------- ENVIRONMENTAL CONDITIONS ------------------------------- + 9.80665 Gravity - Gravity (m/s^2) + 1025 WtrDens - Water density (kg/m^3) + 200 WtrDpth - Water depth (m) + 0 MSL2SWL - Offset between still-water level and mean sea level (m) [positive upward] + ---------------------- SEASTATE ----------------------------------------------- + "./seastate_input.dat" SeaStateInputFile - Primary SeaState input file name (quoted string) + "./seastate.SeaSt" OutRootName - The name which prefixes all SeaState generated files (quoted string) + 0 WrWvKinMod - Write wave kinematics? [0: Do not write any kinematics to file, 1: Write only the (0,0) wave elevations to file, 2: Write the complete wave kinematics to files, no files written if WaveMod=6] + 5001 NSteps - Number of time steps in the simulations (-) + 0.1 TimeInterval - Time step for the simulation (sec) + ---------------------- Waves multipoint elevation output ---------------------- + False WaveElevSeriesFlag - T/F flag to output the wave elevation field (for movies) + END of driver input file + +.. _sea-output-channels: + +Appendix C. List of Output Channels +=================================== + +This is a list of all possible output channels for the SeaState module. +The names are grouped by meaning, but can be ordered in the OUTPUT +CHANNELS section of the primary SeaState input file as you see fit. +α refers to the output position for either wave elevation or wave +kinematics specified in the OUTPUT section of the primary SeaState input +file, where α is a number in the range [1,NWaveElev] for wave elevation +outputs and in the range [1,NWaveKin] for wave kinematics outputs. +Setting α > NWaveElev or α > NWaveKin yields invalid output. All outputs +are in the global inertial-frame coordinate system. + +================================================================ ========================================================================================================== ========================================================================================== +Channel Name(s) Units Description +================================================================ ========================================================================================================== ========================================================================================== +**Wave Elevation** +WaveαElev (m) Total (first- plus second-order) wave elevations (up to 9 designated locations) +WaveαElv1 (m) First-order wave elevations (up to 9 designated locations) +WaveαElv2 (m) Second-order wave elevations (up to 9 designated locations) +**Wave and Current Kinematics** +FVelαxi, FVelαyi, FVelαzi (m/s), (m/s), (m/s) Total (first- plus second-order waves and current) fluid velocities at α +FAccαxi, FAccαyi, FAccαzi (m/s\ :sup:`2`), (m/s\ :sup:`2`), (m/s\ :sup:`2`) Total (first- plus second-order waves) fluid accelerations at α +FDynPα (Pa) Total (first- plus second-order waves) fluid dynamic pressure at α +FAccMCFαxi, FAccMCFαyi, FAccMCFαzi (m/s\ :sup:`2`), (m/s\ :sup:`2`), (m/s\ :sup:`2`) Scaled first-order-wave fluid accelerations for the MacCamy-Fuchs members in HydroDyn at α +================================================================ ========================================================================================================== ========================================================================================== diff --git a/docs/source/user/hydrodyn/figs/current_sub_models.jpg b/docs/source/user/seastate/figs/current_sub_models.jpg similarity index 100% rename from docs/source/user/hydrodyn/figs/current_sub_models.jpg rename to docs/source/user/seastate/figs/current_sub_models.jpg diff --git a/docs/source/user/seastate/index.rst b/docs/source/user/seastate/index.rst new file mode 100644 index 0000000000..1a24d59053 --- /dev/null +++ b/docs/source/user/seastate/index.rst @@ -0,0 +1,15 @@ +.. _SeaSt: + +SeaState User Guide and Theory Manual +===================================== + +.. toctree:: + :maxdepth: 1 + + input_files.rst + output_files.rst + appendix.rst + +SeaState generates wave field information used by HydroDyn. This module had +once been part of HydroDyn, so see the HydroDyn documentation for information on +the waves and current. diff --git a/docs/source/user/seastate/input_files.rst b/docs/source/user/seastate/input_files.rst new file mode 100644 index 0000000000..b7dcc5cf14 --- /dev/null +++ b/docs/source/user/seastate/input_files.rst @@ -0,0 +1,566 @@ +Input Files +=========== + +The user configures the sea state model parameters via a primary SeaState input file. +When used in standalone mode, an additional driver input file is +required. This driver file specifies initialization inputs normally +provided to SeaState by OpenFAST. + +No lines should be added or removed from the input files, except in +tables where the number of rows is specified. + +Units +~~~~~ +SeaState uses the SI system (kg, m, s). + +.. _sea-driver-input: + +SeaState Driver Input File +~~~~~~~~~~~~~~~~~~~~~~~~~~ +The driver input file is only needed for the standalone version of +SeaState and contains inputs normally generated by OpenFAST. It is +necessary to control the sea state conditions for uncoupled models. +An example SeaState driver input file is given in Appendix B. + +Set the **Echo** flag in this file to TRUE if you wish to have +``SeaStateDriver`` echo the contents of the driver input file (useful +for debugging errors in the driver file). The echo file has the naming +convention of ``OutRootName.dvr.ech``. **OutRootName** is specified +in the SEASTATE section of the driver input file. Set the gravity +constant using the **Gravity** parameter. SeaState expects a magnitude, +so in SI units this would be set to 9.80665 :math:`\frac{m}{s^{2}}`. +**WtrDens** specifies the water density and must be a value greater than +or equal to zero; a typical value for seawater is around 1025 +kg/m\ :sup:`3`. **WtrDpth** specifies the water depth (depth of the flat +seabed) relative to the MSL and must be a value greater than +zero. **MSL2SWL** is the offset between the MSL and SWL, positive if SWL +is above MSL. **SeaStateInputFile** is the filename of the primary SeaState +input file. This name should be in quotations and can contain an absolute +path or a relative path. + +**WrWvKinMod** controls the wave kinematics output from the SeaState driver. +Setting it to 0 suppresses driver output of wave kinematics. The driver will +output the wave-elevation time series at the global origin (0,0) in a separate +*.Elev* file if **WrWvKinMod** = 1. This file also serves as a valid +**WvKinFile** for **WaveMod** = 5 (externally generated wave-elevation time series) +in the primary SeaState input file. If **WrWvKinMod** = 2, SeaState will output +the full wave kinematics (velocity, acceleration, dynamic pressure, and wave +elevation) at all wave grid points in eight output files with the extensions +*.Vxi*, *.Vyi*, *.Vzi*, *.Axi*, *.Ayi*, *.Azi*, *.DynP*, and *.Elev*. The velocity +and acceleration outputs are all in the global earth-fixed coordinate system. +These files are also valid as **WvKinFile** for **WaveMod** = 6 (externally +generated full wave-kinematics time series) and can be used as templates if +the users would like to build their own input files for **WaveMod** = 6. +**NSteps** specifies the number of simulation time steps, and **TimeInterval** +specifies the time between steps. **WaveElevSeriesFlag** can be set to TRUE +to output a file with the extension *.WaveElev.out*, which contains the +wave-elevation field at each time step for visualization purposes. Setting +it to FALSE suppresses this output. Note that the grid points for +**WrWvKinMod** = 2 and **WaveElevSeriesFlag** = TRUE are both controlled by +the SPATIAL DISCRETIZATION section of the primary SeaState input file +explained below. + +.. _sea-primary-input: + +SeaState Primary Input File +~~~~~~~~~~~~~~~~~~~~~~~~~~~ +An example SeaState primary input file is given in Appendix A. + +Environmental Conditions +------------------------ +Environmental conditions are now specified in the driver input file but are left in +the primary input file for legacy compatibility. Use the keyword +DEFAULT to pass in values specified by the driver input file. Otherwise, +values given in the primary input file will overwrite those given in the +driver input file. **WtrDens** specifies the water density and must be a value greater than +or equal to zero; a typical value of seawater is around 1025 +kg/m\ :sup:`3`. **WtrDpth** specifies the water depth (depth of the flat +seabed), based on the reference MSL, and must be a value greater than +zero. **MSL2SWL** is the offset between the MSL and SWL, positive +when SWL is above MSL. This parameter is useful when simulating the effect of tides or +storm-surge sea-level variations without having to alter the +substructure geometry information. This parameter is unused with +**WaveMod** = 6 and must be set to zero if you are using a +potential-flow model (**PotMod** = 1 or 2) in HydroDyn. + +Spatial discretization +--------------------------- +The SPATIAL DISCRETIZATION section controls the generation of a wave grid. This wave grid is used primarily by HydroDyn but also by other modules of OpenFAST to compute the hydrodynamic and hydrostatic loads on structures in water. The wave grid is added to allow strip-theory members in HydroDyn to use the wave kinematics and dynamic pressure at the instantaneous displaced position of the structure when evaluating the loads. It also allows the potential-flow wave excitation in HydroDyn to be corrected based on any large drift motion in the horizontal plane, such as that due to high wind thrust. + +Note that in previous versions of OpenFAST, the potential-flow wave excitation and wave field for strip-theory members were precomputed with the structure at the undisplaced position. This mode of operation is no longer present in OpenFAST, and a wave grid must always be defined even if the user chooses not to account for structure displacement when evaluating the strip-theory and/or potential-flow hydrodynamic loads in HydroDyn. + +Currently, the SeaState wave grid is always centered at the global origin and symmetric about the *XZ*-plane and *YZ*-plane. + +**X_HalfWidth** sets (in m) the half width of the wave grid in the global *X*-direction, such that the wave grid covers the region of −\ **X_HalfWidth** ≤ *X* ≤ +\ **X_HalfWidth**. **X_HalfWidth** must be greater than zero. + +**Y_HalfWidth** sets (in m) the half width of the wave grid in the global *Y*-direction, such that the wave grid covers the region of −\ **Y_HalfWidth** ≤ *Y* ≤ +\ **Y_HalfWidth**. **Y_HalfWidth** must be greater than zero. + +**Z_Depth** sets the depth (in m) of the wave grid, such that the wave grid covers the region of (\ **MSL2SWL** − **Z_Depth**\ ) ≤ *Z* ≤ **MSL2SWL**\ . **Z_Depth** must be greater than zero and less than or equal to **MSL2SWL** + **WtrDpth**\ . Setting **Z_Depth** to DEFAULT will automatically set its value to **MSL2SWL** + **WtrDpth**\ . + +**NX** sets the number of uniformly distributed grid points in the *X*-direction over half of the domain, including a point at the origin. Therefore, the total number of grid points in the *X*-direction is equal to 2\ **NX**\ −1. **NX** must be greater than or equal to 2. + +**NY** sets the number of uniformly distributed grid points in the *Y*-direction over half of the domain, including a point at the origin. Therefore, the total number of grid points in the *Y*-direction is equal to 2\ **NY**\ −1. **NY** must be greater than or equal to 2. + +**NZ** sets the number of grid points in the vertical *Z*-direction from *Z* = (\ **MSL2SWL** − **Z_Depth**\ ) to *Z* = **MSL2SWL**\ . The distribution of grid points in the *Z*-direction is not uniform. It instead follows a cosine distribution: *Z*\ [\ *n*\ ] = **Z_Depth**\ (cos(\ *n*\ ·d\ *θ*\ )–1), where *n* = 0,1,…,\ **NZ**\ -1 and d\ *θ* = *π*\ /(2(\ **NZ**\ -1)). This distribution places more grid points near the free surface. **NZ** must be greater than or equal to 2. + +When setting up the wave grid, it is necessary to make sure the wave grid is large enough in all three directions, so that no part of the structure defined in HydroDyn moves out of the wave grid during the simulation. At the same time, the grid should also be fine enough to resolve the shortest wave of interest. + +OpenFAST precomputes and saves the wave-field velocity, acceleration, dynamic pressure, and wave elevation at the start of the simulation. Generating and maintaining the wave grid can be memory intensive for long simulations. Users should set the wave grid to be no larger or finer than necessary to reduce memory use. Reducing **WaveTMax** or increasing **WaveDT** (see WAVES section below) also reduces memory use. For long crested waves (no directional spreading) aligned with the *X*-direction (or *Y*-direction), **NY** (or **NX**) can be reduced to the minimum allowed value of 2 to save memory. + +Waves +----- + +The WAVES section of the input file controls the internal generation of +first-order waves or the use of externally generated waves, used by both +strip-theory and potential-flow modeling in HydroDyn. The wave spectrum +settings in this section only pertain to the first-order wave frequency +components. When second-order terms are optionally enabled—see the +:ref:`sea-2nd_order_waves_input` and :ref:`hd-2nd_order_floating_platform_forces_input` +sections below—the second-order terms are calculated using the +first-order wave-component amplitudes and extra energy is added to the +wave spectrum (at the difference and sum frequencies). + +**WaveMod** specifies the incident wave kinematics model. The options +are: + +* 0: none = still water + +* 1: regular (periodic) waves + +* 1P#: regular (periodic) waves with user-specified phase, for example + 1P20.0 for regular waves with a 20˚ phase (without P#, the phase + will be random, based on **WaveSeed**); 0˚ phase represents a + cosine function, starting at the peak and decreasing in time + +* 2: Irregular (stochastic) waves based on the JONSWAP or + Pierson-Moskowitz frequency spectrum + +* 3: Irregular (stochastic) waves based on a white-noise frequency + spectrum + +* 4: Irregular (stochastic) waves based on a user-defined frequency + spectrum from routine *UserWaveSpctrm()*; need to recompile the SeaState + standalone program or OpenFAST. + +* 5: Externally generated wave-elevation time series + +* 6: Externally generated full wave-kinematics time series + +* 7: User-defined wave frequency components + +Option 4 requires that the *UserWaveSpctrm()* subroutine of the +*Waves.f90* source file be implemented by the user, and will require +recompiling either the standalone SeaState program or OpenFAST. Option 5 +allows the use of externally generated wave-elevation time series, from +which the hydrodynamic loads in the potential-flow solution or the wave +kinematics used in the strip-theory solution are derived internally. +Option 6 allows the use of full externally generated wave kinematics for +use with the strip-theory solution (but not the potential-flow +solution). Option 7 allows the user to specify wave frequency components +(amplitude/wave height, phase, and heading). With options 5, 6, and 7, +the externally generated wave data is provided through input files, all +of which have the root name given by the **WvKinFile** parameter below. + +**WaveStMod** sets the wave-stretching formulation, which allows strip- +theory hydrodynamic and hydrostatic loads (with wave-slope contribution) +to be evaluated up to the instantaneous incident-wave free surface in HydroDyn. +Currently, three different wave-stretching formulations are implemented: +vertical stretching (option 1), extrapolation stretching (option 2), and +Wheeler stretching (option 3). Using any of the three wave-stretching models +will also result in HydroDyn computing the nonlinear hydrostatic load on +strip-theory members up to the instantaneous free surface, including any +contribution from non-zero wave slope. Setting **WaveStMod** to 0 disables +wave stretching, and the strip-theory hydrodynamic and hydrostatic loads will +always be evaluated up to the SWL. Extrapolation stretching (**WaveStMod** = 2) +is not supported when **WaveMod** = 6 (externally generated full wave-kinematics +time series). + +**WaveTMax** sets the length of the incident wave kinematics time +series, but it also determines the frequency step used in the inverse +FFT, from which the internal wave time series are derived (*Δω* = +2\ *π*/**WaveTMax**). When **WaveMod** = 7 (user-defined wave frequency +components), all frequency components specified by the user must be integer +multiples of *Δω* with the lowest allowed frequency being equal to *Δω*. +If **WaveTMax** is less than the total simulation +time, SeaState implements repeating wave kinematics that have a period +of **WaveTMax**; **WaveTMax** must not be less than the total simulation +time when **WaveMod** = 5. **WaveDT** determines the time step for the +wave kinematics time series, but it also determines the maximum +frequency in the inverse FFT (*ω*\ :sub:`max` = *π*/**WaveDT**). When **WaveMod** = 7, +**WaveDT** is not used, and the appropriate time step is determined internally +based on the user-defined frequency components. When modeling +irregular sea states, we recommend that **WaveTMax** be set to at least +1 hour (3600 s) and that **WaveDT** be a value in the range between 0.1 +and 1.0 s to ensure sufficient resolution of the wave spectrum and wave +kinematics. When SeaState is coupled to OpenFAST, **WaveDT** may be +specified arbitrarily independently from the glue code time step of OpenFAST +(wave kinematics will be interpolated in time as necessary); +**WaveDT** must equal the glue code time step of OpenFAST when **WaveMod** = +6. **WaveTMax** and **WaveDT** also affect the amount of memory used by +the SeaState wave grid; a shorter **WaveTMax** and a longer **WaveDT** reduce +memory use. + +For internally generated waves, the wave height (crest-to-trough, twice +the amplitude) for regular waves and the significant wave height for +irregular waves are set using **WaveHs** (only used when **WaveMod** = 1, +2, or 3). The wave period for regular waves and the peak-spectral wave +period for irregular waves is controlled with the **WaveTp** parameter +(only used when **WaveMod** = 1 or 2). **WavePkShp** is the peak-shape +parameter of JONSWAP irregular wave spectrum (only used when **WaveMod** += 2). Set **WavePkShp** to DEFAULT to obtain the value recommended in +the IEC 61400-3 Annex B, derived based on the peak-spectral period and +significant wave height [IEC, 2009]. Set **WavePkShp** to 1.0 for the +Pierson-Moskowitz spectrum. + +**WvLowCOff** and **WvHiCOff** control the lower and upper cut-off +frequencies (in rad/s) of the first-order wave spectrum; the first-order +wave-component amplitudes are zeroed below and above these cut-off +frequencies, respectively. **WvLowCOff** may be set lower than the +low-energy limit of the first-order wave spectrum to minimize +computational expense. Setting a proper upper cut-off frequency +(**WvHiCOff**) also minimizes computational expense and is important to +prevent nonphysical effects when approaching of the breaking-wave limit +and to avoid nonphysical wave forces at high frequencies (i.e., at short +wavelengths) when using a strip-theory solution. **WvLowCOff** and +**WvHiCOff** are unused when **WaveMod** = 0, 1, or 6. + +**WaveDir** (unused when **WaveMod** = 0 or 6) is the mean wave +propagation heading direction (in degrees), and must be in the range +(-180,180]. A heading of 0 corresponds to wave propagation in the +positive X-axis direction. And a heading of 90 corresponds to wave +propagation in the positive Y-axis direction. **WaveDirMod** specifies +the wave directional spreading model (only used when **WaveMod** = 2, 3, +or 4). Setting **WaveDirMod** to 0 disables directional spreading, +resulting in long-crested (plane-progressive) sea states propagating in +the **WaveDir** direction. Setting **WaveDirMod** to 1 enables the +modeling of short-crested sea states, with a mean propagation direction +of **WaveDir**, through the commonly used cosine spreading function +(COS:sup:`2\ S`) to define the directional spreading spectrum, based on +the spreading coefficient (*S*) defined via **WaveDirSpread**. The wave +directional spreading spectrum is discretized with an equal-energy +method using **WaveNDir** number of equal-energy bins. **WaveNDir** is +an odd-valued integer greater than or equal to 1 (1 or 3 or 5…), but SeaState +may slightly increase the specified value of **WaveNDir** to ensure that +there is the same number of wave components within each direction bin; +setting **WaveNDir** = 1 is equivalent to setting **WaveDirMod** = 0. +The range of the directional spread (in degrees) is defined via +**WaveDirSpread**. The equal-energy method assumes that the directional +spreading spectrum is the product of a frequency spectrum and a +spreading function i.e. *S*\ (*ω*,\ *β*) = *S*\ (*ω*)\ *D*\ (*β*). +Directional spreading is not permitted when using Newman’s approximation +of the second-order difference-frequency potential-flow loads. + +**WaveSeed(1)** and **WavedSeed(2)** (unused when **WaveMod** = 0, 5, or +1) combined determine the initial seed (starting point) for the internal +pseudorandom number generator (pRNG) needed to derive the internal wave +kinematics from the wave frequency and direction spectra. If both are +numeric values, the Fortran intrinsic pRNG is used. If **WaveSeed(2)** +is the string "RANLUX", an alternative pRNG included with the NWTC Library +is used and the value of **WaveSeed(1)** is the seed. If you want to +run different time-domain realizations for given boundary conditions (of +significant wave height, and peak-spectral period, etc.), you should +change one or both seeds between simulations. While the phase of each +wave frequency and direction component of the wave spectrum is always +based on a uniform distribution (except when using the 1P# **WaveMod** +option), the amplitude of the wave frequency spectrum can also be +randomized (following a normal distribution) by setting **WaveNDAmp** to +TRUE. Setting **WaveNDAmp** to FALSE means that the amplitude of the +wave frequency spectrum always matches the target spectrum. +**WaveNDAmp** is only used with **WaveMod** = 2, 3, or 4. + +When using externally generated wave data (**WaveMod** = 5, 6, or 7), input +parameter **WvKinFile** should be set to the root name of the input +file(s) without extension when **WaveMod** = 5 or 6 or the full file name with +extension when **WaveMod** = 7. + +Using externally generated wave-elevation time series (**WaveMod** = 5) +requires a text-formatted input data file with the extension *.Elev* +containing two columns of data—the first is time (starting at zero) (in +s) and the second is the wave elevation at (0,0) (in m), separated by +whitespace. Header lines (identified as those not beginning with a +number) are ignored. The time series must be at least **WaveTMax** in +length and not less than the total simulation time, and the time step +must match **WaveDT**. The wave-elevation time series specified is +assumed to be of first order and long-crested, but is not checked for +physical correctness. When second-order terms are optionally enabled—see +the 2\ :sup:`ND`-ORDER WAVES section below—the second-order terms are +calculated using the wave-component amplitudes derived from the provided +wave-elevation time series and extra energy is added to the wave spectrum +(at the difference and sum frequencies). + +Using full externally generated wave kinematics (**WaveMod** = 6) +requires eight text-formatted input data files, all without headers. +Seven files with extensions *.Vxi*, *.Vyi*, *.Vzi*, *.Axi*, *.Ayi*, +*.Azi*, and *.DynP* correspond to the *X*, *Y*, and *Z* velocities (in +m/s) and accelerations (in m/s\ :sup:`2`) in the global inertial-frame +coordinate system and the dynamic pressure (in Pa) time series. Each of +these files must have 13 headerlines, which will be skipped by SeaState, +followed by exactly **WaveTMax**/**WaveDT** rows and *N* +whitepace-separated columns, where *N* is the total number of SeaState +wave grid points (corresponding exactly to those written to the +SeaState summary file). The nodes are ordered by incrementing the *X*-position first, +followed by incrementing the *Y*-position, and finally incrementing the *Z*-position, +as they appear in the SeaState summary file. +The first node is located at (-**X_HalfWidth**,-**Y_HalfWidth**,\ **MSL2SWL**-**Z_Dpth**). +Time is absent from the files but is assumed to go from zero to **WaveTMax** +in steps of **WaveDT**. The eighth file, with extension *.Elev*, contains the +wave-elevation time series (in m). This file must have exactly **WaveTMax**/**WaveDT** rows and +as many whitepace-separated columns as there are grid nodes in a horizontal +plane. The nodes are ordered by incrementing the *X*-position first followed by incrementing the +*Y*-position. The first node is located at (-**X_HalfWidth**,-**Y_HalfWidth**). +To use this feature, it is the burden of the user to generate wave kinematics +data at each of SeaState’s time steps and grid points. SeaState will not +interpolate the data when populating the wave grid. In these input files, +a numeric value (including 0) in a file is assumed to be valid data (with 0 +corresponding to 0 m, 0 m/s, 0 m/s\ :sup:`2`, or 0 Pa); a nonnumeric string +will be converted to a zero. The data in these files is not processed +(filtered, etc.) or checked for physical correctness. Full externally +generated wave kinematics (**WaveMod** = 6) cannot be used in conjunction +with the potential-flow solution, and only vertical and Wheeler wave stretching +are allowed, not extrapolation stretching. Users can run the SeaState +standalone driver program with any of the internal wave-generation models, +e.g., **WaveMod** = 2, with **WrWvKinMod** = 2 in the driver input to generate +a set of valid input files for **WaveMod** = 6 as templates. + +Using user-defined wave frequency components (**WaveMod** = 7) requires +a text-formatted input data file with the extension *.Comp* containing +four columns of data. The first column contains the angular frequency +(in rad/s) of the wave component, the second is the peak-to-trough wave height (in m) +of the component, the third is the wave heading of the component following +the convention of **WaveDir** above (in deg), and the last column is the +wave phase of the frequency component (in deg). A phase of zero corresponds +to a wave crest at the global origin at *t* = 0. The four columns are +separated by whitespaces. Header lines (identified as those not beginning +with a number) are ignored. A valid input file must meet the following +requirements: + +* All frequency entries must be integer multiples of the frequency step, *Δω* = 2π/**WaveTMax**. A relative tolerance of 10\ :sup:`-3` is enforced to allow for some truncation errors in the input frequencies. Users should make sure the input frequencies and **WaveTMax** contain enough significant digits to meet this requirement. The lowest allowed wave angular frequency is *Δω*. + +* If a frequency component has zero wave height, it can be omitted from the input file. + +* The frequency components listed in the input file need not be in any particular order. + +* For each frequency, there can only be one entry. It is not allowed, for example, to have two wave components with different headings but the same frequency. + +The wave components specified are assumed to be of first order and long-crested, +but are not checked for physical correctness. When second-order terms are +optionally enabled—see the 2\ :sup:`ND`-ORDER WAVES section below—the second-order +terms are calculated using the wave components specified and extra energy is +added to the wave spectrum (at the difference and sum frequencies). + +.. _sea-2nd_order_waves_input: + +2\ :sup:`nd`-Order Waves +------------------------ +The 2\ :sup:`ND`-ORDER WAVES section (unused when **WaveMod** = 0 or 6) +of the input file allows the option of adding second-order contributions +to the wave kinematics used by the strip-theory solution. When +second-order terms are optionally enabled, the second-order terms are +calculated using the first-order wave-component amplitudes and extra +energy is added to the wave spectrum (at the difference and sum +frequencies). The second-order terms cannot be computed without also +including the first-order terms from the WAVES section above. Enabling +the second-order terms allows one to capture some of the nonlinearities +of real surface waves, permitting more accurate modeling of sea states +and the associated wave loads at the expense of greater computational +effort (mostly at SeaState initialization). + +While the cut-off frequencies in this section apply to both the +second-order wave kinematics from SeaState (used for strip-theory loads +in HydroDyn) and **the second-order potential-flow loads** in HydroDyn, +the second-order terms themselves are enabled separately. The second-order +wave kinematics used by strip theory are enabled in this section, while +the second-order diffraction loads from potential-flow theory are enabled +in the :ref:`hd-2nd_order_floating_platform_forces_input` section of the +primary HydroDyn input file. The wave elevation outputs from SeaState will +only include the second-order contributions when the second-order wave +kinematics are enabled in this section. + +To use second-order wave kinematics in the strip-theory solution, set +**WvDiffQTF** and/or **WvSumQTF** to TRUE. When **WvDiffQTF** is set to +TRUE, second-order difference-frequency terms, calculated using the full +difference-frequency QTF, are incorporated in the wave kinematics. When +**WvSumQTF** is set to TRUE, second-order sum-frequency terms, +calculated using the full sum-frequency QTF, are incorporated in the +wave kinematics. The full difference- and sum-frequency wave kinematics +QTFs are implemented analytically following [Sharma and Dean, 1981], +which extends Stokes second-order theory to irregular multidirectional +waves. A setting of FALSE disregards the second-order contributions to +the wave kinematics in the strip-theory solution. + +**WvLowCOffD** and **WvHiCOffD** control the lower and upper cut-off +frequencies (in rad/s) of the second-order difference-frequency terms; +the second-order difference-frequency terms are zeroed below and above +these cut-off frequencies, respectively. The cut-offs apply directly to +the physical difference frequencies, not the two individual first-order +frequency components leading to the difference frequencies. When enabling +second-order potential-flow loads in HydroDyn, a setting of **WvLowCOffD** = 0 is +advised to avoid eliminating the mean-drift term (second-order wave +kinematics do not have a nonzero mean). **WvHiCOffD** need not be set +higher than the peak-spectral frequency of the first-order wave spectrum +(*ω*\ :sub:`p` = 2\ *π*/**WaveTp**) to minimize computational expense. + +Likewise, **WvLowCOffS** and **WvHiCOffS** control the lower and upper +cut-off frequencies (in rad/s) of the second-order sum-frequency terms; +the second-order sum-frequency terms are zeroed below and above these +cut-off frequencies, respectively. The cut-offs apply directly to the +physical sum frequencies, not the two individual first-order frequency +components leading to the sum frequencies. **WvLowCOffS** need not be set lower +than the peak-spectral frequency of the first-order wave spectrum +(*ω*\ :sub:`p` = 2\ *π*/**WaveTp**) to minimize computational expense. Setting +a proper upper cut-off frequency (**WvHiCOffS**) also minimizes +computational expense and is important to (1) ensure convergence of the +second-order summations, (2) avoid unphysical "bumps" in the wave +troughs, (3) prevent nonphysical effects when approaching of the +breaking-wave limit, and (4) avoid nonphysical wave forces at high +frequencies (i.e., at short wavelengths) when using a strip-theory +solution. + +Because the second-order terms are calculated using the first-order +wave-component amplitudes, the second-order cut-off frequencies +(**WvLowCOffD**, **WvHiCOffD**, **WvLowCOffS**, and **WvHiCOffS**) are +used in conjunction with the first-order cut-off frequencies +(**WvLowCOff** and **WvHiCOff**) from the WAVES section. However, the +second-order cut-off frequencies are not used by Newman’s approximation +of the second-order difference-frequency potential-flow loads, which are +derived solely from first-order effects. + +Constrained wave +---------------- +The **CONSTRAINED WAVE** section allows the user to prescribe and embed a +large wave crest in JONSWAP stochastic waves (**WaveMod** = 2), following +the constrained NewWave method of Taylor, Jonathan, and Harland (1997). + +**ConstWaveMod** can be set to 0 for no embedded wave, 1 for embedded wave +with prescribed crest elevation from SWL, or 2 for embedded wave with +prescribed crest-to-trough wave height. + +**CrestHmax** (in m) is twice the crest elevation from SWL if **ConstWaveMod** = 1 +or the crest-to-trough wave height if **ConstWaveMod** = 2. **CrestHmax** +must be greater than **WaveHs**. + +**CrestTime** is the time (in s) from the start of the simulation at which +the user-prescribed wave crest is to occur. + +**CrestXi** is the *X*-position (in m) of the embedded wave crest in the global frame +of reference. + +**CrestYi** is the *Y*-position (in m) of the embedded wave crest in the global frame +of reference. + +Constrained wave is only compatible with **WaveMod** = 2 (JONSWAP wave spectrum). +If **WaveMod** is set to other values, this section of the input file will be ignored. + +In the absence of second-order wave components, the crest elevation or crest height will +match the user input **CrestHmax** exactly. If second-order wave components are included +by setting either **WvDiffQTF** or **WvSumQTF** to TRUE, the resulting crest elevation or +crest height can deviate from **CrestHmax**. + +Current +------- +You can include water velocity due to a current model by setting +**CurrMod** = 1. If **CurrMod** is set to zero, then the simulation will +not include current. **CurrMod** = 2 requires that the *UserCurrent()* +subroutine of the *Current.f90* source file be implemented by the user, +and will require recompiling either the standalone SeaState program or +OpenFAST. Current induces steady hydrodynamic loads through the viscous-drag +terms (both distributed and lumped) of strip-theory members in HydroDyn. Current is +not used in the potential-flow solution or when **WaveMod** = 6. + +SeaState’s standard current model includes three sub-models: +near-surface, sub-surface, and depth-independent, as illustrated in +:numref:`sea-fig:current_sub_model`. All three currents are vector summed, +along with the wave particle kinematics velocity. + +.. figure:: figs/current_sub_models.jpg + :align: center + :name: sea-fig:current_sub_model + + Standard Current Sub-Models + +The sub-surface current model follows a power law, + +.. math:: + :label: SubsurfacePowerLaw + + U_{SS}(Z) = U_{0_{SS}} \left( \frac{Z+d}{d} \right)^{ \frac{1}{7} } + +where :math:`Z` is the local depth below the SWL (negative downward), :math:`d` is the +water depth (equal to **WtrDpth** + **MSL2SWL**), and :math:`U_{0_{SS}}` is the current +velocity at SWL, corresponding to **CurrSSV0**. The heading of the +sub-surface current is defined using **CurrSSDir** following the same +convention as **WaveDir**. + +The near-surface current model follows a linear relationship down to a +reference depth such that, + +.. math:: + :label: NearsurfacePowerLaw + + U_{NS}(Z) = U_{0_{NS}} \left( \frac{Z+h_{ref}}{h_{ref}} \right), Z\in[-h_{ref},0] + +otherwise, + +.. math:: + :label: NearsurfaceDeep + + U_{NS}(Z) = 0 + +where :math:`h_{ref}` is the reference depth corresponding to **CurrNSRef** and must be +positive valued. :math:`U_{0_{NS}}` is the current velocity at SWL, corresponding to +**CurrNSV0**. The heading of the near-surface current is defined using +**CurrNSDir**, following the same convention as **WaveDir**. + +The depth-independent current velocity everywhere equals **CurrDIV**. +This current has a heading direction **CurrDIDir**, following the same +convention as **WaveDir**. + +MacCamy-Fuchs diffraction model +------------------------------- +HydroDyn now supports the MacCamy-Fuchs wave-diffraction solution for strip-theory members. +This option attenuates the strip-theory wave excitation when the wavelength is comparable +to or smaller than the member diameter, thus providing more realistic loads at higher frequencies. +To limit memory use, the current OpenFAST implementation requires all strip-theory members +in HydroDyn that uses the MacCamy-Fuchs diffraction solution to have diameters within +/-10% +of a reference diameter given by **MCFD** here. If MacCamy-Fuchs diffraction solution is not +used in HydroDyn, set **MCFD** to a number less than or equal to zero to reduce memory use +and SeaState initialization time. + +Output Channels +--------------- +This section controls output quantities generated by SeaState. Enter one +or more lines containing quoted strings that in turn contain one or more +output parameter names. Separate output parameter names by any +combination of commas, semicolons, spaces, and/or tabs. If you prefix a +parameter name with a minus sign, "-", underscore, "_", or the +characters "m" or "M", SeaState will multiply the value for that channel +by –1 before writing the data. The parameters are not necessarily +written in the order they are listed in the input file. SeaState allows +you to use multiple lines so that you can break your list into +meaningful groups and so the lines can be shorter. You may enter +comments after the closing quote on any of the lines. Entering a line +with the string "END" at the beginning of the line or at the beginning +of a quoted string found at the beginning of the line will cause +SeaState to quit scanning for more lines of channel names. +If SeaState encounters an unknown/invalid channel name, it warns the users +but will remove the suspect channel from the output file. Please refer +to Appendix C for a complete list of possible output parameters. + +You can generate up to 9 wave elevation outputs. **NWaveElev** +determines the number (between 0 and 9), and the whitespace-separated +lists of **WaveElevxi** and **WaveElevyi** determine the locations of +these **NWaveElev** number of points in the global inertial-frame +coordinate system. + +You can also specify up to 9 locations in space to output wave kinematics +(fluid velocity and acceleration) and dynamic pressure. **NWaveKin** +determines the number (between 0 and 9), and the whitespace-separated +lists of **WaveKinxi**, **WaveKinyi**, and **WaveKinzi** determine the locations of +these **NWaveKin** number of points in the global inertial-frame +coordinate system. If one of the wave-stretching model is selected, its +effect will be reflected in the wave kinematics and dynamic pressure outputs. +For example, a point below SWL will report all zeros if it is momentarily out of +water due to a wave trough. Similarly, a point above SWL will report wave kinematics +and dynamic pressure according to the wave-stretching model selected if it +is momentarily in water due to a wave crest. Any point out of water will report +zeros in all wave-kinematics and dynamic-pressure outputs until it reenters water. diff --git a/docs/source/user/seastate/output_files.rst b/docs/source/user/seastate/output_files.rst new file mode 100644 index 0000000000..039e927c57 --- /dev/null +++ b/docs/source/user/seastate/output_files.rst @@ -0,0 +1,127 @@ +.. _sea-output: + +Output Files +============ +SeaState produces five types of output files: echo files, a wave-elevation +file, wave-kinematics files, a summary file, and a time-series file. +The following sections detail the purpose and contents of these files. + +Echo Files +~~~~~~~~~~ +If you set the **Echo** flag to TRUE in the SeaState driver file or the +SeaState primary input file, the contents of those files will be echoed +to a file with the naming conventions, **OutRootName**\ *.dvr.ech* for +the driver input file and **OutRootName**\ *.SeaSt.ech* for the SeaState +primary input file. **OutRootName** is either specified in the SEASTATE +section of the driver input file, or by the OpenFAST program. The echo files +are helpful for debugging your input files. The contents of an echo file +will be truncated if SeaState encounters an error while parsing an input +file. The error usually corresponds to the line after the last +successfully echoed line. + +Wave-Elevation File +~~~~~~~~~~~~~~~~~~~~ +Setting **WaveElevSeriesFlag** in the driver file to TRUE enables the +output of the wave elevation across the entire SeaState wave grid to +a text-based file with the name ``OutRootName.WaveElev.out``. +The output wave grid is controlled by the SPATIAL DISCRETIZATION +section of the primary SeaState input file. These wave elevations are +distinct and output separately from the wave elevations determined by +**NWaveElev** in the SeaState primary input file, which are instead +recorded in the time-series output file. The wave-elevation output file +``OutRootName.WaveElev.out`` contains the total wave elevation, which is +the sum of the first- and second-order terms (when the second-order wave +kinematics are optionally enabled). The wave-elevation file described +here is useful for visualization purposes. + +Wave-Kinematics Files +~~~~~~~~~~~~~~~~~~~~~ +**WrWvKinMod** controls the wave kinematics output from the SeaState driver. +The driver will output the wave-elevation time series at the global origin +(0,0) in a separate *.Elev* file if **WrWvKinMod** = 1. This file also serves +as a valid **WvKinFile** for **WaveMod** = 5 (externally generated wave-elevation +time series) in the primary SeaState input file. This is a separate wave- +elevation output independent from the wave-field output obtained with +**WaveElevSeriesFlag** = TRUE and the wave-elevation time series obtained with +**NWaveElev** in the SeaState primary input file. + +If **WrWvKinMod** = 2, SeaState will output the full wave kinematics (velocity, +acceleration, dynamic pressure, and wave elevation) at all wave grid points in +eight output files with the extensions *.Vxi*, *.Vyi*, *.Vzi*, *.Axi*, *.Ayi*, +*.Azi*, *.DynP*, and *.Elev*. The velocity and acceleration outputs are all in the +global earth-fixed coordinate system. These files are also valid as +**WvKinFile** for **WaveMod** = 6 (externally generated full wave-kinematics +time series) and can be used as templates if users would like to build +their own input files for **WaveMod** = 6. + +.. _sea-summary-file: + +Summary File +~~~~~~~~~~~~ +SeaState generates a summary file with the naming convention, +**OutRootName**\ *.SeaSt.sum* if the **SeaStSum** parameter is set +to TRUE. This file summarizes key information about your sea-state +model, including water density, water depth, still-water level, +the wave grid, first-order wave frequency components, and any +user-requested time-series outputs. + +Summary of User-Requested Outputs +--------------------------------- +The summary file includes information about all user-requested +wave-elevation and wave-kinematics time-series output channels. + +Wave-Kinematics Output Locations +++++++++++++++++++++++++++++++++ +The first column lists the index of the wave-kinematics output locations, +as entered in the OUTPUT CHANNELS section of the SeaState input file. +**Xi**, **Yi**, and **Zi** provide the spatial coordinates of the wave-kinematics +output locations in the global inertial-frame coordinate system. + +Wave-Elevation Output Locations ++++++++++++++++++++++++++++++++ +The first column lists the index of the wave-elevation output locations, +as entered in the OUTPUT CHANNELS section of the SeaState input file. +**Xi** and **Yi** provide the spatial coordinates of the wave-elevation +output locations in the global inertial-frame coordinate system. + +Requested Output Channels ++++++++++++++++++++++++++ +The string labels of all requested time-series output channels, as entered +in the OUTPUT CHANNELS section of the SeaState input file, are summarized here. + +Wave Frequency Components +------------------------- +This section provides the frequency-domain description (in terms of a +Discrete Fourier Transform or DFT) of the first-order wave elevation at +(0,0) on the free surface, but is not written when **WaveMod** = 0 or 6. +The first column, **index**, identifies the index of each wave frequency +component. The finite-depth wave number, angular frequency, and direction of the +wave components are given by **k**, **Omega**, and **Direction**, +respectively. The last two columns provide the real +(**REAL(DFT{WaveElev})**) and imaginary (**IMAG(DFT{WaveElev})**) +parts of the first-order DFT wave amplitudes. The DFT +produces both negative- and positive-frequency components. +The negative-frequency components are complex conjugates of the +positive-frequency components because the time-domain wave elevation is +real-valued. The relationships between the negative- and +positive-frequency components of the DFT are given by +:math:`k\left( - \omega \right) = - k\left( \omega \right)` and +:math:`H\left( - \omega \right) = {H\left( \omega \right)}^{*}`, where +*H* is the DFT of the wave elevation and *\** denotes the complex +conjugate. + + +Results File +~~~~~~~~~~~~ + +The SeaState time-series results are written to a text-based file with +the naming convention ``OutRootName.SeaSt.out`` when **OutSwtch** is +set to either 1 or 3. If SeaState is coupled to OpenFAST and **OutSwtch** is +set to 2 or 3, then OpenFAST will generate a master results file that +includes the SeaState results. The results are in table format, where +each column is a data channel (the first column is always the +simulation time), and each row corresponds to a simulation output time +step. The data channels are specified in the OUTPUT CHANNELS section of +the SeaState primary input file. The column format of the +SeaState-generated file is specified using the **OutFmt** and +**OutSFmt** parameter of the primary input file. diff --git a/docs/source/user/simplified_elastodyn/_implementation.rst.unused b/docs/source/user/simplified_elastodyn/_implementation.rst.unused new file mode 100644 index 0000000000..84a9ef4f05 --- /dev/null +++ b/docs/source/user/simplified_elastodyn/_implementation.rst.unused @@ -0,0 +1,175 @@ + +Implementation +============== + + +Datatypes +---------- + +**InitInput**: + +.. code:: + + CHARACTER(1024) InputFile - - - "Name of the input file" - + CHARACTER(1024) RootName - - - "RootName for writing output files" + + +**InitOutput**: + +The module returns init outputs needed for AeroDyn and ServoDyn, respecting the conventions of ElastoDyn. + +.. code:: + + CHARACTER(ChanLen) WriteOutputHdr {:} - - "Names of the output-to-file channels" - + CHARACTER(ChanLen) WriteOutputUnt {:} - - "Units of the output-to-file channels" - + IntKi NumBl - - - "Number of blades on the turbine" - + ReKi BlPitch - - - "Initial blade pitch angle" rad + ReKi TowerHeight - - - "Tower Height" m + ReKi HubHt - - - "Height of the hub" m + ReKi PlatformPos {6} - - "Initial platform position (6 DOFs)" + ReKi HubRad - - - "Preconed hub radius (distance from the rotor apex to the blade root)" m + ReKi BladeLength - - - "Blade length (for AeroDyn)" m + ReKi RotSpeed - - - "Initial or fixed rotor speed" rad/s + LOGICAL isFixed_GenDOF - - - "Whether the generator is fixed or free" - + + + + +**Inputs**: + +Note: the yaw rate is only used to setup the velocities on the meshes. + +.. code:: + + ReKi AerTrq - - - "Aerodynamic torque" N-m + ReKi HSSBrTrqC - - - "High speed side brake torque" N-m + ReKi GenTrq - - - "Electrical generator torque on HSS" N-m + ReKi BlPitchCom {:} - 2pi "Commanded blade pitch angles" rad + ReKi Yaw - - - "Yaw angle" rad + ReKi YawRate - - - "Yaw rate" rad/s + + +**Outputs**: + + +The module returns outputs needed for AeroDyn and ServoDyn, respecting the conventions of ElastoDyn and using the proper units. +Towerline, nacelle and hub are needed for AeroDyn. Platform mesh is for possible future implementation with HydroDyn. + +Note: LSSTipPxa is obtained from the state, but modulo 2 pi + +Note: additional scalar outputs may be needed by ServoDyn. + +.. code:: + + MeshType BladeRootMotion {:} - - "For AeroDyn/BeamDyn: motions at the blade roots" + MeshType HubPtMotion - - - "For AeroDyn and Lidar(InflowWind): motions of the hub" + MeshType NacelleMotion - - - "For AeroDyn14 & ServoDyn/TMD: motions of the nacelle." + MeshType TowerLn2Mesh - - - "Tower line2 mesh with positions/orientations/velocities/accelerations" - + MeshType PlatformPtMesh - - - "Platform reference point positions/orientations/velocities/accelerations" - + ReKi LSSTipPxa - - 2pi "Rotor azimuth angle (position)" radians + ReKi RotSpeed - - - "Rotor azimuth angular speed" rad/s + ReKi WriteOutput {:} - - "Data to be written to an output file: see WriteOutputHdr for names of each variable" "see WriteOutputUnt" + ReKi HSS_Spd - - - "High-speed shaft (HSS) speed" rad/s + + +**States**: + +.. code:: + + R8Ki QT {1} - - "Current estimate of Q (displacement) for each degree of freedom" - + R8Ki QDT {1} - - "Current estimate of QD (velocity) for each degree of freedom" + + +**Misc**: + +None anticipated at the moment. + +**Parameters**: + +.. code:: + + + R8Ki DeltaT - - - "Time step for module time integration" s + IntKi IntMethod - - - "Integration method {1: RK4, 2: AB4, or 3: ABM4}" - + ReKi J_DT - - - "Drivetrain inertia (blades+hub+shaft+generator) kgm^2 + ReKi PtfmPitch - - - "Static platform tilt angle" rad + MeshMapType mapPtf2Twr - - - "Mesh mapping from Ptfm to Tower line" - + MeshMapType mapTwr2Nac - - - "Mesh mapping from Tower to Nacelle" - + MeshMapType mapNac2Hub - - - "Mesh mapping from Nacelle to Hub" - + LOGICAL isFixed_GenDOF - - - "whether the generator is fixed or free" - + +.. + ReKi GBoxEff - - - "Gear box efficiency" - + +**InputFileInput** + +.. code:: + + R8Ki DeltaT - - - "Time step for module time integration" s + IntKi IntMethod - - - "Integration method {1: RK4, 2: AB4, or 3: ABM4}" - + LOGICAL GenDOF - - - "whether the generator is fixed or free" - + R8Ki Azimuth - - - "Initial azimuth angle for blade 1" deg + ReKi BlPitch - - - "Initial blade pitch angles" radians + ReKi RotSpeed - - - "Initial or fixed rotor speed" RPM + ReKi PtfmPitch - - - "Initial platform position (6 DOFs)" + IntKi NumBl - - - "Number of blades on the turbine" - + ReKi TipRad - - - "Preconed blade-tip radius (distance from the rotor apex to the blade tip)" m + ReKi HubRad - - - "Preconed hub radius (distance from the rotor apex to the blade root)" m + ReKi PreCone - - - "Rotor precone angles" deg + ReKi OverHang - - - "Distance from yaw axis to rotor apex or teeter pin" m + ReKi ShftTilt - - - "Rotor shaft tilt angle" deg + ReKi Twr2Shft - - - "Vertical distance from the tower-top to the rotor shaft" m + ReKi TowerHt - - - "Height of tower above ground level [onshore] or MSL [offshore]" m + ReKi RotIner - - - "Hub inertia about teeter axis (2-blader) or rotor axis (3-blader)" "kg m^2" + ReKi GenIner - - - "Generator inertia about HSS" "kg m^2" + LOGICAL SumPrint - - - "Print summary data to .sum" - + ReKi GBRatio - - - "Gearbox ratio" - + +.. + ReKi GBoxEff - - - "Gearbox efficiency" % + + +Workflow of main routines +------------------------- + +Init +~~~~ + +- Read input file +- Transfer InputFile data to parameters +- Set reference positions of meshes + - Set `PlatformPtMesh` (at (0,0,0)) + - Set `TowerL2Mesh` using two nodes at `PlatformPtMesh` and at the `TowerHt` + - Set `NacellePtMotion`, based on `NacYaw` and last point of `TowerL2Mesh` + - Set `HubPtMotion` based on geometry (`Twr2Shft`, `Tilt`, `OverHang`, and zero azimuth) + - Set `BladeRootMotion`, distributing the blades azimuthally based on the number of blades. +- Define mesh mappings: + - Set mesh mapping between `PlatformPtMesh` and `TowerL2Mesh` + - Set mesh mapping between `TowerL2Mesh` and `NacellePtMotion` + - Set mesh mapping between `NacellePtMotion` and `HubPtMotion` + - Set mesh mapping between `HubPtMotion` and `BladeRootMotion` + +- Return quantities needed by AeroDyn and ServoDyn + + +UpdateStates +~~~~~~~~~~~~ + +If the generator degrees of freedom is on (`isFixed_GenDOF`) , this routine calls one of the time integration method, based on `IntMethod`, each calling the function `CalcConStateDerivative`. +Otherwise, compute states based on Eq. :eq:`sed_stateEqGenDOF`. + +CalcConStateDerivative +~~~~~~~~~~~~~~~~~~~~~~ + +Returns derivative of states according to Eq. :eq:`sed_stateEq`. + + + +CalcOutput +~~~~~~~~~~ + +- Set relative motions and successively update meshes using mapping: + - Set relative motion of `NacellePtMotion` based on yaw and yawrate + - Set relative motion of `HubPtMotion` using :math:`\psi` & :math:`\dot{\psi}` + - Set relative motion of `BladeRootMotion` based on `BlPitchCom` +- Compute `Outputs` and `WriteOutputs` ("Azimuth", "RotSpeed", "RotAcc", "GenSpeed", "GenAcc") from states and inputs. diff --git a/docs/source/user/simplified_elastodyn/index.rst b/docs/source/user/simplified_elastodyn/index.rst new file mode 100644 index 0000000000..49e2238c2a --- /dev/null +++ b/docs/source/user/simplified_elastodyn/index.rst @@ -0,0 +1,30 @@ +.. _SED: + +Simplified ElastoDyn +====================================== + + +This document describes the Simplified ElastoDyn (SED) module. +This module has the features the following: + +- The rotor is rigid +- One degree of freedom is used, representing the variable rotor speed +- No calculation of structural loads +- Possibility to be run with large time step +- A constant platform tilt angle +- Compatibility with AeroDyn and AeroDisk +- Compatibility with active control of torque and yaw (and pitch) + + + +.. only:: html + + +.. toctree:: + :maxdepth: 2 + + theory.rst + input_files.rst + +.. + zrefs.rst diff --git a/docs/source/user/simplified_elastodyn/input_files.rst b/docs/source/user/simplified_elastodyn/input_files.rst new file mode 100644 index 0000000000..f664fb8356 --- /dev/null +++ b/docs/source/user/simplified_elastodyn/input_files.rst @@ -0,0 +1,71 @@ +.. _sed_input-files: + +Input and Output Files +====================== + + +Units +----- + +SED uses the SI system (kg, m, s, N). + +.. _sed_input-file: + +Input file +---------- + + +.. code:: + + ------- SIMPLIFIED ELASTODYN INPUT FILE ---------------------------------------- + Comment + ---------------------- SIMULATION CONTROL -------------------------------------- + False Echo - Echo input data to ".ech" (flag) + 3 Method - Integration method: {1: RK4, 2: AB4, or 3: ABM4} (-) + "default" DT - Integration time step (s) + ---------------------- DEGREES OF FREEDOM -------------------------------------- + True GenDOF - Generator DOF (flag) + ---------------------- INITIAL CONDITIONS -------------------------------------- + 0 Azimuth - Initial azimuth angle for blades (degrees) + 0 BlPitch - Blades initial pitch (degrees) + 0.0 RotSpeed - Initial or fixed rotor speed (rpm) + 0 NacYaw - Initial or fixed nacelle-yaw angle (degrees) + 0 PtfmPitch - Fixed pitch tilt rotational displacement of platform (degrees) + ---------------------- TURBINE CONFIGURATION ----------------------------------- + 3 NumBl - Number of blades (-) + 63 TipRad - The distance from the rotor apex to the blade tip (meters) + 1.5 HubRad - The distance from the rotor apex to the blade root (meters) + -2.5 PreCone - Blades cone angle (degrees) + -5.0191 OverHang - Distance from yaw axis to rotor apex [3 blades] or teeter pin [2 blades] (meters) + -5 ShftTilt - Rotor shaft tilt angle (degrees) + 1.96256 Twr2Shft - Vertical distance from the tower-top to the rotor shaft (meters) + 87.6 TowerHt - Height of tower above ground level [onshore] or MSL [offshore] (meters) + ---------------------- MASS AND INERTIA ---------------------------------------- + 115926 RotIner - Rot inertia about rotor axis [blades + hub] (kg m^2) + 534.116 GenIner - Generator inertia about HSS (kg m^2) + ---------------------- DRIVETRAIN ---------------------------------------------- + 100 GBoxEff - Gearbox efficiency (%) + 97 GBRatio - Gearbox ratio (-) + ---------------------- OUTPUT -------------------------------------------------- + OutList - The next line(s) contains a list of output parameters. See OutListParameters.xlsx for a listing of available output channels, (-) + "Azimuth" - Blades azimuth angle + "RotSpeed" - Low-speed shaft rotational speed + "RotAcc" - Low-speed shaft rotational acceleration + END of input file (the word "END" must appear in the first 3 columns of this last OutList line) + ----------------------------------------------------------------------------------------------------------------------------------------------------------------------------- + + + + + +.. _sed_outputs: + +Outputs +------- + +The write outputs are: + - "Azimuth" : Blades azimuth angle (deg) between 0 and 2pi + - "RotSpeed": Low-speed shaft rotational speed (rpm) + - "RotAcc": Low-speed shaft rotational acceleration (rad/s^2) + - "GenSpeed": High-speed shaft rotational speed (rpm) + - "GenAcc": High-speed shaft rotational acceleration (rad/s^2) diff --git a/docs/source/user/simplified_elastodyn/theory.rst b/docs/source/user/simplified_elastodyn/theory.rst new file mode 100644 index 0000000000..806cbbfa55 --- /dev/null +++ b/docs/source/user/simplified_elastodyn/theory.rst @@ -0,0 +1,67 @@ +.. _sed-theory: + +Theory +============= + +In this module, the rotor is represented by a rigid disk. + + +The module has two states :math:`\psi` and :math:`\dot{\psi}`, corresponding to the azimuthal angle and the rotor speed. (Note: introducing the azimuthal angle as a state is optional, but convenient for coupling with AeroDyn. Such introduction should not have any influence on the time-step required since both equations are effictively decoupled.). +The state-space equations are: + +.. math:: :label: sed_stateEq + + \begin{aligned} + \dot{\psi} & = \dot{\psi} \\ + \ddot{\psi} & = \frac{1}{J_\text{DT}}\left( Q_g - Q_a + Q_b\right) + \end{aligned} + +where :math:`J_{DT}` is the total inertia of the drivetrain (blades+hub+generator), :math:`Q_g`, :math:`Q_a` and :math:`Q_b` are the generator, aerodynamic and brake torque respectively, all expressed on the low-speed-shaft (LSS) side. +The total inertia of the drivetrain is obtained as: + +.. math:: :label: sed_JDT + + J_\text{DT} = J_r + n_g^2 J_{g,HSS} + +where :math:`J_r` is the inertia of the rotor (blades+hub+"shaft"), +:math:`n_g` is the gear ratio of the gearbox +and :math:`J_{g,HSS}` is the inertia of the generator on the high-speed-shaft (HSS). +It is noted that OpenFAST considers the inertia of the shaft to be included in the "hub" (i.e. rotor). +The generator and brake torques on the LSS is obtained from the HSS as follows: + +.. math:: :label: QgLSS + + Q_g = n_g Q_{g,HSS} + ,\quad + Q_b = n_g Q_{b,HSS} + +.. + where :math:`\eta_{DT}` is the efficiency of the drivetrain. + Q_g = \frac{n_g}{\eta_{DT}} Q_{g,HSS} + +The initial conditions associated with equation :eq:`sed_stateEq` are: + +.. math:: :label: sed_stateInit + + \begin{aligned} + \psi & = \psi_0 \\ + \dot{\psi} & = \Omega_0 + \end{aligned} + +where :math:`\psi_0` is the initial azimuthal angle in rad and :math:`\Omega_0` is the initial rotor speed in rad/s. + + + +If the generator degrees of freedom is off, then the states are simply determined as follows: + + +.. math:: :label: sed_stateEqGenDOF + + + \begin{aligned} + \psi & = \psi_0 + \int_{0}^t \dot{\psi} dt = \psi_0 + \Omega_0 n \Delta t \\ + \dot{\psi} & = \Omega_0 + \end{aligned} + +where :math:`n` is the time step index and :math:`\Delta t` is the time step of the module. + diff --git a/docs/source/user/subdyn/examples/OC4_Jacket_SD_Input.dat b/docs/source/user/subdyn/examples/OC4_Jacket_SD_Input.dat index 43111b830f..2c7cf3dcfe 100644 --- a/docs/source/user/subdyn/examples/OC4_Jacket_SD_Input.dat +++ b/docs/source/user/subdyn/examples/OC4_Jacket_SD_Input.dat @@ -111,7 +111,7 @@ IJointID ItfTDXss ItfTDYss ItfTDZss ItfRDXss ItfRDYss ItfRDZss 56 1 1 1 1 1 1 ----------------------------------- MEMBERS ------------------------------------------- 112 NMembers - Number of members (-) -MemberID MJointID1 MJointID2 MPropSetID1 MPropSetID2 MType COSMID ![MType={1:beam circ., 2:cable, 3:rigid, 4:beam arb.}. COMSID={-1:none}] +MemberID MJointID1 MJointID2 MPropSetID1 MPropSetID2 MType COSMID ![MType={1:beam circ., 2:cable, 3:rigid, 4:beam arb., 5:spring}. COMSID={-1:none}] (-) (-) (-) (-) (-) (-) (-) 1 1 2 2 2 1 -1 2 2 3 2 2 1 -1 @@ -247,6 +247,10 @@ PropSetID EA MatDens T0 CtrlChannel 0 NRigidPropSets - Number of rigid link properties PropSetID MatDens (-) (kg/m) +----------------------- SPRING ELEMENT PROPERTIES ------------------------------------- + 0 NSpringPropSets - Number of spring properties +PropSetID k11 k12 k13 k14 k15 k16 k22 k23 k24 k25 k26 k33 k34 k35 k36 k44 k45 k46 k55 k56 k66 + (-) (N/m) (N/m) (N/m) (N/rad) (N/rad) (N/rad) (N/m) (N/m) (N/rad) (N/rad) (N/rad) (N/m) (N/rad) (N/rad) (N/rad) (Nm/rad) (Nm/rad) (Nm/rad) (Nm/rad) (Nm/rad) (Nm/rad) ---------------------- MEMBER COSINE MATRICES COSM(i,j) ------------------------------- 0 NCOSMs - Number of unique cosine matrices (i.e., of unique member alignments including principal axis rotations); ignored if NXPropSets=0 or 9999 in any element below COSMID COSM11 COSM12 COSM13 COSM21 COSM22 COSM23 COSM31 COSM32 COSM33 diff --git a/docs/source/user/subdyn/input_files.rst b/docs/source/user/subdyn/input_files.rst index 157ad04f33..8e7f5a3ae5 100644 --- a/docs/source/user/subdyn/input_files.rst +++ b/docs/source/user/subdyn/input_files.rst @@ -179,11 +179,10 @@ properties, the material properties are not allowed to change within a single member. Future releases will allow for members of different cross-sections, -i.e., noncircular members. For this reason, the input file has -(currently unused) sections dedicated to the identification of direction -cosines that in the future will allow the module to identify the correct -orientation of noncircular members. The current release only accepts -tubular (circular) members. +i.e., noncircular members. For this reason, the input file has sections +dedicated to the identification of direction cosines that in the future +will allow the module to identify the correct orientation of noncircular +members. The current release only accepts tubular (circular) members. The file is organized into several functional sections. Each section corresponds to an aspect of the SubDyn model and substructure. @@ -230,13 +229,6 @@ static gravity and buoyancy loads, and high-frequency loads transferred from the turbine. Recommended to set to True. -**GuyanLoadCorrection** is a flag to specify whether the extra moment due to -the lever arm from the Guyan deflection of the structure is to be added to the loads -passed to SubDyn, and, whether the FEM representation should be expressed in the rotating -frame in the floating case (the rotation is induced by the rigid body Guyan modes). -See section :numref:`SD_Loads` for details. Recommended to set to True. - - FEA and Craig-Bampton Parameters ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -254,16 +246,11 @@ Increasing the number of elements per member may increase accuracy, with the trade-off of increased memory usage and computation time. We recommend using **NDiv** > 1 when modeling tapered members. -**CBMod** is a flag that specifies whether or not the C-B reduction -should be carried out by the module. If FALSE, then the full -finite-element model is retained and **Nmodes** is ignored. - -**Nmodes** sets the number of internal C-B modal DOFs to retain in the +**Nmodes** sets the number of internal C-B modal DOF to retain in the C-B reduction. **Nmodes** = 0 corresponds to a Guyan (static) -reduction. **Nmodes** is ignored if **CBMod** is set to FALSE, -meaning the full finite-element model is retained by keeping all modes -(i.e. a modal analysis is still done, and all the modes are used as DOFs) . - +reduction. With **Nmodes** < 0 (equivalent to **CBMod** set to FALSE +in previous versions), SubDyn will retain all C-B modes, leading to the +same number of DOF as the full finite-element model. **JDampings** specifies value(s) of damping coefficients as a percentage of critical damping for the retained C-B modes. Distinct @@ -419,7 +406,7 @@ MEMBER X-SECTION PROPERTY table (discussed next) for starting cross-section properties and **MPropSetID2** specifies the identifier for ending cross-section properties, allowing for tapered members. The sixth column specify the member type **MType**. -A member is one of the three following types (see :numref:`SD_FEM`): +A member is one of the four following types (see :numref:`SD_FEM`): - Beams (*MType=1*), Euler-Bernoulli (*FEMMod=1*) or Timoshenko (*FEMMod=3*) @@ -427,9 +414,12 @@ A member is one of the three following types (see :numref:`SD_FEM`): - Rigid link (*MType=3*) +- Spring element (*MType=5*) + **COSMID** refers to the IDs of the members' cosine matrices for noncircular -members; the current release uses SubDyn's default direction cosine convention -if it's not present or when COSMID values are -1. +members and spring elements; the current release uses SubDyn's default direction cosine convention +if it's not present or when COSMID values are -1. Spring elements are defined between joints that +are coincident in the space and the direction cosine must be provided. An example of member table is given below @@ -525,22 +515,27 @@ An example of rigid link properties table is given below (-) (kg/m) 12 7850.0 3 7000.0 - - - - - - - - - - - - +Spring Properties +~~~~~~~~~~~~~~~~~ +Members that are specified as spring elements (**MType=5**), +have their properties defined in the spring element properties table. +The table lists for each spring property: the property ID (**PropSetID**) and the +stiffness coefficients (**K11**, **K12**, **K13**, **K14**, **K15**, **K16**, **K22**, +**K23**, **K24**, **K25**, **K26**, **K33**, **K34**, **K35**, **K36**, **K44**, **K45**, +**K46**, **K55**, **K56**, **K66**). The stiffness matrix is considered symmetric and +includes diagonal (kii) and cross-coupling (kij) coefficients. +The FEM representation of the spring element is given in :numref:`SD_SpringElement`. +An example of spring properties table is given below: +.. code:: + -------------------------- SPRING ELEMENT PROPERTIES ---------------------------- + 1 NSpringPropSets - Number of spring properties + PropSetID k11 k12 k13 k14 k15 k16 k22 k23 k24 k25 k26 k33 k34 k35 k36 k44 k45 k46 k55 k56 k66 + (-) (N/m) (N/m) (N/m) (N/rad) (N/rad) (N/rad) (N/m) (N/m) (N/rad) (N/rad) (N/rad) (N/m) (N/rad) (N/rad) (N/rad) (Nm/rad) (Nm/rad) (Nm/rad) (Nm/rad) (Nm/rad) (Nm/rad) + 2 2E7 0 0 0 0 0 1E12 0 0 0 0 1E12 0 0 0 1E12 0 0 1E8 0 1E12 Member Cosine Matrices COSM (i,j) ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -548,9 +543,12 @@ Member Cosine Matrices COSM (i,j) to be provided. Each row of the table will list the nine entries of the direction cosine matrices (COSM11, COSM12,…COSM33) for matrix elements. Each row is a vector in the global coordinate system for principal axes -in the x, y and z directions respectively. These vectors need to be -specified with an extremely high level of precision for results to be -equivalent to an internal calculation. +in the x (COSM11, COSM12, COSM13), y (COSM21, COSM22, COSM23) and +z (COSM31, COSM32, COSM33) directions respectively. Internally, SubDyn +transposes this provided matrix to make it consistent with the definition +of direction cosine matrix :math:`[ \mathbf{D_c} ]` used in SubDyn (Eq. :eq:`Dc`). +The vectors provided need to be specified with an extremely high level of +precision for results to be equivalent to an internal calculation. Joint Additional Concentrated Masses ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ diff --git a/docs/source/user/subdyn/theory.rst b/docs/source/user/subdyn/theory.rst old mode 100644 new mode 100755 index ad56023b4a..4df87b53cf --- a/docs/source/user/subdyn/theory.rst +++ b/docs/source/user/subdyn/theory.rst @@ -279,7 +279,7 @@ The following joints are supported: - Ball joint (*JointType=4*) -A member is one of the three following types: +A member is one of the four following types: - Beams (*MType=1*), Euler-Bernoulli (*FEMMod=1*) or Timoshenko (*FEMMod=3*) @@ -287,11 +287,13 @@ A member is one of the three following types: - Rigid link (*MType=3*) +- Spring element (*MType=5*) + Beam members may be split into several elements to increase the accuracy of the model (using -the input parameter *NDiv*). Member of other types (rigid links and -pretension cables) are not split. In this document, the term *element* +the input parameter *NDiv*). Member of other types (rigid links, pretension cables and springs) +are not split. In this document, the term *element* refers to: a sub-division of a beam member or a member of another type -than beam (rigid-link or pretension cable). The term *joints* refers to +than beam (rigid-link, pretension cable or spring). The term *joints* refers to the points defining the extremities of the members. Some joints are defined in the input file, while others arise from the subdivision of beam members. The end points of an elements are called nodes and each @@ -384,23 +386,21 @@ element stiffness and consistent mass matrices can be written as follows .. math:: :label: ke0 - \setcounter{MaxMatrixCols}{20} - {\scriptstyle [k_e]= \begin{bmatrix} - \frac{12 E J_y} {L_e^3 \left( 1+ K_{sy} \right)} & 0 & 0 & 0 & \frac{6 E J_y}{L_e^2 \left( 1+ K_{sy} \right)} & 0 & -\frac{12 E J_y}{L_e^3 \left( 1+ K_{sy} \right)} & 0 & 0 & 0 & \frac{6 E J_y}{L_e^2 \left( 1+ K_{sy} \right)} & 0 \\ - & \frac{12 E J_x}{L_e^3 \left( 1+ K_{sx} \right)} & 0 & -\frac{6 E J_x}{L_e^2 \left ( 1+ K_{sx} \right )} & 0 & 0 & 0 & -\frac{12 E J_x}{L_e^3 \left ( 1+ K_{sx} \right )} & 0 & -\frac{6 E J_x}{L_e^2 \left ( 1+ K_{sx} \right )} & 0 & 0 \\ - & & \frac{E A_z}{L_e} & 0 & 0 & 0 & 0 & 0 & -\frac{E A_z}{L_e} & 0 & 0 & 0 \\ - & & & \frac{\left(4 + K_{sx} \right) E J_x}{L_e \left ( 1+ K_{sx} \right )} & 0 & 0 & 0 & \frac{6 E J_x}{L_e^2 \left ( 1+ K_{sx} \right )} & 0 & \frac{\left( 2-K_{sx} \right) E J_x}{L_e \left ( 1+ K_{sx} \right )} & 0 & 0 \\ - & & & & \frac{\left(4 + K_{sy} \right) E J_y}{L_e \left ( 1+ K_{sy} \right )} & 0 & -\frac{6 E J_y}{L_e^2 \left ( 1+ K_{sy} \right )} & 0 & 0 & 0 & \frac{\left( 2-K_{sy} \right) E J_y}{L_e \left ( 1+ K_{sy} \right )} & 0 \\ - & & & & & \frac{G J_z}{L_e} & 0 & 0 & 0 & 0 & 0 & -\frac{G J_z}{L_e} \\ - & & & & & & k_{11} & 0 & 0 & 0 & -\frac{6 E J_y}{L_e^2 \left ( 1+ K_{sy} \right )} & 0 \\ - & & & & & & & k_{22} & 0 & \frac{6 E J_x}{L_e^2 \left ( 1+ K_{sx} \right )} & 0 & 0 \\ - & & & & & & & & k_{33} & 0 & 0 & 0 \\ - & & & & & & & & & k_{44} & 0 & 0 \\ - & & & & & & & & & & k_{55} & 0 \\ - & & & & & & & & & & & k_{66} \\ + \frac{12 E J_y} {L_e^3 \left( 1+ K_{sy} \right)} & 0 & 0 & 0 & \frac{6 E J_y}{L_e^2 \left( 1+ K_{sy} \right)} & 0 & -\frac{12 E J_y}{L_e^3 \left( 1+ K_{sy} \right)} & 0 & 0 & 0 & \frac{6 E J_y}{L_e^2 \left( 1+ K_{sy} \right)} & 0 \\ + & \frac{12 E J_x}{L_e^3 \left( 1+ K_{sx} \right)} & 0 & -\frac{6 E J_x}{L_e^2 \left ( 1+ K_{sx} \right )} & 0 & 0 & 0 & -\frac{12 E J_x}{L_e^3 \left ( 1+ K_{sx} \right )} & 0 & -\frac{6 E J_x}{L_e^2 \left ( 1+ K_{sx} \right )} & 0 & 0 \\ + & & \frac{E A_z}{L_e} & 0 & 0 & 0 & 0 & 0 & -\frac{E A_z}{L_e} & 0 & 0 & 0 \\ + & & & \frac{\left(4 + K_{sx} \right) E J_x}{L_e \left ( 1+ K_{sx} \right )} & 0 & 0 & 0 & \frac{6 E J_x}{L_e^2 \left ( 1+ K_{sx} \right )} & 0 & \frac{\left( 2-K_{sx} \right) E J_x}{L_e \left ( 1+ K_{sx} \right )} & 0 & 0 \\ + & & & & \frac{\left(4 + K_{sy} \right) E J_y}{L_e \left ( 1+ K_{sy} \right )} & 0 & -\frac{6 E J_y}{L_e^2 \left ( 1+ K_{sy} \right )} & 0 & 0 & 0 & \frac{\left( 2-K_{sy} \right) E J_y}{L_e \left ( 1+ K_{sy} \right )} & 0 \\ + & & & & & \frac{G J_z}{L_e} & 0 & 0 & 0 & 0 & 0 & -\frac{G J_z}{L_e} \\ + & & & & & & \frac{12 E J_y} {L_e^3 \left( 1+ K_{sy} \right)} & 0 & 0 & 0 & -\frac{6 E J_y}{L_e^2 \left ( 1+ K_{sy} \right )} & 0 \\ + & & & & & & & \frac{12 E J_x}{L_e^3 \left( 1+ K_{sx} \right)} & 0 & \frac{6 E J_x}{L_e^2 \left ( 1+ K_{sx} \right )} & 0 & 0 \\ + & & & & & & & & \frac{E A_z}{L_e} & 0 & 0 & 0 \\ + & & & & & & & & & \frac{\left(4 + K_{sx} \right) E J_x}{L_e \left ( 1+ K_{sx} \right )} & 0 & 0 \\ + & & & & & & & & & & \frac{\left(4 + K_{sy} \right) E J_y}{L_e \left ( 1+ K_{sy} \right )} & 0 \\ + & & & & & & & & & & & \frac{G J_z}{L_e} \\ \end{bmatrix} } @@ -409,21 +409,21 @@ element stiffness and consistent mass matrices can be written as follows [m_e]= \rho \\ \left[\begin{array}{*{12}c} - \frac{13 A_z L_e}{35}+\frac{6 J_y}{5 L_e} & 0 & 0 & 0 & \frac{11 A_z L_e^2}{210}+\frac{J_y}{5 L_e} & 0 & \frac{9 A_z L_e}{70}-\frac{6 J_y}{5 L_e} & 0 & 0 & 0 & -\frac{13 A_z L_e^2}{420}+\frac{J_y}{10} & 0 \\ - & \frac{12 E J_x}{L_e^3 \left ( 1+ K_{sx} \right )} & 0 & -\frac{6 E J_x}{L_e^2 \left ( 1+ K_{sx} \right )} & 0 & 0 & 0 & -\frac{12 E J_x}{L_e^3 \left ( 1+ K_{sx} \right )} & 0 & -\frac{6 E J_x}{L_e^2 \left ( 1+ K_{sx} \right )} & 0 & 0 \\ - & & \frac{E A_z}{L_e} & 0 & 0 & 0 & 0 & 0 & -\frac{E A_z}{L_e} & 0 & 0 & 0 \\ - & & & \frac{\left(4 + K_{sx} \right) E J_x}{L_e \left ( 1+ K_{sx} \right )} & 0 & 0 & 0 & \frac{6 E J_x}{L_e^2 \left ( 1+ K_{sx} \right )} & 0 & \frac{\left( 2-K_{sx} \right) E J_x}{L_e \left ( 1+ K_{sx} \right )} & 0 & 0 \\ - & & & & \frac{\left(4 + K_{sy} \right) E J_y}{L_e \left ( 1+ K_{sy} \right )} & 0 & -\frac{6 E J_y}{L_e^2 \left ( 1+ K_{sy} \right )} & 0 & 0 & 0 & \frac{\left( 2-K_{sy} \right) E J_y}{L_e \left ( 1+ K_{sy} \right )} & 0 \\ - & & & & & \frac{G J_z}{L_e} & 0 & 0 & 0 & 0 & 0 & -\frac{G J_z}{L_e} \\ - & & & & & & \frac{12 E J_y}{L_e^3 \left ( 1+ K_{sy} \right )} & 0 & 0 & 0 & -\frac{6 E J_y}{L_e^2 \left ( 1+ K_{sy} \right )} & 0 \\ - & & & & & & & \frac{12 E J_x}{L_e^3 \left ( 1+ K_{sx} \right )} & 0 & \frac{6 E J_x}{L_e^2 \left ( 1+ K_{sx} \right )} & 0 & 0 \\ - & & & & & & & & \frac{E A_z}{L_e} & 0 & 0 & 0 \\ - & & & & & & & & & \frac{\left(4 + K_{sx} \right) E J_x}{L_e \left ( 1+ K_{sx} \right )} & 0 & 0 \\ - & & & & & & & & & & \frac{\left(4 + K_{sy} \right) E J_y}{L_e \left ( 1+ K_{sy} \right )} & 0 \\ - & & & & & & & & & & & \frac{G J_z}{L_e}\\ + \frac{13 A_z L_e}{35}+\frac{6 J_y}{5 L_e} & 0 & 0 & 0 & \frac{11 A_z L_e^2}{210}+\frac{J_y}{10} & 0 & \frac{9 A_z L_e}{70}-\frac{6 J_y}{5 L_e} & 0 & 0 & 0 & -\frac{13 A_z L_e^2}{420}+\frac{J_y}{10} & 0 \\ + & \frac{13 A_z L_e}{35}+\frac{6 J_x}{5 L_e} & 0 & -\frac{11 A_z L_e^2}{210}-\frac{J_x}{10} & 0 & 0 & 0 & \frac{9 A_z L_e}{70}-\frac{6 J_x}{5 L_e} & 0 & \frac{13 A_z L_e^2}{420}-\frac{J_x}{10} & 0 & 0 \\ + & & \frac{A_z L_e}{3} & 0 & 0 & 0 & 0 & 0 & \frac{A_z L_e}{6} & 0 & 0 & 0 \\ + & & & \frac{A_z L_e^3}{105}+\frac{2 L_e J_x}{15} & 0 & 0 & 0 & -\frac{13 A_z L_e^2}{420}+\frac{J_x}{10} & 0 & -\frac{A_z L_e^3}{140}-\frac{L_e J_x}{30} & 0 & 0 \\ + & & & & \frac{A_z L_e^3}{105}+\frac{2 L_e J_y}{15} & 0 & \frac{13 A_z L_e^2}{420}-\frac{J_y}{10} & 0 & 0 & 0 & -\frac{A_z L_e^3}{140}-\frac{L_e J_y}{30} & 0 \\ + & & & & & \frac{J_z L_e}{3} & 0 & 0 & 0 & 0 & 0 & \frac{J_z L_e}{6} \\ + & & & & & & \frac{13 A_z L_e}{35}+\frac{6 J_y}{5 L_e} & 0 & 0 & 0 & -\frac{11 A_z L_e^2}{210}-\frac{J_y}{10} & 0 \\ + & & & & & & & \frac{13 A_z L_e}{35}+\frac{6 J_x}{5 L_e} & 0 & \frac{11 A_z L_e^2}{210}+\frac{J_x}{10} & 0 & 0 \\ + & & & & & & & & \frac{A_z L_e}{3} & 0 & 0 & 0 \\ + & & & & & & & & & \frac{A_z L_e^3}{105}+\frac{2 L_e J_x}{15} & 0 & 0 \\ + & & & & & & & & & & \frac{A_z L_e^3}{105}+\frac{2 L_e J_y}{15} & 0 \\ + & & & & & & & & & & & \frac{J_z L_e}{3}\\ \end{array}\right] -where :math:`A_z` is the element cross-section area, :math:`J_x, J_y, J_z` are the area second moments of +where the matrices are symmetric, and where :math:`A_z` is the element cross-section area, :math:`J_x, J_y, J_z` are the area second moments of inertia with respect to principal axes of the cross section; :math:`L_e` is the length of the undisplaced element from start-node to end-node; :math:`\rho, E, \textrm{and}\quad G` are material density, Young’s, and Shear moduli, respectively; :math:`K_{sx}, K_{sy}` are shear correction factors as shown below (they are set to zero if @@ -1287,9 +1287,51 @@ The constraint are applied after the full system has been assembled. +.. _SD_SpringElement: + + +Spring Elements +~~~~~~~~~~~~~~~ + +Do not confuse the spring member with the springs defined as +a boundary condition in land-based systems. The spring element +relates two joints by means of a 6 by 6 stiffness matrix that +is assumed symmetric (k_ij = k_ji). + +.. math:: + + \begin{aligned} + K= + \begin{bmatrix} + k_{11} & k_{12} & k_{13} & k_{14} & k_{15} & k_{16} \\ + k_{21} & k_{22} & k_{23} & k_{24} & k_{25} & k_{26} \\ + k_{31} & k_{32} & k_{33} & k_{34} & k_{35} & k_{36} \\ + k_{41} & k_{42} & k_{43} & k_{44} & k_{45} & k_{46} \\ + k_{51} & k_{52} & k_{53} & k_{54} & k_{55} & k_{56} \\ + k_{61} & k_{62} & k_{63} & k_{64} & k_{65} & k_{66} \\ + \end{bmatrix}\end{aligned} + +The spring element does not have a mass associated. However, if desired, a lumped mass can be +defined at the joints. + +Since each joint has 6 DOFs (3 translations and 3 rotations), mathematically, the +spring element has a 12 by 12 dimension. +.. math:: + + \begin{aligned} + K_e= + \begin{bmatrix} + k_{6x6} & -k_{6x6} \\ + -k_{6x6} & k_{6x6} \\ + \end{bmatrix}\end{aligned} +The spring element must be defined between two coincident joints and the orientation has to be +provided by means of the direction cosine. This allows the assembly of the spring element in the +global system stiffness matrix. +The spring element can be connected to beams, kinematic joints (e.g., revolute joint, universal joint, +and spherical joint), the interface joint and rigid links. However, it cannot be connected to a cable. .. _GenericCBReduction: @@ -1738,7 +1780,7 @@ Corrections to the baseline formulation ("GuyanLoadCorrection") ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The baseline FEM implementation needs to be corrected to account for the fact that loads are provided to SubDyn at the displaced positions, and to account for the rigid body motions in the floating case. -The corrections are activated by setting the parameter **GuyanLoadCorrection** to True. +In previous versions of SubDyn, the corrections are activated by setting the parameter **GuyanLoadCorrection** to True. This input parameter has been removed from the SubDyn primary input file, and the load corrections will always be used in current and future versions of SubDyn. diff --git a/docs/source/user/turbsim/examples/TurbSim_User.profiles b/docs/source/user/turbsim/examples/TurbSim_User.profiles index 3063d952bb..63af934660 100644 --- a/docs/source/user/turbsim/examples/TurbSim_User.profiles +++ b/docs/source/user/turbsim/examples/TurbSim_User.profiles @@ -6,8 +6,8 @@ Made up profiles 1.0 StdScale2 - v-component scaling factor for the input standard deviation 0.534 StdScale3 - w-component scaling factor for the input standard deviation ----------------------------------------------------------------------------------- -Height Wind Speed Wind --Direction-- Standard Deviation Length Scale - (m) (m/s) (deg, cntr-clockwise ) (m/s) (m) +Height Wind Speed Wind --Angle-- Standard Deviation Length Scale + (m) (m/s) (deg, cntr-clockwise ) (m/s) (m) ----------------------------------------------------------------------------------- 15.0 3 00 .100 3 25.0 4 00 .200 4 diff --git a/docs/source/user/turbsim/index.rst b/docs/source/user/turbsim/index.rst index 9a54a22ec4..da275f76ec 100644 --- a/docs/source/user/turbsim/index.rst +++ b/docs/source/user/turbsim/index.rst @@ -1,6 +1,11 @@ TurbSim Users Guide Placeholder ====================================== +The Turbsim documentation has not been ported to readthedocs yet. It can be downloaded below. + + :download:`User's Guide <../../../OtherSupporting/TurbSim/TurbSim_v2.00.pdf>` + + .. only:: html This is a placeholder for the TurbSim documentation that has not yet been converted to readTheDocs. diff --git a/docs/source/working.rst b/docs/source/working.rst new file mode 100644 index 0000000000..5860c41ddb --- /dev/null +++ b/docs/source/working.rst @@ -0,0 +1,539 @@ +.. _working_with_OF: + +Working with OpenFAST +===================== + +This section provides support for some of the typical use cases of OpenFAST. +It assumes that the user has an executable of OpenFAST available (see :ref:`installation` for installation). + + + + + +Quick Start - Running OpenFAST +------------------------------ + +In this Quick Start, we will explain how to run OpenFAST. OpenFAST is typically run from a terminal +(also referred to as command prompt or command line). +The simplest method to run OpenFAST is to copy the OpenFAST executable into your working directory, and then open a terminal into that directory. +The steps are therefore: + + - Copy the OpenFAST executable to the directory where you will run your simulations + - Open a terminal + - Navigate to the folder containing the OpenFAST executable + - Run OpenFAST to check its version + - Run OpenFAST on a given input file + +The steps are detailed below. + + +Open a terminal +~~~~~~~~~~~~~~~ + +To learn how open a terminal on your given operating system, you can try the following search queries: + + - `On Windows `__ + - `On Linux `__ + - `On Mac `__ + + + +Navigate to your simulation directory +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +In the terminal, you can navigate between folders using the command `cd`. +In this example, we assume that the simulation directory is `simulations/test`, therefore, to navigate to this directory you need to type: + +.. code-block:: bash + + cd simulations + cd test + +or: + +.. code-block:: bash + + cd simulations/test + + +To go to a parent directory, you can use `cd ..`. +If the directory path contain spaces, use quotes around the path. +It is usually good practice to avoid spaces in directory and file names. +The path can also be an absolute path, e.g., `cd C:/simulations/test`. + + + +Run OpenFAST to check the version number +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +Once your terminal is in the directory where OpenFAST is, you can try to run OpenFAST and check its version as follows: + +.. code-block:: bash + + ./openfast /h + +The `./` characters at the beginning of the command indicates that the executable is located in the current directory. +The command above will display the version of OpenFAST, the compilation options, and display a help message on the syntax for calling the OpenFAST executable. + + +.. note:: + + Try to always read the outputs of OpenFAST displayed in the terminal windows as errors and warnings will be displayed there. In general, if an error is displayed in the terminal, you can use the guidelines given in :ref:`troubleshooting` for troubleshooting. + + +.. warning:: + + It is important to keep track of the version of OpenFAST you are using, since the input files format can change from version to version (see :ref:`api_change`). + + +.. tip:: + + To avoid having to copy the executable in your working directory, you can place the executable into a folder and add this folder to your system path. If you chose this method, and restart your terminal, you should be able to run `openfast /h` from any folder, and this time, `./` is not needed. + + +Run your first OpenFAST simulation +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + + +The typical syntax to run a simulation is: + +.. code-block:: bash + + ./openfast InputFile.fst + +where `InputFile.fst` is a main OpenFAST input file. The extension `.fst` is recommended for the main input file of OpenFAST, `.dat` for other inputs files. +The input file format specifications of OpenFAST input files are given in +:ref:`input_file_overview`. + +We provide a minimal working example to get you started on your first OpenFAST run. +This example uses the `NREL 5-MW `__ wind turbine, which is a fictitious but representative multi-MW wind turbine, with rated power 5 MW, rated rotor speed +12.1 rpm, Hub Height 90 m, and rotor diameter 126 m. +This example is for an "onshore" version of the turbine, with only the structure (no aerodynamics), where the tower is initially displaced by 3m at the tower top. The files are located in the following +`github directory `__ . +You will have to download the following files and place them in your working directory: + +- `Main.fst `__ : the main OpenFAST input file +- `ElastoDyn.dat `__ : the input file for the ElastoDyn module +- `ElastoDyn_Blade.dat `__ : the input file defining the structural properties of the blade to be used by the ElastoDyn module +- `ElastoDyn_Tower.dat `__ : the input file defining the structural properties of the tower to be used by the ElastoDyn module + +Once these 4 files are placed in your working directory (where the OpenFAST executable is located and where your terminal is at), you can run the simulation as follows: + +.. code-block:: bash + + ./openfast Main.fst + + +The simulation should run successfully and OpenFAST will generate an output file with the extension `.out` or `.outb`. +We provide a simple Python and Matlab script in the `github directory `__ to display some of the output channels of this simulation. For more information on how to visualize the outputs, see :ref:`visualizing_input_output_OF`. +In general, if an error is displayed in the terminal, you can use the guidelines given in :ref:`troubleshooting` for troubleshooting. + + + + +.. tip:: + On certain platform (like Windows), you can drag and drop an input file to the OpenFAST executable in your file explorer, and this will run the simulation. If an error occurs using this method, you will not be able to see the error message. + + +.. tip:: + You can use relative and aboslute path to the OpenFAST executable and to the main OpenFAST input file. Input files of OpenFAST also contain filepaths that reference other input files. These filepaths are either relative to the current file, or, can be absolute paths. + + + + + + + +Troubleshooting a simulation +---------------------------- + + +.. _troubleshooting: + +Simple troubleshooting +~~~~~~~~~~~~~~~~~~~~~~ + +When an error is caught during a simulation, OpenFAST will abort with a message of the following kind: + +.. code-block:: bash + + FAST encountered an error during module initialization. + Simulation error level: FATAL ERROR + + Aborting OpenFAST. + +The lines above this message will reveal the nature of the error, and this information can be used to troubleshoot your simulation. + + + +Typical errors +************** + +Some typical errors and solutions are listed below: + +- *The input file "FILE" was not found*: As indicated, the input file is not found. Linux and Mac platforms are case sensitive, and require forward slashes. OpenFAST accepts relative or absolute path. Relative paths are expressed with respect to the file where they are referenced. + +- *Invalid input in file "FILE" while trying to read VAR*: Such errors typically occurs at initialization, when reading one of the input file of OpenFAST. It can be that the variable in the input file has a wrong type (integer instead of logical, float instead of string, etc.). Very often though, such an error indicates that the input file is not formatted propertly for the version of OpenFAST your are executing. Most likely your file is outdated. Lines are often added to the OpenFAST input files. You can have a look at :ref:`api_change` to see what lines have changed between versions of OpenFAST, or look at the `r-test `__ to find working examples of input files for the latest release and dev version of OpenFAST. + +- *A fatal error occurred when parsing data from "FILE". The variable "VAR" was not found on line #II*. Such errors are similar to the one described above. Check that your file has the proper format for the version of OpenFAST you are using. + +Similar messages indicate user-input errors (when selected options are not available or compatible). +Such error messages are usually explicit enough. You can have a look at the comments in the input file for some guidance, and refer to the user guide for more details on individual inputs of each module: :ref:`user_guide`. + +.. tip:: + 90% of the time, errors are due to a mismatch between the OpenFAST version and the input files (see second point above). + + +Typical warnings +**************** + +Some warnings might occasionally occur from different modules (typically the aerodynamic modules) and be reported to the command window. + + - *SkewedWakeCorrection encountered a large value of chi*: indicates that the turbine is highly yawed/titled. Could happen when the turbine undergoes important motions. + - *The BEM solution is being turned off due to low TSR.*: indicate that the instantaneous rotor speed is close to zero, or the relative wind speed is large (check the outputs `RtSpeed` and `RtVavgx`). + +The warnings can sometimes be ignored, but they often indicate an issue in the model. See the next section of advanced troubleshooting. + + + + +Advanced troubleshooting +~~~~~~~~~~~~~~~~~~~~~~~~ + +In some cases, simulations may abort during the simulation (*FAST encountered an error at simulation time T*), or they may run through but have empty or "NaN" outputs after few time steps (as little as one time steps). Such errors are typically due to the model being unphysical. +In such case, you might see error messages of the following kind in the command window: + +- *Small angle assumption violated* or *Angles in GetSmllRotAngs() are larger than 0.4 radians*: such warnings indicate that part of the structure is undergoing large rotations, whereas some module of OpenFAST are only valid under the small angle approximation. +- *Denominator is zero in GetSmllRotAngs()* + +Typically, when a simulation aborts or has unrealistic or NaN values, it is likely that there are errors in the model (the structure is too stiff, too soft, the inflow is incorrect, the initial conditions are incorrect, the controller is behaving unexpectedly, OLAF regularization parameters are set wrong, etc.). + +.. tip:: + The key to troubleshooting is to simplify your model. You can chose to progressively simplify your model, until it runs and produces physical results. Or the other way around, simplify your model to the fullest, and progressively reintroduce complexity. Typical simplifications include: no aerodynamic, stiff structure, steady inflow, no controller. + + + +Below are some steps you can take to troubleshoot your model, in particular trying to isolate the problem to a given module and then input: + + +- Simplify the model by using simple environmental conditions: steady uniform inflow, still water. + +- Remove the controller: Turn `GenDOF` to False in ElastoDyn, and set `CompServo` to 0 in the main input file. The rotor will spin at constant RPM. + +- Simplify your model by turning off most degrees of freedom in your ElastoDyn input file. You can start by keeping all degrees of freedom off, and progressively adding more degrees of freedom. This might indicat if the issue comes from the blade, nacelle, tower or substructure. Some degrees of freedom that are often problematic are the drive train torsion (`DrTrDOF`), and the yaw degree of freedom (`YawDOF`). The drive train stiffness and damping values in ElastoDyn are often set wrong. A common issues with yaw, is when `NacYaw` (in ElastoDyn) and `YawNeut` (in ServoDyn), are in disagreement, or, when the yaw spring and damping `YawSpr` and `YawDamp` are not physical. For offshore simulations, if `YawDOF` and `PtfmYDOF` are on, the model needs to have a realistic `PtfmYIner` present, otherwise these degrees of freedom will be ill-defined in ElastoDyn. PtfmYiner should contain the rotational inertia of the undeflected tower, and, if SubDyn is not used, the torsional inertia of the platform/TP (if any). + +- Simplify the physical models: use ElastoDyn (`CompElast=1`) over BeamDyn, use BEM (`WakeMod=1`) over OLAF, use 0 Craig-Bampton modes in SubDyn. + +- Visualize the time series outputs (see :ref:`visualizing_input_output_OF`). Add relevant displacement outputs to your model for instance: PtfmSurge, PtfmSway, PtfmHeave, PtfmRoll, PtfmPitch, PtfmYaw, NacYaw, TTDspFA, TTDspSS, RotSpeed, OoPDefl1, IPDefl1 and RtSkew. It is likely that the turbine has some large displacements due to some errors in the model. + +- Adjust your initial conditions. As mentioned above, `NacYaw` (ElastoDyn) and `YawNeut` (ServoDyn) need to match when the yaw degrees of freedom is on. If the structural is at an initial position that is unrealistic given the environmental condition, it is likely to overshoot (e.g. high wind speed but pitch too low). A common error is not initializing the rotor speed and blade-pitch angles to their expected (mean) values at the initial wind speed of the simulation, which causes issues with many wind turbine controllers. + +- Visualize the inputs (see :ref:`visualizing_input_output_OF`). Check that the mass and stiffness distributions of the blade and tower are as expected. + +- Verify the masses and stiffness of your system. The Blade mass and tower-top mass are shown in the ElastoDyn summary file. The equivalent 6x6 matrix of the substructure is found in the SubDyn summary file. + +- If you have isolated the problem to a given module, check the information provided in the summary file of this module. Most module have a flag at the end of their input file called `SumPrint` or similar, so that the summary file is written to disk. + +- Reduce the time step. The simulation time step needs to be adjusted based on the frequencies that are modelled in the system (typically the time step needs to be at around a tenth of the fastest frequency). Modules like BeamDyn and SubDyn usually require fine time steps. + Instead of reducing the time step, it is often equivalent to introduce 1 correction step (`NumCrctn`). When corrections are used the Jacobian need to be updated regularly, for instance setting `DT_UJac` to 100 time steps. For a floating system, we recommend using `DT_UJac = 1/(10*f_pitch)`, where `f_pitch` is the natural frequency of the floating wind turbine in pitch. + + +- Perform a linearization of your structure in vacuum (`CompInflow=0`, `CompAero=0`) and in standstill (`RotSpeed=0`) (see :ref:`linearization_analysis_OF`) and check that the frequencies and damping are within the range you expect. Adjust your structural inputs otherwise. + +- Generate VTK outputs for visualization of the turbine and the various meshes used by OpenFAST. VTK outputs are activated using `WrVTK=1` or `WrVTK=2`. The VTK are written in folders `vtk*` in the main directory, and can be visualized using Paraview (see :ref:`visualizing_input_output_OF`). + + + + +.. _moduleTroubleshooting: + +Troubleshooting for specific modules +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +All modules of OpenFAST require a certain level of expertise to ensure that the simulations are physical. +Guidelines for the different modules can be found throughout this documentation, see in particular: + + +- AeroDyn: :ref:`ad_modeling` + +- HydroDyn: :ref:`hd-modeling-considerations` + +- OLAF: :ref:`Guidelines-OLAF` + +- SubDyn: :ref:`sd_modeling-considerations` + +- FAST.Farm: :ref:`FF:ModGuidance` + + + + + + +Scripting +--------- + +NREL maintains several repositories of scripts to work with OpenFAST. +The scripts can for instance be used to read the input and outputs of OpenFAST, visualize them, and generate multiple simulation inputs, and postprocess them. Some of these applications will be detailed in the following sections. + + +The repositories maintained by NREL are the following: + +- `openfast_toolbox `__: collection of low-level Python tools to work with OpenFAST and perform simple operations, with granularity. + +- `matlab-toolbox `__: collection of low-level Matlab tools to work with OpenFAST. + +- `WEIS `__ : high-level Python scripts, stands for Wind Energy with Integrated Servo-control. It can perform multifidelity co-design of wind turbines. WEIS is a framework that combines multiple NREL-developed tools to enable design optimization of floating offshore wind turbines. + +The users are invited to consult the documentations of the individual repository, and discuss related issues on their individual github pages. Contribution by the community to the NREL repositories are welcome and encouraged. + + + +Additional repositories maintained by NREL are listed below: + +- `WISDEM `__: models for assessing overall wind plant cost of energy (COE), also contains file IO, (DLC) case generation, polar manipulations, visualization, and much more! +- `ROSCO_toolbox `__: tools to work with the `ROSCO `__ controller that is supported by OpenFAST + + + +Repositories maintained by third-parties are listed below: + + +- `pyDatView `_ : tool to plot the input and output files of OpenFAST, CSV-files, and other files from other wind energy software (Hawc2, Flex, Bladed). Multiple files can be opened at once to compare results from different simulations. + +- `WindEnergyToolbox `_: library developed by DTU, providing some support for different file formats + +- `FASTTool `_ : NREL FASTv8, MATLAB GUI and Simulink integration developed by TUDelft + + + + + +.. _models_OF: + +Open-source OpenFAST models +--------------------------- + +Open-source OpenFAST wind turbine models can be found here: + +- `r-test `__: regression tests for OpenFAST, contains models for OpenFAST and its drivers (AeroDyn, SubDyn, HydroDyn, etc.). This repository is not intended to be used as a "database" of models, but it has the advantage that the input files are always up to date with the latest `format specifications `_ . OpenFAST input files for previous version can be accessed via the git tags of this repository. +- `IEA Wind Task 37 repository `_ : contains OpenFAST models of the IEA Wind 3.4-MW, 10-MW, 15-MW, and up-and-coming 22-MW reference wind turbines. +- `openfast-turbine-models `_: open source wind turbine models (in development and out of date). + + + + + + + +.. _visualizing_input_output_OF: + +Visualizing inputs and outputs files +------------------------------------ + + + +To visualize the input and output files of OpenFAST the following graphical interface tool can be used: + +- `pyDatView `_ : tool to plot the input and output files of OpenFAST, CSV-files, and other files from other wind energy software (Hawc2, Flex, Bladed). Multiple files can be opened at once to compare results from different simulations. + +The VTK visualization files that are written by OpenFAST can be opened using: + +- `paraview `_ : tool to open the VTK files generated by OpenFAST, i.e. velocity fields and turbine geometry. + + +For advanced cases, the user may want to script the reading and plotting of the input files. +Python and Matlab tools are respectively being provided in the `openfast_toolbox `_ and `matlab-toolbox `_. +In the matlab toolbox, the scripts `FAST2Matlab.m` and `Matlab2FAST.m` are used to read and write input files, the script `ReadFASTbinary` is used to open binary (`.outb`) output files. +The README files of these repositories points to examples and more documentation. + + + + +.. _running_multiple_OF: + +Running parametric studies and design load cases (DLC) +------------------------------------------------------ + +Parametric studies can be run by using the scripts to read and write OpenFAST input files provided in the `matlab-toolbox `__ +and the Python +`openfast_toolbox `__ +. The openfast_toolbox provides dedicated Python scripts and examples to automatize the process (see the README of the repository for more). +The `AeroelasticSE` module of `WEIS `__ can generate input files for the design load cases specified in the standards. +Consult the WEIS repository for more information. + + + + + +.. _linearization_analysis_OF: + +Performing linearization analyses +--------------------------------- + + + +Background +~~~~~~~~~~ + +Many applications require a linear model of a system: eigenvalue analyses, frequency domain analysis, linear state space models for observers, etc. Most models of OpenFAST are non-linear, and a linearization of the underlying system is therefore required. +Linearization is done about a given operating point, which corresponds to the set of values of the states and inputs of the system (typically, a given time of a simulation). +The output of the linearization is a linear state space model (four matrices relating states, inputs and outputs) valid in the neighborhood of the operating point. + +Because the rotor is spinning, the equilibrium solution, if present, will likely be periodic. +It is necessary to linearize at different operating points over a period of revolution (i.e. at different azimuthal positions). + +An additional complication is that some of the states of OpenFAST are in the rotating frame of reference (e.g. the ElastoDyn blade states). To obtain a linear state space model of the system that is in a fixed (non-rotating) frame of reference the multiblade coordinate transformation (MBC) is applied. For a purely periodic system, the MBC can be applied to the linearized outputs at different azimuthal positions which can be combined to form a linearized system in a fixed frame of reference. +We note that the MBC only applies to 3 or more blades. +Floquet theory would be needed 1 or 2 blades, although NREL does not currently have a post-processor that makes use of Floquet theory. + + +.. note:: + Our current recommended practice is to avoid periodicity and simplify the model such that the equilibrium is constant (e.g., removing tilt and gravity). The MBC is still required but it is not required to use different linearization at different azimuthal positions. + +One of the outputs of the linearization is the state matrix (`A`) which relates the system states to their time derivatives. +An eigenvalue analysis of `A` provides the full-system mode shapes, and their frequencies and damping. + +.. note:: + Unlike a linear finite-element software, OpenFAST does not have a notion of a full-system stiffness and mass matrix (some modules have local matrices but only related to the module). The underlying system of equation is non-linear, the frequencies of the system will vary with the operating conditions (e.g. wind speed, rotational speed). + + +The sections below detail the process of obtaining a linear model with OpenFAST, and will focus on its application to obtain the frequencies and damping of the system modes. + + + + +Linearized models for one simulation (manually) +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +This section describes the key steps to generate a linearized model of the system with OpenFAST. + +The steps to perform simple linearization analysis are given below: + +1. Edit the main `.fst` file, set `Linearize=True` + +2. Set the output format `OutFmt` to "ES20.11E3". The output files will be written with this high resolution, which is required for accurate eigenvalue analyses. + +.. warning:: + Because the linearization output files are in ASCII format, the results of the eigenvalue analyses will be sensitive to the output resolution (`OutFmt`). It is therefore important to set this parameter with a large precision as mentioned above. + +3. There are two main methods to determine at which times the linearization will be made: + + - using `CalcSteady=False`, the user prescribes the times where linearization is to occur using `NLinTimes` and `LinTimes` + (it is the responsibility of the user to provide times where the system is in equilibrium or at a periodic steady state, i.e. sufficiently long time); + - `CalcSteady=True` (recommended approach), OpenFAST will automatically start the linearization when the system is at a periodic steady state (based on given tolerance `TrimTol`) and will perform `NLinTimes` linearizations over a rotor revolution. When a controller is used the option `CalcSteady` will also adjust the controller inputs (either Pitch, Yaw, or Generator Torque, based on the input `TrimCase`) such as to reach the rotational speed indicated by the initial condition. The `TrimGain` and `TrimTol` might need to be adjusted. `Twr_Kdmp` and `Bld_Kdmp` can be used to add damping to the tower and blades during the steady-state calculation. These may be helpful to speed up the steady-state calculation and may be necessary if the tower and/or blades are otherwise unstable. Once the steady-state solution is found. `Twr_Kdmp` and `Bld_Kdmp` will not impact the linearization results (i..e., the linear solution will not have extra tower and blade damping). + + + +4. Chose the number of linearizations. For a standstill case, `NLinTimes=1`, for a rotating case, if the equilibrium point is periodic, it is recommended to use `NLinTimes=36` (corresponding to on linearization every 10-degrees of azimuth rotation), otherwise `NLinTimes=1`. If `CalcSteady=False` and the user sets `NLinTimes=36`, the user needs to set `LinTimes` with values that corresponds to the rotor being at 36 unique azimuthal position based on the rotor speed. + + +5. For a typical linearization, the user may set `LinInputs=0`, `LinOutputs=0`, `LinOutJac=False`, `LinOutMod=False`, `Twr_Kdmp=0`, `Bld_Kdmp=0` (see the OpenFAST input file documentation). + Setting `LinInputs = LinOutputs = 0` avoids generating the B, C, and D matrices (no inputs and outputs). + The standard set of linearization inputs inherent in the linearized system are available when `LinInputs=1`. This includes e.g. collective blade pitch. With `LinOutputs = 1`, the outputs of the `OutList` sections of each module are included in the linearized system. For instance, `GenSpeed` can be included by including `GenSpeed` in the `OutList` of ElastoDyn. Linearization about all the inputs and outputs of OpenFAST set `LinInputs=2`, `LinOutputs=2`, at the expense of having large output files. + +6. Run OpenFAST on this `.fst` file. OpenFAST will display a message when it is performing each individual linearization, and individual files with the `.lin` extension will be written to disk. + +7. It is recommended to check the regular output file `.out` or `.outb`. If `CalcSteady=False`, the user should look to see whether the turbine had indeed reached a steady state (or periodic steady state) at the time where linearization was run. If `CalcSteady=True` and a controller is used, the user can check that the rotational speed has indeed converged to the desired RPM, and potentially chose to adjust `TrimGain` and `TrimTol` for future runs. + +The linearization files `*.lin` are then to be postprocessed using the python or matlab tools provided. + +.. note:: + Not all modules and options of OpenFAST are available when performing linearization. OpenFAST will abort with error message that will indicate which options are available. Adapt your input files accordingly. + + + +Postprocessing +~~~~~~~~~~~~~~ + +To obtain the eigenfrequencies of the system the user can open a `.lin` file, extract the state matrix `A` and perform a eigenvalue analysis. For a spinning rotors, all lin-files generated from a simulation at different azimuthal positions need to be opened, and converted using the MBC-transformation. We provide scripts for such cases. + +When only one linearization file is to be used (e.g. at standstill), the script `postproLin_OneLinFile_NoRotation` can be used. Is is found in `matlab-toolbox/Campbell/example` or `openfast_toolbox/openfast_toolbox/linearization/examples/`. + +When several linearization files are to be postprocessed (in particular several files corresponding to different azimuthal positions), the script `postproLin_MultiLinFile_Campbel` can be used, located in the same folders mentioned above. +The script can also be used if linearizations were performed at different wind speed and RPM (via different OpenFAST calls). Displaying the frequencies and damping at these different wind turbine operating conditions is referred to as Campbell diagram. + + + +Campbell diagrams +~~~~~~~~~~~~~~~~~ + +In the near future, a dedicated tool will be provided to simplify the process of generating Campbell diagrams. + +Until then, to avoid the manual process of editing input files for different wind turbine operating conditions, we provide the script `runCampbell`, found in `matlab-toolbox/Campbell/example` or `openfast_toolbox/openfast_toolbox/linearization/examples/`. +The script relies on a template folder which a reference "fst" file. The folder is duplicated, files are created for each wind turbine operating conditions wind speed/rpm), OpenFAST is run, and the linearization files are postprocessed. + + +The script `runCampbell` generates either a set of CSV files or an Excel file. The script attempts to identify the modes (for instance 1st tower fore-aft mode, 1st flap mode, etc.), but a manual process is usually required to fully identify the mode. This process can be difficult and tedious. It is recommended to proceed first with simulations in vacuum, and with few operating points, to get familiar with the system. + +The manual identification process consists in changing the CSV file `Campbell_ModesID.csv` (or the Excel spread sheet `ModesID` if Excel output is used). To avoid having this file rewritten when rerunning `runCampbell`, it is recommended to rename this file as `Campbell_ModesID_Manual.csv`. The part of the script `runCampbell` that plots the Campbell diagram can be adjusted so as to use the "Manual" file. +It is recommended to use the CSV format since this is the method compatible with Python and MacOS. + +The manual identification process consists in attributing indexes in the table of modes, where the index corresponds to the list of sorted mode frequencies. + +For instance, opening the CSV file in excel, the `ModeID` file might look as follows: + +.. code:: + + Mode Number Table + Wind Speed (mps) 2.0 5.0 8.0 + 1st Tower FA 0 0 0 + 1st Tower SS 1 0 0 + +In this example, we assume that linearizations were run at 2, 5 and 8m/s. "0" in the table indicates that a mode was not identified. You can look at the file `Campbell_Summary.txt` to have a look at the frequencies, damping and "modal content" for each mode and operating point. For more details, you can open the individual CSV files for each operating point. (If you used the Excel format, these are in different sheets). +You might find that for 2 and 5m/s, the tower Fore-Aft is the second frequency, and the tower side-side is the first frequency that shows up in the list of modes. At 8m/s you might find that the opposite occurs. In that case, you will edit the file such that it is as follows: + +.. code:: + + Mode Number Table + Wind Speed (mps) 2.0 5.0 8.0 + 1st Tower FA 2 2 1 + 1st Tower SS 1 1 2 + + +The main question is how to determine which mode is which. There is no true solution to this question, here are some elements to help the identifications: + + - The system frequencies are usually easy to determine at 0 m/s and 0 rpm. The system frequencies will vary progressively from this reference point as the RPM/WS/pitch changes. Blade regressive and progressive modes will typically display a "splitting" equal to +/- the rotational speed frequency as the rotational speed increases. The collective modes in flap tend to increase in frequency with rotor speed due to centrifugal stiffening. + + - Blade flap modes are typically highly damped (significantly more than edgewise modes) when aerodynamics are present. + + - From an operating point to the next, the damping will not change drastically. + + - Tower modes are not strongly affected by the change of operating conditions + + - You will need to look at the "mode content", to see where the energy is for each mode. The file `Campbell_Summary.csv` displays a summary of the mode content. In some cases, there is no clear maximum (the keyword `NoMax` is shown). In that case, identifying the mode might be difficult. A similar content is found in the individual operating point files. + + - Visualization of the modes can help identify them (see the next section). The process can yet be lengthy. + +Once the identification table is set. Save the file, and plot the Campbell diagram. The process may be iterative until a satisfying diagram is obtained. There should be no need to close Excel in this process. + +We are aware that the process is lengthy, we thank you for your patience while we attempt to streamline this process. + + + +Mode shape visualization +~~~~~~~~~~~~~~~~~~~~~~~~ + +Mode shape visualization is currently possible. It requires a generation of viz files for each simulations, and rerunning OpenFAST to generate VTK files. The matlab script `runCampbell` assists in this process, but for now limited support and documentation is provided. + +The user is invited to consult the following example: +- https://github.com/OpenFAST/r-test/tree/main/glue-codes/openfast/5MW_Land_ModeShapes + +And it's associated documentation: +- https://github.com/OpenFAST/r-test/blob/main/glue-codes/openfast/5MW_Land_ModeShapes/vtk-visualization.md + + +Additional references +~~~~~~~~~~~~~~~~~~~~~ + +Some linearization issues have been discussed in the forum and as github issues: + +- https://wind.nrel.gov/forum/wind/ + +- https://github.com/OpenFAST/openfast/issues/480 + +Thank you for your patience while we attempt to streamline the linearization and Campbell digram generation process. + + + + + diff --git a/glue-codes/fast-farm/src/FASTWrapper.f90 b/glue-codes/fast-farm/src/FASTWrapper.f90 index 01301c56b7..db5a1181ec 100644 --- a/glue-codes/fast-farm/src/FASTWrapper.f90 +++ b/glue-codes/fast-farm/src/FASTWrapper.f90 @@ -54,8 +54,6 @@ MODULE FASTWrapper !! The parameters are set here and not changed during the simulation. !! The initial states and initial guess for the input are defined. SUBROUTINE FWrap_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut, ErrStat, ErrMsg ) -!.................................................................................................................................. - TYPE(FWrap_InitInputType), INTENT(IN ) :: InitInp !< Input data for initialization routine TYPE(FWrap_InputType), INTENT( OUT) :: u !< An initial guess for the input; input mesh must be defined TYPE(FWrap_ParameterType), INTENT( OUT) :: p !< Parameters @@ -76,7 +74,6 @@ SUBROUTINE FWrap_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - ! local variables TYPE(FAST_ExternInitType) :: ExternInitData INTEGER(IntKi) :: j,k,nb @@ -86,137 +83,109 @@ SUBROUTINE FWrap_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init ! Initialize variables - ErrStat = ErrID_None ErrMsg = '' - - ! Initialize the NWTC Subroutine Library - - !call NWTC_Init( ) ! Display the module information - if (InitInp%TurbNum == 1) call DispNVD( FWrap_Ver ) InitOut%Ver = FWrap_Ver - ! Define initial system states here: - x%Dummy = 0.0_ReKi xd%Dummy = 0.0_ReKi z%Dummy = 0.0_ReKi OtherState%Dummy = 0.0_ReKi - ! Define initial guess for the system inputs here: - - - !................. - ! Initialize an instance of FAST - !................ + !................. + ! Initialize an instance of FAST + !................ - !.... Lidar data (unused) .... - ExternInitData%Tmax = InitInp%TMax + !.... Lidar data (unused) .... + ExternInitData%Tmax = InitInp%TMax + + !.... supercontroller .... + if ( InitInp%UseSC ) then + ExternInitData%NumSC2Ctrl = InitInp%NumSC2Ctrl ! "number of controller inputs [from supercontroller]" + ExternInitData%NumCtrl2SC = InitInp%NumCtrl2SC ! "number of controller outputs [to supercontroller]" + ExternInitData%NumSC2CtrlGlob = InitInp%NumSC2CtrlGlob ! "number of global controller inputs [from supercontroller]" + call AllocAry(ExternInitData%fromSCGlob, InitInp%NumSC2CtrlGlob, 'ExternInitData%InitScOutputsGlob (global inputs to turbine controller from supercontroller)', ErrStat2, ErrMsg2); if (Failed()) return; + call AllocAry(ExternInitData%fromSC, InitInp%NumSC2Ctrl, ' ExternInitData%InitScOutputsTurbine (turbine-related inputs for turbine controller from supercontroller)', ErrStat2, ErrMsg2); if (Failed()) return; + ExternInitData%fromSCGlob = InitInp%fromSCGlob + ExternInitData%fromSC = InitInp%fromSC + call AllocAry(u%fromSCglob, InitInp%NumSC2CtrlGlob, 'u%fromSCglob (global inputs to turbine controller from supercontroller)', ErrStat2, ErrMsg2); if (Failed()) return; + call AllocAry(u%fromSC, InitInp%NumSC2Ctrl, 'u%fromSC (turbine-related inputs for turbine controller from supercontroller)', ErrStat2, ErrMsg2); if (Failed()) return; + else - !.... supercontroller .... - if ( InitInp%UseSC ) then - ExternInitData%NumSC2Ctrl = InitInp%NumSC2Ctrl ! "number of controller inputs [from supercontroller]" - ExternInitData%NumCtrl2SC = InitInp%NumCtrl2SC ! "number of controller outputs [to supercontroller]" - ExternInitData%NumSC2CtrlGlob = InitInp%NumSC2CtrlGlob ! "number of global controller inputs [from supercontroller]" - call AllocAry(ExternInitData%fromSCGlob, InitInp%NumSC2CtrlGlob, 'ExternInitData%InitScOutputsGlob (global inputs to turbine controller from supercontroller)', ErrStat2, ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call AllocAry(ExternInitData%fromSC, InitInp%NumSC2Ctrl, ' ExternInitData%InitScOutputsTurbine (turbine-related inputs for turbine controller from supercontroller)', ErrStat2, ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - ExternInitData%fromSCGlob = InitInp%fromSCGlob - ExternInitData%fromSC = InitInp%fromSC - call AllocAry(u%fromSCglob, InitInp%NumSC2CtrlGlob, 'u%fromSCglob (global inputs to turbine controller from supercontroller)', ErrStat2, ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call AllocAry(u%fromSC, InitInp%NumSC2Ctrl, 'u%fromSC (turbine-related inputs for turbine controller from supercontroller)', ErrStat2, ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - else - - ExternInitData%NumSC2Ctrl = 0 ! "number of controller inputs [from supercontroller]" - ExternInitData%NumCtrl2SC = 0 ! "number of controller outputs [to supercontroller]" - ExternInitData%NumSC2CtrlGlob = 0 ! "number of global controller inputs [from supercontroller]" - - end if - !.... multi-turbine options .... - ExternInitData%TurbIDforName = InitInp%TurbNum - ExternInitData%TurbinePos = InitInp%p_ref_Turbine - ExternInitData%WaveFieldMod = InitInp%WaveFieldMod - - ExternInitData%FarmIntegration = .true. - ExternInitData%RootName = InitInp%RootName - - !.... 4D-wind data .... - ExternInitData%windGrid_n(1) = InitInp%nX_high - ExternInitData%windGrid_n(2) = InitInp%nY_high - ExternInitData%windGrid_n(3) = InitInp%nZ_high - ExternInitData%windGrid_n(4) = InitInp%n_high_low - - ExternInitData%windGrid_delta(1) = InitInp%dX_high - ExternInitData%windGrid_delta(2) = InitInp%dY_high - ExternInitData%windGrid_delta(3) = InitInp%dZ_high - ExternInitData%windGrid_delta(4) = InitInp%dt_high - - ExternInitData%windGrid_pZero = InitInp%p_ref_high - InitInp%p_ref_Turbine - - - CALL FAST_InitializeAll_T( t_initial, InitInp%TurbNum, m%Turbine, ErrStat2, ErrMsg2, InitInp%FASTInFile, ExternInitData ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat >= AbortErrLev) then - call cleanup() - return - end if - - - !................. - ! Check that we've set up FAST properly: - !................. - if (m%Turbine%p_FAST%CompAero /= MODULE_AD) then - call SetErrStat(ErrID_Fatal,"AeroDyn (v15) must be used in each instance of FAST for FAST.Farm.",ErrStat,ErrMsg,RoutineName) - call cleanup() - return - end if - - ! move the misc var to the input variable... - if (m%Turbine%p_FAST%CompInflow /= MODULE_IfW) then - call SetErrStat(ErrID_Fatal,"InflowWind must be used in each instance of FAST for FAST.Farm.",ErrStat,ErrMsg,RoutineName) - call cleanup() - return - end if - - call move_alloc(m%Turbine%IfW%p%FlowField%Grid4D%Vel, u%Vdist_High) - - - !................. - ! Define parameters here: - !................. - - call FWrap_SetParameters(InitInp, p, m%Turbine%p_FAST%dt, Interval, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat >= AbortErrLev) then - call cleanup() - return - end if - - !................. - ! Set outputs (allocate arrays and set miscVar meshes for computing other outputs): - !................. + ExternInitData%NumSC2Ctrl = 0 ! "number of controller inputs [from supercontroller]" + ExternInitData%NumCtrl2SC = 0 ! "number of controller outputs [to supercontroller]" + ExternInitData%NumSC2CtrlGlob = 0 ! "number of global controller inputs [from supercontroller]" + + end if + !.... multi-turbine options .... + ExternInitData%TurbIDforName = InitInp%TurbNum + ExternInitData%TurbinePos = InitInp%p_ref_Turbine + ExternInitData%WaveFieldMod = InitInp%WaveFieldMod + + ExternInitData%FarmIntegration = .true. + ExternInitData%RootName = InitInp%RootName - call AllocAry(y%AzimAvg_Ct, p%nr, 'y%AzimAvg_Ct (azimuth-averaged ct)', ErrStat2, ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call AllocAry(y%AzimAvg_Cq, p%nr, 'y%AzimAvg_Cq (azimuth-averaged cq)', ErrStat2, ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + !.... 4D-wind data .... + ExternInitData%windGrid_n(1) = InitInp%nX_high + ExternInitData%windGrid_n(2) = InitInp%nY_high + ExternInitData%windGrid_n(3) = InitInp%nZ_high + ExternInitData%windGrid_n(4) = InitInp%n_high_low + + ExternInitData%windGrid_delta(1) = InitInp%dX_high + ExternInitData%windGrid_delta(2) = InitInp%dY_high + ExternInitData%windGrid_delta(3) = InitInp%dZ_high + ExternInitData%windGrid_delta(4) = InitInp%dt_high + + ExternInitData%windGrid_pZero = InitInp%p_ref_high - InitInp%p_ref_Turbine + ExternInitData%windGrid_data => InitInp%Vdist_High + + + CALL FAST_InitializeAll_T( t_initial, InitInp%TurbNum, m%Turbine, ErrStat2, ErrMsg2, InitInp%FASTInFile, ExternInitData ) ; if (Failed()) return; + + !................. + ! Check that we've set up FAST properly: + !................. + if (m%Turbine%p_FAST%CompAero /= MODULE_AD .and. m%Turbine%p_FAST%CompAero /= MODULE_ADsk) then + call SetErrStat(ErrID_Fatal,"AeroDyn or AeroDisk must be used in each instance of FAST for FAST.Farm.",ErrStat,ErrMsg,RoutineName) + call cleanup() + return + end if + + ! move the misc var to the input variable... + if (m%Turbine%p_FAST%CompInflow /= MODULE_IfW) then + call SetErrStat(ErrID_Fatal,"InflowWind must be used in each instance of FAST for FAST.Farm.",ErrStat,ErrMsg,RoutineName) + call cleanup() + return + end if + + !................. + ! Define parameters here: + !................. + + call FWrap_SetParameters(InitInp, p, m%Turbine%p_FAST%dt, Interval, ErrStat2, ErrMsg2); if (Failed()) return; - if ( InitInp%UseSC ) then - call AllocAry(y%toSC, InitInp%NumCtrl2SC, 'y%toSC (turbine controller outputs to Super Controller)', ErrStat2, ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - end if + !................. + ! Set outputs (allocate arrays and set miscVar meshes for computing other outputs): + !................. + call AllocAry(y%AzimAvg_Ct, p%nr, 'y%AzimAvg_Ct (azimuth-averaged ct)', ErrStat2, ErrMsg2); if (Failed()) return; + call AllocAry(y%AzimAvg_Cq, p%nr, 'y%AzimAvg_Cq (azimuth-averaged cq)', ErrStat2, ErrMsg2); if (Failed()) return; + + if ( InitInp%UseSC ) then + call AllocAry(y%toSC, InitInp%NumCtrl2SC, 'y%toSC (turbine controller outputs to Super Controller)', ErrStat2, ErrMsg2); if (Failed()) return; + end if + + if (m%Turbine%p_FAST%CompAero == MODULE_AD) then nb = size(m%Turbine%AD%y%rotors(1)%BladeLoad) - Allocate( m%ADRotorDisk(nb), m%TempDisp(nb), m%TempLoads(nb), m%AD_L2L(nb), STAT=ErrStat2 ) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal,"Error allocating space for ADRotorDisk meshes.",ErrStat,ErrMsg,RoutineName) - call cleanup() - return - end if - + allocate( m%ADRotorDisk(nb), m%TempDisp(nb), m%TempLoads(nb), m%AD_L2L(nb), STAT=ErrStat2 ); if (Failed0("ADRotorDisk meshes.")) return; + do k=1,nb call meshCopy( SrcMesh = m%Turbine%AD%y%rotors(1)%BladeLoad(k) & @@ -226,7 +195,7 @@ SUBROUTINE FWrap_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init , TranslationDisp = .TRUE. & ! set automatically to 0 , ErrStat = ErrStat2 & , ErrMess = ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (Failed()) return; call meshCopy( SrcMesh = m%TempDisp(k) & , DestMesh = m%TempLoads(k) & @@ -235,7 +204,7 @@ SUBROUTINE FWrap_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init , Moment = .true. & , ErrStat = ErrStat2 & , ErrMess = ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (Failed()) return; call MeshCreate ( BlankMesh = m%ADRotorDisk(k) & @@ -248,9 +217,7 @@ SUBROUTINE FWrap_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init ,TranslationDisp = .true. & ! only for loads transfer ,Orientation = .true. & ! only for loads transfer ) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - - if (errStat >= AbortErrLev) exit + if (Failed()) return; ! set node initial position/orientation ! shortcut for @@ -260,32 +227,39 @@ SUBROUTINE FWrap_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init ! create line2 elements do j=1,p%nr-1 - call MeshConstructElement( m%ADRotorDisk(k), ELEMENT_LINE2, errStat2, errMsg2, p1=j, p2=j+1 ) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) + call MeshConstructElement( m%ADRotorDisk(k), ELEMENT_LINE2, errStat2, errMsg2, p1=j, p2=j+1 ); if (Failed()) return; end do !j - call MeshCommit(m%ADRotorDisk(k), errStat2, errMsg2 ) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - if (errStat >= AbortErrLev) exit + call MeshCommit(m%ADRotorDisk(k), errStat2, errMsg2 ); if (Failed()) return; - call MeshMapCreate(m%TempLoads(k), m%ADRotorDisk(k), m%AD_L2L(k), ErrStat2, ErrMsg2) ! this is going to transfer the motions as well as the loads, which is overkill - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) + call MeshMapCreate(m%TempLoads(k), m%ADRotorDisk(k), m%AD_L2L(k), ErrStat2, ErrMsg2); if (Failed()) return; ! this is going to transfer the motions as well as the loads, which is overkill end do - - !................ - ! also need to set the WrOutput channels... - !................ - - - call cleanup() + endif + + + call cleanup() contains subroutine cleanup() - call FAST_DestroyExternInitType(ExternInitData,ErrStat2,ErrMsg2) ! this doesn't actually do anything unless we add allocatable data later - end subroutine cleanup - + logical function Failed() + call SetErrStat(errStat2, errMsg2, errStat, errMsg, RoutineName) + Failed = errStat >= AbortErrLev + if (Failed) call cleanup() + end function Failed + + ! check for failed where /= 0 is fatal + logical function Failed0(txt) + character(*), intent(in) :: txt + if (errStat /= 0) then + ErrStat2 = ErrID_Fatal + ErrMsg2 = "Could not allocate memory for "//trim(txt) + call SetErrStat(errStat2, errMsg2, errStat, errMsg, RoutineName) + endif + Failed0 = errStat >= AbortErrLev + if(Failed0) call cleanUp() + end function Failed0 END SUBROUTINE FWrap_Init !---------------------------------------------------------------------------------------------------------------------------------- ! this routine sets the parameters for the FAST Wrapper module. It does not set p%n_FAST_low because we need to initialize FAST first. @@ -347,8 +321,6 @@ end subroutine FWrap_SetParameters !---------------------------------------------------------------------------------------------------------------------------------- !> This routine is called at the end of the simulation. SUBROUTINE FWrap_End( u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) -!.................................................................................................................................. - TYPE(FWrap_InputType), INTENT(INOUT) :: u !< System inputs TYPE(FWrap_ParameterType), INTENT(INOUT) :: p !< Parameters TYPE(FWrap_ContinuousStateType), INTENT(INOUT) :: x !< Continuous states @@ -360,60 +332,40 @@ SUBROUTINE FWrap_End( u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - ! local variables INTEGER(IntKi) :: ErrStat2 ! local error status CHARACTER(ErrMsgLen) :: ErrMsg2 ! local error message CHARACTER(*), PARAMETER :: RoutineName = 'FWrap_End' ! Initialize ErrStat - ErrStat = ErrID_None ErrMsg = '' - !! Place any last minute operations or calculations here: - CALL ExitThisProgram_T( m%Turbine, ErrID_None, .false. ) - !! 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 FWrap_DestroyInput( u, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - + call FWrap_DestroyInput( u, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) !! Destroy the parameter data: - - call FWrap_DestroyParam( p, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + call FWrap_DestroyParam( p, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) !! Destroy the state data: - call FWrap_DestroyContState( x, ErrStat2,ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) call FWrap_DestroyDiscState( xd, ErrStat2,ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) call FWrap_DestroyConstrState( z, ErrStat2,ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) call FWrap_DestroyOtherState( OtherState, ErrStat2,ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - !! Destroy the output data: - - call FWrap_DestroyOutput( y, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - + call FWrap_DestroyOutput( y, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) !! Destroy the misc data: - - call FWrap_DestroyMisc( m, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - + call FWrap_DestroyMisc( m, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) END SUBROUTINE FWrap_End !---------------------------------------------------------------------------------------------------------------------------------- !> This routine updates states and outputs to n+1 based on inputs and states at n (this has an inherent time-step delay on outputs). !! The routine uses subcycles because FAST typically has a smaller time step than FAST.Farm. SUBROUTINE FWrap_Increment( t, n, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) -!.................................................................................................................................. - REAL(DbKi), INTENT(IN ) :: t !< Current simulation time in seconds (no longer used, since inputs are set elsewhere) INTEGER(IntKi), INTENT(IN ) :: n !< Current step of the simulation: t = n*Interval TYPE(FWrap_InputType), INTENT(INOUT) :: u !< Inputs at t (not changed, but possibly copied) @@ -471,13 +423,10 @@ SUBROUTINE FWrap_Increment( t, n, u, p, x, xd, z, OtherState, y, m, ErrStat, Err !END IF - END SUBROUTINE FWrap_Increment !---------------------------------------------------------------------------------------------------------------------------------- !> This routine calculates outputs at n=0 based on inputs at n=0. SUBROUTINE FWrap_t0( u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) -!.................................................................................................................................. - TYPE(FWrap_InputType), INTENT(INOUT) :: u !< Inputs at t TYPE(FWrap_ParameterType), INTENT(IN ) :: p !< Parameters TYPE(FWrap_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at t @@ -495,22 +444,21 @@ SUBROUTINE FWrap_t0( u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) CHARACTER(*), PARAMETER :: RoutineName = 'FWrap_t0' ! Initialize ErrStat - ErrStat = ErrID_None ErrMsg = '' - ! set the inputs needed for FAST: call FWrap_SetInputs(u, m, 0.0_DbKi) ! compute the FAST t0 solution: - call FAST_Solution0_T(m%Turbine, ErrStat2, ErrMsg2 ) + call FAST_Solution0_T(m%Turbine, ErrStat2, ErrMsg2 ) call setErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (ErrStat >= AbortErrLev) return; ! set the outputs for FAST.Farm: call FWrap_CalcOutput(p, u, y, m, ErrStat2, ErrMsg2) call setErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - + if (ErrStat >= AbortErrLev) return; END SUBROUTINE FWrap_t0 !---------------------------------------------------------------------------------------------------------------------------------- @@ -551,157 +499,208 @@ SUBROUTINE FWrap_CalcOutput(p, u, y, m, ErrStat, ErrMsg) integer, parameter :: indx = 1 ! m%BEMT_u(1) is at t; m%BEMT_u(2) is t+dt ! Initialize ErrStat - ErrStat = ErrID_None ErrMsg = '' - ! put this back! - call move_alloc(m%Turbine%IfW%p%FlowField%Grid4D%Vel, u%Vdist_High) - - ! Turbine-dependent commands to the super controller: if (m%Turbine%p_FAST%UseSC) then y%toSC = m%Turbine%SC_DX%u%toSC end if - ! ....... outputs from AeroDyn v15 ............ - - ! note that anything that uses m%Turbine%AD%Input(1) assumes we have not updated these inputs after calling AD_CalcOutput in FAST. - - ! Orientation of rotor centerline, normal to disk: - y%xHat_Disk = m%Turbine%AD%Input(1)%rotors(1)%HubMotion%Orientation(1,:,1) !actually also x_hat_disk and x_hat_hub - - - ! Nacelle-yaw error i.e. the angle about positive Z^ from the rotor centerline to the rotor-disk-averaged relative wind - ! velocity (ambients + deficits + motion), both projected onto the horizontal plane, rad - - ! if the orientation of the rotor centerline or rotor-disk-averaged relative wind speed is directed vertically upward or downward (+/-Z^) - ! the nacelle-yaw error is undefined - if ( EqualRealNos(m%Turbine%AD%m%rotors(1)%V_DiskAvg(1), 0.0_ReKi) .and. EqualRealNos(m%Turbine%AD%m%rotors(1)%V_DiskAvg(2), 0.0_ReKi) ) then - call SetErrStat(ErrID_Fatal,"Nacelle-yaw error is undefined because the rotor-disk-averaged relative wind speed "// & - "is directed vertically", ErrStat,ErrMsg,RoutineName) - elseif ( EqualRealNos(y%xHat_Disk(1), 0.0_ReKi) .and. EqualRealNos(y%xHat_Disk(2), 0.0_ReKi) ) then - call SetErrStat(ErrID_Fatal,"Nacelle-yaw error is undefined because the rotor centerline "// & - "is directed vertically", ErrStat,ErrMsg,RoutineName) - else - vy = m%Turbine%AD%m%rotors(1)%V_DiskAvg(2) * y%xHat_Disk(1) - m%Turbine%AD%m%rotors(1)%V_DiskAvg(1) * y%xHat_Disk(2) - vx = m%Turbine%AD%m%rotors(1)%V_DiskAvg(1) * y%xHat_Disk(1) + m%Turbine%AD%m%rotors(1)%V_DiskAvg(2) * y%xHat_Disk(2) + if (m%Turbine%p_FAST%CompAero == MODULE_AD) then + ! ....... outputs from AeroDyn v15 ............ - y%YawErr = atan2(vy, vx) - end if - + ! note that anything that uses m%Turbine%AD%Input(1) assumes we have not updated these inputs after calling AD_CalcOutput in FAST. - ! Center position of hub, m - p0 = m%Turbine%AD%Input(1)%rotors(1)%HubMotion%Position(:,1) + m%Turbine%AD%Input(1)%rotors(1)%HubMotion%TranslationDisp(:,1) - y%p_hub = p%p_ref_Turbine + p0 - - ! Rotor diameter, m - y%D_rotor = 2.0_ReKi * maxval(m%Turbine%AD%m%rotors(1)%BEMT_u(indx)%rLocal) ! BEMT_u(indx) is calculated on inputs that were passed INTO AD_CalcOutput; Input(1) is calculated from values passed out of ED_CalcOutput AFTER AD_CalcOutput - - if ( y%D_rotor > p%r(p%nr) ) then - call SetErrStat(ErrID_Fatal,"The radius of the wake planes is not large relative to the rotor diameter.", ErrStat,ErrMsg,RoutineName) - end if - - ! Rotor-disk-averaged relative wind speed (ambient + deficits + motion), normal to disk, m/s - y%DiskAvg_Vx_Rel = m%Turbine%AD%m%rotors(1)%V_dot_x - - ! Azimuthally averaged thrust force coefficient (normal to disk), distributed radially - theta = 0.0_ReKi - do k=1,size(m%ADRotorDisk) ! loop on blades - - m%TempDisp(k)%RefOrientation = m%Turbine%AD%Input(1)%rotors(1)%BladeMotion(k)%Orientation - m%TempDisp(k)%Position = m%Turbine%AD%Input(1)%rotors(1)%BladeMotion(k)%Position + m%Turbine%AD%Input(1)%rotors(1)%BladeMotion(k)%TranslationDisp - !m%TempDisp(k)%TranslationDisp = 0.0_R8Ki - m%TempLoads(k)%Force = m%Turbine%AD%y%rotors(1)%BladeLoad(k)%Force - m%TempLoads(k)%Moment = m%Turbine%AD%y%rotors(1)%BladeLoad(k)%Moment + ! Orientation of rotor centerline, normal to disk: + y%xHat_Disk = m%Turbine%AD%Input(1)%rotors(1)%HubMotion%Orientation(1,:,1) !actually also x_hat_disk and x_hat_hub - theta(1) = m%Turbine%AD%m%rotors(1)%hub_theta_x_root(k) - orientation = EulerConstruct( theta ) - m%ADRotorDisk(k)%RefOrientation(:,:,1) = matmul(orientation, m%Turbine%AD%Input(1)%rotors(1)%HubMotion%Orientation(:,:,1) ) - do j=1,p%nr - m%ADRotorDisk(k)%RefOrientation(:,:,j) = m%ADRotorDisk(k)%RefOrientation(:,:,1) - m%ADRotorDisk(k)%Position(:,j) = p0 + p%r(j)*m%ADRotorDisk(k)%RefOrientation(3,:,1) - end do - !m%ADRotorDisk(k)%TranslationDisp = 0.0_ReKi - m%ADRotorDisk(k)%RemapFlag = .true. - - call transfer_line2_to_line2(m%TempLoads(k), m%ADRotorDisk(k), m%AD_L2L(k), ErrStat2, ErrMsg2, m%TempDisp(k), m%ADRotorDisk(k)) - call setErrStat(ErrStat2,ErrMsg2,ErrStat2,ErrMsg,RoutineName) - if (ErrStat >= AbortErrLev) return - end do + + ! Nacelle-yaw error i.e. the angle about positive Z^ from the rotor centerline to the rotor-disk-averaged relative wind + ! velocity (ambients + deficits + motion), both projected onto the horizontal plane, rad + + ! if the orientation of the rotor centerline or rotor-disk-averaged relative wind speed is directed vertically upward or downward (+/-Z^) + ! the nacelle-yaw error is undefined + if ( EqualRealNos(m%Turbine%AD%m%rotors(1)%V_DiskAvg(1), 0.0_ReKi) .and. EqualRealNos(m%Turbine%AD%m%rotors(1)%V_DiskAvg(2), 0.0_ReKi) ) then + call SetErrStat(ErrID_Fatal,"Nacelle-yaw error is undefined because the rotor-disk-averaged relative wind speed "// & + "is directed vertically", ErrStat,ErrMsg,RoutineName) + elseif ( EqualRealNos(y%xHat_Disk(1), 0.0_ReKi) .and. EqualRealNos(y%xHat_Disk(2), 0.0_ReKi) ) then + call SetErrStat(ErrID_Fatal,"Nacelle-yaw error is undefined because the rotor centerline "// & + "is directed vertically", ErrStat,ErrMsg,RoutineName) + else + vy = m%Turbine%AD%m%rotors(1)%V_DiskAvg(2) * y%xHat_Disk(1) - m%Turbine%AD%m%rotors(1)%V_DiskAvg(1) * y%xHat_Disk(2) + vx = m%Turbine%AD%m%rotors(1)%V_DiskAvg(1) * y%xHat_Disk(1) + m%Turbine%AD%m%rotors(1)%V_DiskAvg(2) * y%xHat_Disk(2) - ! --- Ct and Cq on polar grid (goes beyond rotor radius) - if (EqualRealNos(y%DiskAvg_Vx_Rel,0.0_ReKi)) then - y%AzimAvg_Ct = 0.0_ReKi - y%AzimAvg_Cq = 0.0_ReKi - else - y%AzimAvg_Ct(1) = 0.0_ReKi - y%AzimAvg_Cq(1) = 0.0_ReKi + y%YawErr = atan2(vy, vx) + end if + + + ! Center position of hub, m + p0 = m%Turbine%AD%Input(1)%rotors(1)%HubMotion%Position(:,1) + m%Turbine%AD%Input(1)%rotors(1)%HubMotion%TranslationDisp(:,1) + y%p_hub = p%p_ref_Turbine + p0 + + ! Rotor diameter, m + y%D_rotor = 2.0_ReKi * maxval(m%Turbine%AD%m%rotors(1)%BEMT_u(indx)%rLocal) ! BEMT_u(indx) is calculated on inputs that were passed INTO AD_CalcOutput; Input(1) is calculated from values passed out of ED_CalcOutput AFTER AD_CalcOutput + + if ( y%D_rotor > p%r(p%nr) ) then + call SetErrStat(ErrID_Fatal,"The radius of the wake planes is not large relative to the rotor diameter.", ErrStat,ErrMsg,RoutineName) + end if - do j=2,p%nr + ! Rotor-disk-averaged relative wind speed (ambient + deficits + motion), normal to disk, m/s + y%DiskAvg_Vx_Rel = m%Turbine%AD%m%rotors(1)%V_dot_x + + ! Azimuthally averaged thrust force coefficient (normal to disk), distributed radially + theta = 0.0_ReKi + do k=1,size(m%ADRotorDisk) ! loop on blades + + m%TempDisp(k)%RefOrientation = m%Turbine%AD%Input(1)%rotors(1)%BladeMotion(k)%Orientation + m%TempDisp(k)%Position = m%Turbine%AD%Input(1)%rotors(1)%BladeMotion(k)%Position + m%Turbine%AD%Input(1)%rotors(1)%BladeMotion(k)%TranslationDisp + !m%TempDisp(k)%TranslationDisp = 0.0_R8Ki + m%TempLoads(k)%Force = m%Turbine%AD%y%rotors(1)%BladeLoad(k)%Force + m%TempLoads(k)%Moment = m%Turbine%AD%y%rotors(1)%BladeLoad(k)%Moment - denom = m%Turbine%AD%p%rotors(1)%AirDens * pi * p%r(j) * y%DiskAvg_Vx_Rel**2 - - ! Thrust coefficient - ! Ct(r) = dT/dr / (1/2 rho pi r U_rel^2 ), with dT/dr = sum_iB dFn/dr - num = 0.0_ReKi - do k=1,size(m%ADRotorDisk) ! loop on blades force contribution - num = num + dot_product( y%xHat_Disk, m%ADRotorDisk(k)%Force(:,j) ) - end do - y%AzimAvg_Ct(j) = num / denom - - ! Torque coefficient - ! Cq = dQ/dr / (1/2 rho pi r^2 U_rel^2) dQ/dr = sum_iB r dFt/dr - num = 0.0_ReKi - do k=1,size(m%ADRotorDisk) ! loop on blades force contribution - num = num - p%r(j)*dot_product(m%ADRotorDisk(k)%RefOrientation(2,:,1), m%ADRotorDisk(k)%Force(:,j) ) + dot_product(y%xHat_Disk, m%ADRotorDisk(k)%Moment(:,j) ) + theta(1) = m%Turbine%AD%m%rotors(1)%hub_theta_x_root(k) + orientation = EulerConstruct( theta ) + m%ADRotorDisk(k)%RefOrientation(:,:,1) = matmul(orientation, m%Turbine%AD%Input(1)%rotors(1)%HubMotion%Orientation(:,:,1) ) + do j=1,p%nr + m%ADRotorDisk(k)%RefOrientation(:,:,j) = m%ADRotorDisk(k)%RefOrientation(:,:,1) + m%ADRotorDisk(k)%Position(:,j) = p0 + p%r(j)*m%ADRotorDisk(k)%RefOrientation(3,:,1) end do - y%AzimAvg_Cq(j) = num / (denom * p%r(j) ) + !m%ADRotorDisk(k)%TranslationDisp = 0.0_ReKi + m%ADRotorDisk(k)%RemapFlag = .true. + + call transfer_line2_to_line2(m%TempLoads(k), m%ADRotorDisk(k), m%AD_L2L(k), ErrStat2, ErrMsg2, m%TempDisp(k), m%ADRotorDisk(k)) + call setErrStat(ErrStat2,ErrMsg2,ErrStat2,ErrMsg,RoutineName) + if (ErrStat >= AbortErrLev) return end do - end if + ! --- Ct and Cq on polar grid (goes beyond rotor radius) + if (EqualRealNos(y%DiskAvg_Vx_Rel,0.0_ReKi)) then + y%AzimAvg_Ct = 0.0_ReKi + y%AzimAvg_Cq = 0.0_ReKi + else + y%AzimAvg_Ct(1) = 0.0_ReKi + y%AzimAvg_Cq(1) = 0.0_ReKi - ! --- Variables needed to orient wake planes in "skew" coordinate system - ! chi_skew and psi_skew - y%chi_skew = Calc_Chi0(m%Turbine%AD%m%rotors(1)%V_diskAvg, m%turbine%AD%m%rotors(1)%V_dot_x) ! AeroDyn_IO - - ! TODO place me in an AeroDyn Function like Calc_Chi0 - ! Construct y_hat, orthogonal to x_hat when its z component is neglected (in a projected horizontal plane) - yHat_plane(1:3) = (/ -y%xHat_Disk(2), y%xHat_Disk(1), 0.0_ReKi /) - yHat_plane(1:3) = yHat_plane/TwoNorm(yHat_plane) - ! Construct z_hat - zHat_plane(1) = -y%xHat_Disk(1)*y%xHat_Disk(3) - zHat_plane(2) = -y%xHat_Disk(2)*y%xHat_Disk(3) - zHat_plane(3) = y%xHat_Disk(1)*y%xHat_Disk(1) + y%xHat_Disk(2)*y%xHat_Disk(2) - zHat_plane(1:3) = zHat_plane/TwoNorm(zHat_plane) + do j=2,p%nr + + denom = m%Turbine%AD%p%rotors(1)%AirDens * pi * p%r(j) * y%DiskAvg_Vx_Rel**2 + + ! Thrust coefficient + ! Ct(r) = dT/dr / (1/2 rho pi r U_rel^2 ), with dT/dr = sum_iB dFn/dr + num = 0.0_ReKi + do k=1,size(m%ADRotorDisk) ! loop on blades force contribution + num = num + dot_product( y%xHat_Disk, m%ADRotorDisk(k)%Force(:,j) ) + end do + y%AzimAvg_Ct(j) = num / denom + + ! Torque coefficient + ! Cq = dQ/dr / (1/2 rho pi r^2 U_rel^2) dQ/dr = sum_iB r dFt/dr + num = 0.0_ReKi + do k=1,size(m%ADRotorDisk) ! loop on blades force contribution + num = num - p%r(j)*dot_product(m%ADRotorDisk(k)%RefOrientation(2,:,1), m%ADRotorDisk(k)%Force(:,j) ) + dot_product(y%xHat_Disk, m%ADRotorDisk(k)%Moment(:,j) ) + end do + y%AzimAvg_Cq(j) = num / (denom * p%r(j) ) + end do + + end if + + ! --- Variables needed to orient wake planes in "skew" coordinate system + ! chi_skew and psi_skew + y%chi_skew = Calc_Chi0(m%Turbine%AD%m%rotors(1)%V_diskAvg, m%turbine%AD%m%rotors(1)%V_dot_x) ! AeroDyn_IO + + ! TODO place me in an AeroDyn Function like Calc_Chi0 + ! Construct y_hat, orthogonal to x_hat when its z component is neglected (in a projected horizontal plane) + yHat_plane(1:3) = (/ -y%xHat_Disk(2), y%xHat_Disk(1), 0.0_ReKi /) + yHat_plane(1:3) = yHat_plane/TwoNorm(yHat_plane) + ! Construct z_hat + zHat_plane(1) = -y%xHat_Disk(1)*y%xHat_Disk(3) + zHat_plane(2) = -y%xHat_Disk(2)*y%xHat_Disk(3) + zHat_plane(3) = y%xHat_Disk(1)*y%xHat_Disk(1) + y%xHat_Disk(2)*y%xHat_Disk(2) + zHat_plane(1:3) = zHat_plane/TwoNorm(zHat_plane) !~ zHat_Disk = m%Turbine%AD%Input(1)%rotors(1)%HubMotion%Orientation(3,:,1) ! TODO TODO, shoudn't rotate - ! Skew system (y and z are in disk plane, x is normal to disk, y is in the cross-flow direction formed by the diskavg velocity) - xSkew = y%xHat_Disk - ySkew = y%xHat_Disk - m%Turbine%AD%m%rotors(1)%V_diskAvg - denom = TwoNorm(ySkew) - if (EqualRealNos(denom, 0.0_ReKi)) then - ! There is no skew - ySkew = yHat_plane - zSkew = zHat_plane - else - ySkew = ySkew / denom - zSkew(1) = xSkew(2) * ySkew(3) - xSkew(3) * ySkew(2) - zSkew(2) = xSkew(3) * ySkew(1) - xSkew(1) * ySkew(3) - zSkew(3) = xSkew(1) * ySkew(2) - xSkew(2) * ySkew(1) - endif - zHat_Disk = zSkew + ! Skew system (y and z are in disk plane, x is normal to disk, y is in the cross-flow direction formed by the diskavg velocity) + xSkew = y%xHat_Disk + ySkew = y%xHat_Disk - m%Turbine%AD%m%rotors(1)%V_diskAvg + denom = TwoNorm(ySkew) + if (EqualRealNos(denom, 0.0_ReKi)) then + ! There is no skew + ySkew = yHat_plane + zSkew = zHat_plane + else + ySkew = ySkew / denom + zSkew(1) = xSkew(2) * ySkew(3) - xSkew(3) * ySkew(2) + zSkew(2) = xSkew(3) * ySkew(1) - xSkew(1) * ySkew(3) + zSkew(3) = xSkew(1) * ySkew(2) - xSkew(2) * ySkew(1) + endif + zHat_Disk = zSkew + + tmp_sz_y = -1.0_ReKi * dot_product(zHat_Disk,yHat_plane) + tmp_sz_z = dot_product(zHat_Disk,zHat_plane) + if ( EqualRealNos(tmp_sz_y,0.0_ReKi) .and. EqualRealNos(tmp_sz_z,0.0_ReKi) ) then + y%psi_skew = 0.0_ReKi + else + y%psi_skew = atan2( tmp_sz_y, tmp_sz_z ) + end if - tmp_sz_y = -1.0_ReKi * dot_product(zHat_Disk,yHat_plane) - tmp_sz_z = dot_product(zHat_Disk,zHat_plane) - if ( EqualRealNos(tmp_sz_y,0.0_ReKi) .and. EqualRealNos(tmp_sz_z,0.0_ReKi) ) then - y%psi_skew = 0.0_ReKi - else - y%psi_skew = atan2( tmp_sz_y, tmp_sz_z ) - end if - + elseif (m%Turbine%p_FAST%CompAero == MODULE_ADsk) then + ! ....... outputs from AeroDisk ............... + ! Orientation of rotor centerline, normal to disk: + y%xHat_Disk = m%Turbine%ADsk%Input(1)%HubMotion%Orientation(1,:,1) !actually also x_hat_disk and x_hat_hub + + ! Nacelle-yaw error i.e. the angle about positive Z^ from the rotor centerline to the rotor-disk-averaged relative wind + ! velocity (ambients + deficits + motion), both projected onto the horizontal plane, rad + ! if the orientation of the rotor centerline or rotor-disk-averaged relative wind speed is directed vertically upward or downward (+/-Z^) + ! the nacelle-yaw error is undefined (this is handled inside of AeroDisk) + y%YawErr = m%Turbine%ADsk%y%YawErr + + ! Center position of hub, m + p0 = m%Turbine%ADsk%Input(1)%HubMotion%Position(:,1) + m%Turbine%ADsk%Input(1)%HubMotion%TranslationDisp(:,1) + y%p_hub = p%p_ref_Turbine + p0 + + ! Rotor diameter, m + y%D_rotor = 2.0_ReKi * m%Turbine%ADsk%p%RotorRad + + if ( y%D_rotor > p%r(p%nr) ) then + call SetErrStat(ErrID_Fatal,"The radius of the wake planes is not large relative to the rotor diameter.", ErrStat,ErrMsg,RoutineName) + end if + + ! Rotor-disk-averaged relative wind speed (ambient + deficits + motion), normal to disk, m/s + y%DiskAvg_Vx_Rel = m%Turbine%ADsk%y%VRel + + ! Thrust coefficients + if (EqualRealNos(y%DiskAvg_Vx_Rel,0.0_ReKi)) then + y%AzimAvg_Ct = 0.0_ReKi + else + y%AzimAvg_Ct = 0.0_ReKi + do j=1,p%nr + if (p%r(j) <= m%Turbine%ADsk%p%RotorRad) then + y%AzimAvg_Ct(1:j) = m%Turbine%ADsk%y%Ct + endif + enddo + endif + + ! Torque coefficients + if (EqualRealNos(y%DiskAvg_Vx_Rel,0.0_ReKi)) then + y%AzimAvg_Cq = 0.0_ReKi + else + y%AzimAvg_Cq(1) = 0.0_ReKi + do j=2,p%nr + if (p%r(j) <= m%Turbine%ADsk%p%RotorRad) then + y%AzimAvg_Cq(j) = m%Turbine%ADsk%y%Cq * m%Turbine%ADsk%p%RotorRad / p%r(j) ! \f$ C_q(r) = C_Q \frac{R}{r} \f$ + endif + enddo + endif + + ! Skew angles + y%psi_skew = m%Turbine%ADsk%y%PsiSkew + y%chi_skew = m%Turbine%ADsk%y%ChiSkew + + endif + END SUBROUTINE FWrap_CalcOutput !---------------------------------------------------------------------------------------------------------------------------------- !> This subroutine sets the inputs needed before calling an instance of FAST @@ -712,7 +711,6 @@ SUBROUTINE FWrap_SetInputs(u, m, t) REAL(DbKi), INTENT(IN ) :: t !< current simulation time ! set the 4d-wind-inflow input array (a bit of a hack [simplification] so that we don't have large amounts of data copied in multiple data structures): - call move_alloc(u%Vdist_High, m%Turbine%IfW%p%FlowField%Grid4D%Vel) m%Turbine%IfW%p%FlowField%Grid4D%TimeStart = t ! do something with the inputs from the super-controller: diff --git a/glue-codes/fast-farm/src/FASTWrapper_Registry.txt b/glue-codes/fast-farm/src/FASTWrapper_Registry.txt index 5dedfed49a..d5822b91f8 100644 --- a/glue-codes/fast-farm/src/FASTWrapper_Registry.txt +++ b/glue-codes/fast-farm/src/FASTWrapper_Registry.txt @@ -40,6 +40,7 @@ typedef ^ InitInputType IntKi NumCtrl2SC typedef ^ InitInputType Logical UseSC - - - "Use the SuperController? (flag)" - typedef ^ InitInputType SiKi fromSCGlob {:} - - "Global outputs from SuperController" - typedef ^ InitInputType SiKi fromSC {:} - - "Turbine-specific outputs from SuperController" - +typedef ^ InitInputType SiKi *Vdist_High {:}{:}{:}{:}{:} - - "Pointer to UVW components of disturbed wind [nx^high, ny^high, nz^high, n^high/low] (ambient + deficits) across the high-resolution domain around the turbine for each high-resolution time step within a low-resolution time step" "(m/s)" # Define outputs from the initialization routine here: #typedef ^ InitOutputType CHARACTER(ChanLen) WriteOutputHdr {:} - - "Names of the output-to-file channels" - @@ -85,7 +86,6 @@ typedef ^ ParameterType ReKi p_ref_Turbine # Define inputs that are contained on the mesh here: typedef ^ InputType SiKi fromSCglob {:} - - "Global (turbine-independent) commands from the super controller" "(various units)" typedef ^ InputType SiKi fromSC {:} - - "Turbine-dependent commands from the super controller from the super controller" "(various units)" -typedef ^ InputType SiKi Vdist_High {:}{:}{:}{:}{:} - - "UVW components of disturbed wind [nx^high, ny^high, nz^high, n^high/low] (ambient + deficits) across the high-resolution domain around the turbine for each high-resolution time step within a low-resolution time step" "(m/s)" # ..... Outputs ................................................................................................................... # Define outputs that are contained on the mesh here: diff --git a/glue-codes/fast-farm/src/FASTWrapper_Types.f90 b/glue-codes/fast-farm/src/FASTWrapper_Types.f90 index 8c003fc954..983b960364 100644 --- a/glue-codes/fast-farm/src/FASTWrapper_Types.f90 +++ b/glue-codes/fast-farm/src/FASTWrapper_Types.f90 @@ -36,55 +36,56 @@ MODULE FASTWrapper_Types IMPLICIT NONE ! ========= FWrap_InitInputType ======= TYPE, PUBLIC :: FWrap_InitInputType - INTEGER(IntKi) :: nr !< Number of radii in the radial finite-difference grid [-] + INTEGER(IntKi) :: nr = 0_IntKi !< Number of radii in the radial finite-difference grid [-] CHARACTER(1024) :: FASTInFile !< Filename of primary FAST input file of this turbine [-] - REAL(ReKi) :: dr !< Radial increment of radial finite-difference grid [m] - REAL(DbKi) :: tmax !< Simulation length [s] - REAL(ReKi) , DIMENSION(1:3) :: p_ref_Turbine !< Undisplaced global coordinates of this turbine [m] - INTEGER(IntKi) :: WaveFieldMod !< Wave field handling (-) (switch) 0: use individual HydroDyn inputs without adjustment, 1: adjust wave phases based on turbine offsets from farm origin [-] - INTEGER(IntKi) :: n_high_low !< Number of high-resolution time steps per low-resolution time step [-] - REAL(DbKi) :: dt_high !< High-resolution time step [s] - REAL(ReKi) , DIMENSION(1:3) :: p_ref_high !< Position of the origin of the high-resolution spatial domain for this turbine [m] - INTEGER(IntKi) :: nX_high !< Number of high-resolution spatial nodes in X direction [-] - INTEGER(IntKi) :: nY_high !< Number of high-resolution spatial nodes in Y direction [-] - INTEGER(IntKi) :: nZ_high !< Number of high-resolution spatial nodes in Z direction [-] - REAL(ReKi) :: dX_high !< X-component of the spatial increment of the high-resolution spatial domain for this turbine [m] - REAL(ReKi) :: dY_high !< Y-component of the spatial increment of the high-resolution spatial domain for this turbine [m] - REAL(ReKi) :: dZ_high !< Z-component of the spatial increment of the high-resolution spatial domain for this turbine [m] - INTEGER(IntKi) :: TurbNum !< Turbine ID number (start with 1; end with number of turbines) [-] + REAL(ReKi) :: dr = 0.0_ReKi !< Radial increment of radial finite-difference grid [m] + REAL(DbKi) :: tmax = 0.0_R8Ki !< Simulation length [s] + REAL(ReKi) , DIMENSION(1:3) :: p_ref_Turbine = 0.0_ReKi !< Undisplaced global coordinates of this turbine [m] + INTEGER(IntKi) :: WaveFieldMod = 0_IntKi !< Wave field handling (-) (switch) 0: use individual HydroDyn inputs without adjustment, 1: adjust wave phases based on turbine offsets from farm origin [-] + INTEGER(IntKi) :: n_high_low = 0_IntKi !< Number of high-resolution time steps per low-resolution time step [-] + REAL(DbKi) :: dt_high = 0.0_R8Ki !< High-resolution time step [s] + REAL(ReKi) , DIMENSION(1:3) :: p_ref_high = 0.0_ReKi !< Position of the origin of the high-resolution spatial domain for this turbine [m] + INTEGER(IntKi) :: nX_high = 0_IntKi !< Number of high-resolution spatial nodes in X direction [-] + INTEGER(IntKi) :: nY_high = 0_IntKi !< Number of high-resolution spatial nodes in Y direction [-] + INTEGER(IntKi) :: nZ_high = 0_IntKi !< Number of high-resolution spatial nodes in Z direction [-] + REAL(ReKi) :: dX_high = 0.0_ReKi !< X-component of the spatial increment of the high-resolution spatial domain for this turbine [m] + REAL(ReKi) :: dY_high = 0.0_ReKi !< Y-component of the spatial increment of the high-resolution spatial domain for this turbine [m] + REAL(ReKi) :: dZ_high = 0.0_ReKi !< Z-component of the spatial increment of the high-resolution spatial domain for this turbine [m] + INTEGER(IntKi) :: TurbNum = 0_IntKi !< Turbine ID number (start with 1; end with number of turbines) [-] CHARACTER(1024) :: RootName !< The root name derived from the primary FAST.Farm input file [For output reporting in this module we need to have Rootname include the turbine number] [-] - 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 turbine-specific controller outputs [to supercontroller] [-] - LOGICAL :: UseSC !< Use the SuperController? (flag) [-] + INTEGER(IntKi) :: NumSC2Ctrl = 0_IntKi !< Number of turbine-specific controller inputs [from supercontroller] [-] + INTEGER(IntKi) :: NumSC2CtrlGlob = 0_IntKi !< Number of global controller inputs [from supercontroller] [-] + INTEGER(IntKi) :: NumCtrl2SC = 0_IntKi !< Number of turbine-specific controller outputs [to supercontroller] [-] + LOGICAL :: UseSC = .false. !< Use the SuperController? (flag) [-] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: fromSCGlob !< Global outputs from SuperController [-] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: fromSC !< Turbine-specific outputs from SuperController [-] + REAL(SiKi) , DIMENSION(:,:,:,:,:), POINTER :: Vdist_High => NULL() !< Pointer to UVW components of disturbed wind [nx^high, ny^high, nz^high, n^high/low] (ambient + deficits) across the high-resolution domain around the turbine for each high-resolution time step within a low-resolution time step [(m/s)] END TYPE FWrap_InitInputType ! ======================= ! ========= FWrap_InitOutputType ======= TYPE, PUBLIC :: FWrap_InitOutputType - REAL(DbKi) , DIMENSION(1:6) :: PtfmInit !< Initial platform position/rotation vector - surge,sway,heave,roll,pitch,yaw - needed for mooring module initInp [-] + REAL(DbKi) , DIMENSION(1:6) :: PtfmInit = 0.0_R8Ki !< Initial platform position/rotation vector - surge,sway,heave,roll,pitch,yaw - needed for mooring module initInp [-] TYPE(ProgDesc) :: Ver !< This module's name, version, and date [-] END TYPE FWrap_InitOutputType ! ======================= ! ========= FWrap_ContinuousStateType ======= TYPE, PUBLIC :: FWrap_ContinuousStateType - REAL(ReKi) :: dummy !< Remove this variable if you have continuous states [-] + REAL(ReKi) :: dummy = 0.0_ReKi !< Remove this variable if you have continuous states [-] END TYPE FWrap_ContinuousStateType ! ======================= ! ========= FWrap_DiscreteStateType ======= TYPE, PUBLIC :: FWrap_DiscreteStateType - REAL(ReKi) :: dummy !< Remove this variable if you have continuous states [-] + REAL(ReKi) :: dummy = 0.0_ReKi !< Remove this variable if you have continuous states [-] END TYPE FWrap_DiscreteStateType ! ======================= ! ========= FWrap_ConstraintStateType ======= TYPE, PUBLIC :: FWrap_ConstraintStateType - REAL(ReKi) :: dummy !< Remove this variable if you have constraint states [-] + REAL(ReKi) :: dummy = 0.0_ReKi !< Remove this variable if you have constraint states [-] END TYPE FWrap_ConstraintStateType ! ======================= ! ========= FWrap_OtherStateType ======= TYPE, PUBLIC :: FWrap_OtherStateType - INTEGER(IntKi) :: dummy !< Remove this variable if you have other states [-] + INTEGER(IntKi) :: dummy = 0_IntKi !< Remove this variable if you have other states [-] END TYPE FWrap_OtherStateType ! ======================= ! ========= FWrap_MiscVarType ======= @@ -98,2910 +99,873 @@ MODULE FASTWrapper_Types ! ======================= ! ========= FWrap_ParameterType ======= TYPE, PUBLIC :: FWrap_ParameterType - INTEGER(IntKi) :: nr !< Number of radii in the radial finite-difference grid [-] + INTEGER(IntKi) :: nr = 0_IntKi !< Number of radii in the radial finite-difference grid [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: r !< Discretization of radial finite-difference grid [m] - INTEGER(IntKi) :: n_FAST_low !< Number of FAST time steps per low-resolution time step [-] - REAL(ReKi) , DIMENSION(1:3) :: p_ref_Turbine !< Undisplaced global position of this turbine [m] + INTEGER(IntKi) :: n_FAST_low = 0_IntKi !< Number of FAST time steps per low-resolution time step [-] + REAL(ReKi) , DIMENSION(1:3) :: p_ref_Turbine = 0.0_ReKi !< Undisplaced global position of this turbine [m] END TYPE FWrap_ParameterType ! ======================= ! ========= FWrap_InputType ======= TYPE, PUBLIC :: FWrap_InputType REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: fromSCglob !< Global (turbine-independent) commands from the super controller [(various units)] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: fromSC !< Turbine-dependent commands from the super controller from the super controller [(various units)] - REAL(SiKi) , DIMENSION(:,:,:,:,:), ALLOCATABLE :: Vdist_High !< UVW components of disturbed wind [nx^high, ny^high, nz^high, n^high/low] (ambient + deficits) across the high-resolution domain around the turbine for each high-resolution time step within a low-resolution time step [(m/s)] END TYPE FWrap_InputType ! ======================= ! ========= FWrap_OutputType ======= TYPE, PUBLIC :: FWrap_OutputType REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: toSC !< Turbine-dependent commands to the super controller [(various units)] - REAL(ReKi) , DIMENSION(1:3) :: xHat_Disk !< Orientation of rotor centerline, normal to disk [-] - REAL(ReKi) :: YawErr !< Nacelle-yaw error i.e. the angle about positive Z^ from the rotor centerline to the rotor-disk-averaged relative wind velocity (ambients + deficits + motion), both projected onto the horizontal plane [rad] - REAL(ReKi) :: psi_skew !< Azimuth angle from the nominally vertical axis in the disk plane to the vector about which the inflow skew angle is defined [rad] - REAL(ReKi) :: chi_skew !< Inflow skew angle [rad] - REAL(ReKi) , DIMENSION(1:3) :: p_hub !< Center position of hub [m] - REAL(ReKi) :: D_rotor !< Rotor diameter [m] - REAL(ReKi) :: DiskAvg_Vx_Rel !< Rotor-disk-averaged relative wind speed (ambient + deficits + motion), normal to disk [m/s] + REAL(ReKi) , DIMENSION(1:3) :: xHat_Disk = 0.0_ReKi !< Orientation of rotor centerline, normal to disk [-] + REAL(ReKi) :: YawErr = 0.0_ReKi !< Nacelle-yaw error i.e. the angle about positive Z^ from the rotor centerline to the rotor-disk-averaged relative wind velocity (ambients + deficits + motion), both projected onto the horizontal plane [rad] + REAL(ReKi) :: psi_skew = 0.0_ReKi !< Azimuth angle from the nominally vertical axis in the disk plane to the vector about which the inflow skew angle is defined [rad] + REAL(ReKi) :: chi_skew = 0.0_ReKi !< Inflow skew angle [rad] + REAL(ReKi) , DIMENSION(1:3) :: p_hub = 0.0_ReKi !< Center position of hub [m] + REAL(ReKi) :: D_rotor = 0.0_ReKi !< Rotor diameter [m] + REAL(ReKi) :: DiskAvg_Vx_Rel = 0.0_ReKi !< Rotor-disk-averaged relative wind speed (ambient + deficits + motion), normal to disk [m/s] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: AzimAvg_Ct !< Azimuthally averaged thrust force coefficient (normal to disk), distributed radially [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: AzimAvg_Cq !< Azimuthally averaged torque coefficient (normal to disk), distributed radially [-] END TYPE FWrap_OutputType ! ======================= CONTAINS - SUBROUTINE FWrap_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FWrap_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(FWrap_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) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 - INTEGER(IntKi) :: i5, i5_l, i5_u ! bounds (upper/lower) for an array dimension 5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FWrap_CopyInitInput' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInitInputData%nr = SrcInitInputData%nr - DstInitInputData%FASTInFile = SrcInitInputData%FASTInFile - DstInitInputData%dr = SrcInitInputData%dr - DstInitInputData%tmax = SrcInitInputData%tmax - DstInitInputData%p_ref_Turbine = SrcInitInputData%p_ref_Turbine - DstInitInputData%WaveFieldMod = SrcInitInputData%WaveFieldMod - DstInitInputData%n_high_low = SrcInitInputData%n_high_low - DstInitInputData%dt_high = SrcInitInputData%dt_high - DstInitInputData%p_ref_high = SrcInitInputData%p_ref_high - DstInitInputData%nX_high = SrcInitInputData%nX_high - DstInitInputData%nY_high = SrcInitInputData%nY_high - DstInitInputData%nZ_high = SrcInitInputData%nZ_high - DstInitInputData%dX_high = SrcInitInputData%dX_high - DstInitInputData%dY_high = SrcInitInputData%dY_high - DstInitInputData%dZ_high = SrcInitInputData%dZ_high - DstInitInputData%TurbNum = SrcInitInputData%TurbNum - DstInitInputData%RootName = SrcInitInputData%RootName - DstInitInputData%NumSC2Ctrl = SrcInitInputData%NumSC2Ctrl - DstInitInputData%NumSC2CtrlGlob = SrcInitInputData%NumSC2CtrlGlob - DstInitInputData%NumCtrl2SC = SrcInitInputData%NumCtrl2SC - DstInitInputData%UseSC = SrcInitInputData%UseSC -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 FWrap_CopyInitInput - - SUBROUTINE FWrap_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(FWrap_InitInputType), INTENT(INOUT) :: InitInputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FWrap_DestroyInitInput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(InitInputData%fromSCGlob)) THEN - DEALLOCATE(InitInputData%fromSCGlob) -ENDIF -IF (ALLOCATED(InitInputData%fromSC)) THEN - DEALLOCATE(InitInputData%fromSC) -ENDIF - END SUBROUTINE FWrap_DestroyInitInput - - SUBROUTINE FWrap_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(FWrap_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 = 'FWrap_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 ! nr - Int_BufSz = Int_BufSz + 1*LEN(InData%FASTInFile) ! FASTInFile - Re_BufSz = Re_BufSz + 1 ! dr - Db_BufSz = Db_BufSz + 1 ! tmax - Re_BufSz = Re_BufSz + SIZE(InData%p_ref_Turbine) ! p_ref_Turbine - Int_BufSz = Int_BufSz + 1 ! WaveFieldMod - Int_BufSz = Int_BufSz + 1 ! n_high_low - Db_BufSz = Db_BufSz + 1 ! dt_high - Re_BufSz = Re_BufSz + SIZE(InData%p_ref_high) ! p_ref_high - Int_BufSz = Int_BufSz + 1 ! nX_high - Int_BufSz = Int_BufSz + 1 ! nY_high - Int_BufSz = Int_BufSz + 1 ! nZ_high - Re_BufSz = Re_BufSz + 1 ! dX_high - Re_BufSz = Re_BufSz + 1 ! dY_high - Re_BufSz = Re_BufSz + 1 ! dZ_high - Int_BufSz = Int_BufSz + 1 ! TurbNum - Int_BufSz = Int_BufSz + 1*LEN(InData%RootName) ! RootName - Int_BufSz = Int_BufSz + 1 ! NumSC2Ctrl - Int_BufSz = Int_BufSz + 1 ! NumSC2CtrlGlob - Int_BufSz = Int_BufSz + 1 ! NumCtrl2SC - Int_BufSz = Int_BufSz + 1 ! UseSC - 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 - - IntKiBuf(Int_Xferred) = InData%nr - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%FASTInFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%FASTInFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - ReKiBuf(Re_Xferred) = InData%dr - Re_Xferred = Re_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%tmax - Db_Xferred = Db_Xferred + 1 - DO i1 = LBOUND(InData%p_ref_Turbine,1), UBOUND(InData%p_ref_Turbine,1) - ReKiBuf(Re_Xferred) = InData%p_ref_Turbine(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%WaveFieldMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%n_high_low - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%dt_high - Db_Xferred = Db_Xferred + 1 - DO i1 = LBOUND(InData%p_ref_high,1), UBOUND(InData%p_ref_high,1) - ReKiBuf(Re_Xferred) = InData%p_ref_high(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%nX_high - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nY_high - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nZ_high - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%dX_high - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%dY_high - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%dZ_high - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%TurbNum - 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 - 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 - IntKiBuf(Int_Xferred) = TRANSFER(InData%UseSC, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - 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 FWrap_PackInitInput - - SUBROUTINE FWrap_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(FWrap_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) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 - INTEGER(IntKi) :: i5, i5_l, i5_u ! bounds (upper/lower) for an array dimension 5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FWrap_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%nr = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%FASTInFile) - OutData%FASTInFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%dr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%tmax = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - i1_l = LBOUND(OutData%p_ref_Turbine,1) - i1_u = UBOUND(OutData%p_ref_Turbine,1) - DO i1 = LBOUND(OutData%p_ref_Turbine,1), UBOUND(OutData%p_ref_Turbine,1) - OutData%p_ref_Turbine(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%WaveFieldMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%n_high_low = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%dt_high = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - i1_l = LBOUND(OutData%p_ref_high,1) - i1_u = UBOUND(OutData%p_ref_high,1) - DO i1 = LBOUND(OutData%p_ref_high,1), UBOUND(OutData%p_ref_high,1) - OutData%p_ref_high(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%nX_high = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nY_high = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nZ_high = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%dX_high = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%dY_high = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%dZ_high = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TurbNum = 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 - OutData%NumSC2Ctrl = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumSC2CtrlGlob = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumCtrl2SC = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%UseSC = TRANSFER(IntKiBuf(Int_Xferred), OutData%UseSC) - Int_Xferred = 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 (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 ! 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 - END SUBROUTINE FWrap_UnPackInitInput - - SUBROUTINE FWrap_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FWrap_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(FWrap_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 = 'FWrap_CopyInitOutput' -! +subroutine FWrap_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) + type(FWrap_InitInputType), intent(in) :: SrcInitInputData + type(FWrap_InitInputType), intent(inout) :: DstInitInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(5), UB(5) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'FWrap_CopyInitInput' ErrStat = ErrID_None - ErrMsg = "" - DstInitOutputData%PtfmInit = SrcInitOutputData%PtfmInit - CALL NWTC_Library_Copyprogdesc( SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE FWrap_CopyInitOutput - - SUBROUTINE FWrap_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(FWrap_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FWrap_DestroyInitOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL NWTC_Library_Destroyprogdesc( InitOutputData%Ver, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE FWrap_DestroyInitOutput - - SUBROUTINE FWrap_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(FWrap_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 = 'FWrap_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 - Db_BufSz = Db_BufSz + SIZE(InData%PtfmInit) ! PtfmInit - ! 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 - - DO i1 = LBOUND(InData%PtfmInit,1), UBOUND(InData%PtfmInit,1) - DbKiBuf(Db_Xferred) = InData%PtfmInit(i1) - Db_Xferred = Db_Xferred + 1 - END DO - 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 FWrap_PackInitOutput - - SUBROUTINE FWrap_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(FWrap_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 = 'FWrap_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 - i1_l = LBOUND(OutData%PtfmInit,1) - i1_u = UBOUND(OutData%PtfmInit,1) - DO i1 = LBOUND(OutData%PtfmInit,1), UBOUND(OutData%PtfmInit,1) - OutData%PtfmInit(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - 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 FWrap_UnPackInitOutput - - SUBROUTINE FWrap_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FWrap_ContinuousStateType), INTENT(IN) :: SrcContStateData - TYPE(FWrap_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 = 'FWrap_CopyContState' -! + ErrMsg = '' + DstInitInputData%nr = SrcInitInputData%nr + DstInitInputData%FASTInFile = SrcInitInputData%FASTInFile + DstInitInputData%dr = SrcInitInputData%dr + DstInitInputData%tmax = SrcInitInputData%tmax + DstInitInputData%p_ref_Turbine = SrcInitInputData%p_ref_Turbine + DstInitInputData%WaveFieldMod = SrcInitInputData%WaveFieldMod + DstInitInputData%n_high_low = SrcInitInputData%n_high_low + DstInitInputData%dt_high = SrcInitInputData%dt_high + DstInitInputData%p_ref_high = SrcInitInputData%p_ref_high + DstInitInputData%nX_high = SrcInitInputData%nX_high + DstInitInputData%nY_high = SrcInitInputData%nY_high + DstInitInputData%nZ_high = SrcInitInputData%nZ_high + DstInitInputData%dX_high = SrcInitInputData%dX_high + DstInitInputData%dY_high = SrcInitInputData%dY_high + DstInitInputData%dZ_high = SrcInitInputData%dZ_high + DstInitInputData%TurbNum = SrcInitInputData%TurbNum + DstInitInputData%RootName = SrcInitInputData%RootName + DstInitInputData%NumSC2Ctrl = SrcInitInputData%NumSC2Ctrl + DstInitInputData%NumSC2CtrlGlob = SrcInitInputData%NumSC2CtrlGlob + DstInitInputData%NumCtrl2SC = SrcInitInputData%NumCtrl2SC + DstInitInputData%UseSC = SrcInitInputData%UseSC + if (allocated(SrcInitInputData%fromSCGlob)) then + LB(1:1) = lbound(SrcInitInputData%fromSCGlob) + UB(1:1) = ubound(SrcInitInputData%fromSCGlob) + if (.not. allocated(DstInitInputData%fromSCGlob)) then + allocate(DstInitInputData%fromSCGlob(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitInputData%fromSC)) then + LB(1:1) = lbound(SrcInitInputData%fromSC) + UB(1:1) = ubound(SrcInitInputData%fromSC) + if (.not. allocated(DstInitInputData%fromSC)) then + allocate(DstInitInputData%fromSC(LB(1):UB(1)), 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 + end if + DstInitInputData%Vdist_High => SrcInitInputData%Vdist_High +end subroutine + +subroutine FWrap_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(FWrap_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FWrap_DestroyInitInput' ErrStat = ErrID_None - ErrMsg = "" - DstContStateData%dummy = SrcContStateData%dummy - END SUBROUTINE FWrap_CopyContState - - SUBROUTINE FWrap_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(FWrap_ContinuousStateType), INTENT(INOUT) :: ContStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FWrap_DestroyContState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE FWrap_DestroyContState - - SUBROUTINE FWrap_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(FWrap_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 = 'FWrap_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 FWrap_PackContState - - SUBROUTINE FWrap_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(FWrap_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 = 'FWrap_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 FWrap_UnPackContState - - SUBROUTINE FWrap_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FWrap_DiscreteStateType), INTENT(IN) :: SrcDiscStateData - TYPE(FWrap_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 = 'FWrap_CopyDiscState' -! + ErrMsg = '' + if (allocated(InitInputData%fromSCGlob)) then + deallocate(InitInputData%fromSCGlob) + end if + if (allocated(InitInputData%fromSC)) then + deallocate(InitInputData%fromSC) + end if + nullify(InitInputData%Vdist_High) +end subroutine + +subroutine FWrap_PackInitInput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(FWrap_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FWrap_PackInitInput' + logical :: PtrInIndex + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%nr) + call RegPack(RF, InData%FASTInFile) + call RegPack(RF, InData%dr) + call RegPack(RF, InData%tmax) + call RegPack(RF, InData%p_ref_Turbine) + call RegPack(RF, InData%WaveFieldMod) + call RegPack(RF, InData%n_high_low) + call RegPack(RF, InData%dt_high) + call RegPack(RF, InData%p_ref_high) + call RegPack(RF, InData%nX_high) + call RegPack(RF, InData%nY_high) + call RegPack(RF, InData%nZ_high) + call RegPack(RF, InData%dX_high) + call RegPack(RF, InData%dY_high) + call RegPack(RF, InData%dZ_high) + call RegPack(RF, InData%TurbNum) + call RegPack(RF, InData%RootName) + call RegPack(RF, InData%NumSC2Ctrl) + call RegPack(RF, InData%NumSC2CtrlGlob) + call RegPack(RF, InData%NumCtrl2SC) + call RegPack(RF, InData%UseSC) + call RegPackAlloc(RF, InData%fromSCGlob) + call RegPackAlloc(RF, InData%fromSC) + call RegPackPtr(RF, InData%Vdist_High) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FWrap_UnPackInitInput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(FWrap_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FWrap_UnPackInitInput' + integer(B4Ki) :: LB(5), UB(5) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(B8Ki) :: PtrIdx + type(c_ptr) :: Ptr + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%nr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FASTInFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%dr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%tmax); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%p_ref_Turbine); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WaveFieldMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%n_high_low); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%dt_high); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%p_ref_high); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nX_high); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nY_high); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nZ_high); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%dX_high); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%dY_high); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%dZ_high); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TurbNum); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RootName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumSC2Ctrl); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumSC2CtrlGlob); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumCtrl2SC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UseSC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%fromSCGlob); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%fromSC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackPtr(RF, OutData%Vdist_High, LB, UB); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FWrap_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) + type(FWrap_InitOutputType), intent(in) :: SrcInitOutputData + type(FWrap_InitOutputType), intent(inout) :: DstInitOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FWrap_CopyInitOutput' ErrStat = ErrID_None - ErrMsg = "" - DstDiscStateData%dummy = SrcDiscStateData%dummy - END SUBROUTINE FWrap_CopyDiscState - - SUBROUTINE FWrap_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(FWrap_DiscreteStateType), INTENT(INOUT) :: DiscStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FWrap_DestroyDiscState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE FWrap_DestroyDiscState - - SUBROUTINE FWrap_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(FWrap_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 = 'FWrap_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 FWrap_PackDiscState - - SUBROUTINE FWrap_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(FWrap_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 = 'FWrap_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 FWrap_UnPackDiscState - - SUBROUTINE FWrap_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FWrap_ConstraintStateType), INTENT(IN) :: SrcConstrStateData - TYPE(FWrap_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 = 'FWrap_CopyConstrState' -! + ErrMsg = '' + DstInitOutputData%PtfmInit = SrcInitOutputData%PtfmInit + call NWTC_Library_CopyProgDesc(SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine FWrap_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(FWrap_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FWrap_DestroyInitOutput' ErrStat = ErrID_None - ErrMsg = "" - DstConstrStateData%dummy = SrcConstrStateData%dummy - END SUBROUTINE FWrap_CopyConstrState - - SUBROUTINE FWrap_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(FWrap_ConstraintStateType), INTENT(INOUT) :: ConstrStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FWrap_DestroyConstrState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE FWrap_DestroyConstrState - - SUBROUTINE FWrap_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(FWrap_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 = 'FWrap_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) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%dummy - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE FWrap_PackConstrState - - SUBROUTINE FWrap_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(FWrap_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 = 'FWrap_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 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE FWrap_UnPackConstrState - - SUBROUTINE FWrap_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FWrap_OtherStateType), INTENT(IN) :: SrcOtherStateData - TYPE(FWrap_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 = 'FWrap_CopyOtherState' -! + ErrMsg = '' + call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine FWrap_PackInitOutput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(FWrap_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FWrap_PackInitOutput' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%PtfmInit) + call NWTC_Library_PackProgDesc(RF, InData%Ver) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FWrap_UnPackInitOutput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(FWrap_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FWrap_UnPackInitOutput' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%PtfmInit); if (RegCheckErr(RF, RoutineName)) return + call NWTC_Library_UnpackProgDesc(RF, OutData%Ver) ! Ver +end subroutine + +subroutine FWrap_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) + type(FWrap_ContinuousStateType), intent(in) :: SrcContStateData + type(FWrap_ContinuousStateType), intent(inout) :: DstContStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FWrap_CopyContState' ErrStat = ErrID_None - ErrMsg = "" - DstOtherStateData%dummy = SrcOtherStateData%dummy - END SUBROUTINE FWrap_CopyOtherState - - SUBROUTINE FWrap_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(FWrap_OtherStateType), INTENT(INOUT) :: OtherStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FWrap_DestroyOtherState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE FWrap_DestroyOtherState - - SUBROUTINE FWrap_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(FWrap_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 = 'FWrap_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) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = InData%dummy - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE FWrap_PackOtherState - - SUBROUTINE FWrap_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(FWrap_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 = 'FWrap_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 - END SUBROUTINE FWrap_UnPackOtherState - - SUBROUTINE FWrap_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FWrap_MiscVarType), INTENT(INOUT) :: SrcMiscData - TYPE(FWrap_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 = 'FWrap_CopyMisc' -! + ErrMsg = '' + DstContStateData%dummy = SrcContStateData%dummy +end subroutine + +subroutine FWrap_DestroyContState(ContStateData, ErrStat, ErrMsg) + type(FWrap_ContinuousStateType), intent(inout) :: ContStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FWrap_DestroyContState' ErrStat = ErrID_None - ErrMsg = "" - CALL FAST_Copyturbinetype( SrcMiscData%Turbine, DstMiscData%Turbine, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcMiscData%TempDisp)) THEN - i1_l = LBOUND(SrcMiscData%TempDisp,1) - i1_u = UBOUND(SrcMiscData%TempDisp,1) - IF (.NOT. ALLOCATED(DstMiscData%TempDisp)) THEN - ALLOCATE(DstMiscData%TempDisp(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%TempDisp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%TempDisp,1), UBOUND(SrcMiscData%TempDisp,1) - CALL MeshCopy( SrcMiscData%TempDisp(i1), DstMiscData%TempDisp(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcMiscData%TempLoads)) THEN - i1_l = LBOUND(SrcMiscData%TempLoads,1) - i1_u = UBOUND(SrcMiscData%TempLoads,1) - IF (.NOT. ALLOCATED(DstMiscData%TempLoads)) THEN - ALLOCATE(DstMiscData%TempLoads(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%TempLoads.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%TempLoads,1), UBOUND(SrcMiscData%TempLoads,1) - CALL MeshCopy( SrcMiscData%TempLoads(i1), DstMiscData%TempLoads(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcMiscData%ADRotorDisk)) THEN - i1_l = LBOUND(SrcMiscData%ADRotorDisk,1) - i1_u = UBOUND(SrcMiscData%ADRotorDisk,1) - IF (.NOT. ALLOCATED(DstMiscData%ADRotorDisk)) THEN - ALLOCATE(DstMiscData%ADRotorDisk(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%ADRotorDisk.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%ADRotorDisk,1), UBOUND(SrcMiscData%ADRotorDisk,1) - CALL MeshCopy( SrcMiscData%ADRotorDisk(i1), DstMiscData%ADRotorDisk(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcMiscData%AD_L2L)) THEN - i1_l = LBOUND(SrcMiscData%AD_L2L,1) - i1_u = UBOUND(SrcMiscData%AD_L2L,1) - IF (.NOT. ALLOCATED(DstMiscData%AD_L2L)) THEN - ALLOCATE(DstMiscData%AD_L2L(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%AD_L2L.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%AD_L2L,1), UBOUND(SrcMiscData%AD_L2L,1) - CALL NWTC_Library_Copymeshmaptype( SrcMiscData%AD_L2L(i1), DstMiscData%AD_L2L(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - END SUBROUTINE FWrap_CopyMisc - - SUBROUTINE FWrap_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(FWrap_MiscVarType), INTENT(INOUT) :: MiscData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FWrap_DestroyMisc' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL FAST_Destroyturbinetype( MiscData%Turbine, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(MiscData%TempDisp)) THEN -DO i1 = LBOUND(MiscData%TempDisp,1), UBOUND(MiscData%TempDisp,1) - CALL MeshDestroy( MiscData%TempDisp(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MiscData%TempDisp) -ENDIF -IF (ALLOCATED(MiscData%TempLoads)) THEN -DO i1 = LBOUND(MiscData%TempLoads,1), UBOUND(MiscData%TempLoads,1) - CALL MeshDestroy( MiscData%TempLoads(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MiscData%TempLoads) -ENDIF -IF (ALLOCATED(MiscData%ADRotorDisk)) THEN -DO i1 = LBOUND(MiscData%ADRotorDisk,1), UBOUND(MiscData%ADRotorDisk,1) - CALL MeshDestroy( MiscData%ADRotorDisk(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MiscData%ADRotorDisk) -ENDIF -IF (ALLOCATED(MiscData%AD_L2L)) THEN -DO i1 = LBOUND(MiscData%AD_L2L,1), UBOUND(MiscData%AD_L2L,1) - CALL NWTC_Library_Destroymeshmaptype( MiscData%AD_L2L(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MiscData%AD_L2L) -ENDIF - END SUBROUTINE FWrap_DestroyMisc - - SUBROUTINE FWrap_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(FWrap_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 = 'FWrap_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 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! Turbine: size of buffers for each call to pack subtype - CALL FAST_Packturbinetype( Re_Buf, Db_Buf, Int_Buf, InData%Turbine, ErrStat2, ErrMsg2, .TRUE. ) ! Turbine - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Turbine - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Turbine - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Turbine - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! TempDisp allocated yes/no - IF ( ALLOCATED(InData%TempDisp) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TempDisp upper/lower bounds for each dimension - DO i1 = LBOUND(InData%TempDisp,1), UBOUND(InData%TempDisp,1) - Int_BufSz = Int_BufSz + 3 ! TempDisp: size of buffers for each call to pack subtype - CALL MeshPack( InData%TempDisp(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! TempDisp - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! TempDisp - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! TempDisp - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! TempDisp - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! TempLoads allocated yes/no - IF ( ALLOCATED(InData%TempLoads) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TempLoads upper/lower bounds for each dimension - DO i1 = LBOUND(InData%TempLoads,1), UBOUND(InData%TempLoads,1) - Int_BufSz = Int_BufSz + 3 ! TempLoads: size of buffers for each call to pack subtype - CALL MeshPack( InData%TempLoads(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! TempLoads - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! TempLoads - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! TempLoads - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! TempLoads - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! ADRotorDisk allocated yes/no - IF ( ALLOCATED(InData%ADRotorDisk) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ADRotorDisk upper/lower bounds for each dimension - DO i1 = LBOUND(InData%ADRotorDisk,1), UBOUND(InData%ADRotorDisk,1) - Int_BufSz = Int_BufSz + 3 ! ADRotorDisk: size of buffers for each call to pack subtype - CALL MeshPack( InData%ADRotorDisk(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! ADRotorDisk - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! ADRotorDisk - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! ADRotorDisk - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! ADRotorDisk - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! AD_L2L allocated yes/no - IF ( ALLOCATED(InData%AD_L2L) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! AD_L2L upper/lower bounds for each dimension - DO i1 = LBOUND(InData%AD_L2L,1), UBOUND(InData%AD_L2L,1) - Int_BufSz = Int_BufSz + 3 ! AD_L2L: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%AD_L2L(i1), ErrStat2, ErrMsg2, .TRUE. ) ! AD_L2L - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! AD_L2L - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! AD_L2L - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! AD_L2L - 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 - - CALL FAST_Packturbinetype( Re_Buf, Db_Buf, Int_Buf, InData%Turbine, ErrStat2, ErrMsg2, OnlySize ) ! Turbine - 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%TempDisp) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TempDisp,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TempDisp,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TempDisp,1), UBOUND(InData%TempDisp,1) - CALL MeshPack( InData%TempDisp(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! TempDisp - 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%TempLoads) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TempLoads,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TempLoads,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TempLoads,1), UBOUND(InData%TempLoads,1) - CALL MeshPack( InData%TempLoads(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! TempLoads - 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%ADRotorDisk) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ADRotorDisk,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ADRotorDisk,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ADRotorDisk,1), UBOUND(InData%ADRotorDisk,1) - CALL MeshPack( InData%ADRotorDisk(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! ADRotorDisk - 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%AD_L2L) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AD_L2L,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AD_L2L,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%AD_L2L,1), UBOUND(InData%AD_L2L,1) - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%AD_L2L(i1), ErrStat2, ErrMsg2, OnlySize ) ! AD_L2L - 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 FWrap_PackMisc - - SUBROUTINE FWrap_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(FWrap_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 = 'FWrap_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 - 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 FAST_Unpackturbinetype( Re_Buf, Db_Buf, Int_Buf, OutData%Turbine, ErrStat2, ErrMsg2 ) ! Turbine - 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 ! TempDisp not allocated - Int_Xferred = Int_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%TempDisp)) DEALLOCATE(OutData%TempDisp) - ALLOCATE(OutData%TempDisp(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TempDisp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TempDisp,1), UBOUND(OutData%TempDisp,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%TempDisp(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! TempDisp - 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 ! TempLoads not allocated - Int_Xferred = Int_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%TempLoads)) DEALLOCATE(OutData%TempLoads) - ALLOCATE(OutData%TempLoads(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TempLoads.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TempLoads,1), UBOUND(OutData%TempLoads,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%TempLoads(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! TempLoads - 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 ! ADRotorDisk not allocated - Int_Xferred = Int_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%ADRotorDisk)) DEALLOCATE(OutData%ADRotorDisk) - ALLOCATE(OutData%ADRotorDisk(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ADRotorDisk.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ADRotorDisk,1), UBOUND(OutData%ADRotorDisk,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%ADRotorDisk(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! ADRotorDisk - 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 ! AD_L2L not allocated - Int_Xferred = Int_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%AD_L2L)) DEALLOCATE(OutData%AD_L2L) - ALLOCATE(OutData%AD_L2L(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AD_L2L.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%AD_L2L,1), UBOUND(OutData%AD_L2L,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%AD_L2L(i1), ErrStat2, ErrMsg2 ) ! AD_L2L - 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 FWrap_UnPackMisc - - SUBROUTINE FWrap_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FWrap_ParameterType), INTENT(IN) :: SrcParamData - TYPE(FWrap_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 = 'FWrap_CopyParam' -! + ErrMsg = '' +end subroutine + +subroutine FWrap_PackContState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(FWrap_ContinuousStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FWrap_PackContState' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%dummy) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FWrap_UnPackContState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(FWrap_ContinuousStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FWrap_UnPackContState' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%dummy); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FWrap_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) + type(FWrap_DiscreteStateType), intent(in) :: SrcDiscStateData + type(FWrap_DiscreteStateType), intent(inout) :: DstDiscStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FWrap_CopyDiscState' ErrStat = ErrID_None - ErrMsg = "" - DstParamData%nr = SrcParamData%nr -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%n_FAST_low = SrcParamData%n_FAST_low - DstParamData%p_ref_Turbine = SrcParamData%p_ref_Turbine - END SUBROUTINE FWrap_CopyParam - - SUBROUTINE FWrap_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(FWrap_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FWrap_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(ParamData%r)) THEN - DEALLOCATE(ParamData%r) -ENDIF - END SUBROUTINE FWrap_DestroyParam - - SUBROUTINE FWrap_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(FWrap_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 = 'FWrap_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 ! nr - 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 - Int_BufSz = Int_BufSz + 1 ! n_FAST_low - Re_BufSz = Re_BufSz + SIZE(InData%p_ref_Turbine) ! p_ref_Turbine - 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%nr - Int_Xferred = Int_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 - IntKiBuf(Int_Xferred) = InData%n_FAST_low - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%p_ref_Turbine,1), UBOUND(InData%p_ref_Turbine,1) - ReKiBuf(Re_Xferred) = InData%p_ref_Turbine(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END SUBROUTINE FWrap_PackParam - - SUBROUTINE FWrap_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(FWrap_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 = 'FWrap_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%nr = IntKiBuf(Int_Xferred) - Int_Xferred = Int_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%n_FAST_low = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%p_ref_Turbine,1) - i1_u = UBOUND(OutData%p_ref_Turbine,1) - DO i1 = LBOUND(OutData%p_ref_Turbine,1), UBOUND(OutData%p_ref_Turbine,1) - OutData%p_ref_Turbine(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END SUBROUTINE FWrap_UnPackParam - - SUBROUTINE FWrap_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FWrap_InputType), INTENT(IN) :: SrcInputData - TYPE(FWrap_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) :: 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) :: i5, i5_l, i5_u ! bounds (upper/lower) for an array dimension 5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FWrap_CopyInput' -! + ErrMsg = '' + DstDiscStateData%dummy = SrcDiscStateData%dummy +end subroutine + +subroutine FWrap_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) + type(FWrap_DiscreteStateType), intent(inout) :: DiscStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FWrap_DestroyDiscState' ErrStat = ErrID_None - ErrMsg = "" -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%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%Vdist_High)) THEN - i1_l = LBOUND(SrcInputData%Vdist_High,1) - i1_u = UBOUND(SrcInputData%Vdist_High,1) - i2_l = LBOUND(SrcInputData%Vdist_High,2) - i2_u = UBOUND(SrcInputData%Vdist_High,2) - i3_l = LBOUND(SrcInputData%Vdist_High,3) - i3_u = UBOUND(SrcInputData%Vdist_High,3) - i4_l = LBOUND(SrcInputData%Vdist_High,4) - i4_u = UBOUND(SrcInputData%Vdist_High,4) - i5_l = LBOUND(SrcInputData%Vdist_High,5) - i5_u = UBOUND(SrcInputData%Vdist_High,5) - IF (.NOT. ALLOCATED(DstInputData%Vdist_High)) THEN - ALLOCATE(DstInputData%Vdist_High(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u,i5_l:i5_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%Vdist_High.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%Vdist_High = SrcInputData%Vdist_High -ENDIF - END SUBROUTINE FWrap_CopyInput - - SUBROUTINE FWrap_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(FWrap_InputType), INTENT(INOUT) :: InputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FWrap_DestroyInput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(InputData%fromSCglob)) THEN - DEALLOCATE(InputData%fromSCglob) -ENDIF -IF (ALLOCATED(InputData%fromSC)) THEN - DEALLOCATE(InputData%fromSC) -ENDIF -IF (ALLOCATED(InputData%Vdist_High)) THEN - DEALLOCATE(InputData%Vdist_High) -ENDIF - END SUBROUTINE FWrap_DestroyInput - - SUBROUTINE FWrap_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(FWrap_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 = 'FWrap_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 ! 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 - Int_BufSz = Int_BufSz + 1 ! Vdist_High allocated yes/no - IF ( ALLOCATED(InData%Vdist_High) ) THEN - Int_BufSz = Int_BufSz + 2*5 ! Vdist_High upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vdist_High) ! Vdist_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%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 - IF ( .NOT. ALLOCATED(InData%Vdist_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%Vdist_High,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vdist_High,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vdist_High,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vdist_High,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vdist_High,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vdist_High,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vdist_High,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vdist_High,4) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vdist_High,5) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vdist_High,5) - Int_Xferred = Int_Xferred + 2 - - DO i5 = LBOUND(InData%Vdist_High,5), UBOUND(InData%Vdist_High,5) - DO i4 = LBOUND(InData%Vdist_High,4), UBOUND(InData%Vdist_High,4) - DO i3 = LBOUND(InData%Vdist_High,3), UBOUND(InData%Vdist_High,3) - DO i2 = LBOUND(InData%Vdist_High,2), UBOUND(InData%Vdist_High,2) - DO i1 = LBOUND(InData%Vdist_High,1), UBOUND(InData%Vdist_High,1) - ReKiBuf(Re_Xferred) = InData%Vdist_High(i1,i2,i3,i4,i5) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END DO - END IF - END SUBROUTINE FWrap_PackInput - - SUBROUTINE FWrap_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(FWrap_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) :: 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) :: i5, i5_l, i5_u ! bounds (upper/lower) for an array dimension 5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FWrap_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 ! 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 ! 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 ! Vdist_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 - 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 - i5_l = IntKiBuf( Int_Xferred ) - i5_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Vdist_High)) DEALLOCATE(OutData%Vdist_High) - ALLOCATE(OutData%Vdist_High(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u,i5_l:i5_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vdist_High.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i5 = LBOUND(OutData%Vdist_High,5), UBOUND(OutData%Vdist_High,5) - DO i4 = LBOUND(OutData%Vdist_High,4), UBOUND(OutData%Vdist_High,4) - DO i3 = LBOUND(OutData%Vdist_High,3), UBOUND(OutData%Vdist_High,3) - DO i2 = LBOUND(OutData%Vdist_High,2), UBOUND(OutData%Vdist_High,2) - DO i1 = LBOUND(OutData%Vdist_High,1), UBOUND(OutData%Vdist_High,1) - OutData%Vdist_High(i1,i2,i3,i4,i5) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END DO - END IF - END SUBROUTINE FWrap_UnPackInput - - SUBROUTINE FWrap_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FWrap_OutputType), INTENT(IN) :: SrcOutputData - TYPE(FWrap_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 = 'FWrap_CopyOutput' -! + ErrMsg = '' +end subroutine + +subroutine FWrap_PackDiscState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(FWrap_DiscreteStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FWrap_PackDiscState' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%dummy) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FWrap_UnPackDiscState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(FWrap_DiscreteStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FWrap_UnPackDiscState' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%dummy); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FWrap_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) + type(FWrap_ConstraintStateType), intent(in) :: SrcConstrStateData + type(FWrap_ConstraintStateType), intent(inout) :: DstConstrStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FWrap_CopyConstrState' ErrStat = ErrID_None - ErrMsg = "" -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 - DstOutputData%xHat_Disk = SrcOutputData%xHat_Disk - DstOutputData%YawErr = SrcOutputData%YawErr - DstOutputData%psi_skew = SrcOutputData%psi_skew - DstOutputData%chi_skew = SrcOutputData%chi_skew - DstOutputData%p_hub = SrcOutputData%p_hub - DstOutputData%D_rotor = SrcOutputData%D_rotor - DstOutputData%DiskAvg_Vx_Rel = SrcOutputData%DiskAvg_Vx_Rel -IF (ALLOCATED(SrcOutputData%AzimAvg_Ct)) THEN - i1_l = LBOUND(SrcOutputData%AzimAvg_Ct,1) - i1_u = UBOUND(SrcOutputData%AzimAvg_Ct,1) - IF (.NOT. ALLOCATED(DstOutputData%AzimAvg_Ct)) THEN - ALLOCATE(DstOutputData%AzimAvg_Ct(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%AzimAvg_Ct.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%AzimAvg_Ct = SrcOutputData%AzimAvg_Ct -ENDIF -IF (ALLOCATED(SrcOutputData%AzimAvg_Cq)) THEN - i1_l = LBOUND(SrcOutputData%AzimAvg_Cq,1) - i1_u = UBOUND(SrcOutputData%AzimAvg_Cq,1) - IF (.NOT. ALLOCATED(DstOutputData%AzimAvg_Cq)) THEN - ALLOCATE(DstOutputData%AzimAvg_Cq(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%AzimAvg_Cq.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%AzimAvg_Cq = SrcOutputData%AzimAvg_Cq -ENDIF - END SUBROUTINE FWrap_CopyOutput - - SUBROUTINE FWrap_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(FWrap_OutputType), INTENT(INOUT) :: OutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FWrap_DestroyOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(OutputData%toSC)) THEN - DEALLOCATE(OutputData%toSC) -ENDIF -IF (ALLOCATED(OutputData%AzimAvg_Ct)) THEN - DEALLOCATE(OutputData%AzimAvg_Ct) -ENDIF -IF (ALLOCATED(OutputData%AzimAvg_Cq)) THEN - DEALLOCATE(OutputData%AzimAvg_Cq) -ENDIF - END SUBROUTINE FWrap_DestroyOutput - - SUBROUTINE FWrap_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(FWrap_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 = 'FWrap_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 ! 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 - Re_BufSz = Re_BufSz + SIZE(InData%xHat_Disk) ! xHat_Disk - Re_BufSz = Re_BufSz + 1 ! YawErr - Re_BufSz = Re_BufSz + 1 ! psi_skew - Re_BufSz = Re_BufSz + 1 ! chi_skew - Re_BufSz = Re_BufSz + SIZE(InData%p_hub) ! p_hub - Re_BufSz = Re_BufSz + 1 ! D_rotor - Re_BufSz = Re_BufSz + 1 ! DiskAvg_Vx_Rel - Int_BufSz = Int_BufSz + 1 ! AzimAvg_Ct allocated yes/no - IF ( ALLOCATED(InData%AzimAvg_Ct) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! AzimAvg_Ct upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AzimAvg_Ct) ! AzimAvg_Ct - END IF - Int_BufSz = Int_BufSz + 1 ! AzimAvg_Cq allocated yes/no - IF ( ALLOCATED(InData%AzimAvg_Cq) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! AzimAvg_Cq upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AzimAvg_Cq) ! AzimAvg_Cq - 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%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 - 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 - ReKiBuf(Re_Xferred) = InData%YawErr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%psi_skew - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%chi_skew - Re_Xferred = Re_Xferred + 1 - 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 - ReKiBuf(Re_Xferred) = InData%D_rotor - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%DiskAvg_Vx_Rel - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%AzimAvg_Ct) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AzimAvg_Ct,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AzimAvg_Ct,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%AzimAvg_Ct,1), UBOUND(InData%AzimAvg_Ct,1) - ReKiBuf(Re_Xferred) = InData%AzimAvg_Ct(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AzimAvg_Cq) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AzimAvg_Cq,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AzimAvg_Cq,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%AzimAvg_Cq,1), UBOUND(InData%AzimAvg_Cq,1) - ReKiBuf(Re_Xferred) = InData%AzimAvg_Cq(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE FWrap_PackOutput - - SUBROUTINE FWrap_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(FWrap_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 = 'FWrap_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 ! 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 - 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 - OutData%YawErr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%psi_skew = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%chi_skew = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - 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 - OutData%D_rotor = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%DiskAvg_Vx_Rel = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AzimAvg_Ct not allocated - Int_Xferred = Int_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%AzimAvg_Ct)) DEALLOCATE(OutData%AzimAvg_Ct) - ALLOCATE(OutData%AzimAvg_Ct(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AzimAvg_Ct.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%AzimAvg_Ct,1), UBOUND(OutData%AzimAvg_Ct,1) - OutData%AzimAvg_Ct(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AzimAvg_Cq not allocated - Int_Xferred = Int_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%AzimAvg_Cq)) DEALLOCATE(OutData%AzimAvg_Cq) - ALLOCATE(OutData%AzimAvg_Cq(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AzimAvg_Cq.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%AzimAvg_Cq,1), UBOUND(OutData%AzimAvg_Cq,1) - OutData%AzimAvg_Cq(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE FWrap_UnPackOutput - + ErrMsg = '' + DstConstrStateData%dummy = SrcConstrStateData%dummy +end subroutine + +subroutine FWrap_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) + type(FWrap_ConstraintStateType), intent(inout) :: ConstrStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FWrap_DestroyConstrState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine FWrap_PackConstrState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(FWrap_ConstraintStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FWrap_PackConstrState' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%dummy) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FWrap_UnPackConstrState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(FWrap_ConstraintStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FWrap_UnPackConstrState' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%dummy); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FWrap_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) + type(FWrap_OtherStateType), intent(in) :: SrcOtherStateData + type(FWrap_OtherStateType), intent(inout) :: DstOtherStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FWrap_CopyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + DstOtherStateData%dummy = SrcOtherStateData%dummy +end subroutine + +subroutine FWrap_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) + type(FWrap_OtherStateType), intent(inout) :: OtherStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FWrap_DestroyOtherState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine FWrap_PackOtherState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(FWrap_OtherStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FWrap_PackOtherState' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%dummy) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FWrap_UnPackOtherState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(FWrap_OtherStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FWrap_UnPackOtherState' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%dummy); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FWrap_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(FWrap_MiscVarType), intent(inout) :: SrcMiscData + type(FWrap_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FWrap_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + call FAST_CopyTurbineType(SrcMiscData%Turbine, DstMiscData%Turbine, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcMiscData%TempDisp)) then + LB(1:1) = lbound(SrcMiscData%TempDisp) + UB(1:1) = ubound(SrcMiscData%TempDisp) + if (.not. allocated(DstMiscData%TempDisp)) then + allocate(DstMiscData%TempDisp(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%TempDisp.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MeshCopy(SrcMiscData%TempDisp(i1), DstMiscData%TempDisp(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcMiscData%TempLoads)) then + LB(1:1) = lbound(SrcMiscData%TempLoads) + UB(1:1) = ubound(SrcMiscData%TempLoads) + if (.not. allocated(DstMiscData%TempLoads)) then + allocate(DstMiscData%TempLoads(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%TempLoads.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MeshCopy(SrcMiscData%TempLoads(i1), DstMiscData%TempLoads(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcMiscData%ADRotorDisk)) then + LB(1:1) = lbound(SrcMiscData%ADRotorDisk) + UB(1:1) = ubound(SrcMiscData%ADRotorDisk) + if (.not. allocated(DstMiscData%ADRotorDisk)) then + allocate(DstMiscData%ADRotorDisk(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%ADRotorDisk.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MeshCopy(SrcMiscData%ADRotorDisk(i1), DstMiscData%ADRotorDisk(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcMiscData%AD_L2L)) then + LB(1:1) = lbound(SrcMiscData%AD_L2L) + UB(1:1) = ubound(SrcMiscData%AD_L2L) + if (.not. allocated(DstMiscData%AD_L2L)) then + allocate(DstMiscData%AD_L2L(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%AD_L2L.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcMiscData%AD_L2L(i1), DstMiscData%AD_L2L(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if +end subroutine + +subroutine FWrap_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(FWrap_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FWrap_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' + call FAST_DestroyTurbineType(MiscData%Turbine, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(MiscData%TempDisp)) then + LB(1:1) = lbound(MiscData%TempDisp) + UB(1:1) = ubound(MiscData%TempDisp) + do i1 = LB(1), UB(1) + call MeshDestroy( MiscData%TempDisp(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%TempDisp) + end if + if (allocated(MiscData%TempLoads)) then + LB(1:1) = lbound(MiscData%TempLoads) + UB(1:1) = ubound(MiscData%TempLoads) + do i1 = LB(1), UB(1) + call MeshDestroy( MiscData%TempLoads(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%TempLoads) + end if + if (allocated(MiscData%ADRotorDisk)) then + LB(1:1) = lbound(MiscData%ADRotorDisk) + UB(1:1) = ubound(MiscData%ADRotorDisk) + do i1 = LB(1), UB(1) + call MeshDestroy( MiscData%ADRotorDisk(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%ADRotorDisk) + end if + if (allocated(MiscData%AD_L2L)) then + LB(1:1) = lbound(MiscData%AD_L2L) + UB(1:1) = ubound(MiscData%AD_L2L) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(MiscData%AD_L2L(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%AD_L2L) + end if +end subroutine + +subroutine FWrap_PackMisc(RF, Indata) + type(RegFile), intent(inout) :: RF + type(FWrap_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FWrap_PackMisc' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + if (RF%ErrStat >= AbortErrLev) return + call FAST_PackTurbineType(RF, InData%Turbine) + call RegPack(RF, allocated(InData%TempDisp)) + if (allocated(InData%TempDisp)) then + call RegPackBounds(RF, 1, lbound(InData%TempDisp), ubound(InData%TempDisp)) + LB(1:1) = lbound(InData%TempDisp) + UB(1:1) = ubound(InData%TempDisp) + do i1 = LB(1), UB(1) + call MeshPack(RF, InData%TempDisp(i1)) + end do + end if + call RegPack(RF, allocated(InData%TempLoads)) + if (allocated(InData%TempLoads)) then + call RegPackBounds(RF, 1, lbound(InData%TempLoads), ubound(InData%TempLoads)) + LB(1:1) = lbound(InData%TempLoads) + UB(1:1) = ubound(InData%TempLoads) + do i1 = LB(1), UB(1) + call MeshPack(RF, InData%TempLoads(i1)) + end do + end if + call RegPack(RF, allocated(InData%ADRotorDisk)) + if (allocated(InData%ADRotorDisk)) then + call RegPackBounds(RF, 1, lbound(InData%ADRotorDisk), ubound(InData%ADRotorDisk)) + LB(1:1) = lbound(InData%ADRotorDisk) + UB(1:1) = ubound(InData%ADRotorDisk) + do i1 = LB(1), UB(1) + call MeshPack(RF, InData%ADRotorDisk(i1)) + end do + end if + call RegPack(RF, allocated(InData%AD_L2L)) + if (allocated(InData%AD_L2L)) then + call RegPackBounds(RF, 1, lbound(InData%AD_L2L), ubound(InData%AD_L2L)) + LB(1:1) = lbound(InData%AD_L2L) + UB(1:1) = ubound(InData%AD_L2L) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(RF, InData%AD_L2L(i1)) + end do + end if + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FWrap_UnPackMisc(RF, OutData) + type(RegFile), intent(inout) :: RF + type(FWrap_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FWrap_UnPackMisc' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call FAST_UnpackTurbineType(RF, OutData%Turbine) ! Turbine + if (allocated(OutData%TempDisp)) deallocate(OutData%TempDisp) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%TempDisp(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TempDisp.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(RF, OutData%TempDisp(i1)) ! TempDisp + end do + end if + if (allocated(OutData%TempLoads)) deallocate(OutData%TempLoads) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%TempLoads(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TempLoads.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(RF, OutData%TempLoads(i1)) ! TempLoads + end do + end if + if (allocated(OutData%ADRotorDisk)) deallocate(OutData%ADRotorDisk) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%ADRotorDisk(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ADRotorDisk.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(RF, OutData%ADRotorDisk(i1)) ! ADRotorDisk + end do + end if + if (allocated(OutData%AD_L2L)) deallocate(OutData%AD_L2L) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%AD_L2L(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AD_L2L.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(RF, OutData%AD_L2L(i1)) ! AD_L2L + end do + end if +end subroutine + +subroutine FWrap_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(FWrap_ParameterType), intent(in) :: SrcParamData + type(FWrap_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'FWrap_CopyParam' + ErrStat = ErrID_None + ErrMsg = '' + DstParamData%nr = SrcParamData%nr + if (allocated(SrcParamData%r)) then + LB(1:1) = lbound(SrcParamData%r) + UB(1:1) = ubound(SrcParamData%r) + if (.not. allocated(DstParamData%r)) then + allocate(DstParamData%r(LB(1):UB(1)), 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 + end if + DstParamData%n_FAST_low = SrcParamData%n_FAST_low + DstParamData%p_ref_Turbine = SrcParamData%p_ref_Turbine +end subroutine + +subroutine FWrap_DestroyParam(ParamData, ErrStat, ErrMsg) + type(FWrap_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FWrap_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ParamData%r)) then + deallocate(ParamData%r) + end if +end subroutine + +subroutine FWrap_PackParam(RF, Indata) + type(RegFile), intent(inout) :: RF + type(FWrap_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FWrap_PackParam' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%nr) + call RegPackAlloc(RF, InData%r) + call RegPack(RF, InData%n_FAST_low) + call RegPack(RF, InData%p_ref_Turbine) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FWrap_UnPackParam(RF, OutData) + type(RegFile), intent(inout) :: RF + type(FWrap_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FWrap_UnPackParam' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%nr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%r); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%n_FAST_low); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%p_ref_Turbine); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FWrap_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) + type(FWrap_InputType), intent(in) :: SrcInputData + type(FWrap_InputType), intent(inout) :: DstInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'FWrap_CopyInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcInputData%fromSCglob)) then + LB(1:1) = lbound(SrcInputData%fromSCglob) + UB(1:1) = ubound(SrcInputData%fromSCglob) + if (.not. allocated(DstInputData%fromSCglob)) then + allocate(DstInputData%fromSCglob(LB(1):UB(1)), 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 + end if + if (allocated(SrcInputData%fromSC)) then + LB(1:1) = lbound(SrcInputData%fromSC) + UB(1:1) = ubound(SrcInputData%fromSC) + if (.not. allocated(DstInputData%fromSC)) then + allocate(DstInputData%fromSC(LB(1):UB(1)), 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 + end if +end subroutine + +subroutine FWrap_DestroyInput(InputData, ErrStat, ErrMsg) + type(FWrap_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FWrap_DestroyInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InputData%fromSCglob)) then + deallocate(InputData%fromSCglob) + end if + if (allocated(InputData%fromSC)) then + deallocate(InputData%fromSC) + end if +end subroutine + +subroutine FWrap_PackInput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(FWrap_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FWrap_PackInput' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%fromSCglob) + call RegPackAlloc(RF, InData%fromSC) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FWrap_UnPackInput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(FWrap_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FWrap_UnPackInput' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%fromSCglob); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%fromSC); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FWrap_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(FWrap_OutputType), intent(in) :: SrcOutputData + type(FWrap_OutputType), intent(inout) :: DstOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'FWrap_CopyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcOutputData%toSC)) then + LB(1:1) = lbound(SrcOutputData%toSC) + UB(1:1) = ubound(SrcOutputData%toSC) + if (.not. allocated(DstOutputData%toSC)) then + allocate(DstOutputData%toSC(LB(1):UB(1)), 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 + end if + DstOutputData%xHat_Disk = SrcOutputData%xHat_Disk + DstOutputData%YawErr = SrcOutputData%YawErr + DstOutputData%psi_skew = SrcOutputData%psi_skew + DstOutputData%chi_skew = SrcOutputData%chi_skew + DstOutputData%p_hub = SrcOutputData%p_hub + DstOutputData%D_rotor = SrcOutputData%D_rotor + DstOutputData%DiskAvg_Vx_Rel = SrcOutputData%DiskAvg_Vx_Rel + if (allocated(SrcOutputData%AzimAvg_Ct)) then + LB(1:1) = lbound(SrcOutputData%AzimAvg_Ct) + UB(1:1) = ubound(SrcOutputData%AzimAvg_Ct) + if (.not. allocated(DstOutputData%AzimAvg_Ct)) then + allocate(DstOutputData%AzimAvg_Ct(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%AzimAvg_Ct.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%AzimAvg_Ct = SrcOutputData%AzimAvg_Ct + end if + if (allocated(SrcOutputData%AzimAvg_Cq)) then + LB(1:1) = lbound(SrcOutputData%AzimAvg_Cq) + UB(1:1) = ubound(SrcOutputData%AzimAvg_Cq) + if (.not. allocated(DstOutputData%AzimAvg_Cq)) then + allocate(DstOutputData%AzimAvg_Cq(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%AzimAvg_Cq.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%AzimAvg_Cq = SrcOutputData%AzimAvg_Cq + end if +end subroutine + +subroutine FWrap_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(FWrap_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FWrap_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OutputData%toSC)) then + deallocate(OutputData%toSC) + end if + if (allocated(OutputData%AzimAvg_Ct)) then + deallocate(OutputData%AzimAvg_Ct) + end if + if (allocated(OutputData%AzimAvg_Cq)) then + deallocate(OutputData%AzimAvg_Cq) + end if +end subroutine + +subroutine FWrap_PackOutput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(FWrap_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FWrap_PackOutput' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%toSC) + call RegPack(RF, InData%xHat_Disk) + call RegPack(RF, InData%YawErr) + call RegPack(RF, InData%psi_skew) + call RegPack(RF, InData%chi_skew) + call RegPack(RF, InData%p_hub) + call RegPack(RF, InData%D_rotor) + call RegPack(RF, InData%DiskAvg_Vx_Rel) + call RegPackAlloc(RF, InData%AzimAvg_Ct) + call RegPackAlloc(RF, InData%AzimAvg_Cq) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FWrap_UnPackOutput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(FWrap_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FWrap_UnPackOutput' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%toSC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%xHat_Disk); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawErr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%psi_skew); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%chi_skew); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%p_hub); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%D_rotor); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DiskAvg_Vx_Rel); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AzimAvg_Ct); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AzimAvg_Cq); if (RegCheckErr(RF, RoutineName)) return +end subroutine END MODULE FASTWrapper_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/glue-codes/fast-farm/src/FAST_Farm_IO.f90 b/glue-codes/fast-farm/src/FAST_Farm_IO.f90 index 1f05d256f7..2032f9d9ac 100644 --- a/glue-codes/fast-farm/src/FAST_Farm_IO.f90 +++ b/glue-codes/fast-farm/src/FAST_Farm_IO.f90 @@ -1,6 +1,7 @@ module FAST_Farm_IO USE NWTC_Library + USE VersionInfo USE FAST_Farm_Types USE FAST_Farm_IO_Params @@ -8,40 +9,11 @@ module FAST_Farm_IO TYPE(ProgDesc), PARAMETER :: Farm_Ver = ProgDesc( 'FAST.Farm', '', '' ) !< module date/version information - - - contains - -!---------------------------------------------------------------------------------------------------------------------------------- -!> This function returns a string describing the glue code and some of the compilation options we're using. -FUNCTION GetVersion(ThisProgVer) - - ! Passed Variables: - - TYPE(ProgDesc), INTENT( IN ) :: ThisProgVer !< program name/date/version description - CHARACTER(1024) :: GetVersion !< String containing a description of the compiled precision. - - GetVersion = TRIM(GetNVD(ThisProgVer))//', compiled' - - - GetVersion = TRIM(GetVersion)//' as a '//TRIM(Num2LStr(BITS_IN_ADDR))//'-bit application using' - - ! determine precision + integer, parameter :: maxOutputPoints = 9 + integer, parameter :: maxOutputPlanes = 999 ! Allow up to 99 outpt planes - IF ( ReKi == SiKi ) THEN ! Single precision - GetVersion = TRIM(GetVersion)//' single' - ELSEIF ( ReKi == R8Ki ) THEN ! Double precision - GetVersion = TRIM(GetVersion)// ' double' - ELSE ! Unknown precision - GetVersion = TRIM(GetVersion)//' unknown' - ENDIF -! GetVersion = TRIM(GetVersion)//' precision with '//OS_Desc - GetVersion = TRIM(GetVersion)//' precision' - - - RETURN -END FUNCTION GetVersion + contains !---------------------------------------------------------------------------------------------------------------------------------- !> This routine generates the summary file, which contains a regurgitation of the input data and interpolated flexible body data. @@ -195,8 +167,10 @@ SUBROUTINE Farm_PrintSum( farm, WD_InputFileData, ErrStat, ErrMsg ) case (MeanderMod_WndwdJinc) WRITE (UnSum,'(4X,A)') '( windowed jinc )' end select -WRITE (UnSum,'(2X,A)') 'Calibrated parameter for wake meandering (-): '//trim(Num2LStr(farm%AWAE%p%C_Meander)) + WRITE (UnSum,'(2X,A)') 'Calibrated parameter for wake meandering (-): '//trim(Num2LStr(farm%AWAE%p%C_Meander)) +!FIXME: add summary info about WAT + WRITE (UnSum,'(/,A)' ) 'Time Steps' WRITE (UnSum,'(2X,A)') 'Component Time Step Subcyles' WRITE (UnSum,'(2X,A)') ' (-) (s) (-)' @@ -556,6 +530,630 @@ SUBROUTINE WriteFarmOutputToFile( t_global, farm, ErrStat, ErrMsg ) ENDIF END SUBROUTINE WriteFarmOutputToFile +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine reads in the primary FAST.Farm input file, does some validation, and places the values it reads in the +!! parameter structure (p). It prints to an echo file if requested. +SUBROUTINE Farm_ReadPrimaryFile( InputFile, p, WD_InitInp, AWAE_InitInp, SC_InitInp, OutList, ErrStat, ErrMsg ) + TYPE(Farm_ParameterType), INTENT(INOUT) :: p !< The parameter data for the FAST (glue-code) simulation + CHARACTER(*), INTENT(IN ) :: InputFile !< Name of the file containing the primary input data + TYPE(WD_InputFileType), INTENT( OUT) :: WD_InitInp !< input-file data for WakeDynamics module + TYPE(AWAE_InputFileType), INTENT( OUT) :: AWAE_InitInp !< input-file data for AWAE module + TYPE(SC_InitInputType), INTENT( OUT) :: SC_InitInp !< input-file data for SC module + CHARACTER(ChanLen), INTENT( OUT) :: OutList(:) !< list of user-requested output channels + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message + + ! Local variables: + REAL(DbKi) :: TmpTime ! temporary variable to read SttsTime and ChkptTime before converting to #steps based on DT_low + INTEGER(IntKi) :: I ! loop counter + INTEGER(IntKi) :: UnIn ! Unit number for reading file + INTEGER(IntKi) :: UnEc ! I/O unit for echo file. If > 0, file is open for writing. + + INTEGER(IntKi) :: IOS ! Temporary Error status + INTEGER(IntKi) :: OutFileFmt ! An integer that indicates what kind of tabular output should be generated (1=text, 2=binary, 3=both) + INTEGER(IntKi) :: NLinTimes ! An integer that indicates how many times to linearize + LOGICAL :: Echo ! Determines if an echo file should be written + LOGICAL :: TabDelim ! Determines if text output should be delimited by tabs (true) or space (false) + CHARACTER(1024) :: PriPath ! Path name of the primary file + character(1024) :: sDummy ! Dummy string + + CHARACTER(10) :: AbortLevel ! String that indicates which error level should be used to abort the program: WARNING, SEVERE, or FATAL + CHARACTER(30) :: Line ! string for default entry in input file + + INTEGER(IntKi) :: ErrStat2 ! Temporary Error status + CHARACTER(ErrMsgLen) :: ErrMsg2 ! Temporary Error message + CHARACTER(*), PARAMETER :: RoutineName = 'Farm_ReadPrimaryFile' + Real(ReKi) :: DefaultReVal ! Default real value + real(ReKi) :: TmpRAry5(5) ! Temporary array for reading in array of 5 + + ! Initialize some variables: + UnEc = -1 + Echo = .FALSE. ! Don't echo until we've read the "Echo" flag + CALL GetPath( InputFile, PriPath ) ! Input files will be relative to the path where the primary input file is located. + + ! Get an available unit number and open input file + CALL GetNewUnit( UnIn, ErrStat, ErrMsg ); IF ( ErrStat >= AbortErrLev ) RETURN + CALL OpenFInpFile ( UnIn, InputFile, ErrStat2, ErrMsg2 ); if (Failed()) return + + ! Read the lines up/including to the "Echo" simulation control variable + ! If echo is FALSE, don't write these lines to the echo file. + ! 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 --------------------------------------------- + CALL ReadCom( UnIn, InputFile, 'File header: FAST.Farm Version (line 1)', ErrStat2, ErrMsg2, UnEc ); if (Failed()) return + CALL ReadStr( UnIn, InputFile, p%FTitle, 'FTitle', 'File Header: File Description (line 2)', ErrStat2, ErrMsg2, UnEc ); if (Failed()) return + + !---------------------- SIMULATION CONTROL -------------------------------------- + CALL ReadCom( UnIn, InputFile, 'Section Header: Simulation Control', ErrStat2, ErrMsg2, UnEc ); if (Failed()) return + CALL ReadVar( UnIn, InputFile, Echo, "Echo", "Echo input data to .ech (flag)", ErrStat2, ErrMsg2, UnEc); if (Failed()) return + + IF (.NOT. Echo .OR. I > 1) EXIT !exit this loop + + ! Otherwise, open the echo file, then rewind the input file and echo everything we've read + I = I + 1 ! make sure we do this only once (increment counter that says how many times we've read this file) + CALL OpenEcho ( UnEc, TRIM(p%OutFileRoot)//'.ech', ErrStat2, ErrMsg2, Farm_Ver ); if (Failed()) return + IF ( UnEc > 0 ) WRITE (UnEc,'(/,A,/)') 'Data from '//TRIM(Farm_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 + + CALL WrScr( ' Heading of the '//TRIM(Farm_Ver%Name)//' input file: ' ) + CALL WrScr( ' '//TRIM( p%FTitle ) ) + + ! AbortLevel - Error level when simulation should abort: + CALL ReadVar( UnIn, InputFile, AbortLevel, "AbortLevel", "Error level when simulation should abort (string)", & + ErrStat2, ErrMsg2, UnEc); if (Failed()) return + + ! Let's set the abort level here.... knowing that everything before this aborted only on FATAL errors! + CALL Conv2UC( AbortLevel ) !convert to upper case + SELECT CASE( TRIM(AbortLevel) ) + CASE ( "WARNING" ) + AbortErrLev = ErrID_Warn + CASE ( "SEVERE" ) + AbortErrLev = ErrID_Severe + CASE ( "FATAL" ) + AbortErrLev = ErrID_Fatal + CASE DEFAULT + CALL SetErrStat( ErrID_Fatal, 'Invalid AbortLevel specified in FAST.Farm input file. '// & + 'Valid entries are "WARNING", "SEVERE", or "FATAL".',ErrStat,ErrMsg,RoutineName) + call cleanup() + RETURN + END SELECT + + CALL ReadVar( UnIn, InputFile, p%TMax, "TMax", "Total run time (s)", ErrStat2, ErrMsg2, UnEc); if (Failed()) return + CALL ReadVar( UnIn, InputFile, p%UseSC, "UseSC", "Use a super controller? (flag)", ErrStat2, ErrMsg2, UnEc); if (Failed()) return + CALL ReadVar( UnIn, InputFile, AWAE_InitInp%Mod_AmbWind, "Mod_AmbWind", "Ambient wind model (-) (switch) {1: high-fidelity precursor in VTK format, 2: one InflowWind module, 3: multiple InflowWind modules}", ErrStat2, ErrMsg2, UnEc); if (Failed()) return + CALL ReadVar( UnIn, InputFile, p%WaveFieldMod, "Mod_WaveField", "Wave field handling (-) (switch) {1: use individual HydroDyn inputs without adjustment, 2: adjust wave phases based on turbine offsets from farm origin}", ErrStat2, ErrMsg2, UnEc); if (Failed()) return + CALL ReadVar( UnIn, InputFile, p%MooringMod, "Mod_SharedMooring", "Array-level mooring handling (-) (switch) {0: none; 3: array-level MoorDyn model}", ErrStat2, ErrMsg2, UnEc); if (Failed()) return + + !---------------------- SUPER CONTROLLER ------------------------------------------------------------------ + CALL ReadCom( UnIn, InputFile, 'Section Header: Super Controller', ErrStat2, ErrMsg2, UnEc ); if (Failed()) return + CALL ReadVar( UnIn, InputFile, p%SC_FileName, "SC_FileName", "Name/location of the dynamic library {.dll [Windows] or .so [Linux]} containing the Super Controller algorithms (quoated string)", ErrStat2, ErrMsg2, UnEc); if (Failed()) return + IF ( PathIsRelative( p%SC_FileName ) ) p%SC_FileName = TRIM(PriPath)//TRIM(p%SC_FileName) + SC_InitInp%DLL_FileName = p%SC_FileName + + !---------------------- SHARED MOORING SYSTEM ------------------------------------------------------------------ + CALL ReadCom( UnIn, InputFile, 'Section Header: SHARED MOORING SYSTEM', ErrStat2, ErrMsg2, UnEc ); if (Failed()) return + CALL ReadVar( UnIn, InputFile, p%MD_FileName, "MD_FileName", "Name/location of the dynamic library {.dll [Windows] or .so [Linux]} containing the Super Controller algorithms (quoated string)", ErrStat2, ErrMsg2, UnEc); if (Failed()) return + IF ( PathIsRelative( p%MD_FileName ) ) p%MD_FileName = TRIM(PriPath)//TRIM(p%MD_FileName) + CALL ReadVar( UnIn, InputFile, p%DT_mooring, "DT_Mooring", "Time step for farm-levem mooring coupling with each turbine [used only when Mod_SharedMooring > 0] (s) [>0.0]", ErrStat2, ErrMsg2, UnEc); if (Failed()) return + CALL ReadVar( UnIn, InputFile, p%WrMooringVis, "MooringVis","Write shared mooring visualization, at DT_Mooring timestep (-) [only used for Mod_SharedMooring=3]", ErrStat2, ErrMsg2, UnEc); if (Failed()) return + + !---------------------- AMBIENT WIND: PRECURSOR IN VTK FORMAT --------------------------------------------- + CALL ReadCom( UnIn, InputFile, 'Section Header: Ambient Wind: Precursor in VTK Format', ErrStat2, ErrMsg2, UnEc ); if (Failed()) return + CALL ReadVar( UnIn, InputFile, p%DT_low, "DT_Low-VTK", "Time step for low-resolution wind data input files; will be used as the global FAST.Farm time step (s) [>0.0]", ErrStat2, ErrMsg2, UnEc); if (Failed()) return + CALL ReadVar( UnIn, InputFile, p%DT_high, "DT_High-VTK", "Time step for high-resolution wind data input files (s) [>0.0]", ErrStat2, ErrMsg2, UnEc); if (Failed()) return + CALL ReadVar( UnIn, InputFile, p%WindFilePath, "WindFilePath", "Path name of wind data files from ABLSolver precursor (string)", ErrStat2, ErrMsg2, UnEc); if (Failed()) return + IF ( PathIsRelative( p%WindFilePath ) ) p%WindFilePath = TRIM(PriPath)//TRIM(p%WindFilePath) + CALL ReadVar( UnIn, InputFile, AWAE_InitInp%ChkWndFiles, "ChkWndFiles", "Check all the ambient wind files for data consistency? (flag)", ErrStat2, ErrMsg2, UnEc); if (Failed()) return + + !---------------------- AMBIENT WIND: INFLOWWIND MODULE --------------------------------------------- + CALL ReadCom( UnIn, InputFile, 'Section Header: Ambient Wind: InflowWind Module', ErrStat2, ErrMsg2, UnEc ); if (Failed()) return + CALL ReadVar( UnIn, InputFile, AWAE_InitInp%DT_low, "DT_Low", "Time step for low-resolution wind data input files; will be used as the global FAST.Farm time step (s) [>0.0]", ErrStat2, ErrMsg2, UnEc); if (Failed()) return + CALL ReadVar( UnIn, InputFile, AWAE_InitInp%DT_high, "DT_High", "Time step for high-resolution wind data input files (s) [>0.0]", ErrStat2, ErrMsg2, UnEc); if (Failed()) return + + ! Ensure consistency between AWAE_Inputs and FAST.Farm time steps + if ( AWAE_InitInp%Mod_AmbWind == 1) AWAE_InitInp%DT_high = p%DT_high + if ( AWAE_InitInp%Mod_AmbWind == 1) AWAE_InitInp%DT_low = p%DT_low + if ( AWAE_InitInp%Mod_AmbWind > 1 ) p%DT_low = AWAE_InitInp%DT_low + if ( AWAE_InitInp%Mod_AmbWind > 1 ) p%DT_high = AWAE_InitInp%DT_high + + ! low res + CALL ReadVar( UnIn, InputFile, AWAE_InitInp%nX_Low, "nX_Low", "Number of low-resolution spatial nodes in X direction for wind data interpolation (-) [>=2]", ErrStat2, ErrMsg2, UnEc); if (Failed()) return + CALL ReadVar( UnIn, InputFile, AWAE_InitInp%nY_Low, "nY_Low", "Number of low-resolution spatial nodes in Y direction for wind data interpolation (-) [>=2]", ErrStat2, ErrMsg2, UnEc); if (Failed()) return + CALL ReadVar( UnIn, InputFile, AWAE_InitInp%nZ_Low, "nZ_Low", "Number of low-resolution spatial nodes in Z direction for wind data interpolation (-) [>=2]", ErrStat2, ErrMsg2, UnEc); if (Failed()) return + CALL ReadVar( UnIn, InputFile, AWAE_InitInp%X0_Low, "X0_Low", "Origin of low-resolution spatial nodes in X direction for wind data interpolation (m)", ErrStat2, ErrMsg2, UnEc); if (Failed()) return + CALL ReadVar( UnIn, InputFile, AWAE_InitInp%Y0_Low, "Y0_Low", "Origin of low-resolution spatial nodes in Y direction for wind data interpolation (m)", ErrStat2, ErrMsg2, UnEc); if (Failed()) return + CALL ReadVar( UnIn, InputFile, AWAE_InitInp%Z0_Low, "Z0_Low", "Origin of low-resolution spatial nodes in Z direction for wind data interpolation (m)", ErrStat2, ErrMsg2, UnEc); if (Failed()) return + CALL ReadVar( UnIn, InputFile, AWAE_InitInp%dX_Low, "dX_Low", "Spacing of low-resolution spatial nodes in X direction for wind data interpolation (m) [>0.0]", ErrStat2, ErrMsg2, UnEc); if (Failed()) return + CALL ReadVar( UnIn, InputFile, AWAE_InitInp%dY_Low, "dY_Low", "Spacing of low-resolution spatial nodes in Y direction for wind data interpolation (m) [>0.0]", ErrStat2, ErrMsg2, UnEc); if (Failed()) return + CALL ReadVar( UnIn, InputFile, AWAE_InitInp%dZ_Low, "dZ_Low", "Spacing of low-resolution spatial nodes in Z direction for wind data interpolation (m) [>0.0]", ErrStat2, ErrMsg2, UnEc); if (Failed()) return + + ! high res + CALL ReadVar( UnIn, InputFile, AWAE_InitInp%nX_High, "nX_High", "Number of high-resolution spatial nodes in X direction for wind data interpolation (-) [>=2]", ErrStat2, ErrMsg2, UnEc); if (Failed()) return + CALL ReadVar( UnIn, InputFile, AWAE_InitInp%nY_High, "nY_High", "Number of high-resolution spatial nodes in Y direction for wind data interpolation (-) [>=2]", ErrStat2, ErrMsg2, UnEc); if (Failed()) return + CALL ReadVar( UnIn, InputFile, AWAE_InitInp%nZ_High, "nZ_High", "Number of high-resolution spatial nodes in Z direction for wind data interpolation (-) [>=2]", ErrStat2, ErrMsg2, UnEc); if (Failed()) return + + ! inflow file + CALL ReadVar( UnIn, InputFile, AWAE_InitInp%InflowFile, "InflowFile", "Name of file containing InflowWind module input parameters (quoted string)", ErrStat2, ErrMsg2, UnEc); if (Failed()) return + IF ( PathIsRelative( AWAE_InitInp%InflowFile ) ) AWAE_InitInp%InflowFile = TRIM(PriPath)//TRIM(AWAE_InitInp%InflowFile) + if ( AWAE_InitInp%Mod_AmbWind > 1 ) p%WindFilePath = AWAE_InitInp%InflowFile ! For the summary file + + !---------------------- WIND TURBINES --------------------------------------------- + CALL ReadCom( UnIn, InputFile, 'Section Header: Wind Turbines', ErrStat2, ErrMsg2, UnEc ); if (Failed()) return + CALL ReadVar( UnIn, InputFile, p%NumTurbines, "NumTurbines", "Number of wind turbines (-) [>=1]", ErrStat2, ErrMsg2, UnEc); if (Failed()) return + CALL ReadCom( UnIn, InputFile, 'Section Header: WT column names', ErrStat2, ErrMsg2, UnEc ); if (Failed()) return + CALL ReadCom( UnIn, InputFile, 'Section Header: WT column units', ErrStat2, ErrMsg2, UnEc ); if (Failed()) return + + call AllocAry( p%WT_Position, 3, p%NumTurbines, 'WT_Position', ErrStat2, ErrMsg2); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName); if (Failed()) return + call AllocAry( p%WT_FASTInFile, p%NumTurbines, 'WT_FASTInFile', ErrStat2, ErrMsg2); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName); if (Failed()) return + call AllocAry( AWAE_InitInp%WT_Position, 3, p%NumTurbines, 'AWAE_InitInp%WT_Position', ErrStat2, ErrMsg2); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName); if (Failed()) return + + if ( AWAE_InitInp%Mod_AmbWind > 1 ) then ! Using InflowWind + call AllocAry(AWAE_InitInp%X0_high, p%NumTurbines, 'AWAE_InitInp%X0_high', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(AWAE_InitInp%Y0_high, p%NumTurbines, 'AWAE_InitInp%Y0_high', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(AWAE_InitInp%Z0_high, p%NumTurbines, 'AWAE_InitInp%Z0_high', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(AWAE_InitInp%dX_high, p%NumTurbines, 'AWAE_InitInp%dX_high', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(AWAE_InitInp%dY_high, p%NumTurbines, 'AWAE_InitInp%dY_high', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(AWAE_InitInp%dZ_high, p%NumTurbines, 'AWAE_InitInp%dZ_high', ErrStat2, ErrMsg2); if (Failed()) return + end if + + ! WT_Position (WT_X, WT_Y, WT_Z) and WT_FASTInFile + do i=1,p%NumTurbines + if ( AWAE_InitInp%Mod_AmbWind == 1 ) then + READ (UnIn, *, IOSTAT=IOS) p%WT_Position(:,i), p%WT_FASTInFile(i) + else + READ (UnIn, *, IOSTAT=IOS) p%WT_Position(:,i), p%WT_FASTInFile(i), AWAE_InitInp%X0_high(i), AWAE_InitInp%Y0_high(i), AWAE_InitInp%Z0_high(i), AWAE_InitInp%dX_high(i), AWAE_InitInp%dY_high(i), AWAE_InitInp%dZ_high(i) + end if + AWAE_InitInp%WT_Position(:,i) = p%WT_Position(:,i) + CALL CheckIOS ( IOS, InputFile, 'Wind Turbine Columns', NumType, ErrStat2, ErrMsg2 ); if (Failed()) return + IF ( UnEc > 0 ) THEN + if ( AWAE_InitInp%Mod_AmbWind == 1 ) then + WRITE( UnEc, "(3(ES11.4e2,2X),'""',A,'""',T50,' - WT(',I5,')')" ) p%WT_Position(:,i), TRIM( p%WT_FASTInFile(i) ), I + else + WRITE( UnEc, "(3(ES11.4e2,2X),'""',A,'""',T50,6(ES11.4e2,2X),' - WT(',I5,')')" ) p%WT_Position(:,i), TRIM( p%WT_FASTInFile(i) ), AWAE_InitInp%X0_high(i), AWAE_InitInp%Y0_high(i), AWAE_InitInp%Z0_high(i), AWAE_InitInp%dX_high(i), AWAE_InitInp%dY_high(i), AWAE_InitInp%dZ_high(i), I + end if + + END IF + IF ( PathIsRelative( p%WT_FASTInFile(i) ) ) p%WT_FASTInFile(i) = TRIM(PriPath)//TRIM(p%WT_FASTInFile(i)) + end do + + + !---------------------- WAKE DYNAMICS --------------------------------------------- + CALL ReadCom( UnIn, InputFile, 'Section Header: Wake Dynamics', ErrStat2, ErrMsg2, UnEc ); if (Failed()) return + CALL ReadVar( UnIn, InputFile, WD_InitInp%Mod_Wake, "Mod_Wake", "Wake model", ErrStat2, ErrMsg2, UnEc); if(failed()) return + CALL ReadVar( UnIn, InputFile, p%RotorDiamRef , "RotorDiamRef", "Reference turbine rotor diameter for wake calculations (m) [>0.0]", ErrStat2, ErrMsg2, UnEc); if(failed()) return + CALL ReadVar( UnIn, InputFile, WD_InitInp%dr , "dr" , "Radial increment of radial finite-difference grid (m) [>0.0]", ErrStat2, ErrMsg2, UnEc); if(failed()) return + CALL ReadVar( UnIn, InputFile, WD_InitInp%NumRadii, "NumRadii", "Number of radii in the radial finite-difference grid (-) [>=2]", ErrStat2, ErrMsg2, UnEc); if(failed()) return + CALL ReadVar( UnIn, InputFile, WD_InitInp%NumPlanes,"NumPlanes", "Number of wake planes (-) [>=2]", ErrStat2, ErrMsg2, UnEc); if(failed()) return + + ! f_c - Cut-off (corner) frequency of the low-pass time-filter for the wake advection, deflection, and meandering model (Hz) [>0.0] or DEFAULT [DEFAULT=0.0007]: + DefaultReVal = 12.5_ReKi/(p%RotorDiamRef/2._ReKi) ! Eq. (32) of https://doi.org/10.1002/we.2785, with U=10, a=1/3 + CALL ReadVarWDefault( UnIn, InputFile, WD_InitInp%f_c, "f_c", & + "Cut-off (corner) frequency of the low-pass time-filter for the wake advection, deflection, and meandering model (Hz) [>0.0] or DEFAULT [DEFAULT=0.0007]", & + DefaultReVal, ErrStat2, ErrMsg2, UnEc); if (Failed()) return + + ! C_HWkDfl_O + CALL ReadVarWDefault( UnIn, InputFile, WD_InitInp%C_HWkDfl_O, "C_HWkDfl_O", & + "Calibrated parameter in the correction for wake deflection defining the horizontal offset at the rotor (m) or DEFAULT [DEFAULT=0.0]", & + 0.0_ReKi, ErrStat2, ErrMsg2, UnEc); if (Failed()) return + + ! C_HWkDfl_OY + if (WD_InitInp%Mod_Wake == Mod_Wake_Curl) then + DefaultReVal = 0.0_ReKi + else + DefaultReVal = 0.3_ReKi + endif + CALL ReadVarWDefault( UnIn, InputFile, WD_InitInp%C_HWkDfl_OY, "C_HWkDfl_OY", & + "Calibrated parameter in the correction for wake deflection defining the horizontal offset at the rotor scaled with yaw error (m/deg) or DEFAULT [DEFAULT=0.3]", & + DefaultReVal, ErrStat2, ErrMsg2, UnEc); if (Failed()) return + WD_InitInp%C_HWkDfl_OY = WD_InitInp%C_HWkDfl_OY/D2R !immediately convert to m/radians instead of m/degrees + + ! C_HWkDfl_x + CALL ReadVarWDefault( UnIn, InputFile, WD_InitInp%C_HWkDfl_x, "C_HWkDfl_x", & + "Calibrated parameter in the correction for wake deflection defining the horizontal offset scaled with downstream distance (-) or DEFAULT [DEFAULT=0.0]", & + 0.0_ReKi, ErrStat2, ErrMsg2, UnEc); if (Failed()) return + + ! C_HWkDfl_xY + if (WD_InitInp%Mod_Wake == Mod_Wake_Curl) then + DefaultReVal = 0.0_ReKi + else + DefaultReVal = -0.004_ReKi + endif + CALL ReadVarWDefault( UnIn, InputFile, WD_InitInp%C_HWkDfl_xY, "C_HWkDfl_xY", & + "Calibrated parameter in the correction for wake deflection defining the horizontal offset scaled with downstream distance and yaw error (1/deg) or DEFAULT [DEFAULT=-0.004]", & + DefaultReVal, ErrStat2, ErrMsg2, UnEc); if (Failed()) return + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + WD_InitInp%C_HWkDfl_xY = WD_InitInp%C_HWkDfl_xY/D2R !immediately convert to 1/radians instead of 1/degrees + + + ! C_NearWake + CALL ReadVarWDefault( UnIn, InputFile, WD_InitInp%C_NearWake, "C_NearWake", & + "Calibrated parameter for the near-wake correction (-) [>1.0] or DEFAULT [DEFAULT=1.8]", & + 1.8_ReKi, ErrStat2, ErrMsg2, UnEc); if (Failed()) return + + ! k_vAmb - Calibrated parameters for the influence of the shear layer in the eddy viscosity (set of 5 parameters: k, FMin, DMin, DMax, Exp) (-) [>=0.0, >=0.0 and <=1.0, >=0.0, >DMin, >0.0] or DEFAULT [DEFAULT=0.05, 1.0, 0.0, 1.0, 0.01] + call ReadAryWDefault( UnIn, InputFile, TmpRAry5, 5, "k_vAmb", & + "Calibrated parameters for the influence of the shear layer in the eddy viscosity (set of 5 parameters: k, FMin, DMin, DMax, Exp) (-) [>=0.0, >=0.0 and <=1.0, >=0.0, >DMin, >0.0] or DEFAULT [DEFAULT=0.05, 1.0, 0.0, 1.0, 0.01]", & + (/ 0.05_ReKi, 1.0_ReKi, 0.0_ReKi, 1.0_ReKi, 0.01_ReKi /), ErrStat2, ErrMsg2, UnEc); if (Failed()) return + WD_InitInp%k_vAmb = TmpRAry5(1) ! Calibrated parameter for the influence of ambient turbulence in the eddy viscosity (-) [>=0.0] or DEFAULT [DEFAULT=0.05] + WD_InitInp%C_vAmb_FMin = TmpRAry5(2) ! Calibrated parameter in the eddy viscosity filter function for ambient turbulence defining the value in the minimum region (-) [>=0.0 and <=1.0] or DEFAULT [DEFAULT=1.0] + WD_InitInp%C_vAmb_DMin = TmpRAry5(3) ! Calibrated parameter in the eddy viscosity filter function for ambient turbulence defining the transitional diameter fraction between the minimum and exponential regions (-) [>=0.0] or DEFAULT [DEFAULT=0.0] + WD_InitInp%C_vAmb_DMax = TmpRAry5(4) ! 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 ] or DEFAULT [DEFAULT=1.0] + WD_InitInp%C_vAmb_Exp = TmpRAry5(5) ! Calibrated parameter in the eddy viscosity filter function for ambient turbulence defining the exponent in the exponential region (-) [> 0.0] or DEFAULT [DEFAULT=0.01] + + ! k_vShr - Calibrated parameters for the influence of the ambient turbulence in the eddy viscosity (set of 5 parameters: k, FMin, DMin, DMax, Exp) (-) [>=0.0, >=0.0 and <=1.0, >=0.0, >DMin, >0.0] or DEFAULT [DEFAULT=0.016, 0.2, 3.0, 25.0, 0.1] + call ReadAryWDefault( UnIn, InputFile, TmpRAry5, 5, "k_vShr", & + "Calibrated parameters for the influence of the ambient turbulence in the eddy viscosity (set of 5 parameters: k, FMin, DMin, DMax, Exp) (-) [>=0.0, >=0.0 and <=1.0, >=0.0, >DMin, >0.0] or DEFAULT [DEFAULT=0.016, 0.2, 3.0, 25.0, 0.1]", & + (/ 0.016_ReKi, 0.2_ReKi, 3.0_ReKi, 25.0_ReKi, 0.1_ReKi /), ErrStat2, ErrMsg2, UnEc); if (Failed()) return + WD_InitInp%k_vShr = TmpRAry5(1) ! Calibrated parameter for the influence of the shear layer in the eddy viscosity (-) [>=0.0] or DEFAULT [DEFAULT=0.016] + WD_InitInp%C_vShr_FMin = TmpRAry5(2) ! Calibrated parameter in the eddy viscosity filter function for the shear layer defining the value in the minimum region (-) [>=0.0 and <=1.0] or DEFAULT [DEFAULT=0.2] + WD_InitInp%C_vShr_DMin = TmpRAry5(3) ! 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] or DEFAULT [DEFAULT=3.0] + WD_InitInp%C_vShr_DMax = TmpRAry5(4) ! 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] or DEFAULT [DEFAULT=25.0] + WD_InitInp%C_vShr_Exp = TmpRAry5(5) ! Calibrated parameter in the eddy viscosity filter function for the shear layer defining the exponent in the exponential region (-) [> 0.0] or DEFAULT [DEFAULT=0.1] + + ! Mod_WakeDiam - Wake diameter calculation model (-) (switch) {1: rotor diameter, 2: velocity-based, 3: mass-flux based, 4: momentum-flux based} or DEFAULT [DEFAULT=1]: + CALL ReadVarWDefault( UnIn, InputFile, WD_InitInp%Mod_WakeDiam, "Mod_WakeDiam", & + "Wake diameter calculation model (-) (switch) {1: rotor diameter, 2: velocity-based, 3: mass-flux based, 4: momentum-flux based} or DEFAULT [DEFAULT=1]", & + WakeDiamMod_RotDiam, ErrStat2, ErrMsg2, UnEc); if (Failed()) return + + ! C_WakeDiam + CALL ReadVarWDefault( UnIn, InputFile, WD_InitInp%C_WakeDiam, "C_WakeDiam", & + "Calibrated parameter for wake diameter calculation (-) [>0.0 and <1.0] or DEFAULT [DEFAULT=0.95] [unused for Mod_WakeDiam=1]", & + 0.95_ReKi, ErrStat2, ErrMsg2, UnEc); if (Failed()) return + + ! Mod_Meander - Spatial filter model for wake meandering (-) (switch) {1: uniform, 2: truncated jinc, 3: windowed jinc} or DEFAULT [DEFAULT=3]: + CALL ReadVarWDefault( UnIn, InputFile, AWAE_InitInp%Mod_Meander, "Mod_Meander", & + "Spatial filter model for wake meandering (-) (switch) {1: uniform, 2: truncated jinc, 3: windowed jinc} or DEFAULT [DEFAULT=3]", & + MeanderMod_WndwdJinc, ErrStat2, ErrMsg2, UnEc); if (Failed()) return + + ! C_Meander + CALL ReadVarWDefault( UnIn, InputFile, AWAE_InitInp%C_Meander, "C_Meander", & + "Calibrated parameter for wake meandering (-) [>=1.0] or DEFAULT [DEFAULT=1.9]", & + 1.9_ReKi, ErrStat2, ErrMsg2, UnEc); if (Failed()) return + + !----------------------- CURL WAKE PARAMETERS ------------------------------------------ + CALL ReadCom ( UnIn, InputFile, "Section Header: Curl wake parameters", ErrStat2, ErrMsg2, UnEc ); if(failed()) return + CALL ReadVarWDefault( UnIn, InputFile, WD_InitInp%Swirl , "Swirl", "Swirl switch", .True., ErrStat2, ErrMsg2, UnEc); if(failed()) return + CALL ReadVarWDefault( UnIn, InputFile, WD_InitInp%k_VortexDecay, "k_VortexDecay", "Vortex decay constant", 0.0001, ErrStat2, ErrMsg2, UnEc); if(failed()) return + CALL ReadVarWDefault( UnIn, InputFile, WD_InitInp%NumVortices, "NumVortices", "Number of vortices in the curled wake", 100, ErrStat2, ErrMsg2, UnEc); if(failed()) return + CALL ReadVarWDefault( UnIn, InputFile, WD_InitInp%sigma_D, "sigma_D", "Gaussian vortex width", 0.2, ErrStat2, ErrMsg2, UnEc); if(failed()) return + CALL ReadVarWDefault( UnIn, InputFile, WD_InitInp%FilterInit, "FilterInit", "Filter Init", 1 , ErrStat2, ErrMsg2, UnEc); if(failed()) return + CALL ReadVarWDefault( UnIn, InputFile, WD_InitInp%k_vCurl, "k_vCurl", "Eddy viscosity for curl", 2.0 , ErrStat2, ErrMsg2, UnEc); if(failed()) return + CALL ReadVarWDefault( UnIn, InputFile, AWAE_InitInp%Mod_Projection, "Mod_Projection", "Mod_Projection", -1 , ErrStat2, ErrMsg2, UnEc); if(failed()) return + if (AWAE_InitInp%Mod_Projection==-1) then + ! -1 means the user selected "default" + if (WD_InitInp%Mod_Wake==Mod_Wake_Curl) then + AWAE_InitInp%Mod_Projection=2 + else + AWAE_InitInp%Mod_Projection=1 + endif + endif + !----------------------- WAKE-ADDED TURBULENCE ------------------------------------------ + ! Read WAT variables + CALL ReadCom( UnIn, InputFile, 'Section Header: Wake-added turbulence', ErrStat2, ErrMsg2, UnEc ); if(failed()) return + CALL ReadVar( UnIn, InputFile, p%WAT, "WAT", "Switch between wake-added turbulence box options {0: no wake added turbulence, 1: predefined turbulence box, 2: user defined turbulence box}", ErrStat2, ErrMsg2, UnEc); if(failed()) return + CALL ReadVar( UnIn, InputFile, p%WAT_BoxFile, 'WAT_BoxFile', "Filepath to the file containing the u-component of the turbulence box (either predefined or user-defined) (quoted string)", ErrStat2, ErrMsg2, UnEc ); if(failed()) return + call ReadAry( UnIn, InputFile, p%WAT_NxNyNz, 3, "WAT_NxNyNz", "Number of points in the x, y, and z directions of the WAT_BoxFile [used only if WAT=2] (m)", ErrStat2, ErrMsg2, UnEc ); if(failed()) return + call ReadAry( UnIn, InputFile, p%WAT_DxDyDz, 3, "WAT_DxDyDz", "Distance (in meters) between points in the x, y, and z directions of the WAT_BoxFile [used only if WAT=2] (m)", ErrStat2, ErrMsg2, UnEc ); if(failed()) return + call ReadVarWDefault( UnIn, InputFile, p%WAT_ScaleBox, "WAT_ScaleBox", "Flag to scale the input turbulence box to zero mean and unit standard deviation at every node", .False., ErrStat2, ErrMsg2, UnEc); if(failed()) return + call ReadAryWDefault( UnIn, InputFile, TmpRAry5, 5, "WAT_k_Def", & + "Calibrated parameters for the influence of the maximum wake deficit on wake-added turbulence (set of 5 parameters: k_Def , DMin, DMax, FMin, Exp) (-) [>=0.0, >=0.0, >DMin, >=0.0 and <=1.0, >=0.0] or DEFAULT [DEFAULT=[0.6, 0.0, 0.0, 2.0, 1.0 ]]", & + (/0.6_ReKi, 0.0_ReKi, 0.0_ReKi, 2.0_ReKi, 1.00_ReKi/), ErrStat2, ErrMsg2, UnEc); if(failed()) return + WD_InitInp%WAT_k_Def_k_c = TmpRAry5(1) + WD_InitInp%WAT_k_Def_FMin = TmpRAry5(2) + WD_InitInp%WAT_k_Def_DMin = TmpRAry5(3) + WD_InitInp%WAT_k_Def_DMax = TmpRAry5(4) + WD_InitInp%WAT_k_Def_Exp = TmpRAry5(5) + call ReadAryWDefault( UnIn, InputFile, TmpRAry5, 5, "WAT_k_Grad", & + "Calibrated parameters for the influence of the radial velocity gradient of the wake deficit on wake-added turbulence (set of 5 parameters: k_Grad, DMin, DMax, FMin, Exp) (-) [>=0.0, >=0.0, >DMin, >=0.0 and <=1.0, >=0.0] or DEFAULT [DEFAULT=[3.0, 0.0, 0.0, 12.0, 0.65]", & + (/3.0_ReKi, 0.0_ReKi, 0.0_ReKi,12.0_ReKi, 0.65_ReKi/), ErrStat2, ErrMsg2, UnEc); if(failed()) return + WD_InitInp%WAT_k_Grad_k_c = TmpRAry5(1) + WD_InitInp%WAT_k_Grad_FMin = TmpRAry5(2) + WD_InitInp%WAT_k_Grad_DMin = TmpRAry5(3) + WD_InitInp%WAT_k_Grad_DMax = TmpRAry5(4) + WD_InitInp%WAT_k_Grad_Exp = TmpRAry5(5) + if ( PathIsRelative( p%WAT_BoxFile ) ) p%WAT_BoxFile = TRIM(PriPath)//TRIM(p%WAT_BoxFile) + if (p%WAT > 0_IntKi) WD_InitInp%WAT = .true. + + + !---------------------- VISUALIZATION -------------------------------------------------- + CALL ReadCom( UnIn, InputFile, 'Section Header: Visualization', ErrStat2, ErrMsg2, UnEc ); if (Failed()) return + CALL ReadVar( UnIn, InputFile, AWAE_InitInp%WrDisWind, "WrDisWind", "Write disturbed wind data to .Low.Dis.t.vtk etc.? (flag)", ErrStat2, ErrMsg2, UnEc); if (Failed()) return + + ! XY planes + CALL ReadVar( UnIn, InputFile, AWAE_InitInp%NOutDisWindXY, "NOutDisWindXY", "Number of XY planes for output of disturbed wind data across the low-resolution domain to .Low.DisXY..t.vtk (-) [0 to 999]", ErrStat2, ErrMsg2, UnEc); if (Failed()) return + call allocAry( AWAE_InitInp%OutDisWindZ, AWAE_InitInp%NOutDisWindXY, "OutDisWindZ", ErrStat2, ErrMsg2 ); if (Failed()) return + CALL ReadAry( UnIn, InputFile, AWAE_InitInp%OutDisWindZ, AWAE_InitInp%NOutDisWindXY, "OutDisWindZ", "Z coordinates of XY planes for output of disturbed wind data across the low-resolution domain (m) [1 to NOutDisWindXY] [unused for NOutDisWindXY=0]", ErrStat2, ErrMsg2, UnEc); if (Failed()) return + + ! YZ planes + CALL ReadVar( UnIn, InputFile, AWAE_InitInp%NOutDisWindYZ, "NOutDisWindYZ", "Number of YZ planes for output of disturbed wind data across the low-resolution domain to .Low.DisYZ..t.vtk (-) [0 to 999]", ErrStat2, ErrMsg2, UnEc); if (Failed()) return + call allocAry( AWAE_InitInp%OutDisWindX, AWAE_InitInp%NOutDisWindYZ, "OutDisWindX", ErrStat2, ErrMsg2 ); if (Failed()) return + CALL ReadAry( UnIn, InputFile, AWAE_InitInp%OutDisWindX, AWAE_InitInp%NOutDisWindYZ, "OutDisWindX", "X coordinates of YZ planes for output of disturbed wind data across the low-resolution domain (m) [1 to NOutDisWindYZ] [unused for NOutDisWindYZ=0]", ErrStat2, ErrMsg2, UnEc); if (Failed()) return + + ! XZ planes + CALL ReadVar( UnIn, InputFile, AWAE_InitInp%NOutDisWindXZ, "NOutDisWindXZ", "Number of XZ planes for output of disturbed wind data across the low-resolution domain to .Low/DisXZ..t.vtk (-) [0 to 999]", ErrStat2, ErrMsg2, UnEc); if (Failed()) return + call allocAry( AWAE_InitInp%OutDisWindY, AWAE_InitInp%NOutDisWindXZ, "OutDisWindY", ErrStat2, ErrMsg2 ); if (Failed()) return + CALL ReadAry( UnIn, InputFile, AWAE_InitInp%OutDisWindY, AWAE_InitInp%NOutDisWindXZ, "OutDisWindY", "Y coordinates of XZ planes for output of disturbed wind data across the low-resolution domain (m) [1 to NOutDisWindXZ] [unused for NOutDisWindXZ=0]", ErrStat2, ErrMsg2, UnEc); if (Failed()) return + + CALL ReadVarWDefault( UnIn, InputFile, AWAE_InitInp%WrDisDT, "WrDisDT", "The time between vtk outputs [must be a multiple of the low resolution time step]", p%DT_low, ErrStat2, ErrMsg2, UnEc); if (Failed()) return + + !---------------------- OUTPUT -------------------------------------------------- + CALL ReadCom( UnIn, InputFile, 'Section Header: Output', ErrStat2, ErrMsg2, UnEc ); if (Failed()) return + CALL ReadVar( UnIn, InputFile, p%SumPrint, "SumPrint", "Print summary data to .sum? (flag)", ErrStat2, ErrMsg2, UnEc); if (Failed()) return + + CALL ReadVar( UnIn, InputFile, TmpTime, "ChkptTime", "Amount of time between creating checkpoint files for potential restart (s) [>0.0]", ErrStat2, ErrMsg2, UnEc); if (Failed()) return + IF (TmpTime > p%TMax) THEN + p%n_ChkptTime = HUGE(p%n_ChkptTime) + ELSE + p%n_ChkptTime = NINT( TmpTime / p%DT_low ) + END IF + + CALL ReadVar( UnIn, InputFile, p%TStart, "TStart", "Time to begin tabular output (s) [>=0.0]", ErrStat2, ErrMsg2, UnEc); if (Failed()) return + CALL ReadVar( UnIn, InputFile, OutFileFmt, "OutFileFmt", "Format for tabular (time-marching) output file (switch) {1: text file [.out], 2: binary file [.outb], 3: both}", ErrStat2, ErrMsg2, UnEc); if (Failed()) return + SELECT CASE (OutFileFmt) + CASE (1_IntKi) + p%WrBinOutFile = .FALSE. + p%WrTxtOutFile = .TRUE. + CASE (2_IntKi) + p%WrBinOutFile = .TRUE. + p%WrTxtOutFile = .FALSE. + CASE (3_IntKi) + p%WrBinOutFile = .TRUE. + p%WrTxtOutFile = .TRUE. + CASE DEFAULT + ! we'll check this later.... + !CALL SetErrStat( ErrID_Fatal, "FAST.Farm's OutFileFmt must be 1, 2, or 3.",ErrStat,ErrMsg,RoutineName) + !if ( ErrStat >= AbortErrLev ) then + ! call cleanup() + ! RETURN + !end if + END SELECT + + if ( OutFileFmt /= 1_IntKi ) then ! TODO: Only allow text format for now; add binary format later. + CALL SetErrStat( ErrID_Fatal, "FAST.Farm's OutFileFmt must be 1.",ErrStat,ErrMsg,RoutineName) + call cleanup() + RETURN + end if + + CALL ReadVar( UnIn, InputFile, TabDelim, "TabDelim", "Use tab delimiters in text tabular output file? (flag) {uses spaces if False}", ErrStat2, ErrMsg2, UnEc); if (Failed()) return + IF ( TabDelim ) THEN + p%Delim = TAB + ELSE + p%Delim = ' ' + END IF + + CALL ReadVar( UnIn, InputFile, p%OutFmt, "OutFmt", "Format used for text tabular output, excluding the time channel. Resulting field should be 10 characters. (quoted string)", ErrStat2, ErrMsg2, UnEc); if (Failed()) return + + CALL ReadVarWDefault( UnIn, InputFile, WD_InitInp%OutAllPlanes, "OutAllPlanes", "Output all planes", .False., ErrStat2, ErrMsg2, UnEc); if(failed()) return + + ! OutRadii + CALL ReadVar( UnIn, InputFile, p%NOutRadii, "NOutRadii", "Number of radial nodes for wake output for an individual rotor (-) [0 to 20]", ErrStat2, ErrMsg2, UnEc); if (Failed()) return + call allocary( p%OutRadii, p%NOutRadii, "OutRadii", ErrStat2, ErrMsg2 ); if (Failed()) return + CALL ReadAry( UnIn, InputFile, p%OutRadii, p%NOutRadii, "OutRadii", "List of radial nodes for wake output for an individual rotor (-) [1 to NOutRadii]", ErrStat2, ErrMsg2, UnEc); if (Failed()) return + + ! OutDist + CALL ReadVar( UnIn, InputFile, p%NOutDist, "NOutDist", "Number of downstream distances for wake output for an individual rotor (-) [0 to 9]", ErrStat2, ErrMsg2, UnEc); if (Failed()) return + call allocary( p%OutDist, p%NOutDist, "OutDist", ErrStat2, ErrMsg2 ); if (Failed()) return + CALL ReadAry( UnIn, InputFile, p%OutDist, p%NOutDist, "OutDist", "List of downstream distances for wake output for an individual rotor (m) [1 to NOutDist] [unused for NOutDist=0]", ErrStat2, ErrMsg2, UnEc); if (Failed()) return + + ! WindVel + CALL ReadVar( UnIn, InputFile, p%NWindVel, "NWindVel", "Number of points for wind output (-) [0 to 9]", ErrStat2, ErrMsg2, UnEc); if (Failed()) return + call allocAry( p%WindVelX, p%NWindVel, "WindVelX", ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName); if (Failed()) return + call allocAry( p%WindVelY, p%NWindVel, "WindVelY", ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName); if (Failed()) return + call allocAry( p%WindVelZ, p%NWindVel, "WindVelZ", ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName); if (Failed()) return + CALL ReadAry( UnIn, InputFile, p%WindVelX, p%NWindVel, "WindVelX", "List of coordinates in the X direction for wind output (m) [1 to NWindVel] [unused for NWindVel=0]", ErrStat2, ErrMsg2, UnEc); if (Failed()) return + CALL ReadAry( UnIn, InputFile, p%WindVelY, p%NWindVel, "WindVelY", "List of coordinates in the Y direction for wind output (m) [1 to NWindVel] [unused for NWindVel=0]", ErrStat2, ErrMsg2, UnEc); if (Failed()) return + CALL ReadAry( UnIn, InputFile, p%WindVelZ, p%NWindVel, "WindVelZ", "List of coordinates in the Z direction for wind output (m) [1 to NWindVel] [unused for NWindVel=0]", ErrStat2, ErrMsg2, UnEc); if (Failed()) return + + + !---------------------- OUTLIST -------------------------------------------- + CALL ReadCom( UnIn, InputFile, 'Section Header: OutList', ErrStat2, ErrMsg2, UnEc ); if (Failed()) return + CALL ReadOutputList ( UnIn, InputFile, OutList, p%NumOuts, 'OutList', "List of user-requested output channels", ErrStat2, ErrMsg2, UnEc ); if (Failed()) return ! Routine in NWTC Subroutine Library + + + !---------------------- END OF FILE ----------------------------------------- + + call cleanup() + RETURN + +CONTAINS + !............................................................................................................................... + subroutine cleanup() + CLOSE( UnIn ) + IF ( UnEc > 0 ) CLOSE ( UnEc ) + end subroutine cleanup + + logical function Failed() + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + if (Failed) call cleanup() + end function Failed + !............................................................................................................................... +END SUBROUTINE Farm_ReadPrimaryFile +!---------------------------------------------------------------------------------------------------------------------------------- +SUBROUTINE Farm_ValidateInput( p, WD_InitInp, AWAE_InitInp, SC_InitInp, ErrStat, ErrMsg ) + ! Passed variables + TYPE(Farm_ParameterType), INTENT(INOUT) :: p !< The parameter data for the FAST (glue-code) simulation + TYPE(WD_InputFileType), INTENT(IN ) :: WD_InitInp !< input-file data for WakeDynamics module + TYPE(AWAE_InputFileType), INTENT(INOUT) :: AWAE_InitInp !< input-file data for AWAE module + TYPE(SC_InitInputType), INTENT(INOUT) :: SC_InitInp ! input-file data for SC module + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message + + ! Local variables: + INTEGER(IntKi) :: i + INTEGER(IntKi) :: ErrStat2 ! Temporary Error status + CHARACTER(ErrMsgLen) :: ErrMsg2 ! Temporary Error message + CHARACTER(*), PARAMETER :: RoutineName = 'Farm_ValidateInput' + INTEGER(IntKi) :: n_disDT_dt + character(60) :: tmpStr + + ErrStat = ErrID_None + ErrMsg = "" + + + ! --- SIMULATION CONTROL --- + IF ((p%WaveFieldMod .ne. 1) .and. (p%WaveFieldMod .ne. 2)) CALL SetErrStat(ErrID_Fatal,'WaveFieldMod must be 1 or 2.',ErrStat,ErrMsg,RoutineName) + IF ((p%MooringMod .ne. 0) .and. (p%MooringMod .ne. 3)) CALL SetErrStat(ErrID_Fatal,'MooringMod must be 0 or 3.',ErrStat,ErrMsg,RoutineName) + + + IF (p%DT_low <= 0.0_ReKi) CALL SetErrStat(ErrID_Fatal,'DT_low must be positive.',ErrStat,ErrMsg,RoutineName) + IF (p%DT_high <= 0.0_ReKi) CALL SetErrStat(ErrID_Fatal,'DT_high must be positive.',ErrStat,ErrMsg,RoutineName) + IF (p%TMax < 0.0_ReKi) CALL SetErrStat(ErrID_Fatal,'TMax must not be negative.',ErrStat,ErrMsg,RoutineName) + IF (p%NumTurbines < 1) CALL SetErrStat(ErrID_Fatal,'FAST.Farm requires at least 1 turbine. Set NumTurbines > 0.',ErrStat,ErrMsg,RoutineName) + + ! --- SUPER CONTROLLER --- + ! TODO : Verify that the DLL file exists + + ! --- SHARED MOORING SYSTEM --- + ! TODO : Verify that p%MD_FileName file exists + if ((p%DT_mooring <= 0.0_ReKi) .or. (p%DT_mooring > p%DT_high)) CALL SetErrStat(ErrID_Fatal,'DT_mooring must be greater than zero and no greater than dt_high.',ErrStat,ErrMsg,RoutineName) + + ! --- AMBIENT WIND: INFLOWWIND MODULE --- [used only for Mod_AmbWind=2 or 3] --- + ! FIXME: this really should be checked with the turbine specific size diameter -- maybe relocate this check to AWAE or in FF after initializing all turbines? + if (AWAE_InitInp%Mod_AmbWind > 1) then + ! check that the grid is large enough to contain the turbine (only check Y and Z) + do i=1,p%NumTurbines + if (AWAE_InitInp%nY_High*AWAE_InitInp%dY_high(i) < p%RotorDiamRef) call SetErrStat(ErrID_Warn,'High res domain for turbine '//trim(Num2LStr(i))//' may be too small in Y (nY_High*dY_High < RotorDiamRef)',ErrStat,ErrMsg,RoutineName) + if (AWAE_InitInp%nZ_High*AWAE_InitInp%dZ_high(i) < p%RotorDiamRef) call SetErrStat(ErrID_Warn,'High res domain for turbine '//trim(Num2LStr(i))//' may be too small in Z (nZ_High*dZ_High < RotorDiamRef)',ErrStat,ErrMsg,RoutineName) + enddo + endif + + ! --- WAKE DYNAMICS --- + IF (WD_InitInp%Mod_Wake < 1 .or. WD_InitInp%Mod_Wake >3 ) CALL SetErrStat(ErrID_Fatal,'Mod_Wake needs to be 1,2 or 3',ErrStat,ErrMsg,RoutineName) + IF (WD_InitInp%dr <= 0.0_ReKi) CALL SetErrStat(ErrID_Fatal,'dr (radial increment) must be larger than 0.',ErrStat,ErrMsg,RoutineName) + IF (WD_InitInp%NumRadii < 2) CALL SetErrStat(ErrID_Fatal,'NumRadii (number of radii) must be at least 2.',ErrStat,ErrMsg,RoutineName) + IF (WD_InitInp%NumPlanes < 2) CALL SetErrStat(ErrID_Fatal,'NumPlanes (number of wake planes) must be at least 2.',ErrStat,ErrMsg,RoutineName) + + IF (WD_InitInp%k_VortexDecay < 0.0_ReKi) CALL SetErrStat(ErrID_Fatal,'k_VortexDecay needs to be postive',ErrStat,ErrMsg,RoutineName) + IF (WD_InitInp%NumVortices < 2) CALL SetErrStat(ErrID_Fatal,'NumVorticies needs to be greater than 1',ErrStat,ErrMsg,RoutineName) + IF (WD_InitInp%sigma_D < 0.0_ReKi) CALL SetErrStat(ErrID_Fatal,'sigma_D needs to be postive',ErrStat,ErrMsg,RoutineName) + IF (WD_InitInp%f_c <= 0.0_ReKi) CALL SetErrStat(ErrID_Fatal,'f_c (cut-off [corner] frequency) must be more than 0 Hz.',ErrStat,ErrMsg,RoutineName) + IF (WD_InitInp%C_NearWake <= 1.0_Reki) CALL SetErrStat(ErrID_Fatal,'C_NearWake parameter must be greater than 1.',ErrStat,ErrMsg,RoutineName) + IF (WD_InitInp%k_vCurl < 0.0_Reki) CALL SetErrStat(ErrID_Fatal,'k_vCurl parameter must not be negative.',ErrStat,ErrMsg,RoutineName) + + IF (WD_InitInp%k_vAmb < 0.0_Reki) CALL SetErrStat(ErrID_Fatal,'k_vAmb(1) (k_vAmb) must not be negative.',ErrStat,ErrMsg,RoutineName) + IF (WD_InitInp%C_vAmb_FMin < 0.0_Reki .or. WD_InitInp%C_vAmb_FMin > 1.0_Reki) CALL SetErrStat(ErrID_Fatal,'k_vAmb(2) (FMin) must be between 0 and 1 (inclusive).',ErrStat,ErrMsg,RoutineName) + IF (WD_InitInp%C_vAmb_DMin < 0.0_Reki) CALL SetErrStat(ErrID_Fatal,'k_vAmb(3) (DMin) must not be negative.',ErrStat,ErrMsg,RoutineName) + IF (WD_InitInp%C_vAmb_DMax <= WD_InitInp%C_vAmb_DMin) CALL SetErrStat(ErrID_Fatal,'k_vAmb(4) (DMax) must be larger than DMin.',ErrStat,ErrMsg,RoutineName) + IF (WD_InitInp%C_vAmb_Exp < 0.0_Reki) CALL SetErrStat(ErrID_Fatal,'k_vAmb(5) (e) must be >=0.',ErrStat,ErrMsg,RoutineName) + + IF (WD_InitInp%k_vShr < 0.0_Reki) CALL SetErrStat(ErrID_Fatal,'k_vShr(1) (k_vShr) must not be negative.',ErrStat,ErrMsg,RoutineName) + IF (WD_InitInp%C_vShr_FMin < 0.0_Reki .or. WD_InitInp%C_vShr_FMin > 1.0_ReKi) CALL SetErrStat(ErrID_Fatal,'k_vShr(2) (FMin) must be between 0 and 1 (inclusive).',ErrStat,ErrMsg,RoutineName) + IF (WD_InitInp%C_vShr_DMin < 0.0_Reki) CALL SetErrStat(ErrID_Fatal,'k_vShr(3) (DMin) must not be negative.',ErrStat,ErrMsg,RoutineName) + IF (WD_InitInp%C_vShr_DMax <= WD_InitInp%C_vShr_DMin) CALL SetErrStat(ErrID_Fatal,'k_vShr(4) (DMax) must be larger than DMin.',ErrStat,ErrMsg,RoutineName) + IF (WD_InitInp%C_vShr_Exp < 0.0_Reki) CALL SetErrStat(ErrID_Fatal,'k_vShr(5) (e) must be >=0.',ErrStat,ErrMsg,RoutineName) + + IF (WD_InitInp%Mod_WakeDiam < WakeDiamMod_RotDiam .or. WD_InitInp%Mod_WakeDiam > WakeDiamMod_MtmFlux) THEN + call SetErrStat(ErrID_Fatal,'Wake diameter calculation model, Mod_WakeDiam, must be 1 (rotor diameter), 2 (velocity-based), 3 (mass-flux based), 4 (momentum-flux based) or DEFAULT.',ErrStat,ErrMsg,RoutineName) + END IF + + IF (WD_InitInp%Mod_WakeDiam /= WakeDiamMod_RotDiam) THEN + IF (WD_InitInp%C_WakeDiam <= 0.0_Reki .or. WD_InitInp%C_WakeDiam >= 1.0_ReKi) THEN + CALL SetErrStat(ErrID_Fatal,'C_WakeDiam parameter must be between 0 and 1 (exclusive).',ErrStat,ErrMsg,RoutineName) + END IF + END IF + + + + IF (AWAE_InitInp%C_Meander < 1.0_Reki) THEN + CALL SetErrStat(ErrID_Fatal,'C_Meander parameter must not be less than 1.',ErrStat,ErrMsg,RoutineName) + END IF + + ! --- CURL + IF (WD_InitInp%FilterInit < 0 ) CALL SetErrStat(ErrID_Fatal,'FilterInit needs to >= 0',ErrStat,ErrMsg,RoutineName) + IF (AWAE_InitInp%Mod_Meander < MeanderMod_Uniform .or. AWAE_InitInp%Mod_Meander > MeanderMod_WndwdJinc) THEN + call SetErrStat(ErrID_Fatal,'Spatial filter model for wake meandering, Mod_Meander, must be 1 (uniform), 2 (truncated jinc), 3 (windowed jinc) or DEFAULT.',ErrStat,ErrMsg,RoutineName) + END IF + IF (.not.(ANY((/1,2,3/)==AWAE_InitInp%Mod_Projection))) CALL SetErrStat(ErrID_Fatal,'Mod_Projection needs to be 1, 2 or 3',ErrStat,ErrMsg,RoutineName) + + ! --- WAT + if (p%WAT < 0_IntKi .or. p%WAT > 2_IntKi) CALL SetErrStat(ErrID_Fatal,'WAT option must be 0: no wake added turbulence, 1: predefined turbulence box, or 2: user defined turbulence box.',ErrStat,ErrMsg,RoutineName) + if (p%WAT>0) then + ! Checks on k_Def + if (WD_InitInp%WAT_k_Def_k_c <= 0.0_ReKi) call SetErrStat(ErrID_Fatal,'WAT_k_Def(1) (k_def) must be >0.',ErrStat,ErrMsg,RoutineName) + if (WD_InitInp%WAT_k_Def_FMin < 0.0_ReKi .or. WD_InitInp%WAT_k_Def_FMin > 1.0_ReKi) call SetErrStat(ErrID_Fatal,'WAT_k_Def(2) (f_min) must be >=0 and <=1.',ErrStat,ErrMsg,RoutineName) + if (WD_InitInp%WAT_k_Def_DMin < 0.0_ReKi) call SetErrStat(ErrID_Fatal,'WAT_k_Def(3) (D_min) must be >=0.',ErrStat,ErrMsg,RoutineName) + if (WD_InitInp%WAT_k_Def_DMax <= WD_InitInp%WAT_k_Def_DMin) call SetErrStat(ErrID_Fatal,'WAT_k_Def(4) (D_max) must be greater than D_min.',ErrStat,ErrMsg,RoutineName) + if (WD_InitInp%WAT_k_Def_Exp < 0.0_ReKi) call SetErrStat(ErrID_Fatal,'WAT_k_Def(5) (e) must be >=0.',ErrStat,ErrMsg,RoutineName) + ! Tests on k_Grad + if (WD_InitInp%WAT_k_Grad_k_c <= 0.0_ReKi) call SetErrStat(ErrID_Fatal,'WAT_k_Grad(1) (k_def) must be >0.',ErrStat,ErrMsg,RoutineName) + if (WD_InitInp%WAT_k_Grad_FMin < 0.0_ReKi .or. WD_InitInp%WAT_k_Grad_FMin > 1.0_ReKi) call SetErrStat(ErrID_Fatal,'WAT_k_Grad(2) (f_min) must be >=0 and <=1.',ErrStat,ErrMsg,RoutineName) + if (WD_InitInp%WAT_k_Grad_DMin < 0.0_ReKi) call SetErrStat(ErrID_Fatal,'WAT_k_Grad(3) (D_min) must be >=0.',ErrStat,ErrMsg,RoutineName) + if (WD_InitInp%WAT_k_Grad_DMax <= WD_InitInp%WAT_k_Grad_DMin) call SetErrStat(ErrID_Fatal,'WAT_k_Grad(4) (D_max) must be greater than D_min.',ErrStat,ErrMsg,RoutineName) + if (WD_InitInp%WAT_k_Grad_Exp < 0.0_ReKi) call SetErrStat(ErrID_Fatal,'WAT_k_Grad(5) (e) must be >=0.',ErrStat,ErrMsg,RoutineName) + ! summary table + call WrScr(' Wake-Added Turbulence (WAT): coefficients:') + call WrScr(' k_c f_min D_min D_max e') + write(tmpStr,'(A6,A6,6(f9.3))') '','k_Def', WD_InitInp%WAT_k_Def_k_c, WD_InitInp%WAT_k_Def_FMin, WD_InitInp%WAT_k_Def_DMin, WD_InitInp%WAT_k_Def_DMax, WD_InitInp%WAT_k_Def_Exp + call WrScr(tmpStr) + write(tmpStr,'(A6,A6,6(f9.3))') '','k_Grad',WD_InitInp%WAT_k_Grad_k_c,WD_InitInp%WAT_k_Grad_FMin,WD_InitInp%WAT_k_Grad_DMin,WD_InitInp%WAT_k_Grad_DMax,WD_InitInp%WAT_k_Grad_Exp + call WrScr(tmpStr) + endif + + !--- OUTPUT --- + IF ( p%n_ChkptTime < 1_IntKi ) CALL SetErrStat( ErrID_Fatal, 'ChkptTime must be greater than 0 seconds.', ErrStat, ErrMsg, RoutineName ) + IF (p%TStart < 0.0_ReKi) CALL SetErrStat(ErrID_Fatal,'TStart must not be negative.',ErrStat,ErrMsg,RoutineName) + IF (.not. p%WrBinOutFile .and. .not. p%WrTxtOutFile) CALL SetErrStat( ErrID_Fatal, "FAST.Farm's OutFileFmt must be 1, 2, or 3.",ErrStat,ErrMsg,RoutineName) + + if (AWAE_InitInp%WrDisDT < p%DT_low) CALL SetErrStat(ErrID_Fatal,'WrDisDT must greater than or equal to dt_low.',ErrStat,ErrMsg,RoutineName) + + ! let's make sure the FAST.Farm DT_low is an exact integer divisor of AWAE_InitInp%WrDisDT + n_disDT_dt = nint( AWAE_InitInp%WrDisDT / p%DT_low ) + ! (i'm doing this outside of Farm_ValidateInput so we know that dt_low/=0 before computing n_high_low): + IF ( .NOT. EqualRealNos( real(p%DT_low,SiKi)* n_disDT_dt, real(AWAE_InitInp%WrDisDT,SiKi) ) ) THEN + CALL SetErrStat(ErrID_Fatal, "WrDisDT ("//TRIM(Num2LStr(AWAE_InitInp%WrDisDT))//" s) must be an integer multiple of dt_low ("//TRIM(Num2LStr(p%DT_low))//" s).", ErrStat, ErrMsg, RoutineName ) + END IF + AWAE_InitInp%WrDisDT = p%DT_low * n_disDT_dt + + + if (AWAE_InitInp%NOutDisWindXY < 0 .or. AWAE_InitInp%NOutDisWindXY > maxOutputPlanes ) CALL SetErrStat( ErrID_Fatal, 'NOutDisWindXY must be in the range [0, 999].', ErrStat, ErrMsg, RoutineName ) + if (AWAE_InitInp%NOutDisWindYZ < 0 .or. AWAE_InitInp%NOutDisWindYZ > maxOutputPlanes ) CALL SetErrStat( ErrID_Fatal, 'NOutDisWindYZ must be in the range [0, 999].', ErrStat, ErrMsg, RoutineName ) + if (AWAE_InitInp%NOutDisWindXZ < 0 .or. AWAE_InitInp%NOutDisWindXZ > maxOutputPlanes ) CALL SetErrStat( ErrID_Fatal, 'NOutDisWindXZ must be in the range [0, 999].', ErrStat, ErrMsg, RoutineName ) + if (p%NOutDist < 0 .or. p%NOutDist > maxOutputPoints ) then + CALL SetErrStat( ErrID_Fatal, 'NOutDist must be in the range [0, 9].', ErrStat, ErrMsg, RoutineName ) + else + do i=1,p%NOutDist + if (p%OutDist(i) < 0.0_ReKi) then + CALL SetErrStat( ErrID_Fatal, 'OutDist values must be greater than or equal to zero.', ErrStat, ErrMsg, RoutineName ) + exit + end if + end do + end if + + if (p%NWindVel < 0 .or. p%NWindVel > maxOutputPoints ) CALL SetErrStat( ErrID_Fatal, 'NWindVel must be in the range [0, 9].', ErrStat, ErrMsg, RoutineName ) + if (p%NOutRadii < 0 .or. p%NOutRadii > 20 ) then + CALL SetErrStat( ErrID_Fatal, 'NOutRadii must be in the range [0, 20].', ErrStat, ErrMsg, RoutineName ) + else + do i=1,p%NOutRadii + if (p%OutRadii(i) > WD_InitInp%NumRadii - 1 .or. p%OutRadii(i) < 0) then + CALL SetErrStat( ErrID_Fatal, 'OutRadii must be in the range [0, NumRadii - 1].', ErrStat, ErrMsg, RoutineName ) + exit + end if + end do + end if + + + ! Check that OutFmt is a valid format specifier and will fit over the column headings + CALL ChkRealFmtStr( p%OutFmt, 'OutFmt', p%FmtWidth, ErrStat2, ErrMsg2 ) !this sets p%FmtWidth! + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + IF ( p%FmtWidth > ChanLen ) CALL SetErrStat( ErrID_Warn, 'OutFmt produces a column width of '// & + TRIM(Num2LStr(p%FmtWidth))//' instead of '//TRIM(Num2LStr(ChanLen))//' characters.', ErrStat, ErrMsg, RoutineName ) + + +END SUBROUTINE Farm_ValidateInput end module FAST_Farm_IO diff --git a/glue-codes/fast-farm/src/FAST_Farm_Registry.txt b/glue-codes/fast-farm/src/FAST_Farm_Registry.txt index 9f595b55c5..a05215d217 100644 --- a/glue-codes/fast-farm/src/FAST_Farm_Registry.txt +++ b/glue-codes/fast-farm/src/FAST_Farm_Registry.txt @@ -17,13 +17,18 @@ usefrom WakeDynamics_Registry.txt usefrom AWAE_Registry.txt usefrom SuperController_Registry.txt -param FAST_Farm/Farm - INTEGER NumFFModules - 5 - "The number of modules available in FAST.Farm" - -param ^ - INTEGER ModuleFF_None - 0 - "No module selected" - -param ^ - INTEGER ModuleFF_SC - 1 - "Super Controller" - -param ^ - INTEGER ModuleFF_FWrap - 2 - "FAST Wrapper" - -param ^ - INTEGER ModuleFF_WD - 3 - "Wake Dynamics" - -param ^ - INTEGER ModuleFF_AWAE - 4 - "Ambient Wind and Array Effects" - -param ^ - INTEGER ModuleFF_MD - 5 - "Farm-level MoorDyn" - +param FAST_Farm/Farm - INTEGER NumFFModules - 5 - "The number of modules available in FAST.Farm" - +param ^ - INTEGER ModuleFF_None - 0 - "No module selected" - +param ^ - INTEGER ModuleFF_SC - 1 - "Super Controller" - +param ^ - INTEGER ModuleFF_FWrap - 2 - "FAST Wrapper" - +param ^ - INTEGER ModuleFF_WD - 3 - "Wake Dynamics" - +param ^ - INTEGER ModuleFF_AWAE - 4 - "Ambient Wind and Array Effects" - +param ^ - INTEGER ModuleFF_MD - 5 - "Farm-level MoorDyn" - + +param ^ - INTEGER Mod_WAT_None - 0 - "WAT: off" - +param ^ - INTEGER Mod_WAT_PreDef - 1 - "WAT: predefined turbulence boxes" - +param ^ - INTEGER Mod_WAT_UserDef - 2 - "WAT: user defined turbulence boxes" - + # ..... Parameters ................................................................................................................ typedef FAST_Farm/Farm ParameterType DbKi DT_low - - - "Time step for low-resolution wind data input files; will be used as the global FAST.Farm time step" seconds typedef ^ ParameterType DbKi DT_high - - - "High-resolution time step" seconds @@ -32,21 +37,23 @@ typedef ^ ParameterType IntKi n_high_low - typedef ^ ParameterType IntKi NumTurbines - - - "Number of turbines in the simulation" - typedef ^ ParameterType CHARACTER(1024) WindFilePath - - - "Path name of wind data files from ABLSolver precursor" - typedef ^ ParameterType CHARACTER(1024) SC_FileName - - - "Name/location of the dynamic library {.dll [Windows] or .so [Linux]} containing the Super Controller algorithms" - -typedef ^ ParameterType LOGICAL UseSC - - - "Use a super controller?" - +typedef ^ ParameterType LOGICAL UseSC - - - "Use a super controller?" - typedef ^ ParameterType ReKi WT_Position {:}{:} - - "X-Y-Z position of each wind turbine; index 1 = XYZ; index 2 = turbine number" meters typedef ^ ParameterType IntKi WaveFieldMod - - - "Wave field handling (-) (switch) {0: use individual HydroDyn inputs without adjustment, 1: adjust wave phases based on turbine offsets from farm origin}" - typedef ^ ParameterType IntKi MooringMod - - - "Mod_SharedMooring is a flag for array-level mooring. (switch) {0: none, 3: yes/MoorDyn}" - +typedef ^ ParameterType logical WrMooringVis - - - "Write shared mooring visualization (-) [only used for Mod_SharedMooring=3]" - typedef ^ ParameterType CHARACTER(1024) MD_FileName - - - "Name/location of the farm-level MoorDyn input file" - typedef ^ ParameterType DbKi DT_mooring - - - "Time step for farm-levem mooring coupling with each turbine [used only when Mod_SharedMooring > 0]" seconds typedef ^ ParameterType IntKi n_mooring - - - "Number of FAST and MoorDyn time steps per FAST.Farm timestep when mooring > 0" - typedef ^ ParameterType CHARACTER(1024) WT_FASTInFile {:} - - "Name of input file for each turbine" - typedef ^ ParameterType CHARACTER(1024) FTitle - - - "The description line from the primary FAST.Farm input file" - typedef ^ ParameterType CHARACTER(1024) OutFileRoot - - - "The root name derived from the primary FAST.Farm input file" - -typedef ^ ParameterType INTEGER n_ChkptTime - - - "Number of time steps between writing checkpoint files" - +typedef ^ ParameterType INTEGER n_ChkptTime - - - "Number of time steps between writing checkpoint files" - typedef ^ ParameterType DbKi TStart - - - "Time to begin tabular output" s typedef ^ ParameterType IntKi n_TMax - - - "Number of the time step of TMax (the end time of the simulation)" - +typedef ^ ParameterType ReKi RotorDiamRef - - - "Reference turbine rotor diameter for wake calculations (m) [>0.0]" - # parameters for data output to files: -typedef ^ ParameterType LOGICAL SumPrint - - - "Print summary data to file? (.sum)" - +typedef ^ ParameterType LOGICAL SumPrint - - - "Print summary data to file? (.sum)" - typedef ^ ParameterType LOGICAL WrBinOutFile - - - "Write a binary output file? (.outb)" - typedef ^ ParameterType LOGICAL WrTxtOutFile - - - "Write a text (formatted) output file? (.out)" - typedef ^ ParameterType CHARACTER(1) Delim - - - "Delimiter between columns of text output file (.out): space or tab" - @@ -63,11 +70,11 @@ typedef ^ ParameterType IntKi NWindVel - typedef ^ ParameterType ReKi WindVelX {:} - - "List of coordinates in the X direction for wind output [1 to NWindVel]" meters typedef ^ ParameterType ReKi WindVelY {:} - - "List of coordinates in the Y direction for wind output [1 to NWindVel]" meters typedef ^ ParameterType ReKi WindVelZ {:} - - "List of coordinates in the Z direction for wind output [1 to NWindVel]" meters -typedef ^ ParameterType OutParmType OutParam {:} - - "Names and units (and other characteristics) of all requested output parameters" - +typedef ^ ParameterType OutParmType OutParam {:} - - "Names and units (and other characteristics) of all requested output parameter" - typedef ^ ParameterType IntKi NumOuts - - - "Number of user-requested outputs" - -typedef ^ ParameterType IntKi NOutSteps - - - "Maximum number of output steps" - -typedef ^ ParameterType CHARACTER(1024) FileDescLines {3} - - "File Description lines" - -typedef ^ ParameterType ProgDesc Module_Ver {NumModules} - - "Version information from all modules" +typedef ^ ParameterType IntKi NOutSteps - - - "Maximum number of output steps" - +typedef ^ ParameterType CHARACTER(1024) FileDescLines {3} - - "File Description lines" - +typedef ^ ParameterType ProgDesc Module_Ver {NumModules} - - "Version information from all modules" typedef ^ ParameterType IntKi UnOu - - - "File unit for Fast.Farm output data" - typedef ^ ParameterType ReKi dX_low - - - "The spacing of the low-resolution nodes in X direction" m @@ -79,14 +86,21 @@ typedef ^ ParameterType IntKi nZ_low - typedef ^ ParameterType ReKi X0_low - - - "X-component of the origin of the low-resolution spatial domain" m typedef ^ ParameterType ReKi Y0_low - - - "Y-component of the origin of the low-resolution spatial domain" m typedef ^ ParameterType ReKi Z0_low - - - "Z-component of the origin of the low-resolution spatial domain" m -# ..... FAST MiscVar data ....................................................................................................... -typedef ^ MiscVarType ReKi AllOuts {:} - - "An array holding the value of all of the calculated (not only selected) output channels" "see OutListParameters.xlsx spreadsheet" -typedef ^ ^ DbKi TimeData {:} - - "Array to contain the time output data for the binary file (first output time and a time [fixed] increment)" -typedef ^ ^ ReKi AllOutData {:}{:} - - "Array to contain all the output data (time history of all outputs); Index 1 is NumOuts, Index 2 is Time step" -typedef ^ ^ IntKi n_Out - - - "Time index into the AllOutData array" -typedef ^ MiscVarType MeshMapType FWrap_2_MD {:} - - "Map platform kinematics from each FAST instance to MD" -typedef ^ MiscVarType MeshMapType MD_2_FWrap {:} - - "Map MD loads at the array level to each FAST instance" +typedef ^ ParameterType IntKi WAT - - - "Switch between wake-added turbulence box options {0: no wake added turbulence, 1: predefined turbulence box, 2: user defined turbulence box}" - +typedef ^ ParameterType CHARACTER(1024) WAT_BoxFile - - - "Filepath to the file containing the u-component of the turbulence box (either predefined or user-defined)." - +typedef ^ ParameterType IntKi WAT_NxNyNz {3} - - "Number of points in the x, y, and z directions of the WAT_BoxFile -- derived (WAT=1) or read from input file (WAT=2)" (m) +typedef ^ ParameterType ReKi WAT_DxDyDz {3} - - "Distance (in meters) between points in the x, y, and z directions of the WAT_BoxFile -- derived (WAT=1) or read from input file (WAT=2)" (m) +typedef ^ ParameterType logical WAT_ScaleBox - - - "Flag to scale the input turbulence box to zero mean and unit standard deviation at every node" - + +# ..... FARM MiscVar data ....................................................................................................... +typedef ^ MiscVarType ReKi AllOuts {:} - - "An array holding the value of all of the calculated (not only selected) output channels" "see OutListParameters.xlsx spreadsheet" +typedef ^ ^ DbKi TimeData {:} - - "Array to contain the time output data for the binary file (first output time and a time [fixed] increment)" +typedef ^ ^ ReKi AllOutData {:}{:} - - "Array to contain all the output data (time history of all outputs); Index 1 is NumOuts, Index 2 is Time step" +typedef ^ ^ IntKi n_Out - - - "Time index into the AllOutData array" + +typedef ^ ^ MeshMapType FWrap_2_MD {:} - - "Map platform kinematics from each FAST instance to MD" +typedef ^ ^ MeshMapType MD_2_FWrap {:} - - "Map MD loads at the array level to each FAST instance" # ..... FASTWrapper data ....................................................................................................... @@ -144,6 +158,19 @@ typedef ^ ^ DbKi InputTimes {:} - typedef ^ ^ MD_OutputType y - - - "System outputs" typedef ^ ^ MD_MiscVarType m - - - "Misc/optimization variables" typedef ^ ^ logical IsInitialized - .FALSE. - "Has MD_Init been called" +typedef ^ ^ IntKi VTK_count - 0 - "Counter for VTK output of shared moorings" +typedef ^ ^ IntKi VTK_TWidth - - - "width for VTK_count field in output name" +typedef ^ ^ character(1024) VTK_OutFileRoot - - - "Rootfilename for VTK output" +# ..... WAT InflowWind data ............................................................................................ +typedef ^ WAT_IfW_data InflowWind_ContinuousStateType x - - - "Continuous states" +typedef ^ ^ InflowWind_DiscreteStateType xd - - - "Discrete states" +typedef ^ ^ InflowWind_ConstraintStateType z - - - "Constraint states" +typedef ^ ^ InflowWind_OtherStateType OtherSt - - - "Other states" +typedef ^ ^ InflowWind_ParameterType p - - - "Parameters" +typedef ^ ^ InflowWind_InputType u - - - "System inputs" +typedef ^ ^ InflowWind_OutputType y - - - "System outputs" +typedef ^ ^ InflowWind_MiscVarType m - - - "Misc/optimization variables" +typedef ^ ^ logical IsInitialized - .FALSE. - "Has IfW_Init been called" # ..... All submodules' variables................................................................................................. typedef ^ All_FastFarm_Data Farm_ParameterType p - - - "FAST.Farm parameter data" - typedef ^ All_FastFarm_Data Farm_MiscVarType m - - - "FAST.Farm misc var data" - @@ -152,5 +179,6 @@ typedef ^ All_FastFarm_Data WakeDynamics_Data WD {:} - - typedef ^ All_FastFarm_Data AWAE_Data AWAE - - - "Ambient Wind & Array Effects (AWAE) data" - typedef ^ All_FastFarm_Data SC_Data SC - - - "Super Controller (SC) data" - typedef ^ All_FastFarm_Data MD_Data MD - - - "Farm-level MoorDyn model data" - +typedef ^ All_FastFarm_Data WAT_IfW_Data WAT_IfW - - - "IfW data for WAT (temporary location until pointers are enabled)" - # ..... FAST.Farm data ................................................................................................................ # diff --git a/glue-codes/fast-farm/src/FAST_Farm_Subs.f90 b/glue-codes/fast-farm/src/FAST_Farm_Subs.f90 index 0727b70b07..0a7f1a60b0 100644 --- a/glue-codes/fast-farm/src/FAST_Farm_Subs.f90 +++ b/glue-codes/fast-farm/src/FAST_Farm_Subs.f90 @@ -38,16 +38,9 @@ MODULE FAST_Farm_Subs USE OMP_LIB #endif - IMPLICIT NONE - - - - integer, parameter :: maxOutputPoints = 9 - integer, parameter :: maxOutputPlanes = 999 ! Allow up to 999 outpt planes - CONTAINS - +CONTAINS subroutine TrilinearInterpRegGrid(V, pt, dims, val) @@ -170,9 +163,7 @@ SUBROUTINE Farm_Initialize( farm, InputFile, ErrStat, ErrMsg ) IF (LEN_TRIM(InputFile) == 0) THEN ! no input file was specified CALL SetErrStat( ErrID_Fatal, 'The required input file was not specified on the command line.', ErrStat, ErrMsg, RoutineName ) - CALL NWTC_DisplaySyntax( InputFile, 'FAST.Farm.exe' ) - RETURN END IF @@ -192,23 +183,13 @@ SUBROUTINE Farm_Initialize( farm, InputFile, ErrStat, ErrMsg ) ! step 1: read input file !............................................................................................................................... - call Farm_ReadPrimaryFile( InputFile, farm%p, WD_InitInput%InputFileData, AWAE_InitInput%InputFileData, SC_InitInp, OutList, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF + call Farm_ReadPrimaryFile( InputFile, farm%p, WD_InitInput%InputFileData, AWAE_InitInput%InputFileData, SC_InitInp, OutList, ErrStat2, ErrMsg2 ); if(Failed()) return; !............................................................................................................................... ! step 2: validate input & set parameters !............................................................................................................................... - call Farm_ValidateInput( farm%p, WD_InitInput%InputFileData, AWAE_InitInput%InputFileData, SC_InitInp, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF + call Farm_ValidateInput( farm%p, WD_InitInput%InputFileData, AWAE_InitInput%InputFileData, SC_InitInp, ErrStat2, ErrMsg2 ); if(Failed()) return; farm%p%NOutTurb = min(farm%p%NumTurbines,9) ! We only support output for the first 9 turbines, even if the farm has more than 9 @@ -233,14 +214,22 @@ SUBROUTINE Farm_Initialize( farm, InputFile, ErrStat, ErrMsg ) ENDIF !............................................................................................................................... - ! step 3: initialize SC, AWAE, and WD (a, b, and c can be done in parallel) + ! step 3: initialize WAT, AWAE, SC, and WD (b, c, and d can be done in parallel) !............................................................................................................................... - + !------------------- - ! a. CALL AWAE_Init - + ! a. read WAT input files using InflowWind + if (farm%p%WAT /= Mod_WAT_None) then + call WAT_init( farm%p, farm%WAT_IfW, AWAE_InitInput, ErrStat2, ErrMsg2 ) + if(Failed()) return; + endif + + !------------------- + ! b. CALL AWAE_Init + + if (farm%p%WAT /= Mod_WAT_None) AWAE_InitInput%WAT_Enabled = .true. AWAE_InitInput%InputFileData%dr = WD_InitInput%InputFileData%dr - AWAE_InitInput%InputFileData%dt_low = farm%p%dt_low + AWAE_InitInput%InputFileData%dt_low = farm%p%dt_low AWAE_InitInput%InputFileData%NumTurbines = farm%p%NumTurbines AWAE_InitInput%InputFileData%NumRadii = WD_InitInput%InputFileData%NumRadii AWAE_InitInput%InputFileData%NumPlanes = WD_InitInput%InputFileData%NumPlanes @@ -248,13 +237,12 @@ SUBROUTINE Farm_Initialize( farm, InputFile, ErrStat, ErrMsg ) AWAE_InitInput%n_high_low = farm%p%n_high_low AWAE_InitInput%NumDT = farm%p%n_TMax AWAE_InitInput%OutFileRoot = farm%p%OutFileRoot + if (farm%p%WAT /= Mod_WAT_None .and. associated(farm%WAT_IfW%p%FlowField)) then + AWAE_InitInput%WAT_FlowField => farm%WAT_IfW%p%FlowField + endif call AWAE_Init( AWAE_InitInput, farm%AWAE%u, farm%AWAE%p, farm%AWAE%x, farm%AWAE%xd, farm%AWAE%z, farm%AWAE%OtherSt, farm%AWAE%y, & farm%AWAE%m, farm%p%DT_low, AWAE_InitOutput, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF + if(Failed()) return; farm%AWAE%IsInitialized = .true. @@ -270,16 +258,11 @@ SUBROUTINE Farm_Initialize( farm, InputFile, ErrStat, ErrMsg ) farm%p%Module_Ver( ModuleFF_AWAE ) = AWAE_InitOutput%Ver !------------------- - ! b. CALL SC_Init + ! c. CALL SC_Init if ( farm%p%useSC ) then SC_InitInp%nTurbines = farm%p%NumTurbines call SC_Init(SC_InitInp, farm%SC%uInputs, farm%SC%p, farm%SC%x, farm%SC%xd, farm%SC%z, farm%SC%OtherState, & - farm%SC%y, farm%SC%m, farm%p%DT_low, SC_InitOut, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - if (ErrStat >= AbortErrLev) then - call Cleanup() - return - end if + farm%SC%y, farm%SC%m, farm%p%DT_low, SC_InitOut, ErrStat2, ErrMsg2); if(Failed()) return; farm%p%Module_Ver( ModuleFF_SC ) = SC_InitOut%Ver farm%SC%IsInitialized = .true. else @@ -300,38 +283,23 @@ SUBROUTINE Farm_Initialize( farm, InputFile, ErrStat, ErrMsg ) end if !------------------- - ! c. initialize WD (one instance per turbine, each can be done in parallel, too) + ! d. initialize WD (one instance per turbine, each can be done in parallel, too) - call Farm_InitWD( farm, WD_InitInput, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF + call Farm_InitWD( farm, WD_InitInput, ErrStat2, ErrMsg2 ); if(Failed()) return; !............................................................................................................................... ! step 4: initialize FAST (each instance of FAST can also be done in parallel) !............................................................................................................................... - CALL Farm_InitFAST( farm, WD_InitInput%InputFileData, AWAE_InitOutput, SC_InitOut, farm%SC%y, ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF + CALL Farm_InitFAST( farm, WD_InitInput%InputFileData, AWAE_InitOutput, SC_InitOut, farm%SC%y, ErrStat2, ErrMsg2); if(Failed()) return; !............................................................................................................................... ! step 4.5: initialize farm-level MoorDyn if applicable !............................................................................................................................... if (farm%p%MooringMod == 3) then - CALL Farm_InitMD( farm, ErrStat2, ErrMsg2) ! FAST instances must be initialized first so that turbine initial positions are known - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF + CALL Farm_InitMD( farm, ErrStat2, ErrMsg2); if(Failed()) return; ! FAST instances must be initialized first so that turbine initial positions are known end if !............................................................................................................................... @@ -339,24 +307,13 @@ SUBROUTINE Farm_Initialize( farm, InputFile, ErrStat, ErrMsg ) !............................................................................................................................... ! Set parameters for output channels: - CALL Farm_SetOutParam(OutList, farm, ErrStat2, ErrMsg2 ) ! requires: p%NumOuts, sets: p%OutParam. - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF + CALL Farm_SetOutParam(OutList, farm, ErrStat2, ErrMsg2 ); if(Failed()) return; ! requires: p%NumOuts, sets: p%OutParam. - call Farm_InitOutput( farm, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF + call Farm_InitOutput( farm, ErrStat2, ErrMsg2 ); if(Failed()) return; ! Print the summary file if requested: IF (farm%p%SumPrint) THEN - CALL Farm_PrintSum( farm, WD_InitInput%InputFileData, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL Farm_PrintSum( farm, WD_InitInput%InputFileData, ErrStat2, ErrMsg2 ); if(Failed()) return; END IF !............................................................................................................................... @@ -366,1223 +323,256 @@ SUBROUTINE Farm_Initialize( farm, InputFile, ErrStat, ErrMsg ) CONTAINS SUBROUTINE Cleanup() - call WD_DestroyInitInput(WD_InitInput, ErrStat2, ErrMsg2) call AWAE_DestroyInitInput(AWAE_InitInput, ErrStat2, ErrMsg2) call AWAE_DestroyInitOutput(AWAE_InitOutput, ErrStat2, ErrMsg2) - END SUBROUTINE Cleanup + logical function Failed() + call SetErrStat(errStat2, errMsg2, errStat, errMsg, RoutineName) + Failed = errStat >= AbortErrLev + if (Failed) call cleanup() + end function Failed END SUBROUTINE Farm_Initialize -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine reads in the primary FAST.Farm input file, does some validation, and places the values it reads in the -!! parameter structure (p). It prints to an echo file if requested. -SUBROUTINE Farm_ReadPrimaryFile( InputFile, p, WD_InitInp, AWAE_InitInp, SC_InitInp, OutList, ErrStat, ErrMsg ) - - - ! Passed variables - TYPE(Farm_ParameterType), INTENT(INOUT) :: p !< The parameter data for the FAST (glue-code) simulation - CHARACTER(*), INTENT(IN ) :: InputFile !< Name of the file containing the primary input data - TYPE(WD_InputFileType), INTENT( OUT) :: WD_InitInp !< input-file data for WakeDynamics module - TYPE(AWAE_InputFileType), INTENT( OUT) :: AWAE_InitInp !< input-file data for AWAE module - TYPE(SC_InitInputType), INTENT( OUT) :: SC_InitInp !< input-file data for SC module - CHARACTER(ChanLen), INTENT( OUT) :: OutList(:) !< list of user-requested output channels - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message - ! Local variables: - REAL(DbKi) :: TmpTime ! temporary variable to read SttsTime and ChkptTime before converting to #steps based on DT_low - INTEGER(IntKi) :: I ! loop counter - INTEGER(IntKi) :: UnIn ! Unit number for reading file - INTEGER(IntKi) :: UnEc ! I/O unit for echo file. If > 0, file is open for writing. - INTEGER(IntKi) :: IOS ! Temporary Error status - INTEGER(IntKi) :: OutFileFmt ! An integer that indicates what kind of tabular output should be generated (1=text, 2=binary, 3=both) - INTEGER(IntKi) :: NLinTimes ! An integer that indicates how many times to linearize - LOGICAL :: Echo ! Determines if an echo file should be written - LOGICAL :: TabDelim ! Determines if text output should be delimited by tabs (true) or space (false) - CHARACTER(1024) :: PriPath ! Path name of the primary file - - CHARACTER(10) :: AbortLevel ! String that indicates which error level should be used to abort the program: WARNING, SEVERE, or FATAL - CHARACTER(30) :: Line ! string for default entry in input file - - INTEGER(IntKi) :: ErrStat2 ! Temporary Error status - CHARACTER(ErrMsgLen) :: ErrMsg2 ! Temporary Error message - CHARACTER(*), PARAMETER :: RoutineName = 'Farm_ReadPrimaryFile' - Real(ReKi) :: DefaultReVal ! Default real value - Real(ReKi) :: EstimatedRotorRadius ! Estimated rotor radius - - - ! Initialize some variables: - UnEc = -1 - Echo = .FALSE. ! Don't echo until we've read the "Echo" flag - CALL GetPath( InputFile, PriPath ) ! Input files will be relative to the path where the primary input file is located. - - - ! 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 ) then - call cleanup() - RETURN - end if - - ! 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 --------------------------------------------- - - CALL ReadCom( UnIn, InputFile, 'File header: FAST.Farm 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, p%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 CONTROL -------------------------------------- - 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 data to .ech (flag): - CALL ReadVar( UnIn, InputFile, Echo, "Echo", "Echo input data to .ech (flag)", 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%OutFileRoot)//'.ech', ErrStat2, ErrMsg2, Farm_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(Farm_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 - CALL WrScr( ' Heading of the '//TRIM(Farm_Ver%Name)//' input file: ' ) - CALL WrScr( ' '//TRIM( p%FTitle ) ) - - - ! AbortLevel - Error level when simulation should abort: - CALL ReadVar( UnIn, InputFile, AbortLevel, "AbortLevel", "Error level when simulation should abort (string)", & - ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2,ErrStat,ErrMsg,RoutineName) - if ( ErrStat >= AbortErrLev ) then - call cleanup() - RETURN - end if - - ! Let's set the abort level here.... knowing that everything before this aborted only on FATAL errors! - CALL Conv2UC( AbortLevel ) !convert to upper case - SELECT CASE( TRIM(AbortLevel) ) - CASE ( "WARNING" ) - AbortErrLev = ErrID_Warn - CASE ( "SEVERE" ) - AbortErrLev = ErrID_Severe - CASE ( "FATAL" ) - AbortErrLev = ErrID_Fatal - CASE DEFAULT - CALL SetErrStat( ErrID_Fatal, 'Invalid AbortLevel specified in FAST.Farm input file. '// & - 'Valid entries are "WARNING", "SEVERE", or "FATAL".',ErrStat,ErrMsg,RoutineName) - call cleanup() - RETURN - END SELECT - - - ! TMax - Total run time (s): - CALL ReadVar( UnIn, InputFile, p%TMax, "TMax", "Total run time (s)", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if ( ErrStat >= AbortErrLev ) then - call cleanup() - RETURN - end if - - ! UseSC - Use a super controller? (flag): - CALL ReadVar( UnIn, InputFile, p%UseSC, "UseSC", "Use a super controller? (flag)", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if ( ErrStat >= AbortErrLev ) then - call cleanup() - RETURN - end if - - ! Mod_AmbWind - Ambient wind model (-) (switch) {1: high-fidelity precursor in VTK format, 2: one InflowWind module, 3: multiple InflowWind modules}: - CALL ReadVar( UnIn, InputFile, AWAE_InitInp%Mod_AmbWind, "Mod_AmbWind", "Ambient wind model (-) (switch) {1: high-fidelity precursor in VTK format, 2: one InflowWind module, 3: multiple InflowWind modules}", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if ( ErrStat >= AbortErrLev ) then - call cleanup() - RETURN - end if - - ! Mod_WaveField - Wave field handling (-) (switch) {1: use individual HydroDyn inputs without adjustment, 2: adjust wave phases based on turbine offsets from farm origin} - CALL ReadVar( UnIn, InputFile, p%WaveFieldMod, "Mod_WaveField", "Wave field handling (-) (switch) {1: use individual HydroDyn inputs without adjustment, 2: adjust wave phases based on turbine offsets from farm origin}", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if ( ErrStat >= AbortErrLev ) then - call cleanup() - RETURN - end if - - ! Mod_SharedMooring - flag for array-level mooring. (switch) 0: none, 3: yes/MoorDyn - CALL ReadVar( UnIn, InputFile, p%MooringMod, "Mod_SharedMooring", "Array-level mooring handling (-) (switch) {0: none; 3: array-level MoorDyn model}", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if ( ErrStat >= AbortErrLev ) then - call cleanup() - RETURN - end if - - !---------------------- SUPER CONTROLLER ------------------------------------------------------------------ - CALL ReadCom( UnIn, InputFile, 'Section Header: Super Controller', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if ( ErrStat >= AbortErrLev ) then - call cleanup() - RETURN - end if - - ! SC_FileName - Name/location of the dynamic library {.dll [Windows] or .so [Linux]} containing the Super Controller algorithms (quoated string): - CALL ReadVar( UnIn, InputFile, p%SC_FileName, "SC_FileName", "Name/location of the dynamic library {.dll [Windows] or .so [Linux]} containing the Super Controller algorithms (quoated string)", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if ( ErrStat >= AbortErrLev ) then - call cleanup() - RETURN - end if - IF ( PathIsRelative( p%SC_FileName ) ) p%SC_FileName = TRIM(PriPath)//TRIM(p%SC_FileName) - SC_InitInp%DLL_FileName = p%SC_FileName - - !---------------------- SHARED MOORING SYSTEM ------------------------------------------------------------------ - CALL ReadCom( UnIn, InputFile, 'Section Header: SHARED MOORING SYSTEM', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if ( ErrStat >= AbortErrLev ) then - call cleanup() - RETURN - end if - - ! MD_FileName - Name/location of the farm-level MoorDyn input file (quoated string): - CALL ReadVar( UnIn, InputFile, p%MD_FileName, "MD_FileName", "Name/location of the dynamic library {.dll [Windows] or .so [Linux]} containing the Super Controller algorithms (quoated string)", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if ( ErrStat >= AbortErrLev ) then - call cleanup() - RETURN - end if - IF ( PathIsRelative( p%MD_FileName ) ) p%MD_FileName = TRIM(PriPath)//TRIM(p%MD_FileName) - - ! DT_Mooring - time step for farm-level mooring coupling with each turbine [used only when Mod_SharedMooring > 0] (s) [>0.0]: - CALL ReadVar( UnIn, InputFile, p%DT_mooring, "DT_Mooring", "Time step for farm-levem mooring coupling with each turbine [used only when Mod_SharedMooring > 0] (s) [>0.0]", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if ( ErrStat >= AbortErrLev ) then - call cleanup() - RETURN - end if - - !---------------------- AMBIENT WIND: PRECURSOR IN VTK FORMAT --------------------------------------------- - CALL ReadCom( UnIn, InputFile, 'Section Header: Ambient Wind: Precursor in VTK Format', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if ( ErrStat >= AbortErrLev ) then - call cleanup() - RETURN - end if - - ! DT_low - Time step for low-resolution wind data input files; will be used as the global FAST.Farm time step (s) [>0.0]: - CALL ReadVar( UnIn, InputFile, p%DT_low, "DT_Low-VTK", "Time step for low-resolution wind data input files; will be used as the global FAST.Farm time step (s) [>0.0]", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if ( ErrStat >= AbortErrLev ) then - call cleanup() - RETURN - end if - - ! DT_high - Time step for high-resolution wind data input files (s) [>0.0]: - CALL ReadVar( UnIn, InputFile, p%DT_high, "DT_High-VTK", "Time step for high-resolution wind data input files (s) [>0.0]", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if ( ErrStat >= AbortErrLev ) then - call cleanup() - RETURN - end if - - ! WindFilePath - Path name of wind data files from ABLSolver precursor (string): - CALL ReadVar( UnIn, InputFile, p%WindFilePath, "WindFilePath", "Path name of wind data files from ABLSolver precursor (string)", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if ( ErrStat >= AbortErrLev ) then - call cleanup() - RETURN - end if - IF ( PathIsRelative( p%WindFilePath ) ) p%WindFilePath = TRIM(PriPath)//TRIM(p%WindFilePath) - - ! ChkWndFiles - Check all the ambient wind files for data consistency? (flag): - CALL ReadVar( UnIn, InputFile, AWAE_InitInp%ChkWndFiles, "ChkWndFiles", "Check all the ambient wind files for data consistency? (flag)", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if ( ErrStat >= AbortErrLev ) then - call cleanup() - RETURN - end if - - !---------------------- AMBIENT WIND: INFLOWWIND MODULE --------------------------------------------- - CALL ReadCom( UnIn, InputFile, 'Section Header: Ambient Wind: InflowWind Module', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if ( ErrStat >= AbortErrLev ) then - call cleanup() - RETURN - end if - - ! DT_low - Time step for low-resolution wind data input files; will be used as the global FAST.Farm time step (s) [>0.0]: - CALL ReadVar( UnIn, InputFile, AWAE_InitInp%DT_low, "DT_Low", "Time step for low-resolution wind data input files; will be used as the global FAST.Farm time step (s) [>0.0]", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if ( ErrStat >= AbortErrLev ) then - call cleanup() - RETURN - end if - if ( AWAE_InitInp%Mod_AmbWind > 1 ) p%DT_low = AWAE_InitInp%DT_low - - ! DT_high - Time step for high-resolution wind data input files (s) [>0.0]: - CALL ReadVar( UnIn, InputFile, AWAE_InitInp%DT_high, "DT_High", "Time step for high-resolution wind data input files (s) [>0.0]", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if ( ErrStat >= AbortErrLev ) then - call cleanup() - RETURN - end if - if ( AWAE_InitInp%Mod_AmbWind > 1 ) p%DT_high = AWAE_InitInp%DT_high - - ! NX_Low - Number of low-resolution spatial nodes in X direction for wind data interpolation (-) [>=2]: - CALL ReadVar( UnIn, InputFile, AWAE_InitInp%nX_Low, "nX_Low", "Number of low-resolution spatial nodes in X direction for wind data interpolation (-) [>=2]", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if ( ErrStat >= AbortErrLev ) then - call cleanup() - RETURN - end if - - ! NY_Low - Number of low-resolution spatial nodes in Y direction for wind data interpolation (-) [>=2]: - CALL ReadVar( UnIn, InputFile, AWAE_InitInp%nY_Low, "nY_Low", "Number of low-resolution spatial nodes in Y direction for wind data interpolation (-) [>=2]", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if ( ErrStat >= AbortErrLev ) then - call cleanup() - RETURN - end if - - ! NZ_Low - Number of low-resolution spatial nodes in Z direction for wind data interpolation (-) [>=2]: - CALL ReadVar( UnIn, InputFile, AWAE_InitInp%nZ_Low, "nZ_Low", "Number of low-resolution spatial nodes in Z direction for wind data interpolation (-) [>=2]", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if ( ErrStat >= AbortErrLev ) then - call cleanup() - RETURN - end if - - ! X0_Low - Origin of low-resolution spatial nodes in X direction for wind data interpolation (m): - CALL ReadVar( UnIn, InputFile, AWAE_InitInp%X0_Low, "X0_Low", "Origin of low-resolution spatial nodes in X direction for wind data interpolation (m)", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if ( ErrStat >= AbortErrLev ) then - call cleanup() - RETURN - end if - - ! Y0_Low - Origin of low-resolution spatial nodes in Y direction for wind data interpolation (m): - CALL ReadVar( UnIn, InputFile, AWAE_InitInp%Y0_Low, "Y0_Low", "Origin of low-resolution spatial nodes in Y direction for wind data interpolation (m)", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if ( ErrStat >= AbortErrLev ) then - call cleanup() - RETURN - end if - - ! Z0_Low - Origin of low-resolution spatial nodes in Z direction for wind data interpolation (m): - CALL ReadVar( UnIn, InputFile, AWAE_InitInp%Z0_Low, "Z0_Low", "Origin of low-resolution spatial nodes in Z direction for wind data interpolation (m)", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if ( ErrStat >= AbortErrLev ) then - call cleanup() - RETURN - end if - - ! dX_Low - Spacing of low-resolution spatial nodes in X direction for wind data interpolation (m) [>0.0]: - CALL ReadVar( UnIn, InputFile, AWAE_InitInp%dX_Low, "dX_Low", "Spacing of low-resolution spatial nodes in X direction for wind data interpolation (m) [>0.0]", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if ( ErrStat >= AbortErrLev ) then - call cleanup() - RETURN - end if - - ! dY_Low - Spacing of low-resolution spatial nodes in Y direction for wind data interpolation (m) [>0.0]: - CALL ReadVar( UnIn, InputFile, AWAE_InitInp%dY_Low, "dY_Low", "Spacing of low-resolution spatial nodes in Y direction for wind data interpolation (m) [>0.0]", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if ( ErrStat >= AbortErrLev ) then - call cleanup() - RETURN - end if - - ! dZ_Low - Spacing of low-resolution spatial nodes in Z direction for wind data interpolation (m) [>0.0]: - CALL ReadVar( UnIn, InputFile, AWAE_InitInp%dZ_Low, "dZ_Low", "Spacing of low-resolution spatial nodes in Z direction for wind data interpolation (m) [>0.0]", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if ( ErrStat >= AbortErrLev ) then - call cleanup() - RETURN - end if - - ! NX_High - Number of high-resolution spatial nodes in X direction for wind data interpolation (-) [>=2]: - CALL ReadVar( UnIn, InputFile, AWAE_InitInp%nX_High, "nX_High", "Number of high-resolution spatial nodes in X direction for wind data interpolation (-) [>=2]", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if ( ErrStat >= AbortErrLev ) then - call cleanup() - RETURN - end if - - ! NY_High - Number of high-resolution spatial nodes in Y direction for wind data interpolation (-) [>=2]: - CALL ReadVar( UnIn, InputFile, AWAE_InitInp%nY_High, "nY_High", "Number of high-resolution spatial nodes in Y direction for wind data interpolation (-) [>=2]", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if ( ErrStat >= AbortErrLev ) then - call cleanup() - RETURN - end if - - ! NZ_High - Number of high-resolution spatial nodes in Z direction for wind data interpolation (-) [>=2]: - CALL ReadVar( UnIn, InputFile, AWAE_InitInp%nZ_High, "nZ_High", "Number of high-resolution spatial nodes in Z direction for wind data interpolation (-) [>=2]", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if ( ErrStat >= AbortErrLev ) then - call cleanup() - RETURN - end if - - ! InflowFile - Name of file containing InflowWind module input parameters (quoted string): - CALL ReadVar( UnIn, InputFile, AWAE_InitInp%InflowFile, "InflowFile", "Name of file containing InflowWind module input parameters (quoted string)", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if ( ErrStat >= AbortErrLev ) then - call cleanup() - RETURN - end if - IF ( PathIsRelative( AWAE_InitInp%InflowFile ) ) AWAE_InitInp%InflowFile = TRIM(PriPath)//TRIM(AWAE_InitInp%InflowFile) - if ( AWAE_InitInp%Mod_AmbWind > 1 ) p%WindFilePath = AWAE_InitInp%InflowFile ! For the summary file - - !---------------------- WIND TURBINES --------------------------------------------- - CALL ReadCom( UnIn, InputFile, 'Section Header: Wind Turbines', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if ( ErrStat >= AbortErrLev ) then - call cleanup() - RETURN - end if - - - ! NumTurbines - Number of wind turbines (-) [>=1]: - CALL ReadVar( UnIn, InputFile, p%NumTurbines, "NumTurbines", "Number of wind turbines (-) [>=1]", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if ( ErrStat >= AbortErrLev ) then - call cleanup() - RETURN - end if - - CALL ReadCom( UnIn, InputFile, 'Section Header: WT column names', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL ReadCom( UnIn, InputFile, 'Section Header: WT column units', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - call AllocAry( p%WT_Position, 3, p%NumTurbines, 'WT_Position', ErrStat2, ErrMsg2); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call AllocAry( p%WT_FASTInFile, p%NumTurbines, 'WT_FASTInFile', ErrStat2, ErrMsg2); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call AllocAry( AWAE_InitInp%WT_Position, 3, p%NumTurbines, 'AWAE_InitInp%WT_Position', ErrStat2, ErrMsg2); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if ( ErrStat >= AbortErrLev ) then - call cleanup() - RETURN - end if - - if ( AWAE_InitInp%Mod_AmbWind > 1 ) then - ! Using InflowWind - call AllocAry(AWAE_InitInp%X0_high, p%NumTurbines, 'AWAE_InitInp%X0_high', ErrStat2, ErrMsg2) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call AllocAry(AWAE_InitInp%Y0_high, p%NumTurbines, 'AWAE_InitInp%Y0_high', ErrStat2, ErrMsg2) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call AllocAry(AWAE_InitInp%Z0_high, p%NumTurbines, 'AWAE_InitInp%Z0_high', ErrStat2, ErrMsg2) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call AllocAry(AWAE_InitInp%dX_high, p%NumTurbines, 'AWAE_InitInp%dX_high', ErrStat2, ErrMsg2) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call AllocAry(AWAE_InitInp%dY_high, p%NumTurbines, 'AWAE_InitInp%dY_high', ErrStat2, ErrMsg2) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call AllocAry(AWAE_InitInp%dZ_high, p%NumTurbines, 'AWAE_InitInp%dZ_high', ErrStat2, ErrMsg2) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if ( ErrStat >= AbortErrLev ) then - call cleanup() - RETURN - end if - end if - - ! WT_Position (WT_X, WT_Y, WT_Z) and WT_FASTInFile - do i=1,p%NumTurbines - - if ( AWAE_InitInp%Mod_AmbWind == 1 ) then - READ (UnIn, *, IOSTAT=IOS) p%WT_Position(:,i), p%WT_FASTInFile(i) - else - READ (UnIn, *, IOSTAT=IOS) p%WT_Position(:,i), p%WT_FASTInFile(i), AWAE_InitInp%X0_high(i), AWAE_InitInp%Y0_high(i), AWAE_InitInp%Z0_high(i), AWAE_InitInp%dX_high(i), AWAE_InitInp%dY_high(i), AWAE_InitInp%dZ_high(i) - end if - AWAE_InitInp%WT_Position(:,i) = p%WT_Position(:,i) - - CALL CheckIOS ( IOS, InputFile, 'Wind Turbine Columns', NumType, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - if ( ErrStat >= AbortErrLev ) then - call cleanup() - RETURN - end if - IF ( UnEc > 0 ) THEN - if ( AWAE_InitInp%Mod_AmbWind == 1 ) then - WRITE( UnEc, "(3(ES11.4e2,2X),'""',A,'""',T50,' - WT(',I5,')')" ) p%WT_Position(:,i), TRIM( p%WT_FASTInFile(i) ), I - else - WRITE( UnEc, "(3(ES11.4e2,2X),'""',A,'""',T50,6(ES11.4e2,2X),' - WT(',I5,')')" ) p%WT_Position(:,i), TRIM( p%WT_FASTInFile(i) ), AWAE_InitInp%X0_high(i), AWAE_InitInp%Y0_high(i), AWAE_InitInp%Z0_high(i), AWAE_InitInp%dX_high(i), AWAE_InitInp%dY_high(i), AWAE_InitInp%dZ_high(i), I - end if - - END IF - IF ( PathIsRelative( p%WT_FASTInFile(i) ) ) p%WT_FASTInFile(i) = TRIM(PriPath)//TRIM(p%WT_FASTInFile(i)) - - end do - - - !---------------------- WAKE DYNAMICS --------------------------------------------- - CALL ReadCom( UnIn, InputFile, 'Section Header: Wake Dynamics', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if ( ErrStat >= AbortErrLev ) then - call cleanup() - RETURN - end if - - - CALL ReadVar( UnIn, InputFile, WD_InitInp%Mod_Wake, "Mod_Wake", "Wake model", ErrStat2, ErrMsg2, UnEc); if(failed()) return - CALL ReadVar( UnIn, InputFile, WD_InitInp%dr , "dr", "Radial increment of radial finite-difference grid (m) [>0.0]", ErrStat2, ErrMsg2, UnEc); if(failed()) return - CALL ReadVar( UnIn, InputFile, WD_InitInp%NumRadii, "NumRadii", "Number of radii in the radial finite-difference grid (-) [>=2]", ErrStat2, ErrMsg2, UnEc); if(failed()) return - CALL ReadVar( UnIn, InputFile, WD_InitInp%NumPlanes,"NumPlanes", "Number of wake planes (-) [>=2]", ErrStat2, ErrMsg2, UnEc); if(failed()) return - - ! Estimate rotor raidus based on grid size, if user follow approximately the guidelines - EstimatedRotorRadius = (WD_InitInp%dr * WD_InitInp%NumRadii) / 3._ReKi - - ! f_c - Cut-off (corner) frequency of the low-pass time-filter for the wake advection, deflection, and meandering model (Hz) [>0.0] or DEFAULT [DEFAULT=0.0007]: - DefaultReVal = 12.5_ReKi/EstimatedRotorRadius ! Eq. (32) of https://doi.org/10.1002/we.2785, with U=10, a=1/3 - CALL ReadVarWDefault( UnIn, InputFile, WD_InitInp%f_c, "f_c", & - "Cut-off (corner) frequency of the low-pass time-filter for the wake advection, deflection, and meandering model (Hz) [>0.0] or DEFAULT [DEFAULT=0.0007]", & - DefaultReVal, ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if ( ErrStat >= AbortErrLev ) then - call cleanup() - RETURN - end if - - ! C_HWkDfl_O - Calibrated parameter in the correction for wake deflection defining the horizontal offset at the rotor (m) or DEFAULT [DEFAULT=0.0]: - CALL ReadVarWDefault( UnIn, InputFile, WD_InitInp%C_HWkDfl_O, "C_HWkDfl_O", & - "Calibrated parameter in the correction for wake deflection defining the horizontal offset at the rotor (m) or DEFAULT [DEFAULT=0.0]", & - 0.0_ReKi, ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if ( ErrStat >= AbortErrLev ) then - call cleanup() - RETURN - end if - - ! C_HWkDfl_OY - Calibrated parameter in the correction for wake deflection defining the horizontal offset at the rotor scaled with yaw error (m/deg) or DEFAULT [DEFAULT=0.3]: - if (WD_InitInp%Mod_Wake == Mod_Wake_Curl) then - DefaultReVal = 0.0_ReKi - else - DefaultReVal = 0.3_ReKi +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine sets the WAT InflowWind data storage. Rather than initialize all of InflowWind, we just call the HAWC wind init. +SUBROUTINE WAT_init( p, WAT_IfW, AWAE_InitInput, ErrStat, ErrMsg ) + USE InflowWind_IO, only: IfW_HAWC_Init + type(farm_ParameterType), intent(inout) :: p !< farm parameters data + type(WAT_IfW_data), intent(inout) :: WAT_IfW !< InflowWind data + type(AWAE_InitInputType), intent(inout) :: AWAE_InitInput !< for error checking, and temporary to pass IfW + integer(IntKi), intent( out) :: ErrStat !< Error status of the operation + character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + type(HAWC_InitInputType) :: HAWC_InitInput + type(WindFileDat) :: FileDat + character(1024) :: BoxFileRoot, BoxFile_u, BoxFile_v, BoxFile_w + character(1024) :: sDummy + character(6) :: FileEnding(3) + integer(IntKi) :: i,j,k,n + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'WAT_init' + + ErrStat = ErrID_None + ErrMsg = "" + + ! If flowfield is allocated, deallocate and allocate again to clear old data + if (associated(WAT_IfW%p%FlowField)) deallocate(WAT_IfW%p%FlowField) + allocate(WAT_IfW%p%FlowField) + + ! HAWC file names + call SplitFileName (p%WAT_BoxFile, BoxFileRoot, FileEnding, ErrStat2, ErrMsg2); if (Failed()) return + HAWC_InitInput%WindFileName(1) = trim(BoxFileRoot)//trim(FileEnding(1)) + HAWC_InitInput%WindFileName(2) = trim(BoxFileRoot)//trim(FileEnding(2)) + HAWC_InitInput%WindFileName(3) = trim(BoxFileRoot)//trim(FileEnding(3)) + + ! HAWC spatial grid + if (p%WAT == Mod_WAT_PreDef) then ! from libary of WAT files, set the NxNyNz and DxDyDz terms + call MannLibDims(BoxFileRoot, p%RotorDiamRef, p%WAT_NxNyNz, p%WAT_DxDyDz, ErrStat2, ErrMsg2); if (Failed()) return + write(sDummy, '(3(I8,1X))') p%WAT_NxNyNz + call WrScr(' WAT: NxNyNz set to: '//trim(sDummy)//' (inferred from filename)') + write(sDummy, '(3(F8.3,1X))') p%WAT_DxDyDz + call WrScr(' WAT: DxDyDz set to: '//trim(sDummy)//' (based on rotor diameter)') endif - CALL ReadVarWDefault( UnIn, InputFile, WD_InitInp%C_HWkDfl_OY, "C_HWkDfl_OY", & - "Calibrated parameter in the correction for wake deflection defining the horizontal offset at the rotor scaled with yaw error (m/deg) or DEFAULT [DEFAULT=0.3]", & - DefaultReVal, ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if ( ErrStat >= AbortErrLev ) then - call cleanup() - RETURN - end if - WD_InitInp%C_HWkDfl_OY = WD_InitInp%C_HWkDfl_OY/D2R !immediately convert to m/radians instead of m/degrees - - ! C_HWkDfl_x - Calibrated parameter in the correction for wake deflection defining the horizontal offset scaled with downstream distance (-) or DEFAULT [DEFAULT=0.0]: - CALL ReadVarWDefault( UnIn, InputFile, WD_InitInp%C_HWkDfl_x, "C_HWkDfl_x", & - "Calibrated parameter in the correction for wake deflection defining the horizontal offset scaled with downstream distance (-) or DEFAULT [DEFAULT=0.0]", & - 0.0_ReKi, ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if ( ErrStat >= AbortErrLev ) then - call cleanup() - RETURN - end if - - ! C_HWkDfl_xY - Calibrated parameter in the correction for wake deflection defining the horizontal offset scaled with downstream distance and yaw error (1/deg) or DEFAULT [DEFAULT=-0.004]: - if (WD_InitInp%Mod_Wake == Mod_Wake_Curl) then - DefaultReVal = 0.0_ReKi - else - DefaultReVal = -0.004_ReKi + ! Sanity check + if (any(p%WAT_NxNyNz<2)) then + call SetErrStat(ErrID_Fatal, "Values of WAT_NxNyNz should be above 2", ErrStat, ErrMsg, RoutineName) + return endif - CALL ReadVarWDefault( UnIn, InputFile, WD_InitInp%C_HWkDfl_xY, "C_HWkDfl_xY", & - "Calibrated parameter in the correction for wake deflection defining the horizontal offset scaled with downstream distance and yaw error (1/deg) or DEFAULT [DEFAULT=-0.004]", & - DefaultReVal, ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if ( ErrStat >= AbortErrLev ) then - call cleanup() - RETURN - end if - WD_InitInp%C_HWkDfl_xY = WD_InitInp%C_HWkDfl_xY/D2R !immediately convert to 1/radians instead of 1/degrees - - - ! C_NearWake - Calibrated parameter for the near-wake correction (-) [>1.0] or DEFAULT [DEFAULT=1.8]: - CALL ReadVarWDefault( UnIn, InputFile, WD_InitInp%C_NearWake, "C_NearWake", & - "Calibrated parameter for the near-wake correction (-) [>1.0] or DEFAULT [DEFAULT=1.8]", & - 1.8_ReKi, ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if ( ErrStat >= AbortErrLev ) then - call cleanup() - RETURN - end if - - ! k_vAmb - Calibrated parameter for the influence of ambient turbulence in the eddy viscosity (-) [>=0.0] or DEFAULT [DEFAULT=0.05 ]: - CALL ReadVarWDefault( UnIn, InputFile, WD_InitInp%k_vAmb, "k_vAmb", & - "Calibrated parameter for the influence of ambient turbulence in the eddy viscosity (-) [>=0.0] or DEFAULT [DEFAULT=0.05]", & - 0.05_ReKi, ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if ( ErrStat >= AbortErrLev ) then - call cleanup() - RETURN - end if - - ! k_vShr - Calibrated parameter for the influence of the shear layer in the eddy viscosity (-) [>=0.0] or DEFAULT [DEFAULT=0.016]: - CALL ReadVarWDefault( UnIn, InputFile, WD_InitInp%k_vShr, "k_vShr", & - "Calibrated parameter for the influence of the shear layer in the eddy viscosity (-) [>=0.0] or DEFAULT [DEFAULT=0.016]", & - 0.016_ReKi, ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if ( ErrStat >= AbortErrLev ) then - call cleanup() - RETURN - end if - - ! 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] or DEFAULT [DEFAULT=0.0]: - CALL ReadVarWDefault( UnIn, InputFile, WD_InitInp%C_vAmb_DMin, "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] or DEFAULT [DEFAULT=0.0]", & - 0.0_ReKi, ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if ( ErrStat >= AbortErrLev ) then - call cleanup() - RETURN - end if - - ! 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 ] or DEFAULT [DEFAULT=1.0]: - CALL ReadVarWDefault( UnIn, InputFile, WD_InitInp%C_vAmb_DMax, "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 ] or DEFAULT [DEFAULT=1.0]", & - 1.0_ReKi, ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if ( ErrStat >= AbortErrLev ) then - call cleanup() - RETURN - end if - - ! 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] or DEFAULT [DEFAULT=1.0]: - CALL ReadVarWDefault( UnIn, InputFile, WD_InitInp%C_vAmb_FMin, "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] or DEFAULT [DEFAULT=1.0]", & - 1.0_ReKi, ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if ( ErrStat >= AbortErrLev ) then - call cleanup() - RETURN - end if - - ! C_vAmb_Exp - Calibrated parameter in the eddy viscosity filter function for ambient turbulence defining the exponent in the exponential region (-) [> 0.0] or DEFAULT [DEFAULT=0.01]: - CALL ReadVarWDefault( UnIn, InputFile, WD_InitInp%C_vAmb_Exp, "C_vAmb_Exp", & - "Calibrated parameter in the eddy viscosity filter function for ambient turbulence defining the exponent in the exponential region (-) [> 0.0] or DEFAULT [DEFAULT=0.01]", & - 0.01_ReKi, ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if ( ErrStat >= AbortErrLev ) then - call cleanup() - RETURN - end if - - ! 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] or DEFAULT [DEFAULT=3.0]: - CALL ReadVarWDefault( UnIn, InputFile, WD_InitInp%C_vShr_DMin, "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] or DEFAULT [DEFAULT=3.0]", & - 3.0_ReKi, ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if ( ErrStat >= AbortErrLev ) then - call cleanup() - RETURN - end if - - ! 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] or DEFAULT [DEFAULT=25.0]: - CALL ReadVarWDefault( UnIn, InputFile, WD_InitInp%C_vShr_DMax, "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] or DEFAULT [DEFAULT=25.0]", & - 25.0_ReKi, ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if ( ErrStat >= AbortErrLev ) then - call cleanup() - RETURN - end if - - ! 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] or DEFAULT [DEFAULT=0.2]: - CALL ReadVarWDefault( UnIn, InputFile, WD_InitInp%C_vShr_FMin, "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] or DEFAULT [DEFAULT=0.2]", & - 0.2_ReKi, ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if ( ErrStat >= AbortErrLev ) then - call cleanup() - RETURN - end if - - ! C_vShr_Exp - Calibrated parameter in the eddy viscosity filter function for the shear layer defining the exponent in the exponential region (-) [> 0.0] or DEFAULT [DEFAULT=0.1]: - CALL ReadVarWDefault( UnIn, InputFile, WD_InitInp%C_vShr_Exp, "C_vShr_Exp", & - "Calibrated parameter in the eddy viscosity filter function for the shear layer defining the exponent in the exponential region (-) [> 0.0] or DEFAULT [DEFAULT=0.1]", & - 0.1_ReKi, ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if ( ErrStat >= AbortErrLev ) then - call cleanup() - RETURN - end if - - ! Mod_WakeDiam - Wake diameter calculation model (-) (switch) {1: rotor diameter, 2: velocity-based, 3: mass-flux based, 4: momentum-flux based} or DEFAULT [DEFAULT=1]: - CALL ReadVarWDefault( UnIn, InputFile, WD_InitInp%Mod_WakeDiam, "Mod_WakeDiam", & - "Wake diameter calculation model (-) (switch) {1: rotor diameter, 2: velocity-based, 3: mass-flux based, 4: momentum-flux based} or DEFAULT [DEFAULT=1]", & - WakeDiamMod_RotDiam, ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if ( ErrStat >= AbortErrLev ) then - call cleanup() - RETURN - end if - - ! C_WakeDiam - Calibrated parameter for wake diameter calculation (-) [>0.0 and <1.0] or DEFAULT [DEFAULT=0.95] [unused for Mod_WakeDiam=1]: - CALL ReadVarWDefault( UnIn, InputFile, WD_InitInp%C_WakeDiam, "C_WakeDiam", & - "Calibrated parameter for wake diameter calculation (-) [>0.0 and <1.0] or DEFAULT [DEFAULT=0.95] [unused for Mod_WakeDiam=1]", & - 0.95_ReKi, ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if ( ErrStat >= AbortErrLev ) then - call cleanup() - RETURN - end if - - ! Mod_Meander - Spatial filter model for wake meandering (-) (switch) {1: uniform, 2: truncated jinc, 3: windowed jinc} or DEFAULT [DEFAULT=3]: - CALL ReadVarWDefault( UnIn, InputFile, AWAE_InitInp%Mod_Meander, "Mod_Meander", & - "Spatial filter model for wake meandering (-) (switch) {1: uniform, 2: truncated jinc, 3: windowed jinc} or DEFAULT [DEFAULT=3]", & - MeanderMod_WndwdJinc, ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if ( ErrStat >= AbortErrLev ) then - call cleanup() - RETURN - end if - - ! C_Meander - Calibrated parameter for wake meandering (-) [>=1.0] or DEFAULT [DEFAULT=1.9]: - CALL ReadVarWDefault( UnIn, InputFile, AWAE_InitInp%C_Meander, "C_Meander", & - "Calibrated parameter for wake meandering (-) [>=1.0] or DEFAULT [DEFAULT=1.9]", & - 1.9_ReKi, ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if ( ErrStat >= AbortErrLev ) then - call cleanup() - RETURN - end if - - !----------------------- CURL WAKE PARAMETERS ------------------------------------------ - CALL ReadCom ( UnIn, InputFile, "Section Header: Curl wake parameters", ErrStat2, ErrMsg2, UnEc ); if(failed()) return - CALL ReadVarWDefault( UnIn, InputFile, WD_InitInp%Swirl , "Swirl", "Swirl switch", .True., ErrStat2, ErrMsg2, UnEc); if(failed()) return - CALL ReadVarWDefault( UnIn, InputFile, WD_InitInp%k_VortexDecay, "k_VortexDecay", "Vortex decay constant", 0.01, ErrStat2, ErrMsg2, UnEc); if(failed()) return - CALL ReadVarWDefault( UnIn, InputFile, WD_InitInp%NumVortices, "NumVortices", "Number of vortices in the curled wake", 100, ErrStat2, ErrMsg2, UnEc); if(failed()) return - CALL ReadVarWDefault( UnIn, InputFile, WD_InitInp%sigma_D, "sigma_D", "Gaussian vortex width", 0.2, ErrStat2, ErrMsg2, UnEc); if(failed()) return - CALL ReadVarWDefault( UnIn, InputFile, WD_InitInp%FilterInit, "FilterInit", "Filter Init", 1 , ErrStat2, ErrMsg2, UnEc); if(failed()) return - CALL ReadVarWDefault( UnIn, InputFile, WD_InitInp%k_vCurl, "k_vCurl", "Eddy viscosity for curl", 2.0 , ErrStat2, ErrMsg2, UnEc); if(failed()) return - CALL ReadVarWDefault( UnIn, InputFile, AWAE_InitInp%Mod_Projection, "Mod_Projection", "Mod_Projection", -1 , ErrStat2, ErrMsg2, UnEc); if(failed()) return - if (AWAE_InitInp%Mod_Projection==-1) then - ! -1 means the user selected "default" - if (WD_InitInp%Mod_Wake==Mod_Wake_Curl) then - AWAE_InitInp%Mod_Projection=2 - else - AWAE_InitInp%Mod_Projection=1 - endif + if (any(p%WAT_DxDyDz<=0)) then + call SetErrStat(ErrID_Fatal, "Values of WAT_DxDyDz should be strictly positive", ErrStat, ErrMsg, RoutineName) + return + endif + ! NOTE: We don't check for the dimensions of of the grid here compared to high res because we don't know it for VTKs + ! See AWAE_IO_InitGridInfo + + HAWC_InitInput%nx = p%WAT_NxNyNz(1) + HAWC_InitInput%ny = p%WAT_NxNyNz(2) + HAWC_InitInput%nz = p%WAT_NxNyNz(3) + HAWC_InitInput%dx = p%WAT_DxDyDz(1) + HAWC_InitInput%dy = p%WAT_DxDyDz(2) + HAWC_InitInput%dz = p%WAT_DxDyDz(3) + HAWC_InitInput%G3D%RefHt = 0.5_ReKi * p%WAT_NxNyNz(3)*p%WAT_DxDyDz(3) ! reference height; the height (in meters) of the vertical center of the grid (m) + HAWC_InitInput%G3D%URef = 1.0_ReKi ! Set to 1.0 so that dX = DTime (this affects data storage) + HAWC_InitInput%G3D%WindProfileType = 0 ! Wind profile type (0=constant;1=logarithmic,2=power law) + HAWC_InitInput%G3D%PLExp = 0.0_ReKi + HAWC_InitInput%G3D%ScaleMethod = 0 ! NOTE: setting this to 2 doesn't do the same as what we do below with ScaleBox + HAWC_InitInput%G3D%SF = 1.0_ReKi ! Turbulence scaling factor for the x direction (-) [ScaleMethod=1] + HAWC_InitInput%G3D%SigmaF = 1.0_ReKi ! Turbulence standard deviation to calculate scaling from in x direction (m/s) [ScaleMethod=2] + HAWC_InitInput%G3D%Z0 = 0.3_ReKi ! Surface roughness (not used) + HAWC_InitInput%G3D%XOffset = 0.0_ReKi ! Initial offset in +x direction (shift of wind box) + + WAT_IfW%p%FlowField%PropagationDir = 0.0_ReKi + WAT_IfW%p%FlowField%VFlowAngle = 0.0_ReKi + WAT_IfW%p%FlowField%RotateWindBox = .false. + + WAT_IfW%p%FlowField%FieldType = Grid3D_FieldType + call IfW_HAWC_Init(HAWC_InitInput, -1, WAT_IfW%p%FlowField%Grid3D, FileDat, ErrStat2, ErrMsg2); if (Failed()) return ! summary file unit set to -1 + + if (p%WAT_ScaleBox) then + call WrScr(' WAT: Scaling Box for unit standard deviation and zero mean') + call Grid3D_ZeroMean_UnitStd(WAT_IfW%p%FlowField%Grid3D%Vel) endif - !----------------------- WAKE-ADDED TURBULENCE ------------------------------------------ - ! Read WAT variables - WD_InitInp%WAT_k_Def =1.0_ReKi - WD_InitInp%WAT_k_Grad =1.0_ReKi - WD_InitInp%WAT = .false. ! initialize to false to avoid segfault - !CALL ReadCom( UnIn, InputFile, 'Section Header: Wake-added turbulence', ErrStat2, ErrMsg2, UnEc ) - !CALL ReadVar( UnIn, InputFile, WD_InitInp%WAT, "WAT", "Switch for turning on and off wake-added turbulence", ErrStat2, ErrMsg2, UnEc); if(failed()) return - !CALL ReadCom( UnIn, InputFile, 'dummy predef', ErrStat2, ErrMsg2, UnEc ) - !CALL ReadCom( UnIn, InputFile, 'dummy user', ErrStat2, ErrMsg2, UnEc ) - !CALL ReadCom( UnIn, InputFile, 'dummy userdx', ErrStat2, ErrMsg2, UnEc ) - !CALL ReadVarWDefault( UnIn, InputFile, WD_InitInp%WAT_k_Def, "WAT_k_Def, "Calibrated parameter for the influence of the wake deficit in the wake-added Turbulence (-) [>=0.0] or DEFAULT [DEFAULT=1.44]", 1.44_ReKi, ErrStat2, ErrMsg2, UnEc); if(failed()) return - !CALL ReadVarWDefault( UnIn, InputFile, WD_InitInp%WAT_k_Grad, "WAT_k_Grad", "Calibrated parameter for the influence of the radial velocity gradient of the wake deficit in the wake-added Turbulence (-) [>=0.0] or DEFAULT [DEFAULT=0.84]", 0.84_ReKi, ErrStat2, ErrMsg2, UnEc); if(failed()) return - !IF ( PathIsRelative( p%File ) )p%File = TRIM(PriPath)//TRIM(p%File) - - !---------------------- VISUALIZATION -------------------------------------------------- - CALL ReadCom( UnIn, InputFile, 'Section Header: Visualization', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - ! WrDisWind - Write disturbed wind data to .Low.Dis.t.vtk etc.? (flag): - CALL ReadVar( UnIn, InputFile, AWAE_InitInp%WrDisWind, "WrDisWind", "Write disturbed wind data to .Low.Dis.t.vtk etc.? (flag)", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if ( ErrStat >= AbortErrLev ) then - call cleanup() - RETURN - end if - - ! NOutDisWindXY - Number of XY planes for output of disturbed wind data across the low-resolution domain to .Low.DisXY..t.vtk (-) [0 to 9]: - CALL ReadVar( UnIn, InputFile, AWAE_InitInp%NOutDisWindXY, "NOutDisWindXY", "Number of XY planes for output of disturbed wind data across the low-resolution domain to .Low.DisXY..t.vtk (-) [0 to 999]", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if ( ErrStat >= AbortErrLev ) then - call cleanup() - RETURN - end if - - call allocAry( AWAE_InitInp%OutDisWindZ, AWAE_InitInp%NOutDisWindXY, "OutDisWindZ", ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if ( ErrStat >= AbortErrLev ) then - call cleanup() - RETURN - end if - - ! OutDisWindZ - Z coordinates of XY planes for output of disturbed wind data across the low-resolution domain (m) [1 to NOutDisWindXY] [unused for NOutDisWindXY=0]: - CALL ReadAry( UnIn, InputFile, AWAE_InitInp%OutDisWindZ, AWAE_InitInp%NOutDisWindXY, "OutDisWindZ", "Z coordinates of XY planes for output of disturbed wind data across the low-resolution domain (m) [1 to NOutDisWindXY] [unused for NOutDisWindXY=0]", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if ( ErrStat >= AbortErrLev ) then - call cleanup() - RETURN - end if - - ! NOutDisWindYZ - Number of YZ planes for output of disturbed wind data across the low-resolution domain to .Low.DisYZ..t.vtk (-) [0 to 9]: - CALL ReadVar( UnIn, InputFile, AWAE_InitInp%NOutDisWindYZ, "NOutDisWindYZ", "Number of YZ planes for output of disturbed wind data across the low-resolution domain to .Low.DisYZ..t.vtk (-) [0 to 999]", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if ( ErrStat >= AbortErrLev ) then - call cleanup() - RETURN - end if - - call allocAry( AWAE_InitInp%OutDisWindX, AWAE_InitInp%NOutDisWindYZ, "OutDisWindX", ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if ( ErrStat >= AbortErrLev ) then - call cleanup() - RETURN - end if - - ! OutDisWindX - X coordinates of YZ planes for output of disturbed wind data across the low-resolution domain (m) [1 to NOutDisWindYZ] [unused for NOutDisWindYZ=0]: - CALL ReadAry( UnIn, InputFile, AWAE_InitInp%OutDisWindX, AWAE_InitInp%NOutDisWindYZ, "OutDisWindX", "X coordinates of YZ planes for output of disturbed wind data across the low-resolution domain (m) [1 to NOutDisWindYZ] [unused for NOutDisWindYZ=0]", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if ( ErrStat >= AbortErrLev ) then - call cleanup() - RETURN - end if - - ! NOutDisWindXZ - Number of XZ planes for output of disturbed wind data across the low-resolution domain to .Low/DisXZ..t.vtk (-) [0 to 9]: - CALL ReadVar( UnIn, InputFile, AWAE_InitInp%NOutDisWindXZ, "NOutDisWindXZ", "Number of XZ planes for output of disturbed wind data across the low-resolution domain to .Low/DisXZ..t.vtk (-) [0 to 999]", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if ( ErrStat >= AbortErrLev ) then - call cleanup() - RETURN - end if - - call allocAry( AWAE_InitInp%OutDisWindY, AWAE_InitInp%NOutDisWindXZ, "OutDisWindY", ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if ( ErrStat >= AbortErrLev ) then - call cleanup() - RETURN - end if - - ! OutDisWindY - Y coordinates of XZ planes for output of disturbed wind data across the low-resolution domain (m) [1 to NOutDisWindXZ] [unused for NOutDisWindXZ=0]: - CALL ReadAry( UnIn, InputFile, AWAE_InitInp%OutDisWindY, AWAE_InitInp%NOutDisWindXZ, "OutDisWindY", "Y coordinates of XZ planes for output of disturbed wind data across the low-resolution domain (m) [1 to NOutDisWindXZ] [unused for NOutDisWindXZ=0]", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if ( ErrStat >= AbortErrLev ) then - call cleanup() - RETURN - end if - - ! WrDisDT -The time between vtk outputs [must be a multiple of the low resolution time step]: - CALL ReadVarWDefault( UnIn, InputFile, AWAE_InitInp%WrDisDT, "WrDisDT", & - "The time between vtk outputs [must be a multiple of the low resolution time step]", & - p%DT_low, ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if ( ErrStat >= AbortErrLev ) then - call cleanup() - RETURN - end if - - - !---------------------- OUTPUT -------------------------------------------------- - CALL ReadCom( UnIn, InputFile, 'Section Header: Output', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if ( ErrStat >= AbortErrLev ) then - call cleanup() - RETURN - end if - - ! SumPrint - Print summary data to .sum? (flag): - CALL ReadVar( UnIn, InputFile, p%SumPrint, "SumPrint", "Print summary data to .sum? (flag)", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if ( ErrStat >= AbortErrLev ) then - call cleanup() - RETURN - end if - - ! ChkptTime - Amount of time between creating checkpoint files for potential restart (s) [>0.0]: - CALL ReadVar( UnIn, InputFile, TmpTime, "ChkptTime", "Amount of time between creating checkpoint files for potential restart (s) [>0.0]", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if ( ErrStat >= AbortErrLev ) then - call cleanup() - RETURN - end if - - IF (TmpTime > p%TMax) THEN - p%n_ChkptTime = HUGE(p%n_ChkptTime) - ELSE - p%n_ChkptTime = NINT( TmpTime / p%DT_low ) - END IF - - - ! TStart - Time to begin tabular output (s) [>=0.0]: - CALL ReadVar( UnIn, InputFile, p%TStart, "TStart", "Time to begin tabular output (s) [>=0.0]", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if ( ErrStat >= AbortErrLev ) then - call cleanup() - RETURN - end if - - ! OutFileFmt - Format for tabular (time-marching) output file (switch) {1: text file [.out], 2: binary file [.outb], 3: both}: - CALL ReadVar( UnIn, InputFile, OutFileFmt, "OutFileFmt", "Format for tabular (time-marching) output file (switch) {1: text file [.out], 2: binary file [.outb], 3: both}", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if ( ErrStat >= AbortErrLev ) then - call cleanup() - RETURN - end if - - SELECT CASE (OutFileFmt) - CASE (1_IntKi) - p%WrBinOutFile = .FALSE. - p%WrTxtOutFile = .TRUE. - CASE (2_IntKi) - p%WrBinOutFile = .TRUE. - p%WrTxtOutFile = .FALSE. - CASE (3_IntKi) - p%WrBinOutFile = .TRUE. - p%WrTxtOutFile = .TRUE. - CASE DEFAULT - ! we'll check this later.... - !CALL SetErrStat( ErrID_Fatal, "FAST.Farm's OutFileFmt must be 1, 2, or 3.",ErrStat,ErrMsg,RoutineName) - !if ( ErrStat >= AbortErrLev ) then - ! call cleanup() - ! RETURN - !end if - END SELECT - - if ( OutFileFmt /= 1_IntKi ) then ! TODO: Only allow text format for now; add binary format later. - CALL SetErrStat( ErrID_Fatal, "FAST.Farm's OutFileFmt must be 1.",ErrStat,ErrMsg,RoutineName) - call cleanup() - RETURN - end if - - - ! TabDelim - Use tab delimiters in text tabular output file? (flag) {uses spaces if False}: - CALL ReadVar( UnIn, InputFile, TabDelim, "TabDelim", "Use tab delimiters in text tabular output file? (flag) {uses spaces if False}", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if ( ErrStat >= AbortErrLev ) then - call cleanup() - RETURN - end if - - IF ( TabDelim ) THEN - p%Delim = TAB - ELSE - p%Delim = ' ' - END IF - - ! OutFmt - Format used for text tabular output, excluding the time channel. Resulting field should be 10 characters. (quoted string): - CALL ReadVar( UnIn, InputFile, p%OutFmt, "OutFmt", "Format used for text tabular output, excluding the time channel. Resulting field should be 10 characters. (quoted string)", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if ( ErrStat >= AbortErrLev ) then - call cleanup() - RETURN - end if - - - CALL ReadVarWDefault( UnIn, InputFile, WD_InitInp%OutAllPlanes, "OutAllPlanes", "Output all planes", .False., ErrStat2, ErrMsg2, UnEc); if(failed()) return - - - ! NOutRadii - Number of radial nodes for wake output for an individual rotor (-) [0 to 20]: - CALL ReadVar( UnIn, InputFile, p%NOutRadii, "NOutRadii", "Number of radial nodes for wake output for an individual rotor (-) [0 to 20]", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if ( ErrStat >= AbortErrLev ) then - call cleanup() - RETURN - end if - - call allocary( p%OutRadii, p%NOutRadii, "OutRadii", ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if ( ErrStat >= AbortErrLev ) then - call cleanup() - RETURN - end if - - ! OutRadii - List of radial nodes for wake output for an individual rotor (-) [1 to NOutRadii]: - CALL ReadAry( UnIn, InputFile, p%OutRadii, p%NOutRadii, "OutRadii", "List of radial nodes for wake output for an individual rotor (-) [1 to NOutRadii]", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if ( ErrStat >= AbortErrLev ) then - call cleanup() - RETURN - end if - - ! NOutDist - Number of downstream distances for wake output for an individual rotor (-) [0 to 9]: - CALL ReadVar( UnIn, InputFile, p%NOutDist, "NOutDist", "Number of downstream distances for wake output for an individual rotor (-) [0 to 9]", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if ( ErrStat >= AbortErrLev ) then - call cleanup() - RETURN - end if - - call allocary( p%OutDist, p%NOutDist, "OutDist", ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if ( ErrStat >= AbortErrLev ) then - call cleanup() - RETURN - end if - - ! OutDist - List of downstream distances for wake output for an individual rotor (m) [1 to NOutDist] [unused for NOutDist=0]: - CALL ReadAry( UnIn, InputFile, p%OutDist, p%NOutDist, "OutDist", "List of downstream distances for wake output for an individual rotor (m) [1 to NOutDist] [unused for NOutDist=0]", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if ( ErrStat >= AbortErrLev ) then - call cleanup() - RETURN - end if - - ! NWindVel - Number of points for wind output (-) [0 to 9]: - CALL ReadVar( UnIn, InputFile, p%NWindVel, "NWindVel", "Number of points for wind output (-) [0 to 9]", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if ( ErrStat >= AbortErrLev ) then - call cleanup() - RETURN - end if - - call allocAry( p%WindVelX, p%NWindVel, "WindVelX", ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call allocAry( p%WindVelY, p%NWindVel, "WindVelY", ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call allocAry( p%WindVelZ, p%NWindVel, "WindVelZ", ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if ( ErrStat >= AbortErrLev ) then - call cleanup() - RETURN - end if - - ! WindVelX - List of coordinates in the X direction for wind output (m) [1 to NWindVel] [unused for NWindVel=0]: - CALL ReadAry( UnIn, InputFile, p%WindVelX, p%NWindVel, "WindVelX", "List of coordinates in the X direction for wind output (m) [1 to NWindVel] [unused for NWindVel=0]", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if ( ErrStat >= AbortErrLev ) then - call cleanup() - RETURN - end if - - ! WindVelY - List of coordinates in the Y direction for wind output (m) [1 to NWindVel] [unused for NWindVel=0]: - CALL ReadAry( UnIn, InputFile, p%WindVelY, p%NWindVel, "WindVelY", "List of coordinates in the Y direction for wind output (m) [1 to NWindVel] [unused for NWindVel=0]", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if ( ErrStat >= AbortErrLev ) then - call cleanup() - RETURN - end if - - ! WindVelZ - List of coordinates in the Z direction for wind output (m) [1 to NWindVel] [unused for NWindVel=0]: - CALL ReadAry( UnIn, InputFile, p%WindVelZ, p%NWindVel, "WindVelZ", "List of coordinates in the Z direction for wind output (m) [1 to NWindVel] [unused for NWindVel=0]", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if ( ErrStat >= AbortErrLev ) then - call cleanup() - RETURN - end if - - - !!!!!!! OutList The next line(s) contains a list of output parameters. See OutListParameters.xlsx for a listing of available output channels (quoted string) - !---------------------- 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, OutList, p%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 ----------------------------------------- + ! Reference position for wind rotation (not used here, but should be set) + WAT_IfW%p%FlowField%RefPosition = [0.0_ReKi, 0.0_ReKi, WAT_IfW%p%FlowField%Grid3D%RefHeight] - call cleanup() - RETURN + WAT_IfW%IsInitialized = .true. -CONTAINS - !............................................................................................................................... - subroutine cleanup() - CLOSE( UnIn ) - IF ( UnEc > 0 ) CLOSE ( UnEc ) - end subroutine cleanup + call Cleanup() + return +contains logical function Failed() - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) Failed = ErrStat >= AbortErrLev - if (Failed) call cleanup() + if (Failed) call Cleanup() end function Failed - !............................................................................................................................... -END SUBROUTINE Farm_ReadPrimaryFile -!---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE Farm_ValidateInput( p, WD_InitInp, AWAE_InitInp, SC_InitInp, ErrStat, ErrMsg ) - ! Passed variables - TYPE(Farm_ParameterType), INTENT(INOUT) :: p !< The parameter data for the FAST (glue-code) simulation - TYPE(WD_InputFileType), INTENT(IN ) :: WD_InitInp !< input-file data for WakeDynamics module - TYPE(AWAE_InputFileType), INTENT(INOUT) :: AWAE_InitInp !< input-file data for AWAE module - TYPE(SC_InitInputType), INTENT(INOUT) :: SC_InitInp ! input-file data for SC module - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message - - ! Local variables: - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 ! Temporary Error status - CHARACTER(ErrMsgLen) :: ErrMsg2 ! Temporary Error message - CHARACTER(*), PARAMETER :: RoutineName = 'Farm_ValidateInput' - INTEGER(IntKi) :: n_disDT_dt - - ErrStat = ErrID_None - ErrMsg = "" - - - ! --- SIMULATION CONTROL --- - IF ((p%WaveFieldMod .ne. 1) .and. (p%WaveFieldMod .ne. 2)) CALL SetErrStat(ErrID_Fatal,'WaveFieldMod must be 1 or 2.',ErrStat,ErrMsg,RoutineName) - IF ((p%MooringMod .ne. 0) .and. (p%MooringMod .ne. 3)) CALL SetErrStat(ErrID_Fatal,'MooringMod must be 0 or 3.',ErrStat,ErrMsg,RoutineName) - - - IF (p%DT_low <= 0.0_ReKi) CALL SetErrStat(ErrID_Fatal,'DT_low must be positive.',ErrStat,ErrMsg,RoutineName) - IF (p%DT_high <= 0.0_ReKi) CALL SetErrStat(ErrID_Fatal,'DT_high must be positive.',ErrStat,ErrMsg,RoutineName) - IF (p%TMax < 0.0_ReKi) CALL SetErrStat(ErrID_Fatal,'TMax must not be negative.',ErrStat,ErrMsg,RoutineName) - IF (p%NumTurbines < 1) CALL SetErrStat(ErrID_Fatal,'FAST.Farm requires at least 1 turbine. Set NumTurbines > 0.',ErrStat,ErrMsg,RoutineName) - - ! --- SUPER CONTROLLER --- - ! TODO : Verify that the DLL file exists - - ! --- SHARED MOORING SYSTEM --- - ! TODO : Verify that p%MD_FileName file exists - if ((p%DT_mooring <= 0.0_ReKi) .or. (p%DT_mooring > p%DT_high)) CALL SetErrStat(ErrID_Fatal,'DT_mooring must be greater than zero and no greater than dt_high.',ErrStat,ErrMsg,RoutineName) - - ! --- WAKE DYNAMICS --- - IF (WD_InitInp%Mod_Wake < 1 .or. WD_InitInp%Mod_Wake >3 ) CALL SetErrStat(ErrID_Fatal,'Mod_Wake needs to be 1,2 or 3',ErrStat,ErrMsg,RoutineName) - IF (WD_InitInp%dr <= 0.0_ReKi) CALL SetErrStat(ErrID_Fatal,'dr (radial increment) must be larger than 0.',ErrStat,ErrMsg,RoutineName) - IF (WD_InitInp%NumRadii < 2) CALL SetErrStat(ErrID_Fatal,'NumRadii (number of radii) must be at least 2.',ErrStat,ErrMsg,RoutineName) - IF (WD_InitInp%NumPlanes < 2) CALL SetErrStat(ErrID_Fatal,'NumPlanes (number of wake planes) must be at least 2.',ErrStat,ErrMsg,RoutineName) - - IF (WD_InitInp%k_VortexDecay < 0.0_ReKi) CALL SetErrStat(ErrID_Fatal,'k_VortexDecay needs to be postive',ErrStat,ErrMsg,RoutineName) - IF (WD_InitInp%NumVortices < 2) CALL SetErrStat(ErrID_Fatal,'NumVorticies needs to be greater than 1',ErrStat,ErrMsg,RoutineName) - IF (WD_InitInp%sigma_D < 0.0_ReKi) CALL SetErrStat(ErrID_Fatal,'sigma_D needs to be postive',ErrStat,ErrMsg,RoutineName) - IF (WD_InitInp%f_c <= 0.0_ReKi) CALL SetErrStat(ErrID_Fatal,'f_c (cut-off [corner] frequency) must be more than 0 Hz.',ErrStat,ErrMsg,RoutineName) - IF (WD_InitInp%C_NearWake <= 1.0_Reki) CALL SetErrStat(ErrID_Fatal,'C_NearWake parameter must be greater than 1.',ErrStat,ErrMsg,RoutineName) - IF (WD_InitInp%k_vAmb < 0.0_Reki) CALL SetErrStat(ErrID_Fatal,'k_vAmb parameter must not be negative.',ErrStat,ErrMsg,RoutineName) - IF (WD_InitInp%k_vShr < 0.0_Reki) CALL SetErrStat(ErrID_Fatal,'k_vShr parameter must not be negative.',ErrStat,ErrMsg,RoutineName) - IF (WD_InitInp%k_vCurl < 0.0_Reki) CALL SetErrStat(ErrID_Fatal,'k_vCurl parameter must not be negative.',ErrStat,ErrMsg,RoutineName) - - IF (WD_InitInp%C_vAmb_DMin < 0.0_Reki) CALL SetErrStat(ErrID_Fatal,'C_vAmb_DMin parameter must not be negative.',ErrStat,ErrMsg,RoutineName) - IF (WD_InitInp%C_vAmb_DMax <= WD_InitInp%C_vAmb_DMin) CALL SetErrStat(ErrID_Fatal,'C_vAmb_DMax parameter must be larger than C_vAmb_DMin.',ErrStat,ErrMsg,RoutineName) - IF (WD_InitInp%C_vAmb_FMin < 0.0_Reki .or. WD_InitInp%C_vAmb_FMin > 1.0_Reki) CALL SetErrStat(ErrID_Fatal,'C_vAmb_FMin parameter must be between 0 and 1 (inclusive).',ErrStat,ErrMsg,RoutineName) - IF (WD_InitInp%C_vAmb_Exp <= 0.0_Reki) CALL SetErrStat(ErrID_Fatal,'C_vAmb_Exp parameter must be positive.',ErrStat,ErrMsg,RoutineName) - - IF (WD_InitInp%C_vShr_DMin < 0.0_Reki) CALL SetErrStat(ErrID_Fatal,'C_vShr_DMin parameter must not be negative.',ErrStat,ErrMsg,RoutineName) - IF (WD_InitInp%C_vShr_DMax <= WD_InitInp%C_vShr_DMin) CALL SetErrStat(ErrID_Fatal,'C_vShr_DMax parameter must be larger than C_vShr_DMin.',ErrStat,ErrMsg,RoutineName) - IF (WD_InitInp%C_vShr_FMin < 0.0_Reki .or. WD_InitInp%C_vShr_FMin > 1.0_ReKi) CALL SetErrStat(ErrID_Fatal,'C_vShr_FMin parameter must be between 0 and 1 (inclusive).',ErrStat,ErrMsg,RoutineName) - IF (WD_InitInp%C_vShr_Exp <= 0.0_Reki) CALL SetErrStat(ErrID_Fatal,'C_vShr_Exp parameter must be positive.',ErrStat,ErrMsg,RoutineName) - - IF (WD_InitInp%Mod_WakeDiam < WakeDiamMod_RotDiam .or. WD_InitInp%Mod_WakeDiam > WakeDiamMod_MtmFlux) THEN - call SetErrStat(ErrID_Fatal,'Wake diameter calculation model, Mod_WakeDiam, must be 1 (rotor diameter), 2 (velocity-based), 3 (mass-flux based), 4 (momentum-flux based) or DEFAULT.',ErrStat,ErrMsg,RoutineName) - END IF - - IF (WD_InitInp%Mod_WakeDiam /= WakeDiamMod_RotDiam) THEN - IF (WD_InitInp%C_WakeDiam <= 0.0_Reki .or. WD_InitInp%C_WakeDiam >= 1.0_ReKi) THEN - CALL SetErrStat(ErrID_Fatal,'C_WakeDiam parameter must be between 0 and 1 (exclusive).',ErrStat,ErrMsg,RoutineName) - END IF - END IF - - - - IF (AWAE_InitInp%C_Meander < 1.0_Reki) THEN - CALL SetErrStat(ErrID_Fatal,'C_Meander parameter must not be less than 1.',ErrStat,ErrMsg,RoutineName) - END IF - - ! --- CURL - IF (WD_InitInp%FilterInit < 0 ) CALL SetErrStat(ErrID_Fatal,'FilterInit needs to >= 0',ErrStat,ErrMsg,RoutineName) - IF (AWAE_InitInp%Mod_Meander < MeanderMod_Uniform .or. AWAE_InitInp%Mod_Meander > MeanderMod_WndwdJinc) THEN - call SetErrStat(ErrID_Fatal,'Spatial filter model for wake meandering, Mod_Meander, must be 1 (uniform), 2 (truncated jinc), 3 (windowed jinc) or DEFAULT.',ErrStat,ErrMsg,RoutineName) - END IF - IF (.not.(ANY((/1,2/)==AWAE_InitInp%Mod_Projection))) CALL SetErrStat(ErrID_Fatal,'Mod_Projection needs to be 1 or 2',ErrStat,ErrMsg,RoutineName) - - ! --- WAT - IF (WD_InitInp%WAT_k_Def <= 0.0_Reki) CALL SetErrStat(ErrID_Fatal,'WAT_k_Def parameter must be positive.',ErrStat,ErrMsg,RoutineName) - IF (WD_InitInp%WAT_k_Grad <= 0.0_Reki) CALL SetErrStat(ErrID_Fatal,'WAT_k_Grad parameter must be positive.',ErrStat,ErrMsg,RoutineName) - - !--- OUTPUT --- - IF ( p%n_ChkptTime < 1_IntKi ) CALL SetErrStat( ErrID_Fatal, 'ChkptTime must be greater than 0 seconds.', ErrStat, ErrMsg, RoutineName ) - IF (p%TStart < 0.0_ReKi) CALL SetErrStat(ErrID_Fatal,'TStart must not be negative.',ErrStat,ErrMsg,RoutineName) - IF (.not. p%WrBinOutFile .and. .not. p%WrTxtOutFile) CALL SetErrStat( ErrID_Fatal, "FAST.Farm's OutFileFmt must be 1, 2, or 3.",ErrStat,ErrMsg,RoutineName) - - if (AWAE_InitInp%WrDisDT < p%DT_low) CALL SetErrStat(ErrID_Fatal,'WrDisDT must greater than or equal to dt_low.',ErrStat,ErrMsg,RoutineName) - - ! let's make sure the FAST.Farm DT_low is an exact integer divisor of AWAE_InitInp%WrDisDT - n_disDT_dt = nint( AWAE_InitInp%WrDisDT / p%DT_low ) - ! (i'm doing this outside of Farm_ValidateInput so we know that dt_low/=0 before computing n_high_low): - IF ( .NOT. EqualRealNos( real(p%DT_low,SiKi)* n_disDT_dt, real(AWAE_InitInp%WrDisDT,SiKi) ) ) THEN - CALL SetErrStat(ErrID_Fatal, "WrDisDT ("//TRIM(Num2LStr(AWAE_InitInp%WrDisDT))//" s) must be an integer multiple of dt_low ("//TRIM(Num2LStr(p%DT_low))//" s).", ErrStat, ErrMsg, RoutineName ) - END IF - AWAE_InitInp%WrDisDT = p%DT_low * n_disDT_dt - - - if (AWAE_InitInp%NOutDisWindXY < 0 .or. AWAE_InitInp%NOutDisWindXY > maxOutputPlanes ) CALL SetErrStat( ErrID_Fatal, 'NOutDisWindXY must be in the range [0, 999].', ErrStat, ErrMsg, RoutineName ) - if (AWAE_InitInp%NOutDisWindYZ < 0 .or. AWAE_InitInp%NOutDisWindYZ > maxOutputPlanes ) CALL SetErrStat( ErrID_Fatal, 'NOutDisWindYZ must be in the range [0, 999].', ErrStat, ErrMsg, RoutineName ) - if (AWAE_InitInp%NOutDisWindXZ < 0 .or. AWAE_InitInp%NOutDisWindXZ > maxOutputPlanes ) CALL SetErrStat( ErrID_Fatal, 'NOutDisWindXZ must be in the range [0, 999].', ErrStat, ErrMsg, RoutineName ) - if (p%NOutDist < 0 .or. p%NOutDist > maxOutputPoints ) then - CALL SetErrStat( ErrID_Fatal, 'NOutDist must be in the range [0, 9].', ErrStat, ErrMsg, RoutineName ) - else - do i=1,p%NOutDist - if (p%OutDist(i) < 0.0_ReKi) then - CALL SetErrStat( ErrID_Fatal, 'OutDist values must be greater than or equal to zero.', ErrStat, ErrMsg, RoutineName ) + subroutine Cleanup() + ! nothing to clean up + end subroutine Cleanup + + ! Split out the ending of .u or u.bin from the filename. + ! If none given, then append ending and check for file existance + subroutine SplitFileName(FileName, BaseName, Ending, ErrStat3, ErrMsg3) + character(1024), intent(in ) :: FileName + character(1024), intent( out) :: BaseName + character(6), intent( out) :: Ending(3) + integer(IntKi), intent( out) :: ErrStat3 + character(*), intent( out) :: ErrMsg3 + integer(IntKi) :: i,l + logical :: foundFile + ErrStat3 = ErrID_None + ErrMsg3 = "" + ! check if passed filename ends in .u or u.bin + l=len_trim(FileName) + if (index(FileName,'.u')>0) then + BaseName = FileName(1:l-2) + Ending(1)= '.u' + inquire(file=trim(BaseName)//trim(Ending(1)), exist=foundfile) + if (.not. foundFile) then + ErrStat3 = ErrID_Fatal + ErrMsg3 = 'Cannot find wake added turbulence Mann box file with name '//trim(BaseName)//trim(Ending(1)) + endif + Ending(2)= '.v' + Ending(3)= '.w' + return + elseif (index(FileName,'u.bin') > 0) then + BaseName = FileName(1:l-4) + Ending(1)= 'u.bin' + inquire(file=trim(BaseName)//trim(Ending(1)), exist=foundfile) + if (.not. foundFile) then + ErrStat3 = ErrID_Fatal + ErrMsg3 = 'Cannot find wake added turbulence Mann box file with name '//trim(BaseName)//trim(Ending(1)) + endif + Ending(2)= 'v.bin' + Ending(3)= 'w.bin' + return + else ! Ending not included in filename, so try figure it out + BaseName = trim(FileName) + ! is it .u for file ending + Ending(1)= '.u' + Ending(2)= '.v' + Ending(3)= '.w' + inquire(file=trim(BaseName)//trim(Ending(1)), exist=foundFile) + if (foundFile) return + ! is it u.bin for file ending + Ending(1)= 'u.bin' + Ending(2)= 'v.bin' + Ending(3)= 'w.bin' + inquire(file=trim(BaseName)//trim(Ending(1)), exist=foundFile) + if (foundFile) return + ! didn't find file, so error out + ErrStat3 = ErrID_Fatal + ErrMsg3 = 'Cannot find wake added turbulence Mann box file with name '//trim(BaseName)//'.u '//' or '//trim(BaseName)//'u.bin ' + endif + end subroutine SplitFileName + !> If it is a filename of a library, expect following format: FFDB_512x512x64.u where: + !! 512x512x64 -- Number of grid points in X,Y,Z -- Nx, Ny, Nz + subroutine MannLibDims(BoxFileRoot,RotorDiamRef,Nxyz,Dxyz,ErrStat3,ErrMsg3) + character(1024), intent(in ) :: BoxFileroot + real(ReKi), intent(in ) :: RotorDiamRef ! reference rotordiam + integer(IntKi), intent( out) :: Nxyz(3) + real(ReKi), intent( out) :: Dxyz(3) ! derived based on rotor diameter + integer(IntKi), intent( out) :: ErrStat3 + character(*), intent( out) :: ErrMsg3 + integer(IntKi) :: i,iLast, n ! generic indexing stuff + character(1) :: C0 ! characters for testing + real(ReKi), parameter :: ScaleFact=0.03 ! scale ifactor for Dx,Dy,Dz based on rotor diameter + character(1024) :: sDigitsX ! String made of digits and "x" + character(11) :: CharNums="1234567890X" + character(1024), allocatable :: StrArray(:) ! Array of strings extracted from line + Nxyz(:)=-1 + + ErrStat3 = ErrID_None + ErrMsg3 = "" + + ! Set Dxyz + Dxyz=real(RotorDiamRef,ReKi)*ScaleFact + + ! --- Create a string made of digits and "x" only, starting from the end of the filename + n = len_trim(BoxFileRoot) + iLast = n + do i=n,1,-1 + C0 = BoxFileRoot(i:i) + call Conv2UC(C0) + if ((index(CharNums,C0)==0)) then exit - end if - end do - end if + endif + iLast=i + enddo + sDigitsX=BoxFileRoot(iLast:n) + call Conv2UC(sDigitsX) + + ! --- Splitting string according to character "x" + call strsplit(sDigitsX, StrArray, 'X') + if (size(StrArray)/=3) then + ErrStat3 = ErrID_Fatal + ErrMsg3 = "Could not find three substrings delimited by 'x' in filename "//trim(BoxFileRoot)// & + ". Expecting filename to include something like '512x512x64' for 512 by 512 by 64 points" + return + endif + do i=1,3 + if (.not.(is_integer(StrArray(i), Nxyz(i)))) then + ! NOTE: should not happen, unless we have "xx" + ErrStat3 = ErrID_Fatal + ErrMsg3 = "Could not convert substring `"//trim(StrArray(i))//"` to an integer in filename "//trim(BoxFileRoot)// & + ". Expecting filename to include something like '512x512x64' for 512 by 512 by 64 points" + return + endif + enddo + ErrStat3=ErrID_None + ErrMsg3 ="" + end subroutine MannLibDims +end subroutine WAT_init + +!> Remove mean from all grid nodes and set standard deviation to 1 at all nodes +! See Grid3D_ScaleTurbulence and ScaleMethod in InflowWind as well +subroutine Grid3D_ZeroMean_UnitStd(Vel) + real(SiKi), dimension(:,:,:,:), intent(inout) :: Vel !< Array of field velocities 3 x ny x nz x nt + integer(IntKi) :: i,j,k + real(SiKi) :: vmean, vstd + real(SiKi) :: nt + nt = real(size(Vel, 4), SiKi) + do i=1,size(Vel, 2) + do j=1,size(Vel, 3) + do k=1,3 + vmean = sum(Vel(k,i,j,:))/nt + vstd = sqrt(sum((Vel(k,i,j,:) - vmean)**2)/nt) + if ( EqualRealNos( vstd, 0.0_SiKi) ) then + vstd = 1.0_SiKi + endif + Vel(k,i,j,:) = (Vel(k,i,j,:) - vmean)/vstd + enddo + enddo + enddo +end subroutine Grid3D_ZeroMean_UnitStd + - if (p%NWindVel < 0 .or. p%NWindVel > maxOutputPoints ) CALL SetErrStat( ErrID_Fatal, 'NWindVel must be in the range [0, 9].', ErrStat, ErrMsg, RoutineName ) - if (p%NOutRadii < 0 .or. p%NOutRadii > 20 ) then - CALL SetErrStat( ErrID_Fatal, 'NOutRadii must be in the range [0, 20].', ErrStat, ErrMsg, RoutineName ) - else - do i=1,p%NOutRadii - if (p%OutRadii(i) > WD_InitInp%NumRadii - 1 .or. p%OutRadii(i) < 0) then - CALL SetErrStat( ErrID_Fatal, 'OutRadii must be in the range [0, NumRadii - 1].', ErrStat, ErrMsg, RoutineName ) - exit - end if - end do - end if - - - - ! Check that OutFmt is a valid format specifier and will fit over the column headings - CALL ChkRealFmtStr( p%OutFmt, 'OutFmt', p%FmtWidth, ErrStat2, ErrMsg2 ) !this sets p%FmtWidth! - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - IF ( p%FmtWidth /= ChanLen ) CALL SetErrStat( ErrID_Warn, 'OutFmt produces a column width of '// & - TRIM(Num2LStr(p%FmtWidth))//' instead of '//TRIM(Num2LStr(ChanLen))//' characters.', ErrStat, ErrMsg, RoutineName ) - - -END SUBROUTINE Farm_ValidateInput !---------------------------------------------------------------------------------------------------------------------------------- !> This routine initializes all instances of WakeDynamics SUBROUTINE Farm_InitWD( farm, WD_InitInp, ErrStat, ErrMsg ) @@ -1605,11 +595,7 @@ SUBROUTINE Farm_InitWD( farm, WD_InitInp, ErrStat, ErrMsg ) ErrStat = ErrID_None ErrMsg = "" - ALLOCATE(farm%WD(farm%p%NumTurbines),STAT=ErrStat2) - if (ErrStat2 /= 0) then - CALL SetErrStat( ErrID_Fatal, 'Could not allocate memory for Wake Dynamics data', ErrStat, ErrMsg, RoutineName ) - return - end if + ALLOCATE(farm%WD(farm%p%NumTurbines),STAT=ErrStat2); if (Failed0('Wake Dynamics data')) return; !................. ! Initialize each instance of WD @@ -1644,6 +630,18 @@ SUBROUTINE Farm_InitWD( farm, WD_InitInp, ErrStat, ErrMsg ) subroutine cleanup() call WD_DestroyInitOutput( WD_InitOut, ErrStat2, ErrMsg2 ) end subroutine cleanup + + ! check for failed where /= 0 is fatal + logical function Failed0(txt) + character(*), intent(in) :: txt + if (errStat /= 0) then + ErrStat2 = ErrID_Fatal + ErrMsg2 = "Could not allocate memory for "//trim(txt) + call SetErrStat(errStat2, errMsg2, errStat, errMsg, RoutineName) + endif + Failed0 = errStat >= AbortErrLev + if(Failed0) call cleanUp() + end function Failed0 END SUBROUTINE Farm_InitWD !---------------------------------------------------------------------------------------------------------------------------------- !> This routine initializes all instances of FAST using the FASTWrapper module @@ -1673,11 +671,7 @@ SUBROUTINE Farm_InitFAST( farm, WD_InitInp, AWAE_InitOutput, SC_InitOutput, SC_y ErrStat = ErrID_None ErrMsg = "" - ALLOCATE(farm%FWrap(farm%p%NumTurbines),STAT=ErrStat2) - if (ErrStat2 /= 0) then - CALL SetErrStat( ErrID_Fatal, 'Could not allocate memory for FAST Wrapper data', ErrStat, ErrMsg, RoutineName ) - return - end if + ALLOCATE(farm%FWrap(farm%p%NumTurbines),STAT=ErrStat2); if (Failed0('FAST Wrapper data')) return; !................. ! Initialize each instance of FAST @@ -1695,20 +689,12 @@ SUBROUTINE Farm_InitFAST( farm, WD_InitInp, AWAE_InitOutput, SC_InitOutput, SC_y FWrap_InitInp%NumSC2Ctrl = SC_InitOutput%NumSC2Ctrl FWrap_InitInp%NumSC2CtrlGlob= SC_InitOutput%NumSC2CtrlGlob FWrap_InitInp%NumCtrl2SC = SC_InitOutput%NumCtrl2SC - allocate(FWrap_InitInp%fromSCglob(SC_InitOutput%NumSC2CtrlGlob), stat=ErrStat2) - if (ErrStat2 /= 0) then - CALL SetErrStat( ErrID_Fatal, 'Could not allocate memory for FAST Wrapper data `fromSCglob`', ErrStat, ErrMsg, RoutineName ) - return - end if + allocate(FWrap_InitInp%fromSCglob(SC_InitOutput%NumSC2CtrlGlob), stat=ErrStat2); if (Failed0('FAST Wrapper data `fromSCglob`')) return; if (SC_InitOutput%NumSC2CtrlGlob>0) then FWrap_InitInp%fromSCglob = SC_y%fromSCglob endif - allocate(FWrap_InitInp%fromSC(SC_InitOutput%NumSC2Ctrl), stat=ErrStat2) - if (ErrStat2 /= 0) then - CALL SetErrStat( ErrID_Fatal, 'Could not allocate memory for FAST Wrapper data `fromSC`', ErrStat, ErrMsg, RoutineName ) - return - end if + allocate(FWrap_InitInp%fromSC(SC_InitOutput%NumSC2Ctrl), stat=ErrStat2); if (Failed0('FAST Wrapper data `fromSC`')) return; if (farm%p%MooringMod > 0) then FWrap_Interval = farm%p%dt_mooring ! when there is a farm-level mooring model, FASTWrapper will be called at the mooring coupling time step @@ -1736,6 +722,9 @@ SUBROUTINE Farm_InitFAST( farm, WD_InitInp, AWAE_InitOutput, SC_InitOutput, SC_y FWrap_InitInp%dX_high = AWAE_InitOutput%dX_high(nt) FWrap_InitInp%dY_high = AWAE_InitOutput%dY_high(nt) FWrap_InitInp%dZ_high = AWAE_InitOutput%dZ_high(nt) + + FWrap_InitInp%Vdist_High => AWAE_InitOutput%Vdist_High(nt)%data + if (SC_InitOutput%NumSC2Ctrl>0) then FWrap_InitInp%fromSC = SC_y%fromSC((nt-1)*SC_InitOutput%NumSC2Ctrl+1:nt*SC_InitOutput%NumSC2Ctrl) end if @@ -1769,25 +758,37 @@ subroutine cleanup() call FWrap_DestroyInitInput( FWrap_InitInp, ErrStat2, ErrMsg2 ) call FWrap_DestroyInitOutput( FWrap_InitOut, ErrStat2, ErrMsg2 ) end subroutine cleanup + ! check for failed where /= 0 is fatal + logical function Failed0(txt) + character(*), intent(in) :: txt + if (errStat /= 0) then + ErrStat2 = ErrID_Fatal + ErrMsg2 = "Could not allocate memory for "//trim(txt) + call SetErrStat(errStat2, errMsg2, errStat, errMsg, RoutineName) + endif + Failed0 = errStat >= AbortErrLev + if(Failed0) call cleanUp() + end function Failed0 END SUBROUTINE Farm_InitFAST !---------------------------------------------------------------------------------------------------------------------------------- !> This routine initializes a farm-level instance of MoorDyn if applicable SUBROUTINE Farm_InitMD( farm, ErrStat, ErrMsg ) ! Passed variables - type(All_FastFarm_Data), INTENT(INOUT) :: farm !< FAST.Farm data - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message + type(All_FastFarm_Data), TARGET, INTENT(INOUT) :: farm !< FAST.Farm data + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message ! local variables - type(MD_InitInputType) :: MD_InitInp - type(MD_InitOutputType) :: MD_InitOut + type(MD_InitInputType) :: MD_InitInp + type(MD_InitOutputType) :: MD_InitOut - INTEGER(IntKi) :: nt ! loop counter for rotor number - INTEGER(IntKi) :: ErrStat2 ! Temporary Error status - CHARACTER(ErrMsgLen) :: ErrMsg2 ! Temporary Error message - CHARACTER(*), PARAMETER :: RoutineName = 'Farm_InitMD' - + character(1025) :: Path, FileRoot ! for vtk outputs + INTEGER(IntKi) :: nt ! loop counter for rotor number + INTEGER(IntKi) :: ErrStat2 ! Temporary Error status + CHARACTER(ErrMsgLen) :: ErrMsg2 ! Temporary Error message + CHARACTER(*), PARAMETER :: RoutineName = 'Farm_InitMD' + TYPE(MeshType), POINTER :: SubstructureMotion ErrStat = ErrID_None ErrMsg = "" @@ -1831,11 +832,7 @@ SUBROUTINE Farm_InitMD( farm, ErrStat, ErrMsg ) MD_InitInp%FarmSize = farm%p%NumTurbines ! number of turbines in the array. >0 tells MoorDyn to operate in farm mode ALLOCATE( MD_InitInp%PtfmInit(6,farm%p%NumTurbines), MD_InitInp%TurbineRefPos(3,farm%p%NumTurbines), STAT = ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal,"Error allocating MoorDyn PtfmInit and TurbineRefPos initialization inputs in FAST.Farm.",ErrStat,ErrMsg,RoutineName) - CALL Cleanup() - RETURN - END IF + if (Failed0("MoorDyn PtfmInit and TurbineRefPos initialization inputs in FAST.Farm.")) return; ! gather spatial initialization inputs for Farm-level MoorDyn DO nt = 1,farm%p%NumTurbines @@ -1848,82 +845,58 @@ SUBROUTINE Farm_InitMD( farm, ErrStat, ErrMsg ) MD_InitInp%rhoW = 1025.0 MD_InitInp%WtrDepth = 0.0 !TODO: eventually connect this to a global depth input variable <<< + ! Visualization of shared moorings + if (farm%p%WrMooringVis) then + MD_InitInp%VisMeshes=.true. + farm%MD%VTK_Count = 0 + call GetPath ( MD_InitInp%RootName, Path, FileRoot ) ! the returned DVR_Outs%VTK_OutFileRoot includes a file separator character at the end + farm%MD%VTK_OutFileRoot = trim(Path)//PathSep//'vtk'//PathSep//trim(FileRoot) + farm%MD%VTK_TWidth = 5 !FIXME: this should be set based on sim length + endif ! allocate MoorDyn inputs (assuming size 2 for linear interpolation/extrapolation... > ALLOCATE( farm%MD%Input( 2 ), farm%MD%InputTimes( 2 ), STAT = ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal,"Error allocating MD%Input and MD%InputTimes.",ErrStat,ErrMsg,RoutineName) - CALL Cleanup() - RETURN - END IF + if (Failed0("MD%Input and MD%InputTimes.")) return; ! initialize MoorDyn CALL MD_Init( MD_InitInp, farm%MD%Input(1), farm%MD%p, farm%MD%x, farm%MD%xd, farm%MD%z, & farm%MD%OtherSt, farm%MD%y, farm%MD%m, farm%p%DT_mooring, MD_InitOut, ErrStat2, ErrMsg2 ) + if (Failed()) return; farm%MD%IsInitialized = .true. - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) then - call cleanup() - return - end if - ! Copy MD inputs over into the 2nd entry of the input array, to allow the first extrapolation in FARM_MD_Increment - CALL MD_CopyInput (farm%MD%Input(1), farm%MD%Input(2), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + CALL MD_CopyInput (farm%MD%Input(1), farm%MD%Input(2), MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return; farm%MD%InputTimes(2) = -0.1_DbKi - CALL MD_CopyInput (farm%MD%Input(1), farm%MD%u, MESH_NEWCOPY, Errstat2, ErrMsg2) ! do this to initialize meshes/allocatable arrays for output of ExtrapInterp routine - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - + CALL MD_CopyInput (farm%MD%Input(1), farm%MD%u, MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return; ! do this to initialize meshes/allocatable arrays for output of ExtrapInterp routine - ! Set up mesh maps between MoorDyn and floating platforms. - ! (for now assuming ElastoDyn - eventually could differentiate at the turbine level) + ! Set up mesh maps between MoorDyn and floating platforms (or substructure). ! allocate mesh mappings for coupling farm-level MoorDyn with OpenFAST instances ALLOCATE( farm%m%MD_2_FWrap(farm%p%NumTurbines), farm%m%FWrap_2_MD(farm%p%NumTurbines), STAT = ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal,"Error allocating MD_2_FWrap and FWrap_2_MD.",ErrStat,ErrMsg,RoutineName) - CALL Cleanup() - RETURN - END IF + if (Failed0("MD_2_FWrap and FWrap_2_MD.")) return; ! MoorDyn point mesh to/from ElastoDyn (or SubDyn) point mesh - do nt = 1,farm%p%NumTurbines + do nt = 1,farm%p%NumTurbines !if (farm%MD%p%NFairs(nt) > 0 ) then ! only set up a mesh map if MoorDyn has connections to this turbine ! loads - CALL MeshMapCreate( farm%MD%y%CoupledLoads(nt), & - farm%FWrap(nt)%m%Turbine%MeshMapData%u_ED_PlatformPtMesh_MDf, farm%m%MD_2_FWrap(nt), ErrStat2, ErrMsg2 ) - - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':MD_2_FWrap' ) + CALL MeshMapCreate( farm%MD%y%CoupledLoads(nt), farm%FWrap(nt)%m%Turbine%MeshMapData%SubstructureLoads_Tmp_Farm, farm%m%MD_2_FWrap(nt), ErrStat2, ErrMsg2 ) + if (Failed()) return; ! kinematics - CALL MeshMapCreate( farm%FWrap(nt)%m%Turbine%ED%y%PlatformPtMesh, & - farm%MD%Input(1)%CoupledKinematics(nt), farm%m%FWrap_2_MD(nt), ErrStat2, ErrMsg2 ) - - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':FWrap_2_MD' ) + IF (farm%FWrap(nt)%m%Turbine%p_FAST%CompSub == Module_SD) then + SubstructureMotion => farm%FWrap(nt)%m%Turbine%SD%y%y3Mesh + ELSE + SubstructureMotion => farm%FWrap(nt)%m%Turbine%ED%y%PlatformPtMesh + END IF + + CALL MeshMapCreate( SubstructureMotion, farm%MD%Input(1)%CoupledKinematics(nt), farm%m%FWrap_2_MD(nt), ErrStat2, ErrMsg2 ) + if (Failed()) return; - ! Since SubDyn connections are not enabled yet, issue warning - if (allocated(farm%FWrap(nt)%m%Turbine%SD%Input)) then - call SetErrStat( ErrID_Warn, 'Turbine '//trim(Num2LStr(nt))//': Farm moorings connected to ElastoDyn platform reference instead of SubDyn', Errstat, ErrMsg, RoutineName//':MD_2_FWrap' ) - endif - - ! SubDyn alternative: - !CALL MeshMapCreate( farm%MD%y%CoupledLoads(nt), & - ! farm%FWrap(nt)%m%Turbine%SD%Input(1)%LMesh, farm%m%MD_2_FWrap, ErrStat2, ErrMsg2 ) - ! - !CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':MD_2_FWrap' ) - ! - !CALL MeshMapCreate( farm%FWrap(nt)%m%Turbine%SD%y%y2Mesh, & - ! farm%MD%Input(1)%CoupledKinematics(nt), farm%m%FWrap_2_MD, ErrStat2, ErrMsg2 ) - ! - !CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':FWrap_2_MD' ) - !end if - end do + end do farm%p%Module_Ver( ModuleFF_MD) = MD_InitOut%Ver @@ -1935,23 +908,42 @@ subroutine cleanup() call MD_DestroyInitInput( MD_InitInp, ErrStat2, ErrMsg2 ) call MD_DestroyInitOutput( MD_InitOut, ErrStat2, ErrMsg2 ) end subroutine cleanup + + logical function Failed() + call SetErrStat(errStat2, errMsg2, errStat, errMsg, RoutineName) + Failed = errStat >= AbortErrLev + if (Failed) call cleanup() + end function Failed + + ! check for failed where /= 0 is fatal + logical function Failed0(txt) + character(*), intent(in) :: txt + if (errStat /= 0) then + ErrStat2 = ErrID_Fatal + ErrMsg2 = "Could not allocate memory for "//trim(txt) + call SetErrStat(errStat2, errMsg2, errStat, errMsg, RoutineName) + endif + Failed0 = errStat >= AbortErrLev + if(Failed0) call cleanUp() + end function Failed0 END SUBROUTINE Farm_InitMD !---------------------------------------------------------------------------------------------------------------------------------- !> This routine moves a farm-level MoorDyn simulation one step forward, to catch up with FWrap_Increment subroutine FARM_MD_Increment(t, n, farm, ErrStat, ErrMsg) - REAL(DbKi), INTENT(IN ) :: t !< Current simulation time in seconds - INTEGER(IntKi), INTENT(IN ) :: n !< Current step of the simulation in FARM MoorDyn terms - type(All_FastFarm_Data), INTENT(INOUT) :: farm !< FAST.Farm data - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message - - INTEGER(IntKi) :: nt - INTEGER(IntKi) :: n_ss - INTEGER(IntKi) :: n_FMD - REAL(DbKi) :: t_next ! time at next step after this one (s) - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FARM_MD_Increment' + REAL(DbKi), INTENT(IN ) :: t !< Current simulation time in seconds + INTEGER(IntKi), INTENT(IN ) :: n !< Current step of the simulation in FARM MoorDyn terms + type(All_FastFarm_Data), TARGET, INTENT(INOUT) :: farm !< FAST.Farm data + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message + + INTEGER(IntKi) :: nt + INTEGER(IntKi) :: n_ss + INTEGER(IntKi) :: n_FMD + REAL(DbKi) :: t_next ! time at next step after this one (s) + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FARM_MD_Increment' + TYPE(MeshType), POINTER :: SubstructureMotion ErrStat = ErrID_None ErrMsg = "" @@ -1961,16 +953,16 @@ subroutine FARM_MD_Increment(t, n, farm, ErrStat, ErrMsg) ! Do a linear extrapolation to estimate MoorDyn inputs at time n_ss+1 CALL MD_Input_ExtrapInterp(farm%MD%Input, farm%MD%InputTimes, farm%MD%u, t_next, ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + if (Failed()) return; ! Shift "window" of MD%Input: move values of Input and InputTimes from index 1 to index 2 CALL MD_CopyInput (farm%MD%Input(1), farm%MD%Input(2), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + if (Failed()) return; farm%MD%InputTimes(2) = farm%MD%InputTimes(1) ! update index 1 entries with the new extrapolated values CALL MD_CopyInput (farm%MD%u, farm%MD%Input(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + if (Failed()) return; farm%MD%InputTimes(1) = t_next @@ -1978,29 +970,30 @@ subroutine FARM_MD_Increment(t, n, farm, ErrStat, ErrMsg) do nt = 1,farm%p%NumTurbines !if (farm%MD%p%NFairs(nt) > 0 ) then - - CALL Transfer_Point_to_Point( farm%FWrap(nt)%m%Turbine%ED%y%PlatformPtMesh, farm%MD%Input(1)%CoupledKinematics(nt), & - farm%m%FWrap_2_MD(nt), ErrStat2, ErrMsg2 ) - - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat, ErrMsg,RoutineName//'u_MD%CoupledKinematics' ) - - ! SubDyn alternative - !CALL Transfer_Point_to_Point( farm%FWrap(nt)%m%Turbine%SD%y%y2Mesh, farm%MD%Input(1)%CoupledKinematics(nt), farm%m%FWrap_2_MD(nt), ErrStat, ErrMsg ) - !end if - end do + + IF (farm%FWrap(nt)%m%Turbine%p_FAST%CompSub == Module_SD) then + SubstructureMotion => farm%FWrap(nt)%m%Turbine%SD%y%y3Mesh + ELSE + SubstructureMotion => farm%FWrap(nt)%m%Turbine%ED%y%PlatformPtMesh + END IF + + CALL Transfer_Point_to_Point( SubstructureMotion, farm%MD%Input(1)%CoupledKinematics(nt), farm%m%FWrap_2_MD(nt), ErrStat2, ErrMsg2 ) + if (Failed()) return; + + !end if + end do ! ----- update states and calculate outputs ----- CALL MD_UpdateStates( t, n_FMD, farm%MD%Input, farm%MD%InputTimes, farm%MD%p, farm%MD%x, & farm%MD%xd, farm%MD%z, farm%MD%OtherSt, farm%MD%m, ErrStat2, ErrMsg2 ) - - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + if (Failed()) return; + CALL MD_CalcOutput( t, farm%MD%Input(1), farm%MD%p, farm%MD%x, farm%MD%xd, farm%MD%z, & farm%MD%OtherSt, farm%MD%y, farm%MD%m, ErrStat2, ErrMsg2 ) - - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + if (Failed()) return; ! ----- map MD load outputs to each turbine's substructure ----- (taken from U FullOpt1...) @@ -2008,29 +1001,27 @@ subroutine FARM_MD_Increment(t, n, farm, ErrStat, ErrMsg) if (farm%MD%p%nCpldPoints(nt) > 0 ) then ! only map loads if MoorDyn has connections to this turbine (currently considering only Point connections <<< ) - ! copy the MD output mesh for this turbine into a copy mesh within the FAST instance - !CALL MeshCopy ( farm%MD%y%CoupledLoads(nt), farm%FWrap(nt)%m%Turbine%MeshMapData%u_FarmMD_CoupledLoads, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) - ! CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':MeshCopy CoupledLoads' ) - - - ! mapping - CALL Transfer_Point_to_Point( farm%MD%y%CoupledLoads(nt), farm%FWrap(nt)%m%Turbine%MeshMapData%u_ED_PlatformPtMesh_MDf, & + IF (farm%FWrap(nt)%m%Turbine%p_FAST%CompSub == Module_SD) then + SubstructureMotion => farm%FWrap(nt)%m%Turbine%SD%y%y3Mesh + ELSE + SubstructureMotion => farm%FWrap(nt)%m%Turbine%ED%y%PlatformPtMesh + END IF + + ! mapping; Note: SubstructureLoads_Tmp_Farm contains loads from the farm-level (at a previous step); gets integrated into individual turbines inside FWrap_Increment() + CALL Transfer_Point_to_Point( farm%MD%y%CoupledLoads(nt), farm%FWrap(nt)%m%Turbine%MeshMapData%SubstructureLoads_Tmp_Farm, & farm%m%MD_2_FWrap(nt), ErrStat2, ErrMsg2, & - farm%MD%Input(1)%CoupledKinematics(nt), farm%FWrap(nt)%m%Turbine%ED%y%PlatformPtMesh ) !u_MD and y_ED contain the displacements needed for moment calculations + farm%MD%Input(1)%CoupledKinematics(nt), SubstructureMotion ) !u_MD and y_ED contain the displacements needed for moment calculations + if (Failed()) return; - CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) - - ! SubDyn alternative - !CALL Transfer_Point_to_Point( farm%MD%y%CoupledLoads(nt), farm%FWrap(nt)%m%Turbine%MeshMapData%u_SD_LMesh_2, & - ! farm%m%MD_2_FWrap(nt), ErrStat2, ErrMsg2, & - ! farm%MD%Input(1)%CoupledKinematics(nt), farm%FWrap(nt)%m%Turbine%SD%y%y2Mesh ) !u_MD and y_SD contain the displacements needed for moment calculations - ! - !farm%FWrap(nt)%m%Turbine%MeshMapData%u_SD_LMesh%Force = farm%FWrap(nt)%m%Turbine%MeshMapData%u_SD_LMesh%Force + farm%FWrap(nt)%m%Turbine%MeshMapData%u_SD_LMesh_2%Force - !farm%FWrap(nt)%m%Turbine%MeshMapData%u_SD_LMesh%Moment = farm%FWrap(nt)%m%Turbine%MeshMapData%u_SD_LMesh%Moment + farm%FWrap(nt)%m%Turbine%MeshMapData%u_SD_LMesh_2%Moment end if end do - - + + +contains + logical function Failed() + call SetErrStat(errStat2, errMsg2, errStat, errMsg, RoutineName) + Failed = errStat >= AbortErrLev + end function Failed end subroutine Farm_MD_Increment !---------------------------------------------------------------------------------------------------------------------------------- !> This routine performs the initial call to calculate outputs (at t=0). @@ -2084,7 +1075,6 @@ subroutine FARM_InitialCO(farm, ErrStat, ErrMsg) !-------------------- ! 1c. transfer y_AWAE to u_F and u_WD - call Transfer_AWAE_to_FAST(farm) call Transfer_AWAE_to_WD(farm) if (farm%p%UseSC) then @@ -2176,8 +1166,7 @@ subroutine FARM_InitialCO(farm, ErrStat, ErrMsg) !....................................................................................... ! Transfer y_AWAE to u_F and u_WD !....................................................................................... - - call Transfer_AWAE_to_FAST(farm) + call Transfer_AWAE_to_WD(farm) !....................................................................................... @@ -2645,7 +1634,7 @@ subroutine Farm_WriteOutput(n, t, farm, ErrStat, ErrMsg) farm%m%AllOuts(WVAmbZ(iVelPt)) = vel(3) ! Disturbed wind velocity (including wakes) for point, pt, in global coordinates (from the low-resolution domain), m/s - call TrilinearInterpRegGrid(farm%AWAE%m%Vdist_low, pt, (/farm%p%nX_low,farm%p%nY_low,farm%p%nZ_low/), vel) + call TrilinearInterpRegGrid(farm%AWAE%m%Vdist_low_full, pt, (/farm%p%nX_low,farm%p%nY_low,farm%p%nZ_low/), vel) farm%m%AllOuts(WVDisX(iVelPt)) = vel(1) farm%m%AllOuts(WVDisY(iVelPt)) = vel(2) farm%m%AllOuts(WVDisZ(iVelPt)) = vel(3) @@ -2677,7 +1666,7 @@ subroutine FARM_CalcOutput(t, farm, ErrStat, ErrMsg) INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message - INTEGER(IntKi) :: nt + INTEGER(IntKi) :: nt,j INTEGER(IntKi) :: ErrStat2 ! Temporary Error status CHARACTER(ErrMsgLen) :: ErrMsg2 ! Temporary Error message CHARACTER(*), PARAMETER :: RoutineName = 'FARM_CalcOutput' @@ -2764,7 +1753,6 @@ subroutine FARM_CalcOutput(t, farm, ErrStat, ErrMsg) !-------------------- ! 2. Transfer y_AWAE to u_F and u_WD - call Transfer_AWAE_to_FAST(farm) call Transfer_AWAE_to_WD(farm) @@ -2776,16 +1764,43 @@ subroutine FARM_CalcOutput(t, farm, ErrStat, ErrMsg) call Farm_WriteOutput(n, t, farm, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + !....................................................................................... + ! Write shared moorings visualization + !....................................................................................... + + ! Write visualization meshes + if (farm%p%MooringMod == 3) then + if (farm%MD%p%VisMeshes) then + if (allocated(farm%MD%y%VisLinesMesh)) then + do j=1,size(farm%MD%y%VisLinesMesh) + if (farm%MD%y%VisLinesMesh(j)%Committed) then + call MeshWrVTK((/0.0_SiKi,0.0_SiKi,0.0_SiKi/), farm%MD%y%VisLinesMesh(j), trim(farm%MD%VTK_OutFileRoot)//'.MD_Line'//trim(Num2LStr(j)), farm%MD%VTK_count, .false., ErrSTat2, ErrMsg2, farm%MD%VTK_tWidth ) + endif + enddo + endif + if (allocated(farm%MD%y%VisRodsMesh)) then + do j=1,size(farm%MD%y%VisRodsMesh) + if (farm%MD%y%VisRodsMesh(j)%Committed) then + call MeshWrVTK((/0.0_SiKi,0.0_SiKi,0.0_SiKi/), farm%MD%y%VisRodsMesh(j), trim(farm%MD%VTK_OutFileRoot)//'.MD_Rod'//trim(Num2LStr(j)), farm%MD%VTK_count, .false., ErrSTat2, ErrMsg2, farm%MD%VTK_tWidth ) + endif + enddo + endif + farm%MD%VTK_Count = farm%MD%VTK_Count + 1 + endif + endif + ! write(*,*) 'Total Farm_CO-serial took '//trim(num2lstr(omp_get_wtime()-tm1))//' seconds.' end subroutine FARM_CalcOutput !---------------------------------------------------------------------------------------------------------------------------------- !> This routine ends the modules used in this simulation. It does not exit the program. -!! - In parallel: -!! 1. CALL AWAE_End -!! 2. CALL WD_End -!! 3. CALL SC_End -!! 4. CALL F_End +!! - In parallel: +!! 1. CALL WAT_End +!! 2. CALL AWAE_End +!! 3. CALL WD_End +!! 4. CALL SC_End +!! 5. CALL FWrap_End +!! 6. CALL MD_End !! - Close Output File subroutine FARM_End(farm, ErrStat, ErrMsg) type(All_FastFarm_Data), INTENT(INOUT) :: farm @@ -2807,7 +1822,16 @@ subroutine FARM_End(farm, ErrStat, ErrMsg) !....................................................................................... !-------------- - ! 1. end AWAE + ! 1. end AWAE + if (farm%WAT_IfW%IsInitialized) then + call InflowWind_End(farm%WAT_IfW%u, farm%WAT_IfW%p, farm%WAT_IfW%x, farm%WAT_IfW%xd, farm%WAT_IfW%z, & + farm%WAT_IfW%OtherSt, farm%WAT_IfW%y, farm%WAT_IfW%m, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + farm%WAT_IfW%IsInitialized = .false. + endif + + !-------------- + ! 2. end AWAE if (farm%AWAE%IsInitialized) then call AWAE_End( farm%AWAE%u, farm%AWAE%p, farm%AWAE%x, farm%AWAE%xd, farm%AWAE%z, & farm%AWAE%OtherSt, farm%AWAE%y, farm%AWAE%m, ErrStat2, ErrMsg2 ) @@ -2815,11 +1839,9 @@ subroutine FARM_End(farm, ErrStat, ErrMsg) farm%AWAE%IsInitialized = .false. end if - !-------------- - ! 2. end WakeDynamics + ! 3. end WakeDynamics if (allocated(farm%WD)) then - DO nt = 1,farm%p%NumTurbines if (farm%WD(nt)%IsInitialized) then call WD_End( farm%WD(nt)%u, farm%WD(nt)%p, farm%WD(nt)%x, farm%WD(nt)%xd, farm%WD(nt)%z, & @@ -2828,12 +1850,10 @@ subroutine FARM_End(farm, ErrStat, ErrMsg) farm%WD(nt)%IsInitialized = .false. end if END DO - end if !-------------- - ! 3. End supercontroller - + ! 4. End supercontroller if ( farm%p%useSC ) then CALL SC_End(farm%SC%uInputs, farm%SC%p, farm%SC%x, farm%SC%xd, farm%SC%z, farm%SC%OtherState, & farm%SC%y, farm%SC%m, ErrStat2, ErrMsg2) @@ -2841,9 +1861,8 @@ subroutine FARM_End(farm, ErrStat, ErrMsg) end if !-------------- - ! 4. End each instance of FAST (each instance of FAST can be done in parallel, too) + ! 5. End each instance of FAST (each instance of FAST can be done in parallel, too) if (allocated(farm%FWrap)) then - DO nt = 1,farm%p%NumTurbines if (farm%FWrap(nt)%IsInitialized) then CALL FWrap_End( farm%FWrap(nt)%u, farm%FWrap(nt)%p, farm%FWrap(nt)%x, farm%FWrap(nt)%xd, farm%FWrap(nt)%z, & @@ -2852,12 +1871,11 @@ subroutine FARM_End(farm, ErrStat, ErrMsg) farm%FWrap(nt)%IsInitialized = .false. end if END DO - end if !-------------- - ! 5. End farm-level MoorDyn - if (farm%p%MooringMod == 3) then + ! 6. End farm-level MoorDyn + if (farm%p%MooringMod == 3 .and. allocated(farm%MD%Input)) then call MD_End(farm%MD%Input(1), farm%MD%p, farm%MD%x, farm%MD%xd, farm%MD%z, farm%MD%OtherSt, farm%MD%y, farm%MD%m, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) !TODO: any related items need to be cleared? @@ -2911,18 +1929,6 @@ SUBROUTINE Transfer_AWAE_to_WD(farm) END SUBROUTINE Transfer_AWAE_to_WD !---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE Transfer_AWAE_to_FAST(farm) - type(All_FastFarm_Data), INTENT(INOUT) :: farm !< FAST.Farm data - - integer(intKi) :: nt - - DO nt = 1,farm%p%NumTurbines - ! allocated in FAST's IfW initialization as 3,x,y,z,t - farm%FWrap(nt)%u%Vdist_High = farm%AWAE%y%Vdist_High(nt)%data - END DO - -END SUBROUTINE Transfer_AWAE_to_FAST -!---------------------------------------------------------------------------------------------------------------------------------- SUBROUTINE Transfer_WD_to_AWAE(farm) type(All_FastFarm_Data), INTENT(INOUT) :: farm !< FAST.Farm data @@ -2934,7 +1940,10 @@ SUBROUTINE Transfer_WD_to_AWAE(farm) farm%AWAE%u%Vx_wake(:,:,:,nt) = farm%WD(nt)%y%Vx_wake2 ! Axial wake velocity deficit at wake planes, distributed radially, for each turbine farm%AWAE%u%Vy_wake(:,:,:,nt) = farm%WD(nt)%y%Vy_wake2 ! Horizontal wake velocity deficit at wake planes, distributed radially, for each turbine farm%AWAE%u%Vz_wake(:,:,:,nt) = farm%WD(nt)%y%Vz_wake2 ! "Vertical" wake velocity deficit at wake planes, distributed radially, for each turbine - farm%AWAE%u%D_wake(:,nt) = farm%WD(nt)%y%D_wake ! Wake diameters at wake planes for each turbine + farm%AWAE%u%D_wake(:,nt) = farm%WD(nt)%y%D_wake ! Wake diameters at wake planes for each turbine + if (farm%p%WAT /= Mod_WAT_None) then + farm%AWAE%u%WAT_k(:,:,:,nt) = farm%WD(nt)%y%WAT_k ! scaling factor for each wake plane for WAT + endif END DO END SUBROUTINE Transfer_WD_to_AWAE diff --git a/glue-codes/fast-farm/src/FAST_Farm_Types.f90 b/glue-codes/fast-farm/src/FAST_Farm_Types.f90 index 540dc80c53..f2a0fce0e7 100644 --- a/glue-codes/fast-farm/src/FAST_Farm_Types.f90 +++ b/glue-codes/fast-farm/src/FAST_Farm_Types.f90 @@ -44,60 +44,70 @@ MODULE FAST_Farm_Types INTEGER(IntKi), PUBLIC, PARAMETER :: ModuleFF_WD = 3 ! Wake Dynamics [-] INTEGER(IntKi), PUBLIC, PARAMETER :: ModuleFF_AWAE = 4 ! Ambient Wind and Array Effects [-] INTEGER(IntKi), PUBLIC, PARAMETER :: ModuleFF_MD = 5 ! Farm-level MoorDyn [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Mod_WAT_None = 0 ! WAT: off [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Mod_WAT_PreDef = 1 ! WAT: predefined turbulence boxes [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Mod_WAT_UserDef = 2 ! WAT: user defined turbulence boxes [-] ! ========= Farm_ParameterType ======= TYPE, PUBLIC :: Farm_ParameterType - REAL(DbKi) :: DT_low !< Time step for low-resolution wind data input files; will be used as the global FAST.Farm time step [seconds] - REAL(DbKi) :: DT_high !< High-resolution time step [seconds] - REAL(DbKi) :: TMax !< Total run time [seconds] - INTEGER(IntKi) :: n_high_low !< Number of high-resolution time steps per low-resolution time step [-] - INTEGER(IntKi) :: NumTurbines !< Number of turbines in the simulation [-] + REAL(DbKi) :: DT_low = 0.0_R8Ki !< Time step for low-resolution wind data input files; will be used as the global FAST.Farm time step [seconds] + REAL(DbKi) :: DT_high = 0.0_R8Ki !< High-resolution time step [seconds] + REAL(DbKi) :: TMax = 0.0_R8Ki !< Total run time [seconds] + INTEGER(IntKi) :: n_high_low = 0_IntKi !< Number of high-resolution time steps per low-resolution time step [-] + INTEGER(IntKi) :: NumTurbines = 0_IntKi !< Number of turbines in the simulation [-] CHARACTER(1024) :: WindFilePath !< Path name of wind data files from ABLSolver precursor [-] CHARACTER(1024) :: SC_FileName !< Name/location of the dynamic library {.dll [Windows] or .so [Linux]} containing the Super Controller algorithms [-] - LOGICAL :: UseSC !< Use a super controller? [-] + LOGICAL :: UseSC = .false. !< Use a super controller? [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: WT_Position !< X-Y-Z position of each wind turbine; index 1 = XYZ; index 2 = turbine number [meters] - INTEGER(IntKi) :: WaveFieldMod !< Wave field handling (-) (switch) {0: use individual HydroDyn inputs without adjustment, 1: adjust wave phases based on turbine offsets from farm origin} [-] - INTEGER(IntKi) :: MooringMod !< Mod_SharedMooring is a flag for array-level mooring. (switch) {0: none, 3: yes/MoorDyn} [-] + INTEGER(IntKi) :: WaveFieldMod = 0_IntKi !< Wave field handling (-) (switch) {0: use individual HydroDyn inputs without adjustment, 1: adjust wave phases based on turbine offsets from farm origin} [-] + INTEGER(IntKi) :: MooringMod = 0_IntKi !< Mod_SharedMooring is a flag for array-level mooring. (switch) {0: none, 3: yes/MoorDyn} [-] + LOGICAL :: WrMooringVis = .false. !< Write shared mooring visualization (-) [only used for Mod_SharedMooring=3] [-] CHARACTER(1024) :: MD_FileName !< Name/location of the farm-level MoorDyn input file [-] - REAL(DbKi) :: DT_mooring !< Time step for farm-levem mooring coupling with each turbine [used only when Mod_SharedMooring > 0] [seconds] - INTEGER(IntKi) :: n_mooring !< Number of FAST and MoorDyn time steps per FAST.Farm timestep when mooring > 0 [-] + REAL(DbKi) :: DT_mooring = 0.0_R8Ki !< Time step for farm-levem mooring coupling with each turbine [used only when Mod_SharedMooring > 0] [seconds] + INTEGER(IntKi) :: n_mooring = 0_IntKi !< Number of FAST and MoorDyn time steps per FAST.Farm timestep when mooring > 0 [-] CHARACTER(1024) , DIMENSION(:), ALLOCATABLE :: WT_FASTInFile !< Name of input file for each turbine [-] CHARACTER(1024) :: FTitle !< The description line from the primary FAST.Farm input file [-] CHARACTER(1024) :: OutFileRoot !< The root name derived from the primary FAST.Farm input file [-] - INTEGER(IntKi) :: n_ChkptTime !< Number of time steps between writing checkpoint files [-] - REAL(DbKi) :: TStart !< Time to begin tabular output [s] - INTEGER(IntKi) :: n_TMax !< Number of the time step of TMax (the end time of the simulation) [-] - LOGICAL :: SumPrint !< Print summary data to file? (.sum) [-] - LOGICAL :: WrBinOutFile !< Write a binary output file? (.outb) [-] - LOGICAL :: WrTxtOutFile !< Write a text (formatted) output file? (.out) [-] + INTEGER(IntKi) :: n_ChkptTime = 0_IntKi !< Number of time steps between writing checkpoint files [-] + REAL(DbKi) :: TStart = 0.0_R8Ki !< Time to begin tabular output [s] + INTEGER(IntKi) :: n_TMax = 0_IntKi !< Number of the time step of TMax (the end time of the simulation) [-] + REAL(ReKi) :: RotorDiamRef = 0.0_ReKi !< Reference turbine rotor diameter for wake calculations (m) [>0.0] [-] + LOGICAL :: SumPrint = .false. !< Print summary data to file? (.sum) [-] + LOGICAL :: WrBinOutFile = .false. !< Write a binary output file? (.outb) [-] + LOGICAL :: WrTxtOutFile = .false. !< Write a text (formatted) output file? (.out) [-] CHARACTER(1) :: Delim !< Delimiter between columns of text output file (.out): space or tab [-] CHARACTER(20) :: OutFmt !< Format used for text tabular output (except time); resulting field should be 10 characters [-] CHARACTER(20) :: OutFmt_t !< Format used for time channel in text tabular output; resulting field should be 10 characters [-] - INTEGER(IntKi) :: FmtWidth !< width of the time OutFmt specifier [-] - INTEGER(IntKi) :: TChanLen !< width of the time channel [-] - INTEGER(IntKi) :: NOutTurb !< Number of turbines for write output [1 to 9] [-] - INTEGER(IntKi) :: NOutRadii !< Number of radial nodes for wake output for an individual rotor [0 to 20] [-] + INTEGER(IntKi) :: FmtWidth = 0_IntKi !< width of the time OutFmt specifier [-] + INTEGER(IntKi) :: TChanLen = 0_IntKi !< width of the time channel [-] + INTEGER(IntKi) :: NOutTurb = 0_IntKi !< Number of turbines for write output [1 to 9] [-] + INTEGER(IntKi) :: NOutRadii = 0_IntKi !< Number of radial nodes for wake output for an individual rotor [0 to 20] [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: OutRadii !< List of radial nodes for wake output for an individual rotor [1 to NOutRadii] [-] - INTEGER(IntKi) :: NOutDist !< Number of downstream distances for wake output for an individual rotor [0 to 9] [-] + INTEGER(IntKi) :: NOutDist = 0_IntKi !< Number of downstream distances for wake output for an individual rotor [0 to 9] [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: OutDist !< List of downstream distances for wake output for an individual rotor [1 to NOutDist] [meters] - INTEGER(IntKi) :: NWindVel !< Number of points for wind output [0 to 9] [-] + INTEGER(IntKi) :: NWindVel = 0_IntKi !< Number of points for wind output [0 to 9] [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: WindVelX !< List of coordinates in the X direction for wind output [1 to NWindVel] [meters] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: WindVelY !< List of coordinates in the Y direction for wind output [1 to NWindVel] [meters] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: WindVelZ !< List of coordinates in the Z direction for wind output [1 to NWindVel] [meters] - TYPE(OutParmType) , DIMENSION(:), ALLOCATABLE :: OutParam !< Names and units (and other characteristics) of all requested output parameters [-] - INTEGER(IntKi) :: NumOuts !< Number of user-requested outputs [-] - INTEGER(IntKi) :: NOutSteps !< Maximum number of output steps [-] + TYPE(OutParmType) , DIMENSION(:), ALLOCATABLE :: OutParam !< Names and units (and other characteristics) of all requested output parameter [-] + INTEGER(IntKi) :: NumOuts = 0_IntKi !< Number of user-requested outputs [-] + INTEGER(IntKi) :: NOutSteps = 0_IntKi !< Maximum number of output steps [-] CHARACTER(1024) , DIMENSION(1:3) :: FileDescLines !< File Description lines [-] - TYPE(ProgDesc) , DIMENSION(NumModules) :: Module_Ver !< Version information from all modules [-] - INTEGER(IntKi) :: UnOu !< File unit for Fast.Farm output data [-] - REAL(ReKi) :: dX_low !< The spacing of the low-resolution nodes in X direction [m] - REAL(ReKi) :: dY_low !< The spacing of the low-resolution nodes in Y direction [m] - REAL(ReKi) :: dZ_low !< The spacing of the low-resolution nodes in Z direction [m] - INTEGER(IntKi) :: nX_low !< Number of low-resolution spatial nodes in X direction [-] - INTEGER(IntKi) :: nY_low !< Number of low-resolution spatial nodes in Y direction [-] - INTEGER(IntKi) :: nZ_low !< Number of low-resolution spatial nodes in Z direction [-] - REAL(ReKi) :: X0_low !< X-component of the origin of the low-resolution spatial domain [m] - REAL(ReKi) :: Y0_low !< Y-component of the origin of the low-resolution spatial domain [m] - REAL(ReKi) :: Z0_low !< Z-component of the origin of the low-resolution spatial domain [m] + TYPE(ProgDesc) , DIMENSION(1:NumModules) :: Module_Ver !< Version information from all modules [-] + INTEGER(IntKi) :: UnOu = 0_IntKi !< File unit for Fast.Farm output data [-] + REAL(ReKi) :: dX_low = 0.0_ReKi !< The spacing of the low-resolution nodes in X direction [m] + REAL(ReKi) :: dY_low = 0.0_ReKi !< The spacing of the low-resolution nodes in Y direction [m] + REAL(ReKi) :: dZ_low = 0.0_ReKi !< The spacing of the low-resolution nodes in Z direction [m] + INTEGER(IntKi) :: nX_low = 0_IntKi !< Number of low-resolution spatial nodes in X direction [-] + INTEGER(IntKi) :: nY_low = 0_IntKi !< Number of low-resolution spatial nodes in Y direction [-] + INTEGER(IntKi) :: nZ_low = 0_IntKi !< Number of low-resolution spatial nodes in Z direction [-] + REAL(ReKi) :: X0_low = 0.0_ReKi !< X-component of the origin of the low-resolution spatial domain [m] + REAL(ReKi) :: Y0_low = 0.0_ReKi !< Y-component of the origin of the low-resolution spatial domain [m] + REAL(ReKi) :: Z0_low = 0.0_ReKi !< Z-component of the origin of the low-resolution spatial domain [m] + INTEGER(IntKi) :: WAT = 0_IntKi !< Switch between wake-added turbulence box options {0: no wake added turbulence, 1: predefined turbulence box, 2: user defined turbulence box} [-] + CHARACTER(1024) :: WAT_BoxFile !< Filepath to the file containing the u-component of the turbulence box (either predefined or user-defined). [-] + INTEGER(IntKi) , DIMENSION(1:3) :: WAT_NxNyNz = 0_IntKi !< Number of points in the x, y, and z directions of the WAT_BoxFile -- derived (WAT=1) or read from input file (WAT=2) [(m)] + REAL(ReKi) , DIMENSION(1:3) :: WAT_DxDyDz = 0.0_ReKi !< Distance (in meters) between points in the x, y, and z directions of the WAT_BoxFile -- derived (WAT=1) or read from input file (WAT=2) [(m)] + LOGICAL :: WAT_ScaleBox = .false. !< Flag to scale the input turbulence box to zero mean and unit standard deviation at every node [-] END TYPE Farm_ParameterType ! ======================= ! ========= Farm_MiscVarType ======= @@ -105,7 +115,7 @@ MODULE FAST_Farm_Types 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) , DIMENSION(:), ALLOCATABLE :: TimeData !< Array to contain the time output data for the binary file (first output time and a time [fixed] increment) [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: AllOutData !< Array to contain all the output data (time history of all outputs); Index 1 is NumOuts, Index 2 is Time step [-] - INTEGER(IntKi) :: n_Out !< Time index into the AllOutData array [-] + INTEGER(IntKi) :: n_Out = 0_IntKi !< Time index into the AllOutData array [-] TYPE(MeshMapType) , DIMENSION(:), ALLOCATABLE :: FWrap_2_MD !< Map platform kinematics from each FAST instance to MD [-] TYPE(MeshMapType) , DIMENSION(:), ALLOCATABLE :: MD_2_FWrap !< Map MD loads at the array level to each FAST instance [-] END TYPE Farm_MiscVarType @@ -157,7 +167,7 @@ MODULE FAST_Farm_Types TYPE(SC_OtherStateType) :: OtherState !< Other states [-] TYPE(SC_ParameterType) :: p !< Parameters [-] TYPE(SC_InputType) :: uInputs !< System inputs [-] - REAL(DbKi) , DIMENSION(1:1) :: utimes !< Current time [s] + REAL(DbKi) , DIMENSION(1:1) :: utimes = 0.0_R8Ki !< Current time [s] TYPE(SC_OutputType) :: y !< System outputs [-] TYPE(SC_MiscVarType) :: m !< Misc/optimization variables [-] LOGICAL :: IsInitialized = .FALSE. !< Has SC_Init been called [-] @@ -176,8 +186,24 @@ MODULE FAST_Farm_Types TYPE(MD_OutputType) :: y !< System outputs [-] TYPE(MD_MiscVarType) :: m !< Misc/optimization variables [-] LOGICAL :: IsInitialized = .FALSE. !< Has MD_Init been called [-] + INTEGER(IntKi) :: VTK_count = 0 !< Counter for VTK output of shared moorings [-] + INTEGER(IntKi) :: VTK_TWidth = 0_IntKi !< width for VTK_count field in output name [-] + character(1024) :: VTK_OutFileRoot !< Rootfilename for VTK output [-] END TYPE MD_Data ! ======================= +! ========= WAT_IfW_data ======= + TYPE, PUBLIC :: WAT_IfW_data + TYPE(InflowWind_ContinuousStateType) :: x !< Continuous states [-] + TYPE(InflowWind_DiscreteStateType) :: xd !< Discrete states [-] + TYPE(InflowWind_ConstraintStateType) :: z !< Constraint states [-] + TYPE(InflowWind_OtherStateType) :: OtherSt !< Other states [-] + TYPE(InflowWind_ParameterType) :: p !< Parameters [-] + TYPE(InflowWind_InputType) :: u !< System inputs [-] + TYPE(InflowWind_OutputType) :: y !< System outputs [-] + TYPE(InflowWind_MiscVarType) :: m !< Misc/optimization variables [-] + LOGICAL :: IsInitialized = .FALSE. !< Has IfW_Init been called [-] + END TYPE WAT_IfW_data +! ======================= ! ========= All_FastFarm_Data ======= TYPE, PUBLIC :: All_FastFarm_Data TYPE(Farm_ParameterType) :: p !< FAST.Farm parameter data [-] @@ -187,7047 +213,1453 @@ MODULE FAST_Farm_Types TYPE(AWAE_Data) :: AWAE !< Ambient Wind & Array Effects (AWAE) data [-] TYPE(SC_Data) :: SC !< Super Controller (SC) data [-] TYPE(MD_Data) :: MD !< Farm-level MoorDyn model data [-] + TYPE(WAT_IfW_data) :: WAT_IfW !< IfW data for WAT (temporary location until pointers are enabled) [-] END TYPE All_FastFarm_Data ! ======================= CONTAINS - SUBROUTINE Farm_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Farm_ParameterType), INTENT(IN) :: SrcParamData - TYPE(Farm_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 = 'Farm_CopyParam' -! - ErrStat = ErrID_None - ErrMsg = "" - DstParamData%DT_low = SrcParamData%DT_low - DstParamData%DT_high = SrcParamData%DT_high - DstParamData%TMax = SrcParamData%TMax - DstParamData%n_high_low = SrcParamData%n_high_low - DstParamData%NumTurbines = SrcParamData%NumTurbines - DstParamData%WindFilePath = SrcParamData%WindFilePath - DstParamData%SC_FileName = SrcParamData%SC_FileName - DstParamData%UseSC = SrcParamData%UseSC -IF (ALLOCATED(SrcParamData%WT_Position)) THEN - i1_l = LBOUND(SrcParamData%WT_Position,1) - i1_u = UBOUND(SrcParamData%WT_Position,1) - i2_l = LBOUND(SrcParamData%WT_Position,2) - i2_u = UBOUND(SrcParamData%WT_Position,2) - IF (.NOT. ALLOCATED(DstParamData%WT_Position)) THEN - ALLOCATE(DstParamData%WT_Position(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WT_Position.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%WT_Position = SrcParamData%WT_Position -ENDIF - DstParamData%WaveFieldMod = SrcParamData%WaveFieldMod - DstParamData%MooringMod = SrcParamData%MooringMod - DstParamData%MD_FileName = SrcParamData%MD_FileName - DstParamData%DT_mooring = SrcParamData%DT_mooring - DstParamData%n_mooring = SrcParamData%n_mooring -IF (ALLOCATED(SrcParamData%WT_FASTInFile)) THEN - i1_l = LBOUND(SrcParamData%WT_FASTInFile,1) - i1_u = UBOUND(SrcParamData%WT_FASTInFile,1) - IF (.NOT. ALLOCATED(DstParamData%WT_FASTInFile)) THEN - ALLOCATE(DstParamData%WT_FASTInFile(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WT_FASTInFile.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%WT_FASTInFile = SrcParamData%WT_FASTInFile -ENDIF - DstParamData%FTitle = SrcParamData%FTitle - DstParamData%OutFileRoot = SrcParamData%OutFileRoot - DstParamData%n_ChkptTime = SrcParamData%n_ChkptTime - DstParamData%TStart = SrcParamData%TStart - DstParamData%n_TMax = SrcParamData%n_TMax - DstParamData%SumPrint = SrcParamData%SumPrint - DstParamData%WrBinOutFile = SrcParamData%WrBinOutFile - DstParamData%WrTxtOutFile = SrcParamData%WrTxtOutFile - DstParamData%Delim = SrcParamData%Delim - DstParamData%OutFmt = SrcParamData%OutFmt - DstParamData%OutFmt_t = SrcParamData%OutFmt_t - DstParamData%FmtWidth = SrcParamData%FmtWidth - DstParamData%TChanLen = SrcParamData%TChanLen - DstParamData%NOutTurb = SrcParamData%NOutTurb - DstParamData%NOutRadii = SrcParamData%NOutRadii -IF (ALLOCATED(SrcParamData%OutRadii)) THEN - i1_l = LBOUND(SrcParamData%OutRadii,1) - i1_u = UBOUND(SrcParamData%OutRadii,1) - IF (.NOT. ALLOCATED(DstParamData%OutRadii)) THEN - ALLOCATE(DstParamData%OutRadii(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutRadii.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%OutRadii = SrcParamData%OutRadii -ENDIF - DstParamData%NOutDist = SrcParamData%NOutDist -IF (ALLOCATED(SrcParamData%OutDist)) THEN - i1_l = LBOUND(SrcParamData%OutDist,1) - i1_u = UBOUND(SrcParamData%OutDist,1) - IF (.NOT. ALLOCATED(DstParamData%OutDist)) THEN - ALLOCATE(DstParamData%OutDist(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutDist.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%OutDist = SrcParamData%OutDist -ENDIF - DstParamData%NWindVel = SrcParamData%NWindVel -IF (ALLOCATED(SrcParamData%WindVelX)) THEN - i1_l = LBOUND(SrcParamData%WindVelX,1) - i1_u = UBOUND(SrcParamData%WindVelX,1) - IF (.NOT. ALLOCATED(DstParamData%WindVelX)) THEN - ALLOCATE(DstParamData%WindVelX(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WindVelX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%WindVelX = SrcParamData%WindVelX -ENDIF -IF (ALLOCATED(SrcParamData%WindVelY)) THEN - i1_l = LBOUND(SrcParamData%WindVelY,1) - i1_u = UBOUND(SrcParamData%WindVelY,1) - IF (.NOT. ALLOCATED(DstParamData%WindVelY)) THEN - ALLOCATE(DstParamData%WindVelY(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WindVelY.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%WindVelY = SrcParamData%WindVelY -ENDIF -IF (ALLOCATED(SrcParamData%WindVelZ)) THEN - i1_l = LBOUND(SrcParamData%WindVelZ,1) - i1_u = UBOUND(SrcParamData%WindVelZ,1) - IF (.NOT. ALLOCATED(DstParamData%WindVelZ)) THEN - ALLOCATE(DstParamData%WindVelZ(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WindVelZ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%WindVelZ = SrcParamData%WindVelZ -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%NumOuts = SrcParamData%NumOuts - DstParamData%NOutSteps = SrcParamData%NOutSteps - DstParamData%FileDescLines = SrcParamData%FileDescLines - DO i1 = LBOUND(SrcParamData%Module_Ver,1), UBOUND(SrcParamData%Module_Ver,1) - CALL NWTC_Library_Copyprogdesc( SrcParamData%Module_Ver(i1), DstParamData%Module_Ver(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DstParamData%UnOu = SrcParamData%UnOu - DstParamData%dX_low = SrcParamData%dX_low - DstParamData%dY_low = SrcParamData%dY_low - DstParamData%dZ_low = SrcParamData%dZ_low - DstParamData%nX_low = SrcParamData%nX_low - DstParamData%nY_low = SrcParamData%nY_low - DstParamData%nZ_low = SrcParamData%nZ_low - DstParamData%X0_low = SrcParamData%X0_low - DstParamData%Y0_low = SrcParamData%Y0_low - DstParamData%Z0_low = SrcParamData%Z0_low - END SUBROUTINE Farm_CopyParam - - SUBROUTINE Farm_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(Farm_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Farm_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(ParamData%WT_Position)) THEN - DEALLOCATE(ParamData%WT_Position) -ENDIF -IF (ALLOCATED(ParamData%WT_FASTInFile)) THEN - DEALLOCATE(ParamData%WT_FASTInFile) -ENDIF -IF (ALLOCATED(ParamData%OutRadii)) THEN - DEALLOCATE(ParamData%OutRadii) -ENDIF -IF (ALLOCATED(ParamData%OutDist)) THEN - DEALLOCATE(ParamData%OutDist) -ENDIF -IF (ALLOCATED(ParamData%WindVelX)) THEN - DEALLOCATE(ParamData%WindVelX) -ENDIF -IF (ALLOCATED(ParamData%WindVelY)) THEN - DEALLOCATE(ParamData%WindVelY) -ENDIF -IF (ALLOCATED(ParamData%WindVelZ)) THEN - DEALLOCATE(ParamData%WindVelZ) -ENDIF -IF (ALLOCATED(ParamData%OutParam)) THEN -DO i1 = LBOUND(ParamData%OutParam,1), UBOUND(ParamData%OutParam,1) - CALL NWTC_Library_Destroyoutparmtype( ParamData%OutParam(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ParamData%OutParam) -ENDIF -DO i1 = LBOUND(ParamData%Module_Ver,1), UBOUND(ParamData%Module_Ver,1) - CALL NWTC_Library_Destroyprogdesc( ParamData%Module_Ver(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - END SUBROUTINE Farm_DestroyParam - - SUBROUTINE Farm_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(Farm_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 = 'Farm_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 - Db_BufSz = Db_BufSz + 1 ! DT_high - Db_BufSz = Db_BufSz + 1 ! TMax - Int_BufSz = Int_BufSz + 1 ! n_high_low - Int_BufSz = Int_BufSz + 1 ! NumTurbines - Int_BufSz = Int_BufSz + 1*LEN(InData%WindFilePath) ! WindFilePath - Int_BufSz = Int_BufSz + 1*LEN(InData%SC_FileName) ! SC_FileName - Int_BufSz = Int_BufSz + 1 ! UseSC - Int_BufSz = Int_BufSz + 1 ! WT_Position allocated yes/no - IF ( ALLOCATED(InData%WT_Position) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! WT_Position upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WT_Position) ! WT_Position - END IF - Int_BufSz = Int_BufSz + 1 ! WaveFieldMod - Int_BufSz = Int_BufSz + 1 ! MooringMod - Int_BufSz = Int_BufSz + 1*LEN(InData%MD_FileName) ! MD_FileName - Db_BufSz = Db_BufSz + 1 ! DT_mooring - Int_BufSz = Int_BufSz + 1 ! n_mooring - Int_BufSz = Int_BufSz + 1 ! WT_FASTInFile allocated yes/no - IF ( ALLOCATED(InData%WT_FASTInFile) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WT_FASTInFile upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%WT_FASTInFile)*LEN(InData%WT_FASTInFile) ! WT_FASTInFile - END IF - Int_BufSz = Int_BufSz + 1*LEN(InData%FTitle) ! FTitle - Int_BufSz = Int_BufSz + 1*LEN(InData%OutFileRoot) ! OutFileRoot - Int_BufSz = Int_BufSz + 1 ! n_ChkptTime - Db_BufSz = Db_BufSz + 1 ! TStart - Int_BufSz = Int_BufSz + 1 ! n_TMax - Int_BufSz = Int_BufSz + 1 ! SumPrint - Int_BufSz = Int_BufSz + 1 ! WrBinOutFile - Int_BufSz = Int_BufSz + 1 ! WrTxtOutFile - 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%OutFmt_t) ! OutFmt_t - Int_BufSz = Int_BufSz + 1 ! FmtWidth - Int_BufSz = Int_BufSz + 1 ! TChanLen - Int_BufSz = Int_BufSz + 1 ! NOutTurb - Int_BufSz = Int_BufSz + 1 ! NOutRadii - Int_BufSz = Int_BufSz + 1 ! OutRadii allocated yes/no - IF ( ALLOCATED(InData%OutRadii) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OutRadii upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%OutRadii) ! OutRadii - END IF - Int_BufSz = Int_BufSz + 1 ! NOutDist - Int_BufSz = Int_BufSz + 1 ! OutDist allocated yes/no - IF ( ALLOCATED(InData%OutDist) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OutDist upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%OutDist) ! OutDist - END IF - Int_BufSz = Int_BufSz + 1 ! NWindVel - Int_BufSz = Int_BufSz + 1 ! WindVelX allocated yes/no - IF ( ALLOCATED(InData%WindVelX) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WindVelX upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WindVelX) ! WindVelX - END IF - Int_BufSz = Int_BufSz + 1 ! WindVelY allocated yes/no - IF ( ALLOCATED(InData%WindVelY) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WindVelY upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WindVelY) ! WindVelY - END IF - Int_BufSz = Int_BufSz + 1 ! WindVelZ allocated yes/no - IF ( ALLOCATED(InData%WindVelZ) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WindVelZ upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WindVelZ) ! WindVelZ - 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 - ! 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 ! NumOuts - Int_BufSz = Int_BufSz + 1 ! NOutSteps - Int_BufSz = Int_BufSz + SIZE(InData%FileDescLines)*LEN(InData%FileDescLines) ! FileDescLines - DO i1 = LBOUND(InData%Module_Ver,1), UBOUND(InData%Module_Ver,1) - Int_BufSz = Int_BufSz + 3 ! Module_Ver: size of buffers for each call to pack subtype - CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Module_Ver(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Module_Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Module_Ver - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Module_Ver - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Module_Ver - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - Int_BufSz = Int_BufSz + 1 ! UnOu - Re_BufSz = Re_BufSz + 1 ! dX_low - Re_BufSz = Re_BufSz + 1 ! dY_low - Re_BufSz = Re_BufSz + 1 ! dZ_low - Int_BufSz = Int_BufSz + 1 ! nX_low - Int_BufSz = Int_BufSz + 1 ! nY_low - Int_BufSz = Int_BufSz + 1 ! nZ_low - Re_BufSz = Re_BufSz + 1 ! X0_low - Re_BufSz = Re_BufSz + 1 ! Y0_low - Re_BufSz = Re_BufSz + 1 ! Z0_low - 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 - DbKiBuf(Db_Xferred) = InData%DT_high - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%TMax - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%n_high_low - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumTurbines - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%WindFilePath) - IntKiBuf(Int_Xferred) = ICHAR(InData%WindFilePath(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%SC_FileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%SC_FileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = TRANSFER(InData%UseSC, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%WT_Position) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WT_Position,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WT_Position,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WT_Position,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WT_Position,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%WT_Position,2), UBOUND(InData%WT_Position,2) - DO i1 = LBOUND(InData%WT_Position,1), UBOUND(InData%WT_Position,1) - ReKiBuf(Re_Xferred) = InData%WT_Position(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%WaveFieldMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%MooringMod - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%MD_FileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%MD_FileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DbKiBuf(Db_Xferred) = InData%DT_mooring - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%n_mooring - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%WT_FASTInFile) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WT_FASTInFile,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WT_FASTInFile,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WT_FASTInFile,1), UBOUND(InData%WT_FASTInFile,1) - DO I = 1, LEN(InData%WT_FASTInFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%WT_FASTInFile(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - DO I = 1, LEN(InData%FTitle) - IntKiBuf(Int_Xferred) = ICHAR(InData%FTitle(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%OutFileRoot) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutFileRoot(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = InData%n_ChkptTime - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%TStart - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%n_TMax - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%SumPrint, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%WrBinOutFile, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%WrTxtOutFile, IntKiBuf(1)) - 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%OutFmt_t) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt_t(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = InData%FmtWidth - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%TChanLen - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NOutTurb - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NOutRadii - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%OutRadii) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OutRadii,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutRadii,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%OutRadii,1), UBOUND(InData%OutRadii,1) - IntKiBuf(Int_Xferred) = InData%OutRadii(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NOutDist - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%OutDist) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OutDist,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutDist,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%OutDist,1), UBOUND(InData%OutDist,1) - ReKiBuf(Re_Xferred) = InData%OutDist(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NWindVel - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%WindVelX) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WindVelX,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WindVelX,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WindVelX,1), UBOUND(InData%WindVelX,1) - ReKiBuf(Re_Xferred) = InData%WindVelX(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WindVelY) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WindVelY,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WindVelY,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WindVelY,1), UBOUND(InData%WindVelY,1) - ReKiBuf(Re_Xferred) = InData%WindVelY(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WindVelZ) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WindVelZ,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WindVelZ,1) - Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WindVelZ,1), UBOUND(InData%WindVelZ,1) - ReKiBuf(Re_Xferred) = InData%WindVelZ(i1) - Re_Xferred = Re_Xferred + 1 - 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) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NOutSteps - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%FileDescLines,1), UBOUND(InData%FileDescLines,1) - DO I = 1, LEN(InData%FileDescLines) - IntKiBuf(Int_Xferred) = ICHAR(InData%FileDescLines(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - DO i1 = LBOUND(InData%Module_Ver,1), UBOUND(InData%Module_Ver,1) - CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Module_Ver(i1), ErrStat2, ErrMsg2, OnlySize ) ! Module_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 DO - IntKiBuf(Int_Xferred) = InData%UnOu - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%dX_low - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%dY_low - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%dZ_low - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nX_low - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nY_low - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nZ_low - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%X0_low - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Y0_low - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Z0_low - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Farm_PackParam - - SUBROUTINE Farm_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(Farm_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 = 'Farm_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%DT_high = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%TMax = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%n_high_low = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumTurbines = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%WindFilePath) - OutData%WindFilePath(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%SC_FileName) - OutData%SC_FileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%UseSC = TRANSFER(IntKiBuf(Int_Xferred), OutData%UseSC) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WT_Position not allocated - Int_Xferred = Int_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%WT_Position)) DEALLOCATE(OutData%WT_Position) - ALLOCATE(OutData%WT_Position(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WT_Position.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%WT_Position,2), UBOUND(OutData%WT_Position,2) - DO i1 = LBOUND(OutData%WT_Position,1), UBOUND(OutData%WT_Position,1) - OutData%WT_Position(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%WaveFieldMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%MooringMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%MD_FileName) - OutData%MD_FileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%DT_mooring = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%n_mooring = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WT_FASTInFile not allocated - Int_Xferred = Int_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%WT_FASTInFile)) DEALLOCATE(OutData%WT_FASTInFile) - ALLOCATE(OutData%WT_FASTInFile(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WT_FASTInFile.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WT_FASTInFile,1), UBOUND(OutData%WT_FASTInFile,1) - DO I = 1, LEN(OutData%WT_FASTInFile) - OutData%WT_FASTInFile(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - DO I = 1, LEN(OutData%FTitle) - OutData%FTitle(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%OutFileRoot) - OutData%OutFileRoot(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%n_ChkptTime = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TStart = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%n_TMax = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%SumPrint = TRANSFER(IntKiBuf(Int_Xferred), OutData%SumPrint) - Int_Xferred = Int_Xferred + 1 - OutData%WrBinOutFile = TRANSFER(IntKiBuf(Int_Xferred), OutData%WrBinOutFile) - Int_Xferred = Int_Xferred + 1 - OutData%WrTxtOutFile = TRANSFER(IntKiBuf(Int_Xferred), OutData%WrTxtOutFile) - 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%OutFmt_t) - OutData%OutFmt_t(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%FmtWidth = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TChanLen = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NOutTurb = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NOutRadii = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutRadii not allocated - Int_Xferred = Int_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%OutRadii)) DEALLOCATE(OutData%OutRadii) - ALLOCATE(OutData%OutRadii(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutRadii.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%OutRadii,1), UBOUND(OutData%OutRadii,1) - OutData%OutRadii(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - OutData%NOutDist = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutDist not allocated - Int_Xferred = Int_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%OutDist)) DEALLOCATE(OutData%OutDist) - ALLOCATE(OutData%OutDist(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutDist.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%OutDist,1), UBOUND(OutData%OutDist,1) - OutData%OutDist(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%NWindVel = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WindVelX not allocated - Int_Xferred = Int_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%WindVelX)) DEALLOCATE(OutData%WindVelX) - ALLOCATE(OutData%WindVelX(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WindVelX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WindVelX,1), UBOUND(OutData%WindVelX,1) - OutData%WindVelX(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WindVelY not allocated - Int_Xferred = Int_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%WindVelY)) DEALLOCATE(OutData%WindVelY) - ALLOCATE(OutData%WindVelY(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WindVelY.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WindVelY,1), UBOUND(OutData%WindVelY,1) - OutData%WindVelY(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WindVelZ not allocated - Int_Xferred = Int_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%WindVelZ)) DEALLOCATE(OutData%WindVelZ) - ALLOCATE(OutData%WindVelZ(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WindVelZ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WindVelZ,1), UBOUND(OutData%WindVelZ,1) - OutData%WindVelZ(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - 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%NumOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NOutSteps = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%FileDescLines,1) - i1_u = UBOUND(OutData%FileDescLines,1) - DO i1 = LBOUND(OutData%FileDescLines,1), UBOUND(OutData%FileDescLines,1) - DO I = 1, LEN(OutData%FileDescLines) - OutData%FileDescLines(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - i1_l = LBOUND(OutData%Module_Ver,1) - i1_u = UBOUND(OutData%Module_Ver,1) - DO i1 = LBOUND(OutData%Module_Ver,1), UBOUND(OutData%Module_Ver,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%Module_Ver(i1), ErrStat2, ErrMsg2 ) ! Module_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 DO - OutData%UnOu = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%dX_low = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%dY_low = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%dZ_low = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%nX_low = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nY_low = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nZ_low = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%X0_low = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Y0_low = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Z0_low = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Farm_UnPackParam - - SUBROUTINE Farm_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Farm_MiscVarType), INTENT(INOUT) :: SrcMiscData - TYPE(Farm_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 = 'Farm_CopyMisc' -! +subroutine Farm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(Farm_ParameterType), intent(in) :: SrcParamData + type(Farm_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Farm_CopyParam' ErrStat = ErrID_None - ErrMsg = "" -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 -IF (ALLOCATED(SrcMiscData%TimeData)) THEN - i1_l = LBOUND(SrcMiscData%TimeData,1) - i1_u = UBOUND(SrcMiscData%TimeData,1) - IF (.NOT. ALLOCATED(DstMiscData%TimeData)) THEN - ALLOCATE(DstMiscData%TimeData(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%TimeData.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%TimeData = SrcMiscData%TimeData -ENDIF -IF (ALLOCATED(SrcMiscData%AllOutData)) THEN - i1_l = LBOUND(SrcMiscData%AllOutData,1) - i1_u = UBOUND(SrcMiscData%AllOutData,1) - i2_l = LBOUND(SrcMiscData%AllOutData,2) - i2_u = UBOUND(SrcMiscData%AllOutData,2) - IF (.NOT. ALLOCATED(DstMiscData%AllOutData)) THEN - ALLOCATE(DstMiscData%AllOutData(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%AllOutData.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%AllOutData = SrcMiscData%AllOutData -ENDIF - DstMiscData%n_Out = SrcMiscData%n_Out -IF (ALLOCATED(SrcMiscData%FWrap_2_MD)) THEN - i1_l = LBOUND(SrcMiscData%FWrap_2_MD,1) - i1_u = UBOUND(SrcMiscData%FWrap_2_MD,1) - IF (.NOT. ALLOCATED(DstMiscData%FWrap_2_MD)) THEN - ALLOCATE(DstMiscData%FWrap_2_MD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FWrap_2_MD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%FWrap_2_MD,1), UBOUND(SrcMiscData%FWrap_2_MD,1) - CALL NWTC_Library_Copymeshmaptype( SrcMiscData%FWrap_2_MD(i1), DstMiscData%FWrap_2_MD(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcMiscData%MD_2_FWrap)) THEN - i1_l = LBOUND(SrcMiscData%MD_2_FWrap,1) - i1_u = UBOUND(SrcMiscData%MD_2_FWrap,1) - IF (.NOT. ALLOCATED(DstMiscData%MD_2_FWrap)) THEN - ALLOCATE(DstMiscData%MD_2_FWrap(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%MD_2_FWrap.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%MD_2_FWrap,1), UBOUND(SrcMiscData%MD_2_FWrap,1) - CALL NWTC_Library_Copymeshmaptype( SrcMiscData%MD_2_FWrap(i1), DstMiscData%MD_2_FWrap(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - END SUBROUTINE Farm_CopyMisc - - SUBROUTINE Farm_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(Farm_MiscVarType), INTENT(INOUT) :: MiscData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Farm_DestroyMisc' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(MiscData%AllOuts)) THEN - DEALLOCATE(MiscData%AllOuts) -ENDIF -IF (ALLOCATED(MiscData%TimeData)) THEN - DEALLOCATE(MiscData%TimeData) -ENDIF -IF (ALLOCATED(MiscData%AllOutData)) THEN - DEALLOCATE(MiscData%AllOutData) -ENDIF -IF (ALLOCATED(MiscData%FWrap_2_MD)) THEN -DO i1 = LBOUND(MiscData%FWrap_2_MD,1), UBOUND(MiscData%FWrap_2_MD,1) - CALL NWTC_Library_Destroymeshmaptype( MiscData%FWrap_2_MD(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MiscData%FWrap_2_MD) -ENDIF -IF (ALLOCATED(MiscData%MD_2_FWrap)) THEN -DO i1 = LBOUND(MiscData%MD_2_FWrap,1), UBOUND(MiscData%MD_2_FWrap,1) - CALL NWTC_Library_Destroymeshmaptype( MiscData%MD_2_FWrap(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MiscData%MD_2_FWrap) -ENDIF - END SUBROUTINE Farm_DestroyMisc - - SUBROUTINE Farm_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(Farm_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 = 'Farm_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 ! 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 - Int_BufSz = Int_BufSz + 1 ! TimeData allocated yes/no - IF ( ALLOCATED(InData%TimeData) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TimeData upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%TimeData) ! TimeData - END IF - Int_BufSz = Int_BufSz + 1 ! AllOutData allocated yes/no - IF ( ALLOCATED(InData%AllOutData) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! AllOutData upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AllOutData) ! AllOutData - END IF - Int_BufSz = Int_BufSz + 1 ! n_Out - Int_BufSz = Int_BufSz + 1 ! FWrap_2_MD allocated yes/no - IF ( ALLOCATED(InData%FWrap_2_MD) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! FWrap_2_MD upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%FWrap_2_MD,1), UBOUND(InData%FWrap_2_MD,1) - Int_BufSz = Int_BufSz + 3 ! FWrap_2_MD: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%FWrap_2_MD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! FWrap_2_MD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! FWrap_2_MD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! FWrap_2_MD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! FWrap_2_MD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! MD_2_FWrap allocated yes/no - IF ( ALLOCATED(InData%MD_2_FWrap) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! MD_2_FWrap upper/lower bounds for each dimension - DO i1 = LBOUND(InData%MD_2_FWrap,1), UBOUND(InData%MD_2_FWrap,1) - Int_BufSz = Int_BufSz + 3 ! MD_2_FWrap: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%MD_2_FWrap(i1), ErrStat2, ErrMsg2, .TRUE. ) ! MD_2_FWrap - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! MD_2_FWrap - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! MD_2_FWrap - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! MD_2_FWrap - 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%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 - IF ( .NOT. ALLOCATED(InData%TimeData) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TimeData,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TimeData,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TimeData,1), UBOUND(InData%TimeData,1) - DbKiBuf(Db_Xferred) = InData%TimeData(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AllOutData) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AllOutData,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AllOutData,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AllOutData,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AllOutData,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%AllOutData,2), UBOUND(InData%AllOutData,2) - DO i1 = LBOUND(InData%AllOutData,1), UBOUND(InData%AllOutData,1) - ReKiBuf(Re_Xferred) = InData%AllOutData(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%n_Out - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%FWrap_2_MD) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FWrap_2_MD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FWrap_2_MD,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%FWrap_2_MD,1), UBOUND(InData%FWrap_2_MD,1) - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%FWrap_2_MD(i1), ErrStat2, ErrMsg2, OnlySize ) ! FWrap_2_MD - 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%MD_2_FWrap) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MD_2_FWrap,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MD_2_FWrap,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%MD_2_FWrap,1), UBOUND(InData%MD_2_FWrap,1) - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%MD_2_FWrap(i1), ErrStat2, ErrMsg2, OnlySize ) ! MD_2_FWrap - 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 Farm_PackMisc - - SUBROUTINE Farm_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(Farm_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 = 'Farm_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 ! 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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TimeData not allocated - Int_Xferred = Int_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%TimeData)) DEALLOCATE(OutData%TimeData) - ALLOCATE(OutData%TimeData(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TimeData.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TimeData,1), UBOUND(OutData%TimeData,1) - OutData%TimeData(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AllOutData not allocated - Int_Xferred = Int_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%AllOutData)) DEALLOCATE(OutData%AllOutData) - ALLOCATE(OutData%AllOutData(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AllOutData.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%AllOutData,2), UBOUND(OutData%AllOutData,2) - DO i1 = LBOUND(OutData%AllOutData,1), UBOUND(OutData%AllOutData,1) - OutData%AllOutData(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%n_Out = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FWrap_2_MD not allocated - Int_Xferred = Int_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%FWrap_2_MD)) DEALLOCATE(OutData%FWrap_2_MD) - ALLOCATE(OutData%FWrap_2_MD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FWrap_2_MD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%FWrap_2_MD,1), UBOUND(OutData%FWrap_2_MD,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%FWrap_2_MD(i1), ErrStat2, ErrMsg2 ) ! FWrap_2_MD - 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 ! MD_2_FWrap not allocated - Int_Xferred = Int_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%MD_2_FWrap)) DEALLOCATE(OutData%MD_2_FWrap) - ALLOCATE(OutData%MD_2_FWrap(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MD_2_FWrap.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%MD_2_FWrap,1), UBOUND(OutData%MD_2_FWrap,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%MD_2_FWrap(i1), ErrStat2, ErrMsg2 ) ! MD_2_FWrap - 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 Farm_UnPackMisc - - SUBROUTINE Farm_CopyFASTWrapper_Data( SrcFASTWrapper_DataData, DstFASTWrapper_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FASTWrapper_Data), INTENT(INOUT) :: SrcFASTWrapper_DataData - TYPE(FASTWrapper_Data), INTENT(INOUT) :: DstFASTWrapper_DataData - 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 = 'Farm_CopyFASTWrapper_Data' -! + ErrMsg = '' + DstParamData%DT_low = SrcParamData%DT_low + DstParamData%DT_high = SrcParamData%DT_high + DstParamData%TMax = SrcParamData%TMax + DstParamData%n_high_low = SrcParamData%n_high_low + DstParamData%NumTurbines = SrcParamData%NumTurbines + DstParamData%WindFilePath = SrcParamData%WindFilePath + DstParamData%SC_FileName = SrcParamData%SC_FileName + DstParamData%UseSC = SrcParamData%UseSC + if (allocated(SrcParamData%WT_Position)) then + LB(1:2) = lbound(SrcParamData%WT_Position) + UB(1:2) = ubound(SrcParamData%WT_Position) + if (.not. allocated(DstParamData%WT_Position)) then + allocate(DstParamData%WT_Position(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WT_Position.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%WT_Position = SrcParamData%WT_Position + end if + DstParamData%WaveFieldMod = SrcParamData%WaveFieldMod + DstParamData%MooringMod = SrcParamData%MooringMod + DstParamData%WrMooringVis = SrcParamData%WrMooringVis + DstParamData%MD_FileName = SrcParamData%MD_FileName + DstParamData%DT_mooring = SrcParamData%DT_mooring + DstParamData%n_mooring = SrcParamData%n_mooring + if (allocated(SrcParamData%WT_FASTInFile)) then + LB(1:1) = lbound(SrcParamData%WT_FASTInFile) + UB(1:1) = ubound(SrcParamData%WT_FASTInFile) + if (.not. allocated(DstParamData%WT_FASTInFile)) then + allocate(DstParamData%WT_FASTInFile(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WT_FASTInFile.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%WT_FASTInFile = SrcParamData%WT_FASTInFile + end if + DstParamData%FTitle = SrcParamData%FTitle + DstParamData%OutFileRoot = SrcParamData%OutFileRoot + DstParamData%n_ChkptTime = SrcParamData%n_ChkptTime + DstParamData%TStart = SrcParamData%TStart + DstParamData%n_TMax = SrcParamData%n_TMax + DstParamData%RotorDiamRef = SrcParamData%RotorDiamRef + DstParamData%SumPrint = SrcParamData%SumPrint + DstParamData%WrBinOutFile = SrcParamData%WrBinOutFile + DstParamData%WrTxtOutFile = SrcParamData%WrTxtOutFile + DstParamData%Delim = SrcParamData%Delim + DstParamData%OutFmt = SrcParamData%OutFmt + DstParamData%OutFmt_t = SrcParamData%OutFmt_t + DstParamData%FmtWidth = SrcParamData%FmtWidth + DstParamData%TChanLen = SrcParamData%TChanLen + DstParamData%NOutTurb = SrcParamData%NOutTurb + DstParamData%NOutRadii = SrcParamData%NOutRadii + if (allocated(SrcParamData%OutRadii)) then + LB(1:1) = lbound(SrcParamData%OutRadii) + UB(1:1) = ubound(SrcParamData%OutRadii) + if (.not. allocated(DstParamData%OutRadii)) then + allocate(DstParamData%OutRadii(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutRadii.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%OutRadii = SrcParamData%OutRadii + end if + DstParamData%NOutDist = SrcParamData%NOutDist + if (allocated(SrcParamData%OutDist)) then + LB(1:1) = lbound(SrcParamData%OutDist) + UB(1:1) = ubound(SrcParamData%OutDist) + if (.not. allocated(DstParamData%OutDist)) then + allocate(DstParamData%OutDist(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutDist.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%OutDist = SrcParamData%OutDist + end if + DstParamData%NWindVel = SrcParamData%NWindVel + if (allocated(SrcParamData%WindVelX)) then + LB(1:1) = lbound(SrcParamData%WindVelX) + UB(1:1) = ubound(SrcParamData%WindVelX) + if (.not. allocated(DstParamData%WindVelX)) then + allocate(DstParamData%WindVelX(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WindVelX.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%WindVelX = SrcParamData%WindVelX + end if + if (allocated(SrcParamData%WindVelY)) then + LB(1:1) = lbound(SrcParamData%WindVelY) + UB(1:1) = ubound(SrcParamData%WindVelY) + if (.not. allocated(DstParamData%WindVelY)) then + allocate(DstParamData%WindVelY(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WindVelY.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%WindVelY = SrcParamData%WindVelY + end if + if (allocated(SrcParamData%WindVelZ)) then + LB(1:1) = lbound(SrcParamData%WindVelZ) + UB(1:1) = ubound(SrcParamData%WindVelZ) + if (.not. allocated(DstParamData%WindVelZ)) then + allocate(DstParamData%WindVelZ(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WindVelZ.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%WindVelZ = SrcParamData%WindVelZ + end if + if (allocated(SrcParamData%OutParam)) then + LB(1:1) = lbound(SrcParamData%OutParam) + UB(1:1) = ubound(SrcParamData%OutParam) + if (.not. allocated(DstParamData%OutParam)) then + allocate(DstParamData%OutParam(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutParam.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyOutParmType(SrcParamData%OutParam(i1), DstParamData%OutParam(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + DstParamData%NumOuts = SrcParamData%NumOuts + DstParamData%NOutSteps = SrcParamData%NOutSteps + DstParamData%FileDescLines = SrcParamData%FileDescLines + LB(1:1) = lbound(SrcParamData%Module_Ver) + UB(1:1) = ubound(SrcParamData%Module_Ver) + do i1 = LB(1), UB(1) + call NWTC_Library_CopyProgDesc(SrcParamData%Module_Ver(i1), DstParamData%Module_Ver(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + DstParamData%UnOu = SrcParamData%UnOu + DstParamData%dX_low = SrcParamData%dX_low + DstParamData%dY_low = SrcParamData%dY_low + DstParamData%dZ_low = SrcParamData%dZ_low + DstParamData%nX_low = SrcParamData%nX_low + DstParamData%nY_low = SrcParamData%nY_low + DstParamData%nZ_low = SrcParamData%nZ_low + DstParamData%X0_low = SrcParamData%X0_low + DstParamData%Y0_low = SrcParamData%Y0_low + DstParamData%Z0_low = SrcParamData%Z0_low + DstParamData%WAT = SrcParamData%WAT + DstParamData%WAT_BoxFile = SrcParamData%WAT_BoxFile + DstParamData%WAT_NxNyNz = SrcParamData%WAT_NxNyNz + DstParamData%WAT_DxDyDz = SrcParamData%WAT_DxDyDz + DstParamData%WAT_ScaleBox = SrcParamData%WAT_ScaleBox +end subroutine + +subroutine Farm_DestroyParam(ParamData, ErrStat, ErrMsg) + type(Farm_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Farm_DestroyParam' ErrStat = ErrID_None - ErrMsg = "" - CALL FWrap_CopyContState( SrcFASTWrapper_DataData%x, DstFASTWrapper_DataData%x, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL FWrap_CopyDiscState( SrcFASTWrapper_DataData%xd, DstFASTWrapper_DataData%xd, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL FWrap_CopyConstrState( SrcFASTWrapper_DataData%z, DstFASTWrapper_DataData%z, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL FWrap_CopyOtherState( SrcFASTWrapper_DataData%OtherSt, DstFASTWrapper_DataData%OtherSt, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL FWrap_CopyParam( SrcFASTWrapper_DataData%p, DstFASTWrapper_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL FWrap_CopyInput( SrcFASTWrapper_DataData%u, DstFASTWrapper_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL FWrap_CopyOutput( SrcFASTWrapper_DataData%y, DstFASTWrapper_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL FWrap_CopyMisc( SrcFASTWrapper_DataData%m, DstFASTWrapper_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstFASTWrapper_DataData%IsInitialized = SrcFASTWrapper_DataData%IsInitialized - END SUBROUTINE Farm_CopyFASTWrapper_Data - - SUBROUTINE Farm_DestroyFASTWrapper_Data( FASTWrapper_DataData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(FASTWrapper_Data), INTENT(INOUT) :: FASTWrapper_DataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Farm_DestroyFASTWrapper_Data' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL FWrap_DestroyContState( FASTWrapper_DataData%x, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FWrap_DestroyDiscState( FASTWrapper_DataData%xd, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FWrap_DestroyConstrState( FASTWrapper_DataData%z, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FWrap_DestroyOtherState( FASTWrapper_DataData%OtherSt, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FWrap_DestroyParam( FASTWrapper_DataData%p, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FWrap_DestroyInput( FASTWrapper_DataData%u, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FWrap_DestroyOutput( FASTWrapper_DataData%y, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FWrap_DestroyMisc( FASTWrapper_DataData%m, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE Farm_DestroyFASTWrapper_Data - - SUBROUTINE Farm_PackFASTWrapper_Data( 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(FASTWrapper_Data), 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 = 'Farm_PackFASTWrapper_Data' - ! 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 ! x: size of buffers for each call to pack subtype - CALL FWrap_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x, ErrStat2, ErrMsg2, .TRUE. ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype - CALL FWrap_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd, ErrStat2, ErrMsg2, .TRUE. ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xd - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype - CALL FWrap_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z, ErrStat2, ErrMsg2, .TRUE. ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! z - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! z - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! z - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! OtherSt: size of buffers for each call to pack subtype - CALL FWrap_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt, ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype - CALL FWrap_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! p - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! p - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! p - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype - CALL FWrap_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype - CALL FWrap_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype - CALL FWrap_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! m - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! m - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! m - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! IsInitialized - 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 FWrap_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x, ErrStat2, ErrMsg2, OnlySize ) ! x - 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 FWrap_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd, ErrStat2, ErrMsg2, OnlySize ) ! xd - 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 FWrap_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z, ErrStat2, ErrMsg2, OnlySize ) ! z - 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 FWrap_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt, ErrStat2, ErrMsg2, OnlySize ) ! OtherSt - 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 FWrap_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! p - 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 FWrap_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u - 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 FWrap_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y - 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 FWrap_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! m - 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%IsInitialized, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Farm_PackFASTWrapper_Data - - SUBROUTINE Farm_UnPackFASTWrapper_Data( 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(FASTWrapper_Data), 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 = 'Farm_UnPackFASTWrapper_Data' - ! 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 FWrap_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x, ErrStat2, ErrMsg2 ) ! x - 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 FWrap_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd, ErrStat2, ErrMsg2 ) ! xd - 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 FWrap_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z, ErrStat2, ErrMsg2 ) ! z - 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 FWrap_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt, ErrStat2, ErrMsg2 ) ! OtherSt - 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 FWrap_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p - 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 FWrap_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u - 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 FWrap_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y - 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 FWrap_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! m - 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%IsInitialized = TRANSFER(IntKiBuf(Int_Xferred), OutData%IsInitialized) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Farm_UnPackFASTWrapper_Data - - SUBROUTINE Farm_CopyWakeDynamics_Data( SrcWakeDynamics_DataData, DstWakeDynamics_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(WakeDynamics_Data), INTENT(IN) :: SrcWakeDynamics_DataData - TYPE(WakeDynamics_Data), INTENT(INOUT) :: DstWakeDynamics_DataData - 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 = 'Farm_CopyWakeDynamics_Data' -! + ErrMsg = '' + if (allocated(ParamData%WT_Position)) then + deallocate(ParamData%WT_Position) + end if + if (allocated(ParamData%WT_FASTInFile)) then + deallocate(ParamData%WT_FASTInFile) + end if + if (allocated(ParamData%OutRadii)) then + deallocate(ParamData%OutRadii) + end if + if (allocated(ParamData%OutDist)) then + deallocate(ParamData%OutDist) + end if + if (allocated(ParamData%WindVelX)) then + deallocate(ParamData%WindVelX) + end if + if (allocated(ParamData%WindVelY)) then + deallocate(ParamData%WindVelY) + end if + if (allocated(ParamData%WindVelZ)) then + deallocate(ParamData%WindVelZ) + end if + if (allocated(ParamData%OutParam)) then + LB(1:1) = lbound(ParamData%OutParam) + UB(1:1) = ubound(ParamData%OutParam) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyOutParmType(ParamData%OutParam(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%OutParam) + end if + LB(1:1) = lbound(ParamData%Module_Ver) + UB(1:1) = ubound(ParamData%Module_Ver) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyProgDesc(ParamData%Module_Ver(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do +end subroutine + +subroutine Farm_PackParam(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Farm_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Farm_PackParam' + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DT_low) + call RegPack(RF, InData%DT_high) + call RegPack(RF, InData%TMax) + call RegPack(RF, InData%n_high_low) + call RegPack(RF, InData%NumTurbines) + call RegPack(RF, InData%WindFilePath) + call RegPack(RF, InData%SC_FileName) + call RegPack(RF, InData%UseSC) + call RegPackAlloc(RF, InData%WT_Position) + call RegPack(RF, InData%WaveFieldMod) + call RegPack(RF, InData%MooringMod) + call RegPack(RF, InData%WrMooringVis) + call RegPack(RF, InData%MD_FileName) + call RegPack(RF, InData%DT_mooring) + call RegPack(RF, InData%n_mooring) + call RegPackAlloc(RF, InData%WT_FASTInFile) + call RegPack(RF, InData%FTitle) + call RegPack(RF, InData%OutFileRoot) + call RegPack(RF, InData%n_ChkptTime) + call RegPack(RF, InData%TStart) + call RegPack(RF, InData%n_TMax) + call RegPack(RF, InData%RotorDiamRef) + call RegPack(RF, InData%SumPrint) + call RegPack(RF, InData%WrBinOutFile) + call RegPack(RF, InData%WrTxtOutFile) + call RegPack(RF, InData%Delim) + call RegPack(RF, InData%OutFmt) + call RegPack(RF, InData%OutFmt_t) + call RegPack(RF, InData%FmtWidth) + call RegPack(RF, InData%TChanLen) + call RegPack(RF, InData%NOutTurb) + call RegPack(RF, InData%NOutRadii) + call RegPackAlloc(RF, InData%OutRadii) + call RegPack(RF, InData%NOutDist) + call RegPackAlloc(RF, InData%OutDist) + call RegPack(RF, InData%NWindVel) + call RegPackAlloc(RF, InData%WindVelX) + call RegPackAlloc(RF, InData%WindVelY) + call RegPackAlloc(RF, InData%WindVelZ) + call RegPack(RF, allocated(InData%OutParam)) + if (allocated(InData%OutParam)) then + call RegPackBounds(RF, 1, lbound(InData%OutParam), ubound(InData%OutParam)) + LB(1:1) = lbound(InData%OutParam) + UB(1:1) = ubound(InData%OutParam) + do i1 = LB(1), UB(1) + call NWTC_Library_PackOutParmType(RF, InData%OutParam(i1)) + end do + end if + call RegPack(RF, InData%NumOuts) + call RegPack(RF, InData%NOutSteps) + call RegPack(RF, InData%FileDescLines) + LB(1:1) = lbound(InData%Module_Ver) + UB(1:1) = ubound(InData%Module_Ver) + do i1 = LB(1), UB(1) + call NWTC_Library_PackProgDesc(RF, InData%Module_Ver(i1)) + end do + call RegPack(RF, InData%UnOu) + call RegPack(RF, InData%dX_low) + call RegPack(RF, InData%dY_low) + call RegPack(RF, InData%dZ_low) + call RegPack(RF, InData%nX_low) + call RegPack(RF, InData%nY_low) + call RegPack(RF, InData%nZ_low) + call RegPack(RF, InData%X0_low) + call RegPack(RF, InData%Y0_low) + call RegPack(RF, InData%Z0_low) + call RegPack(RF, InData%WAT) + call RegPack(RF, InData%WAT_BoxFile) + call RegPack(RF, InData%WAT_NxNyNz) + call RegPack(RF, InData%WAT_DxDyDz) + call RegPack(RF, InData%WAT_ScaleBox) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Farm_UnPackParam(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Farm_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Farm_UnPackParam' + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DT_low); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DT_high); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TMax); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%n_high_low); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumTurbines); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WindFilePath); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SC_FileName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UseSC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WT_Position); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WaveFieldMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MooringMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WrMooringVis); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MD_FileName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DT_mooring); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%n_mooring); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WT_FASTInFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FTitle); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutFileRoot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%n_ChkptTime); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TStart); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%n_TMax); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RotorDiamRef); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SumPrint); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WrBinOutFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WrTxtOutFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Delim); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutFmt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutFmt_t); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FmtWidth); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TChanLen); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NOutTurb); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NOutRadii); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%OutRadii); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NOutDist); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%OutDist); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NWindVel); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WindVelX); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WindVelY); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WindVelZ); if (RegCheckErr(RF, RoutineName)) return + if (allocated(OutData%OutParam)) deallocate(OutData%OutParam) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%OutParam(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackOutParmType(RF, OutData%OutParam(i1)) ! OutParam + end do + end if + call RegUnpack(RF, OutData%NumOuts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NOutSteps); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FileDescLines); if (RegCheckErr(RF, RoutineName)) return + LB(1:1) = lbound(OutData%Module_Ver) + UB(1:1) = ubound(OutData%Module_Ver) + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackProgDesc(RF, OutData%Module_Ver(i1)) ! Module_Ver + end do + call RegUnpack(RF, OutData%UnOu); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%dX_low); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%dY_low); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%dZ_low); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nX_low); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nY_low); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nZ_low); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%X0_low); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Y0_low); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Z0_low); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WAT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WAT_BoxFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WAT_NxNyNz); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WAT_DxDyDz); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WAT_ScaleBox); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Farm_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(Farm_MiscVarType), intent(inout) :: SrcMiscData + type(Farm_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Farm_CopyMisc' ErrStat = ErrID_None - ErrMsg = "" - CALL WD_CopyContState( SrcWakeDynamics_DataData%x, DstWakeDynamics_DataData%x, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL WD_CopyDiscState( SrcWakeDynamics_DataData%xd, DstWakeDynamics_DataData%xd, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL WD_CopyConstrState( SrcWakeDynamics_DataData%z, DstWakeDynamics_DataData%z, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL WD_CopyOtherState( SrcWakeDynamics_DataData%OtherSt, DstWakeDynamics_DataData%OtherSt, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL WD_CopyParam( SrcWakeDynamics_DataData%p, DstWakeDynamics_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL WD_CopyInput( SrcWakeDynamics_DataData%u, DstWakeDynamics_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL WD_CopyOutput( SrcWakeDynamics_DataData%y, DstWakeDynamics_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL WD_CopyMisc( SrcWakeDynamics_DataData%m, DstWakeDynamics_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstWakeDynamics_DataData%IsInitialized = SrcWakeDynamics_DataData%IsInitialized - END SUBROUTINE Farm_CopyWakeDynamics_Data - - SUBROUTINE Farm_DestroyWakeDynamics_Data( WakeDynamics_DataData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(WakeDynamics_Data), INTENT(INOUT) :: WakeDynamics_DataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Farm_DestroyWakeDynamics_Data' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL WD_DestroyContState( WakeDynamics_DataData%x, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL WD_DestroyDiscState( WakeDynamics_DataData%xd, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL WD_DestroyConstrState( WakeDynamics_DataData%z, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL WD_DestroyOtherState( WakeDynamics_DataData%OtherSt, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL WD_DestroyParam( WakeDynamics_DataData%p, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL WD_DestroyInput( WakeDynamics_DataData%u, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL WD_DestroyOutput( WakeDynamics_DataData%y, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL WD_DestroyMisc( WakeDynamics_DataData%m, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE Farm_DestroyWakeDynamics_Data - - SUBROUTINE Farm_PackWakeDynamics_Data( 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(WakeDynamics_Data), 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 = 'Farm_PackWakeDynamics_Data' - ! 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 ! x: size of buffers for each call to pack subtype - CALL WD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x, ErrStat2, ErrMsg2, .TRUE. ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype - CALL WD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd, ErrStat2, ErrMsg2, .TRUE. ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xd - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype - CALL WD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z, ErrStat2, ErrMsg2, .TRUE. ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! z - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! z - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! z - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! OtherSt: size of buffers for each call to pack subtype - CALL WD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt, ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype - CALL WD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! p - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! p - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! p - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype - CALL WD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype - CALL WD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype - CALL WD_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! m - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! m - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! m - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! IsInitialized - 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_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x, ErrStat2, ErrMsg2, OnlySize ) ! x - 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 WD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd, ErrStat2, ErrMsg2, OnlySize ) ! xd - 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 WD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z, ErrStat2, ErrMsg2, OnlySize ) ! z - 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 WD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt, ErrStat2, ErrMsg2, OnlySize ) ! OtherSt - 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 WD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! p - 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 WD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u - 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 WD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y - 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 WD_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! m - 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%IsInitialized, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Farm_PackWakeDynamics_Data - - SUBROUTINE Farm_UnPackWakeDynamics_Data( 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(WakeDynamics_Data), 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 = 'Farm_UnPackWakeDynamics_Data' - ! 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_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x, ErrStat2, ErrMsg2 ) ! x - 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 WD_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd, ErrStat2, ErrMsg2 ) ! xd - 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 WD_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z, ErrStat2, ErrMsg2 ) ! z - 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 WD_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt, ErrStat2, ErrMsg2 ) ! OtherSt - 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 WD_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p - 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 WD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u - 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 WD_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y - 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 WD_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! m - 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%IsInitialized = TRANSFER(IntKiBuf(Int_Xferred), OutData%IsInitialized) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Farm_UnPackWakeDynamics_Data - - SUBROUTINE Farm_CopyAWAE_Data( SrcAWAE_DataData, DstAWAE_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AWAE_Data), INTENT(IN) :: SrcAWAE_DataData - TYPE(AWAE_Data), INTENT(INOUT) :: DstAWAE_DataData - 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 = 'Farm_CopyAWAE_Data' -! + ErrMsg = '' + if (allocated(SrcMiscData%AllOuts)) then + LB(1:1) = lbound(SrcMiscData%AllOuts) + UB(1:1) = ubound(SrcMiscData%AllOuts) + if (.not. allocated(DstMiscData%AllOuts)) then + allocate(DstMiscData%AllOuts(LB(1):UB(1)), 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 + end if + if (allocated(SrcMiscData%TimeData)) then + LB(1:1) = lbound(SrcMiscData%TimeData) + UB(1:1) = ubound(SrcMiscData%TimeData) + if (.not. allocated(DstMiscData%TimeData)) then + allocate(DstMiscData%TimeData(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%TimeData.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%TimeData = SrcMiscData%TimeData + end if + if (allocated(SrcMiscData%AllOutData)) then + LB(1:2) = lbound(SrcMiscData%AllOutData) + UB(1:2) = ubound(SrcMiscData%AllOutData) + if (.not. allocated(DstMiscData%AllOutData)) then + allocate(DstMiscData%AllOutData(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%AllOutData.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%AllOutData = SrcMiscData%AllOutData + end if + DstMiscData%n_Out = SrcMiscData%n_Out + if (allocated(SrcMiscData%FWrap_2_MD)) then + LB(1:1) = lbound(SrcMiscData%FWrap_2_MD) + UB(1:1) = ubound(SrcMiscData%FWrap_2_MD) + if (.not. allocated(DstMiscData%FWrap_2_MD)) then + allocate(DstMiscData%FWrap_2_MD(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FWrap_2_MD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcMiscData%FWrap_2_MD(i1), DstMiscData%FWrap_2_MD(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcMiscData%MD_2_FWrap)) then + LB(1:1) = lbound(SrcMiscData%MD_2_FWrap) + UB(1:1) = ubound(SrcMiscData%MD_2_FWrap) + if (.not. allocated(DstMiscData%MD_2_FWrap)) then + allocate(DstMiscData%MD_2_FWrap(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%MD_2_FWrap.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcMiscData%MD_2_FWrap(i1), DstMiscData%MD_2_FWrap(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if +end subroutine + +subroutine Farm_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(Farm_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Farm_DestroyMisc' ErrStat = ErrID_None - ErrMsg = "" - CALL AWAE_CopyContState( SrcAWAE_DataData%x, DstAWAE_DataData%x, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AWAE_CopyDiscState( SrcAWAE_DataData%xd, DstAWAE_DataData%xd, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AWAE_CopyConstrState( SrcAWAE_DataData%z, DstAWAE_DataData%z, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AWAE_CopyOtherState( SrcAWAE_DataData%OtherSt, DstAWAE_DataData%OtherSt, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AWAE_CopyParam( SrcAWAE_DataData%p, DstAWAE_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AWAE_CopyInput( SrcAWAE_DataData%u, DstAWAE_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AWAE_CopyOutput( SrcAWAE_DataData%y, DstAWAE_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AWAE_CopyMisc( SrcAWAE_DataData%m, DstAWAE_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstAWAE_DataData%IsInitialized = SrcAWAE_DataData%IsInitialized - END SUBROUTINE Farm_CopyAWAE_Data - - SUBROUTINE Farm_DestroyAWAE_Data( AWAE_DataData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(AWAE_Data), INTENT(INOUT) :: AWAE_DataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Farm_DestroyAWAE_Data' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL AWAE_DestroyContState( AWAE_DataData%x, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AWAE_DestroyDiscState( AWAE_DataData%xd, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AWAE_DestroyConstrState( AWAE_DataData%z, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AWAE_DestroyOtherState( AWAE_DataData%OtherSt, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AWAE_DestroyParam( AWAE_DataData%p, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AWAE_DestroyInput( AWAE_DataData%u, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AWAE_DestroyOutput( AWAE_DataData%y, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AWAE_DestroyMisc( AWAE_DataData%m, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE Farm_DestroyAWAE_Data - - SUBROUTINE Farm_PackAWAE_Data( 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(AWAE_Data), 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 = 'Farm_PackAWAE_Data' - ! 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 ! x: size of buffers for each call to pack subtype - CALL AWAE_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x, ErrStat2, ErrMsg2, .TRUE. ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype - CALL AWAE_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd, ErrStat2, ErrMsg2, .TRUE. ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xd - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype - CALL AWAE_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z, ErrStat2, ErrMsg2, .TRUE. ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! z - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! z - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! z - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! OtherSt: size of buffers for each call to pack subtype - CALL AWAE_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt, ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype - CALL AWAE_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! p - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! p - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! p - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype - CALL AWAE_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype - CALL AWAE_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype - CALL AWAE_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! m - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! m - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! m - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! IsInitialized - 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 AWAE_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x, ErrStat2, ErrMsg2, OnlySize ) ! x - 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 AWAE_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd, ErrStat2, ErrMsg2, OnlySize ) ! xd - 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 AWAE_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z, ErrStat2, ErrMsg2, OnlySize ) ! z - 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 AWAE_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt, ErrStat2, ErrMsg2, OnlySize ) ! OtherSt - 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 AWAE_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! p - 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 AWAE_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u - 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 AWAE_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y - 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 AWAE_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! m - 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%IsInitialized, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Farm_PackAWAE_Data - - SUBROUTINE Farm_UnPackAWAE_Data( 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(AWAE_Data), 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 = 'Farm_UnPackAWAE_Data' - ! 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 AWAE_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x, ErrStat2, ErrMsg2 ) ! x - 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 AWAE_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd, ErrStat2, ErrMsg2 ) ! xd - 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 AWAE_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z, ErrStat2, ErrMsg2 ) ! z - 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 AWAE_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt, ErrStat2, ErrMsg2 ) ! OtherSt - 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 AWAE_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p - 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 AWAE_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u - 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 AWAE_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y - 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 AWAE_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! m - 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%IsInitialized = TRANSFER(IntKiBuf(Int_Xferred), OutData%IsInitialized) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Farm_UnPackAWAE_Data - - SUBROUTINE Farm_CopySC_Data( SrcSC_DataData, DstSC_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SC_Data), INTENT(IN) :: SrcSC_DataData - TYPE(SC_Data), INTENT(INOUT) :: DstSC_DataData - 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 = 'Farm_CopySC_Data' -! + ErrMsg = '' + if (allocated(MiscData%AllOuts)) then + deallocate(MiscData%AllOuts) + end if + if (allocated(MiscData%TimeData)) then + deallocate(MiscData%TimeData) + end if + if (allocated(MiscData%AllOutData)) then + deallocate(MiscData%AllOutData) + end if + if (allocated(MiscData%FWrap_2_MD)) then + LB(1:1) = lbound(MiscData%FWrap_2_MD) + UB(1:1) = ubound(MiscData%FWrap_2_MD) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(MiscData%FWrap_2_MD(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%FWrap_2_MD) + end if + if (allocated(MiscData%MD_2_FWrap)) then + LB(1:1) = lbound(MiscData%MD_2_FWrap) + UB(1:1) = ubound(MiscData%MD_2_FWrap) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(MiscData%MD_2_FWrap(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%MD_2_FWrap) + end if +end subroutine + +subroutine Farm_PackMisc(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Farm_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Farm_PackMisc' + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%AllOuts) + call RegPackAlloc(RF, InData%TimeData) + call RegPackAlloc(RF, InData%AllOutData) + call RegPack(RF, InData%n_Out) + call RegPack(RF, allocated(InData%FWrap_2_MD)) + if (allocated(InData%FWrap_2_MD)) then + call RegPackBounds(RF, 1, lbound(InData%FWrap_2_MD), ubound(InData%FWrap_2_MD)) + LB(1:1) = lbound(InData%FWrap_2_MD) + UB(1:1) = ubound(InData%FWrap_2_MD) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(RF, InData%FWrap_2_MD(i1)) + end do + end if + call RegPack(RF, allocated(InData%MD_2_FWrap)) + if (allocated(InData%MD_2_FWrap)) then + call RegPackBounds(RF, 1, lbound(InData%MD_2_FWrap), ubound(InData%MD_2_FWrap)) + LB(1:1) = lbound(InData%MD_2_FWrap) + UB(1:1) = ubound(InData%MD_2_FWrap) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(RF, InData%MD_2_FWrap(i1)) + end do + end if + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Farm_UnPackMisc(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Farm_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Farm_UnPackMisc' + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%AllOuts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TimeData); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AllOutData); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%n_Out); if (RegCheckErr(RF, RoutineName)) return + if (allocated(OutData%FWrap_2_MD)) deallocate(OutData%FWrap_2_MD) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%FWrap_2_MD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FWrap_2_MD.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(RF, OutData%FWrap_2_MD(i1)) ! FWrap_2_MD + end do + end if + if (allocated(OutData%MD_2_FWrap)) deallocate(OutData%MD_2_FWrap) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%MD_2_FWrap(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MD_2_FWrap.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(RF, OutData%MD_2_FWrap(i1)) ! MD_2_FWrap + end do + end if +end subroutine + +subroutine Farm_CopyFASTWrapper_Data(SrcFASTWrapper_DataData, DstFASTWrapper_DataData, CtrlCode, ErrStat, ErrMsg) + type(FASTWrapper_Data), intent(inout) :: SrcFASTWrapper_DataData + type(FASTWrapper_Data), intent(inout) :: DstFASTWrapper_DataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Farm_CopyFASTWrapper_Data' ErrStat = ErrID_None - ErrMsg = "" - CALL SC_CopyContState( SrcSC_DataData%x, DstSC_DataData%x, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SC_CopyDiscState( SrcSC_DataData%xd, DstSC_DataData%xd, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SC_CopyConstrState( SrcSC_DataData%z, DstSC_DataData%z, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SC_CopyOtherState( SrcSC_DataData%OtherState, DstSC_DataData%OtherState, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SC_CopyParam( SrcSC_DataData%p, DstSC_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SC_CopyInput( SrcSC_DataData%uInputs, DstSC_DataData%uInputs, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstSC_DataData%utimes = SrcSC_DataData%utimes - CALL SC_CopyOutput( SrcSC_DataData%y, DstSC_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SC_CopyMisc( SrcSC_DataData%m, DstSC_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstSC_DataData%IsInitialized = SrcSC_DataData%IsInitialized - END SUBROUTINE Farm_CopySC_Data - - SUBROUTINE Farm_DestroySC_Data( SC_DataData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(SC_Data), INTENT(INOUT) :: SC_DataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Farm_DestroySC_Data' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL SC_DestroyContState( SC_DataData%x, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SC_DestroyDiscState( SC_DataData%xd, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SC_DestroyConstrState( SC_DataData%z, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SC_DestroyOtherState( SC_DataData%OtherState, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SC_DestroyParam( SC_DataData%p, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SC_DestroyInput( SC_DataData%uInputs, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SC_DestroyOutput( SC_DataData%y, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SC_DestroyMisc( SC_DataData%m, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE Farm_DestroySC_Data - - SUBROUTINE Farm_PackSC_Data( 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_Data), 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 = 'Farm_PackSC_Data' - ! 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 ! x: size of buffers for each call to pack subtype - CALL SC_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x, ErrStat2, ErrMsg2, .TRUE. ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype - CALL SC_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd, ErrStat2, ErrMsg2, .TRUE. ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xd - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype - CALL SC_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z, ErrStat2, ErrMsg2, .TRUE. ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! z - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! z - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! z - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! OtherState: size of buffers for each call to pack subtype - CALL SC_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherState, ErrStat2, ErrMsg2, .TRUE. ) ! OtherState - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OtherState - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherState - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherState - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype - CALL SC_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! p - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! p - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! p - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! uInputs: size of buffers for each call to pack subtype - CALL SC_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%uInputs, ErrStat2, ErrMsg2, .TRUE. ) ! uInputs - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! uInputs - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! uInputs - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! uInputs - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Db_BufSz = Db_BufSz + SIZE(InData%utimes) ! utimes - Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype - CALL SC_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype - CALL SC_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! m - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! m - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! m - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! IsInitialized - 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 SC_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x, ErrStat2, ErrMsg2, OnlySize ) ! x - 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 SC_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd, ErrStat2, ErrMsg2, OnlySize ) ! xd - 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 SC_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z, ErrStat2, ErrMsg2, OnlySize ) ! z - 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 SC_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherState, ErrStat2, ErrMsg2, OnlySize ) ! OtherState - 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 SC_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! p - 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 SC_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%uInputs, ErrStat2, ErrMsg2, OnlySize ) ! uInputs - 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 i1 = LBOUND(InData%utimes,1), UBOUND(InData%utimes,1) - DbKiBuf(Db_Xferred) = InData%utimes(i1) - Db_Xferred = Db_Xferred + 1 - END DO - CALL SC_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y - 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 SC_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! m - 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%IsInitialized, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Farm_PackSC_Data - - SUBROUTINE Farm_UnPackSC_Data( 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_Data), 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 = 'Farm_UnPackSC_Data' - ! 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 SC_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x, ErrStat2, ErrMsg2 ) ! x - 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 SC_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd, ErrStat2, ErrMsg2 ) ! xd - 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 SC_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z, ErrStat2, ErrMsg2 ) ! z - 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 SC_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherState, ErrStat2, ErrMsg2 ) ! OtherState - 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 SC_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p - 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 SC_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%uInputs, ErrStat2, ErrMsg2 ) ! uInputs - 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) - i1_l = LBOUND(OutData%utimes,1) - i1_u = UBOUND(OutData%utimes,1) - DO i1 = LBOUND(OutData%utimes,1), UBOUND(OutData%utimes,1) - OutData%utimes(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - 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 SC_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y - 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 SC_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! m - 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%IsInitialized = TRANSFER(IntKiBuf(Int_Xferred), OutData%IsInitialized) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Farm_UnPackSC_Data - - SUBROUTINE Farm_CopyMD_Data( SrcMD_DataData, DstMD_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MD_Data), INTENT(INOUT) :: SrcMD_DataData - TYPE(MD_Data), INTENT(INOUT) :: DstMD_DataData - 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 = 'Farm_CopyMD_Data' -! + ErrMsg = '' + call FWrap_CopyContState(SrcFASTWrapper_DataData%x, DstFASTWrapper_DataData%x, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FWrap_CopyDiscState(SrcFASTWrapper_DataData%xd, DstFASTWrapper_DataData%xd, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FWrap_CopyConstrState(SrcFASTWrapper_DataData%z, DstFASTWrapper_DataData%z, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FWrap_CopyOtherState(SrcFASTWrapper_DataData%OtherSt, DstFASTWrapper_DataData%OtherSt, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FWrap_CopyParam(SrcFASTWrapper_DataData%p, DstFASTWrapper_DataData%p, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FWrap_CopyInput(SrcFASTWrapper_DataData%u, DstFASTWrapper_DataData%u, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FWrap_CopyOutput(SrcFASTWrapper_DataData%y, DstFASTWrapper_DataData%y, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FWrap_CopyMisc(SrcFASTWrapper_DataData%m, DstFASTWrapper_DataData%m, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstFASTWrapper_DataData%IsInitialized = SrcFASTWrapper_DataData%IsInitialized +end subroutine + +subroutine Farm_DestroyFASTWrapper_Data(FASTWrapper_DataData, ErrStat, ErrMsg) + type(FASTWrapper_Data), intent(inout) :: FASTWrapper_DataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Farm_DestroyFASTWrapper_Data' ErrStat = ErrID_None - ErrMsg = "" - CALL MD_CopyContState( SrcMD_DataData%x, DstMD_DataData%x, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MD_CopyDiscState( SrcMD_DataData%xd, DstMD_DataData%xd, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MD_CopyConstrState( SrcMD_DataData%z, DstMD_DataData%z, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MD_CopyOtherState( SrcMD_DataData%OtherSt, DstMD_DataData%OtherSt, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MD_CopyParam( SrcMD_DataData%p, DstMD_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MD_CopyInput( SrcMD_DataData%u, DstMD_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcMD_DataData%Input)) THEN - i1_l = LBOUND(SrcMD_DataData%Input,1) - i1_u = UBOUND(SrcMD_DataData%Input,1) - IF (.NOT. ALLOCATED(DstMD_DataData%Input)) THEN - ALLOCATE(DstMD_DataData%Input(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMD_DataData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMD_DataData%Input,1), UBOUND(SrcMD_DataData%Input,1) - CALL MD_CopyInput( SrcMD_DataData%Input(i1), DstMD_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcMD_DataData%InputTimes)) THEN - i1_l = LBOUND(SrcMD_DataData%InputTimes,1) - i1_u = UBOUND(SrcMD_DataData%InputTimes,1) - IF (.NOT. ALLOCATED(DstMD_DataData%InputTimes)) THEN - ALLOCATE(DstMD_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMD_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMD_DataData%InputTimes = SrcMD_DataData%InputTimes -ENDIF - CALL MD_CopyOutput( SrcMD_DataData%y, DstMD_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MD_CopyMisc( SrcMD_DataData%m, DstMD_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstMD_DataData%IsInitialized = SrcMD_DataData%IsInitialized - END SUBROUTINE Farm_CopyMD_Data - - SUBROUTINE Farm_DestroyMD_Data( MD_DataData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(MD_Data), INTENT(INOUT) :: MD_DataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Farm_DestroyMD_Data' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL MD_DestroyContState( MD_DataData%x, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MD_DestroyDiscState( MD_DataData%xd, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MD_DestroyConstrState( MD_DataData%z, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MD_DestroyOtherState( MD_DataData%OtherSt, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MD_DestroyParam( MD_DataData%p, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MD_DestroyInput( MD_DataData%u, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(MD_DataData%Input)) THEN -DO i1 = LBOUND(MD_DataData%Input,1), UBOUND(MD_DataData%Input,1) - CALL MD_DestroyInput( MD_DataData%Input(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MD_DataData%Input) -ENDIF -IF (ALLOCATED(MD_DataData%InputTimes)) THEN - DEALLOCATE(MD_DataData%InputTimes) -ENDIF - CALL MD_DestroyOutput( MD_DataData%y, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MD_DestroyMisc( MD_DataData%m, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE Farm_DestroyMD_Data - - SUBROUTINE Farm_PackMD_Data( 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(MD_Data), 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 = 'Farm_PackMD_Data' - ! 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 ! x: size of buffers for each call to pack subtype - CALL MD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x, ErrStat2, ErrMsg2, .TRUE. ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype - CALL MD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd, ErrStat2, ErrMsg2, .TRUE. ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xd - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype - CALL MD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z, ErrStat2, ErrMsg2, .TRUE. ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! z - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! z - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! z - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! OtherSt: size of buffers for each call to pack subtype - CALL MD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt, ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype - CALL MD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! p - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! p - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! p - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype - CALL MD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! Input allocated yes/no - IF ( ALLOCATED(InData%Input) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Input upper/lower bounds for each dimension - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - Int_BufSz = Int_BufSz + 3 ! Input: size of buffers for each call to pack subtype - CALL MD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Input - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Input - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Input - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! InputTimes allocated yes/no - IF ( ALLOCATED(InData%InputTimes) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! InputTimes upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes - END IF - Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype - CALL MD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype - CALL MD_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! m - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! m - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! m - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! IsInitialized - 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 MD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x, ErrStat2, ErrMsg2, OnlySize ) ! x - 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 MD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd, ErrStat2, ErrMsg2, OnlySize ) ! xd - 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 MD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z, ErrStat2, ErrMsg2, OnlySize ) ! z - 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 MD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt, ErrStat2, ErrMsg2, OnlySize ) ! OtherSt - 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 MD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! p - 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 MD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u - 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%Input) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Input,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - CALL MD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input - 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%InputTimes) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InputTimes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%InputTimes,1), UBOUND(InData%InputTimes,1) - DbKiBuf(Db_Xferred) = InData%InputTimes(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - CALL MD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y - 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 MD_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! m - 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%IsInitialized, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Farm_PackMD_Data - - SUBROUTINE Farm_UnPackMD_Data( 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(MD_Data), 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 = 'Farm_UnPackMD_Data' - ! 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 MD_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x, ErrStat2, ErrMsg2 ) ! x - 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 MD_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd, ErrStat2, ErrMsg2 ) ! xd - 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 MD_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z, ErrStat2, ErrMsg2 ) ! z - 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 MD_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt, ErrStat2, ErrMsg2 ) ! OtherSt - 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 MD_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p - 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 MD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u - 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 ! Input not allocated - Int_Xferred = Int_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%Input)) DEALLOCATE(OutData%Input) - ALLOCATE(OutData%Input(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Input,1), UBOUND(OutData%Input,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 MD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input(i1), ErrStat2, ErrMsg2 ) ! Input - 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 ! InputTimes not allocated - Int_Xferred = Int_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%InputTimes)) DEALLOCATE(OutData%InputTimes) - ALLOCATE(OutData%InputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%InputTimes,1), UBOUND(OutData%InputTimes,1) - OutData%InputTimes(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_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 MD_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y - 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 MD_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! m - 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%IsInitialized = TRANSFER(IntKiBuf(Int_Xferred), OutData%IsInitialized) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Farm_UnPackMD_Data - - SUBROUTINE Farm_CopyAll_FastFarm_Data( SrcAll_FastFarm_DataData, DstAll_FastFarm_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(All_FastFarm_Data), INTENT(INOUT) :: SrcAll_FastFarm_DataData - TYPE(All_FastFarm_Data), INTENT(INOUT) :: DstAll_FastFarm_DataData - 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 = 'Farm_CopyAll_FastFarm_Data' -! + ErrMsg = '' + call FWrap_DestroyContState(FASTWrapper_DataData%x, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FWrap_DestroyDiscState(FASTWrapper_DataData%xd, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FWrap_DestroyConstrState(FASTWrapper_DataData%z, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FWrap_DestroyOtherState(FASTWrapper_DataData%OtherSt, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FWrap_DestroyParam(FASTWrapper_DataData%p, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FWrap_DestroyInput(FASTWrapper_DataData%u, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FWrap_DestroyOutput(FASTWrapper_DataData%y, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FWrap_DestroyMisc(FASTWrapper_DataData%m, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine Farm_PackFASTWrapper_Data(RF, Indata) + type(RegFile), intent(inout) :: RF + type(FASTWrapper_Data), intent(in) :: InData + character(*), parameter :: RoutineName = 'Farm_PackFASTWrapper_Data' + if (RF%ErrStat >= AbortErrLev) return + call FWrap_PackContState(RF, InData%x) + call FWrap_PackDiscState(RF, InData%xd) + call FWrap_PackConstrState(RF, InData%z) + call FWrap_PackOtherState(RF, InData%OtherSt) + call FWrap_PackParam(RF, InData%p) + call FWrap_PackInput(RF, InData%u) + call FWrap_PackOutput(RF, InData%y) + call FWrap_PackMisc(RF, InData%m) + call RegPack(RF, InData%IsInitialized) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Farm_UnPackFASTWrapper_Data(RF, OutData) + type(RegFile), intent(inout) :: RF + type(FASTWrapper_Data), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Farm_UnPackFASTWrapper_Data' + if (RF%ErrStat /= ErrID_None) return + call FWrap_UnpackContState(RF, OutData%x) ! x + call FWrap_UnpackDiscState(RF, OutData%xd) ! xd + call FWrap_UnpackConstrState(RF, OutData%z) ! z + call FWrap_UnpackOtherState(RF, OutData%OtherSt) ! OtherSt + call FWrap_UnpackParam(RF, OutData%p) ! p + call FWrap_UnpackInput(RF, OutData%u) ! u + call FWrap_UnpackOutput(RF, OutData%y) ! y + call FWrap_UnpackMisc(RF, OutData%m) ! m + call RegUnpack(RF, OutData%IsInitialized); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Farm_CopyWakeDynamics_Data(SrcWakeDynamics_DataData, DstWakeDynamics_DataData, CtrlCode, ErrStat, ErrMsg) + type(WakeDynamics_Data), intent(in) :: SrcWakeDynamics_DataData + type(WakeDynamics_Data), intent(inout) :: DstWakeDynamics_DataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Farm_CopyWakeDynamics_Data' ErrStat = ErrID_None - ErrMsg = "" - CALL Farm_CopyParam( SrcAll_FastFarm_DataData%p, DstAll_FastFarm_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL Farm_CopyMisc( SrcAll_FastFarm_DataData%m, DstAll_FastFarm_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcAll_FastFarm_DataData%FWrap)) THEN - i1_l = LBOUND(SrcAll_FastFarm_DataData%FWrap,1) - i1_u = UBOUND(SrcAll_FastFarm_DataData%FWrap,1) - IF (.NOT. ALLOCATED(DstAll_FastFarm_DataData%FWrap)) THEN - ALLOCATE(DstAll_FastFarm_DataData%FWrap(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstAll_FastFarm_DataData%FWrap.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcAll_FastFarm_DataData%FWrap,1), UBOUND(SrcAll_FastFarm_DataData%FWrap,1) - CALL Farm_Copyfastwrapper_data( SrcAll_FastFarm_DataData%FWrap(i1), DstAll_FastFarm_DataData%FWrap(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcAll_FastFarm_DataData%WD)) THEN - i1_l = LBOUND(SrcAll_FastFarm_DataData%WD,1) - i1_u = UBOUND(SrcAll_FastFarm_DataData%WD,1) - IF (.NOT. ALLOCATED(DstAll_FastFarm_DataData%WD)) THEN - ALLOCATE(DstAll_FastFarm_DataData%WD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstAll_FastFarm_DataData%WD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcAll_FastFarm_DataData%WD,1), UBOUND(SrcAll_FastFarm_DataData%WD,1) - CALL Farm_Copywakedynamics_data( SrcAll_FastFarm_DataData%WD(i1), DstAll_FastFarm_DataData%WD(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL Farm_Copyawae_data( SrcAll_FastFarm_DataData%AWAE, DstAll_FastFarm_DataData%AWAE, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL Farm_Copysc_data( SrcAll_FastFarm_DataData%SC, DstAll_FastFarm_DataData%SC, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL Farm_Copymd_data( SrcAll_FastFarm_DataData%MD, DstAll_FastFarm_DataData%MD, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE Farm_CopyAll_FastFarm_Data - - SUBROUTINE Farm_DestroyAll_FastFarm_Data( All_FastFarm_DataData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(All_FastFarm_Data), INTENT(INOUT) :: All_FastFarm_DataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Farm_DestroyAll_FastFarm_Data' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL Farm_DestroyParam( All_FastFarm_DataData%p, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL Farm_DestroyMisc( All_FastFarm_DataData%m, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(All_FastFarm_DataData%FWrap)) THEN -DO i1 = LBOUND(All_FastFarm_DataData%FWrap,1), UBOUND(All_FastFarm_DataData%FWrap,1) - CALL Farm_Destroyfastwrapper_data( All_FastFarm_DataData%FWrap(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(All_FastFarm_DataData%FWrap) -ENDIF -IF (ALLOCATED(All_FastFarm_DataData%WD)) THEN -DO i1 = LBOUND(All_FastFarm_DataData%WD,1), UBOUND(All_FastFarm_DataData%WD,1) - CALL Farm_Destroywakedynamics_data( All_FastFarm_DataData%WD(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(All_FastFarm_DataData%WD) -ENDIF - CALL Farm_Destroyawae_data( All_FastFarm_DataData%AWAE, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL Farm_Destroysc_data( All_FastFarm_DataData%SC, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL Farm_Destroymd_data( All_FastFarm_DataData%MD, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE Farm_DestroyAll_FastFarm_Data - - SUBROUTINE Farm_PackAll_FastFarm_Data( 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(All_FastFarm_Data), 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 = 'Farm_PackAll_FastFarm_Data' - ! 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 ! p: size of buffers for each call to pack subtype - CALL Farm_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! p - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! p - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! p - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype - CALL Farm_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! m - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! m - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! m - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! FWrap allocated yes/no - IF ( ALLOCATED(InData%FWrap) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! FWrap upper/lower bounds for each dimension - DO i1 = LBOUND(InData%FWrap,1), UBOUND(InData%FWrap,1) - Int_BufSz = Int_BufSz + 3 ! FWrap: size of buffers for each call to pack subtype - CALL Farm_Packfastwrapper_data( Re_Buf, Db_Buf, Int_Buf, InData%FWrap(i1), ErrStat2, ErrMsg2, .TRUE. ) ! FWrap - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! FWrap - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! FWrap - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! FWrap - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! WD allocated yes/no - IF ( ALLOCATED(InData%WD) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WD upper/lower bounds for each dimension - DO i1 = LBOUND(InData%WD,1), UBOUND(InData%WD,1) - Int_BufSz = Int_BufSz + 3 ! WD: size of buffers for each call to pack subtype - CALL Farm_Packwakedynamics_data( Re_Buf, Db_Buf, Int_Buf, InData%WD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! WD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! WD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! WD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! WD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! AWAE: size of buffers for each call to pack subtype - CALL Farm_Packawae_data( Re_Buf, Db_Buf, Int_Buf, InData%AWAE, ErrStat2, ErrMsg2, .TRUE. ) ! AWAE - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! AWAE - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! AWAE - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! AWAE - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! SC: size of buffers for each call to pack subtype - CALL Farm_Packsc_data( Re_Buf, Db_Buf, Int_Buf, InData%SC, ErrStat2, ErrMsg2, .TRUE. ) ! SC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! MD: size of buffers for each call to pack subtype - CALL Farm_Packmd_data( Re_Buf, Db_Buf, Int_Buf, InData%MD, ErrStat2, ErrMsg2, .TRUE. ) ! MD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! MD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! MD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! MD - 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 Farm_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! p - 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 Farm_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! m - 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%FWrap) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FWrap,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FWrap,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%FWrap,1), UBOUND(InData%FWrap,1) - CALL Farm_Packfastwrapper_data( Re_Buf, Db_Buf, Int_Buf, InData%FWrap(i1), ErrStat2, ErrMsg2, OnlySize ) ! FWrap - 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%WD) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WD,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WD,1), UBOUND(InData%WD,1) - CALL Farm_Packwakedynamics_data( Re_Buf, Db_Buf, Int_Buf, InData%WD(i1), ErrStat2, ErrMsg2, OnlySize ) ! WD - 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 - CALL Farm_Packawae_data( Re_Buf, Db_Buf, Int_Buf, InData%AWAE, ErrStat2, ErrMsg2, OnlySize ) ! AWAE - 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 Farm_Packsc_data( Re_Buf, Db_Buf, Int_Buf, InData%SC, ErrStat2, ErrMsg2, OnlySize ) ! SC - 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 Farm_Packmd_data( Re_Buf, Db_Buf, Int_Buf, InData%MD, ErrStat2, ErrMsg2, OnlySize ) ! MD - 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 Farm_PackAll_FastFarm_Data - - SUBROUTINE Farm_UnPackAll_FastFarm_Data( 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(All_FastFarm_Data), 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 = 'Farm_UnPackAll_FastFarm_Data' - ! 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 Farm_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p - 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 Farm_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! m - 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 ! FWrap not allocated - Int_Xferred = Int_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%FWrap)) DEALLOCATE(OutData%FWrap) - ALLOCATE(OutData%FWrap(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FWrap.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%FWrap,1), UBOUND(OutData%FWrap,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 Farm_Unpackfastwrapper_data( Re_Buf, Db_Buf, Int_Buf, OutData%FWrap(i1), ErrStat2, ErrMsg2 ) ! FWrap - 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 ! WD not allocated - Int_Xferred = Int_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%WD)) DEALLOCATE(OutData%WD) - ALLOCATE(OutData%WD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WD,1), UBOUND(OutData%WD,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 Farm_Unpackwakedynamics_data( Re_Buf, Db_Buf, Int_Buf, OutData%WD(i1), ErrStat2, ErrMsg2 ) ! WD - 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 - 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 Farm_Unpackawae_data( Re_Buf, Db_Buf, Int_Buf, OutData%AWAE, ErrStat2, ErrMsg2 ) ! AWAE - 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 Farm_Unpacksc_data( Re_Buf, Db_Buf, Int_Buf, OutData%SC, ErrStat2, ErrMsg2 ) ! SC - 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 Farm_Unpackmd_data( Re_Buf, Db_Buf, Int_Buf, OutData%MD, ErrStat2, ErrMsg2 ) ! MD - 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 Farm_UnPackAll_FastFarm_Data - + ErrMsg = '' + call WD_CopyContState(SrcWakeDynamics_DataData%x, DstWakeDynamics_DataData%x, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call WD_CopyDiscState(SrcWakeDynamics_DataData%xd, DstWakeDynamics_DataData%xd, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call WD_CopyConstrState(SrcWakeDynamics_DataData%z, DstWakeDynamics_DataData%z, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call WD_CopyOtherState(SrcWakeDynamics_DataData%OtherSt, DstWakeDynamics_DataData%OtherSt, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call WD_CopyParam(SrcWakeDynamics_DataData%p, DstWakeDynamics_DataData%p, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call WD_CopyInput(SrcWakeDynamics_DataData%u, DstWakeDynamics_DataData%u, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call WD_CopyOutput(SrcWakeDynamics_DataData%y, DstWakeDynamics_DataData%y, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call WD_CopyMisc(SrcWakeDynamics_DataData%m, DstWakeDynamics_DataData%m, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstWakeDynamics_DataData%IsInitialized = SrcWakeDynamics_DataData%IsInitialized +end subroutine + +subroutine Farm_DestroyWakeDynamics_Data(WakeDynamics_DataData, ErrStat, ErrMsg) + type(WakeDynamics_Data), intent(inout) :: WakeDynamics_DataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Farm_DestroyWakeDynamics_Data' + ErrStat = ErrID_None + ErrMsg = '' + call WD_DestroyContState(WakeDynamics_DataData%x, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call WD_DestroyDiscState(WakeDynamics_DataData%xd, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call WD_DestroyConstrState(WakeDynamics_DataData%z, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call WD_DestroyOtherState(WakeDynamics_DataData%OtherSt, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call WD_DestroyParam(WakeDynamics_DataData%p, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call WD_DestroyInput(WakeDynamics_DataData%u, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call WD_DestroyOutput(WakeDynamics_DataData%y, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call WD_DestroyMisc(WakeDynamics_DataData%m, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine Farm_PackWakeDynamics_Data(RF, Indata) + type(RegFile), intent(inout) :: RF + type(WakeDynamics_Data), intent(in) :: InData + character(*), parameter :: RoutineName = 'Farm_PackWakeDynamics_Data' + if (RF%ErrStat >= AbortErrLev) return + call WD_PackContState(RF, InData%x) + call WD_PackDiscState(RF, InData%xd) + call WD_PackConstrState(RF, InData%z) + call WD_PackOtherState(RF, InData%OtherSt) + call WD_PackParam(RF, InData%p) + call WD_PackInput(RF, InData%u) + call WD_PackOutput(RF, InData%y) + call WD_PackMisc(RF, InData%m) + call RegPack(RF, InData%IsInitialized) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Farm_UnPackWakeDynamics_Data(RF, OutData) + type(RegFile), intent(inout) :: RF + type(WakeDynamics_Data), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Farm_UnPackWakeDynamics_Data' + if (RF%ErrStat /= ErrID_None) return + call WD_UnpackContState(RF, OutData%x) ! x + call WD_UnpackDiscState(RF, OutData%xd) ! xd + call WD_UnpackConstrState(RF, OutData%z) ! z + call WD_UnpackOtherState(RF, OutData%OtherSt) ! OtherSt + call WD_UnpackParam(RF, OutData%p) ! p + call WD_UnpackInput(RF, OutData%u) ! u + call WD_UnpackOutput(RF, OutData%y) ! y + call WD_UnpackMisc(RF, OutData%m) ! m + call RegUnpack(RF, OutData%IsInitialized); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Farm_CopyAWAE_Data(SrcAWAE_DataData, DstAWAE_DataData, CtrlCode, ErrStat, ErrMsg) + type(AWAE_Data), intent(in) :: SrcAWAE_DataData + type(AWAE_Data), intent(inout) :: DstAWAE_DataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Farm_CopyAWAE_Data' + ErrStat = ErrID_None + ErrMsg = '' + call AWAE_CopyContState(SrcAWAE_DataData%x, DstAWAE_DataData%x, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AWAE_CopyDiscState(SrcAWAE_DataData%xd, DstAWAE_DataData%xd, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AWAE_CopyConstrState(SrcAWAE_DataData%z, DstAWAE_DataData%z, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AWAE_CopyOtherState(SrcAWAE_DataData%OtherSt, DstAWAE_DataData%OtherSt, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AWAE_CopyParam(SrcAWAE_DataData%p, DstAWAE_DataData%p, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AWAE_CopyInput(SrcAWAE_DataData%u, DstAWAE_DataData%u, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AWAE_CopyOutput(SrcAWAE_DataData%y, DstAWAE_DataData%y, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AWAE_CopyMisc(SrcAWAE_DataData%m, DstAWAE_DataData%m, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstAWAE_DataData%IsInitialized = SrcAWAE_DataData%IsInitialized +end subroutine + +subroutine Farm_DestroyAWAE_Data(AWAE_DataData, ErrStat, ErrMsg) + type(AWAE_Data), intent(inout) :: AWAE_DataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Farm_DestroyAWAE_Data' + ErrStat = ErrID_None + ErrMsg = '' + call AWAE_DestroyContState(AWAE_DataData%x, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AWAE_DestroyDiscState(AWAE_DataData%xd, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AWAE_DestroyConstrState(AWAE_DataData%z, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AWAE_DestroyOtherState(AWAE_DataData%OtherSt, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AWAE_DestroyParam(AWAE_DataData%p, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AWAE_DestroyInput(AWAE_DataData%u, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AWAE_DestroyOutput(AWAE_DataData%y, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AWAE_DestroyMisc(AWAE_DataData%m, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine Farm_PackAWAE_Data(RF, Indata) + type(RegFile), intent(inout) :: RF + type(AWAE_Data), intent(in) :: InData + character(*), parameter :: RoutineName = 'Farm_PackAWAE_Data' + if (RF%ErrStat >= AbortErrLev) return + call AWAE_PackContState(RF, InData%x) + call AWAE_PackDiscState(RF, InData%xd) + call AWAE_PackConstrState(RF, InData%z) + call AWAE_PackOtherState(RF, InData%OtherSt) + call AWAE_PackParam(RF, InData%p) + call AWAE_PackInput(RF, InData%u) + call AWAE_PackOutput(RF, InData%y) + call AWAE_PackMisc(RF, InData%m) + call RegPack(RF, InData%IsInitialized) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Farm_UnPackAWAE_Data(RF, OutData) + type(RegFile), intent(inout) :: RF + type(AWAE_Data), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Farm_UnPackAWAE_Data' + if (RF%ErrStat /= ErrID_None) return + call AWAE_UnpackContState(RF, OutData%x) ! x + call AWAE_UnpackDiscState(RF, OutData%xd) ! xd + call AWAE_UnpackConstrState(RF, OutData%z) ! z + call AWAE_UnpackOtherState(RF, OutData%OtherSt) ! OtherSt + call AWAE_UnpackParam(RF, OutData%p) ! p + call AWAE_UnpackInput(RF, OutData%u) ! u + call AWAE_UnpackOutput(RF, OutData%y) ! y + call AWAE_UnpackMisc(RF, OutData%m) ! m + call RegUnpack(RF, OutData%IsInitialized); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Farm_CopySC_Data(SrcSC_DataData, DstSC_DataData, CtrlCode, ErrStat, ErrMsg) + type(SC_Data), intent(in) :: SrcSC_DataData + type(SC_Data), intent(inout) :: DstSC_DataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Farm_CopySC_Data' + ErrStat = ErrID_None + ErrMsg = '' + call SC_CopyContState(SrcSC_DataData%x, DstSC_DataData%x, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SC_CopyDiscState(SrcSC_DataData%xd, DstSC_DataData%xd, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SC_CopyConstrState(SrcSC_DataData%z, DstSC_DataData%z, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SC_CopyOtherState(SrcSC_DataData%OtherState, DstSC_DataData%OtherState, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SC_CopyParam(SrcSC_DataData%p, DstSC_DataData%p, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SC_CopyInput(SrcSC_DataData%uInputs, DstSC_DataData%uInputs, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstSC_DataData%utimes = SrcSC_DataData%utimes + call SC_CopyOutput(SrcSC_DataData%y, DstSC_DataData%y, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SC_CopyMisc(SrcSC_DataData%m, DstSC_DataData%m, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstSC_DataData%IsInitialized = SrcSC_DataData%IsInitialized +end subroutine + +subroutine Farm_DestroySC_Data(SC_DataData, ErrStat, ErrMsg) + type(SC_Data), intent(inout) :: SC_DataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Farm_DestroySC_Data' + ErrStat = ErrID_None + ErrMsg = '' + call SC_DestroyContState(SC_DataData%x, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SC_DestroyDiscState(SC_DataData%xd, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SC_DestroyConstrState(SC_DataData%z, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SC_DestroyOtherState(SC_DataData%OtherState, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SC_DestroyParam(SC_DataData%p, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SC_DestroyInput(SC_DataData%uInputs, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SC_DestroyOutput(SC_DataData%y, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SC_DestroyMisc(SC_DataData%m, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine Farm_PackSC_Data(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SC_Data), intent(in) :: InData + character(*), parameter :: RoutineName = 'Farm_PackSC_Data' + if (RF%ErrStat >= AbortErrLev) return + call SC_PackContState(RF, InData%x) + call SC_PackDiscState(RF, InData%xd) + call SC_PackConstrState(RF, InData%z) + call SC_PackOtherState(RF, InData%OtherState) + call SC_PackParam(RF, InData%p) + call SC_PackInput(RF, InData%uInputs) + call RegPack(RF, InData%utimes) + call SC_PackOutput(RF, InData%y) + call SC_PackMisc(RF, InData%m) + call RegPack(RF, InData%IsInitialized) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Farm_UnPackSC_Data(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SC_Data), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Farm_UnPackSC_Data' + if (RF%ErrStat /= ErrID_None) return + call SC_UnpackContState(RF, OutData%x) ! x + call SC_UnpackDiscState(RF, OutData%xd) ! xd + call SC_UnpackConstrState(RF, OutData%z) ! z + call SC_UnpackOtherState(RF, OutData%OtherState) ! OtherState + call SC_UnpackParam(RF, OutData%p) ! p + call SC_UnpackInput(RF, OutData%uInputs) ! uInputs + call RegUnpack(RF, OutData%utimes); if (RegCheckErr(RF, RoutineName)) return + call SC_UnpackOutput(RF, OutData%y) ! y + call SC_UnpackMisc(RF, OutData%m) ! m + call RegUnpack(RF, OutData%IsInitialized); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Farm_CopyMD_Data(SrcMD_DataData, DstMD_DataData, CtrlCode, ErrStat, ErrMsg) + type(MD_Data), intent(inout) :: SrcMD_DataData + type(MD_Data), intent(inout) :: DstMD_DataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Farm_CopyMD_Data' + ErrStat = ErrID_None + ErrMsg = '' + call MD_CopyContState(SrcMD_DataData%x, DstMD_DataData%x, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MD_CopyDiscState(SrcMD_DataData%xd, DstMD_DataData%xd, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MD_CopyConstrState(SrcMD_DataData%z, DstMD_DataData%z, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MD_CopyOtherState(SrcMD_DataData%OtherSt, DstMD_DataData%OtherSt, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MD_CopyParam(SrcMD_DataData%p, DstMD_DataData%p, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MD_CopyInput(SrcMD_DataData%u, DstMD_DataData%u, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcMD_DataData%Input)) then + LB(1:1) = lbound(SrcMD_DataData%Input) + UB(1:1) = ubound(SrcMD_DataData%Input) + if (.not. allocated(DstMD_DataData%Input)) then + allocate(DstMD_DataData%Input(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMD_DataData%Input.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MD_CopyInput(SrcMD_DataData%Input(i1), DstMD_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcMD_DataData%InputTimes)) then + LB(1:1) = lbound(SrcMD_DataData%InputTimes) + UB(1:1) = ubound(SrcMD_DataData%InputTimes) + if (.not. allocated(DstMD_DataData%InputTimes)) then + allocate(DstMD_DataData%InputTimes(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMD_DataData%InputTimes.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMD_DataData%InputTimes = SrcMD_DataData%InputTimes + end if + call MD_CopyOutput(SrcMD_DataData%y, DstMD_DataData%y, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MD_CopyMisc(SrcMD_DataData%m, DstMD_DataData%m, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstMD_DataData%IsInitialized = SrcMD_DataData%IsInitialized + DstMD_DataData%VTK_count = SrcMD_DataData%VTK_count + DstMD_DataData%VTK_TWidth = SrcMD_DataData%VTK_TWidth + DstMD_DataData%VTK_OutFileRoot = SrcMD_DataData%VTK_OutFileRoot +end subroutine + +subroutine Farm_DestroyMD_Data(MD_DataData, ErrStat, ErrMsg) + type(MD_Data), intent(inout) :: MD_DataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Farm_DestroyMD_Data' + ErrStat = ErrID_None + ErrMsg = '' + call MD_DestroyContState(MD_DataData%x, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MD_DestroyDiscState(MD_DataData%xd, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MD_DestroyConstrState(MD_DataData%z, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MD_DestroyOtherState(MD_DataData%OtherSt, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MD_DestroyParam(MD_DataData%p, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MD_DestroyInput(MD_DataData%u, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(MD_DataData%Input)) then + LB(1:1) = lbound(MD_DataData%Input) + UB(1:1) = ubound(MD_DataData%Input) + do i1 = LB(1), UB(1) + call MD_DestroyInput(MD_DataData%Input(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MD_DataData%Input) + end if + if (allocated(MD_DataData%InputTimes)) then + deallocate(MD_DataData%InputTimes) + end if + call MD_DestroyOutput(MD_DataData%y, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MD_DestroyMisc(MD_DataData%m, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine Farm_PackMD_Data(RF, Indata) + type(RegFile), intent(inout) :: RF + type(MD_Data), intent(in) :: InData + character(*), parameter :: RoutineName = 'Farm_PackMD_Data' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + if (RF%ErrStat >= AbortErrLev) return + call MD_PackContState(RF, InData%x) + call MD_PackDiscState(RF, InData%xd) + call MD_PackConstrState(RF, InData%z) + call MD_PackOtherState(RF, InData%OtherSt) + call MD_PackParam(RF, InData%p) + call MD_PackInput(RF, InData%u) + call RegPack(RF, allocated(InData%Input)) + if (allocated(InData%Input)) then + call RegPackBounds(RF, 1, lbound(InData%Input), ubound(InData%Input)) + LB(1:1) = lbound(InData%Input) + UB(1:1) = ubound(InData%Input) + do i1 = LB(1), UB(1) + call MD_PackInput(RF, InData%Input(i1)) + end do + end if + call RegPackAlloc(RF, InData%InputTimes) + call MD_PackOutput(RF, InData%y) + call MD_PackMisc(RF, InData%m) + call RegPack(RF, InData%IsInitialized) + call RegPack(RF, InData%VTK_count) + call RegPack(RF, InData%VTK_TWidth) + call RegPack(RF, InData%VTK_OutFileRoot) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Farm_UnPackMD_Data(RF, OutData) + type(RegFile), intent(inout) :: RF + type(MD_Data), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Farm_UnPackMD_Data' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call MD_UnpackContState(RF, OutData%x) ! x + call MD_UnpackDiscState(RF, OutData%xd) ! xd + call MD_UnpackConstrState(RF, OutData%z) ! z + call MD_UnpackOtherState(RF, OutData%OtherSt) ! OtherSt + call MD_UnpackParam(RF, OutData%p) ! p + call MD_UnpackInput(RF, OutData%u) ! u + if (allocated(OutData%Input)) deallocate(OutData%Input) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%Input(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MD_UnpackInput(RF, OutData%Input(i1)) ! Input + end do + end if + call RegUnpackAlloc(RF, OutData%InputTimes); if (RegCheckErr(RF, RoutineName)) return + call MD_UnpackOutput(RF, OutData%y) ! y + call MD_UnpackMisc(RF, OutData%m) ! m + call RegUnpack(RF, OutData%IsInitialized); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VTK_count); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VTK_TWidth); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VTK_OutFileRoot); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Farm_CopyWAT_IfW_data(SrcWAT_IfW_dataData, DstWAT_IfW_dataData, CtrlCode, ErrStat, ErrMsg) + type(WAT_IfW_data), intent(in) :: SrcWAT_IfW_dataData + type(WAT_IfW_data), intent(inout) :: DstWAT_IfW_dataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Farm_CopyWAT_IfW_data' + ErrStat = ErrID_None + ErrMsg = '' + call InflowWind_CopyContState(SrcWAT_IfW_dataData%x, DstWAT_IfW_dataData%x, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call InflowWind_CopyDiscState(SrcWAT_IfW_dataData%xd, DstWAT_IfW_dataData%xd, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call InflowWind_CopyConstrState(SrcWAT_IfW_dataData%z, DstWAT_IfW_dataData%z, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call InflowWind_CopyOtherState(SrcWAT_IfW_dataData%OtherSt, DstWAT_IfW_dataData%OtherSt, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call InflowWind_CopyParam(SrcWAT_IfW_dataData%p, DstWAT_IfW_dataData%p, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call InflowWind_CopyInput(SrcWAT_IfW_dataData%u, DstWAT_IfW_dataData%u, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call InflowWind_CopyOutput(SrcWAT_IfW_dataData%y, DstWAT_IfW_dataData%y, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call InflowWind_CopyMisc(SrcWAT_IfW_dataData%m, DstWAT_IfW_dataData%m, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstWAT_IfW_dataData%IsInitialized = SrcWAT_IfW_dataData%IsInitialized +end subroutine + +subroutine Farm_DestroyWAT_IfW_data(WAT_IfW_dataData, ErrStat, ErrMsg) + type(WAT_IfW_data), intent(inout) :: WAT_IfW_dataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Farm_DestroyWAT_IfW_data' + ErrStat = ErrID_None + ErrMsg = '' + call InflowWind_DestroyContState(WAT_IfW_dataData%x, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call InflowWind_DestroyDiscState(WAT_IfW_dataData%xd, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call InflowWind_DestroyConstrState(WAT_IfW_dataData%z, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call InflowWind_DestroyOtherState(WAT_IfW_dataData%OtherSt, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call InflowWind_DestroyParam(WAT_IfW_dataData%p, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call InflowWind_DestroyInput(WAT_IfW_dataData%u, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call InflowWind_DestroyOutput(WAT_IfW_dataData%y, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call InflowWind_DestroyMisc(WAT_IfW_dataData%m, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine Farm_PackWAT_IfW_data(RF, Indata) + type(RegFile), intent(inout) :: RF + type(WAT_IfW_data), intent(in) :: InData + character(*), parameter :: RoutineName = 'Farm_PackWAT_IfW_data' + if (RF%ErrStat >= AbortErrLev) return + call InflowWind_PackContState(RF, InData%x) + call InflowWind_PackDiscState(RF, InData%xd) + call InflowWind_PackConstrState(RF, InData%z) + call InflowWind_PackOtherState(RF, InData%OtherSt) + call InflowWind_PackParam(RF, InData%p) + call InflowWind_PackInput(RF, InData%u) + call InflowWind_PackOutput(RF, InData%y) + call InflowWind_PackMisc(RF, InData%m) + call RegPack(RF, InData%IsInitialized) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Farm_UnPackWAT_IfW_data(RF, OutData) + type(RegFile), intent(inout) :: RF + type(WAT_IfW_data), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Farm_UnPackWAT_IfW_data' + if (RF%ErrStat /= ErrID_None) return + call InflowWind_UnpackContState(RF, OutData%x) ! x + call InflowWind_UnpackDiscState(RF, OutData%xd) ! xd + call InflowWind_UnpackConstrState(RF, OutData%z) ! z + call InflowWind_UnpackOtherState(RF, OutData%OtherSt) ! OtherSt + call InflowWind_UnpackParam(RF, OutData%p) ! p + call InflowWind_UnpackInput(RF, OutData%u) ! u + call InflowWind_UnpackOutput(RF, OutData%y) ! y + call InflowWind_UnpackMisc(RF, OutData%m) ! m + call RegUnpack(RF, OutData%IsInitialized); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Farm_CopyAll_FastFarm_Data(SrcAll_FastFarm_DataData, DstAll_FastFarm_DataData, CtrlCode, ErrStat, ErrMsg) + type(All_FastFarm_Data), intent(inout) :: SrcAll_FastFarm_DataData + type(All_FastFarm_Data), intent(inout) :: DstAll_FastFarm_DataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Farm_CopyAll_FastFarm_Data' + ErrStat = ErrID_None + ErrMsg = '' + call Farm_CopyParam(SrcAll_FastFarm_DataData%p, DstAll_FastFarm_DataData%p, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call Farm_CopyMisc(SrcAll_FastFarm_DataData%m, DstAll_FastFarm_DataData%m, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcAll_FastFarm_DataData%FWrap)) then + LB(1:1) = lbound(SrcAll_FastFarm_DataData%FWrap) + UB(1:1) = ubound(SrcAll_FastFarm_DataData%FWrap) + if (.not. allocated(DstAll_FastFarm_DataData%FWrap)) then + allocate(DstAll_FastFarm_DataData%FWrap(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstAll_FastFarm_DataData%FWrap.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call Farm_CopyFASTWrapper_Data(SrcAll_FastFarm_DataData%FWrap(i1), DstAll_FastFarm_DataData%FWrap(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcAll_FastFarm_DataData%WD)) then + LB(1:1) = lbound(SrcAll_FastFarm_DataData%WD) + UB(1:1) = ubound(SrcAll_FastFarm_DataData%WD) + if (.not. allocated(DstAll_FastFarm_DataData%WD)) then + allocate(DstAll_FastFarm_DataData%WD(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstAll_FastFarm_DataData%WD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call Farm_CopyWakeDynamics_Data(SrcAll_FastFarm_DataData%WD(i1), DstAll_FastFarm_DataData%WD(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call Farm_CopyAWAE_Data(SrcAll_FastFarm_DataData%AWAE, DstAll_FastFarm_DataData%AWAE, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call Farm_CopySC_Data(SrcAll_FastFarm_DataData%SC, DstAll_FastFarm_DataData%SC, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call Farm_CopyMD_Data(SrcAll_FastFarm_DataData%MD, DstAll_FastFarm_DataData%MD, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call Farm_CopyWAT_IfW_data(SrcAll_FastFarm_DataData%WAT_IfW, DstAll_FastFarm_DataData%WAT_IfW, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine Farm_DestroyAll_FastFarm_Data(All_FastFarm_DataData, ErrStat, ErrMsg) + type(All_FastFarm_Data), intent(inout) :: All_FastFarm_DataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Farm_DestroyAll_FastFarm_Data' + ErrStat = ErrID_None + ErrMsg = '' + call Farm_DestroyParam(All_FastFarm_DataData%p, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call Farm_DestroyMisc(All_FastFarm_DataData%m, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(All_FastFarm_DataData%FWrap)) then + LB(1:1) = lbound(All_FastFarm_DataData%FWrap) + UB(1:1) = ubound(All_FastFarm_DataData%FWrap) + do i1 = LB(1), UB(1) + call Farm_DestroyFASTWrapper_Data(All_FastFarm_DataData%FWrap(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(All_FastFarm_DataData%FWrap) + end if + if (allocated(All_FastFarm_DataData%WD)) then + LB(1:1) = lbound(All_FastFarm_DataData%WD) + UB(1:1) = ubound(All_FastFarm_DataData%WD) + do i1 = LB(1), UB(1) + call Farm_DestroyWakeDynamics_Data(All_FastFarm_DataData%WD(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(All_FastFarm_DataData%WD) + end if + call Farm_DestroyAWAE_Data(All_FastFarm_DataData%AWAE, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call Farm_DestroySC_Data(All_FastFarm_DataData%SC, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call Farm_DestroyMD_Data(All_FastFarm_DataData%MD, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call Farm_DestroyWAT_IfW_data(All_FastFarm_DataData%WAT_IfW, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine Farm_PackAll_FastFarm_Data(RF, Indata) + type(RegFile), intent(inout) :: RF + type(All_FastFarm_Data), intent(in) :: InData + character(*), parameter :: RoutineName = 'Farm_PackAll_FastFarm_Data' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + if (RF%ErrStat >= AbortErrLev) return + call Farm_PackParam(RF, InData%p) + call Farm_PackMisc(RF, InData%m) + call RegPack(RF, allocated(InData%FWrap)) + if (allocated(InData%FWrap)) then + call RegPackBounds(RF, 1, lbound(InData%FWrap), ubound(InData%FWrap)) + LB(1:1) = lbound(InData%FWrap) + UB(1:1) = ubound(InData%FWrap) + do i1 = LB(1), UB(1) + call Farm_PackFASTWrapper_Data(RF, InData%FWrap(i1)) + end do + end if + call RegPack(RF, allocated(InData%WD)) + if (allocated(InData%WD)) then + call RegPackBounds(RF, 1, lbound(InData%WD), ubound(InData%WD)) + LB(1:1) = lbound(InData%WD) + UB(1:1) = ubound(InData%WD) + do i1 = LB(1), UB(1) + call Farm_PackWakeDynamics_Data(RF, InData%WD(i1)) + end do + end if + call Farm_PackAWAE_Data(RF, InData%AWAE) + call Farm_PackSC_Data(RF, InData%SC) + call Farm_PackMD_Data(RF, InData%MD) + call Farm_PackWAT_IfW_data(RF, InData%WAT_IfW) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Farm_UnPackAll_FastFarm_Data(RF, OutData) + type(RegFile), intent(inout) :: RF + type(All_FastFarm_Data), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Farm_UnPackAll_FastFarm_Data' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call Farm_UnpackParam(RF, OutData%p) ! p + call Farm_UnpackMisc(RF, OutData%m) ! m + if (allocated(OutData%FWrap)) deallocate(OutData%FWrap) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%FWrap(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FWrap.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call Farm_UnpackFASTWrapper_Data(RF, OutData%FWrap(i1)) ! FWrap + end do + end if + if (allocated(OutData%WD)) deallocate(OutData%WD) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%WD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WD.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call Farm_UnpackWakeDynamics_Data(RF, OutData%WD(i1)) ! WD + end do + end if + call Farm_UnpackAWAE_Data(RF, OutData%AWAE) ! AWAE + call Farm_UnpackSC_Data(RF, OutData%SC) ! SC + call Farm_UnpackMD_Data(RF, OutData%MD) ! MD + call Farm_UnpackWAT_IfW_data(RF, OutData%WAT_IfW) ! WAT_IfW +end subroutine END MODULE FAST_Farm_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/glue-codes/openfast-cpp/CMakeLists.txt b/glue-codes/openfast-cpp/CMakeLists.txt index 6405e48cc6..a80c4053ca 100644 --- a/glue-codes/openfast-cpp/CMakeLists.txt +++ b/glue-codes/openfast-cpp/CMakeLists.txt @@ -26,21 +26,22 @@ set(CMAKE_CXX_STANDARD_REQUIRED ON) find_package(MPI REQUIRED) find_package(LibXml2 REQUIRED) find_package(ZLIB REQUIRED) -find_package(HDF5 REQUIRED COMPONENTS C HL) +find_package(HDF5 REQUIRED) +find_package(NetCDF REQUIRED COMPONENTS C) add_library(openfastcpplib SHARED src/OpenFAST.cpp src/SC.cpp) set_property(TARGET openfastcpplib PROPERTY POSITION_INDEPENDENT_CODE ON) target_link_libraries(openfastcpplib openfastlib - ${HDF5_C_LIBRARIES} - ${HDF5_HL_LIBRARIES} + ${HDF5_LIBRARIES} + ${NETCDF_LIBRARIES} ${ZLIB_LIBRARIES} ${LIBXML2_LIBRARIES} ${MPI_LIBRARIES} ) target_include_directories(openfastcpplib PUBLIC - ${HDF5_INCLUDES} - ${HDF5_INCLUDE_DIR} + ${HDF5_INCLUDE_DIRS} + ${NETCDF_INCLUDE_DIRS} ${ZLIB_INCLUDES} ${LIBXML2_INCLUDE_DIR} ${MPI_INCLUDE_PATH} @@ -49,7 +50,7 @@ set_target_properties(openfastcpplib PROPERTIES PUBLIC_HEADER "src/OpenFAST.H;sr install(TARGETS openfastcpplib EXPORT "${CMAKE_PROJECT_NAME}Libraries" - RUNTIME DESTINATION lib + RUNTIME DESTINATION bin ARCHIVE DESTINATION lib LIBRARY DESTINATION lib PUBLIC_HEADER DESTINATION include @@ -79,7 +80,7 @@ if (BUILD_OPENFAST_CPP_DRIVER) install(TARGETS openfastcpp EXPORT "${CMAKE_PROJECT_NAME}Libraries" - RUNTIME DESTINATION lib + RUNTIME DESTINATION bin ARCHIVE DESTINATION lib LIBRARY DESTINATION lib PUBLIC_HEADER DESTINATION include diff --git a/glue-codes/openfast-cpp/src/FAST_Prog.cpp b/glue-codes/openfast-cpp/src/FAST_Prog.cpp index b46514c56d..cb35300394 100644 --- a/glue-codes/openfast-cpp/src/FAST_Prog.cpp +++ b/glue-codes/openfast-cpp/src/FAST_Prog.cpp @@ -1,94 +1,177 @@ #include "OpenFAST.H" #include "yaml-cpp/yaml.h" #include +#include #include inline bool checkFileExists(const std::string& name) { - struct stat buffer; - return (stat (name.c_str(), &buffer) == 0); + struct stat buffer; + return (stat (name.c_str(), &buffer) == 0); } -void readTurbineData(int iTurb, fast::fastInputs & fi, YAML::Node turbNode) { - //Read turbine data for a given turbine using the YAML node - fi.globTurbineData[iTurb].TurbID = turbNode["turb_id"].as(); - fi.globTurbineData[iTurb].FASTInputFileName = turbNode["FAST_input_filename"].as(); - fi.globTurbineData[iTurb].FASTRestartFileName = turbNode["restart_filename"].as(); - if (turbNode["turbine_base_pos"].IsSequence() ) { - fi.globTurbineData[iTurb].TurbineBasePos = turbNode["turbine_base_pos"].as >(); +/// Optionally read in a value from a yaml node if present, else set it to a default value. Copied from github.com/Exawind/nalu-wind/include/NaluParsing.h +template +void get_if_present(const YAML::Node & node, const std::string& key, T& result, const T& default_if_not_present = T()) +{ + if (node[key]) { + const YAML::Node value = node[key]; + result = value.as(); } - if (turbNode["turbine_hub_pos"].IsSequence() ) { - fi.globTurbineData[iTurb].TurbineHubPos = turbNode["turbine_hub_pos"].as >(); + else { + int rank; + int iErr = MPI_Comm_rank( MPI_COMM_WORLD, &rank); + if(!rank) + std::cout << key << " is missing in the input file. Proceeding with assumption " << key << " = " << default_if_not_present << std::endl ; + result = default_if_not_present; } - fi.globTurbineData[iTurb].numForcePtsBlade = turbNode["num_force_pts_blade"].as(); - fi.globTurbineData[iTurb].numForcePtsTwr = turbNode["num_force_pts_tower"].as(); - if (turbNode["nacelle_cd"]) fi.globTurbineData[iTurb].nacelle_cd = turbNode["nacelle_cd"].as(); - if (turbNode["nacelle_area"]) fi.globTurbineData[iTurb].nacelle_area = turbNode["nacelle_area"].as(); - if (turbNode["air_density"]) fi.globTurbineData[iTurb].air_density = turbNode["air_density"].as(); } -void readInputFile(fast::fastInputs & fi, std::string cInterfaceInputFile, double * tEnd) { +/// Read a 'key' from a yaml node if it exists, else throw an error +template +void get_required(const YAML::Node & node, const std::string& key, T& result) +{ + if (node[key]) { + const YAML::Node value = node[key]; + result = value.as(); + } + else { + throw std::runtime_error("Error: parsing missing required key: " + key); + } +} - fi.comm = MPI_COMM_WORLD; +void readTurbineData(int iTurb, fast::fastInputs & fi, YAML::Node turbNode) { - // Check if the input file exists and read it - if ( checkFileExists(cInterfaceInputFile) ) { + //Read turbine data for a given turbine using the YAML node - YAML::Node cDriverInp = YAML::LoadFile(cInterfaceInputFile); + get_if_present(turbNode, "turb_id", fi.globTurbineData[iTurb].TurbID, iTurb); + std::string simType; + get_if_present(turbNode, "sim_type", simType, std::string("ext-inflow")); + if (simType == "ext-loads") + fi.globTurbineData[iTurb].sType = fast::EXTLOADS; + else + fi.globTurbineData[iTurb].sType = fast::EXTINFLOW; - fi.nTurbinesGlob = cDriverInp["nTurbinesGlob"].as(); + std::string emptyString = ""; + get_if_present(turbNode, "FAST_input_filename", fi.globTurbineData[iTurb].FASTInputFileName); + get_if_present(turbNode, "restart_filename", fi.globTurbineData[iTurb].FASTRestartFileName); + if ( (fi.globTurbineData[iTurb].FASTRestartFileName == emptyString) && (fi.globTurbineData[iTurb].FASTInputFileName == emptyString) ) + throw std::runtime_error("Both FAST_input_filename and restart_filename are empty or not specified for Turbine " + std::to_string(iTurb)); - if (fi.nTurbinesGlob > 0) { + if (turbNode["turbine_base_pos"].IsSequence() ) { + fi.globTurbineData[iTurb].TurbineBasePos = turbNode["turbine_base_pos"].as >() ; + } else { + fi.globTurbineData[iTurb].TurbineBasePos = std::vector(3,0.0); + } - if(cDriverInp["dryRun"]) { - fi.dryRun = cDriverInp["dryRun"].as(); - } + if (turbNode["turbine_hub_pos"].IsSequence() ) { + fi.globTurbineData[iTurb].TurbineHubPos = turbNode["turbine_hub_pos"].as >() ; + } else { + fi.globTurbineData[iTurb].TurbineHubPos = std::vector(3,0.0); + } - if(cDriverInp["debug"]) { - fi.debug = cDriverInp["debug"].as(); - } + get_if_present(turbNode, "num_force_pts_blade", fi.globTurbineData[iTurb].numForcePtsBlade, 0); + get_if_present(turbNode, "num_force_pts_tower", fi.globTurbineData[iTurb].numForcePtsTwr, 0); + fi.globTurbineData[iTurb].numForcePts = + fi.globTurbineData[iTurb].numForcePtsBlade + + fi.globTurbineData[iTurb].numForcePtsTwr; - if(cDriverInp["simStart"]) { - if (cDriverInp["simStart"].as() == "init") { - fi.simStart = fast::init; - } else if(cDriverInp["simStart"].as() == "trueRestart") { - fi.simStart = fast::trueRestart; - } else if(cDriverInp["simStart"].as() == "restartDriverInitFAST") { - fi.simStart = fast::restartDriverInitFAST; - } else { - throw std::runtime_error("simStart is not well defined in the input file"); - } - } + float fZero = 0.0; + get_if_present(turbNode, "nacelle_cd", fi.globTurbineData[iTurb].nacelle_cd, fZero); + get_if_present(turbNode, "nacelle_area", fi.globTurbineData[iTurb].nacelle_area, fZero); + get_if_present(turbNode, "air_density", fi.globTurbineData[iTurb].air_density, fZero); + + if (simType == "ext-loads") { + + get_if_present(turbNode, "az_blend_mean", fi.globTurbineData[iTurb].azBlendMean, 20*360.0*M_PI/180.0); //20 revs + get_if_present(turbNode, "az_blend_delta", fi.globTurbineData[iTurb].azBlendDelta, 3.0*360.0*M_PI/180.0); // 3 rev + + } + +} - fi.tStart = cDriverInp["tStart"].as(); - *tEnd = cDriverInp["tEnd"].as(); - fi.nEveryCheckPoint = cDriverInp["nEveryCheckPoint"].as(); - fi.dtFAST = cDriverInp["dtFAST"].as(); - fi.tMax = cDriverInp["tMax"].as(); // tMax is the total duration to which you want to run FAST. This should be the same or greater than the max time given in the FAST fst file. Choose this carefully as FAST writes the output file only at this point if you choose the binary file output. +void readInputFile(fast::fastInputs & fi, std::string cInterfaceInputFile, double *tStart, double * tEnd, int * couplingMode, bool * setExpLawWind, bool * setUniformXBladeForces, int * nIter, double *xBladeForce) { - if(cDriverInp["superController"]) { - fi.scStatus = cDriverInp["superController"].as(); - fi.scLibFile = cDriverInp["scLibFile"].as(); + fi.comm = MPI_COMM_WORLD; + + // Check if the input file exists and read it + if ( checkFileExists(cInterfaceInputFile) ) { + + YAML::Node cDriverInp = YAML::LoadFile(cInterfaceInputFile); + get_required(cDriverInp, "n_turbines_glob", fi.nTurbinesGlob); + + if (fi.nTurbinesGlob > 0) { + + get_if_present(cDriverInp, "dry_run", fi.dryRun, false); + get_if_present(cDriverInp, "debug", fi.debug, false); + + *couplingMode = 0; //CLASSIC is default + if(cDriverInp["coupling_mode"]) { + if ( cDriverInp["coupling_mode"].as() == "strong" ) { + *couplingMode = 1; + } else if ( cDriverInp["coupling_mode"].as() == "classic" ) { + *couplingMode = 0; + } else { + throw std::runtime_error("coupling_mode is not well defined in the input file"); } + } + if (cDriverInp["n_iter"]) { + *nIter = cDriverInp["n_iter"].as(); + if (*nIter < 0) { + *nIter = 1; + } + } else { + *nIter = 1; + } - fi.globTurbineData.resize(fi.nTurbinesGlob); - for (int iTurb=0; iTurb < fi.nTurbinesGlob; iTurb++) { - if (cDriverInp["Turbine" + std::to_string(iTurb)]) { - readTurbineData(iTurb, fi, cDriverInp["Turbine" + std::to_string(iTurb)] ); - } else { - throw std::runtime_error("Node for Turbine" + std::to_string(iTurb) + " not present in input file or I cannot read it"); - } + if(cDriverInp["sim_start"]) { + if (cDriverInp["sim_start"].as() == "init") { + fi.simStart = fast::init; + } else if(cDriverInp["sim_start"].as() == "trueRestart") { + fi.simStart = fast::trueRestart; + } else if(cDriverInp["sim_start"].as() == "restartDriverInitFAST") { + fi.simStart = fast::restartDriverInitFAST; + } else { + throw std::runtime_error("sim_start is not well defined in the input file"); } + } - } else { - throw std::runtime_error("Number of turbines <= 0 "); + get_required(cDriverInp, "t_start", *tStart); + get_required(cDriverInp, "t_end", *tEnd); + get_required(cDriverInp, "restart_freq", fi.restartFreq); + get_if_present(cDriverInp, "output_freq", fi.outputFreq, 100); + get_required(cDriverInp, "dt_driver", fi.dtDriver); + get_required(cDriverInp, "t_max", fi.tMax); // t_max is the total duration to which you want to run FAST. This should be the same or greater than the max time given in the FAST fst file. + get_if_present(cDriverInp, "set_exp_law_wind", *setExpLawWind, false); + get_if_present(cDriverInp, "set_uniform_x_blade_forces", *setUniformXBladeForces, false); + if (setUniformXBladeForces) + get_if_present(cDriverInp, "x_blade_force", *xBladeForce, 0.0); + + get_if_present(cDriverInp, "super_controller", fi.scStatus, false); + if(fi.scStatus) { + get_required(cDriverInp, "sc_libfile", fi.scLibFile); + } + + fi.globTurbineData.resize(fi.nTurbinesGlob); + for (int iTurb=0; iTurb < fi.nTurbinesGlob; iTurb++) { + if (cDriverInp["Turbine" + std::to_string(iTurb)]) { + readTurbineData(iTurb, fi, cDriverInp["Turbine" + std::to_string(iTurb)] ); + } else { + throw std::runtime_error("Node for Turbine" + std::to_string(iTurb) + " not present in input file or I cannot read it"); + } } } else { - throw std::runtime_error("Input file " + cInterfaceInputFile + " does not exist or I cannot access it"); + throw std::runtime_error("Number of turbines <= 0 "); } + + } else { + throw std::runtime_error("Input file " + cInterfaceInputFile + " does not exist or I cannot access it"); + } + } int main(int argc, char** argv) { + if (argc != 2) { std::cerr << "Incorrect syntax. Try: openfastcpp inputfile.yaml" << std::endl ; return 1; @@ -98,36 +181,40 @@ int main(int argc, char** argv) { int nProcs; int rank; std::vector torque (3, 0.0); - std::vector thrust (3, 0.0); + std::vector thrust (3, 0.0); iErr = MPI_Init(NULL, NULL); iErr = MPI_Comm_size( MPI_COMM_WORLD, &nProcs); iErr = MPI_Comm_rank( MPI_COMM_WORLD, &rank); - double tEnd ; // This doesn't belong in the FAST - C++ interface - int ntEnd ; // This doesn't belong in the FAST - C++ interface + int couplingMode ; //CLASSIC (SOWFA style = 0) or STRONG (Conventional Serial Staggered - allow for outer iterations = 1) + double tStart; // This doesn't belong in the C++ API + double tEnd ; // This doesn't belong in the FAST - C++ interface + int ntStart, ntEnd ; // This doesn't belong in the FAST - C++ interface + int nSubsteps; // + bool setExpLawWind; // Set wind speed at Aerodyn nodes based on an exponential profile. Useful for testing the C++ API before running actuator line simulations. + bool setUniformXBladeForces; // Set uniform X blade forces on all blade nodes + int nIter; + double xBladeForce = 0.0; std::string cDriverInputFile=argv[1]; fast::OpenFAST FAST; fast::fastInputs fi ; try { - readInputFile(fi, cDriverInputFile, &tEnd); + readInputFile(fi, cDriverInputFile, &tStart, &tEnd, &couplingMode, &setExpLawWind, &setUniformXBladeForces, &nIter, &xBladeForce); } catch( const std::runtime_error & ex) { std::cerr << ex.what() << std::endl ; std::cerr << "Program quitting now" << std::endl ; return 1; } - // Calculate the last time step - ntEnd = tEnd/fi.dtFAST; - FAST.setInputs(fi); - FAST.allocateTurbinesToProcsSimple(); + FAST.allocateTurbinesToProcsSimple(); // Or allocate turbines to procs by calling "setTurbineProcNo(iTurbGlob, procId)" for turbine. FAST.init(); - if (FAST.isTimeZero()) FAST.solution0(); + nSubsteps = fi.dtDriver/FAST.get_timestep(); if ( FAST.isDryRun() ) { FAST.end() ; @@ -135,8 +222,46 @@ int main(int argc, char** argv) { return 0; } - for (int nt = FAST.get_ntStart(); nt < ntEnd; nt++) { - FAST.step(); + if (FAST.isTimeZero()) { + if (setExpLawWind) + FAST.setExpLawWindSpeed(0.0); + + FAST.solution0(); + } + + + ntStart = tStart/fi.dtDriver; //Calculate the first time step + ntEnd = tEnd/fi.dtDriver; //Calculate the last time step + + for (int nt = ntStart; nt < ntEnd; nt++) { + if (couplingMode == 0) { + // If running with a CFD solver, sample velocities at the actuator/velocity nodes here + if (setExpLawWind) + FAST.setExpLawWindSpeed( (nt+1)*fi.dtDriver ); + if (setUniformXBladeForces) { + FAST.setUniformXBladeForces(xBladeForce); + } + + for (int iSubstep=1; iSubstep < nSubsteps; iSubstep++) { + FAST.step(); + std::cout << "iSubstep = " << iSubstep << std::endl ; + } + // Get forces at actuator nodes and advance CFD solve by one time step here + } else { + for (int j=0; j < nIter; j++) { + // If running with a CFD solver, use 'FAST.predict_states()' to predict position and force at actuator nodes at the next time step on the first pass + // Run a CFD time step as a 'predictor' to get velocity at the next time step + // Sample and set velocity at the actuator/velocity nodes after the first cfd predictor + if (setExpLawWind) + FAST.setExpLawWindSpeed( (nt+1)*fi.dtDriver ); + if (setUniformXBladeForces) { + FAST.setUniformXBladeForces(xBladeForce); + } + FAST.update_states_driver_time_step(); + } + // Call this after enough outer iterations have been done + FAST.advance_to_next_driver_time_step(); + } if (FAST.isDebug()) { FAST.computeTorqueThrust(0,torque,thrust); std::cout.precision(16); @@ -149,5 +274,4 @@ int main(int argc, char** argv) { MPI_Finalize() ; return 0; - } diff --git a/glue-codes/openfast-cpp/src/OpenFAST.H b/glue-codes/openfast-cpp/src/OpenFAST.H index 21ed980aa3..9915d7bbb3 100644 --- a/glue-codes/openfast-cpp/src/OpenFAST.H +++ b/glue-codes/openfast-cpp/src/OpenFAST.H @@ -6,10 +6,13 @@ #include #include #include +#include #include #include +#include +#include "netcdf.h" #include "dlfcn.h" -//TODO: The skip MPICXX is put in place primarily to get around errors in OpenFOAM. This will cause problems if the driver program uses C++ API for MPI. +//TODO: The skip MPICXX is put in place primarily to get around errors in ExternalInflow. This will cause problems if the driver program uses C++ API for MPI. #ifndef OMPI_SKIP_MPICXX #define OMPI_SKIP_MPICXX #endif @@ -22,20 +25,76 @@ namespace fast { -struct globTurbineDataType { - int TurbID; - std::string FASTInputFileName; - std::string FASTRestartFileName; - std::vector TurbineBasePos; - std::vector TurbineHubPos; - std::string forcePtsBladeDistributionType; - int numForcePtsBlade; - int numForcePtsTwr; - float nacelle_cd{0.0}; - float nacelle_area{0.0}; - float air_density{0.0}; +//! An id to indicate the type of simulation for each turbine - Simple/Actuator with optional externally specified inflow or Blade-Resolved with externally specified loads +enum simType { + EXTINFLOW = 0, + EXTLOADS = 1, + simType_END }; +//! A data structure to hold all turbine related information +struct turbineDataType { + //!Integer id for every turbine + int TurbID; + //! The FAST Input file name. Typically a .fst file. + std::string FASTInputFileName; + //! The restart/checkpoint file name. + std::string FASTRestartFileName; + //! Output file root + std::string outFileRoot; + //! The time step for OpenFAST for this turbine + double dt; + //! The position of the base of the turbine in global coordinates + std::vector TurbineBasePos; + //! The approximate position of the hub of the turbine in global coordinates + std::vector TurbineHubPos; + //! Simulation type + simType sType; + //! Number of blades + int numBlades; + //! Number of velocity nodes (AeroDyn) per blade + int numVelPtsBlade; + //! Number of velocity nodes (AeroDyn) on the tower + int numVelPtsTwr; + //! Total number of velocity nodes (AeroDyn) + int numVelPts; + //! Desired number of actuator points on each blade + int numForcePtsBlade; + //! Desired number of actuator points on the tower + int numForcePtsTwr; + //! Total number of actuator points + int numForcePts; + //! Node clustering type + int nodeClusterType; + //! Inflow Type - 1 (InflowWind) or 2 (Externally specified) + int inflowType; + //! Drag coefficient of nacelle + float nacelle_cd; + //! Frontal area of the nacelle + float nacelle_area; + //! Air density around this turbine + float air_density; + //! Number of nodes at which the forces and deflections are computed for blade-resolved FSI on each blade + std::vector nBRfsiPtsBlade; + //! Total number of BR fsi points on all blades combined + int nTotBRfsiPtsBlade; + //! Number of nodes at which the forces and deflections are computed for blade-resolved FSI on the tower + int nBRfsiPtsTwr; + //! The mean azimuth at which the loads are blended between AeroDyn and CFD + double azBlendMean; + //! The delta azimuth over which the the loads are blended between AeroDyn and CFD + double azBlendDelta; + //! Mean velocity at reference height + double velMean; + //! Compass angle of wind direction (in degrees) + double windDir; + //! Reference height for velocity profile + double zRef; + //! Shear exponent of velocity profile + double shearExp; +}; + +//! An id to indicate whether a particular actuator point is on the hub, node or tower enum ActuatorNodeType { HUB = 0, BLADE = 1, @@ -43,6 +102,11 @@ enum ActuatorNodeType { ActuatorNodeType_END }; +/** An id to indicate the start type of a simulation. + * init - Start the simulation from scratch + * trueRestart - Restart from a checkpoint file. Code expects checkpoint files for all parts of the simulation including the controller. + * restartDriverInitFAST - Start all turbines from scratch and use the velocity data in 'velData.h5' file to run upto desired restart time, then continue the simulation like ''trueRestart'. + */ enum simStartType { init = 0, trueRestart = 1, @@ -50,24 +114,133 @@ enum simStartType { simStartType_END }; +//! A data structure to hold all velocity and force node information +struct turbVelForceNodeDataType { + //! Blade location at velocity nodes + std::vector x_vel; + //! Blade velocity at velocity nodes + std::vector xdot_vel; + //! Sampled velocity at velocity nodes + std::vector vel_vel; + //! Reference location at force nodes + std::vector xref_force; + //! Blade location at force nodes + std::vector x_force; + //! Blade velocity at force nodes + std::vector xdot_force; + //! Blade orientation at force nodes + std::vector orient_force; + //! Sampled velocity at force nodes + std::vector vel_force; + //! Actuator force at force nodes + std::vector force; + double x_vel_resid; + double xdot_vel_resid; + double vel_vel_resid; + double x_force_resid; + double xdot_force_resid; + double orient_force_resid; + double vel_force_resid; + double force_resid; +}; + +//! An enum to keep track of information stored at different time steps +enum timeStep { + STATE_NM2 = 0, + STATE_NM1 = 1, + STATE_N = 2, + STATE_NP1 = 3, + timeStep_END +}; + +//! A data structure to hold all loads and deflections information for blade-resolved FSI simulations +struct turbBRfsiDataType { + //! Tower reference position + std::vector twr_ref_pos; + //! Tower deflections + std::vector twr_def; + //! Tower velocity + std::vector twr_vel; + //! Blade radial location + std::vector bld_rloc; + //! Blade chord + std::vector bld_chord; + //! Blade reference position + std::vector bld_ref_pos; + //! Blade deflections + std::vector bld_def; + //! Blade velocity + std::vector bld_vel; + //! Hub reference position + std::vector hub_ref_pos; + //! Hub deflections + std::vector hub_def; + //! Hub velocity + std::vector hub_vel; + //! Nacelle reference position + std::vector nac_ref_pos; + //! Nacelle deflections + std::vector nac_def; + //! Nacelle velocity + std::vector nac_vel; + //! Blade root reference position + std::vector bld_root_ref_pos; + //! Blade root deformation + std::vector bld_root_def; + //! Blade pitch + std::vector bld_pitch; + + //! Tower loads + std::vector twr_ld; + //! Blade loads + std::vector bld_ld; + double twr_def_resid; + double twr_vel_resid; + double bld_def_resid; + double bld_vel_resid; + double twr_ld_resid; + double bld_ld_resid; +}; +/** + * A class to hold all input data for a simulation run through a OpenFAST C++ glue code + */ class fastInputs { public: + //! MPI Communicator MPI_Comm comm; - int nTurbinesGlob; - bool dryRun; - bool debug; - double tStart; + //! Total number of turbines in the simulation + int nTurbinesGlob{0}; + //! The simulation will not run if dryRun is set to true. However, the simulation will read the input files, allocate turbines to processors and prepare to run the individual turbine instances. This flag is useful to test the setup of the simulation before running it. + bool dryRun{false}; + //! Enable debug outputs if set to true + bool debug{false}; + //! Start time of the simulation + double tStart{-1.0}; + //! Start type of the simulation: 'INIT', 'TRUERESTART' or 'RESTARTDRIVERINITFAST'. simStartType simStart; - int nEveryCheckPoint; - double tMax; - double dtFAST; - - bool scStatus; - std::string scLibFile; - std::vector globTurbineData; + //!Restart files will be written every so many time stneps + int restartFreq{-1}; + //!Output files will be written every so many time stneps + int outputFreq{100}; + //! Max time of the simulation + double tMax{0.0}; + //! Time step for driver. + double dtDriver{0.0}; + //! Time step for openfast. + double dtFAST{0.0}; + //! Supercontroller status: True/False. + bool scStatus{false}; + //! Name of the dynamic library containing the supercontroller implementation + std::string scLibFile{""}; + //! Number of inputs and output to the supercontroller from/to each turbine + int numScInputs{0}; + int numScOutputs{0}; + + //! Vector of turbine specific input data + std::vector globTurbineData; // Constructor fastInputs() ; @@ -78,84 +251,182 @@ class fastInputs { }; +/** + * A class to interface OpenFAST's fortran backend with a C++ driver program + */ class OpenFAST { private: + //! MPI Communicator MPI_Comm mpiComm; - bool dryRun; // If this is true, class will simply go through allocation and deallocation of turbine data - bool debug; // Write out extra information if this flags is turned on - std::vector globTurbineData; - int nTurbinesProc; - int nTurbinesGlob; - simStartType simStart; - bool timeZero; - double dtFAST; - double tMax; - std::vector > TurbineBasePos; - std::vector > TurbineHubPos; - std::vector TurbID; - std::vector FASTInputFileName; - std::vector CheckpointFileRoot; - std::vector nacelle_cd; - std::vector nacelle_area; - std::vector air_density; - double tStart; - int nt_global; - int ntStart; // The time step to start the FAST simulation - int nEveryCheckPoint; // Check point files will be written every 'nEveryCheckPoint' time steps - std::vector numBlades; // Number of blades - std::vector forcePtsBladeDistributionType; - std::vector numForcePtsBlade; - std::vector numForcePtsTwr; - std::vector numVelPtsBlade; - std::vector numVelPtsTwr; - + //! The simulation will not run if dryRun is set to true. However, the simulation will read the input files, allocate turbines to processors and prepare to run the individual turbine instances. This flag is useful to test the setup of the simulation before running it. + bool dryRun{false}; // If this is true, class will simply go through allocation and deallocation of turbine data + //! Enable debug outputs if set to true + bool debug{false}; // Write out extra information if this flags is turned on + //! Number of turbines on this MPI rank + int nTurbinesProc{0}; + //! Total number of turbines in the simulation + int nTurbinesGlob{0}; + //! Start type of the simulation: 'INIT', 'TRUERESTART' or 'RESTARTDRIVERINITFAST'. + simStartType simStart{fast::init}; + //! Offset between driver and openfast simulation time - t_driver - t_openfast + double driverOpenfastOffset_{0.0}; + //! Is the time now zero: True/False + bool timeZero{false}; + //! Time step for FAST. All turbines on a given processor should have the same time step. + double dtFAST{-1.0}; + //! Time step for Driver. + double dtDriver{-1.0}; + //! Number of OpenFAST time steps per unit time step of the driver program + int nSubsteps_{-1}; + //! Is this the first pass through a time step + bool firstPass_{true}; + //! Max time of the simulation + double tMax{-1.0}; + //! Start time of the simulation + double tStart{-1.0}; + + //! The current time step number + int nt_global{0}; + //! The current nonlinear iteration + int nlinIter_{0}; + //! The starting time step number + int ntStart{0}; + //! Restart files will be written every so many time steps + int restartFreq_{-1}; + //! Output files will be written every so many time steps + int outputFreq_{100}; + + //! Map of `{variableName : netCDF_ID}` obtained from the NetCDF C interface + std::vector ncOutVarNames_; + std::unordered_map ncOutVarIDs_; + + //! Map of `{dimName : netCDF_ID}` obtained from the NetCDF C interface + std::vector ncOutDimNames_; + std::unordered_map ncOutDimIDs_; + + //! Map of `{variableName : netCDF_ID}` obtained from the NetCDF C interface + std::vector ncRstVarNames_; + std::unordered_map ncRstVarIDs_; + + //! Map of `{dimName : netCDF_ID}` obtained from the NetCDF C interface + std::vector ncRstDimNames_; + std::unordered_map ncRstDimIDs_; + + std::vector globTurbineData; //All turbines + std::vector turbineData; // Only for turbines on the proc + + //! Velocity at force nodes - Store temporarily to interpolate to the velocity nodes std::vector > > forceNodeVel; // Velocity at force nodes - Store temporarily to interpolate to the velocity nodes + //! Position and velocity data at the velocity (aerodyn) nodes - (nTurbines, nTimesteps * nPoints * 6) std::vector > velNodeData; // Position and velocity data at the velocity (aerodyn) nodes - (nTurbines, nTimesteps * nPoints * 6) - hid_t velNodeDataFile; // HDF-5 tag of file containing velocity (aerodyn) node data file - - std::vector cDriver_Input_from_FAST; - std::vector cDriver_Output_to_FAST; + //! Array containing data at the velocity and force nodes + std::vector> velForceNodeData; + //! Array containing forces and deflections data for blade-resolved FSI simulations. + std::vector> brFSIData; + + //! Data structure to get forces and deflections from ExternalInflow module in OpenFAST + std::vector extinfw_i_f_FAST; // Input from OpenFAST + //! Data structure to send velocity information to ExternalInflow module in OpenFAST + std::vector extinfw_o_t_FAST; // Output to OpenFAST + + //! Data structure to get deflections from ExternalLoads module in OpenFAST + std::vector extld_i_f_FAST; // Input from OpenFAST + //! Data structure to get deflections from ExternalLoads module in OpenFAST + std::vector extld_p_f_FAST; // Parameter from OpenFAST + //! Data structure to send force information to ExternalLoads module in OpenFAST + std::vector extld_o_t_FAST; // Output to OpenFAST - // Turbine Number is DIFFERENT from TurbID. Turbine Number simply runs from 0:n-1 locally and globally. - std::map turbineMapGlobToProc; // Mapping global turbine number to processor number - std::map turbineMapProcToGlob; // Mapping local to global turbine number - std::map reverseTurbineMapProcToGlob; // Reverse Mapping global turbine number to local turbine number - std::set turbineSetProcs; // Set of processors containing at least one turbine - std::vector turbineProcs; // Same as the turbineSetProcs, but as an integer array - - //Supercontroller stuff - bool scStatus; - SuperController sc; scInitOutData scio; - int fastMPIGroupSize; + // Mapping of local turbine number to global turbine and processor number + // Turbine Number is DIFFERENT from TurbID. Turbine Number simply runs from 0:n-1 locally and globally. + //! Mapping global turbine number to processor number + std::map turbineMapGlobToProc; + //! Mapping local to global turbine number + std::map turbineMapProcToGlob; + //! Reverse Mapping global turbine number to local turbine number + std::map reverseTurbineMapProcToGlob; + //! Set of processors containing atleast one turbine + std::set turbineSetProcs; + //! Same as the turbineSetProcs, but as an integer array + std::vector turbineProcs; + + // Supercontroller stuff + bool scStatus{false}; + std::string scLibFile; + // Dynamic load stuff copied from 'C++ dlopen mini HOWTO' on tldp.org + void *scLibHandle ; + typedef SuperController* create_sc_t(); + create_sc_t * create_SuperController; + typedef void destroy_sc_t(SuperController *); + destroy_sc_t * destroy_SuperController; + std::unique_ptr sc; + + // MPI related book keeping for all processors containing turbines + //! Number of processors in a fastMPIGroup + int fastMPIGroupSize{-1}; + //! An MPI group created among all processors that simulate atleast one turbine MPI_Group fastMPIGroup; + //! An MPI communicator for the MPI group created among all processors that simulate atleast one turbine MPI_Comm fastMPIComm; - int fastMPIRank; + //! MPI rank of processor on the fastMPIComm + int fastMPIRank{-1}; + //! Global MPI group MPI_Group worldMPIGroup; - int worldMPIRank; + //! MPI rank of processor on global MPI Comm + int worldMPIRank{-1}; - static int AbortErrLev; - int ErrStat; + //! Error status and Error message to communicate with OpenFAST + int ErrStat{0}; char ErrMsg[INTERFACE_STRING_LENGTH]; // make sure this is the same size as IntfStrLen in FAST_Library.f90 + static int AbortErrLev; public: - // Constructor + //! Constructor OpenFAST() ; - // Destructor - ~OpenFAST() ; + //! Destructor + ~OpenFAST() {} ; + //! Set inputs to OpenFAST through an object of the class fastInputs. Should be called on all MPI ranks. void setInputs(const fastInputs &); + //! Check and set the number of sub-timesteps + int checkAndSetSubsteps(); + + //! Set driver time step and check point + void setDriverTimeStep(double dt_driver); + void setDriverCheckpoint(int nt_checkpoint_driver); + + //! Initialize the simulation - allocate memory for all data structures and initialize all turbines. Safe to call on all MPI ranks. void init(); - void solution0(); - void step(); - void stepNoWrite(); + //! Call FAST->solution0 for all turbines. Safe to call on all MPI ranks. + void solution0(bool writeFiles=true); + //! Initialize velocity and force node data. Safe to call on all MPI ranks. + void init_velForceNodeData(); + //! Set up before every OpenFAST time step. Safe to call on all MPI ranks. + void prework(); + //! Update states to next time step by calling FAST_AdvanceStates_T and CalcOutputs_And_SolveForInputs. Safe to call on all MPI ranks. + void update_states_driver_time_step(bool writeFiles=true); + //! Copy the final predicted states from step t_global_next to actual states for that step. Safe to call on all MPI ranks. + void advance_to_next_driver_time_step(bool writeFiles=true); + //! Set external inputs for OpenFAST modules by interpolating to substep. Safe to call on all MPI ranks. + void send_data_to_openfast(double ss_time); + //! Set external inputs for OpenFAST modules at time step 't'. Safe to call on all MPI ranks. + void send_data_to_openfast(fast::timeStep t); + //! Get ouput data from OpenFAST modules. Safe to call on all MPI ranks. + void get_data_from_openfast(fast::timeStep t); + //! Extrapolate velocity and force node data to time step 'n+1' using data at 'n', 'n-1' and 'n-2'. Safe to call on all MPI ranks. + void predict_states(); + //! Advance all turbines by 1 OpenFAST timestep. Safe to call on all MPI ranks. + void step(bool writeFiles=true); + //! Step function to be used with sub-stepping fast between time steps of the driver program. Safe to call on all MPI ranks. + void step(double ss_time); + //! Call FAST->end for all turbines. Safe to call on all MPI ranks. void end(); // Compute the nacelle force @@ -169,125 +440,334 @@ class OpenFAST { float & fy, float & fz); - hid_t openVelocityDataFile(bool createFile); - void readVelocityData(int nTimesteps); - void writeVelocityData(hid_t h5file, int iTurb, int iTimestep, OpFM_InputType_t iData, OpFM_OutputType_t oData); - herr_t closeVelocityDataFile(int nt_global, hid_t velDataFile); - void backupVelocityDataFile(int curTimeStep, hid_t & velDataFile); - + //! Allocate turbine number 'iTurbGlob' to the processor with global MPI rank 'procNo'. MUST be called from every MPI rank. void setTurbineProcNo(int iTurbGlob, int procNo) { turbineMapGlobToProc[iTurbGlob] = procNo; } + //! Allocate all turbines to processors in a round-robin fashion. MUST be called from every MPI rank. void allocateTurbinesToProcsSimple(); + + //! Get fast time step on this processor + double get_timestep() { return dtFAST; } + + //! Get the approximate hub position for turbine number 'iTurbGlob'. This is the value specified in the input to OpenFAST. Must be called only from the processor containing the turbine. void getApproxHubPos(double* currentCoords, int iTurbGlob, int nSize=3); - void getHubPos(double* currentCoords, int iTurbGlob, int nSize=3); - void getHubShftDir(double* hubShftVec, int iTurbGlob, int nSize=3); + //! Get the exact hub position for turbine number 'iTurbGlob'. This is avaiable only after OpenFAST has been initialized for a given turbine. Must be called only from the processor containing the turbine. + void getHubPos(double* currentCoords, int iTurbGlob, fast::timeStep t = fast::STATE_NP1, int nSize=3); + //! Get a vector pointing downstream along the hub for turbine number 'iTurbGlob'. Must be called only from the processor containing the turbine. + void getHubShftDir(double* hubShftVec, int iTurbGlob, fast::timeStep t = fast::STATE_NP1, int nSize=3); + + //! Get the node type (HUB, BLADE, TOWER) of velocity node number 'iNode' for turbine number 'iTurbGlob'. Must be called only from the processor containing the turbine. ActuatorNodeType getVelNodeType(int iTurbGlob, int iNode); - void getVelNodeCoordinates(double* currentCoords, int iNode, int iTurbGlob, int nSize=3); + //! Get the coordinates of velocity node number 'iNode' for turbine number 'iTurbGlob'. Must be called only from the processor containing the turbine. + void getVelNodeCoordinates(double* currentCoords, int iNode, int iTurbGlob, fast::timeStep t = fast::STATE_NP1, int nSize=3); + //! Set the velocity at velocity node 'iNode' for turbine number 'iTurbGlob'. Must be called only from the processor containing the turbine. void setVelocity(double* velocity, int iNode, int iTurbGlob, int nSize=3); + //! Set the velocity at force node 'iNode' for turbine number 'iTurbGlob'. Must be called only from the processor containing the turbine. void setVelocityForceNode(double* velocity, int iNode, int iTurbGlob, int nSize=3); + //! Map the velocity from the force nodes to the velocity nodes using linear interpolation along each blade and the tower. Safe to call from every MPI rank. void interpolateVel_ForceToVelNodes(); + //! Get the node type (HUB, BLADE, TOWER) of force node number 'iNode' for turbine number 'iTurbGlob'. Must be called only from the processor containing the turbine. ActuatorNodeType getForceNodeType(int iTurbGlob, int iNode); - void getForceNodeCoordinates(double* currentCoords, int iNode, int iTurbGlob, int nSize=3); - void getForceNodeOrientation(double* currentOrientation, int iNode, int iTurbGlob, int nSize=9); - void getForce(double* force, int iNode, int iTurbGlob, int nSize=3); - void getRelativeVelForceNode(double* vel, int iNode, int iTurbGlob, int nSize=3); - double getChord(int iNode, int iTurbGlob); + //! Get the coordinates of force node number 'iNode' for turbine number 'iTurbGlob'. Must be called only from the processor containing the turbine. + void getForceNodeCoordinates(double* currentCoords, int iNode, int iTurbGlob, fast::timeStep t = fast::STATE_NP1, int nSize=3); + //! Get the tensor orientation of force node number 'iNode' for turbine number 'iTurbGlob'. Must be called only from the processor containing the turbine. + void getForceNodeOrientation(double* currentOrientation, int iNode, int iTurbGlob, fast::timeStep t = fast::STATE_NP1, int nSize=3); + //! Get the actuator force at force node 'iNode' for turbine number 'iTurbGlob'. Must be called only from the processor containing the turbine. + void getForce(double* force, int iNode, int iTurbGlob, fast::timeStep t = fast::STATE_NP1, int nSize=3); + void getRelativeVelForceNode(double* vel, int iNode, int iTurbGlob, fast::timeStep t = fast::STATE_NP1, int nSize=3); + + //! Get the chord at force node 'iNode' for turbine number 'iTurbGlob'. Must be called only from the processor containing the turbine. + double getChord(int iNode, int iTurbGlob); + //! Get the radial location/height along blade/tower at force node 'iNode' for turbine number 'iTurbGlob'. Must be called only from the processor containing the turbine. + double getRHloc(int iNode, int iTurbGlob); + + //! Get processor containing turbine 'iTurbGlob' + int getProc(int iTurbGlob) {return turbineMapGlobToProc[iTurbGlob];} + + //! Get the blade chord array 'bldRloc' of turbine number 'iTurbGlob' + void getBladeChord(double * bldChord, int iTurbGlob); + //! Get the blade node radial locations array 'bldRloc' of turbine number 'iTurbGlob' + void getBladeRloc(double * bldRloc, int iTurbGlob); + //! Get the blade reference positions array 'bldRefPos' of turbine number 'iTurbGlob' + void getBladeRefPositions(double* bldRefPos, int iTurbGlob, int nSize=6); + //! Get the blade root reference positions array 'bldRootRefPos' of turbine number 'iTurbGlob' + void getBladeRootRefPositions(double* bldRootRefPos, int iTurbGlob, int nSize=6); + //! Get the blade deflections array 'bldDefl' of turbine number 'iTurbGlob' at time step 't' + void getBladeDisplacements(double* bldDefl, double* bldVel, int iTurbGlob, fast::timeStep t = fast::STATE_NP1, int nSize=6); + //! Get the blade root deflections array 'bldRootDefl' of turbine number 'iTurbGlob' at time step 't' + void getBladeRootDisplacements(double* bldRootDefl, int iTurbGlob, fast::timeStep t = fast::STATE_NP1, int nSize=6); + //! Get the blade pitch 'bldPitch' of turbine number 'iTurbGlob' + void getBladePitch(double* bldPitch, int iTurbGlob, int nSize=3); + //! Get the tower reference positions array 'twrRefPos' of turbine number 'iTurbGlob' + void getTowerRefPositions(double* twrRefPos, int iTurbGlob, int nSize=6); + //! Get the tower deflections array 'twrDefl' of turbine number 'iTurbGlob' at time step 't' + void getTowerDisplacements(double* twrDefl, double* twrVel, int iTurbGlob, fast::timeStep t = fast::STATE_NP1, int nSize=6); + //! Get the hub reference position array 'hubRefPos' of turbine number 'iTurbGlob' + void getHubRefPosition(double* hubRefPos, int iTurbGlob, int nSize=6); + //! Get the hub deflections array 'hubDefl' of turbine number 'iTurbGlob' at time step 't' + void getHubDisplacement(double* hubDefl, double* hubVel, int iTurbGlob, fast::timeStep t = fast::STATE_NP1, int nSize=6); + //! Get the nacelle reference position array 'nacRefPos' of turbine number 'iTurbGlob' + void getNacelleRefPosition(double* nacRefPos, int iTurbGlob, int nSize=6); + //! Get the nacelle deflections array 'nacDefl' of turbine number 'iTurbGlob' at time step 't' + void getNacelleDisplacement(double* nacDefl, double* nacVel, int iTurbGlob, fast::timeStep t = fast::STATE_NP1, int nSize=6); + + //! Set the blade forces array 'bldForce' for blade 'iBlade' of turbine number 'iTurbGlob' at time step 't' + void setBladeForces(double* bldForce, int iTurbGlob, fast::timeStep t = fast::STATE_NP1, int nSize=6); + //! Set the tower force array 'twrForce' of turbine number 'iTurbGlob' at time step 't' + void setTowerForces(double* twrForce, int iTurbGlob, fast::timeStep t = fast::STATE_NP1, int nSize=6); + + + //! Get all turbine parametric data + void get_turbineParams(int iTurbGlob, turbineDataType & turbData); + //! Get the starting time step of the simulation. Safe to call from every MPI rank. int get_ntStart() { return ntStart; } + //! Return a boolean flag whether the simulation is dryRun. Safe to call from every MPI rank. bool isDryRun() { return dryRun; } + //! Return a boolean flag whether the simulation is debug. Safe to call from every MPI rank. bool isDebug() { return debug; } + //! Get an enum of type 'simStartType' indicating the start type of the simulation. Safe to call from every MPI rank. simStartType get_simStartType() { return simStart; } + //! Is the simulation time zero right now? Safe to call from every MPI rank. bool isTimeZero() { return timeZero; } - int get_procNo(int iTurbGlob) { return turbineMapGlobToProc[iTurbGlob] ; } // Get processor number of a turbine with global id 'iTurbGlob' + //! Get the global MPI rank of the processor containing turbine number 'iTurbGlob'. Safe to call from every MPI rank. + int get_procNo(int iTurbGlob) { return turbineMapGlobToProc[iTurbGlob] ; } + //! Get the local turbine number of the turbine number 'iTurbGlob'. Safe to call from every MPI rank. int get_localTurbNo(int iTurbGlob) { return reverseTurbineMapProcToGlob[iTurbGlob]; } + //! Get the total number of turbines in the simulation. Safe to call from every MPI rank. int get_nTurbinesGlob() { return nTurbinesGlob; } + //! Get the nacelle area of turbine number 'iTurbGlob'. Must be called only from processor containing the turbine. float get_nacelleArea(int iTurbGlob) { return get_nacelleAreaLoc(get_localTurbNo(iTurbGlob)); } + //! Get the nacelle drag coefficient of turbine number 'iTurbGlob'. Must be called only from processor containing the turbine. float get_nacelleCd(int iTurbGlob) { return get_nacelleCdLoc(get_localTurbNo(iTurbGlob)); } + //! Get the air density around turbine number 'iTurbGlob'. Must be called only from processor containing the turbine. float get_airDensity(int iTurbGlob) { return get_airDensityLoc(get_localTurbNo(iTurbGlob)); } + + //! Get the number of blades in turbine number 'iTurbGlob'. Must be called only from processor containing the turbine. int get_numBlades(int iTurbGlob) { return get_numBladesLoc(get_localTurbNo(iTurbGlob)); } + //! Get the number of Aerodyn/velocity nodes on each blade in turbine number 'iTurbGlob'. Must be called only from processor containing the turbine. int get_numVelPtsBlade(int iTurbGlob) { return get_numVelPtsBladeLoc(get_localTurbNo(iTurbGlob)); } + //! Get the number of Aerodyn/velocity nodes on the tower in turbine number 'iTurbGlob'. Must be called only from processor containing the turbine. int get_numVelPtsTwr(int iTurbGlob) { return get_numVelPtsTwrLoc(get_localTurbNo(iTurbGlob)); } + //! Get the total number of Aerodyn/velocity nodes in turbine number 'iTurbGlob'. Must be called only from processor containing the turbine. int get_numVelPts(int iTurbGlob) { return get_numVelPtsLoc(get_localTurbNo(iTurbGlob)); } + //! Get the number of Actuator/force nodes on each blade in turbine number 'iTurbGlob'. Must be called only from processor containing the turbine. int get_numForcePtsBlade(int iTurbGlob) { return get_numForcePtsBladeLoc(get_localTurbNo(iTurbGlob)); } + //! Get the number of Actuator/force nodes on the tower in turbine number 'iTurbGlob'. Must be called only from processor containing the turbine. int get_numForcePtsTwr(int iTurbGlob) { return get_numForcePtsTwrLoc(get_localTurbNo(iTurbGlob)); } + //! Get the total number of Actuator/force nodes in turbine number 'iTurbGlob'. Must be called only from processor containing the turbine. int get_numForcePts(int iTurbGlob) { return get_numForcePtsLoc(get_localTurbNo(iTurbGlob)); } - void computeTorqueThrust(int iTurGlob, std::vector & torque, std::vector & thrust); - + //! Compute the torque and thrust for turbine number 'iTurbGlob'. Must be called only from processor containing the turbine. + void computeTorqueThrust(int iTurGlob, double* torque, double* thrust, int nSize); inline - void getHubPos(std::vector & currentCoords, int iTurbGlob) { - getHubPos(currentCoords.data(), iTurbGlob, currentCoords.size()); + void getApproxHubPos(std::vector& currentCoords, int iTurbGlob) { + getApproxHubPos(currentCoords.data(), iTurbGlob, currentCoords.size()); } inline - void getApproxHubPos(std::vector& currentCoords, int iTurbGlob) { - getApproxHubPos(currentCoords.data(), iTurbGlob, currentCoords.size()); + void getHubPos(std::vector& currentCoords, int iTurbGlob, fast::timeStep t = fast::STATE_NP1) { + getHubPos(currentCoords.data(), iTurbGlob, t, currentCoords.size()); } + inline - void getHubShftDir(std::vector & hubShftVec, int iTurbGlob) { - getHubShftDir(hubShftVec.data(), iTurbGlob, hubShftVec.size()); + void getHubShftDir(std::vector & hubShftVec, int iTurbGlob, fast::timeStep t = fast::STATE_NP1) { + getHubShftDir(hubShftVec.data(), iTurbGlob, t, hubShftVec.size()); } inline - void getVelNodeCoordinates(std::vector & currentCoords, int iNode, int iTurbGlob) { - getVelNodeCoordinates(currentCoords.data(), iNode, iTurbGlob, currentCoords.size()); + void getVelNodeCoordinates(std::vector & currentCoords, int iNode, int iTurbGlob, fast::timeStep t = fast::STATE_NP1) { + getVelNodeCoordinates(currentCoords.data(), iNode, iTurbGlob, t, currentCoords.size()); } inline void setVelocity(std::vector & currentVelocity, int iNode, int iTurbGlob) { - setVelocity(currentVelocity.data(), iNode, iTurbGlob, currentVelocity.size()); + setVelocity(currentVelocity.data(), iNode, iTurbGlob, currentVelocity.size()); } inline void setVelocityForceNode(std::vector & currentVelocity, int iNode, int iTurbGlob) { - setVelocityForceNode(currentVelocity.data(), iNode, iTurbGlob, currentVelocity.size()); + setVelocityForceNode(currentVelocity.data(), iNode, iTurbGlob, currentVelocity.size()); } inline - void getForceNodeCoordinates(std::vector & currentCoords, int iNode, int iTurbGlob) { - getForceNodeCoordinates(currentCoords.data(), iNode, iTurbGlob, currentCoords.size()); + void getForceNodeCoordinates(std::vector & currentCoords, int iNode, int iTurbGlob, fast::timeStep t = fast::STATE_NP1) { + getForceNodeCoordinates(currentCoords.data(), iNode, iTurbGlob, t, currentCoords.size()); } inline - void getForceNodeOrientation(std::vector & currentOrientation, int iNode, int iTurbGlob) { - getForceNodeOrientation(currentOrientation.data(), iNode, iTurbGlob, currentOrientation.size()); + void getForceNodeOrientation(std::vector & currentOrientation, int iNode, int iTurbGlob, fast::timeStep t = fast::STATE_NP1) { + getForceNodeOrientation(currentOrientation.data(), iNode, iTurbGlob, t, currentOrientation.size()); } inline - void getForce(std::vector & currentForce, int iNode, int iTurbGlob) { - getForce(currentForce.data(), iNode, iTurbGlob, currentForce.size()); + void getForce(std::vector & currentForce, int iNode, int iTurbGlob, fast::timeStep t = fast::STATE_NP1) { + getForce(currentForce.data(), iNode, iTurbGlob, t, currentForce.size()); } inline - void getRelativeVelForceNode(std::vector & currentVelocity, int iNode, int iTurbGlob) { - getRelativeVelForceNode(currentVelocity.data(), iNode, iTurbGlob, currentVelocity.size()); + void getRelativeVelForceNode(std::vector & currentVelocity, int iNode, int iTurbGlob, fast::timeStep t = fast::STATE_NP1) { + getRelativeVelForceNode(currentVelocity.data(), iNode, iTurbGlob, t, currentVelocity.size()); } - private: - + inline + void getBladeRefPositions(std::vector & bldRefPos, int iTurbGlob){ + getBladeRefPositions(bldRefPos.data(), nTurbinesGlob); + } + inline + void getBladeDisplacements(std::vector & bldDefl, std::vector & bldVel, int iTurbGlob, fast::timeStep t = fast::STATE_NP1) + { + getBladeDisplacements(bldDefl.data(), bldVel.data(), iTurbGlob, t, bldDefl.size()); + } + inline + void getBladeRootRefPositions(std::vector & bldRootRefPos, int iTurbGlob){ + getBladeRootRefPositions(bldRootRefPos.data(), iTurbGlob); + } + void getBladeRootDisplacements(std::vector & bldRootDefl, int iTurbGlob, fast::timeStep t = fast::STATE_NP1) + { + getBladeRootDisplacements(bldRootDefl.data(), iTurbGlob, t, bldRootDefl.size()); + } + inline + void getBladePitch(std::vector & bldPitch, int iTurbGlob) + { + getBladePitch(bldPitch.data(), iTurbGlob, bldPitch.size()); + } + inline + void getTowerRefPositions(std::vector & twrRefPos, int iTurbGlob) + { + getTowerRefPositions(twrRefPos.data(), iTurbGlob, 6); + } + inline + void getTowerDisplacements(std::vector & twrDefl, std::vector & twrVel, int iTurbGlob, fast::timeStep t = fast::STATE_NP1) + { + getTowerDisplacements(twrDefl.data(), twrVel.data(), iTurbGlob, t, twrDefl.size()); + } + inline + void getHubRefPosition(std::vector & hubRefPos, int iTurbGlob) + { + getHubRefPosition(hubRefPos.data(), iTurbGlob, hubRefPos.size()); + } + inline + void getHubDisplacement(std::vector & hubDefl, std::vector & hubVel, int iTurbGlob, fast::timeStep t = fast::STATE_NP1) + { + getHubDisplacement(hubDefl.data(), hubVel.data(), iTurbGlob, t, hubDefl.size()); + } + inline + void getNacelleRefPosition(std::vector & nacRefPos, int iTurbGlob) + { + getNacelleRefPosition(nacRefPos.data(), iTurbGlob, nacRefPos.size()); + } + inline + void getNacelleDisplacement(std::vector & nacDefl, std::vector & nacVel, int iTurbGlob, fast::timeStep t = fast::STATE_NP1) + { + getNacelleDisplacement(nacDefl.data(), nacVel.data(), iTurbGlob, t, nacDefl.size()); + } + + inline + void setBladeForces(std::vector & bldForce, int iTurbGlob, fast::timeStep t = fast::STATE_NP1) + { + setBladeForces(bldForce.data(), iTurbGlob, t, 6); + } + inline + void setTowerForces(std::vector & twrForce, int iTurbGlob, fast::timeStep t = fast::STATE_NP1) + { + setTowerForces(twrForce.data(), iTurbGlob, t, 6); + } + inline + void computeTorqueThrust(int iTurbGlob, std::vector & torque, std::vector & thrust) + { + computeTorqueThrust(iTurbGlob, torque.data(), thrust.data(), torque.size()); + } + + //! An example function to set velocities at the Aerodyn nodes using a power law wind profile using an exponent of 0.2 and a reference wind speed of 10 m/s at 90 meters. Safe to call from every MPI rank. + void setExpLawWindSpeed(double t) ; // An example to set velocities at the Aerodyn nodes + + //! An example function to set a uniform X force at all blade nodes. Safe to call from every MPI rank. + void setUniformXBladeForces(double loadX); + + +private: + + //! Set state from another state + void set_state_from_state(fast::timeStep fromState, fast::timeStep toState); + + //! Preprare the C+++ output file for a new OpenFAST simulation + void prepareOutputFile(int iTurbLoc); + //! Find the C++ output file for a restarted simulation + void findOutputFile(int iTurbLoc); + //! Write output data to file + void writeOutputFile(int iTurbLoc, int n_t_global); + + //! Find the OpenFAST restart file from the C++ restart file for a restarted simulation + void findRestartFile(int iTurbLoc); + //! Preprare the C+++ restart file for a new OpenFAST simulation + void prepareRestartFile(int iTurbLoc); + + //! Read velocity and force node data at time step 'n', 'n-1' and 'n-2' to allow for a clean restart + void readRestartFile(int iTurbLoc, int n_t_global); + //! Write velocity and force node data at time step 'n', 'n-1' and 'n-2' to allow for a clean restart + void writeRestartFile(int iTurbLoc, int n_t_global); + + //! Create velocity data file in preparation to write velocity data + void prepareVelocityDataFile(int iTurb); + //! Open velocity data file to read velocity data + int openVelocityDataFile(int iTurb); + //! Read the number of nonlinear iterations for a given driver time step + int read_nlin_iters(int iTurb, int iTimestep, int ncid); + //! Read velocity data at the Aerodyn nodes from velocity data file + void readVelocityData(int iTurb, int iTimestep, int iNlinIter, int ncid); + //! Write velocity data at the Aerodyn nodes from velocity data file + void writeVelocityData(int iTurb, int iTimestep, int nlinIter); + + //! Check whether the error status is ok. If not quit gracefully by printing the error message void checkError(const int ErrStat, const char * ErrMsg); + //! Check whether a file with name "name" exists inline bool checkFileExists(const std::string& name); - void allocateMemory(); - - float get_nacelleCdLoc(int iTurbLoc) { return nacelle_cd[iTurbLoc]; } - float get_nacelleAreaLoc(int iTurbLoc) { return nacelle_area[iTurbLoc]; } - float get_airDensityLoc(int iTurbLoc) { return air_density[iTurbLoc]; } - int get_numBladesLoc(int iTurbLoc) { return numBlades[iTurbLoc]; } - int get_numVelPtsBladeLoc(int iTurbLoc) { return numVelPtsBlade[iTurbLoc]; } - int get_numVelPtsTwrLoc(int iTurbLoc) { return numVelPtsTwr[iTurbLoc]; } - int get_numVelPtsLoc(int iTurbLoc) { return 1 + numBlades[iTurbLoc]*numVelPtsBlade[iTurbLoc] + numVelPtsTwr[iTurbLoc]; } - int get_numForcePtsBladeLoc(int iTurbLoc) { return numForcePtsBlade[iTurbLoc]; } - int get_numForcePtsTwrLoc(int iTurbLoc) { return numForcePtsTwr[iTurbLoc]; } - int get_numForcePtsLoc(int iTurbLoc) { return 1 + numBlades[iTurbLoc]*numForcePtsBlade[iTurbLoc] + numForcePtsTwr[iTurbLoc]; } + //! Allocate memory for data structures for all turbines on this processor + void allocateMemory_preInit(); + //! Allocate more memory for each turbine after intialization/restart + void allocateMemory_postInit(int iTurbLoc); + + //! Get the nacelle drag coefficient of local turbine number 'iTurbLoc' + float get_nacelleCdLoc(int iTurbLoc) { return turbineData[iTurbLoc].nacelle_cd; } + //! Get the nacelle area of local turbine number 'iTurbLoc' + float get_nacelleAreaLoc(int iTurbLoc) { return turbineData[iTurbLoc].nacelle_area; } + //! Get the air density around local turbine number 'iTurbLoc' + float get_airDensityLoc(int iTurbLoc) { return turbineData[iTurbLoc].air_density; } + + //! Get the number of blades in local turbine number 'iTurbLoc' + int get_numBladesLoc(int iTurbLoc) { return turbineData[iTurbLoc].numBlades; } + //! Get the number of Aerodyn/velocity nodes on each blade in local turbine number 'iTurbLoc' + int get_numVelPtsBladeLoc(int iTurbLoc) { return turbineData[iTurbLoc].numVelPtsBlade; } + //! Get the number of Aerodyn/velocity nodes on the tower in local turbine number 'iTurbLoc' + int get_numVelPtsTwrLoc(int iTurbLoc) { return turbineData[iTurbLoc].numVelPtsTwr; } + //! Get the total number of Aerodyn/velocity nodes in local turbine number 'iTurbLoc' + int get_numVelPtsLoc(int iTurbLoc) { return turbineData[iTurbLoc].numVelPts; } + //! Get the number of Actuator/force nodes on each blade in local turbine number 'iTurbLoc' + int get_numForcePtsBladeLoc(int iTurbLoc) { return turbineData[iTurbLoc].numForcePtsBlade; } + //! Get the number of Actuator/force nodes on the tower in local turbine number 'iTurbLoc' + int get_numForcePtsTwrLoc(int iTurbLoc) { return turbineData[iTurbLoc].numForcePtsTwr; } + //! Get the total number of Actuator/force nodes in local turbine number 'iTurbLoc' + int get_numForcePtsLoc(int iTurbLoc) { return turbineData[iTurbLoc].numForcePts; } + + //! Get reference positions of blade-resolved FSI nodes from OpenFAST + void get_ref_positions_from_openfast(int iTurb); void loadSuperController(const fastInputs & fi); - void setOutputsToFAST(OpFM_InputType_t cDriver_Input_from_FAST, OpFM_OutputType_t cDriver_Output_to_FAST) ; // An example to set velocities at the Aerodyn nodes - void applyVelocityData(int iPrestart, int iTurb, OpFM_OutputType_t cDriver_Output_to_FAST, std::vector & velData) ; + //! Apply the velocity data at the Aerodyn nodes in 'velData' to turbine number 'iTurb' at time step 'iPrestart' through the data structure 'cDriver_Output_to_FAST' + void applyVelocityData(int iPrestart, int iTurb, ExtInfw_OutputType_t o_t_FAST, std::vector & velData) ; + + //! Compute cross product a x b and store it into aCrossB + void cross(double * a, double * b, double * aCrossB); + //! Apply a Wiener-Milenkovic rotation 'wm' to a vector 'r' into 'rRot'. To optionally transpose the rotation, set 'tranpose=-1.0'. + void applyWMrotation(double * wm, double * r, double *rRot, double transpose = 1.0); + //! Apply a Direction Cosine Matrix rotation 'dcm' to a vector 'r' into 'rRot'. To optionally transpose the rotation, set 'tranpose=-1.0'. + void applyDCMrotation(double * dcm, double * r, double *rRot, double transpose = 1.0); }; diff --git a/glue-codes/openfast-cpp/src/OpenFAST.cpp b/glue-codes/openfast-cpp/src/OpenFAST.cpp index 7a26e2017d..33a534f8dc 100644 --- a/glue-codes/openfast-cpp/src/OpenFAST.cpp +++ b/glue-codes/openfast-cpp/src/OpenFAST.cpp @@ -1,54 +1,627 @@ #include "OpenFAST.H" #include +#include #include +#include #include #include #include +#include + +inline void check_nc_error(int code, std::string msg) { + if (code != 0) + throw std::runtime_error("OpenFAST C++ API:: NetCDF error: " + msg); +} int fast::OpenFAST::AbortErrLev = ErrID_Fatal; // abort error level; compare with NWTC Library +int time_step_ratio(double fastDt, double driverDt, double epsFactor=1e-6) +{ + // ensure that the ratio is robust to integer conversion by making sure it will always truncate down + // provide an epsilon that is small relative to dtFast to help with integer conversion + const double eps = fastDt*epsFactor; + return static_cast((driverDt+eps)/fastDt); +} + //Constructor fast::fastInputs::fastInputs(): -nTurbinesGlob(0), -dryRun(false), -debug(false), -tStart(-1.0), -nEveryCheckPoint(-1), -tMax(0.0), -dtFAST(0.0), -scStatus(false), -scLibFile("") + nTurbinesGlob(0), + dryRun(false), + debug(false), + tStart(-1.0), + restartFreq(-1), + tMax(0.0), + dtDriver(0.0), + scStatus(false), + scLibFile("") { - //Nothing to do here + //Nothing to do here } +//Constructor +fast::OpenFAST::OpenFAST() +{ + sc = std::unique_ptr(new SuperController); + ncRstVarNames_ = {"time", "rst_filename", "twr_ref_pos", "bld_ref_pos", "nac_ref_pos", "hub_ref_pos", "twr_def", "twr_vel", "twr_ld", "bld_def", "bld_vel", "bld_ld", "hub_def", "hub_vel", "nac_def", "nac_vel", "bld_root_def", "bld_pitch", "x_vel", "vel_vel", "x_force", "xdot_force", "orient_force", "vel_force", "force"}; + ncRstDimNames_ = {"n_tsteps", "n_states", "n_twr_data", "n_bld_data", "n_pt_data", "n_bld_root_data", "n_bld_pitch_data", "n_vel_pts_data", "n_force_pts_data", "n_force_pts_orient_data"}; - - -//Constructor -fast::OpenFAST::OpenFAST(): -nTurbinesGlob(0), -nTurbinesProc(0), -scStatus(false), -simStart(fast::init), -timeZero(false) -{ + ncOutVarNames_ = {"time", "twr_ref_pos", "twr_ref_orient", "bld_chord", "bld_rloc", "bld_ref_pos", "bld_ref_orient", "hub_ref_pos", "hub_ref_orient", "nac_ref_pos", "nac_ref_orient", "twr_disp", "twr_orient", "twr_vel", "twr_rotvel", "twr_ld", "twr_moment", "bld_disp", "bld_orient", "bld_vel", "bld_rotvel", "bld_ld", "bld_ld_loc", "bld_moment", "hub_disp", "hub_orient", "hub_vel", "hub_rotvel", "nac_disp", "nac_orient", "nac_vel", "nac_rotvel", "bld_root_ref_pos", "bld_root_ref_orient", "bld_root_disp", "bld_root_orient"}; + ncOutDimNames_ = {"n_tsteps", "n_dim", "n_twr_nds", "n_blds", "n_bld_nds"}; } -fast::OpenFAST::~OpenFAST(){ } - inline bool fast::OpenFAST::checkFileExists(const std::string& name) { struct stat buffer; return (stat (name.c_str(), &buffer) == 0); } +void fast::OpenFAST::findRestartFile(int iTurbLoc) { + + int ncid; + size_t n_tsteps; + size_t count1 = 1; + double latest_time; + + //Find the file and open it in read only mode + std::stringstream rstfile_ss; + rstfile_ss << "turb_" ; + rstfile_ss << std::setfill('0') << std::setw(2) << turbineData[iTurbLoc].TurbID; + rstfile_ss << "_rst.nc"; + std::string rst_filename = rstfile_ss.str(); + int ierr = nc_open(rst_filename.c_str(), NC_NOWRITE, &ncid); + check_nc_error(ierr, "nc_open"); + + + for (auto const& dim_name: ncRstDimNames_) { + int tmpDimID; + ierr = nc_inq_dimid(ncid, dim_name.data(), &tmpDimID); + if (ierr == NC_NOERR) + ncRstDimIDs_[dim_name] = tmpDimID; + } + + for (auto const& var_name: ncRstVarNames_) { + int tmpVarID; + ierr = nc_inq_varid(ncid, var_name.data(), &tmpVarID); + if (ierr == NC_NOERR) + ncRstVarIDs_[var_name] = tmpVarID; + } + + ierr = nc_inq_dimlen(ncid, ncRstDimIDs_["n_tsteps"], &n_tsteps); + check_nc_error(ierr, "nc_inq_dimlen"); + n_tsteps -= 1; //To account for 0 based indexing + ierr = nc_get_vara_double(ncid, ncRstVarIDs_["time"], &n_tsteps, &count1, &latest_time); + check_nc_error(ierr, "nc_get_vara_double - getting latest time"); + tStart = latest_time; + + char tmpOutFileRoot[INTERFACE_STRING_LENGTH]; + ierr = nc_get_att_text(ncid, NC_GLOBAL, "out_file_root", tmpOutFileRoot); + turbineData[iTurbLoc].outFileRoot.assign(tmpOutFileRoot); + + ierr = nc_get_att_double(ncid, NC_GLOBAL, "dt_fast", &dtFAST); + check_nc_error(ierr, "nc_get_att_double"); + + ierr = nc_get_att_double(ncid, NC_GLOBAL, "dt_driver", &dtDriver); + check_nc_error(ierr, "nc_get_att_double"); + + ierr = nc_get_att_int(ncid, NC_GLOBAL, "output_freq", &outputFreq_); + check_nc_error(ierr, "nc_get_att_int"); + + ierr = nc_get_att_int(ncid, NC_GLOBAL, "restart_freq", &restartFreq_); + check_nc_error(ierr, "nc_get_att_int"); + + int tstep = std::round(latest_time/dtFAST); + + std::stringstream rstfilename; + rstfilename << turbineData[iTurbLoc].outFileRoot << "." << tstep ; + turbineData[iTurbLoc].FASTRestartFileName = rstfilename.str(); + + std::cout << "Restarting from time " << latest_time << " at time step " << tstep << " from file name " << turbineData[iTurbLoc].FASTRestartFileName << std::endl ; + + nc_close(ncid); + +} + +void fast::OpenFAST::prepareRestartFile(int iTurbLoc) { + + int ncid; + //This will destroy any existing file + std::stringstream rstfile_ss; + rstfile_ss << "turb_" ; + rstfile_ss << std::setfill('0') << std::setw(2) << turbineData[iTurbLoc].TurbID; + rstfile_ss << "_rst.nc"; + std::string rst_filename = rstfile_ss.str(); + int ierr = nc_create(rst_filename.c_str(), NC_CLOBBER, &ncid); + check_nc_error(ierr, "nc_create"); + + nc_put_att_text(ncid, NC_GLOBAL, "out_file_root", turbineData[iTurbLoc].outFileRoot.size()+1, turbineData[iTurbLoc].outFileRoot.c_str()); + nc_put_att_double(ncid, NC_GLOBAL, "dt_fast", NC_DOUBLE, 1, &dtFAST); + nc_put_att_double(ncid, NC_GLOBAL, "dt_driver", NC_DOUBLE, 1, &dtDriver); + nc_put_att_int(ncid,NC_GLOBAL,"output_freq", NC_INT, 1, &outputFreq_); + nc_put_att_int(ncid,NC_GLOBAL,"restart_freq", NC_INT, 1, &restartFreq_); + + //Define dimensions + int tmpDimID; + ierr = nc_def_dim(ncid, "n_tsteps", NC_UNLIMITED, &tmpDimID); + ncRstDimIDs_["n_tsteps"] = tmpDimID; + ierr = nc_def_dim(ncid, "n_states", 4, &tmpDimID); + ncRstDimIDs_["n_states"] = tmpDimID; + + //Define variables + int tmpVarID; + ierr = nc_def_var(ncid, "time", NC_DOUBLE, 1, &ncRstDimIDs_["n_tsteps"], &tmpVarID); + ncRstVarIDs_["time"] = tmpVarID; + + if (turbineData[iTurbLoc].sType == EXTLOADS) { + + ierr = nc_def_dim(ncid, "n_twr_data", turbineData[iTurbLoc].nBRfsiPtsTwr*6, &tmpDimID); + ncRstDimIDs_["n_twr_data"] = tmpDimID; + ierr = nc_def_dim(ncid,"n_bld_data", turbineData[iTurbLoc].nTotBRfsiPtsBlade*6, &tmpDimID); + ncRstDimIDs_["n_bld_data"] = tmpDimID; + ierr = nc_def_dim(ncid,"n_bld_root_data", turbineData[iTurbLoc].numBlades*6, &tmpDimID); + ncRstDimIDs_["n_bld_root_data"] = tmpDimID; + ierr = nc_def_dim(ncid,"n_bld_pitch_data", turbineData[iTurbLoc].numBlades, &tmpDimID); + ncRstDimIDs_["n_bld_pitch_data"] = tmpDimID; + ierr = nc_def_dim(ncid,"n_pt_data", 6, &tmpDimID); + ncRstDimIDs_["n_pt_data"] = tmpDimID; + + const std::vector twrDefLoadsDims{ncRstDimIDs_["n_tsteps"], ncRstDimIDs_["n_states"], ncRstDimIDs_["n_twr_data"]}; + const std::vector bldDefLoadsDims{ncRstDimIDs_["n_tsteps"], ncRstDimIDs_["n_states"], ncRstDimIDs_["n_bld_data"]}; + const std::vector bldRootDefsDims{ncRstDimIDs_["n_tsteps"], ncRstDimIDs_["n_states"], ncRstDimIDs_["n_bld_root_data"]}; + const std::vector bldPitchDims{ncRstDimIDs_["n_tsteps"], ncRstDimIDs_["n_states"], ncRstDimIDs_["n_bld_pitch_data"]}; + const std::vector ptDefLoadsDims{ncRstDimIDs_["n_tsteps"], ncRstDimIDs_["n_states"], ncRstDimIDs_["n_pt_data"],}; + + ierr = nc_def_var(ncid, "twr_def", NC_DOUBLE, 3, twrDefLoadsDims.data(), &tmpVarID); + ncRstVarIDs_["twr_def"] = tmpVarID; + ierr = nc_def_var(ncid, "twr_vel", NC_DOUBLE, 3, twrDefLoadsDims.data(), &tmpVarID); + ncRstVarIDs_["twr_vel"] = tmpVarID; + ierr = nc_def_var(ncid, "twr_ld", NC_DOUBLE, 3, twrDefLoadsDims.data(), &tmpVarID); + ncRstVarIDs_["twr_ld"] = tmpVarID; + ierr = nc_def_var(ncid, "bld_def", NC_DOUBLE, 3, bldDefLoadsDims.data(), &tmpVarID); + ncRstVarIDs_["bld_def"] = tmpVarID; + ierr = nc_def_var(ncid, "bld_vel", NC_DOUBLE, 3, bldDefLoadsDims.data(), &tmpVarID); + ncRstVarIDs_["bld_vel"] = tmpVarID; + ierr = nc_def_var(ncid, "bld_ld", NC_DOUBLE, 3, bldDefLoadsDims.data(), &tmpVarID); + ncRstVarIDs_["bld_ld"] = tmpVarID; + ierr = nc_def_var(ncid, "hub_def", NC_DOUBLE, 3, ptDefLoadsDims.data(), &tmpVarID); + ncRstVarIDs_["hub_def"] = tmpVarID; + ierr = nc_def_var(ncid, "hub_vel", NC_DOUBLE, 3, ptDefLoadsDims.data(), &tmpVarID); + ncRstVarIDs_["hub_vel"] = tmpVarID; + ierr = nc_def_var(ncid, "nac_def", NC_DOUBLE, 3, ptDefLoadsDims.data(), &tmpVarID); + ncRstVarIDs_["nac_def"] = tmpVarID; + ierr = nc_def_var(ncid, "nac_vel", NC_DOUBLE, 3, ptDefLoadsDims.data(), &tmpVarID); + ncRstVarIDs_["nac_vel"] = tmpVarID; + ierr = nc_def_var(ncid, "bld_root_def", NC_DOUBLE, 3, bldRootDefsDims.data(), &tmpVarID); + ncRstVarIDs_["bld_root_def"] = tmpVarID; + ierr = nc_def_var(ncid, "bld_pitch", NC_DOUBLE, 3, bldPitchDims.data(), &tmpVarID); + ncRstVarIDs_["bld_pitch"] = tmpVarID; + + } else if (turbineData[iTurbLoc].sType == EXTINFLOW) { + + ierr = nc_def_dim(ncid, "n_vel_pts_data", turbineData[iTurbLoc].numVelPts*3, &tmpDimID); + ncRstDimIDs_["n_vel_pts_data"] = tmpDimID; + ierr = nc_def_dim(ncid, "n_force_pts_data", turbineData[iTurbLoc].numForcePts*3, &tmpDimID); + ncRstDimIDs_["n_force_pts_data"] = tmpDimID; + ierr = nc_def_dim(ncid, "n_force_pts_orient_data", turbineData[iTurbLoc].numForcePts*9, &tmpDimID); + ncRstDimIDs_["n_force_pts_orient_data"] = tmpDimID; + + const std::vector velPtsDataDims{ncRstDimIDs_["n_tsteps"], ncRstDimIDs_["n_states"], ncRstDimIDs_["n_vel_pts_data"]}; + const std::vector forcePtsDataDims{ncRstDimIDs_["n_tsteps"], ncRstDimIDs_["n_states"], ncRstDimIDs_["n_force_pts_data"],}; + const std::vector forcePtsOrientDataDims{ncRstDimIDs_["n_tsteps"], ncRstDimIDs_["n_states"], ncRstDimIDs_["n_force_pts_orient_data"],}; + + ierr = nc_def_var(ncid, "x_vel", NC_DOUBLE, 3, velPtsDataDims.data(), &tmpVarID); + ncRstVarIDs_["x_vel"] = tmpVarID; + ierr = nc_def_var(ncid, "vel_vel", NC_DOUBLE, 3, velPtsDataDims.data(), &tmpVarID); + ncRstVarIDs_["vel_vel"] = tmpVarID; + ierr = nc_def_var(ncid, "xref_force", NC_DOUBLE, 1, &ncRstDimIDs_["n_force_pts_data"], &tmpVarID); + ncRstVarIDs_["xref_force"] = tmpVarID; + ierr = nc_def_var(ncid, "x_force", NC_DOUBLE, 3, forcePtsDataDims.data(), &tmpVarID); + ncRstVarIDs_["x_force"] = tmpVarID; + ierr = nc_def_var(ncid, "xdot_force", NC_DOUBLE, 3, forcePtsDataDims.data(), &tmpVarID); + ncRstVarIDs_["xdot_force"] = tmpVarID; + ierr = nc_def_var(ncid, "vel_force", NC_DOUBLE, 3, forcePtsDataDims.data(), &tmpVarID); + ncRstVarIDs_["vel_force"] = tmpVarID; + ierr = nc_def_var(ncid, "force", NC_DOUBLE, 3, forcePtsDataDims.data(), &tmpVarID); + ncRstVarIDs_["force"] = tmpVarID; + ierr = nc_def_var(ncid, "orient_force", NC_DOUBLE, 3, forcePtsOrientDataDims.data(), &tmpVarID); + ncRstVarIDs_["orient_force"] = tmpVarID; + + } + + //! Indicate that we are done defining variables, ready to write data + ierr = nc_enddef(ncid); + check_nc_error(ierr, "nc_enddef"); + + if ( (turbineData[iTurbLoc].sType == EXTINFLOW) && (turbineData[iTurbLoc].inflowType == 2) ) { + + int nfpts_data = 3*get_numForcePtsLoc(iTurbLoc); + int ierr = nc_put_var_double(ncid, ncRstVarIDs_["xref_force"], velForceNodeData[iTurbLoc][fast::STATE_NP1].xref_force.data()); + } + + ierr = nc_close(ncid); + check_nc_error(ierr, "nc_close"); + + +} + +void fast::OpenFAST::findOutputFile(int iTurbLoc) { + + int ncid; + size_t n_tsteps; + size_t count1 = 1; + double latest_time; + + //Find the file and open it in read only mode + std::stringstream outfile_ss; + outfile_ss << "turb_" ; + outfile_ss << std::setfill('0') << std::setw(2) << turbineData[iTurbLoc].TurbID; + outfile_ss << "_output.nc"; + std::string out_filename = outfile_ss.str(); + int ierr = nc_open(out_filename.c_str(), NC_NOWRITE, &ncid); + check_nc_error(ierr, "nc_open"); + + + for (auto const& dim_name: ncOutDimNames_) { + int tmpDimID; + ierr = nc_inq_dimid(ncid, dim_name.data(), &tmpDimID); + if (ierr == NC_NOERR) + ncOutDimIDs_[dim_name] = tmpDimID; + } + + for (auto const& var_name: ncOutVarNames_) { + int tmpVarID; + ierr = nc_inq_varid(ncid, var_name.data(), &tmpVarID); + if (ierr == NC_NOERR) + ncOutVarIDs_[var_name] = tmpVarID; + } + + ierr = nc_inq_dimlen(ncid, ncOutDimIDs_["n_tsteps"], &n_tsteps); + check_nc_error(ierr, "nc_inq_dimlen"); + n_tsteps -= 1; //To account for 0 based indexing + ierr = nc_get_vara_double(ncid, ncOutVarIDs_["time"], &n_tsteps, &count1, &latest_time); + check_nc_error(ierr, "nc_get_vara_double - getting latest time"); + nc_close(ncid); + +} + +void fast::OpenFAST::prepareOutputFile(int iTurbLoc) { + + int ncid; + //Create the file - this will destory any file + std::stringstream defloads_fstream; + defloads_fstream << "turb_" ; + defloads_fstream << std::setfill('0') << std::setw(2) << turbineData[iTurbLoc].TurbID; + defloads_fstream << "_output.nc"; + std::string defloads_filename = defloads_fstream.str(); + int ierr = nc_create(defloads_filename.c_str(), NC_CLOBBER, &ncid); + check_nc_error(ierr, "nc_create"); + + //Define dimensions + int tmpDimID; + ierr = nc_def_dim(ncid, "n_dim", 3, &tmpDimID); + ncOutDimIDs_["n_dim"] = tmpDimID; + ierr = nc_def_dim(ncid, "n_tsteps", NC_UNLIMITED, &tmpDimID); + ncOutDimIDs_["n_tsteps"] = tmpDimID; + + //Now define variables + int tmpVarID; + ierr = nc_def_var(ncid, "time", NC_DOUBLE, 1, &ncOutDimIDs_["n_tsteps"], &tmpVarID); + ncOutVarIDs_["time"] = tmpVarID; + + if (turbineData[iTurbLoc].sType == EXTLOADS) { + + int nBlades = turbineData[iTurbLoc].numBlades; + int nTwrPts = turbineData[iTurbLoc].nBRfsiPtsTwr; + int nTotBldPts = turbineData[iTurbLoc].nTotBRfsiPtsBlade; + int nBldPts = nTotBldPts/nBlades; + + ierr = nc_def_dim(ncid, "n_twr_nds", nTwrPts, &tmpDimID); + ncOutDimIDs_["n_twr_nds"] = tmpDimID; + ierr = nc_def_dim(ncid,"n_blds", nBlades, &tmpDimID); + ncOutDimIDs_["n_blds"] = tmpDimID; + ierr = nc_def_dim(ncid, "n_bld_nds", nBldPts, &tmpDimID); + ncOutDimIDs_["n_bld_nds"] = tmpDimID; + + const std::vector twrRefDims{ncOutDimIDs_["n_dim"], ncOutDimIDs_["n_twr_nds"]}; + const std::vector twrDefLoadsDims{ncOutDimIDs_["n_tsteps"], ncOutDimIDs_["n_dim"], ncOutDimIDs_["n_twr_nds"]}; + const std::vector bldParamDims{ncOutDimIDs_["n_blds"], ncOutDimIDs_["n_bld_nds"]}; + const std::vector bldRefDims{ncOutDimIDs_["n_blds"], ncOutDimIDs_["n_dim"], ncOutDimIDs_["n_bld_nds"]}; + const std::vector bldRootRefDims{ncOutDimIDs_["n_blds"], ncOutDimIDs_["n_dim"]}; + const std::vector bldDefLoadsDims{ncOutDimIDs_["n_tsteps"], ncOutDimIDs_["n_blds"], ncOutDimIDs_["n_dim"], ncOutDimIDs_["n_bld_nds"]}; + const std::vector bldRootDefDims{ncOutDimIDs_["n_tsteps"], ncOutDimIDs_["n_blds"], ncOutDimIDs_["n_dim"]}; + const std::vector ptRefDims{ncOutDimIDs_["n_dim"]}; + const std::vector ptDefLoadsDims{ncOutDimIDs_["n_tsteps"], ncOutDimIDs_["n_dim"]}; + + ierr = nc_def_var(ncid, "twr_ref_pos", NC_DOUBLE, 2, twrRefDims.data(), &tmpVarID); + ncOutVarIDs_["twr_ref_pos"] = tmpVarID; + ierr = nc_def_var(ncid, "twr_ref_orient", NC_DOUBLE, 2, twrRefDims.data(), &tmpVarID); + ncOutVarIDs_["twr_ref_orient"] = tmpVarID; + ierr = nc_def_var(ncid, "bld_chord", NC_DOUBLE, 2, bldParamDims.data(), &tmpVarID); + ncOutVarIDs_["bld_chord"] = tmpVarID; + ierr = nc_def_var(ncid, "bld_rloc", NC_DOUBLE, 2, bldParamDims.data(), &tmpVarID); + ncOutVarIDs_["bld_rloc"] = tmpVarID; + ierr = nc_def_var(ncid, "bld_ref_pos", NC_DOUBLE, 3, bldRefDims.data(), &tmpVarID); + ncOutVarIDs_["bld_ref_pos"] = tmpVarID; + ierr = nc_def_var(ncid, "bld_ref_orient", NC_DOUBLE, 3, bldRefDims.data(), &tmpVarID); + ncOutVarIDs_["bld_ref_orient"] = tmpVarID; + + ierr = nc_def_var(ncid, "bld_root_ref_pos", NC_DOUBLE, 2, bldRootRefDims.data(), &tmpVarID); + ncOutVarIDs_["bld_root_ref_pos"] = tmpVarID; + ierr = nc_def_var(ncid, "bld_root_ref_orient", NC_DOUBLE, 2, bldRootRefDims.data(), &tmpVarID); + ncOutVarIDs_["bld_root_ref_orient"] = tmpVarID; + + ierr = nc_def_var(ncid, "hub_ref_pos", NC_DOUBLE, 1, ptRefDims.data(), &tmpVarID); + ncOutVarIDs_["hub_ref_pos"] = tmpVarID; + ierr = nc_def_var(ncid, "hub_ref_orient", NC_DOUBLE, 1, ptRefDims.data(), &tmpVarID); + ncOutVarIDs_["hub_ref_orient"] = tmpVarID; + ierr = nc_def_var(ncid, "nac_ref_pos", NC_DOUBLE, 1, ptRefDims.data(), &tmpVarID); + ncOutVarIDs_["nac_ref_pos"] = tmpVarID; + ierr = nc_def_var(ncid, "nac_ref_orient", NC_DOUBLE, 1, ptRefDims.data(), &tmpVarID); + ncOutVarIDs_["nac_ref_orient"] = tmpVarID; + + ierr = nc_def_var(ncid, "twr_disp", NC_DOUBLE, 3, twrDefLoadsDims.data(), &tmpVarID); + ncOutVarIDs_["twr_disp"] = tmpVarID; + ierr = nc_def_var(ncid, "twr_orient", NC_DOUBLE, 3, twrDefLoadsDims.data(), &tmpVarID); + ncOutVarIDs_["twr_orient"] = tmpVarID; + ierr = nc_def_var(ncid, "twr_vel", NC_DOUBLE, 3, twrDefLoadsDims.data(), &tmpVarID); + ncOutVarIDs_["twr_vel"] = tmpVarID; + ierr = nc_def_var(ncid, "twr_rotvel", NC_DOUBLE, 3, twrDefLoadsDims.data(), &tmpVarID); + ncOutVarIDs_["twr_rotvel"] = tmpVarID; + ierr = nc_def_var(ncid, "twr_ld", NC_DOUBLE, 3, twrDefLoadsDims.data(), &tmpVarID); + ncOutVarIDs_["twr_ld"] = tmpVarID; + ierr = nc_def_var(ncid, "twr_moment", NC_DOUBLE, 3, twrDefLoadsDims.data(), &tmpVarID); + ncOutVarIDs_["twr_moment"] = tmpVarID; + + ierr = nc_def_var(ncid, "bld_disp", NC_DOUBLE, 4, bldDefLoadsDims.data(), &tmpVarID); + ncOutVarIDs_["bld_disp"] = tmpVarID; + ierr = nc_def_var(ncid, "bld_orient", NC_DOUBLE, 4, bldDefLoadsDims.data(), &tmpVarID); + ncOutVarIDs_["bld_orient"] = tmpVarID; + ierr = nc_def_var(ncid, "bld_vel", NC_DOUBLE, 4, bldDefLoadsDims.data(), &tmpVarID); + ncOutVarIDs_["bld_vel"] = tmpVarID; + ierr = nc_def_var(ncid, "bld_rotvel", NC_DOUBLE, 4, bldDefLoadsDims.data(), &tmpVarID); + ncOutVarIDs_["bld_rotvel"] = tmpVarID; + + ierr = nc_def_var(ncid, "bld_root_disp", NC_DOUBLE, 3, bldRootDefDims.data(), &tmpVarID); + ncOutVarIDs_["bld_root_disp"] = tmpVarID; + ierr = nc_def_var(ncid, "bld_root_orient", NC_DOUBLE, 3, bldRootDefDims.data(), &tmpVarID); + ncOutVarIDs_["bld_root_orient"] = tmpVarID; + + ierr = nc_def_var(ncid, "bld_ld", NC_DOUBLE, 4, bldDefLoadsDims.data(), &tmpVarID); + ncOutVarIDs_["bld_ld"] = tmpVarID; + ierr = nc_def_var(ncid, "bld_ld_loc", NC_DOUBLE, 4, bldDefLoadsDims.data(), &tmpVarID); + ncOutVarIDs_["bld_ld_loc"] = tmpVarID; + ierr = nc_def_var(ncid, "bld_moment", NC_DOUBLE, 4, bldDefLoadsDims.data(), &tmpVarID); + ncOutVarIDs_["bld_moment"] = tmpVarID; + ierr = nc_def_var(ncid, "hub_disp", NC_DOUBLE, 2, ptDefLoadsDims.data(), &tmpVarID); + ncOutVarIDs_["hub_disp"] = tmpVarID; + ierr = nc_def_var(ncid, "hub_orient", NC_DOUBLE, 2, ptDefLoadsDims.data(), &tmpVarID); + ncOutVarIDs_["hub_orient"] = tmpVarID; + ierr = nc_def_var(ncid, "hub_vel", NC_DOUBLE, 2, ptDefLoadsDims.data(), &tmpVarID); + ncOutVarIDs_["hub_vel"] = tmpVarID; + ierr = nc_def_var(ncid, "hub_rotvel", NC_DOUBLE, 2, ptDefLoadsDims.data(), &tmpVarID); + ncOutVarIDs_["hub_rotvel"] = tmpVarID; + ierr = nc_def_var(ncid, "nac_disp", NC_DOUBLE, 2, ptDefLoadsDims.data(), &tmpVarID); + ncOutVarIDs_["nac_disp"] = tmpVarID; + ierr = nc_def_var(ncid, "nac_orient", NC_DOUBLE, 2, ptDefLoadsDims.data(), &tmpVarID); + ncOutVarIDs_["nac_orient"] = tmpVarID; + ierr = nc_def_var(ncid, "nac_vel", NC_DOUBLE, 2, ptDefLoadsDims.data(), &tmpVarID); + ncOutVarIDs_["nac_vel"] = tmpVarID; + ierr = nc_def_var(ncid, "nac_rotvel", NC_DOUBLE, 2, ptDefLoadsDims.data(), &tmpVarID); + ncOutVarIDs_["nac_rotvel"] = tmpVarID; + + } else if (turbineData[iTurbLoc].sType == EXTINFLOW) { + + int nBlades = get_numBladesLoc(iTurbLoc); + int nBldPts = get_numForcePtsBladeLoc(iTurbLoc); + int nTwrPts = get_numForcePtsTwrLoc(iTurbLoc); + + ierr = nc_def_dim(ncid, "n_twr_nds", nTwrPts, &tmpDimID); + ncOutDimIDs_["n_twr_nds"] = tmpDimID; + ierr = nc_def_dim(ncid,"n_blds", nBlades, &tmpDimID); + ncOutDimIDs_["n_blds"] = tmpDimID; + ierr = nc_def_dim(ncid, "n_bld_nds", nBldPts, &tmpDimID); + ncOutDimIDs_["n_bld_nds"] = tmpDimID; + + const std::vector twrRefDataDims{ncOutDimIDs_["n_dim"], ncOutDimIDs_["n_twr_nds"]}; + const std::vector twrDataDims{ncOutDimIDs_["n_tsteps"], ncOutDimIDs_["n_dim"], ncOutDimIDs_["n_twr_nds"]}; + const std::vector bldParamDims{ncOutDimIDs_["n_blds"], ncOutDimIDs_["n_bld_nds"]}; + const std::vector bldRefDataDims{ncOutDimIDs_["n_blds"], ncOutDimIDs_["n_dim"], ncOutDimIDs_["n_bld_nds"]}; + const std::vector bldDataDims{ncOutDimIDs_["n_tsteps"], ncOutDimIDs_["n_blds"], ncOutDimIDs_["n_dim"], ncOutDimIDs_["n_bld_nds"]}; + const std::vector ptRefDataDims{ncOutDimIDs_["n_dim"]}; + const std::vector ptDataDims{ncOutDimIDs_["n_tsteps"], ncOutDimIDs_["n_dim"]}; + + ierr = nc_def_var(ncid, "bld_chord", NC_DOUBLE, 2, bldParamDims.data(), &tmpVarID); + ncOutVarIDs_["bld_chord"] = tmpVarID; + + ierr = nc_def_var(ncid, "twr_ref_pos", NC_DOUBLE, 2, twrRefDataDims.data(), &tmpVarID); + ncOutVarIDs_["twr_ref_pos"] = tmpVarID; + ierr = nc_def_var(ncid, "twr_disp", NC_DOUBLE, 3, twrDataDims.data(), &tmpVarID); + ncOutVarIDs_["twr_disp"] = tmpVarID; + ierr = nc_def_var(ncid, "twr_vel", NC_DOUBLE, 3, twrDataDims.data(), &tmpVarID); + ncOutVarIDs_["twr_vel"] = tmpVarID; + ierr = nc_def_var(ncid, "twr_ld", NC_DOUBLE, 3, twrDataDims.data(), &tmpVarID); + ncOutVarIDs_["twr_ld"] = tmpVarID; + + ierr = nc_def_var(ncid, "bld_ref_pos", NC_DOUBLE, 3, bldRefDataDims.data(), &tmpVarID); + ncOutVarIDs_["bld_ref_pos"] = tmpVarID; + ierr = nc_def_var(ncid, "bld_disp", NC_DOUBLE, 4, bldDataDims.data(), &tmpVarID); + ncOutVarIDs_["bld_disp"] = tmpVarID; + ierr = nc_def_var(ncid, "bld_vel", NC_DOUBLE, 4, bldDataDims.data(), &tmpVarID); + ncOutVarIDs_["bld_vel"] = tmpVarID; + ierr = nc_def_var(ncid, "bld_ld", NC_DOUBLE, 4, bldDataDims.data(), &tmpVarID); + ncOutVarIDs_["bld_ld"] = tmpVarID; + ierr = nc_def_var(ncid, "bld_ld_loc", NC_DOUBLE, 4, bldDataDims.data(), &tmpVarID); + ncOutVarIDs_["bld_ld_loc"] = tmpVarID; + ierr = nc_def_var(ncid, "hub_ref_pos", NC_DOUBLE, 1, ptRefDataDims.data(), &tmpVarID); + ncOutVarIDs_["hub_ref_pos"] = tmpVarID; + ierr = nc_def_var(ncid, "hub_disp", NC_DOUBLE, 2, ptDataDims.data(), &tmpVarID); + ncOutVarIDs_["hub_disp"] = tmpVarID; + ierr = nc_def_var(ncid, "hub_vel", NC_DOUBLE, 2, ptDataDims.data(), &tmpVarID); + ncOutVarIDs_["hub_vel"] = tmpVarID; + ierr = nc_def_var(ncid, "hub_rotvel", NC_DOUBLE, 2, ptDataDims.data(), &tmpVarID); + ncOutVarIDs_["hub_rotvel"] = tmpVarID; + + ierr = nc_def_var(ncid, "nac_ref_pos", NC_DOUBLE, 1, ptRefDataDims.data(), &tmpVarID); + ncOutVarIDs_["nac_ref_pos"] = tmpVarID; + ierr = nc_def_var(ncid, "nac_disp", NC_DOUBLE, 2, ptDataDims.data(), &tmpVarID); + ncOutVarIDs_["nac_disp"] = tmpVarID; + ierr = nc_def_var(ncid, "nac_vel", NC_DOUBLE, 2, ptDataDims.data(), &tmpVarID); + ncOutVarIDs_["nac_vel"] = tmpVarID; + ierr = nc_def_var(ncid, "nac_rotvel", NC_DOUBLE, 2, ptDataDims.data(), &tmpVarID); + ncOutVarIDs_["nac_rotvel"] = tmpVarID; + + } + + //! Indicate that we are done defining variables, ready to write data + ierr = nc_enddef(ncid); + check_nc_error(ierr, "nc_enddef"); + + if (turbineData[iTurbLoc].sType == EXTLOADS) { + + int nBlades = turbineData[iTurbLoc].numBlades; + int nTwrPts = turbineData[iTurbLoc].nBRfsiPtsTwr; + int nTotBldPts = turbineData[iTurbLoc].nTotBRfsiPtsBlade; + int nBldPts = nTotBldPts/nBlades; + + std::vector tmpArray; + + tmpArray.resize(nTwrPts); + { + std::vector count_dim{1,static_cast(nTwrPts)}; + for (size_t idim=0;idim < 3; idim++) { + for (size_t i=0; i < nTwrPts; i++) + tmpArray[i] = brFSIData[iTurbLoc][3].twr_ref_pos[i*6+idim]; + std::vector start_dim{idim,0}; + ierr = nc_put_vara_double(ncid, ncOutVarIDs_["twr_ref_pos"], start_dim.data(), + count_dim.data(), tmpArray.data()); + } + for (size_t idim=0;idim < 3; idim++) { + for (size_t i=0; i < nTwrPts; i++) + tmpArray[i] = brFSIData[iTurbLoc][3].twr_ref_pos[i*6+3+idim]; + std::vector start_dim{idim,0}; + ierr = nc_put_vara_double(ncid, ncOutVarIDs_["twr_ref_orient"], start_dim.data(), + count_dim.data(), tmpArray.data()); + } + } + + tmpArray.resize(nBldPts); + { + std::vector count_dim{1,1,static_cast(nBldPts)}; + for (size_t iDim=0;iDim < 3; iDim++) { + int iStart = 0 ; + for (size_t iBlade=0; iBlade < nBlades; iBlade++) { + for (auto i=0; i < nBldPts; i++) { + tmpArray[i] = brFSIData[iTurbLoc][3].bld_ref_pos[(iStart*6)+iDim]; + iStart++; + } + std::vector start_dim{iBlade,iDim,0}; + ierr = nc_put_vara_double(ncid, ncOutVarIDs_["bld_ref_pos"], start_dim.data(), + count_dim.data(), tmpArray.data()); + } + } + for (size_t iDim=0;iDim < 3; iDim++) { + int iStart = 0 ; + for (size_t iBlade=0; iBlade < nBlades; iBlade++) { + for (auto i=0; i < nBldPts; i++) { + tmpArray[i] = brFSIData[iTurbLoc][3].bld_ref_pos[(iStart*6)+iDim+3]; + iStart++; + } + std::vector start_dim{iBlade,iDim,0}; + ierr = nc_put_vara_double(ncid, ncOutVarIDs_["bld_ref_orient"], start_dim.data(), + count_dim.data(), tmpArray.data()); + } + } + + std::vector param_count_dim{1,static_cast(nBldPts)}; + int iStart = 0 ; + for (size_t iBlade=0; iBlade < nBlades; iBlade++) { + for (size_t i=0; i < nBldPts; i++) { + tmpArray[i] = brFSIData[iTurbLoc][3].bld_chord[iStart]; + iStart++; + } + std::vector start_dim{iBlade,0}; + ierr = nc_put_vara_double(ncid, ncOutVarIDs_["bld_chord"], start_dim.data(), + param_count_dim.data(), tmpArray.data()); + } + iStart = 0 ; + for (size_t iBlade=0; iBlade < nBlades; iBlade++) { + for (size_t i=0; i < nBldPts; i++) { + tmpArray[i] = brFSIData[iTurbLoc][3].bld_rloc[iStart]; + iStart++; + } + std::vector start_dim{iBlade,0}; + ierr = nc_put_vara_double(ncid, ncOutVarIDs_["bld_rloc"], start_dim.data(), + param_count_dim.data(), tmpArray.data()); + } + } + + for (size_t iBlade=0; iBlade < nBlades; iBlade++) { + std::vector start_dim{iBlade,0}; + std::vector count_dim{1,3}; + ierr = nc_put_vara_double(ncid, ncOutVarIDs_["bld_root_ref_pos"], + start_dim.data(), + count_dim.data(), + &brFSIData[iTurbLoc][3].bld_root_ref_pos[iBlade*6+0]); + + ierr = nc_put_vara_double(ncid, ncOutVarIDs_["bld_root_ref_orient"], + start_dim.data(), + count_dim.data(), + &brFSIData[iTurbLoc][3].bld_root_ref_pos[iBlade*6+3]); + } + + ierr = nc_put_var_double(ncid, ncOutVarIDs_["nac_ref_pos"], + &brFSIData[iTurbLoc][3].nac_ref_pos[0]); + ierr = nc_put_var_double(ncid, ncOutVarIDs_["nac_ref_orient"], + &brFSIData[iTurbLoc][3].nac_ref_pos[3]); + + ierr = nc_put_var_double(ncid, ncOutVarIDs_["hub_ref_pos"], + &brFSIData[iTurbLoc][3].hub_ref_pos[0]); + ierr = nc_put_var_double(ncid, ncOutVarIDs_["hub_ref_orient"], + &brFSIData[iTurbLoc][3].hub_ref_pos[3]); + + } else if (turbineData[iTurbLoc].sType == EXTINFLOW) { + + int nBlades = get_numBladesLoc(iTurbLoc); + int nBldPts = get_numForcePtsBladeLoc(iTurbLoc); + int nTwrPts = get_numForcePtsTwrLoc(iTurbLoc); + + std::vector tmpArray; + + { + + tmpArray.resize(nBldPts); + std::vector count_dim{1,1,static_cast(nBldPts)}; + for (size_t iDim=0;iDim < 3; iDim++) { + for (size_t iBlade=0; iBlade < nBlades; iBlade++) { + int node_bld_start = (1 + iBlade * nBldPts); + for (auto i=0; i < nBldPts; i++) + tmpArray[i] = velForceNodeData[iTurbLoc][3].x_force[(node_bld_start+i)*3+iDim] ; + std::vector start_dim{iBlade,iDim,0}; + ierr = nc_put_vara_double(ncid, ncOutVarIDs_["bld_ref_pos"], start_dim.data(), count_dim.data(), tmpArray.data()); + } + } + + std::vector param_count_dim{1,static_cast(nBldPts)}; + for (size_t iBlade=0; iBlade < nBlades; iBlade++) { + int iStart = 1 + iBlade*nBldPts; + for (size_t i=0; i < nBldPts; i++) + tmpArray[i] = extinfw_i_f_FAST[iTurbLoc].forceNodesChord[iStart+i]; + std::vector start_dim{iBlade,0}; + ierr = nc_put_vara_double(ncid, ncOutVarIDs_["bld_chord"], start_dim.data(), + param_count_dim.data(), tmpArray.data()); + } + } + } + + ierr = nc_close(ncid); + check_nc_error(ierr, "nc_close"); + +} + + void fast::OpenFAST::init() { - // Temporary buffer to pass filenames to OpenFAST fortran subroutines - char currentFileName[INTERFACE_STRING_LENGTH]; - allocateMemory(); + allocateMemory_preInit(); if (!dryRun) { switch (simStart) { @@ -56,36 +629,58 @@ void fast::OpenFAST::init() { case fast::trueRestart: for (int iTurb=0; iTurb < nTurbinesProc; iTurb++) { - /* note that this will set nt_global inside the FAST library */ - std::copy( - CheckpointFileRoot[iTurb].data(), - CheckpointFileRoot[iTurb].data() + (CheckpointFileRoot[iTurb].size() + 1), - currentFileName - ); - FAST_OpFM_Restart( - &iTurb, - currentFileName, - &AbortErrLev, - &dtFAST, - &numBlades[iTurb], - &numVelPtsBlade[iTurb], - &ntStart, - &cDriver_Input_from_FAST[iTurb], - &cDriver_Output_to_FAST[iTurb], - &sc.ip_from_FAST[iTurb], - &sc.op_to_FAST[iTurb], - &ErrStat, - ErrMsg - ); - checkError(ErrStat, ErrMsg); + + findRestartFile(iTurb); + findOutputFile(iTurb); + char tmpRstFileRoot[INTERFACE_STRING_LENGTH]; + strncpy(tmpRstFileRoot, turbineData[iTurb].FASTRestartFileName.c_str(), turbineData[iTurb].FASTRestartFileName.size()); + tmpRstFileRoot[turbineData[iTurb].FASTRestartFileName.size()] = '\0'; + if (turbineData[iTurb].sType == EXTINFLOW) { + /* note that this will set nt_global inside the FAST library */ + FAST_ExtInfw_Restart( + &iTurb, + tmpRstFileRoot, + &AbortErrLev, + &turbineData[iTurb].dt, + &turbineData[iTurb].inflowType, + &turbineData[iTurb].numBlades, + &turbineData[iTurb].numVelPtsBlade, + &turbineData[iTurb].numVelPtsTwr, + &ntStart, + &extinfw_i_f_FAST[iTurb], + &extinfw_o_t_FAST[iTurb], + &sc->ip_from_FAST[iTurb], + &sc->op_to_FAST[iTurb], + &ErrStat, + ErrMsg); + checkError(ErrStat, ErrMsg); + } else if(turbineData[iTurb].sType == EXTLOADS) { + FAST_ExtLoads_Restart( + &iTurb, + tmpRstFileRoot, + &AbortErrLev, + &turbineData[iTurb].dt, + &turbineData[iTurb].numBlades, + &ntStart, + &extld_i_f_FAST[iTurb], + &extld_p_f_FAST[iTurb], + &extld_o_t_FAST[iTurb], + &sc->ip_from_FAST[iTurb], + &sc->op_to_FAST[iTurb], + &ErrStat, + ErrMsg); + turbineData[iTurb].inflowType = 0; + } + nt_global = ntStart; + allocateMemory_postInit(iTurb); - int nfpts = get_numForcePtsLoc(iTurb); - forceNodeVel[iTurb].resize(nfpts); - for (int k = 0; k < nfpts; k++) forceNodeVel[iTurb][k].resize(3) ; - } + get_ref_positions_from_openfast(iTurb); - if (nTurbinesProc > 0) velNodeDataFile = openVelocityDataFile(false); + readRestartFile(iTurb, nt_global); + + } + checkAndSetSubsteps(); if(scStatus) { std::cout << "Use of Supercontroller is not supported through the C++ API right now" << std::endl; @@ -96,373 +691,869 @@ void fast::OpenFAST::init() { case fast::init: - sc.init(scio, nTurbinesProc); + sc->init(scio, nTurbinesProc); if(scStatus) { std::cout << "Use of Supercontroller is not supported through the C++ API right now" << std::endl; // sc.init_sc(scio, nTurbinesProc, turbineMapProcToGlob, fastMPIComm); // sc.calcOutputs_n(0.0); - } - - // this calls the Init() routines of each module + } // this calls the Init() routines of each module for (int iTurb=0; iTurb < nTurbinesProc; iTurb++) { - int nodeClusterType = 0; - if (forcePtsBladeDistributionType[iTurb] == "chordClustered") - { - nodeClusterType = 1; - } - std::copy( - FASTInputFileName[iTurb].data(), - FASTInputFileName[iTurb].data() + (FASTInputFileName[iTurb].size() + 1), - currentFileName - ); - FAST_OpFM_Init( - &iTurb, - &tMax, - currentFileName, - &TurbID[iTurb], - &scio.nSC2CtrlGlob, - &scio.nSC2Ctrl, - &scio.nCtrl2SC, - scio.from_SCglob.data(), - scio.from_SC[iTurb].data(), - &numForcePtsBlade[iTurb], - &numForcePtsTwr[iTurb], - TurbineBasePos[iTurb].data(), - &AbortErrLev, - &dtFAST, - &numBlades[iTurb], - &numVelPtsBlade[iTurb], - &nodeClusterType, - &cDriver_Input_from_FAST[iTurb], - &cDriver_Output_to_FAST[iTurb], - &sc.ip_from_FAST[iTurb], - &sc.op_to_FAST[iTurb], - &ErrStat, - ErrMsg - ); - checkError(ErrStat, ErrMsg); - timeZero = true; + char tmpOutFileRoot[INTERFACE_STRING_LENGTH]; + char inputFileName[INTERFACE_STRING_LENGTH]; + if (turbineData[iTurb].sType == EXTINFLOW) { + + std::copy( + turbineData[iTurb].FASTInputFileName.data(), + turbineData[iTurb].FASTInputFileName.data() + (turbineData[iTurb].FASTInputFileName.size() + 1), + inputFileName + ); + FAST_ExtInfw_Init( + &iTurb, + &tMax, + inputFileName, + &turbineData[iTurb].TurbID, + tmpOutFileRoot, + &scio.nSC2CtrlGlob, + &scio.nSC2Ctrl, + &scio.nCtrl2SC, + scio.from_SCglob.data(), + scio.from_SC[iTurb].data(), + &turbineData[iTurb].numForcePtsBlade, + &turbineData[iTurb].numForcePtsTwr, + turbineData[iTurb].TurbineBasePos.data(), + &AbortErrLev, + &dtDriver, + &turbineData[iTurb].dt, + &turbineData[iTurb].inflowType, + &turbineData[iTurb].numBlades, + &turbineData[iTurb].numVelPtsBlade, + &turbineData[iTurb].numVelPtsTwr, + &turbineData[iTurb].nodeClusterType, + &extinfw_i_f_FAST[iTurb], + &extinfw_o_t_FAST[iTurb], + &sc->ip_from_FAST[iTurb], + &sc->op_to_FAST[iTurb], + &ErrStat, + ErrMsg); + checkError(ErrStat, ErrMsg); + + std::cerr << "turbineData[iTurb].inflowType = " << turbineData[iTurb].inflowType << std::endl; + + turbineData[iTurb].numVelPtsTwr = extinfw_o_t_FAST[iTurb].u_Len - turbineData[iTurb].numBlades*turbineData[iTurb].numVelPtsBlade - 1; + if(turbineData[iTurb].numVelPtsTwr == 0) { + turbineData[iTurb].numForcePtsTwr = 0; + std::cout << "Aerodyn doesn't want to calculate forces on the tower. All actuator points on the tower are turned off for turbine " << turbineMapProcToGlob[iTurb] << "." << std::endl ; + } + + } else if(turbineData[iTurb].sType == EXTLOADS) { + + char inputFileName[INTERFACE_STRING_LENGTH]; + FAST_ExtLoads_Init( + &iTurb, + &tMax, + turbineData[iTurb].FASTInputFileName.data(), + &turbineData[iTurb].TurbID, + tmpOutFileRoot, + turbineData[iTurb].TurbineBasePos.data(), + &AbortErrLev, + &dtDriver, + &turbineData[iTurb].dt, + &turbineData[iTurb].numBlades, + &turbineData[iTurb].azBlendMean, + &turbineData[iTurb].azBlendDelta, + &extld_i_f_FAST[iTurb], + &extld_p_f_FAST[iTurb], + &extld_o_t_FAST[iTurb], + &sc->ip_from_FAST[iTurb], + &sc->op_to_FAST[iTurb], + &ErrStat, + ErrMsg); + checkError(ErrStat, ErrMsg); + + turbineData[iTurb].inflowType = 0; - numVelPtsTwr[iTurb] = cDriver_Output_to_FAST[iTurb].u_Len - numBlades[iTurb]*numVelPtsBlade[iTurb] - 1; - if(numVelPtsTwr[iTurb] == 0) { - numForcePtsTwr[iTurb] = 0; - std::cout << "Aerodyn doesn't want to calculate forces on the tower. All actuator points on the tower are turned off for turbine " << turbineMapProcToGlob[iTurb] << "." << std::endl ; } + timeZero = true; - int nfpts = get_numForcePtsLoc(iTurb); - forceNodeVel[iTurb].resize(nfpts); - for (int k = 0; k < nfpts; k++) forceNodeVel[iTurb][k].resize(3) ; + turbineData[iTurb].outFileRoot.assign(tmpOutFileRoot, strlen(tmpOutFileRoot)); - if ( isDebug() ) { - for (int iNode=0; iNode < get_numVelPtsLoc(iTurb); iNode++) { - std::cout << "Node " << iNode << " Position = " << cDriver_Input_from_FAST[iTurb].pxVel[iNode] << " " << cDriver_Input_from_FAST[iTurb].pyVel[iNode] << " " << cDriver_Input_from_FAST[iTurb].pzVel[iNode] << " " << std::endl ; - } - } - } + allocateMemory_postInit(iTurb); + + get_data_from_openfast(fast::STATE_NM2); + get_data_from_openfast(fast::STATE_NM1); + get_data_from_openfast(fast::STATE_N); + get_data_from_openfast(fast::STATE_NP1); - if (nTurbinesProc > 0) velNodeDataFile = openVelocityDataFile(true); + get_ref_positions_from_openfast(iTurb); + + } + timeZero = true; + checkAndSetSubsteps(); break ; case fast::restartDriverInitFAST: - sc.init(scio, nTurbinesProc); + //sc->init(scio, nTurbinesProc); if(scStatus) { std::cout << "Use of Supercontroller is not supported through the C++ API right now" << std::endl; // sc.init_sc(scio, nTurbinesProc, turbineMapProcToGlob, fastMPIComm); // sc.calcOutputs_n(0.0); } - + for (int iTurb=0; iTurb < nTurbinesProc; iTurb++) { - int nodeClusterType = 0; - if (forcePtsBladeDistributionType[iTurb] == "chordClustered") - { - nodeClusterType = 1; - } - std::copy( - FASTInputFileName[iTurb].data(), - FASTInputFileName[iTurb].data() + (FASTInputFileName[iTurb].size() + 1), - currentFileName - ); - FAST_OpFM_Init( - &iTurb, - &tMax, - currentFileName, - &TurbID[iTurb], - &scio.nSC2CtrlGlob, - &scio.nSC2Ctrl, - &scio.nCtrl2SC, - scio.from_SCglob.data(), - scio.from_SC[iTurb].data(), - &numForcePtsBlade[iTurb], - &numForcePtsTwr[iTurb], - TurbineBasePos[iTurb].data(), - &AbortErrLev, - &dtFAST, - &numBlades[iTurb], - &numVelPtsBlade[iTurb], - &nodeClusterType, - &cDriver_Input_from_FAST[iTurb], - &cDriver_Output_to_FAST[iTurb], - &sc.ip_from_FAST[iTurb], - &sc.op_to_FAST[iTurb], - &ErrStat, - ErrMsg - ); - checkError(ErrStat, ErrMsg); - timeZero = true; + findOutputFile(iTurb); + findRestartFile(iTurb); + char tmpOutFileRoot[INTERFACE_STRING_LENGTH]; + char inputFileName[INTERFACE_STRING_LENGTH]; + if (turbineData[iTurb].sType == EXTINFLOW) { + + std::copy( + turbineData[iTurb].FASTInputFileName.data(), + turbineData[iTurb].FASTInputFileName.data() + (turbineData[iTurb].FASTInputFileName.size() + 1), + inputFileName + ); + + FAST_ExtInfw_Init( + &iTurb, + &tMax, + inputFileName, + &turbineData[iTurb].TurbID, + tmpOutFileRoot, + &scio.nSC2CtrlGlob, + &scio.nSC2Ctrl, + &scio.nCtrl2SC, + scio.from_SCglob.data(), + scio.from_SC[iTurb].data(), + &turbineData[iTurb].numForcePtsBlade, + &turbineData[iTurb].numForcePtsTwr, + turbineData[iTurb].TurbineBasePos.data(), + &AbortErrLev, + &dtDriver, + &turbineData[iTurb].dt, + &turbineData[iTurb].inflowType, + &turbineData[iTurb].numBlades, + &turbineData[iTurb].numVelPtsBlade, + &turbineData[iTurb].numVelPtsTwr, + &turbineData[iTurb].nodeClusterType, + &extinfw_i_f_FAST[iTurb], + &extinfw_o_t_FAST[iTurb], + &sc->ip_from_FAST[iTurb], + &sc->op_to_FAST[iTurb], + &ErrStat, + ErrMsg); + checkError(ErrStat, ErrMsg); + + timeZero = true; + + turbineData[iTurb].numVelPtsTwr = extinfw_o_t_FAST[iTurb].u_Len - turbineData[iTurb].numBlades*turbineData[iTurb].numVelPtsBlade - 1; + if(turbineData[iTurb].numVelPtsTwr == 0) { + turbineData[iTurb].numForcePtsTwr = 0; + std::cout << "Aerodyn doesn't want to calculate forces on the tower. All actuator points on the tower are turned off for turbine " << turbineMapProcToGlob[iTurb] << "." << std::endl ; + } - numVelPtsTwr[iTurb] = cDriver_Output_to_FAST[iTurb].u_Len - numBlades[iTurb]*numVelPtsBlade[iTurb] - 1; - if(numVelPtsTwr[iTurb] == 0) { - numForcePtsTwr[iTurb] = 0; - std::cout << "Aerodyn doesn't want to calculate forces on the tower. All actuator points on the tower are turned off for turbine " << turbineMapProcToGlob[iTurb] << "." << std::endl ; - } + allocateMemory_postInit(iTurb); - int nfpts = get_numForcePtsLoc(iTurb); - forceNodeVel[iTurb].resize(nfpts); - for (int k = 0; k < nfpts; k++) forceNodeVel[iTurb][k].resize(3) ; + get_data_from_openfast(fast::STATE_NM2); + get_data_from_openfast(fast::STATE_NM1); + get_data_from_openfast(fast::STATE_N); + get_data_from_openfast(fast::STATE_NP1); - if ( isDebug() ) { - for (int iNode=0; iNode < get_numVelPtsLoc(iTurb); iNode++) { - std::cout << "Node " << iNode << " Position = " << cDriver_Input_from_FAST[iTurb].pxVel[iNode] << " " << cDriver_Input_from_FAST[iTurb].pyVel[iNode] << " " << cDriver_Input_from_FAST[iTurb].pzVel[iNode] << " " << std::endl ; + get_ref_positions_from_openfast(iTurb); + + checkAndSetSubsteps(); + + ntStart = int(tStart/dtFAST); + int ntStartDriver; + if( (dtFAST > 0) && (nSubsteps_ > 0)) + ntStartDriver = int(tStart/dtFAST/nSubsteps_); + else + ntStartDriver = 0; //Typically for processors that don't contain any turbines + + std::vector velfile_ncid; + velfile_ncid.resize(nTurbinesProc); + + for (int iTurb=0; iTurb < nTurbinesProc; iTurb++) { + velfile_ncid[iTurb] = openVelocityDataFile(iTurb); + readVelocityData(iTurb, 0, 0, velfile_ncid[iTurb]); } - } - } - int nTimesteps; + int nVelPts = get_numVelPtsLoc(iTurb); + std::cout << std::endl ; + std::cout << "nt_global = " << 0 << " nlin_iter = " << 0 << std::endl ; + for (size_t k = 0; k < nVelPts; k++) + std::cout << k << ", " << velForceNodeData[iTurb][3].vel_vel[k*3 + 0] << " " << velForceNodeData[iTurb][3].vel_vel[k*3 + 1] << " " << velForceNodeData[iTurb][3].vel_vel[k*3 + 2] << " " << std::endl ; + + init_velForceNodeData(); + + solution0(false) ; + + for (int iPrestart=0 ; iPrestart < ntStartDriver; iPrestart++) { + for (int iTurb=0; iTurb < nTurbinesProc; iTurb++) { + int nlinIters = read_nlin_iters(iTurb, iPrestart+1, velfile_ncid[iTurb]); + for (int iNlin=0; iNlin < nlinIters; iNlin++) { + readVelocityData(iTurb, iPrestart+1, iNlin, velfile_ncid[iTurb]); + update_states_driver_time_step(false); + } + advance_to_next_driver_time_step(false); + } + } - if (nTurbinesProc > 0) { - readVelocityData(ntStart); - } - for (int iTurb=0; iTurb < nTurbinesProc; iTurb++) { - applyVelocityData(0, iTurb, cDriver_Output_to_FAST[iTurb], velNodeData[iTurb]); - } - solution0() ; + for (int iTurb=0; iTurb < nTurbinesProc; iTurb++) + nc_close(velfile_ncid[iTurb]); - for (int iPrestart=0 ; iPrestart < ntStart; iPrestart++) { - for (int iTurb=0; iTurb < nTurbinesProc; iTurb++) { - applyVelocityData(iPrestart, iTurb, cDriver_Output_to_FAST[iTurb], velNodeData[iTurb]); + readRestartFile(iTurb, nt_global); + + } else { + + throw std::runtime_error("RESTARTDRIVERINITFAST option not supported for blade-resolved FSI yet"); } - stepNoWrite(); } - if (nTurbinesProc > 0) velNodeDataFile = openVelocityDataFile(false); - break; case fast::simStartType_END: break; - } + } } -void fast::OpenFAST::solution0() { +void fast::OpenFAST::solution0(bool writeFiles) { if (!dryRun) { - // set wind speeds at initial locations - // for (int iTurb=0; iTurb < nTurbinesProc; iTurb++) { - // setOutputsToFAST(cDriver_Input_from_FAST[iTurb], cDriver_Output_to_FAST[iTurb]); - // } if(scStatus) { + std::cout << "Use of Supercontroller is not supported through the C++ API right now" << std::endl; // sc.fastSCInputOutput(); } + if (writeFiles) { + for (int iTurb=0; iTurb < nTurbinesProc; iTurb++) { + prepareRestartFile(iTurb); + prepareOutputFile(iTurb); + prepareVelocityDataFile(iTurb); + } + } + + // Unfortunately setVelocity only sets the velocity at 'n+1'. Need to copy 'n+1' to 'n' + init_velForceNodeData() ; + send_data_to_openfast(fast::STATE_NP1); + for (int iTurb=0; iTurb < nTurbinesProc; iTurb++) { - FAST_OpFM_Solution0(&iTurb, &ErrStat, ErrMsg); + + FAST_CFD_Solution0(&iTurb, &ErrStat, ErrMsg); + checkError(ErrStat, ErrMsg); + + FAST_CFD_InitIOarrays_SubStep(&iTurb, &ErrStat, ErrMsg); checkError(ErrStat, ErrMsg); } + get_data_from_openfast(fast::STATE_N); + get_data_from_openfast(fast::STATE_NM1); + get_data_from_openfast(fast::STATE_NM2); + + if (writeFiles) { + for (int iTurb=0; iTurb < nTurbinesProc; iTurb++) { + if (turbineData[iTurb].inflowType == 2) + writeVelocityData(iTurb, -nSubsteps_, 0); + } + } + timeZero = false; if (scStatus) { - std::cout << "Use of Supercontroller is not supported through the C++ API right now" << std::endl; + std::cout << "Use of Supercontroller is not supported through the C++ API right now" << std::endl; // sc.calcOutputs_n(0.0); // sc.fastSCInputOutput(); } } -} -void fast::OpenFAST::step() { +} - /* ****************************** - set inputs from this code and call FAST: - ********************************* */ +void fast::OpenFAST::set_state_from_state(fast::timeStep fromState, fast::timeStep toState) { for (int iTurb=0; iTurb < nTurbinesProc; iTurb++) { - // set wind speeds at original locations - // setOutputsToFAST(cDriver_Input_from_FAST[iTurb], cDriver_Output_to_FAST[iTurb]); - - // this advances the states, calls CalcOutput, and solves for next inputs. Predictor-corrector loop is imbeded here: - // (note OpenFOAM could do subcycling around this step) - - writeVelocityData(velNodeDataFile, iTurb, nt_global, cDriver_Input_from_FAST[iTurb], cDriver_Output_to_FAST[iTurb]); - - if ( isDebug() ) { - - std::ofstream fastcpp_velocity_file; - fastcpp_velocity_file.open("fastcpp_velocity.csv") ; - fastcpp_velocity_file << "# x, y, z, Vx, Vy, Vz" << std::endl ; - for (int iNode=0; iNode < get_numVelPtsLoc(iTurb); iNode++) { - fastcpp_velocity_file << cDriver_Input_from_FAST[iTurb].pxVel[iNode] << ", " << cDriver_Input_from_FAST[iTurb].pyVel[iNode] << ", " << cDriver_Input_from_FAST[iTurb].pzVel[iNode] << ", " << cDriver_Output_to_FAST[iTurb].u[iNode] << ", " << cDriver_Output_to_FAST[iTurb].v[iNode] << ", " << cDriver_Output_to_FAST[iTurb].w[iNode] << " " << std::endl ; + if (turbineData[iTurb].sType == EXTINFLOW) { + int nvelpts = get_numVelPtsLoc(iTurb); + int nfpts = get_numForcePtsLoc(iTurb); + for (int i=0; i0.) { - calc_nacelle_force ( - cDriver_Output_to_FAST[iTurb].u[0], - cDriver_Output_to_FAST[iTurb].v[0], - cDriver_Output_to_FAST[iTurb].w[0], - nacelle_cd[iTurb], - nacelle_area[iTurb], - air_density[iTurb], - cDriver_Input_from_FAST[iTurb].fx[0], - cDriver_Input_from_FAST[iTurb].fy[0], - cDriver_Input_from_FAST[iTurb].fz[0] - ); - } - - if ( isDebug() ) { - std::ofstream actuatorForcesFile; - actuatorForcesFile.open("actuator_forces.csv") ; - actuatorForcesFile << "# x, y, z, fx, fy, fz" << std::endl ; - for (int iNode=0; iNode < get_numForcePtsLoc(iTurb); iNode++) { - actuatorForcesFile << cDriver_Input_from_FAST[iTurb].pxForce[iNode] << ", " << cDriver_Input_from_FAST[iTurb].pyForce[iNode] << ", " << cDriver_Input_from_FAST[iTurb].pzForce[iNode] << ", " << cDriver_Input_from_FAST[iTurb].fx[iNode] << ", " << cDriver_Input_from_FAST[iTurb].fy[iNode] << ", " << cDriver_Input_from_FAST[iTurb].fz[iNode] << " " << std::endl ; + for (int i=0; i. - char dummyCheckPointRoot[INTERFACE_STRING_LENGTH] = " "; - // Ensure that we have a null character - dummyCheckPointRoot[1] = 0; - - if (nTurbinesProc > 0) backupVelocityDataFile(nt_global, velNodeDataFile); - - for (int iTurb=0; iTurb < nTurbinesProc; iTurb++) { - FAST_CreateCheckpoint(&iTurb, dummyCheckPointRoot, &ErrStat, ErrMsg); - checkError(ErrStat, ErrMsg); - } - if(scStatus) { - std::cout << "Use of Supercontroller is not supported through the C++ API right now" << std::endl; - // if (fastMPIRank == 0) { - // sc.writeRestartFile(nt_global); - // } - } - } } -void fast::OpenFAST::stepNoWrite() { +void fast::OpenFAST::init_velForceNodeData() { - /* ****************************** - set inputs from this code and call FAST: - ********************************* */ + set_state_from_state(fast::STATE_NP1, fast::STATE_N); + set_state_from_state(fast::STATE_NP1, fast::STATE_NM1); + set_state_from_state(fast::STATE_NP1, fast::STATE_NM2); - for (int iTurb=0; iTurb < nTurbinesProc; iTurb++) { +} - // set wind speeds at original locations - // setOutputsToFAST(cDriver_Input_from_FAST[iTurb], cDriver_Output_to_FAST[iTurb]); +//! Dot product of two vectors +double dot(double * a, double * b) { - // this advances the states, calls CalcOutput, and solves for next inputs. Predictor-corrector loop is imbeded here: - // (note OpenFOAM could do subcycling around this step) - FAST_OpFM_Step(&iTurb, &ErrStat, ErrMsg); - checkError(ErrStat, ErrMsg); + return (a[0]*b[0] + a[1]*b[1] + a[2]*b[2]); - } +} - if(scStatus) { - std::cout << "Use of Supercontroller is not supported through the C++ API right now" << std::endl; - // sc.updateStates( nt_global * dtFAST); // Predict state at 'n+1' based on inputs - // sc.calcOutputs_np1( (nt_global+1) * dtFAST); - // sc.fastSCInputOutput(); - } +//! Cross product of two vectors +void cross(double * a, double * b, double * aCrossb) { - nt_global = nt_global + 1; + aCrossb[0] = a[1]*b[2] - a[2]*b[1]; + aCrossb[1] = a[2]*b[0] - a[0]*b[2]; + aCrossb[2] = a[0]*b[1] - a[1]*b[0]; - if(scStatus) { - std::cout << "Use of Supercontroller is not supported through the C++ API right now" << std::endl; - // sc.advanceTime(); // Advance states, inputs and outputs from 'n' to 'n+1' - } } -void fast::OpenFAST::calc_nacelle_force(const float & u, const float & v, const float & w, const float & cd, const float & area, const float & rho, float & fx, float & fy, float & fz) { - // Calculate the force on the nacelle (fx,fy,fz) given the - // velocity sampled at the nacelle point (u,v,w), - // drag coefficient 'cd' and nacelle area 'area' +//! Compose Wiener-Milenkovic parameters 'p' and 'q' into 'pPlusq'. If a transpose of 'p' is required, set tranposeP to '-1', else leave blank or set to '+1' +void composeWM(double * p, double * q, double * pPlusq, double transposeP, double transposeQ) { - // The velocity magnitude - float Vmag = std::sqrt(u * u + v * v + w * w); + double p0 = 2.0 - 0.125*dot(p,p); + double q0 = 2.0 - 0.125*dot(q,q); + std::vector pCrossq(3,0.0); + cross(p, q, pCrossq.data()); - // Velocity correction based on Martinez-Tossas PhD Thesis 2017 - // The correction samples the velocity at the center of the - // Gaussian kernel and scales it to obtain the inflow velocity - float epsilon_d = std::sqrt(2.0 / M_PI * cd * area); - float correction = 1. / (1.0 - cd * area / (4.0 * M_PI * epsilon_d * epsilon_d)); + double delta1 = (4.0-p0)*(4.0-q0); + double delta2 = p0*q0 - transposeP*dot(p,q); + double premultFac = 0.0; + if (delta2 < 0) + premultFac = -4.0/(delta1 - delta2); + else + premultFac = 4.0/(delta1 + delta2); + + for (size_t i=0; i < 3; i++) + pPlusq[i] = premultFac * (transposeQ * p0 * q[i] + transposeP * q0 * p[i] + transposeP * transposeQ * pCrossq[i] ); - // Compute the force for each velocity component - fx = rho * 1./2. * cd * area * Vmag * u * correction * correction; - fy = rho * 1./2. * cd * area * Vmag * v * correction * correction; - fz = rho * 1./2. * cd * area * Vmag * w * correction * correction; } -void fast::OpenFAST::setInputs(const fast::fastInputs & fi ) { +//! Extrapolate Wiener-Milenkovic parameters from state 'nm2', 'nm1', 'n' to 'np1' +void extrapRotation(double *rnm2, double *rnm1, double *rn, double *rnp1) { - mpiComm = fi.comm; + std::array rrnm1{ {0.0,0.0,0.0} }; + std::array rrn{ {0.0,0.0,0.0} }; + std::array rrnp1{ {0.0,0.0,0.0} }; - MPI_Comm_rank(mpiComm, &worldMPIRank); - MPI_Comm_group(mpiComm, &worldMPIGroup); + composeWM(rnm2, rnm1, rrnm1.data(), -1.0, 1.0); // Remove rigid body rotaiton of rnm2 from rnm1 + composeWM(rnm2, rn, rrn.data(), -1.0, 1.0); // Remove rigid body rotaiton of rnm2 from rnm1 + for(int i=0; i<3; i++) { + rrnp1[i] = 3.0 * ( rrn[i] - rrnm1[i]) ; + } + composeWM(rnm2, rrnp1.data(), rnp1, 1.0, 1.0); //Add rigid body rotation of nm2 back - nTurbinesGlob = fi.nTurbinesGlob; +} - if (nTurbinesGlob > 0) { +void fast::OpenFAST::predict_states() { + + if (firstPass_) { + for (int iTurb=0; iTurb < nTurbinesProc; iTurb++) { + int nvelpts = get_numVelPtsLoc(iTurb); + int nfpts = get_numForcePtsLoc(iTurb); + for (int i=0; i 1) { + + for (int iTurb=0; iTurb < nTurbinesProc; iTurb++) { + FAST_CFD_Store_SubStep(&iTurb, &nt_global, &ErrStat, ErrMsg) ; + checkError(ErrStat, ErrMsg); + } + + } else { + + if(scStatus) { + std::cout << "Use of Supercontroller is not supported through the C++ API right now" << std::endl; + } + + for (int iTurb=0; iTurb < nTurbinesProc; iTurb++) { + FAST_CFD_Prework(&iTurb, &ErrStat, ErrMsg); + checkError(ErrStat, ErrMsg); + } + } +} + +void fast::OpenFAST::update_states_driver_time_step(bool writeFiles) { + + if (firstPass_) + prework(); + + if (nSubsteps_ > 1) { + + if (!firstPass_) { + for (int iTurb=0; iTurb < nTurbinesProc; iTurb++) { + FAST_CFD_Reset_SubStep(&iTurb, &nSubsteps_, &ErrStat, ErrMsg); + checkError(ErrStat, ErrMsg); + } + } + + for (int iSubstep=1; iSubstep < nSubsteps_+1; iSubstep++) { + double ss_time = double(iSubstep)/double(nSubsteps_); + step(ss_time); + } + + get_data_from_openfast(fast::STATE_NP1); + + if (writeFiles) { + if ( isDebug() ) { + for (int iTurb=0; iTurb < nTurbinesProc; iTurb++) { + std::ofstream fastcpp_velocity_file; + fastcpp_velocity_file.open("fastcpp_residual." + std::to_string(turbineMapProcToGlob[iTurb]) + ".csv", std::ios_base::app) ; + fastcpp_velocity_file << "Time step " << nt_global << " Velocity residual at the force nodes = " << velForceNodeData[iTurb][fast::STATE_NP1].vel_force_resid << std::endl ; + fastcpp_velocity_file << " " << nt_global << " Position residual at the force nodes = " << velForceNodeData[iTurb][fast::STATE_NP1].x_force_resid << std::endl ; + fastcpp_velocity_file << " " << nt_global << " Force residual at the force nodes = " << velForceNodeData[iTurb][fast::STATE_NP1].force_resid << std::endl ; + fastcpp_velocity_file.close() ; + } + } + } + + for (int iTurb=0; iTurb < nTurbinesProc; iTurb++) { + velForceNodeData[iTurb][fast::STATE_NP1].x_vel_resid = 0.0; + velForceNodeData[iTurb][fast::STATE_NP1].vel_vel_resid = 0.0; + velForceNodeData[iTurb][fast::STATE_NP1].x_force_resid = 0.0; + velForceNodeData[iTurb][fast::STATE_NP1].xdot_force_resid = 0.0; + velForceNodeData[iTurb][fast::STATE_NP1].orient_force_resid = 0.0; + velForceNodeData[iTurb][fast::STATE_NP1].vel_force_resid = 0.0; + velForceNodeData[iTurb][fast::STATE_NP1].force_resid = 0.0; + } + } else { + + send_data_to_openfast(fast::STATE_NP1); + + for (int iTurb=0; iTurb < nTurbinesProc; iTurb++) { + FAST_CFD_UpdateStates(&iTurb, &ErrStat, ErrMsg); + checkError(ErrStat, ErrMsg); + + // Compute the force from the nacelle only if the drag coefficient is + // greater than zero + if (get_nacelleCdLoc(iTurb) > 0.) { + + calc_nacelle_force ( + + extinfw_o_t_FAST[iTurb].u[0], + extinfw_o_t_FAST[iTurb].v[0], + extinfw_o_t_FAST[iTurb].w[0], + get_nacelleCdLoc(iTurb), + get_nacelleAreaLoc(iTurb), + get_airDensityLoc(iTurb), + extinfw_i_f_FAST[iTurb].fx[0], + extinfw_i_f_FAST[iTurb].fy[0], + extinfw_i_f_FAST[iTurb].fz[0] + + ); + + } + + } + + get_data_from_openfast(fast::STATE_NP1); + + if ( writeFiles ) { + if ( isDebug() ) { + for (int iTurb=0; iTurb < nTurbinesProc; iTurb++) { + std::ofstream fastcpp_velocity_file; + fastcpp_velocity_file.open("fastcpp_residual." + std::to_string(turbineMapProcToGlob[iTurb]) + ".csv", std::ios_base::app) ; + fastcpp_velocity_file << "Time step " << nt_global << " Velocity residual at the force nodes = " << velForceNodeData[iTurb][fast::STATE_NP1].vel_force_resid << std::endl ; + fastcpp_velocity_file << " " << nt_global << " Position residual at the force nodes = " << velForceNodeData[iTurb][fast::STATE_NP1].x_force_resid << std::endl ; + fastcpp_velocity_file << " " << nt_global << " Force residual at the force nodes = " << velForceNodeData[iTurb][fast::STATE_NP1].force_resid << std::endl ; + fastcpp_velocity_file.close() ; + } + } + } + + for (int iTurb=0; iTurb < nTurbinesProc; iTurb++) { + velForceNodeData[iTurb][fast::STATE_NP1].x_vel_resid = 0.0; + velForceNodeData[iTurb][fast::STATE_NP1].vel_vel_resid = 0.0; + velForceNodeData[iTurb][fast::STATE_NP1].x_force_resid = 0.0; + velForceNodeData[iTurb][fast::STATE_NP1].xdot_force_resid = 0.0; + velForceNodeData[iTurb][fast::STATE_NP1].orient_force_resid = 0.0; + velForceNodeData[iTurb][fast::STATE_NP1].vel_force_resid = 0.0; + velForceNodeData[iTurb][fast::STATE_NP1].force_resid = 0.0; + } + + } + + if (writeFiles) { + for (int iTurb=0; iTurb < nTurbinesProc; iTurb++) { + if (turbineData[iTurb].inflowType == 2) + writeVelocityData(iTurb, nt_global, nlinIter_); + } + } + + firstPass_ = false; + nlinIter_ +=1 ; +} + +void fast::OpenFAST::advance_to_next_driver_time_step(bool writeFiles) { + + if (nSubsteps_ > 1) { + //Nothing to do here + + } else { + + for (int iTurb=0; iTurb < nTurbinesProc; iTurb++) { + FAST_CFD_AdvanceToNextTimeStep(&iTurb, &ErrStat, ErrMsg); + checkError(ErrStat, ErrMsg); + } + + if(scStatus) { + std::cout << "Use of Supercontroller is not supported through the C++ API right now" << std::endl; + } + + } + + nt_global = nt_global + nSubsteps_; + + + for (int iTurb=0; iTurb < nTurbinesProc; iTurb++) { + FAST_CFD_WriteOutput(&iTurb, &ErrStat, ErrMsg); + checkError(ErrStat, ErrMsg); + } + + set_state_from_state(fast::STATE_NM1, fast::STATE_NM2); + set_state_from_state(fast::STATE_N, fast::STATE_NM1); + set_state_from_state(fast::STATE_NP1, fast::STATE_N); + + if (writeFiles) { + for (int iTurb=0; iTurb < nTurbinesProc; iTurb++) { + int tStepRatio = time_step_ratio(dtFAST, dtDriver); + if ( (restartFreq_*tStepRatio > 0) && (((nt_global - ntStart) % (restartFreq_*tStepRatio)) == 0 ) && (nt_global != ntStart) ) { + turbineData[iTurb].FASTRestartFileName = " "; // if blank, it will use FAST convention .nt_global + FAST_CreateCheckpoint(&iTurb, turbineData[iTurb].FASTRestartFileName.data(), &ErrStat, ErrMsg); + checkError(ErrStat, ErrMsg); + writeRestartFile(iTurb, nt_global); + } + if(scStatus) { + if (fastMPIRank == 0) { + sc->writeRestartFile(nt_global); + } + } + + if ( (((nt_global - ntStart) % (outputFreq_ * tStepRatio) ) == 0 ) && (nt_global != ntStart) ) { + writeOutputFile(iTurb, nt_global); + } + } + + } + + nlinIter_ = 0; + firstPass_ = true ; // Set firstPass_ to true for the next time step +} + +void fast::OpenFAST::calc_nacelle_force(const float & u, const float & v, const float & w, const float & cd, const float & area, const float & rho, float & fx, float & fy, float & fz) { + // Calculate the force on the nacelle (fx,fy,fz) given the + // velocity sampled at the nacelle point (u,v,w), + // drag coefficient 'cd' and nacelle area 'area' + // The velocity magnitude + float Vmag = std::sqrt(u * u + v * v + w * w); + + // Velocity correction based on Martinez-Tossas PhD Thesis 2017 + // The correction samples the velocity at the center of the + // Gaussian kernel and scales it to obtain the inflow velocity + float epsilon_d = std::sqrt(2.0 / M_PI * cd * area); + float correction = 1. / (1.0 - cd * area / (4.0 * M_PI * epsilon_d * epsilon_d)); + + // Compute the force for each velocity component + fx = rho * 1./2. * cd * area * Vmag * u * correction * correction; + fy = rho * 1./2. * cd * area * Vmag * v * correction * correction; + fz = rho * 1./2. * cd * area * Vmag * w * correction * correction; + +} + +/* A version of step allowing for sub-timesteps when the driver program has a larger time step than OpenFAST */ +void fast::OpenFAST::step(double ss_time) { + + /* ****************************** + set inputs from this code and call FAST: + ********************************* */ + + if(scStatus) { + std::cout << "Use of Supercontroller is not supported through the C++ API right now" << std::endl; + } + + for (int iTurb=0; iTurb < nTurbinesProc; iTurb++) { + + // this advances the states, calls CalcOutput, and solves for next inputs. Predictor-corrector loop is imbeded here: + FAST_CFD_Prework(&iTurb, &ErrStat, ErrMsg); + checkError(ErrStat, ErrMsg); + send_data_to_openfast(ss_time); + FAST_CFD_UpdateStates(&iTurb, &ErrStat, ErrMsg); + checkError(ErrStat, ErrMsg); + FAST_CFD_AdvanceToNextTimeStep(&iTurb, &ErrStat, ErrMsg); + checkError(ErrStat, ErrMsg); + + } + + if(scStatus) { + std::cout << "Use of Supercontroller is not supported through the C++ API right now" << std::endl; + } + +} + +void fast::OpenFAST::step(bool writeFiles) { + + /* ****************************** + set inputs from this code and call FAST: + ********************************* */ + + for (int iTurb=0; iTurb < nTurbinesProc; iTurb++) { + + // this advances the states, calls CalcOutput, and solves for next inputs. Predictor-corrector loop is imbeded here: + // (note CFD could do subcycling around this step) + + if (turbineData[iTurb].inflowType == 2) + + writeVelocityData(iTurb, nt_global, 0); + + if (writeFiles) { + if ( isDebug() && (turbineData[iTurb].inflowType == 2) ) { + + std::ofstream fastcpp_velocity_file; + fastcpp_velocity_file.open("fastcpp_velocity." + std::to_string(turbineMapProcToGlob[iTurb]) + ".csv") ; + fastcpp_velocity_file << "# x, y, z, Vx, Vy, Vz" << std::endl ; + for (int iNode=0; iNode < get_numVelPtsLoc(iTurb); iNode++) { + fastcpp_velocity_file << extinfw_i_f_FAST[iTurb].pxVel[iNode] << ", " << extinfw_i_f_FAST[iTurb].pyVel[iNode] << ", " << extinfw_i_f_FAST[iTurb].pzVel[iNode] << ", " << extinfw_o_t_FAST[iTurb].u[iNode] << ", " << extinfw_o_t_FAST[iTurb].v[iNode] << ", " << extinfw_o_t_FAST[iTurb].w[iNode] << " " << std::endl ; + } + fastcpp_velocity_file.close() ; + } + } + + FAST_CFD_Prework(&iTurb, &ErrStat, ErrMsg); + checkError(ErrStat, ErrMsg); + send_data_to_openfast(fast::STATE_NP1); + FAST_CFD_UpdateStates(&iTurb, &ErrStat, ErrMsg); + checkError(ErrStat, ErrMsg); + get_data_from_openfast(fast::STATE_NP1); + FAST_CFD_AdvanceToNextTimeStep(&iTurb, &ErrStat, ErrMsg); + checkError(ErrStat, ErrMsg); + + // Compute the force from the nacelle only if the drag coefficient is + // greater than zero + if (get_nacelleCdLoc(iTurb) > 0.) { + + calc_nacelle_force ( + + extinfw_o_t_FAST[iTurb].u[0], + extinfw_o_t_FAST[iTurb].v[0], + extinfw_o_t_FAST[iTurb].w[0], + get_nacelleCdLoc(iTurb), + get_nacelleAreaLoc(iTurb), + get_airDensityLoc(iTurb), + extinfw_i_f_FAST[iTurb].fx[0], + extinfw_i_f_FAST[iTurb].fy[0], + extinfw_i_f_FAST[iTurb].fz[0] + + ); + + } + + if (writeFiles) { + if ( isDebug() && (turbineData[iTurb].inflowType == 2) ) { + std::ofstream actuatorForcesFile; + actuatorForcesFile.open("actuator_forces." + std::to_string(turbineMapProcToGlob[iTurb]) + ".csv") ; + actuatorForcesFile << "# x, y, z, fx, fy, fz" << std::endl ; + for (int iNode=0; iNode < get_numForcePtsLoc(iTurb); iNode++) { + actuatorForcesFile << extinfw_i_f_FAST[iTurb].pxForce[iNode] << ", " << extinfw_i_f_FAST[iTurb].pyForce[iNode] << ", " << extinfw_i_f_FAST[iTurb].pzForce[iNode] << ", " << extinfw_i_f_FAST[iTurb].fx[iNode] << ", " << extinfw_i_f_FAST[iTurb].fy[iNode] << ", " << extinfw_i_f_FAST[iTurb].fz[iNode] << " " << std::endl ; + } + actuatorForcesFile.close() ; + } + } + + } + + if(scStatus) { + std::cout << "Use of Supercontroller is not supported through the C++ API right now" << std::endl; + // sc.updateStates(nt_global * dtFAST); // Predict state at 'n+1' based on inputs + // sc.calcOutputs_np1( (nt_global + 1) * dtFAST); + // sc.fastSCInputOutput(); + } + + nt_global = nt_global + 1; + + for (int iTurb=0; iTurb < nTurbinesProc; iTurb++) { + FAST_CFD_WriteOutput(&iTurb, &ErrStat, ErrMsg); + checkError(ErrStat, ErrMsg); + } + + if (writeFiles) { + int tStepRatio = time_step_ratio(dtFAST, dtDriver); + for (int iTurb=0; iTurb < nTurbinesProc; iTurb++) { + if ( (((nt_global - ntStart) % (restartFreq_ * tStepRatio)) == 0 ) && (nt_global != ntStart) ) { + turbineData[iTurb].FASTRestartFileName = " "; // if blank, it will use FAST convention .nt_global + FAST_CreateCheckpoint(&iTurb, turbineData[iTurb].FASTRestartFileName.data(), &ErrStat, ErrMsg); + checkError(ErrStat, ErrMsg); + writeRestartFile(iTurb, nt_global); + } + if(scStatus) { + std::cout << "Use of Supercontroller is not supported through the C++ API right now" << std::endl; + // if (fastMPIRank == 0) { + // sc.writeRestartFile(nt_global); + // } + } + + if ( (((nt_global - ntStart) % (outputFreq_ * tStepRatio) ) == 0 ) && (nt_global != ntStart) ) { + writeOutputFile(iTurb, nt_global); + } + } + } + +} + +void fast::OpenFAST::setInputs(const fast::fastInputs & fi ) { + + mpiComm = fi.comm; + + MPI_Comm_rank(mpiComm, &worldMPIRank); + MPI_Comm_group(mpiComm, &worldMPIGroup); + + nTurbinesGlob = fi.nTurbinesGlob; + + if (nTurbinesGlob > 0) { dryRun = fi.dryRun; + debug = fi.debug; tStart = fi.tStart; simStart = fi.simStart; - nEveryCheckPoint = fi.nEveryCheckPoint; + restartFreq_ = fi.restartFreq; + outputFreq_ = fi.outputFreq; tMax = fi.tMax; loadSuperController(fi); - dtFAST = fi.dtFAST; + dtDriver = fi.dtDriver; - ntStart = int(tStart/dtFAST); - - if (simStart == fast::restartDriverInitFAST) { - nt_global = 0; - } else { - nt_global = ntStart; - } + ///TODO: Check if this is right and necessary + // if (simStart == fast::restartDriverInitFAST) { + // nt_global = 0; + // } else { + // nt_global = ntStart; + // } globTurbineData.resize(nTurbinesGlob); globTurbineData = fi.globTurbineData; @@ -472,568 +1563,1695 @@ void fast::OpenFAST::setInputs(const fast::fastInputs & fi ) { } } -void fast::OpenFAST::checkError(const int ErrStat, const char * ErrMsg){ - if (ErrStat != ErrID_None){ - if (ErrStat >= AbortErrLev){ - throw std::runtime_error(ErrMsg); +int fast::OpenFAST::checkAndSetSubsteps() { + + if ( nTurbinesProc > 0) { + if (dtDriver > 0) { + dtFAST = turbineData[0].dt; + for (int iTurb=0; iTurb < nTurbinesProc; iTurb++) { + if (dtFAST != turbineData[iTurb].dt) { + throw std::runtime_error("All turbines don't have the same time step "); + } + } + if (dtFAST > 0) { + int tStepRatio = time_step_ratio(dtFAST, dtDriver); + if (std::abs(dtDriver - tStepRatio * dtFAST) < 0.001) {// TODO: Fix arbitrary number 0.001 + nSubsteps_ = tStepRatio; + return 1; + } else { + return -1; + } + } else { + throw std::runtime_error("FAST time step is zero"); + } + + } else { + throw std::runtime_error("Driver time step is not set or set to zero"); } + } else { + return 1; } + } -void fast::OpenFAST::setOutputsToFAST(OpFM_InputType_t cDriver_Input_from_FAST, OpFM_OutputType_t cDriver_Output_to_FAST){ - // routine sets the u-v-w wind speeds used in FAST and the SuperController inputs +void fast::OpenFAST::setDriverTimeStep(double dt_driver) { + dtDriver = dt_driver; +} - for (int j = 0; j < cDriver_Output_to_FAST.u_Len; j++){ - cDriver_Output_to_FAST.u[j] = (float) 10.0*pow((cDriver_Input_from_FAST.pzVel[j] / 90.0), 0.2); // 0.2 power law wind profile using reference 10 m/s at 90 meters - cDriver_Output_to_FAST.v[j] = 0.0; - cDriver_Output_to_FAST.w[j] = 0.0; - } -} +void fast::OpenFAST::setDriverCheckpoint(int nt_checkpoint_driver) { -void fast::OpenFAST::getApproxHubPos(double* currentCoords, int iTurbGlob, int nSize) { - assert(nSize==3); - // Get hub position of Turbine 'iTurbGlob' - for(int i =0; i 0) { + if (nSubsteps_ > 0) { + restartFreq_ = nt_checkpoint_driver; + } else { + throw std::runtime_error("Trying to set driver checkpoint when nSubsteps_ is zero. Set driver time step first may be?"); + } } } -void fast::OpenFAST::getHubPos(double* currentCoords, int iTurbGlob, int nSize) { - assert(nSize==3); - // Get hub position of Turbine 'iTurbGlob' - int iTurbLoc = get_localTurbNo(iTurbGlob); - currentCoords[0] = cDriver_Input_from_FAST[iTurbLoc].pxVel[0] + TurbineBasePos[iTurbLoc][0] ; - currentCoords[1] = cDriver_Input_from_FAST[iTurbLoc].pyVel[0] + TurbineBasePos[iTurbLoc][1] ; - currentCoords[2] = cDriver_Input_from_FAST[iTurbLoc].pzVel[0] + TurbineBasePos[iTurbLoc][2] ; -} +void fast::OpenFAST::get_turbineParams(int iTurbGlob, turbineDataType & turbData) { -void fast::OpenFAST::getHubShftDir(double* hubShftVec, int iTurbGlob, int nSize) { + //TODO: Figure out a better copy operator for the turbineDataType struct + int iTurbLoc = get_localTurbNo(iTurbGlob); + turbData.TurbID = turbineData[iTurbLoc].TurbID; + turbData.FASTInputFileName = turbineData[iTurbLoc].FASTInputFileName; + turbData.FASTRestartFileName = turbineData[iTurbLoc].FASTRestartFileName; + if(turbineData[iTurbLoc].TurbineBasePos.size() > 0) { + turbData.TurbineBasePos.resize(turbineData[iTurbLoc].TurbineBasePos.size()); + for(int i=0; i < turbineData[iTurbLoc].TurbineBasePos.size(); i++) + turbData.TurbineBasePos[i] = turbineData[iTurbLoc].TurbineBasePos[i]; + } + if(turbineData[iTurbLoc].TurbineHubPos.size() > 0) { + turbData.TurbineHubPos.resize(turbineData[iTurbLoc].TurbineHubPos.size()); + for(int i=0; i < turbineData[iTurbLoc].TurbineHubPos.size(); i++) + turbData.TurbineHubPos[i] = turbineData[iTurbLoc].TurbineHubPos[i]; + } + turbData.sType = turbineData[iTurbLoc].sType; + turbData.numBlades = turbineData[iTurbLoc].numBlades; + turbData.numVelPtsBlade = turbineData[iTurbLoc].numVelPtsBlade; + turbData.numVelPtsTwr = turbineData[iTurbLoc].numVelPtsTwr; + turbData.numVelPts = turbineData[iTurbLoc].numVelPts; + turbData.numForcePtsBlade = turbineData[iTurbLoc].numForcePtsBlade; + turbData.numForcePtsTwr = turbineData[iTurbLoc].numForcePtsTwr; + turbData.numForcePts = turbineData[iTurbLoc].numForcePts; + turbData.inflowType = turbineData[iTurbLoc].inflowType; + turbData.nacelle_cd = turbineData[iTurbLoc].nacelle_cd; + turbData.nacelle_area = turbineData[iTurbLoc].nacelle_area; + turbData.air_density = turbineData[iTurbLoc].air_density; + turbData.nBRfsiPtsBlade.resize(turbData.numBlades); + turbData.nTotBRfsiPtsBlade = 0; + for (int i=0; i < turbData.numBlades; i++) { + turbData.nBRfsiPtsBlade[i] = turbineData[iTurbLoc].nBRfsiPtsBlade[i]; + turbData.nTotBRfsiPtsBlade += turbData.nBRfsiPtsBlade[i]; + } + turbData.nBRfsiPtsTwr = turbineData[iTurbLoc].nBRfsiPtsTwr; + turbData.azBlendMean = turbineData[iTurbLoc].azBlendMean; + turbData.azBlendDelta = turbineData[iTurbLoc].azBlendDelta; + +} + + +void fast::OpenFAST::checkError(const int ErrStat, const char * ErrMsg) +{ + if (ErrStat != ErrID_None){ + + if (ErrStat >= AbortErrLev){ + throw std::runtime_error(std::string(ErrMsg)); + } else { + std::cout << "Warning from OpenFAST: " << ErrMsg << std::endl; + } + } +} + +// Actuator stuff + +void fast::OpenFAST::setExpLawWindSpeed(double t){ + + double sinOmegat = 0.1 * std::sin(10.0*t); + for (int iTurb=0; iTurb < nTurbinesProc; iTurb++) { + // routine sets the u-v-w wind speeds used in FAST + int nVelPts = get_numVelPts(iTurb); + int iTurbGlob = turbineMapProcToGlob[iTurb]; + for (int j = 0; j < nVelPts; j++){ + std::vector coords(3,0.0); + std::vector tmpVel(3,0.0); + getVelNodeCoordinates(coords, j, iTurbGlob, fast::STATE_NP1); + tmpVel[0] = (float) 10.0*pow((coords[2] / 90.0), 0.2) + sinOmegat; // 0.2 power law wind profile using reference 10 m/s at 90 meters + a perturbation + setVelocity(tmpVel, j, iTurbGlob); + } + } +} + +void fast::OpenFAST::getApproxHubPos(double* currentCoords, int iTurbGlob, int nSize) { + assert(nSize==3); + // Get hub position of Turbine 'iTurbGlob' + for(int i =0; i rDistForce(nForcePtsBlade) ; + for(int j=0; j < nForcePtsBlade; j++) { + int iNodeForce = 1 + iBlade * nForcePtsBlade + j ; //The number of actuator force points is always the same for all blades + rDistForce[j] = sqrt( + (extinfw_i_f_FAST[iTurb].pxForce[iNodeForce] - extinfw_i_f_FAST[iTurb].pxForce[0])*(extinfw_i_f_FAST[iTurb].pxForce[iNodeForce] - extinfw_i_f_FAST[iTurb].pxForce[0]) + + (extinfw_i_f_FAST[iTurb].pyForce[iNodeForce] - extinfw_i_f_FAST[iTurb].pyForce[0])*(extinfw_i_f_FAST[iTurb].pyForce[iNodeForce] - extinfw_i_f_FAST[iTurb].pyForce[0]) + + (extinfw_i_f_FAST[iTurb].pzForce[iNodeForce] - extinfw_i_f_FAST[iTurb].pzForce[0])*(extinfw_i_f_FAST[iTurb].pzForce[iNodeForce] - extinfw_i_f_FAST[iTurb].pzForce[0]) + ); + } + + // Interpolate to the velocity nodes + int nVelPtsBlade = get_numVelPtsBladeLoc(iTurb); + for(int j=0; j < nVelPtsBlade; j++) { + int iNodeVel = 1 + iBlade * nVelPtsBlade + j ; //Assumes the same number of velocity (Aerodyn) nodes for all blades + double rDistVel = sqrt( + (extinfw_i_f_FAST[iTurb].pxVel[iNodeVel] - extinfw_i_f_FAST[iTurb].pxVel[0])*(extinfw_i_f_FAST[iTurb].pxVel[iNodeVel] - extinfw_i_f_FAST[iTurb].pxVel[0]) + + (extinfw_i_f_FAST[iTurb].pyVel[iNodeVel] - extinfw_i_f_FAST[iTurb].pyVel[0])*(extinfw_i_f_FAST[iTurb].pyVel[iNodeVel] - extinfw_i_f_FAST[iTurb].pyVel[0]) + + (extinfw_i_f_FAST[iTurb].pzVel[iNodeVel] - extinfw_i_f_FAST[iTurb].pzVel[0])*(extinfw_i_f_FAST[iTurb].pzVel[iNodeVel] - extinfw_i_f_FAST[iTurb].pzVel[0]) + ); + //Find nearest two force nodes + int jForceLower = 0; + while ( (rDistForce[jForceLower+1] < rDistVel) && ( jForceLower < (nForcePtsBlade-2)) ) { + jForceLower = jForceLower + 1; + } + int iNodeForceLower = 1 + iBlade * nForcePtsBlade + jForceLower ; + double rInterp = (rDistVel - rDistForce[jForceLower])/(rDistForce[jForceLower+1]-rDistForce[jForceLower]); + + for (int k=0; k < 3; k++) { + double tmp = velForceNodeData[iTurb][fast::STATE_NP1].vel_force[iNodeForceLower*3+k] + rInterp * (velForceNodeData[iTurb][fast::STATE_NP1].vel_force[(iNodeForceLower+1)*3+k] - velForceNodeData[iTurb][fast::STATE_NP1].vel_force[iNodeForceLower*3+k]); + velForceNodeData[iTurb][fast::STATE_NP1].vel_vel_resid += (velForceNodeData[iTurb][fast::STATE_NP1].vel_vel[iNodeVel*3+k] - tmp)*(velForceNodeData[iTurb][fast::STATE_NP1].vel_vel[iNodeVel*3+k] - tmp); + velForceNodeData[iTurb][fast::STATE_NP1].vel_vel[iNodeVel*3+k] = tmp; + } + } + } + + // Now the tower if present and used + int nVelPtsTower = get_numVelPtsTwrLoc(iTurb); + if ( nVelPtsTower > 0 ) { + + // Create interpolating parameter - Distance from first node from ground + int nForcePtsTower = get_numForcePtsTwrLoc(iTurb); + std::vector hDistForce(nForcePtsTower) ; + int iNodeBotTowerForce = 1 + nBlades * get_numForcePtsBladeLoc(iTurb); // The number of actuator force points is always the same for all blades + for(int j=0; j < nForcePtsTower; j++) { + int iNodeForce = iNodeBotTowerForce + j ; + hDistForce[j] = sqrt( + (extinfw_i_f_FAST[iTurb].pxForce[iNodeForce] - extinfw_i_f_FAST[iTurb].pxForce[iNodeBotTowerForce])*(extinfw_i_f_FAST[iTurb].pxForce[iNodeForce] - extinfw_i_f_FAST[iTurb].pxForce[iNodeBotTowerForce]) + + (extinfw_i_f_FAST[iTurb].pyForce[iNodeForce] - extinfw_i_f_FAST[iTurb].pyForce[iNodeBotTowerForce])*(extinfw_i_f_FAST[iTurb].pyForce[iNodeForce] - extinfw_i_f_FAST[iTurb].pyForce[iNodeBotTowerForce]) + + (extinfw_i_f_FAST[iTurb].pzForce[iNodeForce] - extinfw_i_f_FAST[iTurb].pzForce[iNodeBotTowerForce])*(extinfw_i_f_FAST[iTurb].pzForce[iNodeForce] - extinfw_i_f_FAST[iTurb].pzForce[iNodeBotTowerForce]) + ); + } + + int iNodeBotTowerVel = 1 + nBlades * get_numVelPtsBladeLoc(iTurb); // Assumes the same number of velocity (Aerodyn) nodes for all blades + for(int j=0; j < nVelPtsTower; j++) { + int iNodeVel = iNodeBotTowerVel + j ; + double hDistVel = sqrt( + (extinfw_i_f_FAST[iTurb].pxVel[iNodeVel] - extinfw_i_f_FAST[iTurb].pxVel[iNodeBotTowerVel])*(extinfw_i_f_FAST[iTurb].pxVel[iNodeVel] - extinfw_i_f_FAST[iTurb].pxVel[iNodeBotTowerVel]) + + (extinfw_i_f_FAST[iTurb].pyVel[iNodeVel] - extinfw_i_f_FAST[iTurb].pyVel[iNodeBotTowerVel])*(extinfw_i_f_FAST[iTurb].pyVel[iNodeVel] - extinfw_i_f_FAST[iTurb].pyVel[iNodeBotTowerVel]) + + (extinfw_i_f_FAST[iTurb].pzVel[iNodeVel] - extinfw_i_f_FAST[iTurb].pzVel[iNodeBotTowerVel])*(extinfw_i_f_FAST[iTurb].pzVel[iNodeVel] - extinfw_i_f_FAST[iTurb].pzVel[iNodeBotTowerVel]) + ); + //Find nearest two force nodes + int jForceLower = 0; + while ( (hDistForce[jForceLower+1] < hDistVel) && ( jForceLower < (nForcePtsTower-2)) ) { + jForceLower = jForceLower + 1; + } + int iNodeForceLower = iNodeBotTowerForce + jForceLower ; + double rInterp = (hDistVel - hDistForce[jForceLower])/(hDistForce[jForceLower+1]-hDistForce[jForceLower]); + for (int k=0; k < 3; k++) { + double tmp = velForceNodeData[iTurb][fast::STATE_NP1].vel_force[iNodeForceLower*3+k] + rInterp * (velForceNodeData[iTurb][fast::STATE_NP1].vel_force[(iNodeForceLower+1)*3+k] - velForceNodeData[iTurb][fast::STATE_NP1].vel_force[iNodeForceLower*3+k]); + velForceNodeData[iTurb][fast::STATE_NP1].vel_vel_resid += (velForceNodeData[iTurb][fast::STATE_NP1].vel_vel[iNodeVel*3+k] - tmp)*(velForceNodeData[iTurb][fast::STATE_NP1].vel_vel[iNodeVel*3+k] - tmp); + velForceNodeData[iTurb][fast::STATE_NP1].vel_vel[iNodeVel*3+k] = tmp; + } + } + } + + } // End loop over turbines + +} + +void fast::OpenFAST::computeTorqueThrust(int iTurbGlob, double* torque, double* thrust, int nSize) { + + int iTurbLoc = get_localTurbNo(iTurbGlob) ; + if (turbineData[iTurbLoc].sType != EXTINFLOW) + return; + + //Compute the torque and thrust based on the forces at the actuator nodes + std::vector relLoc(3,0.0); + std::vector rPerpShft(3); + thrust[0] = 0.0; thrust[1] = 0.0; thrust[2] = 0.0; + torque[0] = 0.0; torque[1] = 0.0; torque[2] = 0.0; + + std::vector hubShftVec(3); + getHubShftDir(hubShftVec, iTurbGlob, fast::STATE_NP1); + + int nfpts = get_numForcePtsBlade(iTurbLoc); + for (int k=0; k < get_numBladesLoc(iTurbLoc); k++) { + for (int j=0; j < nfpts; j++) { + int iNode = 1 + nfpts*k + j ; + + thrust[0] = thrust[0] + extinfw_i_f_FAST[iTurbLoc].fx[iNode] ; + thrust[1] = thrust[1] + extinfw_i_f_FAST[iTurbLoc].fy[iNode] ; + thrust[2] = thrust[2] + extinfw_i_f_FAST[iTurbLoc].fz[iNode] ; + + relLoc[0] = extinfw_i_f_FAST[iTurbLoc].pxForce[iNode] - extinfw_i_f_FAST[iTurbLoc].pxForce[0] ; + relLoc[1] = extinfw_i_f_FAST[iTurbLoc].pyForce[iNode] - extinfw_i_f_FAST[iTurbLoc].pyForce[0]; + relLoc[2] = extinfw_i_f_FAST[iTurbLoc].pzForce[iNode] - extinfw_i_f_FAST[iTurbLoc].pzForce[0]; + + double rDotHubShftVec = relLoc[0]*hubShftVec[0] + relLoc[1]*hubShftVec[1] + relLoc[2]*hubShftVec[2]; + for (int j=0; j < 3; j++) rPerpShft[j] = relLoc[j] - rDotHubShftVec * hubShftVec[j]; + + torque[0] = torque[0] + rPerpShft[1] * extinfw_i_f_FAST[iTurbLoc].fz[iNode] - rPerpShft[2] * extinfw_i_f_FAST[iTurbLoc].fy[iNode] + extinfw_i_f_FAST[iTurbLoc].momentx[iNode] ; + torque[1] = torque[1] + rPerpShft[2] * extinfw_i_f_FAST[iTurbLoc].fx[iNode] - rPerpShft[0] * extinfw_i_f_FAST[iTurbLoc].fz[iNode] + extinfw_i_f_FAST[iTurbLoc].momenty[iNode] ; + torque[2] = torque[2] + rPerpShft[0] * extinfw_i_f_FAST[iTurbLoc].fy[iNode] - rPerpShft[1] * extinfw_i_f_FAST[iTurbLoc].fx[iNode] + extinfw_i_f_FAST[iTurbLoc].momentz[iNode] ; + + } + } +} + +fast::ActuatorNodeType fast::OpenFAST::getVelNodeType(int iTurbGlob, int iNode) { + // Return the type of velocity node for the given node number. The node ordering (from FAST) is + // Node 0 - Hub node + // Blade 1 nodes + // Blade 2 nodes + // Blade 3 nodes + // Tower nodes + + int iTurbLoc = get_localTurbNo(iTurbGlob); + for(int j=0; j < iTurbLoc; j++) iNode = iNode - get_numVelPtsLoc(iTurbGlob); + if (iNode) { + if ( (iNode + 1 - (get_numVelPts(iTurbLoc) - get_numVelPtsTwr(iTurbLoc)) ) > 0) { + return TOWER; + } + else { + return BLADE; + } + } + else { + return HUB; + } + +} + +fast::ActuatorNodeType fast::OpenFAST::getForceNodeType(int iTurbGlob, int iNode) { + // Return the type of actuator force node for the given node number. The node ordering (from FAST) is + // Node 0 - Hub node + // Blade 1 nodes + // Blade 2 nodes + // Blade 3 nodes + // Tower nodes + + int iTurbLoc = get_localTurbNo(iTurbGlob); + for(int j=0; j < iTurbLoc; j++) iNode = iNode - get_numForcePtsLoc(iTurbGlob); + if (iNode) { + if ( (iNode + 1 - (get_numForcePts(iTurbLoc) - get_numForcePtsTwr(iTurbLoc)) ) > 0) { + return TOWER; + } + else { + return BLADE; + } + } + else { + return HUB; + } +} + +void fast::OpenFAST::allocateMemory_preInit() { + + for (int iTurb=0; iTurb < nTurbinesGlob; iTurb++) { + if (dryRun) { + if(worldMPIRank == 0) { + std::cout << "iTurb = " << iTurb << " turbineMapGlobToProc[iTurb] = " << turbineMapGlobToProc[iTurb] << std::endl ; + } + } + if(worldMPIRank == turbineMapGlobToProc[iTurb]) { + turbineMapProcToGlob[nTurbinesProc] = iTurb; + reverseTurbineMapProcToGlob[iTurb] = nTurbinesProc; + nTurbinesProc++ ; + } + turbineSetProcs.insert(turbineMapGlobToProc[iTurb]); + } + + if(scStatus) { + std::cout << "Use of Supercontroller is not supported through the C++ API right now" << std::endl; + // scio.from_SC.resize(nTurbinesProc); + } + + int nProcsWithTurbines=0; + turbineProcs.resize(turbineSetProcs.size()); + + for (std::set::const_iterator p = turbineSetProcs.begin(); p != turbineSetProcs.end(); p++) { + turbineProcs[nProcsWithTurbines] = *p; + nProcsWithTurbines++ ; + } + + if (dryRun) { + if (nTurbinesProc > 0) { + std::ofstream turbineAllocFile; + turbineAllocFile.open("turbineAlloc." + std::to_string(worldMPIRank) + ".txt") ; + for (int iTurb=0; iTurb < nTurbinesProc; iTurb++) { + turbineAllocFile << "Proc " << worldMPIRank << " loc iTurb " << iTurb << " glob iTurb " << turbineMapProcToGlob[iTurb] << std::endl ; + } + turbineAllocFile.flush(); + turbineAllocFile.close() ; + } + } + + // // Construct a group containing all procs running atleast 1 turbine in FAST + // MPI_Group_incl(worldMPIGroup, nProcsWithTurbines, &turbineProcs[0], &fastMPIGroup) ; + // int fastMPIcommTag = MPI_Comm_create(mpiComm, fastMPIGroup, &fastMPIComm); + // if (MPI_COMM_NULL != fastMPIComm) { + // MPI_Comm_rank(fastMPIComm, &fastMPIRank); + // } + + turbineData.resize(nTurbinesProc); + velForceNodeData.resize(nTurbinesProc); + brFSIData.resize(nTurbinesProc); + + for (int iTurb=0; iTurb < nTurbinesProc; iTurb++) { + + turbineData[iTurb].TurbineBasePos.resize(3); + turbineData[iTurb].TurbineHubPos.resize(3); + + int iTurbGlob = turbineMapProcToGlob[iTurb]; + turbineData[iTurb].TurbID = globTurbineData[iTurbGlob].TurbID; + turbineData[iTurb].sType = globTurbineData[iTurbGlob].sType; + turbineData[iTurb].FASTInputFileName = globTurbineData[iTurbGlob].FASTInputFileName ; + turbineData[iTurb].FASTRestartFileName = globTurbineData[iTurbGlob].FASTRestartFileName ; + for(int i=0;i<3;i++) { + turbineData[iTurb].TurbineBasePos[i] = globTurbineData[iTurbGlob].TurbineBasePos[i]; + turbineData[iTurb].TurbineHubPos[i] = globTurbineData[iTurbGlob].TurbineHubPos[i]; + } + turbineData[iTurb].numForcePtsBlade = globTurbineData[iTurbGlob].numForcePtsBlade; + turbineData[iTurb].numForcePtsTwr = globTurbineData[iTurbGlob].numForcePtsTwr; + turbineData[iTurb].azBlendMean = globTurbineData[iTurbGlob].azBlendMean; + turbineData[iTurb].azBlendDelta = globTurbineData[iTurbGlob].azBlendDelta; + + velForceNodeData[iTurb].resize(4); // To hold data for 4 time steps + brFSIData[iTurb].resize(4); + + } + + // Allocate memory for Turbine datastructure for all turbines + FAST_AllocateTurbines(&nTurbinesProc, &ErrStat, ErrMsg); + + // Allocate memory for ExtInfw Input types in FAST + extinfw_i_f_FAST.resize(nTurbinesProc) ; + extinfw_o_t_FAST.resize(nTurbinesProc) ; + + // Allocate memory for ExtLd Input/Parameter/Output types in FAST + extld_i_f_FAST.resize(nTurbinesProc) ; + extld_p_f_FAST.resize(nTurbinesProc) ; + extld_o_t_FAST.resize(nTurbinesProc) ; + + if(scStatus) { + std::cout << "Use of Supercontroller is not supported through the C++ API right now" << std::endl; + // scio.from_SC.resize(nTurbinesProc); + } + +} + +void fast::OpenFAST::allocateMemory_postInit(int iTurbLoc) { + + if (turbineData[iTurbLoc].sType == EXTINFLOW) { + turbineData[iTurbLoc].nBRfsiPtsBlade = std::vector(turbineData[iTurbLoc].numBlades,0); + turbineData[iTurbLoc].nBRfsiPtsTwr = 0; + + if ( turbineData[iTurbLoc].inflowType == 1) { + // Inflow data is coming from inflow module + turbineData[iTurbLoc].numForcePtsTwr = 0; + turbineData[iTurbLoc].numForcePtsBlade = 0; + turbineData[iTurbLoc].numForcePts = 0; + turbineData[iTurbLoc].numVelPtsTwr = 0; + turbineData[iTurbLoc].numVelPtsBlade = 0; + turbineData[iTurbLoc].numVelPts = 0; + } else { + //Inflow data is coming from external program like a CFD solver + turbineData[iTurbLoc].numForcePts = 1 + turbineData[iTurbLoc].numForcePtsTwr + turbineData[iTurbLoc].numBlades * turbineData[iTurbLoc].numForcePtsBlade ; + turbineData[iTurbLoc].numVelPts = 1 + turbineData[iTurbLoc].numVelPtsTwr + turbineData[iTurbLoc].numBlades * turbineData[iTurbLoc].numVelPtsBlade ; + + int nfpts = get_numForcePtsLoc(iTurbLoc); + int nvelpts = get_numVelPtsLoc(iTurbLoc); + + velForceNodeData[iTurbLoc][3].xref_force.resize(3*nfpts); + for(int k=0; k<4; k++) { + velForceNodeData[iTurbLoc][k].x_vel.resize(3*nvelpts) ; + velForceNodeData[iTurbLoc][k].vel_vel.resize(3*nvelpts) ; + velForceNodeData[iTurbLoc][k].x_force.resize(3*nfpts) ; + velForceNodeData[iTurbLoc][k].xdot_force.resize(3*nfpts) ; + velForceNodeData[iTurbLoc][k].orient_force.resize(9*nfpts) ; + velForceNodeData[iTurbLoc][k].vel_force.resize(3*nfpts) ; + velForceNodeData[iTurbLoc][k].force.resize(3*nfpts) ; + } + + if ( isDebug() ) { + for (int iNode=0; iNode < get_numVelPtsLoc(iTurbLoc); iNode++) { + std::cout << "Node " << iNode << " Position = " << extinfw_i_f_FAST[iTurbLoc].pxVel[iNode] << " " << extinfw_i_f_FAST[iTurbLoc].pyVel[iNode] << " " << extinfw_i_f_FAST[iTurbLoc].pzVel[iNode] << " " << std::endl ; + } + } + } + std::cerr << "turbineData[iTurbLoc].inflowType " << turbineData[iTurbLoc].inflowType << std::endl; + std::cerr << "turbineData[iTurbLoc].numForcePtsTwr = " << turbineData[iTurbLoc].numForcePtsTwr << std::endl; + std::cerr << "turbineData[iTurbLoc].numForcePtsBlade = " << turbineData[iTurbLoc].numForcePtsBlade << std::endl; + std::cerr << "turbineData[iTurbLoc].numForcePts = " << turbineData[iTurbLoc].numForcePts << std::endl; + + + } else if (turbineData[iTurbLoc].sType == EXTLOADS) { + turbineData[iTurbLoc].nBRfsiPtsBlade.resize(turbineData[iTurbLoc].numBlades); + int nTotBldNds = 0; + for(int i=0; i < turbineData[iTurbLoc].numBlades; i++) { + nTotBldNds += extld_p_f_FAST[iTurbLoc].nBladeNodes[i]; + turbineData[iTurbLoc].nBRfsiPtsBlade[i] = extld_p_f_FAST[iTurbLoc].nBladeNodes[i]; + turbineData[iTurbLoc].nTotBRfsiPtsBlade += turbineData[iTurbLoc].nBRfsiPtsBlade[i]; + } + turbineData[iTurbLoc].nBRfsiPtsTwr = extld_p_f_FAST[iTurbLoc].nTowerNodes[0]; + + // Allocate memory for reference position only for 1 time step - np1 + for(int k=0; k<4; k++) { + brFSIData[iTurbLoc][k].twr_ref_pos.resize(6*turbineData[iTurbLoc].nBRfsiPtsTwr); + brFSIData[iTurbLoc][k].twr_def.resize(6*turbineData[iTurbLoc].nBRfsiPtsTwr); + brFSIData[iTurbLoc][k].twr_vel.resize(6*turbineData[iTurbLoc].nBRfsiPtsTwr); + brFSIData[iTurbLoc][k].bld_rloc.resize(nTotBldNds); + brFSIData[iTurbLoc][k].bld_chord.resize(nTotBldNds); + brFSIData[iTurbLoc][k].bld_ref_pos.resize(6*nTotBldNds); + brFSIData[iTurbLoc][k].bld_def.resize(6*nTotBldNds); + brFSIData[iTurbLoc][k].bld_vel.resize(6*nTotBldNds); + brFSIData[iTurbLoc][k].twr_ld.resize(6*turbineData[iTurbLoc].nBRfsiPtsTwr); + brFSIData[iTurbLoc][k].bld_ld.resize(6*nTotBldNds); + brFSIData[iTurbLoc][k].hub_ref_pos.resize(6); + brFSIData[iTurbLoc][k].hub_def.resize(6); + brFSIData[iTurbLoc][k].hub_vel.resize(6); + brFSIData[iTurbLoc][k].nac_ref_pos.resize(6); + brFSIData[iTurbLoc][k].nac_def.resize(6); + brFSIData[iTurbLoc][k].nac_vel.resize(6); + brFSIData[iTurbLoc][k].hub_ref_pos.resize(6); + brFSIData[iTurbLoc][k].bld_pitch.resize(turbineData[iTurbLoc].numBlades); + brFSIData[iTurbLoc][k].bld_root_ref_pos.resize(6*turbineData[iTurbLoc].numBlades); + brFSIData[iTurbLoc][k].bld_root_def.resize(6*turbineData[iTurbLoc].numBlades); + } + } + +} + +void fast::OpenFAST::allocateTurbinesToProcsSimple() { + // Allocate turbines to each processor - round robin fashion + int nProcs ; + MPI_Comm_size(mpiComm, &nProcs); + for(int j = 0; j < nTurbinesGlob; j++) turbineMapGlobToProc[j] = j % nProcs ; +} + +void fast::OpenFAST::end() { + + // Deallocate types we allocated earlier + + if ( !dryRun) { + bool stopTheProgram = false; + for (int iTurb=0; iTurb < nTurbinesProc; iTurb++) { + FAST_End(&iTurb, &stopTheProgram); + } + } + + // MPI_Group_free(&fastMPIGroup); + // if (MPI_COMM_NULL != fastMPIComm) { + // MPI_Comm_free(&fastMPIComm); + // } + // MPI_Group_free(&worldMPIGroup); + + if(scStatus) { + std::cout << "Use of Supercontroller is not supported through the C++ API right now" << std::endl; + // sc.end(); + } + +} + +int fast::OpenFAST::read_nlin_iters(int iTurb, int n_t_global, int ncid) { + + int nlin_iters = 0; + size_t count1 = 1; + size_t n_tsteps = n_t_global; + int ierr = nc_get_vara_int(ncid, 1, &n_tsteps, &count1, &nlin_iters); + + return nlin_iters; + +} + + +void fast::OpenFAST::readVelocityData(int iTurb, int n_t_global, int nlinIter, int ncid) { + + size_t n_tsteps = n_t_global; + const std::vector start_dim{n_tsteps, static_cast(nlinIter), 0}; + int nVelPts = get_numVelPtsLoc(iTurb); + const std::vector velPtsDataDims{1, 1, static_cast(3*nVelPts)}; + int ierr = nc_get_vara_double(ncid, 2, start_dim.data(), velPtsDataDims.data(), velForceNodeData[iTurb][fast::STATE_NP1].vel_vel.data()); +} + +int fast::OpenFAST::openVelocityDataFile(int iTurb) { + + int ncid; + std::stringstream velfile_fstream; + velfile_fstream << "turb_" ; + velfile_fstream << std::setfill('0') << std::setw(2) << turbineData[iTurb].TurbID; + velfile_fstream << "_veldata.nc"; + std::string velfile_filename = velfile_fstream.str(); + int ierr = nc_open(velfile_filename.c_str(), NC_WRITE, &ncid); + check_nc_error(ierr, "nc_open"); + return ncid; + +} + +void fast::OpenFAST::prepareVelocityDataFile(int iTurb) { + + // Open the file in create mode - this will destory any file + int ncid; + std::stringstream velfile_fstream; + velfile_fstream << "turb_" ; + velfile_fstream << std::setfill('0') << std::setw(2) << turbineData[iTurb].TurbID; + velfile_fstream << "_veldata.nc"; + std::string velfile_filename = velfile_fstream.str(); + int ierr = nc_create(velfile_filename.c_str(), NC_CLOBBER, &ncid); + check_nc_error(ierr, "nc_create"); + + //Define dimensions + int tmpDimID; + ierr = nc_def_dim(ncid, "n_tsteps", NC_UNLIMITED, &tmpDimID); + ierr = nc_def_dim(ncid, "n_nonlin_iters_max", 2, &tmpDimID); + ierr = nc_def_dim(ncid, "n_vel_pts_data", turbineData[iTurb].numVelPts*3, &tmpDimID); + + int tmpVarID; + tmpDimID = 0; + ierr = nc_def_var(ncid, "time", NC_DOUBLE, 1, &tmpDimID, &tmpVarID); + ierr = nc_def_var(ncid, "nlin_iters", NC_INT, 1, &tmpDimID, &tmpVarID); + const std::vector velPtsDataDims{0, 1, 2}; + ierr = nc_def_var(ncid, "vel_vel", NC_DOUBLE, 3, velPtsDataDims.data(), &tmpVarID); + + //! Indicate that we are done defining variables, ready to write data + ierr = nc_enddef(ncid); + check_nc_error(ierr, "nc_enddef"); + ierr = nc_close(ncid); + check_nc_error(ierr, "nc_close"); +} + +void fast::OpenFAST::writeVelocityData(int iTurb, int n_t_global, int nlinIter) { + + /* // NetCDF stuff to write velocity data to file */ + int ncid; + //Find the file and open it in append mode + std::stringstream velfile_ss; + velfile_ss << "turb_" ; + velfile_ss << std::setfill('0') << std::setw(2) << turbineData[iTurb].TurbID; + velfile_ss << "_veldata.nc"; + std::string vel_filename = velfile_ss.str(); + int ierr = nc_open(vel_filename.c_str(), NC_WRITE, &ncid); + check_nc_error(ierr, "nc_open"); + + size_t count1=1; + size_t n_tsteps = (n_t_global/nSubsteps_)+1; + double curTime = (n_t_global + nSubsteps_) * dtFAST; + ierr = nc_put_vara_double(ncid, 0, &n_tsteps, &count1, &curTime); + int nVelPts = get_numVelPtsLoc(iTurb) ; + const std::vector velPtsDataDims{1, 1, static_cast(3*nVelPts)}; + const std::vector start_dim{static_cast(n_tsteps),static_cast(nlinIter),0}; + + std::cout << "Writing velocity data at time step " << n_tsteps << ", nonlinear iteration " << nlinIter << std::endl ; + ierr = nc_put_vara_double(ncid, 2, start_dim.data(), velPtsDataDims.data(), velForceNodeData[iTurb][3].vel_vel.data()); + nlinIter += 1; // To account for 0-based indexing + ierr = nc_put_vara_int(ncid, 1, &n_tsteps, &count1, &nlinIter); + + nc_close(ncid); + +} + +void fast::OpenFAST::send_data_to_openfast(fast::timeStep t) { + + for (int iTurb=0; iTurb < nTurbinesProc; iTurb++) { + if ( (turbineData[iTurb].sType == EXTINFLOW) && (turbineData[iTurb].inflowType == 2) ) { + int nvelpts = get_numVelPtsLoc(iTurb); + for (int iNodeVel=0; iNodeVel < nvelpts; iNodeVel++) { + extinfw_o_t_FAST[iTurb].u[iNodeVel] = velForceNodeData[iTurb][t].vel_vel[iNodeVel*3+0]; + extinfw_o_t_FAST[iTurb].v[iNodeVel] = velForceNodeData[iTurb][t].vel_vel[iNodeVel*3+1]; + extinfw_o_t_FAST[iTurb].w[iNodeVel] = velForceNodeData[iTurb][t].vel_vel[iNodeVel*3+2]; + } + } else if(turbineData[iTurb].sType == EXTLOADS) { + + int nBlades = turbineData[iTurb].numBlades; + int iRunTot = 0; + for(int i=0; i < nBlades; i++) { + int nPtsBlade = turbineData[iTurb].nBRfsiPtsBlade[i]; + for (int j=0; j < nPtsBlade; j++) { + for (int k=0; k<6; k++) { + extld_o_t_FAST[iTurb].bldLd[iRunTot*6+k] = brFSIData[iTurb][t].bld_ld[iRunTot*6+k]; + } + iRunTot++; + } + } + + int nPtsTwr = turbineData[iTurb].nBRfsiPtsTwr; + for (int i=0; i < nPtsTwr*6; i++) + extld_o_t_FAST[iTurb].twrLd[i] = brFSIData[iTurb][t].twr_ld[i]; + + } + + } +} + +void fast::OpenFAST::send_data_to_openfast(double ss_time) { + + for (int iTurb=0; iTurb < nTurbinesProc; iTurb++) { + if (turbineData[iTurb].inflowType == 2) { + int nvelpts = get_numVelPtsLoc(iTurb); + for (int iNodeVel=0; iNodeVel < nvelpts; iNodeVel++) { + extinfw_o_t_FAST[iTurb].u[iNodeVel] = velForceNodeData[iTurb][fast::STATE_N].vel_vel[iNodeVel*3+0] + ss_time * (velForceNodeData[iTurb][fast::STATE_NP1].vel_vel[iNodeVel*3+0] - velForceNodeData[iTurb][fast::STATE_N].vel_vel[iNodeVel*3+0]); + extinfw_o_t_FAST[iTurb].v[iNodeVel] = velForceNodeData[iTurb][fast::STATE_N].vel_vel[iNodeVel*3+1] + ss_time * (velForceNodeData[iTurb][fast::STATE_NP1].vel_vel[iNodeVel*3+1] - velForceNodeData[iTurb][fast::STATE_N].vel_vel[iNodeVel*3+1]); + extinfw_o_t_FAST[iTurb].w[iNodeVel] = velForceNodeData[iTurb][fast::STATE_N].vel_vel[iNodeVel*3+2] + ss_time * (velForceNodeData[iTurb][fast::STATE_NP1].vel_vel[iNodeVel*3+2] - velForceNodeData[iTurb][fast::STATE_N].vel_vel[iNodeVel*3+2]); + } + } else if(turbineData[iTurb].sType == EXTLOADS) { + + int nBlades = turbineData[iTurb].numBlades; + int iRunTot = 0; + for(int i=0; i < nBlades; i++) { + int nPtsBlade = turbineData[iTurb].nBRfsiPtsBlade[i]; + for (int j=0; j < nPtsBlade; j++) { + for (int k=0; k<6; k++) { + extld_o_t_FAST[iTurb].bldLd[iRunTot*6+k] = brFSIData[iTurb][fast::STATE_N].bld_ld[iRunTot*6+k] + ss_time * (brFSIData[iTurb][fast::STATE_NP1].bld_ld[iRunTot*6+k] - brFSIData[iTurb][fast::STATE_N].bld_ld[iRunTot*6+k]); + } + iRunTot++; + } + } + + int nPtsTwr = turbineData[iTurb].nBRfsiPtsTwr; + for (int i=0; i < nPtsTwr*6; i++) + extld_o_t_FAST[iTurb].twrLd[i] = brFSIData[iTurb][fast::STATE_N].twr_ld[i] + ss_time * (brFSIData[iTurb][fast::STATE_NP1].twr_ld[i] - brFSIData[iTurb][fast::STATE_N].twr_ld[i]); + + } + } + +} + +void fast::OpenFAST::get_data_from_openfast(timeStep t) { + + + for (int iTurb=0; iTurb < nTurbinesProc; iTurb++) { + + if(turbineData[iTurb].sType == EXTINFLOW) { + + if (turbineData[iTurb].inflowType == 2) { + int nvelpts = get_numVelPtsLoc(iTurb); + int nfpts = get_numForcePtsLoc(iTurb); + // std::cerr << "nvelpts = " << nvelpts << std::endl; + // std::cerr << "nfpts = " << nfpts << " " << get_numForcePtsBladeLoc(iTurb) << " " << get_numForcePtsTwrLoc(iTurb) << std::endl; + for (int i=0; i velPtsDataDims{1, 1, static_cast(3*nvelpts)}; + const std::vector forcePtsDataDims{1, 1, static_cast(3*nfpts)}; + const std::vector forcePtsOrientDataDims{1, 1, static_cast(9*nfpts)}; + + ierr = nc_get_var_double(ncid, ncRstVarIDs_["xref_force"], velForceNodeData[iTurbLoc][fast::STATE_NP1].xref_force.data()); + + for (size_t j=0; j < 4; j++) { // Loop over states - NM2, STATE_NM1, N, NP1 + + const std::vector start_dim{n_tsteps,j,0}; + + ierr = nc_get_vara_double(ncid, ncRstVarIDs_["x_vel"], start_dim.data(), velPtsDataDims.data(), velForceNodeData[iTurbLoc][j].x_vel.data()); + ierr = nc_get_vara_double(ncid, ncRstVarIDs_["vel_vel"], start_dim.data(), velPtsDataDims.data(), velForceNodeData[iTurbLoc][j].vel_vel.data()); + ierr = nc_get_vara_double(ncid, ncRstVarIDs_["x_force"], start_dim.data(), forcePtsDataDims.data(), velForceNodeData[iTurbLoc][j].x_force.data()); + ierr = nc_get_vara_double(ncid, ncRstVarIDs_["xdot_force"], start_dim.data(), forcePtsDataDims.data(), velForceNodeData[iTurbLoc][j].xdot_force.data()); + ierr = nc_get_vara_double(ncid, ncRstVarIDs_["vel_force"], start_dim.data(), forcePtsDataDims.data(), velForceNodeData[iTurbLoc][j].vel_force.data()); + ierr = nc_get_vara_double(ncid, ncRstVarIDs_["force"], start_dim.data(), forcePtsDataDims.data(), velForceNodeData[iTurbLoc][j].force.data()); + ierr = nc_get_vara_double(ncid, ncRstVarIDs_["orient_force"], start_dim.data(), forcePtsOrientDataDims.data(), velForceNodeData[iTurbLoc][j].orient_force.data()); + + } + + } else if (turbineData[iTurbLoc].sType == EXTLOADS) { + + int nBRfsiPtsTwr = turbineData[iTurbLoc].nBRfsiPtsTwr; + int nTotBRfsiPtsBlade = turbineData[iTurbLoc].nTotBRfsiPtsBlade; + int nBlades = turbineData[iTurbLoc].numBlades; + const std::vector twrDataDims{1, 1, static_cast(6*nBRfsiPtsTwr)}; + const std::vector bldDataDims{1, 1, static_cast(6*nTotBRfsiPtsBlade)}; + const std::vector bldRootDataDims{1, 1, static_cast(6*nBlades)}; + const std::vector bldPitchDataDims{1, 1, static_cast(nBlades)}; + const std::vector ptDataDims{1, 1, 6}; + + for (size_t j=0; j < 4; j++) { // Loop over states - NM2, STATE_NM1, N, NP1 + + const std::vector start_dim{n_tsteps, j, 0}; + + ierr = nc_get_vara_double(ncid, ncRstVarIDs_["twr_def"], start_dim.data(), twrDataDims.data(), brFSIData[iTurbLoc][j].twr_def.data()); + ierr = nc_get_vara_double(ncid, ncRstVarIDs_["twr_vel"], start_dim.data(), twrDataDims.data(), brFSIData[iTurbLoc][j].twr_vel.data()); + ierr = nc_get_vara_double(ncid, ncRstVarIDs_["twr_ld"], start_dim.data(), twrDataDims.data(), brFSIData[iTurbLoc][j].twr_ld.data()); + + ierr = nc_get_vara_double(ncid, ncRstVarIDs_["bld_def"], start_dim.data(), bldDataDims.data(), brFSIData[iTurbLoc][j].bld_def.data()); + ierr = nc_get_vara_double(ncid, ncRstVarIDs_["bld_vel"], start_dim.data(), bldDataDims.data(), brFSIData[iTurbLoc][j].bld_vel.data()); + ierr = nc_get_vara_double(ncid, ncRstVarIDs_["bld_ld"], start_dim.data(), bldDataDims.data(), brFSIData[iTurbLoc][j].bld_ld.data()); + + ierr = nc_get_vara_double(ncid, ncRstVarIDs_["hub_def"], start_dim.data(), ptDataDims.data(), brFSIData[iTurbLoc][j].hub_def.data()); + ierr = nc_get_vara_double(ncid, ncRstVarIDs_["hub_vel"], start_dim.data(), ptDataDims.data(), brFSIData[iTurbLoc][j].hub_vel.data()); + + ierr = nc_get_vara_double(ncid, ncRstVarIDs_["nac_def"], start_dim.data(), ptDataDims.data(), brFSIData[iTurbLoc][j].nac_def.data()); + ierr = nc_get_vara_double(ncid, ncRstVarIDs_["nac_vel"], start_dim.data(), ptDataDims.data(), brFSIData[iTurbLoc][j].nac_vel.data()); + + ierr = nc_get_vara_double(ncid, ncRstVarIDs_["bld_root_def"], start_dim.data(), bldRootDataDims.data(), brFSIData[iTurbLoc][j].bld_root_def.data()); + ierr = nc_get_vara_double(ncid, ncRstVarIDs_["bld_pitch"], start_dim.data(), bldPitchDataDims.data(), brFSIData[iTurbLoc][j].bld_pitch.data()); + + } + + + + } + + nc_close(ncid); + +} + +void fast::OpenFAST::cross(double * a, double * b, double * aCrossb) { + + aCrossb[0] = a[1]*b[2] - a[2]*b[1]; + aCrossb[1] = a[2]*b[0] - a[0]*b[2]; + aCrossb[2] = a[0]*b[1] - a[1]*b[0]; + +} + + +//! Apply a DCM rotation 'dcm' to a vector 'r' into 'rRot'. To optionally transpose the rotation, set 'tranpose=-1.0'. +void fast::OpenFAST::applyDCMrotation(double * dcm, double * r, double *rRot, double transpose) { + + if (transpose > 0) { + for(size_t i=0; i < 3; i++) { + rRot[i] = 0.0; + for(size_t j=0; j < 3; j++) + rRot[i] += dcm[i*3+j] * r[j]; + } + } else { + for(size_t i=0; i < 3; i++) { + rRot[i] = 0.0; + for(size_t j=0; j < 3; j++) + rRot[i] += dcm[j*3+i] * r[j]; + } + } +} + +//! Apply a Wiener-Milenkovic rotation 'wm' to a vector 'r' into 'rRot'. To optionally transpose the rotation, set 'tranpose=-1.0'. +void fast::OpenFAST::applyWMrotation(double * wm, double * r, double *rRot, double transpose) { + + double wm0 = 2.0-0.125*dot(wm, wm); + double nu = 2.0/(4.0-wm0); + double cosPhiO2 = 0.5*wm0*nu; + std::vector wmCrossR(3,0.0); + cross(wm, r, wmCrossR.data()); + std::vector wmCrosswmCrossR(3,0.0); + cross(wm, wmCrossR.data(), wmCrosswmCrossR.data()); + + for(size_t i=0; i < 3; i++) + rRot[i] = r[i] + transpose * nu * cosPhiO2 * wmCrossR[i] + 0.5 * nu * nu * wmCrosswmCrossR[i]; + +} + + +void fast::OpenFAST::writeOutputFile(int iTurbLoc, int n_t_global) { + + int ncid; + //Open the file in append mode + std::stringstream outfile_ss; + outfile_ss << "turb_" ; + outfile_ss << std::setfill('0') << std::setw(2) << turbineData[iTurbLoc].TurbID; + outfile_ss << "_output.nc"; + std::string defloads_filename = outfile_ss.str(); + int ierr = nc_open(defloads_filename.c_str(), NC_WRITE, &ncid); + check_nc_error(ierr, "nc_open"); + + size_t count1=1; + int tStepRatio = time_step_ratio(dtFAST, dtDriver); + size_t n_tsteps = n_t_global/tStepRatio/outputFreq_ - 1; + double curTime = n_t_global * dtFAST; + ierr = nc_put_vara_double(ncid, ncOutVarIDs_["time"], &n_tsteps, &count1, &curTime); + + if ( (turbineData[iTurbLoc].sType == EXTINFLOW) && (turbineData[iTurbLoc].inflowType == 2) ) { + + // Nothing to do here yet + int nBlades = get_numBladesLoc(iTurbLoc); + int nBldPts = get_numForcePtsBladeLoc(iTurbLoc); + int nTwrPts = get_numForcePtsTwrLoc(iTurbLoc); + std::vector tmpArray; + + tmpArray.resize(nTwrPts); + { + int node_twr_start = (1 + nBlades * nBldPts)*3; + std::vector count_dim{1,1,static_cast(nTwrPts)}; + for (size_t iDim=0; iDim < 3; iDim++) { + for (auto i=0; i < nTwrPts; i++) + tmpArray[i] = velForceNodeData[iTurbLoc][3].x_force[node_twr_start+i*3+iDim] - velForceNodeData[iTurbLoc][3].xref_force[node_twr_start+i*3+iDim] ; + std::vector start_dim{n_tsteps,iDim,0}; + ierr = nc_put_vara_double(ncid, ncOutVarIDs_["twr_disp"], start_dim.data(), count_dim.data(), tmpArray.data()); + } + for (size_t iDim=0; iDim < 3; iDim++) { + for (auto i=0; i < nTwrPts; i++) + tmpArray[i] = velForceNodeData[iTurbLoc][3].xdot_force[node_twr_start+i*3+iDim] ; + std::vector start_dim{n_tsteps,iDim,0}; + ierr = nc_put_vara_double(ncid, ncOutVarIDs_["twr_vel"], start_dim.data(), count_dim.data(), tmpArray.data()); + } + for (size_t iDim=0;iDim < 3; iDim++) { + for (auto i=0; i < nTwrPts; i++) + tmpArray[i] = velForceNodeData[iTurbLoc][3].force[node_twr_start+i*3+iDim] ; + std::vector start_dim{n_tsteps,iDim,0}; + ierr = nc_put_vara_double(ncid, ncOutVarIDs_["twr_ld"], start_dim.data(), count_dim.data(), tmpArray.data()); + } + } + + tmpArray.resize(nBldPts); + { + std::vector count_dim{1,1,1,static_cast(nBldPts)}; + for (size_t iDim=0;iDim < 3; iDim++) { + for (size_t iBlade=0; iBlade < nBlades; iBlade++) { + int node_bld_start = (1 + iBlade * nBldPts); + for (auto i=0; i < nBldPts; i++) + tmpArray[i] = velForceNodeData[iTurbLoc][3].x_force[(node_bld_start+i)*3+iDim] - velForceNodeData[iTurbLoc][3].xref_force[(node_bld_start+i)*3+iDim] ; + std::vector start_dim{n_tsteps,iBlade,iDim,0}; + ierr = nc_put_vara_double(ncid, ncOutVarIDs_["bld_disp"], start_dim.data(), count_dim.data(), tmpArray.data()); + } + } + for (size_t iDim=0;iDim < 3; iDim++) { + int iStart = 0 ; + for (size_t iBlade=0; iBlade < nBlades; iBlade++) { + int node_bld_start = (1 + iBlade * nBldPts); + for (auto i=0; i < nBldPts; i++) + tmpArray[i] = velForceNodeData[iTurbLoc][3].xdot_force[(node_bld_start+i)*3+iDim] ; + std::vector start_dim{n_tsteps,iBlade,iDim,0}; + ierr = nc_put_vara_double(ncid, ncOutVarIDs_["bld_vel"], start_dim.data(), count_dim.data(), tmpArray.data()); + } + } + for (size_t iDim=0;iDim < 3; iDim++) { + int iStart = 0 ; + for (size_t iBlade=0; iBlade < nBlades; iBlade++) { + int node_bld_start = (1 + iBlade * nBldPts); + for (auto i=0; i < nBldPts; i++) + tmpArray[i] = velForceNodeData[iTurbLoc][3].force[(node_bld_start+i)*3+iDim] ; + std::vector start_dim{n_tsteps,iBlade,iDim,0}; + ierr = nc_put_vara_double(ncid, ncOutVarIDs_["bld_ld"], start_dim.data(), count_dim.data(), tmpArray.data()); + } + } + + std::vector ld_loc(3*nBlades*nBldPts,0.0); + for (auto iBlade=0; iBlade < nBlades; iBlade++) { + int node_bld_start = (1 + iBlade * nBldPts); + for (auto i=0; i < nBldPts; i++) { + applyDCMrotation(&velForceNodeData[iTurbLoc][3].orient_force[(node_bld_start + i)*9], &velForceNodeData[iTurbLoc][3].force[(node_bld_start+i)*3], &ld_loc[(node_bld_start-1)*3]); + } + } + for (size_t iDim=0;iDim < 3; iDim++) { + int iStart = 0 ; + for (size_t iBlade=0; iBlade < nBlades; iBlade++) { + int node_bld_start = (iBlade * nBldPts); + for (auto i=0; i < nBldPts; i++) + tmpArray[i] = ld_loc[(node_bld_start+i)*3+iDim]; + std::vector start_dim{n_tsteps,iBlade,iDim,0}; + ierr = nc_put_vara_double(ncid, ncOutVarIDs_["bld_ld_loc"], start_dim.data(), count_dim.data(), tmpArray.data()); + } + } + } + + tmpArray.resize(3); + for (auto i=0; i < 3; i++) + tmpArray[i] = velForceNodeData[iTurbLoc][3].x_force[i] - velForceNodeData[iTurbLoc][3].xref_force[i]; + std::vector start_dim{n_tsteps, 0}; + std::vector count_dim{1,3}; + ierr = nc_put_vara_double(ncid, ncOutVarIDs_["hub_disp"], start_dim.data(), count_dim.data(), tmpArray.data()); + ierr = nc_put_vara_double(ncid, ncOutVarIDs_["hub_vel"], start_dim.data(), count_dim.data(), &velForceNodeData[iTurbLoc][3].xdot_force[0]); + ierr = nc_put_vara_double(ncid, ncOutVarIDs_["hub_ld"], start_dim.data(), count_dim.data(), &velForceNodeData[iTurbLoc][3].force[0]); + + } else if (turbineData[iTurbLoc].sType == EXTLOADS) { + + int nBlades = turbineData[iTurbLoc].numBlades; + int nTwrPts = turbineData[iTurbLoc].nBRfsiPtsTwr; + int nTotBldPts = turbineData[iTurbLoc].nTotBRfsiPtsBlade; + int nBldPts = nTotBldPts/nBlades; + + std::vector tmpArray; + tmpArray.resize(nTwrPts); + std::vector count_dim{1,1,static_cast(nTwrPts)}; + for (size_t iDim=0;iDim < 3; iDim++) { + for (auto i=0; i < nTwrPts; i++) { + tmpArray[i] = brFSIData[iTurbLoc][3].twr_def[i*6+iDim] ; + // std::cerr << "Twr displacement Node " << i << ", dimension " << iDim << " = " + // << brFSIData[iTurbLoc][3].twr_ref_pos[i*6+iDim] << " " + // << brFSIData[iTurbLoc][3].twr_def[i*6+iDim] << std::endl; + } + std::vector start_dim{n_tsteps,iDim,0}; + ierr = nc_put_vara_double(ncid, ncOutVarIDs_["twr_disp"], start_dim.data(), count_dim.data(), tmpArray.data()); + } + + for (size_t iDim=0;iDim < 3; iDim++) { + for (auto i=0; i < nTwrPts; i++) + tmpArray[i] = brFSIData[iTurbLoc][3].twr_def[i*6+3+iDim] ; + std::vector start_dim{n_tsteps,iDim,0}; + ierr = nc_put_vara_double(ncid, ncOutVarIDs_["twr_orient"], start_dim.data(), count_dim.data(), tmpArray.data()); + } + for (size_t iDim=0;iDim < 3; iDim++) { + for (auto i=0; i < nTwrPts; i++) + tmpArray[i] = brFSIData[iTurbLoc][3].twr_vel[i*6+iDim] ; + std::vector start_dim{n_tsteps,iDim,0}; + ierr = nc_put_vara_double(ncid, ncOutVarIDs_["twr_vel"], start_dim.data(), count_dim.data(), tmpArray.data()); + } + for (size_t iDim=0;iDim < 3; iDim++) { + for (auto i=0; i < nTwrPts; i++) + tmpArray[i] = brFSIData[iTurbLoc][3].twr_vel[i*6+3+iDim] ; + std::vector start_dim{n_tsteps,iDim,0}; + ierr = nc_put_vara_double(ncid, ncOutVarIDs_["twr_rotvel"], start_dim.data(), count_dim.data(), tmpArray.data()); + } + + for (size_t iDim=0;iDim < 3; iDim++) { + for (auto i=0; i < nTwrPts; i++) + tmpArray[i] = brFSIData[iTurbLoc][3].twr_ld[i*6+iDim] ; + std::vector start_dim{n_tsteps,iDim,0}; + ierr = nc_put_vara_double(ncid, ncOutVarIDs_["twr_ld"], start_dim.data(), count_dim.data(), tmpArray.data()); + } + for (size_t iDim=0;iDim < 3; iDim++) { + for (auto i=0; i < nTwrPts; i++) + tmpArray[i] = brFSIData[iTurbLoc][3].twr_ld[i*6+3+iDim]; + std::vector start_dim{n_tsteps,iDim,0}; + ierr = nc_put_vara_double(ncid, ncOutVarIDs_["twr_moment"], start_dim.data(), count_dim.data(), tmpArray.data()); + } + + tmpArray.resize(nBldPts); + { + std::vector count_dim{1,1,1,static_cast(nBldPts)}; + for (size_t iDim=0;iDim < 3; iDim++) { + int iStart = 0 ; + for (size_t iBlade=0; iBlade < nBlades; iBlade++) { + for (auto i=0; i < nBldPts; i++) { + tmpArray[i] = brFSIData[iTurbLoc][3].bld_def[(iStart*6)+iDim]; + iStart++; + } + std::vector start_dim{n_tsteps,iBlade,iDim,0}; + ierr = nc_put_vara_double(ncid, ncOutVarIDs_["bld_disp"], start_dim.data(), count_dim.data(), tmpArray.data()); + } + } + for (size_t iDim=0;iDim < 3; iDim++) { + int iStart = 0 ; + for (size_t iBlade=0; iBlade < nBlades; iBlade++) { + for (auto i=0; i < nBldPts; i++) { + tmpArray[i] = brFSIData[iTurbLoc][3].bld_def[(iStart*6)+3+iDim]; + iStart++; + } + std::vector start_dim{n_tsteps,iBlade,iDim,0}; + ierr = nc_put_vara_double(ncid, ncOutVarIDs_["bld_orient"], start_dim.data(), count_dim.data(), tmpArray.data()); + } + } + for (size_t iDim=0;iDim < 3; iDim++) { + int iStart = 0 ; + for (size_t iBlade=0; iBlade < nBlades; iBlade++) { + for (auto i=0; i < nBldPts; i++) { + tmpArray[i] = brFSIData[iTurbLoc][3].bld_vel[(iStart*6)+iDim]; + iStart++; + } + std::vector start_dim{n_tsteps,iBlade,iDim,0}; + ierr = nc_put_vara_double(ncid, ncOutVarIDs_["bld_vel"], start_dim.data(), count_dim.data(), tmpArray.data()); + } + } + for (size_t iDim=0; iDim < 3; iDim++) { + int iStart = 0 ; + for (size_t iBlade=0; iBlade < nBlades; iBlade++) { + for (auto i=0; i < nBldPts; i++) { + tmpArray[i] = brFSIData[iTurbLoc][3].bld_vel[(iStart*6)+3+iDim]; + iStart++; + } + std::vector start_dim{n_tsteps,iBlade,iDim,0}; + ierr = nc_put_vara_double(ncid, ncOutVarIDs_["bld_rotvel"], start_dim.data(), count_dim.data(), tmpArray.data()); + } + } + for (size_t iDim=0;iDim < 3; iDim++) { + int iStart = 0 ; + for (size_t iBlade=0; iBlade < nBlades; iBlade++) { + for (auto i=0; i < nBldPts; i++) { + tmpArray[i] = brFSIData[iTurbLoc][3].bld_ld[(iStart*6)+iDim]; + iStart++; + } + std::vector start_dim{n_tsteps,iBlade,iDim,0}; + ierr = nc_put_vara_double(ncid, ncOutVarIDs_["bld_ld"], start_dim.data(), count_dim.data(), tmpArray.data()); + } + } + + std::vector ld_loc(3*nTotBldPts,0.0); + for (auto i=0; i < nTotBldPts; i++) { + applyWMrotation(&brFSIData[iTurbLoc][3].bld_def[i*6+3], &brFSIData[iTurbLoc][3].bld_ld[i*6], &ld_loc[i*3]); + } + for (size_t iDim=0;iDim < 3; iDim++) { + int iStart = 0 ; + for (size_t iBlade=0; iBlade < nBlades; iBlade++) { + for (auto i=0; i < nBldPts; i++) { + tmpArray[i] = ld_loc[iStart*3+iDim]; + iStart++; + } + std::vector start_dim{n_tsteps,iBlade,iDim,0}; + ierr = nc_put_vara_double(ncid, ncOutVarIDs_["bld_ld_loc"], start_dim.data(), count_dim.data(), tmpArray.data()); + } + } + + for (size_t iDim=0; iDim < 3; iDim++) { + int iStart = 0 ; + for (size_t iBlade=0; iBlade < nBlades; iBlade++) { + for (auto i=0; i < nBldPts; i++) { + tmpArray[i] = brFSIData[iTurbLoc][3].bld_ld[(iStart*6)+3+iDim]; + iStart++; + } + std::vector start_dim{n_tsteps,iBlade,iDim,0}; + ierr = nc_put_vara_double(ncid, ncOutVarIDs_["bld_moment"], start_dim.data(), count_dim.data(), tmpArray.data()); + } + } + + } + + { + for (size_t iBlade=0; iBlade < nBlades; iBlade++) { + + std::vector start_dim{n_tsteps, iBlade, 0}; + std::vector count_dim{1,1,3}; + + ierr = nc_put_vara_double(ncid, ncOutVarIDs_["bld_root_disp"], + start_dim.data(), + count_dim.data(), + &brFSIData[iTurbLoc][3].bld_root_def[iBlade*6+0]); + + ierr = nc_put_vara_double(ncid, ncOutVarIDs_["bld_root_orient"], + start_dim.data(), + count_dim.data(), + &brFSIData[iTurbLoc][3].bld_root_def[iBlade*6+3]); + } + } + + { + std::vector start_dim{n_tsteps, 0}; + std::vector count_dim{1,3}; + ierr = nc_put_vara_double(ncid, ncOutVarIDs_["hub_disp"], start_dim.data(), count_dim.data(), &brFSIData[iTurbLoc][3].hub_def[0]); + ierr = nc_put_vara_double(ncid, ncOutVarIDs_["hub_orient"], start_dim.data(), count_dim.data(), &brFSIData[iTurbLoc][3].hub_def[3]); + ierr = nc_put_vara_double(ncid, ncOutVarIDs_["hub_vel"], start_dim.data(), count_dim.data(), &brFSIData[iTurbLoc][3].hub_vel[0]); + ierr = nc_put_vara_double(ncid, ncOutVarIDs_["hub_rotvel"], start_dim.data(), count_dim.data(), &brFSIData[iTurbLoc][3].hub_vel[3]); + + ierr = nc_put_vara_double(ncid, ncOutVarIDs_["nac_disp"], start_dim.data(), count_dim.data(), &brFSIData[iTurbLoc][3].nac_def[0]); + ierr = nc_put_vara_double(ncid, ncOutVarIDs_["nac_orient"], start_dim.data(), count_dim.data(), &brFSIData[iTurbLoc][3].nac_def[3]); + ierr = nc_put_vara_double(ncid, ncOutVarIDs_["nac_vel"], start_dim.data(), count_dim.data(), &brFSIData[iTurbLoc][3].nac_vel[0]); + ierr = nc_put_vara_double(ncid, ncOutVarIDs_["nac_rotvel"], start_dim.data(), count_dim.data(), &brFSIData[iTurbLoc][3].nac_vel[3]); + } + } -} -void fast::OpenFAST::getVelNodeCoordinates(double* currentCoords, int iNode, int iTurbGlob, int nSize) { - assert(nSize==3); - // Set coordinates at current node of current turbine - int iTurbLoc = get_localTurbNo(iTurbGlob); - for(int j=0; j < iTurbLoc; j++) iNode = iNode - get_numVelPtsLoc(iTurbLoc); - currentCoords[0] = cDriver_Input_from_FAST[iTurbLoc].pxVel[iNode] + TurbineBasePos[iTurbLoc][0] ; - currentCoords[1] = cDriver_Input_from_FAST[iTurbLoc].pyVel[iNode] + TurbineBasePos[iTurbLoc][1] ; - currentCoords[2] = cDriver_Input_from_FAST[iTurbLoc].pzVel[iNode] + TurbineBasePos[iTurbLoc][2] ; -} + nc_close(ncid); + -void fast::OpenFAST::getForceNodeCoordinates(double* currentCoords, int iNode, int iTurbGlob, int nSize) { - assert(nSize==3); - // Set coordinates at current node of current turbine - int iTurbLoc = get_localTurbNo(iTurbGlob); - currentCoords[0] = cDriver_Input_from_FAST[iTurbLoc].pxForce[iNode] + TurbineBasePos[iTurbLoc][0] ; - currentCoords[1] = cDriver_Input_from_FAST[iTurbLoc].pyForce[iNode] + TurbineBasePos[iTurbLoc][1] ; - currentCoords[2] = cDriver_Input_from_FAST[iTurbLoc].pzForce[iNode] + TurbineBasePos[iTurbLoc][2] ; -} -void fast::OpenFAST::getForceNodeOrientation(double* currentOrientation, int iNode, int iTurbGlob, int nSize) { - assert(nSize==9); - // Set orientation at current node of current turbine - int iTurbLoc = get_localTurbNo(iTurbGlob); - for(int j=0; j < iTurbLoc; j++) iNode = iNode - get_numForcePtsLoc(iTurbLoc); - for(int i=0;i<9;i++) { - currentOrientation[i] = cDriver_Input_from_FAST[iTurbLoc].pOrientation[iNode*9+i] ; - } } -void fast::OpenFAST::getRelativeVelForceNode(double* currentVelocity, int iNode, int iTurbGlob, int nSize) { - assert(nSize==3); - // Get relative velocity at current node of current turbine - int iTurbLoc = get_localTurbNo(iTurbGlob); - for(int j=0; j < iTurbLoc; j++) iNode = iNode - get_numForcePtsLoc(iTurbLoc); +void fast::OpenFAST::writeRestartFile(int iTurbLoc, int n_t_global) { - currentVelocity[0] = forceNodeVel[iTurbLoc][iNode][0] - cDriver_Input_from_FAST[iTurbLoc].xdotForce[iNode]; - currentVelocity[1] = forceNodeVel[iTurbLoc][iNode][1] - cDriver_Input_from_FAST[iTurbLoc].ydotForce[iNode]; - currentVelocity[2] = forceNodeVel[iTurbLoc][iNode][2] - cDriver_Input_from_FAST[iTurbLoc].zdotForce[iNode]; -} + /* // NetCDF stuff to write states to restart file or read back from it */ -void fast::OpenFAST::getForce(double* currentForce, int iNode, int iTurbGlob, int nSize) { - assert(nSize==3); - // Set forces at current node of current turbine - int iTurbLoc = get_localTurbNo(iTurbGlob); - for(int j=0; j < iTurbLoc; j++) iNode = iNode - get_numForcePtsLoc(iTurbLoc); - currentForce[0] = -cDriver_Input_from_FAST[iTurbLoc].fx[iNode] ; - currentForce[1] = -cDriver_Input_from_FAST[iTurbLoc].fy[iNode] ; - currentForce[2] = -cDriver_Input_from_FAST[iTurbLoc].fz[iNode] ; -} + int ncid; + //Find the file and open it in append mode + std::stringstream rstfile_ss; + rstfile_ss << "turb_" ; + rstfile_ss << std::setfill('0') << std::setw(2) << turbineData[iTurbLoc].TurbID; + rstfile_ss << "_rst.nc"; + std::string rst_filename = rstfile_ss.str(); + int ierr = nc_open(rst_filename.c_str(), NC_WRITE, &ncid); + check_nc_error(ierr, "nc_open"); -double fast::OpenFAST::getChord(int iNode, int iTurbGlob) { - // Return blade chord/tower diameter at current node of current turbine - int iTurbLoc = get_localTurbNo(iTurbGlob); - for(int j=0; j < iTurbLoc; j++) iNode = iNode - get_numForcePtsLoc(iTurbLoc); - return cDriver_Input_from_FAST[iTurbLoc].forceNodesChord[iNode] ; -} + size_t count1=1; + int tStepRatio = time_step_ratio(dtFAST, dtDriver); + size_t n_tsteps = n_t_global/tStepRatio/restartFreq_ - 1; + double curTime = n_t_global * dtFAST; + ierr = nc_put_vara_double(ncid, ncRstVarIDs_["time"], &n_tsteps, &count1, &curTime); -void fast::OpenFAST::setVelocity(double* currentVelocity, int iNode, int iTurbGlob, int nSize) { - assert(nSize==3); - // Set velocity at current node of current turbine - - int iTurbLoc = get_localTurbNo(iTurbGlob); - for(int j=0; j < iTurbLoc; j++) iNode = iNode - get_numVelPtsLoc(iTurbLoc); - cDriver_Output_to_FAST[iTurbLoc].u[iNode] = currentVelocity[0]; - cDriver_Output_to_FAST[iTurbLoc].v[iNode] = currentVelocity[1]; - cDriver_Output_to_FAST[iTurbLoc].w[iNode] = currentVelocity[2]; -} + if ( (turbineData[iTurbLoc].sType == EXTINFLOW) && (turbineData[iTurbLoc].inflowType == 2) ){ -void fast::OpenFAST::setVelocityForceNode(double* currentVelocity, int iNode, int iTurbGlob, int nSize) { - assert(nSize==3); - // Set velocity at current node of current turbine - - int iTurbLoc = get_localTurbNo(iTurbGlob); - for(int j=0; j < iTurbLoc; j++) iNode = iNode - get_numForcePtsLoc(iTurbLoc); + int nvelpts = get_numVelPtsLoc(iTurbLoc); + int nfpts = get_numForcePtsLoc(iTurbLoc); - for(int i=0; i velPtsDataDims{1, 1, static_cast(3*nvelpts)}; + const std::vector forcePtsDataDims{1, 1, static_cast(3*nfpts)}; + const std::vector forcePtsOrientDataDims{1, 1, static_cast(9*nfpts)}; -void fast::OpenFAST::interpolateVel_ForceToVelNodes() { + for (size_t j=0; j < 4; j++) { // Loop over states - NM2, STATE_NM1, N, NP1 - // Interpolates the velocity from the force nodes to the velocity nodes - for(int iTurb=0; iTurb < nTurbinesProc; iTurb++) { - // Hub location - cDriver_Output_to_FAST[iTurb].u[0] = forceNodeVel[iTurb][0][0]; - cDriver_Output_to_FAST[iTurb].v[0] = forceNodeVel[iTurb][0][1]; - cDriver_Output_to_FAST[iTurb].w[0] = forceNodeVel[iTurb][0][2]; + const std::vector start_dim{n_tsteps,j,0}; - if ( isDebug() ) { - std::ofstream actuatorVelFile; - actuatorVelFile.open("actuator_velocity.csv") ; - actuatorVelFile << "# x, y, z, Vx, Vy, Vz" << std::endl ; - for (int iNode=0; iNode < get_numForcePtsLoc(iTurb); iNode++) { - actuatorVelFile << cDriver_Input_from_FAST[iTurb].pxForce[iNode] << ", " << cDriver_Input_from_FAST[iTurb].pyForce[iNode] << ", " << cDriver_Input_from_FAST[iTurb].pzForce[iNode] << ", " << forceNodeVel[iTurb][iNode][0] << ", " << forceNodeVel[iTurb][iNode][1] << ", " << forceNodeVel[iTurb][iNode][2] << " " << std::endl ; - } - actuatorVelFile.close() ; + ierr = nc_put_vara_double(ncid, ncRstVarIDs_["x_vel"], start_dim.data(), velPtsDataDims.data(), velForceNodeData[iTurbLoc][j].x_vel.data()); + ierr = nc_put_vara_double(ncid, ncRstVarIDs_["vel_vel"], start_dim.data(), velPtsDataDims.data(), velForceNodeData[iTurbLoc][j].vel_vel.data()); + ierr = nc_put_vara_double(ncid, ncRstVarIDs_["x_force"], start_dim.data(), forcePtsDataDims.data(), velForceNodeData[iTurbLoc][j].x_force.data()); + ierr = nc_put_vara_double(ncid, ncRstVarIDs_["xdot_force"], start_dim.data(), forcePtsDataDims.data(), velForceNodeData[iTurbLoc][j].xdot_force.data()); + ierr = nc_put_vara_double(ncid, ncRstVarIDs_["vel_force"], start_dim.data(), forcePtsDataDims.data(), velForceNodeData[iTurbLoc][j].vel_force.data()); + ierr = nc_put_vara_double(ncid, ncRstVarIDs_["force"], start_dim.data(), forcePtsDataDims.data(), velForceNodeData[iTurbLoc][j].force.data()); + ierr = nc_put_vara_double(ncid, ncRstVarIDs_["orient_force"], start_dim.data(), forcePtsOrientDataDims.data(), velForceNodeData[iTurbLoc][j].orient_force.data()); } - // Do the blades first - int nBlades = get_numBladesLoc(iTurb); - for(int iBlade=0; iBlade < nBlades; iBlade++) { - // Create interpolating parameter - Distance from hub - int nForcePtsBlade = get_numForcePtsBladeLoc(iTurb); - std::vector rDistForce(nForcePtsBlade) ; - for(int j=0; j < nForcePtsBlade; j++) { - int iNodeForce = 1 + iBlade * nForcePtsBlade + j ; //The number of actuator force points is always the same for all blades - rDistForce[j] = std::sqrt( - (cDriver_Input_from_FAST[iTurb].pxForce[iNodeForce] - cDriver_Input_from_FAST[iTurb].pxForce[0])*(cDriver_Input_from_FAST[iTurb].pxForce[iNodeForce] - cDriver_Input_from_FAST[iTurb].pxForce[0]) - + (cDriver_Input_from_FAST[iTurb].pyForce[iNodeForce] - cDriver_Input_from_FAST[iTurb].pyForce[0])*(cDriver_Input_from_FAST[iTurb].pyForce[iNodeForce] - cDriver_Input_from_FAST[iTurb].pyForce[0]) - + (cDriver_Input_from_FAST[iTurb].pzForce[iNodeForce] - cDriver_Input_from_FAST[iTurb].pzForce[0])*(cDriver_Input_from_FAST[iTurb].pzForce[iNodeForce] - cDriver_Input_from_FAST[iTurb].pzForce[0]) - ); - } + } else if (turbineData[iTurbLoc].sType == EXTLOADS) { - // Interpolate to the velocity nodes - int nVelPtsBlade = get_numVelPtsBladeLoc(iTurb); - for(int j=0; j < nVelPtsBlade; j++) { - int iNodeVel = 1 + iBlade * nVelPtsBlade + j ; //Assumes the same number of velocity (Aerodyn) nodes for all blades - double rDistVel = std::sqrt( - (cDriver_Input_from_FAST[iTurb].pxVel[iNodeVel] - cDriver_Input_from_FAST[iTurb].pxVel[0])*(cDriver_Input_from_FAST[iTurb].pxVel[iNodeVel] - cDriver_Input_from_FAST[iTurb].pxVel[0]) - + (cDriver_Input_from_FAST[iTurb].pyVel[iNodeVel] - cDriver_Input_from_FAST[iTurb].pyVel[0])*(cDriver_Input_from_FAST[iTurb].pyVel[iNodeVel] - cDriver_Input_from_FAST[iTurb].pyVel[0]) - + (cDriver_Input_from_FAST[iTurb].pzVel[iNodeVel] - cDriver_Input_from_FAST[iTurb].pzVel[0])*(cDriver_Input_from_FAST[iTurb].pzVel[iNodeVel] - cDriver_Input_from_FAST[iTurb].pzVel[0]) - ); - //Find nearest two force nodes - int jForceLower = 0; - while ( (rDistForce[jForceLower+1] < rDistVel) && ( jForceLower < (nForcePtsBlade-2)) ) { - jForceLower = jForceLower + 1; - } - int iNodeForceLower = 1 + iBlade * nForcePtsBlade + jForceLower ; - double rInterp = (rDistVel - rDistForce[jForceLower])/(rDistForce[jForceLower+1]-rDistForce[jForceLower]); - cDriver_Output_to_FAST[iTurb].u[iNodeVel] = forceNodeVel[iTurb][iNodeForceLower][0] + rInterp * (forceNodeVel[iTurb][iNodeForceLower+1][0] - forceNodeVel[iTurb][iNodeForceLower][0] ); - cDriver_Output_to_FAST[iTurb].v[iNodeVel] = forceNodeVel[iTurb][iNodeForceLower][1] + rInterp * (forceNodeVel[iTurb][iNodeForceLower+1][1] - forceNodeVel[iTurb][iNodeForceLower][1] ); - cDriver_Output_to_FAST[iTurb].w[iNodeVel] = forceNodeVel[iTurb][iNodeForceLower][2] + rInterp * (forceNodeVel[iTurb][iNodeForceLower+1][2] - forceNodeVel[iTurb][iNodeForceLower][2] ); - } - } + int nPtsTwr = turbineData[iTurbLoc].nBRfsiPtsTwr; + int nTotBldPts = turbineData[iTurbLoc].nTotBRfsiPtsBlade; + int nBlades = turbineData[iTurbLoc].numBlades; + const std::vector twrDataDims{1, 1, static_cast(6*nPtsTwr)}; + const std::vector bldDataDims{1, 1, static_cast(6*nTotBldPts)}; + const std::vector bldRootDataDims{1, 1, static_cast(6*nBlades)}; + const std::vector bldPitchDataDims{1, 1, static_cast(nBlades)}; + const std::vector ptDataDims{1, 1, 6}; - // Now the tower if present and used - int nVelPtsTower = get_numVelPtsTwrLoc(iTurb); - if ( nVelPtsTower > 0 ) { + for (size_t j=0; j < 4; j++) { // Loop over states - STATE_NM2, STATE_NM1, STATE_N, STATE_NP1 - // Create interpolating parameter - Distance from first node from ground - int nForcePtsTower = get_numForcePtsTwrLoc(iTurb); - std::vector hDistForce(nForcePtsTower) ; - int iNodeBotTowerForce = 1 + nBlades * get_numForcePtsBladeLoc(iTurb); // The number of actuator force points is always the same for all blades - for(int j=0; j < nForcePtsTower; j++) { - int iNodeForce = iNodeBotTowerForce + j ; - hDistForce[j] = std::sqrt( - (cDriver_Input_from_FAST[iTurb].pxForce[iNodeForce] - cDriver_Input_from_FAST[iTurb].pxForce[iNodeBotTowerForce])*(cDriver_Input_from_FAST[iTurb].pxForce[iNodeForce] - cDriver_Input_from_FAST[iTurb].pxForce[iNodeBotTowerForce]) - + (cDriver_Input_from_FAST[iTurb].pyForce[iNodeForce] - cDriver_Input_from_FAST[iTurb].pyForce[iNodeBotTowerForce])*(cDriver_Input_from_FAST[iTurb].pyForce[iNodeForce] - cDriver_Input_from_FAST[iTurb].pyForce[iNodeBotTowerForce]) - + (cDriver_Input_from_FAST[iTurb].pzForce[iNodeForce] - cDriver_Input_from_FAST[iTurb].pzForce[iNodeBotTowerForce])*(cDriver_Input_from_FAST[iTurb].pzForce[iNodeForce] - cDriver_Input_from_FAST[iTurb].pzForce[iNodeBotTowerForce]) - ); - } + const std::vector start_dim{n_tsteps, j, 0}; - int iNodeBotTowerVel = 1 + nBlades * get_numVelPtsBladeLoc(iTurb); // Assumes the same number of velocity (Aerodyn) nodes for all blades - for(int j=0; j < nVelPtsTower; j++) { - int iNodeVel = iNodeBotTowerVel + j ; - double hDistVel = std::sqrt( - (cDriver_Input_from_FAST[iTurb].pxVel[iNodeVel] - cDriver_Input_from_FAST[iTurb].pxVel[iNodeBotTowerVel])*(cDriver_Input_from_FAST[iTurb].pxVel[iNodeVel] - cDriver_Input_from_FAST[iTurb].pxVel[iNodeBotTowerVel]) - + (cDriver_Input_from_FAST[iTurb].pyVel[iNodeVel] - cDriver_Input_from_FAST[iTurb].pyVel[iNodeBotTowerVel])*(cDriver_Input_from_FAST[iTurb].pyVel[iNodeVel] - cDriver_Input_from_FAST[iTurb].pyVel[iNodeBotTowerVel]) - + (cDriver_Input_from_FAST[iTurb].pzVel[iNodeVel] - cDriver_Input_from_FAST[iTurb].pzVel[iNodeBotTowerVel])*(cDriver_Input_from_FAST[iTurb].pzVel[iNodeVel] - cDriver_Input_from_FAST[iTurb].pzVel[iNodeBotTowerVel]) - ); - //Find nearest two force nodes - int jForceLower = 0; - while ( (hDistForce[jForceLower+1] < hDistVel) && ( jForceLower < (nForcePtsTower-2)) ) { - jForceLower = jForceLower + 1; - } - int iNodeForceLower = iNodeBotTowerForce + jForceLower ; - double rInterp = (hDistVel - hDistForce[jForceLower])/(hDistForce[jForceLower+1]-hDistForce[jForceLower]); - cDriver_Output_to_FAST[iTurb].u[iNodeVel] = forceNodeVel[iTurb][iNodeForceLower][0] + rInterp * (forceNodeVel[iTurb][iNodeForceLower+1][0] - forceNodeVel[iTurb][iNodeForceLower][0] ); - cDriver_Output_to_FAST[iTurb].v[iNodeVel] = forceNodeVel[iTurb][iNodeForceLower][1] + rInterp * (forceNodeVel[iTurb][iNodeForceLower+1][1] - forceNodeVel[iTurb][iNodeForceLower][1] ); - cDriver_Output_to_FAST[iTurb].w[iNodeVel] = forceNodeVel[iTurb][iNodeForceLower][2] + rInterp * (forceNodeVel[iTurb][iNodeForceLower+1][2] - forceNodeVel[iTurb][iNodeForceLower][2] ); - } + ierr = nc_put_vara_double(ncid, ncRstVarIDs_["twr_def"], start_dim.data(), twrDataDims.data(), brFSIData[iTurbLoc][j].twr_def.data()); + ierr = nc_put_vara_double(ncid, ncRstVarIDs_["twr_vel"], start_dim.data(), twrDataDims.data(), brFSIData[iTurbLoc][j].twr_vel.data()); + ierr = nc_put_vara_double(ncid, ncRstVarIDs_["twr_ld"], start_dim.data(), twrDataDims.data(), brFSIData[iTurbLoc][j].twr_ld.data()); + + ierr = nc_put_vara_double(ncid, ncRstVarIDs_["bld_def"], start_dim.data(), bldDataDims.data(), brFSIData[iTurbLoc][j].bld_def.data()); + ierr = nc_put_vara_double(ncid, ncRstVarIDs_["bld_vel"], start_dim.data(), bldDataDims.data(), brFSIData[iTurbLoc][j].bld_vel.data()); + ierr = nc_put_vara_double(ncid, ncRstVarIDs_["bld_ld"], start_dim.data(), bldDataDims.data(), brFSIData[iTurbLoc][j].bld_ld.data()); + + ierr = nc_put_vara_double(ncid, ncRstVarIDs_["hub_def"], start_dim.data(), ptDataDims.data(), brFSIData[iTurbLoc][j].hub_def.data()); + ierr = nc_put_vara_double(ncid, ncRstVarIDs_["hub_vel"], start_dim.data(), ptDataDims.data(), brFSIData[iTurbLoc][j].hub_vel.data()); + + ierr = nc_put_vara_double(ncid, ncRstVarIDs_["nac_def"], start_dim.data(), ptDataDims.data(), brFSIData[iTurbLoc][j].nac_def.data()); + ierr = nc_put_vara_double(ncid, ncRstVarIDs_["nac_vel"], start_dim.data(), ptDataDims.data(), brFSIData[iTurbLoc][j].nac_vel.data()); + + ierr = nc_put_vara_double(ncid, ncRstVarIDs_["bld_root_def"], start_dim.data(), bldRootDataDims.data(), brFSIData[iTurbLoc][j].bld_root_def.data()); + ierr = nc_put_vara_double(ncid, ncRstVarIDs_["bld_pitch"], start_dim.data(), bldPitchDataDims.data(), brFSIData[iTurbLoc][j].bld_pitch.data()); } + } + + nc_close(ncid); + + } -void fast::OpenFAST::computeTorqueThrust(int iTurbGlob, std::vector & torque, std::vector & thrust) { +// Mostly Blade-resolved stuff after this - //Compute the torque and thrust based on the forces at the actuator nodes - std::vector relLoc(3,0.0); - std::vector rPerpShft(3); - thrust[0] = 0.0; thrust[1] = 0.0; thrust[2] = 0.0; - torque[0] = 0.0; torque[1] = 0.0; torque[2] = 0.0; +void fast::OpenFAST::get_ref_positions_from_openfast(int iTurb) { - std::vector hubShftVec(3); - getHubShftDir(hubShftVec, iTurbGlob); + if(turbineData[iTurb].sType == EXTLOADS) { - int iTurbLoc = get_localTurbNo(iTurbGlob) ; - for (int k=0; k < get_numBladesLoc(iTurbLoc); k++) { - for (int j=0; j < numForcePtsBlade[iTurbLoc]; j++) { - int iNode = 1 + numForcePtsBlade[iTurbLoc]*k + j ; + for (int i=0; i < 3; i++) { + brFSIData[iTurb][fast::STATE_NP1].hub_ref_pos[i] = extld_p_f_FAST[iTurb].hubRefPos[i] + turbineData[iTurb].TurbineBasePos[i]; + brFSIData[iTurb][fast::STATE_NP1].nac_ref_pos[i] = extld_p_f_FAST[iTurb].nacRefPos[i] + turbineData[iTurb].TurbineBasePos[i]; + brFSIData[iTurb][fast::STATE_NP1].hub_ref_pos[i+3] = extld_p_f_FAST[iTurb].hubRefPos[i+3]; + brFSIData[iTurb][fast::STATE_NP1].nac_ref_pos[i+3] = extld_p_f_FAST[iTurb].nacRefPos[i+3]; + } + + int nBlades = turbineData[iTurb].numBlades; + int iRunTot = 0; + for (int i=0; i < nBlades; i++) { + int nPtsBlade = turbineData[iTurb].nBRfsiPtsBlade[i]; + for (int j=0; j < nPtsBlade; j++) { + for (int k=0; k < 3; k++) { + brFSIData[iTurb][fast::STATE_NP1].bld_ref_pos[iRunTot*6+k] = extld_p_f_FAST[iTurb].bldRefPos[iRunTot*6+k] + turbineData[iTurb].TurbineBasePos[k]; + brFSIData[iTurb][fast::STATE_NP1].bld_ref_pos[iRunTot*6+k+3] = extld_p_f_FAST[iTurb].bldRefPos[iRunTot*6+k+3]; + } + brFSIData[iTurb][fast::STATE_NP1].bld_chord[iRunTot] = extld_p_f_FAST[iTurb].bldChord[iRunTot]; + brFSIData[iTurb][fast::STATE_NP1].bld_rloc[iRunTot] = extld_p_f_FAST[iTurb].bldRloc[iRunTot]; + iRunTot++; + } - thrust[0] = thrust[0] + cDriver_Input_from_FAST[iTurbLoc].fx[iNode] ; - thrust[1] = thrust[1] + cDriver_Input_from_FAST[iTurbLoc].fy[iNode] ; - thrust[2] = thrust[2] + cDriver_Input_from_FAST[iTurbLoc].fz[iNode] ; + for (int k=0; k < 3; k++) { + brFSIData[iTurb][fast::STATE_NP1].bld_root_ref_pos[i*6+k] = extld_p_f_FAST[iTurb].bldRootRefPos[i*6+k] + turbineData[iTurb].TurbineBasePos[k]; + brFSIData[iTurb][fast::STATE_NP1].bld_root_ref_pos[i*6+k+3] = extld_p_f_FAST[iTurb].bldRootRefPos[i*6+k+3]; + } - relLoc[0] = cDriver_Input_from_FAST[iTurbLoc].pxForce[iNode] - cDriver_Input_from_FAST[iTurbLoc].pxForce[0]; - relLoc[1] = cDriver_Input_from_FAST[iTurbLoc].pyForce[iNode] - cDriver_Input_from_FAST[iTurbLoc].pyForce[0]; - relLoc[2] = cDriver_Input_from_FAST[iTurbLoc].pzForce[iNode] - cDriver_Input_from_FAST[iTurbLoc].pzForce[0]; + } - double rDotHubShftVec = relLoc[0]*hubShftVec[0] + relLoc[1]*hubShftVec[1] + relLoc[2]*hubShftVec[2]; - for (int j=0; j < 3; j++) rPerpShft[j] = relLoc[j] - rDotHubShftVec * hubShftVec[j]; + int nPtsTwr = turbineData[iTurb].nBRfsiPtsTwr; + for (int i=0; i < nPtsTwr; i++) { + for (int j = 0; j < 3; j++) { + brFSIData[iTurb][fast::STATE_NP1].twr_ref_pos[i*6+j] = extld_p_f_FAST[iTurb].twrRefPos[i*6+j] + turbineData[iTurb].TurbineBasePos[j]; + brFSIData[iTurb][fast::STATE_NP1].twr_ref_pos[i*6+j+3] = extld_p_f_FAST[iTurb].twrRefPos[i*6+j+3]; + } + } - torque[0] = torque[0] + rPerpShft[1] * cDriver_Input_from_FAST[iTurbLoc].fz[iNode] - rPerpShft[2] * cDriver_Input_from_FAST[iTurbLoc].fy[iNode] + cDriver_Input_from_FAST[iTurbLoc].momentx[iNode] ; - torque[1] = torque[1] + rPerpShft[2] * cDriver_Input_from_FAST[iTurbLoc].fx[iNode] - rPerpShft[0] * cDriver_Input_from_FAST[iTurbLoc].fz[iNode] + cDriver_Input_from_FAST[iTurbLoc].momenty[iNode] ; - torque[2] = torque[2] + rPerpShft[0] * cDriver_Input_from_FAST[iTurbLoc].fy[iNode] - rPerpShft[1] * cDriver_Input_from_FAST[iTurbLoc].fx[iNode] + cDriver_Input_from_FAST[iTurbLoc].momentz[iNode] ; + } else if(turbineData[iTurb].sType == EXTINFLOW) { + + if (turbineData[iTurb].inflowType == 2) { + int nfpts = get_numForcePtsLoc(iTurb); + for (auto i=0; i 0 ) { - return TOWER; - } else { - return BLADE; + int nBlades = get_numBladesLoc(iTurbLoc); + int iRunTot = 0; + for (int i=0; i < nBlades; i++) { + int nPtsBlade = turbineData[iTurbLoc].nBRfsiPtsBlade[i]; + for(int j=0; j 0 ) { - return TOWER; - } else { - return BLADE; + int nBlades = get_numBladesLoc(iTurbLoc); + int iRunTot = 0; + for (int i=0; i < nBlades; i++) { + int nPtsBlade = turbineData[iTurbLoc].nBRfsiPtsBlade[i]; + for(int j=0; j 0) closeVelocityDataFile(nt_global, velNodeDataFile); +} - if ( !dryRun) { - bool stopTheProgram = false; - for (int iTurb=0; iTurb < nTurbinesProc; iTurb++) { - FAST_End(&iTurb, &stopTheProgram); - } - FAST_DeallocateTurbines(&ErrStat, ErrMsg); - } +void fast::OpenFAST::getTowerRefPositions(double* twrRefPos, int iTurbGlob, int nSize) { - MPI_Group_free(&fastMPIGroup); - if (MPI_COMM_NULL != fastMPIComm) { - MPI_Comm_free(&fastMPIComm); + int iTurbLoc = get_localTurbNo(iTurbGlob); + int nPtsTwr = turbineData[iTurbLoc].nBRfsiPtsTwr; + for (int i=0; i < nPtsTwr; i++) { + for (int j=0; j < nSize; j++) { + twrRefPos[i*6+j] = brFSIData[iTurbLoc][fast::STATE_NP1].twr_ref_pos[i*6+j]; + } } - MPI_Group_free(&worldMPIGroup); - if(scStatus) { - std::cout << "Use of Supercontroller is not supported through the C++ API right now" << std::endl; - // sc.end(); - } } -void fast::OpenFAST::readVelocityData(int nTimesteps) { - - int nTurbines; +void fast::OpenFAST::getTowerDisplacements(double* twrDefl, double* twrVel, int iTurbGlob, fast::timeStep t, int nSize) { - hid_t velDataFile = H5Fopen(("velDatafile." + std::to_string(worldMPIRank) + ".h5").c_str(), H5F_ACC_RDWR, H5P_DEFAULT); - - { - hid_t attr = H5Aopen(velDataFile, "nTurbines", H5P_DEFAULT); - herr_t ret = H5Aread(attr, H5T_NATIVE_INT, &nTurbines) ; - H5Aclose(attr); + int iTurbLoc = get_localTurbNo(iTurbGlob); + int nPtsTwr = turbineData[iTurbLoc].nBRfsiPtsTwr; + for (int i=0; i < nPtsTwr; i++) { + for (int j=0; j < nSize; j++) { + twrDefl[i*6+j] = brFSIData[iTurbLoc][t].twr_def[i*6+j]; + twrVel[i*6+j] = brFSIData[iTurbLoc][t].twr_vel[i*6+j]; + } } - // Allocate memory and read the velocity data. - velNodeData.resize(nTurbines); - for (int iTurb=0; iTurb < nTurbines; iTurb++) { - int nVelPts = get_numVelPtsLoc(iTurb) ; - velNodeData[iTurb].resize(nTimesteps*nVelPts*6) ; - hid_t dset_id = H5Dopen2(velDataFile, ("/turbine" + std::to_string(iTurb)).c_str(), H5P_DEFAULT); - hid_t dspace_id = H5Dget_space(dset_id); +} - hsize_t start[3]; start[1] = 0; start[2] = 0; - hsize_t count[3]; count[0] = 1; count[1] = nVelPts; count[2] = 6; - hid_t mspace_id = H5Screate_simple(3, count, NULL); +void fast::OpenFAST::getHubRefPosition(double* hubRefPos, int iTurbGlob, int nSize) { - for (int iStep=0; iStep < nTimesteps; iStep++) { - start[0] = iStep; - H5Sselect_hyperslab(dspace_id, H5S_SELECT_SET, start, NULL, count, NULL); - herr_t status = H5Dread(dset_id, H5T_NATIVE_DOUBLE, mspace_id, dspace_id, H5P_DEFAULT, &velNodeData[iTurb][iStep*nVelPts*6] ); - } + int iTurbLoc = get_localTurbNo(iTurbGlob); + for (int j=0; j < nSize; j++) + hubRefPos[j] = brFSIData[iTurbLoc][fast::STATE_NP1].hub_ref_pos[j]; - herr_t status = H5Dclose(dset_id); - } } -hid_t fast::OpenFAST::openVelocityDataFile(bool createFile) { +void fast::OpenFAST::getHubDisplacement(double* hubDefl, double* hubVel, int iTurbGlob, fast::timeStep t, int nSize) { - hid_t velDataFile; - if (createFile) { - // Open the file in create mode - velDataFile = H5Fcreate(("velDatafile." + std::to_string(worldMPIRank) + ".h5").c_str(), H5F_ACC_TRUNC, H5P_DEFAULT, H5P_DEFAULT); + int iTurbLoc = get_localTurbNo(iTurbGlob); + for (int j=0; j < nSize; j++) { + hubDefl[j] = brFSIData[iTurbLoc][t].hub_def[j]; + hubVel[j] = brFSIData[iTurbLoc][t].hub_vel[j]; + } - { - hsize_t dims[1]; - dims[0] = 1; - hid_t dataSpace = H5Screate_simple(1, dims, NULL); - hid_t attr = H5Acreate2(velDataFile, "nTurbines", H5T_NATIVE_INT, dataSpace, H5P_DEFAULT, H5P_DEFAULT) ; - herr_t status = H5Awrite(attr, H5T_NATIVE_INT, &nTurbinesProc); - status = H5Aclose(attr); - status = H5Sclose(dataSpace); - - dataSpace = H5Screate_simple(1, dims, NULL); - attr = H5Acreate2(velDataFile, "nTimesteps", H5T_NATIVE_INT, dataSpace, H5P_DEFAULT, H5P_DEFAULT) ; - status = H5Aclose(attr); - status = H5Sclose(dataSpace); - } +} - int ntMax = tMax/dtFAST ; +void fast::OpenFAST::getNacelleRefPosition(double* nacRefPos, int iTurbGlob, int nSize) { - for (int iTurb = 0; iTurb < nTurbinesProc; iTurb++) { - int nVelPts = get_numVelPtsLoc(iTurb); - hsize_t dims[3]; - dims[0] = ntMax; dims[1] = nVelPts; dims[2] = 6 ; + int iTurbLoc = get_localTurbNo(iTurbGlob); + for (int j=0; j < nSize; j++) + nacRefPos[j] = brFSIData[iTurbLoc][fast::STATE_NP1].nac_ref_pos[j]; - hsize_t chunk_dims[3]; - chunk_dims[0] = 1; chunk_dims[1] = nVelPts; chunk_dims[2] = 6; - hid_t dcpl_id = H5Pcreate(H5P_DATASET_CREATE); - H5Pset_chunk(dcpl_id, 3, chunk_dims); +} - hid_t dataSpace = H5Screate_simple(3, dims, NULL); - hid_t dataSet = H5Dcreate(velDataFile, ("/turbine" + std::to_string(iTurb)).c_str(), H5T_NATIVE_DOUBLE, dataSpace, H5P_DEFAULT, dcpl_id, H5P_DEFAULT); - herr_t status = H5Pclose(dcpl_id); - status = H5Dclose(dataSet); - status = H5Sclose(dataSpace); - } +void fast::OpenFAST::getNacelleDisplacement(double* nacDefl, double* nacVel, int iTurbGlob, fast::timeStep t, int nSize) { - } else { - // Open the file in append mode - velDataFile = H5Fopen(("velDatafile." + std::to_string(worldMPIRank) + ".h5").c_str(), H5F_ACC_RDWR, H5P_DEFAULT); + int iTurbLoc = get_localTurbNo(iTurbGlob); + for (int j=0; j < nSize; j++) { + nacDefl[j] = brFSIData[iTurbLoc][t].nac_def[j]; + nacVel[j] = brFSIData[iTurbLoc][t].nac_vel[j]; } - return velDataFile; - } -herr_t fast::OpenFAST::closeVelocityDataFile(int nt_global, hid_t velDataFile) { - herr_t status = H5Fclose(velDataFile) ; - return status; -} +void fast::OpenFAST::setBladeForces(double* bldForces, int iTurbGlob, fast::timeStep t, int nSize) { -void fast::OpenFAST::backupVelocityDataFile(int curTimeStep, hid_t & velDataFile) { + int iTurbLoc = get_localTurbNo(iTurbGlob); + int nBlades = get_numBladesLoc(iTurbLoc); + int iRunTot = 0; + for (int i=0; i < nBlades; i++) { + int nPtsBlade = turbineData[iTurbLoc].nBRfsiPtsBlade[i]; + for(int j=0; j < nPtsBlade; j++) { + for(int k=0; k < nSize; k++) { + brFSIData[iTurbLoc][t].bld_ld[6*iRunTot+k] = bldForces[6*iRunTot+k]; + } + iRunTot++; + } + } - closeVelocityDataFile(curTimeStep, velDataFile); + //TODO: May be calculate the residual as well. +} - std::ifstream source("velDatafile." + std::to_string(worldMPIRank) + ".h5", std::ios::binary); - std::ofstream dest("velDatafile." + std::to_string(worldMPIRank) + ".h5." + std::to_string(curTimeStep) + ".bak", std::ios::binary); +void fast::OpenFAST::setTowerForces(double* twrForces, int iTurbGlob, fast::timeStep t, int nSize) { - dest << source.rdbuf(); - source.close(); - dest.close(); + int iTurbLoc = get_localTurbNo(iTurbGlob); + int nPtsTwr = turbineData[iTurbLoc].nBRfsiPtsTwr; + for (int i=0; i < nPtsTwr; i++) + for (int j=0; j < nSize; j++) + brFSIData[iTurbLoc][t].twr_ld[i*6+j] = twrForces[i*6+j]; + //TODO: May be calculate the residual as well. - velDataFile = openVelocityDataFile(false); } -void fast::OpenFAST::writeVelocityData(hid_t h5File, int iTurb, int iTimestep, OpFM_InputType_t iData, OpFM_OutputType_t oData) { +//! Sets a uniform X force at all blade nodes +void fast::OpenFAST::setUniformXBladeForces(double loadX) { - hsize_t start[3]; start[0] = iTimestep; start[1] = 0; start[2] = 0; - int nVelPts = get_numVelPtsLoc(iTurb) ; - hsize_t count[3]; count[0] = 1; count[1] = nVelPts; count[2] = 6; + for (int iTurb=0; iTurb < nTurbinesProc; iTurb++) { + int iTurbGlob = turbineMapProcToGlob[iTurb]; + int nPtsTwr = turbineData[iTurb].nBRfsiPtsTwr; + std::vector fsiForceTower(6*nPtsTwr,0.0); + setTowerForces(fsiForceTower, iTurbGlob, fast::STATE_NP1); - std::vector tmpVelData; - tmpVelData.resize(nVelPts * 6); + size_t nBlades = get_numBladesLoc(iTurb); + size_t nTotPtsBlade = 0; + for(int iBlade=0; iBlade < nBlades; iBlade++) + nTotPtsBlade += turbineData[iTurb].nBRfsiPtsBlade[iBlade]; - for (int iNode=0 ; iNode < nVelPts; iNode++) { - tmpVelData[iNode*6 + 0] = iData.pxVel[iNode]; - tmpVelData[iNode*6 + 1] = iData.pyVel[iNode]; - tmpVelData[iNode*6 + 2] = iData.pzVel[iNode]; - tmpVelData[iNode*6 + 3] = oData.u[iNode]; - tmpVelData[iNode*6 + 4] = oData.v[iNode]; - tmpVelData[iNode*6 + 5] = oData.w[iNode]; - } + std::vector fsiForceBlade(6*nTotPtsBlade, 0.0); + std::vector dr(nTotPtsBlade, 0.0); - hid_t dset_id = H5Dopen2(h5File, ("/turbine" + std::to_string(iTurb)).c_str(), H5P_DEFAULT); - hid_t dspace_id = H5Dget_space(dset_id); - H5Sselect_hyperslab(dspace_id, H5S_SELECT_SET, start, NULL, count, NULL); - hid_t mspace_id = H5Screate_simple(3, count, NULL); - H5Dwrite(dset_id, H5T_NATIVE_DOUBLE, mspace_id, dspace_id, H5P_DEFAULT, tmpVelData.data()); + size_t iNode=0; + for(int iBlade=0; iBlade < nBlades; iBlade++) { + int nBldPts = turbineData[iTurb].nBRfsiPtsBlade[iBlade]; + dr[iNode] = 0.5*(brFSIData[iTurb][3].bld_rloc[iNode+1] - brFSIData[iTurb][3].bld_rloc[iNode]); + iNode++; - H5Dclose(dset_id); - H5Sclose(dspace_id); - H5Sclose(mspace_id); + for(int i=1; i < nBldPts-1; i++) { + dr[iNode] = 0.5*(brFSIData[iTurb][3].bld_rloc[iNode+1] - brFSIData[iTurb][3].bld_rloc[iNode-1]); + iNode++; + } + dr[iNode] = 0.5*(brFSIData[iTurb][3].bld_rloc[iNode] - brFSIData[iTurb][3].bld_rloc[iNode-1]); + iNode++; + } - hid_t attr_id = H5Aopen_by_name(h5File, ".", "nTimesteps", H5P_DEFAULT, H5P_DEFAULT); - herr_t status = H5Awrite(attr_id, H5T_NATIVE_INT, &iTimestep); - status = H5Aclose(attr_id); + for(int i=0; i < nTotPtsBlade; i++) + fsiForceBlade[i*6] = loadX * dr[i]; // X component of force -} + setBladeForces(fsiForceBlade, iTurbGlob, fast::STATE_NP1); -void fast::OpenFAST::applyVelocityData(int iPrestart, int iTurb, OpFM_OutputType_t cDriver_Output_to_FAST, std::vector & velData) { - int nVelPts = get_numVelPtsLoc(iTurb); - for (int j = 0; j < nVelPts; j++){ - cDriver_Output_to_FAST.u[j] = velData[(iPrestart*nVelPts+j)*6 + 3]; - cDriver_Output_to_FAST.v[j] = velData[(iPrestart*nVelPts+j)*6 + 4]; - cDriver_Output_to_FAST.w[j] = velData[(iPrestart*nVelPts+j)*6 + 5]; } } @@ -1045,6 +3263,8 @@ void fast::OpenFAST::loadSuperController(const fast::fastInputs & fi) { // sc.load(fi.nTurbinesGlob, fi.scLibFile, scio); } else { + scStatus = false; } + } diff --git a/glue-codes/openfast/src/FAST_Prog.f90 b/glue-codes/openfast/src/FAST_Prog.f90 index fb08b019cd..f4e9b2bfe2 100644 --- a/glue-codes/openfast/src/FAST_Prog.f90 +++ b/glue-codes/openfast/src/FAST_Prog.f90 @@ -32,7 +32,8 @@ PROGRAM FAST USE FAST_Subs ! all of the ModuleName and ModuleName_types modules are inherited from FAST_Subs - +USE FAST_SS_Subs, ONLY : FAST_RunSteadyStateDriver + IMPLICIT NONE ! Local parameters: @@ -58,7 +59,7 @@ PROGRAM FAST ! determine if this is a restart from checkpoint !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ CALL NWTC_Init() ! initialize NWTC library (set some global constants and if necessary, open console for writing) - ProgName = 'OpenFAST' + ProgName = FAST_Ver%Name InputFile = "" CheckpointRoot = "" @@ -76,6 +77,11 @@ PROGRAM FAST Restart_step = Turbine(1)%p_FAST%n_TMax_m1 + 1 CALL ExitThisProgram_T( Turbine(1), ErrID_None, .true., SkipRunTimeMsg = .TRUE. ) + ELSE IF ( TRIM(FlagArg) == 'STEADYSTATE' ) THEN ! Do steady-state analysis, not time-marching -- this works for only 1 turbine (i.e., NumTurbines==1)! + + ! this runs the steady-state solver driver and ENDS the program: + CALL FAST_RunSteadyStateDriver( Turbine(1) ) + ELSEIF ( LEN( TRIM(FlagArg) ) > 0 ) THEN ! Any other flag, end normally CALL NormStop() diff --git a/glue-codes/openfast/src/FastLibAPI.cpp b/glue-codes/openfast/src/FastLibAPI.cpp index 12f58a7c7f..ffed53e099 100644 --- a/glue-codes/openfast/src/FastLibAPI.cpp +++ b/glue-codes/openfast/src/FastLibAPI.cpp @@ -8,7 +8,6 @@ #include #include - FastLibAPI::FastLibAPI(std::string input_file): n_turbines(1), i_turb(0), diff --git a/glue-codes/simulink/CMakeLists.txt b/glue-codes/simulink/CMakeLists.txt index 1da4052938..c927e8c0e2 100644 --- a/glue-codes/simulink/CMakeLists.txt +++ b/glue-codes/simulink/CMakeLists.txt @@ -18,7 +18,7 @@ # This list will be linked twice to resolve undefined symbols due to linking order. set(MEX_LIBS $ - $ + $ $ $ $ @@ -27,18 +27,22 @@ set(MEX_LIBS $ $ $ - $ + $ $ $ $ $ # MATLAB Specific $ - $ + $ + $ $ $ - $ + $ $ $ # MATLAB Specific + $ + $ + $ ) # Build the matlab shared library (mex) using the current toolchain. @@ -69,8 +73,9 @@ set_target_properties(FAST_SFunc PROPERTIES Fortran_MODULE_DIRECTORY ${CMAKE_Fortran_MODULE_DIRECTORY}/matlab) target_include_directories(FAST_SFunc PUBLIC $ - $ + $ $ + $ ) if(APPLE OR UNIX) target_compile_definitions(FAST_SFunc PRIVATE IMPLICIT_DLLEXPORT) diff --git a/glue-codes/simulink/examples/Run_Test01_SIG.m b/glue-codes/simulink/examples/Run_Test01_SIG.m index 77b9062c42..992ac4ccc1 100644 --- a/glue-codes/simulink/examples/Run_Test01_SIG.m +++ b/glue-codes/simulink/examples/Run_Test01_SIG.m @@ -32,6 +32,11 @@ FAST_InputFileName = [ OpenFASTRoot 'AWT_YFix_WSt.fst' ]; TMax = 20; +OutList = {'Time','Wind1VelX','Wind1VelY','Wind1VelZ','LSSGagVxa','LSSGagPxa','TeetDefl',... + 'TipDxb2','TipDyb2','TipALxb2','TipALyb2','Spn2ALxb1','Spn2ALyb1','YawBrRDxt',... + 'YawBrRDyt','YawBrRVxp','YawBrRVyp','YawBrRAxp','YawBrRAyp','RootMyc1','RootMxc1',... + 'RootFxc2','RootFyc2','Spn3MLxb1','Spn3MLyb1','RotTorq','YawBrMzn','TwrBsMzt'}; + % run the model sim('Test01_SIG.mdl',[0,TMax]); diff --git a/glue-codes/simulink/examples/Test01_SIG.mdl b/glue-codes/simulink/examples/Test01_SIG.mdl index 4747c02197..1aa20e7edf 100644 --- a/glue-codes/simulink/examples/Test01_SIG.mdl +++ b/glue-codes/simulink/examples/Test01_SIG.mdl @@ -1828,7 +1828,7 @@ Model { ZOrder -3 BlockMirror on NameLocation "top" - Expr "u(strmatch('LSSGagVxa',OutList))" + Expr "u(strcmpi('LSSGagVxa',OutList))" } Block { BlockType SubSystem diff --git a/glue-codes/simulink/examples/test_openfast_simulink.m b/glue-codes/simulink/examples/test_openfast_simulink.m new file mode 100644 index 0000000000..0686b125bd --- /dev/null +++ b/glue-codes/simulink/examples/test_openfast_simulink.m @@ -0,0 +1,31 @@ +%% Test OpenFAST Simulink Interface +classdef test_openfast_simulink < matlab.unittest.TestCase + + %% Test Method Block + methods (Test) + + function testOpenLoopRuns(testCase) + + workspace_root = getenv("GITHUB_WORKSPACE"); + + this_file_path = fileparts(which(mfilename())); + + cd(this_file_path); + + % these variables are defined in the OpenLoop model's FAST_SFunc block: + FAST_InputFileName = fullfile(workspace_root, 'reg_tests', 'r-test', 'glue-codes', 'openfast', 'AOC_WSt', 'AOC_WSt.fst'); + TMax = 5; % seconds + + mdl = "OpenLoop"; + + %simIn = Simulink.SimulationInput(mdl); + %simIn = setBlockParameter(simIn, "sldemo_househeat/Set Point", "Value", FAST_InputFileName); + + assignin("base", "FAST_InputFileName", FAST_InputFileName); + assignin("base", "TMax", TMax); + + sim(mdl, [0,TMax]); + + end + end +end diff --git a/glue-codes/simulink/src/FAST_SFunc.c b/glue-codes/simulink/src/FAST_SFunc.c index d18665a535..f9b072330d 100644 --- a/glue-codes/simulink/src/FAST_SFunc.c +++ b/glue-codes/simulink/src/FAST_SFunc.c @@ -189,9 +189,6 @@ static void mdlInitializeSizes(SimStruct *S) InitInputAry[i] = AdditionalInitInputs[i + 1]; } } - else{ - InitInputAry[0] = SensorType_None; // tell it not to use lidar (shouldn't be necessary, but we'll cover our bases) - } // set this before possibility of error in Fortran library: diff --git a/glue-codes/simulink/src/create_FAST_SFunc.m b/glue-codes/simulink/src/create_FAST_SFunc.m index 4a7c6fdf54..207128b1ed 100644 --- a/glue-codes/simulink/src/create_FAST_SFunc.m +++ b/glue-codes/simulink/src/create_FAST_SFunc.m @@ -71,7 +71,7 @@ ['-l' libName], ... ['-I' includeDir], ... '-I../../../modules/supercontroller/src', ... % needed for visual studio builds to find "SuperController_Types.h" - '-I../../../modules/openfoam/src', ... % needed for visual studio builds to find "OpenFOAM_Types.h" + '-I../../../modules/externalinflow/src', ... % needed for visual studio builds to find "ExternalInflow_Types.h" '-outdir', outDir, ... ['COMPFLAGS=$COMPFLAGS -MT -DS_FUNCTION_NAME=' mexname], ... '-output', mexname, ... diff --git a/modules/aerodisk/CMakeLists.txt b/modules/aerodisk/CMakeLists.txt new file mode 100644 index 0000000000..fa7ee11fba --- /dev/null +++ b/modules/aerodisk/CMakeLists.txt @@ -0,0 +1,41 @@ +# +# Copyright 2024 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/AeroDisk_Registry.txt ${CMAKE_CURRENT_LIST_DIR}/src/AeroDisk_Types.f90) +endif() + +add_library(aerodisklib + src/AeroDisk_Types.f90 + src/AeroDisk_Output_Params.f90 + src/AeroDisk_IO.f90 + src/AeroDisk.f90 +) +target_link_libraries(aerodisklib ifwlib nwtclibs) + +add_executable(aerodisk_driver + src/driver/AeroDisk_Driver_Types.f90 + src/driver/AeroDisk_Driver_Subs.f90 + src/driver/AeroDisk_Driver.f90 +) +target_link_libraries(aerodisk_driver aerodisklib versioninfolib ${CMAKE_DL_LIBS}) + +install(TARGETS aerodisklib aerodisk_driver + EXPORT "${CMAKE_PROJECT_NAME}Libraries" + RUNTIME DESTINATION bin + LIBRARY DESTINATION lib + ARCHIVE DESTINATION lib +) diff --git a/modules/aerodisk/src/AeroDisk.f90 b/modules/aerodisk/src/AeroDisk.f90 new file mode 100644 index 0000000000..e6257ac2d7 --- /dev/null +++ b/modules/aerodisk/src/AeroDisk.f90 @@ -0,0 +1,877 @@ +!********************************************************************************************************************************** +!> ## AeroDisk +!! The AeroDisk module solves a quasi-steady actuator disk representation of the rotor to calculate the 3 forces and 3 moments of +!! the rotor dependent on the tip-speed ratio (TSR), rotor speed (RotSpeed), relative wind velocity vector (VRel), and the rotor- +!! collective blade-pitch (BlPitch). +!! +! .................................................................................................................................. +!! ## LICENSING +!! Copyright (C) 2024 National Renewable Energy Laboratory +!! +!! This file is part of AeroDisk. +!! +!! 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 AeroDisk + + USE AeroDisk_Types + USE AeroDisk_IO + USE NWTC_Library + use IfW_FlowField, only: IfW_FlowField_GetVelAcc + + + implicit none + private + type(ProgDesc), parameter :: ADsk_Ver = ProgDesc( 'AeroDisk', '', '' ) + + public :: ADsk_Init + public :: ADsk_End + public :: ADsk_UpdateStates + public :: ADsk_CalcOutput + public :: ADsk_CalcContStateDeriv + + ! Linearization is not supported by this module, so the following routines are omitted + !public :: ADsk_CalcConstrStateResidual + !public :: ADsk_UpdateDiscState + !public :: ADsk_JacobianPInput + !public :: ADsk_JacobianPContState + !public :: ADsk_JacobianPDiscState + !public :: ADsk_JacobianPConstrState + !public :: ADsk_GetOP + +CONTAINS + + +!---------------------------------------------------------------------------------------------------------------------------------- +!> Initialize the AeroDisk module: +!! - load settings (passed or from file) +!! - setup meshes +!! - initialize outputs and other data storage +SUBROUTINE ADsk_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut, ErrStat, ErrMsg ) + type(ADsk_InitInputType), intent(in ) :: InitInp !< Input data for initialization routine + type(ADsk_InputType), intent( out) :: u !< An initial guess for the input; input mesh must be defined + type(ADsk_ParameterType), intent( out) :: p !< Parameters + type(ADsk_ContinuousStateType), intent( out) :: x !< Initial continuous states + type(ADsk_DiscreteStateType), intent( out) :: xd !< Initial discrete states + type(ADsk_ConstraintStateType), intent( out) :: z !< Initial guess of the constraint states + type(ADsk_OtherStateType), intent( out) :: OtherState !< Initial other states (logical, etc) + type(ADsk_OutputType), intent( out) :: y !< Initial system outputs (outputs are not calculated) + type(ADsk_MiscVarType), intent( out) :: m !< Misc variables for optimization (not copied in glue code) + real(DbKi), intent(inout) :: Interval !< Coupling interval in seconds + type(ADsk_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(ADsk_InputFile) :: InputFileData !< Data from input file as a string array + type(FileInfoType) :: FileInfo_In !< The derived type for holding the full input file for parsing -- we may pass this in the future + integer(IntKi) :: UnEc ! unit number for the echo file (-1 for not in use) + integer(IntKi) :: ErrStat2 ! local error status + character(ErrMsgLen) :: ErrMsg2 ! local error message + character(*), parameter :: RoutineName = 'ADsk_Init' + + ! Initialize variables + ErrStat = ErrID_None + ErrMsg = "" + + ! Initialize the NWTC Subroutine Library + call NWTC_Init( ) + + ! Display the module information + call DispNVD( ADsk_Ver ) + + ! set rootname + p%RootName = trim(InitInp%RootName)//".ADsk" + + ! Get primary input file + if ( InitInp%UseInputFile ) then + CALL ProcessComFile( InitInp%InputFile, FileInfo_In, ErrStat2, ErrMsg2 ) + else + CALL NWTC_Library_CopyFileInfoType( InitInp%PassedFileData, 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 all ADsk-related input and populate the InputFileData structure + call ADsk_ParsePrimaryFileData( InitInp, p%RootName, Interval, FileInfo_In, InputFileData, UnEc, ErrStat2, ErrMsg2 ) + if (Failed()) return; + + ! Verify all the necessary initialization and input file data + CALL ADskInput_ValidateInput( InitInp, InputFileData, ErrStat2, ErrMsg2 ) + if (Failed()) return; + + ! Set parameters + CALL ADskInput_SetParameters( InitInp, Interval, InputFileData, p, ErrStat2, ErrMsg2 ) + if (Failed()) return; + + ! For diagnostic purposes. If we add a summary file, use this to write table + !call WriteAeroTab(p%AeroTable,Cu) + + + ! Set pointer to FlowField data + if (associated(InitInp%FlowField)) then + p%FlowField => InitInp%FlowField + call SetDiskAvgPoints(ErrStat2,ErrMsg2); if (Failed()) return + else + ErrStat2 = ErrID_Fatal + ErrMsg2 = "No flow field data available. AeroDisk cannot continue." + if (Failed()) return + endif + + + ! Set inputs + call Init_U(ErrStat2,ErrMsg2); if (Failed()) return + + ! Set outputs + call Init_Y(ErrStat2,ErrMsg2); if (Failed()) return + + ! Set InitOutputs + call Init_InitY(ErrStat2,ErrMsg2); if (Failed()) return + + ! Set some other stuff that the framework requires + call Init_OtherStuff(ErrStat2,ErrMsg2); if (Failed()) 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 (UnEc > 0_IntKi) close (UnEc) + end subroutine Cleanup + + !> Setup points for disk average velocity calculations + subroutine SetDiskAvgPoints(ErrStat3,ErrMsg3) + integer(IntKi), intent( out) :: ErrStat3 + character(*), intent( out) :: ErrMsg3 + integer(IntKi) :: i + real(ReKi) :: R,theta + ! positions relative to hub + call AllocAry(p%DiskWindPosRel,3,ADsk_NumPtsDiskAvg,'ADsk_NumPtsDiskAvg',ErrStat3,ErrMsg3); if (errStat3 >= AbortErrLev) return + ! absolute point positions for call to GetWindVelAcc + call AllocAry(m%DiskWindPosAbs,3,ADsk_NumPtsDiskAvg,'ADsk_NumPtsDiskAvg',ErrStat3,ErrMsg3); if (errStat3 >= AbortErrLev) return + ! wind velocity at all requested points + call AllocAry(m%DiskWindVel ,3,ADsk_NumPtsDiskAvg,'DiskWindVel' ,ErrStat3,ErrMsg3); if (errStat3 >= AbortErrLev) return + ! Calculate relative points on disk (do this once up front to save computational time). + ! NOTE: this is in the XY plane, and will be multiplied by the hub orientation vector + R = real(p%RotorRad,ReKi) * 0.7_reKi !70% radius + do i=1,ADsk_NumPtsDiskAvg + theta = pi +(i-1)*TwoPi/ADsk_NumPtsDiskAvg + p%DiskWindPosRel(1,i) = 0.0_ReKi ! Hub X (perpindicular to rotor plane) + p%DiskWindPosRel(2,i) = R*cos(theta) ! Hub Y + p%DiskWindPosRel(3,i) = R*sin(theta) ! Hub Z (in vertical plane when azimuth=0) + end do + end subroutine SetDiskAvgPoints + + !> Initialize the inputs in u + subroutine Init_U(ErrStat3,ErrMsg3) + integer(IntKi), intent( out) :: ErrStat3 + character(*), intent( out) :: ErrMsg3 + ! HubMotion mesh + call MeshCreate ( BlankMesh = u%HubMotion & + ,IOS = COMPONENT_INPUT & + ,Nnodes = 1 & + ,ErrStat = ErrStat3 & + ,ErrMess = ErrMsg3 & + ,Orientation = .true. & + ,TranslationDisp = .true. & + ,RotationVel = .true. & + ) + if (errStat3 >= AbortErrLev) return + call MeshPositionNode(u%HubMotion, 1, InitInp%HubPosition, errStat3, errMsg3, InitInp%HubOrientation); if (errStat3 >= AbortErrLev) return + call MeshConstructElement( u%HubMotion, ELEMENT_POINT, errStat3, errMsg3, p1=1 ); if (errStat3 >= AbortErrLev) return + call MeshCommit(u%HubMotion, errStat3, errMsg3 ); if (errStat3 >= AbortErrLev) return + u%HubMotion%Orientation = u%HubMotion%RefOrientation + u%HubMotion%TranslationDisp = 0.0_R8Ki + u%HubMotion%RotationVel = 0.0_ReKi + return + end subroutine Init_U + + !> Initialize the outputs in Y + subroutine Init_Y(ErrStat3,ErrMSg3) + integer(IntKi), intent( out) :: ErrStat3 + character(*), intent( out) :: ErrMsg3 + ! Set output loads mesh + call MeshCopy ( SrcMesh = u%HubMotion & + , DestMesh = y%AeroLoads & + , CtrlCode = MESH_SIBLING & + , IOS = COMPONENT_OUTPUT & + , force = .TRUE. & + , moment = .TRUE. & + , ErrStat = ErrStat3 & + , ErrMess = ErrMsg3 ) + if (ErrStat3 >= AbortErrLev) return + + ! Initialize all outputs to zero (will be set by CalcOutput) + y%YawErr = 0.0_ReKi + y%PsiSkew = 0.0_ReKi + y%ChiSkew = 0.0_ReKi + y%VRel = 0.0_ReKi + y%Ct = 0.0_ReKi + y%Cq = 0.0_ReKi + call AllocAry(y%WriteOutput,p%NumOuts,'WriteOutput',Errstat3,ErrMsg3); if (ErrStat3 >= AbortErrLev) return + y%WriteOutput = 0.0_ReKi + end subroutine Init_Y + + !> Initialize other stuff that the framework requires, but isn't used here + subroutine Init_OtherStuff(ErrStat3,ErRMsg3) + integer(IntKi), intent( out) :: ErrStat3 + character(*), intent( out) :: ErrMsg3 + ErrStat3 = ErrID_None + ErrMsg3 = "" + x%DummyContState = 0.0_ReKi + xd%DummyDiscreteState = 0.0_ReKi + z%DummyConstrState = 0.0_ReKi + OtherState%DummyOtherState = 0_IntKi + m%idx_last = 1_IntKi ! Aerotable lookup indice + if (allocated(m%AllOuts)) deallocate(m%AllOuts) + allocate(m%AllOuts(0:MaxOutPts),STAT=ErrStat3) + if (ErrStat3 /= 0) then + ErrStat3 = ErrID_Fatal + ErrMsg3 = "Cannot allocate m%AllOuts" + return + endif + m%AllOuts = 0.0_SiKi + end subroutine Init_OtherStuff + + !> Initialize the InitOutput + subroutine Init_InitY(ErrStat3,ErrMsg3) + integer(IntKi), intent( out) :: ErrStat3 + character(*), intent( out) :: ErrMsg3 + integer(IntKi) :: i + call AllocAry(InitOut%WriteOutputHdr,p%NumOuts,'WriteOutputHdr',Errstat3,ErrMsg3); if (ErrStat3 >= AbortErrLev) return + call AllocAry(InitOut%WriteOutputUnt,p%NumOuts,'WriteOutputUnt',Errstat3,ErrMsg3); if (ErrStat3 >= AbortErrLev) return + do i=1,p%NumOuts + InitOut%WriteOutputHdr(i) = p%OutParam(i)%Name + InitOut%WriteOutputUnt(i) = p%OutParam(i)%Units + end do + ! Version + InitOut%Ver = ADsk_Ver + InitOut%AirDens = p%AirDens + end subroutine Init_InitY +END SUBROUTINE ADsk_Init + + +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine is called at the end of the simulation. +SUBROUTINE ADsk_End( u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) + type(ADsk_InputType), intent(inout) :: u !< System inputs + type(ADsk_ParameterType), intent(inout) :: p !< Parameters + type(ADsk_ContinuousStateType), intent(inout) :: x !< Continuous states + type(ADsk_DiscreteStateType), intent(inout) :: xd !< Discrete states + type(ADsk_ConstraintStateType), intent(inout) :: z !< Constraint states + type(ADsk_OtherStateType), intent(inout) :: OtherState !< Other states + type(ADsk_OutputType), intent(inout) :: y !< System outputs + type(ADsk_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 = 'ADsk_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 ADsk_DestroyInput( u, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + ! Destroy the parameter data: + call ADsk_DestroyParam( p, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + ! Destroy the state data: + call ADsk_DestroyContState( x, ErrStat2,ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + call ADsk_DestroyDiscState( xd, ErrStat2,ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + call ADsk_DestroyConstrState( z, ErrStat2,ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + call ADsk_DestroyOtherState( OtherState, ErrStat2,ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + ! Destroy the output data: + call ADsk_DestroyOutput( y, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + ! Destroy the misc data: + call ADsk_DestroyMisc( m, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) +END SUBROUTINE ADsk_End + + +!---------------------------------------------------------------------------------------------------------------------------------- +!> This is a routine for computing outputs, used in both loose and tight coupling. +!! It calculates the forces and moments on the rotor disk given an orientation, motion, blade pitch, rotor speed, and wind velocity. +!! The calculations are based on an interpolation into input table values. Since the table is stored as single kind and this method +!! makes several simplifying assumptions that introduuce error, all calculations here are performed in single precision. +SUBROUTINE ADsk_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, NeedWriteOutput ) + real(DbKi), intent(in ) :: t !< Current simulation time in seconds + type(ADsk_InputType), intent(in ) :: u !< Inputs at t + type(ADsk_ParameterType), intent(in ) :: p !< Parameters + type(ADsk_ContinuousStateType), intent(in ) :: x !< Continuous states at t + type(ADsk_DiscreteStateType), intent(in ) :: xd !< Discrete states at t + type(ADsk_ConstraintStateType), intent(in ) :: z !< Constraint states at t + type(ADsk_OtherStateType), intent(in ) :: OtherState !< Other states at t + type(ADsk_MiscVarType), intent(inout) :: m !< Misc variables for optimization (not copied in glue code) + type(ADsk_OutputType), intent(inout) :: y !< Outputs computed at t (Input only for mesh) + integer(IntKi), intent( out) :: ErrStat !< Error status of the operation + character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + logical, optional, intent(in ) :: NeedWriteOutput !< Flag to determine if WriteOutput values need to be calculated in this call + + ! local variables + real(ReKi), allocatable :: NoAcc(:,:) ! Placeholder array not used when accelerations not required. + real(SiKi) :: x_hatDisk(3) ! X direction unit vector of rotor disk (global) + real(SiKi) :: y_hatDisk(3) ! Y direction unit vector of rotor disk (global) + real(SiKi) :: z_hatDisk(3) ! Z direction unit vector of rotor disk (global) + real(SiKi) :: VRel_vec(3) ! relative velocity of wind in moving rotor disk frame + real(SiKi) :: tmp1,tmp3(3) ! temporary variables for calculations + integer(IntKi) :: i ! generic counter + integer(IntKi) :: ErrStat2 ! local error status + character(ErrMsgLen) :: ErrMsg2 ! local error message + character(*), parameter :: RoutineName = 'ADsk_CalcOutput' + logical :: CalcWriteOutput + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" + m%AllOuts = 0.0_SiKi + + if (present(NeedWriteOutput)) then + CalcWriteOutput = NeedWriteOutput + else + CalcWriteOutput = .true. ! by default, calculate WriteOutput unless told that we do not need it + end if + + + !-------------------------------- + !> Disk average wind speed + call CalcDiskAvgVel(ErrStat2,ErrMsg2); if (FAiled()) return + + !-------------------------------- + !> Disk vectors (in global frame) + !! + !! | Vector | Description | Name | + !! | :-------------------------- | :------------------------------------------------------------------------------------------ | :-------- | + !! | \f$\hat{x}_\textrm{disk}\f$ | normal to disk | x_hatDisk | + !! | \f$\hat{y}_\textrm{disk}\f$ | perpendicular to \f$\hat{x}_\textrm{disk}\f$ in the \f$x-y\f$ plane | y_hatDisk | + !! | \f$\hat{z}_\textrm{disk}\f$ | right handed coordinate axis to \f$\hat{x}_\textrm{disk}\f$ and \f$\hat{y}_\textrm{disk}\f$ | z_hatDisk | + ! Normal to disk + x_hatDisk(1:3) = real(u%HubMotion%Orientation(1:3,1,1), SiKi) + ! unit vector of disk normal projected to XY plane (calculate from cross_product(Z_global, x_hatDisk) ) + y_hatDisk(1) = real(-x_hatDisk(2),SiKi) + y_hatDisk(2) = real(x_hatDisk(1),SiKi) + y_hatDisk(3) = 0.0_SiKi + y_hatDisk = y_hatDisk / TwoNorm( y_hatDisk ) ! normalize + ! unit vector normal to x_hatDisk and y_hatDisk -- cross_product(x_hatDisk, y_hatDisk) + z_hatDisk(1) = real(-x_hatDisk(1)*x_hatDisk(3),SiKi) + z_hatDisk(2) = real(-x_hatDisk(2)*x_hatDisk(3),SiKi) + z_hatDisk(3) = real(x_hatDisk(1)*x_hatDisk(1) + x_hatDisk(2)*x_hatDisk(2),SiKi) + + + !------------- + ! Error checks + !------------- + ! Verify rotor and wind orientation are not pointed vertically + if ((EqualRealNos(m%DiskAvgVel(1), 0.0_ReKi) .and. EqualRealNos(m%DiskAvgVel(2), 0.0_ReKi)) .and. (.not. EqualRealNos(m%DiskAvgVel(3), 0.0_ReKi))) then + ErrStat2 = ErrID_Fatal; ErrMsg2 = "AeroDisk cannot calculate aero loads with wind in the vertical direction. Nacelle yaw-error undefined." + if (Failed()) return + endif + if (EqualRealNos(x_hatDisk(1), 0.0_SiKi) .and. EqualRealNos(x_hatDisk(2), 0.0_SiKi)) then + ErrStat2 = ErrID_Fatal; ErrMsg2 = "AeroDisk cannot calculate aero loads with rotor pointed in vertical direction. Nacelle yaw-error undefined." + if (Failed()) return + endif + + !------------------------- + !> Calculate some constants + !! - \f$\vec{V}_\textrm{rel} = \vec{V}_\textrm{wind} - \vec{v}_\textrm{rotor}\f$ + !! - \f$V_\textrm{rel} = \left\| \vec{V}_\textrm{rel} \right\|_2\f$ + !! - \f$V_\textrm{rel,x-disk} = \vec{V}_\textrm{rel_g} \bullet \hat{x}_\textrm{disk}\f$ + !------------------------- + ! Calculate relative wind velocity (global) + VRel_vec(1:3) = real(m%DiskAvgVel(1:3) - u%HubMotion%TranslationVel(1:3,1), SiKi) + ! Magnitude of relative wind velocity + m%VRel = TwoNorm(VRel_vec) + ! relative wind velocity along disk normal + m%VRel_xd = abs(dot_product(VRel_vec, x_hatDisk)) + ! set output + y%VRel = m%VRel + + !> calculate Lambda (TSR) and ChiSkew (inflow skew angle) + !! - \f$\lambda = \left\{ \begin{matrix} + !! 0 &\textrm{for}& \vec{V}_\textrm{rel,x-disk} = 0 \\ + !! \frac{\Omega R}{\vec{V}_\textrm{rel,x-disk}} &\textrm{otherwise}& + !! \end{matrix} \right.\f$ + !! - \f$ \chi = \left\{ \begin{matrix} + !! 0 &\textrm{for}& V_\textrm{rel} = 0 \\ + !! \text{ACOS}\left(\frac{\vec{V}_\textrm{rel}\bullet\hat{x}_\textrm{disk}}{V_\textrm{rel}}\right) &\textrm{otherwise}& + !! \end{matrix} \right.\f$ + !! + if (EqualRealNos(m%VRel_xd,0.0_SiKi)) then + m%lambda = 0.0_SiKi + else + m%lambda = real((u%RotSpeed * p%RotorRad),SiKi) / abs(m%VRel_xd) + endif + if (EqualRealNos(m%VRel,0.0_SiKi)) then + m%Chi = 0.0_SiKi + else + m%Chi = acos( m%VRel_xd / m%VRel ) + endif + y%ChiSkew = m%Chi + + !-------------- + !> x,y,z vectors -- convert global coordinates to disk coordinates + !! - \f$ A_\textrm{tmp} = \left\| \left( \vec{V}_\textrm{rel} \bullet \hat{x}_\textrm{disk} \right) \hat{x}_\textrm{disk} - \vec{V}_\textrm{rel} \right\|_2 \f$ + !! - \f$ \hat{x} = \hat{x}_\textrm{disk}\f$ + !! - \f$ \hat{y} = \left\{ \begin{matrix} + !! \hat{y}_\textrm{disk} = \hat{y}_\textrm{disk} &\textrm{for}& A_\textrm{tmp} = 0\\ + !! \hat{y}_\textrm{disk} = \frac{\left(\vec{V}_\textrm{rel} \bullet \hat{x}_\textrm{disk}\right) \hat{x}_\textrm{disk} - \vec{V}_\textrm{rel}}{A_\textrm{tmp}} &\textrm{otherwise}& + !! \end{matrix}\right. \f$ + !! - \f$ \hat{z} = \left\{ \begin{matrix} + !! \hat{z}_\textrm{disk} = \hat{z}_\textrm{disk} &\textrm{for}& A_\textrm{tmp} = 0\\ + !! \hat{z}_\textrm{disk} = \frac{\vec{V}_\textrm{rel} \times \hat{x}_\textrm{disk}}{A_\textrm{tmp}} &\textrm{otherwise}& + !! \end{matrix}\right.\f$ + tmp3 = dot_product(VRel_vec, x_hatDisk) * x_hatDisk - VRel_vec + tmp1 = TwoNorm(tmp3) + if (EqualRealNos(tmp1, 0.0_SiKi)) then + m%x_hat = x_hatDisk + m%y_hat = y_hatDisk + m%z_hat = z_hatDisk + else + m%x_hat = x_hatDisk + m%y_hat = tmp3 / tmp1 + m%z_hat = cross_product( VRel_vec, x_hatDisk ) / tmp1 + endif + + !--------------- + !> YawErr and Skew + !! - YawErr: \f$ \gamma_\textrm{YawErr} = \text{ATAN2}\left( + !! \vec{V}_\textrm{rel}[2] \hat{x}_\textrm{disk}[1] - \vec{V}_\textrm{rel}[1] \hat{x}_\textrm{disk}[2], + !! \vec{V}_\textrm{rel}[1] \hat{x}_\textrm{disk}[1] + \vec{V}_\textrm{rel}[2] \hat{x}_\textrm{disk}[2] \right) \f$ + !! - PsiSkew: \f$ \Psi_\textrm{skew} = \text{ATAN2}\left( \hat{z} \bullet \hat{y}_\textrm{disk}, -\hat{z}\bullet \hat{z}_\textrm{disk} \right) \f$ + y%YawErr = atan2( VRel_vec(2)*x_hatDisk(1) - VRel_vec(1)*x_hatDisk(2), VRel_vec(1)*x_hatDisk(1) + VRel_vec(2)*x_hatDisk(2) ) + y%PsiSkew = atan2( -1.0_ReKi * real( dot_product(m%z_hat,y_hatDisk), ReKi), real( dot_product(m%z_hat, z_hatDisk), ReKi) ) + + + !------------------------------------------- + !> Interpolate Force and Moment coefficients + call ADskTableInterp(p%AeroTable, p%UseTSR, m%lambda, real(u%RotSpeed,SiKi), m%VRel_xd, real(u%BlPitch,SiKi), m%Chi, m%idx_last, m%C_F, m%C_M, ErrStat2, ErrMsg2) + if (Failed()) return + + !> Apply skew if not in table + !! - \f$ \vec{F} = \vec{F} \left( \cos(\chi) \right)^2 \f$ + !! - \f$ \vec{M} = \vec{M} \left( \cos(\chi) \right)^2 \f$ + if (p%AeroTable%N_Skew <= 0_IntKi) then + tmp1 = cos(m%Chi) * cos(m%Chi) + m%C_F(1:3) = m%C_F(1:3) * tmp1 + m%C_M(1:3) = m%C_M(1:3) * tmp1 + endif + + !------------------------------------------- + !> Calculate forces using force coefficients (disk coordinates) + !! - \f$ F_x = \frac{1}{2} \rho A \left( V_\textrm{rel,x} \right)^2 * C_\textrm{F,x}\left(\text{TSR}@\lambda,\text{RtSpd}@\Omega,\text{V}_\text{rel}@V_\textrm{rel},\text{Pitch}@\theta,\text{Skew}@\chi\right) \f$ + !! - \f$ F_y = \frac{1}{2} \rho A \left( V_\textrm{rel,x} \right)^2 * C_\textrm{F,y}\left(\text{TSR}@\lambda,\text{RtSpd}@\Omega,\text{V}_\text{rel}@V_\textrm{rel},\text{Pitch}@\theta,\text{Skew}@\chi\right) \f$ + !! - \f$ F_z = \frac{1}{2} \rho A \left( V_\textrm{rel,x} \right)^2 * C_\textrm{F,z}\left(\text{TSR}@\lambda,\text{RtSpd}@\Omega,\text{V}_\text{rel}@V_\textrm{rel},\text{Pitch}@\theta,\text{Skew}@\chi\right) \f$ + !! - \f$ M_x = \frac{1}{2} \rho A \left( V_\textrm{rel,x} \right)^2 * C_\textrm{M,x}\left(\text{TSR}@\lambda,\text{RtSpd}@\Omega,\text{V}_\text{rel}@V_\textrm{rel},\text{Pitch}@\theta,\text{Skew}@\chi\right) \f$ + !! - \f$ M_y = \frac{1}{2} \rho A \left( V_\textrm{rel,x} \right)^2 * C_\textrm{M,y}\left(\text{TSR}@\lambda,\text{RtSpd}@\Omega,\text{V}_\text{rel}@V_\textrm{rel},\text{Pitch}@\theta,\text{Skew}@\chi\right) \f$ + !! - \f$ M_z = \frac{1}{2} \rho A \left( V_\textrm{rel,x} \right)^2 * C_\textrm{M,z}\left(\text{TSR}@\lambda,\text{RtSpd}@\Omega,\text{V}_\text{rel}@V_\textrm{rel},\text{Pitch}@\theta,\text{Skew}@\chi\right) \f$ + tmp1 = real(p%halfRhoA,SiKi) * m%VRel_xd * m%VRel_xd + m%Force(1:3) = tmp1 * m%C_F(1:3) + m%Moment(1:3) = tmp1 * real(p%RotorRad,SiKi) * m%C_M(1:3) + + + + !------------- + !> Set outputs + !! - Thrust force: \f$ C_t = C_\textrm{F,x} \f$ + !! - Torque coefficient: \f$ C_t = C_\textrm{M,x} \f$ + !! - \f$ \vec{F} = F_\textrm{x,disk} \hat{x} + F_\textrm{y,disk} \hat{y} + F_\textrm{z,disk} \hat{z} \f$ + !! - \f$ \vec{M} = M_\textrm{x,disk} \hat{x} + M_\textrm{y,disk} \hat{y} + M_\textrm{z,disk} \hat{z} \f$ + y%Ct = m%C_F(1) ! Fx in disk reference frame + y%Cq = m%C_M(1) ! Mx in disk reference frame + + ! AeroLoads in global coordinates + y%AeroLoads%Force( 1:3,1) = m%Force( 1)*m%x_hat + m%Force( 2)*m%y_hat + m%Force( 3)*m%z_hat + y%AeroLoads%Moment(1:3,1) = m%Moment(1)*m%x_hat + m%Moment(2)*m%y_hat + m%Moment(3)*m%z_hat + + + !---------------------------- + !> Set requested WriteOutputs + call Calc_WriteOutput( u, p, y, m, ErrStat2, ErrMsg2, CalcWriteOutput ) + + if (CalcWriteOutput) then + ! Place the selected output channels into the WriteOutput(:) + do i = 1,p%NumOuts ! Loop through all selected output channels + y%WriteOutput(i) = p%OutParam(i)%SignM * m%AllOuts( p%OutParam(i)%Indx ) + end do + endif + + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + !if (Failed) call CleanUp() + end function Failed + subroutine CalcDiskAvgVel(ErrStat3,ErrMsg3) + integer(IntKi), intent( out) :: ErrStat3 + character(ErrMsgLen), intent( out) :: ErrMsg3 + integer(IntKi) :: i + integer(IntKi), parameter :: StartNode = 1 ! index to start returning wind info from external flow field (note: this will not work with ExtInflow) + do i=1,ADsk_NumPtsDiskAvg + m%DiskWindPosAbs(:,i) = real(u%HubMotion%Position(1:3,1)+u%HubMotion%TranslationDisp(1:3,1),ReKi) + matmul(real(u%HubMotion%Orientation(1:3,1:3,1),ReKi),p%DiskWindPosRel(:,i)) + end do + call IfW_FlowField_GetVelAcc(p%FlowField, StartNode, t, m%DiskWindPosAbs, m%DiskWindVel, NoAcc, ErrStat3, ErrMsg3) + if (ErrStat2 >= AbortErrLev) return + ! calculate average + m%DiskAvgVel = sum(m%DiskWindVel, dim=2) / REAL(ADsk_NumPtsDiskAvg,SiKi) + end subroutine CalcDiskAvgVel +END SUBROUTINE ADsk_CalcOutput + +subroutine ADskTableInterp(ATab, UseTSR, lambda, RotSpeed, VRel, BlPitch, Chi, idx_last, C_F, C_M, ErrStat, ErrMsg) + type(ADsk_AeroTable), intent(in ) :: ATab !< AeroTable + logical, intent(in ) :: UseTSR !< flag to use TSR instead of RotSpeed and VRel + real(SiKi), intent(in ) :: lambda !< TSR - tip speed ratio + real(SiKi), intent(in ) :: RotSpeed !< Rotor Speed (rad/s) + real(SiKi), intent(in ) :: VRel !< relative wind velocity along disk normal + real(SiKi), intent(in ) :: BlPitch !< Blade pitch (collective) + real(SiKi), intent(in ) :: Chi !< Inflow skew angle + integer(IntKi), intent(inout) :: idx_last(5) !< m%idx_last -- for slight speedup in searching + real(SiKi), intent( out) :: C_F(3) !< Interpolated force coefficient + real(SiKi), intent( out) :: C_M(3) !< Interpolated moment coefficient + integer(IntKi), intent( out) :: ErrStat !< Error status of the operation + character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + ! Local variables + real(ReKi),parameter :: Tol = 1.0E-4 ! a tolerance for determining if two reals are the same (for interpolation) + real(SiKi) :: r_TSR ! Location between bouding indices into TSR dimension + real(SiKi) :: r_RtSpd ! Location between bounding indices into RtSpd dimension + real(SiKi) :: r_VRel ! Location between bounding indices into VRel dimension + real(SiKi) :: r_Pitch ! Location between bounding indices into Pitch dimension + real(SiKi) :: r_Skew ! Location between bounding indices into Skew dimension + integer(IntKi) :: i_TSR(2) ! Bounding indices into TSR dimension + integer(IntKi) :: i_RtSpd(2) ! Bounding indices into RtSpd dimension + integer(IntKi) :: i_VRel(2) ! Bounding indices into VRel dimension + integer(IntKi) :: i_Pitch(2) ! Bounding indices into Pitch dimension + integer(IntKi) :: i_Skew(2) ! Bounding indices into Skew dimension + real(SiKi) :: N3D( 8) ! interpolation coefficients for 3D interp -- size 2^n + real(SiKi) :: U3D( 8) ! interpolation values for 3D interp -- size 2^n + real(SiKi) :: N4D(16) ! interpolation coefficients for 4D interp -- size 2^n + real(SiKi) :: U4D(16) ! interpolation values for 4D interp -- size 2^n + integer(IntKi) :: ErrStat2 ! local error status + character(ErrMsgLen) :: ErrMsg2 ! local error message + character(*), parameter :: RoutineName = 'ADskTableInterp' + + ! Initialize variables + ErrStat = ErrID_None + ErrMsg = "" + + !--------------------------------------------- + ! Check that we can interpolate into the table + if (UseTSR) then + if ((lambda < ATab%TSR(1)-Tol) .or. (lambda > ATab%TSR(ATab%N_TSR)+Tol)) then + ErrMsg2 = " TSR value of "//trim(Num2LStr(lambda))//" is outside bounds of aero table ["// & + trim(Num2LStr(ATab%TSR(1)))//":"//trim(Num2LStr(ATab%TSR(ATab%N_TSR)))//"]" + call SetErrStat(ErrID_Fatal,ErrMsg2,ErrStat,ErrMsg,RoutineName) + endif + else + if ((RotSpeed < ATab%RtSpd(1)-Tol) .or. (RotSpeed > ATab%RtSpd(ATab%N_RtSpd)+Tol)) then + ErrMsg2 = " Rotor Speed value of "//trim(Num2LStr(RotSpeed))//" is outside bounds of aero table ["// & + trim(Num2LStr(ATab%RtSpd(1)))//":"//trim(Num2LStr(ATab%RtSpd(ATab%N_RtSpd)))//"]" + call SetErrStat(ErrID_Fatal,ErrMsg2,ErrStat,ErrMsg,RoutineName) + endif + if ((VRel < ATab%VRel(1)-Tol) .or. (VRel > ATab%VRel(ATab%N_VRel)+Tol)) then + ErrMsg2 = " VRel value of "//trim(Num2LStr(VRel))//" is outside bounds of aero table ["// & + trim(Num2LStr(ATab%VRel(1)))//":"//trim(Num2LStr(ATab%VRel(ATab%N_VRel)))//"]" + call SetErrStat(ErrID_Fatal,ErrMsg2,ErrStat,ErrMsg,RoutineName) + endif + endif + if (ATab%N_Pitch > 0_IntKi) then + if ((BlPitch < ATab%Pitch(1)-Tol) .or. (BlPitch > ATab%Pitch(ATab%N_Pitch)+Tol)) then + ErrMsg2 = " Blade pitch value of "//trim(Num2LStr(BlPitch))//" is outside bounds of aero table ["// & + trim(Num2LStr(ATab%Pitch(1)))//":"//trim(Num2LStr(ATab%Pitch(ATab%N_Pitch)))//"]" + call SetErrStat(ErrID_Fatal,ErrMsg2,ErrStat,ErrMsg,RoutineName) + endif + endif + if (ATab%N_Skew > 0_IntKi) then + if ((Chi < ATab%Skew(1)-Tol) .or. (Chi > ATab%Skew(ATab%N_Skew)+Tol)) then + ErrMsg2 = " Skew value of "//trim(Num2LStr(Chi))//" is outside bounds of aero table ["// & + trim(Num2LStr(ATab%Skew(1)))//":"//trim(Num2LStr(ATab%Skew(ATab%N_Skew)))//"]" + call SetErrStat(ErrID_Fatal,ErrMsg2,ErrStat,ErrMsg,RoutineName) + endif + endif + if (ErrStat >= AbortErrLev) return + + + !------------------------------- + ! Find indices for interpolation + + ! Initialize all indices to 1. If a column is not used, both indices will be 1 + i_TSR = 1_IntKi + i_RtSpd = 1_IntKi + i_VRel = 1_IntKi + i_Pitch = 1_IntKi + i_Skew = 1_IntKi + ! Set the ratios for all indices to 0 (centered between indices) + r_TSR = 0.0_SiKi + r_RtSpd = 0.0_SiKi + r_VRel = 0.0_SiKi + r_Pitch = 0.0_SiKi + r_Skew = 0.0_SiKi + + ! Find indices to TSR or RtSpd + VRel entries + if (UseTSR) then ! use TSR entry + if (ATab%N_TSR > 1_IntKi) then + ! Find lambda in the table (idx_last(1) is for TSR) + CALL LocateStp( lambda, ATab%TSR, idx_last(1), ATab%N_TSR ) + i_TSR(1) = idx_last(1) ! point before our point of interest + i_TSR(2) = min(idx_last(1)+1,ATab%N_TSR) ! next point, but not out of bounds + call CalcIsoparCoords( lambda, ATab%TSR(i_TSR(1)), ATab%TSR(i_TSR(2)), r_TSR ) + endif + else ! Use RtSpd and VRel instead + if (ATab%N_RtSpd > 1_IntKi) then + ! Find RotSpeed in the table (idx_last(2) is for RtSpd) + CALL LocateStp( RotSpeed, ATab%RtSpd, idx_last(2), ATab%N_RtSpd ) + i_RtSpd(1) = idx_last(2) + i_RtSpd(2) = min(idx_last(2)+1,ATab%N_RtSpd) + call CalcIsoparCoords( RotSpeed, ATab%RtSpd(i_RtSpd(1)), ATab%RtSpd(i_RtSpd(2)), r_RtSpd ) + endif + if (ATab%N_VRel > 1_IntKi) then + ! Find VRel in the table (idx_last(3) is for VRel) + CALL LocateStp( VRel, ATab%VRel, idx_last(3), ATab%N_VRel ) + i_VRel(1) = idx_last(3) + i_VRel(2) = min(idx_last(3)+1,ATab%N_VRel) + call CalcIsoparCoords( VRel, ATab%VRel(i_VRel(1)), ATab%VRel(i_VRel(2)), r_VRel ) + endif + endif + + ! Find indices to pitch + if (ATab%N_Pitch > 1_IntKi) then + ! Find Pitch in the table (idx_last(4) is for Pitch) + CALL LocateStp( BlPitch, ATab%Pitch, idx_last(4), ATab%N_Pitch ) + i_Pitch(1) = idx_last(4) + i_Pitch(2) = min(idx_last(4)+1,ATab%N_Pitch) + call CalcIsoparCoords( BlPitch, ATab%Pitch(i_Pitch(1)), ATab%Pitch(i_Pitch(2)), r_Pitch ) + endif + + ! Find indices to Skew + if (ATab%N_Skew > 1_IntKi) then + ! Find Chi in the table (idx_last(5) is for Skew) + CALL LocateStp( Chi, ATab%Skew, idx_last(5), ATab%N_Skew ) + i_Skew(1) = idx_last(5) + i_Skew(2) = min(idx_last(5)+1,ATab%N_Skew) + call CalcIsoparCoords( Chi, ATab%Skew(i_Skew(1)), ATab%Skew(i_Skew(2)), r_Skew ) + endif + + + !------------------------------------------------ + ! Interpolate values from the coefficients tables + ! For speed, the TSR and RtSpd + VRel cases are + ! handled separately. The table could be + ! interpolated using a 5D interpolation, but + ! since it is known that some indices will not + ! be needed (one ignored indice for RtSpd + VRel + ! case, or two indices for TSR case), simpler + ! interpolations can be used. + + if (UseTSR) then ! use TSR entry + ! Coefficients -- same for all calculations + N3D = getN3D() + + ! Force coefficients + U3D = getU3D(ATab%C_Fx); C_F(1) = sum(N3D * U3D) + U3D = getU3D(ATab%C_Fy); C_F(2) = sum(N3D * U3D) + U3D = getU3D(ATab%C_Fz); C_F(3) = sum(N3D * U3D) + + ! Moment coefficients + U3D = getU3D(ATab%C_Mx); C_M(1) = sum(N3D * U3D) + U3D = getU3D(ATab%C_My); C_M(2) = sum(N3D * U3D) + U3D = getU3D(ATab%C_Mz); C_M(3) = sum(N3D * U3D) + else ! Use RtSpd and VRel instead + ! Coefficients -- same for all calculations + N4D = getN4D() + + ! Force coefficients + U4D = getU4D(ATab%C_Fx); C_F(1) = sum(N4D * U4D) + U4D = getU4D(ATab%C_Fy); C_F(2) = sum(N4D * U4D) + U4D = getU4D(ATab%C_Fz); C_F(3) = sum(N4D * U4D) + + ! Moment coefficients + U4D = getU4D(ATab%C_Mx); C_M(1) = sum(N4D * U4D) + U4D = getU4D(ATab%C_My); C_M(2) = sum(N4D * U4D) + U4D = getU4D(ATab%C_Mz); C_M(3) = sum(N4D * U4D) + endif + + return + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + !if (Failed) call CleanUp() + end function Failed + function getN3D() result(Nr) ! For when TSR is given + real(SiKi) :: Nr(8) + Nr( 1) = ( 1.0_SiKi - r_TSR ) * ( 1.0_SiKi - r_Pitch ) * ( 1.0_SiKi - r_Skew ) + Nr( 2) = ( 1.0_SiKi - r_TSR ) * ( 1.0_SiKi - r_Pitch ) * ( 1.0_SiKi + r_Skew ) + Nr( 3) = ( 1.0_SiKi - r_TSR ) * ( 1.0_SiKi + r_Pitch ) * ( 1.0_SiKi - r_Skew ) + Nr( 4) = ( 1.0_SiKi - r_TSR ) * ( 1.0_SiKi + r_Pitch ) * ( 1.0_SiKi + r_Skew ) + Nr( 5) = ( 1.0_SiKi + r_TSR ) * ( 1.0_SiKi - r_Pitch ) * ( 1.0_SiKi - r_Skew ) + Nr( 6) = ( 1.0_SiKi + r_TSR ) * ( 1.0_SiKi - r_Pitch ) * ( 1.0_SiKi + r_Skew ) + Nr( 7) = ( 1.0_SiKi + r_TSR ) * ( 1.0_SiKi + r_Pitch ) * ( 1.0_SiKi - r_Skew ) + Nr( 8) = ( 1.0_SiKi + r_TSR ) * ( 1.0_SiKi + r_Pitch ) * ( 1.0_SiKi + r_Skew ) + Nr = Nr/ REAL( SIZE(Nr), SiKi ) ! normalize + end function getN3D + function getN4D() result(Nr) ! For when TSR is not given + real(SiKi) :: Nr(16) + Nr( 1) = ( 1.0_SiKi - r_RtSpd ) * ( 1.0_SiKi - r_VRel ) * ( 1.0_SiKi - r_Pitch ) * ( 1.0_SiKi - r_Skew ) + Nr( 2) = ( 1.0_SiKi - r_RtSpd ) * ( 1.0_SiKi - r_VRel ) * ( 1.0_SiKi - r_Pitch ) * ( 1.0_SiKi + r_Skew ) + Nr( 3) = ( 1.0_SiKi - r_RtSpd ) * ( 1.0_SiKi - r_VRel ) * ( 1.0_SiKi + r_Pitch ) * ( 1.0_SiKi - r_Skew ) + Nr( 4) = ( 1.0_SiKi - r_RtSpd ) * ( 1.0_SiKi - r_VRel ) * ( 1.0_SiKi + r_Pitch ) * ( 1.0_SiKi + r_Skew ) + Nr( 5) = ( 1.0_SiKi - r_RtSpd ) * ( 1.0_SiKi + r_VRel ) * ( 1.0_SiKi - r_Pitch ) * ( 1.0_SiKi - r_Skew ) + Nr( 6) = ( 1.0_SiKi - r_RtSpd ) * ( 1.0_SiKi + r_VRel ) * ( 1.0_SiKi - r_Pitch ) * ( 1.0_SiKi + r_Skew ) + Nr( 7) = ( 1.0_SiKi - r_RtSpd ) * ( 1.0_SiKi + r_VRel ) * ( 1.0_SiKi + r_Pitch ) * ( 1.0_SiKi - r_Skew ) + Nr( 8) = ( 1.0_SiKi - r_RtSpd ) * ( 1.0_SiKi + r_VRel ) * ( 1.0_SiKi + r_Pitch ) * ( 1.0_SiKi + r_Skew ) + Nr( 9) = ( 1.0_SiKi + r_RtSpd ) * ( 1.0_SiKi - r_VRel ) * ( 1.0_SiKi - r_Pitch ) * ( 1.0_SiKi - r_Skew ) + Nr(10) = ( 1.0_SiKi + r_RtSpd ) * ( 1.0_SiKi - r_VRel ) * ( 1.0_SiKi - r_Pitch ) * ( 1.0_SiKi + r_Skew ) + Nr(11) = ( 1.0_SiKi + r_RtSpd ) * ( 1.0_SiKi - r_VRel ) * ( 1.0_SiKi + r_Pitch ) * ( 1.0_SiKi - r_Skew ) + Nr(12) = ( 1.0_SiKi + r_RtSpd ) * ( 1.0_SiKi - r_VRel ) * ( 1.0_SiKi + r_Pitch ) * ( 1.0_SiKi + r_Skew ) + Nr(13) = ( 1.0_SiKi + r_RtSpd ) * ( 1.0_SiKi + r_VRel ) * ( 1.0_SiKi - r_Pitch ) * ( 1.0_SiKi - r_Skew ) + Nr(14) = ( 1.0_SiKi + r_RtSpd ) * ( 1.0_SiKi + r_VRel ) * ( 1.0_SiKi - r_Pitch ) * ( 1.0_SiKi + r_Skew ) + Nr(15) = ( 1.0_SiKi + r_RtSpd ) * ( 1.0_SiKi + r_VRel ) * ( 1.0_SiKi + r_Pitch ) * ( 1.0_SiKi - r_Skew ) + Nr(16) = ( 1.0_SiKi + r_RtSpd ) * ( 1.0_SiKi + r_VRel ) * ( 1.0_SiKi + r_Pitch ) * ( 1.0_SiKi + r_Skew ) + Nr = Nr / REAL( SIZE(Nr), SiKi ) ! normalize + end function getN4D + function getU3D(CT) result(Ur) ! For when TSR is given (i_RtSpd(1)=i_VRel(1)=1) + real(SiKi), intent(in) :: CT(:,:,:,:,:) ! Coefficient table + real(SiKi) :: Ur(8) + Ur( 1) = CT( i_TSR(1), i_RtSpd(1), i_VRel(1), i_Pitch(1), i_Skew(1) ) + Ur( 2) = CT( i_TSR(1), i_RtSpd(1), i_VRel(1), i_Pitch(1), i_Skew(2) ) + Ur( 3) = CT( i_TSR(1), i_RtSpd(1), i_VRel(1), i_Pitch(2), i_Skew(1) ) + Ur( 4) = CT( i_TSR(1), i_RtSpd(1), i_VRel(1), i_Pitch(2), i_Skew(2) ) + Ur( 5) = CT( i_TSR(2), i_RtSpd(1), i_VRel(1), i_Pitch(1), i_Skew(1) ) + Ur( 6) = CT( i_TSR(2), i_RtSpd(1), i_VRel(1), i_Pitch(1), i_Skew(2) ) + Ur( 7) = CT( i_TSR(2), i_RtSpd(1), i_VRel(1), i_Pitch(2), i_Skew(1) ) + Ur( 8) = CT( i_TSR(2), i_RtSpd(1), i_VRel(1), i_Pitch(2), i_Skew(2) ) + end function getU3D + function getU4D(CT) result(Ur) ! For when TSR is not given (i_TSR(1)=1) + real(SiKi), intent(in) :: CT(:,:,:,:,:) ! Coefficient table + real(SiKi) :: Ur(16) + Ur( 1) = CT( i_TSR(1), i_RtSpd(1), i_VRel(1), i_Pitch(1), i_Skew(1) ) + Ur( 2) = CT( i_TSR(1), i_RtSpd(1), i_VRel(1), i_Pitch(1), i_Skew(2) ) + Ur( 3) = CT( i_TSR(1), i_RtSpd(1), i_VRel(1), i_Pitch(2), i_Skew(1) ) + Ur( 4) = CT( i_TSR(1), i_RtSpd(1), i_VRel(1), i_Pitch(2), i_Skew(2) ) + Ur( 5) = CT( i_TSR(1), i_RtSpd(1), i_VRel(2), i_Pitch(1), i_Skew(1) ) + Ur( 6) = CT( i_TSR(1), i_RtSpd(1), i_VRel(2), i_Pitch(1), i_Skew(2) ) + Ur( 7) = CT( i_TSR(1), i_RtSpd(1), i_VRel(2), i_Pitch(2), i_Skew(1) ) + Ur( 8) = CT( i_TSR(1), i_RtSpd(1), i_VRel(2), i_Pitch(2), i_Skew(2) ) + Ur( 9) = CT( i_TSR(1), i_RtSpd(2), i_VRel(1), i_Pitch(1), i_Skew(1) ) + Ur(10) = CT( i_TSR(1), i_RtSpd(2), i_VRel(1), i_Pitch(1), i_Skew(2) ) + Ur(11) = CT( i_TSR(1), i_RtSpd(2), i_VRel(1), i_Pitch(2), i_Skew(1) ) + Ur(12) = CT( i_TSR(1), i_RtSpd(2), i_VRel(1), i_Pitch(2), i_Skew(2) ) + Ur(13) = CT( i_TSR(1), i_RtSpd(2), i_VRel(2), i_Pitch(1), i_Skew(1) ) + Ur(14) = CT( i_TSR(1), i_RtSpd(2), i_VRel(2), i_Pitch(1), i_Skew(2) ) + Ur(15) = CT( i_TSR(1), i_RtSpd(2), i_VRel(2), i_Pitch(2), i_Skew(1) ) + Ur(16) = CT( i_TSR(1), i_RtSpd(2), i_VRel(2), i_Pitch(2), i_Skew(2) ) + end function getU4D +end subroutine ADskTableInterp +!---------------------------------------------------------------------------------------------------------------------------------- +!> This subroutine calculates the iosparametric coordinates, isopc, which is a value between -1 and 1 (for each dimension of a dataset) +!! indicating where InCoord falls between posLo and posHi. +!! This routine is copied from WAMIT_Interp.f90 +subroutine CalcIsoparCoords( InCoord, posLo, posHi, isopc ) + real(SiKi), intent(in ) :: InCoord !< + real(SiKi), intent(in ) :: posLo !< coordinate values associated with Indx_Lo + real(SiKi), intent(in ) :: posHi !< coordinate values associated with Indx_Hi + real(SiKi), intent( out) :: isopc !< isoparametric coordinates + ! local variables + real(SiKi) :: dx ! difference between high and low coordinates in the bounding "box" + dx = posHi - posLo + if (EqualRealNos(dx, 0.0_SiKi)) then + isopc = 1.0_SiKi + else + isopc = ( 2.0_SiKi*InCoord - posLo - posHi ) / dx + ! to verify that we don't extrapolate, make sure this is bound between -1 and 1 (effectively nearest neighbor) + isopc = min( 1.0_SiKi, isopc ) + isopc = max(-1.0_SiKi, isopc ) + end if +end subroutine CalcIsoparCoords + +!---------------------------------------------------------------------------------------------------------------------------------- +!> 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. +!! NOTE: there are no states in AeroDisk +SUBROUTINE ADsk_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(ADsk_InputType), intent(inout) :: Inputs(:) !< Inputs at InputTimes (output for mesh connect) + real(DbKi), intent(in ) :: InputTimes(:) !< Times in seconds associated with Inputs + type(ADsk_ParameterType), intent(in ) :: p !< Parameters + type(ADsk_ContinuousStateType), intent(inout) :: x !< Input: Continuous states at t; + type(ADsk_DiscreteStateType), intent(inout) :: xd !< Input: Discrete states at t; + type(ADsk_ConstraintStateType), intent(inout) :: z !< Input: Constraint states at t; + type(ADsk_OtherStateType), intent(inout) :: OtherState !< Other states: Other states at t; + type(ADsk_MiscVarType), intent(inout) :: m !< Misc variables for optimization + 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 = 'ADsk_UpdateStates' + + ! Initialize variables + ErrStat = ErrID_None + ErrMsg = "" + + ! There are no states. + x%DummyContState = 0.0_ReKi + +end subroutine ADsk_UpdateStates + + +!---------------------------------------------------------------------------------------------------------------------------------- +!> This is a tight coupling routine for computing derivatives of continuous states. +!! NOTE: there are no states in AeroDisk +SUBROUTINE ADsk_CalcContStateDeriv( t, u, p, x, xd, z, OtherState, m, dxdt, ErrStat, ErrMsg ) + real(DbKi), intent(in ) :: t !< Current simulation time in seconds + type(ADsk_InputType), intent(in ) :: u !< Inputs at t + type(ADsk_ParameterType), intent(in ) :: p !< Parameters + type(ADsk_ContinuousStateType), intent(in ) :: x !< Continuous states at t + type(ADsk_DiscreteStateType), intent(in ) :: xd !< Discrete states at t + type(ADsk_ConstraintStateType), intent(in ) :: z !< Constraint states at t + type(ADsk_OtherStateType), intent(in ) :: OtherState !< Other states at t + type(ADsk_MiscVarType), intent(inout) :: m !< Misc variables for optimization (not copied in glue code) + type(ADsk_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 + + ! local variables + character(*), parameter :: RoutineName = 'ADsk_CalcContStateDeriv' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" + + ! There are no states + dxdt%DummyContState = 0.0_ReKi + +END SUBROUTINE ADsk_CalcContStateDeriv + + +END MODULE AeroDisk +!********************************************************************************************************************************** diff --git a/modules/aerodisk/src/AeroDisk_IO.f90 b/modules/aerodisk/src/AeroDisk_IO.f90 new file mode 100644 index 0000000000..997edf8f0c --- /dev/null +++ b/modules/aerodisk/src/AeroDisk_IO.f90 @@ -0,0 +1,1106 @@ +!********************************************************************************************************************************** +! LICENSING +! Copyright (C) 2024 National Renewable Energy Laboratory +! +! This file is part of AeroDisk +! +! 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 AeroDisk_IO + + USE AeroDisk_Types + USE AeroDisk_Output_Params + USE NWTC_Library + + implicit none + + ! data storage for reading/parsing table + type :: TableIndexType + integer(IntKi) :: ColTSR !< Column number for Tip-Speed Ratio + integer(IntKi) :: ColRtSpd !< Column number for Rotor Speed + integer(IntKi) :: ColVRel !< Column number for VRel + integer(IntKi) :: ColSkew !< Column number for Skew + integer(IntKi) :: ColPitch !< Column number for Pitch + integer(IntKi) :: NumColNamesGiven !< total number of column names given + end type TableIndexType + +contains + +!--------------------------------------------------------------- +!> Parse the input in the InFileInfo (FileInfo_Type data structure): +subroutine ADsk_ParsePrimaryFileData( InitInp, RootName, interval, FileInfo_In, InputFileData, UnEc, ErrStat, ErrMsg ) + type(ADsk_InitInputType), intent(in ) :: InitInp !< Input data for initialization routine + character(1024), intent(in ) :: RootName !< root name for summary file + real(DBKi), intent(in ) :: interval !< timestep + type(FileInfoType), intent(in ) :: FileInfo_In !< The input file stored in a data structure + type(ADsk_InputFile), intent(inout) :: InputFileData !< The data for initialization + integer(IntKi), intent( out) :: UnEc !< The local unit number for this module's echo file + integer(IntKi), intent( out) :: ErrStat !< Error status from this subroutine + character(*), intent( out) :: ErrMsg !< Error message from this subroutine + + ! local vars + integer(IntKi) :: CurLine !< current entry in FileInfo_In%Lines array + integer(IntKi) :: i !< generic counter + type(TableIndexType) :: TabIdx !< indices for table columnns, for simplifying data parsing/passing + real(SiKi) :: TmpRe(10) !< temporary 10 number array for reading values in from table + integer(IntKi) :: ErrStat2 !< Temporary error status for subroutine and function calls + character(ErrMsgLen) :: ErrMsg2 !< Temporary error message for subroutine and function calls + character(*), parameter :: RoutineName="ADsk_ParsePrimaryFileData" + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" + UnEc = -1 ! No file + + + CALL AllocAry( InputFileData%OutList, MaxOutPts, "Outlist", ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + !====== General ==================================================================================== + 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 ( UnEc, TRIM(RootName)//'.ech', ErrStat2, ErrMsg2 ) + if (Failed()) return; + WRITE(UnEc, '(A)') 'Echo file for AeroDisk primary input file: '//trim(InitInp%InputFile) + ! Write the first three lines into the echo file + WRITE(UnEc, '(A)') FileInfo_In%Lines(1) + WRITE(UnEc, '(A)') FileInfo_In%Lines(2) + WRITE(UnEc, '(A)') FileInfo_In%Lines(3) + + CurLine = 4 + call ParseVar( FileInfo_In, CurLine, 'Echo', InputFileData%Echo, ErrStat2, ErrMsg2, UnEc ) + if (Failed()) return + endif + + + ! DeltaT - Time interval for aerodynamic calculations {or default} (s): + call ParseVarWDefault ( FileInfo_In, CurLine, "DT", InputFileData%DT, interval, ErrStat2, ErrMsg2, UnEc ) + if (Failed()) return + + !====== Environmental Conditions =================================================================== + if ( InputFileData%Echo ) WRITE(UnEc, '(A)') FileInfo_In%Lines(CurLine) ! Write section break to echo + CurLine = CurLine + 1 + ! AirDens - Air density {or default} (kg/m^3) + call ParseVarWDefault( FileInfo_In, CurLine, "AirDens", InputFileData%AirDens, InitInp%defAirDens, ErrStat2, ErrMsg2, UnEc ) + if (Failed()) return + + !====== Actuator Disk Properties =================================================================== + if ( InputFileData%Echo ) WRITE(UnEc, '(A)') FileInfo_In%Lines(CurLine) ! Write section break to echo + CurLine = CurLine + 1 + ! RotorRad - Rotor radius (m) (or "default") + call ParseVarWDefault( FileInfo_In, CurLine, "RotorRad", InputFileData%RotorRad, InitInp%RotorRad, ErrStat2, ErrMsg2, UnEc ) + if (Failed()) return + + ! InColNames - names for the input columns for the table. + call Get_InColNames( FileInfo_In, CurLine, TabIdx, ErrStat2, ErrMsg2, UnEc ) + if (Failed()) return + + ! InColDims - Number of values in each column (-) (must have same number of columns as InColName) [each >=2] + call Get_InColDims( FileInfo_In, CurLine, TabIdx, InputFileData%AeroTable, ErrStat2, ErrMsg2, UnEc ) + if (Failed()) return + + ! Column headers + if ( InputFileData%Echo ) WRITE(UnEc, '(A)') FileInfo_In%Lines(CurLine) + CurLine = CurLine + 1 + if ( InputFileData%Echo ) WRITE(UnEc, '(A)') FileInfo_In%Lines(CurLine) + CurLine = CurLine + 1 + + ! Read table + call Get_RtAeroTableData( FileInfo_In, CurLine, TabIdx, InputFileData%AeroTable, ErrStat2, ErrMsg2, UnEc ) + if (Failed()) return + + + !====== Outputs ==================================================================================== + if ( InputFileData%Echo ) WRITE(UnEc, '(A)') FileInfo_In%Lines(CurLine) ! Write section break to echo + CurLine = CurLine + 1 +! ! SumPrint - Generate a summary file listing input options and interpolated properties to ".AD.sum"? (flag) +! call ParseVar( FileInfo_In, CurLine, "SumPrint", InputFileData%SumPrint, ErrStat2, ErrMsg2, UnEc ) +! if (Failed()) return + + if ( InputFileData%Echo ) WRITE(UnEc, '(A)') FileInfo_In%Lines(CurLine) ! Write section break to echo + CurLine = CurLine + 1 + call ReadOutputListFromFileInfo( FileInfo_In, CurLine, InputFileData%OutList, & + InputFileData%NumOuts, ErrStat2, ErrMsg2, UnEc ) + if (Failed()) return; + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + if (Failed) call CleanUp() + end function Failed + subroutine Cleanup() + ! Only do this on a fault. Leave open for calling routine in case we want to write anything else. + if (UnEc > 0_IntKi) close(UnEc) + end subroutine Cleanup + subroutine GetVarNamePos(FileName,LineNo,ChAry,NameToCheck,ColNum,ErrStat3,ErrMsg3) + character(*), intent(in ) :: FileName + integer(IntKi), intent(in ) :: LineNo + character(*), intent(in ) :: ChAry(:) + character(*), intent(in ) :: NameToCheck + integer(IntKi), intent( out) :: ColNum + integer(IntKi), intent( out) :: ErrStat3 + character(ErrMsgLen), intent( out) :: ErrMsg3 + character(len(ChAry(1))) :: TmpNm + character(len=len(NameToCheck)) :: TmpNmCk + integer(IntKi) :: WordNum + logical :: TmpFlag + ErrStat3 = ErrID_None + ErrMsg3 = "" + TmpFlag = .false. + ColNum = 0_IntKi ! if not present + TmpNmCk = NameToCheck; call Conv2UC(TmpNmCk) + do WordNum=1,size(ChAry) + TmpNm = ChAry(WordNum); call Conv2UC(TmpNm) + if (trim(TmpNm) == TmpNmCk) then + if (TmpFlag) then + ErrStat3 = ErrID_Fatal + ErrMsg3 = NewLine//' >> A fatal error occurred when parsing data from '// & + trim(FileName)//'.'//NewLine// & + ' >> The column name '//trim(NameToCheck)//' occurs more than once on line '// & + trim(Num2LStr(LineNo))//'.' + return + endif + TmpFlag = .true. + ColNum = WordNum + endif + enddo + end subroutine GetVarNamePos + subroutine Get_InColNames(Info,LineNo,Idx,ErrStat3,ErrMsg3,UnEc) + ! A custom routine is used here rather than using the ParseChAry as ParseChAry does not + ! handle an unknown number of quoted strings well (i.e: "RtSpd,VRel,Skew,Pitch") + type(FileInfoType), intent(in ) :: Info + integer(IntKi), intent(inout) :: LineNo + type(TableIndexType), intent(inout) :: Idx + integer(IntKi), intent( out) :: ErrStat3 + character(ErrMsgLen), intent( out) :: ErrMsg3 + integer(IntKi), intent(in ) :: UnEc + integer(IntKi) :: WordPos + character(1024) :: thisFile ! Simplify some error management + integer(IntKi) :: thisLine ! Simplify some error management + character(20) :: TmpChAry(6) + ErrStat3 = ErrID_None + ErrMsg3 = "" + ! Echo if we have a file + if ( UnEc > 0 ) write (UnEc,'(A)') TRIM( Info%Lines(LineNo) ) + + ! Parse out words from the line + call GetWords( Info%Lines(LineNo), TmpChAry, size(TmpChAry)) + + ! file info for error handling -- note that this could be in a different file than the above!!!! + thisFile =trim(Info%FileList(Info%FileIndx(LineNo))) + thisLine = Info%FileLine(LineNo) + + ! Check that this is the right line in the file and InColNames exists in first 5 words of line + call GetVarNamePos(thisFile, thisLine, TmpChAry, "InColNames", WordPos, ErrStat3, ErrMsg3) ! ignore duplicate entry error here + ! Error handling if wrong row + if (WordPos <= 0_IntKi) then + ErrStat3 = ErrID_Fatal + ErrMsg3 = NewLine//' >> A fatal error occurred when parsing data from '// & + trim(thisFile)//'.'//NewLine// & + ' >> The variable "InColNames" was not found on line '//trim(Num2LStr(thisLine))//'.' + return + endif + + ! Get order of the other columns (returns 0 if column name not in file) + call GetVarNamePos(thisFile, thisLine, TmpChAry, "TSR", Idx%ColTSR, ErrStat3,ErrMsg3); if (ErrStat3 >= ErrID_Fatal) return + call GetVarNamePos(thisFile, thisLine, TmpChAry, "RtSpd", Idx%ColRtSpd, ErrStat3,ErrMsg3); if (ErrStat3 >= ErrID_Fatal) return + call GetVarNamePos(thisFile, thisLine, TmpChAry, "VRel", Idx%ColVRel, ErrStat3,ErrMsg3); if (ErrStat3 >= ErrID_Fatal) return + call GetVarNamePos(thisFile, thisLine, TmpChAry, "Skew", Idx%ColSkew, ErrStat3,ErrMsg3); if (ErrStat3 >= ErrID_Fatal) return + call GetVarNamePos(thisFile, thisLine, TmpChAry, "Pitch", Idx%ColPitch, ErrStat3,ErrMsg3); if (ErrStat3 >= ErrID_Fatal) return + + ! total number of columns specified + Idx%NumColNamesGiven = maxval( (/ Idx%ColTSR, Idx%ColRtSpd, Idx%ColVRel, Idx%ColSkew, Idx%ColPitch /) ) + + ! make sure have have column names + if ((Idx%ColTSR + Idx%ColRtSpd + Idx%ColVRel + Idx%ColSkew + Idx%ColPitch) <= 0_IntKi) then + ErrStat3 = ErrID_Fatal + ErrMsg3 = NewLine//' >> A fatal error occurred when parsing data from '// & + trim(thisFile)//'.'//NewLine// & + ' >> At least one column of data named "TSR", "RtSpd", "VRel", "Skew", or "Pitch" must exist'// & + ' in the table header, but none were found'//trim(Num2LStr(thisLine))//'.' + return + endif + LineNo = LineNo + 1 ! Picked up column names, so increment to next line and return + return + end subroutine Get_InColNames + subroutine Get_InColDims(Info,LineNo,Idx,AeroTable,ErrStat3,ErrMsg3,UnEc) + ! A custom routine is used here rather than using the ParseChAry as ParseChAry does not + ! handle an unknown number of quoted strings well (i.e: "RtSpd,VRel,Skew,Pitch") + type(FileInfoType), intent(in ) :: Info + integer(IntKi), intent(inout) :: LineNo + type(TableIndexType), intent(in ) :: Idx + type(ADsk_AeroTable), intent(inout) :: AeroTable + integer(IntKi), intent( out) :: ErrStat3 + character(ErrMsgLen), intent( out) :: ErrMsg3 + integer(IntKi), intent(in ) :: UnEc + integer(IntKi) :: WordPos + integer(IntKi) :: IOS + character(1024) :: thisFile ! Simplify some error management + integer(IntKi) :: thisLine ! Simplify some error management + character(20) :: TmpChAry(6) ! Assume 5 columns and the name + ErrStat3 = ErrID_None + ErrMsg3 = "" + ! Echo if we have a file + if ( UnEc > 0 ) write (UnEc,'(A)') TRIM( Info%Lines(LineNo) ) + + ! Parse out words from the line + call GetWords( Info%Lines(LineNo), TmpChAry, size(TmpChAry)) + + ! file info for error handling -- note that this could be in a different file than the above!!!! + thisFile =trim(Info%FileList(Info%FileIndx(LineNo))) + thisLine = Info%FileLine(LineNo) + + ! Check that this is the right line in the file and InColDims exists in first 5 words of line + call GetVarNamePos(thisFile, thisLine, TmpChAry, "InColDims", WordPos, ErrStat3, ErrMsg3) ! ignore duplicate entry error here + ! Error handling if wrong row + if (WordPos <= 0_IntKi) then + ErrStat3 = ErrID_Fatal + ErrMsg3 = NewLine//' >> A fatal error occurred when parsing data from '// & + trim(thisFile)//'.'//NewLine// & + ' >> The variable "InColDims" was not found on line '//trim(Num2LStr(thisLine))//'.' + return + endif + + ! set number of indices for each to 0 + AeroTable%N_TSR = 0 + AeroTable%N_RtSpd = 0 + AeroTable%N_VRel = 0 + AeroTable%N_Skew = 0 + AeroTable%N_Pitch = 0 + + ! Read numbers for number of various entries from the tmpChAry + if (Idx%ColTSR > 0_IntKi) then + READ (TmpChAry(Idx%ColTSR ),*,IOSTAT=IOS) AeroTable%N_TSR + if (IOS /= 0) then + call SetErrStat(ErrID_Fatal,'Could not read "N_TSR" from column '// & + trim(Num2LStr(Idx%ColTSR))//' on line '//trim(Num2LStr(thisLine))// & + ' in file '//trim(thisFile)//'.',ErrStat3,ErrMsg3,'') + return + endif + endif + if (Idx%ColRtSpd > 0_IntKi) then + READ (TmpChAry(Idx%ColRtSpd),*,IOSTAT=IOS) AeroTable%N_RtSpd + if (IOS /= 0) then + call SetErrStat(ErrID_Fatal,'Could not read "N_RtSpd" from column '// & + trim(Num2LStr(Idx%ColRtSpd))//' on line '//trim(Num2LStr(thisLine))// & + ' in file '//trim(thisFile)//'.',ErrStat3,ErrMsg3,'') + return + endif + endif + if (Idx%ColVRel > 0_IntKi) then + READ (TmpChAry(Idx%ColVRel ),*,IOSTAT=IOS) AeroTable%N_VRel + if (IOS /= 0) then + call SetErrStat(ErrID_Fatal,'Could not read "N_VRel" from column '// & + trim(Num2LStr(Idx%ColVRel))//' on line '//trim(Num2LStr(thisLine))// & + ' in file '//trim(thisFile)//'.',ErrStat3,ErrMsg3,'') + return + endif + endif + if (Idx%ColSkew > 0_IntKi) then + READ (TmpChAry(Idx%ColSkew ),*,IOSTAT=IOS) AeroTable%N_Skew + if (IOS /= 0) then + call SetErrStat(ErrID_Fatal,'Could not read "N_Skew" from column '// & + trim(Num2LStr(Idx%ColSkew))//' on line '//trim(Num2LStr(thisLine))// & + ' in file '//trim(thisFile)//'.',ErrStat3,ErrMsg3,'') + return + endif + endif + if (Idx%ColPitch > 0_IntKi) then + READ (TmpChAry(Idx%ColPitch),*,IOSTAT=IOS) AeroTable%N_Pitch + if (IOS /= 0) then + call SetErrStat(ErrID_Fatal,'Could not read "N_Pitch" from column '// & + trim(Num2LStr(Idx%ColPitch))//' on line '//trim(Num2LStr(thisLine))// & + ' in file '//trim(thisFile)//'.',ErrStat3,ErrMsg3,'') + return + endif + endif + ! make sure all values positive + if (AeroTable%N_TSR < 0_IntKi) call SetErrStat(ErrID_Fatal,'Entry for "N_TSR" must be postive valued from column '// & + trim(Num2LStr(Idx%ColTSR ))//' on line '//trim(Num2LStr(thisLine))//' in file '//trim(thisFile)//'.',ErrStat3,ErrMsg3,'') + if (AeroTable%N_RtSpd < 0_IntKi) call SetErrStat(ErrID_Fatal,'Entry for "N_RtSpd" must be postive valued from column '// & + trim(Num2LStr(Idx%ColRtSpd))//' on line '//trim(Num2LStr(thisLine))//' in file '//trim(thisFile)//'.',ErrStat3,ErrMsg3,'') + if (AeroTable%N_VRel < 0_IntKi) call SetErrStat(ErrID_Fatal,'Entry for "N_VRel" must be postive valued from column '// & + trim(Num2LStr(Idx%ColVRel ))//' on line '//trim(Num2LStr(thisLine))//' in file '//trim(thisFile)//'.',ErrStat3,ErrMsg3,'') + if (AeroTable%N_Skew < 0_IntKi) call SetErrStat(ErrID_Fatal,'Entry for "N_Skew" must be postive valued from column '// & + trim(Num2LStr(Idx%ColSkew ))//' on line '//trim(Num2LStr(thisLine))//' in file '//trim(thisFile)//'.',ErrStat3,ErrMsg3,'') + if (AeroTable%N_Pitch < 0_IntKi) call SetErrStat(ErrID_Fatal,'Entry for "N_Pitch" must be postive valued from column '// & + trim(Num2LStr(Idx%ColPitch))//' on line '//trim(Num2LStr(thisLine))//' in file '//trim(thisFile)//'.',ErrStat3,ErrMsg3,'') + ! NOTE: we are storing 0 for the dimensions that don't exist in the table. We will + ! modify this later to make table usage simpler + LineNo = LineNo + 1 ! Picked up column names, so increment to next line and return + return + end subroutine Get_InColDims + +end subroutine ADsk_ParsePrimaryFileData + + +subroutine Get_RtAeroTableData(Info,LineNo,Idx,AeroTable,ErrStat,ErrMsg,UnEc) + ! Table entries may not be in order. So sort while reading in. + ! NOTE: Sparse data files are not currently supported + type(FileInfoType), intent(in ) :: Info + integer(IntKi), intent(inout) :: LineNo + type(TableIndexType), intent(in ) :: Idx + type(ADsk_AeroTable), intent(inout) :: AeroTable + integer(IntKi), intent( out) :: ErrStat + character(ErrMsgLen), intent( out) :: ErrMsg + integer(IntKi), intent(in ) :: UnEc + integer(IntKi) :: WordPos + integer(IntKi) :: IOS + character(1024) :: thisFile ! Simplify some error management + integer(IntKi) :: thisLine ! Simplify some error management + integer(IntKi) :: i,j ! Generic counters + integer(IntKi) :: NumCols ! number of columns expected + integer(IntKi) :: NumRows ! number of rows expected + integer(IntKi) :: Sz(5) ! Array size -- for readability of code + real(SiKi), allocatable :: TmpTab(:,:) ! temporary real array of allocatable size -- will read entire table in, then do the sorting + logical, allocatable :: Mask(:,:,:,:,:) ! to make sure we aren't missing any terms + integer(IntKi) :: ErrStat2 !< Temporary error status for subroutine and function calls + character(ErrMsgLen) :: ErrMsg2 !< Temporary error message for subroutine and function calls + character(*), parameter :: RoutineName='Get_RtAeroTableData' + ErrStat = ErrID_None + ErrMsg = "" + + + ! Number of columns in table + Sz = 0_IntKi + if (AeroTable%N_TSR > 0_IntKi) Sz(1) = 1_IntKi + if (AeroTable%N_RtSpd > 0_IntKi) Sz(2) = 1_IntKi + if (AeroTable%N_VRel > 0_IntKi) Sz(3) = 1_IntKi + if (AeroTable%N_Pitch > 0_IntKi) Sz(4) = 1_IntKi + if (AeroTable%N_Skew > 0_IntKi) Sz(5) = 1_IntKi + NumCols = Idx%NumColNamesGiven + 6_IntKi ! Add DOF columns + + ! temporary array for sizing -- note that min dimension size is 1 so we calculate number of rows correctly + Sz(1) = max(AeroTable%N_TSR, 1_IntKi) + Sz(2) = max(AeroTable%N_RtSpd,1_IntKi) + Sz(3) = max(AeroTable%N_VRel, 1_IntKi) + Sz(4) = max(AeroTable%N_Pitch,1_IntKi) + Sz(5) = max(AeroTable%N_Skew, 1_IntKi) + + ! Total number of rows we expect to find in the table + NumRows= Sz(1) * Sz(2) * Sz(3) * Sz(4) * Sz(5) + + ! Allocate arrays for forces/moments + call AllocAry(AeroTable%C_Fx, Sz(1), Sz(2), Sz(3), Sz(4), Sz(5), 'AeroTable%C_Fx', ErrStat2, ErrMsg2); if (Failed()) return; AeroTable%C_Fx = 0.0_SiKi + call AllocAry(AeroTable%C_Fy, Sz(1), Sz(2), Sz(3), Sz(4), Sz(5), 'AeroTable%C_Fy', ErrStat2, ErrMsg2); if (Failed()) return; AeroTable%C_Fy = 0.0_SiKi + call AllocAry(AeroTable%C_Fz, Sz(1), Sz(2), Sz(3), Sz(4), Sz(5), 'AeroTable%C_Fz', ErrStat2, ErrMsg2); if (Failed()) return; AeroTable%C_Fz = 0.0_SiKi + call AllocAry(AeroTable%C_Mx, Sz(1), Sz(2), Sz(3), Sz(4), Sz(5), 'AeroTable%C_Mx', ErrStat2, ErrMsg2); if (Failed()) return; AeroTable%C_Mx = 0.0_SiKi + call AllocAry(AeroTable%C_My, Sz(1), Sz(2), Sz(3), Sz(4), Sz(5), 'AeroTable%C_My', ErrStat2, ErrMsg2); if (Failed()) return; AeroTable%C_My = 0.0_SiKi + call AllocAry(AeroTable%C_Mz, Sz(1), Sz(2), Sz(3), Sz(4), Sz(5), 'AeroTable%C_Mz', ErrStat2, ErrMsg2); if (Failed()) return; AeroTable%C_Mz = 0.0_SiKi + + ! Allocate a mask for data checks + allocate(Mask(Sz(1),Sz(2),Sz(3),Sz(4),Sz(5)),STAT=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal,'Could not allocate array for data mask',ErrStat,ErrMsg,RoutineName) + call Cleanup() + return + endif + Mask = .false. + + ! Slurp the entire table into real array -- order for more efficient searching (bad for reading in) + call AllocAry(TmpTab,NumRows,NumCols,'TemporaryTable',ErrStat2,ErrMsg2); if (Failed()) return + do i=1,NumRows + read (Info%Lines(LineNo),*,iostat=IOS) TmpTab(i,1:NumCols) + if (IOS /= 0_IntKi) then + thisFile =trim(Info%FileList(Info%FileIndx(LineNo))) + thisLine = Info%FileLine(LineNo) + call SetErrStat(ErrID_Fatal,'Could not read "Actuator Disk Properties Table" row '//trim(Num2LStr(i))//' (line '//trim(Num2LStr(thisLine))// & + ' in file '//trim(thisFile)//'). Expecting '//trim(Num2LStr(NumRows))//' rows and '//trim(Num2LStr(NumCols))//' columns in table.',ErrStat,ErrMsg,RoutineName) + call Cleanup() + return + endif + if (UnEc > 0_IntKi) write(UnEc,'(A)') trim(Info%Lines(LineNo)) + LineNo = LineNo + 1 + enddo + + ! Find the unique values in the indexing columns of the table (if name given, otherwise skip) + if (AeroTable%N_TSR > 0_IntKi) call GetTabIndexVals( TmpTab(:,Idx%ColTSR ),'TSR' ,AeroTable%N_TSR ,AeroTable%TSR , ErrStat2, ErrMsg2); if (Failed()) return + if (AeroTable%N_RtSpd > 0_IntKi) call GetTabIndexVals( TmpTab(:,Idx%ColRtSpd),'RtSpd',AeroTable%N_RtSpd,AeroTable%RtSpd, ErrStat2, ErrMsg2); if (Failed()) return + if (AeroTable%N_VRel > 0_IntKi) call GetTabIndexVals( TmpTab(:,Idx%ColVRel ),'VRel' ,AeroTable%N_VRel ,AeroTable%VRel , ErrStat2, ErrMsg2); if (Failed()) return + if (AeroTable%N_Pitch > 0_IntKi) call GetTabIndexVals( TmpTab(:,Idx%ColPitch),'Pitch',AeroTable%N_Pitch,AeroTable%Pitch, ErrStat2, ErrMsg2); if (Failed()) return + if (AeroTable%N_Skew > 0_IntKi) call GetTabIndexVals( TmpTab(:,Idx%ColSkew ),'Skew' ,AeroTable%N_Skew ,AeroTable%Skew , ErrStat2, ErrMsg2); if (Failed()) return + + ! Now populate matrix -- read each line and put in correct table entry location + call PopulateAeroTabs(AeroTable,Mask,Idx,TmpTab,NumRows,NumCols,ErrStat2,ErrMsg2); if (Failed()) return + call CheckAeroTabs(AeroTable,Mask,ErrStat2,ErrMsg2); if (Failed()) return + + ! Now convert RtSpd from rpm to rad/s, and Pitch and Skew from deg to rad + if (AeroTable%N_RtSpd > 0_IntKi) AeroTable%RtSpd = (AeroTable%RtSpd * Pi_S)/30.0_SiKi + if (AeroTable%N_Pitch > 0_IntKi) AeroTable%Pitch = (AeroTable%Pitch * Pi_S)/180.0_SiKi + if (AeroTable%N_Skew > 0_IntKi) AeroTable%Skew = (AeroTable%Skew * Pi_S)/180.0_SiKi + + 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() + if (allocated(TmpTab)) deallocate(TmpTab) + if (allocated(Mask)) deallocate(Mask) + end subroutine Cleanup + subroutine GetTabIndexVals(TabCol,ColName,NumExpect,UniqueArray,ErrStat3,ErrMsg3) + real(SiKi), intent(in ) :: TabCol(:) + character(*), intent(in ) :: ColName + integer(IntKi), intent(in ) :: NumExpect + real(SiKi), allocatable,intent( out) :: UniqueArray(:) + integer(IntKi), intent( out) :: ErrStat3 + character(ErrMsgLen), intent( out) :: ErrMsg3 + integer(IntKi) :: NumFound + call UniqueRealValues( TabCol, UniqueArray, NumFound, ErrStat3, ErrMsg3 ) + if (NumExpect /= NumFound) then + call SetErrStat(ErrID_Fatal,'Expecting '//trim(Num2LStr(NumExpect))//' unique '//ColName// & + ' entries in "Actuator Disk Properties Table", but found '//trim(Num2LStr(NumFound))//' instead.',ErrStat3,ErrMsg3,'') + endif + end subroutine GetTabIndexVals + subroutine PopulateAeroTabs(Aero,DatMask,TabIdx,Dat,nRow,nCol,ErrStat3,ErrMsg3) + type(ADsk_AeroTable), intent(inout) :: Aero + logical, allocatable,intent(inout) :: DatMask(:,:,:,:,:) + type(TableIndexType), intent(in ) :: TabIdx + real(SiKi), allocatable,intent(in ) :: Dat(:,:) + integer(IntKi), intent(in ) :: nCol ! number of columns in Dat + integer(IntKi), intent(in ) :: nRow ! number of rows in Dat + integer(IntKi), intent( out) :: ErrStat3 + character(ErrMsgLen), intent( out) :: ErrMsg3 + real(SiKi) :: TmpR6(6) + integer(IntKi) :: row + integer(IntKi) :: iTSR,iRtSpd,iVRel,iPitch,iSkew + ErrStat3 = ErrID_None + ErrMsg3 = '' + DatMask = .false. ! Make sure data mask is false. Set to true for entries we populate + ! Step through each row of raw data, and find corresponding data location + ! Set index for placement to 1 in the event that the variable isn't actually used + do row=1,nRow + TmpR6(1:6) = Dat(row,nCol-5:nCol) ! DOF values + ! Find TSR entry LocateStp(XVal, XAry, Ind, AryLen) + iTSR = 1_IntKi + iRtSpd = 1_IntKi + iVRel = 1_IntKi + iPitch = 1_IntKi + iSkew = 1_IntKi + ! if no entries, the corresponding array is unallocated, so skip and leave index at 1 + if (Aero%N_TSR > 0_IntKi) call LocateStp( Dat(row,TabIdx%ColTSR ),Aero%TSR ,iTSR ,Aero%N_TSR ) + if (Aero%N_RtSpd > 0_IntKi) call LocateStp( Dat(row,TabIdx%ColRtSpd),Aero%RtSpd,iRtSpd,Aero%N_RtSpd) + if (Aero%N_VRel > 0_IntKi) call LocateStp( Dat(row,TabIdx%ColVRel ),Aero%VRel ,iVRel ,Aero%N_VRel ) + if (Aero%N_Pitch > 0_IntKi) call LocateStp( Dat(row,TabIdx%ColPitch),Aero%Pitch,iPitch,Aero%N_Pitch) + if (Aero%N_Skew > 0_IntKi) call LocateStp( Dat(row,TabIdx%ColSkew ),Aero%Skew ,iSkew ,Aero%N_Skew ) + Aero%C_Fx(iTSR,iRtSpd,iVRel,iPitch,iSkew) = TmpR6(1) + Aero%C_Fy(iTSR,iRtSpd,iVRel,iPitch,iSkew) = TmpR6(2) + Aero%C_Fz(iTSR,iRtSpd,iVRel,iPitch,iSkew) = TmpR6(3) + Aero%C_Mx(iTSR,iRtSpd,iVRel,iPitch,iSkew) = TmpR6(4) + Aero%C_My(iTSR,iRtSpd,iVRel,iPitch,iSkew) = TmpR6(5) + Aero%C_Mz(iTSR,iRtSpd,iVRel,iPitch,iSkew) = TmpR6(6) + if (DatMask(iTSR,iRtSpd,iVRel,iPitch,iSkew)) then + call SetErrStat(ErrID_Fatal,'Duplicate data entry in "Actuator Disk Properties Table" row '//trim(Num2LStr(row))//'.',ErrStat3,ErrMsg3,'') + else + DatMask(iTSR,iRtSpd,iVRel,iPitch,iSkew) = .true. + endif + enddo + end subroutine PopulateAeroTabs + subroutine CheckAeroTabs(Aero,DatMask,ErrStat3,ErrMsg3) + type(ADsk_AeroTable), intent(in ) :: Aero + logical, allocatable,intent(in ) :: DatMask(:,:,:,:,:) + integer(IntKi), intent( out) :: ErrStat3 + character(ErrMsgLen), intent( out) :: ErrMsg3 + integer(IntKi) :: iTSR,iRtSpd,iVRel,iPitch,iSkew + logical :: DataMiss + logical :: FirstMiss + character(60) :: TmpChar + real(SiKi) :: TmpR5(5) + ErrStat3 = ErrID_None + ErrMsg3 = '' + DataMiss = .false. + FirstMiss = .false. + do iSkew=1,size(DatMask,DIM=5) + do iPitch=1,size(DatMask,DIM=4) + do iVRel=1,size(DatMask,DIM=3) + do iRtSpd=1,size(DatMask,DIM=2) + do iTSR=1,size(DatMask,DIM=1) + if (.not. DatMask(iTSR,iRtSpd,iVRel,iPitch,iSkew)) then + DataMiss = .true. + if (.not. FirstMiss) then + FirstMiss = .true. + ErrStat3 = ErrID_Fatal + ErrMsg3 = NewLine//'Data missing from table!!! (note order may not be same as file)'//NewLine// & + ' TSR RtSpd VRel Pitch Skew '//NewLine + endif + TmpR5 = NaN_S + if (Aero%N_TSR >0_IntKi) TmpR5(1) = Aero%TSR (iTSR ) + if (Aero%N_RtSpd>0_IntKi) TmpR5(2) = Aero%RtSpd(iRtSpd) + if (Aero%N_VRel >0_IntKi) TmpR5(3) = Aero%VRel (iVRel ) + if (Aero%N_Pitch>0_IntKi) TmpR5(4) = Aero%Pitch(iPitch) + if (Aero%N_Skew >0_IntKi) TmpR5(5) = Aero%Skew (iSkew ) + write(TmpChar,'(6(f10.3))') TmpR5(1), TmpR5(2), TmpR5(3), TmpR5(4), TmpR5(5) + ErrMsg3 = ErrMsg3//TmpChar//NewLine + endif + enddo + enddo + enddo + enddo + enddo + end subroutine CheckAeroTabs +end subroutine Get_RtAeroTableData + + +!> This subroutine counts the number of unique values in an array and returns a sorted array of them. +!! NOTE: this routine is found in the WAMIT2.f90 file as well +SUBROUTINE UniqueRealValues( DataArrayIn, DataArrayOut, NumUnique, ErrStat, ErrMsg ) + IMPLICIT NONE + REAL(SiKi), INTENT(IN ) :: DataArrayIn(:) !< Array to search + REAL(SiKi), ALLOCATABLE, INTENT( OUT) :: DataArrayOut(:) !< Array to return results in + INTEGER(IntKi), INTENT( OUT) :: NumUnique !< Number of unique values found + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error Status + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Message about the error + ! Local variables + REAL(SiKi) :: TmpReal !< Temporary real value + INTEGER(IntKi) :: I !< Generic counter + INTEGER(IntKi) :: J !< Generic counter + REAL(SiKi), ALLOCATABLE :: TmpRealArray(:) !< Temporary real array + LOGICAL :: Duplicate !< If there is a duplicate value + ! Error handling + INTEGER(IntKi) :: ErrStatTmp + CHARACTER(2048) :: ErrMsgTmp + CHARACTER(*), PARAMETER :: RoutineName = 'UniqueRealValues' + + ! Initialize things + ErrStat = ErrID_None + ErrStatTmp = ErrID_None + ErrMsg = '' + ErrMsgTmp = '' + + ! Allocate the temporary array + CALL AllocAry( TmpRealArray, SIZE(DataArrayIn,1), 'Temporary array for data sorting', ErrStatTmp, ErrMsgTmp ) + CALL SetErrStat( ErrStatTmp, ErrMsgTmp, ErrStat, ErrMsg, RoutineName ) + IF ( ErrStat >= AbortErrLev ) THEN + CALL CleanUp + RETURN + ENDIF + + ! Initialize the array with a large negative number. + TmpRealArray = -9.9e9_SiKi + + ! The first point is unique since we haven't compared it to anything yet. + TmpRealArray(1) = DataArrayIn(1) + NumUnique = 1 + + ! Step through the DataArrayIn and put unique values into TmpRealArray. Start at second point + DO I=2,SIZE(DataArrayIn,1) + ! Check the current value against the largest stored value (I-1). If the current value is + ! larger than the last stored one, then it should be stored after it. + IF ( DataArrayIn(I) > TmpRealArray(NumUnique) ) THEN + TmpRealArray(NumUnique + 1) = DataArrayIn(I) + NumUnique = NumUnique + 1 + ELSE + ! Otherwise, if the value should not be put last, then we have to find where it goes. Before + ! searching for the location, first make sure this isn't a duplicate value. + Duplicate = .FALSE. + DO J= NumUnique, 1, -1 + IF ( EqualRealNos( DataArrayIn(I), TmpRealArray(J) )) THEN + Duplicate = .TRUE. + EXIT ! Stop searching + ENDIF + ENDDO + + ! If this is not a duplicate, the location where it goes has to be find. To do this, we will + ! sequentially shift each value one index further as we step backwards through the sorted + ! array. When we find the location between values where this goes, we put the value there. + IF ( .NOT. Duplicate ) THEN + DO J= NumUnique, 1, -1 ! TempRealArray only has NumUnique values. Everything after is junk. + IF ( DataArrayIn(I) < TmpRealArray(J) ) THEN + TmpRealArray(J+1) = TmpRealArray(J) ! Shift this value further along the array + IF ( J == 1 ) THEN ! If we are at the first value, then it goes here. + TmpRealArray(J) = DataArrayIn(I) + NumUnique = NumUnique + 1 + ELSE + IF ( DataArrayIn(I) > TmpRealArray(J-1) ) THEN ! If larger than the preceeding number, it goes here + TmpRealArray(J) = DataArrayIn(I) + NumUnique = NumUnique + 1 + ENDIF + ENDIF + ENDIF + ENDDO + ENDIF + ENDIF + ENDDO + + ! Now that we have the array sorted into unique values, we need to construct an array to return the values in. + CALL AllocAry( DataArrayOut, NumUnique, 'Return array with sorted values', ErrStatTmp, ErrMsgTmp ) + CALL SetErrStat( ErrStatTmp, ErrMsgTmp, ErrStat, ErrMsg, RoutineName ) + IF ( ErrStat >= AbortErrLev ) THEN + CALL CleanUp + RETURN + ENDIF + + ! Copy the values over + DataArrayOut = TmpRealArray(1:NumUnique) + call Cleanup() +contains + subroutine Cleanup() + if (allocated(TmpRealArray)) deallocate(TmpRealArray) + end subroutine Cleanup +END SUBROUTINE UniqueRealValues + + +!> Check inputdata +subroutine ADskInput_ValidateInput( InitInp, InputFileData, ErrStat, ErrMsg ) + type(ADsk_InitInputType), intent(in ) :: InitInp !< Input data for initialization + type(ADsk_InputFile), intent(in ) :: InputFileData !< The data for initialization + integer(IntKi), intent( out) :: ErrStat !< Error status from this subroutine + character(*), intent( out) :: ErrMsg !< Error message from this subroutine + character(*), parameter :: RoutineName="ADskInput_ValidateInput" + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" + + ! InitInput checks + if (InputFileData%DT <= 0.0_DbKi) call SetErrStat(ErrID_Fatal,'DT must not be negative.', ErrStat,ErrMsg,RoutineName) + if (InputFileData%AirDens <= 0.0_ReKi) call SetErrStat(ErrID_Fatal,'AirDens must not be negative.',ErrStat,ErrMsg,RoutineName) + if (InputFileData%RotorRad <= 0.0_ReKi) call SetErrStat(ErrID_Fatal,'RotorRad must not be negative.',ErrStat,ErrMsg,RoutineName) + if (InitInp%Linearize) call SetErrStat(ErrID_Fatal,'AeroDisk cannot perform linearization analysis.',ErrStat,ErrMsg,RoutineName) + + ! Some sanity checks AeroTable + if (InputFileData%AeroTable%N_TSR > 0_IntKi) then + if (minval(InputFileData%AeroTable%TSR) <= 0.0_SiKi) then + call SetErrStat(ErrID_Fatal,'All TSR values in table must be postive.',ErrStat,ErrMsg,RoutineName) + endif + endif + if (InputFileData%AeroTable%N_RtSpd > 0_IntKi) then + if (minval(InputFileData%AeroTable%RtSpd) <= 0.0_SiKi) then + call SetErrStat(ErrID_Fatal,'All RtSpd values in table must be postive.',ErrStat,ErrMsg,RoutineName) + endif + endif + if (InputFileData%AeroTable%N_VRel > 0_IntKi) then + if (minval(InputFileData%AeroTable%VRel) < 0.0_SiKi ) then + call SetErrStat(ErrID_Fatal,'All VRel values in table must be postive.',ErrStat,ErrMsg,RoutineName) + endif + endif + if (InputFileData%AeroTable%N_Pitch > 0_IntKi) then ! input table as deg, already converted to rad + if (minval(InputFileData%AeroTable%Pitch) <= -Pi_S .or. maxval(InputFileData%AeroTable%Pitch) >= Pi_S) then + call SetErrStat(ErrID_Fatal,'All Pitch values in table must be between -180 and 180 degrees.',ErrStat,ErrMsg,RoutineName) + endif + endif + if (InputFileData%AeroTable%N_Skew > 0_IntKi) then ! input table as deg, already converted to rad + if (minval(InputFileData%AeroTable%Skew) <= 0.0_SiKi .or. maxval(InputFileData%AeroTable%Skew) >= Pi_S) then + call SetErrStat(ErrID_Fatal,'All Skew values in table must be between 0 and 180 degrees.',ErrStat,ErrMsg,RoutineName) + endif + endif + + ! Either TSR or RtSpd+VRel columns must be provided + if (InputFileData%AeroTable%N_TSR > 1_IntKi) then + if (InputFileData%AeroTable%N_RtSpd > 1_IntKi .or. InputFileData%AeroTable%N_VRel > 1_IntKi) then + call SetErrStat(ErrID_Fatal,'TSR values present in table along with RtSpd or VRel values. '//NewLine// & + ' --> Either RtSpd and VRel values must be in the table, or TSR values may be present.'//NewLine// & + ' To skip columns, you may enter "0" for the column index and leave the table values.',ErrStat,ErrMsg,RoutineName) + return + endif + else + if (InputFileData%AeroTable%N_RtSpd < 2_IntKi .and. InputFileData%AeroTable%N_VRel < 2_IntKi) then + call SetErrStat(ErrID_Fatal,'TSR values NOT present in table, but RtSpd and VRel values are not both present. '//NewLine// & + ' --> Either RtSpd and VRel values must be in the table, or TSR values may be present.'//NewLine// & + ' To skip columns, you may enter "0" for the column index and leave the table values.',ErrStat,ErrMsg,RoutineName) + return + endif + endif +end subroutine ADskInput_ValidateInput + + +!> validate and process input file data (some was done during parsing of input file) +subroutine ADskInput_SetParameters( InitInp, Interval, InputFileData, p, ErrStat, ErrMsg ) + type(ADsk_InitInputType), intent(in ) :: InitInp !< Input data for initialization + real(DbKi), intent(inout) :: Interval !< Coupling interval in seconds + type(ADsk_InputFile), intent(inout) :: InputFileData !< The data for initialization + type(ADsk_ParameterType), intent(inout) :: p !< + integer(IntKi), intent( out) :: ErrStat !< Error status from this subroutine + character(*), intent( out) :: ErrMsg !< Error message from this subroutine + integer(IntKi) :: ErrStat2 !< Temporary error status for subroutine and function calls + character(ErrMsgLen) :: ErrMsg2 !< Temporary error message for subroutine and function calls + character(*), parameter :: RoutineName="ADskInput_SetParameters" + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" + + ! Set parameters + p%DT = InputFileData%DT + Interval = p%DT ! Tell glue code what we want for DT + p%numOuts = InputFileData%NumOuts + p%RootName = InitInp%RootName + p%RotorRad = InputFileData%RotorRad + p%AirDens = InputFileData%AirDens + p%UseTSR = .false. ! Reset below if N_TSR>1 + + ! Derived parameter + p%halfRhoA = 0.5_ReKi * p%AirDens * Pi * p%RotorRad*p%RotorRad + + ! Table of values + p%AeroTable%N_TSR = InputFileData%AeroTable%N_TSR + p%AeroTable%N_RtSpd = InputFileData%AeroTable%N_RtSpd + p%AeroTable%N_VRel = InputFileData%AeroTable%N_VRel + p%AeroTable%N_Pitch = InputFileData%AeroTable%N_Pitch + p%AeroTable%N_Skew = InputFileData%AeroTable%N_Skew + if (allocated( InputFileData%AeroTable%TSR )) call move_alloc( InputFileData%AeroTable%TSR, p%AeroTable%TSR ) + if (allocated( InputFileData%AeroTable%RtSpd)) call move_alloc( InputFileData%AeroTable%RtSpd, p%AeroTable%RtSpd ) + if (allocated( InputFileData%AeroTable%VRel )) call move_alloc( InputFileData%AeroTable%VRel, p%AeroTable%VRel ) + if (allocated( InputFileData%AeroTable%Pitch)) call move_alloc( InputFileData%AeroTable%Pitch, p%AeroTable%Pitch ) + if (allocated( InputFileData%AeroTable%Skew )) call move_alloc( InputFileData%AeroTable%Skew, p%AeroTable%Skew ) + if (allocated( InputFileData%AeroTable%C_Fx )) call move_alloc( InputFileData%AeroTable%C_Fx, p%AeroTable%C_Fx ) + if (allocated( InputFileData%AeroTable%C_Fy )) call move_alloc( InputFileData%AeroTable%C_Fy, p%AeroTable%C_Fy ) + if (allocated( InputFileData%AeroTable%C_Fz )) call move_alloc( InputFileData%AeroTable%C_Fz, p%AeroTable%C_Fz ) + if (allocated( InputFileData%AeroTable%C_Mx )) call move_alloc( InputFileData%AeroTable%C_Mx, p%AeroTable%C_Mx ) + if (allocated( InputFileData%AeroTable%C_My )) call move_alloc( InputFileData%AeroTable%C_My, p%AeroTable%C_My ) + if (allocated( InputFileData%AeroTable%C_Mz )) call move_alloc( InputFileData%AeroTable%C_Mz, p%AeroTable%C_Mz ) + + ! Use the TSR values + if (p%AeroTable%N_TSR > 1_IntKi) p%UseTSR = .true. + + ! Set the outputs + call SetOutParam(InputFileData%OutList, p, ErrStat, ErrMsg ) +end subroutine ADskInput_SetParameters + + +!> Write the table out to a whatever UnOut is (as long as > 0). +subroutine WriteAeroTab(Aero, UnOut) + type(ADsk_AeroTable), intent(in ) :: Aero + integer(IntKi), intent(in ) :: UnOut + integer(IntKi) :: i1,i2,i3,i4,i5 !< loop counters + character(*), parameter :: RoutineName="ADskInput_SetParameters" + if (UnOut <= 0_IntKi) return + ! Write header info + write(UnOut,'(A)') '=======================================' + write(UnOut,'(A)') 'AeroDisk Actuator Disk Properties table' + write(UnOut,'(A)') ' NOTE: the units correspond to units used internally within code, not units of input' + if (Aero%N_TSR > 0_IntKi) then + write(UnOut,'(A12,I5,A7)') ' TSR ',Aero%N_TSR,' values' + else + write(UnOut,'(A)') ' TSR ---- unused ----' + endif + if (Aero%N_RtSpd > 0_IntKi) then + write(UnOut,'(A12,I5,A7)') ' RtSpd ',Aero%N_RtSpd,' values' + else + write(UnOut,'(A)') ' RtSpd ---- unused ----' + endif + if (Aero%N_VRel > 0_IntKi) then + write(UnOut,'(A12,I5,A7)') ' VRel ',Aero%N_VRel,' values' + else + write(UnOut,'(A)') ' VRel ---- unused ----' + endif + if (Aero%N_Pitch > 0_IntKi) then + write(UnOut,'(A12,I5,A7)') ' Pitch ',Aero%N_Pitch,' values' + else + write(UnOut,'(A)') ' Pitch ---- unused ----' + endif + if (Aero%N_Skew > 0_IntKi) then + write(UnOut,'(A12,I5,A7)') ' Skew ',Aero%N_Skew,' values' + else + write(UnOut,'(A)') ' Skew ---- unused ----' + endif + ! Table header + if (Aero%N_TSR > 0_IntKi) write(UnOut,'(A15)',ADVANCE='NO') ' TSR ' + if (Aero%N_Skew > 0_IntKi) write(UnOut,'(A15)',ADVANCE='NO') ' RtSpd ' + if (Aero%N_VRel > 0_IntKi) write(UnOut,'(A15)',ADVANCE='NO') ' VRel ' + if (Aero%N_Pitch > 0_IntKi) write(UnOut,'(A15)',ADVANCE='NO') ' Pitch ' + if (Aero%N_Skew > 0_IntKi) write(UnOut,'(A15)',ADVANCE='NO') ' Skew ' + write(UnOut,'(A15)',ADVANCE='NO') ' C_fx ' + write(UnOut,'(A15)',ADVANCE='NO') ' C_fy ' + write(UnOut,'(A15)',ADVANCE='NO') ' C_fz ' + write(UnOut,'(A15)',ADVANCE='NO') ' C_mx ' + write(UnOut,'(A15)',ADVANCE='NO') ' C_my ' + write(UnOut,'(A15)',ADVANCE='NO') ' C_mz ' + write(UnOut,'(A)') '' + if (Aero%N_TSR > 0_IntKi) write(UnOut,'(A15)',ADVANCE='NO') ' (-) ' + if (Aero%N_Skew > 0_IntKi) write(UnOut,'(A15)',ADVANCE='NO') ' (rad/s) ' + if (Aero%N_VRel > 0_IntKi) write(UnOut,'(A15)',ADVANCE='NO') ' (m/s) ' + if (Aero%N_Pitch > 0_IntKi) write(UnOut,'(A15)',ADVANCE='NO') ' (rad) ' + if (Aero%N_Skew > 0_IntKi) write(UnOut,'(A15)',ADVANCE='NO') ' (rad) ' + write(UnOut,'(A15)',ADVANCE='NO') ' (-) ' + write(UnOut,'(A15)',ADVANCE='NO') ' (-) ' + write(UnOut,'(A15)',ADVANCE='NO') ' (-) ' + write(UnOut,'(A15)',ADVANCE='NO') ' (-) ' + write(UnOut,'(A15)',ADVANCE='NO') ' (-) ' + write(UnOut,'(A15)',ADVANCE='NO') ' (-) ' + write(UnOut,'(A)') '' + ! Table itself + do i1=1,max(1,Aero%N_TSR ) + do i2=1,max(1,Aero%N_Skew ) + do i3=1,max(1,Aero%N_VRel ) + do i4=1,max(1,Aero%N_Pitch) + do i5=1,max(1,Aero%N_Skew ) + if (Aero%N_TSR > 0_IntKi) write(UnOut,'(2x,f13.6)',ADVANCE='NO') Aero%TSR (i1) + if (Aero%N_Skew > 0_IntKi) write(UnOut,'(2x,f13.6)',ADVANCE='NO') Aero%Skew (i2) + if (Aero%N_VRel > 0_IntKi) write(UnOut,'(2x,f13.6)',ADVANCE='NO') Aero%VRel (i3) + if (Aero%N_Pitch> 0_IntKi) write(UnOut,'(2x,f13.6)',ADVANCE='NO') Aero%Pitch(i4) + if (Aero%N_Skew > 0_IntKi) write(UnOut,'(2x,f13.6)',ADVANCE='NO') Aero%Skew (i5) + write(UnOut, '(f13.6)',ADVANCE='NO') Aero%C_Fx(i1,i2,i3,i4,i5) + write(UnOut,'(2x,f13.6)',ADVANCE='NO') Aero%C_Fy(i1,i2,i3,i4,i5) + write(UnOut,'(2x,f13.6)',ADVANCE='NO') Aero%C_Fz(i1,i2,i3,i4,i5) + write(UnOut,'(2x,f13.6)',ADVANCE='NO') Aero%C_Mx(i1,i2,i3,i4,i5) + write(UnOut,'(2x,f13.6)',ADVANCE='NO') Aero%C_My(i1,i2,i3,i4,i5) + write(UnOut,'(2x,f13.6)',ADVANCE='NO') Aero%C_Mz(i1,i2,i3,i4,i5) + write(UnOut,'(A)') '' + enddo + enddo + enddo + enddo + enddo +end subroutine WriteAeroTab + + +!---------------------------------------------------------------------------------------------------------------------------------- +!> this routine fills the AllOuts array, which is used to send data to the glue code to be written to an output file. +!! NOTE: AllOuts is ReKi, but most calculations in this module are in single precision. This requires a bunch of conversions at this +!! stage. +subroutine Calc_WriteOutput( u, p, y, m, ErrStat, ErrMsg, CalcWriteOutput ) + type(ADsk_InputType), intent(in ) :: u !< The inputs at time T + type(ADsk_ParameterType), intent(in ) :: p !< The module parameters + type(ADsk_OutputType), intent(in ) :: y !< outputs + type(ADsk_MiscVarType), intent(inout) :: m !< misc/optimization variables (for computing mesh transfers) + integer(IntKi), intent( out) :: ErrStat !< The error status code + character(*), intent( out) :: ErrMsg !< The error message, if an error occurred + logical, intent(in ) :: CalcWriteOutput !< flag that determines if we need to compute AllOuts (or just the reaction loads that get returned to ServoDyn) + ! local variables + character(*), parameter :: RoutineName = 'Calc_WriteOutput' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + real(ReKi) :: Tmp3(3) + real(ReKi) :: Rxyz(3,3) !< rotation matrix for x,y,z of local coordinates + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" + + ! return if we are not providing outputs + if (.not. CalcWriteOutput) return + + ! rotation matrix +!FIXME: make sure this is actually correct and not the transpose of what we want + Rxyz(1:3,1) = real(m%x_hat, ReKi) + Rxyz(1:3,2) = real(m%y_hat, ReKi) + Rxyz(1:3,3) = real(m%z_hat, ReKi) + + ! Rotspeed etc + m%AllOuts( ADSpeed ) = u%RotSpeed * 30.0_ReKi / Pi + m%AllOuts( ADPitch ) = u%BlPitch * 180.0_ReKi / Pi + + m%AllOuts( ADTSR ) = real(m%lambda, ReKi) ! TSR -- tip speed ratio (-) + m%AllOuts( ADVRel ) = real(m%VRel, ReKi) ! magnitude of VRel vector (m/s) + m%AllOuts( ADSkew ) = real(m%Chi * 180.0_ReKi / Pi, ReKi) + + ! Wind in local frame, inertial frame + Tmp3 = matmul(Rxyz(1:3,1:3), m%DiskAvgVel) + m%AllOuts( ADVWindx ) = Tmp3(1) + m%AllOuts( ADVWindy ) = Tmp3(2) + m%AllOuts( ADVWindz ) = Tmp3(3) + m%AllOuts( ADVWindxi ) = m%DiskAvgVel(1) + m%AllOuts( ADVWindyi ) = m%DiskAvgVel(2) + m%AllOuts( ADVWindzi ) = m%DiskAvgVel(3) + + ! Rotor velocity in local frame, inertial frame + Tmp3 = matmul(Rxyz(1:3,1:3), u%HubMotion%TranslationVel(1:3,1)) + m%AllOuts( ADSTVx ) = Tmp3(1) + m%AllOuts( ADSTVy ) = Tmp3(2) + m%AllOuts( ADSTVz ) = Tmp3(3) + m%AllOuts( ADSTVxi ) = u%HubMotion%TranslationVel(1,1) + m%AllOuts( ADSTVyi ) = u%HubMotion%TranslationVel(2,1) + m%AllOuts( ADSTVzi ) = u%HubMotion%TranslationVel(3,1) + + ! Coefficients + if (EqualRealNos(m%VRel_xd,0.0_SiKi)) then + m%AllOuts( ADCp ) = 0.0_ReKi + else + m%AllOuts( ADCp ) = (real(m%Moment(1),ReKi) * u%RotSpeed) / (p%halfRhoA * real(m%Vrel_xd,ReKi)**3_IntKi ) + endif + m%AllOuts( ADCt ) = real(m%C_F(1),ReKi) + m%AllOuts( ADCq ) = real(m%C_M(1),ReKi) + + ! Power + m%AllOuts( ADPower ) = real(m%Moment(1),ReKi) * u%RotSpeed + + ! Resulting forces + m%AllOuts( ADFx ) = real(m%Force(1), ReKi) + m%AllOuts( ADFy ) = real(m%Force(2), ReKi) + m%AllOuts( ADFz ) = real(m%Force(3), ReKi) + m%AllOuts( ADMx ) = real(m%Moment(1),ReKi) + m%AllOuts( ADMy ) = real(m%Moment(2),ReKi) + m%AllOuts( ADMz ) = real(m%Moment(3),ReKi) + !Tmp3 = m%Force( 1)*m%x_hat + m%Force( 2)*m%y_hat + m%Force( 3)*m%z_hat + Tmp3 = matmul(real(m%Force(1:3),ReKi), Rxyz(1:3,1:3)) + m%AllOuts( ADFxi ) = Tmp3(1) + m%AllOuts( ADFyi ) = Tmp3(2) + m%AllOuts( ADFzi ) = Tmp3(3) + !Tmp3 = m%Moment(1)*m%x_hat + m%Moment(2)*m%y_hat + m%Moment(3)*m%z_hat + Tmp3 = matmul(real(m%Force(1:3),ReKi), Rxyz(1:3,1:3)) + m%AllOuts( ADMxi ) = Tmp3(1) + m%AllOuts( ADMyi ) = Tmp3(2) + m%AllOuts( ADMzi ) = Tmp3(3) + +end subroutine Calc_WriteOutput + + +!********************************************************************************************************************************** +! 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 24-Feb-2022 16:52:56. +SUBROUTINE SetOutParam(OutList, p, ErrStat, ErrMsg ) +!.................................................................................................................................. + + IMPLICIT NONE + + ! Passed variables + + CHARACTER(ChanLen), INTENT(IN) :: OutList(:) !< The list out user-requested outputs + TYPE(ADsk_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(34) = (/ & ! This lists the names of the allowed parameters, which must be sorted alphabetically + "ADCP ","ADCQ ","ADCT ","ADFX ","ADFXI ","ADFY ","ADFYI ","ADFZ ", & + "ADFZI ","ADMX ","ADMXI ","ADMY ","ADMYI ","ADMZ ","ADMZI ","ADPITCH ", & + "ADPOWER ","ADSKEW ","ADSPEED ","ADSTVX ","ADSTVXI ","ADSTVY ","ADSTVYI ","ADSTVZ ", & + "ADSTVZI ","ADTSR ","ADVREL ","ADVWINDX ","ADVWINDXI","ADVWINDY ","ADVWINDYI","ADVWINDZ ", & + "ADVWINDZI","ADYAWERR "/) + INTEGER(IntKi), PARAMETER :: ParamIndxAry(34) = (/ & ! This lists the index into AllOuts(:) of the allowed parameters ValidParamAry(:) + ADCp , ADCq , ADCt , ADFx , ADFxi , ADFy , ADFyi , ADFz , & + ADFzi , ADMx , ADMxi , ADMy , ADMyi , ADMz , ADMzi , ADPitch , & + ADPower , ADSkew , ADSpeed , ADSTVx , ADSTVxi , ADSTVy , ADSTVyi , ADSTVz , & + ADSTVzi , ADTSR , ADVRel , ADVWindx , ADVWindxi , ADVWindy , ADVWindyi , ADVWindz , & + ADVWindzi , ADYawErr /) + CHARACTER(ChanLen), PARAMETER :: ParamUnitsAry(34) = (/ & ! This lists the units corresponding to the allowed parameters + "(-) ","(-) ","(-) ","(N) ","(N) ","(N) ","(N) ","(N) ", & + "(N) ","(N-m)","(N-m)","(N-m)","(N-m)","(N-m)","(N-m)","(deg)", & + "(W) ","(deg)","(rpm)","(m/s)","(m/s)","(m/s)","(m/s)","(m/s)", & + "(m/s)","(-) ","(m/s)","(m/s)","(m/s)","(m/s)","(m/s)","(m/s)", & + "(m/s)","(deg)"/) + + + ! 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 AeroDisk 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 AeroDisk_IO diff --git a/modules/aerodisk/src/AeroDisk_Output_Params.f90 b/modules/aerodisk/src/AeroDisk_Output_Params.f90 new file mode 100644 index 0000000000..77729c170b --- /dev/null +++ b/modules/aerodisk/src/AeroDisk_Output_Params.f90 @@ -0,0 +1,67 @@ +!> The parameters in this code are from the MATLAB autogeneration scripts. Do not manually edit unless also editing the OutListParamters.xls AeroDisk tab. +module AeroDisk_Output_Params + use NWTC_Library + + +! =================================================================================================== +! 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 24-Feb-2022 18:19:57. + + + ! 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 + + + ! All channels: + + INTEGER(IntKi), PARAMETER :: ADSpeed = 1 + INTEGER(IntKi), PARAMETER :: ADTSR = 2 + INTEGER(IntKi), PARAMETER :: ADPitch = 3 + INTEGER(IntKi), PARAMETER :: ADVWindx = 4 + INTEGER(IntKi), PARAMETER :: ADVWindy = 5 + INTEGER(IntKi), PARAMETER :: ADVWindz = 6 + INTEGER(IntKi), PARAMETER :: ADVWindxi = 7 + INTEGER(IntKi), PARAMETER :: ADVWindyi = 8 + INTEGER(IntKi), PARAMETER :: ADVWindzi = 9 + INTEGER(IntKi), PARAMETER :: ADSTVx = 10 + INTEGER(IntKi), PARAMETER :: ADSTVy = 11 + INTEGER(IntKi), PARAMETER :: ADSTVz = 12 + INTEGER(IntKi), PARAMETER :: ADSTVxi = 13 + INTEGER(IntKi), PARAMETER :: ADSTVyi = 14 + INTEGER(IntKi), PARAMETER :: ADSTVzi = 15 + INTEGER(IntKi), PARAMETER :: ADVRel = 16 + INTEGER(IntKi), PARAMETER :: ADSkew = 17 + INTEGER(IntKi), PARAMETER :: ADYawErr = 18 + INTEGER(IntKi), PARAMETER :: ADCp = 19 + INTEGER(IntKi), PARAMETER :: ADCt = 20 + INTEGER(IntKi), PARAMETER :: ADCq = 21 + INTEGER(IntKi), PARAMETER :: ADFx = 22 + INTEGER(IntKi), PARAMETER :: ADFy = 23 + INTEGER(IntKi), PARAMETER :: ADFz = 24 + INTEGER(IntKi), PARAMETER :: ADFxi = 25 + INTEGER(IntKi), PARAMETER :: ADFyi = 26 + INTEGER(IntKi), PARAMETER :: ADFzi = 27 + INTEGER(IntKi), PARAMETER :: ADMx = 28 + INTEGER(IntKi), PARAMETER :: ADMy = 29 + INTEGER(IntKi), PARAMETER :: ADMz = 30 + INTEGER(IntKi), PARAMETER :: ADMxi = 31 + INTEGER(IntKi), PARAMETER :: ADMyi = 32 + INTEGER(IntKi), PARAMETER :: ADMzi = 33 + INTEGER(IntKi), PARAMETER :: ADPower = 34 + + + ! The maximum number of output channels which can be output by the code. + INTEGER(IntKi), PARAMETER :: MaxOutPts = 34 + +!End of code generated by Matlab script +! =================================================================================================== +end module AeroDisk_Output_Params diff --git a/modules/aerodisk/src/AeroDisk_Registry.txt b/modules/aerodisk/src/AeroDisk_Registry.txt new file mode 100644 index 0000000000..e3247e633b --- /dev/null +++ b/modules/aerodisk/src/AeroDisk_Registry.txt @@ -0,0 +1,139 @@ +################################################################################################################################### +# Registry for Simplified ElastoDyn in the FAST Modularization Framework +# This Registry file is used to create MODULE ADsk_Types which contains all of the user-defined types needed in Simplified ElastoDyn. +# 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 IfW_FlowField.txt + +# ..... Static Param .............................................................................................................. +param AeroDisk/ADsk - IntKi ADsk_NumPtsDiskAvg - 144 - "Number of points averaged for rotor-average wind speed" - + + +# ..... Table storage ............................................................................................................. +typedef AeroDisk/ADsk ADsk_AeroTable IntKi N_TSR - - - "Number of rotor tip-speed ratios in tables" - +typedef ^ ADsk_AeroTable IntKi N_RtSpd - - - "Number of rotor speeds in tables" - +typedef ^ ADsk_AeroTable IntKi N_VRel - - - "Number of rotor inflow wind speeds in tables" - +typedef ^ ADsk_AeroTable IntKi N_Pitch - - - "Number of rotor-collective blade-pitch angles in tables" - +typedef ^ ADsk_AeroTable IntKi N_Skew - - - "Number of rotor inflow-skew angles in tables" - +typedef ^ ADsk_AeroTable SiKi TSR {:} - - "Rotor TSR values in tables" - +typedef ^ ADsk_AeroTable SiKi RtSpd {:} - - "Rotor speed values in tables" rad/s +typedef ^ ADsk_AeroTable SiKi VRel {:} - - "Rotor inflow wind speeds tables" m/s +typedef ^ ADsk_AeroTable SiKi Pitch {:} - - "Rotor-collective blade-pitch anges in tables" rad +typedef ^ ADsk_AeroTable SiKi Skew {:} - - "Rotor inflow-skew values in tables" rad +typedef ^ ADsk_AeroTable SiKi C_Fx {:}{:}{:}{:}{:} - - "Thrust (x/axial) coefficient [N_TSR, N_RtSpd, N_VRel, N_Pitch, N_Skew]" - +typedef ^ ADsk_AeroTable SiKi C_Fy {:}{:}{:}{:}{:} - - "Transverse (y) force coefficient [N_TSR, N_RtSpd, N_VRel, N_Pitch, N_Skew]" - +typedef ^ ADsk_AeroTable SiKi C_Fz {:}{:}{:}{:}{:} - - "Transverse (z) force coefficient [N_TSR, N_RtSpd, N_VRel, N_Pitch, N_Skew]" - +typedef ^ ADsk_AeroTable SiKi C_Mx {:}{:}{:}{:}{:} - - "Torque (x/axial) coefficient [N_TSR, N_RtSpd, N_VRel, N_Pitch, N_Skew]" - +typedef ^ ADsk_AeroTable SiKi C_My {:}{:}{:}{:}{:} - - "Transverse (y) moment coefficient [N_TSR, N_RtSpd, N_VRel, N_Pitch, N_Skew]" - +typedef ^ ADsk_AeroTable SiKi C_Mz {:}{:}{:}{:}{:} - - "Transverse (z) moment coefficient [N_TSR, N_RtSpd, N_VRel, N_Pitch, N_Skew]" - + + +# ..... Initialization data ....................................................................................................... +# ADsk input file +typedef AeroDisk/ADsk ADsk_InputFile LOGICAL Echo - - - "Echo the input file" - +typedef ^ ADsk_InputFile DBKi DT - - - "Time step for module time integration" s +typedef ^ ADsk_InputFile ReKi AirDens - - - "Air density" "kg/m^3" +typedef ^ ADsk_InputFile ReKi RotorRad - - - "Rotor radius" m +typedef ^ ADsk_InputFile LOGICAL SumPrint - - - "Print summary data to .sum" - +typedef ^ ADsk_InputFile IntKi NumOuts - - - "Number of outputs" - +typedef ^ ADsk_InputFile CHARACTER(ChanLen) OutList : - - "List of user-requested output channels" - +typedef ^ ADsk_InputFile ADsk_AeroTable AeroTable - - - "Data table" - + +# ..... Initialization data ....................................................................................................... +# inputs for initialization: +typedef ^ InitInputType CHARACTER(1024) InputFile - - - "Name of the input file" - +typedef ^ InitInputType CHARACTER(1024) RootName - - - "RootName for writing output files" - +typedef ^ InitInputType ReKi RotorRad - - - "Rotor radius" m +typedef ^ InitInputType ReKi HubPosition {3} - - "Hub position -- center of rotor" m +typedef ^ InitInputType R8Ki HubOrientation {3}{3} - - "Hub orientation" - +typedef ^ InitInputType ReKi defAirDens - - - "Default atmospheric density from the driver; may be overwritten" "kg/m^3" +typedef ^ InitInputType LOGICAL Linearize - .false. - "this module cannot be linearized at present" - +typedef ^ InitInputType LOGICAL UseInputFile - .TRUE. - "Supplied by Driver: .TRUE. if using a input file, .FALSE. if all inputs are being passed in by the caller" - +typedef ^ InitInputType FileInfoType PassedFileData - - - "If we don't use the input file, pass everything through this" - +typedef ^ InitInputType FlowFieldType *FlowField - - - "Pointer of InflowWinds flow field data type" - + + +# outputs from initialization: +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 ReKi AirDens - - - "Air density" "kg/m^3" + + +# ..... Inputs .................................................................................................................... +# inputs on meshes: NONE +# inputs not on meshes: +typedef ^ InputType MeshType HubMotion - - - "Hub motion" - +typedef ^ InputType ReKi RotSpeed - - - "Rotor speed" "rad/s" +typedef ^ InputType ReKi BlPitch - - 2pi "blade pitch" "rad" + + + +# ..... Outputs ................................................................................................................... +# outputs on meshes: +typedef ^ OutputType MeshType AeroLoads - - - "Mesh containing the forces and moments from the aero loading (at HubMotion mesh)" - +#TODO: any mesh for visualization of blades/rotor disk? +# outputs not on meshes: +typedef ^ OutputType ReKi YawErr - - - "Nacelle-yaw error, i.e., the angle about positive Z from the rotor centerline to the rotor-disk-averaged relative wind velocity (ambient + rotor motion), both projected onto the horizontal plane" rad +typedef ^ OutputType ReKi PsiSkew - - - "Azimuth angle (from the nominally vertical axis in the disk plane, Z_disk ) to the vector about which the inflow skew angle is defined, i.e., the angle about positive X_disk from Z_disk to the vector about which the positive inflow skew angle is defined " rad +typedef ^ OutputType ReKi ChiSkew - - - "Inflow skew angle" rad +typedef ^ OutputType ReKi VRel - - - "Rotor-disk-averaged relative wind speed (ambient + rotor motion), normal to disk" m/s +typedef ^ OutputType ReKi Ct - - - "Thrust force coefficient (normal to disk)" - +typedef ^ OutputType ReKi Cq - - - "Torque coefficient (normal to disk)" - +typedef ^ OutputType ReKi WriteOutput {:} - - "Data to be written to an output file: see WriteOutputHdr for names of each variable" "see WriteOutputUnt" + + +# ..... States .................................................................................................................... +# continuous (differentiable) states: +typedef ^ ContinuousStateType ReKi DummyContState - - - "" - + +# Define discrete (nondifferentiable) states here: +typedef ^ DiscreteStateType ReKi DummyDiscreteState - - - "" - + +# Define constraint states here: +typedef ^ ConstraintStateType ReKi DummyConstrState - - - "" - + +# any other states +typedef ^ OtherStateType IntKi DummyOtherState - - - "" - + + +# ..... Parameters................................................................................................................. +# unchanging parameters: +typedef ^ ParameterType CHARACTER(1024) RootName - - - "RootName for writing output files" - +typedef ^ ParameterType DBKi DT - - - "Time step for module time integration" s +typedef ^ ParameterType ReKi RotorRad - - - "Rotor radius" m +typedef ^ ParameterType ReKi AirDens - - - "Air density" "kg/m^3" +typedef ^ ParameterType IntKi NumOuts - - - "Number of outputs" - +typedef ^ ParameterType ReKi halfRhoA - - - "half air density times rotor swept area" "kg/m" +typedef ^ ParameterType ADsk_AeroTable AeroTable - - - "Data table" - +typedef ^ ParameterType LOGICAL UseTSR - .false. - "Use TSR values from table instead of VRel + RtSpd" - +typedef ^ ParameterType OutParmType OutParam {:} - - "Names and units (and other characteristics) of all requested output parameters" - +typedef ^ ParameterType FlowFieldType *FlowField - - - "Pointer of InflowWinds flow field data type" - +typedef ^ ParameterType ReKi DiskWindPosRel {:}{:} - - "Disk locations for sampling to get disk avarage velocity (relative to hub)" m + +# ..... Misc/Optimization variables................................................................................................. +typedef ^ MiscVarType IntKi idx_last {5} - - "Last indices used in lookup search" - +typedef ^ MiscVarType ReKi AllOuts {:} - - "Array of all outputs" - +typedef ^ MiscVarType SiKi x_hat 3 - - "Acuator disk X direction unit vector (global)" - +typedef ^ MiscVarType SiKi y_hat 3 - - "Acuator disk Y direction unit vector (global)" - +typedef ^ MiscVarType SiKi z_hat 3 - - "Acuator disk Z direction unit vector (global)" - +typedef ^ MiscVarType SiKi VRel - - - "magnitude of VRel (output as y%VRel)" m/s +typedef ^ MiscVarType SiKi VRel_xd - - - "relative wind velocity along disk normal" m/s +typedef ^ MiscVarType SiKi lambda - - - "TSR - tip speed ratio" - +typedef ^ MiscVarType SiKi Chi - - - "Inflow skew angle" rad +typedef ^ MiscVarType SiKi C_F 3 - - "Force coefficients from table" - +typedef ^ MiscVarType SiKi C_M 3 - - "Moment coefficients from table" - +typedef ^ MiscVarType SiKi Force 3 - - "Force calculated in actuator disk coordinates" N +typedef ^ MiscVarType SiKi Moment 3 - - "Moment calculated in actuator disk coordinates" N-m +typedef ^ MiscVarType ReKi DiskWindPosAbs {:}{:} - - "Disk locations for sampling to get disk avarage velocity (absolute for getting wind)" m +typedef ^ MiscVarType ReKi DiskWindVel {:}{:} - - "Wind speed at disk locations for disk velocity" m/s +typedef ^ MiscVarType ReKi DiskAvgVel 3 - - "Average wind speed across rotor disk" m/s + diff --git a/modules/aerodisk/src/AeroDisk_Types.f90 b/modules/aerodisk/src/AeroDisk_Types.f90 new file mode 100644 index 0000000000..61fef67b28 --- /dev/null +++ b/modules/aerodisk/src/AeroDisk_Types.f90 @@ -0,0 +1,1614 @@ +!STARTOFREGISTRYGENERATEDFILE 'AeroDisk_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 +!********************************************************************************************************************************* +! AeroDisk_Types +!................................................................................................................................. +! This file is part of AeroDisk. +! +! 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 AeroDisk. 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 AeroDisk_Types +!--------------------------------------------------------------------------------------------------------------------------------- +USE IfW_FlowField_Types +USE NWTC_Library +IMPLICIT NONE + INTEGER(IntKi), PUBLIC, PARAMETER :: ADsk_NumPtsDiskAvg = 144 ! Number of points averaged for rotor-average wind speed [-] +! ========= ADsk_AeroTable ======= + TYPE, PUBLIC :: ADsk_AeroTable + INTEGER(IntKi) :: N_TSR = 0_IntKi !< Number of rotor tip-speed ratios in tables [-] + INTEGER(IntKi) :: N_RtSpd = 0_IntKi !< Number of rotor speeds in tables [-] + INTEGER(IntKi) :: N_VRel = 0_IntKi !< Number of rotor inflow wind speeds in tables [-] + INTEGER(IntKi) :: N_Pitch = 0_IntKi !< Number of rotor-collective blade-pitch angles in tables [-] + INTEGER(IntKi) :: N_Skew = 0_IntKi !< Number of rotor inflow-skew angles in tables [-] + REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: TSR !< Rotor TSR values in tables [-] + REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: RtSpd !< Rotor speed values in tables [rad/s] + REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: VRel !< Rotor inflow wind speeds tables [m/s] + REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: Pitch !< Rotor-collective blade-pitch anges in tables [rad] + REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: Skew !< Rotor inflow-skew values in tables [rad] + REAL(SiKi) , DIMENSION(:,:,:,:,:), ALLOCATABLE :: C_Fx !< Thrust (x/axial) coefficient [N_TSR, N_RtSpd, N_VRel, N_Pitch, N_Skew] [-] + REAL(SiKi) , DIMENSION(:,:,:,:,:), ALLOCATABLE :: C_Fy !< Transverse (y) force coefficient [N_TSR, N_RtSpd, N_VRel, N_Pitch, N_Skew] [-] + REAL(SiKi) , DIMENSION(:,:,:,:,:), ALLOCATABLE :: C_Fz !< Transverse (z) force coefficient [N_TSR, N_RtSpd, N_VRel, N_Pitch, N_Skew] [-] + REAL(SiKi) , DIMENSION(:,:,:,:,:), ALLOCATABLE :: C_Mx !< Torque (x/axial) coefficient [N_TSR, N_RtSpd, N_VRel, N_Pitch, N_Skew] [-] + REAL(SiKi) , DIMENSION(:,:,:,:,:), ALLOCATABLE :: C_My !< Transverse (y) moment coefficient [N_TSR, N_RtSpd, N_VRel, N_Pitch, N_Skew] [-] + REAL(SiKi) , DIMENSION(:,:,:,:,:), ALLOCATABLE :: C_Mz !< Transverse (z) moment coefficient [N_TSR, N_RtSpd, N_VRel, N_Pitch, N_Skew] [-] + END TYPE ADsk_AeroTable +! ======================= +! ========= ADsk_InputFile ======= + TYPE, PUBLIC :: ADsk_InputFile + LOGICAL :: Echo = .false. !< Echo the input file [-] + REAL(DbKi) :: DT = 0.0_R8Ki !< Time step for module time integration [s] + REAL(ReKi) :: AirDens = 0.0_ReKi !< Air density [kg/m^3] + REAL(ReKi) :: RotorRad = 0.0_ReKi !< Rotor radius [m] + LOGICAL :: SumPrint = .false. !< Print summary data to .sum [-] + INTEGER(IntKi) :: NumOuts = 0_IntKi !< Number of outputs [-] + CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: OutList !< List of user-requested output channels [-] + TYPE(ADsk_AeroTable) :: AeroTable !< Data table [-] + END TYPE ADsk_InputFile +! ======================= +! ========= ADsk_InitInputType ======= + TYPE, PUBLIC :: ADsk_InitInputType + CHARACTER(1024) :: InputFile !< Name of the input file [-] + CHARACTER(1024) :: RootName !< RootName for writing output files [-] + REAL(ReKi) :: RotorRad = 0.0_ReKi !< Rotor radius [m] + REAL(ReKi) , DIMENSION(1:3) :: HubPosition = 0.0_ReKi !< Hub position -- center of rotor [m] + REAL(R8Ki) , DIMENSION(1:3,1:3) :: HubOrientation = 0.0_R8Ki !< Hub orientation [-] + REAL(ReKi) :: defAirDens = 0.0_ReKi !< Default atmospheric density from the driver; may be overwritten [kg/m^3] + LOGICAL :: Linearize = .false. !< this module cannot be linearized at present [-] + LOGICAL :: UseInputFile = .TRUE. !< Supplied by Driver: .TRUE. if using a input file, .FALSE. if all inputs are being passed in by the caller [-] + TYPE(FileInfoType) :: PassedFileData !< If we don't use the input file, pass everything through this [-] + TYPE(FlowFieldType) , POINTER :: FlowField => NULL() !< Pointer of InflowWinds flow field data type [-] + END TYPE ADsk_InitInputType +! ======================= +! ========= ADsk_InitOutputType ======= + TYPE, PUBLIC :: ADsk_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 [-] + REAL(ReKi) :: AirDens = 0.0_ReKi !< Air density [kg/m^3] + END TYPE ADsk_InitOutputType +! ======================= +! ========= ADsk_InputType ======= + TYPE, PUBLIC :: ADsk_InputType + TYPE(MeshType) :: HubMotion !< Hub motion [-] + REAL(ReKi) :: RotSpeed = 0.0_ReKi !< Rotor speed [rad/s] + REAL(ReKi) :: BlPitch = 0.0_ReKi !< blade pitch [rad] + END TYPE ADsk_InputType +! ======================= +! ========= ADsk_OutputType ======= + TYPE, PUBLIC :: ADsk_OutputType + TYPE(MeshType) :: AeroLoads !< Mesh containing the forces and moments from the aero loading (at HubMotion mesh) [-] + REAL(ReKi) :: YawErr = 0.0_ReKi !< Nacelle-yaw error, i.e., the angle about positive Z from the rotor centerline to the rotor-disk-averaged relative wind velocity (ambient + rotor motion), both projected onto the horizontal plane [rad] + REAL(ReKi) :: PsiSkew = 0.0_ReKi !< Azimuth angle (from the nominally vertical axis in the disk plane, Z_disk ) to the vector about which the inflow skew angle is defined, i.e., the angle about positive X_disk from Z_disk to the vector about which the positive inflow skew angle is defined [rad] + REAL(ReKi) :: ChiSkew = 0.0_ReKi !< Inflow skew angle [rad] + REAL(ReKi) :: VRel = 0.0_ReKi !< Rotor-disk-averaged relative wind speed (ambient + rotor motion), normal to disk [m/s] + REAL(ReKi) :: Ct = 0.0_ReKi !< Thrust force coefficient (normal to disk) [-] + REAL(ReKi) :: Cq = 0.0_ReKi !< Torque coefficient (normal to disk) [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: WriteOutput !< Data to be written to an output file: see WriteOutputHdr for names of each variable [see WriteOutputUnt] + END TYPE ADsk_OutputType +! ======================= +! ========= ADsk_ContinuousStateType ======= + TYPE, PUBLIC :: ADsk_ContinuousStateType + REAL(ReKi) :: DummyContState = 0.0_ReKi !< [-] + END TYPE ADsk_ContinuousStateType +! ======================= +! ========= ADsk_DiscreteStateType ======= + TYPE, PUBLIC :: ADsk_DiscreteStateType + REAL(ReKi) :: DummyDiscreteState = 0.0_ReKi !< [-] + END TYPE ADsk_DiscreteStateType +! ======================= +! ========= ADsk_ConstraintStateType ======= + TYPE, PUBLIC :: ADsk_ConstraintStateType + REAL(ReKi) :: DummyConstrState = 0.0_ReKi !< [-] + END TYPE ADsk_ConstraintStateType +! ======================= +! ========= ADsk_OtherStateType ======= + TYPE, PUBLIC :: ADsk_OtherStateType + INTEGER(IntKi) :: DummyOtherState = 0_IntKi !< [-] + END TYPE ADsk_OtherStateType +! ======================= +! ========= ADsk_ParameterType ======= + TYPE, PUBLIC :: ADsk_ParameterType + CHARACTER(1024) :: RootName !< RootName for writing output files [-] + REAL(DbKi) :: DT = 0.0_R8Ki !< Time step for module time integration [s] + REAL(ReKi) :: RotorRad = 0.0_ReKi !< Rotor radius [m] + REAL(ReKi) :: AirDens = 0.0_ReKi !< Air density [kg/m^3] + INTEGER(IntKi) :: NumOuts = 0_IntKi !< Number of outputs [-] + REAL(ReKi) :: halfRhoA = 0.0_ReKi !< half air density times rotor swept area [kg/m] + TYPE(ADsk_AeroTable) :: AeroTable !< Data table [-] + LOGICAL :: UseTSR = .false. !< Use TSR values from table instead of VRel + RtSpd [-] + TYPE(OutParmType) , DIMENSION(:), ALLOCATABLE :: OutParam !< Names and units (and other characteristics) of all requested output parameters [-] + TYPE(FlowFieldType) , POINTER :: FlowField => NULL() !< Pointer of InflowWinds flow field data type [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: DiskWindPosRel !< Disk locations for sampling to get disk avarage velocity (relative to hub) [m] + END TYPE ADsk_ParameterType +! ======================= +! ========= ADsk_MiscVarType ======= + TYPE, PUBLIC :: ADsk_MiscVarType + INTEGER(IntKi) , DIMENSION(1:5) :: idx_last = 0_IntKi !< Last indices used in lookup search [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: AllOuts !< Array of all outputs [-] + REAL(SiKi) , DIMENSION(1:3) :: x_hat = 0.0_R4Ki !< Acuator disk X direction unit vector (global) [-] + REAL(SiKi) , DIMENSION(1:3) :: y_hat = 0.0_R4Ki !< Acuator disk Y direction unit vector (global) [-] + REAL(SiKi) , DIMENSION(1:3) :: z_hat = 0.0_R4Ki !< Acuator disk Z direction unit vector (global) [-] + REAL(SiKi) :: VRel = 0.0_R4Ki !< magnitude of VRel (output as y%VRel) [m/s] + REAL(SiKi) :: VRel_xd = 0.0_R4Ki !< relative wind velocity along disk normal [m/s] + REAL(SiKi) :: lambda = 0.0_R4Ki !< TSR - tip speed ratio [-] + REAL(SiKi) :: Chi = 0.0_R4Ki !< Inflow skew angle [rad] + REAL(SiKi) , DIMENSION(1:3) :: C_F = 0.0_R4Ki !< Force coefficients from table [-] + REAL(SiKi) , DIMENSION(1:3) :: C_M = 0.0_R4Ki !< Moment coefficients from table [-] + REAL(SiKi) , DIMENSION(1:3) :: Force = 0.0_R4Ki !< Force calculated in actuator disk coordinates [N] + REAL(SiKi) , DIMENSION(1:3) :: Moment = 0.0_R4Ki !< Moment calculated in actuator disk coordinates [N-m] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: DiskWindPosAbs !< Disk locations for sampling to get disk avarage velocity (absolute for getting wind) [m] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: DiskWindVel !< Wind speed at disk locations for disk velocity [m/s] + REAL(ReKi) , DIMENSION(1:3) :: DiskAvgVel = 0.0_ReKi !< Average wind speed across rotor disk [m/s] + END TYPE ADsk_MiscVarType +! ======================= +CONTAINS + +subroutine ADsk_CopyAeroTable(SrcAeroTableData, DstAeroTableData, CtrlCode, ErrStat, ErrMsg) + type(ADsk_AeroTable), intent(in) :: SrcAeroTableData + type(ADsk_AeroTable), intent(inout) :: DstAeroTableData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(5), UB(5) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'ADsk_CopyAeroTable' + ErrStat = ErrID_None + ErrMsg = '' + DstAeroTableData%N_TSR = SrcAeroTableData%N_TSR + DstAeroTableData%N_RtSpd = SrcAeroTableData%N_RtSpd + DstAeroTableData%N_VRel = SrcAeroTableData%N_VRel + DstAeroTableData%N_Pitch = SrcAeroTableData%N_Pitch + DstAeroTableData%N_Skew = SrcAeroTableData%N_Skew + if (allocated(SrcAeroTableData%TSR)) then + LB(1:1) = lbound(SrcAeroTableData%TSR) + UB(1:1) = ubound(SrcAeroTableData%TSR) + if (.not. allocated(DstAeroTableData%TSR)) then + allocate(DstAeroTableData%TSR(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstAeroTableData%TSR.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstAeroTableData%TSR = SrcAeroTableData%TSR + end if + if (allocated(SrcAeroTableData%RtSpd)) then + LB(1:1) = lbound(SrcAeroTableData%RtSpd) + UB(1:1) = ubound(SrcAeroTableData%RtSpd) + if (.not. allocated(DstAeroTableData%RtSpd)) then + allocate(DstAeroTableData%RtSpd(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstAeroTableData%RtSpd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstAeroTableData%RtSpd = SrcAeroTableData%RtSpd + end if + if (allocated(SrcAeroTableData%VRel)) then + LB(1:1) = lbound(SrcAeroTableData%VRel) + UB(1:1) = ubound(SrcAeroTableData%VRel) + if (.not. allocated(DstAeroTableData%VRel)) then + allocate(DstAeroTableData%VRel(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstAeroTableData%VRel.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstAeroTableData%VRel = SrcAeroTableData%VRel + end if + if (allocated(SrcAeroTableData%Pitch)) then + LB(1:1) = lbound(SrcAeroTableData%Pitch) + UB(1:1) = ubound(SrcAeroTableData%Pitch) + if (.not. allocated(DstAeroTableData%Pitch)) then + allocate(DstAeroTableData%Pitch(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstAeroTableData%Pitch.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstAeroTableData%Pitch = SrcAeroTableData%Pitch + end if + if (allocated(SrcAeroTableData%Skew)) then + LB(1:1) = lbound(SrcAeroTableData%Skew) + UB(1:1) = ubound(SrcAeroTableData%Skew) + if (.not. allocated(DstAeroTableData%Skew)) then + allocate(DstAeroTableData%Skew(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstAeroTableData%Skew.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstAeroTableData%Skew = SrcAeroTableData%Skew + end if + if (allocated(SrcAeroTableData%C_Fx)) then + LB(1:5) = lbound(SrcAeroTableData%C_Fx) + UB(1:5) = ubound(SrcAeroTableData%C_Fx) + if (.not. allocated(DstAeroTableData%C_Fx)) then + allocate(DstAeroTableData%C_Fx(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstAeroTableData%C_Fx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstAeroTableData%C_Fx = SrcAeroTableData%C_Fx + end if + if (allocated(SrcAeroTableData%C_Fy)) then + LB(1:5) = lbound(SrcAeroTableData%C_Fy) + UB(1:5) = ubound(SrcAeroTableData%C_Fy) + if (.not. allocated(DstAeroTableData%C_Fy)) then + allocate(DstAeroTableData%C_Fy(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstAeroTableData%C_Fy.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstAeroTableData%C_Fy = SrcAeroTableData%C_Fy + end if + if (allocated(SrcAeroTableData%C_Fz)) then + LB(1:5) = lbound(SrcAeroTableData%C_Fz) + UB(1:5) = ubound(SrcAeroTableData%C_Fz) + if (.not. allocated(DstAeroTableData%C_Fz)) then + allocate(DstAeroTableData%C_Fz(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstAeroTableData%C_Fz.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstAeroTableData%C_Fz = SrcAeroTableData%C_Fz + end if + if (allocated(SrcAeroTableData%C_Mx)) then + LB(1:5) = lbound(SrcAeroTableData%C_Mx) + UB(1:5) = ubound(SrcAeroTableData%C_Mx) + if (.not. allocated(DstAeroTableData%C_Mx)) then + allocate(DstAeroTableData%C_Mx(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstAeroTableData%C_Mx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstAeroTableData%C_Mx = SrcAeroTableData%C_Mx + end if + if (allocated(SrcAeroTableData%C_My)) then + LB(1:5) = lbound(SrcAeroTableData%C_My) + UB(1:5) = ubound(SrcAeroTableData%C_My) + if (.not. allocated(DstAeroTableData%C_My)) then + allocate(DstAeroTableData%C_My(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstAeroTableData%C_My.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstAeroTableData%C_My = SrcAeroTableData%C_My + end if + if (allocated(SrcAeroTableData%C_Mz)) then + LB(1:5) = lbound(SrcAeroTableData%C_Mz) + UB(1:5) = ubound(SrcAeroTableData%C_Mz) + if (.not. allocated(DstAeroTableData%C_Mz)) then + allocate(DstAeroTableData%C_Mz(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstAeroTableData%C_Mz.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstAeroTableData%C_Mz = SrcAeroTableData%C_Mz + end if +end subroutine + +subroutine ADsk_DestroyAeroTable(AeroTableData, ErrStat, ErrMsg) + type(ADsk_AeroTable), intent(inout) :: AeroTableData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'ADsk_DestroyAeroTable' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(AeroTableData%TSR)) then + deallocate(AeroTableData%TSR) + end if + if (allocated(AeroTableData%RtSpd)) then + deallocate(AeroTableData%RtSpd) + end if + if (allocated(AeroTableData%VRel)) then + deallocate(AeroTableData%VRel) + end if + if (allocated(AeroTableData%Pitch)) then + deallocate(AeroTableData%Pitch) + end if + if (allocated(AeroTableData%Skew)) then + deallocate(AeroTableData%Skew) + end if + if (allocated(AeroTableData%C_Fx)) then + deallocate(AeroTableData%C_Fx) + end if + if (allocated(AeroTableData%C_Fy)) then + deallocate(AeroTableData%C_Fy) + end if + if (allocated(AeroTableData%C_Fz)) then + deallocate(AeroTableData%C_Fz) + end if + if (allocated(AeroTableData%C_Mx)) then + deallocate(AeroTableData%C_Mx) + end if + if (allocated(AeroTableData%C_My)) then + deallocate(AeroTableData%C_My) + end if + if (allocated(AeroTableData%C_Mz)) then + deallocate(AeroTableData%C_Mz) + end if +end subroutine + +subroutine ADsk_PackAeroTable(RF, Indata) + type(RegFile), intent(inout) :: RF + type(ADsk_AeroTable), intent(in) :: InData + character(*), parameter :: RoutineName = 'ADsk_PackAeroTable' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%N_TSR) + call RegPack(RF, InData%N_RtSpd) + call RegPack(RF, InData%N_VRel) + call RegPack(RF, InData%N_Pitch) + call RegPack(RF, InData%N_Skew) + call RegPackAlloc(RF, InData%TSR) + call RegPackAlloc(RF, InData%RtSpd) + call RegPackAlloc(RF, InData%VRel) + call RegPackAlloc(RF, InData%Pitch) + call RegPackAlloc(RF, InData%Skew) + call RegPackAlloc(RF, InData%C_Fx) + call RegPackAlloc(RF, InData%C_Fy) + call RegPackAlloc(RF, InData%C_Fz) + call RegPackAlloc(RF, InData%C_Mx) + call RegPackAlloc(RF, InData%C_My) + call RegPackAlloc(RF, InData%C_Mz) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ADsk_UnPackAeroTable(RF, OutData) + type(RegFile), intent(inout) :: RF + type(ADsk_AeroTable), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ADsk_UnPackAeroTable' + integer(B4Ki) :: LB(5), UB(5) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%N_TSR); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%N_RtSpd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%N_VRel); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%N_Pitch); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%N_Skew); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TSR); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%RtSpd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%VRel); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Pitch); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Skew); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%C_Fx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%C_Fy); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%C_Fz); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%C_Mx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%C_My); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%C_Mz); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ADsk_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg) + type(ADsk_InputFile), intent(in) :: SrcInputFileData + type(ADsk_InputFile), intent(inout) :: DstInputFileData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ADsk_CopyInputFile' + ErrStat = ErrID_None + ErrMsg = '' + DstInputFileData%Echo = SrcInputFileData%Echo + DstInputFileData%DT = SrcInputFileData%DT + DstInputFileData%AirDens = SrcInputFileData%AirDens + DstInputFileData%RotorRad = SrcInputFileData%RotorRad + DstInputFileData%SumPrint = SrcInputFileData%SumPrint + DstInputFileData%NumOuts = SrcInputFileData%NumOuts + if (allocated(SrcInputFileData%OutList)) then + LB(1:1) = lbound(SrcInputFileData%OutList) + UB(1:1) = ubound(SrcInputFileData%OutList) + if (.not. allocated(DstInputFileData%OutList)) then + allocate(DstInputFileData%OutList(LB(1):UB(1)), 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 + end if + call ADsk_CopyAeroTable(SrcInputFileData%AeroTable, DstInputFileData%AeroTable, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine ADsk_DestroyInputFile(InputFileData, ErrStat, ErrMsg) + type(ADsk_InputFile), intent(inout) :: InputFileData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ADsk_DestroyInputFile' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InputFileData%OutList)) then + deallocate(InputFileData%OutList) + end if + call ADsk_DestroyAeroTable(InputFileData%AeroTable, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine ADsk_PackInputFile(RF, Indata) + type(RegFile), intent(inout) :: RF + type(ADsk_InputFile), intent(in) :: InData + character(*), parameter :: RoutineName = 'ADsk_PackInputFile' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%Echo) + call RegPack(RF, InData%DT) + call RegPack(RF, InData%AirDens) + call RegPack(RF, InData%RotorRad) + call RegPack(RF, InData%SumPrint) + call RegPack(RF, InData%NumOuts) + call RegPackAlloc(RF, InData%OutList) + call ADsk_PackAeroTable(RF, InData%AeroTable) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ADsk_UnPackInputFile(RF, OutData) + type(RegFile), intent(inout) :: RF + type(ADsk_InputFile), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ADsk_UnPackInputFile' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%Echo); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AirDens); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RotorRad); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SumPrint); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumOuts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%OutList); if (RegCheckErr(RF, RoutineName)) return + call ADsk_UnpackAeroTable(RF, OutData%AeroTable) ! AeroTable +end subroutine + +subroutine ADsk_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) + type(ADsk_InitInputType), intent(in) :: SrcInitInputData + type(ADsk_InitInputType), intent(inout) :: DstInitInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ADsk_CopyInitInput' + ErrStat = ErrID_None + ErrMsg = '' + DstInitInputData%InputFile = SrcInitInputData%InputFile + DstInitInputData%RootName = SrcInitInputData%RootName + DstInitInputData%RotorRad = SrcInitInputData%RotorRad + DstInitInputData%HubPosition = SrcInitInputData%HubPosition + DstInitInputData%HubOrientation = SrcInitInputData%HubOrientation + DstInitInputData%defAirDens = SrcInitInputData%defAirDens + DstInitInputData%Linearize = SrcInitInputData%Linearize + DstInitInputData%UseInputFile = SrcInitInputData%UseInputFile + call NWTC_Library_CopyFileInfoType(SrcInitInputData%PassedFileData, DstInitInputData%PassedFileData, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstInitInputData%FlowField => SrcInitInputData%FlowField +end subroutine + +subroutine ADsk_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(ADsk_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ADsk_DestroyInitInput' + ErrStat = ErrID_None + ErrMsg = '' + call NWTC_Library_DestroyFileInfoType(InitInputData%PassedFileData, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + nullify(InitInputData%FlowField) +end subroutine + +subroutine ADsk_PackInitInput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(ADsk_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ADsk_PackInitInput' + logical :: PtrInIndex + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%InputFile) + call RegPack(RF, InData%RootName) + call RegPack(RF, InData%RotorRad) + call RegPack(RF, InData%HubPosition) + call RegPack(RF, InData%HubOrientation) + call RegPack(RF, InData%defAirDens) + call RegPack(RF, InData%Linearize) + call RegPack(RF, InData%UseInputFile) + call NWTC_Library_PackFileInfoType(RF, InData%PassedFileData) + call RegPack(RF, associated(InData%FlowField)) + if (associated(InData%FlowField)) then + call RegPackPointer(RF, c_loc(InData%FlowField), PtrInIndex) + if (.not. PtrInIndex) then + call IfW_FlowField_PackFlowFieldType(RF, InData%FlowField) + end if + end if + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ADsk_UnPackInitInput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(ADsk_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ADsk_UnPackInitInput' + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(B8Ki) :: PtrIdx + type(c_ptr) :: Ptr + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%InputFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RootName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RotorRad); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HubPosition); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HubOrientation); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%defAirDens); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Linearize); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UseInputFile); if (RegCheckErr(RF, RoutineName)) return + call NWTC_Library_UnpackFileInfoType(RF, OutData%PassedFileData) ! PassedFileData + if (associated(OutData%FlowField)) deallocate(OutData%FlowField) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackPointer(RF, Ptr, PtrIdx); if (RegCheckErr(RF, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%FlowField) + else + allocate(OutData%FlowField,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FlowField.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + RF%Pointers(PtrIdx) = c_loc(OutData%FlowField) + call IfW_FlowField_UnpackFlowFieldType(RF, OutData%FlowField) ! FlowField + end if + else + OutData%FlowField => null() + end if +end subroutine + +subroutine ADsk_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) + type(ADsk_InitOutputType), intent(in) :: SrcInitOutputData + type(ADsk_InitOutputType), intent(inout) :: DstInitOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ADsk_CopyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcInitOutputData%WriteOutputHdr)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) + if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then + allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitOutputData%WriteOutputUnt)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) + if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then + allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), 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 + end if + call NWTC_Library_CopyProgDesc(SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstInitOutputData%AirDens = SrcInitOutputData%AirDens +end subroutine + +subroutine ADsk_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(ADsk_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ADsk_DestroyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InitOutputData%WriteOutputHdr)) then + deallocate(InitOutputData%WriteOutputHdr) + end if + if (allocated(InitOutputData%WriteOutputUnt)) then + deallocate(InitOutputData%WriteOutputUnt) + end if + call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine ADsk_PackInitOutput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(ADsk_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ADsk_PackInitOutput' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%WriteOutputHdr) + call RegPackAlloc(RF, InData%WriteOutputUnt) + call NWTC_Library_PackProgDesc(RF, InData%Ver) + call RegPack(RF, InData%AirDens) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ADsk_UnPackInitOutput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(ADsk_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ADsk_UnPackInitOutput' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%WriteOutputHdr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WriteOutputUnt); if (RegCheckErr(RF, RoutineName)) return + call NWTC_Library_UnpackProgDesc(RF, OutData%Ver) ! Ver + call RegUnpack(RF, OutData%AirDens); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ADsk_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) + type(ADsk_InputType), intent(inout) :: SrcInputData + type(ADsk_InputType), intent(inout) :: DstInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ADsk_CopyInput' + ErrStat = ErrID_None + ErrMsg = '' + call MeshCopy(SrcInputData%HubMotion, DstInputData%HubMotion, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstInputData%RotSpeed = SrcInputData%RotSpeed + DstInputData%BlPitch = SrcInputData%BlPitch +end subroutine + +subroutine ADsk_DestroyInput(InputData, ErrStat, ErrMsg) + type(ADsk_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ADsk_DestroyInput' + ErrStat = ErrID_None + ErrMsg = '' + call MeshDestroy( InputData%HubMotion, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine ADsk_PackInput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(ADsk_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ADsk_PackInput' + if (RF%ErrStat >= AbortErrLev) return + call MeshPack(RF, InData%HubMotion) + call RegPack(RF, InData%RotSpeed) + call RegPack(RF, InData%BlPitch) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ADsk_UnPackInput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(ADsk_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ADsk_UnPackInput' + if (RF%ErrStat /= ErrID_None) return + call MeshUnpack(RF, OutData%HubMotion) ! HubMotion + call RegUnpack(RF, OutData%RotSpeed); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BlPitch); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ADsk_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(ADsk_OutputType), intent(inout) :: SrcOutputData + type(ADsk_OutputType), intent(inout) :: DstOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ADsk_CopyOutput' + ErrStat = ErrID_None + ErrMsg = '' + call MeshCopy(SrcOutputData%AeroLoads, DstOutputData%AeroLoads, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstOutputData%YawErr = SrcOutputData%YawErr + DstOutputData%PsiSkew = SrcOutputData%PsiSkew + DstOutputData%ChiSkew = SrcOutputData%ChiSkew + DstOutputData%VRel = SrcOutputData%VRel + DstOutputData%Ct = SrcOutputData%Ct + DstOutputData%Cq = SrcOutputData%Cq + if (allocated(SrcOutputData%WriteOutput)) then + LB(1:1) = lbound(SrcOutputData%WriteOutput) + UB(1:1) = ubound(SrcOutputData%WriteOutput) + if (.not. allocated(DstOutputData%WriteOutput)) then + allocate(DstOutputData%WriteOutput(LB(1):UB(1)), 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 + end if +end subroutine + +subroutine ADsk_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(ADsk_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ADsk_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' + call MeshDestroy( OutputData%AeroLoads, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(OutputData%WriteOutput)) then + deallocate(OutputData%WriteOutput) + end if +end subroutine + +subroutine ADsk_PackOutput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(ADsk_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ADsk_PackOutput' + if (RF%ErrStat >= AbortErrLev) return + call MeshPack(RF, InData%AeroLoads) + call RegPack(RF, InData%YawErr) + call RegPack(RF, InData%PsiSkew) + call RegPack(RF, InData%ChiSkew) + call RegPack(RF, InData%VRel) + call RegPack(RF, InData%Ct) + call RegPack(RF, InData%Cq) + call RegPackAlloc(RF, InData%WriteOutput) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ADsk_UnPackOutput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(ADsk_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ADsk_UnPackOutput' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call MeshUnpack(RF, OutData%AeroLoads) ! AeroLoads + call RegUnpack(RF, OutData%YawErr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PsiSkew); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ChiSkew); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VRel); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Ct); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Cq); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WriteOutput); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ADsk_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) + type(ADsk_ContinuousStateType), intent(in) :: SrcContStateData + type(ADsk_ContinuousStateType), intent(inout) :: DstContStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'ADsk_CopyContState' + ErrStat = ErrID_None + ErrMsg = '' + DstContStateData%DummyContState = SrcContStateData%DummyContState +end subroutine + +subroutine ADsk_DestroyContState(ContStateData, ErrStat, ErrMsg) + type(ADsk_ContinuousStateType), intent(inout) :: ContStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'ADsk_DestroyContState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine ADsk_PackContState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(ADsk_ContinuousStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ADsk_PackContState' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyContState) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ADsk_UnPackContState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(ADsk_ContinuousStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ADsk_UnPackContState' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyContState); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ADsk_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) + type(ADsk_DiscreteStateType), intent(in) :: SrcDiscStateData + type(ADsk_DiscreteStateType), intent(inout) :: DstDiscStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'ADsk_CopyDiscState' + ErrStat = ErrID_None + ErrMsg = '' + DstDiscStateData%DummyDiscreteState = SrcDiscStateData%DummyDiscreteState +end subroutine + +subroutine ADsk_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) + type(ADsk_DiscreteStateType), intent(inout) :: DiscStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'ADsk_DestroyDiscState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine ADsk_PackDiscState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(ADsk_DiscreteStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ADsk_PackDiscState' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyDiscreteState) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ADsk_UnPackDiscState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(ADsk_DiscreteStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ADsk_UnPackDiscState' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyDiscreteState); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ADsk_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) + type(ADsk_ConstraintStateType), intent(in) :: SrcConstrStateData + type(ADsk_ConstraintStateType), intent(inout) :: DstConstrStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'ADsk_CopyConstrState' + ErrStat = ErrID_None + ErrMsg = '' + DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState +end subroutine + +subroutine ADsk_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) + type(ADsk_ConstraintStateType), intent(inout) :: ConstrStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'ADsk_DestroyConstrState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine ADsk_PackConstrState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(ADsk_ConstraintStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ADsk_PackConstrState' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyConstrState) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ADsk_UnPackConstrState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(ADsk_ConstraintStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ADsk_UnPackConstrState' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyConstrState); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ADsk_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) + type(ADsk_OtherStateType), intent(in) :: SrcOtherStateData + type(ADsk_OtherStateType), intent(inout) :: DstOtherStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'ADsk_CopyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + DstOtherStateData%DummyOtherState = SrcOtherStateData%DummyOtherState +end subroutine + +subroutine ADsk_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) + type(ADsk_OtherStateType), intent(inout) :: OtherStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'ADsk_DestroyOtherState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine ADsk_PackOtherState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(ADsk_OtherStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ADsk_PackOtherState' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyOtherState) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ADsk_UnPackOtherState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(ADsk_OtherStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ADsk_UnPackOtherState' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyOtherState); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ADsk_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(ADsk_ParameterType), intent(in) :: SrcParamData + type(ADsk_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ADsk_CopyParam' + ErrStat = ErrID_None + ErrMsg = '' + DstParamData%RootName = SrcParamData%RootName + DstParamData%DT = SrcParamData%DT + DstParamData%RotorRad = SrcParamData%RotorRad + DstParamData%AirDens = SrcParamData%AirDens + DstParamData%NumOuts = SrcParamData%NumOuts + DstParamData%halfRhoA = SrcParamData%halfRhoA + call ADsk_CopyAeroTable(SrcParamData%AeroTable, DstParamData%AeroTable, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstParamData%UseTSR = SrcParamData%UseTSR + if (allocated(SrcParamData%OutParam)) then + LB(1:1) = lbound(SrcParamData%OutParam) + UB(1:1) = ubound(SrcParamData%OutParam) + if (.not. allocated(DstParamData%OutParam)) then + allocate(DstParamData%OutParam(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutParam.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyOutParmType(SrcParamData%OutParam(i1), DstParamData%OutParam(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + DstParamData%FlowField => SrcParamData%FlowField + if (allocated(SrcParamData%DiskWindPosRel)) then + LB(1:2) = lbound(SrcParamData%DiskWindPosRel) + UB(1:2) = ubound(SrcParamData%DiskWindPosRel) + if (.not. allocated(DstParamData%DiskWindPosRel)) then + allocate(DstParamData%DiskWindPosRel(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%DiskWindPosRel.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%DiskWindPosRel = SrcParamData%DiskWindPosRel + end if +end subroutine + +subroutine ADsk_DestroyParam(ParamData, ErrStat, ErrMsg) + type(ADsk_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ADsk_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' + call ADsk_DestroyAeroTable(ParamData%AeroTable, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(ParamData%OutParam)) then + LB(1:1) = lbound(ParamData%OutParam) + UB(1:1) = ubound(ParamData%OutParam) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyOutParmType(ParamData%OutParam(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%OutParam) + end if + nullify(ParamData%FlowField) + if (allocated(ParamData%DiskWindPosRel)) then + deallocate(ParamData%DiskWindPosRel) + end if +end subroutine + +subroutine ADsk_PackParam(RF, Indata) + type(RegFile), intent(inout) :: RF + type(ADsk_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ADsk_PackParam' + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + logical :: PtrInIndex + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%RootName) + call RegPack(RF, InData%DT) + call RegPack(RF, InData%RotorRad) + call RegPack(RF, InData%AirDens) + call RegPack(RF, InData%NumOuts) + call RegPack(RF, InData%halfRhoA) + call ADsk_PackAeroTable(RF, InData%AeroTable) + call RegPack(RF, InData%UseTSR) + call RegPack(RF, allocated(InData%OutParam)) + if (allocated(InData%OutParam)) then + call RegPackBounds(RF, 1, lbound(InData%OutParam), ubound(InData%OutParam)) + LB(1:1) = lbound(InData%OutParam) + UB(1:1) = ubound(InData%OutParam) + do i1 = LB(1), UB(1) + call NWTC_Library_PackOutParmType(RF, InData%OutParam(i1)) + end do + end if + call RegPack(RF, associated(InData%FlowField)) + if (associated(InData%FlowField)) then + call RegPackPointer(RF, c_loc(InData%FlowField), PtrInIndex) + if (.not. PtrInIndex) then + call IfW_FlowField_PackFlowFieldType(RF, InData%FlowField) + end if + end if + call RegPackAlloc(RF, InData%DiskWindPosRel) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ADsk_UnPackParam(RF, OutData) + type(RegFile), intent(inout) :: RF + type(ADsk_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ADsk_UnPackParam' + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(B8Ki) :: PtrIdx + type(c_ptr) :: Ptr + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%RootName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RotorRad); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AirDens); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumOuts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%halfRhoA); if (RegCheckErr(RF, RoutineName)) return + call ADsk_UnpackAeroTable(RF, OutData%AeroTable) ! AeroTable + call RegUnpack(RF, OutData%UseTSR); if (RegCheckErr(RF, RoutineName)) return + if (allocated(OutData%OutParam)) deallocate(OutData%OutParam) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%OutParam(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackOutParmType(RF, OutData%OutParam(i1)) ! OutParam + end do + end if + if (associated(OutData%FlowField)) deallocate(OutData%FlowField) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackPointer(RF, Ptr, PtrIdx); if (RegCheckErr(RF, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%FlowField) + else + allocate(OutData%FlowField,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FlowField.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + RF%Pointers(PtrIdx) = c_loc(OutData%FlowField) + call IfW_FlowField_UnpackFlowFieldType(RF, OutData%FlowField) ! FlowField + end if + else + OutData%FlowField => null() + end if + call RegUnpackAlloc(RF, OutData%DiskWindPosRel); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ADsk_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(ADsk_MiscVarType), intent(in) :: SrcMiscData + type(ADsk_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'ADsk_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + DstMiscData%idx_last = SrcMiscData%idx_last + if (allocated(SrcMiscData%AllOuts)) then + LB(1:1) = lbound(SrcMiscData%AllOuts) + UB(1:1) = ubound(SrcMiscData%AllOuts) + if (.not. allocated(DstMiscData%AllOuts)) then + allocate(DstMiscData%AllOuts(LB(1):UB(1)), 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 + end if + DstMiscData%x_hat = SrcMiscData%x_hat + DstMiscData%y_hat = SrcMiscData%y_hat + DstMiscData%z_hat = SrcMiscData%z_hat + DstMiscData%VRel = SrcMiscData%VRel + DstMiscData%VRel_xd = SrcMiscData%VRel_xd + DstMiscData%lambda = SrcMiscData%lambda + DstMiscData%Chi = SrcMiscData%Chi + DstMiscData%C_F = SrcMiscData%C_F + DstMiscData%C_M = SrcMiscData%C_M + DstMiscData%Force = SrcMiscData%Force + DstMiscData%Moment = SrcMiscData%Moment + if (allocated(SrcMiscData%DiskWindPosAbs)) then + LB(1:2) = lbound(SrcMiscData%DiskWindPosAbs) + UB(1:2) = ubound(SrcMiscData%DiskWindPosAbs) + if (.not. allocated(DstMiscData%DiskWindPosAbs)) then + allocate(DstMiscData%DiskWindPosAbs(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%DiskWindPosAbs.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%DiskWindPosAbs = SrcMiscData%DiskWindPosAbs + end if + if (allocated(SrcMiscData%DiskWindVel)) then + LB(1:2) = lbound(SrcMiscData%DiskWindVel) + UB(1:2) = ubound(SrcMiscData%DiskWindVel) + if (.not. allocated(DstMiscData%DiskWindVel)) then + allocate(DstMiscData%DiskWindVel(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%DiskWindVel.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%DiskWindVel = SrcMiscData%DiskWindVel + end if + DstMiscData%DiskAvgVel = SrcMiscData%DiskAvgVel +end subroutine + +subroutine ADsk_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(ADsk_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'ADsk_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(MiscData%AllOuts)) then + deallocate(MiscData%AllOuts) + end if + if (allocated(MiscData%DiskWindPosAbs)) then + deallocate(MiscData%DiskWindPosAbs) + end if + if (allocated(MiscData%DiskWindVel)) then + deallocate(MiscData%DiskWindVel) + end if +end subroutine + +subroutine ADsk_PackMisc(RF, Indata) + type(RegFile), intent(inout) :: RF + type(ADsk_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ADsk_PackMisc' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%idx_last) + call RegPackAlloc(RF, InData%AllOuts) + call RegPack(RF, InData%x_hat) + call RegPack(RF, InData%y_hat) + call RegPack(RF, InData%z_hat) + call RegPack(RF, InData%VRel) + call RegPack(RF, InData%VRel_xd) + call RegPack(RF, InData%lambda) + call RegPack(RF, InData%Chi) + call RegPack(RF, InData%C_F) + call RegPack(RF, InData%C_M) + call RegPack(RF, InData%Force) + call RegPack(RF, InData%Moment) + call RegPackAlloc(RF, InData%DiskWindPosAbs) + call RegPackAlloc(RF, InData%DiskWindVel) + call RegPack(RF, InData%DiskAvgVel) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ADsk_UnPackMisc(RF, OutData) + type(RegFile), intent(inout) :: RF + type(ADsk_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ADsk_UnPackMisc' + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%idx_last); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AllOuts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%x_hat); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%y_hat); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%z_hat); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VRel); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VRel_xd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%lambda); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Chi); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%C_F); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%C_M); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Force); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Moment); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%DiskWindPosAbs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%DiskWindVel); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DiskAvgVel); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ADsk_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(ADsk_InputType), intent(inout) :: u(:) ! Input at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Inputs + type(ADsk_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 = 'ADsk_Input_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(u)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(u)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(u) - 1 + select case (order) + case (0) + call ADsk_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call ADsk_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call ADsk_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(u) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE ADsk_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(ADsk_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 + TYPE(ADsk_InputType), INTENT(INOUT) :: u2 ! Input at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs + TYPE(ADsk_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 = 'ADsk_Input_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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 + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + CALL MeshExtrapInterp1(u1%HubMotion, u2%HubMotion, tin, u_out%HubMotion, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + u_out%RotSpeed = a1*u1%RotSpeed + a2*u2%RotSpeed + CALL Angles_ExtrapInterp( u1%BlPitch, u2%BlPitch, tin, u_out%BlPitch, tin_out ) +END SUBROUTINE + +SUBROUTINE ADsk_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(ADsk_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 > t3 + TYPE(ADsk_InputType), INTENT(INOUT) :: u2 ! Input at t2 > t3 + TYPE(ADsk_InputType), INTENT(INOUT) :: u3 ! Input at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs + TYPE(ADsk_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) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'ADsk_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 + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + CALL MeshExtrapInterp2(u1%HubMotion, u2%HubMotion, u3%HubMotion, tin, u_out%HubMotion, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + u_out%RotSpeed = a1*u1%RotSpeed + a2*u2%RotSpeed + a3*u3%RotSpeed + CALL Angles_ExtrapInterp( u1%BlPitch, u2%BlPitch, u3%BlPitch, tin, u_out%BlPitch, tin_out ) +END SUBROUTINE + +subroutine ADsk_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(ADsk_OutputType), intent(inout) :: y(:) ! Output at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Outputs + type(ADsk_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 = 'ADsk_Output_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(y)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(y)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(y) - 1 + select case (order) + case (0) + call ADsk_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call ADsk_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call ADsk_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(y) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE ADsk_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(ADsk_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 + TYPE(ADsk_OutputType), INTENT(INOUT) :: y2 ! Output at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs + TYPE(ADsk_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 = 'ADsk_Output_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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 + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + CALL MeshExtrapInterp1(y1%AeroLoads, y2%AeroLoads, tin, y_out%AeroLoads, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + y_out%YawErr = a1*y1%YawErr + a2*y2%YawErr + y_out%PsiSkew = a1*y1%PsiSkew + a2*y2%PsiSkew + y_out%ChiSkew = a1*y1%ChiSkew + a2*y2%ChiSkew + y_out%VRel = a1*y1%VRel + a2*y2%VRel + y_out%Ct = a1*y1%Ct + a2*y2%Ct + y_out%Cq = a1*y1%Cq + a2*y2%Cq + IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + END IF ! check if allocated +END SUBROUTINE + +SUBROUTINE ADsk_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(ADsk_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 > t3 + TYPE(ADsk_OutputType), INTENT(INOUT) :: y2 ! Output at t2 > t3 + TYPE(ADsk_OutputType), INTENT(INOUT) :: y3 ! Output at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs + TYPE(ADsk_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) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'ADsk_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 + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + CALL MeshExtrapInterp2(y1%AeroLoads, y2%AeroLoads, y3%AeroLoads, tin, y_out%AeroLoads, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + y_out%YawErr = a1*y1%YawErr + a2*y2%YawErr + a3*y3%YawErr + y_out%PsiSkew = a1*y1%PsiSkew + a2*y2%PsiSkew + a3*y3%PsiSkew + y_out%ChiSkew = a1*y1%ChiSkew + a2*y2%ChiSkew + a3*y3%ChiSkew + y_out%VRel = a1*y1%VRel + a2*y2%VRel + a3*y3%VRel + y_out%Ct = a1*y1%Ct + a2*y2%Ct + a3*y3%Ct + y_out%Cq = a1*y1%Cq + a2*y2%Cq + a3*y3%Cq + IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + a3*y3%WriteOutput + END IF ! check if allocated +END SUBROUTINE +END MODULE AeroDisk_Types +!ENDOFREGISTRYGENERATEDFILE diff --git a/modules/aerodisk/src/driver/AeroDisk_Driver.f90 b/modules/aerodisk/src/driver/AeroDisk_Driver.f90 new file mode 100644 index 0000000000..92cb218add --- /dev/null +++ b/modules/aerodisk/src/driver/AeroDisk_Driver.f90 @@ -0,0 +1,415 @@ +!********************************************************************************************************************************** +!> ## AeroDisk_DriverCode: This code tests the AeroDisk module +!!.................................................................................................................................. +!! LICENSING +!! Copyright (C) 2012, 2015 National Renewable Energy Laboratory +!! +!! This file is part of AeroDisk. +!! +!! 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 AeroDisk_Driver + + USE NWTC_Library + USE VersionInfo + USE AeroDisk + USE AeroDisk_Types + USE AeroDisk_Driver_Subs + USE AeroDisk_Driver_Types + USE IfW_FLowField + + IMPLICIT NONE + + TYPE( ProgDesc ), PARAMETER :: ProgInfo = ProgDesc("ADsk_Driver","","") + INTEGER(IntKi) :: ADskDriver_Verbose = 5 ! Verbose level. 0 = none, 5 = some, 10 = lots + + + + integer(IntKi), parameter :: NumInp = 1 !< Number of inputs sent to AeroDisk_UpdateStates + + ! Program variables + real(DbKi) :: Time !< Variable for storing time, in seconds + real(DbKi) :: TimeInterval !< Interval between time steps, in seconds + real(DbKi) :: TStart !< Time to start + real(DbKi) :: TMax !< Maximum time if found by default + integer(IntKi) :: NumTSteps !< number of timesteps + logical :: TimeIntervalFound !< Interval between time steps, in seconds + real(DbKi) :: InputTime(NumInp) !< Variable for storing time associated with inputs, in seconds + real(DbKi), allocatable :: CaseTime(:) !< Timestamps for the case data + real(ReKi), allocatable :: CaseData(:,:) !< Data for the case. Corresponds to CaseTime + + type(ADsk_InitInputType) :: InitInData !< Input data for initialization + type(ADsk_InitOutputType) :: InitOutData !< Output data from initialization + + type(ADsk_ContinuousStateType) :: x !< Continuous states + type(ADsk_DiscreteStateType) :: xd !< Discrete states + type(ADsk_ConstraintStateType) :: z !< Constraint states + type(ADsk_ConstraintStateType) :: Z_residual !< Residual of the constraint state functions (Z) + type(ADsk_OtherStateType) :: OtherState !< Other states + type(ADsk_MiscVarType) :: misc !< Optimization variables + + type(ADsk_ParameterType) :: p !< Parameters + type(ADsk_InputType) :: u(NumInp) !< System inputs + type(ADsk_OutputType) :: y !< System outputs + + ! Local variables for this code + TYPE(ADskDriver_Flags) :: CLSettingsFlags ! Flags indicating which command line arguments were specified + TYPE(ADskDriver_Settings) :: CLSettings ! Command line arguments passed in + TYPE(ADskDriver_Flags) :: SettingsFlags ! Flags indicating which settings were specified (includes CL and ipt file) + TYPE(ADskDriver_Settings) :: Settings ! Driver settings + REAL(DbKi) :: Timer(1:2) ! Keep track of how long this takes to run + type(FileInfoType) :: DvrFileInfo ! Input file stored in FileInfoType structure + type(FlowFieldType), target :: FlowField ! FlowField data + + ! Data transfer + real(ReKi) :: Yaw ! Yaw angle from table + real(R8Ki) :: Force(6) + real(R8Ki) :: Displacement(6) + real(R8Ki) :: Theta(3) + real(R8Ki) :: Orientation_loc(3,3) ! orientation DCM for finding current hub orientation + + INTEGER(IntKi) :: n !< Loop counter (for time step) + integer(IntKi) :: i !< generic loop counter + integer(IntKi) :: DimIdx !< Index of current dimension + integer(IntKi) :: TmpIdx !< Index of last point accessed by dimension + INTEGER(IntKi) :: ErrStat !< Status of error message + CHARACTER(ErrMsgLen) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + CHARACTER(200) :: git_commit ! String containing the current git commit hash + TYPE(ProgDesc), PARAMETER :: version = ProgDesc( 'AeroDisk Driver', '', '' ) ! The version number of this program. + integer(IntKi) :: DvrOut + character(1024) :: OutputFileRootName + + + ! initialize library + call NWTC_Init + call DispNVD(ProgInfo) + DvrOut=-1 ! Set output unit to negative + + ! 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 '//GetNVD( version )//' a part of OpenFAST - '//TRIM(git_Commit)//NewLine//' linked with '//TRIM( GetNVD( NWTC_Ver ))//NewLine ) + + ! Start the timer + call CPU_TIME( Timer(1) ) + + ! Initialize the driver settings to their default values (same as the CL -- command line -- values) + call InitSettingsFlags( ProgInfo, CLSettings, CLSettingsFlags ) + Settings = CLSettings + SettingsFlags = CLSettingsFlags + + ! Parse the input line + call RetrieveArgs( CLSettings, CLSettingsFlags, ErrStat, ErrMsg ) + IF ( ErrStat >= AbortErrLev ) THEN + CALL ProgAbort( ErrMsg ) + ELSEIF ( ErrStat /= 0 ) THEN + CALL WrScr( NewLine//ErrMsg ) + ErrStat = ErrID_None + ENDIF + + ! Check if we are doing verbose error reporting + IF ( CLSettingsFlags%VVerbose ) ADskDriver_Verbose = 10_IntKi + IF ( CLSettingsFlags%Verbose ) ADskDriver_Verbose = 7_IntKi + + ! Verbose error reporting + IF ( ADskDriver_Verbose >= 10_IntKi ) THEN + CALL WrScr('--- Settings from the command line: ---') + CALL printSettings( CLSettingsFlags, CLSettings ) + CALL WrSCr(NewLine) + ENDIF + + ! Verbose error reporting + IF ( ADskDriver_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%ADskIptFile = CLSettingsFlags%ADskIptFile + Settings%ADskIptFileName = CLSettings%ADskIptFileName + ENDIF + + ! If the filename given was not the ADsk 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 ProcessComFile( CLSettings%DvrIptFileName, DvrFileInfo, ErrStat, ErrMsg ) + call CheckErr('') + + ! For diagnostic purposes, the following can be used to display the contents + ! of the DvrFileInfo data structure. + ! call Print_FileInfo_Struct( CU, DvrFileInfo ) ! CU is the screen -- different number on different systems. + + ! Parse the input file + CALL ParseDvrIptFile( CLSettings%DvrIptFileName, DvrFileInfo, SettingsFlags, Settings, ProgInfo, CaseTime, CaseData, ErrStat, ErrMsg ) + call CheckErr('') + + ! VVerbose error reporting + IF ( ADskDriver_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 ( ADskDriver_Verbose >= 10_IntKi ) CALL WrScr('Updating driver settings with command line arguments') + + ELSE + + ! VVerbose error reporting + IF ( ADskDriver_Verbose >= 10_IntKi ) CALL WrScr('No driver input file used. Updating driver settings with command line arguments') + + ENDIF + + ! 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 SettingsFlags%DvrIptFile is a flag indicating + ! if the driver input file read. + CALL UpdateSettingsWithCL( SettingsFlags, Settings, CLSettingsFlags, CLSettings, SettingsFlags%DvrIptFile, ErrStat, ErrMsg ) + call CheckErr('') + + ! Verbose error reporting + IF ( ADskDriver_Verbose >= 10_IntKi ) THEN + CALL WrScr(NewLine//'--- Driver settings after copying over CL settings: ---') + CALL printSettings( SettingsFlags, Settings ) + CALL WrScr(NewLine) + ENDIF + + + + !------------------------------------------ + ! Logic for timestep and total time for sim. + !------------------------------------------ + if ( SettingsFlags%TStart ) then + TStart = Settings%TStart + else + TStart = 0.0_DbKi + ! TODO: if using the input file, could start at the initial time given there (set the TStart with a "default" input option) + endif + + + + TimeIntervalFound=.true. ! If specified or default value set + ! DT - timestep. If default was specified, then calculate default level. + if ( SettingsFlags%DTdefault ) then + ! Set a value to start with (something larger than any expected DT). + TimeIntervalFound=.false. + TimeInterval=1000.0_DbKi + ! Step through all lines to get smallest DT + do n=min(2,size(CaseTime)),size(CaseTime) ! Start at 2nd point (min to avoid stepping over end for single line files) + TimeInterval=min(TimeInterval, real(CaseTime(n)-CaseTime(n-1), DbKi)) + TimeIntervalFound=.true. + enddo + if (TimeIntervalFound) then + call WrScr('Using smallest DT from data file: '//trim(Num2LStr(TimeInterval))//' seconds.') + else + call WrScr('No time timesteps found in input displacement file. Using only one timestep.') + endif + endif + + + ! TMax and NumTSteps from input file or from the value specified (specified overrides) + if ( SettingsFlags%NumTimeStepsDefault ) then + TMax = CaseTime(size(CaseTime)) + NumTSteps = ceiling( TMax / TimeInterval ) + elseif ( SettingsFlags%NumTimeSteps ) then ! Override with number of timesteps + TMax = TimeInterval * Settings%NumTimeSteps + TStart + NumTSteps = Settings%NumTimeSteps + else + NumTSteps = 1_IntKi + TMax = TimeInterval * NumTSteps + endif + + + !------------------------------------------ + ! Save wind data and set pointer + !------------------------------------------ + + call StoreWindData(FlowField,ErrStat,ErrMsg) + call CheckErr('') + + + + ! Routines called in initialization + !............................................................................................................................... + + InitInData%InputFile = Settings%ADskIptFileName + InitInData%RootName = Settings%OutRootName + InitInData%defAirDens = Settings%AirDens + InitInData%RotorRad = Settings%RotorRad + InitInData%HubPosition = (/ 0.0_ReKi, 0.0_ReKi, Settings%RotorHeight /) + ! Set to include the shafttilt, but no other settings. This is an euler angle order + Theta = (/ 0.0_R8Ki, real(Settings%ShftTilt, R8Ki), 0.0_R8Ki /) + InitInData%HubOrientation = EulerConstruct( Theta ) + InitInData%FlowField => FlowField ! pointer to wind data + + + ! Initialize the module + CALL ADsk_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 CheckErr('After Init: ') + END IF + + ! Set the output file + call GetRoot(Settings%OutRootName,OutputFileRootName) + call Dvr_InitializeOutputFile(DvrOut, InitOutData, OutputFileRootName, ErrStat, ErrMsg) + call CheckErr('Setting output file'); + + ! Destroy initialization data + CALL ADsk_DestroyInitInput( InitInData, ErrStat, ErrMsg ) + CALL ADsk_DestroyInitOutput( InitOutData, ErrStat, ErrMsg ) + + + + ! Routines called in loose coupling -- the glue code may implement this in various ways + !............................................................................................................................... + + + TmpIdx = 0_IntKi + + DO n = 0,NumTSteps + Time = n*TimeInterval+TStart + InputTime(1) = Time + + ! interpolate into the input data to get the wind info. Set this as u then run { InterpStpReal( X, Xary, Yary, indx, size) } + ! NOTE: converting CaseTime into ReKi is going to slow things down, but this is a demo driver, not a production tool, so I'm not + ! going to spend time fixing it. + + ! RotSpeed + u(1)%RotSpeed = InterpStp( real(Time,ReKi), real(CaseTime(:),ReKi), CaseData(4,:), TmpIdx, size(CaseTime) ) + ! Pitch + u(1)%BlPitch = InterpStp( real(Time,ReKi), real(CaseTime(:),ReKi), CaseData(5,:), TmpIdx, size(CaseTime) ) + ! Yaw + Yaw = InterpStp( real(Time,ReKi), real(CaseTime(:),ReKi), CaseData(6,:), TmpIdx, size(CaseTime) ) + + ! Now set the turbine orientation info -- note we don't include azimuth (code doesn't use it) + Theta = (/ 0.0_R8Ki, 0.0_R8Ki, real(Yaw,R8Ki) /) + orientation_loc = EulerConstruct(Theta) + u(1)%HubMotion%Orientation(:,:,1) = matmul(orientation_loc, u(1)%HubMotion%RefOrientation(:,:,1)) + ! No motions (rotation vel isn't used in code) + u(1)%HubMotion%TranslationDisp = 0.0_R8Ki + u(1)%HubMotion%TranslationVel = 0.0_ReKi + u(1)%HubMotion%RotationVel = 0.0_ReKi + + ! Calculate outputs at n + CALL ADsk_CalcOutput( Time, u(1), p, x, xd, z, OtherState, y, misc, ErrStat, ErrMsg ); + call CheckErr('After CalcOutput: '); + + ! There are no states to update in AeroDisk, but for completeness we add this. + ! Get state variables at next step: INPUT at step n, OUTPUT at step n + 1 + CALL ADsk_UpdateStates( Time, n, u, InputTime, p, x, xd, z, OtherState, misc, ErrStat, ErrMsg ); + call CheckErr(''); + + !call Dvr_WriteOutputLine(Time,DvrOut,p%OutFmt,y) + call Dvr_WriteOutputLine(Time,DvrOut,"ES20.12E2",y) + END DO + + + + + !............................................................................................................................... + ! Routine to terminate program execution + !............................................................................................................................... + if (DvrOut>0) close(DvrOut) + CALL ADsk_End( u(1), p, x, xd, z, OtherState, y, misc, ErrStat, ErrMsg ) + + ! Cleanup data + call Cleanup() + + IF ( ErrStat /= ErrID_None ) THEN + CALL WrScr( 'ErrorsAfter End: '//ErrMsg ) + ELSE + call WrSCr( 'AeroDisk completed' ) + END IF + + + +CONTAINS + subroutine CheckErr(Text) + character(*), intent(in) :: Text + IF ( ErrStat /= ErrID_None ) THEN ! Check if there was an error and do something about it if necessary + CALL WrScr( Text//ErrMsg ) + if ( ErrStat >= AbortErrLev ) then + call Cleanup() + call ProgEnd() + endif + END IF + end subroutine CheckErr + subroutine Cleanup() + call IfW_FlowField_DestroyFlowFieldType(FlowField,ErrStat,ErrMsg) ! ignore messages from here + end subroutine + subroutine ProgEnd() + ! Placeholder for moment + Call ProgAbort('Fatal error encountered. Ending.') + end subroutine ProgEnd + subroutine StoreWindData(FlowField,ErrStat2,ErrMsg2) + type(FlowFieldType), target, intent( out) :: FlowField + integer(IntKi), intent( out) :: ErrStat2 + character(ErrMsgLen), intent( out) :: ErrMsg2 + integer(IntKi) :: i, NumTSteps + + NumTSteps = size(CaseTime) + + ! Setup flow field + FlowField%FieldType = Uniform_FieldType + FlowField%Uniform%DataSize = NumTSteps + ! The following either fail catastrophically, or pass just fine. So no need for complex error handling. + call AllocAry(FlowField%Uniform%Time, NumTSteps, '', ErrStat2, ErrMsg2); if (ErrStat2 >= AbortErrLev) return + call AllocAry(FlowField%Uniform%VelH, NumTSteps, '', ErrStat2, ErrMsg2); if (ErrStat2 >= AbortErrLev) return + call AllocAry(FlowField%Uniform%VelV, NumTSteps, '', ErrStat2, ErrMsg2); if (ErrStat2 >= AbortErrLev) return + call AllocAry(FlowField%Uniform%VelGust, NumTSteps, '', ErrStat2, ErrMsg2); if (ErrStat2 >= AbortErrLev) return + call AllocAry(FlowField%Uniform%AngleH, NumTSteps, '', ErrStat2, ErrMsg2); if (ErrStat2 >= AbortErrLev) return + call AllocAry(FlowField%Uniform%AngleV, NumTSteps, '', ErrStat2, ErrMsg2); if (ErrStat2 >= AbortErrLev) return + call AllocAry(FlowField%Uniform%ShrH, NumTSteps, '', ErrStat2, ErrMsg2); if (ErrStat2 >= AbortErrLev) return + call AllocAry(FlowField%Uniform%ShrV, NumTSteps, '', ErrStat2, ErrMsg2); if (ErrStat2 >= AbortErrLev) return + call AllocAry(FlowField%Uniform%LinShrV, NumTSteps, '', ErrStat2, ErrMsg2); if (ErrStat2 >= AbortErrLev) return + + ! WindSpeed data + do i=1,NumTSteps + FlowField%Uniform%Time(i) = CaseTime(i) + FlowField%Uniform%VelH(i) = sqrt( CaseData(1,i)*CaseData(1,i) + CaseData(2,i)*CaseData(2,i) ) + FlowField%Uniform%AngleH(i) = atan2(CaseData(2,i),CaseData(1,i)) ! angle in horizontal plane + FlowField%Uniform%VelV(i) = CaseData(3,i) + enddo + + ! Set a few constants so calculations work + FlowField%Uniform%RefLength= 1.0_ReKi ! set this or we get a divide by zero + FlowField%Uniform%RefHeight= 1.0_ReKi ! set this or we get a divide by zero + ! Set other stuff to zero + FlowField%Uniform%ShrV = 0.0_ReKi ! no shear profile + FlowField%Uniform%VelGust = 0.0_ReKi + FlowField%Uniform%AngleV = 0.0_ReKi + FlowField%Uniform%ShrH = 0.0_ReKi + FlowField%Uniform%LinShrV = 0.0_ReKi + ! The following defaults are already set, but setting here in case somnething is later changed + FlowField%RefPosition = 0.0_ReKi + FlowField%PropagationDir = 0.0_ReKi + FlowField%VFlowAngle = 0.0_ReKi + FlowField%VelInterpCubic = .false. + FlowField%RotateWindBox = .false. + FlowField%AccFieldValid = .false. + FlowField%RotToWind = 0.0_ReKi + FlowField%RotFromWind = 0.0_ReKi + end subroutine StoreWindData +END PROGRAM AeroDisk_Driver diff --git a/modules/aerodisk/src/driver/AeroDisk_Driver_Subs.f90 b/modules/aerodisk/src/driver/AeroDisk_Driver_Subs.f90 new file mode 100644 index 0000000000..16b1ebca91 --- /dev/null +++ b/modules/aerodisk/src/driver/AeroDisk_Driver_Subs.f90 @@ -0,0 +1,797 @@ +!********************************************************************************************************************************** +! +! MODULE: AeroDisk_Driver_Subs - This module contains subroutines used by the AeroDisk Driver program +! +!********************************************************************************************************************************** +!********************************************************************************************************************************** +! LICENSING +! Copyright (C) 2024 National Renewable Energy Laboratory +! +! This file is part of AeroDisk. +! +! 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 AeroDisk_Driver_Subs + + USE NWTC_Library + USE AeroDisk_Driver_Types + IMPLICIT NONE + +! NOTE: This is loosely based on the InflowWind driver code. + +CONTAINS +!-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- +!> Print out help information +SUBROUTINE DispHelpText() + ! Statement about usage + CALL WrScr("") + CALL WrScr(" Syntax: AeroDisk_Driver [options]") + CALL WrScr("") + CALL WrScr(" where: -- Name of driver input file to use") + CALL WrScr(" options: "//SWChar//"adsk -- treat as name of AeroDisk input file") + CALL WrScr(" (no driver input file)") + CALL WrScr("") + CALL WrScr(" The following options will overwrite values in the driver input file:") + CALL WrScr(" "//SwChar//"DT[#] -- timestep ") + CALL WrScr(" "//SwChar//"TStart[#] -- start time ") + CALL WrScr(" "//SwChar//"TSteps[#] -- number of timesteps ") + CALL WrScr(" "//SwChar//"v -- verbose output ") + CALL WrScr(" "//SwChar//"vv -- very verbose output ") + CALL WrScr(" "//SwChar//"NonLinear -- only return non-linear portion of reaction force") + CALL WrScr(" "//SwChar//"help -- print this help menu and exit") + CALL WrScr("") + CALL WrScr(" Notes:") + CALL WrScr(" -- Options are not case sensitive.") + CALL WrScr("") +!FIXME: update this +END SUBROUTINE DispHelpText + + +subroutine InitSettingsFlags( ProgInfo, CLSettings, CLFlags ) + implicit none + ! Storing the arguments + type( ProgDesc ), intent(in ) :: ProgInfo + type( ADskDriver_Settings ), intent( out) :: CLSettings !< Command line arguments passed in + type( ADskDriver_Flags ), intent( out) :: CLFlags !< Flags indicating which command line arguments were specified + + ! Set some CLSettings to null/default values + CLSettings%DvrIptFileName = "" ! No input name name until set + CLSettings%ADskIptFileName = "" ! No ADsk input file name until set + CLSettings%NumTimeSteps = 0_IntKi + CLSettings%DT = 0.0_DbKi + CLSettings%TStart = 0.0_ReKi + CLSettings%ProgInfo = ProgInfo ! Driver info + + ! Set some CLFlags to null/default values + CLFlags%DvrIptFile = .FALSE. ! Driver input filename given as command line argument + CLFlags%ADskIptFile = .FALSE. ! AeroDisk input filename given as command line argument + CLFlags%TStart = .FALSE. ! specified time to start at + CLFlags%NumTimeSteps = .FALSE. ! specified a number of timesteps + CLFlags%NumTimeStepsDefault = .FALSE. ! specified 'DEFAULT' for number of timesteps + CLFlags%DT = .FALSE. ! specified a resolution in time + CLFlags%DTDefault = .FALSE. ! specified 'DEFAULT' for resolution in time + CLFlags%Verbose = .FALSE. ! Turn on verbose error reporting? + CLFlags%VVerbose = .FALSE. ! Turn on very verbose error reporting? + +end subroutine InitSettingsFlags + +!-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- +!> This subroutine retrieves the command line arguments and passes them to the +!! AeroDisk_driver_subs::parsearg routine for processing. +SUBROUTINE RetrieveArgs( CLSettings, CLFlags, ErrStat, ErrMsg ) + ! Storing the arguments + type( ADskDriver_Flags ), intent( out) :: CLFlags !< Flags indicating which command line arguments were specified + type( ADskDriver_Settings ), intent( out) :: CLSettings !< Command line arguments passed in + 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 :: adskFlag !< The -adsk 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) + + ! initialize some things + CLFlags%DvrIptFile = .FALSE. + ErrStat = ErrID_None + ErrStatTmp = ErrID_None + ErrMsg = '' + ErrMsgTmp = '' + adskFlag = .FALSE. + 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,'RetrieveArgs') + 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() + 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:), adskFlag, ErrStatTmp, ErrMsgTmp ) + CALL SetErrStat(ErrStatTmp,ErrMsgTmp,ErrStat,ErrMsg,'RetrieveArgs') + 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,'RetrieveArgs') + 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, 'RetrieveArgs' ) + RETURN + ENDIF + + ! Was the -adsk flag set? If so, the filename is the AeroDisk input file. Otherwise + ! it is the driver input file. + IF ( adskFlag ) THEN + CLSettings%ADskIptFileName = TRIM(FileName) + CLFlags%ADskIptFile = .TRUE. + call GetRoot( CLSettings%ADskIptFileName, CLSettings%OutRootName ) + CLFlags%OutRootName = .TRUE. + ELSE + CLSettings%DvrIptFileName = TRIM(FileName) + CLFlags%DvrIptFile = .TRUE. + ENDIF + + + + !------------------------------------------------------------------------------- + !------------------------------------------------------------------------------- + CONTAINS + + + !------------------------------------------------------------------------------- + !> Convert a string to a real number + FUNCTION StringToReal( StringIn, ErrStat ) + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT(IN ) :: StringIn + + REAL(ReKi) :: StringToReal + 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, adskFlagSet, ErrStat, ErrMsg ) + !-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-! + ! Parse and store the input argument ! + !-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-! + + USE NWTC_Library + USE AeroDisk_Driver_Types + USE AeroDisk_Types + + IMPLICIT NONE + + ! Storing the arguments + TYPE( ADskDriver_Flags ), INTENT(INOUT) :: CLFlags ! Flags indicating which arguments were specified + TYPE( ADskDriver_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) :: adskFlagSet ! Was the -adsk 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 + REAL(ReKi) :: TempReal ! temp variable to hold a real + + INTEGER(IntKi) :: ErrStatTmp ! Temporary error status for calls + + + + ! 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,'ParseArg') + 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,'ParseArg') + 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 ADsk input file + IF ( ThisArgUC(1:4) == "ADSK" ) THEN + adskFlagSet = .TRUE. ! More logic in the routine that calls this one to set things. + 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,'ParseArg') + ENDIF + + ENDIF + + + ! "DT[#]" + IF( ThisArgUC(1:Delim1) == "DT[" ) THEN + TempReal = StringToReal( ThisArgUC(Delim1+1:Delim2-1), ErrStat ) + IF ( ErrStat == ErrID_None ) THEN + CLFlags%Dt = .TRUE. + CLSettings%DT = abs(TempReal) + ELSE + CLFlags%Dt = .FALSE. + IF ( ErrStat == ErrID_Warn ) THEN + CALL SetErrStat(ErrStatTmp," Invalid number in option '"//SwChar//TRIM(ThisArg)//"'. Ignoring.", & + ErrStat,ErrMsg,'ParseArgs') + ELSE + CALL SetErrStat( ErrID_Fatal," Something failed in parsing option '"//SwChar//TRIM(ThisArg)//"'.", & + ErrStat, ErrMsg, 'ParseArg') + ENDIF + RETURN + ENDIF + + + ! "TSTEPS[#]" + ELSEIF( ThisArgUC(1:Delim1) == "TSTEPS[" ) THEN + TempReal = StringToReal( ThisArgUC(Delim1+1:Delim2-1), ErrStat ) + IF ( ErrStat == ErrID_None ) THEN + CLFlags%NumTimeSteps = .TRUE. + CLSettings%NumTimeSteps = nint(abs(TempReal)) + ELSE + CLFlags%NumTimeSteps = .FALSE. + CLSettings%NumTimeSteps = 1_IntKi + IF ( ErrStat == ErrID_Warn ) THEN + CALL SetErrStat(ErrStatTmp," Invalid number in option '"//SwChar//TRIM(ThisArg)//"'. Ignoring.", & + ErrStat,ErrMsg,'ParseArgs') + ELSE + CALL SetErrStat( ErrID_Fatal," Something failed in parsing option '"//SwChar//TRIM(ThisArg)//"'.", & + ErrStat, ErrMsg, 'ParseArg') + ENDIF + RETURN + ENDIF + + + + ! "TSTART[#]" + ELSEIF( ThisArgUC(1:Delim1) == "TSTART[" ) THEN + TempReal = StringToReal( ThisArgUC(Delim1+1:Delim2-1), ErrStat ) + IF ( ErrStat == ErrID_None ) THEN + CLFlags%TStart = .TRUE. + CLSettings%TStart = abs(TempReal) + ELSE + CLFlags%TStart = .FALSE. + IF ( ErrStat == ErrID_Warn ) THEN + CALL SetErrStat(ErrStatTmp," Invalid number in option '"//SwChar//TRIM(ThisArg)//"'. Ignoring.", & + ErrStat,ErrMsg,'ParseArgs') + ELSE + CALL SetErrStat( ErrID_Fatal," Something failed in parsing option '"//SwChar//TRIM(ThisArg)//"'.", & + ErrStat, ErrMsg, 'ParseArg') + ENDIF + RETURN + ENDIF +!FIXME: add in the other inputs here. + + 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 ParseDvrIptFile( DvrFileName, DvrFileInfo, DvrFlags, DvrSettings, ProgInfo, CaseTime, CaseData, ErrStat, ErrMsg ) + + CHARACTER(1024), INTENT(IN ) :: DvrFileName + type(FileInfoType), INTENT(IN ) :: DvrFileInfo ! Input file stored in FileInfoType structure + TYPE(ADskDriver_Flags), INTENT(INOUT) :: DvrFlags + TYPE(ADskDriver_Settings), INTENT(INOUT) :: DvrSettings + TYPE(ProgDesc), INTENT(IN ) :: ProgInfo + real(DbKi), allocatable, intent( out) :: CaseTime(:) + real(ReKi), allocatable, intent( out) :: CaseData(:,:) + 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) :: CurLine ! Current line in parsing + INTEGER(IntKi) :: TabLines ! Number of lines in the table + integer(IntKi) :: i !< generic loop counter + real(DbKi) :: TmpDb7(7) !< temporary real array + CHARACTER(1024) :: RootName ! Root name of AeroDisk driver input file + + ! Input file echoing + LOGICAL :: EchoFileContents ! Do we echo the driver file out or not? + INTEGER(IntKi) :: UnEc ! The local unit number for this module's echo file + CHARACTER(1024) :: EchoFileName ! Name of AeroDisk driver echo file + + ! Time steps + CHARACTER(1024) :: InputChr ! Character string for timesteps and input file names (to handle DEFAULT or NONE value) + + ! Local error handling + INTEGER(IntKi) :: ios !< I/O status + INTEGER(IntKi) :: ErrStatTmp !< Temporary error status for calls + CHARACTER(1024) :: ErrMsgTmp !< Temporary error messages for calls + + + ! Initialize the echo file unit to -1 which is the default to prevent echoing, we will alter this based on user input + UnEc = -1 + + call GetRoot( DvrFileName, RootName ) + + !====== General ==================================================================================== + CurLine = 4 ! Skip the first three lines as they are known to be header lines and separators + call ParseVar( DvrFileInfo, CurLine, 'Echo', EchoFileContents, ErrStatTmp, ErrMsgTmp ) + if (Failed()) return; + + if ( EchoFileContents ) then + CALL OpenEcho ( UnEc, TRIM(RootName)//'.ech', ErrStatTmp, ErrMsgTmp ) + if (Failed()) return; + WRITE(UnEc, '(A)') 'Echo file for AeroDisk driver input file: '//trim(DvrFileName) + ! Write the first three lines into the echo file + WRITE(UnEc, '(A)') DvrFileInfo%Lines(1) + WRITE(UnEc, '(A)') DvrFileInfo%Lines(2) + WRITE(UnEc, '(A)') DvrFileInfo%Lines(3) + + CurLine = 4 + call ParseVar( DvrFileInfo, CurLine, 'Echo', EchoFileContents, ErrStatTmp, ErrMsgTmp, UnEc ) + if (Failed()) return + endif + + !====== Primary file and rootname ================================================================== + if ( EchoFileContents ) WRITE(UnEc, '(A)') DvrFileInfo%Lines(CurLine) ! Write section break to echo + CurLine = CurLine + 1 + + ! AeroDisk input file + call ParseVar( DvrFileInfo, CurLine, "ADskIptFile", DvrSettings%ADskIptFileName, ErrStatTmp, ErrMsgTmp, UnEc ) + if (Failed()) return + DvrFlags%ADskIptFile = .TRUE. + + ! AeroDisk output root name + call ParseVar( DvrFileInfo, CurLine, "OutRootName", DvrSettings%OutRootName, ErrStatTmp, ErrMsgTmp, UnEc ) + if (Failed()) return + DvrFlags%OutRootName = .TRUE. + + + !====== Geometry and Environment ==================================================================== + if ( EchoFileContents ) WRITE(UnEc, '(A)') DvrFileInfo%Lines(CurLine) ! Write section break to echo + CurLine = CurLine + 1 + + ! AirDens + call ParseVar( DvrFileInfo, CurLine, "AirDens", DvrSettings%AirDens, ErrStatTmp, ErrMsgTmp, UnEc ) + if (Failed()) return + DvrFlags%AirDens = .TRUE. + + ! RotorRad + call ParseVar( DvrFileInfo, CurLine, "RotorRad", DvrSettings%RotorRad, ErrStatTmp, ErrMsgTmp, UnEc ) + if (Failed()) return + DvrFlags%RotorRad = .TRUE. + + ! RotorHeight + call ParseVar( DvrFileInfo, CurLine, "RotorHeight", DvrSettings%RotorHeight, ErrStatTmp, ErrMsgTmp, UnEc ) + if (Failed()) return + DvrFlags%RotorHeight = .TRUE. + + ! ShftTilt + call ParseVar( DvrFileInfo, CurLine, "ShftTilt", DvrSettings%ShftTilt, ErrStatTmp, ErrMsgTmp, UnEc ) + if (Failed()) return + DvrFlags%ShftTilt = .TRUE. + + + !====== Case analysis ========== ==================================================================== + if ( EchoFileContents ) WRITE(UnEc, '(A)') DvrFileInfo%Lines(CurLine) ! Write section break to echo + CurLine = CurLine + 1 + + ! TStart -- start time + call ParseVar( DvrFileInfo, CurLine, "TStart", DvrSettings%TStart, ErrStatTmp, ErrMsgTmp, UnEc ) + if (Failed()) return + DvrFlags%TStart = .TRUE. + + + ! DT -- Timestep size for the driver to take (or DEFAULT for what the file contains) + call ParseVar( DvrFileInfo, CurLine, "DT", InputChr, ErrStatTmp, ErrMsgTmp, UnEc ) + if (Failed()) return + + ! Check if we asked for the DEFAULT (use what is in the file) + CALL Conv2UC( InputChr ) + IF ( TRIM(InputChr) == '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 (InputChr,*,IOSTAT=IOS) DvrSettings%DT + IF ( IOS /= 0 ) THEN ! problem in the read, so parse the error. + CALL CheckIOS ( IOS, '', 'DT',NumType, ErrStatTmp, ErrMsgTmp ) + if (Failed()) return + ELSE ! Was ok, so set the flags + DvrFlags%DT = .TRUE. + DvrFlags%DTDefault = .FALSE. + ENDIF + ENDIF + + + ! Number of timesteps + call ParseVar( DvrFileInfo, CurLine, "NumTimeSteps", InputChr, ErrStatTmp, ErrMsgTmp, UnEc ) + if (Failed()) return + + ! Check if we asked for the DEFAULT (use what is in the file) + CALL Conv2UC( InputChr ) + IF ( TRIM(InputChr) == 'DEFAULT' ) THEN ! we asked for the default value + DvrFlags%NumTimeSteps = .FALSE. + DvrFlags%NumTimeStepsDefault = .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 (InputChr,*,IOSTAT=IOS) DvrSettings%NumTimeSteps + IF ( IOS /= 0 ) THEN ! problem in the read, so parse the error. + CALL CheckIOS ( IOS, '', 'NumTimeSteps',NumType, ErrStatTmp, ErrMsgTmp ) + if (Failed()) return + ELSE ! Was ok, so set the flags + DvrFlags%NumTimeSteps = .TRUE. + DvrFlags%NumTimeStepsDefault = .FALSE. + ENDIF + ENDIF + + + ! Column headers + if ( EchoFileContents ) WRITE(UnEc, '(A)') DvrFileInfo%Lines(CurLine) + CurLine = CurLine + 1 + if ( EchoFileContents ) WRITE(UnEc, '(A)') DvrFileInfo%Lines(CurLine) + CurLine = CurLine + 1 + + + ! Last line of table is assumed to be last line in file (or included file) + TabLines = DvrFileInfo%NumLines - CurLine + 1 + call AllocAry( CaseTime, TabLines, 'CaseTime', ErrStatTmp, ErrMsgTmp ); if (Failed()) return; + call AllocAry( CaseData, 6, TabLines, 'CaseData', ErrStatTmp, ErrMsgTmp ); if (Failed()) return; + do i=1,Tablines + call ParseAry ( DvrFileInfo, CurLine, 'Coordinates', TmpDb7, 7, ErrStatTmp, ErrMsgTmp, UnEc ) + if (Failed()) return; + ! Set Time_(s) + CaseTime(i) = TmpDb7(1) + ! Set time, wind_x, wind_y, wind_z + CaseData(1:3,i) = real(TmpDb7(2:4),ReKi) + ! Set RotSpeed (rpm -> rad/s) + CaseData(4,i) = real(TmpDb7(5),ReKi) * Pi / 30.0_ReKi + ! Set Pitch (deg -> rad) + CaseData(5,i) = real(TmpDb7(6),ReKi) * D2R + ! Set Yaw (deg -> rad) + CaseData(6,i) = real(TmpDb7(7),ReKi) * D2R + enddo + + + ! Close the echo and input file + CALL CleanupEchoFile( EchoFileContents, UnEc ) + + +CONTAINS + + !> Set error status, close stuff, and return + logical function Failed() + CALL SetErrStat(ErrStatTmp,ErrMsgTmp,ErrStat,ErrMsg,'ParseDvrIptFile') + if (ErrStat >= AbortErrLev) then + CALL CleanupEchoFile( EchoFileContents, UnEc ) + endif + Failed = ErrStat >= AbortErrLev + end function Failed + + !> Clean up the module echo file + 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 ParseDvrIptFile + + +!> 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(ADskDriver_Flags), INTENT(INOUT) :: DvrFlags + TYPE(ADskDriver_Settings), INTENT(INOUT) :: DvrSettings + TYPE(ADskDriver_Flags), INTENT(IN ) :: CLFlags + TYPE(ADskDriver_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 + LOGICAL :: WindGridModify !< Did we modify any of the WindGrid related settings? + character(*), parameter :: RoutineName = 'UpdateSettingsWithCL' + + ! Initialization + WindGridModify = .FALSE. + + ! Initialize the error handling + ErrStat = ErrID_None + ErrMsg = '' + ErrStatTmp = ErrID_None + ErrMsgTmp = '' + + + !-------------------------------------------- + ! Did we change any time information? + !-------------------------------------------- + + ! Check TStart + IF ( CLFlags%TStart ) THEN + IF ( DvrFlags%TStart .AND. ( .NOT. EqualRealNos(DvrSettings%TStart, CLSettings%TStart) ) ) THEN + CALL SetErrStat( ErrID_Warn, ' Overriding driver input value for TStart with '//TRIM(Num2LStr(CLSettings%TStart))//'.', & + ErrStat,ErrMsg,RoutineName) + ELSE + DvrFlags%TStart = .TRUE. + ENDIF + DvrSettings%TStart = CLSettings%TStart + ENDIF + + ! 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 + DvrFlags%DTDefault = .FALSE. + ENDIF + + ! Check NumTimeSteps + IF ( CLFlags%NumTimeSteps ) THEN + IF ( DvrFlags%NumTimeSteps .AND. ( DvrSettings%NumTimeSteps /= CLSettings%NumTimeSteps ) ) THEN + CALL SetErrStat( ErrID_Warn, ' Overriding driver input value for NumTimeSteps with '// & + TRIM(Num2LStr(CLSettings%NumTimeSteps))//'.',& + ErrStat,ErrMsg,RoutineName) + ELSE + DvrFlags%NumTimeSteps = .TRUE. + ENDIF + DvrSettings%NumTimeSteps = CLSettings%NumTimeSteps + DvrFlags%NumTimeStepsDefault = .FALSE. + ENDIF + + ! Make sure there is at least one timestep + DvrSettings%NumTimeSteps = MAX(DvrSettings%NumTimeSteps,1_IntKi) + + + !-------------------------------------------- + ! If there was no driver input file, we need to set a few things. + !-------------------------------------------- + + IF ( .NOT. DVRIPT ) THEN + + ! Do we need to set the NumTimeStepsDefault flag? + IF ( .NOT. DvrFlags%NumTimeSteps ) THEN + DvrFlags%NumTimeStepsDefault = .TRUE. + CALL SetErrStat( ErrID_Info,' The number of timesteps is not specified. Defaulting to what is in the input series file.', & + ErrStat,ErrMsg,RoutineName) + ENDIF + ENDIF + + +!FIXME: remove this after parsing rest of input file. + ! If no DT value has been set (DEFAULT requested), we need to set a default to pass into ADsk + IF ( .NOT. DvrFlags%DT ) THEN + DvrSettings%DT = 0.025_DbKi ! This value gets passed into the ADsk_Init routine, so something must be set. + ENDIF + + +END SUBROUTINE UpdateSettingsWithCL + + + +!> 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( ADskDriver_Flags ), INTENT(IN ) :: DvrFlags !< Flags indicating which settings were set + TYPE( ADskDriver_Settings ), INTENT(IN ) :: DvrSettings !< Stored settings + + CALL WrsCr(TRIM(GetNVD(DvrSettings%ProgInfo))) + CALL WrScr(' DvrIptFile: '//FLAG(DvrFlags%DvrIptFile)// ' '//TRIM(DvrSettings%DvrIptFileName)) + CALL WrScr(' ADskIptFile: '//FLAG(DvrFlags%ADskIptFile)// ' '//TRIM(DvrSettings%ADskIptFileName)) + CALL WrScr(' TStart: '//FLAG(DvrFlags%TStart)// ' '//TRIM(Num2LStr(DvrSettings%TStart))) + 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%NumTimeStepsDefault) THEN + CALL WrScr(' NumTimeSteps: '//FLAG(DvrFlags%NumTimeSteps)// ' DEFAULT') + ELSE + CALL WrScr(' NumTimeSteps: '//FLAG(DvrFlags%NumTimeSteps)// ' '//TRIM(Num2LStr(DvrSettings%NumTimeSteps))) + ENDIF + CALL WrScr(' Verbose: '//FLAG(DvrFlags%Verbose)) + CALL WrScr(' VVerbose: '//FLAG(DvrFlags%VVerbose)) + 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 + + +SUBROUTINE Dvr_InitializeOutputFile(OutUnit,IntOutput,RootName,ErrStat,ErrMsg) + integer(IntKi), intent( out):: OutUnit + type(ADsk_InitOutputType), intent(in ):: IntOutput ! Output for initialization routine + integer(IntKi), intent( out):: ErrStat ! Error status of the operation + character(*), intent( out):: ErrMsg ! Error message if ErrStat /= ErrID_None + character(*), intent(in ):: RootName + integer(IntKi) :: i + integer(IntKi) :: numOuts + integer(IntKi) :: ErrStat2 ! Temporary Error status + character(ErrMsgLen) :: ErrMsg2 ! Temporary Error message + character(*), parameter :: RoutineName = 'Dvr_InitializeOutputFile' + + ErrStat = ErrID_none + ErrMsg = "" + + CALL GetNewUnit(OutUnit,ErrStat2,ErrMsg2) + CALL OpenFOutFile ( OutUnit, trim(RootName)//'.out', ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + if (ErrStat >= AbortErrLev) return + + write (OutUnit,'(/,A)') 'Predictions were generated on '//CurDate()//' at '//CurTime()//' using '//trim(GetNVD(IntOutput%Ver)) + write (OutUnit,'()' ) !print a blank line + + numOuts = size(IntOutput%WriteOutputHdr) + !...................................................... + ! Write the names of the output parameters on one line: + !...................................................... + + write (OutUnit,'()') + write (OutUnit,'()') + write (OutUnit,'()') + + call WrFileNR ( OutUnit, 'Time' ) + + do i=1,NumOuts + call WrFileNR ( OutUnit, tab//IntOutput%WriteOutputHdr(i) ) + end do ! i + + write (OutUnit,'()') + + !...................................................... + ! Write the units of the output parameters on one line: + !...................................................... + + call WrFileNR ( OutUnit, '(s)' ) + + do i=1,NumOuts + call WrFileNR ( Outunit, tab//trim(IntOutput%WriteOutputUnt(i)) ) + end do ! i + + write (OutUnit,'()') + + +END SUBROUTINE Dvr_InitializeOutputFile + +!---------------------------------------------------------------------------------------------------------------------------------- +SUBROUTINE Dvr_WriteOutputLine(t,OutUnit, OutFmt, Output) + real(DbKi) , intent(in ) :: t ! simulation time (s) + integer(IntKi) , intent(in ) :: OutUnit ! Status of error message + character(*) , intent(in ) :: OutFmt + type(ADsk_OutputType), intent(in ) :: Output + integer(IntKi) :: errStat ! Status of error message (we're going to ignore errors in writing to the file) + character(ErrMsgLen) :: errMsg ! Error message if ErrStat /= ErrID_None + character(200) :: frmt ! A string to hold a format specifier + character(15) :: tmpStr ! temporary string to print the time output as text + + frmt = '"'//tab//'"'//trim(OutFmt) ! format for array elements from individual modules + + ! time + write( tmpStr, '(F15.6)' ) t + call WrFileNR( OutUnit, tmpStr ) + call WrNumAryFileNR ( OutUnit, Output%WriteOutput, frmt, errStat, errMsg ) + + ! write a new line (advance to the next line) + write (OutUnit,'()') +end subroutine Dvr_WriteOutputLine + + +END MODULE AeroDisk_Driver_Subs diff --git a/modules/aerodisk/src/driver/AeroDisk_Driver_Types.f90 b/modules/aerodisk/src/driver/AeroDisk_Driver_Types.f90 new file mode 100644 index 0000000000..6378703b0f --- /dev/null +++ b/modules/aerodisk/src/driver/AeroDisk_Driver_Types.f90 @@ -0,0 +1,78 @@ +!********************************************************************************************************************************** +! +! MODULE: ADsk_Driver_Types - This module contains types used by the AeroDisk Driver program to store arguments passed in +! +! The types listed here are used within the AeroDisk Driver program to store the settings. These settings are read in as +! command line arguments, then stored within these types. +! +!********************************************************************************************************************************** +! +!.................................................................................................................................. +! LICENSING +! Copyright (C) 2024 National Renewable Energy Laboratory +! +! This file is part of AeroDisk. +! +! AeroDisk 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 AeroDisk. +! If not, see . +! +!********************************************************************************************************************************** +module AeroDisk_Driver_Types + + use NWTC_Library + use AeroDisk_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 AeroDisk input file. + type :: ADskDriver_Flags + logical :: DvrIptFile = .FALSE. !< Was an input file name given on the command line? + logical :: ADskIptFile = .FALSE. !< Was an AeroDisk input file requested? + logical :: OutRootName = .FALSE. !< Was an AeroDisk output rootname + logical :: AirDens = .FALSE. !< Air density + logical :: RotorRad = .FALSE. !< rotor radius + logical :: RotorHeight = .FALSE. !< rotor height + logical :: ShftTilt = .FALSE. !< shaft tilt + logical :: TStart = .FALSE. !< specified a start time + logical :: NumTimeSteps = .FALSE. !< specified a number of timesteps to process + logical :: NumTimeStepsDefault = .FALSE. !< specified a 'DEFAULT' for number of timesteps to process + logical :: DT = .FALSE. !< specified a resolution in time + logical :: DTDefault = .FALSE. !< specified a 'DEFAULT' for the time resolution + logical :: Verbose = .FALSE. !< Verbose error reporting + logical :: VVerbose = .FALSE. !< Very Verbose error reporting + end type ADskDriver_Flags + + + ! This contains all the settings (possible passed in arguments). + type :: ADskDriver_Settings + character(1024) :: DvrIptFileName !< Driver input file name + character(1024) :: ADskIptFileName !< Filename of AeroDisk input file to read (if no driver input file) + character(1024) :: OutRootName !< Output root name + + real(ReKi) :: AirDens !< Air density (kg/m^3) + real(ReKi) :: RotorRad !< rotor radius (m) + real(ReKi) :: RotorHeight !< rotor height (m) + real(ReKi) :: ShftTilt !< shaft tilt (deg) + + real(DbKi) :: TStart !< Start time + integer(IntKi) :: NumTimeSteps !< Number of timesteps + real(DbKi) :: DT !< resolution of time + + type(ProgDesc) :: ProgInfo !< Program info + type(ProgDesc) :: ADskProgInfo !< Program info for AeroDisk + end type ADskDriver_Settings + + +end module AeroDisk_Driver_Types diff --git a/modules/aerodyn/CMakeLists.txt b/modules/aerodyn/CMakeLists.txt index 0248f647e8..3ace5a80d3 100644 --- a/modules/aerodyn/CMakeLists.txt +++ b/modules/aerodyn/CMakeLists.txt @@ -26,8 +26,20 @@ if (GENERATE_TYPES) generate_f90_types(src/FVW_Registry.txt ${CMAKE_CURRENT_LIST_DIR}/src/FVW_Types.f90) endif() +# BasicAero Library +add_library(basicaerolib STATIC + # UnsteadyAero lib + src/UnsteadyAero.f90 + src/UnsteadyAero_Types.f90 + + # AirFoil Info lib + src/AirfoilInfo.f90 + src/AirfoilInfo_Types.f90 +) +target_link_libraries(basicaerolib ifwlib nwtclibs) + # AeroDyn Library -add_library(aerodynlib +add_library(aerodynlib STATIC src/AeroDyn.f90 src/AeroDyn_IO_Params.f90 src/AeroDyn_IO.f90 @@ -46,14 +58,6 @@ add_library(aerodynlib src/AeroAcoustics_IO.f90 src/AeroAcoustics_Types.f90 - # UnsteadyAero lib - src/UnsteadyAero.f90 - src/UnsteadyAero_Types.f90 - - # AirFoil Info lib - src/AirfoilInfo.f90 - src/AirfoilInfo_Types.f90 - # FVW lib src/FVW.f90 src/FVW_IO.f90 @@ -63,19 +67,22 @@ add_library(aerodynlib src/FVW_BiotSavart.f90 src/FVW_Tests.f90 src/FVW_Types.f90 +) +target_link_libraries(aerodynlib basicaerolib nwtclibs) - # ADI lib +# ADI lib +add_library(adilib STATIC src/AeroDyn_Inflow.f90 src/AeroDyn_Inflow_Types.f90 ) -target_link_libraries(aerodynlib ifwlib nwtclibs) +target_link_libraries(adilib aerodynlib ifwlib) # AeroDyn Driver Subs Library -add_library(aerodyn_driver_subs +add_library(aerodyn_driver_subs STATIC src/AeroDyn_Driver_Subs.f90 src/AeroDyn_Driver_Types.f90 ) -target_link_libraries(aerodyn_driver_subs aerodynlib versioninfolib) +target_link_libraries(aerodyn_driver_subs adilib aerodynlib versioninfolib) # AeroDyn Driver add_executable(aerodyn_driver @@ -88,7 +95,7 @@ add_executable(unsteadyaero_driver src/UnsteadyAero_Driver.f90 src/UA_Dvr_Subs.f90 ) -target_link_libraries(unsteadyaero_driver aerodyn_driver_subs) +target_link_libraries(unsteadyaero_driver basicaerolib lindynlib versioninfolib) # AeroDyn-InflowWind c-bindings interface library add_library(aerodyn_inflow_c_binding SHARED @@ -99,7 +106,7 @@ if(APPLE OR UNIX) target_compile_definitions(aerodyn_inflow_c_binding PRIVATE IMPLICIT_DLLEXPORT) endif() -install(TARGETS aerodynlib aerodyn_driver_subs aerodyn_driver unsteadyaero_driver aerodyn_inflow_c_binding +install(TARGETS aerodynlib basicaerolib aerodyn_driver_subs aerodyn_driver unsteadyaero_driver aerodyn_inflow_c_binding adilib EXPORT "${CMAKE_PROJECT_NAME}Libraries" RUNTIME DESTINATION bin LIBRARY DESTINATION lib diff --git a/modules/aerodyn/python-lib/aerodyn_inflow_library.py b/modules/aerodyn/python-lib/aerodyn_inflow_library.py index 508d42c47a..a0cae3d526 100644 --- a/modules/aerodyn/python-lib/aerodyn_inflow_library.py +++ b/modules/aerodyn/python-lib/aerodyn_inflow_library.py @@ -2,7 +2,7 @@ # LICENSING # Copyright (C) 2021 National Renewable Energy Laboratory # -# This file is part of InflowWind. +# This file is part of AeroDyn. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. @@ -33,12 +33,11 @@ c_byte, c_int, c_double, - c_float, + c_float, c_char, c_char_p, c_wchar, c_wchar_p, - c_bool ) import numpy as np import datetime @@ -71,8 +70,8 @@ def __init__(self, library_path): self.ended = False # For error handling at end # Input file handling - self.ADinputPass = True # Assume passing of input file as a string - self.IfWinputPass = True # Assume passing of input file as a string + self.ADinputPass = 1 # Assume passing of input file as a string + self.IfWinputPass = 1 # Assume passing of input file as a string # Create buffers for class data self.abort_error_level = 4 @@ -99,13 +98,16 @@ def __init__(self, library_path): self.WtrDpth = 0.0 # Water depth (m) self.MSL2SWL = 0.0 # Offset between still-water level and mean sea level (m) [positive upward] - # flags - self.storeHHVel = False - self.transposeDCM= False + # flags + self.storeHHVel = 1 # 0=false, 1=true + self.transposeDCM= 1 # 0=false, 1=true + self.pointLoadOut= 1 # 0=false, 1=true + self.debuglevel = 0 # 0-4 levels # VTK self.WrVTK = 0 # default of no vtk output self.WrVTK_Type = 1 # default of surface meshes + self.WrVTK_DT = 0.0 # default to all self.VTKNacDim = np.array([-2.5,-2.5,0,10,5,5], dtype="float32") # default nacelle dimension for VTK surface rendering [x0,y0,z0,Lx,Ly,Lz] (m) self.VTKHubRad = 1.5 # default hub radius for VTK surface rendering @@ -126,12 +128,10 @@ def __init__(self, library_path): # number of output channels self.numChannels = 0 # Number of channels returned - # Aero calculation method -- AeroProjMod - # APM_BEM_NoSweepPitchTwist - 1 - "Original AeroDyn model where momentum balance is done in the WithoutSweepPitchTwist system" - # APM_BEM_Polar - 2 - "Use staggered polar grid for momentum balance in each annulus" - # APM_LiftingLine - 3 - "Use the blade lifting line (i.e. the structural) orientation (currently for OLAF with VAWT)" - self.AeroProjMod = 1 + # Number of turbines + self.numTurbines = 1 +#FIXME: some assumptions about a single turbine here. # Initial position of hub and blades # used for setup of AD, not used after init. self.initHubPos = np.zeros(shape=(3),dtype=c_float) @@ -151,22 +151,57 @@ def __init__(self, library_path): self.numMeshPts = 1 self.initMeshPos = np.zeros(shape=(self.numMeshPts,3),dtype=c_float ) # Nx3 array [x,y,z] self.initMeshOrient = np.zeros(shape=(self.numMeshPts,9),dtype=c_double) # Nx9 array [r11,r12,r13,r21,r22,r23,r31,r32,r33] + self.meshPtToBladeNum = np.zeros(shape=(self.numMeshPts),dtype=c_int) # Nx1 array [blade number] # OutRootName # If HD writes a file (echo, summary, or other), use this for the # root of the file name. self.outRootName = "Output_ADIlib_default" + self.outVTKdir = "" # Set to specify a directory relative to the input files (created if doesn't exist) # _initialize_routines() ------------------------------------------------------------------------------------------------------------ def _initialize_routines(self): - self.AeroDyn_Inflow_C_Init.argtypes = [ - POINTER(c_bool), # AD input file passed as string + # initialize data storage in library for multiple turbines + self.ADI_C_PreInit.argtypes = [ + POINTER(c_int), # numTurbines + POINTER(c_int), # transposeDCM + POINTER(c_int), # pointLoadOutput + POINTER(c_int), # debuglevel + POINTER(c_int), # ErrStat_C + POINTER(c_char) # ErrMsg_C + ] + self.ADI_C_PreInit.restype = c_int + + # setup one rotor + self.ADI_C_SetupRotor.argtypes = [ + POINTER(c_int), # iturb + POINTER(c_int), # isHAWT + POINTER(c_float), # Turb_RefPos + POINTER(c_float), # initHubPos + POINTER(c_double), # initHubOrient_flat + POINTER(c_float), # initNacellePos + POINTER(c_double), # initNacelleOrient_flat + POINTER(c_int), # numBlades + POINTER(c_float), # initRootPos_flat + POINTER(c_double), # initRootOrient_flat + POINTER(c_int), # numMeshPts + POINTER(c_float), # initMeshPos_flat + POINTER(c_double), # initMeshOrient_flat + POINTER(c_int), # meshPtToBladeNum + POINTER(c_int), # ErrStat_C + POINTER(c_char) # ErrMsg_C + ] + + # initialize ADI with data set by PreInit and SetupRotor + self.ADI_C_Init.argtypes = [ + POINTER(c_int), # AD input file passed as string POINTER(c_char_p), # AD input file as string POINTER(c_int), # AD input file string length - POINTER(c_bool), # IfW input file passed as string + POINTER(c_int), # IfW input file passed as string POINTER(c_char_p), # IfW input file as string POINTER(c_int), # IfW input file string length - POINTER(c_char), # OutRootName + POINTER(c_char), # OutRootName + POINTER(c_char), # OutVTKdir POINTER(c_float), # gravity POINTER(c_float), # defFldDens POINTER(c_float), # defKinVisc @@ -175,47 +210,36 @@ def _initialize_routines(self): POINTER(c_float), # defPvap POINTER(c_float), # WtrDpth POINTER(c_float), # MSL2SWL - POINTER(c_int), # AeroProjMod - POINTER(c_int), # InterpOrder + POINTER(c_int), # InterpOrder POINTER(c_double), # dt - POINTER(c_double), # tmax - POINTER(c_bool), # storeHHVel - POINTER(c_bool), # transposeDCM + POINTER(c_double), # tmax + POINTER(c_int), # storeHHVel POINTER(c_int), # WrVTK POINTER(c_int), # WrVTK_Type + POINTER(c_double), # WrVTK_DT -- 0 or negative to do every step POINTER(c_float), # VTKNacDim POINTER(c_float), # VTKHubRad POINTER(c_int), # wrOuts -- file format for writing outputs POINTER(c_double), # DT_Outs -- timestep for outputs to file - POINTER(c_float), # initHubPos - POINTER(c_double), # initHubOrient_flat - POINTER(c_float), # initNacellePos - POINTER(c_double), # initNacelleOrient_flat - POINTER(c_int), # numBlades - POINTER(c_float), # initRootPos_flat - POINTER(c_double), # initRootOrient_flat - POINTER(c_int), # numMeshPts - POINTER(c_float), # initMeshPos_flat - POINTER(c_double), # initMeshOrient_flat POINTER(c_int), # number of channels POINTER(c_char), # output channel names POINTER(c_char), # output channel units POINTER(c_int), # ErrStat_C POINTER(c_char) # ErrMsg_C ] - self.AeroDyn_Inflow_C_Init.restype = c_int + self.ADI_C_Init.restype = c_int - #self.AeroDyn_Inflow_C_ReInit.argtypes = [ - # POINTER(c_double), # t_initial + #self.ADI_C_ReInit.argtypes = [ + # POINTER(c_double), # t_initial # POINTER(c_double), # dt - # POINTER(c_double), # tmax + # POINTER(c_double), # tmax # POINTER(c_int), # ErrStat_C # POINTER(c_char) # ErrMsg_C #] - #self.AeroDyn_Inflow_C_ReInit.restype = c_int + #self.ADI_C_ReInit.restype = c_int - self.AeroDyn_Inflow_C_CalcOutput.argtypes = [ - POINTER(c_double), # Time_C + self.ADI_C_SetRotorMotion.argtypes = [ + POINTER(c_int), # iturb POINTER(c_float), # HubPos POINTER(c_double), # HubOrient_flat POINTER(c_float), # HubVel @@ -233,50 +257,117 @@ def _initialize_routines(self): POINTER(c_double), # MeshOrient_flat POINTER(c_float), # MeshVel POINTER(c_float), # MeshAcc + ] + + + self.ADI_C_GetRotorLoads.argtypes = [ + POINTER(c_int), # iturb + POINTER(c_int), # numMeshPts POINTER(c_float), # meshFrc -- mesh forces/moments in flat array of 6*numMeshPts + POINTER(c_float), # hhVel -- wind speed at hub height in flat array of 3 + POINTER(c_int), # ErrStat_C + POINTER(c_char) # ErrMsg_C + ] + self.ADI_C_GetRotorLoads.restype = c_int + + + self.ADI_C_GetDiskAvgVel.argtypes = [ + POINTER(c_int), # iturb + POINTER(c_float), # Disk average vel vector + POINTER(c_int), # ErrStat_C + POINTER(c_char) # ErrMsg_C + ] + self.ADI_C_GetDiskAvgVel.restype = c_int + + + self.ADI_C_CalcOutput.argtypes = [ + POINTER(c_double), # Time_C POINTER(c_float), # Output Channel Values POINTER(c_int), # ErrStat_C POINTER(c_char) # ErrMsg_C ] - self.AeroDyn_Inflow_C_CalcOutput.restype = c_int + self.ADI_C_CalcOutput.restype = c_int + - self.AeroDyn_Inflow_C_UpdateStates.argtypes = [ + self.ADI_C_UpdateStates.argtypes = [ POINTER(c_double), # Time_C POINTER(c_double), # TimeNext_C - POINTER(c_float), # HubPos - POINTER(c_double), # HubOrient_flat - POINTER(c_float), # HubVel - POINTER(c_float), # HubAcc - POINTER(c_float), # NacPos - POINTER(c_double), # NacOrient_flat - POINTER(c_float), # NacVel - POINTER(c_float), # NacAcc - POINTER(c_float), # RootPos - POINTER(c_double), # RootOrient_flat - POINTER(c_float), # RootVel - POINTER(c_float), # RootAcc - POINTER(c_int), # numMeshPts - POINTER(c_float), # MeshPos - POINTER(c_double), # MeshOrient_flat - POINTER(c_float), # MeshVel - POINTER(c_float), # MeshAcc POINTER(c_int), # ErrStat_C POINTER(c_char) # ErrMsg_C ] - self.AeroDyn_Inflow_C_UpdateStates.restype = c_int + self.ADI_C_UpdateStates.restype = c_int - self.AeroDyn_Inflow_C_End.argtypes = [ + self.ADI_C_End.argtypes = [ POINTER(c_int), # ErrStat_C POINTER(c_char) # ErrMsg_C ] - self.AeroDyn_Inflow_C_End.restype = c_int + self.ADI_C_End.restype = c_int + + # adi_init ------------------------------------------------------------------------------------------------------------ + def adi_preinit(self): + # Pass number of turbines over to setup arrays. + + # call ADI_C_PreInit + self.ADI_C_PreInit( + byref(c_int(self.numTurbines)), # IN: numTurbines + byref(c_int(self.transposeDCM)), # IN: transposeDCM + byref(c_int(self.pointLoadOut)), # IN: pointLoadOut + byref(c_int(self.debuglevel)), # IN: debuglevel + byref(self.error_status_c), # OUT: ErrStat_C + self.error_message_c # OUT: ErrMsg_C + ) - # aerodyn_inflow_init ------------------------------------------------------------------------------------------------------------ - def aerodyn_inflow_init(self, AD_input_string_array, IfW_input_string_array): - # some bookkeeping initialization - self._numChannels_c = c_int(0) + self.check_error() + + def adi_setuprotor(self,iturb,isHAWT,turbRefPos): + # setup one rotor with initial root/mesh info self._initNumMeshPts = self.numMeshPts self._initNumBlades = self.numBlades + _turbRefPos = (c_float * len(turbRefPos))(*turbRefPos) + + # check hub and root points for initialization + self.check_init_hubroot() + + # Check initial mesh positions + self.check_init_mesh() + + # Flatten arrays to pass + # [x2,y1,z1, x2,y2,z2 ...] + initHubPos_c = (c_float * len(self.initHubPos ))(*self.initHubPos ) + initHubOrient_c = (c_double * len(self.initHubOrient ))(*self.initHubOrient ) + initNacellePos_c = (c_float * len(self.initNacellePos ))(*self.initNacellePos ) + initNacelleOrient_c = (c_double * len(self.initNacelleOrient))(*self.initNacelleOrient) + initRootPos_flat_c = self.flatPosArr( self._initNumBlades, self.numBlades,self.initRootPos, 'RootPos') + initRootOrient_flat_c = self.flatOrientArr(self._initNumBlades, self.numBlades,self.initRootOrient, 'RootOrient') + initMeshPos_flat_c = self.flatPosArr( self._initNumMeshPts,self.numMeshPts,self.initMeshPos, 'MeshPos') + initMeshOrient_flat_c = self.flatOrientArr(self._initNumMeshPts,self.numMeshPts,self.initMeshOrient,'MeshOrient') + initMeshPtToBladeNum_flat_c = (c_int * len(self.meshPtToBladeNum))(*self.meshPtToBladeNum) + + self.ADI_C_SetupRotor( + c_int(iturb), # IN: iturb -- current turbine number + c_int(isHAWT), # IN: 1: is HAWT, 0: VAWT or cross-flow + _turbRefPos, # IN: turbine reference position + initHubPos_c, # IN: initHubPos -- initial hub position + initHubOrient_c, # IN: initHubOrient -- initial hub orientation DCM in flat array of 9 elements + initNacellePos_c, # IN: initNacellePos -- initial hub position + initNacelleOrient_c, # IN: initNacelleOrient -- initial hub orientation DCM in flat array of 9 elements + byref(c_int(self.numBlades)), # IN: number of blades (matches number of blade root positions) + initRootPos_flat_c, # IN: initBladeRootPos -- initial node positions in flat array of 3*numBlades + initRootOrient_flat_c, # IN: initBladeRootOrient -- initial blade root orientation DCMs in flat array of 9*numBlades + byref(c_int(self.numMeshPts)), # IN: number of mesh points expected + initMeshPos_flat_c, # IN: initMeshPos -- initial node positions in flat array of 3*numMeshPts + initMeshOrient_flat_c, # IN: initMeshOrient -- initial node orientation DCMs in flat array of 9*numMeshPts + initMeshPtToBladeNum_flat_c, # IN: initMeshPtToBladeNum -- initial mesh point to blade number mapping + byref(self.error_status_c), # OUT: ErrStat_C + self.error_message_c # OUT: ErrMsg_C + ) + + self.check_error() + + + def adi_init(self, AD_input_string_array, IfW_input_string_array): + # some bookkeeping initialization + self._numChannels_c = c_int(0) # Primary input file will be passed as a single string joined by # C_NULL_CHAR. @@ -292,35 +383,22 @@ def aerodyn_inflow_init(self, AD_input_string_array, IfW_input_string_array): # Rootname for ADI output files (echo etc). _outRootName_c = create_string_buffer((self.outRootName.ljust(self.default_str_c_len)).encode('utf-8')) - - # check hub and root points for initialization - self.check_init_hubroot() - - # Check initial mesh positions - self.check_init_mesh() + _outVTKdir_c = create_string_buffer((self.outVTKdir.ljust(self.default_str_c_len)).encode('utf-8')) # Flatten arrays to pass # [x2,y1,z1, x2,y2,z2 ...] VTKNacDim_c = (c_float * len(self.VTKNacDim ))(*self.VTKNacDim ) - initHubPos_c = (c_float * len(self.initHubPos ))(*self.initHubPos ) - initHubOrient_c = (c_double * len(self.initHubOrient ))(*self.initHubOrient ) - initNacellePos_c = (c_float * len(self.initNacellePos ))(*self.initNacellePos ) - initNacelleOrient_c = (c_double * len(self.initNacelleOrient))(*self.initNacelleOrient) - initRootPos_flat_c = self.flatPosArr( self._initNumBlades, self.numBlades,self.initRootPos, 'Init','RootPos') - initRootOrient_flat_c = self.flatOrientArr(self._initNumBlades, self.numBlades,self.initRootOrient, 'Init','RootOrient') - initMeshPos_flat_c = self.flatPosArr( self._initNumMeshPts,self.numMeshPts,self.initMeshPos, 'Init','MeshPos') - initMeshOrient_flat_c = self.flatOrientArr(self._initNumMeshPts,self.numMeshPts,self.initMeshOrient,'Init','MeshOrient') - - # call AeroDyn_Inflow_C_Init - self.AeroDyn_Inflow_C_Init( - byref(c_bool(self.ADinputPass)), # IN: AD input file is passed + # call ADI_C_Init + self.ADI_C_Init( + byref(c_int(self.ADinputPass)), # IN: AD input file is passed c_char_p(AD_input_string), # IN: AD input file as string (or filename if ADinputPass is false) byref(c_int(AD_input_string_length)), # IN: AD input file string length - byref(c_bool(self.IfWinputPass)), # IN: IfW input file is passed + byref(c_int(self.IfWinputPass)), # IN: IfW input file is passed c_char_p(IfW_input_string), # IN: IfW input file as string (or filename if IfWinputPass is false) byref(c_int(IfW_input_string_length)), # IN: IfW input file string length _outRootName_c, # IN: rootname for ADI file writing + _outVTKdir_c, # IN: directory for vtk output files (relative to input file) byref(c_float(self.gravity)), # IN: gravity byref(c_float(self.defFldDens)), # IN: defFldDens byref(c_float(self.defKinVisc)), # IN: defKinVisc @@ -329,28 +407,17 @@ def aerodyn_inflow_init(self, AD_input_string_array, IfW_input_string_array): byref(c_float(self.defPvap)), # IN: defPvap byref(c_float(self.WtrDpth)), # IN: WtrDpth byref(c_float(self.MSL2SWL)), # IN: MSL2SWL - byref(c_int(self.AeroProjMod)), # IN: AeroProjMod byref(c_int(self.InterpOrder)), # IN: InterpOrder (1: linear, 2: quadratic) byref(c_double(self.dt)), # IN: time step (dt) byref(c_double(self.tmax)), # IN: tmax - byref(c_bool(self.storeHHVel)), # IN: storeHHVel - byref(c_bool(self.transposeDCM)), # IN: transposeDCM + byref(c_int(self.storeHHVel)), # IN: storeHHVel byref(c_int(self.WrVTK)), # IN: WrVTK byref(c_int(self.WrVTK_Type)), # IN: WrVTK_Type + byref(c_double(self.WrVTK_DT)), # IN: WrVTK_DT VTKNacDim_c, # IN: VTKNacDim byref(c_float(self.VTKHubRad)), # IN: VTKHubRad byref(c_int(self.wrOuts)), # IN: wrOuts -- file format for writing outputs byref(c_double(self.DT_Outs)), # IN: DT_Outs -- timestep for outputs to file - initHubPos_c, # IN: initHubPos -- initial hub position - initHubOrient_c, # IN: initHubOrient -- initial hub orientation DCM in flat array of 9 elements - initNacellePos_c, # IN: initNacellePos -- initial hub position - initNacelleOrient_c, # IN: initNacelleOrient -- initial hub orientation DCM in flat array of 9 elements - byref(c_int(self.numBlades)), # IN: number of blades (matches number of blade root positions) - initRootPos_flat_c, # IN: initBladeRootPos -- initial node positions in flat array of 3*numBlades - initRootOrient_flat_c, # IN: initBladeRootOrient -- initial blade root orientation DCMs in flat array of 9*numBlades - byref(c_int(self.numMeshPts)), # IN: number of attachment points expected (where motions are transferred into HD) - initMeshPos_flat_c, # IN: initMeshPos -- initial node positions in flat array of 3*numMeshPts - initMeshOrient_flat_c, # IN: initMeshOrient -- initial node orientation DCMs in flat array of 9*numMeshPts byref(self._numChannels_c), # OUT: number of channels self._channel_names_c, # OUT: output channel names self._channel_units_c, # OUT: output channel units @@ -359,17 +426,17 @@ def aerodyn_inflow_init(self, AD_input_string_array, IfW_input_string_array): ) self.check_error() - + # Initialize output channels self.numChannels = self._numChannels_c.value - ## aerodyn_inflow_reinit ------------------------------------------------------------------------------------------------------------ - #def aerodyn_inflow_reinit(self): - # #FIXME: need to pass something in here I think. Not sure what. + ## adi_reinit ------------------------------------------------------------------------------------------------------------ + #FIXME: this routine is not setup + #def adi_reinit(self): # - # # call AeroDyn_Inflow_C_ReInit - # self.AeroDyn_Inflow_C_ReInit( + # # call ADI_C_ReInit + # self.ADI_C_ReInit( # byref(c_double(self.dt)), # IN: time step (dt) # byref(c_double(self.tmax)), # IN: tmax # byref(self.error_status_c), # OUT: ErrStat_C @@ -377,15 +444,14 @@ def aerodyn_inflow_init(self, AD_input_string_array, IfW_input_string_array): # ) # # self.check_error() - # #FIXME: anything coming out that needs handling/passing? - # aerodyn_inflow_calcOutput ------------------------------------------------------------------------------------------------------------ - def aerodyn_inflow_calcOutput(self, time, hubPos, hubOrient, hubVel, hubAcc, \ + # adi_setrotormotion ------------------------------------------------------------------------------------------------------------ + def adi_setrotormotion(self, iturb, \ + hubPos, hubOrient, hubVel, hubAcc, \ nacPos, nacOrient, nacVel, nacAcc, \ rootPos, rootOrient, rootVel, rootAcc, \ - meshPos, meshOrient, meshVel, meshAcc, \ - meshFrcMom, outputChannelValues): + meshPos, meshOrient, meshVel, meshAcc): # Check input motion info self.check_input_motions_hubNac(hubPos,hubOrient,hubVel,hubAcc,'hub') @@ -403,26 +469,19 @@ def aerodyn_inflow_calcOutput(self, time, hubPos, hubOrient, hubVel, hubAcc, \ _nacAcc_c = (c_float * len(np.squeeze(nacAcc) ))(*np.squeeze(nacAcc) ) # Make a flat 1D arrays of motion info: # [x2,y1,z1, x2,y2,z2 ...] - _rootPos_flat_c = self.flatPosArr( self._initNumBlades,self.numBlades,rootPos, time,'MeshPos') - _rootOrient_flat_c = self.flatOrientArr(self._initNumBlades,self.numBlades,rootOrient,time,'MeshOrient') - _rootVel_flat_c = self.flatVelAccArr(self._initNumBlades,self.numBlades,rootVel, time,'MeshVel') - _rootAcc_flat_c = self.flatVelAccArr(self._initNumBlades,self.numBlades,rootAcc, time,'MeshAcc') + _rootPos_flat_c = self.flatPosArr( self._initNumBlades,self.numBlades,rootPos, 'MeshPos') + _rootOrient_flat_c = self.flatOrientArr(self._initNumBlades,self.numBlades,rootOrient,'MeshOrient') + _rootVel_flat_c = self.flatVelAccArr(self._initNumBlades,self.numBlades,rootVel, 'MeshVel') + _rootAcc_flat_c = self.flatVelAccArr(self._initNumBlades,self.numBlades,rootAcc, 'MeshAcc') # Make a flat 1D arrays of motion info: # [x2,y1,z1, x2,y2,z2 ...] - _meshPos_flat_c = self.flatPosArr( self._initNumMeshPts,self.numMeshPts,meshPos, time,'MeshPos') - _meshOrient_flat_c = self.flatOrientArr(self._initNumMeshPts,self.numMeshPts,meshOrient,time,'MeshOrient') - _meshVel_flat_c = self.flatVelAccArr(self._initNumMeshPts,self.numMeshPts,meshVel, time,'MeshVel') - _meshAcc_flat_c = self.flatVelAccArr(self._initNumMeshPts,self.numMeshPts,meshAcc, time,'MeshAcc') + _meshPos_flat_c = self.flatPosArr( self._initNumMeshPts,self.numMeshPts,meshPos, 'MeshPos') + _meshOrient_flat_c = self.flatOrientArr(self._initNumMeshPts,self.numMeshPts,meshOrient,'MeshOrient') + _meshVel_flat_c = self.flatVelAccArr(self._initNumMeshPts,self.numMeshPts,meshVel, 'MeshVel') + _meshAcc_flat_c = self.flatVelAccArr(self._initNumMeshPts,self.numMeshPts,meshAcc, 'MeshAcc') - # Resulting Forces/moments -- [Fx1,Fy1,Fz1,Mx1,My1,Mz1, Fx2,Fy2,Fz2,Mx2,My2,Mz2 ...] - _meshFrc_flat_c = (c_float * (6 * self.numMeshPts))(0.0,) - - # Set up output channels - outputChannelValues_c = (c_float * self.numChannels)(0.0,) - - # Run AeroDyn_Inflow_C_CalcOutput - self.AeroDyn_Inflow_C_CalcOutput( - byref(c_double(time)), # IN: time at which to calculate output forces + self.ADI_C_SetRotorMotion( + c_int(iturb), # IN: iturb -- current turbine number _hubPos_c, # IN: hub positions _hubOrient_c, # IN: hub orientations _hubVel_c, # IN: hub velocity [TVx,TVy,TVz,RVx,RVy,RVz] @@ -440,8 +499,25 @@ def aerodyn_inflow_calcOutput(self, time, hubPos, hubOrient, hubVel, hubAcc, \ _meshOrient_flat_c, # IN: Orientations (DCM) _meshVel_flat_c, # IN: velocities at desired positions _meshAcc_flat_c, # IN: accelerations at desired positions + byref(self.error_status_c), # OUT: ErrStat_C + self.error_message_c # OUT: ErrMsg_C + ) + + self.check_error() + + + # adi_getrotorloads --------------------------------------------------------------------------------------------------------- + def adi_getrotorloads(self, iturb, meshFrcMom, hhVel=None): + # Resulting Forces/moments -- [Fx1,Fy1,Fz1,Mx1,My1,Mz1, Fx2,Fy2,Fz2,Mx2,My2,Mz2 ...] + _meshFrc_flat_c = (c_float * (6 * self.numMeshPts))(0.0,) + _hhVel_flat_c = (c_float * 3)(0.0,) + + # Run ADI_C_GetRotorLoads + self.ADI_C_GetRotorLoads( + c_int(iturb), # IN: iturb -- current turbine number + byref(c_int(self.numMeshPts)), # IN: number of attachment points expected (where motions are transferred into HD) _meshFrc_flat_c, # OUT: resulting forces/moments array - outputChannelValues_c, # OUT: output channel values as described in input file + _hhVel_flat_c, # OUT: hub height velocity [Vx, Vy, Vz] byref(self.error_status_c), # OUT: ErrStat_C self.error_message_c # OUT: ErrMsg_C ) @@ -458,81 +534,74 @@ def aerodyn_inflow_calcOutput(self, time, hubPos, hubOrient, hubVel, hubAcc, \ meshFrcMom[j,4] = _meshFrc_flat_c[count+4] meshFrcMom[j,5] = _meshFrc_flat_c[count+5] count = count + 6 - - # Convert output channel values back into python - for k in range(0,self.numChannels): - outputChannelValues[k] = float(outputChannelValues_c[k]) - # aerodyn_inflow_updateStates ------------------------------------------------------------------------------------------------------------ - def aerodyn_inflow_updateStates(self, time, timeNext, \ - hubPos, hubOrient, hubVel, hubAcc, \ - nacPos, nacOrient, nacVel, nacAcc, \ - rootPos, rootOrient, rootVel, rootAcc, \ - meshPos, meshOrient, meshVel, meshAcc): + ## Hub height wind speed + if self.storeHHVel and hhVel != None: + hhVel[0] = _hhVel_flat_c[0] + hhVel[1] = _hhVel_flat_c[1] + hhVel[2] = _hhVel_flat_c[2] - # Check input motion info - self.check_input_motions_hubNac(hubPos,hubOrient,hubVel,hubAcc,'hub') - self.check_input_motions_hubNac(nacPos,nacOrient,nacVel,nacAcc,'nacelle') - self.check_input_motions_root(rootPos,rootOrient,rootVel,rootAcc) - self.check_input_motions_mesh(meshPos,meshOrient,meshVel,meshAcc) - _hubPos_c = (c_float * len(np.squeeze(hubPos) ))(*np.squeeze(hubPos) ) - _hubOrient_c = (c_double * len(np.squeeze(hubOrient)))(*np.squeeze(hubOrient)) - _hubVel_c = (c_float * len(np.squeeze(hubVel) ))(*np.squeeze(hubVel) ) - _hubAcc_c = (c_float * len(np.squeeze(hubAcc) ))(*np.squeeze(hubAcc) ) - _nacPos_c = (c_float * len(np.squeeze(nacPos) ))(*np.squeeze(nacPos) ) - _nacOrient_c = (c_double * len(np.squeeze(nacOrient)))(*np.squeeze(nacOrient)) - _nacVel_c = (c_float * len(np.squeeze(nacVel) ))(*np.squeeze(nacVel) ) - _nacAcc_c = (c_float * len(np.squeeze(nacAcc) ))(*np.squeeze(nacAcc) ) - # Make a flat 1D arrays of motion info: - # [x2,y1,z1, x2,y2,z2 ...] - _rootPos_flat_c = self.flatPosArr( self._initNumBlades,self.numBlades,rootPos, time,'MeshPos') - _rootOrient_flat_c = self.flatOrientArr(self._initNumBlades,self.numBlades,rootOrient,time,'MeshOrient') - _rootVel_flat_c = self.flatVelAccArr(self._initNumBlades,self.numBlades,rootVel, time,'MeshVel') - _rootAcc_flat_c = self.flatVelAccArr(self._initNumBlades,self.numBlades,rootAcc, time,'MeshAcc') - # Make a flat 1D arrays of motion info: - # [x2,y1,z1, x2,y2,z2 ...] - _meshPos_flat_c = self.flatPosArr( self._initNumMeshPts,self.numMeshPts,meshPos, time,'MeshPos') - _meshOrient_flat_c = self.flatOrientArr(self._initNumMeshPts,self.numMeshPts,meshOrient,time,'MeshOrient') - _meshVel_flat_c = self.flatVelAccArr(self._initNumMeshPts,self.numMeshPts,meshVel, time,'MeshVel') - _meshAcc_flat_c = self.flatVelAccArr(self._initNumMeshPts,self.numMeshPts,meshAcc, time,'MeshAcc') + # adi_getdiskavgvel --------------------------------------------------------------------------------------------------------- + def adi_getdiskavgvel(self, iturb, diskAvgVel): + # Resulting disk average velocity [Vx,Vy,Vz] + _diskAvgVel_flat_c = (c_float * 3)(0.0,) - # Resulting Forces/moments -- [Fx1,Fy1,Fz1,Mx1,My1,Mz1, Fx2,Fy2,Fz2,Mx2,My2,Mz2 ...] - _meshFrc_flat_c = (c_float * (6 * self.numMeshPts))(0.0,) + # Run ADI_GetDiskAvgVel + self.ADI_C_GetDiskAvgVel( + c_int(iturb), # IN: iturb -- current turbine number + _diskAvgVel_flat_c, # OUT: disk average velocity [Vx, Vy, Vz] + byref(self.error_status_c), # OUT: ErrStat_C + self.error_message_c # OUT: ErrMsg_C + ) + + self.check_error() + + ## Disk average wind speed + diskAvgVel[0] = _diskAvgVel_flat_c[0] + diskAvgVel[1] = _diskAvgVel_flat_c[1] + diskAvgVel[2] = _diskAvgVel_flat_c[2] + + + # adi_calcOutput ------------------------------------------------------------------------------------------------------------ + def adi_calcOutput(self, time, outputChannelValues): + + # Set up output channels + outputChannelValues_c = (c_float * self.numChannels)(0.0,) + + # Run ADI_C_CalcOutput + self.ADI_C_CalcOutput( + byref(c_double(time)), # IN: time at which to calculate output forces + outputChannelValues_c, # OUT: output channel values as described in input file + byref(self.error_status_c), # OUT: ErrStat_C + self.error_message_c # OUT: ErrMsg_C + ) + + self.check_error() + + # Convert output channel values back into python + for k in range(0,self.numChannels): + outputChannelValues[k] = float(outputChannelValues_c[k]) + + # adi_updateStates ------------------------------------------------------------------------------------------------------------ + def adi_updateStates(self, time, timeNext): # Run AeroDyn_Inflow_UpdateStates_c - self.AeroDyn_Inflow_C_UpdateStates( - byref(c_double(time)), # IN: time at which to calculate output forces + self.ADI_C_UpdateStates( + byref(c_double(time)), # IN: time at which to calculate output forces byref(c_double(timeNext)), # IN: time T+dt we are stepping to - _hubPos_c, # IN: hub positions - _hubOrient_c, # IN: hub orientations - _hubVel_c, # IN: hub velocity [TVx,TVy,TVz,RVx,RVy,RVz] - _hubAcc_c, # IN: hub acclerations [TAx,TAy,TAz,RAx,RAy,RAz] - _nacPos_c, # IN: nac positions - _nacOrient_c, # IN: nac orientations - _nacVel_c, # IN: nac velocity [TVx,TVy,TVz,RVx,RVy,RVz] - _nacAcc_c, # IN: nac acclerations [TAx,TAy,TAz,RAx,RAy,RAz] - _rootPos_flat_c, # IN: positions - _rootOrient_flat_c, # IN: Orientations (DCM) - _rootVel_flat_c, # IN: velocities at desired positions - _rootAcc_flat_c, # IN: accelerations at desired positions - byref(c_int(self.numMeshPts)), # IN: number of attachment points expected (where motions are transferred into HD) - _meshPos_flat_c, # IN: positions - _meshOrient_flat_c, # IN: Orientations (DCM) - _meshVel_flat_c, # IN: velocities at desired positions - _meshAcc_flat_c, # IN: accelerations at desired positions byref(self.error_status_c), # OUT: ErrStat_C self.error_message_c # OUT: ErrMsg_C ) self.check_error() - # aerodyn_inflow_end ------------------------------------------------------------------------------------------------------------ - def aerodyn_inflow_end(self): + # adi_end ------------------------------------------------------------------------------------------------------------ + def adi_end(self): if not self.ended: self.ended = True - # Run AeroDyn_Inflow_C_End - self.AeroDyn_Inflow_C_End( + # Run ADI_C_End + self.ADI_C_End( byref(self.error_status_c), self.error_message_c ) @@ -547,14 +616,14 @@ def check_error(self): print(f"AeroDyn/InflowWind error status: {self.error_levels[self.error_status_c.value]}: {self.error_message_c.value.decode('ascii')}") else: print(f"AeroDyn/InflowWind error status: {self.error_levels[self.error_status_c.value]}: {self.error_message_c.value.decode('ascii')}") - self.aerodyn_inflow_end() + self.adi_end() raise Exception("\nAeroDyn/InflowWind terminated prematurely.") - def flatPosArr(self,initNumMeshPts,numPts,MeshPosArr,time,name): + def flatPosArr(self,initNumMeshPts,numPts,MeshPosArr,name): if initNumMeshPts != numPts: - print(f"At time {time}, the number of {name} points changed from initial value of {initNumMeshPts}. This is not permitted during the simulation.") - self.aerodyn_inflow_end() + print(f"The number of {name} points changed from initial value of {initNumMeshPts}. This is not permitted during the simulation.") + self.adi_end() raise Exception("\nError in calling AeroDyn/InflowWind library.") meshPos_flat = [pp for p in MeshPosArr for pp in p] meshPos_flat_c = (c_float * (3 * numPts))(0.0,) @@ -563,10 +632,10 @@ def flatPosArr(self,initNumMeshPts,numPts,MeshPosArr,time,name): return meshPos_flat_c - def flatOrientArr(self,initNumMeshPts,numPts,MeshOrientArr,time,name): + def flatOrientArr(self,initNumMeshPts,numPts,MeshOrientArr,name): if initNumMeshPts != numPts: - print(f"At time {time}, the number of {name} points changed from initial value of {initNumMeshPts}. This is not permitted during the simulation.") - self.aerodyn_inflow_end() + print(f"The number of {name} points changed from initial value of {initNumMeshPts}. This is not permitted during the simulation.") + self.adi_end() raise Exception("\nError in calling AeroDyn/InflowWind library.") meshOrient_flat = [pp for p in MeshOrientArr for pp in p] meshOrient_flat_c = (c_double * (9 * numPts))(0.0,) @@ -575,10 +644,10 @@ def flatOrientArr(self,initNumMeshPts,numPts,MeshOrientArr,time,name): return meshOrient_flat_c - def flatVelAccArr(self,initNumMeshPts,numPts,MeshArr,time,name): + def flatVelAccArr(self,initNumMeshPts,numPts,MeshArr,name): if initNumMeshPts != numPts: - print(f"At time {time}, the number of {name} points changed from initial value of {initNumMeshPts}. This is not permitted during the simulation.") - self.aerodyn_inflow_end() + print(f"The number of {name} points changed from initial value of {initNumMeshPts}. This is not permitted during the simulation.") + self.adi_end() raise Exception("\nError in calling AeroDyn/InflowWind library.") # Velocity -- [Vx2,Vy1,Vz1,RVx1,RVy1,RVz1, Vx2,Vy2,Vz2,RVx2,RVy2,RVz2 ...] meshVel_flat = [pp for p in MeshArr for pp in p] @@ -612,41 +681,41 @@ def check_init_hubroot(self): #print(" size 0 ", self.initNacelleOrient.shape[0]) if self.numBlades < 1: print("No blades. Set numBlades to number of AD blades in the model") - self.aerodyn_inflow_end() + self.adi_end() raise Exception("\nAeroDyn terminated prematurely.") if self.initRootPos.shape[1] != 3: print("Expecting a Nx3 array of blade root positions (initRootPos) with second index for [x,y,z]") - self.aerodyn_inflow_end() + self.adi_end() raise Exception("\nAeroDyn terminated prematurely.") if self.initRootPos.shape[0] != self.numBlades: print("Expecting a Nx3 array of blade root positions (initRootPos) with first index for blade number") - self.aerodyn_inflow_end() + self.adi_end() raise Exception("\nAeroDyn terminated prematurely.") if self.initRootOrient.shape[1] != 9: print("Expecting a Nx9 array of blade root orientations as DCMs (initRootOrient) with second index for [r11,r12,r13,r21,r22,r23,r31,r32,r33]") - self.aerodyn_inflow_end() + self.adi_end() raise Exception("\nAeroDyn terminated prematurely.") if self.initRootOrient.shape[0] != self.numBlades: print("Expecting a Nx3 array of blade root orientations (initRootOrient) with first index for blade number") - self.aerodyn_inflow_end() + self.adi_end() raise Exception("\nAeroDyn terminated prematurely.") if np.squeeze(self.initHubPos.ndim) > 1 or self.initHubPos.shape[0] != 3: print("Expecting a 3 element array for initHubPos [x,y,z]") - self.aerodyn_inflow_end() + self.adi_end() raise Exception("\nAeroDyn terminated prematurely.") if np.squeeze(self.initHubOrient.ndim) > 1 or self.initHubOrient.shape[0] != 9: print("Expecting a 9 element array for initHubOrient DCM [r11,r12,r13,r21,r22,r23,r31,r32,r33]") - self.aerodyn_inflow_end() + self.adi_end() raise Exception("\nAeroDyn terminated prematurely.") if np.squeeze(self.initNacellePos.ndim) > 1 or self.initNacellePos.shape[0] != 3: print("Expecting a 3 element array for initNacellePos [x,y,z]") - self.aerodyn_inflow_end() + self.adi_end() raise Exception("\nAeroDyn terminated prematurely.") if np.squeeze(self.initNacelleOrient.ndim) > 1 or self.initNacelleOrient.shape[0] != 9: print("Expecting a 9 element array for initNacelleOrient DCM [r11,r12,r13,r21,r22,r23,r31,r32,r33]") - self.aerodyn_inflow_end() + self.adi_end() raise Exception("\nAeroDyn terminated prematurely.") - + def check_init_mesh(self): #print("shape of initMeshPos ", self.initMeshPos.shape) @@ -660,23 +729,23 @@ def check_init_mesh(self): # Verify that the shape of initMeshPos is correct if self.initMeshPos.shape[0] != self.initMeshOrient.shape[0]: print("Different number of meshs in inital position and orientation arrays") - self.aerodyn_inflow_end() + self.adi_end() raise Exception("\nAeroDyn terminated prematurely.") if self.initMeshPos.shape[1] != 3: print("Expecting a Nx3 array of initial mesh positions (initMeshPos) with second index for [x,y,z]") - self.aerodyn_inflow_end() + self.adi_end() raise Exception("\nAeroDyn terminated prematurely.") if self.initMeshPos.shape[0] != self.numMeshPts: print("Expecting a Nx3 array of initial mesh positions (initMeshPos) with first index for mesh number.") - self.aerodyn_inflow_end() + self.adi_end() raise Exception("\nAeroDyn terminated prematurely.") if self.initMeshOrient.shape[1] != 9: print("Expecting a Nx9 array of initial mesh orientations as DCMs (initMeshOrient) with second index for [r11,r12,r13,r21,r22,r23,r31,r32,r33]") - self.aerodyn_inflow_end() + self.adi_end() raise Exception("\nAeroDyn terminated prematurely.") if self.initMeshOrient.shape[0] != self.numMeshPts: print("Expecting a Nx3 array of initial mesh orientations (initMeshOrient) with first index for mesh number.") - self.aerodyn_inflow_end() + self.adi_end() raise Exception("\nAeroDyn terminated prematurely.") @@ -684,72 +753,72 @@ def check_input_motions_hubNac(self,nodePos,nodeOrient,nodeVel,nodeAcc,_name): # Verify that the shape of positions array is correct if nodePos.size != 3: print("Expecting a Nx3 array of "+_name+" positions with second index for [x,y,z]") - self.aerodyn_inflow_end() + self.adi_end() raise Exception("\nAeroDyn/AeroDyn terminated prematurely.") # Verify that the shape of orientations array is correct if nodeOrient.size != 9: print("Expecting a Nx9 array of "+_name+" orientations with second index for [r11,r12,r13,r21,r22,r23,r31,r32,r33]") - self.aerodyn_inflow_end() + self.adi_end() raise Exception("\nAeroDyn/AeroDyn terminated prematurely.") # Verify that the shape of velocities array is correct if nodeVel.size != 6: print("Expecting a Nx6 array of "+_name+" velocities with second index for [x,y,z,Rx,Ry,Rz]") - self.aerodyn_inflow_end() + self.adi_end() raise Exception("\nAeroDyn/AeroDyn terminated prematurely.") # Verify that the shape of accelerations array is correct if nodeAcc.size != 6: print("Expecting a Nx6 array of "+_name+" accelerations with second index for [x,y,z,Rx,Ry,Rz]") - self.aerodyn_inflow_end() + self.adi_end() raise Exception("\nAeroDyn/AeroDyn terminated prematurely.") def check_input_motions_root(self,rootPos,rootOrient,rootVel,rootAcc): # make sure number of roots didn't change for some reason if self._initNumBlades != self.numBlades: print(f"At time {time}, the number of root points changed from initial value of {self._initNumBlades}. This is not permitted during the simulation.") - self.aerodyn_inflow_end() + self.adi_end() raise Exception("\nError in calling AeroDyn/AeroDyn library.") # Verify that the shape of positions array is correct if rootPos.shape[1] != 3: print("Expecting a Nx3 array of root positions (rootOrient) with second index for [x,y,z]") - self.aerodyn_inflow_end() + self.adi_end() raise Exception("\nAeroDyn/AeroDyn terminated prematurely.") if rootPos.shape[0] != self.numBlades: print("Expecting a Nx3 array of root positions (rootOrient) with first index for root number.") - self.aerodyn_inflow_end() + self.adi_end() raise Exception("\nAeroDyn/AeroDyn terminated prematurely.") # Verify that the shape of orientations array is correct if rootOrient.shape[1] != 9: print("Expecting a Nx9 array of root orientations (rootPos) with second index for [r11,r12,r13,r21,r22,r23,r31,r32,r33]") - self.aerodyn_inflow_end() + self.adi_end() raise Exception("\nAeroDyn/AeroDyn terminated prematurely.") if rootOrient.shape[0] != self.numBlades: print("Expecting a Nx9 array of root orientations (rootPos) with first index for root number.") - self.aerodyn_inflow_end() + self.adi_end() raise Exception("\nAeroDyn/AeroDyn terminated prematurely.") # Verify that the shape of velocities array is correct if rootVel.shape[1] != 6: print("Expecting a Nx6 array of root velocities (rootVel) with second index for [x,y,z,Rx,Ry,Rz]") - self.aerodyn_inflow_end() + self.adi_end() raise Exception("\nAeroDyn/AeroDyn terminated prematurely.") if rootVel.shape[0] != self.numBlades: print("Expecting a Nx6 array of root velocities (rootVel) with first index for root number.") - self.aerodyn_inflow_end() + self.adi_end() raise Exception("\nAeroDyn/AeroDyn terminated prematurely.") # Verify that the shape of accelerations array is correct if rootAcc.shape[1] != 6: print("Expecting a Nx6 array of root accelerations (rootAcc) with second index for [x,y,z,Rx,Ry,Rz]") - self.aerodyn_inflow_end() + self.adi_end() raise Exception("\nAeroDyn/AeroDyn terminated prematurely.") if rootAcc.shape[0] != self.numBlades: print("Expecting a Nx6 array of root accelerations (rootAcc) with first index for root number.") - self.aerodyn_inflow_end() + self.adi_end() raise Exception("\nAeroDyn/AeroDyn terminated prematurely.") @@ -757,47 +826,47 @@ def check_input_motions_mesh(self,meshPos,meshOrient,meshVel,meshAcc): # make sure number of meshs didn't change for some reason if self._initNumMeshPts != self.numMeshPts: print(f"At time {time}, the number of mesh points changed from initial value of {self._initNumMeshPts}. This is not permitted during the simulation.") - self.aerodyn_inflow_end() + self.adi_end() raise Exception("\nError in calling AeroDyn/AeroDyn library.") # Verify that the shape of positions array is correct if meshPos.shape[1] != 3: print("Expecting a Nx3 array of mesh positions (meshOrient) with second index for [x,y,z]") - self.aerodyn_inflow_end() + self.adi_end() raise Exception("\nAeroDyn/AeroDyn terminated prematurely.") if meshPos.shape[0] != self.numMeshPts: print("Expecting a Nx3 array of mesh positions (meshOrient) with first index for mesh number.") - self.aerodyn_inflow_end() + self.adi_end() raise Exception("\nAeroDyn/AeroDyn terminated prematurely.") # Verify that the shape of orientations array is correct if meshOrient.shape[1] != 9: print("Expecting a Nx9 array of mesh orientations (meshPos) with second index for [r11,r12,r13,r21,r22,r23,r31,r32,r33]") - self.aerodyn_inflow_end() + self.adi_end() raise Exception("\nAeroDyn/AeroDyn terminated prematurely.") if meshOrient.shape[0] != self.numMeshPts: print("Expecting a Nx9 array of mesh orientations (meshPos) with first index for mesh number.") - self.aerodyn_inflow_end() + self.adi_end() raise Exception("\nAeroDyn/AeroDyn terminated prematurely.") # Verify that the shape of velocities array is correct if meshVel.shape[1] != 6: print("Expecting a Nx6 array of mesh velocities (meshVel) with second index for [x,y,z,Rx,Ry,Rz]") - self.aerodyn_inflow_end() + self.adi_end() raise Exception("\nAeroDyn/AeroDyn terminated prematurely.") if meshVel.shape[0] != self.numMeshPts: print("Expecting a Nx6 array of mesh velocities (meshVel) with first index for mesh number.") - self.aerodyn_inflow_end() + self.adi_end() raise Exception("\nAeroDyn/AeroDyn terminated prematurely.") # Verify that the shape of accelerations array is correct if meshAcc.shape[1] != 6: print("Expecting a Nx6 array of mesh accelerations (meshAcc) with second index for [x,y,z,Rx,Ry,Rz]") - self.aerodyn_inflow_end() + self.adi_end() raise Exception("\nAeroDyn/AeroDyn terminated prematurely.") if meshAcc.shape[0] != self.numMeshPts: print("Expecting a Nx6 array of mesh accelerations (meshAcc) with first index for mesh number.") - self.aerodyn_inflow_end() + self.adi_end() raise Exception("\nAeroDyn/AeroDyn terminated prematurely.") @@ -826,7 +895,8 @@ def output_channel_units(self): # correctly, this will be identical to the corresponding values in the # AeroDyn/InflowWind output channels. -#FIXME: this is incorrect +#FIXME: this may not output everything in the interface (updates have been made +# since writing this, but this routine was not updated accordingly class DriverDbg(): """ This is only for debugging purposes only. The input motions and resulting @@ -841,8 +911,8 @@ def __init__(self,filename,numMeshPts): # write file header t_string=datetime.datetime.now() dt_string=datetime.date.today() - self.DbgFile.write(f"## This file was generated by aerodyn_inflow_c_lib on {dt_string.strftime('%b-%d-%Y')} at {t_string.strftime('%H:%M:%S')}\n") - self.DbgFile.write(f"## This file contains the resulting forces/moments at each of {self.numMeshPts} mesh points passed into the aerodyn_inflow_c_lib\n") + self.DbgFile.write(f"## This file was generated by adi_c_lib on {dt_string.strftime('%b-%d-%Y')} at {t_string.strftime('%H:%M:%S')}\n") + self.DbgFile.write(f"## This file contains the resulting forces/moments at each of {self.numMeshPts} mesh points passed into the adi_c_lib\n") self.DbgFile.write("#\n") self.DbgFile.write("#\n") self.DbgFile.write("#\n") @@ -875,6 +945,9 @@ def __init__(self,filename,numMeshPts): self.DbgFile.write(f_string.format(f_num+"Mx" )) self.DbgFile.write(f_string.format(f_num+"My" )) self.DbgFile.write(f_string.format(f_num+"Mz" )) + self.DbgFile.write(f_string.format(f_num+"DskAvgVx" )) + self.DbgFile.write(f_string.format(f_num+"DskAvgVy" )) + self.DbgFile.write(f_string.format(f_num+"DskAvgVz" )) self.DbgFile.write("\n") self.DbgFile.write(" (s) ") for i in range(1,self.numMeshPts+1): @@ -902,10 +975,13 @@ def __init__(self,filename,numMeshPts): self.DbgFile.write(f_string.format("(N-m)" )) self.DbgFile.write(f_string.format("(N-m)" )) self.DbgFile.write(f_string.format("(N-m)" )) + self.DbgFile.write(f_string.format("(m/s)" )) + self.DbgFile.write(f_string.format("(m/s)" )) + self.DbgFile.write(f_string.format("(m/s)" )) self.DbgFile.write("\n") self.opened = True - def write(self,t,meshPos,meshVel,meshAcc,meshFrc): + def write(self,t,meshPos,meshVel,meshAcc,meshFrc,DiskAvgVel): t_string = "{:10.4f}" f_string3 = "{:25.7e}"*3 f_string6 = "{:25.7e}"*6 @@ -915,6 +991,7 @@ def write(self,t,meshPos,meshVel,meshAcc,meshFrc): self.DbgFile.write(f_string6.format(*meshVel[i,:])) self.DbgFile.write(f_string6.format(*meshAcc[i,:])) self.DbgFile.write(f_string6.format(*meshFrc[i,:])) + self.DbgFile.write(f_string3.format(*DiskAvgVel[:])) self.DbgFile.write("\n") def end(self): @@ -927,7 +1004,7 @@ def end(self): # Helper class for writing channels to file. # for the regression testing to mirror the output from the AD15 and InfowWind # from an OpenFAST simulation. This may also have value for debugging -# interfacing to the AeroDyn_Inflow_C_Binding library +# interfacing to the ADI_C_Binding library class WriteOutChans(): """ diff --git a/modules/aerodyn/src/AeroAcoustics.f90 b/modules/aerodyn/src/AeroAcoustics.f90 index 77449b40bc..968693f6a1 100644 --- a/modules/aerodyn/src/AeroAcoustics.f90 +++ b/modules/aerodyn/src/AeroAcoustics.f90 @@ -55,7 +55,7 @@ subroutine AA_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut type(AA_OutputType), intent( out) :: y !< Initial system outputs (outputs are not calculated; !! only the output mesh is initialized) type(AA_MiscVarType), intent( out) :: m !< Initial misc/optimization variables - real(DbKi), intent(inout) :: interval !< Coupling interval in seconds: the rate that + real(DbKi), intent(in ) :: interval !< Coupling interval in seconds: the rate that !! (1) AA_UpdateStates() is called in loose coupling & !! (2) AA_UpdateDiscState() is called in tight coupling. !! Input is the suggested time from the glue code; @@ -177,17 +177,10 @@ subroutine SetParameters( InitInp, InputFileData, p, ErrStat, ErrMsg ) p%SpdSound = InitInp%SpdSound p%HubHeight = InitInp%HubHeight p%Lturb = InputFileData%Lturb - p%dy_turb_in = InputFileData%dy_turb_in - p%dz_turb_in = InputFileData%dz_turb_in p%NrObsLoc = InputFileData%NrObsLoc p%FTitle = InputFileData%FTitle - - IF ((InputFileData%TICalcMeth==1)) THEN - call AllocAry(p%TI_Grid_In,size(InputFileData%TI_Grid_In,1), size(InputFileData%TI_Grid_In,2), 'p%TI_Grid_In', errStat2, errMsg2); if(Failed()) return - p%TI_Grid_In=InputFileData%TI_Grid_In - ENDIF - - p%AvgV=InputFileData%AvgV + p%TI = InputFileData%TI + p%avgV = InputFileData%avgV ! Copy AFInfo into AA module ! TODO Allocate AFInfo and AFindx variables (DONE AND DONE) @@ -733,30 +726,9 @@ subroutine AA_UpdateStates( t, n, m, u, p, xd, errStat, errMsg ) ELSE! interpolate from the user given ti values do i=1,p%NumBlades do j=1,p%NumBlNds - zi_a=ABS(m%LE_Location(3,j,i) - (FLOOR(p%HubHeight-maxval(p%BlSpn(:,1)))) ) /p%dz_turb_in - z0_a=floor(zi_a) - z1_a=ceiling(zi_a) - zd_a=zi_a-z0_a - yi_a=ABS(m%LE_Location(2,j,i) + maxval(p%BlSpn(:,1)) ) /p%dy_turb_in - y0_a=floor(yi_a) - y1_a=ceiling(yi_a) - yd_a=yi_a-y0_a - c00_a=(1.0_ReKi-yd_a)*p%TI_Grid_In(z0_a+1,y0_a+1)+yd_a*p%TI_Grid_In(z0_a+1,y1_a+1) - c10_a=(1.0_ReKi-yd_a)*p%TI_Grid_In(z1_a+1,y0_a+1)+yd_a*p%TI_Grid_In(z1_a+1,y1_a+1) - - ! This is the turbulence intensity of the wind at the location of the blade i at node j - ti_vx = (1.0_ReKi-zd_a)*c00_a+zd_a*c10_a - ! With some velocity triangles, we convert it into the incident turbulence intensity, i.e. the TI used by the Amiet model - U1 = u%Vrel(J,I) - U2 = SQRT((p%AvgV*(1.+ti_vx))**2 + U1**2 - p%AvgV**2) - ! xd%TIVx(j,i)=(U2-U1)/U1 - xd%TIVx(j,i)=p%AvgV*ti_vx/U1 - - - if (i.eq.p%NumBlades) then - if (j.eq.p%NumBlNds) then - endif - endif + ! We scale the incident turbulence intensity by the ratio of average to incident wind speed + ! The scaled TI is used by the Amiet model + xd%TIVx(j,i)=p%TI*p%avgV/u%Vrel(J,I) enddo enddo endif @@ -1508,7 +1480,7 @@ SUBROUTINE TBLTE(ALPSTAR,C,U,THETA,PHI,L,R,p,d99Var2,dstarVar1,dstarVar2,StallVa IF (ALPSTAR .GT. StallVal) ST2 = 4.72 * ST1 ST1PRIM = (ST1+ST2)/2. ! Eq 33 from BPM Airfoil Self-noise and Prediction paper CALL A0COMP(RC,A0) ! compute -20 dB dropout (returns A0) - CALL A0COMP(3.*RC,A02) ! compute -20 dB dropout for AoA > AoA_0 (returns A02) + CALL A0COMP(3.0_ReKi*RC,A02) ! compute -20 dB dropout for AoA > AoA_0 (returns A02) ! Evaluate minimum and maximum 'a' curves at a0 CALL AMIN(A0,AMINA0) CALL AMAX(A0,AMAXA0) @@ -2332,7 +2304,7 @@ SUBROUTINE TBLTE_TNO(U,THETA,PHI,D,R,Cfall,d99all,EdgeVelAll,p,SPLP,SPLS,SPLALPH Mach = U / p%SpdSound ! Directivity function - CALL DIRECTH_TE(REAL(Mach),THETA,PHI,DBARH,errStat2,errMsg2) + CALL DIRECTH_TE(REAL(Mach,ReKi),THETA,PHI,DBARH,errStat2,errMsg2) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsgn, RoutineName ) do i_omega = 1,n_freq diff --git a/modules/aerodyn/src/AeroAcoustics_IO.f90 b/modules/aerodyn/src/AeroAcoustics_IO.f90 index 28679b5992..7e6affa37e 100644 --- a/modules/aerodyn/src/AeroAcoustics_IO.f90 +++ b/modules/aerodyn/src/AeroAcoustics_IO.f90 @@ -94,10 +94,6 @@ SUBROUTINE ReadInputFiles( InputFileName, AFI, InputFileData, Default_DT, OutFil if (Failed())return endif - IF( (InputFileData%TICalcMeth==1) ) THEN - CALL REadTICalcTables(InputFileName,InputFileData, ErrStat2, ErrMsg2); if(Failed()) return - ENDIF - CONTAINS logical function Failed() call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -203,7 +199,8 @@ SUBROUTINE ReadPrimaryFile( InputFile, InputFileData, Default_DT, OutFileRoot, U CALL ReadCom( UnIn, InputFile, 'Section Header: Aeroacoustic Models', ErrStat2, ErrMsg2, UnEc ); call check() CALL ReadVar(UnIn,InputFile,InputFileData%IInflow ,"InflowMod" ,"" ,ErrStat2,ErrMsg2,UnEc); call check() CALL ReadVar(UnIn,InputFile,InputFileData%TICalcMeth ,"TICalcMeth" ,"" ,ErrStat2,ErrMsg2,UnEc); call check() - CALL ReadVAr(UnIn,InputFile,InputFileData%TICalcTabFile,"TICalcTabFile","" ,ErrStat2,ErrMsg2,UnEc); call check() + CALL ReadVAr(UnIn,InputFile,InputFileData%TI ,"TI" ,"" ,ErrStat2,ErrMsg2,UnEc); call check() + CALL ReadVAr(UnIn,InputFile,InputFileData%avgV ,"avgV" ,"" ,ErrStat2,ErrMsg2,UnEc); call check() CALL ReadVar(UnIn,InputFile,InputFileData%Lturb ,"Lturb" ,"" ,ErrStat2,ErrMsg2,UnEc); call check() CALL ReadVar(UnIn,InputFile,InputFileData%ITURB ,"TurbMod" ,"" ,ErrStat2,ErrMsg2,UnEc); call check() ! ITURB - TBLTE NOISE CALL ReadVar(UnIn,InputFile,InputFileData%X_BLMethod ,"BLMod" ,"" ,ErrStat2,ErrMsg2,UnEc); call check() @@ -423,66 +420,6 @@ SUBROUTINE Cleanup() END SUBROUTINE Cleanup END SUBROUTINE ReadBLTables !---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE ReadTICalcTables(InputFile, InputFileData, ErrStat, ErrMsg) - ! Passed variables - integer(IntKi), intent(out) :: ErrStat ! Error status - character(*), intent(out) :: ErrMsg ! Error message - type(AA_InputFile), intent(inout) :: InputFileData ! All the data in the Noise input file - character(*), intent(in) :: InputFile ! Name of the file containing the primary input data - ! Local variables: - integer(IntKi) :: UnIn ! Unit number for reading file - character(1024) :: FileName ! name of the files containing obesever location - integer(IntKi) :: ErrStat2 ! Temporary Error status - character(ErrMsgLen) :: ErrMsg2 ! Temporary Error message - character(1024) :: PriPath ! Path name of the primary file - character(*), parameter :: RoutineName = 'REadTICalcTables' - integer(IntKi) :: GridY ! - integer(IntKi) :: GridZ ! - integer(IntKi) :: cou1 - ! Initialize some variables: - ErrStat = ErrID_None - ErrMsg = "" - - CALL GetPath( InputFile, PriPath ) ! Input files will be relative to the path where the primary input file is located. - - FileName = TRIM(PriPath)//InputFileData%TICalcTabFile - - CALL GetNewUnit( UnIn, ErrStat2, ErrMsg2); call check() - CALL OpenFInpFile ( UnIn, FileName, ErrStat2, ErrMsg2 ); if(Failed()) return - CALL ReadCom(UnIn, FileName, 'Text Line', ErrStat2, ErrMsg2); call check() - CALL ReadVar(UnIn, FileName, InputFileData%AvgV, 'AvgV', 'Echo flag', ErrStat2, ErrMsg2); call check() - CALL ReadCom(UnIn, FileName, 'Text Line', ErrStat2, ErrMsg2); call check() - CALL ReadVar(UnIn, FileName, GridY, 'GridY', 'Echo flag', ErrStat2, ErrMsg2); call check() - CALL ReadCom(UnIn, FileName, 'Text Line', ErrStat2, ErrMsg2);call check() - CALL ReadVar(UnIn, FileName, GridZ, 'GridZ', 'Echo flag', ErrStat2, ErrMsg2); call check() - CALL ReadCom(UnIn, FileName, 'Text Line', ErrStat2, ErrMsg2); call check() - CALL ReadVar(UnIn, FileName, InputFileData%dy_turb_in, 'InputFileData%dy_turb_in', 'Echo flag', ErrStat2, ErrMsg2); call check() - CALL ReadCom(UnIn, FileName, 'Text Line', ErrStat2, ErrMsg2); call check() - CALL ReadVar(UnIn, FileName, InputFileData%dz_turb_in, 'InputFileData%dz_turb_in', 'Echo flag', ErrStat2, ErrMsg2); call check() - if(Failed()) return - - CALL AllocAry( InputFileData%TI_Grid_In,GridZ,GridY,'InputFileData%TI_Grid_In', ErrStat2, ErrMsg2); - if(Failed()) return - DO cou1=1,size(InputFileData%TI_Grid_In,1) - read(UnIn,*) InputFileData%TI_Grid_In(cou1,:) - ENDDO - !---------------------- END OF FILE ----------------------------------------- - CALL Cleanup( ) - -CONTAINS - logical function Failed() - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - Failed = ErrStat >= AbortErrLev - if(Failed) call cleanup() - end function Failed - SUBROUTINE Check() - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE Check - SUBROUTINE Cleanup() - IF (UnIn > 0) CLOSE ( UnIn ) - END SUBROUTINE Cleanup -END SUBROUTINE REadTICalcTables -!---------------------------------------------------------------------------------------------------------------------------------- !> This routine validates the inputs from the AeroDyn input files. SUBROUTINE ValidateInputData( InputFileData, NumBl, ErrStat, ErrMsg ) type(AA_InputFile), intent(in) :: InputFileData !< All the data in the AeroDyn input file diff --git a/modules/aerodyn/src/AeroAcoustics_Registry.txt b/modules/aerodyn/src/AeroAcoustics_Registry.txt index ec84c4c062..b01f3061dc 100644 --- a/modules/aerodyn/src/AeroAcoustics_Registry.txt +++ b/modules/aerodyn/src/AeroAcoustics_Registry.txt @@ -53,7 +53,7 @@ typedef ^ InitOutputType ReKi AirDens # # ..... Primary Input file data ................................................................................................... -typedef ^ AA_InputFile DbKi DT_AA - - - "Time interval for aerodynamic calculations {or "default"}" s +typedef ^ AA_InputFile DbKi DT_AA - - - "Time interval for aerodynamic calculations {or \"default\"}" s typedef ^ AA_InputFile IntKi IBLUNT - - - "FLAG TO COMPUTE BLUNTNESS NOISE" - typedef ^ AA_InputFile IntKi ILAM - - - "FLAG TO COMPUTE LBL NOISE {1=steady model, 2=Beddoes-Leishman unsteady model}" - typedef ^ AA_InputFile IntKi ITIP - - - "FLAG TO COMPUTE TIP NOISE {0=none, 1=baseline potential flow, 2=potential flow with Bak correction}" - @@ -74,11 +74,11 @@ typedef ^ AA_InputFile ReKi ObsZ typedef ^ AA_InputFile AA_BladePropsType BladeProps {:} - - "blade property information from blade input files" - typedef ^ AA_InputFile IntKi NrOutFile - - - "Nr of output files" - typedef ^ AA_InputFile CHARACTER(1024) AAoutfile {:} - - "AAoutfile for writing output files" - -typedef ^ AA_InputFile CHARACTER(1024) TICalcTabFile - - - "Name of the file containing the table for incident turbulence intensity" - typedef ^ AA_InputFile CHARACTER(1024) FTitle - - - "File Title: the 2nd line of the input file, which contains a description of its contents" - typedef ^ AA_InputFile DBKi AAStart - - - "Time after which to calculate AA" s +typedef ^ AA_InputFile ReKi TI - - - "Average rotor incident turbulence intensity" - +typedef ^ AA_InputFile ReKi avgV - - - "Average wind speed" - typedef ^ AA_InputFile ReKi Lturb - - - "Turbulent lengthscale in Amiet model" - -typedef ^ AA_InputFile ReKi AvgV - - - "Average wind speed to compute incident turbulence intensity" m typedef ^ AA_InputFile ReKi ReListBL {:} - - "" typedef ^ AA_InputFile ReKi AoAListBL {:} - - "" deg typedef ^ AA_InputFile ReKi Pres_DispThick {:}{:}{:} - - "" @@ -89,9 +89,6 @@ typedef ^ AA_InputFile ReKi Pres_Cf typedef ^ AA_InputFile ReKi Suct_Cf {:}{:}{:} - - "" typedef ^ AA_InputFile ReKi Pres_EdgeVelRat {:}{:}{:} - - "" typedef ^ AA_InputFile ReKi Suct_EdgeVelRat {:}{:}{:} - - "" -typedef ^ AA_InputFile ReKi TI_Grid_In {:}{:} - - "" -typedef ^ AA_InputFile ReKi dz_turb_in - - - "" m -typedef ^ AA_InputFile ReKi dy_turb_in - - - "" m # ..... States .................................................................................................................... # Define continuous (differentiable) states here: @@ -184,10 +181,8 @@ typedef ^ ParameterType IntKi total_s typedef ^ ParameterType IntKi AA_Bl_Prcntge - - - "The Percentage of the Blade which the noise is calculated" % typedef ^ ParameterType IntKi startnode - - - "Corersponding node to the noise calculation percentage of the blade" - typedef ^ ParameterType ReKi Lturb - - - "Turbulent lengthscale in Amiet model" m -typedef ^ ParameterType ReKi AvgV - - - "Average wind speed to compute incident turbulence intensity" m -typedef ^ ParameterType ReKi dz_turb_in - - - "" m -typedef ^ ParameterType ReKi dy_turb_in - - - "" m -typedef ^ ParameterType ReKi TI_Grid_In {:}{:} - - "" +typedef ^ ParameterType ReKi avgV - - - "Average wind speed to compute incident turbulence intensity" m +typedef ^ ParameterType ReKi TI - - - "Rotor incident turbulent intensity" typedef ^ ParameterType CHARACTER(1024) FTitle - - - "File Title: the 2nd line of the input file, which contains a description of its contents" - # parameters for output diff --git a/modules/aerodyn/src/AeroAcoustics_Types.f90 b/modules/aerodyn/src/AeroAcoustics_Types.f90 index 8a702ba2fb..19b850b12c 100644 --- a/modules/aerodyn/src/AeroAcoustics_Types.f90 +++ b/modules/aerodyn/src/AeroAcoustics_Types.f90 @@ -36,22 +36,22 @@ MODULE AeroAcoustics_Types IMPLICIT NONE ! ========= AA_BladePropsType ======= TYPE, PUBLIC :: AA_BladePropsType - REAL(ReKi) :: TEThick !< [-] - REAL(ReKi) :: TEAngle !< [-] + REAL(ReKi) :: TEThick = 0.0_ReKi !< [-] + REAL(ReKi) :: TEAngle = 0.0_ReKi !< [-] END TYPE AA_BladePropsType ! ======================= ! ========= AA_InitInputType ======= TYPE, PUBLIC :: AA_InitInputType CHARACTER(1024) :: InputFile !< Name of the input file [-] - INTEGER(IntKi) :: NumBlades !< Number of blades on the turbine [-] - INTEGER(IntKi) :: NumBlNds !< Number of blade nodes [-] + INTEGER(IntKi) :: NumBlades = 0_IntKi !< Number of blades on the turbine [-] + INTEGER(IntKi) :: NumBlNds = 0_IntKi !< Number of blade nodes [-] CHARACTER(1024) :: RootName !< RootName for writing output files [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BlSpn !< Span at blade node [m] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BlChord !< Chord at blade node [m] - REAL(ReKi) :: AirDens !< Air density [kg/m^3] - REAL(ReKi) :: KinVisc !< Kinematic air viscosity [m^2/s] - REAL(ReKi) :: SpdSound !< Speed of sound [m/s] - REAL(ReKi) :: HubHeight !< Hub Height [m] + REAL(ReKi) :: AirDens = 0.0_ReKi !< Air density [kg/m^3] + REAL(ReKi) :: KinVisc = 0.0_ReKi !< Kinematic air viscosity [m^2/s] + REAL(ReKi) :: SpdSound = 0.0_ReKi !< Speed of sound [m/s] + REAL(ReKi) :: HubHeight = 0.0_ReKi !< Hub Height [m] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: BlAFID !< Index of airfoil data file for blade node location [array of numBladeNodes by numBlades] [-] TYPE(AFI_ParameterType) , DIMENSION(:), ALLOCATABLE :: AFInfo !< Airfoil information structure containing the aerodynamic center and airfoil shape coordinates [-] END TYPE AA_InitInputType @@ -68,37 +68,37 @@ MODULE AeroAcoustics_Types CHARACTER(25) , DIMENSION(:), ALLOCATABLE :: WriteOutputUntNodes !< Units of the output-to-file channels [-] character(1) :: delim !< column delimiter [-] TYPE(ProgDesc) :: Ver !< This module's name, version, and date [-] - REAL(ReKi) :: AirDens !< Air density [kg/m^3] + REAL(ReKi) :: AirDens = 0.0_ReKi !< Air density [kg/m^3] END TYPE AA_InitOutputType ! ======================= ! ========= AA_InputFile ======= TYPE, PUBLIC :: AA_InputFile - REAL(DbKi) :: DT_AA !< Time interval for aerodynamic calculations {or "default"} [s] - INTEGER(IntKi) :: IBLUNT !< FLAG TO COMPUTE BLUNTNESS NOISE [-] - INTEGER(IntKi) :: ILAM !< FLAG TO COMPUTE LBL NOISE {1=steady model, 2=Beddoes-Leishman unsteady model} [-] - INTEGER(IntKi) :: ITIP !< FLAG TO COMPUTE TIP NOISE {0=none, 1=baseline potential flow, 2=potential flow with Bak correction} [-] - INTEGER(IntKi) :: ITRIP !< FLAG TO TRIP BOUNDARY LAYER {0=none, 1=baseline potential flow, 2=potential flow with Bak correction} [-] - INTEGER(IntKi) :: ITURB !< FLAG TO COMPUTE TBLTE NOISE {0=none, 1=baseline potential flow, 2=potential flow with Bak correction} [-] - INTEGER(IntKi) :: IInflow !< FLAG TO COMPUTE Turbulent Inflow NOISE {0=none, 1=baseline potential flow, 2=potential flow with Bak correction} [-] - INTEGER(IntKi) :: X_BLMethod !< Integer describing calculation method for boundary layer properties, = 1 BPM = 2 Pretabulated [-] - INTEGER(IntKi) :: TICalcMeth !< TICalcMeth [-] - INTEGER(IntKi) :: NReListBL !< Number of values of ReListBL [-] - LOGICAL :: aweightflag !< Integer a weighting call [-] - LOGICAL :: ROUND !< LOGICAL INDICATING ROUNDED TIP [-] - REAL(ReKi) :: ALPRAT !< TIP LIFT CURVE SLOPE [-] - INTEGER(IntKi) :: AA_Bl_Prcntge !< see the AeroAcoustics input file for description [-] - INTEGER(IntKi) :: NrObsLoc !< Number of observer locations [-] + REAL(DbKi) :: DT_AA = 0.0_R8Ki !< Time interval for aerodynamic calculations {or "default"} [s] + INTEGER(IntKi) :: IBLUNT = 0_IntKi !< FLAG TO COMPUTE BLUNTNESS NOISE [-] + INTEGER(IntKi) :: ILAM = 0_IntKi !< FLAG TO COMPUTE LBL NOISE {1=steady model, 2=Beddoes-Leishman unsteady model} [-] + INTEGER(IntKi) :: ITIP = 0_IntKi !< FLAG TO COMPUTE TIP NOISE {0=none, 1=baseline potential flow, 2=potential flow with Bak correction} [-] + INTEGER(IntKi) :: ITRIP = 0_IntKi !< FLAG TO TRIP BOUNDARY LAYER {0=none, 1=baseline potential flow, 2=potential flow with Bak correction} [-] + INTEGER(IntKi) :: ITURB = 0_IntKi !< FLAG TO COMPUTE TBLTE NOISE {0=none, 1=baseline potential flow, 2=potential flow with Bak correction} [-] + INTEGER(IntKi) :: IInflow = 0_IntKi !< FLAG TO COMPUTE Turbulent Inflow NOISE {0=none, 1=baseline potential flow, 2=potential flow with Bak correction} [-] + INTEGER(IntKi) :: X_BLMethod = 0_IntKi !< Integer describing calculation method for boundary layer properties, = 1 BPM = 2 Pretabulated [-] + INTEGER(IntKi) :: TICalcMeth = 0_IntKi !< TICalcMeth [-] + INTEGER(IntKi) :: NReListBL = 0_IntKi !< Number of values of ReListBL [-] + LOGICAL :: aweightflag = .false. !< Integer a weighting call [-] + LOGICAL :: ROUND = .false. !< LOGICAL INDICATING ROUNDED TIP [-] + REAL(ReKi) :: ALPRAT = 0.0_ReKi !< TIP LIFT CURVE SLOPE [-] + INTEGER(IntKi) :: AA_Bl_Prcntge = 0_IntKi !< see the AeroAcoustics input file for description [-] + INTEGER(IntKi) :: NrObsLoc = 0_IntKi !< Number of observer locations [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: ObsX !< Observer location in tower-base coordinate X horizontal [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: ObsY !< Observer location in tower-base coordinate Y lateral [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: ObsZ !< Observer location in tower-base coordinate Z vertical [m] TYPE(AA_BladePropsType) , DIMENSION(:), ALLOCATABLE :: BladeProps !< blade property information from blade input files [-] - INTEGER(IntKi) :: NrOutFile !< Nr of output files [-] + INTEGER(IntKi) :: NrOutFile = 0_IntKi !< Nr of output files [-] CHARACTER(1024) , DIMENSION(:), ALLOCATABLE :: AAoutfile !< AAoutfile for writing output files [-] - CHARACTER(1024) :: TICalcTabFile !< Name of the file containing the table for incident turbulence intensity [-] CHARACTER(1024) :: FTitle !< File Title: the 2nd line of the input file, which contains a description of its contents [-] - REAL(DbKi) :: AAStart !< Time after which to calculate AA [s] - REAL(ReKi) :: Lturb !< Turbulent lengthscale in Amiet model [-] - REAL(ReKi) :: AvgV !< Average wind speed to compute incident turbulence intensity [m] + REAL(DbKi) :: AAStart = 0.0_R8Ki !< Time after which to calculate AA [s] + REAL(ReKi) :: TI = 0.0_ReKi !< Average rotor incident turbulence intensity [-] + REAL(ReKi) :: avgV = 0.0_ReKi !< Average wind speed [-] + REAL(ReKi) :: Lturb = 0.0_ReKi !< Turbulent lengthscale in Amiet model [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: ReListBL !< [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: AoAListBL !< [deg] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: Pres_DispThick !< [-] @@ -109,14 +109,11 @@ MODULE AeroAcoustics_Types REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: Suct_Cf !< [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: Pres_EdgeVelRat !< [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: Suct_EdgeVelRat !< [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: TI_Grid_In !< [-] - REAL(ReKi) :: dz_turb_in !< [m] - REAL(ReKi) :: dy_turb_in !< [m] END TYPE AA_InputFile ! ======================= ! ========= AA_ContinuousStateType ======= TYPE, PUBLIC :: AA_ContinuousStateType - REAL(SiKi) :: DummyContState !< Remove this variable if you have continuous states [-] + REAL(SiKi) :: DummyContState = 0.0_R4Ki !< Remove this variable if you have continuous states [-] END TYPE AA_ContinuousStateType ! ======================= ! ========= AA_DiscreteStateType ======= @@ -136,12 +133,12 @@ MODULE AeroAcoustics_Types ! ======================= ! ========= AA_ConstraintStateType ======= TYPE, PUBLIC :: AA_ConstraintStateType - REAL(SiKi) :: DummyConstrState !< Remove this variable if you have states [-] + REAL(SiKi) :: DummyConstrState = 0.0_R4Ki !< Remove this variable if you have states [-] END TYPE AA_ConstraintStateType ! ======================= ! ========= AA_OtherStateType ======= TYPE, PUBLIC :: AA_OtherStateType - REAL(SiKi) :: DummyOtherState !< Remove this variable if you have states [-] + REAL(SiKi) :: DummyOtherState = 0.0_R4Ki !< Remove this variable if you have states [-] END TYPE AA_OtherStateType ! ======================= ! ========= AA_MiscVarType ======= @@ -154,7 +151,7 @@ MODULE AeroAcoustics_Types REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: rTEtoObserve !< C [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: rLEtoObserve !< C [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: LE_Location !< Height of Leading Edge for calculation of TI and Scales if needed [-] - REAL(ReKi) :: RotSpeedAoA !< C [-] + REAL(ReKi) :: RotSpeedAoA = 0.0_ReKi !< C [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: SPLLBL !< C [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: SPLP !< C [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: SPLS !< C [-] @@ -168,66 +165,64 @@ MODULE AeroAcoustics_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: d99Var !< BL Output [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: dStarVar !< BL Output [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: EdgeVelVar !< BL Output [-] - INTEGER(IntKi) :: speccou !< Secptrum counter every XX seconds new spectrum [-] - INTEGER(IntKi) :: filesopen !< check if file is open [-] + INTEGER(IntKi) :: speccou = 0_IntKi !< Secptrum counter every XX seconds new spectrum [-] + INTEGER(IntKi) :: filesopen = 0_IntKi !< check if file is open [-] END TYPE AA_MiscVarType ! ======================= ! ========= AA_ParameterType ======= TYPE, PUBLIC :: AA_ParameterType - REAL(DbKi) :: DT !< Time step for continuous state integration & discrete state update [seconds] - INTEGER(IntKi) :: IBLUNT !< Bluntness noise model [-] - INTEGER(IntKi) :: ILAM !< LBL noise model [-] - INTEGER(IntKi) :: ITIP !< Tip noise model [-] - INTEGER(IntKi) :: ITRIP !< Trip boundary layer [-] - INTEGER(IntKi) :: ITURB !< Tblte noise model [-] - INTEGER(IntKi) :: IInflow !< Turbulent inflow noise model [-] - INTEGER(IntKi) :: X_BLMethod !< Integer describing calculation method for boundary layer properties, = 1 BPM = 2 Pretabulated [-] - INTEGER(IntKi) :: TICalcMeth !< [-] - LOGICAL :: ROUND !< Logical indicating rounded tip [-] - REAL(ReKi) :: ALPRAT !< TIP LIFT CURVE SLOPE [-] - INTEGER(IntKi) :: NumBlades !< Number of blades on the turbine [-] - INTEGER(IntKi) :: NumBlNds !< Number of nodes on each blade [-] - REAL(ReKi) :: AirDens !< Air density [kg/m^3] - REAL(ReKi) :: KinVisc !< Kinematic air viscosity [m^2/s] - REAL(ReKi) :: SpdSound !< Speed of sound [m/s] - REAL(ReKi) :: HubHeight !< Hub height [m] - REAL(ReKi) :: toptip !< Top Tip Height = Hub height plus radius [m] - REAL(ReKi) :: bottip !< Bottom Tip Height = Hub height minus radius [m] + REAL(DbKi) :: DT = 0.0_R8Ki !< Time step for continuous state integration & discrete state update [seconds] + INTEGER(IntKi) :: IBLUNT = 0_IntKi !< Bluntness noise model [-] + INTEGER(IntKi) :: ILAM = 0_IntKi !< LBL noise model [-] + INTEGER(IntKi) :: ITIP = 0_IntKi !< Tip noise model [-] + INTEGER(IntKi) :: ITRIP = 0_IntKi !< Trip boundary layer [-] + INTEGER(IntKi) :: ITURB = 0_IntKi !< Tblte noise model [-] + INTEGER(IntKi) :: IInflow = 0_IntKi !< Turbulent inflow noise model [-] + INTEGER(IntKi) :: X_BLMethod = 0_IntKi !< Integer describing calculation method for boundary layer properties, = 1 BPM = 2 Pretabulated [-] + INTEGER(IntKi) :: TICalcMeth = 0_IntKi !< [-] + LOGICAL :: ROUND = .false. !< Logical indicating rounded tip [-] + REAL(ReKi) :: ALPRAT = 0.0_ReKi !< TIP LIFT CURVE SLOPE [-] + INTEGER(IntKi) :: NumBlades = 0_IntKi !< Number of blades on the turbine [-] + INTEGER(IntKi) :: NumBlNds = 0_IntKi !< Number of nodes on each blade [-] + REAL(ReKi) :: AirDens = 0.0_ReKi !< Air density [kg/m^3] + REAL(ReKi) :: KinVisc = 0.0_ReKi !< Kinematic air viscosity [m^2/s] + REAL(ReKi) :: SpdSound = 0.0_ReKi !< Speed of sound [m/s] + REAL(ReKi) :: HubHeight = 0.0_ReKi !< Hub height [m] + REAL(ReKi) :: toptip = 0.0_ReKi !< Top Tip Height = Hub height plus radius [m] + REAL(ReKi) :: bottip = 0.0_ReKi !< Bottom Tip Height = Hub height minus radius [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: rotorregionlimitsVert !< [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: rotorregionlimitsHorz !< [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: rotorregionlimitsalph !< [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: rotorregionlimitsrad !< [-] - INTEGER(IntKi) :: NrObsLoc !< Number of observer locations [-] - LOGICAL :: aweightflag !< [-] - LOGICAL :: TxtFileOutput !< [-] - REAL(DbKi) :: AAStart !< Time after which to calculate AA [s] + INTEGER(IntKi) :: NrObsLoc = 0_IntKi !< Number of observer locations [-] + LOGICAL :: aweightflag = .false. !< [-] + LOGICAL :: TxtFileOutput = .false. !< [-] + REAL(DbKi) :: AAStart = 0.0_R8Ki !< Time after which to calculate AA [s] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: ObsX !< Observer location in tower-base coordinate X horizontal [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: ObsY !< Observer location in tower-base coordinate Y lateral [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: ObsZ !< Observer location in tower-base coordinate Z vertical [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: FreqList !< List of Acoustic Frequencies to Calculate [Hz] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Aweight !< List of Acoustic Frequencies a weighting [dB] - REAL(ReKi) :: Fsample !< Sampling Frequency 1/delta(t) - 1/(simulation time step) [Hz] - INTEGER(IntKi) :: total_sample !< Total FFT Sample amount for dissipation calculation [-] - INTEGER(IntKi) :: total_sampleTI !< Total FFT Sample amount for dissipation calculation [-] - INTEGER(IntKi) :: AA_Bl_Prcntge !< The Percentage of the Blade which the noise is calculated [%] - INTEGER(IntKi) :: startnode !< Corersponding node to the noise calculation percentage of the blade [-] - REAL(ReKi) :: Lturb !< Turbulent lengthscale in Amiet model [m] - REAL(ReKi) :: AvgV !< Average wind speed to compute incident turbulence intensity [m] - REAL(ReKi) :: dz_turb_in !< [m] - REAL(ReKi) :: dy_turb_in !< [m] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: TI_Grid_In !< [-] + REAL(ReKi) :: Fsample = 0.0_ReKi !< Sampling Frequency 1/delta(t) - 1/(simulation time step) [Hz] + INTEGER(IntKi) :: total_sample = 0_IntKi !< Total FFT Sample amount for dissipation calculation [-] + INTEGER(IntKi) :: total_sampleTI = 0_IntKi !< Total FFT Sample amount for dissipation calculation [-] + INTEGER(IntKi) :: AA_Bl_Prcntge = 0_IntKi !< The Percentage of the Blade which the noise is calculated [%] + INTEGER(IntKi) :: startnode = 0_IntKi !< Corersponding node to the noise calculation percentage of the blade [-] + REAL(ReKi) :: Lturb = 0.0_ReKi !< Turbulent lengthscale in Amiet model [m] + REAL(ReKi) :: avgV = 0.0_ReKi !< Average wind speed to compute incident turbulence intensity [m] + REAL(ReKi) :: TI = 0.0_ReKi !< Rotor incident turbulent intensity [-] CHARACTER(1024) :: FTitle !< File Title: the 2nd line of the input file, which contains a description of its contents [-] character(20) :: outFmt !< Format specifier [-] - INTEGER(IntKi) :: NrOutFile !< Nr of output files [-] + INTEGER(IntKi) :: NrOutFile = 0_IntKi !< Nr of output files [-] character(1) :: delim !< column delimiter [-] - INTEGER(IntKi) :: NumOuts !< Number of parameters in the output list (number of outputs requested) [-] - INTEGER(IntKi) :: NumOutsForPE !< Number of parameters in the output list (number of outputs requested) [-] - INTEGER(IntKi) :: NumOutsForSep !< Number of parameters in the output list (number of outputs requested) [-] - INTEGER(IntKi) :: NumOutsForNodes !< Number of parameters in the output list (number of outputs requested) [-] - INTEGER(IntKi) :: unOutFile !< unit number for writing output file [-] - INTEGER(IntKi) :: unOutFile2 !< unit number for writing output file [-] - INTEGER(IntKi) :: unOutFile3 !< unit number for writing output file [-] - INTEGER(IntKi) :: unOutFile4 !< unit number for writing output file [-] + INTEGER(IntKi) :: NumOuts = 0_IntKi !< Number of parameters in the output list (number of outputs requested) [-] + INTEGER(IntKi) :: NumOutsForPE = 0_IntKi !< Number of parameters in the output list (number of outputs requested) [-] + INTEGER(IntKi) :: NumOutsForSep = 0_IntKi !< Number of parameters in the output list (number of outputs requested) [-] + INTEGER(IntKi) :: NumOutsForNodes = 0_IntKi !< Number of parameters in the output list (number of outputs requested) [-] + INTEGER(IntKi) :: unOutFile = 0_IntKi !< unit number for writing output file [-] + INTEGER(IntKi) :: unOutFile2 = 0_IntKi !< unit number for writing output file [-] + INTEGER(IntKi) :: unOutFile3 = 0_IntKi !< unit number for writing output file [-] + INTEGER(IntKi) :: unOutFile4 = 0_IntKi !< unit number for writing output file [-] CHARACTER(1024) :: RootName !< RootName for writing output files [-] TYPE(OutParmType) , DIMENSION(:), ALLOCATABLE :: OutParam !< Names and units (and other characteristics) of all requested output parameters [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: StallStart !< ation [-] @@ -278,9585 +273,2673 @@ MODULE AeroAcoustics_Types END TYPE AA_OutputType ! ======================= CONTAINS - SUBROUTINE AA_CopyBladePropsType( SrcBladePropsTypeData, DstBladePropsTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AA_BladePropsType), INTENT(IN) :: SrcBladePropsTypeData - TYPE(AA_BladePropsType), INTENT(INOUT) :: DstBladePropsTypeData - 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 = 'AA_CopyBladePropsType' -! - ErrStat = ErrID_None - ErrMsg = "" - DstBladePropsTypeData%TEThick = SrcBladePropsTypeData%TEThick - DstBladePropsTypeData%TEAngle = SrcBladePropsTypeData%TEAngle - END SUBROUTINE AA_CopyBladePropsType - - SUBROUTINE AA_DestroyBladePropsType( BladePropsTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(AA_BladePropsType), INTENT(INOUT) :: BladePropsTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AA_DestroyBladePropsType' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE AA_DestroyBladePropsType - - SUBROUTINE AA_PackBladePropsType( 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(AA_BladePropsType), 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 = 'AA_PackBladePropsType' - ! 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 ! TEThick - Re_BufSz = Re_BufSz + 1 ! TEAngle - 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%TEThick - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TEAngle - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AA_PackBladePropsType - SUBROUTINE AA_UnPackBladePropsType( 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(AA_BladePropsType), 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 = 'AA_UnPackBladePropsType' - ! 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%TEThick = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TEAngle = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AA_UnPackBladePropsType - - SUBROUTINE AA_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AA_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(AA_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 = 'AA_CopyInitInput' -! +subroutine AA_CopyBladePropsType(SrcBladePropsTypeData, DstBladePropsTypeData, CtrlCode, ErrStat, ErrMsg) + type(AA_BladePropsType), intent(in) :: SrcBladePropsTypeData + type(AA_BladePropsType), intent(inout) :: DstBladePropsTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AA_CopyBladePropsType' ErrStat = ErrID_None - ErrMsg = "" - DstInitInputData%InputFile = SrcInitInputData%InputFile - DstInitInputData%NumBlades = SrcInitInputData%NumBlades - DstInitInputData%NumBlNds = SrcInitInputData%NumBlNds - DstInitInputData%RootName = SrcInitInputData%RootName -IF (ALLOCATED(SrcInitInputData%BlSpn)) THEN - i1_l = LBOUND(SrcInitInputData%BlSpn,1) - i1_u = UBOUND(SrcInitInputData%BlSpn,1) - i2_l = LBOUND(SrcInitInputData%BlSpn,2) - i2_u = UBOUND(SrcInitInputData%BlSpn,2) - IF (.NOT. ALLOCATED(DstInitInputData%BlSpn)) THEN - ALLOCATE(DstInitInputData%BlSpn(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%BlSpn.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%BlSpn = SrcInitInputData%BlSpn -ENDIF -IF (ALLOCATED(SrcInitInputData%BlChord)) THEN - i1_l = LBOUND(SrcInitInputData%BlChord,1) - i1_u = UBOUND(SrcInitInputData%BlChord,1) - i2_l = LBOUND(SrcInitInputData%BlChord,2) - i2_u = UBOUND(SrcInitInputData%BlChord,2) - IF (.NOT. ALLOCATED(DstInitInputData%BlChord)) THEN - ALLOCATE(DstInitInputData%BlChord(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%BlChord.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%BlChord = SrcInitInputData%BlChord -ENDIF - DstInitInputData%AirDens = SrcInitInputData%AirDens - DstInitInputData%KinVisc = SrcInitInputData%KinVisc - DstInitInputData%SpdSound = SrcInitInputData%SpdSound - DstInitInputData%HubHeight = SrcInitInputData%HubHeight -IF (ALLOCATED(SrcInitInputData%BlAFID)) THEN - i1_l = LBOUND(SrcInitInputData%BlAFID,1) - i1_u = UBOUND(SrcInitInputData%BlAFID,1) - i2_l = LBOUND(SrcInitInputData%BlAFID,2) - i2_u = UBOUND(SrcInitInputData%BlAFID,2) - IF (.NOT. ALLOCATED(DstInitInputData%BlAFID)) THEN - ALLOCATE(DstInitInputData%BlAFID(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%BlAFID.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%BlAFID = SrcInitInputData%BlAFID -ENDIF -IF (ALLOCATED(SrcInitInputData%AFInfo)) THEN - i1_l = LBOUND(SrcInitInputData%AFInfo,1) - i1_u = UBOUND(SrcInitInputData%AFInfo,1) - IF (.NOT. ALLOCATED(DstInitInputData%AFInfo)) THEN - ALLOCATE(DstInitInputData%AFInfo(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%AFInfo.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcInitInputData%AFInfo,1), UBOUND(SrcInitInputData%AFInfo,1) - CALL AFI_CopyParam( SrcInitInputData%AFInfo(i1), DstInitInputData%AFInfo(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - END SUBROUTINE AA_CopyInitInput - - SUBROUTINE AA_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(AA_InitInputType), INTENT(INOUT) :: InitInputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AA_DestroyInitInput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(InitInputData%BlSpn)) THEN - DEALLOCATE(InitInputData%BlSpn) -ENDIF -IF (ALLOCATED(InitInputData%BlChord)) THEN - DEALLOCATE(InitInputData%BlChord) -ENDIF -IF (ALLOCATED(InitInputData%BlAFID)) THEN - DEALLOCATE(InitInputData%BlAFID) -ENDIF -IF (ALLOCATED(InitInputData%AFInfo)) THEN -DO i1 = LBOUND(InitInputData%AFInfo,1), UBOUND(InitInputData%AFInfo,1) - CALL AFI_DestroyParam( InitInputData%AFInfo(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(InitInputData%AFInfo) -ENDIF - END SUBROUTINE AA_DestroyInitInput - - SUBROUTINE AA_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(AA_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 = 'AA_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 ! NumBlades - Int_BufSz = Int_BufSz + 1 ! NumBlNds - Int_BufSz = Int_BufSz + 1*LEN(InData%RootName) ! RootName - Int_BufSz = Int_BufSz + 1 ! BlSpn allocated yes/no - IF ( ALLOCATED(InData%BlSpn) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BlSpn upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BlSpn) ! BlSpn - END IF - Int_BufSz = Int_BufSz + 1 ! BlChord allocated yes/no - IF ( ALLOCATED(InData%BlChord) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BlChord upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BlChord) ! BlChord - END IF - Re_BufSz = Re_BufSz + 1 ! AirDens - Re_BufSz = Re_BufSz + 1 ! KinVisc - Re_BufSz = Re_BufSz + 1 ! SpdSound - Re_BufSz = Re_BufSz + 1 ! HubHeight - Int_BufSz = Int_BufSz + 1 ! BlAFID allocated yes/no - IF ( ALLOCATED(InData%BlAFID) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BlAFID upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%BlAFID) ! BlAFID - END IF - Int_BufSz = Int_BufSz + 1 ! AFInfo allocated yes/no - IF ( ALLOCATED(InData%AFInfo) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! AFInfo upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%AFInfo,1), UBOUND(InData%AFInfo,1) - Int_BufSz = Int_BufSz + 3 ! AFInfo: size of buffers for each call to pack subtype - CALL AFI_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%AFInfo(i1), ErrStat2, ErrMsg2, .TRUE. ) ! AFInfo - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! AFInfo - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! AFInfo - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! AFInfo - 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 - - 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) = InData%NumBlades - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumBlNds - 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%BlSpn) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlSpn,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlSpn,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlSpn,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlSpn,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%BlSpn,2), UBOUND(InData%BlSpn,2) - DO i1 = LBOUND(InData%BlSpn,1), UBOUND(InData%BlSpn,1) - ReKiBuf(Re_Xferred) = InData%BlSpn(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BlChord) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlChord,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlChord,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlChord,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlChord,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%BlChord,2), UBOUND(InData%BlChord,2) - DO i1 = LBOUND(InData%BlChord,1), UBOUND(InData%BlChord,1) - ReKiBuf(Re_Xferred) = InData%BlChord(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - ReKiBuf(Re_Xferred) = InData%AirDens - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%KinVisc - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%SpdSound - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%HubHeight - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%BlAFID) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlAFID,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlAFID,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlAFID,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlAFID,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%BlAFID,2), UBOUND(InData%BlAFID,2) - DO i1 = LBOUND(InData%BlAFID,1), UBOUND(InData%BlAFID,1) - IntKiBuf(Int_Xferred) = InData%BlAFID(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AFInfo) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AFInfo,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AFInfo,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%AFInfo,1), UBOUND(InData%AFInfo,1) - CALL AFI_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%AFInfo(i1), ErrStat2, ErrMsg2, OnlySize ) ! AFInfo - 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 AA_PackInitInput - - SUBROUTINE AA_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(AA_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 = 'AA_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%NumBlades = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumBlNds = 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 ! BlSpn not allocated - Int_Xferred = Int_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%BlSpn)) DEALLOCATE(OutData%BlSpn) - ALLOCATE(OutData%BlSpn(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlSpn.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%BlSpn,2), UBOUND(OutData%BlSpn,2) - DO i1 = LBOUND(OutData%BlSpn,1), UBOUND(OutData%BlSpn,1) - OutData%BlSpn(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlChord not allocated - Int_Xferred = Int_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%BlChord)) DEALLOCATE(OutData%BlChord) - ALLOCATE(OutData%BlChord(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlChord.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%BlChord,2), UBOUND(OutData%BlChord,2) - DO i1 = LBOUND(OutData%BlChord,1), UBOUND(OutData%BlChord,1) - OutData%BlChord(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%AirDens = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%KinVisc = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SpdSound = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%HubHeight = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlAFID not allocated - Int_Xferred = Int_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%BlAFID)) DEALLOCATE(OutData%BlAFID) - ALLOCATE(OutData%BlAFID(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlAFID.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%BlAFID,2), UBOUND(OutData%BlAFID,2) - DO i1 = LBOUND(OutData%BlAFID,1), UBOUND(OutData%BlAFID,1) - OutData%BlAFID(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AFInfo not allocated - Int_Xferred = Int_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%AFInfo)) DEALLOCATE(OutData%AFInfo) - ALLOCATE(OutData%AFInfo(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AFInfo.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%AFInfo,1), UBOUND(OutData%AFInfo,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 AFI_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%AFInfo(i1), ErrStat2, ErrMsg2 ) ! AFInfo - 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 AA_UnPackInitInput - - SUBROUTINE AA_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AA_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(AA_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 = 'AA_CopyInitOutput' -! + ErrMsg = '' + DstBladePropsTypeData%TEThick = SrcBladePropsTypeData%TEThick + DstBladePropsTypeData%TEAngle = SrcBladePropsTypeData%TEAngle +end subroutine + +subroutine AA_DestroyBladePropsType(BladePropsTypeData, ErrStat, ErrMsg) + type(AA_BladePropsType), intent(inout) :: BladePropsTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AA_DestroyBladePropsType' 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 -IF (ALLOCATED(SrcInitOutputData%WriteOutputHdrforPE)) THEN - i1_l = LBOUND(SrcInitOutputData%WriteOutputHdrforPE,1) - i1_u = UBOUND(SrcInitOutputData%WriteOutputHdrforPE,1) - IF (.NOT. ALLOCATED(DstInitOutputData%WriteOutputHdrforPE)) THEN - ALLOCATE(DstInitOutputData%WriteOutputHdrforPE(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputHdrforPE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WriteOutputHdrforPE = SrcInitOutputData%WriteOutputHdrforPE -ENDIF -IF (ALLOCATED(SrcInitOutputData%WriteOutputUntforPE)) THEN - i1_l = LBOUND(SrcInitOutputData%WriteOutputUntforPE,1) - i1_u = UBOUND(SrcInitOutputData%WriteOutputUntforPE,1) - IF (.NOT. ALLOCATED(DstInitOutputData%WriteOutputUntforPE)) THEN - ALLOCATE(DstInitOutputData%WriteOutputUntforPE(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputUntforPE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WriteOutputUntforPE = SrcInitOutputData%WriteOutputUntforPE -ENDIF -IF (ALLOCATED(SrcInitOutputData%WriteOutputHdrSep)) THEN - i1_l = LBOUND(SrcInitOutputData%WriteOutputHdrSep,1) - i1_u = UBOUND(SrcInitOutputData%WriteOutputHdrSep,1) - IF (.NOT. ALLOCATED(DstInitOutputData%WriteOutputHdrSep)) THEN - ALLOCATE(DstInitOutputData%WriteOutputHdrSep(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputHdrSep.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WriteOutputHdrSep = SrcInitOutputData%WriteOutputHdrSep -ENDIF -IF (ALLOCATED(SrcInitOutputData%WriteOutputUntSep)) THEN - i1_l = LBOUND(SrcInitOutputData%WriteOutputUntSep,1) - i1_u = UBOUND(SrcInitOutputData%WriteOutputUntSep,1) - IF (.NOT. ALLOCATED(DstInitOutputData%WriteOutputUntSep)) THEN - ALLOCATE(DstInitOutputData%WriteOutputUntSep(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputUntSep.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WriteOutputUntSep = SrcInitOutputData%WriteOutputUntSep -ENDIF -IF (ALLOCATED(SrcInitOutputData%WriteOutputHdrNodes)) THEN - i1_l = LBOUND(SrcInitOutputData%WriteOutputHdrNodes,1) - i1_u = UBOUND(SrcInitOutputData%WriteOutputHdrNodes,1) - IF (.NOT. ALLOCATED(DstInitOutputData%WriteOutputHdrNodes)) THEN - ALLOCATE(DstInitOutputData%WriteOutputHdrNodes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputHdrNodes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WriteOutputHdrNodes = SrcInitOutputData%WriteOutputHdrNodes -ENDIF -IF (ALLOCATED(SrcInitOutputData%WriteOutputUntNodes)) THEN - i1_l = LBOUND(SrcInitOutputData%WriteOutputUntNodes,1) - i1_u = UBOUND(SrcInitOutputData%WriteOutputUntNodes,1) - IF (.NOT. ALLOCATED(DstInitOutputData%WriteOutputUntNodes)) THEN - ALLOCATE(DstInitOutputData%WriteOutputUntNodes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputUntNodes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WriteOutputUntNodes = SrcInitOutputData%WriteOutputUntNodes -ENDIF - DstInitOutputData%delim = SrcInitOutputData%delim - CALL NWTC_Library_Copyprogdesc( SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstInitOutputData%AirDens = SrcInitOutputData%AirDens - END SUBROUTINE AA_CopyInitOutput - - SUBROUTINE AA_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(AA_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AA_DestroyInitOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(InitOutputData%WriteOutputHdr)) THEN - DEALLOCATE(InitOutputData%WriteOutputHdr) -ENDIF -IF (ALLOCATED(InitOutputData%WriteOutputUnt)) THEN - DEALLOCATE(InitOutputData%WriteOutputUnt) -ENDIF -IF (ALLOCATED(InitOutputData%WriteOutputHdrforPE)) THEN - DEALLOCATE(InitOutputData%WriteOutputHdrforPE) -ENDIF -IF (ALLOCATED(InitOutputData%WriteOutputUntforPE)) THEN - DEALLOCATE(InitOutputData%WriteOutputUntforPE) -ENDIF -IF (ALLOCATED(InitOutputData%WriteOutputHdrSep)) THEN - DEALLOCATE(InitOutputData%WriteOutputHdrSep) -ENDIF -IF (ALLOCATED(InitOutputData%WriteOutputUntSep)) THEN - DEALLOCATE(InitOutputData%WriteOutputUntSep) -ENDIF -IF (ALLOCATED(InitOutputData%WriteOutputHdrNodes)) THEN - DEALLOCATE(InitOutputData%WriteOutputHdrNodes) -ENDIF -IF (ALLOCATED(InitOutputData%WriteOutputUntNodes)) THEN - DEALLOCATE(InitOutputData%WriteOutputUntNodes) -ENDIF - CALL NWTC_Library_Destroyprogdesc( InitOutputData%Ver, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE AA_DestroyInitOutput - - SUBROUTINE AA_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(AA_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 = 'AA_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 - Int_BufSz = Int_BufSz + 1 ! WriteOutputHdrforPE allocated yes/no - IF ( ALLOCATED(InData%WriteOutputHdrforPE) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutputHdrforPE upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%WriteOutputHdrforPE)*LEN(InData%WriteOutputHdrforPE) ! WriteOutputHdrforPE - END IF - Int_BufSz = Int_BufSz + 1 ! WriteOutputUntforPE allocated yes/no - IF ( ALLOCATED(InData%WriteOutputUntforPE) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutputUntforPE upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%WriteOutputUntforPE)*LEN(InData%WriteOutputUntforPE) ! WriteOutputUntforPE - END IF - Int_BufSz = Int_BufSz + 1 ! WriteOutputHdrSep allocated yes/no - IF ( ALLOCATED(InData%WriteOutputHdrSep) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutputHdrSep upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%WriteOutputHdrSep)*LEN(InData%WriteOutputHdrSep) ! WriteOutputHdrSep - END IF - Int_BufSz = Int_BufSz + 1 ! WriteOutputUntSep allocated yes/no - IF ( ALLOCATED(InData%WriteOutputUntSep) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutputUntSep upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%WriteOutputUntSep)*LEN(InData%WriteOutputUntSep) ! WriteOutputUntSep - END IF - Int_BufSz = Int_BufSz + 1 ! WriteOutputHdrNodes allocated yes/no - IF ( ALLOCATED(InData%WriteOutputHdrNodes) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutputHdrNodes upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%WriteOutputHdrNodes)*LEN(InData%WriteOutputHdrNodes) ! WriteOutputHdrNodes - END IF - Int_BufSz = Int_BufSz + 1 ! WriteOutputUntNodes allocated yes/no - IF ( ALLOCATED(InData%WriteOutputUntNodes) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutputUntNodes upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%WriteOutputUntNodes)*LEN(InData%WriteOutputUntNodes) ! WriteOutputUntNodes - END IF - Int_BufSz = Int_BufSz + 1*LEN(InData%delim) ! delim - ! 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 - Re_BufSz = Re_BufSz + 1 ! AirDens - 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 - IF ( .NOT. ALLOCATED(InData%WriteOutputHdrforPE) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutputHdrforPE,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputHdrforPE,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WriteOutputHdrforPE,1), UBOUND(InData%WriteOutputHdrforPE,1) - DO I = 1, LEN(InData%WriteOutputHdrforPE) - IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputHdrforPE(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WriteOutputUntforPE) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutputUntforPE,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputUntforPE,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WriteOutputUntforPE,1), UBOUND(InData%WriteOutputUntforPE,1) - DO I = 1, LEN(InData%WriteOutputUntforPE) - IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputUntforPE(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WriteOutputHdrSep) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutputHdrSep,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputHdrSep,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WriteOutputHdrSep,1), UBOUND(InData%WriteOutputHdrSep,1) - DO I = 1, LEN(InData%WriteOutputHdrSep) - IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputHdrSep(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WriteOutputUntSep) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutputUntSep,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputUntSep,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WriteOutputUntSep,1), UBOUND(InData%WriteOutputUntSep,1) - DO I = 1, LEN(InData%WriteOutputUntSep) - IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputUntSep(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WriteOutputHdrNodes) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutputHdrNodes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputHdrNodes,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WriteOutputHdrNodes,1), UBOUND(InData%WriteOutputHdrNodes,1) - DO I = 1, LEN(InData%WriteOutputHdrNodes) - IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputHdrNodes(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WriteOutputUntNodes) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutputUntNodes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputUntNodes,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WriteOutputUntNodes,1), UBOUND(InData%WriteOutputUntNodes,1) - DO I = 1, LEN(InData%WriteOutputUntNodes) - IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputUntNodes(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - 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 - 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 - ReKiBuf(Re_Xferred) = InData%AirDens - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AA_PackInitOutput - - SUBROUTINE AA_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(AA_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 = 'AA_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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputHdrforPE not allocated - Int_Xferred = Int_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%WriteOutputHdrforPE)) DEALLOCATE(OutData%WriteOutputHdrforPE) - ALLOCATE(OutData%WriteOutputHdrforPE(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdrforPE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WriteOutputHdrforPE,1), UBOUND(OutData%WriteOutputHdrforPE,1) - DO I = 1, LEN(OutData%WriteOutputHdrforPE) - OutData%WriteOutputHdrforPE(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 ! WriteOutputUntforPE not allocated - Int_Xferred = Int_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%WriteOutputUntforPE)) DEALLOCATE(OutData%WriteOutputUntforPE) - ALLOCATE(OutData%WriteOutputUntforPE(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUntforPE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WriteOutputUntforPE,1), UBOUND(OutData%WriteOutputUntforPE,1) - DO I = 1, LEN(OutData%WriteOutputUntforPE) - OutData%WriteOutputUntforPE(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 ! WriteOutputHdrSep not allocated - Int_Xferred = Int_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%WriteOutputHdrSep)) DEALLOCATE(OutData%WriteOutputHdrSep) - ALLOCATE(OutData%WriteOutputHdrSep(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdrSep.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WriteOutputHdrSep,1), UBOUND(OutData%WriteOutputHdrSep,1) - DO I = 1, LEN(OutData%WriteOutputHdrSep) - OutData%WriteOutputHdrSep(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 ! WriteOutputUntSep not allocated - Int_Xferred = Int_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%WriteOutputUntSep)) DEALLOCATE(OutData%WriteOutputUntSep) - ALLOCATE(OutData%WriteOutputUntSep(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUntSep.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WriteOutputUntSep,1), UBOUND(OutData%WriteOutputUntSep,1) - DO I = 1, LEN(OutData%WriteOutputUntSep) - OutData%WriteOutputUntSep(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 ! WriteOutputHdrNodes not allocated - Int_Xferred = Int_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%WriteOutputHdrNodes)) DEALLOCATE(OutData%WriteOutputHdrNodes) - ALLOCATE(OutData%WriteOutputHdrNodes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdrNodes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WriteOutputHdrNodes,1), UBOUND(OutData%WriteOutputHdrNodes,1) - DO I = 1, LEN(OutData%WriteOutputHdrNodes) - OutData%WriteOutputHdrNodes(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 ! WriteOutputUntNodes not allocated - Int_Xferred = Int_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%WriteOutputUntNodes)) DEALLOCATE(OutData%WriteOutputUntNodes) - ALLOCATE(OutData%WriteOutputUntNodes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUntNodes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WriteOutputUntNodes,1), UBOUND(OutData%WriteOutputUntNodes,1) - DO I = 1, LEN(OutData%WriteOutputUntNodes) - OutData%WriteOutputUntNodes(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - 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 - 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%AirDens = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AA_UnPackInitOutput - - SUBROUTINE AA_CopyInputFile( SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AA_InputFile), INTENT(IN) :: SrcInputFileData - TYPE(AA_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 = 'AA_CopyInputFile' -! + ErrMsg = '' +end subroutine + +subroutine AA_PackBladePropsType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(AA_BladePropsType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AA_PackBladePropsType' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%TEThick) + call RegPack(RF, InData%TEAngle) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AA_UnPackBladePropsType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(AA_BladePropsType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AA_UnPackBladePropsType' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%TEThick); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TEAngle); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AA_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) + type(AA_InitInputType), intent(in) :: SrcInitInputData + type(AA_InitInputType), intent(inout) :: DstInitInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AA_CopyInitInput' ErrStat = ErrID_None - ErrMsg = "" - DstInputFileData%DT_AA = SrcInputFileData%DT_AA - DstInputFileData%IBLUNT = SrcInputFileData%IBLUNT - DstInputFileData%ILAM = SrcInputFileData%ILAM - DstInputFileData%ITIP = SrcInputFileData%ITIP - DstInputFileData%ITRIP = SrcInputFileData%ITRIP - DstInputFileData%ITURB = SrcInputFileData%ITURB - DstInputFileData%IInflow = SrcInputFileData%IInflow - DstInputFileData%X_BLMethod = SrcInputFileData%X_BLMethod - DstInputFileData%TICalcMeth = SrcInputFileData%TICalcMeth - DstInputFileData%NReListBL = SrcInputFileData%NReListBL - DstInputFileData%aweightflag = SrcInputFileData%aweightflag - DstInputFileData%ROUND = SrcInputFileData%ROUND - DstInputFileData%ALPRAT = SrcInputFileData%ALPRAT - DstInputFileData%AA_Bl_Prcntge = SrcInputFileData%AA_Bl_Prcntge - DstInputFileData%NrObsLoc = SrcInputFileData%NrObsLoc -IF (ALLOCATED(SrcInputFileData%ObsX)) THEN - i1_l = LBOUND(SrcInputFileData%ObsX,1) - i1_u = UBOUND(SrcInputFileData%ObsX,1) - IF (.NOT. ALLOCATED(DstInputFileData%ObsX)) THEN - ALLOCATE(DstInputFileData%ObsX(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%ObsX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%ObsX = SrcInputFileData%ObsX -ENDIF -IF (ALLOCATED(SrcInputFileData%ObsY)) THEN - i1_l = LBOUND(SrcInputFileData%ObsY,1) - i1_u = UBOUND(SrcInputFileData%ObsY,1) - IF (.NOT. ALLOCATED(DstInputFileData%ObsY)) THEN - ALLOCATE(DstInputFileData%ObsY(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%ObsY.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%ObsY = SrcInputFileData%ObsY -ENDIF -IF (ALLOCATED(SrcInputFileData%ObsZ)) THEN - i1_l = LBOUND(SrcInputFileData%ObsZ,1) - i1_u = UBOUND(SrcInputFileData%ObsZ,1) - IF (.NOT. ALLOCATED(DstInputFileData%ObsZ)) THEN - ALLOCATE(DstInputFileData%ObsZ(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%ObsZ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%ObsZ = SrcInputFileData%ObsZ -ENDIF -IF (ALLOCATED(SrcInputFileData%BladeProps)) THEN - i1_l = LBOUND(SrcInputFileData%BladeProps,1) - i1_u = UBOUND(SrcInputFileData%BladeProps,1) - IF (.NOT. ALLOCATED(DstInputFileData%BladeProps)) THEN - ALLOCATE(DstInputFileData%BladeProps(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%BladeProps.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcInputFileData%BladeProps,1), UBOUND(SrcInputFileData%BladeProps,1) - CALL AA_Copybladepropstype( SrcInputFileData%BladeProps(i1), DstInputFileData%BladeProps(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - DstInputFileData%NrOutFile = SrcInputFileData%NrOutFile -IF (ALLOCATED(SrcInputFileData%AAoutfile)) THEN - i1_l = LBOUND(SrcInputFileData%AAoutfile,1) - i1_u = UBOUND(SrcInputFileData%AAoutfile,1) - IF (.NOT. ALLOCATED(DstInputFileData%AAoutfile)) THEN - ALLOCATE(DstInputFileData%AAoutfile(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%AAoutfile.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%AAoutfile = SrcInputFileData%AAoutfile -ENDIF - DstInputFileData%TICalcTabFile = SrcInputFileData%TICalcTabFile - DstInputFileData%FTitle = SrcInputFileData%FTitle - DstInputFileData%AAStart = SrcInputFileData%AAStart - DstInputFileData%Lturb = SrcInputFileData%Lturb - DstInputFileData%AvgV = SrcInputFileData%AvgV -IF (ALLOCATED(SrcInputFileData%ReListBL)) THEN - i1_l = LBOUND(SrcInputFileData%ReListBL,1) - i1_u = UBOUND(SrcInputFileData%ReListBL,1) - IF (.NOT. ALLOCATED(DstInputFileData%ReListBL)) THEN - ALLOCATE(DstInputFileData%ReListBL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%ReListBL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%ReListBL = SrcInputFileData%ReListBL -ENDIF -IF (ALLOCATED(SrcInputFileData%AoAListBL)) THEN - i1_l = LBOUND(SrcInputFileData%AoAListBL,1) - i1_u = UBOUND(SrcInputFileData%AoAListBL,1) - IF (.NOT. ALLOCATED(DstInputFileData%AoAListBL)) THEN - ALLOCATE(DstInputFileData%AoAListBL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%AoAListBL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%AoAListBL = SrcInputFileData%AoAListBL -ENDIF -IF (ALLOCATED(SrcInputFileData%Pres_DispThick)) THEN - i1_l = LBOUND(SrcInputFileData%Pres_DispThick,1) - i1_u = UBOUND(SrcInputFileData%Pres_DispThick,1) - i2_l = LBOUND(SrcInputFileData%Pres_DispThick,2) - i2_u = UBOUND(SrcInputFileData%Pres_DispThick,2) - i3_l = LBOUND(SrcInputFileData%Pres_DispThick,3) - i3_u = UBOUND(SrcInputFileData%Pres_DispThick,3) - IF (.NOT. ALLOCATED(DstInputFileData%Pres_DispThick)) THEN - ALLOCATE(DstInputFileData%Pres_DispThick(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%Pres_DispThick.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%Pres_DispThick = SrcInputFileData%Pres_DispThick -ENDIF -IF (ALLOCATED(SrcInputFileData%Suct_DispThick)) THEN - i1_l = LBOUND(SrcInputFileData%Suct_DispThick,1) - i1_u = UBOUND(SrcInputFileData%Suct_DispThick,1) - i2_l = LBOUND(SrcInputFileData%Suct_DispThick,2) - i2_u = UBOUND(SrcInputFileData%Suct_DispThick,2) - i3_l = LBOUND(SrcInputFileData%Suct_DispThick,3) - i3_u = UBOUND(SrcInputFileData%Suct_DispThick,3) - IF (.NOT. ALLOCATED(DstInputFileData%Suct_DispThick)) THEN - ALLOCATE(DstInputFileData%Suct_DispThick(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%Suct_DispThick.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%Suct_DispThick = SrcInputFileData%Suct_DispThick -ENDIF -IF (ALLOCATED(SrcInputFileData%Pres_BLThick)) THEN - i1_l = LBOUND(SrcInputFileData%Pres_BLThick,1) - i1_u = UBOUND(SrcInputFileData%Pres_BLThick,1) - i2_l = LBOUND(SrcInputFileData%Pres_BLThick,2) - i2_u = UBOUND(SrcInputFileData%Pres_BLThick,2) - i3_l = LBOUND(SrcInputFileData%Pres_BLThick,3) - i3_u = UBOUND(SrcInputFileData%Pres_BLThick,3) - IF (.NOT. ALLOCATED(DstInputFileData%Pres_BLThick)) THEN - ALLOCATE(DstInputFileData%Pres_BLThick(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%Pres_BLThick.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%Pres_BLThick = SrcInputFileData%Pres_BLThick -ENDIF -IF (ALLOCATED(SrcInputFileData%Suct_BLThick)) THEN - i1_l = LBOUND(SrcInputFileData%Suct_BLThick,1) - i1_u = UBOUND(SrcInputFileData%Suct_BLThick,1) - i2_l = LBOUND(SrcInputFileData%Suct_BLThick,2) - i2_u = UBOUND(SrcInputFileData%Suct_BLThick,2) - i3_l = LBOUND(SrcInputFileData%Suct_BLThick,3) - i3_u = UBOUND(SrcInputFileData%Suct_BLThick,3) - IF (.NOT. ALLOCATED(DstInputFileData%Suct_BLThick)) THEN - ALLOCATE(DstInputFileData%Suct_BLThick(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%Suct_BLThick.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%Suct_BLThick = SrcInputFileData%Suct_BLThick -ENDIF -IF (ALLOCATED(SrcInputFileData%Pres_Cf)) THEN - i1_l = LBOUND(SrcInputFileData%Pres_Cf,1) - i1_u = UBOUND(SrcInputFileData%Pres_Cf,1) - i2_l = LBOUND(SrcInputFileData%Pres_Cf,2) - i2_u = UBOUND(SrcInputFileData%Pres_Cf,2) - i3_l = LBOUND(SrcInputFileData%Pres_Cf,3) - i3_u = UBOUND(SrcInputFileData%Pres_Cf,3) - IF (.NOT. ALLOCATED(DstInputFileData%Pres_Cf)) THEN - ALLOCATE(DstInputFileData%Pres_Cf(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%Pres_Cf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%Pres_Cf = SrcInputFileData%Pres_Cf -ENDIF -IF (ALLOCATED(SrcInputFileData%Suct_Cf)) THEN - i1_l = LBOUND(SrcInputFileData%Suct_Cf,1) - i1_u = UBOUND(SrcInputFileData%Suct_Cf,1) - i2_l = LBOUND(SrcInputFileData%Suct_Cf,2) - i2_u = UBOUND(SrcInputFileData%Suct_Cf,2) - i3_l = LBOUND(SrcInputFileData%Suct_Cf,3) - i3_u = UBOUND(SrcInputFileData%Suct_Cf,3) - IF (.NOT. ALLOCATED(DstInputFileData%Suct_Cf)) THEN - ALLOCATE(DstInputFileData%Suct_Cf(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%Suct_Cf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%Suct_Cf = SrcInputFileData%Suct_Cf -ENDIF -IF (ALLOCATED(SrcInputFileData%Pres_EdgeVelRat)) THEN - i1_l = LBOUND(SrcInputFileData%Pres_EdgeVelRat,1) - i1_u = UBOUND(SrcInputFileData%Pres_EdgeVelRat,1) - i2_l = LBOUND(SrcInputFileData%Pres_EdgeVelRat,2) - i2_u = UBOUND(SrcInputFileData%Pres_EdgeVelRat,2) - i3_l = LBOUND(SrcInputFileData%Pres_EdgeVelRat,3) - i3_u = UBOUND(SrcInputFileData%Pres_EdgeVelRat,3) - IF (.NOT. ALLOCATED(DstInputFileData%Pres_EdgeVelRat)) THEN - ALLOCATE(DstInputFileData%Pres_EdgeVelRat(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%Pres_EdgeVelRat.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%Pres_EdgeVelRat = SrcInputFileData%Pres_EdgeVelRat -ENDIF -IF (ALLOCATED(SrcInputFileData%Suct_EdgeVelRat)) THEN - i1_l = LBOUND(SrcInputFileData%Suct_EdgeVelRat,1) - i1_u = UBOUND(SrcInputFileData%Suct_EdgeVelRat,1) - i2_l = LBOUND(SrcInputFileData%Suct_EdgeVelRat,2) - i2_u = UBOUND(SrcInputFileData%Suct_EdgeVelRat,2) - i3_l = LBOUND(SrcInputFileData%Suct_EdgeVelRat,3) - i3_u = UBOUND(SrcInputFileData%Suct_EdgeVelRat,3) - IF (.NOT. ALLOCATED(DstInputFileData%Suct_EdgeVelRat)) THEN - ALLOCATE(DstInputFileData%Suct_EdgeVelRat(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%Suct_EdgeVelRat.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%Suct_EdgeVelRat = SrcInputFileData%Suct_EdgeVelRat -ENDIF -IF (ALLOCATED(SrcInputFileData%TI_Grid_In)) THEN - i1_l = LBOUND(SrcInputFileData%TI_Grid_In,1) - i1_u = UBOUND(SrcInputFileData%TI_Grid_In,1) - i2_l = LBOUND(SrcInputFileData%TI_Grid_In,2) - i2_u = UBOUND(SrcInputFileData%TI_Grid_In,2) - IF (.NOT. ALLOCATED(DstInputFileData%TI_Grid_In)) THEN - ALLOCATE(DstInputFileData%TI_Grid_In(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%TI_Grid_In.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%TI_Grid_In = SrcInputFileData%TI_Grid_In -ENDIF - DstInputFileData%dz_turb_in = SrcInputFileData%dz_turb_in - DstInputFileData%dy_turb_in = SrcInputFileData%dy_turb_in - END SUBROUTINE AA_CopyInputFile - - SUBROUTINE AA_DestroyInputFile( InputFileData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(AA_InputFile), INTENT(INOUT) :: InputFileData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AA_DestroyInputFile' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(InputFileData%ObsX)) THEN - DEALLOCATE(InputFileData%ObsX) -ENDIF -IF (ALLOCATED(InputFileData%ObsY)) THEN - DEALLOCATE(InputFileData%ObsY) -ENDIF -IF (ALLOCATED(InputFileData%ObsZ)) THEN - DEALLOCATE(InputFileData%ObsZ) -ENDIF -IF (ALLOCATED(InputFileData%BladeProps)) THEN -DO i1 = LBOUND(InputFileData%BladeProps,1), UBOUND(InputFileData%BladeProps,1) - CALL AA_Destroybladepropstype( InputFileData%BladeProps(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(InputFileData%BladeProps) -ENDIF -IF (ALLOCATED(InputFileData%AAoutfile)) THEN - DEALLOCATE(InputFileData%AAoutfile) -ENDIF -IF (ALLOCATED(InputFileData%ReListBL)) THEN - DEALLOCATE(InputFileData%ReListBL) -ENDIF -IF (ALLOCATED(InputFileData%AoAListBL)) THEN - DEALLOCATE(InputFileData%AoAListBL) -ENDIF -IF (ALLOCATED(InputFileData%Pres_DispThick)) THEN - DEALLOCATE(InputFileData%Pres_DispThick) -ENDIF -IF (ALLOCATED(InputFileData%Suct_DispThick)) THEN - DEALLOCATE(InputFileData%Suct_DispThick) -ENDIF -IF (ALLOCATED(InputFileData%Pres_BLThick)) THEN - DEALLOCATE(InputFileData%Pres_BLThick) -ENDIF -IF (ALLOCATED(InputFileData%Suct_BLThick)) THEN - DEALLOCATE(InputFileData%Suct_BLThick) -ENDIF -IF (ALLOCATED(InputFileData%Pres_Cf)) THEN - DEALLOCATE(InputFileData%Pres_Cf) -ENDIF -IF (ALLOCATED(InputFileData%Suct_Cf)) THEN - DEALLOCATE(InputFileData%Suct_Cf) -ENDIF -IF (ALLOCATED(InputFileData%Pres_EdgeVelRat)) THEN - DEALLOCATE(InputFileData%Pres_EdgeVelRat) -ENDIF -IF (ALLOCATED(InputFileData%Suct_EdgeVelRat)) THEN - DEALLOCATE(InputFileData%Suct_EdgeVelRat) -ENDIF -IF (ALLOCATED(InputFileData%TI_Grid_In)) THEN - DEALLOCATE(InputFileData%TI_Grid_In) -ENDIF - END SUBROUTINE AA_DestroyInputFile - - SUBROUTINE AA_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(AA_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 = 'AA_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_AA - Int_BufSz = Int_BufSz + 1 ! IBLUNT - Int_BufSz = Int_BufSz + 1 ! ILAM - Int_BufSz = Int_BufSz + 1 ! ITIP - Int_BufSz = Int_BufSz + 1 ! ITRIP - Int_BufSz = Int_BufSz + 1 ! ITURB - Int_BufSz = Int_BufSz + 1 ! IInflow - Int_BufSz = Int_BufSz + 1 ! X_BLMethod - Int_BufSz = Int_BufSz + 1 ! TICalcMeth - Int_BufSz = Int_BufSz + 1 ! NReListBL - Int_BufSz = Int_BufSz + 1 ! aweightflag - Int_BufSz = Int_BufSz + 1 ! ROUND - Re_BufSz = Re_BufSz + 1 ! ALPRAT - Int_BufSz = Int_BufSz + 1 ! AA_Bl_Prcntge - Int_BufSz = Int_BufSz + 1 ! NrObsLoc - Int_BufSz = Int_BufSz + 1 ! ObsX allocated yes/no - IF ( ALLOCATED(InData%ObsX) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ObsX upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%ObsX) ! ObsX - END IF - Int_BufSz = Int_BufSz + 1 ! ObsY allocated yes/no - IF ( ALLOCATED(InData%ObsY) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ObsY upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%ObsY) ! ObsY - END IF - Int_BufSz = Int_BufSz + 1 ! ObsZ allocated yes/no - IF ( ALLOCATED(InData%ObsZ) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ObsZ upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%ObsZ) ! ObsZ - END IF - Int_BufSz = Int_BufSz + 1 ! BladeProps allocated yes/no - IF ( ALLOCATED(InData%BladeProps) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BladeProps upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%BladeProps,1), UBOUND(InData%BladeProps,1) - Int_BufSz = Int_BufSz + 3 ! BladeProps: size of buffers for each call to pack subtype - CALL AA_Packbladepropstype( Re_Buf, Db_Buf, Int_Buf, InData%BladeProps(i1), ErrStat2, ErrMsg2, .TRUE. ) ! BladeProps - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BladeProps - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BladeProps - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BladeProps - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! NrOutFile - Int_BufSz = Int_BufSz + 1 ! AAoutfile allocated yes/no - IF ( ALLOCATED(InData%AAoutfile) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! AAoutfile upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%AAoutfile)*LEN(InData%AAoutfile) ! AAoutfile - END IF - Int_BufSz = Int_BufSz + 1*LEN(InData%TICalcTabFile) ! TICalcTabFile - Int_BufSz = Int_BufSz + 1*LEN(InData%FTitle) ! FTitle - Db_BufSz = Db_BufSz + 1 ! AAStart - Re_BufSz = Re_BufSz + 1 ! Lturb - Re_BufSz = Re_BufSz + 1 ! AvgV - Int_BufSz = Int_BufSz + 1 ! ReListBL allocated yes/no - IF ( ALLOCATED(InData%ReListBL) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ReListBL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%ReListBL) ! ReListBL - END IF - Int_BufSz = Int_BufSz + 1 ! AoAListBL allocated yes/no - IF ( ALLOCATED(InData%AoAListBL) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! AoAListBL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AoAListBL) ! AoAListBL - END IF - Int_BufSz = Int_BufSz + 1 ! Pres_DispThick allocated yes/no - IF ( ALLOCATED(InData%Pres_DispThick) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Pres_DispThick upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Pres_DispThick) ! Pres_DispThick - END IF - Int_BufSz = Int_BufSz + 1 ! Suct_DispThick allocated yes/no - IF ( ALLOCATED(InData%Suct_DispThick) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Suct_DispThick upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Suct_DispThick) ! Suct_DispThick - END IF - Int_BufSz = Int_BufSz + 1 ! Pres_BLThick allocated yes/no - IF ( ALLOCATED(InData%Pres_BLThick) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Pres_BLThick upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Pres_BLThick) ! Pres_BLThick - END IF - Int_BufSz = Int_BufSz + 1 ! Suct_BLThick allocated yes/no - IF ( ALLOCATED(InData%Suct_BLThick) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Suct_BLThick upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Suct_BLThick) ! Suct_BLThick - END IF - Int_BufSz = Int_BufSz + 1 ! Pres_Cf allocated yes/no - IF ( ALLOCATED(InData%Pres_Cf) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Pres_Cf upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Pres_Cf) ! Pres_Cf - END IF - Int_BufSz = Int_BufSz + 1 ! Suct_Cf allocated yes/no - IF ( ALLOCATED(InData%Suct_Cf) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Suct_Cf upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Suct_Cf) ! Suct_Cf - END IF - Int_BufSz = Int_BufSz + 1 ! Pres_EdgeVelRat allocated yes/no - IF ( ALLOCATED(InData%Pres_EdgeVelRat) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Pres_EdgeVelRat upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Pres_EdgeVelRat) ! Pres_EdgeVelRat - END IF - Int_BufSz = Int_BufSz + 1 ! Suct_EdgeVelRat allocated yes/no - IF ( ALLOCATED(InData%Suct_EdgeVelRat) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Suct_EdgeVelRat upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Suct_EdgeVelRat) ! Suct_EdgeVelRat - END IF - Int_BufSz = Int_BufSz + 1 ! TI_Grid_In allocated yes/no - IF ( ALLOCATED(InData%TI_Grid_In) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! TI_Grid_In upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TI_Grid_In) ! TI_Grid_In - END IF - Re_BufSz = Re_BufSz + 1 ! dz_turb_in - Re_BufSz = Re_BufSz + 1 ! dy_turb_in - 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_AA - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%IBLUNT - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%ILAM - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%ITIP - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%ITRIP - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%ITURB - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%IInflow - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%X_BLMethod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%TICalcMeth - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NReListBL - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%aweightflag, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%ROUND, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%ALPRAT - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%AA_Bl_Prcntge - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NrObsLoc - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%ObsX) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ObsX,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ObsX,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ObsX,1), UBOUND(InData%ObsX,1) - ReKiBuf(Re_Xferred) = InData%ObsX(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ObsY) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ObsY,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ObsY,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ObsY,1), UBOUND(InData%ObsY,1) - ReKiBuf(Re_Xferred) = InData%ObsY(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ObsZ) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ObsZ,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ObsZ,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ObsZ,1), UBOUND(InData%ObsZ,1) - ReKiBuf(Re_Xferred) = InData%ObsZ(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BladeProps) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BladeProps,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BladeProps,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BladeProps,1), UBOUND(InData%BladeProps,1) - CALL AA_Packbladepropstype( Re_Buf, Db_Buf, Int_Buf, InData%BladeProps(i1), ErrStat2, ErrMsg2, OnlySize ) ! BladeProps - 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%NrOutFile - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%AAoutfile) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AAoutfile,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AAoutfile,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%AAoutfile,1), UBOUND(InData%AAoutfile,1) - DO I = 1, LEN(InData%AAoutfile) - IntKiBuf(Int_Xferred) = ICHAR(InData%AAoutfile(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - DO I = 1, LEN(InData%TICalcTabFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%TICalcTabFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%FTitle) - IntKiBuf(Int_Xferred) = ICHAR(InData%FTitle(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DbKiBuf(Db_Xferred) = InData%AAStart - Db_Xferred = Db_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Lturb - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%AvgV - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%ReListBL) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ReListBL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ReListBL,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ReListBL,1), UBOUND(InData%ReListBL,1) - ReKiBuf(Re_Xferred) = InData%ReListBL(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AoAListBL) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AoAListBL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AoAListBL,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%AoAListBL,1), UBOUND(InData%AoAListBL,1) - ReKiBuf(Re_Xferred) = InData%AoAListBL(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Pres_DispThick) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Pres_DispThick,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Pres_DispThick,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Pres_DispThick,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Pres_DispThick,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Pres_DispThick,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Pres_DispThick,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Pres_DispThick,3), UBOUND(InData%Pres_DispThick,3) - DO i2 = LBOUND(InData%Pres_DispThick,2), UBOUND(InData%Pres_DispThick,2) - DO i1 = LBOUND(InData%Pres_DispThick,1), UBOUND(InData%Pres_DispThick,1) - ReKiBuf(Re_Xferred) = InData%Pres_DispThick(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Suct_DispThick) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Suct_DispThick,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Suct_DispThick,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Suct_DispThick,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Suct_DispThick,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Suct_DispThick,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Suct_DispThick,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Suct_DispThick,3), UBOUND(InData%Suct_DispThick,3) - DO i2 = LBOUND(InData%Suct_DispThick,2), UBOUND(InData%Suct_DispThick,2) - DO i1 = LBOUND(InData%Suct_DispThick,1), UBOUND(InData%Suct_DispThick,1) - ReKiBuf(Re_Xferred) = InData%Suct_DispThick(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Pres_BLThick) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Pres_BLThick,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Pres_BLThick,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Pres_BLThick,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Pres_BLThick,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Pres_BLThick,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Pres_BLThick,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Pres_BLThick,3), UBOUND(InData%Pres_BLThick,3) - DO i2 = LBOUND(InData%Pres_BLThick,2), UBOUND(InData%Pres_BLThick,2) - DO i1 = LBOUND(InData%Pres_BLThick,1), UBOUND(InData%Pres_BLThick,1) - ReKiBuf(Re_Xferred) = InData%Pres_BLThick(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Suct_BLThick) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Suct_BLThick,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Suct_BLThick,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Suct_BLThick,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Suct_BLThick,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Suct_BLThick,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Suct_BLThick,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Suct_BLThick,3), UBOUND(InData%Suct_BLThick,3) - DO i2 = LBOUND(InData%Suct_BLThick,2), UBOUND(InData%Suct_BLThick,2) - DO i1 = LBOUND(InData%Suct_BLThick,1), UBOUND(InData%Suct_BLThick,1) - ReKiBuf(Re_Xferred) = InData%Suct_BLThick(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Pres_Cf) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Pres_Cf,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Pres_Cf,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Pres_Cf,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Pres_Cf,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Pres_Cf,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Pres_Cf,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Pres_Cf,3), UBOUND(InData%Pres_Cf,3) - DO i2 = LBOUND(InData%Pres_Cf,2), UBOUND(InData%Pres_Cf,2) - DO i1 = LBOUND(InData%Pres_Cf,1), UBOUND(InData%Pres_Cf,1) - ReKiBuf(Re_Xferred) = InData%Pres_Cf(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Suct_Cf) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Suct_Cf,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Suct_Cf,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Suct_Cf,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Suct_Cf,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Suct_Cf,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Suct_Cf,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Suct_Cf,3), UBOUND(InData%Suct_Cf,3) - DO i2 = LBOUND(InData%Suct_Cf,2), UBOUND(InData%Suct_Cf,2) - DO i1 = LBOUND(InData%Suct_Cf,1), UBOUND(InData%Suct_Cf,1) - ReKiBuf(Re_Xferred) = InData%Suct_Cf(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Pres_EdgeVelRat) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Pres_EdgeVelRat,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Pres_EdgeVelRat,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Pres_EdgeVelRat,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Pres_EdgeVelRat,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Pres_EdgeVelRat,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Pres_EdgeVelRat,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Pres_EdgeVelRat,3), UBOUND(InData%Pres_EdgeVelRat,3) - DO i2 = LBOUND(InData%Pres_EdgeVelRat,2), UBOUND(InData%Pres_EdgeVelRat,2) - DO i1 = LBOUND(InData%Pres_EdgeVelRat,1), UBOUND(InData%Pres_EdgeVelRat,1) - ReKiBuf(Re_Xferred) = InData%Pres_EdgeVelRat(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Suct_EdgeVelRat) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Suct_EdgeVelRat,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Suct_EdgeVelRat,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Suct_EdgeVelRat,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Suct_EdgeVelRat,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Suct_EdgeVelRat,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Suct_EdgeVelRat,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Suct_EdgeVelRat,3), UBOUND(InData%Suct_EdgeVelRat,3) - DO i2 = LBOUND(InData%Suct_EdgeVelRat,2), UBOUND(InData%Suct_EdgeVelRat,2) - DO i1 = LBOUND(InData%Suct_EdgeVelRat,1), UBOUND(InData%Suct_EdgeVelRat,1) - ReKiBuf(Re_Xferred) = InData%Suct_EdgeVelRat(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TI_Grid_In) ) THEN - 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_Grid_In,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TI_Grid_In,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TI_Grid_In,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TI_Grid_In,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%TI_Grid_In,2), UBOUND(InData%TI_Grid_In,2) - DO i1 = LBOUND(InData%TI_Grid_In,1), UBOUND(InData%TI_Grid_In,1) - ReKiBuf(Re_Xferred) = InData%TI_Grid_In(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - ReKiBuf(Re_Xferred) = InData%dz_turb_in - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%dy_turb_in - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AA_PackInputFile - - SUBROUTINE AA_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(AA_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 = 'AA_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_AA = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%IBLUNT = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%ILAM = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%ITIP = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%ITRIP = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%ITURB = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%IInflow = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%X_BLMethod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TICalcMeth = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NReListBL = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%aweightflag = TRANSFER(IntKiBuf(Int_Xferred), OutData%aweightflag) - Int_Xferred = Int_Xferred + 1 - OutData%ROUND = TRANSFER(IntKiBuf(Int_Xferred), OutData%ROUND) - Int_Xferred = Int_Xferred + 1 - OutData%ALPRAT = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%AA_Bl_Prcntge = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NrObsLoc = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ObsX not allocated - Int_Xferred = Int_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%ObsX)) DEALLOCATE(OutData%ObsX) - ALLOCATE(OutData%ObsX(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ObsX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ObsX,1), UBOUND(OutData%ObsX,1) - OutData%ObsX(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ObsY not allocated - Int_Xferred = Int_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%ObsY)) DEALLOCATE(OutData%ObsY) - ALLOCATE(OutData%ObsY(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ObsY.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ObsY,1), UBOUND(OutData%ObsY,1) - OutData%ObsY(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ObsZ not allocated - Int_Xferred = Int_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%ObsZ)) DEALLOCATE(OutData%ObsZ) - ALLOCATE(OutData%ObsZ(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ObsZ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ObsZ,1), UBOUND(OutData%ObsZ,1) - OutData%ObsZ(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BladeProps not allocated - Int_Xferred = Int_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%BladeProps)) DEALLOCATE(OutData%BladeProps) - ALLOCATE(OutData%BladeProps(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeProps.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BladeProps,1), UBOUND(OutData%BladeProps,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 AA_Unpackbladepropstype( Re_Buf, Db_Buf, Int_Buf, OutData%BladeProps(i1), ErrStat2, ErrMsg2 ) ! BladeProps - 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%NrOutFile = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AAoutfile not allocated - Int_Xferred = Int_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%AAoutfile)) DEALLOCATE(OutData%AAoutfile) - ALLOCATE(OutData%AAoutfile(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AAoutfile.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%AAoutfile,1), UBOUND(OutData%AAoutfile,1) - DO I = 1, LEN(OutData%AAoutfile) - OutData%AAoutfile(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - DO I = 1, LEN(OutData%TICalcTabFile) - OutData%TICalcTabFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%FTitle) - OutData%FTitle(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%AAStart = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%Lturb = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%AvgV = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ReListBL not allocated - Int_Xferred = Int_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%ReListBL)) DEALLOCATE(OutData%ReListBL) - ALLOCATE(OutData%ReListBL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ReListBL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ReListBL,1), UBOUND(OutData%ReListBL,1) - OutData%ReListBL(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AoAListBL not allocated - Int_Xferred = Int_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%AoAListBL)) DEALLOCATE(OutData%AoAListBL) - ALLOCATE(OutData%AoAListBL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AoAListBL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%AoAListBL,1), UBOUND(OutData%AoAListBL,1) - OutData%AoAListBL(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Pres_DispThick not allocated - Int_Xferred = Int_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%Pres_DispThick)) DEALLOCATE(OutData%Pres_DispThick) - ALLOCATE(OutData%Pres_DispThick(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%Pres_DispThick.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Pres_DispThick,3), UBOUND(OutData%Pres_DispThick,3) - DO i2 = LBOUND(OutData%Pres_DispThick,2), UBOUND(OutData%Pres_DispThick,2) - DO i1 = LBOUND(OutData%Pres_DispThick,1), UBOUND(OutData%Pres_DispThick,1) - OutData%Pres_DispThick(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 ! Suct_DispThick not allocated - Int_Xferred = Int_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%Suct_DispThick)) DEALLOCATE(OutData%Suct_DispThick) - ALLOCATE(OutData%Suct_DispThick(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%Suct_DispThick.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Suct_DispThick,3), UBOUND(OutData%Suct_DispThick,3) - DO i2 = LBOUND(OutData%Suct_DispThick,2), UBOUND(OutData%Suct_DispThick,2) - DO i1 = LBOUND(OutData%Suct_DispThick,1), UBOUND(OutData%Suct_DispThick,1) - OutData%Suct_DispThick(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 ! Pres_BLThick not allocated - Int_Xferred = Int_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%Pres_BLThick)) DEALLOCATE(OutData%Pres_BLThick) - ALLOCATE(OutData%Pres_BLThick(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%Pres_BLThick.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Pres_BLThick,3), UBOUND(OutData%Pres_BLThick,3) - DO i2 = LBOUND(OutData%Pres_BLThick,2), UBOUND(OutData%Pres_BLThick,2) - DO i1 = LBOUND(OutData%Pres_BLThick,1), UBOUND(OutData%Pres_BLThick,1) - OutData%Pres_BLThick(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 ! Suct_BLThick not allocated - Int_Xferred = Int_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%Suct_BLThick)) DEALLOCATE(OutData%Suct_BLThick) - ALLOCATE(OutData%Suct_BLThick(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%Suct_BLThick.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Suct_BLThick,3), UBOUND(OutData%Suct_BLThick,3) - DO i2 = LBOUND(OutData%Suct_BLThick,2), UBOUND(OutData%Suct_BLThick,2) - DO i1 = LBOUND(OutData%Suct_BLThick,1), UBOUND(OutData%Suct_BLThick,1) - OutData%Suct_BLThick(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 ! Pres_Cf not allocated - Int_Xferred = Int_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%Pres_Cf)) DEALLOCATE(OutData%Pres_Cf) - ALLOCATE(OutData%Pres_Cf(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%Pres_Cf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Pres_Cf,3), UBOUND(OutData%Pres_Cf,3) - DO i2 = LBOUND(OutData%Pres_Cf,2), UBOUND(OutData%Pres_Cf,2) - DO i1 = LBOUND(OutData%Pres_Cf,1), UBOUND(OutData%Pres_Cf,1) - OutData%Pres_Cf(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 ! Suct_Cf not allocated - Int_Xferred = Int_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%Suct_Cf)) DEALLOCATE(OutData%Suct_Cf) - ALLOCATE(OutData%Suct_Cf(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%Suct_Cf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Suct_Cf,3), UBOUND(OutData%Suct_Cf,3) - DO i2 = LBOUND(OutData%Suct_Cf,2), UBOUND(OutData%Suct_Cf,2) - DO i1 = LBOUND(OutData%Suct_Cf,1), UBOUND(OutData%Suct_Cf,1) - OutData%Suct_Cf(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 ! Pres_EdgeVelRat not allocated - Int_Xferred = Int_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%Pres_EdgeVelRat)) DEALLOCATE(OutData%Pres_EdgeVelRat) - ALLOCATE(OutData%Pres_EdgeVelRat(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%Pres_EdgeVelRat.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Pres_EdgeVelRat,3), UBOUND(OutData%Pres_EdgeVelRat,3) - DO i2 = LBOUND(OutData%Pres_EdgeVelRat,2), UBOUND(OutData%Pres_EdgeVelRat,2) - DO i1 = LBOUND(OutData%Pres_EdgeVelRat,1), UBOUND(OutData%Pres_EdgeVelRat,1) - OutData%Pres_EdgeVelRat(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 ! Suct_EdgeVelRat not allocated - Int_Xferred = Int_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%Suct_EdgeVelRat)) DEALLOCATE(OutData%Suct_EdgeVelRat) - ALLOCATE(OutData%Suct_EdgeVelRat(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%Suct_EdgeVelRat.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Suct_EdgeVelRat,3), UBOUND(OutData%Suct_EdgeVelRat,3) - DO i2 = LBOUND(OutData%Suct_EdgeVelRat,2), UBOUND(OutData%Suct_EdgeVelRat,2) - DO i1 = LBOUND(OutData%Suct_EdgeVelRat,1), UBOUND(OutData%Suct_EdgeVelRat,1) - OutData%Suct_EdgeVelRat(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 ! TI_Grid_In not allocated - Int_Xferred = Int_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_Grid_In)) DEALLOCATE(OutData%TI_Grid_In) - ALLOCATE(OutData%TI_Grid_In(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TI_Grid_In.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%TI_Grid_In,2), UBOUND(OutData%TI_Grid_In,2) - DO i1 = LBOUND(OutData%TI_Grid_In,1), UBOUND(OutData%TI_Grid_In,1) - OutData%TI_Grid_In(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%dz_turb_in = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%dy_turb_in = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AA_UnPackInputFile - - SUBROUTINE AA_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AA_ContinuousStateType), INTENT(IN) :: SrcContStateData - TYPE(AA_ContinuousStateType), INTENT(INOUT) :: DstContStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AA_CopyContState' -! + ErrMsg = '' + DstInitInputData%InputFile = SrcInitInputData%InputFile + DstInitInputData%NumBlades = SrcInitInputData%NumBlades + DstInitInputData%NumBlNds = SrcInitInputData%NumBlNds + DstInitInputData%RootName = SrcInitInputData%RootName + if (allocated(SrcInitInputData%BlSpn)) then + LB(1:2) = lbound(SrcInitInputData%BlSpn) + UB(1:2) = ubound(SrcInitInputData%BlSpn) + if (.not. allocated(DstInitInputData%BlSpn)) then + allocate(DstInitInputData%BlSpn(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%BlSpn.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%BlSpn = SrcInitInputData%BlSpn + end if + if (allocated(SrcInitInputData%BlChord)) then + LB(1:2) = lbound(SrcInitInputData%BlChord) + UB(1:2) = ubound(SrcInitInputData%BlChord) + if (.not. allocated(DstInitInputData%BlChord)) then + allocate(DstInitInputData%BlChord(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%BlChord.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%BlChord = SrcInitInputData%BlChord + end if + DstInitInputData%AirDens = SrcInitInputData%AirDens + DstInitInputData%KinVisc = SrcInitInputData%KinVisc + DstInitInputData%SpdSound = SrcInitInputData%SpdSound + DstInitInputData%HubHeight = SrcInitInputData%HubHeight + if (allocated(SrcInitInputData%BlAFID)) then + LB(1:2) = lbound(SrcInitInputData%BlAFID) + UB(1:2) = ubound(SrcInitInputData%BlAFID) + if (.not. allocated(DstInitInputData%BlAFID)) then + allocate(DstInitInputData%BlAFID(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%BlAFID.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%BlAFID = SrcInitInputData%BlAFID + end if + if (allocated(SrcInitInputData%AFInfo)) then + LB(1:1) = lbound(SrcInitInputData%AFInfo) + UB(1:1) = ubound(SrcInitInputData%AFInfo) + if (.not. allocated(DstInitInputData%AFInfo)) then + allocate(DstInitInputData%AFInfo(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%AFInfo.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AFI_CopyParam(SrcInitInputData%AFInfo(i1), DstInitInputData%AFInfo(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if +end subroutine + +subroutine AA_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(AA_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AA_DestroyInitInput' ErrStat = ErrID_None - ErrMsg = "" - DstContStateData%DummyContState = SrcContStateData%DummyContState - END SUBROUTINE AA_CopyContState - - SUBROUTINE AA_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(AA_ContinuousStateType), INTENT(INOUT) :: ContStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AA_DestroyContState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE AA_DestroyContState - - SUBROUTINE AA_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(AA_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 = 'AA_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 AA_PackContState - - SUBROUTINE AA_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(AA_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 = 'AA_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 = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AA_UnPackContState - - SUBROUTINE AA_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AA_DiscreteStateType), INTENT(IN) :: SrcDiscStateData - TYPE(AA_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) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AA_CopyDiscState' -! + ErrMsg = '' + if (allocated(InitInputData%BlSpn)) then + deallocate(InitInputData%BlSpn) + end if + if (allocated(InitInputData%BlChord)) then + deallocate(InitInputData%BlChord) + end if + if (allocated(InitInputData%BlAFID)) then + deallocate(InitInputData%BlAFID) + end if + if (allocated(InitInputData%AFInfo)) then + LB(1:1) = lbound(InitInputData%AFInfo) + UB(1:1) = ubound(InitInputData%AFInfo) + do i1 = LB(1), UB(1) + call AFI_DestroyParam(InitInputData%AFInfo(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InitInputData%AFInfo) + end if +end subroutine + +subroutine AA_PackInitInput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(AA_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AA_PackInitInput' + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%InputFile) + call RegPack(RF, InData%NumBlades) + call RegPack(RF, InData%NumBlNds) + call RegPack(RF, InData%RootName) + call RegPackAlloc(RF, InData%BlSpn) + call RegPackAlloc(RF, InData%BlChord) + call RegPack(RF, InData%AirDens) + call RegPack(RF, InData%KinVisc) + call RegPack(RF, InData%SpdSound) + call RegPack(RF, InData%HubHeight) + call RegPackAlloc(RF, InData%BlAFID) + call RegPack(RF, allocated(InData%AFInfo)) + if (allocated(InData%AFInfo)) then + call RegPackBounds(RF, 1, lbound(InData%AFInfo), ubound(InData%AFInfo)) + LB(1:1) = lbound(InData%AFInfo) + UB(1:1) = ubound(InData%AFInfo) + do i1 = LB(1), UB(1) + call AFI_PackParam(RF, InData%AFInfo(i1)) + end do + end if + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AA_UnPackInitInput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(AA_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AA_UnPackInitInput' + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%InputFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumBlades); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumBlNds); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RootName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BlSpn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BlChord); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AirDens); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%KinVisc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SpdSound); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HubHeight); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BlAFID); if (RegCheckErr(RF, RoutineName)) return + if (allocated(OutData%AFInfo)) deallocate(OutData%AFInfo) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%AFInfo(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AFInfo.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AFI_UnpackParam(RF, OutData%AFInfo(i1)) ! AFInfo + end do + end if +end subroutine + +subroutine AA_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) + type(AA_InitOutputType), intent(in) :: SrcInitOutputData + type(AA_InitOutputType), intent(inout) :: DstInitOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AA_CopyInitOutput' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcDiscStateData%MeanVrel)) THEN - i1_l = LBOUND(SrcDiscStateData%MeanVrel,1) - i1_u = UBOUND(SrcDiscStateData%MeanVrel,1) - i2_l = LBOUND(SrcDiscStateData%MeanVrel,2) - i2_u = UBOUND(SrcDiscStateData%MeanVrel,2) - IF (.NOT. ALLOCATED(DstDiscStateData%MeanVrel)) THEN - ALLOCATE(DstDiscStateData%MeanVrel(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%MeanVrel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%MeanVrel = SrcDiscStateData%MeanVrel -ENDIF -IF (ALLOCATED(SrcDiscStateData%VrelSq)) THEN - i1_l = LBOUND(SrcDiscStateData%VrelSq,1) - i1_u = UBOUND(SrcDiscStateData%VrelSq,1) - i2_l = LBOUND(SrcDiscStateData%VrelSq,2) - i2_u = UBOUND(SrcDiscStateData%VrelSq,2) - IF (.NOT. ALLOCATED(DstDiscStateData%VrelSq)) THEN - ALLOCATE(DstDiscStateData%VrelSq(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%VrelSq.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%VrelSq = SrcDiscStateData%VrelSq -ENDIF -IF (ALLOCATED(SrcDiscStateData%TIVrel)) THEN - i1_l = LBOUND(SrcDiscStateData%TIVrel,1) - i1_u = UBOUND(SrcDiscStateData%TIVrel,1) - i2_l = LBOUND(SrcDiscStateData%TIVrel,2) - i2_u = UBOUND(SrcDiscStateData%TIVrel,2) - IF (.NOT. ALLOCATED(DstDiscStateData%TIVrel)) THEN - ALLOCATE(DstDiscStateData%TIVrel(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%TIVrel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%TIVrel = SrcDiscStateData%TIVrel -ENDIF -IF (ALLOCATED(SrcDiscStateData%VrelStore)) THEN - i1_l = LBOUND(SrcDiscStateData%VrelStore,1) - i1_u = UBOUND(SrcDiscStateData%VrelStore,1) - i2_l = LBOUND(SrcDiscStateData%VrelStore,2) - i2_u = UBOUND(SrcDiscStateData%VrelStore,2) - i3_l = LBOUND(SrcDiscStateData%VrelStore,3) - i3_u = UBOUND(SrcDiscStateData%VrelStore,3) - IF (.NOT. ALLOCATED(DstDiscStateData%VrelStore)) THEN - ALLOCATE(DstDiscStateData%VrelStore(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%VrelStore.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%VrelStore = SrcDiscStateData%VrelStore -ENDIF -IF (ALLOCATED(SrcDiscStateData%TIVx)) THEN - i1_l = LBOUND(SrcDiscStateData%TIVx,1) - i1_u = UBOUND(SrcDiscStateData%TIVx,1) - i2_l = LBOUND(SrcDiscStateData%TIVx,2) - i2_u = UBOUND(SrcDiscStateData%TIVx,2) - IF (.NOT. ALLOCATED(DstDiscStateData%TIVx)) THEN - ALLOCATE(DstDiscStateData%TIVx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%TIVx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%TIVx = SrcDiscStateData%TIVx -ENDIF -IF (ALLOCATED(SrcDiscStateData%MeanVxVyVz)) THEN - i1_l = LBOUND(SrcDiscStateData%MeanVxVyVz,1) - i1_u = UBOUND(SrcDiscStateData%MeanVxVyVz,1) - i2_l = LBOUND(SrcDiscStateData%MeanVxVyVz,2) - i2_u = UBOUND(SrcDiscStateData%MeanVxVyVz,2) - IF (.NOT. ALLOCATED(DstDiscStateData%MeanVxVyVz)) THEN - ALLOCATE(DstDiscStateData%MeanVxVyVz(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%MeanVxVyVz.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%MeanVxVyVz = SrcDiscStateData%MeanVxVyVz -ENDIF -IF (ALLOCATED(SrcDiscStateData%VxSq)) THEN - i1_l = LBOUND(SrcDiscStateData%VxSq,1) - i1_u = UBOUND(SrcDiscStateData%VxSq,1) - i2_l = LBOUND(SrcDiscStateData%VxSq,2) - i2_u = UBOUND(SrcDiscStateData%VxSq,2) - IF (.NOT. ALLOCATED(DstDiscStateData%VxSq)) THEN - ALLOCATE(DstDiscStateData%VxSq(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%VxSq.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%VxSq = SrcDiscStateData%VxSq -ENDIF -IF (ALLOCATED(SrcDiscStateData%allregcounter)) THEN - i1_l = LBOUND(SrcDiscStateData%allregcounter,1) - i1_u = UBOUND(SrcDiscStateData%allregcounter,1) - i2_l = LBOUND(SrcDiscStateData%allregcounter,2) - i2_u = UBOUND(SrcDiscStateData%allregcounter,2) - IF (.NOT. ALLOCATED(DstDiscStateData%allregcounter)) THEN - ALLOCATE(DstDiscStateData%allregcounter(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%allregcounter.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%allregcounter = SrcDiscStateData%allregcounter -ENDIF -IF (ALLOCATED(SrcDiscStateData%VxSqRegion)) THEN - i1_l = LBOUND(SrcDiscStateData%VxSqRegion,1) - i1_u = UBOUND(SrcDiscStateData%VxSqRegion,1) - i2_l = LBOUND(SrcDiscStateData%VxSqRegion,2) - i2_u = UBOUND(SrcDiscStateData%VxSqRegion,2) - IF (.NOT. ALLOCATED(DstDiscStateData%VxSqRegion)) THEN - ALLOCATE(DstDiscStateData%VxSqRegion(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%VxSqRegion.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%VxSqRegion = SrcDiscStateData%VxSqRegion -ENDIF -IF (ALLOCATED(SrcDiscStateData%RegVxStor)) THEN - i1_l = LBOUND(SrcDiscStateData%RegVxStor,1) - i1_u = UBOUND(SrcDiscStateData%RegVxStor,1) - i2_l = LBOUND(SrcDiscStateData%RegVxStor,2) - i2_u = UBOUND(SrcDiscStateData%RegVxStor,2) - i3_l = LBOUND(SrcDiscStateData%RegVxStor,3) - i3_u = UBOUND(SrcDiscStateData%RegVxStor,3) - IF (.NOT. ALLOCATED(DstDiscStateData%RegVxStor)) THEN - ALLOCATE(DstDiscStateData%RegVxStor(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%RegVxStor.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%RegVxStor = SrcDiscStateData%RegVxStor -ENDIF -IF (ALLOCATED(SrcDiscStateData%RegionTIDelete)) THEN - i1_l = LBOUND(SrcDiscStateData%RegionTIDelete,1) - i1_u = UBOUND(SrcDiscStateData%RegionTIDelete,1) - i2_l = LBOUND(SrcDiscStateData%RegionTIDelete,2) - i2_u = UBOUND(SrcDiscStateData%RegionTIDelete,2) - IF (.NOT. ALLOCATED(DstDiscStateData%RegionTIDelete)) THEN - ALLOCATE(DstDiscStateData%RegionTIDelete(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%RegionTIDelete.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%RegionTIDelete = SrcDiscStateData%RegionTIDelete -ENDIF - END SUBROUTINE AA_CopyDiscState - - SUBROUTINE AA_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(AA_DiscreteStateType), INTENT(INOUT) :: DiscStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AA_DestroyDiscState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(DiscStateData%MeanVrel)) THEN - DEALLOCATE(DiscStateData%MeanVrel) -ENDIF -IF (ALLOCATED(DiscStateData%VrelSq)) THEN - DEALLOCATE(DiscStateData%VrelSq) -ENDIF -IF (ALLOCATED(DiscStateData%TIVrel)) THEN - DEALLOCATE(DiscStateData%TIVrel) -ENDIF -IF (ALLOCATED(DiscStateData%VrelStore)) THEN - DEALLOCATE(DiscStateData%VrelStore) -ENDIF -IF (ALLOCATED(DiscStateData%TIVx)) THEN - DEALLOCATE(DiscStateData%TIVx) -ENDIF -IF (ALLOCATED(DiscStateData%MeanVxVyVz)) THEN - DEALLOCATE(DiscStateData%MeanVxVyVz) -ENDIF -IF (ALLOCATED(DiscStateData%VxSq)) THEN - DEALLOCATE(DiscStateData%VxSq) -ENDIF -IF (ALLOCATED(DiscStateData%allregcounter)) THEN - DEALLOCATE(DiscStateData%allregcounter) -ENDIF -IF (ALLOCATED(DiscStateData%VxSqRegion)) THEN - DEALLOCATE(DiscStateData%VxSqRegion) -ENDIF -IF (ALLOCATED(DiscStateData%RegVxStor)) THEN - DEALLOCATE(DiscStateData%RegVxStor) -ENDIF -IF (ALLOCATED(DiscStateData%RegionTIDelete)) THEN - DEALLOCATE(DiscStateData%RegionTIDelete) -ENDIF - END SUBROUTINE AA_DestroyDiscState - - SUBROUTINE AA_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(AA_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 = 'AA_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 ! MeanVrel allocated yes/no - IF ( ALLOCATED(InData%MeanVrel) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! MeanVrel upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%MeanVrel) ! MeanVrel - END IF - Int_BufSz = Int_BufSz + 1 ! VrelSq allocated yes/no - IF ( ALLOCATED(InData%VrelSq) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! VrelSq upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%VrelSq) ! VrelSq - END IF - Int_BufSz = Int_BufSz + 1 ! TIVrel allocated yes/no - IF ( ALLOCATED(InData%TIVrel) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! TIVrel upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TIVrel) ! TIVrel - END IF - Int_BufSz = Int_BufSz + 1 ! VrelStore allocated yes/no - IF ( ALLOCATED(InData%VrelStore) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! VrelStore upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%VrelStore) ! VrelStore - END IF - Int_BufSz = Int_BufSz + 1 ! TIVx allocated yes/no - IF ( ALLOCATED(InData%TIVx) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! TIVx upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TIVx) ! TIVx - END IF - Int_BufSz = Int_BufSz + 1 ! MeanVxVyVz allocated yes/no - IF ( ALLOCATED(InData%MeanVxVyVz) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! MeanVxVyVz upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%MeanVxVyVz) ! MeanVxVyVz - END IF - Int_BufSz = Int_BufSz + 1 ! VxSq allocated yes/no - IF ( ALLOCATED(InData%VxSq) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! VxSq upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%VxSq) ! VxSq - END IF - Int_BufSz = Int_BufSz + 1 ! allregcounter allocated yes/no - IF ( ALLOCATED(InData%allregcounter) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! allregcounter upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%allregcounter) ! allregcounter - END IF - Int_BufSz = Int_BufSz + 1 ! VxSqRegion allocated yes/no - IF ( ALLOCATED(InData%VxSqRegion) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! VxSqRegion upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%VxSqRegion) ! VxSqRegion - END IF - Int_BufSz = Int_BufSz + 1 ! RegVxStor allocated yes/no - IF ( ALLOCATED(InData%RegVxStor) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! RegVxStor upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%RegVxStor) ! RegVxStor - END IF - Int_BufSz = Int_BufSz + 1 ! RegionTIDelete allocated yes/no - IF ( ALLOCATED(InData%RegionTIDelete) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! RegionTIDelete upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%RegionTIDelete) ! RegionTIDelete - 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%MeanVrel) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MeanVrel,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MeanVrel,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MeanVrel,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MeanVrel,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%MeanVrel,2), UBOUND(InData%MeanVrel,2) - DO i1 = LBOUND(InData%MeanVrel,1), UBOUND(InData%MeanVrel,1) - ReKiBuf(Re_Xferred) = InData%MeanVrel(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%VrelSq) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%VrelSq,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VrelSq,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%VrelSq,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VrelSq,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%VrelSq,2), UBOUND(InData%VrelSq,2) - DO i1 = LBOUND(InData%VrelSq,1), UBOUND(InData%VrelSq,1) - ReKiBuf(Re_Xferred) = InData%VrelSq(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TIVrel) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TIVrel,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TIVrel,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TIVrel,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TIVrel,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%TIVrel,2), UBOUND(InData%TIVrel,2) - DO i1 = LBOUND(InData%TIVrel,1), UBOUND(InData%TIVrel,1) - ReKiBuf(Re_Xferred) = InData%TIVrel(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%VrelStore) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%VrelStore,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VrelStore,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%VrelStore,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VrelStore,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%VrelStore,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VrelStore,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%VrelStore,3), UBOUND(InData%VrelStore,3) - DO i2 = LBOUND(InData%VrelStore,2), UBOUND(InData%VrelStore,2) - DO i1 = LBOUND(InData%VrelStore,1), UBOUND(InData%VrelStore,1) - ReKiBuf(Re_Xferred) = InData%VrelStore(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TIVx) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TIVx,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TIVx,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TIVx,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TIVx,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%TIVx,2), UBOUND(InData%TIVx,2) - DO i1 = LBOUND(InData%TIVx,1), UBOUND(InData%TIVx,1) - ReKiBuf(Re_Xferred) = InData%TIVx(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%MeanVxVyVz) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MeanVxVyVz,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MeanVxVyVz,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MeanVxVyVz,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MeanVxVyVz,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%MeanVxVyVz,2), UBOUND(InData%MeanVxVyVz,2) - DO i1 = LBOUND(InData%MeanVxVyVz,1), UBOUND(InData%MeanVxVyVz,1) - ReKiBuf(Re_Xferred) = InData%MeanVxVyVz(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%VxSq) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%VxSq,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VxSq,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%VxSq,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VxSq,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%VxSq,2), UBOUND(InData%VxSq,2) - DO i1 = LBOUND(InData%VxSq,1), UBOUND(InData%VxSq,1) - ReKiBuf(Re_Xferred) = InData%VxSq(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%allregcounter) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%allregcounter,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%allregcounter,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%allregcounter,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%allregcounter,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%allregcounter,2), UBOUND(InData%allregcounter,2) - DO i1 = LBOUND(InData%allregcounter,1), UBOUND(InData%allregcounter,1) - ReKiBuf(Re_Xferred) = InData%allregcounter(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%VxSqRegion) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%VxSqRegion,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VxSqRegion,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%VxSqRegion,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VxSqRegion,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%VxSqRegion,2), UBOUND(InData%VxSqRegion,2) - DO i1 = LBOUND(InData%VxSqRegion,1), UBOUND(InData%VxSqRegion,1) - ReKiBuf(Re_Xferred) = InData%VxSqRegion(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%RegVxStor) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RegVxStor,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RegVxStor,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RegVxStor,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RegVxStor,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RegVxStor,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RegVxStor,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%RegVxStor,3), UBOUND(InData%RegVxStor,3) - DO i2 = LBOUND(InData%RegVxStor,2), UBOUND(InData%RegVxStor,2) - DO i1 = LBOUND(InData%RegVxStor,1), UBOUND(InData%RegVxStor,1) - ReKiBuf(Re_Xferred) = InData%RegVxStor(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%RegionTIDelete) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RegionTIDelete,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RegionTIDelete,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RegionTIDelete,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RegionTIDelete,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%RegionTIDelete,2), UBOUND(InData%RegionTIDelete,2) - DO i1 = LBOUND(InData%RegionTIDelete,1), UBOUND(InData%RegionTIDelete,1) - ReKiBuf(Re_Xferred) = InData%RegionTIDelete(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE AA_PackDiscState - - SUBROUTINE AA_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(AA_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) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AA_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 ! MeanVrel not allocated - Int_Xferred = Int_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%MeanVrel)) DEALLOCATE(OutData%MeanVrel) - ALLOCATE(OutData%MeanVrel(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MeanVrel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%MeanVrel,2), UBOUND(OutData%MeanVrel,2) - DO i1 = LBOUND(OutData%MeanVrel,1), UBOUND(OutData%MeanVrel,1) - OutData%MeanVrel(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! VrelSq not allocated - Int_Xferred = Int_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%VrelSq)) DEALLOCATE(OutData%VrelSq) - ALLOCATE(OutData%VrelSq(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%VrelSq.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%VrelSq,2), UBOUND(OutData%VrelSq,2) - DO i1 = LBOUND(OutData%VrelSq,1), UBOUND(OutData%VrelSq,1) - OutData%VrelSq(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TIVrel not allocated - Int_Xferred = Int_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%TIVrel)) DEALLOCATE(OutData%TIVrel) - ALLOCATE(OutData%TIVrel(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TIVrel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%TIVrel,2), UBOUND(OutData%TIVrel,2) - DO i1 = LBOUND(OutData%TIVrel,1), UBOUND(OutData%TIVrel,1) - OutData%TIVrel(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! VrelStore not allocated - Int_Xferred = Int_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%VrelStore)) DEALLOCATE(OutData%VrelStore) - ALLOCATE(OutData%VrelStore(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%VrelStore.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%VrelStore,3), UBOUND(OutData%VrelStore,3) - DO i2 = LBOUND(OutData%VrelStore,2), UBOUND(OutData%VrelStore,2) - DO i1 = LBOUND(OutData%VrelStore,1), UBOUND(OutData%VrelStore,1) - OutData%VrelStore(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 ! TIVx not allocated - Int_Xferred = Int_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%TIVx)) DEALLOCATE(OutData%TIVx) - ALLOCATE(OutData%TIVx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TIVx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%TIVx,2), UBOUND(OutData%TIVx,2) - DO i1 = LBOUND(OutData%TIVx,1), UBOUND(OutData%TIVx,1) - OutData%TIVx(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MeanVxVyVz not allocated - Int_Xferred = Int_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%MeanVxVyVz)) DEALLOCATE(OutData%MeanVxVyVz) - ALLOCATE(OutData%MeanVxVyVz(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MeanVxVyVz.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%MeanVxVyVz,2), UBOUND(OutData%MeanVxVyVz,2) - DO i1 = LBOUND(OutData%MeanVxVyVz,1), UBOUND(OutData%MeanVxVyVz,1) - OutData%MeanVxVyVz(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! VxSq not allocated - Int_Xferred = Int_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%VxSq)) DEALLOCATE(OutData%VxSq) - ALLOCATE(OutData%VxSq(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%VxSq.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%VxSq,2), UBOUND(OutData%VxSq,2) - DO i1 = LBOUND(OutData%VxSq,1), UBOUND(OutData%VxSq,1) - OutData%VxSq(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! allregcounter not allocated - Int_Xferred = Int_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%allregcounter)) DEALLOCATE(OutData%allregcounter) - ALLOCATE(OutData%allregcounter(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%allregcounter.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%allregcounter,2), UBOUND(OutData%allregcounter,2) - DO i1 = LBOUND(OutData%allregcounter,1), UBOUND(OutData%allregcounter,1) - OutData%allregcounter(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! VxSqRegion not allocated - Int_Xferred = Int_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%VxSqRegion)) DEALLOCATE(OutData%VxSqRegion) - ALLOCATE(OutData%VxSqRegion(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%VxSqRegion.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%VxSqRegion,2), UBOUND(OutData%VxSqRegion,2) - DO i1 = LBOUND(OutData%VxSqRegion,1), UBOUND(OutData%VxSqRegion,1) - OutData%VxSqRegion(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RegVxStor not allocated - Int_Xferred = Int_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%RegVxStor)) DEALLOCATE(OutData%RegVxStor) - ALLOCATE(OutData%RegVxStor(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%RegVxStor.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%RegVxStor,3), UBOUND(OutData%RegVxStor,3) - DO i2 = LBOUND(OutData%RegVxStor,2), UBOUND(OutData%RegVxStor,2) - DO i1 = LBOUND(OutData%RegVxStor,1), UBOUND(OutData%RegVxStor,1) - OutData%RegVxStor(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 ! RegionTIDelete not allocated - Int_Xferred = Int_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%RegionTIDelete)) DEALLOCATE(OutData%RegionTIDelete) - ALLOCATE(OutData%RegionTIDelete(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RegionTIDelete.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%RegionTIDelete,2), UBOUND(OutData%RegionTIDelete,2) - DO i1 = LBOUND(OutData%RegionTIDelete,1), UBOUND(OutData%RegionTIDelete,1) - OutData%RegionTIDelete(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE AA_UnPackDiscState - - SUBROUTINE AA_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AA_ConstraintStateType), INTENT(IN) :: SrcConstrStateData - TYPE(AA_ConstraintStateType), INTENT(INOUT) :: DstConstrStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AA_CopyConstrState' -! + ErrMsg = '' + if (allocated(SrcInitOutputData%WriteOutputHdr)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) + if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then + allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitOutputData%WriteOutputUnt)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) + if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then + allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitOutputData%WriteOutputHdrforPE)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdrforPE) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdrforPE) + if (.not. allocated(DstInitOutputData%WriteOutputHdrforPE)) then + allocate(DstInitOutputData%WriteOutputHdrforPE(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputHdrforPE.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%WriteOutputHdrforPE = SrcInitOutputData%WriteOutputHdrforPE + end if + if (allocated(SrcInitOutputData%WriteOutputUntforPE)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUntforPE) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUntforPE) + if (.not. allocated(DstInitOutputData%WriteOutputUntforPE)) then + allocate(DstInitOutputData%WriteOutputUntforPE(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputUntforPE.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%WriteOutputUntforPE = SrcInitOutputData%WriteOutputUntforPE + end if + if (allocated(SrcInitOutputData%WriteOutputHdrSep)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdrSep) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdrSep) + if (.not. allocated(DstInitOutputData%WriteOutputHdrSep)) then + allocate(DstInitOutputData%WriteOutputHdrSep(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputHdrSep.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%WriteOutputHdrSep = SrcInitOutputData%WriteOutputHdrSep + end if + if (allocated(SrcInitOutputData%WriteOutputUntSep)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUntSep) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUntSep) + if (.not. allocated(DstInitOutputData%WriteOutputUntSep)) then + allocate(DstInitOutputData%WriteOutputUntSep(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputUntSep.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%WriteOutputUntSep = SrcInitOutputData%WriteOutputUntSep + end if + if (allocated(SrcInitOutputData%WriteOutputHdrNodes)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdrNodes) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdrNodes) + if (.not. allocated(DstInitOutputData%WriteOutputHdrNodes)) then + allocate(DstInitOutputData%WriteOutputHdrNodes(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputHdrNodes.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%WriteOutputHdrNodes = SrcInitOutputData%WriteOutputHdrNodes + end if + if (allocated(SrcInitOutputData%WriteOutputUntNodes)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUntNodes) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUntNodes) + if (.not. allocated(DstInitOutputData%WriteOutputUntNodes)) then + allocate(DstInitOutputData%WriteOutputUntNodes(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputUntNodes.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%WriteOutputUntNodes = SrcInitOutputData%WriteOutputUntNodes + end if + DstInitOutputData%delim = SrcInitOutputData%delim + call NWTC_Library_CopyProgDesc(SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstInitOutputData%AirDens = SrcInitOutputData%AirDens +end subroutine + +subroutine AA_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(AA_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AA_DestroyInitOutput' ErrStat = ErrID_None - ErrMsg = "" - DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState - END SUBROUTINE AA_CopyConstrState - - SUBROUTINE AA_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(AA_ConstraintStateType), INTENT(INOUT) :: ConstrStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AA_DestroyConstrState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE AA_DestroyConstrState - - SUBROUTINE AA_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(AA_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 = 'AA_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 AA_PackConstrState - - SUBROUTINE AA_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(AA_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 = 'AA_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 = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AA_UnPackConstrState - - SUBROUTINE AA_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AA_OtherStateType), INTENT(IN) :: SrcOtherStateData - TYPE(AA_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 = 'AA_CopyOtherState' -! + ErrMsg = '' + if (allocated(InitOutputData%WriteOutputHdr)) then + deallocate(InitOutputData%WriteOutputHdr) + end if + if (allocated(InitOutputData%WriteOutputUnt)) then + deallocate(InitOutputData%WriteOutputUnt) + end if + if (allocated(InitOutputData%WriteOutputHdrforPE)) then + deallocate(InitOutputData%WriteOutputHdrforPE) + end if + if (allocated(InitOutputData%WriteOutputUntforPE)) then + deallocate(InitOutputData%WriteOutputUntforPE) + end if + if (allocated(InitOutputData%WriteOutputHdrSep)) then + deallocate(InitOutputData%WriteOutputHdrSep) + end if + if (allocated(InitOutputData%WriteOutputUntSep)) then + deallocate(InitOutputData%WriteOutputUntSep) + end if + if (allocated(InitOutputData%WriteOutputHdrNodes)) then + deallocate(InitOutputData%WriteOutputHdrNodes) + end if + if (allocated(InitOutputData%WriteOutputUntNodes)) then + deallocate(InitOutputData%WriteOutputUntNodes) + end if + call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine AA_PackInitOutput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(AA_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AA_PackInitOutput' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%WriteOutputHdr) + call RegPackAlloc(RF, InData%WriteOutputUnt) + call RegPackAlloc(RF, InData%WriteOutputHdrforPE) + call RegPackAlloc(RF, InData%WriteOutputUntforPE) + call RegPackAlloc(RF, InData%WriteOutputHdrSep) + call RegPackAlloc(RF, InData%WriteOutputUntSep) + call RegPackAlloc(RF, InData%WriteOutputHdrNodes) + call RegPackAlloc(RF, InData%WriteOutputUntNodes) + call RegPack(RF, InData%delim) + call NWTC_Library_PackProgDesc(RF, InData%Ver) + call RegPack(RF, InData%AirDens) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AA_UnPackInitOutput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(AA_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AA_UnPackInitOutput' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%WriteOutputHdr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WriteOutputUnt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WriteOutputHdrforPE); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WriteOutputUntforPE); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WriteOutputHdrSep); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WriteOutputUntSep); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WriteOutputHdrNodes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WriteOutputUntNodes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%delim); if (RegCheckErr(RF, RoutineName)) return + call NWTC_Library_UnpackProgDesc(RF, OutData%Ver) ! Ver + call RegUnpack(RF, OutData%AirDens); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AA_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg) + type(AA_InputFile), intent(in) :: SrcInputFileData + type(AA_InputFile), intent(inout) :: DstInputFileData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AA_CopyInputFile' ErrStat = ErrID_None - ErrMsg = "" - DstOtherStateData%DummyOtherState = SrcOtherStateData%DummyOtherState - END SUBROUTINE AA_CopyOtherState - - SUBROUTINE AA_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(AA_OtherStateType), INTENT(INOUT) :: OtherStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AA_DestroyOtherState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE AA_DestroyOtherState - - SUBROUTINE AA_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(AA_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 = 'AA_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 AA_PackOtherState - - SUBROUTINE AA_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(AA_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 = 'AA_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 AA_UnPackOtherState - - SUBROUTINE AA_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AA_MiscVarType), INTENT(IN) :: SrcMiscData - TYPE(AA_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) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AA_CopyMisc' -! + ErrMsg = '' + DstInputFileData%DT_AA = SrcInputFileData%DT_AA + DstInputFileData%IBLUNT = SrcInputFileData%IBLUNT + DstInputFileData%ILAM = SrcInputFileData%ILAM + DstInputFileData%ITIP = SrcInputFileData%ITIP + DstInputFileData%ITRIP = SrcInputFileData%ITRIP + DstInputFileData%ITURB = SrcInputFileData%ITURB + DstInputFileData%IInflow = SrcInputFileData%IInflow + DstInputFileData%X_BLMethod = SrcInputFileData%X_BLMethod + DstInputFileData%TICalcMeth = SrcInputFileData%TICalcMeth + DstInputFileData%NReListBL = SrcInputFileData%NReListBL + DstInputFileData%aweightflag = SrcInputFileData%aweightflag + DstInputFileData%ROUND = SrcInputFileData%ROUND + DstInputFileData%ALPRAT = SrcInputFileData%ALPRAT + DstInputFileData%AA_Bl_Prcntge = SrcInputFileData%AA_Bl_Prcntge + DstInputFileData%NrObsLoc = SrcInputFileData%NrObsLoc + if (allocated(SrcInputFileData%ObsX)) then + LB(1:1) = lbound(SrcInputFileData%ObsX) + UB(1:1) = ubound(SrcInputFileData%ObsX) + if (.not. allocated(DstInputFileData%ObsX)) then + allocate(DstInputFileData%ObsX(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%ObsX.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%ObsX = SrcInputFileData%ObsX + end if + if (allocated(SrcInputFileData%ObsY)) then + LB(1:1) = lbound(SrcInputFileData%ObsY) + UB(1:1) = ubound(SrcInputFileData%ObsY) + if (.not. allocated(DstInputFileData%ObsY)) then + allocate(DstInputFileData%ObsY(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%ObsY.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%ObsY = SrcInputFileData%ObsY + end if + if (allocated(SrcInputFileData%ObsZ)) then + LB(1:1) = lbound(SrcInputFileData%ObsZ) + UB(1:1) = ubound(SrcInputFileData%ObsZ) + if (.not. allocated(DstInputFileData%ObsZ)) then + allocate(DstInputFileData%ObsZ(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%ObsZ.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%ObsZ = SrcInputFileData%ObsZ + end if + if (allocated(SrcInputFileData%BladeProps)) then + LB(1:1) = lbound(SrcInputFileData%BladeProps) + UB(1:1) = ubound(SrcInputFileData%BladeProps) + if (.not. allocated(DstInputFileData%BladeProps)) then + allocate(DstInputFileData%BladeProps(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%BladeProps.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AA_CopyBladePropsType(SrcInputFileData%BladeProps(i1), DstInputFileData%BladeProps(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + DstInputFileData%NrOutFile = SrcInputFileData%NrOutFile + if (allocated(SrcInputFileData%AAoutfile)) then + LB(1:1) = lbound(SrcInputFileData%AAoutfile) + UB(1:1) = ubound(SrcInputFileData%AAoutfile) + if (.not. allocated(DstInputFileData%AAoutfile)) then + allocate(DstInputFileData%AAoutfile(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%AAoutfile.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%AAoutfile = SrcInputFileData%AAoutfile + end if + DstInputFileData%FTitle = SrcInputFileData%FTitle + DstInputFileData%AAStart = SrcInputFileData%AAStart + DstInputFileData%TI = SrcInputFileData%TI + DstInputFileData%avgV = SrcInputFileData%avgV + DstInputFileData%Lturb = SrcInputFileData%Lturb + if (allocated(SrcInputFileData%ReListBL)) then + LB(1:1) = lbound(SrcInputFileData%ReListBL) + UB(1:1) = ubound(SrcInputFileData%ReListBL) + if (.not. allocated(DstInputFileData%ReListBL)) then + allocate(DstInputFileData%ReListBL(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%ReListBL.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%ReListBL = SrcInputFileData%ReListBL + end if + if (allocated(SrcInputFileData%AoAListBL)) then + LB(1:1) = lbound(SrcInputFileData%AoAListBL) + UB(1:1) = ubound(SrcInputFileData%AoAListBL) + if (.not. allocated(DstInputFileData%AoAListBL)) then + allocate(DstInputFileData%AoAListBL(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%AoAListBL.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%AoAListBL = SrcInputFileData%AoAListBL + end if + if (allocated(SrcInputFileData%Pres_DispThick)) then + LB(1:3) = lbound(SrcInputFileData%Pres_DispThick) + UB(1:3) = ubound(SrcInputFileData%Pres_DispThick) + if (.not. allocated(DstInputFileData%Pres_DispThick)) then + allocate(DstInputFileData%Pres_DispThick(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%Pres_DispThick.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%Pres_DispThick = SrcInputFileData%Pres_DispThick + end if + if (allocated(SrcInputFileData%Suct_DispThick)) then + LB(1:3) = lbound(SrcInputFileData%Suct_DispThick) + UB(1:3) = ubound(SrcInputFileData%Suct_DispThick) + if (.not. allocated(DstInputFileData%Suct_DispThick)) then + allocate(DstInputFileData%Suct_DispThick(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%Suct_DispThick.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%Suct_DispThick = SrcInputFileData%Suct_DispThick + end if + if (allocated(SrcInputFileData%Pres_BLThick)) then + LB(1:3) = lbound(SrcInputFileData%Pres_BLThick) + UB(1:3) = ubound(SrcInputFileData%Pres_BLThick) + if (.not. allocated(DstInputFileData%Pres_BLThick)) then + allocate(DstInputFileData%Pres_BLThick(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%Pres_BLThick.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%Pres_BLThick = SrcInputFileData%Pres_BLThick + end if + if (allocated(SrcInputFileData%Suct_BLThick)) then + LB(1:3) = lbound(SrcInputFileData%Suct_BLThick) + UB(1:3) = ubound(SrcInputFileData%Suct_BLThick) + if (.not. allocated(DstInputFileData%Suct_BLThick)) then + allocate(DstInputFileData%Suct_BLThick(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%Suct_BLThick.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%Suct_BLThick = SrcInputFileData%Suct_BLThick + end if + if (allocated(SrcInputFileData%Pres_Cf)) then + LB(1:3) = lbound(SrcInputFileData%Pres_Cf) + UB(1:3) = ubound(SrcInputFileData%Pres_Cf) + if (.not. allocated(DstInputFileData%Pres_Cf)) then + allocate(DstInputFileData%Pres_Cf(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%Pres_Cf.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%Pres_Cf = SrcInputFileData%Pres_Cf + end if + if (allocated(SrcInputFileData%Suct_Cf)) then + LB(1:3) = lbound(SrcInputFileData%Suct_Cf) + UB(1:3) = ubound(SrcInputFileData%Suct_Cf) + if (.not. allocated(DstInputFileData%Suct_Cf)) then + allocate(DstInputFileData%Suct_Cf(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%Suct_Cf.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%Suct_Cf = SrcInputFileData%Suct_Cf + end if + if (allocated(SrcInputFileData%Pres_EdgeVelRat)) then + LB(1:3) = lbound(SrcInputFileData%Pres_EdgeVelRat) + UB(1:3) = ubound(SrcInputFileData%Pres_EdgeVelRat) + if (.not. allocated(DstInputFileData%Pres_EdgeVelRat)) then + allocate(DstInputFileData%Pres_EdgeVelRat(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%Pres_EdgeVelRat.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%Pres_EdgeVelRat = SrcInputFileData%Pres_EdgeVelRat + end if + if (allocated(SrcInputFileData%Suct_EdgeVelRat)) then + LB(1:3) = lbound(SrcInputFileData%Suct_EdgeVelRat) + UB(1:3) = ubound(SrcInputFileData%Suct_EdgeVelRat) + if (.not. allocated(DstInputFileData%Suct_EdgeVelRat)) then + allocate(DstInputFileData%Suct_EdgeVelRat(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%Suct_EdgeVelRat.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%Suct_EdgeVelRat = SrcInputFileData%Suct_EdgeVelRat + end if +end subroutine + +subroutine AA_DestroyInputFile(InputFileData, ErrStat, ErrMsg) + type(AA_InputFile), intent(inout) :: InputFileData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AA_DestroyInputFile' ErrStat = ErrID_None - ErrMsg = "" -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 -IF (ALLOCATED(SrcMiscData%ChordAngleTE)) THEN - i1_l = LBOUND(SrcMiscData%ChordAngleTE,1) - i1_u = UBOUND(SrcMiscData%ChordAngleTE,1) - i2_l = LBOUND(SrcMiscData%ChordAngleTE,2) - i2_u = UBOUND(SrcMiscData%ChordAngleTE,2) - i3_l = LBOUND(SrcMiscData%ChordAngleTE,3) - i3_u = UBOUND(SrcMiscData%ChordAngleTE,3) - IF (.NOT. ALLOCATED(DstMiscData%ChordAngleTE)) THEN - ALLOCATE(DstMiscData%ChordAngleTE(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%ChordAngleTE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%ChordAngleTE = SrcMiscData%ChordAngleTE -ENDIF -IF (ALLOCATED(SrcMiscData%SpanAngleTE)) THEN - i1_l = LBOUND(SrcMiscData%SpanAngleTE,1) - i1_u = UBOUND(SrcMiscData%SpanAngleTE,1) - i2_l = LBOUND(SrcMiscData%SpanAngleTE,2) - i2_u = UBOUND(SrcMiscData%SpanAngleTE,2) - i3_l = LBOUND(SrcMiscData%SpanAngleTE,3) - i3_u = UBOUND(SrcMiscData%SpanAngleTE,3) - IF (.NOT. ALLOCATED(DstMiscData%SpanAngleTE)) THEN - ALLOCATE(DstMiscData%SpanAngleTE(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SpanAngleTE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%SpanAngleTE = SrcMiscData%SpanAngleTE -ENDIF -IF (ALLOCATED(SrcMiscData%ChordAngleLE)) THEN - i1_l = LBOUND(SrcMiscData%ChordAngleLE,1) - i1_u = UBOUND(SrcMiscData%ChordAngleLE,1) - i2_l = LBOUND(SrcMiscData%ChordAngleLE,2) - i2_u = UBOUND(SrcMiscData%ChordAngleLE,2) - i3_l = LBOUND(SrcMiscData%ChordAngleLE,3) - i3_u = UBOUND(SrcMiscData%ChordAngleLE,3) - IF (.NOT. ALLOCATED(DstMiscData%ChordAngleLE)) THEN - ALLOCATE(DstMiscData%ChordAngleLE(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%ChordAngleLE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%ChordAngleLE = SrcMiscData%ChordAngleLE -ENDIF -IF (ALLOCATED(SrcMiscData%SpanAngleLE)) THEN - i1_l = LBOUND(SrcMiscData%SpanAngleLE,1) - i1_u = UBOUND(SrcMiscData%SpanAngleLE,1) - i2_l = LBOUND(SrcMiscData%SpanAngleLE,2) - i2_u = UBOUND(SrcMiscData%SpanAngleLE,2) - i3_l = LBOUND(SrcMiscData%SpanAngleLE,3) - i3_u = UBOUND(SrcMiscData%SpanAngleLE,3) - IF (.NOT. ALLOCATED(DstMiscData%SpanAngleLE)) THEN - ALLOCATE(DstMiscData%SpanAngleLE(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SpanAngleLE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%SpanAngleLE = SrcMiscData%SpanAngleLE -ENDIF -IF (ALLOCATED(SrcMiscData%rTEtoObserve)) THEN - i1_l = LBOUND(SrcMiscData%rTEtoObserve,1) - i1_u = UBOUND(SrcMiscData%rTEtoObserve,1) - i2_l = LBOUND(SrcMiscData%rTEtoObserve,2) - i2_u = UBOUND(SrcMiscData%rTEtoObserve,2) - i3_l = LBOUND(SrcMiscData%rTEtoObserve,3) - i3_u = UBOUND(SrcMiscData%rTEtoObserve,3) - IF (.NOT. ALLOCATED(DstMiscData%rTEtoObserve)) THEN - ALLOCATE(DstMiscData%rTEtoObserve(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%rTEtoObserve.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%rTEtoObserve = SrcMiscData%rTEtoObserve -ENDIF -IF (ALLOCATED(SrcMiscData%rLEtoObserve)) THEN - i1_l = LBOUND(SrcMiscData%rLEtoObserve,1) - i1_u = UBOUND(SrcMiscData%rLEtoObserve,1) - i2_l = LBOUND(SrcMiscData%rLEtoObserve,2) - i2_u = UBOUND(SrcMiscData%rLEtoObserve,2) - i3_l = LBOUND(SrcMiscData%rLEtoObserve,3) - i3_u = UBOUND(SrcMiscData%rLEtoObserve,3) - IF (.NOT. ALLOCATED(DstMiscData%rLEtoObserve)) THEN - ALLOCATE(DstMiscData%rLEtoObserve(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%rLEtoObserve.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%rLEtoObserve = SrcMiscData%rLEtoObserve -ENDIF -IF (ALLOCATED(SrcMiscData%LE_Location)) THEN - i1_l = LBOUND(SrcMiscData%LE_Location,1) - i1_u = UBOUND(SrcMiscData%LE_Location,1) - i2_l = LBOUND(SrcMiscData%LE_Location,2) - i2_u = UBOUND(SrcMiscData%LE_Location,2) - i3_l = LBOUND(SrcMiscData%LE_Location,3) - i3_u = UBOUND(SrcMiscData%LE_Location,3) - IF (.NOT. ALLOCATED(DstMiscData%LE_Location)) THEN - ALLOCATE(DstMiscData%LE_Location(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%LE_Location.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%LE_Location = SrcMiscData%LE_Location -ENDIF - DstMiscData%RotSpeedAoA = SrcMiscData%RotSpeedAoA -IF (ALLOCATED(SrcMiscData%SPLLBL)) THEN - i1_l = LBOUND(SrcMiscData%SPLLBL,1) - i1_u = UBOUND(SrcMiscData%SPLLBL,1) - IF (.NOT. ALLOCATED(DstMiscData%SPLLBL)) THEN - ALLOCATE(DstMiscData%SPLLBL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SPLLBL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%SPLLBL = SrcMiscData%SPLLBL -ENDIF -IF (ALLOCATED(SrcMiscData%SPLP)) THEN - i1_l = LBOUND(SrcMiscData%SPLP,1) - i1_u = UBOUND(SrcMiscData%SPLP,1) - IF (.NOT. ALLOCATED(DstMiscData%SPLP)) THEN - ALLOCATE(DstMiscData%SPLP(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SPLP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%SPLP = SrcMiscData%SPLP -ENDIF -IF (ALLOCATED(SrcMiscData%SPLS)) THEN - i1_l = LBOUND(SrcMiscData%SPLS,1) - i1_u = UBOUND(SrcMiscData%SPLS,1) - IF (.NOT. ALLOCATED(DstMiscData%SPLS)) THEN - ALLOCATE(DstMiscData%SPLS(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SPLS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%SPLS = SrcMiscData%SPLS -ENDIF -IF (ALLOCATED(SrcMiscData%SPLALPH)) THEN - i1_l = LBOUND(SrcMiscData%SPLALPH,1) - i1_u = UBOUND(SrcMiscData%SPLALPH,1) - IF (.NOT. ALLOCATED(DstMiscData%SPLALPH)) THEN - ALLOCATE(DstMiscData%SPLALPH(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SPLALPH.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%SPLALPH = SrcMiscData%SPLALPH -ENDIF -IF (ALLOCATED(SrcMiscData%SPLTBL)) THEN - i1_l = LBOUND(SrcMiscData%SPLTBL,1) - i1_u = UBOUND(SrcMiscData%SPLTBL,1) - IF (.NOT. ALLOCATED(DstMiscData%SPLTBL)) THEN - ALLOCATE(DstMiscData%SPLTBL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SPLTBL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%SPLTBL = SrcMiscData%SPLTBL -ENDIF -IF (ALLOCATED(SrcMiscData%SPLTIP)) THEN - i1_l = LBOUND(SrcMiscData%SPLTIP,1) - i1_u = UBOUND(SrcMiscData%SPLTIP,1) - IF (.NOT. ALLOCATED(DstMiscData%SPLTIP)) THEN - ALLOCATE(DstMiscData%SPLTIP(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SPLTIP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%SPLTIP = SrcMiscData%SPLTIP -ENDIF -IF (ALLOCATED(SrcMiscData%SPLTI)) THEN - i1_l = LBOUND(SrcMiscData%SPLTI,1) - i1_u = UBOUND(SrcMiscData%SPLTI,1) - IF (.NOT. ALLOCATED(DstMiscData%SPLTI)) THEN - ALLOCATE(DstMiscData%SPLTI(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SPLTI.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%SPLTI = SrcMiscData%SPLTI -ENDIF -IF (ALLOCATED(SrcMiscData%SPLTIGui)) THEN - i1_l = LBOUND(SrcMiscData%SPLTIGui,1) - i1_u = UBOUND(SrcMiscData%SPLTIGui,1) - IF (.NOT. ALLOCATED(DstMiscData%SPLTIGui)) THEN - ALLOCATE(DstMiscData%SPLTIGui(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SPLTIGui.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%SPLTIGui = SrcMiscData%SPLTIGui -ENDIF -IF (ALLOCATED(SrcMiscData%SPLBLUNT)) THEN - i1_l = LBOUND(SrcMiscData%SPLBLUNT,1) - i1_u = UBOUND(SrcMiscData%SPLBLUNT,1) - IF (.NOT. ALLOCATED(DstMiscData%SPLBLUNT)) THEN - ALLOCATE(DstMiscData%SPLBLUNT(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SPLBLUNT.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%SPLBLUNT = SrcMiscData%SPLBLUNT -ENDIF -IF (ALLOCATED(SrcMiscData%CfVar)) THEN - i1_l = LBOUND(SrcMiscData%CfVar,1) - i1_u = UBOUND(SrcMiscData%CfVar,1) - IF (.NOT. ALLOCATED(DstMiscData%CfVar)) THEN - ALLOCATE(DstMiscData%CfVar(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%CfVar.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%CfVar = SrcMiscData%CfVar -ENDIF -IF (ALLOCATED(SrcMiscData%d99Var)) THEN - i1_l = LBOUND(SrcMiscData%d99Var,1) - i1_u = UBOUND(SrcMiscData%d99Var,1) - IF (.NOT. ALLOCATED(DstMiscData%d99Var)) THEN - ALLOCATE(DstMiscData%d99Var(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%d99Var.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%d99Var = SrcMiscData%d99Var -ENDIF -IF (ALLOCATED(SrcMiscData%dStarVar)) THEN - i1_l = LBOUND(SrcMiscData%dStarVar,1) - i1_u = UBOUND(SrcMiscData%dStarVar,1) - IF (.NOT. ALLOCATED(DstMiscData%dStarVar)) THEN - ALLOCATE(DstMiscData%dStarVar(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%dStarVar.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%dStarVar = SrcMiscData%dStarVar -ENDIF -IF (ALLOCATED(SrcMiscData%EdgeVelVar)) THEN - i1_l = LBOUND(SrcMiscData%EdgeVelVar,1) - i1_u = UBOUND(SrcMiscData%EdgeVelVar,1) - IF (.NOT. ALLOCATED(DstMiscData%EdgeVelVar)) THEN - ALLOCATE(DstMiscData%EdgeVelVar(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%EdgeVelVar.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%EdgeVelVar = SrcMiscData%EdgeVelVar -ENDIF - DstMiscData%speccou = SrcMiscData%speccou - DstMiscData%filesopen = SrcMiscData%filesopen - END SUBROUTINE AA_CopyMisc - - SUBROUTINE AA_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(AA_MiscVarType), INTENT(INOUT) :: MiscData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AA_DestroyMisc' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(MiscData%AllOuts)) THEN - DEALLOCATE(MiscData%AllOuts) -ENDIF -IF (ALLOCATED(MiscData%ChordAngleTE)) THEN - DEALLOCATE(MiscData%ChordAngleTE) -ENDIF -IF (ALLOCATED(MiscData%SpanAngleTE)) THEN - DEALLOCATE(MiscData%SpanAngleTE) -ENDIF -IF (ALLOCATED(MiscData%ChordAngleLE)) THEN - DEALLOCATE(MiscData%ChordAngleLE) -ENDIF -IF (ALLOCATED(MiscData%SpanAngleLE)) THEN - DEALLOCATE(MiscData%SpanAngleLE) -ENDIF -IF (ALLOCATED(MiscData%rTEtoObserve)) THEN - DEALLOCATE(MiscData%rTEtoObserve) -ENDIF -IF (ALLOCATED(MiscData%rLEtoObserve)) THEN - DEALLOCATE(MiscData%rLEtoObserve) -ENDIF -IF (ALLOCATED(MiscData%LE_Location)) THEN - DEALLOCATE(MiscData%LE_Location) -ENDIF -IF (ALLOCATED(MiscData%SPLLBL)) THEN - DEALLOCATE(MiscData%SPLLBL) -ENDIF -IF (ALLOCATED(MiscData%SPLP)) THEN - DEALLOCATE(MiscData%SPLP) -ENDIF -IF (ALLOCATED(MiscData%SPLS)) THEN - DEALLOCATE(MiscData%SPLS) -ENDIF -IF (ALLOCATED(MiscData%SPLALPH)) THEN - DEALLOCATE(MiscData%SPLALPH) -ENDIF -IF (ALLOCATED(MiscData%SPLTBL)) THEN - DEALLOCATE(MiscData%SPLTBL) -ENDIF -IF (ALLOCATED(MiscData%SPLTIP)) THEN - DEALLOCATE(MiscData%SPLTIP) -ENDIF -IF (ALLOCATED(MiscData%SPLTI)) THEN - DEALLOCATE(MiscData%SPLTI) -ENDIF -IF (ALLOCATED(MiscData%SPLTIGui)) THEN - DEALLOCATE(MiscData%SPLTIGui) -ENDIF -IF (ALLOCATED(MiscData%SPLBLUNT)) THEN - DEALLOCATE(MiscData%SPLBLUNT) -ENDIF -IF (ALLOCATED(MiscData%CfVar)) THEN - DEALLOCATE(MiscData%CfVar) -ENDIF -IF (ALLOCATED(MiscData%d99Var)) THEN - DEALLOCATE(MiscData%d99Var) -ENDIF -IF (ALLOCATED(MiscData%dStarVar)) THEN - DEALLOCATE(MiscData%dStarVar) -ENDIF -IF (ALLOCATED(MiscData%EdgeVelVar)) THEN - DEALLOCATE(MiscData%EdgeVelVar) -ENDIF - END SUBROUTINE AA_DestroyMisc - - SUBROUTINE AA_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(AA_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 = 'AA_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 ! 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 - Int_BufSz = Int_BufSz + 1 ! ChordAngleTE allocated yes/no - IF ( ALLOCATED(InData%ChordAngleTE) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! ChordAngleTE upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%ChordAngleTE) ! ChordAngleTE - END IF - Int_BufSz = Int_BufSz + 1 ! SpanAngleTE allocated yes/no - IF ( ALLOCATED(InData%SpanAngleTE) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! SpanAngleTE upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%SpanAngleTE) ! SpanAngleTE - END IF - Int_BufSz = Int_BufSz + 1 ! ChordAngleLE allocated yes/no - IF ( ALLOCATED(InData%ChordAngleLE) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! ChordAngleLE upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%ChordAngleLE) ! ChordAngleLE - END IF - Int_BufSz = Int_BufSz + 1 ! SpanAngleLE allocated yes/no - IF ( ALLOCATED(InData%SpanAngleLE) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! SpanAngleLE upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%SpanAngleLE) ! SpanAngleLE - END IF - Int_BufSz = Int_BufSz + 1 ! rTEtoObserve allocated yes/no - IF ( ALLOCATED(InData%rTEtoObserve) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! rTEtoObserve upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%rTEtoObserve) ! rTEtoObserve - END IF - Int_BufSz = Int_BufSz + 1 ! rLEtoObserve allocated yes/no - IF ( ALLOCATED(InData%rLEtoObserve) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! rLEtoObserve upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%rLEtoObserve) ! rLEtoObserve - END IF - Int_BufSz = Int_BufSz + 1 ! LE_Location allocated yes/no - IF ( ALLOCATED(InData%LE_Location) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! LE_Location upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%LE_Location) ! LE_Location - END IF - Re_BufSz = Re_BufSz + 1 ! RotSpeedAoA - Int_BufSz = Int_BufSz + 1 ! SPLLBL allocated yes/no - IF ( ALLOCATED(InData%SPLLBL) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! SPLLBL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%SPLLBL) ! SPLLBL - END IF - Int_BufSz = Int_BufSz + 1 ! SPLP allocated yes/no - IF ( ALLOCATED(InData%SPLP) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! SPLP upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%SPLP) ! SPLP - END IF - Int_BufSz = Int_BufSz + 1 ! SPLS allocated yes/no - IF ( ALLOCATED(InData%SPLS) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! SPLS upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%SPLS) ! SPLS - END IF - Int_BufSz = Int_BufSz + 1 ! SPLALPH allocated yes/no - IF ( ALLOCATED(InData%SPLALPH) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! SPLALPH upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%SPLALPH) ! SPLALPH - END IF - Int_BufSz = Int_BufSz + 1 ! SPLTBL allocated yes/no - IF ( ALLOCATED(InData%SPLTBL) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! SPLTBL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%SPLTBL) ! SPLTBL - END IF - Int_BufSz = Int_BufSz + 1 ! SPLTIP allocated yes/no - IF ( ALLOCATED(InData%SPLTIP) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! SPLTIP upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%SPLTIP) ! SPLTIP - END IF - Int_BufSz = Int_BufSz + 1 ! SPLTI allocated yes/no - IF ( ALLOCATED(InData%SPLTI) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! SPLTI upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%SPLTI) ! SPLTI - END IF - Int_BufSz = Int_BufSz + 1 ! SPLTIGui allocated yes/no - IF ( ALLOCATED(InData%SPLTIGui) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! SPLTIGui upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%SPLTIGui) ! SPLTIGui - END IF - Int_BufSz = Int_BufSz + 1 ! SPLBLUNT allocated yes/no - IF ( ALLOCATED(InData%SPLBLUNT) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! SPLBLUNT upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%SPLBLUNT) ! SPLBLUNT - END IF - Int_BufSz = Int_BufSz + 1 ! CfVar allocated yes/no - IF ( ALLOCATED(InData%CfVar) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! CfVar upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CfVar) ! CfVar - END IF - Int_BufSz = Int_BufSz + 1 ! d99Var allocated yes/no - IF ( ALLOCATED(InData%d99Var) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! d99Var upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%d99Var) ! d99Var - END IF - Int_BufSz = Int_BufSz + 1 ! dStarVar allocated yes/no - IF ( ALLOCATED(InData%dStarVar) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! dStarVar upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%dStarVar) ! dStarVar - END IF - Int_BufSz = Int_BufSz + 1 ! EdgeVelVar allocated yes/no - IF ( ALLOCATED(InData%EdgeVelVar) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! EdgeVelVar upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%EdgeVelVar) ! EdgeVelVar - END IF - Int_BufSz = Int_BufSz + 1 ! speccou - Int_BufSz = Int_BufSz + 1 ! filesopen - 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%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 - IF ( .NOT. ALLOCATED(InData%ChordAngleTE) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ChordAngleTE,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ChordAngleTE,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ChordAngleTE,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ChordAngleTE,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ChordAngleTE,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ChordAngleTE,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%ChordAngleTE,3), UBOUND(InData%ChordAngleTE,3) - DO i2 = LBOUND(InData%ChordAngleTE,2), UBOUND(InData%ChordAngleTE,2) - DO i1 = LBOUND(InData%ChordAngleTE,1), UBOUND(InData%ChordAngleTE,1) - ReKiBuf(Re_Xferred) = InData%ChordAngleTE(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%SpanAngleTE) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SpanAngleTE,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SpanAngleTE,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SpanAngleTE,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SpanAngleTE,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SpanAngleTE,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SpanAngleTE,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%SpanAngleTE,3), UBOUND(InData%SpanAngleTE,3) - DO i2 = LBOUND(InData%SpanAngleTE,2), UBOUND(InData%SpanAngleTE,2) - DO i1 = LBOUND(InData%SpanAngleTE,1), UBOUND(InData%SpanAngleTE,1) - ReKiBuf(Re_Xferred) = InData%SpanAngleTE(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ChordAngleLE) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ChordAngleLE,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ChordAngleLE,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ChordAngleLE,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ChordAngleLE,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ChordAngleLE,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ChordAngleLE,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%ChordAngleLE,3), UBOUND(InData%ChordAngleLE,3) - DO i2 = LBOUND(InData%ChordAngleLE,2), UBOUND(InData%ChordAngleLE,2) - DO i1 = LBOUND(InData%ChordAngleLE,1), UBOUND(InData%ChordAngleLE,1) - ReKiBuf(Re_Xferred) = InData%ChordAngleLE(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%SpanAngleLE) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SpanAngleLE,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SpanAngleLE,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SpanAngleLE,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SpanAngleLE,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SpanAngleLE,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SpanAngleLE,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%SpanAngleLE,3), UBOUND(InData%SpanAngleLE,3) - DO i2 = LBOUND(InData%SpanAngleLE,2), UBOUND(InData%SpanAngleLE,2) - DO i1 = LBOUND(InData%SpanAngleLE,1), UBOUND(InData%SpanAngleLE,1) - ReKiBuf(Re_Xferred) = InData%SpanAngleLE(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%rTEtoObserve) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rTEtoObserve,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rTEtoObserve,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rTEtoObserve,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rTEtoObserve,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rTEtoObserve,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rTEtoObserve,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%rTEtoObserve,3), UBOUND(InData%rTEtoObserve,3) - DO i2 = LBOUND(InData%rTEtoObserve,2), UBOUND(InData%rTEtoObserve,2) - DO i1 = LBOUND(InData%rTEtoObserve,1), UBOUND(InData%rTEtoObserve,1) - ReKiBuf(Re_Xferred) = InData%rTEtoObserve(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%rLEtoObserve) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rLEtoObserve,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rLEtoObserve,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rLEtoObserve,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rLEtoObserve,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rLEtoObserve,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rLEtoObserve,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%rLEtoObserve,3), UBOUND(InData%rLEtoObserve,3) - DO i2 = LBOUND(InData%rLEtoObserve,2), UBOUND(InData%rLEtoObserve,2) - DO i1 = LBOUND(InData%rLEtoObserve,1), UBOUND(InData%rLEtoObserve,1) - ReKiBuf(Re_Xferred) = InData%rLEtoObserve(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LE_Location) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LE_Location,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LE_Location,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LE_Location,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LE_Location,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LE_Location,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LE_Location,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%LE_Location,3), UBOUND(InData%LE_Location,3) - DO i2 = LBOUND(InData%LE_Location,2), UBOUND(InData%LE_Location,2) - DO i1 = LBOUND(InData%LE_Location,1), UBOUND(InData%LE_Location,1) - ReKiBuf(Re_Xferred) = InData%LE_Location(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - ReKiBuf(Re_Xferred) = InData%RotSpeedAoA - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%SPLLBL) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SPLLBL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SPLLBL,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%SPLLBL,1), UBOUND(InData%SPLLBL,1) - ReKiBuf(Re_Xferred) = InData%SPLLBL(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%SPLP) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SPLP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SPLP,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%SPLP,1), UBOUND(InData%SPLP,1) - ReKiBuf(Re_Xferred) = InData%SPLP(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%SPLS) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SPLS,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SPLS,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%SPLS,1), UBOUND(InData%SPLS,1) - ReKiBuf(Re_Xferred) = InData%SPLS(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%SPLALPH) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SPLALPH,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SPLALPH,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%SPLALPH,1), UBOUND(InData%SPLALPH,1) - ReKiBuf(Re_Xferred) = InData%SPLALPH(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%SPLTBL) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SPLTBL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SPLTBL,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%SPLTBL,1), UBOUND(InData%SPLTBL,1) - ReKiBuf(Re_Xferred) = InData%SPLTBL(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%SPLTIP) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SPLTIP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SPLTIP,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%SPLTIP,1), UBOUND(InData%SPLTIP,1) - ReKiBuf(Re_Xferred) = InData%SPLTIP(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%SPLTI) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SPLTI,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SPLTI,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%SPLTI,1), UBOUND(InData%SPLTI,1) - ReKiBuf(Re_Xferred) = InData%SPLTI(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%SPLTIGui) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SPLTIGui,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SPLTIGui,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%SPLTIGui,1), UBOUND(InData%SPLTIGui,1) - ReKiBuf(Re_Xferred) = InData%SPLTIGui(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%SPLBLUNT) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SPLBLUNT,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SPLBLUNT,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%SPLBLUNT,1), UBOUND(InData%SPLBLUNT,1) - ReKiBuf(Re_Xferred) = InData%SPLBLUNT(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CfVar) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CfVar,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CfVar,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%CfVar,1), UBOUND(InData%CfVar,1) - ReKiBuf(Re_Xferred) = InData%CfVar(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%d99Var) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%d99Var,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%d99Var,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%d99Var,1), UBOUND(InData%d99Var,1) - ReKiBuf(Re_Xferred) = InData%d99Var(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%dStarVar) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%dStarVar,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dStarVar,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%dStarVar,1), UBOUND(InData%dStarVar,1) - ReKiBuf(Re_Xferred) = InData%dStarVar(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%EdgeVelVar) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%EdgeVelVar,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%EdgeVelVar,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%EdgeVelVar,1), UBOUND(InData%EdgeVelVar,1) - ReKiBuf(Re_Xferred) = InData%EdgeVelVar(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%speccou - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%filesopen - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE AA_PackMisc - - SUBROUTINE AA_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(AA_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) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AA_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 ! 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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ChordAngleTE not allocated - Int_Xferred = Int_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%ChordAngleTE)) DEALLOCATE(OutData%ChordAngleTE) - ALLOCATE(OutData%ChordAngleTE(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%ChordAngleTE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%ChordAngleTE,3), UBOUND(OutData%ChordAngleTE,3) - DO i2 = LBOUND(OutData%ChordAngleTE,2), UBOUND(OutData%ChordAngleTE,2) - DO i1 = LBOUND(OutData%ChordAngleTE,1), UBOUND(OutData%ChordAngleTE,1) - OutData%ChordAngleTE(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 ! SpanAngleTE not allocated - Int_Xferred = Int_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%SpanAngleTE)) DEALLOCATE(OutData%SpanAngleTE) - ALLOCATE(OutData%SpanAngleTE(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%SpanAngleTE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%SpanAngleTE,3), UBOUND(OutData%SpanAngleTE,3) - DO i2 = LBOUND(OutData%SpanAngleTE,2), UBOUND(OutData%SpanAngleTE,2) - DO i1 = LBOUND(OutData%SpanAngleTE,1), UBOUND(OutData%SpanAngleTE,1) - OutData%SpanAngleTE(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 ! ChordAngleLE not allocated - Int_Xferred = Int_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%ChordAngleLE)) DEALLOCATE(OutData%ChordAngleLE) - ALLOCATE(OutData%ChordAngleLE(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%ChordAngleLE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%ChordAngleLE,3), UBOUND(OutData%ChordAngleLE,3) - DO i2 = LBOUND(OutData%ChordAngleLE,2), UBOUND(OutData%ChordAngleLE,2) - DO i1 = LBOUND(OutData%ChordAngleLE,1), UBOUND(OutData%ChordAngleLE,1) - OutData%ChordAngleLE(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 ! SpanAngleLE not allocated - Int_Xferred = Int_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%SpanAngleLE)) DEALLOCATE(OutData%SpanAngleLE) - ALLOCATE(OutData%SpanAngleLE(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%SpanAngleLE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%SpanAngleLE,3), UBOUND(OutData%SpanAngleLE,3) - DO i2 = LBOUND(OutData%SpanAngleLE,2), UBOUND(OutData%SpanAngleLE,2) - DO i1 = LBOUND(OutData%SpanAngleLE,1), UBOUND(OutData%SpanAngleLE,1) - OutData%SpanAngleLE(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 ! rTEtoObserve not allocated - Int_Xferred = Int_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%rTEtoObserve)) DEALLOCATE(OutData%rTEtoObserve) - ALLOCATE(OutData%rTEtoObserve(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%rTEtoObserve.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%rTEtoObserve,3), UBOUND(OutData%rTEtoObserve,3) - DO i2 = LBOUND(OutData%rTEtoObserve,2), UBOUND(OutData%rTEtoObserve,2) - DO i1 = LBOUND(OutData%rTEtoObserve,1), UBOUND(OutData%rTEtoObserve,1) - OutData%rTEtoObserve(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 ! rLEtoObserve not allocated - Int_Xferred = Int_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%rLEtoObserve)) DEALLOCATE(OutData%rLEtoObserve) - ALLOCATE(OutData%rLEtoObserve(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%rLEtoObserve.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%rLEtoObserve,3), UBOUND(OutData%rLEtoObserve,3) - DO i2 = LBOUND(OutData%rLEtoObserve,2), UBOUND(OutData%rLEtoObserve,2) - DO i1 = LBOUND(OutData%rLEtoObserve,1), UBOUND(OutData%rLEtoObserve,1) - OutData%rLEtoObserve(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 ! LE_Location not allocated - Int_Xferred = Int_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%LE_Location)) DEALLOCATE(OutData%LE_Location) - ALLOCATE(OutData%LE_Location(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%LE_Location.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%LE_Location,3), UBOUND(OutData%LE_Location,3) - DO i2 = LBOUND(OutData%LE_Location,2), UBOUND(OutData%LE_Location,2) - DO i1 = LBOUND(OutData%LE_Location,1), UBOUND(OutData%LE_Location,1) - OutData%LE_Location(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - OutData%RotSpeedAoA = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SPLLBL not allocated - Int_Xferred = Int_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%SPLLBL)) DEALLOCATE(OutData%SPLLBL) - ALLOCATE(OutData%SPLLBL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SPLLBL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%SPLLBL,1), UBOUND(OutData%SPLLBL,1) - OutData%SPLLBL(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SPLP not allocated - Int_Xferred = Int_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%SPLP)) DEALLOCATE(OutData%SPLP) - ALLOCATE(OutData%SPLP(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SPLP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%SPLP,1), UBOUND(OutData%SPLP,1) - OutData%SPLP(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SPLS not allocated - Int_Xferred = Int_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%SPLS)) DEALLOCATE(OutData%SPLS) - ALLOCATE(OutData%SPLS(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SPLS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%SPLS,1), UBOUND(OutData%SPLS,1) - OutData%SPLS(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SPLALPH not allocated - Int_Xferred = Int_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%SPLALPH)) DEALLOCATE(OutData%SPLALPH) - ALLOCATE(OutData%SPLALPH(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SPLALPH.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%SPLALPH,1), UBOUND(OutData%SPLALPH,1) - OutData%SPLALPH(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SPLTBL not allocated - Int_Xferred = Int_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%SPLTBL)) DEALLOCATE(OutData%SPLTBL) - ALLOCATE(OutData%SPLTBL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SPLTBL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%SPLTBL,1), UBOUND(OutData%SPLTBL,1) - OutData%SPLTBL(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SPLTIP not allocated - Int_Xferred = Int_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%SPLTIP)) DEALLOCATE(OutData%SPLTIP) - ALLOCATE(OutData%SPLTIP(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SPLTIP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%SPLTIP,1), UBOUND(OutData%SPLTIP,1) - OutData%SPLTIP(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SPLTI not allocated - Int_Xferred = Int_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%SPLTI)) DEALLOCATE(OutData%SPLTI) - ALLOCATE(OutData%SPLTI(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SPLTI.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%SPLTI,1), UBOUND(OutData%SPLTI,1) - OutData%SPLTI(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SPLTIGui not allocated - Int_Xferred = Int_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%SPLTIGui)) DEALLOCATE(OutData%SPLTIGui) - ALLOCATE(OutData%SPLTIGui(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SPLTIGui.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%SPLTIGui,1), UBOUND(OutData%SPLTIGui,1) - OutData%SPLTIGui(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SPLBLUNT not allocated - Int_Xferred = Int_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%SPLBLUNT)) DEALLOCATE(OutData%SPLBLUNT) - ALLOCATE(OutData%SPLBLUNT(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SPLBLUNT.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%SPLBLUNT,1), UBOUND(OutData%SPLBLUNT,1) - OutData%SPLBLUNT(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CfVar not allocated - Int_Xferred = Int_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%CfVar)) DEALLOCATE(OutData%CfVar) - ALLOCATE(OutData%CfVar(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CfVar.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%CfVar,1), UBOUND(OutData%CfVar,1) - OutData%CfVar(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! d99Var not allocated - Int_Xferred = Int_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%d99Var)) DEALLOCATE(OutData%d99Var) - ALLOCATE(OutData%d99Var(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%d99Var.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%d99Var,1), UBOUND(OutData%d99Var,1) - OutData%d99Var(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! dStarVar not allocated - Int_Xferred = Int_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%dStarVar)) DEALLOCATE(OutData%dStarVar) - ALLOCATE(OutData%dStarVar(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%dStarVar.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%dStarVar,1), UBOUND(OutData%dStarVar,1) - OutData%dStarVar(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! EdgeVelVar not allocated - Int_Xferred = Int_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%EdgeVelVar)) DEALLOCATE(OutData%EdgeVelVar) - ALLOCATE(OutData%EdgeVelVar(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%EdgeVelVar.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%EdgeVelVar,1), UBOUND(OutData%EdgeVelVar,1) - OutData%EdgeVelVar(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%speccou = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%filesopen = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE AA_UnPackMisc - - SUBROUTINE AA_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AA_ParameterType), INTENT(IN) :: SrcParamData - TYPE(AA_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) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AA_CopyParam' -! + ErrMsg = '' + if (allocated(InputFileData%ObsX)) then + deallocate(InputFileData%ObsX) + end if + if (allocated(InputFileData%ObsY)) then + deallocate(InputFileData%ObsY) + end if + if (allocated(InputFileData%ObsZ)) then + deallocate(InputFileData%ObsZ) + end if + if (allocated(InputFileData%BladeProps)) then + LB(1:1) = lbound(InputFileData%BladeProps) + UB(1:1) = ubound(InputFileData%BladeProps) + do i1 = LB(1), UB(1) + call AA_DestroyBladePropsType(InputFileData%BladeProps(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InputFileData%BladeProps) + end if + if (allocated(InputFileData%AAoutfile)) then + deallocate(InputFileData%AAoutfile) + end if + if (allocated(InputFileData%ReListBL)) then + deallocate(InputFileData%ReListBL) + end if + if (allocated(InputFileData%AoAListBL)) then + deallocate(InputFileData%AoAListBL) + end if + if (allocated(InputFileData%Pres_DispThick)) then + deallocate(InputFileData%Pres_DispThick) + end if + if (allocated(InputFileData%Suct_DispThick)) then + deallocate(InputFileData%Suct_DispThick) + end if + if (allocated(InputFileData%Pres_BLThick)) then + deallocate(InputFileData%Pres_BLThick) + end if + if (allocated(InputFileData%Suct_BLThick)) then + deallocate(InputFileData%Suct_BLThick) + end if + if (allocated(InputFileData%Pres_Cf)) then + deallocate(InputFileData%Pres_Cf) + end if + if (allocated(InputFileData%Suct_Cf)) then + deallocate(InputFileData%Suct_Cf) + end if + if (allocated(InputFileData%Pres_EdgeVelRat)) then + deallocate(InputFileData%Pres_EdgeVelRat) + end if + if (allocated(InputFileData%Suct_EdgeVelRat)) then + deallocate(InputFileData%Suct_EdgeVelRat) + end if +end subroutine + +subroutine AA_PackInputFile(RF, Indata) + type(RegFile), intent(inout) :: RF + type(AA_InputFile), intent(in) :: InData + character(*), parameter :: RoutineName = 'AA_PackInputFile' + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DT_AA) + call RegPack(RF, InData%IBLUNT) + call RegPack(RF, InData%ILAM) + call RegPack(RF, InData%ITIP) + call RegPack(RF, InData%ITRIP) + call RegPack(RF, InData%ITURB) + call RegPack(RF, InData%IInflow) + call RegPack(RF, InData%X_BLMethod) + call RegPack(RF, InData%TICalcMeth) + call RegPack(RF, InData%NReListBL) + call RegPack(RF, InData%aweightflag) + call RegPack(RF, InData%ROUND) + call RegPack(RF, InData%ALPRAT) + call RegPack(RF, InData%AA_Bl_Prcntge) + call RegPack(RF, InData%NrObsLoc) + call RegPackAlloc(RF, InData%ObsX) + call RegPackAlloc(RF, InData%ObsY) + call RegPackAlloc(RF, InData%ObsZ) + call RegPack(RF, allocated(InData%BladeProps)) + if (allocated(InData%BladeProps)) then + call RegPackBounds(RF, 1, lbound(InData%BladeProps), ubound(InData%BladeProps)) + LB(1:1) = lbound(InData%BladeProps) + UB(1:1) = ubound(InData%BladeProps) + do i1 = LB(1), UB(1) + call AA_PackBladePropsType(RF, InData%BladeProps(i1)) + end do + end if + call RegPack(RF, InData%NrOutFile) + call RegPackAlloc(RF, InData%AAoutfile) + call RegPack(RF, InData%FTitle) + call RegPack(RF, InData%AAStart) + call RegPack(RF, InData%TI) + call RegPack(RF, InData%avgV) + call RegPack(RF, InData%Lturb) + call RegPackAlloc(RF, InData%ReListBL) + call RegPackAlloc(RF, InData%AoAListBL) + call RegPackAlloc(RF, InData%Pres_DispThick) + call RegPackAlloc(RF, InData%Suct_DispThick) + call RegPackAlloc(RF, InData%Pres_BLThick) + call RegPackAlloc(RF, InData%Suct_BLThick) + call RegPackAlloc(RF, InData%Pres_Cf) + call RegPackAlloc(RF, InData%Suct_Cf) + call RegPackAlloc(RF, InData%Pres_EdgeVelRat) + call RegPackAlloc(RF, InData%Suct_EdgeVelRat) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AA_UnPackInputFile(RF, OutData) + type(RegFile), intent(inout) :: RF + type(AA_InputFile), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AA_UnPackInputFile' + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DT_AA); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%IBLUNT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ILAM); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ITIP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ITRIP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ITURB); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%IInflow); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%X_BLMethod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TICalcMeth); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NReListBL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%aweightflag); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ROUND); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ALPRAT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AA_Bl_Prcntge); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NrObsLoc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ObsX); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ObsY); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ObsZ); if (RegCheckErr(RF, RoutineName)) return + if (allocated(OutData%BladeProps)) deallocate(OutData%BladeProps) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%BladeProps(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeProps.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AA_UnpackBladePropsType(RF, OutData%BladeProps(i1)) ! BladeProps + end do + end if + call RegUnpack(RF, OutData%NrOutFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AAoutfile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FTitle); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AAStart); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TI); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%avgV); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Lturb); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ReListBL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AoAListBL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Pres_DispThick); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Suct_DispThick); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Pres_BLThick); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Suct_BLThick); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Pres_Cf); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Suct_Cf); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Pres_EdgeVelRat); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Suct_EdgeVelRat); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AA_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) + type(AA_ContinuousStateType), intent(in) :: SrcContStateData + type(AA_ContinuousStateType), intent(inout) :: DstContStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AA_CopyContState' ErrStat = ErrID_None - ErrMsg = "" - DstParamData%DT = SrcParamData%DT - DstParamData%IBLUNT = SrcParamData%IBLUNT - DstParamData%ILAM = SrcParamData%ILAM - DstParamData%ITIP = SrcParamData%ITIP - DstParamData%ITRIP = SrcParamData%ITRIP - DstParamData%ITURB = SrcParamData%ITURB - DstParamData%IInflow = SrcParamData%IInflow - DstParamData%X_BLMethod = SrcParamData%X_BLMethod - DstParamData%TICalcMeth = SrcParamData%TICalcMeth - DstParamData%ROUND = SrcParamData%ROUND - DstParamData%ALPRAT = SrcParamData%ALPRAT - DstParamData%NumBlades = SrcParamData%NumBlades - DstParamData%NumBlNds = SrcParamData%NumBlNds - DstParamData%AirDens = SrcParamData%AirDens - DstParamData%KinVisc = SrcParamData%KinVisc - DstParamData%SpdSound = SrcParamData%SpdSound - DstParamData%HubHeight = SrcParamData%HubHeight - DstParamData%toptip = SrcParamData%toptip - DstParamData%bottip = SrcParamData%bottip -IF (ALLOCATED(SrcParamData%rotorregionlimitsVert)) THEN - i1_l = LBOUND(SrcParamData%rotorregionlimitsVert,1) - i1_u = UBOUND(SrcParamData%rotorregionlimitsVert,1) - IF (.NOT. ALLOCATED(DstParamData%rotorregionlimitsVert)) THEN - ALLOCATE(DstParamData%rotorregionlimitsVert(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rotorregionlimitsVert.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%rotorregionlimitsVert = SrcParamData%rotorregionlimitsVert -ENDIF -IF (ALLOCATED(SrcParamData%rotorregionlimitsHorz)) THEN - i1_l = LBOUND(SrcParamData%rotorregionlimitsHorz,1) - i1_u = UBOUND(SrcParamData%rotorregionlimitsHorz,1) - IF (.NOT. ALLOCATED(DstParamData%rotorregionlimitsHorz)) THEN - ALLOCATE(DstParamData%rotorregionlimitsHorz(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rotorregionlimitsHorz.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%rotorregionlimitsHorz = SrcParamData%rotorregionlimitsHorz -ENDIF -IF (ALLOCATED(SrcParamData%rotorregionlimitsalph)) THEN - i1_l = LBOUND(SrcParamData%rotorregionlimitsalph,1) - i1_u = UBOUND(SrcParamData%rotorregionlimitsalph,1) - IF (.NOT. ALLOCATED(DstParamData%rotorregionlimitsalph)) THEN - ALLOCATE(DstParamData%rotorregionlimitsalph(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rotorregionlimitsalph.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%rotorregionlimitsalph = SrcParamData%rotorregionlimitsalph -ENDIF -IF (ALLOCATED(SrcParamData%rotorregionlimitsrad)) THEN - i1_l = LBOUND(SrcParamData%rotorregionlimitsrad,1) - i1_u = UBOUND(SrcParamData%rotorregionlimitsrad,1) - IF (.NOT. ALLOCATED(DstParamData%rotorregionlimitsrad)) THEN - ALLOCATE(DstParamData%rotorregionlimitsrad(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rotorregionlimitsrad.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%rotorregionlimitsrad = SrcParamData%rotorregionlimitsrad -ENDIF - DstParamData%NrObsLoc = SrcParamData%NrObsLoc - DstParamData%aweightflag = SrcParamData%aweightflag - DstParamData%TxtFileOutput = SrcParamData%TxtFileOutput - DstParamData%AAStart = SrcParamData%AAStart -IF (ALLOCATED(SrcParamData%ObsX)) THEN - i1_l = LBOUND(SrcParamData%ObsX,1) - i1_u = UBOUND(SrcParamData%ObsX,1) - IF (.NOT. ALLOCATED(DstParamData%ObsX)) THEN - ALLOCATE(DstParamData%ObsX(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ObsX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%ObsX = SrcParamData%ObsX -ENDIF -IF (ALLOCATED(SrcParamData%ObsY)) THEN - i1_l = LBOUND(SrcParamData%ObsY,1) - i1_u = UBOUND(SrcParamData%ObsY,1) - IF (.NOT. ALLOCATED(DstParamData%ObsY)) THEN - ALLOCATE(DstParamData%ObsY(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ObsY.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%ObsY = SrcParamData%ObsY -ENDIF -IF (ALLOCATED(SrcParamData%ObsZ)) THEN - i1_l = LBOUND(SrcParamData%ObsZ,1) - i1_u = UBOUND(SrcParamData%ObsZ,1) - IF (.NOT. ALLOCATED(DstParamData%ObsZ)) THEN - ALLOCATE(DstParamData%ObsZ(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ObsZ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%ObsZ = SrcParamData%ObsZ -ENDIF -IF (ALLOCATED(SrcParamData%FreqList)) THEN - i1_l = LBOUND(SrcParamData%FreqList,1) - i1_u = UBOUND(SrcParamData%FreqList,1) - IF (.NOT. ALLOCATED(DstParamData%FreqList)) THEN - ALLOCATE(DstParamData%FreqList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%FreqList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%FreqList = SrcParamData%FreqList -ENDIF -IF (ALLOCATED(SrcParamData%Aweight)) THEN - i1_l = LBOUND(SrcParamData%Aweight,1) - i1_u = UBOUND(SrcParamData%Aweight,1) - IF (.NOT. ALLOCATED(DstParamData%Aweight)) THEN - ALLOCATE(DstParamData%Aweight(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Aweight.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Aweight = SrcParamData%Aweight -ENDIF - DstParamData%Fsample = SrcParamData%Fsample - DstParamData%total_sample = SrcParamData%total_sample - DstParamData%total_sampleTI = SrcParamData%total_sampleTI - DstParamData%AA_Bl_Prcntge = SrcParamData%AA_Bl_Prcntge - DstParamData%startnode = SrcParamData%startnode - DstParamData%Lturb = SrcParamData%Lturb - DstParamData%AvgV = SrcParamData%AvgV - DstParamData%dz_turb_in = SrcParamData%dz_turb_in - DstParamData%dy_turb_in = SrcParamData%dy_turb_in -IF (ALLOCATED(SrcParamData%TI_Grid_In)) THEN - i1_l = LBOUND(SrcParamData%TI_Grid_In,1) - i1_u = UBOUND(SrcParamData%TI_Grid_In,1) - i2_l = LBOUND(SrcParamData%TI_Grid_In,2) - i2_u = UBOUND(SrcParamData%TI_Grid_In,2) - IF (.NOT. ALLOCATED(DstParamData%TI_Grid_In)) THEN - ALLOCATE(DstParamData%TI_Grid_In(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TI_Grid_In.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%TI_Grid_In = SrcParamData%TI_Grid_In -ENDIF - DstParamData%FTitle = SrcParamData%FTitle - DstParamData%outFmt = SrcParamData%outFmt - DstParamData%NrOutFile = SrcParamData%NrOutFile - DstParamData%delim = SrcParamData%delim - DstParamData%NumOuts = SrcParamData%NumOuts - DstParamData%NumOutsForPE = SrcParamData%NumOutsForPE - DstParamData%NumOutsForSep = SrcParamData%NumOutsForSep - DstParamData%NumOutsForNodes = SrcParamData%NumOutsForNodes - DstParamData%unOutFile = SrcParamData%unOutFile - DstParamData%unOutFile2 = SrcParamData%unOutFile2 - DstParamData%unOutFile3 = SrcParamData%unOutFile3 - DstParamData%unOutFile4 = SrcParamData%unOutFile4 - 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 -IF (ALLOCATED(SrcParamData%StallStart)) THEN - i1_l = LBOUND(SrcParamData%StallStart,1) - i1_u = UBOUND(SrcParamData%StallStart,1) - i2_l = LBOUND(SrcParamData%StallStart,2) - i2_u = UBOUND(SrcParamData%StallStart,2) - IF (.NOT. ALLOCATED(DstParamData%StallStart)) THEN - ALLOCATE(DstParamData%StallStart(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%StallStart.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%StallStart = SrcParamData%StallStart -ENDIF -IF (ALLOCATED(SrcParamData%TEThick)) THEN - i1_l = LBOUND(SrcParamData%TEThick,1) - i1_u = UBOUND(SrcParamData%TEThick,1) - i2_l = LBOUND(SrcParamData%TEThick,2) - i2_u = UBOUND(SrcParamData%TEThick,2) - IF (.NOT. ALLOCATED(DstParamData%TEThick)) THEN - ALLOCATE(DstParamData%TEThick(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TEThick.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%TEThick = SrcParamData%TEThick -ENDIF -IF (ALLOCATED(SrcParamData%TEAngle)) THEN - i1_l = LBOUND(SrcParamData%TEAngle,1) - i1_u = UBOUND(SrcParamData%TEAngle,1) - i2_l = LBOUND(SrcParamData%TEAngle,2) - i2_u = UBOUND(SrcParamData%TEAngle,2) - IF (.NOT. ALLOCATED(DstParamData%TEAngle)) THEN - ALLOCATE(DstParamData%TEAngle(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TEAngle.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%TEAngle = SrcParamData%TEAngle -ENDIF -IF (ALLOCATED(SrcParamData%AerCent)) THEN - i1_l = LBOUND(SrcParamData%AerCent,1) - i1_u = UBOUND(SrcParamData%AerCent,1) - i2_l = LBOUND(SrcParamData%AerCent,2) - i2_u = UBOUND(SrcParamData%AerCent,2) - i3_l = LBOUND(SrcParamData%AerCent,3) - i3_u = UBOUND(SrcParamData%AerCent,3) - IF (.NOT. ALLOCATED(DstParamData%AerCent)) THEN - ALLOCATE(DstParamData%AerCent(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AerCent.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%AerCent = SrcParamData%AerCent -ENDIF -IF (ALLOCATED(SrcParamData%BlAFID)) THEN - i1_l = LBOUND(SrcParamData%BlAFID,1) - i1_u = UBOUND(SrcParamData%BlAFID,1) - i2_l = LBOUND(SrcParamData%BlAFID,2) - i2_u = UBOUND(SrcParamData%BlAFID,2) - IF (.NOT. ALLOCATED(DstParamData%BlAFID)) THEN - ALLOCATE(DstParamData%BlAFID(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BlAFID.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%BlAFID = SrcParamData%BlAFID -ENDIF -IF (ALLOCATED(SrcParamData%AFInfo)) THEN - i1_l = LBOUND(SrcParamData%AFInfo,1) - i1_u = UBOUND(SrcParamData%AFInfo,1) - IF (.NOT. ALLOCATED(DstParamData%AFInfo)) THEN - ALLOCATE(DstParamData%AFInfo(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AFInfo.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcParamData%AFInfo,1), UBOUND(SrcParamData%AFInfo,1) - CALL AFI_CopyParam( SrcParamData%AFInfo(i1), DstParamData%AFInfo(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcParamData%AFLECo)) THEN - i1_l = LBOUND(SrcParamData%AFLECo,1) - i1_u = UBOUND(SrcParamData%AFLECo,1) - i2_l = LBOUND(SrcParamData%AFLECo,2) - i2_u = UBOUND(SrcParamData%AFLECo,2) - i3_l = LBOUND(SrcParamData%AFLECo,3) - i3_u = UBOUND(SrcParamData%AFLECo,3) - IF (.NOT. ALLOCATED(DstParamData%AFLECo)) THEN - ALLOCATE(DstParamData%AFLECo(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AFLECo.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%AFLECo = SrcParamData%AFLECo -ENDIF -IF (ALLOCATED(SrcParamData%AFTECo)) THEN - i1_l = LBOUND(SrcParamData%AFTECo,1) - i1_u = UBOUND(SrcParamData%AFTECo,1) - i2_l = LBOUND(SrcParamData%AFTECo,2) - i2_u = UBOUND(SrcParamData%AFTECo,2) - i3_l = LBOUND(SrcParamData%AFTECo,3) - i3_u = UBOUND(SrcParamData%AFTECo,3) - IF (.NOT. ALLOCATED(DstParamData%AFTECo)) THEN - ALLOCATE(DstParamData%AFTECo(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AFTECo.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%AFTECo = SrcParamData%AFTECo -ENDIF -IF (ALLOCATED(SrcParamData%BlSpn)) THEN - i1_l = LBOUND(SrcParamData%BlSpn,1) - i1_u = UBOUND(SrcParamData%BlSpn,1) - i2_l = LBOUND(SrcParamData%BlSpn,2) - i2_u = UBOUND(SrcParamData%BlSpn,2) - IF (.NOT. ALLOCATED(DstParamData%BlSpn)) THEN - ALLOCATE(DstParamData%BlSpn(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BlSpn.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%BlSpn = SrcParamData%BlSpn -ENDIF -IF (ALLOCATED(SrcParamData%BlChord)) THEN - i1_l = LBOUND(SrcParamData%BlChord,1) - i1_u = UBOUND(SrcParamData%BlChord,1) - i2_l = LBOUND(SrcParamData%BlChord,2) - i2_u = UBOUND(SrcParamData%BlChord,2) - IF (.NOT. ALLOCATED(DstParamData%BlChord)) THEN - ALLOCATE(DstParamData%BlChord(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BlChord.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%BlChord = SrcParamData%BlChord -ENDIF -IF (ALLOCATED(SrcParamData%ReListBL)) THEN - i1_l = LBOUND(SrcParamData%ReListBL,1) - i1_u = UBOUND(SrcParamData%ReListBL,1) - IF (.NOT. ALLOCATED(DstParamData%ReListBL)) THEN - ALLOCATE(DstParamData%ReListBL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ReListBL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%ReListBL = SrcParamData%ReListBL -ENDIF -IF (ALLOCATED(SrcParamData%AOAListBL)) THEN - i1_l = LBOUND(SrcParamData%AOAListBL,1) - i1_u = UBOUND(SrcParamData%AOAListBL,1) - IF (.NOT. ALLOCATED(DstParamData%AOAListBL)) THEN - ALLOCATE(DstParamData%AOAListBL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AOAListBL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%AOAListBL = SrcParamData%AOAListBL -ENDIF -IF (ALLOCATED(SrcParamData%dStarAll1)) THEN - i1_l = LBOUND(SrcParamData%dStarAll1,1) - i1_u = UBOUND(SrcParamData%dStarAll1,1) - i2_l = LBOUND(SrcParamData%dStarAll1,2) - i2_u = UBOUND(SrcParamData%dStarAll1,2) - i3_l = LBOUND(SrcParamData%dStarAll1,3) - i3_u = UBOUND(SrcParamData%dStarAll1,3) - IF (.NOT. ALLOCATED(DstParamData%dStarAll1)) THEN - ALLOCATE(DstParamData%dStarAll1(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%dStarAll1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%dStarAll1 = SrcParamData%dStarAll1 -ENDIF -IF (ALLOCATED(SrcParamData%dStarAll2)) THEN - i1_l = LBOUND(SrcParamData%dStarAll2,1) - i1_u = UBOUND(SrcParamData%dStarAll2,1) - i2_l = LBOUND(SrcParamData%dStarAll2,2) - i2_u = UBOUND(SrcParamData%dStarAll2,2) - i3_l = LBOUND(SrcParamData%dStarAll2,3) - i3_u = UBOUND(SrcParamData%dStarAll2,3) - IF (.NOT. ALLOCATED(DstParamData%dStarAll2)) THEN - ALLOCATE(DstParamData%dStarAll2(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%dStarAll2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%dStarAll2 = SrcParamData%dStarAll2 -ENDIF -IF (ALLOCATED(SrcParamData%d99All1)) THEN - i1_l = LBOUND(SrcParamData%d99All1,1) - i1_u = UBOUND(SrcParamData%d99All1,1) - i2_l = LBOUND(SrcParamData%d99All1,2) - i2_u = UBOUND(SrcParamData%d99All1,2) - i3_l = LBOUND(SrcParamData%d99All1,3) - i3_u = UBOUND(SrcParamData%d99All1,3) - IF (.NOT. ALLOCATED(DstParamData%d99All1)) THEN - ALLOCATE(DstParamData%d99All1(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%d99All1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%d99All1 = SrcParamData%d99All1 -ENDIF -IF (ALLOCATED(SrcParamData%d99All2)) THEN - i1_l = LBOUND(SrcParamData%d99All2,1) - i1_u = UBOUND(SrcParamData%d99All2,1) - i2_l = LBOUND(SrcParamData%d99All2,2) - i2_u = UBOUND(SrcParamData%d99All2,2) - i3_l = LBOUND(SrcParamData%d99All2,3) - i3_u = UBOUND(SrcParamData%d99All2,3) - IF (.NOT. ALLOCATED(DstParamData%d99All2)) THEN - ALLOCATE(DstParamData%d99All2(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%d99All2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%d99All2 = SrcParamData%d99All2 -ENDIF -IF (ALLOCATED(SrcParamData%CfAll1)) THEN - i1_l = LBOUND(SrcParamData%CfAll1,1) - i1_u = UBOUND(SrcParamData%CfAll1,1) - i2_l = LBOUND(SrcParamData%CfAll1,2) - i2_u = UBOUND(SrcParamData%CfAll1,2) - i3_l = LBOUND(SrcParamData%CfAll1,3) - i3_u = UBOUND(SrcParamData%CfAll1,3) - IF (.NOT. ALLOCATED(DstParamData%CfAll1)) THEN - ALLOCATE(DstParamData%CfAll1(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CfAll1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%CfAll1 = SrcParamData%CfAll1 -ENDIF -IF (ALLOCATED(SrcParamData%CfAll2)) THEN - i1_l = LBOUND(SrcParamData%CfAll2,1) - i1_u = UBOUND(SrcParamData%CfAll2,1) - i2_l = LBOUND(SrcParamData%CfAll2,2) - i2_u = UBOUND(SrcParamData%CfAll2,2) - i3_l = LBOUND(SrcParamData%CfAll2,3) - i3_u = UBOUND(SrcParamData%CfAll2,3) - IF (.NOT. ALLOCATED(DstParamData%CfAll2)) THEN - ALLOCATE(DstParamData%CfAll2(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CfAll2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%CfAll2 = SrcParamData%CfAll2 -ENDIF -IF (ALLOCATED(SrcParamData%EdgeVelRat1)) THEN - i1_l = LBOUND(SrcParamData%EdgeVelRat1,1) - i1_u = UBOUND(SrcParamData%EdgeVelRat1,1) - i2_l = LBOUND(SrcParamData%EdgeVelRat1,2) - i2_u = UBOUND(SrcParamData%EdgeVelRat1,2) - i3_l = LBOUND(SrcParamData%EdgeVelRat1,3) - i3_u = UBOUND(SrcParamData%EdgeVelRat1,3) - IF (.NOT. ALLOCATED(DstParamData%EdgeVelRat1)) THEN - ALLOCATE(DstParamData%EdgeVelRat1(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%EdgeVelRat1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%EdgeVelRat1 = SrcParamData%EdgeVelRat1 -ENDIF -IF (ALLOCATED(SrcParamData%EdgeVelRat2)) THEN - i1_l = LBOUND(SrcParamData%EdgeVelRat2,1) - i1_u = UBOUND(SrcParamData%EdgeVelRat2,1) - i2_l = LBOUND(SrcParamData%EdgeVelRat2,2) - i2_u = UBOUND(SrcParamData%EdgeVelRat2,2) - i3_l = LBOUND(SrcParamData%EdgeVelRat2,3) - i3_u = UBOUND(SrcParamData%EdgeVelRat2,3) - IF (.NOT. ALLOCATED(DstParamData%EdgeVelRat2)) THEN - ALLOCATE(DstParamData%EdgeVelRat2(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%EdgeVelRat2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%EdgeVelRat2 = SrcParamData%EdgeVelRat2 -ENDIF -IF (ALLOCATED(SrcParamData%AFThickGuida)) THEN - i1_l = LBOUND(SrcParamData%AFThickGuida,1) - i1_u = UBOUND(SrcParamData%AFThickGuida,1) - i2_l = LBOUND(SrcParamData%AFThickGuida,2) - i2_u = UBOUND(SrcParamData%AFThickGuida,2) - IF (.NOT. ALLOCATED(DstParamData%AFThickGuida)) THEN - ALLOCATE(DstParamData%AFThickGuida(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AFThickGuida.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%AFThickGuida = SrcParamData%AFThickGuida -ENDIF - END SUBROUTINE AA_CopyParam - - SUBROUTINE AA_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(AA_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AA_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(ParamData%rotorregionlimitsVert)) THEN - DEALLOCATE(ParamData%rotorregionlimitsVert) -ENDIF -IF (ALLOCATED(ParamData%rotorregionlimitsHorz)) THEN - DEALLOCATE(ParamData%rotorregionlimitsHorz) -ENDIF -IF (ALLOCATED(ParamData%rotorregionlimitsalph)) THEN - DEALLOCATE(ParamData%rotorregionlimitsalph) -ENDIF -IF (ALLOCATED(ParamData%rotorregionlimitsrad)) THEN - DEALLOCATE(ParamData%rotorregionlimitsrad) -ENDIF -IF (ALLOCATED(ParamData%ObsX)) THEN - DEALLOCATE(ParamData%ObsX) -ENDIF -IF (ALLOCATED(ParamData%ObsY)) THEN - DEALLOCATE(ParamData%ObsY) -ENDIF -IF (ALLOCATED(ParamData%ObsZ)) THEN - DEALLOCATE(ParamData%ObsZ) -ENDIF -IF (ALLOCATED(ParamData%FreqList)) THEN - DEALLOCATE(ParamData%FreqList) -ENDIF -IF (ALLOCATED(ParamData%Aweight)) THEN - DEALLOCATE(ParamData%Aweight) -ENDIF -IF (ALLOCATED(ParamData%TI_Grid_In)) THEN - DEALLOCATE(ParamData%TI_Grid_In) -ENDIF -IF (ALLOCATED(ParamData%OutParam)) THEN -DO i1 = LBOUND(ParamData%OutParam,1), UBOUND(ParamData%OutParam,1) - CALL NWTC_Library_Destroyoutparmtype( ParamData%OutParam(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ParamData%OutParam) -ENDIF -IF (ALLOCATED(ParamData%StallStart)) THEN - DEALLOCATE(ParamData%StallStart) -ENDIF -IF (ALLOCATED(ParamData%TEThick)) THEN - DEALLOCATE(ParamData%TEThick) -ENDIF -IF (ALLOCATED(ParamData%TEAngle)) THEN - DEALLOCATE(ParamData%TEAngle) -ENDIF -IF (ALLOCATED(ParamData%AerCent)) THEN - DEALLOCATE(ParamData%AerCent) -ENDIF -IF (ALLOCATED(ParamData%BlAFID)) THEN - DEALLOCATE(ParamData%BlAFID) -ENDIF -IF (ALLOCATED(ParamData%AFInfo)) THEN -DO i1 = LBOUND(ParamData%AFInfo,1), UBOUND(ParamData%AFInfo,1) - CALL AFI_DestroyParam( ParamData%AFInfo(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ParamData%AFInfo) -ENDIF -IF (ALLOCATED(ParamData%AFLECo)) THEN - DEALLOCATE(ParamData%AFLECo) -ENDIF -IF (ALLOCATED(ParamData%AFTECo)) THEN - DEALLOCATE(ParamData%AFTECo) -ENDIF -IF (ALLOCATED(ParamData%BlSpn)) THEN - DEALLOCATE(ParamData%BlSpn) -ENDIF -IF (ALLOCATED(ParamData%BlChord)) THEN - DEALLOCATE(ParamData%BlChord) -ENDIF -IF (ALLOCATED(ParamData%ReListBL)) THEN - DEALLOCATE(ParamData%ReListBL) -ENDIF -IF (ALLOCATED(ParamData%AOAListBL)) THEN - DEALLOCATE(ParamData%AOAListBL) -ENDIF -IF (ALLOCATED(ParamData%dStarAll1)) THEN - DEALLOCATE(ParamData%dStarAll1) -ENDIF -IF (ALLOCATED(ParamData%dStarAll2)) THEN - DEALLOCATE(ParamData%dStarAll2) -ENDIF -IF (ALLOCATED(ParamData%d99All1)) THEN - DEALLOCATE(ParamData%d99All1) -ENDIF -IF (ALLOCATED(ParamData%d99All2)) THEN - DEALLOCATE(ParamData%d99All2) -ENDIF -IF (ALLOCATED(ParamData%CfAll1)) THEN - DEALLOCATE(ParamData%CfAll1) -ENDIF -IF (ALLOCATED(ParamData%CfAll2)) THEN - DEALLOCATE(ParamData%CfAll2) -ENDIF -IF (ALLOCATED(ParamData%EdgeVelRat1)) THEN - DEALLOCATE(ParamData%EdgeVelRat1) -ENDIF -IF (ALLOCATED(ParamData%EdgeVelRat2)) THEN - DEALLOCATE(ParamData%EdgeVelRat2) -ENDIF -IF (ALLOCATED(ParamData%AFThickGuida)) THEN - DEALLOCATE(ParamData%AFThickGuida) -ENDIF - END SUBROUTINE AA_DestroyParam - - SUBROUTINE AA_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(AA_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 = 'AA_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 ! IBLUNT - Int_BufSz = Int_BufSz + 1 ! ILAM - Int_BufSz = Int_BufSz + 1 ! ITIP - Int_BufSz = Int_BufSz + 1 ! ITRIP - Int_BufSz = Int_BufSz + 1 ! ITURB - Int_BufSz = Int_BufSz + 1 ! IInflow - Int_BufSz = Int_BufSz + 1 ! X_BLMethod - Int_BufSz = Int_BufSz + 1 ! TICalcMeth - Int_BufSz = Int_BufSz + 1 ! ROUND - Re_BufSz = Re_BufSz + 1 ! ALPRAT - Int_BufSz = Int_BufSz + 1 ! NumBlades - Int_BufSz = Int_BufSz + 1 ! NumBlNds - Re_BufSz = Re_BufSz + 1 ! AirDens - Re_BufSz = Re_BufSz + 1 ! KinVisc - Re_BufSz = Re_BufSz + 1 ! SpdSound - Re_BufSz = Re_BufSz + 1 ! HubHeight - Re_BufSz = Re_BufSz + 1 ! toptip - Re_BufSz = Re_BufSz + 1 ! bottip - Int_BufSz = Int_BufSz + 1 ! rotorregionlimitsVert allocated yes/no - IF ( ALLOCATED(InData%rotorregionlimitsVert) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! rotorregionlimitsVert upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%rotorregionlimitsVert) ! rotorregionlimitsVert - END IF - Int_BufSz = Int_BufSz + 1 ! rotorregionlimitsHorz allocated yes/no - IF ( ALLOCATED(InData%rotorregionlimitsHorz) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! rotorregionlimitsHorz upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%rotorregionlimitsHorz) ! rotorregionlimitsHorz - END IF - Int_BufSz = Int_BufSz + 1 ! rotorregionlimitsalph allocated yes/no - IF ( ALLOCATED(InData%rotorregionlimitsalph) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! rotorregionlimitsalph upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%rotorregionlimitsalph) ! rotorregionlimitsalph - END IF - Int_BufSz = Int_BufSz + 1 ! rotorregionlimitsrad allocated yes/no - IF ( ALLOCATED(InData%rotorregionlimitsrad) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! rotorregionlimitsrad upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%rotorregionlimitsrad) ! rotorregionlimitsrad - END IF - Int_BufSz = Int_BufSz + 1 ! NrObsLoc - Int_BufSz = Int_BufSz + 1 ! aweightflag - Int_BufSz = Int_BufSz + 1 ! TxtFileOutput - Db_BufSz = Db_BufSz + 1 ! AAStart - Int_BufSz = Int_BufSz + 1 ! ObsX allocated yes/no - IF ( ALLOCATED(InData%ObsX) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ObsX upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%ObsX) ! ObsX - END IF - Int_BufSz = Int_BufSz + 1 ! ObsY allocated yes/no - IF ( ALLOCATED(InData%ObsY) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ObsY upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%ObsY) ! ObsY - END IF - Int_BufSz = Int_BufSz + 1 ! ObsZ allocated yes/no - IF ( ALLOCATED(InData%ObsZ) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ObsZ upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%ObsZ) ! ObsZ - END IF - Int_BufSz = Int_BufSz + 1 ! FreqList allocated yes/no - IF ( ALLOCATED(InData%FreqList) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! FreqList upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%FreqList) ! FreqList - END IF - Int_BufSz = Int_BufSz + 1 ! Aweight allocated yes/no - IF ( ALLOCATED(InData%Aweight) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Aweight upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Aweight) ! Aweight - END IF - Re_BufSz = Re_BufSz + 1 ! Fsample - Int_BufSz = Int_BufSz + 1 ! total_sample - Int_BufSz = Int_BufSz + 1 ! total_sampleTI - Int_BufSz = Int_BufSz + 1 ! AA_Bl_Prcntge - Int_BufSz = Int_BufSz + 1 ! startnode - Re_BufSz = Re_BufSz + 1 ! Lturb - Re_BufSz = Re_BufSz + 1 ! AvgV - Re_BufSz = Re_BufSz + 1 ! dz_turb_in - Re_BufSz = Re_BufSz + 1 ! dy_turb_in - Int_BufSz = Int_BufSz + 1 ! TI_Grid_In allocated yes/no - IF ( ALLOCATED(InData%TI_Grid_In) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! TI_Grid_In upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TI_Grid_In) ! TI_Grid_In - END IF - Int_BufSz = Int_BufSz + 1*LEN(InData%FTitle) ! FTitle - Int_BufSz = Int_BufSz + 1*LEN(InData%outFmt) ! outFmt - Int_BufSz = Int_BufSz + 1 ! NrOutFile - Int_BufSz = Int_BufSz + 1*LEN(InData%delim) ! delim - Int_BufSz = Int_BufSz + 1 ! NumOuts - Int_BufSz = Int_BufSz + 1 ! NumOutsForPE - Int_BufSz = Int_BufSz + 1 ! NumOutsForSep - Int_BufSz = Int_BufSz + 1 ! NumOutsForNodes - Int_BufSz = Int_BufSz + 1 ! unOutFile - Int_BufSz = Int_BufSz + 1 ! unOutFile2 - Int_BufSz = Int_BufSz + 1 ! unOutFile3 - Int_BufSz = Int_BufSz + 1 ! unOutFile4 - 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 ! StallStart allocated yes/no - IF ( ALLOCATED(InData%StallStart) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! StallStart upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%StallStart) ! StallStart - END IF - Int_BufSz = Int_BufSz + 1 ! TEThick allocated yes/no - IF ( ALLOCATED(InData%TEThick) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! TEThick upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TEThick) ! TEThick - END IF - Int_BufSz = Int_BufSz + 1 ! TEAngle allocated yes/no - IF ( ALLOCATED(InData%TEAngle) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! TEAngle upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TEAngle) ! TEAngle - END IF - Int_BufSz = Int_BufSz + 1 ! AerCent allocated yes/no - IF ( ALLOCATED(InData%AerCent) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! AerCent upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AerCent) ! AerCent - END IF - Int_BufSz = Int_BufSz + 1 ! BlAFID allocated yes/no - IF ( ALLOCATED(InData%BlAFID) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BlAFID upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%BlAFID) ! BlAFID - END IF - Int_BufSz = Int_BufSz + 1 ! AFInfo allocated yes/no - IF ( ALLOCATED(InData%AFInfo) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! AFInfo upper/lower bounds for each dimension - DO i1 = LBOUND(InData%AFInfo,1), UBOUND(InData%AFInfo,1) - Int_BufSz = Int_BufSz + 3 ! AFInfo: size of buffers for each call to pack subtype - CALL AFI_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%AFInfo(i1), ErrStat2, ErrMsg2, .TRUE. ) ! AFInfo - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! AFInfo - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! AFInfo - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! AFInfo - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! AFLECo allocated yes/no - IF ( ALLOCATED(InData%AFLECo) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! AFLECo upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AFLECo) ! AFLECo - END IF - Int_BufSz = Int_BufSz + 1 ! AFTECo allocated yes/no - IF ( ALLOCATED(InData%AFTECo) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! AFTECo upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AFTECo) ! AFTECo - END IF - Int_BufSz = Int_BufSz + 1 ! BlSpn allocated yes/no - IF ( ALLOCATED(InData%BlSpn) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BlSpn upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BlSpn) ! BlSpn - END IF - Int_BufSz = Int_BufSz + 1 ! BlChord allocated yes/no - IF ( ALLOCATED(InData%BlChord) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BlChord upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BlChord) ! BlChord - END IF - Int_BufSz = Int_BufSz + 1 ! ReListBL allocated yes/no - IF ( ALLOCATED(InData%ReListBL) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ReListBL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%ReListBL) ! ReListBL - END IF - Int_BufSz = Int_BufSz + 1 ! AOAListBL allocated yes/no - IF ( ALLOCATED(InData%AOAListBL) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! AOAListBL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AOAListBL) ! AOAListBL - END IF - Int_BufSz = Int_BufSz + 1 ! dStarAll1 allocated yes/no - IF ( ALLOCATED(InData%dStarAll1) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! dStarAll1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%dStarAll1) ! dStarAll1 - END IF - Int_BufSz = Int_BufSz + 1 ! dStarAll2 allocated yes/no - IF ( ALLOCATED(InData%dStarAll2) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! dStarAll2 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%dStarAll2) ! dStarAll2 - END IF - Int_BufSz = Int_BufSz + 1 ! d99All1 allocated yes/no - IF ( ALLOCATED(InData%d99All1) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! d99All1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%d99All1) ! d99All1 - END IF - Int_BufSz = Int_BufSz + 1 ! d99All2 allocated yes/no - IF ( ALLOCATED(InData%d99All2) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! d99All2 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%d99All2) ! d99All2 - END IF - Int_BufSz = Int_BufSz + 1 ! CfAll1 allocated yes/no - IF ( ALLOCATED(InData%CfAll1) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! CfAll1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CfAll1) ! CfAll1 - END IF - Int_BufSz = Int_BufSz + 1 ! CfAll2 allocated yes/no - IF ( ALLOCATED(InData%CfAll2) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! CfAll2 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CfAll2) ! CfAll2 - END IF - Int_BufSz = Int_BufSz + 1 ! EdgeVelRat1 allocated yes/no - IF ( ALLOCATED(InData%EdgeVelRat1) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! EdgeVelRat1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%EdgeVelRat1) ! EdgeVelRat1 - END IF - Int_BufSz = Int_BufSz + 1 ! EdgeVelRat2 allocated yes/no - IF ( ALLOCATED(InData%EdgeVelRat2) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! EdgeVelRat2 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%EdgeVelRat2) ! EdgeVelRat2 - END IF - Int_BufSz = Int_BufSz + 1 ! AFThickGuida allocated yes/no - IF ( ALLOCATED(InData%AFThickGuida) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! AFThickGuida upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AFThickGuida) ! AFThickGuida - 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) = InData%IBLUNT - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%ILAM - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%ITIP - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%ITRIP - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%ITURB - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%IInflow - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%X_BLMethod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%TICalcMeth - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%ROUND, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%ALPRAT - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumBlades - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumBlNds - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%AirDens - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%KinVisc - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%SpdSound - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%HubHeight - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%toptip - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%bottip - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%rotorregionlimitsVert) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rotorregionlimitsVert,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rotorregionlimitsVert,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%rotorregionlimitsVert,1), UBOUND(InData%rotorregionlimitsVert,1) - ReKiBuf(Re_Xferred) = InData%rotorregionlimitsVert(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%rotorregionlimitsHorz) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rotorregionlimitsHorz,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rotorregionlimitsHorz,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%rotorregionlimitsHorz,1), UBOUND(InData%rotorregionlimitsHorz,1) - ReKiBuf(Re_Xferred) = InData%rotorregionlimitsHorz(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%rotorregionlimitsalph) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rotorregionlimitsalph,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rotorregionlimitsalph,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%rotorregionlimitsalph,1), UBOUND(InData%rotorregionlimitsalph,1) - ReKiBuf(Re_Xferred) = InData%rotorregionlimitsalph(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%rotorregionlimitsrad) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rotorregionlimitsrad,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rotorregionlimitsrad,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%rotorregionlimitsrad,1), UBOUND(InData%rotorregionlimitsrad,1) - ReKiBuf(Re_Xferred) = InData%rotorregionlimitsrad(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NrObsLoc - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%aweightflag, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%TxtFileOutput, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%AAStart - Db_Xferred = Db_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%ObsX) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ObsX,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ObsX,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ObsX,1), UBOUND(InData%ObsX,1) - ReKiBuf(Re_Xferred) = InData%ObsX(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ObsY) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ObsY,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ObsY,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ObsY,1), UBOUND(InData%ObsY,1) - ReKiBuf(Re_Xferred) = InData%ObsY(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ObsZ) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ObsZ,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ObsZ,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ObsZ,1), UBOUND(InData%ObsZ,1) - ReKiBuf(Re_Xferred) = InData%ObsZ(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%FreqList) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FreqList,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FreqList,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%FreqList,1), UBOUND(InData%FreqList,1) - ReKiBuf(Re_Xferred) = InData%FreqList(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Aweight) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Aweight,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Aweight,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Aweight,1), UBOUND(InData%Aweight,1) - ReKiBuf(Re_Xferred) = InData%Aweight(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%Fsample - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%total_sample - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%total_sampleTI - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%AA_Bl_Prcntge - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%startnode - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Lturb - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%AvgV - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%dz_turb_in - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%dy_turb_in - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%TI_Grid_In) ) THEN - 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_Grid_In,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TI_Grid_In,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TI_Grid_In,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TI_Grid_In,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%TI_Grid_In,2), UBOUND(InData%TI_Grid_In,2) - DO i1 = LBOUND(InData%TI_Grid_In,1), UBOUND(InData%TI_Grid_In,1) - ReKiBuf(Re_Xferred) = InData%TI_Grid_In(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - DO I = 1, LEN(InData%FTitle) - IntKiBuf(Int_Xferred) = ICHAR(InData%FTitle(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 - IntKiBuf(Int_Xferred) = InData%NrOutFile - 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 - IntKiBuf(Int_Xferred) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumOutsForPE - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumOutsForSep - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumOutsForNodes - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%unOutFile - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%unOutFile2 - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%unOutFile3 - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%unOutFile4 - 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 - IF ( .NOT. ALLOCATED(InData%StallStart) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StallStart,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StallStart,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StallStart,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StallStart,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%StallStart,2), UBOUND(InData%StallStart,2) - DO i1 = LBOUND(InData%StallStart,1), UBOUND(InData%StallStart,1) - ReKiBuf(Re_Xferred) = InData%StallStart(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TEThick) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TEThick,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TEThick,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TEThick,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TEThick,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%TEThick,2), UBOUND(InData%TEThick,2) - DO i1 = LBOUND(InData%TEThick,1), UBOUND(InData%TEThick,1) - ReKiBuf(Re_Xferred) = InData%TEThick(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TEAngle) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TEAngle,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TEAngle,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TEAngle,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TEAngle,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%TEAngle,2), UBOUND(InData%TEAngle,2) - DO i1 = LBOUND(InData%TEAngle,1), UBOUND(InData%TEAngle,1) - ReKiBuf(Re_Xferred) = InData%TEAngle(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AerCent) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AerCent,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AerCent,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AerCent,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AerCent,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AerCent,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AerCent,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%AerCent,3), UBOUND(InData%AerCent,3) - DO i2 = LBOUND(InData%AerCent,2), UBOUND(InData%AerCent,2) - DO i1 = LBOUND(InData%AerCent,1), UBOUND(InData%AerCent,1) - ReKiBuf(Re_Xferred) = InData%AerCent(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BlAFID) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlAFID,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlAFID,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlAFID,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlAFID,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%BlAFID,2), UBOUND(InData%BlAFID,2) - DO i1 = LBOUND(InData%BlAFID,1), UBOUND(InData%BlAFID,1) - IntKiBuf(Int_Xferred) = InData%BlAFID(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AFInfo) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AFInfo,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AFInfo,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%AFInfo,1), UBOUND(InData%AFInfo,1) - CALL AFI_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%AFInfo(i1), ErrStat2, ErrMsg2, OnlySize ) ! AFInfo - 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%AFLECo) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AFLECo,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AFLECo,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AFLECo,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AFLECo,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AFLECo,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AFLECo,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%AFLECo,3), UBOUND(InData%AFLECo,3) - DO i2 = LBOUND(InData%AFLECo,2), UBOUND(InData%AFLECo,2) - DO i1 = LBOUND(InData%AFLECo,1), UBOUND(InData%AFLECo,1) - ReKiBuf(Re_Xferred) = InData%AFLECo(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AFTECo) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AFTECo,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AFTECo,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AFTECo,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AFTECo,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AFTECo,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AFTECo,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%AFTECo,3), UBOUND(InData%AFTECo,3) - DO i2 = LBOUND(InData%AFTECo,2), UBOUND(InData%AFTECo,2) - DO i1 = LBOUND(InData%AFTECo,1), UBOUND(InData%AFTECo,1) - ReKiBuf(Re_Xferred) = InData%AFTECo(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BlSpn) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlSpn,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlSpn,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlSpn,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlSpn,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%BlSpn,2), UBOUND(InData%BlSpn,2) - DO i1 = LBOUND(InData%BlSpn,1), UBOUND(InData%BlSpn,1) - ReKiBuf(Re_Xferred) = InData%BlSpn(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BlChord) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlChord,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlChord,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlChord,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlChord,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%BlChord,2), UBOUND(InData%BlChord,2) - DO i1 = LBOUND(InData%BlChord,1), UBOUND(InData%BlChord,1) - ReKiBuf(Re_Xferred) = InData%BlChord(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ReListBL) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ReListBL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ReListBL,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ReListBL,1), UBOUND(InData%ReListBL,1) - ReKiBuf(Re_Xferred) = InData%ReListBL(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AOAListBL) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AOAListBL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AOAListBL,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%AOAListBL,1), UBOUND(InData%AOAListBL,1) - ReKiBuf(Re_Xferred) = InData%AOAListBL(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%dStarAll1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%dStarAll1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dStarAll1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%dStarAll1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dStarAll1,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%dStarAll1,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dStarAll1,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%dStarAll1,3), UBOUND(InData%dStarAll1,3) - DO i2 = LBOUND(InData%dStarAll1,2), UBOUND(InData%dStarAll1,2) - DO i1 = LBOUND(InData%dStarAll1,1), UBOUND(InData%dStarAll1,1) - ReKiBuf(Re_Xferred) = InData%dStarAll1(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%dStarAll2) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%dStarAll2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dStarAll2,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%dStarAll2,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dStarAll2,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%dStarAll2,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dStarAll2,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%dStarAll2,3), UBOUND(InData%dStarAll2,3) - DO i2 = LBOUND(InData%dStarAll2,2), UBOUND(InData%dStarAll2,2) - DO i1 = LBOUND(InData%dStarAll2,1), UBOUND(InData%dStarAll2,1) - ReKiBuf(Re_Xferred) = InData%dStarAll2(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%d99All1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%d99All1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%d99All1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%d99All1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%d99All1,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%d99All1,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%d99All1,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%d99All1,3), UBOUND(InData%d99All1,3) - DO i2 = LBOUND(InData%d99All1,2), UBOUND(InData%d99All1,2) - DO i1 = LBOUND(InData%d99All1,1), UBOUND(InData%d99All1,1) - ReKiBuf(Re_Xferred) = InData%d99All1(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%d99All2) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%d99All2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%d99All2,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%d99All2,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%d99All2,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%d99All2,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%d99All2,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%d99All2,3), UBOUND(InData%d99All2,3) - DO i2 = LBOUND(InData%d99All2,2), UBOUND(InData%d99All2,2) - DO i1 = LBOUND(InData%d99All2,1), UBOUND(InData%d99All2,1) - ReKiBuf(Re_Xferred) = InData%d99All2(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CfAll1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CfAll1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CfAll1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CfAll1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CfAll1,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CfAll1,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CfAll1,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%CfAll1,3), UBOUND(InData%CfAll1,3) - DO i2 = LBOUND(InData%CfAll1,2), UBOUND(InData%CfAll1,2) - DO i1 = LBOUND(InData%CfAll1,1), UBOUND(InData%CfAll1,1) - ReKiBuf(Re_Xferred) = InData%CfAll1(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CfAll2) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CfAll2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CfAll2,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CfAll2,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CfAll2,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CfAll2,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CfAll2,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%CfAll2,3), UBOUND(InData%CfAll2,3) - DO i2 = LBOUND(InData%CfAll2,2), UBOUND(InData%CfAll2,2) - DO i1 = LBOUND(InData%CfAll2,1), UBOUND(InData%CfAll2,1) - ReKiBuf(Re_Xferred) = InData%CfAll2(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%EdgeVelRat1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%EdgeVelRat1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%EdgeVelRat1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%EdgeVelRat1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%EdgeVelRat1,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%EdgeVelRat1,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%EdgeVelRat1,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%EdgeVelRat1,3), UBOUND(InData%EdgeVelRat1,3) - DO i2 = LBOUND(InData%EdgeVelRat1,2), UBOUND(InData%EdgeVelRat1,2) - DO i1 = LBOUND(InData%EdgeVelRat1,1), UBOUND(InData%EdgeVelRat1,1) - ReKiBuf(Re_Xferred) = InData%EdgeVelRat1(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%EdgeVelRat2) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%EdgeVelRat2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%EdgeVelRat2,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%EdgeVelRat2,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%EdgeVelRat2,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%EdgeVelRat2,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%EdgeVelRat2,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%EdgeVelRat2,3), UBOUND(InData%EdgeVelRat2,3) - DO i2 = LBOUND(InData%EdgeVelRat2,2), UBOUND(InData%EdgeVelRat2,2) - DO i1 = LBOUND(InData%EdgeVelRat2,1), UBOUND(InData%EdgeVelRat2,1) - ReKiBuf(Re_Xferred) = InData%EdgeVelRat2(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AFThickGuida) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AFThickGuida,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AFThickGuida,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AFThickGuida,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AFThickGuida,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%AFThickGuida,2), UBOUND(InData%AFThickGuida,2) - DO i1 = LBOUND(InData%AFThickGuida,1), UBOUND(InData%AFThickGuida,1) - ReKiBuf(Re_Xferred) = InData%AFThickGuida(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE AA_PackParam - - SUBROUTINE AA_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(AA_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) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AA_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%IBLUNT = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%ILAM = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%ITIP = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%ITRIP = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%ITURB = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%IInflow = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%X_BLMethod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TICalcMeth = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%ROUND = TRANSFER(IntKiBuf(Int_Xferred), OutData%ROUND) - Int_Xferred = Int_Xferred + 1 - OutData%ALPRAT = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NumBlades = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumBlNds = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%AirDens = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%KinVisc = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SpdSound = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%HubHeight = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%toptip = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%bottip = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rotorregionlimitsVert not allocated - Int_Xferred = Int_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%rotorregionlimitsVert)) DEALLOCATE(OutData%rotorregionlimitsVert) - ALLOCATE(OutData%rotorregionlimitsVert(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotorregionlimitsVert.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%rotorregionlimitsVert,1), UBOUND(OutData%rotorregionlimitsVert,1) - OutData%rotorregionlimitsVert(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rotorregionlimitsHorz not allocated - Int_Xferred = Int_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%rotorregionlimitsHorz)) DEALLOCATE(OutData%rotorregionlimitsHorz) - ALLOCATE(OutData%rotorregionlimitsHorz(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotorregionlimitsHorz.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%rotorregionlimitsHorz,1), UBOUND(OutData%rotorregionlimitsHorz,1) - OutData%rotorregionlimitsHorz(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rotorregionlimitsalph not allocated - Int_Xferred = Int_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%rotorregionlimitsalph)) DEALLOCATE(OutData%rotorregionlimitsalph) - ALLOCATE(OutData%rotorregionlimitsalph(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotorregionlimitsalph.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%rotorregionlimitsalph,1), UBOUND(OutData%rotorregionlimitsalph,1) - OutData%rotorregionlimitsalph(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rotorregionlimitsrad not allocated - Int_Xferred = Int_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%rotorregionlimitsrad)) DEALLOCATE(OutData%rotorregionlimitsrad) - ALLOCATE(OutData%rotorregionlimitsrad(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotorregionlimitsrad.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%rotorregionlimitsrad,1), UBOUND(OutData%rotorregionlimitsrad,1) - OutData%rotorregionlimitsrad(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%NrObsLoc = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%aweightflag = TRANSFER(IntKiBuf(Int_Xferred), OutData%aweightflag) - Int_Xferred = Int_Xferred + 1 - OutData%TxtFileOutput = TRANSFER(IntKiBuf(Int_Xferred), OutData%TxtFileOutput) - Int_Xferred = Int_Xferred + 1 - OutData%AAStart = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ObsX not allocated - Int_Xferred = Int_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%ObsX)) DEALLOCATE(OutData%ObsX) - ALLOCATE(OutData%ObsX(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ObsX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ObsX,1), UBOUND(OutData%ObsX,1) - OutData%ObsX(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ObsY not allocated - Int_Xferred = Int_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%ObsY)) DEALLOCATE(OutData%ObsY) - ALLOCATE(OutData%ObsY(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ObsY.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ObsY,1), UBOUND(OutData%ObsY,1) - OutData%ObsY(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ObsZ not allocated - Int_Xferred = Int_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%ObsZ)) DEALLOCATE(OutData%ObsZ) - ALLOCATE(OutData%ObsZ(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ObsZ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ObsZ,1), UBOUND(OutData%ObsZ,1) - OutData%ObsZ(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FreqList not allocated - Int_Xferred = Int_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%FreqList)) DEALLOCATE(OutData%FreqList) - ALLOCATE(OutData%FreqList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FreqList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%FreqList,1), UBOUND(OutData%FreqList,1) - OutData%FreqList(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Aweight not allocated - Int_Xferred = Int_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%Aweight)) DEALLOCATE(OutData%Aweight) - ALLOCATE(OutData%Aweight(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Aweight.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Aweight,1), UBOUND(OutData%Aweight,1) - OutData%Aweight(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%Fsample = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%total_sample = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%total_sampleTI = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%AA_Bl_Prcntge = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%startnode = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%Lturb = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%AvgV = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%dz_turb_in = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%dy_turb_in = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TI_Grid_In not allocated - Int_Xferred = Int_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_Grid_In)) DEALLOCATE(OutData%TI_Grid_In) - ALLOCATE(OutData%TI_Grid_In(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TI_Grid_In.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%TI_Grid_In,2), UBOUND(OutData%TI_Grid_In,2) - DO i1 = LBOUND(OutData%TI_Grid_In,1), UBOUND(OutData%TI_Grid_In,1) - OutData%TI_Grid_In(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - DO I = 1, LEN(OutData%FTitle) - OutData%FTitle(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 - OutData%NrOutFile = 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 - OutData%NumOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumOutsForPE = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumOutsForSep = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumOutsForNodes = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%unOutFile = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%unOutFile2 = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%unOutFile3 = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%unOutFile4 = 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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StallStart not allocated - Int_Xferred = Int_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%StallStart)) DEALLOCATE(OutData%StallStart) - ALLOCATE(OutData%StallStart(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StallStart.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%StallStart,2), UBOUND(OutData%StallStart,2) - DO i1 = LBOUND(OutData%StallStart,1), UBOUND(OutData%StallStart,1) - OutData%StallStart(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TEThick not allocated - Int_Xferred = Int_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%TEThick)) DEALLOCATE(OutData%TEThick) - ALLOCATE(OutData%TEThick(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TEThick.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%TEThick,2), UBOUND(OutData%TEThick,2) - DO i1 = LBOUND(OutData%TEThick,1), UBOUND(OutData%TEThick,1) - OutData%TEThick(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TEAngle not allocated - Int_Xferred = Int_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%TEAngle)) DEALLOCATE(OutData%TEAngle) - ALLOCATE(OutData%TEAngle(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TEAngle.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%TEAngle,2), UBOUND(OutData%TEAngle,2) - DO i1 = LBOUND(OutData%TEAngle,1), UBOUND(OutData%TEAngle,1) - OutData%TEAngle(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AerCent not allocated - Int_Xferred = Int_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%AerCent)) DEALLOCATE(OutData%AerCent) - ALLOCATE(OutData%AerCent(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%AerCent.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%AerCent,3), UBOUND(OutData%AerCent,3) - DO i2 = LBOUND(OutData%AerCent,2), UBOUND(OutData%AerCent,2) - DO i1 = LBOUND(OutData%AerCent,1), UBOUND(OutData%AerCent,1) - OutData%AerCent(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 ! BlAFID not allocated - Int_Xferred = Int_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%BlAFID)) DEALLOCATE(OutData%BlAFID) - ALLOCATE(OutData%BlAFID(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlAFID.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%BlAFID,2), UBOUND(OutData%BlAFID,2) - DO i1 = LBOUND(OutData%BlAFID,1), UBOUND(OutData%BlAFID,1) - OutData%BlAFID(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AFInfo not allocated - Int_Xferred = Int_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%AFInfo)) DEALLOCATE(OutData%AFInfo) - ALLOCATE(OutData%AFInfo(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AFInfo.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%AFInfo,1), UBOUND(OutData%AFInfo,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 AFI_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%AFInfo(i1), ErrStat2, ErrMsg2 ) ! AFInfo - 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 ! AFLECo not allocated - Int_Xferred = Int_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%AFLECo)) DEALLOCATE(OutData%AFLECo) - ALLOCATE(OutData%AFLECo(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%AFLECo.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%AFLECo,3), UBOUND(OutData%AFLECo,3) - DO i2 = LBOUND(OutData%AFLECo,2), UBOUND(OutData%AFLECo,2) - DO i1 = LBOUND(OutData%AFLECo,1), UBOUND(OutData%AFLECo,1) - OutData%AFLECo(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 ! AFTECo not allocated - Int_Xferred = Int_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%AFTECo)) DEALLOCATE(OutData%AFTECo) - ALLOCATE(OutData%AFTECo(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%AFTECo.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%AFTECo,3), UBOUND(OutData%AFTECo,3) - DO i2 = LBOUND(OutData%AFTECo,2), UBOUND(OutData%AFTECo,2) - DO i1 = LBOUND(OutData%AFTECo,1), UBOUND(OutData%AFTECo,1) - OutData%AFTECo(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 ! BlSpn not allocated - Int_Xferred = Int_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%BlSpn)) DEALLOCATE(OutData%BlSpn) - ALLOCATE(OutData%BlSpn(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlSpn.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%BlSpn,2), UBOUND(OutData%BlSpn,2) - DO i1 = LBOUND(OutData%BlSpn,1), UBOUND(OutData%BlSpn,1) - OutData%BlSpn(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlChord not allocated - Int_Xferred = Int_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%BlChord)) DEALLOCATE(OutData%BlChord) - ALLOCATE(OutData%BlChord(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlChord.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%BlChord,2), UBOUND(OutData%BlChord,2) - DO i1 = LBOUND(OutData%BlChord,1), UBOUND(OutData%BlChord,1) - OutData%BlChord(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ReListBL not allocated - Int_Xferred = Int_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%ReListBL)) DEALLOCATE(OutData%ReListBL) - ALLOCATE(OutData%ReListBL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ReListBL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ReListBL,1), UBOUND(OutData%ReListBL,1) - OutData%ReListBL(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AOAListBL not allocated - Int_Xferred = Int_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%AOAListBL)) DEALLOCATE(OutData%AOAListBL) - ALLOCATE(OutData%AOAListBL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AOAListBL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%AOAListBL,1), UBOUND(OutData%AOAListBL,1) - OutData%AOAListBL(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! dStarAll1 not allocated - Int_Xferred = Int_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%dStarAll1)) DEALLOCATE(OutData%dStarAll1) - ALLOCATE(OutData%dStarAll1(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%dStarAll1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%dStarAll1,3), UBOUND(OutData%dStarAll1,3) - DO i2 = LBOUND(OutData%dStarAll1,2), UBOUND(OutData%dStarAll1,2) - DO i1 = LBOUND(OutData%dStarAll1,1), UBOUND(OutData%dStarAll1,1) - OutData%dStarAll1(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 ! dStarAll2 not allocated - Int_Xferred = Int_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%dStarAll2)) DEALLOCATE(OutData%dStarAll2) - ALLOCATE(OutData%dStarAll2(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%dStarAll2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%dStarAll2,3), UBOUND(OutData%dStarAll2,3) - DO i2 = LBOUND(OutData%dStarAll2,2), UBOUND(OutData%dStarAll2,2) - DO i1 = LBOUND(OutData%dStarAll2,1), UBOUND(OutData%dStarAll2,1) - OutData%dStarAll2(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 ! d99All1 not allocated - Int_Xferred = Int_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%d99All1)) DEALLOCATE(OutData%d99All1) - ALLOCATE(OutData%d99All1(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%d99All1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%d99All1,3), UBOUND(OutData%d99All1,3) - DO i2 = LBOUND(OutData%d99All1,2), UBOUND(OutData%d99All1,2) - DO i1 = LBOUND(OutData%d99All1,1), UBOUND(OutData%d99All1,1) - OutData%d99All1(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 ! d99All2 not allocated - Int_Xferred = Int_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%d99All2)) DEALLOCATE(OutData%d99All2) - ALLOCATE(OutData%d99All2(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%d99All2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%d99All2,3), UBOUND(OutData%d99All2,3) - DO i2 = LBOUND(OutData%d99All2,2), UBOUND(OutData%d99All2,2) - DO i1 = LBOUND(OutData%d99All2,1), UBOUND(OutData%d99All2,1) - OutData%d99All2(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 ! CfAll1 not allocated - Int_Xferred = Int_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%CfAll1)) DEALLOCATE(OutData%CfAll1) - ALLOCATE(OutData%CfAll1(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%CfAll1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%CfAll1,3), UBOUND(OutData%CfAll1,3) - DO i2 = LBOUND(OutData%CfAll1,2), UBOUND(OutData%CfAll1,2) - DO i1 = LBOUND(OutData%CfAll1,1), UBOUND(OutData%CfAll1,1) - OutData%CfAll1(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 ! CfAll2 not allocated - Int_Xferred = Int_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%CfAll2)) DEALLOCATE(OutData%CfAll2) - ALLOCATE(OutData%CfAll2(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%CfAll2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%CfAll2,3), UBOUND(OutData%CfAll2,3) - DO i2 = LBOUND(OutData%CfAll2,2), UBOUND(OutData%CfAll2,2) - DO i1 = LBOUND(OutData%CfAll2,1), UBOUND(OutData%CfAll2,1) - OutData%CfAll2(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 ! EdgeVelRat1 not allocated - Int_Xferred = Int_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%EdgeVelRat1)) DEALLOCATE(OutData%EdgeVelRat1) - ALLOCATE(OutData%EdgeVelRat1(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%EdgeVelRat1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%EdgeVelRat1,3), UBOUND(OutData%EdgeVelRat1,3) - DO i2 = LBOUND(OutData%EdgeVelRat1,2), UBOUND(OutData%EdgeVelRat1,2) - DO i1 = LBOUND(OutData%EdgeVelRat1,1), UBOUND(OutData%EdgeVelRat1,1) - OutData%EdgeVelRat1(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 ! EdgeVelRat2 not allocated - Int_Xferred = Int_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%EdgeVelRat2)) DEALLOCATE(OutData%EdgeVelRat2) - ALLOCATE(OutData%EdgeVelRat2(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%EdgeVelRat2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%EdgeVelRat2,3), UBOUND(OutData%EdgeVelRat2,3) - DO i2 = LBOUND(OutData%EdgeVelRat2,2), UBOUND(OutData%EdgeVelRat2,2) - DO i1 = LBOUND(OutData%EdgeVelRat2,1), UBOUND(OutData%EdgeVelRat2,1) - OutData%EdgeVelRat2(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 ! AFThickGuida not allocated - Int_Xferred = Int_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%AFThickGuida)) DEALLOCATE(OutData%AFThickGuida) - ALLOCATE(OutData%AFThickGuida(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AFThickGuida.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%AFThickGuida,2), UBOUND(OutData%AFThickGuida,2) - DO i1 = LBOUND(OutData%AFThickGuida,1), UBOUND(OutData%AFThickGuida,1) - OutData%AFThickGuida(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE AA_UnPackParam - - SUBROUTINE AA_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AA_InputType), INTENT(IN) :: SrcInputData - TYPE(AA_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) :: 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 = 'AA_CopyInput' -! + ErrMsg = '' + DstContStateData%DummyContState = SrcContStateData%DummyContState +end subroutine + +subroutine AA_DestroyContState(ContStateData, ErrStat, ErrMsg) + type(AA_ContinuousStateType), intent(inout) :: ContStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AA_DestroyContState' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcInputData%RotGtoL)) THEN - i1_l = LBOUND(SrcInputData%RotGtoL,1) - i1_u = UBOUND(SrcInputData%RotGtoL,1) - i2_l = LBOUND(SrcInputData%RotGtoL,2) - i2_u = UBOUND(SrcInputData%RotGtoL,2) - i3_l = LBOUND(SrcInputData%RotGtoL,3) - i3_u = UBOUND(SrcInputData%RotGtoL,3) - i4_l = LBOUND(SrcInputData%RotGtoL,4) - i4_u = UBOUND(SrcInputData%RotGtoL,4) - IF (.NOT. ALLOCATED(DstInputData%RotGtoL)) THEN - ALLOCATE(DstInputData%RotGtoL(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 DstInputData%RotGtoL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%RotGtoL = SrcInputData%RotGtoL -ENDIF -IF (ALLOCATED(SrcInputData%AeroCent_G)) THEN - i1_l = LBOUND(SrcInputData%AeroCent_G,1) - i1_u = UBOUND(SrcInputData%AeroCent_G,1) - i2_l = LBOUND(SrcInputData%AeroCent_G,2) - i2_u = UBOUND(SrcInputData%AeroCent_G,2) - i3_l = LBOUND(SrcInputData%AeroCent_G,3) - i3_u = UBOUND(SrcInputData%AeroCent_G,3) - IF (.NOT. ALLOCATED(DstInputData%AeroCent_G)) THEN - ALLOCATE(DstInputData%AeroCent_G(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%AeroCent_G.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%AeroCent_G = SrcInputData%AeroCent_G -ENDIF -IF (ALLOCATED(SrcInputData%Vrel)) THEN - i1_l = LBOUND(SrcInputData%Vrel,1) - i1_u = UBOUND(SrcInputData%Vrel,1) - i2_l = LBOUND(SrcInputData%Vrel,2) - i2_u = UBOUND(SrcInputData%Vrel,2) - IF (.NOT. ALLOCATED(DstInputData%Vrel)) THEN - ALLOCATE(DstInputData%Vrel(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%Vrel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%Vrel = SrcInputData%Vrel -ENDIF -IF (ALLOCATED(SrcInputData%AoANoise)) THEN - i1_l = LBOUND(SrcInputData%AoANoise,1) - i1_u = UBOUND(SrcInputData%AoANoise,1) - i2_l = LBOUND(SrcInputData%AoANoise,2) - i2_u = UBOUND(SrcInputData%AoANoise,2) - IF (.NOT. ALLOCATED(DstInputData%AoANoise)) THEN - ALLOCATE(DstInputData%AoANoise(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%AoANoise.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%AoANoise = SrcInputData%AoANoise -ENDIF -IF (ALLOCATED(SrcInputData%Inflow)) THEN - i1_l = LBOUND(SrcInputData%Inflow,1) - i1_u = UBOUND(SrcInputData%Inflow,1) - i2_l = LBOUND(SrcInputData%Inflow,2) - i2_u = UBOUND(SrcInputData%Inflow,2) - i3_l = LBOUND(SrcInputData%Inflow,3) - i3_u = UBOUND(SrcInputData%Inflow,3) - IF (.NOT. ALLOCATED(DstInputData%Inflow)) THEN - ALLOCATE(DstInputData%Inflow(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%Inflow.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%Inflow = SrcInputData%Inflow -ENDIF - END SUBROUTINE AA_CopyInput - - SUBROUTINE AA_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(AA_InputType), INTENT(INOUT) :: InputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AA_DestroyInput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(InputData%RotGtoL)) THEN - DEALLOCATE(InputData%RotGtoL) -ENDIF -IF (ALLOCATED(InputData%AeroCent_G)) THEN - DEALLOCATE(InputData%AeroCent_G) -ENDIF -IF (ALLOCATED(InputData%Vrel)) THEN - DEALLOCATE(InputData%Vrel) -ENDIF -IF (ALLOCATED(InputData%AoANoise)) THEN - DEALLOCATE(InputData%AoANoise) -ENDIF -IF (ALLOCATED(InputData%Inflow)) THEN - DEALLOCATE(InputData%Inflow) -ENDIF - END SUBROUTINE AA_DestroyInput - - SUBROUTINE AA_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(AA_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 = 'AA_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 ! RotGtoL allocated yes/no - IF ( ALLOCATED(InData%RotGtoL) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! RotGtoL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%RotGtoL) ! RotGtoL - END IF - Int_BufSz = Int_BufSz + 1 ! AeroCent_G allocated yes/no - IF ( ALLOCATED(InData%AeroCent_G) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! AeroCent_G upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AeroCent_G) ! AeroCent_G - END IF - Int_BufSz = Int_BufSz + 1 ! Vrel allocated yes/no - IF ( ALLOCATED(InData%Vrel) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Vrel upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vrel) ! Vrel - END IF - Int_BufSz = Int_BufSz + 1 ! AoANoise allocated yes/no - IF ( ALLOCATED(InData%AoANoise) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! AoANoise upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AoANoise) ! AoANoise - END IF - Int_BufSz = Int_BufSz + 1 ! Inflow allocated yes/no - IF ( ALLOCATED(InData%Inflow) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Inflow upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Inflow) ! Inflow - 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%RotGtoL) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RotGtoL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotGtoL,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RotGtoL,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotGtoL,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RotGtoL,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotGtoL,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RotGtoL,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotGtoL,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%RotGtoL,4), UBOUND(InData%RotGtoL,4) - DO i3 = LBOUND(InData%RotGtoL,3), UBOUND(InData%RotGtoL,3) - DO i2 = LBOUND(InData%RotGtoL,2), UBOUND(InData%RotGtoL,2) - DO i1 = LBOUND(InData%RotGtoL,1), UBOUND(InData%RotGtoL,1) - ReKiBuf(Re_Xferred) = InData%RotGtoL(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AeroCent_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%AeroCent_G,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AeroCent_G,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AeroCent_G,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AeroCent_G,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AeroCent_G,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AeroCent_G,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%AeroCent_G,3), UBOUND(InData%AeroCent_G,3) - DO i2 = LBOUND(InData%AeroCent_G,2), UBOUND(InData%AeroCent_G,2) - DO i1 = LBOUND(InData%AeroCent_G,1), UBOUND(InData%AeroCent_G,1) - ReKiBuf(Re_Xferred) = InData%AeroCent_G(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Vrel) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vrel,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vrel,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vrel,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vrel,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Vrel,2), UBOUND(InData%Vrel,2) - DO i1 = LBOUND(InData%Vrel,1), UBOUND(InData%Vrel,1) - ReKiBuf(Re_Xferred) = InData%Vrel(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AoANoise) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AoANoise,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AoANoise,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AoANoise,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AoANoise,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%AoANoise,2), UBOUND(InData%AoANoise,2) - DO i1 = LBOUND(InData%AoANoise,1), UBOUND(InData%AoANoise,1) - ReKiBuf(Re_Xferred) = InData%AoANoise(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Inflow) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Inflow,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Inflow,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Inflow,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Inflow,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Inflow,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Inflow,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Inflow,3), UBOUND(InData%Inflow,3) - DO i2 = LBOUND(InData%Inflow,2), UBOUND(InData%Inflow,2) - DO i1 = LBOUND(InData%Inflow,1), UBOUND(InData%Inflow,1) - ReKiBuf(Re_Xferred) = InData%Inflow(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - END SUBROUTINE AA_PackInput - - SUBROUTINE AA_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(AA_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) :: 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 = 'AA_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 ! RotGtoL not allocated - Int_Xferred = Int_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%RotGtoL)) DEALLOCATE(OutData%RotGtoL) - ALLOCATE(OutData%RotGtoL(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%RotGtoL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%RotGtoL,4), UBOUND(OutData%RotGtoL,4) - DO i3 = LBOUND(OutData%RotGtoL,3), UBOUND(OutData%RotGtoL,3) - DO i2 = LBOUND(OutData%RotGtoL,2), UBOUND(OutData%RotGtoL,2) - DO i1 = LBOUND(OutData%RotGtoL,1), UBOUND(OutData%RotGtoL,1) - OutData%RotGtoL(i1,i2,i3,i4) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AeroCent_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 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%AeroCent_G)) DEALLOCATE(OutData%AeroCent_G) - ALLOCATE(OutData%AeroCent_G(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%AeroCent_G.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%AeroCent_G,3), UBOUND(OutData%AeroCent_G,3) - DO i2 = LBOUND(OutData%AeroCent_G,2), UBOUND(OutData%AeroCent_G,2) - DO i1 = LBOUND(OutData%AeroCent_G,1), UBOUND(OutData%AeroCent_G,1) - OutData%AeroCent_G(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 ! Vrel not allocated - Int_Xferred = Int_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%Vrel)) DEALLOCATE(OutData%Vrel) - ALLOCATE(OutData%Vrel(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vrel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Vrel,2), UBOUND(OutData%Vrel,2) - DO i1 = LBOUND(OutData%Vrel,1), UBOUND(OutData%Vrel,1) - OutData%Vrel(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AoANoise not allocated - Int_Xferred = Int_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%AoANoise)) DEALLOCATE(OutData%AoANoise) - ALLOCATE(OutData%AoANoise(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AoANoise.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%AoANoise,2), UBOUND(OutData%AoANoise,2) - DO i1 = LBOUND(OutData%AoANoise,1), UBOUND(OutData%AoANoise,1) - OutData%AoANoise(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Inflow not allocated - Int_Xferred = Int_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%Inflow)) DEALLOCATE(OutData%Inflow) - ALLOCATE(OutData%Inflow(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%Inflow.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Inflow,3), UBOUND(OutData%Inflow,3) - DO i2 = LBOUND(OutData%Inflow,2), UBOUND(OutData%Inflow,2) - DO i1 = LBOUND(OutData%Inflow,1), UBOUND(OutData%Inflow,1) - OutData%Inflow(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - END SUBROUTINE AA_UnPackInput - - SUBROUTINE AA_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AA_OutputType), INTENT(IN) :: SrcOutputData - TYPE(AA_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) :: 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 = 'AA_CopyOutput' -! + ErrMsg = '' +end subroutine + +subroutine AA_PackContState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(AA_ContinuousStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AA_PackContState' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyContState) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AA_UnPackContState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(AA_ContinuousStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AA_UnPackContState' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyContState); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) + type(AA_DiscreteStateType), intent(in) :: SrcDiscStateData + type(AA_DiscreteStateType), intent(inout) :: DstDiscStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'AA_CopyDiscState' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcOutputData%SumSpecNoise)) THEN - i1_l = LBOUND(SrcOutputData%SumSpecNoise,1) - i1_u = UBOUND(SrcOutputData%SumSpecNoise,1) - i2_l = LBOUND(SrcOutputData%SumSpecNoise,2) - i2_u = UBOUND(SrcOutputData%SumSpecNoise,2) - i3_l = LBOUND(SrcOutputData%SumSpecNoise,3) - i3_u = UBOUND(SrcOutputData%SumSpecNoise,3) - IF (.NOT. ALLOCATED(DstOutputData%SumSpecNoise)) THEN - ALLOCATE(DstOutputData%SumSpecNoise(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%SumSpecNoise.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%SumSpecNoise = SrcOutputData%SumSpecNoise -ENDIF -IF (ALLOCATED(SrcOutputData%SumSpecNoiseSep)) THEN - i1_l = LBOUND(SrcOutputData%SumSpecNoiseSep,1) - i1_u = UBOUND(SrcOutputData%SumSpecNoiseSep,1) - i2_l = LBOUND(SrcOutputData%SumSpecNoiseSep,2) - i2_u = UBOUND(SrcOutputData%SumSpecNoiseSep,2) - i3_l = LBOUND(SrcOutputData%SumSpecNoiseSep,3) - i3_u = UBOUND(SrcOutputData%SumSpecNoiseSep,3) - IF (.NOT. ALLOCATED(DstOutputData%SumSpecNoiseSep)) THEN - ALLOCATE(DstOutputData%SumSpecNoiseSep(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%SumSpecNoiseSep.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%SumSpecNoiseSep = SrcOutputData%SumSpecNoiseSep -ENDIF -IF (ALLOCATED(SrcOutputData%OASPL)) THEN - i1_l = LBOUND(SrcOutputData%OASPL,1) - i1_u = UBOUND(SrcOutputData%OASPL,1) - i2_l = LBOUND(SrcOutputData%OASPL,2) - i2_u = UBOUND(SrcOutputData%OASPL,2) - i3_l = LBOUND(SrcOutputData%OASPL,3) - i3_u = UBOUND(SrcOutputData%OASPL,3) - IF (.NOT. ALLOCATED(DstOutputData%OASPL)) THEN - ALLOCATE(DstOutputData%OASPL(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%OASPL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%OASPL = SrcOutputData%OASPL -ENDIF -IF (ALLOCATED(SrcOutputData%OASPL_Mech)) THEN - i1_l = LBOUND(SrcOutputData%OASPL_Mech,1) - i1_u = UBOUND(SrcOutputData%OASPL_Mech,1) - i2_l = LBOUND(SrcOutputData%OASPL_Mech,2) - i2_u = UBOUND(SrcOutputData%OASPL_Mech,2) - i3_l = LBOUND(SrcOutputData%OASPL_Mech,3) - i3_u = UBOUND(SrcOutputData%OASPL_Mech,3) - i4_l = LBOUND(SrcOutputData%OASPL_Mech,4) - i4_u = UBOUND(SrcOutputData%OASPL_Mech,4) - IF (.NOT. ALLOCATED(DstOutputData%OASPL_Mech)) THEN - ALLOCATE(DstOutputData%OASPL_Mech(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 DstOutputData%OASPL_Mech.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%OASPL_Mech = SrcOutputData%OASPL_Mech -ENDIF -IF (ALLOCATED(SrcOutputData%DirectiviOutput)) THEN - i1_l = LBOUND(SrcOutputData%DirectiviOutput,1) - i1_u = UBOUND(SrcOutputData%DirectiviOutput,1) - IF (.NOT. ALLOCATED(DstOutputData%DirectiviOutput)) THEN - ALLOCATE(DstOutputData%DirectiviOutput(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%DirectiviOutput.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%DirectiviOutput = SrcOutputData%DirectiviOutput -ENDIF -IF (ALLOCATED(SrcOutputData%OutLECoords)) THEN - i1_l = LBOUND(SrcOutputData%OutLECoords,1) - i1_u = UBOUND(SrcOutputData%OutLECoords,1) - i2_l = LBOUND(SrcOutputData%OutLECoords,2) - i2_u = UBOUND(SrcOutputData%OutLECoords,2) - i3_l = LBOUND(SrcOutputData%OutLECoords,3) - i3_u = UBOUND(SrcOutputData%OutLECoords,3) - i4_l = LBOUND(SrcOutputData%OutLECoords,4) - i4_u = UBOUND(SrcOutputData%OutLECoords,4) - IF (.NOT. ALLOCATED(DstOutputData%OutLECoords)) THEN - ALLOCATE(DstOutputData%OutLECoords(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 DstOutputData%OutLECoords.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%OutLECoords = SrcOutputData%OutLECoords -ENDIF -IF (ALLOCATED(SrcOutputData%PtotalFreq)) THEN - i1_l = LBOUND(SrcOutputData%PtotalFreq,1) - i1_u = UBOUND(SrcOutputData%PtotalFreq,1) - i2_l = LBOUND(SrcOutputData%PtotalFreq,2) - i2_u = UBOUND(SrcOutputData%PtotalFreq,2) - IF (.NOT. ALLOCATED(DstOutputData%PtotalFreq)) THEN - ALLOCATE(DstOutputData%PtotalFreq(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%PtotalFreq.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%PtotalFreq = SrcOutputData%PtotalFreq -ENDIF -IF (ALLOCATED(SrcOutputData%WriteOutputForPE)) THEN - i1_l = LBOUND(SrcOutputData%WriteOutputForPE,1) - i1_u = UBOUND(SrcOutputData%WriteOutputForPE,1) - IF (.NOT. ALLOCATED(DstOutputData%WriteOutputForPE)) THEN - ALLOCATE(DstOutputData%WriteOutputForPE(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WriteOutputForPE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%WriteOutputForPE = SrcOutputData%WriteOutputForPE -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 -IF (ALLOCATED(SrcOutputData%WriteOutputSep)) THEN - i1_l = LBOUND(SrcOutputData%WriteOutputSep,1) - i1_u = UBOUND(SrcOutputData%WriteOutputSep,1) - IF (.NOT. ALLOCATED(DstOutputData%WriteOutputSep)) THEN - ALLOCATE(DstOutputData%WriteOutputSep(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WriteOutputSep.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%WriteOutputSep = SrcOutputData%WriteOutputSep -ENDIF -IF (ALLOCATED(SrcOutputData%WriteOutputNode)) THEN - i1_l = LBOUND(SrcOutputData%WriteOutputNode,1) - i1_u = UBOUND(SrcOutputData%WriteOutputNode,1) - IF (.NOT. ALLOCATED(DstOutputData%WriteOutputNode)) THEN - ALLOCATE(DstOutputData%WriteOutputNode(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WriteOutputNode.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%WriteOutputNode = SrcOutputData%WriteOutputNode -ENDIF - END SUBROUTINE AA_CopyOutput - - SUBROUTINE AA_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(AA_OutputType), INTENT(INOUT) :: OutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AA_DestroyOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(OutputData%SumSpecNoise)) THEN - DEALLOCATE(OutputData%SumSpecNoise) -ENDIF -IF (ALLOCATED(OutputData%SumSpecNoiseSep)) THEN - DEALLOCATE(OutputData%SumSpecNoiseSep) -ENDIF -IF (ALLOCATED(OutputData%OASPL)) THEN - DEALLOCATE(OutputData%OASPL) -ENDIF -IF (ALLOCATED(OutputData%OASPL_Mech)) THEN - DEALLOCATE(OutputData%OASPL_Mech) -ENDIF -IF (ALLOCATED(OutputData%DirectiviOutput)) THEN - DEALLOCATE(OutputData%DirectiviOutput) -ENDIF -IF (ALLOCATED(OutputData%OutLECoords)) THEN - DEALLOCATE(OutputData%OutLECoords) -ENDIF -IF (ALLOCATED(OutputData%PtotalFreq)) THEN - DEALLOCATE(OutputData%PtotalFreq) -ENDIF -IF (ALLOCATED(OutputData%WriteOutputForPE)) THEN - DEALLOCATE(OutputData%WriteOutputForPE) -ENDIF -IF (ALLOCATED(OutputData%WriteOutput)) THEN - DEALLOCATE(OutputData%WriteOutput) -ENDIF -IF (ALLOCATED(OutputData%WriteOutputSep)) THEN - DEALLOCATE(OutputData%WriteOutputSep) -ENDIF -IF (ALLOCATED(OutputData%WriteOutputNode)) THEN - DEALLOCATE(OutputData%WriteOutputNode) -ENDIF - END SUBROUTINE AA_DestroyOutput - - SUBROUTINE AA_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(AA_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 = 'AA_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 ! SumSpecNoise allocated yes/no - IF ( ALLOCATED(InData%SumSpecNoise) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! SumSpecNoise upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%SumSpecNoise) ! SumSpecNoise - END IF - Int_BufSz = Int_BufSz + 1 ! SumSpecNoiseSep allocated yes/no - IF ( ALLOCATED(InData%SumSpecNoiseSep) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! SumSpecNoiseSep upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%SumSpecNoiseSep) ! SumSpecNoiseSep - END IF - Int_BufSz = Int_BufSz + 1 ! OASPL allocated yes/no - IF ( ALLOCATED(InData%OASPL) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! OASPL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%OASPL) ! OASPL - END IF - Int_BufSz = Int_BufSz + 1 ! OASPL_Mech allocated yes/no - IF ( ALLOCATED(InData%OASPL_Mech) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! OASPL_Mech upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%OASPL_Mech) ! OASPL_Mech - END IF - Int_BufSz = Int_BufSz + 1 ! DirectiviOutput allocated yes/no - IF ( ALLOCATED(InData%DirectiviOutput) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! DirectiviOutput upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%DirectiviOutput) ! DirectiviOutput - END IF - Int_BufSz = Int_BufSz + 1 ! OutLECoords allocated yes/no - IF ( ALLOCATED(InData%OutLECoords) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! OutLECoords upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%OutLECoords) ! OutLECoords - END IF - Int_BufSz = Int_BufSz + 1 ! PtotalFreq allocated yes/no - IF ( ALLOCATED(InData%PtotalFreq) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PtotalFreq upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PtotalFreq) ! PtotalFreq - END IF - Int_BufSz = Int_BufSz + 1 ! WriteOutputForPE allocated yes/no - IF ( ALLOCATED(InData%WriteOutputForPE) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutputForPE upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WriteOutputForPE) ! WriteOutputForPE - 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 - Int_BufSz = Int_BufSz + 1 ! WriteOutputSep allocated yes/no - IF ( ALLOCATED(InData%WriteOutputSep) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutputSep upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WriteOutputSep) ! WriteOutputSep - END IF - Int_BufSz = Int_BufSz + 1 ! WriteOutputNode allocated yes/no - IF ( ALLOCATED(InData%WriteOutputNode) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutputNode upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WriteOutputNode) ! WriteOutputNode - 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%SumSpecNoise) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SumSpecNoise,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SumSpecNoise,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SumSpecNoise,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SumSpecNoise,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SumSpecNoise,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SumSpecNoise,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%SumSpecNoise,3), UBOUND(InData%SumSpecNoise,3) - DO i2 = LBOUND(InData%SumSpecNoise,2), UBOUND(InData%SumSpecNoise,2) - DO i1 = LBOUND(InData%SumSpecNoise,1), UBOUND(InData%SumSpecNoise,1) - ReKiBuf(Re_Xferred) = InData%SumSpecNoise(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%SumSpecNoiseSep) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SumSpecNoiseSep,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SumSpecNoiseSep,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SumSpecNoiseSep,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SumSpecNoiseSep,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SumSpecNoiseSep,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SumSpecNoiseSep,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%SumSpecNoiseSep,3), UBOUND(InData%SumSpecNoiseSep,3) - DO i2 = LBOUND(InData%SumSpecNoiseSep,2), UBOUND(InData%SumSpecNoiseSep,2) - DO i1 = LBOUND(InData%SumSpecNoiseSep,1), UBOUND(InData%SumSpecNoiseSep,1) - ReKiBuf(Re_Xferred) = InData%SumSpecNoiseSep(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%OASPL) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OASPL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OASPL,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OASPL,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OASPL,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OASPL,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OASPL,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%OASPL,3), UBOUND(InData%OASPL,3) - DO i2 = LBOUND(InData%OASPL,2), UBOUND(InData%OASPL,2) - DO i1 = LBOUND(InData%OASPL,1), UBOUND(InData%OASPL,1) - ReKiBuf(Re_Xferred) = InData%OASPL(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%OASPL_Mech) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OASPL_Mech,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OASPL_Mech,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OASPL_Mech,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OASPL_Mech,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OASPL_Mech,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OASPL_Mech,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OASPL_Mech,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OASPL_Mech,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%OASPL_Mech,4), UBOUND(InData%OASPL_Mech,4) - DO i3 = LBOUND(InData%OASPL_Mech,3), UBOUND(InData%OASPL_Mech,3) - DO i2 = LBOUND(InData%OASPL_Mech,2), UBOUND(InData%OASPL_Mech,2) - DO i1 = LBOUND(InData%OASPL_Mech,1), UBOUND(InData%OASPL_Mech,1) - ReKiBuf(Re_Xferred) = InData%OASPL_Mech(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%DirectiviOutput) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DirectiviOutput,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DirectiviOutput,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%DirectiviOutput,1), UBOUND(InData%DirectiviOutput,1) - ReKiBuf(Re_Xferred) = InData%DirectiviOutput(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%OutLECoords) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OutLECoords,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutLECoords,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OutLECoords,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutLECoords,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OutLECoords,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutLECoords,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OutLECoords,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutLECoords,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%OutLECoords,4), UBOUND(InData%OutLECoords,4) - DO i3 = LBOUND(InData%OutLECoords,3), UBOUND(InData%OutLECoords,3) - DO i2 = LBOUND(InData%OutLECoords,2), UBOUND(InData%OutLECoords,2) - DO i1 = LBOUND(InData%OutLECoords,1), UBOUND(InData%OutLECoords,1) - ReKiBuf(Re_Xferred) = InData%OutLECoords(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PtotalFreq) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PtotalFreq,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PtotalFreq,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PtotalFreq,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PtotalFreq,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PtotalFreq,2), UBOUND(InData%PtotalFreq,2) - DO i1 = LBOUND(InData%PtotalFreq,1), UBOUND(InData%PtotalFreq,1) - ReKiBuf(Re_Xferred) = InData%PtotalFreq(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WriteOutputForPE) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutputForPE,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputForPE,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WriteOutputForPE,1), UBOUND(InData%WriteOutputForPE,1) - ReKiBuf(Re_Xferred) = InData%WriteOutputForPE(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 - IF ( .NOT. ALLOCATED(InData%WriteOutputSep) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutputSep,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputSep,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WriteOutputSep,1), UBOUND(InData%WriteOutputSep,1) - ReKiBuf(Re_Xferred) = InData%WriteOutputSep(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WriteOutputNode) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutputNode,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputNode,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WriteOutputNode,1), UBOUND(InData%WriteOutputNode,1) - ReKiBuf(Re_Xferred) = InData%WriteOutputNode(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE AA_PackOutput - - SUBROUTINE AA_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(AA_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) :: 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 = 'AA_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 ! SumSpecNoise not allocated - Int_Xferred = Int_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%SumSpecNoise)) DEALLOCATE(OutData%SumSpecNoise) - ALLOCATE(OutData%SumSpecNoise(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%SumSpecNoise.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%SumSpecNoise,3), UBOUND(OutData%SumSpecNoise,3) - DO i2 = LBOUND(OutData%SumSpecNoise,2), UBOUND(OutData%SumSpecNoise,2) - DO i1 = LBOUND(OutData%SumSpecNoise,1), UBOUND(OutData%SumSpecNoise,1) - OutData%SumSpecNoise(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 ! SumSpecNoiseSep not allocated - Int_Xferred = Int_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%SumSpecNoiseSep)) DEALLOCATE(OutData%SumSpecNoiseSep) - ALLOCATE(OutData%SumSpecNoiseSep(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%SumSpecNoiseSep.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%SumSpecNoiseSep,3), UBOUND(OutData%SumSpecNoiseSep,3) - DO i2 = LBOUND(OutData%SumSpecNoiseSep,2), UBOUND(OutData%SumSpecNoiseSep,2) - DO i1 = LBOUND(OutData%SumSpecNoiseSep,1), UBOUND(OutData%SumSpecNoiseSep,1) - OutData%SumSpecNoiseSep(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 ! OASPL not allocated - Int_Xferred = Int_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%OASPL)) DEALLOCATE(OutData%OASPL) - ALLOCATE(OutData%OASPL(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%OASPL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%OASPL,3), UBOUND(OutData%OASPL,3) - DO i2 = LBOUND(OutData%OASPL,2), UBOUND(OutData%OASPL,2) - DO i1 = LBOUND(OutData%OASPL,1), UBOUND(OutData%OASPL,1) - OutData%OASPL(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 ! OASPL_Mech not allocated - Int_Xferred = Int_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%OASPL_Mech)) DEALLOCATE(OutData%OASPL_Mech) - ALLOCATE(OutData%OASPL_Mech(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%OASPL_Mech.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%OASPL_Mech,4), UBOUND(OutData%OASPL_Mech,4) - DO i3 = LBOUND(OutData%OASPL_Mech,3), UBOUND(OutData%OASPL_Mech,3) - DO i2 = LBOUND(OutData%OASPL_Mech,2), UBOUND(OutData%OASPL_Mech,2) - DO i1 = LBOUND(OutData%OASPL_Mech,1), UBOUND(OutData%OASPL_Mech,1) - OutData%OASPL_Mech(i1,i2,i3,i4) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DirectiviOutput not allocated - Int_Xferred = Int_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%DirectiviOutput)) DEALLOCATE(OutData%DirectiviOutput) - ALLOCATE(OutData%DirectiviOutput(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DirectiviOutput.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%DirectiviOutput,1), UBOUND(OutData%DirectiviOutput,1) - OutData%DirectiviOutput(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutLECoords not allocated - Int_Xferred = Int_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%OutLECoords)) DEALLOCATE(OutData%OutLECoords) - ALLOCATE(OutData%OutLECoords(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%OutLECoords.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%OutLECoords,4), UBOUND(OutData%OutLECoords,4) - DO i3 = LBOUND(OutData%OutLECoords,3), UBOUND(OutData%OutLECoords,3) - DO i2 = LBOUND(OutData%OutLECoords,2), UBOUND(OutData%OutLECoords,2) - DO i1 = LBOUND(OutData%OutLECoords,1), UBOUND(OutData%OutLECoords,1) - OutData%OutLECoords(i1,i2,i3,i4) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PtotalFreq not allocated - Int_Xferred = Int_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%PtotalFreq)) DEALLOCATE(OutData%PtotalFreq) - ALLOCATE(OutData%PtotalFreq(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtotalFreq.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PtotalFreq,2), UBOUND(OutData%PtotalFreq,2) - DO i1 = LBOUND(OutData%PtotalFreq,1), UBOUND(OutData%PtotalFreq,1) - OutData%PtotalFreq(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputForPE not allocated - Int_Xferred = Int_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%WriteOutputForPE)) DEALLOCATE(OutData%WriteOutputForPE) - ALLOCATE(OutData%WriteOutputForPE(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputForPE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WriteOutputForPE,1), UBOUND(OutData%WriteOutputForPE,1) - OutData%WriteOutputForPE(i1) = ReKiBuf(Re_Xferred) - 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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputSep not allocated - Int_Xferred = Int_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%WriteOutputSep)) DEALLOCATE(OutData%WriteOutputSep) - ALLOCATE(OutData%WriteOutputSep(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputSep.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WriteOutputSep,1), UBOUND(OutData%WriteOutputSep,1) - OutData%WriteOutputSep(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputNode not allocated - Int_Xferred = Int_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%WriteOutputNode)) DEALLOCATE(OutData%WriteOutputNode) - ALLOCATE(OutData%WriteOutputNode(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputNode.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WriteOutputNode,1), UBOUND(OutData%WriteOutputNode,1) - OutData%WriteOutputNode(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE AA_UnPackOutput - + ErrMsg = '' + if (allocated(SrcDiscStateData%MeanVrel)) then + LB(1:2) = lbound(SrcDiscStateData%MeanVrel) + UB(1:2) = ubound(SrcDiscStateData%MeanVrel) + if (.not. allocated(DstDiscStateData%MeanVrel)) then + allocate(DstDiscStateData%MeanVrel(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%MeanVrel.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%MeanVrel = SrcDiscStateData%MeanVrel + end if + if (allocated(SrcDiscStateData%VrelSq)) then + LB(1:2) = lbound(SrcDiscStateData%VrelSq) + UB(1:2) = ubound(SrcDiscStateData%VrelSq) + if (.not. allocated(DstDiscStateData%VrelSq)) then + allocate(DstDiscStateData%VrelSq(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%VrelSq.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%VrelSq = SrcDiscStateData%VrelSq + end if + if (allocated(SrcDiscStateData%TIVrel)) then + LB(1:2) = lbound(SrcDiscStateData%TIVrel) + UB(1:2) = ubound(SrcDiscStateData%TIVrel) + if (.not. allocated(DstDiscStateData%TIVrel)) then + allocate(DstDiscStateData%TIVrel(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%TIVrel.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%TIVrel = SrcDiscStateData%TIVrel + end if + if (allocated(SrcDiscStateData%VrelStore)) then + LB(1:3) = lbound(SrcDiscStateData%VrelStore) + UB(1:3) = ubound(SrcDiscStateData%VrelStore) + if (.not. allocated(DstDiscStateData%VrelStore)) then + allocate(DstDiscStateData%VrelStore(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%VrelStore.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%VrelStore = SrcDiscStateData%VrelStore + end if + if (allocated(SrcDiscStateData%TIVx)) then + LB(1:2) = lbound(SrcDiscStateData%TIVx) + UB(1:2) = ubound(SrcDiscStateData%TIVx) + if (.not. allocated(DstDiscStateData%TIVx)) then + allocate(DstDiscStateData%TIVx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%TIVx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%TIVx = SrcDiscStateData%TIVx + end if + if (allocated(SrcDiscStateData%MeanVxVyVz)) then + LB(1:2) = lbound(SrcDiscStateData%MeanVxVyVz) + UB(1:2) = ubound(SrcDiscStateData%MeanVxVyVz) + if (.not. allocated(DstDiscStateData%MeanVxVyVz)) then + allocate(DstDiscStateData%MeanVxVyVz(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%MeanVxVyVz.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%MeanVxVyVz = SrcDiscStateData%MeanVxVyVz + end if + if (allocated(SrcDiscStateData%VxSq)) then + LB(1:2) = lbound(SrcDiscStateData%VxSq) + UB(1:2) = ubound(SrcDiscStateData%VxSq) + if (.not. allocated(DstDiscStateData%VxSq)) then + allocate(DstDiscStateData%VxSq(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%VxSq.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%VxSq = SrcDiscStateData%VxSq + end if + if (allocated(SrcDiscStateData%allregcounter)) then + LB(1:2) = lbound(SrcDiscStateData%allregcounter) + UB(1:2) = ubound(SrcDiscStateData%allregcounter) + if (.not. allocated(DstDiscStateData%allregcounter)) then + allocate(DstDiscStateData%allregcounter(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%allregcounter.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%allregcounter = SrcDiscStateData%allregcounter + end if + if (allocated(SrcDiscStateData%VxSqRegion)) then + LB(1:2) = lbound(SrcDiscStateData%VxSqRegion) + UB(1:2) = ubound(SrcDiscStateData%VxSqRegion) + if (.not. allocated(DstDiscStateData%VxSqRegion)) then + allocate(DstDiscStateData%VxSqRegion(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%VxSqRegion.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%VxSqRegion = SrcDiscStateData%VxSqRegion + end if + if (allocated(SrcDiscStateData%RegVxStor)) then + LB(1:3) = lbound(SrcDiscStateData%RegVxStor) + UB(1:3) = ubound(SrcDiscStateData%RegVxStor) + if (.not. allocated(DstDiscStateData%RegVxStor)) then + allocate(DstDiscStateData%RegVxStor(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%RegVxStor.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%RegVxStor = SrcDiscStateData%RegVxStor + end if + if (allocated(SrcDiscStateData%RegionTIDelete)) then + LB(1:2) = lbound(SrcDiscStateData%RegionTIDelete) + UB(1:2) = ubound(SrcDiscStateData%RegionTIDelete) + if (.not. allocated(DstDiscStateData%RegionTIDelete)) then + allocate(DstDiscStateData%RegionTIDelete(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%RegionTIDelete.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%RegionTIDelete = SrcDiscStateData%RegionTIDelete + end if +end subroutine + +subroutine AA_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) + type(AA_DiscreteStateType), intent(inout) :: DiscStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AA_DestroyDiscState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(DiscStateData%MeanVrel)) then + deallocate(DiscStateData%MeanVrel) + end if + if (allocated(DiscStateData%VrelSq)) then + deallocate(DiscStateData%VrelSq) + end if + if (allocated(DiscStateData%TIVrel)) then + deallocate(DiscStateData%TIVrel) + end if + if (allocated(DiscStateData%VrelStore)) then + deallocate(DiscStateData%VrelStore) + end if + if (allocated(DiscStateData%TIVx)) then + deallocate(DiscStateData%TIVx) + end if + if (allocated(DiscStateData%MeanVxVyVz)) then + deallocate(DiscStateData%MeanVxVyVz) + end if + if (allocated(DiscStateData%VxSq)) then + deallocate(DiscStateData%VxSq) + end if + if (allocated(DiscStateData%allregcounter)) then + deallocate(DiscStateData%allregcounter) + end if + if (allocated(DiscStateData%VxSqRegion)) then + deallocate(DiscStateData%VxSqRegion) + end if + if (allocated(DiscStateData%RegVxStor)) then + deallocate(DiscStateData%RegVxStor) + end if + if (allocated(DiscStateData%RegionTIDelete)) then + deallocate(DiscStateData%RegionTIDelete) + end if +end subroutine + +subroutine AA_PackDiscState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(AA_DiscreteStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AA_PackDiscState' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%MeanVrel) + call RegPackAlloc(RF, InData%VrelSq) + call RegPackAlloc(RF, InData%TIVrel) + call RegPackAlloc(RF, InData%VrelStore) + call RegPackAlloc(RF, InData%TIVx) + call RegPackAlloc(RF, InData%MeanVxVyVz) + call RegPackAlloc(RF, InData%VxSq) + call RegPackAlloc(RF, InData%allregcounter) + call RegPackAlloc(RF, InData%VxSqRegion) + call RegPackAlloc(RF, InData%RegVxStor) + call RegPackAlloc(RF, InData%RegionTIDelete) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AA_UnPackDiscState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(AA_DiscreteStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AA_UnPackDiscState' + integer(B4Ki) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%MeanVrel); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%VrelSq); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TIVrel); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%VrelStore); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TIVx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%MeanVxVyVz); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%VxSq); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%allregcounter); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%VxSqRegion); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%RegVxStor); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%RegionTIDelete); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AA_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) + type(AA_ConstraintStateType), intent(in) :: SrcConstrStateData + type(AA_ConstraintStateType), intent(inout) :: DstConstrStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AA_CopyConstrState' + ErrStat = ErrID_None + ErrMsg = '' + DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState +end subroutine + +subroutine AA_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) + type(AA_ConstraintStateType), intent(inout) :: ConstrStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AA_DestroyConstrState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine AA_PackConstrState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(AA_ConstraintStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AA_PackConstrState' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyConstrState) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AA_UnPackConstrState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(AA_ConstraintStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AA_UnPackConstrState' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyConstrState); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AA_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) + type(AA_OtherStateType), intent(in) :: SrcOtherStateData + type(AA_OtherStateType), intent(inout) :: DstOtherStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AA_CopyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + DstOtherStateData%DummyOtherState = SrcOtherStateData%DummyOtherState +end subroutine + +subroutine AA_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) + type(AA_OtherStateType), intent(inout) :: OtherStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AA_DestroyOtherState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine AA_PackOtherState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(AA_OtherStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AA_PackOtherState' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyOtherState) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AA_UnPackOtherState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(AA_OtherStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AA_UnPackOtherState' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyOtherState); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(AA_MiscVarType), intent(in) :: SrcMiscData + type(AA_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'AA_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcMiscData%AllOuts)) then + LB(1:1) = lbound(SrcMiscData%AllOuts) + UB(1:1) = ubound(SrcMiscData%AllOuts) + if (.not. allocated(DstMiscData%AllOuts)) then + allocate(DstMiscData%AllOuts(LB(1):UB(1)), 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 + end if + if (allocated(SrcMiscData%ChordAngleTE)) then + LB(1:3) = lbound(SrcMiscData%ChordAngleTE) + UB(1:3) = ubound(SrcMiscData%ChordAngleTE) + if (.not. allocated(DstMiscData%ChordAngleTE)) then + allocate(DstMiscData%ChordAngleTE(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%ChordAngleTE.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%ChordAngleTE = SrcMiscData%ChordAngleTE + end if + if (allocated(SrcMiscData%SpanAngleTE)) then + LB(1:3) = lbound(SrcMiscData%SpanAngleTE) + UB(1:3) = ubound(SrcMiscData%SpanAngleTE) + if (.not. allocated(DstMiscData%SpanAngleTE)) then + allocate(DstMiscData%SpanAngleTE(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SpanAngleTE.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%SpanAngleTE = SrcMiscData%SpanAngleTE + end if + if (allocated(SrcMiscData%ChordAngleLE)) then + LB(1:3) = lbound(SrcMiscData%ChordAngleLE) + UB(1:3) = ubound(SrcMiscData%ChordAngleLE) + if (.not. allocated(DstMiscData%ChordAngleLE)) then + allocate(DstMiscData%ChordAngleLE(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%ChordAngleLE.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%ChordAngleLE = SrcMiscData%ChordAngleLE + end if + if (allocated(SrcMiscData%SpanAngleLE)) then + LB(1:3) = lbound(SrcMiscData%SpanAngleLE) + UB(1:3) = ubound(SrcMiscData%SpanAngleLE) + if (.not. allocated(DstMiscData%SpanAngleLE)) then + allocate(DstMiscData%SpanAngleLE(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SpanAngleLE.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%SpanAngleLE = SrcMiscData%SpanAngleLE + end if + if (allocated(SrcMiscData%rTEtoObserve)) then + LB(1:3) = lbound(SrcMiscData%rTEtoObserve) + UB(1:3) = ubound(SrcMiscData%rTEtoObserve) + if (.not. allocated(DstMiscData%rTEtoObserve)) then + allocate(DstMiscData%rTEtoObserve(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%rTEtoObserve.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%rTEtoObserve = SrcMiscData%rTEtoObserve + end if + if (allocated(SrcMiscData%rLEtoObserve)) then + LB(1:3) = lbound(SrcMiscData%rLEtoObserve) + UB(1:3) = ubound(SrcMiscData%rLEtoObserve) + if (.not. allocated(DstMiscData%rLEtoObserve)) then + allocate(DstMiscData%rLEtoObserve(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%rLEtoObserve.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%rLEtoObserve = SrcMiscData%rLEtoObserve + end if + if (allocated(SrcMiscData%LE_Location)) then + LB(1:3) = lbound(SrcMiscData%LE_Location) + UB(1:3) = ubound(SrcMiscData%LE_Location) + if (.not. allocated(DstMiscData%LE_Location)) then + allocate(DstMiscData%LE_Location(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%LE_Location.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%LE_Location = SrcMiscData%LE_Location + end if + DstMiscData%RotSpeedAoA = SrcMiscData%RotSpeedAoA + if (allocated(SrcMiscData%SPLLBL)) then + LB(1:1) = lbound(SrcMiscData%SPLLBL) + UB(1:1) = ubound(SrcMiscData%SPLLBL) + if (.not. allocated(DstMiscData%SPLLBL)) then + allocate(DstMiscData%SPLLBL(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SPLLBL.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%SPLLBL = SrcMiscData%SPLLBL + end if + if (allocated(SrcMiscData%SPLP)) then + LB(1:1) = lbound(SrcMiscData%SPLP) + UB(1:1) = ubound(SrcMiscData%SPLP) + if (.not. allocated(DstMiscData%SPLP)) then + allocate(DstMiscData%SPLP(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SPLP.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%SPLP = SrcMiscData%SPLP + end if + if (allocated(SrcMiscData%SPLS)) then + LB(1:1) = lbound(SrcMiscData%SPLS) + UB(1:1) = ubound(SrcMiscData%SPLS) + if (.not. allocated(DstMiscData%SPLS)) then + allocate(DstMiscData%SPLS(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SPLS.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%SPLS = SrcMiscData%SPLS + end if + if (allocated(SrcMiscData%SPLALPH)) then + LB(1:1) = lbound(SrcMiscData%SPLALPH) + UB(1:1) = ubound(SrcMiscData%SPLALPH) + if (.not. allocated(DstMiscData%SPLALPH)) then + allocate(DstMiscData%SPLALPH(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SPLALPH.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%SPLALPH = SrcMiscData%SPLALPH + end if + if (allocated(SrcMiscData%SPLTBL)) then + LB(1:1) = lbound(SrcMiscData%SPLTBL) + UB(1:1) = ubound(SrcMiscData%SPLTBL) + if (.not. allocated(DstMiscData%SPLTBL)) then + allocate(DstMiscData%SPLTBL(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SPLTBL.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%SPLTBL = SrcMiscData%SPLTBL + end if + if (allocated(SrcMiscData%SPLTIP)) then + LB(1:1) = lbound(SrcMiscData%SPLTIP) + UB(1:1) = ubound(SrcMiscData%SPLTIP) + if (.not. allocated(DstMiscData%SPLTIP)) then + allocate(DstMiscData%SPLTIP(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SPLTIP.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%SPLTIP = SrcMiscData%SPLTIP + end if + if (allocated(SrcMiscData%SPLTI)) then + LB(1:1) = lbound(SrcMiscData%SPLTI) + UB(1:1) = ubound(SrcMiscData%SPLTI) + if (.not. allocated(DstMiscData%SPLTI)) then + allocate(DstMiscData%SPLTI(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SPLTI.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%SPLTI = SrcMiscData%SPLTI + end if + if (allocated(SrcMiscData%SPLTIGui)) then + LB(1:1) = lbound(SrcMiscData%SPLTIGui) + UB(1:1) = ubound(SrcMiscData%SPLTIGui) + if (.not. allocated(DstMiscData%SPLTIGui)) then + allocate(DstMiscData%SPLTIGui(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SPLTIGui.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%SPLTIGui = SrcMiscData%SPLTIGui + end if + if (allocated(SrcMiscData%SPLBLUNT)) then + LB(1:1) = lbound(SrcMiscData%SPLBLUNT) + UB(1:1) = ubound(SrcMiscData%SPLBLUNT) + if (.not. allocated(DstMiscData%SPLBLUNT)) then + allocate(DstMiscData%SPLBLUNT(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SPLBLUNT.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%SPLBLUNT = SrcMiscData%SPLBLUNT + end if + if (allocated(SrcMiscData%CfVar)) then + LB(1:1) = lbound(SrcMiscData%CfVar) + UB(1:1) = ubound(SrcMiscData%CfVar) + if (.not. allocated(DstMiscData%CfVar)) then + allocate(DstMiscData%CfVar(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%CfVar.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%CfVar = SrcMiscData%CfVar + end if + if (allocated(SrcMiscData%d99Var)) then + LB(1:1) = lbound(SrcMiscData%d99Var) + UB(1:1) = ubound(SrcMiscData%d99Var) + if (.not. allocated(DstMiscData%d99Var)) then + allocate(DstMiscData%d99Var(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%d99Var.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%d99Var = SrcMiscData%d99Var + end if + if (allocated(SrcMiscData%dStarVar)) then + LB(1:1) = lbound(SrcMiscData%dStarVar) + UB(1:1) = ubound(SrcMiscData%dStarVar) + if (.not. allocated(DstMiscData%dStarVar)) then + allocate(DstMiscData%dStarVar(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%dStarVar.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%dStarVar = SrcMiscData%dStarVar + end if + if (allocated(SrcMiscData%EdgeVelVar)) then + LB(1:1) = lbound(SrcMiscData%EdgeVelVar) + UB(1:1) = ubound(SrcMiscData%EdgeVelVar) + if (.not. allocated(DstMiscData%EdgeVelVar)) then + allocate(DstMiscData%EdgeVelVar(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%EdgeVelVar.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%EdgeVelVar = SrcMiscData%EdgeVelVar + end if + DstMiscData%speccou = SrcMiscData%speccou + DstMiscData%filesopen = SrcMiscData%filesopen +end subroutine + +subroutine AA_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(AA_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AA_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(MiscData%AllOuts)) then + deallocate(MiscData%AllOuts) + end if + if (allocated(MiscData%ChordAngleTE)) then + deallocate(MiscData%ChordAngleTE) + end if + if (allocated(MiscData%SpanAngleTE)) then + deallocate(MiscData%SpanAngleTE) + end if + if (allocated(MiscData%ChordAngleLE)) then + deallocate(MiscData%ChordAngleLE) + end if + if (allocated(MiscData%SpanAngleLE)) then + deallocate(MiscData%SpanAngleLE) + end if + if (allocated(MiscData%rTEtoObserve)) then + deallocate(MiscData%rTEtoObserve) + end if + if (allocated(MiscData%rLEtoObserve)) then + deallocate(MiscData%rLEtoObserve) + end if + if (allocated(MiscData%LE_Location)) then + deallocate(MiscData%LE_Location) + end if + if (allocated(MiscData%SPLLBL)) then + deallocate(MiscData%SPLLBL) + end if + if (allocated(MiscData%SPLP)) then + deallocate(MiscData%SPLP) + end if + if (allocated(MiscData%SPLS)) then + deallocate(MiscData%SPLS) + end if + if (allocated(MiscData%SPLALPH)) then + deallocate(MiscData%SPLALPH) + end if + if (allocated(MiscData%SPLTBL)) then + deallocate(MiscData%SPLTBL) + end if + if (allocated(MiscData%SPLTIP)) then + deallocate(MiscData%SPLTIP) + end if + if (allocated(MiscData%SPLTI)) then + deallocate(MiscData%SPLTI) + end if + if (allocated(MiscData%SPLTIGui)) then + deallocate(MiscData%SPLTIGui) + end if + if (allocated(MiscData%SPLBLUNT)) then + deallocate(MiscData%SPLBLUNT) + end if + if (allocated(MiscData%CfVar)) then + deallocate(MiscData%CfVar) + end if + if (allocated(MiscData%d99Var)) then + deallocate(MiscData%d99Var) + end if + if (allocated(MiscData%dStarVar)) then + deallocate(MiscData%dStarVar) + end if + if (allocated(MiscData%EdgeVelVar)) then + deallocate(MiscData%EdgeVelVar) + end if +end subroutine + +subroutine AA_PackMisc(RF, Indata) + type(RegFile), intent(inout) :: RF + type(AA_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AA_PackMisc' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%AllOuts) + call RegPackAlloc(RF, InData%ChordAngleTE) + call RegPackAlloc(RF, InData%SpanAngleTE) + call RegPackAlloc(RF, InData%ChordAngleLE) + call RegPackAlloc(RF, InData%SpanAngleLE) + call RegPackAlloc(RF, InData%rTEtoObserve) + call RegPackAlloc(RF, InData%rLEtoObserve) + call RegPackAlloc(RF, InData%LE_Location) + call RegPack(RF, InData%RotSpeedAoA) + call RegPackAlloc(RF, InData%SPLLBL) + call RegPackAlloc(RF, InData%SPLP) + call RegPackAlloc(RF, InData%SPLS) + call RegPackAlloc(RF, InData%SPLALPH) + call RegPackAlloc(RF, InData%SPLTBL) + call RegPackAlloc(RF, InData%SPLTIP) + call RegPackAlloc(RF, InData%SPLTI) + call RegPackAlloc(RF, InData%SPLTIGui) + call RegPackAlloc(RF, InData%SPLBLUNT) + call RegPackAlloc(RF, InData%CfVar) + call RegPackAlloc(RF, InData%d99Var) + call RegPackAlloc(RF, InData%dStarVar) + call RegPackAlloc(RF, InData%EdgeVelVar) + call RegPack(RF, InData%speccou) + call RegPack(RF, InData%filesopen) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AA_UnPackMisc(RF, OutData) + type(RegFile), intent(inout) :: RF + type(AA_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AA_UnPackMisc' + integer(B4Ki) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%AllOuts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ChordAngleTE); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%SpanAngleTE); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ChordAngleLE); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%SpanAngleLE); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%rTEtoObserve); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%rLEtoObserve); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LE_Location); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RotSpeedAoA); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%SPLLBL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%SPLP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%SPLS); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%SPLALPH); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%SPLTBL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%SPLTIP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%SPLTI); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%SPLTIGui); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%SPLBLUNT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%CfVar); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%d99Var); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dStarVar); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%EdgeVelVar); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%speccou); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%filesopen); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(AA_ParameterType), intent(in) :: SrcParamData + type(AA_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AA_CopyParam' + ErrStat = ErrID_None + ErrMsg = '' + DstParamData%DT = SrcParamData%DT + DstParamData%IBLUNT = SrcParamData%IBLUNT + DstParamData%ILAM = SrcParamData%ILAM + DstParamData%ITIP = SrcParamData%ITIP + DstParamData%ITRIP = SrcParamData%ITRIP + DstParamData%ITURB = SrcParamData%ITURB + DstParamData%IInflow = SrcParamData%IInflow + DstParamData%X_BLMethod = SrcParamData%X_BLMethod + DstParamData%TICalcMeth = SrcParamData%TICalcMeth + DstParamData%ROUND = SrcParamData%ROUND + DstParamData%ALPRAT = SrcParamData%ALPRAT + DstParamData%NumBlades = SrcParamData%NumBlades + DstParamData%NumBlNds = SrcParamData%NumBlNds + DstParamData%AirDens = SrcParamData%AirDens + DstParamData%KinVisc = SrcParamData%KinVisc + DstParamData%SpdSound = SrcParamData%SpdSound + DstParamData%HubHeight = SrcParamData%HubHeight + DstParamData%toptip = SrcParamData%toptip + DstParamData%bottip = SrcParamData%bottip + if (allocated(SrcParamData%rotorregionlimitsVert)) then + LB(1:1) = lbound(SrcParamData%rotorregionlimitsVert) + UB(1:1) = ubound(SrcParamData%rotorregionlimitsVert) + if (.not. allocated(DstParamData%rotorregionlimitsVert)) then + allocate(DstParamData%rotorregionlimitsVert(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rotorregionlimitsVert.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%rotorregionlimitsVert = SrcParamData%rotorregionlimitsVert + end if + if (allocated(SrcParamData%rotorregionlimitsHorz)) then + LB(1:1) = lbound(SrcParamData%rotorregionlimitsHorz) + UB(1:1) = ubound(SrcParamData%rotorregionlimitsHorz) + if (.not. allocated(DstParamData%rotorregionlimitsHorz)) then + allocate(DstParamData%rotorregionlimitsHorz(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rotorregionlimitsHorz.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%rotorregionlimitsHorz = SrcParamData%rotorregionlimitsHorz + end if + if (allocated(SrcParamData%rotorregionlimitsalph)) then + LB(1:1) = lbound(SrcParamData%rotorregionlimitsalph) + UB(1:1) = ubound(SrcParamData%rotorregionlimitsalph) + if (.not. allocated(DstParamData%rotorregionlimitsalph)) then + allocate(DstParamData%rotorregionlimitsalph(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rotorregionlimitsalph.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%rotorregionlimitsalph = SrcParamData%rotorregionlimitsalph + end if + if (allocated(SrcParamData%rotorregionlimitsrad)) then + LB(1:1) = lbound(SrcParamData%rotorregionlimitsrad) + UB(1:1) = ubound(SrcParamData%rotorregionlimitsrad) + if (.not. allocated(DstParamData%rotorregionlimitsrad)) then + allocate(DstParamData%rotorregionlimitsrad(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rotorregionlimitsrad.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%rotorregionlimitsrad = SrcParamData%rotorregionlimitsrad + end if + DstParamData%NrObsLoc = SrcParamData%NrObsLoc + DstParamData%aweightflag = SrcParamData%aweightflag + DstParamData%TxtFileOutput = SrcParamData%TxtFileOutput + DstParamData%AAStart = SrcParamData%AAStart + if (allocated(SrcParamData%ObsX)) then + LB(1:1) = lbound(SrcParamData%ObsX) + UB(1:1) = ubound(SrcParamData%ObsX) + if (.not. allocated(DstParamData%ObsX)) then + allocate(DstParamData%ObsX(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ObsX.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%ObsX = SrcParamData%ObsX + end if + if (allocated(SrcParamData%ObsY)) then + LB(1:1) = lbound(SrcParamData%ObsY) + UB(1:1) = ubound(SrcParamData%ObsY) + if (.not. allocated(DstParamData%ObsY)) then + allocate(DstParamData%ObsY(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ObsY.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%ObsY = SrcParamData%ObsY + end if + if (allocated(SrcParamData%ObsZ)) then + LB(1:1) = lbound(SrcParamData%ObsZ) + UB(1:1) = ubound(SrcParamData%ObsZ) + if (.not. allocated(DstParamData%ObsZ)) then + allocate(DstParamData%ObsZ(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ObsZ.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%ObsZ = SrcParamData%ObsZ + end if + if (allocated(SrcParamData%FreqList)) then + LB(1:1) = lbound(SrcParamData%FreqList) + UB(1:1) = ubound(SrcParamData%FreqList) + if (.not. allocated(DstParamData%FreqList)) then + allocate(DstParamData%FreqList(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%FreqList.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%FreqList = SrcParamData%FreqList + end if + if (allocated(SrcParamData%Aweight)) then + LB(1:1) = lbound(SrcParamData%Aweight) + UB(1:1) = ubound(SrcParamData%Aweight) + if (.not. allocated(DstParamData%Aweight)) then + allocate(DstParamData%Aweight(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Aweight.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Aweight = SrcParamData%Aweight + end if + DstParamData%Fsample = SrcParamData%Fsample + DstParamData%total_sample = SrcParamData%total_sample + DstParamData%total_sampleTI = SrcParamData%total_sampleTI + DstParamData%AA_Bl_Prcntge = SrcParamData%AA_Bl_Prcntge + DstParamData%startnode = SrcParamData%startnode + DstParamData%Lturb = SrcParamData%Lturb + DstParamData%avgV = SrcParamData%avgV + DstParamData%TI = SrcParamData%TI + DstParamData%FTitle = SrcParamData%FTitle + DstParamData%outFmt = SrcParamData%outFmt + DstParamData%NrOutFile = SrcParamData%NrOutFile + DstParamData%delim = SrcParamData%delim + DstParamData%NumOuts = SrcParamData%NumOuts + DstParamData%NumOutsForPE = SrcParamData%NumOutsForPE + DstParamData%NumOutsForSep = SrcParamData%NumOutsForSep + DstParamData%NumOutsForNodes = SrcParamData%NumOutsForNodes + DstParamData%unOutFile = SrcParamData%unOutFile + DstParamData%unOutFile2 = SrcParamData%unOutFile2 + DstParamData%unOutFile3 = SrcParamData%unOutFile3 + DstParamData%unOutFile4 = SrcParamData%unOutFile4 + DstParamData%RootName = SrcParamData%RootName + if (allocated(SrcParamData%OutParam)) then + LB(1:1) = lbound(SrcParamData%OutParam) + UB(1:1) = ubound(SrcParamData%OutParam) + if (.not. allocated(DstParamData%OutParam)) then + allocate(DstParamData%OutParam(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutParam.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyOutParmType(SrcParamData%OutParam(i1), DstParamData%OutParam(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcParamData%StallStart)) then + LB(1:2) = lbound(SrcParamData%StallStart) + UB(1:2) = ubound(SrcParamData%StallStart) + if (.not. allocated(DstParamData%StallStart)) then + allocate(DstParamData%StallStart(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%StallStart.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%StallStart = SrcParamData%StallStart + end if + if (allocated(SrcParamData%TEThick)) then + LB(1:2) = lbound(SrcParamData%TEThick) + UB(1:2) = ubound(SrcParamData%TEThick) + if (.not. allocated(DstParamData%TEThick)) then + allocate(DstParamData%TEThick(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TEThick.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%TEThick = SrcParamData%TEThick + end if + if (allocated(SrcParamData%TEAngle)) then + LB(1:2) = lbound(SrcParamData%TEAngle) + UB(1:2) = ubound(SrcParamData%TEAngle) + if (.not. allocated(DstParamData%TEAngle)) then + allocate(DstParamData%TEAngle(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TEAngle.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%TEAngle = SrcParamData%TEAngle + end if + if (allocated(SrcParamData%AerCent)) then + LB(1:3) = lbound(SrcParamData%AerCent) + UB(1:3) = ubound(SrcParamData%AerCent) + if (.not. allocated(DstParamData%AerCent)) then + allocate(DstParamData%AerCent(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AerCent.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%AerCent = SrcParamData%AerCent + end if + if (allocated(SrcParamData%BlAFID)) then + LB(1:2) = lbound(SrcParamData%BlAFID) + UB(1:2) = ubound(SrcParamData%BlAFID) + if (.not. allocated(DstParamData%BlAFID)) then + allocate(DstParamData%BlAFID(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BlAFID.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%BlAFID = SrcParamData%BlAFID + end if + if (allocated(SrcParamData%AFInfo)) then + LB(1:1) = lbound(SrcParamData%AFInfo) + UB(1:1) = ubound(SrcParamData%AFInfo) + if (.not. allocated(DstParamData%AFInfo)) then + allocate(DstParamData%AFInfo(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AFInfo.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AFI_CopyParam(SrcParamData%AFInfo(i1), DstParamData%AFInfo(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcParamData%AFLECo)) then + LB(1:3) = lbound(SrcParamData%AFLECo) + UB(1:3) = ubound(SrcParamData%AFLECo) + if (.not. allocated(DstParamData%AFLECo)) then + allocate(DstParamData%AFLECo(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AFLECo.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%AFLECo = SrcParamData%AFLECo + end if + if (allocated(SrcParamData%AFTECo)) then + LB(1:3) = lbound(SrcParamData%AFTECo) + UB(1:3) = ubound(SrcParamData%AFTECo) + if (.not. allocated(DstParamData%AFTECo)) then + allocate(DstParamData%AFTECo(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AFTECo.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%AFTECo = SrcParamData%AFTECo + end if + if (allocated(SrcParamData%BlSpn)) then + LB(1:2) = lbound(SrcParamData%BlSpn) + UB(1:2) = ubound(SrcParamData%BlSpn) + if (.not. allocated(DstParamData%BlSpn)) then + allocate(DstParamData%BlSpn(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BlSpn.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%BlSpn = SrcParamData%BlSpn + end if + if (allocated(SrcParamData%BlChord)) then + LB(1:2) = lbound(SrcParamData%BlChord) + UB(1:2) = ubound(SrcParamData%BlChord) + if (.not. allocated(DstParamData%BlChord)) then + allocate(DstParamData%BlChord(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BlChord.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%BlChord = SrcParamData%BlChord + end if + if (allocated(SrcParamData%ReListBL)) then + LB(1:1) = lbound(SrcParamData%ReListBL) + UB(1:1) = ubound(SrcParamData%ReListBL) + if (.not. allocated(DstParamData%ReListBL)) then + allocate(DstParamData%ReListBL(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ReListBL.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%ReListBL = SrcParamData%ReListBL + end if + if (allocated(SrcParamData%AOAListBL)) then + LB(1:1) = lbound(SrcParamData%AOAListBL) + UB(1:1) = ubound(SrcParamData%AOAListBL) + if (.not. allocated(DstParamData%AOAListBL)) then + allocate(DstParamData%AOAListBL(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AOAListBL.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%AOAListBL = SrcParamData%AOAListBL + end if + if (allocated(SrcParamData%dStarAll1)) then + LB(1:3) = lbound(SrcParamData%dStarAll1) + UB(1:3) = ubound(SrcParamData%dStarAll1) + if (.not. allocated(DstParamData%dStarAll1)) then + allocate(DstParamData%dStarAll1(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%dStarAll1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%dStarAll1 = SrcParamData%dStarAll1 + end if + if (allocated(SrcParamData%dStarAll2)) then + LB(1:3) = lbound(SrcParamData%dStarAll2) + UB(1:3) = ubound(SrcParamData%dStarAll2) + if (.not. allocated(DstParamData%dStarAll2)) then + allocate(DstParamData%dStarAll2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%dStarAll2.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%dStarAll2 = SrcParamData%dStarAll2 + end if + if (allocated(SrcParamData%d99All1)) then + LB(1:3) = lbound(SrcParamData%d99All1) + UB(1:3) = ubound(SrcParamData%d99All1) + if (.not. allocated(DstParamData%d99All1)) then + allocate(DstParamData%d99All1(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%d99All1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%d99All1 = SrcParamData%d99All1 + end if + if (allocated(SrcParamData%d99All2)) then + LB(1:3) = lbound(SrcParamData%d99All2) + UB(1:3) = ubound(SrcParamData%d99All2) + if (.not. allocated(DstParamData%d99All2)) then + allocate(DstParamData%d99All2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%d99All2.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%d99All2 = SrcParamData%d99All2 + end if + if (allocated(SrcParamData%CfAll1)) then + LB(1:3) = lbound(SrcParamData%CfAll1) + UB(1:3) = ubound(SrcParamData%CfAll1) + if (.not. allocated(DstParamData%CfAll1)) then + allocate(DstParamData%CfAll1(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CfAll1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%CfAll1 = SrcParamData%CfAll1 + end if + if (allocated(SrcParamData%CfAll2)) then + LB(1:3) = lbound(SrcParamData%CfAll2) + UB(1:3) = ubound(SrcParamData%CfAll2) + if (.not. allocated(DstParamData%CfAll2)) then + allocate(DstParamData%CfAll2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CfAll2.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%CfAll2 = SrcParamData%CfAll2 + end if + if (allocated(SrcParamData%EdgeVelRat1)) then + LB(1:3) = lbound(SrcParamData%EdgeVelRat1) + UB(1:3) = ubound(SrcParamData%EdgeVelRat1) + if (.not. allocated(DstParamData%EdgeVelRat1)) then + allocate(DstParamData%EdgeVelRat1(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%EdgeVelRat1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%EdgeVelRat1 = SrcParamData%EdgeVelRat1 + end if + if (allocated(SrcParamData%EdgeVelRat2)) then + LB(1:3) = lbound(SrcParamData%EdgeVelRat2) + UB(1:3) = ubound(SrcParamData%EdgeVelRat2) + if (.not. allocated(DstParamData%EdgeVelRat2)) then + allocate(DstParamData%EdgeVelRat2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%EdgeVelRat2.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%EdgeVelRat2 = SrcParamData%EdgeVelRat2 + end if + if (allocated(SrcParamData%AFThickGuida)) then + LB(1:2) = lbound(SrcParamData%AFThickGuida) + UB(1:2) = ubound(SrcParamData%AFThickGuida) + if (.not. allocated(DstParamData%AFThickGuida)) then + allocate(DstParamData%AFThickGuida(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AFThickGuida.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%AFThickGuida = SrcParamData%AFThickGuida + end if +end subroutine + +subroutine AA_DestroyParam(ParamData, ErrStat, ErrMsg) + type(AA_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AA_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ParamData%rotorregionlimitsVert)) then + deallocate(ParamData%rotorregionlimitsVert) + end if + if (allocated(ParamData%rotorregionlimitsHorz)) then + deallocate(ParamData%rotorregionlimitsHorz) + end if + if (allocated(ParamData%rotorregionlimitsalph)) then + deallocate(ParamData%rotorregionlimitsalph) + end if + if (allocated(ParamData%rotorregionlimitsrad)) then + deallocate(ParamData%rotorregionlimitsrad) + end if + if (allocated(ParamData%ObsX)) then + deallocate(ParamData%ObsX) + end if + if (allocated(ParamData%ObsY)) then + deallocate(ParamData%ObsY) + end if + if (allocated(ParamData%ObsZ)) then + deallocate(ParamData%ObsZ) + end if + if (allocated(ParamData%FreqList)) then + deallocate(ParamData%FreqList) + end if + if (allocated(ParamData%Aweight)) then + deallocate(ParamData%Aweight) + end if + if (allocated(ParamData%OutParam)) then + LB(1:1) = lbound(ParamData%OutParam) + UB(1:1) = ubound(ParamData%OutParam) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyOutParmType(ParamData%OutParam(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%OutParam) + end if + if (allocated(ParamData%StallStart)) then + deallocate(ParamData%StallStart) + end if + if (allocated(ParamData%TEThick)) then + deallocate(ParamData%TEThick) + end if + if (allocated(ParamData%TEAngle)) then + deallocate(ParamData%TEAngle) + end if + if (allocated(ParamData%AerCent)) then + deallocate(ParamData%AerCent) + end if + if (allocated(ParamData%BlAFID)) then + deallocate(ParamData%BlAFID) + end if + if (allocated(ParamData%AFInfo)) then + LB(1:1) = lbound(ParamData%AFInfo) + UB(1:1) = ubound(ParamData%AFInfo) + do i1 = LB(1), UB(1) + call AFI_DestroyParam(ParamData%AFInfo(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%AFInfo) + end if + if (allocated(ParamData%AFLECo)) then + deallocate(ParamData%AFLECo) + end if + if (allocated(ParamData%AFTECo)) then + deallocate(ParamData%AFTECo) + end if + if (allocated(ParamData%BlSpn)) then + deallocate(ParamData%BlSpn) + end if + if (allocated(ParamData%BlChord)) then + deallocate(ParamData%BlChord) + end if + if (allocated(ParamData%ReListBL)) then + deallocate(ParamData%ReListBL) + end if + if (allocated(ParamData%AOAListBL)) then + deallocate(ParamData%AOAListBL) + end if + if (allocated(ParamData%dStarAll1)) then + deallocate(ParamData%dStarAll1) + end if + if (allocated(ParamData%dStarAll2)) then + deallocate(ParamData%dStarAll2) + end if + if (allocated(ParamData%d99All1)) then + deallocate(ParamData%d99All1) + end if + if (allocated(ParamData%d99All2)) then + deallocate(ParamData%d99All2) + end if + if (allocated(ParamData%CfAll1)) then + deallocate(ParamData%CfAll1) + end if + if (allocated(ParamData%CfAll2)) then + deallocate(ParamData%CfAll2) + end if + if (allocated(ParamData%EdgeVelRat1)) then + deallocate(ParamData%EdgeVelRat1) + end if + if (allocated(ParamData%EdgeVelRat2)) then + deallocate(ParamData%EdgeVelRat2) + end if + if (allocated(ParamData%AFThickGuida)) then + deallocate(ParamData%AFThickGuida) + end if +end subroutine + +subroutine AA_PackParam(RF, Indata) + type(RegFile), intent(inout) :: RF + type(AA_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AA_PackParam' + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DT) + call RegPack(RF, InData%IBLUNT) + call RegPack(RF, InData%ILAM) + call RegPack(RF, InData%ITIP) + call RegPack(RF, InData%ITRIP) + call RegPack(RF, InData%ITURB) + call RegPack(RF, InData%IInflow) + call RegPack(RF, InData%X_BLMethod) + call RegPack(RF, InData%TICalcMeth) + call RegPack(RF, InData%ROUND) + call RegPack(RF, InData%ALPRAT) + call RegPack(RF, InData%NumBlades) + call RegPack(RF, InData%NumBlNds) + call RegPack(RF, InData%AirDens) + call RegPack(RF, InData%KinVisc) + call RegPack(RF, InData%SpdSound) + call RegPack(RF, InData%HubHeight) + call RegPack(RF, InData%toptip) + call RegPack(RF, InData%bottip) + call RegPackAlloc(RF, InData%rotorregionlimitsVert) + call RegPackAlloc(RF, InData%rotorregionlimitsHorz) + call RegPackAlloc(RF, InData%rotorregionlimitsalph) + call RegPackAlloc(RF, InData%rotorregionlimitsrad) + call RegPack(RF, InData%NrObsLoc) + call RegPack(RF, InData%aweightflag) + call RegPack(RF, InData%TxtFileOutput) + call RegPack(RF, InData%AAStart) + call RegPackAlloc(RF, InData%ObsX) + call RegPackAlloc(RF, InData%ObsY) + call RegPackAlloc(RF, InData%ObsZ) + call RegPackAlloc(RF, InData%FreqList) + call RegPackAlloc(RF, InData%Aweight) + call RegPack(RF, InData%Fsample) + call RegPack(RF, InData%total_sample) + call RegPack(RF, InData%total_sampleTI) + call RegPack(RF, InData%AA_Bl_Prcntge) + call RegPack(RF, InData%startnode) + call RegPack(RF, InData%Lturb) + call RegPack(RF, InData%avgV) + call RegPack(RF, InData%TI) + call RegPack(RF, InData%FTitle) + call RegPack(RF, InData%outFmt) + call RegPack(RF, InData%NrOutFile) + call RegPack(RF, InData%delim) + call RegPack(RF, InData%NumOuts) + call RegPack(RF, InData%NumOutsForPE) + call RegPack(RF, InData%NumOutsForSep) + call RegPack(RF, InData%NumOutsForNodes) + call RegPack(RF, InData%unOutFile) + call RegPack(RF, InData%unOutFile2) + call RegPack(RF, InData%unOutFile3) + call RegPack(RF, InData%unOutFile4) + call RegPack(RF, InData%RootName) + call RegPack(RF, allocated(InData%OutParam)) + if (allocated(InData%OutParam)) then + call RegPackBounds(RF, 1, lbound(InData%OutParam), ubound(InData%OutParam)) + LB(1:1) = lbound(InData%OutParam) + UB(1:1) = ubound(InData%OutParam) + do i1 = LB(1), UB(1) + call NWTC_Library_PackOutParmType(RF, InData%OutParam(i1)) + end do + end if + call RegPackAlloc(RF, InData%StallStart) + call RegPackAlloc(RF, InData%TEThick) + call RegPackAlloc(RF, InData%TEAngle) + call RegPackAlloc(RF, InData%AerCent) + call RegPackAlloc(RF, InData%BlAFID) + call RegPack(RF, allocated(InData%AFInfo)) + if (allocated(InData%AFInfo)) then + call RegPackBounds(RF, 1, lbound(InData%AFInfo), ubound(InData%AFInfo)) + LB(1:1) = lbound(InData%AFInfo) + UB(1:1) = ubound(InData%AFInfo) + do i1 = LB(1), UB(1) + call AFI_PackParam(RF, InData%AFInfo(i1)) + end do + end if + call RegPackAlloc(RF, InData%AFLECo) + call RegPackAlloc(RF, InData%AFTECo) + call RegPackAlloc(RF, InData%BlSpn) + call RegPackAlloc(RF, InData%BlChord) + call RegPackAlloc(RF, InData%ReListBL) + call RegPackAlloc(RF, InData%AOAListBL) + call RegPackAlloc(RF, InData%dStarAll1) + call RegPackAlloc(RF, InData%dStarAll2) + call RegPackAlloc(RF, InData%d99All1) + call RegPackAlloc(RF, InData%d99All2) + call RegPackAlloc(RF, InData%CfAll1) + call RegPackAlloc(RF, InData%CfAll2) + call RegPackAlloc(RF, InData%EdgeVelRat1) + call RegPackAlloc(RF, InData%EdgeVelRat2) + call RegPackAlloc(RF, InData%AFThickGuida) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AA_UnPackParam(RF, OutData) + type(RegFile), intent(inout) :: RF + type(AA_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AA_UnPackParam' + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%IBLUNT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ILAM); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ITIP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ITRIP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ITURB); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%IInflow); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%X_BLMethod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TICalcMeth); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ROUND); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ALPRAT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumBlades); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumBlNds); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AirDens); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%KinVisc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SpdSound); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HubHeight); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%toptip); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%bottip); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%rotorregionlimitsVert); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%rotorregionlimitsHorz); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%rotorregionlimitsalph); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%rotorregionlimitsrad); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NrObsLoc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%aweightflag); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TxtFileOutput); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AAStart); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ObsX); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ObsY); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ObsZ); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%FreqList); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Aweight); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Fsample); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%total_sample); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%total_sampleTI); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AA_Bl_Prcntge); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%startnode); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Lturb); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%avgV); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TI); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FTitle); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%outFmt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NrOutFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%delim); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumOuts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumOutsForPE); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumOutsForSep); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumOutsForNodes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%unOutFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%unOutFile2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%unOutFile3); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%unOutFile4); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RootName); if (RegCheckErr(RF, RoutineName)) return + if (allocated(OutData%OutParam)) deallocate(OutData%OutParam) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%OutParam(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackOutParmType(RF, OutData%OutParam(i1)) ! OutParam + end do + end if + call RegUnpackAlloc(RF, OutData%StallStart); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TEThick); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TEAngle); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AerCent); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BlAFID); if (RegCheckErr(RF, RoutineName)) return + if (allocated(OutData%AFInfo)) deallocate(OutData%AFInfo) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%AFInfo(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AFInfo.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AFI_UnpackParam(RF, OutData%AFInfo(i1)) ! AFInfo + end do + end if + call RegUnpackAlloc(RF, OutData%AFLECo); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AFTECo); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BlSpn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BlChord); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ReListBL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AOAListBL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dStarAll1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dStarAll2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%d99All1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%d99All2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%CfAll1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%CfAll2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%EdgeVelRat1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%EdgeVelRat2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AFThickGuida); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AA_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) + type(AA_InputType), intent(in) :: SrcInputData + type(AA_InputType), intent(inout) :: DstInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(4), UB(4) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'AA_CopyInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcInputData%RotGtoL)) then + LB(1:4) = lbound(SrcInputData%RotGtoL) + UB(1:4) = ubound(SrcInputData%RotGtoL) + if (.not. allocated(DstInputData%RotGtoL)) then + allocate(DstInputData%RotGtoL(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%RotGtoL.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%RotGtoL = SrcInputData%RotGtoL + end if + if (allocated(SrcInputData%AeroCent_G)) then + LB(1:3) = lbound(SrcInputData%AeroCent_G) + UB(1:3) = ubound(SrcInputData%AeroCent_G) + if (.not. allocated(DstInputData%AeroCent_G)) then + allocate(DstInputData%AeroCent_G(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%AeroCent_G.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%AeroCent_G = SrcInputData%AeroCent_G + end if + if (allocated(SrcInputData%Vrel)) then + LB(1:2) = lbound(SrcInputData%Vrel) + UB(1:2) = ubound(SrcInputData%Vrel) + if (.not. allocated(DstInputData%Vrel)) then + allocate(DstInputData%Vrel(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%Vrel.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%Vrel = SrcInputData%Vrel + end if + if (allocated(SrcInputData%AoANoise)) then + LB(1:2) = lbound(SrcInputData%AoANoise) + UB(1:2) = ubound(SrcInputData%AoANoise) + if (.not. allocated(DstInputData%AoANoise)) then + allocate(DstInputData%AoANoise(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%AoANoise.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%AoANoise = SrcInputData%AoANoise + end if + if (allocated(SrcInputData%Inflow)) then + LB(1:3) = lbound(SrcInputData%Inflow) + UB(1:3) = ubound(SrcInputData%Inflow) + if (.not. allocated(DstInputData%Inflow)) then + allocate(DstInputData%Inflow(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%Inflow.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%Inflow = SrcInputData%Inflow + end if +end subroutine + +subroutine AA_DestroyInput(InputData, ErrStat, ErrMsg) + type(AA_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AA_DestroyInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InputData%RotGtoL)) then + deallocate(InputData%RotGtoL) + end if + if (allocated(InputData%AeroCent_G)) then + deallocate(InputData%AeroCent_G) + end if + if (allocated(InputData%Vrel)) then + deallocate(InputData%Vrel) + end if + if (allocated(InputData%AoANoise)) then + deallocate(InputData%AoANoise) + end if + if (allocated(InputData%Inflow)) then + deallocate(InputData%Inflow) + end if +end subroutine + +subroutine AA_PackInput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(AA_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AA_PackInput' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%RotGtoL) + call RegPackAlloc(RF, InData%AeroCent_G) + call RegPackAlloc(RF, InData%Vrel) + call RegPackAlloc(RF, InData%AoANoise) + call RegPackAlloc(RF, InData%Inflow) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AA_UnPackInput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(AA_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AA_UnPackInput' + integer(B4Ki) :: LB(4), UB(4) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%RotGtoL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AeroCent_G); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Vrel); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AoANoise); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Inflow); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AA_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(AA_OutputType), intent(in) :: SrcOutputData + type(AA_OutputType), intent(inout) :: DstOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(4), UB(4) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'AA_CopyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcOutputData%SumSpecNoise)) then + LB(1:3) = lbound(SrcOutputData%SumSpecNoise) + UB(1:3) = ubound(SrcOutputData%SumSpecNoise) + if (.not. allocated(DstOutputData%SumSpecNoise)) then + allocate(DstOutputData%SumSpecNoise(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%SumSpecNoise.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%SumSpecNoise = SrcOutputData%SumSpecNoise + end if + if (allocated(SrcOutputData%SumSpecNoiseSep)) then + LB(1:3) = lbound(SrcOutputData%SumSpecNoiseSep) + UB(1:3) = ubound(SrcOutputData%SumSpecNoiseSep) + if (.not. allocated(DstOutputData%SumSpecNoiseSep)) then + allocate(DstOutputData%SumSpecNoiseSep(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%SumSpecNoiseSep.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%SumSpecNoiseSep = SrcOutputData%SumSpecNoiseSep + end if + if (allocated(SrcOutputData%OASPL)) then + LB(1:3) = lbound(SrcOutputData%OASPL) + UB(1:3) = ubound(SrcOutputData%OASPL) + if (.not. allocated(DstOutputData%OASPL)) then + allocate(DstOutputData%OASPL(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%OASPL.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%OASPL = SrcOutputData%OASPL + end if + if (allocated(SrcOutputData%OASPL_Mech)) then + LB(1:4) = lbound(SrcOutputData%OASPL_Mech) + UB(1:4) = ubound(SrcOutputData%OASPL_Mech) + if (.not. allocated(DstOutputData%OASPL_Mech)) then + allocate(DstOutputData%OASPL_Mech(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%OASPL_Mech.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%OASPL_Mech = SrcOutputData%OASPL_Mech + end if + if (allocated(SrcOutputData%DirectiviOutput)) then + LB(1:1) = lbound(SrcOutputData%DirectiviOutput) + UB(1:1) = ubound(SrcOutputData%DirectiviOutput) + if (.not. allocated(DstOutputData%DirectiviOutput)) then + allocate(DstOutputData%DirectiviOutput(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%DirectiviOutput.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%DirectiviOutput = SrcOutputData%DirectiviOutput + end if + if (allocated(SrcOutputData%OutLECoords)) then + LB(1:4) = lbound(SrcOutputData%OutLECoords) + UB(1:4) = ubound(SrcOutputData%OutLECoords) + if (.not. allocated(DstOutputData%OutLECoords)) then + allocate(DstOutputData%OutLECoords(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%OutLECoords.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%OutLECoords = SrcOutputData%OutLECoords + end if + if (allocated(SrcOutputData%PtotalFreq)) then + LB(1:2) = lbound(SrcOutputData%PtotalFreq) + UB(1:2) = ubound(SrcOutputData%PtotalFreq) + if (.not. allocated(DstOutputData%PtotalFreq)) then + allocate(DstOutputData%PtotalFreq(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%PtotalFreq.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%PtotalFreq = SrcOutputData%PtotalFreq + end if + if (allocated(SrcOutputData%WriteOutputForPE)) then + LB(1:1) = lbound(SrcOutputData%WriteOutputForPE) + UB(1:1) = ubound(SrcOutputData%WriteOutputForPE) + if (.not. allocated(DstOutputData%WriteOutputForPE)) then + allocate(DstOutputData%WriteOutputForPE(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WriteOutputForPE.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%WriteOutputForPE = SrcOutputData%WriteOutputForPE + end if + if (allocated(SrcOutputData%WriteOutput)) then + LB(1:1) = lbound(SrcOutputData%WriteOutput) + UB(1:1) = ubound(SrcOutputData%WriteOutput) + if (.not. allocated(DstOutputData%WriteOutput)) then + allocate(DstOutputData%WriteOutput(LB(1):UB(1)), 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 + end if + if (allocated(SrcOutputData%WriteOutputSep)) then + LB(1:1) = lbound(SrcOutputData%WriteOutputSep) + UB(1:1) = ubound(SrcOutputData%WriteOutputSep) + if (.not. allocated(DstOutputData%WriteOutputSep)) then + allocate(DstOutputData%WriteOutputSep(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WriteOutputSep.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%WriteOutputSep = SrcOutputData%WriteOutputSep + end if + if (allocated(SrcOutputData%WriteOutputNode)) then + LB(1:1) = lbound(SrcOutputData%WriteOutputNode) + UB(1:1) = ubound(SrcOutputData%WriteOutputNode) + if (.not. allocated(DstOutputData%WriteOutputNode)) then + allocate(DstOutputData%WriteOutputNode(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WriteOutputNode.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%WriteOutputNode = SrcOutputData%WriteOutputNode + end if +end subroutine + +subroutine AA_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(AA_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AA_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OutputData%SumSpecNoise)) then + deallocate(OutputData%SumSpecNoise) + end if + if (allocated(OutputData%SumSpecNoiseSep)) then + deallocate(OutputData%SumSpecNoiseSep) + end if + if (allocated(OutputData%OASPL)) then + deallocate(OutputData%OASPL) + end if + if (allocated(OutputData%OASPL_Mech)) then + deallocate(OutputData%OASPL_Mech) + end if + if (allocated(OutputData%DirectiviOutput)) then + deallocate(OutputData%DirectiviOutput) + end if + if (allocated(OutputData%OutLECoords)) then + deallocate(OutputData%OutLECoords) + end if + if (allocated(OutputData%PtotalFreq)) then + deallocate(OutputData%PtotalFreq) + end if + if (allocated(OutputData%WriteOutputForPE)) then + deallocate(OutputData%WriteOutputForPE) + end if + if (allocated(OutputData%WriteOutput)) then + deallocate(OutputData%WriteOutput) + end if + if (allocated(OutputData%WriteOutputSep)) then + deallocate(OutputData%WriteOutputSep) + end if + if (allocated(OutputData%WriteOutputNode)) then + deallocate(OutputData%WriteOutputNode) + end if +end subroutine + +subroutine AA_PackOutput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(AA_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AA_PackOutput' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%SumSpecNoise) + call RegPackAlloc(RF, InData%SumSpecNoiseSep) + call RegPackAlloc(RF, InData%OASPL) + call RegPackAlloc(RF, InData%OASPL_Mech) + call RegPackAlloc(RF, InData%DirectiviOutput) + call RegPackAlloc(RF, InData%OutLECoords) + call RegPackAlloc(RF, InData%PtotalFreq) + call RegPackAlloc(RF, InData%WriteOutputForPE) + call RegPackAlloc(RF, InData%WriteOutput) + call RegPackAlloc(RF, InData%WriteOutputSep) + call RegPackAlloc(RF, InData%WriteOutputNode) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AA_UnPackOutput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(AA_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AA_UnPackOutput' + integer(B4Ki) :: LB(4), UB(4) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%SumSpecNoise); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%SumSpecNoiseSep); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%OASPL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%OASPL_Mech); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%DirectiviOutput); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%OutLECoords); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PtotalFreq); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WriteOutputForPE); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WriteOutput); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WriteOutputSep); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WriteOutputNode); if (RegCheckErr(RF, RoutineName)) return +end subroutine END MODULE AeroAcoustics_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/aerodyn/src/AeroDyn.f90 b/modules/aerodyn/src/AeroDyn.f90 index 658f12bce5..6ed9b86c50 100644 --- a/modules/aerodyn/src/AeroDyn.f90 +++ b/modules/aerodyn/src/AeroDyn.f90 @@ -1,4 +1,4 @@ -!********************************************************************************************************************************** +!********************************************************************************************************************************* ! LICENSING ! Copyright (C) 2015-2016 National Renewable Energy Laboratory ! Copyright (C) 2016-2021 Envision Energy USA, LTD @@ -31,11 +31,11 @@ module AeroDyn use UnsteadyAero use FVW use FVW_Subs, only: FVW_AeroOuts + use IfW_FlowField, only: IfW_FlowField_GetVelAcc, IfW_UniformWind_GetOP, IfW_UniformWind_Perturb, IfW_FlowField_CopyFlowFieldType implicit none - private - + ! ..... Public Subroutines ................................................................................................... @@ -60,11 +60,6 @@ module AeroDyn ! (Xd), and constraint - state(Z) functions all with respect to the constraint ! states(z) PUBLIC :: AD_GetOP !< Routine to pack the operating point values (for linearization) into arrays - - PUBLIC :: AD_NumWindPoints !< Routine to return then number of windpoints required by AeroDyn - PUBLIC :: AD_BoxExceedPointsIdx !< Routine to set the start of the OLAF wind points - PUBLIC :: AD_GetExternalWind !< Set the external wind into AeroDyn inputs - PUBLIC :: AD_SetExternalWindPositions !< Set the external wind points needed by AeroDyn inputs contains !---------------------------------------------------------------------------------------------------------------------------------- @@ -187,7 +182,7 @@ subroutine AD_SetInitOut(MHK, WtrDpth, p, p_AD, InputFileData, InitOut, errStat, CALL SetErrStat(ErrID_Fatal,"Error allocating memory for TwrElev.", ErrStat, ErrMsg, RoutineName) RETURN END IF - IF ( MHK == 1 ) THEN + IF ( MHK == MHK_FixedBottom ) THEN InitOut%TwrElev(:) = InputFileData%TwrElev(:) - WtrDpth ELSE InitOut%TwrElev(:) = InputFileData%TwrElev(:) @@ -231,8 +226,9 @@ subroutine AD_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut ! Local variables - integer(IntKi) :: i ! loop counter + integer(IntKi) :: i,k ! loop counter integer(IntKi) :: iR ! loop on rotors + integer(IntKi) :: nNodesVelRot ! number of nodes associated with the rotor that need wind velocity (for CFD coupling) integer(IntKi) :: errStat2 ! temporary error status of the operation character(ErrMsgLen) :: errMsg2 ! temporary error message @@ -244,7 +240,7 @@ subroutine AD_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut integer(IntKi) :: nRotors ! Number of rotors integer(IntKi), allocatable, dimension(:) :: NumBlades ! Number of blades per rotor integer(IntKi) , allocatable, dimension(:) :: AeroProjMod ! AeroProjMod per rotor - + logical , allocatable, dimension(:) :: calcCrvAngle ! whether the curve angle should be calculated character(*), parameter :: RoutineName = 'AD_Init' @@ -267,21 +263,26 @@ subroutine AD_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut ! Allocate rotors data types nRotors = size(InitInp%rotors) - allocate(x%rotors(nRotors), xd%rotors(nRotors), z%rotors(nRotors), OtherState%rotors(nRotors), stat=errStat) - if (errStat/=0) call SetErrStat( ErrID_Fatal, 'Allocating rotor states', errStat, errMsg, RoutineName ) - allocate(u%rotors(nRotors), y%rotors(nRotors), InitOut%rotors(nRotors), InputFileData%rotors(nRotors), stat=errStat) - if (errStat/=0) call SetErrStat( ErrID_Fatal, 'Allocating rotor input/outputs', errStat, errMsg, RoutineName ) - allocate(p%rotors(nRotors), m%rotors(nRotors), stat=errStat) - if (errStat/=0) call SetErrStat( ErrID_Fatal, 'Allocating rotor params/misc', errStat, errMsg, RoutineName ) - allocate(NumBlades(nRotors), stat=errStat ) ! temp array to pass NumBlades - if (errStat/=0) call SetErrStat( ErrID_Fatal, 'Allocating numblades per rotor', errStat, errMsg, RoutineName ) - allocate(AeroProjMod(nRotors), stat=errStat ) ! temp array to pass AeroProjMod - AeroProjMod=-1 - if (errStat/=0) call SetErrStat( ErrID_Fatal, 'Allocating AeroProjMod per rotor', errStat, errMsg, RoutineName ) + allocate(x%rotors(nRotors), xd%rotors(nRotors), z%rotors(nRotors), OtherState%rotors(nRotors), stat=errStat2) + if (errStat2/=0) call SetErrStat( ErrID_Fatal, 'Allocating rotor states', errStat, errMsg, RoutineName ) + allocate(u%rotors(nRotors), y%rotors(nRotors), InitOut%rotors(nRotors), InputFileData%rotors(nRotors), stat=errStat2) + if (errStat2/=0) call SetErrStat( ErrID_Fatal, 'Allocating rotor input/outputs', errStat, errMsg, RoutineName ) + allocate(p%rotors(nRotors), m%rotors(nRotors), stat=errStat2) + if (errStat2/=0) call SetErrStat( ErrID_Fatal, 'Allocating rotor params/misc', errStat, errMsg, RoutineName ) + allocate(NumBlades(nRotors), stat=errStat2 ) ! temp array to pass NumBlades + if (errStat2/=0) call SetErrStat( ErrID_Fatal, 'Allocating numblades per rotor', errStat, errMsg, RoutineName ) + allocate(AeroProjMod(nRotors), stat=errStat2 ) ! temp array to pass AeroProjMod + if (errStat2/=0) call SetErrStat( ErrID_Fatal, 'Allocating AeroProjMod per rotor', errStat, errMsg, RoutineName ) + ! Inflow storage + allocate(m%Inflow(3), stat=errStat2) + if (errStat2/=0) call SetErrStat( ErrID_Fatal, 'Allocating Inflow', errStat, errMsg, RoutineName ) + allocate(m%Inflow(1)%RotInflow(nRotors), stat=errStat2) + if (errStat2/=0) call SetErrStat( ErrID_Fatal, 'Allocating rotor inflow', errStat, errMsg, RoutineName ) if (errStat/=ErrID_None) then call Cleanup() return end if + AeroProjMod=-1 @@ -321,46 +322,70 @@ subroutine AD_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut CALL ParsePrimaryFileInfo( PriPath, InitInp, InitInp%InputFile, p%RootName, NumBlades, interval, FileInfo_In, InputFileData, UnEcho, ErrStat2, ErrMsg2 ) if (Failed()) return; - ! Temporary HACK, for WakeMod=10, 11 or 12 use AeroProjMod 2 (will trigger PolarBEM) - if (InputFileData%WakeMod==10) then - call WrScr(' WARNING: WakeMod=10 is a temporary hack. Using new projection method with WakeMod=0.') - InputFileData%WakeMod = 0 - AeroProjMod(:) = 2 - elseif (InputFileData%WakeMod==11) then - call WrScr(' WARNING: WakeMod=11 is a temporary hack. Using new projection method with WakeMod=1.') - InputFileData%WakeMod = 1 - AeroProjMod(:) = 2 - elseif (InputFileData%WakeMod==12) then - call WrScr(' WARNING: WakeMod=12 is a temporary hack. Using new projection method with WakeMod=2.') - InputFileData%WakeMod = 2 - AeroProjMod(:) = 2 - endif + ! --- "Automatic handling of AeroProjMod + do iR = 1, nRotors + if (AeroProjMod(iR) == -1) then + if (InputFileData%Wake_Mod /= WakeMod_BEMT) then + ! For BEMT, we don't throw a warning + call WrScr('[INFO] Using the input file input `BEM_Mod` to match BEM coordinate system outputs') + endif + select case (InputFileData%BEM_Mod) + case (BEMMod_2D); AeroProjMod(ir) = APM_BEM_NoSweepPitchTwist + case (BEMMod_3D); AeroProjMod(ir) = APM_BEM_Polar + case default; call Fatal('Input `BEM_Mod` not supported: '//trim(num2lstr(InputFileData%BEM_Mod))); return + end select + + endif + enddo + + call AllocAry( calcCrvAngle, sum(NumBlades), 'calcCrvAngle', ErrStat2, ErrMsg2) + if (Failed()) return; ! ----------------------------------------------------------------- ! Read the AeroDyn blade files, or copy from passed input -!FIXME: add handling for passing of blade files and other types of files. - call ReadInputFiles( InitInp%InputFile, InputFileData, interval, p%RootName, NumBlades, AeroProjMod, UnEcho, ErrStat2, ErrMsg2 ) + call ReadInputFiles( InitInp%InputFile, InputFileData, interval, p%RootName, NumBlades, AeroProjMod, UnEcho, calcCrvAngle, ErrStat2, ErrMsg2 ) if (Failed()) return; - + + ! override some parameters to simplify for aero maps + ! bjj: do we put a warning here if any of these values aren't currently set this way? + if (InitInp%CompAeroMaps) then + InputFileData%DTAero = interval ! we're not using this, so set it to something "safe" + InputFileData%UA_Init%UAMod = UA_None + InputFileData%TwrPotent = TwrPotent_none + InputFileData%TwrShadow = TwrShadow_none + InputFileData%TwrAero = TwrAero_none + !InputFileData%CavitCheck = .false. + !InputFileData%TFinAero = .false. ! not sure if this needs to be set or not + InputFileData%DBEMT_Mod = DBEMT_none + end if + ! Validate the inputs - call ValidateInputData( InitInp, InputFileData, NumBlades, ErrStat2, ErrMsg2 ) + call ValidateInputData( InitInp, InputFileData, NumBlades, calcCrvAngle, ErrStat2, ErrMsg2 ) if (Failed()) return; + ! set BlCrvAng (in radians, done after validation of other inputs): + k = 1; + do iR = 1, nRotors + do I=1,NumBlades(iR) + if (calcCrvAngle(k)) CALL setCantAngle( InputFileData%rotors(iR)%BladeProps(I) ) + k = k + 1 + end do + end do + !............................................................................................ ! Define parameters !............................................................................................ ! Initialize AFI module (read Airfoil tables) - call Init_AFIparams( InputFileData, p%AFI, UnEcho, ErrStat2, ErrMsg2 ) + call Init_AFIparams( InputFileData, p%AFI, UnEcho, p%RootName, ErrStat2, ErrMsg2 ) if (Failed()) return; ! set the rest of the parameters - p%SkewMod = InputFileData%SkewMod + p%Skew_Mod = InputFileData%Skew_Mod do iR = 1, nRotors - !p%rotors(iR)%AeroProjMod = InitInp%rotors(iR)%AeroProjMod p%rotors(iR)%AeroProjMod = AeroProjMod(iR) - p%rotors(iR)%AeroBEM_Mod = InitInp%rotors(iR)%AeroBEM_Mod + call WrScr(' AeroDyn: projMod: '//trim(num2lstr(p%rotors(iR)%AeroProjMod))) call SetParameters( InitInp, InputFileData, InputFileData%rotors(iR), p%rotors(iR), p, ErrStat2, ErrMsg2 ) if (Failed()) return; enddo @@ -368,12 +393,21 @@ subroutine AD_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut do iR = 1, nRotors p%rotors(iR)%TFinAero = InputFileData%rotors(iR)%TFinAero p%rotors(iR)%TFin%TFinMod = InputFileData%rotors(iR)%TFin%TFinMod - p%rotors(iR)%TFin%TFinChord = InputFileData%rotors(iR)%TFin%TFinChord p%rotors(iR)%TFin%TFinArea = InputFileData%rotors(iR)%TFin%TFinArea p%rotors(iR)%TFin%TFinIndMod = InputFileData%rotors(iR)%TFin%TFinIndMod p%rotors(iR)%TFin%TFinAFID = InputFileData%rotors(iR)%TFin%TFinAFID + p%rotors(iR)%TFin%TFinChord = InputFileData%rotors(iR)%TFin%TFinChord + p%rotors(iR)%TFin%TFinKp = InputFileData%rotors(iR)%TFin%TFinKp + p%rotors(iR)%TFin%TFinSigma = InputFileData%rotors(iR)%TFin%TFinSigma + p%rotors(iR)%TFin%TFinAStar = InputFileData%rotors(iR)%TFin%TFinAStar + p%rotors(iR)%TFin%TFinKv = InputFileData%rotors(iR)%TFin%TFinKv + p%rotors(iR)%TFin%TFinCDc = InputFileData%rotors(iR)%TFin%TFinCDc enddo - + + ! Set pointer to FlowField data + if (associated(InitInp%FlowField)) p%FlowField => InitInp%FlowField + + !............................................................................................ ! Define and initialize inputs here !............................................................................................ @@ -399,7 +433,7 @@ subroutine AD_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut ! initialize BEMT after setting parameters and inputs because we are going to use the already- ! calculated node positions from the input meshes - if (p%WakeMod /= WakeMod_FVW) then + if (p%Wake_Mod /= WakeMod_FVW) then do iR = 1, nRotors call Init_BEMTmodule( InputFileData, InputFileData%rotors(iR), u%rotors(iR), m%rotors(iR)%BEMT_u(1), p%rotors(iR), p, x%rotors(iR)%BEMT, xd%rotors(iR)%BEMT, z%rotors(iR)%BEMT, & OtherState%rotors(iR)%BEMT, m%rotors(iR)%BEMT_y, m%rotors(iR)%BEMT, ErrStat2, ErrMsg2 ) @@ -418,7 +452,7 @@ subroutine AD_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut end if enddo - else ! if (p%WakeMod == WakeMod_FVW) then + else ! if (p%Wake_Mod == WakeMod_FVW) then !------------------------------------------------------------------------------------------------- ! Initialize FVW module if it is used @@ -449,21 +483,34 @@ subroutine AD_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut !............................................................................................ - ! Initialize states and misc vars + ! Initialize misc vars !............................................................................................ ! many states are in the BEMT module, which were initialized in BEMT_Init() - do iR = 1, nRotors - call Init_MiscVars(m%rotors(iR), p%rotors(iR), u%rotors(iR), y%rotors(iR), errStat2, errMsg2) + call Init_MiscVars(m%rotors(iR), p%rotors(iR), p, u%rotors(iR), y%rotors(iR), errStat2, errMsg2) if (Failed()) return; enddo !............................................................................................ - ! Initialize other states + ! Initialize m%Inflow%RotInflow for tracking wind inflow + !............................................................................................ + do iR = 1, nRotors + call Init_RotInflow( p%rotors(iR), m%Inflow(1)%RotInflow(iR), errStat2, ErrMsg2 ) + if (Failed()) return + enddo + + ! Duplicte Inflow(1) (must be done after Init_OLAF) + call AD_CopyInflowType(m%Inflow(1), m%Inflow(2), MESH_NEWCOPY, ErrStat2, ErrMsg2) + if (Failed()) return + call AD_CopyInflowType(m%Inflow(1), m%Inflow(3), MESH_NEWCOPY, ErrStat2, ErrMsg2) + if (Failed()) return + + !............................................................................................ + ! Initialize states !............................................................................................ ! The wake from FVW is stored in other states. This may not be the best place to put it! - call Init_OtherStates(m, p, OtherState, errStat2, errMsg2) + call Init_States(m, p, OtherState, errStat2, errMsg2) if (Failed()) return; !............................................................................................ @@ -484,10 +531,22 @@ subroutine AD_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut end do end if + ! number of nodes velocity is required at (for coupling to cfd) + InitOut%nNodesVel = 0 + do iR = 1, nRotors + if (u%rotors(iR)%HubMotion%committed) InitOut%nNodesVel = InitOut%nNodesVel + u%rotors(iR)%HubMotion%nNodes + do k = 1,size(u%rotors(iR)%BladeMotion) + if (u%rotors(iR)%BladeMotion(k)%committed) InitOut%nNodesVel = InitOut%nNodesVel + u%rotors(iR)%BladeMotion(k)%nNodes + enddo + if (u%rotors(iR)%TowerMotion%committed) InitOut%nNodesVel = InitOut%nNodesVel + u%rotors(iR)%TowerMotion%nNodes + if (u%rotors(iR)%NacelleMotion%committed) InitOut%nNodesVel = InitOut%nNodesVel + u%rotors(iR)%NacelleMotion%nNodes + if (u%rotors(iR)%TFinMotion%committed) InitOut%nNodesVel = InitOut%nNodesVel + u%rotors(iR)%TFinMotion%nNodes + enddo + !............................................................................................ ! Initialize Jacobian: !............................................................................................ - if (InitInp%Linearize) then + if (InitInp%Linearize .or. InitInp%CompAeroMaps) then do iR = 1, nRotors call Init_Jacobian(InputFileData%rotors(iR), p%rotors(iR), p, u%rotors(iR), y%rotors(iR), m%rotors(iR), InitOut%rotors(iR), errStat2, errMsg2) if (Failed()) return; @@ -499,7 +558,7 @@ subroutine AD_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut !............................................................................................ if (InputFileData%SumPrint) then do iR = 1, nRotors - call AD_PrintSum( InputFileData, p%rotors(iR), p, u, y, ErrStat2, ErrMsg2 ) + call AD_PrintSum( InputFileData, p%rotors(iR), p, u, y, NumBlades(iR), InputFileData%rotors(iR)%BladeProps(:), ErrStat2, ErrMsg2 ) if (Failed()) return; enddo end if @@ -511,10 +570,15 @@ subroutine AD_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut Interval = p%DT - - call Cleanup() + call Cleanup() contains + subroutine Fatal(errMsg_in) + character(*), intent(in) :: errMsg_in + call SetErrStat(ErrID_Fatal, errMsg_in, ErrStat, ErrMsg, RoutineName ) + call Cleanup() + end subroutine Fatal + logical function Failed() CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) Failed = ErrStat >= AbortErrLev @@ -524,6 +588,10 @@ subroutine Cleanup() CALL AD_DestroyInputFile( InputFileData, ErrStat2, ErrMsg2 ) CALL NWTC_Library_Destroyfileinfotype(FileInfo_In, ErrStat2, ErrMsg2) + if (allocated(NumBlades )) deallocate(NumBlades) + if (allocated(AeroProjMod )) deallocate(AeroProjMod) + if (allocated(calcCrvAngle)) deallocate(calcCrvAngle) + IF ( UnEcho > 0 ) CLOSE( UnEcho ) end subroutine Cleanup @@ -565,7 +633,7 @@ subroutine AD_ReInit(p, x, xd, z, OtherState, m, Interval, ErrStat, ErrMsg ) ! and the UA filter end if - if (p%WakeMod /= WakeMod_FVW) then + if (p%Wake_Mod /= WakeMod_FVW) then do IR=1, size(p%rotors) call BEMT_ReInit(p%rotors(iR)%BEMT,x%rotors(iR)%BEMT,xd%rotors(iR)%BEMT,z%rotors(iR)%BEMT,OtherState%rotors(iR)%BEMT,m%rotors(iR)%BEMT,ErrStat,ErrMsg) @@ -583,9 +651,10 @@ subroutine AD_ReInit(p, x, xd, z, OtherState, m, Interval, ErrStat, ErrMsg ) end subroutine AD_ReInit !---------------------------------------------------------------------------------------------------------------------------------- !> This routine initializes (allocates) the misc variables for use during the simulation. -subroutine Init_MiscVars(m, p, u, y, errStat, errMsg) +subroutine Init_MiscVars(m, p, p_AD, u, y, errStat, errMsg) type(RotMiscVarType), intent(inout) :: m !< misc/optimization data (not defined in submodules) type(RotParameterType), intent(in ) :: p !< Parameters + type(AD_ParameterType), intent(in ) :: p_AD !< Parameters type(RotInputType), intent(inout) :: u !< input for HubMotion mesh (create sibling mesh here) type(RotOutputType), intent(inout) :: y !< output (create mapping between output and otherstate mesh here) integer(IntKi), intent( out) :: errStat !< Error status of the operation @@ -593,8 +662,7 @@ subroutine Init_MiscVars(m, p, u, y, errStat, errMsg) ! Local variables - integer(intKi) :: k - integer(intKi) :: j + integer(intKi) :: i, j, k integer(intKi) :: ErrStat2 ! temporary Error status character(ErrMsgLen) :: ErrMsg2 ! temporary Error message character(*), parameter :: RoutineName = 'Init_MiscVars' @@ -604,8 +672,11 @@ subroutine Init_MiscVars(m, p, u, y, errStat, errMsg) errStat = ErrID_None errMsg = "" - call AllocAry( m%DisturbedInflow, 3_IntKi, p%NumBlNds, p%numBlades, 'm%DisturbedInflow', ErrStat2, ErrMsg2 ) ! must be same size as u%InflowOnBlade + call AllocAry( m%DisturbedInflow, 3_IntKi, p%NumBlNds, p%numBlades, 'm%DisturbedInflow', ErrStat2, ErrMsg2 ) ! must be same size as RotInflow%Blade(k)%InflowVel call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) +if ((p_AD%SectAvg) .and. ((p_AD%Wake_Mod == WakeMod_BEMT)) ) then + call AllocAry( m%SectAvgInflow, 3_IntKi, p%NumBlNds, p%numBlades, 'm%SectAvgInflow' , ErrStat2, ErrMsg2 ); if(Failed()) return +endif call AllocAry( m%orientationAnnulus, 3_IntKi, 3_IntKi, p%NumBlNds, p%numBlades, 'm%orientationAnnulus', ErrStat2, ErrMsg2 ) call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) call AllocAry( m%R_li, 3_IntKi, 3_IntKi, p%NumBlNds, p%numBlades, 'm%R_li', ErrStat2, ErrMsg2 ) @@ -633,11 +704,14 @@ subroutine Init_MiscVars(m, p, u, y, errStat, errMsg) call AllocAry( m%Y_Twr, p%NumTwrNds, 'm%Y_Twr', ErrStat2, ErrMsg2 ) call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) ! save blade calculations for output: -if (p%TwrPotent /= TwrPotent_none .or. p%TwrShadow /= TwrShadow_none) then - call AllocAry( m%TwrClrnc, p%NumBlNds, p%NumBlades, 'm%TwrClrnc', ErrStat2, ErrMsg2 ) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) -end if - call AllocAry( m%Curve, p%NumBlNds, p%NumBlades, 'm%Curve', ErrStat2, ErrMsg2 ) + if (p%TwrPotent /= TwrPotent_none .or. p%TwrShadow /= TwrShadow_none) then + call AllocAry( m%TwrClrnc, p%NumBlNds, p%NumBlades, 'm%TwrClrnc', ErrStat2, ErrMsg2 ) + call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) + end if + + call AllocAry( m%Cant, p%NumBlNds, p%NumBlades, 'm%Cant', ErrStat2, ErrMsg2 ) + call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) + call AllocAry( m%Toe, p%NumBlNds, p%NumBlades, 'm%Toe', ErrStat2, ErrMsg2 ) call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) call AllocAry( m%X, p%NumBlNds, p%NumBlades, 'm%X', ErrStat2, ErrMsg2 ) call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) @@ -870,30 +944,38 @@ subroutine Init_MiscVars(m, p, u, y, errStat, errMsg) end if m%FirstWarn_TowerStrike = .true. + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function Failed end subroutine Init_MiscVars !---------------------------------------------------------------------------------------------------------------------------------- -!> This routine initializes (allocates) the misc variables for use during the simulation. -subroutine Init_OtherStates(m, p, OtherState, errStat, errMsg) +!> This routine initializes (allocates) the states for use during the simulation. +subroutine Init_States(m, p, OtherState, errStat, errMsg) type(AD_MiscVarType), intent(in ) :: m !< misc/optimization data (not defined in submodules) type(AD_ParameterType), intent(in ) :: p !< Parameters type(AD_OtherStateType), intent(inout) :: OtherState !< 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 ! temporary Error status - character(ErrMsgLen) :: ErrMsg2 ! temporary Error message - character(*), parameter :: RoutineName = 'Init_OtherStates' + integer(intKi) :: ErrStat2 ! temporary Error status + character(ErrMsgLen) :: ErrMsg2 ! temporary Error message + character(*), parameter :: RoutineName = 'Init_States' errStat = ErrID_None errMsg = "" + + ! store Wake positions in otherstates. This may not be the best location if (allocated(m%FVW%r_wind)) then call AllocAry( OtherState%WakeLocationPoints, 3_IntKi, size(m%FVW%r_wind,DIM=2), ' OtherState%WakeLocationPoints', ErrStat2, ErrMsg2 ) ! must be same size as m%r_wind from FVW call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) OtherState%WakeLocationPoints = m%FVW%r_wind endif -end subroutine Init_OtherStates +end subroutine Init_States !---------------------------------------------------------------------------------------------------------------------------------- !> This routine initializes AeroDyn meshes and output array variables for use during the simulation. subroutine Init_y(y, u, p, errStat, errMsg) @@ -916,7 +998,7 @@ subroutine Init_y(y, u, p, errStat, errMsg) errMsg = "" - if (p%TwrAero .or. p%Buoyancy .and. p%NumTwrNds > 0) then + if (p%NumTwrNds > 0 .and. (p%TwrAero /= TwrAero_None .or. p%Buoyancy)) then call MeshCopy ( SrcMesh = u%TowerMotion & , DestMesh = y%TowerLoad & @@ -937,17 +1019,17 @@ subroutine Init_y(y, u, p, errStat, errMsg) end if - call MeshCopy ( SrcMesh = u%NacelleMotion & - , DestMesh = y%NacelleLoad & - , CtrlCode = MESH_SIBLING & - , IOS = COMPONENT_OUTPUT & - , force = .TRUE. & - , moment = .TRUE. & - , ErrStat = ErrStat2 & - , ErrMess = ErrMsg2 ) + call MeshCopy ( SrcMesh = u%NacelleMotion & + , DestMesh = y%NacelleLoad & + , CtrlCode = MESH_SIBLING & + , IOS = COMPONENT_OUTPUT & + , force = .TRUE. & + , moment = .TRUE. & + , ErrStat = ErrStat2 & + , ErrMess = ErrMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - if (ErrStat >= AbortErrLev) RETURN + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + if (ErrStat >= AbortErrLev) RETURN ! --- TailFin if (p%TFinAero) then @@ -965,7 +1047,7 @@ subroutine Init_y(y, u, p, errStat, errMsg) else y%TFinLoad%NNodes = 0 endif - + call MeshCopy ( SrcMesh = u%HubMotion & , DestMesh = y%HubLoad & @@ -1043,24 +1125,13 @@ subroutine Init_u( u, p, p_AD, InputFileData, MHK, WtrDpth, InitInp, errStat, er ErrStat = ErrID_None ErrMsg = "" - - ! Arrays for InflowWind inputs: - - call AllocAry( u%InflowOnBlade, 3_IntKi, p%NumBlNds, p%numBlades, 'u%InflowOnBlade', ErrStat2, ErrMsg2 ) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - call AllocAry( u%InflowOnTower, 3_IntKi, p%NumTwrNds, 'u%InflowOnTower', ErrStat2, ErrMsg2 ) ! could be size zero - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - call AllocAry( u%UserProp, p%NumBlNds, p%numBlades, 'u%UserProp', ErrStat2, ErrMsg2 ) call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) if (errStat >= AbortErrLev) return - u%InflowOnBlade = 0.0_ReKi + u%UserProp = 0.0_ReKi - u%InflowOnHub = 0.0_ReKi - u%InflowOnNacelle = 0.0_ReKi - u%InflowOnTailFin = 0.0_ReKi ! Meshes for motion inputs (ElastoDyn and/or BeamDyn) !................ @@ -1068,8 +1139,6 @@ subroutine Init_u( u, p, p_AD, InputFileData, MHK, WtrDpth, InitInp, errStat, er !................ if (p%NumTwrNds > 0) then - u%InflowOnTower = 0.0_ReKi - call MeshCreate ( BlankMesh = u%TowerMotion & ,IOS = COMPONENT_INPUT & ,Nnodes = p%NumTwrNds & @@ -1085,9 +1154,9 @@ subroutine Init_u( u, p, p_AD, InputFileData, MHK, WtrDpth, InitInp, errStat, er if (errStat >= AbortErrLev) return ! set node initial position/orientation - position = 0.0_ReKi + position = InitInp%originInit do j=1,p%NumTwrNds - IF ( MHK == 1 ) THEN + IF ( MHK == MHK_FixedBottom ) THEN position(3) = InputFileData%TwrElev(j) - WtrDpth ELSE position(3) = InputFileData%TwrElev(j) @@ -1118,9 +1187,9 @@ subroutine Init_u( u, p, p_AD, InputFileData, MHK, WtrDpth, InitInp, errStat, er !................ ! hub !................ - call CreatePointMesh(u%HubMotion, InitInp%HubPosition, InitInp%HubOrientation, errStat2, errMsg2, hasMotion=.True., hasLoads=.False., hasAcc=.False.) + call CreateInputPointMesh(u%HubMotion, InitInp%HubPosition, InitInp%HubOrientation, errStat2, errMsg2, hasMotion=.True., hasLoads=.False., hasAcc=.False.) if (Failed()) return - + !................ ! TailFin Motion Mesh !................ @@ -1131,7 +1200,7 @@ subroutine Init_u( u, p, p_AD, InputFileData, MHK, WtrDpth, InitInp, errStat, er theta(3) = InputFileData%TFin%TFinAngles(3) orientationL = EulerConstructZYX( theta ) ! nac2tf orientation = matmul(orientationL, InitInp%NacelleOrientation) ! gl2tf = nac2tf * gl2nac - call CreatePointMesh(u%TFinMotion, position, orientation, errStat2, errMsg2, hasMotion=.True., hasLoads=.False., hasAcc=.False.) + call CreateInputPointMesh(u%TFinMotion, position, orientation, errStat2, errMsg2, hasMotion=.True., hasLoads=.False., hasAcc=.False.) if (Failed()) return else u%TFinMotion%NNodes = 0 @@ -1148,7 +1217,7 @@ subroutine Init_u( u, p, p_AD, InputFileData, MHK, WtrDpth, InitInp, errStat, er end if do k=1,p%NumBlades - call CreatePointMesh(u%BladeRootMotion(k), InitInp%BladeRootPosition(:,k), InitInp%BladeRootOrientation(:,:,k), errStat2, errMsg2, hasMotion=.True., hasLoads=.False.) + call CreateInputPointMesh(u%BladeRootMotion(k), InitInp%BladeRootPosition(:,k), InitInp%BladeRootOrientation(:,:,k), errStat2, errMsg2, hasMotion=.True., hasLoads=.False.) if (Failed()) return end do !k=numBlades @@ -1174,6 +1243,7 @@ subroutine Init_u( u, p, p_AD, InputFileData, MHK, WtrDpth, InitInp, errStat, er ,TranslationVel = .true. & ,RotationVel = .true. & ,TranslationAcc = .true. & + ,RotationAcc = .true. & ) call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) @@ -1224,6 +1294,11 @@ subroutine Init_u( u, p, p_AD, InputFileData, MHK, WtrDpth, InitInp, errStat, er u%BladeMotion(k)%RotationVel = 0.0_ReKi u%BladeMotion(k)%TranslationAcc = 0.0_ReKi + if (p_AD%CompAeroMaps) then + do j=1,InputFileData%BladeProps(k)%NumBlNds + u%BladeMotion(k)%TranslationVel(:,j) = cross_product(u%HubMotion%RefOrientation(1,:,1)*InitInp%RotSpeed, u%BladeMotion(k)%Position(:,j)-u%HubMotion%Position(:,1)) + end do + end if end do !k=numBlades @@ -1234,7 +1309,7 @@ subroutine Init_u( u, p, p_AD, InputFileData, MHK, WtrDpth, InitInp, errStat, er ! Nacelle !................ position = real(InitInp%NacellePosition, ReKi) - call CreatePointMesh(u%NacelleMotion, position, InitInp%NacelleOrientation, errStat2, errMsg2, hasMotion=.True., hasLoads=.False., hasAcc=.False.) + call CreateInputPointMesh(u%NacelleMotion, position, InitInp%NacelleOrientation, errStat2, errMsg2, hasMotion=.True., hasLoads=.False., hasAcc=.False.) if (Failed()) return contains @@ -1243,6 +1318,66 @@ logical function Failed() Failed = ErrStat >= AbortErrLev end function Failed end subroutine Init_u + + +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine sets data storage in OtherState for wind information +subroutine Init_RotInflow( p, RotInflow, errStat, ErrMsg ) + type(RotParameterType), intent(in ) :: p !< Parameters + type(RotInflowType), intent(inout) :: RotInflow !< OtherState%RotInflow(iR) + integer(IntKi), intent( out) :: ErrStat !< Error status of the operation + character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + integer(IntKi) :: k + character(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None + integer(IntKi) :: ErrStat2 ! temporary Error status of the operation + character(*), parameter :: RoutineName = 'Init_RotInflow' + + ! Error handling + ErrStat = ErrID_None + ErrMsg = "" + + ! Arrays for InflowWind inputs: + allocate(RotInflow%Blade(p%numBlades), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat( ErrID_Fatal, 'Error allocating RotInflow%Blade', errStat, errMsg, RoutineName ) + if (Failed()) return + end if + + do k = 1, p%NumBlades + call AllocAry( RotInflow%Blade(k)%InflowVel, 3_IntKi, p%NumBlNds, 'RotInflow%Blade(k)%InflowVel', ErrStat2, ErrMsg2 ) + if (Failed()) return + RotInflow%Blade(k)%InflowVel = 0.0_ReKi + + if (p%MHK > 0) then + call AllocAry( RotInflow%Blade(k)%InflowAcc, 3_IntKi, p%NumBlNds, 'RotInflow%Blade(k)%InflowAcc', ErrStat2, ErrMsg2 ) + if (Failed()) return + RotInflow%Blade(k)%InflowAcc = 0.0_ReKi + end if + end do + + call AllocAry( RotInflow%Tower%InflowVel, 3_IntKi, p%NumTwrNds, 'RotInflow%Tower%InflowVel', ErrStat2, ErrMsg2 ) ! could be size zero + if (Failed()) return + + if (p%MHK > 0) then + call AllocAry( RotInflow%Tower%InflowAcc, 3_IntKi, p%NumTwrNds, 'RotInflow%Tower%InflowAcc', ErrStat2, ErrMsg2 ) ! could be size zero + if (Failed()) return + end if + + + RotInflow%InflowOnHub = 0.0_ReKi + RotInflow%InflowOnNacelle = 0.0_ReKi + RotInflow%InflowOnTailFin = 0.0_ReKi + RotInflow%AvgDiskVel = 0.0_ReKi + RotInflow%Tower%InflowVel = 0.0_ReKi + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function Failed +end subroutine Init_RotInflow + + !---------------------------------------------------------------------------------------------------------------------------------- !> This routine sets AeroDyn parameters for use during the simulation; these variables are not changed after AD_Init. subroutine SetParameters( InitInp, InputFileData, RotData, p, p_AD, ErrStat, ErrMsg ) @@ -1266,23 +1401,30 @@ subroutine SetParameters( InitInp, InputFileData, RotData, p, p_AD, ErrStat, Err ErrStat = ErrID_None ErrMsg = "" - p_AD%UA_Flag = InputFileData%AFAeroMod == AFAeroMod_BL_unsteady + p_AD%UA_Flag = InputFileData%UA_Init%UAMod > UA_None + p_AD%CompAeroMaps = InitInp%CompAeroMaps + + p_AD%SectAvg = InputFileData%SectAvg + p_AD%SA_Weighting = InputFileData%SA_Weighting + p_AD%SA_PsiBwd = InputFileData%SA_PsiBwd*D2R + p_AD%SA_PsiFwd = InputFileData%SA_PsiFwd*D2R + p_AD%SA_nPerSec = InputFileData%SA_nPerSec + p%MHK = InitInp%MHK p_AD%DT = InputFileData%DTAero - p_AD%WakeMod = InputFileData%WakeMod + p_AD%Wake_Mod = InputFileData%Wake_Mod + p%DBEMT_Mod = InputFileData%DBEMT_Mod p%TwrPotent = InputFileData%TwrPotent p%TwrShadow = InputFileData%TwrShadow p%TwrAero = InputFileData%TwrAero p%CavitCheck = InputFileData%CavitCheck p%Buoyancy = InputFileData%Buoyancy - - if (InitInp%Linearize .and. InputFileData%WakeMod == WakeMod_BEMT) then - p%FrozenWake = InputFileData%FrozenWake - else - p%FrozenWake = .FALSE. - end if + p%NacelleDrag = InputFileData%NacelleDrag + p%NacArea = RotData%NacArea + p%NacCd = RotData%NacCd + p%NacDragAC = RotData%NacDragAC p%CompAA = InputFileData%CompAA @@ -1300,24 +1442,15 @@ subroutine SetParameters( InitInp, InputFileData, RotData, p, p_AD, ErrStat, Err call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) endif - if (p%TwrPotent == TwrPotent_none .and. p%TwrShadow == TwrShadow_none .and. .not. p%TwrAero .and. .not. p%Buoyancy ) then - p%NumTwrNds = 0 - elseif (p%TwrPotent == TwrPotent_none .and. p%TwrShadow == TwrShadow_none .and. .not. p%TwrAero .and. p%Buoyancy .and. RotData%NumTwrNds <= 0 ) then - p%NumTwrNds = 0 - elseif (p%TwrPotent == TwrPotent_none .and. p%TwrShadow == TwrShadow_none .and. .not. p%TwrAero .and. p%Buoyancy .and. RotData%NumTwrNds > 0 ) then - p%NumTwrNds = RotData%NumTwrNds - - call move_alloc( RotData%TwrDiam, p%TwrDiam ) - call move_alloc( RotData%TwrCd, p%TwrCd ) - call move_alloc( RotData%TwrTI, p%TwrTI ) - call move_alloc( RotData%TwrCb, p%TwrCb ) - else + if (RotData%NumTwrNds > 0 .and. (p%TwrPotent /= TwrPotent_none .or. p%TwrShadow /= TwrShadow_none .or. p%TwrAero /= TwrAero_none .or. p%Buoyancy)) then p%NumTwrNds = RotData%NumTwrNds - + call move_alloc( RotData%TwrDiam, p%TwrDiam ) - call move_alloc( RotData%TwrCd, p%TwrCd ) - call move_alloc( RotData%TwrTI, p%TwrTI ) + call move_alloc( RotData%TwrCd, p%TwrCd ) + call move_alloc( RotData%TwrTI, p%TwrTI ) call move_alloc( RotData%TwrCb, p%TwrCb ) + else + p%NumTwrNds = 0 end if if (p%Buoyancy) then @@ -1501,7 +1634,7 @@ subroutine AD_End( u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) ! Place any last minute operations or calculations here: ! End the FVW submodule - if (p%WakeMod == WakeMod_FVW ) then + if (p%Wake_Mod == WakeMod_FVW ) then if ( p%UA_Flag ) then do iW=1,p%FVW%nWings @@ -1568,24 +1701,28 @@ subroutine AD_UpdateStates( t, n, u, utimes, p, x, xd, z, OtherState, m, errStat character(*), intent( out) :: errMsg !< Error message if ErrStat /= ErrID_None ! local variables - integer(intKi) :: iR ! Counter on rotors - integer :: i + integer(intKi) :: iR ! Counter on rotors + integer(intKi) :: i real(DbKi) :: BEMT_utimes(2) !< Times associated with m%BEMT_u(:), in seconds - type(AD_InputType) :: uInterp ! Interpolated/Extrapolated input - integer(intKi) :: ErrStat2 ! temporary Error status - character(ErrMsgLen) :: ErrMsg2 ! temporary Error message - character(*), parameter :: RoutineName = 'AD_UpdateStates' + type(AD_InputType) :: uInterp ! Interpolated/Extrapolated input + type(AD_InflowType) :: InflowInterp ! Interpolated/Extrapolated inflow + integer(intKi) :: ErrStat2 ! temporary Error status + character(ErrMsgLen) :: ErrMsg2 ! temporary Error message + character(*), parameter :: RoutineName = 'AD_UpdateStates' ErrStat = ErrID_None ErrMsg = "" - + + ! Set wind -- NOTE: this is inneficient since the previous input value resides at m%Inflow(2) + do i=1,size(u) + call AD_CalcWind(utimes(i), u(i), p%FLowField, p, OtherState, m%Inflow(i), ErrStat2, ErrMsg2) + if (Failed()) return + enddo call AD_CopyInput( u(1), uInterp, MESH_NEWCOPY, errStat2, errMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) then - call Cleanup() - return - end if + if (Failed()) return + call AD_CopyInflowType( m%Inflow(1), InflowInterp, MESH_NEWCOPY, errStat2, errMsg2) + if (Failed()) return ! set values of m%BEMT_u(2) from inputs interpolated at t+dt; ! set values of m%BEMT_u(1) from inputs (uInterp) interpolated at t @@ -1594,30 +1731,33 @@ subroutine AD_UpdateStates( t, n, u, utimes, p, x, xd, z, OtherState, m, errStat BEMT_utimes(1) = t do i=2,1,-1 ! I'm calculating values for t second in case we want the other misc vars at t as before, but I don't think it matters) call AD_Input_ExtrapInterp(u,utimes,uInterp,BEMT_utimes(i), errStat2, errMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (Failed()) return - do iR = 1,size(p%rotors) - call SetInputs(p%rotors(iR), p, uInterp%rotors(iR), m%rotors(iR), i, errStat2, errMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - enddo - enddo - + ! Calculate wind using uInterp + call AD_CalcWind(utimes(i),uInterp, p%FLowField, p, OtherState, m%Inflow(1), ErrStat2, ErrMsg2) + if (Failed()) return + + do iR = 1,size(p%rotors) + call SetInputs(t, p%rotors(iR), p, uInterp%rotors(iR), InflowInterp%RotInflow(iR), m%rotors(iR), i, errStat2, errMsg2) + if (Failed()) return + enddo + end do - if (p%WakeMod /= WakeMod_FVW) then + if (p%Wake_Mod /= WakeMod_FVW) then do iR = 1,size(p%rotors) ! Call into the BEMT update states NOTE: This is a non-standard framework interface!!!!! GJH call BEMT_UpdateStates(t, n, m%rotors(iR)%BEMT_u(:), BEMT_utimes, p%rotors(iR)%BEMT, x%rotors(iR)%BEMT, xd%rotors(iR)%BEMT, z%rotors(iR)%BEMT, OtherState%rotors(iR)%BEMT, p%AFI, m%rotors(iR)%BEMT, errStat2, errMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (Failed()) return ! Call AeroAcoustics updates states if ( p%rotors(iR)%CompAA ) then ! We need the outputs from BEMT as inputs to AeroAcoustics module ! Also, SetInputs() [called above] calls SetInputsForBEMT() which in turn establishes current versions of the Global to local transformations we need as inputs to AA - call SetInputsForAA(p%rotors(iR), u(1)%rotors(iR), m%rotors(iR), errStat2, errMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SetInputsForAA(p%rotors(iR), u(1)%rotors(iR), m%Inflow(1)%RotInflow(iR), m%rotors(iR), errStat2, errMsg2) + if (Failed()) return call AA_UpdateStates(t, n, m%rotors(iR)%AA, m%rotors(iR)%AA_u, p%rotors(iR)%AA, xd%rotors(iR)%AA, errStat2, errMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (Failed()) return end if enddo @@ -1625,18 +1765,18 @@ subroutine AD_UpdateStates( t, n, u, utimes, p, x, xd, z, OtherState, m, errStat ! This needs to extract the inputs from the AD data types (mesh) and copy pieces for the FVW module do i=1,size(u) call SetInputsForFVW(p, u(i), i, m, errStat2, errMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (Failed()) return enddo ! Note: the setup is handled above in the SetInputs routine call FVW_UpdateStates( t, n, m%FVW_u, utimes, p%FVW, x%FVW, xd%FVW, z%FVW, OtherState%FVW, p%AFI, m%FVW, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (Failed()) return ! The wind points are passed out as other states. These really correspond to the propogation of the vortex to the next wind position. if (allocated(OtherState%WakeLocationPoints)) then OtherState%WakeLocationPoints = m%FVW%r_wind endif ! UA TODO !call UA_UpdateState_Wrapper(p%AFI, n, p%FVW, x%FVW, xd%FVW, OtherState%FVW, m%FVW, ErrStat2, ErrMsg2) - ! call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + ! if (Failed()) return endif call Cleanup() @@ -1644,8 +1784,159 @@ subroutine AD_UpdateStates( t, n, u, utimes, p, x, xd, z, OtherState, m, errStat contains subroutine Cleanup() call AD_DestroyInput( uInterp, errStat2, errMsg2) + call AD_DestroyInflowType( InflowInterp, ErrStat2, ErrMsg2) end subroutine Cleanup + logical function Failed() + call SetErrStat(errStat2, errMsg2, errStat, errMsg, 'AD_UpdateStates') + Failed = errStat >= AbortErrLev + if (Failed) call Cleanup() + end function Failed end subroutine AD_UpdateStates + +subroutine AD_CalcWind(t, u, FLowField, p, o, Inflow, ErrStat, ErrMsg) + real(DbKi), intent(in ) :: t !< Current simulation time in seconds + type(AD_InputType), intent(in ) :: u !< Inputs at Time t + type(FlowFieldType),pointer, intent(in ) :: FlowField + type(AD_ParameterType), intent(in ) :: p !< Parameters + type(AD_OtherStateType), intent(in ) :: o !< Other states at t + type(AD_InflowType),target, intent(inout) :: Inflow !< calculated inflow + 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 + integer(intKi) :: StartNode, iWT, k + real(ReKi) :: PosOffset(3) + real(ReKi), allocatable :: NoAcc(:,:) + type(RotInflowType), pointer :: RotInflow ! pointer to shorten names + + ErrStat = ErrID_None + ErrMsg = "" + + if (.not. associated(FlowField)) return ! use the initial (or input) values for these inputs + ! bjj: if the previous line is not appropriate, then some other check for if FlowField has been set should be used. + + ! Initialize node. The StartNode is used for OpenFOAM to provide the wind + ! velocities. The node ordering in OpenFOAM must match that used in here. + StartNode = 1 + + do iWT = 1, size(u%rotors) + call AD_CalcWind_Rotor(t, u%rotors(iWT), FLowField, p%rotors(iWT), Inflow%RotInflow(iWT), StartNode, ErrStat2, ErrMsg2) + if(Failed()) return + enddo + + ! OLAF points + if (allocated(o%WakeLocationPoints) .and. allocated(Inflow%InflowWakeVel)) then + ! If rotor is MHK, add water depth to z coordinate + if (p%FVW%MHK > 0) then + PosOffset = [0.0_ReKi, 0.0_ReKi, p%FVW%WtrDpth] + else + PosOffset = 0.0_ReKi + end if + + call IfW_FlowField_GetVelAcc(FlowField, StartNode, t, & + o%WakeLocationPoints, & + Inflow%InflowWakeVel, & + NoAcc, ErrStat2, ErrMsg2, & + BoxExceedAllow=.true., PosOffset=PosOffset) + if(Failed()) return + StartNode = StartNode + size(o%WakeLocationPoints) + end if + +contains + logical function Failed() + call SetErrStat(errStat2, errMsg2, errStat, errMsg, 'AD_CalcWind') + Failed = errStat >= AbortErrLev + end function Failed +end subroutine + +subroutine AD_CalcWind_Rotor(t, u, FlowField, p, RotInflow, StartNode, ErrStat, ErrMsg) + real(DbKi), intent(in ) :: t !< Current simulation time in seconds + type(RotInputType), intent(in ) :: u !< Inputs at Time t + type(FlowFieldType),pointer, intent(in ) :: FlowField + type(RotParameterType), intent(in ) :: p !< Parameters + type(RotInflowType), intent(inout) :: RotInflow !< calculated inflow for rotor + integer(IntKi), intent(inout) :: StartNode !< starting node for rotor wind + 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 + integer(intKi) :: k + real(ReKi) :: PosOffset(3) + real(ReKi), allocatable :: NoAcc(:,:) + + ErrStat = ErrID_None + ErrMsg = "" + + if (.not. associated(FlowField)) return ! use the initial (or input) values for these inputs + + ! If rotor is MHK, add water depth to z coordinate + if (p%MHK > 0) then + PosOffset = [0.0_ReKi, 0.0_ReKi, p%WtrDpth] + else + PosOffset = 0.0_ReKi + end if + + ! Hub + if (u%HubMotion%Committed) then + call IfW_FlowField_GetVelAcc(FlowField, StartNode, t, & + real(u%HubMotion%TranslationDisp + u%HubMotion%Position, ReKi), & + RotInflow%InflowOnHub, NoAcc, ErrStat2, ErrMsg2, PosOffset=PosOffset) + if(Failed()) return + else + RotInflow%InflowOnHub = 0.0_ReKi + end if + StartNode = StartNode + 1 + + ! Blade + do k = 1, p%NumBlades + call IfW_FlowField_GetVelAcc(FlowField, StartNode, t, & + real(u%BladeMotion(k)%TranslationDisp + u%BladeMotion(k)%Position, ReKi), & + RotInflow%Blade(k)%InflowVel, RotInflow%Blade(k)%InflowAcc, ErrStat2, ErrMsg2, PosOffset=PosOffset) + if(Failed()) return + StartNode = StartNode + p%NumBlNds + end do + + ! Tower + if (u%TowerMotion%Nnodes > 0) then + call IfW_FlowField_GetVelAcc(FlowField, StartNode, t, & + real(u%TowerMotion%TranslationDisp + u%TowerMotion%Position, ReKi), & + RotInflow%Tower%InflowVel, RotInflow%Tower%InflowAcc, ErrStat2, ErrMsg2, PosOffset=PosOffset) + if(Failed()) return + StartNode = StartNode + p%NumTwrNds + end if + + ! Nacelle + if (u%NacelleMotion%Committed) then + call IfW_FlowField_GetVelAcc(FlowField, StartNode, t, & + real(u%NacelleMotion%TranslationDisp + u%NacelleMotion%Position, ReKi), & + RotInflow%InflowOnNacelle, NoAcc, ErrStat2, ErrMsg2, PosOffset=PosOffset) + if(Failed()) return + StartNode = StartNode + 1 + else + RotInflow%InflowOnNacelle = 0.0_ReKi + end if + + ! TailFin + if (u%TFinMotion%Committed) then + call IfW_FlowField_GetVelAcc(FlowField, StartNode, t, & + real(u%TFinMotion%TranslationDisp + u%TFinMotion%Position, ReKi), & + RotInflow%InflowOnTailFin, NoAcc, ErrStat2, ErrMsg2, PosOffset=PosOffset) + if(Failed()) return + StartNode = StartNode + 1 + else + RotInflow%InflowOnTailFin = 0.0_ReKi + end if + +contains + logical function Failed() + call SetErrStat(errStat2, errMsg2, errStat, errMsg, 'AD_CalcWindRotor') + Failed = errStat >= AbortErrLev + end function Failed +end subroutine + + !---------------------------------------------------------------------------------------------------------------------------------- !> 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. @@ -1671,13 +1962,11 @@ subroutine AD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None LOGICAL, OPTIONAL, INTENT(IN ) :: NeedWriteOutput !< Flag to determine if WriteOutput values need to be calculated in this call - - integer(intKi) :: iR ! Loop on rotors - integer(intKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_CalcOutput' LOGICAL :: CalcWriteOutput + integer(intKi) :: iR ! Loop on rotors ErrStat = ErrID_None ErrMsg = "" @@ -1688,52 +1977,74 @@ subroutine AD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, CalcWriteOutput = .true. ! by default, calculate WriteOutput unless told that we do not need it end if + ! Calculate wind based on current positions + call AD_CalcWind(t, u, p%FlowField, p, OtherState, m%Inflow(1), ErrStat2, ErrMsg2) + if(Failed()) return ! SetInputs, Calc BEM Outputs and Twr Outputs do iR=1,size(p%rotors) - call RotCalcOutput( t, u%rotors(iR), p%rotors(iR), p, x%rotors(iR), xd%rotors(iR), z%rotors(iR), OtherState%rotors(iR), y%rotors(iR), m%rotors(iR), m, iR, ErrStat2, ErrMsg2, .false.) - call SetErrStat(ErrStat2, ErrMSg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return + call RotCalcOutput(t, u%rotors(iR), m%Inflow(1)%RotInflow(iR), p%rotors(iR), p, x%rotors(iR), & + xd%rotors(iR), z%rotors(iR), OtherState%rotors(iR), & + y%rotors(iR), m%rotors(iR), m, iR, ErrStat2, ErrMsg2, .false.) + if(Failed()) return enddo - if (p%WakeMod == WakeMod_FVW) then + if (p%Wake_Mod == WakeMod_FVW) then ! This needs to extract the inputs from the AD data types (mesh) and copy pieces for the FVW module call SetInputsForFVW(p, u, 1, m, errStat2, errMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if(Failed()) return ! Calculate Outputs at time t CALL FVW_CalcOutput( t, m%FVW_u(1), p%FVW, x%FVW, xd%FVW, z%FVW, OtherState%FVW, m%FVW_y, m%FVW, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if(Failed()) return call SetOutputsFromFVW( t, u, p, OtherState, x, xd, m, y, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if(Failed()) return endif ! Cavitation check call AD_CavtCrit(u, p, m, errStat2, errMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if(Failed()) return + + ! initialize nacelle mesh loads + do iR = 1,size(p%rotors) + y%rotors(iR)%NacelleLoad%Force = 0.0_ReKi + y%rotors(iR)%NacelleLoad%Moment = 0.0_ReKi + end do ! Calculate buoyant loads do iR = 1,size(p%rotors) if ( p%rotors(iR)%Buoyancy ) then call CalcBuoyantLoads( u%rotors(iR), p%rotors(iR), m%rotors(iR), y%rotors(iR), ErrStat, ErrMsg ) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return + if(Failed()) return end if end do + ! Calculate nacelle drag loads + do iR = 1,size(p%rotors) + if ( p%rotors(iR)%NacelleDrag ) then + call computeNacelleDrag( u%rotors(iR), p%rotors(iR), m%rotors(iR), y%rotors(iR), m%Inflow(1)%RotInflow(iR), ErrStat, ErrMsg ) + if(Failed()) return + end if + end do + !------------------------------------------------------- ! get values to output to file: !------------------------------------------------------- if (CalcWriteOutput) then do iR = 1,size(p%rotors) - call RotWriteOutputs(t, u%rotors(iR), p%rotors(iR), p, x%rotors(iR), xd%rotors(iR), z%rotors(iR), OtherState%rotors(iR), y%rotors(iR), m%rotors(iR), m, iR, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMSg2, ErrStat, ErrMsg, RoutineName) + call RotWriteOutputs(t, u%rotors(iR), m%Inflow(1)%RotInflow(iR), p%rotors(iR), p, x%rotors(iR), xd%rotors(iR), z%rotors(iR), OtherState%rotors(iR), y%rotors(iR), m%rotors(iR), m, iR, ErrStat2, ErrMsg2) + if(Failed()) return end do end if +contains + logical function Failed() + call SetErrStat(errStat2, errMsg2, errStat, errMsg, RoutineName) + Failed = errStat >= AbortErrLev + end function Failed end subroutine AD_CalcOutput !---------------------------------------------------------------------------------------------------------------------------------- -subroutine RotCalcOutput( t, u, p, p_AD, x, xd, z, OtherState, y, m, m_AD, iRot, ErrStat, ErrMsg, NeedWriteOutput) +subroutine RotCalcOutput( t, u, RotInflow, p, p_AD, x, xd, z, OtherState, y, m, m_AD, iRot, ErrStat, ErrMsg, NeedWriteOutput) ! 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. @@ -1741,6 +2052,7 @@ subroutine RotCalcOutput( t, u, p, p_AD, x, xd, z, OtherState, y, m, m_AD, iRot, REAL(DbKi), INTENT(IN ) :: t !< Current simulation time in seconds TYPE(RotInputType), INTENT(IN ) :: u !< Inputs at Time t + TYPE(RotInflowType), INTENT(IN ) :: RotInflow !< Rotor Inflow at Time t TYPE(RotParameterType), INTENT(IN ) :: p !< Parameters TYPE(AD_ParameterType), INTENT(IN ) :: p_AD !< Parameters TYPE(RotContinuousStateType), INTENT(IN ) :: x !< Continuous states at t @@ -1774,10 +2086,10 @@ subroutine RotCalcOutput( t, u, p, p_AD, x, xd, z, OtherState, y, m, m_AD, iRot, CalcWriteOutput = .true. ! by default, calculate WriteOutput unless told that we do not need it end if - call SetInputs(p, p_AD, u, m, indx, errStat2, errMsg2) + call SetInputs(t, p, p_AD, u, RotInflow, m, indx, errStat2, errMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (p_AD%WakeMod /= WakeMod_FVW) then + if (p_AD%Wake_Mod /= WakeMod_FVW) then ! Call the BEMT module CalcOutput. Notice that the BEMT outputs are purposely attached to AeroDyn's MiscVar structure to ! avoid issues with the coupling code @@ -1789,7 +2101,7 @@ subroutine RotCalcOutput( t, u, p, p_AD, x, xd, z, OtherState, y, m, m_AD, iRot, if ( p%CompAA ) then ! We need the outputs from BEMT as inputs to AeroAcoustics module ! Also, SetInputs() [called above] calls SetInputsForBEMT() which in turn establishes current versions of the Global to local transformations we need as inputs to AA - call SetInputsForAA(p, u, m, errStat2, errMsg2) + call SetInputsForAA(p, u, RotInflow, m, errStat2, errMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call AA_CalcOutput(t, m%AA_u, p%AA, x%AA, xd%AA, z%AA, OtherState%AA, m%AA_y, m%AA, errStat2, errMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1797,14 +2109,15 @@ subroutine RotCalcOutput( t, u, p, p_AD, x, xd, z, OtherState, y, m, m_AD, iRot, endif - if ( p%TwrAero ) then - call ADTwr_CalcOutput(p, u, m, y, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if ( p%TwrAero /= TwrAero_none ) then + call ADTwr_CalcOutput(p, u, RotInflow, m, y, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) endif ! --- Tail Fin if (p%TFinAero) then - call TFin_CalcOutput(p, p_AD, u, m, y, ErrStat2, ErrMsg2) + call TFin_CalcOutput(p, p_AD, u, RotInflow, m, y, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) endif @@ -1812,12 +2125,13 @@ subroutine RotCalcOutput( t, u, p, p_AD, x, xd, z, OtherState, y, m, m_AD, iRot, ! get values to output to file: !------------------------------------------------------- if (CalcWriteOutput) then - call RotWriteOutputs(t, u, p, p_AD, x, xd, z, OtherState, y, m, m_AD, iRot, ErrStat, ErrMsg) + call RotWriteOutputs(t, u, RotInflow, p, p_AD, x, xd, z, OtherState, y, m, m_AD, iRot, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end if end subroutine RotCalcOutput !---------------------------------------------------------------------------------------------------------------------------------- -subroutine RotWriteOutputs( t, u, p, p_AD, x, xd, z, OtherState, y, m, m_AD, iRot, ErrStat, ErrMsg) +subroutine RotWriteOutputs( t, u, RotInflow, p, p_AD, x, xd, z, OtherState, y, m, m_AD, iRot, ErrStat, ErrMsg) ! 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. @@ -1825,6 +2139,7 @@ subroutine RotWriteOutputs( t, u, p, p_AD, x, xd, z, OtherState, y, m, m_AD, iRo REAL(DbKi), INTENT(IN ) :: t !< Current simulation time in seconds TYPE(RotInputType), INTENT(IN ) :: u !< Inputs at Time t + TYPE(RotInflowType), INTENT(IN ) :: RotInflow !< Rotor inflow at Time t TYPE(RotParameterType), INTENT(IN ) :: p !< Parameters TYPE(AD_ParameterType), INTENT(IN ) :: p_AD !< Parameters TYPE(RotContinuousStateType), INTENT(IN ) :: x !< Continuous states at t @@ -1846,14 +2161,14 @@ subroutine RotWriteOutputs( t, u, p, p_AD, x, xd, z, OtherState, y, m, m_AD, iRo integer(intKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'RotCalcOutput' + character(*), parameter :: RoutineName = 'RotWriteOutputs' real(R8Ki) :: x_hat_disk(3) ! LOGICAL :: CalcWriteOutput !------------------------------------------------------- ! get values to output to file: !------------------------------------------------------- if (p%NumOuts > 0) then - call Calc_WriteOutput( p, p_AD, u, x, m, m_AD, y, OtherState, xd, indx, iRot, ErrStat2, ErrMsg2 ) + call Calc_WriteOutput( p, p_AD, u, RotInflow, x, m, m_AD, y, OtherState, xd, indx, iRot, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) !............................................................................................................................... @@ -1879,7 +2194,7 @@ subroutine RotWriteOutputs( t, u, p, p_AD, x, xd, z, OtherState, y, m, m_AD, iRo ! Compute R_li for all nodes call Calculate_MeshOrientation_Rel2Hub(u%BladeMotion(k), u%HubMotion, x_hat_disk, m%R_li(:,:,:,k)) enddo - call Calc_WriteAllBldNdOutput( p, p_AD, u, m, m_AD, x, y, OtherState, indx, iRot, ErrStat2, ErrMsg2 ) ! Call after normal writeoutput. Will just postpend data on here. + call Calc_WriteAllBldNdOutput( p, p_AD, u, m, m_AD, x, y, OtherState, RotInflow, indx, iRot, ErrStat2, ErrMsg2 ) ! Call after normal writeoutput. Will just postpend data on here. call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end if end if @@ -1909,10 +2224,10 @@ subroutine AD_CavtCrit(u, p, m, errStat, errMsg) do j = 1,p%rotors(iR)%numBlades ! Loop through all blades do i = 1,p%rotors(iR)%NumBlNds ! Loop through all nodes - if ( p%WakeMod == WakeMod_BEMT .or. p%WakeMod == WakeMod_DBEMT ) then + if ( p%Wake_Mod == WakeMod_BEMT ) then Vreltemp = m%rotors(iR)%BEMT_y%Vrel(i,j) Cpmintemp = m%rotors(iR)%BEMT_y%Cpmin(i,j) - else if ( p%WakeMod == WakeMod_FVW ) then + else if ( p%Wake_Mod == WakeMod_FVW ) then iW = p%FVW%Bld2Wings(iR,j) Vreltemp = m%FVW%W(iW)%BN_Vrel(i) Cpmintemp = m%FVW%W(iW)%BN_Cpmin(i) @@ -2218,7 +2533,7 @@ subroutine CalcBuoyantLoads( u, p, m, y, ErrStat, ErrMsg ) end if ! Add buoyant loads to aerodynamic loads - if ( p%TwrAero ) then + if ( p%TwrAero /= TwrAero_None ) then do j = 1,p%NumTwrNds ! loop through all nodes y%TowerLoad%Force(:,j) = y%TowerLoad%Force(:,j) + m%TwrBuoyLoad%Force(:,j) y%TowerLoad%Moment(:,j) = y%TowerLoad%Moment(:,j) + m%TwrBuoyLoad%Moment(:,j) @@ -2289,6 +2604,7 @@ subroutine CalcBuoyantLoads( u, p, m, y, ErrStat, ErrMsg ) if ( p%VolNac == 0 ) then m%NacFB = NacFBtmp m%NacMB = NacMBtmp + else ! Check that nacelle node does not go beneath the seabed or pierce the free surface if ( u%NacelleMotion%Position(3,1) + u%NacelleMotion%TranslationDisp(3,1) >= p%MSL2SWL .OR. u%NacelleMotion%Position(3,1) + u%NacelleMotion%TranslationDisp(3,1) <= -p%WtrDpth ) & @@ -2324,11 +2640,17 @@ subroutine CalcBuoyantLoads( u, p, m, y, ErrStat, ErrMsg ) ! Pass to m variable m%NacFB = NacFBtmp m%NacMB = NacMBtmp + end if - ! Assign buoyant loads to nacelle mesh - y%NacelleLoad%Force(:,1) = NacFBtmp - y%NacelleLoad%Moment(:,1) = NacMBtmp + ! Assign buoyant loads to nacelle mesh. Mesh might contain the nacelle drag force. + y%NacelleLoad%Force(:,1) = y%NacelleLoad%Force(:,1) + NacFBtmp + y%NacelleLoad%Moment(:,1) = y%NacelleLoad%Moment(:,1) + NacMBtmp + + ! Passing buoyant loads to m variable, drag loads are called after buoyant loads + m%NacFi = y%NacelleLoad%Force(:,1) + m%NacMi = y%NacelleLoad%Moment(:,1) + end subroutine CalcBuoyantLoads !---------------------------------------------------------------------------------------------------------------------------------- @@ -2362,18 +2684,19 @@ subroutine AD_CalcConstrStateResidual( Time, u, p, x, xd, z, OtherState, m, z_re do iR=1, size(p%rotors) - call RotCalcConstrStateResidual( Time, u%rotors(iR), p%rotors(iR), p, x%rotors(iR), xd%rotors(iR), z%rotors(iR), OtherState%rotors(iR), m%rotors(iR), z_residual%rotors(iR), ErrStat2, ErrMsg2 ) + call RotCalcConstrStateResidual( Time, u%rotors(iR), m%Inflow(1)%RotInflow(iR), p%rotors(iR), p, x%rotors(iR), xd%rotors(iR), z%rotors(iR), OtherState%rotors(iR), m%rotors(iR), z_residual%rotors(iR), ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) enddo end subroutine AD_CalcConstrStateResidual !---------------------------------------------------------------------------------------------------------------------------------- !> Tight coupling routine for solving for the residual of the constraint state equations -subroutine RotCalcConstrStateResidual( Time, u, p, p_AD, x, xd, z, OtherState, m, z_residual, ErrStat, ErrMsg ) +subroutine RotCalcConstrStateResidual( Time, u, RotInflow, p, p_AD, x, xd, z, OtherState, m, z_residual, ErrStat, ErrMsg ) !.................................................................................................................................. REAL(DbKi), INTENT(IN ) :: Time !< Current simulation time in seconds TYPE(RotInputType), INTENT(IN ) :: u !< Inputs at Time + TYPE(RotInflowType), INTENT(IN ) :: RotInflow !< rotor inflow at Time TYPE(RotParameterType), INTENT(IN ) :: p !< Parameters TYPE(AD_ParameterType), INTENT(IN ) :: p_AD !< Parameters TYPE(RotContinuousStateType), INTENT(IN ) :: x !< Continuous states at Time @@ -2401,7 +2724,7 @@ subroutine RotCalcConstrStateResidual( Time, u, p, p_AD, x, xd, z, OtherState, m end if - call SetInputs(p, p_AD, u, m, indx, errStat2, errMsg2) + call SetInputs(Time, p, p_AD, u, RotInflow, m, indx, errStat2, errMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2412,12 +2735,13 @@ subroutine RotCalcConstrStateResidual( Time, u, p, p_AD, x, xd, z, OtherState, m end subroutine RotCalcConstrStateResidual !---------------------------------------------------------------------------------------------------------------------------------- -subroutine RotCalcContStateDeriv( t, u, p, p_AD, x, xd, z, OtherState, m, dxdt, ErrStat, ErrMsg ) +subroutine RotCalcContStateDeriv( t, u, RotInflow, p, p_AD, x, xd, z, OtherState, m, dxdt, ErrStat, ErrMsg ) ! Tight coupling routine for computing derivatives of continuous states !.................................................................................................................................. REAL(DbKi), INTENT(IN ) :: t ! Current simulation time in seconds TYPE(RotInputType), INTENT(IN ) :: u ! Inputs at t + TYPE(RotInflowType), INTENT(IN ) :: RotInflow !< Rotor inflow Inputs at Time TYPE(RotParameterType), INTENT(IN ) :: p ! Parameters TYPE(AD_ParameterType), INTENT(IN ) :: p_AD ! Parameters TYPE(RotContinuousStateType), INTENT(IN ) :: x ! Continuous states at t @@ -2441,7 +2765,7 @@ subroutine RotCalcContStateDeriv( t, u, p, p_AD, x, xd, z, OtherState, m, dxdt, ErrStat = ErrID_None ErrMsg = "" - call SetInputs(p, p_AD, u, m, InputIndex, ErrStat2, ErrMsg2) + call SetInputs(t, p, p_AD, u, RotInflow, m, InputIndex, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call BEMT_CalcContStateDeriv( t, m%BEMT_u(InputIndex), p%BEMT, x%BEMT, xd%BEMT, z%BEMT, OtherState%BEMT, m%BEMT, dxdt%BEMT, p_AD%AFI, ErrStat2, ErrMsg2 ) @@ -2451,10 +2775,12 @@ END SUBROUTINE RotCalcContStateDeriv !---------------------------------------------------------------------------------------------------------------------------------- !> This subroutine converts the AeroDyn inputs into values that can be used for its submodules. It calculates the disturbed inflow !! on the blade if tower shadow or tower influence are enabled, then uses these values to set m%BEMT_u(indx). -subroutine SetInputs(p, p_AD, u, m, indx, errStat, errMsg) +subroutine SetInputs(t, p, p_AD, u, RotInflow, m, indx, errStat, errMsg) + real(DbKi), intent(in ) :: t !< Current simulation time in seconds type(RotParameterType), intent(in ) :: p !< AD parameters type(AD_ParameterType), intent(in ) :: p_AD !< AD parameters type(RotInputType), intent(in ) :: u !< AD Inputs at Time + type(RotInflowType), intent(in ) :: RotInflow !< Rotor inflow Inputs at Time type(RotMiscVarType), intent(inout) :: m !< Misc/optimization variables integer, intent(in ) :: indx !< index into m%BEMT_u(indx) array; 1=t and 2=t+dt (but not checked here) integer(IntKi), intent( out) :: ErrStat !< Error status of the operation @@ -2468,21 +2794,27 @@ subroutine SetInputs(p, p_AD, u, m, indx, errStat, errMsg) ErrMsg = "" ! Disturbed inflow on blade (if tower shadow present) - call SetDisturbedInflow(p, p_AD, u, m, errStat, errMsg) + call SetDisturbedInflow(p, p_AD, u, RotInflow, m, errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, RoutineName) + + if (p_AD%Wake_Mod /= WakeMod_FVW) then + + if (p_AD%SectAvg) then + call SetSectAvgInflow(t, p, p_AD, u, RotInflow, m, errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, RoutineName) + endif - if (p_AD%WakeMod /= WakeMod_FVW) then ! This needs to extract the inputs from the AD data types (mesh) and massage them for the BEMT module - call SetInputsForBEMT(p, u, m, indx, errStat2, errMsg2) + call SetInputsForBEMT(p, p_AD, u, RotInflow, m, indx, errStat2, errMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) endif end subroutine SetInputs !---------------------------------------------------------------------------------------------------------------------------------- !> Disturbed inflow on the blade if tower shadow or tower influence are enabled -subroutine SetDisturbedInflow(p, p_AD, u, m, errStat, errMsg) +subroutine SetDisturbedInflow(p, p_AD, u, RotInflow, m, errStat, errMsg) type(RotParameterType), intent(in ) :: p !< AD parameters type(AD_ParameterType), intent(in ) :: p_AD !< AD parameters type(RotInputType), intent(in ) :: u !< AD Inputs at Time + type(RotInflowType), intent(in ) :: RotInflow !< Rotor inflow at Time type(RotMiscVarType), 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 @@ -2495,13 +2827,15 @@ subroutine SetDisturbedInflow(p, p_AD, u, m, errStat, errMsg) errStat = ErrID_None errMsg = "" if (p%TwrPotent /= TwrPotent_none .or. p%TwrShadow /= TwrShadow_none) then - call TwrInfl( p, u, m, errStat2, errMsg2 ) ! NOTE: tower clearance is computed here.. + call TwrInfl( p, u, RotInflow, m, errStat2, errMsg2 ) ! NOTE: tower clearance is computed here.. call SetErrStat(errStat2, errMsg2, errStat, errMsg, RoutineName) else - m%DisturbedInflow = u%InflowOnBlade + do k = 1, p%NumBlades + m%DisturbedInflow(:,:,k) = RotInflow%Blade(k)%InflowVel + end do end if - if (p_AD%SkewMod == SkewMod_Orthogonal) then + if (p_AD%Skew_Mod == Skew_Mod_Orthogonal) then x_hat_disk = u%HubMotion%Orientation(1,:,1) do k=1,p%NumBlades @@ -2513,22 +2847,153 @@ subroutine SetDisturbedInflow(p, p_AD, u, m, errStat, errMsg) end subroutine SetDisturbedInflow - -!---------------------------------------------------------------------------------------------------------------------------------- -!> This subroutine sets m%BEMT_u(indx). -subroutine SetInputsForBEMT(p, u, m, indx, errStat, errMsg) - - type(RotParameterType), intent(in ) :: p !< AD parameters - type(RotInputType), intent(in ) :: u !< AD Inputs at Time - type(RotMiscVarType), intent(inout) :: m !< Misc/optimization variables +!> Sector Averaged (disturbed when tower influence on) inflow on the blade +!! Loop on blade nodes and computed a weighted sector average inflow at each node +subroutine SetSectAvgInflow(t, p, p_AD, u, RotInflow, m, errStat, errMsg) + real(DbKi), intent(in ) :: t !< Current simulation time in seconds + type(RotParameterType), intent(in ) :: p !< AD parameters + type(AD_ParameterType), intent(in ) :: p_AD !< AD parameters + type(RotInputType), intent(in ) :: u !< AD Inputs at Time + type(RotInflowType), intent(in ) :: RotInflow !< Rotor inflow at Time + type(RotMiscVarType), 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(R8Ki) :: R_li !< + real(ReKi) :: x_hat_disk(3) !< unit vector normal to disk along hub x axis + real(ReKi) :: r_A(3) !< Vector from global origin to blade node + real(ReKi) :: r_H(3) !< Vector from global origin to hub center + real(ReKi) :: r_S(3) !< Vector from global origin to point in sector + real(ReKi) :: rHS(3) !< Vector from rotor center to point in sector + real(ReKi) :: rHA(3) !< Vector from rotor center to blade node + real(ReKi) :: rHA_perp(3) !< Component of rHA perpendicular to x_hat_disk + real(ReKi) :: rHA_para(3) !< Component of rHA paralel to x_hat_disk + real(ReKi) :: rHA_perp_n !< Norm of rHA_perp + real(ReKi) :: e_r(3) !< Polar unit vector along rHA_perp + real(ReKi) :: e_t(3) !< Polar unit vector perpendicular to rHA_perp ("e_theta") + real(ReKi) :: temp_norm + real(ReKi) :: psi !< Azimuthal offset in the current sector, runs from -psi_bwd to psi_fwd + real(ReKi) :: dpsi !< Azimuthal increment + real(ReKi), allocatable :: SectPos(:,:)!< Points used to define a given sector (for a given blade node A) + real(ReKi), allocatable :: SectVel(:,:)!< Inflow velocity at a given sector (Undisturbed and then disturbed) + real(ReKi), allocatable :: SectAcc(:,:)!< Inflow velocity at a given sector (Undisturbed and then disturbed) + real(ReKi), allocatable :: SectWgt(:) !< Sector weights for velocity averaging + integer(intKi) :: j,k, ipsi + integer(intKi) :: errStat2 + character(ErrMsgLen) :: errMsg2 + character(*), parameter :: RoutineName = 'SetSectAvgInflow' + ! + errStat = ErrID_None + errMsg = "" + + if (.not. associated(p_AD%FlowField)) then + errStat2 = errID_Fatal + errMsg2 = 'FlowField should be allocated' + if (Failed()) return + endif + + ! Alloc and inits + call AllocAry(SectPos, 3, p_AD%SA_nPerSec, "SectPos", errStat2, errMsg2); if(Failed()) return + call AllocAry(SectVel, 3, p_AD%SA_nPerSec, "SectVel", errStat2, errMsg2); if(Failed()) return + call AllocAry(SectWgt, p_AD%SA_nPerSec, "SectWgt", errStat2, errMsg2); if(Failed()) return + if (allocated(SectAcc)) deallocate(SectAcc) ! IfW_FlowField_GetVelAcc some logic for Acc, so we ensure it's deallocated + SectVel = 0.0_ReKi + SectPos = 0.0_ReKi + if (p_AD%SA_Weighting == SA_Wgt_Uniform) then + SectWgt = 1.0_ReKi/p_AD%SA_nPerSec + else + errStat2 = errID_Fatal; errMsg2 = 'Sector averaging weighting (`SA_Weighting`) should be Uniform' + if (Failed()) return + endif + dpsi = (p_AD%SA_PsiFwd-p_AD%SA_PsiBwd)/(p_AD%SA_nPerSec-1) + + ! Hub + x_hat_disk = real(u%HubMotion%Orientation(1,:,1), ReKi) + r_H = u%HubMotion%Position(:,1) + u%HubMotion%TranslationDisp(:,1) + + ! --- Loop on blade nodes and computed a weighted sector average inflow at each node + do k=1,p%NumBlades + do j=1,p%NumBlNds + + ! --- Setup a polar coordinate system based on the current blade node + ! This is the same kind of calculations as the Calculate_MeshOrientation_Rel2Hub + r_A = u%BladeMotion(k)%Position(:,j) + u%BladeMotion(k)%TranslationDisp(:,j) + rHA = r_A - r_H + rHA_para = dot_product( x_hat_disk, rHA ) * x_hat_disk + rHA_perp = rHA - rHA_para + rHA_perp_n = TwoNorm( rHA_perp ) + + ! --- Create list of section points around the current blade node + if (EqualRealNos(rHA_perp_n, 0.0_ReKi)) then + ! We set all points to be the current one (likely the rotor center when no hub..) + do ipsi=1,p_AD%SA_nPerSec + SectPos(:, ipsi) = r_A + enddo + else + e_r = rHA_perp/rHA_perp_n ! Unit vector in "radial" coordinate + e_t = cross_product( x_hat_disk, e_r ) ! Unit vector in "tangential" coordinate + do ipsi=1,p_AD%SA_nPerSec + psi = p_AD%SA_PsiBwd + (ipsi-1)*dpsi + SectPos(:, ipsi) = (rHA_perp_n*cos(psi) * e_r + rHA_perp_n*sin(psi) * e_t) + rHA_para + r_H + enddo + endif + + ! --- Inflow on sector points + ! Undisturbed + call IfW_FlowField_GetVelAcc(p_AD%FlowField, 1, t, SectPos, SectVel, SectAcc, errStat=errStat2, errMsg=errMsg2); if(Failed()) return + ! --- Option 1 Disturbed inflow Before averaging - SectVel is modified in place + !if (p%TwrPotent /= TwrPotent_none .or. p%TwrShadow /= TwrShadow_none) then + ! call TwrInflArray(p, u, RotInflow, m, SectPos, SectVel, errStat2, errMsg2); if(Failed()) return + !endif + + ! --- Weighting and averaging + m%SectAvgInflow(1, j, k) = sum(SectVel(1,:)*SectWgt) + m%SectAvgInflow(2, j, k) = sum(SectVel(2,:)*SectWgt) + m%SectAvgInflow(3, j, k) = sum(SectVel(3,:)*SectWgt) + + ! --- Option 2 Disturbed after averaging + if (p%TwrPotent /= TwrPotent_none .or. p%TwrShadow /= TwrShadow_none) then + ! TODO use a "scalar" function or change the interface of TwrInfl. Waiting for Wind Inputs of AD to be removed from AD + call TwrInflArray( p, u, RotInflow, m, reshape(r_A, (/3,1/)), m%SectAvgInflow(:, j:j, k), errStat2, errMsg2); if(Failed()) return + endif + enddo + + enddo + + call CleanUp() +contains + subroutine CleanUp() + if(allocated(SectPos)) deallocate(SectPos) + if(allocated(SectVel)) deallocate(SectVel) + if(allocated(SectAcc)) deallocate(SectAcc) + if(allocated(SectWgt)) deallocate(SectWgt) + end subroutine + logical function Failed() + call SetErrStat(errStat2, errMsg2, errStat, errMsg, RoutineName) + Failed = errStat >= AbortErrLev + if (Failed) call CleanUp() + end function Failed +end subroutine SetSectAvgInflow + + + +!---------------------------------------------------------------------------------------------------------------------------------- +!> This subroutine sets m%BEMT_u(indx). +subroutine SetInputsForBEMT(p, p_AD, u, RotInflow, m, indx, errStat, errMsg) + + type(RotParameterType), intent(in ) :: p !< AD parameters + type(AD_ParameterType), intent(in ) :: p_AD !< AD parameters + type(RotInputType), intent(in ) :: u !< AD Inputs at Time + type(RotInflowType), intent(in ) :: RotInflow !< Rotor inflow at Time + type(RotMiscVarType), intent(inout) :: m !< Misc/optimization variables integer, intent(in ) :: indx !< index into m%BEMT_u array; must be 1 or 2 (but not checked here) integer(IntKi), intent( out) :: ErrStat !< Error status of the operation character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None ! local variables - real(R8Ki) :: x_hat(3) - real(R8Ki) :: y_hat(3) - real(R8Ki) :: z_hat(3) + !real(R8Ki) :: x_hat(3) + !real(R8Ki) :: y_hat(3) + !real(R8Ki) :: z_hat(3) real(R8Ki) :: x_hat_disk(3) real(R8Ki) :: y_hat_disk(3) real(R8Ki) :: z_hat_disk(3) @@ -2559,7 +3024,7 @@ subroutine SetInputsForBEMT(p, u, m, indx, errStat, errMsg) ErrMsg = "" ! Get disk average values and orientations - call DiskAvgValues(p, u, m, x_hat_disk, y_hat_disk, z_hat_disk, Azimuth) ! also sets m%V_diskAvg, m%V_dot_x + call DiskAvgValues(p, u, RotInflow, m, x_hat_disk, y_hat_disk, z_hat_disk, Azimuth) ! also sets m%V_diskAvg, m%V_dot_x ! Velocity in disk normal m%BEMT_u(indx)%V0 = m%AvgDiskVelDist ! Note: used for SkewWake Cont @@ -2580,7 +3045,7 @@ subroutine SetInputsForBEMT(p, u, m, indx, errStat, errMsg) else x_hat_wind = m%V_diskAvg/denom end if - ! Yaw + ! Yaw tmpD = x_hat_disk tmpD(3) = 0.0 tmpW = x_hat_wind @@ -2590,7 +3055,7 @@ subroutine SetInputsForBEMT(p, u, m, indx, errStat, errMsg) yaw = 0.0_ReKi else yaw = acos(max(-1.0_ReKi,min(1.0_ReKi,dot_product(tmpD,tmpW)/denom))) - end if + end if tmp_skewVec = cross_product(tmpW,tmpD); yaw = sign(yaw,tmp_skewVec(3)) m%Yaw = yaw @@ -2634,7 +3099,7 @@ subroutine SetInputsForBEMT(p, u, m, indx, errStat, errMsg) signofAngle = sign(1.0_ReKi,SkewVec(3)) endif - if (p%AeroBEM_Mod /= BEMMod_2D) then + if (p%BEM_Mod /= BEMMod_2D) then ! TODO m%BEMT_u(indx)%chi0 = sign( m%BEMT_u(indx)%chi0, signOfAngle ) endif end if @@ -2689,18 +3154,20 @@ subroutine SetInputsForBEMT(p, u, m, indx, errStat, errMsg) if (ErrStat >= AbortErrLev) return !.......................... - ! Set main geometry parameters (orientatioAnnulus, Curve, rLocal) + ! Set main geometry parameters (orientatioAnnulus, Twist, Toe, Cant, rLocal) !.......................... + ! TODO (EB): For harmonization between BEM and OLAF we should always compute R_li, r_Local, Twist, Toe, Cant, drdz + ! BEM would then switch below between an "orientationMomentum", either Annulus (R_li) or NoPitchSweepPitch (R_wi) if (p%AeroProjMod==APM_BEM_NoSweepPitchTwist .or. p%AeroProjMod==APM_LiftingLine) then ! orientationAnnulus and curve if (p%AeroProjMod==APM_BEM_NoSweepPitchTwist) then - call Calculate_MeshOrientation_NoSweepPitchTwist(p, u, m, ErrStat=ErrStat, ErrMsg=ErrMsg, thetaBladeNds=thetaBladeNds) + call Calculate_MeshOrientation_NoSweepPitchTwist(p, u, m, thetaBladeNds, m%Toe, m%Cant, ErrStat=ErrStat, ErrMsg=ErrMsg) else - call Calculate_MeshOrientation_LiftingLine(p, u, m, ErrStat=ErrStat, ErrMsg=ErrMsg, thetaBladeNds=thetaBladeNds) + call Calculate_MeshOrientation_LiftingLine(p, u, m, thetaBladeNds, m%Toe, m%Cant, ErrStat=ErrStat, ErrMsg=ErrMsg) endif - ! local radius (normalized distance from rotor centerline) + ! local radius (normalized distance from rotor centerline) NOTE: unfortunate calculation, see comment above for harmonization do k=1,p%NumBlades call Calculate_MeshOrientation_Rel2Hub(u%BladeMotion(k), u%HubMotion, x_hat_disk, elemPosRelToHub_save=elemPosRelToHub, elemPosRotorProj_save=elemPosRotorProj) do j=1,p%NumBlNds @@ -2713,6 +3180,8 @@ subroutine SetInputsForBEMT(p, u, m, indx, errStat, errMsg) ! Determine current azimuth angle and pitch axis vector of blade k, element j call Calculate_MeshOrientation_Rel2Hub(u%BladeMotion(k), u%HubMotion, x_hat_disk, m%orientationAnnulus(:,:,:,k), elemPosRelToHub_save=elemPosRelToHub, elemPosRotorProj_save=elemPosRotorProj) + ! Twist (aero+elastic), Toe, Cant (instantaneous and local), include elastic deformation + call TwistToeCant_FromLocalPolar(u%BladeMotion(k), m%orientationAnnulus(:,:,:,k), thetaBladeNds(:,k), m%Toe(:,k), m%Cant(:,k)) !.......................... ! Compute local radius @@ -2746,10 +3215,10 @@ subroutine SetInputsForBEMT(p, u, m, indx, errStat, errMsg) !.......................... - ! local blade angles + ! local blade angles passed to BEM !.......................... if (p%AeroProjMod==APM_BEM_NoSweepPitchTwist .or. p%AeroProjMod==APM_LiftingLine) then - ! Theta + ! Local and instantaneous blade twist+pitch (aerodynamic + elastic), cant and toe (include elastic deformation) do k=1,p%NumBlades do j=1,p%NumBlNds m%BEMT_u(indx)%theta(j,k) = thetaBladeNds(j,k) ! local pitch + twist (aerodyanmic + elastic) angle of the jth node in the kth blade @@ -2762,16 +3231,9 @@ subroutine SetInputsForBEMT(p, u, m, indx, errStat, errMsg) elseif (p%AeroProjMod==APM_BEM_Polar) then do k=1,p%NumBlades do j=1,p%NumBlNds - ! Get local blade cant angle and twist - orientation = matmul( u%BladeMotion(k)%Orientation(:,:,j), transpose( m%orientationAnnulus(:,:,j,k) ) ) - theta = EulerExtract( orientation ) - ! Get toe angle - m%BEMT_u(indx)%toeAngle(j,k) = theta(1) - ! cant angle (including aeroelastic deformation) - m%BEMT_u(indx)%cantAngle(j,k) = theta(2) - m%Curve(j,k) = theta(2) - ! twist (including pitch and aeroelastic deformation) - m%BEMT_u(indx)%theta(j,k) = -theta(3) + m%BEMT_u(indx)%theta(j,k) = thetaBladeNds(j,k) + m%BEMT_u(indx)%toeAngle(j,k) = m%Toe(j,k) + m%BEMT_u(indx)%cantAngle(j,k) = m%Cant(j,k) end do !j=nodes end do !k=blades else @@ -2784,8 +3246,12 @@ subroutine SetInputsForBEMT(p, u, m, indx, errStat, errMsg) !.......................... do k=1,p%NumBlades do j=1,p%NumBlNds + if (p_AD%SectAvg) then + tmp = m%SectAvgInflow(:,j,k) - u%BladeMotion(k)%TranslationVel(:,j) ! rel_V(j)_Blade(k) + else + tmp = m%DisturbedInflow(:,j,k) - u%BladeMotion(k)%TranslationVel(:,j) ! rel_V(j)_Blade(k) + endif ! Velocity in "p" or "w" system (depending) on AeroProjMod - tmp = m%DisturbedInflow(:,j,k) - u%BladeMotion(k)%TranslationVel(:,j) ! rel_V(j)_Blade(k) m%BEMT_u(indx)%Vx(j,k) = dot_product( tmp, m%orientationAnnulus(1,:,j,k) ) ! normal component (normal to the plane, not chord) of the inflow velocity of the jth node in the kth blade m%BEMT_u(indx)%Vy(j,k) = dot_product( tmp, m%orientationAnnulus(2,:,j,k) ) !+ TwoNorm(m%DisturbedInflow(:,j,k))*(sin()*sin(tilt)*)! tangential component (tangential to the plane, not chord) of the inflow velocity of the jth node in the kth blade m%BEMT_u(indx)%Vz(j,k) = dot_product( tmp, m%orientationAnnulus(3,:,j,k) ) ! radial component (tangential to the plane, not chord) of the inflow velocity of the jth node in the kth blade @@ -2803,6 +3269,7 @@ subroutine SetInputsForBEMT(p, u, m, indx, errStat, errMsg) do k=1,p%NumBlades do j=1,p%NumBlNds ! inputs for CUA (and CDBEMT): + ! TODO Here we should take the rotation in the airfoil coordinate system instead of the "l" or "w" system m%BEMT_u(indx)%omega_z(j,k) = dot_product( u%BladeMotion(k)%RotationVel( :,j), m%orientationAnnulus(3,:,j,k) ) ! rotation of no-sweep-pitch coordinate system around z of the jth node in the kth blade end do !j=nodes @@ -2832,9 +3299,10 @@ subroutine SetInputsForBEMT(p, u, m, indx, errStat, errMsg) end subroutine SetInputsForBEMT !---------------------------------------------------------------------------------------------------------------------------------- -subroutine DiskAvgValues(p, u, m, x_hat_disk, y_hat_disk, z_hat_disk, Azimuth) +subroutine DiskAvgValues(p, u, RotInflow, m, x_hat_disk, y_hat_disk, z_hat_disk, Azimuth) type(RotParameterType), intent(in ) :: p !< AD parameters type(RotInputType), intent(in ) :: u !< AD Inputs at Time + type(RotInflowType), intent(in ) :: RotInflow !< Rotor Inflow at Time type(RotMiscVarType), intent(inout) :: m !< Misc/optimization variables real(R8Ki), intent( out) :: x_hat_disk(3) real(R8Ki), optional, intent( out) :: y_hat_disk(3) @@ -2850,12 +3318,14 @@ subroutine DiskAvgValues(p, u, m, x_hat_disk, y_hat_disk, z_hat_disk, Azimuth) ! calculate disk-averaged velocities m%AvgDiskVel = 0.0_ReKi m%AvgDiskVelDist = 0.0_ReKi ! TODO potentially get rid of that in the future + m%V_diskAvg = 0.0_ReKi + m%V_dot_x = 0.0_ReKi if (p%NumBlades <= 0) return ! The Intel compiler gets array bounds issues in this routine with no blades. do k=1,p%NumBlades do j=1,p%NumBlNds m%AvgDiskVelDist = m%AvgDiskVelDist + m%DisturbedInflow(:,j,k) - m%AvgDiskVel = m%AvgDiskVel + u%InflowOnBlade(:,j,k) + m%AvgDiskVel = m%AvgDiskVel + RotInflow%Blade(k)%InflowVel(:,j) end do end do m%AvgDiskVelDist = m%AvgDiskVelDist / real( p%NumBlades * p%NumBlNds, ReKi ) @@ -2941,6 +3411,27 @@ subroutine StorePitchAndAzimuth(p, u, m, ErrStat,ErrMsg) enddo endsubroutine StorePitchAndAzimuth +!---------------------------------------------------------------------------------------------------------------------------------- +!> Instantaneous and local Twist Toe Cant angles from local polar to section +!! Note: could also be placed in Calculate_MeshOrientation_Rel2Hub +subroutine TwistToeCant_FromLocalPolar(secMesh, R_li, twist, toe, cant) + type(MeshType), intent(in ) :: secMesh !< Blade section mesh "BladeMotion" + real(R8Ki), intent(in ) :: R_li(3,3,secMesh%NNodes) !< Orientation from inertial (i) to local polar (l), aka "orientationAnnulus" + real(R8Ki), intent(out ) :: twist(secMesh%NNodes) !< Twist + real(ReKi), intent(out ) :: toe (secMesh%NNodes) !< Toe + real(ReKi), intent(out ) :: cant (secMesh%NNodes) !< Cant + real(R8Ki) :: R_sl(3,3) !< Orientation from local polar to section + integer(intKi) :: j !< loop counter for nodes + real(R8Ki) :: thetas(3) !< Euler angles + do j = 1, secMesh%NNodes + R_sl = matmul( secMesh%Orientation(:,:,j), transpose( R_li(:,:,j) ) ) ! From local polar to section - R_sec_i R_i_annulus + thetas = EulerExtract( R_sl ) + toe(j) = real( thetas(1), ReKi) ! toe angle + cant(j) = real( thetas(2), ReKi) ! cant angle (including aeroelastic deformation) + twist(j) = -thetas(3) ! twist (including pitch and aeroelastic deformation) + end do +end subroutine TwistToeCant_FromLocalPolar + !---------------------------------------------------------------------------------------------------------------------------------- subroutine Calculate_MeshOrientation_Rel2Hub(Mesh1, HubMotion, x_hat_disk, orientationAnnulus, elemPosRelToHub_save, elemPosRotorProj_save) TYPE(MeshType), intent(in) :: Mesh1 !< either BladeMotion or BladeRootMotion mesh @@ -2990,25 +3481,16 @@ subroutine Calculate_MeshOrientation_Rel2Hub(Mesh1, HubMotion, x_hat_disk, orien if (present(elemPosRotorProj_save)) elemPosRotorProj_save(:,j) = elemPosRotorProj end do - ! orientation = matmul( Mesh1(k)%Orientation(:,:,j), transpose( orientationAnnulus(:,:,j) ) ) - ! theta = EulerExtract( orientation ) - ! ! Get toe angle - ! toeAngle(j) = theta(1) - ! ! cant angle (including aeroelastic deformation) - ! cantAngle(j) = theta(2) - ! Curve(j) = theta(2) - ! ! twist (including pitch and aeroelastic deformation) - ! thetaNds(j) = -theta(3) - end subroutine Calculate_MeshOrientation_Rel2Hub !---------------------------------------------------------------------------------------------------------------------------------- ! Calculate_MeshOrientation_NoSweepPitchTwist sets orientationAnnulus, Curve and potential Blades nodes angles -subroutine Calculate_MeshOrientation_NoSweepPitchTwist(p, u, m, thetaBladeNds, toeBladeNds, ErrStat, ErrMsg) +subroutine Calculate_MeshOrientation_NoSweepPitchTwist(p, u, m, twist, toe, cant, ErrStat, ErrMsg) type(RotParameterType), intent(in ) :: p !< AD parameters type(RotInputType), intent(in ) :: u !< AD Inputs at Time type(RotMiscVarType), intent(inout) :: m !< Misc/optimization variables - real(R8Ki), optional, intent( out) :: thetaBladeNds(p%NumBlNds,p%NumBlades) - real(R8Ki), optional, intent( out) :: toeBladeNds(p%NumBlNds,p%NumBlades) + real(R8Ki), optional, intent( out) :: twist(p%NumBlNds,p%NumBlades) + real(ReKi), optional, intent( out) :: toe(p%NumBlNds,p%NumBlades) + real(ReKi), optional, intent( out) :: cant(p%NumBlNds,p%NumBlades) integer(IntKi), intent( out) :: ErrStat !< Error status of the operation character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None real(R8Ki) :: theta(3) @@ -3046,9 +3528,9 @@ subroutine Calculate_MeshOrientation_NoSweepPitchTwist(p, u, m, thetaBladeNds, t call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) theta = EulerExtract( orientation ) !root(k)WithoutPitch_theta(j)_blade(k) - m%Curve( j,k) = theta(2) ! save value for possible output later - if (present(thetaBladeNds)) thetaBladeNds(j,k) = -theta(3) ! local pitch + twist (aerodyanmic + elastic) angle of the jth node in the kth blade - if (present(toeBladeNds )) toeBladeNds( j,k) = theta(1) + if (present(cant)) cant (j,k) = theta(2) ! save value for possible output later + if (present(twist)) twist(j,k) = -theta(3) ! local pitch + twist (aerodyanmic + elastic) angle of the jth node in the kth blade + if (present(toe )) toe( j,k) = theta(1) theta(1) = 0.0_ReKi theta(3) = 0.0_ReKi @@ -3058,15 +3540,16 @@ subroutine Calculate_MeshOrientation_NoSweepPitchTwist(p, u, m, thetaBladeNds, t end do !k=blades end subroutine Calculate_MeshOrientation_NoSweepPitchTwist !---------------------------------------------------------------------------------------------------------------------------------- -subroutine Calculate_MeshOrientation_LiftingLine(p, u, m, thetaBladeNds, toeBladeNds, ErrStat, ErrMsg) +subroutine Calculate_MeshOrientation_LiftingLine(p, u, m, twist, toe, cant, ErrStat, ErrMsg) type(RotParameterType), intent(in ) :: p !< AD parameters type(RotInputType), intent(in ) :: u !< AD Inputs at Time type(RotMiscVarType), intent(inout) :: m !< Misc/optimization variables - real(R8Ki), optional, intent( out) :: thetaBladeNds(p%NumBlNds,p%NumBlades) - real(R8Ki), optional, intent( out) :: toeBladeNds(p%NumBlNds,p%NumBlades) + real(R8Ki), intent( out) :: twist(p%NumBlNds,p%NumBlades) + real(ReKi), intent( out) :: toe(p%NumBlNds,p%NumBlades) + real(ReKi), intent( out) :: cant(p%NumBlNds,p%NumBlades) integer(IntKi), intent( out) :: ErrStat !< Error status of the operation character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None - real(R8Ki) :: theta(3) + real(R8Ki) :: thetas(3) real(R8Ki) :: orientation(3,3) integer(intKi) :: j ! loop counter for nodes integer(intKi) :: k ! loop counter for blades @@ -3083,10 +3566,10 @@ subroutine Calculate_MeshOrientation_LiftingLine(p, u, m, thetaBladeNds, toeBlad do j=1,p%NumBlNds orientation = matmul( u%BladeMotion(k)%Orientation(:,:,j), transpose( m%orientationAnnulus(:,:,j,k) ) ) - theta = EulerExtract( orientation ) - m%Curve( j,k) = theta(2) ! TODO - if (present(thetaBladeNds)) thetaBladeNds(j,k) = -theta(3) - if (present(toeBladeNds )) toeBladeNds( j,k) = theta(1) + thetas = EulerExtract( orientation ) + twist(j,k) = -thetas(3) + toe( j,k) = thetas(1) + cant( j,k) = thetas(2) enddo end do !k=blades @@ -3110,81 +3593,95 @@ subroutine SetInputsForFVW(p, u, tIndx, m, errStat, errMsg) integer(intKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SetInputsForFVW' - integer :: iW + integer :: iW ErrStat = ErrID_None ErrMsg = "" - do iR =1, size(p%rotors) - allocate(thetaBladeNds(p%rotors(iR)%NumBlNds, p%rotors(iR)%NumBlades)) - ! Get disk average values and orientations - ! NOTE: needed because it sets m%V_diskAvg and m%V_dot_x, needed by CalcOutput.. - call DiskAvgValues(p%rotors(iR), u%rotors(iR), m%rotors(iR), x_hat_disk) ! also sets m%V_diskAvg and m%V_dot_x - if (p%rotors(iR)%AeroProjMod==APM_BEM_NoSweepPitchTwist) then - call Calculate_MeshOrientation_NoSweepPitchTwist(p%rotors(iR),u%rotors(iR), m%rotors(iR), thetaBladeNds,ErrStat=ErrStat2,ErrMsg=ErrMsg2) ! sets m%orientationAnnulus, m%Curve - else if (p%rotors(iR)%AeroProjMod==APM_LiftingLine) then - call Calculate_MeshOrientation_LiftingLine (p%rotors(iR),u%rotors(iR), m%rotors(iR), thetaBladeNds,ErrStat=ErrStat2,ErrMsg=ErrMsg2) ! sets m%orientationAnnulus, m%Curve - endif - call StorePitchAndAzimuth(p%rotors(iR), u%rotors(iR), m%rotors(iR), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat >= AbortErrLev) return + do iR =1, size(p%rotors) + allocate(thetaBladeNds(p%rotors(iR)%NumBlNds, p%rotors(iR)%NumBlades)) + ! Get disk average values and orientations + ! NOTE: needed because it sets m%V_diskAvg and m%V_dot_x, needed by CalcOutput.. + call DiskAvgValues(p%rotors(iR), u%rotors(iR), m%Inflow(tIndx)%RotInflow(iR), m%rotors(iR), x_hat_disk) ! also sets m%V_diskAvg and m%V_dot_x + + ! Compute Orientation similar to BEM, only to have consistent outputs... + ! TODO TODO TODO All this below is mostly a calcOutput thing, we should move it somewhere else! + ! orientation annulus is only used for Outputs with OLAF, same for pitch and azimuth + if (p%rotors(iR)%AeroProjMod==APM_BEM_NoSweepPitchTwist) then + call Calculate_MeshOrientation_NoSweepPitchTwist(p%rotors(iR), u%rotors(iR), m%rotors(iR), thetaBladeNds, m%rotors(iR)%Toe, m%rotors(iR)%Cant, ErrStat=ErrStat2,ErrMsg=ErrMsg2) ! sets m%orientationAnnulus, m%Curve + + elseif (p%rotors(iR)%AeroProjMod==APM_BEM_Polar) then + do k=1,p%rotors(iR)%numBlades + call Calculate_MeshOrientation_Rel2Hub(u%rotors(iR)%BladeMotion(k), u%rotors(iR)%HubMotion, x_hat_disk, m%rotors(iR)%orientationAnnulus(:,:,:,k)) + call TwistToeCant_FromLocalPolar(u%rotors(iR)%BladeMotion(k), m%rotors(iR)%orientationAnnulus(:,:,:,k), thetaBladeNds(:,k), m%rotors(iR)%Toe(:,k), m%rotors(iR)%Cant(:,k)) + enddo + + else if (p%rotors(iR)%AeroProjMod==APM_LiftingLine) then + call Calculate_MeshOrientation_LiftingLine (p%rotors(iR),u%rotors(iR), m%rotors(iR), thetaBladeNds, m%rotors(iR)%Toe, m%rotors(iR)%Cant, ErrStat=ErrStat2,ErrMsg=ErrMsg2) ! sets m%orientationAnnulus, m%Curve + else + call SetErrStat(ErrID_Fatal, 'Aero Projection Method not implemented' ,ErrStat, ErrMsg, RoutineName) + endif + call StorePitchAndAzimuth(p%rotors(iR), u%rotors(iR), m%rotors(iR), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (ErrStat >= AbortErrLev) return - ! Rather than use a meshcopy, we will just copy what we need to the WingsMesh - ! NOTE: MeshCopy requires the source mesh to be INOUT intent - ! NOTE2: If we change the WingsMesh to not be identical to the BladeMotion mesh, add the mapping stuff here. - do k=1,p%rotors(iR)%NumBlades - iW=p%FVW%Bld2Wings(iR,k) + ! Rather than use a meshcopy, we will just copy what we need to the WingsMesh + ! NOTE: MeshCopy requires the source mesh to be INOUT intent + ! NOTE2: If we change the WingsMesh to not be identical to the BladeMotion mesh, add the mapping stuff here. + do k=1,p%rotors(iR)%NumBlades + iW=p%FVW%Bld2Wings(iR,k) - if ( u%rotors(iR)%BladeMotion(k)%nNodes /= m%FVW_u(tIndx)%WingsMesh(iW)%nNodes ) then - call SetErrStat(ErrID_Fatal,"WingsMesh contains different number of nodes than the BladeMotion mesh",ErrStat,ErrMsg,RoutineName) - return - endif - m%FVW%W(iW)%PitchAndTwist(:) = thetaBladeNds(:,k) ! local pitch + twist (aerodyanmic + elastic) angle of the jth node in the kth blade - m%FVW_u(tIndx)%WingsMesh(iW)%TranslationDisp = u%rotors(iR)%BladeMotion(k)%TranslationDisp - m%FVW_u(tIndx)%WingsMesh(iW)%Orientation = u%rotors(iR)%BladeMotion(k)%Orientation - m%FVW_u(tIndx)%WingsMesh(iW)%TranslationVel = u%rotors(iR)%BladeMotion(k)%TranslationVel - m%FVW_u(tIndx)%rotors(iR)%HubPosition = u%rotors(iR)%HubMotion%Position(:,1) + u%rotors(iR)%HubMotion%TranslationDisp(:,1) - m%FVW_u(tIndx)%rotors(iR)%HubOrientation = u%rotors(iR)%HubMotion%Orientation(:,:,1) + if ( u%rotors(iR)%BladeMotion(k)%nNodes /= m%FVW_u(tIndx)%WingsMesh(iW)%nNodes ) then + call SetErrStat(ErrID_Fatal,"WingsMesh contains different number of nodes than the BladeMotion mesh",ErrStat,ErrMsg,RoutineName) + return + endif + m%FVW%W(iW)%PitchAndTwist(:) = thetaBladeNds(:,k) ! local pitch + twist (aerodyanmic + elastic) angle of the jth node in the kth blade + m%FVW_u(tIndx)%WingsMesh(iW)%TranslationDisp = u%rotors(iR)%BladeMotion(k)%TranslationDisp + m%FVW_u(tIndx)%WingsMesh(iW)%Orientation = u%rotors(iR)%BladeMotion(k)%Orientation + m%FVW_u(tIndx)%WingsMesh(iW)%TranslationVel = u%rotors(iR)%BladeMotion(k)%TranslationVel + m%FVW_u(tIndx)%rotors(iR)%HubPosition = u%rotors(iR)%HubMotion%Position(:,1) + u%rotors(iR)%HubMotion%TranslationDisp(:,1) + m%FVW_u(tIndx)%rotors(iR)%HubOrientation = u%rotors(iR)%HubMotion%Orientation(:,:,1) - ! Inputs for dynamic stall (see SetInputsForBEMT) - do j=1,p%rotors(iR)%NumBlNds - ! inputs for CUA, section pitch/torsion rate - m%FVW_u(tIndx)%W(iW)%omega_z(j) = dot_product( u%rotors(iR)%BladeMotion(k)%RotationVel( :,j), m%rotors(iR)%orientationAnnulus(3,:,j,k) ) ! rotation of no-sweep-pitch coordinate system around z of the jth node in the kth blade - end do !j=nodes - enddo ! k blades - if (allocated(thetaBladeNds)) deallocate(thetaBladeNds) - enddo ! iR, rotors + ! Inputs for dynamic stall (see SetInputsForBEMT) + do j=1,p%rotors(iR)%NumBlNds + ! inputs for CUA, section pitch/torsion rate + m%FVW_u(tIndx)%W(iW)%omega_z(j) = dot_product( u%rotors(iR)%BladeMotion(k)%RotationVel( :,j), m%rotors(iR)%orientationAnnulus(3,:,j,k) ) ! rotation of no-sweep-pitch coordinate system around z of the jth node in the kth blade + end do !j=nodes + enddo ! k blades + if (allocated(thetaBladeNds)) deallocate(thetaBladeNds) + enddo ! iR, rotors - if (ALLOCATED(m%FVW_u(tIndx)%V_wind)) then - m%FVW_u(tIndx)%V_wind = u%InflowWakeVel - ! Applying tower shadow to V_wind based on r_wind positions - ! NOTE: m%DisturbedInflow also contains tower shadow and we need it for CalcOutput - if (p%FVW%TwrShadowOnWake) then - do iR =1, size(p%rotors) - if (p%rotors(iR)%TwrPotent /= TwrPotent_none .or. p%rotors(iR)%TwrShadow /= TwrShadow_none) then - call TwrInflArray( p%rotors(iR), u%rotors(iR), m%rotors(iR), m%FVW%r_wind, m%FVW_u(tIndx)%V_wind, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat >= AbortErrLev) return - endif - enddo - end if - endif - do iR =1, size(p%rotors) - ! Disturbed inflow for UA on Lifting line Mesh Points - call SetDisturbedInflow(p%rotors(iR), p, u%rotors(iR), m%rotors(iR), errStat2, errMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - do k=1,p%rotors(iR)%NumBlades - iW=p%FVW%Bld2Wings(iR,k) - m%FVW_u(tIndx)%W(iW)%Vwnd_LL(1:3,:) = m%rotors(iR)%DisturbedInflow(1:3,:,k) + if (ALLOCATED(m%FVW_u(tIndx)%V_wind)) then + m%FVW_u(tIndx)%V_wind = m%Inflow(tIndx)%InflowWakeVel + ! Applying tower shadow to V_wind based on r_wind positions + ! NOTE: m%DisturbedInflow also contains tower shadow and we need it for CalcOutput + if (p%FVW%TwrShadowOnWake) then + do iR =1, size(p%rotors) + if (p%rotors(iR)%TwrPotent /= TwrPotent_none .or. p%rotors(iR)%TwrShadow /= TwrShadow_none) then + call TwrInflArray( p%rotors(iR), u%rotors(iR), m%Inflow(tIndx)%RotInflow(iR), m%rotors(iR), m%FVW%r_wind, m%FVW_u(tIndx)%V_wind, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (ErrStat >= AbortErrLev) return + endif enddo + end if + endif + do iR =1, size(p%rotors) + ! Disturbed inflow for UA on Lifting line Mesh Points + call SetDisturbedInflow(p%rotors(iR), p, u%rotors(iR), m%Inflow(tIndx)%RotInflow(iR), m%rotors(iR), errStat2, errMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + do k=1,p%rotors(iR)%NumBlades + iW=p%FVW%Bld2Wings(iR,k) + m%FVW_u(tIndx)%W(iW)%Vwnd_LL(1:3,:) = m%rotors(iR)%DisturbedInflow(1:3,:,k) enddo + enddo end subroutine SetInputsForFVW !---------------------------------------------------------------------------------------------------------------------------------- !> This subroutine sets m%AA_u. -subroutine SetInputsForAA(p, u, m, errStat, errMsg) +subroutine SetInputsForAA(p, u, RotInflow, m, errStat, errMsg) type(RotParameterType), intent(in ) :: p !< AD parameters type(RotInputType), intent(in ) :: u !< AD Inputs at Time + type(RotInflowType), intent(in ) :: RotInflow !< AD inflow at Time type(RotMiscVarType), 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 @@ -3210,9 +3707,7 @@ subroutine SetInputsForAA(p, u, m, errStat, errMsg) m%AA_u%AoANoise(i,j) = m%BEMT_y%AOA(i,j) ! Set the blade element undisturbed flow - m%AA_u%Inflow(1,i,j) = u%InflowonBlade(1,i,j) - m%AA_u%Inflow(2,i,j) = u%InflowonBlade(2,i,j) - m%AA_u%Inflow(3,i,j) = u%InflowonBlade(3,i,j) + m%AA_u%Inflow(:,i,j) = RotInflow%Blade(j)%InflowVel(:,i) end do end do end subroutine SetInputsForAA @@ -3233,7 +3728,7 @@ subroutine SetOutputsFromBEMT( p, u, m, y ) real(reki) :: c ! local chord length real(reki) :: aoa ! local angle of attack real(reki) :: Cl,Cd,Cm ! local airfoil lift, drag and pitching moment coefficients - real(reki) :: Cn,Ct ! local airfoil normal and tangential force coefficients + real(reki) :: Cxa,Cya ! local airfoil normal and tangential force coefficients do k=1,p%NumBlades @@ -3244,14 +3739,14 @@ subroutine SetOutputsFromBEMT( p, u, m, y ) Cl = m%BEMT_y%cl(j,k) Cd = m%BEMT_y%cd(j,k) Cm = m%BEMT_y%cm(j,k) - Cn = Cl*cos(aoa) + Cd*sin(aoa) - Ct = -Cl*sin(aoa) + Cd*cos(aoa) ! NOTE: this is not Ct but Cy_a (y_a going towards the TE) + Cxa = Cl*cos(aoa) + Cd*sin(aoa) + Cya = -Cl*sin(aoa) + Cd*cos(aoa) ! Dimensionalize the aero forces and moment q = 0.5 * p%airDens * m%BEMT_y%Vrel(j,k)**2 ! dynamic pressure of the jth node in the kth blade c = p%BEMT%chord(j,k) - forceAirfoil(1) = Cn * q * c - forceAirfoil(2) = Ct * q * c + forceAirfoil(1) = Cxa * q * c + forceAirfoil(2) = Cya * q * c forceAirfoil(3) = 0.0_reki momentAirfoil(1) = 0.0_reki momentAirfoil(2) = 0.0_reki @@ -3285,10 +3780,10 @@ subroutine SetOutputsFromBEMT( p, u, m, y ) y%BladeLoad(k)%Moment(:,j) = matmul( moment, m%orientationAnnulus(:,:,j,k) ) ! moment per unit length of the jth node in the kth blade else - ! Transfer loads from the airfoil frame to the blade frame - y%BladeLoad(k)%Force(:,j) = matmul( forceAirfoil, u%BladeMotion(k)%Orientation(:,:,j) ) ! force per unit length of the jth node in the kth blade - y%BladeLoad(k)%Moment(:,j) = matmul( momentAirfoil, u%BladeMotion(k)%Orientation(:,:,j) ) ! moment per unit length of the jth node in the kth blade - endif + ! Transfer loads from the airfoil frame to the blade frame + y%BladeLoad(k)%Force(:,j) = matmul( forceAirfoil, u%BladeMotion(k)%Orientation(:,:,j) ) ! force per unit length of the jth node in the kth blade + y%BladeLoad(k)%Moment(:,j) = matmul( momentAirfoil, u%BladeMotion(k)%Orientation(:,:,j) ) ! moment per unit length of the jth node in the kth blade + endif end do !j=nodes end do !k=blades @@ -3450,7 +3945,7 @@ SUBROUTINE ValidateNumBlades( NumBl, ErrStat, ErrMsg ) END SUBROUTINE ValidateNumBlades !---------------------------------------------------------------------------------------------------------------------------------- !> This routine validates the inputs from the AeroDyn input files. -SUBROUTINE ValidateInputData( InitInp, InputFileData, NumBl, ErrStat, ErrMsg ) +SUBROUTINE ValidateInputData( InitInp, InputFileData, NumBl, calcCrvAngle, ErrStat, ErrMsg ) !.................................................................................................................................. ! Passed variables: @@ -3458,6 +3953,7 @@ SUBROUTINE ValidateInputData( InitInp, InputFileData, NumBl, ErrStat, ErrMsg ) type(AD_InitInputType), intent(in ) :: InitInp !< Input data for initialization routine type(AD_InputFile), intent(in) :: InputFileData !< All the data in the AeroDyn input file integer(IntKi), intent(in) :: NumBl(:) !< Number of blades: size(NumBl) = number of rotors + logical, intent(in) :: calcCrvAngle(:) integer(IntKi), intent(out) :: ErrStat !< Error status character(*), intent(out) :: ErrMsg !< Error message @@ -3466,14 +3962,15 @@ SUBROUTINE ValidateInputData( InitInp, InputFileData, NumBl, ErrStat, ErrMsg ) integer(IntKi) :: k ! Blade number integer(IntKi) :: j ! node number integer(IntKi) :: iR ! rotor index + integer(IntKi) :: iBld ! check on first blade character(*), parameter :: RoutineName = 'ValidateInputData' ErrStat = ErrID_None ErrMsg = "" ! do iR = 1,size(NumBl) -! if (NumBl(iR) < 1) then -! call SetErrStat( ErrID_Fatal, 'Number of blades must be at least 1.', ErrStat, ErrMsg, RoutineName ) +! if (NumBl(iR) < 0) then +! call SetErrStat( ErrID_Fatal, 'Number of blades must not be a negative number.', ErrStat, ErrMsg, RoutineName ) ! return ! return early because InputFileData%BladeProps may not be allocated properly otherwise... ! else ! if (NumBl(iR) > AD_MaxBl_Out .and. InitInp%Linearize) then @@ -3484,15 +3981,11 @@ SUBROUTINE ValidateInputData( InitInp, InputFileData, NumBl, ErrStat, ErrMsg ) ! end do if (InputFileData%DTAero <= 0.0) call SetErrStat ( ErrID_Fatal, 'DTAero must be greater than zero.', ErrStat, ErrMsg, RoutineName ) - if (InputFileData%WakeMod /= WakeMod_None .and. InputFileData%WakeMod /= WakeMod_BEMT .and. InputFileData%WakeMod /= WakeMod_DBEMT .and. InputFileData%WakeMod /= WakeMod_FVW) then - call SetErrStat ( ErrID_Fatal, 'WakeMod must be '//trim(num2lstr(WakeMod_None))//' (none), '//trim(num2lstr(WakeMod_BEMT))//' (BEMT), '// & - trim(num2lstr(WakeMod_DBEMT))//' (DBEMT), or '//trim(num2lstr(WakeMod_FVW))//' (FVW).',ErrStat, ErrMsg, RoutineName ) + if (InputFileData%Wake_Mod /= WakeMod_None .and. InputFileData%Wake_Mod /= WakeMod_BEMT .and. InputFileData%Wake_Mod /= WakeMod_FVW) then + call SetErrStat ( ErrID_Fatal, 'Wake_Mod must be '//trim(num2lstr(WakeMod_None))//' (none), '//trim(num2lstr(WakeMod_BEMT))//' (BEMT), '// & + ' or '//trim(num2lstr(WakeMod_FVW))//' (FVW).',ErrStat, ErrMsg, RoutineName ) end if - if (InputFileData%AFAeroMod /= AFAeroMod_Steady .and. InputFileData%AFAeroMod /= AFAeroMod_BL_unsteady) then - call SetErrStat ( ErrID_Fatal, 'AFAeroMod must be '//trim(num2lstr(AFAeroMod_Steady))//' (steady) or '//& - trim(num2lstr(AFAeroMod_BL_unsteady))//' (Beddoes-Leishman unsteady).', ErrStat, ErrMsg, RoutineName ) - end if if (InputFileData%TwrPotent /= TwrPotent_none .and. InputFileData%TwrPotent /= TwrPotent_baseline .and. InputFileData%TwrPotent /= TwrPotent_Bak) then call SetErrStat ( ErrID_Fatal, 'TwrPotent must be 0 (none), 1 (baseline potential flow), or 2 (potential flow with Bak correction).', ErrStat, ErrMsg, RoutineName ) end if @@ -3521,12 +4014,17 @@ SUBROUTINE ValidateInputData( InitInp, InputFileData, NumBl, ErrStat, ErrMsg ) if ( maxval(InputFileData%rotors(iR)%TwrTI) > 0.4 .and. maxval(InputFileData%rotors(iR)%TwrTI) < 1.0) call SetErrStat ( ErrID_Warn, 'The turbulence intensity for the Eames tower shadow model above 0.4 may return unphysical results. Interpret with caution.', ErrStat, ErrMsg, RoutineName ) enddo endif + + if (InputFileData%TwrAero /= TwrAero_none .and. InputFileData%TwrAero /= TwrAero_noVIV) then + call SetErrStat ( ErrID_Fatal, 'TwrAero must be 0 (none) or 1 (Tower aero on).', ErrStat, ErrMsg, RoutineName ) + end if + if (Failed()) return - if (InitInp%MHK == 0 .and. InputFileData%CavitCheck) call SetErrStat ( ErrID_Fatal, 'A cavitation check can only be performed for an MHK turbine.', ErrStat, ErrMsg, RoutineName ) - if (InitInp%MHK == 0 .and. InputFileData%Buoyancy) call SetErrStat ( ErrID_Fatal, 'Buoyancy can only be calculated for an MHK turbine.', ErrStat, ErrMsg, RoutineName ) - if (InitInp%MHK == 1 .and. InputFileData%CompAA .or. InitInp%MHK == 2 .and. InputFileData%CompAA) call SetErrStat ( ErrID_Fatal, 'The aeroacoustics module cannot be used with an MHK turbine.', ErrStat, ErrMsg, RoutineName ) + if (InitInp%MHK == MHK_None .and. InputFileData%CavitCheck) call SetErrStat ( ErrID_Fatal, 'A cavitation check can only be performed for an MHK turbine.', ErrStat, ErrMsg, RoutineName ) + if (InitInp%MHK == MHK_None .and. InputFileData%Buoyancy) call SetErrStat ( ErrID_Fatal, 'Buoyancy can only be calculated for an MHK turbine.', ErrStat, ErrMsg, RoutineName ) + if (InitInp%MHK /= MHK_None .and. InputFileData%CompAA ) call SetErrStat ( ErrID_Fatal, 'The aeroacoustics module cannot be used with an MHK turbine.', ErrStat, ErrMsg, RoutineName ) do iR = 1,size(NumBl) - if (InitInp%MHK == 1 .and. InputFileData%rotors(iR)%TFinAero .or. InitInp%MHK == 2 .and. InputFileData%rotors(iR)%TFinAero) call SetErrStat ( ErrID_Fatal, 'A tail fin cannot be modeled for an MHK turbine.', ErrStat, ErrMsg, RoutineName ) + if (InitInp%MHK /= MHK_None .and. InputFileData%rotors(iR)%TFinAero) call SetErrStat ( ErrID_Fatal, 'A tail fin cannot be modeled for an MHK turbine.', ErrStat, ErrMsg, RoutineName ) enddo if (InputFileData%AirDens <= 0.0) call SetErrStat ( ErrID_Fatal, 'The density of the working fluid must be greater than zero.', ErrStat, ErrMsg, RoutineName ) @@ -3537,21 +4035,34 @@ SUBROUTINE ValidateInputData( InitInp, InputFileData, NumBl, ErrStat, ErrMsg ) - ! BEMT/DBEMT inputs - ! bjj: these checks should probably go into BEMT where they are used... - if (InputFileData%WakeMod /= WakeMod_none .and. InputFileData%WakeMod /= WakeMod_FVW) then + ! NOTE: this check is done here because it is used for all kind of Wake Mod + if (.not.any(InputFileData%BEM_Mod == (/BEMMod_2D, BEMMod_3D/))) call Fatal('BEM_Mod must be 1 or 2.') + + ! --- BEMT/DBEMT inputs + ! bjj: these checks should probably go into BEMT where they are used... + if (InputFileData%Wake_Mod == WakeMod_BEMT) then if ( InputFileData%MaxIter < 1 ) call SetErrStat( ErrID_Fatal, 'MaxIter must be greater than 0.', ErrStat, ErrMsg, RoutineName ) if ( InputFileData%IndToler < 0.0 .or. EqualRealNos(InputFileData%IndToler, 0.0_ReKi) ) & call SetErrStat( ErrID_Fatal, 'IndToler must be greater than 0.', ErrStat, ErrMsg, RoutineName ) - if ( InputFileData%SkewMod /= SkewMod_Orthogonal .and. InputFileData%SkewMod /= SkewMod_Uncoupled .and. InputFileData%SkewMod /= SkewMod_PittPeters) & ! .and. InputFileData%SkewMod /= SkewMod_Coupled ) - call SetErrStat( ErrID_Fatal, 'SkewMod must be 1, or 2. Option 3 will be implemented in a future version.', ErrStat, ErrMsg, RoutineName ) + if (.not.any(InputFileData%Skew_Mod == (/Skew_Mod_Orthogonal, Skew_Mod_None, Skew_Mod_Active/))) call Fatal('Skew_Mod must be -1, 0, or 1.') + if (.not.any(InputFileData%SkewRedistr_Mod == (/SkewRedistrMod_None, SkewRedistrMod_PittPeters/))) call Fatal('SkewRedistr_Mod should be 0 or 1') + + if ( InputFileData%SectAvg) then + if (InputFileData%SA_Weighting /= SA_Wgt_Uniform) call Fatal('SectAvgWeighting should be Uniform (=1) for now.') + if (InputFileData%SA_nPerSec <= 1) call Fatal('SectAvgNPoints must be >=1') + if (InputFileData%SA_PsiBwd > 0) call Fatal('SectAvgPsiBwd must be negative') + if (InputFileData%SA_PsiFwd < 0) call Fatal('SectAvgPsiFwd must be positive') + if (InputFileData%SA_PsiFwd <= InputFileData%SA_PsiBwd ) call Fatal('SectAvgPsiFwd must be strictly higher than SA_PsiBwd') + endif + ! Good to return once in a while.. + if (Failed()) return end if !BEMT/DBEMT checks - if ( InputFileData%CavitCheck .and. InputFileData%AFAeroMod == AFAeroMod_BL_unsteady) then + if ( InputFileData%CavitCheck .and. InputFileData%UA_Init%UAMod >0) then call SetErrStat( ErrID_Fatal, 'Cannot use unsteady aerodynamics module with a cavitation check', ErrStat, ErrMsg, RoutineName ) end if @@ -3563,9 +4074,15 @@ SUBROUTINE ValidateInputData( InitInp, InputFileData, NumBl, ErrStat, ErrMsg ) ! ............................. ! check blade mesh data: ! ............................. - do iR = 1,size(NumBl) + iBld = 1 + do iR = 1,size(NumBl) ! number of rotors if (NumBl(iR)>0) then - if ( InputFileData%rotors(iR)%BladeProps(1)%NumBlNds < 2 ) call SetErrStat( ErrID_Fatal, 'There must be at least two nodes per blade.',ErrStat, ErrMsg, RoutineName ) + if (any(calcCrvAngle(iBld:iBld+NumBl(iR)-1))) then + if ( InputFileData%rotors(iR)%BladeProps(1)%NumBlNds < 3 ) call SetErrStat( ErrID_Fatal, 'There must be at least three nodes per blade to calculate BlCrvAng.',ErrStat, ErrMsg, RoutineName ) + else + if ( InputFileData%rotors(iR)%BladeProps(1)%NumBlNds < 2 ) call SetErrStat( ErrID_Fatal, 'There must be at least two nodes per blade.',ErrStat, ErrMsg, RoutineName ) + end if + iBld = iBld+NumBl(iR) ! Increment blade counter endif do k=2,NumBl(iR) if ( InputFileData%rotors(iR)%BladeProps(k)%NumBlNds /= InputFileData%rotors(iR)%BladeProps(k-1)%NumBlNds ) then @@ -3616,36 +4133,41 @@ SUBROUTINE ValidateInputData( InitInp, InputFileData, NumBl, ErrStat, ErrMsg ) end do ! k=blades end if end do ! iR rotor + if (Failed()) return ! ............................. ! check tower mesh data: - ! ............................. - do iR = 1,size(NumBl) - if (InputFileData%TwrPotent /= TwrPotent_none .or. InputFileData%TwrShadow /= TwrShadow_none .or. InputFileData%TwrAero .or. InputFileData%Buoyancy .and. InputFileData%rotors(iR)%NumTwrNds > 0 ) then + ! ............................. + if (InputFileData%TwrPotent /= TwrPotent_none .or. InputFileData%TwrShadow /= TwrShadow_none .or. InputFileData%TwrAero /= TwrAero_none .or. InputFileData%Buoyancy) then + do iR = 1,size(NumBl) + if (InputFileData%rotors(iR)%NumTwrNds <= 0) cycle !bjj: this could be removed since the loops here already take into account the number of tower nodes + + ! Check that the tower diameter is > 0. if (InputFileData%rotors(iR)%NumTwrNds < 2) call SetErrStat( ErrID_Fatal, 'There must be at least two nodes on the tower.',ErrStat, ErrMsg, RoutineName ) ! Check that the tower diameter is > 0. do j=1,InputFileData%rotors(iR)%NumTwrNds if ( InputFileData%rotors(iR)%TwrDiam(j) <= 0.0_ReKi ) then - call SetErrStat( ErrID_Fatal, 'The diameter for tower node '//trim(Num2LStr(j))//' must be greater than 0.' & - , ErrStat, ErrMsg, RoutineName ) + call SetErrStat( ErrID_Fatal, 'The diameter for tower node '//trim(Num2LStr(j))//' must be greater than 0.', ErrStat, ErrMsg, RoutineName ) end if end do ! j=nodes ! check that the elevation is increasing: - do j=2,InputFileData%rotors(iR)%NumTwrNds - if ( InitInp%MHK /= 2 ) then - if ( InputFileData%rotors(iR)%TwrElev(j) <= InputFileData%rotors(iR)%TwrElev(j-1) ) then - call SetErrStat( ErrID_Fatal, 'The tower nodes must be entered in increasing elevation.', ErrStat, ErrMsg, RoutineName ) - exit - end if - else if ( InitInp%MHK == 2 ) then + if ( InitInp%MHK == MHK_Floating ) then + do j=2,InputFileData%rotors(iR)%NumTwrNds if ( InputFileData%rotors(iR)%TwrElev(j) >= InputFileData%rotors(iR)%TwrElev(j-1) ) then call SetErrStat( ErrID_Fatal, 'The tower nodes must be entered in decreasing elevation for a floating MHK turbine.', ErrStat, ErrMsg, RoutineName ) exit end if - end if - end do ! j=nodes + end do ! j=nodes + else + do j=2,InputFileData%rotors(iR)%NumTwrNds + if ( InputFileData%rotors(iR)%TwrElev(j) <= InputFileData%rotors(iR)%TwrElev(j-1) ) then + call SetErrStat( ErrID_Fatal, 'The tower nodes must be entered in increasing elevation.', ErrStat, ErrMsg, RoutineName ) + exit + end if + end do ! j=nodes + end if ! If the Buoyancy flag is True, check that the tower buoyancy coefficients are >= 0. if ( InputFileData%Buoyancy .and. InputFileData%rotors(iR)%NumTwrNds > 0 ) then @@ -3655,9 +4177,10 @@ SUBROUTINE ValidateInputData( InitInp, InputFileData, NumBl, ErrStat, ErrMsg ) endif end do ! j=nodes end if + end do ! iR rotor + end if ! using the tower - end if - end do ! iR rotor + if (Failed()) return @@ -3709,6 +4232,7 @@ SUBROUTINE ValidateInputData( InitInp, InputFileData, NumBl, ErrStat, ErrMsg ) enddo ! iR end if + if (Failed()) return if ( ( InputFileData%NBlOuts < 0_IntKi ) .OR. ( InputFileData%NBlOuts > 9_IntKi ) ) then @@ -3728,6 +4252,7 @@ SUBROUTINE ValidateInputData( InitInp, InputFileData, NumBl, ErrStat, ErrMsg ) end do ! iR, rotor end if + if (Failed()) return !.................. ! Tail fin checks @@ -3742,44 +4267,70 @@ SUBROUTINE ValidateInputData( InitInp, InputFileData, NumBl, ErrStat, ErrMsg ) endif endif enddo ! iR, rotor + if (Failed()) return !.................. ! check for linearization !.................. if (InitInp%Linearize) then - if (InputFileData%AFAeroMod /= AFAeroMod_Steady) then - if (InputFileData%UAMod /= UA_HGM .and. InputFileData%UAMod /= UA_HGMV .and. InputFileData%UAMod /= UA_OYE) then - call SetErrStat( ErrID_Fatal, 'When AFAeroMod=2, UAMod must be 4, 5, or 6 for linearization. Set AFAeroMod=1, or, set UAMod=4, 5, or 6.', ErrStat, ErrMsg, RoutineName ) - end if + + if (InputFileData%Wake_Mod /= WakeMod_None .and. InputFileData%Wake_Mod /= WakeMod_BEMT) then + call SetErrStat( ErrID_Fatal, 'Wake_Mod must be 0 or 1 for linearization.', ErrStat, ErrMsg, RoutineName ) + endif + + if (InputFileData%UA_Init%UAMod /= UA_None .and. InputFileData%UA_Init%UAMod /= UA_HGM .and. InputFileData%UA_Init%UAMod /= UA_HGMV .and. InputFileData%UA_Init%UAMod /= UA_OYE) then + call SetErrStat( ErrID_Fatal, 'UA_Mod must be 0, 4, 5, or 6 for linearization.', ErrStat, ErrMsg, RoutineName ) end if - - if (InputFileData%WakeMod == WakeMod_FVW) then !bjj: note: among other things, WriteOutput values will not be calculated properly in AD Jacobians if FVW this is allowed - call SetErrStat( ErrID_Fatal, 'FVW cannot currently be used for linearization. Set WakeMod=0 or WakeMod=1.', ErrStat, ErrMsg, RoutineName ) - else if (InputFileData%WakeMod == WakeMod_DBEMT) then - if (InputFileData%DBEMT_Mod /= DBEMT_cont_tauConst) then - call SetErrStat( ErrID_Fatal, 'DBEMT requires the continuous formulation with constant tau1 for linearization. Set DBEMT_Mod=3 or set WakeMod to 0 or 1.', ErrStat, ErrMsg, RoutineName ) - end if + + select case(InputFileData%DBEMT_Mod) + case (DBEMT_None, DBEMT_frozen, DBEMT_cont_tauConst) + case default + call SetErrStat( ErrID_Fatal, 'DBEMT_Mod must be -1 (frozen), 0 (none), or 3 (continuous formulation with constant tau1) for linearization. Set DBEMT_Mod=-1,0,3.', ErrStat, ErrMsg, RoutineName ) + end select + + if (InputFileData%NacelleDrag) then + call SetErrStat( ErrID_Fatal, 'Nacelle drag cannot currently be used for linearization. Set NacelleDrag = false.', ErrStat, ErrMsg, RoutineName ) end if end if + + !.................. + ! check for nacelle drag parameters + !.................. + + if (InputFileData%NacelleDrag) then + do iR = 1,size(NumBl) + if (any(InputFileData%rotors(iR)%NacArea < 0.0_ReKi)) then + call SetErrStat( ErrID_Fatal, 'Nacelle projected area should not be negative for drag model.', ErrStat, ErrMsg, RoutineName ) + end if + if (any(InputFileData%rotors(iR)%NacCd < 0.0_ReKi)) then + call SetErrStat( ErrID_Fatal, 'Nacelle drag coefficient should not be negative for drag model.', ErrStat, ErrMsg, RoutineName ) + end if + end do + end if contains SUBROUTINE Fatal(ErrMsg_in) - character(len=*), intent(in) :: ErrMsg_in + character(*), intent(in) :: ErrMsg_in call SetErrStat(ErrID_Fatal, ErrMsg_in, ErrStat, ErrMsg, RoutineName) END SUBROUTINE Fatal + + logical function Failed() + Failed = ErrStat >= AbortErrLev + end function Failed END SUBROUTINE ValidateInputData !---------------------------------------------------------------------------------------------------------------------------------- !> This subroutine sets up the data structures and initializes AirfoilInfo to get the necessary AFI parameters. It then verifies !! that the UA parameters are included in the AFI tables if UA is being used. -SUBROUTINE Init_AFIparams( InputFileData, p_AFI, UnEc, ErrStat, ErrMsg ) +SUBROUTINE Init_AFIparams( InputFileData, p_AFI, UnEc, RootName, ErrStat, ErrMsg ) ! Passed variables type(AD_InputFile), intent(inout) :: InputFileData !< All the data in the AeroDyn input file (intent(out) only because of the call to MOVE_ALLOC) type(AFI_ParameterType), allocatable, intent( out) :: p_AFI(:) !< parameters returned from the AFI (airfoil info) module integer(IntKi), intent(in ) :: UnEc !< I/O unit for echo file. If > 0, file is open for writing. + character(*), intent(in ) :: RootName !< root name for debugging files integer(IntKi), intent( out) :: ErrStat !< Error status character(*), intent( out) :: ErrMsg !< Error message @@ -3811,7 +4362,7 @@ SUBROUTINE Init_AFIparams( InputFileData, p_AFI, UnEc, ErrStat, ErrMsg ) IF (.not. InputFileData%UseBlCm) AFI_InitInputs%InCol_Cm = 0 ! Don't try to use Cm if flag set to false AFI_InitInputs%InCol_Cpmin = InputFileData%InCol_Cpmin AFI_InitInputs%AFTabMod = InputFileData%AFTabMod !AFITable_1 - AFI_InitInputs%UA_f_cn = (InputFileData%UAMod /= UA_HGM).and.(InputFileData%UAMod /= UA_OYE) ! HGM and OYE use the separation function based on cl instead of cn + AFI_InitInputs%UAMod = InputFileData%UA_Init%UAMod ! Call AFI_Init to read in and process the airfoil files. ! This includes creating the spline coefficients to be used for interpolation. @@ -3823,6 +4374,8 @@ SUBROUTINE Init_AFIparams( InputFileData, p_AFI, UnEc, ErrStat, ErrMsg ) call AFI_Init ( AFI_InitInputs, p_AFI(File), ErrStat2, ErrMsg2, UnEc ) call SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) exit + + !call AFI_WrTables( p_AFI(File), InputFileData%UA_Init%UAMod, trim(RootName)//'.'//trim(Num2LStr(File)) ) end do @@ -3914,10 +4467,6 @@ SUBROUTINE Init_AAmodule( DrvInitInp, AD_InputFileData, RotInputFileData, u_AD, ! --- AeroAcoustics initialization call call AA_Init(InitInp, u, p%AA, x, xd, z, OtherState, y, m, Interval, InitOut, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) - - if (.not. equalRealNos(Interval, p_AD%DT) ) then - call SetErrStat( ErrID_Fatal, "DTAero was changed in Init_AAmodule(); this is not allowed.", ErrStat2, ErrMsg2, RoutineName) - endif call Cleanup() @@ -3972,6 +4521,7 @@ SUBROUTINE Init_BEMTmodule( InputFileData, RotInputFileData, u_AD, u, p, p_AD, x integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'Init_BEMTmodule' + character(1024) :: Label ! note here that each blade is required to have the same number of nodes @@ -3985,12 +4535,21 @@ SUBROUTINE Init_BEMTmodule( InputFileData, RotInputFileData, u_AD, u, p, p_AD, x InitInp%airDens = InputFileData%AirDens InitInp%kinVisc = InputFileData%KinVisc - InitInp%skewWakeMod = InputFileData%SkewMod + ! --- Skew + InitInp%skewWakeMod = InputFileData%Skew_Mod + InitInp%skewRedistrMod = InputFileData%SkewRedistr_Mod InitInp%yawCorrFactor = InputFileData%SkewModFactor + InitInp%MomentumCorr = InputFileData%SkewMomCorr + ! Safety + if (InputFileData%Skew_Mod /= Skew_Mod_Active) then + InitInp%skewRedistrMod = SkewRedistrMod_None + InitInp%MomentumCorr = .False. + endif + ! --- Algo InitInp%aTol = InputFileData%IndToler InitInp%useTipLoss = InputFileData%TipLoss InitInp%useHubLoss = InputFileData%HubLoss - InitInp%useInduction = InputFileData%WakeMod /= WakeMod_none + InitInp%useInduction = InputFileData%Wake_Mod == WakeMod_BEMT InitInp%useTanInd = InputFileData%TanInd InitInp%useAIDrag = InputFileData%AIDrag InitInp%useTIDrag = InputFileData%TIDrag @@ -3998,6 +4557,8 @@ SUBROUTINE Init_BEMTmodule( InputFileData, RotInputFileData, u_AD, u, p, p_AD, x InitInp%numReIterations = 1 ! This is currently not available in the input file and is only for testing InitInp%maxIndIterations = InputFileData%MaxIter + call UA_CopyInitInput(InputFileData%UA_Init, InitInp%UA_Init, MESH_NEWCOPY, ErrStat2, ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + call AllocAry(InitInp%chord, InitInp%numBladeNodes,InitInp%numBlades,'chord', ErrStat2,ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) call AllocAry(InitInp%AFindx,InitInp%numBladeNodes,InitInp%numBlades,'AFindx', ErrStat2,ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) @@ -4006,8 +4567,8 @@ SUBROUTINE Init_BEMTmodule( InputFileData, RotInputFileData, u_AD, u, p, p_AD, x call AllocAry(InitInp%rLocal,InitInp%numBladeNodes,InitInp%numBlades,'rLocal', ErrStat2,ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) call AllocAry(InitInp%zTip, InitInp%numBlades,'zTip', ErrStat2,ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) call AllocAry(InitInp%rTipFix, InitInp%numBlades,'rTipFix',ErrStat2,ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call AllocAry(InitInp%UAOff_innerNode, InitInp%numBlades,'UAOff_innerNode',ErrStat2,ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call AllocAry(InitInp%UAOff_outerNode, InitInp%numBlades,'UAOff_outerNode',ErrStat2,ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + call AllocAry(InitInp%UA_Init%UAOff_innerNode, InitInp%numBlades,'UAOff_innerNode',ErrStat2,ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + call AllocAry(InitInp%UA_Init%UAOff_outerNode, InitInp%numBlades,'UAOff_outerNode',ErrStat2,ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) if ( ErrStat >= AbortErrLev ) then call Cleanup() @@ -4068,15 +4629,15 @@ SUBROUTINE Init_BEMTmodule( InputFileData, RotInputFileData, u_AD, u, p, p_AD, x end do !k=blades - InitInp%UAOff_innerNode = 0 - InitInp%UAOff_outerNode = p%NumBlNds + 1 + InitInp%UA_Init%UAOff_innerNode = 0 + InitInp%UA_Init%UAOff_outerNode = p%NumBlNds + 1 do k = 1,p%numBlades do j = 1,p%NumBlNds frac = InitInp%rLocal(j,k) / rMax if (frac < InputFileData%UAStartRad) then - InitInp%UAOff_innerNode(k) = max(InitInp%UAOff_innerNode(k), j) + InitInp%UA_Init%UAOff_innerNode(k) = max(InitInp%UA_Init%UAOff_innerNode(k), j) elseif (frac > InputFileData%UAEndRad) then - InitInp%UAOff_outerNode(k) = min(InitInp%UAOff_outerNode(k), j) + InitInp%UA_Init%UAOff_outerNode(k) = min(InitInp%UA_Init%UAOff_outerNode(k), j) end if end do end do @@ -4091,39 +4652,50 @@ SUBROUTINE Init_BEMTmodule( InputFileData, RotInputFileData, u_AD, u, p, p_AD, x end do InitInp%UA_Flag = p_AD%UA_Flag - InitInp%UAMod = InputFileData%UAMod - InitInp%Flookup = InputFileData%Flookup - InitInp%a_s = InputFileData%SpdSound - InitInp%MomentumCorr = .FALSE. ! TODO EB + InitInp%SumPrint = InputFileData%SumPrint InitInp%RootName = p%RootName - InitInp%BEM_Mod = p%AeroBEM_Mod - + InitInp%BEM_Mod = InputFileData%BEM_Mod + p%BEM_Mod = InputFileData%BEM_Mod ! TODO try to get rid of me - if (p%AeroBEM_Mod==-1) then - !call WrSCr('WARNING: AeroDyn: BEM_Mod is -1, using default BEM_Mod based on projection') - if (p%AeroProjMod == APM_BEM_NoSweepPitchTwist) then - InitInp%BEM_Mod = BEMMod_2D - else if (p%AeroProjMod == APM_BEM_Polar) then - InitInp%BEM_Mod = BEMMod_3D - else - InitInp%BEM_Mod = -1 - call SetErrStat(ErrID_Fatal, "AeroProjMod needs to be 1 or 2 when used with BEM", ErrStat, ErrMsg, RoutineName) - endif + ! --- Print BEM formulation to screen + Label = '' + if (p%AeroProjMod==APM_BEM_NoSweepPitchTwist) then + Label='Projection: legacy (NoSweepPitchTwist)' + elseif (p%AeroProjMod==APM_BEM_Polar) then + Label='Projection: Polar' + elseif (p%AeroProjMod==APM_LiftingLine) then + Label='Projection: Lifting Line' + else + ! Normally we wouldn't want to do a print or STOP, but we + ! should never get here unless a programmer made a mistake. + ! I'll leave this as is for now. - ADP + print*,'Invalid projection method' + STOP + endif + if (InitInp%BEM_Mod==BEMMod_2D) then + Label = trim(Label)//', BEM: legacy (2D)' + elseif (InitInp%BEM_Mod==BEMMod_3D) then + Label = trim(Label)//', BEM: polar (3D)' + else + print*,'Invalid BEM method' + STOP endif - p%AeroBEM_Mod = InitInp%BEM_Mod ! Very important, for consistency - !call WrScr(' AeroDyn: projMod: '//trim(num2lstr(p%AeroProjMod))//', BEM_Mod:'//trim(num2lstr(InitInp%BEM_Mod))) + if (InitInp%MomentumCorr) then + Label = trim(Label)//', MomentumCorrection' + endif + if (p_AD%SectAvg) then + Label = trim(Label)//', Sector Average' + endif + call WrScr(' '//trim(Label)) + ! remove the ".AD" from the RootName k = len_trim(InitInp%RootName) if (k>3) then InitInp%RootName = InitInp%RootName(1:k-3) end if - if (InputFileData%WakeMod == WakeMod_DBEMT) then - InitInp%DBEMT_Mod = InputFileData%DBEMT_Mod - else - InitInp%DBEMT_Mod = DBEMT_none - end if + InitInp%DBEMT_Mod = InputFileData%DBEMT_Mod InitInp%tau1_const = InputFileData%tau1_const if (ErrStat >= AbortErrLev) then @@ -4139,6 +4711,7 @@ SUBROUTINE Init_BEMTmodule( InputFileData, RotInputFileData, u_AD, u, p, p_AD, x call SetErrStat( ErrID_Fatal, "DTAero was changed in Init_BEMTmodule(); this is not allowed.", ErrStat2, ErrMsg2, RoutineName) !m%UseFrozenWake = .FALSE. !BJJ: set this in BEMT + if (p_AD%CompAeroMaps) p%BEMT%lin_nx = 0 ! we are going to ignore this call Cleanup() return @@ -4274,10 +4847,7 @@ SUBROUTINE Init_OLAF( InputFileData, u_AD, u, p, x, xd, z, OtherState, m, ErrSta ! Unsteady Aero Data InitInp%UA_Flag = p%UA_Flag - InitInp%UAMod = InputFileData%UAMod - InitInp%Flookup = InputFileData%Flookup - InitInp%a_s = InputFileData%SpdSound - InitInp%SumPrint = InputFileData%SumPrint + call UA_CopyInitInput(InputFileData%UA_Init, InitInp%UA_Init, MESH_NEWCOPY, ErrStat2, ErrMsg2) iW_incr = iW_incr+p%rotors(iR)%numBlades enddo ! iR, rotors @@ -4286,8 +4856,8 @@ SUBROUTINE Init_OLAF( InputFileData, u_AD, u, p, x, xd, z, OtherState, m, ErrSta call FVW_Init(p%AFI, InitInp, u, p%FVW, x, xd, z, OtherState, m%FVW_y, m%FVW, Interval, InitOut, ErrStat2, ErrMsg2 ); if(Failed()) return ! set the size of the input and xd arrays for passing wind info to FVW. - call AllocAry(u_AD%InflowWakeVel, 3, size(m%FVW%r_wind,DIM=2), 'InflowWakeVel', ErrStat2,ErrMsg2); if(Failed()) return - u_AD%InflowWakeVel = 0.0_ReKi ! initialize for safety + call AllocAry(m%Inflow(1)%InflowWakeVel, 3, size(m%FVW%r_wind,DIM=2), 'InflowWakeVel', ErrStat2,ErrMsg2); if(Failed()) return + m%Inflow(1)%InflowWakeVel = 0.0_ReKi ! initialize for safety if (.not. equalRealNos(Interval, p%DT) ) then errStat2=ErrID_Fatal; errMsg2="DTAero was changed in Init_FVWmodule(); this is not allowed yet."; if(Failed()) return @@ -4310,9 +4880,10 @@ end function Failed END SUBROUTINE Init_OLAF !---------------------------------------------------------------------------------------------------------------------------------- !> This subroutine calculates the tower loads for the AeroDyn TowerLoad output mesh. -SUBROUTINE TFin_CalcOutput(p, p_AD, u, m, y, ErrStat, ErrMsg ) +SUBROUTINE TFin_CalcOutput(p, p_AD, u, RotInflow, m, y, ErrStat, ErrMsg ) TYPE(RotInputType), INTENT(IN ) :: u !< Inputs at Time t + TYPE(RotInflowType), INTENT(IN ) :: RotInflow !< Inputs at Time t TYPE(RotParameterType), INTENT(IN ) :: p !< Parameters TYPE(AD_ParameterType), INTENT(IN ) :: p_AD !< Parameters TYPE(RotMiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables @@ -4327,9 +4898,12 @@ SUBROUTINE TFin_CalcOutput(p, p_AD, u, m, y, ErrStat, ErrMsg ) real(ReKi) :: V_wnd(3) ! wind velocity real(ReKi) :: V_ind(3) ! induced velocity real(ReKi) :: V_str(3) ! structural velocity + real(ReKi) :: V_wnd_tf(3) ! wind velocity real(ReKi) :: force_tf(3) ! force in tf system real(ReKi) :: moment_tf(3) ! moment in tf system real(ReKi) :: alpha, Re, Cx, Cy, q ! Cl, Cd, Cm, + real(ReKi) :: x1, x2, x3,gamma_tf! scaling functions, gamma for unsteady modeling + type(AFI_OutputType) :: AFI_interp ! Resulting values from lookup table integer(intKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 @@ -4340,29 +4914,38 @@ SUBROUTINE TFin_CalcOutput(p, p_AD, u, m, y, ErrStat, ErrMsg ) ! TODO TailFin: compute tower influence - V_wnd = u%InflowOnTailFin + V_wnd = RotInflow%InflowOnTailFin(:,1) V_str = u%TFinMotion%TranslationVel(:,1) if (p%TFin%TFinIndMod==TFinIndMod_none) then V_ind = 0.0_ReKi + elseif(p%TFin%TFinIndMod==TFinIndMod_rotavg) then ! TODO TODO - print*,'TODO TailFin: compute rotor average induced velocity' + call WrScr('TODO TailFin: compute rotor average induced velocity') V_ind = 0.0_ReKi + else - STOP ! Will never happen + call setErrStat(ErrID_Fatal, 'TailFin model unsupported', ErrStat, ErrMsg, 'TFin_CalcOutput') + endif - V_rel = V_wnd - V_str + V_ind + + V_rel = V_wnd - V_str + V_ind ! relative wind on tail fin V_rel_tf = matmul(u%TFinMotion%Orientation(:,:,1), V_rel) ! from inertial to tf system - alpha = atan2( V_rel_tf(2), V_rel_tf(1)) ! angle of attack + alpha = atan2(V_rel_tf(2), V_rel_tf(1)) ! angle of attack + v_wnd_tf = matmul(u%TFinMotion%Orientation(:,:,1), V_wnd) ! only used for calculation of x1,x2,x3 + gamma_tf = atan2(v_wnd_tf(2), v_wnd_tf(1)) ! only used for calculation of x1,x2,x3 V_rel_orth2 = V_rel_tf(1)**2 + V_rel_tf(2)**2 ! square norm of Vrel in tf system + ! Initialize the tail fin forces to zero + force_tf(:) = 0.0_ReKi + moment_tf(:) = 0.0_ReKi + if (p%TFin%TFinMod==TFinAero_none) then - y%TFinLoad%Force(1:3,1) = 0.0_ReKi - y%TFinLoad%Moment(1:3,1) = 0.0_ReKi + ! Do nothing elseif (p%TFin%TFinMod==TFinAero_polar) then - ! Airfoil coefficients + ! Airfoil coefficients based model Re = sqrt(V_rel_orth2) * p%TFin%TFinChord/p%KinVisc call AFI_ComputeAirfoilCoefs( alpha, Re, 0.0_ReKi, p_AD%AFI(p%TFin%TFinAFID), AFI_interp, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -4370,21 +4953,28 @@ SUBROUTINE TFin_CalcOutput(p, p_AD, u, m, y, ErrStat, ErrMsg ) Cy = AFI_interp%Cl * cos(alpha) + AFI_interp%Cd * sin(alpha) ! Forces in tailfin system q = 0.5 * p%airDens * V_rel_orth2 * p%TFin%TFinArea - force_tf(:) = 0.0_ReKi - moment_tf(:) = 0.0_ReKi + force_tf(1) = Cx * q force_tf(2) = Cy * q - force_tf(3) = 0.0_ReKi - moment_tf(1:2) = 0.0_ReKi moment_tf(3) = AFI_interp%Cm * q * p%TFin%TFinChord - ! Transfer to global - y%TFinLoad%Force(1:3,1) = matmul(transpose(u%TFinMotion%Orientation(:,:,1)), force_tf) - y%TFinLoad%Moment(1:3,1) = matmul(transpose(u%TFinMotion%Orientation(:,:,1)), moment_tf) elseif (p%TFin%TFinMod==TFinAero_USB) then - call SetErrStat(ErrID_Fatal, 'Tail fin USB model not yet available', ErrStat, ErrMsg, RoutineName ) - return + ! Unsteady aerodynamic model + + ! Calculate separation function (quasi-steady) + x1 = 1.0_Reki/(1.0_Reki+exp(p%TFin%TFinSigma(1)*((ABS(gamma_tf)*R2D)-p%TFin%TFinAStar(1)))) + x2 = 1.0_Reki/(1.0_Reki+exp(p%TFin%TFinSigma(2)*((ABS(gamma_tf)*R2D)-p%TFin%TFinAStar(2)))) + x3 = 1.0_Reki/(1.0_Reki+exp(p%TFin%TFinSigma(3)*((ABS(gamma_tf)*R2D)-p%TFin%TFinAStar(3)))) + + ! Calculate unsteady force on tail fin + force_tf(2) = 0.5_ReKi * p%AirDens * p%TFin%TFinArea * & + (p%TFin%TFinKp * x1 * V_rel_tf(1) * V_rel_tf(2) + & + (x2 * p%TFin%TFinKv + (1-x3)*p%TFin%TFinCDc) * V_rel_tf(2) * ABS(V_rel_tf(2))) endif + + ! Transfer to global + y%TFinLoad%Force(1:3,1) = matmul(transpose(u%TFinMotion%Orientation(:,:,1)), force_tf) + y%TFinLoad%Moment(1:3,1) = matmul(transpose(u%TFinMotion%Orientation(:,:,1)), moment_tf) ! --- Store m%TFinAlpha = alpha @@ -4398,11 +4988,13 @@ SUBROUTINE TFin_CalcOutput(p, p_AD, u, m, y, ErrStat, ErrMsg ) m%TFinM_i = y%TFinLoad%Moment(1:3,1) END SUBROUTINE TFin_CalcOutput + !---------------------------------------------------------------------------------------------------------------------------------- !> This subroutine calculates the tower loads for the AeroDyn TowerLoad output mesh. -SUBROUTINE ADTwr_CalcOutput(p, u, m, y, ErrStat, ErrMsg ) +SUBROUTINE ADTwr_CalcOutput(p, u, RotInflow, m, y, ErrStat, ErrMsg ) TYPE(RotInputType), INTENT(IN ) :: u !< Inputs at Time t + TYPE(RotInflowType), INTENT(IN ) :: RotInflow !< Inputs at Time t TYPE(RotParameterType), INTENT(IN ) :: p !< Parameters TYPE(RotMiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables TYPE(RotOutputType), INTENT(INOUT) :: y !< Outputs computed at t (Input only so that mesh con- @@ -4417,6 +5009,9 @@ SUBROUTINE ADTwr_CalcOutput(p, u, m, y, ErrStat, ErrMsg ) real(ReKi) :: VL(2) ! relative local x- and y-components of the wind speed on a tower node real(ReKi) :: tmp(3) + real(ReKi) :: xTower(3) ! tower x-orientation vector + real(ReKi) :: yTower(3) ! tower y-orientation vector + !integer(intKi) :: ErrStat2 !character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ADTwr_CalcOutput' @@ -4425,34 +5020,36 @@ SUBROUTINE ADTwr_CalcOutput(p, u, m, y, ErrStat, ErrMsg ) ErrStat = ErrID_None ErrMsg = "" + IF (p%TwrAero == TwrAero_noVIV) THEN - do j=1,p%NumTwrNds + do j=1,p%NumTwrNds - V_rel = u%InflowOnTower(:,j) - u%TowerMotion%TranslationVel(:,j) ! relative wind speed at tower node + V_rel = RotInflow%Tower%InflowVel(:,j) - u%TowerMotion%TranslationVel(:,j) ! relative wind speed at tower node - tmp = u%TowerMotion%Orientation(1,:,j) - VL(1) = dot_product( V_Rel, tmp ) ! relative local x-component of wind speed of the jth node in the tower - tmp = u%TowerMotion%Orientation(2,:,j) - VL(2) = dot_product( V_Rel, tmp ) ! relative local y-component of wind speed of the jth node in the tower + xTower = u%TowerMotion%Orientation(1,:,j) + yTower = u%TowerMotion%Orientation(2,:,j) + VL(1) = dot_product( V_Rel, xTower ) ! relative local x-component of wind speed of the jth node in the tower + VL(2) = dot_product( V_Rel, yTower ) ! relative local y-component of wind speed of the jth node in the tower - m%W_Twr(j) = TwoNorm( VL ) ! relative wind speed normal to the tower at node j - q = 0.5 * p%TwrCd(j) * p%AirDens * p%TwrDiam(j) * m%W_Twr(j) + m%W_Twr(j) = TwoNorm( VL ) ! relative wind speed normal to the tower at node j + q = 0.5 * p%TwrCd(j) * p%AirDens * p%TwrDiam(j) * m%W_Twr(j) - ! force per unit length of the jth node in the tower - tmp(1) = q * VL(1) - tmp(2) = q * VL(2) - tmp(3) = 0.0_ReKi + ! force per unit length of the jth node in the tower + tmp(1) = q * VL(1) + tmp(2) = q * VL(2) + tmp(3) = 0.0_ReKi - y%TowerLoad%force(:,j) = matmul( tmp, u%TowerMotion%Orientation(:,:,j) ) ! note that I'm calculating the transpose here, which is okay because we have 1-d arrays - m%X_Twr(j) = tmp(1) - m%Y_Twr(j) = tmp(2) + y%TowerLoad%force(:,j) = matmul( tmp, u%TowerMotion%Orientation(:,:,j) ) ! note that I'm calculating the transpose here, which is okay because we have 1-d arrays + m%X_Twr(j) = tmp(1) + m%Y_Twr(j) = tmp(2) - ! moment per unit length of the jth node in the tower - y%TowerLoad%moment(:,j) = 0.0_ReKi + ! moment per unit length of the jth node in the tower + y%TowerLoad%moment(:,j) = 0.0_ReKi - end do - + end do + + END IF END SUBROUTINE ADTwr_CalcOutput !---------------------------------------------------------------------------------------------------------------------------------- @@ -4491,11 +5088,12 @@ SUBROUTINE CheckTwrInfl(u, ErrStat, ErrMsg ) END SUBROUTINE CheckTwrInfl !---------------------------------------------------------------------------------------------------------------------------------- !> This routine calculates m%DisturbedInflow, the influence of tower shadow and/or potential flow on the inflow velocities -SUBROUTINE TwrInfl( p, u, m, ErrStat, ErrMsg ) +SUBROUTINE TwrInfl( p, u, RotInflow, m, ErrStat, ErrMsg ) !.................................................................................................................................. TYPE(RotInputType), INTENT(IN ) :: u !< Inputs at Time t TYPE(RotParameterType), INTENT(IN ) :: p !< Parameters + TYPE(RotInflowType), INTENT(IN ) :: RotInflow !< Rotor Inflow at Time t type(RotMiscVarType), 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 @@ -4540,16 +5138,16 @@ SUBROUTINE TwrInfl( p, u, m, ErrStat, ErrMsg ) BladeNodePosition = u%BladeMotion(k)%Position(:,j) + u%BladeMotion(k)%TranslationDisp(:,j) - call getLocalTowerProps(p, u, BladeNodePosition, theta_tower_trans, W_tower, xbar, ybar, zbar, TwrCd, TwrTI, m%TwrClrnc(j,k), FirstWarn_TowerStrike, DisturbInflow, ErrStat2, ErrMsg2) + call getLocalTowerProps(p, u, RotInflow, BladeNodePosition, theta_tower_trans, W_tower, xbar, ybar, zbar, TwrCd, TwrTI, m%TwrClrnc(j,k), FirstWarn_TowerStrike, DisturbInflow, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) if (.not. FirstWarn_TowerStrike) call SetErrStat(ErrID_Fatal, "Tower strike.", ErrStat, ErrMsg, RoutineName ) if (ErrStat >= AbortErrLev) return if ( DisturbInflow ) then v = CalculateTowerInfluence(p, xbar, ybar, zbar, W_tower, TwrCd, TwrTI) - m%DisturbedInflow(:,j,k) = u%InflowOnBlade(:,j,k) + matmul( theta_tower_trans, v ) + m%DisturbedInflow(:,j,k) = RotInflow%Blade(k)%InflowVel(:,j) + matmul( theta_tower_trans, v ) else - m%DisturbedInflow(:,j,k) = u%InflowOnBlade(:,j,k) + m%DisturbedInflow(:,j,k) = RotInflow%Blade(k)%InflowVel(:,j) end if end do !j=NumBlNds @@ -4561,8 +5159,9 @@ END SUBROUTINE TwrInfl !> Calculate the tower influence on a array of points `Positions` (3xn) !! The subroutine has side effecs and modifies the inflow !! Relies heavily (i.e. unfortunate copy pasting), on TwrInfl -SUBROUTINE TwrInflArray( p, u, m, Positions, Inflow, ErrStat, ErrMsg ) +SUBROUTINE TwrInflArray( p, u, RotInflow, m, Positions, Inflow, ErrStat, ErrMsg ) TYPE(RotInputType), INTENT(IN ) :: u !< Inputs at Time t + TYPE(RotInflowType), INTENT(IN ) :: RotInflow !< Rotor inflow at Time t TYPE(RotParameterType), INTENT(IN ) :: p !< Parameters type(RotMiscVarType), intent(inout) :: m !< Misc/optimization variables real(ReKi), dimension(:,:), INTENT(IN ) :: Positions !< Positions where tower influence is to be computed @@ -4603,7 +5202,7 @@ SUBROUTINE TwrInflArray( p, u, m, Positions, Inflow, ErrStat, ErrMsg ) ! Find nearest line2 element or node of the tower (see getLocalTowerProps) ! values are found for the deflected tower, returning theta_tower, W_tower, xbar, ybar, zbar, and TowerCd: - call getLocalTowerProps(p, u, Pos, theta_tower_trans, W_tower, xbar, ybar, zbar, TwrCd, TwrTI, TwrClrnc, FirstWarn_TowerStrike, DisturbInflow, ErrStat2, ErrMsg2) + call getLocalTowerProps(p, u, RotInflow, Pos, theta_tower_trans, W_tower, xbar, ybar, zbar, TwrCd, TwrTI, TwrClrnc, FirstWarn_TowerStrike, DisturbInflow, ErrStat2, ErrMsg2) if ( DisturbInflow ) then v = CalculateTowerInfluence(p, xbar, ybar, zbar, W_tower, TwrCd, TwrTI) @@ -4618,7 +5217,7 @@ END SUBROUTINE TwrInflArray FUNCTION CalculateTowerInfluence(p, xbar_in, ybar, zbar, W_tower, TwrCd, TwrTI) RESULT(v) TYPE(RotParameterType), INTENT(IN ) :: p !< Parameters - real(ReKi), intent(in ) :: xbar_in ! local x^ component of r_TowerBlade (distance from tower to blade) normalized by tower radius + real(ReKi), intent(in) :: xbar_in ! local x^ component of r_TowerBlade (distance from tower to blade) normalized by tower radius real(ReKi), intent(in) :: ybar ! local y^ component of r_TowerBlade (distance from tower to blade) normalized by tower radius real(ReKi), intent(in) :: zbar ! local z^ component of r_TowerBlade (distance from tower to blade) normalized by tower radius real(ReKi), intent(in) :: W_tower ! local relative wind speed normal to the tower @@ -4692,9 +5291,10 @@ END FUNCTION CalculateTowerInfluence !---------------------------------------------------------------------------------------------------------------------------------- !> This routine returns the tower constants necessary to compute the tower influence. !! if u%TowerMotion does not have any nodes there will be serious problems. I assume that has been checked earlier. -SUBROUTINE getLocalTowerProps(p, u, BladeNodePosition, theta_tower_trans, W_tower, xbar, ybar, zbar, TwrCd, TwrTI, TwrClrnc, FirstWarn_TowerStrike, DisturbInflow, ErrStat, ErrMsg) +SUBROUTINE getLocalTowerProps(p, u, RotInflow, BladeNodePosition, theta_tower_trans, W_tower, xbar, ybar, zbar, TwrCd, TwrTI, TwrClrnc, FirstWarn_TowerStrike, DisturbInflow, ErrStat, ErrMsg) !.................................................................................................................................. TYPE(RotInputType), INTENT(IN ) :: u !< Inputs at Time t + TYPE(RotInflowType), INTENT(IN ) :: RotInflow !< Rotor inflow at Time t TYPE(RotParameterType), INTENT(IN ) :: p !< Parameters REAL(ReKi) ,INTENT(IN ) :: BladeNodePosition(3) !< local blade node position REAL(ReKi) ,INTENT( OUT) :: theta_tower_trans(3,3) !< transpose of local tower orientation expressed as a DCM @@ -4723,13 +5323,13 @@ SUBROUTINE getLocalTowerProps(p, u, BladeNodePosition, theta_tower_trans, W_towe ! .............................................. ! option 1: nearest line2 element ! .............................................. - call TwrInfl_NearestLine2Element(p, u, BladeNodePosition, r_TowerBlade, theta_tower_trans, W_tower, xbar, ybar, zbar, TwrCd, TwrTI, TwrDiam, found) + call TwrInfl_NearestLine2Element(p, u, RotInflow, BladeNodePosition, r_TowerBlade, theta_tower_trans, W_tower, xbar, ybar, zbar, TwrCd, TwrTI, TwrDiam, found) if ( .not. found) then ! .............................................. ! option 2: nearest node ! .............................................. - call TwrInfl_NearestPoint(p, u, BladeNodePosition, r_TowerBlade, theta_tower_trans, W_tower, xbar, ybar, zbar, TwrCd, TwrTI, TwrDiam) + call TwrInfl_NearestPoint(p, u, RotInflow, BladeNodePosition, r_TowerBlade, theta_tower_trans, W_tower, xbar, ybar, zbar, TwrCd, TwrTI, TwrDiam) end if @@ -4766,9 +5366,10 @@ END SUBROUTINE getLocalTowerProps !! That is, for each node of the blade mesh, an orthogonal projection is made onto all possible Line2 elements of the tower mesh and !! the line2 element of the tower mesh that is the minimum distance away is found. !! Adapted from modmesh_mapping::createmapping_projecttoline2() -SUBROUTINE TwrInfl_NearestLine2Element(p, u, BladeNodePosition, r_TowerBlade, theta_tower_trans, W_tower, xbar, ybar, zbar, TwrCd, TwrTI, TwrDiam, found) +SUBROUTINE TwrInfl_NearestLine2Element(p, u, RotInflow, BladeNodePosition, r_TowerBlade, theta_tower_trans, W_tower, xbar, ybar, zbar, TwrCd, TwrTI, TwrDiam, found) !.................................................................................................................................. TYPE(RotInputType), INTENT(IN ) :: u !< Inputs at Time t + TYPE(RotInflowType), INTENT(IN ) :: RotInflow !< Rotor Inflow at Time t TYPE(RotParameterType), INTENT(IN ) :: p !< Parameters REAL(ReKi) ,INTENT(IN ) :: BladeNodePosition(3) !< local blade node position REAL(ReKi) ,INTENT( OUT) :: r_TowerBlade(3) !< distance vector from tower to blade @@ -4855,8 +5456,8 @@ SUBROUTINE TwrInfl_NearestLine2Element(p, u, BladeNodePosition, r_TowerBlade, th found = .true. min_dist = dist - V_rel_tower = ( u%InflowOnTower(:,n1) - u%TowerMotion%TranslationVel(:,n1) ) * elem_position2 & - + ( u%InflowOnTower(:,n2) - u%TowerMotion%TranslationVel(:,n2) ) * elem_position + V_rel_tower = ( RotInflow%Tower%InflowVel(:,n1) - u%TowerMotion%TranslationVel(:,n1) ) * elem_position2 & + + ( RotInflow%Tower%InflowVel(:,n2) - u%TowerMotion%TranslationVel(:,n2) ) * elem_position TwrDiam = elem_position2*p%TwrDiam(n1) + elem_position*p%TwrDiam(n2) TwrCd = elem_position2*p%TwrCd( n1) + elem_position*p%TwrCd( n2) @@ -4904,9 +5505,10 @@ END SUBROUTINE TwrInfl_NearestLine2Element !! Find the nearest-neighbor node in the tower Line2-element domain (following an approach similar to the point_to_point mapping !! search for motion and scalar quantities). That is, for each node of the blade mesh, the node of the tower mesh that is the minimum !! distance away is found. -SUBROUTINE TwrInfl_NearestPoint(p, u, BladeNodePosition, r_TowerBlade, theta_tower_trans, W_tower, xbar, ybar, zbar, TwrCd, TwrTI, TwrDiam) +SUBROUTINE TwrInfl_NearestPoint(p, u, RotInflow, BladeNodePosition, r_TowerBlade, theta_tower_trans, W_tower, xbar, ybar, zbar, TwrCd, TwrTI, TwrDiam) !.................................................................................................................................. TYPE(RotInputType), INTENT(IN ) :: u !< Inputs at Time t + TYPE(RotInflowType), INTENT(IN ) :: RotInflow !< Rotor Inflow at Time t TYPE(RotParameterType), INTENT(IN ) :: p !< Parameters REAL(ReKi) ,INTENT(IN ) :: BladeNodePosition(3) !< local blade node position REAL(ReKi) ,INTENT( OUT) :: r_TowerBlade(3) !< distance vector from tower to blade @@ -4970,7 +5572,7 @@ SUBROUTINE TwrInfl_NearestPoint(p, u, BladeNodePosition, r_TowerBlade, theta_tow n1 = node_with_min_distance r_TowerBlade = BladeNodePosition - u%TowerMotion%Position(:,n1) - u%TowerMotion%TranslationDisp(:,n1) - V_rel_tower = u%InflowOnTower(:,n1) - u%TowerMotion%TranslationVel(:,n1) + V_rel_tower = RotInflow%Tower%InflowVel(:,n1) - u%TowerMotion%TranslationVel(:,n1) TwrDiam = p%TwrDiam(n1) TwrCd = p%TwrCd( n1) TwrTI = p%TwrTI( n1) @@ -5032,8 +5634,6 @@ END SUBROUTINE TwrInfl_NearestPoint !> 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 AD_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(AD_InputType), INTENT(INOUT) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) TYPE(AD_ParameterType), INTENT(IN ) :: p !< Parameters @@ -5042,40 +5642,35 @@ SUBROUTINE AD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM TYPE(AD_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point TYPE(AD_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point TYPE(AD_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(AD_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 - ! integer(IntKi), parameter :: iR =1 ! Rotor index + integer(intKi) :: StartNode + StartNode = 1 ! ignored during linearization since cannot linearize with ExtInflow if (size(p%rotors)>1) then errStat = ErrID_Fatal errMsg = 'Linearization with more than one rotor not supported' return endif - call Rot_JacobianPInput( t, u%rotors(iR), p%rotors(iR), p, x%rotors(iR), xd%rotors(iR), z%rotors(iR), OtherState%rotors(iR), y%rotors(iR), m%rotors(iR), m, iR, ErrStat, ErrMsg, dYdu, dXdu, dXddu, dZdu) + call AD_CalcWind_Rotor( t, u%rotors(iR), p%FLowField, p%rotors(iR), m%Inflow(1)%RotInflow(iR), StartNode, ErrStat, ErrMsg) + call Rot_JacobianPInput( t, u%rotors(iR), m%Inflow(1)%RotInflow(iR), p%rotors(iR), p, x%rotors(iR), xd%rotors(iR), z%rotors(iR), OtherState%rotors(iR), y%rotors(iR), m%rotors(iR), m, iR, ErrStat, ErrMsg, dYdu, dXdu, dXddu, dZdu) END SUBROUTINE AD_JacobianPInput - !! respect to the inputs (u) [intent in to avoid deallocation] + !> 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 Rot_JacobianPInput( t, u, p, p_AD, x, xd, z, OtherState, y, m, m_AD, iRot, ErrStat, ErrMsg, dYdu, dXdu, dXddu, dZdu) -!.................................................................................................................................. - +SUBROUTINE Rot_JacobianPInput( t, u, RotInflow, p, p_AD, x, xd, z, OtherState, y, m, m_AD, iRot, ErrStat, ErrMsg, dYdu, dXdu, dXddu, dZdu) REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point TYPE(RotInputType), INTENT(INOUT) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) + TYPE(RotInflowType), INTENT(IN ) :: RotInflow !< Rotor inflow TYPE(RotParameterType), INTENT(IN ) :: p !< Parameters TYPE(AD_ParameterType), INTENT(IN ) :: p_AD !< Parameters TYPE(RotContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point @@ -5083,22 +5678,15 @@ SUBROUTINE Rot_JacobianPInput( t, u, p, p_AD, x, xd, z, OtherState, y, m, m_AD, TYPE(RotConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point TYPE(RotOtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point TYPE(RotOutputType), 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(RotMiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables TYPE(AD_MiscVarType), INTENT(INOUT) :: m_AD !< misc variables INTEGER, INTENT(IN ) :: iRot !< Rotor index, needed for OLAF 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] + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdu(:,:) !< Partial derivatives of output functions (Y) + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdu(:,:) !< Partial derivatives of continuous state functions (X) + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddu(:,:) !< Partial derivatives of discrete state functions (Xd) + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdu(:,:) !< Partial derivatives of constraint state functions (Z) ! local variables TYPE(RotOutputType) :: y_p TYPE(RotOutputType) :: y_m @@ -5109,25 +5697,25 @@ SUBROUTINE Rot_JacobianPInput( t, u, p, p_AD, x, xd, z, OtherState, y, m, m_AD, TYPE(RotOtherStateType) :: OtherState_copy TYPE(RotOtherStateType) :: OtherState_init TYPE(RotInputType) :: u_perturb + type(FLowFieldType),target :: FlowField_perturb + type(FLowFieldType),pointer :: FlowField_perturb_p ! need a pointer in the CalcWind_Rotor routine + type(RotInflowType) :: RotInflow_perturb !< Rotor inflow, perturbed by FlowField extended inputs REAL(R8Ki) :: delta_p, delta_m ! delta change in input INTEGER(IntKi) :: i integer, parameter :: indx = 1 ! m%BEMT_u(1) is at t; m%BEMT_u(2) is t+dt integer(intKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'AD_JacobianPInput' + character(*), parameter :: RoutineName = 'Rot_JacobianPInput' ! Initialize ErrStat - ErrStat = ErrID_None ErrMsg = '' - ! get OP values here (i.e., set inputs for BEMT): - if ( p%FrozenWake ) then - call SetInputs(p, p_AD, u, m, indx, errStat2, errMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later + if ( p%DBEMT_Mod == DBEMT_frozen ) then + call SetInputs(t, p, p_AD, u, RotInflow, m, indx, errStat2, errMsg2); if (Failed()) return ! compare m%BEMT_y arguments with call to BEMT_CalcOutput call computeFrozenWake(m%BEMT_u(indx), p%BEMT, m%BEMT_y, m%BEMT ) @@ -5135,114 +5723,80 @@ SUBROUTINE Rot_JacobianPInput( t, u, p, p_AD, x, xd, z, OtherState, y, m, m_AD, end if - call AD_CopyRotContinuousStateType( x, x_init, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call AD_CopyRotOtherStateType( OtherState, OtherState_init, MESH_NEWCOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if - + call AD_CopyRotContinuousStateType( x, x_init, MESH_NEWCOPY, ErrStat2, ErrMsg2 ); if (Failed()) return + call AD_CopyRotOtherStateType( OtherState, OtherState_init, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + ! Copy FlowField data -- ideally we would not do this, but we cannot linearize with turbulent winds + call IfW_FlowField_CopyFlowFieldType(p_AD%FlowField, FlowField_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + FlowField_perturb_p => FlowField_perturb + call AD_CopyRotInflowType( RotInflow, RotInflow_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + ! initialize x_init so that we get accurrate values for first step if (.not. OtherState%BEMT%nodesInitialized ) then - call SetInputs(p, p_AD, u, m, indx, errStat2, errMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - + call SetInputs(t, p, p_AD, u, RotInflow, m, indx, errStat2, errMsg2); if (Failed()) return call BEMT_InitStates(t, m%BEMT_u(indx), p%BEMT, x_init%BEMT, xd%BEMT, z%BEMT, OtherState_init%BEMT, m%BEMT, p_AD%AFI, ErrStat2, ErrMsg2 ) ! changes values only if states haven't been initialized - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (Failed()) return end if - - + + ! make a copy of the inputs to perturb - call AD_CopyRotInputType( u, u_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if - + call AD_CopyRotInputType( 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: - + ! allocate dYdu if (.not. allocated(dYdu) ) then - call AllocAry(dYdu,p%Jac_ny, size(p%Jac_u_indx,1),'dYdu', ErrStat2, ErrMsg2) - call setErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if + 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 AD_CopyRotOutputType( y, y_p, MESH_NEWCOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call AD_CopyRotOutputType( y, y_m, MESH_NEWCOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + call AD_CopyRotOutputType( y, y_p, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + call AD_CopyRotOutputType( y, y_m, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return ! make a copy of the states to perturb - call AD_CopyRotConstraintStateType( z, z_copy, MESH_NEWCOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call AD_CopyRotOtherStateType( OtherState_init, OtherState_copy, MESH_NEWCOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + call AD_CopyRotConstraintStateType( z, z_copy, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + call AD_CopyRotOtherStateType( OtherState_init, OtherState_copy, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if do i=1,size(p%Jac_u_indx,1) ! get u_op + delta_p u - call AD_CopyRotInputType( u, u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later + call IfW_FlowField_CopyFlowFieldType(p_AD%FlowField, FlowField_perturb_p, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return + call AD_CopyRotInflowType( RotInflow, RotInflow_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return + call AD_CopyRotInputType( u, u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ); if (Failed()) return call Perturb_u( p, i, 1, u_perturb, delta_p ) + call Perturb_uExtend( t, u_perturb, FlowField_perturb_p, RotInflow_perturb, p, OtherState, i, 1, u_perturb, delta_p, ErrStat2, ErrMsg2); if (Failed()) return - call AD_CopyRotConstraintStateType( z, z_copy, MESH_UPDATECOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call AD_CopyRotOtherStateType( OtherState_init, OtherState_copy, MESH_UPDATECOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + call AD_CopyRotConstraintStateType( z, z_copy, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return + call AD_CopyRotOtherStateType( OtherState_init, OtherState_copy, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return ! get updated z%phi values: - !call AD_UpdateStates( t, 1, (/u_perturb/), (/t/), p, x_copy, xd_copy, z_copy, OtherState_copy, m, errStat2, errMsg2 ) - ! call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) !bjj: this is what we want to do instead of the overkill of calling AD_UpdateStates - call SetInputs(p, p_AD, u_perturb, m, indx, errStat2, errMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - call UpdatePhi( m%BEMT_u(indx), p%BEMT, z_copy%BEMT%phi, p_AD%AFI, m%BEMT, OtherState_copy%BEMT%ValidPhi, errStat2, errMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later + call SetInputs(t, p, p_AD, u_perturb, RotInflow_perturb, m, indx, errStat2, errMsg2); if (Failed()) return + call UpdatePhi( m%BEMT_u(indx), p%BEMT, z_copy%BEMT%phi, p_AD%AFI, m%BEMT, OtherState_copy%BEMT%ValidPhi, errStat2, errMsg2 ); if (Failed()) return ! compute y at u_op + delta_p u - call RotCalcOutput( t, u_perturb, p, p_AD, x_init, xd, z_copy, OtherState_copy, y_p, m, m_AD, iRot, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later + call RotCalcOutput( t, u_perturb, RotInflow_perturb, p, p_AD, x_init, xd, z_copy, OtherState_copy, y_p, m, m_AD, iRot, ErrStat2, ErrMsg2 ); if (Failed()) return ! get u_op - delta_m u - call AD_CopyRotInputType( u, u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later + call IfW_FlowField_CopyFlowFieldType(p_AD%FlowField, FlowField_perturb_p, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return + call AD_CopyRotInflowType( RotInflow, RotInflow_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return + call AD_CopyRotInputType( u, u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ); if (Failed()) return call Perturb_u( p, i, -1, u_perturb, delta_m ) + call Perturb_uExtend( t, u_perturb, FlowField_perturb_p, RotInflow_perturb, p, OtherState, i, -1, u_perturb, delta_m, ErrStat2, ErrMsg2); if (Failed()) return - call AD_CopyRotConstraintStateType( z, z_copy, MESH_UPDATECOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call AD_CopyRotOtherStateType( OtherState, OtherState_copy, MESH_UPDATECOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + call AD_CopyRotConstraintStateType( z, z_copy, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return + call AD_CopyRotOtherStateType( OtherState, OtherState_copy, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return ! get updated z%phi values: - !call RotUpdateStates( t, 1, (/u_perturb/), (/t/), p, x_copy, xd_copy, z_copy, OtherState_copy, m, errStat2, errMsg2 ) - ! call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call SetInputs(p, p_AD, u_perturb, m, indx, errStat2, errMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - call UpdatePhi( m%BEMT_u(indx), p%BEMT, z_copy%BEMT%phi, p_AD%AFI, m%BEMT, OtherState_copy%BEMT%ValidPhi, errStat2, errMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later + call SetInputs(t, p, p_AD, u_perturb, RotInflow_perturb, m, indx, errStat2, errMsg2); if (Failed()) return + call UpdatePhi( m%BEMT_u(indx), p%BEMT, z_copy%BEMT%phi, p_AD%AFI, m%BEMT, OtherState_copy%BEMT%ValidPhi, errStat2, errMsg2 ); if (Failed()) return ! compute y at u_op - delta_m u - call RotCalcOutput( t, u_perturb, p, p_AD, x_init, xd, z_copy, OtherState_copy, y_m, m, m_AD, iRot, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later + call RotCalcOutput( t, u_perturb, RotInflow_perturb, p, p_AD, x_init, xd, z_copy, OtherState_copy, y_m, m, m_AD, iRot, ErrStat2, ErrMsg2 ); if (Failed()) return - ! get central difference: call Compute_dY( p, p_AD, y_p, y_m, delta_p, delta_m, dYdu(:,i) ) @@ -5262,37 +5816,33 @@ SUBROUTINE Rot_JacobianPInput( t, u, p, p_AD, x, xd, z, OtherState, y, m, m_AD, ! allocate dXdu if necessary if (.not. allocated(dXdu)) then - call AllocAry(dXdu, size(p%dx), size(p%Jac_u_indx,1), 'dXdu', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if + call AllocAry(dXdu, size(p%dx), size(p%Jac_u_indx,1), 'dXdu', ErrStat2, ErrMsg2); if (Failed()) return end if do i=1,size(p%Jac_u_indx,1) ! get u_op + delta u - call AD_CopyRotInputType( u, u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later + call IfW_FlowField_CopyFlowFieldType(p_AD%FlowField, FlowField_perturb_p, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return + call AD_CopyRotInflowType( RotInflow, RotInflow_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return + call AD_CopyRotInputType( u, u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ); if (Failed()) return call Perturb_u( p, i, 1, u_perturb, delta_p ) + call Perturb_uExtend( t, u_perturb, FlowField_perturb_p, RotInflow_perturb, p, OtherState, i, 1, u_perturb, delta_p, ErrStat2, ErrMsg2); if (Failed()) return ! compute x at u_op + delta u ! note that this routine updates z%phi instead of using the actual state value, so we don't need to call UpdateStates/UpdatePhi here to get z_op + delta_z: - call RotCalcContStateDeriv( t, u_perturb, p, p_AD, x_init, xd, z, OtherState_init, m, x_p, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - + call RotCalcContStateDeriv( t, u_perturb, RotInflow_perturb, p, p_AD, x_init, xd, z, OtherState_init, m, x_p, ErrStat2, ErrMsg2 ); if (Failed()) return ! get u_op - delta u - call AD_CopyRotInputType( u, u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later + call IfW_FlowField_CopyFlowFieldType(p_AD%FlowField, FlowField_perturb_p, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return + call AD_CopyRotInflowType( RotInflow, RotInflow_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return + call AD_CopyRotInputType( u, u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ); if (Failed()) return call Perturb_u( p, i, -1, u_perturb, delta_m ) - + call Perturb_uExtend( t, u_perturb, FlowField_perturb_p, RotInflow_perturb, p, OtherState, i, -1, u_perturb, delta_m, ErrStat2, ErrMsg2); if (Failed()) return + ! compute x at u_op - delta u ! note that this routine updates z%phi instead of using the actual state value, so we don't need to call UpdateStates here to get z_op + delta_z: - call RotCalcContStateDeriv( t, u_perturb, p, p_AD, x_init, xd, z, OtherState_init, m, x_m, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + call RotCalcContStateDeriv( t, u_perturb, RotInflow_perturb, p, p_AD, x_init, xd, z, OtherState_init, m, x_m, ErrStat2, ErrMsg2 ); if (Failed()) return ! get central difference: @@ -5322,21 +5872,26 @@ SUBROUTINE Rot_JacobianPInput( t, u, p, p_AD, x, xd, z, OtherState, y, m, m_AD, 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() m%BEMT%UseFrozenWake = .false. - call AD_DestroyRotOutputType( y_p, ErrStat2, ErrMsg2) call AD_DestroyRotOutputType( y_m, ErrStat2, ErrMsg2) - call AD_DestroyRotContinuousStateType( x_p, ErrStat2, ErrMsg2) - call AD_DestroyRotContinuousStateType( x_m, ErrStat2, ErrMsg2) - call AD_DestroyRotContinuousStateType( x_init, ErrStat2, ErrMsg2) - call AD_DestroyRotConstraintStateType( z_copy, ErrStat2, ErrMsg2) + call AD_DestroyRotContinuousStateType( x_p, ErrStat2, ErrMsg2) + call AD_DestroyRotContinuousStateType( x_m, ErrStat2, ErrMsg2) + call AD_DestroyRotContinuousStateType( x_init, ErrStat2, ErrMsg2) + call AD_DestroyRotConstraintStateType( z_copy, ErrStat2, ErrMsg2) call AD_DestroyRotOtherStateType( OtherState_copy, ErrStat2, ErrMsg2) call AD_DestroyRotOtherStateType( OtherState_init, ErrStat2, ErrMsg2) - call AD_DestroyRotInputType( u_perturb, ErrStat2, ErrMsg2 ) + call AD_DestroyRotInflowType( RotInflow_perturb, ErrStat2, ErrMsg2 ) + call IfW_FlowField_DestroyFlowFieldType( FlowField_perturb, ErrStat2, ErrMsg2 ) end subroutine cleanup - END SUBROUTINE Rot_JacobianPInput !> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions @@ -5379,7 +5934,7 @@ SUBROUTINE AD_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, return endif - call RotJacobianPContState( t, u%rotors(iR), p%rotors(iR), p, x%rotors(iR), xd%rotors(iR), z%rotors(iR), OtherState%rotors(iR), y%rotors(iR), m%rotors(iR), m, iR, ErrStat, ErrMsg, dYdx, dXdx, dXddx, dZdx ) + call RotJacobianPContState( t, u%rotors(iR), m%Inflow(1)%RotInflow(iR), p%rotors(iR), p, x%rotors(iR), xd%rotors(iR), z%rotors(iR), OtherState%rotors(iR), y%rotors(iR), m%rotors(iR), m, iR, ErrStat, ErrMsg, dYdx, dXdx, dXddx, dZdx ) END SUBROUTINE AD_JacobianPContState @@ -5387,11 +5942,12 @@ END SUBROUTINE AD_JacobianPContState !---------------------------------------------------------------------------------------------------------------------------------- !> 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 RotJacobianPContState( t, u, p, p_AD, x, xd, z, OtherState, y, m, m_AD, iRot, ErrStat, ErrMsg, dYdx, dXdx, dXddx, dZdx ) +SUBROUTINE RotJacobianPContState( t, u, RotInflow, p, p_AD, x, xd, z, OtherState, y, m, m_AD, iRot, ErrStat, ErrMsg, dYdx, dXdx, dXddx, dZdx ) !.................................................................................................................................. REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point TYPE(RotInputType), INTENT(IN ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) + TYPE(RotInflowType), INTENT(IN ) :: RotInflow !< Rotor inflow TYPE(RotParameterType), INTENT(IN ) :: p !< Parameters TYPE(AD_ParameterType), INTENT(IN ) :: p_AD !< Parameters TYPE(RotContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point @@ -5443,9 +5999,8 @@ SUBROUTINE RotJacobianPContState( t, u, p, p_AD, x, xd, z, OtherState, y, m, m_A ErrMsg = '' - if ( p%FrozenWake ) then - call SetInputs(p, p_AD, u, m, indx, errStat2, errMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if ( p%DBEMT_Mod == DBEMT_frozen ) then + call SetInputs(t, p, p_AD, u, RotInflow, m, indx, errStat2, errMsg2); if (Failed()) return; ! compare arguments with call to BEMT_CalcOutput call computeFrozenWake(m%BEMT_u(indx), p%BEMT, m%BEMT_y, m%BEMT ) @@ -5453,13 +6008,9 @@ SUBROUTINE RotJacobianPContState( t, u, p, p_AD, x, xd, z, OtherState, y, m, m_A end if - call AD_CopyRotContinuousStateType( x, x_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - call AD_CopyRotContinuousStateType( x, x_init, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call AD_CopyRotOtherStateType( OtherState, OtherState_init, MESH_NEWCOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + call AD_CopyRotContinuousStateType( x, x_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2 ); if (Failed()) return; + call AD_CopyRotContinuousStateType( x, x_init, MESH_NEWCOPY, ErrStat2, ErrMsg2 ); if (Failed()) return; + call AD_CopyRotOtherStateType( OtherState, OtherState_init, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return; if (ErrStat>=AbortErrLev) then call cleanup() @@ -5468,11 +6019,8 @@ SUBROUTINE RotJacobianPContState( t, u, p, p_AD, x, xd, z, OtherState, y, m, m_A ! initialize x_init so that we get accurrate values for if (.not. OtherState%BEMT%nodesInitialized ) then - call SetInputs(p, p_AD, u, m, indx, errStat2, errMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - call BEMT_InitStates(t, m%BEMT_u(indx), p%BEMT, x_init%BEMT, xd%BEMT, z%BEMT, OtherState_init%BEMT, m%BEMT, p_AD%AFI, ErrStat2, ErrMsg2 ) ! changes values only if states haven't been initialized - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + call SetInputs(t, p, p_AD, u, RotInflow, m, indx, errStat2, errMsg2); if (Failed()) return; + call BEMT_InitStates(t, m%BEMT_u(indx), p%BEMT, x_init%BEMT, xd%BEMT, z%BEMT, OtherState_init%BEMT, m%BEMT, p_AD%AFI, ErrStat2, ErrMsg2 ); if (Failed()) return; ! changes values only if states haven't been initialized end if @@ -5482,145 +6030,88 @@ SUBROUTINE RotJacobianPContState( t, u, p, p_AD, x, xd, z, OtherState, y, m, m_A ! allocate dYdx if necessary if (.not. allocated(dYdx)) then - call AllocAry(dYdx, p%Jac_ny, size(p%dx), 'dYdx', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if + call AllocAry(dYdx, p%Jac_ny, size(p%dx), '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 AD_CopyRotOutputType( y, y_p, MESH_NEWCOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call AD_CopyRotOutputType( y, y_m, MESH_NEWCOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if + call AD_CopyRotOutputType( y, y_p, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return; + call AD_CopyRotOutputType( y, y_m, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return; do i=1,size(p%dx) ! get x_op + delta_p x - call AD_CopyRotContinuousStateType( x_init, x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later + call AD_CopyRotContinuousStateType( x_init, x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ); if (Failed()) return; call Perturb_x( p, i, 1, x_perturb, delta_p ) ! compute y at x_op + delta_p x ! NOTE: z_op is the same as z because x_perturb does not affect the values of phi, thus I am not updating the states or calling UpdatePhi to get z_perturb. - call RotCalcOutput( t, u, p, p_AD, x_perturb, xd, z, OtherState_init, y_p, m, m_AD, iRot, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later + call RotCalcOutput( t, u, RotInflow, p, p_AD, x_perturb, xd, z, OtherState_init, y_p, m, m_AD, iRot, ErrStat2, ErrMsg2 ) ; if (Failed()) return; ! get x_op - delta_m x - call AD_CopyRotContinuousStateType( x_init, x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later + call AD_CopyRotContinuousStateType( x_init, x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ); if (Failed()) return; call Perturb_x( p, i, -1, x_perturb, delta_m ) ! compute y at x_op - delta_m x ! NOTE: z_op is the same as z because x_perturb does not affect the values of phi, thus I am not updating the states or calling UpdatePhi to get z_perturb. - call RotCalcOutput( t, u, p, p_AD, x_perturb, xd, z, OtherState_init, y_m, m, m_AD, iRot, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later + call RotCalcOutput( t, u, RotInflow, p, p_AD, x_perturb, xd, z, OtherState_init, y_m, m, m_AD, iRot, ErrStat2, ErrMsg2 ); if (Failed()) return; ! get central difference: call Compute_dY( p, p_AD, y_p, y_m, delta_p, delta_m, dYdx(:,i) ) end do - - - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if - call AD_DestroyRotOutputType( y_p, ErrStat2, ErrMsg2 ) ! we don't need this any more - call AD_DestroyRotOutputType( y_m, ErrStat2, ErrMsg2 ) ! we don't need this any more - 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 - - ! Calculate the partial derivative of the continuous state functions (X) with respect to the inputs (u) here: - ! allocate dXdx if necessary if (.not. allocated(dXdx)) then - call AllocAry(dXdx, size(p%dx), size(p%dx), 'dXdx', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if + call AllocAry(dXdx, size(p%dx), size(p%dx), 'dXdx', ErrStat2, ErrMsg2); if (Failed()) return; end if do i=1,size(p%dx,1) ! get x_op + delta x - call AD_CopyRotContinuousStateType( x_init, x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later + call AD_CopyRotContinuousStateType( x_init, x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ); if (Failed()) return; call Perturb_x( p, i, 1, x_perturb, delta_p ) ! compute X at x_op + delta x ! NOTE: z_op is the same as z because x_perturb does not affect the values of phi, thus I am not updating the states or calling UpdatePhi to get z_perturb. - call RotCalcContStateDeriv( t, u, p, p_AD, x_perturb, xd, z, OtherState_init, m, x_p, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + call RotCalcContStateDeriv( t, u, RotInflow, p, p_AD, x_perturb, xd, z, OtherState_init, m, x_p, ErrStat2, ErrMsg2 ); if (Failed()) return; ! get x_op - delta x - call AD_CopyRotContinuousStateType( x_init, x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later + call AD_CopyRotContinuousStateType( x_init, x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ); if (Failed()) return; call Perturb_x( p, i, -1, x_perturb, delta_m ) ! compute x at u_op - delta u ! NOTE: z_op is the same as z because x_perturb does not affect the values of phi, thus I am not updating the states or calling UpdatePhi to get z_perturb. - call RotCalcContStateDeriv( t, u, p, p_AD, x_perturb, xd, z, OtherState_init, m, x_m, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + call RotCalcContStateDeriv( t, u, RotInflow, p, p_AD, x_perturb, xd, z, OtherState_init, m, x_m, ErrStat2, ErrMsg2 ); if (Failed()) return; - ! get central difference: - - ! we may have had an error allocating memory, so we'll check - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if - ! get central difference: call Compute_dX( p, x_p, x_m, delta_p, delta_m, dXdx(:,i) ) end do - - call AD_DestroyRotContinuousStateType( x_p, ErrStat2, ErrMsg2 ) ! we don't need this any more - call AD_DestroyRotContinuousStateType( x_m, ErrStat2, ErrMsg2 ) ! we don't need this any more - - - 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 +! IF ( PRESENT( dXddx ) ) THEN +! END IF - - ! Calculate the partial derivative of the constraint state functions (Z) with respect to the continuous states (x) here: - - ! allocate and set dZdx - - END IF +! IF ( PRESENT( dZdx ) ) THEN +! 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() m%BEMT%UseFrozenWake = .false. @@ -5633,14 +6124,13 @@ subroutine cleanup() call AD_DestroyRotContinuousStateType( x_init, ErrStat2, ErrMsg2 ) call AD_DestroyRotOtherStateType( OtherState_init, ErrStat2, ErrMsg2 ) end subroutine cleanup - END SUBROUTINE RotJacobianPContState + + !---------------------------------------------------------------------------------------------------------------------------------- !> 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 AD_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(AD_InputType), INTENT(IN ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) TYPE(AD_ParameterType), INTENT(IN ) :: p !< Parameters @@ -5649,72 +6139,38 @@ SUBROUTINE AD_JacobianPDiscState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, TYPE(AD_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point TYPE(AD_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point TYPE(AD_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(AD_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 = '' + return; ! nothing to do here - 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 +! 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 AD_JacobianPDiscState -END SUBROUTINE AD_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 AD_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(AD_InputType), INTENT(IN ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) TYPE(AD_ParameterType), INTENT(IN ) :: p !< Parameters @@ -5723,25 +6179,14 @@ SUBROUTINE AD_JacobianPConstrState( t, u, p, x, xd, z, OtherState, y, m, ErrStat TYPE(AD_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point TYPE(AD_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point TYPE(AD_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 dYdz. TYPE(AD_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] - ! + integer(IntKi), parameter :: iR =1 ! Rotor index if (size(p%rotors)>1) then @@ -5750,17 +6195,18 @@ SUBROUTINE AD_JacobianPConstrState( t, u, p, x, xd, z, OtherState, y, m, ErrStat return endif - call RotJacobianPConstrState( t, u%rotors(iR), p%rotors(iR), p, x%rotors(iR), xd%rotors(iR), z%rotors(iR), OtherState%rotors(iR), y%rotors(iR), m%rotors(iR), m, iR, errStat, errMsg, dYdz, dXdz, dXddz, dZdz ) + call RotJacobianPConstrState( t, u%rotors(iR), m%Inflow(1)%RotInflow(iR), p%rotors(iR), p, x%rotors(iR), xd%rotors(iR), z%rotors(iR), OtherState%rotors(iR), y%rotors(iR), m%rotors(iR), m, iR, errStat, errMsg, dYdz, dXdz, dXddz, dZdz ) END SUBROUTINE AD_JacobianPConstrState + + !---------------------------------------------------------------------------------------------------------------------------------- !> 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 RotJacobianPConstrState( t, u, p, p_AD, x, xd, z, OtherState, y, m, m_AD, iRot, ErrStat, ErrMsg, dYdz, dXdz, dXddz, dZdz ) -!.................................................................................................................................. - +SUBROUTINE RotJacobianPConstrState( t, u, RotInflow, p, p_AD, x, xd, z, OtherState, y, m, m_AD, iRot, ErrStat, ErrMsg, dYdz, dXdz, dXddz, dZdz ) REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point TYPE(RotInputType), INTENT(IN ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) + TYPE(RotInflowType), INTENT(IN ) :: RotInflow !< Inflow on rotor TYPE(RotParameterType), INTENT(IN ) :: p !< Parameters TYPE(AD_ParameterType), INTENT(IN ) :: p_AD !< Parameters TYPE(RotContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point @@ -5768,26 +6214,15 @@ SUBROUTINE RotJacobianPConstrState( t, u, p, p_AD, x, xd, z, OtherState, y, m, m TYPE(RotConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point TYPE(RotOtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point TYPE(RotOutputType), 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 dYdz. TYPE(RotMiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables TYPE(AD_MiscVarType), INTENT(INOUT) :: m_AD !< misc variables INTEGER, INTENT(IN ) :: iRot !< Rotor index, needed for OLAF 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 TYPE(RotOutputType) :: y_p @@ -5804,24 +6239,17 @@ SUBROUTINE RotJacobianPConstrState( t, u, p, p_AD, x, xd, z, OtherState, y, m, m character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_JacobianPConstrState' - - ! local variables - - ! Initialize ErrStat - ErrStat = ErrID_None ErrMsg = '' ! get OP values here: !call AD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat2, ErrMsg2 ) ! (bjj: is this necessary? if not, still need to get BEMT inputs) - call SetInputs(p, p_AD, u, m, indx, errStat2, errMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - call BEMT_CopyInput( m%BEMT_u(indx), m%BEMT_u(op_indx), MESH_UPDATECOPY, ErrStat2, ErrMsg2) ! copy the BEMT OP inputs to a temporary location that won't be overwritten - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later + call SetInputs(t, p, p_AD, u, RotInflow, m, indx, errStat2, errMsg2); if (Failed()) return; + call BEMT_CopyInput( m%BEMT_u(indx), m%BEMT_u(op_indx), MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return; ! copy the BEMT OP inputs to a temporary location that won't be overwritten - if ( p%FrozenWake ) then + if ( p%DBEMT_Mod == DBEMT_frozen ) then ! compare arguments with call to BEMT_CalcOutput call computeFrozenWake(m%BEMT_u(op_indx), p%BEMT, m%BEMT_y, m%BEMT ) m%BEMT%UseFrozenWake = .true. @@ -5829,39 +6257,21 @@ SUBROUTINE RotJacobianPConstrState( t, u, p, p_AD, x, xd, z, OtherState, y, m, m ! make a copy of the constraint states to perturb - call AD_CopyRotConstraintStateType( z, z_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if - + call AD_CopyRotConstraintStateType( z, z_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return; - IF ( PRESENT( dYdz ) ) THEN - ! Calculate the partial derivative of the output functions (Y) with respect to the constraint states (z) here: + ! Calculate the partial derivative of the output functions (Y) with respect to the constraint states (z): + IF ( PRESENT( dYdz ) ) THEN ! allocate and set dYdz if (.not. allocated(dYdz) ) then - call AllocAry(dYdz,p%Jac_ny, size(z%BEMT%phi),'dYdz', ErrStat2, ErrMsg2) - call setErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if + call AllocAry(dYdz,p%Jac_ny, size(z%BEMT%phi),'dYdz', 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 AD_CopyRotOutputType( y, y_p, MESH_NEWCOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call AD_CopyRotOutputType( y, y_m, MESH_NEWCOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if - + call AD_CopyRotOutputType( y, y_p, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return; + call AD_CopyRotOutputType( y, y_m, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return; do k=1,p%NumBlades ! size(z%BEMT%Phi,2) do j=1,p%NumBlNds ! size(z%BEMT%Phi,1) @@ -5880,37 +6290,22 @@ SUBROUTINE RotJacobianPConstrState( t, u, p, p_AD, x, xd, z, OtherState, y, m, m z_perturb%BEMT%phi(j,k) = z%BEMT%phi(j,k) + delta_p ! compute y at z_op + delta_p z - call RotCalcOutput( t, u, p, p_AD, x, xd, z_perturb, OtherState, y_p, m, m_AD, iRot, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - + call RotCalcOutput( t, u, RotInflow, p, p_AD, x, xd, z_perturb, OtherState, y_p, m, m_AD, iRot, ErrStat2, ErrMsg2 ) ; if (Failed()) return; ! get z_op - delta_m z z_perturb%BEMT%phi(j,k) = z%BEMT%phi(j,k) - delta_m ! compute y at z_op - delta_m z - call RotCalcOutput( t, u, p, p_AD, x, xd, z_perturb, OtherState, y_m, m, m_AD, iRot, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - + call RotCalcOutput( t, u, RotInflow, p, p_AD, x, xd, z_perturb, OtherState, y_m, m, m_AD, iRot, ErrStat2, ErrMsg2 ) ; if (Failed()) return; ! get central difference: call Compute_dY( p, p_AD, y_p, y_m, delta_p, delta_m, dYdz(:,i) ) - ! put z_perturb back (for next iteration): z_perturb%BEMT%phi(j,k) = z%BEMT%phi(j,k) end if - end do end do - - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if - call AD_DestroyRotOutputType( y_p, ErrStat2, ErrMsg2 ) ! we don't need this any more - call AD_DestroyRotOutputType( y_m, ErrStat2, ErrMsg2 ) ! we don't need this any more - - END IF IF ( PRESENT( dXdz ) ) THEN @@ -5921,29 +6316,18 @@ SUBROUTINE RotJacobianPConstrState( t, u, p, p_AD, x, xd, z, OtherState, y, m, m if (allocated(dXddz)) deallocate(dXddz) END IF + + ! Calculate the partial derivative of the constraint state functions (Z) with respect to the constraint states (z): IF ( PRESENT(dZdz) ) THEN - call CheckLinearizationInput(p%BEMT, m%BEMT_u(op_indx), z%BEMT, m%BEMT, OtherState%BEMT, ErrStat2, ErrMsg2) - call setErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if - - ! Calculate the partial derivative of the constraint state functions (Z) with respect to the constraint states (z) here: + call CheckLinearizationInput(p%BEMT, m%BEMT_u(op_indx), z%BEMT, m%BEMT, OtherState%BEMT, ErrStat2, ErrMsg2) ; if (Failed()) return; ! allocate and set dZdz if (.not. allocated(dZdz)) then - call AllocAry(dZdz,size(z%BEMT%phi), size(z%BEMT%phi),'dZdz', ErrStat2, ErrMsg2) - call setErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if + call AllocAry(dZdz,size(z%BEMT%phi), size(z%BEMT%phi),'dZdz', ErrStat2, ErrMsg2); if (Failed()) return; end if - - call AD_CopyRotConstraintStateType( z, z_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) + call AD_CopyRotConstraintStateType( z, z_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ); if (Failed()) return; do k=1,p%NumBlades ! size(z%BEMT%Phi,2) do j=1,p%NumBlNds ! size(z%BEMT%Phi,1) @@ -5961,23 +6345,15 @@ SUBROUTINE RotJacobianPConstrState( t, u, p, p_AD, x, xd, z, OtherState, y, m, m z_perturb%BEMT%phi(j,k) = z%BEMT%phi(j,k) + delta_p ! compute z_p at z_op + delta_p z - call RotCalcConstrStateResidual( t, u, p, p_AD, x, xd, z_perturb, OtherState, m, z_p, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - + call RotCalcConstrStateResidual( t, u, RotInflow, p, p_AD, x, xd, z_perturb, OtherState, m, z_p, ErrStat2, ErrMsg2 ) ; if (Failed()) return; ! get z_op - delta_m z z_perturb%BEMT%phi(j,k) = z%BEMT%phi(j,k) - delta_m ! compute z_m at u_op - delta_m u - call RotCalcConstrStateResidual( t, u, p, p_AD, x, xd, z_perturb, OtherState, m, z_m, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if + call RotCalcConstrStateResidual( t, u, RotInflow, p, p_AD, x, xd, z_perturb, OtherState, m, z_m, ErrStat2, ErrMsg2 ) ; if (Failed()) return; ! get central difference: - do k2=1,p%NumBlades ! size(z%BEMT%Phi,2) do j2=1,p%NumBlNds ! size(z%BEMT%Phi,1) n = (k2-1)*p%NumBlNds + j2 @@ -5994,15 +6370,17 @@ SUBROUTINE RotJacobianPConstrState( t, u, p, p_AD, x, xd, z, OtherState, y, m, m end do end do - - call AD_DestroyRotConstraintStateType( z_p, ErrStat2, ErrMsg2 ) ! we don't need this any more - call AD_DestroyRotConstraintStateType( z_m, ErrStat2, ErrMsg2 ) ! we don't need this any more - 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() m%BEMT%UseFrozenWake = .false. @@ -6014,10 +6392,10 @@ subroutine cleanup() end subroutine cleanup END SUBROUTINE RotJacobianPConstrState + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ !> Routine to pack the data structures representing the operating points into arrays for linearization. SUBROUTINE AD_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(AD_InputType), INTENT(IN ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) TYPE(AD_ParameterType), INTENT(IN ) :: p !< Parameters @@ -6044,16 +6422,17 @@ SUBROUTINE AD_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, return endif - call RotGetOP( t, u%rotors(iR), p%rotors(iR), p, x%rotors(iR), xd%rotors(iR), z%rotors(iR), OtherState%rotors(iR), y%rotors(iR), m%rotors(iR), errStat, errMsg, u_op, y_op, x_op, dx_op, xd_op, z_op ) + call RotGetOP( t, u%rotors(iR), m%Inflow(1)%RotInflow(iR), p%rotors(iR), p, x%rotors(iR), xd%rotors(iR), z%rotors(iR), OtherState%rotors(iR), y%rotors(iR), m%rotors(iR), errStat, errMsg, u_op, y_op, x_op, dx_op, xd_op, z_op ) END SUBROUTINE AD_GetOP !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ !> Routine to pack the data structures representing the operating points into arrays for linearization. -SUBROUTINE RotGetOP( t, u, p, p_AD, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, y_op, x_op, dx_op, xd_op, z_op ) - +!! NOTE: the order here needs to exactly match the order in Init_Jacobian_u. +SUBROUTINE RotGetOP( t, u, RotInflow, p, p_AD, 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(RotInputType), INTENT(IN ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) + TYPE(RotInflowType), INTENT(IN ) :: RotInflow !< Rotor Inflow at operating point (may change to inout if a mesh copy is required) TYPE(RotParameterType), INTENT(IN ) :: p !< Parameters TYPE(AD_ParameterType), INTENT(IN ) :: p_AD !< Parameters TYPE(RotContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point @@ -6071,136 +6450,188 @@ SUBROUTINE RotGetOP( t, u, p, p_AD, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, 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) :: index, i, j, k + INTEGER(IntKi) :: index, i, j, k, n INTEGER(IntKi) :: nu INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD_GetOP' LOGICAL :: FieldMask(FIELDMASK_SIZE) TYPE(RotContinuousStateType) :: dxdt + real(ReKi) :: OP_out(3) !< operating point of wind (HWindSpeed, PLexp, and AngleH) + - ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = '' IF ( PRESENT( u_op ) ) THEN - - nu = size(p%Jac_u_indx,1) + u%TowerMotion%NNodes * 6 & ! Jac_u_indx has 3 orientation angles, but the OP needs the full 9 elements of the DCM - + u%hubMotion%NNodes * 6 ! Jac_u_indx has 3 orientation angles, but the OP needs the full 9 elements of the DCM - do i=1,p%NumBlades - nu = nu + u%BladeMotion(i)%NNodes * 6 & ! Jac_u_indx has 3 orientation angles, but the OP needs the full 9 elements of the DCM - + u%BladeRootMotion(i)%NNodes * 6 ! Jac_u_indx has 3 orientation angles, but the OP needs the full 9 elements of the DCM - end do - + nu = size(p%Jac_u_indx,1) + do i=1,p%NumBl_Lin + nu = nu + u%BladeMotion(i)%NNodes * 6 ! Jac_u_indx has 3 orientation angles, but the OP needs the full 9 elements of the DCM + end do + + if (.not. p_AD%CompAeroMaps) then + nu = nu + u%NacelleMotion%NNodes * 6 & ! Jac_u_indx has 3 orientation angles, but the OP needs the full 9 elements of the DCM + + u%HubMotion%NNodes * 6 & ! Jac_u_indx has 3 orientation angles, but the OP needs the full 9 elements of the DCM + + u%TowerMotion%NNodes * 6 & ! Jac_u_indx has 3 orientation angles, but the OP needs the full 9 elements of the DCM + + u%TFinMotion%NNodes * 6 ! Jac_u_indx has 3 orientation angles, but the OP needs the full 9 elements of the DCM + do i=1,p%NumBlades + nu = nu + u%BladeRootMotion(i)%NNodes * 6 ! Jac_u_indx has 3 orientation angles, but the OP needs the full 9 elements of the DCM + end do + end if + if (.not. allocated(u_op)) then - call AllocAry(u_op, nu, 'u_op', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return + call AllocAry(u_op, nu, 'u_op', ErrStat2, ErrMsg2); if (Failed()) return end if - + index = 1 - FieldMask = .false. - FieldMask(MASKID_TRANSLATIONDISP) = .true. - FieldMask(MASKID_Orientation) = .true. - FieldMask(MASKID_TRANSLATIONVel) = .true. - call PackMotionMesh(u%TowerMotion, u_op, index, FieldMask=FieldMask) - - FieldMask(MASKID_TRANSLATIONVel) = .false. - FieldMask(MASKID_RotationVel) = .true. - call PackMotionMesh(u%HubMotion, u_op, index, FieldMask=FieldMask) - - FieldMask = .false. - FieldMask(MASKID_Orientation) = .true. - do k = 1,p%NumBlades - call PackMotionMesh(u%BladeRootMotion(k), u_op, index, FieldMask=FieldMask) - end do - - FieldMask(MASKID_TRANSLATIONDISP) = .true. - FieldMask(MASKID_Orientation) = .true. - FieldMask(MASKID_TRANSLATIONVel) = .true. - FieldMask(MASKID_RotationVel) = .true. - FieldMask(MASKID_TRANSLATIONAcc) = .true. - do k=1,p%NumBlades - call PackMotionMesh(u%BladeMotion(k), u_op, index, FieldMask=FieldMask) - end do - - do k=1,p%NumBlades - do i=1,p%NumBlNds - do j=1,3 - u_op(index) = u%InflowOnBlade(j,i,k) - index = index + 1 - end do + if (.not. p_AD%CompAeroMaps) then + !------------------------------ + ! Nacelle + ! Module/Mesh/Field: u%NacelleMotion%TranslationDisp + ! Module/Mesh/Field: u%NacelleMotion%Orientation + FieldMask = .false. + FieldMask(MASKID_TRANSLATIONDISP) = .true. + FieldMask(MASKID_ORIENTATION) = .true. + call PackMotionMesh(u%NacelleMotion, u_op, index, FieldMask=FieldMask) + + !------------------------------ + ! Hub + ! Module/Mesh/Field: u%HubMotion%TranslationDisp + ! Module/Mesh/Field: u%HubMotion%Orientation + ! Module/Mesh/Field: u%HubMotion%RotationVel + FieldMask = .false. + FieldMask(MASKID_TRANSLATIONDISP) = .true. + FieldMask(MASKID_ORIENTATION) = .true. + FieldMask(MASKID_ROTATIONVEL) = .true. + call PackMotionMesh(u%HubMotion, u_op, index, FieldMask=FieldMask) + + !------------------------------ + ! TailFin + ! Module/Mesh/Field: u%TFinMotion%TranslationDisp + ! Module/Mesh/Field: u%TFinMotion%Orientation + ! Module/Mesh/Field: u%TFinMotion%TranslationVel + FieldMask = .false. + FieldMask(MASKID_TRANSLATIONDISP) = .true. + FieldMask(MASKID_ORIENTATION) = .true. + FieldMask(MASKID_TRANSLATIONVEL) = .true. + call PackMotionMesh(u%TFinMotion, u_op, index, FieldMask=FieldMask) + + !------------------------------ + ! Tower + ! Module/Mesh/Field: u%TowerMotion%TranslationDisp + ! Module/Mesh/Field: u%TowerMotion%Orientation + ! Module/Mesh/Field: u%TowerMotion%TranslationVel + ! Module/Mesh/Field: u%TowerMotion%TranslationAcc + FieldMask = .false. + FieldMask(MASKID_TRANSLATIONDISP) = .true. + FieldMask(MASKID_ORIENTATION) = .true. + FieldMask(MASKID_TRANSLATIONVEL) = .true. + FieldMask(MASKID_TRANSLATIONACC) = .true. + call PackMotionMesh(u%TowerMotion, u_op, index, FieldMask=FieldMask) + + !------------------------------ + ! Blade Root + ! Module/Mesh/Field: u%BladeRootMotion(1)%Orientation + ! Module/Mesh/Field: u%BladeRootMotion(2)%Orientation + ! Module/Mesh/Field: u%BladeRootMotion(3)%Orientation + FieldMask = .false. + FieldMask(MASKID_ORIENTATION) = .true. + do k = 1,p%NumBlades + call PackMotionMesh(u%BladeRootMotion(k), u_op, index, FieldMask=FieldMask) end do - end do + endif - do i=1,p%NumTwrNds - do j=1,3 - u_op(index) = u%InflowOnTower(j,i) - index = index + 1 - end do + + !------------------------------ + ! Blade + ! Module/Mesh/Field: u%BladeMotion(k)%TranslationDisp + ! Module/Mesh/Field: u%BladeMotion(k)%Orientation + ! Module/Mesh/Field: u%BladeMotion(k)%TranslationVel + ! Module/Mesh/Field: u%BladeMotion(k)%RotationVel + ! Module/Mesh/Field: u%BladeMotion(k)%TranslationAcc + ! Module/Mesh/Field: u%BladeMotion(k)%RotationalAcc + if (.not. p_AD%CompAeroMaps) then + 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. + else + FieldMask = .false. + FieldMask(MASKID_TRANSLATIONDISP) = .true. + FieldMask(MASKID_ORIENTATION) = .true. + FieldMask(MASKID_TRANSLATIONVel) = .true. + end if + do k=1,p%NumBl_Lin + call PackMotionMesh(u%BladeMotion(k), u_op, index, FieldMask=FieldMask) end do - do k=1,p%NumBlades - do j = 1, size(u%UserProp,1) ! Number of nodes for a blade - u_op(index) = u%UserProp(j,k) - index = index + 1 + if (.not. p_AD%CompAeroMaps) then + !------------------------------ + ! UserProp + ! Module/Mesh/Field: u%UserProp(:,:) + do k=1,p%NumBlades + do j = 1, size(u%UserProp,1) ! Number of nodes for a blade + u_op(index) = u%UserProp(j,k) + index = index + 1 + end do end do - end do - - ! I'm not including this in the linearization yet - !do i=1,u%NacelleMotion%NNodes ! 1 or 0 - ! do j=1,3 - ! u_op(index) = u%InflowOnNacelle(j) - ! index = index + 1 - ! end do - !end do - ! - !do i=1,u%HubMotion%NNodes ! 1 - ! do j=1,3 - ! u_op(index) = u%InflowOnHub(j) - ! index = index + 1 - ! end do - !end do + + !------------------------------ + ! Extended inputs -- Linearization is only possible with Steady or Uniform Wind, so take advantage of that here + ! Module/Mesh/Field: HWindSpeed = 37 + ! Module/Mesh/Field: PLexp = 38 + ! Module/Mesh/Field: PropagationDir = 39 + call IfW_UniformWind_GetOP(p_AD%FlowField%Uniform, t, .false. , OP_out) + ! HWindSpeed + u_op(index) = OP_out(1); index = index + 1 + ! PLexp + u_op(index) = OP_out(2); index = index + 1 + ! PropagationDir (include AngleH in calculation if any) + u_op(index) = OP_out(3) + p_AD%FlowField%PropagationDir; index = index + 1 + end if END IF IF ( PRESENT( y_op ) ) THEN - + if (.not. allocated(y_op)) then - call AllocAry(y_op, p%Jac_ny, 'y_op', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return + call AllocAry(y_op, p%Jac_ny, 'y_op', ErrStat2, ErrMsg2); if (Failed()) return end if - - index = 1 - call PackLoadMesh(y%TowerLoad, y_op, index) - do k=1,p%NumBlades - call PackLoadMesh(y%BladeLoad(k), y_op, index) + if (.not. p_AD%CompAeroMaps) then + call PackLoadMesh(y%NacelleLoad, y_op, index) + call PackLoadMesh(y%HubLoad, y_op, index) + call PackLoadMesh(y%TFinLoad, y_op, index) + call PackLoadMesh(y%TowerLoad, y_op, index) + endif + do k=1,p%NumBl_Lin + call PackLoadMesh(y%BladeLoad(k), y_op, index) end do - - index = index - 1 - do i=1,p%NumOuts + p%BldNd_TotNumOuts - y_op(i+index) = y%WriteOutput(i) - end do - - + + if (.not. p_AD%CompAeroMaps) then + index = index - 1 + do i=1,p%NumOuts + p%BldNd_TotNumOuts + y_op(i+index) = y%WriteOutput(i) + end do + end if + END IF IF ( PRESENT( x_op ) ) THEN - + if (.not. allocated(x_op)) then - call AllocAry(x_op, p%BEMT%DBEMT%lin_nx + p%BEMT%UA%lin_nx,'x_op',ErrStat2,ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) return + call AllocAry(x_op, p%BEMT%DBEMT%lin_nx + p%BEMT%UA%lin_nx + p%BEMT%lin_nx,'x_op',ErrStat2,ErrMsg2); if (Failed()) return end if index = 1 - ! set linearization operating points: + ! set linearization operating points: if (p%BEMT%DBEMT%lin_nx>0) then do j=1,p%NumBlades ! size(x%BEMT%DBEMT%element,2) do i=1,p%NumBlNds ! size(x%BEMT%DBEMT%element,1) @@ -6210,7 +6641,7 @@ SUBROUTINE RotGetOP( t, u, p, p_AD, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, end do end do end do - + do j=1,p%NumBlades ! size(x%BEMT%DBEMT%element,2) do i=1,p%NumBlNds ! size(x%BEMT%DBEMT%element,1) do k=1,size(x%BEMT%DBEMT%element(i,j)%vind_1) @@ -6219,47 +6650,38 @@ SUBROUTINE RotGetOP( t, u, p, p_AD, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, end do end do end do - end if - + + ! UA states if (p%BEMT%UA%lin_nx>0) then - if (p%BEMT%UA%UAMod==UA_OYE) then - do j=1,p%NumBlades ! size(x%BEMT%UA%element,2) - do i=1,p%NumBlNds ! size(x%BEMT%UA%element,1) - x_op(index) = x%BEMT%UA%element(i,j)%x(4) - index = index + 1 - end do - end do - else - do j=1,p%NumBlades ! size(x%BEMT%UA%element,2) - do i=1,p%NumBlNds ! size(x%BEMT%UA%element,1) - do k=1,4 !size(x%BEMT%UA%element(i,j)%x) !linearize only first 4 states (5th is vortex) - x_op(index) = x%BEMT%UA%element(i,j)%x(k) - index = index + 1 - end do - end do - end do - endif - + do n=1,p%BEMT%UA%lin_nx + i = p%BEMT%UA%lin_xIndx(n,1) + j = p%BEMT%UA%lin_xIndx(n,2) + k = p%BEMT%UA%lin_xIndx(n,3) + x_op(index) = x%BEMT%UA%element(i,j)%x(k) + + index = index + 1 + end do end if - + + ! BEMT states + if (p%BEMT%lin_nx>0) then + !do k = 1,size(x%BEMT%V_w) + ! x_op(index) = x%BEMT%v_w(k) + ! index = index + 1 + !end do + end if + END IF IF ( PRESENT( dx_op ) ) THEN - + if (.not. allocated(dx_op)) then - call AllocAry(dx_op, p%BEMT%DBEMT%lin_nx + p%BEMT%UA%lin_nx,'dx_op',ErrStat2,ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) return + call AllocAry(dx_op, p%BEMT%DBEMT%lin_nx + p%BEMT%UA%lin_nx + p%BEMT%lin_nx,'dx_op',ErrStat2,ErrMsg2); if (Failed()) return end if - call RotCalcContStateDeriv(t, u, p, p_AD, x, xd, z, OtherState, m, dxdt, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call AD_DestroyRotContinuousStateType( dxdt, ErrStat2, ErrMsg2) - return - end if - + call RotCalcContStateDeriv(t, u, RotInflow, p, p_AD, x, xd, z, OtherState, m, dxdt, ErrStat2, ErrMsg2); if (Failed()) return + index = 1 ! set linearization operating points: if (p%BEMT%DBEMT%lin_nx>0) then @@ -6272,7 +6694,7 @@ SUBROUTINE RotGetOP( t, u, p, p_AD, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, end do end do end do - + do j=1,p%NumBlades ! size(dxdt%BEMT%DBEMT%element,2) do i=1,p%NumBlNds ! size(dxdt%BEMT%DBEMT%element,1) do k=1,size(dxdt%BEMT%DBEMT%element(i,j)%vind_1) @@ -6281,46 +6703,44 @@ SUBROUTINE RotGetOP( t, u, p, p_AD, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, end do end do end do - + end if - + ! UA states derivatives if (p%BEMT%UA%lin_nx>0) then - if (p%BEMT%UA%UAMod==UA_OYE) then - do j=1,p%NumBlades ! size(dxdt%BEMT%UA%element,2) - do i=1,p%NumBlNds ! size(dxdt%BEMT%UA%element,1) - dx_op(index) = dxdt%BEMT%UA%element(i,j)%x(4) - index = index + 1 - end do - end do - else - do j=1,p%NumBlades ! size(dxdt%BEMT%UA%element,2) - do i=1,p%NumBlNds ! size(dxdt%BEMT%UA%element,1) - do k=1,4 !size(dxdt%BEMT%UA%element(i,j)%x) don't linearize 5th state - dx_op(index) = dxdt%BEMT%UA%element(i,j)%x(k) - index = index + 1 - end do - end do - end do - endif - end if - - call AD_DestroyRotContinuousStateType( dxdt, ErrStat2, ErrMsg2) - - END IF - - IF ( PRESENT( xd_op ) ) THEN + do n=1,p%BEMT%UA%lin_nx + i = p%BEMT%UA%lin_xIndx(n,1) + j = p%BEMT%UA%lin_xIndx(n,2) + k = p%BEMT%UA%lin_xIndx(n,3) + dx_op(index) = dxdt%BEMT%UA%element(i,j)%x(k) + + index = index + 1 + end do + end if + ! BEMT states derivatives + if (p%BEMT%lin_nx>0) then + ErrStat2=ErrID_Fatal + ErrMsg2='Number of lin states for bem should be zero for now.' + if (Failed()) return + !do k = 1,size(x%BEMT%V_w) + ! dx_op(index) = dxdt%BEMT%v_w(k) + ! index = index + 1 + !end do + end if + END IF - + + IF ( PRESENT( xd_op ) ) THEN + + END IF + IF ( PRESENT( z_op ) ) THEN if (.not. allocated(z_op)) then - call AllocAry(z_op, p%NumBlades*p%NumBlNds, 'z_op', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return + call AllocAry(z_op, p%NumBlades*p%NumBlNds, 'z_op', ErrStat2, ErrMsg2); if (Failed()) return end if - - + + index = 1 do k=1,p%NumBlades ! size(z%BEMT%Phi,2) do i=1,p%NumBlNds ! size(z%BEMT%Phi,1) @@ -6328,22 +6748,33 @@ SUBROUTINE RotGetOP( t, u, p, p_AD, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, index = index + 1 end do end do - + END IF +contains + logical function Failed() + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + Failed = ErrStat >= AbortErrLev + if (Failed) call Cleanup() + end function Failed + + subroutine cleanup() + call AD_DestroyRotContinuousStateType( dxdt, ErrStat2, ErrMsg2) + end subroutine cleanup END SUBROUTINE RotGetOP -!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -SUBROUTINE Init_Jacobian_y( p, y, InitOut, ErrStat, ErrMsg) + +!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +SUBROUTINE Init_Jacobian_y( p, p_AD, y, InitOut, ErrStat, ErrMsg) TYPE(RotParameterType) , INTENT(INOUT) :: p !< parameters + TYPE(AD_ParameterType) , INTENT(INOUT) :: p_AD !< parameters TYPE(RotOutputType) , INTENT(IN ) :: y !< outputs TYPE(RotInitOutputType) , 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 ! local variables: - INTEGER(IntKi) :: i, j, k, indx_next, indx_last + INTEGER(IntKi) :: i, j, k, indx_next, indx_last INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Init_Jacobian_y' @@ -6354,390 +6785,453 @@ SUBROUTINE Init_Jacobian_y( p, y, InitOut, ErrStat, ErrMsg) ErrMsg = "" - ! determine how many outputs there are in the Jacobians - p%Jac_ny = y%TowerLoad%NNodes * 6 & ! 3 forces + 3 moments at each node - + p%NumOuts + p%BldNd_TotNumOuts ! WriteOutput values - - do k=1,p%NumBlades + ! determine how many outputs there are in the Jacobians + if (p_AD%CompAeroMaps) then + p%Jac_ny = 0 ! we skip tower and writeOutput values in the solve (note: y%TowerLoad%NNodes=0) + else + p%Jac_ny = y%NacelleLoad%NNodes * 6 & ! 3 forces + 3 moments at each node + + y%HubLoad%NNodes * 6 & ! 3 forces + 3 moments at each node + + y%TFinLoad%NNodes * 6 & ! 3 forces + 3 moments at each node + + y%TowerLoad%NNodes * 6 & ! 3 forces + 3 moments at each node + + p%NumOuts + p%BldNd_TotNumOuts ! WriteOutput values + end if + + do k=1,p%NumBl_Lin p%Jac_ny = p%Jac_ny + y%BladeLoad(k)%NNodes * 6 ! 3 forces + 3 moments at each node end do ! get the names of the linearized outputs: - call AllocAry(InitOut%LinNames_y, p%Jac_ny,'LinNames_y',ErrStat2,ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call AllocAry(InitOut%RotFrame_y, p%Jac_ny,'RotFrame_y',ErrStat2,ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat >= AbortErrLev) return + call AllocAry(InitOut%LinNames_y, p%Jac_ny,'LinNames_y',ErrStat2,ErrMsg2); if (Failed()) return + call AllocAry(InitOut%RotFrame_y, p%Jac_ny,'RotFrame_y',ErrStat2,ErrMsg2); if (Failed()) return InitOut%RotFrame_y = .false. ! default all to false, then set the true ones below indx_next = 1 - call PackLoadMesh_Names(y%TowerLoad, 'Tower', InitOut%LinNames_y, indx_next) + if (.not. p_AD%CompAeroMaps) then + p%Jac_y_idxStartList%NacelleLoad = indx_next; call PackLoadMesh_Names(y%NacelleLoad, 'Nacelle', InitOut%LinNames_y, indx_next) + p%Jac_y_idxStartList%HubLoad = indx_next; call PackLoadMesh_Names(y%HubLoad, 'Hub', InitOut%LinNames_y, indx_next) + p%Jac_y_idxStartList%TFinLoad = indx_next; call PackLoadMesh_Names(y%TFinLoad, 'TailFin', InitOut%LinNames_y, indx_next) + p%Jac_y_idxStartList%TowerLoad = indx_next; call PackLoadMesh_Names(y%TowerLoad, 'Tower', InitOut%LinNames_y, indx_next) ! note: y%TowerLoad%NNodes=0 for aeroMaps + endif indx_last = indx_next - do k=1,p%NumBlades + p%Jac_y_idxStartList%BladeLoad = indx_next; + do k=1,p%NumBl_Lin call PackLoadMesh_Names(y%BladeLoad(k), 'Blade '//trim(num2lstr(k)), InitOut%LinNames_y, indx_next) end do ! InitOut%RotFrame_y(indx_last:indx_next-1) = .true. ! The mesh fields are in the global frame, so are not in the rotating frame - do i=1,p%NumOuts + p%BldNd_TotNumOuts - InitOut%LinNames_y(i+indx_next-1) = trim(InitOut%WriteOutputHdr(i))//', '//trim(InitOut%WriteOutputUnt(i)) !trim(p%OutParam(i)%Name)//', '//p%OutParam(i)%Units - end do + if (.not. p_AD%CompAeroMaps) then + ! Outputs + do i=1,p%NumOuts + p%BldNd_TotNumOuts + InitOut%LinNames_y(i+indx_next-1) = trim(InitOut%WriteOutputHdr(i))//', '//trim(InitOut%WriteOutputUnt(i)) !trim(p%OutParam(i)%Name)//', '//p%OutParam(i)%Units + end do - - ! check for all the WriteOutput values that are functions of blade number: - allocate( AllOut(0:MaxOutPts), STAT=ErrStat2 ) ! allocate starting at zero to account for invalid output channels - if (ErrStat2 /=0 ) then - call SetErrStat(ErrID_Info, 'error allocating temporary space for AllOut',ErrStat,ErrMsg,RoutineName) - return; - end if + ! check for all the WriteOutput values that are functions of blade number: + allocate( AllOut(0:MaxOutPts), STAT=ErrStat2 ) ! allocate starting at zero to account for invalid output channels + if (ErrStat2 /=0 ) then + ErrStat2 = ErrID_Info + ErrMsg2 = 'error allocating temporary space for AllOut' + if (Failed()) return + end if - AllOut = .false. - do k=1,3 - AllOut( BAzimuth(k)) = .true. - AllOut( BPitch (k)) = .true. - - ! AllOut( BFldFx( k)) = .true. - ! AllOut( BFldFy( k)) = .true. - ! AllOut( BFldFz( k)) = .true. - ! AllOut( BFldMx( k)) = .true. - ! AllOut( BFldMy( k)) = .true. - ! AllOut( BFldMz( k)) = .true. - - do j=1,9 - AllOut(BNVUndx(j,k)) = .true. - AllOut(BNVUndy(j,k)) = .true. - AllOut(BNVUndz(j,k)) = .true. - AllOut(BNVDisx(j,k)) = .true. - AllOut(BNVDisy(j,k)) = .true. - AllOut(BNVDisz(j,k)) = .true. - AllOut(BNSTVx (j,k)) = .true. - AllOut(BNSTVy (j,k)) = .true. - AllOut(BNSTVz (j,k)) = .true. - AllOut(BNVRel (j,k)) = .true. - AllOut(BNDynP (j,k)) = .true. - AllOut(BNRe (j,k)) = .true. - AllOut(BNM (j,k)) = .true. - AllOut(BNVIndx(j,k)) = .true. - AllOut(BNVIndy(j,k)) = .true. - AllOut(BNAxInd(j,k)) = .true. - AllOut(BNTnInd(j,k)) = .true. - AllOut(BNAlpha(j,k)) = .true. - AllOut(BNTheta(j,k)) = .true. - AllOut(BNPhi (j,k)) = .true. - AllOut(BNCurve(j,k)) = .true. - AllOut(BNCl (j,k)) = .true. - AllOut(BNCd (j,k)) = .true. - AllOut(BNCm (j,k)) = .true. - AllOut(BNCx (j,k)) = .true. - AllOut(BNCy (j,k)) = .true. - AllOut(BNCn (j,k)) = .true. - AllOut(BNCt (j,k)) = .true. - AllOut(BNFl (j,k)) = .true. - AllOut(BNFd (j,k)) = .true. - AllOut(BNMm (j,k)) = .true. - AllOut(BNFx (j,k)) = .true. - AllOut(BNFy (j,k)) = .true. - AllOut(BNFn (j,k)) = .true. - AllOut(BNFt (j,k)) = .true. - AllOut(BNClrnc(j,k)) = .true. + AllOut = .false. + do k=1,3 + AllOut( BAzimuth(k)) = .true. + AllOut( BPitch (k)) = .true. + + AllOut( BAeroFx( k)) = .true. + AllOut( BAeroFy( k)) = .true. + AllOut( BAeroFz( k)) = .true. + AllOut( BAeroMx( k)) = .true. + AllOut( BAeroMy( k)) = .true. + AllOut( BAeroMz( k)) = .true. + !AllOut( TipClrnc(k)) = .true. + + do j=1,9 + AllOut(BNVUndx(j,k)) = .true. + AllOut(BNVUndy(j,k)) = .true. + AllOut(BNVUndz(j,k)) = .true. + AllOut(BNVDisx(j,k)) = .true. + AllOut(BNVDisy(j,k)) = .true. + AllOut(BNVDisz(j,k)) = .true. + AllOut(BNSTVx (j,k)) = .true. + AllOut(BNSTVy (j,k)) = .true. + AllOut(BNSTVz (j,k)) = .true. + AllOut(BNVRel (j,k)) = .true. + AllOut(BNDynP (j,k)) = .true. + AllOut(BNRe (j,k)) = .true. + AllOut(BNM (j,k)) = .true. + AllOut(BNVIndx(j,k)) = .true. + AllOut(BNVIndy(j,k)) = .true. + AllOut(BNAxInd(j,k)) = .true. + AllOut(BNTnInd(j,k)) = .true. + AllOut(BNAlpha(j,k)) = .true. + AllOut(BNTheta(j,k)) = .true. + AllOut(BNPhi (j,k)) = .true. + AllOut(BNCurve(j,k)) = .true. + AllOut(BNCl (j,k)) = .true. + AllOut(BNCd (j,k)) = .true. + AllOut(BNCm (j,k)) = .true. + AllOut(BNCx (j,k)) = .true. + AllOut(BNCy (j,k)) = .true. + AllOut(BNCn (j,k)) = .true. + AllOut(BNCt (j,k)) = .true. + AllOut(BNFl (j,k)) = .true. + AllOut(BNFd (j,k)) = .true. + AllOut(BNMm (j,k)) = .true. + AllOut(BNFx (j,k)) = .true. + AllOut(BNFy (j,k)) = .true. + AllOut(BNFn (j,k)) = .true. + AllOut(BNFt (j,k)) = .true. + AllOut(BNClrnc(j,k)) = .true. + end do end do - end do - do i=1,p%NumOuts - InitOut%RotFrame_y(i+indx_next-1) = AllOut( p%OutParam(i)%Indx ) - end do + do i=1,p%NumOuts + InitOut%RotFrame_y(i+indx_next-1) = AllOut( p%OutParam(i)%Indx ) + end do - do i=1,p%BldNd_TotNumOuts - InitOut%RotFrame_y(i+p%NumOuts+indx_next-1) = .true. - !AbsCant, AbsToe, AbsTwist should probably be set to .false. - end do + do i=1,p%BldNd_TotNumOuts + InitOut%RotFrame_y(i+p%NumOuts+indx_next-1) = .true. + !AbsCant, AbsToe, AbsTwist should probably be set to .false. + end do - - deallocate(AllOut) - + 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() + if (allocated(AllOut)) deallocate(AllOut) + end subroutine Cleanup END SUBROUTINE Init_Jacobian_y -!---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE Init_Jacobian_u( InputFileData, p, u, InitOut, ErrStat, ErrMsg) + +!---------------------------------------------------------------------------------------------------------------------------------- +SUBROUTINE Init_Jacobian_u( InputFileData, p, p_AD, u, InitOut, ErrStat, ErrMsg) TYPE(RotInputFile) , INTENT(IN ) :: InputFileData !< input file data (for default blade perturbation) TYPE(RotParameterType) , INTENT(INOUT) :: p !< parameters + TYPE(AD_ParameterType) , INTENT(INOUT) :: p_AD !< parameters TYPE(RotInputType) , INTENT(IN ) :: u !< inputs TYPE(RotInitOutputType) , 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 - + ! local variables: - INTEGER(IntKi) :: i, j, k, index, index_last, nu, i_meshField - REAL(ReKi) :: perturb, perturb_t, perturb_b(MaxBl) + INTEGER(IntKi) :: i, j, k, index, indexNames, index_last, nu, i_meshField + INTEGER(IntKi) :: NumFieldsForLinearization + REAL(ReKi) :: perturb, perturb_t, perturb_b(AD_MaxBl_Out) LOGICAL :: FieldMask(FIELDMASK_SIZE) CHARACTER(1), PARAMETER :: UVW(3) = (/'U','V','W'/) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Init_Jacobian_u' - + ErrStat = ErrID_None ErrMsg = "" - - + + p%NumExtendedInputs = 3 ! Extended inputs from InflowWind: HWindSpeed, PLexp, PropagationDir + ! determine how many inputs there are in the Jacobians - nu = u%TowerMotion%NNodes * 9 & ! 3 Translation Displacements + 3 orientations + 3 Translation velocities at each node - + u%hubMotion%NNodes * 9 & ! 3 Translation Displacements + 3 orientations + 3 Rotation velocities at each node - + size( u%InflowOnBlade) & - + size( u%InflowOnTower) & !note that we are not passing the inflow on nacelle or hub here - + size( u%UserProp) - - do i=1,p%NumBlades - nu = nu + u%BladeMotion(i)%NNodes * 15 & ! 3 Translation Displacements + 3 orientations + 3 Translation velocities + 3 Rotation velocities + 3 TranslationAcc at each node - + u%BladeRootMotion(i)%NNodes * 3 ! 3 orientations at each node - end do - + if (p_AD%CompAeroMaps) then + nu = 0 + + NumFieldsForLinearization = 3 ! Translation Displacements + orientations + Translation velocities at each node on the blade mesh + else + nu = u%NacelleMotion%NNodes * 6 & ! 3 Translation Displacements + 3 orientations + + u%hubMotion%NNodes * 9 & ! 3 Translation Displacements + 3 orientations + 3 Rotation velocities + + u%TowerMotion%NNodes * 12 & ! 3 Translation Displacements + 3 orientations + 3 Translation velocities + 3 Translation Accelerations + + u%TFinMotion%NNodes * 9 & ! 3 Translation Displacements + 3 orientations + 3 Translation velocities + + size( u%UserProp) & ! typically number of blades + + p%NumExtendedInputs + + NumFieldsForLinearization = 6 ! Translation Displacements + orientations + Translation velocities + Rotation velocities + TranslationAcc + RotationAcc at each node on the blade mesh + do i=1,p%NumBlades + nu = nu + u%BladeRootMotion(i)%NNodes * 3 ! 3 orientations at each node + end do + end if + + do i=1,p%NumBl_Lin + nu = nu + u%BladeMotion(i)%NNodes * 3*NumFieldsForLinearization ! 3 components per additional field + end do + ! all other inputs ignored - - !............................ + + !............................ ! fill matrix to store index to help us figure out what the ith value of the u vector really means ! (see aerodyn::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) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - - !............... - ! AD input mappings stored in p%Jac_u_indx: - !............... - index = 1 - !Module/Mesh/Field: u%TowerMotion%TranslationDisp = 1; - !Module/Mesh/Field: u%TowerMotion%Orientation = 2; - !Module/Mesh/Field: u%TowerMotion%TranslationVel = 3; - do i_meshField = 1,3 - do i=1,u%TowerMotion%NNodes - do j=1,3 - p%Jac_u_indx(index,1) = i_meshField - p%Jac_u_indx(index,2) = j !component index: j - p%Jac_u_indx(index,3) = i !Node: i - index = index + 1 - end do !j - end do !i - end do - - !Module/Mesh/Field: u%HubMotion%TranslationDisp = 4; - !Module/Mesh/Field: u%HubMotion%Orientation = 5; - !Module/Mesh/Field: u%HubMotion%RotationVel = 6; - do i_meshField = 4,6 - do i=1,u%HubMotion%NNodes - do j=1,3 - p%Jac_u_indx(index,1) = i_meshField - p%Jac_u_indx(index,2) = j !component index: j - p%Jac_u_indx(index,3) = i !Node: i - index = index + 1 - end do !j - end do !i - end do - - !bjj: if MaxBl (max blades) changes, we need to modify this - !Module/Mesh/Field: u%BladeRootMotion(1)%Orientation = 7; - !Module/Mesh/Field: u%BladeRootMotion(2)%Orientation = 8; - !Module/Mesh/Field: u%BladeRootMotion(3)%Orientation = 9; - do k=1,p%NumBlades - do i_meshField = 6,6 - do i=1,u%BladeRootMotion(k)%NNodes - do j=1,3 - p%Jac_u_indx(index,1) = i_meshField + k - p%Jac_u_indx(index,2) = j !component index: j - p%Jac_u_indx(index,3) = i !Node: i - index = index + 1 - end do !j - end do !i - - end do !i_meshField - end do !k - - !bjj: if MaxBl (max blades) changes, we need to modify this - !Module/Mesh/Field: u%BladeMotion(1)%TranslationDisp = 10; - !Module/Mesh/Field: u%BladeMotion(1)%Orientation = 11; - !Module/Mesh/Field: u%BladeMotion(1)%TranslationVel = 12; - !Module/Mesh/Field: u%BladeMotion(1)%RotationVel = 13; - !Module/Mesh/Field: u%BladeMotion(1)%TranslationAcc = 14; - - !Module/Mesh/Field: u%BladeMotion(2)%TranslationDisp = 15; - !Module/Mesh/Field: u%BladeMotion(2)%Orientation = 16; - !Module/Mesh/Field: u%BladeMotion(2)%TranslationVel = 17; - !Module/Mesh/Field: u%BladeMotion(2)%RotationVel = 18; - !Module/Mesh/Field: u%BladeMotion(2)%TranslationAcc = 19; - - !Module/Mesh/Field: u%BladeMotion(3)%TranslationDisp = 20; - !Module/Mesh/Field: u%BladeMotion(3)%Orientation = 21; - !Module/Mesh/Field: u%BladeMotion(3)%TranslationVel = 22; - !Module/Mesh/Field: u%BladeMotion(3)%RotationVel = 23; - !Module/Mesh/Field: u%BladeMotion(3)%TranslationAcc = 24; - do k=1,p%NumBlades - do i_meshField = 1,5 - do i=1,u%BladeMotion(k)%NNodes - do j=1,3 - p%Jac_u_indx(index,1) = 9 + i_meshField + (k-1)*5 - p%Jac_u_indx(index,2) = j !component index: j - p%Jac_u_indx(index,3) = i !Node: i - index = index + 1 - end do !j - end do !i - - end do !i_meshField - end do !k - - !Module/Mesh/Field: u%InflowOnBlade(:,:,1) = 25; - !Module/Mesh/Field: u%InflowOnBlade(:,:,2) = 26; - !Module/Mesh/Field: u%InflowOnBlade(:,:,3) = 27; - do k=1,size(u%InflowOnBlade,3) ! p%NumBlades - do i=1,size(u%InflowOnBlade,2) ! numNodes - do j=1,3 - p%Jac_u_indx(index,1) = 24 + k - p%Jac_u_indx(index,2) = j !component index: j - p%Jac_u_indx(index,3) = i !Node: i - index = index + 1 - end do !j - end do !i - end do !k - - !Module/Mesh/Field: u%InflowOnTower(:,:) = 28; - do i=1,size(u%InflowOnTower,2) ! numNodes - do j=1,3 - p%Jac_u_indx(index,1) = 28 - p%Jac_u_indx(index,2) = j !component index: j - p%Jac_u_indx(index,3) = i !Node: i - index = index + 1 - end do !j - end do !i - - !Module/Mesh/Field: u%UserProp(:,:) = 29,30,31; - - do k=1,size(u%UserProp,2) ! p%NumBlades - do i=1,size(u%UserProp,1) ! numNodes - p%Jac_u_indx(index,1) = 28 + k - p%Jac_u_indx(index,2) = 1 !component index: this is a scalar, so 1, but is never used - p%Jac_u_indx(index,3) = i !Node: i - index = index + 1 - end do !i - end do !k - !...................................... - ! default perturbations, p%du: - !...................................... - call allocAry( p%du, 31, 'p%du', ErrStat2, ErrMsg2) ! 31 = number of unique values in p%Jac_u_indx(:,1) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + !............................ + + call allocAry( p%Jac_u_indx, nu, 3, 'p%Jac_u_indx', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(InitOut%LinNames_u, nu, 'LinNames_u', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(InitOut%RotFrame_u, nu, 'RotFrame_u', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(InitOut%IsLoad_u, nu, 'IsLoad_u', ErrStat2, ErrMsg2); if (Failed()) return + ! perturbations + call allocAry( p%du, 39, 'p%du', ErrStat2, ErrMsg2); if (Failed()) return ! number of unique values in p%Jac_u_indx(:,1) (check below) perturb = 2*D2R - - do k=1,p%NumBlades + do k=1,p%NumBl_Lin perturb_b(k) = 0.2_ReKi*D2R * InputFileData%BladeProps(k)%BlSpn( InputFileData%BladeProps(k)%NumBlNds ) end do - if ( u%TowerMotion%NNodes > 0) then perturb_t = 0.2_ReKi*D2R * u%TowerMotion%Position( 3, u%TowerMotion%NNodes ) else perturb_t = 0.0_ReKi - end if - - p%du(1) = perturb_t ! u%TowerMotion%TranslationDisp = 1 - p%du(2) = perturb ! u%TowerMotion%Orientation = 2 - p%du(3) = perturb_t ! u%TowerMotion%TranslationVel = 3 - p%du(4) = perturb_b(1) ! u%HubMotion%TranslationDisp = 4 - p%du(5) = perturb ! u%HubMotion%Orientation = 5 - p%du(6) = perturb ! u%HubMotion%RotationVel = 6 - do i_meshField = 7,9 - p%du(i_meshField) = perturb ! u%BladeRootMotion(k)%Orientation = 6+k, for k in [1, 3] - end do - do k=1,p%NumBlades - p%du(10 + (k-1)*5) = perturb_b(k) ! u%BladeMotion(k)%TranslationDisp = 10 + (k-1)*5 - p%du(11 + (k-1)*5) = perturb ! u%BladeMotion(k)%Orientation = 11 + (k-1)*5 - p%du(12 + (k-1)*5) = perturb_b(k) ! u%BladeMotion(k)%TranslationVel = 12 + (k-1)*5 - p%du(13 + (k-1)*5) = perturb ! u%BladeMotion(k)%RotationVel = 13 + (k-1)*5 - p%du(14 + (k-1)*5) = perturb_b(k) ! u%BladeMotion(k)%TranslationAcc = 14 + (k-1)*5 !bjj: is the correct???? - end do - do k=1,p%NumBlades - p%du(24 + k) = perturb_b(k) ! u%InflowOnBlade(:,:,k) = 24 + k - end do - p%du(28) = perturb_t ! u%InflowOnTower(:,:) = 28 - do k=1,p%NumBlades - p%du(28+k) = perturb ! u%UserProp(:,:) = 29,30,31 - end do - !..................... - ! get names of linearized inputs - !..................... - call AllocAry(InitOut%LinNames_u, nu, 'LinNames_u', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call AllocAry(InitOut%RotFrame_u, nu, 'RotFrame_u', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call AllocAry(InitOut%IsLoad_u, nu, 'IsLoad_u', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return + end if + ! initialize + p%Jac_u_indx = 0 + p%du = 0.0_R8Ki InitOut%IsLoad_u = .false. ! None of AeroDyn's inputs are loads InitOut%RotFrame_u = .false. - do k=0,p%NumBlades*p%NumBlNds-1 - InitOut%RotFrame_u(nu - k ) = .true. ! UserProp(:,:) - end do + + + !=========================================================================== + ! AD input mappings stored in p%Jac_u_indx, perturbations in p%du + !=========================================================================== index = 1 - FieldMask = .false. - FieldMask(MASKID_TRANSLATIONDISP) = .true. - FieldMask(MASKID_Orientation) = .true. - FieldMask(MASKID_TRANSLATIONVel) = .true. - call PackMotionMesh_Names(u%TowerMotion, 'Tower', InitOut%LinNames_u, index, FieldMask=FieldMask) - - FieldMask(MASKID_TRANSLATIONVel) = .false. - FieldMask(MASKID_RotationVel) = .true. - call PackMotionMesh_Names(u%HubMotion, 'Hub', InitOut%LinNames_u, index, FieldMask=FieldMask) - - index_last = index - FieldMask = .false. - FieldMask(MASKID_Orientation) = .true. - do k = 1,p%NumBlades - call PackMotionMesh_Names(u%BladeRootMotion(k), 'Blade root '//trim(num2lstr(k)), InitOut%LinNames_u, index, FieldMask=FieldMask) - end do - - FieldMask(MASKID_TRANSLATIONDISP) = .true. - FieldMask(MASKID_TRANSLATIONVel) = .true. - FieldMask(MASKID_RotationVel) = .true. - FieldMask(MASKID_TRANSLATIONAcc) = .true. - do k=1,p%NumBlades - call PackMotionMesh_Names(u%BladeMotion(k), 'Blade '//trim(num2lstr(k)), InitOut%LinNames_u, index, FieldMask=FieldMask) - end do - - do k=1,p%NumBlades - do i=1,p%NumBlNds - do j=1,3 - InitOut%LinNames_u(index) = UVW(j)//'-component inflow on blade '//trim(num2lstr(k))//', node '//trim(num2lstr(i))//', m/s' - index = index + 1 - end do - end do - end do - !InitOut%RotFrame_u(index_last:index-1) = .true. ! values on the mesh (and from IfW) are in global coordinates, thus not in the rotating frame - do i=1,p%NumTwrNds - do j=1,3 - InitOut%LinNames_u(index) = UVW(j)//'-component inflow on tower node '//trim(num2lstr(i))//', m/s' - index = index + 1 + if (.not. p_AD%CompAeroMaps) then + !------------------------------ + ! Nacelle + ! Module/Mesh/Field: u%NacelleMotion%TranslationDisp = 1; + ! Module/Mesh/Field: u%NacelleMotion%Orientation = 2; + indexNames=index + p%Jac_u_idxStartList%Nacelle = index + call SetJac_u_idx(1,2,u%NacelleMotion%NNodes,index) + ! Perturbations + p%du(1) = perturb_b(1) + p%du(2) = perturb + ! Names + FieldMask = .false. + FieldMask(MASKID_TRANSLATIONDISP) = .true. + FieldMask(MASKID_ORIENTATION) = .true. + call PackMotionMesh_Names(u%NacelleMotion, 'Nacelle', InitOut%LinNames_u, indexNames, FieldMask=FieldMask) + + !------------------------------ + ! Hub + ! Module/Mesh/Field: u%HubMotion%TranslationDisp = 3; + ! Module/Mesh/Field: u%HubMotion%Orientation = 4; + ! Module/Mesh/Field: u%HubMotion%RotationVel = 5; + indexNames=index + p%Jac_u_idxStartList%Hub = index + call SetJac_u_idx(3,5,u%HubMotion%NNodes,index) + ! Perturbations + p%du(3) = perturb_b(1) + p%du(4) = perturb + p%du(5) = perturb + ! Names + FieldMask = .false. + FieldMask(MASKID_TRANSLATIONDISP) = .true. + FieldMask(MASKID_ORIENTATION) = .true. + FieldMask(MASKID_ROTATIONVEL) = .true. + call PackMotionMesh_Names(u%HubMotion, 'Hub', InitOut%LinNames_u, indexNames, FieldMask=FieldMask) + + + !------------------------------ + ! TailFin + ! Module/Mesh/Field: u%TFinMotion%TranslationDisp = 6; + ! Module/Mesh/Field: u%TFinMotion%Orientation = 7; + ! Module/Mesh/Field: u%TFinMotion%TranslationVel = 8; + indexNames=index + p%Jac_u_idxStartList%TFin = index + call SetJac_u_idx(6,8,u%TFinMotion%NNodes,index) + ! Perturbations + p%du(6) = perturb + p%du(7) = perturb + p%du(8) = perturb + ! Names + FieldMask = .false. + FieldMask(MASKID_TRANSLATIONDISP) = .true. + FieldMask(MASKID_ORIENTATION) = .true. + FieldMask(MASKID_TRANSLATIONVEL) = .true. + call PackMotionMesh_Names(u%TFinMotion, 'TailFin', InitOut%LinNames_u, indexNames, FieldMask=FieldMask) + + + !------------------------------ + ! Tower + ! Module/Mesh/Field: u%TowerMotion%TranslationDisp = 9; + ! Module/Mesh/Field: u%TowerMotion%Orientation = 10; + ! Module/Mesh/Field: u%TowerMotion%TranslationVel = 11; + ! Module/Mesh/Field: u%TowerMotion%TranslationAcc = 12; + indexNames=index + p%Jac_u_idxStartList%Tower = index + call SetJac_u_idx(9,12,u%TowerMotion%NNodes,index) + ! Perturbations + p%du( 9) = perturb_t + p%du(10) = perturb + p%du(11) = perturb_t + p%du(12) = perturb_t + ! Names + FieldMask = .false. + FieldMask(MASKID_TRANSLATIONDISP) = .true. + FieldMask(MASKID_ORIENTATION) = .true. + FieldMask(MASKID_TRANSLATIONVEL) = .true. + FieldMask(MASKID_TRANSLATIONACC) = .true. + call PackMotionMesh_Names(u%TowerMotion, 'Tower', InitOut%LinNames_u, indexNames, FieldMask=FieldMask) + + + !------------------------------ + ! Blade root (3 blade limit!!!!) + ! Module/Mesh/Field: u%BladeRootMotion(1)%Orientation = 13; + ! Module/Mesh/Field: u%BladeRootMotion(2)%Orientation = 14; + ! Module/Mesh/Field: u%BladeRootMotion(3)%Orientation = 15; + indexNames=index + p%Jac_u_idxStartList%BladeRoot = index + do k = 1,p%NumBl_Lin + call SetJac_u_idx(13+k-1,13+k-1,u%BladeRootMotion(k)%NNodes,index) end do - end do + ! Perturbations + p%du(13) = perturb + p%du(14) = perturb + p%du(15) = perturb + ! Names + FieldMask = .false. + FieldMask(MASKID_Orientation) = .true. + do k = 1,p%NumBl_Lin + call PackMotionMesh_Names(u%BladeRootMotion(k), 'Blade root '//trim(num2lstr(k)), InitOut%LinNames_u, indexNames, FieldMask=FieldMask) + end do + end if ! .not. compAeroMaps + + + !------------------------------ + ! Blades (3 blade limit!!!!!) + ! Module/Mesh/Field: u%BladeMotion(1)%TranslationDisp = 16 + (bladenum-1)*6; + ! Module/Mesh/Field: u%BladeMotion(1)%Orientation = 17 + (bladenum-1)*6; + ! Module/Mesh/Field: u%BladeMotion(1)%TranslationVel = 18 + (bladenum-1)*6; + ! Module/Mesh/Field: u%BladeMotion(1)%RotationVel = 19 + (bladenum-1)*6; full lin only + ! Module/Mesh/Field: u%BladeMotion(1)%TranslationAcc = 20 + (bladenum-1)*6; full lin only + ! Module/Mesh/Field: u%BladeMotion(1)%RotationalAcc = 21 + (bladenum-1)*6; full lin only + if (.not. p_AD%CompAeroMaps) then ! full linearization + indexNames=index + p%Jac_u_idxStartList%Blade = index + call SetJac_u_idx(16,21,u%BladeMotion(1)%NNodes,index) + if (p%NumBl_Lin > 1) call SetJac_u_idx(22,27,u%BladeMotion(2)%NNodes,index) + if (p%NumBl_Lin > 2) call SetJac_u_idx(28,33,u%BladeMotion(3)%NNodes,index) + ! Perturbations + do k=1,p%NumBl_Lin + p%du(16 + (k-1)*6) = perturb_b(k) + p%du(17 + (k-1)*6) = perturb + p%du(18 + (k-1)*6) = perturb_b(k) + p%du(19 + (k-1)*6) = perturb + p%du(20 + (k-1)*6) = perturb_b(k) + p%du(21 + (k-1)*6) = perturb + end do + ! Names + 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. + do k=1,p%NumBl_Lin + call PackMotionMesh_Names(u%BladeMotion(k), 'Blade '//trim(num2lstr(k)), InitOut%LinNames_u, indexNames, FieldMask=FieldMask) + end do + else + indexNames=index + p%Jac_u_idxStartList%Blade = index + call SetJac_u_idx(16,18,u%BladeMotion(1)%NNodes,index) + if (p%NumBl_Lin > 1) call SetJac_u_idx(22,24,u%BladeMotion(2)%NNodes,index) + if (p%NumBl_Lin > 2) call SetJac_u_idx(28,30,u%BladeMotion(3)%NNodes,index) + ! Perturbations + do k=1,p%NumBl_Lin + p%du(16 + (k-1)*6) = perturb_b(k) + p%du(17 + (k-1)*6) = perturb + p%du(18 + (k-1)*6) = perturb_b(k) + end do + ! Names + FieldMask = .false. + FieldMask(MASKID_TRANSLATIONDISP) = .true. + FieldMask(MASKID_ORIENTATION) = .true. + FieldMask(MASKID_TRANSLATIONVEL) = .true. + do k=1,p%NumBl_Lin + call PackMotionMesh_Names(u%BladeMotion(k), 'Blade '//trim(num2lstr(k)), InitOut%LinNames_u, indexNames, FieldMask=FieldMask) + end do + endif - do k=1,p%NumBlades - do i=1,p%NumBlNds - InitOut%LinNames_u(index) = 'User property on blade '//trim(num2lstr(k))//', node '//trim(num2lstr(i))//', -' - index = index + 1 + + if (.not. p_AD%CompAeroMaps) then + !------------------------------ + ! UserProp + ! Module/Mesh/Field: u%UserProp(:,:) = 34,35,36; + p%Jac_u_idxStartList%UserProp = index + do k=1,size(u%UserProp,2) ! p%NumBlades + do i=1,size(u%UserProp,1) ! numNodes + p%Jac_u_indx(index,1) = 34 + k-1 + p%Jac_u_indx(index,2) = 1 !component index: this is a scalar, so 1, but is never used + p%Jac_u_indx(index,3) = i !Node: i + ! Names + InitOut%LinNames_u(index) = 'User property on blade '//trim(num2lstr(k))//', node '//trim(num2lstr(i))//', -' + ! RotFrame + InitOut%RotFrame_u(index) = .true. + index = index + 1 + end do !i + ! Perturbations + p%du(34 + k-1) = perturb + end do ! + + + !------------------------------ + ! Extended inputs (number of these must be exactly p%NumExtendedInputs) + ! Module/Mesh/Field: HWindSpeed = 37 + ! Module/Mesh/Field: PLexp = 38 + ! Module/Mesh/Field: PropagationDir = 39 + p%Jac_u_idxStartList%Extended = index + p%Jac_u_indx(index,1)=37; p%Jac_u_indx(index,2)=1; p%Jac_u_indx(index,3)=1; InitOut%LinNames_u(index) = 'Extended input: horizontal wind speed (steady/uniform wind), m/s'; index=index+1 + p%Jac_u_indx(index,1)=38; p%Jac_u_indx(index,2)=1; p%Jac_u_indx(index,3)=1; InitOut%LinNames_u(index) = 'Extended input: vertical power-law shear exponent, -'; index=index+1 + p%Jac_u_indx(index,1)=39; p%Jac_u_indx(index,2)=1; p%Jac_u_indx(index,3)=1; InitOut%LinNames_u(index) = 'Extended input: propagation direction, rad'; index=index+1 + ! Perturbations + p%du(37) = perturb + p%du(38) = perturb + p%du(39) = perturb + + end if ! .not. compAeroMaps + +contains + subroutine SetJac_u_idx(FieldIdxStart,FieldIdxEnd,nNodes,idx) + integer, intent(in ) :: FieldIdxStart + integer, intent(in ) :: FieldIdxEnd + integer, intent(in ) :: nNodes + integer, intent(inout) :: idx + integer :: i_meshField,i,j + do i_meshField = FieldIdxStart,FieldIdxEnd + do i=1,nNodes + do j=1,3 + p%Jac_u_indx(idx,1) = i_meshField + p%Jac_u_indx(idx,2) = j !component index: j + p%Jac_u_indx(idx,3) = i !Node: i + idx = idx + 1 + end do !j + end do !i end do - end do + end subroutine + + logical function Failed() + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + Failed = ErrStat >= AbortErrLev + !if (Failed) call Cleanup() + end function Failed +END SUBROUTINE Init_Jacobian_u + - END SUBROUTINE Init_Jacobian_u !---------------------------------------------------------------------------------------------------------------------------------- SUBROUTINE Init_Jacobian_x( p, InitOut, ErrStat, ErrMsg) - TYPE(RotParameterType) , INTENT(INOUT) :: p !< parameters TYPE(RotInitOutputType) , 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 @@ -6746,7 +7240,7 @@ SUBROUTINE Init_Jacobian_x( p, InitOut, ErrStat, ErrMsg) CHARACTER(*), PARAMETER :: RoutineName = 'Init_Jacobian_x' ! local variables: - INTEGER(IntKi) :: i, j, k + INTEGER(IntKi) :: i, j, k, n, state INTEGER(IntKi) :: nx INTEGER(IntKi) :: nx1 CHARACTER(25) :: NodeTxt @@ -6755,17 +7249,16 @@ SUBROUTINE Init_Jacobian_x( p, InitOut, ErrStat, ErrMsg) ErrMsg = "" - nx = p%BEMT%DBEMT%lin_nx + p%BEMT%UA%lin_nx + nx = p%BEMT%DBEMT%lin_nx + p%BEMT%UA%lin_nx + p%BEMT%lin_nx ! allocate space for the row/column names and for perturbation sizes ! always allocate this in case it is size zero ... (we use size(p%dx) for many calculations) - CALL AllocAry(p%dx, nx, 'p%dx', ErrStat2, ErrMsg2); call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL AllocAry(p%dx, nx, 'p%dx', ErrStat2, ErrMsg2); if (Failed()) return if (nx==0) return - CALL AllocAry(InitOut%LinNames_x, nx, 'LinNames_x', ErrStat2, ErrMsg2); CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AllocAry(InitOut%RotFrame_x, nx, 'RotFrame_x', ErrStat2, ErrMsg2); CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AllocAry(InitOut%DerivOrder_x, nx, 'DerivOrder_x', ErrStat2, ErrMsg2); CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return + CALL AllocAry(InitOut%LinNames_x, nx, 'LinNames_x', ErrStat2, ErrMsg2); if (Failed()) return + CALL AllocAry(InitOut%RotFrame_x, nx, 'RotFrame_x', ErrStat2, ErrMsg2); if (Failed()) return + CALL AllocAry(InitOut%DerivOrder_x, nx, 'DerivOrder_x', ErrStat2, ErrMsg2); if (Failed()) return ! All DBEMT continuous states are order = 2; UA states are order 1 @@ -6795,41 +7288,59 @@ SUBROUTINE Init_Jacobian_x( p, InitOut, ErrStat, ErrMsg) InitOut%RotFrame_x(i+nx1) = InitOut%RotFrame_x(i) end do end if - + + ! UA states if (p%BEMT%UA%lin_nx>0) then InitOut%DerivOrder_x(1+p%BEMT%DBEMT%lin_nx:nx) = 1 InitOut%RotFrame_x( 1+p%BEMT%DBEMT%lin_nx:nx) = .true. k = 1 + p%BEMT%DBEMT%lin_nx - do j=1,p%NumBlades ! size(x%BEMT%DBEMT%element,2) - do i=1,p%NumBlNds ! size(x%BEMT%DBEMT%element,1) - NodeTxt = 'blade '//trim(num2lstr(j))//', node '//trim(num2lstr(i)) - if (p%BEMT%UA%UAMod/=UA_OYE) then - - InitOut%LinNames_x(k) = 'x1 '//trim(NodeTxt)//', rad' - k = k + 1 + do n=1,p%BEMT%UA%lin_nx + i = p%BEMT%UA%lin_xIndx(n,1) + j = p%BEMT%UA%lin_xIndx(n,2) + state = p%BEMT%UA%lin_xIndx(n,3) - InitOut%LinNames_x(k) = 'x2 '//trim(NodeTxt)//', rad' - k = k + 1 - - InitOut%LinNames_x(k) = 'x3 '//trim(NodeTxt)//', -' - k = k + 1 - endif - - InitOut%LinNames_x(k) = 'x4 '//trim(NodeTxt)//', -' - p%dx(k) = 0.001 ! x4 is a number between 0 and 1, so we need this to be small - k = k + 1 - end do - end do + p%dx(k) = p%BEMT%UA%dx(state) + + NodeTxt = 'x'//trim(num2lstr(state))//' blade '//trim(num2lstr(j))//', node '//trim(num2lstr(i)) + if (state<3) then + InitOut%LinNames_x(k) = trim(NodeTxt)//', rad' ! x1 and x2 are radians + else + InitOut%LinNames_x(k) = trim(NodeTxt)//', -' ! x3, x4 (and x5) are units of cl or cn + end if + InitOut%DerivOrder_x(k) = 1 + InitOut%RotFrame_x(k) = .true. + k = k + 1 + end do end if - + + ! BEMT states + if (p%BEMT%lin_nx>0) then + call SetErrStat(ErrID_Fatal,'Number of lin states for bem should be zero for now.', ErrStat, ErrMsg, RoutineName) + return + !k = 1 + p%BEMT%DBEMT%lin_nx + p%BEMT%UA%lin_nx + + !InitOut%DerivOrder_x(k:nx) = 1 + !InitOut%RotFrame_x( k:nx) = .false. + ! + !InitOut%LinNames_x(k ) = 'X-component of wake velocity, m/s' + !InitOut%LinNames_x(k+1) = 'Y-component of wake velocity, m/s' + !InitOut%LinNames_x(k+2) = 'Z-component of wake velocity, m/s' + end if +contains + logical function Failed() + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + Failed = ErrStat >= AbortErrLev + !if (Failed) call Cleanup() + end function Failed END SUBROUTINE Init_Jacobian_x + + !---------------------------------------------------------------------------------------------------------------------------------- !> 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 corresponding parts of AD linearization ! SUBROUTINE Init_Jacobian( InputFileData, p, p_AD, u, y, m, InitOut, ErrStat, ErrMsg) - type(RotInputFile) , intent(in ) :: InputFileData !< input file data (for default blade perturbation) TYPE(RotParameterType) , INTENT(INOUT) :: p !< parameters TYPE(AD_ParameterType) , INTENT(INOUT) :: p_AD !< parameters @@ -6837,7 +7348,6 @@ SUBROUTINE Init_Jacobian( InputFileData, p, p_AD, u, y, m, InitOut, ErrStat, Err TYPE(RotOutputType) , INTENT(IN ) :: y !< outputs TYPE(RotMiscVarType) , INTENT(IN ) :: m !< miscellaneous variable TYPE(RotInitOutputType) , 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 @@ -6849,134 +7359,213 @@ SUBROUTINE Init_Jacobian( InputFileData, p, p_AD, u, y, m, InitOut, ErrStat, Err ErrStat = ErrID_None ErrMsg = "" -!FIXME: add logic to check that p%NumBlades is not greater than MaxBl. Cannot linearize if that is true. - call Init_Jacobian_y( p, y, InitOut, ErrStat, ErrMsg) + if (p_AD%CompAeroMaps) then + p%NumBl_Lin = 1 + else + p%NumBl_Lin = p%NumBlades + end if + + call Init_Jacobian_y( p, p_AD, y, InitOut, ErrStat, ErrMsg) ! these matrices will be needed for linearization with frozen wake feature - if (p%FrozenWake) then - call AllocAry(m%BEMT%AxInd_op,p%NumBlNds,p%numBlades,'m%BEMT%AxInd_op', ErrStat2,ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call AllocAry(m%BEMT%TnInd_op,p%NumBlNds,p%numBlades,'m%BEMT%TnInd_op', ErrStat2,ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if ( p%DBEMT_Mod == DBEMT_frozen ) then + call AllocAry(m%BEMT%AxInd_op,p%NumBlNds,p%numBlades,'m%BEMT%AxInd_op', ErrStat2,ErrMsg2); if (Failed()) return + call AllocAry(m%BEMT%TnInd_op,p%NumBlNds,p%numBlades,'m%BEMT%TnInd_op', ErrStat2,ErrMsg2); if (Failed()) return end if - call Init_Jacobian_u( InputFileData, p, u, InitOut, ErrStat2, ErrMsg2); call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call Init_Jacobian_u( InputFileData, p, p_AD, u, InitOut, ErrStat2, ErrMsg2); if (Failed()) return - call Init_Jacobian_x( p, InitOut, ErrStat2, ErrMsg2); call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call Init_Jacobian_x( p, InitOut, ErrStat2, ErrMsg2); if (Failed()) return +contains + logical function Failed() + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + Failed = ErrStat >= AbortErrLev + !if (Failed) call Cleanup() + end function Failed END SUBROUTINE 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 aerodyn::init_jacobian is consistant with this routine! SUBROUTINE Perturb_u( p, n, perturb_sign, u, du ) - TYPE(RotParameterType) , INTENT(IN ) :: p !< parameters - INTEGER( IntKi ) , INTENT(IN ) :: n !< number of array element to use + 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(RotInputType) , INTENT(INOUT) :: u !< perturbed AD 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) - + + 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%TowerMotion%TranslationDisp = 1; - u%TowerMotion%TranslationDisp( fieldIndx,node) = u%TowerMotion%TranslationDisp( fieldIndx,node) + du * perturb_sign - CASE ( 2) !Module/Mesh/Field: u%TowerMotion%Orientation = 2; - CALL PerturbOrientationMatrix( u%TowerMotion%Orientation(:,:,node), du * perturb_sign, fieldIndx, UseSmlAngle=.true. ) - CASE ( 3) !Module/Mesh/Field: u%TowerMotion%TranslationVel = 3; - u%TowerMotion%TranslationVel( fieldIndx,node ) = u%TowerMotion%TranslationVel( fieldIndx,node) + du * perturb_sign - - CASE ( 4) !Module/Mesh/Field: u%HubMotion%TranslationDisp = 4; - u%HubMotion%TranslationDisp(fieldIndx,node) = u%HubMotion%TranslationDisp(fieldIndx,node) + du * perturb_sign - CASE ( 5) !Module/Mesh/Field: u%HubMotion%Orientation = 5; - CALL PerturbOrientationMatrix( u%HubMotion%Orientation(:,:,node), du * perturb_sign, fieldIndx ) - CASE ( 6) !Module/Mesh/Field: u%HubMotion%RotationVel = 6; - u%HubMotion%RotationVel(fieldIndx,node) = u%HubMotion%RotationVel(fieldIndx,node) + du * perturb_sign - - CASE ( 7) !Module/Mesh/Field: u%BladeRootMotion(1)%Orientation = 7; - CALL PerturbOrientationMatrix( u%BladeRootMotion(1)%Orientation(:,:,node), du * perturb_sign, fieldIndx ) - - CASE ( 8) !Module/Mesh/Field: u%BladeRootMotion(2)%Orientation = 8; - CALL PerturbOrientationMatrix( u%BladeRootMotion(2)%Orientation(:,:,node), du * perturb_sign, fieldIndx ) - - CASE ( 9) !Module/Mesh/Field: u%BladeRootMotion(3)%Orientation = 9; - CALL PerturbOrientationMatrix( u%BladeRootMotion(3)%Orientation(:,:,node), du * perturb_sign, fieldIndx ) - - CASE (10) !Module/Mesh/Field: u%BladeMotion(1)%TranslationDisp = 10; - u%BladeMotion(1)%TranslationDisp(fieldIndx,node) = u%BladeMotion(1)%TranslationDisp(fieldIndx,node) + du * perturb_sign - CASE (11) !Module/Mesh/Field: u%BladeMotion(1)%Orientation = 11; - CALL PerturbOrientationMatrix( u%BladeMotion(1)%Orientation(:,:,node), du * perturb_sign, fieldIndx ) - CASE (12) !Module/Mesh/Field: u%BladeMotion(1)%TranslationVel = 12; - u%BladeMotion(1)%TranslationVel(fieldIndx,node) = u%BladeMotion(1)%TranslationVel(fieldIndx,node) + du * perturb_sign - CASE (13) !Module/Mesh/Field: u%BladeMotion(1)%RotationVel = 13; - u%BladeMotion(1)%RotationVel(fieldIndx,node) = u%BladeMotion(1)%RotationVel(fieldIndx,node) + du * perturb_sign - CASE (14) !Module/Mesh/Field: u%BladeMotion(1)%TranslationAcc = 14; - u%BladeMotion(1)%TranslationAcc(fieldIndx,node) = u%BladeMotion(1)%TranslationAcc(fieldIndx,node) + du * perturb_sign - - CASE (15) !Module/Mesh/Field: u%BladeMotion(2)%TranslationDisp = 15; - u%BladeMotion(2)%TranslationDisp( fieldIndx,node) = u%BladeMotion(2)%TranslationDisp( fieldIndx,node) + du * perturb_sign - CASE (16) !Module/Mesh/Field: u%BladeMotion(2)%Orientation = 16; - CALL PerturbOrientationMatrix( u%BladeMotion(2)%Orientation(:,:,node), du * perturb_sign, fieldIndx ) - CASE (17) !Module/Mesh/Field: u%BladeMotion(2)%TranslationVel = 17; - u%BladeMotion(2)%TranslationVel(fieldIndx,node) = u%BladeMotion(2)%TranslationVel(fieldIndx,node) + du * perturb_sign - CASE (18) !Module/Mesh/Field: u%BladeMotion(2)%RotationVel = 18; - u%BladeMotion(2)%RotationVel(fieldIndx,node) = u%BladeMotion(2)%RotationVel(fieldIndx,node) + du * perturb_sign - CASE (19) !Module/Mesh/Field: u%BladeMotion(2)%TranslationAcc = 19; - u%BladeMotion(2)%TranslationAcc(fieldIndx,node) = u%BladeMotion(2)%TranslationAcc(fieldIndx,node) + du * perturb_sign - - CASE (20) !Module/Mesh/Field: u%BladeMotion(3)%TranslationDisp = 20; - u%BladeMotion(3)%TranslationDisp( fieldIndx,node) = u%BladeMotion(3)%TranslationDisp( fieldIndx,node) + du * perturb_sign - CASE (21) !Module/Mesh/Field: u%BladeMotion(3)%Orientation = 21; - CALL PerturbOrientationMatrix( u%BladeMotion(3)%Orientation(:,:,node), du * perturb_sign, fieldIndx ) - CASE (22) !Module/Mesh/Field: u%BladeMotion(3)%TranslationVel = 22; - u%BladeMotion(3)%TranslationVel(fieldIndx,node) = u%BladeMotion(3)%TranslationVel(fieldIndx,node) + du * perturb_sign - CASE (23) !Module/Mesh/Field: u%BladeMotion(3)%RotationVel = 23; - u%BladeMotion(3)%RotationVel(fieldIndx,node) = u%BladeMotion(3)%RotationVel(fieldIndx,node) + du * perturb_sign - CASE (24) !Module/Mesh/Field: u%BladeMotion(3)%TranslationAcc = 24; - u%BladeMotion(3)%TranslationAcc(fieldIndx,node) = u%BladeMotion(3)%TranslationAcc(fieldIndx,node) + du * perturb_sign - - CASE (25) !Module/Mesh/Field: u%InflowOnBlade(:,:,1) = 25; - u%InflowOnBlade(fieldIndx,node,1) = u%InflowOnBlade(fieldIndx,node,1) + du * perturb_sign - CASE (26) !Module/Mesh/Field: u%InflowOnBlade(:,:,2) = 26; - u%InflowOnBlade(fieldIndx,node,2) = u%InflowOnBlade(fieldIndx,node,2) + du * perturb_sign - CASE (27) !Module/Mesh/Field: u%InflowOnBlade(:,:,3) = 27; - u%InflowOnBlade(fieldIndx,node,3) = u%InflowOnBlade(fieldIndx,node,3) + du * perturb_sign - - CASE (28) !Module/Mesh/Field: u%InflowOnTower(:,:) = 28; - u%InflowOnTower(fieldIndx,node) = u%InflowOnTower(fieldIndx,node) + du * perturb_sign - CASE (29) !Module/Mesh/Field: u%UserProp(:,1) = 29; - u%UserProp(node,1) = u%UserProp(node,1) + du * perturb_sign - CASE (30) !Module/Mesh/Field: u%UserProp(:,2) = 30; - u%UserProp(node,2) = u%UserProp(node,2) + du * perturb_sign - CASE (31) !Module/Mesh/Field: u%UserProp(:,3) = 31; - u%UserProp(node,3) = u%UserProp(node,3) + du * perturb_sign + + ! Nacelle + ! Module/Mesh/Field: u%NacelleMotion%TranslationDisp = 1; + ! Module/Mesh/Field: u%NacelleMotion%Orientation = 2; + case( 1); u%NacelleMotion%TranslationDisp(fieldIndx,node) = u%NacelleMotion%TranslationDisp(fieldIndx,node) + du * perturb_sign + case( 2); call PerturbOrientationMatrix( u%NacelleMotion%Orientation(:,:,node), du * perturb_sign, fieldIndx ) + + ! Hub + ! Module/Mesh/Field: u%HubMotion%TranslationDisp = 3; + ! Module/Mesh/Field: u%HubMotion%Orientation = 4; + ! Module/Mesh/Field: u%HubMotion%RotationVel = 5; + case( 3); u%HubMotion%TranslationDisp(fieldIndx,node) = u%HubMotion%TranslationDisp(fieldIndx,node) + du * perturb_sign + case( 4); call PerturbOrientationMatrix( u%HubMotion%Orientation(:,:,node), du * perturb_sign, fieldIndx ) + case( 5); u%HubMotion%RotationVel( fieldIndx,node) = u%HubMotion%RotationVel(fieldIndx,node) + du * perturb_sign + + ! TailFin + ! Module/Mesh/Field: u%TFinMotion%TranslationDisp = 6; + ! Module/Mesh/Field: u%TFinMotion%Orientation = 7; + ! Module/Mesh/Field: u%TFinMotion%TranslationVel = 8; + case( 6); u%TFinMotion%TranslationDisp(fieldIndx,node) = u%TFinMotion%TranslationDisp(fieldIndx,node) + du * perturb_sign + case( 7); call PerturbOrientationMatrix( u%TFinMotion%Orientation(:,:,node), du * perturb_sign, fieldIndx ) + case( 8); u%TFinMotion%TranslationVel( fieldIndx,node) = u%TFinMotion%TranslationVel(fieldIndx,node) + du * perturb_sign + + ! Tower + ! Module/Mesh/Field: u%TowerMotion%TranslationDisp = 9; + ! Module/Mesh/Field: u%TowerMotion%Orientation = 10; + ! Module/Mesh/Field: u%TowerMotion%TranslationVel = 11; + ! Module/Mesh/Field: u%TowerMotion%TranslationAcc = 12; + case( 9); u%TowerMotion%TranslationDisp(fieldIndx,node) = u%TowerMotion%TranslationDisp( fieldIndx,node) + du * perturb_sign + case(10); CALL PerturbOrientationMatrix( u%TowerMotion%Orientation(:,:,node), du * perturb_sign, fieldIndx, UseSmlAngle=.false. ) + case(11); u%TowerMotion%TranslationVel( fieldIndx,node) = u%TowerMotion%TranslationVel( fieldIndx,node) + du * perturb_sign + case(12); u%TowerMotion%TranslationAcc( fieldIndx,node) = u%TowerMotion%TranslationAcc(fieldIndx,node) + du * perturb_sign + + ! BladeRoot + ! Module/Mesh/Field: u%BladeRootMotion(1)%Orientation = 13; + ! Module/Mesh/Field: u%BladeRootMotion(2)%Orientation = 14; + ! Module/Mesh/Field: u%BladeRootMotion(3)%Orientation = 15; + case(13); call PerturbOrientationMatrix( u%BladeRootMotion(1)%Orientation(:,:,node), du * perturb_sign, fieldIndx ) + case(14); call PerturbOrientationMatrix( u%BladeRootMotion(2)%Orientation(:,:,node), du * perturb_sign, fieldIndx ) + case(15); call PerturbOrientationMatrix( u%BladeRootMotion(3)%Orientation(:,:,node), du * perturb_sign, fieldIndx ) + + ! Blade 1 + ! Module/Mesh/Field: u%BladeMotion(1)%TranslationDisp = 16; + ! Module/Mesh/Field: u%BladeMotion(1)%Orientation = 17; + ! Module/Mesh/Field: u%BladeMotion(1)%TranslationVel = 18; + ! Module/Mesh/Field: u%BladeMotion(1)%RotationVel = 19; + ! Module/Mesh/Field: u%BladeMotion(1)%TranslationAcc = 20; + ! Module/Mesh/Field: u%BladeMotion(1)%RotationalAcc = 21; + case(16); u%BladeMotion(1)%TranslationDisp(fieldIndx,node) = u%BladeMotion(1)%TranslationDisp(fieldIndx,node) + du * perturb_sign + case(17); call PerturbOrientationMatrix( u%BladeMotion(1)%Orientation(:,:,node), du * perturb_sign, fieldIndx ) + case(18); u%BladeMotion(1)%TranslationVel( fieldIndx,node) = u%BladeMotion(1)%TranslationVel(fieldIndx,node) + du * perturb_sign + case(19); u%BladeMotion(1)%RotationVel( fieldIndx,node) = u%BladeMotion(1)%RotationVel( fieldIndx,node) + du * perturb_sign + case(20); u%BladeMotion(1)%TranslationAcc( fieldIndx,node) = u%BladeMotion(1)%TranslationAcc(fieldIndx,node) + du * perturb_sign + case(21); u%BladeMotion(1)%RotationAcc( fieldIndx,node) = u%BladeMotion(1)%RotationAcc( fieldIndx,node) + du * perturb_sign + + ! Blade 2 + ! Module/Mesh/Field: u%BladeMotion(2)%TranslationDisp = 22; + ! Module/Mesh/Field: u%BladeMotion(2)%Orientation = 23; + ! Module/Mesh/Field: u%BladeMotion(2)%TranslationVel = 24; + ! Module/Mesh/Field: u%BladeMotion(2)%RotationVel = 25; + ! Module/Mesh/Field: u%BladeMotion(2)%TranslationAcc = 26; + ! Module/Mesh/Field: u%BladeMotion(2)%RotationalAcc = 27; + case(22); u%BladeMotion(2)%TranslationDisp(fieldIndx,node) = u%BladeMotion(2)%TranslationDisp(fieldIndx,node) + du * perturb_sign + case(23); call PerturbOrientationMatrix( u%BladeMotion(2)%Orientation(:,:,node), du * perturb_sign, fieldIndx ) + case(24); u%BladeMotion(2)%TranslationVel( fieldIndx,node) = u%BladeMotion(2)%TranslationVel(fieldIndx,node) + du * perturb_sign + case(25); u%BladeMotion(2)%RotationVel( fieldIndx,node) = u%BladeMotion(2)%RotationVel( fieldIndx,node) + du * perturb_sign + case(26); u%BladeMotion(2)%TranslationAcc( fieldIndx,node) = u%BladeMotion(2)%TranslationAcc(fieldIndx,node) + du * perturb_sign + case(27); u%BladeMotion(2)%RotationAcc( fieldIndx,node) = u%BladeMotion(2)%RotationAcc( fieldIndx,node) + du * perturb_sign + + ! Blade 3 + ! Module/Mesh/Field: u%BladeMotion(3)%TranslationDisp = 28; + ! Module/Mesh/Field: u%BladeMotion(3)%Orientation = 29; + ! Module/Mesh/Field: u%BladeMotion(3)%TranslationVel = 30; + ! Module/Mesh/Field: u%BladeMotion(3)%RotationVel = 31; + ! Module/Mesh/Field: u%BladeMotion(3)%TranslationAcc = 32; + ! Module/Mesh/Field: u%BladeMotion(3)%RotationalAcc = 33; + case(28); u%BladeMotion(3)%TranslationDisp(fieldIndx,node) = u%BladeMotion(3)%TranslationDisp(fieldIndx,node) + du * perturb_sign + case(29); call PerturbOrientationMatrix( u%BladeMotion(3)%Orientation(:,:,node), du * perturb_sign, fieldIndx ) + case(30); u%BladeMotion(3)%TranslationVel( fieldIndx,node) = u%BladeMotion(3)%TranslationVel(fieldIndx,node) + du * perturb_sign + case(31); u%BladeMotion(3)%RotationVel( fieldIndx,node) = u%BladeMotion(3)%RotationVel( fieldIndx,node) + du * perturb_sign + case(32); u%BladeMotion(3)%TranslationAcc( fieldIndx,node) = u%BladeMotion(3)%TranslationAcc(fieldIndx,node) + du * perturb_sign + case(33); u%BladeMotion(3)%RotationAcc( fieldIndx,node) = u%BladeMotion(3)%RotationAcc( fieldIndx,node) + du * perturb_sign + + ! UserProp + ! Module/Mesh/Field: u%UserProp(:,:) = 34,35,36; + case(34); u%UserProp(node,1) = u%UserProp(node,1) + du * perturb_sign + case(35); u%UserProp(node,2) = u%UserProp(node,2) + du * perturb_sign + case(36); u%UserProp(node,3) = u%UserProp(node,3) + du * perturb_sign + END SELECT - + END SUBROUTINE Perturb_u + + +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine perturbs the nth element of the u array extended inputs (and mesh/field it corresponds to) +!! Do not change this without making sure subroutine aerodyn::init_jacobian is consistant with this routine! +subroutine Perturb_uExtend( t, u_perturb, FlowField_perturb, RotInflow_perturb, p, OtherState, n, perturb_sign, u, du, ErrStat, ErrMsg ) + real(DbKi), intent(in ) :: t !< Time in seconds at operating point + type(RotInputType), intent(inout) :: u_perturb + type(FLowFieldType),pointer, intent(inout) :: FlowField_perturb !< perturbed flowfield (only the uniform wind) + type(RotInflowType), intent(inout) :: RotInflow_perturb !< Rotor inflow, perturbed by FlowField extended inputs + type(RotParameterType), intent(in ) :: p !< parameters + type(RotOtherStateType), intent(in ) :: OtherState !< Other states at operating point + 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(RotInputType), intent(inout) :: u !< perturbed AD inputs + real( R8Ki ), intent( out) :: du !< amount that specific input was perturbed + integer(IntKi), intent( out) :: ErrStat !< Error status of the operation + character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + ! local variables + integer :: fieldIndx + integer :: node + real(R8Ki) :: FlowField_du(3) !< vector of perturbations to apply to flow field + integer(intKi) :: StartNode + + ! Error handling + ErrStat = ErrID_None + ErrMsg = "" + + fieldIndx = p%Jac_u_indx(n,2) + node = p%Jac_u_indx(n,3) + du = p%du( p%Jac_u_indx(n,1) ) + StartNode = 1 ! ignored during linearization since cannot linearize with ExtInflow + + ! determine which mesh we're trying to perturb and perturb the input: + select case( p%Jac_u_indx(n,1) ) + ! Extended inputs + ! Module/Mesh/Field: HWindSpeed = 37 + ! Module/Mesh/Field: PLexp = 38 + ! Module/Mesh/Field: PropagationDir = 39 + case(37,38,39) + FlowField_du = 0.0_R8Ki + select case( p%Jac_u_indx(n,1) ) + case (37); FlowField_du(1) = du *perturb_sign + case (38); FlowField_du(2) = du *perturb_sign + case (39); FlowField_du(3) = du *perturb_sign + end select + call IfW_UniformWind_Perturb(FlowField_perturb, FlowField_du) + end select + call AD_CalcWind_Rotor(t, u_perturb, FlowField_perturb, p, RotInflow_perturb, StartNode, ErrStat, ErrMsg) +end subroutine Perturb_uExtend + + !---------------------------------------------------------------------------------------------------------------------------------- !> This routine perturbs the nth element of the u array (and mesh/field it corresponds to) !! Do not change this without making sure subroutine aerodyn::init_jacobian is consistant with this routine! SUBROUTINE Perturb_x( p, n, perturb_sign, x, dx ) - TYPE(RotParameterType) , 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(RotContinuousStateType) , INTENT(INOUT) :: x !< perturbed AD continuous states REAL( R8Ki ) , INTENT( OUT) :: dx !< amount that specific input was perturbed - ! local variables INTEGER(IntKi) :: Blade ! loop over blade nodes INTEGER(IntKi) :: BladeNode ! loop over blades - INTEGER(IntKi) :: StateIndex ! loop over blades + INTEGER(IntKi) :: StateIndex ! which state we are perturbing + INTEGER(IntKi) :: n_tmp ! dx = p%dx( n ) @@ -6992,16 +7581,19 @@ SUBROUTINE Perturb_x( p, n, perturb_sign, x, dx ) endif else - !call GetStateIndices( n - p%BEMT%DBEMT%lin_nx, size(x%BEMT%UA%element,2), size(x%BEMT%UA%element,1), size(x%BEMT%UA%element(1,1)%x), Blade, BladeNode, StateIndex ) - if (p%BEMT%UA%UAMod==UA_OYE) then - call GetStateIndices( n - p%BEMT%DBEMT%lin_nx, size(x%BEMT%UA%element,2), size(x%BEMT%UA%element,1), 1, Blade, BladeNode, StateIndex ) - StateIndex=4 ! Always the 4th one + n_tmp = n - p%BEMT%DBEMT%lin_nx + + if (n_tmp <= p%BEMT%UA%lin_nx) then + BladeNode = p%BEMT%UA%lin_xIndx(n_tmp,1) ! node + Blade = p%BEMT%UA%lin_xIndx(n_tmp,2) ! blade + StateIndex = p%BEMT%UA%lin_xIndx(n_tmp,3) ! state + + x%BEMT%UA%element(BladeNode,Blade)%x(StateIndex) = x%BEMT%UA%element(BladeNode,Blade)%x(StateIndex) + dx * perturb_sign else - call GetStateIndices( n - p%BEMT%DBEMT%lin_nx, size(x%BEMT%UA%element,2), size(x%BEMT%UA%element,1), 4, Blade, BladeNode, StateIndex ) - endif - x%BEMT%UA%element(BladeNode,Blade)%x(StateIndex) = x%BEMT%UA%element(BladeNode,Blade)%x(StateIndex) + dx * perturb_sign - + StateIndex = n_tmp - p%BEMT%UA%lin_nx + x%BEMT%V_w(StateIndex) = x%BEMT%V_w(StateIndex) + dx * perturb_sign + end if end if contains @@ -7028,11 +7620,12 @@ subroutine GetStateIndices( Indx, NumberOfBlades, NumberOfElementsPerBlade, Numb end subroutine GetStateIndices END SUBROUTINE 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 aerodyn::init_jacobian is consistant with this routine! SUBROUTINE Compute_dY(p, p_AD, y_p, y_m, delta_p, delta_m, dY) - TYPE(RotParameterType) , INTENT(IN ) :: p !< parameters TYPE(AD_ParameterType) , INTENT(IN ) :: p_AD !< parameters TYPE(RotOutputType) , INTENT(IN ) :: y_p !< AD outputs at \f$ u + \Delta_p u \f$ or \f$ x + \Delta_p x \f$ (p=plus) @@ -7044,30 +7637,35 @@ SUBROUTINE Compute_dY(p, p_AD, y_p, y_m, delta_p, delta_m, dY) ! local variables: INTEGER(IntKi) :: k ! loop over blades INTEGER(IntKi) :: indx_first ! index indicating next value of dY to be filled - indx_first = 1 - call PackLoadMesh_dY(y_p%TowerLoad, y_m%TowerLoad, dY, indx_first) + if (.not. p_AD%CompAeroMaps) then + call PackLoadMesh_dY(y_p%NacelleLoad, y_m%NacelleLoad, dY, indx_first) + call PackLoadMesh_dY(y_p%HubLoad, y_m%HubLoad, dY, indx_first) + call PackLoadMesh_dY(y_p%TFinLoad, y_m%TFinLoad, dY, indx_first) + call PackLoadMesh_dY(y_p%TowerLoad, y_m%TowerLoad, dY, indx_first) + endif - do k=1,p%NumBlades + do k=1,p%NumBl_Lin call PackLoadMesh_dY(y_p%BladeLoad(k), y_m%BladeLoad(k), dY, indx_first) end do - - do k=1,p%NumOuts + p%BldNd_TotNumOuts - dY(k+indx_first-1) = y_p%WriteOutput(k) - y_m%WriteOutput(k) - end do - + if (.not. p_AD%CompAeroMaps) then + do k=1,p%NumOuts + p%BldNd_TotNumOuts + dY(k+indx_first-1) = y_p%WriteOutput(k) - y_m%WriteOutput(k) + end do + end if dY = dY / (delta_p + delta_m) END SUBROUTINE Compute_dY + + !---------------------------------------------------------------------------------------------------------------------------------- !> This routine uses values of two continuous state types to compute an array of differences. !! Do not change this packing without making sure subroutine aerodyn::init_jacobian is consistant with this routine! SUBROUTINE Compute_dX(p, x_p, x_m, delta_p, delta_m, dX) - TYPE(RotParameterType) , INTENT(IN ) :: p !< parameters TYPE(RotContinuousStateType) , INTENT(IN ) :: x_p !< AD continuous states at \f$ u + \Delta_p u \f$ or \f$ x + \Delta_p x \f$ (p=plus) TYPE(RotContinuousStateType) , INTENT(IN ) :: x_m !< AD continuous states at \f$ u - \Delta_m u \f$ or \f$ x - \Delta_m x \f$ (m=minus) @@ -7078,6 +7676,8 @@ SUBROUTINE Compute_dX(p, x_p, x_m, delta_p, delta_m, dX) ! local variables: INTEGER(IntKi) :: i ! loop over blade nodes INTEGER(IntKi) :: j ! loop over blades + INTEGER(IntKi) :: k ! loop over states + INTEGER(IntKi) :: n ! loop over active UA states INTEGER(IntKi) :: indx_first ! index indicating next value of dY to be filled @@ -7102,190 +7702,105 @@ SUBROUTINE Compute_dX(p, x_p, x_m, delta_p, delta_m, dX) end if if (p%BEMT%UA%lin_nx>0) then - - if (p%BEMT%UA%UAMod==UA_OYE) then - do j=1,size(x_p%BEMT%UA%element,2) ! number of blades - do i=1,size(x_p%BEMT%UA%element,1) ! number of nodes per blade - dX(indx_first) = x_p%BEMT%UA%element(i,j)%x(4) - x_m%BEMT%UA%element(i,j)%x(4) - indx_first = indx_first + 1 ! = index_first += 4 - end do - end do - else - do j=1,size(x_p%BEMT%UA%element,2) ! number of blades - do i=1,size(x_p%BEMT%UA%element,1) ! number of nodes per blade - dX(indx_first:indx_first+3) = x_p%BEMT%UA%element(i,j)%x(1:4) - x_m%BEMT%UA%element(i,j)%x(1:4) - indx_first = indx_first + 4 ! = index_first += 4 - end do - end do - endif + do n=1,p%BEMT%UA%lin_nx + i = p%BEMT%UA%lin_xIndx(n,1) + j = p%BEMT%UA%lin_xIndx(n,2) + k = p%BEMT%UA%lin_xIndx(n,3) + dX(indx_first) = x_p%BEMT%UA%element(i,j)%x(k) - x_m%BEMT%UA%element(i,j)%x(k) + indx_first = indx_first + 1 + end do + end if + if (p%BEMT%lin_nx>0) then ! skewWake + !do j=1,size(x_p%BEMT%v_w) + ! dX(indx_first) = x_p%BEMT%v_w(j) - x_m%BEMT%v_w(j) + ! indx_first = indx_first + 1 + !end do + end if dX = dX / (delta_p + delta_m) END SUBROUTINE Compute_dX -!---------------------------------------------------------------------------------------------------------------------------------- -!> Count number of wind points required by AeroDyn. -!! Should respect the order of AD_GetExternalWind and AD_SetExternalWindPositions -integer(IntKi) function AD_NumWindPoints(u_AD, o_AD) result(n) - type(AD_InputType), intent(in ) :: u_AD ! AeroDyn data - type(AD_OtherStateType), intent(in ) :: o_AD ! AeroDyn data - ! locals - integer(IntKi) :: k - integer(IntKi) :: iWT - n = 0 - do iWT=1, size(u_AD%rotors) - ! Blades - do k=1,size(u_AD%rotors(iWT)%BladeMotion) - n = n + u_AD%rotors(iWT)%BladeMotion(k)%NNodes - end do - ! Tower - n = n + u_AD%rotors(iWT)%TowerMotion%NNodes - ! Nacelle - if (u_AD%rotors(iWT)%NacelleMotion%Committed) then - n = n + u_AD%rotors(iWT)%NacelleMotion%NNodes ! 1 point - endif - ! Hub Motion - if (u_AD%rotors(iWT)%HubMotion%Committed) then - n = n + u_AD%rotors(iWT)%HubMotion%NNodes ! 1 point - endif - ! TailFin - n = n + u_AD%rotors(iWT)%TFinMotion%NNodes ! 1 point - enddo - if (allocated(o_AD%WakeLocationPoints)) then - n = n + size(o_AD%WakeLocationPoints, dim=2) - end if -end function AD_NumWindPoints -!---------------------------------------------------------------------------------------------------------------------------------- -!> Start index of the OLAF wind points for this turbine -!! Should respect the order of AD_GetExternalWind and AD_SetExternalWindPositions -integer(IntKi) function AD_BoxExceedPointsIdx(u_AD, o_AD) result(n) - type(AD_InputType), intent(in ) :: u_AD ! AeroDyn data - type(AD_OtherStateType), intent(in ) :: o_AD ! AeroDyn data - ! locals - integer(IntKi) :: k - integer(IntKi) :: TotPts ! call AD_NumWindPts, then subtract - TotPts = AD_NumWindPoints(u_AD, o_AD) - if (allocated(o_AD%WakeLocationPoints)) then - n = TotPts - size(o_AD%WakeLocationPoints, dim=2) + 1 ! start index of the olaf points - else ! No OLAF, so return -1 to indicate not used - n = -1 - endif -end function AD_BoxExceedPointsIdx -!---------------------------------------------------------------------------------------------------------------------------------- -!> Sets the wind calculated by InflowWind into the AeroDyn arrays ("InputSolve_IfW") -!! Should respect the order of AD_NumWindPoints and AD_SetExternalWindPositions -subroutine AD_GetExternalWind(u_AD, VelUVW, node, errStat, errMsg) - ! Passed variables - type(AD_InputType), intent(inout) :: u_AD !< AeroDyn inputs - real(ReKi), dimension(:,:), intent(in ) :: VelUVW !< Velocity array 3 x n (as typically returned by InflowWind) - integer(IntKi), intent(inout) :: node !< Counter for dimension 2 of VelUVW. Initialized by caller and returned! - integer(IntKi) :: errStat!< Error status of the operation - character(*) :: errMsg !< Error message if errStat /= ErrID_None - ! Local variables: - integer(IntKi) :: j ! Loops through nodes / elements. - integer(IntKi) :: k ! Loops through blades. - integer(IntKi) :: nNodes - integer(IntKi) :: iWT - errStat = ErrID_None - errMsg = "" - do iWT=1,size(u_AD%rotors) - nNodes = size(u_AD%rotors(iWT)%InflowOnBlade,2) - ! Blades - do k=1,size(u_AD%rotors(iWT)%InflowOnBlade,3) - do j=1,nNodes - u_AD%rotors(iWT)%InflowOnBlade(:,j,k) = VelUVW(:,node) - node = node + 1 - end do - end do - ! Tower - if ( allocated(u_AD%rotors(iWT)%InflowOnTower) ) then - do j=1,size(u_AD%rotors(iWT)%InflowOnTower,2) - u_AD%rotors(iWT)%InflowOnTower(:,j) = VelUVW(:,node) - node = node + 1 - end do - end if - ! Nacelle - if (u_AD%rotors(iWT)%NacelleMotion%Committed) then - u_AD%rotors(iWT)%InflowOnNacelle(:) = VelUVW(:,node) - node = node + 1 - else - u_AD%rotors(iWT)%InflowOnNacelle = 0.0_ReKi - end if - ! Hub - if (u_AD%rotors(iWT)%HubMotion%NNodes > 0) then - u_AD%rotors(iWT)%InflowOnHub(:) = VelUVW(:,node) - node = node + 1 - else - u_AD%rotors(iWT)%InflowOnHub = 0.0_ReKi - end if - ! TailFin - if (u_AD%rotors(iWT)%TFinMotion%NNodes > 0) then - u_AD%rotors(iWT)%InflowOnTailFin(:) = VelUVW(:,node) - node = node + 1 - else - u_AD%rotors(iWT)%InflowOnTailFin = 0.0_ReKi - end if - enddo ! rotors - ! OLAF points - if ( allocated(u_AD%InflowWakeVel) ) then - do j=1,size(u_AD%InflowWakeVel,DIM=2) - u_AD%InflowWakeVel(:,j) = VelUVW(:,node) - node = node + 1 - end do !j, wake points - end if -end subroutine AD_GetExternalWind -!---------------------------------------------------------------------------------------------------------------------------------- -!> Set inputs for inflow wind -!! Order should match AD_NumWindPoints and AD_GetExternalWind -subroutine AD_SetExternalWindPositions(u_AD, o_AD, PosXYZ, node, errStat, errMsg) - type(AD_InputType), intent(in ) :: u_AD !< AeroDyn inputs - type(AD_OtherStateType), intent(in ) :: o_AD !< AeroDyn other states - real(ReKi), dimension(:,:), intent(inout) :: PosXYZ !< Positions - integer(IntKi), intent(inout) :: node !< Counter for dimension 2 of PosXYZ. Initialized by caller and returned! - integer(IntKi) , intent(out ) :: errStat !< Status of error message - character(*) , intent(out ) :: errMsg !< Error message if errStat /= ErrID_None - integer :: k, j, iWT - errStat = ErrID_None - errMsg = '' +!------------------------------------------------------------------------------------------------------- +!> This routine calculates nacelle drag loads on a turbine. +SUBROUTINE computeNacelleDrag( u, p, m, y, RotInflow, ErrStat, ErrMsg ) + + TYPE(RotInputType) , INTENT(IN ) :: u !< AD inputs - used for mesh node positions + TYPE(RotParameterType) , INTENT(IN ) :: p !< Parameters + TYPE(RotMiscVarType) , INTENT(INOUT) :: m !< Misc/optimization variables + TYPE(RotOutputType) , INTENT(INOUT) :: y !< Outputs computed at t + TYPE(RotInflowType) , INTENT(IN ) :: RotInflow !< Rotor inflow + INTEGER(IntKi) , INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*) , INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + ! Local Vars + REAL(ReKi) :: totalAngle ! Angle between incoming wind direction and nacelle, + REAL(ReKi) :: tiltAngle ! Tilt angle of the nacelle. + REAL(ReKi) :: yawAngle ! Current Yaw Bearing. + REAL(ReKi) :: areaCd ! Area*Cd of the nacelle projected in the wind direction + REAL(ReKi) :: forceMag ! Drag force aligned with wind direction + Real(ReKi) :: unitDiskVec(3) ! unit vector aligned at an angle of "totalAngle" from yawed rotor disk + Real(ReKi) :: areaCdVec(3) ! Vec containing areas of yz, xz and xy faces of the nacelle * respective Cd's + REAL(ReKi) :: hubHeigthWindSpeed(3) ! hubHeigthWindSpeed(1), hubHeigthWindSpeed(2), and hubHeigthWindSpeed(3) and u, v, and w wind velocities at Hub height + REAL(ReKi) :: force(3) ! Forces in nacelle c.s + REAL(ReKi) :: moment(3) ! Moments in nacelle c.s - do iWT=1,size(u_AD%rotors) - ! Blade - do k = 1,size(u_AD%rotors(iWT)%BladeMotion) - do j = 1,u_AD%rotors(iWT)%BladeMotion(k)%nNodes - node = node + 1 - PosXYZ(:,node) = u_AD%rotors(iWT)%BladeMotion(k)%TranslationDisp(:,j) + u_AD%rotors(iWT)%BladeMotion(k)%Position(:,j) - end do !J = 1,p%Bldnodes ! Loop through the blade nodes / elements - end do !K = 1,p%NumBl - ! Tower - do j = 1,u_AD%rotors(iWT)%TowerMotion%nNodes - node = node + 1 - PosXYZ(:,node) = u_AD%rotors(iWT)%TowerMotion%TranslationDisp(:,J) + u_AD%rotors(iWT)%TowerMotion%Position(:,J) - end do - ! Nacelle - if (u_AD%rotors(iWT)%NacelleMotion%Committed) then - node = node + 1 - PosXYZ(:,node) = u_AD%rotors(iWT)%NacelleMotion%TranslationDisp(:,1) + u_AD%rotors(iWT)%NacelleMotion%Position(:,1) - end if - ! Hub - if (u_AD%rotors(iWT)%HubMotion%Committed) then - node = node + 1 - PosXYZ(:,node) = u_AD%rotors(iWT)%HubMotion%TranslationDisp(:,1) + u_AD%rotors(iWT)%HubMotion%Position(:,1) - end if - ! TailFin - if (u_AD%rotors(iWT)%TFinMotion%Committed) then - node = node + 1 - PosXYZ(:,node) = u_AD%rotors(iWT)%TFinMotion%TranslationDisp(:,1) + u_AD%rotors(iWT)%TFinMotion%Position(:,1) - end if - enddo ! iWT - ! vortex points from FVW in AD15 - if (allocated(o_AD%WakeLocationPoints)) then - do j = 1,size(o_AD%WakeLocationPoints,dim=2) - node = node + 1 - PosXYZ(:,node) = o_AD%WakeLocationPoints(:,j) - enddo !j, wake points - end if -end subroutine AD_SetExternalWindPositions + ErrStat = ErrID_None + ErrMsg = "" + + ! ! Calculating the relative inflow velocity at nacelle + hubHeigthWindSpeed = RotInflow%InflowOnNacelle(:,1) - u%NacelleMotion%TranslationVel(:,1) + + ! Calculating required angles. + yawAngle = atan2(u%NacelleMotion%Orientation(1,2,1), u%NacelleMotion%Orientation(1,1,1)) + call MPi2Pi(yawAngle) + + totalAngle = atan2(hubHeigthWindSpeed(2),hubHeigthWindSpeed(1)) - yawAngle + call MPi2Pi(totalAngle) + + tiltAngle = -1 * atan2(u%NacelleMotion%Orientation(1,3,1), u%NacelleMotion%Orientation(1,1,1)) + call MPi2Pi(tiltAngle) + + ! Unit vector of incoming wind to the nacelle. + unitDiskVec(1) = abs(cos(totalAngle)) + unitDiskVec(2) = abs(sin(totalAngle)) + unitDiskVec(3) = abs(sin(tiltAngle)) + + ! Calculating Area * Cd for the respective areas. Allows for multiple Cds + areaCdVec(1) = p%NacArea(1) * p%NacCd(1) + areaCdVec(2) = p%NacArea(2) * p%NacCd(2) + areaCdVec(3) = p%NacArea(3) * p%NacCd(3) + + ! total nacelle area * Cd projected into incoming wind direction + areaCd = dot_product(areaCdVec, unitDiskVec) + + ! Find drag force (in global X direction) Assuming dominant direction of wind. + forceMag = 0.5 * p%AirDens * (hubHeigthWindSpeed(1)**2 + hubHeigthWindSpeed(2)**2) * areaCd + + ! Decompose along the nacelle length, width and height + force = unitDiskVec*forceMag + + force(1) = sign(force(1),cos(totalAngle)) + force(2) = sign(force(2),sin(totalAngle)) + force(3) = sign(force(3),sin(tiltAngle)) + + ! moment affect due to offset between nacelle reference position and nacelle Drag AC + moment = CROSS_PRODUCT(p%NacDragAC, force) + + ! Add drag forces and moments to nacelle node + y%NacelleLoad%Force(:,1) = y%NacelleLoad%Force(:,1) + matmul(transpose(u%NacelleMotion%Orientation(:,:,1)),force) + y%NacelleLoad%Moment(:,1) = y%NacelleLoad%Moment(:,1) + matmul(transpose(u%NacelleMotion%Orientation(:,:,1)),moment) + ! Adding to misc vars for output in Global c.s. + m%NacDragF = matmul(transpose(u%NacelleMotion%Orientation(:,:,1)),force) + m%NacDragM = matmul(transpose(u%NacelleMotion%Orientation(:,:,1)),moment) + m%NacFi = y%NacelleLoad%Force(:,1) + m%NacMi = y%NacelleLoad%Moment(:,1) + + + +END SUBROUTINE computeNacelleDrag + +!---------------------------------------------------------------------------------------------------------------------------------- END MODULE AeroDyn diff --git a/modules/aerodyn/src/AeroDyn_AllBldNdOuts_IO.f90 b/modules/aerodyn/src/AeroDyn_AllBldNdOuts_IO.f90 index 54b239e4e2..1a9e9bca75 100644 --- a/modules/aerodyn/src/AeroDyn_AllBldNdOuts_IO.f90 +++ b/modules/aerodyn/src/AeroDyn_AllBldNdOuts_IO.f90 @@ -212,6 +212,7 @@ SUBROUTINE AllBldNdOuts_InitOut( InitOut, p, InputFileData, ErrStat, ErrMsg ) INTEGER(IntKi) :: INDX ! Index count within WriteOutput INTEGER(IntKi) :: IdxBlade ! Counter to which blade we are on + INTEGER(IntKi) :: IdxNodeOut ! Counter to the blade node we ae on INTEGER(IntKi) :: IdxNode ! Counter to the blade node we ae on INTEGER(IntKi) :: IdxChan ! Counter to the channel we are outputting. CHARACTER(16) :: ChanPrefix ! Name prefix (AB#N###) @@ -238,7 +239,8 @@ SUBROUTINE AllBldNdOuts_InitOut( InitOut, p, InputFileData, ErrStat, ErrMsg ) DO IdxChan=1,p%BldNd_NumOuts DO IdxBlade=1,p%BldNd_BladesOut - DO IdxNode=1,p%NumBlNds + DO IdxNodeOut=1,p%BldNd_NumNodesOut + IdxNode = p%BldNd_BlOutNd(IdxNodeOut) ! Create the name prefix: WRITE (TmpChar,'(I3.3)') IdxNode ! 3 digit number @@ -264,7 +266,7 @@ END SUBROUTINE AllBldNdOuts_InitOut !! NOTE: the equations here came from the output section of AeroDyn_IO.f90. If anything changes in there, it needs to be reflected !! here. -SUBROUTINE Calc_WriteAllBldNdOutput( p, p_AD, u, m, m_AD, x, y, OtherState, Indx, iRot, ErrStat, ErrMsg ) +SUBROUTINE Calc_WriteAllBldNdOutput( p, p_AD, u, m, m_AD, x, y, OtherState, RotInflow, Indx, iRot, ErrStat, ErrMsg ) TYPE(RotParameterType), INTENT(IN ) :: p ! The rotor parameters TYPE(AD_ParameterType),target,INTENT(IN ) :: p_AD ! The module parameters TYPE(RotInputType), target, INTENT(IN ) :: u ! inputs @@ -273,6 +275,7 @@ SUBROUTINE Calc_WriteAllBldNdOutput( p, p_AD, u, m, m_AD, x, y, OtherState, Indx TYPE(RotContinuousStateType), INTENT(IN ) :: x ! rotor Continuous states TYPE(RotOutputType), INTENT(INOUT) :: y ! outputs (updates y%WriteOutput) TYPE(RotOtherStateType), INTENT(IN ) :: OtherState ! other states + TYPE(RotInflowType), INTENT(IN ) :: RotInflow ! other states%RotInflow(iRot) INTEGER, INTENT(IN ) :: Indx ! index into m%BEMT_u(Indx) array; 1=t and 2=t+dt (but not checked here) INTEGER, INTENT(IN ) :: iRot ! Rotor index, needed for OLAF INTEGER(IntKi), INTENT( OUT) :: ErrStat ! The error status code @@ -282,9 +285,9 @@ SUBROUTINE Calc_WriteAllBldNdOutput( p, p_AD, u, m, m_AD, x, y, OtherState, Indx INTEGER(IntKi) :: iOut ! Index count within WriteOutput INTEGER(IntKi) :: iB, iW ! Counter to which blade we are on, and Wing - INTEGER(IntKi) :: iNd ! Counter to the blade node we ae on + INTEGER(IntKi) :: iNd ! Counter to the blade node we are on + INTEGER(IntKi) :: iNdL ! Counter to the list of blade node we are on INTEGER(IntKi) :: IdxChan ! Counter to the channel we are outputting. - INTEGER(IntKi) :: nB, nNd ! number of blades, number of nodes INTEGER(IntKi) :: compIndx ! index for array component (x,y,z) CHARACTER(*), PARAMETER :: RoutineName = 'Calc_WriteAllBldNdOutput' REAL(ReKi) :: ct, st ! cosine, sine of theta @@ -292,16 +295,18 @@ SUBROUTINE Calc_WriteAllBldNdOutput( p, p_AD, u, m, m_AD, x, y, OtherState, Indx real(ReKi) :: R_ph(3,3) ! Transformation from polar to hub (azimuth rotation along x hub) real(ReKi) :: R_pi(3,3,p%NumBlades) ! Transformation from inertial to polar (same x at hub coordinate system, blade-azimuth rotated) real(ReKi) :: psi_hub ! Azimuth wrt hub - real(R8Ki), dimension(:,:,:,:), pointer :: R_li ! Alias. Transformation from inertial to local-polar to airfoil (3x3xnNodesxnBlades) - real(R8Ki), dimension(:,:,:,:), pointer :: R_wi ! Alias. Transformation from inertial to "WithoutSweepPitchTwist" or "orientationAnnulus". TODO: deprecate me. integer(Intki), dimension(:) , pointer :: W2B ! Alias. Index from Wing index to Blade ! Alias to shorten notations - nB = p%BldNd_BladesOut - nNd = p%NumBlNds - R_li => m%R_li ! inertial to local-polar - R_wi => m%orientationAnnulus ! inertial to without-sweep-pitch-twist or orientation annulus (TODO: deprecate me) - if (p_AD%WakeMod == WakeMod_FVW) W2B => p_AD%FVW%Bld2Wings(iRot, :) ! From Wing index to blade index + ASSOCIATE ( nB => p%BldNd_BladesOut & ! number of blades to output + , nNd => p%BldNd_NumNodesOut & ! number of blade nodes to output + , Nd => p%BldNd_BlOutNd(:) & ! array of blade node indices for output + , R_li => m%R_li & ! inertial to local-polar + , R_wi => m%orientationAnnulus & ! inertial to without-sweep-pitch-twist or orientation annulus (TODO: deprecate me) + ) + + + if (p_AD%Wake_Mod == WakeMod_FVW) W2B => p_AD%FVW%Bld2Wings(iRot, :) ! From Wing index to blade index ! Initialize some things ErrMsg = '' @@ -332,83 +337,83 @@ SUBROUTINE Calc_WriteAllBldNdOutput( p, p_AD, u, m, m_AD, x, y, OtherState, Indx SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) ! Indx contains the information on what channel should be output ! Invalid channel, we still have headers for invalid channels. Need to account for that - CASE (0 ); do iB=1,nB; do iNd=1,nNd; y%WriteOutput(iOut) = 0.0_ReKi; iOut = iOut + 1; enddo;enddo + CASE (0 ); do iB=1,nB; do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = 0.0_ReKi; iOut = iOut + 1; enddo;enddo ! ***** Undisturbed wind velocity in inertial, polar, local and airfoil systems***** - CASE( BldNd_VUndxi ); do iB=1,nB; do iNd=1,nNd; y%WriteOutput(iOut) = u%InflowOnBlade(1,iNd,iB); iOut = iOut + 1; enddo;enddo - CASE( BldNd_VUndyi ); do iB=1,nB; do iNd=1,nNd; y%WriteOutput(iOut) = u%InflowOnBlade(2,iNd,iB); iOut = iOut + 1; enddo;enddo - CASE( BldNd_VUndzi ); do iB=1,nB; do iNd=1,nNd; y%WriteOutput(iOut) = u%InflowOnBlade(3,iNd,iB); iOut = iOut + 1; enddo;enddo + CASE( BldNd_VUndxi ); do iB=1,nB; do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = RotInflow%Blade(iB)%InflowVel(1,iNd); iOut = iOut + 1; enddo;enddo + CASE( BldNd_VUndyi ); do iB=1,nB; do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = RotInflow%Blade(iB)%InflowVel(2,iNd); iOut = iOut + 1; enddo;enddo + CASE( BldNd_VUndzi ); do iB=1,nB; do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = RotInflow%Blade(iB)%InflowVel(3,iNd); iOut = iOut + 1; enddo;enddo - CASE( BldNd_VUndxp ); do iB=1,nB; do iNd=1,nNd; y%WriteOutput(iOut) = dot_product( u%InflowOnBlade(:,iNd,iB), R_pi(1,:,iB) ); iOut = iOut + 1; enddo;enddo - CASE( BldNd_VUndyp ); do iB=1,nB; do iNd=1,nNd; y%WriteOutput(iOut) = dot_product( u%InflowOnBlade(:,iNd,iB), R_pi(2,:,iB) ); iOut = iOut + 1; enddo;enddo - CASE( BldNd_VUndzp ); do iB=1,nB; do iNd=1,nNd; y%WriteOutput(iOut) = dot_product( u%InflowOnBlade(:,iNd,iB), R_pi(3,:,iB) ); iOut = iOut + 1; enddo;enddo + CASE( BldNd_VUndxp ); do iB=1,nB; do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = dot_product( RotInflow%Blade(iB)%InflowVel(:,iNd), R_pi(1,:,iB) ); iOut = iOut + 1; enddo;enddo + CASE( BldNd_VUndyp ); do iB=1,nB; do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = dot_product( RotInflow%Blade(iB)%InflowVel(:,iNd), R_pi(2,:,iB) ); iOut = iOut + 1; enddo;enddo + CASE( BldNd_VUndzp ); do iB=1,nB; do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = dot_product( RotInflow%Blade(iB)%InflowVel(:,iNd), R_pi(3,:,iB) ); iOut = iOut + 1; enddo;enddo - CASE( BldNd_VUndxl ); do iB=1,nB; do iNd=1,nNd; y%WriteOutput(iOut) = dot_product( u%InflowOnBlade(:,iNd,iB), R_li(1,:,iNd,iB) ); iOut = iOut + 1; enddo;enddo - CASE( BldNd_VUndyl ); do iB=1,nB; do iNd=1,nNd; y%WriteOutput(iOut) = dot_product( u%InflowOnBlade(:,iNd,iB), R_li(2,:,iNd,iB) ); iOut = iOut + 1; enddo;enddo - CASE( BldNd_VUndzl ); do iB=1,nB; do iNd=1,nNd; y%WriteOutput(iOut) = dot_product( u%InflowOnBlade(:,iNd,iB), R_li(3,:,iNd,iB) ); iOut = iOut + 1; enddo;enddo + CASE( BldNd_VUndxl ); do iB=1,nB; do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = dot_product( RotInflow%Blade(iB)%InflowVel(:,iNd), R_li(1,:,iNd,iB) ); iOut = iOut + 1; enddo;enddo + CASE( BldNd_VUndyl ); do iB=1,nB; do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = dot_product( RotInflow%Blade(iB)%InflowVel(:,iNd), R_li(2,:,iNd,iB) ); iOut = iOut + 1; enddo;enddo + CASE( BldNd_VUndzl ); do iB=1,nB; do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = dot_product( RotInflow%Blade(iB)%InflowVel(:,iNd), R_li(3,:,iNd,iB) ); iOut = iOut + 1; enddo;enddo - CASE( BldNd_VUndxa ); do iB=1,nB; do iNd=1,nNd; y%WriteOutput(iOut) = dot_product( u%InflowOnBlade(:,iNd,iB), u%BladeMotion(iB)%Orientation(1,:,iNd) ); iOut = iOut + 1; enddo;enddo - CASE( BldNd_VUndya ); do iB=1,nB; do iNd=1,nNd; y%WriteOutput(iOut) = dot_product( u%InflowOnBlade(:,iNd,iB), u%BladeMotion(iB)%Orientation(2,:,iNd) ); iOut = iOut + 1; enddo;enddo - CASE( BldNd_VUndza ); do iB=1,nB; do iNd=1,nNd; y%WriteOutput(iOut) = dot_product( u%InflowOnBlade(:,iNd,iB), u%BladeMotion(iB)%Orientation(3,:,iNd) ); iOut = iOut + 1; enddo;enddo + CASE( BldNd_VUndxa ); do iB=1,nB; do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = dot_product( RotInflow%Blade(iB)%InflowVel(:,iNd), u%BladeMotion(iB)%Orientation(1,:,iNd) ); iOut = iOut + 1; enddo;enddo + CASE( BldNd_VUndya ); do iB=1,nB; do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = dot_product( RotInflow%Blade(iB)%InflowVel(:,iNd), u%BladeMotion(iB)%Orientation(2,:,iNd) ); iOut = iOut + 1; enddo;enddo + CASE( BldNd_VUndza ); do iB=1,nB; do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = dot_product( RotInflow%Blade(iB)%InflowVel(:,iNd), u%BladeMotion(iB)%Orientation(3,:,iNd) ); iOut = iOut + 1; enddo;enddo ! TODO: deprecate this - CASE( BldNd_VUndx ); do iB=1,nB; do iNd=1,nNd; y%WriteOutput(iOut) = dot_product( u%InflowOnBlade(:,iNd,iB), R_wi(1,:,iNd,iB) ); iOut = iOut + 1; enddo;enddo - CASE( BldNd_VUndy ); do iB=1,nB; do iNd=1,nNd; y%WriteOutput(iOut) = dot_product( u%InflowOnBlade(:,iNd,iB), R_wi(2,:,iNd,iB) ); iOut = iOut + 1; enddo;enddo - CASE( BldNd_VUndz ); do iB=1,nB; do iNd=1,nNd; y%WriteOutput(iOut) = dot_product( u%InflowOnBlade(:,iNd,iB), R_wi(3,:,iNd,iB) ); iOut = iOut + 1; enddo;enddo + CASE( BldNd_VUndx ); do iB=1,nB; do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = dot_product( RotInflow%Blade(iB)%InflowVel(:,iNd), R_wi(1,:,iNd,iB) ); iOut = iOut + 1; enddo;enddo + CASE( BldNd_VUndy ); do iB=1,nB; do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = dot_product( RotInflow%Blade(iB)%InflowVel(:,iNd), R_wi(2,:,iNd,iB) ); iOut = iOut + 1; enddo;enddo + CASE( BldNd_VUndz ); do iB=1,nB; do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = dot_product( RotInflow%Blade(iB)%InflowVel(:,iNd), R_wi(3,:,iNd,iB) ); iOut = iOut + 1; enddo;enddo ! ***** Disturbed wind velocity in inertial, polar, local and airfoil systems***** - CASE( BldNd_VDisxi ); do iB=1,nB; do iNd=1,nNd; y%WriteOutput(iOut) = m%DisturbedInflow(1,iNd,iB); iOut = iOut + 1; enddo;enddo - CASE( BldNd_VDisyi ); do iB=1,nB; do iNd=1,nNd; y%WriteOutput(iOut) = m%DisturbedInflow(2,iNd,iB); iOut = iOut + 1; enddo;enddo - CASE( BldNd_VDiszi ); do iB=1,nB; do iNd=1,nNd; y%WriteOutput(iOut) = m%DisturbedInflow(3,iNd,iB); iOut = iOut + 1; enddo;enddo + CASE( BldNd_VDisxi ); do iB=1,nB; do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = m%DisturbedInflow(1,iNd,iB); iOut = iOut + 1; enddo;enddo + CASE( BldNd_VDisyi ); do iB=1,nB; do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = m%DisturbedInflow(2,iNd,iB); iOut = iOut + 1; enddo;enddo + CASE( BldNd_VDiszi ); do iB=1,nB; do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = m%DisturbedInflow(3,iNd,iB); iOut = iOut + 1; enddo;enddo - CASE( BldNd_VDisxp ); do iB=1,nB; do iNd=1,nNd; y%WriteOutput(iOut) = dot_product( m%DisturbedInflow(:,iNd,iB), R_pi(1,:,iB) ); iOut = iOut + 1; enddo;enddo - CASE( BldNd_VDisyp ); do iB=1,nB; do iNd=1,nNd; y%WriteOutput(iOut) = dot_product( m%DisturbedInflow(:,iNd,iB), R_pi(2,:,iB) ); iOut = iOut + 1; enddo;enddo - CASE( BldNd_VDiszp ); do iB=1,nB; do iNd=1,nNd; y%WriteOutput(iOut) = dot_product( m%DisturbedInflow(:,iNd,iB), R_pi(3,:,iB) ); iOut = iOut + 1; enddo;enddo + CASE( BldNd_VDisxp ); do iB=1,nB; do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = dot_product( m%DisturbedInflow(:,iNd,iB), R_pi(1,:,iB) ); iOut = iOut + 1; enddo;enddo + CASE( BldNd_VDisyp ); do iB=1,nB; do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = dot_product( m%DisturbedInflow(:,iNd,iB), R_pi(2,:,iB) ); iOut = iOut + 1; enddo;enddo + CASE( BldNd_VDiszp ); do iB=1,nB; do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = dot_product( m%DisturbedInflow(:,iNd,iB), R_pi(3,:,iB) ); iOut = iOut + 1; enddo;enddo - CASE( BldNd_VDisxl ); do iB=1,nB; do iNd=1,nNd; y%WriteOutput(iOut) = dot_product( m%DisturbedInflow(:,iNd,iB), R_li(1,:,iNd,iB) ); iOut = iOut + 1; enddo;enddo - CASE( BldNd_VDisyl ); do iB=1,nB; do iNd=1,nNd; y%WriteOutput(iOut) = dot_product( m%DisturbedInflow(:,iNd,iB), R_li(2,:,iNd,iB) ); iOut = iOut + 1; enddo;enddo - CASE( BldNd_VDiszl ); do iB=1,nB; do iNd=1,nNd; y%WriteOutput(iOut) = dot_product( m%DisturbedInflow(:,iNd,iB), R_li(3,:,iNd,iB) ); iOut = iOut + 1; enddo;enddo + CASE( BldNd_VDisxl ); do iB=1,nB; do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = dot_product( m%DisturbedInflow(:,iNd,iB), R_li(1,:,iNd,iB) ); iOut = iOut + 1; enddo;enddo + CASE( BldNd_VDisyl ); do iB=1,nB; do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = dot_product( m%DisturbedInflow(:,iNd,iB), R_li(2,:,iNd,iB) ); iOut = iOut + 1; enddo;enddo + CASE( BldNd_VDiszl ); do iB=1,nB; do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = dot_product( m%DisturbedInflow(:,iNd,iB), R_li(3,:,iNd,iB) ); iOut = iOut + 1; enddo;enddo - CASE( BldNd_VDisxa ); do iB=1,nB; do iNd=1,nNd; y%WriteOutput(iOut) = dot_product( m%DisturbedInflow(:,iNd,iB), u%BladeMotion(iB)%Orientation(1,:,iNd) ); iOut = iOut + 1; enddo;enddo - CASE( BldNd_VDisya ); do iB=1,nB; do iNd=1,nNd; y%WriteOutput(iOut) = dot_product( m%DisturbedInflow(:,iNd,iB), u%BladeMotion(iB)%Orientation(2,:,iNd) ); iOut = iOut + 1; enddo;enddo - CASE( BldNd_VDisza ); do iB=1,nB; do iNd=1,nNd; y%WriteOutput(iOut) = dot_product( m%DisturbedInflow(:,iNd,iB), u%BladeMotion(iB)%Orientation(3,:,iNd) ); iOut = iOut + 1; enddo;enddo + CASE( BldNd_VDisxa ); do iB=1,nB; do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = dot_product( m%DisturbedInflow(:,iNd,iB), u%BladeMotion(iB)%Orientation(1,:,iNd) ); iOut = iOut + 1; enddo;enddo + CASE( BldNd_VDisya ); do iB=1,nB; do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = dot_product( m%DisturbedInflow(:,iNd,iB), u%BladeMotion(iB)%Orientation(2,:,iNd) ); iOut = iOut + 1; enddo;enddo + CASE( BldNd_VDisza ); do iB=1,nB; do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = dot_product( m%DisturbedInflow(:,iNd,iB), u%BladeMotion(iB)%Orientation(3,:,iNd) ); iOut = iOut + 1; enddo;enddo ! TODO: deprecate this - CASE( BldNd_VDisx ); do iB=1,nB; do iNd=1,nNd; y%WriteOutput(iOut) = dot_product( m%DisturbedInflow(:,iNd,iB), R_wi(1,:,iNd,iB) ); iOut = iOut + 1; enddo;enddo - CASE( BldNd_VDisy ); do iB=1,nB; do iNd=1,nNd; y%WriteOutput(iOut) = dot_product( m%DisturbedInflow(:,iNd,iB), R_wi(2,:,iNd,iB) ); iOut = iOut + 1; enddo;enddo - CASE( BldNd_VDisz ); do iB=1,nB; do iNd=1,nNd; y%WriteOutput(iOut) = dot_product( m%DisturbedInflow(:,iNd,iB), R_wi(3,:,iNd,iB) ); iOut = iOut + 1; enddo;enddo + CASE( BldNd_VDisx ); do iB=1,nB; do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = dot_product( m%DisturbedInflow(:,iNd,iB), R_wi(1,:,iNd,iB) ); iOut = iOut + 1; enddo;enddo + CASE( BldNd_VDisy ); do iB=1,nB; do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = dot_product( m%DisturbedInflow(:,iNd,iB), R_wi(2,:,iNd,iB) ); iOut = iOut + 1; enddo;enddo + CASE( BldNd_VDisz ); do iB=1,nB; do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = dot_product( m%DisturbedInflow(:,iNd,iB), R_wi(3,:,iNd,iB) ); iOut = iOut + 1; enddo;enddo ! ***** Structural translational velocity inertial, polar, local and airfoil systems***** - CASE( BldNd_STVxi ); do iB=1,nB; do iNd=1,nNd; y%WriteOutput(iOut) = u%BladeMotion(iB)%TranslationVel(1,iNd); iOut = iOut + 1; enddo;enddo - CASE( BldNd_STVyi ); do iB=1,nB; do iNd=1,nNd; y%WriteOutput(iOut) = u%BladeMotion(iB)%TranslationVel(2,iNd); iOut = iOut + 1; enddo;enddo - CASE( BldNd_STVzi ); do iB=1,nB; do iNd=1,nNd; y%WriteOutput(iOut) = u%BladeMotion(iB)%TranslationVel(3,iNd); iOut = iOut + 1; enddo;enddo + CASE( BldNd_STVxi ); do iB=1,nB; do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = u%BladeMotion(iB)%TranslationVel(1,iNd); iOut = iOut + 1; enddo;enddo + CASE( BldNd_STVyi ); do iB=1,nB; do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = u%BladeMotion(iB)%TranslationVel(2,iNd); iOut = iOut + 1; enddo;enddo + CASE( BldNd_STVzi ); do iB=1,nB; do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = u%BladeMotion(iB)%TranslationVel(3,iNd); iOut = iOut + 1; enddo;enddo - CASE( BldNd_STVxp ); do iB=1,nB; do iNd=1,nNd; y%WriteOutput(iOut) = dot_product( u%BladeMotion(iB)%TranslationVel(:,iNd), R_pi(1,:,iB) ); iOut = iOut + 1; enddo;enddo - CASE( BldNd_STVyp ); do iB=1,nB; do iNd=1,nNd; y%WriteOutput(iOut) = dot_product( u%BladeMotion(iB)%TranslationVel(:,iNd), R_pi(2,:,iB) ); iOut = iOut + 1; enddo;enddo - CASE( BldNd_STVzp ); do iB=1,nB; do iNd=1,nNd; y%WriteOutput(iOut) = dot_product( u%BladeMotion(iB)%TranslationVel(:,iNd), R_pi(3,:,iB) ); iOut = iOut + 1; enddo;enddo + CASE( BldNd_STVxp ); do iB=1,nB; do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = dot_product( u%BladeMotion(iB)%TranslationVel(:,iNd), R_pi(1,:,iB) ); iOut = iOut + 1; enddo;enddo + CASE( BldNd_STVyp ); do iB=1,nB; do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = dot_product( u%BladeMotion(iB)%TranslationVel(:,iNd), R_pi(2,:,iB) ); iOut = iOut + 1; enddo;enddo + CASE( BldNd_STVzp ); do iB=1,nB; do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = dot_product( u%BladeMotion(iB)%TranslationVel(:,iNd), R_pi(3,:,iB) ); iOut = iOut + 1; enddo;enddo - CASE( BldNd_STVxl ); do iB=1,nB; do iNd=1,nNd; y%WriteOutput(iOut) = dot_product( u%BladeMotion(iB)%TranslationVel(:,iNd), R_li(1,:,iNd,iB) ); iOut = iOut + 1; enddo;enddo - CASE( BldNd_STVyl ); do iB=1,nB; do iNd=1,nNd; y%WriteOutput(iOut) = dot_product( u%BladeMotion(iB)%TranslationVel(:,iNd), R_li(2,:,iNd,iB) ); iOut = iOut + 1; enddo;enddo - CASE( BldNd_STVzl ); do iB=1,nB; do iNd=1,nNd; y%WriteOutput(iOut) = dot_product( u%BladeMotion(iB)%TranslationVel(:,iNd), R_li(3,:,iNd,iB) ); iOut = iOut + 1; enddo;enddo + CASE( BldNd_STVxl ); do iB=1,nB; do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = dot_product( u%BladeMotion(iB)%TranslationVel(:,iNd), R_li(1,:,iNd,iB) ); iOut = iOut + 1; enddo;enddo + CASE( BldNd_STVyl ); do iB=1,nB; do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = dot_product( u%BladeMotion(iB)%TranslationVel(:,iNd), R_li(2,:,iNd,iB) ); iOut = iOut + 1; enddo;enddo + CASE( BldNd_STVzl ); do iB=1,nB; do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = dot_product( u%BladeMotion(iB)%TranslationVel(:,iNd), R_li(3,:,iNd,iB) ); iOut = iOut + 1; enddo;enddo - CASE( BldNd_STVxa ); do iB=1,nB; do iNd=1,nNd; y%WriteOutput(iOut) = dot_product( u%BladeMotion(iB)%TranslationVel(:,iNd), u%BladeMotion(iB)%Orientation(1,:,iNd) ); iOut = iOut + 1; enddo;enddo - CASE( BldNd_STVya ); do iB=1,nB; do iNd=1,nNd; y%WriteOutput(iOut) = dot_product( u%BladeMotion(iB)%TranslationVel(:,iNd), u%BladeMotion(iB)%Orientation(2,:,iNd) ); iOut = iOut + 1; enddo;enddo - CASE( BldNd_STVza ); do iB=1,nB; do iNd=1,nNd; y%WriteOutput(iOut) = dot_product( u%BladeMotion(iB)%TranslationVel(:,iNd), u%BladeMotion(iB)%Orientation(3,:,iNd) ); iOut = iOut + 1; enddo;enddo + CASE( BldNd_STVxa ); do iB=1,nB; do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = dot_product( u%BladeMotion(iB)%TranslationVel(:,iNd), u%BladeMotion(iB)%Orientation(1,:,iNd) ); iOut = iOut + 1; enddo;enddo + CASE( BldNd_STVya ); do iB=1,nB; do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = dot_product( u%BladeMotion(iB)%TranslationVel(:,iNd), u%BladeMotion(iB)%Orientation(2,:,iNd) ); iOut = iOut + 1; enddo;enddo + CASE( BldNd_STVza ); do iB=1,nB; do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = dot_product( u%BladeMotion(iB)%TranslationVel(:,iNd), u%BladeMotion(iB)%Orientation(3,:,iNd) ); iOut = iOut + 1; enddo;enddo ! TODO: deprecate this - CASE( BldNd_STVx ); do iB=1,nB; do iNd=1,nNd; y%WriteOutput(iOut) = dot_product( u%BladeMotion(iB)%TranslationVel(:,iNd), R_wi(1,:,iNd,iB) ); iOut = iOut + 1; enddo;enddo - CASE( BldNd_STVy ); do iB=1,nB; do iNd=1,nNd; y%WriteOutput(iOut) = dot_product( u%BladeMotion(iB)%TranslationVel(:,iNd), R_wi(2,:,iNd,iB) ); iOut = iOut + 1; enddo;enddo - CASE( BldNd_STVz ); do iB=1,nB; do iNd=1,nNd; y%WriteOutput(iOut) = dot_product( u%BladeMotion(iB)%TranslationVel(:,iNd), R_wi(3,:,iNd,iB) ); iOut = iOut + 1; enddo;enddo + CASE( BldNd_STVx ); do iB=1,nB; do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = dot_product( u%BladeMotion(iB)%TranslationVel(:,iNd), R_wi(1,:,iNd,iB) ); iOut = iOut + 1; enddo;enddo + CASE( BldNd_STVy ); do iB=1,nB; do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = dot_product( u%BladeMotion(iB)%TranslationVel(:,iNd), R_wi(2,:,iNd,iB) ); iOut = iOut + 1; enddo;enddo + CASE( BldNd_STVz ); do iB=1,nB; do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = dot_product( u%BladeMotion(iB)%TranslationVel(:,iNd), R_wi(3,:,iNd,iB) ); iOut = iOut + 1; enddo;enddo ! ***** Induced velocities in inertial, polar, local and airfoil systems***** ! Axial and tangential induced wind velocity ! TODO use m%Vind_i and R_wi CASE ( BldNd_Vindx ) - if (p_AD%WakeMod /= WakeMod_FVW) then + if (p_AD%Wake_Mod /= WakeMod_FVW) then do iB=1,nB - do iNd=1,nNd + do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = - m%BEMT_u(Indx)%Vx(iNd,iB) * m%BEMT_y%axInduction( iNd,iB) iOut = iOut + 1 enddo @@ -416,7 +421,7 @@ SUBROUTINE Calc_WriteAllBldNdOutput( p, p_AD, u, m, m_AD, x, y, OtherState, Indx else do iB=1,nB iW = W2B(iB) - do iNd=1,nNd; + do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = -m_AD%FVW%W(iW)%BN_UrelWind_s(1,iNd) * m_AD%FVW%W(iW)%BN_AxInd(iNd) iOut = iOut + 1 enddo @@ -424,9 +429,9 @@ SUBROUTINE Calc_WriteAllBldNdOutput( p, p_AD, u, m, m_AD, x, y, OtherState, Indx endif CASE ( BldNd_Vindy ) - if (p_AD%WakeMod /= WakeMod_FVW) then + if (p_AD%Wake_Mod /= WakeMod_FVW) then DO iB=1,nB - DO iNd=1,nNd + do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = m%BEMT_u(Indx)%Vy(iNd,iB) * m%BEMT_y%tanInduction(iNd,iB) iOut = iOut + 1 END DO @@ -434,36 +439,36 @@ SUBROUTINE Calc_WriteAllBldNdOutput( p, p_AD, u, m, m_AD, x, y, OtherState, Indx else DO iB=1,nB iW = W2B(iB) - DO iNd=1,nNd + do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = m_AD%FVW%W(iW)%BN_UrelWind_s(2,iNd) * m_AD%FVW%W(iW)%BN_TanInd(iNd) iOut = iOut + 1 END DO END DO endif - CASE( BldNd_Vindxi ); do iB=1,nB; do iNd=1,nNd; y%WriteOutput(iOut) = m%Vind_i(1, iNd, iB); iOut = iOut + 1; enddo;enddo - CASE( BldNd_Vindyi ); do iB=1,nB; do iNd=1,nNd; y%WriteOutput(iOut) = m%Vind_i(2, iNd, iB); iOut = iOut + 1; enddo;enddo - CASE( BldNd_Vindzi ); do iB=1,nB; do iNd=1,nNd; y%WriteOutput(iOut) = m%Vind_i(3, iNd, iB); iOut = iOut + 1; enddo;enddo + CASE( BldNd_Vindxi ); do iB=1,nB; do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = m%Vind_i(1, iNd, iB); iOut = iOut + 1; enddo;enddo + CASE( BldNd_Vindyi ); do iB=1,nB; do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = m%Vind_i(2, iNd, iB); iOut = iOut + 1; enddo;enddo + CASE( BldNd_Vindzi ); do iB=1,nB; do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = m%Vind_i(3, iNd, iB); iOut = iOut + 1; enddo;enddo - CASE( BldNd_Vindxp ); do iB=1,nB; do iNd=1,nNd; y%WriteOutput(iOut) = dot_product( m%Vind_i(:, iNd, iB), R_pi(1,:,iB) ); iOut = iOut + 1; enddo;enddo - CASE( BldNd_Vindyp ); do iB=1,nB; do iNd=1,nNd; y%WriteOutput(iOut) = dot_product( m%Vind_i(:, iNd, iB), R_pi(2,:,iB) ); iOut = iOut + 1; enddo;enddo - CASE( BldNd_Vindzp ); do iB=1,nB; do iNd=1,nNd; y%WriteOutput(iOut) = dot_product( m%Vind_i(:, iNd, iB), R_pi(3,:,iB) ); iOut = iOut + 1; enddo;enddo + CASE( BldNd_Vindxp ); do iB=1,nB; do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = dot_product( m%Vind_i(:, iNd, iB), R_pi(1,:,iB) ); iOut = iOut + 1; enddo;enddo + CASE( BldNd_Vindyp ); do iB=1,nB; do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = dot_product( m%Vind_i(:, iNd, iB), R_pi(2,:,iB) ); iOut = iOut + 1; enddo;enddo + CASE( BldNd_Vindzp ); do iB=1,nB; do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = dot_product( m%Vind_i(:, iNd, iB), R_pi(3,:,iB) ); iOut = iOut + 1; enddo;enddo - CASE( BldNd_Vindxl ); do iB=1,nB; do iNd=1,nNd; y%WriteOutput(iOut) = dot_product( m%Vind_i(:, iNd, iB), R_li(1,:,iNd,iB) ); iOut = iOut + 1; enddo;enddo - CASE( BldNd_Vindyl ); do iB=1,nB; do iNd=1,nNd; y%WriteOutput(iOut) = dot_product( m%Vind_i(:, iNd, iB), R_li(2,:,iNd,iB) ); iOut = iOut + 1; enddo;enddo - CASE( BldNd_Vindzl ); do iB=1,nB; do iNd=1,nNd; y%WriteOutput(iOut) = dot_product( m%Vind_i(:, iNd, iB), R_li(3,:,iNd,iB) ); iOut = iOut + 1; enddo;enddo + CASE( BldNd_Vindxl ); do iB=1,nB; do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = dot_product( m%Vind_i(:, iNd, iB), R_li(1,:,iNd,iB) ); iOut = iOut + 1; enddo;enddo + CASE( BldNd_Vindyl ); do iB=1,nB; do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = dot_product( m%Vind_i(:, iNd, iB), R_li(2,:,iNd,iB) ); iOut = iOut + 1; enddo;enddo + CASE( BldNd_Vindzl ); do iB=1,nB; do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = dot_product( m%Vind_i(:, iNd, iB), R_li(3,:,iNd,iB) ); iOut = iOut + 1; enddo;enddo - CASE( BldNd_Vindxa ); do iB=1,nB; do iNd=1,nNd; y%WriteOutput(iOut) = dot_product( m%Vind_i(:, iNd, iB), u%BladeMotion(iB)%Orientation(1,:,iNd) ); iOut = iOut + 1; enddo;enddo - CASE( BldNd_Vindya ); do iB=1,nB; do iNd=1,nNd; y%WriteOutput(iOut) = dot_product( m%Vind_i(:, iNd, iB), u%BladeMotion(iB)%Orientation(2,:,iNd) ); iOut = iOut + 1; enddo;enddo - CASE( BldNd_Vindza ); do iB=1,nB; do iNd=1,nNd; y%WriteOutput(iOut) = dot_product( m%Vind_i(:, iNd, iB), u%BladeMotion(iB)%Orientation(3,:,iNd) ); iOut = iOut + 1; enddo;enddo + CASE( BldNd_Vindxa ); do iB=1,nB; do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = dot_product( m%Vind_i(:, iNd, iB), u%BladeMotion(iB)%Orientation(1,:,iNd) ); iOut = iOut + 1; enddo;enddo + CASE( BldNd_Vindya ); do iB=1,nB; do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = dot_product( m%Vind_i(:, iNd, iB), u%BladeMotion(iB)%Orientation(2,:,iNd) ); iOut = iOut + 1; enddo;enddo + CASE( BldNd_Vindza ); do iB=1,nB; do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = dot_product( m%Vind_i(:, iNd, iB), u%BladeMotion(iB)%Orientation(3,:,iNd) ); iOut = iOut + 1; enddo;enddo ! TODO: Vrel, DynP, Re, Ma - should be unified across lifting-line implementations. Vrel should be computed based on velocities in (a)-system ! Relative wind speed CASE ( BldNd_VRel ) - if (p_AD%WakeMod /= WakeMod_FVW) then + if (p_AD%Wake_Mod /= WakeMod_FVW) then DO iB=1,nB - DO iNd=1,nNd + do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = m%BEMT_y%Vrel(iNd,iB) iOut = iOut + 1 END DO @@ -471,7 +476,7 @@ SUBROUTINE Calc_WriteAllBldNdOutput( p, p_AD, u, m, m_AD, x, y, OtherState, Indx else DO iB=1,nB iW = W2B(iB) - DO iNd=1,nNd + do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = m_AD%FVW%W(iW)%BN_Vrel(iNd) iOut = iOut + 1 END DO @@ -480,9 +485,9 @@ SUBROUTINE Calc_WriteAllBldNdOutput( p, p_AD, u, m, m_AD, x, y, OtherState, Indx ! Dynamic pressure CASE ( BldNd_DynP ) - if (p_AD%WakeMod /= WakeMod_FVW) then + if (p_AD%Wake_Mod /= WakeMod_FVW) then DO iB=1,nB - DO iNd=1,nNd + do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = 0.5 * p%airDens * m%BEMT_y%Vrel(iNd,iB)**2 iOut = iOut + 1 END DO @@ -490,7 +495,7 @@ SUBROUTINE Calc_WriteAllBldNdOutput( p, p_AD, u, m, m_AD, x, y, OtherState, Indx else DO iB=1,nB iW = W2B(iB) - DO iNd=1,nNd + do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = 0.5 * p%airDens * m_AD%FVW%W(iW)%BN_Vrel(iNd)**2 iOut = iOut + 1 END DO @@ -499,9 +504,9 @@ SUBROUTINE Calc_WriteAllBldNdOutput( p, p_AD, u, m, m_AD, x, y, OtherState, Indx ! Reynolds number (in millions) CASE ( BldNd_Re ) - if (p_AD%WakeMod /= WakeMod_FVW) then + if (p_AD%Wake_Mod /= WakeMod_FVW) then DO iB=1,nB - DO iNd=1,nNd + do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = p%BEMT%chord(iNd,iB) * m%BEMT_y%Vrel(iNd,iB) / p%KinVisc / 1.0E6 iOut = iOut + 1 END DO @@ -509,7 +514,7 @@ SUBROUTINE Calc_WriteAllBldNdOutput( p, p_AD, u, m, m_AD, x, y, OtherState, Indx else DO iB=1,nB iW = W2B(iB) - DO iNd=1,nNd + do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = m_AD%FVW%W(iW)%BN_Re(iNd) / 1.0E6 iOut = iOut + 1 END DO @@ -518,9 +523,9 @@ SUBROUTINE Calc_WriteAllBldNdOutput( p, p_AD, u, m, m_AD, x, y, OtherState, Indx ! Mach number CASE ( BldNd_M ) - if (p_AD%WakeMod /= WakeMod_FVW) then + if (p_AD%Wake_Mod /= WakeMod_FVW) then DO iB=1,nB - DO iNd=1,nNd + do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = m%BEMT_y%Vrel(iNd,iB) / p%SpdSound iOut = iOut + 1 END DO @@ -528,7 +533,7 @@ SUBROUTINE Calc_WriteAllBldNdOutput( p, p_AD, u, m, m_AD, x, y, OtherState, Indx else DO iB=1,nB iW = W2B(iB) - DO iNd=1,nNd + do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = m_AD%FVW%W(iW)%BN_Vrel(iNd) / p%SpdSound iOut = iOut + 1 END DO @@ -538,9 +543,9 @@ SUBROUTINE Calc_WriteAllBldNdOutput( p, p_AD, u, m, m_AD, x, y, OtherState, Indx ! Axial and tangential induction factors CASE ( BldNd_AxInd ) - if (p_AD%WakeMod /= WakeMod_FVW) then + if (p_AD%Wake_Mod /= WakeMod_FVW) then DO iB=1,nB - DO iNd=1,nNd + do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = m%BEMT_y%axInduction(iNd,iB) iOut = iOut + 1 END DO @@ -548,7 +553,7 @@ SUBROUTINE Calc_WriteAllBldNdOutput( p, p_AD, u, m, m_AD, x, y, OtherState, Indx else DO iB=1,nB iW = W2B(iB) - DO iNd=1,nNd + do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = m_AD%FVW%W(iW)%BN_AxInd(iNd) iOut = iOut + 1 END DO @@ -556,9 +561,9 @@ SUBROUTINE Calc_WriteAllBldNdOutput( p, p_AD, u, m, m_AD, x, y, OtherState, Indx endif CASE ( BldNd_TnInd ) - if (p_AD%WakeMod /= WakeMod_FVW) then + if (p_AD%Wake_Mod /= WakeMod_FVW) then DO iB=1,nB - DO iNd=1,nNd + do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = m%BEMT_y%tanInduction(iNd,iB) iOut = iOut + 1 END DO @@ -566,7 +571,7 @@ SUBROUTINE Calc_WriteAllBldNdOutput( p, p_AD, u, m, m_AD, x, y, OtherState, Indx else DO iB=1,nB iW = W2B(iB) - DO iNd=1,nNd + do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = m_AD%FVW%W(iW)%BN_TanInd(iNd) iOut = iOut + 1 END DO @@ -575,9 +580,9 @@ SUBROUTINE Calc_WriteAllBldNdOutput( p, p_AD, u, m, m_AD, x, y, OtherState, Indx ! Quasi-steady Axial and tangential induction factors CASE ( BldNd_AxInd_qs ) - if (p_AD%WakeMod /= WakeMod_FVW) then + if (p_AD%Wake_Mod /= WakeMod_FVW) then DO iB=1,nB - DO iNd=1,nNd + do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = m%BEMT_y%axInduction_qs(iNd,iB) iOut = iOut + 1 END DO @@ -585,7 +590,7 @@ SUBROUTINE Calc_WriteAllBldNdOutput( p, p_AD, u, m, m_AD, x, y, OtherState, Indx else DO iB=1,nB iW = W2B(iB) - DO iNd=1,nNd + do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = m_AD%FVW%W(iW)%BN_AxInd(iNd) ! TODO iOut = iOut + 1 END DO @@ -593,9 +598,9 @@ SUBROUTINE Calc_WriteAllBldNdOutput( p, p_AD, u, m, m_AD, x, y, OtherState, Indx endif CASE ( BldNd_TnInd_qs ) - if (p_AD%WakeMod /= WakeMod_FVW) then + if (p_AD%Wake_Mod /= WakeMod_FVW) then DO iB=1,nB - DO iNd=1,nNd + do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = m%BEMT_y%tanInduction_qs(iNd,iB) iOut = iOut + 1 END DO @@ -603,19 +608,19 @@ SUBROUTINE Calc_WriteAllBldNdOutput( p, p_AD, u, m, m_AD, x, y, OtherState, Indx else DO iB=1,nB iW = W2B(iB) - DO iNd=1,nNd + do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = m_AD%FVW%W(iW)%BN_TanInd(iNd) ! TODO iOut = iOut + 1 END DO END DO endif - + ! AoA, pitch+twist angle, inflow angle, and curvature angle CASE ( BldNd_Alpha ) - if (p_AD%WakeMod /= WakeMod_FVW) then + if (p_AD%Wake_Mod /= WakeMod_FVW) then DO iB=1,nB - DO iNd=1,nNd + do iNdL=1,nNd; iNd=Nd(iNdL); ! TODO Change this y%WriteOutput(iOut) = Rad2M180to180Deg( m%BEMT_y%phi(iNd,iB) - m%BEMT_u(Indx)%theta(iNd,iB) ) iOut = iOut + 1 @@ -624,7 +629,7 @@ SUBROUTINE Calc_WriteAllBldNdOutput( p, p_AD, u, m, m_AD, x, y, OtherState, Indx else DO iB=1,nB iW = W2B(iB) - DO iNd=1,nNd + do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = m_AD%FVW%W(iW)%BN_alpha(iNd)*R2D iOut = iOut + 1 END DO @@ -632,9 +637,9 @@ SUBROUTINE Calc_WriteAllBldNdOutput( p, p_AD, u, m, m_AD, x, y, OtherState, Indx endif CASE ( BldNd_Theta ) - if (p_AD%WakeMod /= WakeMod_FVW) then + if (p_AD%Wake_Mod /= WakeMod_FVW) then DO iB=1,nB - DO iNd=1,nNd + do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = m%BEMT_u(Indx)%theta(iNd,iB)*R2D iOut = iOut + 1 END DO @@ -642,7 +647,7 @@ SUBROUTINE Calc_WriteAllBldNdOutput( p, p_AD, u, m, m_AD, x, y, OtherState, Indx else DO iB=1,nB iW = W2B(iB) - DO iNd=1,nNd + do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = m_AD%FVW%W(iW)%PitchAndTwist(iNd)*R2D iOut = iOut + 1 END DO @@ -650,9 +655,9 @@ SUBROUTINE Calc_WriteAllBldNdOutput( p, p_AD, u, m, m_AD, x, y, OtherState, Indx endif CASE ( BldNd_Phi ) - if (p_AD%WakeMod /= WakeMod_FVW) then + if (p_AD%Wake_Mod /= WakeMod_FVW) then DO iB=1,nB - DO iNd=1,nNd + do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = m%BEMT_y%phi(iNd,iB)*R2D iOut = iOut + 1 END DO @@ -660,7 +665,7 @@ SUBROUTINE Calc_WriteAllBldNdOutput( p, p_AD, u, m, m_AD, x, y, OtherState, Indx else DO iB=1,nB iW = W2B(iB) - DO iNd=1,nNd + do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) =m_AD%FVW%W(iW)%BN_phi(iNd)*R2D iOut = iOut + 1 END DO @@ -668,49 +673,28 @@ SUBROUTINE Calc_WriteAllBldNdOutput( p, p_AD, u, m, m_AD, x, y, OtherState, Indx endif CASE ( BldNd_Curve ) - if (p_AD%WakeMod /= WakeMod_FVW) then - DO iB=1,nB - DO iNd=1,nNd - y%WriteOutput(iOut) = m%Curve(iNd,iB)*R2D - iOut = iOut + 1 - END DO - END DO - else - DO iB=1,nB - iW = W2B(iB) - DO iNd=1,nNd -!NOT available in FVW yet - y%WriteOutput(iOut) = 0.0_ReKi - iOut = iOut + 1 - END DO + DO iB=1,nB + DO iNdL=1,nNd; iNd=Nd(iNdL); + y%WriteOutput(iOut) = m%Cant(iNd,iB)*R2D + iOut = iOut + 1 END DO - endif + END DO CASE ( BldNd_Toe ) - if (p_AD%WakeMod /= WakeMod_FVW) then - DO iB=1,nB - DO iNd=1,nNd - y%WriteOutput(iOut) = m%BEMT_u(Indx)%toeAngle(iNd,iB)*R2D - iOut = iOut + 1 - END DO - END DO - else - DO iB=1,nB - iW = W2B(iB) - DO iNd=1,nNd - y%WriteOutput(iOut) = 0.0_ReKi - iOut = iOut + 1 - END DO + DO iB=1,nB + DO iNdL=1,nNd; iNd=Nd(iNdL); + y%WriteOutput(iOut) = m%Toe(iNd,iB)*R2D + iOut = iOut + 1 END DO - endif + END DO ! Unsteady lift force, drag force, pitching moment coefficients ! TODO this should be somehow unified across lifting-line implementations CASE ( BldNd_Cl ) - if (p_AD%WakeMod /= WakeMod_FVW) then + if (p_AD%Wake_Mod /= WakeMod_FVW) then DO iB=1,nB - DO iNd=1,nNd + do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = m%BEMT_y%Cl(iNd,iB) iOut = iOut + 1 END DO @@ -718,7 +702,7 @@ SUBROUTINE Calc_WriteAllBldNdOutput( p, p_AD, u, m, m_AD, x, y, OtherState, Indx else DO iB=1,nB iW = W2B(iB) - DO iNd=1,nNd + do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = m_AD%FVW%W(iW)%BN_Cl(iNd) iOut = iOut + 1 END DO @@ -726,9 +710,9 @@ SUBROUTINE Calc_WriteAllBldNdOutput( p, p_AD, u, m, m_AD, x, y, OtherState, Indx endif CASE ( BldNd_Cd ) - if (p_AD%WakeMod /= WakeMod_FVW) then + if (p_AD%Wake_Mod /= WakeMod_FVW) then DO iB=1,nB - DO iNd=1,nNd + do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = m%BEMT_y%Cd(iNd,iB) iOut = iOut + 1 END DO @@ -736,7 +720,7 @@ SUBROUTINE Calc_WriteAllBldNdOutput( p, p_AD, u, m, m_AD, x, y, OtherState, Indx else DO iB=1,nB iW = W2B(iB) - DO iNd=1,nNd + do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = m_AD%FVW%W(iW)%BN_Cd(iNd) iOut = iOut + 1 END DO @@ -744,9 +728,9 @@ SUBROUTINE Calc_WriteAllBldNdOutput( p, p_AD, u, m, m_AD, x, y, OtherState, Indx endif CASE ( BldNd_Cm ) - if (p_AD%WakeMod /= WakeMod_FVW) then + if (p_AD%Wake_Mod /= WakeMod_FVW) then DO iB=1,nB - DO iNd=1,nNd + do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = m%BEMT_y%Cm(iNd,iB) iOut = iOut + 1 END DO @@ -754,7 +738,7 @@ SUBROUTINE Calc_WriteAllBldNdOutput( p, p_AD, u, m, m_AD, x, y, OtherState, Indx else DO iB=1,nB iW = W2B(iB) - DO iNd=1,nNd + do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = m_AD%FVW%W(iW)%BN_Cm(iNd) iOut = iOut + 1 END DO @@ -764,9 +748,9 @@ SUBROUTINE Calc_WriteAllBldNdOutput( p, p_AD, u, m, m_AD, x, y, OtherState, Indx ! Normal force (to plane), tangential force (to plane) coefficients ! TODO deprecate CASE ( BldNd_Cx ) - if (p_AD%WakeMod /= WakeMod_FVW) then + if (p_AD%Wake_Mod /= WakeMod_FVW) then DO iB=1,nB - DO iNd=1,nNd + do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = m%BEMT_y%Cx(iNd,iB) iOut = iOut + 1 END DO @@ -774,7 +758,7 @@ SUBROUTINE Calc_WriteAllBldNdOutput( p, p_AD, u, m, m_AD, x, y, OtherState, Indx else DO iB=1,nB iW = W2B(iB) - DO iNd=1,nNd + do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = m_AD%FVW%W(iW)%BN_Cx(iNd) iOut = iOut + 1 END DO @@ -782,9 +766,9 @@ SUBROUTINE Calc_WriteAllBldNdOutput( p, p_AD, u, m, m_AD, x, y, OtherState, Indx endif CASE ( BldNd_Cy ) - if (p_AD%WakeMod /= WakeMod_FVW) then + if (p_AD%Wake_Mod /= WakeMod_FVW) then DO iB=1,nB - DO iNd=1,nNd + do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = m%BEMT_y%Cy(iNd,iB) iOut = iOut + 1 END DO @@ -792,7 +776,7 @@ SUBROUTINE Calc_WriteAllBldNdOutput( p, p_AD, u, m, m_AD, x, y, OtherState, Indx else DO iB=1,nB iW = W2B(iB) - DO iNd=1,nNd + do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = m_AD%FVW%W(iW)%BN_Cy(iNd) iOut = iOut + 1 END DO @@ -801,9 +785,9 @@ SUBROUTINE Calc_WriteAllBldNdOutput( p, p_AD, u, m, m_AD, x, y, OtherState, Indx ! Normal force (to chord), and tangential force (to chord) coefficients CASE ( BldNd_Cn ) - if (p_AD%WakeMod /= WakeMod_FVW) then + if (p_AD%Wake_Mod /= WakeMod_FVW) then DO iB=1,nB - DO iNd=1,nNd + do iNdL=1,nNd; iNd=Nd(iNdL); ct=cos(m%BEMT_u(Indx)%theta(iNd,iB)) st=sin(m%BEMT_u(Indx)%theta(iNd,iB)) y%WriteOutput(iOut) = m%BEMT_y%Cx(iNd,iB)*ct + m%BEMT_y%Cy(iNd,iB)*st @@ -813,7 +797,7 @@ SUBROUTINE Calc_WriteAllBldNdOutput( p, p_AD, u, m, m_AD, x, y, OtherState, Indx else DO iB=1,nB iW = W2B(iB) - DO iNd=1,nNd + do iNdL=1,nNd; iNd=Nd(iNdL); ct=cos(m_AD%FVW%W(iW)%PitchAndTwist(iNd)) ! cos(theta) st=sin(m_AD%FVW%W(iW)%PitchAndTwist(iNd)) ! sin(theta) y%WriteOutput(iOut) = m_AD%FVW%W(iW)%BN_Cx(iNd)*ct + m_AD%FVW%W(iW)%BN_Cy(iNd)*st @@ -823,9 +807,9 @@ SUBROUTINE Calc_WriteAllBldNdOutput( p, p_AD, u, m, m_AD, x, y, OtherState, Indx endif CASE ( BldNd_Ct ) - if (p_AD%WakeMod /= WakeMod_FVW) then + if (p_AD%Wake_Mod /= WakeMod_FVW) then DO iB=1,nB - DO iNd=1,nNd + do iNdL=1,nNd; iNd=Nd(iNdL); ct=cos(m%BEMT_u(Indx)%theta(iNd,iB)) st=sin(m%BEMT_u(Indx)%theta(iNd,iB)) y%WriteOutput(iOut) = -m%BEMT_y%Cx(iNd,iB)*st + m%BEMT_y%Cy(iNd,iB)*ct @@ -835,7 +819,7 @@ SUBROUTINE Calc_WriteAllBldNdOutput( p, p_AD, u, m, m_AD, x, y, OtherState, Indx else DO iB=1,nB iW = W2B(iB) - DO iNd=1,nNd + do iNdL=1,nNd; iNd=Nd(iNdL); ct=cos(m_AD%FVW%W(iW)%PitchAndTwist(iNd)) ! cos(theta) st=sin(m_AD%FVW%W(iW)%PitchAndTwist(iNd)) ! sin(theta) y%WriteOutput(iOut) = -m_AD%FVW%W(iW)%BN_Cx(iNd)*st + m_AD%FVW%W(iW)%BN_Cy(iNd)*ct @@ -847,9 +831,9 @@ SUBROUTINE Calc_WriteAllBldNdOutput( p, p_AD, u, m, m_AD, x, y, OtherState, Indx ! Lift force, drag force, pitching moment CASE ( BldNd_Fl ) - if (p_AD%WakeMod /= WakeMod_FVW) then + if (p_AD%Wake_Mod /= WakeMod_FVW) then DO iB=1,nB - DO iNd=1,nNd + do iNdL=1,nNd; iNd=Nd(iNdL); cp=cos(m%BEMT_y%phi(iNd,iB)) sp=sin(m%BEMT_y%phi(iNd,iB)) y%WriteOutput(iOut) = m%X(iNd,iB)*cp - m%Y(iNd,iB)*sp @@ -859,7 +843,7 @@ SUBROUTINE Calc_WriteAllBldNdOutput( p, p_AD, u, m, m_AD, x, y, OtherState, Indx else DO iB=1,nB iW = W2B(iB) - DO iNd=1,nNd + do iNdL=1,nNd; iNd=Nd(iNdL); cp=cos(m_AD%FVW%W(iW)%BN_phi(iNd)) sp=sin(m_AD%FVW%W(iW)%BN_phi(iNd)) y%WriteOutput(iOut) = m%X(iNd,iB)*cp - m%Y(iNd,iB)*sp @@ -869,9 +853,9 @@ SUBROUTINE Calc_WriteAllBldNdOutput( p, p_AD, u, m, m_AD, x, y, OtherState, Indx endif CASE ( BldNd_Fd ) - if (p_AD%WakeMod /= WakeMod_FVW) then + if (p_AD%Wake_Mod /= WakeMod_FVW) then DO iB=1,nB - DO iNd=1,nNd + do iNdL=1,nNd; iNd=Nd(iNdL); cp=cos(m%BEMT_y%phi(iNd,iB)) sp=sin(m%BEMT_y%phi(iNd,iB)) y%WriteOutput(iOut) = m%X(iNd,iB)*sp + m%Y(iNd,iB)*cp @@ -881,7 +865,7 @@ SUBROUTINE Calc_WriteAllBldNdOutput( p, p_AD, u, m, m_AD, x, y, OtherState, Indx else DO iB=1,nB iW = W2B(iB) - DO iNd=1,nNd + do iNdL=1,nNd; iNd=Nd(iNdL); cp=cos(m_AD%FVW%W(iW)%BN_phi(iNd)) sp=sin(m_AD%FVW%W(iW)%BN_phi(iNd)) y%WriteOutput(iOut) = m%X(iNd,iB)*sp + m%Y(iNd,iB)*cp @@ -890,19 +874,19 @@ SUBROUTINE Calc_WriteAllBldNdOutput( p, p_AD, u, m, m_AD, x, y, OtherState, Indx END DO endif - CASE ( BldNd_Mm ); do iB=1,nB; do iNd=1,nNd; y%WriteOutput(iOut) = m%M(iNd,iB); iOut = iOut + 1; enddo;enddo + CASE ( BldNd_Mm ); do iB=1,nB; do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = m%M(iNd,iB); iOut = iOut + 1; enddo;enddo ! Normal force (to plane), tangential force (to plane) ! TODO deprecate - CASE ( BldNd_Fx ); do iB=1,nB; do iNd=1,nNd; y%WriteOutput(iOut) = m%X(iNd,iB); iOut = iOut + 1; enddo;enddo - CASE ( BldNd_Fy ); do iB=1,nB; do iNd=1,nNd; y%WriteOutput(iOut) = -m%Y(iNd,iB); iOut = iOut + 1; enddo;enddo + CASE ( BldNd_Fx ); do iB=1,nB; do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = m%X(iNd,iB); iOut = iOut + 1; enddo;enddo + CASE ( BldNd_Fy ); do iB=1,nB; do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = -m%Y(iNd,iB); iOut = iOut + 1; enddo;enddo ! Normal force (to chord), and tangential force (to chord) per unit length - !CASE( BldNd_Fn ); do iB=1,nB; do iNd=1,nNd; y%WriteOutput(iOut) = dot_product( y%BladeLoad(iB)%Force (:, iNd), u%BladeMotion(iB)%Orientation(1,:,iNd)); iOut = iOut + 1; enddo;enddo + !CASE( BldNd_Fn ); do iB=1,nB; do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = dot_product( y%BladeLoad(iB)%Force (:, iNd), u%BladeMotion(iB)%Orientation(1,:,iNd)); iOut = iOut + 1; enddo;enddo CASE ( BldNd_Fn ) - if (p_AD%WakeMod /= WakeMod_FVW) then + if (p_AD%Wake_Mod /= WakeMod_FVW) then DO iB=1,nB - DO iNd=1,nNd + do iNdL=1,nNd; iNd=Nd(iNdL); ct=cos(m%BEMT_u(Indx)%theta(iNd,iB)) st=sin(m%BEMT_u(Indx)%theta(iNd,iB)) y%WriteOutput(iOut) = m%X(iNd,iB)*ct - m%Y(iNd,iB)*st @@ -912,7 +896,7 @@ SUBROUTINE Calc_WriteAllBldNdOutput( p, p_AD, u, m, m_AD, x, y, OtherState, Indx else DO iB=1,nB iW = W2B(iB) - DO iNd=1,nNd + do iNdL=1,nNd; iNd=Nd(iNdL); ct=cos(m_AD%FVW%W(iW)%PitchAndTwist(iNd)) ! cos(theta) st=sin(m_AD%FVW%W(iW)%PitchAndTwist(iNd)) ! sin(theta) y%WriteOutput(iOut) = m%X(iNd,iB)*ct - m%Y(iNd,iB)*st @@ -921,11 +905,11 @@ SUBROUTINE Calc_WriteAllBldNdOutput( p, p_AD, u, m, m_AD, x, y, OtherState, Indx END DO endif - !CASE( BldNd_Ft ); do iB=1,nB; do iNd=1,nNd; y%WriteOutput(iOut) = -dot_product( y%BladeLoad(iB)%Force (:, iNd), u%BladeMotion(iB)%Orientation(2,:,iNd)); iOut = iOut + 1; enddo;enddo + !CASE( BldNd_Ft ); do iB=1,nB; do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = -dot_product( y%BladeLoad(iB)%Force (:, iNd), u%BladeMotion(iB)%Orientation(2,:,iNd)); iOut = iOut + 1; enddo;enddo CASE ( BldNd_Ft ) - if (p_AD%WakeMod /= WakeMod_FVW) then + if (p_AD%Wake_Mod /= WakeMod_FVW) then DO iB=1,nB - DO iNd=1,nNd + do iNdL=1,nNd; iNd=Nd(iNdL); ct=cos(m%BEMT_u(Indx)%theta(iNd,iB)) st=sin(m%BEMT_u(Indx)%theta(iNd,iB)) y%WriteOutput(iOut) = -m%X(iNd,iB)*st - m%Y(iNd,iB)*ct @@ -935,7 +919,7 @@ SUBROUTINE Calc_WriteAllBldNdOutput( p, p_AD, u, m, m_AD, x, y, OtherState, Indx else DO iB=1,nB iW = W2B(iB) - DO iNd=1,nNd + do iNdL=1,nNd; iNd=Nd(iNdL); ct=cos(m_AD%FVW%W(iW)%PitchAndTwist(iNd)) ! cos(theta) st=sin(m_AD%FVW%W(iW)%PitchAndTwist(iNd)) ! sin(theta) y%WriteOutput(iOut) = -m%X(iNd,iB)*st - m%Y(iNd,iB)*ct @@ -945,44 +929,44 @@ SUBROUTINE Calc_WriteAllBldNdOutput( p, p_AD, u, m, m_AD, x, y, OtherState, Indx endif ! ******* Force/Moment in: global, polar, local-polar and airfoil system - CASE( BldNd_Fxi ); do iB=1,nB; do iNd=1,nNd; y%WriteOutput(iOut) = y%BladeLoad(iB)%Force (1, iNd); iOut = iOut + 1; enddo;enddo - CASE( BldNd_Fyi ); do iB=1,nB; do iNd=1,nNd; y%WriteOutput(iOut) = y%BladeLoad(iB)%Force (2, iNd); iOut = iOut + 1; enddo;enddo - CASE( BldNd_Fzi ); do iB=1,nB; do iNd=1,nNd; y%WriteOutput(iOut) = y%BladeLoad(iB)%Force (3, iNd); iOut = iOut + 1; enddo;enddo - CASE( BldNd_Mxi ); do iB=1,nB; do iNd=1,nNd; y%WriteOutput(iOut) = y%BladeLoad(iB)%Moment(1, iNd); iOut = iOut + 1; enddo;enddo - CASE( BldNd_Myi ); do iB=1,nB; do iNd=1,nNd; y%WriteOutput(iOut) = y%BladeLoad(iB)%Moment(2, iNd); iOut = iOut + 1; enddo;enddo - CASE( BldNd_Mzi ); do iB=1,nB; do iNd=1,nNd; y%WriteOutput(iOut) = y%BladeLoad(iB)%Moment(3, iNd); iOut = iOut + 1; enddo;enddo - - CASE( BldNd_Fxp ); do iB=1,nB; do iNd=1,nNd; y%WriteOutput(iOut) = dot_product( y%BladeLoad(iB)%Force (:, iNd), R_pi(1,:,iB)); iOut = iOut + 1; enddo;enddo - CASE( BldNd_Fyp ); do iB=1,nB; do iNd=1,nNd; y%WriteOutput(iOut) = dot_product( y%BladeLoad(iB)%Force (:, iNd), R_pi(2,:,iB)); iOut = iOut + 1; enddo;enddo - CASE( BldNd_Fzp ); do iB=1,nB; do iNd=1,nNd; y%WriteOutput(iOut) = dot_product( y%BladeLoad(iB)%Force (:, iNd), R_pi(3,:,iB)); iOut = iOut + 1; enddo;enddo - CASE( BldNd_Mxp ); do iB=1,nB; do iNd=1,nNd; y%WriteOutput(iOut) = dot_product( y%BladeLoad(iB)%Moment(:, iNd), R_pi(1,:,iB)); iOut = iOut + 1; enddo;enddo - CASE( BldNd_Myp ); do iB=1,nB; do iNd=1,nNd; y%WriteOutput(iOut) = dot_product( y%BladeLoad(iB)%Moment(:, iNd), R_pi(2,:,iB)); iOut = iOut + 1; enddo;enddo - CASE( BldNd_Mzp ); do iB=1,nB; do iNd=1,nNd; y%WriteOutput(iOut) = dot_product( y%BladeLoad(iB)%Moment(:, iNd), R_pi(3,:,iB)); iOut = iOut + 1; enddo;enddo - - CASE( BldNd_Fxl ); do iB=1,nB; do iNd=1,nNd; y%WriteOutput(iOut) = dot_product( y%BladeLoad(iB)%Force (:, iNd), R_li(1,:,iNd,iB)); iOut = iOut + 1; enddo;enddo - CASE( BldNd_Fyl ); do iB=1,nB; do iNd=1,nNd; y%WriteOutput(iOut) = dot_product( y%BladeLoad(iB)%Force (:, iNd), R_li(2,:,iNd,iB)); iOut = iOut + 1; enddo;enddo - CASE( BldNd_Fzl ); do iB=1,nB; do iNd=1,nNd; y%WriteOutput(iOut) = dot_product( y%BladeLoad(iB)%Force (:, iNd), R_li(3,:,iNd,iB)); iOut = iOut + 1; enddo;enddo - CASE( BldNd_Mxl ); do iB=1,nB; do iNd=1,nNd; y%WriteOutput(iOut) = dot_product( y%BladeLoad(iB)%Moment(:, iNd), R_li(1,:,iNd,iB)); iOut = iOut + 1; enddo;enddo - CASE( BldNd_Myl ); do iB=1,nB; do iNd=1,nNd; y%WriteOutput(iOut) = dot_product( y%BladeLoad(iB)%Moment(:, iNd), R_li(2,:,iNd,iB)); iOut = iOut + 1; enddo;enddo - CASE( BldNd_Mzl ); do iB=1,nB; do iNd=1,nNd; y%WriteOutput(iOut) = dot_product( y%BladeLoad(iB)%Moment(:, iNd), R_li(3,:,iNd,iB)); iOut = iOut + 1; enddo;enddo + CASE( BldNd_Fxi ); do iB=1,nB; do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = y%BladeLoad(iB)%Force (1, iNd); iOut = iOut + 1; enddo;enddo + CASE( BldNd_Fyi ); do iB=1,nB; do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = y%BladeLoad(iB)%Force (2, iNd); iOut = iOut + 1; enddo;enddo + CASE( BldNd_Fzi ); do iB=1,nB; do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = y%BladeLoad(iB)%Force (3, iNd); iOut = iOut + 1; enddo;enddo + CASE( BldNd_Mxi ); do iB=1,nB; do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = y%BladeLoad(iB)%Moment(1, iNd); iOut = iOut + 1; enddo;enddo + CASE( BldNd_Myi ); do iB=1,nB; do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = y%BladeLoad(iB)%Moment(2, iNd); iOut = iOut + 1; enddo;enddo + CASE( BldNd_Mzi ); do iB=1,nB; do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = y%BladeLoad(iB)%Moment(3, iNd); iOut = iOut + 1; enddo;enddo + + CASE( BldNd_Fxp ); do iB=1,nB; do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = dot_product( y%BladeLoad(iB)%Force (:, iNd), R_pi(1,:,iB)); iOut = iOut + 1; enddo;enddo + CASE( BldNd_Fyp ); do iB=1,nB; do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = dot_product( y%BladeLoad(iB)%Force (:, iNd), R_pi(2,:,iB)); iOut = iOut + 1; enddo;enddo + CASE( BldNd_Fzp ); do iB=1,nB; do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = dot_product( y%BladeLoad(iB)%Force (:, iNd), R_pi(3,:,iB)); iOut = iOut + 1; enddo;enddo + CASE( BldNd_Mxp ); do iB=1,nB; do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = dot_product( y%BladeLoad(iB)%Moment(:, iNd), R_pi(1,:,iB)); iOut = iOut + 1; enddo;enddo + CASE( BldNd_Myp ); do iB=1,nB; do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = dot_product( y%BladeLoad(iB)%Moment(:, iNd), R_pi(2,:,iB)); iOut = iOut + 1; enddo;enddo + CASE( BldNd_Mzp ); do iB=1,nB; do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = dot_product( y%BladeLoad(iB)%Moment(:, iNd), R_pi(3,:,iB)); iOut = iOut + 1; enddo;enddo + + CASE( BldNd_Fxl ); do iB=1,nB; do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = dot_product( y%BladeLoad(iB)%Force (:, iNd), R_li(1,:,iNd,iB)); iOut = iOut + 1; enddo;enddo + CASE( BldNd_Fyl ); do iB=1,nB; do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = dot_product( y%BladeLoad(iB)%Force (:, iNd), R_li(2,:,iNd,iB)); iOut = iOut + 1; enddo;enddo + CASE( BldNd_Fzl ); do iB=1,nB; do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = dot_product( y%BladeLoad(iB)%Force (:, iNd), R_li(3,:,iNd,iB)); iOut = iOut + 1; enddo;enddo + CASE( BldNd_Mxl ); do iB=1,nB; do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = dot_product( y%BladeLoad(iB)%Moment(:, iNd), R_li(1,:,iNd,iB)); iOut = iOut + 1; enddo;enddo + CASE( BldNd_Myl ); do iB=1,nB; do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = dot_product( y%BladeLoad(iB)%Moment(:, iNd), R_li(2,:,iNd,iB)); iOut = iOut + 1; enddo;enddo + CASE( BldNd_Mzl ); do iB=1,nB; do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = dot_product( y%BladeLoad(iB)%Moment(:, iNd), R_li(3,:,iNd,iB)); iOut = iOut + 1; enddo;enddo ! NOTE: BldNd_Fn=BldNd_Fxa, BldNd_Ft=-BldNd_Fya (minus sign!), BldNd_Mm=BldNd_Mza BldNdMxa=0 - !CASE( BldNd_Fxa ); do iB=1,nB; do iNd=1,nNd; y%WriteOutput(iOut) = dot_product( y%BladeLoad(iB)%Force (:, iNd), u%BladeMotion(iB)%Orientation(1,:,iNd)); iOut = iOut + 1; enddo;enddo - !CASE( BldNd_Fya ); do iB=1,nB; do iNd=1,nNd; y%WriteOutput(iOut) = dot_product( y%BladeLoad(iB)%Force (:, iNd), u%BladeMotion(iB)%Orientation(2,:,iNd)); iOut = iOut + 1; enddo;enddo - !CASE( BldNd_Mza ); do iB=1,nB; do iNd=1,nNd; y%WriteOutput(iOut) = dot_product( y%BladeLoad(iB)%Moment(:, iNd), u%BladeMotion(iB)%Orientation(3,:,iNd)); iOut = iOut + 1; enddo;enddo + !CASE( BldNd_Fxa ); do iB=1,nB; do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = dot_product( y%BladeLoad(iB)%Force (:, iNd), u%BladeMotion(iB)%Orientation(1,:,iNd)); iOut = iOut + 1; enddo;enddo + !CASE( BldNd_Fya ); do iB=1,nB; do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = dot_product( y%BladeLoad(iB)%Force (:, iNd), u%BladeMotion(iB)%Orientation(2,:,iNd)); iOut = iOut + 1; enddo;enddo + !CASE( BldNd_Mza ); do iB=1,nB; do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = dot_product( y%BladeLoad(iB)%Moment(:, iNd), u%BladeMotion(iB)%Orientation(3,:,iNd)); iOut = iOut + 1; enddo;enddo ! Tower clearance (requires tower influence calculation): CASE ( BldNd_Clrnc ) if (.not. allocated(m%TwrClrnc)) then DO iB=1,nB - DO iNd=1,nNd + do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = 0.0_ReKi iOut = iOut + 1 END DO END DO else DO iB=1,nB - DO iNd=1,nNd + do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = m%TwrClrnc(iNd,iB) iOut = iOut + 1 END DO @@ -992,9 +976,9 @@ SUBROUTINE Calc_WriteAllBldNdOutput( p, p_AD, u, m, m_AD, x, y, OtherState, Indx ! TODO: remove me, Vx, Vy can be computed from other outputs (and they are in legacy coordinate system) CASE ( BldNd_Vx ) - if (p_AD%WakeMod /= WakeMod_FVW) then + if (p_AD%Wake_Mod /= WakeMod_FVW) then DO iB=1,nB - DO iNd=1,nNd + do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = m%BEMT_u(Indx)%Vx(iNd,iB) iOut = iOut + 1 END DO @@ -1002,7 +986,7 @@ SUBROUTINE Calc_WriteAllBldNdOutput( p, p_AD, u, m, m_AD, x, y, OtherState, Indx else DO iB=1,nB iW = W2B(iB) - DO iNd=1,nNd + do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = m_AD%FVW%W(iW)%BN_UrelWind_s(1,iNd) iOut = iOut + 1 END DO @@ -1010,9 +994,9 @@ SUBROUTINE Calc_WriteAllBldNdOutput( p, p_AD, u, m, m_AD, x, y, OtherState, Indx endif CASE ( BldNd_Vy ) - if (p_AD%WakeMod /= WakeMod_FVW) then + if (p_AD%Wake_Mod /= WakeMod_FVW) then DO iB=1,nB - DO iNd=1,nNd + do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = m%BEMT_u(Indx)%Vy(iNd,iB) iOut = iOut + 1 END DO @@ -1020,7 +1004,7 @@ SUBROUTINE Calc_WriteAllBldNdOutput( p, p_AD, u, m, m_AD, x, y, OtherState, Indx else DO iB=1,nB iW = W2B(iB) - DO iNd=1,nNd + do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = m_AD%FVW%W(iW)%BN_UrelWind_s(2,iNd) iOut = iOut + 1 END DO @@ -1028,10 +1012,10 @@ SUBROUTINE Calc_WriteAllBldNdOutput( p, p_AD, u, m, m_AD, x, y, OtherState, Indx endif CASE ( BldNd_GeomPhi ) - if (p_AD%WakeMod /= WakeMod_FVW) then + if (p_AD%Wake_Mod /= WakeMod_FVW) then if (allocated(OtherState%BEMT%ValidPhi)) then DO iB=1,nB - DO iNd=1,nNd + do iNdL=1,nNd; iNd=Nd(iNdL); if (OtherState%BEMT%ValidPhi(iNd,iB)) then y%WriteOutput(iOut) = 1.0_ReKi - m%BEMT%BEM_weight else @@ -1043,7 +1027,7 @@ SUBROUTINE Calc_WriteAllBldNdOutput( p, p_AD, u, m, m_AD, x, y, OtherState, Indx else DO iB=1,nB iW = W2B(iB) - DO iNd=1,nNd + do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = 1.0_ReKi iOut = iOut + 1 END DO @@ -1051,7 +1035,7 @@ SUBROUTINE Calc_WriteAllBldNdOutput( p, p_AD, u, m, m_AD, x, y, OtherState, Indx end if else DO iB=1,nB - DO iNd=1,nNd + do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = 0.0_ReKi ! Not valid for FVW iOut = iOut + 1 END DO @@ -1059,16 +1043,16 @@ SUBROUTINE Calc_WriteAllBldNdOutput( p, p_AD, u, m, m_AD, x, y, OtherState, Indx endif CASE ( BldNd_chi ) - if (p_AD%WakeMod /= WakeMod_FVW) then + if (p_AD%Wake_Mod /= WakeMod_FVW) then DO iB=1,nB - DO iNd=1,nNd + do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = m%BEMT_y%chi(iNd,iB)*R2D iOut = iOut + 1 END DO END DO else DO iB=1,nB - DO iNd=1,nNd + do iNdL=1,nNd; iNd=Nd(iNdL); !NOT available in FVW yet y%WriteOutput(iOut) = 0.0_ReKi iOut = iOut + 1 @@ -1078,9 +1062,9 @@ SUBROUTINE Calc_WriteAllBldNdOutput( p, p_AD, u, m, m_AD, x, y, OtherState, Indx CASE ( BldNd_UA_Flag ) IF (p_AD%UA_Flag) THEN - if (p_AD%WakeMod /= WakeMod_FVW) then + if (p_AD%Wake_Mod /= WakeMod_FVW) then DO iB=1,nB - DO iNd=1,u%BladeMotion(iB)%NNodes + do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = m%BEMT%UA%weight(iNd, iB) iOut = iOut + 1 ENDDO @@ -1088,7 +1072,7 @@ SUBROUTINE Calc_WriteAllBldNdOutput( p, p_AD, u, m, m_AD, x, y, OtherState, Indx else DO iB=1,nB iW = W2B(iB) - DO iNd=1,u%BladeMotion(iB)%NNodes + do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = m_AD%FVW%W(iW)%m_UA%weight(iNd, 1) iOut = iOut + 1 ENDDO @@ -1096,7 +1080,7 @@ SUBROUTINE Calc_WriteAllBldNdOutput( p, p_AD, u, m, m_AD, x, y, OtherState, Indx end if ELSE DO iB=1,nB - DO iNd=1,u%BladeMotion(iB)%NNodes + do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = 0.0_ReKi iOut = iOut + 1 ENDDO @@ -1119,9 +1103,9 @@ SUBROUTINE Calc_WriteAllBldNdOutput( p, p_AD, u, m, m_AD, x, y, OtherState, Indx compIndx = 5 END SELECT - !if (p_AD%WakeMod /= WakeMod_FVW) then + !if (p_AD%Wake_Mod /= WakeMod_FVW) then DO iB=1,nB - DO iNd=1,u%BladeMotion(iB)%NNodes + do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = x%BEMT%UA%element(iNd, iB)%x(compIndx) iOut = iOut + 1 ENDDO @@ -1129,7 +1113,7 @@ SUBROUTINE Calc_WriteAllBldNdOutput( p, p_AD, u, m, m_AD, x, y, OtherState, Indx !else ! DO iB=1,nB ! iW = W2B(iB) - ! DO iNd=1,u%BladeMotion(iB)%NNodes + ! do iNdL=1,nNd; iNd=Nd(iNdL); ! y%WriteOutput(iOut) = x_AD%FVW%UA(iW)%element(iNd, iB)%x(compIndx) ! iOut = iOut + 1 ! ENDDO @@ -1138,7 +1122,7 @@ SUBROUTINE Calc_WriteAllBldNdOutput( p, p_AD, u, m, m_AD, x, y, OtherState, Indx ELSE DO iB=1,nB - DO iNd=1,u%BladeMotion(iB)%NNodes + do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = 0.0_ReKi iOut = iOut + 1 ENDDO @@ -1148,9 +1132,9 @@ SUBROUTINE Calc_WriteAllBldNdOutput( p, p_AD, u, m, m_AD, x, y, OtherState, Indx ! CpMin CASE ( BldNd_CpMin ) - if (p_AD%WakeMod /= WakeMod_FVW) then + if (p_AD%Wake_Mod /= WakeMod_FVW) then DO iB=1,nB - DO iNd=1,u%BladeMotion(iB)%NNodes + do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = m%BEMT_y%Cpmin(iNd,iB) iOut = iOut + 1 ENDDO @@ -1158,7 +1142,7 @@ SUBROUTINE Calc_WriteAllBldNdOutput( p, p_AD, u, m, m_AD, x, y, OtherState, Indx else DO iB=1,nB iW = W2B(iB) - DO iNd=1,u%BladeMotion(iB)%NNodes + do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = m_AD%FVW%W(iW)%BN_Cpmin(iNd) iOut = iOut + 1 ENDDO @@ -1166,14 +1150,14 @@ SUBROUTINE Calc_WriteAllBldNdOutput( p, p_AD, u, m, m_AD, x, y, OtherState, Indx endif ! Cavitation - CASE ( BldNd_SgCav ); do iB=1,nB; do iNd=1,u%BladeMotion(iB)%NNodes; y%WriteOutput(iOut) = m%SigmaCavit(iNd,iB); iOut = iOut + 1; enddo;enddo - CASE ( BldNd_SigCr ); do iB=1,nB; do iNd=1,u%BladeMotion(iB)%NNodes; y%WriteOutput(iOut) = m%SigmaCavitCrit(iNd,iB); iOut = iOut + 1; enddo;enddo + CASE ( BldNd_SgCav ); do iB=1,nB; do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = m%SigmaCavit(iNd,iB); iOut = iOut + 1; enddo;enddo + CASE ( BldNd_SigCr ); do iB=1,nB; do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = m%SigmaCavitCrit(iNd,iB); iOut = iOut + 1; enddo;enddo ! circulation on blade CASE ( BldNd_Gam ) - if (p_AD%WakeMod /= WakeMod_FVW) then + if (p_AD%Wake_Mod /= WakeMod_FVW) then DO iB=1,nB - DO iNd=1,u%BladeMotion(iB)%NNodes + do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = 0.5_ReKi * p%BEMT%chord(iNd,iB) * m%BEMT_y%Vrel(iNd,iB) * m%BEMT_y%Cl(iNd,iB) ! "Gam" [m^2/s] iOut = iOut + 1 ENDDO @@ -1181,7 +1165,7 @@ SUBROUTINE Calc_WriteAllBldNdOutput( p, p_AD, u, m, m_AD, x, y, OtherState, Indx else DO iB=1,nB iW = W2B(iB) - DO iNd=1,u%BladeMotion(iB)%NNodes + do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = 0.5_ReKi * p_AD%FVW%W(iW)%chord_LL(iNd) * m_AD%FVW%W(iW)%BN_Vrel(iNd) * m_AD%FVW%W(iW)%BN_Cl(iNd) ! "Gam" [m^2/s] iOut = iOut + 1 ENDDO @@ -1194,9 +1178,9 @@ SUBROUTINE Calc_WriteAllBldNdOutput( p, p_AD, u, m, m_AD, x, y, OtherState, Indx ! TODO this should be provided by all lifting-line codes ! Cl_Static CASE ( BldNd_Cl_qs ) - if (p_AD%WakeMod /= WakeMod_FVW) then + if (p_AD%Wake_Mod /= WakeMod_FVW) then DO iB=1,nB - DO iNd=1,u%BladeMotion(iB)%NNodes + do iNdL=1,nNd; iNd=Nd(iNdL); !NOT available in BEMT/DBEMT yet y%WriteOutput(iOut) = 0.0_ReKi iOut = iOut + 1 @@ -1205,7 +1189,7 @@ SUBROUTINE Calc_WriteAllBldNdOutput( p, p_AD, u, m, m_AD, x, y, OtherState, Indx else DO iB=1,nB iW = W2B(iB) - DO iNd=1,u%BladeMotion(iB)%NNodes + do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = m_AD%FVW%W(iW)%BN_Cl_Static(iNd) iOut = iOut + 1 ENDDO @@ -1214,9 +1198,9 @@ SUBROUTINE Calc_WriteAllBldNdOutput( p, p_AD, u, m, m_AD, x, y, OtherState, Indx ! Cd_Static CASE ( BldNd_Cd_qs ) - if (p_AD%WakeMod /= WakeMod_FVW) then + if (p_AD%Wake_Mod /= WakeMod_FVW) then DO iB=1,nB - DO iNd=1,u%BladeMotion(iB)%NNodes + do iNdL=1,nNd; iNd=Nd(iNdL); !NOT available in BEMT/DBEMT yet y%WriteOutput(iOut) = 0.0_ReKi iOut = iOut + 1 @@ -1225,7 +1209,7 @@ SUBROUTINE Calc_WriteAllBldNdOutput( p, p_AD, u, m, m_AD, x, y, OtherState, Indx else DO iB=1,nB iW = W2B(iB) - DO iNd=1,u%BladeMotion(iB)%NNodes + do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = m_AD%FVW%W(iW)%BN_Cd_Static(iNd) iOut = iOut + 1 ENDDO @@ -1234,9 +1218,9 @@ SUBROUTINE Calc_WriteAllBldNdOutput( p, p_AD, u, m, m_AD, x, y, OtherState, Indx ! Cm_Static CASE ( BldNd_Cm_qs ) - if (p_AD%WakeMod /= WakeMod_FVW) then + if (p_AD%Wake_Mod /= WakeMod_FVW) then DO iB=1,nB - DO iNd=1,u%BladeMotion(iB)%NNodes + do iNdL=1,nNd; iNd=Nd(iNdL); !NOT available in BEMT/DBEMT yet y%WriteOutput(iOut) = 0.0_ReKi iOut = iOut + 1 @@ -1245,7 +1229,7 @@ SUBROUTINE Calc_WriteAllBldNdOutput( p, p_AD, u, m, m_AD, x, y, OtherState, Indx else DO iB=1,nB iW = W2B(iB) - DO iNd=1,u%BladeMotion(iB)%NNodes + do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = m_AD%FVW%W(iW)%BN_Cm_Static(iNd) iOut = iOut + 1 ENDDO @@ -1255,48 +1239,48 @@ SUBROUTINE Calc_WriteAllBldNdOutput( p, p_AD, u, m, m_AD, x, y, OtherState, Indx !================================================ BEM ONLY ! BEM variables: F: Hub/Tip-loss factor, k/kp: load factors, CT: thrust coefficient in CT-a relationship - CASE(BldNd_BEM_F_qs ); do iB=1,nB; do iNd=1,nNd; y%WriteOutput(iOut) = m%BEMT_y%F(iNd,iB); iOut = iOut + 1; enddo;enddo - CASE(BldNd_BEM_k_qs ); do iB=1,nB; do iNd=1,nNd; y%WriteOutput(iOut) = m%BEMT_y%k(iNd,iB); iOut = iOut + 1; enddo;enddo - CASE(BldNd_BEM_kp_qs ); do iB=1,nB; do iNd=1,nNd; y%WriteOutput(iOut) = m%BEMT_y%k_p(iNd,iB); iOut = iOut + 1; enddo;enddo - CASE(BldNd_BEM_CT_qs ); do iB=1,nB; do iNd=1,nNd; y%WriteOutput(iOut) = 4*m%BEMT_y%F(iNd,iB)*m%BEMT_y%k(iNd,iB)*(1._ReKi-m%BEMT_y%axInduction_qs(iNd,iB))**2; iOut = iOut + 1; enddo;enddo + CASE(BldNd_BEM_F_qs ); do iB=1,nB; do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = m%BEMT_y%F(iNd,iB); iOut = iOut + 1; enddo;enddo + CASE(BldNd_BEM_k_qs ); do iB=1,nB; do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = m%BEMT_y%k(iNd,iB); iOut = iOut + 1; enddo;enddo + CASE(BldNd_BEM_kp_qs ); do iB=1,nB; do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = m%BEMT_y%k_p(iNd,iB); iOut = iOut + 1; enddo;enddo + CASE(BldNd_BEM_CT_qs ); do iB=1,nB; do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = 4*m%BEMT_y%F(iNd,iB)*m%BEMT_y%k(iNd,iB)*(1._ReKi-m%BEMT_y%axInduction_qs(iNd,iB))**2; iOut = iOut + 1; enddo;enddo !================================================ MHK only ! Buoyant force in inertial, polar, local and airfoil systems - CASE( BldNd_Fbxi ); do iB=1,nB; do iNd=1,nNd; y%WriteOutput(iOut) = m%BladeBuoyLoad(iB)%Force (1,iNd); iOut = iOut + 1; enddo;enddo - CASE( BldNd_Fbyi ); do iB=1,nB; do iNd=1,nNd; y%WriteOutput(iOut) = m%BladeBuoyLoad(iB)%Force (2,iNd); iOut = iOut + 1; enddo;enddo - CASE( BldNd_Fbzi ); do iB=1,nB; do iNd=1,nNd; y%WriteOutput(iOut) = m%BladeBuoyLoad(iB)%Force (3,iNd); iOut = iOut + 1; enddo;enddo - CASE( BldNd_Mbxi ); do iB=1,nB; do iNd=1,nNd; y%WriteOutput(iOut) = m%BladeBuoyLoad(iB)%Moment(1,iNd); iOut = iOut + 1; enddo;enddo - CASE( BldNd_Mbyi ); do iB=1,nB; do iNd=1,nNd; y%WriteOutput(iOut) = m%BladeBuoyLoad(iB)%Moment(2,iNd); iOut = iOut + 1; enddo;enddo - CASE( BldNd_Mbzi ); do iB=1,nB; do iNd=1,nNd; y%WriteOutput(iOut) = m%BladeBuoyLoad(iB)%Moment(3,iNd); iOut = iOut + 1; enddo;enddo - - CASE( BldNd_Fbxp ); do iB=1,nB; do iNd=1,nNd; y%WriteOutput(iOut) = dot_product( m%BladeBuoyLoad(iB)%Force (:,iNd), R_pi(1,:,iB) ); iOut = iOut + 1; enddo;enddo - CASE( BldNd_Fbyp ); do iB=1,nB; do iNd=1,nNd; y%WriteOutput(iOut) = dot_product( m%BladeBuoyLoad(iB)%Force (:,iNd), R_pi(2,:,iB) ); iOut = iOut + 1; enddo;enddo - CASE( BldNd_Fbzp ); do iB=1,nB; do iNd=1,nNd; y%WriteOutput(iOut) = dot_product( m%BladeBuoyLoad(iB)%Force (:,iNd), R_pi(3,:,iB) ); iOut = iOut + 1; enddo;enddo - CASE( BldNd_Mbxp ); do iB=1,nB; do iNd=1,nNd; y%WriteOutput(iOut) = dot_product( m%BladeBuoyLoad(iB)%Moment(:,iNd), R_pi(1,:,iB) ); iOut = iOut + 1; enddo;enddo - CASE( BldNd_Mbyp ); do iB=1,nB; do iNd=1,nNd; y%WriteOutput(iOut) = dot_product( m%BladeBuoyLoad(iB)%Moment(:,iNd), R_pi(2,:,iB) ); iOut = iOut + 1; enddo;enddo - CASE( BldNd_Mbzp ); do iB=1,nB; do iNd=1,nNd; y%WriteOutput(iOut) = dot_product( m%BladeBuoyLoad(iB)%Moment(:,iNd), R_pi(3,:,iB) ); iOut = iOut + 1; enddo;enddo - - CASE( BldNd_Fbxl ); do iB=1,nB; do iNd=1,nNd; y%WriteOutput(iOut) = dot_product( m%BladeBuoyLoad(iB)%Force (:,iNd), R_li(1,:,iNd,iB) ); iOut = iOut + 1; enddo;enddo - CASE( BldNd_Fbyl ); do iB=1,nB; do iNd=1,nNd; y%WriteOutput(iOut) = dot_product( m%BladeBuoyLoad(iB)%Force (:,iNd), R_li(2,:,iNd,iB) ); iOut = iOut + 1; enddo;enddo - CASE( BldNd_Fbzl ); do iB=1,nB; do iNd=1,nNd; y%WriteOutput(iOut) = dot_product( m%BladeBuoyLoad(iB)%Force (:,iNd), R_li(3,:,iNd,iB) ); iOut = iOut + 1; enddo;enddo - CASE( BldNd_Mbxl ); do iB=1,nB; do iNd=1,nNd; y%WriteOutput(iOut) = dot_product( m%BladeBuoyLoad(iB)%Moment(:,iNd), R_li(1,:,iNd,iB) ); iOut = iOut + 1; enddo;enddo - CASE( BldNd_Mbyl ); do iB=1,nB; do iNd=1,nNd; y%WriteOutput(iOut) = dot_product( m%BladeBuoyLoad(iB)%Moment(:,iNd), R_li(2,:,iNd,iB) ); iOut = iOut + 1; enddo;enddo - CASE( BldNd_Mbzl ); do iB=1,nB; do iNd=1,nNd; y%WriteOutput(iOut) = dot_product( m%BladeBuoyLoad(iB)%Moment(:,iNd), R_li(3,:,iNd,iB) ); iOut = iOut + 1; enddo;enddo - - CASE( BldNd_Fbxa ); do iB=1,nB; do iNd=1,nNd; y%WriteOutput(iOut) = dot_product( m%BladeBuoyLoad(iB)%Force (:,iNd), u%BladeMotion(iB)%Orientation(1,:,iNd) ); iOut = iOut + 1; enddo;enddo - CASE( BldNd_Fbya ); do iB=1,nB; do iNd=1,nNd; y%WriteOutput(iOut) = dot_product( m%BladeBuoyLoad(iB)%Force (:,iNd), u%BladeMotion(iB)%Orientation(2,:,iNd) ); iOut = iOut + 1; enddo;enddo - CASE( BldNd_Fbza ); do iB=1,nB; do iNd=1,nNd; y%WriteOutput(iOut) = dot_product( m%BladeBuoyLoad(iB)%Force (:,iNd), u%BladeMotion(iB)%Orientation(3,:,iNd) ); iOut = iOut + 1; enddo;enddo - CASE( BldNd_Mbxa ); do iB=1,nB; do iNd=1,nNd; y%WriteOutput(iOut) = dot_product( m%BladeBuoyLoad(iB)%Moment(:,iNd), u%BladeMotion(iB)%Orientation(1,:,iNd) ); iOut = iOut + 1; enddo;enddo - CASE( BldNd_Mbya ); do iB=1,nB; do iNd=1,nNd; y%WriteOutput(iOut) = dot_product( m%BladeBuoyLoad(iB)%Moment(:,iNd), u%BladeMotion(iB)%Orientation(2,:,iNd) ); iOut = iOut + 1; enddo;enddo - CASE( BldNd_Mbza ); do iB=1,nB; do iNd=1,nNd; y%WriteOutput(iOut) = dot_product( m%BladeBuoyLoad(iB)%Moment(:,iNd), u%BladeMotion(iB)%Orientation(3,:,iNd) ); iOut = iOut + 1; enddo;enddo + CASE( BldNd_Fbxi ); do iB=1,nB; do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = m%BladeBuoyLoad(iB)%Force (1,iNd); iOut = iOut + 1; enddo;enddo + CASE( BldNd_Fbyi ); do iB=1,nB; do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = m%BladeBuoyLoad(iB)%Force (2,iNd); iOut = iOut + 1; enddo;enddo + CASE( BldNd_Fbzi ); do iB=1,nB; do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = m%BladeBuoyLoad(iB)%Force (3,iNd); iOut = iOut + 1; enddo;enddo + CASE( BldNd_Mbxi ); do iB=1,nB; do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = m%BladeBuoyLoad(iB)%Moment(1,iNd); iOut = iOut + 1; enddo;enddo + CASE( BldNd_Mbyi ); do iB=1,nB; do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = m%BladeBuoyLoad(iB)%Moment(2,iNd); iOut = iOut + 1; enddo;enddo + CASE( BldNd_Mbzi ); do iB=1,nB; do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = m%BladeBuoyLoad(iB)%Moment(3,iNd); iOut = iOut + 1; enddo;enddo + + CASE( BldNd_Fbxp ); do iB=1,nB; do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = dot_product( m%BladeBuoyLoad(iB)%Force (:,iNd), R_pi(1,:,iB) ); iOut = iOut + 1; enddo;enddo + CASE( BldNd_Fbyp ); do iB=1,nB; do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = dot_product( m%BladeBuoyLoad(iB)%Force (:,iNd), R_pi(2,:,iB) ); iOut = iOut + 1; enddo;enddo + CASE( BldNd_Fbzp ); do iB=1,nB; do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = dot_product( m%BladeBuoyLoad(iB)%Force (:,iNd), R_pi(3,:,iB) ); iOut = iOut + 1; enddo;enddo + CASE( BldNd_Mbxp ); do iB=1,nB; do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = dot_product( m%BladeBuoyLoad(iB)%Moment(:,iNd), R_pi(1,:,iB) ); iOut = iOut + 1; enddo;enddo + CASE( BldNd_Mbyp ); do iB=1,nB; do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = dot_product( m%BladeBuoyLoad(iB)%Moment(:,iNd), R_pi(2,:,iB) ); iOut = iOut + 1; enddo;enddo + CASE( BldNd_Mbzp ); do iB=1,nB; do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = dot_product( m%BladeBuoyLoad(iB)%Moment(:,iNd), R_pi(3,:,iB) ); iOut = iOut + 1; enddo;enddo + + CASE( BldNd_Fbxl ); do iB=1,nB; do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = dot_product( m%BladeBuoyLoad(iB)%Force (:,iNd), R_li(1,:,iNd,iB) ); iOut = iOut + 1; enddo;enddo + CASE( BldNd_Fbyl ); do iB=1,nB; do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = dot_product( m%BladeBuoyLoad(iB)%Force (:,iNd), R_li(2,:,iNd,iB) ); iOut = iOut + 1; enddo;enddo + CASE( BldNd_Fbzl ); do iB=1,nB; do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = dot_product( m%BladeBuoyLoad(iB)%Force (:,iNd), R_li(3,:,iNd,iB) ); iOut = iOut + 1; enddo;enddo + CASE( BldNd_Mbxl ); do iB=1,nB; do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = dot_product( m%BladeBuoyLoad(iB)%Moment(:,iNd), R_li(1,:,iNd,iB) ); iOut = iOut + 1; enddo;enddo + CASE( BldNd_Mbyl ); do iB=1,nB; do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = dot_product( m%BladeBuoyLoad(iB)%Moment(:,iNd), R_li(2,:,iNd,iB) ); iOut = iOut + 1; enddo;enddo + CASE( BldNd_Mbzl ); do iB=1,nB; do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = dot_product( m%BladeBuoyLoad(iB)%Moment(:,iNd), R_li(3,:,iNd,iB) ); iOut = iOut + 1; enddo;enddo + + CASE( BldNd_Fbxa ); do iB=1,nB; do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = dot_product( m%BladeBuoyLoad(iB)%Force (:,iNd), u%BladeMotion(iB)%Orientation(1,:,iNd) ); iOut = iOut + 1; enddo;enddo + CASE( BldNd_Fbya ); do iB=1,nB; do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = dot_product( m%BladeBuoyLoad(iB)%Force (:,iNd), u%BladeMotion(iB)%Orientation(2,:,iNd) ); iOut = iOut + 1; enddo;enddo + CASE( BldNd_Fbza ); do iB=1,nB; do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = dot_product( m%BladeBuoyLoad(iB)%Force (:,iNd), u%BladeMotion(iB)%Orientation(3,:,iNd) ); iOut = iOut + 1; enddo;enddo + CASE( BldNd_Mbxa ); do iB=1,nB; do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = dot_product( m%BladeBuoyLoad(iB)%Moment(:,iNd), u%BladeMotion(iB)%Orientation(1,:,iNd) ); iOut = iOut + 1; enddo;enddo + CASE( BldNd_Mbya ); do iB=1,nB; do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = dot_product( m%BladeBuoyLoad(iB)%Moment(:,iNd), u%BladeMotion(iB)%Orientation(2,:,iNd) ); iOut = iOut + 1; enddo;enddo + CASE( BldNd_Mbza ); do iB=1,nB; do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = dot_product( m%BladeBuoyLoad(iB)%Moment(:,iNd), u%BladeMotion(iB)%Orientation(3,:,iNd) ); iOut = iOut + 1; enddo;enddo !================================================ DEBUG ONLY ! Convenient placeholders for debuging - CASE ( BldNd_Debug1 ); do iB=1,nB; do iNd=1,u%BladeMotion(iB)%NNodes; y%WriteOutput(iOut) = 0.0_ReKi; iOut = iOut + 1; enddo;enddo - CASE ( BldNd_Debug2 ); do iB=1,nB; do iNd=1,u%BladeMotion(iB)%NNodes; y%WriteOutput(iOut) = 0.0_ReKi; iOut = iOut + 1; enddo;enddo - CASE ( BldNd_Debug3 ); do iB=1,nB; do iNd=1,u%BladeMotion(iB)%NNodes; y%WriteOutput(iOut) = 0.0_ReKi; iOut = iOut + 1; enddo;enddo + CASE ( BldNd_Debug1 ); do iB=1,nB; do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = 0.0_ReKi; iOut = iOut + 1; enddo;enddo + CASE ( BldNd_Debug2 ); do iB=1,nB; do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = 0.0_ReKi; iOut = iOut + 1; enddo;enddo + CASE ( BldNd_Debug3 ); do iB=1,nB; do iNdL=1,nNd; iNd=Nd(iNdL); y%WriteOutput(iOut) = 0.0_ReKi; iOut = iOut + 1; enddo;enddo CASE DEFAULT ! Should never happen, this is a programmer's error @@ -1306,6 +1290,7 @@ SUBROUTINE Calc_WriteAllBldNdOutput( p, p_AD, u, m, m_AD, x, y, OtherState, Indx END DO ! each channel + END ASSOCIATE ! END SUBROUTINE Calc_WriteAllBldNdOutput @@ -1324,6 +1309,11 @@ SUBROUTINE AllBldNdOuts_SetParameters( InputFileData, p, p_AD, ErrStat, ErrMsg ) INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + REAL(ReKi),PARAMETER :: WrongNo=-9999. ! Placeholder value for bad(old) values in BldNd_BlOutNd + CHARACTER(4) :: NodeStr + CHARACTER(1024) :: LineStr + INTEGER :: IOS + INTEGER :: I ! local variables character(*), parameter :: RoutineName = 'AllBldNdOuts_SetParameters' @@ -1342,45 +1332,79 @@ SUBROUTINE AllBldNdOuts_SetParameters( InputFileData, p, p_AD, ErrStat, ErrMsg ) p%BldNd_BladesOut = InputFileData%BldNd_BladesOut ENDIF - - ! Check if the requested blade nodes are valid - ! InputFileData%BldNd_BlOutNd + + ! Determine which blade nodes to output: + ALLOCATE ( p%BldNd_BlOutNd(p%NumBlNds) , STAT=IOS ) + IF ( IOS /= 0_IntKi ) THEN + CALL SetErrStat( ErrID_Fatal,"Error allocating memory for the AeroDyn BldNd_BlOutNd array.", ErrStat, ErrMsg, RoutineName ) + RETURN + ENDIF + + if (p%BldNd_BladesOut > 0) then + ! Parse BldNd_BlOutNd_Str to determine which nodes should be output + READ (InputFileData%BldNd_BlOutNd_Str, *,IOSTAT=IOS) NodeStr + IF (IOS /= 0) THEN + CALL SetErrStat( ErrID_Fatal,"Error reading nodes from BldNd_BlOutNd.", ErrStat, ErrMsg, RoutineName ) + RETURN + ENDIF + CALL Conv2UC(NodeStr) + + SELECT CASE (TRIM(NodeStr)) + CASE ("ALL") + p%BldNd_NumNodesOut = p%NumBlNds + DO I=1,p%BldNd_NumNodesOut + p%BldNd_BlOutNd(i) = i + END DO + CASE ("TIP") + p%BldNd_NumNodesOut = 1 + p%BldNd_BlOutNd(1) = p%NumBlNds + CASE ("ROOT") + p%BldNd_NumNodesOut = 1 + p%BldNd_BlOutNd(1) = 1 + CASE DEFAULT + p%BldNd_BlOutNd=WrongNo ! initialize to determine how many we node numbers we have read in + p%BldNd_NumNodesOut = p%NumBlNds + + if (InputFileData%BldNd_BlOutNd_Str(1:1) == '"') then + READ (InputFileData%BldNd_BlOutNd_Str, *,IOSTAT=IOS) LineStr ! remove quotes if they exist + else + LineStr = InputFileData%BldNd_BlOutNd_Str + end if + + READ (LineStr, *,IOSTAT=IOS) p%BldNd_BlOutNd + IF (IOS /= 0) THEN + DO I = 1, p%NumBlNds + IF ( p%BldNd_BlOutNd(I) .EQ. WrongNo ) THEN + p%BldNd_NumNodesOut = I - 1 + IF (p%BldNd_NumNodesOut < 1) THEN + + CALL SetErrStat( ErrID_Fatal,"Error reading numeric nodes from BldNd_BlOutNd.", ErrStat, ErrMsg, RoutineName ) + RETURN + ELSE + EXIT + END IF + END IF + END DO + ENDIF !IOS error reading incomplete array + + DO I = 1, p%BldNd_NumNodesOut + IF ( ( p%BldNd_BlOutNd(I) <= 0 ) .OR.( p%BldNd_BlOutNd(I) > p%NumBlNds ) ) THEN + CALL SetErrStat( ErrID_Fatal,"Invalid node listed in BldNd_BlOutNd. Nodes must be in the range [1,"//trim(num2lstr(p%NumBlNds))//"].", ErrStat, ErrMsg, RoutineName ) + RETURN + ENDIF + END DO + END SELECT + ELSE + p%BldNd_NumNodesOut = 0 + END IF ! Set the parameter to store number of requested Blade Node output sets p%BldNd_NumOuts = InputFileData%BldNd_NumOuts + if (p%BldNd_BladesOut==0) p%BldNd_NumOuts = 0 ! Set the total number of outputs ( requested channel groups * number requested nodes * number requested blades ) - p%BldNd_TotNumOuts = p%BldNd_NumOuts*p%NumBlNds*p%BldNd_BladesOut ! p%BldNd_NumOuts * size(p%BldNd_BlOutNd) * size(p%BldNd_BladesOut) - -! ! Check if the blade node array to output is valid: p%BldNd_BlOutNd -! ! TODO: this value is not read in by the input file reading yet, so setting to all blade nodes -! ! -- check if list handed in is of nodes that exist (not sure this is ever checked) -! ! -- copy values over -! -! ! Temporary workaround here: -! ALLOCATE ( p%BldNd_BlOutNd(1:p%NumBlNds) , STAT=ErrStat2 ) -! IF ( ErrStat2 /= 0_IntKi ) THEN -! CALL SetErrStat( ErrID_Fatal,"Error allocating memory for the AeroDyn OutParam array.", ErrStat, ErrMsg, RoutineName ) -! RETURN -! ENDIF -! DO I=1,p%NumBlNds ! put all nodes in the list -! p%BldNd_BlOutNd(i) = i -! ENDDO - - -! ! Check if the requested blades are actually in use: -! ! TODO: this value is not read in by the input file reading yet, so setting to all blades -! ! -- check if list handed in is of blades that exist (not sure this is ever checked) -! ! -- copy values over -! ALLOCATE ( p%BldNd_BladesOut(1:p%NumBlades), STAT=ErrStat2 ) -! IF ( ErrStat2 /= 0_IntKi ) THEN -! CALL SetErrStat( ErrID_Fatal,"Error allocating memory for the AeroDyn OutParam array.", ErrStat, ErrMsg, RoutineName ) -! RETURN -! ENDIF -! DO I=1,p%NumBlades ! put all blades in the list -! p%BldNd_BladesOut(i) = i -! ENDDO + p%BldNd_TotNumOuts = p%BldNd_NumOuts*p%BldNd_NumNodesOut*p%BldNd_BladesOut if (p%BldNd_TotNumOuts > 0) then call BldNdOuts_SetOutParam(InputFileData%BldNd_OutList, p, p_AD, ErrStat, ErrMsg ) ! requires: p%NumOuts, p%numBlades, p%NumBlNds, p%NumTwrNds; sets: p%BldNdOutParam. @@ -1388,8 +1412,7 @@ SUBROUTINE AllBldNdOuts_SetParameters( InputFileData, p, p_AD, ErrStat, ErrMsg ) end if - -END SUBROUTINE AllBldNdOuts_SetParameters +END SUBROUTINE AllBldNdOuts_SetParameters !********************************************************************************************************************************** @@ -1531,7 +1554,7 @@ SUBROUTINE BldNdOuts_SetOutParam(BldNd_OutList, p, p_AD, ErrStat, ErrMsg ) end if ! The following are valid only for BEMT/DBEMT - if (p_AD%WakeMod /= WakeMod_FVW) then + if (p_AD%Wake_Mod /= WakeMod_FVW) then InvalidOutput( BldNd_Cl_qs ) = .true. InvalidOutput( BldNd_Cd_qs ) = .true. InvalidOutput( BldNd_Cm_qs ) = .true. @@ -1544,7 +1567,7 @@ SUBROUTINE BldNdOuts_SetOutParam(BldNd_OutList, p, p_AD, ErrStat, ErrMsg ) endif ! The following are valid only for BEMT/DBEMT - if (p_AD%WakeMod /= WakeMod_BEMT) then + if (p_AD%Wake_Mod /= WakeMod_BEMT) then InvalidOutput( BldNd_BEM_F_qs ) = .true. InvalidOutput( BldNd_BEM_k_qs ) = .true. InvalidOutput( BldNd_BEM_kp_qs ) = .true. @@ -1553,7 +1576,7 @@ SUBROUTINE BldNdOuts_SetOutParam(BldNd_OutList, p, p_AD, ErrStat, ErrMsg ) ! it's going to be very difficult to get the FVW states without rewriting a bunch of code - if (.not. p_AD%UA_Flag .or. p_AD%WakeMod == WakeMod_FVW) then ! also invalid if AFAeroMod is not 4,5,6 + if (.not. p_AD%UA_Flag .or. p_AD%Wake_Mod == WakeMod_FVW) then ! also invalid if AFAeroMod is not 4,5,6 InvalidOutput( BldNd_UA_x1 ) = .true. InvalidOutput( BldNd_UA_x2 ) = .true. InvalidOutput( BldNd_UA_x3 ) = .true. diff --git a/modules/aerodyn/src/AeroDyn_Driver.f90 b/modules/aerodyn/src/AeroDyn_Driver.f90 index fdc343249c..076f0a4bcc 100644 --- a/modules/aerodyn/src/AeroDyn_Driver.f90 +++ b/modules/aerodyn/src/AeroDyn_Driver.f90 @@ -52,24 +52,24 @@ program AeroDyn_Driver ! Init of time estimator t_global=0.0_DbKi t_final=dat%dvr%numSteps*dat%dvr%dt - if (dat%dvr%analysisType/=idAnalysisCombi) then + !if (dat%dvr%analysisType/=idAnalysisCombi) then call SimStatus_FirstTime( TiLstPrn, PrevClockTime, SimStrtTime, UsrTime2, t_global, t_final ) - endif + !endif ! One time loop do nt = 1, dat%dvr%numSteps call Dvr_TimeStep(nt, dat%dvr, dat%ADI, dat%FED, dat%errStat, dat%errMsg); call CheckError() ! Time update to screen t_global=nt*dat%dvr%dt - if (dat%dvr%analysisType/=idAnalysisCombi) then + !if (dat%dvr%analysisType/=idAnalysisCombi) then if (mod( nt + 1, 10 )==0) call SimStatus(TiLstPrn, PrevClockTime, t_global, t_final) - endif + !endif end do !nt=1,numSteps - if (dat%dvr%analysisType/=idAnalysisCombi) then + !if (dat%dvr%analysisType/=idAnalysisCombi) then ! display runtime to screen call RunTimes(StrtTime, UsrTime1, SimStrtTime, UsrTime2, t_global) - endif + !endif call Dvr_EndCase(dat%dvr, dat%ADI, dat%initialized, dat%errStat, dat%errMsg); call CheckError() diff --git a/modules/aerodyn/src/AeroDyn_Driver_Registry.txt b/modules/aerodyn/src/AeroDyn_Driver_Registry.txt index b216fc47f3..47c55804f2 100644 --- a/modules/aerodyn/src/AeroDyn_Driver_Registry.txt +++ b/modules/aerodyn/src/AeroDyn_Driver_Registry.txt @@ -15,7 +15,7 @@ usefrom AeroDyn_Registry.txt usefrom AeroDyn_Inflow_Registry.txt # # ..... Table of combined cases to run ....................................................................................................... -typedef AeroDyn_Driver/AD_Dvr Dvr_Case ReKi HWindSpeed - - - "Hub wind speed" "m/s" +typedef AeroDyn_Driver/AD_Dvr Dvr_Case ReKi HWindSpeed - - - "Hub wind speed" "m/s" typedef ^ ^ ReKi PLExp - - - "Power law wind-shear exponent" "-" typedef ^ ^ ReKi rotSpeed - - - "Rotor speed" "rad/s" typedef ^ ^ ReKi bldPitch - - - "Pitch angle" "rad" @@ -36,7 +36,7 @@ typedef ^ DvrVTK_SurfaceType SiKi BaseBox {3}{8} - - # typedef ^ DvrVTK_SurfaceType DvrVTK_BLSurfaceType BladeShape {:} - - "AirfoilCoords for each blade" m # ..... Data for driver output file ....................................................................................................... -typedef AeroDyn_Driver/AD_Dvr Dvr_Outputs ProgDesc AD_ver - - - "AeroDyn version information" - +typedef AeroDyn_Driver/AD_Dvr Dvr_Outputs ProgDesc AD_ver - - - "AeroDyn version information" - typedef ^ ^ IntKi unOutFile : - - "unit number for writing output file for each rotor" "-" typedef ^ ^ IntKi ActualChanLen - - - "Actual length of channels written to text file (less than or equal to ChanLen)" "-" typedef ^ ^ IntKi nDvrOutputs - - - "Number of outputs for the driver (without AD and IW)" "-" @@ -45,17 +45,18 @@ typedef ^ ^ character(25) Fmt_a typedef ^ ^ character(1) delim - - - "column delimiter" "-" typedef ^ ^ character(20) outFmt - - - "Format specifier" "-" typedef ^ ^ IntKi fileFmt - - - "Output format 1=Text, 2=Binary, 3=Both" "-" -typedef ^ ^ IntKi wrVTK - - - "0= no vtk, 1=init only, 2=animation" "-" +typedef ^ ^ IntKi WrVTK - - - "0= no vtk, 1=init only, 2=animation" "-" typedef ^ ^ IntKi WrVTK_Type - - - "Flag for VTK output type (1=surface, 2=line, 3=both)" - typedef ^ ^ character(1024) Root - - - "Output file rootname" "-" -typedef ^ ^ character(1024) VTK_OutFileRoot - - - "Output file rootname for vtk" "-" +typedef ^ ^ character(1024) VTK_OutFileRoot - - - "Output file rootname for vtk (includes directory)" "-" typedef ^ ^ character(ChanLen) WriteOutputHdr {:} - - "Channel headers" "-" typedef ^ ^ character(ChanLen) WriteOutputUnt {:} - - "Channel units" "-" typedef ^ ^ ReKi storage ::: - - "nTurbines x nChannel x nTime" typedef ^ ^ ReKi outLine : - - "Output line to be written to disk" typedef ^ ^ DvrVTK_SurfaceType VTK_surface : - - "Data for VTK surface visualization" -typedef ^ ^ INTEGER VTK_tWidth - - - "Width of number of files for leading zeros in file name format" - -typedef ^ ^ INTEGER n_VTKTime - - - "Number of time steps between writing VTK files" - +typedef ^ ^ IntKi VTK_tWidth - - - "Width of number of files for leading zeros in file name format" - +typedef ^ ^ IntKi n_VTKTime - - - "Number of time steps between writing VTK files" - +typedef ^ ^ DbKi VTK_DT - - - "Write VTK time step" - typedef ^ ^ SiKi VTKHubRad - - - "Hub radius for visualization" m typedef ^ ^ ReKi VTKNacDim 6 - - "Nacelle dimensions for visualization" m typedef ^ ^ SiKi VTKRefPoint 3 - - "RefPoint for VTK outputs" @@ -138,7 +139,7 @@ typedef ^ ^ ReKi Patm typedef ^ ^ ReKi Pvap - - - "Vapour pressure of working fluid" "Pa" typedef ^ ^ ReKi WtrDpth - - - "Water depth" "m" typedef ^ ^ ReKi MSL2SWL - - - "Offset between still-water level and mean sea level" "m" -typedef ^ ^ IntKi numTurbines - - - "number of blades on turbine" "-" +typedef ^ ^ IntKi numTurbines - -9999 - "number of turbine rotors" "-" typedef ^ ^ WTData WT : - - "Wind turbine data for driver" "-" typedef ^ ^ DbKi dT - - - "time increment" "s" typedef ^ ^ DbKi tMax - - - "time increment" "s" @@ -149,7 +150,7 @@ typedef ^ ^ IntKi iCase typedef ^ ^ ReKi timeSeries :: - - "Times series inputs when AnalysisType=1, 6 columns, Time, WndSpeed, ShearExp, RotSpd, Pitch, Yaw" "-" typedef ^ ^ IntKi iTimeSeries - - - "Stored index to optimize time interpolation" - typedef ^ ^ character(1024) root - - - "Output file rootname" "-" -typedef ^ ^ Dvr_Outputs out - - - "data for driver output file" "-" +typedef ^ ^ Dvr_Outputs out - - - "data for driver output file" "-" typedef ^ ^ ADI_IW_InputData IW_InitInp - - - "" - # ..... Data to wrap the driver .......................................................................................................... diff --git a/modules/aerodyn/src/AeroDyn_Driver_Subs.f90 b/modules/aerodyn/src/AeroDyn_Driver_Subs.f90 index a43ae3356a..d609215127 100644 --- a/modules/aerodyn/src/AeroDyn_Driver_Subs.f90 +++ b/modules/aerodyn/src/AeroDyn_Driver_Subs.f90 @@ -22,7 +22,6 @@ module AeroDyn_Driver_Subs use AeroDyn_Inflow_Types use AeroDyn_Inflow, only: ADI_Init, ADI_ReInit, ADI_End, ADI_CalcOutput, ADI_UpdateStates use AeroDyn_Inflow, only: concatOutputHeaders - use AeroDyn_Inflow, only: ADI_ADIW_Solve ! TODO remove me use AeroDyn_Inflow, only: Init_MeshMap_For_ADI, Set_Inputs_For_ADI use AeroDyn_IO, only: AD_WrVTK_Surfaces, AD_WrVTK_LinesPoints @@ -238,7 +237,6 @@ subroutine Dvr_InitCase(iCase, dvr, ADI, FED, errStat, errMsg ) DO j = 1-numInp, 0 call Shift_ADI_Inputs(j,dvr, ADI, errStat2, errMsg2); if(Failed()) return call Set_Inputs_For_ADI(ADI%u(1), FED, errStat2, errMsg2); if(Failed()) return - call ADI_ADIW_Solve(ADI%inputTimes(1), ADI%p, ADI%u(1)%AD, ADI%OtherState(1)%AD, ADI%m%IW%u, ADI%m%IW, .true., errStat2, errMsg2); if(Failed()) return ! TODO TODO TODO remove me END DO ! --- AeroDyn + Inflow at T=0 call ADI_CalcOutput(ADI%inputTimes(1), ADI%u(1), ADI%p, ADI%x(1), ADI%xd(1), ADI%z(1), ADI%OtherState(1), ADI%y, ADI%m, errStat2, errMsg2); if(Failed()) return @@ -291,8 +289,7 @@ subroutine Dvr_TimeStep(nt, dvr, ADI, FED, errStat, errMsg) ! u(1) is at nt, u(2) is at nt-1. Set inputs for nt timestep call Shift_ADI_Inputs(nt,dvr, ADI, errStat2, errMsg2); if(Failed()) return call Set_Inputs_For_ADI(ADI%u(1), FED, errStat2, errMsg2); if(Failed()) return - call ADI_ADIW_Solve(ADI%inputTimes(1), ADI%p, ADI%u(1)%AD, ADI%OtherState(1)%AD, ADI%m%IW%u, ADI%m%IW, .true., errStat, errMsg) - + time = ADI%inputTimes(2) ! Calculate outputs at nt - 1 (current time) @@ -361,7 +358,7 @@ subroutine Dvr_EndCase(dvr, ADI, initialized, errStat, errMsg) else sWT = '' endif - call WrBinFAST(trim(dvr%out%Root)//trim(sWT)//'.outb', FileFmtID_ChanLen_In, 'AeroDynDriver', dvr%out%WriteOutputHdr, dvr%out%WriteOutputUnt, (/0.0_DbKi, dvr%dt/), dvr%out%storage(:,:,iWT), errStat2, errMsg2) + call WrBinFAST(trim(dvr%out%Root)//trim(sWT)//'.outb', FileFmtID_ChanLen_In, GetVersion(version), dvr%out%WriteOutputHdr, dvr%out%WriteOutputUnt, (/0.0_DbKi, dvr%dt/), dvr%out%storage(:,:,iWT), errStat2, errMsg2) call SetErrStat(errStat2, errMsg2, errStat, errMsg, RoutineName) enddo endif @@ -448,7 +445,7 @@ subroutine Init_ADI_ForDriver(iCase, ADI, dvr, FED, dt, errStat, errMsg) !call AD_Dvr_DestroyAeroDyn_Data (AD , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, RoutineName) needInit=.true. endif - if (ADI%p%AD%WakeMod == WakeMod_FVW) then + if (ADI%p%AD%Wake_Mod == WakeMod_FVW) then call WrScr('[INFO] OLAF is used, AeroDyn will be re-initialized') needInit=.true. endif @@ -468,11 +465,11 @@ subroutine Init_ADI_ForDriver(iCase, ADI, dvr, FED, dt, errStat, errMsg) InitInp%IW_InitInp%HWindSpeed = dvr%IW_InitInp%HWindSpeed InitInp%IW_InitInp%RefHt = dvr%IW_InitInp%RefHt InitInp%IW_InitInp%PLExp = dvr%IW_InitInp%PLExp - InitInp%IW_InitInp%UseInputFile = .true. ! read input file instead of passed file data InitInp%IW_InitInp%MHK = dvr%MHK + InitInp%IW_InitInp%FilePassingMethod = 0_IntKi ! read input file instead of passed file data ! AeroDyn InitInp%AD%Gravity = 9.80665_ReKi - InitInp%AD%RootName = dvr%out%Root ! 'C:/Work/XFlow/' + InitInp%AD%RootName = dvr%out%Root InitInp%AD%InputFile = dvr%AD_InputFile InitInp%AD%MHK = dvr%MHK InitInp%AD%defFldDens = dvr%FldDens @@ -499,15 +496,15 @@ subroutine Init_ADI_ForDriver(iCase, ADI, dvr, FED, dt, errStat, errMsg) if (wt%projMod==-1)then !call WrScr('>>> Using HAWTprojection to determine projMod') if (wt%HAWTprojection) then - InitInp%AD%rotors(iWT)%AeroProjMod = APM_BEM_NoSweepPitchTwist ! default, with WithoutSweepPitchTwist + !InitInp%AD%rotors(iWT)%AeroProjMod = APM_BEM_NoSweepPitchTwist ! default, with WithoutSweepPitchTwist + InitInp%AD%rotors(iWT)%AeroProjMod = -1 ! We let the code decide based on BEM_Mod else InitInp%AD%rotors(iWT)%AeroProjMod = APM_LiftingLine endif else InitInp%AD%rotors(iWT)%AeroProjMod = wt%projMod endif - InitInp%AD%rotors(iWT)%AeroBEM_Mod = wt%BEM_Mod - !call WrScr(' Driver: projMod: '//trim(num2lstr(InitInp%AD%rotors(iWT)%AeroProjMod))//', BEM_Mod:'//trim(num2lstr(InitInp%AD%rotors(iWT)%AeroBEM_Mod))) + call WrScr(' Driver: projMod: '//trim(num2lstr(InitInp%AD%rotors(iWT)%AeroProjMod))) InitInp%AD%rotors(iWT)%HubPosition = y_ED%HubPtMotion%Position(:,1) InitInp%AD%rotors(iWT)%HubOrientation = y_ED%HubPtMotion%RefOrientation(:,:,1) InitInp%AD%rotors(iWT)%NacellePosition = y_ED%NacelleMotion%Position(:,1) @@ -519,7 +516,8 @@ subroutine Init_ADI_ForDriver(iCase, ADI, dvr, FED, dt, errStat, errMsg) enddo call ADI_Init(InitInp, ADI%u(1), ADI%p, ADI%x(1), ADI%xd(1), ADI%z(1), ADI%OtherState(1), ADI%y, ADI%m, dt, InitOut, errStat, errMsg) - + dvr%out%AD_ver = InitOut%Ver + ! Set output headers if (iCase==1) then call concatOutputHeaders(dvr%out%WriteOutputHdr, dvr%out%WriteOutputUnt, InitOut%WriteOutputHdr, InitOut%WriteOutputUnt, errStat2, errMsg2); if(Failed()) return @@ -551,7 +549,7 @@ logical function Failed0(txt) if (errStat /= 0) then ErrStat2 = ErrID_Fatal ErrMsg2 = "Could not allocate "//trim(txt) - call SetErrStat(errStat2, errMsg2, errStat, errMsg, 'Dvr_InitCase') + call SetErrStat(errStat2, errMsg2, errStat, errMsg, 'Init_ADI_ForDriver') endif Failed0 = errStat >= AbortErrLev if(Failed0) call cleanUp() @@ -593,26 +591,26 @@ subroutine Init_Meshes(dvr, FED, errStat, errMsg) orientation = R_gl2wt !bjj: Inspector consistently gives "Invalid Memory Access" errors here on the allocation of wt%ptMesh%RotationVel in MeshCreate. I haven't yet figured out why. - call CreatePointMesh(y_ED%PlatformPtMesh, pos, orientation, errStat2, errMsg2, hasMotion=.True., hasLoads=.False.); if(Failed()) return + call CreateInputPointMesh(y_ED%PlatformPtMesh, pos, orientation, errStat2, errMsg2, hasMotion=.True., hasLoads=.False.); if(Failed()) return ! Tower if (wt%hasTower) then pos = y_ED%PlatformPtMesh%Position(:,1) + matmul(transpose(R_gl2wt), wt%twr%origin_t) orientation = R_gl2wt - call CreatePointMesh(y_ED%TwrPtMesh, pos, orientation, errStat2, errMsg2, hasMotion=.True., hasLoads=.False.); if(Failed()) return + call CreateInputPointMesh(y_ED%TwrPtMesh, pos, orientation, errStat2, errMsg2, hasMotion=.True., hasLoads=.False.); if(Failed()) return endif ! Nacelle pos = y_ED%PlatformPtMesh%Position(:,1) + matmul(transpose(R_gl2wt), wt%nac%origin_t) orientation = R_gl2wt ! Yaw? - call CreatePointMesh(y_ED%NacelleMotion, pos, orientation, errStat2, errMsg2, hasMotion=.True., hasLoads=.False.); if(Failed()) return + call CreateInputPointMesh(y_ED%NacelleMotion, pos, orientation, errStat2, errMsg2, hasMotion=.True., hasLoads=.False.); if(Failed()) return ! Hub R_nac2gl = transpose(y_ED%NacelleMotion%RefOrientation(:,:,1)) R_nac2hub = EulerConstruct( wt%hub%orientation_n ) ! nacelle 2 hub (constant) pos = y_ED%NacelleMotion%Position(:,1) + matmul(R_nac2gl,wt%hub%origin_n) orientation = matmul(R_nac2hub, y_ED%NacelleMotion%RefOrientation(:,:,1)) ! Global 2 hub at t=0 - call CreatePointMesh(y_ED%HubPtMotion, pos, orientation, errStat2, errMsg2, hasMotion=.True., hasLoads=.False.); if(Failed())return + call CreateInputPointMesh(y_ED%HubPtMotion, pos, orientation, errStat2, errMsg2, hasMotion=.True., hasLoads=.False.); if(Failed())return ! Blades ! wt%Rg2b0 = EulerConstruct( wt%orientationInit ) ! global 2 base at t = 0 (constant) @@ -626,7 +624,7 @@ subroutine Init_Meshes(dvr, FED, errStat, errMsg) R_hub2bl = EulerConstruct( wt%bld(iB)%orientation_h ) ! Rotation matrix hub 2 blade (constant) orientation = matmul(R_hub2bl, y_ED%HubPtMotion%RefOrientation(:,:,1) ) ! Global 2 blade = hub2blade x global2hub pos = y_ED%HubPtMotion%Position(:,1) + matmul(R_hub2gl, wt%bld(iB)%origin_h) + wt%bld(iB)%hubRad_bl*orientation(3,:) - call CreatePointMesh(y_ED%BladeRootMotion(iB), pos, orientation, errStat2, errMsg2, hasMotion=.True., hasLoads=.False.); if(Failed())return + call CreateInputPointMesh(y_ED%BladeRootMotion(iB), pos, orientation, errStat2, errMsg2, hasMotion=.True., hasLoads=.False.); if(Failed())return end do ! --- Mapping @@ -704,9 +702,12 @@ subroutine Set_Mesh_Motion(nt, dvr, ADI, FED, errStat, errMsg) ! Getting current time values by interpolation ! timestate = HWindSpeed, PLExp, RotSpeed, Pitch, yaw call interpTimeValue(dvr%timeSeries, time, dvr%iTimeSeries, timeState) - ! Set wind at this time + ! Set wind at this time ADI%m%IW%HWindSpeed = timeState(1) ADI%m%IW%PLexp = timeState(2) + ! Set values in flow field (not recommended) + ADI%m%IW%p%FlowField%Uniform%VelH = timeState(1) + ADI%m%IW%p%FlowField%Uniform%ShrV = timeState(2) !! Set motion at this time dvr%WT(1)%hub%rotSpeed = timeState(3) ! rad/s do j=1,size(dvr%WT(1)%bld) @@ -1009,9 +1010,6 @@ subroutine Dvr_ReadInputFile(fileName, dvr, errStat, errMsg ) call ParseVar(FileInfo_In, CurLine, 'ProjMod'//sWT , wt%projMod , errStat2, errMsg2, unEc); if (errStat2==ErrID_Fatal) then wt%projMod = -1 - wt%BEM_Mod = -1 - else - call ParseVar(FileInfo_In, CurLine, 'BEM_Mod'//sWT , wt%BEM_Mod , errStat2, errMsg2, unEc); if(Failed()) return endif call ParseVar(FileInfo_In, CurLine, 'BasicHAWTFormat'//sWT , wt%basicHAWTFormat , errStat2, errMsg2, unEc); if(Failed()) return @@ -1023,7 +1021,7 @@ subroutine Dvr_ReadInputFile(fileName, dvr, errStat, errMsg ) if (wt%BasicHAWTFormat) then ! --- Basic Geometry call ParseAry(FileInfo_In, CurLine, 'baseOriginInit'//sWT , wt%originInit , 3 , errStat2, errMsg2 , unEc); if(Failed()) return - if ( dvr%MHK == 1 ) then + if ( dvr%MHK == MHK_FixedBottom ) then wt%originInit(3) = wt%originInit(3) - dvr%WtrDpth end if call ParseVar(FileInfo_In, CurLine, 'numBlades'//sWT , wt%numBlades , errStat2, errMsg2 , unEc); if(Failed()) return @@ -1061,7 +1059,7 @@ subroutine Dvr_ReadInputFile(fileName, dvr, errStat, errMsg ) ! --- Advanced geometry ! Rotor origin and orientation call ParseAry(FileInfo_In, CurLine, 'baseOriginInit'//sWT , wt%originInit, 3 , errStat2, errMsg2, unEc); if(Failed()) return - if ( dvr%MHK == 1 ) then + if ( dvr%MHK == MHK_FixedBottom ) then wt%originInit(3) = wt%originInit(3) - dvr%WtrDpth end if call ParseAry(FileInfo_In, CurLine, 'baseOrientationInit'//sWT, wt%orientationInit, 3 , errStat2, errMsg2, unEc); if(Failed()) return @@ -1107,7 +1105,7 @@ subroutine Dvr_ReadInputFile(fileName, dvr, errStat, errMsg ) call ParseVar(FileInfo_In, CurLine, 'amplitude'//sWT , wt%amplitude, errStat2, errMsg2, unEc); if(Failed()) return call ParseVar(FileInfo_In, CurLine, 'frequency'//sWT , wt%frequency, errStat2, errMsg2, unEc); if(Failed()) return call ParseVar(FileInfo_In, CurLine, 'baseMotionFilename'//sWT, wt%motionFileName, errStat2, errMsg2, unEc); if(Failed()) return - wt%frequency = wt%frequency * 2 *pi ! Hz to rad/s + wt%frequency = wt%frequency * 2 * pi ! Hz to rad/s if (dvr%analysisType==idAnalysisRegular) then if (wt%motionType==idBaseMotionGeneral) then call ReadDelimFile(wt%motionFileName, 19, wt%motion, errStat2, errMsg2, priPath=priPath); if(Failed()) return @@ -1315,7 +1313,7 @@ subroutine setSimpleMotion(wt, rotSpeed, bldPitch, nacYaw, DOF, amplitude, frequ integer :: i wt%degreeofFreedom = DOF wt%amplitude = amplitude - wt%frequency = frequency * 2 *pi ! Hz to rad/s + wt%frequency = frequency wt%nac%motionType = idNacMotionConstant wt%nac%yaw = nacYaw* PI /180._ReKi ! deg 2 rad wt%hub%motionType = idHubMotionConstant @@ -1347,7 +1345,7 @@ subroutine ValidateInputs(dvr, errStat, errMsg) ! Turbine Data: !if ( dvr%numBlades < 1 ) call SetErrStat( ErrID_Fatal, "There must be at least 1 blade (numBlades).", errStat, ErrMsg, RoutineName) ! Combined-Case Analysis: - if (dvr%MHK /= 0 .and. dvr%MHK /= 1 .and. dvr%MHK /= 2) call SetErrStat(ErrID_Fatal, 'MHK switch must be 0, 1, or 2.', ErrStat, ErrMsg, RoutineName) + if (dvr%MHK /= MHK_None .and. dvr%MHK /= MHK_FixedBottom .and. dvr%MHK /= MHK_Floating) call SetErrStat(ErrID_Fatal, 'MHK switch must be 0, 1, or 2.', ErrStat, ErrMsg, RoutineName) if (dvr%DT < epsilon(0.0_ReKi) ) call SetErrStat(ErrID_Fatal,'dT must be larger than 0.',errStat, errMsg,RoutineName) if (Check(.not.(ANY((/0,1/) == dvr%IW_InitInp%compInflow) ), 'CompInflow needs to be 0 or 1')) return @@ -1454,7 +1452,7 @@ subroutine Dvr_InitializeOutputs(nWT, out, numSteps, errStat, errMsg) end if call OpenFOutFile ( out%unOutFile(iWT), trim(out%Root)//trim(sWT)//'.out', errStat, errMsg ) if ( errStat >= AbortErrLev ) return - write (out%unOutFile(iWT),'(/,A)') 'Predictions were generated on '//CurDate()//' at '//CurTime()//' using '//trim( version%Name ) + write (out%unOutFile(iWT),'(/,A)') 'Predictions were generated on '//CurDate()//' at '//CurTime()//' using '//trim( TRIM(GetVersion(version)) ) write (out%unOutFile(iWT),'(1X,A)') trim(GetNVD(out%AD_ver)) write (out%unOutFile(iWT),'()' ) !print a blank line write (out%unOutFile(iWT),'()' ) !print a blank line @@ -1670,8 +1668,8 @@ subroutine Dvr_WriteOutputs(nt, t, dvr, out, yADI, errStat, errMsg) out%outLine(1:nDV) = dvr%wt(iWT)%WriteOutput(1:nDV) ! Driver Write Outputs ! out%outLine(11) = dvr%WT(iWT)%hub%azimuth ! azimuth already stored a nt-1 - out%outLine(nDV+1:nDV+nAD) = yADI%AD%rotors(iWT)%WriteOutput ! AeroDyn WriteOutputs - out%outLine(nDV+nAD+1:) = yADI%IW_WriteOutput ! InflowWind WriteOutputs + out%outLine(nDV+1:nDV+nIW) = yADI%IW_WriteOutput ! InflowWind WriteOutputs + out%outLine(nDV+nIW+1:) = yADI%AD%rotors(iWT)%WriteOutput ! AeroDyn WriteOutputs if (out%fileFmt==idFmtBoth .or. out%fileFmt == idFmtAscii) then ! ASCII @@ -1684,133 +1682,19 @@ subroutine Dvr_WriteOutputs(nt, t, dvr, out, yADI, errStat, errMsg) endif if (out%fileFmt==idFmtBoth .or. out%fileFmt == idFmtBinary) then ! Store for binary - out%storage(1:nDV+nAD+nIW, nt, iWT) = out%outLine(1:nDV+nAD+nIW) + out%storage(1:nDV+nIW+nAD, nt, iWT) = out%outLine(1:nDV+nIW+nAD) endif endif enddo end subroutine Dvr_WriteOutputs - -!---------------------------------------------------------------------------------------------------------------------------------- -!> Read a delimited file with one line of header -subroutine ReadDelimFile(Filename, nCol, Array, errStat, errMsg, nHeaderLines, priPath) - character(len=*), intent(in) :: Filename - integer, intent(in) :: nCol - real(ReKi), dimension(:,:), allocatable, intent(out) :: Array - integer(IntKi) , intent(out) :: errStat ! Status of error message - character(*) , intent(out) :: errMsg ! Error message if errStat /= ErrID_None - integer(IntKi), optional, intent(in ) :: nHeaderLines - character(*) , optional, intent(in ) :: priPath ! Primary path, to use if filename is not absolute - integer :: UnIn, i, j, nLine, nHead - character(len= 2048) :: line - integer(IntKi) :: errStat2 ! local status of error message - character(ErrMsgLen) :: errMsg2 ! temporary Error message - character(len=2048) :: Filename_Loc ! filename local to this function - errStat = ErrID_None - errMsg = "" - - Filename_Loc = Filename - if (present(priPath)) then - if (PathIsRelative(Filename_Loc)) Filename_Loc = trim(PriPath)//trim(Filename) - endif - - ! Open file - call GetNewUnit(UnIn) - call OpenFInpFile(UnIn, Filename_Loc, errStat2, errMsg2); if(Failed()) return - ! Count number of lines - nLine = line_count(UnIn) - allocate(Array(nLine-1, nCol), stat=errStat2); errMsg2='allocation failed'; if(Failed())return - ! Read header - nHead=1 - if (present(nHeaderLines)) nHead = nHeaderLines - do i=1,nHead - read(UnIn, *, IOSTAT=errStat2) line - errMsg2 = ' Error reading line '//trim(Num2LStr(1))//' of file: '//trim(Filename_Loc) - if(Failed()) return - enddo - ! Read data - do I = 1,nLine-1 - read (UnIn,*,IOSTAT=errStat2) (Array(I,J), J=1,nCol) - errMsg2 = ' Error reading line '//trim(Num2LStr(I+1))//' of file: '//trim(Filename_Loc) - if(Failed()) return - end do - close(UnIn) -contains - logical function Failed() - CALL SetErrStat(errStat2, errMsg2, errStat, errMsg, 'ReadDelimFile' ) - Failed = errStat >= AbortErrLev - if (Failed) then - if ((UnIn)>0) close(UnIn) - endif - end function Failed -end subroutine ReadDelimFile - -!---------------------------------------------------------------------------------------------------------------------------------- -!> Counts number of lines in a file -integer function line_count(iunit) - integer, intent(in) :: iunit - character(len=2048) :: line - ! safety for infinite loop.. - integer :: i - integer, parameter :: nline_max=100000000 ! 100 M - line_count=0 - do i=1,nline_max - line='' - read(iunit,'(A)',END=100)line - line_count=line_count+1 - enddo - if (line_count==nline_max) then - print*,'Error: maximum number of line exceeded for line_count' - STOP - endif -100 if(len(trim(line))>0) then - line_count=line_count+1 - endif - rewind(iunit) - return -end function - -!---------------------------------------------------------------------------------------------------------------------------------- -!> Perform linear interpolation of an array, where first column is assumed to be ascending time values -!! First value is used for times before, and last value is used for time beyond -subroutine interpTimeValue(array, time, iLast, values) - real(ReKi), dimension(:,:), intent(in) :: array !< vector of time steps - real(DbKi), intent(in) :: time !< time - integer, intent(inout) :: iLast - real(ReKi), dimension(:), intent(out) :: values !< vector of values at given time - integer :: i - real(ReKi) :: alpha - if (array(iLast,1)> time) then - values = array(iLast,2:) - elseif (iLast == size(array,1)) then - values = array(iLast,2:) - else - ! Look for index - do i=iLast,size(array,1) - if (array(i,1)<=time) then - iLast=i - else - exit - endif - enddo - if (iLast==size(array,1)) then - values = array(iLast,2:) - else - ! Linear interpolation - alpha = (array(iLast+1,1)-time)/(array(iLast+1,1)-array(iLast,1)) - values = array(iLast,2:)*alpha + array(iLast+1,2:)*(1-alpha) - !print*,'time', array(iLast,1), '<=', time,'<', array(iLast+1,1), 'fact', alpha - endif - endif -end subroutine interpTimeValue - !---------------------------------------------------------------------------------------------------------------------------------- !> This subroutine sets up the information needed for plotting VTK surfaces. -subroutine setVTKParameters(p_FAST, dvr, ADI, errStat, errMsg, dirname) - type(Dvr_Outputs), intent(inout) :: p_FAST !< The parameters of the glue code - type(Dvr_SimData), target, intent(inout) :: dvr ! intent(out) only so that we can save FmtWidth in dvr%out%ActualChanLen - type(ADI_Data), target, intent(in ) :: ADI ! Input data for initialization (intent out for getting AD WriteOutput names/units) - integer(IntKi), intent( out) :: errStat !< Error status of the operation - character(*), intent( out) :: errMsg !< Error message if errStat /= ErrID_None +subroutine setVTKParameters(DVR_Outs, dvr, ADI, errStat, errMsg, dirname) + type(Dvr_Outputs), intent(inout) :: DVR_Outs !< The parameters of the glue code + type(Dvr_SimData), target, intent(inout) :: dvr ! intent(out) only so that we can save FmtWidth in dvr%out%ActualChanLen + type(ADI_Data), target, intent(in ) :: ADI ! Input data for initialization (intent out for getting AD WriteOutput names/units) + integer(IntKi), intent( out) :: errStat !< Error status of the operation + character(*), intent( out) :: errMsg !< Error message if errStat /= ErrID_None character(*), optional,intent(in ) :: dirname real(SiKi) :: RefPoint(3), RefLengths(2) real(SiKi) :: x, y @@ -1842,19 +1726,23 @@ subroutine setVTKParameters(p_FAST, dvr, ADI, errStat, errMsg, dirname) ! get the name of the output directory for vtk files (in a subdirectory called "vtk" of the output directory), and ! create the VTK directory if it does not exist - call GetPath ( p_FAST%root, p_FAST%VTK_OutFileRoot, vtkroot ) ! the returned p_FAST%VTK_OutFileRoot includes a file separator character at the end - p_FAST%VTK_OutFileRoot = trim(p_FAST%VTK_OutFileRoot) // trim(dir) - call MKDIR( trim(p_FAST%VTK_OutFileRoot) ) - p_FAST%VTK_OutFileRoot = trim( p_FAST%VTK_OutFileRoot ) // PathSep // trim(vtkroot) + call GetPath ( DVR_Outs%root, DVR_Outs%VTK_OutFileRoot, vtkroot ) ! the returned DVR_Outs%VTK_OutFileRoot includes a file separator character at the end + if (PathIsRelative(trim(dir))) then + DVR_Outs%VTK_OutFileRoot = trim(DVR_Outs%VTK_OutFileRoot) // trim(dir) + else + DVR_Outs%VTK_OutFileRoot = trim(dir) + endif + call MKDIR( trim(DVR_Outs%VTK_OutFileRoot) ) + DVR_Outs%VTK_OutFileRoot = trim( DVR_Outs%VTK_OutFileRoot ) // PathSep // trim(vtkroot) ! calculate the number of digits in 'y_FAST%NOutSteps' (Maximum number of output steps to be written) ! this will be used to pad the write-out step in the VTK filename with zeros in calls to MeshWrVTK() - p_FAST%VTK_tWidth = max(9, CEILING( log10( real(dvr%numSteps+1, ReKi) / p_FAST%n_VTKTime ) ) + 1) ! NOTE: at least 9, if user changes dt/and tmax + DVR_Outs%VTK_tWidth = max(9, CEILING( log10( real(dvr%numSteps+1, ReKi) / DVR_Outs%n_VTKTime ) ) + 1) ! NOTE: at least 9, if user changes dt/and tmax - if (allocated(p_FAST%VTK_Surface)) then + if (allocated(DVR_Outs%VTK_Surface)) then return ! The surfaces were already computed (for combined cases) endif - allocate(p_FAST%VTK_Surface(dvr%numTurbines)) + allocate(DVR_Outs%VTK_Surface(dvr%numTurbines)) ! --- Find dimensions for all objects to determine "Ground" and typical dimensions MaxBladeLength = 0 MaxTwrLength = 0 @@ -1895,7 +1783,7 @@ subroutine setVTKParameters(p_FAST, dvr, ADI, errStat, errMsg, dirname) enddo ! Loop on turbine ! Get radius for ground (blade length + hub radius): - GroundRad = MaxBladeLength + MaxTwrLength+ p_FAST%VTKHubRad + GroundRad = MaxBladeLength + MaxTwrLength+ DVR_Outs%VTKHubRad ! write the ground or seabed reference polygon: RefPoint(1:2) = dvr%WT(1)%originInit(1:2) do iWT=2,dvr%numTurbines @@ -1905,37 +1793,37 @@ subroutine setVTKParameters(p_FAST, dvr, ADI, errStat, errMsg, dirname) RefPoint(3) = 0.0_ReKi RefLengths = GroundRad + sqrt((WorldBoxMax(1)-WorldBoxMin(1))**2 + (WorldBoxMax(2)-WorldBoxMin(2))**2) - call WrVTK_Ground (RefPoint, RefLengths, trim(p_FAST%VTK_OutFileRoot) // '.GroundSurface', errStat2, errMsg2 ) + call WrVTK_Ground (RefPoint, RefLengths, trim(DVR_Outs%VTK_OutFileRoot) // '.GroundSurface', errStat2, errMsg2 ) ! --- Create surfaces for Nacelle, Base, Tower, Blades do iWT=1,dvr%numTurbines wt => dvr%wt(iWT) - p_FAST%VTK_Surface(iWT)%NumSectors = 25 + DVR_Outs%VTK_Surface(iWT)%NumSectors = 25 ! Create nacelle box - p_FAST%VTK_Surface(iWT)%NacelleBox(:,1) = (/ p_FAST%VTKNacDim(1) , p_FAST%VTKNacDim(2)+p_FAST%VTKNacDim(5), p_FAST%VTKNacDim(3) /) - p_FAST%VTK_Surface(iWT)%NacelleBox(:,2) = (/ p_FAST%VTKNacDim(1)+p_FAST%VTKNacDim(4), p_FAST%VTKNacDim(2)+p_FAST%VTKNacDim(5), p_FAST%VTKNacDim(3) /) - p_FAST%VTK_Surface(iWT)%NacelleBox(:,3) = (/ p_FAST%VTKNacDim(1)+p_FAST%VTKNacDim(4), p_FAST%VTKNacDim(2) , p_FAST%VTKNacDim(3) /) - p_FAST%VTK_Surface(iWT)%NacelleBox(:,4) = (/ p_FAST%VTKNacDim(1) , p_FAST%VTKNacDim(2) , p_FAST%VTKNacDim(3) /) - p_FAST%VTK_Surface(iWT)%NacelleBox(:,5) = (/ p_FAST%VTKNacDim(1) , p_FAST%VTKNacDim(2) , p_FAST%VTKNacDim(3)+p_FAST%VTKNacDim(6) /) - p_FAST%VTK_Surface(iWT)%NacelleBox(:,6) = (/ p_FAST%VTKNacDim(1)+p_FAST%VTKNacDim(4), p_FAST%VTKNacDim(2) , p_FAST%VTKNacDim(3)+p_FAST%VTKNacDim(6) /) - p_FAST%VTK_Surface(iWT)%NacelleBox(:,7) = (/ p_FAST%VTKNacDim(1)+p_FAST%VTKNacDim(4), p_FAST%VTKNacDim(2)+p_FAST%VTKNacDim(5), p_FAST%VTKNacDim(3)+p_FAST%VTKNacDim(6) /) - p_FAST%VTK_Surface(iWT)%NacelleBox(:,8) = (/ p_FAST%VTKNacDim(1) , p_FAST%VTKNacDim(2)+p_FAST%VTKNacDim(5), p_FAST%VTKNacDim(3)+p_FAST%VTKNacDim(6) /) + DVR_Outs%VTK_Surface(iWT)%NacelleBox(:,1) = (/ DVR_Outs%VTKNacDim(1) , DVR_Outs%VTKNacDim(2)+DVR_Outs%VTKNacDim(5), DVR_Outs%VTKNacDim(3) /) + DVR_Outs%VTK_Surface(iWT)%NacelleBox(:,2) = (/ DVR_Outs%VTKNacDim(1)+DVR_Outs%VTKNacDim(4), DVR_Outs%VTKNacDim(2)+DVR_Outs%VTKNacDim(5), DVR_Outs%VTKNacDim(3) /) + DVR_Outs%VTK_Surface(iWT)%NacelleBox(:,3) = (/ DVR_Outs%VTKNacDim(1)+DVR_Outs%VTKNacDim(4), DVR_Outs%VTKNacDim(2) , DVR_Outs%VTKNacDim(3) /) + DVR_Outs%VTK_Surface(iWT)%NacelleBox(:,4) = (/ DVR_Outs%VTKNacDim(1) , DVR_Outs%VTKNacDim(2) , DVR_Outs%VTKNacDim(3) /) + DVR_Outs%VTK_Surface(iWT)%NacelleBox(:,5) = (/ DVR_Outs%VTKNacDim(1) , DVR_Outs%VTKNacDim(2) , DVR_Outs%VTKNacDim(3)+DVR_Outs%VTKNacDim(6) /) + DVR_Outs%VTK_Surface(iWT)%NacelleBox(:,6) = (/ DVR_Outs%VTKNacDim(1)+DVR_Outs%VTKNacDim(4), DVR_Outs%VTKNacDim(2) , DVR_Outs%VTKNacDim(3)+DVR_Outs%VTKNacDim(6) /) + DVR_Outs%VTK_Surface(iWT)%NacelleBox(:,7) = (/ DVR_Outs%VTKNacDim(1)+DVR_Outs%VTKNacDim(4), DVR_Outs%VTKNacDim(2)+DVR_Outs%VTKNacDim(5), DVR_Outs%VTKNacDim(3)+DVR_Outs%VTKNacDim(6) /) + DVR_Outs%VTK_Surface(iWT)%NacelleBox(:,8) = (/ DVR_Outs%VTKNacDim(1) , DVR_Outs%VTKNacDim(2)+DVR_Outs%VTKNacDim(5), DVR_Outs%VTKNacDim(3)+DVR_Outs%VTKNacDim(6) /) ! Create base box (using towerbase or nacelle dime) - BaseBoxDim = minval(p_FAST%VTKNacDim(4:6))/2 + BaseBoxDim = minval(DVR_Outs%VTKNacDim(4:6))/2 if (size(ADI%m%VTK_Surfaces(iWT)%TowerRad)>0) then BaseBoxDim = ADI%m%VTK_Surfaces(iWT)%TowerRad(1) endif - p_FAST%VTK_Surface(iWT)%BaseBox(:,1) = (/ -BaseBoxDim , -BaseBoxDim+2*BaseBoxDim, -BaseBoxDim /) - p_FAST%VTK_Surface(iWT)%BaseBox(:,2) = (/ -BaseBoxDim+2*BaseBoxDim, -BaseBoxDim+2*BaseBoxDim, -BaseBoxDim /) - p_FAST%VTK_Surface(iWT)%BaseBox(:,3) = (/ -BaseBoxDim+2*BaseBoxDim, -BaseBoxDim , -BaseBoxDim /) - p_FAST%VTK_Surface(iWT)%BaseBox(:,4) = (/ -BaseBoxDim , -BaseBoxDim , -BaseBoxDim /) - p_FAST%VTK_Surface(iWT)%BaseBox(:,5) = (/ -BaseBoxDim , -BaseBoxDim , -BaseBoxDim+2*BaseBoxDim /) - p_FAST%VTK_Surface(iWT)%BaseBox(:,6) = (/ -BaseBoxDim+2*BaseBoxDim, -BaseBoxDim , -BaseBoxDim+2*BaseBoxDim /) - p_FAST%VTK_Surface(iWT)%BaseBox(:,7) = (/ -BaseBoxDim+2*BaseBoxDim, -BaseBoxDim+2*BaseBoxDim, -BaseBoxDim+2*BaseBoxDim /) - p_FAST%VTK_Surface(iWT)%BaseBox(:,8) = (/ -BaseBoxDim , -BaseBoxDim+2*BaseBoxDim, -BaseBoxDim+2*BaseBoxDim /) + DVR_Outs%VTK_Surface(iWT)%BaseBox(:,1) = (/ -BaseBoxDim , -BaseBoxDim+2*BaseBoxDim, -BaseBoxDim /) + DVR_Outs%VTK_Surface(iWT)%BaseBox(:,2) = (/ -BaseBoxDim+2*BaseBoxDim, -BaseBoxDim+2*BaseBoxDim, -BaseBoxDim /) + DVR_Outs%VTK_Surface(iWT)%BaseBox(:,3) = (/ -BaseBoxDim+2*BaseBoxDim, -BaseBoxDim , -BaseBoxDim /) + DVR_Outs%VTK_Surface(iWT)%BaseBox(:,4) = (/ -BaseBoxDim , -BaseBoxDim , -BaseBoxDim /) + DVR_Outs%VTK_Surface(iWT)%BaseBox(:,5) = (/ -BaseBoxDim , -BaseBoxDim , -BaseBoxDim+2*BaseBoxDim /) + DVR_Outs%VTK_Surface(iWT)%BaseBox(:,6) = (/ -BaseBoxDim+2*BaseBoxDim, -BaseBoxDim , -BaseBoxDim+2*BaseBoxDim /) + DVR_Outs%VTK_Surface(iWT)%BaseBox(:,7) = (/ -BaseBoxDim+2*BaseBoxDim, -BaseBoxDim+2*BaseBoxDim, -BaseBoxDim+2*BaseBoxDim /) + DVR_Outs%VTK_Surface(iWT)%BaseBox(:,8) = (/ -BaseBoxDim , -BaseBoxDim+2*BaseBoxDim, -BaseBoxDim+2*BaseBoxDim /) enddo ! iWT, turbines @@ -1943,12 +1831,12 @@ end subroutine SetVTKParameters !---------------------------------------------------------------------------------------------------------------------------------- !> This routine writes a minimal subset of meshes with surfaces to VTK-formatted files. It doesn't bother with !! returning an error code. -subroutine WrVTK_Surfaces(t_global, ADI, FED, p_FAST, VTK_count) +subroutine WrVTK_Surfaces(t_global, ADI, FED, DVR_Outs, VTK_count) use FVW_IO, only: WrVTK_FVW real(DbKi), intent(in ) :: t_global !< Current global time type(FED_Data), target, intent(in ) :: FED !< Elastic wind turbine data (Fake ElastoDyn) type(ADI_Data), intent(in ) :: ADI !< Input data for initialization (intent out for getting AD WriteOutput names/units) - type(Dvr_Outputs), intent(in ) :: p_FAST !< Parameters for the glue code + type(Dvr_Outputs), intent(in ) :: DVR_Outs !< Parameters for the glue code integer(IntKi) , intent(in ) :: VTK_count logical, parameter :: OutputFields = .FALSE. ! due to confusion about what fields mean on a surface, we are going to just output the basic meshes if people ask for fields integer(IntKi) :: errStat2 @@ -1959,7 +1847,7 @@ subroutine WrVTK_Surfaces(t_global, ADI, FED, p_FAST, VTK_count) type(RotFED), pointer :: y_ED ! Alias to shorten notation ! AeroDyn surfaces (Blades, Hub, Tower) - call AD_WrVTK_Surfaces(ADI%u(2)%AD, ADI%y%AD, p_FAST%VTKRefPoint, ADI%m%VTK_Surfaces, VTK_count, p_FAST%VTK_OutFileRoot, p_FAST%VTK_tWidth, 25, p_FAST%VTKHubRad) + call AD_WrVTK_Surfaces(ADI%u(2)%AD, ADI%y%AD, DVR_Outs%VTKRefPoint, ADI%m%VTK_Surfaces, VTK_count, DVR_Outs%VTK_OutFileRoot, DVR_Outs%VTK_tWidth, 25, DVR_Outs%VTKHubRad) ! Elastic info nWT = size(FED%WT) @@ -1972,25 +1860,25 @@ subroutine WrVTK_Surfaces(t_global, ADI, FED, p_FAST, VTK_count) y_ED => FED%WT(iWT) ! Base - call MeshWrVTK_PointSurface (p_FAST%VTKRefPoint, y_ED%PlatformPtMesh, trim(p_FAST%VTK_OutFileRoot)//trim(sWT)//'.BaseSurface', & - VTK_count, OutputFields, errStat2, errMsg2, p_FAST%VTK_tWidth , verts = p_FAST%VTK_Surface(iWT)%BaseBox) + call MeshWrVTK_PointSurface (DVR_Outs%VTKRefPoint, y_ED%PlatformPtMesh, trim(DVR_Outs%VTK_OutFileRoot)//trim(sWT)//'.BaseSurface', & + VTK_count, OutputFields, errStat2, errMsg2, DVR_Outs%VTK_tWidth , verts = DVR_Outs%VTK_Surface(iWT)%BaseBox) if (y_ED%numBlades>0) then ! Nacelle - call MeshWrVTK_PointSurface (p_FAST%VTKRefPoint, y_ED%NacelleMotion, trim(p_FAST%VTK_OutFileRoot)//trim(sWT)//'.NacelleSurface', & - VTK_count, OutputFields, errStat2, errMsg2, p_FAST%VTK_tWidth , verts = p_FAST%VTK_Surface(iWT)%NacelleBox) + call MeshWrVTK_PointSurface (DVR_Outs%VTKRefPoint, y_ED%NacelleMotion, trim(DVR_Outs%VTK_OutFileRoot)//trim(sWT)//'.NacelleSurface', & + VTK_count, OutputFields, errStat2, errMsg2, DVR_Outs%VTK_tWidth , verts = DVR_Outs%VTK_Surface(iWT)%NacelleBox) endif - if (p_FAST%WrVTK>1) then + if (DVR_Outs%WrVTK>1) then ! --- animations ! Tower base - call MeshWrVTK_PointSurface (p_FAST%VTKRefPoint, y_ED%TwrPtMesh, trim(p_FAST%VTK_OutFileRoot)//trim(sWT)//'.TwrBaseSurface', & - VTK_count, OutputFields, errStat2, errMsg2, p_FAST%VTK_tWidth , & - NumSegments=p_FAST%VTK_Surface(iWT)%NumSectors, radius=p_FAST%VTKHubRad) + call MeshWrVTK_PointSurface (DVR_Outs%VTKRefPoint, y_ED%TwrPtMesh, trim(DVR_Outs%VTK_OutFileRoot)//trim(sWT)//'.TwrBaseSurface', & + VTK_count, OutputFields, errStat2, errMsg2, DVR_Outs%VTK_tWidth , & + NumSegments=DVR_Outs%VTK_Surface(iWT)%NumSectors, radius=DVR_Outs%VTKHubRad) if (ADI%u(2)%AD%rotors(iWT)%TowerMotion%nNodes>0) then - call MeshWrVTK_PointSurface (p_FAST%VTKRefPoint, y_ED%TwrPtMeshAD, trim(p_FAST%VTK_OutFileRoot)//trim(sWT)//'.TwrBaseSurfaceAD', & - VTK_count, OutputFields, errStat2, errMsg2, p_FAST%VTK_tWidth , & - NumSegments=p_FAST%VTK_Surface(iWT)%NumSectors, radius=p_FAST%VTKHubRad) + call MeshWrVTK_PointSurface (DVR_Outs%VTKRefPoint, y_ED%TwrPtMeshAD, trim(DVR_Outs%VTK_OutFileRoot)//trim(sWT)//'.TwrBaseSurfaceAD', & + VTK_count, OutputFields, errStat2, errMsg2, DVR_Outs%VTK_tWidth , & + NumSegments=DVR_Outs%VTK_Surface(iWT)%NumSectors, radius=DVR_Outs%VTKHubRad) endif endif enddo @@ -1998,18 +1886,18 @@ subroutine WrVTK_Surfaces(t_global, ADI, FED, p_FAST, VTK_count) ! Free wake if (allocated(ADI%m%AD%FVW_u)) then if (allocated(ADI%m%AD%FVW_u(1)%WingsMesh)) then - call WrVTK_FVW(ADI%p%AD%FVW, ADI%x(1)%AD%FVW, ADI%z(1)%AD%FVW, ADI%m%AD%FVW, trim(p_FAST%VTK_OutFileRoot)//'.FVW', VTK_count, p_FAST%VTK_tWidth, bladeFrame=.FALSE.) ! bladeFrame==.FALSE. to output in global coords + call WrVTK_FVW(ADI%p%AD%FVW, ADI%x(1)%AD%FVW, ADI%z(1)%AD%FVW, ADI%m%AD%FVW, trim(DVR_Outs%VTK_OutFileRoot)//'.FVW', VTK_count, DVR_Outs%VTK_tWidth, bladeFrame=.FALSE.) ! bladeFrame==.FALSE. to output in global coords end if end if end subroutine WrVTK_Surfaces !> This routine writes a minimal subset of meshes with surfaces to VTK-formatted files. It doesn't bother with !! returning an error code. -subroutine WrVTK_Lines(t_global, ADI, FED, p_FAST, VTK_count) +subroutine WrVTK_Lines(t_global, ADI, FED, DVR_Outs, VTK_count) use FVW_IO, only: WrVTK_FVW REAL(DbKi), INTENT(IN ) :: t_global !< Current global time type(ADI_Data), intent(in ) :: ADI !< Input data for initialization (intent out for getting AD WriteOutput names/units) type(FED_Data), target, intent(in ) :: FED !< Elastic wind turbine data (Fake ElastoDyn) - TYPE(Dvr_Outputs), INTENT(IN ) :: p_FAST !< Parameters for the glue code + TYPE(Dvr_Outputs), INTENT(IN ) :: DVR_Outs !< Parameters for the glue code INTEGER(IntKi) , INTENT(IN ) :: VTK_count logical, parameter :: OutputFields = .TRUE. INTEGER(IntKi) :: k @@ -2021,7 +1909,7 @@ subroutine WrVTK_Lines(t_global, ADI, FED, p_FAST, VTK_count) type(RotFED), pointer :: y_ED ! Alias to shorten notation ! AeroDyn surfaces (Blades, Tower) - call AD_WrVTK_LinesPoints(ADI%u(2)%AD, ADI%y%AD, p_FAST%VTKRefPoint, VTK_count, p_FAST%VTK_OutFileRoot, p_FAST%VTK_tWidth) + call AD_WrVTK_LinesPoints(ADI%u(2)%AD, ADI%y%AD, DVR_Outs%VTKRefPoint, VTK_count, DVR_Outs%VTK_OutFileRoot, DVR_Outs%VTK_tWidth) ! Elastic info nWT = size(FED%WT) @@ -2033,34 +1921,34 @@ subroutine WrVTK_Lines(t_global, ADI, FED, p_FAST, VTK_count) endif y_ED => FED%WT(iWT) - if (p_FAST%WrVTK_Type==2) then ! only if not doing surfaces + if (DVR_Outs%WrVTK_Type==2) then ! only if not doing surfaces ! Base - call MeshWrVTK_PointSurface (p_FAST%VTKRefPoint, y_ED%PlatformPtMesh, trim(p_FAST%VTK_OutFileRoot)//trim(sWT)//'.BaseSurface', & - VTK_count, OutputFields, errStat2, errMsg2, p_FAST%VTK_tWidth , verts = p_FAST%VTK_Surface(iWT)%BaseBox) + call MeshWrVTK_PointSurface (DVR_Outs%VTKRefPoint, y_ED%PlatformPtMesh, trim(DVR_Outs%VTK_OutFileRoot)//trim(sWT)//'.BaseSurface', & + VTK_count, OutputFields, errStat2, errMsg2, DVR_Outs%VTK_tWidth , verts = DVR_Outs%VTK_Surface(iWT)%BaseBox) endif if (y_ED%numBlades>0) then ! Nacelle - call MeshWrVTK( p_FAST%VTKRefPoint, y_ED%NacelleMotion, trim(p_FAST%VTK_OutFileRoot)//trim(sWT)//'.Nacelle', & - VTK_count, OutputFields, errStat2, errMsg2, p_FAST%VTK_tWidth ) + call MeshWrVTK( DVR_Outs%VTKRefPoint, y_ED%NacelleMotion, trim(DVR_Outs%VTK_OutFileRoot)//trim(sWT)//'.Nacelle', & + VTK_count, OutputFields, errStat2, errMsg2, DVR_Outs%VTK_tWidth ) endif - if (p_FAST%WrVTK>1) then + if (DVR_Outs%WrVTK>1) then ! --- animations ! Tower base - call MeshWrVTK(p_FAST%VTKRefPoint, y_ED%TwrPtMesh, trim(p_FAST%VTK_OutFileRoot)//trim(sWT)//'.TwrBase', & - VTK_count, OutputFields, errStat2, errMsg2, p_FAST%VTK_tWidth ) + call MeshWrVTK(DVR_Outs%VTKRefPoint, y_ED%TwrPtMesh, trim(DVR_Outs%VTK_OutFileRoot)//trim(sWT)//'.TwrBase', & + VTK_count, OutputFields, errStat2, errMsg2, DVR_Outs%VTK_tWidth ) if (ADI%u(2)%AD%rotors(iWT)%TowerMotion%nNodes>0) then - call MeshWrVTK(p_FAST%VTKRefPoint, y_ED%TwrPtMeshAD, trim(p_FAST%VTK_OutFileRoot)//trim(sWT)//'.TwrBaseAD', & - VTK_count, OutputFields, errStat2, errMsg2, p_FAST%VTK_tWidth ) + call MeshWrVTK(DVR_Outs%VTKRefPoint, y_ED%TwrPtMeshAD, trim(DVR_Outs%VTK_OutFileRoot)//trim(sWT)//'.TwrBaseAD', & + VTK_count, OutputFields, errStat2, errMsg2, DVR_Outs%VTK_tWidth ) endif endif enddo ! Free wake (only write this here if doing line meshes only -- FVW is written with surface outputs) - if (allocated(ADI%m%AD%FVW_u) .and. p_FAST%WrVTK_Type==2) then + if (allocated(ADI%m%AD%FVW_u) .and. DVR_Outs%WrVTK_Type==2) then if (allocated(ADI%m%AD%FVW_u(1)%WingsMesh)) then - call WrVTK_FVW(ADI%p%AD%FVW, ADI%x(1)%AD%FVW, ADI%z(1)%AD%FVW, ADI%m%AD%FVW, trim(p_FAST%VTK_OutFileRoot)//'.FVW', VTK_count, p_FAST%VTK_tWidth, bladeFrame=.FALSE.) ! bladeFrame==.FALSE. to output in global coords + call WrVTK_FVW(ADI%p%AD%FVW, ADI%x(1)%AD%FVW, ADI%z(1)%AD%FVW, ADI%m%AD%FVW, trim(DVR_Outs%VTK_OutFileRoot)//'.FVW', VTK_count, DVR_Outs%VTK_tWidth, bladeFrame=.FALSE.) ! bladeFrame==.FALSE. to output in global coords end if end if end subroutine WrVTK_Lines @@ -2227,6 +2115,7 @@ subroutine userHubMotion(nt, iWT, dvr, ADI, FED, arr, azimuth, rotSpeed, rotAcc, alphaTq = min(max(alphaTq, 0._ReKi), 1.0_ReKi) ! Bounding value ! --- Rotor torque + !bjj: note: WriteOutput isn't always computed when AD_CalcOutput is called (though it appears to be okay in AeroDyn_Inflow.f90); be careful that AllOuts( RtAeroMxh ) is up to date. rotTorque = ADI%m%AD%rotors(iWT)%AllOuts( RtAeroMxh ) ! Optional filtering of input torque rotTorque_filt = ( 1.0 - alphaTq )*rotTorque + alphaTq*rotTorque_filt_prev diff --git a/modules/aerodyn/src/AeroDyn_Driver_Types.f90 b/modules/aerodyn/src/AeroDyn_Driver_Types.f90 index cb59d0248f..f1122aded8 100644 --- a/modules/aerodyn/src/AeroDyn_Driver_Types.f90 +++ b/modules/aerodyn/src/AeroDyn_Driver_Types.f90 @@ -31,109 +31,111 @@ !! unpack routines associated with each defined data type. This code is automatically generated by the FAST Registry. MODULE AeroDyn_Driver_Types !--------------------------------------------------------------------------------------------------------------------------------- +USE AeroDyn_Types USE AeroDyn_Inflow_Types USE NWTC_Library IMPLICIT NONE ! ========= Dvr_Case ======= TYPE, PUBLIC :: Dvr_Case - REAL(ReKi) :: HWindSpeed !< Hub wind speed [m/s] - REAL(ReKi) :: PLExp !< Power law wind-shear exponent [-] - REAL(ReKi) :: rotSpeed !< Rotor speed [rad/s] - REAL(ReKi) :: bldPitch !< Pitch angle [rad] - REAL(ReKi) :: nacYaw !< Yaw angle [rad] - REAL(DbKi) :: tMax !< Max time [s] - REAL(DbKi) :: dT !< time increment [s] - INTEGER(IntKi) :: numSteps !< number of steps in this case [-] - INTEGER(IntKi) :: DOF !< Degree of freedom for sinusoidal motion [-] - REAL(ReKi) :: amplitude !< Amplitude for sinusoidal motion (when DOF>0) [-] - REAL(ReKi) :: frequency !< Frequency for sinusoidal motion (when DOF>0) [-] + REAL(ReKi) :: HWindSpeed = 0.0_ReKi !< Hub wind speed [m/s] + REAL(ReKi) :: PLExp = 0.0_ReKi !< Power law wind-shear exponent [-] + REAL(ReKi) :: rotSpeed = 0.0_ReKi !< Rotor speed [rad/s] + REAL(ReKi) :: bldPitch = 0.0_ReKi !< Pitch angle [rad] + REAL(ReKi) :: nacYaw = 0.0_ReKi !< Yaw angle [rad] + REAL(DbKi) :: tMax = 0.0_R8Ki !< Max time [s] + REAL(DbKi) :: dT = 0.0_R8Ki !< time increment [s] + INTEGER(IntKi) :: numSteps = 0_IntKi !< number of steps in this case [-] + INTEGER(IntKi) :: DOF = 0_IntKi !< Degree of freedom for sinusoidal motion [-] + REAL(ReKi) :: amplitude = 0.0_ReKi !< Amplitude for sinusoidal motion (when DOF>0) [-] + REAL(ReKi) :: frequency = 0.0_ReKi !< Frequency for sinusoidal motion (when DOF>0) [-] END TYPE Dvr_Case ! ======================= ! ========= DvrVTK_SurfaceType ======= TYPE, PUBLIC :: DvrVTK_SurfaceType - INTEGER(IntKi) :: NumSectors !< number of sectors in which to split circles (higher number gives smoother surface) [-] - REAL(SiKi) , DIMENSION(1:3,1:8) :: NacelleBox !< X-Y-Z locations of 8 points that define the nacelle box, relative to the nacelle position [m] - REAL(SiKi) , DIMENSION(1:3,1:8) :: BaseBox !< X-Y-Z locations of 8 points that define the base box [m] + INTEGER(IntKi) :: NumSectors = 0_IntKi !< number of sectors in which to split circles (higher number gives smoother surface) [-] + REAL(SiKi) , DIMENSION(1:3,1:8) :: NacelleBox = 0.0_R4Ki !< X-Y-Z locations of 8 points that define the nacelle box, relative to the nacelle position [m] + REAL(SiKi) , DIMENSION(1:3,1:8) :: BaseBox = 0.0_R4Ki !< X-Y-Z locations of 8 points that define the base box [m] END TYPE DvrVTK_SurfaceType ! ======================= ! ========= Dvr_Outputs ======= TYPE, PUBLIC :: Dvr_Outputs TYPE(ProgDesc) :: AD_ver !< AeroDyn version information [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: unOutFile !< unit number for writing output file for each rotor [-] - INTEGER(IntKi) :: ActualChanLen !< Actual length of channels written to text file (less than or equal to ChanLen) [-] - INTEGER(IntKi) :: nDvrOutputs !< Number of outputs for the driver (without AD and IW) [-] + INTEGER(IntKi) :: ActualChanLen = 0_IntKi !< Actual length of channels written to text file (less than or equal to ChanLen) [-] + INTEGER(IntKi) :: nDvrOutputs = 0_IntKi !< Number of outputs for the driver (without AD and IW) [-] character(20) :: Fmt_t !< Format specifier for time channel [-] character(25) :: Fmt_a !< Format specifier for each column (including delimiter) [-] character(1) :: delim !< column delimiter [-] character(20) :: outFmt !< Format specifier [-] - INTEGER(IntKi) :: fileFmt !< Output format 1=Text, 2=Binary, 3=Both [-] - INTEGER(IntKi) :: wrVTK !< 0= no vtk, 1=init only, 2=animation [-] - INTEGER(IntKi) :: WrVTK_Type !< Flag for VTK output type (1=surface, 2=line, 3=both) [-] + INTEGER(IntKi) :: fileFmt = 0_IntKi !< Output format 1=Text, 2=Binary, 3=Both [-] + INTEGER(IntKi) :: WrVTK = 0_IntKi !< 0= no vtk, 1=init only, 2=animation [-] + INTEGER(IntKi) :: WrVTK_Type = 0_IntKi !< Flag for VTK output type (1=surface, 2=line, 3=both) [-] character(1024) :: Root !< Output file rootname [-] - character(1024) :: VTK_OutFileRoot !< Output file rootname for vtk [-] + character(1024) :: VTK_OutFileRoot !< Output file rootname for vtk (includes directory) [-] character(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputHdr !< Channel headers [-] character(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputUnt !< Channel units [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: storage !< nTurbines x nChannel x nTime [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: outLine !< Output line to be written to disk [-] TYPE(DvrVTK_SurfaceType) , DIMENSION(:), ALLOCATABLE :: VTK_surface !< Data for VTK surface visualization [-] - INTEGER(IntKi) :: VTK_tWidth !< Width of number of files for leading zeros in file name format [-] - INTEGER(IntKi) :: n_VTKTime !< Number of time steps between writing VTK files [-] - REAL(SiKi) :: VTKHubRad !< Hub radius for visualization [m] - REAL(ReKi) , DIMENSION(1:6) :: VTKNacDim !< Nacelle dimensions for visualization [m] - REAL(SiKi) , DIMENSION(1:3) :: VTKRefPoint !< RefPoint for VTK outputs [-] - REAL(DbKi) :: DT_Outs !< Output time resolution [s] - INTEGER(IntKi) :: n_DT_Out !< Number of time steps between writing a line in the time-marching output files [-] + INTEGER(IntKi) :: VTK_tWidth = 0_IntKi !< Width of number of files for leading zeros in file name format [-] + INTEGER(IntKi) :: n_VTKTime = 0_IntKi !< Number of time steps between writing VTK files [-] + REAL(DbKi) :: VTK_DT = 0.0_R8Ki !< Write VTK time step [-] + REAL(SiKi) :: VTKHubRad = 0.0_R4Ki !< Hub radius for visualization [m] + REAL(ReKi) , DIMENSION(1:6) :: VTKNacDim = 0.0_ReKi !< Nacelle dimensions for visualization [m] + REAL(SiKi) , DIMENSION(1:3) :: VTKRefPoint = 0.0_R4Ki !< RefPoint for VTK outputs [-] + REAL(DbKi) :: DT_Outs = 0.0_R8Ki !< Output time resolution [s] + INTEGER(IntKi) :: n_DT_Out = 0_IntKi !< Number of time steps between writing a line in the time-marching output files [-] END TYPE Dvr_Outputs ! ======================= ! ========= BladeData ======= TYPE, PUBLIC :: BladeData - REAL(ReKi) :: pitch !< rad [-] - REAL(ReKi) :: pitchSpeed !< rad/s [-] - REAL(ReKi) :: pitchAcc !< rad/s/s [-] - REAL(ReKi) , DIMENSION(1:3) :: origin_h !< [-] - REAL(ReKi) , DIMENSION(1:3) :: orientation_h !< [-] - REAL(ReKi) :: hubRad_bl !< [-] - REAL(DbKi) , DIMENSION(1:3,1:3) :: Rh2bl0 !< Rotation matrix blade 2 hub [-] - INTEGER(IntKi) :: motionType !< [-] - INTEGER(IntKi) :: iMotion !< Stored index to optimize time interpolation [-] + REAL(ReKi) :: pitch = 0.0_ReKi !< rad [-] + REAL(ReKi) :: pitchSpeed = 0.0_ReKi !< rad/s [-] + REAL(ReKi) :: pitchAcc = 0.0_ReKi !< rad/s/s [-] + REAL(ReKi) , DIMENSION(1:3) :: origin_h = 0.0_ReKi !< [-] + REAL(ReKi) , DIMENSION(1:3) :: orientation_h = 0.0_ReKi !< [-] + REAL(ReKi) :: hubRad_bl = 0.0_ReKi !< [-] + REAL(DbKi) , DIMENSION(1:3,1:3) :: Rh2bl0 = 0.0_R8Ki !< Rotation matrix blade 2 hub [-] + INTEGER(IntKi) :: motionType = 0_IntKi !< [-] + INTEGER(IntKi) :: iMotion = 0_IntKi !< Stored index to optimize time interpolation [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: motion !< [-] character(1024) :: motionFileName !< [-] END TYPE BladeData ! ======================= ! ========= HubData ======= TYPE, PUBLIC :: HubData - REAL(ReKi) , DIMENSION(1:3) :: origin_n !< [-] - REAL(ReKi) , DIMENSION(1:3) :: orientation_n !< [-] - INTEGER(IntKi) :: motionType !< [-] - INTEGER(IntKi) :: iMotion !< Stored index to optimize time interpolation [-] - REAL(ReKi) :: azimuth !< rotor position [rad] - REAL(ReKi) :: rotSpeed !< rotor speed [rad/s] - REAL(ReKi) :: rotAcc !< rotor acceleration [rad/s/s] + REAL(ReKi) , DIMENSION(1:3) :: origin_n = 0.0_ReKi !< [-] + REAL(ReKi) , DIMENSION(1:3) :: orientation_n = 0.0_ReKi !< [-] + INTEGER(IntKi) :: motionType = 0_IntKi !< [-] + INTEGER(IntKi) :: iMotion = 0_IntKi !< Stored index to optimize time interpolation [-] + REAL(ReKi) :: azimuth = 0.0_ReKi !< rotor position [rad] + REAL(ReKi) :: rotSpeed = 0.0_ReKi !< rotor speed [rad/s] + REAL(ReKi) :: rotAcc = 0.0_ReKi !< rotor acceleration [rad/s/s] character(1024) :: motionFileName !< [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: motion !< [-] END TYPE HubData ! ======================= ! ========= NacData ======= TYPE, PUBLIC :: NacData - REAL(ReKi) , DIMENSION(1:3) :: origin_t !< [-] - INTEGER(IntKi) :: motionType !< [-] - INTEGER(IntKi) :: iMotion !< Stored index to optimize time interpolation [-] - REAL(ReKi) :: yaw !< rad [rad] - REAL(ReKi) :: yawSpeed !< yawspeed [rad/s] - REAL(ReKi) :: yawAcc !< yawAcceleration [rad/s^2] + REAL(ReKi) , DIMENSION(1:3) :: origin_t = 0.0_ReKi !< [-] + INTEGER(IntKi) :: motionType = 0_IntKi !< [-] + INTEGER(IntKi) :: iMotion = 0_IntKi !< Stored index to optimize time interpolation [-] + REAL(ReKi) :: yaw = 0.0_ReKi !< rad [rad] + REAL(ReKi) :: yawSpeed = 0.0_ReKi !< yawspeed [rad/s] + REAL(ReKi) :: yawAcc = 0.0_ReKi !< yawAcceleration [rad/s^2] character(1024) :: motionFileName !< [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: motion !< [-] END TYPE NacData ! ======================= ! ========= TwrData ======= TYPE, PUBLIC :: TwrData - REAL(ReKi) , DIMENSION(1:3) :: origin_t !< [-] + REAL(ReKi) , DIMENSION(1:3) :: origin_t = 0.0_ReKi !< [-] END TYPE TwrData ! ======================= ! ========= WTData ======= TYPE, PUBLIC :: WTData - REAL(ReKi) , DIMENSION(1:3) :: originInit !< [-] - REAL(ReKi) , DIMENSION(1:3) :: orientationInit !< [-] + REAL(ReKi) , DIMENSION(1:3) :: originInit = 0.0_ReKi !< [-] + REAL(ReKi) , DIMENSION(1:3) :: orientationInit = 0.0_ReKi !< [-] TYPE(MeshMapType) :: map2twrPt !< Mesh mapping from base to tower [-] TYPE(MeshMapType) :: map2nacPt !< Mesh mapping from base to nacelle [-] TYPE(MeshMapType) :: map2hubPt !< Mesh mapping from Nacelle to hub [-] @@ -142,18 +144,18 @@ MODULE AeroDyn_Driver_Types TYPE(HubData) :: hub !< [-] TYPE(NacData) :: nac !< [-] TYPE(TwrData) :: twr !< [-] - INTEGER(IntKi) :: numBlades !< [-] - LOGICAL :: basicHAWTFormat !< If true simply input HubRad/Pitch/Overhang/Cone, otherwise all turbine inputs [-] - LOGICAL :: hasTower !< [-] - INTEGER(IntKi) :: projMod !< If true simply input HubRad/Pitch/Overhang/Cone, otherwise all turbine inputs [-] - INTEGER(IntKi) :: BEM_Mod !< Switch for different BEM implementations [-] - LOGICAL :: HAWTprojection !< [-] - INTEGER(IntKi) :: motionType !< [-] + INTEGER(IntKi) :: numBlades = 0_IntKi !< [-] + LOGICAL :: basicHAWTFormat = .false. !< If true simply input HubRad/Pitch/Overhang/Cone, otherwise all turbine inputs [-] + LOGICAL :: hasTower = .false. !< [-] + INTEGER(IntKi) :: projMod = 0_IntKi !< If true simply input HubRad/Pitch/Overhang/Cone, otherwise all turbine inputs [-] + INTEGER(IntKi) :: BEM_Mod = 0_IntKi !< Switch for different BEM implementations [-] + LOGICAL :: HAWTprojection = .false. !< [-] + INTEGER(IntKi) :: motionType = 0_IntKi !< [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: motion !< [-] - INTEGER(IntKi) :: iMotion !< Stored index to optimize time interpolation [-] - INTEGER(IntKi) :: degreeOfFreedom !< [-] - REAL(ReKi) :: amplitude !< [-] - REAL(ReKi) :: frequency !< [-] + INTEGER(IntKi) :: iMotion = 0_IntKi !< Stored index to optimize time interpolation [-] + INTEGER(IntKi) :: degreeOfFreedom = 0_IntKi !< [-] + REAL(ReKi) :: amplitude = 0.0_ReKi !< [-] + REAL(ReKi) :: frequency = 0.0_ReKi !< [-] character(1024) :: motionFileName !< [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: WriteOutput !< WriteOutputs of the driver only [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: userSwapArray !< Array to store user data for user-defined functions [-] @@ -162,25 +164,25 @@ MODULE AeroDyn_Driver_Types ! ========= Dvr_SimData ======= TYPE, PUBLIC :: Dvr_SimData character(1024) :: AD_InputFile !< Name of AeroDyn input file [-] - INTEGER(IntKi) :: MHK !< MHK turbine type (switch) {0: not an MHK turbine, 1: fixed MHK turbine, 2: floating MHK turbine} [-] - INTEGER(IntKi) :: AnalysisType !< 0=Steady Wind, 1=InflowWind [-] - REAL(ReKi) :: FldDens !< Density of working fluid [kg/m^3] - REAL(ReKi) :: KinVisc !< Kinematic viscosity of working fluid [m^2/s] - REAL(ReKi) :: SpdSound !< Speed of sound in working fluid [m/s] - REAL(ReKi) :: Patm !< Atmospheric pressure [Pa] - REAL(ReKi) :: Pvap !< Vapour pressure of working fluid [Pa] - REAL(ReKi) :: WtrDpth !< Water depth [m] - REAL(ReKi) :: MSL2SWL !< Offset between still-water level and mean sea level [m] - INTEGER(IntKi) :: numTurbines !< number of blades on turbine [-] + INTEGER(IntKi) :: MHK = 0_IntKi !< MHK turbine type (switch) {0: not an MHK turbine, 1: fixed MHK turbine, 2: floating MHK turbine} [-] + INTEGER(IntKi) :: AnalysisType = 0_IntKi !< 0=Steady Wind, 1=InflowWind [-] + REAL(ReKi) :: FldDens = 0.0_ReKi !< Density of working fluid [kg/m^3] + REAL(ReKi) :: KinVisc = 0.0_ReKi !< Kinematic viscosity of working fluid [m^2/s] + REAL(ReKi) :: SpdSound = 0.0_ReKi !< Speed of sound in working fluid [m/s] + REAL(ReKi) :: Patm = 0.0_ReKi !< Atmospheric pressure [Pa] + REAL(ReKi) :: Pvap = 0.0_ReKi !< Vapour pressure of working fluid [Pa] + REAL(ReKi) :: WtrDpth = 0.0_ReKi !< Water depth [m] + REAL(ReKi) :: MSL2SWL = 0.0_ReKi !< Offset between still-water level and mean sea level [m] + INTEGER(IntKi) :: numTurbines = -9999 !< number of turbine rotors [-] TYPE(WTData) , DIMENSION(:), ALLOCATABLE :: WT !< Wind turbine data for driver [-] - REAL(DbKi) :: dT !< time increment [s] - REAL(DbKi) :: tMax !< time increment [s] - INTEGER(IntKi) :: numSteps !< number of steps in this case [-] - INTEGER(IntKi) :: numCases !< number of steps in this case [-] + REAL(DbKi) :: dT = 0.0_R8Ki !< time increment [s] + REAL(DbKi) :: tMax = 0.0_R8Ki !< time increment [s] + INTEGER(IntKi) :: numSteps = 0_IntKi !< number of steps in this case [-] + INTEGER(IntKi) :: numCases = 0_IntKi !< number of steps in this case [-] TYPE(Dvr_Case) , DIMENSION(:), ALLOCATABLE :: Cases !< table of cases to run when AnalysisType=2 [-] - INTEGER(IntKi) :: iCase !< Current Case being run [-] + INTEGER(IntKi) :: iCase = 0_IntKi !< Current Case being run [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: timeSeries !< Times series inputs when AnalysisType=1, 6 columns, Time, WndSpeed, ShearExp, RotSpd, Pitch, Yaw [-] - INTEGER(IntKi) :: iTimeSeries !< Stored index to optimize time interpolation [-] + INTEGER(IntKi) :: iTimeSeries = 0_IntKi !< Stored index to optimize time interpolation [-] character(1024) :: root !< Output file rootname [-] TYPE(Dvr_Outputs) :: out !< data for driver output file [-] TYPE(ADI_IW_InputData) :: IW_InitInp !< [-] @@ -191,4592 +193,1227 @@ MODULE AeroDyn_Driver_Types TYPE(Dvr_SimData) :: dvr !< Driver data [-] TYPE(ADI_Data) :: ADI !< AeroDyn InflowWind Data [-] TYPE(FED_Data) :: FED !< Elastic wind turbine data (Fake ElastoDyn) [-] - INTEGER(IntKi) :: errStat !< [-] + INTEGER(IntKi) :: errStat = 0_IntKi !< [-] character(ErrMsgLen) :: errMsg !< [-] - LOGICAL :: initialized !< [-] + LOGICAL :: initialized = .false. !< [-] END TYPE AllData ! ======================= CONTAINS - SUBROUTINE AD_Dvr_CopyDvr_Case( SrcDvr_CaseData, DstDvr_CaseData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Dvr_Case), INTENT(IN) :: SrcDvr_CaseData - TYPE(Dvr_Case), INTENT(INOUT) :: DstDvr_CaseData - 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 = 'AD_Dvr_CopyDvr_Case' -! - ErrStat = ErrID_None - ErrMsg = "" - DstDvr_CaseData%HWindSpeed = SrcDvr_CaseData%HWindSpeed - DstDvr_CaseData%PLExp = SrcDvr_CaseData%PLExp - DstDvr_CaseData%rotSpeed = SrcDvr_CaseData%rotSpeed - DstDvr_CaseData%bldPitch = SrcDvr_CaseData%bldPitch - DstDvr_CaseData%nacYaw = SrcDvr_CaseData%nacYaw - DstDvr_CaseData%tMax = SrcDvr_CaseData%tMax - DstDvr_CaseData%dT = SrcDvr_CaseData%dT - DstDvr_CaseData%numSteps = SrcDvr_CaseData%numSteps - DstDvr_CaseData%DOF = SrcDvr_CaseData%DOF - DstDvr_CaseData%amplitude = SrcDvr_CaseData%amplitude - DstDvr_CaseData%frequency = SrcDvr_CaseData%frequency - END SUBROUTINE AD_Dvr_CopyDvr_Case - - SUBROUTINE AD_Dvr_DestroyDvr_Case( Dvr_CaseData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(Dvr_Case), INTENT(INOUT) :: Dvr_CaseData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_DestroyDvr_Case' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE AD_Dvr_DestroyDvr_Case - - SUBROUTINE AD_Dvr_PackDvr_Case( 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(Dvr_Case), 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 = 'AD_Dvr_PackDvr_Case' - ! 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 ! HWindSpeed - Re_BufSz = Re_BufSz + 1 ! PLExp - Re_BufSz = Re_BufSz + 1 ! rotSpeed - Re_BufSz = Re_BufSz + 1 ! bldPitch - Re_BufSz = Re_BufSz + 1 ! nacYaw - Db_BufSz = Db_BufSz + 1 ! tMax - Db_BufSz = Db_BufSz + 1 ! dT - Int_BufSz = Int_BufSz + 1 ! numSteps - Int_BufSz = Int_BufSz + 1 ! DOF - Re_BufSz = Re_BufSz + 1 ! amplitude - Re_BufSz = Re_BufSz + 1 ! frequency - 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%HWindSpeed - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PLExp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%rotSpeed - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%bldPitch - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%nacYaw - Re_Xferred = Re_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%tMax - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%dT - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%numSteps - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%DOF - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%amplitude - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%frequency - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AD_Dvr_PackDvr_Case - - SUBROUTINE AD_Dvr_UnPackDvr_Case( 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(Dvr_Case), 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 = 'AD_Dvr_UnPackDvr_Case' - ! 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%HWindSpeed = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PLExp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%rotSpeed = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%bldPitch = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%nacYaw = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%tMax = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%dT = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%numSteps = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%DOF = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%amplitude = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%frequency = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AD_Dvr_UnPackDvr_Case - - SUBROUTINE AD_Dvr_CopyDvrVTK_SurfaceType( SrcDvrVTK_SurfaceTypeData, DstDvrVTK_SurfaceTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(DvrVTK_SurfaceType), INTENT(IN) :: SrcDvrVTK_SurfaceTypeData - TYPE(DvrVTK_SurfaceType), INTENT(INOUT) :: DstDvrVTK_SurfaceTypeData - 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 = 'AD_Dvr_CopyDvrVTK_SurfaceType' -! +subroutine AD_Dvr_CopyDvr_Case(SrcDvr_CaseData, DstDvr_CaseData, CtrlCode, ErrStat, ErrMsg) + type(Dvr_Case), intent(in) :: SrcDvr_CaseData + type(Dvr_Case), intent(inout) :: DstDvr_CaseData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD_Dvr_CopyDvr_Case' ErrStat = ErrID_None - ErrMsg = "" - DstDvrVTK_SurfaceTypeData%NumSectors = SrcDvrVTK_SurfaceTypeData%NumSectors - DstDvrVTK_SurfaceTypeData%NacelleBox = SrcDvrVTK_SurfaceTypeData%NacelleBox - DstDvrVTK_SurfaceTypeData%BaseBox = SrcDvrVTK_SurfaceTypeData%BaseBox - END SUBROUTINE AD_Dvr_CopyDvrVTK_SurfaceType - - SUBROUTINE AD_Dvr_DestroyDvrVTK_SurfaceType( DvrVTK_SurfaceTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(DvrVTK_SurfaceType), INTENT(INOUT) :: DvrVTK_SurfaceTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_DestroyDvrVTK_SurfaceType' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE AD_Dvr_DestroyDvrVTK_SurfaceType - - SUBROUTINE AD_Dvr_PackDvrVTK_SurfaceType( 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(DvrVTK_SurfaceType), 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 = 'AD_Dvr_PackDvrVTK_SurfaceType' - ! 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 ! NumSectors - Re_BufSz = Re_BufSz + SIZE(InData%NacelleBox) ! NacelleBox - Re_BufSz = Re_BufSz + SIZE(InData%BaseBox) ! BaseBox - 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%NumSectors - Int_Xferred = Int_Xferred + 1 - DO i2 = LBOUND(InData%NacelleBox,2), UBOUND(InData%NacelleBox,2) - DO i1 = LBOUND(InData%NacelleBox,1), UBOUND(InData%NacelleBox,1) - ReKiBuf(Re_Xferred) = InData%NacelleBox(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - DO i2 = LBOUND(InData%BaseBox,2), UBOUND(InData%BaseBox,2) - DO i1 = LBOUND(InData%BaseBox,1), UBOUND(InData%BaseBox,1) - ReKiBuf(Re_Xferred) = InData%BaseBox(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END SUBROUTINE AD_Dvr_PackDvrVTK_SurfaceType - - SUBROUTINE AD_Dvr_UnPackDvrVTK_SurfaceType( 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(DvrVTK_SurfaceType), 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 = 'AD_Dvr_UnPackDvrVTK_SurfaceType' - ! 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%NumSectors = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%NacelleBox,1) - i1_u = UBOUND(OutData%NacelleBox,1) - i2_l = LBOUND(OutData%NacelleBox,2) - i2_u = UBOUND(OutData%NacelleBox,2) - DO i2 = LBOUND(OutData%NacelleBox,2), UBOUND(OutData%NacelleBox,2) - DO i1 = LBOUND(OutData%NacelleBox,1), UBOUND(OutData%NacelleBox,1) - OutData%NacelleBox(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%BaseBox,1) - i1_u = UBOUND(OutData%BaseBox,1) - i2_l = LBOUND(OutData%BaseBox,2) - i2_u = UBOUND(OutData%BaseBox,2) - DO i2 = LBOUND(OutData%BaseBox,2), UBOUND(OutData%BaseBox,2) - DO i1 = LBOUND(OutData%BaseBox,1), UBOUND(OutData%BaseBox,1) - OutData%BaseBox(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END SUBROUTINE AD_Dvr_UnPackDvrVTK_SurfaceType - - SUBROUTINE AD_Dvr_CopyDvr_Outputs( SrcDvr_OutputsData, DstDvr_OutputsData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Dvr_Outputs), INTENT(IN) :: SrcDvr_OutputsData - TYPE(Dvr_Outputs), INTENT(INOUT) :: DstDvr_OutputsData - 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 = 'AD_Dvr_CopyDvr_Outputs' -! + ErrMsg = '' + DstDvr_CaseData%HWindSpeed = SrcDvr_CaseData%HWindSpeed + DstDvr_CaseData%PLExp = SrcDvr_CaseData%PLExp + DstDvr_CaseData%rotSpeed = SrcDvr_CaseData%rotSpeed + DstDvr_CaseData%bldPitch = SrcDvr_CaseData%bldPitch + DstDvr_CaseData%nacYaw = SrcDvr_CaseData%nacYaw + DstDvr_CaseData%tMax = SrcDvr_CaseData%tMax + DstDvr_CaseData%dT = SrcDvr_CaseData%dT + DstDvr_CaseData%numSteps = SrcDvr_CaseData%numSteps + DstDvr_CaseData%DOF = SrcDvr_CaseData%DOF + DstDvr_CaseData%amplitude = SrcDvr_CaseData%amplitude + DstDvr_CaseData%frequency = SrcDvr_CaseData%frequency +end subroutine + +subroutine AD_Dvr_DestroyDvr_Case(Dvr_CaseData, ErrStat, ErrMsg) + type(Dvr_Case), intent(inout) :: Dvr_CaseData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD_Dvr_DestroyDvr_Case' ErrStat = ErrID_None - ErrMsg = "" - CALL NWTC_Library_Copyprogdesc( SrcDvr_OutputsData%AD_ver, DstDvr_OutputsData%AD_ver, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcDvr_OutputsData%unOutFile)) THEN - i1_l = LBOUND(SrcDvr_OutputsData%unOutFile,1) - i1_u = UBOUND(SrcDvr_OutputsData%unOutFile,1) - IF (.NOT. ALLOCATED(DstDvr_OutputsData%unOutFile)) THEN - ALLOCATE(DstDvr_OutputsData%unOutFile(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDvr_OutputsData%unOutFile.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDvr_OutputsData%unOutFile = SrcDvr_OutputsData%unOutFile -ENDIF - DstDvr_OutputsData%ActualChanLen = SrcDvr_OutputsData%ActualChanLen - DstDvr_OutputsData%nDvrOutputs = SrcDvr_OutputsData%nDvrOutputs - DstDvr_OutputsData%Fmt_t = SrcDvr_OutputsData%Fmt_t - DstDvr_OutputsData%Fmt_a = SrcDvr_OutputsData%Fmt_a - DstDvr_OutputsData%delim = SrcDvr_OutputsData%delim - DstDvr_OutputsData%outFmt = SrcDvr_OutputsData%outFmt - DstDvr_OutputsData%fileFmt = SrcDvr_OutputsData%fileFmt - DstDvr_OutputsData%wrVTK = SrcDvr_OutputsData%wrVTK - DstDvr_OutputsData%WrVTK_Type = SrcDvr_OutputsData%WrVTK_Type - DstDvr_OutputsData%Root = SrcDvr_OutputsData%Root - DstDvr_OutputsData%VTK_OutFileRoot = SrcDvr_OutputsData%VTK_OutFileRoot -IF (ALLOCATED(SrcDvr_OutputsData%WriteOutputHdr)) THEN - i1_l = LBOUND(SrcDvr_OutputsData%WriteOutputHdr,1) - i1_u = UBOUND(SrcDvr_OutputsData%WriteOutputHdr,1) - IF (.NOT. ALLOCATED(DstDvr_OutputsData%WriteOutputHdr)) THEN - ALLOCATE(DstDvr_OutputsData%WriteOutputHdr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDvr_OutputsData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDvr_OutputsData%WriteOutputHdr = SrcDvr_OutputsData%WriteOutputHdr -ENDIF -IF (ALLOCATED(SrcDvr_OutputsData%WriteOutputUnt)) THEN - i1_l = LBOUND(SrcDvr_OutputsData%WriteOutputUnt,1) - i1_u = UBOUND(SrcDvr_OutputsData%WriteOutputUnt,1) - IF (.NOT. ALLOCATED(DstDvr_OutputsData%WriteOutputUnt)) THEN - ALLOCATE(DstDvr_OutputsData%WriteOutputUnt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDvr_OutputsData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDvr_OutputsData%WriteOutputUnt = SrcDvr_OutputsData%WriteOutputUnt -ENDIF -IF (ALLOCATED(SrcDvr_OutputsData%storage)) THEN - i1_l = LBOUND(SrcDvr_OutputsData%storage,1) - i1_u = UBOUND(SrcDvr_OutputsData%storage,1) - i2_l = LBOUND(SrcDvr_OutputsData%storage,2) - i2_u = UBOUND(SrcDvr_OutputsData%storage,2) - i3_l = LBOUND(SrcDvr_OutputsData%storage,3) - i3_u = UBOUND(SrcDvr_OutputsData%storage,3) - IF (.NOT. ALLOCATED(DstDvr_OutputsData%storage)) THEN - ALLOCATE(DstDvr_OutputsData%storage(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDvr_OutputsData%storage.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDvr_OutputsData%storage = SrcDvr_OutputsData%storage -ENDIF -IF (ALLOCATED(SrcDvr_OutputsData%outLine)) THEN - i1_l = LBOUND(SrcDvr_OutputsData%outLine,1) - i1_u = UBOUND(SrcDvr_OutputsData%outLine,1) - IF (.NOT. ALLOCATED(DstDvr_OutputsData%outLine)) THEN - ALLOCATE(DstDvr_OutputsData%outLine(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDvr_OutputsData%outLine.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDvr_OutputsData%outLine = SrcDvr_OutputsData%outLine -ENDIF -IF (ALLOCATED(SrcDvr_OutputsData%VTK_surface)) THEN - i1_l = LBOUND(SrcDvr_OutputsData%VTK_surface,1) - i1_u = UBOUND(SrcDvr_OutputsData%VTK_surface,1) - IF (.NOT. ALLOCATED(DstDvr_OutputsData%VTK_surface)) THEN - ALLOCATE(DstDvr_OutputsData%VTK_surface(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDvr_OutputsData%VTK_surface.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcDvr_OutputsData%VTK_surface,1), UBOUND(SrcDvr_OutputsData%VTK_surface,1) - CALL AD_Dvr_Copydvrvtk_surfacetype( SrcDvr_OutputsData%VTK_surface(i1), DstDvr_OutputsData%VTK_surface(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - DstDvr_OutputsData%VTK_tWidth = SrcDvr_OutputsData%VTK_tWidth - DstDvr_OutputsData%n_VTKTime = SrcDvr_OutputsData%n_VTKTime - DstDvr_OutputsData%VTKHubRad = SrcDvr_OutputsData%VTKHubRad - DstDvr_OutputsData%VTKNacDim = SrcDvr_OutputsData%VTKNacDim - DstDvr_OutputsData%VTKRefPoint = SrcDvr_OutputsData%VTKRefPoint - DstDvr_OutputsData%DT_Outs = SrcDvr_OutputsData%DT_Outs - DstDvr_OutputsData%n_DT_Out = SrcDvr_OutputsData%n_DT_Out - END SUBROUTINE AD_Dvr_CopyDvr_Outputs - - SUBROUTINE AD_Dvr_DestroyDvr_Outputs( Dvr_OutputsData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(Dvr_Outputs), INTENT(INOUT) :: Dvr_OutputsData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_DestroyDvr_Outputs' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL NWTC_Library_Destroyprogdesc( Dvr_OutputsData%AD_ver, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(Dvr_OutputsData%unOutFile)) THEN - DEALLOCATE(Dvr_OutputsData%unOutFile) -ENDIF -IF (ALLOCATED(Dvr_OutputsData%WriteOutputHdr)) THEN - DEALLOCATE(Dvr_OutputsData%WriteOutputHdr) -ENDIF -IF (ALLOCATED(Dvr_OutputsData%WriteOutputUnt)) THEN - DEALLOCATE(Dvr_OutputsData%WriteOutputUnt) -ENDIF -IF (ALLOCATED(Dvr_OutputsData%storage)) THEN - DEALLOCATE(Dvr_OutputsData%storage) -ENDIF -IF (ALLOCATED(Dvr_OutputsData%outLine)) THEN - DEALLOCATE(Dvr_OutputsData%outLine) -ENDIF -IF (ALLOCATED(Dvr_OutputsData%VTK_surface)) THEN -DO i1 = LBOUND(Dvr_OutputsData%VTK_surface,1), UBOUND(Dvr_OutputsData%VTK_surface,1) - CALL AD_Dvr_Destroydvrvtk_surfacetype( Dvr_OutputsData%VTK_surface(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(Dvr_OutputsData%VTK_surface) -ENDIF - END SUBROUTINE AD_Dvr_DestroyDvr_Outputs - - SUBROUTINE AD_Dvr_PackDvr_Outputs( 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(Dvr_Outputs), 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 = 'AD_Dvr_PackDvr_Outputs' - ! 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 ! AD_ver: size of buffers for each call to pack subtype - CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%AD_ver, ErrStat2, ErrMsg2, .TRUE. ) ! AD_ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! AD_ver - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! AD_ver - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! AD_ver - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! unOutFile allocated yes/no - IF ( ALLOCATED(InData%unOutFile) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! unOutFile upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%unOutFile) ! unOutFile - END IF - Int_BufSz = Int_BufSz + 1 ! ActualChanLen - Int_BufSz = Int_BufSz + 1 ! nDvrOutputs - Int_BufSz = Int_BufSz + 1*LEN(InData%Fmt_t) ! Fmt_t - Int_BufSz = Int_BufSz + 1*LEN(InData%Fmt_a) ! Fmt_a - Int_BufSz = Int_BufSz + 1*LEN(InData%delim) ! delim - Int_BufSz = Int_BufSz + 1*LEN(InData%outFmt) ! outFmt - Int_BufSz = Int_BufSz + 1 ! fileFmt - Int_BufSz = Int_BufSz + 1 ! wrVTK - Int_BufSz = Int_BufSz + 1 ! WrVTK_Type - Int_BufSz = Int_BufSz + 1*LEN(InData%Root) ! Root - Int_BufSz = Int_BufSz + 1*LEN(InData%VTK_OutFileRoot) ! VTK_OutFileRoot - 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 - Int_BufSz = Int_BufSz + 1 ! storage allocated yes/no - IF ( ALLOCATED(InData%storage) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! storage upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%storage) ! storage - END IF - Int_BufSz = Int_BufSz + 1 ! outLine allocated yes/no - IF ( ALLOCATED(InData%outLine) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! outLine upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%outLine) ! outLine - END IF - Int_BufSz = Int_BufSz + 1 ! VTK_surface allocated yes/no - IF ( ALLOCATED(InData%VTK_surface) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! VTK_surface upper/lower bounds for each dimension - DO i1 = LBOUND(InData%VTK_surface,1), UBOUND(InData%VTK_surface,1) - Int_BufSz = Int_BufSz + 3 ! VTK_surface: size of buffers for each call to pack subtype - CALL AD_Dvr_Packdvrvtk_surfacetype( Re_Buf, Db_Buf, Int_Buf, InData%VTK_surface(i1), ErrStat2, ErrMsg2, .TRUE. ) ! VTK_surface - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! VTK_surface - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! VTK_surface - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! VTK_surface - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! VTK_tWidth - Int_BufSz = Int_BufSz + 1 ! n_VTKTime - Re_BufSz = Re_BufSz + 1 ! VTKHubRad - Re_BufSz = Re_BufSz + SIZE(InData%VTKNacDim) ! VTKNacDim - Re_BufSz = Re_BufSz + SIZE(InData%VTKRefPoint) ! VTKRefPoint - Db_BufSz = Db_BufSz + 1 ! DT_Outs - Int_BufSz = Int_BufSz + 1 ! n_DT_Out - 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%AD_ver, ErrStat2, ErrMsg2, OnlySize ) ! AD_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%unOutFile) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%unOutFile,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%unOutFile,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%unOutFile,1), UBOUND(InData%unOutFile,1) - IntKiBuf(Int_Xferred) = InData%unOutFile(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%ActualChanLen - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nDvrOutputs - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%Fmt_t) - IntKiBuf(Int_Xferred) = ICHAR(InData%Fmt_t(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%Fmt_a) - IntKiBuf(Int_Xferred) = ICHAR(InData%Fmt_a(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - 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 - IntKiBuf(Int_Xferred) = InData%fileFmt - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%wrVTK - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%WrVTK_Type - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%Root) - IntKiBuf(Int_Xferred) = ICHAR(InData%Root(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%VTK_OutFileRoot) - IntKiBuf(Int_Xferred) = ICHAR(InData%VTK_OutFileRoot(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - 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 - IF ( .NOT. ALLOCATED(InData%storage) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%storage,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%storage,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%storage,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%storage,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%storage,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%storage,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%storage,3), UBOUND(InData%storage,3) - DO i2 = LBOUND(InData%storage,2), UBOUND(InData%storage,2) - DO i1 = LBOUND(InData%storage,1), UBOUND(InData%storage,1) - ReKiBuf(Re_Xferred) = InData%storage(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%outLine) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%outLine,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%outLine,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%outLine,1), UBOUND(InData%outLine,1) - ReKiBuf(Re_Xferred) = InData%outLine(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%VTK_surface) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%VTK_surface,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VTK_surface,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%VTK_surface,1), UBOUND(InData%VTK_surface,1) - CALL AD_Dvr_Packdvrvtk_surfacetype( Re_Buf, Db_Buf, Int_Buf, InData%VTK_surface(i1), ErrStat2, ErrMsg2, OnlySize ) ! VTK_surface - 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%VTK_tWidth - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%n_VTKTime - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%VTKHubRad - Re_Xferred = Re_Xferred + 1 - DO i1 = LBOUND(InData%VTKNacDim,1), UBOUND(InData%VTKNacDim,1) - ReKiBuf(Re_Xferred) = InData%VTKNacDim(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%VTKRefPoint,1), UBOUND(InData%VTKRefPoint,1) - ReKiBuf(Re_Xferred) = InData%VTKRefPoint(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DbKiBuf(Db_Xferred) = InData%DT_Outs - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%n_DT_Out - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE AD_Dvr_PackDvr_Outputs - - SUBROUTINE AD_Dvr_UnPackDvr_Outputs( 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(Dvr_Outputs), 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 = 'AD_Dvr_UnPackDvr_Outputs' - ! 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%AD_ver, ErrStat2, ErrMsg2 ) ! AD_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 ! unOutFile not allocated - Int_Xferred = Int_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%unOutFile)) DEALLOCATE(OutData%unOutFile) - ALLOCATE(OutData%unOutFile(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%unOutFile.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%unOutFile,1), UBOUND(OutData%unOutFile,1) - OutData%unOutFile(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - OutData%ActualChanLen = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nDvrOutputs = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%Fmt_t) - OutData%Fmt_t(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%Fmt_a) - OutData%Fmt_a(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - 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 - OutData%fileFmt = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%wrVTK = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WrVTK_Type = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%Root) - OutData%Root(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%VTK_OutFileRoot) - OutData%VTK_OutFileRoot(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - 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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! storage not allocated - Int_Xferred = Int_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%storage)) DEALLOCATE(OutData%storage) - ALLOCATE(OutData%storage(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%storage.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%storage,3), UBOUND(OutData%storage,3) - DO i2 = LBOUND(OutData%storage,2), UBOUND(OutData%storage,2) - DO i1 = LBOUND(OutData%storage,1), UBOUND(OutData%storage,1) - OutData%storage(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 ! outLine not allocated - Int_Xferred = Int_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%outLine)) DEALLOCATE(OutData%outLine) - ALLOCATE(OutData%outLine(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%outLine.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%outLine,1), UBOUND(OutData%outLine,1) - OutData%outLine(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! VTK_surface not allocated - Int_Xferred = Int_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%VTK_surface)) DEALLOCATE(OutData%VTK_surface) - ALLOCATE(OutData%VTK_surface(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%VTK_surface.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%VTK_surface,1), UBOUND(OutData%VTK_surface,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 AD_Dvr_Unpackdvrvtk_surfacetype( Re_Buf, Db_Buf, Int_Buf, OutData%VTK_surface(i1), ErrStat2, ErrMsg2 ) ! VTK_surface - 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%VTK_tWidth = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%n_VTKTime = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%VTKHubRad = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%VTKNacDim,1) - i1_u = UBOUND(OutData%VTKNacDim,1) - DO i1 = LBOUND(OutData%VTKNacDim,1), UBOUND(OutData%VTKNacDim,1) - OutData%VTKNacDim(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%VTKRefPoint,1) - i1_u = UBOUND(OutData%VTKRefPoint,1) - DO i1 = LBOUND(OutData%VTKRefPoint,1), UBOUND(OutData%VTKRefPoint,1) - OutData%VTKRefPoint(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%DT_Outs = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%n_DT_Out = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE AD_Dvr_UnPackDvr_Outputs - - SUBROUTINE AD_Dvr_CopyBladeData( SrcBladeDataData, DstBladeDataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(BladeData), INTENT(IN) :: SrcBladeDataData - TYPE(BladeData), INTENT(INOUT) :: DstBladeDataData - 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 = 'AD_Dvr_CopyBladeData' -! + ErrMsg = '' +end subroutine + +subroutine AD_Dvr_PackDvr_Case(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Dvr_Case), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_Dvr_PackDvr_Case' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%HWindSpeed) + call RegPack(RF, InData%PLExp) + call RegPack(RF, InData%rotSpeed) + call RegPack(RF, InData%bldPitch) + call RegPack(RF, InData%nacYaw) + call RegPack(RF, InData%tMax) + call RegPack(RF, InData%dT) + call RegPack(RF, InData%numSteps) + call RegPack(RF, InData%DOF) + call RegPack(RF, InData%amplitude) + call RegPack(RF, InData%frequency) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AD_Dvr_UnPackDvr_Case(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Dvr_Case), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_Dvr_UnPackDvr_Case' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%HWindSpeed); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PLExp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rotSpeed); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%bldPitch); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nacYaw); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%tMax); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%dT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%numSteps); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DOF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%amplitude); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%frequency); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AD_Dvr_CopyDvrVTK_SurfaceType(SrcDvrVTK_SurfaceTypeData, DstDvrVTK_SurfaceTypeData, CtrlCode, ErrStat, ErrMsg) + type(DvrVTK_SurfaceType), intent(in) :: SrcDvrVTK_SurfaceTypeData + type(DvrVTK_SurfaceType), intent(inout) :: DstDvrVTK_SurfaceTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD_Dvr_CopyDvrVTK_SurfaceType' ErrStat = ErrID_None - ErrMsg = "" - DstBladeDataData%pitch = SrcBladeDataData%pitch - DstBladeDataData%pitchSpeed = SrcBladeDataData%pitchSpeed - DstBladeDataData%pitchAcc = SrcBladeDataData%pitchAcc - DstBladeDataData%origin_h = SrcBladeDataData%origin_h - DstBladeDataData%orientation_h = SrcBladeDataData%orientation_h - DstBladeDataData%hubRad_bl = SrcBladeDataData%hubRad_bl - DstBladeDataData%Rh2bl0 = SrcBladeDataData%Rh2bl0 - DstBladeDataData%motionType = SrcBladeDataData%motionType - DstBladeDataData%iMotion = SrcBladeDataData%iMotion -IF (ALLOCATED(SrcBladeDataData%motion)) THEN - i1_l = LBOUND(SrcBladeDataData%motion,1) - i1_u = UBOUND(SrcBladeDataData%motion,1) - i2_l = LBOUND(SrcBladeDataData%motion,2) - i2_u = UBOUND(SrcBladeDataData%motion,2) - IF (.NOT. ALLOCATED(DstBladeDataData%motion)) THEN - ALLOCATE(DstBladeDataData%motion(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladeDataData%motion.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladeDataData%motion = SrcBladeDataData%motion -ENDIF - DstBladeDataData%motionFileName = SrcBladeDataData%motionFileName - END SUBROUTINE AD_Dvr_CopyBladeData - - SUBROUTINE AD_Dvr_DestroyBladeData( BladeDataData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(BladeData), INTENT(INOUT) :: BladeDataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_DestroyBladeData' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(BladeDataData%motion)) THEN - DEALLOCATE(BladeDataData%motion) -ENDIF - END SUBROUTINE AD_Dvr_DestroyBladeData - - SUBROUTINE AD_Dvr_PackBladeData( 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(BladeData), 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 = 'AD_Dvr_PackBladeData' - ! 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 ! pitch - Re_BufSz = Re_BufSz + 1 ! pitchSpeed - Re_BufSz = Re_BufSz + 1 ! pitchAcc - Re_BufSz = Re_BufSz + SIZE(InData%origin_h) ! origin_h - Re_BufSz = Re_BufSz + SIZE(InData%orientation_h) ! orientation_h - Re_BufSz = Re_BufSz + 1 ! hubRad_bl - Db_BufSz = Db_BufSz + SIZE(InData%Rh2bl0) ! Rh2bl0 - Int_BufSz = Int_BufSz + 1 ! motionType - Int_BufSz = Int_BufSz + 1 ! iMotion - Int_BufSz = Int_BufSz + 1 ! motion allocated yes/no - IF ( ALLOCATED(InData%motion) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! motion upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%motion) ! motion - END IF - Int_BufSz = Int_BufSz + 1*LEN(InData%motionFileName) ! motionFileName - 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%pitch - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%pitchSpeed - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%pitchAcc - Re_Xferred = Re_Xferred + 1 - DO i1 = LBOUND(InData%origin_h,1), UBOUND(InData%origin_h,1) - ReKiBuf(Re_Xferred) = InData%origin_h(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%orientation_h,1), UBOUND(InData%orientation_h,1) - ReKiBuf(Re_Xferred) = InData%orientation_h(i1) - Re_Xferred = Re_Xferred + 1 - END DO - ReKiBuf(Re_Xferred) = InData%hubRad_bl - Re_Xferred = Re_Xferred + 1 - DO i2 = LBOUND(InData%Rh2bl0,2), UBOUND(InData%Rh2bl0,2) - DO i1 = LBOUND(InData%Rh2bl0,1), UBOUND(InData%Rh2bl0,1) - DbKiBuf(Db_Xferred) = InData%Rh2bl0(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - IntKiBuf(Int_Xferred) = InData%motionType - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%iMotion - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%motion) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%motion,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%motion,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%motion,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%motion,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%motion,2), UBOUND(InData%motion,2) - DO i1 = LBOUND(InData%motion,1), UBOUND(InData%motion,1) - ReKiBuf(Re_Xferred) = InData%motion(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - DO I = 1, LEN(InData%motionFileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%motionFileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END SUBROUTINE AD_Dvr_PackBladeData - - SUBROUTINE AD_Dvr_UnPackBladeData( 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(BladeData), 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 = 'AD_Dvr_UnPackBladeData' - ! 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%pitch = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%pitchSpeed = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%pitchAcc = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%origin_h,1) - i1_u = UBOUND(OutData%origin_h,1) - DO i1 = LBOUND(OutData%origin_h,1), UBOUND(OutData%origin_h,1) - OutData%origin_h(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%orientation_h,1) - i1_u = UBOUND(OutData%orientation_h,1) - DO i1 = LBOUND(OutData%orientation_h,1), UBOUND(OutData%orientation_h,1) - OutData%orientation_h(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%hubRad_bl = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%Rh2bl0,1) - i1_u = UBOUND(OutData%Rh2bl0,1) - i2_l = LBOUND(OutData%Rh2bl0,2) - i2_u = UBOUND(OutData%Rh2bl0,2) - DO i2 = LBOUND(OutData%Rh2bl0,2), UBOUND(OutData%Rh2bl0,2) - DO i1 = LBOUND(OutData%Rh2bl0,1), UBOUND(OutData%Rh2bl0,1) - OutData%Rh2bl0(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - OutData%motionType = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%iMotion = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! motion not allocated - Int_Xferred = Int_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%motion)) DEALLOCATE(OutData%motion) - ALLOCATE(OutData%motion(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%motion.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%motion,2), UBOUND(OutData%motion,2) - DO i1 = LBOUND(OutData%motion,1), UBOUND(OutData%motion,1) - OutData%motion(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - DO I = 1, LEN(OutData%motionFileName) - OutData%motionFileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END SUBROUTINE AD_Dvr_UnPackBladeData - - SUBROUTINE AD_Dvr_CopyHubData( SrcHubDataData, DstHubDataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(HubData), INTENT(IN) :: SrcHubDataData - TYPE(HubData), INTENT(INOUT) :: DstHubDataData - 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 = 'AD_Dvr_CopyHubData' -! + ErrMsg = '' + DstDvrVTK_SurfaceTypeData%NumSectors = SrcDvrVTK_SurfaceTypeData%NumSectors + DstDvrVTK_SurfaceTypeData%NacelleBox = SrcDvrVTK_SurfaceTypeData%NacelleBox + DstDvrVTK_SurfaceTypeData%BaseBox = SrcDvrVTK_SurfaceTypeData%BaseBox +end subroutine + +subroutine AD_Dvr_DestroyDvrVTK_SurfaceType(DvrVTK_SurfaceTypeData, ErrStat, ErrMsg) + type(DvrVTK_SurfaceType), intent(inout) :: DvrVTK_SurfaceTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD_Dvr_DestroyDvrVTK_SurfaceType' ErrStat = ErrID_None - ErrMsg = "" - DstHubDataData%origin_n = SrcHubDataData%origin_n - DstHubDataData%orientation_n = SrcHubDataData%orientation_n - DstHubDataData%motionType = SrcHubDataData%motionType - DstHubDataData%iMotion = SrcHubDataData%iMotion - DstHubDataData%azimuth = SrcHubDataData%azimuth - DstHubDataData%rotSpeed = SrcHubDataData%rotSpeed - DstHubDataData%rotAcc = SrcHubDataData%rotAcc - DstHubDataData%motionFileName = SrcHubDataData%motionFileName -IF (ALLOCATED(SrcHubDataData%motion)) THEN - i1_l = LBOUND(SrcHubDataData%motion,1) - i1_u = UBOUND(SrcHubDataData%motion,1) - i2_l = LBOUND(SrcHubDataData%motion,2) - i2_u = UBOUND(SrcHubDataData%motion,2) - IF (.NOT. ALLOCATED(DstHubDataData%motion)) THEN - ALLOCATE(DstHubDataData%motion(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstHubDataData%motion.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstHubDataData%motion = SrcHubDataData%motion -ENDIF - END SUBROUTINE AD_Dvr_CopyHubData - - SUBROUTINE AD_Dvr_DestroyHubData( HubDataData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(HubData), INTENT(INOUT) :: HubDataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_DestroyHubData' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(HubDataData%motion)) THEN - DEALLOCATE(HubDataData%motion) -ENDIF - END SUBROUTINE AD_Dvr_DestroyHubData - - SUBROUTINE AD_Dvr_PackHubData( 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(HubData), 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 = 'AD_Dvr_PackHubData' - ! 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%origin_n) ! origin_n - Re_BufSz = Re_BufSz + SIZE(InData%orientation_n) ! orientation_n - Int_BufSz = Int_BufSz + 1 ! motionType - Int_BufSz = Int_BufSz + 1 ! iMotion - Re_BufSz = Re_BufSz + 1 ! azimuth - Re_BufSz = Re_BufSz + 1 ! rotSpeed - Re_BufSz = Re_BufSz + 1 ! rotAcc - Int_BufSz = Int_BufSz + 1*LEN(InData%motionFileName) ! motionFileName - Int_BufSz = Int_BufSz + 1 ! motion allocated yes/no - IF ( ALLOCATED(InData%motion) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! motion upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%motion) ! motion - 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 i1 = LBOUND(InData%origin_n,1), UBOUND(InData%origin_n,1) - ReKiBuf(Re_Xferred) = InData%origin_n(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%orientation_n,1), UBOUND(InData%orientation_n,1) - ReKiBuf(Re_Xferred) = InData%orientation_n(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%motionType - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%iMotion - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%azimuth - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%rotSpeed - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%rotAcc - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(InData%motionFileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%motionFileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IF ( .NOT. ALLOCATED(InData%motion) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%motion,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%motion,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%motion,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%motion,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%motion,2), UBOUND(InData%motion,2) - DO i1 = LBOUND(InData%motion,1), UBOUND(InData%motion,1) - ReKiBuf(Re_Xferred) = InData%motion(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE AD_Dvr_PackHubData - - SUBROUTINE AD_Dvr_UnPackHubData( 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(HubData), 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 = 'AD_Dvr_UnPackHubData' - ! 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%origin_n,1) - i1_u = UBOUND(OutData%origin_n,1) - DO i1 = LBOUND(OutData%origin_n,1), UBOUND(OutData%origin_n,1) - OutData%origin_n(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%orientation_n,1) - i1_u = UBOUND(OutData%orientation_n,1) - DO i1 = LBOUND(OutData%orientation_n,1), UBOUND(OutData%orientation_n,1) - OutData%orientation_n(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%motionType = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%iMotion = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%azimuth = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%rotSpeed = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%rotAcc = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(OutData%motionFileName) - OutData%motionFileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! motion not allocated - Int_Xferred = Int_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%motion)) DEALLOCATE(OutData%motion) - ALLOCATE(OutData%motion(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%motion.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%motion,2), UBOUND(OutData%motion,2) - DO i1 = LBOUND(OutData%motion,1), UBOUND(OutData%motion,1) - OutData%motion(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE AD_Dvr_UnPackHubData - - SUBROUTINE AD_Dvr_CopyNacData( SrcNacDataData, DstNacDataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(NacData), INTENT(IN) :: SrcNacDataData - TYPE(NacData), INTENT(INOUT) :: DstNacDataData - 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 = 'AD_Dvr_CopyNacData' -! + ErrMsg = '' +end subroutine + +subroutine AD_Dvr_PackDvrVTK_SurfaceType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(DvrVTK_SurfaceType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_Dvr_PackDvrVTK_SurfaceType' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%NumSectors) + call RegPack(RF, InData%NacelleBox) + call RegPack(RF, InData%BaseBox) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AD_Dvr_UnPackDvrVTK_SurfaceType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(DvrVTK_SurfaceType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_Dvr_UnPackDvrVTK_SurfaceType' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%NumSectors); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NacelleBox); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BaseBox); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AD_Dvr_CopyDvr_Outputs(SrcDvr_OutputsData, DstDvr_OutputsData, CtrlCode, ErrStat, ErrMsg) + type(Dvr_Outputs), intent(in) :: SrcDvr_OutputsData + type(Dvr_Outputs), intent(inout) :: DstDvr_OutputsData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_Dvr_CopyDvr_Outputs' ErrStat = ErrID_None - ErrMsg = "" - DstNacDataData%origin_t = SrcNacDataData%origin_t - DstNacDataData%motionType = SrcNacDataData%motionType - DstNacDataData%iMotion = SrcNacDataData%iMotion - DstNacDataData%yaw = SrcNacDataData%yaw - DstNacDataData%yawSpeed = SrcNacDataData%yawSpeed - DstNacDataData%yawAcc = SrcNacDataData%yawAcc - DstNacDataData%motionFileName = SrcNacDataData%motionFileName -IF (ALLOCATED(SrcNacDataData%motion)) THEN - i1_l = LBOUND(SrcNacDataData%motion,1) - i1_u = UBOUND(SrcNacDataData%motion,1) - i2_l = LBOUND(SrcNacDataData%motion,2) - i2_u = UBOUND(SrcNacDataData%motion,2) - IF (.NOT. ALLOCATED(DstNacDataData%motion)) THEN - ALLOCATE(DstNacDataData%motion(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstNacDataData%motion.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstNacDataData%motion = SrcNacDataData%motion -ENDIF - END SUBROUTINE AD_Dvr_CopyNacData - - SUBROUTINE AD_Dvr_DestroyNacData( NacDataData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(NacData), INTENT(INOUT) :: NacDataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_DestroyNacData' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(NacDataData%motion)) THEN - DEALLOCATE(NacDataData%motion) -ENDIF - END SUBROUTINE AD_Dvr_DestroyNacData - - SUBROUTINE AD_Dvr_PackNacData( 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(NacData), 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 = 'AD_Dvr_PackNacData' - ! 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%origin_t) ! origin_t - Int_BufSz = Int_BufSz + 1 ! motionType - Int_BufSz = Int_BufSz + 1 ! iMotion - Re_BufSz = Re_BufSz + 1 ! yaw - Re_BufSz = Re_BufSz + 1 ! yawSpeed - Re_BufSz = Re_BufSz + 1 ! yawAcc - Int_BufSz = Int_BufSz + 1*LEN(InData%motionFileName) ! motionFileName - Int_BufSz = Int_BufSz + 1 ! motion allocated yes/no - IF ( ALLOCATED(InData%motion) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! motion upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%motion) ! motion - 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 i1 = LBOUND(InData%origin_t,1), UBOUND(InData%origin_t,1) - ReKiBuf(Re_Xferred) = InData%origin_t(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%motionType - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%iMotion - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%yaw - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%yawSpeed - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%yawAcc - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(InData%motionFileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%motionFileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IF ( .NOT. ALLOCATED(InData%motion) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%motion,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%motion,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%motion,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%motion,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%motion,2), UBOUND(InData%motion,2) - DO i1 = LBOUND(InData%motion,1), UBOUND(InData%motion,1) - ReKiBuf(Re_Xferred) = InData%motion(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE AD_Dvr_PackNacData - - SUBROUTINE AD_Dvr_UnPackNacData( 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(NacData), 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 = 'AD_Dvr_UnPackNacData' - ! 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%origin_t,1) - i1_u = UBOUND(OutData%origin_t,1) - DO i1 = LBOUND(OutData%origin_t,1), UBOUND(OutData%origin_t,1) - OutData%origin_t(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%motionType = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%iMotion = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%yaw = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%yawSpeed = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%yawAcc = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(OutData%motionFileName) - OutData%motionFileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! motion not allocated - Int_Xferred = Int_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%motion)) DEALLOCATE(OutData%motion) - ALLOCATE(OutData%motion(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%motion.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%motion,2), UBOUND(OutData%motion,2) - DO i1 = LBOUND(OutData%motion,1), UBOUND(OutData%motion,1) - OutData%motion(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE AD_Dvr_UnPackNacData - - SUBROUTINE AD_Dvr_CopyTwrData( SrcTwrDataData, DstTwrDataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(TwrData), INTENT(IN) :: SrcTwrDataData - TYPE(TwrData), INTENT(INOUT) :: DstTwrDataData - 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 = 'AD_Dvr_CopyTwrData' -! + ErrMsg = '' + call NWTC_Library_CopyProgDesc(SrcDvr_OutputsData%AD_ver, DstDvr_OutputsData%AD_ver, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcDvr_OutputsData%unOutFile)) then + LB(1:1) = lbound(SrcDvr_OutputsData%unOutFile) + UB(1:1) = ubound(SrcDvr_OutputsData%unOutFile) + if (.not. allocated(DstDvr_OutputsData%unOutFile)) then + allocate(DstDvr_OutputsData%unOutFile(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDvr_OutputsData%unOutFile.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDvr_OutputsData%unOutFile = SrcDvr_OutputsData%unOutFile + end if + DstDvr_OutputsData%ActualChanLen = SrcDvr_OutputsData%ActualChanLen + DstDvr_OutputsData%nDvrOutputs = SrcDvr_OutputsData%nDvrOutputs + DstDvr_OutputsData%Fmt_t = SrcDvr_OutputsData%Fmt_t + DstDvr_OutputsData%Fmt_a = SrcDvr_OutputsData%Fmt_a + DstDvr_OutputsData%delim = SrcDvr_OutputsData%delim + DstDvr_OutputsData%outFmt = SrcDvr_OutputsData%outFmt + DstDvr_OutputsData%fileFmt = SrcDvr_OutputsData%fileFmt + DstDvr_OutputsData%WrVTK = SrcDvr_OutputsData%WrVTK + DstDvr_OutputsData%WrVTK_Type = SrcDvr_OutputsData%WrVTK_Type + DstDvr_OutputsData%Root = SrcDvr_OutputsData%Root + DstDvr_OutputsData%VTK_OutFileRoot = SrcDvr_OutputsData%VTK_OutFileRoot + if (allocated(SrcDvr_OutputsData%WriteOutputHdr)) then + LB(1:1) = lbound(SrcDvr_OutputsData%WriteOutputHdr) + UB(1:1) = ubound(SrcDvr_OutputsData%WriteOutputHdr) + if (.not. allocated(DstDvr_OutputsData%WriteOutputHdr)) then + allocate(DstDvr_OutputsData%WriteOutputHdr(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDvr_OutputsData%WriteOutputHdr.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDvr_OutputsData%WriteOutputHdr = SrcDvr_OutputsData%WriteOutputHdr + end if + if (allocated(SrcDvr_OutputsData%WriteOutputUnt)) then + LB(1:1) = lbound(SrcDvr_OutputsData%WriteOutputUnt) + UB(1:1) = ubound(SrcDvr_OutputsData%WriteOutputUnt) + if (.not. allocated(DstDvr_OutputsData%WriteOutputUnt)) then + allocate(DstDvr_OutputsData%WriteOutputUnt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDvr_OutputsData%WriteOutputUnt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDvr_OutputsData%WriteOutputUnt = SrcDvr_OutputsData%WriteOutputUnt + end if + if (allocated(SrcDvr_OutputsData%storage)) then + LB(1:3) = lbound(SrcDvr_OutputsData%storage) + UB(1:3) = ubound(SrcDvr_OutputsData%storage) + if (.not. allocated(DstDvr_OutputsData%storage)) then + allocate(DstDvr_OutputsData%storage(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDvr_OutputsData%storage.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDvr_OutputsData%storage = SrcDvr_OutputsData%storage + end if + if (allocated(SrcDvr_OutputsData%outLine)) then + LB(1:1) = lbound(SrcDvr_OutputsData%outLine) + UB(1:1) = ubound(SrcDvr_OutputsData%outLine) + if (.not. allocated(DstDvr_OutputsData%outLine)) then + allocate(DstDvr_OutputsData%outLine(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDvr_OutputsData%outLine.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDvr_OutputsData%outLine = SrcDvr_OutputsData%outLine + end if + if (allocated(SrcDvr_OutputsData%VTK_surface)) then + LB(1:1) = lbound(SrcDvr_OutputsData%VTK_surface) + UB(1:1) = ubound(SrcDvr_OutputsData%VTK_surface) + if (.not. allocated(DstDvr_OutputsData%VTK_surface)) then + allocate(DstDvr_OutputsData%VTK_surface(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDvr_OutputsData%VTK_surface.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AD_Dvr_CopyDvrVTK_SurfaceType(SrcDvr_OutputsData%VTK_surface(i1), DstDvr_OutputsData%VTK_surface(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + DstDvr_OutputsData%VTK_tWidth = SrcDvr_OutputsData%VTK_tWidth + DstDvr_OutputsData%n_VTKTime = SrcDvr_OutputsData%n_VTKTime + DstDvr_OutputsData%VTK_DT = SrcDvr_OutputsData%VTK_DT + DstDvr_OutputsData%VTKHubRad = SrcDvr_OutputsData%VTKHubRad + DstDvr_OutputsData%VTKNacDim = SrcDvr_OutputsData%VTKNacDim + DstDvr_OutputsData%VTKRefPoint = SrcDvr_OutputsData%VTKRefPoint + DstDvr_OutputsData%DT_Outs = SrcDvr_OutputsData%DT_Outs + DstDvr_OutputsData%n_DT_Out = SrcDvr_OutputsData%n_DT_Out +end subroutine + +subroutine AD_Dvr_DestroyDvr_Outputs(Dvr_OutputsData, ErrStat, ErrMsg) + type(Dvr_Outputs), intent(inout) :: Dvr_OutputsData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_Dvr_DestroyDvr_Outputs' ErrStat = ErrID_None - ErrMsg = "" - DstTwrDataData%origin_t = SrcTwrDataData%origin_t - END SUBROUTINE AD_Dvr_CopyTwrData - - SUBROUTINE AD_Dvr_DestroyTwrData( TwrDataData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(TwrData), INTENT(INOUT) :: TwrDataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_DestroyTwrData' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE AD_Dvr_DestroyTwrData - - SUBROUTINE AD_Dvr_PackTwrData( 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(TwrData), 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 = 'AD_Dvr_PackTwrData' - ! 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%origin_t) ! origin_t - 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%origin_t,1), UBOUND(InData%origin_t,1) - ReKiBuf(Re_Xferred) = InData%origin_t(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END SUBROUTINE AD_Dvr_PackTwrData - - SUBROUTINE AD_Dvr_UnPackTwrData( 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(TwrData), 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 = 'AD_Dvr_UnPackTwrData' - ! 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%origin_t,1) - i1_u = UBOUND(OutData%origin_t,1) - DO i1 = LBOUND(OutData%origin_t,1), UBOUND(OutData%origin_t,1) - OutData%origin_t(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END SUBROUTINE AD_Dvr_UnPackTwrData - - SUBROUTINE AD_Dvr_CopyWTData( SrcWTDataData, DstWTDataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(WTData), INTENT(INOUT) :: SrcWTDataData - TYPE(WTData), INTENT(INOUT) :: DstWTDataData - 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 = 'AD_Dvr_CopyWTData' -! + ErrMsg = '' + call NWTC_Library_DestroyProgDesc(Dvr_OutputsData%AD_ver, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(Dvr_OutputsData%unOutFile)) then + deallocate(Dvr_OutputsData%unOutFile) + end if + if (allocated(Dvr_OutputsData%WriteOutputHdr)) then + deallocate(Dvr_OutputsData%WriteOutputHdr) + end if + if (allocated(Dvr_OutputsData%WriteOutputUnt)) then + deallocate(Dvr_OutputsData%WriteOutputUnt) + end if + if (allocated(Dvr_OutputsData%storage)) then + deallocate(Dvr_OutputsData%storage) + end if + if (allocated(Dvr_OutputsData%outLine)) then + deallocate(Dvr_OutputsData%outLine) + end if + if (allocated(Dvr_OutputsData%VTK_surface)) then + LB(1:1) = lbound(Dvr_OutputsData%VTK_surface) + UB(1:1) = ubound(Dvr_OutputsData%VTK_surface) + do i1 = LB(1), UB(1) + call AD_Dvr_DestroyDvrVTK_SurfaceType(Dvr_OutputsData%VTK_surface(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(Dvr_OutputsData%VTK_surface) + end if +end subroutine + +subroutine AD_Dvr_PackDvr_Outputs(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Dvr_Outputs), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_Dvr_PackDvr_Outputs' + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) + if (RF%ErrStat >= AbortErrLev) return + call NWTC_Library_PackProgDesc(RF, InData%AD_ver) + call RegPackAlloc(RF, InData%unOutFile) + call RegPack(RF, InData%ActualChanLen) + call RegPack(RF, InData%nDvrOutputs) + call RegPack(RF, InData%Fmt_t) + call RegPack(RF, InData%Fmt_a) + call RegPack(RF, InData%delim) + call RegPack(RF, InData%outFmt) + call RegPack(RF, InData%fileFmt) + call RegPack(RF, InData%WrVTK) + call RegPack(RF, InData%WrVTK_Type) + call RegPack(RF, InData%Root) + call RegPack(RF, InData%VTK_OutFileRoot) + call RegPackAlloc(RF, InData%WriteOutputHdr) + call RegPackAlloc(RF, InData%WriteOutputUnt) + call RegPackAlloc(RF, InData%storage) + call RegPackAlloc(RF, InData%outLine) + call RegPack(RF, allocated(InData%VTK_surface)) + if (allocated(InData%VTK_surface)) then + call RegPackBounds(RF, 1, lbound(InData%VTK_surface), ubound(InData%VTK_surface)) + LB(1:1) = lbound(InData%VTK_surface) + UB(1:1) = ubound(InData%VTK_surface) + do i1 = LB(1), UB(1) + call AD_Dvr_PackDvrVTK_SurfaceType(RF, InData%VTK_surface(i1)) + end do + end if + call RegPack(RF, InData%VTK_tWidth) + call RegPack(RF, InData%n_VTKTime) + call RegPack(RF, InData%VTK_DT) + call RegPack(RF, InData%VTKHubRad) + call RegPack(RF, InData%VTKNacDim) + call RegPack(RF, InData%VTKRefPoint) + call RegPack(RF, InData%DT_Outs) + call RegPack(RF, InData%n_DT_Out) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AD_Dvr_UnPackDvr_Outputs(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Dvr_Outputs), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_Dvr_UnPackDvr_Outputs' + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call NWTC_Library_UnpackProgDesc(RF, OutData%AD_ver) ! AD_ver + call RegUnpackAlloc(RF, OutData%unOutFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ActualChanLen); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nDvrOutputs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Fmt_t); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Fmt_a); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%delim); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%outFmt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%fileFmt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WrVTK); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WrVTK_Type); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Root); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VTK_OutFileRoot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WriteOutputHdr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WriteOutputUnt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%storage); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%outLine); if (RegCheckErr(RF, RoutineName)) return + if (allocated(OutData%VTK_surface)) deallocate(OutData%VTK_surface) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%VTK_surface(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%VTK_surface.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AD_Dvr_UnpackDvrVTK_SurfaceType(RF, OutData%VTK_surface(i1)) ! VTK_surface + end do + end if + call RegUnpack(RF, OutData%VTK_tWidth); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%n_VTKTime); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VTK_DT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VTKHubRad); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VTKNacDim); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VTKRefPoint); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DT_Outs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%n_DT_Out); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AD_Dvr_CopyBladeData(SrcBladeDataData, DstBladeDataData, CtrlCode, ErrStat, ErrMsg) + type(BladeData), intent(in) :: SrcBladeDataData + type(BladeData), intent(inout) :: DstBladeDataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'AD_Dvr_CopyBladeData' ErrStat = ErrID_None - ErrMsg = "" - DstWTDataData%originInit = SrcWTDataData%originInit - DstWTDataData%orientationInit = SrcWTDataData%orientationInit - CALL NWTC_Library_Copymeshmaptype( SrcWTDataData%map2twrPt, DstWTDataData%map2twrPt, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcWTDataData%map2nacPt, DstWTDataData%map2nacPt, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcWTDataData%map2hubPt, DstWTDataData%map2hubPt, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcWTDataData%map2BldPt)) THEN - i1_l = LBOUND(SrcWTDataData%map2BldPt,1) - i1_u = UBOUND(SrcWTDataData%map2BldPt,1) - IF (.NOT. ALLOCATED(DstWTDataData%map2BldPt)) THEN - ALLOCATE(DstWTDataData%map2BldPt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWTDataData%map2BldPt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcWTDataData%map2BldPt,1), UBOUND(SrcWTDataData%map2BldPt,1) - CALL NWTC_Library_Copymeshmaptype( SrcWTDataData%map2BldPt(i1), DstWTDataData%map2BldPt(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcWTDataData%bld)) THEN - i1_l = LBOUND(SrcWTDataData%bld,1) - i1_u = UBOUND(SrcWTDataData%bld,1) - IF (.NOT. ALLOCATED(DstWTDataData%bld)) THEN - ALLOCATE(DstWTDataData%bld(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWTDataData%bld.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcWTDataData%bld,1), UBOUND(SrcWTDataData%bld,1) - CALL AD_Dvr_Copybladedata( SrcWTDataData%bld(i1), DstWTDataData%bld(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL AD_Dvr_Copyhubdata( SrcWTDataData%hub, DstWTDataData%hub, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD_Dvr_Copynacdata( SrcWTDataData%nac, DstWTDataData%nac, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD_Dvr_Copytwrdata( SrcWTDataData%twr, DstWTDataData%twr, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstWTDataData%numBlades = SrcWTDataData%numBlades - DstWTDataData%basicHAWTFormat = SrcWTDataData%basicHAWTFormat - DstWTDataData%hasTower = SrcWTDataData%hasTower - DstWTDataData%projMod = SrcWTDataData%projMod - DstWTDataData%BEM_Mod = SrcWTDataData%BEM_Mod - DstWTDataData%HAWTprojection = SrcWTDataData%HAWTprojection - DstWTDataData%motionType = SrcWTDataData%motionType -IF (ALLOCATED(SrcWTDataData%motion)) THEN - i1_l = LBOUND(SrcWTDataData%motion,1) - i1_u = UBOUND(SrcWTDataData%motion,1) - i2_l = LBOUND(SrcWTDataData%motion,2) - i2_u = UBOUND(SrcWTDataData%motion,2) - IF (.NOT. ALLOCATED(DstWTDataData%motion)) THEN - ALLOCATE(DstWTDataData%motion(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWTDataData%motion.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWTDataData%motion = SrcWTDataData%motion -ENDIF - DstWTDataData%iMotion = SrcWTDataData%iMotion - DstWTDataData%degreeOfFreedom = SrcWTDataData%degreeOfFreedom - DstWTDataData%amplitude = SrcWTDataData%amplitude - DstWTDataData%frequency = SrcWTDataData%frequency - DstWTDataData%motionFileName = SrcWTDataData%motionFileName -IF (ALLOCATED(SrcWTDataData%WriteOutput)) THEN - i1_l = LBOUND(SrcWTDataData%WriteOutput,1) - i1_u = UBOUND(SrcWTDataData%WriteOutput,1) - IF (.NOT. ALLOCATED(DstWTDataData%WriteOutput)) THEN - ALLOCATE(DstWTDataData%WriteOutput(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWTDataData%WriteOutput.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWTDataData%WriteOutput = SrcWTDataData%WriteOutput -ENDIF -IF (ALLOCATED(SrcWTDataData%userSwapArray)) THEN - i1_l = LBOUND(SrcWTDataData%userSwapArray,1) - i1_u = UBOUND(SrcWTDataData%userSwapArray,1) - IF (.NOT. ALLOCATED(DstWTDataData%userSwapArray)) THEN - ALLOCATE(DstWTDataData%userSwapArray(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWTDataData%userSwapArray.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWTDataData%userSwapArray = SrcWTDataData%userSwapArray -ENDIF - END SUBROUTINE AD_Dvr_CopyWTData - - SUBROUTINE AD_Dvr_DestroyWTData( WTDataData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(WTData), INTENT(INOUT) :: WTDataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_DestroyWTData' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL NWTC_Library_Destroymeshmaptype( WTDataData%map2twrPt, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL NWTC_Library_Destroymeshmaptype( WTDataData%map2nacPt, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL NWTC_Library_Destroymeshmaptype( WTDataData%map2hubPt, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(WTDataData%map2BldPt)) THEN -DO i1 = LBOUND(WTDataData%map2BldPt,1), UBOUND(WTDataData%map2BldPt,1) - CALL NWTC_Library_Destroymeshmaptype( WTDataData%map2BldPt(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(WTDataData%map2BldPt) -ENDIF -IF (ALLOCATED(WTDataData%bld)) THEN -DO i1 = LBOUND(WTDataData%bld,1), UBOUND(WTDataData%bld,1) - CALL AD_Dvr_Destroybladedata( WTDataData%bld(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(WTDataData%bld) -ENDIF - CALL AD_Dvr_Destroyhubdata( WTDataData%hub, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD_Dvr_Destroynacdata( WTDataData%nac, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD_Dvr_Destroytwrdata( WTDataData%twr, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(WTDataData%motion)) THEN - DEALLOCATE(WTDataData%motion) -ENDIF -IF (ALLOCATED(WTDataData%WriteOutput)) THEN - DEALLOCATE(WTDataData%WriteOutput) -ENDIF -IF (ALLOCATED(WTDataData%userSwapArray)) THEN - DEALLOCATE(WTDataData%userSwapArray) -ENDIF - END SUBROUTINE AD_Dvr_DestroyWTData - - SUBROUTINE AD_Dvr_PackWTData( 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(WTData), 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 = 'AD_Dvr_PackWTData' - ! 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%originInit) ! originInit - Re_BufSz = Re_BufSz + SIZE(InData%orientationInit) ! orientationInit - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! map2twrPt: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%map2twrPt, ErrStat2, ErrMsg2, .TRUE. ) ! map2twrPt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! map2twrPt - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! map2twrPt - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! map2twrPt - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! map2nacPt: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%map2nacPt, ErrStat2, ErrMsg2, .TRUE. ) ! map2nacPt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! map2nacPt - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! map2nacPt - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! map2nacPt - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! map2hubPt: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%map2hubPt, ErrStat2, ErrMsg2, .TRUE. ) ! map2hubPt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! map2hubPt - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! map2hubPt - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! map2hubPt - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! map2BldPt allocated yes/no - IF ( ALLOCATED(InData%map2BldPt) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! map2BldPt upper/lower bounds for each dimension - DO i1 = LBOUND(InData%map2BldPt,1), UBOUND(InData%map2BldPt,1) - Int_BufSz = Int_BufSz + 3 ! map2BldPt: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%map2BldPt(i1), ErrStat2, ErrMsg2, .TRUE. ) ! map2BldPt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! map2BldPt - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! map2BldPt - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! map2BldPt - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! bld allocated yes/no - IF ( ALLOCATED(InData%bld) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! bld upper/lower bounds for each dimension - DO i1 = LBOUND(InData%bld,1), UBOUND(InData%bld,1) - Int_BufSz = Int_BufSz + 3 ! bld: size of buffers for each call to pack subtype - CALL AD_Dvr_Packbladedata( Re_Buf, Db_Buf, Int_Buf, InData%bld(i1), ErrStat2, ErrMsg2, .TRUE. ) ! bld - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! bld - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! bld - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! bld - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! hub: size of buffers for each call to pack subtype - CALL AD_Dvr_Packhubdata( Re_Buf, Db_Buf, Int_Buf, InData%hub, ErrStat2, ErrMsg2, .TRUE. ) ! hub - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! hub - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! hub - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! hub - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! nac: size of buffers for each call to pack subtype - CALL AD_Dvr_Packnacdata( Re_Buf, Db_Buf, Int_Buf, InData%nac, ErrStat2, ErrMsg2, .TRUE. ) ! nac - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! nac - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! nac - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! nac - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! twr: size of buffers for each call to pack subtype - CALL AD_Dvr_Packtwrdata( Re_Buf, Db_Buf, Int_Buf, InData%twr, ErrStat2, ErrMsg2, .TRUE. ) ! twr - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! twr - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! twr - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! twr - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! numBlades - Int_BufSz = Int_BufSz + 1 ! basicHAWTFormat - Int_BufSz = Int_BufSz + 1 ! hasTower - Int_BufSz = Int_BufSz + 1 ! projMod - Int_BufSz = Int_BufSz + 1 ! BEM_Mod - Int_BufSz = Int_BufSz + 1 ! HAWTprojection - Int_BufSz = Int_BufSz + 1 ! motionType - Int_BufSz = Int_BufSz + 1 ! motion allocated yes/no - IF ( ALLOCATED(InData%motion) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! motion upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%motion) ! motion - END IF - Int_BufSz = Int_BufSz + 1 ! iMotion - Int_BufSz = Int_BufSz + 1 ! degreeOfFreedom - Re_BufSz = Re_BufSz + 1 ! amplitude - Re_BufSz = Re_BufSz + 1 ! frequency - Int_BufSz = Int_BufSz + 1*LEN(InData%motionFileName) ! motionFileName - 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 ! userSwapArray allocated yes/no - IF ( ALLOCATED(InData%userSwapArray) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! userSwapArray upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%userSwapArray) ! userSwapArray - 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 i1 = LBOUND(InData%originInit,1), UBOUND(InData%originInit,1) - ReKiBuf(Re_Xferred) = InData%originInit(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%orientationInit,1), UBOUND(InData%orientationInit,1) - ReKiBuf(Re_Xferred) = InData%orientationInit(i1) - Re_Xferred = Re_Xferred + 1 - END DO - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%map2twrPt, ErrStat2, ErrMsg2, OnlySize ) ! map2twrPt - 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 NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%map2nacPt, ErrStat2, ErrMsg2, OnlySize ) ! map2nacPt - 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 NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%map2hubPt, ErrStat2, ErrMsg2, OnlySize ) ! map2hubPt - 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%map2BldPt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%map2BldPt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%map2BldPt,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%map2BldPt,1), UBOUND(InData%map2BldPt,1) - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%map2BldPt(i1), ErrStat2, ErrMsg2, OnlySize ) ! map2BldPt - 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%bld) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%bld,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%bld,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%bld,1), UBOUND(InData%bld,1) - CALL AD_Dvr_Packbladedata( Re_Buf, Db_Buf, Int_Buf, InData%bld(i1), ErrStat2, ErrMsg2, OnlySize ) ! bld - 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 - CALL AD_Dvr_Packhubdata( Re_Buf, Db_Buf, Int_Buf, InData%hub, ErrStat2, ErrMsg2, OnlySize ) ! hub - 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 AD_Dvr_Packnacdata( Re_Buf, Db_Buf, Int_Buf, InData%nac, ErrStat2, ErrMsg2, OnlySize ) ! nac - 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 AD_Dvr_Packtwrdata( Re_Buf, Db_Buf, Int_Buf, InData%twr, ErrStat2, ErrMsg2, OnlySize ) ! twr - 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%numBlades - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%basicHAWTFormat, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%hasTower, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%projMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%BEM_Mod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%HAWTprojection, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%motionType - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%motion) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%motion,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%motion,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%motion,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%motion,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%motion,2), UBOUND(InData%motion,2) - DO i1 = LBOUND(InData%motion,1), UBOUND(InData%motion,1) - ReKiBuf(Re_Xferred) = InData%motion(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%iMotion - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%degreeOfFreedom - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%amplitude - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%frequency - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(InData%motionFileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%motionFileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - 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%userSwapArray) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%userSwapArray,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%userSwapArray,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%userSwapArray,1), UBOUND(InData%userSwapArray,1) - ReKiBuf(Re_Xferred) = InData%userSwapArray(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE AD_Dvr_PackWTData - - SUBROUTINE AD_Dvr_UnPackWTData( 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(WTData), 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 = 'AD_Dvr_UnPackWTData' - ! 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%originInit,1) - i1_u = UBOUND(OutData%originInit,1) - DO i1 = LBOUND(OutData%originInit,1), UBOUND(OutData%originInit,1) - OutData%originInit(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%orientationInit,1) - i1_u = UBOUND(OutData%orientationInit,1) - DO i1 = LBOUND(OutData%orientationInit,1), UBOUND(OutData%orientationInit,1) - OutData%orientationInit(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - 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%map2twrPt, ErrStat2, ErrMsg2 ) ! map2twrPt - 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 NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%map2nacPt, ErrStat2, ErrMsg2 ) ! map2nacPt - 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 NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%map2hubPt, ErrStat2, ErrMsg2 ) ! map2hubPt - 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 ! map2BldPt not allocated - Int_Xferred = Int_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%map2BldPt)) DEALLOCATE(OutData%map2BldPt) - ALLOCATE(OutData%map2BldPt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%map2BldPt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%map2BldPt,1), UBOUND(OutData%map2BldPt,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%map2BldPt(i1), ErrStat2, ErrMsg2 ) ! map2BldPt - 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 ! bld not allocated - Int_Xferred = Int_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%bld)) DEALLOCATE(OutData%bld) - ALLOCATE(OutData%bld(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%bld.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%bld,1), UBOUND(OutData%bld,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 AD_Dvr_Unpackbladedata( Re_Buf, Db_Buf, Int_Buf, OutData%bld(i1), ErrStat2, ErrMsg2 ) ! bld - 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 - 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 AD_Dvr_Unpackhubdata( Re_Buf, Db_Buf, Int_Buf, OutData%hub, ErrStat2, ErrMsg2 ) ! hub - 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 AD_Dvr_Unpacknacdata( Re_Buf, Db_Buf, Int_Buf, OutData%nac, ErrStat2, ErrMsg2 ) ! nac - 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 AD_Dvr_Unpacktwrdata( Re_Buf, Db_Buf, Int_Buf, OutData%twr, ErrStat2, ErrMsg2 ) ! twr - 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%numBlades = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%basicHAWTFormat = TRANSFER(IntKiBuf(Int_Xferred), OutData%basicHAWTFormat) - Int_Xferred = Int_Xferred + 1 - OutData%hasTower = TRANSFER(IntKiBuf(Int_Xferred), OutData%hasTower) - Int_Xferred = Int_Xferred + 1 - OutData%projMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%BEM_Mod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%HAWTprojection = TRANSFER(IntKiBuf(Int_Xferred), OutData%HAWTprojection) - Int_Xferred = Int_Xferred + 1 - OutData%motionType = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! motion not allocated - Int_Xferred = Int_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%motion)) DEALLOCATE(OutData%motion) - ALLOCATE(OutData%motion(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%motion.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%motion,2), UBOUND(OutData%motion,2) - DO i1 = LBOUND(OutData%motion,1), UBOUND(OutData%motion,1) - OutData%motion(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%iMotion = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%degreeOfFreedom = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%amplitude = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%frequency = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(OutData%motionFileName) - OutData%motionFileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - 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 ! userSwapArray not allocated - Int_Xferred = Int_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%userSwapArray)) DEALLOCATE(OutData%userSwapArray) - ALLOCATE(OutData%userSwapArray(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%userSwapArray.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%userSwapArray,1), UBOUND(OutData%userSwapArray,1) - OutData%userSwapArray(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE AD_Dvr_UnPackWTData - - SUBROUTINE AD_Dvr_CopyDvr_SimData( SrcDvr_SimDataData, DstDvr_SimDataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Dvr_SimData), INTENT(INOUT) :: SrcDvr_SimDataData - TYPE(Dvr_SimData), INTENT(INOUT) :: DstDvr_SimDataData - 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 = 'AD_Dvr_CopyDvr_SimData' -! + ErrMsg = '' + DstBladeDataData%pitch = SrcBladeDataData%pitch + DstBladeDataData%pitchSpeed = SrcBladeDataData%pitchSpeed + DstBladeDataData%pitchAcc = SrcBladeDataData%pitchAcc + DstBladeDataData%origin_h = SrcBladeDataData%origin_h + DstBladeDataData%orientation_h = SrcBladeDataData%orientation_h + DstBladeDataData%hubRad_bl = SrcBladeDataData%hubRad_bl + DstBladeDataData%Rh2bl0 = SrcBladeDataData%Rh2bl0 + DstBladeDataData%motionType = SrcBladeDataData%motionType + DstBladeDataData%iMotion = SrcBladeDataData%iMotion + if (allocated(SrcBladeDataData%motion)) then + LB(1:2) = lbound(SrcBladeDataData%motion) + UB(1:2) = ubound(SrcBladeDataData%motion) + if (.not. allocated(DstBladeDataData%motion)) then + allocate(DstBladeDataData%motion(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladeDataData%motion.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladeDataData%motion = SrcBladeDataData%motion + end if + DstBladeDataData%motionFileName = SrcBladeDataData%motionFileName +end subroutine + +subroutine AD_Dvr_DestroyBladeData(BladeDataData, ErrStat, ErrMsg) + type(BladeData), intent(inout) :: BladeDataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD_Dvr_DestroyBladeData' ErrStat = ErrID_None - ErrMsg = "" - DstDvr_SimDataData%AD_InputFile = SrcDvr_SimDataData%AD_InputFile - DstDvr_SimDataData%MHK = SrcDvr_SimDataData%MHK - DstDvr_SimDataData%AnalysisType = SrcDvr_SimDataData%AnalysisType - DstDvr_SimDataData%FldDens = SrcDvr_SimDataData%FldDens - DstDvr_SimDataData%KinVisc = SrcDvr_SimDataData%KinVisc - DstDvr_SimDataData%SpdSound = SrcDvr_SimDataData%SpdSound - DstDvr_SimDataData%Patm = SrcDvr_SimDataData%Patm - DstDvr_SimDataData%Pvap = SrcDvr_SimDataData%Pvap - DstDvr_SimDataData%WtrDpth = SrcDvr_SimDataData%WtrDpth - DstDvr_SimDataData%MSL2SWL = SrcDvr_SimDataData%MSL2SWL - DstDvr_SimDataData%numTurbines = SrcDvr_SimDataData%numTurbines -IF (ALLOCATED(SrcDvr_SimDataData%WT)) THEN - i1_l = LBOUND(SrcDvr_SimDataData%WT,1) - i1_u = UBOUND(SrcDvr_SimDataData%WT,1) - IF (.NOT. ALLOCATED(DstDvr_SimDataData%WT)) THEN - ALLOCATE(DstDvr_SimDataData%WT(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDvr_SimDataData%WT.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcDvr_SimDataData%WT,1), UBOUND(SrcDvr_SimDataData%WT,1) - CALL AD_Dvr_Copywtdata( SrcDvr_SimDataData%WT(i1), DstDvr_SimDataData%WT(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - DstDvr_SimDataData%dT = SrcDvr_SimDataData%dT - DstDvr_SimDataData%tMax = SrcDvr_SimDataData%tMax - DstDvr_SimDataData%numSteps = SrcDvr_SimDataData%numSteps - DstDvr_SimDataData%numCases = SrcDvr_SimDataData%numCases -IF (ALLOCATED(SrcDvr_SimDataData%Cases)) THEN - i1_l = LBOUND(SrcDvr_SimDataData%Cases,1) - i1_u = UBOUND(SrcDvr_SimDataData%Cases,1) - IF (.NOT. ALLOCATED(DstDvr_SimDataData%Cases)) THEN - ALLOCATE(DstDvr_SimDataData%Cases(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDvr_SimDataData%Cases.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcDvr_SimDataData%Cases,1), UBOUND(SrcDvr_SimDataData%Cases,1) - CALL AD_Dvr_Copydvr_case( SrcDvr_SimDataData%Cases(i1), DstDvr_SimDataData%Cases(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - DstDvr_SimDataData%iCase = SrcDvr_SimDataData%iCase -IF (ALLOCATED(SrcDvr_SimDataData%timeSeries)) THEN - i1_l = LBOUND(SrcDvr_SimDataData%timeSeries,1) - i1_u = UBOUND(SrcDvr_SimDataData%timeSeries,1) - i2_l = LBOUND(SrcDvr_SimDataData%timeSeries,2) - i2_u = UBOUND(SrcDvr_SimDataData%timeSeries,2) - IF (.NOT. ALLOCATED(DstDvr_SimDataData%timeSeries)) THEN - ALLOCATE(DstDvr_SimDataData%timeSeries(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDvr_SimDataData%timeSeries.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDvr_SimDataData%timeSeries = SrcDvr_SimDataData%timeSeries -ENDIF - DstDvr_SimDataData%iTimeSeries = SrcDvr_SimDataData%iTimeSeries - DstDvr_SimDataData%root = SrcDvr_SimDataData%root - CALL AD_Dvr_Copydvr_outputs( SrcDvr_SimDataData%out, DstDvr_SimDataData%out, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL ADI_Copyiw_inputdata( SrcDvr_SimDataData%IW_InitInp, DstDvr_SimDataData%IW_InitInp, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE AD_Dvr_CopyDvr_SimData - - SUBROUTINE AD_Dvr_DestroyDvr_SimData( Dvr_SimDataData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(Dvr_SimData), INTENT(INOUT) :: Dvr_SimDataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_DestroyDvr_SimData' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(Dvr_SimDataData%WT)) THEN -DO i1 = LBOUND(Dvr_SimDataData%WT,1), UBOUND(Dvr_SimDataData%WT,1) - CALL AD_Dvr_Destroywtdata( Dvr_SimDataData%WT(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(Dvr_SimDataData%WT) -ENDIF -IF (ALLOCATED(Dvr_SimDataData%Cases)) THEN -DO i1 = LBOUND(Dvr_SimDataData%Cases,1), UBOUND(Dvr_SimDataData%Cases,1) - CALL AD_Dvr_Destroydvr_case( Dvr_SimDataData%Cases(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(Dvr_SimDataData%Cases) -ENDIF -IF (ALLOCATED(Dvr_SimDataData%timeSeries)) THEN - DEALLOCATE(Dvr_SimDataData%timeSeries) -ENDIF - CALL AD_Dvr_Destroydvr_outputs( Dvr_SimDataData%out, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL ADI_Destroyiw_inputdata( Dvr_SimDataData%IW_InitInp, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE AD_Dvr_DestroyDvr_SimData - - SUBROUTINE AD_Dvr_PackDvr_SimData( 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(Dvr_SimData), 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 = 'AD_Dvr_PackDvr_SimData' - ! 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%AD_InputFile) ! AD_InputFile - Int_BufSz = Int_BufSz + 1 ! MHK - Int_BufSz = Int_BufSz + 1 ! AnalysisType - Re_BufSz = Re_BufSz + 1 ! FldDens - Re_BufSz = Re_BufSz + 1 ! KinVisc - Re_BufSz = Re_BufSz + 1 ! SpdSound - Re_BufSz = Re_BufSz + 1 ! Patm - Re_BufSz = Re_BufSz + 1 ! Pvap - Re_BufSz = Re_BufSz + 1 ! WtrDpth - Re_BufSz = Re_BufSz + 1 ! MSL2SWL - Int_BufSz = Int_BufSz + 1 ! numTurbines - Int_BufSz = Int_BufSz + 1 ! WT allocated yes/no - IF ( ALLOCATED(InData%WT) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WT upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%WT,1), UBOUND(InData%WT,1) - Int_BufSz = Int_BufSz + 3 ! WT: size of buffers for each call to pack subtype - CALL AD_Dvr_Packwtdata( Re_Buf, Db_Buf, Int_Buf, InData%WT(i1), ErrStat2, ErrMsg2, .TRUE. ) ! WT - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! WT - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! WT - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! WT - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Db_BufSz = Db_BufSz + 1 ! dT - Db_BufSz = Db_BufSz + 1 ! tMax - Int_BufSz = Int_BufSz + 1 ! numSteps - Int_BufSz = Int_BufSz + 1 ! numCases - Int_BufSz = Int_BufSz + 1 ! Cases allocated yes/no - IF ( ALLOCATED(InData%Cases) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Cases upper/lower bounds for each dimension - DO i1 = LBOUND(InData%Cases,1), UBOUND(InData%Cases,1) - Int_BufSz = Int_BufSz + 3 ! Cases: size of buffers for each call to pack subtype - CALL AD_Dvr_Packdvr_case( Re_Buf, Db_Buf, Int_Buf, InData%Cases(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Cases - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Cases - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Cases - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Cases - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! iCase - Int_BufSz = Int_BufSz + 1 ! timeSeries allocated yes/no - IF ( ALLOCATED(InData%timeSeries) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! timeSeries upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%timeSeries) ! timeSeries - END IF - Int_BufSz = Int_BufSz + 1 ! iTimeSeries - Int_BufSz = Int_BufSz + 1*LEN(InData%root) ! root - Int_BufSz = Int_BufSz + 3 ! out: size of buffers for each call to pack subtype - CALL AD_Dvr_Packdvr_outputs( Re_Buf, Db_Buf, Int_Buf, InData%out, ErrStat2, ErrMsg2, .TRUE. ) ! out - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! out - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! out - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! out - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! IW_InitInp: size of buffers for each call to pack subtype - CALL ADI_Packiw_inputdata( Re_Buf, Db_Buf, Int_Buf, InData%IW_InitInp, ErrStat2, ErrMsg2, .TRUE. ) ! IW_InitInp - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! IW_InitInp - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! IW_InitInp - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! IW_InitInp - 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%AD_InputFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%AD_InputFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = InData%MHK - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%AnalysisType - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%FldDens - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%KinVisc - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%SpdSound - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Patm - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Pvap - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WtrDpth - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MSL2SWL - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%numTurbines - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%WT) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WT,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WT,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WT,1), UBOUND(InData%WT,1) - CALL AD_Dvr_Packwtdata( Re_Buf, Db_Buf, Int_Buf, InData%WT(i1), ErrStat2, ErrMsg2, OnlySize ) ! WT - 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 - DbKiBuf(Db_Xferred) = InData%dT - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%tMax - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%numSteps - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%numCases - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%Cases) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Cases,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cases,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Cases,1), UBOUND(InData%Cases,1) - CALL AD_Dvr_Packdvr_case( Re_Buf, Db_Buf, Int_Buf, InData%Cases(i1), ErrStat2, ErrMsg2, OnlySize ) ! Cases - 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%iCase - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%timeSeries) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%timeSeries,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%timeSeries,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%timeSeries,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%timeSeries,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%timeSeries,2), UBOUND(InData%timeSeries,2) - DO i1 = LBOUND(InData%timeSeries,1), UBOUND(InData%timeSeries,1) - ReKiBuf(Re_Xferred) = InData%timeSeries(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%iTimeSeries - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%root) - IntKiBuf(Int_Xferred) = ICHAR(InData%root(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - CALL AD_Dvr_Packdvr_outputs( Re_Buf, Db_Buf, Int_Buf, InData%out, ErrStat2, ErrMsg2, OnlySize ) ! out - 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 ADI_Packiw_inputdata( Re_Buf, Db_Buf, Int_Buf, InData%IW_InitInp, ErrStat2, ErrMsg2, OnlySize ) ! IW_InitInp - 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 AD_Dvr_PackDvr_SimData - - SUBROUTINE AD_Dvr_UnPackDvr_SimData( 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(Dvr_SimData), 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 = 'AD_Dvr_UnPackDvr_SimData' - ! 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%AD_InputFile) - OutData%AD_InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%MHK = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%AnalysisType = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%FldDens = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%KinVisc = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SpdSound = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Patm = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Pvap = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%WtrDpth = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MSL2SWL = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%numTurbines = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WT not allocated - Int_Xferred = Int_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%WT)) DEALLOCATE(OutData%WT) - ALLOCATE(OutData%WT(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WT.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WT,1), UBOUND(OutData%WT,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 AD_Dvr_Unpackwtdata( Re_Buf, Db_Buf, Int_Buf, OutData%WT(i1), ErrStat2, ErrMsg2 ) ! WT - 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%dT = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%tMax = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%numSteps = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%numCases = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Cases not allocated - Int_Xferred = Int_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%Cases)) DEALLOCATE(OutData%Cases) - ALLOCATE(OutData%Cases(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cases.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Cases,1), UBOUND(OutData%Cases,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 AD_Dvr_Unpackdvr_case( Re_Buf, Db_Buf, Int_Buf, OutData%Cases(i1), ErrStat2, ErrMsg2 ) ! Cases - 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%iCase = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! timeSeries not allocated - Int_Xferred = Int_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%timeSeries)) DEALLOCATE(OutData%timeSeries) - ALLOCATE(OutData%timeSeries(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%timeSeries.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%timeSeries,2), UBOUND(OutData%timeSeries,2) - DO i1 = LBOUND(OutData%timeSeries,1), UBOUND(OutData%timeSeries,1) - OutData%timeSeries(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%iTimeSeries = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%root) - OutData%root(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - 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 AD_Dvr_Unpackdvr_outputs( Re_Buf, Db_Buf, Int_Buf, OutData%out, ErrStat2, ErrMsg2 ) ! out - 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 ADI_Unpackiw_inputdata( Re_Buf, Db_Buf, Int_Buf, OutData%IW_InitInp, ErrStat2, ErrMsg2 ) ! IW_InitInp - 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 AD_Dvr_UnPackDvr_SimData - - SUBROUTINE AD_Dvr_CopyAllData( SrcAllDataData, DstAllDataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AllData), INTENT(INOUT) :: SrcAllDataData - TYPE(AllData), INTENT(INOUT) :: DstAllDataData - 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 = 'AD_Dvr_CopyAllData' -! + ErrMsg = '' + if (allocated(BladeDataData%motion)) then + deallocate(BladeDataData%motion) + end if +end subroutine + +subroutine AD_Dvr_PackBladeData(RF, Indata) + type(RegFile), intent(inout) :: RF + type(BladeData), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_Dvr_PackBladeData' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%pitch) + call RegPack(RF, InData%pitchSpeed) + call RegPack(RF, InData%pitchAcc) + call RegPack(RF, InData%origin_h) + call RegPack(RF, InData%orientation_h) + call RegPack(RF, InData%hubRad_bl) + call RegPack(RF, InData%Rh2bl0) + call RegPack(RF, InData%motionType) + call RegPack(RF, InData%iMotion) + call RegPackAlloc(RF, InData%motion) + call RegPack(RF, InData%motionFileName) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AD_Dvr_UnPackBladeData(RF, OutData) + type(RegFile), intent(inout) :: RF + type(BladeData), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_Dvr_UnPackBladeData' + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%pitch); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%pitchSpeed); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%pitchAcc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%origin_h); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%orientation_h); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%hubRad_bl); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Rh2bl0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%motionType); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iMotion); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%motion); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%motionFileName); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AD_Dvr_CopyHubData(SrcHubDataData, DstHubDataData, CtrlCode, ErrStat, ErrMsg) + type(HubData), intent(in) :: SrcHubDataData + type(HubData), intent(inout) :: DstHubDataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'AD_Dvr_CopyHubData' ErrStat = ErrID_None - ErrMsg = "" - CALL AD_Dvr_Copydvr_simdata( SrcAllDataData%dvr, DstAllDataData%dvr, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL ADI_Copydata( SrcAllDataData%ADI, DstAllDataData%ADI, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL ADI_Copyfed_data( SrcAllDataData%FED, DstAllDataData%FED, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstAllDataData%errStat = SrcAllDataData%errStat - DstAllDataData%errMsg = SrcAllDataData%errMsg - DstAllDataData%initialized = SrcAllDataData%initialized - END SUBROUTINE AD_Dvr_CopyAllData - - SUBROUTINE AD_Dvr_DestroyAllData( AllDataData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(AllData), INTENT(INOUT) :: AllDataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_DestroyAllData' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL AD_Dvr_Destroydvr_simdata( AllDataData%dvr, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL ADI_Destroydata( AllDataData%ADI, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL ADI_Destroyfed_data( AllDataData%FED, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE AD_Dvr_DestroyAllData - - SUBROUTINE AD_Dvr_PackAllData( 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(AllData), 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 = 'AD_Dvr_PackAllData' - ! 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 ! dvr: size of buffers for each call to pack subtype - CALL AD_Dvr_Packdvr_simdata( Re_Buf, Db_Buf, Int_Buf, InData%dvr, ErrStat2, ErrMsg2, .TRUE. ) ! dvr - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! dvr - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! dvr - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! dvr - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! ADI: size of buffers for each call to pack subtype - CALL ADI_Packdata( Re_Buf, Db_Buf, Int_Buf, InData%ADI, ErrStat2, ErrMsg2, .TRUE. ) ! ADI - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! ADI - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! ADI - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! ADI - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! FED: size of buffers for each call to pack subtype - CALL ADI_Packfed_data( Re_Buf, Db_Buf, Int_Buf, InData%FED, ErrStat2, ErrMsg2, .TRUE. ) ! FED - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! FED - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! FED - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! FED - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! errStat - Int_BufSz = Int_BufSz + 1*LEN(InData%errMsg) ! errMsg - Int_BufSz = Int_BufSz + 1 ! initialized - 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 AD_Dvr_Packdvr_simdata( Re_Buf, Db_Buf, Int_Buf, InData%dvr, ErrStat2, ErrMsg2, OnlySize ) ! dvr - 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 ADI_Packdata( Re_Buf, Db_Buf, Int_Buf, InData%ADI, ErrStat2, ErrMsg2, OnlySize ) ! ADI - 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 ADI_Packfed_data( Re_Buf, Db_Buf, Int_Buf, InData%FED, ErrStat2, ErrMsg2, OnlySize ) ! FED - 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%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 - IntKiBuf(Int_Xferred) = TRANSFER(InData%initialized, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE AD_Dvr_PackAllData - - SUBROUTINE AD_Dvr_UnPackAllData( 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(AllData), 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 = 'AD_Dvr_UnPackAllData' - ! 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 AD_Dvr_Unpackdvr_simdata( Re_Buf, Db_Buf, Int_Buf, OutData%dvr, ErrStat2, ErrMsg2 ) ! dvr - 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 ADI_Unpackdata( Re_Buf, Db_Buf, Int_Buf, OutData%ADI, ErrStat2, ErrMsg2 ) ! ADI - 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 ADI_Unpackfed_data( Re_Buf, Db_Buf, Int_Buf, OutData%FED, ErrStat2, ErrMsg2 ) ! FED - 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%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%initialized = TRANSFER(IntKiBuf(Int_Xferred), OutData%initialized) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE AD_Dvr_UnPackAllData - + ErrMsg = '' + DstHubDataData%origin_n = SrcHubDataData%origin_n + DstHubDataData%orientation_n = SrcHubDataData%orientation_n + DstHubDataData%motionType = SrcHubDataData%motionType + DstHubDataData%iMotion = SrcHubDataData%iMotion + DstHubDataData%azimuth = SrcHubDataData%azimuth + DstHubDataData%rotSpeed = SrcHubDataData%rotSpeed + DstHubDataData%rotAcc = SrcHubDataData%rotAcc + DstHubDataData%motionFileName = SrcHubDataData%motionFileName + if (allocated(SrcHubDataData%motion)) then + LB(1:2) = lbound(SrcHubDataData%motion) + UB(1:2) = ubound(SrcHubDataData%motion) + if (.not. allocated(DstHubDataData%motion)) then + allocate(DstHubDataData%motion(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstHubDataData%motion.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstHubDataData%motion = SrcHubDataData%motion + end if +end subroutine + +subroutine AD_Dvr_DestroyHubData(HubDataData, ErrStat, ErrMsg) + type(HubData), intent(inout) :: HubDataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD_Dvr_DestroyHubData' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(HubDataData%motion)) then + deallocate(HubDataData%motion) + end if +end subroutine + +subroutine AD_Dvr_PackHubData(RF, Indata) + type(RegFile), intent(inout) :: RF + type(HubData), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_Dvr_PackHubData' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%origin_n) + call RegPack(RF, InData%orientation_n) + call RegPack(RF, InData%motionType) + call RegPack(RF, InData%iMotion) + call RegPack(RF, InData%azimuth) + call RegPack(RF, InData%rotSpeed) + call RegPack(RF, InData%rotAcc) + call RegPack(RF, InData%motionFileName) + call RegPackAlloc(RF, InData%motion) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AD_Dvr_UnPackHubData(RF, OutData) + type(RegFile), intent(inout) :: RF + type(HubData), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_Dvr_UnPackHubData' + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%origin_n); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%orientation_n); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%motionType); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iMotion); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%azimuth); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rotSpeed); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rotAcc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%motionFileName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%motion); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AD_Dvr_CopyNacData(SrcNacDataData, DstNacDataData, CtrlCode, ErrStat, ErrMsg) + type(NacData), intent(in) :: SrcNacDataData + type(NacData), intent(inout) :: DstNacDataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'AD_Dvr_CopyNacData' + ErrStat = ErrID_None + ErrMsg = '' + DstNacDataData%origin_t = SrcNacDataData%origin_t + DstNacDataData%motionType = SrcNacDataData%motionType + DstNacDataData%iMotion = SrcNacDataData%iMotion + DstNacDataData%yaw = SrcNacDataData%yaw + DstNacDataData%yawSpeed = SrcNacDataData%yawSpeed + DstNacDataData%yawAcc = SrcNacDataData%yawAcc + DstNacDataData%motionFileName = SrcNacDataData%motionFileName + if (allocated(SrcNacDataData%motion)) then + LB(1:2) = lbound(SrcNacDataData%motion) + UB(1:2) = ubound(SrcNacDataData%motion) + if (.not. allocated(DstNacDataData%motion)) then + allocate(DstNacDataData%motion(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstNacDataData%motion.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstNacDataData%motion = SrcNacDataData%motion + end if +end subroutine + +subroutine AD_Dvr_DestroyNacData(NacDataData, ErrStat, ErrMsg) + type(NacData), intent(inout) :: NacDataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD_Dvr_DestroyNacData' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(NacDataData%motion)) then + deallocate(NacDataData%motion) + end if +end subroutine + +subroutine AD_Dvr_PackNacData(RF, Indata) + type(RegFile), intent(inout) :: RF + type(NacData), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_Dvr_PackNacData' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%origin_t) + call RegPack(RF, InData%motionType) + call RegPack(RF, InData%iMotion) + call RegPack(RF, InData%yaw) + call RegPack(RF, InData%yawSpeed) + call RegPack(RF, InData%yawAcc) + call RegPack(RF, InData%motionFileName) + call RegPackAlloc(RF, InData%motion) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AD_Dvr_UnPackNacData(RF, OutData) + type(RegFile), intent(inout) :: RF + type(NacData), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_Dvr_UnPackNacData' + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%origin_t); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%motionType); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iMotion); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%yaw); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%yawSpeed); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%yawAcc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%motionFileName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%motion); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AD_Dvr_CopyTwrData(SrcTwrDataData, DstTwrDataData, CtrlCode, ErrStat, ErrMsg) + type(TwrData), intent(in) :: SrcTwrDataData + type(TwrData), intent(inout) :: DstTwrDataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD_Dvr_CopyTwrData' + ErrStat = ErrID_None + ErrMsg = '' + DstTwrDataData%origin_t = SrcTwrDataData%origin_t +end subroutine + +subroutine AD_Dvr_DestroyTwrData(TwrDataData, ErrStat, ErrMsg) + type(TwrData), intent(inout) :: TwrDataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD_Dvr_DestroyTwrData' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine AD_Dvr_PackTwrData(RF, Indata) + type(RegFile), intent(inout) :: RF + type(TwrData), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_Dvr_PackTwrData' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%origin_t) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AD_Dvr_UnPackTwrData(RF, OutData) + type(RegFile), intent(inout) :: RF + type(TwrData), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_Dvr_UnPackTwrData' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%origin_t); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AD_Dvr_CopyWTData(SrcWTDataData, DstWTDataData, CtrlCode, ErrStat, ErrMsg) + type(WTData), intent(inout) :: SrcWTDataData + type(WTData), intent(inout) :: DstWTDataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_Dvr_CopyWTData' + ErrStat = ErrID_None + ErrMsg = '' + DstWTDataData%originInit = SrcWTDataData%originInit + DstWTDataData%orientationInit = SrcWTDataData%orientationInit + call NWTC_Library_CopyMeshMapType(SrcWTDataData%map2twrPt, DstWTDataData%map2twrPt, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyMeshMapType(SrcWTDataData%map2nacPt, DstWTDataData%map2nacPt, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyMeshMapType(SrcWTDataData%map2hubPt, DstWTDataData%map2hubPt, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcWTDataData%map2BldPt)) then + LB(1:1) = lbound(SrcWTDataData%map2BldPt) + UB(1:1) = ubound(SrcWTDataData%map2BldPt) + if (.not. allocated(DstWTDataData%map2BldPt)) then + allocate(DstWTDataData%map2BldPt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWTDataData%map2BldPt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcWTDataData%map2BldPt(i1), DstWTDataData%map2BldPt(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcWTDataData%bld)) then + LB(1:1) = lbound(SrcWTDataData%bld) + UB(1:1) = ubound(SrcWTDataData%bld) + if (.not. allocated(DstWTDataData%bld)) then + allocate(DstWTDataData%bld(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWTDataData%bld.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AD_Dvr_CopyBladeData(SrcWTDataData%bld(i1), DstWTDataData%bld(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call AD_Dvr_CopyHubData(SrcWTDataData%hub, DstWTDataData%hub, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AD_Dvr_CopyNacData(SrcWTDataData%nac, DstWTDataData%nac, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AD_Dvr_CopyTwrData(SrcWTDataData%twr, DstWTDataData%twr, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstWTDataData%numBlades = SrcWTDataData%numBlades + DstWTDataData%basicHAWTFormat = SrcWTDataData%basicHAWTFormat + DstWTDataData%hasTower = SrcWTDataData%hasTower + DstWTDataData%projMod = SrcWTDataData%projMod + DstWTDataData%BEM_Mod = SrcWTDataData%BEM_Mod + DstWTDataData%HAWTprojection = SrcWTDataData%HAWTprojection + DstWTDataData%motionType = SrcWTDataData%motionType + if (allocated(SrcWTDataData%motion)) then + LB(1:2) = lbound(SrcWTDataData%motion) + UB(1:2) = ubound(SrcWTDataData%motion) + if (.not. allocated(DstWTDataData%motion)) then + allocate(DstWTDataData%motion(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWTDataData%motion.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWTDataData%motion = SrcWTDataData%motion + end if + DstWTDataData%iMotion = SrcWTDataData%iMotion + DstWTDataData%degreeOfFreedom = SrcWTDataData%degreeOfFreedom + DstWTDataData%amplitude = SrcWTDataData%amplitude + DstWTDataData%frequency = SrcWTDataData%frequency + DstWTDataData%motionFileName = SrcWTDataData%motionFileName + if (allocated(SrcWTDataData%WriteOutput)) then + LB(1:1) = lbound(SrcWTDataData%WriteOutput) + UB(1:1) = ubound(SrcWTDataData%WriteOutput) + if (.not. allocated(DstWTDataData%WriteOutput)) then + allocate(DstWTDataData%WriteOutput(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWTDataData%WriteOutput.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWTDataData%WriteOutput = SrcWTDataData%WriteOutput + end if + if (allocated(SrcWTDataData%userSwapArray)) then + LB(1:1) = lbound(SrcWTDataData%userSwapArray) + UB(1:1) = ubound(SrcWTDataData%userSwapArray) + if (.not. allocated(DstWTDataData%userSwapArray)) then + allocate(DstWTDataData%userSwapArray(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWTDataData%userSwapArray.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWTDataData%userSwapArray = SrcWTDataData%userSwapArray + end if +end subroutine + +subroutine AD_Dvr_DestroyWTData(WTDataData, ErrStat, ErrMsg) + type(WTData), intent(inout) :: WTDataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_Dvr_DestroyWTData' + ErrStat = ErrID_None + ErrMsg = '' + call NWTC_Library_DestroyMeshMapType(WTDataData%map2twrPt, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call NWTC_Library_DestroyMeshMapType(WTDataData%map2nacPt, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call NWTC_Library_DestroyMeshMapType(WTDataData%map2hubPt, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(WTDataData%map2BldPt)) then + LB(1:1) = lbound(WTDataData%map2BldPt) + UB(1:1) = ubound(WTDataData%map2BldPt) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(WTDataData%map2BldPt(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(WTDataData%map2BldPt) + end if + if (allocated(WTDataData%bld)) then + LB(1:1) = lbound(WTDataData%bld) + UB(1:1) = ubound(WTDataData%bld) + do i1 = LB(1), UB(1) + call AD_Dvr_DestroyBladeData(WTDataData%bld(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(WTDataData%bld) + end if + call AD_Dvr_DestroyHubData(WTDataData%hub, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AD_Dvr_DestroyNacData(WTDataData%nac, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AD_Dvr_DestroyTwrData(WTDataData%twr, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(WTDataData%motion)) then + deallocate(WTDataData%motion) + end if + if (allocated(WTDataData%WriteOutput)) then + deallocate(WTDataData%WriteOutput) + end if + if (allocated(WTDataData%userSwapArray)) then + deallocate(WTDataData%userSwapArray) + end if +end subroutine + +subroutine AD_Dvr_PackWTData(RF, Indata) + type(RegFile), intent(inout) :: RF + type(WTData), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_Dvr_PackWTData' + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%originInit) + call RegPack(RF, InData%orientationInit) + call NWTC_Library_PackMeshMapType(RF, InData%map2twrPt) + call NWTC_Library_PackMeshMapType(RF, InData%map2nacPt) + call NWTC_Library_PackMeshMapType(RF, InData%map2hubPt) + call RegPack(RF, allocated(InData%map2BldPt)) + if (allocated(InData%map2BldPt)) then + call RegPackBounds(RF, 1, lbound(InData%map2BldPt), ubound(InData%map2BldPt)) + LB(1:1) = lbound(InData%map2BldPt) + UB(1:1) = ubound(InData%map2BldPt) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(RF, InData%map2BldPt(i1)) + end do + end if + call RegPack(RF, allocated(InData%bld)) + if (allocated(InData%bld)) then + call RegPackBounds(RF, 1, lbound(InData%bld), ubound(InData%bld)) + LB(1:1) = lbound(InData%bld) + UB(1:1) = ubound(InData%bld) + do i1 = LB(1), UB(1) + call AD_Dvr_PackBladeData(RF, InData%bld(i1)) + end do + end if + call AD_Dvr_PackHubData(RF, InData%hub) + call AD_Dvr_PackNacData(RF, InData%nac) + call AD_Dvr_PackTwrData(RF, InData%twr) + call RegPack(RF, InData%numBlades) + call RegPack(RF, InData%basicHAWTFormat) + call RegPack(RF, InData%hasTower) + call RegPack(RF, InData%projMod) + call RegPack(RF, InData%BEM_Mod) + call RegPack(RF, InData%HAWTprojection) + call RegPack(RF, InData%motionType) + call RegPackAlloc(RF, InData%motion) + call RegPack(RF, InData%iMotion) + call RegPack(RF, InData%degreeOfFreedom) + call RegPack(RF, InData%amplitude) + call RegPack(RF, InData%frequency) + call RegPack(RF, InData%motionFileName) + call RegPackAlloc(RF, InData%WriteOutput) + call RegPackAlloc(RF, InData%userSwapArray) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AD_Dvr_UnPackWTData(RF, OutData) + type(RegFile), intent(inout) :: RF + type(WTData), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_Dvr_UnPackWTData' + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%originInit); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%orientationInit); if (RegCheckErr(RF, RoutineName)) return + call NWTC_Library_UnpackMeshMapType(RF, OutData%map2twrPt) ! map2twrPt + call NWTC_Library_UnpackMeshMapType(RF, OutData%map2nacPt) ! map2nacPt + call NWTC_Library_UnpackMeshMapType(RF, OutData%map2hubPt) ! map2hubPt + if (allocated(OutData%map2BldPt)) deallocate(OutData%map2BldPt) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%map2BldPt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%map2BldPt.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(RF, OutData%map2BldPt(i1)) ! map2BldPt + end do + end if + if (allocated(OutData%bld)) deallocate(OutData%bld) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%bld(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%bld.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AD_Dvr_UnpackBladeData(RF, OutData%bld(i1)) ! bld + end do + end if + call AD_Dvr_UnpackHubData(RF, OutData%hub) ! hub + call AD_Dvr_UnpackNacData(RF, OutData%nac) ! nac + call AD_Dvr_UnpackTwrData(RF, OutData%twr) ! twr + call RegUnpack(RF, OutData%numBlades); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%basicHAWTFormat); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%hasTower); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%projMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BEM_Mod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HAWTprojection); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%motionType); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%motion); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iMotion); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%degreeOfFreedom); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%amplitude); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%frequency); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%motionFileName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WriteOutput); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%userSwapArray); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AD_Dvr_CopyDvr_SimData(SrcDvr_SimDataData, DstDvr_SimDataData, CtrlCode, ErrStat, ErrMsg) + type(Dvr_SimData), intent(inout) :: SrcDvr_SimDataData + type(Dvr_SimData), intent(inout) :: DstDvr_SimDataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_Dvr_CopyDvr_SimData' + ErrStat = ErrID_None + ErrMsg = '' + DstDvr_SimDataData%AD_InputFile = SrcDvr_SimDataData%AD_InputFile + DstDvr_SimDataData%MHK = SrcDvr_SimDataData%MHK + DstDvr_SimDataData%AnalysisType = SrcDvr_SimDataData%AnalysisType + DstDvr_SimDataData%FldDens = SrcDvr_SimDataData%FldDens + DstDvr_SimDataData%KinVisc = SrcDvr_SimDataData%KinVisc + DstDvr_SimDataData%SpdSound = SrcDvr_SimDataData%SpdSound + DstDvr_SimDataData%Patm = SrcDvr_SimDataData%Patm + DstDvr_SimDataData%Pvap = SrcDvr_SimDataData%Pvap + DstDvr_SimDataData%WtrDpth = SrcDvr_SimDataData%WtrDpth + DstDvr_SimDataData%MSL2SWL = SrcDvr_SimDataData%MSL2SWL + DstDvr_SimDataData%numTurbines = SrcDvr_SimDataData%numTurbines + if (allocated(SrcDvr_SimDataData%WT)) then + LB(1:1) = lbound(SrcDvr_SimDataData%WT) + UB(1:1) = ubound(SrcDvr_SimDataData%WT) + if (.not. allocated(DstDvr_SimDataData%WT)) then + allocate(DstDvr_SimDataData%WT(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDvr_SimDataData%WT.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AD_Dvr_CopyWTData(SrcDvr_SimDataData%WT(i1), DstDvr_SimDataData%WT(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + DstDvr_SimDataData%dT = SrcDvr_SimDataData%dT + DstDvr_SimDataData%tMax = SrcDvr_SimDataData%tMax + DstDvr_SimDataData%numSteps = SrcDvr_SimDataData%numSteps + DstDvr_SimDataData%numCases = SrcDvr_SimDataData%numCases + if (allocated(SrcDvr_SimDataData%Cases)) then + LB(1:1) = lbound(SrcDvr_SimDataData%Cases) + UB(1:1) = ubound(SrcDvr_SimDataData%Cases) + if (.not. allocated(DstDvr_SimDataData%Cases)) then + allocate(DstDvr_SimDataData%Cases(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDvr_SimDataData%Cases.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AD_Dvr_CopyDvr_Case(SrcDvr_SimDataData%Cases(i1), DstDvr_SimDataData%Cases(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + DstDvr_SimDataData%iCase = SrcDvr_SimDataData%iCase + if (allocated(SrcDvr_SimDataData%timeSeries)) then + LB(1:2) = lbound(SrcDvr_SimDataData%timeSeries) + UB(1:2) = ubound(SrcDvr_SimDataData%timeSeries) + if (.not. allocated(DstDvr_SimDataData%timeSeries)) then + allocate(DstDvr_SimDataData%timeSeries(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDvr_SimDataData%timeSeries.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDvr_SimDataData%timeSeries = SrcDvr_SimDataData%timeSeries + end if + DstDvr_SimDataData%iTimeSeries = SrcDvr_SimDataData%iTimeSeries + DstDvr_SimDataData%root = SrcDvr_SimDataData%root + call AD_Dvr_CopyDvr_Outputs(SrcDvr_SimDataData%out, DstDvr_SimDataData%out, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call ADI_CopyIW_InputData(SrcDvr_SimDataData%IW_InitInp, DstDvr_SimDataData%IW_InitInp, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine AD_Dvr_DestroyDvr_SimData(Dvr_SimDataData, ErrStat, ErrMsg) + type(Dvr_SimData), intent(inout) :: Dvr_SimDataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_Dvr_DestroyDvr_SimData' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(Dvr_SimDataData%WT)) then + LB(1:1) = lbound(Dvr_SimDataData%WT) + UB(1:1) = ubound(Dvr_SimDataData%WT) + do i1 = LB(1), UB(1) + call AD_Dvr_DestroyWTData(Dvr_SimDataData%WT(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(Dvr_SimDataData%WT) + end if + if (allocated(Dvr_SimDataData%Cases)) then + LB(1:1) = lbound(Dvr_SimDataData%Cases) + UB(1:1) = ubound(Dvr_SimDataData%Cases) + do i1 = LB(1), UB(1) + call AD_Dvr_DestroyDvr_Case(Dvr_SimDataData%Cases(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(Dvr_SimDataData%Cases) + end if + if (allocated(Dvr_SimDataData%timeSeries)) then + deallocate(Dvr_SimDataData%timeSeries) + end if + call AD_Dvr_DestroyDvr_Outputs(Dvr_SimDataData%out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call ADI_DestroyIW_InputData(Dvr_SimDataData%IW_InitInp, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine AD_Dvr_PackDvr_SimData(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Dvr_SimData), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_Dvr_PackDvr_SimData' + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%AD_InputFile) + call RegPack(RF, InData%MHK) + call RegPack(RF, InData%AnalysisType) + call RegPack(RF, InData%FldDens) + call RegPack(RF, InData%KinVisc) + call RegPack(RF, InData%SpdSound) + call RegPack(RF, InData%Patm) + call RegPack(RF, InData%Pvap) + call RegPack(RF, InData%WtrDpth) + call RegPack(RF, InData%MSL2SWL) + call RegPack(RF, InData%numTurbines) + call RegPack(RF, allocated(InData%WT)) + if (allocated(InData%WT)) then + call RegPackBounds(RF, 1, lbound(InData%WT), ubound(InData%WT)) + LB(1:1) = lbound(InData%WT) + UB(1:1) = ubound(InData%WT) + do i1 = LB(1), UB(1) + call AD_Dvr_PackWTData(RF, InData%WT(i1)) + end do + end if + call RegPack(RF, InData%dT) + call RegPack(RF, InData%tMax) + call RegPack(RF, InData%numSteps) + call RegPack(RF, InData%numCases) + call RegPack(RF, allocated(InData%Cases)) + if (allocated(InData%Cases)) then + call RegPackBounds(RF, 1, lbound(InData%Cases), ubound(InData%Cases)) + LB(1:1) = lbound(InData%Cases) + UB(1:1) = ubound(InData%Cases) + do i1 = LB(1), UB(1) + call AD_Dvr_PackDvr_Case(RF, InData%Cases(i1)) + end do + end if + call RegPack(RF, InData%iCase) + call RegPackAlloc(RF, InData%timeSeries) + call RegPack(RF, InData%iTimeSeries) + call RegPack(RF, InData%root) + call AD_Dvr_PackDvr_Outputs(RF, InData%out) + call ADI_PackIW_InputData(RF, InData%IW_InitInp) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AD_Dvr_UnPackDvr_SimData(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Dvr_SimData), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_Dvr_UnPackDvr_SimData' + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%AD_InputFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MHK); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AnalysisType); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FldDens); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%KinVisc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SpdSound); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Patm); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Pvap); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WtrDpth); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MSL2SWL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%numTurbines); if (RegCheckErr(RF, RoutineName)) return + if (allocated(OutData%WT)) deallocate(OutData%WT) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%WT(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WT.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AD_Dvr_UnpackWTData(RF, OutData%WT(i1)) ! WT + end do + end if + call RegUnpack(RF, OutData%dT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%tMax); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%numSteps); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%numCases); if (RegCheckErr(RF, RoutineName)) return + if (allocated(OutData%Cases)) deallocate(OutData%Cases) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%Cases(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cases.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AD_Dvr_UnpackDvr_Case(RF, OutData%Cases(i1)) ! Cases + end do + end if + call RegUnpack(RF, OutData%iCase); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%timeSeries); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iTimeSeries); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%root); if (RegCheckErr(RF, RoutineName)) return + call AD_Dvr_UnpackDvr_Outputs(RF, OutData%out) ! out + call ADI_UnpackIW_InputData(RF, OutData%IW_InitInp) ! IW_InitInp +end subroutine + +subroutine AD_Dvr_CopyAllData(SrcAllDataData, DstAllDataData, CtrlCode, ErrStat, ErrMsg) + type(AllData), intent(inout) :: SrcAllDataData + type(AllData), intent(inout) :: DstAllDataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_Dvr_CopyAllData' + ErrStat = ErrID_None + ErrMsg = '' + call AD_Dvr_CopyDvr_SimData(SrcAllDataData%dvr, DstAllDataData%dvr, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call ADI_CopyData(SrcAllDataData%ADI, DstAllDataData%ADI, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call ADI_CopyFED_Data(SrcAllDataData%FED, DstAllDataData%FED, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstAllDataData%errStat = SrcAllDataData%errStat + DstAllDataData%errMsg = SrcAllDataData%errMsg + DstAllDataData%initialized = SrcAllDataData%initialized +end subroutine + +subroutine AD_Dvr_DestroyAllData(AllDataData, ErrStat, ErrMsg) + type(AllData), intent(inout) :: AllDataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_Dvr_DestroyAllData' + ErrStat = ErrID_None + ErrMsg = '' + call AD_Dvr_DestroyDvr_SimData(AllDataData%dvr, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call ADI_DestroyData(AllDataData%ADI, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call ADI_DestroyFED_Data(AllDataData%FED, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine AD_Dvr_PackAllData(RF, Indata) + type(RegFile), intent(inout) :: RF + type(AllData), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_Dvr_PackAllData' + if (RF%ErrStat >= AbortErrLev) return + call AD_Dvr_PackDvr_SimData(RF, InData%dvr) + call ADI_PackData(RF, InData%ADI) + call ADI_PackFED_Data(RF, InData%FED) + call RegPack(RF, InData%errStat) + call RegPack(RF, InData%errMsg) + call RegPack(RF, InData%initialized) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AD_Dvr_UnPackAllData(RF, OutData) + type(RegFile), intent(inout) :: RF + type(AllData), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_Dvr_UnPackAllData' + if (RF%ErrStat /= ErrID_None) return + call AD_Dvr_UnpackDvr_SimData(RF, OutData%dvr) ! dvr + call ADI_UnpackData(RF, OutData%ADI) ! ADI + call ADI_UnpackFED_Data(RF, OutData%FED) ! FED + call RegUnpack(RF, OutData%errStat); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%errMsg); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%initialized); if (RegCheckErr(RF, RoutineName)) return +end subroutine END MODULE AeroDyn_Driver_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/aerodyn/src/AeroDyn_IO.f90 b/modules/aerodyn/src/AeroDyn_IO.f90 index 05b43ea325..a3e56406a7 100644 --- a/modules/aerodyn/src/AeroDyn_IO.f90 +++ b/modules/aerodyn/src/AeroDyn_IO.f90 @@ -83,11 +83,12 @@ END FUNCTION Calc_Chi0 !---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE Calc_WriteOutput( p, p_AD, u, x, m, m_AD, y, OtherState, xd, indx, iRot, ErrStat, ErrMsg ) +SUBROUTINE Calc_WriteOutput( p, p_AD, u, RotInflow, x, m, m_AD, y, OtherState, xd, indx, iRot, ErrStat, ErrMsg ) TYPE(RotParameterType), INTENT(IN ) :: p ! The rotor parameters TYPE(AD_ParameterType), INTENT(IN ) :: p_AD ! The module parameters TYPE(RotInputType), INTENT(IN ) :: u ! inputs + TYPE(RotInflowType), INTENT(IN ) :: RotInflow ! other states%RotInflow at t (for DBEMT and UA) TYPE(RotContinuousStateType), INTENT(IN ) :: x !< Continuous states at t TYPE(RotMiscVarType), INTENT(INOUT) :: m ! misc variables TYPE(AD_MiscVarType), INTENT(INOUT) :: m_AD ! misc variables @@ -119,11 +120,12 @@ SUBROUTINE Calc_WriteOutput( p, p_AD, u, x, m, m_AD, y, OtherState, xd, indx, iR ErrStat = ErrID_None ErrMsg = "" - tmpHubFB = 0.0_ReKi - tmpHubMB = 0.0_ReKi ! Compute max radius and rotor speed - if (p_AD%WakeMod /= WakeMod_FVW) then + if (p%NumBlades == 0) then + rmax = 0.0_ReKi + omega = 0.0_ReKi + elseif (p_AD%Wake_Mod /= WakeMod_FVW) then rmax = 0.0_ReKi do k=1,p%NumBlades do j=1,p%NumBlNds @@ -139,16 +141,15 @@ SUBROUTINE Calc_WriteOutput( p, p_AD, u, x, m, m_AD, y, OtherState, xd, indx, iR endif + ! Common outputs to all AeroDyn submodules call Calc_WriteOutput_AD() ! need to call this before calling the BEMT vs FVW versions of outputs so that the integrated output quantities are known - if (p_AD%WakeMod /= WakeMod_FVW) then + if (p_AD%Wake_Mod /= WakeMod_FVW) then call Calc_WriteOutput_BEMT() else call Calc_WriteOutput_FVW() endif - - ! set these for debugging ! m%AllOuts( Debug1 ) = 0.0_ReKi !TwoNorm( m%BEMT%u_SkewWake(1)%v_qsw ) ! m%AllOuts( Debug2 ) = 0.0_ReKi !TwoNorm( x%BEMT%v_w ) @@ -162,7 +163,7 @@ subroutine Calc_WriteOutput_AD() do beta=1,p%NTwOuts j = p%TwOutNd(beta) - tmp = matmul( u%TowerMotion%Orientation(:,:,j) , u%InflowOnTower(:,j) ) + tmp = matmul( u%TowerMotion%Orientation(:,:,j) , RotInflow%Tower%InflowVel(:,j) ) m%AllOuts( TwNVUnd(:,beta) ) = tmp tmp = matmul( u%TowerMotion%Orientation(:,:,j) , u%TowerMotion%TranslationVel(:,j) ) @@ -174,8 +175,12 @@ subroutine Calc_WriteOutput_AD() m%AllOuts( TwNM( beta) ) = m%W_Twr(j) / p%SpdSound ! Mach number m%AllOuts( TwNFdx( beta) ) = m%X_Twr(j) m%AllOuts( TwNFdy( beta) ) = m%Y_Twr(j) + end do ! out nodes - if ( p%Buoyancy ) then + if ( p%Buoyancy ) then + do beta=1,p%NTwOuts + j = p%TwOutNd(beta) + tmp = matmul( u%TowerMotion%Orientation(:,:,j) , m%TwrBuoyLoad%Force(:,j) ) m%AllOuts( TwNFbx(beta) ) = tmp(1) m%AllOuts( TwNFby(beta) ) = tmp(2) @@ -185,10 +190,9 @@ subroutine Calc_WriteOutput_AD() m%AllOuts( TwNMbx(beta) ) = tmp(1) m%AllOuts( TwNMby(beta) ) = tmp(2) m%AllOuts( TwNMbz(beta) ) = tmp(3) - end if - - end do ! out nodes - + end do + end if + ! hub outputs if ( p%Buoyancy ) then tmpHubFB = matmul( u%HubMotion%Orientation(:,:,1) , m%HubFB ) @@ -200,9 +204,12 @@ subroutine Calc_WriteOutput_AD() m%AllOuts( HbMbx ) = tmpHubMB(1) m%AllOuts( HbMby ) = tmpHubMB(2) m%AllOuts( HbMbz ) = tmpHubMB(3) + else + tmpHubFB = 0.0_ReKi ! initialize for integration later + tmpHubMB = 0.0_ReKi ! initialize for integration later end if - ! nacelle outputs + ! nacelle buoyancy outputs if ( p%Buoyancy ) then tmp = matmul( u%NacelleMotion%Orientation(:,:,1) , m%NacFB ) m%AllOuts( NcFbx ) = tmp(1) @@ -215,12 +222,40 @@ subroutine Calc_WriteOutput_AD() m%AllOuts( NcMbz ) = tmp(3) end if + ! nacelle drag outputs + if ( p%NacelleDrag ) then + + tmp = matmul( u%NacelleMotion%Orientation(:,:,1) , m%NacDragF ) + m%AllOuts( NcFdx ) = tmp(1) + m%AllOuts( NcFdy ) = tmp(2) + m%AllOuts( NcFdz ) = tmp(3) + + tmp = matmul( u%NacelleMotion%Orientation(:,:,1) , m%NacDragM ) + m%AllOuts( NcMdx ) = tmp(1) + m%AllOuts( NcMdy ) = tmp(2) + m%AllOuts( NcMdz ) = tmp(3) + end if + + ! nacelle total forces and moments + if ( p%Buoyancy .OR. p%NacelleDrag) then + + tmp = m%NacFi + m%AllOuts( NcFxi ) = tmp(1) + m%AllOuts( NcFyi ) = tmp(2) + m%AllOuts( NcFzi ) = tmp(3) + + tmp = m%NacMi + m%AllOuts( NcMxi ) = tmp(1) + m%AllOuts( NcMyi ) = tmp(2) + m%AllOuts( NcMzi ) = tmp(3) + end if + ! blade outputs do k=1,min(p%numBlades,AD_MaxBl_Out) ! limit this do beta=1,p%NBlOuts j=p%BlOutNd(beta) - tmp = matmul( m%orientationAnnulus(:,:,j,k), u%InflowOnBlade(:,j,k) ) + tmp = matmul( m%orientationAnnulus(:,:,j,k), RotInflow%Blade(k)%InflowVel(:,j) ) m%AllOuts( BNVUndx(beta,k) ) = tmp(1) m%AllOuts( BNVUndy(beta,k) ) = tmp(2) m%AllOuts( BNVUndz(beta,k) ) = tmp(3) @@ -235,12 +270,19 @@ subroutine Calc_WriteOutput_AD() m%AllOuts( BNSTVy( beta,k) ) = tmp(2) m%AllOuts( BNSTVz( beta,k) ) = tmp(3) - m%AllOuts( BNCurve(beta,k) ) = m%Curve(j,k)*R2D + m%AllOuts( BNCurve(beta,k) ) = m%Cant(j,k)*R2D m%AllOuts( BNSigCr( beta,k) ) = m%SigmaCavitCrit(j,k) m%AllOuts( BNSgCav( beta,k) ) = m%SigmaCavit(j,k) - if ( p%Buoyancy ) then + end do ! nodes + end do ! blades + + if ( p%Buoyancy ) then + do k=1,min(p%numBlades,AD_MaxBl_Out) ! limit this + do beta=1,p%NBlOuts + j=p%BlOutNd(beta) + tmp = matmul( u%BladeMotion(k)%Orientation(:,:,j), m%BladeBuoyLoad(k)%Force(:,j) ) m%AllOuts( BNFbn(beta,k) ) = tmp(1) m%AllOuts( BNFbt(beta,k) ) = tmp(2) @@ -250,13 +292,10 @@ subroutine Calc_WriteOutput_AD() m%AllOuts( BNMbn(beta,k) ) = tmp(1) m%AllOuts( BNMbt(beta,k) ) = tmp(2) m%AllOuts( BNMbs(beta,k) ) = tmp(3) - end if - - end do ! nodes - end do ! blades - - - + end do ! nodes + end do ! blades + end if + ! blade node tower clearance (requires tower influence calculation): if (p%TwrPotent /= TwrPotent_none .or. p%TwrShadow /= TwrShadow_none) then do k=1,min(p%numBlades,AD_MaxBl_Out) @@ -343,15 +382,14 @@ subroutine Calc_WriteOutput_AD() end do ! k=blades ! rotor outputs - if ( EqualRealNos( real(m%V_dot_x,SiKi), 0.0_SiKi ) ) then - m%AllOuts( RtTSR ) = 0.0_ReKi + if ( abs( m%V_dot_x ) < 0.04_ReKi .or. p%NumBlades == 0 ) then ! < 0.018 is close to "v_dot_x**3 not equal to 0" (cubed because of Cp denominator) m%AllOuts( RtAeroCp ) = 0.0_ReKi m%AllOuts( RtAeroCq ) = 0.0_ReKi m%AllOuts( RtAeroCt ) = 0.0_ReKi else - m%AllOuts( RtTSR ) = omega * rmax / m%V_dot_x - denom = 0.5*p%AirDens*m%AllOuts( RtArea )*m%V_dot_x**2 + !denom = 0.5 * p%AirDens * (pi * rmax**2) * m%V_dot_x**2 + m%AllOuts( RtAeroCp ) = m%AllOuts( RtAeroPwr ) / (denom * m%V_dot_x) m%AllOuts( RtAeroCq ) = m%AllOuts( RtAeroMxh ) / (denom * rmax ) m%AllOuts( RtAeroCt ) = m%AllOuts( RtAeroFxh ) / denom @@ -421,8 +459,6 @@ subroutine Calc_WriteOutput_BEMT() m%AllOuts( BNTheta(beta,k) ) = m%BEMT_u(indx)%theta(j,k)*R2D m%AllOuts( BNPhi( beta,k) ) = m%BEMT_y%phi(j,k)*R2D - ! m%AllOuts( BNCurve(beta,k) ) = m%Curve(j,k)*R2D - m%AllOuts( BNCpmin( beta,k) ) = m%BEMT_y%Cpmin(j,k) ! m%AllOuts( BNSigCr( beta,k) ) = m%SigmaCavitCrit(j,k) ! m%AllOuts( BNSgCav( beta,k) ) = m%SigmaCavit(j,k) @@ -457,11 +493,15 @@ subroutine Calc_WriteOutput_BEMT() ! rotor outputs: - - m%AllOuts( RtSkew ) = m%BEMT_u(indx)%chi0*R2D -! m%AllOuts( RtTSR ) = m%BEMT_u(indx)%TSR - m%AllOuts( DBEMTau1 ) = OtherState%BEMT%DBEMT%tau1 - + if (p%NumBlades > 0) then + m%AllOuts( RtSkew ) = m%BEMT_u(indx)%chi0*R2D + m%AllOuts( RtTSR ) = m%BEMT_u(indx)%TSR + m%AllOuts( DBEMTau1 ) = OtherState%BEMT%DBEMT%tau1 + else + m%AllOuts( RtSkew ) = 0.0_ReKi + m%AllOuts( RtTSR ) = 0.0_ReKi + m%AllOuts( DBEMTau1 ) = 0.0_ReKi + end if end subroutine Calc_WriteOutput_BEMT @@ -505,7 +545,6 @@ subroutine Calc_WriteOutput_FVW m%AllOuts( BNAlpha(beta,k) ) = m_AD%FVW%W(iW)%BN_alpha(j)*R2D m%AllOuts( BNTheta(beta,k) ) = m_AD%FVW%W(iW)%PitchAndTwist(j)*R2D m%AllOuts( BNPhi( beta,k) ) = m_AD%FVW%W(iW)%BN_phi(j)*R2D -! m%AllOuts( BNCurve(beta,k) ) = m%Curve(j,k)*R2D ! TODO m%AllOuts( BNCpmin(beta,k) ) = m_AD%FVW%W(iW)%BN_Cpmin(j) m%AllOuts( BNCl( beta,k) ) = m_AD%FVW%W(iW)%BN_Cl(j) @@ -537,13 +576,19 @@ subroutine Calc_WriteOutput_FVW ! m%AllOuts( RtArea ) = pi*rmax**2 ! TODO vertical axis m%AllOuts( RtSkew ) = Calc_Chi0(m%V_diskAvg, m%V_dot_x) * R2D -! m%AllOuts( DBEMTau1 ) = 0.0_ReKi ! not valid with FVW + if ( EqualRealNos( REAL(m%V_dot_x, SiKi), 0.0_SiKi ) ) then + m%AllOuts( RtTSR ) = 0.0_ReKi + else + m%AllOuts( RtTSR ) = omega * rmax / m%V_dot_x + end if + m%AllOuts( DBEMTau1 ) = 0.0_ReKi ! not valid with FVW end subroutine Calc_WriteOutput_FVW + END SUBROUTINE Calc_WriteOutput !---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE ReadInputFiles( InputFileName, InputFileData, Default_DT, OutFileRoot, NumBlades, AeroProjMod, UnEcho, ErrStat, ErrMsg ) +SUBROUTINE ReadInputFiles( InputFileName, InputFileData, Default_DT, OutFileRoot, NumBlades, AeroProjMod, UnEcho, calcCrvAngle, ErrStat, ErrMsg ) ! This subroutine reads the input file and stores all the data in the AD_InputFile structure. ! It does not perform data validation. !.................................................................................................................................. @@ -557,8 +602,9 @@ SUBROUTINE ReadInputFiles( InputFileName, InputFileData, Default_DT, OutFileRoot TYPE(AD_InputFile), INTENT(INOUT) :: InputFileData ! Data stored in the module's input file INTEGER(IntKi), INTENT(INOUT) :: UnEcho ! Unit number for the echo file - INTEGER(IntKi), INTENT(IN) :: NumBlades(:) ! Number of blades per rotor + INTEGER(IntKi), INTENT(IN) :: NumBlades(:) ! Number of blades for this model per rotor INTEGER(IntKi), INTENT(IN) :: AeroProjMod(:) ! AeroProjMod per rotor + LOGICAL, INTENT(INOUT) :: calcCrvAngle(:) ! Whether this blade definition should calculate BlCrvAng (each blades and each rotor) INTEGER(IntKi), INTENT(OUT) :: ErrStat ! The error status code CHARACTER(*), INTENT(OUT) :: ErrMsg ! The error message, if an error occurred @@ -577,8 +623,9 @@ SUBROUTINE ReadInputFiles( InputFileName, InputFileData, Default_DT, OutFileRoot ErrStat = ErrID_None ErrMsg = '' - InputFileData%DTAero = Default_DT ! the glue code's suggested DT for the module (may be overwritten in ReadPrimaryFile()) + InputFileData%DTAero = Default_DT ! the glue code's suggested DT for the module (may be overwritten in ReadPrimaryFile()) + calcCrvAngle = .false. ! initialize in case of early return ! get the blade input-file data iBld=1 @@ -593,7 +640,7 @@ SUBROUTINE ReadInputFiles( InputFileName, InputFileData, Default_DT, OutFileRoot !FIXME: add options for passing the blade files. This routine will need restructuring to handle that. DO I=1,NumBlades(iR) - CALL ReadBladeInputs ( InputFileData%ADBlFile(iBld), InputFileData%rotors(iR)%BladeProps(I), AeroProjMod(iR), UnEcho, ErrStat2, ErrMsg2 ) + CALL ReadBladeInputs ( InputFileData%ADBlFile(iBld), InputFileData%rotors(iR)%BladeProps(I), AeroProjMod(iR), UnEcho, calcCrvAngle(iBld), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName//TRIM(':Blade')//TRIM(Num2LStr(I))) IF ( ErrStat >= AbortErrLev ) THEN CALL Cleanup() @@ -634,6 +681,7 @@ END SUBROUTINE ReadInputFiles !---------------------------------------------------------------------------------------------------------------------------------- !> This routine parses the input file data stored in FileInfo_In and places it in the InputFileData structure for validating. SUBROUTINE ParsePrimaryFileInfo( PriPath, InitInp, InputFile, RootName, NumBlades, interval, FileInfo_In, InputFileData, UnEc, ErrStat, ErrMsg ) + implicit none ! Passed variables @@ -658,20 +706,39 @@ SUBROUTINE ParsePrimaryFileInfo( PriPath, InitInp, InputFile, RootName, NumBlade character(ErrMsgLen) :: ErrMsg_NoAllBldNdOuts integer(IntKi) :: CurLine !< current entry in FileInfo_In%Lines array real(ReKi) :: TmpRe5(5) !< temporary 8 number array for reading values in - + logical :: TwrAeroLogical !< convert TwrAero from logical (input file) to integer (new) + character(1024) :: sDummy !< temporary string + character(1024) :: tmpOutStr !< temporary string for writing to screen + logical :: wakeModProvided, frozenWakeProvided, skewModProvided, AFAeroModProvided, UAModProvided, isLegalComment, firstWarn !< Temporary for legacy purposes + logical :: AoA34_Missing + integer :: UAMod_Old + integer :: WakeMod_Old + integer :: AFAeroMod_Old + integer :: SkewMod_Old + logical :: FrozenWake_Old character(*), parameter :: RoutineName = 'ParsePrimaryFileInfo' + UAMod_Old = -1 + WakeMod_Old = -1 + AFAeroMod_Old = -1 + SkewMod_Old = -1 + FrozenWake_Old = .False. + + InputFileData%UA_Init%UA_OUTS = 0 + InputFileData%UA_Init%d_34_to_ac = 0.5_ReKi + ! Initialization ErrStat = ErrId_None ErrMsg = "" UnEc = -1 ! Echo file unit. >0 when used + firstWarn=.False. CALL AllocAry( InputFileData%OutList, MaxOutPts, "Outlist", ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ! Allocate array for holding the list of node outputs - CALL AllocAry( InputFileData%BldNd_OutList, BldNd_MaxOutPts, "BldNd_Outlist", ErrStat2, ErrMsg2 ) + CALL AllocAry( InputFileData%BldNd_OutList, 2*BldNd_MaxOutPts, "BldNd_Outlist", ErrStat2, ErrMsg2 ) ! allow users to enter twice the number of unique outputs CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) numBladesTot=sum(NumBlades) @@ -702,12 +769,24 @@ SUBROUTINE ParsePrimaryFileInfo( PriPath, InitInp, InputFile, RootName, NumBlade ! DTAero - Time interval for aerodynamic calculations {or default} (s): call ParseVarWDefault ( FileInfo_In, CurLine, "DTAero", InputFileData%DTAero, interval, ErrStat2, ErrMsg2, UnEc ) if (Failed()) return - ! WakeMod - Type of wake/induction model (switch) {0=none, 1=BEMT, 2=DBEMT, 3=OLAF} [WakeMod cannot be 2 or 3 when linearizing] - call ParseVar( FileInfo_In, CurLine, "WakeMod", InputFileData%WakeMod, ErrStat2, ErrMsg2, UnEc ) - if (Failed()) return - ! AFAeroMod - Type of blade airfoil aerodynamics model (switch) {1=steady model, 2=Beddoes-Leishman unsteady model} [AFAeroMod must be 1 when linearizing] - call ParseVar( FileInfo_In, CurLine, "AFAeroMod", InputFileData%AFAeroMod, ErrStat2, ErrMsg2, UnEc ) - if (Failed()) return + ! WakeMod - LEGACY + call ParseVar( FileInfo_In, CurLine, "WakeMod", WakeMod_Old, ErrStat2, ErrMsg2, UnEc) + wakeModProvided = legacyInputPresent('WakeMod', CurLine, ErrStat2, ErrMsg2, 'Wake_Mod=0 (WakeMod=0), Wake_Mod=1 (WakeMod=1), DBEMT_Mod>0 (WakeMod=2), Wake_Mod=3 (WakeMod=3)') + ! Wake_Mod- Type of wake/induction model (switch) {0=none, 1=BEMT, 2=TBD, 3=OLAF} + call ParseVar( FileInfo_In, CurLine, "Wake_Mod", InputFileData%Wake_Mod, ErrStat2, ErrMsg2, UnEc ) + if (newInputMissing('Wake_Mod', CurLine, errStat2, errMsg2)) then + call WrScr(' Setting Wake_Mod to 1 (BEM active) as the input is Missing (typical behavior).') + InputFileData%Wake_Mod = WakeMod_BEMT + else + if (wakeModProvided) then + call LegacyAbort('Cannot have both Wake_Mod and WakeMod in the input file'); return + endif + endif + + + ! AFAeroMod - Type of blade airfoil aerodynamics model (switch) {1=steady model, 2=Beddoes-Leishman unsteady model} [AFAeroMod must be 1 when linearizing] + call ParseVar( FileInfo_In, CurLine, "AFAeroMod", AFAeroMod_Old, ErrStat2, ErrMsg2, UnEc ) + AFAeroModProvided = legacyInputPresent('AFAeroMod', CurLine, ErrStat2, ErrMsg2, 'UA_Mod=0 (AFAeroMod=1) or UA_Mod>1 (AFAeroMod=2)') ! TwrPotent - Type of tower influence on wind based on potential flow around the tower (switch) {0=none, 1=baseline potential flow, 2=potential flow with Bak correction} call ParseVar( FileInfo_In, CurLine, "TwrPotent", InputFileData%TwrPotent, ErrStat2, ErrMsg2, UnEc ) if (Failed()) return @@ -715,16 +794,25 @@ SUBROUTINE ParsePrimaryFileInfo( PriPath, InitInp, InputFile, RootName, NumBlade call ParseVar( FileInfo_In, CurLine, "TwrShadow", InputFileData%TwrShadow, ErrStat2, ErrMsg2, UnEc ) if (Failed()) return ! TwrAero - Calculate tower aerodynamic loads? (flag) - call ParseVar( FileInfo_In, CurLine, "TwrAero", InputFileData%TwrAero, ErrStat2, ErrMsg2, UnEc ) - if (Failed()) return - ! FrozenWake - Assume frozen wake during linearization? (flag) [used only when WakeMod=1 and when linearizing] - call ParseVar( FileInfo_In, CurLine, "FrozenWake", InputFileData%FrozenWake, ErrStat2, ErrMsg2, UnEc ) + call ParseVar( FileInfo_In, CurLine, "TwrAero", TwrAeroLogical, ErrStat2, ErrMsg2, UnEc ) if (Failed()) return + if (TwrAeroLogical) then + InputFileData%TwrAero = TwrAero_NoVIV + else + InputFileData%TwrAero = TwrAero_None + end if + + ! FrozenWake - Assume frozen wake during linearization? (flag) [used only when WakeMod=1 and when linearizing] + call ParseVar( FileInfo_In, CurLine, "FrozenWake", FrozenWake_Old, ErrStat2, ErrMsg2, UnEc ) + frozenWakeProvided = legacyInputPresent('FrozenWake', Curline, ErrStat2, ErrMsg2, 'DBEMTMod=-1 (FrozenWake=True) or DBEMTMod>-1 (FrozenWake=False)') ! CavitCheck - Perform cavitation check? (flag) [AFAeroMod must be 1 when CavitCheck=true] call ParseVar( FileInfo_In, CurLine, "CavitCheck", InputFileData%CavitCheck, ErrStat2, ErrMsg2, UnEc ) if (Failed()) return ! Buoyancy - Include buoyancy effects? (flag) call ParseVar( FileInfo_In, CurLine, "Buoyancy", InputFileData%Buoyancy, ErrStat2, ErrMsg2, UnEc ) + if (Failed()) return + ! NacelleDrag - Include Nacelle Drag effects? (flag) + call ParseVar( FileInfo_In, CurLine, "NacelleDrag", InputFileData%NacelleDrag, ErrStat2, ErrMsg2, UnEc ) if (Failed()) return ! CompAA - Flag to compute AeroAcoustics calculation [only used when WakeMod=1 or 2] call ParseVar( FileInfo_In, CurLine, "CompAA", InputFileData%CompAA, ErrStat2, ErrMsg2, UnEc ) @@ -746,6 +834,8 @@ SUBROUTINE ParsePrimaryFileInfo( PriPath, InitInp, InputFile, RootName, NumBlade ! SpdSound - Speed of sound {or default} (m/s) call ParseVarWDefault( FileInfo_In, CurLine, "SpdSound", InputFileData%SpdSound, InitInp%defSpdSound, ErrStat2, ErrMsg2, UnEc ) if (Failed()) return + InputFileData%UA_Init%a_s = InputFileData%SpdSound + ! Patm - Atmospheric pressure {or default} (Pa) [used only when CavitCheck=True] call ParseVarWDefault( FileInfo_In, CurLine, "Patm", InputFileData%Patm, InitInp%defPatm, ErrStat2, ErrMsg2, UnEc ) if (Failed()) return @@ -754,14 +844,55 @@ SUBROUTINE ParsePrimaryFileInfo( PriPath, InitInp, InputFile, RootName, NumBlade if (Failed()) return !====== Blade-Element/Momentum Theory Options ====================================================== [unused when WakeMod=0 or 3] - if ( InputFileData%Echo ) WRITE(UnEc, '(A)') FileInfo_In%Lines(CurLine) ! Write section break to echo - CurLine = CurLine + 1 - ! SkewMod - Type of skewed-wake correction model (switch) {1=uncoupled, 2=Pitt/Peters, 3=coupled} [unused when WakeMod=0 or 3] - call ParseVar( FileInfo_In, CurLine, "SkewMod", InputFileData%SkewMod, ErrStat2, ErrMsg2, UnEc ) - if (Failed()) return + call ParseCom (FileInfo_in, CurLine, sDummy, errStat2, errMsg2, UnEc, isLegalComment); if (Failed()) return + + ! BEM_Mod + call ParseVar( FileInfo_In, CurLine, "BEM_Mod", InputFileData%BEM_Mod, ErrStat2, ErrMsg2, UnEc ) + if (newInputMissing('BEM_Mod', CurLine, errStat2, errMsg2)) then + call WrScr(' Setting BEM_Mod to 1 (NoPitchSweepPitch) as the input is Missing (legacy behavior).') + InputFileData%BEM_Mod = BEMMod_2D + else + call ParseCom (FileInfo_in, CurLine, sDummy, errStat2, errMsg2, UnEc, isLegalComment); if (Failed()) return + endif + + ! SkewMod Legacy + call ParseVar( FileInfo_In, CurLine, "SkewMod", SkewMod_Old, ErrStat2, ErrMsg2, UnEc ) + skewModProvided = legacyInputPresent('SkewMod', CurLine, ErrStat2, ErrMsg2, 'Skew_Mod=-1 (SkewMod=0), Skew_Mod=0 (SkewMod=1), Skew_Mod=1 (SkewMod>=2)') + ! Skew_Mod- Select skew model {0: No skew model at all, -1:Throw away non-normal component for linearization, 1: Glauert skew model, } + call ParseVar( FileInfo_In, CurLine, "Skew_Mod", InputFileData%Skew_Mod, ErrStat2, ErrMsg2, UnEc ) + if (newInputMissing('Skew_Mod', CurLine, errStat2, errMsg2)) then + call WrScr(' Setting Skew_Mod to 1 (skew active) as the input is Missing (typical behavior).') + InputFileData%Skew_Mod = Skew_Mod_Active + else + if (skewModProvided) then + call LegacyAbort('Cannot have both Skew_Mod and SkewMod in the input file'); return + endif + endif + + + ! SkewMomCorr - Turn the skew momentum correction on or off [used only when SkewMod=1] + call ParseVar( FileInfo_In, CurLine, "SkewMomCorr", InputFileData%SkewMomCorr, ErrStat2, ErrMsg2, UnEc ) + if (newInputMissing('SkewMomCorr', CurLine, errStat2, errMsg2)) then + call WrScr(' Setting SkewMomCorr to False as the input is Missing (legacy behavior).') + InputFileData%SkewMomCorr = .False. + endif + + ! SkewRedistr_Mod - Type of skewed-wake correction model (switch) {0: no redistribution, 1=Glauert/Pitt/Peters, 2=Vortex Cylinder} [unsed only when SkewMod=1] + call ParseVarWDefault( FileInfo_In, CurLine, "SkewRedistr_Mod", InputFileData%SkewRedistr_Mod, 1, ErrStat2, ErrMsg2, UnEc ) + if (newInputMissing('SkewRedistr_Mod', CurLine, errStat2, errMsg2)) then + call WrScr(' Setting SkewRedistr_Mod to 1 as the input is Missing (legacy behavior).') + InputFileData%SkewRedistr_Mod = 1 + endif + ! SkewModFactor - Constant used in Pitt/Peters skewed wake model {or "default" is 15/32*pi} (-) [used only when SkewMod=2; unused when WakeMod=0 or 3] call ParseVarWDefault( FileInfo_In, CurLine, "SkewModFactor", InputFileData%SkewModFactor, (15.0_ReKi * pi / 32.0_ReKi), ErrStat2, ErrMsg2, UnEc ) - if (Failed()) return + if( legacyInputPresent('SkewModFactor', CurLine, ErrStat2, ErrMsg2, 'Rename this parameter to SkewRedistrFactor')) then + ! pass + else + call ParseVarWDefault( FileInfo_In, CurLine, "SkewRedistrFactor", InputFileData%SkewModFactor, (15.0_ReKi * pi / 32.0_ReKi), ErrStat2, ErrMsg2, UnEc ); if (Failed()) return + call ParseCom (FileInfo_in, CurLine, sDummy, errStat2, errMsg2, UnEc, isLegalComment); if (Failed()) return + endif + ! TipLoss - Use the Prandtl tip-loss model? (flag) [unused when WakeMod=0 or 3] call ParseVar( FileInfo_In, CurLine, "TipLoss", InputFileData%TipLoss, ErrStat2, ErrMsg2, UnEc ) if (Failed()) return @@ -787,11 +918,22 @@ SUBROUTINE ParsePrimaryFileInfo( PriPath, InitInp, InputFile, RootName, NumBlade ! MaxIter - Maximum number of iteration steps (-) [unused when WakeMod=0] call ParseVar( FileInfo_In, CurLine, "MaxIter", InputFileData%MaxIter, ErrStat2, ErrMsg2, UnEc ) if (Failed()) return + ! --- Shear + call ParseCom (FileInfo_in, CurLine, sDummy, errStat2, errMsg2, UnEc, isLegalComment); if (Failed()) return + call ParseVar( FileInfo_In, CurLine, "SectAvg" , InputFileData%SectAvg, ErrStat2, ErrMsg2, UnEc ); + if (newInputMissing('SectAvg', CurLine, errStat2, errMsg2)) then + call WrScr(' Setting SectAvg to False as the input is Missing (legacy behavior).') + InputFileData%SectAvg = .false. + else + call ParseVarWDefault( FileInfo_In, CurLine, "SectAvgWeighting", InputFileData%SA_Weighting, 1 , ErrStat2, ErrMsg2, UnEc ); if (Failed()) return + call ParseVarWDefault( FileInfo_In, CurLine, "SectAvgNPoints" , InputFileData%SA_nPerSec, 5 , ErrStat2, ErrMsg2, UnEc ); if (Failed()) return + call ParseVarWDefault( FileInfo_In, CurLine, "SectAvgPsiBwd" , InputFileData%SA_PsiBwd, -60._ReKi, ErrStat2, ErrMsg2, UnEc ); if (Failed()) return + call ParseVarWDefault( FileInfo_In, CurLine, "SectAvgPsiFwd" , InputFileData%SA_PsiFwd, 60._ReKi, ErrStat2, ErrMsg2, UnEc ); if (Failed()) return + call ParseCom (FileInfo_in, CurLine, sDummy, errStat2, errMsg2, UnEc, isLegalComment); if (Failed()) return + endif !====== Dynamic Blade-Element/Momentum Theory Options ============================================== [used only when WakeMod=2] - if ( InputFileData%Echo ) WRITE(UnEc, '(A)') FileInfo_In%Lines(CurLine) ! Write section break to echo - CurLine = CurLine + 1 - ! DBEMT_Mod - Type of dynamic BEMT (DBEMT) model {1=constant tau1, 2=time-dependent tau1} (-) [used only when WakeMod=2] + ! DBEMT_Mod - Type of dynamic BEMT (DBEMT) model {1=constant tau1, 2=time-dependent tau1} (-) [used only when WakeMod=2] call ParseVar( FileInfo_In, CurLine, "DBEMT_Mod", InputFileData%DBEMT_Mod, ErrStat2, ErrMsg2, UnEc ) if (Failed()) return ! tau1_const - Time constant for DBEMT (s) [used only when WakeMod=2 and DBEMT_Mod=1] @@ -807,14 +949,36 @@ SUBROUTINE ParsePrimaryFileInfo( PriPath, InitInp, InputFile, RootName, NumBlade IF ( PathIsRelative( InputFileData%FVWFileName ) ) InputFileData%FVWFileName = TRIM(PriPath)//TRIM(InputFileData%FVWFileName) !====== Beddoes-Leishman Unsteady Airfoil Aerodynamics Options ===================================== [used only when AFAeroMod=2] - if ( InputFileData%Echo ) WRITE(UnEc, '(A)') FileInfo_In%Lines(CurLine) ! Write section break to echo - CurLine = CurLine + 1 - ! UAMod - Unsteady Aero Model Switch (switch) {1=Baseline model (Original), 2=Gonzalez's variant (changes in Cn,Cc,Cm), 3=Minnema/Pierce variant (changes in Cc and Cm)} [used only when AFAeroMod=2] - call ParseVar( FileInfo_In, CurLine, "UAMod", InputFileData%UAMod, ErrStat2, ErrMsg2, UnEc ) - if (Failed()) return + call ParseCom (FileInfo_in, CurLine, sDummy, errStat2, errMsg2, UnEc, isLegalComment); if (Failed()) return + ! AoA34 Sample the angle of attack (AoA) at the 3/4 chord or the AC point {default=True} [always used] + call ParseVar( FileInfo_In, CurLine, "AoA34", InputFileData%AoA34, ErrStat2, ErrMsg2, UnEc ) + AoA34_Missing = newInputMissing('AoA34', CurLine, errStat2, errMsg2) + ! UAMod (Legacy) + call ParseVar( FileInfo_In, CurLine, "UAMod", UAMod_Old, ErrStat2, ErrMsg2, UnEc ) + UAModProvided = legacyInputPresent('UAMod', CurLine, ErrStat2, ErrMsg2, 'UA_Mod=0 (AFAeroMod=1), UA_Mod>1 (AFAeroMod=2 and UA_Mod=UAMod') + ! UA_Mod - Unsteady Aero Model Switch (switch) {0=Quasi-steady (no UA), 2=Gonzalez's variant (changes in Cn,Cc,Cm), 3=Minnema/Pierce variant (changes in Cc and Cm)} + call ParseVar( FileInfo_In, CurLine, "UA_Mod", InputFileData%UA_Init%UAMod, ErrStat2, ErrMsg2, UnEc ) + if (newInputMissing('UA_Mod', CurLine, errStat2, errMsg2)) then + ! We'll deal with it when we deal with AFAeroMod + InputFileData%UA_Init%UAMod = UAMod_Old + if (.not. UAModProvided) then + call LegacyAbort('Need to provide either UA_Mod or UAMod in the input file'); return + endif + else + if (UAModProvided) then + call LegacyAbort('Cannot have both UA_Mod and UAMod in the input file'); return + endif + endif + + ! FLookup - Flag to indicate whether a lookup for f' will be calculated (TRUE) or whether best-fit exponential equations will be used (FALSE); if FALSE S1-S4 must be provided in airfoil input files (flag) [used only when AFAeroMod=2] - call ParseVar( FileInfo_In, CurLine, "FLookup", InputFileData%FLookup, ErrStat2, ErrMsg2, UnEc ) + call ParseVar( FileInfo_In, CurLine, "FLookup", InputFileData%UA_Init%FLookup, ErrStat2, ErrMsg2, UnEc ) if (Failed()) return + + ! IntegrationMethod - Switch to indicate which integration method UA uses (1=RK4, 2=AB4, 3=ABM4, 4=BDF2) (switch): + call ParseVar( FileInfo_In, CurLine, "IntegrationMethod", InputFileData%UA_Init%IntegrationMethod, ErrStat2, ErrMsg2, UnEc ) + if (ErrStat2>= AbortErrLev) InputFileData%UA_Init%IntegrationMethod = UA_Method_ABM4 + ! UAStartRad - Starting radius for dynamic stall (fraction of rotor radius) [used only when AFAeroMod=2]: call ParseVar( FileInfo_In, CurLine, "UAStartRad", InputFileData%UAStartRad, ErrStat2, ErrMsg2, UnEc ) if (ErrStat2>= AbortErrLev) InputFileData%UAStartRad = 0.0_ReKi @@ -897,6 +1061,16 @@ SUBROUTINE ParsePrimaryFileInfo( PriPath, InitInp, InputFile, RootName, NumBlade ! NacCenB - Nacelle center of buoyancy x,y,z direction offsets (m) call ParseAry( FileInfo_In, CurLine, 'NacCenB', InputFileData%rotors(iR)%NacCenB, 3 , ErrStat2, ErrMsg2, UnEc ) if (Failed()) return + + ! NacArea - Projected area of the nacelle in X, Y, Z in the nacelle coordinate system (m^2) + call ParseAry( FileInfo_In, CurLine, "NacArea", InputFileData%rotors(iR)%NacArea, 3, ErrStat2, ErrMsg2, UnEc ) + if (Failed()) return + ! NacCd - Drag coefficient for the nacelle areas defined above (-) + call ParseAry( FileInfo_In, CurLine, "NacCd", InputFileData%rotors(iR)%NacCd, 3, ErrStat2, ErrMsg2, UnEc ) + if (Failed()) return + ! NacDragAC - Position of aerodynamic center of nacelle drag in nacelle coordinates (m) + call ParseAry( FileInfo_In, CurLine, "NacDragAC", InputFileData%rotors(iR)%NacDragAC, 3, ErrStat2, ErrMsg2, UnEc ) + if (Failed()) return end do !====== Tail fin aerodynamics ======================================================================== @@ -907,7 +1081,7 @@ SUBROUTINE ParsePrimaryFileInfo( PriPath, InitInp, InputFile, RootName, NumBlade call ParseVar(FileInfo_In, CurLine, "TFinAero", InputFileData%rotors(iR)%TFinAero, ErrStat2, ErrMsg2, UnEc); if (ErrStat2==ErrID_None) then call ParseVar(FileInfo_In, CurLine, "TFinFile", InputFileData%rotors(iR)%TFinFile, ErrStat2, ErrMsg2, UnEc, IsPath=.true.); if (Failed()) return - InputFileData%rotors(iR)%TFinFile = trim(PriPath) // trim(InputFileData%rotors(iR)%TFinFile) + IF ( PathIsRelative( InputFileData%rotors(iR)%TFinFile ) ) InputFileData%rotors(iR)%TFinFile = trim(PriPath) // trim(InputFileData%rotors(iR)%TFinFile) else call LegacyWarning('Tail Fin section (TFinAero, TFinFile) is missing from input file.') CurLine = CurLine - 1 @@ -955,6 +1129,7 @@ SUBROUTINE ParsePrimaryFileInfo( PriPath, InitInp, InputFile, RootName, NumBlade ! SumPrint - Generate a summary file listing input options and interpolated properties to ".AD.sum"? (flag) call ParseVar( FileInfo_In, CurLine, "SumPrint", InputFileData%SumPrint, ErrStat2, ErrMsg2, UnEc ) if (Failed()) return + InputFileData%UA_Init%WrSum = InputFileData%SumPrint ! NBlOuts - Number of blade node outputs [0 - 9] (-) call ParseVar( FileInfo_In, CurLine, "NBlOuts", InputFileData%NBlOuts, ErrStat2, ErrMsg2, UnEc ) @@ -987,6 +1162,67 @@ SUBROUTINE ParsePrimaryFileInfo( PriPath, InitInp, InputFile, RootName, NumBlade call ReadOutputListFromFileInfo( FileInfo_In, CurLine, InputFileData%OutList, InputFileData%NumOuts, ErrStat2, ErrMsg2, UnEc ) if (Failed()) return; + !====== Legacy logic to match old and new input files ================================================ + ! NOTE: remove me in future release + if (frozenWakeProvided) then + if (FrozenWake_Old) then + call WrScr('> FrozenWake=True -> Setting DBEMT_Mod=-1') + InputFileData%DBEMT_Mod = DBEMT_frozen + else + call WrScr('> FrozenWake=False -> Not changing DBEMT_Mod') + endif + endif + if (wakeModProvided) then + InputFileData%Wake_Mod = WakeMod_Old + if (WakeMod_Old==1) then + call WrScr('> WakeMod=1 -> Setting DBEMT_Mod=0') + ! Turn off DBEMT + InputFileData%DBEMT_Mod=DBEMT_none + else if (WakeMod_Old==2) then + call WrScr('> WakeMod=2 -> Setting Wake_Mod=1 (BEMT) (DBEMT_Mod needs to be >0)') + InputFileData%Wake_Mod = WakeMod_BEMT + if (InputFileData%DBEMT_Mod < DBEMT_none) then + call LegacyAbort('DBEMT should be >0 when using legacy input WakeMod=2'); return + endif + endif + endif + if (AFAeroModProvided) then + if (AFAeroMod_Old==1) then + call WrScr('> AFAeroMod=1 -> Setting UA_Mod=0') + InputFileData%UA_Init%UAMod = UA_None + if (AoA34_Missing) then + call WrScr('> Setting AoA34 to False as the input is Missing and UA is turned off (legacy behavior).') + InputFileData%AoA34=.false. + endif + else if (AFAeroMod_Old==2) then + call WrScr('> AFAeroMod=2 -> Not changing DBEMT_Mod') + if (InputFileData%UA_Init%UAMod==0) then + call LegacyAbort('Cannot set UA_Mod=0 with legacy option AFAeroMod=2 (inconsistent behavior).'); return + else if (AoA34_Missing) then + call WrScr('> Setting AoA34 to True as the input is Missing and UA is turned on (legacy behavior).') + InputFileData%AoA34=.true. + endif + else + call LegacyAbort('AFAeroMod should be 1 or 2'); return + endif + endif + if (skewModProvided) then + if (SkewMod_Old==0) then + InputFileData%Skew_Mod = Skew_Mod_Orthogonal + else if (SkewMod_Old==1) then + InputFileData%Skew_Mod = Skew_Mod_None + else if (SkewMod_Old==2) then + InputFileData%Skew_Mod = Skew_Mod_Active + else + call LegacyAbort('Legacy option SkewMod is not 0, 1,2 which is not supported.'); return + endif + endif + + !====== Print new and old inputs ===================================================================== + if (wakeModProvided .or. frozenWakeProvided .or. skewModProvided .or. AFAeroModProvided .or. UAModProvided) then + call printNewOldInputs() + endif + !====== Nodal Outputs ============================================================================== ! In case there is something ill-formed in the additional nodal outputs section, we will simply ignore it. ! Expecting at least 5 more lines in the input file for this section @@ -1004,10 +1240,17 @@ SUBROUTINE ParsePrimaryFileInfo( PriPath, InitInp, InputFile, RootName, NumBlade ! Will likely require reading this line in as a string (BldNd_BladesOut_Str) and parsing it call ParseVar( FileInfo_In, CurLine, "BldNd_BladesOut", InputFileData%BldNd_BladesOut, ErrStat2, ErrMsg2, UnEc ) if (FailedNodal()) return - ! BldNd_BlOutNd - Future feature will allow selecting a portion of the nodes to output. Not implemented yet. (-) - ! TODO: Parse this string into an array of nodes to output at (one idea is to set an array of boolean to T/F for which nodes to output). At present, we ignore it entirely. + ! BldNd_BlOutNd - Allow selecting a portion of the nodes to output. (-) call ParseVar( FileInfo_In, CurLine, "BldNd_BlOutNd", InputFileData%BldNd_BlOutNd_Str, ErrStat2, ErrMsg2, UnEc ) - if (FailedNodal()) return + if (ErrStat2 /= ErrID_None) then + ! ParseVar won't read a string of numbers in quotes since the quotes are a delimiter, so we'll just copy the whole line here and move on + InputFileData%BldNd_BlOutNd_Str = FileInfo_In%Lines(CurLine) + if ( InputFileData%Echo ) WRITE(UnEc, '(A)') InputFileData%BldNd_BlOutNd_Str ! Write BldNd_BlOutNd_Str to echo + + CurLine = CurLine + 1 + ErrStat2 = ErrID_None + end if + ! OutList - The next line(s) contains a list of output parameters. See OutListParameters.xlsx for a listing of available output channels, (-) if ( InputFileData%Echo ) WRITE(UnEc, '(A)') FileInfo_In%Lines(CurLine) ! Write section break to echo CurLine = CurLine + 1 @@ -1019,7 +1262,41 @@ SUBROUTINE ParsePrimaryFileInfo( PriPath, InitInp, InputFile, RootName, NumBlade ! Prevent segfault when no blades specified. All logic tests on BldNd_NumOuts at present. if (InputFileData%BldNd_BladesOut <= 0) InputFileData%BldNd_NumOuts = 0 + + !====== Advanced Options ============================================================================= + if ((CurLine) >= size(FileInfo_In%Lines)) RETURN + + call WrScr(' - Reading advanced options for AeroDyn') + do CurLine= CurLine, size(FileInfo_In%Lines) + sDummy = FileInfo_In%Lines(CurLine) + call Conv2UC(sDummy) ! to uppercase + if (index(sDummy, '!') == 1 .or. index(sDummy, '=') == 1 .or. index(sDummy, '#') == 1 .or. index(sDummy, '---') == 1) then + ! pass comment lines + elseif (index(sDummy, 'SECTAVG')>1) then + read(sDummy, '(L1)') InputFileData%SectAvg + write(tmpOutStr,*) ' >>> SectAvg ',InputFileData%SectAvg + elseif (index(sDummy, 'SA_PSIBWD')>1) then + read(sDummy, *) InputFileData%SA_PsiBwd + write(tmpOutStr,*) ' >>> SA_PsiBwd ',InputFileData%SA_PsiBwd + elseif (index(sDummy, 'SA_PSIFWD')>1) then + read(sDummy, *) InputFileData%SA_PsiFwd + write(tmpOutStr,*) ' >>> SA_PsiFwd ',InputFileData%SA_PsiFwd + elseif (index(sDummy, 'SA_NPERSEC')>1) then + read(sDummy, *) InputFileData%SA_nPerSec + write(tmpOutStr,*) ' >>> SA_nPerSec ',InputFileData%SA_nPerSec + else + write(tmpOutStr,*) '[WARN] AeroDyn Line ignored: '//trim(sDummy) + endif + call WrScr(trim(tmpOutStr)) + enddo + + + !---------------------- END OF FILE ----------------------------------------- + + RETURN + + CONTAINS !------------------------------------------------------------------------------------------------- logical function Failed() @@ -1030,7 +1307,8 @@ logical function Failed() end function Failed logical function FailedNodal() ErrMsg_NoAllBldNdOuts='AD15 Nodal Outputs: Nodal output section of AeroDyn input file not found or improperly formatted. Skipping nodal outputs.' - FailedNodal = ErrStat2 >= AbortErrLev + ! TODO Use and ErrID_Fatal here + FailedNodal = ErrStat2 >= AbortErrLev if ( FailedNodal ) then InputFileData%BldNd_BladesOut = 0 InputFileData%BldNd_NumOuts = 0 @@ -1039,16 +1317,99 @@ logical function FailedNodal() end function FailedNodal subroutine LegacyWarning(Message) character(len=*), intent(in) :: Message - call WrScr('!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!') - call WrScr('Warning: the AeroDyn input file is not at the latest format!' ) - call WrScr(' Visit: https://openfast.readthedocs.io/en/dev/source/user/api_change.html') + if (.not.FirstWarn) then + call WrScr('!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!') + call WrScr('[WARN] The AeroDyn input file is not at the latest format!' ) + call WrScr(' Visit: https://openfast.readthedocs.io/en/dev/source/user/api_change.html') + call WrScr('!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!') + FirstWarn=.true. + endif call WrScr('> Issue: '//trim(Message)) - call WrScr('!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!') end subroutine LegacyWarning !------------------------------------------------------------------------------------------------- + subroutine LegacyAbort(Message) + character(len=*), intent(in) :: Message + call SetErrStat( ErrID_Fatal, Message, ErrStat, ErrMsg, 'ParsePrimaryFileInfo' ) + end subroutine LegacyAbort + !------------------------------------------------------------------------------------------------- + logical function legacyInputPresent(varName, iLine, errStat, errMsg, varNameSubs) + character(len=*), intent(in ) :: varName !< Variable being read + integer(IntKi), intent(in ) :: iLine !< Line number + integer(IntKi), intent(inout) :: errStat !< Error status + character(ErrMsgLen), intent(inout) :: errMsg !< Error message + character(len=*), optional, intent(in ) :: varNameSubs !< Substituted variable + legacyInputPresent = errStat == ErrID_None + if (legacyInputPresent) then + if (present(varNameSubs)) then + call LegacyWarning(trim(varName)//' has now been removed.'//NewLine//' Use: '//trim(varNameSubs)//'.') + else + call LegacyWarning(trim(varName)//' has now been removed.') + endif + else + ! We are actually happy, this input should indeed not be present. + endif + ! We erase the error no matter what + errStat = ErrID_None + errMsg = '' + end function legacyInputPresent + !------------------------------------------------------------------------------------------------- + logical function newInputMissing(varName, iLine, errStat, errMsg, varNameSubs) + character(len=*), intent(in ) :: varName !< Variable being read + integer(IntKi), intent(in ) :: iLine !< Line number + integer(IntKi), intent(inout) :: errStat !< Error status + character(ErrMsgLen), intent(inout) :: errMsg !< Error message + character(len=*), optional, intent(in ) :: varNameSubs !< Substituted variable + newInputMissing = errStat == ErrID_Fatal + if (newInputMissing) then + call LegacyWarning(trim(varName)//' should be present on line '//trim(num2lstr(iLine))//'.') + else + ! We are happy + endif + ! We erase the error + errStat = ErrID_None + errMsg = '' + end function newInputMissing + + !------------------------------------------------------------------------------------------------- + subroutine printNewOldInputs() + character(1024) :: tmpStr + ! Temporary HACK, for WakeMod=10, 11 or 12 use AeroProjMod 2 (will trigger PolarBEM) + if (InputFileData%Wake_Mod==10) then + call WrScr('[WARN] Wake_Mod=10 is a temporary hack. Setting BEM_Mod to 0') + InputFileData%BEM_Mod = 0 + elseif (InputFileData%Wake_Mod==11) then + call WrScr('[WARN] Wake_Mod=11 is a temporary hack. Setting BEM_Mod to 2') + InputFileData%BEM_Mod = 2 + elseif (InputFileData%Wake_Mod==12) then + call WrScr('[WARN] Wake_Mod=12 is a temporary hack. Setting BEM_Mod to 2') + InputFileData%BEM_Mod = 2 + endif + !====== Summary of new AeroDyn options =============================================================== + ! NOTE: remove me in future release + call WrScr('-------------- New AeroDyn inputs (with new meaning):') + write (tmpStr,'(A20,I0)') 'Wake_Mod: ' , InputFileData%Wake_Mod; call WrScr(trim(tmpStr)) + write (tmpStr,'(A20,I0)') 'BEM_Mod: ' , InputFileData%BEM_Mod; call WrScr(trim(tmpStr)) + write (tmpStr,'(A20,L1)') 'SectAvg: ' , InputFileData%SectAvg; call WrScr(trim(tmpStr)) + write (tmpStr,'(A20,I0)') 'SectAvgWeighting: ', InputFileData%SA_Weighting; call WrScr(trim(tmpStr)) + write (tmpStr,'(A20,I0)') 'SectAvgNPoints: ', InputFileData%SA_nPerSec; call WrScr(trim(tmpStr)) + write (tmpStr,'(A20,I0)') 'DBEMT_Mod:' , InputFileData%DBEMT_Mod; call WrScr(trim(tmpStr)) + write (tmpStr,'(A20,I0)') 'Skew_Mod: ' , InputFileData%Skew_Mod; call WrScr(trim(tmpStr)) + write (tmpStr,'(A20,L1)') 'SkewMomCorr:' , InputFileData%SkewMomCorr; call WrScr(trim(tmpStr)) + write (tmpStr,'(A20,I0)') 'SkewRedistr_Mod:' , InputFileData%SkewRedistr_Mod; call WrScr(trim(tmpStr)) + write (tmpStr,'(A20,L1)') 'AoA34: ' , InputFileData%AoA34; call WrScr(trim(tmpStr)) + write (tmpStr,'(A20,I0)') 'UA_Mod: ' , InputFileData%UA_Init%UAMod; call WrScr(trim(tmpStr)) + call WrScr('-------------- Old AeroDyn inputs:') + write (tmpStr,'(A20,I0)') 'WakeMod: ', WakeMod_Old; call WrScr(trim(tmpStr)) + write (tmpStr,'(A20,I0)') 'SkewMod: ', SkewMod_Old; call WrScr(trim(tmpStr)) + write (tmpStr,'(A20,I0)') 'AFAeroMod:', AFAeroMod_Old; call WrScr(trim(tmpStr)) + write (tmpStr,'(A20,L1)') 'FrozenWake:', FrozenWake_Old; call WrScr(trim(tmpStr)) + write (tmpStr,'(A20,I0)') 'UAMod: ', UAMod_Old; call WrScr(trim(tmpStr)) + call WrScr('------------------------------------------------------') + end subroutine printNewOldInputs + END SUBROUTINE ParsePrimaryFileInfo !---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE ReadBladeInputs ( ADBlFile, BladeKInputFileData, AeroProjMod, UnEc, ErrStat, ErrMsg ) +SUBROUTINE ReadBladeInputs ( ADBlFile, BladeKInputFileData, AeroProjMod, UnEc, calcCrvAngle, ErrStat, ErrMsg ) ! This routine reads a blade input file. !.................................................................................................................................. @@ -1059,6 +1420,7 @@ SUBROUTINE ReadBladeInputs ( ADBlFile, BladeKInputFileData, AeroProjMod, UnEc, E CHARACTER(*), INTENT(IN) :: ADBlFile ! Name of the blade input file data INTEGER(IntKi), INTENT(IN) :: AeroProjMod ! AeroProjMod INTEGER(IntKi), INTENT(IN) :: UnEc ! I/O unit for echo file. If present and > 0, write to UnEc + LOGICAL, INTENT(INOUT) :: calcCrvAngle ! Whether this blade definition should calculate BlCrvAng INTEGER(IntKi), INTENT(OUT) :: ErrStat ! Error status CHARACTER(*), INTENT(OUT) :: ErrMsg ! Error message @@ -1066,27 +1428,26 @@ SUBROUTINE ReadBladeInputs ( ADBlFile, BladeKInputFileData, AeroProjMod, UnEc, E ! Local variables: - INTEGER(IntKi) :: I ! A generic DO index. - INTEGER( IntKi ) :: UnIn ! Unit number for reading file - INTEGER(IntKi) :: ErrStat2 , IOS ! Temporary Error status - CHARACTER(ErrMsgLen) :: ErrMsg2 ! Temporary Err msg - CHARACTER(*), PARAMETER :: RoutineName = 'ReadBladeInputs' - CHARACTER(len=1024) :: Line - CHARACTER(len=50) :: HeaderCols(10) ! Header columns in file - LOGICAL :: hasBuoyancy ! Does file contain Buoyancy columns + INTEGER(IntKi) :: I ! A generic DO index. + INTEGER( IntKi ) :: UnIn ! Unit number for reading file + INTEGER(IntKi) :: ErrStat2 , IOS ! Temporary Error status + CHARACTER(ErrMsgLen) :: ErrMsg2 ! Temporary Err msg + INTEGER, PARAMETER :: MaxCols = 10 + CHARACTER(NWTC_SizeOfNumWord*(MaxCols+1)) :: Line + INTEGER(IntKi) :: Indx(MaxCols) + CHARACTER(8), PARAMETER :: AvailableChanNames(MaxCols) = (/'BLSPN ', 'BLCRVAC ','BLSWPAC ','BLCRVANG','BLTWIST ','BLCHORD ', 'BLAFID ', 'BLCB ', 'BLCENBN ','BLCENBT ' /) ! in upper case only + LOGICAL, PARAMETER :: RequiredChanNames( MaxCols) = (/.true. , .true. ,.true. ,.false. ,.true. ,.true. , .true. , .false. , .false. ,.false. /) + CHARACTER(*), PARAMETER :: RoutineName = 'ReadBladeInputs' + ErrStat = ErrID_None ErrMsg = "" UnIn = -1 + ! Open the input file for blade K. !$OMP critical(filename) CALL GetNewUnit( UnIn, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - - ! Open the input file for blade K. - CALL OpenFInpFile ( UnIn, ADBlFile, ErrStat2, ErrMsg2 ) !$OMP end critical(filename) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1117,16 +1478,6 @@ SUBROUTINE ReadBladeInputs ( ADBlFile, BladeKInputFileData, AeroProjMod, UnEc, E CALL ReadCom ( UnIn, ADBlFile, 'Table header: names', ErrStat2, ErrMsg2, UnEc, Comment=Line ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - ! Check if 10 columns are present - READ (Line,*, IOSTAT=ErrStat2) ( HeaderCols(I), I=1,10 ) - hasBuoyancy = .true. - IF ( ErrStat2 < 0 ) THEN ! end of line reached - hasBuoyancy = .false. - !call WrScr('Blade input file is missing buoyancy columns.') - ELSE IF ( ErrStat2 > 0 ) THEN - CALL SetErrStat(ErrID_Fatal, 'Unexpected error while trying to infer column headers in blade file.', ErrStat, ErrMsg, RoutineName) - endif - CALL ReadCom ( UnIn, ADBlFile, 'Table header: units', ErrStat2, ErrMsg2, UnEc ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1159,61 +1510,60 @@ SUBROUTINE ReadBladeInputs ( ADBlFile, BladeKInputFileData, AeroProjMod, UnEc, E CALL AllocAry( BladeKInputFileData%BlCenBt, BladeKInputFileData%NumBlNds, 'BlCenBt', ErrStat2, ErrMsg2) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF (.not. hasBuoyancy) THEN - BladeKInputFileData%BlCb = 0.0_ReKi - BladeKInputFileData%BlCenBn = 0.0_ReKi - BladeKInputFileData%BlCenBt = 0.0_ReKi - ENDIF - ! Return on error if we didn't allocate space for the next inputs IF ( ErrStat >= AbortErrLev ) THEN CALL Cleanup() RETURN END IF - + + ! Initialize in case these columns are missing (e.g., no buoyancy, or cant angle) + BladeKInputFileData%BlCrvAng = 0.0_ReKi + BladeKInputFileData%BlCb = 0.0_ReKi + BladeKInputFileData%BlCenBn = 0.0_ReKi + BladeKInputFileData%BlCenBt = 0.0_ReKi + + + ! figure out what columns are specified in this file and in what order: + CALL GetInputColumnIndex(MaxCols, AvailableChanNames, RequiredChanNames, Line, Indx, ErrStat2, ErrMsg2) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + IF ( ErrStat >= AbortErrLev ) THEN + CALL Cleanup() + RETURN + END IF + + DO I=1,BladeKInputFileData%NumBlNds - IF (hasBuoyancy) THEN - READ( UnIn, *, IOStat=IOS ) BladeKInputFileData%BlSpn(I), BladeKInputFileData%BlCrvAC(I), BladeKInputFileData%BlSwpAC(I), & - BladeKInputFileData%BlCrvAng(I), BladeKInputFileData%BlTwist(I), BladeKInputFileData%BlChord(I), & - BladeKInputFileData%BlAFID(I), BladeKInputFileData%BlCb(I), BladeKInputFileData%BlCenBn(I), BladeKInputFileData%BlCenBt(I) - ELSE - READ( UnIn, *, IOStat=IOS ) BladeKInputFileData%BlSpn(I), BladeKInputFileData%BlCrvAC(I), BladeKInputFileData%BlSwpAC(I), & - BladeKInputFileData%BlCrvAng(I), BladeKInputFileData%BlTwist(I), BladeKInputFileData%BlChord(I), & - BladeKInputFileData%BlAFID(I) - ENDIF - CALL CheckIOS( IOS, ADBlFile, 'Blade properties row '//TRIM(Num2LStr(I)), NumType, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ! Return on error if we couldn't read this line - IF ( ErrStat >= AbortErrLev ) THEN - CALL Cleanup() - RETURN - END IF + CALL ReadCom( UnIn, ADBlFile, 'Blade properties row '//TRIM(Num2LStr(I)), ErrStat2, ErrMsg2, UnEc, Comment=Line ) ! this will get echoed as a comment instead of a table + ! Return on error if we couldn't read this line + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF ( ErrStat >= AbortErrLev ) THEN + CALL Cleanup() + RETURN + END IF - IF (UnEc > 0) THEN - WRITE( UnEc, "(6(F9.4,1x),I9,4(F9.4,1x))", IOStat=IOS) BladeKInputFileData%BlSpn(I), BladeKInputFileData%BlCrvAC(I), BladeKInputFileData%BlSwpAC(I), & - BladeKInputFileData%BlCrvAng(I), BladeKInputFileData%BlTwist(I), BladeKInputFileData%BlChord(I), & - BladeKInputFileData%BlAFID(I), BladeKInputFileData%BlCb(I), BladeKInputFileData%BlCenBn(I), BladeKInputFileData%BlCenBt(I) - END IF + CALL ConvertLineToCols(Line, i, Indx, BladeKInputFileData, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF ( ErrStat >= AbortErrLev ) THEN + CALL Cleanup() + RETURN + END IF END DO - + BladeKInputFileData%BlTwist = BladeKInputFileData%BlTwist*D2R + BladeKInputFileData%BlCrvAng = BladeKInputFileData%BlCrvAng*D2R + + ! note, we will compute BlCrvAng later for APM_BEM_Polar or in the case the BlCrvAng column is missing from the file + calcCrvAngle = AeroProjMod==APM_BEM_Polar .or. Indx(4) < 1 + + if (Indx(4) > 0 .and. calcCrvAngle) then + CALL SetErrStat(ErrID_Warn,'BlCrvAng will be calculated and overwrite the values specified in blade file "'//trim(ADBlFile)//'".', ErrStat, ErrMsg, RoutineName) + end if + + !bjj: do we still need this??? if (all(BladeKInputFileData%BlCrvAC.eq.0.0_ReKi)) then - BladeKInputFileData%BlCrvAng = 0.0_ReKi - else - if (AeroProjMod==APM_BEM_NoSweepPitchTwist .or. AeroProjMod==APM_LiftingLine) then - !call WrScr('>>> ReadBladeInputs: Not computing cant angle (BlCrvAng), AeroProjMod='//trim(num2lstr(AeroProjMod))) - else if (AeroProjMod==APM_BEM_Polar) then - call WrScr('>>> ReadBladeInputs: Computing cant angle (BlCrvAng), AeroProjMod='//trim(num2lstr(AeroProjMod))) - call calcCantAngle(BladeKInputFileData%BlCrvAC,BladeKInputFileData%BlSpn,3, size(BladeKInputFileData%BlSpn),BladeKInputFileData%BlCrvAng) - else - call SetErrStat(ErrID_Fatal, 'Unsupported AeroProjMod='//trim(num2lstr(AeroProjMod)), ErrStat, ErrMsg, RoutineName) - call Cleanup() - return - endif + BladeKInputFileData%BlCrvAng = 0.0_ReKi endif - BladeKInputFileData%BlCrvAng = BladeKInputFileData%BlCrvAng*D2R - BladeKInputFileData%BlTwist = BladeKInputFileData%BlTwist*D2R - + ! -------------- END OF FILE -------------------------------------------- CALL Cleanup() @@ -1229,8 +1579,75 @@ SUBROUTINE Cleanup() IF (UnIn > 0) CLOSE(UnIn) END SUBROUTINE Cleanup + !............................................................................................................................... +END SUBROUTINE ReadBladeInputs +!---------------------------------------------------------------------------------------------------------------------------------- +SUBROUTINE ConvertLineToCols(Line, i, Indx, BladeKInputFileData, ErrStat, ErrMsg) + CHARACTER(*), INTENT(IN ) :: Line ! text containing line we are reading/parsing + INTEGER(IntKi), INTENT(IN ) :: i ! row of input table we are reading + INTEGER(IntKi), INTENT(IN ) :: Indx(:) ! order of table columns, determined from headers in subroutine GetInputColumnIndex() + TYPE(AD_BladePropsType), INTENT(INOUT) :: BladeKInputFileData ! Data for Blade K stored in the module's input file + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + + INTEGER(IntKi) :: NumCols ! number of columns in the file + CHARACTER(NWTC_SizeOfNumWord) :: Words(size(Indx)) + INTEGER :: IOS(size(Indx)) + INTEGER :: c ! column index + CHARACTER(*), PARAMETER :: RoutineName = 'ConvertLineToCols' + + + ErrStat = ErrID_None + ErrMsg = "" + +! CALL GetWords ( Line, Words, size(Indx), NumCols ) + !IF (MAXVAL(Indx) > NumCols) THEN + ! CALL SetErrStat(ErrID_Fatal, "Required column is not available in the table on row "//trim(num2lstr(i))//".", ErrStat, ErrMsg, RoutineName) + ! RETURN + !END IF + + ! Read "words" as character strings: + NumCols = MAXVAL(Indx) + READ(Line, *, IOStat=IOS(1)) Words(1:NumCols) + + IOS = 0 ! initialize in case we don't read all of the columns + + ! Note: See order of variable AvailableChanNames in subroutine ReadBladeInputs() for these variables indices + ! Also, we have checked that Indx is non zero and less than MaxCols for each of the required words + c=Indx( 1); READ( Words(c), *, IOStat=IOS(c) ) BladeKInputFileData%BlSpn(I) + c=Indx( 2); READ( Words(c), *, IOStat=IOS(c) ) BladeKInputFileData%BlCrvAC(I) + c=Indx( 3); READ( Words(c), *, IOStat=IOS(c) ) BladeKInputFileData%BlSwpAC(I) + c=Indx( 5); READ( Words(c), *, IOStat=IOS(c) ) BladeKInputFileData%BlTwist(I) + c=Indx( 6); READ( Words(c), *, IOStat=IOS(c) ) BladeKInputFileData%BlChord(I) + c=Indx( 7); READ( Words(c), *, IOStat=IOS(c) ) BladeKInputFileData%BlAFID(I) + + c=Indx(4) + IF (c > 0) THEN + READ( Words(c), *, IOStat=IOS(c) ) BladeKInputFileData%BlCrvAng(I) + END IF + + c=Indx(8) + IF (c > 0) THEN + READ( Words(c), *, IOStat=IOS(c) ) BladeKInputFileData%BlCb(I) + END IF + + c=Indx(9) + IF (c > 0) THEN + READ( Words(c), *, IOStat=IOS(c) ) BladeKInputFileData%BlCenBn(I) + END IF + + c=Indx(10) + IF (c > 0) THEN + READ( Words(c), *, IOStat=IOS(c) ) BladeKInputFileData%BlCenBt(I) + END IF + + IF (ANY(IOS /= 0)) THEN + CALL SetErrStat(ErrID_Fatal, "Unable to read numeric data from all columns in the table on row "//trim(num2lstr(i))//".", ErrStat, ErrMsg, RoutineName) + RETURN + END IF + +END SUBROUTINE ConvertLineToCols -END SUBROUTINE ReadBladeInputs !---------------------------------------------------------------------------------------------------------------------------------- !> Read Tail Fin inputs SUBROUTINE ReadTailFinInputs(FileName, TFData, UnEc, ErrStat, ErrMsg) @@ -1258,7 +1675,6 @@ SUBROUTINE ReadTailFinInputs(FileName, TFData, UnEc, ErrStat, ErrMsg) !====== General inputs ============================================================ call ParseCom(FileInfo_in, iLine, DummyLine , ErrStat2, ErrMsg2, UnEc); if (Failed()) return; call ParseVar(FileInfo_In, iLine, 'TFinMod' , TFData%TFinMod , ErrStat2, ErrMsg2, UnEc); if (Failed()) return; - call ParseVar(FileInfo_In, iLine, 'TFinChord' , TFData%TFinChord , ErrStat2, ErrMsg2, UnEc); if (Failed()) return; call ParseVar(FileInfo_In, iLine, 'TFinArea' , TFData%TFinArea , ErrStat2, ErrMsg2, UnEc); if (Failed()) return; call ParseAry(FileInfo_In, iLine, 'TFinRefP_n', TFData%TFinRefP_n, 3 , ErrStat2, ErrMsg2, UnEc); if (Failed()) return; call ParseAry(FileInfo_In, iLine, 'TFinAngles', TFData%TFinAngles, 3 , ErrStat2, ErrMsg2, UnEc); if (Failed()) return; @@ -1266,17 +1682,23 @@ SUBROUTINE ReadTailFinInputs(FileName, TFData, UnEc, ErrStat, ErrMsg) !====== Polar-based model ================================ [used only when TFinMod=1] call ParseCom(FileInfo_in, iLine, DummyLine , ErrStat2, ErrMsg2, UnEc); if (Failed()) return; call ParseVar(FileInfo_In, iLine, 'TFinAFID' , TFData%TFinAFID , ErrStat2, ErrMsg2, UnEc); if (Failed()) return; + call ParseVar(FileInfo_In, iLine, 'TFinChord' , TFData%TFinChord , ErrStat2, ErrMsg2, UnEc); if (Failed()) return; !====== Unsteady slender body model ===================== [used only when TFinMod=2] call ParseCom(FileInfo_in, iLine, DummyLine , ErrStat2, ErrMsg2, UnEc); if (Failed()) return; + call ParseVar(FileInfo_In, iLine, 'TFinKp' , TFData%TFinKp , ErrStat2, ErrMsg2, UnEc); if (Failed()) return; + call ParseAry(FileInfo_In, iLine, 'TFinSigma' , TFData%TFinSigma, 3 , ErrStat2, ErrMsg2, UnEc); if (Failed()) return; + call ParseAry(FileInfo_In, iLine, 'TFinAStar', TFData%TFinAStar, 3 , ErrStat2, ErrMsg2, UnEc); if (Failed()) return; + call ParseVar(FileInfo_In, iLine, 'TFinKv' , TFData%TFinKv , ErrStat2, ErrMsg2, UnEc); if (Failed()) return; + call ParseVar(FileInfo_In, iLine, 'TFinCDc' , TFData%TFinCDc , ErrStat2, ErrMsg2, UnEc); if (Failed()) return; + ! TODO ! --- Triggers TFData%TFinAngles = TFData%TFinAngles*D2R ! deg2rad ! --- Validation on the fly - !if (all((/TFinAero_none,TFinAero_polar, TFinAero_USB/) /= TFData%TFinMod)) then - if (all((/TFinAero_none,TFinAero_polar/) /= TFData%TFinMod)) then - call Fatal('TFinMod needs to be 0, or 1') + if (all((/TFinAero_none,TFinAero_polar,TFinAero_USB/) /= TFData%TFinMod)) then + call Fatal('TFinMod needs to be 0, 1 or 2') endif !if (all((/TFinIndMod_none,TFinIndMod_rotavg/) /= TFData%TFinIndMod)) then if (all((/TFinIndMod_none/) /= TFData%TFinIndMod)) then @@ -1296,7 +1718,7 @@ end subroutine Fatal END SUBROUTINE ReadTailFinInputs !---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE AD_PrintSum( InputFileData, p, p_AD, u, y, ErrStat, ErrMsg ) +SUBROUTINE AD_PrintSum( InputFileData, p, p_AD, u, y, NumBlades, BladeInputFileData, ErrStat, ErrMsg ) ! This routine generates the summary file, which contains a summary of input file options. use YAML, only: yaml_write_var ! passed variables @@ -1305,6 +1727,9 @@ SUBROUTINE AD_PrintSum( InputFileData, p, p_AD, u, y, ErrStat, ErrMsg ) TYPE(AD_ParameterType), INTENT(IN) :: p_AD ! Parameters TYPE(AD_InputType), INTENT(IN) :: u ! inputs TYPE(AD_OutputType), INTENT(IN) :: y ! outputs + INTEGER(IntKi), INTENT(IN) :: NumBlades ! Number of blades for this rotor + TYPE(AD_BladePropsType), INTENT(IN) :: BladeInputFileData(:) ! Data for Bladex stored in the module's input file + INTEGER(IntKi), INTENT(OUT) :: ErrStat CHARACTER(*), INTENT(OUT) :: ErrMsg @@ -1312,6 +1737,7 @@ SUBROUTINE AD_PrintSum( InputFileData, p, p_AD, u, y, ErrStat, ErrMsg ) ! Local variables. INTEGER(IntKi) :: I ! Index for the nodes. + INTEGER(IntKi) :: K ! Index for the blades INTEGER(IntKi) :: UnSu ! I/O unit number for the summary output file CHARACTER(*), PARAMETER :: FmtDat = '(A,T41,1(:,F13.3))' ! Format for outputting mass and modal data. @@ -1338,11 +1764,9 @@ SUBROUTINE AD_PrintSum( InputFileData, p, p_AD, u, y, ErrStat, ErrMsg ) WRITE (UnSu,'(/,A)') '====== General Options ============================================================================' ! WakeMod - select case (p_AD%WakeMod) + select case (p_AD%Wake_Mod) case (WakeMod_BEMT) Msg = 'Blade-Element/Momentum Theory' - case (WakeMod_DBEMT) - Msg = 'Dynamic Blade-Element/Momentum Theory' case (WakeMod_FVW) Msg = 'Free Vortex Wake Theory' case (WakeMod_None) @@ -1350,20 +1774,7 @@ SUBROUTINE AD_PrintSum( InputFileData, p, p_AD, u, y, ErrStat, ErrMsg ) case default Msg = 'unknown' end select - WRITE (UnSu,Ec_IntFrmt) p_AD%WakeMod, 'WakeMod', 'Type of wake/induction model: '//TRIM(Msg) - - - ! AFAeroMod - select case (InputFileData%AFAeroMod) - case (AFAeroMod_BL_unsteady) - Msg = 'Beddoes-Leishman unsteady model' - case (AFAeroMod_steady) - Msg = 'steady' - case default - Msg = 'unknown' - end select - WRITE (UnSu,Ec_IntFrmt) InputFileData%AFAeroMod, 'AFAeroMod', 'Type of blade airfoil aerodynamics model: '//TRIM(Msg) - + WRITE (UnSu,Ec_IntFrmt) p_AD%Wake_Mod, 'WakeMod', 'Type of wake/induction model: '//TRIM(Msg) ! TwrPotent select case (p%TwrPotent) @@ -1386,20 +1797,25 @@ SUBROUTINE AD_PrintSum( InputFileData, p, p_AD, u, y, ErrStat, ErrMsg ) case (TwrShadow_Eames) Msg = 'Eames tower shadow model with TI values from the table' case (TwrShadow_none) - Msg = 'none' - case default - Msg = 'unknown' + Msg = 'none' + case default + Msg = 'unknown' end select WRITE (UnSu,Ec_IntFrmt) p%TwrShadow, 'TwrShadow', 'Type of tower influence on wind based on downstream tower shadow: '//TRIM(Msg) - + ! TwrAero - if (p%TwrAero) then - Msg = 'Yes' - else - Msg = 'No' - end if - WRITE (UnSu,Ec_LgFrmt) p%TwrAero, 'TwrAero', 'Calculate tower aerodynamic loads? '//TRIM(Msg) + select case (p%TwrAero) + case (TwrAero_none) + Msg = "none" + case (TwrAero_NoVIV) + Msg = "Tower aero calculated without VIV" +! case (TwrAero_VIV) +! Msg = "Tower aero calculated with VIV" + case default + Msg = 'unknown' + end select + WRITE (UnSu,Ec_LgFrmt) p%TwrAero, 'TwrAero', 'Tower aerodynamic loads: '//TRIM(Msg) ! CavitCheck if (p%CavitCheck) then @@ -1417,22 +1833,30 @@ SUBROUTINE AD_PrintSum( InputFileData, p, p_AD, u, y, ErrStat, ErrMsg ) end if WRITE (UnSu,Ec_LgFrmt) p%Buoyancy, 'Buoyancy', 'Include buoyancy effects? '//TRIM(Msg) + ! Nacelle Drag + if (p%NacelleDrag) then + Msg = 'Yes' + else + Msg = 'No' + end if + WRITE (UnSu,Ec_LgFrmt) p%NacelleDrag, 'NacelleDrag', 'Include NacelleDrag effects? '//TRIM(Msg) + - if (p_AD%WakeMod/=WakeMod_none) then + if (p_AD%Wake_Mod/=WakeMod_none) then WRITE (UnSu,'(A)') '====== Blade-Element/Momentum Theory Options ======================================================' ! SkewMod - select case (InputFileData%SkewMod) - case (SkewMod_Orthogonal) + select case (InputFileData%Skew_Mod) + case (Skew_Mod_Orthogonal) Msg = 'orthogonal' - case (SkewMod_Uncoupled) - Msg = 'uncoupled' - case (SkewMod_PittPeters) - Msg = 'Pitt/Peters' + case (Skew_Mod_None) + Msg = 'no correction' + case (Skew_Mod_Active) + Msg = 'active' case default Msg = 'unknown' end select - WRITE (UnSu,Ec_IntFrmt) InputFileData%SkewMod, 'SkewMod', 'Type of skewed-wake correction model: '//TRIM(Msg) + WRITE (UnSu,Ec_IntFrmt) InputFileData%Skew_Mod, 'Skew_Mod', 'Skewed-wake correction model: '//TRIM(Msg) ! TipLoss @@ -1484,63 +1908,86 @@ SUBROUTINE AD_PrintSum( InputFileData, p, p_AD, u, y, ErrStat, ErrMsg ) ! MaxIter - if (p_AD%WakeMod == WakeMod_DBEMT) then - select case (InputFileData%DBEMT_Mod) - case (DBEMT_tauConst) - Msg = 'constant tau1' - case (DBEMT_tauVaries) - Msg = 'time-dependent tau1' - case (DBEMT_cont_tauConst) - Msg = 'continuous formulation with constant tau1' - case default - Msg = 'unknown' - end select - - WRITE (UnSu,Ec_IntFrmt) InputFileData%DBEMT_Mod, 'DBEMT_Mod', 'Type of dynamic BEMT (DBEMT) model: '//TRIM(Msg) + select case (InputFileData%DBEMT_Mod) + case (DBEMT_frozen) + Msg = 'frozen-wake' + case (DBEMT_none) + Msg = 'quasi-steady' + case (DBEMT_tauConst) + Msg = 'dynamic - constant tau1' + case (DBEMT_tauVaries) + Msg = 'dynamic - time-dependent tau1' + case (DBEMT_cont_tauConst) + Msg = 'dynamic - continuous formulation with constant tau1' + case default + Msg = 'unknown' + end select + + WRITE (UnSu,Ec_IntFrmt) InputFileData%DBEMT_Mod, 'DBEMT_Mod', 'Type of dynamic BEMT (DBEMT) model: '//TRIM(Msg) - if (InputFileData%DBEMT_Mod==DBEMT_tauConst) & - WRITE (UnSu,Ec_ReFrmt) InputFileData%tau1_const, 'tau1_const', 'Time constant for DBEMT (s)' + if (InputFileData%DBEMT_Mod==DBEMT_tauConst) & + WRITE (UnSu,Ec_ReFrmt) InputFileData%tau1_const, 'tau1_const', 'Time constant for DBEMT (s)' - end if end if - if (InputFileData%AFAeroMod==AFAeroMod_BL_unsteady) then - WRITE (UnSu,'(A)') '====== Beddoes-Leishman Unsteady Airfoil Aerodynamics Options =====================================' - - ! UAMod - select case (InputFileData%UAMod) - case (UA_Baseline) - Msg = 'baseline model (original)' - case (UA_Gonzalez) - Msg = "Gonzalez's variant (changes in Cn, Cc, and Cm)" - case (UA_MinnemaPierce) - Msg = 'Minnema/Pierce variant (changes in Cc and Cm)' - !case (4) - ! Msg = 'DYSTOOL' - case (UA_HGM) - Msg = 'HGM (continuous state)' - case (UA_HGMV) - Msg = 'HGMV (continuous state + vortex)' - case (UA_OYE) - Msg = 'Stieg Oye dynamic stall model' - case (UA_BV) - Msg = 'Boeing-Vertol dynamic stall model (e.g. used in CACTUS)' - case default - Msg = 'unknown' - end select - WRITE (UnSu,Ec_IntFrmt) InputFileData%UAMod, 'UAMod', 'Unsteady Aero Model: '//TRIM(Msg) - + WRITE (UnSu,'(A)') '======================== Unsteady Airfoil Aerodynamics Options =====================================' - ! FLookup - if (InputFileData%FLookup) then - Msg = 'Yes' - else - Msg = 'No, use best-fit exponential equations instead' - end if - WRITE (UnSu,Ec_LgFrmt) InputFileData%FLookup, 'FLookup', "Use a lookup for f'? "//TRIM(Msg) - - end if + ! UAMod + select case (InputFileData%UA_Init%UAMod) + case (UA_None) + Msg = 'none (quasi-steady airfoil aerodynamics)' + case (UA_Baseline) + Msg = 'baseline model (original)' + case (UA_Gonzalez) + Msg = "Gonzalez's variant (changes in Cn, Cc, and Cm)" + case (UA_MinnemaPierce) + Msg = 'Minnema/Pierce variant (changes in Cc and Cm)' + !case (4) + ! Msg = 'DYSTOOL' + case (UA_HGM) + Msg = 'HGM (continuous state)' + case (UA_HGMV) + Msg = 'HGMV (continuous state + vortex)' + case (UA_OYE) + Msg = 'Stieg Oye dynamic stall model' + case (UA_BV) + Msg = 'Boeing-Vertol dynamic stall model (e.g. used in CACTUS)' + case default + Msg = 'unknown' + end select + WRITE (UnSu,Ec_IntFrmt) InputFileData%UA_Init%UAMod, 'UA_Mod', 'Unsteady Aero Model: '//TRIM(Msg) + + + ! FLookup + if (InputFileData%UA_Init%FLookup) then + Msg = 'Yes' + else + Msg = 'No, use best-fit exponential equations instead' + end if + WRITE (UnSu,Ec_LgFrmt) InputFileData%UA_Init%FLookup, 'FLookup', "Use a lookup for f'? "//TRIM(Msg) + + + ! IntegrationMethod + select case (InputFileData%UA_Init%IntegrationMethod) + case (UA_Method_RK4) + Msg = 'fourth-order Runge-Kutta Method (RK4)' + case (UA_Method_AB4) + Msg = 'fourth-order Adams-Bashforth Method (AB4)' + case (UA_Method_ABM4) + Msg = "fourth-order Adams-Bashforth-Moulton Method (ABM4)" + case (UA_Method_BDF2) + Msg = '2nd-order backward differentiation formula (BDF2)' + case default + Msg = 'unknown' + end select + WRITE (UnSu,Ec_IntFrmt) InputFileData%UA_Init%IntegrationMethod, 'IntegrationMethod', 'Integration method for continuous UA models: '//TRIM(Msg) + + + ! UAStartRad, UAEndRad + WRITE (UnSu,"( 2X, F11.5,2X,A,T30,' - ',A )") InputFileData%UAStartRad, 'UAStartRad', 'Starting blade radius fraction for UA models (-)' ! compare with Ec_ReFrmt format statement + WRITE (UnSu,"( 2X, F11.5,2X,A,T30,' - ',A )") InputFileData%UAEndRad, 'UAEndRad', 'Ending blade radius fraction for UA models (-)' + WRITE (UnSu,'(A)') '====== Outputs ====================================================================================' @@ -1594,6 +2041,23 @@ SUBROUTINE AD_PrintSum( InputFileData, p, p_AD, u, y, ErrStat, ErrMsg ) call yaml_write_var ( UnSu , 'Total blade volume (m^3)' , p%VolBl , 'F7.3' , ErrStat , ErrMsg ) ! Buoyancy volume of all blades call yaml_write_var ( UnSu , 'Tower volume (m^3)' , p%VolTwr , 'F13.3' , ErrStat , ErrMsg ) ! Buoyancy volume of the tower + WRITE (UnSu,'(/,/,A)') '====== Blade definitions ==========================================================================' + + DO k=1,NumBlades + WRITE (UnSu,'(15x,A)') + WRITE (UnSu,'(3x,A,I2,A)') '----- Blade ', k, ' -----------------------------------------------------------------------------------------------------------' + WRITE (UnSu,'(6(1x,A20))') 'BlSpn', 'BlCrvAC', 'BlSwpAC','BlCrvAng','BlTwist', 'BlChord' + WRITE (UnSu,'(6(1x,A20))') '(m)', '(m)', '(m)', '(deg)', '(deg)', '(m)' + WRITE (UnSu,'(6(1x,A20))') '--------','--------','-------','--------','--------','--------' + DO I=1,size(BladeInputFileData(K)%BlSpn) + WRITE( UnSu, '(3( 1X,F20.6), 2( 1X,F20.4 ), 1( 1X,F20.6))') & + BladeInputFileData(K)%BlSpn(I), BladeInputFileData(K)%BlCrvAC(I), BladeInputFileData(K)%BlSwpAC(I), & + BladeInputFileData(K)%BlCrvAng(I)*R2D, BladeInputFileData(K)%BlTwist(I)*R2D, BladeInputFileData(K)%BlChord(I) + END DO + END DO + + + CLOSE(UnSu) RETURN @@ -1612,12 +2076,12 @@ END SUBROUTINE AD_PrintSum !! 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 07-Sep-2022 16:15:55. +!! This routine was generated by Write_ChckOutLst.m using the parameters listed in OutListParameters.xlsx at 27-Oct-2022 11:00:28. SUBROUTINE SetOutParam(OutList, p, p_AD, ErrStat, ErrMsg ) !.................................................................................................................................. - + IMPLICIT NONE - + ! Passed variables CHARACTER(ChanLen), INTENT(IN) :: OutList(:) !< The list of user-requested outputs @@ -1655,7 +2119,7 @@ SUBROUTINE SetOutParam(OutList, p, p_AD, ErrStat, ErrMsg ) end if - if (p_AD%WakeMod /= WakeMod_DBEMT) then + if (p%DBEMT_Mod == DBEMT_none) then InvalidOutput( DBEMTau1 ) = .true. end if @@ -1697,7 +2161,27 @@ SUBROUTINE SetOutParam(OutList, p, p_AD, ErrStat, ErrMsg ) InvalidOutput( BNMbs(:,i) ) = .true. end do end if + + if (.not. p%NacelleDrag) then ! Invalid Nacelle Drag loads + InvalidOutput( NcFdx ) = .true. + InvalidOutput( NcFdy ) = .true. + InvalidOutput( NcFdz ) = .true. + InvalidOutput( NcMdx ) = .true. + InvalidOutput( NcMdy ) = .true. + InvalidOutput( NcMdz ) = .true. + end if + + if (.not. (p%NacelleDrag .OR. p%Buoyancy)) then ! Invalid Nacelle Total loads + InvalidOutput( NcFxi ) = .true. + InvalidOutput( NcFyi ) = .true. + InvalidOutput( NcFzi ) = .true. + InvalidOutput( NcMxi ) = .true. + InvalidOutput( NcMyi ) = .true. + InvalidOutput( NcMzi ) = .true. + end if + + DO i = p%NTwOuts+1,9 ! Invalid tower nodes InvalidOutput( TwNVUnd(:,i) ) = .true. @@ -1717,7 +2201,7 @@ SUBROUTINE SetOutParam(OutList, p, p_AD, ErrStat, ErrMsg ) END DO - DO I = p%NumBlades+1,size(BAzimuth,1) ! Invalid blades + DO I = p%NumBlades+1,size(BAzimuth,1) ! Invalid blades (Note: size(BAzimuth) should be AD_MaxBl_Out) InvalidOutput( BAzimuth( i) ) = .true. InvalidOutput( BPitch( i) ) = .true. @@ -1871,18 +2355,19 @@ SUBROUTINE SetOutParam(OutList, p, p_AD, ErrStat, ErrMsg ) 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 !********************************************************************************************************************************** + !---------------------------------------------------------------------------------------------------------------------------------- !> This subroutine sets up the information needed for plotting VTK surfaces. subroutine AD_SetVTKSurface(InitOutData_AD, u_AD, VTK_Surface, errStat, errMsg) @@ -2139,254 +2624,78 @@ SUBROUTINE AD_SetVTKDefaultBladeParams(M, BladeShape, tipNode, rootNode, cylNode END SUBROUTINE AD_SetVTKDefaultBladeParams -subroutine calcCantAngle(f, xi,stencilSize,n,cantAngle) -! This subroutine calculates implicit cant angle based on the blade reference line that includes prebend. - implicit none - integer(IntKi), intent(in) :: stencilSize, n - integer(IntKi) :: i, j - integer(IntKi) :: info - real(ReKi), intent(in) :: f(n), xi(n) - real(ReKi) :: cx(stencilSize), cf(stencilSize), xiIn(stencilSize) - real(ReKi) :: fIn(stencilSize), cPrime(n), fPrime(n) - real(ReKi), intent(inout) :: cantAngle(n) - - do i = 1,size(xi) - - if (i.eq.1) then - fIn = f(1:stencilSize) - xiIn = xi(1:stencilSize) - elseif (i.eq.size(xi)) then - fIn = f(size(xi)-stencilSize +1:size(xi)) - xiIn = xi(size(xi)-stencilSize+1:size(xi)) - else - fIn = f(i-1:i+1) - xiIn = xi(i-1:i+1) - endif - call differ_stencil ( xi(i), 1, 2, xiIn, cx, info ) - !call differ_stencil ( xi(i), 1, 2, fIn, cf, info ) - if (info /= 0) then - print*,'Cant Calc failed at i=',i - else - cPrime(i) = 0.0 - fPrime(i) = 0.0 - do j = 1,size(cx) - cPrime(i) = cPrime(i) + cx(j)*xiIn(j) - fPrime(i) = fPrime(i) + cx(j)*fIn(j) - end do - cantAngle(i) = atan2(fPrime(i),cPrime(i))*180_ReKi/pi - endif - end do - -end subroutine calcCantAngle - - - -subroutine differ_stencil ( x0, o, p, x, c, info ) - -!*****************************************************************************80 -! -!! DIFFER_STENCIL computes finite difference coefficients. -! -! Discussion: -! -! We determine coefficients C to approximate the derivative at X0 -! of order O and precision P, using finite differences, so that -! -! d^o f(x)/dx^o (x0) = sum ( 0 <= i <= o+p-1 ) c(i) f(x(i)) -! + O(h^(p)) -! -! where H is the maximum spacing between X0 and any X(I). -! -! Licensing: -! -! This code is distributed under the GNU LGPL license. -! -! Modified: -! -! 10 November 2013 -! -! Author: -! -! John Burkardt -! -! Parameters: -! -! Input, real ( kind = 8 ) X0, the point where the derivative is to -! be approximated. -! -! Input, integer ( kind = 4 ) O, the order of the derivative to be -! approximated. 1 <= O. -! -! Input, integer ( kind = 4 ) P, the order of the error, as a power of H. -! -! Input, real ( kind = 8 ) X(O+P), the evaluation points. -! -! Output, real ( kind = 8 ) C(O+P), the coefficients. -! - implicit none - - integer(IntKi), intent(in) :: o - integer(IntKi), intent(in) :: p - - real(ReKi) :: b(o+p) - real(ReKi), intent(out) :: c(o+p) - real(ReKi) :: dx(o+p) - integer(IntKi) :: i - integer(IntKi), intent(out) :: info - integer(IntKi) :: job - integer(IntKi) :: n - real(R8Ki) :: r8_factorial - real(ReKi), intent(in) :: x(o+p) - real(ReKi), intent(in) :: x0 - - n = o + p - - dx(1:n) = x(1:n) - x0 - - b(1:o+p) = 0.0D+00 - b(o+1) = 1.0D+00 - - job = 0 - call r8vm_sl ( n, dx, b, c, job, info ) - - if ( info /= 0 ) then - call WrScr('DIFFER_STENCIL: Vandermonde linear system is singular.') - return - end if - r8_factorial = 1.0D+00 - do i = 1,o - r8_factorial = r8_factorial*i - end do - c(1:n) = c(1:n) * r8_factorial - - return - -end subroutine differ_stencil - -subroutine r8vm_sl ( n, a, b, x, job, info ) - -!*****************************************************************************80 -! -!! R8VM_SL solves an R8VM linear system. -! -! Discussion: -! -! The R8VM storage format is used for an M by N Vandermonde matrix. -! An M by N Vandermonde matrix is defined by the values in its second -! row, which will be written here as X(1:N). The matrix has a first -! row of 1's, a second row equal to X(1:N), a third row whose entries -! are the squares of the X values, up to the M-th row whose entries -! are the (M-1)th powers of the X values. The matrix can be stored -! compactly by listing just the values X(1:N). -! -! Vandermonde systems are very close to singularity. The singularity -! gets worse as N increases, and as any pair of values defining -! the matrix get close. Even a system as small as N = 10 will -! involve the 9th power of the defining values. -! -! Licensing: -! -! This code is distributed under the GNU LGPL license. -! -! Modified: -! -! 29 September 2003 -! -! Author: -! -! John Burkardt. -! -! Reference: -! -! Gene Golub, Charles Van Loan, -! Matrix Computations, -! Third Edition, -! Johns Hopkins, 1996. -! -! Parameters: -! -! Input, integer ( kind = 4 ) N, the number of rows and columns of -! the matrix. -! -! Input, real ( kind = 8 ) A(N), the R8VM matrix. -! -! Input, real ( kind = 8 ) B(N), the right hand side. -! -! Output, real ( kind = 8 ) X(N), the solution of the linear system. -! -! Input, integer ( kind = 4 ) JOB, specifies the system to solve. -! 0, solve A * x = b. -! nonzero, solve A' * x = b. -! -! Output, integer ( kind = 4 ) INFO. -! 0, no error. -! nonzero, at least two of the values in A are equal. -! - implicit none - - integer (IntKi ), intent(in) :: n - - real(ReKi), intent(in) :: a(n) - real(ReKi), intent(in) :: b(n) - integer(IntKi) :: i - integer(IntKi), intent(out) :: info - integer(IntKi) :: j - integer(IntKi), intent(in) :: job - real(ReKi), intent(out) :: x(n) -! -! Check for explicit singularity. -! - info = 0 - - do j = 1, n - 1 - do i = j + 1, n - if ( a(i) == a(j) ) then - info = 1 - return - end if - end do - end do - - x(1:n) = b(1:n) - - if ( job == 0 ) then - - do j = 1, n - 1 - do i = n, j + 1, -1 - x(i) = x(i) - a(j) * x(i-1) - end do - end do - - do j = n - 1, 1, -1 - - do i = j + 1, n - x(i) = x(i) / ( a(i) - a(i-j) ) - end do - - do i = j, n - 1 - x(i) = x(i) - x(i+1) - end do - - end do - - else - - do j = 1, n - 1 - do i = n, j + 1, -1 - x(i) = ( x(i) - x(i-1) ) / ( a(i) - a(i-j) ) - end do - end do - - do j = n - 1, 1, -1 - do i = j, n - 1 - x(i) = x(i) - x(i+1) * a(j) - end do - end do +!---------------------------------------------------------------------------------------------------------------------------------- +!> Set the cant angle from the mid-chord reference line +!! SETCANTANGLE() will update the BlCrvAng based upon the projection of +!! the mid-chord reference line onto the X-Z plane. +!! +!! NOTE: this assumes that the cant and toe angles are zero and only the +!! local twist and chord length contirbute to the mid-chord location; in +!! the future an iterative approach could be taken to include the cant +!! angle influence on the mid-code node locations +subroutine setCantAngle( BladeKInputFileData ) +! Note: we have already checked that BladeKInputFileData%NumBlNds > 2 and that zMidChord is in increasing order (not constant) + TYPE(AD_BladePropsType), INTENT(INOUT) :: BladeKInputFileData + + REAL(ReKi) :: dx( BladeKInputFileData%NumBlNds) + REAL(ReKi) :: xMidChord( BladeKInputFileData%NumBlNds) + REAL(ReKi) :: zMidChord( BladeKInputFileData%NumBlNds) + REAL(ReKi) :: prebendSlope(BladeKInputFileData%NumBlNds) + INTEGER :: NumBlNds + INTEGER :: ii ! loop counter + + NumBlNds = BladeKInputFileData%NumBlNds + + ! Compute mid-chord location in global system + dx = 0.25_ReKi * BladeKInputFileData%BlChord * sin( BladeKInputFileData%BlTwist ) ! note element-by-element multiplication (not matrix multiply here); twist is in radians + + xMidChord = BladeKInputFileData%BlCrvAC + dx + zMidChord = BladeKInputFileData%BlSpn - end if + + ! Compute prebend slope relative to z-span + + ! Root node + prebendSlope(1) = dfdxOfLagrangeInterpolant( zMidChord(1), & + zMidChord(1), xMidChord(1), & + zMidChord(2), xMidChord(2), & + zMidChord(3), xMidChord(3) ) + + ! Internal nodes + do ii = 2, NumBlNds - 1 + prebendSlope(ii) = dfdxOfLagrangeInterpolant( zMidChord(ii), & + zMidChord(ii-1), xMidChord(ii-1), & + zMidChord(ii), xMidChord(ii), & + zMidChord(ii+1), xMidChord(ii+1) ) + end do - return -end subroutine r8vm_sl + ! Tip node + prebendSlope(NumBlNds) = dfdxOfLagrangeInterpolant( zMidChord(NumBlNds), & + zMidChord(NumBlNds-2), xMidChord(NumBlNds-2), & + zMidChord(NumBlNds-1), xMidChord(NumBlNds-1), & + zMidChord(NumBlNds), xMidChord(NumBlNds) ) + ! Convert slope to cant angle + BladeKInputFileData%BlCrvAng = atan2( prebendSlope, 1.0_ReKi ) ! return value in radians + +end subroutine setCantAngle +!---------------------------------------------------------------------------------------------------------------------------------- +!> df/dx approximation from Lagrange interpolating polynomial +!! See Eqn 5 at https://mathworld.wolfram.com/LagrangeInterpolatingPolynomial.html +REAL(ReKi) function dfdxOfLagrangeInterpolant(x, x1, f1, x2, f2, x3, f3) RESULT(dfdx) + + REAL(ReKi) , INTENT(IN) :: x + REAL(ReKi) , INTENT(IN) :: x1 + REAL(ReKi) , INTENT(IN) :: x2 + REAL(ReKi) , INTENT(IN) :: x3 + REAL(ReKi) , INTENT(IN) :: f1 + REAL(ReKi) , INTENT(IN) :: f2 + REAL(ReKi) , INTENT(IN) :: f3 + + dfdx = f1 * (2*x-x2-x3)/((x1-x2)*(x1-x3)) & + + f2 * (2*x-x1-x3)/((x2-x1)*(x2-x3)) & + + f3 * (2*x-x1-x2)/((x3-x1)*(x3-x2)); + +end function dfdxOfLagrangeInterpolant !---------------------------------------------------------------------------------------------------------------------------------- END MODULE AeroDyn_IO diff --git a/modules/aerodyn/src/AeroDyn_IO_Params.f90 b/modules/aerodyn/src/AeroDyn_IO_Params.f90 index 3568cd8b32..d31c280d2c 100644 --- a/modules/aerodyn/src/AeroDyn_IO_Params.f90 +++ b/modules/aerodyn/src/AeroDyn_IO_Params.f90 @@ -1546,36 +1546,48 @@ module AeroDyn_IO_Params INTEGER(IntKi), PARAMETER :: NcMbx = 1496 INTEGER(IntKi), PARAMETER :: NcMby = 1497 INTEGER(IntKi), PARAMETER :: NcMbz = 1498 + INTEGER(IntKi), PARAMETER :: NcFdx = 1499 + INTEGER(IntKi), PARAMETER :: NcFdy = 1500 + INTEGER(IntKi), PARAMETER :: NcFdz = 1501 + INTEGER(IntKi), PARAMETER :: NcMdx = 1502 + INTEGER(IntKi), PARAMETER :: NcMdy = 1503 + INTEGER(IntKi), PARAMETER :: NcMdz = 1504 + INTEGER(IntKi), PARAMETER :: NcFxi = 1505 + INTEGER(IntKi), PARAMETER :: NcFyi = 1506 + INTEGER(IntKi), PARAMETER :: NcFzi = 1507 + INTEGER(IntKi), PARAMETER :: NcMxi = 1508 + INTEGER(IntKi), PARAMETER :: NcMyi = 1509 + INTEGER(IntKi), PARAMETER :: NcMzi = 1510 ! TailFin: - INTEGER(IntKi), PARAMETER :: TFAlpha = 1499 - INTEGER(IntKi), PARAMETER :: TFMach = 1500 - INTEGER(IntKi), PARAMETER :: TFRe = 1501 - INTEGER(IntKi), PARAMETER :: TFVrel = 1502 - INTEGER(IntKi), PARAMETER :: TFVundxi = 1503 - INTEGER(IntKi), PARAMETER :: TFVundyi = 1504 - INTEGER(IntKi), PARAMETER :: TFVundzi = 1505 - INTEGER(IntKi), PARAMETER :: TFVindxi = 1506 - INTEGER(IntKi), PARAMETER :: TFVindyi = 1507 - INTEGER(IntKi), PARAMETER :: TFVindzi = 1508 - INTEGER(IntKi), PARAMETER :: TFVrelxi = 1509 - INTEGER(IntKi), PARAMETER :: TFVrelyi = 1510 - INTEGER(IntKi), PARAMETER :: TFVrelzi = 1511 - INTEGER(IntKi), PARAMETER :: TFSTVxi = 1512 - INTEGER(IntKi), PARAMETER :: TFSTVyi = 1513 - INTEGER(IntKi), PARAMETER :: TFSTVzi = 1514 - INTEGER(IntKi), PARAMETER :: TFFxi = 1515 - INTEGER(IntKi), PARAMETER :: TFFyi = 1516 - INTEGER(IntKi), PARAMETER :: TFFzi = 1517 - INTEGER(IntKi), PARAMETER :: TFMxi = 1518 - INTEGER(IntKi), PARAMETER :: TFMyi = 1519 - INTEGER(IntKi), PARAMETER :: TFMzi = 1520 + INTEGER(IntKi), PARAMETER :: TFAlpha = 1511 + INTEGER(IntKi), PARAMETER :: TFMach = 1512 + INTEGER(IntKi), PARAMETER :: TFRe = 1513 + INTEGER(IntKi), PARAMETER :: TFVrel = 1514 + INTEGER(IntKi), PARAMETER :: TFVundxi = 1515 + INTEGER(IntKi), PARAMETER :: TFVundyi = 1516 + INTEGER(IntKi), PARAMETER :: TFVundzi = 1517 + INTEGER(IntKi), PARAMETER :: TFVindxi = 1518 + INTEGER(IntKi), PARAMETER :: TFVindyi = 1519 + INTEGER(IntKi), PARAMETER :: TFVindzi = 1520 + INTEGER(IntKi), PARAMETER :: TFVrelxi = 1521 + INTEGER(IntKi), PARAMETER :: TFVrelyi = 1522 + INTEGER(IntKi), PARAMETER :: TFVrelzi = 1523 + INTEGER(IntKi), PARAMETER :: TFSTVxi = 1524 + INTEGER(IntKi), PARAMETER :: TFSTVyi = 1525 + INTEGER(IntKi), PARAMETER :: TFSTVzi = 1526 + INTEGER(IntKi), PARAMETER :: TFFxi = 1527 + INTEGER(IntKi), PARAMETER :: TFFyi = 1528 + INTEGER(IntKi), PARAMETER :: TFFzi = 1529 + INTEGER(IntKi), PARAMETER :: TFMxi = 1530 + INTEGER(IntKi), PARAMETER :: TFMyi = 1531 + INTEGER(IntKi), PARAMETER :: TFMzi = 1532 ! The maximum number of output channels which can be output by the code. - INTEGER(IntKi), PARAMETER :: MaxOutPts = 1520 + INTEGER(IntKi), PARAMETER :: MaxOutPts = 1532 !End of code generated by Matlab script ! =================================================================================================== @@ -1874,7 +1886,7 @@ module AeroDyn_IO_Params - CHARACTER(OutStrLenM1), PARAMETER :: ValidParamAry(1594) = (/ & ! This lists the names of the allowed parameters, which must be sorted alphabetically + CHARACTER(OutStrLenM1), PARAMETER :: ValidParamAry(1606) = (/ & ! This lists the names of the allowed parameters, which must be sorted alphabetically "B1AEROFX ","B1AEROFXI","B1AEROFY ","B1AEROFYI","B1AEROFZ ","B1AEROFZI","B1AEROMX ","B1AEROMXI", & "B1AEROMY ","B1AEROMYI","B1AEROMZ ","B1AEROMZI","B1AEROPWR","B1AZIMUTH","B1FLDFX ","B1FLDFXI ", & "B1FLDFY ","B1FLDFYI ","B1FLDFZ ","B1FLDFZI ","B1FLDMX ","B1FLDMXI ","B1FLDMY ","B1FLDMYI ", & @@ -2045,37 +2057,38 @@ module AeroDyn_IO_Params "B4AEROMZ ","B4AEROMZI","B4AEROPWR","B4FLDFX ","B4FLDFXI ","B4FLDFY ","B4FLDFYI ","B4FLDFZ ", & "B4FLDFZI ","B4FLDMX ","B4FLDMXI ","B4FLDMY ","B4FLDMYI ","B4FLDMZ ","B4FLDMZI ","B4FLDPWR ", & "DBEMTAU1 ","HBFBX ","HBFBY ","HBFBZ ","HBMBX ","HBMBY ","HBMBZ ","NCFBX ", & - "NCFBY ","NCFBZ ","NCMBX ","NCMBY ","NCMBZ ","RTAEROCP ","RTAEROCQ ","RTAEROCT ", & - "RTAEROFXH","RTAEROFXI","RTAEROFYH","RTAEROFYI","RTAEROFZH","RTAEROFZI","RTAEROMXH","RTAEROMXI", & - "RTAEROMYH","RTAEROMYI","RTAEROMZH","RTAEROMZI","RTAEROPWR","RTAREA ","RTFLDCP ","RTFLDCQ ", & - "RTFLDCT ","RTFLDFXG ","RTFLDFXH ","RTFLDFXI ","RTFLDFYG ","RTFLDFYH ","RTFLDFYI ","RTFLDFZG ", & - "RTFLDFZH ","RTFLDFZI ","RTFLDMXG ","RTFLDMXH ","RTFLDMXI ","RTFLDMYG ","RTFLDMYH ","RTFLDMYI ", & - "RTFLDMZG ","RTFLDMZH ","RTFLDMZI ","RTFLDPWR ","RTSKEW ","RTSPEED ","RTTSR ","RTVAVGXH ", & - "RTVAVGYH ","RTVAVGZH ","TFALPHA ","TFFXI ","TFFYI ","TFFZI ","TFMACH ","TFMXI ", & - "TFMYI ","TFMZI ","TFRE ","TFSTVXI ","TFSTVYI ","TFSTVZI ","TFVINDXI ","TFVINDYI ", & - "TFVINDZI ","TFVREL ","TFVRELXI ","TFVRELYI ","TFVRELZI ","TFVUNDXI ","TFVUNDYI ","TFVUNDZI ", & - "TWN1DYNP ","TWN1FBX ","TWN1FBY ","TWN1FBZ ","TWN1FDX ","TWN1FDY ","TWN1M ","TWN1MBX ", & - "TWN1MBY ","TWN1MBZ ","TWN1RE ","TWN1STVX ","TWN1STVY ","TWN1STVZ ","TWN1VREL ","TWN1VUNDX", & - "TWN1VUNDY","TWN1VUNDZ","TWN2DYNP ","TWN2FBX ","TWN2FBY ","TWN2FBZ ","TWN2FDX ","TWN2FDY ", & - "TWN2M ","TWN2MBX ","TWN2MBY ","TWN2MBZ ","TWN2RE ","TWN2STVX ","TWN2STVY ","TWN2STVZ ", & - "TWN2VREL ","TWN2VUNDX","TWN2VUNDY","TWN2VUNDZ","TWN3DYNP ","TWN3FBX ","TWN3FBY ","TWN3FBZ ", & - "TWN3FDX ","TWN3FDY ","TWN3M ","TWN3MBX ","TWN3MBY ","TWN3MBZ ","TWN3RE ","TWN3STVX ", & - "TWN3STVY ","TWN3STVZ ","TWN3VREL ","TWN3VUNDX","TWN3VUNDY","TWN3VUNDZ","TWN4DYNP ","TWN4FBX ", & - "TWN4FBY ","TWN4FBZ ","TWN4FDX ","TWN4FDY ","TWN4M ","TWN4MBX ","TWN4MBY ","TWN4MBZ ", & - "TWN4RE ","TWN4STVX ","TWN4STVY ","TWN4STVZ ","TWN4VREL ","TWN4VUNDX","TWN4VUNDY","TWN4VUNDZ", & - "TWN5DYNP ","TWN5FBX ","TWN5FBY ","TWN5FBZ ","TWN5FDX ","TWN5FDY ","TWN5M ","TWN5MBX ", & - "TWN5MBY ","TWN5MBZ ","TWN5RE ","TWN5STVX ","TWN5STVY ","TWN5STVZ ","TWN5VREL ","TWN5VUNDX", & - "TWN5VUNDY","TWN5VUNDZ","TWN6DYNP ","TWN6FBX ","TWN6FBY ","TWN6FBZ ","TWN6FDX ","TWN6FDY ", & - "TWN6M ","TWN6MBX ","TWN6MBY ","TWN6MBZ ","TWN6RE ","TWN6STVX ","TWN6STVY ","TWN6STVZ ", & - "TWN6VREL ","TWN6VUNDX","TWN6VUNDY","TWN6VUNDZ","TWN7DYNP ","TWN7FBX ","TWN7FBY ","TWN7FBZ ", & - "TWN7FDX ","TWN7FDY ","TWN7M ","TWN7MBX ","TWN7MBY ","TWN7MBZ ","TWN7RE ","TWN7STVX ", & - "TWN7STVY ","TWN7STVZ ","TWN7VREL ","TWN7VUNDX","TWN7VUNDY","TWN7VUNDZ","TWN8DYNP ","TWN8FBX ", & - "TWN8FBY ","TWN8FBZ ","TWN8FDX ","TWN8FDY ","TWN8M ","TWN8MBX ","TWN8MBY ","TWN8MBZ ", & - "TWN8RE ","TWN8STVX ","TWN8STVY ","TWN8STVZ ","TWN8VREL ","TWN8VUNDX","TWN8VUNDY","TWN8VUNDZ", & - "TWN9DYNP ","TWN9FBX ","TWN9FBY ","TWN9FBZ ","TWN9FDX ","TWN9FDY ","TWN9M ","TWN9MBX ", & - "TWN9MBY ","TWN9MBZ ","TWN9RE ","TWN9STVX ","TWN9STVY ","TWN9STVZ ","TWN9VREL ","TWN9VUNDX", & - "TWN9VUNDY","TWN9VUNDZ"/) - INTEGER(IntKi), PARAMETER :: ParamIndxAry(1594) = (/ & ! This lists the index into AllOuts(:) of the allowed parameters ValidParamAry(:) + "NCFBY ","NCFBZ ","NCFDX ","NCFDY ","NCFDZ ","NCFXI ","NCFYI ","NCFZI ", & + "NCMBX ","NCMBY ","NCMBZ ","NCMDX ","NCMDY ","NCMDZ ","NCMXI ","NCMYI ", & + "NCMZI ","RTAEROCP ","RTAEROCQ ","RTAEROCT ","RTAEROFXH","RTAEROFXI","RTAEROFYH","RTAEROFYI", & + "RTAEROFZH","RTAEROFZI","RTAEROMXH","RTAEROMXI","RTAEROMYH","RTAEROMYI","RTAEROMZH","RTAEROMZI", & + "RTAEROPWR","RTAREA ","RTFLDCP ","RTFLDCQ ","RTFLDCT ","RTFLDFXG ","RTFLDFXH ","RTFLDFXI ", & + "RTFLDFYG ","RTFLDFYH ","RTFLDFYI ","RTFLDFZG ","RTFLDFZH ","RTFLDFZI ","RTFLDMXG ","RTFLDMXH ", & + "RTFLDMXI ","RTFLDMYG ","RTFLDMYH ","RTFLDMYI ","RTFLDMZG ","RTFLDMZH ","RTFLDMZI ","RTFLDPWR ", & + "RTSKEW ","RTSPEED ","RTTSR ","RTVAVGXH ","RTVAVGYH ","RTVAVGZH ","TFALPHA ","TFFXI ", & + "TFFYI ","TFFZI ","TFMACH ","TFMXI ","TFMYI ","TFMZI ","TFRE ","TFSTVXI ", & + "TFSTVYI ","TFSTVZI ","TFVINDXI ","TFVINDYI ","TFVINDZI ","TFVREL ","TFVRELXI ","TFVRELYI ", & + "TFVRELZI ","TFVUNDXI ","TFVUNDYI ","TFVUNDZI ","TWN1DYNP ","TWN1FBX ","TWN1FBY ","TWN1FBZ ", & + "TWN1FDX ","TWN1FDY ","TWN1M ","TWN1MBX ","TWN1MBY ","TWN1MBZ ","TWN1RE ","TWN1STVX ", & + "TWN1STVY ","TWN1STVZ ","TWN1VREL ","TWN1VUNDX","TWN1VUNDY","TWN1VUNDZ","TWN2DYNP ","TWN2FBX ", & + "TWN2FBY ","TWN2FBZ ","TWN2FDX ","TWN2FDY ","TWN2M ","TWN2MBX ","TWN2MBY ","TWN2MBZ ", & + "TWN2RE ","TWN2STVX ","TWN2STVY ","TWN2STVZ ","TWN2VREL ","TWN2VUNDX","TWN2VUNDY","TWN2VUNDZ", & + "TWN3DYNP ","TWN3FBX ","TWN3FBY ","TWN3FBZ ","TWN3FDX ","TWN3FDY ","TWN3M ","TWN3MBX ", & + "TWN3MBY ","TWN3MBZ ","TWN3RE ","TWN3STVX ","TWN3STVY ","TWN3STVZ ","TWN3VREL ","TWN3VUNDX", & + "TWN3VUNDY","TWN3VUNDZ","TWN4DYNP ","TWN4FBX ","TWN4FBY ","TWN4FBZ ","TWN4FDX ","TWN4FDY ", & + "TWN4M ","TWN4MBX ","TWN4MBY ","TWN4MBZ ","TWN4RE ","TWN4STVX ","TWN4STVY ","TWN4STVZ ", & + "TWN4VREL ","TWN4VUNDX","TWN4VUNDY","TWN4VUNDZ","TWN5DYNP ","TWN5FBX ","TWN5FBY ","TWN5FBZ ", & + "TWN5FDX ","TWN5FDY ","TWN5M ","TWN5MBX ","TWN5MBY ","TWN5MBZ ","TWN5RE ","TWN5STVX ", & + "TWN5STVY ","TWN5STVZ ","TWN5VREL ","TWN5VUNDX","TWN5VUNDY","TWN5VUNDZ","TWN6DYNP ","TWN6FBX ", & + "TWN6FBY ","TWN6FBZ ","TWN6FDX ","TWN6FDY ","TWN6M ","TWN6MBX ","TWN6MBY ","TWN6MBZ ", & + "TWN6RE ","TWN6STVX ","TWN6STVY ","TWN6STVZ ","TWN6VREL ","TWN6VUNDX","TWN6VUNDY","TWN6VUNDZ", & + "TWN7DYNP ","TWN7FBX ","TWN7FBY ","TWN7FBZ ","TWN7FDX ","TWN7FDY ","TWN7M ","TWN7MBX ", & + "TWN7MBY ","TWN7MBZ ","TWN7RE ","TWN7STVX ","TWN7STVY ","TWN7STVZ ","TWN7VREL ","TWN7VUNDX", & + "TWN7VUNDY","TWN7VUNDZ","TWN8DYNP ","TWN8FBX ","TWN8FBY ","TWN8FBZ ","TWN8FDX ","TWN8FDY ", & + "TWN8M ","TWN8MBX ","TWN8MBY ","TWN8MBZ ","TWN8RE ","TWN8STVX ","TWN8STVY ","TWN8STVZ ", & + "TWN8VREL ","TWN8VUNDX","TWN8VUNDY","TWN8VUNDZ","TWN9DYNP ","TWN9FBX ","TWN9FBY ","TWN9FBZ ", & + "TWN9FDX ","TWN9FDY ","TWN9M ","TWN9MBX ","TWN9MBY ","TWN9MBZ ","TWN9RE ","TWN9STVX ", & + "TWN9STVY ","TWN9STVZ ","TWN9VREL ","TWN9VUNDX","TWN9VUNDY","TWN9VUNDZ"/) + INTEGER(IntKi), PARAMETER :: ParamIndxAry(1606) = (/ & ! This lists the index into AllOuts(:) of the allowed parameters ValidParamAry(:) B1AeroFx , B1AeroFxi , B1AeroFy , B1AeroFyi , B1AeroFz , B1AeroFzi , B1AeroMx , B1AeroMxi , & B1AeroMy , B1AeroMyi , B1AeroMz , B1AeroMzi , B1AeroPwr , B1Azimuth , B1AeroFx , B1AeroFxi , & B1AeroFy , B1AeroFyi , B1AeroFz , B1AeroFzi , B1AeroMx , B1AeroMxi , B1AeroMy , B1AeroMyi , & @@ -2246,38 +2259,39 @@ module AeroDyn_IO_Params B4AeroMz , B4AeroMzi , B4AeroPwr , B4AeroFx , B4AeroFxi , B4AeroFy , B4AeroFyi , B4AeroFz , & B4AeroFzi , B4AeroMx , B4AeroMxi , B4AeroMy , B4AeroMyi , B4AeroMz , B4AeroMzi , B4AeroPwr , & DBEMTau1 , HbFbx , HbFby , HbFbz , HbMbx , HbMby , HbMbz , NcFbx , & - NcFby , NcFbz , NcMbx , NcMby , NcMbz , RtAeroCp , RtAeroCq , RtAeroCt , & - RtAeroFxh , RtAeroFxi , RtAeroFyh , RtAeroFyi , RtAeroFzh , RtAeroFzi , RtAeroMxh , RtAeroMxi , & - RtAeroMyh , RtAeroMyi , RtAeroMzh , RtAeroMzi , RtAeroPwr , RtArea , RtAeroCp , RtAeroCq , & - RtAeroCt , RtAeroFxi , RtAeroFxh , RtAeroFxi , RtAeroFyi , RtAeroFyh , RtAeroFyi , RtAeroFzi , & - RtAeroFzh , RtAeroFzi , RtAeroMxi , RtAeroMxh , RtAeroMxi , RtAeroMyi , RtAeroMyh , RtAeroMyi , & - RtAeroMzi , RtAeroMzh , RtAeroMzi , RtAeroPwr , RtSkew , RtSpeed , RtTSR , RtVAvgxh , & - RtVAvgyh , RtVAvgzh , TFAlpha , TFFxi , TFFyi , TFFzi , TFMach , TFMxi , & - TFMyi , TFMzi , TFRe , TFSTVxi , TFSTVyi , TFSTVzi , TFVindxi , TFVindyi , & - TFVindzi , TFVrel , TFVrelxi , TFVrelyi , TFVrelzi , TFVundxi , TFVundyi , TFVundzi , & - TwN1DynP , TwN1Fbx , TwN1Fby , TwN1Fbz , TwN1Fdx , TwN1Fdy , TwN1M , TwN1Mbx , & - TwN1Mby , TwN1Mbz , TwN1Re , TwN1STVx , TwN1STVy , TwN1STVz , TwN1Vrel , TwN1VUndx , & - TwN1VUndy , TwN1VUndz , TwN2DynP , TwN2Fbx , TwN2Fby , TwN2Fbz , TwN2Fdx , TwN2Fdy , & - TwN2M , TwN2Mbx , TwN2Mby , TwN2Mbz , TwN2Re , TwN2STVx , TwN2STVy , TwN2STVz , & - TwN2Vrel , TwN2VUndx , TwN2VUndy , TwN2VUndz , TwN3DynP , TwN3Fbx , TwN3Fby , TwN3Fbz , & - TwN3Fdx , TwN3Fdy , TwN3M , TwN3Mbx , TwN3Mby , TwN3Mbz , TwN3Re , TwN3STVx , & - TwN3STVy , TwN3STVz , TwN3Vrel , TwN3VUndx , TwN3VUndy , TwN3VUndz , TwN4DynP , TwN4Fbx , & - TwN4Fby , TwN4Fbz , TwN4Fdx , TwN4Fdy , TwN4M , TwN4Mbx , TwN4Mby , TwN4Mbz , & - TwN4Re , TwN4STVx , TwN4STVy , TwN4STVz , TwN4Vrel , TwN4VUndx , TwN4VUndy , TwN4VUndz , & - TwN5DynP , TwN5Fbx , TwN5Fby , TwN5Fbz , TwN5Fdx , TwN5Fdy , TwN5M , TwN5Mbx , & - TwN5Mby , TwN5Mbz , TwN5Re , TwN5STVx , TwN5STVy , TwN5STVz , TwN5Vrel , TwN5VUndx , & - TwN5VUndy , TwN5VUndz , TwN6DynP , TwN6Fbx , TwN6Fby , TwN6Fbz , TwN6Fdx , TwN6Fdy , & - TwN6M , TwN6Mbx , TwN6Mby , TwN6Mbz , TwN6Re , TwN6STVx , TwN6STVy , TwN6STVz , & - TwN6Vrel , TwN6VUndx , TwN6VUndy , TwN6VUndz , TwN7DynP , TwN7Fbx , TwN7Fby , TwN7Fbz , & - TwN7Fdx , TwN7Fdy , TwN7M , TwN7Mbx , TwN7Mby , TwN7Mbz , TwN7Re , TwN7STVx , & - TwN7STVy , TwN7STVz , TwN7Vrel , TwN7VUndx , TwN7VUndy , TwN7VUndz , TwN8DynP , TwN8Fbx , & - TwN8Fby , TwN8Fbz , TwN8Fdx , TwN8Fdy , TwN8M , TwN8Mbx , TwN8Mby , TwN8Mbz , & - TwN8Re , TwN8STVx , TwN8STVy , TwN8STVz , TwN8Vrel , TwN8VUndx , TwN8VUndy , TwN8VUndz , & - TwN9DynP , TwN9Fbx , TwN9Fby , TwN9Fbz , TwN9Fdx , TwN9Fdy , TwN9M , TwN9Mbx , & - TwN9Mby , TwN9Mbz , TwN9Re , TwN9STVx , TwN9STVy , TwN9STVz , TwN9Vrel , TwN9VUndx , & - TwN9VUndy , TwN9VUndz /) - CHARACTER(ChanLen), PARAMETER :: ParamUnitsAry(1594) = (/ character(ChanLen) :: & ! This lists the units corresponding to the allowed parameters - "(N) ","(N) ","(N) ","(N) ","(N) ","(N) ","(N-m) ","(N-m) ", & + NcFby , NcFbz , NcFdx , NcFdy , NcFdz , NcFxi , NcFyi , NcFzi , & + NcMbx , NcMby , NcMbz , NcMdx , NcMdy , NcMdz , NcMxi , NcMyi , & + NcMzi , RtAeroCp , RtAeroCq , RtAeroCt , RtAeroFxh , RtAeroFxi , RtAeroFyh , RtAeroFyi , & + RtAeroFzh , RtAeroFzi , RtAeroMxh , RtAeroMxi , RtAeroMyh , RtAeroMyi , RtAeroMzh , RtAeroMzi , & + RtAeroPwr , RtArea , RtAeroCp , RtAeroCq , RtAeroCt , RtAeroFxi , RtAeroFxh , RtAeroFxi , & + RtAeroFyi , RtAeroFyh , RtAeroFyi , RtAeroFzi , RtAeroFzh , RtAeroFzi , RtAeroMxi , RtAeroMxh , & + RtAeroMxi , RtAeroMyi , RtAeroMyh , RtAeroMyi , RtAeroMzi , RtAeroMzh , RtAeroMzi , RtAeroPwr , & + RtSkew , RtSpeed , RtTSR , RtVAvgxh , RtVAvgyh , RtVAvgzh , TFAlpha , TFFxi , & + TFFyi , TFFzi , TFMach , TFMxi , TFMyi , TFMzi , TFRe , TFSTVxi , & + TFSTVyi , TFSTVzi , TFVindxi , TFVindyi , TFVindzi , TFVrel , TFVrelxi , TFVrelyi , & + TFVrelzi , TFVundxi , TFVundyi , TFVundzi , TwN1DynP , TwN1Fbx , TwN1Fby , TwN1Fbz , & + TwN1Fdx , TwN1Fdy , TwN1M , TwN1Mbx , TwN1Mby , TwN1Mbz , TwN1Re , TwN1STVx , & + TwN1STVy , TwN1STVz , TwN1Vrel , TwN1VUndx , TwN1VUndy , TwN1VUndz , TwN2DynP , TwN2Fbx , & + TwN2Fby , TwN2Fbz , TwN2Fdx , TwN2Fdy , TwN2M , TwN2Mbx , TwN2Mby , TwN2Mbz , & + TwN2Re , TwN2STVx , TwN2STVy , TwN2STVz , TwN2Vrel , TwN2VUndx , TwN2VUndy , TwN2VUndz , & + TwN3DynP , TwN3Fbx , TwN3Fby , TwN3Fbz , TwN3Fdx , TwN3Fdy , TwN3M , TwN3Mbx , & + TwN3Mby , TwN3Mbz , TwN3Re , TwN3STVx , TwN3STVy , TwN3STVz , TwN3Vrel , TwN3VUndx , & + TwN3VUndy , TwN3VUndz , TwN4DynP , TwN4Fbx , TwN4Fby , TwN4Fbz , TwN4Fdx , TwN4Fdy , & + TwN4M , TwN4Mbx , TwN4Mby , TwN4Mbz , TwN4Re , TwN4STVx , TwN4STVy , TwN4STVz , & + TwN4Vrel , TwN4VUndx , TwN4VUndy , TwN4VUndz , TwN5DynP , TwN5Fbx , TwN5Fby , TwN5Fbz , & + TwN5Fdx , TwN5Fdy , TwN5M , TwN5Mbx , TwN5Mby , TwN5Mbz , TwN5Re , TwN5STVx , & + TwN5STVy , TwN5STVz , TwN5Vrel , TwN5VUndx , TwN5VUndy , TwN5VUndz , TwN6DynP , TwN6Fbx , & + TwN6Fby , TwN6Fbz , TwN6Fdx , TwN6Fdy , TwN6M , TwN6Mbx , TwN6Mby , TwN6Mbz , & + TwN6Re , TwN6STVx , TwN6STVy , TwN6STVz , TwN6Vrel , TwN6VUndx , TwN6VUndy , TwN6VUndz , & + TwN7DynP , TwN7Fbx , TwN7Fby , TwN7Fbz , TwN7Fdx , TwN7Fdy , TwN7M , TwN7Mbx , & + TwN7Mby , TwN7Mbz , TwN7Re , TwN7STVx , TwN7STVy , TwN7STVz , TwN7Vrel , TwN7VUndx , & + TwN7VUndy , TwN7VUndz , TwN8DynP , TwN8Fbx , TwN8Fby , TwN8Fbz , TwN8Fdx , TwN8Fdy , & + TwN8M , TwN8Mbx , TwN8Mby , TwN8Mbz , TwN8Re , TwN8STVx , TwN8STVy , TwN8STVz , & + TwN8Vrel , TwN8VUndx , TwN8VUndy , TwN8VUndz , TwN9DynP , TwN9Fbx , TwN9Fby , TwN9Fbz , & + TwN9Fdx , TwN9Fdy , TwN9M , TwN9Mbx , TwN9Mby , TwN9Mbz , TwN9Re , TwN9STVx , & + TwN9STVy , TwN9STVz , TwN9Vrel , TwN9VUndx , TwN9VUndy , TwN9VUndz /) +CHARACTER(ChanLen), PARAMETER :: ParamUnitsAry(1606) = (/ character(ChanLen) :: & ! This lists the units corresponding to the allowed parameters + "(N) ","(N) ","(N) ","(N) ","(N) ","(N) ","(N-m) ","(N-m) ", & "(N-m) ","(N-m) ","(N-m) ","(N-m) ","(W) ","(deg) ","(N) ","(N) ", & "(N) ","(N) ","(N) ","(N) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ", & "(N-m) ","(N-m) ","(W) ","(deg) ","(-) ","(-) ","(-) ","(m) ", & @@ -2447,19 +2461,16 @@ module AeroDyn_IO_Params "(N-m) ","(N-m) ","(W) ","(N) ","(N) ","(N) ","(N) ","(N) ", & "(N) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ","(W) ", & "(s) ","(N) ","(N) ","(N) ","(N-m) ","(N-m) ","(N-m) ","(N) ", & - "(N) ","(N) ","(N-m) ","(N-m) ","(N-m) ","(-) ","(-) ","(-) ", & - "(N) ","(N) ","(N) ","(N) ","(N) ","(N) ","(N-m) ","(N-m) ", & - "(N-m) ","(N-m) ","(N-m) ","(N-m) ","(W) ","(m^2) ","(-) ","(-) ", & - "(-) ","(N) ","(N) ","(N) ","(N) ","(N) ","(N) ","(N) ", & + "(N) ","(N) ","(N) ","(N) ","(N) ","(N) ","(N) ","(N) ", & + "(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ", & + "(N-m) ","(-) ","(-) ","(-) ","(N) ","(N) ","(N) ","(N) ", & "(N) ","(N) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ", & - "(N-m) ","(N-m) ","(N-m) ","(W) ","(deg) ","(rpm) ","(-) ","(m/s) ", & - "(m/s) ","(m/s) ","(deg) ","(N) ","(N) ","(N) ","(-) ","(N-m) ", & - "(N-m) ","(N-m) ","(-) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & + "(W) ","(m^2) ","(-) ","(-) ","(-) ","(N) ","(N) ","(N) ", & + "(N) ","(N) ","(N) ","(N) ","(N) ","(N) ","(N-m) ","(N-m) ", & + "(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ","(W) ", & + "(deg) ","(rpm) ","(-) ","(m/s) ","(m/s) ","(m/s) ","(deg) ","(N) ", & + "(N) ","(N) ","(-) ","(N-m) ","(N-m) ","(N-m) ","(-) ","(m/s) ", & "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & - "(Pa) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(-) ","(N-m/m)", & - "(N-m/m)","(N-m/m)","(-) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s) ","(Pa) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(-) ","(N-m/m)","(N-m/m)","(N-m/m)","(-) ","(m/s) ","(m/s) ","(m/s) ", & "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(Pa) ","(N/m) ","(N/m) ","(N/m) ", & "(N/m) ","(N/m) ","(-) ","(N-m/m)","(N-m/m)","(N-m/m)","(-) ","(m/s) ", & "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(Pa) ","(N/m) ", & @@ -2476,7 +2487,11 @@ module AeroDyn_IO_Params "(-) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & "(Pa) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(-) ","(N-m/m)", & "(N-m/m)","(N-m/m)","(-) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s) "/) + "(m/s) ","(m/s) ","(Pa) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(-) ","(N-m/m)","(N-m/m)","(N-m/m)","(-) ","(m/s) ","(m/s) ","(m/s) ", & + "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(Pa) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(-) ","(N-m/m)","(N-m/m)","(N-m/m)","(-) ","(m/s) ", & + "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) "/) end module AeroDyn_IO_Params diff --git a/modules/aerodyn/src/AeroDyn_Inflow.f90 b/modules/aerodyn/src/AeroDyn_Inflow.f90 index 0418fa019b..3f212d78e3 100644 --- a/modules/aerodyn/src/AeroDyn_Inflow.f90 +++ b/modules/aerodyn/src/AeroDyn_Inflow.f90 @@ -4,8 +4,7 @@ module AeroDyn_Inflow use NWTC_Library use AeroDyn_Inflow_Types use AeroDyn_Types - use AeroDyn, only: AD_Init, AD_ReInit, AD_CalcOutput, AD_UpdateStates, AD_End, AD_BoxExceedPointsIdx - use AeroDyn, only: AD_NumWindPoints, AD_GetExternalWind, AD_SetExternalWindPositions + use AeroDyn, only: AD_Init, AD_ReInit, AD_CalcOutput, AD_UpdateStates, AD_End use AeroDyn_IO, only: AD_SetVTKSurface use InflowWind, only: InflowWind_Init, InflowWind_CalcOutput, InflowWind_End @@ -22,7 +21,6 @@ module AeroDyn_Inflow public :: ADI_UpdateStates ! Convenient routines for driver - public :: ADI_ADIW_Solve public :: concatOutputHeaders public :: Init_MeshMap_For_ADI public :: Set_Inputs_For_ADI @@ -64,6 +62,10 @@ subroutine ADI_Init(InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut ! Display the module information call DispNVD( ADI_Ver ) + ! Clear writeoutputs + if (allocated(InitOut%WriteOutputHdr)) deallocate(InitOut%WriteOutputHdr) + if (allocated(InitOut%WriteOutputUnt)) deallocate(InitOut%WriteOutputUnt) + ! Set parameters p%dt = interval p%storeHHVel = InitInp%storeHHVel @@ -71,9 +73,14 @@ subroutine ADI_Init(InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut p%MHK = InitInp%AD%MHK p%WtrDpth = InitInp%AD%WtrDpth + ! --- Initialize Inflow Wind + call ADI_InitInflowWind(InitInp%RootName, InitInp%IW_InitInp, u%AD, OtherState%AD, m%IW, Interval, InitOut_IW, errStat2, errMsg2); if (Failed()) return + ! Concatenate AD outputs to IW outputs + call concatOutputHeaders(InitOut%WriteOutputHdr, InitOut%WriteOutputUnt, InitOut_IW%WriteOutputHdr, InitOut_IW%WriteOutputUnt, errStat2, errMsg2); if(Failed()) return + ! --- Initialize AeroDyn - if (allocated(InitOut%WriteOutputHdr)) deallocate(InitOut%WriteOutputHdr) - if (allocated(InitOut%WriteOutputUnt)) deallocate(InitOut%WriteOutputUnt) + ! Link InflowWind's FlowField to AeroDyn's FlowField + InitInp%AD%FlowField => InitOut_IW%FlowField call AD_Init(InitInp%AD, u%AD, p%AD, x%AD, xd%AD, z%AD, OtherState%AD, y%AD, m%AD, Interval, InitOut_AD, errStat2, errMsg2); if (Failed()) return InitOut%Ver = InitOut_AD%ver @@ -81,11 +88,6 @@ subroutine ADI_Init(InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut !TODO: this header is too short if we add more rotors. Should also add a rotor identifier call concatOutputHeaders(InitOut%WriteOutputHdr, InitOut%WriteOutputUnt, InitOut_AD%rotors(1)%WriteOutputHdr, InitOut_AD%rotors(1)%WriteOutputUnt, errStat2, errMsg2); if(Failed()) return - ! --- Initialize Inflow Wind - call ADI_InitInflowWind(InitInp%RootName, InitInp%IW_InitInp, u%AD, OtherState%AD, m%IW, Interval, InitOut_IW, errStat2, errMsg2); if (Failed()) return - ! Concatenate AD outputs to IW outputs - call concatOutputHeaders(InitOut%WriteOutputHdr, InitOut%WriteOutputUnt, InitOut_IW%WriteOutputHdr, InitOut_IW%WriteOutputUnt, errStat2, errMsg2); if(Failed()) return - ! --- Initialize grouped outputs !TODO: assumes one rotor p%NumOuts = p%AD%rotors(1)%NumOuts + p%AD%rotors(1)%BldNd_TotNumOuts + m%IW%p%NumOuts @@ -235,7 +237,7 @@ subroutine ADI_UpdateStates( t, n, u, utimes, p, x, xd, z, OtherState, m, errSta subroutine CleanUp() !call ADI_DestroyConstrState(z_guess, errStat2, errMsg2); if(Failed()) return do it=1,size(utimes) - call AD_DestroyInput(u_AD(it), errStat2, errMsg2); if(Failed()) return + call AD_DestroyInput(u_AD(it), errStat2, errMsg2) ! ignore errors here enddo end subroutine @@ -249,6 +251,7 @@ end subroutine ADI_UpdateStates !---------------------------------------------------------------------------------------------------------------------------------- !> Routine for computing outputs, used in both loose and tight coupling. subroutine ADI_CalcOutput(t, u, p, x, xd, z, OtherState, y, m, errStat, errMsg) + use IfW_FlowField, only: IfW_FlowField_GetVelAcc real(DbKi), intent(in ) :: t !< Current simulation time in seconds type(ADI_InputType), intent(inout) :: u !< Inputs at Time t ! NOTE: set as in-out since "Inflow" needs to be set type(ADI_ParameterType), intent(in ) :: p !< Parameters @@ -261,36 +264,56 @@ subroutine ADI_CalcOutput(t, u, p, x, xd, z, OtherState, y, m, errStat, errMsg) type(ADI_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) :: errStat2 character(errMsgLen) :: errMsg2 + integer(IntKi) :: node character(*), parameter :: RoutineName = 'ADI_CalcOutput' integer :: iWT errStat = ErrID_None errMsg = "" - ! --- CalcOutputs for IW (Sets u_AD%rotors(:)%InflowOnBlade, etc, and m%IW%y) - y%IW_WriteOutput(:) = m%IW%y%WriteOutput(:) + !---------------------------------------------------------------------------- + ! Calculate InflowWind outputs if module was initialized + !---------------------------------------------------------------------------- + + if (m%IW%CompInflow == 1) then + call InflowWind_CalcOutput(t, m%IW%u, m%IW%p, m%IW%x, m%IW%xd, m%IW%z, & + m%IW%OtherSt, m%IW%y, m%IW%m, errStat2, errMsg2) + if(Failed()) return + + ! Copy InflowWind outputs to ADI outputs + y%IW_WriteOutput(:) = m%IW%y%WriteOutput(:) + end if + !---------------------------------------------------------------------------- + ! Calculate aerodyn output + !---------------------------------------------------------------------------- ! Calculate outputs at t - call AD_CalcOutput(t, u%AD, p%AD, x%AD, xd%AD, z%AD, OtherState%AD, y%AD, m%AD, errStat2, errMsg2); if(Failed()) return + call AD_CalcOutput(t, u%AD, p%AD, x%AD, xd%AD, z%AD, OtherState%AD, y%AD, m%AD, errStat2, errMsg2) + if(Failed()) return ! --- Outputs for driver - ! Hub Height velocity outputs - if (p%storeHHVel) then - do iWT = 1, size(p%AD%rotors) - y%HHVel(1, iWT) = m%IW%y%VelocityUVW(1, iWT) - y%HHVel(2, iWT) = m%IW%y%VelocityUVW(2, iWT) - y%HHVel(3, iWT) = m%IW%y%VelocityUVW(3, iWT) - enddo - endif y%PLExp = m%IW%PLExp ! --- Set outputs -!TODO: this assumes one rotor!!! - y%WriteOutput(1:p%AD%rotors(1)%NumOuts+p%AD%rotors(1)%BldNd_TotNumOuts) = y%AD%rotors(1)%WriteOutput(1:p%AD%rotors(1)%NumOuts+p%AD%rotors(1)%BldNd_TotNumOuts) - y%WriteOutput(p%AD%rotors(1)%NumOuts+p%AD%rotors(1)%BldNd_TotNumOuts+1:p%NumOuts) = y%IW_WriteOutput(1:m%IW%p%NumOuts) + !TODO: this assumes one rotor!!! + associate(AD_NumOuts => p%AD%rotors(1)%NumOuts + p%AD%rotors(1)%BldNd_TotNumOuts, & + IW_NumOuts => m%IW%p%NumOuts) + y%WriteOutput(1:IW_NumOuts) = y%IW_WriteOutput(1:IW_NumOuts) + y%WriteOutput(IW_NumOuts+1:p%NumOuts) = y%AD%rotors(1)%WriteOutput(1:AD_NumOuts) + end associate + + !---------------------------------------------------------------------------- + ! Store hub height velocity calculated in CalcOutput + !---------------------------------------------------------------------------- + + if (p%storeHHVel) then + do iWT = 1, size(u%AD%rotors) + y%HHVel(:,iWT) = m%AD%Inflow(1)%RotInflow(iWT)%InflowOnHub(:,1) + end do + endif contains @@ -308,7 +331,9 @@ end subroutine ADI_CalcOutput !> subroutine ADI_InitInflowWind(Root, i_IW, u_AD, o_AD, IW, dt, InitOutData, errStat, errMsg) use InflowWind, only: InflowWind_Init - character(len=*), intent(in ) :: Root ! Rootname for input files + use InflowWind_IO, only: IfW_SteadyWind_Init + use IfW_FlowField, only: IfW_UniformField_CalcAccel + character(*), intent(in ) :: Root ! Rootname for input files type(ADI_IW_InputData), intent(in ) :: i_IW ! Inflow Wind "pseudo init input" data type(AD_InputType), intent(in ) :: u_AD ! AeroDyn data type(AD_OtherStateType), intent(in ) :: o_AD ! AeroDyn data @@ -317,49 +342,62 @@ subroutine ADI_InitInflowWind(Root, i_IW, u_AD, o_AD, IW, dt, InitOutData, errSt type(InflowWind_InitOutputType), intent(out) :: InitOutData ! Output data from initialization integer(IntKi) , intent( out) :: errStat ! Status of error message character(*) , intent( out) :: errMsg ! Error message if errStat /= ErrID_None - ! locals - integer(IntKi) :: errStat2 ! local status of error message - character(errMsgLen) :: errMsg2 ! local error message if errStat /= ErrID_None - type(InflowWind_InitInputType) :: InitInData ! Input data for initialization + + integer(IntKi) :: errStat2 ! local status of error message + character(errMsgLen) :: errMsg2 ! local error message if errStat /= ErrID_None + type(InflowWind_InitInputType) :: InitInData ! Input data for initialization + Type(Steady_InitInputType) :: Steady_InitInput + Type(WindFileDat) :: FileDat errStat = ErrID_None errMsg = '' - ! --- Count number of points required by AeroDyn - InitInData%NumWindPoints = AD_NumWindPoints(u_AD, o_AD) - ! Adding Hub windspeed for each turbine - InitInData%NumWindPoints = InitInData%NumWindPoints + size(u_AD%rotors) - ! --- Init InflowWind - if (i_IW%CompInflow==0) then - ! Fake "InflowWind" init + if (i_IW%CompInflow == 0) then + ! Initialze only the flow field with steady wind allocate(InitOutData%WriteOutputHdr(0)) allocate(InitOutData%WriteOutputUnt(0)) allocate(IW%y%WriteOutput(0)) - call AllocAry(IW%u%PositionXYZ, 3, InitInData%NumWindPoints, 'PositionXYZ', errStat2, errMsg2); if (Failed()) return - call AllocAry(IW%y%VelocityUVW, 3, InitInData%NumWindPoints, 'VelocityUVW', errStat2, errMsg2); if (Failed()) return - IW%u%PositionXYZ = myNaN - IW%y%VelocityUVW = myNaN + Steady_InitInput%HWindSpeed = i_IW%HWindSpeed + Steady_InitInput%RefHt = i_IW%RefHt + Steady_InitInput%PLExp = i_IW%PLExp + allocate(IW%p%FlowField) + IW%p%FlowField%PropagationDir = 0.0_ReKi + IW%p%FlowField%VFlowAngle = 0.0_ReKi + IW%p%FlowField%RotateWindBox = .false. + IW%p%FlowField%FieldType = Uniform_FieldType + IW%p%FlowField%RefPosition = [0.0_ReKi, 0.0_ReKi, i_IW%RefHt] + InitOutData%FlowField => IW%p%FlowField + call IfW_SteadyWind_Init(Steady_InitInput, 0, IW%p%FlowField%Uniform, & + FileDat, errStat2, errMsg2) + if(Failed()) return + if (i_IW%MHK == MHK_FixedBottom .or. i_IW%MHK == MHK_FLoating) then + call IfW_UniformField_CalcAccel(IW%p%FlowField%Uniform, errStat2, errMsg2) + if(Failed()) return + IW%p%FlowField%AccFieldValid = .true. + end if else - ! Module init + ! Initialze InflowWind module InitInData%InputFileName = i_IW%InputFile InitInData%Linearize = i_IW%Linearize - InitInData%UseInputFile = i_IW%UseInputFile - ! Box exceed allow for OLAF poitns - if (allocated(o_AD%WakeLocationPoints)) then - InitInData%BoxExceedAllowF = .true. - InitInData%BoxExceedAllowIdx = AD_BoxExceedPointsIdx(u_AD, o_AD) - endif - if (.not. i_IW%UseInputFile) then - call NWTC_Library_Copyfileinfotype( i_IW%PassedFileData, InitInData%PassedFileData, MESH_NEWCOPY, errStat2, errMsg2 ); if (Failed()) return + InitInData%FilePassingMethod= i_IW%FilePassingMethod + InitInData%NumWindPoints = 1 + if (i_IW%FilePassingMethod == 1_IntKi) then ! passing input file as an FileInfoType structure + call NWTC_Library_Copyfileinfotype( i_IW%PassedFileInfo, InitInData%PassedFileInfo, MESH_NEWCOPY, errStat2, errMsg2 ); if (Failed()) return + elseif (i_IW%FilePassingMethod == 2_IntKi) then ! passing input file as an IfW_InputFile structure + call InflowWind_CopyInputFile( i_IW%PassedFileData, InitInData%PassedFileData, MESH_NEWCOPY, errStat2, errMsg2 ); if (Failed()) return endif InitInData%RootName = trim(Root)//'.IfW' InitInData%MHK = i_IW%MHK + ! OLAF might be used in AD, in which case we need to allow out of bounds for some calcs. To do that + ! the average values for the entire wind profile must be calculated and stored (we don't know if OLAF + ! is used until after AD_Init below). + InitInData%BoxExceedAllow = .true. CALL InflowWind_Init( InitInData, IW%u, IW%p, & IW%x, IW%xd, IW%z, IW%OtherSt, & IW%y, IW%m, dt, InitOutData, errStat2, errMsg2 ) if(Failed()) return - endif + ! --- Store main init input data (data that don't use InfloWind directly) IW%CompInflow = i_IW%CompInflow IW%HWindSpeed = i_IW%HWindSpeed @@ -367,6 +405,7 @@ subroutine ADI_InitInflowWind(Root, i_IW, u_AD, o_AD, IW, dt, InitOutData, errSt IW%PLExp = i_IW%PLExp call cleanup() + contains subroutine cleanup() call InflowWind_DestroyInitInput( InitInData, errStat2, errMsg2 ) @@ -415,121 +454,6 @@ subroutine concatOutputHeaders(WriteOutputHdr0, WriteOutputUnt0, WriteOutputHdr, deallocate(TmpUnt) endif end subroutine concatOutputHeaders -!---------------------------------------------------------------------------------------------------------------------------------- -!> Solve for the wind speed at the location necessary for AeroDyn -subroutine ADI_ADIW_Solve(t, p_AD, u_AD, o_AD, u_IfW, IW, hubHeightFirst, errStat, errMsg) - real(DbKi), intent(in ) :: t ! Time of evaluation - type(ADI_ParameterType), intent(in ) :: p_AD ! Parameters - type(AD_InputType), intent(inout) :: u_AD ! AeroDyn data - type(AD_OtherStateType), intent(in ) :: o_AD ! AeroDyn data - type(InflowWind_InputType), intent(inout) :: u_IfW ! InflowWind data - type(ADI_InflowWindData), intent(inout) :: IW ! InflowWind data - logical, intent(in ) :: hubHeightFirst ! Hub Height velocity is packed at beginning - integer(IntKi) , intent( out) :: errStat ! Status of error message - character(*) , intent( out) :: errMsg ! Error message if errStat /= ErrID_None - integer(IntKi) :: errStat2 ! Status of error message - character(errMsgLen) :: errMsg2 ! Error message if errStat /= ErrID_None - errStat = ErrID_None - errMsg = '' - - ! Set u_ifW%PositionXYZ - call ADI_Set_IW_Inputs(p_AD, u_AD, o_AD, u_IfW, hubHeightFirst, errStat2, errMsg2); if(Failed()) return - ! Compute IW%y%VelocityUVW - call ADI_CalcOutput_IW(t, u_IfW, IW, errStat2, errMsg2); if(Failed()) return - ! Set u_AD%..%InflowOnBlade, u_AD%..%InflowOnTower, etc - call ADI_AD_InputSolve_IfW(u_AD, IW%y, hubHeightFirst, errStat2, errMsg2); if(Failed()) return - -contains - logical function Failed() - call SetErrStat(errStat2, errMsg2, errStat, errMsg, 'ADI_ADIW_Solve') - Failed = errStat >= AbortErrLev - end function Failed -end subroutine ADI_ADIW_Solve -!---------------------------------------------------------------------------------------------------------------------------------- -!> Set inputs for inflow wind -subroutine ADI_Set_IW_Inputs(p_AD, u_AD, o_AD, u_IfW, hubHeightFirst, errStat, errMsg) - type(ADI_ParameterType), intent(in ) :: p_AD ! Parameters - type(AD_InputType), intent(in ) :: u_AD ! AeroDyn data - type(AD_OtherStateType), intent(in ) :: o_AD ! AeroDyn data - type(InflowWind_InputType), intent(inout) :: u_IfW ! InflowWind data - logical, intent(in ) :: hubHeightFirst ! Hub Height velocity is packed at beginning - integer(IntKi) , intent( out) :: errStat ! Status of error message - character(*) , intent( out) :: errMsg ! Error message if errStat /= ErrID_None - integer :: node, iWT - errStat = ErrID_None - errMsg = '' - node=0 - - if (hubHeightFirst) then - ! Hub Height point for each turbine - do iWT=1,size(u_AD%rotors) - node = node + 1 - u_IfW%PositionXYZ(:,node) = u_AD%rotors(iWT)%hubMotion%Position(:,1) + u_AD%rotors(iWT)%hubMotion%TranslationDisp(:,1) - enddo - endif - call AD_SetExternalWindPositions(u_AD, o_AD, u_IfW%PositionXYZ, node, errStat, errMsg) - if ( p_AD%MHK == 1 .or. p_AD%MHK == 2 ) then - u_IfW%PositionXYZ(3,:) = u_IfW%PositionXYZ(3,:) + p_AD%WtrDpth - endif -end subroutine ADI_Set_IW_Inputs -!---------------------------------------------------------------------------------------------------------------------------------- -!---------------------------------------------------------------------------------------------------------------------------------- -!> Calculate Wind at desired points -!! NOTE: order is important and should match AD_NumWindPoints -!! Similar to FAST_Solver, IfW_InputSolve -subroutine ADI_CalcOutput_IW(t, u_IfW, IW, errStat, errMsg) - real(DbKi), intent(in ) :: t ! Time of evaluation - type(InflowWind_InputType), intent(inout) :: u_IfW ! InflowWind data - type(ADI_InflowWindData), intent(inout) :: IW ! InflowWind data - integer(IntKi) , intent( out) :: errStat ! Status of error message - character(*) , intent( out) :: errMsg ! Error message if errStat /= ErrID_None - integer :: j - real(ReKi) :: z - integer(IntKi) :: errStat2 ! Status of error message - character(errMsgLen) :: errMsg2 ! Error message if errStat /= ErrID_None - errStat = ErrID_None - errMsg = '' - if (IW%CompInflow==1) then - call InflowWind_CalcOutput(t, u_IfW, IW%p, IW%x, IW%xd, IW%z, IW%OtherSt, IW%y, IW%m, errStat2, errMsg2) - call SetErrStat(errStat2, errMsg2, errStat, errMsg, 'ADI_CalcOutput_IW') - else - do j=1,size(u_IfW%PositionXYZ,2) - z = u_IfW%PositionXYZ(3,j) - IW%y%VelocityUVW(1,j) = IW%HWindSpeed*(z/IW%RefHt)**IW%PLExp - IW%y%VelocityUVW(2,j) = 0.0_ReKi !V - IW%y%VelocityUVW(3,j) = 0.0_ReKi !W - end do - endif -end subroutine ADI_CalcOutput_IW -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine sets the wind claculated by InflowWind to the AeroDyn arrays -!! See similar routine in FAST_Solver -!! TODO put this in AeroDyn -subroutine ADI_AD_InputSolve_IfW(u_AD, y_IfW, hubHeightFirst, errStat, errMsg) - ! Passed variables - TYPE(AD_InputType), INTENT(INOUT) :: u_AD !< The inputs to AeroDyn - TYPE(InflowWind_OutputType), INTENT(IN) :: y_IfW !< The outputs from InflowWind - logical, intent(in ) :: hubHeightFirst ! Hub Height velocity is packed at beginning - INTEGER(IntKi) :: errStat !< Error status of the operation - CHARACTER(*) :: errMsg !< Error message if errStat /= ErrID_None - ! Local variables: - INTEGER(IntKi) :: node - INTEGER(IntKi) :: iWT - errStat = ErrID_None - errMsg = "" - node = 1 - ! Order important! - if (hubHeightFirst) then - do iWT=1,size(u_AD%rotors) - node = node + 1 ! Hub velocities for each rotor - enddo - endif - call AD_GetExternalWind(u_AD, y_IfW%VelocityUVW, node, errStat, errMsg) - -end subroutine ADI_AD_InputSolve_IfW - - - ! --------------------------------------------------------------------------------} ! --- ROUTINES RELEVANT FOR COUPLING WITH "FED": Fake ElastoDyn ! --------------------------------------------------------------------------------{ @@ -590,7 +514,7 @@ subroutine Init_MeshMap_For_ADI(FED, p, uAD, errStat, errMsg) if (y_ED%hasTower) then twrHeightAD=uAD%rotors(iWT)%TowerMotion%Position(3,uAD%rotors(iWT)%TowerMotion%nNodes)-uAD%rotors(iWT)%TowerMotion%Position(3,1) ! Check tower height - if ( p%MHK==2 ) then + if ( p%MHK==MHK_Floating ) then if (twrHeightAD>0) then errStat=ErrID_Fatal errMsg='First AeroDyn tower height should be larger than last AD tower height for a floating MHK turbine' @@ -603,9 +527,9 @@ subroutine Init_MeshMap_For_ADI(FED, p, uAD, errStat, errMsg) endif twrHeightAD=uAD%rotors(iWT)%TowerMotion%Position(3,uAD%rotors(iWT)%TowerMotion%nNodes) ! NOTE: assuming start a z=0 - if ( p%MHK==1 ) then + if ( p%MHK==MHK_FixedBottom ) then twrHeightAD = twrHeightAD + p%WtrDpth - elseif ( p%MHK==2 ) then + elseif ( p%MHK==MHK_Floating ) then twrHeightAD = abs(twrHeightAD) endif @@ -621,13 +545,13 @@ subroutine Init_MeshMap_For_ADI(FED, p, uAD, errStat, errMsg) ! Adjust tower position (AeroDyn return values assuming (0,0,0) for tower base Pbase = y_ED%TwrPtMesh%Position(:,1) Ptop = y_ED%NacelleMotion%Position(:,1) - if ( p%MHK==2 ) then + if ( p%MHK==MHK_Floating ) then DeltaP = Pbase-Ptop else DeltaP = Ptop-Pbase endif do i = 1, uAD%rotors(iWT)%TowerMotion%nNodes - if ( p%MHK==1 ) then + if ( p%MHK==MHK_FixedBottom ) then zBar = (uAD%rotors(iWT)%TowerMotion%Position(3,i) + p%WtrDpth) / twrHeight else zBar = uAD%rotors(iWT)%TowerMotion%Position(3,i)/twrHeight @@ -639,7 +563,7 @@ subroutine Init_MeshMap_For_ADI(FED, p, uAD, errStat, errMsg) pos = y_ED%TwrPtMesh%Position(:,1) orientation = y_ED%TwrPtMesh%RefOrientation(:,:,1) call Eye(orientation, errStat2, errMsg2) - call CreatePointMesh(y_ED%TwrPtMeshAD, pos, orientation, errStat2, errMsg2, hasMotion=.True., hasLoads=.False.); if(Failed())return + call CreateInputPointMesh(y_ED%TwrPtMeshAD, pos, orientation, errStat2, errMsg2, hasMotion=.True., hasLoads=.False.); if(Failed())return ! TowerBase to AD tower base call MeshMapCreate(y_ED%TwrPtMesh, y_ED%TwrPtMeshAD, y_ED%ED_P_2_AD_P_T, errStat2, errMsg2); if(Failed()) return diff --git a/modules/aerodyn/src/AeroDyn_Inflow_C_Binding.f90 b/modules/aerodyn/src/AeroDyn_Inflow_C_Binding.f90 index 23ae166eb3..48f0d4601f 100644 --- a/modules/aerodyn/src/AeroDyn_Inflow_C_Binding.f90 +++ b/modules/aerodyn/src/AeroDyn_Inflow_C_Binding.f90 @@ -24,32 +24,42 @@ MODULE AeroDyn_Inflow_C_BINDING USE AeroDyn_Inflow_Types USE AeroDyn_Driver_Types, only: Dvr_SimData, Dvr_Outputs USE AeroDyn_Driver_Subs, only: Dvr_InitializeOutputs, Dvr_WriteOutputs, SetVTKParameters !, WrVTK_Surfaces, WrVTK_Lines, WrVTK_Ground + USE IfW_FlowField, only: IfW_FlowField_GetVelAcc USE NWTC_Library USE VersionInfo - IMPLICIT NONE SAVE - PUBLIC :: AeroDyn_Inflow_C_Init - !PUBLIC :: AeroDyn_Inflow_C_ReInit - PUBLIC :: AeroDyn_Inflow_C_CalcOutput - PUBLIC :: AeroDyn_Inflow_C_UpdateStates - PUBLIC :: AeroDyn_Inflow_C_End + PUBLIC :: ADI_C_Init + !PUBLIC :: ADI_C_ReInit + PUBLIC :: ADI_C_CalcOutput + PUBLIC :: ADI_C_UpdateStates + PUBLIC :: ADI_C_End + PUBLIC :: ADI_C_PreInit ! Initial call to setup number of turbines + PUBLIC :: ADI_C_SetupRotor ! Initial node positions etc for a rotor + PUBLIC :: ADI_C_SetRotorMotion ! Set motions for a given rotor + PUBLIC :: ADI_C_GetRotorLoads ! Retrieve loads for a given rotor + PUBLIC :: ADI_C_GetDiskAvgVel ! Get the disk average velocity for the rotor !------------------------------------------------------------------------------------ ! Version info for display type(ProgDesc), parameter :: version = ProgDesc( 'AeroDyn-Inflow library', '', '' ) - !------------------------------------------------------------------------------------ - ! Debugging: debugverbose + ! Debugging: DebugLevel -- passed at PreInit ! 0 - none ! 1 - some summary info ! 2 - above + all position/orientation info ! 3 - above + input files (if direct passed) ! 4 - above + meshes - integer(IntKi), parameter :: debugverbose = 0 + integer(IntKi) :: DebugLevel = 0 + + !------------------------------------------------------------------------------------ + ! Point Load Output: flag indicating library returns point loads -- passed at PreInit + ! true - loads returned by ADI_C_GetRotorLoads are point loads (N, N-m) at mesh points + ! false - loads returned by ADI_C_GetRotorLoads are distributed (N/m, N-m/m) loads at mesh points + logical :: PointLoadOutput = .true. !------------------------------------------------------------------------------------ ! Error handling @@ -88,12 +98,13 @@ MODULE AeroDyn_Inflow_C_BINDING integer(IntKi) :: InterpOrder !------------------------------ ! Primary ADI data derived data types - type(ADI_Data) :: ADI + type(ADI_Data), target :: ADI !< all ADI data (target for using pointers to simplify code) type(ADI_InitInputType) :: InitInp !< Initialization data type(ADI_InitOutputType) :: InitOutData !< Initial output data -- Names, units, and version info. + type(ADI_InputType) :: ADI_u !< ADI inputs -- set by AD_SetInputMotion. Copied as needed (necessary for correction steps) !------------------------------ ! Simulation data - type(Dvr_SimData) :: Sim !< data about the simulation + type(Dvr_SimData) :: Sim !< Data about the simulation !------------------------------ ! Outputs type(Dvr_Outputs) :: WrOutputsData !< Data for writing outputs to file @@ -116,17 +127,29 @@ MODULE AeroDyn_Inflow_C_BINDING ! the glue code. However, here we do not pass state information through the ! interface and therefore must store it here analogously to how it is handled ! in the OpenFAST glue code. - integer(IntKi) :: n_Global ! global timestep - integer(IntKi) :: n_VTK ! VTK timestep - real(DbKi) :: InputTimePrev ! input time of last UpdateStates call + integer(IntKi) :: n_Global ! global timestep + integer(IntKi) :: n_VTK ! VTK timestep + real(DbKi) :: InputTimePrev ! input time of last UpdateStates call + real(DbKi) :: InputTimePrev_Calc ! input time of last CalcOutput call ! Note that we are including the previous state info here (not done in OF this way) - integer(IntKi), parameter :: STATE_LAST = 0 ! Index for previous state (not needed in OF, but necessary here) - integer(IntKi), parameter :: STATE_CURR = 1 ! Index for current state - integer(IntKi), parameter :: STATE_PRED = 2 ! Index for predicted state + integer(IntKi), parameter :: STATE_LAST = 0 ! Index for previous state (not needed in OF, but necessary here) + integer(IntKi), parameter :: STATE_CURR = 1 ! Index for current state + integer(IntKi), parameter :: STATE_PRED = 2 ! Index for predicted state ! Note the indexing is different on inputs (no clue why, but thats how OF handles it) - integer(IntKi), parameter :: INPUT_LAST = 3 ! Index for previous input at t-dt - integer(IntKi), parameter :: INPUT_CURR = 2 ! Index for current input at t - integer(IntKi), parameter :: INPUT_PRED = 1 ! Index for predicted input at t+dt + integer(IntKi), parameter :: INPUT_LAST = 3 ! Index for previous input at t-dt + integer(IntKi), parameter :: INPUT_CURR = 2 ! Index for current input at t + integer(IntKi), parameter :: INPUT_PRED = 1 ! Index for predicted input at t+dt + + !------------------------------- + ! Variables for disk average velocity calculations + integer(IntKi), parameter :: NumPtsDiskAvg = 144 + type :: DiskAvgVelData_Type + real(ReKi) :: DiskWindPosRel(3,NumPtsDiskAvg) + real(ReKi) :: DiskWindPosAbs(3,NumPtsDiskAvg) + real(ReKi) :: DiskWindVel(3,NumPtsDiskAvg) + real(ReKi) :: DiskAvgVel(3) + end type DiskAvgVelData_Type + type(DiskAvgVelData_Type), allocatable :: DiskAvgVelVars(:) !------------------------------------------------------------------------------------ ! Meshes for motions and loads @@ -135,6 +158,37 @@ MODULE AeroDyn_Inflow_C_BINDING ! positions passed into this module and what is used inside AD. This is done ! through a pair of meshes for the motion and loads corresponding to the node ! positions passed in. + + ! ========= BladeNodeToMeshPointMapType ======= + TYPE, PUBLIC :: BladeNodeToMeshPointMapType + INTEGER(IntKi), ALLOCATABLE :: BladeNodeToMeshPoint(:) !< Blade node -> structural mesh point mapping (sized by the number of nodes on the blade) + END TYPE BladeNodeToMeshPointMapType + ! ======================= + ! ========= BladeStrMeshCoordsType ======= + TYPE, PUBLIC :: BladeStrMeshCoordsType + REAL(ReKi), DIMENSION(:,:), ALLOCATABLE :: Position !< Position of all blade points (sized by 3 x number of mesh points on the blade [x,y,z]) + REAL(ReKi), DIMENSION(:,:,:), ALLOCATABLE :: Orient !< Orientation of all blade points (sized by 3 x 3 x number of mesh points on the blade [r11,r12,r13,r21,r22,r23,r31,r32,r33]) + REAL(ReKi), DIMENSION(:,:), ALLOCATABLE :: Velocity !< Velocity of all blade points (sized by 6 x number of mesh points on the blade [u,v,w,p,q,r]) + REAL(ReKi), DIMENSION(:,:), ALLOCATABLE :: Accln !< Acceleration of all blade points (sized by 6 x number of mesh points on the blade [udot,vdot,wdot,pdot,qdot,rdot]) + REAL(ReKi), DIMENSION(:,:), ALLOCATABLE :: Force !< Force of all blade points (sized by 6 x number of mesh points on the blade [Fx,Fy,Fz,Mx,My,Mz]) + END TYPE BladeStrMeshCoordsType + ! ======================= + ! ========= StrucPtsToBladeMapType ======= + TYPE, PUBLIC :: StrucPtsToBladeMapType + INTEGER(IntKi) :: NumBlades ! Number of blades on this rotor + INTEGER(IntKi), ALLOCATABLE :: NumMeshPtsPerBlade(:) ! Number of structural mesh points on each blade (sized by the number of blades) + INTEGER(IntKi), ALLOCATABLE :: MeshPt_2_BladeNum(:) ! Structural mesh point -> which blade on the rotor it is on (sized by the number of mesh points on the rotor) + TYPE(BladeNodeToMeshPointMapType),ALLOCATABLE:: BladeNode_2_MeshPt(:) ! Blade node on blade -> structural mesh point (sized by the number of mesh points on the blade) + TYPE(BladeStrMeshCoordsType), ALLOCATABLE :: BladeStrMeshCoords(:) ! Mesh point coordinates for each blade (sized by the number of blades) + END TYPE StrucPtsToBladeMapType + ! ======================= + ! ========= MeshByBladeType ======= + TYPE, PUBLIC :: MeshByBladeType + ! TODO: Sometime we should rename Mesh to BldMesh + TYPE(MeshType), ALLOCATABLE :: Mesh(:) ! Mesh for motions/loads of external nodes at each blade (sized by number of blades on the rotor) + END TYPE MeshByBladeType + ! ======================= + !------------------------------ ! Meshes for external nodes ! These point meshes are merely used to simplify the mapping of motions/loads @@ -142,33 +196,32 @@ MODULE AeroDyn_Inflow_C_BINDING ! one or multiple points. ! - 1 point -- rigid floating body assumption ! - N points -- flexible structure (either floating or fixed bottom) + ! TODO: for clarity, sometime it might be worth renaming BldStr* here to RtrPt* instead logical :: TransposeDCM !< Transpose DCMs as passed in -- test the vtk outputs to see if needed - integer(IntKi) :: NumMeshPts ! Number of mesh points we are interfacing motions/loads to/from AD - type(MeshType) :: BldPtMotionMesh ! mesh for motions of external nodes - type(MeshType) :: BldPtLoadMesh ! mesh for loads for external nodes - type(MeshType) :: BldPtLoadMesh_tmp ! mesh for loads for external nodes -- temporary -! type(MeshType) :: NacMotionMesh ! mesh for motion of nacelle -- TODO: add this mesh for nacelle load transfers -! type(MeshType) :: NacLoadMesh ! mesh for loads for nacelle loads -- TODO: add this mesh for nacelle load transfers + integer(IntKi), allocatable :: NumMeshPts(:) ! Number of mesh points we are interfacing motions/loads to/from AD for each rotor + type(MeshByBladeType), allocatable :: BldStrMotionMesh(:) ! Mesh for motions of external nodes (sized by number of rotors) + type(MeshByBladeType), allocatable :: BldStrLoadMesh(:) ! Mesh for loads for external nodes (sized by number of rotors) + type(MeshByBladeType), allocatable :: BldStrLoadMesh_tmp(:) ! Mesh for loads for external nodes -- temporary storage for loads (sized by number of rotors) + ! type(MeshType), allocatable :: NacMotionMesh(:) ! mesh for motion of nacelle -- TODO: add this mesh for nacelle load transfers + ! type(MeshType), allocatable :: NacLoadMesh(:) ! mesh for loads for nacelle loads -- TODO: add this mesh for nacelle load transfers !------------------------------ ! Mesh mapping: motions ! The mapping of motions from the nodes passed in to the corresponding AD meshes - type(MeshMapType), allocatable :: Map_BldPtMotion_2_AD_Blade(:) ! Mesh mapping between input motion mesh for blade -! type(MeshMapType) :: Map_AD_Nac_2_NacPtLoad ! Mesh mapping between input motion mesh for nacelle + ! TODO: sometime restructure the Map_BldStrMotion_2_AD_Blade and Map_AD_BldLoad_P_2_BldStrLoad to 1D and place inside a rotor structure + type(MeshMapType), allocatable :: Map_BldStrMotion_2_AD_Blade(:,:) ! Mesh mapping between input motion mesh for blade (sized by the number of blades and number of rotors) + type(MeshMapType), allocatable :: Map_AD_Nac_2_NacPtLoad(:) ! Mesh mapping between input motion mesh for nacelle !------------------------------ ! Mesh mapping: loads ! The mapping of loads from the AD meshes to the corresponding external nodes - type(MeshMapType), allocatable :: Map_AD_BldLoad_P_2_BldPtLoad(:) ! Mesh mapping between AD output blade line2 load to BldPtLoad for return -! type(MeshMapType) :: Map_NacPtMotion_2_AD_Nac ! Mesh mapping between AD output nacelle pt load to NacLoad for return - ! Motions input (so we don't have to reallocate all the time - real(ReKi), allocatable :: tmpBldPtMeshPos(:,:) ! temp array. Probably don't need this, but makes conversion from C clearer. - real(ReKi), allocatable :: tmpBldPtMeshOri(:,:,:) ! temp array. Probably don't need this, but makes conversion from C clearer. - real(ReKi), allocatable :: tmpBldPtMeshVel(:,:) ! temp array. Probably don't need this, but makes conversion from C clearer. - real(ReKi), allocatable :: tmpBldPtMeshAcc(:,:) ! temp array. Probably don't need this, but makes conversion from C clearer. - real(ReKi), allocatable :: tmpBldPtMeshFrc(:,:) ! temp array. Probably don't need this, but makes conversion to C clearer. - !------------------------------------------------------------------------------------ - - + type(StrucPtsToBladeMapType), allocatable :: StrucPts_2_Bld_Map(:) ! Array mapping info for structural mesh points to blades, and back (sized by the number of rotors/turbines) + type(MeshMapType), allocatable :: Map_AD_BldLoad_P_2_BldStrLoad(:,:) ! Mesh mapping between AD output blade line2 load to BldStrLoad for return (sized by the number of blades and number of rotors) + ! NOTE on turbine origin + ! The turbine origin is set by TurbOrigin_C during the ADI_C_SetupRotor routine. This is the tower base location. All + ! blade, tower, nacelle, and hub coordinates are relative to this location. Since AD15 and IfW use absolute positioning, + ! the reference positions for the blades, tower, nacelle, and hub are set by the values passed into ADI_C_SetupRotor + + ! TurbOrigin_C (stored as Sim%WT(iWT)%OriginInit). When the mesh and other points are passed in, they are relative to + ! their respective rotor origin. CONTAINS @@ -188,40 +241,190 @@ subroutine SetErr(ErrStat, ErrMsg, ErrStat_C, ErrMsg_C) else ErrMsg_C = TRANSFER( trim(ErrMsg)//C_NULL_CHAR, ErrMsg_C ) endif + if (ErrStat /= ErrID_None) call WrScr(NewLine//'ADI_C_Binding: '//trim(ErrMsg)//NewLine) end subroutine SetErr +!=============================================================================================================== +!--------------------------------------------- AeroDyn PreInit ------------------------------------------------- +!=============================================================================================================== +!> Allocate all the arrays for data storage for all turbine rotors +subroutine ADI_C_PreInit(NumTurbines_C, TransposeDCM_in, PointLoadOutput_in, DebugLevel_in, ErrStat_C, ErrMsg_C) BIND (C, NAME='ADI_C_PreInit') + implicit none +#ifndef IMPLICIT_DLLEXPORT +!DEC$ ATTRIBUTES DLLEXPORT :: ADI_C_PreInit +!GCC$ ATTRIBUTES DLLEXPORT :: ADI_C_PreInit +#endif + integer(c_int), intent(in ) :: NumTurbines_C + integer(c_int), intent(in ) :: TransposeDCM_in !< Transpose DCMs as they are passed i + integer(c_int), intent(in ) :: PointLoadOutput_in + integer(c_int), intent(in ) :: DebugLevel_in + integer(c_int), intent( out) :: ErrStat_C + character(kind=c_char), intent( out) :: ErrMsg_C(ErrMsgLen_C) + + ! Local variables + integer(IntKi) :: iWT !< current turbine + integer :: ErrStat !< aggregated error status + character(ErrMsgLen) :: ErrMsg !< aggregated error message + integer :: ErrStat2 !< temporary error status from a call + character(ErrMsgLen) :: ErrMsg2 !< temporary error message from a call + character(*), parameter :: RoutineName = 'ADI_C_PreInit' !< for error handling + + ! Initialize error handling + ErrStat = ErrID_None + ErrMsg = "" + + CALL NWTC_Init( ProgNameIn=version%Name ) + CALL DispCopyrightLicense( version%Name ) + CALL DispCompileRuntimeInfo( version%Name ) + + ! Save flag for outputting point or distributed loads + PointLoadOutput = PointLoadOutput_in /= 0 + + ! interface debugging + DebugLevel = int(DebugLevel_in,IntKi) + ! if non-zero, show all passed data here. Then check valid values + if (DebugLevel /= 0_IntKi) then + call WrScr(" Interface debugging level "//trim(Num2Lstr(DebugLevel))//" requested.") + call ShowPassedData() + endif + + ! check valid debug level + if (DebugLevel < 0_IntKi) then + ErrStat2 = ErrID_Fatal + ErrMsg2 = "Interface debug level must be 0 or greater"//NewLine// & + " 0 - none"//NewLine// & + " 1 - some summary info and variables passed through interface"//NewLine// & + " 2 - above + all position/orientation info"//NewLine// & + " 3 - above + input files (if direct passed)"//NewLine// & + " 4 - above + meshes" + if (Failed()) return; + endif + + ! Set number of turbines + Sim%NumTurbines = int(NumTurbines_C,IntKi) + + if (Sim%NumTurbines < 1_IntKi .or. Sim%NumTurbines > 9_IntKi) then + ErrStat2 = ErrID_Fatal + ErrMsg2 = 'AeroDyn_Inflow simulates between 1 and 9 turbines, but '//trim(Num2LStr(Sim%NumTurbines))//' was specified' + if (Failed()) return; + endif + + ! Flag to transpose DCMs as they are passed in + TransposeDCM = TransposeDCM_in==1_c_int + + ! Allocate arrays and meshes for the number of turbines + if (allocated(InitInp%AD%rotors)) deallocate(InitInp%AD%rotors) + allocate(InitInp%AD%rotors(Sim%NumTurbines),stat=errStat2); if (Failed0('rotors')) return + + ! allocate data storage for DiskAvgVel retrieval + if (allocated(DiskAvgVelVars)) deallocate(DiskAvgVelVars) + allocate(DiskAvgVelVars(Sim%NumTurbines), STAT=ErrStat2); if (Failed0('DiskAvgVelVars')) return + + ! Allocate data storage for turbine info + if (allocated(Sim%WT)) deallocate(Sim%WT) + allocate(Sim%WT(Sim%NumTurbines),stat=errStat2); if (Failed0('wind turbines')) return + do iWT=1,Sim%NumTurbines + Sim%WT(iWT)%NumBlades = -999 + enddo + + ! Storage for number of meshpoints + if (allocated(NumMeshPts)) deallocate(NumMeshPts) + allocate(NumMeshPts(Sim%NumTurbines),stat=errStat2); if (Failed0('NumMeshPts')) return + NumMeshPts = -999 + + ! Allocate meshes and mesh mappings + if (allocated(BldStrMotionMesh )) deallocate(BldStrMotionMesh ) + if (allocated(BldStrLoadMesh )) deallocate(BldStrLoadMesh ) + if (allocated(BldStrLoadMesh_tmp)) deallocate(BldStrLoadMesh_tmp) + ! if (allocated(NacMotionMesh )) deallocate(NacMotionMesh ) + ! if (allocated(NacLoadMesh )) deallocate(NacLoadMesh ) + allocate(BldStrMotionMesh( Sim%NumTurbines), STAT=ErrStat2); if (Failed0('BldStrMotionMesh' )) return + allocate(BldStrLoadMesh( Sim%NumTurbines), STAT=ErrStat2); if (Failed0('BldStrLoadMesh' )) return + allocate(BldStrLoadMesh_tmp(Sim%NumTurbines), STAT=ErrStat2); if (Failed0('BldStrLoadMesh_tmp')) return + ! allocate(NacMotionMesh( Sim%NumTurbines), STAT=ErrStat2); if (Failed0('NacMotionMesh' )) return + ! allocate(NacLoadMesh( Sim%NumTurbines), STAT=ErrStat2); if (Failed0('NacLoadMesh' )) return + + if (allocated(Map_BldStrMotion_2_AD_Blade )) deallocate(Map_BldStrMotion_2_AD_Blade ) + if (allocated(Map_AD_BldLoad_P_2_BldStrLoad )) deallocate(Map_AD_BldLoad_P_2_BldStrLoad) + ! if (allocated(Map_NacPtMotion_2_AD_Nac )) deallocate(Map_NacPtMotion_2_AD_Nac ) + ! allocate(Map_NacPtMotion_2_AD_Nac(Sim%NumTurbines),STAT=ErrStat2); if (Failed0('Map_AD_BldLoad_P_2_BldStrLoad')) returns + + ! Allocate the StrucPtsToBladeMapType array used for mapping structural points to blades of the rotor + if (allocated(StrucPts_2_Bld_Map)) deallocate(StrucPts_2_Bld_Map) + allocate(StrucPts_2_Bld_Map(Sim%NumTurbines), STAT=ErrStat2); if (Failed0('StrucPts_2_Bld_Map' )) return + + call SetErr(ErrStat,ErrMsg,ErrStat_C,ErrMsg_C) + +contains + logical function Failed() + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + Failed = ErrStat >= AbortErrLev + if (Failed) then + call ClearTmpStorage() + call SetErr(ErrStat,ErrMsg,ErrStat_C,ErrMsg_C) + endif + end function Failed + + ! check for failed where /= 0 is fatal + logical function Failed0(txt) + character(*), intent(in) :: txt + if (errStat /= 0) then + ErrStat2 = ErrID_Fatal + ErrMsg2 = "Could not allocate "//trim(txt) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + endif + Failed0 = ErrStat >= AbortErrLev + if(Failed0) call ClearTmpStorage() + end function Failed0 + + !> This subroutine prints out all the variables that are passed in. Use this only + !! for debugging the interface on the Fortran side. + subroutine ShowPassedData() + character(1) :: TmpFlag + call WrSCr("") + call WrScr("-----------------------------------------------------------") + call WrScr("Interface debugging: Variables passed in through interface") + call WrScr(" ADI_C_PreInit") + call WrScr(" --------------------------------------") + call WrScr(" NumTurbines_C "//trim(Num2LStr( NumTurbines_C )) ) + TmpFlag="F"; if (TransposeDCM_in==1_c_int) TmpFlag="T" + call WrScr(" TransposeDCM_in "//TmpFlag ) + call WrScr(" debuglevel "//trim(Num2LStr( DebugLevel_in )) ) + call WrScr("-----------------------------------------------------------") + end subroutine ShowPassedData + +end subroutine ADI_C_PreInit + !=============================================================================================================== !--------------------------------------------- AeroDyn Init---------------------------------------------------- !=============================================================================================================== -SUBROUTINE AeroDyn_Inflow_C_Init( ADinputFilePassed, ADinputFileString_C, ADinputFileStringLength_C, & +SUBROUTINE ADI_C_Init( ADinputFilePassed, ADinputFileString_C, ADinputFileStringLength_C, & IfWinputFilePassed, IfWinputFileString_C, IfWinputFileStringLength_C, OutRootName_C, & + OutVTKDir_C, & gravity_C, defFldDens_C, defKinVisc_C, defSpdSound_C, & defPatm_C, defPvap_C, WtrDpth_C, MSL2SWL_C, & - AeroProjMod_C, & InterpOrder_C, DT_C, TMax_C, & - storeHHVel, TransposeDCM_in, & - WrVTK_in, WrVTK_inType, VTKNacDim_in, VTKHubRad_in, & + storeHHVel, & + WrVTK_in, WrVTK_inType, WrVTK_inDT, & + VTKNacDim_in, VTKHubRad_in, & wrOuts_C, DT_Outs_C, & - HubPos_C, HubOri_C, & - NacPos_C, NacOri_C, & - NumBlades_C, BldRootPos_C, BldRootOri_C, & - NumMeshPts_C, InitMeshPos_C, InitMeshOri_C, & NumChannels_C, OutputChannelNames_C, OutputChannelUnits_C, & - ErrStat_C, ErrMsg_C) BIND (C, NAME='AeroDyn_Inflow_C_Init') + ErrStat_C, ErrMsg_C) BIND (C, NAME='ADI_C_Init') implicit none #ifndef IMPLICIT_DLLEXPORT -!DEC$ ATTRIBUTES DLLEXPORT :: AeroDyn_Inflow_C_Init -!GCC$ ATTRIBUTES DLLEXPORT :: AeroDyn_Inflow_C_Init +!DEC$ ATTRIBUTES DLLEXPORT :: ADI_C_Init +!GCC$ ATTRIBUTES DLLEXPORT :: ADI_C_Init #endif ! Input file info - logical(c_bool), intent(in ) :: ADinputFilePassed !< Write VTK outputs [0: none, 1: init only, 2: animation] + integer(c_int), intent(in ) :: ADinputFilePassed !< Write VTK outputs [0: none, 1: init only, 2: animation] type(c_ptr), intent(in ) :: ADinputFileString_C !< Input file as a single string with lines deliniated by C_NULL_CHAR integer(c_int), intent(in ) :: ADinputFileStringLength_C !< lenght of the input file string - logical(c_bool), intent(in ) :: IfWinputFilePassed !< Write VTK outputs [0: none, 1: init only, 2: animation] + integer(c_int), intent(in ) :: IfWinputFilePassed !< Write VTK outputs [0: none, 1: init only, 2: animation] type(c_ptr), intent(in ) :: IfWinputFileString_C !< Input file as a single string with lines deliniated by C_NULL_CHAR integer(c_int), intent(in ) :: IfWinputFileStringLength_C !< lenght of the input file string character(kind=c_char), intent(in ) :: OutRootName_C(IntfStrLen) !< Root name to use for echo files and other + character(kind=c_char), intent(in ) :: OutVTKDir_C(IntfStrLen) !< Directory to put all vtk output ! Environmental real(c_float), intent(in ) :: gravity_C !< Gravitational acceleration (m/s^2) real(c_float), intent(in ) :: defFldDens_C !< Air density (kg/m^3) @@ -231,38 +434,21 @@ SUBROUTINE AeroDyn_Inflow_C_Init( ADinputFilePassed, ADinputFileString_C, ADinpu real(c_float), intent(in ) :: defPvap_C !< Vapour pressure of working fluid (Pa) [used only for an MHK turbine cavitation check] real(c_float), intent(in ) :: WtrDpth_C !< Water depth (m) real(c_float), intent(in ) :: MSL2SWL_C !< Offset between still-water level and mean sea level (m) [positive upward] - ! Aero calculation method -- AeroProjMod - ! APM_BEM_NoSweepPitchTwist - 1 - "Original AeroDyn model where momentum balance is done in the WithoutSweepPitchTwist system" - ! APM_BEM_Polar - 2 - "Use staggered polar grid for momentum balance in each annulus" - ! APM_LiftingLine - 3 - "Use the blade lifting line (i.e. the structural) orientation (currently for OLAF with VAWT)" - integer(c_int), intent(in ) :: AeroProjMod_C !< Type of aerodynamic projection - ! Initial hub and blade root positions/orientations - real(c_float), intent(in ) :: HubPos_C( 3 ) !< Hub position - real(c_double), intent(in ) :: HubOri_C( 9 ) !< Hub orientation - real(c_float), intent(in ) :: NacPos_C( 3 ) !< Nacelle position - real(c_double), intent(in ) :: NacOri_C( 9 ) !< Nacelle orientation - integer(c_int), intent(in ) :: NumBlades_C !< Number of blades - real(c_float), intent(in ) :: BldRootPos_C( 3*NumBlades_C ) !< Blade root positions - real(c_double), intent(in ) :: BldRootOri_C( 9*NumBlades_C ) !< Blade root orientations - ! Initial nodes - integer(c_int), intent(in ) :: NumMeshPts_C !< Number of mesh points we are transfering motions to and output loads to - real(c_float), intent(in ) :: InitMeshPos_C( 3*NumMeshPts_C ) !< A 3xNumMeshPts_C array [x,y,z] - real(c_double), intent(in ) :: InitMeshOri_C( 9*NumMeshPts_C ) !< A 9xNumMeshPts_C array [r11,r12,r13,r21,r22,r23,r31,r32,r33] ! Interpolation integer(c_int), intent(in ) :: InterpOrder_C !< Interpolation order to use (must be 1 or 2) ! Time real(c_double), intent(in ) :: DT_C !< Timestep used with AD for stepping forward from t to t+dt. Must be constant. real(c_double), intent(in ) :: TMax_C !< Maximum time for simulation ! Flags - logical(c_bool), intent(in ) :: storeHHVel !< Store hub height time series from IfW - logical(c_bool), intent(in ) :: TransposeDCM_in !< Transpose DCMs as they are passed in + integer(c_int), intent(in ) :: storeHHVel !< Store hub height time series from IfW ! VTK integer(c_int), intent(in ) :: WrVTK_in !< Write VTK outputs [0: none, 1: init only, 2: animation] integer(c_int), intent(in ) :: WrVTK_inType !< Write VTK outputs as [1: surface, 2: lines, 3: both] + real(c_double), intent(in ) :: WrVTK_inDT !< Timestep between VTK writes real(c_float), intent(in ) :: VTKNacDim_in(6) !< Nacelle dimension passed in for VTK surface rendering [0,y0,z0,Lx,Ly,Lz] (m) real(c_float), intent(in ) :: VTKHubrad_in !< Hub radius for VTK surface rendering integer(c_int), intent(in ) :: wrOuts_C !< Write ADI output file - real(c_double), intent(in ) :: DT_Outs_C !< Timestep to write output file from ADI + real(c_double), intent(in ) :: DT_Outs_C !< Timestep to write output file from ADI ! Output integer(c_int), intent( out) :: NumChannels_C !< Number of output channels requested from the input file character(kind=c_char), intent( out) :: OutputChannelNames_C(ChanLen*MaxADIOutputs+1) !< NOTE: if MaxADIOutputs is sufficiently large, we may overrun the buffer on the Python side. @@ -270,7 +456,7 @@ SUBROUTINE AeroDyn_Inflow_C_Init( ADinputFilePassed, ADinputFileString_C, ADinpu integer(c_int), intent( out) :: ErrStat_C !< Error status character(kind=c_char), intent( out) :: ErrMsg_C(ErrMsgLen_C) !< Error message (C_NULL_CHAR terminated) - ! Local Variable4 + ! Local variables character(IntfStrLen) :: OutRootName !< Root name to use for echo files and other character(IntfStrLen) :: TmpFileName !< Temporary file name if not passing AD or IfW input file contents directly character(kind=C_char, len=ADinputFileStringLength_C), pointer :: ADinputFileString !< Input file as a single string with NULL chracter separating lines @@ -280,19 +466,47 @@ SUBROUTINE AeroDyn_Inflow_C_Init( ADinputFilePassed, ADinputFileString_C, ADinpu character(ErrMsgLen) :: ErrMsg !< aggregated error message integer(IntKi) :: ErrStat2 !< temporary error status from a call character(ErrMsgLen) :: ErrMsg2 !< temporary error message from a call - integer(IntKi) :: i,j,k !< generic counters - character(*), parameter :: RoutineName = 'AeroDyn_Inflow_C_Init' !< for error handling + character(IntfStrLen) :: OutVTKdir !< Output directory for files (relative to current location) + integer(IntKi) :: i,j,k !< generic index variables + integer(IntKi) :: iWT !< current turbine number (iterate through during setup for ADI_Init call) + integer(IntKi) :: AeroProjMod !< for checking that all turbines use the same AeroProjMod + character(*), parameter :: RoutineName = 'ADI_C_Init' !< for error handling ! Initialize error handling ErrStat = ErrID_None ErrMsg = "" + ErrStat2 = ErrID_None + ErrMsg2 = "" NumChannels_C = 0_c_int OutputChannelNames_C(:) = '' OutputChannelUnits_C(:) = '' - CALL NWTC_Init( ProgNameIn=version%Name ) - CALL DispCopyrightLicense( version%Name ) - CALL DispCompileRuntimeInfo( version%Name ) + + ! check if Pre-Init was called + if (Sim%NumTurbines < 0_IntKi) then + ErrStat2 = ErrID_Fatal + ErrMsg2 = "Call ADI_C_PreInit and ADI_C_SetupRotor prior to calling ADI_C_Init" + if (Failed()) return + endif + + do iWT=1,Sim%NumTurbines + if (Sim%WT(iWT)%NumBlades < 0) call SetErrStat(ErrID_Fatal,"Rotor "//trim(Num2LStr(iWT))//" not initialized. Call ADI_C_SetupRotor prior to calling ADI_C_Init",ErrStat,ErrMsg,RoutineName) + enddo + if (Failed()) return + + + ! Check that all turbines are using the same AeroProjMod (mixing projection modes is not currently supported) + AeroProjMod = InitInp%AD%rotors(1)%AeroProjMod + do iWT = 2,Sim%NumTurbines + if(AeroProjMod /= InitInp%AD%rotors(iWT)%AeroProjMod) then + ErrStat2 = ErrID_Fatal + ErrMsg2 = "Different AeroProjMod values for each turbine (set from TurbineIsHAWT flag). Check that all turbines are of the same type (HAWT or not)." + if (Failed()) return + endif + enddo + + ! Setup temporary storage arrays for simpler transfers + call SetTempStorage(ErrStat2,ErrMsg2); if (Failed()) return !-------------------------- @@ -303,9 +517,13 @@ SUBROUTINE AeroDyn_Inflow_C_Init( ADinputFilePassed, ADinputFileString_C, ADinpu i = INDEX(OutRootName,C_NULL_CHAR) - 1 ! if this has a c null character at the end... if ( i > 0 ) OutRootName = OutRootName(1:I) ! remove it + ! OutVTKdir -- output directory + OutVTKdir = TRANSFER( OutVTKdir_C, OutVTKdir ) + i = INDEX(OutVTKdir,C_NULL_CHAR) - 1 ! if this has a c null character at the end... + if ( i > 0 ) OutVTKdir = OutVTKdir(1:I) ! remove it ! For debugging the interface: - if (debugverbose > 0) then + if (DebugLevel > 0) then call ShowPassedData() endif @@ -316,7 +534,7 @@ SUBROUTINE AeroDyn_Inflow_C_Init( ADinputFilePassed, ADinputFileString_C, ADinpu ! Format AD input file contents InitInp%AD%RootName = OutRootName - if (ADinputFilePassed) then + if (ADinputFilePassed==1_c_int) then InitInp%AD%UsePrimaryInputFile = .FALSE. ! Don't try to read an input -- use passed data instead (blades and AF tables not passed) InitInp%AD%InputFile = "passed_ad_file" ! not actually used call InitFileInfo(ADinputFileString, InitInp%AD%PassedPrimaryInputData, ErrStat2, ErrMsg2); if (Failed()) return @@ -333,12 +551,12 @@ SUBROUTINE AeroDyn_Inflow_C_Init( ADinputFilePassed, ADinputFileString_C, ADinpu ! Format IfW input file contents ! RootName is set in ADI_Init using InitInp%RootName InitInp%RootName = OutRootName - if (IfWinputFilePassed) then - InitInp%IW_InitInp%UseInputFile = .FALSE. ! Don't try to read an input -- use passed data instead (blades and AF tables not passed) - InitInp%IW_InitInp%InputFile = "passed_ifw_file" ! not actually used - call InitFileInfo(IfWinputFileString, InitInp%IW_InitInp%PassedFileData, ErrStat2, ErrMsg2); if (Failed()) return + if (IfWinputFilePassed==1_c_int) then + InitInp%IW_InitInp%FilePassingMethod = 1_IntKi ! Don't try to read an input -- use passed data instead (blades and AF tables not passed) using FileInfoType + InitInp%IW_InitInp%InputFile = "passed_ifw_file" ! not actually used + call InitFileInfo(IfWinputFileString, InitInp%IW_InitInp%PassedFileInfo, ErrStat2, ErrMsg2); if (Failed()) return else - InitInp%IW_InitINp%UseInputFile = .TRUE. ! Read input info from a primary input file + InitInp%IW_InitINp%FilePassingMethod = 0_IntKi ! Read input info from a primary input file i = min(IntfStrLen,IfWinputFileStringLength_C) TmpFileName = '' TmpFileName(1:i) = IfWinputFileString(1:i) @@ -351,34 +569,31 @@ SUBROUTINE AeroDyn_Inflow_C_Init( ADinputFilePassed, ADinputFileString_C, ADinpu ! For diagnostic purposes, the following can be used to display the contents ! of the InFileInfo data structure. ! CU is the screen -- system dependent. - if (debugverbose >= 3) then - if (ADinputFilePassed) call Print_FileInfo_Struct( CU, InitInp%AD%PassedPrimaryInputData ) - if (IfWinputFilePassed) call Print_FileInfo_Struct( CU, InitInp%IW_InitInp%PassedFileData ) + if (DebugLevel >= 3) then + if (ADinputFilePassed==1_c_int) call Print_FileInfo_Struct( CU, InitInp%AD%PassedPrimaryInputData ) + if (IfWinputFilePassed==1_c_int) call Print_FileInfo_Struct( CU, InitInp%IW_InitInp%PassedFileInfo ) endif ! Store data about the simulation (NOTE: we are not fully populating the Sim data structure) - allocate (Sim%WT(1),stat=errStat2); if (Failed0('wind turbines')) return Sim%dT = REAL(DT_C, DbKi) Sim%TMax = REAL(TMax_C, DbKi) Sim%numSteps = ceiling(Sim%tMax/Sim%dt) - Sim%NumTurbines = 1_IntKi ! only one turbine for now - Sim%WT(1)%NumBlades = int(NumBlades_C, IntKi) Sim%root = trim(OutRootName) - Sim%WT(1)%OriginInit = (/ 0.0_SiKi, 0.0_SiKi, 0.0_SiKi /) !TODO: should this be an input? ! Timekeeping n_Global = 0_IntKi ! Assume we are on timestep 0 at start - n_VTK = -1_IntKi ! Set VTK output to T=0 at first call + n_VTK = -1_IntKi ! counter advance just before writing ! Interpolation order - InterpOrder = int(InterpOrder_C, IntKi) + InterpOrder = int(InterpOrder_C, IntKi) ! VTK outputs WrOutputsData%WrVTK = int(WrVTK_in, IntKi) WrOutputsData%WrVTK_Type = int(WrVTK_inType, IntKi) + WrOutputsData%VTK_dt = real(WrVTK_inDT, DbKi) WrOutputsData%VTKNacDim = real(VTKNacDim_in, SiKi) WrOutputsData%VTKHubrad = real(VTKHubrad_in, SiKi) WrOutputsData%VTKRefPoint = (/ 0.0_ReKi, 0.0_ReKi, 0.0_ReKi /) !TODO: should this be an input? WrOutputsData%root = trim(OutRootName) - WrOutputsData%n_VTKTime = 1 ! output every timestep + WrOutputsData%n_VTKTime = 1 ! output every timestep ! Write outputs to file WrOutputsData%fileFmt = int(wrOuts_C, IntKi) @@ -387,9 +602,6 @@ SUBROUTINE AeroDyn_Inflow_C_Init( ADinputFilePassed, ADinputFileString_C, ADinpu ! Validate and set some inputs (moved to subroutine to make cleaner to read call ValidateSetInputs(ErrStat2,ErrMsg2); if(Failed()) return - ! Flag to transpose DCMs as they are passed in - TransposeDCM = TransposeDCM_in - ! Linearization ! for now, set linearization to false. Pass this in later when interface supports it InitInp%AD%Linearize = .FALSE. @@ -407,56 +619,16 @@ SUBROUTINE AeroDyn_Inflow_C_Init( ADinputFilePassed, ADinputFileString_C, ADinpu InitInp%AD%defPvap = REAL(defPvap_C, ReKi) InitInp%AD%WtrDpth = REAL(WtrDpth_C, ReKi) InitInp%AD%MSL2SWL = REAL(MSL2SWL_C, ReKi) - InitInp%storeHHVel = storeHHVel + InitInp%storeHHVel = storeHHVel==1_c_int InitInp%WrVTK = WrOutputsData%WrVTK InitInp%WrVTK_Type = WrOutputsData%WrVTK_Type InitInp%IW_InitInp%CompInflow = 1 ! Use InflowWind ! setup rotors for AD -- interface only supports one rotor at present - allocate (InitInp%AD%rotors(1),stat=errStat2); if (Failed0('rotors')) return - InitInp%AD%rotors(1)%AeroProjMod = int(AeroProjMod_C, IntKi) - InitInp%AD%rotors(1)%numBlades = Sim%WT(1)%NumBlades - call AllocAry(InitInp%AD%rotors(1)%BladeRootPosition, 3, Sim%WT(1)%NumBlades, 'BldRootPos', errStat2, errMsg2 ); if (Failed()) return - call AllocAry(InitInp%AD%rotors(1)%BladeRootOrientation, 3, 3, Sim%WT(1)%NumBlades, 'BldRootOri', errStat2, errMsg2 ); if (Failed()) return - InitInp%AD%rotors(1)%HubPosition = real(HubPos_C(1:3),ReKi) - InitInp%AD%rotors(1)%HubOrientation = reshape( real(HubOri_C(1:9),R8Ki), (/3,3/) ) - InitInp%AD%rotors(1)%NacellePosition = real(NacPos_C(1:3),ReKi) - InitInp%AD%rotors(1)%NacelleOrientation = reshape( real(NacOri_C(1:9),R8Ki), (/3,3/) ) - InitInp%AD%rotors(1)%BladeRootPosition = reshape( real(BldRootPos_C(1:3*Sim%WT(1)%NumBlades),ReKi), (/ 3,Sim%WT(1)%NumBlades/) ) - InitInp%AD%rotors(1)%BladeRootOrientation = reshape( real(BldRootOri_C(1:9*Sim%WT(1)%NumBlades),R8Ki), (/3,3,Sim%WT(1)%NumBlades/) ) - if (TransposeDCM) then - InitInp%AD%rotors(1)%HubOrientation = transpose(InitInp%AD%rotors(1)%HubOrientation) - InitInp%AD%rotors(1)%NacelleOrientation = transpose(InitInp%AD%rotors(1)%NacelleOrientation) - do i=1,Sim%WT(1)%NumBlades - InitInp%AD%rotors(1)%BladeRootOrientation(1:3,1:3,i) = transpose(InitInp%AD%rotors(1)%BladeRootOrientation(1:3,1:3,i)) - enddo - endif - - ! Remap the orientation DCM just in case there is some issue with passed - call OrientRemap(InitInp%AD%rotors(1)%HubOrientation) - call OrientRemap(InitInp%AD%rotors(1)%NacelleOrientation) - do i=1,Sim%WT(1)%NumBlades - call OrientRemap(InitInp%AD%rotors(1)%BladeRootOrientation(1:3,1:3,i)) + do iWT=1,Sim%NumTurbines + InitInp%AD%rotors(iWT)%numBlades = Sim%WT(iWT)%NumBlades enddo - ! Number of blades and initial positions - ! - NumMeshPts is the number of interface Mesh points we are expecting on the python - ! side. Will validate this against what AD reads from the initialization info. - NumMeshPts = int(NumMeshPts_C, IntKi) - if (NumMeshPts < 1) then - ErrStat2 = ErrID_Fatal - ErrMsg2 = "At least one node point must be specified" - if (Failed()) return - endif - ! Allocate temporary arrays to simplify data conversions - call AllocAry( tmpBldPtMeshPos, 3, NumMeshPts, "tmpBldPtMeshPos", ErrStat2, ErrMsg2 ); if (Failed()) return - call AllocAry( tmpBldPtMeshOri, 3, 3, NumMeshPts, "tmpBldPtMeshOri", ErrStat2, ErrMsg2 ); if (Failed()) return - call AllocAry( tmpBldPtMeshVel, 6, NumMeshPts, "tmpBldPtMeshVel", ErrStat2, ErrMsg2 ); if (Failed()) return - call AllocAry( tmpBldPtMeshAcc, 6, NumMeshPts, "tmpBldPtMeshAcc", ErrStat2, ErrMsg2 ); if (Failed()) return - call AllocAry( tmpBldPtMeshFrc, 6, NumMeshPts, "tmpBldPtMeshFrc", ErrStat2, ErrMsg2 ); if (Failed()) return - tmpBldPtMeshPos( 1:3,1:NumMeshPts) = reshape( real(InitMeshPos_C(1:3*NumMeshPts),ReKi), (/ 3,NumMeshPts/) ) - tmpBldPtMeshOri(1:3,1:3,1:NumMeshPts) = reshape( real(InitMeshOri_C(1:9*NumMeshPts),ReKi), (/3,3,NumMeshPts/) ) - !---------------------------------------------------- ! Allocate input array u and corresponding InputTimes @@ -486,35 +658,62 @@ SUBROUTINE AeroDyn_Inflow_C_Init( ADinputFilePassed, ADinputFileString_C, ADinpu !------------------------------------------------------------- ! Sanity checks !------------------------------------------------------------- - call CheckNodes(ErrStat2,ErrMsg2); if (Failed()) return + do iWT=1,Sim%NumTurbines + call CheckNodes(iWT); if (Failed()) return + enddo !------------------------------------------------------------- ! Set the interface meshes for motion inputs and loads output !------------------------------------------------------------- - call SetMotionLoadsInterfaceMeshes(ErrStat2,ErrMsg2); if (Failed()) return + call SetupMotionLoadsInterfaceMeshes(); if (Failed()) return + ! setup meshes if (WrOutputsData%WrVTK > 0_IntKi) then - call setVTKParameters(WrOutputsData, Sim, ADI, errStat, errMsg, 'vtk-ADI') + if (len_trim(OutVTKdir) <= 0) then + OutVTKdir = 'vtk-ADI' + endif + call setVTKParameters(WrOutputsData, Sim, ADI, ErrStat2, ErrMsg2, OutVTKdir) if (Failed()) return - call WrVTK_refMeshes(ADI%u(1)%AD%rotors(:),WrOutputsData%VTKRefPoint,ErrStat2,ErrMsg2) + endif + ! write meshes for this rotor + if (WrOutputsData%WrVTK > 0_IntKi) then + do iWT=1,Sim%NumTurbines + call WrVTK_refMeshes(ADI%u(1)%AD%rotors(:),WrOutputsData%VTKRefPoint,ErrStat2,ErrMsg2) + enddo if (Failed()) return endif + ! Setup points for calculating disk average velocity + do iWT=1,Sim%NumTurbines + call SetDiskAvgPoints(iWT) + if (Failed()) return + enddo + !------------------------------------------------------------- ! Setup other prior timesteps ! We fill InputTimes with negative times, but the Input values are identical for each of those times; this allows ! us to use, e.g., quadratic interpolation that effectively acts as a zeroth-order extrapolation and first-order extrapolation ! for the first and second time steps. (The interpolation order in the ExtrapInput routines are determined as ! order = SIZE(Input) + ! Tracking of previous input times + ! Since we may run correction steps, there are some things we don't want to do !------------------------------------------------------------- do i=2,InterpOrder+1 call ADI_CopyInput (ADI%u(1), ADI%u(i), MESH_NEWCOPY, Errstat2, ErrMsg2) if (Failed()) return enddo do i = 1, InterpOrder + 1 - ADI%InputTimes(i) = 0.0_DbKi - (i - 1) * Sim%dT ! assume start at T=0 + ADI%InputTimes(i) = 0.0_DbKi - (i - 1) * Sim%dT ! assume start at T=0 enddo - InputTimePrev = ADI%InputTimes(1) - Sim%dT ! Initialize for UpdateStates + InputTimePrev = ADI%InputTimes(1) - Sim%dT ! Initialize for UpdateStates + InputTimePrev_Calc = ADI%InputTimes(1) - Sim%dT ! Initialize for CalcOutput + + !------------------------------------------------------------- + ! copy of ADI inputs. AD_SetInputMotion will set this mesh. When CalcOutput is called, + ! this data is used. When UpdateStates is called, this data is copied over to the ADI%u + !------------------------------------------------------------- + call ADI_CopyInput (ADI%u(1), ADI_u, MESH_NEWCOPY, Errstat2, ErrMsg2) + if (Failed()) return !------------------------------------------------------------- @@ -563,6 +762,11 @@ SUBROUTINE AeroDyn_Inflow_C_Init( ADinputFilePassed, ADinputFileString_C, ADinpu call SetupFileOutputs() endif + + ! destroy the InitInp and InitOutput + call ADI_DestroyInitInput( InitInp, Errstat2, ErrMsg2); if (Failed()) return + call ADI_DestroyInitOutput(InitOutData, Errstat2, ErrMsg2); if (Failed()) return + call SetErr(ErrStat,ErrMsg,ErrStat_C,ErrMsg_C) @@ -571,7 +775,7 @@ logical function Failed() CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) Failed = ErrStat >= AbortErrLev if (Failed) then - call FailCleanup() + call ClearTmpStorage() call SetErr(ErrStat,ErrMsg,ErrStat_C,ErrMsg_C) endif end function Failed @@ -579,31 +783,30 @@ end function Failed ! check for failed where /= 0 is fatal logical function Failed0(txt) character(*), intent(in) :: txt - if (errStat /= 0) then + if (errStat2 /= 0) then ErrStat2 = ErrID_Fatal ErrMsg2 = "Could not allocate "//trim(txt) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) endif Failed0 = ErrStat >= AbortErrLev - if(Failed0) call FailCleanup() + if(Failed0) then + call ClearTmpStorage() + call SetErr(ErrStat,ErrMsg,ErrStat_C,ErrMsg_C) + endif end function Failed0 - subroutine FailCleanup() - if (allocated(tmpBldPtMeshPos)) deallocate(tmpBldPtMeshPos) - if (allocated(tmpBldPtMeshOri)) deallocate(tmpBldPtMeshOri) - if (allocated(tmpBldPtMeshVel)) deallocate(tmpBldPtMeshVel) - if (allocated(tmpBldPtMeshAcc)) deallocate(tmpBldPtMeshAcc) - if (allocated(tmpBldPtMeshFrc)) deallocate(tmpBldPtMeshFrc) - end subroutine FailCleanup - !> Validate and set some of the outputs (values must be stored before here as some might be changed) subroutine ValidateSetInputs(ErrStat3,ErrMsg3) integer(IntKi), intent( out) :: ErrStat3 !< temporary error status character(ErrMsgLen), intent( out) :: ErrMsg3 !< temporary error message + + ErrStat3 = ErrID_None + ErrMsg3 = "" + ! Interporder if ( InterpOrder < 1_IntKi .or. InterpOrder > 2_IntKi ) then - call SetErrStat(ErrID_Fatal,"InterpOrder passed into AeroDyn_Inflow_C_Init must be 1 (linear) or 2 (quadratic)",ErrStat3,ErrMsg3,RoutineName) + call SetErrStat(ErrID_Fatal,"InterpOrder passed into ADI_C_Init must be 1 (linear) or 2 (quadratic)",ErrStat3,ErrMsg3,RoutineName) return endif @@ -623,6 +826,7 @@ subroutine ValidateSetInputs(ErrStat3,ErrMsg3) endif endif + ! check fileFmt if ( WrOutputsData%fileFmt /= idFmtNone .and. WrOutputsData%fileFmt /= idFmtAscii .and. & WrOutputsData%fileFmt /= idFmtBinary .and. WrOutputsData%fileFmt /= idFmtBoth) then @@ -642,6 +846,19 @@ subroutine ValidateSetInputs(ErrStat3,ErrMsg3) call SetErrStat(ErrID_Warn,"Requested DT_Outs is not an integer multiple of DT. Changing DT_Outs to "//trim(Num2LStr(WrOutputsData%DT_Outs))//".",ErrStat3,ErrMsg3,RoutineName) endif endif + if (WrOutputsData%WrVTK > 1_IntKi) then ! only if writing during simulation is requested (ignore init or no outputs) + ! If a smaller timestep between outputs is requested than the simulation runs at, change to DT + if (WrOutputsData%VTK_DT < Sim%dT) then + WrOutputsData%VTK_DT = Sim%dT + call SetErrStat(ErrID_Warn,"Requested VTK_DT is smaller than timestep DT. Setting VTK_DT to DT.",ErrStat3,ErrMsg3,RoutineName) + endif + ! If not an integer multiple of DT, adjust + WrOutputsData%n_VTKtime = NINT( WrOutputsData%VTK_DT / Sim%dT ) + if (.NOT. EqualRealNos( WrOutputsData%VTK_DT, Sim%dT * WrOutputsData%n_VTKtime )) then + WrOutputsData%VTK_DT = real(WrOutputsData%n_VTKtime, DbKi) * Sim%dT + call SetErrStat(ErrID_Warn,"Requested VTK_DT is not an integer multiple of DT. Changing VTK_DT to "//trim(Num2LStr(WrOutputsData%VTK_DT))//".",ErrStat3,ErrMsg3,RoutineName) + endif + endif end subroutine ValidateSetInputs !> allocate data storage for file outputs @@ -658,9 +875,9 @@ subroutine SetupFileOutputs() call concatOutputHeaders(WrOutputsData%WriteOutputHdr, WrOutputsData%WriteOutputUnt, InitOutData%WriteOutputHdr, InitOutData%WriteOutputUnt, errStat2, errMsg2); if(Failed()) return ! allocate output file handling and set formats - WrOutputsData%outFmt = "ES15.8E2" + WrOutputsData%outFmt = "ES15.8E2" WrOutputsData%delim = TAB - WrOutputsData%AD_ver = InitOutData%Ver + WrOutputsData%AD_ver = InitOutData%Ver allocate(WrOutputsData%unOutFile(Sim%numTurbines), STAT=ErrStat2); if(Failed0("unOutFile")) return; WrOutputsData%unOutFile = -1 !FIXME: number of timesteps is incorrect! @@ -674,18 +891,22 @@ end subroutine SetupFileOutputs subroutine ShowPassedData() character(1) :: TmpFlag integer :: i,j - call WrScr("Interface debugging: Variables passed in through interface") + call WrSCr("") call WrScr("-----------------------------------------------------------") + call WrScr("Interface debugging: Variables passed in through interface") + call WrScr(" ADI_C_Init") + call WrScr(" --------------------------------------------------------") call WrScr(" FileInfo") - TmpFlag="F"; if (ADinputFilePassed) TmpFlag="T" + TmpFlag="F"; if (ADinputFilePassed==1_c_int) TmpFlag="T" call WrScr(" ADinputFilePassed_C "//TmpFlag ) call WrScr(" ADinputFileString_C (ptr addr) "//trim(Num2LStr(LOC(ADinputFileString_C))) ) call WrScr(" ADinputFileStringLength_C "//trim(Num2LStr( ADinputFileStringLength_C )) ) - TmpFlag="F"; if (IfWinputFilePassed) TmpFlag="T" + TmpFlag="F"; if (IfWinputFilePassed==1_c_int) TmpFlag="T" call WrScr(" IfWinputFilePassed_C "//TmpFlag ) call WrScr(" IfWinputFileString_C (ptr addr)"//trim(Num2LStr(LOC(IfWinputFileString_C))) ) call WrScr(" IfWinputFileStringLength_C "//trim(Num2LStr( IfWinputFileStringLength_C )) ) call WrScr(" OutRootName "//trim(OutRootName) ) + call WrScr(" OutVTKDir "//trim(OutVTKDir) ) call WrScr(" Environment variables") call WrScr(" gravity_C "//trim(Num2LStr( gravity_C )) ) call WrScr(" defFldDens_C "//trim(Num2LStr( defFldDens_C )) ) @@ -704,208 +925,76 @@ subroutine ShowPassedData() call WrScr(" wrOuts_C "//trim(Num2LStr( wrOuts_C )) ) call WrScr(" DT_Outs_C "//trim(Num2LStr( DT_Outs_C )) ) call WrScr(" Flags") - TmpFlag="F"; if (storeHHVel) TmpFlag="T" + TmpFlag="F"; if (storeHHVel==1_c_int) TmpFlag="T" call WrScr(" storeHHVel "//TmpFlag ) call WrScr(" WrVTK_in "//trim(Num2LStr( WrVTK_in )) ) call WrScr(" WrVTK_inType "//trim(Num2LStr( WrVTK_inType )) ) - TmpFlag="F"; if (TransposeDCM_in) TmpFlag="T" - call WrScr(" TransposeDCM_in "//TmpFlag ) - call WrScr(" Init Data") - call WrNR(" Hub Position ") - call WrMatrix(HubPos_C,CU,'(3(ES15.7e2))') - call WrNR(" Hub Orientation ") - call WrMatrix(HubOri_C,CU,'(9(ES23.15e2))') - call WrNR(" Nacelle Position ") - call WrMatrix(NacPos_C,CU,'(3(ES15.7e2))') - call WrNR(" Nacelle Orientation ") - call WrMatrix(NacOri_C,CU,'(9(ES23.15e2))') - call WrScr(" NumBlades_C "//trim(Num2LStr( NumBlades_C )) ) - if (debugverbose > 1) then - call WrScr(" Root Positions") - do i=1,NumBlades_C - j=3*(i-1) - call WrMatrix(BldRootPos_C(j+1:j+3),CU,'(3(ES15.7e2))') - enddo - call WrScr(" Root Orientations") - do i=1,NumBlades_C - j=9*(i-1) - call WrMatrix(BldRootOri_C(j+1:j+9),CU,'(9(ES23.15e2))') - enddo - endif - call WrScr(" NumMeshPts_C "//trim(Num2LStr( NumMeshPts_C )) ) - if (debugverbose > 1) then - call WrScr(" Mesh Positions") - do i=1,NumMeshPts_C - j=3*(i-1) - call WrMatrix(InitMeshPos_C(j+1:j+3),CU,'(3(ES15.7e2))') - enddo - call WrScr(" Mesh Orientations") - do i=1,NumMeshPts_C - j=9*(i-1) - call WrMatrix(InitMeshOri_C(j+1:j+9),CU,'(9(ES23.15e2))') - enddo - endif + call WrScr(" WrVTK_inDT "//trim(Num2LStr( WrVTK_inDT )) ) call WrScr("-----------------------------------------------------------") end subroutine ShowPassedData !> This subroutine sets the interface meshes to map to the input motions to the AD !! meshes - subroutine SetMotionLoadsInterfaceMeshes(ErrStat3,ErrMsg3) - integer(IntKi), intent( out) :: ErrStat3 !< temporary error status - character(ErrMsgLen), intent( out) :: ErrMsg3 !< temporary error message - integer(IntKi) :: iNode - real(ReKi) :: InitPos(3) - real(R8Ki) :: Orient(3,3) - !------------------------------------------------------------- - ! Set the interface meshes for motion inputs and loads output - !------------------------------------------------------------- - ! Motion mesh for blades - call MeshCreate( BldPtMotionMesh , & - IOS = COMPONENT_INPUT , & - Nnodes = NumMeshPts , & - ErrStat = ErrStat3 , & - ErrMess = ErrMsg3 , & - TranslationDisp = .TRUE., Orientation = .TRUE., & - TranslationVel = .TRUE., RotationVel = .TRUE., & - TranslationAcc = .TRUE., RotationAcc = .FALSE. ) - if (ErrStat3 >= AbortErrLev) return - - do iNode=1,NumMeshPts - ! initial position and orientation of node - InitPos = tmpBldPtMeshPos(1:3,iNode) - if (TransposeDCM) then - Orient = transpose(tmpBldPtMeshOri(1:3,1:3,iNode)) - else - Orient = tmpBldPtMeshOri(1:3,1:3,iNode) - endif - call OrientRemap(Orient) - call MeshPositionNode( BldPtMotionMesh , & - iNode , & - InitPos , & ! position - ErrStat3, ErrMsg3 , & - Orient ) ! orientation - if (ErrStat3 >= AbortErrLev) return -!FIXME: if we need to switch to line2 instead of point, do that here. - call MeshConstructElement ( BldPtMotionMesh, ELEMENT_POINT, ErrStat3, ErrMsg3, iNode ) - if (ErrStat3 >= AbortErrLev) return - enddo - - call MeshCommit ( BldPtMotionMesh, ErrStat3, ErrMsg3 ) - if (ErrStat3 >= AbortErrLev) return - BldPtMotionMesh%RemapFlag = .TRUE. - - ! For checking the mesh, uncomment this. - ! note: CU is is output unit (platform dependent). - if (debugverbose >= 4) call MeshPrintInfo( CU, BldPtMotionMesh, MeshName='BldPtMotionMesh' ) - - -! !------------------------------------------------------------- -! ! Motion mesh for nacelle -- TODO: add this mesh for nacelle load transfers -! call MeshCreate( NacMotionMesh , & -! IOS = COMPONENT_INPUT , & -! Nnodes = 1 , & -! ErrStat = ErrStat3 , & -! ErrMess = ErrMsg3 , & -! TranslationDisp = .TRUE., Orientation = .TRUE., & -! TranslationVel = .TRUE., RotationVel = .TRUE., & -! TranslationAcc = .TRUE., RotationAcc = .FALSE. ) -! if (ErrStat3 >= AbortErrLev) return -! -! InitPos = real(NacPos_C( 1:3),ReKi) -! Orient = reshape( real(NacOri_C(1:9),ReKi), (/3,3/) ) -! call OrientRemap(Orient) -! call MeshPositionNode( NacMotionMesh , & -! 1 , & -! InitPos , & ! position -! ErrStat3, ErrMsg3 , & -! Orient ) ! orientation -! if (ErrStat3 >= AbortErrLev) return -! -! call MeshConstructElement ( NacMotionMesh, ELEMENT_POINT, ErrStat3, ErrMsg3, p1=1 ) -! if (ErrStat3 >= AbortErrLev) return -! -! call MeshCommit ( NacMotionMesh, ErrStat3, ErrMsg3 ) -! if (ErrStat3 >= AbortErrLev) return -! NacMotionMesh%RemapFlag = .TRUE. -! -! ! For checking the mesh, uncomment this. -! ! note: CU is is output unit (platform dependent). -! if (debugverbose >= 4) call MeshPrintInfo( CU, NacMotionMesh, MeshName='NacMotionMesh' ) -! -! - !------------------------------------------------------------- - ! Load mesh for blades - CALL MeshCopy( SrcMesh = BldPtMotionMesh ,& - DestMesh = BldPtLoadMesh ,& - CtrlCode = MESH_SIBLING ,& - IOS = COMPONENT_OUTPUT ,& - ErrStat = ErrStat3 ,& - ErrMess = ErrMsg3 ,& - Force = .TRUE. ,& - Moment = .TRUE. ) - if (ErrStat3 >= AbortErrLev) return - BldPtLoadMesh%RemapFlag = .TRUE. - - ! Temp mesh for load transfer - CALL MeshCopy( SrcMesh = BldPtLoadMesh ,& - DestMesh = BldPtLoadMesh_tmp ,& - CtrlCode = MESH_COUSIN ,& - IOS = COMPONENT_OUTPUT ,& - ErrStat = ErrStat3 ,& - ErrMess = ErrMsg3 ,& - Force = .TRUE. ,& - Moment = .TRUE. ) - if (ErrStat3 >= AbortErrLev) return - BldPtLoadMesh_tmp%RemapFlag = .TRUE. - - - ! For checking the mesh - ! note: CU is is output unit (platform dependent). - if (debugverbose >= 4) call MeshPrintInfo( CU, BldPtLoadMesh, MeshName='BldPtLoadMesh' ) - - -! !------------------------------------------------------------- -! ! Load mesh for nacelle -- TODO: add this mesh for nacelle load transfers -! CALL MeshCopy( SrcMesh = NacMotionMesh ,& -! DestMesh = NacLoadMesh ,& -! CtrlCode = MESH_SIBLING ,& -! IOS = COMPONENT_OUTPUT ,& -! ErrStat = ErrStat3 ,& -! ErrMess = ErrMsg3 ,& -! Force = .TRUE. ,& -! Moment = .TRUE. ) -! if (ErrStat3 >= AbortErrLev) return -! NacLoadMesh%RemapFlag = .TRUE. -! -! ! For checking the mesh, uncomment this. -! ! note: CU is is output unit (platform dependent). -! if (debugverbose >= 4) call MeshPrintInfo( CU, NacLoadMesh, MeshName='NacLoadMesh' ) - - - !------------------------------------------------------------- - ! Set the mapping meshes - ! blades - allocate(Map_BldPtMotion_2_AD_Blade(Sim%WT(1)%NumBlades),Map_AD_BldLoad_P_2_BldPtLoad(Sim%WT(1)%NumBlades),STAT=ErrStat3) - if (ErrStat3 /= 0) then - ErrStat3 = ErrID_Fatal - ErrMsg3 = "Could not allocate Map_BldPtMotion_2_AD_Blade" - return - endif - do i=1,Sim%WT(1)%NumBlades - call MeshMapCreate( BldPtMotionMesh, ADI%u(1)%AD%rotors(1)%BladeMotion(i), Map_BldPtMotion_2_AD_Blade(i), ErrStat3, ErrMsg3 ) - if (ErrStat3 >= AbortErrLev) return - call MeshMapCreate( ADI%y%AD%rotors(1)%BladeLoad(i), BldPtLoadMesh, Map_AD_BldLoad_P_2_BldPtLoad(i), ErrStat3, ErrMsg3 ) - if (ErrStat3 >= AbortErrLev) return + subroutine SetupMotionLoadsInterfaceMeshes() + integer(IntKi) :: iWT !< current rotor/turbine + integer(IntKi) :: iBlade !< current blade + integer(IntKi) :: maxBlades !< maximum number of blades on all turbine rotors + + ! Find out maximum number of blades on all turbine rotors + maxBlades = 0_IntKi + do iWT=1,Sim%NumTurbines + maxBlades = max(maxBlades,Sim%WT(iWT)%NumBlades) enddo - ! nacelle -- TODO: add this mesh for nacelle load transfers -! if ( y%AD%rotors(1)%NacelleLoad%Committed ) then -! call MeshMapCreate( NacMotionMesh, ADI%u(1)%AD%rotors(1)%NacelleMotion, Map_NacPtMotion_2_AD_Nac, ErrStat3, ErrMsg3 ) -! if (ErrStat3 >= AbortErrLev) return -! call MeshMapCreate( ADI%y%AD%rotors(1)%NacelleLoad, NacLoadMesh, Map_AD_Nac_2_NacPtLoad, ErrStat3, ErrMsg3 ) -! if (ErrStat3 >= AbortErrLev) return -! endif - end subroutine SetMotionLoadsInterfaceMeshes + ! NOTE: storing mappings in 2D this way may increase memory usage slightly if one turbine has many more blades than another. However + ! the speed an memory penalties are negligible, so I don't see much reason to change that at this point. + allocate(Map_BldStrMotion_2_AD_Blade( maxBlades, Sim%NumTurbines), STAT=ErrStat2); if (Failed0('Map_BldStrMotion_2_AD_Blade' )) return + allocate(Map_AD_BldLoad_P_2_BldStrLoad(maxBlades, Sim%NumTurbines), STAT=ErrStat2); if (Failed0('Map_AD_BldLoad_P_2_BldStrLoad')) return + + ! Step through all turbine rotors + do iWT=1,Sim%NumTurbines + !------------------------------------------------------------- + ! Load mesh for blades + ! Step through all blades on this rotor + do iBlade=1,Sim%WT(iWT)%NumBlades + !------------------------------------------------------------- + ! Load mesh for blades + CALL MeshCopy( SrcMesh = BldStrMotionMesh(iWT)%Mesh(iBlade) ,& + DestMesh = BldStrLoadMesh(iWT)%Mesh(iBlade) ,& + CtrlCode = MESH_SIBLING ,& + IOS = COMPONENT_OUTPUT ,& + ErrStat = ErrStat2 ,& + ErrMess = ErrMsg2 ,& + Force = .TRUE. ,& + Moment = .TRUE. ) + if(Failed()) return + BldStrMotionMesh(iWT)%Mesh(iBlade)%RemapFlag = .FALSE. + + ! Temp mesh for load transfer + CALL MeshCopy( SrcMesh = BldStrLoadMesh(iWT)%Mesh(iBlade) ,& + DestMesh = BldStrLoadMesh_tmp(iWT)%Mesh(iBlade) ,& + CtrlCode = MESH_COUSIN ,& + IOS = COMPONENT_OUTPUT ,& + ErrStat = ErrStat2 ,& + ErrMess = ErrMsg2 ,& + Force = .TRUE. ,& + Moment = .TRUE. ) + if(Failed()) return + BldStrLoadMesh_tmp(iWT)%Mesh(iBlade)%RemapFlag = .FALSE. + + ! For checking the mesh + ! Note: CU is is output unit (platform dependent). + if (DebugLevel >= 4) call MeshPrintInfo( CU, BldStrLoadMesh(iWT)%Mesh(iBlade), MeshName='BldStrLoadMesh'//trim(Num2LStr(iWT))//'_'//trim(Num2LStr(iBlade)) ) + + !------------------------------------------------------------- + ! Set the mapping meshes + ! blades + call MeshMapCreate( BldStrMotionMesh(iWT)%Mesh(iBlade), ADI%u(1)%AD%rotors(iWT)%BladeMotion(iBlade), Map_BldStrMotion_2_AD_Blade(iBlade, iWT), ErrStat2, ErrMsg2 ); if(Failed()) return + call MeshMapCreate( ADI%y%AD%rotors(iWT)%BladeLoad(iBlade), BldStrLoadMesh(iWT)%Mesh(iBlade), Map_AD_BldLoad_P_2_BldStrLoad(iBlade, iWT), ErrStat2, ErrMsg2 ); if(Failed()) return + enddo ! iBlade + enddo ! iWT + + end subroutine SetupMotionLoadsInterfaceMeshes !------------------------------------------------------------- @@ -913,29 +1002,44 @@ end subroutine SetMotionLoadsInterfaceMeshes !! If more than one input node was passed in, but only a single AD node !! exists, then give error that too many !! nodes passed. - subroutine CheckNodes(ErrStat3,ErrMsg3) - integer(IntKi), intent( out) :: ErrStat3 !< temporary error status - character(ErrMsgLen), intent( out) :: ErrMsg3 !< temporary error message - ErrStat3 = ErrID_None - ErrMsg3 = "" + subroutine CheckNodes(iWT) + integer(IntKi), intent(in ) :: iWT !< current rotor/turbine ! FIXME: this is a placeholder in case we think of some sanity checks to perform. ! - some check that nodes make some sense -- might be caught in meshmapping ! - some checks on hub/nacelle being near middle of the rotor? Not sure if that matters end subroutine CheckNodes -END SUBROUTINE AeroDyn_Inflow_C_Init + !> Setup points for disk average velocity calculations + subroutine SetDiskAvgPoints(iWT) + integer(IntKi), intent(in) :: iWT + integer(IntKi) :: i,BlNds + real(ReKi) :: R,theta,BLength + ! Calculate relative points on disk (do this once up front to save computational time). + ! NOTE: this is in the XY plane, and will be multiplied by the hub orientation vector + BlNds = ADI%p%AD%rotors(iWT)%NumBlNds + BLength = TwoNorm(ADI%u(1)%AD%rotors(iWT)%BladeMotion(1)%Position(:,BlNds) - ADI%u(1)%AD%rotors(iWT)%HubMotion%Position(:,1)) + R = real(BLength,ReKi) * 0.7_reKi !70% radius + do i=1,NumPtsDiskAvg + theta = pi +(i-1)*TwoPi/NumPtsDiskAvg + DiskAvgVelVars(iWT)%DiskWindPosRel(1,i) = 0.0_ReKi ! Hub X (perpindicular to rotor plane) + DiskAvgVelVars(iWT)%DiskWindPosRel(2,i) = R*cos(theta) ! Hub Y + DiskAvgVelVars(iWT)%DiskWindPosRel(3,i) = R*sin(theta) ! Hub Z (in vertical plane when azimuth=0) + end do + end subroutine SetDiskAvgPoints + +END SUBROUTINE ADI_C_Init !!=============================================================================================================== !!--------------------------------------------- AeroDyn ReInit--------------------------------------------------- !!=============================================================================================================== !!TODO: finish this routine so it is usable if we need re-init capability for coupling -!SUBROUTINE AeroDyn_Inflow_C_ReInit( DT_C, TMax_C, & -! ErrStat_C, ErrMsg_C) BIND (C, NAME='AeroDyn_Inflow_C_ReInit') +!SUBROUTINE ADI_C_ReInit( DT_C, TMax_C, & +! ErrStat_C, ErrMsg_C) BIND (C, NAME='ADI_C_ReInit') ! implicit none !#ifndef IMPLICIT_DLLEXPORT -!!DEC$ ATTRIBUTES DLLEXPORT :: AeroDyn_Inflow_C_ReInit -!!GCC$ ATTRIBUTES DLLEXPORT :: AeroDyn_Inflow_C_ReInit +!!DEC$ ATTRIBUTES DLLEXPORT :: ADI_C_ReInit +!!GCC$ ATTRIBUTES DLLEXPORT :: ADI_C_ReInit !#endif ! ! real(c_double), intent(in ) :: DT_C !< Timestep used with AD for stepping forward from t to t+dt. Must be constant. @@ -947,7 +1051,7 @@ END SUBROUTINE AeroDyn_Inflow_C_Init ! character(ErrMsgLen) :: ErrMsg !< aggregated error message ! integer(IntKi) :: ErrStat2 !< temporary error status from a call ! character(ErrMsgLen) :: ErrMsg2 !< temporary error message from a call -! character(*), parameter :: RoutineName = 'AeroDyn_Inflow_C_ReInit' !< for error handling +! character(*), parameter :: RoutineName = 'ADI_C_ReInit' !< for error handling ! ! ! Initialize error handling ! ErrStat = ErrID_None @@ -970,105 +1074,47 @@ END SUBROUTINE AeroDyn_Inflow_C_Init ! call SetErr(ErrStat,ErrMsg,ErrStat_C,ErrMsg_C) ! endif ! end function Failed -!END SUBROUTINE AeroDyn_Inflow_C_ReInit +!END SUBROUTINE ADI_C_ReInit !=============================================================================================================== !--------------------------------------------- AeroDyn CalcOutput --------------------------------------------- !=============================================================================================================== - -SUBROUTINE AeroDyn_Inflow_C_CalcOutput(Time_C, & - HubPos_C, HubOri_C, HubVel_C, HubAcc_C, & - NacPos_C, NacOri_C, NacVel_C, NacAcc_C, & - BldRootPos_C, BldRootOri_C, BldRootVel_C, BldRootAcc_C, & - NumMeshPts_C, & - MeshPos_C, MeshOri_C, MeshVel_C, MeshAcc_C, & - MeshFrc_C, OutputChannelValues_C, ErrStat_C, ErrMsg_C) BIND (C, NAME='AeroDyn_Inflow_C_CalcOutput') +!> This routine calculates the outputs at Time_C using the states and inputs provided. +!! NOTE: make sure to call ADI_C_SetRotorMotion before calling CalcOutput +SUBROUTINE ADI_C_CalcOutput(Time_C, & + OutputChannelValues_C, ErrStat_C, ErrMsg_C) BIND (C, NAME='ADI_C_CalcOutput') implicit none #ifndef IMPLICIT_DLLEXPORT -!DEC$ ATTRIBUTES DLLEXPORT :: AeroDyn_Inflow_C_CalcOutput -!GCC$ ATTRIBUTES DLLEXPORT :: AeroDyn_Inflow_C_CalcOutput +!DEC$ ATTRIBUTES DLLEXPORT :: ADI_C_CalcOutput +!GCC$ ATTRIBUTES DLLEXPORT :: ADI_C_CalcOutput #endif real(c_double), intent(in ) :: Time_C - real(c_float), intent(in ) :: HubPos_C( 3 ) !< Hub position - real(c_double), intent(in ) :: HubOri_C( 9 ) !< Hub orientation - real(c_float), intent(in ) :: HubVel_C( 6 ) !< Hub velocity - real(c_float), intent(in ) :: HubAcc_C( 6 ) !< Hub acceleration - real(c_float), intent(in ) :: NacPos_C( 3 ) !< Nacelle position - real(c_double), intent(in ) :: NacOri_C( 9 ) !< Nacelle orientation - real(c_float), intent(in ) :: NacVel_C( 6 ) !< Nacelle velocity - real(c_float), intent(in ) :: NacAcc_C( 6 ) !< Nacelle acceleration - real(c_float), intent(in ) :: BldRootPos_C( 3*Sim%WT(1)%NumBlades ) !< Blade root positions - real(c_double), intent(in ) :: BldRootOri_C( 9*Sim%WT(1)%NumBlades ) !< Blade root orientations - real(c_float), intent(in ) :: BldRootVel_C( 6*Sim%WT(1)%NumBlades ) !< Blade root velocities - real(c_float), intent(in ) :: BldRootAcc_C( 6*Sim%WT(1)%NumBlades ) !< Blade root accelerations - ! Blade mesh nodes - integer(c_int), intent(in ) :: NumMeshPts_C !< Number of mesh points we are transfering motions to and output loads to - real(c_float), intent(in ) :: MeshPos_C( 3*NumMeshPts_C ) !< A 3xNumMeshPts_C array [x,y,z] - real(c_double), intent(in ) :: MeshOri_C( 9*NumMeshPts_C ) !< A 9xNumMeshPts_C array [r11,r12,r13,r21,r22,r23,r31,r32,r33] - real(c_float), intent(in ) :: MeshVel_C( 6*NumMeshPts_C ) !< A 6xNumMeshPts_C array [x,y,z] - real(c_float), intent(in ) :: MeshAcc_C( 6*NumMeshPts_C ) !< A 6xNumMeshPts_C array [x,y,z] - real(c_float), intent( out) :: MeshFrc_C( 6*NumMeshPts_C ) !< A 6xNumMeshPts_C array [Fx,Fy,Fz,Mx,My,Mz] -- forces and moments (global) real(c_float), intent( out) :: OutputChannelValues_C(ADI%p%NumOuts) integer(c_int), intent( out) :: ErrStat_C character(kind=c_char), intent( out) :: ErrMsg_C(ErrMsgLen_C) ! Local variables real(DbKi) :: Time - integer(IntKi) :: iNode integer(IntKi) :: ErrStat !< aggregated error status character(ErrMsgLen) :: ErrMsg !< aggregated error message integer(IntKi) :: ErrStat2 !< temporary error status from a call character(ErrMsgLen) :: ErrMsg2 !< temporary error message from a call - character(*), parameter :: RoutineName = 'AeroDyn_Inflow_C_CalcOutput' !< for error handling + character(*), parameter :: RoutineName = 'ADI_C_CalcOutput' !< for error handling ! Initialize error handling ErrStat = ErrID_None ErrMsg = "" - ! Sanity check -- number of node points cannot change - if ( NumMeshPts /= int(NumMeshPts_C, IntKi) ) then - ErrStat2 = ErrID_Fatal - ErrMsg2 = "Number of node points passed in changed. This must be constant throughout simulation" - if (Failed()) return - endif - - ! Convert the inputs from C to Fortrn Time = REAL(Time_C,DbKi) - ! Reshape mesh position, orientation, velocity, acceleration - tmpBldPtMeshPos(1:3,1:NumMeshPts) = reshape( real(MeshPos_C(1:3*NumMeshPts),ReKi), (/3, NumMeshPts/) ) - tmpBldPtMeshOri(1:3,1:3,1:NumMeshPts) = reshape( real(MeshOri_C(1:9*NumMeshPts),R8Ki), (/3,3,NumMeshPts/) ) - tmpBldPtMeshVel(1:6,1:NumMeshPts) = reshape( real(MeshVel_C(1:6*NumMeshPts),ReKi), (/6, NumMeshPts/) ) - tmpBldPtMeshAcc(1:6,1:NumMeshPts) = reshape( real(MeshAcc_C(1:6*NumMeshPts),ReKi), (/6, NumMeshPts/) ) - - - ! Transfer motions to input meshes - call Set_MotionMesh( ErrStat2, ErrMsg2 ); if (Failed()) return - call AD_SetInputMotion( ADI%u(1), & - HubPos_C, HubOri_C, HubVel_C, HubAcc_C, & - NacPos_C, NacOri_C, NacVel_C, NacAcc_C, & - BldRootPos_C, BldRootOri_C, BldRootVel_C, BldRootAcc_C, & - ErrStat2, ErrMsg2 ) ! transfer input motion mesh to u(1) meshes - if (Failed()) return - - ! call IfW and set inputs for AD - call ADI_ADIW_Solve(Time, ADI%p, ADI%u(1)%AD, ADI%OtherState(STATE_CURR)%AD, ADI%m%IW%u, ADI%m%IW, .false., ErrStat2, ErrMsg2) - if (Failed()) return - ! Call the main subroutine ADI_CalcOutput to get the resulting forces and moments at time T - CALL ADI_CalcOutput( Time, ADI%u(1), ADI%p, ADI%x(STATE_CURR), ADI%xd(STATE_CURR), ADI%z(STATE_CURR), ADI%OtherState(STATE_CURR), ADI%y, ADI%m, ErrStat2, ErrMsg2 ) + call ADI_CopyInput (ADI_u, ADI%u(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) ! copy new inputs over if (Failed()) return - - ! Transfer resulting load meshes to intermediate mesh - call AD_TransferLoads( ADI%u(1), ADI%y, ErrStat2, ErrMsg2 ) + CALL ADI_CalcOutput( Time, ADI%u(1), ADI%p, ADI%x(STATE_CURR), ADI%xd(STATE_CURR), ADI%z(STATE_CURR), ADI%OtherState(STATE_CURR), ADI%y, ADI%m, ErrStat2, ErrMsg2 ) if (Failed()) return - ! Set output force/moment array - call Set_OutputLoadArray( ) - MeshFrc_C(1:6*NumMeshPts) = reshape( real(tmpBldPtMeshFrc(1:6,1:NumMeshPts), c_float), (/6*NumMeshPts/) ) - ! Get the output channel info out of y OutputChannelValues_C = REAL(ADI%y%WriteOutput, C_FLOAT) @@ -1076,7 +1122,16 @@ SUBROUTINE AeroDyn_Inflow_C_CalcOutput(Time_C, & ! write outputs !------------------------------------------------------- ! Write VTK if requested (animation=2) - if (WrOutputsData%WrVTK > 1_IntKi) call WrVTK_Meshes(ADI%u(1)%AD%rotors(:),(/0.0_SiKi,0.0_SiKi,0.0_SiKi/),ErrStat2,ErrMsg2) + if (WrOutputsData%WrVTK > 1_IntKi) then + ! Check if writing this step (note this may overwrite if we rerun a step in a correction loop) + if ( mod( n_Global, WrOutputsData%n_VTKTime ) == 0 ) THEN + ! increment the current VTK output number if not a correction step, otherwise overwrite previous + if (.not. EqualRealNos( real(Time,DbKi), InputTimePrev_Calc ) ) then + n_VTK = n_VTK + 1_IntKi ! Increment for this write + endif + call WrVTK_Meshes(ADI%u(1)%AD%rotors(:),(/0.0_SiKi,0.0_SiKi,0.0_SiKi/),ErrStat2,ErrMsg2) + endif + endif if (WrOutputsData%fileFmt > idFmtNone) then !FIXME: need some way to overwrite the correction timesteps (for text file)! @@ -1086,13 +1141,16 @@ SUBROUTINE AeroDyn_Inflow_C_CalcOutput(Time_C, & ! Set error status call SetErr(ErrStat,ErrMsg,ErrStat_C,ErrMsg_C) + ! Store info what time we just ran calcs for + InputTimePrev_Calc = Time + CONTAINS logical function Failed() CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) Failed = ErrStat >= AbortErrLev if (Failed) call SetErr(ErrStat,ErrMsg,ErrStat_C,ErrMsg_C) end function Failed -END SUBROUTINE AeroDyn_Inflow_C_CalcOutput +END SUBROUTINE ADI_C_CalcOutput !=============================================================================================================== !--------------------------------------------- AeroDyn UpdateStates ------------------------------------------- @@ -1102,62 +1160,32 @@ END SUBROUTINE AeroDyn_Inflow_C_CalcOutput !! Since we don't really know if we are doing correction steps or not, we will track the previous state and !! reset to those if we are repeating a timestep (normally this would be handled by the OF glue code, but since !! the states are not passed across the interface, we must handle them here). -SUBROUTINE AeroDyn_Inflow_C_UpdateStates( Time_C, TimeNext_C, & - HubPos_C, HubOri_C, HubVel_C, HubAcc_C, & - NacPos_C, NacOri_C, NacVel_C, NacAcc_C, & - BldRootPos_C, BldRootOri_C, BldRootVel_C, BldRootAcc_C, & - NumMeshPts_C, & - MeshPos_C, MeshOri_C, MeshVel_C, MeshAcc_C, & - ErrStat_C, ErrMsg_C) BIND (C, NAME='AeroDyn_Inflow_C_UpdateStates') +!! NOTE: make sure to call ADI_C_SetRotorMotion before calling UpdateStates +SUBROUTINE ADI_C_UpdateStates( Time_C, TimeNext_C, & + ErrStat_C, ErrMsg_C) BIND (C, NAME='ADI_C_UpdateStates') implicit none #ifndef IMPLICIT_DLLEXPORT -!DEC$ ATTRIBUTES DLLEXPORT :: AeroDyn_Inflow_C_UpdateStates -!GCC$ ATTRIBUTES DLLEXPORT :: AeroDyn_Inflow_C_UpdateStates +!DEC$ ATTRIBUTES DLLEXPORT :: ADI_C_UpdateStates +!GCC$ ATTRIBUTES DLLEXPORT :: ADI_C_UpdateStates #endif real(c_double), intent(in ) :: Time_C real(c_double), intent(in ) :: TimeNext_C - real(c_float), intent(in ) :: HubPos_C( 3 ) !< Hub position - real(c_double), intent(in ) :: HubOri_C( 9 ) !< Hub orientation - real(c_float), intent(in ) :: HubVel_C( 6 ) !< Hub velocity - real(c_float), intent(in ) :: HubAcc_C( 6 ) !< Hub acceleration - real(c_float), intent(in ) :: NacPos_C( 3 ) !< Nacelle position - real(c_double), intent(in ) :: NacOri_C( 9 ) !< Nacelle orientation - real(c_float), intent(in ) :: NacVel_C( 6 ) !< Nacelle velocity - real(c_float), intent(in ) :: NacAcc_C( 6 ) !< Nacelle acceleration - real(c_float), intent(in ) :: BldRootPos_C( 3*Sim%WT(1)%NumBlades ) !< Blade root positions - real(c_double), intent(in ) :: BldRootOri_C( 9*Sim%WT(1)%NumBlades ) !< Blade root orientations - real(c_float), intent(in ) :: BldRootVel_C( 6*Sim%WT(1)%NumBlades ) !< Blade root velocities - real(c_float), intent(in ) :: BldRootAcc_C( 6*Sim%WT(1)%NumBlades ) !< Blade root accelerations - ! Blade mesh nodes - integer(c_int), intent(in ) :: NumMeshPts_C !< Number of mesh points we are transfering motions to and output loads to - real(c_float), intent(in ) :: MeshPos_C( 3*NumMeshPts_C ) !< A 3xNumMeshPts_C array [x,y,z] - real(c_double), intent(in ) :: MeshOri_C( 9*NumMeshPts_C ) !< A 9xNumMeshPts_C array [r11,r12,r13,r21,r22,r23,r31,r32,r33] - real(c_float), intent(in ) :: MeshVel_C( 6*NumMeshPts_C ) !< A 6xNumMeshPts_C array [x,y,z] - real(c_float), intent(in ) :: MeshAcc_C( 6*NumMeshPts_C ) !< A 6xNumMeshPts_C array [x,y,z] integer(c_int), intent( out) :: ErrStat_C character(kind=c_char), intent( out) :: ErrMsg_C(ErrMsgLen_C) ! Local variables logical :: CorrectionStep ! if we are repeating a timestep in UpdateStates, don't update the inputs array - integer(IntKi) :: iNode integer(IntKi) :: ErrStat !< aggregated error status character(ErrMsgLen) :: ErrMsg !< aggregated error message integer(IntKi) :: ErrStat2 !< temporary error status from a call character(ErrMsgLen) :: ErrMsg2 !< temporary error message from a call - character(*), parameter :: RoutineName = 'AeroDyn_Inflow_C_UpdateStates' !< for error handling + character(*), parameter :: RoutineName = 'ADI_C_UpdateStates' !< for error handling ! Initialize error handling ErrStat = ErrID_None ErrMsg = "" CorrectionStep = .false. - ! Sanity check -- number of node points cannot change - if ( NumMeshPts /= int(NumMeshPts_C, IntKi) ) then - ErrStat2 = ErrID_Fatal - ErrMsg2 = "Number of node points passed in changed. This must be constant throughout simulation" - if (Failed()) return - endif - !------------------------------------------------------- ! Check the time for current timestep and next timestep @@ -1210,24 +1238,6 @@ SUBROUTINE AeroDyn_Inflow_C_UpdateStates( Time_C, TimeNext_C, & call ADI_CopyInput( ADI%u(INPUT_PRED), ADI%u(INPUT_CURR), MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return endif - !------------------------------------------------------- - ! Set inputs for time T+dt -- u(INPUT_PRED) - !------------------------------------------------------- - ! Reshape mesh position, orientation, velocity, acceleration - tmpBldPtMeshPos(1:3,1:NumMeshPts) = reshape( real(MeshPos_C(1:3*NumMeshPts),ReKi), (/3, NumMeshPts/) ) - tmpBldPtMeshOri(1:3,1:3,1:NumMeshPts) = reshape( real(MeshOri_C(1:9*NumMeshPts),R8Ki), (/3,3,NumMeshPts/) ) - tmpBldPtMeshVel(1:6,1:NumMeshPts) = reshape( real(MeshVel_C(1:6*NumMeshPts),ReKi), (/6, NumMeshPts/) ) - tmpBldPtMeshAcc(1:6,1:NumMeshPts) = reshape( real(MeshAcc_C(1:6*NumMeshPts),ReKi), (/6, NumMeshPts/) ) - - ! Transfer motions to input meshes - call Set_MotionMesh( ErrStat2, ErrMsg2 ); if (Failed()) return - call AD_SetInputMotion( ADI%u(INPUT_PRED), & - HubPos_C, HubOri_C, HubVel_C, HubAcc_C, & - NacPos_C, NacOri_C, NacVel_C, NacAcc_C, & - BldRootPos_C, BldRootOri_C, BldRootVel_C, BldRootAcc_C, & - ErrStat2, ErrMsg2 ) ! transfer input motion mesh to u(1) meshes - if (Failed()) return - ! Set copy the current state over to the predicted state for sending to UpdateStates ! -- The STATE_PREDicted will get updated in the call. @@ -1238,6 +1248,11 @@ SUBROUTINE AeroDyn_Inflow_C_UpdateStates( Time_C, TimeNext_C, & CALL ADI_CopyOtherState (ADI%OtherState(STATE_CURR), ADI%OtherState(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return + ! Copy newinputs for time u(INPUT_PRED) + call ADI_CopyInput (ADI_u, ADI%u(INPUT_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + if (Failed()) return + + ! Call the main subroutine ADI_UpdateStates to get the velocities CALL ADI_UpdateStates( ADI%InputTimes(INPUT_CURR), n_Global, ADI%u, ADI%InputTimes, ADI%p, ADI%x(STATE_PRED), ADI%xd(STATE_PRED), ADI%z(STATE_PRED), ADI%OtherState(STATE_PRED), ADI%m, ErrStat2, ErrMsg2 ) if (Failed()) return @@ -1269,18 +1284,18 @@ logical function Failed() Failed = ErrStat >= AbortErrLev if (Failed) call SetErr(ErrStat,ErrMsg,ErrStat_C,ErrMsg_C) end function Failed -END SUBROUTINE AeroDyn_Inflow_C_UpdateStates +END SUBROUTINE ADI_C_UpdateStates !=============================================================================================================== !--------------------------------------------------- AeroDyn End----------------------------------------------- !=============================================================================================================== ! NOTE: the error handling in this routine is slightly different than the other routines -SUBROUTINE AeroDyn_Inflow_C_End(ErrStat_C,ErrMsg_C) BIND (C, NAME='AeroDyn_Inflow_C_End') +SUBROUTINE ADI_C_End(ErrStat_C,ErrMsg_C) BIND (C, NAME='ADI_C_End') implicit none #ifndef IMPLICIT_DLLEXPORT -!DEC$ ATTRIBUTES DLLEXPORT :: AeroDyn_Inflow_C_End -!GCC$ ATTRIBUTES DLLEXPORT :: AeroDyn_Inflow_C_End +!DEC$ ATTRIBUTES DLLEXPORT :: ADI_C_End +!GCC$ ATTRIBUTES DLLEXPORT :: ADI_C_End #endif integer(c_int), intent( out) :: ErrStat_C character(kind=c_char), intent( out) :: ErrMsg_C(ErrMsgLen_C) @@ -1293,7 +1308,7 @@ SUBROUTINE AeroDyn_Inflow_C_End(ErrStat_C,ErrMsg_C) BIND (C, NAME='AeroDyn_Inflo character(ErrMsgLen) :: ErrMsg !< aggregated error message integer :: ErrStat2 !< temporary error status from a call character(ErrMsgLen) :: ErrMsg2 !< temporary error message from a call - character(*), parameter :: RoutineName = 'AeroDyn_Inflow_C_End' !< for error handling + character(*), parameter :: RoutineName = 'ADI_C_End' !< for error handling ! Initialize error handling ErrStat = ErrID_None @@ -1314,19 +1329,12 @@ SUBROUTINE AeroDyn_Inflow_C_End(ErrStat_C,ErrMsg_C) BIND (C, NAME='AeroDyn_Inflo else sWT = '' endif - call WrBinFAST(trim(WrOutputsData%Root)//trim(sWT)//'.outb', FileFmtID_ChanLen_In, 'AeroDyn_Inflow_C_Library', WrOutputsData%WriteOutputHdr, WrOutputsData%WriteOutputUnt, (/0.0_DbKi, Sim%dT/), WrOutputsData%storage(:,:,iWT), errStat2, errMsg2) + call WrBinFAST(trim(WrOutputsData%Root)//trim(sWT)//'.outb', FileFmtID_ChanLen_In, 'ADI_C_Library', WrOutputsData%WriteOutputHdr, WrOutputsData%WriteOutputUnt, (/0.0_DbKi, Sim%dT/), WrOutputsData%storage(:,:,iWT), errStat2, errMsg2) call SetErrStat(errStat2, errMsg2, errStat, errMsg, RoutineName) enddo endif end if - ! clear out any globably allocated helper arrays - if (allocated(tmpBldPtMeshPos)) deallocate(tmpBldPtMeshPos) - if (allocated(tmpBldPtMeshOri)) deallocate(tmpBldPtMeshOri) - if (allocated(tmpBldPtMeshVel)) deallocate(tmpBldPtMeshVel) - if (allocated(tmpBldPtMeshAcc)) deallocate(tmpBldPtMeshAcc) - if (allocated(tmpBldPtMeshFrc)) deallocate(tmpBldPtMeshFrc) - ! Call the main subroutine ADI_End ! If u is not allocated, then we didn't get far at all in initialization, @@ -1367,75 +1375,730 @@ SUBROUTINE AeroDyn_Inflow_C_End(ErrStat_C,ErrMsg_C) BIND (C, NAME='AeroDyn_Inflo !if (allocated(InputTimes)) deallocate(InputTimes) ! Clear out mesh related data storage - call ClearMesh() + call ClearTmpStorage() + + call SetErr(ErrStat,ErrMsg,ErrStat_C,ErrMsg_C) +END SUBROUTINE ADI_C_End + + +!=============================================================================================================== +!--------------------------------------------- AeroDyn SetupRotor ---------------------------------------------- +!=============================================================================================================== +!> Setup the initial rotor root positions etc before initializing +subroutine ADI_C_SetupRotor(iWT_c, TurbineIsHAWT_c, TurbOrigin_C, & + HubPos_C, HubOri_C, & + NacPos_C, NacOri_C, & + NumBlades_C, BldRootPos_C, BldRootOri_C, & + NumMeshPts_C, InitMeshPos_C, InitMeshOri_C, & + MeshPtToBladeNum_C, ErrStat_C, ErrMsg_C) BIND (C, NAME='ADI_C_SetupRotor') + implicit none +#ifndef IMPLICIT_DLLEXPORT +!DEC$ ATTRIBUTES DLLEXPORT :: ADI_C_SetupRotor +!GCC$ ATTRIBUTES DLLEXPORT :: ADI_C_SetupRotor +#endif + integer(c_int), intent(in ) :: iWT_c !< Wind turbine / rotor number + integer(c_int), intent(in ) :: TurbineIsHAWT_c !< true for HAWT, false for VAWT + real(c_float), intent(in ) :: TurbOrigin_C(3) !< turbine origin (tower base). Gets added to all meshes to shift turbine position. + ! Initial hub and blade root positions/orientations + real(c_float), intent(in ) :: HubPos_C( 3 ) !< Hub position + real(c_double), intent(in ) :: HubOri_C( 9 ) !< Hub orientation + real(c_float), intent(in ) :: NacPos_C( 3 ) !< Nacelle position + real(c_double), intent(in ) :: NacOri_C( 9 ) !< Nacelle orientation + integer(c_int), intent(in ) :: NumBlades_C !< Number of blades + real(c_float), intent(in ) :: BldRootPos_C( 3*NumBlades_C ) !< Blade root positions + real(c_double), intent(in ) :: BldRootOri_C( 9*NumBlades_C ) !< Blade root orientations + ! Initial nodes + integer(c_int), intent(in ) :: NumMeshPts_C !< Number of mesh points we are transferring motions and outputting loads to + real(c_float), intent(in ) :: InitMeshPos_C( 3*NumMeshPts_C ) !< A 3xNumMeshPts_C array [x,y,z] + real(c_double), intent(in ) :: InitMeshOri_C( 9*NumMeshPts_C ) !< A 9xNumMeshPts_C array [r11,r12,r13,r21,r22,r23,r31,r32,r33] + integer(c_int), intent(in ) :: MeshPtToBladeNum_C( NumMeshPts_C ) !< A NumMeshPts_C array of blade numbers associated with each mesh point + integer(c_int), intent( out) :: ErrStat_C !< Error status + character(kind=c_char), intent( out) :: ErrMsg_C(ErrMsgLen_C) !< Error message (C_NULL_CHAR terminated) + + ! Local variables + integer(IntKi) :: iWT !< current turbine + integer(IntKi) :: iBlade !< current blade + logical :: TurbineIsHAWT !< true for HAWT, false for VAWT + integer(IntKi) :: ErrStat !< aggregated error messagNumBlades_ee + character(ErrMsgLen) :: ErrMsg !< aggregated error message + integer(IntKi) :: ErrStat2 !< temporary error status from a call + character(ErrMsgLen) :: ErrMsg2 !< temporary error message from a call + integer(IntKi) :: i,j,k !< generic index variables + character(*), parameter :: RoutineName = 'ADI_C_Init' !< for error handling + + ! Initialize error handling + ErrStat = ErrID_None + ErrMsg = "" + + + ! For debugging the interface: + if (DebugLevel > 0) then + call ShowPassedData() + endif + + ! turbine geometry + iWT = int(iWT_c, IntKi) + Sim%WT(iWT)%NumBlades = int(NumBlades_C, IntKi) + Sim%WT(iWT)%OriginInit(1:3) = real(TurbOrigin_C(1:3), ReKi) + + ! Aero calculation method -- AeroProjMod + ! APM_BEM_NoSweepPitchTwist - 1 - "Original AeroDyn model where momentum balance is done in the WithoutSweepPitchTwist system" + ! APM_BEM_Polar - 2 - "Use staggered polar grid for momentum balance in each annulus" + ! APM_LiftingLine - 3 - "Use the blade lifting line (i.e. the structural) orientation (currently for OLAF with VAWT)" + ! For now we will set (this may need to be changed later): + ! HAWT --> AeroProjMod = 1 + ! VAWT --> AeroProjMod = 3 + TurbineIsHAWT = TurbineIsHAWT_c==1_c_int + if (TurbineIsHAWT) then + InitInp%AD%rotors(iWT)%AeroProjMod = 1 + else + InitInp%AD%rotors(iWT)%AeroProjMod = 3 + endif + + + call AllocAry(InitInp%AD%rotors(iWT)%BladeRootPosition, 3, Sim%WT(iWT)%NumBlades, 'BldRootPos', errStat2, errMsg2 ); if (Failed()) return + call AllocAry(InitInp%AD%rotors(iWT)%BladeRootOrientation, 3, 3, Sim%WT(iWT)%NumBlades, 'BldRootOri', errStat2, errMsg2 ); if (Failed()) return + InitInp%AD%rotors(iWT)%originInit = Sim%WT(iWT)%OriginInit(1:3) + InitInp%AD%rotors(iWT)%HubPosition = real(HubPos_C(1:3),ReKi) + Sim%WT(iWT)%OriginInit(1:3) + InitInp%AD%rotors(iWT)%HubOrientation = reshape( real(HubOri_C(1:9),R8Ki), (/3,3/) ) + InitInp%AD%rotors(iWT)%NacellePosition = real(NacPos_C(1:3),ReKi) + Sim%WT(iWT)%OriginInit(1:3) + InitInp%AD%rotors(iWT)%NacelleOrientation = reshape( real(NacOri_C(1:9),R8Ki), (/3,3/) ) + InitInp%AD%rotors(iWT)%BladeRootPosition = reshape( real(BldRootPos_C(1:3*Sim%WT(iWT)%NumBlades),ReKi), (/ 3,Sim%WT(iWT)%NumBlades/) ) + InitInp%AD%rotors(iWT)%BladeRootOrientation = reshape( real(BldRootOri_C(1:9*Sim%WT(iWT)%NumBlades),R8Ki), (/3,3,Sim%WT(iWT)%NumBlades/) ) + do i=1,Sim%WT(iWT)%NumBlades + InitInp%AD%rotors(iWT)%BladeRootPosition(1:3,i) = InitInp%AD%rotors(iWT)%BladeRootPosition(1:3,i) + Sim%WT(iWT)%OriginInit(1:3) + enddo + if (TransposeDCM) then + InitInp%AD%rotors(iWT)%HubOrientation = transpose(InitInp%AD%rotors(iWT)%HubOrientation) + InitInp%AD%rotors(iWT)%NacelleOrientation = transpose(InitInp%AD%rotors(iWT)%NacelleOrientation) + do i=1,Sim%WT(iWT)%NumBlades + InitInp%AD%rotors(iWT)%BladeRootOrientation(1:3,1:3,i) = transpose(InitInp%AD%rotors(iWT)%BladeRootOrientation(1:3,1:3,i)) + enddo + endif + + ! Remap the orientation DCM just in case there is some issue with passed + call OrientRemap(InitInp%AD%rotors(iWT)%HubOrientation) + call OrientRemap(InitInp%AD%rotors(iWT)%NacelleOrientation) + do i=1,Sim%WT(iWT)%NumBlades + call OrientRemap(InitInp%AD%rotors(iWT)%BladeRootOrientation(1:3,1:3,i)) + enddo + + ! Number of blades and initial positions + ! - NumMeshPts is the number of interface Mesh points we are expecting on the python + ! side. Will validate this against what AD reads from the initialization info. + NumMeshPts(iWT) = int(NumMeshPts_C, IntKi) + if (NumMeshPts(iWT) < 1) then + ErrStat2 = ErrID_Fatal + ErrMsg2 = "At least one node point must be specified" + if (Failed()) return + endif + + call SetupMotionMesh() + + ! Set error status + call SetErr(ErrStat,ErrMsg,ErrStat_C,ErrMsg_C) + +contains + logical function Failed() + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + Failed = ErrStat >= AbortErrLev + if (Failed) then + call ClearTmpStorage() + call SetErr(ErrStat,ErrMsg,ErrStat_C,ErrMsg_C) + endif + end function Failed + + ! check for failed where /= 0 is fatal + logical function Failed0(txt) + character(*), intent(in) :: txt + if (errStat /= 0) then + ErrStat2 = ErrID_Fatal + ErrMsg2 = "Could not allocate "//trim(txt) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + endif + Failed0 = ErrStat >= AbortErrLev + if(Failed0) call ClearTmpStorage() + end function Failed0 + + !> This subroutine prints out all the variables that are passed in. Use this only + !! for debugging the interface on the Fortran side. + subroutine ShowPassedData() + character(1) :: TmpFlag + integer :: i,j + call WrSCr("") + call WrScr("-----------------------------------------------------------") + call WrScr("Interface debugging: Variables passed in through interface") + call WrScr(" ADI_C_SetupRotor -- rotor "//trim(Num2LStr(iWT_c))) + call WrScr(" --------------------------------------------------------") + call WrScr(" Turbine origin") + call WrMatrix(TurbOrigin_C,CU,'(3(ES15.7e2))') + call WrScr(" Init rotor positions/orientations (positions do not include Turbine origin offset)") + call WrNR(" Hub Position ") + call WrMatrix(HubPos_C,CU,'(3(ES15.7e2))') + call WrNR(" Hub Orientation ") + call WrMatrix(HubOri_C,CU,'(9(ES23.15e2))') + call WrNR(" Nacelle Position ") + call WrMatrix(NacPos_C,CU,'(3(ES15.7e2))') + call WrNR(" Nacelle Orientation ") + call WrMatrix(NacOri_C,CU,'(9(ES23.15e2))') + call WrScr(" NumBlades_C "//trim(Num2LStr(NumBlades_C)) ) + if (DebugLevel > 1) then + call WrScr(" Root Positions") + do i=1,NumBlades_C + j=3*(i-1) + call WrMatrix(BldRootPos_C(j+1:j+3),CU,'(3(ES15.7e2))') + enddo + call WrScr(" Root Orientations") + do i=1,NumBlades_C + j=9*(i-1) + call WrMatrix(BldRootOri_C(j+1:j+9),CU,'(9(ES23.15e2))') + enddo + endif + call WrScr(" NumMeshPts_C "//trim(Num2LStr( NumMeshPts_C )) ) + if (DebugLevel > 1) then + call WrScr(" Mesh Positions") + do i=1,NumMeshPts_C + j=3*(i-1) + call WrMatrix(InitMeshPos_C(j+1:j+3),CU,'(3(ES15.7e2))') + enddo + call WrScr(" Mesh Orientations") + do i=1,NumMeshPts_C + j=9*(i-1) + call WrMatrix(InitMeshOri_C(j+1:j+9),CU,'(9(ES23.15e2))') + enddo + endif + call WrScr("-----------------------------------------------------------") + end subroutine ShowPassedData + + subroutine SetupMotionMesh() + real(ReKi) :: InitPos(3) + real(R8Ki) :: Orient(3,3) + integer(IntKi) :: count + + !------------------------------------------------------------- + ! Allocate and define the components of StrucPts_2_Bld_Map + !------------------------------------------------------------- + StrucPts_2_Bld_Map(iWT)%NumBlades = Sim%WT(iWT)%NumBlades + + call AllocAry(StrucPts_2_Bld_Map(iWT)%NumMeshPtsPerBlade, Sim%WT(iWT)%NumBlades, "NumMeshPtsPerBlade", ErrStat2, ErrMsg2 ); if (Failed()) return + call AllocAry( StrucPts_2_Bld_Map(iWT)%MeshPt_2_BladeNum, NumMeshPts(iWT), "MeshPt_2_BladeNum", ErrStat2, ErrMsg2 ); if (Failed()) return + + allocate(StrucPts_2_Bld_Map(iWT)%BladeNode_2_MeshPt( Sim%WT(iWT)%NumBlades ), STAT=ErrStat2); if (Failed0('StrucPts_2_Bld_Map(iWT)%BladeNode_2_MeshPt' )) return + + ! Calculate the number of mesh points per blade + do i=1,Sim%WT(iWT)%NumBlades + count = 0 + do j=1,NumMeshPts(iWT) + if (MeshPtToBladeNum_C(j) == i) then + count = count + 1 + endif + enddo + StrucPts_2_Bld_Map(iWT)%NumMeshPtsPerBlade(i) = count + enddo + + StrucPts_2_Bld_Map(iWT)%MeshPt_2_BladeNum(1:NumMeshPts(iWT)) = MeshPtToBladeNum_C(1:NumMeshPts(iWT)) + + ! Allocate remaining components of StrucPts_2_Bld_Map based on the number of mesh points per blade + do i=1,Sim%WT(iWT)%NumBlades + call AllocAry(StrucPts_2_Bld_Map(iWT)%BladeNode_2_MeshPt(i)%BladeNodeToMeshPoint, StrucPts_2_Bld_Map(iWT)%NumMeshPtsPerBlade(i), "BladeNodeToMeshPoint", ErrStat2, ErrMsg2); if (Failed()) return + enddo + + do i=1,Sim%WT(iWT)%NumBlades + count = 0 + do j=1,NumMeshPts(iWT) + if (MeshPtToBladeNum_C(j) == i) then + count = count + 1 + StrucPts_2_Bld_Map(iWT)%BladeNode_2_MeshPt(i)%BladeNodeToMeshPoint(count) = j + endif + enddo + enddo + + ! Allocate and define the components of BladeStrMeshCoords + allocate(StrucPts_2_Bld_Map(iWT)%BladeStrMeshCoords(Sim%WT(iWT)%NumBlades), STAT=ErrStat2); if (Failed0('StrucPts_2_Bld_Map(iWT)%BladeStrMeshCoords')) return + do i=1,Sim%WT(iWT)%NumBlades + call AllocAry(StrucPts_2_Bld_Map(iWT)%BladeStrMeshCoords(i)%Position, 3, StrucPts_2_Bld_Map(iWT)%NumMeshPtsPerBlade(i), "BladeStrMeshCoords(i)%Position", ErrStat2, ErrMsg2 ); if (Failed()) return + call AllocAry(StrucPts_2_Bld_Map(iWT)%BladeStrMeshCoords(i)%Orient, 3, 3, StrucPts_2_Bld_Map(iWT)%NumMeshPtsPerBlade(i), "BladeStrMeshCoords(i)%Orient", ErrStat2, ErrMsg2 ); if (Failed()) return + call AllocAry(StrucPts_2_Bld_Map(iWT)%BladeStrMeshCoords(i)%Velocity, 6, StrucPts_2_Bld_Map(iWT)%NumMeshPtsPerBlade(i), "BladeStrMeshCoords(i)%Velocity", ErrStat2, ErrMsg2 ); if (Failed()) return + call AllocAry(StrucPts_2_Bld_Map(iWT)%BladeStrMeshCoords(i)%Accln, 6, StrucPts_2_Bld_Map(iWT)%NumMeshPtsPerBlade(i), "BladeStrMeshCoords(i)%Accln", ErrStat2, ErrMsg2 ); if (Failed()) return + call AllocAry(StrucPts_2_Bld_Map(iWT)%BladeStrMeshCoords(i)%Force, 6, StrucPts_2_Bld_Map(iWT)%NumMeshPtsPerBlade(i), "BladeStrMeshCoords(i)%Force", ErrStat2, ErrMsg2 ); if (Failed()) return + enddo + + do i=1,Sim%WT(iWT)%NumBlades + do j=1,StrucPts_2_Bld_Map(iWT)%NumMeshPtsPerBlade(i) + StrucPts_2_Bld_Map(iWT)%BladeStrMeshCoords(i)%Position(1:3,j) = reshape( real(InitMeshPos_C(3 * StrucPts_2_Bld_Map(iWT)%BladeNode_2_MeshPt(i)%BladeNodeToMeshPoint(j) - 2 : 3 * StrucPts_2_Bld_Map(iWT)%BladeNode_2_MeshPt(i)%BladeNodeToMeshPoint(j)),ReKi), (/3/) ) + StrucPts_2_Bld_Map(iWT)%BladeStrMeshCoords(i)%Orient(1:3,1:3,j) = reshape( real(InitMeshOri_C(9 * StrucPts_2_Bld_Map(iWT)%BladeNode_2_MeshPt(i)%BladeNodeToMeshPoint(j) - 8 : 9 * StrucPts_2_Bld_Map(iWT)%BladeNode_2_MeshPt(i)%BladeNodeToMeshPoint(j)),R8Ki), (/3,3/) ) + enddo + enddo + + ! Allocate the meshes + allocate(BldStrMotionMesh(iWT)%Mesh( Sim%WT(iWT)%NumBlades ), STAT=ErrStat2); if (Failed0('BldStrMotionMesh( iWT )%Mesh' )) return + allocate(BldStrLoadMesh(iWT)%Mesh( Sim%WT(iWT)%NumBlades ), STAT=ErrStat2); if (Failed0('BldStrLoadMesh( iWT )%Mesh' )) return + allocate(BldStrLoadMesh_tmp(iWT)%Mesh( Sim%WT(iWT)%NumBlades ), STAT=ErrStat2); if (Failed0('BldStrLoadMesh_tmp( iWT )%Mesh' )) return + + !------------------------------------------------------------- + ! Set the interface meshes for motion inputs and loads output + !------------------------------------------------------------- + ! Motion mesh for blades + do iBlade=1,Sim%WT(iWT)%NumBlades + call MeshCreate( BldStrMotionMesh(iWT)%Mesh(iBlade) , & + IOS = COMPONENT_INPUT , & + Nnodes = StrucPts_2_Bld_Map(iWT)%NumMeshPtsPerBlade(iBlade) , & + ErrStat = ErrStat2 , & + ErrMess = ErrMsg2 , & + TranslationDisp = .TRUE., Orientation = .TRUE. , & + TranslationVel = .TRUE., RotationVel = .TRUE. , & + TranslationAcc = .TRUE., RotationAcc = .FALSE. ) + if(Failed()) return + enddo + + do iBlade=1,Sim%WT(iWT)%NumBlades + do j=1,StrucPts_2_Bld_Map(iWT)%NumMeshPtsPerBlade(iBlade) + ! Initial position and orientation of node + InitPos = StrucPts_2_Bld_Map(iWT)%BladeStrMeshCoords(iBlade)%Position(1:3,j) + Sim%WT(iWT)%OriginInit(1:3) + if (TransposeDCM) then + Orient = transpose(StrucPts_2_Bld_Map(iWT)%BladeStrMeshCoords(iBlade)%Orient(1:3,1:3,j)) + else + Orient = StrucPts_2_Bld_Map(iWT)%BladeStrMeshCoords(iBlade)%Orient(1:3,1:3,j) + endif + call OrientRemap(Orient) + call MeshPositionNode( BldStrMotionMesh(iWT)%Mesh(iBlade) , & + j , & + InitPos , & ! position + ErrStat2, ErrMsg2 , & + Orient ) ! orientation + if(Failed()) return + + ! Create point or line element based on flag + if (PointLoadOutput) then + call MeshConstructElement ( BldStrMotionMesh(iWT)%Mesh(iBlade), ELEMENT_POINT, ErrStat2, ErrMsg2, j ); if(Failed()) return + else if (j > 1) then + ! This assumes that the first point is the root + call MeshConstructElement ( BldStrMotionMesh(iWT)%Mesh(iBlade), ELEMENT_LINE2, ErrStat2, ErrMsg2, j-1, j ); if(Failed()) return + end if + enddo + enddo + + do iBlade=1,Sim%WT(iWT)%NumBlades + call MeshCommit ( BldStrMotionMesh(iWT)%Mesh(iBlade), ErrStat2, ErrMsg2 ); if(Failed()) return + BldStrMotionMesh(iWT)%Mesh(iBlade)%RemapFlag = .FALSE. + + ! For checking the mesh + ! Note: CU is is output unit (platform dependent) + if (DebugLevel >= 4) call MeshPrintInfo( CU, BldStrMotionMesh(iWT)%Mesh(iBlade), MeshName='BldStrMotionMesh'//trim(Num2LStr(iWT))//'_'//trim(Num2LStr(iBlade)) ) + enddo + +! !------------------------------------------------------------- +! ! Motion mesh for nacelle -- TODO: add this mesh for nacelle load transfers +! call MeshCreate( NacMotionMesh(iWT) , & +! IOS = COMPONENT_INPUT , & +! Nnodes = 1 , & +! ErrStat = ErrStat2 , & +! ErrMess = ErrMsg2 , & +! TranslationDisp = .TRUE., Orientation = .TRUE., & +! TranslationVel = .TRUE., RotationVel = .TRUE., & +! TranslationAcc = .TRUE., RotationAcc = .FALSE. ) +! if(Failed()) return +! +! InitPos = real(NacPos_C( 1:3),ReKi) + Sim%WT(iWT)%OriginInit(1:3) +! Orient = reshape( real(NacOri_C(1:9),ReKi), (/3,3/) ) +! call OrientRemap(Orient) +! call MeshPositionNode( NacMotionMesh(iWT) , & +! 1 , & +! InitPos , & ! position +! ErrStat2, ErrMsg2 , & +! Orient ) ! orientation +! if(Failed()) return +! +! call MeshConstructElement ( NacMotionMesh(iWT), ELEMENT_POINT, ErrStat2, ErrMsg2, p1=1 ); if(Failed()) return +! +! call MeshCommit ( NacMotionMesh(iWT), ErrStat2, ErrMsg2 ); if(Failed()) return +! NacMotionMesh(iWT)%RemapFlag = .FALSE. +! +! ! For checking the mesh, uncomment this. +! ! note: CU is is output unit (platform dependent). +! if (DebugLevel >= 4) call MeshPrintInfo( CU, NacMotionMesh(iWT), MeshName='NacMotionMesh'//trim(Num2LStr(iWT)) ) + + end subroutine SetupMotionMesh +end subroutine ADI_C_SetupRotor + +!=============================================================================================================== +!--------------------------------------------- AeroDyn SetRotorMotion ------------------------------------------ +!=============================================================================================================== +!> Set the motions for a single rotor. This must be called before ADI_C_CalcOutput +subroutine ADI_C_SetRotorMotion( iWT_c, & + HubPos_C, HubOri_C, HubVel_C, HubAcc_C, & + NacPos_C, NacOri_C, NacVel_C, NacAcc_C, & + BldRootPos_C, BldRootOri_C, BldRootVel_C, BldRootAcc_C, & + NumMeshPts_C, & + MeshPos_C, MeshOri_C, MeshVel_C, MeshAcc_C, & + ErrStat_C, ErrMsg_C) BIND (C, NAME='ADI_C_SetRotorMotion') + implicit none +#ifndef IMPLICIT_DLLEXPORT +!DEC$ ATTRIBUTES DLLEXPORT :: ADI_C_SetRotorMotion +!GCC$ ATTRIBUTES DLLEXPORT :: ADI_C_SetRotorMotion +#endif + integer(c_int), intent(in ) :: iWT_c !< Wind turbine / rotor number + real(c_float), intent(in ) :: HubPos_C( 3 ) !< Hub position + real(c_double), intent(in ) :: HubOri_C( 9 ) !< Hub orientation + real(c_float), intent(in ) :: HubVel_C( 6 ) !< Hub velocity + real(c_float), intent(in ) :: HubAcc_C( 6 ) !< Hub acceleration + real(c_float), intent(in ) :: NacPos_C( 3 ) !< Nacelle position + real(c_double), intent(in ) :: NacOri_C( 9 ) !< Nacelle orientation + real(c_float), intent(in ) :: NacVel_C( 6 ) !< Nacelle velocity + real(c_float), intent(in ) :: NacAcc_C( 6 ) !< Nacelle acceleration + real(c_float), intent(in ) :: BldRootPos_C( 3*Sim%WT(iWT_c)%NumBlades ) !< Blade root positions + real(c_double), intent(in ) :: BldRootOri_C( 9*Sim%WT(iWT_c)%NumBlades ) !< Blade root orientations + real(c_float), intent(in ) :: BldRootVel_C( 6*Sim%WT(iWT_c)%NumBlades ) !< Blade root velocities + real(c_float), intent(in ) :: BldRootAcc_C( 6*Sim%WT(iWT_c)%NumBlades ) !< Blade root accelerations + ! Blade mesh nodes + integer(c_int), intent(in ) :: NumMeshPts_C !< Number of mesh points we are transfering motions to and output loads to + real(c_float), intent(in ) :: MeshPos_C( 3*NumMeshPts_C ) !< A 3xNumMeshPts_C array [x,y,z] + real(c_double), intent(in ) :: MeshOri_C( 9*NumMeshPts_C ) !< A 9xNumMeshPts_C array [r11,r12,r13,r21,r22,r23,r31,r32,r33] + real(c_float), intent(in ) :: MeshVel_C( 6*NumMeshPts_C ) !< A 6xNumMeshPts_C array [x,y,z] + real(c_float), intent(in ) :: MeshAcc_C( 6*NumMeshPts_C ) !< A 6xNumMeshPts_C array [x,y,z] + integer(c_int), intent( out) :: ErrStat_C + character(kind=c_char), intent( out) :: ErrMsg_C(ErrMsgLen_C) + + ! Local variables + real(DbKi) :: Time + integer(IntKi) :: iWT !< current wind turbine / rotor + integer(IntKi) :: i,j !< generic index variables + integer(IntKi) :: ErrStat !< aggregated error status + character(ErrMsgLen) :: ErrMsg !< aggregated error message + integer(IntKi) :: ErrStat2 !< temporary error status from a call + character(ErrMsgLen) :: ErrMsg2 !< temporary error message from a call + character(*), parameter :: RoutineName = 'ADI_C_SetRotorMotion' !< for error handling + + ! Initialize error handling + ErrStat = ErrID_None + ErrMsg = "" + + ! For debugging the interface: + if (DebugLevel > 0) then + call ShowPassedData() + endif + + ! current turbine number + iWT = int(iWT_c, IntKi) + + ! Sanity check -- number of node points cannot change + if ( NumMeshPts(iWT) /= int(NumMeshPts_C, IntKi) ) then + ErrStat2 = ErrID_Fatal + ErrMsg2 = "Number of node points passed in changed. This must be constant throughout simulation" + if (Failed()) return + endif + + ! Reshape mesh position, orientation, velocity, acceleration + do i=1,Sim%WT(iWT)%NumBlades + do j=1,StrucPts_2_Bld_Map(iWT)%NumMeshPtsPerBlade(i) + StrucPts_2_Bld_Map(iWT)%BladeStrMeshCoords(i)%Position( 1:3,j) = reshape( real(MeshPos_C(3 * StrucPts_2_Bld_Map(iWT)%BladeNode_2_MeshPt(i)%BladeNodeToMeshPoint(j) - 2 : 3 * StrucPts_2_Bld_Map(iWT)%BladeNode_2_MeshPt(i)%BladeNodeToMeshPoint(j)),ReKi), (/3/) ) + StrucPts_2_Bld_Map(iWT)%BladeStrMeshCoords(i)%Orient(1:3,1:3,j) = reshape( real(MeshOri_C(9 * StrucPts_2_Bld_Map(iWT)%BladeNode_2_MeshPt(i)%BladeNodeToMeshPoint(j) - 8 : 9 * StrucPts_2_Bld_Map(iWT)%BladeNode_2_MeshPt(i)%BladeNodeToMeshPoint(j)),R8Ki), (/3,3/) ) + StrucPts_2_Bld_Map(iWT)%BladeStrMeshCoords(i)%Velocity( 1:6,j) = reshape( real(MeshVel_C(6 * StrucPts_2_Bld_Map(iWT)%BladeNode_2_MeshPt(i)%BladeNodeToMeshPoint(j) - 5 : 6 * StrucPts_2_Bld_Map(iWT)%BladeNode_2_MeshPt(i)%BladeNodeToMeshPoint(j)),ReKi), (/6/) ) + StrucPts_2_Bld_Map(iWT)%BladeStrMeshCoords(i)%Accln( 1:6,j) = reshape( real(MeshAcc_C(6 * StrucPts_2_Bld_Map(iWT)%BladeNode_2_MeshPt(i)%BladeNodeToMeshPoint(j) - 5 : 6 * StrucPts_2_Bld_Map(iWT)%BladeNode_2_MeshPt(i)%BladeNodeToMeshPoint(j)),ReKi), (/6/) ) + enddo + enddo + + ! Transfer motions to input meshes + do iWT=1,Sim%NumTurbines + call Set_MotionMesh(iWT, ErrStat2, ErrMsg2); if (Failed()) return + call AD_SetInputMotion( iWT, ADI_u, & + HubPos_C, HubOri_C, HubVel_C, HubAcc_C, & + NacPos_C, NacOri_C, NacVel_C, NacAcc_C, & + BldRootPos_C, BldRootOri_C, BldRootVel_C, BldRootAcc_C, & + ErrStat2, ErrMsg2 ) ! transfer input motion mesh to u(1) meshes + if (Failed()) return + enddo + ! Set error status call SetErr(ErrStat,ErrMsg,ErrStat_C,ErrMsg_C) + CONTAINS - !> Don't leave junk in memory. So destroy meshes and mappings. - subroutine ClearMesh() - ! Blade - call MeshDestroy( BldPtMotionMesh, ErrStat2, ErrMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - call MeshDestroy( BldPtLoadMesh, ErrStat2, ErrMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ! Destroy mesh mappings - if (allocated(Map_BldPtMotion_2_AD_Blade)) then - do i=1,Sim%WT(1)%NumBlades - call NWTC_Library_Destroymeshmaptype( Map_BldPtMotion_2_AD_Blade(i), ErrStat2, ErrMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + logical function Failed() + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + Failed = ErrStat >= AbortErrLev + if (Failed) call SetErr(ErrStat,ErrMsg,ErrStat_C,ErrMsg_C) + end function Failed + !> This subroutine prints out all the variables that are passed in. Use this only + !! for debugging the interface on the Fortran side. + subroutine ShowPassedData() + character(1) :: TmpFlag + integer :: i,j + call WrSCr("") + call WrScr("-----------------------------------------------------------") + call WrScr("Interface debugging: Variables passed in through interface") + call WrScr(" ADI_C_SetRotorMotion -- rotor "//trim(Num2LStr(iWT_c))) + call WrScr(" ("//trim(Num2LStr(Sim%WT(iWT_C)%numBlades))//" blades, "//trim(Num2LStr(NumMeshPts(iWT_C)))//" mesh nodes)") + call WrScr(" --------------------------------------------------------") + call WrScr(" rotor positions/orientations (positions do not include Turbine origin offset)") + call WrNR(" Hub Position ") + call WrMatrix(HubPos_C,CU,'(3(ES15.7e2))') + call WrNR(" Hub Orientation ") + call WrMatrix(HubOri_C,CU,'(9(ES23.15e2))') + call WrNR(" Hub Velocity ") + call WrMatrix(HubVel_C,CU,'(6(ES15.7e2))') + call WrNR(" Hub Acceleration ") + call WrMatrix(HubAcc_C,CU,'(6(ES15.7e2))') + + call WrNR(" Nacelle Position ") + call WrMatrix(NacPos_C,CU,'(3(ES15.7e2))') + call WrNR(" Nacelle Orientation ") + call WrMatrix(NacOri_C,CU,'(9(ES23.15e2))') + call WrNR(" Nacelle Velocity ") + call WrMatrix(NacVel_C,CU,'(6(ES15.7e2))') + call WrNR(" Nacelle Acceleration ") + call WrMatrix(NacAcc_C,CU,'(6(ES15.7e2))') + + if (DebugLevel > 1) then + call WrScr(" Root Positions (positions do not include Turbine origin offset)") + do i=1,Sim%WT(iWT_c)%NumBlades + j=3*(i-1) + call WrMatrix(BldRootPos_C(j+1:j+3),CU,'(3(ES15.7e2))') + enddo + call WrScr(" Root Orientations") + do i=1,Sim%WT(iWT_c)%NumBlades + j=9*(i-1) + call WrMatrix(BldRootOri_C(j+1:j+9),CU,'(9(ES23.15e2))') + enddo + call WrScr(" Root Velocities") + do i=1,Sim%WT(iWT_c)%NumBlades + j=3*(i-1) + call WrMatrix(BldRootPos_C(j+1:j+3),CU,'(6(ES15.7e2))') + enddo + call WrScr(" Root Accelerations") + do i=1,Sim%WT(iWT_c)%NumBlades + j=3*(i-1) + call WrMatrix(BldRootAcc_C(j+1:j+3),CU,'(6(ES15.7e2))') enddo - deallocate(Map_BldPtMotion_2_AD_Blade) endif - if (allocated(Map_AD_BldLoad_P_2_BldPtLoad)) then - do i=1,Sim%WT(1)%NumBlades - call NWTC_Library_Destroymeshmaptype( Map_AD_BldLoad_P_2_BldPtLoad(i), ErrStat2, ErrMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + call WrScr(" NumMeshPts_C "//trim(Num2LStr( NumMeshPts_C )) ) + if (DebugLevel > 1) then + call WrScr(" Mesh Positions (positions do not include Turbine origin offset)") + do i=1,NumMeshPts_C + j=3*(i-1) + call WrMatrix(MeshPos_C(j+1:j+3),CU,'(3(ES15.7e2))') + enddo + call WrScr(" Mesh Orientations") + do i=1,NumMeshPts_C + j=9*(i-1) + call WrMatrix(MeshOri_C(j+1:j+9),CU,'(9(ES23.15e2))') + enddo + call WrScr(" Mesh Velocities") + do i=1,NumMeshPts_C + j=3*(i-1) + call WrMatrix(MeshVel_C(j+1:j+3),CU,'(6(ES15.7e2))') + enddo + call WrScr(" Mesh Accelerations") + do i=1,NumMeshPts_C + j=3*(i-1) + call WrMatrix(MeshAcc_C(j+1:j+3),CU,'(6(ES15.7e2))') enddo - deallocate(Map_AD_BldLoad_P_2_BldPtLoad) endif - ! Nacelle -- TODO: add this mesh for nacelle load transfers -! call MeshDestroy( NacMotionMesh, ErrStat2, ErrMsg2 ) -! call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) -! call MeshDestroy( NacLoadMesh, ErrStat2, ErrMsg2 ) -! call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) -! call NWTC_Library_Destroymeshmaptype( Map_AD_Nac_2_NacPtLoad , ErrStat2, ErrMsg2 ) -! call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) -! call NWTC_Library_Destroymeshmaptype( Map_NacPtMotion_2_AD_Nac , ErrStat2, ErrMsg2 ) -! call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + call WrScr("-----------------------------------------------------------") + end subroutine ShowPassedData + +end subroutine ADI_C_SetRotorMotion + +!=============================================================================================================== +!--------------------------------------------- AeroDyn GetRotorLoads ------------------------------------------- +!=============================================================================================================== +!> Get the loads from a single rotor. This must be called after ADI_C_CalcOutput +subroutine ADI_C_GetRotorLoads(iWT_C, & + NumMeshPts_C, MeshFrc_C, HHVel_C, & + ErrStat_C, ErrMsg_C) BIND (C, NAME='ADI_C_GetRotorLoads') + implicit none +#ifndef IMPLICIT_DLLEXPORT +!DEC$ ATTRIBUTES DLLEXPORT :: ADI_C_GetRotorLoads +!GCC$ ATTRIBUTES DLLEXPORT :: ADI_C_GetRotorLoads +#endif + integer(c_int), intent(in ) :: iWT_C !< Wind turbine / rotor number + integer(c_int), intent(in ) :: NumMeshPts_C !< Number of mesh points we are transfering motions to and output loads to + real(c_float), intent( out) :: MeshFrc_C( 6*NumMeshPts_C ) !< A 6xNumMeshPts_C array [Fx,Fy,Fz,Mx,My,Mz] -- forces and moments (global) + real(c_float), intent( out) :: HHVel_C(3) !< Wind speed array [Vx,Vy,Vz] -- (m/s) (global) + integer(c_int), intent( out) :: ErrStat_C + character(kind=c_char), intent( out) :: ErrMsg_C(ErrMsgLen_C) + + ! Local variables + integer(IntKi) :: iWT !< current wind turbine / rotor + integer(IntKi) :: ErrStat !< aggregated error status + character(ErrMsgLen) :: ErrMsg !< aggregated error message + integer(IntKi) :: ErrStat2 !< temporary error status from a call + character(ErrMsgLen) :: ErrMsg2 !< temporary error message from a call + character(*), parameter :: RoutineName = 'ADI_C_SetRotorMotion' !< for error handling + integer(IntKi) :: i,j !< generic index variables + + ! Initialize error handling + ErrStat = ErrID_None + ErrMsg = "" + + ! For debugging the interface: + if (DebugLevel > 0) then + call ShowPassedData() + endif + + ! current turbine number + iWT = int(iWT_c, IntKi) + + ! Sanity check -- number of node points cannot change + if ( NumMeshPts(iWT) /= int(NumMeshPts_C, IntKi) ) then + ErrStat2 = ErrID_Fatal + ErrMsg2 = "Number of node points passed in changed. This must be constant throughout simulation" + if (Failed()) return + endif + + ! Transfer resulting load meshes to intermediate mesh + call AD_TransferLoads( iWT, ADI%u(1), ADI%y, ErrStat2, ErrMsg2 ) + if (Failed()) return - end subroutine ClearMesh -END SUBROUTINE AeroDyn_Inflow_C_End + ! Set output force/moment array + call Set_OutputLoadArray(iWT) + do i=1,Sim%WT(iWT)%NumBlades + do j=1,StrucPts_2_Bld_Map(iWT)%NumMeshPtsPerBlade(i) + MeshFrc_C(6 * StrucPts_2_Bld_Map(iWT)%BladeNode_2_MeshPt(i)%BladeNodeToMeshPoint(j) - 5 : 6 * StrucPts_2_Bld_Map(iWT)%BladeNode_2_MeshPt(i)%BladeNodeToMeshPoint(j)) = real(StrucPts_2_Bld_Map(iWT)%BladeStrMeshCoords(i)%Force(1:6,j), c_float) + enddo + enddo + ! Set hub height wind speed (m/s) + if (ADI%p%storeHHVel) then + HHVel_C = real(ADI%y%HHVel(:, iWT), c_float) + else + HHVel_C = 0.0_c_float + end if + + ! Set error status + call SetErr(ErrStat,ErrMsg,ErrStat_C,ErrMsg_C) + +CONTAINS + logical function Failed() + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + Failed = ErrStat >= AbortErrLev + if (Failed) call SetErr(ErrStat,ErrMsg,ErrStat_C,ErrMsg_C) + end function Failed + !> This subroutine prints out all the variables that are passed in. Use this only + !! for debugging the interface on the Fortran side. + subroutine ShowPassedData() + character(1) :: TmpFlag + integer :: i,j + call WrSCr("") + call WrScr("-----------------------------------------------------------") + call WrScr("Interface debugging: Variables passed in through interface") + call WrScr(" ADI_C_GetRotorLoads -- rotor "//trim(Num2LStr(iWT_c))) + call WrScr(" --------------------------------------------------------") + call WrScr(" NumMeshPts_C "//trim(Num2LStr( NumMeshPts_C )) ) + call WrScr("-----------------------------------------------------------") + end subroutine ShowPassedData +end subroutine ADI_C_GetRotorLoads + + +!=============================================================================================================== +!--------------------------------------------- GetDiskAvgVel --------------------------------------------------- +!=============================================================================================================== +!> Get the disk average velocity for a single rotor (uses the IfW DiskAvgVel routine) +subroutine ADI_C_GetDiskAvgVel(iWT_C, & + DiskAvgVel_C, & + ErrStat_C, ErrMsg_C) BIND (C, NAME='ADI_C_GetDiskAvgVel') + implicit none +#ifndef IMPLICIT_DLLEXPORT +!DEC$ ATTRIBUTES DLLEXPORT :: ADI_C_GetDiskAvgVel +!GCC$ ATTRIBUTES DLLEXPORT :: ADI_C_GetDiskAvgVel +#endif + integer(c_int), intent(in ) :: iWT_C !< Wind turbine / rotor number + real(c_float), intent( out) :: DiskAvgVel_C(3) !< Wind speed vector for disk average [Vx,Vy,Vz] -- (m/s) (global) + integer(c_int), intent( out) :: ErrStat_C + character(kind=c_char), intent( out) :: ErrMsg_C(ErrMsgLen_C) + + ! Local variables + type(MeshType), pointer :: Hub ! HubMotion mesh pointer, for simplicity in code reading + integer(IntKi) :: iWT !< current wind turbine / rotor + integer(IntKi) :: i + integer(IntKi), parameter :: StartNode = 1 ! so all points are calculated + real(ReKi), allocatable :: NoAcc(:,:) ! Placeholder array not used when accelerations not required. + real(ReKi) :: DiskAvgVel(3) !< Wind speed vector for disk average [Vx,Vy,Vz] -- (m/s) (global) + integer(IntKi) :: ErrStat !< aggregated error status + character(ErrMsgLen) :: ErrMsg !< aggregated error message + character(*), parameter :: RoutineName = 'ADI_C_GetDiskAvgVel' !< for error handling + + ! Initialize error handling + ErrStat = ErrID_None + ErrMsg = "" + + ! For debugging the interface: + if (DebugLevel > 0) then + call ShowPassedData() + endif + + ! current turbine number + iWT = int(iWT_c, IntKi) + + ! pointer to make code more readable + Hub => ADI%u(1)%AD%rotors(iWT)%HubMotion + + ! Calculate Disk Avg Velocity + do i=1,NumPtsDiskAvg + DiskAvgVelVars(iWT)%DiskWindPosAbs(:,i) = real(Hub%Position(1:3,1)+Hub%TranslationDisp(1:3,1),ReKi) & + + matmul(real(Hub%Orientation(1:3,1:3,1),ReKi),DiskAvgVelVars(iWT)%DiskWindPosRel(:,i)) + enddo + call IfW_FlowField_GetVelAcc(ADI%m%IW%p%FlowField, StartNode, InputTimePrev_Calc, DiskAvgVelVars(iWT)%DiskWindPosAbs, DiskAvgVelVars(iWT)%DiskWindVel, NoAcc, ErrStat, ErrMsg) + + ! calculate average + DiskAvgVel = sum(DiskAvgVelVars(iWT)%DiskWindVel, dim=2) / REAL(NumPtsDiskAvg,SiKi) + DiskAvgVel_C = real(DiskAvgVel, c_float) + + ! Set error status + call SetErr(ErrStat,ErrMsg,ErrStat_C,ErrMsg_C) + +CONTAINS + !> This subroutine prints out all the variables that are passed in. Use this only + !! for debugging the interface on the Fortran side. + subroutine ShowPassedData() + call WrSCr("") + call WrScr("-----------------------------------------------------------") + call WrScr("Interface debugging: Variables passed in through interface") + call WrScr(" ADI_C_GetDiskAvgVel -- rotor "//trim(Num2LStr(iWT_c))) + call WrScr("-----------------------------------------------------------") + end subroutine ShowPassedData +end subroutine ADI_C_GetDiskAvgVel + + +!=================================================================================================================================== +! Internal routines for setting meshes etc. +!=================================================================================================================================== !> This routine is operating on module level data. Error handling here in case checks added -subroutine Set_MotionMesh(ErrStat3, ErrMsg3) +!! NOTE: the OriginInit is not included in the data passed in and must be added to the the position info here +subroutine Set_MotionMesh(iWT, ErrStat3, ErrMsg3) + integer(IntKi), intent(in ) :: iWT !< current rotor/turbine integer(IntKi), intent( out) :: ErrStat3 character(ErrMsgLen), intent( out) :: ErrMsg3 - integer(IntKi) :: iNode + integer(IntKi) :: iBlade !< current blade + integer(IntKi) :: j !< generic index variables + ErrStat3 = 0_IntKi ErrMsg3 = '' ! Set mesh corresponding to input motions - do iNode=1,NumMeshPts - BldPtMotionMesh%TranslationDisp(1:3,iNode) = tmpBldPtMeshPos(1:3,iNode) - real(BldPtMotionMesh%Position(1:3,iNode), R8Ki) - BldPtMotionMesh%Orientation(1:3,1:3,iNode) = tmpBldPtMeshOri(1:3,1:3,iNode) - BldPtMotionMesh%TranslationVel( 1:3,iNode) = tmpBldPtMeshVel(1:3,iNode) - BldPtMotionMesh%RotationVel( 1:3,iNode) = tmpBldPtMeshVel(4:6,iNode) - BldPtMotionMesh%TranslationAcc( 1:3,iNode) = tmpBldPtMeshAcc(1:3,iNode) - !BldPtMotionMesh%RotationAcc( 1:3,iNode) = tmpBldPtMeshAcc(4:6,iNode) ! Rotational acc not included - call OrientRemap(BldPtMotionMesh%Orientation(1:3,1:3,iNode)) - if (TransposeDCM) then - BldPtMotionMesh%Orientation(1:3,1:3,iNode) = transpose(BldPtMotionMesh%Orientation(1:3,1:3,iNode)) - endif + do iBlade=1,Sim%WT(iWT)%NumBlades + do j=1,StrucPts_2_Bld_Map(iWT)%NumMeshPtsPerBlade(iBlade) + BldStrMotionMesh(iWT)%Mesh(iBlade)%TranslationDisp(1:3,j) = StrucPts_2_Bld_Map(iWT)%BladeStrMeshCoords(iBlade)%Position(1:3,j) + Sim%WT(iWT)%OriginInit(1:3) - real(BldStrMotionMesh(iWT)%Mesh(iBlade)%Position(1:3,j), R8Ki) + BldStrMotionMesh(iWT)%Mesh(iBlade)%Orientation(1:3,1:3,j) = StrucPts_2_Bld_Map(iWT)%BladeStrMeshCoords(iBlade)%Orient(1:3,1:3,j) + BldStrMotionMesh(iWT)%Mesh(iBlade)%TranslationVel( 1:3,j) = StrucPts_2_Bld_Map(iWT)%BladeStrMeshCoords(iBlade)%Velocity(1:3,j) + BldStrMotionMesh(iWT)%Mesh(iBlade)%RotationVel( 1:3,j) = StrucPts_2_Bld_Map(iWT)%BladeStrMeshCoords(iBlade)%Velocity(4:6,j) + BldStrMotionMesh(iWT)%Mesh(iBlade)%TranslationAcc( 1:3,j) = StrucPts_2_Bld_Map(iWT)%BladeStrMeshCoords(iBlade)%Accln(1:3,j) + call OrientRemap(BldStrMotionMesh(iWT)%Mesh(iBlade)%Orientation(1:3,1:3,j)) + if (TransposeDCM) then + BldStrMotionMesh(iWT)%Mesh(iBlade)%Orientation(1:3,1:3,j) = transpose(BldStrMotionMesh(iWT)%Mesh(iBlade)%Orientation(1:3,1:3,j)) + endif + enddo enddo end subroutine Set_MotionMesh !> Map the motion of the intermediate input mesh over to the input meshes !! This routine is operating on module level data, hence few inputs -subroutine AD_SetInputMotion( u_local, & +!! NOTE: the OriginInit is not included in the data passed in and must be added to the the position info here +subroutine AD_SetInputMotion( iWT, u_local, & HubPos_C, HubOri_C, HubVel_C, HubAcc_C, & NacPos_C, NacOri_C, NacVel_C, NacAcc_C, & BldRootPos_C, BldRootOri_C, BldRootVel_C, BldRootAcc_C, & ErrStat, ErrMsg ) + integer(IntKi), intent(in ) :: iWT !< this turbine type(ADI_InputType), intent(inout) :: u_local ! Only one input (probably at T) real(c_float), intent(in ) :: HubPos_C( 3 ) !< Hub position real(c_double), intent(in ) :: HubOri_C( 9 ) !< Hub orientation @@ -1445,58 +2108,69 @@ subroutine AD_SetInputMotion( u_local, & real(c_double), intent(in ) :: NacOri_C( 9 ) !< Nacelle orientation real(c_float), intent(in ) :: NacVel_C( 6 ) !< Nacelle velocity real(c_float), intent(in ) :: NacAcc_C( 6 ) !< Nacelle acceleration - real(c_float), intent(in ) :: BldRootPos_C( 3*Sim%WT(1)%NumBlades ) !< Blade root positions - real(c_double), intent(in ) :: BldRootOri_C( 9*Sim%WT(1)%NumBlades ) !< Blade root orientations - real(c_float), intent(in ) :: BldRootVel_C( 6*Sim%WT(1)%NumBlades ) !< Blade root velocities - real(c_float), intent(in ) :: BldRootAcc_C( 6*Sim%WT(1)%NumBlades ) !< Blade root accelerations + real(c_float), intent(in ) :: BldRootPos_C( 3*Sim%WT(iWT)%NumBlades ) !< Blade root positions + real(c_double), intent(in ) :: BldRootOri_C( 9*Sim%WT(iWT)%NumBlades ) !< Blade root orientations + real(c_float), intent(in ) :: BldRootVel_C( 6*Sim%WT(iWT)%NumBlades ) !< Blade root velocities + real(c_float), intent(in ) :: BldRootAcc_C( 6*Sim%WT(iWT)%NumBlades ) !< Blade root accelerations integer(IntKi), intent( out) :: ErrStat character(ErrMsgLen), intent( out) :: ErrMsg - integer(IntKi) :: i + integer(IntKi) :: iBlade !< current blade + integer(IntKi) :: i,j !< generic index variables + integer(IntKi) :: n_elems !< number of elements in the mesh ErrStat = 0_IntKi ErrMsg = '' + ! Hub -- NOTE: RotationalAcc not present in the mesh - if ( u_local%AD%rotors(1)%HubMotion%Committed ) then - u_local%AD%rotors(1)%HubMotion%TranslationDisp(1:3,1) = real(HubPos_C(1:3),R8Ki) - real(u_local%AD%rotors(1)%HubMotion%Position(1:3,1), R8Ki) - u_local%AD%rotors(1)%HubMotion%Orientation(1:3,1:3,1) = reshape( real(HubOri_C(1:9),R8Ki), (/3,3/) ) - u_local%AD%rotors(1)%HubMotion%TranslationVel(1:3,1) = real(HubVel_C(1:3), ReKi) - u_local%AD%rotors(1)%HubMotion%RotationVel(1:3,1) = real(HubVel_C(4:6), ReKi) - u_local%AD%rotors(1)%HubMotion%TranslationAcc(1:3,1) = real(HubAcc_C(1:3), ReKi) - call OrientRemap(u_local%AD%rotors(1)%HubMotion%Orientation(1:3,1:3,1)) + if ( u_local%AD%rotors(iWT)%HubMotion%Committed ) then + u_local%AD%rotors(iWT)%HubMotion%TranslationDisp(1:3,1) = real(HubPos_C(1:3),R8Ki) + Sim%WT(iWT)%OriginInit(1:3) - real(u_local%AD%rotors(iWT)%HubMotion%Position(1:3,1), R8Ki) + u_local%AD%rotors(iWT)%HubMotion%Orientation(1:3,1:3,1) = reshape( real(HubOri_C(1:9),R8Ki), (/3,3/) ) + u_local%AD%rotors(iWT)%HubMotion%TranslationVel(1:3,1) = real(HubVel_C(1:3), ReKi) + u_local%AD%rotors(iWT)%HubMotion%RotationVel(1:3,1) = real(HubVel_C(4:6), ReKi) + u_local%AD%rotors(iWT)%HubMotion%TranslationAcc(1:3,1) = real(HubAcc_C(1:3), ReKi) + call OrientRemap(u_local%AD%rotors(iWT)%HubMotion%Orientation(1:3,1:3,1)) if (TransposeDCM) then - u_local%AD%rotors(1)%HubMotion%Orientation(1:3,1:3,1) = transpose(u_local%AD%rotors(1)%HubMotion%Orientation(1:3,1:3,1)) + u_local%AD%rotors(iWT)%HubMotion%Orientation(1:3,1:3,1) = transpose(u_local%AD%rotors(iWT)%HubMotion%Orientation(1:3,1:3,1)) endif endif + ! Nacelle -- NOTE: RotationalVel and RotationalAcc not present in the mesh - if ( u_local%AD%rotors(1)%NacelleMotion%Committed ) then - u_local%AD%rotors(1)%NacelleMotion%TranslationDisp(1:3,1) = real(NacPos_C(1:3),R8Ki) - real(u_local%AD%rotors(1)%NacelleMotion%Position(1:3,1), R8Ki) - u_local%AD%rotors(1)%NacelleMotion%Orientation(1:3,1:3,1) = reshape( real(NacOri_C(1:9),R8Ki), (/3,3/) ) - u_local%AD%rotors(1)%NacelleMotion%TranslationVel(1:3,1) = real(NacVel_C(1:3), ReKi) - u_local%AD%rotors(1)%NacelleMotion%TranslationAcc(1:3,1) = real(NacAcc_C(1:3), ReKi) - call OrientRemap(u_local%AD%rotors(1)%NacelleMotion%Orientation(1:3,1:3,1)) + if ( u_local%AD%rotors(iWT)%NacelleMotion%Committed ) then + u_local%AD%rotors(iWT)%NacelleMotion%TranslationDisp(1:3,1) = real(NacPos_C(1:3),R8Ki) + Sim%WT(iWT)%OriginInit(1:3) - real(u_local%AD%rotors(iWT)%NacelleMotion%Position(1:3,1), R8Ki) + u_local%AD%rotors(iWT)%NacelleMotion%Orientation(1:3,1:3,1) = reshape( real(NacOri_C(1:9),R8Ki), (/3,3/) ) + u_local%AD%rotors(iWT)%NacelleMotion%TranslationVel(1:3,1) = real(NacVel_C(1:3), ReKi) + u_local%AD%rotors(iWT)%NacelleMotion%TranslationAcc(1:3,1) = real(NacAcc_C(1:3), ReKi) + call OrientRemap(u_local%AD%rotors(iWT)%NacelleMotion%Orientation(1:3,1:3,1)) if (TransposeDCM) then - u_local%AD%rotors(1)%NacelleMotion%Orientation(1:3,1:3,1) = transpose(u_local%AD%rotors(1)%NacelleMotion%Orientation(1:3,1:3,1)) + u_local%AD%rotors(iWT)%NacelleMotion%Orientation(1:3,1:3,1) = transpose(u_local%AD%rotors(iWT)%NacelleMotion%Orientation(1:3,1:3,1)) endif endif + ! Blade root - do i=0,Sim%WT(1)%numBlades-1 - if ( u_local%AD%rotors(1)%BladeRootMotion(i+1)%Committed ) then - u_local%AD%rotors(1)%BladeRootMotion(i+1)%TranslationDisp(1:3,1) = real(BldRootPos_C(3*i+1:3*i+3),R8Ki) - real(u_local%AD%rotors(1)%BladeRootMotion(i+1)%Position(1:3,1), R8Ki) - u_local%AD%rotors(1)%BladeRootMotion(i+1)%Orientation(1:3,1:3,1) = reshape( real(BldRootOri_C(9*i+1:9*i+9),R8Ki), (/3,3/) ) - u_local%AD%rotors(1)%BladeRootMotion(i+1)%TranslationVel(1:3,1) = real(BldRootVel_C(6*i+1:6*i+3), ReKi) - u_local%AD%rotors(1)%BladeRootMotion(i+1)%RotationVel(1:3,1) = real(BldRootVel_C(6*i+4:6*i+6), ReKi) - u_local%AD%rotors(1)%BladeRootMotion(i+1)%TranslationAcc(1:3,1) = real(BldRootAcc_C(6*i+1:6*i+3), ReKi) - u_local%AD%rotors(1)%BladeRootMotion(i+1)%RotationAcc(1:3,1) = real(BldRootAcc_C(6*i+4:6*i+6), ReKi) - call OrientRemap(u_local%AD%rotors(1)%BladeRootMotion(i+1)%Orientation(1:3,1:3,1)) + do i=0,Sim%WT(iWT)%numBlades-1 + if ( u_local%AD%rotors(iWT)%BladeRootMotion(i+1)%Committed ) then + u_local%AD%rotors(iWT)%BladeRootMotion(i+1)%TranslationDisp(1:3,1) = real(BldRootPos_C(3*i+1:3*i+3),R8Ki) + Sim%WT(iWT)%OriginInit(1:3) - real(u_local%AD%rotors(iWT)%BladeRootMotion(i+1)%Position(1:3,1), R8Ki) + u_local%AD%rotors(iWT)%BladeRootMotion(i+1)%Orientation(1:3,1:3,1) = reshape( real(BldRootOri_C(9*i+1:9*i+9),R8Ki), (/3,3/) ) + u_local%AD%rotors(iWT)%BladeRootMotion(i+1)%TranslationVel(1:3,1) = real(BldRootVel_C(6*i+1:6*i+3), ReKi) + u_local%AD%rotors(iWT)%BladeRootMotion(i+1)%RotationVel(1:3,1) = real(BldRootVel_C(6*i+4:6*i+6), ReKi) + u_local%AD%rotors(iWT)%BladeRootMotion(i+1)%TranslationAcc(1:3,1) = real(BldRootAcc_C(6*i+1:6*i+3), ReKi) + u_local%AD%rotors(iWT)%BladeRootMotion(i+1)%RotationAcc(1:3,1) = real(BldRootAcc_C(6*i+4:6*i+6), ReKi) + call OrientRemap(u_local%AD%rotors(iWT)%BladeRootMotion(i+1)%Orientation(1:3,1:3,1)) if (TransposeDCM) then - u_local%AD%rotors(1)%BladeRootMotion(i+1)%Orientation(1:3,1:3,1) = transpose(u_local%AD%rotors(1)%BladeRootMotion(i+1)%Orientation(1:3,1:3,1)) + u_local%AD%rotors(iWT)%BladeRootMotion(i+1)%Orientation(1:3,1:3,1) = transpose(u_local%AD%rotors(iWT)%BladeRootMotion(i+1)%Orientation(1:3,1:3,1)) endif endif enddo ! Blade mesh - do i=1,Sim%WT(1)%numBlades - if ( u_local%AD%rotors(1)%BladeMotion(i)%Committed ) then - call Transfer_Point_to_Line2( BldPtMotionMesh, u_local%AD%rotors(1)%BladeMotion(i), Map_BldPtMotion_2_AD_Blade(i), ErrStat, ErrMsg ) + do iBlade=1,Sim%WT(iWT)%numBlades + n_elems = size(BldStrMotionMesh(iWT)%Mesh(iBlade)%Position, 2) + if (( u_local%AD%rotors(iWT)%BladeMotion(iBlade)%Committed ) .and. (n_elems > 0)) then + if (PointLoadOutput) then + call Transfer_Point_to_Line2(BldStrMotionMesh(iWT)%Mesh(iBlade), u_local%AD%rotors(iWT)%BladeMotion(iBlade), Map_BldStrMotion_2_AD_Blade(i,iWT), ErrStat, ErrMsg) + else + call Transfer_Line2_to_Line2(BldStrMotionMesh(iWT)%Mesh(iBlade), u_local%AD%rotors(iWT)%BladeMotion(iBlade), Map_BldStrMotion_2_AD_Blade(i,iWT), ErrStat, ErrMsg) + u_local%AD%rotors(iWT)%BladeMotion(iBlade)%RemapFlag = .false. + end if if (ErrStat >= AbortErrLev) return endif enddo @@ -1504,35 +2178,58 @@ end subroutine AD_SetInputMotion !> Map the loads of the output mesh to the intermediate output mesh. !! This routine is operating on module level data, hence few inputs -subroutine AD_TransferLoads( u_local, y_local, ErrStat3, ErrMsg3 ) - type(ADI_InputType), intent(in ) :: u_local ! Only one input (probably at T) - type(ADI_OutputType), intent(in ) :: y_local ! Only one input (probably at T) +subroutine AD_TransferLoads( iWT, u_local, y_local, ErrStat3, ErrMsg3 ) + integer(IntKi), intent(in ) :: iWT !< Current rotor/turbine + type(ADI_InputType), intent(in ) :: u_local !< Only one input (probably at T) + type(ADI_OutputType), intent(in ) :: y_local !< Only one input (probably at T) integer(IntKi), intent( out) :: ErrStat3 character(ErrMsgLen), intent( out) :: ErrMsg3 - integer(IntKi) :: i - BldPtLoadMesh%Force = 0.0_ReKi - BldPtLoadMesh%Moment = 0.0_ReKi - do i=1,Sim%WT(1)%NumBlades - if ( y_local%AD%rotors(1)%BladeLoad(i)%Committed ) then - if (debugverbose > 4) call MeshPrintInfo( CU, y_local%AD%rotors(1)%BladeLoad(i), MeshName='AD%rotors('//trim(Num2LStr(1))//')%BladeLoad('//trim(Num2LStr(i))//')' ) - call Transfer_Line2_to_Point( ADI%y%AD%rotors(1)%BladeLoad(i), BldPtLoadMesh_tmp, Map_AD_BldLoad_P_2_BldPtLoad(i), & - ErrStat3, ErrMsg3, u_local%AD%rotors(1)%BladeMotion(i), BldPtMotionMesh ) - if (ErrStat3 >= AbortErrLev) return - BldPtLoadMesh%Force = BldPtLoadMesh%Force + BldPtLoadMesh_tmp%Force - BldPtLoadMesh%Moment = BldPtLoadMesh%Moment + BldPtLoadMesh_tmp%Moment + integer(IntKi) :: iBlade !< current blade + integer(IntKi) :: n_elems !< number of elements in the mesh + + + do iBlade=1,Sim%WT(iWT)%NumBlades + n_elems = size(BldStrMotionMesh(iWT)%Mesh(iBlade)%Position, 2) + if (n_elems > 0) then + BldStrLoadMesh(iWT)%Mesh(iBlade)%Force = 0.0_ReKi + BldStrLoadMesh(iWT)%Mesh(iBlade)%Moment = 0.0_ReKi + endif + enddo + + do iBlade=1,Sim%WT(iWT)%NumBlades + if ( y_local%AD%rotors(iWT)%BladeLoad(iBlade)%Committed ) then + if (DebugLevel >= 4) call MeshPrintInfo( CU, y_local%AD%rotors(iWT)%BladeLoad(iBlade), MeshName='AD%rotors('//trim(Num2LStr(iWT))//')%BladeLoad('//trim(Num2LStr(iBlade))//')' ) + n_elems = size(BldStrMotionMesh(iWT)%Mesh(iBlade)%Position, 2) + if (n_elems > 0) then + if (PointLoadOutput) then + call Transfer_Line2_to_Point(ADI%y%AD%rotors(iWT)%BladeLoad(iBlade), BldStrLoadMesh_tmp(iWT)%Mesh(iBlade), Map_AD_BldLoad_P_2_BldStrLoad(iBlade,iWT), & + ErrStat3, ErrMsg3, u_local%AD%rotors(iWT)%BladeMotion(iBlade), BldStrMotionMesh(iWT)%Mesh(iBlade)) + else + call Transfer_Line2_to_Line2(ADI%y%AD%rotors(iWT)%BladeLoad(iBlade), BldStrLoadMesh_tmp(iWT)%Mesh(iBlade), Map_AD_BldLoad_P_2_BldStrLoad(iBlade,iWT), & + ErrStat3, ErrMsg3, u_local%AD%rotors(iWT)%BladeMotion(iBlade), BldStrMotionMesh(iWT)%Mesh(iBlade)) + ADI%y%AD%rotors(iWT)%BladeLoad(iBlade)%RemapFlag = .false. + end if + if (ErrStat3 >= AbortErrLev) return + BldStrLoadMesh(iWT)%Mesh(iBlade)%Force = BldStrLoadMesh(iWT)%Mesh(iBlade)%Force + BldStrLoadMesh_tmp(iWT)%Mesh(iBlade)%Force + BldStrLoadMesh(iWT)%Mesh(iBlade)%Moment = BldStrLoadMesh(iWT)%Mesh(iBlade)%Moment + BldStrLoadMesh_tmp(iWT)%Mesh(iBlade)%Moment + endif endif + if (DebugLevel >= 4) call MeshPrintInfo( CU, BldStrLoadMesh(iWT)%Mesh(iBlade), MeshName='BldStrLoadMesh'//trim(Num2LStr(iWT))//'_'//trim(Num2LStr(iBlade)) ) enddo - if (debugverbose > 4) call MeshPrintInfo( CU, BldPtLoadMesh, MeshName='BldPtLoadMesh' ) end subroutine AD_TransferLoads !> Transfer the loads from the load mesh to the temporary array for output !! This routine is operating on module level data, hence few inputs -subroutine Set_OutputLoadArray() - integer(IntKi) :: iNode +subroutine Set_OutputLoadArray(iWT) + integer(IntKi), intent(in ) :: iWT !< current rotor/turbine + integer(IntKi) :: iBlade !< current blade + integer(IntKi) :: j !< generic index variables ! Set mesh corresponding to input motions - do iNode=1,NumMeshPts - tmpBldPtMeshFrc(1:3,iNode) = BldPtLoadMesh%Force (1:3,iNode) - tmpBldPtMeshFrc(4:6,iNode) = BldPtLoadMesh%Moment(1:3,iNode) + do iBlade=1,Sim%WT(iWT)%NumBlades + do j=1,StrucPts_2_Bld_Map(iWT)%NumMeshPtsPerBlade(iBlade) + StrucPts_2_Bld_Map(iWT)%BladeStrMeshCoords(iBlade)%Force(1:3,j) = BldStrLoadMesh(iWT)%Mesh(iBlade)%Force( 1:3,j) + StrucPts_2_Bld_Map(iWT)%BladeStrMeshCoords(iBlade)%Force(4:6,j) = BldStrLoadMesh(iWT)%Mesh(iBlade)%Moment(1:3,j) + enddo enddo end subroutine Set_OutputLoadArray @@ -1560,7 +2257,7 @@ subroutine WrVTK_refMeshes(rot_u, RefPoint, ErrStat, ErrMsg) integer(IntKi), intent( out) :: ErrStat !< error status character(ErrMsgLen), intent( out) :: ErrMsg !< error message integer(IntKi) :: nBlades - integer(IntKi) :: iWT, nWT, k + integer(IntKi) :: iWT, nWT, iBlade character(*), parameter :: RoutineName = 'WrVTK_refMeshes' !< for error handling integer(IntKi) :: ErrStat2 !< temporary error status character(ErrMsgLen) :: ErrMsg2 !< temporary error message @@ -1577,7 +2274,7 @@ subroutine WrVTK_refMeshes(rot_u, RefPoint, ErrStat, ErrMsg) else sWT = '.T'//trim(num2lstr(iWT)) endif - + select case (WrOutputsData%WrVTK_Type) case (1) ! surfaces -- don't write any surface references call WrVTK_PointsRef( ErrStat2,ErrMsg2); if (Failed()) return; @@ -1589,6 +2286,7 @@ subroutine WrVTK_refMeshes(rot_u, RefPoint, ErrStat, ErrMsg) call WrVTK_LinesRef( ErrStat2,ErrMsg2); if (Failed()) return; end select enddo + contains logical function Failed() CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -1603,20 +2301,22 @@ subroutine WrVTK_PointsRef(ErrStat3,ErrMsg3) ErrMsg3 = '' ! Blade point motion (structural mesh from driver) - call MeshWrVTKreference(RefPoint, BldPtMotionMesh, trim(WrOutputsData%VTK_OutFileRoot)//trim(sWT)//'.BldPtMotionMesh', ErrStat3, ErrMsg3) - if (ErrStat3 >= AbortErrLev) return + do iBlade=1,Sim%WT(iWT)%NumBlades + call MeshWrVTKreference(RefPoint, BldStrMotionMesh(iWT)%Mesh(iBlade), trim(WrOutputsData%VTK_OutFileRoot)//trim(sWT)//'.BldStrMotionMesh', ErrStat3, ErrMsg3) + if (ErrStat3 >= AbortErrLev) return + enddo ! Blade root motion (point only) if (allocated(rot_u(iWT)%BladeRootMotion)) then - do k=1,Sim%WT(1)%NumBlades - if (rot_u(iWT)%BladeRootMotion(k)%Committed) then - call MeshWrVTKreference(RefPoint, rot_u(iWT)%BladeRootMotion(k), trim(WrOutputsData%VTK_OutFileRoot)//trim(sWT)//'.BladeRootMotion'//trim(num2lstr(k)), ErrStat3, ErrMsg3 ) + do iBlade=1,Sim%WT(iWT)%NumBlades + if (rot_u(iWT)%BladeRootMotion(iBlade)%Committed) then + call MeshWrVTKreference(RefPoint, rot_u(iWT)%BladeRootMotion(iBlade), trim(WrOutputsData%VTK_OutFileRoot)//trim(sWT)//'.BladeRootMotion'//trim(num2lstr(iBlade)), ErrStat3, ErrMsg3 ) if (ErrStat3 >= AbortErrLev) return endif enddo endif - ! Nacelle (structural point input + ! Nacelle (structural point input) if ( rot_u(iWT)%NacelleMotion%Committed ) call MeshWrVTKreference(RefPoint, rot_u(iWT)%NacelleMotion, trim(WrOutputsData%VTK_OutFileRoot)//trim(sWT)//'.NacelleMotion', ErrStat3, ErrMsg3) if (ErrStat3 >= AbortErrLev) return end subroutine WrVTK_PointsRef @@ -1642,9 +2342,9 @@ subroutine WrVTK_LinesRef(ErrStat3,ErrMsg3) ! Blades if (allocated(rot_u(iWT)%BladeMotion)) then - do k=1,Sim%WT(1)%NumBlades - if (rot_u(iWT)%BladeMotion(k)%Committed) then - call MeshWrVTKreference(RefPoint, rot_u(iWT)%BladeMotion(k), trim(WrOutputsData%VTK_OutFileRoot)//trim(sWT)//'.Blade'//trim(num2lstr(k)), ErrStat3, ErrMsg3 ) + do iBlade=1,Sim%WT(iWT)%NumBlades + if (rot_u(iWT)%BladeMotion(iBlade)%Committed) then + call MeshWrVTKreference(RefPoint, rot_u(iWT)%BladeMotion(iBlade), trim(WrOutputsData%VTK_OutFileRoot)//trim(sWT)//'.Blade'//trim(num2lstr(iBlade)), ErrStat3, ErrMsg3 ) if (ErrStat3 >= AbortErrLev) return endif enddo @@ -1660,7 +2360,7 @@ subroutine WrVTK_Meshes(rot_u, RefPoint, ErrStat, ErrMsg) integer(IntKi), intent( out) :: ErrStat !< error status character(ErrMsgLen), intent( out) :: ErrMsg !< error message integer(IntKi) :: nBlades - integer(IntKi) :: iWT, nWT, k + integer(IntKi) :: iWT, nWT, iBlade character(IntfStrLen) :: TmpFileName character(*), parameter :: RoutineName = 'WrVTK_Meshes' !< for error handling integer(IntKi) :: ErrStat2 !< temporary error status @@ -1678,7 +2378,7 @@ subroutine WrVTK_Meshes(rot_u, RefPoint, ErrStat, ErrMsg) else sWT = '.T'//trim(num2lstr(iWT)) endif - + select case (WrOutputsData%WrVTK_Type) case (1) ! surfaces call WrVTK_Points( ErrStat2,ErrMsg2); if (Failed()) return; @@ -1708,27 +2408,29 @@ subroutine WrVTK_Points(ErrStat3,ErrMsg3) ErrMsg3 = '' ! Blade point motion (structural mesh from driver) - call MeshWrVTK(RefPoint, BldPtMotionMesh, trim(WrOutputsData%VTK_OutFileRoot)//trim(sWT)//'.BldPtMotionMesh', n_Global, .true., ErrStat3, ErrMsg3, WrOutputsData%VTK_tWidth) - if (ErrStat3 >= AbortErrLev) return + do iBlade=1,Sim%WT(iWT)%NumBlades + call MeshWrVTK(RefPoint, BldStrMotionMesh(iWT)%Mesh(iBlade), trim(WrOutputsData%VTK_OutFileRoot)//trim(sWT)//'.BldStrMotionMesh'//trim(num2lstr(iBlade)), n_VTK, .true., ErrStat3, ErrMsg3, WrOutputsData%VTK_tWidth) + if (ErrStat3 >= AbortErrLev) return + enddo ! Blade root motion (point only) if (allocated(rot_u(iWT)%BladeRootMotion)) then - do k=1,Sim%WT(1)%NumBlades - if (rot_u(iWT)%BladeRootMotion(k)%Committed) then - call MeshWrVTK(RefPoint, rot_u(iWT)%BladeRootMotion(k), trim(WrOutputsData%VTK_OutFileRoot)//trim(sWT)//'.BladeRootMotion'//trim(num2lstr(k)), n_Global, .true., ErrStat3, ErrMsg3, WrOutputsData%VTK_tWidth) + do iBlade=1,Sim%WT(iWT)%NumBlades + if (rot_u(iWT)%BladeRootMotion(iBlade)%Committed) then + call MeshWrVTK(RefPoint, rot_u(iWT)%BladeRootMotion(iBlade), trim(WrOutputsData%VTK_OutFileRoot)//trim(sWT)//'.BladeRootMotion'//trim(num2lstr(iBlade)), n_VTK, .true., ErrStat3, ErrMsg3, WrOutputsData%VTK_tWidth) if (ErrStat3 >= AbortErrLev) return endif enddo endif ! Nacelle (structural point input - if ( rot_u(iWT)%NacelleMotion%Committed ) call MeshWrVTK(RefPoint, rot_u(iWT)%NacelleMotion, trim(WrOutputsData%VTK_OutFileRoot)//trim(sWT)//'.NacelleMotion', n_Global, .true., ErrStat3, ErrMsg3, WrOutputsData%VTK_tWidth) + if ( rot_u(iWT)%NacelleMotion%Committed ) call MeshWrVTK(RefPoint, rot_u(iWT)%NacelleMotion, trim(WrOutputsData%VTK_OutFileRoot)//trim(sWT)//'.NacelleMotion', n_VTK, .true., ErrStat3, ErrMsg3, WrOutputsData%VTK_tWidth) if (ErrStat3 >= AbortErrLev) return ! Free wake if (allocated(ADI%m%AD%FVW_u) .and. iWT==1) then if (allocated(ADI%m%AD%FVW_u(1)%WingsMesh)) then - call WrVTK_FVW(ADI%p%AD%FVW, ADI%x(STATE_CURR)%AD%FVW, ADI%z(STATE_CURR)%AD%FVW, ADI%m%AD%FVW, trim(WrOutputsData%VTK_OutFileRoot)//'.FVW', n_Global, WrOutputsData%VTK_tWidth, bladeFrame=.FALSE.) ! bladeFrame==.FALSE. to output in global coords + call WrVTK_FVW(ADI%p%AD%FVW, ADI%x(STATE_CURR)%AD%FVW, ADI%z(STATE_CURR)%AD%FVW, ADI%m%AD%FVW, trim(WrOutputsData%VTK_OutFileRoot)//'.FVW', n_VTK, WrOutputsData%VTK_tWidth, bladeFrame=.FALSE.) ! bladeFrame==.FALSE. to output in global coords endif end if end subroutine WrVTK_Points @@ -1743,12 +2445,12 @@ subroutine WrVTK_Surfaces(ErrStat3,ErrMsg3) ErrStat3 = 0_IntKi ErrMsg3 = '' -!TODO: use this routine when it is moved out of the driver and into ADI -! call AD_WrVTK_Surfaces(ADI%u(1)%AD, ADI%y%AD, RefPoint, ADI%m%VTK_Surfaces, n_Global, WrOutputsData%Root, WrOutputsData%VTK_tWidth, 25, WrOutputsData%VTKHubRad) + ! TODO: use this routine when it is moved out of the driver and into ADI + ! call AD_WrVTK_Surfaces(ADI%u(1)%AD, ADI%y%AD, RefPoint, ADI%m%VTK_Surfaces, n_VTK, WrOutputsData%Root, WrOutputsData%VTK_tWidth, 25, WrOutputsData%VTKHubRad) ! Nacelle if ( rot_u(iWT)%NacelleMotion%Committed ) then - call MeshWrVTK_PointSurface (RefPoint, rot_u(iWT)%NacelleMotion, trim(WrOutputsData%VTK_OutFileRoot)//trim(sWT)//'.NacelleSurface', n_Global, & + call MeshWrVTK_PointSurface (RefPoint, rot_u(iWT)%NacelleMotion, trim(WrOutputsData%VTK_OutFileRoot)//trim(sWT)//'.NacelleSurface', n_VTK, & OutputFields, errStat3, errMsg3, WrOutputsData%VTK_tWidth, verts=WrOutputsData%VTK_Surface(iWT)%NacelleBox) if (ErrStat3 >= AbortErrLev) return endif @@ -1756,25 +2458,25 @@ subroutine WrVTK_Surfaces(ErrStat3,ErrMsg3) ! Tower if (rot_u(iWT)%TowerMotion%Committed) then call MeshWrVTK_Ln2Surface (RefPoint, rot_u(iWT)%TowerMotion, trim(WrOutputsData%VTK_OutFileRoot)//trim(sWT)//'.TowerSurface', & - n_Global, OutputFields, errStat3, errMsg3, WrOutputsData%VTK_tWidth, numSectors, ADI%m%VTK_Surfaces(iWT)%TowerRad ) + n_VTK, OutputFields, errStat3, errMsg3, WrOutputsData%VTK_tWidth, numSectors, ADI%m%VTK_Surfaces(iWT)%TowerRad ) if (ErrStat3 >= AbortErrLev) return endif ! Hub if (rot_u(iWT)%HubMotion%Committed) then call MeshWrVTK_PointSurface (RefPoint, rot_u(iWT)%HubMotion, trim(WrOutputsData%VTK_OutFileRoot)//trim(sWT)//'.HubSurface', & - n_Global, OutputFields, errStat3, errMsg3, WrOutputsData%VTK_tWidth, & + n_VTK, OutputFields, errStat3, errMsg3, WrOutputsData%VTK_tWidth, & NumSegments=numSectors, radius=WrOutputsData%VTKHubRad) if (ErrStat3 >= AbortErrLev) return endif ! Blades if (allocated(rot_u(iWT)%BladeMotion)) then - do k=1,Sim%WT(1)%NumBlades - if (rot_u(iWT)%BladeMotion(k)%Committed) then - call MeshWrVTK_Ln2Surface (RefPoint, rot_u(iWT)%BladeMotion(k), trim(WrOutputsData%VTK_OutFileRoot)//trim(sWT)//'.Blade'//trim(num2lstr(k))//'Surface', & - n_Global, OutputFields, errStat3, errMsg3, WrOutputsData%VTK_tWidth , verts=ADI%m%VTK_Surfaces(iWT)%BladeShape(k)%AirfoilCoords, & - Sib=ADI%y%AD%rotors(iWT)%BladeLoad(k) ) + do iBlade=1,Sim%WT(iWT)%NumBlades + if (rot_u(iWT)%BladeMotion(iBlade)%Committed) then + call MeshWrVTK_Ln2Surface (RefPoint, rot_u(iWT)%BladeMotion(iBlade), trim(WrOutputsData%VTK_OutFileRoot)//trim(sWT)//'.Blade'//trim(num2lstr(iBlade))//'Surface', & + n_VTK, OutputFields, errStat3, errMsg3, WrOutputsData%VTK_tWidth , verts=ADI%m%VTK_Surfaces(iWT)%BladeShape(iBlade)%AirfoilCoords, & + Sib=ADI%y%AD%rotors(iWT)%BladeLoad(iBlade) ) if (ErrStat3 >= AbortErrLev) return endif enddo @@ -1789,22 +2491,22 @@ subroutine WrVTK_Lines(ErrStat3,ErrMsg3) ErrMsg3 = '' ! Tower - if (rot_u(iWT)%TowerMotion%Committed) call MeshWrVTK(RefPoint, rot_u(iWT)%TowerMotion, trim(WrOutputsData%VTK_OutFileRoot)//trim(sWT)//'.Tower', n_Global, .true., ErrStat3, ErrMsg3, WrOutputsData%VTK_tWidth) + if (rot_u(iWT)%TowerMotion%Committed) call MeshWrVTK(RefPoint, rot_u(iWT)%TowerMotion, trim(WrOutputsData%VTK_OutFileRoot)//trim(sWT)//'.Tower', n_VTK, .true., ErrStat3, ErrMsg3, WrOutputsData%VTK_tWidth) if (ErrStat3 >= AbortErrLev) return ! Nacelle meshes - if (rot_u(iWT)%NacelleMotion%Committed) call MeshWrVTK(RefPoint, rot_u(iWT)%NacelleMotion, trim(WrOutputsData%VTK_OutFileRoot)//trim(sWT)//'.Nacelle', n_Global, .true., ErrStat3, ErrMsg3, WrOutputsData%VTK_tWidth) + if (rot_u(iWT)%NacelleMotion%Committed) call MeshWrVTK(RefPoint, rot_u(iWT)%NacelleMotion, trim(WrOutputsData%VTK_OutFileRoot)//trim(sWT)//'.Nacelle', n_VTK, .true., ErrStat3, ErrMsg3, WrOutputsData%VTK_tWidth) if (ErrStat3 >= AbortErrLev) return ! Hub - if (rot_u(iWT)%HubMotion%Committed) call MeshWrVTK(RefPoint, rot_u(iWT)%HubMotion, trim(WrOutputsData%VTK_OutFileRoot)//trim(sWT)//'.Hub', n_Global, .true., ErrStat3, ErrMsg3, WrOutputsData%VTK_tWidth) + if (rot_u(iWT)%HubMotion%Committed) call MeshWrVTK(RefPoint, rot_u(iWT)%HubMotion, trim(WrOutputsData%VTK_OutFileRoot)//trim(sWT)//'.Hub', n_VTK, .true., ErrStat3, ErrMsg3, WrOutputsData%VTK_tWidth) if (ErrStat3 >= AbortErrLev) return ! Blades if (allocated(rot_u(iWT)%BladeMotion)) then - do k=1,Sim%WT(1)%NumBlades - if (rot_u(iWT)%BladeMotion(k)%Committed) then - call MeshWrVTK(RefPoint, rot_u(iWT)%BladeMotion(k), trim(WrOutputsData%VTK_OutFileRoot)//trim(sWT)//'.Blade'//trim(num2lstr(k)), n_Global, .true., ErrStat3, ErrMsg3, WrOutputsData%VTK_tWidth) + do iBlade=1,Sim%WT(iWT)%NumBlades + if (rot_u(iWT)%BladeMotion(iBlade)%Committed) then + call MeshWrVTK(RefPoint, rot_u(iWT)%BladeMotion(iBlade), trim(WrOutputsData%VTK_OutFileRoot)//trim(sWT)//'.Blade'//trim(num2lstr(iBlade)), n_VTK, .true., ErrStat3, ErrMsg3, WrOutputsData%VTK_tWidth) if (ErrStat3 >= AbortErrLev) return endif enddo @@ -1834,7 +2536,7 @@ subroutine WrVTK_Ground (RefPoint, HalfLengths, FileRootName, errStat, errMsg) errStat = ErrID_None errMsg = "" FileName = TRIM(FileRootName)//'.vtp' - call WrVTK_header( FileName, NumberOfPoints, NumberOfLines, NumberOfPolys, Un, errStat2, errMsg2 ) + call WrVTK_header( FileName, NumberOfPoints, NumberOfLines, NumberOfPolys, Un, errStat2, errMsg2 ) call SetErrStat(errStat2,errMsg2,errStat,errMsg,'WrVTK_Ground'); if (errStat >= AbortErrLev) return WRITE(Un,'(A)') ' ' WRITE(Un,'(A)') ' ' @@ -1844,18 +2546,85 @@ subroutine WrVTK_Ground (RefPoint, HalfLengths, FileRootName, errStat, errMsg) WRITE(Un,VTK_AryFmt) RefPoint(1) - HalfLengths(1) , RefPoint(2) + HalfLengths(2), RefPoint(3) WRITE(Un,'(A)') ' ' WRITE(Un,'(A)') ' ' - WRITE(Un,'(A)') ' ' - WRITE(Un,'(A)') ' ' - WRITE(Un,'('//trim(num2lstr(NumberOfPoints))//'(i7))') (ix, ix=0,NumberOfPoints-1) - WRITE(Un,'(A)') ' ' - - WRITE(Un,'(A)') ' ' + WRITE(Un,'(A)') ' ' + WRITE(Un,'(A)') ' ' + WRITE(Un,'('//trim(num2lstr(NumberOfPoints))//'(i7))') (ix, ix=0,NumberOfPoints-1) + WRITE(Un,'(A)') ' ' + + WRITE(Un,'(A)') ' ' WRITE(Un,'(i7)') NumberOfPoints WRITE(Un,'(A)') ' ' - WRITE(Un,'(A)') ' ' - call WrVTK_footer( Un ) + WRITE(Un,'(A)') ' ' + call WrVTK_footer( Un ) end subroutine WrVTK_Ground +!-------------------------------------------------------------------- +!> Set some temporary data storage arrays to simplify data conversion +subroutine SetTempStorage(ErrStat,ErrMsg) + INTEGER(IntKi), intent(out) :: errStat !< Indicates whether an error occurred (see NWTC_Library) + character(*), intent(out) :: errMsg !< Error message associated with the errStat + INTEGER(IntKi) :: errStat2 + CHARACTER(ErrMsgLen) :: errMsg2 + character(*), parameter :: RoutineName = 'SetTempStorage' !< for error handling + ErrStat = ErrID_None + ErrMsg = "" + if (.not. allocated(NumMeshPts)) then + ErrStat = ErrID_Fatal + ErrMSg = "Pre-Init has not been called yet" + return + endif + if (minval(NumMeshPts) < 0) then + ErrStat = ErrID_Fatal + ErrMSg = "ADI_C_SetupRotor haven't been called for all rotors" + return + endif + +contains + logical function Failed() + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + Failed = ErrStat >= AbortErrLev + end function Failed +end subroutine SetTempStorage + +!-------------------------------------------------------------------- +!> Don't leave junk in memory. So destroy meshes and mappings. +subroutine ClearTmpStorage() + INTEGER(IntKi) :: errStat2, iWT + CHARACTER(ErrMsgLen) :: errMsg2 + ! Meshes + do iWT=1,Sim%NumTurbines + if (allocated(BldStrMotionMesh(iWT)%Mesh)) call ClearMeshArr1(BldStrMotionMesh(iWT)%Mesh) + if (allocated(BldStrLoadMesh(iWT)%Mesh)) call ClearMeshArr1(BldStrLoadMesh(iWT)%Mesh) + if (allocated(BldStrLoadMesh_tmp(iWT)%Mesh)) call ClearMeshArr1(BldStrLoadMesh_tmp(iWT)%Mesh) + enddo + ! if (allocated(NacMotionMesh )) call ClearMeshArr1(NacMotionMesh ) + ! if (allocated(NacLoadMesh )) call ClearMeshArr1(NacLoadMesh ) + if (allocated(Map_BldStrMotion_2_AD_Blade )) call ClearMeshMapArr2(Map_BldStrMotion_2_AD_Blade ) + ! other stuff + if (allocated(DiskAvgVelVars)) deallocate(DiskAvgVelVars) +contains + subroutine ClearMeshArr1(MeshName) + type(MeshType), allocatable :: MeshName(:) + integer :: i + do i=1,size(MeshName) + call MeshDestroy( MeshName(i), ErrStat2, ErrMsg2 ) ! ignore errors + enddo + deallocate(MeshName) + end subroutine ClearMeshArr1 + + subroutine ClearMeshMapArr2(MapName) + type(MeshMapType), allocatable :: MapName(:,:) + integer :: i,j + do j=1,size(MapName,2) + do i=1,size(MapName,1) + call NWTC_Library_Destroymeshmaptype( MapName(i,j), ErrStat2, ErrMsg2 ) + enddo + enddo + deallocate(MapName) + end subroutine ClearMeshMapArr2 + +end subroutine ClearTmpStorage + END MODULE AeroDyn_Inflow_C_BINDING diff --git a/modules/aerodyn/src/AeroDyn_Inflow_Registry.txt b/modules/aerodyn/src/AeroDyn_Inflow_Registry.txt index f47582f5fd..678ea45947 100644 --- a/modules/aerodyn/src/AeroDyn_Inflow_Registry.txt +++ b/modules/aerodyn/src/AeroDyn_Inflow_Registry.txt @@ -37,8 +37,9 @@ typedef ^ ^ ReKi HWindSpe typedef ^ ^ ReKi RefHt - - - "RefHeight" typedef ^ ^ ReKi PLExp - - - "PLExp" typedef ^ ^ IntKi MHK - - - "MHK turbine type switch" - -typedef ^ ^ LOGICAL UseInputFile - .TRUE. - "Should we read everthing from an input file, or is it passed in?" - -typedef ^ ^ FileInfoType PassedFileData - - - "If we don't use the input file, pass everything through this" - +typedef ^ ^ IntKi FilePassingMethod - 0 - "Should we read everthing from an input file (0), passed in as a FileInfoType structure (1), or passed as the IfW_InputFile structure (2)" - +typedef ^ ^ FileInfoType PassedFileInfo - - - "If we don't use the input file, pass everything through this as a FileInfo structure" - +typedef ^ ^ InflowWind_InputFile PassedFileData - - - "If we don't use the input file, pass everything through this as an IfW InputFile structure" - typedef ^ ^ LOGICAL Linearize - .FALSE. - "Flag that tells this module if the glue code wants to linearize." - diff --git a/modules/aerodyn/src/AeroDyn_Inflow_Types.f90 b/modules/aerodyn/src/AeroDyn_Inflow_Types.f90 index 9151ebda88..295764d98a 100644 --- a/modules/aerodyn/src/AeroDyn_Inflow_Types.f90 +++ b/modules/aerodyn/src/AeroDyn_Inflow_Types.f90 @@ -32,7 +32,6 @@ MODULE AeroDyn_Inflow_Types !--------------------------------------------------------------------------------------------------------------------------------- USE AeroDyn_Types -USE InflowWind_Types USE NWTC_Library IMPLICIT NONE INTEGER(IntKi), PUBLIC, PARAMETER :: ADI_Version = 1 ! [-] @@ -46,22 +45,23 @@ MODULE AeroDyn_Inflow_Types TYPE(InflowWind_MiscVarType) :: m !< Misc/optimization variables [-] TYPE(InflowWind_InputType) :: u !< Array of inputs associated with InputTimes [-] TYPE(InflowWind_OutputType) :: y !< System outputs [-] - INTEGER(IntKi) :: CompInflow !< 0=Steady Wind, 1=InflowWind [-] - REAL(ReKi) :: HWindSpeed !< RefHeight Wind speed [-] - REAL(ReKi) :: RefHt !< RefHeight [-] - REAL(ReKi) :: PLExp !< PLExp [-] + INTEGER(IntKi) :: CompInflow = 0_IntKi !< 0=Steady Wind, 1=InflowWind [-] + REAL(ReKi) :: HWindSpeed = 0.0_ReKi !< RefHeight Wind speed [-] + REAL(ReKi) :: RefHt = 0.0_ReKi !< RefHeight [-] + REAL(ReKi) :: PLExp = 0.0_ReKi !< PLExp [-] END TYPE ADI_InflowWindData ! ======================= ! ========= ADI_IW_InputData ======= TYPE, PUBLIC :: ADI_IW_InputData Character(1024) :: InputFile !< Name of InfloWind input file [-] - INTEGER(IntKi) :: CompInflow !< 0=Steady Wind, 1=InflowWind [-] - REAL(ReKi) :: HWindSpeed !< RefHeight Wind speed [-] - REAL(ReKi) :: RefHt !< RefHeight [-] - REAL(ReKi) :: PLExp !< PLExp [-] - INTEGER(IntKi) :: MHK !< MHK turbine type switch [-] - LOGICAL :: UseInputFile = .TRUE. !< Should we read everthing from an input file, or is it passed in? [-] - TYPE(FileInfoType) :: PassedFileData !< If we don't use the input file, pass everything through this [-] + INTEGER(IntKi) :: CompInflow = 0_IntKi !< 0=Steady Wind, 1=InflowWind [-] + REAL(ReKi) :: HWindSpeed = 0.0_ReKi !< RefHeight Wind speed [-] + REAL(ReKi) :: RefHt = 0.0_ReKi !< RefHeight [-] + REAL(ReKi) :: PLExp = 0.0_ReKi !< PLExp [-] + INTEGER(IntKi) :: MHK = 0_IntKi !< MHK turbine type switch [-] + INTEGER(IntKi) :: FilePassingMethod = 0 !< Should we read everthing from an input file (0), passed in as a FileInfoType structure (1), or passed as the IfW_InputFile structure (2) [-] + TYPE(FileInfoType) :: PassedFileInfo !< If we don't use the input file, pass everything through this as a FileInfo structure [-] + TYPE(InflowWind_InputFile) :: PassedFileData !< If we don't use the input file, pass everything through this as an IfW InputFile structure [-] LOGICAL :: Linearize = .FALSE. !< Flag that tells this module if the glue code wants to linearize. [-] END TYPE ADI_IW_InputData ! ======================= @@ -73,7 +73,7 @@ MODULE AeroDyn_Inflow_Types LOGICAL :: storeHHVel = .false. !< If True, hub height velocity will be computed by infow wind [-] INTEGER(IntKi) :: WrVTK = 0 !< 0= no vtk, 1=init only, 2=animation [-] INTEGER(IntKi) :: WrVTK_Type = 1 !< Flag for VTK output type (1=surface, 2=line, 3=both) [-] - REAL(ReKi) :: WtrDpth !< Water depth [m] + REAL(ReKi) :: WtrDpth = 0.0_ReKi !< Water depth [m] END TYPE ADI_InitInputType ! ======================= ! ========= ADI_InitOutputType ======= @@ -113,13 +113,13 @@ MODULE AeroDyn_Inflow_Types ! ========= ADI_ParameterType ======= TYPE, PUBLIC :: ADI_ParameterType TYPE(AD_ParameterType) :: AD !< Parameters [-] - REAL(DbKi) :: dt !< time increment [s] - LOGICAL :: storeHHVel !< If True, hub height velocity will be computed by infow wind [-] - INTEGER(IntKi) :: wrVTK !< 0= no vtk, 1=init only, 2=animation [-] - INTEGER(IntKi) :: WrVTK_Type !< Flag for VTK output type (1=surface, 2=line, 3=both) [-] + REAL(DbKi) :: dt = 0.0_R8Ki !< time increment [s] + LOGICAL :: storeHHVel = .false. !< If True, hub height velocity will be computed by infow wind [-] + INTEGER(IntKi) :: wrVTK = 0_IntKi !< 0= no vtk, 1=init only, 2=animation [-] + INTEGER(IntKi) :: WrVTK_Type = 0_IntKi !< Flag for VTK output type (1=surface, 2=line, 3=both) [-] INTEGER(IntKi) :: NumOuts = 0 !< Total number of WriteOutput outputs [-] - INTEGER(IntKi) :: MHK !< MHK turbine type switch [-] - REAL(ReKi) :: WtrDpth !< Water depth [m] + INTEGER(IntKi) :: MHK = 0_IntKi !< MHK turbine type switch [-] + REAL(ReKi) :: WtrDpth = 0.0_ReKi !< Water depth [m] END TYPE ADI_ParameterType ! ======================= ! ========= ADI_InputType ======= @@ -131,7 +131,7 @@ MODULE AeroDyn_Inflow_Types TYPE, PUBLIC :: ADI_OutputType TYPE(AD_OutputType) :: AD !< System outputs [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: HHVel !< Hub Height velocities for each rotors [-] - REAL(ReKi) :: PLExp !< Power law exponents (for outputs only) [-] + REAL(ReKi) :: PLExp = 0.0_ReKi !< Power law exponents (for outputs only) [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: IW_WriteOutput !< WriteOutputs for inflow wind [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: WriteOutput !< System outputs [-] END TYPE ADI_OutputType @@ -160,7 +160,7 @@ MODULE AeroDyn_Inflow_Types TYPE(MeshType) , DIMENSION(:), ALLOCATABLE :: BladeLn2Mesh !< (only if elastic blades) BladeLn2Mesh Line mesh along blade [-] LOGICAL :: hasTower = .true. !< True if a tower is present [-] LOGICAL :: rigidBlades = .true. !< True if blades are rigid (using BladeRootMotion) or not (Useing BldeLn2Mesh) [-] - INTEGER(IntKi) :: numBlades !< Number of blades [-] + INTEGER(IntKi) :: numBlades = 0_IntKi !< Number of blades [-] TYPE(MeshMapType) :: ED_P_2_AD_P_T !< (only if hasTower) Mesh mapping from tower base to AD tower base [-] TYPE(MeshMapType) :: AD_P_2_AD_L_T !< (only if hasTower) Mesh mapping from tower base to AD tower line [-] TYPE(MeshMapType) , DIMENSION(:), ALLOCATABLE :: AD_P_2_AD_L_B !< (only for rigid blades) Mesh mapping from AD blade root to AD line mesh [-] @@ -176,7150 +176,1586 @@ MODULE AeroDyn_Inflow_Types END TYPE FED_Data ! ======================= CONTAINS - SUBROUTINE ADI_CopyInflowWindData( SrcInflowWindDataData, DstInflowWindDataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ADI_InflowWindData), INTENT(IN) :: SrcInflowWindDataData - TYPE(ADI_InflowWindData), INTENT(INOUT) :: DstInflowWindDataData - 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 = 'ADI_CopyInflowWindData' -! - ErrStat = ErrID_None - ErrMsg = "" - CALL InflowWind_CopyContState( SrcInflowWindDataData%x, DstInflowWindDataData%x, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL InflowWind_CopyDiscState( SrcInflowWindDataData%xd, DstInflowWindDataData%xd, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL InflowWind_CopyConstrState( SrcInflowWindDataData%z, DstInflowWindDataData%z, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL InflowWind_CopyOtherState( SrcInflowWindDataData%OtherSt, DstInflowWindDataData%OtherSt, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL InflowWind_CopyParam( SrcInflowWindDataData%p, DstInflowWindDataData%p, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL InflowWind_CopyMisc( SrcInflowWindDataData%m, DstInflowWindDataData%m, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL InflowWind_CopyInput( SrcInflowWindDataData%u, DstInflowWindDataData%u, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL InflowWind_CopyOutput( SrcInflowWindDataData%y, DstInflowWindDataData%y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstInflowWindDataData%CompInflow = SrcInflowWindDataData%CompInflow - DstInflowWindDataData%HWindSpeed = SrcInflowWindDataData%HWindSpeed - DstInflowWindDataData%RefHt = SrcInflowWindDataData%RefHt - DstInflowWindDataData%PLExp = SrcInflowWindDataData%PLExp - END SUBROUTINE ADI_CopyInflowWindData - - SUBROUTINE ADI_DestroyInflowWindData( InflowWindDataData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(ADI_InflowWindData), INTENT(INOUT) :: InflowWindDataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ADI_DestroyInflowWindData' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL InflowWind_DestroyContState( InflowWindDataData%x, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL InflowWind_DestroyDiscState( InflowWindDataData%xd, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL InflowWind_DestroyConstrState( InflowWindDataData%z, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL InflowWind_DestroyOtherState( InflowWindDataData%OtherSt, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL InflowWind_DestroyParam( InflowWindDataData%p, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL InflowWind_DestroyMisc( InflowWindDataData%m, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL InflowWind_DestroyInput( InflowWindDataData%u, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL InflowWind_DestroyOutput( InflowWindDataData%y, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE ADI_DestroyInflowWindData - - SUBROUTINE ADI_PackInflowWindData( 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(ADI_InflowWindData), 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 = 'ADI_PackInflowWindData' - ! 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 ! x: size of buffers for each call to pack subtype - CALL InflowWind_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x, ErrStat2, ErrMsg2, .TRUE. ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype - CALL InflowWind_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd, ErrStat2, ErrMsg2, .TRUE. ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xd - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype - CALL InflowWind_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z, ErrStat2, ErrMsg2, .TRUE. ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! z - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! z - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! z - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! OtherSt: size of buffers for each call to pack subtype - CALL InflowWind_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt, ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype - CALL InflowWind_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! p - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! p - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! p - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype - CALL InflowWind_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! m - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! m - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! m - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype - CALL InflowWind_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype - CALL InflowWind_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! CompInflow - Re_BufSz = Re_BufSz + 1 ! HWindSpeed - Re_BufSz = Re_BufSz + 1 ! RefHt - Re_BufSz = Re_BufSz + 1 ! PLExp - 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 InflowWind_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x, ErrStat2, ErrMsg2, OnlySize ) ! x - 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 InflowWind_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd, ErrStat2, ErrMsg2, OnlySize ) ! xd - 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 InflowWind_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z, ErrStat2, ErrMsg2, OnlySize ) ! z - 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 InflowWind_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt, ErrStat2, ErrMsg2, OnlySize ) ! OtherSt - 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 InflowWind_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! p - 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 InflowWind_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! m - 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 InflowWind_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u - 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 InflowWind_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y - 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%CompInflow - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%HWindSpeed - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RefHt - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PLExp - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE ADI_PackInflowWindData - - SUBROUTINE ADI_UnPackInflowWindData( 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(ADI_InflowWindData), 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 = 'ADI_UnPackInflowWindData' - ! 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 InflowWind_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x, ErrStat2, ErrMsg2 ) ! x - 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 InflowWind_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd, ErrStat2, ErrMsg2 ) ! xd - 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 InflowWind_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z, ErrStat2, ErrMsg2 ) ! z - 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 InflowWind_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt, ErrStat2, ErrMsg2 ) ! OtherSt - 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 InflowWind_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p - 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 InflowWind_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! m - 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 InflowWind_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u - 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 InflowWind_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y - 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%CompInflow = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%HWindSpeed = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RefHt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PLExp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE ADI_UnPackInflowWindData - - SUBROUTINE ADI_CopyIW_InputData( SrcIW_InputDataData, DstIW_InputDataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ADI_IW_InputData), INTENT(IN) :: SrcIW_InputDataData - TYPE(ADI_IW_InputData), INTENT(INOUT) :: DstIW_InputDataData - 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 = 'ADI_CopyIW_InputData' -! +subroutine ADI_CopyInflowWindData(SrcInflowWindDataData, DstInflowWindDataData, CtrlCode, ErrStat, ErrMsg) + type(ADI_InflowWindData), intent(in) :: SrcInflowWindDataData + type(ADI_InflowWindData), intent(inout) :: DstInflowWindDataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ADI_CopyInflowWindData' ErrStat = ErrID_None - ErrMsg = "" - DstIW_InputDataData%InputFile = SrcIW_InputDataData%InputFile - DstIW_InputDataData%CompInflow = SrcIW_InputDataData%CompInflow - DstIW_InputDataData%HWindSpeed = SrcIW_InputDataData%HWindSpeed - DstIW_InputDataData%RefHt = SrcIW_InputDataData%RefHt - DstIW_InputDataData%PLExp = SrcIW_InputDataData%PLExp - DstIW_InputDataData%MHK = SrcIW_InputDataData%MHK - DstIW_InputDataData%UseInputFile = SrcIW_InputDataData%UseInputFile - CALL NWTC_Library_Copyfileinfotype( SrcIW_InputDataData%PassedFileData, DstIW_InputDataData%PassedFileData, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstIW_InputDataData%Linearize = SrcIW_InputDataData%Linearize - END SUBROUTINE ADI_CopyIW_InputData - - SUBROUTINE ADI_DestroyIW_InputData( IW_InputDataData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(ADI_IW_InputData), INTENT(INOUT) :: IW_InputDataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ADI_DestroyIW_InputData' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL NWTC_Library_Destroyfileinfotype( IW_InputDataData%PassedFileData, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE ADI_DestroyIW_InputData - - SUBROUTINE ADI_PackIW_InputData( 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(ADI_IW_InputData), 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 = 'ADI_PackIW_InputData' - ! 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 ! CompInflow - Re_BufSz = Re_BufSz + 1 ! HWindSpeed - Re_BufSz = Re_BufSz + 1 ! RefHt - Re_BufSz = Re_BufSz + 1 ! PLExp - Int_BufSz = Int_BufSz + 1 ! MHK - Int_BufSz = Int_BufSz + 1 ! UseInputFile - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! PassedFileData: size of buffers for each call to pack subtype - CALL NWTC_Library_Packfileinfotype( Re_Buf, Db_Buf, Int_Buf, InData%PassedFileData, ErrStat2, ErrMsg2, .TRUE. ) ! PassedFileData - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! PassedFileData - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! PassedFileData - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! PassedFileData - 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%InputFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%InputFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = InData%CompInflow - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%HWindSpeed - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RefHt - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PLExp - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%MHK - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%UseInputFile, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - CALL NWTC_Library_Packfileinfotype( Re_Buf, Db_Buf, Int_Buf, InData%PassedFileData, ErrStat2, ErrMsg2, OnlySize ) ! PassedFileData - 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 ADI_PackIW_InputData - - SUBROUTINE ADI_UnPackIW_InputData( 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(ADI_IW_InputData), 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 = 'ADI_UnPackIW_InputData' - ! 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%CompInflow = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%HWindSpeed = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RefHt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PLExp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MHK = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - 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%PassedFileData, ErrStat2, ErrMsg2 ) ! PassedFileData - 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 ADI_UnPackIW_InputData - - SUBROUTINE ADI_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ADI_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(ADI_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 = 'ADI_CopyInitInput' -! + ErrMsg = '' + call InflowWind_CopyContState(SrcInflowWindDataData%x, DstInflowWindDataData%x, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call InflowWind_CopyDiscState(SrcInflowWindDataData%xd, DstInflowWindDataData%xd, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call InflowWind_CopyConstrState(SrcInflowWindDataData%z, DstInflowWindDataData%z, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call InflowWind_CopyOtherState(SrcInflowWindDataData%OtherSt, DstInflowWindDataData%OtherSt, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call InflowWind_CopyParam(SrcInflowWindDataData%p, DstInflowWindDataData%p, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call InflowWind_CopyMisc(SrcInflowWindDataData%m, DstInflowWindDataData%m, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call InflowWind_CopyInput(SrcInflowWindDataData%u, DstInflowWindDataData%u, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call InflowWind_CopyOutput(SrcInflowWindDataData%y, DstInflowWindDataData%y, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstInflowWindDataData%CompInflow = SrcInflowWindDataData%CompInflow + DstInflowWindDataData%HWindSpeed = SrcInflowWindDataData%HWindSpeed + DstInflowWindDataData%RefHt = SrcInflowWindDataData%RefHt + DstInflowWindDataData%PLExp = SrcInflowWindDataData%PLExp +end subroutine + +subroutine ADI_DestroyInflowWindData(InflowWindDataData, ErrStat, ErrMsg) + type(ADI_InflowWindData), intent(inout) :: InflowWindDataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ADI_DestroyInflowWindData' ErrStat = ErrID_None - ErrMsg = "" - CALL AD_CopyInitInput( SrcInitInputData%AD, DstInitInputData%AD, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL ADI_Copyiw_inputdata( SrcInitInputData%IW_InitInp, DstInitInputData%IW_InitInp, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstInitInputData%RootName = SrcInitInputData%RootName - DstInitInputData%storeHHVel = SrcInitInputData%storeHHVel - DstInitInputData%WrVTK = SrcInitInputData%WrVTK - DstInitInputData%WrVTK_Type = SrcInitInputData%WrVTK_Type - DstInitInputData%WtrDpth = SrcInitInputData%WtrDpth - END SUBROUTINE ADI_CopyInitInput - - SUBROUTINE ADI_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(ADI_InitInputType), INTENT(INOUT) :: InitInputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ADI_DestroyInitInput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL AD_DestroyInitInput( InitInputData%AD, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL ADI_Destroyiw_inputdata( InitInputData%IW_InitInp, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE ADI_DestroyInitInput - - SUBROUTINE ADI_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(ADI_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 = 'ADI_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 ! AD: size of buffers for each call to pack subtype - CALL AD_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%AD, ErrStat2, ErrMsg2, .TRUE. ) ! AD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! AD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! AD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! AD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! IW_InitInp: size of buffers for each call to pack subtype - CALL ADI_Packiw_inputdata( Re_Buf, Db_Buf, Int_Buf, InData%IW_InitInp, ErrStat2, ErrMsg2, .TRUE. ) ! IW_InitInp - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! IW_InitInp - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! IW_InitInp - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! IW_InitInp - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1*LEN(InData%RootName) ! RootName - Int_BufSz = Int_BufSz + 1 ! storeHHVel - Int_BufSz = Int_BufSz + 1 ! WrVTK - Int_BufSz = Int_BufSz + 1 ! WrVTK_Type - Re_BufSz = Re_BufSz + 1 ! WtrDpth - 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 AD_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%AD, ErrStat2, ErrMsg2, OnlySize ) ! AD - 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 ADI_Packiw_inputdata( Re_Buf, Db_Buf, Int_Buf, InData%IW_InitInp, ErrStat2, ErrMsg2, OnlySize ) ! IW_InitInp - 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%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = TRANSFER(InData%storeHHVel, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%WrVTK - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%WrVTK_Type - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WtrDpth - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE ADI_PackInitInput - - SUBROUTINE ADI_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(ADI_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 = 'ADI_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 AD_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%AD, ErrStat2, ErrMsg2 ) ! AD - 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 ADI_Unpackiw_inputdata( Re_Buf, Db_Buf, Int_Buf, OutData%IW_InitInp, ErrStat2, ErrMsg2 ) ! IW_InitInp - 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%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%storeHHVel = TRANSFER(IntKiBuf(Int_Xferred), OutData%storeHHVel) - Int_Xferred = Int_Xferred + 1 - OutData%WrVTK = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WrVTK_Type = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WtrDpth = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE ADI_UnPackInitInput - - SUBROUTINE ADI_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ADI_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(ADI_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 = 'ADI_CopyInitOutput' -! + ErrMsg = '' + call InflowWind_DestroyContState(InflowWindDataData%x, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call InflowWind_DestroyDiscState(InflowWindDataData%xd, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call InflowWind_DestroyConstrState(InflowWindDataData%z, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call InflowWind_DestroyOtherState(InflowWindDataData%OtherSt, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call InflowWind_DestroyParam(InflowWindDataData%p, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call InflowWind_DestroyMisc(InflowWindDataData%m, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call InflowWind_DestroyInput(InflowWindDataData%u, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call InflowWind_DestroyOutput(InflowWindDataData%y, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine ADI_PackInflowWindData(RF, Indata) + type(RegFile), intent(inout) :: RF + type(ADI_InflowWindData), intent(in) :: InData + character(*), parameter :: RoutineName = 'ADI_PackInflowWindData' + if (RF%ErrStat >= AbortErrLev) return + call InflowWind_PackContState(RF, InData%x) + call InflowWind_PackDiscState(RF, InData%xd) + call InflowWind_PackConstrState(RF, InData%z) + call InflowWind_PackOtherState(RF, InData%OtherSt) + call InflowWind_PackParam(RF, InData%p) + call InflowWind_PackMisc(RF, InData%m) + call InflowWind_PackInput(RF, InData%u) + call InflowWind_PackOutput(RF, InData%y) + call RegPack(RF, InData%CompInflow) + call RegPack(RF, InData%HWindSpeed) + call RegPack(RF, InData%RefHt) + call RegPack(RF, InData%PLExp) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ADI_UnPackInflowWindData(RF, OutData) + type(RegFile), intent(inout) :: RF + type(ADI_InflowWindData), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ADI_UnPackInflowWindData' + if (RF%ErrStat /= ErrID_None) return + call InflowWind_UnpackContState(RF, OutData%x) ! x + call InflowWind_UnpackDiscState(RF, OutData%xd) ! xd + call InflowWind_UnpackConstrState(RF, OutData%z) ! z + call InflowWind_UnpackOtherState(RF, OutData%OtherSt) ! OtherSt + call InflowWind_UnpackParam(RF, OutData%p) ! p + call InflowWind_UnpackMisc(RF, OutData%m) ! m + call InflowWind_UnpackInput(RF, OutData%u) ! u + call InflowWind_UnpackOutput(RF, OutData%y) ! y + call RegUnpack(RF, OutData%CompInflow); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HWindSpeed); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RefHt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PLExp); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ADI_CopyIW_InputData(SrcIW_InputDataData, DstIW_InputDataData, CtrlCode, ErrStat, ErrMsg) + type(ADI_IW_InputData), intent(in) :: SrcIW_InputDataData + type(ADI_IW_InputData), intent(inout) :: DstIW_InputDataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ADI_CopyIW_InputData' 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 ADI_CopyInitOutput - - SUBROUTINE ADI_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(ADI_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ADI_DestroyInitOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL NWTC_Library_Destroyprogdesc( InitOutputData%Ver, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(InitOutputData%WriteOutputHdr)) THEN - DEALLOCATE(InitOutputData%WriteOutputHdr) -ENDIF -IF (ALLOCATED(InitOutputData%WriteOutputUnt)) THEN - DEALLOCATE(InitOutputData%WriteOutputUnt) -ENDIF - END SUBROUTINE ADI_DestroyInitOutput - - SUBROUTINE ADI_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(ADI_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 = 'ADI_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 ADI_PackInitOutput - - SUBROUTINE ADI_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(ADI_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 = 'ADI_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 ADI_UnPackInitOutput - - SUBROUTINE ADI_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ADI_ContinuousStateType), INTENT(IN) :: SrcContStateData - TYPE(ADI_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 = 'ADI_CopyContState' -! + ErrMsg = '' + DstIW_InputDataData%InputFile = SrcIW_InputDataData%InputFile + DstIW_InputDataData%CompInflow = SrcIW_InputDataData%CompInflow + DstIW_InputDataData%HWindSpeed = SrcIW_InputDataData%HWindSpeed + DstIW_InputDataData%RefHt = SrcIW_InputDataData%RefHt + DstIW_InputDataData%PLExp = SrcIW_InputDataData%PLExp + DstIW_InputDataData%MHK = SrcIW_InputDataData%MHK + DstIW_InputDataData%FilePassingMethod = SrcIW_InputDataData%FilePassingMethod + call NWTC_Library_CopyFileInfoType(SrcIW_InputDataData%PassedFileInfo, DstIW_InputDataData%PassedFileInfo, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call InflowWind_CopyInputFile(SrcIW_InputDataData%PassedFileData, DstIW_InputDataData%PassedFileData, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstIW_InputDataData%Linearize = SrcIW_InputDataData%Linearize +end subroutine + +subroutine ADI_DestroyIW_InputData(IW_InputDataData, ErrStat, ErrMsg) + type(ADI_IW_InputData), intent(inout) :: IW_InputDataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ADI_DestroyIW_InputData' ErrStat = ErrID_None - ErrMsg = "" - CALL AD_CopyContState( SrcContStateData%AD, DstContStateData%AD, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE ADI_CopyContState - - SUBROUTINE ADI_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(ADI_ContinuousStateType), INTENT(INOUT) :: ContStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ADI_DestroyContState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL AD_DestroyContState( ContStateData%AD, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE ADI_DestroyContState - - SUBROUTINE ADI_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(ADI_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 = 'ADI_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 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! AD: size of buffers for each call to pack subtype - CALL AD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%AD, ErrStat2, ErrMsg2, .TRUE. ) ! AD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! AD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! AD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! AD - 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 AD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%AD, ErrStat2, ErrMsg2, OnlySize ) ! AD - 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 ADI_PackContState - - SUBROUTINE ADI_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(ADI_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 = 'ADI_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 - 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 AD_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%AD, ErrStat2, ErrMsg2 ) ! AD - 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 ADI_UnPackContState - - SUBROUTINE ADI_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ADI_DiscreteStateType), INTENT(IN) :: SrcDiscStateData - TYPE(ADI_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 = 'ADI_CopyDiscState' -! + ErrMsg = '' + call NWTC_Library_DestroyFileInfoType(IW_InputDataData%PassedFileInfo, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call InflowWind_DestroyInputFile(IW_InputDataData%PassedFileData, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine ADI_PackIW_InputData(RF, Indata) + type(RegFile), intent(inout) :: RF + type(ADI_IW_InputData), intent(in) :: InData + character(*), parameter :: RoutineName = 'ADI_PackIW_InputData' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%InputFile) + call RegPack(RF, InData%CompInflow) + call RegPack(RF, InData%HWindSpeed) + call RegPack(RF, InData%RefHt) + call RegPack(RF, InData%PLExp) + call RegPack(RF, InData%MHK) + call RegPack(RF, InData%FilePassingMethod) + call NWTC_Library_PackFileInfoType(RF, InData%PassedFileInfo) + call InflowWind_PackInputFile(RF, InData%PassedFileData) + call RegPack(RF, InData%Linearize) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ADI_UnPackIW_InputData(RF, OutData) + type(RegFile), intent(inout) :: RF + type(ADI_IW_InputData), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ADI_UnPackIW_InputData' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%InputFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CompInflow); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HWindSpeed); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RefHt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PLExp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MHK); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FilePassingMethod); if (RegCheckErr(RF, RoutineName)) return + call NWTC_Library_UnpackFileInfoType(RF, OutData%PassedFileInfo) ! PassedFileInfo + call InflowWind_UnpackInputFile(RF, OutData%PassedFileData) ! PassedFileData + call RegUnpack(RF, OutData%Linearize); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ADI_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) + type(ADI_InitInputType), intent(in) :: SrcInitInputData + type(ADI_InitInputType), intent(inout) :: DstInitInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ADI_CopyInitInput' ErrStat = ErrID_None - ErrMsg = "" - CALL AD_CopyDiscState( SrcDiscStateData%AD, DstDiscStateData%AD, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE ADI_CopyDiscState - - SUBROUTINE ADI_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(ADI_DiscreteStateType), INTENT(INOUT) :: DiscStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ADI_DestroyDiscState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL AD_DestroyDiscState( DiscStateData%AD, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE ADI_DestroyDiscState - - SUBROUTINE ADI_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(ADI_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 = 'ADI_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 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! AD: size of buffers for each call to pack subtype - CALL AD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%AD, ErrStat2, ErrMsg2, .TRUE. ) ! AD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! AD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! AD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! AD - 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 AD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%AD, ErrStat2, ErrMsg2, OnlySize ) ! AD - 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 ADI_PackDiscState - - SUBROUTINE ADI_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(ADI_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 = 'ADI_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 - 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 AD_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%AD, ErrStat2, ErrMsg2 ) ! AD - 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 ADI_UnPackDiscState - - SUBROUTINE ADI_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ADI_ConstraintStateType), INTENT(IN) :: SrcConstrStateData - TYPE(ADI_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 = 'ADI_CopyConstrState' -! + ErrMsg = '' + call AD_CopyInitInput(SrcInitInputData%AD, DstInitInputData%AD, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call ADI_CopyIW_InputData(SrcInitInputData%IW_InitInp, DstInitInputData%IW_InitInp, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstInitInputData%RootName = SrcInitInputData%RootName + DstInitInputData%storeHHVel = SrcInitInputData%storeHHVel + DstInitInputData%WrVTK = SrcInitInputData%WrVTK + DstInitInputData%WrVTK_Type = SrcInitInputData%WrVTK_Type + DstInitInputData%WtrDpth = SrcInitInputData%WtrDpth +end subroutine + +subroutine ADI_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(ADI_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ADI_DestroyInitInput' ErrStat = ErrID_None - ErrMsg = "" - CALL AD_CopyConstrState( SrcConstrStateData%AD, DstConstrStateData%AD, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE ADI_CopyConstrState - - SUBROUTINE ADI_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(ADI_ConstraintStateType), INTENT(INOUT) :: ConstrStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ADI_DestroyConstrState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL AD_DestroyConstrState( ConstrStateData%AD, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE ADI_DestroyConstrState - - SUBROUTINE ADI_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(ADI_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 = 'ADI_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 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! AD: size of buffers for each call to pack subtype - CALL AD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%AD, ErrStat2, ErrMsg2, .TRUE. ) ! AD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! AD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! AD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! AD - 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 AD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%AD, ErrStat2, ErrMsg2, OnlySize ) ! AD - 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 ADI_PackConstrState - - SUBROUTINE ADI_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(ADI_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 = 'ADI_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 - 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 AD_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%AD, ErrStat2, ErrMsg2 ) ! AD - 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 ADI_UnPackConstrState - - SUBROUTINE ADI_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ADI_OtherStateType), INTENT(IN) :: SrcOtherStateData - TYPE(ADI_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 = 'ADI_CopyOtherState' -! + ErrMsg = '' + call AD_DestroyInitInput(InitInputData%AD, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call ADI_DestroyIW_InputData(InitInputData%IW_InitInp, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine ADI_PackInitInput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(ADI_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ADI_PackInitInput' + if (RF%ErrStat >= AbortErrLev) return + call AD_PackInitInput(RF, InData%AD) + call ADI_PackIW_InputData(RF, InData%IW_InitInp) + call RegPack(RF, InData%RootName) + call RegPack(RF, InData%storeHHVel) + call RegPack(RF, InData%WrVTK) + call RegPack(RF, InData%WrVTK_Type) + call RegPack(RF, InData%WtrDpth) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ADI_UnPackInitInput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(ADI_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ADI_UnPackInitInput' + if (RF%ErrStat /= ErrID_None) return + call AD_UnpackInitInput(RF, OutData%AD) ! AD + call ADI_UnpackIW_InputData(RF, OutData%IW_InitInp) ! IW_InitInp + call RegUnpack(RF, OutData%RootName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%storeHHVel); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WrVTK); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WrVTK_Type); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WtrDpth); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ADI_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) + type(ADI_InitOutputType), intent(in) :: SrcInitOutputData + type(ADI_InitOutputType), intent(inout) :: DstInitOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ADI_CopyInitOutput' ErrStat = ErrID_None - ErrMsg = "" - CALL AD_CopyOtherState( SrcOtherStateData%AD, DstOtherStateData%AD, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE ADI_CopyOtherState - - SUBROUTINE ADI_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(ADI_OtherStateType), INTENT(INOUT) :: OtherStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ADI_DestroyOtherState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL AD_DestroyOtherState( OtherStateData%AD, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE ADI_DestroyOtherState - - SUBROUTINE ADI_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(ADI_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 = 'ADI_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 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! AD: size of buffers for each call to pack subtype - CALL AD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%AD, ErrStat2, ErrMsg2, .TRUE. ) ! AD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! AD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! AD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! AD - 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 AD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%AD, ErrStat2, ErrMsg2, OnlySize ) ! AD - 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 ADI_PackOtherState - - SUBROUTINE ADI_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(ADI_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 = 'ADI_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 - 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 AD_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%AD, ErrStat2, ErrMsg2 ) ! AD - 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 ADI_UnPackOtherState - - SUBROUTINE ADI_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ADI_MiscVarType), INTENT(INOUT) :: SrcMiscData - TYPE(ADI_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 = 'ADI_CopyMisc' -! + 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 + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) + if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then + allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitOutputData%WriteOutputUnt)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) + if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then + allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), 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 + end if +end subroutine + +subroutine ADI_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(ADI_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ADI_DestroyInitOutput' ErrStat = ErrID_None - ErrMsg = "" - CALL AD_CopyMisc( SrcMiscData%AD, DstMiscData%AD, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL ADI_Copyinflowwinddata( SrcMiscData%IW, DstMiscData%IW, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcMiscData%VTK_surfaces)) THEN - i1_l = LBOUND(SrcMiscData%VTK_surfaces,1) - i1_u = UBOUND(SrcMiscData%VTK_surfaces,1) - IF (.NOT. ALLOCATED(DstMiscData%VTK_surfaces)) THEN - ALLOCATE(DstMiscData%VTK_surfaces(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%VTK_surfaces.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%VTK_surfaces,1), UBOUND(SrcMiscData%VTK_surfaces,1) - CALL AD_Copyvtk_rotsurfacetype( SrcMiscData%VTK_surfaces(i1), DstMiscData%VTK_surfaces(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - END SUBROUTINE ADI_CopyMisc - - SUBROUTINE ADI_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(ADI_MiscVarType), INTENT(INOUT) :: MiscData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ADI_DestroyMisc' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL AD_DestroyMisc( MiscData%AD, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL ADI_Destroyinflowwinddata( MiscData%IW, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(MiscData%VTK_surfaces)) THEN -DO i1 = LBOUND(MiscData%VTK_surfaces,1), UBOUND(MiscData%VTK_surfaces,1) - CALL AD_Destroyvtk_rotsurfacetype( MiscData%VTK_surfaces(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MiscData%VTK_surfaces) -ENDIF - END SUBROUTINE ADI_DestroyMisc - - SUBROUTINE ADI_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(ADI_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 = 'ADI_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 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! AD: size of buffers for each call to pack subtype - CALL AD_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%AD, ErrStat2, ErrMsg2, .TRUE. ) ! AD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! AD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! AD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! AD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! IW: size of buffers for each call to pack subtype - CALL ADI_Packinflowwinddata( Re_Buf, Db_Buf, Int_Buf, InData%IW, ErrStat2, ErrMsg2, .TRUE. ) ! IW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! IW - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! IW - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! IW - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! VTK_surfaces allocated yes/no - IF ( ALLOCATED(InData%VTK_surfaces) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! VTK_surfaces upper/lower bounds for each dimension - DO i1 = LBOUND(InData%VTK_surfaces,1), UBOUND(InData%VTK_surfaces,1) - Int_BufSz = Int_BufSz + 3 ! VTK_surfaces: size of buffers for each call to pack subtype - CALL AD_Packvtk_rotsurfacetype( Re_Buf, Db_Buf, Int_Buf, InData%VTK_surfaces(i1), ErrStat2, ErrMsg2, .TRUE. ) ! VTK_surfaces - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! VTK_surfaces - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! VTK_surfaces - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! VTK_surfaces - 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 - - CALL AD_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%AD, ErrStat2, ErrMsg2, OnlySize ) ! AD - 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 ADI_Packinflowwinddata( Re_Buf, Db_Buf, Int_Buf, InData%IW, ErrStat2, ErrMsg2, OnlySize ) ! IW - 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%VTK_surfaces) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%VTK_surfaces,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VTK_surfaces,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%VTK_surfaces,1), UBOUND(InData%VTK_surfaces,1) - CALL AD_Packvtk_rotsurfacetype( Re_Buf, Db_Buf, Int_Buf, InData%VTK_surfaces(i1), ErrStat2, ErrMsg2, OnlySize ) ! VTK_surfaces - 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 ADI_PackMisc - - SUBROUTINE ADI_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(ADI_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 = 'ADI_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 - 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 AD_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%AD, ErrStat2, ErrMsg2 ) ! AD - 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 ADI_Unpackinflowwinddata( Re_Buf, Db_Buf, Int_Buf, OutData%IW, ErrStat2, ErrMsg2 ) ! IW - 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 ! VTK_surfaces not allocated - Int_Xferred = Int_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%VTK_surfaces)) DEALLOCATE(OutData%VTK_surfaces) - ALLOCATE(OutData%VTK_surfaces(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%VTK_surfaces.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%VTK_surfaces,1), UBOUND(OutData%VTK_surfaces,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 AD_Unpackvtk_rotsurfacetype( Re_Buf, Db_Buf, Int_Buf, OutData%VTK_surfaces(i1), ErrStat2, ErrMsg2 ) ! VTK_surfaces - 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 ADI_UnPackMisc - - SUBROUTINE ADI_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ADI_ParameterType), INTENT(IN) :: SrcParamData - TYPE(ADI_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 = 'ADI_CopyParam' -! + ErrMsg = '' + call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(InitOutputData%WriteOutputHdr)) then + deallocate(InitOutputData%WriteOutputHdr) + end if + if (allocated(InitOutputData%WriteOutputUnt)) then + deallocate(InitOutputData%WriteOutputUnt) + end if +end subroutine + +subroutine ADI_PackInitOutput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(ADI_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ADI_PackInitOutput' + if (RF%ErrStat >= AbortErrLev) return + call NWTC_Library_PackProgDesc(RF, InData%Ver) + call RegPackAlloc(RF, InData%WriteOutputHdr) + call RegPackAlloc(RF, InData%WriteOutputUnt) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ADI_UnPackInitOutput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(ADI_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ADI_UnPackInitOutput' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call NWTC_Library_UnpackProgDesc(RF, OutData%Ver) ! Ver + call RegUnpackAlloc(RF, OutData%WriteOutputHdr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WriteOutputUnt); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ADI_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) + type(ADI_ContinuousStateType), intent(in) :: SrcContStateData + type(ADI_ContinuousStateType), intent(inout) :: DstContStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ADI_CopyContState' ErrStat = ErrID_None - ErrMsg = "" - CALL AD_CopyParam( SrcParamData%AD, DstParamData%AD, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstParamData%dt = SrcParamData%dt - DstParamData%storeHHVel = SrcParamData%storeHHVel - DstParamData%wrVTK = SrcParamData%wrVTK - DstParamData%WrVTK_Type = SrcParamData%WrVTK_Type - DstParamData%NumOuts = SrcParamData%NumOuts - DstParamData%MHK = SrcParamData%MHK - DstParamData%WtrDpth = SrcParamData%WtrDpth - END SUBROUTINE ADI_CopyParam - - SUBROUTINE ADI_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(ADI_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ADI_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL AD_DestroyParam( ParamData%AD, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE ADI_DestroyParam - - SUBROUTINE ADI_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(ADI_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 = 'ADI_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 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! AD: size of buffers for each call to pack subtype - CALL AD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%AD, ErrStat2, ErrMsg2, .TRUE. ) ! AD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! AD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! AD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! AD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Db_BufSz = Db_BufSz + 1 ! dt - Int_BufSz = Int_BufSz + 1 ! storeHHVel - Int_BufSz = Int_BufSz + 1 ! wrVTK - Int_BufSz = Int_BufSz + 1 ! WrVTK_Type - Int_BufSz = Int_BufSz + 1 ! NumOuts - Int_BufSz = Int_BufSz + 1 ! MHK - Re_BufSz = Re_BufSz + 1 ! WtrDpth - 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 AD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%AD, ErrStat2, ErrMsg2, OnlySize ) ! AD - 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 - DbKiBuf(Db_Xferred) = InData%dt - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%storeHHVel, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%wrVTK - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%WrVTK_Type - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%MHK - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WtrDpth - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE ADI_PackParam - - SUBROUTINE ADI_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(ADI_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 = 'ADI_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 - 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 AD_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%AD, ErrStat2, ErrMsg2 ) ! AD - 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%dt = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%storeHHVel = TRANSFER(IntKiBuf(Int_Xferred), OutData%storeHHVel) - Int_Xferred = Int_Xferred + 1 - OutData%wrVTK = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WrVTK_Type = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%MHK = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WtrDpth = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE ADI_UnPackParam - - SUBROUTINE ADI_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ADI_InputType), INTENT(INOUT) :: SrcInputData - TYPE(ADI_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 = 'ADI_CopyInput' -! + ErrMsg = '' + call AD_CopyContState(SrcContStateData%AD, DstContStateData%AD, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine ADI_DestroyContState(ContStateData, ErrStat, ErrMsg) + type(ADI_ContinuousStateType), intent(inout) :: ContStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ADI_DestroyContState' ErrStat = ErrID_None - ErrMsg = "" - CALL AD_CopyInput( SrcInputData%AD, DstInputData%AD, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE ADI_CopyInput - - SUBROUTINE ADI_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(ADI_InputType), INTENT(INOUT) :: InputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ADI_DestroyInput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL AD_DestroyInput( InputData%AD, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE ADI_DestroyInput - - SUBROUTINE ADI_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(ADI_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 = 'ADI_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 ! AD: size of buffers for each call to pack subtype - CALL AD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%AD, ErrStat2, ErrMsg2, .TRUE. ) ! AD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! AD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! AD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! AD - 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 AD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%AD, ErrStat2, ErrMsg2, OnlySize ) ! AD - 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 ADI_PackInput - - SUBROUTINE ADI_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(ADI_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 = 'ADI_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 AD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%AD, ErrStat2, ErrMsg2 ) ! AD - 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 ADI_UnPackInput - - SUBROUTINE ADI_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ADI_OutputType), INTENT(INOUT) :: SrcOutputData - TYPE(ADI_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 = 'ADI_CopyOutput' -! + ErrMsg = '' + call AD_DestroyContState(ContStateData%AD, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine ADI_PackContState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(ADI_ContinuousStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ADI_PackContState' + if (RF%ErrStat >= AbortErrLev) return + call AD_PackContState(RF, InData%AD) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ADI_UnPackContState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(ADI_ContinuousStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ADI_UnPackContState' + if (RF%ErrStat /= ErrID_None) return + call AD_UnpackContState(RF, OutData%AD) ! AD +end subroutine + +subroutine ADI_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) + type(ADI_DiscreteStateType), intent(in) :: SrcDiscStateData + type(ADI_DiscreteStateType), intent(inout) :: DstDiscStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ADI_CopyDiscState' ErrStat = ErrID_None - ErrMsg = "" - CALL AD_CopyOutput( SrcOutputData%AD, DstOutputData%AD, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcOutputData%HHVel)) THEN - i1_l = LBOUND(SrcOutputData%HHVel,1) - i1_u = UBOUND(SrcOutputData%HHVel,1) - i2_l = LBOUND(SrcOutputData%HHVel,2) - i2_u = UBOUND(SrcOutputData%HHVel,2) - IF (.NOT. ALLOCATED(DstOutputData%HHVel)) THEN - ALLOCATE(DstOutputData%HHVel(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%HHVel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%HHVel = SrcOutputData%HHVel -ENDIF - DstOutputData%PLExp = SrcOutputData%PLExp -IF (ALLOCATED(SrcOutputData%IW_WriteOutput)) THEN - i1_l = LBOUND(SrcOutputData%IW_WriteOutput,1) - i1_u = UBOUND(SrcOutputData%IW_WriteOutput,1) - IF (.NOT. ALLOCATED(DstOutputData%IW_WriteOutput)) THEN - ALLOCATE(DstOutputData%IW_WriteOutput(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%IW_WriteOutput.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%IW_WriteOutput = SrcOutputData%IW_WriteOutput -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 ADI_CopyOutput - - SUBROUTINE ADI_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(ADI_OutputType), INTENT(INOUT) :: OutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ADI_DestroyOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL AD_DestroyOutput( OutputData%AD, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(OutputData%HHVel)) THEN - DEALLOCATE(OutputData%HHVel) -ENDIF -IF (ALLOCATED(OutputData%IW_WriteOutput)) THEN - DEALLOCATE(OutputData%IW_WriteOutput) -ENDIF -IF (ALLOCATED(OutputData%WriteOutput)) THEN - DEALLOCATE(OutputData%WriteOutput) -ENDIF - END SUBROUTINE ADI_DestroyOutput - - SUBROUTINE ADI_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(ADI_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 = 'ADI_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 ! AD: size of buffers for each call to pack subtype - CALL AD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%AD, ErrStat2, ErrMsg2, .TRUE. ) ! AD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! AD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! AD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! AD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! HHVel allocated yes/no - IF ( ALLOCATED(InData%HHVel) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! HHVel upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%HHVel) ! HHVel - END IF - Re_BufSz = Re_BufSz + 1 ! PLExp - Int_BufSz = Int_BufSz + 1 ! IW_WriteOutput allocated yes/no - IF ( ALLOCATED(InData%IW_WriteOutput) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! IW_WriteOutput upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%IW_WriteOutput) ! IW_WriteOutput - 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 AD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%AD, ErrStat2, ErrMsg2, OnlySize ) ! AD - 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%HHVel) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%HHVel,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%HHVel,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%HHVel,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%HHVel,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%HHVel,2), UBOUND(InData%HHVel,2) - DO i1 = LBOUND(InData%HHVel,1), UBOUND(InData%HHVel,1) - ReKiBuf(Re_Xferred) = InData%HHVel(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - ReKiBuf(Re_Xferred) = InData%PLExp - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%IW_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%IW_WriteOutput,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IW_WriteOutput,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%IW_WriteOutput,1), UBOUND(InData%IW_WriteOutput,1) - ReKiBuf(Re_Xferred) = InData%IW_WriteOutput(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 ADI_PackOutput - - SUBROUTINE ADI_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(ADI_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 = 'ADI_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 AD_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%AD, ErrStat2, ErrMsg2 ) ! AD - 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 ! HHVel not allocated - Int_Xferred = Int_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%HHVel)) DEALLOCATE(OutData%HHVel) - ALLOCATE(OutData%HHVel(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%HHVel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%HHVel,2), UBOUND(OutData%HHVel,2) - DO i1 = LBOUND(OutData%HHVel,1), UBOUND(OutData%HHVel,1) - OutData%HHVel(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%PLExp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IW_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%IW_WriteOutput)) DEALLOCATE(OutData%IW_WriteOutput) - ALLOCATE(OutData%IW_WriteOutput(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IW_WriteOutput.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%IW_WriteOutput,1), UBOUND(OutData%IW_WriteOutput,1) - OutData%IW_WriteOutput(i1) = ReKiBuf(Re_Xferred) - 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 ADI_UnPackOutput - - SUBROUTINE ADI_CopyData( SrcDataData, DstDataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ADI_Data), INTENT(INOUT) :: SrcDataData - TYPE(ADI_Data), INTENT(INOUT) :: DstDataData - 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 = 'ADI_CopyData' -! + ErrMsg = '' + call AD_CopyDiscState(SrcDiscStateData%AD, DstDiscStateData%AD, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine ADI_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) + type(ADI_DiscreteStateType), intent(inout) :: DiscStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ADI_DestroyDiscState' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcDataData%x)) THEN - i1_l = LBOUND(SrcDataData%x,1) - i1_u = UBOUND(SrcDataData%x,1) - IF (.NOT. ALLOCATED(DstDataData%x)) THEN - ALLOCATE(DstDataData%x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDataData%x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcDataData%x,1), UBOUND(SrcDataData%x,1) - CALL ADI_CopyContState( SrcDataData%x(i1), DstDataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcDataData%xd)) THEN - i1_l = LBOUND(SrcDataData%xd,1) - i1_u = UBOUND(SrcDataData%xd,1) - IF (.NOT. ALLOCATED(DstDataData%xd)) THEN - ALLOCATE(DstDataData%xd(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDataData%xd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcDataData%xd,1), UBOUND(SrcDataData%xd,1) - CALL ADI_CopyDiscState( SrcDataData%xd(i1), DstDataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcDataData%z)) THEN - i1_l = LBOUND(SrcDataData%z,1) - i1_u = UBOUND(SrcDataData%z,1) - IF (.NOT. ALLOCATED(DstDataData%z)) THEN - ALLOCATE(DstDataData%z(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDataData%z.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcDataData%z,1), UBOUND(SrcDataData%z,1) - CALL ADI_CopyConstrState( SrcDataData%z(i1), DstDataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcDataData%OtherState)) THEN - i1_l = LBOUND(SrcDataData%OtherState,1) - i1_u = UBOUND(SrcDataData%OtherState,1) - IF (.NOT. ALLOCATED(DstDataData%OtherState)) THEN - ALLOCATE(DstDataData%OtherState(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDataData%OtherState.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcDataData%OtherState,1), UBOUND(SrcDataData%OtherState,1) - CALL ADI_CopyOtherState( SrcDataData%OtherState(i1), DstDataData%OtherState(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL ADI_CopyParam( SrcDataData%p, DstDataData%p, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL ADI_CopyMisc( SrcDataData%m, DstDataData%m, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcDataData%u)) THEN - i1_l = LBOUND(SrcDataData%u,1) - i1_u = UBOUND(SrcDataData%u,1) - IF (.NOT. ALLOCATED(DstDataData%u)) THEN - ALLOCATE(DstDataData%u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDataData%u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcDataData%u,1), UBOUND(SrcDataData%u,1) - CALL ADI_CopyInput( SrcDataData%u(i1), DstDataData%u(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL ADI_CopyOutput( SrcDataData%y, DstDataData%y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcDataData%inputTimes)) THEN - i1_l = LBOUND(SrcDataData%inputTimes,1) - i1_u = UBOUND(SrcDataData%inputTimes,1) - IF (.NOT. ALLOCATED(DstDataData%inputTimes)) THEN - ALLOCATE(DstDataData%inputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDataData%inputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDataData%inputTimes = SrcDataData%inputTimes -ENDIF - END SUBROUTINE ADI_CopyData - - SUBROUTINE ADI_DestroyData( DataData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(ADI_Data), INTENT(INOUT) :: DataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ADI_DestroyData' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(DataData%x)) THEN -DO i1 = LBOUND(DataData%x,1), UBOUND(DataData%x,1) - CALL ADI_DestroyContState( DataData%x(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(DataData%x) -ENDIF -IF (ALLOCATED(DataData%xd)) THEN -DO i1 = LBOUND(DataData%xd,1), UBOUND(DataData%xd,1) - CALL ADI_DestroyDiscState( DataData%xd(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(DataData%xd) -ENDIF -IF (ALLOCATED(DataData%z)) THEN -DO i1 = LBOUND(DataData%z,1), UBOUND(DataData%z,1) - CALL ADI_DestroyConstrState( DataData%z(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(DataData%z) -ENDIF -IF (ALLOCATED(DataData%OtherState)) THEN -DO i1 = LBOUND(DataData%OtherState,1), UBOUND(DataData%OtherState,1) - CALL ADI_DestroyOtherState( DataData%OtherState(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(DataData%OtherState) -ENDIF - CALL ADI_DestroyParam( DataData%p, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL ADI_DestroyMisc( DataData%m, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(DataData%u)) THEN -DO i1 = LBOUND(DataData%u,1), UBOUND(DataData%u,1) - CALL ADI_DestroyInput( DataData%u(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(DataData%u) -ENDIF - CALL ADI_DestroyOutput( DataData%y, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(DataData%inputTimes)) THEN - DEALLOCATE(DataData%inputTimes) -ENDIF - END SUBROUTINE ADI_DestroyData - - SUBROUTINE ADI_PackData( 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(ADI_Data), 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 = 'ADI_PackData' - ! 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 ! x allocated yes/no - IF ( ALLOCATED(InData%x) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! x upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - Int_BufSz = Int_BufSz + 3 ! x: size of buffers for each call to pack subtype - CALL ADI_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! xd allocated yes/no - IF ( ALLOCATED(InData%xd) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! xd upper/lower bounds for each dimension - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype - CALL ADI_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xd - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! z allocated yes/no - IF ( ALLOCATED(InData%z) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! z upper/lower bounds for each dimension - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype - CALL ADI_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! z - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! z - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! z - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! OtherState allocated yes/no - IF ( ALLOCATED(InData%OtherState) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OtherState upper/lower bounds for each dimension - DO i1 = LBOUND(InData%OtherState,1), UBOUND(InData%OtherState,1) - Int_BufSz = Int_BufSz + 3 ! OtherState: size of buffers for each call to pack subtype - CALL ADI_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherState(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherState - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OtherState - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherState - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherState - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype - CALL ADI_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! p - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! p - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! p - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype - CALL ADI_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! m - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! m - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! m - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! u allocated yes/no - IF ( ALLOCATED(InData%u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! u upper/lower bounds for each dimension - DO i1 = LBOUND(InData%u,1), UBOUND(InData%u,1) - Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype - CALL ADI_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u(i1), ErrStat2, ErrMsg2, .TRUE. ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype - CALL ADI_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! inputTimes allocated yes/no - IF ( ALLOCATED(InData%inputTimes) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! inputTimes upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%inputTimes) ! inputTimes - 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%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%x,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - CALL ADI_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, OnlySize ) ! x - 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%xd) ) THEN - 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,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xd,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - CALL ADI_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd - 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%z) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%z,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - CALL ADI_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, OnlySize ) ! z - 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%OtherState) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OtherState,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OtherState,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%OtherState,1), UBOUND(InData%OtherState,1) - CALL ADI_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherState(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherState - 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 - CALL ADI_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! p - 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 ADI_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! m - 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%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) - CALL ADI_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u(i1), ErrStat2, ErrMsg2, OnlySize ) ! u - 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 - CALL ADI_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y - 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%inputTimes) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%inputTimes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%inputTimes,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%inputTimes,1), UBOUND(InData%inputTimes,1) - DbKiBuf(Db_Xferred) = InData%inputTimes(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE ADI_PackData - - SUBROUTINE ADI_UnPackData( 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(ADI_Data), 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 = 'ADI_UnPackData' - ! 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 ! 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%x)) DEALLOCATE(OutData%x) - ALLOCATE(OutData%x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,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 ADI_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x(i1), ErrStat2, ErrMsg2 ) ! x - 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 ! xd not allocated - Int_Xferred = Int_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)) DEALLOCATE(OutData%xd) - ALLOCATE(OutData%xd(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%xd,1), UBOUND(OutData%xd,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 ADI_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1), ErrStat2, ErrMsg2 ) ! xd - 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 ! z not allocated - Int_Xferred = Int_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%z)) DEALLOCATE(OutData%z) - ALLOCATE(OutData%z(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%z.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,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 ADI_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1), ErrStat2, ErrMsg2 ) ! z - 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 ! OtherState not allocated - Int_Xferred = Int_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%OtherState)) DEALLOCATE(OutData%OtherState) - ALLOCATE(OutData%OtherState(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherState.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%OtherState,1), UBOUND(OutData%OtherState,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 ADI_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherState(i1), ErrStat2, ErrMsg2 ) ! OtherState - 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 - 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 ADI_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p - 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 ADI_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! m - 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 ! 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%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 - DO i1 = LBOUND(OutData%u,1), UBOUND(OutData%u,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 ADI_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u(i1), ErrStat2, ErrMsg2 ) ! u - 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 - 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 ADI_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y - 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 ! inputTimes not allocated - Int_Xferred = Int_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%inputTimes)) DEALLOCATE(OutData%inputTimes) - ALLOCATE(OutData%inputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%inputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%inputTimes,1), UBOUND(OutData%inputTimes,1) - OutData%inputTimes(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE ADI_UnPackData - - SUBROUTINE ADI_CopyRotFED( SrcRotFEDData, DstRotFEDData, CtrlCode, ErrStat, ErrMsg ) - TYPE(RotFED), INTENT(INOUT) :: SrcRotFEDData - TYPE(RotFED), INTENT(INOUT) :: DstRotFEDData - 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 = 'ADI_CopyRotFED' -! + ErrMsg = '' + call AD_DestroyDiscState(DiscStateData%AD, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine ADI_PackDiscState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(ADI_DiscreteStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ADI_PackDiscState' + if (RF%ErrStat >= AbortErrLev) return + call AD_PackDiscState(RF, InData%AD) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ADI_UnPackDiscState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(ADI_DiscreteStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ADI_UnPackDiscState' + if (RF%ErrStat /= ErrID_None) return + call AD_UnpackDiscState(RF, OutData%AD) ! AD +end subroutine + +subroutine ADI_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) + type(ADI_ConstraintStateType), intent(in) :: SrcConstrStateData + type(ADI_ConstraintStateType), intent(inout) :: DstConstrStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ADI_CopyConstrState' ErrStat = ErrID_None - ErrMsg = "" - CALL MeshCopy( SrcRotFEDData%PlatformPtMesh, DstRotFEDData%PlatformPtMesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcRotFEDData%TwrPtMesh, DstRotFEDData%TwrPtMesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcRotFEDData%TwrPtMeshAD, DstRotFEDData%TwrPtMeshAD, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcRotFEDData%NacelleMotion, DstRotFEDData%NacelleMotion, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcRotFEDData%HubPtMotion, DstRotFEDData%HubPtMotion, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcRotFEDData%BladeRootMotion)) THEN - i1_l = LBOUND(SrcRotFEDData%BladeRootMotion,1) - i1_u = UBOUND(SrcRotFEDData%BladeRootMotion,1) - IF (.NOT. ALLOCATED(DstRotFEDData%BladeRootMotion)) THEN - ALLOCATE(DstRotFEDData%BladeRootMotion(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotFEDData%BladeRootMotion.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcRotFEDData%BladeRootMotion,1), UBOUND(SrcRotFEDData%BladeRootMotion,1) - CALL MeshCopy( SrcRotFEDData%BladeRootMotion(i1), DstRotFEDData%BladeRootMotion(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcRotFEDData%BladeLn2Mesh)) THEN - i1_l = LBOUND(SrcRotFEDData%BladeLn2Mesh,1) - i1_u = UBOUND(SrcRotFEDData%BladeLn2Mesh,1) - IF (.NOT. ALLOCATED(DstRotFEDData%BladeLn2Mesh)) THEN - ALLOCATE(DstRotFEDData%BladeLn2Mesh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotFEDData%BladeLn2Mesh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcRotFEDData%BladeLn2Mesh,1), UBOUND(SrcRotFEDData%BladeLn2Mesh,1) - CALL MeshCopy( SrcRotFEDData%BladeLn2Mesh(i1), DstRotFEDData%BladeLn2Mesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - DstRotFEDData%hasTower = SrcRotFEDData%hasTower - DstRotFEDData%rigidBlades = SrcRotFEDData%rigidBlades - DstRotFEDData%numBlades = SrcRotFEDData%numBlades - CALL NWTC_Library_Copymeshmaptype( SrcRotFEDData%ED_P_2_AD_P_T, DstRotFEDData%ED_P_2_AD_P_T, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcRotFEDData%AD_P_2_AD_L_T, DstRotFEDData%AD_P_2_AD_L_T, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcRotFEDData%AD_P_2_AD_L_B)) THEN - i1_l = LBOUND(SrcRotFEDData%AD_P_2_AD_L_B,1) - i1_u = UBOUND(SrcRotFEDData%AD_P_2_AD_L_B,1) - IF (.NOT. ALLOCATED(DstRotFEDData%AD_P_2_AD_L_B)) THEN - ALLOCATE(DstRotFEDData%AD_P_2_AD_L_B(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotFEDData%AD_P_2_AD_L_B.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcRotFEDData%AD_P_2_AD_L_B,1), UBOUND(SrcRotFEDData%AD_P_2_AD_L_B,1) - CALL NWTC_Library_Copymeshmaptype( SrcRotFEDData%AD_P_2_AD_L_B(i1), DstRotFEDData%AD_P_2_AD_L_B(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL NWTC_Library_Copymeshmaptype( SrcRotFEDData%ED_P_2_AD_P_TF, DstRotFEDData%ED_P_2_AD_P_TF, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcRotFEDData%ED_P_2_AD_P_R)) THEN - i1_l = LBOUND(SrcRotFEDData%ED_P_2_AD_P_R,1) - i1_u = UBOUND(SrcRotFEDData%ED_P_2_AD_P_R,1) - IF (.NOT. ALLOCATED(DstRotFEDData%ED_P_2_AD_P_R)) THEN - ALLOCATE(DstRotFEDData%ED_P_2_AD_P_R(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotFEDData%ED_P_2_AD_P_R.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcRotFEDData%ED_P_2_AD_P_R,1), UBOUND(SrcRotFEDData%ED_P_2_AD_P_R,1) - CALL NWTC_Library_Copymeshmaptype( SrcRotFEDData%ED_P_2_AD_P_R(i1), DstRotFEDData%ED_P_2_AD_P_R(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL NWTC_Library_Copymeshmaptype( SrcRotFEDData%ED_P_2_AD_P_H, DstRotFEDData%ED_P_2_AD_P_H, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcRotFEDData%ED_P_2_AD_P_N, DstRotFEDData%ED_P_2_AD_P_N, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE ADI_CopyRotFED - - SUBROUTINE ADI_DestroyRotFED( RotFEDData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(RotFED), INTENT(INOUT) :: RotFEDData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ADI_DestroyRotFED' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL MeshDestroy( RotFEDData%PlatformPtMesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( RotFEDData%TwrPtMesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( RotFEDData%TwrPtMeshAD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( RotFEDData%NacelleMotion, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( RotFEDData%HubPtMotion, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(RotFEDData%BladeRootMotion)) THEN -DO i1 = LBOUND(RotFEDData%BladeRootMotion,1), UBOUND(RotFEDData%BladeRootMotion,1) - CALL MeshDestroy( RotFEDData%BladeRootMotion(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(RotFEDData%BladeRootMotion) -ENDIF -IF (ALLOCATED(RotFEDData%BladeLn2Mesh)) THEN -DO i1 = LBOUND(RotFEDData%BladeLn2Mesh,1), UBOUND(RotFEDData%BladeLn2Mesh,1) - CALL MeshDestroy( RotFEDData%BladeLn2Mesh(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(RotFEDData%BladeLn2Mesh) -ENDIF - CALL NWTC_Library_Destroymeshmaptype( RotFEDData%ED_P_2_AD_P_T, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL NWTC_Library_Destroymeshmaptype( RotFEDData%AD_P_2_AD_L_T, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(RotFEDData%AD_P_2_AD_L_B)) THEN -DO i1 = LBOUND(RotFEDData%AD_P_2_AD_L_B,1), UBOUND(RotFEDData%AD_P_2_AD_L_B,1) - CALL NWTC_Library_Destroymeshmaptype( RotFEDData%AD_P_2_AD_L_B(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(RotFEDData%AD_P_2_AD_L_B) -ENDIF - CALL NWTC_Library_Destroymeshmaptype( RotFEDData%ED_P_2_AD_P_TF, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(RotFEDData%ED_P_2_AD_P_R)) THEN -DO i1 = LBOUND(RotFEDData%ED_P_2_AD_P_R,1), UBOUND(RotFEDData%ED_P_2_AD_P_R,1) - CALL NWTC_Library_Destroymeshmaptype( RotFEDData%ED_P_2_AD_P_R(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(RotFEDData%ED_P_2_AD_P_R) -ENDIF - CALL NWTC_Library_Destroymeshmaptype( RotFEDData%ED_P_2_AD_P_H, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL NWTC_Library_Destroymeshmaptype( RotFEDData%ED_P_2_AD_P_N, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE ADI_DestroyRotFED - - SUBROUTINE ADI_PackRotFED( 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(RotFED), 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 = 'ADI_PackRotFED' - ! 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 ! PlatformPtMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%PlatformPtMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! PlatformPtMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! PlatformPtMesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! PlatformPtMesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! PlatformPtMesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! TwrPtMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%TwrPtMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! TwrPtMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! TwrPtMesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! TwrPtMesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! TwrPtMesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! TwrPtMeshAD: size of buffers for each call to pack subtype - CALL MeshPack( InData%TwrPtMeshAD, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! TwrPtMeshAD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! TwrPtMeshAD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! TwrPtMeshAD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! TwrPtMeshAD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! NacelleMotion: size of buffers for each call to pack subtype - CALL MeshPack( InData%NacelleMotion, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! NacelleMotion - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! NacelleMotion - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! NacelleMotion - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! NacelleMotion - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! HubPtMotion: size of buffers for each call to pack subtype - CALL MeshPack( InData%HubPtMotion, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! HubPtMotion - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! HubPtMotion - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! HubPtMotion - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! HubPtMotion - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! BladeRootMotion allocated yes/no - IF ( ALLOCATED(InData%BladeRootMotion) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BladeRootMotion upper/lower bounds for each dimension - DO i1 = LBOUND(InData%BladeRootMotion,1), UBOUND(InData%BladeRootMotion,1) - Int_BufSz = Int_BufSz + 3 ! BladeRootMotion: size of buffers for each call to pack subtype - CALL MeshPack( InData%BladeRootMotion(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! BladeRootMotion - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BladeRootMotion - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BladeRootMotion - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BladeRootMotion - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! BladeLn2Mesh allocated yes/no - IF ( ALLOCATED(InData%BladeLn2Mesh) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BladeLn2Mesh upper/lower bounds for each dimension - DO i1 = LBOUND(InData%BladeLn2Mesh,1), UBOUND(InData%BladeLn2Mesh,1) - Int_BufSz = Int_BufSz + 3 ! BladeLn2Mesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%BladeLn2Mesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! BladeLn2Mesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BladeLn2Mesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BladeLn2Mesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BladeLn2Mesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! hasTower - Int_BufSz = Int_BufSz + 1 ! rigidBlades - Int_BufSz = Int_BufSz + 1 ! numBlades - Int_BufSz = Int_BufSz + 3 ! ED_P_2_AD_P_T: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_AD_P_T, ErrStat2, ErrMsg2, .TRUE. ) ! ED_P_2_AD_P_T - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! ED_P_2_AD_P_T - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! ED_P_2_AD_P_T - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! ED_P_2_AD_P_T - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! AD_P_2_AD_L_T: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%AD_P_2_AD_L_T, ErrStat2, ErrMsg2, .TRUE. ) ! AD_P_2_AD_L_T - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! AD_P_2_AD_L_T - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! AD_P_2_AD_L_T - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! AD_P_2_AD_L_T - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! AD_P_2_AD_L_B allocated yes/no - IF ( ALLOCATED(InData%AD_P_2_AD_L_B) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! AD_P_2_AD_L_B upper/lower bounds for each dimension - DO i1 = LBOUND(InData%AD_P_2_AD_L_B,1), UBOUND(InData%AD_P_2_AD_L_B,1) - Int_BufSz = Int_BufSz + 3 ! AD_P_2_AD_L_B: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%AD_P_2_AD_L_B(i1), ErrStat2, ErrMsg2, .TRUE. ) ! AD_P_2_AD_L_B - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! AD_P_2_AD_L_B - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! AD_P_2_AD_L_B - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! AD_P_2_AD_L_B - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! ED_P_2_AD_P_TF: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_AD_P_TF, ErrStat2, ErrMsg2, .TRUE. ) ! ED_P_2_AD_P_TF - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! ED_P_2_AD_P_TF - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! ED_P_2_AD_P_TF - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! ED_P_2_AD_P_TF - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! ED_P_2_AD_P_R allocated yes/no - IF ( ALLOCATED(InData%ED_P_2_AD_P_R) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ED_P_2_AD_P_R upper/lower bounds for each dimension - DO i1 = LBOUND(InData%ED_P_2_AD_P_R,1), UBOUND(InData%ED_P_2_AD_P_R,1) - Int_BufSz = Int_BufSz + 3 ! ED_P_2_AD_P_R: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_AD_P_R(i1), ErrStat2, ErrMsg2, .TRUE. ) ! ED_P_2_AD_P_R - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! ED_P_2_AD_P_R - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! ED_P_2_AD_P_R - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! ED_P_2_AD_P_R - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! ED_P_2_AD_P_H: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_AD_P_H, ErrStat2, ErrMsg2, .TRUE. ) ! ED_P_2_AD_P_H - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! ED_P_2_AD_P_H - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! ED_P_2_AD_P_H - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! ED_P_2_AD_P_H - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! ED_P_2_AD_P_N: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_AD_P_N, ErrStat2, ErrMsg2, .TRUE. ) ! ED_P_2_AD_P_N - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! ED_P_2_AD_P_N - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! ED_P_2_AD_P_N - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! ED_P_2_AD_P_N - 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%PlatformPtMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! PlatformPtMesh - 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%TwrPtMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! TwrPtMesh - 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%TwrPtMeshAD, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! TwrPtMeshAD - 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%NacelleMotion, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! NacelleMotion - 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%HubPtMotion, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! HubPtMotion - 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%BladeRootMotion) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BladeRootMotion,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BladeRootMotion,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BladeRootMotion,1), UBOUND(InData%BladeRootMotion,1) - CALL MeshPack( InData%BladeRootMotion(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! BladeRootMotion - 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%BladeLn2Mesh) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BladeLn2Mesh,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BladeLn2Mesh,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BladeLn2Mesh,1), UBOUND(InData%BladeLn2Mesh,1) - CALL MeshPack( InData%BladeLn2Mesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! BladeLn2Mesh - 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%hasTower, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%rigidBlades, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%numBlades - Int_Xferred = Int_Xferred + 1 - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_AD_P_T, ErrStat2, ErrMsg2, OnlySize ) ! ED_P_2_AD_P_T - 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 NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%AD_P_2_AD_L_T, ErrStat2, ErrMsg2, OnlySize ) ! AD_P_2_AD_L_T - 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%AD_P_2_AD_L_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%AD_P_2_AD_L_B,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AD_P_2_AD_L_B,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%AD_P_2_AD_L_B,1), UBOUND(InData%AD_P_2_AD_L_B,1) - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%AD_P_2_AD_L_B(i1), ErrStat2, ErrMsg2, OnlySize ) ! AD_P_2_AD_L_B - 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 - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_AD_P_TF, ErrStat2, ErrMsg2, OnlySize ) ! ED_P_2_AD_P_TF - 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%ED_P_2_AD_P_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%ED_P_2_AD_P_R,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ED_P_2_AD_P_R,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ED_P_2_AD_P_R,1), UBOUND(InData%ED_P_2_AD_P_R,1) - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_AD_P_R(i1), ErrStat2, ErrMsg2, OnlySize ) ! ED_P_2_AD_P_R - 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 - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_AD_P_H, ErrStat2, ErrMsg2, OnlySize ) ! ED_P_2_AD_P_H - 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 NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_AD_P_N, ErrStat2, ErrMsg2, OnlySize ) ! ED_P_2_AD_P_N - 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 ADI_PackRotFED - - SUBROUTINE ADI_UnPackRotFED( 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(RotFED), 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 = 'ADI_UnPackRotFED' - ! 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%PlatformPtMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! PlatformPtMesh - 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%TwrPtMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! TwrPtMesh - 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%TwrPtMeshAD, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! TwrPtMeshAD - 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%NacelleMotion, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! NacelleMotion - 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%HubPtMotion, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! HubPtMotion - 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 ! BladeRootMotion not allocated - Int_Xferred = Int_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%BladeRootMotion)) DEALLOCATE(OutData%BladeRootMotion) - ALLOCATE(OutData%BladeRootMotion(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeRootMotion.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BladeRootMotion,1), UBOUND(OutData%BladeRootMotion,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%BladeRootMotion(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! BladeRootMotion - 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 ! BladeLn2Mesh not allocated - Int_Xferred = Int_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%BladeLn2Mesh)) DEALLOCATE(OutData%BladeLn2Mesh) - ALLOCATE(OutData%BladeLn2Mesh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeLn2Mesh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BladeLn2Mesh,1), UBOUND(OutData%BladeLn2Mesh,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%BladeLn2Mesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! BladeLn2Mesh - 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%hasTower = TRANSFER(IntKiBuf(Int_Xferred), OutData%hasTower) - Int_Xferred = Int_Xferred + 1 - OutData%rigidBlades = TRANSFER(IntKiBuf(Int_Xferred), OutData%rigidBlades) - Int_Xferred = Int_Xferred + 1 - OutData%numBlades = IntKiBuf(Int_Xferred) - 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_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%ED_P_2_AD_P_T, ErrStat2, ErrMsg2 ) ! ED_P_2_AD_P_T - 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 NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%AD_P_2_AD_L_T, ErrStat2, ErrMsg2 ) ! AD_P_2_AD_L_T - 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 ! AD_P_2_AD_L_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%AD_P_2_AD_L_B)) DEALLOCATE(OutData%AD_P_2_AD_L_B) - ALLOCATE(OutData%AD_P_2_AD_L_B(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AD_P_2_AD_L_B.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%AD_P_2_AD_L_B,1), UBOUND(OutData%AD_P_2_AD_L_B,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%AD_P_2_AD_L_B(i1), ErrStat2, ErrMsg2 ) ! AD_P_2_AD_L_B - 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 - 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%ED_P_2_AD_P_TF, ErrStat2, ErrMsg2 ) ! ED_P_2_AD_P_TF - 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 ! ED_P_2_AD_P_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%ED_P_2_AD_P_R)) DEALLOCATE(OutData%ED_P_2_AD_P_R) - ALLOCATE(OutData%ED_P_2_AD_P_R(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ED_P_2_AD_P_R.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ED_P_2_AD_P_R,1), UBOUND(OutData%ED_P_2_AD_P_R,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%ED_P_2_AD_P_R(i1), ErrStat2, ErrMsg2 ) ! ED_P_2_AD_P_R - 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 - 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%ED_P_2_AD_P_H, ErrStat2, ErrMsg2 ) ! ED_P_2_AD_P_H - 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 NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%ED_P_2_AD_P_N, ErrStat2, ErrMsg2 ) ! ED_P_2_AD_P_N - 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 ADI_UnPackRotFED - - SUBROUTINE ADI_CopyFED_Data( SrcFED_DataData, DstFED_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FED_Data), INTENT(INOUT) :: SrcFED_DataData - TYPE(FED_Data), INTENT(INOUT) :: DstFED_DataData - 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 = 'ADI_CopyFED_Data' -! + ErrMsg = '' + call AD_CopyConstrState(SrcConstrStateData%AD, DstConstrStateData%AD, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine ADI_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) + type(ADI_ConstraintStateType), intent(inout) :: ConstrStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ADI_DestroyConstrState' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcFED_DataData%WT)) THEN - i1_l = LBOUND(SrcFED_DataData%WT,1) - i1_u = UBOUND(SrcFED_DataData%WT,1) - IF (.NOT. ALLOCATED(DstFED_DataData%WT)) THEN - ALLOCATE(DstFED_DataData%WT(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstFED_DataData%WT.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcFED_DataData%WT,1), UBOUND(SrcFED_DataData%WT,1) - CALL ADI_Copyrotfed( SrcFED_DataData%WT(i1), DstFED_DataData%WT(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - END SUBROUTINE ADI_CopyFED_Data - - SUBROUTINE ADI_DestroyFED_Data( FED_DataData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(FED_Data), INTENT(INOUT) :: FED_DataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ADI_DestroyFED_Data' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(FED_DataData%WT)) THEN -DO i1 = LBOUND(FED_DataData%WT,1), UBOUND(FED_DataData%WT,1) - CALL ADI_Destroyrotfed( FED_DataData%WT(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(FED_DataData%WT) -ENDIF - END SUBROUTINE ADI_DestroyFED_Data - - SUBROUTINE ADI_PackFED_Data( 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(FED_Data), 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 = 'ADI_PackFED_Data' - ! 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 ! WT allocated yes/no - IF ( ALLOCATED(InData%WT) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WT upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%WT,1), UBOUND(InData%WT,1) - Int_BufSz = Int_BufSz + 3 ! WT: size of buffers for each call to pack subtype - CALL ADI_Packrotfed( Re_Buf, Db_Buf, Int_Buf, InData%WT(i1), ErrStat2, ErrMsg2, .TRUE. ) ! WT - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! WT - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! WT - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! WT - 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%WT) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WT,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WT,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WT,1), UBOUND(InData%WT,1) - CALL ADI_Packrotfed( Re_Buf, Db_Buf, Int_Buf, InData%WT(i1), ErrStat2, ErrMsg2, OnlySize ) ! WT - 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 ADI_PackFED_Data - - SUBROUTINE ADI_UnPackFED_Data( 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(FED_Data), 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 = 'ADI_UnPackFED_Data' - ! 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 ! WT not allocated - Int_Xferred = Int_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%WT)) DEALLOCATE(OutData%WT) - ALLOCATE(OutData%WT(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WT.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WT,1), UBOUND(OutData%WT,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 ADI_Unpackrotfed( Re_Buf, Db_Buf, Int_Buf, OutData%WT(i1), ErrStat2, ErrMsg2 ) ! WT - 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 ADI_UnPackFED_Data - + ErrMsg = '' + call AD_DestroyConstrState(ConstrStateData%AD, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine ADI_PackConstrState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(ADI_ConstraintStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ADI_PackConstrState' + if (RF%ErrStat >= AbortErrLev) return + call AD_PackConstrState(RF, InData%AD) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ADI_UnPackConstrState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(ADI_ConstraintStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ADI_UnPackConstrState' + if (RF%ErrStat /= ErrID_None) return + call AD_UnpackConstrState(RF, OutData%AD) ! AD +end subroutine + +subroutine ADI_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) + type(ADI_OtherStateType), intent(in) :: SrcOtherStateData + type(ADI_OtherStateType), intent(inout) :: DstOtherStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ADI_CopyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + call AD_CopyOtherState(SrcOtherStateData%AD, DstOtherStateData%AD, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine ADI_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) + type(ADI_OtherStateType), intent(inout) :: OtherStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ADI_DestroyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + call AD_DestroyOtherState(OtherStateData%AD, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine ADI_PackOtherState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(ADI_OtherStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ADI_PackOtherState' + if (RF%ErrStat >= AbortErrLev) return + call AD_PackOtherState(RF, InData%AD) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ADI_UnPackOtherState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(ADI_OtherStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ADI_UnPackOtherState' + if (RF%ErrStat /= ErrID_None) return + call AD_UnpackOtherState(RF, OutData%AD) ! AD +end subroutine + +subroutine ADI_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(ADI_MiscVarType), intent(inout) :: SrcMiscData + type(ADI_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ADI_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + call AD_CopyMisc(SrcMiscData%AD, DstMiscData%AD, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call ADI_CopyInflowWindData(SrcMiscData%IW, DstMiscData%IW, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcMiscData%VTK_surfaces)) then + LB(1:1) = lbound(SrcMiscData%VTK_surfaces) + UB(1:1) = ubound(SrcMiscData%VTK_surfaces) + if (.not. allocated(DstMiscData%VTK_surfaces)) then + allocate(DstMiscData%VTK_surfaces(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%VTK_surfaces.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AD_CopyVTK_RotSurfaceType(SrcMiscData%VTK_surfaces(i1), DstMiscData%VTK_surfaces(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if +end subroutine + +subroutine ADI_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(ADI_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ADI_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' + call AD_DestroyMisc(MiscData%AD, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call ADI_DestroyInflowWindData(MiscData%IW, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(MiscData%VTK_surfaces)) then + LB(1:1) = lbound(MiscData%VTK_surfaces) + UB(1:1) = ubound(MiscData%VTK_surfaces) + do i1 = LB(1), UB(1) + call AD_DestroyVTK_RotSurfaceType(MiscData%VTK_surfaces(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%VTK_surfaces) + end if +end subroutine + +subroutine ADI_PackMisc(RF, Indata) + type(RegFile), intent(inout) :: RF + type(ADI_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ADI_PackMisc' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + if (RF%ErrStat >= AbortErrLev) return + call AD_PackMisc(RF, InData%AD) + call ADI_PackInflowWindData(RF, InData%IW) + call RegPack(RF, allocated(InData%VTK_surfaces)) + if (allocated(InData%VTK_surfaces)) then + call RegPackBounds(RF, 1, lbound(InData%VTK_surfaces), ubound(InData%VTK_surfaces)) + LB(1:1) = lbound(InData%VTK_surfaces) + UB(1:1) = ubound(InData%VTK_surfaces) + do i1 = LB(1), UB(1) + call AD_PackVTK_RotSurfaceType(RF, InData%VTK_surfaces(i1)) + end do + end if + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ADI_UnPackMisc(RF, OutData) + type(RegFile), intent(inout) :: RF + type(ADI_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ADI_UnPackMisc' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call AD_UnpackMisc(RF, OutData%AD) ! AD + call ADI_UnpackInflowWindData(RF, OutData%IW) ! IW + if (allocated(OutData%VTK_surfaces)) deallocate(OutData%VTK_surfaces) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%VTK_surfaces(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%VTK_surfaces.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AD_UnpackVTK_RotSurfaceType(RF, OutData%VTK_surfaces(i1)) ! VTK_surfaces + end do + end if +end subroutine + +subroutine ADI_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(ADI_ParameterType), intent(in) :: SrcParamData + type(ADI_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ADI_CopyParam' + ErrStat = ErrID_None + ErrMsg = '' + call AD_CopyParam(SrcParamData%AD, DstParamData%AD, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstParamData%dt = SrcParamData%dt + DstParamData%storeHHVel = SrcParamData%storeHHVel + DstParamData%wrVTK = SrcParamData%wrVTK + DstParamData%WrVTK_Type = SrcParamData%WrVTK_Type + DstParamData%NumOuts = SrcParamData%NumOuts + DstParamData%MHK = SrcParamData%MHK + DstParamData%WtrDpth = SrcParamData%WtrDpth +end subroutine + +subroutine ADI_DestroyParam(ParamData, ErrStat, ErrMsg) + type(ADI_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ADI_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' + call AD_DestroyParam(ParamData%AD, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine ADI_PackParam(RF, Indata) + type(RegFile), intent(inout) :: RF + type(ADI_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ADI_PackParam' + if (RF%ErrStat >= AbortErrLev) return + call AD_PackParam(RF, InData%AD) + call RegPack(RF, InData%dt) + call RegPack(RF, InData%storeHHVel) + call RegPack(RF, InData%wrVTK) + call RegPack(RF, InData%WrVTK_Type) + call RegPack(RF, InData%NumOuts) + call RegPack(RF, InData%MHK) + call RegPack(RF, InData%WtrDpth) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ADI_UnPackParam(RF, OutData) + type(RegFile), intent(inout) :: RF + type(ADI_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ADI_UnPackParam' + if (RF%ErrStat /= ErrID_None) return + call AD_UnpackParam(RF, OutData%AD) ! AD + call RegUnpack(RF, OutData%dt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%storeHHVel); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%wrVTK); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WrVTK_Type); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumOuts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MHK); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WtrDpth); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ADI_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) + type(ADI_InputType), intent(inout) :: SrcInputData + type(ADI_InputType), intent(inout) :: DstInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ADI_CopyInput' + ErrStat = ErrID_None + ErrMsg = '' + call AD_CopyInput(SrcInputData%AD, DstInputData%AD, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine ADI_DestroyInput(InputData, ErrStat, ErrMsg) + type(ADI_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ADI_DestroyInput' + ErrStat = ErrID_None + ErrMsg = '' + call AD_DestroyInput(InputData%AD, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine ADI_PackInput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(ADI_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ADI_PackInput' + if (RF%ErrStat >= AbortErrLev) return + call AD_PackInput(RF, InData%AD) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ADI_UnPackInput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(ADI_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ADI_UnPackInput' + if (RF%ErrStat /= ErrID_None) return + call AD_UnpackInput(RF, OutData%AD) ! AD +end subroutine + +subroutine ADI_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(ADI_OutputType), intent(inout) :: SrcOutputData + type(ADI_OutputType), intent(inout) :: DstOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ADI_CopyOutput' + ErrStat = ErrID_None + ErrMsg = '' + call AD_CopyOutput(SrcOutputData%AD, DstOutputData%AD, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcOutputData%HHVel)) then + LB(1:2) = lbound(SrcOutputData%HHVel) + UB(1:2) = ubound(SrcOutputData%HHVel) + if (.not. allocated(DstOutputData%HHVel)) then + allocate(DstOutputData%HHVel(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%HHVel.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%HHVel = SrcOutputData%HHVel + end if + DstOutputData%PLExp = SrcOutputData%PLExp + if (allocated(SrcOutputData%IW_WriteOutput)) then + LB(1:1) = lbound(SrcOutputData%IW_WriteOutput) + UB(1:1) = ubound(SrcOutputData%IW_WriteOutput) + if (.not. allocated(DstOutputData%IW_WriteOutput)) then + allocate(DstOutputData%IW_WriteOutput(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%IW_WriteOutput.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%IW_WriteOutput = SrcOutputData%IW_WriteOutput + end if + if (allocated(SrcOutputData%WriteOutput)) then + LB(1:1) = lbound(SrcOutputData%WriteOutput) + UB(1:1) = ubound(SrcOutputData%WriteOutput) + if (.not. allocated(DstOutputData%WriteOutput)) then + allocate(DstOutputData%WriteOutput(LB(1):UB(1)), 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 + end if +end subroutine + +subroutine ADI_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(ADI_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ADI_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' + call AD_DestroyOutput(OutputData%AD, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(OutputData%HHVel)) then + deallocate(OutputData%HHVel) + end if + if (allocated(OutputData%IW_WriteOutput)) then + deallocate(OutputData%IW_WriteOutput) + end if + if (allocated(OutputData%WriteOutput)) then + deallocate(OutputData%WriteOutput) + end if +end subroutine + +subroutine ADI_PackOutput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(ADI_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ADI_PackOutput' + if (RF%ErrStat >= AbortErrLev) return + call AD_PackOutput(RF, InData%AD) + call RegPackAlloc(RF, InData%HHVel) + call RegPack(RF, InData%PLExp) + call RegPackAlloc(RF, InData%IW_WriteOutput) + call RegPackAlloc(RF, InData%WriteOutput) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ADI_UnPackOutput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(ADI_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ADI_UnPackOutput' + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call AD_UnpackOutput(RF, OutData%AD) ! AD + call RegUnpackAlloc(RF, OutData%HHVel); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PLExp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%IW_WriteOutput); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WriteOutput); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ADI_CopyData(SrcDataData, DstDataData, CtrlCode, ErrStat, ErrMsg) + type(ADI_Data), intent(inout) :: SrcDataData + type(ADI_Data), intent(inout) :: DstDataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ADI_CopyData' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcDataData%x)) then + LB(1:1) = lbound(SrcDataData%x) + UB(1:1) = ubound(SrcDataData%x) + if (.not. allocated(DstDataData%x)) then + allocate(DstDataData%x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDataData%x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call ADI_CopyContState(SrcDataData%x(i1), DstDataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcDataData%xd)) then + LB(1:1) = lbound(SrcDataData%xd) + UB(1:1) = ubound(SrcDataData%xd) + if (.not. allocated(DstDataData%xd)) then + allocate(DstDataData%xd(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDataData%xd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call ADI_CopyDiscState(SrcDataData%xd(i1), DstDataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcDataData%z)) then + LB(1:1) = lbound(SrcDataData%z) + UB(1:1) = ubound(SrcDataData%z) + if (.not. allocated(DstDataData%z)) then + allocate(DstDataData%z(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDataData%z.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call ADI_CopyConstrState(SrcDataData%z(i1), DstDataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcDataData%OtherState)) then + LB(1:1) = lbound(SrcDataData%OtherState) + UB(1:1) = ubound(SrcDataData%OtherState) + if (.not. allocated(DstDataData%OtherState)) then + allocate(DstDataData%OtherState(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDataData%OtherState.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call ADI_CopyOtherState(SrcDataData%OtherState(i1), DstDataData%OtherState(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call ADI_CopyParam(SrcDataData%p, DstDataData%p, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call ADI_CopyMisc(SrcDataData%m, DstDataData%m, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcDataData%u)) then + LB(1:1) = lbound(SrcDataData%u) + UB(1:1) = ubound(SrcDataData%u) + if (.not. allocated(DstDataData%u)) then + allocate(DstDataData%u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDataData%u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call ADI_CopyInput(SrcDataData%u(i1), DstDataData%u(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call ADI_CopyOutput(SrcDataData%y, DstDataData%y, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcDataData%inputTimes)) then + LB(1:1) = lbound(SrcDataData%inputTimes) + UB(1:1) = ubound(SrcDataData%inputTimes) + if (.not. allocated(DstDataData%inputTimes)) then + allocate(DstDataData%inputTimes(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDataData%inputTimes.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDataData%inputTimes = SrcDataData%inputTimes + end if +end subroutine + +subroutine ADI_DestroyData(DataData, ErrStat, ErrMsg) + type(ADI_Data), intent(inout) :: DataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ADI_DestroyData' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(DataData%x)) then + LB(1:1) = lbound(DataData%x) + UB(1:1) = ubound(DataData%x) + do i1 = LB(1), UB(1) + call ADI_DestroyContState(DataData%x(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(DataData%x) + end if + if (allocated(DataData%xd)) then + LB(1:1) = lbound(DataData%xd) + UB(1:1) = ubound(DataData%xd) + do i1 = LB(1), UB(1) + call ADI_DestroyDiscState(DataData%xd(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(DataData%xd) + end if + if (allocated(DataData%z)) then + LB(1:1) = lbound(DataData%z) + UB(1:1) = ubound(DataData%z) + do i1 = LB(1), UB(1) + call ADI_DestroyConstrState(DataData%z(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(DataData%z) + end if + if (allocated(DataData%OtherState)) then + LB(1:1) = lbound(DataData%OtherState) + UB(1:1) = ubound(DataData%OtherState) + do i1 = LB(1), UB(1) + call ADI_DestroyOtherState(DataData%OtherState(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(DataData%OtherState) + end if + call ADI_DestroyParam(DataData%p, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call ADI_DestroyMisc(DataData%m, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(DataData%u)) then + LB(1:1) = lbound(DataData%u) + UB(1:1) = ubound(DataData%u) + do i1 = LB(1), UB(1) + call ADI_DestroyInput(DataData%u(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(DataData%u) + end if + call ADI_DestroyOutput(DataData%y, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(DataData%inputTimes)) then + deallocate(DataData%inputTimes) + end if +end subroutine + +subroutine ADI_PackData(RF, Indata) + type(RegFile), intent(inout) :: RF + type(ADI_Data), intent(in) :: InData + character(*), parameter :: RoutineName = 'ADI_PackData' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%x)) + if (allocated(InData%x)) then + call RegPackBounds(RF, 1, lbound(InData%x), ubound(InData%x)) + LB(1:1) = lbound(InData%x) + UB(1:1) = ubound(InData%x) + do i1 = LB(1), UB(1) + call ADI_PackContState(RF, InData%x(i1)) + end do + end if + call RegPack(RF, allocated(InData%xd)) + if (allocated(InData%xd)) then + call RegPackBounds(RF, 1, lbound(InData%xd), ubound(InData%xd)) + LB(1:1) = lbound(InData%xd) + UB(1:1) = ubound(InData%xd) + do i1 = LB(1), UB(1) + call ADI_PackDiscState(RF, InData%xd(i1)) + end do + end if + call RegPack(RF, allocated(InData%z)) + if (allocated(InData%z)) then + call RegPackBounds(RF, 1, lbound(InData%z), ubound(InData%z)) + LB(1:1) = lbound(InData%z) + UB(1:1) = ubound(InData%z) + do i1 = LB(1), UB(1) + call ADI_PackConstrState(RF, InData%z(i1)) + end do + end if + call RegPack(RF, allocated(InData%OtherState)) + if (allocated(InData%OtherState)) then + call RegPackBounds(RF, 1, lbound(InData%OtherState), ubound(InData%OtherState)) + LB(1:1) = lbound(InData%OtherState) + UB(1:1) = ubound(InData%OtherState) + do i1 = LB(1), UB(1) + call ADI_PackOtherState(RF, InData%OtherState(i1)) + end do + end if + call ADI_PackParam(RF, InData%p) + call ADI_PackMisc(RF, InData%m) + call RegPack(RF, allocated(InData%u)) + if (allocated(InData%u)) then + call RegPackBounds(RF, 1, lbound(InData%u), ubound(InData%u)) + LB(1:1) = lbound(InData%u) + UB(1:1) = ubound(InData%u) + do i1 = LB(1), UB(1) + call ADI_PackInput(RF, InData%u(i1)) + end do + end if + call ADI_PackOutput(RF, InData%y) + call RegPackAlloc(RF, InData%inputTimes) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ADI_UnPackData(RF, OutData) + type(RegFile), intent(inout) :: RF + type(ADI_Data), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ADI_UnPackData' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + if (allocated(OutData%x)) deallocate(OutData%x) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%x(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call ADI_UnpackContState(RF, OutData%x(i1)) ! x + end do + end if + if (allocated(OutData%xd)) deallocate(OutData%xd) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%xd(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call ADI_UnpackDiscState(RF, OutData%xd(i1)) ! xd + end do + end if + if (allocated(OutData%z)) deallocate(OutData%z) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%z(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call ADI_UnpackConstrState(RF, OutData%z(i1)) ! z + end do + end if + if (allocated(OutData%OtherState)) deallocate(OutData%OtherState) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%OtherState(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherState.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call ADI_UnpackOtherState(RF, OutData%OtherState(i1)) ! OtherState + end do + end if + call ADI_UnpackParam(RF, OutData%p) ! p + call ADI_UnpackMisc(RF, OutData%m) ! m + if (allocated(OutData%u)) deallocate(OutData%u) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%u(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call ADI_UnpackInput(RF, OutData%u(i1)) ! u + end do + end if + call ADI_UnpackOutput(RF, OutData%y) ! y + call RegUnpackAlloc(RF, OutData%inputTimes); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ADI_CopyRotFED(SrcRotFEDData, DstRotFEDData, CtrlCode, ErrStat, ErrMsg) + type(RotFED), intent(inout) :: SrcRotFEDData + type(RotFED), intent(inout) :: DstRotFEDData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ADI_CopyRotFED' + ErrStat = ErrID_None + ErrMsg = '' + call MeshCopy(SrcRotFEDData%PlatformPtMesh, DstRotFEDData%PlatformPtMesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcRotFEDData%TwrPtMesh, DstRotFEDData%TwrPtMesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcRotFEDData%TwrPtMeshAD, DstRotFEDData%TwrPtMeshAD, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcRotFEDData%NacelleMotion, DstRotFEDData%NacelleMotion, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcRotFEDData%HubPtMotion, DstRotFEDData%HubPtMotion, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcRotFEDData%BladeRootMotion)) then + LB(1:1) = lbound(SrcRotFEDData%BladeRootMotion) + UB(1:1) = ubound(SrcRotFEDData%BladeRootMotion) + if (.not. allocated(DstRotFEDData%BladeRootMotion)) then + allocate(DstRotFEDData%BladeRootMotion(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotFEDData%BladeRootMotion.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MeshCopy(SrcRotFEDData%BladeRootMotion(i1), DstRotFEDData%BladeRootMotion(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcRotFEDData%BladeLn2Mesh)) then + LB(1:1) = lbound(SrcRotFEDData%BladeLn2Mesh) + UB(1:1) = ubound(SrcRotFEDData%BladeLn2Mesh) + if (.not. allocated(DstRotFEDData%BladeLn2Mesh)) then + allocate(DstRotFEDData%BladeLn2Mesh(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotFEDData%BladeLn2Mesh.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MeshCopy(SrcRotFEDData%BladeLn2Mesh(i1), DstRotFEDData%BladeLn2Mesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + DstRotFEDData%hasTower = SrcRotFEDData%hasTower + DstRotFEDData%rigidBlades = SrcRotFEDData%rigidBlades + DstRotFEDData%numBlades = SrcRotFEDData%numBlades + call NWTC_Library_CopyMeshMapType(SrcRotFEDData%ED_P_2_AD_P_T, DstRotFEDData%ED_P_2_AD_P_T, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyMeshMapType(SrcRotFEDData%AD_P_2_AD_L_T, DstRotFEDData%AD_P_2_AD_L_T, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcRotFEDData%AD_P_2_AD_L_B)) then + LB(1:1) = lbound(SrcRotFEDData%AD_P_2_AD_L_B) + UB(1:1) = ubound(SrcRotFEDData%AD_P_2_AD_L_B) + if (.not. allocated(DstRotFEDData%AD_P_2_AD_L_B)) then + allocate(DstRotFEDData%AD_P_2_AD_L_B(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotFEDData%AD_P_2_AD_L_B.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcRotFEDData%AD_P_2_AD_L_B(i1), DstRotFEDData%AD_P_2_AD_L_B(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call NWTC_Library_CopyMeshMapType(SrcRotFEDData%ED_P_2_AD_P_TF, DstRotFEDData%ED_P_2_AD_P_TF, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcRotFEDData%ED_P_2_AD_P_R)) then + LB(1:1) = lbound(SrcRotFEDData%ED_P_2_AD_P_R) + UB(1:1) = ubound(SrcRotFEDData%ED_P_2_AD_P_R) + if (.not. allocated(DstRotFEDData%ED_P_2_AD_P_R)) then + allocate(DstRotFEDData%ED_P_2_AD_P_R(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotFEDData%ED_P_2_AD_P_R.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcRotFEDData%ED_P_2_AD_P_R(i1), DstRotFEDData%ED_P_2_AD_P_R(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call NWTC_Library_CopyMeshMapType(SrcRotFEDData%ED_P_2_AD_P_H, DstRotFEDData%ED_P_2_AD_P_H, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyMeshMapType(SrcRotFEDData%ED_P_2_AD_P_N, DstRotFEDData%ED_P_2_AD_P_N, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine ADI_DestroyRotFED(RotFEDData, ErrStat, ErrMsg) + type(RotFED), intent(inout) :: RotFEDData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ADI_DestroyRotFED' + ErrStat = ErrID_None + ErrMsg = '' + call MeshDestroy( RotFEDData%PlatformPtMesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( RotFEDData%TwrPtMesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( RotFEDData%TwrPtMeshAD, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( RotFEDData%NacelleMotion, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( RotFEDData%HubPtMotion, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(RotFEDData%BladeRootMotion)) then + LB(1:1) = lbound(RotFEDData%BladeRootMotion) + UB(1:1) = ubound(RotFEDData%BladeRootMotion) + do i1 = LB(1), UB(1) + call MeshDestroy( RotFEDData%BladeRootMotion(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(RotFEDData%BladeRootMotion) + end if + if (allocated(RotFEDData%BladeLn2Mesh)) then + LB(1:1) = lbound(RotFEDData%BladeLn2Mesh) + UB(1:1) = ubound(RotFEDData%BladeLn2Mesh) + do i1 = LB(1), UB(1) + call MeshDestroy( RotFEDData%BladeLn2Mesh(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(RotFEDData%BladeLn2Mesh) + end if + call NWTC_Library_DestroyMeshMapType(RotFEDData%ED_P_2_AD_P_T, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call NWTC_Library_DestroyMeshMapType(RotFEDData%AD_P_2_AD_L_T, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(RotFEDData%AD_P_2_AD_L_B)) then + LB(1:1) = lbound(RotFEDData%AD_P_2_AD_L_B) + UB(1:1) = ubound(RotFEDData%AD_P_2_AD_L_B) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(RotFEDData%AD_P_2_AD_L_B(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(RotFEDData%AD_P_2_AD_L_B) + end if + call NWTC_Library_DestroyMeshMapType(RotFEDData%ED_P_2_AD_P_TF, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(RotFEDData%ED_P_2_AD_P_R)) then + LB(1:1) = lbound(RotFEDData%ED_P_2_AD_P_R) + UB(1:1) = ubound(RotFEDData%ED_P_2_AD_P_R) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(RotFEDData%ED_P_2_AD_P_R(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(RotFEDData%ED_P_2_AD_P_R) + end if + call NWTC_Library_DestroyMeshMapType(RotFEDData%ED_P_2_AD_P_H, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call NWTC_Library_DestroyMeshMapType(RotFEDData%ED_P_2_AD_P_N, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine ADI_PackRotFED(RF, Indata) + type(RegFile), intent(inout) :: RF + type(RotFED), intent(in) :: InData + character(*), parameter :: RoutineName = 'ADI_PackRotFED' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + if (RF%ErrStat >= AbortErrLev) return + call MeshPack(RF, InData%PlatformPtMesh) + call MeshPack(RF, InData%TwrPtMesh) + call MeshPack(RF, InData%TwrPtMeshAD) + call MeshPack(RF, InData%NacelleMotion) + call MeshPack(RF, InData%HubPtMotion) + call RegPack(RF, allocated(InData%BladeRootMotion)) + if (allocated(InData%BladeRootMotion)) then + call RegPackBounds(RF, 1, lbound(InData%BladeRootMotion), ubound(InData%BladeRootMotion)) + LB(1:1) = lbound(InData%BladeRootMotion) + UB(1:1) = ubound(InData%BladeRootMotion) + do i1 = LB(1), UB(1) + call MeshPack(RF, InData%BladeRootMotion(i1)) + end do + end if + call RegPack(RF, allocated(InData%BladeLn2Mesh)) + if (allocated(InData%BladeLn2Mesh)) then + call RegPackBounds(RF, 1, lbound(InData%BladeLn2Mesh), ubound(InData%BladeLn2Mesh)) + LB(1:1) = lbound(InData%BladeLn2Mesh) + UB(1:1) = ubound(InData%BladeLn2Mesh) + do i1 = LB(1), UB(1) + call MeshPack(RF, InData%BladeLn2Mesh(i1)) + end do + end if + call RegPack(RF, InData%hasTower) + call RegPack(RF, InData%rigidBlades) + call RegPack(RF, InData%numBlades) + call NWTC_Library_PackMeshMapType(RF, InData%ED_P_2_AD_P_T) + call NWTC_Library_PackMeshMapType(RF, InData%AD_P_2_AD_L_T) + call RegPack(RF, allocated(InData%AD_P_2_AD_L_B)) + if (allocated(InData%AD_P_2_AD_L_B)) then + call RegPackBounds(RF, 1, lbound(InData%AD_P_2_AD_L_B), ubound(InData%AD_P_2_AD_L_B)) + LB(1:1) = lbound(InData%AD_P_2_AD_L_B) + UB(1:1) = ubound(InData%AD_P_2_AD_L_B) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(RF, InData%AD_P_2_AD_L_B(i1)) + end do + end if + call NWTC_Library_PackMeshMapType(RF, InData%ED_P_2_AD_P_TF) + call RegPack(RF, allocated(InData%ED_P_2_AD_P_R)) + if (allocated(InData%ED_P_2_AD_P_R)) then + call RegPackBounds(RF, 1, lbound(InData%ED_P_2_AD_P_R), ubound(InData%ED_P_2_AD_P_R)) + LB(1:1) = lbound(InData%ED_P_2_AD_P_R) + UB(1:1) = ubound(InData%ED_P_2_AD_P_R) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(RF, InData%ED_P_2_AD_P_R(i1)) + end do + end if + call NWTC_Library_PackMeshMapType(RF, InData%ED_P_2_AD_P_H) + call NWTC_Library_PackMeshMapType(RF, InData%ED_P_2_AD_P_N) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ADI_UnPackRotFED(RF, OutData) + type(RegFile), intent(inout) :: RF + type(RotFED), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ADI_UnPackRotFED' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call MeshUnpack(RF, OutData%PlatformPtMesh) ! PlatformPtMesh + call MeshUnpack(RF, OutData%TwrPtMesh) ! TwrPtMesh + call MeshUnpack(RF, OutData%TwrPtMeshAD) ! TwrPtMeshAD + call MeshUnpack(RF, OutData%NacelleMotion) ! NacelleMotion + call MeshUnpack(RF, OutData%HubPtMotion) ! HubPtMotion + if (allocated(OutData%BladeRootMotion)) deallocate(OutData%BladeRootMotion) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%BladeRootMotion(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeRootMotion.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(RF, OutData%BladeRootMotion(i1)) ! BladeRootMotion + end do + end if + if (allocated(OutData%BladeLn2Mesh)) deallocate(OutData%BladeLn2Mesh) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%BladeLn2Mesh(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeLn2Mesh.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(RF, OutData%BladeLn2Mesh(i1)) ! BladeLn2Mesh + end do + end if + call RegUnpack(RF, OutData%hasTower); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rigidBlades); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%numBlades); if (RegCheckErr(RF, RoutineName)) return + call NWTC_Library_UnpackMeshMapType(RF, OutData%ED_P_2_AD_P_T) ! ED_P_2_AD_P_T + call NWTC_Library_UnpackMeshMapType(RF, OutData%AD_P_2_AD_L_T) ! AD_P_2_AD_L_T + if (allocated(OutData%AD_P_2_AD_L_B)) deallocate(OutData%AD_P_2_AD_L_B) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%AD_P_2_AD_L_B(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AD_P_2_AD_L_B.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(RF, OutData%AD_P_2_AD_L_B(i1)) ! AD_P_2_AD_L_B + end do + end if + call NWTC_Library_UnpackMeshMapType(RF, OutData%ED_P_2_AD_P_TF) ! ED_P_2_AD_P_TF + if (allocated(OutData%ED_P_2_AD_P_R)) deallocate(OutData%ED_P_2_AD_P_R) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%ED_P_2_AD_P_R(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ED_P_2_AD_P_R.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(RF, OutData%ED_P_2_AD_P_R(i1)) ! ED_P_2_AD_P_R + end do + end if + call NWTC_Library_UnpackMeshMapType(RF, OutData%ED_P_2_AD_P_H) ! ED_P_2_AD_P_H + call NWTC_Library_UnpackMeshMapType(RF, OutData%ED_P_2_AD_P_N) ! ED_P_2_AD_P_N +end subroutine + +subroutine ADI_CopyFED_Data(SrcFED_DataData, DstFED_DataData, CtrlCode, ErrStat, ErrMsg) + type(FED_Data), intent(inout) :: SrcFED_DataData + type(FED_Data), intent(inout) :: DstFED_DataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ADI_CopyFED_Data' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcFED_DataData%WT)) then + LB(1:1) = lbound(SrcFED_DataData%WT) + UB(1:1) = ubound(SrcFED_DataData%WT) + if (.not. allocated(DstFED_DataData%WT)) then + allocate(DstFED_DataData%WT(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstFED_DataData%WT.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call ADI_CopyRotFED(SrcFED_DataData%WT(i1), DstFED_DataData%WT(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if +end subroutine + +subroutine ADI_DestroyFED_Data(FED_DataData, ErrStat, ErrMsg) + type(FED_Data), intent(inout) :: FED_DataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ADI_DestroyFED_Data' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(FED_DataData%WT)) then + LB(1:1) = lbound(FED_DataData%WT) + UB(1:1) = ubound(FED_DataData%WT) + do i1 = LB(1), UB(1) + call ADI_DestroyRotFED(FED_DataData%WT(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(FED_DataData%WT) + end if +end subroutine + +subroutine ADI_PackFED_Data(RF, Indata) + type(RegFile), intent(inout) :: RF + type(FED_Data), intent(in) :: InData + character(*), parameter :: RoutineName = 'ADI_PackFED_Data' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%WT)) + if (allocated(InData%WT)) then + call RegPackBounds(RF, 1, lbound(InData%WT), ubound(InData%WT)) + LB(1:1) = lbound(InData%WT) + UB(1:1) = ubound(InData%WT) + do i1 = LB(1), UB(1) + call ADI_PackRotFED(RF, InData%WT(i1)) + end do + end if + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ADI_UnPackFED_Data(RF, OutData) + type(RegFile), intent(inout) :: RF + type(FED_Data), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ADI_UnPackFED_Data' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + if (allocated(OutData%WT)) deallocate(OutData%WT) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%WT(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WT.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call ADI_UnpackRotFED(RF, OutData%WT(i1)) ! WT + end do + end if +end subroutine END MODULE AeroDyn_Inflow_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/aerodyn/src/AeroDyn_Registry.txt b/modules/aerodyn/src/AeroDyn_Registry.txt index 5f763c8a6c..9060a08859 100644 --- a/modules/aerodyn/src/AeroDyn_Registry.txt +++ b/modules/aerodyn/src/AeroDyn_Registry.txt @@ -16,16 +16,14 @@ usefrom BEMT_Registry.txt usefrom FVW_Registry.txt usefrom UnsteadyAero_Registry.txt usefrom AeroAcoustics_Registry.txt +usefrom InflowWind.txt param AeroDyn/AD - IntKi ModelUnknown - -1 - "" - param ^ - IntKi WakeMod_none - 0 - "Wake model - none" - param ^ - IntKi WakeMod_BEMT - 1 - "Wake model - BEMT (blade elememnt momentum theory)" - -param ^ - IntKi WakeMod_DBEMT - 2 - "Wake model - DBEMT (dynamic elememnt momentum theory)" - +#param ^ - IntKi WakeMod_TODO - 2 - "Wake model - TBD" - param ^ - IntKi WakeMod_FVW - 3 - "Wake model - FVW (free vortex wake, OLAF)" - -param ^ - IntKi AFAeroMod_steady - 1 - "steady model" - -param ^ - IntKi AFAeroMod_BL_unsteady - 2 - "Beddoes-Leishman unsteady model" - - param ^ - IntKi TwrPotent_none - 0 - "no tower potential flow" - param ^ - IntKi TwrPotent_baseline - 1 - "baseline tower potential flow" - param ^ - IntKi TwrPotent_Bak - 2 - "tower potential flow with Bak correction" - @@ -34,6 +32,13 @@ param ^ - IntKi TwrShadow_none - 0 - "no tower s param ^ - IntKi TwrShadow_Powles - 1 - "Powles tower shadow model" - param ^ - IntKi TwrShadow_Eames - 2 - "Eames tower shadow model" - +param ^ - IntKi TwrAero_none - 0 - "no tower aero" - +param ^ - IntKi TwrAero_noVIV - 1 - "Tower aero model without VIV" - +param ^ - IntKi TwrAero_VIV - 2 - "Tower aero model with VIV" - + +param ^ - IntKi SA_Wgt_Uniform - 1 - "Sector average weighting - Uniform" - +#param ^ - IntKi SA_Wgt_Impulse - 1 - "Sector average weighting - Impulse" - + param ^ - IntKi TFinAero_none - 0 - "no tail fin aero" - param ^ - IntKi TFinAero_polar - 1 - "polar-based tail fin aerodynamics" - param ^ - IntKi TFinAero_USB - 2 - "unsteady slender body tail fin aerodynamics model" - @@ -50,19 +55,29 @@ param ^ - IntKi AD_MaxBl_Out - 3 - "Maximum nu # Tail Fin parameters typedef ^ TFinParameterType IntKi TFinMod - - 0 "Tail fin aerodynamics model {0=none, 1=polar-based, 2=USB-based}" (switch) -typedef ^ TFinParameterType ReKi TFinChord - - - "Tail fin chord [used only when TFinMod=1]" m -typedef ^ TFinParameterType ReKi TFinArea - - - "Tail fin planform area [used only when TFinMod=1]" m^2 +typedef ^ TFinParameterType ReKi TFinArea - - - "Tail fin planform area" m^2 typedef ^ TFinParameterType IntKi TFinIndMod - - - "Model for induced velocity calculation {0=none, 1=rotor-average}" (switch) typedef ^ TFinParameterType IntKi TFinAFID - - - "Index of Tail fin airfoil number [1 to NumAFfiles]" - +typedef ^ TFinParameterType ReKi TFinChord - - - "Tail fin chord" m +typedef ^ TFinParameterType ReKi TFinKp - - - "Tail fin potential flow coefficient for unsteady aerodynamics" - +typedef ^ TFinParameterType ReKi TFinSigma 3 - - "Tail fin empirical constants characterizing the decay of separation functions" 1/deg +typedef ^ TFinParameterType ReKi TFinAStar 3 - - "Tail fin characteristics angles for separation functions" deg +typedef ^ TFinParameterType ReKi TFinKv - - - "Tail fin vortex lift coefficient for unsteady aerodynamics" - +typedef ^ TFinParameterType ReKi TFinCDc - - - "Tail fin drag coefficient for unsteady aerodynamics" - # Tail Fin input file typedef ^ TFinInputFileType IntKi TFinMod - - 0 "Tail fin aerodynamics model {0=none, 1=polar-based, 2=USB-based}" (switch) -typedef ^ TFinInputFileType ReKi TFinChord - - - "Tail fin chord [used only when TFinMod=1]" m -typedef ^ TFinInputFileType ReKi TFinArea - - - "Tail fin planform area [used only when TFinMod=1]" m^2 +typedef ^ TFinInputFileType ReKi TFinArea - - - "Tail fin planform area" m^2 typedef ^ TFinInputFileType ReKi TFinRefP_n 3 - - "Undeflected position of the tail fin reference point wrt the tower top" m typedef ^ TFinInputFileType ReKi TFinAngles 3 - - "Tail fin chordline skew, tilt, and bank angles about the reference point" (deg) typedef ^ TFinInputFileType IntKi TFinIndMod - - - "Model for induced velocity calculation {0=none, 1=rotor-average}" (switch) typedef ^ TFinInputFileType IntKi TFinAFID - - - "Index of Tail fin airfoil number [1 to NumAFfiles]" - +typedef ^ TFinInputFileType ReKi TFinChord - - - "Tail fin chord" m +typedef ^ TFinInputFileType ReKi TFinKp - - - "Tail fin potential flow coefficient for unsteady aerodynamics" - +typedef ^ TFinInputFileType ReKi TFinSigma 3 - - "Tail fin empirical constants characterizing the decay of separation functions" 1/deg +typedef ^ TFinInputFileType ReKi TFinAStar 3 - - "Tail fin characteristics angles for separation functions" deg +typedef ^ TFinInputFileType ReKi TFinKv - - - "Tail fin vortex lift coefficient for unsteady aerodynamics" - +typedef ^ TFinInputFileType ReKi TFinCDc - - - "Tail fin drag coefficient for unsteady aerodynamics" - @@ -76,6 +91,7 @@ typedef ^ ^ SiKi TowerRad # ..... Initialization data ....................................................................................................... # Define inputs that the initialization routine may need here: typedef AeroDyn/AD RotInitInputType IntKi NumBlades - - - "Number of blades on the turbine" - +typedef ^ RotInitInputType ReKi originInit {3} - 0 "X-Y-Z reference position for the turbine" m typedef ^ RotInitInputType ReKi HubPosition {3} - - "X-Y-Z reference position of hub" m typedef ^ RotInitInputType R8Ki HubOrientation {3}{3} - - "DCM reference orientation of hub" - typedef ^ RotInitInputType ReKi BladeRootPosition {:}{:} - - "X-Y-Z reference position of each blade root (3 x NumBlades)" m @@ -83,7 +99,7 @@ typedef ^ RotInitInputType R8Ki BladeRootOrientation {:}{:}{:} - - "DCM referenc typedef ^ RotInitInputType R8Ki NacellePosition {3} - - "X-Y-Z reference position of nacelle" m typedef ^ RotInitInputType R8Ki NacelleOrientation {3}{3} - - "DCM reference orientation of nacelle" - typedef ^ RotInitInputType IntKi AeroProjMod - 1 - "Flag to switch between different projection models" - -typedef ^ RotInitInputType IntKi AeroBEM_Mod - -1 - "Flag to switch between different BEM Model" - +typedef ^ RotInitInputType ReKi RotSpeed - - 0 "Rotor speed used when AeroDyn is computing aero maps" "rad/s" typedef ^ InitInputType RotInitInputType rotors {:} - - "Init Input Types for rotors" - typedef ^ InitInputType CHARACTER(1024) InputFile - - - "Name of the input file" - @@ -91,6 +107,7 @@ typedef ^ InitInputType CHARACTER(1024) RootName - - - "RootName for writing out typedef ^ InitInputType LOGICAL UsePrimaryInputFile - .TRUE. - "Read input file instead of passed data" - typedef ^ InitInputType FileInfoType PassedPrimaryInputData - - - "Primary input file as FileInfoType (set by driver/glue code)" - typedef ^ InitInputType Logical Linearize - .FALSE. - "Flag that tells this module if the glue code wants to linearize." - +typedef ^ InitInputType LOGICAL CompAeroMaps - .FALSE. - "flag to determine if AeroDyn is computing aero maps (true) or running a normal simulation (false)" - typedef ^ InitInputType ReKi Gravity - - - "Gravity force" Nm/s^2 typedef ^ InitInputType IntKi MHK - - - "MHK turbine type switch" - typedef ^ InitInputType ReKi defFldDens - - - "Default fluid density from the driver; may be overwritten" kg/m^3 @@ -100,6 +117,7 @@ typedef ^ InitInputType ReKi defPatm - - - "Default atmospheric typedef ^ InitInputType ReKi defPvap - - - "Default vapor pressure from the driver; may be overwritten" Pa typedef ^ InitInputType ReKi WtrDpth - - - "Water depth" m typedef ^ InitInputType ReKi MSL2SWL - - - "Offset between still-water level and mean sea level" m +typedef ^ InitInputType FlowFieldType *FlowField - - - "Pointer of InflowWinds flow field data type" - # This is data defined in the Input File for this module (or could otherwise be passed in) # ..... Blade Input file data ..................................................................................................... @@ -137,6 +155,7 @@ typedef ^ RotInitOutputType ReKi TwrDiam {:} - - "Diameter of tower at node" m typedef ^ InitOutputType RotInitOutputType rotors {:} - - "Rotor init output type" - typedef ^ InitOutputType ProgDesc Ver - - - "This module's name, version, and date" - +typedef ^ InitOutputType IntKi nNodesVel - - - "number of nodes velocity values are needed at (for ExtLoads coupling)" - # ..... Input file data ........................................................................................................... # ..... Primary Input file data ................................................................................................... @@ -154,21 +173,24 @@ typedef ^ RotInputFile ReKi HubCenBx - - - "Hub center of buoyancy x directio # Nacelle typedef ^ RotInputFile ReKi VolNac - - - "Nacelle volume" m^3 typedef ^ RotInputFile ReKi NacCenB 3 - - "Position of nacelle center of buoyancy from yaw bearing in nacelle coordinates" m +typedef ^ RotInputFile ReKi NacArea 3 - - "Projected area of the nacelle in X, Y, Z in the nacelle coordinate system" m^2 +typedef ^ RotInputFile ReKi NacCd 3 - - "Drag cefficient for the nacelle areas defied above" - +typedef ^ RotInputFile ReKi NacDragAC 3 - - "Position of aerodynamic center of nacelle drag in nacelle coordinates" m # TailFin typedef ^ RotInputFile LOGICAL TFinAero - .FALSE. - "Calculate tail fin aerodynamics model (flag)" flag typedef ^ RotInputFile CHARACTER(1024) TFinFile - - - "Input file for tail fin aerodynamics [used only when TFinAero=True]" - typedef ^ RotInputFile TFinInputFileType TFin - - - "Input file data for tail fin" - typedef ^ AD_InputFile Logical Echo - - - "Echo input file to echo file" - -typedef ^ AD_InputFile DbKi DTAero - - - "Time interval for aerodynamic calculations {or "default"}" s -typedef ^ AD_InputFile IntKi WakeMod - - - "Type of wake/induction model {0=none, 1=BEMT, 2=DBEMT, 3=FVW}" - -typedef ^ AD_InputFile IntKi AFAeroMod - - - "Type of blade airfoil aerodynamics model {1=steady model, 2=Beddoes-Leishman unsteady model}" - +typedef ^ AD_InputFile DbKi DTAero - - - "Time interval for aerodynamic calculations {or \"default\"}" s +typedef ^ AD_InputFile IntKi Wake_Mod - - - "Type of wake/induction model {0=none, 1=BEMT, 2=DBEMT, 3=FVW}" - +typedef ^ AD_InputFile IntKi BEM_Mod - - - "Type of BEM model {1=legacy NoSweepPitchTwist, 2=polar grid}" - typedef ^ AD_InputFile IntKi TwrPotent - - - "Type of tower influence on wind based on potential flow around the tower {0=none, 1=baseline potential flow, 2=potential flow with Bak correction}" - typedef ^ AD_InputFile IntKi TwrShadow - - - "Type of tower influence on wind based on downstream tower shadow {0=none, 1=Powles model, 2=Eames model}" - -typedef ^ AD_InputFile LOGICAL TwrAero - - - "Calculate tower aerodynamic loads?" flag -typedef ^ AD_InputFile Logical FrozenWake - - - "Flag that tells this module it should assume a frozen wake during linearization." - +typedef ^ AD_InputFile IntKi TwrAero - - - "Calculate tower aerodynamic loads? {0=none, 1=aero without VIV, 2=aero with VIV}" - typedef ^ AD_InputFile Logical CavitCheck - - - "Flag that tells us if we want to check for cavitation" - typedef ^ AD_InputFile Logical Buoyancy - - - "Include buoyancy effects?" flag +typedef ^ AD_InputFile Logical NacelleDrag - - - "Include NacelleDrag effects?" flag typedef ^ AD_InputFile Logical CompAA - - - "Compute AeroAcoustic noise" flag typedef ^ AD_InputFile CHARACTER(1024) AA_InputFile - - - "AeroAcoustics input file name" "quoted strings" typedef ^ AD_InputFile CHARACTER(1024) ADBlFile {:} - - "AD blade file (NumBl filenames)" "quoted strings" @@ -177,37 +199,44 @@ typedef ^ AD_InputFile ReKi KinVisc - - - "Kinematic air viscosity" m^2/s typedef ^ AD_InputFile ReKi Patm - - - "Atmospheric pressure" Pa typedef ^ AD_InputFile ReKi Pvap - - - "Vapour pressure" Pa typedef ^ AD_InputFile ReKi SpdSound - - - "Speed of sound" m/s -typedef ^ AD_InputFile IntKi SkewMod - - - "Type of skewed-wake correction model {0=orthogonal, 1=uncoupled, 2=Pitt/Peters, 3=coupled} [unused when WakeMod=0]" - +typedef ^ AD_InputFile IntKi Skew_Mod - - - "Select skew model {0=No skew model at all, -1=Throw away non-normal component for linearization, 1=Glauert skew model}" - +typedef ^ AD_InputFile Logical SkewMomCorr - - - "Turn the skew momentum correction on or off [used only when SkewMod=1]" - +typedef ^ AD_InputFile IntKi SkewRedistr_Mod - - - "Type of skewed-wake redistribution model (switch) {0=no redistribution, 1=Glauert/Pitt/Peters, 2=Vortex Cylinder} [unsed only when SkewMod=1]" - typedef ^ AD_InputFile ReKi SkewModFactor - - - "Constant used in Pitt/Peters skewed wake model (default is 15*pi/32)" - -typedef ^ AD_InputFile LOGICAL TipLoss - - - "Use the Prandtl tip-loss model? [unused when WakeMod=0]" flag -typedef ^ AD_InputFile LOGICAL HubLoss - - - "Use the Prandtl hub-loss model? [unused when WakeMod=0]" flag -typedef ^ AD_InputFile LOGICAL TanInd - - - "Include tangential induction in BEMT calculations? [unused when WakeMod=0]" flag -typedef ^ AD_InputFile LOGICAL AIDrag - - - "Include the drag term in the axial-induction calculation? [unused when WakeMod=0]" flag -typedef ^ AD_InputFile LOGICAL TIDrag - - - "Include the drag term in the tangential-induction calculation? [unused when WakeMod=0 or TanInd=FALSE]" flag -typedef ^ AD_InputFile ReKi IndToler - - - "Convergence tolerance for BEM induction factors [unused when WakeMod=0]" - -typedef ^ AD_InputFile ReKi MaxIter - - - "Maximum number of iteration steps [unused when WakeMod=0]" - -typedef ^ AD_InputFile IntKi UAMod - - - "Unsteady Aero Model Switch (switch) {1=Baseline model (Original), 2=Gonzalez's variant (changes in Cn,Cc,Cm), 3=Minnema/Pierce variant (changes in Cc and Cm)} [used only when AFAeroMod=2]" - -typedef ^ AD_InputFile LOGICAL FLookup - - - "Flag to indicate whether a lookup for f' will be calculated (TRUE) or whether best-fit exponential equations will be used (FALSE); if FALSE S1-S4 must be provided in airfoil input files [used only when AFAeroMod=2]" flag +typedef ^ AD_InputFile LOGICAL TipLoss - - - "Use the Prandtl tip-loss model? [unused when Wake_Mod=0]" flag +typedef ^ AD_InputFile LOGICAL HubLoss - - - "Use the Prandtl hub-loss model? [unused when Wake_Mod=0]" flag +typedef ^ AD_InputFile LOGICAL TanInd - - - "Include tangential induction in BEMT calculations? [unused when Wake_Mod=0]" flag +typedef ^ AD_InputFile LOGICAL AIDrag - - - "Include the drag term in the axial-induction calculation? [unused when Wake_Mod=0]" flag +typedef ^ AD_InputFile LOGICAL TIDrag - - - "Include the drag term in the tangential-induction calculation? [unused when Wake_Mod=0 or TanInd=FALSE]" flag +typedef ^ AD_InputFile ReKi IndToler - - - "Convergence tolerance for BEM induction factors [unused when Wake_Mod=0]" - +typedef ^ AD_InputFile ReKi MaxIter - - - "Maximum number of iteration steps [unused when Wake_Mod=0]" - +typedef ^ AD_InputFile Logical SectAvg - .False. - "Use Sector average for BEM inflow velocity calculation (flag)" - +typedef ^ ^ IntKi SA_Weighting - 1 - "Sector Average - Weighting function for sector average {1=Uniform, 2=Impulse, } within a 360/nB sector centered on the blade (switch) [used only when SectAvg=True]" - +typedef ^ ^ ReKi SA_PsiBwd - -60 - "Sector Average - Backard Azimuth (<0)" deg +typedef ^ ^ ReKi SA_PsiFwd - 60 - "Sector Average - Forward Azimuth (>0)" deg +typedef ^ ^ IntKi SA_nPerSec - 5 - "Sector average - Number of points per sectors (-) [used only when SectAvg=True]" - +typedef ^ ^ LOGICAL AoA34 - - - "Sample the angle of attack (AoA) at the 3/4 chord or the AC point {default=True} [always used]" - +typedef ^ AD_InputFile UA_InitInputType UA_Init - - - "InitInput data for UA model" - typedef ^ AD_InputFile ReKi InCol_Alfa - - - "The column in the airfoil tables that contains the angle of attack" - typedef ^ AD_InputFile ReKi InCol_Cl - - - "The column in the airfoil tables that contains the lift coefficient" - typedef ^ AD_InputFile ReKi InCol_Cd - - - "The column in the airfoil tables that contains the drag coefficient" - typedef ^ AD_InputFile ReKi InCol_Cm - - - "The column in the airfoil tables that contains the pitching-moment coefficient; use zero if there is no Cm column" - typedef ^ AD_InputFile ReKi InCol_Cpmin - - - "The column in the airfoil tables that contains the drag coefficient; use zero if there is no Cpmin column" - -typedef ^ AD_InputFile INTEGER AFTabMod - - - "Interpolation method for multiple airfoil tables {1 = 1D on AoA (only first table is used); 2 = 2D on AoA and Re; 3 = 2D on AoA and UserProp}" - +typedef ^ AD_InputFile IntKi AFTabMod - - - "Interpolation method for multiple airfoil tables {1 = 1D on AoA (only first table is used); 2 = 2D on AoA and Re; 3 = 2D on AoA and UserProp}" - typedef ^ AD_InputFile IntKi NumAFfiles - - - "Number of airfoil files used" - typedef ^ AD_InputFile CHARACTER(1024) FVWFileName - - - "FVW input filename" "quoted string" typedef ^ AD_InputFile CHARACTER(1024) AFNames {:} - - "Airfoil file names (NumAF lines)" "quoted strings" typedef ^ AD_InputFile LOGICAL UseBlCm - - - "Include aerodynamic pitching moment in calculations?" flag #typedef ^ AD_InputFile IntKi NumBlNds - - - "Number of blade nodes used in the analysis" - -typedef ^ AD_InputFile LOGICAL SumPrint - - - "Generate a summary file listing input options and interpolated properties to ".AD.sum"?" flag +typedef ^ AD_InputFile LOGICAL SumPrint - - - "Generate a summary file listing input options and interpolated properties to \".AD.sum\"?" flag typedef ^ AD_InputFile IntKi NBlOuts - - - "Number of blade node outputs [0 - 9]" - typedef ^ AD_InputFile IntKi BlOutNd {9} - - "Blade nodes whose values will be output" - typedef ^ AD_InputFile IntKi NTwOuts - - - "Number of tower node outputs [0 - 9]" - typedef ^ AD_InputFile IntKi TwOutNd {9} - - "Tower nodes whose values will be output" - typedef ^ AD_InputFile IntKi NumOuts - - - "Number of parameters in the output list (number of outputs requested)" - typedef ^ AD_InputFile CHARACTER(ChanLen) OutList {:} - - "List of user-requested output channels" - -typedef ^ AD_InputFile ReKi tau1_const - - - "time constant for DBEMT [used only when WakeMod=2 and DBEMT_Mod/=2]" s -typedef ^ AD_InputFile IntKi DBEMT_Mod - - - "Type of dynamic BEMT (DBEMT) model {1=constant tau1, 2=time-dependent tau1}" - +typedef ^ AD_InputFile ReKi tau1_const - - - "time constant for DBEMT" s +typedef ^ AD_InputFile IntKi DBEMT_Mod - - - "Type of dynamic BEMT (DBEMT) model {0=No Dynamic Wake, -1=Frozen Wake for linearization, 1=constant tau1, 2=time-dependent tau1, 3=constant tau1 with continuous formulation} (-) [used only when WakeMod=1]" - typedef ^ AD_InputFile IntKi BldNd_NumOuts - - - "Number of requested output channels per blade node (AD_AllBldNdOuts)" - typedef ^ AD_InputFile CHARACTER(ChanLen) BldNd_OutList {:} - - "List of user-requested output channels (AD_AllBldNdOuts)" - #typedef ^ AD_InputFile IntKi BldNd_BlOutNd {:} - - "The blade nodes to actually output (AD_AllBldNdOuts)" - @@ -262,13 +291,15 @@ typedef ^ RotMiscVarType AA_OutputType AA_y - - - "Outputs from the AA module" - typedef ^ RotMiscVarType AA_InputType AA_u - - - "Inputs to the AA module" - typedef ^ RotMiscVarType ReKi DisturbedInflow {:}{:}{:} - - "InflowOnBlade values modified by tower influence" m/s +typedef ^ RotMiscVarType ReKi SectAvgInflow {:}{:}{:} - - "Sector averaged - disturbed inflow to improve BEM shear calculations" m/s typedef ^ RotMiscVarType R8Ki orientationAnnulus {:}{:}{:}{:} - - "Coordinate system equivalent to BladeMotion Orientation, but without live sweep, blade-pitch, and twist angles" - typedef ^ RotMiscVarType R8Ki R_li {:}{:}{:}{:} - - "Transformation matrix from inertial system to the staggered polar coordinate system of a given section" - typedef ^ RotMiscVarType ReKi AllOuts {:} - - "An array holding the value of all of the calculated (not only selected) output channels" - typedef ^ RotMiscVarType ReKi W_Twr {:} - - "relative wind speed normal to the tower at node j" m/s typedef ^ RotMiscVarType ReKi X_Twr {:} - - "local x-component of force per unit length of the jth node in the tower" m/s typedef ^ RotMiscVarType ReKi Y_Twr {:} - - "local y-component of force per unit length of the jth node in the tower" m/s -typedef ^ RotMiscVarType ReKi Curve {:}{:} - - "curvature angle, saved for possible output to file" rad +typedef ^ RotMiscVarType ReKi Cant {:}{:} - - "curvature angle, saved for possible output to file" rad +typedef ^ RotMiscVarType ReKi Toe {:}{:} - - "Toe angle, saved for possible output to file" rad typedef ^ RotMiscVarType ReKi TwrClrnc {:}{:} - - "Distance between tower (including tower radius) and blade node (not including blade width), saved for possible output to file" m typedef ^ RotMiscVarType ReKi X {:}{:} - - "normal force per unit length (normal to the plane, not chord) of the jth node in the kth blade" N/m typedef ^ RotMiscVarType ReKi Y {:}{:} - - "tangential force per unit length (tangential to the plane, not chord) of the jth node in the kth blade" N/m @@ -294,6 +325,10 @@ typedef ^ RotMiscVarType ReKi HubFB {:} - - "buoyant force at hub node typedef ^ RotMiscVarType ReKi HubMB {:} - - "buoyant moment at hub node" Nm typedef ^ RotMiscVarType ReKi NacFB {:} - - "buoyant force at nacelle (tower top) node" N typedef ^ RotMiscVarType ReKi NacMB {:} - - "buoyant moment at nacelle (tower top) node" Nm +typedef ^ RotMiscVarType ReKi NacDragF {:} - - "drag force at nacelle (tower top) node" N +typedef ^ RotMiscVarType ReKi NacDragM {:} - - "drag moment at nacelle (tower top) node" Nm +typedef ^ RotMiscVarType ReKi NacFi {:} - - "Total force at nacelle (tower top) node" N +typedef ^ RotMiscVarType ReKi NacMi {:} - - "Total moment at nacelle (tower top) node" Nm typedef ^ RotMiscVarType MeshType BladeRootLoad {:} - - "meshes at blade root; used to compute an integral for mapping the output blade loads to single points (for writing to file only)" - typedef ^ RotMiscVarType MeshMapType B_L_2_R_P {:} - - "mapping data structure to map each bladeLoad output mesh to corresponding MiscVar%BladeRootLoad mesh" typedef ^ RotMiscVarType MeshType BladeBuoyLoadPoint {:} - - "point mesh for lumped buoyant blade loads" - @@ -316,16 +351,47 @@ typedef ^ RotMiscVarType ReKi TFinSTV_i 3 - - "Structural velocity at the refer typedef ^ RotMiscVarType ReKi TFinF_i 3 - - "Forces at the reference point of the fin in the inertial system" typedef ^ RotMiscVarType ReKi TFinM_i 3 - - "Moments at the reference point of the fin in the inertial system" -typedef ^ MiscVarType RotMiscVarType rotors {:}- - - "MiscVars for each rotor" - +# Inflow data storage +typedef ^ ElemInflowType ReKi InflowVel {:}{:} - - "U,V,W at nodes on element (note if we change the requirement that NumNodes is the same for each blade, this will need to change)" m/s +typedef ^ ElemInflowType ReKi InflowAcc {:}{:} - - "Wind acceleration at nodes on element (blade or tower) (note if we change the requirement that NumNodes is the same for each blade, this will need to change)" m/s +typedef ^ RotInflowType ElemInflowType Blade {:} - - "Blade wind inputs" - +typedef ^ RotInflowType ElemInflowType Tower - - - "Blade wind inputs" - +typedef ^ RotInflowType ReKi InflowOnHub {3}{1} - - "U,V,W at hub" m/s +typedef ^ RotInflowType ReKi InflowOnNacelle {3}{1} - - "U,V,W at nacelle" m/s +typedef ^ RotInflowType ReKi InflowOnTailFin {3}{1} - - "U,V,W at tailfin" m/s +typedef ^ RotInflowType ReKi AvgDiskVel {3} - 0.0 "disk-averaged U,V,W" m/s + +typedef ^ AD_InflowType ReKi InflowWakeVel {:}{:} - - "U,V,W at wake points" m/s +typedef ^ AD_InflowType RotInflowType RotInflow {:} - - "Inflow on rotor" - + +typedef ^ MiscVarType RotMiscVarType rotors {:} - - "MiscVars for each rotor" - typedef ^ MiscVarType FVW_InputType FVW_u : - - "Inputs to the FVW module" - typedef ^ MiscVarType FVW_OutputType FVW_y - - - "Outputs from the FVW module" - typedef ^ MiscVarType FVW_MiscVarType FVW - - - "MiscVars from the FVW module" - +typedef ^ MiscVarType ReKi WindPos {:}{:} - - "XYZ coordinates to query for wind velocity/acceleration" - +typedef ^ MiscVarType ReKi WindVel {:}{:} - - "XYZ components of wind velocity" - +typedef ^ MiscVarType ReKi WindAcc {:}{:} - - "XYZ components of wind acceleration" - +typedef ^ MiscVarType AD_InflowType Inflow {:} - - "Inflow storage (size of u for history of inputs)" - + # ..... Parameters ................................................................................................................ # Define parameters here: # Parameters for each rotor +typedef ^ Jac_u_idxStarts IntKi Nacelle - 1 - "Index to first point in u jacobian for Nacelle" - +typedef ^ Jac_u_idxStarts IntKi Hub - 1 - "Index to first point in u jacobian for Hub" - +typedef ^ Jac_u_idxStarts IntKi TFin - 1 - "Index to first point in u jacobian for TFin" - +typedef ^ Jac_u_idxStarts IntKi Tower - 1 - "Index to first point in u jacobian for Tower" - +typedef ^ Jac_u_idxStarts IntKi BladeRoot - 1 - "Index to first point in u jacobian for BladeRoot" - +typedef ^ Jac_u_idxStarts IntKi Blade - 1 - "Index to first point in u jacobian for Blade" - +typedef ^ Jac_u_idxStarts IntKi UserProp - 1 - "Index to first point in u jacobian for UserProp" - +typedef ^ Jac_u_idxStarts IntKi Extended - 1 - "Index to first point in u jacobian for Extended" - +typedef ^ Jac_y_idxStarts IntKi NacelleLoad - 1 - "Index to first point in y jacobian for NacelleLoad" - +typedef ^ Jac_y_idxStarts IntKi HubLoad - 1 - "Index to first point in y jacobian for HubLoad" - +typedef ^ Jac_y_idxStarts IntKi TFinLoad - 1 - "Index to first point in y jacobian for TFinLoad" - +typedef ^ Jac_y_idxStarts IntKi TowerLoad - 1 - "Index to first point in y jacobian for TowerLoad" - +typedef ^ Jac_y_idxStarts IntKi BladeLoad - 1 - "Index to first point in y jacobian for BladeLoad" - typedef ^ RotParameterType IntKi NumBlades - - - "Number of blades on the turbine" - typedef ^ RotParameterType IntKi NumBlNds - - - "Number of nodes on each blade" - typedef ^ RotParameterType IntKi NumTwrNds - - - "Number of nodes on the tower" - @@ -340,6 +406,9 @@ typedef ^ RotParameterType ReKi VolHub - - - "Hub volume" m^3 typedef ^ RotParameterType ReKi HubCenBx - - - "Hub center of buoyancy x direction offset" m typedef ^ RotParameterType ReKi VolNac - - - "Nacelle volume" m^3 typedef ^ RotParameterType ReKi NacCenB 3 - - "Position of nacelle center of buoyancy from yaw bearing in nacelle coordinates" m +typedef ^ RotParameterType ReKi NacArea 3 - - "Projected area of the nacelle in X, Y, Z in the nacelle coordinate system" m^2 +typedef ^ RotParameterType ReKi NacCd 3 - - "Drag cefficient for the nacelle areas defied above" - +typedef ^ RotParameterType ReKi NacDragAC 3 - - "Position of aerodynamic center of nacelle drag in nacelle coordinates" m typedef ^ RotParameterType ReKi VolBl - - - "Buoyancy volume of all blades" m^3 typedef ^ RotParameterType ReKi VolTwr - - - "Buoyancy volume of the tower" m^3 typedef ^ RotParameterType ReKi BlRad {:}{:} - - "Matrix of equivalent blade radius at each node, used in buoyancy calculation" m @@ -352,18 +421,22 @@ typedef ^ RotParameterType ReKi TwrTaper {:} - - "Array of tower element t typedef ^ RotParameterType ReKi TwrAxCent {:} - - "Array of tower element axial centroid, used in buoyancy calculation" - typedef ^ RotParameterType BEMT_ParameterType BEMT - - - "Parameters for BEMT module" typedef ^ RotParameterType AA_ParameterType AA - - - "Parameters for AA module" -typedef ^ RotParameterType Integer Jac_u_indx {:}{:} - - "matrix to help fill/pack the u vector in computing the jacobian" - +typedef ^ RotParameterType IntKi Jac_u_indx {:}{:} - - "matrix to help fill/pack the u vector in computing the jacobian" - +typedef ^ RotParameterType Jac_u_idxStarts Jac_u_idxStartList - - - "Starting indices for all Jac_u components" - +typedef ^ RotParameterType Jac_y_idxStarts Jac_y_idxStartList - - - "Starting indices for all Jac_y components" - +typedef ^ RotParameterType IntKi NumExtendedInputs - - - "number of extended inputs" - typedef ^ RotParameterType ReKi du {:} - - "vector that determines size of perturbation for u (inputs)" typedef ^ RotParameterType ReKi dx {:} - - "vector that determines size of perturbation for x (continuous states)" -typedef ^ RotParameterType Integer Jac_ny - - - "number of outputs in jacobian matrix" - -typedef ^ RotParameterType Integer NumBl_Lin - - - "number of blades in the jacobian" - +typedef ^ RotParameterType IntKi Jac_ny - - - "number of outputs in jacobian matrix" - +typedef ^ RotParameterType IntKi NumBl_Lin - - - "number of blades in the jacobian" - typedef ^ RotParameterType IntKi TwrPotent - - - "Type of tower influence on wind based on potential flow around the tower {0=none, 1=baseline potential flow, 2=potential flow with Bak correction}" - typedef ^ RotParameterType IntKi TwrShadow - - - "Type of tower influence on wind based on downstream tower shadow {0=none, 1=Powles model, 2=Eames model}" - -typedef ^ RotParameterType LOGICAL TwrAero - - - "Calculate tower aerodynamic loads?" flag -typedef ^ RotParameterType Logical FrozenWake - - - "Flag that tells this module it should assume a frozen wake during linearization." - +typedef ^ RotParameterType IntKi TwrAero - - - "Calculate tower aerodynamic loads? {0=none, 1=aero without VIV, 2=aero with VIV}" switch +typedef ^ RotParameterType Integer DBEMT_Mod - - - "DBEMT_Mod" - typedef ^ RotParameterType Logical CavitCheck - - - "Flag that tells us if we want to check for cavitation" - typedef ^ RotParameterType Logical Buoyancy - - - "Include buoyancy effects?" flag +typedef ^ RotParameterType Logical NacelleDrag - - - "Include NacelleDrag effects?" flag typedef ^ RotParameterType IntKi MHK - - - "MHK" flag typedef ^ RotParameterType Logical CompAA - - - "Compute AeroAcoustic noise" flag typedef ^ RotParameterType ReKi AirDens - - - "Air density" kg/m^3 @@ -375,7 +448,7 @@ typedef ^ RotParameterType ReKi Pvap - - - "Vapour pressure" P typedef ^ RotParameterType ReKi WtrDpth - - - "Water depth" m typedef ^ RotParameterType ReKi MSL2SWL - - - "Offset between still-water level and mean sea level" m typedef ^ RotParameterType IntKi AeroProjMod - 1 - "Flag to switch between different projection models" - -typedef ^ RotParameterType IntKi AeroBEM_Mod - -1 - "Flag to switch between different BEM Model" - +typedef ^ RotParameterType IntKi BEM_Mod - -1 - "Flag to switch between different BEM Model" - # parameters for output typedef ^ RotParameterType IntKi NumOuts - - - "Number of parameters in the output list (number of outputs requested)" - typedef ^ RotParameterType CHARACTER(1024) RootName - - - "RootName for writing output files" - @@ -390,21 +463,28 @@ typedef ^ RotParameterType IntKi BldNd_TotNumOuts - - - "Total number of request typedef ^ RotParameterType OutParmType BldNd_OutParam {:} - - "Names and units (and other characteristics) of all requested output parameters" - typedef ^ RotParameterType IntKi BldNd_BlOutNd {:} - - "The blade nodes to actually output (AD_AllBldNdOuts)" - typedef ^ RotParameterType IntKi BldNd_BladesOut - - - "The blades to output (AD_AllBldNdOuts)" - +typedef ^ RotParameterType IntKi BldNd_NumNodesOut - - - "The blades to output (AD_AllBldNdOuts)" - # Tail fin parameters (per rotor) typedef ^ RotParameterType LOGICAL TFinAero - .FALSE. - "Calculate tail fin aerodynamics model (flag)" flag typedef ^ RotParameterType TFinParameterType TFin - - - "Parameters for tail fin of current rotor" - -# parameters for all rotors: +# Parameters for all rotors: typedef ^ ParameterType RotParameterType rotors {:} - - "Parameter types for each rotor" - # 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 CHARACTER(1024) RootName - - - "RootName for writing output files" - typedef ^ ParameterType AFI_ParameterType AFI {:} - - "AirfoilInfo parameters" -typedef ^ ParameterType IntKi SkewMod - - - "Type of skewed-wake correction model {0=orthogonal, 1=uncoupled, 2=Pitt/Peters, 3=coupled} [unused when WakeMod=0]" - -typedef ^ ParameterType IntKi WakeMod - - - "Type of wake/induction model {0=none, 1=BEMT, 2=DBEMT, 3=FVW}" - +typedef ^ ParameterType IntKi Skew_Mod - - - "Type of skewed-wake correction model {-1=orthogonal, 0=None, 1=Glauert} [unused when Wake_Mod=0]" - +typedef ^ ParameterType IntKi Wake_Mod - - - "Type of wake/induction model {0=none, 1=BEMT, 2=DBEMT, 3=FVW}" - typedef ^ ParameterType FVW_ParameterType FVW - - - "Parameters for FVW module" typedef ^ ParameterType LOGICAL CompAeroMaps - .FALSE. - "flag to determine if AeroDyn is computing aero maps (true) or running a normal simulation (false)" - typedef ^ ParameterType LOGICAL UA_Flag - - - "logical flag indicating whether to use UnsteadyAero" - +typedef ^ ParameterType FlowFieldType *FlowField - - - "Pointer of InflowWinds flow field data type" - +typedef ^ ^ Logical SectAvg - - - "Use Sector average for BEM inflow velocity calculation" - +typedef ^ ^ IntKi SA_Weighting - - 1 "Sector Average - Weighting function for sector average {1=Uniform, 2=Impulse} within a 360/nB sector centered on the blade (switch) [used only when SectAvg=True]" - +typedef ^ ^ ReKi SA_PsiBwd - - - "Sector Average - Backard Azimuth (<0)" deg +typedef ^ ^ ReKi SA_PsiFwd - - - "Sector Average - Forward Azimuth (>0)" deg +typedef ^ ^ IntKi SA_nPerSec - - - "Sector Average - Number of points per sector (>1)" - # ..... Inputs .................................................................................................................... @@ -416,16 +496,10 @@ typedef ^ RotInputType MeshType BladeRootMotion {:} - - "motion on each blade ro typedef ^ RotInputType MeshType BladeMotion {:} - - "motion on each blade" - typedef ^ RotInputType MeshType TFinMotion - - - "motion of tail fin (at tail fin ref point)" - # Define inputs that are not on a mesh here: -typedef ^ RotInputType ReKi InflowOnBlade {:}{:}{:} - - "U,V,W at nodes on each blade (note if we change the requirement that NumNodes is the same for each blade, this will need to change)" m/s -typedef ^ RotInputType ReKi InflowOnTower {:}{:} - - "U,V,W at nodes on the tower" m/s -typedef ^ RotInputType ReKi InflowOnHub {3} - - "U,V,W at hub" m/s -typedef ^ RotInputType ReKi InflowOnNacelle {3} - - "U,V,W at nacelle" m/s -typedef ^ RotInputType ReKi InflowOnTailFin {3} - - "U,V,W at tailfin" m/s typedef ^ RotInputType ReKi UserProp {:}{:} - - "Optional user property for interpolating airfoils (per element per blade)" - typedef ^ InputType RotInputType rotors {:} - - "Inputs for each rotor" - -typedef ^ InputType ReKi InflowWakeVel {:}{:} - - "U,V,W at wake points" m/s # ..... Outputs ................................................................................................................... diff --git a/modules/aerodyn/src/AeroDyn_Types.f90 b/modules/aerodyn/src/AeroDyn_Types.f90 index c26eef9940..68cc48710c 100644 --- a/modules/aerodyn/src/AeroDyn_Types.f90 +++ b/modules/aerodyn/src/AeroDyn_Types.f90 @@ -31,25 +31,27 @@ !! unpack routines associated with each defined data type. This code is automatically generated by the FAST Registry. MODULE AeroDyn_Types !--------------------------------------------------------------------------------------------------------------------------------- -USE UnsteadyAero_Types +USE AirfoilInfo_Types USE BEMT_Types USE FVW_Types USE AeroAcoustics_Types +USE InflowWind_Types USE NWTC_Library IMPLICIT NONE INTEGER(IntKi), PUBLIC, PARAMETER :: ModelUnknown = -1 ! [-] INTEGER(IntKi), PUBLIC, PARAMETER :: WakeMod_none = 0 ! Wake model - none [-] INTEGER(IntKi), PUBLIC, PARAMETER :: WakeMod_BEMT = 1 ! Wake model - BEMT (blade elememnt momentum theory) [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: WakeMod_DBEMT = 2 ! Wake model - DBEMT (dynamic elememnt momentum theory) [-] INTEGER(IntKi), PUBLIC, PARAMETER :: WakeMod_FVW = 3 ! Wake model - FVW (free vortex wake, OLAF) [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: AFAeroMod_steady = 1 ! steady model [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: AFAeroMod_BL_unsteady = 2 ! Beddoes-Leishman unsteady model [-] INTEGER(IntKi), PUBLIC, PARAMETER :: TwrPotent_none = 0 ! no tower potential flow [-] INTEGER(IntKi), PUBLIC, PARAMETER :: TwrPotent_baseline = 1 ! baseline tower potential flow [-] INTEGER(IntKi), PUBLIC, PARAMETER :: TwrPotent_Bak = 2 ! tower potential flow with Bak correction [-] INTEGER(IntKi), PUBLIC, PARAMETER :: TwrShadow_none = 0 ! no tower shadow [-] INTEGER(IntKi), PUBLIC, PARAMETER :: TwrShadow_Powles = 1 ! Powles tower shadow model [-] INTEGER(IntKi), PUBLIC, PARAMETER :: TwrShadow_Eames = 2 ! Eames tower shadow model [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: TwrAero_none = 0 ! no tower aero [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: TwrAero_noVIV = 1 ! Tower aero model without VIV [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: TwrAero_VIV = 2 ! Tower aero model with VIV [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: SA_Wgt_Uniform = 1 ! Sector average weighting - Uniform [-] INTEGER(IntKi), PUBLIC, PARAMETER :: TFinAero_none = 0 ! no tail fin aero [-] INTEGER(IntKi), PUBLIC, PARAMETER :: TFinAero_polar = 1 ! polar-based tail fin aerodynamics [-] INTEGER(IntKi), PUBLIC, PARAMETER :: TFinAero_USB = 2 ! unsteady slender body tail fin aerodynamics model [-] @@ -61,22 +63,32 @@ MODULE AeroDyn_Types INTEGER(IntKi), PUBLIC, PARAMETER :: AD_MaxBl_Out = 3 ! Maximum number of blades for information output (or linearization) [-] ! ========= TFinParameterType ======= TYPE, PUBLIC :: TFinParameterType - INTEGER(IntKi) :: TFinMod !< Tail fin aerodynamics model {0=none, 1=polar-based, 2=USB-based} [(switch)] - REAL(ReKi) :: TFinChord !< Tail fin chord [used only when TFinMod=1] [m] - REAL(ReKi) :: TFinArea !< Tail fin planform area [used only when TFinMod=1] [m^2] - INTEGER(IntKi) :: TFinIndMod !< Model for induced velocity calculation {0=none, 1=rotor-average} [(switch)] - INTEGER(IntKi) :: TFinAFID !< Index of Tail fin airfoil number [1 to NumAFfiles] [-] + INTEGER(IntKi) :: TFinMod = 0_IntKi !< Tail fin aerodynamics model {0=none, 1=polar-based, 2=USB-based} [(switch)] + REAL(ReKi) :: TFinArea = 0.0_ReKi !< Tail fin planform area [m^2] + INTEGER(IntKi) :: TFinIndMod = 0_IntKi !< Model for induced velocity calculation {0=none, 1=rotor-average} [(switch)] + INTEGER(IntKi) :: TFinAFID = 0_IntKi !< Index of Tail fin airfoil number [1 to NumAFfiles] [-] + REAL(ReKi) :: TFinChord = 0.0_ReKi !< Tail fin chord [m] + REAL(ReKi) :: TFinKp = 0.0_ReKi !< Tail fin potential flow coefficient for unsteady aerodynamics [-] + REAL(ReKi) , DIMENSION(1:3) :: TFinSigma = 0.0_ReKi !< Tail fin empirical constants characterizing the decay of separation functions [1/deg] + REAL(ReKi) , DIMENSION(1:3) :: TFinAStar = 0.0_ReKi !< Tail fin characteristics angles for separation functions [deg] + REAL(ReKi) :: TFinKv = 0.0_ReKi !< Tail fin vortex lift coefficient for unsteady aerodynamics [-] + REAL(ReKi) :: TFinCDc = 0.0_ReKi !< Tail fin drag coefficient for unsteady aerodynamics [-] END TYPE TFinParameterType ! ======================= ! ========= TFinInputFileType ======= TYPE, PUBLIC :: TFinInputFileType - INTEGER(IntKi) :: TFinMod !< Tail fin aerodynamics model {0=none, 1=polar-based, 2=USB-based} [(switch)] - REAL(ReKi) :: TFinChord !< Tail fin chord [used only when TFinMod=1] [m] - REAL(ReKi) :: TFinArea !< Tail fin planform area [used only when TFinMod=1] [m^2] - REAL(ReKi) , DIMENSION(1:3) :: TFinRefP_n !< Undeflected position of the tail fin reference point wrt the tower top [m] - REAL(ReKi) , DIMENSION(1:3) :: TFinAngles !< Tail fin chordline skew, tilt, and bank angles about the reference point [(deg)] - INTEGER(IntKi) :: TFinIndMod !< Model for induced velocity calculation {0=none, 1=rotor-average} [(switch)] - INTEGER(IntKi) :: TFinAFID !< Index of Tail fin airfoil number [1 to NumAFfiles] [-] + INTEGER(IntKi) :: TFinMod = 0_IntKi !< Tail fin aerodynamics model {0=none, 1=polar-based, 2=USB-based} [(switch)] + REAL(ReKi) :: TFinArea = 0.0_ReKi !< Tail fin planform area [m^2] + REAL(ReKi) , DIMENSION(1:3) :: TFinRefP_n = 0.0_ReKi !< Undeflected position of the tail fin reference point wrt the tower top [m] + REAL(ReKi) , DIMENSION(1:3) :: TFinAngles = 0.0_ReKi !< Tail fin chordline skew, tilt, and bank angles about the reference point [(deg)] + INTEGER(IntKi) :: TFinIndMod = 0_IntKi !< Model for induced velocity calculation {0=none, 1=rotor-average} [(switch)] + INTEGER(IntKi) :: TFinAFID = 0_IntKi !< Index of Tail fin airfoil number [1 to NumAFfiles] [-] + REAL(ReKi) :: TFinChord = 0.0_ReKi !< Tail fin chord [m] + REAL(ReKi) :: TFinKp = 0.0_ReKi !< Tail fin potential flow coefficient for unsteady aerodynamics [-] + REAL(ReKi) , DIMENSION(1:3) :: TFinSigma = 0.0_ReKi !< Tail fin empirical constants characterizing the decay of separation functions [1/deg] + REAL(ReKi) , DIMENSION(1:3) :: TFinAStar = 0.0_ReKi !< Tail fin characteristics angles for separation functions [deg] + REAL(ReKi) :: TFinKv = 0.0_ReKi !< Tail fin vortex lift coefficient for unsteady aerodynamics [-] + REAL(ReKi) :: TFinCDc = 0.0_ReKi !< Tail fin drag coefficient for unsteady aerodynamics [-] END TYPE TFinInputFileType ! ======================= ! ========= AD_VTK_BLSurfaceType ======= @@ -92,15 +104,16 @@ MODULE AeroDyn_Types ! ======================= ! ========= RotInitInputType ======= TYPE, PUBLIC :: RotInitInputType - INTEGER(IntKi) :: NumBlades !< Number of blades on the turbine [-] - REAL(ReKi) , DIMENSION(1:3) :: HubPosition !< X-Y-Z reference position of hub [m] - REAL(R8Ki) , DIMENSION(1:3,1:3) :: HubOrientation !< DCM reference orientation of hub [-] + INTEGER(IntKi) :: NumBlades = 0_IntKi !< Number of blades on the turbine [-] + REAL(ReKi) , DIMENSION(1:3) :: originInit = 0.0_ReKi !< X-Y-Z reference position for the turbine [m] + REAL(ReKi) , DIMENSION(1:3) :: HubPosition = 0.0_ReKi !< X-Y-Z reference position of hub [m] + REAL(R8Ki) , DIMENSION(1:3,1:3) :: HubOrientation = 0.0_R8Ki !< DCM reference orientation of hub [-] 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) [-] - REAL(R8Ki) , DIMENSION(1:3) :: NacellePosition !< X-Y-Z reference position of nacelle [m] - REAL(R8Ki) , DIMENSION(1:3,1:3) :: NacelleOrientation !< DCM reference orientation of nacelle [-] + REAL(R8Ki) , DIMENSION(1:3) :: NacellePosition = 0.0_R8Ki !< X-Y-Z reference position of nacelle [m] + REAL(R8Ki) , DIMENSION(1:3,1:3) :: NacelleOrientation = 0.0_R8Ki !< DCM reference orientation of nacelle [-] INTEGER(IntKi) :: AeroProjMod = 1 !< Flag to switch between different projection models [-] - INTEGER(IntKi) :: AeroBEM_Mod = -1 !< Flag to switch between different BEM Model [-] + REAL(ReKi) :: RotSpeed = 0.0_ReKi !< Rotor speed used when AeroDyn is computing aero maps [rad/s] END TYPE RotInitInputType ! ======================= ! ========= AD_InitInputType ======= @@ -111,20 +124,22 @@ MODULE AeroDyn_Types LOGICAL :: UsePrimaryInputFile = .TRUE. !< Read input file instead of passed data [-] TYPE(FileInfoType) :: PassedPrimaryInputData !< Primary input file as FileInfoType (set by driver/glue code) [-] LOGICAL :: Linearize = .FALSE. !< Flag that tells this module if the glue code wants to linearize. [-] - REAL(ReKi) :: Gravity !< Gravity force [Nm/s^2] - INTEGER(IntKi) :: MHK !< MHK turbine type switch [-] - REAL(ReKi) :: defFldDens !< Default fluid density from the driver; may be overwritten [kg/m^3] - REAL(ReKi) :: defKinVisc !< Default kinematic viscosity from the driver; may be overwritten [m^2/s] - REAL(ReKi) :: defSpdSound !< Default speed of sound from the driver; may be overwritten [m/s] - REAL(ReKi) :: defPatm !< Default atmospheric pressure from the driver; may be overwritten [Pa] - REAL(ReKi) :: defPvap !< Default vapor pressure from the driver; may be overwritten [Pa] - REAL(ReKi) :: WtrDpth !< Water depth [m] - REAL(ReKi) :: MSL2SWL !< Offset between still-water level and mean sea level [m] + LOGICAL :: CompAeroMaps = .FALSE. !< flag to determine if AeroDyn is computing aero maps (true) or running a normal simulation (false) [-] + REAL(ReKi) :: Gravity = 0.0_ReKi !< Gravity force [Nm/s^2] + INTEGER(IntKi) :: MHK = 0_IntKi !< MHK turbine type switch [-] + REAL(ReKi) :: defFldDens = 0.0_ReKi !< Default fluid density from the driver; may be overwritten [kg/m^3] + REAL(ReKi) :: defKinVisc = 0.0_ReKi !< Default kinematic viscosity from the driver; may be overwritten [m^2/s] + REAL(ReKi) :: defSpdSound = 0.0_ReKi !< Default speed of sound from the driver; may be overwritten [m/s] + REAL(ReKi) :: defPatm = 0.0_ReKi !< Default atmospheric pressure from the driver; may be overwritten [Pa] + REAL(ReKi) :: defPvap = 0.0_ReKi !< Default vapor pressure from the driver; may be overwritten [Pa] + REAL(ReKi) :: WtrDpth = 0.0_ReKi !< Water depth [m] + REAL(ReKi) :: MSL2SWL = 0.0_ReKi !< Offset between still-water level and mean sea level [m] + TYPE(FlowFieldType) , POINTER :: FlowField => NULL() !< Pointer of InflowWinds flow field data type [-] END TYPE AD_InitInputType ! ======================= ! ========= AD_BladePropsType ======= TYPE, PUBLIC :: AD_BladePropsType - INTEGER(IntKi) :: NumBlNds !< Number of blade nodes used in the analysis [-] + INTEGER(IntKi) :: NumBlNds = 0_IntKi !< Number of blade nodes used in the analysis [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BlSpn !< Span at blade node [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BlCrvAC !< Curve at blade node [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BlSwpAC !< Sweep at blade node [m] @@ -144,7 +159,7 @@ MODULE AeroDyn_Types ! ======================= ! ========= RotInitOutputType ======= TYPE, PUBLIC :: RotInitOutputType - REAL(ReKi) :: AirDens !< Air density [kg/m^3] + REAL(ReKi) :: AirDens = 0.0_ReKi !< Air density [kg/m^3] 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(AD_BladeShape) , DIMENSION(:), ALLOCATABLE :: BladeShape !< airfoil coordinates for each blade [m] @@ -165,21 +180,25 @@ MODULE AeroDyn_Types TYPE, PUBLIC :: AD_InitOutputType TYPE(RotInitOutputType) , DIMENSION(:), ALLOCATABLE :: rotors !< Rotor init output type [-] TYPE(ProgDesc) :: Ver !< This module's name, version, and date [-] + INTEGER(IntKi) :: nNodesVel = 0_IntKi !< number of nodes velocity values are needed at (for ExtLoads coupling) [-] END TYPE AD_InitOutputType ! ======================= ! ========= RotInputFile ======= TYPE, PUBLIC :: RotInputFile TYPE(AD_BladePropsType) , DIMENSION(:), ALLOCATABLE :: BladeProps !< blade property information from blade input files [-] - INTEGER(IntKi) :: NumTwrNds !< Number of tower nodes used in the analysis [-] + INTEGER(IntKi) :: NumTwrNds = 0_IntKi !< Number of tower nodes used in the analysis [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TwrElev !< Elevation at tower node [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TwrDiam !< Diameter of tower at node [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TwrCd !< Coefficient of drag at tower node [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TwrTI !< Turbulence intensity for tower shadow at tower node [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TwrCb !< Coefficient of buoyancy at tower node [-] - REAL(ReKi) :: VolHub !< Hub volume [m^3] - REAL(ReKi) :: HubCenBx !< Hub center of buoyancy x direction offset [m] - REAL(ReKi) :: VolNac !< Nacelle volume [m^3] - REAL(ReKi) , DIMENSION(1:3) :: NacCenB !< Position of nacelle center of buoyancy from yaw bearing in nacelle coordinates [m] + REAL(ReKi) :: VolHub = 0.0_ReKi !< Hub volume [m^3] + REAL(ReKi) :: HubCenBx = 0.0_ReKi !< Hub center of buoyancy x direction offset [m] + REAL(ReKi) :: VolNac = 0.0_ReKi !< Nacelle volume [m^3] + REAL(ReKi) , DIMENSION(1:3) :: NacCenB = 0.0_ReKi !< Position of nacelle center of buoyancy from yaw bearing in nacelle coordinates [m] + REAL(ReKi) , DIMENSION(1:3) :: NacArea = 0.0_ReKi !< Projected area of the nacelle in X, Y, Z in the nacelle coordinate system [m^2] + REAL(ReKi) , DIMENSION(1:3) :: NacCd = 0.0_ReKi !< Drag cefficient for the nacelle areas defied above [-] + REAL(ReKi) , DIMENSION(1:3) :: NacDragAC = 0.0_ReKi !< Position of aerodynamic center of nacelle drag in nacelle coordinates [m] LOGICAL :: TFinAero = .FALSE. !< Calculate tail fin aerodynamics model (flag) [flag] CHARACTER(1024) :: TFinFile !< Input file for tail fin aerodynamics [used only when TFinAero=True] [-] TYPE(TFinInputFileType) :: TFin !< Input file data for tail fin [-] @@ -187,60 +206,67 @@ MODULE AeroDyn_Types ! ======================= ! ========= AD_InputFile ======= TYPE, PUBLIC :: AD_InputFile - LOGICAL :: Echo !< Echo input file to echo file [-] - REAL(DbKi) :: DTAero !< Time interval for aerodynamic calculations {or "default"} [s] - INTEGER(IntKi) :: WakeMod !< Type of wake/induction model {0=none, 1=BEMT, 2=DBEMT, 3=FVW} [-] - INTEGER(IntKi) :: AFAeroMod !< Type of blade airfoil aerodynamics model {1=steady model, 2=Beddoes-Leishman unsteady model} [-] - INTEGER(IntKi) :: TwrPotent !< Type of tower influence on wind based on potential flow around the tower {0=none, 1=baseline potential flow, 2=potential flow with Bak correction} [-] - INTEGER(IntKi) :: TwrShadow !< Type of tower influence on wind based on downstream tower shadow {0=none, 1=Powles model, 2=Eames model} [-] - LOGICAL :: TwrAero !< Calculate tower aerodynamic loads? [flag] - LOGICAL :: FrozenWake !< Flag that tells this module it should assume a frozen wake during linearization. [-] - LOGICAL :: CavitCheck !< Flag that tells us if we want to check for cavitation [-] - LOGICAL :: Buoyancy !< Include buoyancy effects? [flag] - LOGICAL :: CompAA !< Compute AeroAcoustic noise [flag] + LOGICAL :: Echo = .false. !< Echo input file to echo file [-] + REAL(DbKi) :: DTAero = 0.0_R8Ki !< Time interval for aerodynamic calculations {or "default"} [s] + INTEGER(IntKi) :: Wake_Mod = 0_IntKi !< Type of wake/induction model {0=none, 1=BEMT, 2=DBEMT, 3=FVW} [-] + INTEGER(IntKi) :: BEM_Mod = 0_IntKi !< Type of BEM model {1=legacy NoSweepPitchTwist, 2=polar grid} [-] + INTEGER(IntKi) :: TwrPotent = 0_IntKi !< Type of tower influence on wind based on potential flow around the tower {0=none, 1=baseline potential flow, 2=potential flow with Bak correction} [-] + INTEGER(IntKi) :: TwrShadow = 0_IntKi !< Type of tower influence on wind based on downstream tower shadow {0=none, 1=Powles model, 2=Eames model} [-] + INTEGER(IntKi) :: TwrAero = 0_IntKi !< Calculate tower aerodynamic loads? {0=none, 1=aero without VIV, 2=aero with VIV} [-] + LOGICAL :: CavitCheck = .false. !< Flag that tells us if we want to check for cavitation [-] + LOGICAL :: Buoyancy = .false. !< Include buoyancy effects? [flag] + LOGICAL :: NacelleDrag = .false. !< Include NacelleDrag effects? [flag] + LOGICAL :: CompAA = .false. !< Compute AeroAcoustic noise [flag] CHARACTER(1024) :: AA_InputFile !< AeroAcoustics input file name [quoted strings] CHARACTER(1024) , DIMENSION(:), ALLOCATABLE :: ADBlFile !< AD blade file (NumBl filenames) [quoted strings] - REAL(ReKi) :: AirDens !< Air density [kg/m^3] - REAL(ReKi) :: KinVisc !< Kinematic air viscosity [m^2/s] - REAL(ReKi) :: Patm !< Atmospheric pressure [Pa] - REAL(ReKi) :: Pvap !< Vapour pressure [Pa] - REAL(ReKi) :: SpdSound !< Speed of sound [m/s] - INTEGER(IntKi) :: SkewMod !< Type of skewed-wake correction model {0=orthogonal, 1=uncoupled, 2=Pitt/Peters, 3=coupled} [unused when WakeMod=0] [-] - REAL(ReKi) :: SkewModFactor !< Constant used in Pitt/Peters skewed wake model (default is 15*pi/32) [-] - LOGICAL :: TipLoss !< Use the Prandtl tip-loss model? [unused when WakeMod=0] [flag] - LOGICAL :: HubLoss !< Use the Prandtl hub-loss model? [unused when WakeMod=0] [flag] - LOGICAL :: TanInd !< Include tangential induction in BEMT calculations? [unused when WakeMod=0] [flag] - LOGICAL :: AIDrag !< Include the drag term in the axial-induction calculation? [unused when WakeMod=0] [flag] - LOGICAL :: TIDrag !< Include the drag term in the tangential-induction calculation? [unused when WakeMod=0 or TanInd=FALSE] [flag] - REAL(ReKi) :: IndToler !< Convergence tolerance for BEM induction factors [unused when WakeMod=0] [-] - REAL(ReKi) :: MaxIter !< Maximum number of iteration steps [unused when WakeMod=0] [-] - INTEGER(IntKi) :: UAMod !< Unsteady Aero Model Switch (switch) {1=Baseline model (Original), 2=Gonzalez's variant (changes in Cn,Cc,Cm), 3=Minnema/Pierce variant (changes in Cc and Cm)} [used only when AFAeroMod=2] [-] - LOGICAL :: FLookup !< Flag to indicate whether a lookup for f' will be calculated (TRUE) or whether best-fit exponential equations will be used (FALSE); if FALSE S1-S4 must be provided in airfoil input files [used only when AFAeroMod=2] [flag] - REAL(ReKi) :: InCol_Alfa !< The column in the airfoil tables that contains the angle of attack [-] - REAL(ReKi) :: InCol_Cl !< The column in the airfoil tables that contains the lift coefficient [-] - REAL(ReKi) :: InCol_Cd !< The column in the airfoil tables that contains the drag coefficient [-] - REAL(ReKi) :: InCol_Cm !< The column in the airfoil tables that contains the pitching-moment coefficient; use zero if there is no Cm column [-] - REAL(ReKi) :: InCol_Cpmin !< The column in the airfoil tables that contains the drag coefficient; use zero if there is no Cpmin column [-] - INTEGER(IntKi) :: AFTabMod !< Interpolation method for multiple airfoil tables {1 = 1D on AoA (only first table is used); 2 = 2D on AoA and Re; 3 = 2D on AoA and UserProp} [-] - INTEGER(IntKi) :: NumAFfiles !< Number of airfoil files used [-] + REAL(ReKi) :: AirDens = 0.0_ReKi !< Air density [kg/m^3] + REAL(ReKi) :: KinVisc = 0.0_ReKi !< Kinematic air viscosity [m^2/s] + REAL(ReKi) :: Patm = 0.0_ReKi !< Atmospheric pressure [Pa] + REAL(ReKi) :: Pvap = 0.0_ReKi !< Vapour pressure [Pa] + REAL(ReKi) :: SpdSound = 0.0_ReKi !< Speed of sound [m/s] + INTEGER(IntKi) :: Skew_Mod = 0_IntKi !< Select skew model {0=No skew model at all, -1=Throw away non-normal component for linearization, 1=Glauert skew model} [-] + LOGICAL :: SkewMomCorr = .false. !< Turn the skew momentum correction on or off [used only when SkewMod=1] [-] + INTEGER(IntKi) :: SkewRedistr_Mod = 0_IntKi !< Type of skewed-wake redistribution model (switch) {0=no redistribution, 1=Glauert/Pitt/Peters, 2=Vortex Cylinder} [unsed only when SkewMod=1] [-] + REAL(ReKi) :: SkewModFactor = 0.0_ReKi !< Constant used in Pitt/Peters skewed wake model (default is 15*pi/32) [-] + LOGICAL :: TipLoss = .false. !< Use the Prandtl tip-loss model? [unused when Wake_Mod=0] [flag] + LOGICAL :: HubLoss = .false. !< Use the Prandtl hub-loss model? [unused when Wake_Mod=0] [flag] + LOGICAL :: TanInd = .false. !< Include tangential induction in BEMT calculations? [unused when Wake_Mod=0] [flag] + LOGICAL :: AIDrag = .false. !< Include the drag term in the axial-induction calculation? [unused when Wake_Mod=0] [flag] + LOGICAL :: TIDrag = .false. !< Include the drag term in the tangential-induction calculation? [unused when Wake_Mod=0 or TanInd=FALSE] [flag] + REAL(ReKi) :: IndToler = 0.0_ReKi !< Convergence tolerance for BEM induction factors [unused when Wake_Mod=0] [-] + REAL(ReKi) :: MaxIter = 0.0_ReKi !< Maximum number of iteration steps [unused when Wake_Mod=0] [-] + LOGICAL :: SectAvg = .False. !< Use Sector average for BEM inflow velocity calculation (flag) [-] + INTEGER(IntKi) :: SA_Weighting = 1 !< Sector Average - Weighting function for sector average {1=Uniform, 2=Impulse, } within a 360/nB sector centered on the blade (switch) [used only when SectAvg=True] [-] + REAL(ReKi) :: SA_PsiBwd = -60 !< Sector Average - Backard Azimuth (<0) [deg] + REAL(ReKi) :: SA_PsiFwd = 60 !< Sector Average - Forward Azimuth (>0) [deg] + INTEGER(IntKi) :: SA_nPerSec = 5 !< Sector average - Number of points per sectors (-) [used only when SectAvg=True] [-] + LOGICAL :: AoA34 = .false. !< Sample the angle of attack (AoA) at the 3/4 chord or the AC point {default=True} [always used] [-] + TYPE(UA_InitInputType) :: UA_Init !< InitInput data for UA model [-] + REAL(ReKi) :: InCol_Alfa = 0.0_ReKi !< The column in the airfoil tables that contains the angle of attack [-] + REAL(ReKi) :: InCol_Cl = 0.0_ReKi !< The column in the airfoil tables that contains the lift coefficient [-] + REAL(ReKi) :: InCol_Cd = 0.0_ReKi !< The column in the airfoil tables that contains the drag coefficient [-] + REAL(ReKi) :: InCol_Cm = 0.0_ReKi !< The column in the airfoil tables that contains the pitching-moment coefficient; use zero if there is no Cm column [-] + REAL(ReKi) :: InCol_Cpmin = 0.0_ReKi !< The column in the airfoil tables that contains the drag coefficient; use zero if there is no Cpmin column [-] + INTEGER(IntKi) :: AFTabMod = 0_IntKi !< Interpolation method for multiple airfoil tables {1 = 1D on AoA (only first table is used); 2 = 2D on AoA and Re; 3 = 2D on AoA and UserProp} [-] + INTEGER(IntKi) :: NumAFfiles = 0_IntKi !< Number of airfoil files used [-] CHARACTER(1024) :: FVWFileName !< FVW input filename [quoted string] CHARACTER(1024) , DIMENSION(:), ALLOCATABLE :: AFNames !< Airfoil file names (NumAF lines) [quoted strings] - LOGICAL :: UseBlCm !< Include aerodynamic pitching moment in calculations? [flag] - LOGICAL :: SumPrint !< Generate a summary file listing input options and interpolated properties to ".AD.sum"? [flag] - INTEGER(IntKi) :: NBlOuts !< Number of blade node outputs [0 - 9] [-] - INTEGER(IntKi) , DIMENSION(1:9) :: BlOutNd !< Blade nodes whose values will be output [-] - INTEGER(IntKi) :: NTwOuts !< Number of tower node outputs [0 - 9] [-] - INTEGER(IntKi) , DIMENSION(1:9) :: TwOutNd !< Tower nodes whose values will be output [-] - INTEGER(IntKi) :: NumOuts !< Number of parameters in the output list (number of outputs requested) [-] + LOGICAL :: UseBlCm = .false. !< Include aerodynamic pitching moment in calculations? [flag] + LOGICAL :: SumPrint = .false. !< Generate a summary file listing input options and interpolated properties to ".AD.sum"? [flag] + INTEGER(IntKi) :: NBlOuts = 0_IntKi !< Number of blade node outputs [0 - 9] [-] + INTEGER(IntKi) , DIMENSION(1:9) :: BlOutNd = 0_IntKi !< Blade nodes whose values will be output [-] + INTEGER(IntKi) :: NTwOuts = 0_IntKi !< Number of tower node outputs [0 - 9] [-] + INTEGER(IntKi) , DIMENSION(1:9) :: TwOutNd = 0_IntKi !< Tower nodes whose values will be output [-] + INTEGER(IntKi) :: NumOuts = 0_IntKi !< Number of parameters in the output list (number of outputs requested) [-] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: OutList !< List of user-requested output channels [-] - REAL(ReKi) :: tau1_const !< time constant for DBEMT [used only when WakeMod=2 and DBEMT_Mod/=2] [s] - INTEGER(IntKi) :: DBEMT_Mod !< Type of dynamic BEMT (DBEMT) model {1=constant tau1, 2=time-dependent tau1} [-] - INTEGER(IntKi) :: BldNd_NumOuts !< Number of requested output channels per blade node (AD_AllBldNdOuts) [-] + REAL(ReKi) :: tau1_const = 0.0_ReKi !< time constant for DBEMT [s] + INTEGER(IntKi) :: DBEMT_Mod = 0_IntKi !< Type of dynamic BEMT (DBEMT) model {0=No Dynamic Wake, -1=Frozen Wake for linearization, 1=constant tau1, 2=time-dependent tau1, 3=constant tau1 with continuous formulation} (-) [used only when WakeMod=1] [-] + INTEGER(IntKi) :: BldNd_NumOuts = 0_IntKi !< Number of requested output channels per blade node (AD_AllBldNdOuts) [-] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: BldNd_OutList !< List of user-requested output channels (AD_AllBldNdOuts) [-] CHARACTER(1024) :: BldNd_BlOutNd_Str !< String to parse for the blade nodes to actually output (AD_AllBldNdOuts) [-] - INTEGER(IntKi) :: BldNd_BladesOut !< The blades to output (AD_AllBldNdOuts) [-] - REAL(ReKi) :: UAStartRad !< Starting [radius] - REAL(ReKi) :: UAEndRad !< Ending [radius] + INTEGER(IntKi) :: BldNd_BladesOut = 0_IntKi !< The blades to output (AD_AllBldNdOuts) [-] + REAL(ReKi) :: UAStartRad = 0.0_ReKi !< Starting [radius] + REAL(ReKi) :: UAEndRad = 0.0_ReKi !< Ending [radius] TYPE(RotInputFile) , DIMENSION(:), ALLOCATABLE :: rotors !< Rotor (blades and tower) input file data [-] END TYPE AD_InputFile ! ======================= @@ -302,13 +328,15 @@ MODULE AeroDyn_Types TYPE(AA_OutputType) :: AA_y !< Outputs from the AA module [-] TYPE(AA_InputType) :: AA_u !< Inputs to the AA module [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: DisturbedInflow !< InflowOnBlade values modified by tower influence [m/s] + REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: SectAvgInflow !< Sector averaged - disturbed inflow to improve BEM shear calculations [m/s] REAL(R8Ki) , DIMENSION(:,:,:,:), ALLOCATABLE :: orientationAnnulus !< Coordinate system equivalent to BladeMotion Orientation, but without live sweep, blade-pitch, and twist angles [-] REAL(R8Ki) , DIMENSION(:,:,:,:), ALLOCATABLE :: R_li !< Transformation matrix from inertial system to the staggered polar coordinate system of a given section [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: AllOuts !< An array holding the value of all of the calculated (not only selected) output channels [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: W_Twr !< relative wind speed normal to the tower at node j [m/s] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: X_Twr !< local x-component of force per unit length of the jth node in the tower [m/s] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Y_Twr !< local y-component of force per unit length of the jth node in the tower [m/s] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Curve !< curvature angle, saved for possible output to file [rad] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Cant !< curvature angle, saved for possible output to file [rad] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Toe !< Toe angle, saved for possible output to file [rad] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: TwrClrnc !< Distance between tower (including tower radius) and blade node (not including blade width), saved for possible output to file [m] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: X !< normal force per unit length (normal to the plane, not chord) of the jth node in the kth blade [N/m] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Y !< tangential force per unit length (tangential to the plane, not chord) of the jth node in the kth blade [N/m] @@ -318,11 +346,11 @@ MODULE AeroDyn_Types REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: My !< pitching moment per unit length of the jth node in the kth blade (in y direction) [Nm/m] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Mz !< pitching moment per unit length of the jth node in the kth blade (in z direction) [Nm/m] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: Vind_i !< Induced velocities at jth node and kth blade (3xnSpanxnB) [m/s] - REAL(ReKi) , DIMENSION(1:3) :: V_DiskAvg !< disk-average relative wind speed [m/s] - REAL(ReKi) :: yaw !< Yaw calculated in SetInputsForBEMT [rad] - REAL(ReKi) :: tilt !< tilt calculated in SetInputsForBEMT [rad] + REAL(ReKi) , DIMENSION(1:3) :: V_DiskAvg = 0.0_ReKi !< disk-average relative wind speed [m/s] + REAL(ReKi) :: yaw = 0.0_ReKi !< Yaw calculated in SetInputsForBEMT [rad] + REAL(ReKi) :: tilt = 0.0_ReKi !< tilt calculated in SetInputsForBEMT [rad] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: hub_theta_x_root !< angles saved for FAST.Farm [rad] - REAL(ReKi) :: V_dot_x + REAL(ReKi) :: V_dot_x = 0.0_ReKi TYPE(MeshType) :: HubLoad !< mesh at hub; used to compute an integral for mapping the output blade loads to a single point (for writing to file only) [-] TYPE(MeshMapType) , DIMENSION(:), ALLOCATABLE :: B_L_2_H_P !< mapping data structure to map each bladeLoad output mesh to the MiscVar%HubLoad mesh [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: SigmaCavitCrit !< critical cavitation number- inception value (above which cavit will occur) [-] @@ -334,6 +362,10 @@ MODULE AeroDyn_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: HubMB !< buoyant moment at hub node [Nm] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: NacFB !< buoyant force at nacelle (tower top) node [N] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: NacMB !< buoyant moment at nacelle (tower top) node [Nm] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: NacDragF !< drag force at nacelle (tower top) node [N] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: NacDragM !< drag moment at nacelle (tower top) node [Nm] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: NacFi !< Total force at nacelle (tower top) node [N] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: NacMi !< Total moment at nacelle (tower top) node [Nm] TYPE(MeshType) , DIMENSION(:), ALLOCATABLE :: BladeRootLoad !< meshes at blade root; used to compute an integral for mapping the output blade loads to single points (for writing to file only) [-] TYPE(MeshMapType) , DIMENSION(:), ALLOCATABLE :: B_L_2_R_P !< mapping data structure to map each bladeLoad output mesh to corresponding MiscVar%BladeRootLoad mesh [-] TYPE(MeshType) , DIMENSION(:), ALLOCATABLE :: BladeBuoyLoadPoint !< point mesh for lumped buoyant blade loads [-] @@ -342,33 +374,80 @@ MODULE AeroDyn_Types TYPE(MeshType) :: TwrBuoyLoadPoint !< point mesh for lumped buoyant tower loads [-] TYPE(MeshType) :: TwrBuoyLoad !< line mesh for per unit length buoyant tower loads [-] TYPE(MeshMapType) :: T_P_2_T_L !< mapping data structure to map buoyant tower point loads (m%TwrBuoyLoadPoint) to buoyant tower line loads (m%TwrBuoyLoad) [-] - LOGICAL :: FirstWarn_TowerStrike !< flag to avoid printing tower strike multiple times [-] - REAL(ReKi) , DIMENSION(1:3) :: AvgDiskVel !< disk-averaged U,V,W (undisturbed) [m/s] - REAL(ReKi) , DIMENSION(1:3) :: AvgDiskVelDist !< disk-averaged U,V,W (disturbed) [m/s] - REAL(ReKi) :: TFinAlpha !< Angle of attack for tailfin [-] - REAL(ReKi) :: TFinRe !< Reynolds number for tailfin [-] - REAL(ReKi) :: TFinVrel !< Orthogonal relative velocity nrom at the reference point [-] - REAL(ReKi) , DIMENSION(1:3) :: TFinVund_i !< Undisturbed wind velocity at the reference point of the fin in the inertial system [-] - REAL(ReKi) , DIMENSION(1:3) :: TFinVind_i !< Induced velocity at the reference point of the fin in the inertial system [-] - REAL(ReKi) , DIMENSION(1:3) :: TFinVrel_i !< Relative velocity at the reference point of the fin in the inertial system [-] - REAL(ReKi) , DIMENSION(1:3) :: TFinSTV_i !< Structural velocity at the reference point of the fin in the inertial system [-] - REAL(ReKi) , DIMENSION(1:3) :: TFinF_i !< Forces at the reference point of the fin in the inertial system [-] - REAL(ReKi) , DIMENSION(1:3) :: TFinM_i !< Moments at the reference point of the fin in the inertial system [-] + LOGICAL :: FirstWarn_TowerStrike = .false. !< flag to avoid printing tower strike multiple times [-] + REAL(ReKi) , DIMENSION(1:3) :: AvgDiskVel = 0.0_ReKi !< disk-averaged U,V,W (undisturbed) [m/s] + REAL(ReKi) , DIMENSION(1:3) :: AvgDiskVelDist = 0.0_ReKi !< disk-averaged U,V,W (disturbed) [m/s] + REAL(ReKi) :: TFinAlpha = 0.0_ReKi !< Angle of attack for tailfin [-] + REAL(ReKi) :: TFinRe = 0.0_ReKi !< Reynolds number for tailfin [-] + REAL(ReKi) :: TFinVrel = 0.0_ReKi !< Orthogonal relative velocity nrom at the reference point [-] + REAL(ReKi) , DIMENSION(1:3) :: TFinVund_i = 0.0_ReKi !< Undisturbed wind velocity at the reference point of the fin in the inertial system [-] + REAL(ReKi) , DIMENSION(1:3) :: TFinVind_i = 0.0_ReKi !< Induced velocity at the reference point of the fin in the inertial system [-] + REAL(ReKi) , DIMENSION(1:3) :: TFinVrel_i = 0.0_ReKi !< Relative velocity at the reference point of the fin in the inertial system [-] + REAL(ReKi) , DIMENSION(1:3) :: TFinSTV_i = 0.0_ReKi !< Structural velocity at the reference point of the fin in the inertial system [-] + REAL(ReKi) , DIMENSION(1:3) :: TFinF_i = 0.0_ReKi !< Forces at the reference point of the fin in the inertial system [-] + REAL(ReKi) , DIMENSION(1:3) :: TFinM_i = 0.0_ReKi !< Moments at the reference point of the fin in the inertial system [-] END TYPE RotMiscVarType ! ======================= +! ========= ElemInflowType ======= + TYPE, PUBLIC :: ElemInflowType + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: InflowVel !< U,V,W at nodes on element (note if we change the requirement that NumNodes is the same for each blade, this will need to change) [m/s] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: InflowAcc !< Wind acceleration at nodes on element (blade or tower) (note if we change the requirement that NumNodes is the same for each blade, this will need to change) [m/s] + END TYPE ElemInflowType +! ======================= +! ========= RotInflowType ======= + TYPE, PUBLIC :: RotInflowType + TYPE(ElemInflowType) , DIMENSION(:), ALLOCATABLE :: Blade !< Blade wind inputs [-] + TYPE(ElemInflowType) :: Tower !< Blade wind inputs [-] + REAL(ReKi) , DIMENSION(1:3,1:1) :: InflowOnHub = 0.0_ReKi !< U,V,W at hub [m/s] + REAL(ReKi) , DIMENSION(1:3,1:1) :: InflowOnNacelle = 0.0_ReKi !< U,V,W at nacelle [m/s] + REAL(ReKi) , DIMENSION(1:3,1:1) :: InflowOnTailFin = 0.0_ReKi !< U,V,W at tailfin [m/s] + REAL(ReKi) , DIMENSION(1:3) :: AvgDiskVel = 0.0_ReKi !< disk-averaged U,V,W [m/s] + END TYPE RotInflowType +! ======================= +! ========= AD_InflowType ======= + TYPE, PUBLIC :: AD_InflowType + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: InflowWakeVel !< U,V,W at wake points [m/s] + TYPE(RotInflowType) , DIMENSION(:), ALLOCATABLE :: RotInflow !< Inflow on rotor [-] + END TYPE AD_InflowType +! ======================= ! ========= AD_MiscVarType ======= TYPE, PUBLIC :: AD_MiscVarType TYPE(RotMiscVarType) , DIMENSION(:), ALLOCATABLE :: rotors !< MiscVars for each rotor [-] TYPE(FVW_InputType) , DIMENSION(:), ALLOCATABLE :: FVW_u !< Inputs to the FVW module [-] TYPE(FVW_OutputType) :: FVW_y !< Outputs from the FVW module [-] TYPE(FVW_MiscVarType) :: FVW !< MiscVars from the FVW module [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: WindPos !< XYZ coordinates to query for wind velocity/acceleration [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: WindVel !< XYZ components of wind velocity [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: WindAcc !< XYZ components of wind acceleration [-] + TYPE(AD_InflowType) , DIMENSION(:), ALLOCATABLE :: Inflow !< Inflow storage (size of u for history of inputs) [-] END TYPE AD_MiscVarType ! ======================= +! ========= Jac_u_idxStarts ======= + TYPE, PUBLIC :: Jac_u_idxStarts + INTEGER(IntKi) :: Nacelle = 1 !< Index to first point in u jacobian for Nacelle [-] + INTEGER(IntKi) :: Hub = 1 !< Index to first point in u jacobian for Hub [-] + INTEGER(IntKi) :: TFin = 1 !< Index to first point in u jacobian for TFin [-] + INTEGER(IntKi) :: Tower = 1 !< Index to first point in u jacobian for Tower [-] + INTEGER(IntKi) :: BladeRoot = 1 !< Index to first point in u jacobian for BladeRoot [-] + INTEGER(IntKi) :: Blade = 1 !< Index to first point in u jacobian for Blade [-] + INTEGER(IntKi) :: UserProp = 1 !< Index to first point in u jacobian for UserProp [-] + INTEGER(IntKi) :: Extended = 1 !< Index to first point in u jacobian for Extended [-] + END TYPE Jac_u_idxStarts +! ======================= +! ========= Jac_y_idxStarts ======= + TYPE, PUBLIC :: Jac_y_idxStarts + INTEGER(IntKi) :: NacelleLoad = 1 !< Index to first point in y jacobian for NacelleLoad [-] + INTEGER(IntKi) :: HubLoad = 1 !< Index to first point in y jacobian for HubLoad [-] + INTEGER(IntKi) :: TFinLoad = 1 !< Index to first point in y jacobian for TFinLoad [-] + INTEGER(IntKi) :: TowerLoad = 1 !< Index to first point in y jacobian for TowerLoad [-] + INTEGER(IntKi) :: BladeLoad = 1 !< Index to first point in y jacobian for BladeLoad [-] + END TYPE Jac_y_idxStarts +! ======================= ! ========= RotParameterType ======= TYPE, PUBLIC :: RotParameterType - INTEGER(IntKi) :: NumBlades !< Number of blades on the turbine [-] - INTEGER(IntKi) :: NumBlNds !< Number of nodes on each blade [-] - INTEGER(IntKi) :: NumTwrNds !< Number of nodes on the tower [-] + INTEGER(IntKi) :: NumBlades = 0_IntKi !< Number of blades on the turbine [-] + INTEGER(IntKi) :: NumBlNds = 0_IntKi !< Number of nodes on each blade [-] + INTEGER(IntKi) :: NumTwrNds = 0_IntKi !< Number of nodes on the tower [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TwrDiam !< Diameter of tower at node [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TwrCd !< Coefficient of drag at tower node [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TwrTI !< Turbulence intensity for tower shadow at tower node [-] @@ -376,12 +455,15 @@ MODULE AeroDyn_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TwrCb !< Coefficient of buoyancy at tower node [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BlCenBn !< Normal offset between aerodynamic center and center of buoyancy at blade node [m] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BlCenBt !< Tangential offset between aerodynamic center and center of buoyancy at blade node [m] - REAL(ReKi) :: VolHub !< Hub volume [m^3] - REAL(ReKi) :: HubCenBx !< Hub center of buoyancy x direction offset [m] - REAL(ReKi) :: VolNac !< Nacelle volume [m^3] - REAL(ReKi) , DIMENSION(1:3) :: NacCenB !< Position of nacelle center of buoyancy from yaw bearing in nacelle coordinates [m] - REAL(ReKi) :: VolBl !< Buoyancy volume of all blades [m^3] - REAL(ReKi) :: VolTwr !< Buoyancy volume of the tower [m^3] + REAL(ReKi) :: VolHub = 0.0_ReKi !< Hub volume [m^3] + REAL(ReKi) :: HubCenBx = 0.0_ReKi !< Hub center of buoyancy x direction offset [m] + REAL(ReKi) :: VolNac = 0.0_ReKi !< Nacelle volume [m^3] + REAL(ReKi) , DIMENSION(1:3) :: NacCenB = 0.0_ReKi !< Position of nacelle center of buoyancy from yaw bearing in nacelle coordinates [m] + REAL(ReKi) , DIMENSION(1:3) :: NacArea = 0.0_ReKi !< Projected area of the nacelle in X, Y, Z in the nacelle coordinate system [m^2] + REAL(ReKi) , DIMENSION(1:3) :: NacCd = 0.0_ReKi !< Drag cefficient for the nacelle areas defied above [-] + REAL(ReKi) , DIMENSION(1:3) :: NacDragAC = 0.0_ReKi !< Position of aerodynamic center of nacelle drag in nacelle coordinates [m] + REAL(ReKi) :: VolBl = 0.0_ReKi !< Buoyancy volume of all blades [m^3] + REAL(ReKi) :: VolTwr = 0.0_ReKi !< Buoyancy volume of the tower [m^3] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BlRad !< Matrix of equivalent blade radius at each node, used in buoyancy calculation [m] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BlDL !< Matrix of blade element length based on CB, used in buoyancy calculation [m] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BlTaper !< Matrix of blade element taper, used in buoyancy calculation [-] @@ -393,40 +475,45 @@ MODULE AeroDyn_Types TYPE(BEMT_ParameterType) :: BEMT !< Parameters for BEMT module [-] TYPE(AA_ParameterType) :: AA !< Parameters for AA module [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: Jac_u_indx !< matrix to help fill/pack the u vector in computing the jacobian [-] + TYPE(Jac_u_idxStarts) :: Jac_u_idxStartList !< Starting indices for all Jac_u components [-] + TYPE(Jac_y_idxStarts) :: Jac_y_idxStartList !< Starting indices for all Jac_y components [-] + INTEGER(IntKi) :: NumExtendedInputs = 0_IntKi !< number of extended inputs [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: du !< vector that determines size of perturbation for u (inputs) [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: dx !< vector that determines size of perturbation for x (continuous states) [-] - INTEGER(IntKi) :: Jac_ny !< number of outputs in jacobian matrix [-] - INTEGER(IntKi) :: NumBl_Lin !< number of blades in the jacobian [-] - INTEGER(IntKi) :: TwrPotent !< Type of tower influence on wind based on potential flow around the tower {0=none, 1=baseline potential flow, 2=potential flow with Bak correction} [-] - INTEGER(IntKi) :: TwrShadow !< Type of tower influence on wind based on downstream tower shadow {0=none, 1=Powles model, 2=Eames model} [-] - LOGICAL :: TwrAero !< Calculate tower aerodynamic loads? [flag] - LOGICAL :: FrozenWake !< Flag that tells this module it should assume a frozen wake during linearization. [-] - LOGICAL :: CavitCheck !< Flag that tells us if we want to check for cavitation [-] - LOGICAL :: Buoyancy !< Include buoyancy effects? [flag] - INTEGER(IntKi) :: MHK !< MHK [flag] - LOGICAL :: CompAA !< Compute AeroAcoustic noise [flag] - REAL(ReKi) :: AirDens !< Air density [kg/m^3] - REAL(ReKi) :: KinVisc !< Kinematic air viscosity [m^2/s] - REAL(ReKi) :: SpdSound !< Speed of sound [m/s] - REAL(ReKi) :: Gravity !< Gravitational acceleration [m/s^2] - REAL(ReKi) :: Patm !< Atmospheric pressure [Pa] - REAL(ReKi) :: Pvap !< Vapour pressure [Pa] - REAL(ReKi) :: WtrDpth !< Water depth [m] - REAL(ReKi) :: MSL2SWL !< Offset between still-water level and mean sea level [m] + INTEGER(IntKi) :: Jac_ny = 0_IntKi !< number of outputs in jacobian matrix [-] + INTEGER(IntKi) :: NumBl_Lin = 0_IntKi !< number of blades in the jacobian [-] + INTEGER(IntKi) :: TwrPotent = 0_IntKi !< Type of tower influence on wind based on potential flow around the tower {0=none, 1=baseline potential flow, 2=potential flow with Bak correction} [-] + INTEGER(IntKi) :: TwrShadow = 0_IntKi !< Type of tower influence on wind based on downstream tower shadow {0=none, 1=Powles model, 2=Eames model} [-] + INTEGER(IntKi) :: TwrAero = 0_IntKi !< Calculate tower aerodynamic loads? {0=none, 1=aero without VIV, 2=aero with VIV} [switch] + INTEGER(IntKi) :: DBEMT_Mod = 0_IntKi !< DBEMT_Mod [-] + LOGICAL :: CavitCheck = .false. !< Flag that tells us if we want to check for cavitation [-] + LOGICAL :: Buoyancy = .false. !< Include buoyancy effects? [flag] + LOGICAL :: NacelleDrag = .false. !< Include NacelleDrag effects? [flag] + INTEGER(IntKi) :: MHK = 0_IntKi !< MHK [flag] + LOGICAL :: CompAA = .false. !< Compute AeroAcoustic noise [flag] + REAL(ReKi) :: AirDens = 0.0_ReKi !< Air density [kg/m^3] + REAL(ReKi) :: KinVisc = 0.0_ReKi !< Kinematic air viscosity [m^2/s] + REAL(ReKi) :: SpdSound = 0.0_ReKi !< Speed of sound [m/s] + REAL(ReKi) :: Gravity = 0.0_ReKi !< Gravitational acceleration [m/s^2] + REAL(ReKi) :: Patm = 0.0_ReKi !< Atmospheric pressure [Pa] + REAL(ReKi) :: Pvap = 0.0_ReKi !< Vapour pressure [Pa] + REAL(ReKi) :: WtrDpth = 0.0_ReKi !< Water depth [m] + REAL(ReKi) :: MSL2SWL = 0.0_ReKi !< Offset between still-water level and mean sea level [m] INTEGER(IntKi) :: AeroProjMod = 1 !< Flag to switch between different projection models [-] - INTEGER(IntKi) :: AeroBEM_Mod = -1 !< Flag to switch between different BEM Model [-] - INTEGER(IntKi) :: NumOuts !< Number of parameters in the output list (number of outputs requested) [-] + INTEGER(IntKi) :: BEM_Mod = -1 !< Flag to switch between different BEM Model [-] + INTEGER(IntKi) :: NumOuts = 0_IntKi !< Number of parameters in the output list (number of outputs requested) [-] CHARACTER(1024) :: RootName !< RootName for writing output files [-] TYPE(OutParmType) , DIMENSION(:), ALLOCATABLE :: OutParam !< Names and units (and other characteristics) of all requested output parameters [-] - INTEGER(IntKi) :: NBlOuts !< Number of blade node outputs [0 - 9] [-] - INTEGER(IntKi) , DIMENSION(1:9) :: BlOutNd !< Blade nodes whose values will be output [-] - INTEGER(IntKi) :: NTwOuts !< Number of tower node outputs [0 - 9] [-] - INTEGER(IntKi) , DIMENSION(1:9) :: TwOutNd !< Tower nodes whose values will be output [-] - INTEGER(IntKi) :: BldNd_NumOuts !< Number of requested output channels per blade node (AD_AllBldNdOuts) [-] - INTEGER(IntKi) :: BldNd_TotNumOuts !< Total number of requested output channels of blade node information (BldNd_NumOuts * BldNd_BlOutNd * BldNd_BladesOut -- AD_AllBldNdOuts) [-] + INTEGER(IntKi) :: NBlOuts = 0_IntKi !< Number of blade node outputs [0 - 9] [-] + INTEGER(IntKi) , DIMENSION(1:9) :: BlOutNd = 0_IntKi !< Blade nodes whose values will be output [-] + INTEGER(IntKi) :: NTwOuts = 0_IntKi !< Number of tower node outputs [0 - 9] [-] + INTEGER(IntKi) , DIMENSION(1:9) :: TwOutNd = 0_IntKi !< Tower nodes whose values will be output [-] + INTEGER(IntKi) :: BldNd_NumOuts = 0_IntKi !< Number of requested output channels per blade node (AD_AllBldNdOuts) [-] + INTEGER(IntKi) :: BldNd_TotNumOuts = 0_IntKi !< Total number of requested output channels of blade node information (BldNd_NumOuts * BldNd_BlOutNd * BldNd_BladesOut -- AD_AllBldNdOuts) [-] TYPE(OutParmType) , DIMENSION(:), ALLOCATABLE :: BldNd_OutParam !< Names and units (and other characteristics) of all requested output parameters [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: BldNd_BlOutNd !< The blade nodes to actually output (AD_AllBldNdOuts) [-] - INTEGER(IntKi) :: BldNd_BladesOut !< The blades to output (AD_AllBldNdOuts) [-] + INTEGER(IntKi) :: BldNd_BladesOut = 0_IntKi !< The blades to output (AD_AllBldNdOuts) [-] + INTEGER(IntKi) :: BldNd_NumNodesOut = 0_IntKi !< The blades to output (AD_AllBldNdOuts) [-] LOGICAL :: TFinAero = .FALSE. !< Calculate tail fin aerodynamics model (flag) [flag] TYPE(TFinParameterType) :: TFin !< Parameters for tail fin of current rotor [-] END TYPE RotParameterType @@ -434,14 +521,20 @@ MODULE AeroDyn_Types ! ========= AD_ParameterType ======= TYPE, PUBLIC :: AD_ParameterType TYPE(RotParameterType) , DIMENSION(:), ALLOCATABLE :: rotors !< Parameter types for each rotor [-] - REAL(DbKi) :: DT !< Time step for continuous state integration & discrete state update [seconds] + REAL(DbKi) :: DT = 0.0_R8Ki !< Time step for continuous state integration & discrete state update [seconds] CHARACTER(1024) :: RootName !< RootName for writing output files [-] TYPE(AFI_ParameterType) , DIMENSION(:), ALLOCATABLE :: AFI !< AirfoilInfo parameters [-] - INTEGER(IntKi) :: SkewMod !< Type of skewed-wake correction model {0=orthogonal, 1=uncoupled, 2=Pitt/Peters, 3=coupled} [unused when WakeMod=0] [-] - INTEGER(IntKi) :: WakeMod !< Type of wake/induction model {0=none, 1=BEMT, 2=DBEMT, 3=FVW} [-] + INTEGER(IntKi) :: Skew_Mod = 0_IntKi !< Type of skewed-wake correction model {-1=orthogonal, 0=None, 1=Glauert} [unused when Wake_Mod=0] [-] + INTEGER(IntKi) :: Wake_Mod = 0_IntKi !< Type of wake/induction model {0=none, 1=BEMT, 2=DBEMT, 3=FVW} [-] TYPE(FVW_ParameterType) :: FVW !< Parameters for FVW module [-] LOGICAL :: CompAeroMaps = .FALSE. !< flag to determine if AeroDyn is computing aero maps (true) or running a normal simulation (false) [-] - LOGICAL :: UA_Flag !< logical flag indicating whether to use UnsteadyAero [-] + LOGICAL :: UA_Flag = .false. !< logical flag indicating whether to use UnsteadyAero [-] + TYPE(FlowFieldType) , POINTER :: FlowField => NULL() !< Pointer of InflowWinds flow field data type [-] + LOGICAL :: SectAvg = .false. !< Use Sector average for BEM inflow velocity calculation [-] + INTEGER(IntKi) :: SA_Weighting = 0_IntKi !< Sector Average - Weighting function for sector average {1=Uniform, 2=Impulse} within a 360/nB sector centered on the blade (switch) [used only when SectAvg=True] [-] + REAL(ReKi) :: SA_PsiBwd = 0.0_ReKi !< Sector Average - Backard Azimuth (<0) [deg] + REAL(ReKi) :: SA_PsiFwd = 0.0_ReKi !< Sector Average - Forward Azimuth (>0) [deg] + INTEGER(IntKi) :: SA_nPerSec = 0_IntKi !< Sector Average - Number of points per sector (>1) [-] END TYPE AD_ParameterType ! ======================= ! ========= RotInputType ======= @@ -452,18 +545,12 @@ MODULE AeroDyn_Types TYPE(MeshType) , DIMENSION(:), ALLOCATABLE :: BladeRootMotion !< motion on each blade root [-] TYPE(MeshType) , DIMENSION(:), ALLOCATABLE :: BladeMotion !< motion on each blade [-] TYPE(MeshType) :: TFinMotion !< motion of tail fin (at tail fin ref point) [-] - REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: InflowOnBlade !< U,V,W at nodes on each blade (note if we change the requirement that NumNodes is the same for each blade, this will need to change) [m/s] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: InflowOnTower !< U,V,W at nodes on the tower [m/s] - REAL(ReKi) , DIMENSION(1:3) :: InflowOnHub !< U,V,W at hub [m/s] - REAL(ReKi) , DIMENSION(1:3) :: InflowOnNacelle !< U,V,W at nacelle [m/s] - REAL(ReKi) , DIMENSION(1:3) :: InflowOnTailFin !< U,V,W at tailfin [m/s] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: UserProp !< Optional user property for interpolating airfoils (per element per blade) [-] END TYPE RotInputType ! ======================= ! ========= AD_InputType ======= TYPE, PUBLIC :: AD_InputType TYPE(RotInputType) , DIMENSION(:), ALLOCATABLE :: rotors !< Inputs for each rotor [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: InflowWakeVel !< U,V,W at wake points [m/s] END TYPE AD_InputType ! ======================= ! ========= RotOutputType ======= @@ -482,17859 +569,6173 @@ MODULE AeroDyn_Types END TYPE AD_OutputType ! ======================= CONTAINS - SUBROUTINE AD_CopyTFinParameterType( SrcTFinParameterTypeData, DstTFinParameterTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(TFinParameterType), INTENT(IN) :: SrcTFinParameterTypeData - TYPE(TFinParameterType), INTENT(INOUT) :: DstTFinParameterTypeData - 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 = 'AD_CopyTFinParameterType' -! - ErrStat = ErrID_None - ErrMsg = "" - DstTFinParameterTypeData%TFinMod = SrcTFinParameterTypeData%TFinMod - DstTFinParameterTypeData%TFinChord = SrcTFinParameterTypeData%TFinChord - DstTFinParameterTypeData%TFinArea = SrcTFinParameterTypeData%TFinArea - DstTFinParameterTypeData%TFinIndMod = SrcTFinParameterTypeData%TFinIndMod - DstTFinParameterTypeData%TFinAFID = SrcTFinParameterTypeData%TFinAFID - END SUBROUTINE AD_CopyTFinParameterType - - SUBROUTINE AD_DestroyTFinParameterType( TFinParameterTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(TFinParameterType), INTENT(INOUT) :: TFinParameterTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_DestroyTFinParameterType' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE AD_DestroyTFinParameterType - - SUBROUTINE AD_PackTFinParameterType( 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(TFinParameterType), 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 = 'AD_PackTFinParameterType' - ! 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 ! TFinMod - Re_BufSz = Re_BufSz + 1 ! TFinChord - Re_BufSz = Re_BufSz + 1 ! TFinArea - Int_BufSz = Int_BufSz + 1 ! TFinIndMod - Int_BufSz = Int_BufSz + 1 ! TFinAFID - 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%TFinMod - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TFinChord - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TFinArea - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%TFinIndMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%TFinAFID - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE AD_PackTFinParameterType - SUBROUTINE AD_UnPackTFinParameterType( 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(TFinParameterType), 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 = 'AD_UnPackTFinParameterType' - ! 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%TFinMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TFinChord = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TFinArea = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TFinIndMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TFinAFID = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE AD_UnPackTFinParameterType - - SUBROUTINE AD_CopyTFinInputFileType( SrcTFinInputFileTypeData, DstTFinInputFileTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(TFinInputFileType), INTENT(IN) :: SrcTFinInputFileTypeData - TYPE(TFinInputFileType), INTENT(INOUT) :: DstTFinInputFileTypeData - 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 = 'AD_CopyTFinInputFileType' -! +subroutine AD_CopyTFinParameterType(SrcTFinParameterTypeData, DstTFinParameterTypeData, CtrlCode, ErrStat, ErrMsg) + type(TFinParameterType), intent(in) :: SrcTFinParameterTypeData + type(TFinParameterType), intent(inout) :: DstTFinParameterTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD_CopyTFinParameterType' ErrStat = ErrID_None - ErrMsg = "" - DstTFinInputFileTypeData%TFinMod = SrcTFinInputFileTypeData%TFinMod - DstTFinInputFileTypeData%TFinChord = SrcTFinInputFileTypeData%TFinChord - DstTFinInputFileTypeData%TFinArea = SrcTFinInputFileTypeData%TFinArea - DstTFinInputFileTypeData%TFinRefP_n = SrcTFinInputFileTypeData%TFinRefP_n - DstTFinInputFileTypeData%TFinAngles = SrcTFinInputFileTypeData%TFinAngles - DstTFinInputFileTypeData%TFinIndMod = SrcTFinInputFileTypeData%TFinIndMod - DstTFinInputFileTypeData%TFinAFID = SrcTFinInputFileTypeData%TFinAFID - END SUBROUTINE AD_CopyTFinInputFileType - - SUBROUTINE AD_DestroyTFinInputFileType( TFinInputFileTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(TFinInputFileType), INTENT(INOUT) :: TFinInputFileTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_DestroyTFinInputFileType' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE AD_DestroyTFinInputFileType - - SUBROUTINE AD_PackTFinInputFileType( 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(TFinInputFileType), 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 = 'AD_PackTFinInputFileType' - ! 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 ! TFinMod - Re_BufSz = Re_BufSz + 1 ! TFinChord - Re_BufSz = Re_BufSz + 1 ! TFinArea - Re_BufSz = Re_BufSz + SIZE(InData%TFinRefP_n) ! TFinRefP_n - Re_BufSz = Re_BufSz + SIZE(InData%TFinAngles) ! TFinAngles - Int_BufSz = Int_BufSz + 1 ! TFinIndMod - Int_BufSz = Int_BufSz + 1 ! TFinAFID - 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%TFinMod - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TFinChord - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TFinArea - Re_Xferred = Re_Xferred + 1 - DO i1 = LBOUND(InData%TFinRefP_n,1), UBOUND(InData%TFinRefP_n,1) - ReKiBuf(Re_Xferred) = InData%TFinRefP_n(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%TFinAngles,1), UBOUND(InData%TFinAngles,1) - ReKiBuf(Re_Xferred) = InData%TFinAngles(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%TFinIndMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%TFinAFID - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE AD_PackTFinInputFileType - - SUBROUTINE AD_UnPackTFinInputFileType( 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(TFinInputFileType), 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 = 'AD_UnPackTFinInputFileType' - ! 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%TFinMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TFinChord = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TFinArea = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%TFinRefP_n,1) - i1_u = UBOUND(OutData%TFinRefP_n,1) - DO i1 = LBOUND(OutData%TFinRefP_n,1), UBOUND(OutData%TFinRefP_n,1) - OutData%TFinRefP_n(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%TFinAngles,1) - i1_u = UBOUND(OutData%TFinAngles,1) - DO i1 = LBOUND(OutData%TFinAngles,1), UBOUND(OutData%TFinAngles,1) - OutData%TFinAngles(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%TFinIndMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TFinAFID = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE AD_UnPackTFinInputFileType + ErrMsg = '' + DstTFinParameterTypeData%TFinMod = SrcTFinParameterTypeData%TFinMod + DstTFinParameterTypeData%TFinArea = SrcTFinParameterTypeData%TFinArea + DstTFinParameterTypeData%TFinIndMod = SrcTFinParameterTypeData%TFinIndMod + DstTFinParameterTypeData%TFinAFID = SrcTFinParameterTypeData%TFinAFID + DstTFinParameterTypeData%TFinChord = SrcTFinParameterTypeData%TFinChord + DstTFinParameterTypeData%TFinKp = SrcTFinParameterTypeData%TFinKp + DstTFinParameterTypeData%TFinSigma = SrcTFinParameterTypeData%TFinSigma + DstTFinParameterTypeData%TFinAStar = SrcTFinParameterTypeData%TFinAStar + DstTFinParameterTypeData%TFinKv = SrcTFinParameterTypeData%TFinKv + DstTFinParameterTypeData%TFinCDc = SrcTFinParameterTypeData%TFinCDc +end subroutine + +subroutine AD_DestroyTFinParameterType(TFinParameterTypeData, ErrStat, ErrMsg) + type(TFinParameterType), intent(inout) :: TFinParameterTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD_DestroyTFinParameterType' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine AD_PackTFinParameterType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(TFinParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_PackTFinParameterType' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%TFinMod) + call RegPack(RF, InData%TFinArea) + call RegPack(RF, InData%TFinIndMod) + call RegPack(RF, InData%TFinAFID) + call RegPack(RF, InData%TFinChord) + call RegPack(RF, InData%TFinKp) + call RegPack(RF, InData%TFinSigma) + call RegPack(RF, InData%TFinAStar) + call RegPack(RF, InData%TFinKv) + call RegPack(RF, InData%TFinCDc) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AD_UnPackTFinParameterType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(TFinParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_UnPackTFinParameterType' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%TFinMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFinArea); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFinIndMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFinAFID); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFinChord); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFinKp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFinSigma); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFinAStar); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFinKv); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFinCDc); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AD_CopyTFinInputFileType(SrcTFinInputFileTypeData, DstTFinInputFileTypeData, CtrlCode, ErrStat, ErrMsg) + type(TFinInputFileType), intent(in) :: SrcTFinInputFileTypeData + type(TFinInputFileType), intent(inout) :: DstTFinInputFileTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD_CopyTFinInputFileType' + ErrStat = ErrID_None + ErrMsg = '' + DstTFinInputFileTypeData%TFinMod = SrcTFinInputFileTypeData%TFinMod + DstTFinInputFileTypeData%TFinArea = SrcTFinInputFileTypeData%TFinArea + DstTFinInputFileTypeData%TFinRefP_n = SrcTFinInputFileTypeData%TFinRefP_n + DstTFinInputFileTypeData%TFinAngles = SrcTFinInputFileTypeData%TFinAngles + DstTFinInputFileTypeData%TFinIndMod = SrcTFinInputFileTypeData%TFinIndMod + DstTFinInputFileTypeData%TFinAFID = SrcTFinInputFileTypeData%TFinAFID + DstTFinInputFileTypeData%TFinChord = SrcTFinInputFileTypeData%TFinChord + DstTFinInputFileTypeData%TFinKp = SrcTFinInputFileTypeData%TFinKp + DstTFinInputFileTypeData%TFinSigma = SrcTFinInputFileTypeData%TFinSigma + DstTFinInputFileTypeData%TFinAStar = SrcTFinInputFileTypeData%TFinAStar + DstTFinInputFileTypeData%TFinKv = SrcTFinInputFileTypeData%TFinKv + DstTFinInputFileTypeData%TFinCDc = SrcTFinInputFileTypeData%TFinCDc +end subroutine + +subroutine AD_DestroyTFinInputFileType(TFinInputFileTypeData, ErrStat, ErrMsg) + type(TFinInputFileType), intent(inout) :: TFinInputFileTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD_DestroyTFinInputFileType' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine AD_PackTFinInputFileType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(TFinInputFileType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_PackTFinInputFileType' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%TFinMod) + call RegPack(RF, InData%TFinArea) + call RegPack(RF, InData%TFinRefP_n) + call RegPack(RF, InData%TFinAngles) + call RegPack(RF, InData%TFinIndMod) + call RegPack(RF, InData%TFinAFID) + call RegPack(RF, InData%TFinChord) + call RegPack(RF, InData%TFinKp) + call RegPack(RF, InData%TFinSigma) + call RegPack(RF, InData%TFinAStar) + call RegPack(RF, InData%TFinKv) + call RegPack(RF, InData%TFinCDc) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AD_UnPackTFinInputFileType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(TFinInputFileType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_UnPackTFinInputFileType' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%TFinMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFinArea); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFinRefP_n); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFinAngles); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFinIndMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFinAFID); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFinChord); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFinKp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFinSigma); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFinAStar); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFinKv); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFinCDc); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AD_CopyVTK_BLSurfaceType(SrcVTK_BLSurfaceTypeData, DstVTK_BLSurfaceTypeData, CtrlCode, ErrStat, ErrMsg) + type(AD_VTK_BLSurfaceType), intent(in) :: SrcVTK_BLSurfaceTypeData + type(AD_VTK_BLSurfaceType), intent(inout) :: DstVTK_BLSurfaceTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'AD_CopyVTK_BLSurfaceType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcVTK_BLSurfaceTypeData%AirfoilCoords)) then + LB(1:3) = lbound(SrcVTK_BLSurfaceTypeData%AirfoilCoords) + UB(1:3) = ubound(SrcVTK_BLSurfaceTypeData%AirfoilCoords) + if (.not. allocated(DstVTK_BLSurfaceTypeData%AirfoilCoords)) then + allocate(DstVTK_BLSurfaceTypeData%AirfoilCoords(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_BLSurfaceTypeData%AirfoilCoords.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstVTK_BLSurfaceTypeData%AirfoilCoords = SrcVTK_BLSurfaceTypeData%AirfoilCoords + end if +end subroutine + +subroutine AD_DestroyVTK_BLSurfaceType(VTK_BLSurfaceTypeData, ErrStat, ErrMsg) + type(AD_VTK_BLSurfaceType), intent(inout) :: VTK_BLSurfaceTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD_DestroyVTK_BLSurfaceType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(VTK_BLSurfaceTypeData%AirfoilCoords)) then + deallocate(VTK_BLSurfaceTypeData%AirfoilCoords) + end if +end subroutine + +subroutine AD_PackVTK_BLSurfaceType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(AD_VTK_BLSurfaceType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_PackVTK_BLSurfaceType' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%AirfoilCoords) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AD_UnPackVTK_BLSurfaceType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(AD_VTK_BLSurfaceType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_UnPackVTK_BLSurfaceType' + integer(B4Ki) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%AirfoilCoords); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AD_CopyVTK_RotSurfaceType(SrcVTK_RotSurfaceTypeData, DstVTK_RotSurfaceTypeData, CtrlCode, ErrStat, ErrMsg) + type(AD_VTK_RotSurfaceType), intent(in) :: SrcVTK_RotSurfaceTypeData + type(AD_VTK_RotSurfaceType), intent(inout) :: DstVTK_RotSurfaceTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_CopyVTK_RotSurfaceType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcVTK_RotSurfaceTypeData%BladeShape)) then + LB(1:1) = lbound(SrcVTK_RotSurfaceTypeData%BladeShape) + UB(1:1) = ubound(SrcVTK_RotSurfaceTypeData%BladeShape) + if (.not. allocated(DstVTK_RotSurfaceTypeData%BladeShape)) then + allocate(DstVTK_RotSurfaceTypeData%BladeShape(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_RotSurfaceTypeData%BladeShape.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AD_CopyVTK_BLSurfaceType(SrcVTK_RotSurfaceTypeData%BladeShape(i1), DstVTK_RotSurfaceTypeData%BladeShape(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcVTK_RotSurfaceTypeData%TowerRad)) then + LB(1:1) = lbound(SrcVTK_RotSurfaceTypeData%TowerRad) + UB(1:1) = ubound(SrcVTK_RotSurfaceTypeData%TowerRad) + if (.not. allocated(DstVTK_RotSurfaceTypeData%TowerRad)) then + allocate(DstVTK_RotSurfaceTypeData%TowerRad(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_RotSurfaceTypeData%TowerRad.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstVTK_RotSurfaceTypeData%TowerRad = SrcVTK_RotSurfaceTypeData%TowerRad + end if +end subroutine + +subroutine AD_DestroyVTK_RotSurfaceType(VTK_RotSurfaceTypeData, ErrStat, ErrMsg) + type(AD_VTK_RotSurfaceType), intent(inout) :: VTK_RotSurfaceTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_DestroyVTK_RotSurfaceType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(VTK_RotSurfaceTypeData%BladeShape)) then + LB(1:1) = lbound(VTK_RotSurfaceTypeData%BladeShape) + UB(1:1) = ubound(VTK_RotSurfaceTypeData%BladeShape) + do i1 = LB(1), UB(1) + call AD_DestroyVTK_BLSurfaceType(VTK_RotSurfaceTypeData%BladeShape(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(VTK_RotSurfaceTypeData%BladeShape) + end if + if (allocated(VTK_RotSurfaceTypeData%TowerRad)) then + deallocate(VTK_RotSurfaceTypeData%TowerRad) + end if +end subroutine + +subroutine AD_PackVTK_RotSurfaceType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(AD_VTK_RotSurfaceType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_PackVTK_RotSurfaceType' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%BladeShape)) + if (allocated(InData%BladeShape)) then + call RegPackBounds(RF, 1, lbound(InData%BladeShape), ubound(InData%BladeShape)) + LB(1:1) = lbound(InData%BladeShape) + UB(1:1) = ubound(InData%BladeShape) + do i1 = LB(1), UB(1) + call AD_PackVTK_BLSurfaceType(RF, InData%BladeShape(i1)) + end do + end if + call RegPackAlloc(RF, InData%TowerRad) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AD_UnPackVTK_RotSurfaceType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(AD_VTK_RotSurfaceType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_UnPackVTK_RotSurfaceType' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + if (allocated(OutData%BladeShape)) deallocate(OutData%BladeShape) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%BladeShape(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeShape.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AD_UnpackVTK_BLSurfaceType(RF, OutData%BladeShape(i1)) ! BladeShape + end do + end if + call RegUnpackAlloc(RF, OutData%TowerRad); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AD_CopyRotInitInputType(SrcRotInitInputTypeData, DstRotInitInputTypeData, CtrlCode, ErrStat, ErrMsg) + type(RotInitInputType), intent(in) :: SrcRotInitInputTypeData + type(RotInitInputType), intent(inout) :: DstRotInitInputTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'AD_CopyRotInitInputType' + ErrStat = ErrID_None + ErrMsg = '' + DstRotInitInputTypeData%NumBlades = SrcRotInitInputTypeData%NumBlades + DstRotInitInputTypeData%originInit = SrcRotInitInputTypeData%originInit + DstRotInitInputTypeData%HubPosition = SrcRotInitInputTypeData%HubPosition + DstRotInitInputTypeData%HubOrientation = SrcRotInitInputTypeData%HubOrientation + if (allocated(SrcRotInitInputTypeData%BladeRootPosition)) then + LB(1:2) = lbound(SrcRotInitInputTypeData%BladeRootPosition) + UB(1:2) = ubound(SrcRotInitInputTypeData%BladeRootPosition) + if (.not. allocated(DstRotInitInputTypeData%BladeRootPosition)) then + allocate(DstRotInitInputTypeData%BladeRootPosition(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotInitInputTypeData%BladeRootPosition.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotInitInputTypeData%BladeRootPosition = SrcRotInitInputTypeData%BladeRootPosition + end if + if (allocated(SrcRotInitInputTypeData%BladeRootOrientation)) then + LB(1:3) = lbound(SrcRotInitInputTypeData%BladeRootOrientation) + UB(1:3) = ubound(SrcRotInitInputTypeData%BladeRootOrientation) + if (.not. allocated(DstRotInitInputTypeData%BladeRootOrientation)) then + allocate(DstRotInitInputTypeData%BladeRootOrientation(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotInitInputTypeData%BladeRootOrientation.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotInitInputTypeData%BladeRootOrientation = SrcRotInitInputTypeData%BladeRootOrientation + end if + DstRotInitInputTypeData%NacellePosition = SrcRotInitInputTypeData%NacellePosition + DstRotInitInputTypeData%NacelleOrientation = SrcRotInitInputTypeData%NacelleOrientation + DstRotInitInputTypeData%AeroProjMod = SrcRotInitInputTypeData%AeroProjMod + DstRotInitInputTypeData%RotSpeed = SrcRotInitInputTypeData%RotSpeed +end subroutine + +subroutine AD_DestroyRotInitInputType(RotInitInputTypeData, ErrStat, ErrMsg) + type(RotInitInputType), intent(inout) :: RotInitInputTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD_DestroyRotInitInputType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(RotInitInputTypeData%BladeRootPosition)) then + deallocate(RotInitInputTypeData%BladeRootPosition) + end if + if (allocated(RotInitInputTypeData%BladeRootOrientation)) then + deallocate(RotInitInputTypeData%BladeRootOrientation) + end if +end subroutine + +subroutine AD_PackRotInitInputType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(RotInitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_PackRotInitInputType' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%NumBlades) + call RegPack(RF, InData%originInit) + call RegPack(RF, InData%HubPosition) + call RegPack(RF, InData%HubOrientation) + call RegPackAlloc(RF, InData%BladeRootPosition) + call RegPackAlloc(RF, InData%BladeRootOrientation) + call RegPack(RF, InData%NacellePosition) + call RegPack(RF, InData%NacelleOrientation) + call RegPack(RF, InData%AeroProjMod) + call RegPack(RF, InData%RotSpeed) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AD_UnPackRotInitInputType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(RotInitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_UnPackRotInitInputType' + integer(B4Ki) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%NumBlades); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%originInit); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HubPosition); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HubOrientation); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BladeRootPosition); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BladeRootOrientation); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NacellePosition); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NacelleOrientation); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AeroProjMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RotSpeed); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) + type(AD_InitInputType), intent(in) :: SrcInitInputData + type(AD_InitInputType), intent(inout) :: DstInitInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_CopyInitInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcInitInputData%rotors)) then + LB(1:1) = lbound(SrcInitInputData%rotors) + UB(1:1) = ubound(SrcInitInputData%rotors) + if (.not. allocated(DstInitInputData%rotors)) then + allocate(DstInitInputData%rotors(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%rotors.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AD_CopyRotInitInputType(SrcInitInputData%rotors(i1), DstInitInputData%rotors(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + DstInitInputData%InputFile = SrcInitInputData%InputFile + DstInitInputData%RootName = SrcInitInputData%RootName + DstInitInputData%UsePrimaryInputFile = SrcInitInputData%UsePrimaryInputFile + call NWTC_Library_CopyFileInfoType(SrcInitInputData%PassedPrimaryInputData, DstInitInputData%PassedPrimaryInputData, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstInitInputData%Linearize = SrcInitInputData%Linearize + DstInitInputData%CompAeroMaps = SrcInitInputData%CompAeroMaps + DstInitInputData%Gravity = SrcInitInputData%Gravity + DstInitInputData%MHK = SrcInitInputData%MHK + DstInitInputData%defFldDens = SrcInitInputData%defFldDens + DstInitInputData%defKinVisc = SrcInitInputData%defKinVisc + DstInitInputData%defSpdSound = SrcInitInputData%defSpdSound + DstInitInputData%defPatm = SrcInitInputData%defPatm + DstInitInputData%defPvap = SrcInitInputData%defPvap + DstInitInputData%WtrDpth = SrcInitInputData%WtrDpth + DstInitInputData%MSL2SWL = SrcInitInputData%MSL2SWL + DstInitInputData%FlowField => SrcInitInputData%FlowField +end subroutine + +subroutine AD_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(AD_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_DestroyInitInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InitInputData%rotors)) then + LB(1:1) = lbound(InitInputData%rotors) + UB(1:1) = ubound(InitInputData%rotors) + do i1 = LB(1), UB(1) + call AD_DestroyRotInitInputType(InitInputData%rotors(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InitInputData%rotors) + end if + call NWTC_Library_DestroyFileInfoType(InitInputData%PassedPrimaryInputData, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + nullify(InitInputData%FlowField) +end subroutine + +subroutine AD_PackInitInput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(AD_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_PackInitInput' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + logical :: PtrInIndex + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%rotors)) + if (allocated(InData%rotors)) then + call RegPackBounds(RF, 1, lbound(InData%rotors), ubound(InData%rotors)) + LB(1:1) = lbound(InData%rotors) + UB(1:1) = ubound(InData%rotors) + do i1 = LB(1), UB(1) + call AD_PackRotInitInputType(RF, InData%rotors(i1)) + end do + end if + call RegPack(RF, InData%InputFile) + call RegPack(RF, InData%RootName) + call RegPack(RF, InData%UsePrimaryInputFile) + call NWTC_Library_PackFileInfoType(RF, InData%PassedPrimaryInputData) + call RegPack(RF, InData%Linearize) + call RegPack(RF, InData%CompAeroMaps) + call RegPack(RF, InData%Gravity) + call RegPack(RF, InData%MHK) + call RegPack(RF, InData%defFldDens) + call RegPack(RF, InData%defKinVisc) + call RegPack(RF, InData%defSpdSound) + call RegPack(RF, InData%defPatm) + call RegPack(RF, InData%defPvap) + call RegPack(RF, InData%WtrDpth) + call RegPack(RF, InData%MSL2SWL) + call RegPack(RF, associated(InData%FlowField)) + if (associated(InData%FlowField)) then + call RegPackPointer(RF, c_loc(InData%FlowField), PtrInIndex) + if (.not. PtrInIndex) then + call IfW_FlowField_PackFlowFieldType(RF, InData%FlowField) + end if + end if + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AD_UnPackInitInput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(AD_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_UnPackInitInput' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(B8Ki) :: PtrIdx + type(c_ptr) :: Ptr + if (RF%ErrStat /= ErrID_None) return + if (allocated(OutData%rotors)) deallocate(OutData%rotors) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%rotors(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotors.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AD_UnpackRotInitInputType(RF, OutData%rotors(i1)) ! rotors + end do + end if + call RegUnpack(RF, OutData%InputFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RootName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UsePrimaryInputFile); if (RegCheckErr(RF, RoutineName)) return + call NWTC_Library_UnpackFileInfoType(RF, OutData%PassedPrimaryInputData) ! PassedPrimaryInputData + call RegUnpack(RF, OutData%Linearize); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CompAeroMaps); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Gravity); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MHK); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%defFldDens); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%defKinVisc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%defSpdSound); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%defPatm); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%defPvap); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WtrDpth); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MSL2SWL); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%FlowField)) deallocate(OutData%FlowField) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackPointer(RF, Ptr, PtrIdx); if (RegCheckErr(RF, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%FlowField) + else + allocate(OutData%FlowField,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FlowField.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + RF%Pointers(PtrIdx) = c_loc(OutData%FlowField) + call IfW_FlowField_UnpackFlowFieldType(RF, OutData%FlowField) ! FlowField + end if + else + OutData%FlowField => null() + end if +end subroutine + +subroutine AD_CopyBladePropsType(SrcBladePropsTypeData, DstBladePropsTypeData, CtrlCode, ErrStat, ErrMsg) + type(AD_BladePropsType), intent(in) :: SrcBladePropsTypeData + type(AD_BladePropsType), intent(inout) :: DstBladePropsTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'AD_CopyBladePropsType' + ErrStat = ErrID_None + ErrMsg = '' + DstBladePropsTypeData%NumBlNds = SrcBladePropsTypeData%NumBlNds + if (allocated(SrcBladePropsTypeData%BlSpn)) then + LB(1:1) = lbound(SrcBladePropsTypeData%BlSpn) + UB(1:1) = ubound(SrcBladePropsTypeData%BlSpn) + if (.not. allocated(DstBladePropsTypeData%BlSpn)) then + allocate(DstBladePropsTypeData%BlSpn(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladePropsTypeData%BlSpn.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladePropsTypeData%BlSpn = SrcBladePropsTypeData%BlSpn + end if + if (allocated(SrcBladePropsTypeData%BlCrvAC)) then + LB(1:1) = lbound(SrcBladePropsTypeData%BlCrvAC) + UB(1:1) = ubound(SrcBladePropsTypeData%BlCrvAC) + if (.not. allocated(DstBladePropsTypeData%BlCrvAC)) then + allocate(DstBladePropsTypeData%BlCrvAC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladePropsTypeData%BlCrvAC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladePropsTypeData%BlCrvAC = SrcBladePropsTypeData%BlCrvAC + end if + if (allocated(SrcBladePropsTypeData%BlSwpAC)) then + LB(1:1) = lbound(SrcBladePropsTypeData%BlSwpAC) + UB(1:1) = ubound(SrcBladePropsTypeData%BlSwpAC) + if (.not. allocated(DstBladePropsTypeData%BlSwpAC)) then + allocate(DstBladePropsTypeData%BlSwpAC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladePropsTypeData%BlSwpAC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladePropsTypeData%BlSwpAC = SrcBladePropsTypeData%BlSwpAC + end if + if (allocated(SrcBladePropsTypeData%BlCrvAng)) then + LB(1:1) = lbound(SrcBladePropsTypeData%BlCrvAng) + UB(1:1) = ubound(SrcBladePropsTypeData%BlCrvAng) + if (.not. allocated(DstBladePropsTypeData%BlCrvAng)) then + allocate(DstBladePropsTypeData%BlCrvAng(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladePropsTypeData%BlCrvAng.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladePropsTypeData%BlCrvAng = SrcBladePropsTypeData%BlCrvAng + end if + if (allocated(SrcBladePropsTypeData%BlTwist)) then + LB(1:1) = lbound(SrcBladePropsTypeData%BlTwist) + UB(1:1) = ubound(SrcBladePropsTypeData%BlTwist) + if (.not. allocated(DstBladePropsTypeData%BlTwist)) then + allocate(DstBladePropsTypeData%BlTwist(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladePropsTypeData%BlTwist.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladePropsTypeData%BlTwist = SrcBladePropsTypeData%BlTwist + end if + if (allocated(SrcBladePropsTypeData%BlChord)) then + LB(1:1) = lbound(SrcBladePropsTypeData%BlChord) + UB(1:1) = ubound(SrcBladePropsTypeData%BlChord) + if (.not. allocated(DstBladePropsTypeData%BlChord)) then + allocate(DstBladePropsTypeData%BlChord(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladePropsTypeData%BlChord.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladePropsTypeData%BlChord = SrcBladePropsTypeData%BlChord + end if + if (allocated(SrcBladePropsTypeData%BlAFID)) then + LB(1:1) = lbound(SrcBladePropsTypeData%BlAFID) + UB(1:1) = ubound(SrcBladePropsTypeData%BlAFID) + if (.not. allocated(DstBladePropsTypeData%BlAFID)) then + allocate(DstBladePropsTypeData%BlAFID(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladePropsTypeData%BlAFID.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladePropsTypeData%BlAFID = SrcBladePropsTypeData%BlAFID + end if + if (allocated(SrcBladePropsTypeData%BlCb)) then + LB(1:1) = lbound(SrcBladePropsTypeData%BlCb) + UB(1:1) = ubound(SrcBladePropsTypeData%BlCb) + if (.not. allocated(DstBladePropsTypeData%BlCb)) then + allocate(DstBladePropsTypeData%BlCb(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladePropsTypeData%BlCb.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladePropsTypeData%BlCb = SrcBladePropsTypeData%BlCb + end if + if (allocated(SrcBladePropsTypeData%BlCenBn)) then + LB(1:1) = lbound(SrcBladePropsTypeData%BlCenBn) + UB(1:1) = ubound(SrcBladePropsTypeData%BlCenBn) + if (.not. allocated(DstBladePropsTypeData%BlCenBn)) then + allocate(DstBladePropsTypeData%BlCenBn(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladePropsTypeData%BlCenBn.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladePropsTypeData%BlCenBn = SrcBladePropsTypeData%BlCenBn + end if + if (allocated(SrcBladePropsTypeData%BlCenBt)) then + LB(1:1) = lbound(SrcBladePropsTypeData%BlCenBt) + UB(1:1) = ubound(SrcBladePropsTypeData%BlCenBt) + if (.not. allocated(DstBladePropsTypeData%BlCenBt)) then + allocate(DstBladePropsTypeData%BlCenBt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladePropsTypeData%BlCenBt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladePropsTypeData%BlCenBt = SrcBladePropsTypeData%BlCenBt + end if +end subroutine + +subroutine AD_DestroyBladePropsType(BladePropsTypeData, ErrStat, ErrMsg) + type(AD_BladePropsType), intent(inout) :: BladePropsTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD_DestroyBladePropsType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(BladePropsTypeData%BlSpn)) then + deallocate(BladePropsTypeData%BlSpn) + end if + if (allocated(BladePropsTypeData%BlCrvAC)) then + deallocate(BladePropsTypeData%BlCrvAC) + end if + if (allocated(BladePropsTypeData%BlSwpAC)) then + deallocate(BladePropsTypeData%BlSwpAC) + end if + if (allocated(BladePropsTypeData%BlCrvAng)) then + deallocate(BladePropsTypeData%BlCrvAng) + end if + if (allocated(BladePropsTypeData%BlTwist)) then + deallocate(BladePropsTypeData%BlTwist) + end if + if (allocated(BladePropsTypeData%BlChord)) then + deallocate(BladePropsTypeData%BlChord) + end if + if (allocated(BladePropsTypeData%BlAFID)) then + deallocate(BladePropsTypeData%BlAFID) + end if + if (allocated(BladePropsTypeData%BlCb)) then + deallocate(BladePropsTypeData%BlCb) + end if + if (allocated(BladePropsTypeData%BlCenBn)) then + deallocate(BladePropsTypeData%BlCenBn) + end if + if (allocated(BladePropsTypeData%BlCenBt)) then + deallocate(BladePropsTypeData%BlCenBt) + end if +end subroutine + +subroutine AD_PackBladePropsType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(AD_BladePropsType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_PackBladePropsType' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%NumBlNds) + call RegPackAlloc(RF, InData%BlSpn) + call RegPackAlloc(RF, InData%BlCrvAC) + call RegPackAlloc(RF, InData%BlSwpAC) + call RegPackAlloc(RF, InData%BlCrvAng) + call RegPackAlloc(RF, InData%BlTwist) + call RegPackAlloc(RF, InData%BlChord) + call RegPackAlloc(RF, InData%BlAFID) + call RegPackAlloc(RF, InData%BlCb) + call RegPackAlloc(RF, InData%BlCenBn) + call RegPackAlloc(RF, InData%BlCenBt) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AD_UnPackBladePropsType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(AD_BladePropsType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_UnPackBladePropsType' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%NumBlNds); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BlSpn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BlCrvAC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BlSwpAC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BlCrvAng); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BlTwist); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BlChord); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BlAFID); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BlCb); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BlCenBn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BlCenBt); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AD_CopyBladeShape(SrcBladeShapeData, DstBladeShapeData, CtrlCode, ErrStat, ErrMsg) + type(AD_BladeShape), intent(in) :: SrcBladeShapeData + type(AD_BladeShape), intent(inout) :: DstBladeShapeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'AD_CopyBladeShape' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcBladeShapeData%AirfoilCoords)) then + LB(1:3) = lbound(SrcBladeShapeData%AirfoilCoords) + UB(1:3) = ubound(SrcBladeShapeData%AirfoilCoords) + if (.not. allocated(DstBladeShapeData%AirfoilCoords)) then + allocate(DstBladeShapeData%AirfoilCoords(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladeShapeData%AirfoilCoords.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladeShapeData%AirfoilCoords = SrcBladeShapeData%AirfoilCoords + end if +end subroutine + +subroutine AD_DestroyBladeShape(BladeShapeData, ErrStat, ErrMsg) + type(AD_BladeShape), intent(inout) :: BladeShapeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD_DestroyBladeShape' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(BladeShapeData%AirfoilCoords)) then + deallocate(BladeShapeData%AirfoilCoords) + end if +end subroutine + +subroutine AD_PackBladeShape(RF, Indata) + type(RegFile), intent(inout) :: RF + type(AD_BladeShape), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_PackBladeShape' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%AirfoilCoords) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AD_UnPackBladeShape(RF, OutData) + type(RegFile), intent(inout) :: RF + type(AD_BladeShape), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_UnPackBladeShape' + integer(B4Ki) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%AirfoilCoords); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AD_CopyRotInitOutputType(SrcRotInitOutputTypeData, DstRotInitOutputTypeData, CtrlCode, ErrStat, ErrMsg) + type(RotInitOutputType), intent(in) :: SrcRotInitOutputTypeData + type(RotInitOutputType), intent(inout) :: DstRotInitOutputTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_CopyRotInitOutputType' + ErrStat = ErrID_None + ErrMsg = '' + DstRotInitOutputTypeData%AirDens = SrcRotInitOutputTypeData%AirDens + if (allocated(SrcRotInitOutputTypeData%WriteOutputHdr)) then + LB(1:1) = lbound(SrcRotInitOutputTypeData%WriteOutputHdr) + UB(1:1) = ubound(SrcRotInitOutputTypeData%WriteOutputHdr) + if (.not. allocated(DstRotInitOutputTypeData%WriteOutputHdr)) then + allocate(DstRotInitOutputTypeData%WriteOutputHdr(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotInitOutputTypeData%WriteOutputHdr.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotInitOutputTypeData%WriteOutputHdr = SrcRotInitOutputTypeData%WriteOutputHdr + end if + if (allocated(SrcRotInitOutputTypeData%WriteOutputUnt)) then + LB(1:1) = lbound(SrcRotInitOutputTypeData%WriteOutputUnt) + UB(1:1) = ubound(SrcRotInitOutputTypeData%WriteOutputUnt) + if (.not. allocated(DstRotInitOutputTypeData%WriteOutputUnt)) then + allocate(DstRotInitOutputTypeData%WriteOutputUnt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotInitOutputTypeData%WriteOutputUnt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotInitOutputTypeData%WriteOutputUnt = SrcRotInitOutputTypeData%WriteOutputUnt + end if + if (allocated(SrcRotInitOutputTypeData%BladeShape)) then + LB(1:1) = lbound(SrcRotInitOutputTypeData%BladeShape) + UB(1:1) = ubound(SrcRotInitOutputTypeData%BladeShape) + if (.not. allocated(DstRotInitOutputTypeData%BladeShape)) then + allocate(DstRotInitOutputTypeData%BladeShape(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotInitOutputTypeData%BladeShape.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AD_CopyBladeShape(SrcRotInitOutputTypeData%BladeShape(i1), DstRotInitOutputTypeData%BladeShape(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcRotInitOutputTypeData%LinNames_y)) then + LB(1:1) = lbound(SrcRotInitOutputTypeData%LinNames_y) + UB(1:1) = ubound(SrcRotInitOutputTypeData%LinNames_y) + if (.not. allocated(DstRotInitOutputTypeData%LinNames_y)) then + allocate(DstRotInitOutputTypeData%LinNames_y(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotInitOutputTypeData%LinNames_y.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotInitOutputTypeData%LinNames_y = SrcRotInitOutputTypeData%LinNames_y + end if + if (allocated(SrcRotInitOutputTypeData%LinNames_x)) then + LB(1:1) = lbound(SrcRotInitOutputTypeData%LinNames_x) + UB(1:1) = ubound(SrcRotInitOutputTypeData%LinNames_x) + if (.not. allocated(DstRotInitOutputTypeData%LinNames_x)) then + allocate(DstRotInitOutputTypeData%LinNames_x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotInitOutputTypeData%LinNames_x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotInitOutputTypeData%LinNames_x = SrcRotInitOutputTypeData%LinNames_x + end if + if (allocated(SrcRotInitOutputTypeData%LinNames_u)) then + LB(1:1) = lbound(SrcRotInitOutputTypeData%LinNames_u) + UB(1:1) = ubound(SrcRotInitOutputTypeData%LinNames_u) + if (.not. allocated(DstRotInitOutputTypeData%LinNames_u)) then + allocate(DstRotInitOutputTypeData%LinNames_u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotInitOutputTypeData%LinNames_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotInitOutputTypeData%LinNames_u = SrcRotInitOutputTypeData%LinNames_u + end if + if (allocated(SrcRotInitOutputTypeData%RotFrame_y)) then + LB(1:1) = lbound(SrcRotInitOutputTypeData%RotFrame_y) + UB(1:1) = ubound(SrcRotInitOutputTypeData%RotFrame_y) + if (.not. allocated(DstRotInitOutputTypeData%RotFrame_y)) then + allocate(DstRotInitOutputTypeData%RotFrame_y(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotInitOutputTypeData%RotFrame_y.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotInitOutputTypeData%RotFrame_y = SrcRotInitOutputTypeData%RotFrame_y + end if + if (allocated(SrcRotInitOutputTypeData%RotFrame_x)) then + LB(1:1) = lbound(SrcRotInitOutputTypeData%RotFrame_x) + UB(1:1) = ubound(SrcRotInitOutputTypeData%RotFrame_x) + if (.not. allocated(DstRotInitOutputTypeData%RotFrame_x)) then + allocate(DstRotInitOutputTypeData%RotFrame_x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotInitOutputTypeData%RotFrame_x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotInitOutputTypeData%RotFrame_x = SrcRotInitOutputTypeData%RotFrame_x + end if + if (allocated(SrcRotInitOutputTypeData%RotFrame_u)) then + LB(1:1) = lbound(SrcRotInitOutputTypeData%RotFrame_u) + UB(1:1) = ubound(SrcRotInitOutputTypeData%RotFrame_u) + if (.not. allocated(DstRotInitOutputTypeData%RotFrame_u)) then + allocate(DstRotInitOutputTypeData%RotFrame_u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotInitOutputTypeData%RotFrame_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotInitOutputTypeData%RotFrame_u = SrcRotInitOutputTypeData%RotFrame_u + end if + if (allocated(SrcRotInitOutputTypeData%IsLoad_u)) then + LB(1:1) = lbound(SrcRotInitOutputTypeData%IsLoad_u) + UB(1:1) = ubound(SrcRotInitOutputTypeData%IsLoad_u) + if (.not. allocated(DstRotInitOutputTypeData%IsLoad_u)) then + allocate(DstRotInitOutputTypeData%IsLoad_u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotInitOutputTypeData%IsLoad_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotInitOutputTypeData%IsLoad_u = SrcRotInitOutputTypeData%IsLoad_u + end if + if (allocated(SrcRotInitOutputTypeData%BladeProps)) then + LB(1:1) = lbound(SrcRotInitOutputTypeData%BladeProps) + UB(1:1) = ubound(SrcRotInitOutputTypeData%BladeProps) + if (.not. allocated(DstRotInitOutputTypeData%BladeProps)) then + allocate(DstRotInitOutputTypeData%BladeProps(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotInitOutputTypeData%BladeProps.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AD_CopyBladePropsType(SrcRotInitOutputTypeData%BladeProps(i1), DstRotInitOutputTypeData%BladeProps(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcRotInitOutputTypeData%DerivOrder_x)) then + LB(1:1) = lbound(SrcRotInitOutputTypeData%DerivOrder_x) + UB(1:1) = ubound(SrcRotInitOutputTypeData%DerivOrder_x) + if (.not. allocated(DstRotInitOutputTypeData%DerivOrder_x)) then + allocate(DstRotInitOutputTypeData%DerivOrder_x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotInitOutputTypeData%DerivOrder_x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotInitOutputTypeData%DerivOrder_x = SrcRotInitOutputTypeData%DerivOrder_x + end if + if (allocated(SrcRotInitOutputTypeData%TwrElev)) then + LB(1:1) = lbound(SrcRotInitOutputTypeData%TwrElev) + UB(1:1) = ubound(SrcRotInitOutputTypeData%TwrElev) + if (.not. allocated(DstRotInitOutputTypeData%TwrElev)) then + allocate(DstRotInitOutputTypeData%TwrElev(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotInitOutputTypeData%TwrElev.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotInitOutputTypeData%TwrElev = SrcRotInitOutputTypeData%TwrElev + end if + if (allocated(SrcRotInitOutputTypeData%TwrDiam)) then + LB(1:1) = lbound(SrcRotInitOutputTypeData%TwrDiam) + UB(1:1) = ubound(SrcRotInitOutputTypeData%TwrDiam) + if (.not. allocated(DstRotInitOutputTypeData%TwrDiam)) then + allocate(DstRotInitOutputTypeData%TwrDiam(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotInitOutputTypeData%TwrDiam.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotInitOutputTypeData%TwrDiam = SrcRotInitOutputTypeData%TwrDiam + end if +end subroutine + +subroutine AD_DestroyRotInitOutputType(RotInitOutputTypeData, ErrStat, ErrMsg) + type(RotInitOutputType), intent(inout) :: RotInitOutputTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_DestroyRotInitOutputType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(RotInitOutputTypeData%WriteOutputHdr)) then + deallocate(RotInitOutputTypeData%WriteOutputHdr) + end if + if (allocated(RotInitOutputTypeData%WriteOutputUnt)) then + deallocate(RotInitOutputTypeData%WriteOutputUnt) + end if + if (allocated(RotInitOutputTypeData%BladeShape)) then + LB(1:1) = lbound(RotInitOutputTypeData%BladeShape) + UB(1:1) = ubound(RotInitOutputTypeData%BladeShape) + do i1 = LB(1), UB(1) + call AD_DestroyBladeShape(RotInitOutputTypeData%BladeShape(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(RotInitOutputTypeData%BladeShape) + end if + if (allocated(RotInitOutputTypeData%LinNames_y)) then + deallocate(RotInitOutputTypeData%LinNames_y) + end if + if (allocated(RotInitOutputTypeData%LinNames_x)) then + deallocate(RotInitOutputTypeData%LinNames_x) + end if + if (allocated(RotInitOutputTypeData%LinNames_u)) then + deallocate(RotInitOutputTypeData%LinNames_u) + end if + if (allocated(RotInitOutputTypeData%RotFrame_y)) then + deallocate(RotInitOutputTypeData%RotFrame_y) + end if + if (allocated(RotInitOutputTypeData%RotFrame_x)) then + deallocate(RotInitOutputTypeData%RotFrame_x) + end if + if (allocated(RotInitOutputTypeData%RotFrame_u)) then + deallocate(RotInitOutputTypeData%RotFrame_u) + end if + if (allocated(RotInitOutputTypeData%IsLoad_u)) then + deallocate(RotInitOutputTypeData%IsLoad_u) + end if + if (allocated(RotInitOutputTypeData%BladeProps)) then + LB(1:1) = lbound(RotInitOutputTypeData%BladeProps) + UB(1:1) = ubound(RotInitOutputTypeData%BladeProps) + do i1 = LB(1), UB(1) + call AD_DestroyBladePropsType(RotInitOutputTypeData%BladeProps(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(RotInitOutputTypeData%BladeProps) + end if + if (allocated(RotInitOutputTypeData%DerivOrder_x)) then + deallocate(RotInitOutputTypeData%DerivOrder_x) + end if + if (allocated(RotInitOutputTypeData%TwrElev)) then + deallocate(RotInitOutputTypeData%TwrElev) + end if + if (allocated(RotInitOutputTypeData%TwrDiam)) then + deallocate(RotInitOutputTypeData%TwrDiam) + end if +end subroutine + +subroutine AD_PackRotInitOutputType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(RotInitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_PackRotInitOutputType' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%AirDens) + call RegPackAlloc(RF, InData%WriteOutputHdr) + call RegPackAlloc(RF, InData%WriteOutputUnt) + call RegPack(RF, allocated(InData%BladeShape)) + if (allocated(InData%BladeShape)) then + call RegPackBounds(RF, 1, lbound(InData%BladeShape), ubound(InData%BladeShape)) + LB(1:1) = lbound(InData%BladeShape) + UB(1:1) = ubound(InData%BladeShape) + do i1 = LB(1), UB(1) + call AD_PackBladeShape(RF, InData%BladeShape(i1)) + end do + end if + call RegPackAlloc(RF, InData%LinNames_y) + call RegPackAlloc(RF, InData%LinNames_x) + call RegPackAlloc(RF, InData%LinNames_u) + call RegPackAlloc(RF, InData%RotFrame_y) + call RegPackAlloc(RF, InData%RotFrame_x) + call RegPackAlloc(RF, InData%RotFrame_u) + call RegPackAlloc(RF, InData%IsLoad_u) + call RegPack(RF, allocated(InData%BladeProps)) + if (allocated(InData%BladeProps)) then + call RegPackBounds(RF, 1, lbound(InData%BladeProps), ubound(InData%BladeProps)) + LB(1:1) = lbound(InData%BladeProps) + UB(1:1) = ubound(InData%BladeProps) + do i1 = LB(1), UB(1) + call AD_PackBladePropsType(RF, InData%BladeProps(i1)) + end do + end if + call RegPackAlloc(RF, InData%DerivOrder_x) + call RegPackAlloc(RF, InData%TwrElev) + call RegPackAlloc(RF, InData%TwrDiam) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AD_UnPackRotInitOutputType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(RotInitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_UnPackRotInitOutputType' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%AirDens); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WriteOutputHdr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WriteOutputUnt); if (RegCheckErr(RF, RoutineName)) return + if (allocated(OutData%BladeShape)) deallocate(OutData%BladeShape) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%BladeShape(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeShape.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AD_UnpackBladeShape(RF, OutData%BladeShape(i1)) ! BladeShape + end do + end if + call RegUnpackAlloc(RF, OutData%LinNames_y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LinNames_x); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LinNames_u); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%RotFrame_y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%RotFrame_x); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%RotFrame_u); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%IsLoad_u); if (RegCheckErr(RF, RoutineName)) return + if (allocated(OutData%BladeProps)) deallocate(OutData%BladeProps) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%BladeProps(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeProps.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AD_UnpackBladePropsType(RF, OutData%BladeProps(i1)) ! BladeProps + end do + end if + call RegUnpackAlloc(RF, OutData%DerivOrder_x); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TwrElev); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TwrDiam); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) + type(AD_InitOutputType), intent(in) :: SrcInitOutputData + type(AD_InitOutputType), intent(inout) :: DstInitOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_CopyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcInitOutputData%rotors)) then + LB(1:1) = lbound(SrcInitOutputData%rotors) + UB(1:1) = ubound(SrcInitOutputData%rotors) + if (.not. allocated(DstInitOutputData%rotors)) then + allocate(DstInitOutputData%rotors(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%rotors.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AD_CopyRotInitOutputType(SrcInitOutputData%rotors(i1), DstInitOutputData%rotors(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call NWTC_Library_CopyProgDesc(SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstInitOutputData%nNodesVel = SrcInitOutputData%nNodesVel +end subroutine + +subroutine AD_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(AD_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_DestroyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InitOutputData%rotors)) then + LB(1:1) = lbound(InitOutputData%rotors) + UB(1:1) = ubound(InitOutputData%rotors) + do i1 = LB(1), UB(1) + call AD_DestroyRotInitOutputType(InitOutputData%rotors(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InitOutputData%rotors) + end if + call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine AD_PackInitOutput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(AD_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_PackInitOutput' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%rotors)) + if (allocated(InData%rotors)) then + call RegPackBounds(RF, 1, lbound(InData%rotors), ubound(InData%rotors)) + LB(1:1) = lbound(InData%rotors) + UB(1:1) = ubound(InData%rotors) + do i1 = LB(1), UB(1) + call AD_PackRotInitOutputType(RF, InData%rotors(i1)) + end do + end if + call NWTC_Library_PackProgDesc(RF, InData%Ver) + call RegPack(RF, InData%nNodesVel) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AD_UnPackInitOutput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(AD_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_UnPackInitOutput' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + if (allocated(OutData%rotors)) deallocate(OutData%rotors) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%rotors(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotors.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AD_UnpackRotInitOutputType(RF, OutData%rotors(i1)) ! rotors + end do + end if + call NWTC_Library_UnpackProgDesc(RF, OutData%Ver) ! Ver + call RegUnpack(RF, OutData%nNodesVel); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AD_CopyRotInputFile(SrcRotInputFileData, DstRotInputFileData, CtrlCode, ErrStat, ErrMsg) + type(RotInputFile), intent(in) :: SrcRotInputFileData + type(RotInputFile), intent(inout) :: DstRotInputFileData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_CopyRotInputFile' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcRotInputFileData%BladeProps)) then + LB(1:1) = lbound(SrcRotInputFileData%BladeProps) + UB(1:1) = ubound(SrcRotInputFileData%BladeProps) + if (.not. allocated(DstRotInputFileData%BladeProps)) then + allocate(DstRotInputFileData%BladeProps(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotInputFileData%BladeProps.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AD_CopyBladePropsType(SrcRotInputFileData%BladeProps(i1), DstRotInputFileData%BladeProps(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + DstRotInputFileData%NumTwrNds = SrcRotInputFileData%NumTwrNds + if (allocated(SrcRotInputFileData%TwrElev)) then + LB(1:1) = lbound(SrcRotInputFileData%TwrElev) + UB(1:1) = ubound(SrcRotInputFileData%TwrElev) + if (.not. allocated(DstRotInputFileData%TwrElev)) then + allocate(DstRotInputFileData%TwrElev(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotInputFileData%TwrElev.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotInputFileData%TwrElev = SrcRotInputFileData%TwrElev + end if + if (allocated(SrcRotInputFileData%TwrDiam)) then + LB(1:1) = lbound(SrcRotInputFileData%TwrDiam) + UB(1:1) = ubound(SrcRotInputFileData%TwrDiam) + if (.not. allocated(DstRotInputFileData%TwrDiam)) then + allocate(DstRotInputFileData%TwrDiam(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotInputFileData%TwrDiam.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotInputFileData%TwrDiam = SrcRotInputFileData%TwrDiam + end if + if (allocated(SrcRotInputFileData%TwrCd)) then + LB(1:1) = lbound(SrcRotInputFileData%TwrCd) + UB(1:1) = ubound(SrcRotInputFileData%TwrCd) + if (.not. allocated(DstRotInputFileData%TwrCd)) then + allocate(DstRotInputFileData%TwrCd(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotInputFileData%TwrCd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotInputFileData%TwrCd = SrcRotInputFileData%TwrCd + end if + if (allocated(SrcRotInputFileData%TwrTI)) then + LB(1:1) = lbound(SrcRotInputFileData%TwrTI) + UB(1:1) = ubound(SrcRotInputFileData%TwrTI) + if (.not. allocated(DstRotInputFileData%TwrTI)) then + allocate(DstRotInputFileData%TwrTI(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotInputFileData%TwrTI.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotInputFileData%TwrTI = SrcRotInputFileData%TwrTI + end if + if (allocated(SrcRotInputFileData%TwrCb)) then + LB(1:1) = lbound(SrcRotInputFileData%TwrCb) + UB(1:1) = ubound(SrcRotInputFileData%TwrCb) + if (.not. allocated(DstRotInputFileData%TwrCb)) then + allocate(DstRotInputFileData%TwrCb(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotInputFileData%TwrCb.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotInputFileData%TwrCb = SrcRotInputFileData%TwrCb + end if + DstRotInputFileData%VolHub = SrcRotInputFileData%VolHub + DstRotInputFileData%HubCenBx = SrcRotInputFileData%HubCenBx + DstRotInputFileData%VolNac = SrcRotInputFileData%VolNac + DstRotInputFileData%NacCenB = SrcRotInputFileData%NacCenB + DstRotInputFileData%NacArea = SrcRotInputFileData%NacArea + DstRotInputFileData%NacCd = SrcRotInputFileData%NacCd + DstRotInputFileData%NacDragAC = SrcRotInputFileData%NacDragAC + DstRotInputFileData%TFinAero = SrcRotInputFileData%TFinAero + DstRotInputFileData%TFinFile = SrcRotInputFileData%TFinFile + call AD_CopyTFinInputFileType(SrcRotInputFileData%TFin, DstRotInputFileData%TFin, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine AD_DestroyRotInputFile(RotInputFileData, ErrStat, ErrMsg) + type(RotInputFile), intent(inout) :: RotInputFileData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_DestroyRotInputFile' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(RotInputFileData%BladeProps)) then + LB(1:1) = lbound(RotInputFileData%BladeProps) + UB(1:1) = ubound(RotInputFileData%BladeProps) + do i1 = LB(1), UB(1) + call AD_DestroyBladePropsType(RotInputFileData%BladeProps(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(RotInputFileData%BladeProps) + end if + if (allocated(RotInputFileData%TwrElev)) then + deallocate(RotInputFileData%TwrElev) + end if + if (allocated(RotInputFileData%TwrDiam)) then + deallocate(RotInputFileData%TwrDiam) + end if + if (allocated(RotInputFileData%TwrCd)) then + deallocate(RotInputFileData%TwrCd) + end if + if (allocated(RotInputFileData%TwrTI)) then + deallocate(RotInputFileData%TwrTI) + end if + if (allocated(RotInputFileData%TwrCb)) then + deallocate(RotInputFileData%TwrCb) + end if + call AD_DestroyTFinInputFileType(RotInputFileData%TFin, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine AD_PackRotInputFile(RF, Indata) + type(RegFile), intent(inout) :: RF + type(RotInputFile), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_PackRotInputFile' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%BladeProps)) + if (allocated(InData%BladeProps)) then + call RegPackBounds(RF, 1, lbound(InData%BladeProps), ubound(InData%BladeProps)) + LB(1:1) = lbound(InData%BladeProps) + UB(1:1) = ubound(InData%BladeProps) + do i1 = LB(1), UB(1) + call AD_PackBladePropsType(RF, InData%BladeProps(i1)) + end do + end if + call RegPack(RF, InData%NumTwrNds) + call RegPackAlloc(RF, InData%TwrElev) + call RegPackAlloc(RF, InData%TwrDiam) + call RegPackAlloc(RF, InData%TwrCd) + call RegPackAlloc(RF, InData%TwrTI) + call RegPackAlloc(RF, InData%TwrCb) + call RegPack(RF, InData%VolHub) + call RegPack(RF, InData%HubCenBx) + call RegPack(RF, InData%VolNac) + call RegPack(RF, InData%NacCenB) + call RegPack(RF, InData%NacArea) + call RegPack(RF, InData%NacCd) + call RegPack(RF, InData%NacDragAC) + call RegPack(RF, InData%TFinAero) + call RegPack(RF, InData%TFinFile) + call AD_PackTFinInputFileType(RF, InData%TFin) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AD_UnPackRotInputFile(RF, OutData) + type(RegFile), intent(inout) :: RF + type(RotInputFile), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_UnPackRotInputFile' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + if (allocated(OutData%BladeProps)) deallocate(OutData%BladeProps) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%BladeProps(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeProps.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AD_UnpackBladePropsType(RF, OutData%BladeProps(i1)) ! BladeProps + end do + end if + call RegUnpack(RF, OutData%NumTwrNds); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TwrElev); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TwrDiam); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TwrCd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TwrTI); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TwrCb); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VolHub); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HubCenBx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VolNac); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NacCenB); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NacArea); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NacCd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NacDragAC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFinAero); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFinFile); if (RegCheckErr(RF, RoutineName)) return + call AD_UnpackTFinInputFileType(RF, OutData%TFin) ! TFin +end subroutine + +subroutine AD_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg) + type(AD_InputFile), intent(in) :: SrcInputFileData + type(AD_InputFile), intent(inout) :: DstInputFileData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_CopyInputFile' + ErrStat = ErrID_None + ErrMsg = '' + DstInputFileData%Echo = SrcInputFileData%Echo + DstInputFileData%DTAero = SrcInputFileData%DTAero + DstInputFileData%Wake_Mod = SrcInputFileData%Wake_Mod + DstInputFileData%BEM_Mod = SrcInputFileData%BEM_Mod + DstInputFileData%TwrPotent = SrcInputFileData%TwrPotent + DstInputFileData%TwrShadow = SrcInputFileData%TwrShadow + DstInputFileData%TwrAero = SrcInputFileData%TwrAero + DstInputFileData%CavitCheck = SrcInputFileData%CavitCheck + DstInputFileData%Buoyancy = SrcInputFileData%Buoyancy + DstInputFileData%NacelleDrag = SrcInputFileData%NacelleDrag + DstInputFileData%CompAA = SrcInputFileData%CompAA + DstInputFileData%AA_InputFile = SrcInputFileData%AA_InputFile + if (allocated(SrcInputFileData%ADBlFile)) then + LB(1:1) = lbound(SrcInputFileData%ADBlFile) + UB(1:1) = ubound(SrcInputFileData%ADBlFile) + if (.not. allocated(DstInputFileData%ADBlFile)) then + allocate(DstInputFileData%ADBlFile(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%ADBlFile.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%ADBlFile = SrcInputFileData%ADBlFile + end if + DstInputFileData%AirDens = SrcInputFileData%AirDens + DstInputFileData%KinVisc = SrcInputFileData%KinVisc + DstInputFileData%Patm = SrcInputFileData%Patm + DstInputFileData%Pvap = SrcInputFileData%Pvap + DstInputFileData%SpdSound = SrcInputFileData%SpdSound + DstInputFileData%Skew_Mod = SrcInputFileData%Skew_Mod + DstInputFileData%SkewMomCorr = SrcInputFileData%SkewMomCorr + DstInputFileData%SkewRedistr_Mod = SrcInputFileData%SkewRedistr_Mod + DstInputFileData%SkewModFactor = SrcInputFileData%SkewModFactor + DstInputFileData%TipLoss = SrcInputFileData%TipLoss + DstInputFileData%HubLoss = SrcInputFileData%HubLoss + DstInputFileData%TanInd = SrcInputFileData%TanInd + DstInputFileData%AIDrag = SrcInputFileData%AIDrag + DstInputFileData%TIDrag = SrcInputFileData%TIDrag + DstInputFileData%IndToler = SrcInputFileData%IndToler + DstInputFileData%MaxIter = SrcInputFileData%MaxIter + DstInputFileData%SectAvg = SrcInputFileData%SectAvg + DstInputFileData%SA_Weighting = SrcInputFileData%SA_Weighting + DstInputFileData%SA_PsiBwd = SrcInputFileData%SA_PsiBwd + DstInputFileData%SA_PsiFwd = SrcInputFileData%SA_PsiFwd + DstInputFileData%SA_nPerSec = SrcInputFileData%SA_nPerSec + DstInputFileData%AoA34 = SrcInputFileData%AoA34 + call UA_CopyInitInput(SrcInputFileData%UA_Init, DstInputFileData%UA_Init, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstInputFileData%InCol_Alfa = SrcInputFileData%InCol_Alfa + DstInputFileData%InCol_Cl = SrcInputFileData%InCol_Cl + DstInputFileData%InCol_Cd = SrcInputFileData%InCol_Cd + DstInputFileData%InCol_Cm = SrcInputFileData%InCol_Cm + DstInputFileData%InCol_Cpmin = SrcInputFileData%InCol_Cpmin + DstInputFileData%AFTabMod = SrcInputFileData%AFTabMod + DstInputFileData%NumAFfiles = SrcInputFileData%NumAFfiles + DstInputFileData%FVWFileName = SrcInputFileData%FVWFileName + if (allocated(SrcInputFileData%AFNames)) then + LB(1:1) = lbound(SrcInputFileData%AFNames) + UB(1:1) = ubound(SrcInputFileData%AFNames) + if (.not. allocated(DstInputFileData%AFNames)) then + allocate(DstInputFileData%AFNames(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%AFNames.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%AFNames = SrcInputFileData%AFNames + end if + DstInputFileData%UseBlCm = SrcInputFileData%UseBlCm + DstInputFileData%SumPrint = SrcInputFileData%SumPrint + DstInputFileData%NBlOuts = SrcInputFileData%NBlOuts + DstInputFileData%BlOutNd = SrcInputFileData%BlOutNd + DstInputFileData%NTwOuts = SrcInputFileData%NTwOuts + DstInputFileData%TwOutNd = SrcInputFileData%TwOutNd + DstInputFileData%NumOuts = SrcInputFileData%NumOuts + if (allocated(SrcInputFileData%OutList)) then + LB(1:1) = lbound(SrcInputFileData%OutList) + UB(1:1) = ubound(SrcInputFileData%OutList) + if (.not. allocated(DstInputFileData%OutList)) then + allocate(DstInputFileData%OutList(LB(1):UB(1)), 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 + end if + DstInputFileData%tau1_const = SrcInputFileData%tau1_const + DstInputFileData%DBEMT_Mod = SrcInputFileData%DBEMT_Mod + DstInputFileData%BldNd_NumOuts = SrcInputFileData%BldNd_NumOuts + if (allocated(SrcInputFileData%BldNd_OutList)) then + LB(1:1) = lbound(SrcInputFileData%BldNd_OutList) + UB(1:1) = ubound(SrcInputFileData%BldNd_OutList) + if (.not. allocated(DstInputFileData%BldNd_OutList)) then + allocate(DstInputFileData%BldNd_OutList(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%BldNd_OutList.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%BldNd_OutList = SrcInputFileData%BldNd_OutList + end if + DstInputFileData%BldNd_BlOutNd_Str = SrcInputFileData%BldNd_BlOutNd_Str + DstInputFileData%BldNd_BladesOut = SrcInputFileData%BldNd_BladesOut + DstInputFileData%UAStartRad = SrcInputFileData%UAStartRad + DstInputFileData%UAEndRad = SrcInputFileData%UAEndRad + if (allocated(SrcInputFileData%rotors)) then + LB(1:1) = lbound(SrcInputFileData%rotors) + UB(1:1) = ubound(SrcInputFileData%rotors) + if (.not. allocated(DstInputFileData%rotors)) then + allocate(DstInputFileData%rotors(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%rotors.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AD_CopyRotInputFile(SrcInputFileData%rotors(i1), DstInputFileData%rotors(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if +end subroutine + +subroutine AD_DestroyInputFile(InputFileData, ErrStat, ErrMsg) + type(AD_InputFile), intent(inout) :: InputFileData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_DestroyInputFile' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InputFileData%ADBlFile)) then + deallocate(InputFileData%ADBlFile) + end if + call UA_DestroyInitInput(InputFileData%UA_Init, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(InputFileData%AFNames)) then + deallocate(InputFileData%AFNames) + end if + if (allocated(InputFileData%OutList)) then + deallocate(InputFileData%OutList) + end if + if (allocated(InputFileData%BldNd_OutList)) then + deallocate(InputFileData%BldNd_OutList) + end if + if (allocated(InputFileData%rotors)) then + LB(1:1) = lbound(InputFileData%rotors) + UB(1:1) = ubound(InputFileData%rotors) + do i1 = LB(1), UB(1) + call AD_DestroyRotInputFile(InputFileData%rotors(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InputFileData%rotors) + end if +end subroutine + +subroutine AD_PackInputFile(RF, Indata) + type(RegFile), intent(inout) :: RF + type(AD_InputFile), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_PackInputFile' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%Echo) + call RegPack(RF, InData%DTAero) + call RegPack(RF, InData%Wake_Mod) + call RegPack(RF, InData%BEM_Mod) + call RegPack(RF, InData%TwrPotent) + call RegPack(RF, InData%TwrShadow) + call RegPack(RF, InData%TwrAero) + call RegPack(RF, InData%CavitCheck) + call RegPack(RF, InData%Buoyancy) + call RegPack(RF, InData%NacelleDrag) + call RegPack(RF, InData%CompAA) + call RegPack(RF, InData%AA_InputFile) + call RegPackAlloc(RF, InData%ADBlFile) + call RegPack(RF, InData%AirDens) + call RegPack(RF, InData%KinVisc) + call RegPack(RF, InData%Patm) + call RegPack(RF, InData%Pvap) + call RegPack(RF, InData%SpdSound) + call RegPack(RF, InData%Skew_Mod) + call RegPack(RF, InData%SkewMomCorr) + call RegPack(RF, InData%SkewRedistr_Mod) + call RegPack(RF, InData%SkewModFactor) + call RegPack(RF, InData%TipLoss) + call RegPack(RF, InData%HubLoss) + call RegPack(RF, InData%TanInd) + call RegPack(RF, InData%AIDrag) + call RegPack(RF, InData%TIDrag) + call RegPack(RF, InData%IndToler) + call RegPack(RF, InData%MaxIter) + call RegPack(RF, InData%SectAvg) + call RegPack(RF, InData%SA_Weighting) + call RegPack(RF, InData%SA_PsiBwd) + call RegPack(RF, InData%SA_PsiFwd) + call RegPack(RF, InData%SA_nPerSec) + call RegPack(RF, InData%AoA34) + call UA_PackInitInput(RF, InData%UA_Init) + call RegPack(RF, InData%InCol_Alfa) + call RegPack(RF, InData%InCol_Cl) + call RegPack(RF, InData%InCol_Cd) + call RegPack(RF, InData%InCol_Cm) + call RegPack(RF, InData%InCol_Cpmin) + call RegPack(RF, InData%AFTabMod) + call RegPack(RF, InData%NumAFfiles) + call RegPack(RF, InData%FVWFileName) + call RegPackAlloc(RF, InData%AFNames) + call RegPack(RF, InData%UseBlCm) + call RegPack(RF, InData%SumPrint) + call RegPack(RF, InData%NBlOuts) + call RegPack(RF, InData%BlOutNd) + call RegPack(RF, InData%NTwOuts) + call RegPack(RF, InData%TwOutNd) + call RegPack(RF, InData%NumOuts) + call RegPackAlloc(RF, InData%OutList) + call RegPack(RF, InData%tau1_const) + call RegPack(RF, InData%DBEMT_Mod) + call RegPack(RF, InData%BldNd_NumOuts) + call RegPackAlloc(RF, InData%BldNd_OutList) + call RegPack(RF, InData%BldNd_BlOutNd_Str) + call RegPack(RF, InData%BldNd_BladesOut) + call RegPack(RF, InData%UAStartRad) + call RegPack(RF, InData%UAEndRad) + call RegPack(RF, allocated(InData%rotors)) + if (allocated(InData%rotors)) then + call RegPackBounds(RF, 1, lbound(InData%rotors), ubound(InData%rotors)) + LB(1:1) = lbound(InData%rotors) + UB(1:1) = ubound(InData%rotors) + do i1 = LB(1), UB(1) + call AD_PackRotInputFile(RF, InData%rotors(i1)) + end do + end if + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AD_UnPackInputFile(RF, OutData) + type(RegFile), intent(inout) :: RF + type(AD_InputFile), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_UnPackInputFile' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%Echo); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DTAero); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Wake_Mod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BEM_Mod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TwrPotent); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TwrShadow); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TwrAero); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CavitCheck); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Buoyancy); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NacelleDrag); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CompAA); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AA_InputFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ADBlFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AirDens); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%KinVisc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Patm); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Pvap); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SpdSound); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Skew_Mod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SkewMomCorr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SkewRedistr_Mod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SkewModFactor); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TipLoss); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HubLoss); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TanInd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AIDrag); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TIDrag); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%IndToler); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MaxIter); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SectAvg); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SA_Weighting); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SA_PsiBwd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SA_PsiFwd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SA_nPerSec); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AoA34); if (RegCheckErr(RF, RoutineName)) return + call UA_UnpackInitInput(RF, OutData%UA_Init) ! UA_Init + call RegUnpack(RF, OutData%InCol_Alfa); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%InCol_Cl); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%InCol_Cd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%InCol_Cm); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%InCol_Cpmin); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AFTabMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumAFfiles); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FVWFileName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AFNames); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UseBlCm); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SumPrint); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NBlOuts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BlOutNd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NTwOuts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TwOutNd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumOuts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%OutList); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%tau1_const); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DBEMT_Mod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BldNd_NumOuts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BldNd_OutList); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BldNd_BlOutNd_Str); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BldNd_BladesOut); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UAStartRad); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UAEndRad); if (RegCheckErr(RF, RoutineName)) return + if (allocated(OutData%rotors)) deallocate(OutData%rotors) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%rotors(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotors.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AD_UnpackRotInputFile(RF, OutData%rotors(i1)) ! rotors + end do + end if +end subroutine + +subroutine AD_CopyRotContinuousStateType(SrcRotContinuousStateTypeData, DstRotContinuousStateTypeData, CtrlCode, ErrStat, ErrMsg) + type(RotContinuousStateType), intent(in) :: SrcRotContinuousStateTypeData + type(RotContinuousStateType), intent(inout) :: DstRotContinuousStateTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_CopyRotContinuousStateType' + ErrStat = ErrID_None + ErrMsg = '' + call BEMT_CopyContState(SrcRotContinuousStateTypeData%BEMT, DstRotContinuousStateTypeData%BEMT, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AA_CopyContState(SrcRotContinuousStateTypeData%AA, DstRotContinuousStateTypeData%AA, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine AD_DestroyRotContinuousStateType(RotContinuousStateTypeData, ErrStat, ErrMsg) + type(RotContinuousStateType), intent(inout) :: RotContinuousStateTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_DestroyRotContinuousStateType' + ErrStat = ErrID_None + ErrMsg = '' + call BEMT_DestroyContState(RotContinuousStateTypeData%BEMT, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AA_DestroyContState(RotContinuousStateTypeData%AA, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine AD_PackRotContinuousStateType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(RotContinuousStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_PackRotContinuousStateType' + if (RF%ErrStat >= AbortErrLev) return + call BEMT_PackContState(RF, InData%BEMT) + call AA_PackContState(RF, InData%AA) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AD_UnPackRotContinuousStateType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(RotContinuousStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_UnPackRotContinuousStateType' + if (RF%ErrStat /= ErrID_None) return + call BEMT_UnpackContState(RF, OutData%BEMT) ! BEMT + call AA_UnpackContState(RF, OutData%AA) ! AA +end subroutine + +subroutine AD_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) + type(AD_ContinuousStateType), intent(in) :: SrcContStateData + type(AD_ContinuousStateType), intent(inout) :: DstContStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_CopyContState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcContStateData%rotors)) then + LB(1:1) = lbound(SrcContStateData%rotors) + UB(1:1) = ubound(SrcContStateData%rotors) + if (.not. allocated(DstContStateData%rotors)) then + allocate(DstContStateData%rotors(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%rotors.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AD_CopyRotContinuousStateType(SrcContStateData%rotors(i1), DstContStateData%rotors(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call FVW_CopyContState(SrcContStateData%FVW, DstContStateData%FVW, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine AD_DestroyContState(ContStateData, ErrStat, ErrMsg) + type(AD_ContinuousStateType), intent(inout) :: ContStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_DestroyContState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ContStateData%rotors)) then + LB(1:1) = lbound(ContStateData%rotors) + UB(1:1) = ubound(ContStateData%rotors) + do i1 = LB(1), UB(1) + call AD_DestroyRotContinuousStateType(ContStateData%rotors(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ContStateData%rotors) + end if + call FVW_DestroyContState(ContStateData%FVW, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine AD_PackContState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(AD_ContinuousStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_PackContState' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%rotors)) + if (allocated(InData%rotors)) then + call RegPackBounds(RF, 1, lbound(InData%rotors), ubound(InData%rotors)) + LB(1:1) = lbound(InData%rotors) + UB(1:1) = ubound(InData%rotors) + do i1 = LB(1), UB(1) + call AD_PackRotContinuousStateType(RF, InData%rotors(i1)) + end do + end if + call FVW_PackContState(RF, InData%FVW) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AD_UnPackContState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(AD_ContinuousStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_UnPackContState' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + if (allocated(OutData%rotors)) deallocate(OutData%rotors) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%rotors(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotors.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AD_UnpackRotContinuousStateType(RF, OutData%rotors(i1)) ! rotors + end do + end if + call FVW_UnpackContState(RF, OutData%FVW) ! FVW +end subroutine + +subroutine AD_CopyRotDiscreteStateType(SrcRotDiscreteStateTypeData, DstRotDiscreteStateTypeData, CtrlCode, ErrStat, ErrMsg) + type(RotDiscreteStateType), intent(in) :: SrcRotDiscreteStateTypeData + type(RotDiscreteStateType), intent(inout) :: DstRotDiscreteStateTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_CopyRotDiscreteStateType' + ErrStat = ErrID_None + ErrMsg = '' + call BEMT_CopyDiscState(SrcRotDiscreteStateTypeData%BEMT, DstRotDiscreteStateTypeData%BEMT, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AA_CopyDiscState(SrcRotDiscreteStateTypeData%AA, DstRotDiscreteStateTypeData%AA, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine AD_DestroyRotDiscreteStateType(RotDiscreteStateTypeData, ErrStat, ErrMsg) + type(RotDiscreteStateType), intent(inout) :: RotDiscreteStateTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_DestroyRotDiscreteStateType' + ErrStat = ErrID_None + ErrMsg = '' + call BEMT_DestroyDiscState(RotDiscreteStateTypeData%BEMT, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AA_DestroyDiscState(RotDiscreteStateTypeData%AA, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine AD_PackRotDiscreteStateType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(RotDiscreteStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_PackRotDiscreteStateType' + if (RF%ErrStat >= AbortErrLev) return + call BEMT_PackDiscState(RF, InData%BEMT) + call AA_PackDiscState(RF, InData%AA) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AD_UnPackRotDiscreteStateType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(RotDiscreteStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_UnPackRotDiscreteStateType' + if (RF%ErrStat /= ErrID_None) return + call BEMT_UnpackDiscState(RF, OutData%BEMT) ! BEMT + call AA_UnpackDiscState(RF, OutData%AA) ! AA +end subroutine + +subroutine AD_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) + type(AD_DiscreteStateType), intent(in) :: SrcDiscStateData + type(AD_DiscreteStateType), intent(inout) :: DstDiscStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_CopyDiscState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcDiscStateData%rotors)) then + LB(1:1) = lbound(SrcDiscStateData%rotors) + UB(1:1) = ubound(SrcDiscStateData%rotors) + if (.not. allocated(DstDiscStateData%rotors)) then + allocate(DstDiscStateData%rotors(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%rotors.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AD_CopyRotDiscreteStateType(SrcDiscStateData%rotors(i1), DstDiscStateData%rotors(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call FVW_CopyDiscState(SrcDiscStateData%FVW, DstDiscStateData%FVW, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine AD_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) + type(AD_DiscreteStateType), intent(inout) :: DiscStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_DestroyDiscState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(DiscStateData%rotors)) then + LB(1:1) = lbound(DiscStateData%rotors) + UB(1:1) = ubound(DiscStateData%rotors) + do i1 = LB(1), UB(1) + call AD_DestroyRotDiscreteStateType(DiscStateData%rotors(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(DiscStateData%rotors) + end if + call FVW_DestroyDiscState(DiscStateData%FVW, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine AD_PackDiscState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(AD_DiscreteStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_PackDiscState' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%rotors)) + if (allocated(InData%rotors)) then + call RegPackBounds(RF, 1, lbound(InData%rotors), ubound(InData%rotors)) + LB(1:1) = lbound(InData%rotors) + UB(1:1) = ubound(InData%rotors) + do i1 = LB(1), UB(1) + call AD_PackRotDiscreteStateType(RF, InData%rotors(i1)) + end do + end if + call FVW_PackDiscState(RF, InData%FVW) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AD_UnPackDiscState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(AD_DiscreteStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_UnPackDiscState' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + if (allocated(OutData%rotors)) deallocate(OutData%rotors) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%rotors(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotors.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AD_UnpackRotDiscreteStateType(RF, OutData%rotors(i1)) ! rotors + end do + end if + call FVW_UnpackDiscState(RF, OutData%FVW) ! FVW +end subroutine + +subroutine AD_CopyRotConstraintStateType(SrcRotConstraintStateTypeData, DstRotConstraintStateTypeData, CtrlCode, ErrStat, ErrMsg) + type(RotConstraintStateType), intent(in) :: SrcRotConstraintStateTypeData + type(RotConstraintStateType), intent(inout) :: DstRotConstraintStateTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_CopyRotConstraintStateType' + ErrStat = ErrID_None + ErrMsg = '' + call BEMT_CopyConstrState(SrcRotConstraintStateTypeData%BEMT, DstRotConstraintStateTypeData%BEMT, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AA_CopyConstrState(SrcRotConstraintStateTypeData%AA, DstRotConstraintStateTypeData%AA, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine AD_DestroyRotConstraintStateType(RotConstraintStateTypeData, ErrStat, ErrMsg) + type(RotConstraintStateType), intent(inout) :: RotConstraintStateTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_DestroyRotConstraintStateType' + ErrStat = ErrID_None + ErrMsg = '' + call BEMT_DestroyConstrState(RotConstraintStateTypeData%BEMT, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AA_DestroyConstrState(RotConstraintStateTypeData%AA, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine AD_PackRotConstraintStateType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(RotConstraintStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_PackRotConstraintStateType' + if (RF%ErrStat >= AbortErrLev) return + call BEMT_PackConstrState(RF, InData%BEMT) + call AA_PackConstrState(RF, InData%AA) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AD_UnPackRotConstraintStateType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(RotConstraintStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_UnPackRotConstraintStateType' + if (RF%ErrStat /= ErrID_None) return + call BEMT_UnpackConstrState(RF, OutData%BEMT) ! BEMT + call AA_UnpackConstrState(RF, OutData%AA) ! AA +end subroutine + +subroutine AD_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) + type(AD_ConstraintStateType), intent(in) :: SrcConstrStateData + type(AD_ConstraintStateType), intent(inout) :: DstConstrStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_CopyConstrState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcConstrStateData%rotors)) then + LB(1:1) = lbound(SrcConstrStateData%rotors) + UB(1:1) = ubound(SrcConstrStateData%rotors) + if (.not. allocated(DstConstrStateData%rotors)) then + allocate(DstConstrStateData%rotors(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstConstrStateData%rotors.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AD_CopyRotConstraintStateType(SrcConstrStateData%rotors(i1), DstConstrStateData%rotors(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call FVW_CopyConstrState(SrcConstrStateData%FVW, DstConstrStateData%FVW, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine AD_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) + type(AD_ConstraintStateType), intent(inout) :: ConstrStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_DestroyConstrState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ConstrStateData%rotors)) then + LB(1:1) = lbound(ConstrStateData%rotors) + UB(1:1) = ubound(ConstrStateData%rotors) + do i1 = LB(1), UB(1) + call AD_DestroyRotConstraintStateType(ConstrStateData%rotors(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ConstrStateData%rotors) + end if + call FVW_DestroyConstrState(ConstrStateData%FVW, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine AD_PackConstrState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(AD_ConstraintStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_PackConstrState' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%rotors)) + if (allocated(InData%rotors)) then + call RegPackBounds(RF, 1, lbound(InData%rotors), ubound(InData%rotors)) + LB(1:1) = lbound(InData%rotors) + UB(1:1) = ubound(InData%rotors) + do i1 = LB(1), UB(1) + call AD_PackRotConstraintStateType(RF, InData%rotors(i1)) + end do + end if + call FVW_PackConstrState(RF, InData%FVW) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AD_UnPackConstrState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(AD_ConstraintStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_UnPackConstrState' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + if (allocated(OutData%rotors)) deallocate(OutData%rotors) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%rotors(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotors.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AD_UnpackRotConstraintStateType(RF, OutData%rotors(i1)) ! rotors + end do + end if + call FVW_UnpackConstrState(RF, OutData%FVW) ! FVW +end subroutine + +subroutine AD_CopyRotOtherStateType(SrcRotOtherStateTypeData, DstRotOtherStateTypeData, CtrlCode, ErrStat, ErrMsg) + type(RotOtherStateType), intent(in) :: SrcRotOtherStateTypeData + type(RotOtherStateType), intent(inout) :: DstRotOtherStateTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_CopyRotOtherStateType' + ErrStat = ErrID_None + ErrMsg = '' + call BEMT_CopyOtherState(SrcRotOtherStateTypeData%BEMT, DstRotOtherStateTypeData%BEMT, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AA_CopyOtherState(SrcRotOtherStateTypeData%AA, DstRotOtherStateTypeData%AA, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine AD_DestroyRotOtherStateType(RotOtherStateTypeData, ErrStat, ErrMsg) + type(RotOtherStateType), intent(inout) :: RotOtherStateTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_DestroyRotOtherStateType' + ErrStat = ErrID_None + ErrMsg = '' + call BEMT_DestroyOtherState(RotOtherStateTypeData%BEMT, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AA_DestroyOtherState(RotOtherStateTypeData%AA, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine AD_PackRotOtherStateType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(RotOtherStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_PackRotOtherStateType' + if (RF%ErrStat >= AbortErrLev) return + call BEMT_PackOtherState(RF, InData%BEMT) + call AA_PackOtherState(RF, InData%AA) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AD_UnPackRotOtherStateType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(RotOtherStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_UnPackRotOtherStateType' + if (RF%ErrStat /= ErrID_None) return + call BEMT_UnpackOtherState(RF, OutData%BEMT) ! BEMT + call AA_UnpackOtherState(RF, OutData%AA) ! AA +end subroutine + +subroutine AD_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) + type(AD_OtherStateType), intent(in) :: SrcOtherStateData + type(AD_OtherStateType), intent(inout) :: DstOtherStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_CopyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcOtherStateData%rotors)) then + LB(1:1) = lbound(SrcOtherStateData%rotors) + UB(1:1) = ubound(SrcOtherStateData%rotors) + if (.not. allocated(DstOtherStateData%rotors)) then + allocate(DstOtherStateData%rotors(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%rotors.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AD_CopyRotOtherStateType(SrcOtherStateData%rotors(i1), DstOtherStateData%rotors(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call FVW_CopyOtherState(SrcOtherStateData%FVW, DstOtherStateData%FVW, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcOtherStateData%WakeLocationPoints)) then + LB(1:2) = lbound(SrcOtherStateData%WakeLocationPoints) + UB(1:2) = ubound(SrcOtherStateData%WakeLocationPoints) + if (.not. allocated(DstOtherStateData%WakeLocationPoints)) then + allocate(DstOtherStateData%WakeLocationPoints(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%WakeLocationPoints.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOtherStateData%WakeLocationPoints = SrcOtherStateData%WakeLocationPoints + end if +end subroutine + +subroutine AD_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) + type(AD_OtherStateType), intent(inout) :: OtherStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_DestroyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OtherStateData%rotors)) then + LB(1:1) = lbound(OtherStateData%rotors) + UB(1:1) = ubound(OtherStateData%rotors) + do i1 = LB(1), UB(1) + call AD_DestroyRotOtherStateType(OtherStateData%rotors(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(OtherStateData%rotors) + end if + call FVW_DestroyOtherState(OtherStateData%FVW, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(OtherStateData%WakeLocationPoints)) then + deallocate(OtherStateData%WakeLocationPoints) + end if +end subroutine + +subroutine AD_PackOtherState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(AD_OtherStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_PackOtherState' + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%rotors)) + if (allocated(InData%rotors)) then + call RegPackBounds(RF, 1, lbound(InData%rotors), ubound(InData%rotors)) + LB(1:1) = lbound(InData%rotors) + UB(1:1) = ubound(InData%rotors) + do i1 = LB(1), UB(1) + call AD_PackRotOtherStateType(RF, InData%rotors(i1)) + end do + end if + call FVW_PackOtherState(RF, InData%FVW) + call RegPackAlloc(RF, InData%WakeLocationPoints) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AD_UnPackOtherState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(AD_OtherStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_UnPackOtherState' + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + if (allocated(OutData%rotors)) deallocate(OutData%rotors) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%rotors(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotors.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AD_UnpackRotOtherStateType(RF, OutData%rotors(i1)) ! rotors + end do + end if + call FVW_UnpackOtherState(RF, OutData%FVW) ! FVW + call RegUnpackAlloc(RF, OutData%WakeLocationPoints); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, CtrlCode, ErrStat, ErrMsg) + type(RotMiscVarType), intent(inout) :: SrcRotMiscVarTypeData + type(RotMiscVarType), intent(inout) :: DstRotMiscVarTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2, i3, i4 + integer(B4Ki) :: LB(4), UB(4) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_CopyRotMiscVarType' + ErrStat = ErrID_None + ErrMsg = '' + call BEMT_CopyMisc(SrcRotMiscVarTypeData%BEMT, DstRotMiscVarTypeData%BEMT, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call BEMT_CopyOutput(SrcRotMiscVarTypeData%BEMT_y, DstRotMiscVarTypeData%BEMT_y, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + LB(1:1) = lbound(SrcRotMiscVarTypeData%BEMT_u) + UB(1:1) = ubound(SrcRotMiscVarTypeData%BEMT_u) + do i1 = LB(1), UB(1) + call BEMT_CopyInput(SrcRotMiscVarTypeData%BEMT_u(i1), DstRotMiscVarTypeData%BEMT_u(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + call AA_CopyMisc(SrcRotMiscVarTypeData%AA, DstRotMiscVarTypeData%AA, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AA_CopyOutput(SrcRotMiscVarTypeData%AA_y, DstRotMiscVarTypeData%AA_y, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AA_CopyInput(SrcRotMiscVarTypeData%AA_u, DstRotMiscVarTypeData%AA_u, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcRotMiscVarTypeData%DisturbedInflow)) then + LB(1:3) = lbound(SrcRotMiscVarTypeData%DisturbedInflow) + UB(1:3) = ubound(SrcRotMiscVarTypeData%DisturbedInflow) + if (.not. allocated(DstRotMiscVarTypeData%DisturbedInflow)) then + allocate(DstRotMiscVarTypeData%DisturbedInflow(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%DisturbedInflow.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%DisturbedInflow = SrcRotMiscVarTypeData%DisturbedInflow + end if + if (allocated(SrcRotMiscVarTypeData%SectAvgInflow)) then + LB(1:3) = lbound(SrcRotMiscVarTypeData%SectAvgInflow) + UB(1:3) = ubound(SrcRotMiscVarTypeData%SectAvgInflow) + if (.not. allocated(DstRotMiscVarTypeData%SectAvgInflow)) then + allocate(DstRotMiscVarTypeData%SectAvgInflow(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%SectAvgInflow.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%SectAvgInflow = SrcRotMiscVarTypeData%SectAvgInflow + end if + if (allocated(SrcRotMiscVarTypeData%orientationAnnulus)) then + LB(1:4) = lbound(SrcRotMiscVarTypeData%orientationAnnulus) + UB(1:4) = ubound(SrcRotMiscVarTypeData%orientationAnnulus) + if (.not. allocated(DstRotMiscVarTypeData%orientationAnnulus)) then + allocate(DstRotMiscVarTypeData%orientationAnnulus(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%orientationAnnulus.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%orientationAnnulus = SrcRotMiscVarTypeData%orientationAnnulus + end if + if (allocated(SrcRotMiscVarTypeData%R_li)) then + LB(1:4) = lbound(SrcRotMiscVarTypeData%R_li) + UB(1:4) = ubound(SrcRotMiscVarTypeData%R_li) + if (.not. allocated(DstRotMiscVarTypeData%R_li)) then + allocate(DstRotMiscVarTypeData%R_li(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%R_li.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%R_li = SrcRotMiscVarTypeData%R_li + end if + if (allocated(SrcRotMiscVarTypeData%AllOuts)) then + LB(1:1) = lbound(SrcRotMiscVarTypeData%AllOuts) + UB(1:1) = ubound(SrcRotMiscVarTypeData%AllOuts) + if (.not. allocated(DstRotMiscVarTypeData%AllOuts)) then + allocate(DstRotMiscVarTypeData%AllOuts(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%AllOuts.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%AllOuts = SrcRotMiscVarTypeData%AllOuts + end if + if (allocated(SrcRotMiscVarTypeData%W_Twr)) then + LB(1:1) = lbound(SrcRotMiscVarTypeData%W_Twr) + UB(1:1) = ubound(SrcRotMiscVarTypeData%W_Twr) + if (.not. allocated(DstRotMiscVarTypeData%W_Twr)) then + allocate(DstRotMiscVarTypeData%W_Twr(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%W_Twr.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%W_Twr = SrcRotMiscVarTypeData%W_Twr + end if + if (allocated(SrcRotMiscVarTypeData%X_Twr)) then + LB(1:1) = lbound(SrcRotMiscVarTypeData%X_Twr) + UB(1:1) = ubound(SrcRotMiscVarTypeData%X_Twr) + if (.not. allocated(DstRotMiscVarTypeData%X_Twr)) then + allocate(DstRotMiscVarTypeData%X_Twr(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%X_Twr.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%X_Twr = SrcRotMiscVarTypeData%X_Twr + end if + if (allocated(SrcRotMiscVarTypeData%Y_Twr)) then + LB(1:1) = lbound(SrcRotMiscVarTypeData%Y_Twr) + UB(1:1) = ubound(SrcRotMiscVarTypeData%Y_Twr) + if (.not. allocated(DstRotMiscVarTypeData%Y_Twr)) then + allocate(DstRotMiscVarTypeData%Y_Twr(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%Y_Twr.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%Y_Twr = SrcRotMiscVarTypeData%Y_Twr + end if + if (allocated(SrcRotMiscVarTypeData%Cant)) then + LB(1:2) = lbound(SrcRotMiscVarTypeData%Cant) + UB(1:2) = ubound(SrcRotMiscVarTypeData%Cant) + if (.not. allocated(DstRotMiscVarTypeData%Cant)) then + allocate(DstRotMiscVarTypeData%Cant(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%Cant.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%Cant = SrcRotMiscVarTypeData%Cant + end if + if (allocated(SrcRotMiscVarTypeData%Toe)) then + LB(1:2) = lbound(SrcRotMiscVarTypeData%Toe) + UB(1:2) = ubound(SrcRotMiscVarTypeData%Toe) + if (.not. allocated(DstRotMiscVarTypeData%Toe)) then + allocate(DstRotMiscVarTypeData%Toe(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%Toe.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%Toe = SrcRotMiscVarTypeData%Toe + end if + if (allocated(SrcRotMiscVarTypeData%TwrClrnc)) then + LB(1:2) = lbound(SrcRotMiscVarTypeData%TwrClrnc) + UB(1:2) = ubound(SrcRotMiscVarTypeData%TwrClrnc) + if (.not. allocated(DstRotMiscVarTypeData%TwrClrnc)) then + allocate(DstRotMiscVarTypeData%TwrClrnc(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%TwrClrnc.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%TwrClrnc = SrcRotMiscVarTypeData%TwrClrnc + end if + if (allocated(SrcRotMiscVarTypeData%X)) then + LB(1:2) = lbound(SrcRotMiscVarTypeData%X) + UB(1:2) = ubound(SrcRotMiscVarTypeData%X) + if (.not. allocated(DstRotMiscVarTypeData%X)) then + allocate(DstRotMiscVarTypeData%X(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%X.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%X = SrcRotMiscVarTypeData%X + end if + if (allocated(SrcRotMiscVarTypeData%Y)) then + LB(1:2) = lbound(SrcRotMiscVarTypeData%Y) + UB(1:2) = ubound(SrcRotMiscVarTypeData%Y) + if (.not. allocated(DstRotMiscVarTypeData%Y)) then + allocate(DstRotMiscVarTypeData%Y(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%Y.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%Y = SrcRotMiscVarTypeData%Y + end if + if (allocated(SrcRotMiscVarTypeData%Z)) then + LB(1:2) = lbound(SrcRotMiscVarTypeData%Z) + UB(1:2) = ubound(SrcRotMiscVarTypeData%Z) + if (.not. allocated(DstRotMiscVarTypeData%Z)) then + allocate(DstRotMiscVarTypeData%Z(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%Z.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%Z = SrcRotMiscVarTypeData%Z + end if + if (allocated(SrcRotMiscVarTypeData%M)) then + LB(1:2) = lbound(SrcRotMiscVarTypeData%M) + UB(1:2) = ubound(SrcRotMiscVarTypeData%M) + if (.not. allocated(DstRotMiscVarTypeData%M)) then + allocate(DstRotMiscVarTypeData%M(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%M.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%M = SrcRotMiscVarTypeData%M + end if + if (allocated(SrcRotMiscVarTypeData%Mx)) then + LB(1:2) = lbound(SrcRotMiscVarTypeData%Mx) + UB(1:2) = ubound(SrcRotMiscVarTypeData%Mx) + if (.not. allocated(DstRotMiscVarTypeData%Mx)) then + allocate(DstRotMiscVarTypeData%Mx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%Mx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%Mx = SrcRotMiscVarTypeData%Mx + end if + if (allocated(SrcRotMiscVarTypeData%My)) then + LB(1:2) = lbound(SrcRotMiscVarTypeData%My) + UB(1:2) = ubound(SrcRotMiscVarTypeData%My) + if (.not. allocated(DstRotMiscVarTypeData%My)) then + allocate(DstRotMiscVarTypeData%My(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%My.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%My = SrcRotMiscVarTypeData%My + end if + if (allocated(SrcRotMiscVarTypeData%Mz)) then + LB(1:2) = lbound(SrcRotMiscVarTypeData%Mz) + UB(1:2) = ubound(SrcRotMiscVarTypeData%Mz) + if (.not. allocated(DstRotMiscVarTypeData%Mz)) then + allocate(DstRotMiscVarTypeData%Mz(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%Mz.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%Mz = SrcRotMiscVarTypeData%Mz + end if + if (allocated(SrcRotMiscVarTypeData%Vind_i)) then + LB(1:3) = lbound(SrcRotMiscVarTypeData%Vind_i) + UB(1:3) = ubound(SrcRotMiscVarTypeData%Vind_i) + if (.not. allocated(DstRotMiscVarTypeData%Vind_i)) then + allocate(DstRotMiscVarTypeData%Vind_i(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%Vind_i.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%Vind_i = SrcRotMiscVarTypeData%Vind_i + end if + DstRotMiscVarTypeData%V_DiskAvg = SrcRotMiscVarTypeData%V_DiskAvg + DstRotMiscVarTypeData%yaw = SrcRotMiscVarTypeData%yaw + DstRotMiscVarTypeData%tilt = SrcRotMiscVarTypeData%tilt + if (allocated(SrcRotMiscVarTypeData%hub_theta_x_root)) then + LB(1:1) = lbound(SrcRotMiscVarTypeData%hub_theta_x_root) + UB(1:1) = ubound(SrcRotMiscVarTypeData%hub_theta_x_root) + if (.not. allocated(DstRotMiscVarTypeData%hub_theta_x_root)) then + allocate(DstRotMiscVarTypeData%hub_theta_x_root(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%hub_theta_x_root.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%hub_theta_x_root = SrcRotMiscVarTypeData%hub_theta_x_root + end if + DstRotMiscVarTypeData%V_dot_x = SrcRotMiscVarTypeData%V_dot_x + call MeshCopy(SrcRotMiscVarTypeData%HubLoad, DstRotMiscVarTypeData%HubLoad, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcRotMiscVarTypeData%B_L_2_H_P)) then + LB(1:1) = lbound(SrcRotMiscVarTypeData%B_L_2_H_P) + UB(1:1) = ubound(SrcRotMiscVarTypeData%B_L_2_H_P) + if (.not. allocated(DstRotMiscVarTypeData%B_L_2_H_P)) then + allocate(DstRotMiscVarTypeData%B_L_2_H_P(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%B_L_2_H_P.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcRotMiscVarTypeData%B_L_2_H_P(i1), DstRotMiscVarTypeData%B_L_2_H_P(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcRotMiscVarTypeData%SigmaCavitCrit)) then + LB(1:2) = lbound(SrcRotMiscVarTypeData%SigmaCavitCrit) + UB(1:2) = ubound(SrcRotMiscVarTypeData%SigmaCavitCrit) + if (.not. allocated(DstRotMiscVarTypeData%SigmaCavitCrit)) then + allocate(DstRotMiscVarTypeData%SigmaCavitCrit(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%SigmaCavitCrit.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%SigmaCavitCrit = SrcRotMiscVarTypeData%SigmaCavitCrit + end if + if (allocated(SrcRotMiscVarTypeData%SigmaCavit)) then + LB(1:2) = lbound(SrcRotMiscVarTypeData%SigmaCavit) + UB(1:2) = ubound(SrcRotMiscVarTypeData%SigmaCavit) + if (.not. allocated(DstRotMiscVarTypeData%SigmaCavit)) then + allocate(DstRotMiscVarTypeData%SigmaCavit(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%SigmaCavit.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%SigmaCavit = SrcRotMiscVarTypeData%SigmaCavit + end if + if (allocated(SrcRotMiscVarTypeData%CavitWarnSet)) then + LB(1:2) = lbound(SrcRotMiscVarTypeData%CavitWarnSet) + UB(1:2) = ubound(SrcRotMiscVarTypeData%CavitWarnSet) + if (.not. allocated(DstRotMiscVarTypeData%CavitWarnSet)) then + allocate(DstRotMiscVarTypeData%CavitWarnSet(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%CavitWarnSet.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%CavitWarnSet = SrcRotMiscVarTypeData%CavitWarnSet + end if + if (allocated(SrcRotMiscVarTypeData%TwrFB)) then + LB(1:2) = lbound(SrcRotMiscVarTypeData%TwrFB) + UB(1:2) = ubound(SrcRotMiscVarTypeData%TwrFB) + if (.not. allocated(DstRotMiscVarTypeData%TwrFB)) then + allocate(DstRotMiscVarTypeData%TwrFB(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%TwrFB.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%TwrFB = SrcRotMiscVarTypeData%TwrFB + end if + if (allocated(SrcRotMiscVarTypeData%TwrMB)) then + LB(1:2) = lbound(SrcRotMiscVarTypeData%TwrMB) + UB(1:2) = ubound(SrcRotMiscVarTypeData%TwrMB) + if (.not. allocated(DstRotMiscVarTypeData%TwrMB)) then + allocate(DstRotMiscVarTypeData%TwrMB(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%TwrMB.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%TwrMB = SrcRotMiscVarTypeData%TwrMB + end if + if (allocated(SrcRotMiscVarTypeData%HubFB)) then + LB(1:1) = lbound(SrcRotMiscVarTypeData%HubFB) + UB(1:1) = ubound(SrcRotMiscVarTypeData%HubFB) + if (.not. allocated(DstRotMiscVarTypeData%HubFB)) then + allocate(DstRotMiscVarTypeData%HubFB(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%HubFB.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%HubFB = SrcRotMiscVarTypeData%HubFB + end if + if (allocated(SrcRotMiscVarTypeData%HubMB)) then + LB(1:1) = lbound(SrcRotMiscVarTypeData%HubMB) + UB(1:1) = ubound(SrcRotMiscVarTypeData%HubMB) + if (.not. allocated(DstRotMiscVarTypeData%HubMB)) then + allocate(DstRotMiscVarTypeData%HubMB(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%HubMB.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%HubMB = SrcRotMiscVarTypeData%HubMB + end if + if (allocated(SrcRotMiscVarTypeData%NacFB)) then + LB(1:1) = lbound(SrcRotMiscVarTypeData%NacFB) + UB(1:1) = ubound(SrcRotMiscVarTypeData%NacFB) + if (.not. allocated(DstRotMiscVarTypeData%NacFB)) then + allocate(DstRotMiscVarTypeData%NacFB(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%NacFB.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%NacFB = SrcRotMiscVarTypeData%NacFB + end if + if (allocated(SrcRotMiscVarTypeData%NacMB)) then + LB(1:1) = lbound(SrcRotMiscVarTypeData%NacMB) + UB(1:1) = ubound(SrcRotMiscVarTypeData%NacMB) + if (.not. allocated(DstRotMiscVarTypeData%NacMB)) then + allocate(DstRotMiscVarTypeData%NacMB(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%NacMB.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%NacMB = SrcRotMiscVarTypeData%NacMB + end if + if (allocated(SrcRotMiscVarTypeData%NacDragF)) then + LB(1:1) = lbound(SrcRotMiscVarTypeData%NacDragF) + UB(1:1) = ubound(SrcRotMiscVarTypeData%NacDragF) + if (.not. allocated(DstRotMiscVarTypeData%NacDragF)) then + allocate(DstRotMiscVarTypeData%NacDragF(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%NacDragF.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%NacDragF = SrcRotMiscVarTypeData%NacDragF + end if + if (allocated(SrcRotMiscVarTypeData%NacDragM)) then + LB(1:1) = lbound(SrcRotMiscVarTypeData%NacDragM) + UB(1:1) = ubound(SrcRotMiscVarTypeData%NacDragM) + if (.not. allocated(DstRotMiscVarTypeData%NacDragM)) then + allocate(DstRotMiscVarTypeData%NacDragM(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%NacDragM.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%NacDragM = SrcRotMiscVarTypeData%NacDragM + end if + if (allocated(SrcRotMiscVarTypeData%NacFi)) then + LB(1:1) = lbound(SrcRotMiscVarTypeData%NacFi) + UB(1:1) = ubound(SrcRotMiscVarTypeData%NacFi) + if (.not. allocated(DstRotMiscVarTypeData%NacFi)) then + allocate(DstRotMiscVarTypeData%NacFi(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%NacFi.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%NacFi = SrcRotMiscVarTypeData%NacFi + end if + if (allocated(SrcRotMiscVarTypeData%NacMi)) then + LB(1:1) = lbound(SrcRotMiscVarTypeData%NacMi) + UB(1:1) = ubound(SrcRotMiscVarTypeData%NacMi) + if (.not. allocated(DstRotMiscVarTypeData%NacMi)) then + allocate(DstRotMiscVarTypeData%NacMi(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%NacMi.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%NacMi = SrcRotMiscVarTypeData%NacMi + end if + if (allocated(SrcRotMiscVarTypeData%BladeRootLoad)) then + LB(1:1) = lbound(SrcRotMiscVarTypeData%BladeRootLoad) + UB(1:1) = ubound(SrcRotMiscVarTypeData%BladeRootLoad) + if (.not. allocated(DstRotMiscVarTypeData%BladeRootLoad)) then + allocate(DstRotMiscVarTypeData%BladeRootLoad(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%BladeRootLoad.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MeshCopy(SrcRotMiscVarTypeData%BladeRootLoad(i1), DstRotMiscVarTypeData%BladeRootLoad(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcRotMiscVarTypeData%B_L_2_R_P)) then + LB(1:1) = lbound(SrcRotMiscVarTypeData%B_L_2_R_P) + UB(1:1) = ubound(SrcRotMiscVarTypeData%B_L_2_R_P) + if (.not. allocated(DstRotMiscVarTypeData%B_L_2_R_P)) then + allocate(DstRotMiscVarTypeData%B_L_2_R_P(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%B_L_2_R_P.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcRotMiscVarTypeData%B_L_2_R_P(i1), DstRotMiscVarTypeData%B_L_2_R_P(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcRotMiscVarTypeData%BladeBuoyLoadPoint)) then + LB(1:1) = lbound(SrcRotMiscVarTypeData%BladeBuoyLoadPoint) + UB(1:1) = ubound(SrcRotMiscVarTypeData%BladeBuoyLoadPoint) + if (.not. allocated(DstRotMiscVarTypeData%BladeBuoyLoadPoint)) then + allocate(DstRotMiscVarTypeData%BladeBuoyLoadPoint(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%BladeBuoyLoadPoint.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MeshCopy(SrcRotMiscVarTypeData%BladeBuoyLoadPoint(i1), DstRotMiscVarTypeData%BladeBuoyLoadPoint(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcRotMiscVarTypeData%BladeBuoyLoad)) then + LB(1:1) = lbound(SrcRotMiscVarTypeData%BladeBuoyLoad) + UB(1:1) = ubound(SrcRotMiscVarTypeData%BladeBuoyLoad) + if (.not. allocated(DstRotMiscVarTypeData%BladeBuoyLoad)) then + allocate(DstRotMiscVarTypeData%BladeBuoyLoad(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%BladeBuoyLoad.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MeshCopy(SrcRotMiscVarTypeData%BladeBuoyLoad(i1), DstRotMiscVarTypeData%BladeBuoyLoad(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcRotMiscVarTypeData%B_P_2_B_L)) then + LB(1:1) = lbound(SrcRotMiscVarTypeData%B_P_2_B_L) + UB(1:1) = ubound(SrcRotMiscVarTypeData%B_P_2_B_L) + if (.not. allocated(DstRotMiscVarTypeData%B_P_2_B_L)) then + allocate(DstRotMiscVarTypeData%B_P_2_B_L(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%B_P_2_B_L.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcRotMiscVarTypeData%B_P_2_B_L(i1), DstRotMiscVarTypeData%B_P_2_B_L(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call MeshCopy(SrcRotMiscVarTypeData%TwrBuoyLoadPoint, DstRotMiscVarTypeData%TwrBuoyLoadPoint, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcRotMiscVarTypeData%TwrBuoyLoad, DstRotMiscVarTypeData%TwrBuoyLoad, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyMeshMapType(SrcRotMiscVarTypeData%T_P_2_T_L, DstRotMiscVarTypeData%T_P_2_T_L, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstRotMiscVarTypeData%FirstWarn_TowerStrike = SrcRotMiscVarTypeData%FirstWarn_TowerStrike + DstRotMiscVarTypeData%AvgDiskVel = SrcRotMiscVarTypeData%AvgDiskVel + DstRotMiscVarTypeData%AvgDiskVelDist = SrcRotMiscVarTypeData%AvgDiskVelDist + DstRotMiscVarTypeData%TFinAlpha = SrcRotMiscVarTypeData%TFinAlpha + DstRotMiscVarTypeData%TFinRe = SrcRotMiscVarTypeData%TFinRe + DstRotMiscVarTypeData%TFinVrel = SrcRotMiscVarTypeData%TFinVrel + DstRotMiscVarTypeData%TFinVund_i = SrcRotMiscVarTypeData%TFinVund_i + DstRotMiscVarTypeData%TFinVind_i = SrcRotMiscVarTypeData%TFinVind_i + DstRotMiscVarTypeData%TFinVrel_i = SrcRotMiscVarTypeData%TFinVrel_i + DstRotMiscVarTypeData%TFinSTV_i = SrcRotMiscVarTypeData%TFinSTV_i + DstRotMiscVarTypeData%TFinF_i = SrcRotMiscVarTypeData%TFinF_i + DstRotMiscVarTypeData%TFinM_i = SrcRotMiscVarTypeData%TFinM_i +end subroutine + +subroutine AD_DestroyRotMiscVarType(RotMiscVarTypeData, ErrStat, ErrMsg) + type(RotMiscVarType), intent(inout) :: RotMiscVarTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2, i3, i4 + integer(B4Ki) :: LB(4), UB(4) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_DestroyRotMiscVarType' + ErrStat = ErrID_None + ErrMsg = '' + call BEMT_DestroyMisc(RotMiscVarTypeData%BEMT, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call BEMT_DestroyOutput(RotMiscVarTypeData%BEMT_y, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + LB(1:1) = lbound(RotMiscVarTypeData%BEMT_u) + UB(1:1) = ubound(RotMiscVarTypeData%BEMT_u) + do i1 = LB(1), UB(1) + call BEMT_DestroyInput(RotMiscVarTypeData%BEMT_u(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + call AA_DestroyMisc(RotMiscVarTypeData%AA, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AA_DestroyOutput(RotMiscVarTypeData%AA_y, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AA_DestroyInput(RotMiscVarTypeData%AA_u, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(RotMiscVarTypeData%DisturbedInflow)) then + deallocate(RotMiscVarTypeData%DisturbedInflow) + end if + if (allocated(RotMiscVarTypeData%SectAvgInflow)) then + deallocate(RotMiscVarTypeData%SectAvgInflow) + end if + if (allocated(RotMiscVarTypeData%orientationAnnulus)) then + deallocate(RotMiscVarTypeData%orientationAnnulus) + end if + if (allocated(RotMiscVarTypeData%R_li)) then + deallocate(RotMiscVarTypeData%R_li) + end if + if (allocated(RotMiscVarTypeData%AllOuts)) then + deallocate(RotMiscVarTypeData%AllOuts) + end if + if (allocated(RotMiscVarTypeData%W_Twr)) then + deallocate(RotMiscVarTypeData%W_Twr) + end if + if (allocated(RotMiscVarTypeData%X_Twr)) then + deallocate(RotMiscVarTypeData%X_Twr) + end if + if (allocated(RotMiscVarTypeData%Y_Twr)) then + deallocate(RotMiscVarTypeData%Y_Twr) + end if + if (allocated(RotMiscVarTypeData%Cant)) then + deallocate(RotMiscVarTypeData%Cant) + end if + if (allocated(RotMiscVarTypeData%Toe)) then + deallocate(RotMiscVarTypeData%Toe) + end if + if (allocated(RotMiscVarTypeData%TwrClrnc)) then + deallocate(RotMiscVarTypeData%TwrClrnc) + end if + if (allocated(RotMiscVarTypeData%X)) then + deallocate(RotMiscVarTypeData%X) + end if + if (allocated(RotMiscVarTypeData%Y)) then + deallocate(RotMiscVarTypeData%Y) + end if + if (allocated(RotMiscVarTypeData%Z)) then + deallocate(RotMiscVarTypeData%Z) + end if + if (allocated(RotMiscVarTypeData%M)) then + deallocate(RotMiscVarTypeData%M) + end if + if (allocated(RotMiscVarTypeData%Mx)) then + deallocate(RotMiscVarTypeData%Mx) + end if + if (allocated(RotMiscVarTypeData%My)) then + deallocate(RotMiscVarTypeData%My) + end if + if (allocated(RotMiscVarTypeData%Mz)) then + deallocate(RotMiscVarTypeData%Mz) + end if + if (allocated(RotMiscVarTypeData%Vind_i)) then + deallocate(RotMiscVarTypeData%Vind_i) + end if + if (allocated(RotMiscVarTypeData%hub_theta_x_root)) then + deallocate(RotMiscVarTypeData%hub_theta_x_root) + end if + call MeshDestroy( RotMiscVarTypeData%HubLoad, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(RotMiscVarTypeData%B_L_2_H_P)) then + LB(1:1) = lbound(RotMiscVarTypeData%B_L_2_H_P) + UB(1:1) = ubound(RotMiscVarTypeData%B_L_2_H_P) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(RotMiscVarTypeData%B_L_2_H_P(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(RotMiscVarTypeData%B_L_2_H_P) + end if + if (allocated(RotMiscVarTypeData%SigmaCavitCrit)) then + deallocate(RotMiscVarTypeData%SigmaCavitCrit) + end if + if (allocated(RotMiscVarTypeData%SigmaCavit)) then + deallocate(RotMiscVarTypeData%SigmaCavit) + end if + if (allocated(RotMiscVarTypeData%CavitWarnSet)) then + deallocate(RotMiscVarTypeData%CavitWarnSet) + end if + if (allocated(RotMiscVarTypeData%TwrFB)) then + deallocate(RotMiscVarTypeData%TwrFB) + end if + if (allocated(RotMiscVarTypeData%TwrMB)) then + deallocate(RotMiscVarTypeData%TwrMB) + end if + if (allocated(RotMiscVarTypeData%HubFB)) then + deallocate(RotMiscVarTypeData%HubFB) + end if + if (allocated(RotMiscVarTypeData%HubMB)) then + deallocate(RotMiscVarTypeData%HubMB) + end if + if (allocated(RotMiscVarTypeData%NacFB)) then + deallocate(RotMiscVarTypeData%NacFB) + end if + if (allocated(RotMiscVarTypeData%NacMB)) then + deallocate(RotMiscVarTypeData%NacMB) + end if + if (allocated(RotMiscVarTypeData%NacDragF)) then + deallocate(RotMiscVarTypeData%NacDragF) + end if + if (allocated(RotMiscVarTypeData%NacDragM)) then + deallocate(RotMiscVarTypeData%NacDragM) + end if + if (allocated(RotMiscVarTypeData%NacFi)) then + deallocate(RotMiscVarTypeData%NacFi) + end if + if (allocated(RotMiscVarTypeData%NacMi)) then + deallocate(RotMiscVarTypeData%NacMi) + end if + if (allocated(RotMiscVarTypeData%BladeRootLoad)) then + LB(1:1) = lbound(RotMiscVarTypeData%BladeRootLoad) + UB(1:1) = ubound(RotMiscVarTypeData%BladeRootLoad) + do i1 = LB(1), UB(1) + call MeshDestroy( RotMiscVarTypeData%BladeRootLoad(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(RotMiscVarTypeData%BladeRootLoad) + end if + if (allocated(RotMiscVarTypeData%B_L_2_R_P)) then + LB(1:1) = lbound(RotMiscVarTypeData%B_L_2_R_P) + UB(1:1) = ubound(RotMiscVarTypeData%B_L_2_R_P) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(RotMiscVarTypeData%B_L_2_R_P(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(RotMiscVarTypeData%B_L_2_R_P) + end if + if (allocated(RotMiscVarTypeData%BladeBuoyLoadPoint)) then + LB(1:1) = lbound(RotMiscVarTypeData%BladeBuoyLoadPoint) + UB(1:1) = ubound(RotMiscVarTypeData%BladeBuoyLoadPoint) + do i1 = LB(1), UB(1) + call MeshDestroy( RotMiscVarTypeData%BladeBuoyLoadPoint(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(RotMiscVarTypeData%BladeBuoyLoadPoint) + end if + if (allocated(RotMiscVarTypeData%BladeBuoyLoad)) then + LB(1:1) = lbound(RotMiscVarTypeData%BladeBuoyLoad) + UB(1:1) = ubound(RotMiscVarTypeData%BladeBuoyLoad) + do i1 = LB(1), UB(1) + call MeshDestroy( RotMiscVarTypeData%BladeBuoyLoad(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(RotMiscVarTypeData%BladeBuoyLoad) + end if + if (allocated(RotMiscVarTypeData%B_P_2_B_L)) then + LB(1:1) = lbound(RotMiscVarTypeData%B_P_2_B_L) + UB(1:1) = ubound(RotMiscVarTypeData%B_P_2_B_L) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(RotMiscVarTypeData%B_P_2_B_L(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(RotMiscVarTypeData%B_P_2_B_L) + end if + call MeshDestroy( RotMiscVarTypeData%TwrBuoyLoadPoint, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( RotMiscVarTypeData%TwrBuoyLoad, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call NWTC_Library_DestroyMeshMapType(RotMiscVarTypeData%T_P_2_T_L, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine AD_PackRotMiscVarType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(RotMiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_PackRotMiscVarType' + integer(B4Ki) :: i1, i2, i3, i4 + integer(B4Ki) :: LB(4), UB(4) + if (RF%ErrStat >= AbortErrLev) return + call BEMT_PackMisc(RF, InData%BEMT) + call BEMT_PackOutput(RF, InData%BEMT_y) + LB(1:1) = lbound(InData%BEMT_u) + UB(1:1) = ubound(InData%BEMT_u) + do i1 = LB(1), UB(1) + call BEMT_PackInput(RF, InData%BEMT_u(i1)) + end do + call AA_PackMisc(RF, InData%AA) + call AA_PackOutput(RF, InData%AA_y) + call AA_PackInput(RF, InData%AA_u) + call RegPackAlloc(RF, InData%DisturbedInflow) + call RegPackAlloc(RF, InData%SectAvgInflow) + call RegPackAlloc(RF, InData%orientationAnnulus) + call RegPackAlloc(RF, InData%R_li) + call RegPackAlloc(RF, InData%AllOuts) + call RegPackAlloc(RF, InData%W_Twr) + call RegPackAlloc(RF, InData%X_Twr) + call RegPackAlloc(RF, InData%Y_Twr) + call RegPackAlloc(RF, InData%Cant) + call RegPackAlloc(RF, InData%Toe) + call RegPackAlloc(RF, InData%TwrClrnc) + call RegPackAlloc(RF, InData%X) + call RegPackAlloc(RF, InData%Y) + call RegPackAlloc(RF, InData%Z) + call RegPackAlloc(RF, InData%M) + call RegPackAlloc(RF, InData%Mx) + call RegPackAlloc(RF, InData%My) + call RegPackAlloc(RF, InData%Mz) + call RegPackAlloc(RF, InData%Vind_i) + call RegPack(RF, InData%V_DiskAvg) + call RegPack(RF, InData%yaw) + call RegPack(RF, InData%tilt) + call RegPackAlloc(RF, InData%hub_theta_x_root) + call RegPack(RF, InData%V_dot_x) + call MeshPack(RF, InData%HubLoad) + call RegPack(RF, allocated(InData%B_L_2_H_P)) + if (allocated(InData%B_L_2_H_P)) then + call RegPackBounds(RF, 1, lbound(InData%B_L_2_H_P), ubound(InData%B_L_2_H_P)) + LB(1:1) = lbound(InData%B_L_2_H_P) + UB(1:1) = ubound(InData%B_L_2_H_P) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(RF, InData%B_L_2_H_P(i1)) + end do + end if + call RegPackAlloc(RF, InData%SigmaCavitCrit) + call RegPackAlloc(RF, InData%SigmaCavit) + call RegPackAlloc(RF, InData%CavitWarnSet) + call RegPackAlloc(RF, InData%TwrFB) + call RegPackAlloc(RF, InData%TwrMB) + call RegPackAlloc(RF, InData%HubFB) + call RegPackAlloc(RF, InData%HubMB) + call RegPackAlloc(RF, InData%NacFB) + call RegPackAlloc(RF, InData%NacMB) + call RegPackAlloc(RF, InData%NacDragF) + call RegPackAlloc(RF, InData%NacDragM) + call RegPackAlloc(RF, InData%NacFi) + call RegPackAlloc(RF, InData%NacMi) + call RegPack(RF, allocated(InData%BladeRootLoad)) + if (allocated(InData%BladeRootLoad)) then + call RegPackBounds(RF, 1, lbound(InData%BladeRootLoad), ubound(InData%BladeRootLoad)) + LB(1:1) = lbound(InData%BladeRootLoad) + UB(1:1) = ubound(InData%BladeRootLoad) + do i1 = LB(1), UB(1) + call MeshPack(RF, InData%BladeRootLoad(i1)) + end do + end if + call RegPack(RF, allocated(InData%B_L_2_R_P)) + if (allocated(InData%B_L_2_R_P)) then + call RegPackBounds(RF, 1, lbound(InData%B_L_2_R_P), ubound(InData%B_L_2_R_P)) + LB(1:1) = lbound(InData%B_L_2_R_P) + UB(1:1) = ubound(InData%B_L_2_R_P) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(RF, InData%B_L_2_R_P(i1)) + end do + end if + call RegPack(RF, allocated(InData%BladeBuoyLoadPoint)) + if (allocated(InData%BladeBuoyLoadPoint)) then + call RegPackBounds(RF, 1, lbound(InData%BladeBuoyLoadPoint), ubound(InData%BladeBuoyLoadPoint)) + LB(1:1) = lbound(InData%BladeBuoyLoadPoint) + UB(1:1) = ubound(InData%BladeBuoyLoadPoint) + do i1 = LB(1), UB(1) + call MeshPack(RF, InData%BladeBuoyLoadPoint(i1)) + end do + end if + call RegPack(RF, allocated(InData%BladeBuoyLoad)) + if (allocated(InData%BladeBuoyLoad)) then + call RegPackBounds(RF, 1, lbound(InData%BladeBuoyLoad), ubound(InData%BladeBuoyLoad)) + LB(1:1) = lbound(InData%BladeBuoyLoad) + UB(1:1) = ubound(InData%BladeBuoyLoad) + do i1 = LB(1), UB(1) + call MeshPack(RF, InData%BladeBuoyLoad(i1)) + end do + end if + call RegPack(RF, allocated(InData%B_P_2_B_L)) + if (allocated(InData%B_P_2_B_L)) then + call RegPackBounds(RF, 1, lbound(InData%B_P_2_B_L), ubound(InData%B_P_2_B_L)) + LB(1:1) = lbound(InData%B_P_2_B_L) + UB(1:1) = ubound(InData%B_P_2_B_L) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(RF, InData%B_P_2_B_L(i1)) + end do + end if + call MeshPack(RF, InData%TwrBuoyLoadPoint) + call MeshPack(RF, InData%TwrBuoyLoad) + call NWTC_Library_PackMeshMapType(RF, InData%T_P_2_T_L) + call RegPack(RF, InData%FirstWarn_TowerStrike) + call RegPack(RF, InData%AvgDiskVel) + call RegPack(RF, InData%AvgDiskVelDist) + call RegPack(RF, InData%TFinAlpha) + call RegPack(RF, InData%TFinRe) + call RegPack(RF, InData%TFinVrel) + call RegPack(RF, InData%TFinVund_i) + call RegPack(RF, InData%TFinVind_i) + call RegPack(RF, InData%TFinVrel_i) + call RegPack(RF, InData%TFinSTV_i) + call RegPack(RF, InData%TFinF_i) + call RegPack(RF, InData%TFinM_i) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AD_UnPackRotMiscVarType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(RotMiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_UnPackRotMiscVarType' + integer(B4Ki) :: i1, i2, i3, i4 + integer(B4Ki) :: LB(4), UB(4) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call BEMT_UnpackMisc(RF, OutData%BEMT) ! BEMT + call BEMT_UnpackOutput(RF, OutData%BEMT_y) ! BEMT_y + LB(1:1) = lbound(OutData%BEMT_u) + UB(1:1) = ubound(OutData%BEMT_u) + do i1 = LB(1), UB(1) + call BEMT_UnpackInput(RF, OutData%BEMT_u(i1)) ! BEMT_u + end do + call AA_UnpackMisc(RF, OutData%AA) ! AA + call AA_UnpackOutput(RF, OutData%AA_y) ! AA_y + call AA_UnpackInput(RF, OutData%AA_u) ! AA_u + call RegUnpackAlloc(RF, OutData%DisturbedInflow); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%SectAvgInflow); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%orientationAnnulus); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%R_li); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AllOuts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%W_Twr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%X_Twr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Y_Twr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Cant); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Toe); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TwrClrnc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%X); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Z); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%M); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Mx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%My); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Mz); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Vind_i); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%V_DiskAvg); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%yaw); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%tilt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%hub_theta_x_root); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%V_dot_x); if (RegCheckErr(RF, RoutineName)) return + call MeshUnpack(RF, OutData%HubLoad) ! HubLoad + if (allocated(OutData%B_L_2_H_P)) deallocate(OutData%B_L_2_H_P) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%B_L_2_H_P(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%B_L_2_H_P.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(RF, OutData%B_L_2_H_P(i1)) ! B_L_2_H_P + end do + end if + call RegUnpackAlloc(RF, OutData%SigmaCavitCrit); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%SigmaCavit); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%CavitWarnSet); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TwrFB); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TwrMB); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%HubFB); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%HubMB); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%NacFB); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%NacMB); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%NacDragF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%NacDragM); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%NacFi); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%NacMi); if (RegCheckErr(RF, RoutineName)) return + if (allocated(OutData%BladeRootLoad)) deallocate(OutData%BladeRootLoad) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%BladeRootLoad(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeRootLoad.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(RF, OutData%BladeRootLoad(i1)) ! BladeRootLoad + end do + end if + if (allocated(OutData%B_L_2_R_P)) deallocate(OutData%B_L_2_R_P) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%B_L_2_R_P(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%B_L_2_R_P.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(RF, OutData%B_L_2_R_P(i1)) ! B_L_2_R_P + end do + end if + if (allocated(OutData%BladeBuoyLoadPoint)) deallocate(OutData%BladeBuoyLoadPoint) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%BladeBuoyLoadPoint(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeBuoyLoadPoint.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(RF, OutData%BladeBuoyLoadPoint(i1)) ! BladeBuoyLoadPoint + end do + end if + if (allocated(OutData%BladeBuoyLoad)) deallocate(OutData%BladeBuoyLoad) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%BladeBuoyLoad(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeBuoyLoad.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(RF, OutData%BladeBuoyLoad(i1)) ! BladeBuoyLoad + end do + end if + if (allocated(OutData%B_P_2_B_L)) deallocate(OutData%B_P_2_B_L) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%B_P_2_B_L(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%B_P_2_B_L.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(RF, OutData%B_P_2_B_L(i1)) ! B_P_2_B_L + end do + end if + call MeshUnpack(RF, OutData%TwrBuoyLoadPoint) ! TwrBuoyLoadPoint + call MeshUnpack(RF, OutData%TwrBuoyLoad) ! TwrBuoyLoad + call NWTC_Library_UnpackMeshMapType(RF, OutData%T_P_2_T_L) ! T_P_2_T_L + call RegUnpack(RF, OutData%FirstWarn_TowerStrike); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AvgDiskVel); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AvgDiskVelDist); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFinAlpha); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFinRe); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFinVrel); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFinVund_i); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFinVind_i); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFinVrel_i); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFinSTV_i); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFinF_i); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFinM_i); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AD_CopyElemInflowType(SrcElemInflowTypeData, DstElemInflowTypeData, CtrlCode, ErrStat, ErrMsg) + type(ElemInflowType), intent(in) :: SrcElemInflowTypeData + type(ElemInflowType), intent(inout) :: DstElemInflowTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'AD_CopyElemInflowType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcElemInflowTypeData%InflowVel)) then + LB(1:2) = lbound(SrcElemInflowTypeData%InflowVel) + UB(1:2) = ubound(SrcElemInflowTypeData%InflowVel) + if (.not. allocated(DstElemInflowTypeData%InflowVel)) then + allocate(DstElemInflowTypeData%InflowVel(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstElemInflowTypeData%InflowVel.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstElemInflowTypeData%InflowVel = SrcElemInflowTypeData%InflowVel + end if + if (allocated(SrcElemInflowTypeData%InflowAcc)) then + LB(1:2) = lbound(SrcElemInflowTypeData%InflowAcc) + UB(1:2) = ubound(SrcElemInflowTypeData%InflowAcc) + if (.not. allocated(DstElemInflowTypeData%InflowAcc)) then + allocate(DstElemInflowTypeData%InflowAcc(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstElemInflowTypeData%InflowAcc.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstElemInflowTypeData%InflowAcc = SrcElemInflowTypeData%InflowAcc + end if +end subroutine + +subroutine AD_DestroyElemInflowType(ElemInflowTypeData, ErrStat, ErrMsg) + type(ElemInflowType), intent(inout) :: ElemInflowTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD_DestroyElemInflowType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ElemInflowTypeData%InflowVel)) then + deallocate(ElemInflowTypeData%InflowVel) + end if + if (allocated(ElemInflowTypeData%InflowAcc)) then + deallocate(ElemInflowTypeData%InflowAcc) + end if +end subroutine + +subroutine AD_PackElemInflowType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(ElemInflowType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_PackElemInflowType' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%InflowVel) + call RegPackAlloc(RF, InData%InflowAcc) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AD_UnPackElemInflowType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(ElemInflowType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_UnPackElemInflowType' + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%InflowVel); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%InflowAcc); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AD_CopyRotInflowType(SrcRotInflowTypeData, DstRotInflowTypeData, CtrlCode, ErrStat, ErrMsg) + type(RotInflowType), intent(in) :: SrcRotInflowTypeData + type(RotInflowType), intent(inout) :: DstRotInflowTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_CopyRotInflowType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcRotInflowTypeData%Blade)) then + LB(1:1) = lbound(SrcRotInflowTypeData%Blade) + UB(1:1) = ubound(SrcRotInflowTypeData%Blade) + if (.not. allocated(DstRotInflowTypeData%Blade)) then + allocate(DstRotInflowTypeData%Blade(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotInflowTypeData%Blade.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AD_CopyElemInflowType(SrcRotInflowTypeData%Blade(i1), DstRotInflowTypeData%Blade(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call AD_CopyElemInflowType(SrcRotInflowTypeData%Tower, DstRotInflowTypeData%Tower, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstRotInflowTypeData%InflowOnHub = SrcRotInflowTypeData%InflowOnHub + DstRotInflowTypeData%InflowOnNacelle = SrcRotInflowTypeData%InflowOnNacelle + DstRotInflowTypeData%InflowOnTailFin = SrcRotInflowTypeData%InflowOnTailFin + DstRotInflowTypeData%AvgDiskVel = SrcRotInflowTypeData%AvgDiskVel +end subroutine + +subroutine AD_DestroyRotInflowType(RotInflowTypeData, ErrStat, ErrMsg) + type(RotInflowType), intent(inout) :: RotInflowTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_DestroyRotInflowType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(RotInflowTypeData%Blade)) then + LB(1:1) = lbound(RotInflowTypeData%Blade) + UB(1:1) = ubound(RotInflowTypeData%Blade) + do i1 = LB(1), UB(1) + call AD_DestroyElemInflowType(RotInflowTypeData%Blade(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(RotInflowTypeData%Blade) + end if + call AD_DestroyElemInflowType(RotInflowTypeData%Tower, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine AD_PackRotInflowType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(RotInflowType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_PackRotInflowType' + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%Blade)) + if (allocated(InData%Blade)) then + call RegPackBounds(RF, 1, lbound(InData%Blade), ubound(InData%Blade)) + LB(1:1) = lbound(InData%Blade) + UB(1:1) = ubound(InData%Blade) + do i1 = LB(1), UB(1) + call AD_PackElemInflowType(RF, InData%Blade(i1)) + end do + end if + call AD_PackElemInflowType(RF, InData%Tower) + call RegPack(RF, InData%InflowOnHub) + call RegPack(RF, InData%InflowOnNacelle) + call RegPack(RF, InData%InflowOnTailFin) + call RegPack(RF, InData%AvgDiskVel) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AD_UnPackRotInflowType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(RotInflowType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_UnPackRotInflowType' + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + if (allocated(OutData%Blade)) deallocate(OutData%Blade) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%Blade(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Blade.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AD_UnpackElemInflowType(RF, OutData%Blade(i1)) ! Blade + end do + end if + call AD_UnpackElemInflowType(RF, OutData%Tower) ! Tower + call RegUnpack(RF, OutData%InflowOnHub); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%InflowOnNacelle); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%InflowOnTailFin); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AvgDiskVel); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AD_CopyInflowType(SrcInflowTypeData, DstInflowTypeData, CtrlCode, ErrStat, ErrMsg) + type(AD_InflowType), intent(in) :: SrcInflowTypeData + type(AD_InflowType), intent(inout) :: DstInflowTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_CopyInflowType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcInflowTypeData%InflowWakeVel)) then + LB(1:2) = lbound(SrcInflowTypeData%InflowWakeVel) + UB(1:2) = ubound(SrcInflowTypeData%InflowWakeVel) + if (.not. allocated(DstInflowTypeData%InflowWakeVel)) then + allocate(DstInflowTypeData%InflowWakeVel(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInflowTypeData%InflowWakeVel.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInflowTypeData%InflowWakeVel = SrcInflowTypeData%InflowWakeVel + end if + if (allocated(SrcInflowTypeData%RotInflow)) then + LB(1:1) = lbound(SrcInflowTypeData%RotInflow) + UB(1:1) = ubound(SrcInflowTypeData%RotInflow) + if (.not. allocated(DstInflowTypeData%RotInflow)) then + allocate(DstInflowTypeData%RotInflow(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInflowTypeData%RotInflow.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AD_CopyRotInflowType(SrcInflowTypeData%RotInflow(i1), DstInflowTypeData%RotInflow(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if +end subroutine + +subroutine AD_DestroyInflowType(InflowTypeData, ErrStat, ErrMsg) + type(AD_InflowType), intent(inout) :: InflowTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_DestroyInflowType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InflowTypeData%InflowWakeVel)) then + deallocate(InflowTypeData%InflowWakeVel) + end if + if (allocated(InflowTypeData%RotInflow)) then + LB(1:1) = lbound(InflowTypeData%RotInflow) + UB(1:1) = ubound(InflowTypeData%RotInflow) + do i1 = LB(1), UB(1) + call AD_DestroyRotInflowType(InflowTypeData%RotInflow(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InflowTypeData%RotInflow) + end if +end subroutine + +subroutine AD_PackInflowType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(AD_InflowType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_PackInflowType' + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%InflowWakeVel) + call RegPack(RF, allocated(InData%RotInflow)) + if (allocated(InData%RotInflow)) then + call RegPackBounds(RF, 1, lbound(InData%RotInflow), ubound(InData%RotInflow)) + LB(1:1) = lbound(InData%RotInflow) + UB(1:1) = ubound(InData%RotInflow) + do i1 = LB(1), UB(1) + call AD_PackRotInflowType(RF, InData%RotInflow(i1)) + end do + end if + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AD_UnPackInflowType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(AD_InflowType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_UnPackInflowType' + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%InflowWakeVel); if (RegCheckErr(RF, RoutineName)) return + if (allocated(OutData%RotInflow)) deallocate(OutData%RotInflow) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%RotInflow(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotInflow.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AD_UnpackRotInflowType(RF, OutData%RotInflow(i1)) ! RotInflow + end do + end if +end subroutine + +subroutine AD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(AD_MiscVarType), intent(inout) :: SrcMiscData + type(AD_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcMiscData%rotors)) then + LB(1:1) = lbound(SrcMiscData%rotors) + UB(1:1) = ubound(SrcMiscData%rotors) + if (.not. allocated(DstMiscData%rotors)) then + allocate(DstMiscData%rotors(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%rotors.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AD_CopyRotMiscVarType(SrcMiscData%rotors(i1), DstMiscData%rotors(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcMiscData%FVW_u)) then + LB(1:1) = lbound(SrcMiscData%FVW_u) + UB(1:1) = ubound(SrcMiscData%FVW_u) + if (.not. allocated(DstMiscData%FVW_u)) then + allocate(DstMiscData%FVW_u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FVW_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call FVW_CopyInput(SrcMiscData%FVW_u(i1), DstMiscData%FVW_u(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call FVW_CopyOutput(SrcMiscData%FVW_y, DstMiscData%FVW_y, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FVW_CopyMisc(SrcMiscData%FVW, DstMiscData%FVW, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcMiscData%WindPos)) then + LB(1:2) = lbound(SrcMiscData%WindPos) + UB(1:2) = ubound(SrcMiscData%WindPos) + if (.not. allocated(DstMiscData%WindPos)) then + allocate(DstMiscData%WindPos(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%WindPos.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%WindPos = SrcMiscData%WindPos + end if + if (allocated(SrcMiscData%WindVel)) then + LB(1:2) = lbound(SrcMiscData%WindVel) + UB(1:2) = ubound(SrcMiscData%WindVel) + if (.not. allocated(DstMiscData%WindVel)) then + allocate(DstMiscData%WindVel(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%WindVel.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%WindVel = SrcMiscData%WindVel + end if + if (allocated(SrcMiscData%WindAcc)) then + LB(1:2) = lbound(SrcMiscData%WindAcc) + UB(1:2) = ubound(SrcMiscData%WindAcc) + if (.not. allocated(DstMiscData%WindAcc)) then + allocate(DstMiscData%WindAcc(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%WindAcc.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%WindAcc = SrcMiscData%WindAcc + end if + if (allocated(SrcMiscData%Inflow)) then + LB(1:1) = lbound(SrcMiscData%Inflow) + UB(1:1) = ubound(SrcMiscData%Inflow) + if (.not. allocated(DstMiscData%Inflow)) then + allocate(DstMiscData%Inflow(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Inflow.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AD_CopyInflowType(SrcMiscData%Inflow(i1), DstMiscData%Inflow(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if +end subroutine + +subroutine AD_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(AD_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(MiscData%rotors)) then + LB(1:1) = lbound(MiscData%rotors) + UB(1:1) = ubound(MiscData%rotors) + do i1 = LB(1), UB(1) + call AD_DestroyRotMiscVarType(MiscData%rotors(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%rotors) + end if + if (allocated(MiscData%FVW_u)) then + LB(1:1) = lbound(MiscData%FVW_u) + UB(1:1) = ubound(MiscData%FVW_u) + do i1 = LB(1), UB(1) + call FVW_DestroyInput(MiscData%FVW_u(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%FVW_u) + end if + call FVW_DestroyOutput(MiscData%FVW_y, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FVW_DestroyMisc(MiscData%FVW, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(MiscData%WindPos)) then + deallocate(MiscData%WindPos) + end if + if (allocated(MiscData%WindVel)) then + deallocate(MiscData%WindVel) + end if + if (allocated(MiscData%WindAcc)) then + deallocate(MiscData%WindAcc) + end if + if (allocated(MiscData%Inflow)) then + LB(1:1) = lbound(MiscData%Inflow) + UB(1:1) = ubound(MiscData%Inflow) + do i1 = LB(1), UB(1) + call AD_DestroyInflowType(MiscData%Inflow(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%Inflow) + end if +end subroutine + +subroutine AD_PackMisc(RF, Indata) + type(RegFile), intent(inout) :: RF + type(AD_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_PackMisc' + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%rotors)) + if (allocated(InData%rotors)) then + call RegPackBounds(RF, 1, lbound(InData%rotors), ubound(InData%rotors)) + LB(1:1) = lbound(InData%rotors) + UB(1:1) = ubound(InData%rotors) + do i1 = LB(1), UB(1) + call AD_PackRotMiscVarType(RF, InData%rotors(i1)) + end do + end if + call RegPack(RF, allocated(InData%FVW_u)) + if (allocated(InData%FVW_u)) then + call RegPackBounds(RF, 1, lbound(InData%FVW_u), ubound(InData%FVW_u)) + LB(1:1) = lbound(InData%FVW_u) + UB(1:1) = ubound(InData%FVW_u) + do i1 = LB(1), UB(1) + call FVW_PackInput(RF, InData%FVW_u(i1)) + end do + end if + call FVW_PackOutput(RF, InData%FVW_y) + call FVW_PackMisc(RF, InData%FVW) + call RegPackAlloc(RF, InData%WindPos) + call RegPackAlloc(RF, InData%WindVel) + call RegPackAlloc(RF, InData%WindAcc) + call RegPack(RF, allocated(InData%Inflow)) + if (allocated(InData%Inflow)) then + call RegPackBounds(RF, 1, lbound(InData%Inflow), ubound(InData%Inflow)) + LB(1:1) = lbound(InData%Inflow) + UB(1:1) = ubound(InData%Inflow) + do i1 = LB(1), UB(1) + call AD_PackInflowType(RF, InData%Inflow(i1)) + end do + end if + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AD_UnPackMisc(RF, OutData) + type(RegFile), intent(inout) :: RF + type(AD_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_UnPackMisc' + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + if (allocated(OutData%rotors)) deallocate(OutData%rotors) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%rotors(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotors.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AD_UnpackRotMiscVarType(RF, OutData%rotors(i1)) ! rotors + end do + end if + if (allocated(OutData%FVW_u)) deallocate(OutData%FVW_u) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%FVW_u(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FVW_u.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call FVW_UnpackInput(RF, OutData%FVW_u(i1)) ! FVW_u + end do + end if + call FVW_UnpackOutput(RF, OutData%FVW_y) ! FVW_y + call FVW_UnpackMisc(RF, OutData%FVW) ! FVW + call RegUnpackAlloc(RF, OutData%WindPos); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WindVel); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WindAcc); if (RegCheckErr(RF, RoutineName)) return + if (allocated(OutData%Inflow)) deallocate(OutData%Inflow) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%Inflow(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Inflow.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AD_UnpackInflowType(RF, OutData%Inflow(i1)) ! Inflow + end do + end if +end subroutine + +subroutine AD_CopyJac_u_idxStarts(SrcJac_u_idxStartsData, DstJac_u_idxStartsData, CtrlCode, ErrStat, ErrMsg) + type(Jac_u_idxStarts), intent(in) :: SrcJac_u_idxStartsData + type(Jac_u_idxStarts), intent(inout) :: DstJac_u_idxStartsData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD_CopyJac_u_idxStarts' + ErrStat = ErrID_None + ErrMsg = '' + DstJac_u_idxStartsData%Nacelle = SrcJac_u_idxStartsData%Nacelle + DstJac_u_idxStartsData%Hub = SrcJac_u_idxStartsData%Hub + DstJac_u_idxStartsData%TFin = SrcJac_u_idxStartsData%TFin + DstJac_u_idxStartsData%Tower = SrcJac_u_idxStartsData%Tower + DstJac_u_idxStartsData%BladeRoot = SrcJac_u_idxStartsData%BladeRoot + DstJac_u_idxStartsData%Blade = SrcJac_u_idxStartsData%Blade + DstJac_u_idxStartsData%UserProp = SrcJac_u_idxStartsData%UserProp + DstJac_u_idxStartsData%Extended = SrcJac_u_idxStartsData%Extended +end subroutine + +subroutine AD_DestroyJac_u_idxStarts(Jac_u_idxStartsData, ErrStat, ErrMsg) + type(Jac_u_idxStarts), intent(inout) :: Jac_u_idxStartsData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD_DestroyJac_u_idxStarts' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine AD_PackJac_u_idxStarts(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Jac_u_idxStarts), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_PackJac_u_idxStarts' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%Nacelle) + call RegPack(RF, InData%Hub) + call RegPack(RF, InData%TFin) + call RegPack(RF, InData%Tower) + call RegPack(RF, InData%BladeRoot) + call RegPack(RF, InData%Blade) + call RegPack(RF, InData%UserProp) + call RegPack(RF, InData%Extended) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AD_UnPackJac_u_idxStarts(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Jac_u_idxStarts), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_UnPackJac_u_idxStarts' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%Nacelle); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Hub); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFin); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Tower); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BladeRoot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Blade); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UserProp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Extended); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AD_CopyJac_y_idxStarts(SrcJac_y_idxStartsData, DstJac_y_idxStartsData, CtrlCode, ErrStat, ErrMsg) + type(Jac_y_idxStarts), intent(in) :: SrcJac_y_idxStartsData + type(Jac_y_idxStarts), intent(inout) :: DstJac_y_idxStartsData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD_CopyJac_y_idxStarts' + ErrStat = ErrID_None + ErrMsg = '' + DstJac_y_idxStartsData%NacelleLoad = SrcJac_y_idxStartsData%NacelleLoad + DstJac_y_idxStartsData%HubLoad = SrcJac_y_idxStartsData%HubLoad + DstJac_y_idxStartsData%TFinLoad = SrcJac_y_idxStartsData%TFinLoad + DstJac_y_idxStartsData%TowerLoad = SrcJac_y_idxStartsData%TowerLoad + DstJac_y_idxStartsData%BladeLoad = SrcJac_y_idxStartsData%BladeLoad +end subroutine + +subroutine AD_DestroyJac_y_idxStarts(Jac_y_idxStartsData, ErrStat, ErrMsg) + type(Jac_y_idxStarts), intent(inout) :: Jac_y_idxStartsData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD_DestroyJac_y_idxStarts' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine AD_PackJac_y_idxStarts(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Jac_y_idxStarts), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_PackJac_y_idxStarts' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%NacelleLoad) + call RegPack(RF, InData%HubLoad) + call RegPack(RF, InData%TFinLoad) + call RegPack(RF, InData%TowerLoad) + call RegPack(RF, InData%BladeLoad) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AD_UnPackJac_y_idxStarts(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Jac_y_idxStarts), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_UnPackJac_y_idxStarts' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%NacelleLoad); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HubLoad); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFinLoad); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TowerLoad); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BladeLoad); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AD_CopyRotParameterType(SrcRotParameterTypeData, DstRotParameterTypeData, CtrlCode, ErrStat, ErrMsg) + type(RotParameterType), intent(in) :: SrcRotParameterTypeData + type(RotParameterType), intent(inout) :: DstRotParameterTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_CopyRotParameterType' + ErrStat = ErrID_None + ErrMsg = '' + DstRotParameterTypeData%NumBlades = SrcRotParameterTypeData%NumBlades + DstRotParameterTypeData%NumBlNds = SrcRotParameterTypeData%NumBlNds + DstRotParameterTypeData%NumTwrNds = SrcRotParameterTypeData%NumTwrNds + if (allocated(SrcRotParameterTypeData%TwrDiam)) then + LB(1:1) = lbound(SrcRotParameterTypeData%TwrDiam) + UB(1:1) = ubound(SrcRotParameterTypeData%TwrDiam) + if (.not. allocated(DstRotParameterTypeData%TwrDiam)) then + allocate(DstRotParameterTypeData%TwrDiam(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%TwrDiam.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotParameterTypeData%TwrDiam = SrcRotParameterTypeData%TwrDiam + end if + if (allocated(SrcRotParameterTypeData%TwrCd)) then + LB(1:1) = lbound(SrcRotParameterTypeData%TwrCd) + UB(1:1) = ubound(SrcRotParameterTypeData%TwrCd) + if (.not. allocated(DstRotParameterTypeData%TwrCd)) then + allocate(DstRotParameterTypeData%TwrCd(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%TwrCd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotParameterTypeData%TwrCd = SrcRotParameterTypeData%TwrCd + end if + if (allocated(SrcRotParameterTypeData%TwrTI)) then + LB(1:1) = lbound(SrcRotParameterTypeData%TwrTI) + UB(1:1) = ubound(SrcRotParameterTypeData%TwrTI) + if (.not. allocated(DstRotParameterTypeData%TwrTI)) then + allocate(DstRotParameterTypeData%TwrTI(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%TwrTI.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotParameterTypeData%TwrTI = SrcRotParameterTypeData%TwrTI + end if + if (allocated(SrcRotParameterTypeData%BlTwist)) then + LB(1:2) = lbound(SrcRotParameterTypeData%BlTwist) + UB(1:2) = ubound(SrcRotParameterTypeData%BlTwist) + if (.not. allocated(DstRotParameterTypeData%BlTwist)) then + allocate(DstRotParameterTypeData%BlTwist(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%BlTwist.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotParameterTypeData%BlTwist = SrcRotParameterTypeData%BlTwist + end if + if (allocated(SrcRotParameterTypeData%TwrCb)) then + LB(1:1) = lbound(SrcRotParameterTypeData%TwrCb) + UB(1:1) = ubound(SrcRotParameterTypeData%TwrCb) + if (.not. allocated(DstRotParameterTypeData%TwrCb)) then + allocate(DstRotParameterTypeData%TwrCb(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%TwrCb.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotParameterTypeData%TwrCb = SrcRotParameterTypeData%TwrCb + end if + if (allocated(SrcRotParameterTypeData%BlCenBn)) then + LB(1:2) = lbound(SrcRotParameterTypeData%BlCenBn) + UB(1:2) = ubound(SrcRotParameterTypeData%BlCenBn) + if (.not. allocated(DstRotParameterTypeData%BlCenBn)) then + allocate(DstRotParameterTypeData%BlCenBn(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%BlCenBn.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotParameterTypeData%BlCenBn = SrcRotParameterTypeData%BlCenBn + end if + if (allocated(SrcRotParameterTypeData%BlCenBt)) then + LB(1:2) = lbound(SrcRotParameterTypeData%BlCenBt) + UB(1:2) = ubound(SrcRotParameterTypeData%BlCenBt) + if (.not. allocated(DstRotParameterTypeData%BlCenBt)) then + allocate(DstRotParameterTypeData%BlCenBt(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%BlCenBt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotParameterTypeData%BlCenBt = SrcRotParameterTypeData%BlCenBt + end if + DstRotParameterTypeData%VolHub = SrcRotParameterTypeData%VolHub + DstRotParameterTypeData%HubCenBx = SrcRotParameterTypeData%HubCenBx + DstRotParameterTypeData%VolNac = SrcRotParameterTypeData%VolNac + DstRotParameterTypeData%NacCenB = SrcRotParameterTypeData%NacCenB + DstRotParameterTypeData%NacArea = SrcRotParameterTypeData%NacArea + DstRotParameterTypeData%NacCd = SrcRotParameterTypeData%NacCd + DstRotParameterTypeData%NacDragAC = SrcRotParameterTypeData%NacDragAC + DstRotParameterTypeData%VolBl = SrcRotParameterTypeData%VolBl + DstRotParameterTypeData%VolTwr = SrcRotParameterTypeData%VolTwr + if (allocated(SrcRotParameterTypeData%BlRad)) then + LB(1:2) = lbound(SrcRotParameterTypeData%BlRad) + UB(1:2) = ubound(SrcRotParameterTypeData%BlRad) + if (.not. allocated(DstRotParameterTypeData%BlRad)) then + allocate(DstRotParameterTypeData%BlRad(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%BlRad.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotParameterTypeData%BlRad = SrcRotParameterTypeData%BlRad + end if + if (allocated(SrcRotParameterTypeData%BlDL)) then + LB(1:2) = lbound(SrcRotParameterTypeData%BlDL) + UB(1:2) = ubound(SrcRotParameterTypeData%BlDL) + if (.not. allocated(DstRotParameterTypeData%BlDL)) then + allocate(DstRotParameterTypeData%BlDL(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%BlDL.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotParameterTypeData%BlDL = SrcRotParameterTypeData%BlDL + end if + if (allocated(SrcRotParameterTypeData%BlTaper)) then + LB(1:2) = lbound(SrcRotParameterTypeData%BlTaper) + UB(1:2) = ubound(SrcRotParameterTypeData%BlTaper) + if (.not. allocated(DstRotParameterTypeData%BlTaper)) then + allocate(DstRotParameterTypeData%BlTaper(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%BlTaper.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotParameterTypeData%BlTaper = SrcRotParameterTypeData%BlTaper + end if + if (allocated(SrcRotParameterTypeData%BlAxCent)) then + LB(1:2) = lbound(SrcRotParameterTypeData%BlAxCent) + UB(1:2) = ubound(SrcRotParameterTypeData%BlAxCent) + if (.not. allocated(DstRotParameterTypeData%BlAxCent)) then + allocate(DstRotParameterTypeData%BlAxCent(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%BlAxCent.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotParameterTypeData%BlAxCent = SrcRotParameterTypeData%BlAxCent + end if + if (allocated(SrcRotParameterTypeData%TwrRad)) then + LB(1:1) = lbound(SrcRotParameterTypeData%TwrRad) + UB(1:1) = ubound(SrcRotParameterTypeData%TwrRad) + if (.not. allocated(DstRotParameterTypeData%TwrRad)) then + allocate(DstRotParameterTypeData%TwrRad(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%TwrRad.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotParameterTypeData%TwrRad = SrcRotParameterTypeData%TwrRad + end if + if (allocated(SrcRotParameterTypeData%TwrDL)) then + LB(1:1) = lbound(SrcRotParameterTypeData%TwrDL) + UB(1:1) = ubound(SrcRotParameterTypeData%TwrDL) + if (.not. allocated(DstRotParameterTypeData%TwrDL)) then + allocate(DstRotParameterTypeData%TwrDL(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%TwrDL.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotParameterTypeData%TwrDL = SrcRotParameterTypeData%TwrDL + end if + if (allocated(SrcRotParameterTypeData%TwrTaper)) then + LB(1:1) = lbound(SrcRotParameterTypeData%TwrTaper) + UB(1:1) = ubound(SrcRotParameterTypeData%TwrTaper) + if (.not. allocated(DstRotParameterTypeData%TwrTaper)) then + allocate(DstRotParameterTypeData%TwrTaper(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%TwrTaper.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotParameterTypeData%TwrTaper = SrcRotParameterTypeData%TwrTaper + end if + if (allocated(SrcRotParameterTypeData%TwrAxCent)) then + LB(1:1) = lbound(SrcRotParameterTypeData%TwrAxCent) + UB(1:1) = ubound(SrcRotParameterTypeData%TwrAxCent) + if (.not. allocated(DstRotParameterTypeData%TwrAxCent)) then + allocate(DstRotParameterTypeData%TwrAxCent(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%TwrAxCent.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotParameterTypeData%TwrAxCent = SrcRotParameterTypeData%TwrAxCent + end if + call BEMT_CopyParam(SrcRotParameterTypeData%BEMT, DstRotParameterTypeData%BEMT, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AA_CopyParam(SrcRotParameterTypeData%AA, DstRotParameterTypeData%AA, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcRotParameterTypeData%Jac_u_indx)) then + LB(1:2) = lbound(SrcRotParameterTypeData%Jac_u_indx) + UB(1:2) = ubound(SrcRotParameterTypeData%Jac_u_indx) + if (.not. allocated(DstRotParameterTypeData%Jac_u_indx)) then + allocate(DstRotParameterTypeData%Jac_u_indx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%Jac_u_indx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotParameterTypeData%Jac_u_indx = SrcRotParameterTypeData%Jac_u_indx + end if + call AD_CopyJac_u_idxStarts(SrcRotParameterTypeData%Jac_u_idxStartList, DstRotParameterTypeData%Jac_u_idxStartList, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AD_CopyJac_y_idxStarts(SrcRotParameterTypeData%Jac_y_idxStartList, DstRotParameterTypeData%Jac_y_idxStartList, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstRotParameterTypeData%NumExtendedInputs = SrcRotParameterTypeData%NumExtendedInputs + if (allocated(SrcRotParameterTypeData%du)) then + LB(1:1) = lbound(SrcRotParameterTypeData%du) + UB(1:1) = ubound(SrcRotParameterTypeData%du) + if (.not. allocated(DstRotParameterTypeData%du)) then + allocate(DstRotParameterTypeData%du(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%du.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotParameterTypeData%du = SrcRotParameterTypeData%du + end if + if (allocated(SrcRotParameterTypeData%dx)) then + LB(1:1) = lbound(SrcRotParameterTypeData%dx) + UB(1:1) = ubound(SrcRotParameterTypeData%dx) + if (.not. allocated(DstRotParameterTypeData%dx)) then + allocate(DstRotParameterTypeData%dx(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%dx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotParameterTypeData%dx = SrcRotParameterTypeData%dx + end if + DstRotParameterTypeData%Jac_ny = SrcRotParameterTypeData%Jac_ny + DstRotParameterTypeData%NumBl_Lin = SrcRotParameterTypeData%NumBl_Lin + DstRotParameterTypeData%TwrPotent = SrcRotParameterTypeData%TwrPotent + DstRotParameterTypeData%TwrShadow = SrcRotParameterTypeData%TwrShadow + DstRotParameterTypeData%TwrAero = SrcRotParameterTypeData%TwrAero + DstRotParameterTypeData%DBEMT_Mod = SrcRotParameterTypeData%DBEMT_Mod + DstRotParameterTypeData%CavitCheck = SrcRotParameterTypeData%CavitCheck + DstRotParameterTypeData%Buoyancy = SrcRotParameterTypeData%Buoyancy + DstRotParameterTypeData%NacelleDrag = SrcRotParameterTypeData%NacelleDrag + DstRotParameterTypeData%MHK = SrcRotParameterTypeData%MHK + DstRotParameterTypeData%CompAA = SrcRotParameterTypeData%CompAA + DstRotParameterTypeData%AirDens = SrcRotParameterTypeData%AirDens + DstRotParameterTypeData%KinVisc = SrcRotParameterTypeData%KinVisc + DstRotParameterTypeData%SpdSound = SrcRotParameterTypeData%SpdSound + DstRotParameterTypeData%Gravity = SrcRotParameterTypeData%Gravity + DstRotParameterTypeData%Patm = SrcRotParameterTypeData%Patm + DstRotParameterTypeData%Pvap = SrcRotParameterTypeData%Pvap + DstRotParameterTypeData%WtrDpth = SrcRotParameterTypeData%WtrDpth + DstRotParameterTypeData%MSL2SWL = SrcRotParameterTypeData%MSL2SWL + DstRotParameterTypeData%AeroProjMod = SrcRotParameterTypeData%AeroProjMod + DstRotParameterTypeData%BEM_Mod = SrcRotParameterTypeData%BEM_Mod + DstRotParameterTypeData%NumOuts = SrcRotParameterTypeData%NumOuts + DstRotParameterTypeData%RootName = SrcRotParameterTypeData%RootName + if (allocated(SrcRotParameterTypeData%OutParam)) then + LB(1:1) = lbound(SrcRotParameterTypeData%OutParam) + UB(1:1) = ubound(SrcRotParameterTypeData%OutParam) + if (.not. allocated(DstRotParameterTypeData%OutParam)) then + allocate(DstRotParameterTypeData%OutParam(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%OutParam.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyOutParmType(SrcRotParameterTypeData%OutParam(i1), DstRotParameterTypeData%OutParam(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + DstRotParameterTypeData%NBlOuts = SrcRotParameterTypeData%NBlOuts + DstRotParameterTypeData%BlOutNd = SrcRotParameterTypeData%BlOutNd + DstRotParameterTypeData%NTwOuts = SrcRotParameterTypeData%NTwOuts + DstRotParameterTypeData%TwOutNd = SrcRotParameterTypeData%TwOutNd + DstRotParameterTypeData%BldNd_NumOuts = SrcRotParameterTypeData%BldNd_NumOuts + DstRotParameterTypeData%BldNd_TotNumOuts = SrcRotParameterTypeData%BldNd_TotNumOuts + if (allocated(SrcRotParameterTypeData%BldNd_OutParam)) then + LB(1:1) = lbound(SrcRotParameterTypeData%BldNd_OutParam) + UB(1:1) = ubound(SrcRotParameterTypeData%BldNd_OutParam) + if (.not. allocated(DstRotParameterTypeData%BldNd_OutParam)) then + allocate(DstRotParameterTypeData%BldNd_OutParam(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%BldNd_OutParam.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyOutParmType(SrcRotParameterTypeData%BldNd_OutParam(i1), DstRotParameterTypeData%BldNd_OutParam(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcRotParameterTypeData%BldNd_BlOutNd)) then + LB(1:1) = lbound(SrcRotParameterTypeData%BldNd_BlOutNd) + UB(1:1) = ubound(SrcRotParameterTypeData%BldNd_BlOutNd) + if (.not. allocated(DstRotParameterTypeData%BldNd_BlOutNd)) then + allocate(DstRotParameterTypeData%BldNd_BlOutNd(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%BldNd_BlOutNd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotParameterTypeData%BldNd_BlOutNd = SrcRotParameterTypeData%BldNd_BlOutNd + end if + DstRotParameterTypeData%BldNd_BladesOut = SrcRotParameterTypeData%BldNd_BladesOut + DstRotParameterTypeData%BldNd_NumNodesOut = SrcRotParameterTypeData%BldNd_NumNodesOut + DstRotParameterTypeData%TFinAero = SrcRotParameterTypeData%TFinAero + call AD_CopyTFinParameterType(SrcRotParameterTypeData%TFin, DstRotParameterTypeData%TFin, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine AD_DestroyRotParameterType(RotParameterTypeData, ErrStat, ErrMsg) + type(RotParameterType), intent(inout) :: RotParameterTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_DestroyRotParameterType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(RotParameterTypeData%TwrDiam)) then + deallocate(RotParameterTypeData%TwrDiam) + end if + if (allocated(RotParameterTypeData%TwrCd)) then + deallocate(RotParameterTypeData%TwrCd) + end if + if (allocated(RotParameterTypeData%TwrTI)) then + deallocate(RotParameterTypeData%TwrTI) + end if + if (allocated(RotParameterTypeData%BlTwist)) then + deallocate(RotParameterTypeData%BlTwist) + end if + if (allocated(RotParameterTypeData%TwrCb)) then + deallocate(RotParameterTypeData%TwrCb) + end if + if (allocated(RotParameterTypeData%BlCenBn)) then + deallocate(RotParameterTypeData%BlCenBn) + end if + if (allocated(RotParameterTypeData%BlCenBt)) then + deallocate(RotParameterTypeData%BlCenBt) + end if + if (allocated(RotParameterTypeData%BlRad)) then + deallocate(RotParameterTypeData%BlRad) + end if + if (allocated(RotParameterTypeData%BlDL)) then + deallocate(RotParameterTypeData%BlDL) + end if + if (allocated(RotParameterTypeData%BlTaper)) then + deallocate(RotParameterTypeData%BlTaper) + end if + if (allocated(RotParameterTypeData%BlAxCent)) then + deallocate(RotParameterTypeData%BlAxCent) + end if + if (allocated(RotParameterTypeData%TwrRad)) then + deallocate(RotParameterTypeData%TwrRad) + end if + if (allocated(RotParameterTypeData%TwrDL)) then + deallocate(RotParameterTypeData%TwrDL) + end if + if (allocated(RotParameterTypeData%TwrTaper)) then + deallocate(RotParameterTypeData%TwrTaper) + end if + if (allocated(RotParameterTypeData%TwrAxCent)) then + deallocate(RotParameterTypeData%TwrAxCent) + end if + call BEMT_DestroyParam(RotParameterTypeData%BEMT, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AA_DestroyParam(RotParameterTypeData%AA, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(RotParameterTypeData%Jac_u_indx)) then + deallocate(RotParameterTypeData%Jac_u_indx) + end if + call AD_DestroyJac_u_idxStarts(RotParameterTypeData%Jac_u_idxStartList, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AD_DestroyJac_y_idxStarts(RotParameterTypeData%Jac_y_idxStartList, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(RotParameterTypeData%du)) then + deallocate(RotParameterTypeData%du) + end if + if (allocated(RotParameterTypeData%dx)) then + deallocate(RotParameterTypeData%dx) + end if + if (allocated(RotParameterTypeData%OutParam)) then + LB(1:1) = lbound(RotParameterTypeData%OutParam) + UB(1:1) = ubound(RotParameterTypeData%OutParam) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyOutParmType(RotParameterTypeData%OutParam(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(RotParameterTypeData%OutParam) + end if + if (allocated(RotParameterTypeData%BldNd_OutParam)) then + LB(1:1) = lbound(RotParameterTypeData%BldNd_OutParam) + UB(1:1) = ubound(RotParameterTypeData%BldNd_OutParam) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyOutParmType(RotParameterTypeData%BldNd_OutParam(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(RotParameterTypeData%BldNd_OutParam) + end if + if (allocated(RotParameterTypeData%BldNd_BlOutNd)) then + deallocate(RotParameterTypeData%BldNd_BlOutNd) + end if + call AD_DestroyTFinParameterType(RotParameterTypeData%TFin, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine AD_PackRotParameterType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(RotParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_PackRotParameterType' + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%NumBlades) + call RegPack(RF, InData%NumBlNds) + call RegPack(RF, InData%NumTwrNds) + call RegPackAlloc(RF, InData%TwrDiam) + call RegPackAlloc(RF, InData%TwrCd) + call RegPackAlloc(RF, InData%TwrTI) + call RegPackAlloc(RF, InData%BlTwist) + call RegPackAlloc(RF, InData%TwrCb) + call RegPackAlloc(RF, InData%BlCenBn) + call RegPackAlloc(RF, InData%BlCenBt) + call RegPack(RF, InData%VolHub) + call RegPack(RF, InData%HubCenBx) + call RegPack(RF, InData%VolNac) + call RegPack(RF, InData%NacCenB) + call RegPack(RF, InData%NacArea) + call RegPack(RF, InData%NacCd) + call RegPack(RF, InData%NacDragAC) + call RegPack(RF, InData%VolBl) + call RegPack(RF, InData%VolTwr) + call RegPackAlloc(RF, InData%BlRad) + call RegPackAlloc(RF, InData%BlDL) + call RegPackAlloc(RF, InData%BlTaper) + call RegPackAlloc(RF, InData%BlAxCent) + call RegPackAlloc(RF, InData%TwrRad) + call RegPackAlloc(RF, InData%TwrDL) + call RegPackAlloc(RF, InData%TwrTaper) + call RegPackAlloc(RF, InData%TwrAxCent) + call BEMT_PackParam(RF, InData%BEMT) + call AA_PackParam(RF, InData%AA) + call RegPackAlloc(RF, InData%Jac_u_indx) + call AD_PackJac_u_idxStarts(RF, InData%Jac_u_idxStartList) + call AD_PackJac_y_idxStarts(RF, InData%Jac_y_idxStartList) + call RegPack(RF, InData%NumExtendedInputs) + call RegPackAlloc(RF, InData%du) + call RegPackAlloc(RF, InData%dx) + call RegPack(RF, InData%Jac_ny) + call RegPack(RF, InData%NumBl_Lin) + call RegPack(RF, InData%TwrPotent) + call RegPack(RF, InData%TwrShadow) + call RegPack(RF, InData%TwrAero) + call RegPack(RF, InData%DBEMT_Mod) + call RegPack(RF, InData%CavitCheck) + call RegPack(RF, InData%Buoyancy) + call RegPack(RF, InData%NacelleDrag) + call RegPack(RF, InData%MHK) + call RegPack(RF, InData%CompAA) + call RegPack(RF, InData%AirDens) + call RegPack(RF, InData%KinVisc) + call RegPack(RF, InData%SpdSound) + call RegPack(RF, InData%Gravity) + call RegPack(RF, InData%Patm) + call RegPack(RF, InData%Pvap) + call RegPack(RF, InData%WtrDpth) + call RegPack(RF, InData%MSL2SWL) + call RegPack(RF, InData%AeroProjMod) + call RegPack(RF, InData%BEM_Mod) + call RegPack(RF, InData%NumOuts) + call RegPack(RF, InData%RootName) + call RegPack(RF, allocated(InData%OutParam)) + if (allocated(InData%OutParam)) then + call RegPackBounds(RF, 1, lbound(InData%OutParam), ubound(InData%OutParam)) + LB(1:1) = lbound(InData%OutParam) + UB(1:1) = ubound(InData%OutParam) + do i1 = LB(1), UB(1) + call NWTC_Library_PackOutParmType(RF, InData%OutParam(i1)) + end do + end if + call RegPack(RF, InData%NBlOuts) + call RegPack(RF, InData%BlOutNd) + call RegPack(RF, InData%NTwOuts) + call RegPack(RF, InData%TwOutNd) + call RegPack(RF, InData%BldNd_NumOuts) + call RegPack(RF, InData%BldNd_TotNumOuts) + call RegPack(RF, allocated(InData%BldNd_OutParam)) + if (allocated(InData%BldNd_OutParam)) then + call RegPackBounds(RF, 1, lbound(InData%BldNd_OutParam), ubound(InData%BldNd_OutParam)) + LB(1:1) = lbound(InData%BldNd_OutParam) + UB(1:1) = ubound(InData%BldNd_OutParam) + do i1 = LB(1), UB(1) + call NWTC_Library_PackOutParmType(RF, InData%BldNd_OutParam(i1)) + end do + end if + call RegPackAlloc(RF, InData%BldNd_BlOutNd) + call RegPack(RF, InData%BldNd_BladesOut) + call RegPack(RF, InData%BldNd_NumNodesOut) + call RegPack(RF, InData%TFinAero) + call AD_PackTFinParameterType(RF, InData%TFin) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AD_UnPackRotParameterType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(RotParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_UnPackRotParameterType' + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%NumBlades); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumBlNds); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumTwrNds); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TwrDiam); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TwrCd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TwrTI); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BlTwist); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TwrCb); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BlCenBn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BlCenBt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VolHub); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HubCenBx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VolNac); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NacCenB); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NacArea); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NacCd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NacDragAC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VolBl); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VolTwr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BlRad); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BlDL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BlTaper); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BlAxCent); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TwrRad); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TwrDL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TwrTaper); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TwrAxCent); if (RegCheckErr(RF, RoutineName)) return + call BEMT_UnpackParam(RF, OutData%BEMT) ! BEMT + call AA_UnpackParam(RF, OutData%AA) ! AA + call RegUnpackAlloc(RF, OutData%Jac_u_indx); if (RegCheckErr(RF, RoutineName)) return + call AD_UnpackJac_u_idxStarts(RF, OutData%Jac_u_idxStartList) ! Jac_u_idxStartList + call AD_UnpackJac_y_idxStarts(RF, OutData%Jac_y_idxStartList) ! Jac_y_idxStartList + call RegUnpack(RF, OutData%NumExtendedInputs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%du); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Jac_ny); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumBl_Lin); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TwrPotent); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TwrShadow); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TwrAero); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DBEMT_Mod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CavitCheck); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Buoyancy); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NacelleDrag); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MHK); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CompAA); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AirDens); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%KinVisc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SpdSound); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Gravity); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Patm); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Pvap); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WtrDpth); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MSL2SWL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AeroProjMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BEM_Mod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumOuts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RootName); if (RegCheckErr(RF, RoutineName)) return + if (allocated(OutData%OutParam)) deallocate(OutData%OutParam) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%OutParam(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackOutParmType(RF, OutData%OutParam(i1)) ! OutParam + end do + end if + call RegUnpack(RF, OutData%NBlOuts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BlOutNd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NTwOuts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TwOutNd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BldNd_NumOuts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BldNd_TotNumOuts); if (RegCheckErr(RF, RoutineName)) return + if (allocated(OutData%BldNd_OutParam)) deallocate(OutData%BldNd_OutParam) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%BldNd_OutParam(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldNd_OutParam.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackOutParmType(RF, OutData%BldNd_OutParam(i1)) ! BldNd_OutParam + end do + end if + call RegUnpackAlloc(RF, OutData%BldNd_BlOutNd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BldNd_BladesOut); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BldNd_NumNodesOut); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFinAero); if (RegCheckErr(RF, RoutineName)) return + call AD_UnpackTFinParameterType(RF, OutData%TFin) ! TFin +end subroutine + +subroutine AD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(AD_ParameterType), intent(in) :: SrcParamData + type(AD_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_CopyParam' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcParamData%rotors)) then + LB(1:1) = lbound(SrcParamData%rotors) + UB(1:1) = ubound(SrcParamData%rotors) + if (.not. allocated(DstParamData%rotors)) then + allocate(DstParamData%rotors(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rotors.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AD_CopyRotParameterType(SrcParamData%rotors(i1), DstParamData%rotors(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + DstParamData%DT = SrcParamData%DT + DstParamData%RootName = SrcParamData%RootName + if (allocated(SrcParamData%AFI)) then + LB(1:1) = lbound(SrcParamData%AFI) + UB(1:1) = ubound(SrcParamData%AFI) + if (.not. allocated(DstParamData%AFI)) then + allocate(DstParamData%AFI(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AFI.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AFI_CopyParam(SrcParamData%AFI(i1), DstParamData%AFI(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + DstParamData%Skew_Mod = SrcParamData%Skew_Mod + DstParamData%Wake_Mod = SrcParamData%Wake_Mod + call FVW_CopyParam(SrcParamData%FVW, DstParamData%FVW, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstParamData%CompAeroMaps = SrcParamData%CompAeroMaps + DstParamData%UA_Flag = SrcParamData%UA_Flag + DstParamData%FlowField => SrcParamData%FlowField + DstParamData%SectAvg = SrcParamData%SectAvg + DstParamData%SA_Weighting = SrcParamData%SA_Weighting + DstParamData%SA_PsiBwd = SrcParamData%SA_PsiBwd + DstParamData%SA_PsiFwd = SrcParamData%SA_PsiFwd + DstParamData%SA_nPerSec = SrcParamData%SA_nPerSec +end subroutine + +subroutine AD_DestroyParam(ParamData, ErrStat, ErrMsg) + type(AD_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ParamData%rotors)) then + LB(1:1) = lbound(ParamData%rotors) + UB(1:1) = ubound(ParamData%rotors) + do i1 = LB(1), UB(1) + call AD_DestroyRotParameterType(ParamData%rotors(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%rotors) + end if + if (allocated(ParamData%AFI)) then + LB(1:1) = lbound(ParamData%AFI) + UB(1:1) = ubound(ParamData%AFI) + do i1 = LB(1), UB(1) + call AFI_DestroyParam(ParamData%AFI(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%AFI) + end if + call FVW_DestroyParam(ParamData%FVW, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + nullify(ParamData%FlowField) +end subroutine + +subroutine AD_PackParam(RF, Indata) + type(RegFile), intent(inout) :: RF + type(AD_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_PackParam' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + logical :: PtrInIndex + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%rotors)) + if (allocated(InData%rotors)) then + call RegPackBounds(RF, 1, lbound(InData%rotors), ubound(InData%rotors)) + LB(1:1) = lbound(InData%rotors) + UB(1:1) = ubound(InData%rotors) + do i1 = LB(1), UB(1) + call AD_PackRotParameterType(RF, InData%rotors(i1)) + end do + end if + call RegPack(RF, InData%DT) + call RegPack(RF, InData%RootName) + call RegPack(RF, allocated(InData%AFI)) + if (allocated(InData%AFI)) then + call RegPackBounds(RF, 1, lbound(InData%AFI), ubound(InData%AFI)) + LB(1:1) = lbound(InData%AFI) + UB(1:1) = ubound(InData%AFI) + do i1 = LB(1), UB(1) + call AFI_PackParam(RF, InData%AFI(i1)) + end do + end if + call RegPack(RF, InData%Skew_Mod) + call RegPack(RF, InData%Wake_Mod) + call FVW_PackParam(RF, InData%FVW) + call RegPack(RF, InData%CompAeroMaps) + call RegPack(RF, InData%UA_Flag) + call RegPack(RF, associated(InData%FlowField)) + if (associated(InData%FlowField)) then + call RegPackPointer(RF, c_loc(InData%FlowField), PtrInIndex) + if (.not. PtrInIndex) then + call IfW_FlowField_PackFlowFieldType(RF, InData%FlowField) + end if + end if + call RegPack(RF, InData%SectAvg) + call RegPack(RF, InData%SA_Weighting) + call RegPack(RF, InData%SA_PsiBwd) + call RegPack(RF, InData%SA_PsiFwd) + call RegPack(RF, InData%SA_nPerSec) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AD_UnPackParam(RF, OutData) + type(RegFile), intent(inout) :: RF + type(AD_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_UnPackParam' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(B8Ki) :: PtrIdx + type(c_ptr) :: Ptr + if (RF%ErrStat /= ErrID_None) return + if (allocated(OutData%rotors)) deallocate(OutData%rotors) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%rotors(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotors.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AD_UnpackRotParameterType(RF, OutData%rotors(i1)) ! rotors + end do + end if + call RegUnpack(RF, OutData%DT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RootName); if (RegCheckErr(RF, RoutineName)) return + if (allocated(OutData%AFI)) deallocate(OutData%AFI) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%AFI(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AFI.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AFI_UnpackParam(RF, OutData%AFI(i1)) ! AFI + end do + end if + call RegUnpack(RF, OutData%Skew_Mod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Wake_Mod); if (RegCheckErr(RF, RoutineName)) return + call FVW_UnpackParam(RF, OutData%FVW) ! FVW + call RegUnpack(RF, OutData%CompAeroMaps); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UA_Flag); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%FlowField)) deallocate(OutData%FlowField) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackPointer(RF, Ptr, PtrIdx); if (RegCheckErr(RF, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%FlowField) + else + allocate(OutData%FlowField,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FlowField.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + RF%Pointers(PtrIdx) = c_loc(OutData%FlowField) + call IfW_FlowField_UnpackFlowFieldType(RF, OutData%FlowField) ! FlowField + end if + else + OutData%FlowField => null() + end if + call RegUnpack(RF, OutData%SectAvg); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SA_Weighting); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SA_PsiBwd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SA_PsiFwd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SA_nPerSec); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AD_CopyRotInputType(SrcRotInputTypeData, DstRotInputTypeData, CtrlCode, ErrStat, ErrMsg) + type(RotInputType), intent(inout) :: SrcRotInputTypeData + type(RotInputType), intent(inout) :: DstRotInputTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_CopyRotInputType' + ErrStat = ErrID_None + ErrMsg = '' + call MeshCopy(SrcRotInputTypeData%NacelleMotion, DstRotInputTypeData%NacelleMotion, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcRotInputTypeData%TowerMotion, DstRotInputTypeData%TowerMotion, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcRotInputTypeData%HubMotion, DstRotInputTypeData%HubMotion, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcRotInputTypeData%BladeRootMotion)) then + LB(1:1) = lbound(SrcRotInputTypeData%BladeRootMotion) + UB(1:1) = ubound(SrcRotInputTypeData%BladeRootMotion) + if (.not. allocated(DstRotInputTypeData%BladeRootMotion)) then + allocate(DstRotInputTypeData%BladeRootMotion(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotInputTypeData%BladeRootMotion.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MeshCopy(SrcRotInputTypeData%BladeRootMotion(i1), DstRotInputTypeData%BladeRootMotion(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcRotInputTypeData%BladeMotion)) then + LB(1:1) = lbound(SrcRotInputTypeData%BladeMotion) + UB(1:1) = ubound(SrcRotInputTypeData%BladeMotion) + if (.not. allocated(DstRotInputTypeData%BladeMotion)) then + allocate(DstRotInputTypeData%BladeMotion(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotInputTypeData%BladeMotion.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MeshCopy(SrcRotInputTypeData%BladeMotion(i1), DstRotInputTypeData%BladeMotion(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call MeshCopy(SrcRotInputTypeData%TFinMotion, DstRotInputTypeData%TFinMotion, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcRotInputTypeData%UserProp)) then + LB(1:2) = lbound(SrcRotInputTypeData%UserProp) + UB(1:2) = ubound(SrcRotInputTypeData%UserProp) + if (.not. allocated(DstRotInputTypeData%UserProp)) then + allocate(DstRotInputTypeData%UserProp(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotInputTypeData%UserProp.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotInputTypeData%UserProp = SrcRotInputTypeData%UserProp + end if +end subroutine + +subroutine AD_DestroyRotInputType(RotInputTypeData, ErrStat, ErrMsg) + type(RotInputType), intent(inout) :: RotInputTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_DestroyRotInputType' + ErrStat = ErrID_None + ErrMsg = '' + call MeshDestroy( RotInputTypeData%NacelleMotion, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( RotInputTypeData%TowerMotion, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( RotInputTypeData%HubMotion, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(RotInputTypeData%BladeRootMotion)) then + LB(1:1) = lbound(RotInputTypeData%BladeRootMotion) + UB(1:1) = ubound(RotInputTypeData%BladeRootMotion) + do i1 = LB(1), UB(1) + call MeshDestroy( RotInputTypeData%BladeRootMotion(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(RotInputTypeData%BladeRootMotion) + end if + if (allocated(RotInputTypeData%BladeMotion)) then + LB(1:1) = lbound(RotInputTypeData%BladeMotion) + UB(1:1) = ubound(RotInputTypeData%BladeMotion) + do i1 = LB(1), UB(1) + call MeshDestroy( RotInputTypeData%BladeMotion(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(RotInputTypeData%BladeMotion) + end if + call MeshDestroy( RotInputTypeData%TFinMotion, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(RotInputTypeData%UserProp)) then + deallocate(RotInputTypeData%UserProp) + end if +end subroutine + +subroutine AD_PackRotInputType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(RotInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_PackRotInputType' + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + if (RF%ErrStat >= AbortErrLev) return + call MeshPack(RF, InData%NacelleMotion) + call MeshPack(RF, InData%TowerMotion) + call MeshPack(RF, InData%HubMotion) + call RegPack(RF, allocated(InData%BladeRootMotion)) + if (allocated(InData%BladeRootMotion)) then + call RegPackBounds(RF, 1, lbound(InData%BladeRootMotion), ubound(InData%BladeRootMotion)) + LB(1:1) = lbound(InData%BladeRootMotion) + UB(1:1) = ubound(InData%BladeRootMotion) + do i1 = LB(1), UB(1) + call MeshPack(RF, InData%BladeRootMotion(i1)) + end do + end if + call RegPack(RF, allocated(InData%BladeMotion)) + if (allocated(InData%BladeMotion)) then + call RegPackBounds(RF, 1, lbound(InData%BladeMotion), ubound(InData%BladeMotion)) + LB(1:1) = lbound(InData%BladeMotion) + UB(1:1) = ubound(InData%BladeMotion) + do i1 = LB(1), UB(1) + call MeshPack(RF, InData%BladeMotion(i1)) + end do + end if + call MeshPack(RF, InData%TFinMotion) + call RegPackAlloc(RF, InData%UserProp) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AD_UnPackRotInputType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(RotInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_UnPackRotInputType' + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call MeshUnpack(RF, OutData%NacelleMotion) ! NacelleMotion + call MeshUnpack(RF, OutData%TowerMotion) ! TowerMotion + call MeshUnpack(RF, OutData%HubMotion) ! HubMotion + if (allocated(OutData%BladeRootMotion)) deallocate(OutData%BladeRootMotion) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%BladeRootMotion(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeRootMotion.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(RF, OutData%BladeRootMotion(i1)) ! BladeRootMotion + end do + end if + if (allocated(OutData%BladeMotion)) deallocate(OutData%BladeMotion) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%BladeMotion(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeMotion.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(RF, OutData%BladeMotion(i1)) ! BladeMotion + end do + end if + call MeshUnpack(RF, OutData%TFinMotion) ! TFinMotion + call RegUnpackAlloc(RF, OutData%UserProp); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) + type(AD_InputType), intent(inout) :: SrcInputData + type(AD_InputType), intent(inout) :: DstInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_CopyInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcInputData%rotors)) then + LB(1:1) = lbound(SrcInputData%rotors) + UB(1:1) = ubound(SrcInputData%rotors) + if (.not. allocated(DstInputData%rotors)) then + allocate(DstInputData%rotors(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%rotors.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AD_CopyRotInputType(SrcInputData%rotors(i1), DstInputData%rotors(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if +end subroutine + +subroutine AD_DestroyInput(InputData, ErrStat, ErrMsg) + type(AD_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_DestroyInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InputData%rotors)) then + LB(1:1) = lbound(InputData%rotors) + UB(1:1) = ubound(InputData%rotors) + do i1 = LB(1), UB(1) + call AD_DestroyRotInputType(InputData%rotors(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InputData%rotors) + end if +end subroutine + +subroutine AD_PackInput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(AD_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_PackInput' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%rotors)) + if (allocated(InData%rotors)) then + call RegPackBounds(RF, 1, lbound(InData%rotors), ubound(InData%rotors)) + LB(1:1) = lbound(InData%rotors) + UB(1:1) = ubound(InData%rotors) + do i1 = LB(1), UB(1) + call AD_PackRotInputType(RF, InData%rotors(i1)) + end do + end if + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AD_UnPackInput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(AD_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_UnPackInput' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + if (allocated(OutData%rotors)) deallocate(OutData%rotors) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%rotors(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotors.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AD_UnpackRotInputType(RF, OutData%rotors(i1)) ! rotors + end do + end if +end subroutine + +subroutine AD_CopyRotOutputType(SrcRotOutputTypeData, DstRotOutputTypeData, CtrlCode, ErrStat, ErrMsg) + type(RotOutputType), intent(inout) :: SrcRotOutputTypeData + type(RotOutputType), intent(inout) :: DstRotOutputTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_CopyRotOutputType' + ErrStat = ErrID_None + ErrMsg = '' + call MeshCopy(SrcRotOutputTypeData%NacelleLoad, DstRotOutputTypeData%NacelleLoad, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcRotOutputTypeData%HubLoad, DstRotOutputTypeData%HubLoad, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcRotOutputTypeData%TowerLoad, DstRotOutputTypeData%TowerLoad, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcRotOutputTypeData%BladeLoad)) then + LB(1:1) = lbound(SrcRotOutputTypeData%BladeLoad) + UB(1:1) = ubound(SrcRotOutputTypeData%BladeLoad) + if (.not. allocated(DstRotOutputTypeData%BladeLoad)) then + allocate(DstRotOutputTypeData%BladeLoad(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotOutputTypeData%BladeLoad.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MeshCopy(SrcRotOutputTypeData%BladeLoad(i1), DstRotOutputTypeData%BladeLoad(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call MeshCopy(SrcRotOutputTypeData%TFinLoad, DstRotOutputTypeData%TFinLoad, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcRotOutputTypeData%WriteOutput)) then + LB(1:1) = lbound(SrcRotOutputTypeData%WriteOutput) + UB(1:1) = ubound(SrcRotOutputTypeData%WriteOutput) + if (.not. allocated(DstRotOutputTypeData%WriteOutput)) then + allocate(DstRotOutputTypeData%WriteOutput(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotOutputTypeData%WriteOutput.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotOutputTypeData%WriteOutput = SrcRotOutputTypeData%WriteOutput + end if +end subroutine + +subroutine AD_DestroyRotOutputType(RotOutputTypeData, ErrStat, ErrMsg) + type(RotOutputType), intent(inout) :: RotOutputTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_DestroyRotOutputType' + ErrStat = ErrID_None + ErrMsg = '' + call MeshDestroy( RotOutputTypeData%NacelleLoad, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( RotOutputTypeData%HubLoad, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( RotOutputTypeData%TowerLoad, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(RotOutputTypeData%BladeLoad)) then + LB(1:1) = lbound(RotOutputTypeData%BladeLoad) + UB(1:1) = ubound(RotOutputTypeData%BladeLoad) + do i1 = LB(1), UB(1) + call MeshDestroy( RotOutputTypeData%BladeLoad(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(RotOutputTypeData%BladeLoad) + end if + call MeshDestroy( RotOutputTypeData%TFinLoad, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(RotOutputTypeData%WriteOutput)) then + deallocate(RotOutputTypeData%WriteOutput) + end if +end subroutine + +subroutine AD_PackRotOutputType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(RotOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_PackRotOutputType' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + if (RF%ErrStat >= AbortErrLev) return + call MeshPack(RF, InData%NacelleLoad) + call MeshPack(RF, InData%HubLoad) + call MeshPack(RF, InData%TowerLoad) + call RegPack(RF, allocated(InData%BladeLoad)) + if (allocated(InData%BladeLoad)) then + call RegPackBounds(RF, 1, lbound(InData%BladeLoad), ubound(InData%BladeLoad)) + LB(1:1) = lbound(InData%BladeLoad) + UB(1:1) = ubound(InData%BladeLoad) + do i1 = LB(1), UB(1) + call MeshPack(RF, InData%BladeLoad(i1)) + end do + end if + call MeshPack(RF, InData%TFinLoad) + call RegPackAlloc(RF, InData%WriteOutput) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AD_UnPackRotOutputType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(RotOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_UnPackRotOutputType' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call MeshUnpack(RF, OutData%NacelleLoad) ! NacelleLoad + call MeshUnpack(RF, OutData%HubLoad) ! HubLoad + call MeshUnpack(RF, OutData%TowerLoad) ! TowerLoad + if (allocated(OutData%BladeLoad)) deallocate(OutData%BladeLoad) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%BladeLoad(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeLoad.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(RF, OutData%BladeLoad(i1)) ! BladeLoad + end do + end if + call MeshUnpack(RF, OutData%TFinLoad) ! TFinLoad + call RegUnpackAlloc(RF, OutData%WriteOutput); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(AD_OutputType), intent(inout) :: SrcOutputData + type(AD_OutputType), intent(inout) :: DstOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_CopyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcOutputData%rotors)) then + LB(1:1) = lbound(SrcOutputData%rotors) + UB(1:1) = ubound(SrcOutputData%rotors) + if (.not. allocated(DstOutputData%rotors)) then + allocate(DstOutputData%rotors(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%rotors.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AD_CopyRotOutputType(SrcOutputData%rotors(i1), DstOutputData%rotors(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if +end subroutine + +subroutine AD_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(AD_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OutputData%rotors)) then + LB(1:1) = lbound(OutputData%rotors) + UB(1:1) = ubound(OutputData%rotors) + do i1 = LB(1), UB(1) + call AD_DestroyRotOutputType(OutputData%rotors(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(OutputData%rotors) + end if +end subroutine + +subroutine AD_PackOutput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(AD_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_PackOutput' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%rotors)) + if (allocated(InData%rotors)) then + call RegPackBounds(RF, 1, lbound(InData%rotors), ubound(InData%rotors)) + LB(1:1) = lbound(InData%rotors) + UB(1:1) = ubound(InData%rotors) + do i1 = LB(1), UB(1) + call AD_PackRotOutputType(RF, InData%rotors(i1)) + end do + end if + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AD_UnPackOutput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(AD_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_UnPackOutput' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + if (allocated(OutData%rotors)) deallocate(OutData%rotors) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%rotors(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotors.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AD_UnpackRotOutputType(RF, OutData%rotors(i1)) ! rotors + end do + end if +end subroutine + +subroutine AD_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(AD_InputType), intent(inout) :: u(:) ! Input at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Inputs + type(AD_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 = 'AD_Input_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(u)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(u)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(u) - 1 + select case (order) + case (0) + call AD_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call AD_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call AD_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(u) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE AD_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 +! +!.................................................................................................................................. - SUBROUTINE AD_CopyVTK_BLSurfaceType( SrcVTK_BLSurfaceTypeData, DstVTK_BLSurfaceTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AD_VTK_BLSurfaceType), INTENT(IN) :: SrcVTK_BLSurfaceTypeData - TYPE(AD_VTK_BLSurfaceType), INTENT(INOUT) :: DstVTK_BLSurfaceTypeData - 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 = 'AD_CopyVTK_BLSurfaceType' -! + TYPE(AD_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 + TYPE(AD_InputType), INTENT(INOUT) :: u2 ! Input at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs + TYPE(AD_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 = 'AD_Input_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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 :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 counter variable for arrays + ! Initialize ErrStat ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcVTK_BLSurfaceTypeData%AirfoilCoords)) THEN - i1_l = LBOUND(SrcVTK_BLSurfaceTypeData%AirfoilCoords,1) - i1_u = UBOUND(SrcVTK_BLSurfaceTypeData%AirfoilCoords,1) - i2_l = LBOUND(SrcVTK_BLSurfaceTypeData%AirfoilCoords,2) - i2_u = UBOUND(SrcVTK_BLSurfaceTypeData%AirfoilCoords,2) - i3_l = LBOUND(SrcVTK_BLSurfaceTypeData%AirfoilCoords,3) - i3_u = UBOUND(SrcVTK_BLSurfaceTypeData%AirfoilCoords,3) - IF (.NOT. ALLOCATED(DstVTK_BLSurfaceTypeData%AirfoilCoords)) THEN - ALLOCATE(DstVTK_BLSurfaceTypeData%AirfoilCoords(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_BLSurfaceTypeData%AirfoilCoords.', ErrStat, ErrMsg,RoutineName) + 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 - END IF - DstVTK_BLSurfaceTypeData%AirfoilCoords = SrcVTK_BLSurfaceTypeData%AirfoilCoords -ENDIF - END SUBROUTINE AD_CopyVTK_BLSurfaceType - - SUBROUTINE AD_DestroyVTK_BLSurfaceType( VTK_BLSurfaceTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(AD_VTK_BLSurfaceType), INTENT(INOUT) :: VTK_BLSurfaceTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_DestroyVTK_BLSurfaceType' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(VTK_BLSurfaceTypeData%AirfoilCoords)) THEN - DEALLOCATE(VTK_BLSurfaceTypeData%AirfoilCoords) -ENDIF - END SUBROUTINE AD_DestroyVTK_BLSurfaceType - - SUBROUTINE AD_PackVTK_BLSurfaceType( 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(AD_VTK_BLSurfaceType), 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 = 'AD_PackVTK_BLSurfaceType' - ! 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 ! AirfoilCoords allocated yes/no - IF ( ALLOCATED(InData%AirfoilCoords) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! AirfoilCoords upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AirfoilCoords) ! AirfoilCoords - 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%AirfoilCoords) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AirfoilCoords,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AirfoilCoords,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AirfoilCoords,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AirfoilCoords,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AirfoilCoords,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AirfoilCoords,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%AirfoilCoords,3), UBOUND(InData%AirfoilCoords,3) - DO i2 = LBOUND(InData%AirfoilCoords,2), UBOUND(InData%AirfoilCoords,2) - DO i1 = LBOUND(InData%AirfoilCoords,1), UBOUND(InData%AirfoilCoords,1) - ReKiBuf(Re_Xferred) = InData%AirfoilCoords(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO + END IF + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + IF (ALLOCATED(u_out%rotors) .AND. ALLOCATED(u1%rotors)) THEN + do i01 = lbound(u_out%rotors,1),ubound(u_out%rotors,1) + CALL MeshExtrapInterp1(u1%rotors(i01)%NacelleMotion, u2%rotors(i01)%NacelleMotion, tin, u_out%rotors(i01)%NacelleMotion, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + do i01 = lbound(u_out%rotors,1),ubound(u_out%rotors,1) + CALL MeshExtrapInterp1(u1%rotors(i01)%TowerMotion, u2%rotors(i01)%TowerMotion, tin, u_out%rotors(i01)%TowerMotion, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + do i01 = lbound(u_out%rotors,1),ubound(u_out%rotors,1) + CALL MeshExtrapInterp1(u1%rotors(i01)%HubMotion, u2%rotors(i01)%HubMotion, tin, u_out%rotors(i01)%HubMotion, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + do i01 = lbound(u_out%rotors,1),ubound(u_out%rotors,1) + IF (ALLOCATED(u_out%rotors(i01)%BladeRootMotion) .AND. ALLOCATED(u1%rotors(i01)%BladeRootMotion)) THEN + do i1 = lbound(u_out%rotors(i01)%BladeRootMotion,1),ubound(u_out%rotors(i01)%BladeRootMotion,1) + CALL MeshExtrapInterp1(u1%rotors(i01)%BladeRootMotion(i1), u2%rotors(i01)%BladeRootMotion(i1), tin, u_out%rotors(i01)%BladeRootMotion(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated END DO - END IF - END SUBROUTINE AD_PackVTK_BLSurfaceType - - SUBROUTINE AD_UnPackVTK_BLSurfaceType( 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(AD_VTK_BLSurfaceType), 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 = 'AD_UnPackVTK_BLSurfaceType' - ! 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 ! AirfoilCoords not allocated - Int_Xferred = Int_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%AirfoilCoords)) DEALLOCATE(OutData%AirfoilCoords) - ALLOCATE(OutData%AirfoilCoords(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%AirfoilCoords.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%AirfoilCoords,3), UBOUND(OutData%AirfoilCoords,3) - DO i2 = LBOUND(OutData%AirfoilCoords,2), UBOUND(OutData%AirfoilCoords,2) - DO i1 = LBOUND(OutData%AirfoilCoords,1), UBOUND(OutData%AirfoilCoords,1) - OutData%AirfoilCoords(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO + do i01 = lbound(u_out%rotors,1),ubound(u_out%rotors,1) + IF (ALLOCATED(u_out%rotors(i01)%BladeMotion) .AND. ALLOCATED(u1%rotors(i01)%BladeMotion)) THEN + do i1 = lbound(u_out%rotors(i01)%BladeMotion,1),ubound(u_out%rotors(i01)%BladeMotion,1) + CALL MeshExtrapInterp1(u1%rotors(i01)%BladeMotion(i1), u2%rotors(i01)%BladeMotion(i1), tin, u_out%rotors(i01)%BladeMotion(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated END DO - END IF - END SUBROUTINE AD_UnPackVTK_BLSurfaceType - - SUBROUTINE AD_CopyVTK_RotSurfaceType( SrcVTK_RotSurfaceTypeData, DstVTK_RotSurfaceTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AD_VTK_RotSurfaceType), INTENT(IN) :: SrcVTK_RotSurfaceTypeData - TYPE(AD_VTK_RotSurfaceType), INTENT(INOUT) :: DstVTK_RotSurfaceTypeData - 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 = 'AD_CopyVTK_RotSurfaceType' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcVTK_RotSurfaceTypeData%BladeShape)) THEN - i1_l = LBOUND(SrcVTK_RotSurfaceTypeData%BladeShape,1) - i1_u = UBOUND(SrcVTK_RotSurfaceTypeData%BladeShape,1) - IF (.NOT. ALLOCATED(DstVTK_RotSurfaceTypeData%BladeShape)) THEN - ALLOCATE(DstVTK_RotSurfaceTypeData%BladeShape(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_RotSurfaceTypeData%BladeShape.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcVTK_RotSurfaceTypeData%BladeShape,1), UBOUND(SrcVTK_RotSurfaceTypeData%BladeShape,1) - CALL AD_Copyvtk_blsurfacetype( SrcVTK_RotSurfaceTypeData%BladeShape(i1), DstVTK_RotSurfaceTypeData%BladeShape(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcVTK_RotSurfaceTypeData%TowerRad)) THEN - i1_l = LBOUND(SrcVTK_RotSurfaceTypeData%TowerRad,1) - i1_u = UBOUND(SrcVTK_RotSurfaceTypeData%TowerRad,1) - IF (.NOT. ALLOCATED(DstVTK_RotSurfaceTypeData%TowerRad)) THEN - ALLOCATE(DstVTK_RotSurfaceTypeData%TowerRad(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_RotSurfaceTypeData%TowerRad.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstVTK_RotSurfaceTypeData%TowerRad = SrcVTK_RotSurfaceTypeData%TowerRad -ENDIF - END SUBROUTINE AD_CopyVTK_RotSurfaceType - - SUBROUTINE AD_DestroyVTK_RotSurfaceType( VTK_RotSurfaceTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(AD_VTK_RotSurfaceType), INTENT(INOUT) :: VTK_RotSurfaceTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_DestroyVTK_RotSurfaceType' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(VTK_RotSurfaceTypeData%BladeShape)) THEN -DO i1 = LBOUND(VTK_RotSurfaceTypeData%BladeShape,1), UBOUND(VTK_RotSurfaceTypeData%BladeShape,1) - CALL AD_Destroyvtk_blsurfacetype( VTK_RotSurfaceTypeData%BladeShape(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(VTK_RotSurfaceTypeData%BladeShape) -ENDIF -IF (ALLOCATED(VTK_RotSurfaceTypeData%TowerRad)) THEN - DEALLOCATE(VTK_RotSurfaceTypeData%TowerRad) -ENDIF - END SUBROUTINE AD_DestroyVTK_RotSurfaceType - - SUBROUTINE AD_PackVTK_RotSurfaceType( 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(AD_VTK_RotSurfaceType), 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 = 'AD_PackVTK_RotSurfaceType' - ! 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 ! BladeShape allocated yes/no - IF ( ALLOCATED(InData%BladeShape) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BladeShape upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%BladeShape,1), UBOUND(InData%BladeShape,1) - Int_BufSz = Int_BufSz + 3 ! BladeShape: size of buffers for each call to pack subtype - CALL AD_Packvtk_blsurfacetype( Re_Buf, Db_Buf, Int_Buf, InData%BladeShape(i1), ErrStat2, ErrMsg2, .TRUE. ) ! BladeShape - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BladeShape - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BladeShape - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BladeShape - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! TowerRad allocated yes/no - IF ( ALLOCATED(InData%TowerRad) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TowerRad upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TowerRad) ! TowerRad - 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%BladeShape) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BladeShape,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BladeShape,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BladeShape,1), UBOUND(InData%BladeShape,1) - CALL AD_Packvtk_blsurfacetype( Re_Buf, Db_Buf, Int_Buf, InData%BladeShape(i1), ErrStat2, ErrMsg2, OnlySize ) ! BladeShape - 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%TowerRad) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TowerRad,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TowerRad,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TowerRad,1), UBOUND(InData%TowerRad,1) - ReKiBuf(Re_Xferred) = InData%TowerRad(i1) - Re_Xferred = Re_Xferred + 1 + do i01 = lbound(u_out%rotors,1),ubound(u_out%rotors,1) + CALL MeshExtrapInterp1(u1%rotors(i01)%TFinMotion, u2%rotors(i01)%TFinMotion, tin, u_out%rotors(i01)%TFinMotion, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO - END IF - END SUBROUTINE AD_PackVTK_RotSurfaceType - - SUBROUTINE AD_UnPackVTK_RotSurfaceType( 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(AD_VTK_RotSurfaceType), 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 = 'AD_UnPackVTK_RotSurfaceType' - ! 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 ! BladeShape not allocated - Int_Xferred = Int_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%BladeShape)) DEALLOCATE(OutData%BladeShape) - ALLOCATE(OutData%BladeShape(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeShape.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BladeShape,1), UBOUND(OutData%BladeShape,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 AD_Unpackvtk_blsurfacetype( Re_Buf, Db_Buf, Int_Buf, OutData%BladeShape(i1), ErrStat2, ErrMsg2 ) ! BladeShape - 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 ! TowerRad not allocated - Int_Xferred = Int_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%TowerRad)) DEALLOCATE(OutData%TowerRad) - ALLOCATE(OutData%TowerRad(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TowerRad.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TowerRad,1), UBOUND(OutData%TowerRad,1) - OutData%TowerRad(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 + do i01 = lbound(u_out%rotors,1),ubound(u_out%rotors,1) + IF (ALLOCATED(u_out%rotors(i01)%UserProp) .AND. ALLOCATED(u1%rotors(i01)%UserProp)) THEN + u_out%rotors(i01)%UserProp = a1*u1%rotors(i01)%UserProp + a2*u2%rotors(i01)%UserProp + END IF ! check if allocated END DO - END IF - END SUBROUTINE AD_UnPackVTK_RotSurfaceType + END IF ! check if allocated +END SUBROUTINE + +SUBROUTINE AD_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 +! +!.................................................................................................................................. - SUBROUTINE AD_CopyRotInitInputType( SrcRotInitInputTypeData, DstRotInitInputTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(RotInitInputType), INTENT(IN) :: SrcRotInitInputTypeData - TYPE(RotInitInputType), INTENT(INOUT) :: DstRotInitInputTypeData - 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 = 'AD_CopyRotInitInputType' -! + TYPE(AD_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 > t3 + TYPE(AD_InputType), INTENT(INOUT) :: u2 ! Input at t2 > t3 + TYPE(AD_InputType), INTENT(INOUT) :: u3 ! Input at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs + TYPE(AD_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) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'AD_Input_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 counter variable for arrays + ! Initialize ErrStat ErrStat = ErrID_None - ErrMsg = "" - DstRotInitInputTypeData%NumBlades = SrcRotInitInputTypeData%NumBlades - DstRotInitInputTypeData%HubPosition = SrcRotInitInputTypeData%HubPosition - DstRotInitInputTypeData%HubOrientation = SrcRotInitInputTypeData%HubOrientation -IF (ALLOCATED(SrcRotInitInputTypeData%BladeRootPosition)) THEN - i1_l = LBOUND(SrcRotInitInputTypeData%BladeRootPosition,1) - i1_u = UBOUND(SrcRotInitInputTypeData%BladeRootPosition,1) - i2_l = LBOUND(SrcRotInitInputTypeData%BladeRootPosition,2) - i2_u = UBOUND(SrcRotInitInputTypeData%BladeRootPosition,2) - IF (.NOT. ALLOCATED(DstRotInitInputTypeData%BladeRootPosition)) THEN - ALLOCATE(DstRotInitInputTypeData%BladeRootPosition(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotInitInputTypeData%BladeRootPosition.', ErrStat, ErrMsg,RoutineName) + 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 - END IF - DstRotInitInputTypeData%BladeRootPosition = SrcRotInitInputTypeData%BladeRootPosition -ENDIF -IF (ALLOCATED(SrcRotInitInputTypeData%BladeRootOrientation)) THEN - i1_l = LBOUND(SrcRotInitInputTypeData%BladeRootOrientation,1) - i1_u = UBOUND(SrcRotInitInputTypeData%BladeRootOrientation,1) - i2_l = LBOUND(SrcRotInitInputTypeData%BladeRootOrientation,2) - i2_u = UBOUND(SrcRotInitInputTypeData%BladeRootOrientation,2) - i3_l = LBOUND(SrcRotInitInputTypeData%BladeRootOrientation,3) - i3_u = UBOUND(SrcRotInitInputTypeData%BladeRootOrientation,3) - IF (.NOT. ALLOCATED(DstRotInitInputTypeData%BladeRootOrientation)) THEN - ALLOCATE(DstRotInitInputTypeData%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 DstRotInitInputTypeData%BladeRootOrientation.', ErrStat, ErrMsg,RoutineName) + 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 - END IF - END IF - DstRotInitInputTypeData%BladeRootOrientation = SrcRotInitInputTypeData%BladeRootOrientation -ENDIF - DstRotInitInputTypeData%NacellePosition = SrcRotInitInputTypeData%NacellePosition - DstRotInitInputTypeData%NacelleOrientation = SrcRotInitInputTypeData%NacelleOrientation - DstRotInitInputTypeData%AeroProjMod = SrcRotInitInputTypeData%AeroProjMod - DstRotInitInputTypeData%AeroBEM_Mod = SrcRotInitInputTypeData%AeroBEM_Mod - END SUBROUTINE AD_CopyRotInitInputType - - SUBROUTINE AD_DestroyRotInitInputType( RotInitInputTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(RotInitInputType), INTENT(INOUT) :: RotInitInputTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_DestroyRotInitInputType' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(RotInitInputTypeData%BladeRootPosition)) THEN - DEALLOCATE(RotInitInputTypeData%BladeRootPosition) -ENDIF -IF (ALLOCATED(RotInitInputTypeData%BladeRootOrientation)) THEN - DEALLOCATE(RotInitInputTypeData%BladeRootOrientation) -ENDIF - END SUBROUTINE AD_DestroyRotInitInputType - - SUBROUTINE AD_PackRotInitInputType( 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(RotInitInputType), 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 = 'AD_PackRotInitInputType' - ! 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 ! NumBlades - Re_BufSz = Re_BufSz + SIZE(InData%HubPosition) ! HubPosition - Db_BufSz = Db_BufSz + SIZE(InData%HubOrientation) ! HubOrientation - 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 - Db_BufSz = Db_BufSz + SIZE(InData%NacellePosition) ! NacellePosition - Db_BufSz = Db_BufSz + SIZE(InData%NacelleOrientation) ! NacelleOrientation - Int_BufSz = Int_BufSz + 1 ! AeroProjMod - Int_BufSz = Int_BufSz + 1 ! AeroBEM_Mod - 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%NumBlades - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%HubPosition,1), UBOUND(InData%HubPosition,1) - ReKiBuf(Re_Xferred) = InData%HubPosition(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i2 = LBOUND(InData%HubOrientation,2), UBOUND(InData%HubOrientation,2) - DO i1 = LBOUND(InData%HubOrientation,1), UBOUND(InData%HubOrientation,1) - DbKiBuf(Db_Xferred) = InData%HubOrientation(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - 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 - DO i1 = LBOUND(InData%NacellePosition,1), UBOUND(InData%NacellePosition,1) - DbKiBuf(Db_Xferred) = InData%NacellePosition(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i2 = LBOUND(InData%NacelleOrientation,2), UBOUND(InData%NacelleOrientation,2) - DO i1 = LBOUND(InData%NacelleOrientation,1), UBOUND(InData%NacelleOrientation,1) - DbKiBuf(Db_Xferred) = InData%NacelleOrientation(i1,i2) - Db_Xferred = Db_Xferred + 1 + 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 + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + IF (ALLOCATED(u_out%rotors) .AND. ALLOCATED(u1%rotors)) THEN + do i01 = lbound(u_out%rotors,1),ubound(u_out%rotors,1) + CALL MeshExtrapInterp2(u1%rotors(i01)%NacelleMotion, u2%rotors(i01)%NacelleMotion, u3%rotors(i01)%NacelleMotion, tin, u_out%rotors(i01)%NacelleMotion, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + do i01 = lbound(u_out%rotors,1),ubound(u_out%rotors,1) + CALL MeshExtrapInterp2(u1%rotors(i01)%TowerMotion, u2%rotors(i01)%TowerMotion, u3%rotors(i01)%TowerMotion, tin, u_out%rotors(i01)%TowerMotion, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + do i01 = lbound(u_out%rotors,1),ubound(u_out%rotors,1) + CALL MeshExtrapInterp2(u1%rotors(i01)%HubMotion, u2%rotors(i01)%HubMotion, u3%rotors(i01)%HubMotion, tin, u_out%rotors(i01)%HubMotion, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + do i01 = lbound(u_out%rotors,1),ubound(u_out%rotors,1) + IF (ALLOCATED(u_out%rotors(i01)%BladeRootMotion) .AND. ALLOCATED(u1%rotors(i01)%BladeRootMotion)) THEN + do i1 = lbound(u_out%rotors(i01)%BladeRootMotion,1),ubound(u_out%rotors(i01)%BladeRootMotion,1) + CALL MeshExtrapInterp2(u1%rotors(i01)%BladeRootMotion(i1), u2%rotors(i01)%BladeRootMotion(i1), u3%rotors(i01)%BladeRootMotion(i1), tin, u_out%rotors(i01)%BladeRootMotion(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated END DO - END DO - IntKiBuf(Int_Xferred) = InData%AeroProjMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%AeroBEM_Mod - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE AD_PackRotInitInputType + do i01 = lbound(u_out%rotors,1),ubound(u_out%rotors,1) + IF (ALLOCATED(u_out%rotors(i01)%BladeMotion) .AND. ALLOCATED(u1%rotors(i01)%BladeMotion)) THEN + do i1 = lbound(u_out%rotors(i01)%BladeMotion,1),ubound(u_out%rotors(i01)%BladeMotion,1) + CALL MeshExtrapInterp2(u1%rotors(i01)%BladeMotion(i1), u2%rotors(i01)%BladeMotion(i1), u3%rotors(i01)%BladeMotion(i1), tin, u_out%rotors(i01)%BladeMotion(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + END DO + do i01 = lbound(u_out%rotors,1),ubound(u_out%rotors,1) + CALL MeshExtrapInterp2(u1%rotors(i01)%TFinMotion, u2%rotors(i01)%TFinMotion, u3%rotors(i01)%TFinMotion, tin, u_out%rotors(i01)%TFinMotion, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + do i01 = lbound(u_out%rotors,1),ubound(u_out%rotors,1) + IF (ALLOCATED(u_out%rotors(i01)%UserProp) .AND. ALLOCATED(u1%rotors(i01)%UserProp)) THEN + u_out%rotors(i01)%UserProp = a1*u1%rotors(i01)%UserProp + a2*u2%rotors(i01)%UserProp + a3*u3%rotors(i01)%UserProp + END IF ! check if allocated + END DO + END IF ! check if allocated +END SUBROUTINE + +subroutine AD_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(AD_OutputType), intent(inout) :: y(:) ! Output at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Outputs + type(AD_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 = 'AD_Output_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(y)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(y)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(y) - 1 + select case (order) + case (0) + call AD_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call AD_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call AD_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(y) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE AD_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 +! +!.................................................................................................................................. - SUBROUTINE AD_UnPackRotInitInputType( 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(RotInitInputType), 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 = 'AD_UnPackRotInitInputType' - ! 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%NumBlades = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%HubPosition,1) - i1_u = UBOUND(OutData%HubPosition,1) - DO i1 = LBOUND(OutData%HubPosition,1), UBOUND(OutData%HubPosition,1) - OutData%HubPosition(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%HubOrientation,1) - i1_u = UBOUND(OutData%HubOrientation,1) - i2_l = LBOUND(OutData%HubOrientation,2) - i2_u = UBOUND(OutData%HubOrientation,2) - DO i2 = LBOUND(OutData%HubOrientation,2), UBOUND(OutData%HubOrientation,2) - DO i1 = LBOUND(OutData%HubOrientation,1), UBOUND(OutData%HubOrientation,1) - OutData%HubOrientation(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - 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 + TYPE(AD_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 + TYPE(AD_OutputType), INTENT(INOUT) :: y2 ! Output at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs + TYPE(AD_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 = 'AD_Output_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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 + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + IF (ALLOCATED(y_out%rotors) .AND. ALLOCATED(y1%rotors)) THEN + do i01 = lbound(y_out%rotors,1),ubound(y_out%rotors,1) + CALL MeshExtrapInterp1(y1%rotors(i01)%NacelleLoad, y2%rotors(i01)%NacelleLoad, tin, y_out%rotors(i01)%NacelleLoad, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + do i01 = lbound(y_out%rotors,1),ubound(y_out%rotors,1) + CALL MeshExtrapInterp1(y1%rotors(i01)%HubLoad, y2%rotors(i01)%HubLoad, tin, y_out%rotors(i01)%HubLoad, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + do i01 = lbound(y_out%rotors,1),ubound(y_out%rotors,1) + CALL MeshExtrapInterp1(y1%rotors(i01)%TowerLoad, y2%rotors(i01)%TowerLoad, tin, y_out%rotors(i01)%TowerLoad, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + do i01 = lbound(y_out%rotors,1),ubound(y_out%rotors,1) + IF (ALLOCATED(y_out%rotors(i01)%BladeLoad) .AND. ALLOCATED(y1%rotors(i01)%BladeLoad)) THEN + do i1 = lbound(y_out%rotors(i01)%BladeLoad,1),ubound(y_out%rotors(i01)%BladeLoad,1) + CALL MeshExtrapInterp1(y1%rotors(i01)%BladeLoad(i1), y2%rotors(i01)%BladeLoad(i1), tin, y_out%rotors(i01)%BladeLoad(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated 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 + do i01 = lbound(y_out%rotors,1),ubound(y_out%rotors,1) + CALL MeshExtrapInterp1(y1%rotors(i01)%TFinLoad, y2%rotors(i01)%TFinLoad, tin, y_out%rotors(i01)%TFinLoad, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO - END IF - i1_l = LBOUND(OutData%NacellePosition,1) - i1_u = UBOUND(OutData%NacellePosition,1) - DO i1 = LBOUND(OutData%NacellePosition,1), UBOUND(OutData%NacellePosition,1) - OutData%NacellePosition(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%NacelleOrientation,1) - i1_u = UBOUND(OutData%NacelleOrientation,1) - i2_l = LBOUND(OutData%NacelleOrientation,2) - i2_u = UBOUND(OutData%NacelleOrientation,2) - DO i2 = LBOUND(OutData%NacelleOrientation,2), UBOUND(OutData%NacelleOrientation,2) - DO i1 = LBOUND(OutData%NacelleOrientation,1), UBOUND(OutData%NacelleOrientation,1) - OutData%NacelleOrientation(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 + do i01 = lbound(y_out%rotors,1),ubound(y_out%rotors,1) + IF (ALLOCATED(y_out%rotors(i01)%WriteOutput) .AND. ALLOCATED(y1%rotors(i01)%WriteOutput)) THEN + y_out%rotors(i01)%WriteOutput = a1*y1%rotors(i01)%WriteOutput + a2*y2%rotors(i01)%WriteOutput + END IF ! check if allocated END DO - END DO - OutData%AeroProjMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%AeroBEM_Mod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE AD_UnPackRotInitInputType - - SUBROUTINE AD_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AD_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(AD_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 = 'AD_CopyInitInput' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcInitInputData%rotors)) THEN - i1_l = LBOUND(SrcInitInputData%rotors,1) - i1_u = UBOUND(SrcInitInputData%rotors,1) - IF (.NOT. ALLOCATED(DstInitInputData%rotors)) THEN - ALLOCATE(DstInitInputData%rotors(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%rotors.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcInitInputData%rotors,1), UBOUND(SrcInitInputData%rotors,1) - CALL AD_Copyrotinitinputtype( SrcInitInputData%rotors(i1), DstInitInputData%rotors(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - DstInitInputData%InputFile = SrcInitInputData%InputFile - DstInitInputData%RootName = SrcInitInputData%RootName - DstInitInputData%UsePrimaryInputFile = SrcInitInputData%UsePrimaryInputFile - CALL NWTC_Library_Copyfileinfotype( SrcInitInputData%PassedPrimaryInputData, DstInitInputData%PassedPrimaryInputData, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstInitInputData%Linearize = SrcInitInputData%Linearize - DstInitInputData%Gravity = SrcInitInputData%Gravity - DstInitInputData%MHK = SrcInitInputData%MHK - DstInitInputData%defFldDens = SrcInitInputData%defFldDens - DstInitInputData%defKinVisc = SrcInitInputData%defKinVisc - DstInitInputData%defSpdSound = SrcInitInputData%defSpdSound - DstInitInputData%defPatm = SrcInitInputData%defPatm - DstInitInputData%defPvap = SrcInitInputData%defPvap - DstInitInputData%WtrDpth = SrcInitInputData%WtrDpth - DstInitInputData%MSL2SWL = SrcInitInputData%MSL2SWL - END SUBROUTINE AD_CopyInitInput - - SUBROUTINE AD_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(AD_InitInputType), INTENT(INOUT) :: InitInputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_DestroyInitInput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(InitInputData%rotors)) THEN -DO i1 = LBOUND(InitInputData%rotors,1), UBOUND(InitInputData%rotors,1) - CALL AD_Destroyrotinitinputtype( InitInputData%rotors(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(InitInputData%rotors) -ENDIF - CALL NWTC_Library_Destroyfileinfotype( InitInputData%PassedPrimaryInputData, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE AD_DestroyInitInput - - SUBROUTINE AD_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(AD_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 = 'AD_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 ! rotors allocated yes/no - IF ( ALLOCATED(InData%rotors) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! rotors upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%rotors,1), UBOUND(InData%rotors,1) - Int_BufSz = Int_BufSz + 3 ! rotors: size of buffers for each call to pack subtype - CALL AD_Packrotinitinputtype( Re_Buf, Db_Buf, Int_Buf, InData%rotors(i1), ErrStat2, ErrMsg2, .TRUE. ) ! rotors - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! rotors - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! rotors - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! rotors - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1*LEN(InData%InputFile) ! InputFile - Int_BufSz = Int_BufSz + 1*LEN(InData%RootName) ! RootName - Int_BufSz = Int_BufSz + 1 ! UsePrimaryInputFile - 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 + END IF ! check if allocated +END SUBROUTINE - 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 ! Linearize - Re_BufSz = Re_BufSz + 1 ! Gravity - Int_BufSz = Int_BufSz + 1 ! MHK - Re_BufSz = Re_BufSz + 1 ! defFldDens - Re_BufSz = Re_BufSz + 1 ! defKinVisc - Re_BufSz = Re_BufSz + 1 ! defSpdSound - Re_BufSz = Re_BufSz + 1 ! defPatm - Re_BufSz = Re_BufSz + 1 ! defPvap - Re_BufSz = Re_BufSz + 1 ! WtrDpth - Re_BufSz = Re_BufSz + 1 ! MSL2SWL - 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%rotors) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rotors,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rotors,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%rotors,1), UBOUND(InData%rotors,1) - CALL AD_Packrotinitinputtype( Re_Buf, Db_Buf, Int_Buf, InData%rotors(i1), ErrStat2, ErrMsg2, OnlySize ) ! rotors - 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%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 - IntKiBuf(Int_Xferred) = TRANSFER(InData%UsePrimaryInputFile, 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%Linearize, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Gravity - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%MHK - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%defFldDens - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%defKinVisc - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%defSpdSound - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%defPatm - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%defPvap - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WtrDpth - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MSL2SWL - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AD_PackInitInput - - SUBROUTINE AD_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(AD_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 = 'AD_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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rotors not allocated - Int_Xferred = Int_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%rotors)) DEALLOCATE(OutData%rotors) - ALLOCATE(OutData%rotors(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotors.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%rotors,1), UBOUND(OutData%rotors,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 AD_Unpackrotinitinputtype( Re_Buf, Db_Buf, Int_Buf, OutData%rotors(i1), ErrStat2, ErrMsg2 ) ! rotors - 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%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%UsePrimaryInputFile = TRANSFER(IntKiBuf(Int_Xferred), OutData%UsePrimaryInputFile) - 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%Linearize = TRANSFER(IntKiBuf(Int_Xferred), OutData%Linearize) - Int_Xferred = Int_Xferred + 1 - OutData%Gravity = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MHK = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%defFldDens = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%defKinVisc = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%defSpdSound = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%defPatm = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%defPvap = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%WtrDpth = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MSL2SWL = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AD_UnPackInitInput +SUBROUTINE AD_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 +! +!.................................................................................................................................. - SUBROUTINE AD_CopyBladePropsType( SrcBladePropsTypeData, DstBladePropsTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AD_BladePropsType), INTENT(IN) :: SrcBladePropsTypeData - TYPE(AD_BladePropsType), INTENT(INOUT) :: DstBladePropsTypeData - 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 = 'AD_CopyBladePropsType' -! + TYPE(AD_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 > t3 + TYPE(AD_OutputType), INTENT(INOUT) :: y2 ! Output at t2 > t3 + TYPE(AD_OutputType), INTENT(INOUT) :: y3 ! Output at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs + TYPE(AD_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) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'AD_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 = "" - DstBladePropsTypeData%NumBlNds = SrcBladePropsTypeData%NumBlNds -IF (ALLOCATED(SrcBladePropsTypeData%BlSpn)) THEN - i1_l = LBOUND(SrcBladePropsTypeData%BlSpn,1) - i1_u = UBOUND(SrcBladePropsTypeData%BlSpn,1) - IF (.NOT. ALLOCATED(DstBladePropsTypeData%BlSpn)) THEN - ALLOCATE(DstBladePropsTypeData%BlSpn(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladePropsTypeData%BlSpn.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladePropsTypeData%BlSpn = SrcBladePropsTypeData%BlSpn -ENDIF -IF (ALLOCATED(SrcBladePropsTypeData%BlCrvAC)) THEN - i1_l = LBOUND(SrcBladePropsTypeData%BlCrvAC,1) - i1_u = UBOUND(SrcBladePropsTypeData%BlCrvAC,1) - IF (.NOT. ALLOCATED(DstBladePropsTypeData%BlCrvAC)) THEN - ALLOCATE(DstBladePropsTypeData%BlCrvAC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladePropsTypeData%BlCrvAC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladePropsTypeData%BlCrvAC = SrcBladePropsTypeData%BlCrvAC -ENDIF -IF (ALLOCATED(SrcBladePropsTypeData%BlSwpAC)) THEN - i1_l = LBOUND(SrcBladePropsTypeData%BlSwpAC,1) - i1_u = UBOUND(SrcBladePropsTypeData%BlSwpAC,1) - IF (.NOT. ALLOCATED(DstBladePropsTypeData%BlSwpAC)) THEN - ALLOCATE(DstBladePropsTypeData%BlSwpAC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladePropsTypeData%BlSwpAC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladePropsTypeData%BlSwpAC = SrcBladePropsTypeData%BlSwpAC -ENDIF -IF (ALLOCATED(SrcBladePropsTypeData%BlCrvAng)) THEN - i1_l = LBOUND(SrcBladePropsTypeData%BlCrvAng,1) - i1_u = UBOUND(SrcBladePropsTypeData%BlCrvAng,1) - IF (.NOT. ALLOCATED(DstBladePropsTypeData%BlCrvAng)) THEN - ALLOCATE(DstBladePropsTypeData%BlCrvAng(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladePropsTypeData%BlCrvAng.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladePropsTypeData%BlCrvAng = SrcBladePropsTypeData%BlCrvAng -ENDIF -IF (ALLOCATED(SrcBladePropsTypeData%BlTwist)) THEN - i1_l = LBOUND(SrcBladePropsTypeData%BlTwist,1) - i1_u = UBOUND(SrcBladePropsTypeData%BlTwist,1) - IF (.NOT. ALLOCATED(DstBladePropsTypeData%BlTwist)) THEN - ALLOCATE(DstBladePropsTypeData%BlTwist(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladePropsTypeData%BlTwist.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladePropsTypeData%BlTwist = SrcBladePropsTypeData%BlTwist -ENDIF -IF (ALLOCATED(SrcBladePropsTypeData%BlChord)) THEN - i1_l = LBOUND(SrcBladePropsTypeData%BlChord,1) - i1_u = UBOUND(SrcBladePropsTypeData%BlChord,1) - IF (.NOT. ALLOCATED(DstBladePropsTypeData%BlChord)) THEN - ALLOCATE(DstBladePropsTypeData%BlChord(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladePropsTypeData%BlChord.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladePropsTypeData%BlChord = SrcBladePropsTypeData%BlChord -ENDIF -IF (ALLOCATED(SrcBladePropsTypeData%BlAFID)) THEN - i1_l = LBOUND(SrcBladePropsTypeData%BlAFID,1) - i1_u = UBOUND(SrcBladePropsTypeData%BlAFID,1) - IF (.NOT. ALLOCATED(DstBladePropsTypeData%BlAFID)) THEN - ALLOCATE(DstBladePropsTypeData%BlAFID(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladePropsTypeData%BlAFID.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladePropsTypeData%BlAFID = SrcBladePropsTypeData%BlAFID -ENDIF -IF (ALLOCATED(SrcBladePropsTypeData%BlCb)) THEN - i1_l = LBOUND(SrcBladePropsTypeData%BlCb,1) - i1_u = UBOUND(SrcBladePropsTypeData%BlCb,1) - IF (.NOT. ALLOCATED(DstBladePropsTypeData%BlCb)) THEN - ALLOCATE(DstBladePropsTypeData%BlCb(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladePropsTypeData%BlCb.', ErrStat, ErrMsg,RoutineName) + 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 - END IF - DstBladePropsTypeData%BlCb = SrcBladePropsTypeData%BlCb -ENDIF -IF (ALLOCATED(SrcBladePropsTypeData%BlCenBn)) THEN - i1_l = LBOUND(SrcBladePropsTypeData%BlCenBn,1) - i1_u = UBOUND(SrcBladePropsTypeData%BlCenBn,1) - IF (.NOT. ALLOCATED(DstBladePropsTypeData%BlCenBn)) THEN - ALLOCATE(DstBladePropsTypeData%BlCenBn(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladePropsTypeData%BlCenBn.', ErrStat, ErrMsg,RoutineName) + 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 - END IF - END IF - DstBladePropsTypeData%BlCenBn = SrcBladePropsTypeData%BlCenBn -ENDIF -IF (ALLOCATED(SrcBladePropsTypeData%BlCenBt)) THEN - i1_l = LBOUND(SrcBladePropsTypeData%BlCenBt,1) - i1_u = UBOUND(SrcBladePropsTypeData%BlCenBt,1) - IF (.NOT. ALLOCATED(DstBladePropsTypeData%BlCenBt)) THEN - ALLOCATE(DstBladePropsTypeData%BlCenBt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladePropsTypeData%BlCenBt.', ErrStat, ErrMsg,RoutineName) + 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 - END IF - DstBladePropsTypeData%BlCenBt = SrcBladePropsTypeData%BlCenBt -ENDIF - END SUBROUTINE AD_CopyBladePropsType - - SUBROUTINE AD_DestroyBladePropsType( BladePropsTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(AD_BladePropsType), INTENT(INOUT) :: BladePropsTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_DestroyBladePropsType' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(BladePropsTypeData%BlSpn)) THEN - DEALLOCATE(BladePropsTypeData%BlSpn) -ENDIF -IF (ALLOCATED(BladePropsTypeData%BlCrvAC)) THEN - DEALLOCATE(BladePropsTypeData%BlCrvAC) -ENDIF -IF (ALLOCATED(BladePropsTypeData%BlSwpAC)) THEN - DEALLOCATE(BladePropsTypeData%BlSwpAC) -ENDIF -IF (ALLOCATED(BladePropsTypeData%BlCrvAng)) THEN - DEALLOCATE(BladePropsTypeData%BlCrvAng) -ENDIF -IF (ALLOCATED(BladePropsTypeData%BlTwist)) THEN - DEALLOCATE(BladePropsTypeData%BlTwist) -ENDIF -IF (ALLOCATED(BladePropsTypeData%BlChord)) THEN - DEALLOCATE(BladePropsTypeData%BlChord) -ENDIF -IF (ALLOCATED(BladePropsTypeData%BlAFID)) THEN - DEALLOCATE(BladePropsTypeData%BlAFID) -ENDIF -IF (ALLOCATED(BladePropsTypeData%BlCb)) THEN - DEALLOCATE(BladePropsTypeData%BlCb) -ENDIF -IF (ALLOCATED(BladePropsTypeData%BlCenBn)) THEN - DEALLOCATE(BladePropsTypeData%BlCenBn) -ENDIF -IF (ALLOCATED(BladePropsTypeData%BlCenBt)) THEN - DEALLOCATE(BladePropsTypeData%BlCenBt) -ENDIF - END SUBROUTINE AD_DestroyBladePropsType - - SUBROUTINE AD_PackBladePropsType( 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(AD_BladePropsType), 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 = 'AD_PackBladePropsType' - ! 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 ! NumBlNds - Int_BufSz = Int_BufSz + 1 ! BlSpn allocated yes/no - IF ( ALLOCATED(InData%BlSpn) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BlSpn upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BlSpn) ! BlSpn - END IF - Int_BufSz = Int_BufSz + 1 ! BlCrvAC allocated yes/no - IF ( ALLOCATED(InData%BlCrvAC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BlCrvAC upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BlCrvAC) ! BlCrvAC - END IF - Int_BufSz = Int_BufSz + 1 ! BlSwpAC allocated yes/no - IF ( ALLOCATED(InData%BlSwpAC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BlSwpAC upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BlSwpAC) ! BlSwpAC - END IF - Int_BufSz = Int_BufSz + 1 ! BlCrvAng allocated yes/no - IF ( ALLOCATED(InData%BlCrvAng) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BlCrvAng upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BlCrvAng) ! BlCrvAng - END IF - Int_BufSz = Int_BufSz + 1 ! BlTwist allocated yes/no - IF ( ALLOCATED(InData%BlTwist) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BlTwist upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BlTwist) ! BlTwist - END IF - Int_BufSz = Int_BufSz + 1 ! BlChord allocated yes/no - IF ( ALLOCATED(InData%BlChord) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BlChord upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BlChord) ! BlChord - END IF - Int_BufSz = Int_BufSz + 1 ! BlAFID allocated yes/no - IF ( ALLOCATED(InData%BlAFID) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BlAFID upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%BlAFID) ! BlAFID - END IF - Int_BufSz = Int_BufSz + 1 ! BlCb allocated yes/no - IF ( ALLOCATED(InData%BlCb) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BlCb upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BlCb) ! BlCb - END IF - Int_BufSz = Int_BufSz + 1 ! BlCenBn allocated yes/no - IF ( ALLOCATED(InData%BlCenBn) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BlCenBn upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BlCenBn) ! BlCenBn - END IF - Int_BufSz = Int_BufSz + 1 ! BlCenBt allocated yes/no - IF ( ALLOCATED(InData%BlCenBt) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BlCenBt upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BlCenBt) ! BlCenBt - 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%NumBlNds - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%BlSpn) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlSpn,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlSpn,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BlSpn,1), UBOUND(InData%BlSpn,1) - ReKiBuf(Re_Xferred) = InData%BlSpn(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BlCrvAC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlCrvAC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlCrvAC,1) - Int_Xferred = Int_Xferred + 2 + END IF + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + IF (ALLOCATED(y_out%rotors) .AND. ALLOCATED(y1%rotors)) THEN + do i01 = lbound(y_out%rotors,1),ubound(y_out%rotors,1) + CALL MeshExtrapInterp2(y1%rotors(i01)%NacelleLoad, y2%rotors(i01)%NacelleLoad, y3%rotors(i01)%NacelleLoad, tin, y_out%rotors(i01)%NacelleLoad, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + do i01 = lbound(y_out%rotors,1),ubound(y_out%rotors,1) + CALL MeshExtrapInterp2(y1%rotors(i01)%HubLoad, y2%rotors(i01)%HubLoad, y3%rotors(i01)%HubLoad, tin, y_out%rotors(i01)%HubLoad, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + do i01 = lbound(y_out%rotors,1),ubound(y_out%rotors,1) + CALL MeshExtrapInterp2(y1%rotors(i01)%TowerLoad, y2%rotors(i01)%TowerLoad, y3%rotors(i01)%TowerLoad, tin, y_out%rotors(i01)%TowerLoad, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + do i01 = lbound(y_out%rotors,1),ubound(y_out%rotors,1) + IF (ALLOCATED(y_out%rotors(i01)%BladeLoad) .AND. ALLOCATED(y1%rotors(i01)%BladeLoad)) THEN + do i1 = lbound(y_out%rotors(i01)%BladeLoad,1),ubound(y_out%rotors(i01)%BladeLoad,1) + CALL MeshExtrapInterp2(y1%rotors(i01)%BladeLoad(i1), y2%rotors(i01)%BladeLoad(i1), y3%rotors(i01)%BladeLoad(i1), tin, y_out%rotors(i01)%BladeLoad(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + END DO + do i01 = lbound(y_out%rotors,1),ubound(y_out%rotors,1) + CALL MeshExtrapInterp2(y1%rotors(i01)%TFinLoad, y2%rotors(i01)%TFinLoad, y3%rotors(i01)%TFinLoad, tin, y_out%rotors(i01)%TFinLoad, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + do i01 = lbound(y_out%rotors,1),ubound(y_out%rotors,1) + IF (ALLOCATED(y_out%rotors(i01)%WriteOutput) .AND. ALLOCATED(y1%rotors(i01)%WriteOutput)) THEN + y_out%rotors(i01)%WriteOutput = a1*y1%rotors(i01)%WriteOutput + a2*y2%rotors(i01)%WriteOutput + a3*y3%rotors(i01)%WriteOutput + END IF ! check if allocated + END DO + END IF ! check if allocated +END SUBROUTINE + +subroutine AD_InflowType_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg) + ! + ! This subroutine calculates a extrapolated (or interpolated) InflowType 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(AD_InflowType), intent(in) :: u(:) ! InflowType at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the InflowTypes + type(AD_InflowType), intent(inout) :: u_out ! InflowType 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 = 'AD_InflowType_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(u)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(u)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(u) - 1 + select case (order) + case (0) + call AD_CopyInflowType(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call AD_InflowType_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call AD_InflowType_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(u) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE AD_InflowType_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) +! +! This subroutine calculates a extrapolated (or interpolated) InflowType 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 +! +!.................................................................................................................................. - DO i1 = LBOUND(InData%BlCrvAC,1), UBOUND(InData%BlCrvAC,1) - ReKiBuf(Re_Xferred) = InData%BlCrvAC(i1) - Re_Xferred = Re_Xferred + 1 + TYPE(AD_InflowType), INTENT(IN) :: u1 ! InflowType at t1 > t2 + TYPE(AD_InflowType), INTENT(IN) :: u2 ! InflowType at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the InflowTypes + TYPE(AD_InflowType), INTENT(INOUT) :: u_out ! InflowType 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 InflowTypes + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'AD_InflowType_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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 :: i11 ! dim1 level 1 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i12 ! dim2 level 1 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 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 + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + IF (ALLOCATED(u_out%InflowWakeVel) .AND. ALLOCATED(u1%InflowWakeVel)) THEN + u_out%InflowWakeVel = a1*u1%InflowWakeVel + a2*u2%InflowWakeVel + END IF ! check if allocated + IF (ALLOCATED(u_out%RotInflow) .AND. ALLOCATED(u1%RotInflow)) THEN + do i01 = lbound(u_out%RotInflow,1),ubound(u_out%RotInflow,1) + IF (ALLOCATED(u_out%RotInflow(i01)%Blade) .AND. ALLOCATED(u1%RotInflow(i01)%Blade)) THEN + do i11 = lbound(u_out%RotInflow(i01)%Blade,1),ubound(u_out%RotInflow(i01)%Blade,1) + IF (ALLOCATED(u_out%RotInflow(i01)%Blade(i11)%InflowVel) .AND. ALLOCATED(u1%RotInflow(i01)%Blade(i11)%InflowVel)) THEN + u_out%RotInflow(i01)%Blade(i11)%InflowVel = a1*u1%RotInflow(i01)%Blade(i11)%InflowVel + a2*u2%RotInflow(i01)%Blade(i11)%InflowVel + END IF ! check if allocated + END DO + do i11 = lbound(u_out%RotInflow(i01)%Blade,1),ubound(u_out%RotInflow(i01)%Blade,1) + IF (ALLOCATED(u_out%RotInflow(i01)%Blade(i11)%InflowAcc) .AND. ALLOCATED(u1%RotInflow(i01)%Blade(i11)%InflowAcc)) THEN + u_out%RotInflow(i01)%Blade(i11)%InflowAcc = a1*u1%RotInflow(i01)%Blade(i11)%InflowAcc + a2*u2%RotInflow(i01)%Blade(i11)%InflowAcc + END IF ! check if allocated + END DO + END IF ! check if allocated END DO - END IF - IF ( .NOT. ALLOCATED(InData%BlSwpAC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlSwpAC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlSwpAC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BlSwpAC,1), UBOUND(InData%BlSwpAC,1) - ReKiBuf(Re_Xferred) = InData%BlSwpAC(i1) - Re_Xferred = Re_Xferred + 1 + do i01 = lbound(u_out%RotInflow,1),ubound(u_out%RotInflow,1) + IF (ALLOCATED(u_out%RotInflow(i01)%Tower%InflowVel) .AND. ALLOCATED(u1%RotInflow(i01)%Tower%InflowVel)) THEN + u_out%RotInflow(i01)%Tower%InflowVel = a1*u1%RotInflow(i01)%Tower%InflowVel + a2*u2%RotInflow(i01)%Tower%InflowVel + END IF ! check if allocated + IF (ALLOCATED(u_out%RotInflow(i01)%Tower%InflowAcc) .AND. ALLOCATED(u1%RotInflow(i01)%Tower%InflowAcc)) THEN + u_out%RotInflow(i01)%Tower%InflowAcc = a1*u1%RotInflow(i01)%Tower%InflowAcc + a2*u2%RotInflow(i01)%Tower%InflowAcc + END IF ! check if allocated END DO - END IF - IF ( .NOT. ALLOCATED(InData%BlCrvAng) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlCrvAng,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlCrvAng,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BlCrvAng,1), UBOUND(InData%BlCrvAng,1) - ReKiBuf(Re_Xferred) = InData%BlCrvAng(i1) - Re_Xferred = Re_Xferred + 1 + do i01 = lbound(u_out%RotInflow,1),ubound(u_out%RotInflow,1) + u_out%RotInflow(i01)%InflowOnHub = a1*u1%RotInflow(i01)%InflowOnHub + a2*u2%RotInflow(i01)%InflowOnHub END DO - END IF - IF ( .NOT. ALLOCATED(InData%BlTwist) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlTwist,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlTwist,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BlTwist,1), UBOUND(InData%BlTwist,1) - ReKiBuf(Re_Xferred) = InData%BlTwist(i1) - Re_Xferred = Re_Xferred + 1 + do i01 = lbound(u_out%RotInflow,1),ubound(u_out%RotInflow,1) + u_out%RotInflow(i01)%InflowOnNacelle = a1*u1%RotInflow(i01)%InflowOnNacelle + a2*u2%RotInflow(i01)%InflowOnNacelle END DO - END IF - IF ( .NOT. ALLOCATED(InData%BlChord) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlChord,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlChord,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BlChord,1), UBOUND(InData%BlChord,1) - ReKiBuf(Re_Xferred) = InData%BlChord(i1) - Re_Xferred = Re_Xferred + 1 + do i01 = lbound(u_out%RotInflow,1),ubound(u_out%RotInflow,1) + u_out%RotInflow(i01)%InflowOnTailFin = a1*u1%RotInflow(i01)%InflowOnTailFin + a2*u2%RotInflow(i01)%InflowOnTailFin END DO - END IF - IF ( .NOT. ALLOCATED(InData%BlAFID) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlAFID,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlAFID,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BlAFID,1), UBOUND(InData%BlAFID,1) - IntKiBuf(Int_Xferred) = InData%BlAFID(i1) - Int_Xferred = Int_Xferred + 1 + do i01 = lbound(u_out%RotInflow,1),ubound(u_out%RotInflow,1) + u_out%RotInflow(i01)%AvgDiskVel = a1*u1%RotInflow(i01)%AvgDiskVel + a2*u2%RotInflow(i01)%AvgDiskVel END DO - END IF - IF ( .NOT. ALLOCATED(InData%BlCb) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlCb,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlCb,1) - Int_Xferred = Int_Xferred + 2 + END IF ! check if allocated +END SUBROUTINE - DO i1 = LBOUND(InData%BlCb,1), UBOUND(InData%BlCb,1) - ReKiBuf(Re_Xferred) = InData%BlCb(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BlCenBn) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlCenBn,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlCenBn,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BlCenBn,1), UBOUND(InData%BlCenBn,1) - ReKiBuf(Re_Xferred) = InData%BlCenBn(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BlCenBt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlCenBt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlCenBt,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BlCenBt,1), UBOUND(InData%BlCenBt,1) - ReKiBuf(Re_Xferred) = InData%BlCenBt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE AD_PackBladePropsType - - SUBROUTINE AD_UnPackBladePropsType( 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(AD_BladePropsType), 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 = 'AD_UnPackBladePropsType' - ! 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%NumBlNds = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlSpn not allocated - Int_Xferred = Int_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%BlSpn)) DEALLOCATE(OutData%BlSpn) - ALLOCATE(OutData%BlSpn(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlSpn.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BlSpn,1), UBOUND(OutData%BlSpn,1) - OutData%BlSpn(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlCrvAC not allocated - Int_Xferred = Int_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%BlCrvAC)) DEALLOCATE(OutData%BlCrvAC) - ALLOCATE(OutData%BlCrvAC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlCrvAC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BlCrvAC,1), UBOUND(OutData%BlCrvAC,1) - OutData%BlCrvAC(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlSwpAC not allocated - Int_Xferred = Int_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%BlSwpAC)) DEALLOCATE(OutData%BlSwpAC) - ALLOCATE(OutData%BlSwpAC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlSwpAC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BlSwpAC,1), UBOUND(OutData%BlSwpAC,1) - OutData%BlSwpAC(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlCrvAng not allocated - Int_Xferred = Int_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%BlCrvAng)) DEALLOCATE(OutData%BlCrvAng) - ALLOCATE(OutData%BlCrvAng(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlCrvAng.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BlCrvAng,1), UBOUND(OutData%BlCrvAng,1) - OutData%BlCrvAng(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlTwist not allocated - Int_Xferred = Int_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%BlTwist)) DEALLOCATE(OutData%BlTwist) - ALLOCATE(OutData%BlTwist(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlTwist.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BlTwist,1), UBOUND(OutData%BlTwist,1) - OutData%BlTwist(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlChord not allocated - Int_Xferred = Int_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%BlChord)) DEALLOCATE(OutData%BlChord) - ALLOCATE(OutData%BlChord(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlChord.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BlChord,1), UBOUND(OutData%BlChord,1) - OutData%BlChord(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlAFID not allocated - Int_Xferred = Int_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%BlAFID)) DEALLOCATE(OutData%BlAFID) - ALLOCATE(OutData%BlAFID(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlAFID.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BlAFID,1), UBOUND(OutData%BlAFID,1) - OutData%BlAFID(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlCb not allocated - Int_Xferred = Int_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%BlCb)) DEALLOCATE(OutData%BlCb) - ALLOCATE(OutData%BlCb(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlCb.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BlCb,1), UBOUND(OutData%BlCb,1) - OutData%BlCb(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlCenBn not allocated - Int_Xferred = Int_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%BlCenBn)) DEALLOCATE(OutData%BlCenBn) - ALLOCATE(OutData%BlCenBn(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlCenBn.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BlCenBn,1), UBOUND(OutData%BlCenBn,1) - OutData%BlCenBn(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlCenBt not allocated - Int_Xferred = Int_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%BlCenBt)) DEALLOCATE(OutData%BlCenBt) - ALLOCATE(OutData%BlCenBt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlCenBt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BlCenBt,1), UBOUND(OutData%BlCenBt,1) - OutData%BlCenBt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE AD_UnPackBladePropsType - - SUBROUTINE AD_CopyBladeShape( SrcBladeShapeData, DstBladeShapeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AD_BladeShape), INTENT(IN) :: SrcBladeShapeData - TYPE(AD_BladeShape), INTENT(INOUT) :: DstBladeShapeData - 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 = 'AD_CopyBladeShape' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcBladeShapeData%AirfoilCoords)) THEN - i1_l = LBOUND(SrcBladeShapeData%AirfoilCoords,1) - i1_u = UBOUND(SrcBladeShapeData%AirfoilCoords,1) - i2_l = LBOUND(SrcBladeShapeData%AirfoilCoords,2) - i2_u = UBOUND(SrcBladeShapeData%AirfoilCoords,2) - i3_l = LBOUND(SrcBladeShapeData%AirfoilCoords,3) - i3_u = UBOUND(SrcBladeShapeData%AirfoilCoords,3) - IF (.NOT. ALLOCATED(DstBladeShapeData%AirfoilCoords)) THEN - ALLOCATE(DstBladeShapeData%AirfoilCoords(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladeShapeData%AirfoilCoords.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladeShapeData%AirfoilCoords = SrcBladeShapeData%AirfoilCoords -ENDIF - END SUBROUTINE AD_CopyBladeShape - - SUBROUTINE AD_DestroyBladeShape( BladeShapeData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(AD_BladeShape), INTENT(INOUT) :: BladeShapeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_DestroyBladeShape' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(BladeShapeData%AirfoilCoords)) THEN - DEALLOCATE(BladeShapeData%AirfoilCoords) -ENDIF - END SUBROUTINE AD_DestroyBladeShape - - SUBROUTINE AD_PackBladeShape( 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(AD_BladeShape), 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 = 'AD_PackBladeShape' - ! 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 ! AirfoilCoords allocated yes/no - IF ( ALLOCATED(InData%AirfoilCoords) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! AirfoilCoords upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AirfoilCoords) ! AirfoilCoords - 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%AirfoilCoords) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AirfoilCoords,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AirfoilCoords,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AirfoilCoords,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AirfoilCoords,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AirfoilCoords,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AirfoilCoords,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%AirfoilCoords,3), UBOUND(InData%AirfoilCoords,3) - DO i2 = LBOUND(InData%AirfoilCoords,2), UBOUND(InData%AirfoilCoords,2) - DO i1 = LBOUND(InData%AirfoilCoords,1), UBOUND(InData%AirfoilCoords,1) - ReKiBuf(Re_Xferred) = InData%AirfoilCoords(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - END SUBROUTINE AD_PackBladeShape - - SUBROUTINE AD_UnPackBladeShape( 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(AD_BladeShape), 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 = 'AD_UnPackBladeShape' - ! 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 ! AirfoilCoords not allocated - Int_Xferred = Int_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%AirfoilCoords)) DEALLOCATE(OutData%AirfoilCoords) - ALLOCATE(OutData%AirfoilCoords(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%AirfoilCoords.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%AirfoilCoords,3), UBOUND(OutData%AirfoilCoords,3) - DO i2 = LBOUND(OutData%AirfoilCoords,2), UBOUND(OutData%AirfoilCoords,2) - DO i1 = LBOUND(OutData%AirfoilCoords,1), UBOUND(OutData%AirfoilCoords,1) - OutData%AirfoilCoords(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - END SUBROUTINE AD_UnPackBladeShape - - SUBROUTINE AD_CopyRotInitOutputType( SrcRotInitOutputTypeData, DstRotInitOutputTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(RotInitOutputType), INTENT(IN) :: SrcRotInitOutputTypeData - TYPE(RotInitOutputType), INTENT(INOUT) :: DstRotInitOutputTypeData - 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 = 'AD_CopyRotInitOutputType' -! - ErrStat = ErrID_None - ErrMsg = "" - DstRotInitOutputTypeData%AirDens = SrcRotInitOutputTypeData%AirDens -IF (ALLOCATED(SrcRotInitOutputTypeData%WriteOutputHdr)) THEN - i1_l = LBOUND(SrcRotInitOutputTypeData%WriteOutputHdr,1) - i1_u = UBOUND(SrcRotInitOutputTypeData%WriteOutputHdr,1) - IF (.NOT. ALLOCATED(DstRotInitOutputTypeData%WriteOutputHdr)) THEN - ALLOCATE(DstRotInitOutputTypeData%WriteOutputHdr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotInitOutputTypeData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotInitOutputTypeData%WriteOutputHdr = SrcRotInitOutputTypeData%WriteOutputHdr -ENDIF -IF (ALLOCATED(SrcRotInitOutputTypeData%WriteOutputUnt)) THEN - i1_l = LBOUND(SrcRotInitOutputTypeData%WriteOutputUnt,1) - i1_u = UBOUND(SrcRotInitOutputTypeData%WriteOutputUnt,1) - IF (.NOT. ALLOCATED(DstRotInitOutputTypeData%WriteOutputUnt)) THEN - ALLOCATE(DstRotInitOutputTypeData%WriteOutputUnt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotInitOutputTypeData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotInitOutputTypeData%WriteOutputUnt = SrcRotInitOutputTypeData%WriteOutputUnt -ENDIF -IF (ALLOCATED(SrcRotInitOutputTypeData%BladeShape)) THEN - i1_l = LBOUND(SrcRotInitOutputTypeData%BladeShape,1) - i1_u = UBOUND(SrcRotInitOutputTypeData%BladeShape,1) - IF (.NOT. ALLOCATED(DstRotInitOutputTypeData%BladeShape)) THEN - ALLOCATE(DstRotInitOutputTypeData%BladeShape(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotInitOutputTypeData%BladeShape.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcRotInitOutputTypeData%BladeShape,1), UBOUND(SrcRotInitOutputTypeData%BladeShape,1) - CALL AD_Copybladeshape( SrcRotInitOutputTypeData%BladeShape(i1), DstRotInitOutputTypeData%BladeShape(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcRotInitOutputTypeData%LinNames_y)) THEN - i1_l = LBOUND(SrcRotInitOutputTypeData%LinNames_y,1) - i1_u = UBOUND(SrcRotInitOutputTypeData%LinNames_y,1) - IF (.NOT. ALLOCATED(DstRotInitOutputTypeData%LinNames_y)) THEN - ALLOCATE(DstRotInitOutputTypeData%LinNames_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotInitOutputTypeData%LinNames_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotInitOutputTypeData%LinNames_y = SrcRotInitOutputTypeData%LinNames_y -ENDIF -IF (ALLOCATED(SrcRotInitOutputTypeData%LinNames_x)) THEN - i1_l = LBOUND(SrcRotInitOutputTypeData%LinNames_x,1) - i1_u = UBOUND(SrcRotInitOutputTypeData%LinNames_x,1) - IF (.NOT. ALLOCATED(DstRotInitOutputTypeData%LinNames_x)) THEN - ALLOCATE(DstRotInitOutputTypeData%LinNames_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotInitOutputTypeData%LinNames_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotInitOutputTypeData%LinNames_x = SrcRotInitOutputTypeData%LinNames_x -ENDIF -IF (ALLOCATED(SrcRotInitOutputTypeData%LinNames_u)) THEN - i1_l = LBOUND(SrcRotInitOutputTypeData%LinNames_u,1) - i1_u = UBOUND(SrcRotInitOutputTypeData%LinNames_u,1) - IF (.NOT. ALLOCATED(DstRotInitOutputTypeData%LinNames_u)) THEN - ALLOCATE(DstRotInitOutputTypeData%LinNames_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotInitOutputTypeData%LinNames_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotInitOutputTypeData%LinNames_u = SrcRotInitOutputTypeData%LinNames_u -ENDIF -IF (ALLOCATED(SrcRotInitOutputTypeData%RotFrame_y)) THEN - i1_l = LBOUND(SrcRotInitOutputTypeData%RotFrame_y,1) - i1_u = UBOUND(SrcRotInitOutputTypeData%RotFrame_y,1) - IF (.NOT. ALLOCATED(DstRotInitOutputTypeData%RotFrame_y)) THEN - ALLOCATE(DstRotInitOutputTypeData%RotFrame_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotInitOutputTypeData%RotFrame_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotInitOutputTypeData%RotFrame_y = SrcRotInitOutputTypeData%RotFrame_y -ENDIF -IF (ALLOCATED(SrcRotInitOutputTypeData%RotFrame_x)) THEN - i1_l = LBOUND(SrcRotInitOutputTypeData%RotFrame_x,1) - i1_u = UBOUND(SrcRotInitOutputTypeData%RotFrame_x,1) - IF (.NOT. ALLOCATED(DstRotInitOutputTypeData%RotFrame_x)) THEN - ALLOCATE(DstRotInitOutputTypeData%RotFrame_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotInitOutputTypeData%RotFrame_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotInitOutputTypeData%RotFrame_x = SrcRotInitOutputTypeData%RotFrame_x -ENDIF -IF (ALLOCATED(SrcRotInitOutputTypeData%RotFrame_u)) THEN - i1_l = LBOUND(SrcRotInitOutputTypeData%RotFrame_u,1) - i1_u = UBOUND(SrcRotInitOutputTypeData%RotFrame_u,1) - IF (.NOT. ALLOCATED(DstRotInitOutputTypeData%RotFrame_u)) THEN - ALLOCATE(DstRotInitOutputTypeData%RotFrame_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotInitOutputTypeData%RotFrame_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotInitOutputTypeData%RotFrame_u = SrcRotInitOutputTypeData%RotFrame_u -ENDIF -IF (ALLOCATED(SrcRotInitOutputTypeData%IsLoad_u)) THEN - i1_l = LBOUND(SrcRotInitOutputTypeData%IsLoad_u,1) - i1_u = UBOUND(SrcRotInitOutputTypeData%IsLoad_u,1) - IF (.NOT. ALLOCATED(DstRotInitOutputTypeData%IsLoad_u)) THEN - ALLOCATE(DstRotInitOutputTypeData%IsLoad_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotInitOutputTypeData%IsLoad_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotInitOutputTypeData%IsLoad_u = SrcRotInitOutputTypeData%IsLoad_u -ENDIF -IF (ALLOCATED(SrcRotInitOutputTypeData%BladeProps)) THEN - i1_l = LBOUND(SrcRotInitOutputTypeData%BladeProps,1) - i1_u = UBOUND(SrcRotInitOutputTypeData%BladeProps,1) - IF (.NOT. ALLOCATED(DstRotInitOutputTypeData%BladeProps)) THEN - ALLOCATE(DstRotInitOutputTypeData%BladeProps(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotInitOutputTypeData%BladeProps.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcRotInitOutputTypeData%BladeProps,1), UBOUND(SrcRotInitOutputTypeData%BladeProps,1) - CALL AD_Copybladepropstype( SrcRotInitOutputTypeData%BladeProps(i1), DstRotInitOutputTypeData%BladeProps(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcRotInitOutputTypeData%DerivOrder_x)) THEN - i1_l = LBOUND(SrcRotInitOutputTypeData%DerivOrder_x,1) - i1_u = UBOUND(SrcRotInitOutputTypeData%DerivOrder_x,1) - IF (.NOT. ALLOCATED(DstRotInitOutputTypeData%DerivOrder_x)) THEN - ALLOCATE(DstRotInitOutputTypeData%DerivOrder_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotInitOutputTypeData%DerivOrder_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotInitOutputTypeData%DerivOrder_x = SrcRotInitOutputTypeData%DerivOrder_x -ENDIF -IF (ALLOCATED(SrcRotInitOutputTypeData%TwrElev)) THEN - i1_l = LBOUND(SrcRotInitOutputTypeData%TwrElev,1) - i1_u = UBOUND(SrcRotInitOutputTypeData%TwrElev,1) - IF (.NOT. ALLOCATED(DstRotInitOutputTypeData%TwrElev)) THEN - ALLOCATE(DstRotInitOutputTypeData%TwrElev(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotInitOutputTypeData%TwrElev.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotInitOutputTypeData%TwrElev = SrcRotInitOutputTypeData%TwrElev -ENDIF -IF (ALLOCATED(SrcRotInitOutputTypeData%TwrDiam)) THEN - i1_l = LBOUND(SrcRotInitOutputTypeData%TwrDiam,1) - i1_u = UBOUND(SrcRotInitOutputTypeData%TwrDiam,1) - IF (.NOT. ALLOCATED(DstRotInitOutputTypeData%TwrDiam)) THEN - ALLOCATE(DstRotInitOutputTypeData%TwrDiam(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotInitOutputTypeData%TwrDiam.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotInitOutputTypeData%TwrDiam = SrcRotInitOutputTypeData%TwrDiam -ENDIF - END SUBROUTINE AD_CopyRotInitOutputType - - SUBROUTINE AD_DestroyRotInitOutputType( RotInitOutputTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(RotInitOutputType), INTENT(INOUT) :: RotInitOutputTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_DestroyRotInitOutputType' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(RotInitOutputTypeData%WriteOutputHdr)) THEN - DEALLOCATE(RotInitOutputTypeData%WriteOutputHdr) -ENDIF -IF (ALLOCATED(RotInitOutputTypeData%WriteOutputUnt)) THEN - DEALLOCATE(RotInitOutputTypeData%WriteOutputUnt) -ENDIF -IF (ALLOCATED(RotInitOutputTypeData%BladeShape)) THEN -DO i1 = LBOUND(RotInitOutputTypeData%BladeShape,1), UBOUND(RotInitOutputTypeData%BladeShape,1) - CALL AD_Destroybladeshape( RotInitOutputTypeData%BladeShape(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(RotInitOutputTypeData%BladeShape) -ENDIF -IF (ALLOCATED(RotInitOutputTypeData%LinNames_y)) THEN - DEALLOCATE(RotInitOutputTypeData%LinNames_y) -ENDIF -IF (ALLOCATED(RotInitOutputTypeData%LinNames_x)) THEN - DEALLOCATE(RotInitOutputTypeData%LinNames_x) -ENDIF -IF (ALLOCATED(RotInitOutputTypeData%LinNames_u)) THEN - DEALLOCATE(RotInitOutputTypeData%LinNames_u) -ENDIF -IF (ALLOCATED(RotInitOutputTypeData%RotFrame_y)) THEN - DEALLOCATE(RotInitOutputTypeData%RotFrame_y) -ENDIF -IF (ALLOCATED(RotInitOutputTypeData%RotFrame_x)) THEN - DEALLOCATE(RotInitOutputTypeData%RotFrame_x) -ENDIF -IF (ALLOCATED(RotInitOutputTypeData%RotFrame_u)) THEN - DEALLOCATE(RotInitOutputTypeData%RotFrame_u) -ENDIF -IF (ALLOCATED(RotInitOutputTypeData%IsLoad_u)) THEN - DEALLOCATE(RotInitOutputTypeData%IsLoad_u) -ENDIF -IF (ALLOCATED(RotInitOutputTypeData%BladeProps)) THEN -DO i1 = LBOUND(RotInitOutputTypeData%BladeProps,1), UBOUND(RotInitOutputTypeData%BladeProps,1) - CALL AD_Destroybladepropstype( RotInitOutputTypeData%BladeProps(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(RotInitOutputTypeData%BladeProps) -ENDIF -IF (ALLOCATED(RotInitOutputTypeData%DerivOrder_x)) THEN - DEALLOCATE(RotInitOutputTypeData%DerivOrder_x) -ENDIF -IF (ALLOCATED(RotInitOutputTypeData%TwrElev)) THEN - DEALLOCATE(RotInitOutputTypeData%TwrElev) -ENDIF -IF (ALLOCATED(RotInitOutputTypeData%TwrDiam)) THEN - DEALLOCATE(RotInitOutputTypeData%TwrDiam) -ENDIF - END SUBROUTINE AD_DestroyRotInitOutputType - - SUBROUTINE AD_PackRotInitOutputType( 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(RotInitOutputType), 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 = 'AD_PackRotInitOutputType' - ! 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 ! 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 - Int_BufSz = Int_BufSz + 1 ! BladeShape allocated yes/no - IF ( ALLOCATED(InData%BladeShape) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BladeShape upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%BladeShape,1), UBOUND(InData%BladeShape,1) - Int_BufSz = Int_BufSz + 3 ! BladeShape: size of buffers for each call to pack subtype - CALL AD_Packbladeshape( Re_Buf, Db_Buf, Int_Buf, InData%BladeShape(i1), ErrStat2, ErrMsg2, .TRUE. ) ! BladeShape - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BladeShape - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BladeShape - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BladeShape - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - 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 ! BladeProps allocated yes/no - IF ( ALLOCATED(InData%BladeProps) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BladeProps upper/lower bounds for each dimension - DO i1 = LBOUND(InData%BladeProps,1), UBOUND(InData%BladeProps,1) - Int_BufSz = Int_BufSz + 3 ! BladeProps: size of buffers for each call to pack subtype - CALL AD_Packbladepropstype( Re_Buf, Db_Buf, Int_Buf, InData%BladeProps(i1), ErrStat2, ErrMsg2, .TRUE. ) ! BladeProps - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BladeProps - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BladeProps - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BladeProps - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - 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 - Int_BufSz = Int_BufSz + 1 ! TwrElev allocated yes/no - IF ( ALLOCATED(InData%TwrElev) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TwrElev upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TwrElev) ! TwrElev - END IF - Int_BufSz = Int_BufSz + 1 ! TwrDiam allocated yes/no - IF ( ALLOCATED(InData%TwrDiam) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TwrDiam upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TwrDiam) ! TwrDiam - 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%AirDens - Re_Xferred = Re_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 - IF ( .NOT. ALLOCATED(InData%BladeShape) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BladeShape,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BladeShape,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BladeShape,1), UBOUND(InData%BladeShape,1) - CALL AD_Packbladeshape( Re_Buf, Db_Buf, Int_Buf, InData%BladeShape(i1), ErrStat2, ErrMsg2, OnlySize ) ! BladeShape - 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%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%BladeProps) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BladeProps,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BladeProps,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BladeProps,1), UBOUND(InData%BladeProps,1) - CALL AD_Packbladepropstype( Re_Buf, Db_Buf, Int_Buf, InData%BladeProps(i1), ErrStat2, ErrMsg2, OnlySize ) ! BladeProps - 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%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 - IF ( .NOT. ALLOCATED(InData%TwrElev) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwrElev,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrElev,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TwrElev,1), UBOUND(InData%TwrElev,1) - ReKiBuf(Re_Xferred) = InData%TwrElev(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TwrDiam) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwrDiam,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrDiam,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TwrDiam,1), UBOUND(InData%TwrDiam,1) - ReKiBuf(Re_Xferred) = InData%TwrDiam(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE AD_PackRotInitOutputType - - SUBROUTINE AD_UnPackRotInitOutputType( 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(RotInitOutputType), 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 = 'AD_UnPackRotInitOutputType' - ! 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 - 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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BladeShape not allocated - Int_Xferred = Int_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%BladeShape)) DEALLOCATE(OutData%BladeShape) - ALLOCATE(OutData%BladeShape(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeShape.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BladeShape,1), UBOUND(OutData%BladeShape,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 AD_Unpackbladeshape( Re_Buf, Db_Buf, Int_Buf, OutData%BladeShape(i1), ErrStat2, ErrMsg2 ) ! BladeShape - 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 ! 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 ! BladeProps not allocated - Int_Xferred = Int_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%BladeProps)) DEALLOCATE(OutData%BladeProps) - ALLOCATE(OutData%BladeProps(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeProps.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BladeProps,1), UBOUND(OutData%BladeProps,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 AD_Unpackbladepropstype( Re_Buf, Db_Buf, Int_Buf, OutData%BladeProps(i1), ErrStat2, ErrMsg2 ) ! BladeProps - 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 ! 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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrElev not allocated - Int_Xferred = Int_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%TwrElev)) DEALLOCATE(OutData%TwrElev) - ALLOCATE(OutData%TwrElev(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrElev.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TwrElev,1), UBOUND(OutData%TwrElev,1) - OutData%TwrElev(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrDiam not allocated - Int_Xferred = Int_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%TwrDiam)) DEALLOCATE(OutData%TwrDiam) - ALLOCATE(OutData%TwrDiam(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrDiam.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TwrDiam,1), UBOUND(OutData%TwrDiam,1) - OutData%TwrDiam(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE AD_UnPackRotInitOutputType - - SUBROUTINE AD_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AD_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(AD_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 = 'AD_CopyInitOutput' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcInitOutputData%rotors)) THEN - i1_l = LBOUND(SrcInitOutputData%rotors,1) - i1_u = UBOUND(SrcInitOutputData%rotors,1) - IF (.NOT. ALLOCATED(DstInitOutputData%rotors)) THEN - ALLOCATE(DstInitOutputData%rotors(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%rotors.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcInitOutputData%rotors,1), UBOUND(SrcInitOutputData%rotors,1) - CALL AD_Copyrotinitoutputtype( SrcInitOutputData%rotors(i1), DstInitOutputData%rotors(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -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 AD_CopyInitOutput - - SUBROUTINE AD_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(AD_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_DestroyInitOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(InitOutputData%rotors)) THEN -DO i1 = LBOUND(InitOutputData%rotors,1), UBOUND(InitOutputData%rotors,1) - CALL AD_Destroyrotinitoutputtype( InitOutputData%rotors(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(InitOutputData%rotors) -ENDIF - CALL NWTC_Library_Destroyprogdesc( InitOutputData%Ver, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE AD_DestroyInitOutput - - SUBROUTINE AD_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(AD_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 = 'AD_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 ! rotors allocated yes/no - IF ( ALLOCATED(InData%rotors) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! rotors upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%rotors,1), UBOUND(InData%rotors,1) - Int_BufSz = Int_BufSz + 3 ! rotors: size of buffers for each call to pack subtype - CALL AD_Packrotinitoutputtype( Re_Buf, Db_Buf, Int_Buf, InData%rotors(i1), ErrStat2, ErrMsg2, .TRUE. ) ! rotors - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! rotors - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! rotors - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! rotors - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - 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%rotors) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rotors,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rotors,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%rotors,1), UBOUND(InData%rotors,1) - CALL AD_Packrotinitoutputtype( Re_Buf, Db_Buf, Int_Buf, InData%rotors(i1), ErrStat2, ErrMsg2, OnlySize ) ! rotors - 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 - 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 AD_PackInitOutput - - SUBROUTINE AD_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(AD_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 = 'AD_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 ! rotors not allocated - Int_Xferred = Int_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%rotors)) DEALLOCATE(OutData%rotors) - ALLOCATE(OutData%rotors(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotors.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%rotors,1), UBOUND(OutData%rotors,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 AD_Unpackrotinitoutputtype( Re_Buf, Db_Buf, Int_Buf, OutData%rotors(i1), ErrStat2, ErrMsg2 ) ! rotors - 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 - 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 AD_UnPackInitOutput - - SUBROUTINE AD_CopyRotInputFile( SrcRotInputFileData, DstRotInputFileData, CtrlCode, ErrStat, ErrMsg ) - TYPE(RotInputFile), INTENT(IN) :: SrcRotInputFileData - TYPE(RotInputFile), INTENT(INOUT) :: DstRotInputFileData - 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 = 'AD_CopyRotInputFile' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcRotInputFileData%BladeProps)) THEN - i1_l = LBOUND(SrcRotInputFileData%BladeProps,1) - i1_u = UBOUND(SrcRotInputFileData%BladeProps,1) - IF (.NOT. ALLOCATED(DstRotInputFileData%BladeProps)) THEN - ALLOCATE(DstRotInputFileData%BladeProps(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotInputFileData%BladeProps.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcRotInputFileData%BladeProps,1), UBOUND(SrcRotInputFileData%BladeProps,1) - CALL AD_Copybladepropstype( SrcRotInputFileData%BladeProps(i1), DstRotInputFileData%BladeProps(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - DstRotInputFileData%NumTwrNds = SrcRotInputFileData%NumTwrNds -IF (ALLOCATED(SrcRotInputFileData%TwrElev)) THEN - i1_l = LBOUND(SrcRotInputFileData%TwrElev,1) - i1_u = UBOUND(SrcRotInputFileData%TwrElev,1) - IF (.NOT. ALLOCATED(DstRotInputFileData%TwrElev)) THEN - ALLOCATE(DstRotInputFileData%TwrElev(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotInputFileData%TwrElev.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotInputFileData%TwrElev = SrcRotInputFileData%TwrElev -ENDIF -IF (ALLOCATED(SrcRotInputFileData%TwrDiam)) THEN - i1_l = LBOUND(SrcRotInputFileData%TwrDiam,1) - i1_u = UBOUND(SrcRotInputFileData%TwrDiam,1) - IF (.NOT. ALLOCATED(DstRotInputFileData%TwrDiam)) THEN - ALLOCATE(DstRotInputFileData%TwrDiam(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotInputFileData%TwrDiam.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotInputFileData%TwrDiam = SrcRotInputFileData%TwrDiam -ENDIF -IF (ALLOCATED(SrcRotInputFileData%TwrCd)) THEN - i1_l = LBOUND(SrcRotInputFileData%TwrCd,1) - i1_u = UBOUND(SrcRotInputFileData%TwrCd,1) - IF (.NOT. ALLOCATED(DstRotInputFileData%TwrCd)) THEN - ALLOCATE(DstRotInputFileData%TwrCd(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotInputFileData%TwrCd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotInputFileData%TwrCd = SrcRotInputFileData%TwrCd -ENDIF -IF (ALLOCATED(SrcRotInputFileData%TwrTI)) THEN - i1_l = LBOUND(SrcRotInputFileData%TwrTI,1) - i1_u = UBOUND(SrcRotInputFileData%TwrTI,1) - IF (.NOT. ALLOCATED(DstRotInputFileData%TwrTI)) THEN - ALLOCATE(DstRotInputFileData%TwrTI(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotInputFileData%TwrTI.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotInputFileData%TwrTI = SrcRotInputFileData%TwrTI -ENDIF -IF (ALLOCATED(SrcRotInputFileData%TwrCb)) THEN - i1_l = LBOUND(SrcRotInputFileData%TwrCb,1) - i1_u = UBOUND(SrcRotInputFileData%TwrCb,1) - IF (.NOT. ALLOCATED(DstRotInputFileData%TwrCb)) THEN - ALLOCATE(DstRotInputFileData%TwrCb(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotInputFileData%TwrCb.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotInputFileData%TwrCb = SrcRotInputFileData%TwrCb -ENDIF - DstRotInputFileData%VolHub = SrcRotInputFileData%VolHub - DstRotInputFileData%HubCenBx = SrcRotInputFileData%HubCenBx - DstRotInputFileData%VolNac = SrcRotInputFileData%VolNac - DstRotInputFileData%NacCenB = SrcRotInputFileData%NacCenB - DstRotInputFileData%TFinAero = SrcRotInputFileData%TFinAero - DstRotInputFileData%TFinFile = SrcRotInputFileData%TFinFile - CALL AD_Copytfininputfiletype( SrcRotInputFileData%TFin, DstRotInputFileData%TFin, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE AD_CopyRotInputFile - - SUBROUTINE AD_DestroyRotInputFile( RotInputFileData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(RotInputFile), INTENT(INOUT) :: RotInputFileData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_DestroyRotInputFile' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(RotInputFileData%BladeProps)) THEN -DO i1 = LBOUND(RotInputFileData%BladeProps,1), UBOUND(RotInputFileData%BladeProps,1) - CALL AD_Destroybladepropstype( RotInputFileData%BladeProps(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(RotInputFileData%BladeProps) -ENDIF -IF (ALLOCATED(RotInputFileData%TwrElev)) THEN - DEALLOCATE(RotInputFileData%TwrElev) -ENDIF -IF (ALLOCATED(RotInputFileData%TwrDiam)) THEN - DEALLOCATE(RotInputFileData%TwrDiam) -ENDIF -IF (ALLOCATED(RotInputFileData%TwrCd)) THEN - DEALLOCATE(RotInputFileData%TwrCd) -ENDIF -IF (ALLOCATED(RotInputFileData%TwrTI)) THEN - DEALLOCATE(RotInputFileData%TwrTI) -ENDIF -IF (ALLOCATED(RotInputFileData%TwrCb)) THEN - DEALLOCATE(RotInputFileData%TwrCb) -ENDIF - CALL AD_Destroytfininputfiletype( RotInputFileData%TFin, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE AD_DestroyRotInputFile - - SUBROUTINE AD_PackRotInputFile( 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(RotInputFile), 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 = 'AD_PackRotInputFile' - ! 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 ! BladeProps allocated yes/no - IF ( ALLOCATED(InData%BladeProps) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BladeProps upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%BladeProps,1), UBOUND(InData%BladeProps,1) - Int_BufSz = Int_BufSz + 3 ! BladeProps: size of buffers for each call to pack subtype - CALL AD_Packbladepropstype( Re_Buf, Db_Buf, Int_Buf, InData%BladeProps(i1), ErrStat2, ErrMsg2, .TRUE. ) ! BladeProps - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BladeProps - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BladeProps - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BladeProps - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! NumTwrNds - Int_BufSz = Int_BufSz + 1 ! TwrElev allocated yes/no - IF ( ALLOCATED(InData%TwrElev) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TwrElev upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TwrElev) ! TwrElev - END IF - Int_BufSz = Int_BufSz + 1 ! TwrDiam allocated yes/no - IF ( ALLOCATED(InData%TwrDiam) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TwrDiam upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TwrDiam) ! TwrDiam - END IF - Int_BufSz = Int_BufSz + 1 ! TwrCd allocated yes/no - IF ( ALLOCATED(InData%TwrCd) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TwrCd upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TwrCd) ! TwrCd - END IF - Int_BufSz = Int_BufSz + 1 ! TwrTI allocated yes/no - IF ( ALLOCATED(InData%TwrTI) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TwrTI upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TwrTI) ! TwrTI - END IF - Int_BufSz = Int_BufSz + 1 ! TwrCb allocated yes/no - IF ( ALLOCATED(InData%TwrCb) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TwrCb upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TwrCb) ! TwrCb - END IF - Re_BufSz = Re_BufSz + 1 ! VolHub - Re_BufSz = Re_BufSz + 1 ! HubCenBx - Re_BufSz = Re_BufSz + 1 ! VolNac - Re_BufSz = Re_BufSz + SIZE(InData%NacCenB) ! NacCenB - Int_BufSz = Int_BufSz + 1 ! TFinAero - Int_BufSz = Int_BufSz + 1*LEN(InData%TFinFile) ! TFinFile - Int_BufSz = Int_BufSz + 3 ! TFin: size of buffers for each call to pack subtype - CALL AD_Packtfininputfiletype( Re_Buf, Db_Buf, Int_Buf, InData%TFin, ErrStat2, ErrMsg2, .TRUE. ) ! TFin - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! TFin - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! TFin - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! TFin - 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%BladeProps) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BladeProps,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BladeProps,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BladeProps,1), UBOUND(InData%BladeProps,1) - CALL AD_Packbladepropstype( Re_Buf, Db_Buf, Int_Buf, InData%BladeProps(i1), ErrStat2, ErrMsg2, OnlySize ) ! BladeProps - 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%NumTwrNds - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%TwrElev) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwrElev,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrElev,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TwrElev,1), UBOUND(InData%TwrElev,1) - ReKiBuf(Re_Xferred) = InData%TwrElev(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TwrDiam) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwrDiam,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrDiam,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TwrDiam,1), UBOUND(InData%TwrDiam,1) - ReKiBuf(Re_Xferred) = InData%TwrDiam(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TwrCd) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwrCd,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrCd,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TwrCd,1), UBOUND(InData%TwrCd,1) - ReKiBuf(Re_Xferred) = InData%TwrCd(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TwrTI) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwrTI,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrTI,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TwrTI,1), UBOUND(InData%TwrTI,1) - ReKiBuf(Re_Xferred) = InData%TwrTI(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TwrCb) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwrCb,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrCb,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TwrCb,1), UBOUND(InData%TwrCb,1) - ReKiBuf(Re_Xferred) = InData%TwrCb(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%VolHub - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%HubCenBx - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%VolNac - Re_Xferred = Re_Xferred + 1 - DO i1 = LBOUND(InData%NacCenB,1), UBOUND(InData%NacCenB,1) - ReKiBuf(Re_Xferred) = InData%NacCenB(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = TRANSFER(InData%TFinAero, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%TFinFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%TFinFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - CALL AD_Packtfininputfiletype( Re_Buf, Db_Buf, Int_Buf, InData%TFin, ErrStat2, ErrMsg2, OnlySize ) ! TFin - 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 AD_PackRotInputFile - - SUBROUTINE AD_UnPackRotInputFile( 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(RotInputFile), 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 = 'AD_UnPackRotInputFile' - ! 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 ! BladeProps not allocated - Int_Xferred = Int_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%BladeProps)) DEALLOCATE(OutData%BladeProps) - ALLOCATE(OutData%BladeProps(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeProps.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BladeProps,1), UBOUND(OutData%BladeProps,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 AD_Unpackbladepropstype( Re_Buf, Db_Buf, Int_Buf, OutData%BladeProps(i1), ErrStat2, ErrMsg2 ) ! BladeProps - 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%NumTwrNds = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrElev not allocated - Int_Xferred = Int_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%TwrElev)) DEALLOCATE(OutData%TwrElev) - ALLOCATE(OutData%TwrElev(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrElev.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TwrElev,1), UBOUND(OutData%TwrElev,1) - OutData%TwrElev(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrDiam not allocated - Int_Xferred = Int_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%TwrDiam)) DEALLOCATE(OutData%TwrDiam) - ALLOCATE(OutData%TwrDiam(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrDiam.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TwrDiam,1), UBOUND(OutData%TwrDiam,1) - OutData%TwrDiam(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrCd not allocated - Int_Xferred = Int_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%TwrCd)) DEALLOCATE(OutData%TwrCd) - ALLOCATE(OutData%TwrCd(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrCd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TwrCd,1), UBOUND(OutData%TwrCd,1) - OutData%TwrCd(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrTI not allocated - Int_Xferred = Int_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%TwrTI)) DEALLOCATE(OutData%TwrTI) - ALLOCATE(OutData%TwrTI(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrTI.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TwrTI,1), UBOUND(OutData%TwrTI,1) - OutData%TwrTI(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrCb not allocated - Int_Xferred = Int_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%TwrCb)) DEALLOCATE(OutData%TwrCb) - ALLOCATE(OutData%TwrCb(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrCb.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TwrCb,1), UBOUND(OutData%TwrCb,1) - OutData%TwrCb(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%VolHub = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%HubCenBx = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%VolNac = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%NacCenB,1) - i1_u = UBOUND(OutData%NacCenB,1) - DO i1 = LBOUND(OutData%NacCenB,1), UBOUND(OutData%NacCenB,1) - OutData%NacCenB(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%TFinAero = TRANSFER(IntKiBuf(Int_Xferred), OutData%TFinAero) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%TFinFile) - OutData%TFinFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - 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 AD_Unpacktfininputfiletype( Re_Buf, Db_Buf, Int_Buf, OutData%TFin, ErrStat2, ErrMsg2 ) ! TFin - 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 AD_UnPackRotInputFile - - SUBROUTINE AD_CopyInputFile( SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AD_InputFile), INTENT(IN) :: SrcInputFileData - TYPE(AD_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 = 'AD_CopyInputFile' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInputFileData%Echo = SrcInputFileData%Echo - DstInputFileData%DTAero = SrcInputFileData%DTAero - DstInputFileData%WakeMod = SrcInputFileData%WakeMod - DstInputFileData%AFAeroMod = SrcInputFileData%AFAeroMod - DstInputFileData%TwrPotent = SrcInputFileData%TwrPotent - DstInputFileData%TwrShadow = SrcInputFileData%TwrShadow - DstInputFileData%TwrAero = SrcInputFileData%TwrAero - DstInputFileData%FrozenWake = SrcInputFileData%FrozenWake - DstInputFileData%CavitCheck = SrcInputFileData%CavitCheck - DstInputFileData%Buoyancy = SrcInputFileData%Buoyancy - DstInputFileData%CompAA = SrcInputFileData%CompAA - DstInputFileData%AA_InputFile = SrcInputFileData%AA_InputFile -IF (ALLOCATED(SrcInputFileData%ADBlFile)) THEN - i1_l = LBOUND(SrcInputFileData%ADBlFile,1) - i1_u = UBOUND(SrcInputFileData%ADBlFile,1) - IF (.NOT. ALLOCATED(DstInputFileData%ADBlFile)) THEN - ALLOCATE(DstInputFileData%ADBlFile(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%ADBlFile.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%ADBlFile = SrcInputFileData%ADBlFile -ENDIF - DstInputFileData%AirDens = SrcInputFileData%AirDens - DstInputFileData%KinVisc = SrcInputFileData%KinVisc - DstInputFileData%Patm = SrcInputFileData%Patm - DstInputFileData%Pvap = SrcInputFileData%Pvap - DstInputFileData%SpdSound = SrcInputFileData%SpdSound - DstInputFileData%SkewMod = SrcInputFileData%SkewMod - DstInputFileData%SkewModFactor = SrcInputFileData%SkewModFactor - DstInputFileData%TipLoss = SrcInputFileData%TipLoss - DstInputFileData%HubLoss = SrcInputFileData%HubLoss - DstInputFileData%TanInd = SrcInputFileData%TanInd - DstInputFileData%AIDrag = SrcInputFileData%AIDrag - DstInputFileData%TIDrag = SrcInputFileData%TIDrag - DstInputFileData%IndToler = SrcInputFileData%IndToler - DstInputFileData%MaxIter = SrcInputFileData%MaxIter - DstInputFileData%UAMod = SrcInputFileData%UAMod - DstInputFileData%FLookup = SrcInputFileData%FLookup - DstInputFileData%InCol_Alfa = SrcInputFileData%InCol_Alfa - DstInputFileData%InCol_Cl = SrcInputFileData%InCol_Cl - DstInputFileData%InCol_Cd = SrcInputFileData%InCol_Cd - DstInputFileData%InCol_Cm = SrcInputFileData%InCol_Cm - DstInputFileData%InCol_Cpmin = SrcInputFileData%InCol_Cpmin - DstInputFileData%AFTabMod = SrcInputFileData%AFTabMod - DstInputFileData%NumAFfiles = SrcInputFileData%NumAFfiles - DstInputFileData%FVWFileName = SrcInputFileData%FVWFileName -IF (ALLOCATED(SrcInputFileData%AFNames)) THEN - i1_l = LBOUND(SrcInputFileData%AFNames,1) - i1_u = UBOUND(SrcInputFileData%AFNames,1) - IF (.NOT. ALLOCATED(DstInputFileData%AFNames)) THEN - ALLOCATE(DstInputFileData%AFNames(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%AFNames.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%AFNames = SrcInputFileData%AFNames -ENDIF - DstInputFileData%UseBlCm = SrcInputFileData%UseBlCm - DstInputFileData%SumPrint = SrcInputFileData%SumPrint - DstInputFileData%NBlOuts = SrcInputFileData%NBlOuts - DstInputFileData%BlOutNd = SrcInputFileData%BlOutNd - DstInputFileData%NTwOuts = SrcInputFileData%NTwOuts - DstInputFileData%TwOutNd = SrcInputFileData%TwOutNd - 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%tau1_const = SrcInputFileData%tau1_const - DstInputFileData%DBEMT_Mod = SrcInputFileData%DBEMT_Mod - DstInputFileData%BldNd_NumOuts = SrcInputFileData%BldNd_NumOuts -IF (ALLOCATED(SrcInputFileData%BldNd_OutList)) THEN - i1_l = LBOUND(SrcInputFileData%BldNd_OutList,1) - i1_u = UBOUND(SrcInputFileData%BldNd_OutList,1) - IF (.NOT. ALLOCATED(DstInputFileData%BldNd_OutList)) THEN - ALLOCATE(DstInputFileData%BldNd_OutList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%BldNd_OutList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%BldNd_OutList = SrcInputFileData%BldNd_OutList -ENDIF - DstInputFileData%BldNd_BlOutNd_Str = SrcInputFileData%BldNd_BlOutNd_Str - DstInputFileData%BldNd_BladesOut = SrcInputFileData%BldNd_BladesOut - DstInputFileData%UAStartRad = SrcInputFileData%UAStartRad - DstInputFileData%UAEndRad = SrcInputFileData%UAEndRad -IF (ALLOCATED(SrcInputFileData%rotors)) THEN - i1_l = LBOUND(SrcInputFileData%rotors,1) - i1_u = UBOUND(SrcInputFileData%rotors,1) - IF (.NOT. ALLOCATED(DstInputFileData%rotors)) THEN - ALLOCATE(DstInputFileData%rotors(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%rotors.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcInputFileData%rotors,1), UBOUND(SrcInputFileData%rotors,1) - CALL AD_Copyrotinputfile( SrcInputFileData%rotors(i1), DstInputFileData%rotors(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - END SUBROUTINE AD_CopyInputFile - - SUBROUTINE AD_DestroyInputFile( InputFileData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(AD_InputFile), INTENT(INOUT) :: InputFileData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_DestroyInputFile' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(InputFileData%ADBlFile)) THEN - DEALLOCATE(InputFileData%ADBlFile) -ENDIF -IF (ALLOCATED(InputFileData%AFNames)) THEN - DEALLOCATE(InputFileData%AFNames) -ENDIF -IF (ALLOCATED(InputFileData%OutList)) THEN - DEALLOCATE(InputFileData%OutList) -ENDIF -IF (ALLOCATED(InputFileData%BldNd_OutList)) THEN - DEALLOCATE(InputFileData%BldNd_OutList) -ENDIF -IF (ALLOCATED(InputFileData%rotors)) THEN -DO i1 = LBOUND(InputFileData%rotors,1), UBOUND(InputFileData%rotors,1) - CALL AD_Destroyrotinputfile( InputFileData%rotors(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(InputFileData%rotors) -ENDIF - END SUBROUTINE AD_DestroyInputFile - - SUBROUTINE AD_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(AD_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 = 'AD_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 ! Echo - Db_BufSz = Db_BufSz + 1 ! DTAero - Int_BufSz = Int_BufSz + 1 ! WakeMod - Int_BufSz = Int_BufSz + 1 ! AFAeroMod - Int_BufSz = Int_BufSz + 1 ! TwrPotent - Int_BufSz = Int_BufSz + 1 ! TwrShadow - Int_BufSz = Int_BufSz + 1 ! TwrAero - Int_BufSz = Int_BufSz + 1 ! FrozenWake - Int_BufSz = Int_BufSz + 1 ! CavitCheck - Int_BufSz = Int_BufSz + 1 ! Buoyancy - Int_BufSz = Int_BufSz + 1 ! CompAA - Int_BufSz = Int_BufSz + 1*LEN(InData%AA_InputFile) ! AA_InputFile - Int_BufSz = Int_BufSz + 1 ! ADBlFile allocated yes/no - IF ( ALLOCATED(InData%ADBlFile) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ADBlFile upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%ADBlFile)*LEN(InData%ADBlFile) ! ADBlFile - END IF - Re_BufSz = Re_BufSz + 1 ! AirDens - Re_BufSz = Re_BufSz + 1 ! KinVisc - Re_BufSz = Re_BufSz + 1 ! Patm - Re_BufSz = Re_BufSz + 1 ! Pvap - Re_BufSz = Re_BufSz + 1 ! SpdSound - Int_BufSz = Int_BufSz + 1 ! SkewMod - Re_BufSz = Re_BufSz + 1 ! SkewModFactor - Int_BufSz = Int_BufSz + 1 ! TipLoss - Int_BufSz = Int_BufSz + 1 ! HubLoss - Int_BufSz = Int_BufSz + 1 ! TanInd - Int_BufSz = Int_BufSz + 1 ! AIDrag - Int_BufSz = Int_BufSz + 1 ! TIDrag - Re_BufSz = Re_BufSz + 1 ! IndToler - Re_BufSz = Re_BufSz + 1 ! MaxIter - Int_BufSz = Int_BufSz + 1 ! UAMod - Int_BufSz = Int_BufSz + 1 ! FLookup - Re_BufSz = Re_BufSz + 1 ! InCol_Alfa - Re_BufSz = Re_BufSz + 1 ! InCol_Cl - Re_BufSz = Re_BufSz + 1 ! InCol_Cd - Re_BufSz = Re_BufSz + 1 ! InCol_Cm - Re_BufSz = Re_BufSz + 1 ! InCol_Cpmin - Int_BufSz = Int_BufSz + 1 ! AFTabMod - Int_BufSz = Int_BufSz + 1 ! NumAFfiles - Int_BufSz = Int_BufSz + 1*LEN(InData%FVWFileName) ! FVWFileName - Int_BufSz = Int_BufSz + 1 ! AFNames allocated yes/no - IF ( ALLOCATED(InData%AFNames) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! AFNames upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%AFNames)*LEN(InData%AFNames) ! AFNames - END IF - Int_BufSz = Int_BufSz + 1 ! UseBlCm - Int_BufSz = Int_BufSz + 1 ! SumPrint - Int_BufSz = Int_BufSz + 1 ! NBlOuts - Int_BufSz = Int_BufSz + SIZE(InData%BlOutNd) ! BlOutNd - Int_BufSz = Int_BufSz + 1 ! NTwOuts - Int_BufSz = Int_BufSz + SIZE(InData%TwOutNd) ! TwOutNd - 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 - Re_BufSz = Re_BufSz + 1 ! tau1_const - Int_BufSz = Int_BufSz + 1 ! DBEMT_Mod - Int_BufSz = Int_BufSz + 1 ! BldNd_NumOuts - Int_BufSz = Int_BufSz + 1 ! BldNd_OutList allocated yes/no - IF ( ALLOCATED(InData%BldNd_OutList) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BldNd_OutList upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%BldNd_OutList)*LEN(InData%BldNd_OutList) ! BldNd_OutList - END IF - Int_BufSz = Int_BufSz + 1*LEN(InData%BldNd_BlOutNd_Str) ! BldNd_BlOutNd_Str - Int_BufSz = Int_BufSz + 1 ! BldNd_BladesOut - Re_BufSz = Re_BufSz + 1 ! UAStartRad - Re_BufSz = Re_BufSz + 1 ! UAEndRad - Int_BufSz = Int_BufSz + 1 ! rotors allocated yes/no - IF ( ALLOCATED(InData%rotors) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! rotors upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%rotors,1), UBOUND(InData%rotors,1) - Int_BufSz = Int_BufSz + 3 ! rotors: size of buffers for each call to pack subtype - CALL AD_Packrotinputfile( Re_Buf, Db_Buf, Int_Buf, InData%rotors(i1), ErrStat2, ErrMsg2, .TRUE. ) ! rotors - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! rotors - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! rotors - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! rotors - 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 - - IntKiBuf(Int_Xferred) = TRANSFER(InData%Echo, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%DTAero - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%WakeMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%AFAeroMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%TwrPotent - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%TwrShadow - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%TwrAero, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%FrozenWake, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%CavitCheck, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%Buoyancy, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%CompAA, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%AA_InputFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%AA_InputFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IF ( .NOT. ALLOCATED(InData%ADBlFile) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ADBlFile,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ADBlFile,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ADBlFile,1), UBOUND(InData%ADBlFile,1) - DO I = 1, LEN(InData%ADBlFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%ADBlFile(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - ReKiBuf(Re_Xferred) = InData%AirDens - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%KinVisc - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Patm - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Pvap - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%SpdSound - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%SkewMod - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%SkewModFactor - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%TipLoss, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%HubLoss, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%TanInd, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%AIDrag, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%TIDrag, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%IndToler - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MaxIter - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%UAMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%FLookup, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%InCol_Alfa - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%InCol_Cl - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%InCol_Cd - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%InCol_Cm - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%InCol_Cpmin - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%AFTabMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumAFfiles - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%FVWFileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%FVWFileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IF ( .NOT. ALLOCATED(InData%AFNames) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AFNames,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AFNames,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%AFNames,1), UBOUND(InData%AFNames,1) - DO I = 1, LEN(InData%AFNames) - IntKiBuf(Int_Xferred) = ICHAR(InData%AFNames(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IntKiBuf(Int_Xferred) = TRANSFER(InData%UseBlCm, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%SumPrint, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NBlOuts - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%BlOutNd,1), UBOUND(InData%BlOutNd,1) - IntKiBuf(Int_Xferred) = InData%BlOutNd(i1) - Int_Xferred = Int_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%NTwOuts - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%TwOutNd,1), UBOUND(InData%TwOutNd,1) - IntKiBuf(Int_Xferred) = InData%TwOutNd(i1) - Int_Xferred = Int_Xferred + 1 - END DO - 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 - ReKiBuf(Re_Xferred) = InData%tau1_const - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%DBEMT_Mod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%BldNd_NumOuts - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%BldNd_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%BldNd_OutList,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldNd_OutList,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BldNd_OutList,1), UBOUND(InData%BldNd_OutList,1) - DO I = 1, LEN(InData%BldNd_OutList) - IntKiBuf(Int_Xferred) = ICHAR(InData%BldNd_OutList(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - DO I = 1, LEN(InData%BldNd_BlOutNd_Str) - IntKiBuf(Int_Xferred) = ICHAR(InData%BldNd_BlOutNd_Str(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = InData%BldNd_BladesOut - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%UAStartRad - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%UAEndRad - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%rotors) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rotors,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rotors,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%rotors,1), UBOUND(InData%rotors,1) - CALL AD_Packrotinputfile( Re_Buf, Db_Buf, Int_Buf, InData%rotors(i1), ErrStat2, ErrMsg2, OnlySize ) ! rotors - 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 AD_PackInputFile - - SUBROUTINE AD_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(AD_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 = 'AD_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%Echo = TRANSFER(IntKiBuf(Int_Xferred), OutData%Echo) - Int_Xferred = Int_Xferred + 1 - OutData%DTAero = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%WakeMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%AFAeroMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TwrPotent = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TwrShadow = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TwrAero = TRANSFER(IntKiBuf(Int_Xferred), OutData%TwrAero) - Int_Xferred = Int_Xferred + 1 - OutData%FrozenWake = TRANSFER(IntKiBuf(Int_Xferred), OutData%FrozenWake) - Int_Xferred = Int_Xferred + 1 - OutData%CavitCheck = TRANSFER(IntKiBuf(Int_Xferred), OutData%CavitCheck) - Int_Xferred = Int_Xferred + 1 - OutData%Buoyancy = TRANSFER(IntKiBuf(Int_Xferred), OutData%Buoyancy) - Int_Xferred = Int_Xferred + 1 - OutData%CompAA = TRANSFER(IntKiBuf(Int_Xferred), OutData%CompAA) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%AA_InputFile) - OutData%AA_InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ADBlFile not allocated - Int_Xferred = Int_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%ADBlFile)) DEALLOCATE(OutData%ADBlFile) - ALLOCATE(OutData%ADBlFile(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ADBlFile.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ADBlFile,1), UBOUND(OutData%ADBlFile,1) - DO I = 1, LEN(OutData%ADBlFile) - OutData%ADBlFile(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - OutData%AirDens = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%KinVisc = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Patm = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Pvap = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SpdSound = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SkewMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%SkewModFactor = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TipLoss = TRANSFER(IntKiBuf(Int_Xferred), OutData%TipLoss) - Int_Xferred = Int_Xferred + 1 - OutData%HubLoss = TRANSFER(IntKiBuf(Int_Xferred), OutData%HubLoss) - Int_Xferred = Int_Xferred + 1 - OutData%TanInd = TRANSFER(IntKiBuf(Int_Xferred), OutData%TanInd) - Int_Xferred = Int_Xferred + 1 - OutData%AIDrag = TRANSFER(IntKiBuf(Int_Xferred), OutData%AIDrag) - Int_Xferred = Int_Xferred + 1 - OutData%TIDrag = TRANSFER(IntKiBuf(Int_Xferred), OutData%TIDrag) - Int_Xferred = Int_Xferred + 1 - OutData%IndToler = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MaxIter = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%UAMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%FLookup = TRANSFER(IntKiBuf(Int_Xferred), OutData%FLookup) - Int_Xferred = Int_Xferred + 1 - OutData%InCol_Alfa = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%InCol_Cl = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%InCol_Cd = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%InCol_Cm = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%InCol_Cpmin = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%AFTabMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumAFfiles = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%FVWFileName) - OutData%FVWFileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AFNames not allocated - Int_Xferred = Int_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%AFNames)) DEALLOCATE(OutData%AFNames) - ALLOCATE(OutData%AFNames(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AFNames.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%AFNames,1), UBOUND(OutData%AFNames,1) - DO I = 1, LEN(OutData%AFNames) - OutData%AFNames(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - OutData%UseBlCm = TRANSFER(IntKiBuf(Int_Xferred), OutData%UseBlCm) - Int_Xferred = Int_Xferred + 1 - OutData%SumPrint = TRANSFER(IntKiBuf(Int_Xferred), OutData%SumPrint) - Int_Xferred = Int_Xferred + 1 - OutData%NBlOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%BlOutNd,1) - i1_u = UBOUND(OutData%BlOutNd,1) - DO i1 = LBOUND(OutData%BlOutNd,1), UBOUND(OutData%BlOutNd,1) - OutData%BlOutNd(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - OutData%NTwOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%TwOutNd,1) - i1_u = UBOUND(OutData%TwOutNd,1) - DO i1 = LBOUND(OutData%TwOutNd,1), UBOUND(OutData%TwOutNd,1) - OutData%TwOutNd(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - 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 - OutData%tau1_const = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%DBEMT_Mod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%BldNd_NumOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldNd_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%BldNd_OutList)) DEALLOCATE(OutData%BldNd_OutList) - ALLOCATE(OutData%BldNd_OutList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldNd_OutList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BldNd_OutList,1), UBOUND(OutData%BldNd_OutList,1) - DO I = 1, LEN(OutData%BldNd_OutList) - OutData%BldNd_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%BldNd_BlOutNd_Str) - OutData%BldNd_BlOutNd_Str(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%BldNd_BladesOut = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%UAStartRad = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%UAEndRad = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rotors not allocated - Int_Xferred = Int_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%rotors)) DEALLOCATE(OutData%rotors) - ALLOCATE(OutData%rotors(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotors.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%rotors,1), UBOUND(OutData%rotors,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 AD_Unpackrotinputfile( Re_Buf, Db_Buf, Int_Buf, OutData%rotors(i1), ErrStat2, ErrMsg2 ) ! rotors - 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 AD_UnPackInputFile - - SUBROUTINE AD_CopyRotContinuousStateType( SrcRotContinuousStateTypeData, DstRotContinuousStateTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(RotContinuousStateType), INTENT(IN) :: SrcRotContinuousStateTypeData - TYPE(RotContinuousStateType), INTENT(INOUT) :: DstRotContinuousStateTypeData - 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 = 'AD_CopyRotContinuousStateType' -! - ErrStat = ErrID_None - ErrMsg = "" - CALL BEMT_CopyContState( SrcRotContinuousStateTypeData%BEMT, DstRotContinuousStateTypeData%BEMT, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AA_CopyContState( SrcRotContinuousStateTypeData%AA, DstRotContinuousStateTypeData%AA, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE AD_CopyRotContinuousStateType - - SUBROUTINE AD_DestroyRotContinuousStateType( RotContinuousStateTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(RotContinuousStateType), INTENT(INOUT) :: RotContinuousStateTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_DestroyRotContinuousStateType' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL BEMT_DestroyContState( RotContinuousStateTypeData%BEMT, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AA_DestroyContState( RotContinuousStateTypeData%AA, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE AD_DestroyRotContinuousStateType - - SUBROUTINE AD_PackRotContinuousStateType( 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(RotContinuousStateType), 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 = 'AD_PackRotContinuousStateType' - ! 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 ! BEMT: size of buffers for each call to pack subtype - CALL BEMT_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%BEMT, ErrStat2, ErrMsg2, .TRUE. ) ! BEMT - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BEMT - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BEMT - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BEMT - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! AA: size of buffers for each call to pack subtype - CALL AA_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%AA, ErrStat2, ErrMsg2, .TRUE. ) ! AA - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! AA - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! AA - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! AA - 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 BEMT_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%BEMT, ErrStat2, ErrMsg2, OnlySize ) ! BEMT - 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 AA_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%AA, ErrStat2, ErrMsg2, OnlySize ) ! AA - 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 AD_PackRotContinuousStateType - - SUBROUTINE AD_UnPackRotContinuousStateType( 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(RotContinuousStateType), 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 = 'AD_UnPackRotContinuousStateType' - ! 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 BEMT_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%BEMT, ErrStat2, ErrMsg2 ) ! BEMT - 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 AA_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%AA, ErrStat2, ErrMsg2 ) ! AA - 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 AD_UnPackRotContinuousStateType - - SUBROUTINE AD_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AD_ContinuousStateType), INTENT(IN) :: SrcContStateData - TYPE(AD_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 = 'AD_CopyContState' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcContStateData%rotors)) THEN - i1_l = LBOUND(SrcContStateData%rotors,1) - i1_u = UBOUND(SrcContStateData%rotors,1) - IF (.NOT. ALLOCATED(DstContStateData%rotors)) THEN - ALLOCATE(DstContStateData%rotors(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%rotors.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcContStateData%rotors,1), UBOUND(SrcContStateData%rotors,1) - CALL AD_Copyrotcontinuousstatetype( SrcContStateData%rotors(i1), DstContStateData%rotors(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL FVW_CopyContState( SrcContStateData%FVW, DstContStateData%FVW, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE AD_CopyContState - - SUBROUTINE AD_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(AD_ContinuousStateType), INTENT(INOUT) :: ContStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_DestroyContState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(ContStateData%rotors)) THEN -DO i1 = LBOUND(ContStateData%rotors,1), UBOUND(ContStateData%rotors,1) - CALL AD_Destroyrotcontinuousstatetype( ContStateData%rotors(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ContStateData%rotors) -ENDIF - CALL FVW_DestroyContState( ContStateData%FVW, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE AD_DestroyContState - - SUBROUTINE AD_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(AD_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 = 'AD_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 ! rotors allocated yes/no - IF ( ALLOCATED(InData%rotors) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! rotors upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%rotors,1), UBOUND(InData%rotors,1) - Int_BufSz = Int_BufSz + 3 ! rotors: size of buffers for each call to pack subtype - CALL AD_Packrotcontinuousstatetype( Re_Buf, Db_Buf, Int_Buf, InData%rotors(i1), ErrStat2, ErrMsg2, .TRUE. ) ! rotors - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! rotors - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! rotors - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! rotors - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! FVW: size of buffers for each call to pack subtype - CALL FVW_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%FVW, ErrStat2, ErrMsg2, .TRUE. ) ! FVW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! FVW - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! FVW - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! FVW - 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%rotors) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rotors,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rotors,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%rotors,1), UBOUND(InData%rotors,1) - CALL AD_Packrotcontinuousstatetype( Re_Buf, Db_Buf, Int_Buf, InData%rotors(i1), ErrStat2, ErrMsg2, OnlySize ) ! rotors - 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 - CALL FVW_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%FVW, ErrStat2, ErrMsg2, OnlySize ) ! FVW - 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 AD_PackContState - - SUBROUTINE AD_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(AD_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 = 'AD_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 ! rotors not allocated - Int_Xferred = Int_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%rotors)) DEALLOCATE(OutData%rotors) - ALLOCATE(OutData%rotors(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotors.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%rotors,1), UBOUND(OutData%rotors,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 AD_Unpackrotcontinuousstatetype( Re_Buf, Db_Buf, Int_Buf, OutData%rotors(i1), ErrStat2, ErrMsg2 ) ! rotors - 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 - 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 FVW_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%FVW, ErrStat2, ErrMsg2 ) ! FVW - 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 AD_UnPackContState - - SUBROUTINE AD_CopyRotDiscreteStateType( SrcRotDiscreteStateTypeData, DstRotDiscreteStateTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(RotDiscreteStateType), INTENT(IN) :: SrcRotDiscreteStateTypeData - TYPE(RotDiscreteStateType), INTENT(INOUT) :: DstRotDiscreteStateTypeData - 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 = 'AD_CopyRotDiscreteStateType' -! - ErrStat = ErrID_None - ErrMsg = "" - CALL BEMT_CopyDiscState( SrcRotDiscreteStateTypeData%BEMT, DstRotDiscreteStateTypeData%BEMT, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AA_CopyDiscState( SrcRotDiscreteStateTypeData%AA, DstRotDiscreteStateTypeData%AA, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE AD_CopyRotDiscreteStateType - - SUBROUTINE AD_DestroyRotDiscreteStateType( RotDiscreteStateTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(RotDiscreteStateType), INTENT(INOUT) :: RotDiscreteStateTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_DestroyRotDiscreteStateType' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL BEMT_DestroyDiscState( RotDiscreteStateTypeData%BEMT, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AA_DestroyDiscState( RotDiscreteStateTypeData%AA, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE AD_DestroyRotDiscreteStateType - - SUBROUTINE AD_PackRotDiscreteStateType( 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(RotDiscreteStateType), 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 = 'AD_PackRotDiscreteStateType' - ! 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 ! BEMT: size of buffers for each call to pack subtype - CALL BEMT_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%BEMT, ErrStat2, ErrMsg2, .TRUE. ) ! BEMT - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BEMT - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BEMT - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BEMT - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! AA: size of buffers for each call to pack subtype - CALL AA_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%AA, ErrStat2, ErrMsg2, .TRUE. ) ! AA - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! AA - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! AA - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! AA - 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 BEMT_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%BEMT, ErrStat2, ErrMsg2, OnlySize ) ! BEMT - 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 AA_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%AA, ErrStat2, ErrMsg2, OnlySize ) ! AA - 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 AD_PackRotDiscreteStateType - - SUBROUTINE AD_UnPackRotDiscreteStateType( 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(RotDiscreteStateType), 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 = 'AD_UnPackRotDiscreteStateType' - ! 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 BEMT_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%BEMT, ErrStat2, ErrMsg2 ) ! BEMT - 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 AA_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%AA, ErrStat2, ErrMsg2 ) ! AA - 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 AD_UnPackRotDiscreteStateType - - SUBROUTINE AD_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AD_DiscreteStateType), INTENT(IN) :: SrcDiscStateData - TYPE(AD_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 = 'AD_CopyDiscState' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcDiscStateData%rotors)) THEN - i1_l = LBOUND(SrcDiscStateData%rotors,1) - i1_u = UBOUND(SrcDiscStateData%rotors,1) - IF (.NOT. ALLOCATED(DstDiscStateData%rotors)) THEN - ALLOCATE(DstDiscStateData%rotors(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%rotors.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcDiscStateData%rotors,1), UBOUND(SrcDiscStateData%rotors,1) - CALL AD_Copyrotdiscretestatetype( SrcDiscStateData%rotors(i1), DstDiscStateData%rotors(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL FVW_CopyDiscState( SrcDiscStateData%FVW, DstDiscStateData%FVW, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE AD_CopyDiscState - - SUBROUTINE AD_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(AD_DiscreteStateType), INTENT(INOUT) :: DiscStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_DestroyDiscState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(DiscStateData%rotors)) THEN -DO i1 = LBOUND(DiscStateData%rotors,1), UBOUND(DiscStateData%rotors,1) - CALL AD_Destroyrotdiscretestatetype( DiscStateData%rotors(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(DiscStateData%rotors) -ENDIF - CALL FVW_DestroyDiscState( DiscStateData%FVW, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE AD_DestroyDiscState - - SUBROUTINE AD_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(AD_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 = 'AD_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 ! rotors allocated yes/no - IF ( ALLOCATED(InData%rotors) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! rotors upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%rotors,1), UBOUND(InData%rotors,1) - Int_BufSz = Int_BufSz + 3 ! rotors: size of buffers for each call to pack subtype - CALL AD_Packrotdiscretestatetype( Re_Buf, Db_Buf, Int_Buf, InData%rotors(i1), ErrStat2, ErrMsg2, .TRUE. ) ! rotors - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! rotors - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! rotors - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! rotors - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! FVW: size of buffers for each call to pack subtype - CALL FVW_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%FVW, ErrStat2, ErrMsg2, .TRUE. ) ! FVW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! FVW - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! FVW - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! FVW - 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%rotors) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rotors,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rotors,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%rotors,1), UBOUND(InData%rotors,1) - CALL AD_Packrotdiscretestatetype( Re_Buf, Db_Buf, Int_Buf, InData%rotors(i1), ErrStat2, ErrMsg2, OnlySize ) ! rotors - 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 - CALL FVW_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%FVW, ErrStat2, ErrMsg2, OnlySize ) ! FVW - 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 AD_PackDiscState - - SUBROUTINE AD_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(AD_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 = 'AD_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 ! rotors not allocated - Int_Xferred = Int_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%rotors)) DEALLOCATE(OutData%rotors) - ALLOCATE(OutData%rotors(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotors.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%rotors,1), UBOUND(OutData%rotors,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 AD_Unpackrotdiscretestatetype( Re_Buf, Db_Buf, Int_Buf, OutData%rotors(i1), ErrStat2, ErrMsg2 ) ! rotors - 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 - 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 FVW_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%FVW, ErrStat2, ErrMsg2 ) ! FVW - 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 AD_UnPackDiscState - - SUBROUTINE AD_CopyRotConstraintStateType( SrcRotConstraintStateTypeData, DstRotConstraintStateTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(RotConstraintStateType), INTENT(IN) :: SrcRotConstraintStateTypeData - TYPE(RotConstraintStateType), INTENT(INOUT) :: DstRotConstraintStateTypeData - 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 = 'AD_CopyRotConstraintStateType' -! - ErrStat = ErrID_None - ErrMsg = "" - CALL BEMT_CopyConstrState( SrcRotConstraintStateTypeData%BEMT, DstRotConstraintStateTypeData%BEMT, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AA_CopyConstrState( SrcRotConstraintStateTypeData%AA, DstRotConstraintStateTypeData%AA, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE AD_CopyRotConstraintStateType - - SUBROUTINE AD_DestroyRotConstraintStateType( RotConstraintStateTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(RotConstraintStateType), INTENT(INOUT) :: RotConstraintStateTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_DestroyRotConstraintStateType' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL BEMT_DestroyConstrState( RotConstraintStateTypeData%BEMT, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AA_DestroyConstrState( RotConstraintStateTypeData%AA, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE AD_DestroyRotConstraintStateType - - SUBROUTINE AD_PackRotConstraintStateType( 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(RotConstraintStateType), 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 = 'AD_PackRotConstraintStateType' - ! 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 ! BEMT: size of buffers for each call to pack subtype - CALL BEMT_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%BEMT, ErrStat2, ErrMsg2, .TRUE. ) ! BEMT - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BEMT - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BEMT - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BEMT - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! AA: size of buffers for each call to pack subtype - CALL AA_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%AA, ErrStat2, ErrMsg2, .TRUE. ) ! AA - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! AA - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! AA - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! AA - 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 BEMT_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%BEMT, ErrStat2, ErrMsg2, OnlySize ) ! BEMT - 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 AA_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%AA, ErrStat2, ErrMsg2, OnlySize ) ! AA - 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 AD_PackRotConstraintStateType - - SUBROUTINE AD_UnPackRotConstraintStateType( 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(RotConstraintStateType), 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 = 'AD_UnPackRotConstraintStateType' - ! 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 BEMT_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%BEMT, ErrStat2, ErrMsg2 ) ! BEMT - 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 AA_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%AA, ErrStat2, ErrMsg2 ) ! AA - 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 AD_UnPackRotConstraintStateType - - SUBROUTINE AD_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AD_ConstraintStateType), INTENT(IN) :: SrcConstrStateData - TYPE(AD_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 = 'AD_CopyConstrState' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcConstrStateData%rotors)) THEN - i1_l = LBOUND(SrcConstrStateData%rotors,1) - i1_u = UBOUND(SrcConstrStateData%rotors,1) - IF (.NOT. ALLOCATED(DstConstrStateData%rotors)) THEN - ALLOCATE(DstConstrStateData%rotors(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstConstrStateData%rotors.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcConstrStateData%rotors,1), UBOUND(SrcConstrStateData%rotors,1) - CALL AD_Copyrotconstraintstatetype( SrcConstrStateData%rotors(i1), DstConstrStateData%rotors(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL FVW_CopyConstrState( SrcConstrStateData%FVW, DstConstrStateData%FVW, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE AD_CopyConstrState - - SUBROUTINE AD_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(AD_ConstraintStateType), INTENT(INOUT) :: ConstrStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_DestroyConstrState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(ConstrStateData%rotors)) THEN -DO i1 = LBOUND(ConstrStateData%rotors,1), UBOUND(ConstrStateData%rotors,1) - CALL AD_Destroyrotconstraintstatetype( ConstrStateData%rotors(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ConstrStateData%rotors) -ENDIF - CALL FVW_DestroyConstrState( ConstrStateData%FVW, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE AD_DestroyConstrState - - SUBROUTINE AD_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(AD_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 = 'AD_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 - Int_BufSz = Int_BufSz + 1 ! rotors allocated yes/no - IF ( ALLOCATED(InData%rotors) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! rotors upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%rotors,1), UBOUND(InData%rotors,1) - Int_BufSz = Int_BufSz + 3 ! rotors: size of buffers for each call to pack subtype - CALL AD_Packrotconstraintstatetype( Re_Buf, Db_Buf, Int_Buf, InData%rotors(i1), ErrStat2, ErrMsg2, .TRUE. ) ! rotors - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! rotors - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! rotors - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! rotors - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! FVW: size of buffers for each call to pack subtype - CALL FVW_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%FVW, ErrStat2, ErrMsg2, .TRUE. ) ! FVW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! FVW - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! FVW - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! FVW - 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%rotors) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rotors,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rotors,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%rotors,1), UBOUND(InData%rotors,1) - CALL AD_Packrotconstraintstatetype( Re_Buf, Db_Buf, Int_Buf, InData%rotors(i1), ErrStat2, ErrMsg2, OnlySize ) ! rotors - 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 - CALL FVW_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%FVW, ErrStat2, ErrMsg2, OnlySize ) ! FVW - 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 AD_PackConstrState - - SUBROUTINE AD_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(AD_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 = 'AD_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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rotors not allocated - Int_Xferred = Int_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%rotors)) DEALLOCATE(OutData%rotors) - ALLOCATE(OutData%rotors(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotors.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%rotors,1), UBOUND(OutData%rotors,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 AD_Unpackrotconstraintstatetype( Re_Buf, Db_Buf, Int_Buf, OutData%rotors(i1), ErrStat2, ErrMsg2 ) ! rotors - 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 - 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 FVW_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%FVW, ErrStat2, ErrMsg2 ) ! FVW - 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 AD_UnPackConstrState - - SUBROUTINE AD_CopyRotOtherStateType( SrcRotOtherStateTypeData, DstRotOtherStateTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(RotOtherStateType), INTENT(IN) :: SrcRotOtherStateTypeData - TYPE(RotOtherStateType), INTENT(INOUT) :: DstRotOtherStateTypeData - 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 = 'AD_CopyRotOtherStateType' -! - ErrStat = ErrID_None - ErrMsg = "" - CALL BEMT_CopyOtherState( SrcRotOtherStateTypeData%BEMT, DstRotOtherStateTypeData%BEMT, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AA_CopyOtherState( SrcRotOtherStateTypeData%AA, DstRotOtherStateTypeData%AA, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE AD_CopyRotOtherStateType - - SUBROUTINE AD_DestroyRotOtherStateType( RotOtherStateTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(RotOtherStateType), INTENT(INOUT) :: RotOtherStateTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_DestroyRotOtherStateType' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL BEMT_DestroyOtherState( RotOtherStateTypeData%BEMT, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AA_DestroyOtherState( RotOtherStateTypeData%AA, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE AD_DestroyRotOtherStateType - - SUBROUTINE AD_PackRotOtherStateType( 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(RotOtherStateType), 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 = 'AD_PackRotOtherStateType' - ! 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 ! BEMT: size of buffers for each call to pack subtype - CALL BEMT_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%BEMT, ErrStat2, ErrMsg2, .TRUE. ) ! BEMT - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BEMT - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BEMT - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BEMT - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! AA: size of buffers for each call to pack subtype - CALL AA_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%AA, ErrStat2, ErrMsg2, .TRUE. ) ! AA - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! AA - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! AA - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! AA - 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 BEMT_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%BEMT, ErrStat2, ErrMsg2, OnlySize ) ! BEMT - 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 AA_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%AA, ErrStat2, ErrMsg2, OnlySize ) ! AA - 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 AD_PackRotOtherStateType - - SUBROUTINE AD_UnPackRotOtherStateType( 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(RotOtherStateType), 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 = 'AD_UnPackRotOtherStateType' - ! 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 BEMT_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%BEMT, ErrStat2, ErrMsg2 ) ! BEMT - 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 AA_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%AA, ErrStat2, ErrMsg2 ) ! AA - 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 AD_UnPackRotOtherStateType - - SUBROUTINE AD_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AD_OtherStateType), INTENT(IN) :: SrcOtherStateData - TYPE(AD_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) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_CopyOtherState' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcOtherStateData%rotors)) THEN - i1_l = LBOUND(SrcOtherStateData%rotors,1) - i1_u = UBOUND(SrcOtherStateData%rotors,1) - IF (.NOT. ALLOCATED(DstOtherStateData%rotors)) THEN - ALLOCATE(DstOtherStateData%rotors(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%rotors.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcOtherStateData%rotors,1), UBOUND(SrcOtherStateData%rotors,1) - CALL AD_Copyrototherstatetype( SrcOtherStateData%rotors(i1), DstOtherStateData%rotors(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL FVW_CopyOtherState( SrcOtherStateData%FVW, DstOtherStateData%FVW, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcOtherStateData%WakeLocationPoints)) THEN - i1_l = LBOUND(SrcOtherStateData%WakeLocationPoints,1) - i1_u = UBOUND(SrcOtherStateData%WakeLocationPoints,1) - i2_l = LBOUND(SrcOtherStateData%WakeLocationPoints,2) - i2_u = UBOUND(SrcOtherStateData%WakeLocationPoints,2) - IF (.NOT. ALLOCATED(DstOtherStateData%WakeLocationPoints)) THEN - ALLOCATE(DstOtherStateData%WakeLocationPoints(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%WakeLocationPoints.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOtherStateData%WakeLocationPoints = SrcOtherStateData%WakeLocationPoints -ENDIF - END SUBROUTINE AD_CopyOtherState - - SUBROUTINE AD_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(AD_OtherStateType), INTENT(INOUT) :: OtherStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_DestroyOtherState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(OtherStateData%rotors)) THEN -DO i1 = LBOUND(OtherStateData%rotors,1), UBOUND(OtherStateData%rotors,1) - CALL AD_Destroyrototherstatetype( OtherStateData%rotors(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(OtherStateData%rotors) -ENDIF - CALL FVW_DestroyOtherState( OtherStateData%FVW, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(OtherStateData%WakeLocationPoints)) THEN - DEALLOCATE(OtherStateData%WakeLocationPoints) -ENDIF - END SUBROUTINE AD_DestroyOtherState - - SUBROUTINE AD_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(AD_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 = 'AD_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 ! rotors allocated yes/no - IF ( ALLOCATED(InData%rotors) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! rotors upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%rotors,1), UBOUND(InData%rotors,1) - Int_BufSz = Int_BufSz + 3 ! rotors: size of buffers for each call to pack subtype - CALL AD_Packrototherstatetype( Re_Buf, Db_Buf, Int_Buf, InData%rotors(i1), ErrStat2, ErrMsg2, .TRUE. ) ! rotors - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! rotors - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! rotors - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! rotors - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! FVW: size of buffers for each call to pack subtype - CALL FVW_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%FVW, ErrStat2, ErrMsg2, .TRUE. ) ! FVW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! FVW - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! FVW - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! FVW - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! WakeLocationPoints allocated yes/no - IF ( ALLOCATED(InData%WakeLocationPoints) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! WakeLocationPoints upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WakeLocationPoints) ! WakeLocationPoints - 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%rotors) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rotors,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rotors,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%rotors,1), UBOUND(InData%rotors,1) - CALL AD_Packrototherstatetype( Re_Buf, Db_Buf, Int_Buf, InData%rotors(i1), ErrStat2, ErrMsg2, OnlySize ) ! rotors - 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 - CALL FVW_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%FVW, ErrStat2, ErrMsg2, OnlySize ) ! FVW - 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%WakeLocationPoints) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WakeLocationPoints,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WakeLocationPoints,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WakeLocationPoints,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WakeLocationPoints,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%WakeLocationPoints,2), UBOUND(InData%WakeLocationPoints,2) - DO i1 = LBOUND(InData%WakeLocationPoints,1), UBOUND(InData%WakeLocationPoints,1) - ReKiBuf(Re_Xferred) = InData%WakeLocationPoints(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE AD_PackOtherState - - SUBROUTINE AD_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(AD_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) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_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 ! rotors not allocated - Int_Xferred = Int_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%rotors)) DEALLOCATE(OutData%rotors) - ALLOCATE(OutData%rotors(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotors.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%rotors,1), UBOUND(OutData%rotors,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 AD_Unpackrototherstatetype( Re_Buf, Db_Buf, Int_Buf, OutData%rotors(i1), ErrStat2, ErrMsg2 ) ! rotors - 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 - 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 FVW_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%FVW, ErrStat2, ErrMsg2 ) ! FVW - 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 ! WakeLocationPoints not allocated - Int_Xferred = Int_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%WakeLocationPoints)) DEALLOCATE(OutData%WakeLocationPoints) - ALLOCATE(OutData%WakeLocationPoints(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WakeLocationPoints.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%WakeLocationPoints,2), UBOUND(OutData%WakeLocationPoints,2) - DO i1 = LBOUND(OutData%WakeLocationPoints,1), UBOUND(OutData%WakeLocationPoints,1) - OutData%WakeLocationPoints(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE AD_UnPackOtherState - - SUBROUTINE AD_CopyRotMiscVarType( SrcRotMiscVarTypeData, DstRotMiscVarTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(RotMiscVarType), INTENT(INOUT) :: SrcRotMiscVarTypeData - TYPE(RotMiscVarType), INTENT(INOUT) :: DstRotMiscVarTypeData - 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 = 'AD_CopyRotMiscVarType' -! - ErrStat = ErrID_None - ErrMsg = "" - CALL BEMT_CopyMisc( SrcRotMiscVarTypeData%BEMT, DstRotMiscVarTypeData%BEMT, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL BEMT_CopyOutput( SrcRotMiscVarTypeData%BEMT_y, DstRotMiscVarTypeData%BEMT_y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DO i1 = LBOUND(SrcRotMiscVarTypeData%BEMT_u,1), UBOUND(SrcRotMiscVarTypeData%BEMT_u,1) - CALL BEMT_CopyInput( SrcRotMiscVarTypeData%BEMT_u(i1), DstRotMiscVarTypeData%BEMT_u(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - CALL AA_CopyMisc( SrcRotMiscVarTypeData%AA, DstRotMiscVarTypeData%AA, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AA_CopyOutput( SrcRotMiscVarTypeData%AA_y, DstRotMiscVarTypeData%AA_y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AA_CopyInput( SrcRotMiscVarTypeData%AA_u, DstRotMiscVarTypeData%AA_u, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcRotMiscVarTypeData%DisturbedInflow)) THEN - i1_l = LBOUND(SrcRotMiscVarTypeData%DisturbedInflow,1) - i1_u = UBOUND(SrcRotMiscVarTypeData%DisturbedInflow,1) - i2_l = LBOUND(SrcRotMiscVarTypeData%DisturbedInflow,2) - i2_u = UBOUND(SrcRotMiscVarTypeData%DisturbedInflow,2) - i3_l = LBOUND(SrcRotMiscVarTypeData%DisturbedInflow,3) - i3_u = UBOUND(SrcRotMiscVarTypeData%DisturbedInflow,3) - IF (.NOT. ALLOCATED(DstRotMiscVarTypeData%DisturbedInflow)) THEN - ALLOCATE(DstRotMiscVarTypeData%DisturbedInflow(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%DisturbedInflow.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotMiscVarTypeData%DisturbedInflow = SrcRotMiscVarTypeData%DisturbedInflow -ENDIF -IF (ALLOCATED(SrcRotMiscVarTypeData%orientationAnnulus)) THEN - i1_l = LBOUND(SrcRotMiscVarTypeData%orientationAnnulus,1) - i1_u = UBOUND(SrcRotMiscVarTypeData%orientationAnnulus,1) - i2_l = LBOUND(SrcRotMiscVarTypeData%orientationAnnulus,2) - i2_u = UBOUND(SrcRotMiscVarTypeData%orientationAnnulus,2) - i3_l = LBOUND(SrcRotMiscVarTypeData%orientationAnnulus,3) - i3_u = UBOUND(SrcRotMiscVarTypeData%orientationAnnulus,3) - i4_l = LBOUND(SrcRotMiscVarTypeData%orientationAnnulus,4) - i4_u = UBOUND(SrcRotMiscVarTypeData%orientationAnnulus,4) - IF (.NOT. ALLOCATED(DstRotMiscVarTypeData%orientationAnnulus)) THEN - ALLOCATE(DstRotMiscVarTypeData%orientationAnnulus(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 DstRotMiscVarTypeData%orientationAnnulus.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotMiscVarTypeData%orientationAnnulus = SrcRotMiscVarTypeData%orientationAnnulus -ENDIF -IF (ALLOCATED(SrcRotMiscVarTypeData%R_li)) THEN - i1_l = LBOUND(SrcRotMiscVarTypeData%R_li,1) - i1_u = UBOUND(SrcRotMiscVarTypeData%R_li,1) - i2_l = LBOUND(SrcRotMiscVarTypeData%R_li,2) - i2_u = UBOUND(SrcRotMiscVarTypeData%R_li,2) - i3_l = LBOUND(SrcRotMiscVarTypeData%R_li,3) - i3_u = UBOUND(SrcRotMiscVarTypeData%R_li,3) - i4_l = LBOUND(SrcRotMiscVarTypeData%R_li,4) - i4_u = UBOUND(SrcRotMiscVarTypeData%R_li,4) - IF (.NOT. ALLOCATED(DstRotMiscVarTypeData%R_li)) THEN - ALLOCATE(DstRotMiscVarTypeData%R_li(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 DstRotMiscVarTypeData%R_li.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotMiscVarTypeData%R_li = SrcRotMiscVarTypeData%R_li -ENDIF -IF (ALLOCATED(SrcRotMiscVarTypeData%AllOuts)) THEN - i1_l = LBOUND(SrcRotMiscVarTypeData%AllOuts,1) - i1_u = UBOUND(SrcRotMiscVarTypeData%AllOuts,1) - IF (.NOT. ALLOCATED(DstRotMiscVarTypeData%AllOuts)) THEN - ALLOCATE(DstRotMiscVarTypeData%AllOuts(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%AllOuts.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotMiscVarTypeData%AllOuts = SrcRotMiscVarTypeData%AllOuts -ENDIF -IF (ALLOCATED(SrcRotMiscVarTypeData%W_Twr)) THEN - i1_l = LBOUND(SrcRotMiscVarTypeData%W_Twr,1) - i1_u = UBOUND(SrcRotMiscVarTypeData%W_Twr,1) - IF (.NOT. ALLOCATED(DstRotMiscVarTypeData%W_Twr)) THEN - ALLOCATE(DstRotMiscVarTypeData%W_Twr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%W_Twr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotMiscVarTypeData%W_Twr = SrcRotMiscVarTypeData%W_Twr -ENDIF -IF (ALLOCATED(SrcRotMiscVarTypeData%X_Twr)) THEN - i1_l = LBOUND(SrcRotMiscVarTypeData%X_Twr,1) - i1_u = UBOUND(SrcRotMiscVarTypeData%X_Twr,1) - IF (.NOT. ALLOCATED(DstRotMiscVarTypeData%X_Twr)) THEN - ALLOCATE(DstRotMiscVarTypeData%X_Twr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%X_Twr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotMiscVarTypeData%X_Twr = SrcRotMiscVarTypeData%X_Twr -ENDIF -IF (ALLOCATED(SrcRotMiscVarTypeData%Y_Twr)) THEN - i1_l = LBOUND(SrcRotMiscVarTypeData%Y_Twr,1) - i1_u = UBOUND(SrcRotMiscVarTypeData%Y_Twr,1) - IF (.NOT. ALLOCATED(DstRotMiscVarTypeData%Y_Twr)) THEN - ALLOCATE(DstRotMiscVarTypeData%Y_Twr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%Y_Twr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotMiscVarTypeData%Y_Twr = SrcRotMiscVarTypeData%Y_Twr -ENDIF -IF (ALLOCATED(SrcRotMiscVarTypeData%Curve)) THEN - i1_l = LBOUND(SrcRotMiscVarTypeData%Curve,1) - i1_u = UBOUND(SrcRotMiscVarTypeData%Curve,1) - i2_l = LBOUND(SrcRotMiscVarTypeData%Curve,2) - i2_u = UBOUND(SrcRotMiscVarTypeData%Curve,2) - IF (.NOT. ALLOCATED(DstRotMiscVarTypeData%Curve)) THEN - ALLOCATE(DstRotMiscVarTypeData%Curve(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%Curve.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotMiscVarTypeData%Curve = SrcRotMiscVarTypeData%Curve -ENDIF -IF (ALLOCATED(SrcRotMiscVarTypeData%TwrClrnc)) THEN - i1_l = LBOUND(SrcRotMiscVarTypeData%TwrClrnc,1) - i1_u = UBOUND(SrcRotMiscVarTypeData%TwrClrnc,1) - i2_l = LBOUND(SrcRotMiscVarTypeData%TwrClrnc,2) - i2_u = UBOUND(SrcRotMiscVarTypeData%TwrClrnc,2) - IF (.NOT. ALLOCATED(DstRotMiscVarTypeData%TwrClrnc)) THEN - ALLOCATE(DstRotMiscVarTypeData%TwrClrnc(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%TwrClrnc.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotMiscVarTypeData%TwrClrnc = SrcRotMiscVarTypeData%TwrClrnc -ENDIF -IF (ALLOCATED(SrcRotMiscVarTypeData%X)) THEN - i1_l = LBOUND(SrcRotMiscVarTypeData%X,1) - i1_u = UBOUND(SrcRotMiscVarTypeData%X,1) - i2_l = LBOUND(SrcRotMiscVarTypeData%X,2) - i2_u = UBOUND(SrcRotMiscVarTypeData%X,2) - IF (.NOT. ALLOCATED(DstRotMiscVarTypeData%X)) THEN - ALLOCATE(DstRotMiscVarTypeData%X(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%X.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotMiscVarTypeData%X = SrcRotMiscVarTypeData%X -ENDIF -IF (ALLOCATED(SrcRotMiscVarTypeData%Y)) THEN - i1_l = LBOUND(SrcRotMiscVarTypeData%Y,1) - i1_u = UBOUND(SrcRotMiscVarTypeData%Y,1) - i2_l = LBOUND(SrcRotMiscVarTypeData%Y,2) - i2_u = UBOUND(SrcRotMiscVarTypeData%Y,2) - IF (.NOT. ALLOCATED(DstRotMiscVarTypeData%Y)) THEN - ALLOCATE(DstRotMiscVarTypeData%Y(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%Y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotMiscVarTypeData%Y = SrcRotMiscVarTypeData%Y -ENDIF -IF (ALLOCATED(SrcRotMiscVarTypeData%Z)) THEN - i1_l = LBOUND(SrcRotMiscVarTypeData%Z,1) - i1_u = UBOUND(SrcRotMiscVarTypeData%Z,1) - i2_l = LBOUND(SrcRotMiscVarTypeData%Z,2) - i2_u = UBOUND(SrcRotMiscVarTypeData%Z,2) - IF (.NOT. ALLOCATED(DstRotMiscVarTypeData%Z)) THEN - ALLOCATE(DstRotMiscVarTypeData%Z(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%Z.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotMiscVarTypeData%Z = SrcRotMiscVarTypeData%Z -ENDIF -IF (ALLOCATED(SrcRotMiscVarTypeData%M)) THEN - i1_l = LBOUND(SrcRotMiscVarTypeData%M,1) - i1_u = UBOUND(SrcRotMiscVarTypeData%M,1) - i2_l = LBOUND(SrcRotMiscVarTypeData%M,2) - i2_u = UBOUND(SrcRotMiscVarTypeData%M,2) - IF (.NOT. ALLOCATED(DstRotMiscVarTypeData%M)) THEN - ALLOCATE(DstRotMiscVarTypeData%M(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%M.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotMiscVarTypeData%M = SrcRotMiscVarTypeData%M -ENDIF -IF (ALLOCATED(SrcRotMiscVarTypeData%Mx)) THEN - i1_l = LBOUND(SrcRotMiscVarTypeData%Mx,1) - i1_u = UBOUND(SrcRotMiscVarTypeData%Mx,1) - i2_l = LBOUND(SrcRotMiscVarTypeData%Mx,2) - i2_u = UBOUND(SrcRotMiscVarTypeData%Mx,2) - IF (.NOT. ALLOCATED(DstRotMiscVarTypeData%Mx)) THEN - ALLOCATE(DstRotMiscVarTypeData%Mx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%Mx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotMiscVarTypeData%Mx = SrcRotMiscVarTypeData%Mx -ENDIF -IF (ALLOCATED(SrcRotMiscVarTypeData%My)) THEN - i1_l = LBOUND(SrcRotMiscVarTypeData%My,1) - i1_u = UBOUND(SrcRotMiscVarTypeData%My,1) - i2_l = LBOUND(SrcRotMiscVarTypeData%My,2) - i2_u = UBOUND(SrcRotMiscVarTypeData%My,2) - IF (.NOT. ALLOCATED(DstRotMiscVarTypeData%My)) THEN - ALLOCATE(DstRotMiscVarTypeData%My(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%My.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotMiscVarTypeData%My = SrcRotMiscVarTypeData%My -ENDIF -IF (ALLOCATED(SrcRotMiscVarTypeData%Mz)) THEN - i1_l = LBOUND(SrcRotMiscVarTypeData%Mz,1) - i1_u = UBOUND(SrcRotMiscVarTypeData%Mz,1) - i2_l = LBOUND(SrcRotMiscVarTypeData%Mz,2) - i2_u = UBOUND(SrcRotMiscVarTypeData%Mz,2) - IF (.NOT. ALLOCATED(DstRotMiscVarTypeData%Mz)) THEN - ALLOCATE(DstRotMiscVarTypeData%Mz(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%Mz.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotMiscVarTypeData%Mz = SrcRotMiscVarTypeData%Mz -ENDIF -IF (ALLOCATED(SrcRotMiscVarTypeData%Vind_i)) THEN - i1_l = LBOUND(SrcRotMiscVarTypeData%Vind_i,1) - i1_u = UBOUND(SrcRotMiscVarTypeData%Vind_i,1) - i2_l = LBOUND(SrcRotMiscVarTypeData%Vind_i,2) - i2_u = UBOUND(SrcRotMiscVarTypeData%Vind_i,2) - i3_l = LBOUND(SrcRotMiscVarTypeData%Vind_i,3) - i3_u = UBOUND(SrcRotMiscVarTypeData%Vind_i,3) - IF (.NOT. ALLOCATED(DstRotMiscVarTypeData%Vind_i)) THEN - ALLOCATE(DstRotMiscVarTypeData%Vind_i(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%Vind_i.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotMiscVarTypeData%Vind_i = SrcRotMiscVarTypeData%Vind_i -ENDIF - DstRotMiscVarTypeData%V_DiskAvg = SrcRotMiscVarTypeData%V_DiskAvg - DstRotMiscVarTypeData%yaw = SrcRotMiscVarTypeData%yaw - DstRotMiscVarTypeData%tilt = SrcRotMiscVarTypeData%tilt -IF (ALLOCATED(SrcRotMiscVarTypeData%hub_theta_x_root)) THEN - i1_l = LBOUND(SrcRotMiscVarTypeData%hub_theta_x_root,1) - i1_u = UBOUND(SrcRotMiscVarTypeData%hub_theta_x_root,1) - IF (.NOT. ALLOCATED(DstRotMiscVarTypeData%hub_theta_x_root)) THEN - ALLOCATE(DstRotMiscVarTypeData%hub_theta_x_root(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%hub_theta_x_root.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotMiscVarTypeData%hub_theta_x_root = SrcRotMiscVarTypeData%hub_theta_x_root -ENDIF - DstRotMiscVarTypeData%V_dot_x = SrcRotMiscVarTypeData%V_dot_x - CALL MeshCopy( SrcRotMiscVarTypeData%HubLoad, DstRotMiscVarTypeData%HubLoad, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcRotMiscVarTypeData%B_L_2_H_P)) THEN - i1_l = LBOUND(SrcRotMiscVarTypeData%B_L_2_H_P,1) - i1_u = UBOUND(SrcRotMiscVarTypeData%B_L_2_H_P,1) - IF (.NOT. ALLOCATED(DstRotMiscVarTypeData%B_L_2_H_P)) THEN - ALLOCATE(DstRotMiscVarTypeData%B_L_2_H_P(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%B_L_2_H_P.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcRotMiscVarTypeData%B_L_2_H_P,1), UBOUND(SrcRotMiscVarTypeData%B_L_2_H_P,1) - CALL NWTC_Library_Copymeshmaptype( SrcRotMiscVarTypeData%B_L_2_H_P(i1), DstRotMiscVarTypeData%B_L_2_H_P(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcRotMiscVarTypeData%SigmaCavitCrit)) THEN - i1_l = LBOUND(SrcRotMiscVarTypeData%SigmaCavitCrit,1) - i1_u = UBOUND(SrcRotMiscVarTypeData%SigmaCavitCrit,1) - i2_l = LBOUND(SrcRotMiscVarTypeData%SigmaCavitCrit,2) - i2_u = UBOUND(SrcRotMiscVarTypeData%SigmaCavitCrit,2) - IF (.NOT. ALLOCATED(DstRotMiscVarTypeData%SigmaCavitCrit)) THEN - ALLOCATE(DstRotMiscVarTypeData%SigmaCavitCrit(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%SigmaCavitCrit.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotMiscVarTypeData%SigmaCavitCrit = SrcRotMiscVarTypeData%SigmaCavitCrit -ENDIF -IF (ALLOCATED(SrcRotMiscVarTypeData%SigmaCavit)) THEN - i1_l = LBOUND(SrcRotMiscVarTypeData%SigmaCavit,1) - i1_u = UBOUND(SrcRotMiscVarTypeData%SigmaCavit,1) - i2_l = LBOUND(SrcRotMiscVarTypeData%SigmaCavit,2) - i2_u = UBOUND(SrcRotMiscVarTypeData%SigmaCavit,2) - IF (.NOT. ALLOCATED(DstRotMiscVarTypeData%SigmaCavit)) THEN - ALLOCATE(DstRotMiscVarTypeData%SigmaCavit(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%SigmaCavit.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotMiscVarTypeData%SigmaCavit = SrcRotMiscVarTypeData%SigmaCavit -ENDIF -IF (ALLOCATED(SrcRotMiscVarTypeData%CavitWarnSet)) THEN - i1_l = LBOUND(SrcRotMiscVarTypeData%CavitWarnSet,1) - i1_u = UBOUND(SrcRotMiscVarTypeData%CavitWarnSet,1) - i2_l = LBOUND(SrcRotMiscVarTypeData%CavitWarnSet,2) - i2_u = UBOUND(SrcRotMiscVarTypeData%CavitWarnSet,2) - IF (.NOT. ALLOCATED(DstRotMiscVarTypeData%CavitWarnSet)) THEN - ALLOCATE(DstRotMiscVarTypeData%CavitWarnSet(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%CavitWarnSet.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotMiscVarTypeData%CavitWarnSet = SrcRotMiscVarTypeData%CavitWarnSet -ENDIF -IF (ALLOCATED(SrcRotMiscVarTypeData%TwrFB)) THEN - i1_l = LBOUND(SrcRotMiscVarTypeData%TwrFB,1) - i1_u = UBOUND(SrcRotMiscVarTypeData%TwrFB,1) - i2_l = LBOUND(SrcRotMiscVarTypeData%TwrFB,2) - i2_u = UBOUND(SrcRotMiscVarTypeData%TwrFB,2) - IF (.NOT. ALLOCATED(DstRotMiscVarTypeData%TwrFB)) THEN - ALLOCATE(DstRotMiscVarTypeData%TwrFB(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%TwrFB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotMiscVarTypeData%TwrFB = SrcRotMiscVarTypeData%TwrFB -ENDIF -IF (ALLOCATED(SrcRotMiscVarTypeData%TwrMB)) THEN - i1_l = LBOUND(SrcRotMiscVarTypeData%TwrMB,1) - i1_u = UBOUND(SrcRotMiscVarTypeData%TwrMB,1) - i2_l = LBOUND(SrcRotMiscVarTypeData%TwrMB,2) - i2_u = UBOUND(SrcRotMiscVarTypeData%TwrMB,2) - IF (.NOT. ALLOCATED(DstRotMiscVarTypeData%TwrMB)) THEN - ALLOCATE(DstRotMiscVarTypeData%TwrMB(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%TwrMB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotMiscVarTypeData%TwrMB = SrcRotMiscVarTypeData%TwrMB -ENDIF -IF (ALLOCATED(SrcRotMiscVarTypeData%HubFB)) THEN - i1_l = LBOUND(SrcRotMiscVarTypeData%HubFB,1) - i1_u = UBOUND(SrcRotMiscVarTypeData%HubFB,1) - IF (.NOT. ALLOCATED(DstRotMiscVarTypeData%HubFB)) THEN - ALLOCATE(DstRotMiscVarTypeData%HubFB(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%HubFB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotMiscVarTypeData%HubFB = SrcRotMiscVarTypeData%HubFB -ENDIF -IF (ALLOCATED(SrcRotMiscVarTypeData%HubMB)) THEN - i1_l = LBOUND(SrcRotMiscVarTypeData%HubMB,1) - i1_u = UBOUND(SrcRotMiscVarTypeData%HubMB,1) - IF (.NOT. ALLOCATED(DstRotMiscVarTypeData%HubMB)) THEN - ALLOCATE(DstRotMiscVarTypeData%HubMB(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%HubMB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotMiscVarTypeData%HubMB = SrcRotMiscVarTypeData%HubMB -ENDIF -IF (ALLOCATED(SrcRotMiscVarTypeData%NacFB)) THEN - i1_l = LBOUND(SrcRotMiscVarTypeData%NacFB,1) - i1_u = UBOUND(SrcRotMiscVarTypeData%NacFB,1) - IF (.NOT. ALLOCATED(DstRotMiscVarTypeData%NacFB)) THEN - ALLOCATE(DstRotMiscVarTypeData%NacFB(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%NacFB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotMiscVarTypeData%NacFB = SrcRotMiscVarTypeData%NacFB -ENDIF -IF (ALLOCATED(SrcRotMiscVarTypeData%NacMB)) THEN - i1_l = LBOUND(SrcRotMiscVarTypeData%NacMB,1) - i1_u = UBOUND(SrcRotMiscVarTypeData%NacMB,1) - IF (.NOT. ALLOCATED(DstRotMiscVarTypeData%NacMB)) THEN - ALLOCATE(DstRotMiscVarTypeData%NacMB(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%NacMB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotMiscVarTypeData%NacMB = SrcRotMiscVarTypeData%NacMB -ENDIF -IF (ALLOCATED(SrcRotMiscVarTypeData%BladeRootLoad)) THEN - i1_l = LBOUND(SrcRotMiscVarTypeData%BladeRootLoad,1) - i1_u = UBOUND(SrcRotMiscVarTypeData%BladeRootLoad,1) - IF (.NOT. ALLOCATED(DstRotMiscVarTypeData%BladeRootLoad)) THEN - ALLOCATE(DstRotMiscVarTypeData%BladeRootLoad(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%BladeRootLoad.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcRotMiscVarTypeData%BladeRootLoad,1), UBOUND(SrcRotMiscVarTypeData%BladeRootLoad,1) - CALL MeshCopy( SrcRotMiscVarTypeData%BladeRootLoad(i1), DstRotMiscVarTypeData%BladeRootLoad(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcRotMiscVarTypeData%B_L_2_R_P)) THEN - i1_l = LBOUND(SrcRotMiscVarTypeData%B_L_2_R_P,1) - i1_u = UBOUND(SrcRotMiscVarTypeData%B_L_2_R_P,1) - IF (.NOT. ALLOCATED(DstRotMiscVarTypeData%B_L_2_R_P)) THEN - ALLOCATE(DstRotMiscVarTypeData%B_L_2_R_P(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%B_L_2_R_P.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcRotMiscVarTypeData%B_L_2_R_P,1), UBOUND(SrcRotMiscVarTypeData%B_L_2_R_P,1) - CALL NWTC_Library_Copymeshmaptype( SrcRotMiscVarTypeData%B_L_2_R_P(i1), DstRotMiscVarTypeData%B_L_2_R_P(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcRotMiscVarTypeData%BladeBuoyLoadPoint)) THEN - i1_l = LBOUND(SrcRotMiscVarTypeData%BladeBuoyLoadPoint,1) - i1_u = UBOUND(SrcRotMiscVarTypeData%BladeBuoyLoadPoint,1) - IF (.NOT. ALLOCATED(DstRotMiscVarTypeData%BladeBuoyLoadPoint)) THEN - ALLOCATE(DstRotMiscVarTypeData%BladeBuoyLoadPoint(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%BladeBuoyLoadPoint.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcRotMiscVarTypeData%BladeBuoyLoadPoint,1), UBOUND(SrcRotMiscVarTypeData%BladeBuoyLoadPoint,1) - CALL MeshCopy( SrcRotMiscVarTypeData%BladeBuoyLoadPoint(i1), DstRotMiscVarTypeData%BladeBuoyLoadPoint(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcRotMiscVarTypeData%BladeBuoyLoad)) THEN - i1_l = LBOUND(SrcRotMiscVarTypeData%BladeBuoyLoad,1) - i1_u = UBOUND(SrcRotMiscVarTypeData%BladeBuoyLoad,1) - IF (.NOT. ALLOCATED(DstRotMiscVarTypeData%BladeBuoyLoad)) THEN - ALLOCATE(DstRotMiscVarTypeData%BladeBuoyLoad(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%BladeBuoyLoad.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcRotMiscVarTypeData%BladeBuoyLoad,1), UBOUND(SrcRotMiscVarTypeData%BladeBuoyLoad,1) - CALL MeshCopy( SrcRotMiscVarTypeData%BladeBuoyLoad(i1), DstRotMiscVarTypeData%BladeBuoyLoad(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcRotMiscVarTypeData%B_P_2_B_L)) THEN - i1_l = LBOUND(SrcRotMiscVarTypeData%B_P_2_B_L,1) - i1_u = UBOUND(SrcRotMiscVarTypeData%B_P_2_B_L,1) - IF (.NOT. ALLOCATED(DstRotMiscVarTypeData%B_P_2_B_L)) THEN - ALLOCATE(DstRotMiscVarTypeData%B_P_2_B_L(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%B_P_2_B_L.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcRotMiscVarTypeData%B_P_2_B_L,1), UBOUND(SrcRotMiscVarTypeData%B_P_2_B_L,1) - CALL NWTC_Library_Copymeshmaptype( SrcRotMiscVarTypeData%B_P_2_B_L(i1), DstRotMiscVarTypeData%B_P_2_B_L(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL MeshCopy( SrcRotMiscVarTypeData%TwrBuoyLoadPoint, DstRotMiscVarTypeData%TwrBuoyLoadPoint, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcRotMiscVarTypeData%TwrBuoyLoad, DstRotMiscVarTypeData%TwrBuoyLoad, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcRotMiscVarTypeData%T_P_2_T_L, DstRotMiscVarTypeData%T_P_2_T_L, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstRotMiscVarTypeData%FirstWarn_TowerStrike = SrcRotMiscVarTypeData%FirstWarn_TowerStrike - DstRotMiscVarTypeData%AvgDiskVel = SrcRotMiscVarTypeData%AvgDiskVel - DstRotMiscVarTypeData%AvgDiskVelDist = SrcRotMiscVarTypeData%AvgDiskVelDist - DstRotMiscVarTypeData%TFinAlpha = SrcRotMiscVarTypeData%TFinAlpha - DstRotMiscVarTypeData%TFinRe = SrcRotMiscVarTypeData%TFinRe - DstRotMiscVarTypeData%TFinVrel = SrcRotMiscVarTypeData%TFinVrel - DstRotMiscVarTypeData%TFinVund_i = SrcRotMiscVarTypeData%TFinVund_i - DstRotMiscVarTypeData%TFinVind_i = SrcRotMiscVarTypeData%TFinVind_i - DstRotMiscVarTypeData%TFinVrel_i = SrcRotMiscVarTypeData%TFinVrel_i - DstRotMiscVarTypeData%TFinSTV_i = SrcRotMiscVarTypeData%TFinSTV_i - DstRotMiscVarTypeData%TFinF_i = SrcRotMiscVarTypeData%TFinF_i - DstRotMiscVarTypeData%TFinM_i = SrcRotMiscVarTypeData%TFinM_i - END SUBROUTINE AD_CopyRotMiscVarType - - SUBROUTINE AD_DestroyRotMiscVarType( RotMiscVarTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(RotMiscVarType), INTENT(INOUT) :: RotMiscVarTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_DestroyRotMiscVarType' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL BEMT_DestroyMisc( RotMiscVarTypeData%BEMT, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL BEMT_DestroyOutput( RotMiscVarTypeData%BEMT_y, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -DO i1 = LBOUND(RotMiscVarTypeData%BEMT_u,1), UBOUND(RotMiscVarTypeData%BEMT_u,1) - CALL BEMT_DestroyInput( RotMiscVarTypeData%BEMT_u(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - CALL AA_DestroyMisc( RotMiscVarTypeData%AA, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AA_DestroyOutput( RotMiscVarTypeData%AA_y, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AA_DestroyInput( RotMiscVarTypeData%AA_u, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(RotMiscVarTypeData%DisturbedInflow)) THEN - DEALLOCATE(RotMiscVarTypeData%DisturbedInflow) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%orientationAnnulus)) THEN - DEALLOCATE(RotMiscVarTypeData%orientationAnnulus) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%R_li)) THEN - DEALLOCATE(RotMiscVarTypeData%R_li) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%AllOuts)) THEN - DEALLOCATE(RotMiscVarTypeData%AllOuts) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%W_Twr)) THEN - DEALLOCATE(RotMiscVarTypeData%W_Twr) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%X_Twr)) THEN - DEALLOCATE(RotMiscVarTypeData%X_Twr) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%Y_Twr)) THEN - DEALLOCATE(RotMiscVarTypeData%Y_Twr) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%Curve)) THEN - DEALLOCATE(RotMiscVarTypeData%Curve) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%TwrClrnc)) THEN - DEALLOCATE(RotMiscVarTypeData%TwrClrnc) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%X)) THEN - DEALLOCATE(RotMiscVarTypeData%X) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%Y)) THEN - DEALLOCATE(RotMiscVarTypeData%Y) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%Z)) THEN - DEALLOCATE(RotMiscVarTypeData%Z) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%M)) THEN - DEALLOCATE(RotMiscVarTypeData%M) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%Mx)) THEN - DEALLOCATE(RotMiscVarTypeData%Mx) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%My)) THEN - DEALLOCATE(RotMiscVarTypeData%My) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%Mz)) THEN - DEALLOCATE(RotMiscVarTypeData%Mz) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%Vind_i)) THEN - DEALLOCATE(RotMiscVarTypeData%Vind_i) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%hub_theta_x_root)) THEN - DEALLOCATE(RotMiscVarTypeData%hub_theta_x_root) -ENDIF - CALL MeshDestroy( RotMiscVarTypeData%HubLoad, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(RotMiscVarTypeData%B_L_2_H_P)) THEN -DO i1 = LBOUND(RotMiscVarTypeData%B_L_2_H_P,1), UBOUND(RotMiscVarTypeData%B_L_2_H_P,1) - CALL NWTC_Library_Destroymeshmaptype( RotMiscVarTypeData%B_L_2_H_P(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(RotMiscVarTypeData%B_L_2_H_P) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%SigmaCavitCrit)) THEN - DEALLOCATE(RotMiscVarTypeData%SigmaCavitCrit) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%SigmaCavit)) THEN - DEALLOCATE(RotMiscVarTypeData%SigmaCavit) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%CavitWarnSet)) THEN - DEALLOCATE(RotMiscVarTypeData%CavitWarnSet) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%TwrFB)) THEN - DEALLOCATE(RotMiscVarTypeData%TwrFB) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%TwrMB)) THEN - DEALLOCATE(RotMiscVarTypeData%TwrMB) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%HubFB)) THEN - DEALLOCATE(RotMiscVarTypeData%HubFB) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%HubMB)) THEN - DEALLOCATE(RotMiscVarTypeData%HubMB) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%NacFB)) THEN - DEALLOCATE(RotMiscVarTypeData%NacFB) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%NacMB)) THEN - DEALLOCATE(RotMiscVarTypeData%NacMB) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%BladeRootLoad)) THEN -DO i1 = LBOUND(RotMiscVarTypeData%BladeRootLoad,1), UBOUND(RotMiscVarTypeData%BladeRootLoad,1) - CALL MeshDestroy( RotMiscVarTypeData%BladeRootLoad(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(RotMiscVarTypeData%BladeRootLoad) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%B_L_2_R_P)) THEN -DO i1 = LBOUND(RotMiscVarTypeData%B_L_2_R_P,1), UBOUND(RotMiscVarTypeData%B_L_2_R_P,1) - CALL NWTC_Library_Destroymeshmaptype( RotMiscVarTypeData%B_L_2_R_P(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(RotMiscVarTypeData%B_L_2_R_P) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%BladeBuoyLoadPoint)) THEN -DO i1 = LBOUND(RotMiscVarTypeData%BladeBuoyLoadPoint,1), UBOUND(RotMiscVarTypeData%BladeBuoyLoadPoint,1) - CALL MeshDestroy( RotMiscVarTypeData%BladeBuoyLoadPoint(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(RotMiscVarTypeData%BladeBuoyLoadPoint) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%BladeBuoyLoad)) THEN -DO i1 = LBOUND(RotMiscVarTypeData%BladeBuoyLoad,1), UBOUND(RotMiscVarTypeData%BladeBuoyLoad,1) - CALL MeshDestroy( RotMiscVarTypeData%BladeBuoyLoad(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(RotMiscVarTypeData%BladeBuoyLoad) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%B_P_2_B_L)) THEN -DO i1 = LBOUND(RotMiscVarTypeData%B_P_2_B_L,1), UBOUND(RotMiscVarTypeData%B_P_2_B_L,1) - CALL NWTC_Library_Destroymeshmaptype( RotMiscVarTypeData%B_P_2_B_L(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(RotMiscVarTypeData%B_P_2_B_L) -ENDIF - CALL MeshDestroy( RotMiscVarTypeData%TwrBuoyLoadPoint, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( RotMiscVarTypeData%TwrBuoyLoad, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL NWTC_Library_Destroymeshmaptype( RotMiscVarTypeData%T_P_2_T_L, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE AD_DestroyRotMiscVarType - - SUBROUTINE AD_PackRotMiscVarType( 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(RotMiscVarType), 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 = 'AD_PackRotMiscVarType' - ! 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 ! BEMT: size of buffers for each call to pack subtype - CALL BEMT_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%BEMT, ErrStat2, ErrMsg2, .TRUE. ) ! BEMT - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BEMT - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BEMT - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BEMT - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! BEMT_y: size of buffers for each call to pack subtype - CALL BEMT_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%BEMT_y, ErrStat2, ErrMsg2, .TRUE. ) ! BEMT_y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BEMT_y - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BEMT_y - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BEMT_y - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - DO i1 = LBOUND(InData%BEMT_u,1), UBOUND(InData%BEMT_u,1) - Int_BufSz = Int_BufSz + 3 ! BEMT_u: size of buffers for each call to pack subtype - CALL BEMT_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%BEMT_u(i1), ErrStat2, ErrMsg2, .TRUE. ) ! BEMT_u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BEMT_u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BEMT_u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BEMT_u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - Int_BufSz = Int_BufSz + 3 ! AA: size of buffers for each call to pack subtype - CALL AA_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%AA, ErrStat2, ErrMsg2, .TRUE. ) ! AA - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! AA - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! AA - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! AA - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! AA_y: size of buffers for each call to pack subtype - CALL AA_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%AA_y, ErrStat2, ErrMsg2, .TRUE. ) ! AA_y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! AA_y - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! AA_y - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! AA_y - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! AA_u: size of buffers for each call to pack subtype - CALL AA_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%AA_u, ErrStat2, ErrMsg2, .TRUE. ) ! AA_u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! AA_u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! AA_u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! AA_u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! DisturbedInflow allocated yes/no - IF ( ALLOCATED(InData%DisturbedInflow) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! DisturbedInflow upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%DisturbedInflow) ! DisturbedInflow - END IF - Int_BufSz = Int_BufSz + 1 ! orientationAnnulus allocated yes/no - IF ( ALLOCATED(InData%orientationAnnulus) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! orientationAnnulus upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%orientationAnnulus) ! orientationAnnulus - END IF - Int_BufSz = Int_BufSz + 1 ! R_li allocated yes/no - IF ( ALLOCATED(InData%R_li) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! R_li upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%R_li) ! R_li - END IF - 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 - Int_BufSz = Int_BufSz + 1 ! W_Twr allocated yes/no - IF ( ALLOCATED(InData%W_Twr) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! W_Twr upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%W_Twr) ! W_Twr - END IF - Int_BufSz = Int_BufSz + 1 ! X_Twr allocated yes/no - IF ( ALLOCATED(InData%X_Twr) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! X_Twr upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%X_Twr) ! X_Twr - END IF - Int_BufSz = Int_BufSz + 1 ! Y_Twr allocated yes/no - IF ( ALLOCATED(InData%Y_Twr) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Y_Twr upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Y_Twr) ! Y_Twr - END IF - Int_BufSz = Int_BufSz + 1 ! Curve allocated yes/no - IF ( ALLOCATED(InData%Curve) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Curve upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Curve) ! Curve - END IF - Int_BufSz = Int_BufSz + 1 ! TwrClrnc allocated yes/no - IF ( ALLOCATED(InData%TwrClrnc) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! TwrClrnc upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TwrClrnc) ! TwrClrnc - END IF - Int_BufSz = Int_BufSz + 1 ! X allocated yes/no - IF ( ALLOCATED(InData%X) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! X upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%X) ! X - END IF - Int_BufSz = Int_BufSz + 1 ! Y allocated yes/no - IF ( ALLOCATED(InData%Y) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Y upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Y) ! Y - END IF - Int_BufSz = Int_BufSz + 1 ! Z allocated yes/no - IF ( ALLOCATED(InData%Z) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Z upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Z) ! Z - 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 - Re_BufSz = Re_BufSz + SIZE(InData%M) ! M - END IF - Int_BufSz = Int_BufSz + 1 ! Mx allocated yes/no - IF ( ALLOCATED(InData%Mx) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Mx upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Mx) ! Mx - END IF - Int_BufSz = Int_BufSz + 1 ! My allocated yes/no - IF ( ALLOCATED(InData%My) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! My upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%My) ! My - END IF - Int_BufSz = Int_BufSz + 1 ! Mz allocated yes/no - IF ( ALLOCATED(InData%Mz) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Mz upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Mz) ! Mz - END IF - Int_BufSz = Int_BufSz + 1 ! Vind_i allocated yes/no - IF ( ALLOCATED(InData%Vind_i) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Vind_i upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vind_i) ! Vind_i - END IF - Re_BufSz = Re_BufSz + SIZE(InData%V_DiskAvg) ! V_DiskAvg - Re_BufSz = Re_BufSz + 1 ! yaw - Re_BufSz = Re_BufSz + 1 ! tilt - Int_BufSz = Int_BufSz + 1 ! hub_theta_x_root allocated yes/no - IF ( ALLOCATED(InData%hub_theta_x_root) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! hub_theta_x_root upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%hub_theta_x_root) ! hub_theta_x_root - END IF - Re_BufSz = Re_BufSz + 1 ! V_dot_x - Int_BufSz = Int_BufSz + 3 ! HubLoad: size of buffers for each call to pack subtype - CALL MeshPack( InData%HubLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! HubLoad - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! HubLoad - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! HubLoad - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! HubLoad - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! B_L_2_H_P allocated yes/no - IF ( ALLOCATED(InData%B_L_2_H_P) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! B_L_2_H_P upper/lower bounds for each dimension - DO i1 = LBOUND(InData%B_L_2_H_P,1), UBOUND(InData%B_L_2_H_P,1) - Int_BufSz = Int_BufSz + 3 ! B_L_2_H_P: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%B_L_2_H_P(i1), ErrStat2, ErrMsg2, .TRUE. ) ! B_L_2_H_P - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! B_L_2_H_P - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! B_L_2_H_P - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! B_L_2_H_P - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! SigmaCavitCrit allocated yes/no - IF ( ALLOCATED(InData%SigmaCavitCrit) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! SigmaCavitCrit upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%SigmaCavitCrit) ! SigmaCavitCrit - END IF - Int_BufSz = Int_BufSz + 1 ! SigmaCavit allocated yes/no - IF ( ALLOCATED(InData%SigmaCavit) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! SigmaCavit upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%SigmaCavit) ! SigmaCavit - END IF - Int_BufSz = Int_BufSz + 1 ! CavitWarnSet allocated yes/no - IF ( ALLOCATED(InData%CavitWarnSet) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! CavitWarnSet upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%CavitWarnSet) ! CavitWarnSet - END IF - Int_BufSz = Int_BufSz + 1 ! TwrFB allocated yes/no - IF ( ALLOCATED(InData%TwrFB) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! TwrFB upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TwrFB) ! TwrFB - END IF - Int_BufSz = Int_BufSz + 1 ! TwrMB allocated yes/no - IF ( ALLOCATED(InData%TwrMB) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! TwrMB upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TwrMB) ! TwrMB - END IF - Int_BufSz = Int_BufSz + 1 ! HubFB allocated yes/no - IF ( ALLOCATED(InData%HubFB) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! HubFB upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%HubFB) ! HubFB - END IF - Int_BufSz = Int_BufSz + 1 ! HubMB allocated yes/no - IF ( ALLOCATED(InData%HubMB) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! HubMB upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%HubMB) ! HubMB - END IF - Int_BufSz = Int_BufSz + 1 ! NacFB allocated yes/no - IF ( ALLOCATED(InData%NacFB) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! NacFB upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%NacFB) ! NacFB - END IF - Int_BufSz = Int_BufSz + 1 ! NacMB allocated yes/no - IF ( ALLOCATED(InData%NacMB) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! NacMB upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%NacMB) ! NacMB - END IF - Int_BufSz = Int_BufSz + 1 ! BladeRootLoad allocated yes/no - IF ( ALLOCATED(InData%BladeRootLoad) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BladeRootLoad upper/lower bounds for each dimension - DO i1 = LBOUND(InData%BladeRootLoad,1), UBOUND(InData%BladeRootLoad,1) - Int_BufSz = Int_BufSz + 3 ! BladeRootLoad: size of buffers for each call to pack subtype - CALL MeshPack( InData%BladeRootLoad(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! BladeRootLoad - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BladeRootLoad - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BladeRootLoad - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BladeRootLoad - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! B_L_2_R_P allocated yes/no - IF ( ALLOCATED(InData%B_L_2_R_P) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! B_L_2_R_P upper/lower bounds for each dimension - DO i1 = LBOUND(InData%B_L_2_R_P,1), UBOUND(InData%B_L_2_R_P,1) - Int_BufSz = Int_BufSz + 3 ! B_L_2_R_P: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%B_L_2_R_P(i1), ErrStat2, ErrMsg2, .TRUE. ) ! B_L_2_R_P - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! B_L_2_R_P - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! B_L_2_R_P - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! B_L_2_R_P - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! BladeBuoyLoadPoint allocated yes/no - IF ( ALLOCATED(InData%BladeBuoyLoadPoint) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BladeBuoyLoadPoint upper/lower bounds for each dimension - DO i1 = LBOUND(InData%BladeBuoyLoadPoint,1), UBOUND(InData%BladeBuoyLoadPoint,1) - Int_BufSz = Int_BufSz + 3 ! BladeBuoyLoadPoint: size of buffers for each call to pack subtype - CALL MeshPack( InData%BladeBuoyLoadPoint(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! BladeBuoyLoadPoint - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BladeBuoyLoadPoint - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BladeBuoyLoadPoint - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BladeBuoyLoadPoint - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! BladeBuoyLoad allocated yes/no - IF ( ALLOCATED(InData%BladeBuoyLoad) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BladeBuoyLoad upper/lower bounds for each dimension - DO i1 = LBOUND(InData%BladeBuoyLoad,1), UBOUND(InData%BladeBuoyLoad,1) - Int_BufSz = Int_BufSz + 3 ! BladeBuoyLoad: size of buffers for each call to pack subtype - CALL MeshPack( InData%BladeBuoyLoad(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! BladeBuoyLoad - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BladeBuoyLoad - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BladeBuoyLoad - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BladeBuoyLoad - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! B_P_2_B_L allocated yes/no - IF ( ALLOCATED(InData%B_P_2_B_L) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! B_P_2_B_L upper/lower bounds for each dimension - DO i1 = LBOUND(InData%B_P_2_B_L,1), UBOUND(InData%B_P_2_B_L,1) - Int_BufSz = Int_BufSz + 3 ! B_P_2_B_L: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%B_P_2_B_L(i1), ErrStat2, ErrMsg2, .TRUE. ) ! B_P_2_B_L - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! B_P_2_B_L - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! B_P_2_B_L - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! B_P_2_B_L - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! TwrBuoyLoadPoint: size of buffers for each call to pack subtype - CALL MeshPack( InData%TwrBuoyLoadPoint, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! TwrBuoyLoadPoint - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! TwrBuoyLoadPoint - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! TwrBuoyLoadPoint - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! TwrBuoyLoadPoint - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! TwrBuoyLoad: size of buffers for each call to pack subtype - CALL MeshPack( InData%TwrBuoyLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! TwrBuoyLoad - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! TwrBuoyLoad - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! TwrBuoyLoad - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! TwrBuoyLoad - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! T_P_2_T_L: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%T_P_2_T_L, ErrStat2, ErrMsg2, .TRUE. ) ! T_P_2_T_L - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! T_P_2_T_L - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! T_P_2_T_L - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! T_P_2_T_L - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! FirstWarn_TowerStrike - Re_BufSz = Re_BufSz + SIZE(InData%AvgDiskVel) ! AvgDiskVel - Re_BufSz = Re_BufSz + SIZE(InData%AvgDiskVelDist) ! AvgDiskVelDist - Re_BufSz = Re_BufSz + 1 ! TFinAlpha - Re_BufSz = Re_BufSz + 1 ! TFinRe - Re_BufSz = Re_BufSz + 1 ! TFinVrel - Re_BufSz = Re_BufSz + SIZE(InData%TFinVund_i) ! TFinVund_i - Re_BufSz = Re_BufSz + SIZE(InData%TFinVind_i) ! TFinVind_i - Re_BufSz = Re_BufSz + SIZE(InData%TFinVrel_i) ! TFinVrel_i - Re_BufSz = Re_BufSz + SIZE(InData%TFinSTV_i) ! TFinSTV_i - Re_BufSz = Re_BufSz + SIZE(InData%TFinF_i) ! TFinF_i - Re_BufSz = Re_BufSz + SIZE(InData%TFinM_i) ! TFinM_i - 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 BEMT_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%BEMT, ErrStat2, ErrMsg2, OnlySize ) ! BEMT - 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 BEMT_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%BEMT_y, ErrStat2, ErrMsg2, OnlySize ) ! BEMT_y - 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 i1 = LBOUND(InData%BEMT_u,1), UBOUND(InData%BEMT_u,1) - CALL BEMT_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%BEMT_u(i1), ErrStat2, ErrMsg2, OnlySize ) ! BEMT_u - 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 - CALL AA_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%AA, ErrStat2, ErrMsg2, OnlySize ) ! AA - 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 AA_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%AA_y, ErrStat2, ErrMsg2, OnlySize ) ! AA_y - 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 AA_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%AA_u, ErrStat2, ErrMsg2, OnlySize ) ! AA_u - 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%DisturbedInflow) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DisturbedInflow,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DisturbedInflow,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DisturbedInflow,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DisturbedInflow,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DisturbedInflow,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DisturbedInflow,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%DisturbedInflow,3), UBOUND(InData%DisturbedInflow,3) - DO i2 = LBOUND(InData%DisturbedInflow,2), UBOUND(InData%DisturbedInflow,2) - DO i1 = LBOUND(InData%DisturbedInflow,1), UBOUND(InData%DisturbedInflow,1) - ReKiBuf(Re_Xferred) = InData%DisturbedInflow(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%orientationAnnulus) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%orientationAnnulus,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%orientationAnnulus,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%orientationAnnulus,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%orientationAnnulus,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%orientationAnnulus,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%orientationAnnulus,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%orientationAnnulus,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%orientationAnnulus,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%orientationAnnulus,4), UBOUND(InData%orientationAnnulus,4) - DO i3 = LBOUND(InData%orientationAnnulus,3), UBOUND(InData%orientationAnnulus,3) - DO i2 = LBOUND(InData%orientationAnnulus,2), UBOUND(InData%orientationAnnulus,2) - DO i1 = LBOUND(InData%orientationAnnulus,1), UBOUND(InData%orientationAnnulus,1) - DbKiBuf(Db_Xferred) = InData%orientationAnnulus(i1,i2,i3,i4) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%R_li) ) THEN - 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_li,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%R_li,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%R_li,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%R_li,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%R_li,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%R_li,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%R_li,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%R_li,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%R_li,4), UBOUND(InData%R_li,4) - DO i3 = LBOUND(InData%R_li,3), UBOUND(InData%R_li,3) - DO i2 = LBOUND(InData%R_li,2), UBOUND(InData%R_li,2) - DO i1 = LBOUND(InData%R_li,1), UBOUND(InData%R_li,1) - DbKiBuf(Db_Xferred) = InData%R_li(i1,i2,i3,i4) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - 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 - IF ( .NOT. ALLOCATED(InData%W_Twr) ) THEN - 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_Twr,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%W_Twr,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%W_Twr,1), UBOUND(InData%W_Twr,1) - ReKiBuf(Re_Xferred) = InData%W_Twr(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%X_Twr) ) THEN - 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_Twr,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%X_Twr,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%X_Twr,1), UBOUND(InData%X_Twr,1) - ReKiBuf(Re_Xferred) = InData%X_Twr(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Y_Twr) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Y_Twr,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Y_Twr,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Y_Twr,1), UBOUND(InData%Y_Twr,1) - ReKiBuf(Re_Xferred) = InData%Y_Twr(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Curve) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Curve,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Curve,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Curve,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Curve,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Curve,2), UBOUND(InData%Curve,2) - DO i1 = LBOUND(InData%Curve,1), UBOUND(InData%Curve,1) - ReKiBuf(Re_Xferred) = InData%Curve(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TwrClrnc) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwrClrnc,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrClrnc,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwrClrnc,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrClrnc,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%TwrClrnc,2), UBOUND(InData%TwrClrnc,2) - DO i1 = LBOUND(InData%TwrClrnc,1), UBOUND(InData%TwrClrnc,1) - ReKiBuf(Re_Xferred) = InData%TwrClrnc(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%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%X,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%X,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%X,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%X,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%X,2), UBOUND(InData%X,2) - DO i1 = LBOUND(InData%X,1), UBOUND(InData%X,1) - ReKiBuf(Re_Xferred) = InData%X(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%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%Y,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Y,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Y,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Y,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Y,2), UBOUND(InData%Y,2) - DO i1 = LBOUND(InData%Y,1), UBOUND(InData%Y,1) - ReKiBuf(Re_Xferred) = InData%Y(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Z) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Z,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Z,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Z,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Z,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Z,2), UBOUND(InData%Z,2) - DO i1 = LBOUND(InData%Z,1), UBOUND(InData%Z,1) - ReKiBuf(Re_Xferred) = InData%Z(i1,i2) - Re_Xferred = Re_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) - ReKiBuf(Re_Xferred) = InData%M(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Mx) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Mx,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Mx,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Mx,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Mx,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Mx,2), UBOUND(InData%Mx,2) - DO i1 = LBOUND(InData%Mx,1), UBOUND(InData%Mx,1) - ReKiBuf(Re_Xferred) = InData%Mx(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%My) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%My,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%My,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%My,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%My,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%My,2), UBOUND(InData%My,2) - DO i1 = LBOUND(InData%My,1), UBOUND(InData%My,1) - ReKiBuf(Re_Xferred) = InData%My(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Mz) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Mz,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Mz,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Mz,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Mz,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Mz,2), UBOUND(InData%Mz,2) - DO i1 = LBOUND(InData%Mz,1), UBOUND(InData%Mz,1) - ReKiBuf(Re_Xferred) = InData%Mz(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Vind_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%Vind_i,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vind_i,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vind_i,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vind_i,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vind_i,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vind_i,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Vind_i,3), UBOUND(InData%Vind_i,3) - DO i2 = LBOUND(InData%Vind_i,2), UBOUND(InData%Vind_i,2) - DO i1 = LBOUND(InData%Vind_i,1), UBOUND(InData%Vind_i,1) - ReKiBuf(Re_Xferred) = InData%Vind_i(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - DO i1 = LBOUND(InData%V_DiskAvg,1), UBOUND(InData%V_DiskAvg,1) - ReKiBuf(Re_Xferred) = InData%V_DiskAvg(i1) - Re_Xferred = Re_Xferred + 1 - END DO - ReKiBuf(Re_Xferred) = InData%yaw - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%tilt - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%hub_theta_x_root) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%hub_theta_x_root,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%hub_theta_x_root,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%hub_theta_x_root,1), UBOUND(InData%hub_theta_x_root,1) - ReKiBuf(Re_Xferred) = InData%hub_theta_x_root(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%V_dot_x - Re_Xferred = Re_Xferred + 1 - CALL MeshPack( InData%HubLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! HubLoad - 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%B_L_2_H_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%B_L_2_H_P,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%B_L_2_H_P,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%B_L_2_H_P,1), UBOUND(InData%B_L_2_H_P,1) - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%B_L_2_H_P(i1), ErrStat2, ErrMsg2, OnlySize ) ! B_L_2_H_P - 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%SigmaCavitCrit) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SigmaCavitCrit,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SigmaCavitCrit,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SigmaCavitCrit,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SigmaCavitCrit,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%SigmaCavitCrit,2), UBOUND(InData%SigmaCavitCrit,2) - DO i1 = LBOUND(InData%SigmaCavitCrit,1), UBOUND(InData%SigmaCavitCrit,1) - ReKiBuf(Re_Xferred) = InData%SigmaCavitCrit(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%SigmaCavit) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SigmaCavit,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SigmaCavit,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SigmaCavit,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SigmaCavit,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%SigmaCavit,2), UBOUND(InData%SigmaCavit,2) - DO i1 = LBOUND(InData%SigmaCavit,1), UBOUND(InData%SigmaCavit,1) - ReKiBuf(Re_Xferred) = InData%SigmaCavit(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CavitWarnSet) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CavitWarnSet,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CavitWarnSet,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CavitWarnSet,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CavitWarnSet,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%CavitWarnSet,2), UBOUND(InData%CavitWarnSet,2) - DO i1 = LBOUND(InData%CavitWarnSet,1), UBOUND(InData%CavitWarnSet,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%CavitWarnSet(i1,i2), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TwrFB) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwrFB,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrFB,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwrFB,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrFB,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%TwrFB,2), UBOUND(InData%TwrFB,2) - DO i1 = LBOUND(InData%TwrFB,1), UBOUND(InData%TwrFB,1) - ReKiBuf(Re_Xferred) = InData%TwrFB(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TwrMB) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwrMB,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrMB,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwrMB,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrMB,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%TwrMB,2), UBOUND(InData%TwrMB,2) - DO i1 = LBOUND(InData%TwrMB,1), UBOUND(InData%TwrMB,1) - ReKiBuf(Re_Xferred) = InData%TwrMB(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%HubFB) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%HubFB,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%HubFB,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%HubFB,1), UBOUND(InData%HubFB,1) - ReKiBuf(Re_Xferred) = InData%HubFB(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%HubMB) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%HubMB,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%HubMB,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%HubMB,1), UBOUND(InData%HubMB,1) - ReKiBuf(Re_Xferred) = InData%HubMB(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%NacFB) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%NacFB,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NacFB,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%NacFB,1), UBOUND(InData%NacFB,1) - ReKiBuf(Re_Xferred) = InData%NacFB(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%NacMB) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%NacMB,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NacMB,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%NacMB,1), UBOUND(InData%NacMB,1) - ReKiBuf(Re_Xferred) = InData%NacMB(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BladeRootLoad) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BladeRootLoad,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BladeRootLoad,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BladeRootLoad,1), UBOUND(InData%BladeRootLoad,1) - CALL MeshPack( InData%BladeRootLoad(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! BladeRootLoad - 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%B_L_2_R_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%B_L_2_R_P,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%B_L_2_R_P,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%B_L_2_R_P,1), UBOUND(InData%B_L_2_R_P,1) - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%B_L_2_R_P(i1), ErrStat2, ErrMsg2, OnlySize ) ! B_L_2_R_P - 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%BladeBuoyLoadPoint) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BladeBuoyLoadPoint,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BladeBuoyLoadPoint,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BladeBuoyLoadPoint,1), UBOUND(InData%BladeBuoyLoadPoint,1) - CALL MeshPack( InData%BladeBuoyLoadPoint(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! BladeBuoyLoadPoint - 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%BladeBuoyLoad) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BladeBuoyLoad,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BladeBuoyLoad,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BladeBuoyLoad,1), UBOUND(InData%BladeBuoyLoad,1) - CALL MeshPack( InData%BladeBuoyLoad(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! BladeBuoyLoad - 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%B_P_2_B_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%B_P_2_B_L,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%B_P_2_B_L,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%B_P_2_B_L,1), UBOUND(InData%B_P_2_B_L,1) - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%B_P_2_B_L(i1), ErrStat2, ErrMsg2, OnlySize ) ! B_P_2_B_L - 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 - CALL MeshPack( InData%TwrBuoyLoadPoint, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! TwrBuoyLoadPoint - 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%TwrBuoyLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! TwrBuoyLoad - 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 NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%T_P_2_T_L, ErrStat2, ErrMsg2, OnlySize ) ! T_P_2_T_L - 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_TowerStrike, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%AvgDiskVel,1), UBOUND(InData%AvgDiskVel,1) - ReKiBuf(Re_Xferred) = InData%AvgDiskVel(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%AvgDiskVelDist,1), UBOUND(InData%AvgDiskVelDist,1) - ReKiBuf(Re_Xferred) = InData%AvgDiskVelDist(i1) - Re_Xferred = Re_Xferred + 1 - END DO - ReKiBuf(Re_Xferred) = InData%TFinAlpha - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TFinRe - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TFinVrel - Re_Xferred = Re_Xferred + 1 - DO i1 = LBOUND(InData%TFinVund_i,1), UBOUND(InData%TFinVund_i,1) - ReKiBuf(Re_Xferred) = InData%TFinVund_i(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%TFinVind_i,1), UBOUND(InData%TFinVind_i,1) - ReKiBuf(Re_Xferred) = InData%TFinVind_i(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%TFinVrel_i,1), UBOUND(InData%TFinVrel_i,1) - ReKiBuf(Re_Xferred) = InData%TFinVrel_i(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%TFinSTV_i,1), UBOUND(InData%TFinSTV_i,1) - ReKiBuf(Re_Xferred) = InData%TFinSTV_i(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%TFinF_i,1), UBOUND(InData%TFinF_i,1) - ReKiBuf(Re_Xferred) = InData%TFinF_i(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%TFinM_i,1), UBOUND(InData%TFinM_i,1) - ReKiBuf(Re_Xferred) = InData%TFinM_i(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END SUBROUTINE AD_PackRotMiscVarType - - SUBROUTINE AD_UnPackRotMiscVarType( 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(RotMiscVarType), 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 = 'AD_UnPackRotMiscVarType' - ! 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 BEMT_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%BEMT, ErrStat2, ErrMsg2 ) ! BEMT - 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 BEMT_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%BEMT_y, ErrStat2, ErrMsg2 ) ! BEMT_y - 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) - i1_l = LBOUND(OutData%BEMT_u,1) - i1_u = UBOUND(OutData%BEMT_u,1) - DO i1 = LBOUND(OutData%BEMT_u,1), UBOUND(OutData%BEMT_u,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 BEMT_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%BEMT_u(i1), ErrStat2, ErrMsg2 ) ! BEMT_u - 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 - 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 AA_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%AA, ErrStat2, ErrMsg2 ) ! AA - 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 AA_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%AA_y, ErrStat2, ErrMsg2 ) ! AA_y - 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 AA_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%AA_u, ErrStat2, ErrMsg2 ) ! AA_u - 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 ! DisturbedInflow not allocated - Int_Xferred = Int_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%DisturbedInflow)) DEALLOCATE(OutData%DisturbedInflow) - ALLOCATE(OutData%DisturbedInflow(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%DisturbedInflow.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%DisturbedInflow,3), UBOUND(OutData%DisturbedInflow,3) - DO i2 = LBOUND(OutData%DisturbedInflow,2), UBOUND(OutData%DisturbedInflow,2) - DO i1 = LBOUND(OutData%DisturbedInflow,1), UBOUND(OutData%DisturbedInflow,1) - OutData%DisturbedInflow(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 ! orientationAnnulus not allocated - Int_Xferred = Int_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%orientationAnnulus)) DEALLOCATE(OutData%orientationAnnulus) - ALLOCATE(OutData%orientationAnnulus(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%orientationAnnulus.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%orientationAnnulus,4), UBOUND(OutData%orientationAnnulus,4) - DO i3 = LBOUND(OutData%orientationAnnulus,3), UBOUND(OutData%orientationAnnulus,3) - DO i2 = LBOUND(OutData%orientationAnnulus,2), UBOUND(OutData%orientationAnnulus,2) - DO i1 = LBOUND(OutData%orientationAnnulus,1), UBOUND(OutData%orientationAnnulus,1) - OutData%orientationAnnulus(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 ! R_li not allocated - Int_Xferred = Int_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%R_li)) DEALLOCATE(OutData%R_li) - ALLOCATE(OutData%R_li(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%R_li.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%R_li,4), UBOUND(OutData%R_li,4) - DO i3 = LBOUND(OutData%R_li,3), UBOUND(OutData%R_li,3) - DO i2 = LBOUND(OutData%R_li,2), UBOUND(OutData%R_li,2) - DO i1 = LBOUND(OutData%R_li,1), UBOUND(OutData%R_li,1) - OutData%R_li(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 ! 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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! W_Twr not allocated - Int_Xferred = Int_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%W_Twr)) DEALLOCATE(OutData%W_Twr) - ALLOCATE(OutData%W_Twr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%W_Twr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%W_Twr,1), UBOUND(OutData%W_Twr,1) - OutData%W_Twr(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! X_Twr not allocated - Int_Xferred = Int_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_Twr)) DEALLOCATE(OutData%X_Twr) - ALLOCATE(OutData%X_Twr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%X_Twr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%X_Twr,1), UBOUND(OutData%X_Twr,1) - OutData%X_Twr(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Y_Twr not allocated - Int_Xferred = Int_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%Y_Twr)) DEALLOCATE(OutData%Y_Twr) - ALLOCATE(OutData%Y_Twr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Y_Twr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Y_Twr,1), UBOUND(OutData%Y_Twr,1) - OutData%Y_Twr(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Curve not allocated - Int_Xferred = Int_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%Curve)) DEALLOCATE(OutData%Curve) - ALLOCATE(OutData%Curve(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Curve.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Curve,2), UBOUND(OutData%Curve,2) - DO i1 = LBOUND(OutData%Curve,1), UBOUND(OutData%Curve,1) - OutData%Curve(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrClrnc not allocated - Int_Xferred = Int_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%TwrClrnc)) DEALLOCATE(OutData%TwrClrnc) - ALLOCATE(OutData%TwrClrnc(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrClrnc.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%TwrClrnc,2), UBOUND(OutData%TwrClrnc,2) - DO i1 = LBOUND(OutData%TwrClrnc,1), UBOUND(OutData%TwrClrnc,1) - OutData%TwrClrnc(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! 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%X)) DEALLOCATE(OutData%X) - ALLOCATE(OutData%X(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%X.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%X,2), UBOUND(OutData%X,2) - DO i1 = LBOUND(OutData%X,1), UBOUND(OutData%X,1) - OutData%X(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! 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 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Y)) DEALLOCATE(OutData%Y) - ALLOCATE(OutData%Y(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Y,2), UBOUND(OutData%Y,2) - DO i1 = LBOUND(OutData%Y,1), UBOUND(OutData%Y,1) - OutData%Y(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Z not allocated - Int_Xferred = Int_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%Z)) DEALLOCATE(OutData%Z) - ALLOCATE(OutData%Z(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Z.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Z,2), UBOUND(OutData%Z,2) - DO i1 = LBOUND(OutData%Z,1), UBOUND(OutData%Z,1) - OutData%Z(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_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) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Mx not allocated - Int_Xferred = Int_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%Mx)) DEALLOCATE(OutData%Mx) - ALLOCATE(OutData%Mx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Mx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Mx,2), UBOUND(OutData%Mx,2) - DO i1 = LBOUND(OutData%Mx,1), UBOUND(OutData%Mx,1) - OutData%Mx(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! My not allocated - Int_Xferred = Int_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%My)) DEALLOCATE(OutData%My) - ALLOCATE(OutData%My(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%My.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%My,2), UBOUND(OutData%My,2) - DO i1 = LBOUND(OutData%My,1), UBOUND(OutData%My,1) - OutData%My(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Mz not allocated - Int_Xferred = Int_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%Mz)) DEALLOCATE(OutData%Mz) - ALLOCATE(OutData%Mz(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Mz.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Mz,2), UBOUND(OutData%Mz,2) - DO i1 = LBOUND(OutData%Mz,1), UBOUND(OutData%Mz,1) - OutData%Mz(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vind_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 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Vind_i)) DEALLOCATE(OutData%Vind_i) - ALLOCATE(OutData%Vind_i(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%Vind_i.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Vind_i,3), UBOUND(OutData%Vind_i,3) - DO i2 = LBOUND(OutData%Vind_i,2), UBOUND(OutData%Vind_i,2) - DO i1 = LBOUND(OutData%Vind_i,1), UBOUND(OutData%Vind_i,1) - OutData%Vind_i(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - i1_l = LBOUND(OutData%V_DiskAvg,1) - i1_u = UBOUND(OutData%V_DiskAvg,1) - DO i1 = LBOUND(OutData%V_DiskAvg,1), UBOUND(OutData%V_DiskAvg,1) - OutData%V_DiskAvg(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%yaw = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%tilt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! hub_theta_x_root not allocated - Int_Xferred = Int_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%hub_theta_x_root)) DEALLOCATE(OutData%hub_theta_x_root) - ALLOCATE(OutData%hub_theta_x_root(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%hub_theta_x_root.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%hub_theta_x_root,1), UBOUND(OutData%hub_theta_x_root,1) - OutData%hub_theta_x_root(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%V_dot_x = ReKiBuf(Re_Xferred) - Re_Xferred = Re_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%HubLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! HubLoad - 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 ! B_L_2_H_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 - IF (ALLOCATED(OutData%B_L_2_H_P)) DEALLOCATE(OutData%B_L_2_H_P) - ALLOCATE(OutData%B_L_2_H_P(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%B_L_2_H_P.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%B_L_2_H_P,1), UBOUND(OutData%B_L_2_H_P,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%B_L_2_H_P(i1), ErrStat2, ErrMsg2 ) ! B_L_2_H_P - 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 ! SigmaCavitCrit not allocated - Int_Xferred = Int_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%SigmaCavitCrit)) DEALLOCATE(OutData%SigmaCavitCrit) - ALLOCATE(OutData%SigmaCavitCrit(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SigmaCavitCrit.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%SigmaCavitCrit,2), UBOUND(OutData%SigmaCavitCrit,2) - DO i1 = LBOUND(OutData%SigmaCavitCrit,1), UBOUND(OutData%SigmaCavitCrit,1) - OutData%SigmaCavitCrit(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SigmaCavit not allocated - Int_Xferred = Int_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%SigmaCavit)) DEALLOCATE(OutData%SigmaCavit) - ALLOCATE(OutData%SigmaCavit(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SigmaCavit.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%SigmaCavit,2), UBOUND(OutData%SigmaCavit,2) - DO i1 = LBOUND(OutData%SigmaCavit,1), UBOUND(OutData%SigmaCavit,1) - OutData%SigmaCavit(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CavitWarnSet not allocated - Int_Xferred = Int_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%CavitWarnSet)) DEALLOCATE(OutData%CavitWarnSet) - ALLOCATE(OutData%CavitWarnSet(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CavitWarnSet.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%CavitWarnSet,2), UBOUND(OutData%CavitWarnSet,2) - DO i1 = LBOUND(OutData%CavitWarnSet,1), UBOUND(OutData%CavitWarnSet,1) - OutData%CavitWarnSet(i1,i2) = TRANSFER(IntKiBuf(Int_Xferred), OutData%CavitWarnSet(i1,i2)) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrFB not allocated - Int_Xferred = Int_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%TwrFB)) DEALLOCATE(OutData%TwrFB) - ALLOCATE(OutData%TwrFB(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrFB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%TwrFB,2), UBOUND(OutData%TwrFB,2) - DO i1 = LBOUND(OutData%TwrFB,1), UBOUND(OutData%TwrFB,1) - OutData%TwrFB(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrMB not allocated - Int_Xferred = Int_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%TwrMB)) DEALLOCATE(OutData%TwrMB) - ALLOCATE(OutData%TwrMB(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrMB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%TwrMB,2), UBOUND(OutData%TwrMB,2) - DO i1 = LBOUND(OutData%TwrMB,1), UBOUND(OutData%TwrMB,1) - OutData%TwrMB(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! HubFB not allocated - Int_Xferred = Int_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%HubFB)) DEALLOCATE(OutData%HubFB) - ALLOCATE(OutData%HubFB(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%HubFB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%HubFB,1), UBOUND(OutData%HubFB,1) - OutData%HubFB(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! HubMB not allocated - Int_Xferred = Int_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%HubMB)) DEALLOCATE(OutData%HubMB) - ALLOCATE(OutData%HubMB(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%HubMB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%HubMB,1), UBOUND(OutData%HubMB,1) - OutData%HubMB(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NacFB not allocated - Int_Xferred = Int_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%NacFB)) DEALLOCATE(OutData%NacFB) - ALLOCATE(OutData%NacFB(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NacFB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%NacFB,1), UBOUND(OutData%NacFB,1) - OutData%NacFB(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NacMB not allocated - Int_Xferred = Int_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%NacMB)) DEALLOCATE(OutData%NacMB) - ALLOCATE(OutData%NacMB(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NacMB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%NacMB,1), UBOUND(OutData%NacMB,1) - OutData%NacMB(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BladeRootLoad not allocated - Int_Xferred = Int_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%BladeRootLoad)) DEALLOCATE(OutData%BladeRootLoad) - ALLOCATE(OutData%BladeRootLoad(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeRootLoad.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BladeRootLoad,1), UBOUND(OutData%BladeRootLoad,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%BladeRootLoad(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! BladeRootLoad - 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 ! B_L_2_R_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 - IF (ALLOCATED(OutData%B_L_2_R_P)) DEALLOCATE(OutData%B_L_2_R_P) - ALLOCATE(OutData%B_L_2_R_P(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%B_L_2_R_P.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%B_L_2_R_P,1), UBOUND(OutData%B_L_2_R_P,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%B_L_2_R_P(i1), ErrStat2, ErrMsg2 ) ! B_L_2_R_P - 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 ! BladeBuoyLoadPoint not allocated - Int_Xferred = Int_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%BladeBuoyLoadPoint)) DEALLOCATE(OutData%BladeBuoyLoadPoint) - ALLOCATE(OutData%BladeBuoyLoadPoint(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeBuoyLoadPoint.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BladeBuoyLoadPoint,1), UBOUND(OutData%BladeBuoyLoadPoint,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%BladeBuoyLoadPoint(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! BladeBuoyLoadPoint - 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 ! BladeBuoyLoad not allocated - Int_Xferred = Int_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%BladeBuoyLoad)) DEALLOCATE(OutData%BladeBuoyLoad) - ALLOCATE(OutData%BladeBuoyLoad(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeBuoyLoad.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BladeBuoyLoad,1), UBOUND(OutData%BladeBuoyLoad,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%BladeBuoyLoad(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! BladeBuoyLoad - 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 ! B_P_2_B_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%B_P_2_B_L)) DEALLOCATE(OutData%B_P_2_B_L) - ALLOCATE(OutData%B_P_2_B_L(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%B_P_2_B_L.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%B_P_2_B_L,1), UBOUND(OutData%B_P_2_B_L,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%B_P_2_B_L(i1), ErrStat2, ErrMsg2 ) ! B_P_2_B_L - 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 - 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%TwrBuoyLoadPoint, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! TwrBuoyLoadPoint - 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%TwrBuoyLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! TwrBuoyLoad - 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 NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%T_P_2_T_L, ErrStat2, ErrMsg2 ) ! T_P_2_T_L - 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_TowerStrike = TRANSFER(IntKiBuf(Int_Xferred), OutData%FirstWarn_TowerStrike) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%AvgDiskVel,1) - i1_u = UBOUND(OutData%AvgDiskVel,1) - DO i1 = LBOUND(OutData%AvgDiskVel,1), UBOUND(OutData%AvgDiskVel,1) - OutData%AvgDiskVel(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%AvgDiskVelDist,1) - i1_u = UBOUND(OutData%AvgDiskVelDist,1) - DO i1 = LBOUND(OutData%AvgDiskVelDist,1), UBOUND(OutData%AvgDiskVelDist,1) - OutData%AvgDiskVelDist(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%TFinAlpha = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TFinRe = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TFinVrel = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%TFinVund_i,1) - i1_u = UBOUND(OutData%TFinVund_i,1) - DO i1 = LBOUND(OutData%TFinVund_i,1), UBOUND(OutData%TFinVund_i,1) - OutData%TFinVund_i(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%TFinVind_i,1) - i1_u = UBOUND(OutData%TFinVind_i,1) - DO i1 = LBOUND(OutData%TFinVind_i,1), UBOUND(OutData%TFinVind_i,1) - OutData%TFinVind_i(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%TFinVrel_i,1) - i1_u = UBOUND(OutData%TFinVrel_i,1) - DO i1 = LBOUND(OutData%TFinVrel_i,1), UBOUND(OutData%TFinVrel_i,1) - OutData%TFinVrel_i(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%TFinSTV_i,1) - i1_u = UBOUND(OutData%TFinSTV_i,1) - DO i1 = LBOUND(OutData%TFinSTV_i,1), UBOUND(OutData%TFinSTV_i,1) - OutData%TFinSTV_i(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%TFinF_i,1) - i1_u = UBOUND(OutData%TFinF_i,1) - DO i1 = LBOUND(OutData%TFinF_i,1), UBOUND(OutData%TFinF_i,1) - OutData%TFinF_i(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%TFinM_i,1) - i1_u = UBOUND(OutData%TFinM_i,1) - DO i1 = LBOUND(OutData%TFinM_i,1), UBOUND(OutData%TFinM_i,1) - OutData%TFinM_i(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END SUBROUTINE AD_UnPackRotMiscVarType - - SUBROUTINE AD_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AD_MiscVarType), INTENT(INOUT) :: SrcMiscData - TYPE(AD_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 = 'AD_CopyMisc' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcMiscData%rotors)) THEN - i1_l = LBOUND(SrcMiscData%rotors,1) - i1_u = UBOUND(SrcMiscData%rotors,1) - IF (.NOT. ALLOCATED(DstMiscData%rotors)) THEN - ALLOCATE(DstMiscData%rotors(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%rotors.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%rotors,1), UBOUND(SrcMiscData%rotors,1) - CALL AD_Copyrotmiscvartype( SrcMiscData%rotors(i1), DstMiscData%rotors(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcMiscData%FVW_u)) THEN - i1_l = LBOUND(SrcMiscData%FVW_u,1) - i1_u = UBOUND(SrcMiscData%FVW_u,1) - IF (.NOT. ALLOCATED(DstMiscData%FVW_u)) THEN - ALLOCATE(DstMiscData%FVW_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FVW_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%FVW_u,1), UBOUND(SrcMiscData%FVW_u,1) - CALL FVW_CopyInput( SrcMiscData%FVW_u(i1), DstMiscData%FVW_u(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL FVW_CopyOutput( SrcMiscData%FVW_y, DstMiscData%FVW_y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL FVW_CopyMisc( SrcMiscData%FVW, DstMiscData%FVW, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE AD_CopyMisc - - SUBROUTINE AD_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(AD_MiscVarType), INTENT(INOUT) :: MiscData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_DestroyMisc' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(MiscData%rotors)) THEN -DO i1 = LBOUND(MiscData%rotors,1), UBOUND(MiscData%rotors,1) - CALL AD_Destroyrotmiscvartype( MiscData%rotors(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MiscData%rotors) -ENDIF -IF (ALLOCATED(MiscData%FVW_u)) THEN -DO i1 = LBOUND(MiscData%FVW_u,1), UBOUND(MiscData%FVW_u,1) - CALL FVW_DestroyInput( MiscData%FVW_u(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MiscData%FVW_u) -ENDIF - CALL FVW_DestroyOutput( MiscData%FVW_y, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FVW_DestroyMisc( MiscData%FVW, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE AD_DestroyMisc - - SUBROUTINE AD_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(AD_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 = 'AD_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 ! rotors allocated yes/no - IF ( ALLOCATED(InData%rotors) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! rotors upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%rotors,1), UBOUND(InData%rotors,1) - Int_BufSz = Int_BufSz + 3 ! rotors: size of buffers for each call to pack subtype - CALL AD_Packrotmiscvartype( Re_Buf, Db_Buf, Int_Buf, InData%rotors(i1), ErrStat2, ErrMsg2, .TRUE. ) ! rotors - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! rotors - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! rotors - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! rotors - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! FVW_u allocated yes/no - IF ( ALLOCATED(InData%FVW_u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! FVW_u upper/lower bounds for each dimension - DO i1 = LBOUND(InData%FVW_u,1), UBOUND(InData%FVW_u,1) - Int_BufSz = Int_BufSz + 3 ! FVW_u: size of buffers for each call to pack subtype - CALL FVW_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%FVW_u(i1), ErrStat2, ErrMsg2, .TRUE. ) ! FVW_u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! FVW_u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! FVW_u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! FVW_u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! FVW_y: size of buffers for each call to pack subtype - CALL FVW_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%FVW_y, ErrStat2, ErrMsg2, .TRUE. ) ! FVW_y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! FVW_y - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! FVW_y - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! FVW_y - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! FVW: size of buffers for each call to pack subtype - CALL FVW_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%FVW, ErrStat2, ErrMsg2, .TRUE. ) ! FVW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! FVW - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! FVW - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! FVW - 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%rotors) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rotors,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rotors,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%rotors,1), UBOUND(InData%rotors,1) - CALL AD_Packrotmiscvartype( Re_Buf, Db_Buf, Int_Buf, InData%rotors(i1), ErrStat2, ErrMsg2, OnlySize ) ! rotors - 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%FVW_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%FVW_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FVW_u,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%FVW_u,1), UBOUND(InData%FVW_u,1) - CALL FVW_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%FVW_u(i1), ErrStat2, ErrMsg2, OnlySize ) ! FVW_u - 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 - CALL FVW_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%FVW_y, ErrStat2, ErrMsg2, OnlySize ) ! FVW_y - 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 FVW_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%FVW, ErrStat2, ErrMsg2, OnlySize ) ! FVW - 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 AD_PackMisc - - SUBROUTINE AD_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(AD_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 = 'AD_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 ! rotors not allocated - Int_Xferred = Int_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%rotors)) DEALLOCATE(OutData%rotors) - ALLOCATE(OutData%rotors(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotors.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%rotors,1), UBOUND(OutData%rotors,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 AD_Unpackrotmiscvartype( Re_Buf, Db_Buf, Int_Buf, OutData%rotors(i1), ErrStat2, ErrMsg2 ) ! rotors - 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 ! FVW_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%FVW_u)) DEALLOCATE(OutData%FVW_u) - ALLOCATE(OutData%FVW_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FVW_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%FVW_u,1), UBOUND(OutData%FVW_u,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 FVW_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%FVW_u(i1), ErrStat2, ErrMsg2 ) ! FVW_u - 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 - 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 FVW_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%FVW_y, ErrStat2, ErrMsg2 ) ! FVW_y - 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 FVW_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%FVW, ErrStat2, ErrMsg2 ) ! FVW - 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 AD_UnPackMisc - - SUBROUTINE AD_CopyRotParameterType( SrcRotParameterTypeData, DstRotParameterTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(RotParameterType), INTENT(IN) :: SrcRotParameterTypeData - TYPE(RotParameterType), INTENT(INOUT) :: DstRotParameterTypeData - 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 = 'AD_CopyRotParameterType' -! - ErrStat = ErrID_None - ErrMsg = "" - DstRotParameterTypeData%NumBlades = SrcRotParameterTypeData%NumBlades - DstRotParameterTypeData%NumBlNds = SrcRotParameterTypeData%NumBlNds - DstRotParameterTypeData%NumTwrNds = SrcRotParameterTypeData%NumTwrNds -IF (ALLOCATED(SrcRotParameterTypeData%TwrDiam)) THEN - i1_l = LBOUND(SrcRotParameterTypeData%TwrDiam,1) - i1_u = UBOUND(SrcRotParameterTypeData%TwrDiam,1) - IF (.NOT. ALLOCATED(DstRotParameterTypeData%TwrDiam)) THEN - ALLOCATE(DstRotParameterTypeData%TwrDiam(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%TwrDiam.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotParameterTypeData%TwrDiam = SrcRotParameterTypeData%TwrDiam -ENDIF -IF (ALLOCATED(SrcRotParameterTypeData%TwrCd)) THEN - i1_l = LBOUND(SrcRotParameterTypeData%TwrCd,1) - i1_u = UBOUND(SrcRotParameterTypeData%TwrCd,1) - IF (.NOT. ALLOCATED(DstRotParameterTypeData%TwrCd)) THEN - ALLOCATE(DstRotParameterTypeData%TwrCd(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%TwrCd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotParameterTypeData%TwrCd = SrcRotParameterTypeData%TwrCd -ENDIF -IF (ALLOCATED(SrcRotParameterTypeData%TwrTI)) THEN - i1_l = LBOUND(SrcRotParameterTypeData%TwrTI,1) - i1_u = UBOUND(SrcRotParameterTypeData%TwrTI,1) - IF (.NOT. ALLOCATED(DstRotParameterTypeData%TwrTI)) THEN - ALLOCATE(DstRotParameterTypeData%TwrTI(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%TwrTI.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotParameterTypeData%TwrTI = SrcRotParameterTypeData%TwrTI -ENDIF -IF (ALLOCATED(SrcRotParameterTypeData%BlTwist)) THEN - i1_l = LBOUND(SrcRotParameterTypeData%BlTwist,1) - i1_u = UBOUND(SrcRotParameterTypeData%BlTwist,1) - i2_l = LBOUND(SrcRotParameterTypeData%BlTwist,2) - i2_u = UBOUND(SrcRotParameterTypeData%BlTwist,2) - IF (.NOT. ALLOCATED(DstRotParameterTypeData%BlTwist)) THEN - ALLOCATE(DstRotParameterTypeData%BlTwist(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%BlTwist.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotParameterTypeData%BlTwist = SrcRotParameterTypeData%BlTwist -ENDIF -IF (ALLOCATED(SrcRotParameterTypeData%TwrCb)) THEN - i1_l = LBOUND(SrcRotParameterTypeData%TwrCb,1) - i1_u = UBOUND(SrcRotParameterTypeData%TwrCb,1) - IF (.NOT. ALLOCATED(DstRotParameterTypeData%TwrCb)) THEN - ALLOCATE(DstRotParameterTypeData%TwrCb(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%TwrCb.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotParameterTypeData%TwrCb = SrcRotParameterTypeData%TwrCb -ENDIF -IF (ALLOCATED(SrcRotParameterTypeData%BlCenBn)) THEN - i1_l = LBOUND(SrcRotParameterTypeData%BlCenBn,1) - i1_u = UBOUND(SrcRotParameterTypeData%BlCenBn,1) - i2_l = LBOUND(SrcRotParameterTypeData%BlCenBn,2) - i2_u = UBOUND(SrcRotParameterTypeData%BlCenBn,2) - IF (.NOT. ALLOCATED(DstRotParameterTypeData%BlCenBn)) THEN - ALLOCATE(DstRotParameterTypeData%BlCenBn(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%BlCenBn.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotParameterTypeData%BlCenBn = SrcRotParameterTypeData%BlCenBn -ENDIF -IF (ALLOCATED(SrcRotParameterTypeData%BlCenBt)) THEN - i1_l = LBOUND(SrcRotParameterTypeData%BlCenBt,1) - i1_u = UBOUND(SrcRotParameterTypeData%BlCenBt,1) - i2_l = LBOUND(SrcRotParameterTypeData%BlCenBt,2) - i2_u = UBOUND(SrcRotParameterTypeData%BlCenBt,2) - IF (.NOT. ALLOCATED(DstRotParameterTypeData%BlCenBt)) THEN - ALLOCATE(DstRotParameterTypeData%BlCenBt(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%BlCenBt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotParameterTypeData%BlCenBt = SrcRotParameterTypeData%BlCenBt -ENDIF - DstRotParameterTypeData%VolHub = SrcRotParameterTypeData%VolHub - DstRotParameterTypeData%HubCenBx = SrcRotParameterTypeData%HubCenBx - DstRotParameterTypeData%VolNac = SrcRotParameterTypeData%VolNac - DstRotParameterTypeData%NacCenB = SrcRotParameterTypeData%NacCenB - DstRotParameterTypeData%VolBl = SrcRotParameterTypeData%VolBl - DstRotParameterTypeData%VolTwr = SrcRotParameterTypeData%VolTwr -IF (ALLOCATED(SrcRotParameterTypeData%BlRad)) THEN - i1_l = LBOUND(SrcRotParameterTypeData%BlRad,1) - i1_u = UBOUND(SrcRotParameterTypeData%BlRad,1) - i2_l = LBOUND(SrcRotParameterTypeData%BlRad,2) - i2_u = UBOUND(SrcRotParameterTypeData%BlRad,2) - IF (.NOT. ALLOCATED(DstRotParameterTypeData%BlRad)) THEN - ALLOCATE(DstRotParameterTypeData%BlRad(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%BlRad.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotParameterTypeData%BlRad = SrcRotParameterTypeData%BlRad -ENDIF -IF (ALLOCATED(SrcRotParameterTypeData%BlDL)) THEN - i1_l = LBOUND(SrcRotParameterTypeData%BlDL,1) - i1_u = UBOUND(SrcRotParameterTypeData%BlDL,1) - i2_l = LBOUND(SrcRotParameterTypeData%BlDL,2) - i2_u = UBOUND(SrcRotParameterTypeData%BlDL,2) - IF (.NOT. ALLOCATED(DstRotParameterTypeData%BlDL)) THEN - ALLOCATE(DstRotParameterTypeData%BlDL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%BlDL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotParameterTypeData%BlDL = SrcRotParameterTypeData%BlDL -ENDIF -IF (ALLOCATED(SrcRotParameterTypeData%BlTaper)) THEN - i1_l = LBOUND(SrcRotParameterTypeData%BlTaper,1) - i1_u = UBOUND(SrcRotParameterTypeData%BlTaper,1) - i2_l = LBOUND(SrcRotParameterTypeData%BlTaper,2) - i2_u = UBOUND(SrcRotParameterTypeData%BlTaper,2) - IF (.NOT. ALLOCATED(DstRotParameterTypeData%BlTaper)) THEN - ALLOCATE(DstRotParameterTypeData%BlTaper(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%BlTaper.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotParameterTypeData%BlTaper = SrcRotParameterTypeData%BlTaper -ENDIF -IF (ALLOCATED(SrcRotParameterTypeData%BlAxCent)) THEN - i1_l = LBOUND(SrcRotParameterTypeData%BlAxCent,1) - i1_u = UBOUND(SrcRotParameterTypeData%BlAxCent,1) - i2_l = LBOUND(SrcRotParameterTypeData%BlAxCent,2) - i2_u = UBOUND(SrcRotParameterTypeData%BlAxCent,2) - IF (.NOT. ALLOCATED(DstRotParameterTypeData%BlAxCent)) THEN - ALLOCATE(DstRotParameterTypeData%BlAxCent(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%BlAxCent.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotParameterTypeData%BlAxCent = SrcRotParameterTypeData%BlAxCent -ENDIF -IF (ALLOCATED(SrcRotParameterTypeData%TwrRad)) THEN - i1_l = LBOUND(SrcRotParameterTypeData%TwrRad,1) - i1_u = UBOUND(SrcRotParameterTypeData%TwrRad,1) - IF (.NOT. ALLOCATED(DstRotParameterTypeData%TwrRad)) THEN - ALLOCATE(DstRotParameterTypeData%TwrRad(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%TwrRad.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotParameterTypeData%TwrRad = SrcRotParameterTypeData%TwrRad -ENDIF -IF (ALLOCATED(SrcRotParameterTypeData%TwrDL)) THEN - i1_l = LBOUND(SrcRotParameterTypeData%TwrDL,1) - i1_u = UBOUND(SrcRotParameterTypeData%TwrDL,1) - IF (.NOT. ALLOCATED(DstRotParameterTypeData%TwrDL)) THEN - ALLOCATE(DstRotParameterTypeData%TwrDL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%TwrDL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotParameterTypeData%TwrDL = SrcRotParameterTypeData%TwrDL -ENDIF -IF (ALLOCATED(SrcRotParameterTypeData%TwrTaper)) THEN - i1_l = LBOUND(SrcRotParameterTypeData%TwrTaper,1) - i1_u = UBOUND(SrcRotParameterTypeData%TwrTaper,1) - IF (.NOT. ALLOCATED(DstRotParameterTypeData%TwrTaper)) THEN - ALLOCATE(DstRotParameterTypeData%TwrTaper(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%TwrTaper.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotParameterTypeData%TwrTaper = SrcRotParameterTypeData%TwrTaper -ENDIF -IF (ALLOCATED(SrcRotParameterTypeData%TwrAxCent)) THEN - i1_l = LBOUND(SrcRotParameterTypeData%TwrAxCent,1) - i1_u = UBOUND(SrcRotParameterTypeData%TwrAxCent,1) - IF (.NOT. ALLOCATED(DstRotParameterTypeData%TwrAxCent)) THEN - ALLOCATE(DstRotParameterTypeData%TwrAxCent(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%TwrAxCent.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotParameterTypeData%TwrAxCent = SrcRotParameterTypeData%TwrAxCent -ENDIF - CALL BEMT_CopyParam( SrcRotParameterTypeData%BEMT, DstRotParameterTypeData%BEMT, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AA_CopyParam( SrcRotParameterTypeData%AA, DstRotParameterTypeData%AA, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcRotParameterTypeData%Jac_u_indx)) THEN - i1_l = LBOUND(SrcRotParameterTypeData%Jac_u_indx,1) - i1_u = UBOUND(SrcRotParameterTypeData%Jac_u_indx,1) - i2_l = LBOUND(SrcRotParameterTypeData%Jac_u_indx,2) - i2_u = UBOUND(SrcRotParameterTypeData%Jac_u_indx,2) - IF (.NOT. ALLOCATED(DstRotParameterTypeData%Jac_u_indx)) THEN - ALLOCATE(DstRotParameterTypeData%Jac_u_indx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%Jac_u_indx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotParameterTypeData%Jac_u_indx = SrcRotParameterTypeData%Jac_u_indx -ENDIF -IF (ALLOCATED(SrcRotParameterTypeData%du)) THEN - i1_l = LBOUND(SrcRotParameterTypeData%du,1) - i1_u = UBOUND(SrcRotParameterTypeData%du,1) - IF (.NOT. ALLOCATED(DstRotParameterTypeData%du)) THEN - ALLOCATE(DstRotParameterTypeData%du(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%du.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotParameterTypeData%du = SrcRotParameterTypeData%du -ENDIF -IF (ALLOCATED(SrcRotParameterTypeData%dx)) THEN - i1_l = LBOUND(SrcRotParameterTypeData%dx,1) - i1_u = UBOUND(SrcRotParameterTypeData%dx,1) - IF (.NOT. ALLOCATED(DstRotParameterTypeData%dx)) THEN - ALLOCATE(DstRotParameterTypeData%dx(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%dx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotParameterTypeData%dx = SrcRotParameterTypeData%dx -ENDIF - DstRotParameterTypeData%Jac_ny = SrcRotParameterTypeData%Jac_ny - DstRotParameterTypeData%NumBl_Lin = SrcRotParameterTypeData%NumBl_Lin - DstRotParameterTypeData%TwrPotent = SrcRotParameterTypeData%TwrPotent - DstRotParameterTypeData%TwrShadow = SrcRotParameterTypeData%TwrShadow - DstRotParameterTypeData%TwrAero = SrcRotParameterTypeData%TwrAero - DstRotParameterTypeData%FrozenWake = SrcRotParameterTypeData%FrozenWake - DstRotParameterTypeData%CavitCheck = SrcRotParameterTypeData%CavitCheck - DstRotParameterTypeData%Buoyancy = SrcRotParameterTypeData%Buoyancy - DstRotParameterTypeData%MHK = SrcRotParameterTypeData%MHK - DstRotParameterTypeData%CompAA = SrcRotParameterTypeData%CompAA - DstRotParameterTypeData%AirDens = SrcRotParameterTypeData%AirDens - DstRotParameterTypeData%KinVisc = SrcRotParameterTypeData%KinVisc - DstRotParameterTypeData%SpdSound = SrcRotParameterTypeData%SpdSound - DstRotParameterTypeData%Gravity = SrcRotParameterTypeData%Gravity - DstRotParameterTypeData%Patm = SrcRotParameterTypeData%Patm - DstRotParameterTypeData%Pvap = SrcRotParameterTypeData%Pvap - DstRotParameterTypeData%WtrDpth = SrcRotParameterTypeData%WtrDpth - DstRotParameterTypeData%MSL2SWL = SrcRotParameterTypeData%MSL2SWL - DstRotParameterTypeData%AeroProjMod = SrcRotParameterTypeData%AeroProjMod - DstRotParameterTypeData%AeroBEM_Mod = SrcRotParameterTypeData%AeroBEM_Mod - DstRotParameterTypeData%NumOuts = SrcRotParameterTypeData%NumOuts - DstRotParameterTypeData%RootName = SrcRotParameterTypeData%RootName -IF (ALLOCATED(SrcRotParameterTypeData%OutParam)) THEN - i1_l = LBOUND(SrcRotParameterTypeData%OutParam,1) - i1_u = UBOUND(SrcRotParameterTypeData%OutParam,1) - IF (.NOT. ALLOCATED(DstRotParameterTypeData%OutParam)) THEN - ALLOCATE(DstRotParameterTypeData%OutParam(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%OutParam.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcRotParameterTypeData%OutParam,1), UBOUND(SrcRotParameterTypeData%OutParam,1) - CALL NWTC_Library_Copyoutparmtype( SrcRotParameterTypeData%OutParam(i1), DstRotParameterTypeData%OutParam(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - DstRotParameterTypeData%NBlOuts = SrcRotParameterTypeData%NBlOuts - DstRotParameterTypeData%BlOutNd = SrcRotParameterTypeData%BlOutNd - DstRotParameterTypeData%NTwOuts = SrcRotParameterTypeData%NTwOuts - DstRotParameterTypeData%TwOutNd = SrcRotParameterTypeData%TwOutNd - DstRotParameterTypeData%BldNd_NumOuts = SrcRotParameterTypeData%BldNd_NumOuts - DstRotParameterTypeData%BldNd_TotNumOuts = SrcRotParameterTypeData%BldNd_TotNumOuts -IF (ALLOCATED(SrcRotParameterTypeData%BldNd_OutParam)) THEN - i1_l = LBOUND(SrcRotParameterTypeData%BldNd_OutParam,1) - i1_u = UBOUND(SrcRotParameterTypeData%BldNd_OutParam,1) - IF (.NOT. ALLOCATED(DstRotParameterTypeData%BldNd_OutParam)) THEN - ALLOCATE(DstRotParameterTypeData%BldNd_OutParam(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%BldNd_OutParam.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcRotParameterTypeData%BldNd_OutParam,1), UBOUND(SrcRotParameterTypeData%BldNd_OutParam,1) - CALL NWTC_Library_Copyoutparmtype( SrcRotParameterTypeData%BldNd_OutParam(i1), DstRotParameterTypeData%BldNd_OutParam(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcRotParameterTypeData%BldNd_BlOutNd)) THEN - i1_l = LBOUND(SrcRotParameterTypeData%BldNd_BlOutNd,1) - i1_u = UBOUND(SrcRotParameterTypeData%BldNd_BlOutNd,1) - IF (.NOT. ALLOCATED(DstRotParameterTypeData%BldNd_BlOutNd)) THEN - ALLOCATE(DstRotParameterTypeData%BldNd_BlOutNd(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%BldNd_BlOutNd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotParameterTypeData%BldNd_BlOutNd = SrcRotParameterTypeData%BldNd_BlOutNd -ENDIF - DstRotParameterTypeData%BldNd_BladesOut = SrcRotParameterTypeData%BldNd_BladesOut - DstRotParameterTypeData%TFinAero = SrcRotParameterTypeData%TFinAero - CALL AD_Copytfinparametertype( SrcRotParameterTypeData%TFin, DstRotParameterTypeData%TFin, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE AD_CopyRotParameterType - - SUBROUTINE AD_DestroyRotParameterType( RotParameterTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(RotParameterType), INTENT(INOUT) :: RotParameterTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_DestroyRotParameterType' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(RotParameterTypeData%TwrDiam)) THEN - DEALLOCATE(RotParameterTypeData%TwrDiam) -ENDIF -IF (ALLOCATED(RotParameterTypeData%TwrCd)) THEN - DEALLOCATE(RotParameterTypeData%TwrCd) -ENDIF -IF (ALLOCATED(RotParameterTypeData%TwrTI)) THEN - DEALLOCATE(RotParameterTypeData%TwrTI) -ENDIF -IF (ALLOCATED(RotParameterTypeData%BlTwist)) THEN - DEALLOCATE(RotParameterTypeData%BlTwist) -ENDIF -IF (ALLOCATED(RotParameterTypeData%TwrCb)) THEN - DEALLOCATE(RotParameterTypeData%TwrCb) -ENDIF -IF (ALLOCATED(RotParameterTypeData%BlCenBn)) THEN - DEALLOCATE(RotParameterTypeData%BlCenBn) -ENDIF -IF (ALLOCATED(RotParameterTypeData%BlCenBt)) THEN - DEALLOCATE(RotParameterTypeData%BlCenBt) -ENDIF -IF (ALLOCATED(RotParameterTypeData%BlRad)) THEN - DEALLOCATE(RotParameterTypeData%BlRad) -ENDIF -IF (ALLOCATED(RotParameterTypeData%BlDL)) THEN - DEALLOCATE(RotParameterTypeData%BlDL) -ENDIF -IF (ALLOCATED(RotParameterTypeData%BlTaper)) THEN - DEALLOCATE(RotParameterTypeData%BlTaper) -ENDIF -IF (ALLOCATED(RotParameterTypeData%BlAxCent)) THEN - DEALLOCATE(RotParameterTypeData%BlAxCent) -ENDIF -IF (ALLOCATED(RotParameterTypeData%TwrRad)) THEN - DEALLOCATE(RotParameterTypeData%TwrRad) -ENDIF -IF (ALLOCATED(RotParameterTypeData%TwrDL)) THEN - DEALLOCATE(RotParameterTypeData%TwrDL) -ENDIF -IF (ALLOCATED(RotParameterTypeData%TwrTaper)) THEN - DEALLOCATE(RotParameterTypeData%TwrTaper) -ENDIF -IF (ALLOCATED(RotParameterTypeData%TwrAxCent)) THEN - DEALLOCATE(RotParameterTypeData%TwrAxCent) -ENDIF - CALL BEMT_DestroyParam( RotParameterTypeData%BEMT, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AA_DestroyParam( RotParameterTypeData%AA, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(RotParameterTypeData%Jac_u_indx)) THEN - DEALLOCATE(RotParameterTypeData%Jac_u_indx) -ENDIF -IF (ALLOCATED(RotParameterTypeData%du)) THEN - DEALLOCATE(RotParameterTypeData%du) -ENDIF -IF (ALLOCATED(RotParameterTypeData%dx)) THEN - DEALLOCATE(RotParameterTypeData%dx) -ENDIF -IF (ALLOCATED(RotParameterTypeData%OutParam)) THEN -DO i1 = LBOUND(RotParameterTypeData%OutParam,1), UBOUND(RotParameterTypeData%OutParam,1) - CALL NWTC_Library_Destroyoutparmtype( RotParameterTypeData%OutParam(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(RotParameterTypeData%OutParam) -ENDIF -IF (ALLOCATED(RotParameterTypeData%BldNd_OutParam)) THEN -DO i1 = LBOUND(RotParameterTypeData%BldNd_OutParam,1), UBOUND(RotParameterTypeData%BldNd_OutParam,1) - CALL NWTC_Library_Destroyoutparmtype( RotParameterTypeData%BldNd_OutParam(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(RotParameterTypeData%BldNd_OutParam) -ENDIF -IF (ALLOCATED(RotParameterTypeData%BldNd_BlOutNd)) THEN - DEALLOCATE(RotParameterTypeData%BldNd_BlOutNd) -ENDIF - CALL AD_Destroytfinparametertype( RotParameterTypeData%TFin, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE AD_DestroyRotParameterType - - SUBROUTINE AD_PackRotParameterType( 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(RotParameterType), 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 = 'AD_PackRotParameterType' - ! 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 ! NumBlades - Int_BufSz = Int_BufSz + 1 ! NumBlNds - Int_BufSz = Int_BufSz + 1 ! NumTwrNds - Int_BufSz = Int_BufSz + 1 ! TwrDiam allocated yes/no - IF ( ALLOCATED(InData%TwrDiam) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TwrDiam upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TwrDiam) ! TwrDiam - END IF - Int_BufSz = Int_BufSz + 1 ! TwrCd allocated yes/no - IF ( ALLOCATED(InData%TwrCd) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TwrCd upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TwrCd) ! TwrCd - END IF - Int_BufSz = Int_BufSz + 1 ! TwrTI allocated yes/no - IF ( ALLOCATED(InData%TwrTI) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TwrTI upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TwrTI) ! TwrTI - END IF - Int_BufSz = Int_BufSz + 1 ! BlTwist allocated yes/no - IF ( ALLOCATED(InData%BlTwist) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BlTwist upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BlTwist) ! BlTwist - END IF - Int_BufSz = Int_BufSz + 1 ! TwrCb allocated yes/no - IF ( ALLOCATED(InData%TwrCb) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TwrCb upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TwrCb) ! TwrCb - END IF - Int_BufSz = Int_BufSz + 1 ! BlCenBn allocated yes/no - IF ( ALLOCATED(InData%BlCenBn) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BlCenBn upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BlCenBn) ! BlCenBn - END IF - Int_BufSz = Int_BufSz + 1 ! BlCenBt allocated yes/no - IF ( ALLOCATED(InData%BlCenBt) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BlCenBt upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BlCenBt) ! BlCenBt - END IF - Re_BufSz = Re_BufSz + 1 ! VolHub - Re_BufSz = Re_BufSz + 1 ! HubCenBx - Re_BufSz = Re_BufSz + 1 ! VolNac - Re_BufSz = Re_BufSz + SIZE(InData%NacCenB) ! NacCenB - Re_BufSz = Re_BufSz + 1 ! VolBl - Re_BufSz = Re_BufSz + 1 ! VolTwr - Int_BufSz = Int_BufSz + 1 ! BlRad allocated yes/no - IF ( ALLOCATED(InData%BlRad) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BlRad upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BlRad) ! BlRad - END IF - Int_BufSz = Int_BufSz + 1 ! BlDL allocated yes/no - IF ( ALLOCATED(InData%BlDL) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BlDL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BlDL) ! BlDL - END IF - Int_BufSz = Int_BufSz + 1 ! BlTaper allocated yes/no - IF ( ALLOCATED(InData%BlTaper) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BlTaper upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BlTaper) ! BlTaper - END IF - Int_BufSz = Int_BufSz + 1 ! BlAxCent allocated yes/no - IF ( ALLOCATED(InData%BlAxCent) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BlAxCent upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BlAxCent) ! BlAxCent - END IF - Int_BufSz = Int_BufSz + 1 ! TwrRad allocated yes/no - IF ( ALLOCATED(InData%TwrRad) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TwrRad upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TwrRad) ! TwrRad - END IF - Int_BufSz = Int_BufSz + 1 ! TwrDL allocated yes/no - IF ( ALLOCATED(InData%TwrDL) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TwrDL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TwrDL) ! TwrDL - END IF - Int_BufSz = Int_BufSz + 1 ! TwrTaper allocated yes/no - IF ( ALLOCATED(InData%TwrTaper) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TwrTaper upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TwrTaper) ! TwrTaper - END IF - Int_BufSz = Int_BufSz + 1 ! TwrAxCent allocated yes/no - IF ( ALLOCATED(InData%TwrAxCent) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TwrAxCent upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TwrAxCent) ! TwrAxCent - END IF - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! BEMT: size of buffers for each call to pack subtype - CALL BEMT_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%BEMT, ErrStat2, ErrMsg2, .TRUE. ) ! BEMT - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BEMT - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BEMT - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BEMT - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! AA: size of buffers for each call to pack subtype - CALL AA_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%AA, ErrStat2, ErrMsg2, .TRUE. ) ! AA - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! AA - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! AA - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! AA - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - 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 - Re_BufSz = Re_BufSz + SIZE(InData%du) ! du - END IF - Int_BufSz = Int_BufSz + 1 ! dx allocated yes/no - IF ( ALLOCATED(InData%dx) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! dx upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%dx) ! dx - END IF - Int_BufSz = Int_BufSz + 1 ! Jac_ny - Int_BufSz = Int_BufSz + 1 ! NumBl_Lin - Int_BufSz = Int_BufSz + 1 ! TwrPotent - Int_BufSz = Int_BufSz + 1 ! TwrShadow - Int_BufSz = Int_BufSz + 1 ! TwrAero - Int_BufSz = Int_BufSz + 1 ! FrozenWake - Int_BufSz = Int_BufSz + 1 ! CavitCheck - Int_BufSz = Int_BufSz + 1 ! Buoyancy - Int_BufSz = Int_BufSz + 1 ! MHK - Int_BufSz = Int_BufSz + 1 ! CompAA - Re_BufSz = Re_BufSz + 1 ! AirDens - Re_BufSz = Re_BufSz + 1 ! KinVisc - Re_BufSz = Re_BufSz + 1 ! SpdSound - Re_BufSz = Re_BufSz + 1 ! Gravity - Re_BufSz = Re_BufSz + 1 ! Patm - Re_BufSz = Re_BufSz + 1 ! Pvap - Re_BufSz = Re_BufSz + 1 ! WtrDpth - Re_BufSz = Re_BufSz + 1 ! MSL2SWL - Int_BufSz = Int_BufSz + 1 ! AeroProjMod - Int_BufSz = Int_BufSz + 1 ! AeroBEM_Mod - Int_BufSz = Int_BufSz + 1 ! NumOuts - 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 - 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 ! NBlOuts - Int_BufSz = Int_BufSz + SIZE(InData%BlOutNd) ! BlOutNd - Int_BufSz = Int_BufSz + 1 ! NTwOuts - Int_BufSz = Int_BufSz + SIZE(InData%TwOutNd) ! TwOutNd - Int_BufSz = Int_BufSz + 1 ! BldNd_NumOuts - Int_BufSz = Int_BufSz + 1 ! BldNd_TotNumOuts - Int_BufSz = Int_BufSz + 1 ! BldNd_OutParam allocated yes/no - IF ( ALLOCATED(InData%BldNd_OutParam) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BldNd_OutParam upper/lower bounds for each dimension - DO i1 = LBOUND(InData%BldNd_OutParam,1), UBOUND(InData%BldNd_OutParam,1) - Int_BufSz = Int_BufSz + 3 ! BldNd_OutParam: size of buffers for each call to pack subtype - CALL NWTC_Library_Packoutparmtype( Re_Buf, Db_Buf, Int_Buf, InData%BldNd_OutParam(i1), ErrStat2, ErrMsg2, .TRUE. ) ! BldNd_OutParam - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BldNd_OutParam - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BldNd_OutParam - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BldNd_OutParam - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! BldNd_BlOutNd allocated yes/no - IF ( ALLOCATED(InData%BldNd_BlOutNd) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BldNd_BlOutNd upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%BldNd_BlOutNd) ! BldNd_BlOutNd - END IF - Int_BufSz = Int_BufSz + 1 ! BldNd_BladesOut - Int_BufSz = Int_BufSz + 1 ! TFinAero - Int_BufSz = Int_BufSz + 3 ! TFin: size of buffers for each call to pack subtype - CALL AD_Packtfinparametertype( Re_Buf, Db_Buf, Int_Buf, InData%TFin, ErrStat2, ErrMsg2, .TRUE. ) ! TFin - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! TFin - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! TFin - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! TFin - 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 - - IntKiBuf(Int_Xferred) = InData%NumBlades - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumBlNds - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumTwrNds - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%TwrDiam) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwrDiam,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrDiam,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TwrDiam,1), UBOUND(InData%TwrDiam,1) - ReKiBuf(Re_Xferred) = InData%TwrDiam(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TwrCd) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwrCd,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrCd,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TwrCd,1), UBOUND(InData%TwrCd,1) - ReKiBuf(Re_Xferred) = InData%TwrCd(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TwrTI) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwrTI,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrTI,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TwrTI,1), UBOUND(InData%TwrTI,1) - ReKiBuf(Re_Xferred) = InData%TwrTI(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BlTwist) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlTwist,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlTwist,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlTwist,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlTwist,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%BlTwist,2), UBOUND(InData%BlTwist,2) - DO i1 = LBOUND(InData%BlTwist,1), UBOUND(InData%BlTwist,1) - ReKiBuf(Re_Xferred) = InData%BlTwist(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TwrCb) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwrCb,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrCb,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TwrCb,1), UBOUND(InData%TwrCb,1) - ReKiBuf(Re_Xferred) = InData%TwrCb(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BlCenBn) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlCenBn,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlCenBn,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlCenBn,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlCenBn,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%BlCenBn,2), UBOUND(InData%BlCenBn,2) - DO i1 = LBOUND(InData%BlCenBn,1), UBOUND(InData%BlCenBn,1) - ReKiBuf(Re_Xferred) = InData%BlCenBn(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BlCenBt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlCenBt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlCenBt,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlCenBt,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlCenBt,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%BlCenBt,2), UBOUND(InData%BlCenBt,2) - DO i1 = LBOUND(InData%BlCenBt,1), UBOUND(InData%BlCenBt,1) - ReKiBuf(Re_Xferred) = InData%BlCenBt(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - ReKiBuf(Re_Xferred) = InData%VolHub - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%HubCenBx - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%VolNac - Re_Xferred = Re_Xferred + 1 - DO i1 = LBOUND(InData%NacCenB,1), UBOUND(InData%NacCenB,1) - ReKiBuf(Re_Xferred) = InData%NacCenB(i1) - Re_Xferred = Re_Xferred + 1 - END DO - ReKiBuf(Re_Xferred) = InData%VolBl - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%VolTwr - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%BlRad) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlRad,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlRad,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlRad,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlRad,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%BlRad,2), UBOUND(InData%BlRad,2) - DO i1 = LBOUND(InData%BlRad,1), UBOUND(InData%BlRad,1) - ReKiBuf(Re_Xferred) = InData%BlRad(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BlDL) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlDL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlDL,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlDL,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlDL,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%BlDL,2), UBOUND(InData%BlDL,2) - DO i1 = LBOUND(InData%BlDL,1), UBOUND(InData%BlDL,1) - ReKiBuf(Re_Xferred) = InData%BlDL(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BlTaper) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlTaper,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlTaper,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlTaper,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlTaper,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%BlTaper,2), UBOUND(InData%BlTaper,2) - DO i1 = LBOUND(InData%BlTaper,1), UBOUND(InData%BlTaper,1) - ReKiBuf(Re_Xferred) = InData%BlTaper(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BlAxCent) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlAxCent,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlAxCent,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlAxCent,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlAxCent,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%BlAxCent,2), UBOUND(InData%BlAxCent,2) - DO i1 = LBOUND(InData%BlAxCent,1), UBOUND(InData%BlAxCent,1) - ReKiBuf(Re_Xferred) = InData%BlAxCent(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TwrRad) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwrRad,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrRad,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TwrRad,1), UBOUND(InData%TwrRad,1) - ReKiBuf(Re_Xferred) = InData%TwrRad(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TwrDL) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwrDL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrDL,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TwrDL,1), UBOUND(InData%TwrDL,1) - ReKiBuf(Re_Xferred) = InData%TwrDL(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TwrTaper) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwrTaper,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrTaper,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TwrTaper,1), UBOUND(InData%TwrTaper,1) - ReKiBuf(Re_Xferred) = InData%TwrTaper(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TwrAxCent) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwrAxCent,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrAxCent,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TwrAxCent,1), UBOUND(InData%TwrAxCent,1) - ReKiBuf(Re_Xferred) = InData%TwrAxCent(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - CALL BEMT_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%BEMT, ErrStat2, ErrMsg2, OnlySize ) ! BEMT - 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 AA_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%AA, ErrStat2, ErrMsg2, OnlySize ) ! AA - 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%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) - ReKiBuf(Re_Xferred) = InData%du(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%dx) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%dx,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dx,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%dx,1), UBOUND(InData%dx,1) - ReKiBuf(Re_Xferred) = InData%dx(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%Jac_ny - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumBl_Lin - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%TwrPotent - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%TwrShadow - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%TwrAero, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%FrozenWake, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%CavitCheck, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%Buoyancy, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%MHK - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%CompAA, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%AirDens - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%KinVisc - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%SpdSound - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Gravity - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Patm - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Pvap - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WtrDpth - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MSL2SWL - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%AeroProjMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%AeroBEM_Mod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumOuts - 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 - IntKiBuf(Int_Xferred) = InData%NBlOuts - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%BlOutNd,1), UBOUND(InData%BlOutNd,1) - IntKiBuf(Int_Xferred) = InData%BlOutNd(i1) - Int_Xferred = Int_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%NTwOuts - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%TwOutNd,1), UBOUND(InData%TwOutNd,1) - IntKiBuf(Int_Xferred) = InData%TwOutNd(i1) - Int_Xferred = Int_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%BldNd_NumOuts - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%BldNd_TotNumOuts - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%BldNd_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%BldNd_OutParam,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldNd_OutParam,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BldNd_OutParam,1), UBOUND(InData%BldNd_OutParam,1) - CALL NWTC_Library_Packoutparmtype( Re_Buf, Db_Buf, Int_Buf, InData%BldNd_OutParam(i1), ErrStat2, ErrMsg2, OnlySize ) ! BldNd_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%BldNd_BlOutNd) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BldNd_BlOutNd,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldNd_BlOutNd,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BldNd_BlOutNd,1), UBOUND(InData%BldNd_BlOutNd,1) - IntKiBuf(Int_Xferred) = InData%BldNd_BlOutNd(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%BldNd_BladesOut - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%TFinAero, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - CALL AD_Packtfinparametertype( Re_Buf, Db_Buf, Int_Buf, InData%TFin, ErrStat2, ErrMsg2, OnlySize ) ! TFin - 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 AD_PackRotParameterType - - SUBROUTINE AD_UnPackRotParameterType( 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(RotParameterType), 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 = 'AD_UnPackRotParameterType' - ! 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%NumBlades = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumBlNds = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumTwrNds = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrDiam not allocated - Int_Xferred = Int_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%TwrDiam)) DEALLOCATE(OutData%TwrDiam) - ALLOCATE(OutData%TwrDiam(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrDiam.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TwrDiam,1), UBOUND(OutData%TwrDiam,1) - OutData%TwrDiam(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrCd not allocated - Int_Xferred = Int_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%TwrCd)) DEALLOCATE(OutData%TwrCd) - ALLOCATE(OutData%TwrCd(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrCd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TwrCd,1), UBOUND(OutData%TwrCd,1) - OutData%TwrCd(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrTI not allocated - Int_Xferred = Int_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%TwrTI)) DEALLOCATE(OutData%TwrTI) - ALLOCATE(OutData%TwrTI(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrTI.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TwrTI,1), UBOUND(OutData%TwrTI,1) - OutData%TwrTI(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlTwist not allocated - Int_Xferred = Int_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%BlTwist)) DEALLOCATE(OutData%BlTwist) - ALLOCATE(OutData%BlTwist(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlTwist.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%BlTwist,2), UBOUND(OutData%BlTwist,2) - DO i1 = LBOUND(OutData%BlTwist,1), UBOUND(OutData%BlTwist,1) - OutData%BlTwist(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrCb not allocated - Int_Xferred = Int_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%TwrCb)) DEALLOCATE(OutData%TwrCb) - ALLOCATE(OutData%TwrCb(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrCb.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TwrCb,1), UBOUND(OutData%TwrCb,1) - OutData%TwrCb(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlCenBn not allocated - Int_Xferred = Int_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%BlCenBn)) DEALLOCATE(OutData%BlCenBn) - ALLOCATE(OutData%BlCenBn(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlCenBn.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%BlCenBn,2), UBOUND(OutData%BlCenBn,2) - DO i1 = LBOUND(OutData%BlCenBn,1), UBOUND(OutData%BlCenBn,1) - OutData%BlCenBn(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlCenBt not allocated - Int_Xferred = Int_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%BlCenBt)) DEALLOCATE(OutData%BlCenBt) - ALLOCATE(OutData%BlCenBt(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlCenBt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%BlCenBt,2), UBOUND(OutData%BlCenBt,2) - DO i1 = LBOUND(OutData%BlCenBt,1), UBOUND(OutData%BlCenBt,1) - OutData%BlCenBt(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%VolHub = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%HubCenBx = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%VolNac = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%NacCenB,1) - i1_u = UBOUND(OutData%NacCenB,1) - DO i1 = LBOUND(OutData%NacCenB,1), UBOUND(OutData%NacCenB,1) - OutData%NacCenB(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%VolBl = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%VolTwr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlRad not allocated - Int_Xferred = Int_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%BlRad)) DEALLOCATE(OutData%BlRad) - ALLOCATE(OutData%BlRad(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlRad.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%BlRad,2), UBOUND(OutData%BlRad,2) - DO i1 = LBOUND(OutData%BlRad,1), UBOUND(OutData%BlRad,1) - OutData%BlRad(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlDL not allocated - Int_Xferred = Int_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%BlDL)) DEALLOCATE(OutData%BlDL) - ALLOCATE(OutData%BlDL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlDL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%BlDL,2), UBOUND(OutData%BlDL,2) - DO i1 = LBOUND(OutData%BlDL,1), UBOUND(OutData%BlDL,1) - OutData%BlDL(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlTaper not allocated - Int_Xferred = Int_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%BlTaper)) DEALLOCATE(OutData%BlTaper) - ALLOCATE(OutData%BlTaper(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlTaper.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%BlTaper,2), UBOUND(OutData%BlTaper,2) - DO i1 = LBOUND(OutData%BlTaper,1), UBOUND(OutData%BlTaper,1) - OutData%BlTaper(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlAxCent not allocated - Int_Xferred = Int_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%BlAxCent)) DEALLOCATE(OutData%BlAxCent) - ALLOCATE(OutData%BlAxCent(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlAxCent.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%BlAxCent,2), UBOUND(OutData%BlAxCent,2) - DO i1 = LBOUND(OutData%BlAxCent,1), UBOUND(OutData%BlAxCent,1) - OutData%BlAxCent(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrRad not allocated - Int_Xferred = Int_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%TwrRad)) DEALLOCATE(OutData%TwrRad) - ALLOCATE(OutData%TwrRad(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrRad.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TwrRad,1), UBOUND(OutData%TwrRad,1) - OutData%TwrRad(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrDL not allocated - Int_Xferred = Int_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%TwrDL)) DEALLOCATE(OutData%TwrDL) - ALLOCATE(OutData%TwrDL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrDL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TwrDL,1), UBOUND(OutData%TwrDL,1) - OutData%TwrDL(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrTaper not allocated - Int_Xferred = Int_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%TwrTaper)) DEALLOCATE(OutData%TwrTaper) - ALLOCATE(OutData%TwrTaper(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrTaper.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TwrTaper,1), UBOUND(OutData%TwrTaper,1) - OutData%TwrTaper(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrAxCent not allocated - Int_Xferred = Int_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%TwrAxCent)) DEALLOCATE(OutData%TwrAxCent) - ALLOCATE(OutData%TwrAxCent(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrAxCent.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TwrAxCent,1), UBOUND(OutData%TwrAxCent,1) - OutData%TwrAxCent(i1) = ReKiBuf(Re_Xferred) - 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 BEMT_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%BEMT, ErrStat2, ErrMsg2 ) ! BEMT - 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 AA_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%AA, ErrStat2, ErrMsg2 ) ! AA - 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 ! 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) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! dx not allocated - Int_Xferred = Int_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%dx)) DEALLOCATE(OutData%dx) - ALLOCATE(OutData%dx(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%dx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%dx,1), UBOUND(OutData%dx,1) - OutData%dx(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%Jac_ny = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumBl_Lin = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TwrPotent = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TwrShadow = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TwrAero = TRANSFER(IntKiBuf(Int_Xferred), OutData%TwrAero) - Int_Xferred = Int_Xferred + 1 - OutData%FrozenWake = TRANSFER(IntKiBuf(Int_Xferred), OutData%FrozenWake) - Int_Xferred = Int_Xferred + 1 - OutData%CavitCheck = TRANSFER(IntKiBuf(Int_Xferred), OutData%CavitCheck) - Int_Xferred = Int_Xferred + 1 - OutData%Buoyancy = TRANSFER(IntKiBuf(Int_Xferred), OutData%Buoyancy) - Int_Xferred = Int_Xferred + 1 - OutData%MHK = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%CompAA = TRANSFER(IntKiBuf(Int_Xferred), OutData%CompAA) - Int_Xferred = Int_Xferred + 1 - OutData%AirDens = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%KinVisc = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SpdSound = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Gravity = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Patm = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Pvap = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%WtrDpth = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MSL2SWL = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%AeroProjMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%AeroBEM_Mod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumOuts = 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 - OutData%NBlOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%BlOutNd,1) - i1_u = UBOUND(OutData%BlOutNd,1) - DO i1 = LBOUND(OutData%BlOutNd,1), UBOUND(OutData%BlOutNd,1) - OutData%BlOutNd(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - OutData%NTwOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%TwOutNd,1) - i1_u = UBOUND(OutData%TwOutNd,1) - DO i1 = LBOUND(OutData%TwOutNd,1), UBOUND(OutData%TwOutNd,1) - OutData%TwOutNd(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - OutData%BldNd_NumOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%BldNd_TotNumOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldNd_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%BldNd_OutParam)) DEALLOCATE(OutData%BldNd_OutParam) - ALLOCATE(OutData%BldNd_OutParam(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldNd_OutParam.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BldNd_OutParam,1), UBOUND(OutData%BldNd_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%BldNd_OutParam(i1), ErrStat2, ErrMsg2 ) ! BldNd_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 ! BldNd_BlOutNd not allocated - Int_Xferred = Int_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%BldNd_BlOutNd)) DEALLOCATE(OutData%BldNd_BlOutNd) - ALLOCATE(OutData%BldNd_BlOutNd(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldNd_BlOutNd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BldNd_BlOutNd,1), UBOUND(OutData%BldNd_BlOutNd,1) - OutData%BldNd_BlOutNd(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - OutData%BldNd_BladesOut = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TFinAero = TRANSFER(IntKiBuf(Int_Xferred), OutData%TFinAero) - 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 AD_Unpacktfinparametertype( Re_Buf, Db_Buf, Int_Buf, OutData%TFin, ErrStat2, ErrMsg2 ) ! TFin - 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 AD_UnPackRotParameterType - - SUBROUTINE AD_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AD_ParameterType), INTENT(IN) :: SrcParamData - TYPE(AD_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 = 'AD_CopyParam' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcParamData%rotors)) THEN - i1_l = LBOUND(SrcParamData%rotors,1) - i1_u = UBOUND(SrcParamData%rotors,1) - IF (.NOT. ALLOCATED(DstParamData%rotors)) THEN - ALLOCATE(DstParamData%rotors(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rotors.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcParamData%rotors,1), UBOUND(SrcParamData%rotors,1) - CALL AD_Copyrotparametertype( SrcParamData%rotors(i1), DstParamData%rotors(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - DstParamData%DT = SrcParamData%DT - DstParamData%RootName = SrcParamData%RootName -IF (ALLOCATED(SrcParamData%AFI)) THEN - i1_l = LBOUND(SrcParamData%AFI,1) - i1_u = UBOUND(SrcParamData%AFI,1) - IF (.NOT. ALLOCATED(DstParamData%AFI)) THEN - ALLOCATE(DstParamData%AFI(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AFI.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcParamData%AFI,1), UBOUND(SrcParamData%AFI,1) - CALL AFI_CopyParam( SrcParamData%AFI(i1), DstParamData%AFI(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - DstParamData%SkewMod = SrcParamData%SkewMod - DstParamData%WakeMod = SrcParamData%WakeMod - CALL FVW_CopyParam( SrcParamData%FVW, DstParamData%FVW, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstParamData%CompAeroMaps = SrcParamData%CompAeroMaps - DstParamData%UA_Flag = SrcParamData%UA_Flag - END SUBROUTINE AD_CopyParam - - SUBROUTINE AD_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(AD_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(ParamData%rotors)) THEN -DO i1 = LBOUND(ParamData%rotors,1), UBOUND(ParamData%rotors,1) - CALL AD_Destroyrotparametertype( ParamData%rotors(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ParamData%rotors) -ENDIF -IF (ALLOCATED(ParamData%AFI)) THEN -DO i1 = LBOUND(ParamData%AFI,1), UBOUND(ParamData%AFI,1) - CALL AFI_DestroyParam( ParamData%AFI(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ParamData%AFI) -ENDIF - CALL FVW_DestroyParam( ParamData%FVW, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE AD_DestroyParam - - SUBROUTINE AD_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(AD_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 = 'AD_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 ! rotors allocated yes/no - IF ( ALLOCATED(InData%rotors) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! rotors upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%rotors,1), UBOUND(InData%rotors,1) - Int_BufSz = Int_BufSz + 3 ! rotors: size of buffers for each call to pack subtype - CALL AD_Packrotparametertype( Re_Buf, Db_Buf, Int_Buf, InData%rotors(i1), ErrStat2, ErrMsg2, .TRUE. ) ! rotors - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! rotors - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! rotors - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! rotors - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Db_BufSz = Db_BufSz + 1 ! DT - Int_BufSz = Int_BufSz + 1*LEN(InData%RootName) ! RootName - Int_BufSz = Int_BufSz + 1 ! AFI allocated yes/no - IF ( ALLOCATED(InData%AFI) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! AFI upper/lower bounds for each dimension - DO i1 = LBOUND(InData%AFI,1), UBOUND(InData%AFI,1) - Int_BufSz = Int_BufSz + 3 ! AFI: size of buffers for each call to pack subtype - CALL AFI_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%AFI(i1), ErrStat2, ErrMsg2, .TRUE. ) ! AFI - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! AFI - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! AFI - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! AFI - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! SkewMod - Int_BufSz = Int_BufSz + 1 ! WakeMod - Int_BufSz = Int_BufSz + 3 ! FVW: size of buffers for each call to pack subtype - CALL FVW_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%FVW, ErrStat2, ErrMsg2, .TRUE. ) ! FVW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! FVW - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! FVW - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! FVW - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! CompAeroMaps - Int_BufSz = Int_BufSz + 1 ! UA_Flag - 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%rotors) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rotors,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rotors,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%rotors,1), UBOUND(InData%rotors,1) - CALL AD_Packrotparametertype( Re_Buf, Db_Buf, Int_Buf, InData%rotors(i1), ErrStat2, ErrMsg2, OnlySize ) ! rotors - 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 - 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 - IF ( .NOT. ALLOCATED(InData%AFI) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AFI,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AFI,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%AFI,1), UBOUND(InData%AFI,1) - CALL AFI_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%AFI(i1), ErrStat2, ErrMsg2, OnlySize ) ! AFI - 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%SkewMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%WakeMod - Int_Xferred = Int_Xferred + 1 - CALL FVW_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%FVW, ErrStat2, ErrMsg2, OnlySize ) ! FVW - 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%CompAeroMaps, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%UA_Flag, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE AD_PackParam - - SUBROUTINE AD_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(AD_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 = 'AD_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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rotors not allocated - Int_Xferred = Int_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%rotors)) DEALLOCATE(OutData%rotors) - ALLOCATE(OutData%rotors(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotors.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%rotors,1), UBOUND(OutData%rotors,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 AD_Unpackrotparametertype( Re_Buf, Db_Buf, Int_Buf, OutData%rotors(i1), ErrStat2, ErrMsg2 ) ! rotors - 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%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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AFI not allocated - Int_Xferred = Int_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%AFI)) DEALLOCATE(OutData%AFI) - ALLOCATE(OutData%AFI(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AFI.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%AFI,1), UBOUND(OutData%AFI,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 AFI_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%AFI(i1), ErrStat2, ErrMsg2 ) ! AFI - 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%SkewMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WakeMod = IntKiBuf(Int_Xferred) - 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 FVW_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%FVW, ErrStat2, ErrMsg2 ) ! FVW - 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%CompAeroMaps = TRANSFER(IntKiBuf(Int_Xferred), OutData%CompAeroMaps) - Int_Xferred = Int_Xferred + 1 - OutData%UA_Flag = TRANSFER(IntKiBuf(Int_Xferred), OutData%UA_Flag) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE AD_UnPackParam - - SUBROUTINE AD_CopyRotInputType( SrcRotInputTypeData, DstRotInputTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(RotInputType), INTENT(INOUT) :: SrcRotInputTypeData - TYPE(RotInputType), INTENT(INOUT) :: DstRotInputTypeData - 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 = 'AD_CopyRotInputType' -! - ErrStat = ErrID_None - ErrMsg = "" - CALL MeshCopy( SrcRotInputTypeData%NacelleMotion, DstRotInputTypeData%NacelleMotion, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcRotInputTypeData%TowerMotion, DstRotInputTypeData%TowerMotion, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcRotInputTypeData%HubMotion, DstRotInputTypeData%HubMotion, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcRotInputTypeData%BladeRootMotion)) THEN - i1_l = LBOUND(SrcRotInputTypeData%BladeRootMotion,1) - i1_u = UBOUND(SrcRotInputTypeData%BladeRootMotion,1) - IF (.NOT. ALLOCATED(DstRotInputTypeData%BladeRootMotion)) THEN - ALLOCATE(DstRotInputTypeData%BladeRootMotion(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotInputTypeData%BladeRootMotion.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcRotInputTypeData%BladeRootMotion,1), UBOUND(SrcRotInputTypeData%BladeRootMotion,1) - CALL MeshCopy( SrcRotInputTypeData%BladeRootMotion(i1), DstRotInputTypeData%BladeRootMotion(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcRotInputTypeData%BladeMotion)) THEN - i1_l = LBOUND(SrcRotInputTypeData%BladeMotion,1) - i1_u = UBOUND(SrcRotInputTypeData%BladeMotion,1) - IF (.NOT. ALLOCATED(DstRotInputTypeData%BladeMotion)) THEN - ALLOCATE(DstRotInputTypeData%BladeMotion(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotInputTypeData%BladeMotion.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcRotInputTypeData%BladeMotion,1), UBOUND(SrcRotInputTypeData%BladeMotion,1) - CALL MeshCopy( SrcRotInputTypeData%BladeMotion(i1), DstRotInputTypeData%BladeMotion(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL MeshCopy( SrcRotInputTypeData%TFinMotion, DstRotInputTypeData%TFinMotion, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcRotInputTypeData%InflowOnBlade)) THEN - i1_l = LBOUND(SrcRotInputTypeData%InflowOnBlade,1) - i1_u = UBOUND(SrcRotInputTypeData%InflowOnBlade,1) - i2_l = LBOUND(SrcRotInputTypeData%InflowOnBlade,2) - i2_u = UBOUND(SrcRotInputTypeData%InflowOnBlade,2) - i3_l = LBOUND(SrcRotInputTypeData%InflowOnBlade,3) - i3_u = UBOUND(SrcRotInputTypeData%InflowOnBlade,3) - IF (.NOT. ALLOCATED(DstRotInputTypeData%InflowOnBlade)) THEN - ALLOCATE(DstRotInputTypeData%InflowOnBlade(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotInputTypeData%InflowOnBlade.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotInputTypeData%InflowOnBlade = SrcRotInputTypeData%InflowOnBlade -ENDIF -IF (ALLOCATED(SrcRotInputTypeData%InflowOnTower)) THEN - i1_l = LBOUND(SrcRotInputTypeData%InflowOnTower,1) - i1_u = UBOUND(SrcRotInputTypeData%InflowOnTower,1) - i2_l = LBOUND(SrcRotInputTypeData%InflowOnTower,2) - i2_u = UBOUND(SrcRotInputTypeData%InflowOnTower,2) - IF (.NOT. ALLOCATED(DstRotInputTypeData%InflowOnTower)) THEN - ALLOCATE(DstRotInputTypeData%InflowOnTower(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotInputTypeData%InflowOnTower.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotInputTypeData%InflowOnTower = SrcRotInputTypeData%InflowOnTower -ENDIF - DstRotInputTypeData%InflowOnHub = SrcRotInputTypeData%InflowOnHub - DstRotInputTypeData%InflowOnNacelle = SrcRotInputTypeData%InflowOnNacelle - DstRotInputTypeData%InflowOnTailFin = SrcRotInputTypeData%InflowOnTailFin -IF (ALLOCATED(SrcRotInputTypeData%UserProp)) THEN - i1_l = LBOUND(SrcRotInputTypeData%UserProp,1) - i1_u = UBOUND(SrcRotInputTypeData%UserProp,1) - i2_l = LBOUND(SrcRotInputTypeData%UserProp,2) - i2_u = UBOUND(SrcRotInputTypeData%UserProp,2) - IF (.NOT. ALLOCATED(DstRotInputTypeData%UserProp)) THEN - ALLOCATE(DstRotInputTypeData%UserProp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotInputTypeData%UserProp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotInputTypeData%UserProp = SrcRotInputTypeData%UserProp -ENDIF - END SUBROUTINE AD_CopyRotInputType - - SUBROUTINE AD_DestroyRotInputType( RotInputTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(RotInputType), INTENT(INOUT) :: RotInputTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_DestroyRotInputType' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL MeshDestroy( RotInputTypeData%NacelleMotion, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( RotInputTypeData%TowerMotion, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( RotInputTypeData%HubMotion, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(RotInputTypeData%BladeRootMotion)) THEN -DO i1 = LBOUND(RotInputTypeData%BladeRootMotion,1), UBOUND(RotInputTypeData%BladeRootMotion,1) - CALL MeshDestroy( RotInputTypeData%BladeRootMotion(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(RotInputTypeData%BladeRootMotion) -ENDIF -IF (ALLOCATED(RotInputTypeData%BladeMotion)) THEN -DO i1 = LBOUND(RotInputTypeData%BladeMotion,1), UBOUND(RotInputTypeData%BladeMotion,1) - CALL MeshDestroy( RotInputTypeData%BladeMotion(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(RotInputTypeData%BladeMotion) -ENDIF - CALL MeshDestroy( RotInputTypeData%TFinMotion, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(RotInputTypeData%InflowOnBlade)) THEN - DEALLOCATE(RotInputTypeData%InflowOnBlade) -ENDIF -IF (ALLOCATED(RotInputTypeData%InflowOnTower)) THEN - DEALLOCATE(RotInputTypeData%InflowOnTower) -ENDIF -IF (ALLOCATED(RotInputTypeData%UserProp)) THEN - DEALLOCATE(RotInputTypeData%UserProp) -ENDIF - END SUBROUTINE AD_DestroyRotInputType - - SUBROUTINE AD_PackRotInputType( 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(RotInputType), 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 = 'AD_PackRotInputType' - ! 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 ! NacelleMotion: size of buffers for each call to pack subtype - CALL MeshPack( InData%NacelleMotion, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! NacelleMotion - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! NacelleMotion - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! NacelleMotion - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! NacelleMotion - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! TowerMotion: size of buffers for each call to pack subtype - CALL MeshPack( InData%TowerMotion, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! TowerMotion - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! TowerMotion - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! TowerMotion - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! TowerMotion - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! HubMotion: size of buffers for each call to pack subtype - CALL MeshPack( InData%HubMotion, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! HubMotion - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! HubMotion - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! HubMotion - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! HubMotion - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! BladeRootMotion allocated yes/no - IF ( ALLOCATED(InData%BladeRootMotion) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BladeRootMotion upper/lower bounds for each dimension - DO i1 = LBOUND(InData%BladeRootMotion,1), UBOUND(InData%BladeRootMotion,1) - Int_BufSz = Int_BufSz + 3 ! BladeRootMotion: size of buffers for each call to pack subtype - CALL MeshPack( InData%BladeRootMotion(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! BladeRootMotion - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BladeRootMotion - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BladeRootMotion - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BladeRootMotion - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! BladeMotion allocated yes/no - IF ( ALLOCATED(InData%BladeMotion) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BladeMotion upper/lower bounds for each dimension - DO i1 = LBOUND(InData%BladeMotion,1), UBOUND(InData%BladeMotion,1) - Int_BufSz = Int_BufSz + 3 ! BladeMotion: size of buffers for each call to pack subtype - CALL MeshPack( InData%BladeMotion(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! BladeMotion - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BladeMotion - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BladeMotion - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BladeMotion - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! TFinMotion: size of buffers for each call to pack subtype - CALL MeshPack( InData%TFinMotion, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! TFinMotion - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! TFinMotion - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! TFinMotion - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! TFinMotion - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! InflowOnBlade allocated yes/no - IF ( ALLOCATED(InData%InflowOnBlade) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! InflowOnBlade upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%InflowOnBlade) ! InflowOnBlade - END IF - Int_BufSz = Int_BufSz + 1 ! InflowOnTower allocated yes/no - IF ( ALLOCATED(InData%InflowOnTower) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! InflowOnTower upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%InflowOnTower) ! InflowOnTower - END IF - Re_BufSz = Re_BufSz + SIZE(InData%InflowOnHub) ! InflowOnHub - Re_BufSz = Re_BufSz + SIZE(InData%InflowOnNacelle) ! InflowOnNacelle - Re_BufSz = Re_BufSz + SIZE(InData%InflowOnTailFin) ! InflowOnTailFin - Int_BufSz = Int_BufSz + 1 ! UserProp allocated yes/no - IF ( ALLOCATED(InData%UserProp) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! UserProp upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%UserProp) ! UserProp - 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%NacelleMotion, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! NacelleMotion - 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%TowerMotion, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! TowerMotion - 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%HubMotion, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! HubMotion - 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%BladeRootMotion) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BladeRootMotion,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BladeRootMotion,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BladeRootMotion,1), UBOUND(InData%BladeRootMotion,1) - CALL MeshPack( InData%BladeRootMotion(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! BladeRootMotion - 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%BladeMotion) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BladeMotion,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BladeMotion,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BladeMotion,1), UBOUND(InData%BladeMotion,1) - CALL MeshPack( InData%BladeMotion(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! BladeMotion - 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 - CALL MeshPack( InData%TFinMotion, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! TFinMotion - 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%InflowOnBlade) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InflowOnBlade,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InflowOnBlade,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InflowOnBlade,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InflowOnBlade,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InflowOnBlade,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InflowOnBlade,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%InflowOnBlade,3), UBOUND(InData%InflowOnBlade,3) - DO i2 = LBOUND(InData%InflowOnBlade,2), UBOUND(InData%InflowOnBlade,2) - DO i1 = LBOUND(InData%InflowOnBlade,1), UBOUND(InData%InflowOnBlade,1) - ReKiBuf(Re_Xferred) = InData%InflowOnBlade(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%InflowOnTower) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InflowOnTower,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InflowOnTower,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InflowOnTower,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InflowOnTower,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%InflowOnTower,2), UBOUND(InData%InflowOnTower,2) - DO i1 = LBOUND(InData%InflowOnTower,1), UBOUND(InData%InflowOnTower,1) - ReKiBuf(Re_Xferred) = InData%InflowOnTower(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - DO i1 = LBOUND(InData%InflowOnHub,1), UBOUND(InData%InflowOnHub,1) - ReKiBuf(Re_Xferred) = InData%InflowOnHub(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%InflowOnNacelle,1), UBOUND(InData%InflowOnNacelle,1) - ReKiBuf(Re_Xferred) = InData%InflowOnNacelle(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%InflowOnTailFin,1), UBOUND(InData%InflowOnTailFin,1) - ReKiBuf(Re_Xferred) = InData%InflowOnTailFin(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%UserProp) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%UserProp,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UserProp,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%UserProp,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UserProp,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%UserProp,2), UBOUND(InData%UserProp,2) - DO i1 = LBOUND(InData%UserProp,1), UBOUND(InData%UserProp,1) - ReKiBuf(Re_Xferred) = InData%UserProp(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE AD_PackRotInputType - - SUBROUTINE AD_UnPackRotInputType( 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(RotInputType), 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 = 'AD_UnPackRotInputType' - ! 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%NacelleMotion, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! NacelleMotion - 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%TowerMotion, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! TowerMotion - 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%HubMotion, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! HubMotion - 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 ! BladeRootMotion not allocated - Int_Xferred = Int_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%BladeRootMotion)) DEALLOCATE(OutData%BladeRootMotion) - ALLOCATE(OutData%BladeRootMotion(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeRootMotion.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BladeRootMotion,1), UBOUND(OutData%BladeRootMotion,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%BladeRootMotion(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! BladeRootMotion - 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 ! BladeMotion not allocated - Int_Xferred = Int_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%BladeMotion)) DEALLOCATE(OutData%BladeMotion) - ALLOCATE(OutData%BladeMotion(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeMotion.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BladeMotion,1), UBOUND(OutData%BladeMotion,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%BladeMotion(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! BladeMotion - 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 - 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%TFinMotion, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! TFinMotion - 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 ! InflowOnBlade not allocated - Int_Xferred = Int_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%InflowOnBlade)) DEALLOCATE(OutData%InflowOnBlade) - ALLOCATE(OutData%InflowOnBlade(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%InflowOnBlade.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%InflowOnBlade,3), UBOUND(OutData%InflowOnBlade,3) - DO i2 = LBOUND(OutData%InflowOnBlade,2), UBOUND(OutData%InflowOnBlade,2) - DO i1 = LBOUND(OutData%InflowOnBlade,1), UBOUND(OutData%InflowOnBlade,1) - OutData%InflowOnBlade(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 ! InflowOnTower not allocated - Int_Xferred = Int_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%InflowOnTower)) DEALLOCATE(OutData%InflowOnTower) - ALLOCATE(OutData%InflowOnTower(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InflowOnTower.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%InflowOnTower,2), UBOUND(OutData%InflowOnTower,2) - DO i1 = LBOUND(OutData%InflowOnTower,1), UBOUND(OutData%InflowOnTower,1) - OutData%InflowOnTower(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - i1_l = LBOUND(OutData%InflowOnHub,1) - i1_u = UBOUND(OutData%InflowOnHub,1) - DO i1 = LBOUND(OutData%InflowOnHub,1), UBOUND(OutData%InflowOnHub,1) - OutData%InflowOnHub(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%InflowOnNacelle,1) - i1_u = UBOUND(OutData%InflowOnNacelle,1) - DO i1 = LBOUND(OutData%InflowOnNacelle,1), UBOUND(OutData%InflowOnNacelle,1) - OutData%InflowOnNacelle(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%InflowOnTailFin,1) - i1_u = UBOUND(OutData%InflowOnTailFin,1) - DO i1 = LBOUND(OutData%InflowOnTailFin,1), UBOUND(OutData%InflowOnTailFin,1) - OutData%InflowOnTailFin(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! UserProp not allocated - Int_Xferred = Int_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%UserProp)) DEALLOCATE(OutData%UserProp) - ALLOCATE(OutData%UserProp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%UserProp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%UserProp,2), UBOUND(OutData%UserProp,2) - DO i1 = LBOUND(OutData%UserProp,1), UBOUND(OutData%UserProp,1) - OutData%UserProp(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE AD_UnPackRotInputType - - SUBROUTINE AD_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AD_InputType), INTENT(INOUT) :: SrcInputData - TYPE(AD_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 = 'AD_CopyInput' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcInputData%rotors)) THEN - i1_l = LBOUND(SrcInputData%rotors,1) - i1_u = UBOUND(SrcInputData%rotors,1) - IF (.NOT. ALLOCATED(DstInputData%rotors)) THEN - ALLOCATE(DstInputData%rotors(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%rotors.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcInputData%rotors,1), UBOUND(SrcInputData%rotors,1) - CALL AD_Copyrotinputtype( SrcInputData%rotors(i1), DstInputData%rotors(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcInputData%InflowWakeVel)) THEN - i1_l = LBOUND(SrcInputData%InflowWakeVel,1) - i1_u = UBOUND(SrcInputData%InflowWakeVel,1) - i2_l = LBOUND(SrcInputData%InflowWakeVel,2) - i2_u = UBOUND(SrcInputData%InflowWakeVel,2) - IF (.NOT. ALLOCATED(DstInputData%InflowWakeVel)) THEN - ALLOCATE(DstInputData%InflowWakeVel(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%InflowWakeVel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%InflowWakeVel = SrcInputData%InflowWakeVel -ENDIF - END SUBROUTINE AD_CopyInput - - SUBROUTINE AD_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(AD_InputType), INTENT(INOUT) :: InputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_DestroyInput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(InputData%rotors)) THEN -DO i1 = LBOUND(InputData%rotors,1), UBOUND(InputData%rotors,1) - CALL AD_Destroyrotinputtype( InputData%rotors(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(InputData%rotors) -ENDIF -IF (ALLOCATED(InputData%InflowWakeVel)) THEN - DEALLOCATE(InputData%InflowWakeVel) -ENDIF - END SUBROUTINE AD_DestroyInput - - SUBROUTINE AD_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(AD_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 = 'AD_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 ! rotors allocated yes/no - IF ( ALLOCATED(InData%rotors) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! rotors upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%rotors,1), UBOUND(InData%rotors,1) - Int_BufSz = Int_BufSz + 3 ! rotors: size of buffers for each call to pack subtype - CALL AD_Packrotinputtype( Re_Buf, Db_Buf, Int_Buf, InData%rotors(i1), ErrStat2, ErrMsg2, .TRUE. ) ! rotors - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! rotors - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! rotors - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! rotors - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! InflowWakeVel allocated yes/no - IF ( ALLOCATED(InData%InflowWakeVel) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! InflowWakeVel upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%InflowWakeVel) ! InflowWakeVel - 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%rotors) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rotors,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rotors,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%rotors,1), UBOUND(InData%rotors,1) - CALL AD_Packrotinputtype( Re_Buf, Db_Buf, Int_Buf, InData%rotors(i1), ErrStat2, ErrMsg2, OnlySize ) ! rotors - 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%InflowWakeVel) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InflowWakeVel,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InflowWakeVel,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InflowWakeVel,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InflowWakeVel,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%InflowWakeVel,2), UBOUND(InData%InflowWakeVel,2) - DO i1 = LBOUND(InData%InflowWakeVel,1), UBOUND(InData%InflowWakeVel,1) - ReKiBuf(Re_Xferred) = InData%InflowWakeVel(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE AD_PackInput - - SUBROUTINE AD_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(AD_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 = 'AD_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 ! rotors not allocated - Int_Xferred = Int_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%rotors)) DEALLOCATE(OutData%rotors) - ALLOCATE(OutData%rotors(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotors.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%rotors,1), UBOUND(OutData%rotors,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 AD_Unpackrotinputtype( Re_Buf, Db_Buf, Int_Buf, OutData%rotors(i1), ErrStat2, ErrMsg2 ) ! rotors - 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 ! InflowWakeVel not allocated - Int_Xferred = Int_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%InflowWakeVel)) DEALLOCATE(OutData%InflowWakeVel) - ALLOCATE(OutData%InflowWakeVel(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InflowWakeVel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%InflowWakeVel,2), UBOUND(OutData%InflowWakeVel,2) - DO i1 = LBOUND(OutData%InflowWakeVel,1), UBOUND(OutData%InflowWakeVel,1) - OutData%InflowWakeVel(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE AD_UnPackInput - - SUBROUTINE AD_CopyRotOutputType( SrcRotOutputTypeData, DstRotOutputTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(RotOutputType), INTENT(INOUT) :: SrcRotOutputTypeData - TYPE(RotOutputType), INTENT(INOUT) :: DstRotOutputTypeData - 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 = 'AD_CopyRotOutputType' -! - ErrStat = ErrID_None - ErrMsg = "" - CALL MeshCopy( SrcRotOutputTypeData%NacelleLoad, DstRotOutputTypeData%NacelleLoad, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcRotOutputTypeData%HubLoad, DstRotOutputTypeData%HubLoad, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcRotOutputTypeData%TowerLoad, DstRotOutputTypeData%TowerLoad, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcRotOutputTypeData%BladeLoad)) THEN - i1_l = LBOUND(SrcRotOutputTypeData%BladeLoad,1) - i1_u = UBOUND(SrcRotOutputTypeData%BladeLoad,1) - IF (.NOT. ALLOCATED(DstRotOutputTypeData%BladeLoad)) THEN - ALLOCATE(DstRotOutputTypeData%BladeLoad(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotOutputTypeData%BladeLoad.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcRotOutputTypeData%BladeLoad,1), UBOUND(SrcRotOutputTypeData%BladeLoad,1) - CALL MeshCopy( SrcRotOutputTypeData%BladeLoad(i1), DstRotOutputTypeData%BladeLoad(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL MeshCopy( SrcRotOutputTypeData%TFinLoad, DstRotOutputTypeData%TFinLoad, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcRotOutputTypeData%WriteOutput)) THEN - i1_l = LBOUND(SrcRotOutputTypeData%WriteOutput,1) - i1_u = UBOUND(SrcRotOutputTypeData%WriteOutput,1) - IF (.NOT. ALLOCATED(DstRotOutputTypeData%WriteOutput)) THEN - ALLOCATE(DstRotOutputTypeData%WriteOutput(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotOutputTypeData%WriteOutput.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotOutputTypeData%WriteOutput = SrcRotOutputTypeData%WriteOutput -ENDIF - END SUBROUTINE AD_CopyRotOutputType - - SUBROUTINE AD_DestroyRotOutputType( RotOutputTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(RotOutputType), INTENT(INOUT) :: RotOutputTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_DestroyRotOutputType' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL MeshDestroy( RotOutputTypeData%NacelleLoad, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( RotOutputTypeData%HubLoad, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( RotOutputTypeData%TowerLoad, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(RotOutputTypeData%BladeLoad)) THEN -DO i1 = LBOUND(RotOutputTypeData%BladeLoad,1), UBOUND(RotOutputTypeData%BladeLoad,1) - CALL MeshDestroy( RotOutputTypeData%BladeLoad(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(RotOutputTypeData%BladeLoad) -ENDIF - CALL MeshDestroy( RotOutputTypeData%TFinLoad, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(RotOutputTypeData%WriteOutput)) THEN - DEALLOCATE(RotOutputTypeData%WriteOutput) -ENDIF - END SUBROUTINE AD_DestroyRotOutputType - - SUBROUTINE AD_PackRotOutputType( 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(RotOutputType), 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 = 'AD_PackRotOutputType' - ! 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 ! NacelleLoad: size of buffers for each call to pack subtype - CALL MeshPack( InData%NacelleLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! NacelleLoad - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! NacelleLoad - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! NacelleLoad - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! NacelleLoad - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! HubLoad: size of buffers for each call to pack subtype - CALL MeshPack( InData%HubLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! HubLoad - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! HubLoad - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! HubLoad - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! HubLoad - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! TowerLoad: size of buffers for each call to pack subtype - CALL MeshPack( InData%TowerLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! TowerLoad - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! TowerLoad - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! TowerLoad - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! TowerLoad - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! BladeLoad allocated yes/no - IF ( ALLOCATED(InData%BladeLoad) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BladeLoad upper/lower bounds for each dimension - DO i1 = LBOUND(InData%BladeLoad,1), UBOUND(InData%BladeLoad,1) - Int_BufSz = Int_BufSz + 3 ! BladeLoad: size of buffers for each call to pack subtype - CALL MeshPack( InData%BladeLoad(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! BladeLoad - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BladeLoad - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BladeLoad - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BladeLoad - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! TFinLoad: size of buffers for each call to pack subtype - CALL MeshPack( InData%TFinLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! TFinLoad - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! TFinLoad - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! TFinLoad - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! TFinLoad - 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%NacelleLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! NacelleLoad - 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%HubLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! HubLoad - 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%TowerLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! TowerLoad - 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%BladeLoad) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BladeLoad,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BladeLoad,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BladeLoad,1), UBOUND(InData%BladeLoad,1) - CALL MeshPack( InData%BladeLoad(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! BladeLoad - 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 - CALL MeshPack( InData%TFinLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! TFinLoad - 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 AD_PackRotOutputType - - SUBROUTINE AD_UnPackRotOutputType( 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(RotOutputType), 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 = 'AD_UnPackRotOutputType' - ! 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%NacelleLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! NacelleLoad - 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%HubLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! HubLoad - 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%TowerLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! TowerLoad - 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 ! BladeLoad not allocated - Int_Xferred = Int_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%BladeLoad)) DEALLOCATE(OutData%BladeLoad) - ALLOCATE(OutData%BladeLoad(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeLoad.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BladeLoad,1), UBOUND(OutData%BladeLoad,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%BladeLoad(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! BladeLoad - 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 - 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%TFinLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! TFinLoad - 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 AD_UnPackRotOutputType - - SUBROUTINE AD_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AD_OutputType), INTENT(INOUT) :: SrcOutputData - TYPE(AD_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 = 'AD_CopyOutput' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcOutputData%rotors)) THEN - i1_l = LBOUND(SrcOutputData%rotors,1) - i1_u = UBOUND(SrcOutputData%rotors,1) - IF (.NOT. ALLOCATED(DstOutputData%rotors)) THEN - ALLOCATE(DstOutputData%rotors(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%rotors.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcOutputData%rotors,1), UBOUND(SrcOutputData%rotors,1) - CALL AD_Copyrotoutputtype( SrcOutputData%rotors(i1), DstOutputData%rotors(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - END SUBROUTINE AD_CopyOutput - - SUBROUTINE AD_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(AD_OutputType), INTENT(INOUT) :: OutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_DestroyOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(OutputData%rotors)) THEN -DO i1 = LBOUND(OutputData%rotors,1), UBOUND(OutputData%rotors,1) - CALL AD_Destroyrotoutputtype( OutputData%rotors(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(OutputData%rotors) -ENDIF - END SUBROUTINE AD_DestroyOutput - - SUBROUTINE AD_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(AD_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 = 'AD_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 ! rotors allocated yes/no - IF ( ALLOCATED(InData%rotors) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! rotors upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%rotors,1), UBOUND(InData%rotors,1) - Int_BufSz = Int_BufSz + 3 ! rotors: size of buffers for each call to pack subtype - CALL AD_Packrotoutputtype( Re_Buf, Db_Buf, Int_Buf, InData%rotors(i1), ErrStat2, ErrMsg2, .TRUE. ) ! rotors - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! rotors - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! rotors - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! rotors - 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%rotors) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rotors,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rotors,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%rotors,1), UBOUND(InData%rotors,1) - CALL AD_Packrotoutputtype( Re_Buf, Db_Buf, Int_Buf, InData%rotors(i1), ErrStat2, ErrMsg2, OnlySize ) ! rotors - 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 AD_PackOutput - - SUBROUTINE AD_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(AD_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 = 'AD_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 ! rotors not allocated - Int_Xferred = Int_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%rotors)) DEALLOCATE(OutData%rotors) - ALLOCATE(OutData%rotors(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotors.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%rotors,1), UBOUND(OutData%rotors,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 AD_Unpackrotoutputtype( Re_Buf, Db_Buf, Int_Buf, OutData%rotors(i1), ErrStat2, ErrMsg2 ) ! rotors - 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 AD_UnPackOutput - - - SUBROUTINE AD_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(AD_InputType), INTENT(INOUT) :: u(:) ! Input at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Inputs - TYPE(AD_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 = 'AD_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 AD_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL AD_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 AD_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 AD_Input_ExtrapInterp - - - SUBROUTINE AD_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(AD_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 - TYPE(AD_InputType), INTENT(INOUT) :: u2 ! Input at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs - TYPE(AD_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 = 'AD_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 :: i02 ! dim2 level 0 counter variable for arrays of ddts - INTEGER :: i03 ! dim3 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - INTEGER :: i2 ! dim2 counter variable for arrays - INTEGER :: i3 ! dim3 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%rotors) .AND. ALLOCATED(u1%rotors)) THEN - DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) - CALL MeshExtrapInterp1(u1%rotors(i01)%NacelleMotion, u2%rotors(i01)%NacelleMotion, tin, u_out%rotors(i01)%NacelleMotion, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO - DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) - CALL MeshExtrapInterp1(u1%rotors(i01)%TowerMotion, u2%rotors(i01)%TowerMotion, tin, u_out%rotors(i01)%TowerMotion, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO - DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) - CALL MeshExtrapInterp1(u1%rotors(i01)%HubMotion, u2%rotors(i01)%HubMotion, tin, u_out%rotors(i01)%HubMotion, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO - DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) -IF (ALLOCATED(u_out%rotors(i01)%BladeRootMotion) .AND. ALLOCATED(u1%rotors(i01)%BladeRootMotion)) THEN - DO i1 = LBOUND(u_out%rotors(i01)%BladeRootMotion,1),UBOUND(u_out%rotors(i01)%BladeRootMotion,1) - CALL MeshExtrapInterp1(u1%rotors(i01)%BladeRootMotion(i1), u2%rotors(i01)%BladeRootMotion(i1), tin, u_out%rotors(i01)%BladeRootMotion(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated - ENDDO - DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) -IF (ALLOCATED(u_out%rotors(i01)%BladeMotion) .AND. ALLOCATED(u1%rotors(i01)%BladeMotion)) THEN - DO i1 = LBOUND(u_out%rotors(i01)%BladeMotion,1),UBOUND(u_out%rotors(i01)%BladeMotion,1) - CALL MeshExtrapInterp1(u1%rotors(i01)%BladeMotion(i1), u2%rotors(i01)%BladeMotion(i1), tin, u_out%rotors(i01)%BladeMotion(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated - ENDDO - DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) - CALL MeshExtrapInterp1(u1%rotors(i01)%TFinMotion, u2%rotors(i01)%TFinMotion, tin, u_out%rotors(i01)%TFinMotion, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO - DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) -IF (ALLOCATED(u_out%rotors(i01)%InflowOnBlade) .AND. ALLOCATED(u1%rotors(i01)%InflowOnBlade)) THEN - DO i3 = LBOUND(u_out%rotors(i01)%InflowOnBlade,3),UBOUND(u_out%rotors(i01)%InflowOnBlade,3) - DO i2 = LBOUND(u_out%rotors(i01)%InflowOnBlade,2),UBOUND(u_out%rotors(i01)%InflowOnBlade,2) - DO i1 = LBOUND(u_out%rotors(i01)%InflowOnBlade,1),UBOUND(u_out%rotors(i01)%InflowOnBlade,1) - b = -(u1%rotors(i01)%InflowOnBlade(i1,i2,i3) - u2%rotors(i01)%InflowOnBlade(i1,i2,i3)) - u_out%rotors(i01)%InflowOnBlade(i1,i2,i3) = u1%rotors(i01)%InflowOnBlade(i1,i2,i3) + b * ScaleFactor - END DO - END DO - END DO -END IF ! check if allocated - ENDDO - DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) -IF (ALLOCATED(u_out%rotors(i01)%InflowOnTower) .AND. ALLOCATED(u1%rotors(i01)%InflowOnTower)) THEN - DO i2 = LBOUND(u_out%rotors(i01)%InflowOnTower,2),UBOUND(u_out%rotors(i01)%InflowOnTower,2) - DO i1 = LBOUND(u_out%rotors(i01)%InflowOnTower,1),UBOUND(u_out%rotors(i01)%InflowOnTower,1) - b = -(u1%rotors(i01)%InflowOnTower(i1,i2) - u2%rotors(i01)%InflowOnTower(i1,i2)) - u_out%rotors(i01)%InflowOnTower(i1,i2) = u1%rotors(i01)%InflowOnTower(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated - ENDDO - DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) - DO i1 = LBOUND(u_out%rotors(i01)%InflowOnHub,1),UBOUND(u_out%rotors(i01)%InflowOnHub,1) - b = -(u1%rotors(i01)%InflowOnHub(i1) - u2%rotors(i01)%InflowOnHub(i1)) - u_out%rotors(i01)%InflowOnHub(i1) = u1%rotors(i01)%InflowOnHub(i1) + b * ScaleFactor - END DO - ENDDO - DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) - DO i1 = LBOUND(u_out%rotors(i01)%InflowOnNacelle,1),UBOUND(u_out%rotors(i01)%InflowOnNacelle,1) - b = -(u1%rotors(i01)%InflowOnNacelle(i1) - u2%rotors(i01)%InflowOnNacelle(i1)) - u_out%rotors(i01)%InflowOnNacelle(i1) = u1%rotors(i01)%InflowOnNacelle(i1) + b * ScaleFactor - END DO - ENDDO - DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) - DO i1 = LBOUND(u_out%rotors(i01)%InflowOnTailFin,1),UBOUND(u_out%rotors(i01)%InflowOnTailFin,1) - b = -(u1%rotors(i01)%InflowOnTailFin(i1) - u2%rotors(i01)%InflowOnTailFin(i1)) - u_out%rotors(i01)%InflowOnTailFin(i1) = u1%rotors(i01)%InflowOnTailFin(i1) + b * ScaleFactor - END DO - ENDDO - DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) -IF (ALLOCATED(u_out%rotors(i01)%UserProp) .AND. ALLOCATED(u1%rotors(i01)%UserProp)) THEN - DO i2 = LBOUND(u_out%rotors(i01)%UserProp,2),UBOUND(u_out%rotors(i01)%UserProp,2) - DO i1 = LBOUND(u_out%rotors(i01)%UserProp,1),UBOUND(u_out%rotors(i01)%UserProp,1) - b = -(u1%rotors(i01)%UserProp(i1,i2) - u2%rotors(i01)%UserProp(i1,i2)) - u_out%rotors(i01)%UserProp(i1,i2) = u1%rotors(i01)%UserProp(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated - ENDDO -END IF ! check if allocated -IF (ALLOCATED(u_out%InflowWakeVel) .AND. ALLOCATED(u1%InflowWakeVel)) THEN - DO i2 = LBOUND(u_out%InflowWakeVel,2),UBOUND(u_out%InflowWakeVel,2) - DO i1 = LBOUND(u_out%InflowWakeVel,1),UBOUND(u_out%InflowWakeVel,1) - b = -(u1%InflowWakeVel(i1,i2) - u2%InflowWakeVel(i1,i2)) - u_out%InflowWakeVel(i1,i2) = u1%InflowWakeVel(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated - END SUBROUTINE AD_Input_ExtrapInterp1 - - - SUBROUTINE AD_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) +SUBROUTINE AD_InflowType_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 +! This subroutine calculates a extrapolated (or interpolated) InflowType 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 @@ -18346,373 +6747,90 @@ SUBROUTINE AD_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrM ! !.................................................................................................................................. - TYPE(AD_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 > t3 - TYPE(AD_InputType), INTENT(INOUT) :: u2 ! Input at t2 > t3 - TYPE(AD_InputType), INTENT(INOUT) :: u3 ! Input at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs - TYPE(AD_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 + TYPE(AD_InflowType), INTENT(IN) :: u1 ! InflowType at t1 > t2 > t3 + TYPE(AD_InflowType), INTENT(IN) :: u2 ! InflowType at t2 > t3 + TYPE(AD_InflowType), INTENT(IN) :: u3 ! InflowType at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the InflowTypes + TYPE(AD_InflowType), INTENT(INOUT) :: u_out ! InflowType 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 = 'AD_Input_ExtrapInterp2' - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts - INTEGER :: i03 ! dim3 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - INTEGER :: i2 ! dim2 counter variable for arrays - INTEGER :: i3 ! dim3 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) - + REAL(DbKi) :: t(3) ! Times associated with the InflowTypes + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + INTEGER(IntKi) :: order ! order of polynomial fit (max 2) + REAL(DbKi) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'AD_InflowType_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i11 ! dim1 level 1 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i12 ! dim2 level 1 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 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 + 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 + 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 + 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%rotors) .AND. ALLOCATED(u1%rotors)) THEN - DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) - CALL MeshExtrapInterp2(u1%rotors(i01)%NacelleMotion, u2%rotors(i01)%NacelleMotion, u3%rotors(i01)%NacelleMotion, tin, u_out%rotors(i01)%NacelleMotion, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO - DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) - CALL MeshExtrapInterp2(u1%rotors(i01)%TowerMotion, u2%rotors(i01)%TowerMotion, u3%rotors(i01)%TowerMotion, tin, u_out%rotors(i01)%TowerMotion, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO - DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) - CALL MeshExtrapInterp2(u1%rotors(i01)%HubMotion, u2%rotors(i01)%HubMotion, u3%rotors(i01)%HubMotion, tin, u_out%rotors(i01)%HubMotion, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO - DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) -IF (ALLOCATED(u_out%rotors(i01)%BladeRootMotion) .AND. ALLOCATED(u1%rotors(i01)%BladeRootMotion)) THEN - DO i1 = LBOUND(u_out%rotors(i01)%BladeRootMotion,1),UBOUND(u_out%rotors(i01)%BladeRootMotion,1) - CALL MeshExtrapInterp2(u1%rotors(i01)%BladeRootMotion(i1), u2%rotors(i01)%BladeRootMotion(i1), u3%rotors(i01)%BladeRootMotion(i1), tin, u_out%rotors(i01)%BladeRootMotion(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated - ENDDO - DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) -IF (ALLOCATED(u_out%rotors(i01)%BladeMotion) .AND. ALLOCATED(u1%rotors(i01)%BladeMotion)) THEN - DO i1 = LBOUND(u_out%rotors(i01)%BladeMotion,1),UBOUND(u_out%rotors(i01)%BladeMotion,1) - CALL MeshExtrapInterp2(u1%rotors(i01)%BladeMotion(i1), u2%rotors(i01)%BladeMotion(i1), u3%rotors(i01)%BladeMotion(i1), tin, u_out%rotors(i01)%BladeMotion(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated - ENDDO - DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) - CALL MeshExtrapInterp2(u1%rotors(i01)%TFinMotion, u2%rotors(i01)%TFinMotion, u3%rotors(i01)%TFinMotion, tin, u_out%rotors(i01)%TFinMotion, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO - DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) -IF (ALLOCATED(u_out%rotors(i01)%InflowOnBlade) .AND. ALLOCATED(u1%rotors(i01)%InflowOnBlade)) THEN - DO i3 = LBOUND(u_out%rotors(i01)%InflowOnBlade,3),UBOUND(u_out%rotors(i01)%InflowOnBlade,3) - DO i2 = LBOUND(u_out%rotors(i01)%InflowOnBlade,2),UBOUND(u_out%rotors(i01)%InflowOnBlade,2) - DO i1 = LBOUND(u_out%rotors(i01)%InflowOnBlade,1),UBOUND(u_out%rotors(i01)%InflowOnBlade,1) - b = (t(3)**2*(u1%rotors(i01)%InflowOnBlade(i1,i2,i3) - u2%rotors(i01)%InflowOnBlade(i1,i2,i3)) + t(2)**2*(-u1%rotors(i01)%InflowOnBlade(i1,i2,i3) + u3%rotors(i01)%InflowOnBlade(i1,i2,i3)))* scaleFactor - c = ( (t(2)-t(3))*u1%rotors(i01)%InflowOnBlade(i1,i2,i3) + t(3)*u2%rotors(i01)%InflowOnBlade(i1,i2,i3) - t(2)*u3%rotors(i01)%InflowOnBlade(i1,i2,i3) ) * scaleFactor - u_out%rotors(i01)%InflowOnBlade(i1,i2,i3) = u1%rotors(i01)%InflowOnBlade(i1,i2,i3) + b + c * t_out + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + IF (ALLOCATED(u_out%InflowWakeVel) .AND. ALLOCATED(u1%InflowWakeVel)) THEN + u_out%InflowWakeVel = a1*u1%InflowWakeVel + a2*u2%InflowWakeVel + a3*u3%InflowWakeVel + END IF ! check if allocated + IF (ALLOCATED(u_out%RotInflow) .AND. ALLOCATED(u1%RotInflow)) THEN + do i01 = lbound(u_out%RotInflow,1),ubound(u_out%RotInflow,1) + IF (ALLOCATED(u_out%RotInflow(i01)%Blade) .AND. ALLOCATED(u1%RotInflow(i01)%Blade)) THEN + do i11 = lbound(u_out%RotInflow(i01)%Blade,1),ubound(u_out%RotInflow(i01)%Blade,1) + IF (ALLOCATED(u_out%RotInflow(i01)%Blade(i11)%InflowVel) .AND. ALLOCATED(u1%RotInflow(i01)%Blade(i11)%InflowVel)) THEN + u_out%RotInflow(i01)%Blade(i11)%InflowVel = a1*u1%RotInflow(i01)%Blade(i11)%InflowVel + a2*u2%RotInflow(i01)%Blade(i11)%InflowVel + a3*u3%RotInflow(i01)%Blade(i11)%InflowVel + END IF ! check if allocated + END DO + do i11 = lbound(u_out%RotInflow(i01)%Blade,1),ubound(u_out%RotInflow(i01)%Blade,1) + IF (ALLOCATED(u_out%RotInflow(i01)%Blade(i11)%InflowAcc) .AND. ALLOCATED(u1%RotInflow(i01)%Blade(i11)%InflowAcc)) THEN + u_out%RotInflow(i01)%Blade(i11)%InflowAcc = a1*u1%RotInflow(i01)%Blade(i11)%InflowAcc + a2*u2%RotInflow(i01)%Blade(i11)%InflowAcc + a3*u3%RotInflow(i01)%Blade(i11)%InflowAcc + END IF ! check if allocated + END DO + END IF ! check if allocated END DO - END DO - END DO -END IF ! check if allocated - ENDDO - DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) -IF (ALLOCATED(u_out%rotors(i01)%InflowOnTower) .AND. ALLOCATED(u1%rotors(i01)%InflowOnTower)) THEN - DO i2 = LBOUND(u_out%rotors(i01)%InflowOnTower,2),UBOUND(u_out%rotors(i01)%InflowOnTower,2) - DO i1 = LBOUND(u_out%rotors(i01)%InflowOnTower,1),UBOUND(u_out%rotors(i01)%InflowOnTower,1) - b = (t(3)**2*(u1%rotors(i01)%InflowOnTower(i1,i2) - u2%rotors(i01)%InflowOnTower(i1,i2)) + t(2)**2*(-u1%rotors(i01)%InflowOnTower(i1,i2) + u3%rotors(i01)%InflowOnTower(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*u1%rotors(i01)%InflowOnTower(i1,i2) + t(3)*u2%rotors(i01)%InflowOnTower(i1,i2) - t(2)*u3%rotors(i01)%InflowOnTower(i1,i2) ) * scaleFactor - u_out%rotors(i01)%InflowOnTower(i1,i2) = u1%rotors(i01)%InflowOnTower(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated - ENDDO - DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) - DO i1 = LBOUND(u_out%rotors(i01)%InflowOnHub,1),UBOUND(u_out%rotors(i01)%InflowOnHub,1) - b = (t(3)**2*(u1%rotors(i01)%InflowOnHub(i1) - u2%rotors(i01)%InflowOnHub(i1)) + t(2)**2*(-u1%rotors(i01)%InflowOnHub(i1) + u3%rotors(i01)%InflowOnHub(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%rotors(i01)%InflowOnHub(i1) + t(3)*u2%rotors(i01)%InflowOnHub(i1) - t(2)*u3%rotors(i01)%InflowOnHub(i1) ) * scaleFactor - u_out%rotors(i01)%InflowOnHub(i1) = u1%rotors(i01)%InflowOnHub(i1) + b + c * t_out - END DO - ENDDO - DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) - DO i1 = LBOUND(u_out%rotors(i01)%InflowOnNacelle,1),UBOUND(u_out%rotors(i01)%InflowOnNacelle,1) - b = (t(3)**2*(u1%rotors(i01)%InflowOnNacelle(i1) - u2%rotors(i01)%InflowOnNacelle(i1)) + t(2)**2*(-u1%rotors(i01)%InflowOnNacelle(i1) + u3%rotors(i01)%InflowOnNacelle(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%rotors(i01)%InflowOnNacelle(i1) + t(3)*u2%rotors(i01)%InflowOnNacelle(i1) - t(2)*u3%rotors(i01)%InflowOnNacelle(i1) ) * scaleFactor - u_out%rotors(i01)%InflowOnNacelle(i1) = u1%rotors(i01)%InflowOnNacelle(i1) + b + c * t_out - END DO - ENDDO - DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) - DO i1 = LBOUND(u_out%rotors(i01)%InflowOnTailFin,1),UBOUND(u_out%rotors(i01)%InflowOnTailFin,1) - b = (t(3)**2*(u1%rotors(i01)%InflowOnTailFin(i1) - u2%rotors(i01)%InflowOnTailFin(i1)) + t(2)**2*(-u1%rotors(i01)%InflowOnTailFin(i1) + u3%rotors(i01)%InflowOnTailFin(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%rotors(i01)%InflowOnTailFin(i1) + t(3)*u2%rotors(i01)%InflowOnTailFin(i1) - t(2)*u3%rotors(i01)%InflowOnTailFin(i1) ) * scaleFactor - u_out%rotors(i01)%InflowOnTailFin(i1) = u1%rotors(i01)%InflowOnTailFin(i1) + b + c * t_out - END DO - ENDDO - DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) -IF (ALLOCATED(u_out%rotors(i01)%UserProp) .AND. ALLOCATED(u1%rotors(i01)%UserProp)) THEN - DO i2 = LBOUND(u_out%rotors(i01)%UserProp,2),UBOUND(u_out%rotors(i01)%UserProp,2) - DO i1 = LBOUND(u_out%rotors(i01)%UserProp,1),UBOUND(u_out%rotors(i01)%UserProp,1) - b = (t(3)**2*(u1%rotors(i01)%UserProp(i1,i2) - u2%rotors(i01)%UserProp(i1,i2)) + t(2)**2*(-u1%rotors(i01)%UserProp(i1,i2) + u3%rotors(i01)%UserProp(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*u1%rotors(i01)%UserProp(i1,i2) + t(3)*u2%rotors(i01)%UserProp(i1,i2) - t(2)*u3%rotors(i01)%UserProp(i1,i2) ) * scaleFactor - u_out%rotors(i01)%UserProp(i1,i2) = u1%rotors(i01)%UserProp(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated - ENDDO -END IF ! check if allocated -IF (ALLOCATED(u_out%InflowWakeVel) .AND. ALLOCATED(u1%InflowWakeVel)) THEN - DO i2 = LBOUND(u_out%InflowWakeVel,2),UBOUND(u_out%InflowWakeVel,2) - DO i1 = LBOUND(u_out%InflowWakeVel,1),UBOUND(u_out%InflowWakeVel,1) - b = (t(3)**2*(u1%InflowWakeVel(i1,i2) - u2%InflowWakeVel(i1,i2)) + t(2)**2*(-u1%InflowWakeVel(i1,i2) + u3%InflowWakeVel(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*u1%InflowWakeVel(i1,i2) + t(3)*u2%InflowWakeVel(i1,i2) - t(2)*u3%InflowWakeVel(i1,i2) ) * scaleFactor - u_out%InflowWakeVel(i1,i2) = u1%InflowWakeVel(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated - END SUBROUTINE AD_Input_ExtrapInterp2 - - - SUBROUTINE AD_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(AD_OutputType), INTENT(INOUT) :: y(:) ! Output at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Outputs - TYPE(AD_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 = 'AD_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 AD_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL AD_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 AD_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 AD_Output_ExtrapInterp - - - SUBROUTINE AD_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(AD_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 - TYPE(AD_OutputType), INTENT(INOUT) :: y2 ! Output at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs - TYPE(AD_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 = 'AD_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%rotors) .AND. ALLOCATED(y1%rotors)) THEN - DO i01 = LBOUND(y_out%rotors,1),UBOUND(y_out%rotors,1) - CALL MeshExtrapInterp1(y1%rotors(i01)%NacelleLoad, y2%rotors(i01)%NacelleLoad, tin, y_out%rotors(i01)%NacelleLoad, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO - DO i01 = LBOUND(y_out%rotors,1),UBOUND(y_out%rotors,1) - CALL MeshExtrapInterp1(y1%rotors(i01)%HubLoad, y2%rotors(i01)%HubLoad, tin, y_out%rotors(i01)%HubLoad, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO - DO i01 = LBOUND(y_out%rotors,1),UBOUND(y_out%rotors,1) - CALL MeshExtrapInterp1(y1%rotors(i01)%TowerLoad, y2%rotors(i01)%TowerLoad, tin, y_out%rotors(i01)%TowerLoad, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO - DO i01 = LBOUND(y_out%rotors,1),UBOUND(y_out%rotors,1) -IF (ALLOCATED(y_out%rotors(i01)%BladeLoad) .AND. ALLOCATED(y1%rotors(i01)%BladeLoad)) THEN - DO i1 = LBOUND(y_out%rotors(i01)%BladeLoad,1),UBOUND(y_out%rotors(i01)%BladeLoad,1) - CALL MeshExtrapInterp1(y1%rotors(i01)%BladeLoad(i1), y2%rotors(i01)%BladeLoad(i1), tin, y_out%rotors(i01)%BladeLoad(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated - ENDDO - DO i01 = LBOUND(y_out%rotors,1),UBOUND(y_out%rotors,1) - CALL MeshExtrapInterp1(y1%rotors(i01)%TFinLoad, y2%rotors(i01)%TFinLoad, tin, y_out%rotors(i01)%TFinLoad, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO - DO i01 = LBOUND(y_out%rotors,1),UBOUND(y_out%rotors,1) -IF (ALLOCATED(y_out%rotors(i01)%WriteOutput) .AND. ALLOCATED(y1%rotors(i01)%WriteOutput)) THEN - DO i1 = LBOUND(y_out%rotors(i01)%WriteOutput,1),UBOUND(y_out%rotors(i01)%WriteOutput,1) - b = -(y1%rotors(i01)%WriteOutput(i1) - y2%rotors(i01)%WriteOutput(i1)) - y_out%rotors(i01)%WriteOutput(i1) = y1%rotors(i01)%WriteOutput(i1) + b * ScaleFactor - END DO -END IF ! check if allocated - ENDDO -END IF ! check if allocated - END SUBROUTINE AD_Output_ExtrapInterp1 - - - SUBROUTINE AD_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(AD_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 > t3 - TYPE(AD_OutputType), INTENT(INOUT) :: y2 ! Output at t2 > t3 - TYPE(AD_OutputType), INTENT(INOUT) :: y3 ! Output at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs - TYPE(AD_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 = 'AD_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%rotors) .AND. ALLOCATED(y1%rotors)) THEN - DO i01 = LBOUND(y_out%rotors,1),UBOUND(y_out%rotors,1) - CALL MeshExtrapInterp2(y1%rotors(i01)%NacelleLoad, y2%rotors(i01)%NacelleLoad, y3%rotors(i01)%NacelleLoad, tin, y_out%rotors(i01)%NacelleLoad, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO - DO i01 = LBOUND(y_out%rotors,1),UBOUND(y_out%rotors,1) - CALL MeshExtrapInterp2(y1%rotors(i01)%HubLoad, y2%rotors(i01)%HubLoad, y3%rotors(i01)%HubLoad, tin, y_out%rotors(i01)%HubLoad, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO - DO i01 = LBOUND(y_out%rotors,1),UBOUND(y_out%rotors,1) - CALL MeshExtrapInterp2(y1%rotors(i01)%TowerLoad, y2%rotors(i01)%TowerLoad, y3%rotors(i01)%TowerLoad, tin, y_out%rotors(i01)%TowerLoad, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO - DO i01 = LBOUND(y_out%rotors,1),UBOUND(y_out%rotors,1) -IF (ALLOCATED(y_out%rotors(i01)%BladeLoad) .AND. ALLOCATED(y1%rotors(i01)%BladeLoad)) THEN - DO i1 = LBOUND(y_out%rotors(i01)%BladeLoad,1),UBOUND(y_out%rotors(i01)%BladeLoad,1) - CALL MeshExtrapInterp2(y1%rotors(i01)%BladeLoad(i1), y2%rotors(i01)%BladeLoad(i1), y3%rotors(i01)%BladeLoad(i1), tin, y_out%rotors(i01)%BladeLoad(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated - ENDDO - DO i01 = LBOUND(y_out%rotors,1),UBOUND(y_out%rotors,1) - CALL MeshExtrapInterp2(y1%rotors(i01)%TFinLoad, y2%rotors(i01)%TFinLoad, y3%rotors(i01)%TFinLoad, tin, y_out%rotors(i01)%TFinLoad, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO - DO i01 = LBOUND(y_out%rotors,1),UBOUND(y_out%rotors,1) -IF (ALLOCATED(y_out%rotors(i01)%WriteOutput) .AND. ALLOCATED(y1%rotors(i01)%WriteOutput)) THEN - DO i1 = LBOUND(y_out%rotors(i01)%WriteOutput,1),UBOUND(y_out%rotors(i01)%WriteOutput,1) - b = (t(3)**2*(y1%rotors(i01)%WriteOutput(i1) - y2%rotors(i01)%WriteOutput(i1)) + t(2)**2*(-y1%rotors(i01)%WriteOutput(i1) + y3%rotors(i01)%WriteOutput(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%rotors(i01)%WriteOutput(i1) + t(3)*y2%rotors(i01)%WriteOutput(i1) - t(2)*y3%rotors(i01)%WriteOutput(i1) ) * scaleFactor - y_out%rotors(i01)%WriteOutput(i1) = y1%rotors(i01)%WriteOutput(i1) + b + c * t_out - END DO -END IF ! check if allocated - ENDDO -END IF ! check if allocated - END SUBROUTINE AD_Output_ExtrapInterp2 - + do i01 = lbound(u_out%RotInflow,1),ubound(u_out%RotInflow,1) + IF (ALLOCATED(u_out%RotInflow(i01)%Tower%InflowVel) .AND. ALLOCATED(u1%RotInflow(i01)%Tower%InflowVel)) THEN + u_out%RotInflow(i01)%Tower%InflowVel = a1*u1%RotInflow(i01)%Tower%InflowVel + a2*u2%RotInflow(i01)%Tower%InflowVel + a3*u3%RotInflow(i01)%Tower%InflowVel + END IF ! check if allocated + IF (ALLOCATED(u_out%RotInflow(i01)%Tower%InflowAcc) .AND. ALLOCATED(u1%RotInflow(i01)%Tower%InflowAcc)) THEN + u_out%RotInflow(i01)%Tower%InflowAcc = a1*u1%RotInflow(i01)%Tower%InflowAcc + a2*u2%RotInflow(i01)%Tower%InflowAcc + a3*u3%RotInflow(i01)%Tower%InflowAcc + END IF ! check if allocated + END DO + do i01 = lbound(u_out%RotInflow,1),ubound(u_out%RotInflow,1) + u_out%RotInflow(i01)%InflowOnHub = a1*u1%RotInflow(i01)%InflowOnHub + a2*u2%RotInflow(i01)%InflowOnHub + a3*u3%RotInflow(i01)%InflowOnHub + END DO + do i01 = lbound(u_out%RotInflow,1),ubound(u_out%RotInflow,1) + u_out%RotInflow(i01)%InflowOnNacelle = a1*u1%RotInflow(i01)%InflowOnNacelle + a2*u2%RotInflow(i01)%InflowOnNacelle + a3*u3%RotInflow(i01)%InflowOnNacelle + END DO + do i01 = lbound(u_out%RotInflow,1),ubound(u_out%RotInflow,1) + u_out%RotInflow(i01)%InflowOnTailFin = a1*u1%RotInflow(i01)%InflowOnTailFin + a2*u2%RotInflow(i01)%InflowOnTailFin + a3*u3%RotInflow(i01)%InflowOnTailFin + END DO + do i01 = lbound(u_out%RotInflow,1),ubound(u_out%RotInflow,1) + u_out%RotInflow(i01)%AvgDiskVel = a1*u1%RotInflow(i01)%AvgDiskVel + a2*u2%RotInflow(i01)%AvgDiskVel + a3*u3%RotInflow(i01)%AvgDiskVel + END DO + END IF ! check if allocated +END SUBROUTINE END MODULE AeroDyn_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/aerodyn/src/AirfoilInfo.f90 b/modules/aerodyn/src/AirfoilInfo.f90 index 7d3d0742e7..08f51e1736 100644 --- a/modules/aerodyn/src/AirfoilInfo.f90 +++ b/modules/aerodyn/src/AirfoilInfo.f90 @@ -26,6 +26,7 @@ MODULE AirfoilInfo USE AirfoilInfo_Types USE :: ISO_FORTRAN_ENV , ONLY : IOSTAT_EOR + USE :: NWTC_LAPACK IMPLICIT NONE @@ -34,6 +35,9 @@ MODULE AirfoilInfo PUBLIC :: AFI_Init ! routine to initialize AirfoilInfo parameters PUBLIC :: AFI_ComputeUACoefs ! routine to calculate Airfoil BL parameters for UA PUBLIC :: AFI_ComputeAirfoilCoefs ! routine to perform 1D (AOA) or 2D (AOA, Re) or (AOA, UserProp) lookup of the airfoil coefs + PUBLIC :: AFI_WrHeader + PUBLIC :: AFI_WrData + PUBLIC :: AFI_WrTables TYPE(ProgDesc), PARAMETER :: AFI_Ver = ProgDesc( 'AirfoilInfo', '', '') ! The name, version, and date of AirfoilInfo. @@ -424,7 +428,7 @@ SUBROUTINE ReadAFfile ( InitInp, NumCoefsIn, p, ErrStat, ErrMsg, UnEc ) RETURN END IF - ! RelThickness, default is 0.2 if user doesn't know it, only used for Boing-Vertol UA model = 7 + ! RelThickness, default is 0.2 if user doesn't know it, only used for Boeing-Vertol UA model = 7 CALL ParseVarWDefault ( FileInfo, CurLine, 'RelThickness', p%RelThickness, 0.2_ReKi, ErrStat2, ErrMsg2, UnEc ) if (ErrStat2 >= AbortErrLev) then ! if the line is missing, set RelThickness = -1 and move on... p%RelThickness=-1 ! To trigger an error @@ -477,15 +481,15 @@ SUBROUTINE ReadAFfile ( InitInp, NumCoefsIn, p, ErrStat, ErrMsg, UnEc ) ENDDO ! Row ENDIF - - ! Reading Boundary layer file for aeroacoustics + + ! Reading Boundary layer file for aeroacoustics CALL ParseVar ( FileInfo, CurLine, 'BL_file' , p%BL_file , ErrStat2, ErrMsg2, UnEc, IsPath=.true. ) IF (ErrStat2 >= AbortErrLev) p%BL_file = "NOT_SET_IN_AIRFOIL_FILE" !CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) IF ( PathIsRelative( p%BL_file ) ) p%BL_file=trim(PriPath)//trim(p%BL_file) - ! How many columns do we need to read in the input and how many total coefficients will be used? + ! How many columns do we need to read in the input and how many total coefficients will be used? Cols2Parse = MAX( InitInp%InCol_Alfa, InitInp%InCol_Cl, InitInp%InCol_Cd, InitInp%InCol_Cm, InitInp%InCol_Cpmin ) ALLOCATE ( SiAry( Cols2Parse ) , STAT=ErrStat2 ) IF ( ErrStat2 /= 0 ) THEN @@ -713,6 +717,7 @@ SUBROUTINE ReadAFfile ( InitInp, NumCoefsIn, p, ErrStat, ErrMsg, UnEc ) CALL Cleanup() RETURN ENDIF + p%Table(iTable)%Coefs = 0.0_ReKi DO Row=1,p%Table(iTable)%NumAlf @@ -752,7 +757,7 @@ SUBROUTINE ReadAFfile ( InitInp, NumCoefsIn, p, ErrStat, ErrMsg, UnEc ) if ( p%Table(iTable)%ConstData ) then p%Table(iTable)%InclUAdata = .false. else - call CalculateUACoeffs(CalcDefaults(iTable), p%Table(iTable), p%ColCl, p%ColCd, p%ColCm, p%ColUAf, InitInp%UA_f_cn) + call CalculateUACoeffs(CalcDefaults(iTable), p%Table(iTable), p%ColCl, p%ColCd, p%ColCm, p%ColUAf, InitInp%UAMod) end if ! Let's make sure that the data go from -Pi to Pi and that the values are the same for both @@ -819,48 +824,63 @@ END SUBROUTINE Cleanup END SUBROUTINE ReadAFfile !---------------------------------------------------------------------------------------------------------------------------------- - SUBROUTINE CalculateUACoeffs(CalcDefaults,p,ColCl,ColCd,ColCm,ColUAf,UA_f_cn) + SUBROUTINE CalculateUACoeffs(CalcDefaults,p,ColCl,ColCd,ColCm,ColUAf,UAMod) TYPE (AFI_UA_BL_Default_Type),intent(in):: CalcDefaults TYPE (AFI_Table_Type), intent(inout) :: p ! This structure stores all the module parameters that are set by AirfoilInfo during the initialization phase. integer(IntKi), intent(in ) :: ColCl ! column for cl integer(IntKi), intent(in ) :: ColCd ! column for cd integer(IntKi), intent(in ) :: ColCm ! column for cm integer(IntKi), intent(in ) :: ColUAf ! column for UA f_st (based on Cl or cn) - logical, intent(in ) :: UA_f_cn ! is f_st based on cn (true) or cl (false)? + integer(IntKi), intent(in ) :: UAMod ! UA model; determines how to compute f_st? INTEGER(IntKi) :: Row ! The row of a table to be parsed in the FileInfo structure. INTEGER(IntKi) :: col_fs ! column for UA cn/cl_fs (fully separated cn or cl) INTEGER(IntKi) :: col_fa ! column for UA cn/cl_fa (fully attached cn or cl) - REAL(ReKi) :: cl_ratio, cl_inv - REAL(ReKi) :: f_st, fullySeparate - REAL(ReKi) :: f_iHigh, f_iLow INTEGER(IntKi) :: iCdMin - INTEGER(IntKi) :: iHigh, iLow + INTEGER(IntKi) :: iHighLimit, iLowLimit + INTEGER(IntKi) :: iHigh, iLow INTEGER(IntKi) :: iHigh2, iLow2 + INTEGER(IntKi) :: iGuess, iUpper, iLower, i(1) + INTEGER(IntKi) :: nRoots + + LOGICAL :: UA_f_cn ! note that we don't get here with constant data, so NumAlf>2 + REAL(ReKi) :: roots(p%NumAlf) REAL(ReKi) :: cn(p%NumAlf) + REAL(ReKi) :: ClSlope_raw(p%NumAlf-1) REAL(ReKi) :: CnSlope_raw(p%NumAlf-1) + REAL(ReKi) :: ClSlope_(p%NumAlf-1) REAL(ReKi) :: CnSlope_(p%NumAlf-1) REAL(ReKi) :: alpha_(p%NumAlf-1) REAL(ReKi) :: alphaAtCdMin REAL(ReKi) :: CnSlopeAtCdMin - REAL(ReKi) :: ClTmp, alphaTmp REAL(ReKi) :: maxCnSlope - REAL(ReKi) :: slope REAL(ReKi) , PARAMETER :: CnSlopeThreshold = 0.90; REAL(ReKi) , PARAMETER :: fAtCriticalCn = 0.7; REAL(ReKi) :: LimitAlphaRange - - - LimitAlphaRange = 20.0_ReKi * D2R ! range we're limiting our equations to (in radians) + REAL(ReKi) :: Default_Cn_alpha + REAL(ReKi) :: Default_Cl_alpha + REAL(ReKi) :: Default_alpha0 + REAL(ReKi) :: alphaMargin + INTEGER(IntKi) :: ErrStat2 ! Error status local to this routine. + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'CalculateUACoeffs' + + if ( UAMod == UA_HGMV360 ) then + LimitAlphaRange = TwoPi ! range we're limiting our equations to (in radians) + else + LimitAlphaRange = 20.0_ReKi * D2R ! range we're limiting our equations to (in radians) + end if + col_fs = ColUAf + 1 col_fa = col_fs + 1 + UA_f_cn = UAMod /= UA_HGM .and. UAMod /= UA_Oye ! these models use cl instead of cn if ( p%InclUAdata ) then @@ -888,142 +908,343 @@ SUBROUTINE CalculateUACoeffs(CalcDefaults,p,ColCl,ColCd,ColCm,ColUAf,UA_f_cn) if (CalcDefaults%A1 ) p%UA_BL%A1 = 0.30_ReKi if (CalcDefaults%A2 ) p%UA_BL%A2 = 0.70_ReKi if (CalcDefaults%A5 ) p%UA_BL%A5 = 1.00_ReKi - if (CalcDefaults%St_sh ) p%UA_BL%St_sh = 0.19_ReKi if (CalcDefaults%x_cp_bar ) p%UA_BL%x_cp_bar = 0.20_ReKi - if (CalcDefaults%UACutout ) p%UA_BL%UACutout = 45.00_ReKi*D2R ! turn off UA at 45 degrees - if (CalcDefaults%UACutout_delta ) p%UA_BL%UACutout_delta = 5.00_ReKi*D2R ! begin turning off 5 degrees before UAcutout - if (CalcDefaults%filtCutOff ) p%UA_BL%filtCutOff = 0.50_ReKi + if (UAMod == UA_HGMV360) then ! set defaults for this model (note: we don't turn off UA) + if (CalcDefaults%St_sh ) p%UA_BL%St_sh = 0.14_ReKi + if (CalcDefaults%UACutout ) p%UA_BL%UACutout = TwoPi*2 ! don't turn off UA for this model + if (CalcDefaults%UACutout_delta ) p%UA_BL%UACutout_delta = D2R ! begin turning off 1 degrees before UAcutout (if UACutout is large enough, we don't turn off UAcutout) + else + if (CalcDefaults%St_sh ) p%UA_BL%St_sh = 0.19_ReKi + if (CalcDefaults%UACutout ) p%UA_BL%UACutout = 45.00_ReKi*D2R ! turn off UA at 45 degrees + if (CalcDefaults%UACutout_delta ) p%UA_BL%UACutout_delta = 5.00_ReKi*D2R ! begin turning off 5 degrees before UAcutout + end if + p%UA_BL%UACutout_blend = max(0.0_ReKi, abs(p%UA_BL%UACutout) - abs(p%UA_BL%UACutout_delta)) !------------------------------------- ! Calculate based on airfoil polar: !------------------------------------- - ! if Cd is constant, does this cause issues??? iCdMin = minloc(p%Coefs(:,ColCd),DIM=1, MASK=abs(p%alpha)<=LimitAlphaRange) - if (CalcDefaults%Cd0) p%UA_BL%Cd0 = p%Coefs(iCdMin,ColCd) - alphaAtCdMin = p%alpha(iCdMin) - - ! compute cn: - do Row=1,p%NumAlf - cn(Row) = p%Coefs(Row,ColCl)*cos(p%alpha(Row)) + (p%Coefs(Row,ColCd) - p%UA_BL%Cd0)*sin(p%alpha(Row)) - end do - - ! compute cn and cl slopes (raw): - do Row=1,p%NumAlf-1 - CnSlope_raw(Row) = ( cn(Row+1) - cn(Row) ) / (p%alpha(Row+1) - p%alpha(Row)) - ClSlope_( Row) = ( p%Coefs(Row+1,ColCl) - p%Coefs(Row,ColCl) ) / (p%alpha(Row+1) - p%alpha(Row)) - alpha_( Row) = 0.5_ReKi * (p%alpha(Row+1) + p%alpha(Row)) - end do + if ( (maxval(p%Coefs(:,ColCd),DIM=1, MASK=abs(p%alpha)<=LimitAlphaRange) == & + minval(p%Coefs(:,ColCd),DIM=1, MASK=abs(p%alpha)<=LimitAlphaRange) ) .or. & + maxval(p%Coefs(:,ColCl),DIM=1, MASK=abs(p%alpha)<=LimitAlphaRange) < 0.01 ) then + + ! Cylinder polar perhaps? + + if (CalcDefaults%Cd0) p%UA_BL%Cd0 = p%Coefs(iCdMin,ColCd) + if (CalcDefaults%alpha0) p%UA_BL%alpha0 = 0; + if (CalcDefaults%C_nalpha) p%UA_BL%C_nalpha = 0; + if (CalcDefaults%C_lalpha) p%UA_BL%C_lalpha = 0; + if (CalcDefaults%Cm0) p%UA_BL%Cm0 = 0; + if (CalcDefaults%alpha1) p%UA_BL%alpha1 = 10*D2R; + if (CalcDefaults%alpha2) p%UA_BL%alpha2 = -10*D2R; + if (CalcDefaults%Cn1) p%UA_BL%Cn1 = 0; + if (CalcDefaults%Cn2) p%UA_BL%Cn2 = 0; + if (CalcDefaults%alphaLower) p%UA_BL%alphaLower = -5*D2R; + if (CalcDefaults%alphaUpper) p%UA_BL%alphaUpper = 5*D2R; + + if (.not. UA_f_cn) then + call ComputeUASeparationFunction_onCl(p, ColCl, ColUAf, col_fs, col_fa) + else + + if ( UAMod == UA_HGMV360 ) then + p%UA_BL%Cd0 = 0.0_ReKi ! setting this to 0 so that Cn gets calculated properly elsewhere in this code + end if + Cn = Calculate_Cn(alpha=p%alpha, cl=p%Coefs(:,ColCl), cd=p%Coefs(:,ColCd), cd0=p%UA_BL%Cd0) + call ComputeUA360_AttachedFlow(p, ColUAf, Cn, iLower, iUpper) + call ComputeUA360_updateSeparationF( p, ColUAf, Cn, iLower, iUpper ) + call ComputeUA360_updateCnSeparated( p, ColUAf, Cn, iLower ) + + end if + else + ! if Cd is constant, does this cause issues??? + alphaAtCdMin = p%alpha(iCdMin) - ! smooth cn slope for better calculations later: - call kernelSmoothing(alpha_, CnSlope_raw, kernelType_TRIWEIGHT, 2.0_ReKi*D2R, CnSlope_) + ! compute cn: + if (UAMod == UA_HGMV360) then + !call Compute_iLoweriUpper(p, iLower, iUpper) + !if (CalcDefaults%Cd0) p%UA_BL%Cd0 = minval( p%Coefs(iLower:iUpper, ColCd) ) + p%UA_BL%Cd0 = 0.0_ReKi ! setting this to 0 so that Cn gets calculated properly elsewhere in this code + else + if (CalcDefaults%Cd0) p%UA_BL%Cd0 = p%Coefs(iCdMin,ColCd) + end if + cn = Calculate_Cn(alpha=p%alpha, cl=p%Coefs(:,ColCl), cd=p%Coefs(:,ColCd), cd0=p%UA_BL%Cd0) + + ! compute cn and cl slopes (raw): + do Row=1,p%NumAlf-1 + CnSlope_raw(Row) = ( cn(Row+1) - cn(Row) ) / (p%alpha(Row+1) - p%alpha(Row)) + ClSlope_raw(Row) = ( p%Coefs(Row+1,ColCl) - p%Coefs(Row,ColCl) ) / (p%alpha(Row+1) - p%alpha(Row)) + alpha_( Row) = 0.5_ReKi * (p%alpha(Row+1) + p%alpha(Row)) + end do + ! smooth cn slope for better calculations later: + call kernelSmoothing(alpha_, CnSlope_raw, kernelType_TRIWEIGHT, 2.0_ReKi*D2R, CnSlope_) + call kernelSmoothing(alpha_, ClSlope_raw, kernelType_TRIWEIGHT, 2.0_ReKi*D2R, ClSlope_) - CnSlopeAtCdMin = InterpStp( alphaAtCdMin, alpha_, CnSlope_, iLow, p%NumAlf-1 ) + iGuess = iCdMin + CnSlopeAtCdMin = InterpStp( alphaAtCdMin, alpha_, CnSlope_, iGuess, p%NumAlf-1 ) - !find alphaUpper (using smoothed Cn values): - iHigh = minloc( alpha_ ,DIM=1, MASK=alpha_ >= LimitAlphaRange ) ! we can limit this to ~20 degrees - iHigh2 = iHigh - if (CalcDefaults%alphaUpper) then + ! find bounding indices for limitAlphaRange + iHighLimit = min( maxloc( alpha_ , DIM=1, MASK=alpha_ < LimitAlphaRange) + 1, size(alpha_) ) ! we can limit this to some range + iLowLimit = max( minloc( alpha_ , DIM=1, MASK=alpha_ > -LimitAlphaRange) - 1, 1 ) ! we can limit this to some range + if (iHighLimit - iLowLimit < 3) iHighLimit = min(iLowLimit+2,size(alpha_)) ! this could still be an issue if we don't have very many points in the airfoil table. If that's the case, this data is not worth anything anyway + if (iHighLimit - iLowLimit < 3) iLowLimit = max(iHighLimit-2,1) ! this could still be an issue if we don't have very many points in the airfoil table. If that's the case, this data is not worth anything anyway - if (iHigh maxCnSlope) then - maxCnSlope = CnSlope_(Row) + maxCnSlope = CnSlopeAtCdMin + do Row=iCdMin, iHigh + iHigh2 = Row + if (CnSlope_(Row) > maxCnSlope) then + maxCnSlope = CnSlope_(Row) + else if (CnSlope_(Row) < CnSlopeThreshold*maxCnSlope) then + exit + end if + end do + + if (iHigh2 == iCdMin) then + p%UA_BL%alphaUpper = alphaAtCdMin; + else + iHigh2 = min(max(1, iHigh2-1), p%NumAlf-1 ) + p%UA_BL%alphaUpper = alpha_(iHigh2); end if - if (CnSlope_(Row) < CnSlopeThreshold*maxCnSlope) exit - end do - if (iHigh2 == iCdMin) then - p%UA_BL%alphaUpper = alphaAtCdMin; else - iHigh2 = min(max(1, iHigh2-1), p%NumAlf-1 ) - p%UA_BL%alphaUpper = alpha_(iHigh2); + iHigh2 = iHighLimit ! initialize for use in alphaLower if no alphaUpper default is requested end if - - end if - !find alphaLower - iLow = maxloc( alpha_ , DIM=1, MASK=alpha_ <= -LimitAlphaRange) ! we can limit this to ~-20 degrees - if (CalcDefaults%alphaLower) then - if (iLow>iCdMin) iLow = 1 - - maxCnSlope = CnSlopeAtCdMin - iLow2 = min(iHigh2-1, iCdMin-1, p%NumAlf-1) - - do Row = min(iHigh2-1, iCdMin-1, p%NumAlf-1) ,iLow,-1 - iLow2 = Row - if (CnSlope_(Row) > maxCnSlope) then - maxCnSlope = CnSlope_(Row); - end if - - - if ( CnSlope_(Row) < CnSlopeThreshold*maxCnSlope ) exit - end do - if (iLow2 == iCdMin) then - p%UA_BL%alphaLower = alphaAtCdMin; - else - iLow2 = min(max(1, iLow2+1), p%NumAlf-1 ) - p%UA_BL%alphaLower = alpha_(iLow2); + !find alphaLower + if (CalcDefaults%alphaLower) then + maxCnSlope = CnSlopeAtCdMin + + iLow = iLowLimit + iHigh = max( 1, min(iHigh2, iCdMin, p%NumAlf-1) ) + if (iHigh < iLow) iLow = 1 + + do Row = iHigh,iLow,-1 + iLow2 = Row + if (CnSlope_(Row) > maxCnSlope) then + maxCnSlope = CnSlope_(Row); + else if ( CnSlope_(Row) < CnSlopeThreshold*maxCnSlope ) then + exit + end if + end do + + if (iLow2 == iCdMin) then + p%UA_BL%alphaLower = alphaAtCdMin; + else + iLow2 = min(max(1, iLow2+1), p%NumAlf-1 ) + p%UA_BL%alphaLower = alpha_(iLow2); + end if end if - end if - ! make sure iLow and iHigh are defined before doing this calculation: - ! note: perhaps we want to recalculate CnSlope_ with un-smoothed values???? - if (CalcDefaults%C_nalpha) p%UA_BL%C_nalpha = maxval(CnSlope_(iLow:iHigh)) + !------------------------------------ + ! Note: C_nalpha, C_lalpha, and alpha0 are not used in HGMV360 + !------------------------------------ + + if (CalcDefaults%C_nalpha .or. CalcDefaults%C_lalpha .or. CalcDefaults%alpha0) then + + alphaMargin = 0.2*( p%UA_BL%alphaUpper - p%UA_BL%alphaLower ); + !mask = p%alpha >= p%UA_BL%alphaLower+alphaMargin & p%alpha <= p%UA_BL%alphaUpper-alphaMargin; + + iLow2 = iLowLimit + do while (iLow2 < iHighLimit-1 .and. p%alpha(iLow2) < p%UA_BL%alphaLower + alphaMargin) + iLow2 = iLow2 + 1 + end do + + iHigh2 = iHighLimit + do while (iHigh2 > iLow2+1 .and. p%alpha(iHigh2) > p%UA_BL%alphaUpper - alphaMargin) + iHigh2 = iHigh2 - 1 + end do + + call Calculate_C_alpha(p%alpha(iLow2:iHigh2), Cn(iLow2:iHigh2), p%Coefs(iLow2:iHigh2,ColCl), Default_Cn_alpha, Default_Cl_alpha, Default_alpha0, ErrStat2, ErrMsg2) - ! this is calculated with un-smoothed data: - if (CalcDefaults%C_lalpha) p%UA_BL%C_lalpha = maxval(ClSlope_(iLow:iHigh)) + if (CalcDefaults%C_nalpha) p%UA_BL%C_nalpha = Default_Cn_alpha + if (CalcDefaults%C_lalpha) p%UA_BL%C_lalpha = Default_Cl_alpha + if (CalcDefaults%alpha0) p%UA_BL%alpha0 = Default_alpha0 + end if + if (CalcDefaults%Cm0) then + if (ColCm > 0) then + iGuess = p%NumAlf/2 ! guess: start in the center + p%UA_BL%Cm0 = InterpStp( p%UA_BL%alpha0, p%alpha, p%Coefs(:,ColCm), iGuess, p%NumAlf ) + else + p%UA_BL%Cm0 = 0.0_ReKi + end if + end if - ! find alpha0 - ! least squares fit between alphaLower and alphaUpper??? (see LAPACK_GELSD) - ! For now we will just go a poor-man's linear fit with existing data: - if (CalcDefaults%alpha0) then - slope = p%UA_BL%C_lalpha - if (EqualRealNos(slope, 0.0_ReKi)) then - p%UA_BL%alpha0 = 0.0_ReKi ! doesn't really matter + if (.not. UA_f_cn) then ! + call ComputeUASeparationFunction_onCl(p, ColCl, ColUAf, col_fs, col_fa) + call Compute_iLoweriUpper(p, iLower, iUpper) ! calculating iLower and iUpper here (for alpha1 and alpha2) else - alphaTmp = 0.5_ReKi * (p%UA_BL%alphaLower+p%UA_BL%alphaUpper) - ClTmp = InterpStp(alphaTmp, p%alpha, p%Coefs(:,ColCl), iLow, p%NumAlf) - p%UA_BL%alpha0 = alphaTmp - ClTmp / slope + call ComputeUA360_AttachedFlow(p, ColUAf, Cn, iLower, iUpper) + call ComputeUA360_updateSeparationF( p, ColUAf, Cn, iLower, iUpper ) + call ComputeUA360_updateCnSeparated( p, ColUAf, Cn, iLower ) end if - end if + - if (CalcDefaults%Cm0) then - if (ColCm > 0) then - iLow = p%NumAlf/2 ! guess: start in the center - p%UA_BL%Cm0 = InterpStp( p%UA_BL%alpha0, p%alpha, p%Coefs(:,ColCm), iLow, p%NumAlf ) - else - p%UA_BL%Cm0 = 0.0_ReKi + ! alpha1 + if (CalcDefaults%alpha1) then + iGuess = max(1, minloc( p%alpha , DIM=1, MASK=p%alpha >= p%UA_BL%alphaUpper .and. p%Coefs(:,ColUAf) <= fAtCriticalCn)) + call fZeros(p%alpha(iUpper:), fAtCriticalCn - p%Coefs(iUpper:,ColUAf), roots, nRoots) + + if (nRoots==1) then + p%UA_BL%alpha1 = roots(1) + elseif (nRoots>1) then + i = minloc( abs(roots(1:nRoots) - p%alpha(iGuess) ), DIM=1 ) ! find root closest to guess + p%UA_BL%alpha1 = roots(i(1)) + else + p%UA_BL%alpha1 = p%alpha(iGuess) + end if + end if + + ! alpha2 + if (CalcDefaults%alpha2) then + iGuess = maxloc( p%alpha , DIM=1, MASK=p%alpha <= p%UA_BL%alphaLower .and. p%Coefs(:,ColUAf) <= fAtCriticalCn) + call fZeros(p%alpha(:iLower), fAtCriticalCn - p%Coefs(:iLower,ColUAf), roots, nRoots) + + if (nRoots==1) then + p%UA_BL%alpha2 = roots(1) + elseif (nRoots>1) then + i = minloc( abs(roots(1:nRoots) - p%alpha(iGuess) ), DIM=1 ) ! find root closest to guess + p%UA_BL%alpha2 = roots(i(1)) + else + p%UA_BL%alpha2 = p%alpha(iGuess) + end if + + end if + + ! Cn1 + if (CalcDefaults%Cn1) then + iGuess = iHighLimit + p%UA_BL%Cn1 = InterpStp( p%UA_BL%alpha1, p%alpha, cn, iGuess, p%NumAlf ) + end if + + ! Cn2 + if (CalcDefaults%Cn2) then + iGuess = iLowLimit + p%UA_BL%Cn2 = InterpStp( p%UA_BL%alpha2, p%alpha, cn, iGuess, p%NumAlf ) end if + + end if ! not a circular polar + + if ( UA_f_cn ) then + iGuess = iLowLimit + p%UA_BL%c_alphaLower = InterpStp(p%UA_BL%alphaLower, p%alpha, cn, iGuess, p%NumAlf) + iGuess = iHighLimit + p%UA_BL%c_alphaUpper = InterpStp(p%UA_BL%alphaUpper, p%alpha, cn, iGuess, p%NumAlf) + else + iGuess = iLowLimit + p%UA_BL%c_alphaLower = InterpStp(p%UA_BL%alphaLower, p%alpha, p%Coefs(:,ColCl), iGuess, p%NumAlf) + iGuess = iHighLimit + p%UA_BL%c_alphaUpper = InterpStp(p%UA_BL%alphaUpper, p%alpha, p%Coefs(:,ColCl), iGuess, p%NumAlf) end if + end if ! UA is included + + END SUBROUTINE CalculateUACoeffs +!---------------------------------------------------------------------------------------------------------------------------------- + FUNCTION Calculate_Cn (alpha, Cl, Cd, Cd0) RESULT(Cn) + REAL(ReKi), intent(in ) :: alpha(:) ! alpha + REAL(ReKi), intent(in ) :: Cl(:) ! cl + REAL(ReKi), intent(in ) :: Cd(:) ! cd + REAL(ReKi), intent(in ) :: Cd0 + REAL(ReKi) :: Cn(size(alpha)) ! cn (result of this function) + + integer(IntKi) :: NumAlf + integer(IntKi) :: Row + + NumAlf = size(alpha) + + do Row=1,NumAlf + cn(Row) = Cl(Row)*cos(alpha(Row)) + (Cd(Row) - Cd0)*sin(alpha(Row)) + end do + + END FUNCTION Calculate_Cn +!---------------------------------------------------------------------------------------------------------------------------------- + SUBROUTINE Calculate_C_alpha(alpha, Cn, Cl, Default_Cn_alpha, Default_Cl_alpha, Default_alpha0, ErrStat, ErrMsg) + REAL(ReKi), intent(in ) :: alpha(:) ! alpha + REAL(ReKi), intent(in ) :: Cn(:) ! cn + REAL(ReKi), intent(in ) :: Cl(:) ! cl + + REAL(ReKi), intent( out) :: Default_Cn_alpha + REAL(ReKi), intent( out) :: Default_Cl_alpha + REAL(ReKi), intent( out) :: Default_alpha0 + integer(IntKi), intent( out) :: errStat ! Error status of the operation + character(*), intent( out) :: errMsg ! Error message if ErrStat /= ErrID_None + + REAL(ReKi) :: A( size(alpha), 2) + REAL(ReKi) :: B(max(2,size(alpha)),2) + + if (SIZE(Cn) < 2 .OR. SIZE(Cl) < 2) then + ErrMsg='Calculate_C_alpha: Not enough data points to compute Cn and Cl slopes.' + ErrStat=ErrID_Fatal + Default_Cn_alpha = EPSILON(Default_Cn_alpha) + Default_Cl_alpha = EPSILON(Default_Cl_alpha) + Default_alpha0 = 0.0_ReKi + return + end if + + A(:,1) = alpha + A(:,2) = 1.0_ReKi + + if (size(Cn) == 1) then + B(:,1) = Cn(1) + B(:,2) = Cl(1) + else + B(:,1) = Cn + B(:,2) = Cl + end if + + CALL LAPACK_gels('N', A, B, ErrStat, ErrMsg) + + Default_Cn_alpha = B(1,1) + Default_Cl_alpha = B(1,2) + + if (.not. EqualRealNos(B(1,1),0.0_ReKi)) then + Default_alpha0 = -B(2,1)/B(1,1) ! using the values from Cn_alpha + else + Default_alpha0 = 0.0_ReKi + end if - if (.not. UA_f_cn) then ! - !------------------------------------------------ - ! calculate f_st, cl_fs, and cl_fa for HGM model - !------------------------------------------------ - if (EqualRealNos(p%UA_BL%c_lalpha,0.0_ReKi)) then - p%Coefs(:,ColUAf) = 0.0_ReKi ! Eq. 59 - p%Coefs(:,col_fs) = p%Coefs(:,ColCl) ! Eq. 61 - p%Coefs(:,col_fa) = 0.0_ReKi - call ComputeUASeparationFunction_zero(p, ColUAf, p%Coefs(:,ColCl)) ! just to initialize these values... UA will turn off without using them - else + END SUBROUTINE Calculate_C_alpha +!---------------------------------------------------------------------------------------------------------------------------------- + SUBROUTINE ComputeUASeparationFunction_onCl(p, ColCl, ColUAf, col_fs, col_fa) + TYPE (AFI_Table_Type), intent(inout) :: p ! This structure stores all the module parameters that are set by AirfoilInfo during the initialization phase. + integer(IntKi), intent(in ) :: ColUAf ! column for UA f_st (based on Cl or cn) + integer(IntKi), intent(in ) :: ColCl ! column for cl + INTEGER(IntKi), intent(in ) :: col_fs ! column for UA cn/cl_fs (fully separated cn or cl) + INTEGER(IntKi), intent(in ) :: col_fa ! column for UA cn/cl_fa (fully attached cn or cl); NOT USED IN THE MODELS ! note that col_fa is not used in this model, but we set the values to ensure files get written properly + + + integer :: Row + REAL(ReKi) :: cl_ratio + REAL(ReKi) :: cl_inv + REAL(ReKi) :: f_st + REAL(ReKi) :: fullySeparate + + !------------------------------------------------ + ! calculate f_st, cl_fs, and cl_fa for HGM model + !------------------------------------------------ + if (EqualRealNos(p%UA_BL%c_lalpha,0.0_ReKi)) then + p%Coefs(:,ColUAf) = 0.0_ReKi ! Eq. 59 + p%Coefs(:,col_fs) = p%Coefs(:,ColCl) ! Eq. 61 + p%Coefs(:,col_fa) = 0.0_ReKi + call ComputeUASeparationFunction_zero(p, ColUAf, p%Coefs(:,ColCl)) ! just to initialize these values... UA will turn off without using them + else do Row=1,p%NumAlf if (EqualRealNos( p%alpha(Row), p%UA_BL%alpha0)) then f_st = 1.0_ReKi ! Eq. 59 - p%Coefs(Row,col_fs) = p%Coefs(Row,ColCl) / 2.0_ReKi ! Eq. 61 (which should be very close to 0 because definition of alpha0 says cl(alpha0) = 0 ) + fullySeparate = p%Coefs(Row,ColCl) / 2.0_ReKi ! Eq. 61 (which should be very close to 0 because definition of alpha0 says cl(alpha0) = 0 ) else cl_ratio = p%Coefs(Row,ColCl) / ( p%UA_BL%c_lalpha*(p%alpha(Row) - p%UA_BL%alpha0)) @@ -1040,19 +1261,19 @@ SUBROUTINE CalculateUACoeffs(CalcDefaults,p,ColCl,ColCd,ColCm,ColUAf,UA_f_cn) f_st = 1.0_ReKi fullySeparate = p%Coefs(Row,ColCl) / 2.0_ReKi ! Eq. 61 end if - - p%Coefs(Row,col_fs) = fullySeparate - + end if p%Coefs(Row,ColUAf) = f_st + p%Coefs(Row,col_fs) = fullySeparate + p%Coefs(Row,col_fa) = p%UA_BL%c_lalpha * (p%alpha(Row) - p%UA_BL%alpha0) ! not used in the UA model (it's specified directly), but computed here for completeness end do - - ! Compute variables to help x3 state with +/-180-degree wrap-around issues - ! and make sure that the separation function is monotonic before iLow and after iHigh: - call ComputeUASeparationFunction_zero(p, ColUAf, p%Coefs(:,ColCl)) ! this was comparing with alpha0, but now we compaer with alphaUpper and alphaLower - + + ! These variables aren't used with the models that use Cl instead of Cn, but it's a way to initialize the values. + ! They make sure that the separation function is monotonic before p%UA_BL%alphaLower and after p%UA_BL%alphaUpper: + call ComputeUASeparationFunction_zero(p, ColUAf, p%Coefs(:,ColCl)) ! this was comparing with alpha0, but now we compare with alphaUpper and alphaLower + ! Ensuring everything is in harmony do Row=1,p%NumAlf @@ -1072,295 +1293,291 @@ SUBROUTINE CalculateUACoeffs(CalcDefaults,p,ColCl,ColCd,ColCm,ColUAf,UA_f_cn) end if ! c_lalpha == 0 - - else - - call ComputeUASeparationFunction(p, ColUAf, cn) - - end if - - ! alpha1, alpha2, Cn1 and Cn2 - iLow = 1 - f_iLow = huge(f_iHigh) - iHigh = p%NumAlf - f_iHigh = f_iLow - do Row=1,p%NumAlf - if (p%alpha(Row) < p%UA_BL%AlphaLower) then - f_st = abs(p%Coefs(Row,ColUAf) - fAtCriticalCn) - if ( f_st < f_iLow ) then - iLow = Row - f_iLow = f_st - end if - else if (p%alpha(Row) > p%UA_BL%AlphaUpper) then - f_st = abs(p%Coefs(Row,ColUAf) - fAtCriticalCn) - if ( f_st < f_iHigh ) then - iHigh = Row - f_iHigh = f_st - end if - end if - end do - - ! alpha2 - if (CalcDefaults%alpha2) then - if ( (p%Coefs(iLow,ColUAf) < fAtCriticalCn .and. iLow < p%NumAlf) .or. iLow == 1) then - iLow2 = iLow + 1 - else - iLow2 = iLow - 1 - end if - - slope = (p%Coefs(iLow,ColUAf) - p%Coefs(iLow2,ColUAf)) / (p%alpha(iLow) - p%alpha(iLow2)) - if (EqualRealNos(slope, 0.0_ReKi) ) then - p%UA_BL%alpha2 = p%alpha(iLow) - else - p%UA_BL%alpha2 = (fAtCriticalCn - p%Coefs(iLow,ColUAf)) / slope + p%alpha(iLow) - end if - end if - - ! alpha1 - if (CalcDefaults%alpha1) then - if ((p%Coefs(iHigh,ColUAf) < fAtCriticalCn .and. iHigh > 1) .or. iHigh == p%NumAlf) then - iHigh2 = iHigh - 1 - else - iHigh2 = iHigh + 1 - end if - slope =(p%Coefs(iHigh,ColUAf) - p%Coefs(iHigh2,ColUAf)) / (p%alpha(iHigh) - p%alpha(iHigh2)) - if (EqualRealNos(slope, 0.0_ReKi) ) then - p%UA_BL%alpha1 = p%alpha(iHigh) - else - p%UA_BL%alpha1 = (fAtCriticalCn - p%Coefs(iHigh,ColUAf)) / slope + p%alpha(iHigh) - end if - end if - - - ! Cn1 - if (CalcDefaults%Cn1) then - p%UA_BL%Cn1 = InterpStp( p%UA_BL%alpha1, p%alpha, cn, iHigh, p%NumAlf ) - end if - - ! Cn2 - if (CalcDefaults%Cn2) then - p%UA_BL%Cn2 = InterpStp( p%UA_BL%alpha2, p%alpha, cn, iLow, p%NumAlf ) - end if - - ! after we know the fully attached Cn - - end if ! UA is included + END SUBROUTINE ComputeUASeparationFunction_onCl +!---------------------------------------------------------------------------------------------------------------------------------- + SUBROUTINE Compute_iLoweriUpper(p, iLower, iUpper) + TYPE (AFI_Table_Type), intent(in ) :: p ! This structure stores all the module parameters that are set by AirfoilInfo during the initialization phase. + INTEGER(IntKi) , intent( out) :: iLower ! The lower index separating the region around 0 + INTEGER(IntKi) , intent( out) :: iUpper ! The upper index separating the region around 0 + + !------------------------------------------------ + ! get bounds + !------------------------------------------------ + iLower = minloc( p%alpha , DIM=1, MASK=p%alpha >= p%UA_BL%alphaLower) + iUpper = maxloc( p%alpha , DIM=1, MASK=p%alpha <= p%UA_BL%alphaUpper) + + iLower = max(1, min(p%NumAlf-1,iLower)) ! 1 <= iLower <= NumAlf-1 + iUpper = max(2, min(p%NumAlf ,iUpper)) ! 2 <= iUpper <= NumAlf - END SUBROUTINE CalculateUACoeffs + END SUBROUTINE Compute_iLoweriUpper !---------------------------------------------------------------------------------------------------------------------------------- - SUBROUTINE ComputeUASeparationFunction(p, ColUAf, cn_cl) + SUBROUTINE ComputeUASeparationFunction_zero(p, ColUAf, cn_cl) TYPE (AFI_Table_Type), intent(inout) :: p ! This structure stores all the module parameters that are set by AirfoilInfo during the initialization phase. integer(IntKi), intent(in ) :: ColUAf ! column for UA f_st (based on Cl or cn) REAL(ReKi), intent(in ) :: cn_cl(:) ! cn or cl, whichever variable we are computing this on - REAL(ReKi) :: temp + REAL(ReKi) :: c_RateBreak ! the slope of the wrap-around region INTEGER(IntKi) :: Row ! The row of a table to be parsed in the FileInfo structure. INTEGER(IntKi) :: col_fs ! column for UA cn/cl_fs (fully separated cn or cl) INTEGER(IntKi) :: col_fa ! column for UA cn/cl_fa (fully attached cn or cl) - - REAL(ReKi) :: c_ratio - REAL(ReKi) :: f_st - REAL(ReKi) :: denom - REAL(ReKi) :: fullySeparate - INTEGER(IntKi) :: iHigh, iLow - INTEGER(IntKi) :: iHigh_2, iLow_2 - INTEGER(IntKi) :: iHigh_1, iLow_1 - - REAL(ReKi) :: c_num, c_den - REAL(ReKi) :: c_offset + INTEGER(IntKi) :: iTemp !------------------------------------------------ ! set column numbers !------------------------------------------------ col_fs = ColUAf + 1 col_fa = col_fs + 1 + + ! initialize so that we can find the minimum f on each side of the attached region + !iLow = minloc(p%Coefs(:,ColUAf), DIM=1, MASK=p%alpha < p%UA_BL%alphaLower, BACK=.TRUE.) ! because not all compilers allow keyword "BACK" from the F2008 standard, we implement this way: + iTemp = minloc(p%Coefs(:,ColUAf), DIM=1, MASK=p%alpha < p%UA_BL%alphaLower) ! because not all compilers (gcc) allow keyword "BACK" from the F2008 standard, we implement this way + iLow = maxloc( p%alpha, DIM=1, MASK=p%alpha < p%UA_BL%alphaLower .and. p%Coefs(:,ColUAf) == p%Coefs(iTemp,ColUAf) ) + + iHigh = minloc(p%Coefs(:,ColUAf), DIM=1, MASK=p%alpha > p%UA_BL%alphaUpper) + ! Compute variables to help x3 state with +/-180-degree wrap-around issues + p%UA_BL%alphaBreakUpper = p%alpha(iHigh) + p%UA_BL%alphaBreakLower = p%alpha(iLow) + p%UA_BL%CnBreakUpper = p%Coefs(iHigh,col_fa) + p%UA_BL%CnBreakLower = p%Coefs(iLow,col_fa) + + c_RateBreak = (p%UA_BL%CnBreakUpper - p%UA_BL%CnBreakLower) / ( (p%UA_BL%alphaBreakUpper-TwoPi) - p%UA_BL%alphaBreakLower) + + ! make sure that the separation function is monotonic before iLow and after iHigh: + do Row=1,iLow + p%Coefs(Row,col_fa) = (p%alpha(Row) - p%UA_BL%alphaBreakLower) * c_RateBreak + p%UA_BL%CnBreakLower + p%Coefs(Row,col_fs) = cn_cl(Row) + p%Coefs(Row,ColUAf) = 0.0_ReKi + end do + do Row=iHigh,p%NumAlf + p%Coefs(Row,col_fa) = (p%alpha(Row) - p%UA_BL%alphaBreakUpper) * c_RateBreak + p%UA_BL%CnBreakUpper + p%Coefs(Row,col_fs) = cn_cl(Row) + p%Coefs(Row,ColUAf) = 0.0_ReKi + end do + + END SUBROUTINE ComputeUASeparationFunction_zero +!---------------------------------------------------------------------------------------------------------------------------------- + SUBROUTINE ComputeUA360_AttachedFlow(p, ColUAf, cn_cl, iLower, iUpper) + TYPE (AFI_Table_Type), intent(inout) :: p ! This structure stores all the module parameters that are set by AirfoilInfo during the initialization phase. + integer(IntKi), intent(in ) :: ColUAf ! column for UA f_st (based on Cl or cn) + REAL(ReKi), intent(in ) :: cn_cl(:) ! cn or cl, whichever variable we are computing this on + INTEGER(IntKi) , intent( out) :: iLower ! The lower index separating the region around 0 + INTEGER(IntKi) , intent( out) :: iUpper ! The upper index separating the region around 0 + + REAL(ReKi) :: roots(p%NumAlf) + REAL(ReKi) :: x_(3), f_(3) + + REAL(ReKi) :: CnSlopeUpper, alpha0Upper + REAL(ReKi) :: CnSlopeLower, alpha0Lower + REAL(ReKi) :: CnSlopeReverseFlow ! Cn slope versus angle of attack for reverse flow, 1/rad + + + INTEGER(IntKi) :: Row ! The row of a table to be parsed in the FileInfo structure. + INTEGER(IntKi) :: iRoot + INTEGER(IntKi) :: col_fa ! column for UA cn/cl_fa (fully attached cn or cl) + INTEGER(IntKi) :: Indx + INTEGER(IntKi) :: nZeros + !------------------------------------------------ - ! calculate f_st, {cn | cl}_fs, and {cn | cl}_fa for UA model + ! set column numbers !------------------------------------------------ - if (p%UA_BL%alphaLower > p%UA_BL%alphaUpper) then ! switch them around - temp = p%UA_BL%alphaUpper - p%UA_BL%alphaUpper = p%UA_BL%alphaLower - p%UA_BL%alphaLower = temp - end if - + col_fa = ColUAf + 2 + !------------------------------------------------ - ! find iLow where p%alpha(iLow) = p%UA_BL%alphaLower - ! Note that we may have specified an alphaLower that is not in the input alpha table, so we get the closest value + ! get bounds !------------------------------------------------ - iLow = 1 ! start at first index - CALL LocateBin( p%UA_BL%alphaLower, p%alpha, iLow, p%NumAlf ) - if (iLow < p%NumAlf) then - if ( p%alpha(iLow+1) - p%UA_BL%alphaLower < p%UA_BL%alphaLower - p%alpha(iLow) ) then ! see if p%alpha(iLow) or p%alpha(iLow+1) is the closest index - if (p%UA_BL%alphaUpper > p%alpha(iLow+1)) iLow = iLow + 1 !if we don't go past, alphaUpper, use the closest alpha: p%alpha(iLow+1) - end if - else - iLow = p%NumAlf - 1 ! we can't have IndLower > IndUpper, so fix it here. - end if - ! figure out which side of iLow to compute the slope later: - iLow_2 = iLow + 1 - iLow_1 = iLow - - ! get value - p%UA_BL%c_alphaLower = InterpStp( p%UA_BL%alphaLower, p%alpha, cn_cl, iLow, p%NumAlf ) + call Compute_iLoweriUpper(p, iLower, iUpper) + p%UA_BL%alphaLower = p%alpha(iLower) ! note we are overwritting values here to make them consistent in the linear equation + p%UA_BL%alphaUpper = p%alpha(iUpper) ! note we are overwritting values here to make them consistent in the linear equation + + p%UA_BL%c_alphaLower = cn_cl(iLower) ! for vortex calculations (x5, HGMV model) + p%UA_BL%c_alphaUpper = cn_cl(iUpper) ! for vortex calculations (x5, HGMV model) !------------------------------------------------ - ! find iHigh where p%alpha(iHigh) is approximately p%UA_BL%alphaUpper - ! Note that we may have specified an alphaUpper that is not in the input alpha table, so we get the closest value - ! also making sure that iLow < iHigh + ! From dynamicStallLUT.m/updateCnAttached() !------------------------------------------------ - iHigh = iLow_1 ! start at first index - CALL LocateStp( p%UA_BL%alphaUpper, p%alpha, iHigh, p%NumAlf ) - if (iHigh < p%NumAlf) then - if (iHigh >= iLow) then - if ( p%alpha(iHigh+1) - p%UA_BL%alphaUpper < p%UA_BL%alphaUpper - p%alpha(iHigh) ) iHigh = iHigh + 1 - else - iHigh = iLow + 1 - end if + CnSlopeUpper = ( cn_cl(iUpper-1) - cn_cl(iUpper) ) / ( p%alpha(iUpper-1) - p%alpha(iUpper) ) + if (EqualRealNos(CnSlopeUpper, 0.0_ReKi)) then + alpha0Upper = p%alpha(iUpper) + else + alpha0Upper = p%alpha(iUpper) - cn_cl(iUpper)/CnSlopeUpper; end if - ! figure out which side of iHigh to compute the slope later: - iHigh_2= iHigh - 1 - iHigh_1 = iHigh - - p%UA_BL%c_alphaUpper = InterpStp( p%UA_BL%alphaUpper, p%alpha, cn_cl, iHigh, p%NumAlf ) - !------------------------------------------------ - ! Compute derivatives for fully attached values of cn or cl: - !------------------------------------------------ - denom = (p%UA_BL%alphaLower - p%UA_BL%alphaUpper) - if (EqualRealNos(denom,0.0_ReKi)) then - p%UA_BL%c_Rate = 0.0_ReKi + CnSlopeLower = ( cn_cl(iLower) - cn_cl(iLower+1) ) / ( p%alpha(iLower) - p%alpha(iLower+1) ) + if (EqualRealNos(CnSlopeLower, 0.0_ReKi)) then + alpha0Lower = p%alpha(iLower) else - p%UA_BL%c_Rate = (p%UA_BL%c_alphaLower - p%UA_BL%c_alphaUpper)/(p%UA_BL%alphaLower - p%UA_BL%alphaUpper) + alpha0Lower = p%alpha(iLower) - cn_cl(iLower)/CnSlopeLower; end if - p%UA_BL%c_Rate = max(p%UA_BL%c_Rate, sqrt(epsilon(p%UA_BL%c_Rate))) ! make sure this isn't zero - ! these can't have zero in the denom because alphas are unique and the indices are not the same: - p%UA_BL%c_RateLower = (cn_cl( iLow_1) - cn_cl( iLow_2))/(p%alpha( iLow_1) - p%alpha( iLow_2)) - p%UA_BL%c_RateUpper = (cn_cl(iHigh_1) - cn_cl(iHigh_2))/(p%alpha(iHigh_1) - p%alpha(iHigh_2)) + ! Find reverse flow Cn = 0 near positive 180 deg (and not in the range (- 45, 45) degrees) + call fZeros(p%alpha, cn_cl, roots, nZeros, Period=TwoPi) + p%UA_BL%alpha0ReverseFlow = p%alpha(1) ! default value, in case there aren't any roots. Maybe this should be an error? + if (nZeros > 0) then + iRoot = maxloc( abs(roots(1:nZeros)), DIM=1, MASK=abs(roots(1:nZeros)) >= 45.0_ReKi*D2R ) + if (iRoot > 0) then + p%UA_BL%alpha0ReverseFlow = roots(iRoot) + if (p%UA_BL%alpha0ReverseFlow < -PiBy2) p%UA_BL%alpha0ReverseFlow = p%UA_BL%alpha0ReverseFlow + TwoPi !bjj check this value along with alphaBreakLower subtracting the TwoPi + end if + end if + CnSlopeReverseFlow = -TwoPi; - p%UA_BL%c_RateLower = max(p%UA_BL%c_RateLower, sqrt(epsilon(p%UA_BL%c_RateLower))) ! make sure this isn't zero - p%UA_BL%c_RateUpper = max(p%UA_BL%c_RateUpper, sqrt(epsilon(p%UA_BL%c_RateUpper))) ! make sure this isn't zero - ! Linear extrapolation using values computed with alphaLower and alphaUpper; - ! between alphaLower and alphaUpper, set equal to {cn | cl} so that we don't get asymptotic behavior in the separation function. - do Row=1,iLow-1 - p%Coefs(Row,col_fa) = (p%alpha(Row) - p%UA_BL%alphaLower) * p%UA_BL%c_RateLower + p%UA_BL%c_alphaLower + ! Find intersections + p%UA_BL%alphaBreakUpper = ( CnSlopeReverseFlow * p%UA_BL%alpha0ReverseFlow - CnSlopeUpper*alpha0Upper ) / ( CnSlopeReverseFlow - CnSlopeUpper ); + p%UA_BL%CnBreakUpper = CnSlopeUpper*( p%UA_BL%alphaBreakUpper - alpha0Upper ); + + p%UA_BL%alphaBreakLower = ( CnSlopeReverseFlow * (p%UA_BL%alpha0ReverseFlow - TwoPi) - CnSlopeLower*alpha0Lower ) / ( CnSlopeReverseFlow - CnSlopeLower ); + p%UA_BL%CnBreakLower = CnSlopeLower*( p%UA_BL%alphaBreakLower - alpha0Lower ); + + ! set fully attached values: + Indx = 1 + x_ = (/ p%UA_BL%alpha0ReverseFlow-TwoPi, p%UA_BL%alphaBreakLower, p%alpha(iLower) /) + f_ = (/ 0.0_ReKi, p%UA_BL%CnBreakLower, cn_cl(iLower) /) + do Row=1,iLower-1 + p%Coefs(Row,col_fa) = InterpExtrapStp(p%alpha(Row), x_, f_, Indx, size(x_)) end do - do Row=iLow,iHigh + + do Row=iLower,iUpper p%Coefs(Row,col_fa) = cn_cl(Row) end do - do Row=iHigh+1,p%NumAlf - p%Coefs(Row,col_fa) = (p%alpha(Row) - p%UA_BL%alphaUpper) * p%UA_BL%c_RateUpper + p%UA_BL%c_alphaUpper + + x_ = (/ p%alpha(iUpper), p%UA_BL%alphaBreakUpper, p%UA_BL%alpha0ReverseFlow /) + f_ = (/ cn_cl(iUpper) , p%UA_BL%CnBreakUpper, 0.0_ReKi /) + do Row=iUpper+1,p%NumAlf + p%Coefs(Row,col_fa) = InterpExtrapStp(p%alpha(Row), x_, f_, Indx, size(x_)) end do - !---------------------------------------------------------------------- - ! Compute separation function, f_st, as well as fully separated values: - !---------------------------------------------------------------------- - c_offset = (p%UA_BL%c_alphaLower + p%UA_BL%c_alphaUpper) / 2.0_ReKi + END SUBROUTINE ComputeUA360_AttachedFlow +!---------------------------------------------------------------------------------------------------------------------------------- + SUBROUTINE ComputeUA360_updateSeparationF( p, ColUAf, cn_cl, iLower, iUpper ) + TYPE (AFI_Table_Type), intent(inout) :: p ! This structure stores all the module parameters that are set by AirfoilInfo during the initialization phase. + integer(IntKi), intent(in ) :: ColUAf ! column for UA f_st (based on Cl or cn) + REAL(ReKi), intent(in ) :: cn_cl(:) ! cn or cl, whichever variable we are computing this on + INTEGER(IntKi) , intent(in ) :: iLower ! The lower index separating the region around 0 + INTEGER(IntKi) , intent(in ) :: iUpper ! The upper index separating the region around 0 + + REAL(ReKi) :: Offset + REAL(ReKi) :: CnRatio + REAL(ReKi) :: alpha_(p%NumAlf) ! temporary for calculating periodic f_st + REAL(ReKi) :: f_st( p%NumAlf) ! temporary for calculating periodic f_st + INTEGER(IntKi) :: Row ! The row of a table to be parsed in the FileInfo structure. + INTEGER(IntKi) :: col_fa ! column for UA cn/cl_fa (fully attached cn or cl) + INTEGER(IntKi) :: iReverseFlow ! The index where f_st is at a local max near +/-180 + INTEGER(IntKi) :: iUpperBreak ! The upper index separating the region around +/-180 + INTEGER(IntKi) :: iLowerBreak ! The lower index separating the region around +/-180 + + + !------------------------------------------------ + ! set column numbers + !------------------------------------------------ + col_fa = ColUAf + 2 ! fully attached (column values computed in ComputeUA360_AttachedFlow()) + + ! compute f_st (separation function, f = p%Coefs(Row,ColUAf)) do Row=1,p%NumAlf - - c_num = cn_cl(Row) - c_offset ! numerator - c_den = p%Coefs(Row,col_fa) - c_offset ! denominator - - if (EqualRealNos(c_den,0.0_ReKi)) then - c_ratio = 1.0_ReKi ! This will occur in the fully attached region, where we want f=1. - f_st = 1.0_ReKi + offset = ComputeUA360_CnOffset(p, cn_cl, Row, iLower) + if (EqualRealNos(p%Coefs(Row,col_fa),offset)) then + CnRatio = 1.0_ReKi else - c_ratio = max(0.25_ReKi, c_num / c_den) - f_st = (2.0_ReKi * sqrt(c_ratio) - 1.0_ReKi)**2 + CnRatio = (cn_cl(Row)-offset) / (p%Coefs(Row,col_fa)-offset); ! offset needed to ensure numerator and denomonator have same sign since sqrt is used next end if - - if (f_st < 1.0_ReKi) then - ! Region where f_st<1, merge - f_st = max(0.0_ReKi, f_st) ! make sure it is not negative - fullySeparate = (cn_cl(Row) - p%Coefs(Row,col_fa)*f_st) / (1.0_ReKi - f_st) - else - ! Fully attached region - f_st = 1.0_ReKi ! make sure it doesen't exceed 1 - fullySeparate = (cn_cl(Row) + c_offset)/ 2.0_ReKi - end if - - p%Coefs(Row,ColUAf) = f_st - p%Coefs(Row,col_fs) = fullySeparate + CnRatio = max( 0.25_ReKi, CnRatio ); ! below 1/4 we assume full separation and f = 0 + + p%Coefs(Row,ColUAf) = ( 2.0_ReKi * sqrt( CnRatio ) - 1.0_ReKi )**2 + + p%Coefs(Row,ColUAf) = min( p%Coefs(Row,ColUAf), 1.0_ReKi ) ! f <= 1 + p%Coefs(Row,ColUAf) = max( 0.0_ReKi, p%Coefs(Row,ColUAf) ) ! f >= 0 + + !if (EqualRealNos( p%Coefs(Row,col_fa), cn_cl(Row)) p%Coefs(Row,ColUAf) = 1.0_ReKi ! Set this below without EqualRealNos() + end do + + ! Where p%Coefs(Row,col_fa) == cn_cl(Row), set f = 1 + do Row=iLower,iUpper + p%Coefs(Row,ColUAf) = 1.0_ReKi end do + !----------------------------------------------------------- + ! now fix issues if there is a second peak near 180 degrees: + !----------------------------------------------------------- + iLowerBreak = maxloc( p%alpha , DIM=1, MASK=p%alpha <= p%UA_BL%alphaBreakLower) + alpha_ = cshift(p%alpha,iLowerBreak) + f_st = cshift(p%Coefs(:,ColUAf),iLowerBreak) + do Row = 2,p%NumAlf + if (alpha_(Row) < alpha_(Row-1)) alpha_(Row) = alpha_(Row)+TwoPi + end do - ! Compute variables to help x3 state with +/-180-degree wrap-around issues - ! and make sure that the separation function is monotonic before iLow and after iHigh: - call ComputeUASeparationFunction_zero(p, ColUAf, cn_cl) - - END SUBROUTINE ComputeUASeparationFunction + iReverseFlow = maxloc( f_st, DIM=1, MASK= alpha_ > p%UA_BL%alphaBreakUpper ) + iUpperBreak = minloc( alpha_ , DIM=1, MASK=alpha_ >= p%UA_BL%alphaBreakUpper) + + ! make sure this is monotonically decreasing from a single peak: + do Row=iReverseFlow-1,iUpperBreak+1,-1 +! if ( f_st(Row-1) > f_st(Row) ) f_st(Row-1) = max(0.0_ReKi, f_st(Row) - ABS( (f_st(Row+1) - f_st(Row) )/(alpha_(Row+1) - alpha_(Row)) * (alpha_(Row)-alpha_(Row-1)))) + if (EqualRealNos(f_st(Row),0.0_ReKi)) f_st(Row-1) = 0.0_ReKi + if ( f_st(Row-1) > f_st(Row) ) f_st(Row) = 0.5_ReKi * (f_st(Row+1) + f_st(Row-1)) + end do + do Row=iReverseFlow+1,p%NumAlf-1 +! if ( f_st(Row+1) > f_st(Row) ) f_st(Row+1) = max(0.0_ReKi, f_st(Row) - ABS( (f_st(Row-1) - f_st(Row) )/(alpha_(Row-1) - alpha_(Row)) * (alpha_(Row+1) - alpha_(Row)))) + if (EqualRealNos(f_st(Row),0.0_ReKi)) f_st(Row+1) = 0.0_ReKi + if ( f_st(Row+1) > f_st(Row) ) f_st(Row) = 0.5_ReKi * (f_st(Row+1) + f_st(Row-1)) + end do + + p%Coefs(:,ColUAf) = cshift(f_st,-iLowerBreak) + + + END SUBROUTINE ComputeUA360_updateSeparationF !---------------------------------------------------------------------------------------------------------------------------------- - SUBROUTINE ComputeUASeparationFunction_zero(p, ColUAf, cn_cl) + SUBROUTINE ComputeUA360_updateCnSeparated( p, ColUAf, cn_cl, iLower ) TYPE (AFI_Table_Type), intent(inout) :: p ! This structure stores all the module parameters that are set by AirfoilInfo during the initialization phase. integer(IntKi), intent(in ) :: ColUAf ! column for UA f_st (based on Cl or cn) REAL(ReKi), intent(in ) :: cn_cl(:) ! cn or cl, whichever variable we are computing this on + INTEGER(IntKi) , intent(in ) :: iLower ! The lower index separating the region around 0 + REAL(ReKi) :: Offset INTEGER(IntKi) :: Row ! The row of a table to be parsed in the FileInfo structure. - INTEGER(IntKi) :: col_fs ! column for UA cn/cl_fs (fully separated cn or cl) INTEGER(IntKi) :: col_fa ! column for UA cn/cl_fa (fully attached cn or cl) - INTEGER(IntKi) :: iHigh, iLow - REAL(ReKi) :: f_st ! separation function - REAL(ReKi) :: f_iHigh, f_iLow + INTEGER(IntKi) :: col_fs ! column for UA cn/cl_fa (fully separated cn or cl) !------------------------------------------------ ! set column numbers !------------------------------------------------ - col_fs = ColUAf + 1 - col_fa = col_fs + 1 - - - ! initialize so that we can find the minimum f on each side of the attached region - f_iHigh = huge(f_iHigh) - f_iLow = f_iHigh - iHigh = p%NumAlf - iLow = 1 - - - do Row=1,p%NumAlf + col_fa = ColUAf + 2 ! fully attached + col_fs = ColUAf + 1 ! fully separate - f_st = p%Coefs(Row,ColUAf) - - if (p%alpha(Row) < p%UA_BL%alphaLower) then ! find minimum f below alphaLower - if (f_st <= f_iLow) then - f_iLow = f_st - iLow = Row - end if - else if (p%alpha(Row) > p%UA_BL%alphaUpper) then - if (f_st < f_iHigh) then ! find minimum f above alphaUpper - f_iHigh = f_st - iHigh = Row - end if + do Row=1,p%NumAlf + if (EqualRealNos( p%Coefs(Row,ColUAf), 1.0_ReKi )) then + offset = ComputeUA360_CnOffset(p, cn_cl, Row, iLower) + p%Coefs(Row,col_fs) = 0.5_ReKi * (cn_cl(Row) + offset) + else + p%Coefs(Row,col_fs) = ( cn_cl(Row) - p%Coefs(Row,col_fa) * p%Coefs(Row,ColUAf) ) / ( 1.0_ReKi - p%Coefs(Row,ColUAf) ) end if - end do + END SUBROUTINE ComputeUA360_updateCnSeparated +!---------------------------------------------------------------------------------------------------------------------------------- + REAL(ReKi) FUNCTION ComputeUA360_CnOffset(p, cn_cl, Row, iLower) RESULT(offset) + TYPE (AFI_Table_Type), intent(in ) :: p ! This structure stores all the module parameters that are set by AirfoilInfo during the initialization phase. + REAL(ReKi), intent(in ) :: cn_cl(:) ! cn or cl, whichever variable we are computing this on + INTEGER(IntKi) , intent(in ) :: Row ! The row of a table to be parsed in the FileInfo structure. + INTEGER(IntKi) , intent(in ) :: iLower ! The lower index separating the region around 0 + + REAL(ReKi) :: CnOffset ! Mathematical trick: offset to Cn making formulation of f-separation behave for strange polars with negative stall at positive Cn values (usually soiled polars for thick airfoils) + REAL(ReKi) :: SlopeScale + + + ! compute cnOffset + if (cn_cl(iLower) > -0.05) then + CnOffset = cn_cl(iLower) + 0.05 + else + CnOffset = 0.0_ReKi + end if - ! Compute variables to help x3 state with +/-180-degree wrap-around issues - p%UA_BL%alphaUpperWrap = p%alpha(iHigh) - p%UA_BL%alphaLowerWrap = p%alpha(iLow) - p%UA_BL%c_RateWrap = (p%Coefs(iHigh,col_fa) - p%Coefs(iLow,col_fa)) / ( (p%alpha(iHigh)-TwoPi) - p%alpha(iLow)) - p%UA_BL%c_alphaUpperWrap = p%Coefs(iHigh,col_fa) - p%UA_BL%c_alphaLowerWrap = p%Coefs(iLow,col_fa) - - ! make sure that the separation function is monotonic before iLow and after iHigh: - do Row=1,iLow - p%Coefs(Row,col_fa) = (p%alpha(Row) - p%UA_BL%alphaLowerWrap) * p%UA_BL%c_RateWrap + p%UA_BL%c_alphaLowerWrap - p%Coefs(Row,col_fs) = cn_cl(Row) - p%Coefs(Row,ColUAf) = 0.0_ReKi - end do - do Row=iHigh,p%NumAlf - p%Coefs(Row,col_fa) = (p%alpha(Row) - p%UA_BL%alphaUpperWrap) * p%UA_BL%c_RateWrap + p%UA_BL%c_alphaUpperWrap - p%Coefs(Row,col_fs) = cn_cl(Row) - p%Coefs(Row,ColUAf) = 0.0_ReKi - end do - -END SUBROUTINE ComputeUASeparationFunction_zero + SlopeScale = 0.1_ReKi*R2D + offset = CnOffset * ( tanh(SlopeScale*(p%alpha(Row)+PiBy2)) - tanh(SlopeScale*(p%alpha(Row)-PiBy2)) ) / 2.0_ReKi; !Only apply Cn offset in vicinity of AoA 0 deg + END FUNCTION ComputeUA360_CnOffset !---------------------------------------------------------------------------------------------------------------------------------- subroutine FindBoundingTables(p, secondaryDepVal, lowerTable, upperTable, xVals) @@ -1570,6 +1787,7 @@ subroutine AFI_ComputeAirfoilCoefs1D( AOA, p, AFI_interp, errStat, errMsg, Table AFI_interp%Cm0 = 0.0_ReKi end if + end subroutine AFI_ComputeAirfoilCoefs1D !---------------------------------------------------------------------------------------------------------------------------------- @@ -1647,4 +1865,311 @@ subroutine AFI_ComputeUACoefs( p, Re, UserProp, UA_BL, errMsg, errStat ) end subroutine AFI_ComputeUACoefs !============================================================================= +subroutine AFI_WrHeader(delim, FileName, unOutFile, ErrStat, ErrMsg) + + character(*), intent(in ) :: delim + character(*), intent(in ) :: FileName + integer(IntKi), intent( out) :: unOutFile + 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 + character(*), parameter :: RoutineName = 'AFI_WrHeader' + + integer, parameter :: MaxLen = 17 + integer, parameter :: NumChans = 46 + character(MaxLen) :: ChanName( NumChans) + character(MaxLen) :: ChanUnit( NumChans) + + + i=1 + ChanName(i) = 'AirfoilNumber'; ChanUnit(i) = '(-)'; i = i+1; + ChanName(i) = 'TableNumber'; ChanUnit(i) = '(-)'; i = i+1; + ChanName(i) = 'alpha0'; ChanUnit(i) = '(deg)'; i = i+1; + ChanName(i) = 'alpha1'; ChanUnit(i) = '(deg)'; i = i+1; + ChanName(i) = 'alpha2'; ChanUnit(i) = '(deg)'; i = i+1; + ChanName(i) = 'eta_e'; ChanUnit(i) = '(-)'; i = i+1; + ChanName(i) = 'C_nalpha'; ChanUnit(i) = '(-/rad)'; i = i+1; + ChanName(i) = 'C_lalpha'; ChanUnit(i) = '(-/rad)'; i = i+1; + ChanName(i) = 'T_f0'; ChanUnit(i) = '(-)'; i = i+1; + ChanName(i) = 'T_V0'; ChanUnit(i) = '(-)'; i = i+1; + ChanName(i) = 'T_p'; ChanUnit(i) = '(-)'; i = i+1; + ChanName(i) = 'T_VL'; ChanUnit(i) = '(-)'; i = i+1; + ChanName(i) = 'b1'; ChanUnit(i) = '(-)'; i = i+1; + ChanName(i) = 'b2'; ChanUnit(i) = '(-)'; i = i+1; + ChanName(i) = 'b5'; ChanUnit(i) = '(-)'; i = i+1; + ChanName(i) = 'A1'; ChanUnit(i) = '(-)'; i = i+1; + ChanName(i) = 'A2'; ChanUnit(i) = '(-)'; i = i+1; + ChanName(i) = 'A5'; ChanUnit(i) = '(-)'; i = i+1; + ChanName(i) = 'S1'; ChanUnit(i) = '(-)'; i = i+1; + ChanName(i) = 'S2'; ChanUnit(i) = '(-)'; i = i+1; + ChanName(i) = 'S3'; ChanUnit(i) = '(-)'; i = i+1; + ChanName(i) = 'S4'; ChanUnit(i) = '(-)'; i = i+1; + ChanName(i) = 'Cn1'; ChanUnit(i) = '(-)'; i = i+1; + ChanName(i) = 'Cn2'; ChanUnit(i) = '(-)'; i = i+1; + ChanName(i) = 'St_sh'; ChanUnit(i) = '(-)'; i = i+1; + ChanName(i) = 'Cd0'; ChanUnit(i) = '(-)'; i = i+1; + ChanName(i) = 'Cm0'; ChanUnit(i) = '(-)'; i = i+1; + ChanName(i) = 'k0'; ChanUnit(i) = '(-)'; i = i+1; + ChanName(i) = 'k1'; ChanUnit(i) = '(-)'; i = i+1; + ChanName(i) = 'k2'; ChanUnit(i) = '(-)'; i = i+1; + ChanName(i) = 'k3'; ChanUnit(i) = '(-)'; i = i+1; + ChanName(i) = 'k1_hat'; ChanUnit(i) = '(-)'; i = i+1; + ChanName(i) = 'x_cp_bar'; ChanUnit(i) = '(-)'; i = i+1; + ChanName(i) = 'UACutout'; ChanUnit(i) = '(deg)'; i = i+1; + ChanName(i) = 'UACutout_delta'; ChanUnit(i) = '(deg)'; i = i+1; + ChanName(i) = 'UACutout_blend'; ChanUnit(i) = '(deg)'; i = i+1; + ChanName(i) = 'filtCutOff'; ChanUnit(i) = '(-)'; i = i+1; + ChanName(i) = 'alphaLower'; ChanUnit(i) = '(deg)'; i = i+1; + ChanName(i) = 'alphaUpper'; ChanUnit(i) = '(deg)'; i = i+1; + ChanName(i) = 'c_alphaLower'; ChanUnit(i) = '(-)'; i = i+1; + ChanName(i) = 'c_alphaUpper'; ChanUnit(i) = '(-)'; i = i+1; + ChanName(i) = 'alpha0ReverseFlow'; ChanUnit(i) = '(deg)'; i = i+1; + ChanName(i) = 'alphaBreakUpper'; ChanUnit(i) = '(deg)'; i = i+1; + ChanName(i) = 'CnBreakUpper'; ChanUnit(i) = '(-)'; i = i+1; + ChanName(i) = 'alphaBreakLower'; ChanUnit(i) = '(deg)'; i = i+1; + ChanName(i) = 'CnBreakLower'; ChanUnit(i) = '(-)'; i = i+1; + + !$OMP critical(filename) + CALL GetNewUnit( unOutFile, ErrStat, ErrMsg ) + if (ErrStat < AbortErrLev) then + CALL OpenFOutFile ( unOutFile, trim(FileName), ErrStat2, ErrMsg2 ) + endif + !$OMP end critical(filename) + + ! Generate file outputs + + write (unOutFile,'(/,A)') 'Predictions were generated on '//CurDate()//' at '//CurTime() !//' using '//trim(GetNVD(version)) + write (unOutFile,'(1X,A)') trim(ProgName) + write (unOutFile,'()' ) !print a blank line + write (unOutFile,'()' ) !print a blank line + write (unOutFile,'()' ) !print a blank line + + + !...................................................... + ! Write the names of the output parameters on one line: + !...................................................... + call WrFileNR ( unOutFile, ChanName(1) ) + do i=2,size(ChanName) + call WrFileNR ( unOutFile, delim//ChanName(i) ) + end do + write (unOutFile,'()') + + !...................................................... + ! Write the units of the output parameters on one line: + !...................................................... + call WrFileNR ( unOutFile, ChanUnit(1) ) + do i=2,size(ChanName) + call WrFileNR ( unOutFile, delim//ChanUnit(i) ) + end do + write (unOutFile,'()') + +end subroutine AFI_WrHeader +!============================================================================= +subroutine AFI_WrData(k, unOutFile, delim, AFInfo) + type(AFI_ParameterType), intent(in ) :: AFInfo ! The airfoil parameter data (for all airfoils) + integer, intent(in ) :: k + integer(IntKi), intent(in ) :: unOutFile + character(*), intent(in ) :: delim + + integer(IntKi) :: i + + integer, parameter :: MaxLen = 17 + integer, parameter :: NumChans = 46 + real(ReKi) :: TmpValues(NumChans) + character(3) :: MaxLenStr + character(80) :: Fmt + + MaxLenStr = trim(num2lstr(MaxLen)) + TmpValues = 0.0_ReKi ! initialize in case UAdata is not included in the airfoil table + + Fmt = '(I'//MaxLenStr//',"'//delim//'",I'//MaxLenStr//','//trim(num2lstr(NumChans))//'("'//delim//'",F'//MaxLenStr//'.5))' + + do i=1,size(AFInfo%Table) + IF (AFInfo%Table(i)%InclUAdata) then + WRITE(unOutFile, Fmt) k, i, & + AFInfo%Table(i)%UA_BL%alpha0*R2D , & + AFInfo%Table(i)%UA_BL%alpha1*R2D , & + AFInfo%Table(i)%UA_BL%alpha2*R2D , & + AFInfo%Table(i)%UA_BL%eta_e , & + AFInfo%Table(i)%UA_BL%C_nalpha , & + AFInfo%Table(i)%UA_BL%C_lalpha , & + AFInfo%Table(i)%UA_BL%T_f0 , & + AFInfo%Table(i)%UA_BL%T_V0 , & + AFInfo%Table(i)%UA_BL%T_p , & + AFInfo%Table(i)%UA_BL%T_VL , & + AFInfo%Table(i)%UA_BL%b1 , & + AFInfo%Table(i)%UA_BL%b2 , & + AFInfo%Table(i)%UA_BL%b5 , & + AFInfo%Table(i)%UA_BL%A1 , & + AFInfo%Table(i)%UA_BL%A2 , & + AFInfo%Table(i)%UA_BL%A5 , & + AFInfo%Table(i)%UA_BL%S1 , & + AFInfo%Table(i)%UA_BL%S2 , & + AFInfo%Table(i)%UA_BL%S3 , & + AFInfo%Table(i)%UA_BL%S4 , & + AFInfo%Table(i)%UA_BL%Cn1 , & + AFInfo%Table(i)%UA_BL%Cn2 , & + AFInfo%Table(i)%UA_BL%St_sh , & + AFInfo%Table(i)%UA_BL%Cd0 , & + AFInfo%Table(i)%UA_BL%Cm0 , & + AFInfo%Table(i)%UA_BL%k0 , & + AFInfo%Table(i)%UA_BL%k1 , & + AFInfo%Table(i)%UA_BL%k2 , & + AFInfo%Table(i)%UA_BL%k3 , & + AFInfo%Table(i)%UA_BL%k1_hat , & + AFInfo%Table(i)%UA_BL%x_cp_bar , & + AFInfo%Table(i)%UA_BL%UACutout*R2D , & + AFInfo%Table(i)%UA_BL%UACutout_delta*R2D, & + AFInfo%Table(i)%UA_BL%UACutout_blend*R2D, & + AFInfo%Table(i)%UA_BL%filtCutOff , & + AFInfo%Table(i)%UA_BL%alphaLower*R2D , & + AFInfo%Table(i)%UA_BL%alphaUpper*R2D , & + AFInfo%Table(i)%UA_BL%c_alphaLower , & + AFInfo%Table(i)%UA_BL%c_alphaUpper , & + AFInfo%Table(i)%UA_BL%alpha0ReverseFlow*R2D, & + AFInfo%Table(i)%UA_BL%alphaBreakUpper*R2D, & + AFInfo%Table(i)%UA_BL%CnBreakUpper , & + AFInfo%Table(i)%UA_BL%alphaBreakLower*R2D, & + AFInfo%Table(i)%UA_BL%CnBreakLower + + ELSE + WRITE(unOutFile, Fmt) k, i, TmpValues(3:) + END IF + end do + +end subroutine AFI_WrData +!============================================================================= +subroutine AFI_WrTables(AFI_Params,UAMod,OutRootName) + + type(AFI_ParameterType), intent(in), target :: AFI_Params + integer(IntKi), intent(in) :: UAMod + character(*), intent(in) :: OutRootName + + integer(IntKi) :: unOutFile + integer(IntKi) :: ErrStat + character(ErrMsgLen) :: ErrMsg + + Real(ReKi), allocatable :: cl_smooth(:) + Real(ReKi), allocatable :: cn_smooth(:) + Real(ReKi), allocatable :: cn(:) + Real(ReKi), allocatable :: cc(:) + Real(ReKi), allocatable :: cl_lin(:) + Real(ReKi), allocatable :: cn_lin(:) + + character(len=3) :: Prefix + character(len=11) :: sFullyAtt + character(len=8) :: sCm + integer :: iTab, iRow + type(AFI_Table_Type), pointer :: table !< Alias + + if (UAMod /= UA_HGM .and. UAMod /= UA_Oye) then + Prefix='Cn_' + sFullyAtt='Cn_FullyAtt' + else + Prefix='Cl_' + sFullyAtt='Dummy' + endif + if (AFI_Params%ColCm > 0) then + sCm='Cm' + else + sCm='Cm_Dummy' + endif + + + ! Loop on tables, write a different file for each table. + do iTab = 1, size(AFI_Params%Table) + table => AFI_Params%Table(iTab) + + ! Compute derived parameters from cl and cd, and UA_BL + allocate(cl_smooth(table%NumAlf)) + allocate(cn_smooth(table%NumAlf)) + allocate(cn (table%NumAlf)) + allocate(cc (table%NumAlf)) + allocate(cl_lin (table%NumAlf)) + allocate(cn_lin (table%NumAlf)) + + + cn = table%Coefs(:,AFI_Params%ColCl) * cos(table%alpha) + (table%Coefs(:,AFI_Params%ColCd) - table%UA_BL%Cd0) * sin(table%alpha); + cc = table%Coefs(:,AFI_Params%ColCl) * sin(table%alpha) - (table%Coefs(:,AFI_Params%ColCd) - table%UA_BL%Cd0) * cos(table%alpha); + cn_lin = table%UA_BL%C_nalpha * (table%alpha - table%UA_BL%alpha0) + cl_lin = table%UA_BL%C_lalpha * (table%alpha - table%UA_BL%alpha0) + + do iRow = 1, table%NumAlf + if ((table%alpha(iRow)table%UA_BL%alphaBreakUpper) then + cl_lin(iRow) =0.0_ReKi + cn_lin(iRow) =0.0_ReKi + endif + enddo + + ! Smoothing (used priot to compute slope in CalculateUACoeffs) + call kernelSmoothing(table%alpha, cn , kernelType_TRIWEIGHT, 2.0_ReKi*D2R, cn_smooth) + call kernelSmoothing(table%alpha, table%Coefs(:,AFI_Params%ColCl), kernelType_TRIWEIGHT, 2.0_ReKi*D2R, cl_smooth) + + + ! Write to file + !$OMP critical(filename) + CALL GetNewUnit( unOutFile, ErrStat, ErrMsg ) + if (ErrStat < AbortErrLev) then + CALL OpenFOutFile ( unOutFile, trim(OutRootName)//'.Coefs.'//trim(num2lstr(iTab))//'.out', ErrStat, ErrMsg ) + endif + !$OMP end critical(filename) + if (ErrStat >= AbortErrLev) then + call WrScr(Trim(ErrMsg)) + return + end if + + WRITE (unOutFile,'(/,A/)') 'These predictions were generated by AirfoilInfo on '//CurDate()//' at '//CurTime()//'.' + WRITE (unOutFile,'(/,A/)') ' ' + + if (AFI_Params%ColUAf > 0) then + WRITE(unOutFile, '(20(A20,1x))') 'Alpha', 'Cl', 'Cd', sCm, 'Cn', 'Cc', 'f_st', Prefix//'FullySep', sFullyAtt , 'Cl_lin','Cn_lin','Cl_smooth', 'Cn_smooth' + WRITE(unOutFile, '(20(A20,1x))') '(deg)', '(-)', '(-)', '(-)', '(-)', '(-)','(-)', '(-)' , '(-)' , '(-)' , '(-)' , '(-)' ,'(-)' + + ! TODO, we could do something with ColCpmim and ColUAf + if (AFI_Params%ColCm > 0) then + do iRow=1,size(table%Alpha) + WRITE(unOutFile, '(20(F20.6,1x))') table%Alpha(iRow)*R2D, table%Coefs(iRow,AFI_Params%ColCl), table%Coefs(iRow,AFI_Params%ColCd), table%Coefs(iRow,AFI_Params%ColCm), & + cn(iRow), cc(iRow), table%Coefs(iRow,AFI_Params%ColUAf:), cl_lin(iRow), cn_lin(iRow), cl_smooth(iRow), cn_smooth(iRow) + end do + else + do iRow=1,size(table%Alpha) + WRITE(unOutFile, '(20(F20.6,1x))') table%Alpha(iRow)*R2D, table%Coefs(iRow,AFI_Params%ColCl), table%Coefs(iRow,AFI_Params%ColCd), 0.0_ReKi, & + cn(iRow), cc(iRow), table%Coefs(iRow,AFI_Params%ColUAf:), cl_lin(iRow), cn_lin(iRow), cl_smooth(iRow), cn_smooth(iRow) + end do + endif + else + WRITE(unOutFile, '(20(A20,1x))') 'Alpha', 'Cl', 'Cd', sCm, 'Cn', 'Cc', 'Cl_lin','Cn_lin','Cl_smooth', 'Cn_smooth' + WRITE(unOutFile, '(20(A20,1x))') '(deg)', '(-)', '(-)', '(-)', '(-)', '(-)', '(-)' ,'(-)' ,'(-)' ,'(-)' + + ! TODO, we could do something with ColCpmim and ColUAf + if (AFI_Params%ColCm > 0) then + do iRow=1,size(table%Alpha) + WRITE(unOutFile, '(20(F20.6,1x))') table%Alpha(iRow)*R2D, table%Coefs(iRow,AFI_Params%ColCl), table%Coefs(iRow,AFI_Params%ColCd), table%Coefs(iRow,AFI_Params%ColCm), & + cn(iRow), cn(iRow), cl_lin(iRow), cn_lin(iRow), cl_smooth(iRow), cn_smooth(iRow) + end do + else + do iRow=1,size(table%Alpha) + WRITE(unOutFile, '(20(F20.6,1x))') table%Alpha(iRow)*R2D, table%Coefs(iRow,AFI_Params%ColCl), table%Coefs(iRow,AFI_Params%ColCd), 0.0_ReKi, & + cn(iRow), cn(iRow), cl_lin(iRow), cn_lin(iRow), cl_smooth(iRow), cn_smooth(iRow) + end do + endif + + end if + + CLOSE(unOutFile) + + if(allocated(cl_smooth)) deallocate(cl_smooth) + if(allocated(cn_smooth)) deallocate(cn_smooth) + if(allocated(cn )) deallocate(cn ) + if(allocated(cc )) deallocate(cc ) + if(allocated(cl_lin )) deallocate(cl_lin ) + if(allocated(cn_lin )) deallocate(cn_lin ) + enddo + +end subroutine AFI_WrTables +!============================================================================= + END MODULE AirfoilInfo diff --git a/modules/aerodyn/src/AirfoilInfo_Registry.txt b/modules/aerodyn/src/AirfoilInfo_Registry.txt index 853cd3e294..c4fff142f8 100644 --- a/modules/aerodyn/src/AirfoilInfo_Registry.txt +++ b/modules/aerodyn/src/AirfoilInfo_Registry.txt @@ -20,6 +20,18 @@ param AirfoilInfo/AFI - INTEGER AFITable_1 param AirfoilInfo/AFI - INTEGER AFITable_2Re - 2 - "2D interpolation on AoA and Re" - param AirfoilInfo/AFI - INTEGER AFITable_2User - 3 - "2D interpolation on AoA and UserProp" - +# These are UA models; defined here so that we can appropriately compute the separation function and attached flow values for the airfoil table. +# This is not an ideal place for the parameters, but AFI needs this information at initialization. +param AirfoilInfo/AFI - INTEGER UA_None - 0 - "Steady aerodynamics, using the same angle of attack convention as UA" - +param AirfoilInfo/AFI - INTEGER UA_Baseline - 1 - "UAMod = 1 [Baseline model (Original)]" - +param AirfoilInfo/AFI - INTEGER UA_Gonzalez - 2 - "UAMod = 2 [Gonzalez's variant (changes in Cn,Cc,Cm)]" - +param AirfoilInfo/AFI - INTEGER UA_MinnemaPierce - 3 - "Minnema/Pierce variant (changes in Cc and Cm)" - +param AirfoilInfo/AFI - INTEGER UA_HGM - 4 - "continuous variant of HGM (Hansen) model" - +param AirfoilInfo/AFI - INTEGER UA_HGMV - 5 - "continuous variant of HGM (Hansen) model with vortex modifications" - +param AirfoilInfo/AFI - INTEGER UA_Oye - 6 - "Stieg Oye dynamic stall model" - +param AirfoilInfo/AFI - INTEGER UA_BV - 7 - "Boeing-Vertol dynamic stall model (e.g. used in CACTUS)" - +param AirfoilInfo/AFI - INTEGER UA_HGMV360 - 8 - "continuous variant of HGM (Hansen) model with vortex modifications modified for 360-deg" - + # ..... Airfoil data ............................................................................................................... # The following derived type stores Beddoes-Leishman unsteady-aero data for an airfoil at a single combination of Re and control setting. The data can be computed internally of not read from the input file. @@ -53,7 +65,7 @@ typedef ^ ^ ReKi k1 typedef ^ ^ ReKi k2 - - - "airfoil parameter in the x_cp_hat curve best-fit [ignored if UAMod<>1]" - typedef ^ ^ ReKi k3 - - - "airfoil parameter in the x_cp_hat curve best-fit [ignored if UAMod<>1]" - typedef ^ ^ ReKi k1_hat - - - "Constant in the expression of Cc due to leading edge vortex effects. [ignored if UAMod<>1]" - -typedef ^ ^ ReKi x_cp_bar - - - "Constant in the expression of \hat(x)_cp^v [ignored if UAMod<>1, default = 0.2]" - +typedef ^ ^ ReKi x_cp_bar - - - "Constant in the expression of \\hat(x)_cp^v [ignored if UAMod<>1, default = 0.2]" - typedef ^ ^ ReKi UACutout - - - "Angle of attack above which unsteady aerodynamics are disabled" "input in degrees; stored as radians" typedef ^ ^ ReKi UACutout_delta - - - "Number of angles-of-attack below UACutout where unsteady aerodynamics begin to be disabled" "input in degrees; stored as radians" typedef ^ ^ ReKi UACutout_blend - - - "Angle of attack above which unsteady aerodynamics begins to be disabled" "stored as radians" @@ -61,17 +73,14 @@ typedef ^ ^ ReKi filtCutOff typedef ^ ^ ReKi alphaUpper - - 2pi "(input) upper angle of attack defining fully attached region" "input in degrees; stored as radians" typedef ^ ^ ReKi alphaLower - - 2pi "(input) lower angle of attack defining fully attached region" "input in degrees; stored as radians" -typedef ^ ^ ReKi c_Rate - - - "(calculated) linear slope in the fully attached region of cn or cl" "1/rad" -typedef ^ ^ ReKi c_RateUpper - - - "(calculated) linear slope in the upper fully attached region of cn or cl" "1/rad" -typedef ^ ^ ReKi c_RateLower - - - "(calculated) linear slope in the lower fully attached region of cn or cl" "1/rad" typedef ^ ^ ReKi c_alphaLower - - - "(calculated) value of cn or cl at alphaLower" "-" typedef ^ ^ ReKi c_alphaUpper - - - "(calculated) value of cn or cl at alphaUpper" "-" -typedef ^ ^ ReKi alphaUpperWrap - - 2pi "(calculated) upper angle of attack defining fully attached wrap-around region" "stored as radians" -typedef ^ ^ ReKi alphaLowerWrap - - 2pi "(calculated) lower angle of attack defining fully attached wrap-around region" "stored as radians" -typedef ^ ^ ReKi c_RateWrap - - - "(calculated) linear slope in the fully attached wrap-around region of cn or cl (will be negative)" "1/rad" -typedef ^ ^ ReKi c_alphaLowerWrap - - - "(calculated) value of cn or cl at alphaLowerWrap" "-" -typedef ^ ^ ReKi c_alphaUpperWrap - - - "(calculated) value of cn or cl at alphaUpperWrap" "-" +typedef ^ ^ ReKi alpha0ReverseFlow - - 2pi "(calculated) Angle of attack for Cn=0 for reverse flow" "rad" +typedef ^ ^ ReKi alphaBreakUpper - - 2pi "(calculated) Angle of attack where normal and reverse flow CnAttached intersect; between 0 and +pi; will be near +pi/2 deg in most cases" "rad" +typedef ^ ^ ReKi CnBreakUpper - - - "(calculated) CnAttached value at alphaBreakUpper where normal and reverse flow CnAttached intersect; will be positive" "-" +typedef ^ ^ ReKi alphaBreakLower - - 2pi "(calculated) Angle of attack where normal and reverse flow CnAttached intersect; between -pi and 0; will be near -pi/2 deg in most cases" "rad" +typedef ^ ^ ReKi CnBreakLower - - - "(calculated) CnAttached value at alphaBreakLower where normal and reverse flow CnAttached intersect; will be negative" "-" typedef AirfoilInfo/AFI AFI_UA_BL_Default_Type LOGICAL alpha0 - .true. - "Calculate value for this input?" - typedef ^ ^ LOGICAL alpha1 - .true. - "Calculate value for this input?" - @@ -132,7 +141,7 @@ typedef ^ ^ INTEGER InCol_Cl typedef ^ ^ INTEGER InCol_Cd - - - "The column of the coefficient tables that holds the minimum pressure coefficient" - typedef ^ ^ INTEGER InCol_Cm - - - "The column of the coefficient tables that holds the pitching-moment coefficient" - typedef ^ ^ INTEGER InCol_Cpmin - - - "The column of the coefficient tables that holds the minimum pressure coefficient" - -typedef ^ ^ LOGICAL UA_f_cn - - - "Whether any UA separation functions should be calculated on cn (true) or cl (false)" - +typedef ^ ^ INTEGER UAMod - - - "UA model: used to determine how UA separation functions should be calculated" - # Define outputs from the initialization routine here: typedef ^ InitOutputType ProgDesc Ver - - - "This module's name, version, and date" - diff --git a/modules/aerodyn/src/AirfoilInfo_Types.f90 b/modules/aerodyn/src/AirfoilInfo_Types.f90 index 64e6a7d477..3ee973c9d5 100644 --- a/modules/aerodyn/src/AirfoilInfo_Types.f90 +++ b/modules/aerodyn/src/AirfoilInfo_Types.f90 @@ -36,55 +36,61 @@ MODULE AirfoilInfo_Types INTEGER(IntKi), PUBLIC, PARAMETER :: AFITable_1 = 1 ! 1D interpolation on AoA (first table only) [-] INTEGER(IntKi), PUBLIC, PARAMETER :: AFITable_2Re = 2 ! 2D interpolation on AoA and Re [-] INTEGER(IntKi), PUBLIC, PARAMETER :: AFITable_2User = 3 ! 2D interpolation on AoA and UserProp [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: UA_None = 0 ! Steady aerodynamics, using the same angle of attack convention as UA [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: UA_Baseline = 1 ! UAMod = 1 [Baseline model (Original)] [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: UA_Gonzalez = 2 ! UAMod = 2 [Gonzalez's variant (changes in Cn,Cc,Cm)] [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: UA_MinnemaPierce = 3 ! Minnema/Pierce variant (changes in Cc and Cm) [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: UA_HGM = 4 ! continuous variant of HGM (Hansen) model [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: UA_HGMV = 5 ! continuous variant of HGM (Hansen) model with vortex modifications [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: UA_Oye = 6 ! Stieg Oye dynamic stall model [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: UA_BV = 7 ! Boeing-Vertol dynamic stall model (e.g. used in CACTUS) [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: UA_HGMV360 = 8 ! continuous variant of HGM (Hansen) model with vortex modifications modified for 360-deg [-] ! ========= AFI_UA_BL_Type ======= TYPE, PUBLIC :: AFI_UA_BL_Type - REAL(ReKi) :: alpha0 !< Angle of attack for zero lift (also used in HGM) [input in degrees; stored as radians] - REAL(ReKi) :: alpha1 !< angle of attack at f = 0.7, approximately the stall angle; for alpha >= alpha0 [input in degrees; stored as radians] - REAL(ReKi) :: alpha2 !< angle of attack at f = 0.7, approximately the stall angle; for alpha < alpha0 [input in degrees; stored as radians] - REAL(ReKi) :: eta_e !< Recovery factor in the range [0.85 - 0.95] [-] - REAL(ReKi) :: C_nalpha !< Cn slope for zero lift (used for Beddoes-Leishman unsteady aero) [1/rad] - REAL(ReKi) :: C_lalpha !< Cl slope for zero lift (used for HGM unsteady aero only) -> calculated [1/rad] - REAL(ReKi) :: T_f0 !< initial value of T_f, airfoil specific, used to compute D_f and fprimeprime (also used in HGM) [-] - REAL(ReKi) :: T_V0 !< initial value of T_V, airfoil specific, time parameter associated with the vortex lift decay process, used in Cn_v [-] - REAL(ReKi) :: T_p !< boundary-layer, leading edge pressure gradient time parameter; used in D_p; airfoil specific (also used in HGM) [-] - REAL(ReKi) :: T_VL !< Initial value of the time constant associated with the vortex advection process; it represents the non-dimensional time in semi-chords, needed for a vortex to travel from LE to trailing edge (TE); it is used in the expression of Cvn. It depends on Re, M (weakly), and airfoil. [valid range = 6 - 13] [-] - REAL(ReKi) :: b1 !< airfoil constant derived from experimental results (also used in HGM), usually 0.14 [-] - REAL(ReKi) :: b2 !< airfoil constant derived from experimental results (also used in HGM), usually 0.53 [-] - REAL(ReKi) :: b5 !< airfoil constant derived from experimental results, usually 5.0 [-] - REAL(ReKi) :: A1 !< airfoil constant derived from experimental results (also used in HGM), usually 0.3 [-] - REAL(ReKi) :: A2 !< airfoil constant derived from experimental results (also used in HGM), usually 0.7 [-] - REAL(ReKi) :: A5 !< airfoil constant derived from experimental results, usually 1.0 [-] - REAL(ReKi) :: S1 !< Constant in the f curve best-fit for alpha0<=AOA<=alpha1 [-] - REAL(ReKi) :: S2 !< Constant in the f curve best-fit for AOA> alpha1 [-] - REAL(ReKi) :: S3 !< Constant in the f curve best-fit for alpha2<=AOA< alpha0 [-] - REAL(ReKi) :: S4 !< Constant in the f curve best-fit for AOA< alpha2 [-] - REAL(ReKi) :: Cn1 !< Cn at stall value for positive angle of attack [or critical value of Cn_prime at LE separation for alpha >= alpha0] [-] - REAL(ReKi) :: Cn2 !< Cn at stall value for negative angle of attack [or critical value of Cn_prime at LE separation for alpha < alpha0] [-] - REAL(ReKi) :: St_sh !< Strouhal's shedding frequency constant. [-] - REAL(ReKi) :: Cd0 !< Minimum Cd value [-] - REAL(ReKi) :: Cm0 !< 2D pitching moment coefficient at zero lift, positive if nose is up [-] - REAL(ReKi) :: k0 !< airfoil parameter in the x_cp_hat curve best-fit [ignored if UAMod<>1] [-] - REAL(ReKi) :: k1 !< airfoil parameter in the x_cp_hat curve best-fit [ignored if UAMod<>1] [-] - REAL(ReKi) :: k2 !< airfoil parameter in the x_cp_hat curve best-fit [ignored if UAMod<>1] [-] - REAL(ReKi) :: k3 !< airfoil parameter in the x_cp_hat curve best-fit [ignored if UAMod<>1] [-] - REAL(ReKi) :: k1_hat !< Constant in the expression of Cc due to leading edge vortex effects. [ignored if UAMod<>1] [-] - REAL(ReKi) :: x_cp_bar !< Constant in the expression of \hat(x)_cp^v [ignored if UAMod<>1, default = 0.2] [-] - REAL(ReKi) :: UACutout !< Angle of attack above which unsteady aerodynamics are disabled [input in degrees; stored as radians] - REAL(ReKi) :: UACutout_delta !< Number of angles-of-attack below UACutout where unsteady aerodynamics begin to be disabled [input in degrees; stored as radians] - REAL(ReKi) :: UACutout_blend !< Angle of attack above which unsteady aerodynamics begins to be disabled [stored as radians] - REAL(ReKi) :: filtCutOff !< Reduced frequency cutoff used to calculate the dynamic low pass filter cut-off frequency for the pitching rate and accelerations [default = 0.5] [-] - REAL(ReKi) :: alphaUpper !< (input) upper angle of attack defining fully attached region [input in degrees; stored as radians] - REAL(ReKi) :: alphaLower !< (input) lower angle of attack defining fully attached region [input in degrees; stored as radians] - REAL(ReKi) :: c_Rate !< (calculated) linear slope in the fully attached region of cn or cl [1/rad] - REAL(ReKi) :: c_RateUpper !< (calculated) linear slope in the upper fully attached region of cn or cl [1/rad] - REAL(ReKi) :: c_RateLower !< (calculated) linear slope in the lower fully attached region of cn or cl [1/rad] - REAL(ReKi) :: c_alphaLower !< (calculated) value of cn or cl at alphaLower [-] - REAL(ReKi) :: c_alphaUpper !< (calculated) value of cn or cl at alphaUpper [-] - REAL(ReKi) :: alphaUpperWrap !< (calculated) upper angle of attack defining fully attached wrap-around region [stored as radians] - REAL(ReKi) :: alphaLowerWrap !< (calculated) lower angle of attack defining fully attached wrap-around region [stored as radians] - REAL(ReKi) :: c_RateWrap !< (calculated) linear slope in the fully attached wrap-around region of cn or cl (will be negative) [1/rad] - REAL(ReKi) :: c_alphaLowerWrap !< (calculated) value of cn or cl at alphaLowerWrap [-] - REAL(ReKi) :: c_alphaUpperWrap !< (calculated) value of cn or cl at alphaUpperWrap [-] + REAL(ReKi) :: alpha0 = 0.0_ReKi !< Angle of attack for zero lift (also used in HGM) [input in degrees; stored as radians] + REAL(ReKi) :: alpha1 = 0.0_ReKi !< angle of attack at f = 0.7, approximately the stall angle; for alpha >= alpha0 [input in degrees; stored as radians] + REAL(ReKi) :: alpha2 = 0.0_ReKi !< angle of attack at f = 0.7, approximately the stall angle; for alpha < alpha0 [input in degrees; stored as radians] + REAL(ReKi) :: eta_e = 0.0_ReKi !< Recovery factor in the range [0.85 - 0.95] [-] + REAL(ReKi) :: C_nalpha = 0.0_ReKi !< Cn slope for zero lift (used for Beddoes-Leishman unsteady aero) [1/rad] + REAL(ReKi) :: C_lalpha = 0.0_ReKi !< Cl slope for zero lift (used for HGM unsteady aero only) -> calculated [1/rad] + REAL(ReKi) :: T_f0 = 0.0_ReKi !< initial value of T_f, airfoil specific, used to compute D_f and fprimeprime (also used in HGM) [-] + REAL(ReKi) :: T_V0 = 0.0_ReKi !< initial value of T_V, airfoil specific, time parameter associated with the vortex lift decay process, used in Cn_v [-] + REAL(ReKi) :: T_p = 0.0_ReKi !< boundary-layer, leading edge pressure gradient time parameter; used in D_p; airfoil specific (also used in HGM) [-] + REAL(ReKi) :: T_VL = 0.0_ReKi !< Initial value of the time constant associated with the vortex advection process; it represents the non-dimensional time in semi-chords, needed for a vortex to travel from LE to trailing edge (TE); it is used in the expression of Cvn. It depends on Re, M (weakly), and airfoil. [valid range = 6 - 13] [-] + REAL(ReKi) :: b1 = 0.0_ReKi !< airfoil constant derived from experimental results (also used in HGM), usually 0.14 [-] + REAL(ReKi) :: b2 = 0.0_ReKi !< airfoil constant derived from experimental results (also used in HGM), usually 0.53 [-] + REAL(ReKi) :: b5 = 0.0_ReKi !< airfoil constant derived from experimental results, usually 5.0 [-] + REAL(ReKi) :: A1 = 0.0_ReKi !< airfoil constant derived from experimental results (also used in HGM), usually 0.3 [-] + REAL(ReKi) :: A2 = 0.0_ReKi !< airfoil constant derived from experimental results (also used in HGM), usually 0.7 [-] + REAL(ReKi) :: A5 = 0.0_ReKi !< airfoil constant derived from experimental results, usually 1.0 [-] + REAL(ReKi) :: S1 = 0.0_ReKi !< Constant in the f curve best-fit for alpha0<=AOA<=alpha1 [-] + REAL(ReKi) :: S2 = 0.0_ReKi !< Constant in the f curve best-fit for AOA> alpha1 [-] + REAL(ReKi) :: S3 = 0.0_ReKi !< Constant in the f curve best-fit for alpha2<=AOA< alpha0 [-] + REAL(ReKi) :: S4 = 0.0_ReKi !< Constant in the f curve best-fit for AOA< alpha2 [-] + REAL(ReKi) :: Cn1 = 0.0_ReKi !< Cn at stall value for positive angle of attack [or critical value of Cn_prime at LE separation for alpha >= alpha0] [-] + REAL(ReKi) :: Cn2 = 0.0_ReKi !< Cn at stall value for negative angle of attack [or critical value of Cn_prime at LE separation for alpha < alpha0] [-] + REAL(ReKi) :: St_sh = 0.0_ReKi !< Strouhal's shedding frequency constant. [-] + REAL(ReKi) :: Cd0 = 0.0_ReKi !< Minimum Cd value [-] + REAL(ReKi) :: Cm0 = 0.0_ReKi !< 2D pitching moment coefficient at zero lift, positive if nose is up [-] + REAL(ReKi) :: k0 = 0.0_ReKi !< airfoil parameter in the x_cp_hat curve best-fit [ignored if UAMod<>1] [-] + REAL(ReKi) :: k1 = 0.0_ReKi !< airfoil parameter in the x_cp_hat curve best-fit [ignored if UAMod<>1] [-] + REAL(ReKi) :: k2 = 0.0_ReKi !< airfoil parameter in the x_cp_hat curve best-fit [ignored if UAMod<>1] [-] + REAL(ReKi) :: k3 = 0.0_ReKi !< airfoil parameter in the x_cp_hat curve best-fit [ignored if UAMod<>1] [-] + REAL(ReKi) :: k1_hat = 0.0_ReKi !< Constant in the expression of Cc due to leading edge vortex effects. [ignored if UAMod<>1] [-] + REAL(ReKi) :: x_cp_bar = 0.0_ReKi !< Constant in the expression of \hat(x)_cp^v [ignored if UAMod<>1, default = 0.2] [-] + REAL(ReKi) :: UACutout = 0.0_ReKi !< Angle of attack above which unsteady aerodynamics are disabled [input in degrees; stored as radians] + REAL(ReKi) :: UACutout_delta = 0.0_ReKi !< Number of angles-of-attack below UACutout where unsteady aerodynamics begin to be disabled [input in degrees; stored as radians] + REAL(ReKi) :: UACutout_blend = 0.0_ReKi !< Angle of attack above which unsteady aerodynamics begins to be disabled [stored as radians] + REAL(ReKi) :: filtCutOff = 0.0_ReKi !< Reduced frequency cutoff used to calculate the dynamic low pass filter cut-off frequency for the pitching rate and accelerations [default = 0.5] [-] + REAL(ReKi) :: alphaUpper = 0.0_ReKi !< (input) upper angle of attack defining fully attached region [input in degrees; stored as radians] + REAL(ReKi) :: alphaLower = 0.0_ReKi !< (input) lower angle of attack defining fully attached region [input in degrees; stored as radians] + REAL(ReKi) :: c_alphaLower = 0.0_ReKi !< (calculated) value of cn or cl at alphaLower [-] + REAL(ReKi) :: c_alphaUpper = 0.0_ReKi !< (calculated) value of cn or cl at alphaUpper [-] + REAL(ReKi) :: alpha0ReverseFlow = 0.0_ReKi !< (calculated) Angle of attack for Cn=0 for reverse flow [rad] + REAL(ReKi) :: alphaBreakUpper = 0.0_ReKi !< (calculated) Angle of attack where normal and reverse flow CnAttached intersect; between 0 and +pi; will be near +pi/2 deg in most cases [rad] + REAL(ReKi) :: CnBreakUpper = 0.0_ReKi !< (calculated) CnAttached value at alphaBreakUpper where normal and reverse flow CnAttached intersect; will be positive [-] + REAL(ReKi) :: alphaBreakLower = 0.0_ReKi !< (calculated) Angle of attack where normal and reverse flow CnAttached intersect; between -pi and 0; will be near -pi/2 deg in most cases [rad] + REAL(ReKi) :: CnBreakLower = 0.0_ReKi !< (calculated) CnAttached value at alphaBreakLower where normal and reverse flow CnAttached intersect; will be negative [-] END TYPE AFI_UA_BL_Type ! ======================= ! ========= AFI_UA_BL_Default_Type ======= @@ -132,24 +138,24 @@ MODULE AirfoilInfo_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Alpha !< Angle-of-attack vector that matches the Coefs matrix [rad] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Coefs !< Airfoil coefficients for Cd, Cl, and maybe Cm and/or Cpmin [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: SplineCoefs !< Spline coefficients for Cd, Cl, and maybe Cm and/or Cpmin [-] - REAL(ReKi) :: UserProp !< User Property for a table, for example a Control setting [-] - REAL(ReKi) :: Re !< Reynolds number [-] - INTEGER(IntKi) :: NumAlf !< Length of the Alpha and Coefs arrays [-] - LOGICAL :: ConstData !< Flag that tells if aerodynamic coefficients are the same for all alphas [-] - LOGICAL :: InclUAdata !< Flag that tells if UA data is included in the input file [-] + REAL(ReKi) :: UserProp = 0.0_ReKi !< User Property for a table, for example a Control setting [-] + REAL(ReKi) :: Re = 0.0_ReKi !< Reynolds number [-] + INTEGER(IntKi) :: NumAlf = 0_IntKi !< Length of the Alpha and Coefs arrays [-] + LOGICAL :: ConstData = .false. !< Flag that tells if aerodynamic coefficients are the same for all alphas [-] + LOGICAL :: InclUAdata = .false. !< Flag that tells if UA data is included in the input file [-] TYPE(AFI_UA_BL_Type) :: UA_BL !< The tables of Leishman-Beddoes unsteady-aero data for given Re and control setting [-] END TYPE AFI_Table_Type ! ======================= ! ========= AFI_InitInputType ======= TYPE, PUBLIC :: AFI_InitInputType CHARACTER(1024) :: FileName !< The name of the file the data is read from [-] - INTEGER(IntKi) :: AFTabMod !< Interpolation method for multiple airfoil tables {1 = 1D on AoA (only first table is used); 2 = 2D on AoA and Re; 3 = 2D on AoA and UserProp} [-] - INTEGER(IntKi) :: InCol_Alfa !< The column of the coefficient tables that holds the angle of attack [-] - INTEGER(IntKi) :: InCol_Cl !< The column of the coefficient tables that holds the lift coefficient [-] - INTEGER(IntKi) :: InCol_Cd !< The column of the coefficient tables that holds the minimum pressure coefficient [-] - INTEGER(IntKi) :: InCol_Cm !< The column of the coefficient tables that holds the pitching-moment coefficient [-] - INTEGER(IntKi) :: InCol_Cpmin !< The column of the coefficient tables that holds the minimum pressure coefficient [-] - LOGICAL :: UA_f_cn !< Whether any UA separation functions should be calculated on cn (true) or cl (false) [-] + INTEGER(IntKi) :: AFTabMod = 0_IntKi !< Interpolation method for multiple airfoil tables {1 = 1D on AoA (only first table is used); 2 = 2D on AoA and Re; 3 = 2D on AoA and UserProp} [-] + INTEGER(IntKi) :: InCol_Alfa = 0_IntKi !< The column of the coefficient tables that holds the angle of attack [-] + INTEGER(IntKi) :: InCol_Cl = 0_IntKi !< The column of the coefficient tables that holds the lift coefficient [-] + INTEGER(IntKi) :: InCol_Cd = 0_IntKi !< The column of the coefficient tables that holds the minimum pressure coefficient [-] + INTEGER(IntKi) :: InCol_Cm = 0_IntKi !< The column of the coefficient tables that holds the pitching-moment coefficient [-] + INTEGER(IntKi) :: InCol_Cpmin = 0_IntKi !< The column of the coefficient tables that holds the minimum pressure coefficient [-] + INTEGER(IntKi) :: UAMod = 0_IntKi !< UA model: used to determine how UA separation functions should be calculated [-] END TYPE AFI_InitInputType ! ======================= ! ========= AFI_InitOutputType ======= @@ -159,20 +165,20 @@ MODULE AirfoilInfo_Types ! ======================= ! ========= AFI_ParameterType ======= TYPE, PUBLIC :: AFI_ParameterType - INTEGER(IntKi) :: ColCd !< The column in the p%Coefs arrays that contains Cd data [-] - INTEGER(IntKi) :: ColCl !< The column in the p%Coefs arrays that contains Cl data [-] - INTEGER(IntKi) :: ColCm !< The column in the p%Coefs arrays that contains Cm data [-] - INTEGER(IntKi) :: ColCpmin !< The column in the p%Coefs arrays that contains Cpmin data [-] - INTEGER(IntKi) :: ColUAf !< The column in the p%Coefs arrays that contains f_st data (on cl or cn) for UA [-] - INTEGER(IntKi) :: AFTabMod !< Interpolation method for multiple airfoil tables {1 = 1D on AoA (only first table is used); 2 = 2D on AoA and Re; 3 = 2D on AoA and UserProp} [-] + INTEGER(IntKi) :: ColCd = 0_IntKi !< The column in the p%Coefs arrays that contains Cd data [-] + INTEGER(IntKi) :: ColCl = 0_IntKi !< The column in the p%Coefs arrays that contains Cl data [-] + INTEGER(IntKi) :: ColCm = 0_IntKi !< The column in the p%Coefs arrays that contains Cm data [-] + INTEGER(IntKi) :: ColCpmin = 0_IntKi !< The column in the p%Coefs arrays that contains Cpmin data [-] + INTEGER(IntKi) :: ColUAf = 0_IntKi !< The column in the p%Coefs arrays that contains f_st data (on cl or cn) for UA [-] + INTEGER(IntKi) :: AFTabMod = 0_IntKi !< Interpolation method for multiple airfoil tables {1 = 1D on AoA (only first table is used); 2 = 2D on AoA and Re; 3 = 2D on AoA and UserProp} [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: secondVals !< The values of the 2nd dependent variable when using multiple airfoil tables (Re or UserProp, saved in an array so that the logic in the interpolation scheme is cleaner) [-] - INTEGER(IntKi) :: InterpOrd !< Interpolation order [-] - REAL(ReKi) :: RelThickness !< Relative thickness of airfoil thickness/chord [-] - REAL(ReKi) :: NonDimArea !< The non-dimensional area of the airfoil (area/chord^2) [unused] [-] - INTEGER(IntKi) :: NumCoords !< The number of coordinates which define the airfoil shape [-] + INTEGER(IntKi) :: InterpOrd = 0_IntKi !< Interpolation order [-] + REAL(ReKi) :: RelThickness = 0.0_ReKi !< Relative thickness of airfoil thickness/chord [-] + REAL(ReKi) :: NonDimArea = 0.0_ReKi !< The non-dimensional area of the airfoil (area/chord^2) [unused] [-] + INTEGER(IntKi) :: NumCoords = 0_IntKi !< The number of coordinates which define the airfoil shape [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: X_Coord !< X-coordinate for the airfoil shape [unused] [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Y_Coord !< Y-coordinate for the airfoil shape [unused] [-] - INTEGER(IntKi) :: NumTabs !< The number of airfoil tables in the airfoil file [-] + INTEGER(IntKi) :: NumTabs = 0_IntKi !< The number of airfoil tables in the airfoil file [-] TYPE(AFI_Table_Type) , DIMENSION(:), ALLOCATABLE :: Table !< The tables of airfoil data for given Re and control setting [-] CHARACTER(1024) :: BL_file !< The name of the file with the boundary layer data [-] CHARACTER(1024) :: FileName !< The name of the file that stored this information. [-] @@ -180,9 +186,9 @@ MODULE AirfoilInfo_Types ! ======================= ! ========= AFI_InputType ======= TYPE, PUBLIC :: AFI_InputType - REAL(ReKi) :: AoA !< The angle of attack [radians] - REAL(ReKi) :: UserProp !< The user-defined control setting [-] - REAL(ReKi) :: Re !< Reynolds number [-] + REAL(ReKi) :: AoA = 0.0_ReKi !< The angle of attack [radians] + REAL(ReKi) :: UserProp = 0.0_ReKi !< The user-defined control setting [-] + REAL(ReKi) :: Re = 0.0_ReKi !< Reynolds number [-] END TYPE AFI_InputType ! ======================= ! ========= AFI_OutputType ======= @@ -199,2539 +205,883 @@ MODULE AirfoilInfo_Types END TYPE AFI_OutputType ! ======================= CONTAINS - SUBROUTINE AFI_CopyUA_BL_Type( SrcUA_BL_TypeData, DstUA_BL_TypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AFI_UA_BL_Type), INTENT(IN) :: SrcUA_BL_TypeData - TYPE(AFI_UA_BL_Type), INTENT(INOUT) :: DstUA_BL_TypeData - 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 = 'AFI_CopyUA_BL_Type' -! - ErrStat = ErrID_None - ErrMsg = "" - DstUA_BL_TypeData%alpha0 = SrcUA_BL_TypeData%alpha0 - DstUA_BL_TypeData%alpha1 = SrcUA_BL_TypeData%alpha1 - DstUA_BL_TypeData%alpha2 = SrcUA_BL_TypeData%alpha2 - DstUA_BL_TypeData%eta_e = SrcUA_BL_TypeData%eta_e - DstUA_BL_TypeData%C_nalpha = SrcUA_BL_TypeData%C_nalpha - DstUA_BL_TypeData%C_lalpha = SrcUA_BL_TypeData%C_lalpha - DstUA_BL_TypeData%T_f0 = SrcUA_BL_TypeData%T_f0 - DstUA_BL_TypeData%T_V0 = SrcUA_BL_TypeData%T_V0 - DstUA_BL_TypeData%T_p = SrcUA_BL_TypeData%T_p - DstUA_BL_TypeData%T_VL = SrcUA_BL_TypeData%T_VL - DstUA_BL_TypeData%b1 = SrcUA_BL_TypeData%b1 - DstUA_BL_TypeData%b2 = SrcUA_BL_TypeData%b2 - DstUA_BL_TypeData%b5 = SrcUA_BL_TypeData%b5 - DstUA_BL_TypeData%A1 = SrcUA_BL_TypeData%A1 - DstUA_BL_TypeData%A2 = SrcUA_BL_TypeData%A2 - DstUA_BL_TypeData%A5 = SrcUA_BL_TypeData%A5 - DstUA_BL_TypeData%S1 = SrcUA_BL_TypeData%S1 - DstUA_BL_TypeData%S2 = SrcUA_BL_TypeData%S2 - DstUA_BL_TypeData%S3 = SrcUA_BL_TypeData%S3 - DstUA_BL_TypeData%S4 = SrcUA_BL_TypeData%S4 - DstUA_BL_TypeData%Cn1 = SrcUA_BL_TypeData%Cn1 - DstUA_BL_TypeData%Cn2 = SrcUA_BL_TypeData%Cn2 - DstUA_BL_TypeData%St_sh = SrcUA_BL_TypeData%St_sh - DstUA_BL_TypeData%Cd0 = SrcUA_BL_TypeData%Cd0 - DstUA_BL_TypeData%Cm0 = SrcUA_BL_TypeData%Cm0 - DstUA_BL_TypeData%k0 = SrcUA_BL_TypeData%k0 - DstUA_BL_TypeData%k1 = SrcUA_BL_TypeData%k1 - DstUA_BL_TypeData%k2 = SrcUA_BL_TypeData%k2 - DstUA_BL_TypeData%k3 = SrcUA_BL_TypeData%k3 - DstUA_BL_TypeData%k1_hat = SrcUA_BL_TypeData%k1_hat - DstUA_BL_TypeData%x_cp_bar = SrcUA_BL_TypeData%x_cp_bar - DstUA_BL_TypeData%UACutout = SrcUA_BL_TypeData%UACutout - DstUA_BL_TypeData%UACutout_delta = SrcUA_BL_TypeData%UACutout_delta - DstUA_BL_TypeData%UACutout_blend = SrcUA_BL_TypeData%UACutout_blend - DstUA_BL_TypeData%filtCutOff = SrcUA_BL_TypeData%filtCutOff - DstUA_BL_TypeData%alphaUpper = SrcUA_BL_TypeData%alphaUpper - DstUA_BL_TypeData%alphaLower = SrcUA_BL_TypeData%alphaLower - DstUA_BL_TypeData%c_Rate = SrcUA_BL_TypeData%c_Rate - DstUA_BL_TypeData%c_RateUpper = SrcUA_BL_TypeData%c_RateUpper - DstUA_BL_TypeData%c_RateLower = SrcUA_BL_TypeData%c_RateLower - DstUA_BL_TypeData%c_alphaLower = SrcUA_BL_TypeData%c_alphaLower - DstUA_BL_TypeData%c_alphaUpper = SrcUA_BL_TypeData%c_alphaUpper - DstUA_BL_TypeData%alphaUpperWrap = SrcUA_BL_TypeData%alphaUpperWrap - DstUA_BL_TypeData%alphaLowerWrap = SrcUA_BL_TypeData%alphaLowerWrap - DstUA_BL_TypeData%c_RateWrap = SrcUA_BL_TypeData%c_RateWrap - DstUA_BL_TypeData%c_alphaLowerWrap = SrcUA_BL_TypeData%c_alphaLowerWrap - DstUA_BL_TypeData%c_alphaUpperWrap = SrcUA_BL_TypeData%c_alphaUpperWrap - END SUBROUTINE AFI_CopyUA_BL_Type - - SUBROUTINE AFI_DestroyUA_BL_Type( UA_BL_TypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(AFI_UA_BL_Type), INTENT(INOUT) :: UA_BL_TypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AFI_DestroyUA_BL_Type' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE AFI_DestroyUA_BL_Type - - SUBROUTINE AFI_PackUA_BL_Type( 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(AFI_UA_BL_Type), 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 = 'AFI_PackUA_BL_Type' - ! 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 ! alpha0 - Re_BufSz = Re_BufSz + 1 ! alpha1 - Re_BufSz = Re_BufSz + 1 ! alpha2 - Re_BufSz = Re_BufSz + 1 ! eta_e - Re_BufSz = Re_BufSz + 1 ! C_nalpha - Re_BufSz = Re_BufSz + 1 ! C_lalpha - Re_BufSz = Re_BufSz + 1 ! T_f0 - Re_BufSz = Re_BufSz + 1 ! T_V0 - Re_BufSz = Re_BufSz + 1 ! T_p - Re_BufSz = Re_BufSz + 1 ! T_VL - Re_BufSz = Re_BufSz + 1 ! b1 - Re_BufSz = Re_BufSz + 1 ! b2 - Re_BufSz = Re_BufSz + 1 ! b5 - Re_BufSz = Re_BufSz + 1 ! A1 - Re_BufSz = Re_BufSz + 1 ! A2 - Re_BufSz = Re_BufSz + 1 ! A5 - Re_BufSz = Re_BufSz + 1 ! S1 - Re_BufSz = Re_BufSz + 1 ! S2 - Re_BufSz = Re_BufSz + 1 ! S3 - Re_BufSz = Re_BufSz + 1 ! S4 - Re_BufSz = Re_BufSz + 1 ! Cn1 - Re_BufSz = Re_BufSz + 1 ! Cn2 - Re_BufSz = Re_BufSz + 1 ! St_sh - Re_BufSz = Re_BufSz + 1 ! Cd0 - Re_BufSz = Re_BufSz + 1 ! Cm0 - Re_BufSz = Re_BufSz + 1 ! k0 - Re_BufSz = Re_BufSz + 1 ! k1 - Re_BufSz = Re_BufSz + 1 ! k2 - Re_BufSz = Re_BufSz + 1 ! k3 - Re_BufSz = Re_BufSz + 1 ! k1_hat - Re_BufSz = Re_BufSz + 1 ! x_cp_bar - Re_BufSz = Re_BufSz + 1 ! UACutout - Re_BufSz = Re_BufSz + 1 ! UACutout_delta - Re_BufSz = Re_BufSz + 1 ! UACutout_blend - Re_BufSz = Re_BufSz + 1 ! filtCutOff - Re_BufSz = Re_BufSz + 1 ! alphaUpper - Re_BufSz = Re_BufSz + 1 ! alphaLower - Re_BufSz = Re_BufSz + 1 ! c_Rate - Re_BufSz = Re_BufSz + 1 ! c_RateUpper - Re_BufSz = Re_BufSz + 1 ! c_RateLower - Re_BufSz = Re_BufSz + 1 ! c_alphaLower - Re_BufSz = Re_BufSz + 1 ! c_alphaUpper - Re_BufSz = Re_BufSz + 1 ! alphaUpperWrap - Re_BufSz = Re_BufSz + 1 ! alphaLowerWrap - Re_BufSz = Re_BufSz + 1 ! c_RateWrap - Re_BufSz = Re_BufSz + 1 ! c_alphaLowerWrap - Re_BufSz = Re_BufSz + 1 ! c_alphaUpperWrap - 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%alpha0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%alpha1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%alpha2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%eta_e - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%C_nalpha - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%C_lalpha - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%T_f0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%T_V0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%T_p - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%T_VL - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%b1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%b2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%b5 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%A1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%A2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%A5 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%S1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%S2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%S3 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%S4 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Cn1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Cn2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%St_sh - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Cd0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Cm0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%k0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%k1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%k2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%k3 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%k1_hat - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%x_cp_bar - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%UACutout - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%UACutout_delta - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%UACutout_blend - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%filtCutOff - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%alphaUpper - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%alphaLower - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%c_Rate - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%c_RateUpper - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%c_RateLower - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%c_alphaLower - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%c_alphaUpper - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%alphaUpperWrap - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%alphaLowerWrap - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%c_RateWrap - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%c_alphaLowerWrap - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%c_alphaUpperWrap - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AFI_PackUA_BL_Type - - SUBROUTINE AFI_UnPackUA_BL_Type( 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(AFI_UA_BL_Type), 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 = 'AFI_UnPackUA_BL_Type' - ! 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%alpha0 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%alpha1 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%alpha2 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%eta_e = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_nalpha = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_lalpha = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%T_f0 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%T_V0 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%T_p = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%T_VL = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%b1 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%b2 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%b5 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%A1 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%A2 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%A5 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%S1 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%S2 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%S3 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%S4 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Cn1 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Cn2 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%St_sh = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Cd0 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Cm0 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%k0 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%k1 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%k2 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%k3 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%k1_hat = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%x_cp_bar = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%UACutout = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%UACutout_delta = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%UACutout_blend = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%filtCutOff = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%alphaUpper = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%alphaLower = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%c_Rate = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%c_RateUpper = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%c_RateLower = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%c_alphaLower = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%c_alphaUpper = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%alphaUpperWrap = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%alphaLowerWrap = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%c_RateWrap = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%c_alphaLowerWrap = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%c_alphaUpperWrap = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AFI_UnPackUA_BL_Type - - SUBROUTINE AFI_CopyUA_BL_Default_Type( SrcUA_BL_Default_TypeData, DstUA_BL_Default_TypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AFI_UA_BL_Default_Type), INTENT(IN) :: SrcUA_BL_Default_TypeData - TYPE(AFI_UA_BL_Default_Type), INTENT(INOUT) :: DstUA_BL_Default_TypeData - 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 = 'AFI_CopyUA_BL_Default_Type' -! +subroutine AFI_CopyUA_BL_Type(SrcUA_BL_TypeData, DstUA_BL_TypeData, CtrlCode, ErrStat, ErrMsg) + type(AFI_UA_BL_Type), intent(in) :: SrcUA_BL_TypeData + type(AFI_UA_BL_Type), intent(inout) :: DstUA_BL_TypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AFI_CopyUA_BL_Type' ErrStat = ErrID_None - ErrMsg = "" - DstUA_BL_Default_TypeData%alpha0 = SrcUA_BL_Default_TypeData%alpha0 - DstUA_BL_Default_TypeData%alpha1 = SrcUA_BL_Default_TypeData%alpha1 - DstUA_BL_Default_TypeData%alpha2 = SrcUA_BL_Default_TypeData%alpha2 - DstUA_BL_Default_TypeData%eta_e = SrcUA_BL_Default_TypeData%eta_e - DstUA_BL_Default_TypeData%C_nalpha = SrcUA_BL_Default_TypeData%C_nalpha - DstUA_BL_Default_TypeData%C_lalpha = SrcUA_BL_Default_TypeData%C_lalpha - DstUA_BL_Default_TypeData%T_f0 = SrcUA_BL_Default_TypeData%T_f0 - DstUA_BL_Default_TypeData%T_V0 = SrcUA_BL_Default_TypeData%T_V0 - DstUA_BL_Default_TypeData%T_p = SrcUA_BL_Default_TypeData%T_p - DstUA_BL_Default_TypeData%T_VL = SrcUA_BL_Default_TypeData%T_VL - DstUA_BL_Default_TypeData%b1 = SrcUA_BL_Default_TypeData%b1 - DstUA_BL_Default_TypeData%b2 = SrcUA_BL_Default_TypeData%b2 - DstUA_BL_Default_TypeData%b5 = SrcUA_BL_Default_TypeData%b5 - DstUA_BL_Default_TypeData%A1 = SrcUA_BL_Default_TypeData%A1 - DstUA_BL_Default_TypeData%A2 = SrcUA_BL_Default_TypeData%A2 - DstUA_BL_Default_TypeData%A5 = SrcUA_BL_Default_TypeData%A5 - DstUA_BL_Default_TypeData%S1 = SrcUA_BL_Default_TypeData%S1 - DstUA_BL_Default_TypeData%S2 = SrcUA_BL_Default_TypeData%S2 - DstUA_BL_Default_TypeData%S3 = SrcUA_BL_Default_TypeData%S3 - DstUA_BL_Default_TypeData%S4 = SrcUA_BL_Default_TypeData%S4 - DstUA_BL_Default_TypeData%Cn1 = SrcUA_BL_Default_TypeData%Cn1 - DstUA_BL_Default_TypeData%Cn2 = SrcUA_BL_Default_TypeData%Cn2 - DstUA_BL_Default_TypeData%St_sh = SrcUA_BL_Default_TypeData%St_sh - DstUA_BL_Default_TypeData%Cd0 = SrcUA_BL_Default_TypeData%Cd0 - DstUA_BL_Default_TypeData%Cm0 = SrcUA_BL_Default_TypeData%Cm0 - DstUA_BL_Default_TypeData%k0 = SrcUA_BL_Default_TypeData%k0 - DstUA_BL_Default_TypeData%k1 = SrcUA_BL_Default_TypeData%k1 - DstUA_BL_Default_TypeData%k2 = SrcUA_BL_Default_TypeData%k2 - DstUA_BL_Default_TypeData%k3 = SrcUA_BL_Default_TypeData%k3 - DstUA_BL_Default_TypeData%k1_hat = SrcUA_BL_Default_TypeData%k1_hat - DstUA_BL_Default_TypeData%x_cp_bar = SrcUA_BL_Default_TypeData%x_cp_bar - DstUA_BL_Default_TypeData%UACutout = SrcUA_BL_Default_TypeData%UACutout - DstUA_BL_Default_TypeData%UACutout_delta = SrcUA_BL_Default_TypeData%UACutout_delta - DstUA_BL_Default_TypeData%filtCutOff = SrcUA_BL_Default_TypeData%filtCutOff - DstUA_BL_Default_TypeData%alphaUpper = SrcUA_BL_Default_TypeData%alphaUpper - DstUA_BL_Default_TypeData%alphaLower = SrcUA_BL_Default_TypeData%alphaLower - END SUBROUTINE AFI_CopyUA_BL_Default_Type - - SUBROUTINE AFI_DestroyUA_BL_Default_Type( UA_BL_Default_TypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(AFI_UA_BL_Default_Type), INTENT(INOUT) :: UA_BL_Default_TypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AFI_DestroyUA_BL_Default_Type' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE AFI_DestroyUA_BL_Default_Type - - SUBROUTINE AFI_PackUA_BL_Default_Type( 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(AFI_UA_BL_Default_Type), 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 = 'AFI_PackUA_BL_Default_Type' - ! 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 ! alpha0 - Int_BufSz = Int_BufSz + 1 ! alpha1 - Int_BufSz = Int_BufSz + 1 ! alpha2 - Int_BufSz = Int_BufSz + 1 ! eta_e - Int_BufSz = Int_BufSz + 1 ! C_nalpha - Int_BufSz = Int_BufSz + 1 ! C_lalpha - Int_BufSz = Int_BufSz + 1 ! T_f0 - Int_BufSz = Int_BufSz + 1 ! T_V0 - Int_BufSz = Int_BufSz + 1 ! T_p - Int_BufSz = Int_BufSz + 1 ! T_VL - Int_BufSz = Int_BufSz + 1 ! b1 - Int_BufSz = Int_BufSz + 1 ! b2 - Int_BufSz = Int_BufSz + 1 ! b5 - Int_BufSz = Int_BufSz + 1 ! A1 - Int_BufSz = Int_BufSz + 1 ! A2 - Int_BufSz = Int_BufSz + 1 ! A5 - Int_BufSz = Int_BufSz + 1 ! S1 - Int_BufSz = Int_BufSz + 1 ! S2 - Int_BufSz = Int_BufSz + 1 ! S3 - Int_BufSz = Int_BufSz + 1 ! S4 - Int_BufSz = Int_BufSz + 1 ! Cn1 - Int_BufSz = Int_BufSz + 1 ! Cn2 - Int_BufSz = Int_BufSz + 1 ! St_sh - Int_BufSz = Int_BufSz + 1 ! Cd0 - Int_BufSz = Int_BufSz + 1 ! Cm0 - Int_BufSz = Int_BufSz + 1 ! k0 - Int_BufSz = Int_BufSz + 1 ! k1 - Int_BufSz = Int_BufSz + 1 ! k2 - Int_BufSz = Int_BufSz + 1 ! k3 - Int_BufSz = Int_BufSz + 1 ! k1_hat - Int_BufSz = Int_BufSz + 1 ! x_cp_bar - Int_BufSz = Int_BufSz + 1 ! UACutout - Int_BufSz = Int_BufSz + 1 ! UACutout_delta - Int_BufSz = Int_BufSz + 1 ! filtCutOff - Int_BufSz = Int_BufSz + 1 ! alphaUpper - Int_BufSz = Int_BufSz + 1 ! alphaLower - 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%alpha0, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%alpha1, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%alpha2, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%eta_e, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%C_nalpha, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%C_lalpha, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%T_f0, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%T_V0, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%T_p, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%T_VL, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%b1, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%b2, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%b5, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%A1, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%A2, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%A5, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%S1, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%S2, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%S3, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%S4, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%Cn1, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%Cn2, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%St_sh, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%Cd0, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%Cm0, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%k0, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%k1, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%k2, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%k3, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%k1_hat, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%x_cp_bar, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%UACutout, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%UACutout_delta, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%filtCutOff, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%alphaUpper, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%alphaLower, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE AFI_PackUA_BL_Default_Type - - SUBROUTINE AFI_UnPackUA_BL_Default_Type( 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(AFI_UA_BL_Default_Type), 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 = 'AFI_UnPackUA_BL_Default_Type' - ! 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%alpha0 = TRANSFER(IntKiBuf(Int_Xferred), OutData%alpha0) - Int_Xferred = Int_Xferred + 1 - OutData%alpha1 = TRANSFER(IntKiBuf(Int_Xferred), OutData%alpha1) - Int_Xferred = Int_Xferred + 1 - OutData%alpha2 = TRANSFER(IntKiBuf(Int_Xferred), OutData%alpha2) - Int_Xferred = Int_Xferred + 1 - OutData%eta_e = TRANSFER(IntKiBuf(Int_Xferred), OutData%eta_e) - Int_Xferred = Int_Xferred + 1 - OutData%C_nalpha = TRANSFER(IntKiBuf(Int_Xferred), OutData%C_nalpha) - Int_Xferred = Int_Xferred + 1 - OutData%C_lalpha = TRANSFER(IntKiBuf(Int_Xferred), OutData%C_lalpha) - Int_Xferred = Int_Xferred + 1 - OutData%T_f0 = TRANSFER(IntKiBuf(Int_Xferred), OutData%T_f0) - Int_Xferred = Int_Xferred + 1 - OutData%T_V0 = TRANSFER(IntKiBuf(Int_Xferred), OutData%T_V0) - Int_Xferred = Int_Xferred + 1 - OutData%T_p = TRANSFER(IntKiBuf(Int_Xferred), OutData%T_p) - Int_Xferred = Int_Xferred + 1 - OutData%T_VL = TRANSFER(IntKiBuf(Int_Xferred), OutData%T_VL) - Int_Xferred = Int_Xferred + 1 - OutData%b1 = TRANSFER(IntKiBuf(Int_Xferred), OutData%b1) - Int_Xferred = Int_Xferred + 1 - OutData%b2 = TRANSFER(IntKiBuf(Int_Xferred), OutData%b2) - Int_Xferred = Int_Xferred + 1 - OutData%b5 = TRANSFER(IntKiBuf(Int_Xferred), OutData%b5) - Int_Xferred = Int_Xferred + 1 - OutData%A1 = TRANSFER(IntKiBuf(Int_Xferred), OutData%A1) - Int_Xferred = Int_Xferred + 1 - OutData%A2 = TRANSFER(IntKiBuf(Int_Xferred), OutData%A2) - Int_Xferred = Int_Xferred + 1 - OutData%A5 = TRANSFER(IntKiBuf(Int_Xferred), OutData%A5) - Int_Xferred = Int_Xferred + 1 - OutData%S1 = TRANSFER(IntKiBuf(Int_Xferred), OutData%S1) - Int_Xferred = Int_Xferred + 1 - OutData%S2 = TRANSFER(IntKiBuf(Int_Xferred), OutData%S2) - Int_Xferred = Int_Xferred + 1 - OutData%S3 = TRANSFER(IntKiBuf(Int_Xferred), OutData%S3) - Int_Xferred = Int_Xferred + 1 - OutData%S4 = TRANSFER(IntKiBuf(Int_Xferred), OutData%S4) - Int_Xferred = Int_Xferred + 1 - OutData%Cn1 = TRANSFER(IntKiBuf(Int_Xferred), OutData%Cn1) - Int_Xferred = Int_Xferred + 1 - OutData%Cn2 = TRANSFER(IntKiBuf(Int_Xferred), OutData%Cn2) - Int_Xferred = Int_Xferred + 1 - OutData%St_sh = TRANSFER(IntKiBuf(Int_Xferred), OutData%St_sh) - Int_Xferred = Int_Xferred + 1 - OutData%Cd0 = TRANSFER(IntKiBuf(Int_Xferred), OutData%Cd0) - Int_Xferred = Int_Xferred + 1 - OutData%Cm0 = TRANSFER(IntKiBuf(Int_Xferred), OutData%Cm0) - Int_Xferred = Int_Xferred + 1 - OutData%k0 = TRANSFER(IntKiBuf(Int_Xferred), OutData%k0) - Int_Xferred = Int_Xferred + 1 - OutData%k1 = TRANSFER(IntKiBuf(Int_Xferred), OutData%k1) - Int_Xferred = Int_Xferred + 1 - OutData%k2 = TRANSFER(IntKiBuf(Int_Xferred), OutData%k2) - Int_Xferred = Int_Xferred + 1 - OutData%k3 = TRANSFER(IntKiBuf(Int_Xferred), OutData%k3) - Int_Xferred = Int_Xferred + 1 - OutData%k1_hat = TRANSFER(IntKiBuf(Int_Xferred), OutData%k1_hat) - Int_Xferred = Int_Xferred + 1 - OutData%x_cp_bar = TRANSFER(IntKiBuf(Int_Xferred), OutData%x_cp_bar) - Int_Xferred = Int_Xferred + 1 - OutData%UACutout = TRANSFER(IntKiBuf(Int_Xferred), OutData%UACutout) - Int_Xferred = Int_Xferred + 1 - OutData%UACutout_delta = TRANSFER(IntKiBuf(Int_Xferred), OutData%UACutout_delta) - Int_Xferred = Int_Xferred + 1 - OutData%filtCutOff = TRANSFER(IntKiBuf(Int_Xferred), OutData%filtCutOff) - Int_Xferred = Int_Xferred + 1 - OutData%alphaUpper = TRANSFER(IntKiBuf(Int_Xferred), OutData%alphaUpper) - Int_Xferred = Int_Xferred + 1 - OutData%alphaLower = TRANSFER(IntKiBuf(Int_Xferred), OutData%alphaLower) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE AFI_UnPackUA_BL_Default_Type - - SUBROUTINE AFI_CopyTable_Type( SrcTable_TypeData, DstTable_TypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AFI_Table_Type), INTENT(IN) :: SrcTable_TypeData - TYPE(AFI_Table_Type), INTENT(INOUT) :: DstTable_TypeData - 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 = 'AFI_CopyTable_Type' -! + ErrMsg = '' + DstUA_BL_TypeData%alpha0 = SrcUA_BL_TypeData%alpha0 + DstUA_BL_TypeData%alpha1 = SrcUA_BL_TypeData%alpha1 + DstUA_BL_TypeData%alpha2 = SrcUA_BL_TypeData%alpha2 + DstUA_BL_TypeData%eta_e = SrcUA_BL_TypeData%eta_e + DstUA_BL_TypeData%C_nalpha = SrcUA_BL_TypeData%C_nalpha + DstUA_BL_TypeData%C_lalpha = SrcUA_BL_TypeData%C_lalpha + DstUA_BL_TypeData%T_f0 = SrcUA_BL_TypeData%T_f0 + DstUA_BL_TypeData%T_V0 = SrcUA_BL_TypeData%T_V0 + DstUA_BL_TypeData%T_p = SrcUA_BL_TypeData%T_p + DstUA_BL_TypeData%T_VL = SrcUA_BL_TypeData%T_VL + DstUA_BL_TypeData%b1 = SrcUA_BL_TypeData%b1 + DstUA_BL_TypeData%b2 = SrcUA_BL_TypeData%b2 + DstUA_BL_TypeData%b5 = SrcUA_BL_TypeData%b5 + DstUA_BL_TypeData%A1 = SrcUA_BL_TypeData%A1 + DstUA_BL_TypeData%A2 = SrcUA_BL_TypeData%A2 + DstUA_BL_TypeData%A5 = SrcUA_BL_TypeData%A5 + DstUA_BL_TypeData%S1 = SrcUA_BL_TypeData%S1 + DstUA_BL_TypeData%S2 = SrcUA_BL_TypeData%S2 + DstUA_BL_TypeData%S3 = SrcUA_BL_TypeData%S3 + DstUA_BL_TypeData%S4 = SrcUA_BL_TypeData%S4 + DstUA_BL_TypeData%Cn1 = SrcUA_BL_TypeData%Cn1 + DstUA_BL_TypeData%Cn2 = SrcUA_BL_TypeData%Cn2 + DstUA_BL_TypeData%St_sh = SrcUA_BL_TypeData%St_sh + DstUA_BL_TypeData%Cd0 = SrcUA_BL_TypeData%Cd0 + DstUA_BL_TypeData%Cm0 = SrcUA_BL_TypeData%Cm0 + DstUA_BL_TypeData%k0 = SrcUA_BL_TypeData%k0 + DstUA_BL_TypeData%k1 = SrcUA_BL_TypeData%k1 + DstUA_BL_TypeData%k2 = SrcUA_BL_TypeData%k2 + DstUA_BL_TypeData%k3 = SrcUA_BL_TypeData%k3 + DstUA_BL_TypeData%k1_hat = SrcUA_BL_TypeData%k1_hat + DstUA_BL_TypeData%x_cp_bar = SrcUA_BL_TypeData%x_cp_bar + DstUA_BL_TypeData%UACutout = SrcUA_BL_TypeData%UACutout + DstUA_BL_TypeData%UACutout_delta = SrcUA_BL_TypeData%UACutout_delta + DstUA_BL_TypeData%UACutout_blend = SrcUA_BL_TypeData%UACutout_blend + DstUA_BL_TypeData%filtCutOff = SrcUA_BL_TypeData%filtCutOff + DstUA_BL_TypeData%alphaUpper = SrcUA_BL_TypeData%alphaUpper + DstUA_BL_TypeData%alphaLower = SrcUA_BL_TypeData%alphaLower + DstUA_BL_TypeData%c_alphaLower = SrcUA_BL_TypeData%c_alphaLower + DstUA_BL_TypeData%c_alphaUpper = SrcUA_BL_TypeData%c_alphaUpper + DstUA_BL_TypeData%alpha0ReverseFlow = SrcUA_BL_TypeData%alpha0ReverseFlow + DstUA_BL_TypeData%alphaBreakUpper = SrcUA_BL_TypeData%alphaBreakUpper + DstUA_BL_TypeData%CnBreakUpper = SrcUA_BL_TypeData%CnBreakUpper + DstUA_BL_TypeData%alphaBreakLower = SrcUA_BL_TypeData%alphaBreakLower + DstUA_BL_TypeData%CnBreakLower = SrcUA_BL_TypeData%CnBreakLower +end subroutine + +subroutine AFI_DestroyUA_BL_Type(UA_BL_TypeData, ErrStat, ErrMsg) + type(AFI_UA_BL_Type), intent(inout) :: UA_BL_TypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AFI_DestroyUA_BL_Type' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcTable_TypeData%Alpha)) THEN - i1_l = LBOUND(SrcTable_TypeData%Alpha,1) - i1_u = UBOUND(SrcTable_TypeData%Alpha,1) - IF (.NOT. ALLOCATED(DstTable_TypeData%Alpha)) THEN - ALLOCATE(DstTable_TypeData%Alpha(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstTable_TypeData%Alpha.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstTable_TypeData%Alpha = SrcTable_TypeData%Alpha -ENDIF -IF (ALLOCATED(SrcTable_TypeData%Coefs)) THEN - i1_l = LBOUND(SrcTable_TypeData%Coefs,1) - i1_u = UBOUND(SrcTable_TypeData%Coefs,1) - i2_l = LBOUND(SrcTable_TypeData%Coefs,2) - i2_u = UBOUND(SrcTable_TypeData%Coefs,2) - IF (.NOT. ALLOCATED(DstTable_TypeData%Coefs)) THEN - ALLOCATE(DstTable_TypeData%Coefs(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstTable_TypeData%Coefs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstTable_TypeData%Coefs = SrcTable_TypeData%Coefs -ENDIF -IF (ALLOCATED(SrcTable_TypeData%SplineCoefs)) THEN - i1_l = LBOUND(SrcTable_TypeData%SplineCoefs,1) - i1_u = UBOUND(SrcTable_TypeData%SplineCoefs,1) - i2_l = LBOUND(SrcTable_TypeData%SplineCoefs,2) - i2_u = UBOUND(SrcTable_TypeData%SplineCoefs,2) - i3_l = LBOUND(SrcTable_TypeData%SplineCoefs,3) - i3_u = UBOUND(SrcTable_TypeData%SplineCoefs,3) - IF (.NOT. ALLOCATED(DstTable_TypeData%SplineCoefs)) THEN - ALLOCATE(DstTable_TypeData%SplineCoefs(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstTable_TypeData%SplineCoefs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstTable_TypeData%SplineCoefs = SrcTable_TypeData%SplineCoefs -ENDIF - DstTable_TypeData%UserProp = SrcTable_TypeData%UserProp - DstTable_TypeData%Re = SrcTable_TypeData%Re - DstTable_TypeData%NumAlf = SrcTable_TypeData%NumAlf - DstTable_TypeData%ConstData = SrcTable_TypeData%ConstData - DstTable_TypeData%InclUAdata = SrcTable_TypeData%InclUAdata - CALL AFI_Copyua_bl_type( SrcTable_TypeData%UA_BL, DstTable_TypeData%UA_BL, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE AFI_CopyTable_Type - - SUBROUTINE AFI_DestroyTable_Type( Table_TypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(AFI_Table_Type), INTENT(INOUT) :: Table_TypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AFI_DestroyTable_Type' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(Table_TypeData%Alpha)) THEN - DEALLOCATE(Table_TypeData%Alpha) -ENDIF -IF (ALLOCATED(Table_TypeData%Coefs)) THEN - DEALLOCATE(Table_TypeData%Coefs) -ENDIF -IF (ALLOCATED(Table_TypeData%SplineCoefs)) THEN - DEALLOCATE(Table_TypeData%SplineCoefs) -ENDIF - CALL AFI_Destroyua_bl_type( Table_TypeData%UA_BL, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE AFI_DestroyTable_Type - - SUBROUTINE AFI_PackTable_Type( 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(AFI_Table_Type), 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 = 'AFI_PackTable_Type' - ! 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 ! Alpha allocated yes/no - IF ( ALLOCATED(InData%Alpha) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Alpha upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Alpha) ! Alpha - END IF - Int_BufSz = Int_BufSz + 1 ! Coefs allocated yes/no - IF ( ALLOCATED(InData%Coefs) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Coefs upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Coefs) ! Coefs - END IF - Int_BufSz = Int_BufSz + 1 ! SplineCoefs allocated yes/no - IF ( ALLOCATED(InData%SplineCoefs) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! SplineCoefs upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%SplineCoefs) ! SplineCoefs - END IF - Re_BufSz = Re_BufSz + 1 ! UserProp - Re_BufSz = Re_BufSz + 1 ! Re - Int_BufSz = Int_BufSz + 1 ! NumAlf - Int_BufSz = Int_BufSz + 1 ! ConstData - Int_BufSz = Int_BufSz + 1 ! InclUAdata - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! UA_BL: size of buffers for each call to pack subtype - CALL AFI_Packua_bl_type( Re_Buf, Db_Buf, Int_Buf, InData%UA_BL, ErrStat2, ErrMsg2, .TRUE. ) ! UA_BL - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! UA_BL - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! UA_BL - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! UA_BL - 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%Alpha) ) THEN - 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,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Alpha,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Alpha,1), UBOUND(InData%Alpha,1) - ReKiBuf(Re_Xferred) = InData%Alpha(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Coefs) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Coefs,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Coefs,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Coefs,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Coefs,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Coefs,2), UBOUND(InData%Coefs,2) - DO i1 = LBOUND(InData%Coefs,1), UBOUND(InData%Coefs,1) - ReKiBuf(Re_Xferred) = InData%Coefs(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%SplineCoefs) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SplineCoefs,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SplineCoefs,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SplineCoefs,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SplineCoefs,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SplineCoefs,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SplineCoefs,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%SplineCoefs,3), UBOUND(InData%SplineCoefs,3) - DO i2 = LBOUND(InData%SplineCoefs,2), UBOUND(InData%SplineCoefs,2) - DO i1 = LBOUND(InData%SplineCoefs,1), UBOUND(InData%SplineCoefs,1) - ReKiBuf(Re_Xferred) = InData%SplineCoefs(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - ReKiBuf(Re_Xferred) = InData%UserProp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Re - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumAlf - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%ConstData, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%InclUAdata, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - CALL AFI_Packua_bl_type( Re_Buf, Db_Buf, Int_Buf, InData%UA_BL, ErrStat2, ErrMsg2, OnlySize ) ! UA_BL - 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 AFI_PackTable_Type - - SUBROUTINE AFI_UnPackTable_Type( 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(AFI_Table_Type), 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 = 'AFI_UnPackTable_Type' - ! 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 ! Alpha not allocated - Int_Xferred = Int_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%Alpha)) DEALLOCATE(OutData%Alpha) - ALLOCATE(OutData%Alpha(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Alpha.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Alpha,1), UBOUND(OutData%Alpha,1) - OutData%Alpha(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Coefs not allocated - Int_Xferred = Int_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%Coefs)) DEALLOCATE(OutData%Coefs) - ALLOCATE(OutData%Coefs(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Coefs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Coefs,2), UBOUND(OutData%Coefs,2) - DO i1 = LBOUND(OutData%Coefs,1), UBOUND(OutData%Coefs,1) - OutData%Coefs(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SplineCoefs not allocated - Int_Xferred = Int_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%SplineCoefs)) DEALLOCATE(OutData%SplineCoefs) - ALLOCATE(OutData%SplineCoefs(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%SplineCoefs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%SplineCoefs,3), UBOUND(OutData%SplineCoefs,3) - DO i2 = LBOUND(OutData%SplineCoefs,2), UBOUND(OutData%SplineCoefs,2) - DO i1 = LBOUND(OutData%SplineCoefs,1), UBOUND(OutData%SplineCoefs,1) - OutData%SplineCoefs(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - OutData%UserProp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Re = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NumAlf = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%ConstData = TRANSFER(IntKiBuf(Int_Xferred), OutData%ConstData) - Int_Xferred = Int_Xferred + 1 - OutData%InclUAdata = TRANSFER(IntKiBuf(Int_Xferred), OutData%InclUAdata) - 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 AFI_Unpackua_bl_type( Re_Buf, Db_Buf, Int_Buf, OutData%UA_BL, ErrStat2, ErrMsg2 ) ! UA_BL - 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 AFI_UnPackTable_Type - - SUBROUTINE AFI_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AFI_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(AFI_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 = 'AFI_CopyInitInput' -! + ErrMsg = '' +end subroutine + +subroutine AFI_PackUA_BL_Type(RF, Indata) + type(RegFile), intent(inout) :: RF + type(AFI_UA_BL_Type), intent(in) :: InData + character(*), parameter :: RoutineName = 'AFI_PackUA_BL_Type' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%alpha0) + call RegPack(RF, InData%alpha1) + call RegPack(RF, InData%alpha2) + call RegPack(RF, InData%eta_e) + call RegPack(RF, InData%C_nalpha) + call RegPack(RF, InData%C_lalpha) + call RegPack(RF, InData%T_f0) + call RegPack(RF, InData%T_V0) + call RegPack(RF, InData%T_p) + call RegPack(RF, InData%T_VL) + call RegPack(RF, InData%b1) + call RegPack(RF, InData%b2) + call RegPack(RF, InData%b5) + call RegPack(RF, InData%A1) + call RegPack(RF, InData%A2) + call RegPack(RF, InData%A5) + call RegPack(RF, InData%S1) + call RegPack(RF, InData%S2) + call RegPack(RF, InData%S3) + call RegPack(RF, InData%S4) + call RegPack(RF, InData%Cn1) + call RegPack(RF, InData%Cn2) + call RegPack(RF, InData%St_sh) + call RegPack(RF, InData%Cd0) + call RegPack(RF, InData%Cm0) + call RegPack(RF, InData%k0) + call RegPack(RF, InData%k1) + call RegPack(RF, InData%k2) + call RegPack(RF, InData%k3) + call RegPack(RF, InData%k1_hat) + call RegPack(RF, InData%x_cp_bar) + call RegPack(RF, InData%UACutout) + call RegPack(RF, InData%UACutout_delta) + call RegPack(RF, InData%UACutout_blend) + call RegPack(RF, InData%filtCutOff) + call RegPack(RF, InData%alphaUpper) + call RegPack(RF, InData%alphaLower) + call RegPack(RF, InData%c_alphaLower) + call RegPack(RF, InData%c_alphaUpper) + call RegPack(RF, InData%alpha0ReverseFlow) + call RegPack(RF, InData%alphaBreakUpper) + call RegPack(RF, InData%CnBreakUpper) + call RegPack(RF, InData%alphaBreakLower) + call RegPack(RF, InData%CnBreakLower) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AFI_UnPackUA_BL_Type(RF, OutData) + type(RegFile), intent(inout) :: RF + type(AFI_UA_BL_Type), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AFI_UnPackUA_BL_Type' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%alpha0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%alpha1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%alpha2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%eta_e); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%C_nalpha); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%C_lalpha); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%T_f0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%T_V0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%T_p); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%T_VL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%b1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%b2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%b5); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%A1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%A2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%A5); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%S1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%S2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%S3); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%S4); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Cn1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Cn2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%St_sh); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Cd0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Cm0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%k0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%k1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%k2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%k3); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%k1_hat); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%x_cp_bar); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UACutout); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UACutout_delta); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UACutout_blend); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%filtCutOff); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%alphaUpper); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%alphaLower); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%c_alphaLower); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%c_alphaUpper); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%alpha0ReverseFlow); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%alphaBreakUpper); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CnBreakUpper); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%alphaBreakLower); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CnBreakLower); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AFI_CopyUA_BL_Default_Type(SrcUA_BL_Default_TypeData, DstUA_BL_Default_TypeData, CtrlCode, ErrStat, ErrMsg) + type(AFI_UA_BL_Default_Type), intent(in) :: SrcUA_BL_Default_TypeData + type(AFI_UA_BL_Default_Type), intent(inout) :: DstUA_BL_Default_TypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AFI_CopyUA_BL_Default_Type' ErrStat = ErrID_None - ErrMsg = "" - DstInitInputData%FileName = SrcInitInputData%FileName - DstInitInputData%AFTabMod = SrcInitInputData%AFTabMod - DstInitInputData%InCol_Alfa = SrcInitInputData%InCol_Alfa - DstInitInputData%InCol_Cl = SrcInitInputData%InCol_Cl - DstInitInputData%InCol_Cd = SrcInitInputData%InCol_Cd - DstInitInputData%InCol_Cm = SrcInitInputData%InCol_Cm - DstInitInputData%InCol_Cpmin = SrcInitInputData%InCol_Cpmin - DstInitInputData%UA_f_cn = SrcInitInputData%UA_f_cn - END SUBROUTINE AFI_CopyInitInput - - SUBROUTINE AFI_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(AFI_InitInputType), INTENT(INOUT) :: InitInputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AFI_DestroyInitInput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE AFI_DestroyInitInput - - SUBROUTINE AFI_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(AFI_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 = 'AFI_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%FileName) ! FileName - Int_BufSz = Int_BufSz + 1 ! AFTabMod - Int_BufSz = Int_BufSz + 1 ! InCol_Alfa - Int_BufSz = Int_BufSz + 1 ! InCol_Cl - Int_BufSz = Int_BufSz + 1 ! InCol_Cd - Int_BufSz = Int_BufSz + 1 ! InCol_Cm - Int_BufSz = Int_BufSz + 1 ! InCol_Cpmin - Int_BufSz = Int_BufSz + 1 ! UA_f_cn - 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%FileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%FileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = InData%AFTabMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%InCol_Alfa - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%InCol_Cl - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%InCol_Cd - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%InCol_Cm - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%InCol_Cpmin - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%UA_f_cn, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE AFI_PackInitInput - - SUBROUTINE AFI_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(AFI_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 = 'AFI_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%FileName) - OutData%FileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%AFTabMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%InCol_Alfa = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%InCol_Cl = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%InCol_Cd = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%InCol_Cm = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%InCol_Cpmin = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%UA_f_cn = TRANSFER(IntKiBuf(Int_Xferred), OutData%UA_f_cn) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE AFI_UnPackInitInput - - SUBROUTINE AFI_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AFI_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(AFI_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 = 'AFI_CopyInitOutput' -! + ErrMsg = '' + DstUA_BL_Default_TypeData%alpha0 = SrcUA_BL_Default_TypeData%alpha0 + DstUA_BL_Default_TypeData%alpha1 = SrcUA_BL_Default_TypeData%alpha1 + DstUA_BL_Default_TypeData%alpha2 = SrcUA_BL_Default_TypeData%alpha2 + DstUA_BL_Default_TypeData%eta_e = SrcUA_BL_Default_TypeData%eta_e + DstUA_BL_Default_TypeData%C_nalpha = SrcUA_BL_Default_TypeData%C_nalpha + DstUA_BL_Default_TypeData%C_lalpha = SrcUA_BL_Default_TypeData%C_lalpha + DstUA_BL_Default_TypeData%T_f0 = SrcUA_BL_Default_TypeData%T_f0 + DstUA_BL_Default_TypeData%T_V0 = SrcUA_BL_Default_TypeData%T_V0 + DstUA_BL_Default_TypeData%T_p = SrcUA_BL_Default_TypeData%T_p + DstUA_BL_Default_TypeData%T_VL = SrcUA_BL_Default_TypeData%T_VL + DstUA_BL_Default_TypeData%b1 = SrcUA_BL_Default_TypeData%b1 + DstUA_BL_Default_TypeData%b2 = SrcUA_BL_Default_TypeData%b2 + DstUA_BL_Default_TypeData%b5 = SrcUA_BL_Default_TypeData%b5 + DstUA_BL_Default_TypeData%A1 = SrcUA_BL_Default_TypeData%A1 + DstUA_BL_Default_TypeData%A2 = SrcUA_BL_Default_TypeData%A2 + DstUA_BL_Default_TypeData%A5 = SrcUA_BL_Default_TypeData%A5 + DstUA_BL_Default_TypeData%S1 = SrcUA_BL_Default_TypeData%S1 + DstUA_BL_Default_TypeData%S2 = SrcUA_BL_Default_TypeData%S2 + DstUA_BL_Default_TypeData%S3 = SrcUA_BL_Default_TypeData%S3 + DstUA_BL_Default_TypeData%S4 = SrcUA_BL_Default_TypeData%S4 + DstUA_BL_Default_TypeData%Cn1 = SrcUA_BL_Default_TypeData%Cn1 + DstUA_BL_Default_TypeData%Cn2 = SrcUA_BL_Default_TypeData%Cn2 + DstUA_BL_Default_TypeData%St_sh = SrcUA_BL_Default_TypeData%St_sh + DstUA_BL_Default_TypeData%Cd0 = SrcUA_BL_Default_TypeData%Cd0 + DstUA_BL_Default_TypeData%Cm0 = SrcUA_BL_Default_TypeData%Cm0 + DstUA_BL_Default_TypeData%k0 = SrcUA_BL_Default_TypeData%k0 + DstUA_BL_Default_TypeData%k1 = SrcUA_BL_Default_TypeData%k1 + DstUA_BL_Default_TypeData%k2 = SrcUA_BL_Default_TypeData%k2 + DstUA_BL_Default_TypeData%k3 = SrcUA_BL_Default_TypeData%k3 + DstUA_BL_Default_TypeData%k1_hat = SrcUA_BL_Default_TypeData%k1_hat + DstUA_BL_Default_TypeData%x_cp_bar = SrcUA_BL_Default_TypeData%x_cp_bar + DstUA_BL_Default_TypeData%UACutout = SrcUA_BL_Default_TypeData%UACutout + DstUA_BL_Default_TypeData%UACutout_delta = SrcUA_BL_Default_TypeData%UACutout_delta + DstUA_BL_Default_TypeData%filtCutOff = SrcUA_BL_Default_TypeData%filtCutOff + DstUA_BL_Default_TypeData%alphaUpper = SrcUA_BL_Default_TypeData%alphaUpper + DstUA_BL_Default_TypeData%alphaLower = SrcUA_BL_Default_TypeData%alphaLower +end subroutine + +subroutine AFI_DestroyUA_BL_Default_Type(UA_BL_Default_TypeData, ErrStat, ErrMsg) + type(AFI_UA_BL_Default_Type), intent(inout) :: UA_BL_Default_TypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AFI_DestroyUA_BL_Default_Type' 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 AFI_CopyInitOutput - - SUBROUTINE AFI_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(AFI_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AFI_DestroyInitOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL NWTC_Library_Destroyprogdesc( InitOutputData%Ver, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE AFI_DestroyInitOutput - - SUBROUTINE AFI_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(AFI_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 = 'AFI_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) - - 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 AFI_PackInitOutput - - SUBROUTINE AFI_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(AFI_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 = 'AFI_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 AFI_UnPackInitOutput - - SUBROUTINE AFI_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AFI_ParameterType), INTENT(IN) :: SrcParamData - TYPE(AFI_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 = 'AFI_CopyParam' -! + ErrMsg = '' +end subroutine + +subroutine AFI_PackUA_BL_Default_Type(RF, Indata) + type(RegFile), intent(inout) :: RF + type(AFI_UA_BL_Default_Type), intent(in) :: InData + character(*), parameter :: RoutineName = 'AFI_PackUA_BL_Default_Type' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%alpha0) + call RegPack(RF, InData%alpha1) + call RegPack(RF, InData%alpha2) + call RegPack(RF, InData%eta_e) + call RegPack(RF, InData%C_nalpha) + call RegPack(RF, InData%C_lalpha) + call RegPack(RF, InData%T_f0) + call RegPack(RF, InData%T_V0) + call RegPack(RF, InData%T_p) + call RegPack(RF, InData%T_VL) + call RegPack(RF, InData%b1) + call RegPack(RF, InData%b2) + call RegPack(RF, InData%b5) + call RegPack(RF, InData%A1) + call RegPack(RF, InData%A2) + call RegPack(RF, InData%A5) + call RegPack(RF, InData%S1) + call RegPack(RF, InData%S2) + call RegPack(RF, InData%S3) + call RegPack(RF, InData%S4) + call RegPack(RF, InData%Cn1) + call RegPack(RF, InData%Cn2) + call RegPack(RF, InData%St_sh) + call RegPack(RF, InData%Cd0) + call RegPack(RF, InData%Cm0) + call RegPack(RF, InData%k0) + call RegPack(RF, InData%k1) + call RegPack(RF, InData%k2) + call RegPack(RF, InData%k3) + call RegPack(RF, InData%k1_hat) + call RegPack(RF, InData%x_cp_bar) + call RegPack(RF, InData%UACutout) + call RegPack(RF, InData%UACutout_delta) + call RegPack(RF, InData%filtCutOff) + call RegPack(RF, InData%alphaUpper) + call RegPack(RF, InData%alphaLower) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AFI_UnPackUA_BL_Default_Type(RF, OutData) + type(RegFile), intent(inout) :: RF + type(AFI_UA_BL_Default_Type), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AFI_UnPackUA_BL_Default_Type' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%alpha0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%alpha1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%alpha2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%eta_e); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%C_nalpha); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%C_lalpha); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%T_f0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%T_V0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%T_p); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%T_VL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%b1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%b2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%b5); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%A1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%A2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%A5); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%S1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%S2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%S3); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%S4); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Cn1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Cn2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%St_sh); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Cd0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Cm0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%k0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%k1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%k2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%k3); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%k1_hat); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%x_cp_bar); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UACutout); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UACutout_delta); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%filtCutOff); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%alphaUpper); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%alphaLower); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AFI_CopyTable_Type(SrcTable_TypeData, DstTable_TypeData, CtrlCode, ErrStat, ErrMsg) + type(AFI_Table_Type), intent(in) :: SrcTable_TypeData + type(AFI_Table_Type), intent(inout) :: DstTable_TypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AFI_CopyTable_Type' ErrStat = ErrID_None - ErrMsg = "" - DstParamData%ColCd = SrcParamData%ColCd - DstParamData%ColCl = SrcParamData%ColCl - DstParamData%ColCm = SrcParamData%ColCm - DstParamData%ColCpmin = SrcParamData%ColCpmin - DstParamData%ColUAf = SrcParamData%ColUAf - DstParamData%AFTabMod = SrcParamData%AFTabMod -IF (ALLOCATED(SrcParamData%secondVals)) THEN - i1_l = LBOUND(SrcParamData%secondVals,1) - i1_u = UBOUND(SrcParamData%secondVals,1) - IF (.NOT. ALLOCATED(DstParamData%secondVals)) THEN - ALLOCATE(DstParamData%secondVals(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%secondVals.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%secondVals = SrcParamData%secondVals -ENDIF - DstParamData%InterpOrd = SrcParamData%InterpOrd - DstParamData%RelThickness = SrcParamData%RelThickness - DstParamData%NonDimArea = SrcParamData%NonDimArea - DstParamData%NumCoords = SrcParamData%NumCoords -IF (ALLOCATED(SrcParamData%X_Coord)) THEN - i1_l = LBOUND(SrcParamData%X_Coord,1) - i1_u = UBOUND(SrcParamData%X_Coord,1) - IF (.NOT. ALLOCATED(DstParamData%X_Coord)) THEN - ALLOCATE(DstParamData%X_Coord(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%X_Coord.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%X_Coord = SrcParamData%X_Coord -ENDIF -IF (ALLOCATED(SrcParamData%Y_Coord)) THEN - i1_l = LBOUND(SrcParamData%Y_Coord,1) - i1_u = UBOUND(SrcParamData%Y_Coord,1) - IF (.NOT. ALLOCATED(DstParamData%Y_Coord)) THEN - ALLOCATE(DstParamData%Y_Coord(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Y_Coord.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Y_Coord = SrcParamData%Y_Coord -ENDIF - DstParamData%NumTabs = SrcParamData%NumTabs -IF (ALLOCATED(SrcParamData%Table)) THEN - i1_l = LBOUND(SrcParamData%Table,1) - i1_u = UBOUND(SrcParamData%Table,1) - IF (.NOT. ALLOCATED(DstParamData%Table)) THEN - ALLOCATE(DstParamData%Table(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Table.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcParamData%Table,1), UBOUND(SrcParamData%Table,1) - CALL AFI_Copytable_type( SrcParamData%Table(i1), DstParamData%Table(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - DstParamData%BL_file = SrcParamData%BL_file - DstParamData%FileName = SrcParamData%FileName - END SUBROUTINE AFI_CopyParam - - SUBROUTINE AFI_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(AFI_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AFI_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(ParamData%secondVals)) THEN - DEALLOCATE(ParamData%secondVals) -ENDIF -IF (ALLOCATED(ParamData%X_Coord)) THEN - DEALLOCATE(ParamData%X_Coord) -ENDIF -IF (ALLOCATED(ParamData%Y_Coord)) THEN - DEALLOCATE(ParamData%Y_Coord) -ENDIF -IF (ALLOCATED(ParamData%Table)) THEN -DO i1 = LBOUND(ParamData%Table,1), UBOUND(ParamData%Table,1) - CALL AFI_Destroytable_type( ParamData%Table(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ParamData%Table) -ENDIF - END SUBROUTINE AFI_DestroyParam - - SUBROUTINE AFI_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(AFI_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 = 'AFI_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 ! ColCd - Int_BufSz = Int_BufSz + 1 ! ColCl - Int_BufSz = Int_BufSz + 1 ! ColCm - Int_BufSz = Int_BufSz + 1 ! ColCpmin - Int_BufSz = Int_BufSz + 1 ! ColUAf - Int_BufSz = Int_BufSz + 1 ! AFTabMod - Int_BufSz = Int_BufSz + 1 ! secondVals allocated yes/no - IF ( ALLOCATED(InData%secondVals) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! secondVals upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%secondVals) ! secondVals - END IF - Int_BufSz = Int_BufSz + 1 ! InterpOrd - Re_BufSz = Re_BufSz + 1 ! RelThickness - Re_BufSz = Re_BufSz + 1 ! NonDimArea - Int_BufSz = Int_BufSz + 1 ! NumCoords - Int_BufSz = Int_BufSz + 1 ! X_Coord allocated yes/no - IF ( ALLOCATED(InData%X_Coord) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! X_Coord upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%X_Coord) ! X_Coord - END IF - Int_BufSz = Int_BufSz + 1 ! Y_Coord allocated yes/no - IF ( ALLOCATED(InData%Y_Coord) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Y_Coord upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Y_Coord) ! Y_Coord - END IF - Int_BufSz = Int_BufSz + 1 ! NumTabs - Int_BufSz = Int_BufSz + 1 ! Table allocated yes/no - IF ( ALLOCATED(InData%Table) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Table upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%Table,1), UBOUND(InData%Table,1) - Int_BufSz = Int_BufSz + 3 ! Table: size of buffers for each call to pack subtype - CALL AFI_Packtable_type( Re_Buf, Db_Buf, Int_Buf, InData%Table(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Table - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Table - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Table - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Table - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1*LEN(InData%BL_file) ! BL_file - Int_BufSz = Int_BufSz + 1*LEN(InData%FileName) ! 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) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = InData%ColCd - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%ColCl - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%ColCm - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%ColCpmin - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%ColUAf - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%AFTabMod - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%secondVals) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%secondVals,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%secondVals,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%secondVals,1), UBOUND(InData%secondVals,1) - ReKiBuf(Re_Xferred) = InData%secondVals(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%InterpOrd - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RelThickness - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%NonDimArea - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumCoords - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%X_Coord) ) THEN - 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_Coord,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%X_Coord,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%X_Coord,1), UBOUND(InData%X_Coord,1) - ReKiBuf(Re_Xferred) = InData%X_Coord(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Y_Coord) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Y_Coord,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Y_Coord,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Y_Coord,1), UBOUND(InData%Y_Coord,1) - ReKiBuf(Re_Xferred) = InData%Y_Coord(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NumTabs - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%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%Table,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Table,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Table,1), UBOUND(InData%Table,1) - CALL AFI_Packtable_type( Re_Buf, Db_Buf, Int_Buf, InData%Table(i1), ErrStat2, ErrMsg2, OnlySize ) ! Table - 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%BL_file) - IntKiBuf(Int_Xferred) = ICHAR(InData%BL_file(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%FileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%FileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END SUBROUTINE AFI_PackParam - - SUBROUTINE AFI_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(AFI_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 = 'AFI_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%ColCd = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%ColCl = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%ColCm = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%ColCpmin = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%ColUAf = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%AFTabMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! secondVals not allocated - Int_Xferred = Int_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%secondVals)) DEALLOCATE(OutData%secondVals) - ALLOCATE(OutData%secondVals(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%secondVals.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%secondVals,1), UBOUND(OutData%secondVals,1) - OutData%secondVals(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%InterpOrd = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%RelThickness = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NonDimArea = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NumCoords = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! X_Coord not allocated - Int_Xferred = Int_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_Coord)) DEALLOCATE(OutData%X_Coord) - ALLOCATE(OutData%X_Coord(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%X_Coord.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%X_Coord,1), UBOUND(OutData%X_Coord,1) - OutData%X_Coord(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Y_Coord not allocated - Int_Xferred = Int_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%Y_Coord)) DEALLOCATE(OutData%Y_Coord) - ALLOCATE(OutData%Y_Coord(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Y_Coord.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Y_Coord,1), UBOUND(OutData%Y_Coord,1) - OutData%Y_Coord(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%NumTabs = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! 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 - IF (ALLOCATED(OutData%Table)) DEALLOCATE(OutData%Table) - ALLOCATE(OutData%Table(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Table.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Table,1), UBOUND(OutData%Table,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 AFI_Unpacktable_type( Re_Buf, Db_Buf, Int_Buf, OutData%Table(i1), ErrStat2, ErrMsg2 ) ! Table - 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%BL_file) - OutData%BL_file(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%FileName) - OutData%FileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END SUBROUTINE AFI_UnPackParam - - SUBROUTINE AFI_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AFI_InputType), INTENT(IN) :: SrcInputData - TYPE(AFI_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 = 'AFI_CopyInput' -! + ErrMsg = '' + if (allocated(SrcTable_TypeData%Alpha)) then + LB(1:1) = lbound(SrcTable_TypeData%Alpha) + UB(1:1) = ubound(SrcTable_TypeData%Alpha) + if (.not. allocated(DstTable_TypeData%Alpha)) then + allocate(DstTable_TypeData%Alpha(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTable_TypeData%Alpha.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTable_TypeData%Alpha = SrcTable_TypeData%Alpha + end if + if (allocated(SrcTable_TypeData%Coefs)) then + LB(1:2) = lbound(SrcTable_TypeData%Coefs) + UB(1:2) = ubound(SrcTable_TypeData%Coefs) + if (.not. allocated(DstTable_TypeData%Coefs)) then + allocate(DstTable_TypeData%Coefs(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTable_TypeData%Coefs.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTable_TypeData%Coefs = SrcTable_TypeData%Coefs + end if + if (allocated(SrcTable_TypeData%SplineCoefs)) then + LB(1:3) = lbound(SrcTable_TypeData%SplineCoefs) + UB(1:3) = ubound(SrcTable_TypeData%SplineCoefs) + if (.not. allocated(DstTable_TypeData%SplineCoefs)) then + allocate(DstTable_TypeData%SplineCoefs(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTable_TypeData%SplineCoefs.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTable_TypeData%SplineCoefs = SrcTable_TypeData%SplineCoefs + end if + DstTable_TypeData%UserProp = SrcTable_TypeData%UserProp + DstTable_TypeData%Re = SrcTable_TypeData%Re + DstTable_TypeData%NumAlf = SrcTable_TypeData%NumAlf + DstTable_TypeData%ConstData = SrcTable_TypeData%ConstData + DstTable_TypeData%InclUAdata = SrcTable_TypeData%InclUAdata + call AFI_CopyUA_BL_Type(SrcTable_TypeData%UA_BL, DstTable_TypeData%UA_BL, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine AFI_DestroyTable_Type(Table_TypeData, ErrStat, ErrMsg) + type(AFI_Table_Type), intent(inout) :: Table_TypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AFI_DestroyTable_Type' ErrStat = ErrID_None - ErrMsg = "" - DstInputData%AoA = SrcInputData%AoA - DstInputData%UserProp = SrcInputData%UserProp - DstInputData%Re = SrcInputData%Re - END SUBROUTINE AFI_CopyInput - - SUBROUTINE AFI_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(AFI_InputType), INTENT(INOUT) :: InputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AFI_DestroyInput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE AFI_DestroyInput - - SUBROUTINE AFI_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(AFI_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 = 'AFI_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 ! AoA - Re_BufSz = Re_BufSz + 1 ! UserProp - Re_BufSz = Re_BufSz + 1 ! Re - 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%AoA - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%UserProp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Re - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AFI_PackInput - - SUBROUTINE AFI_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(AFI_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 = 'AFI_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%AoA = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%UserProp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Re = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AFI_UnPackInput - - SUBROUTINE AFI_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AFI_OutputType), INTENT(IN) :: SrcOutputData - TYPE(AFI_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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AFI_CopyOutput' -! + ErrMsg = '' + if (allocated(Table_TypeData%Alpha)) then + deallocate(Table_TypeData%Alpha) + end if + if (allocated(Table_TypeData%Coefs)) then + deallocate(Table_TypeData%Coefs) + end if + if (allocated(Table_TypeData%SplineCoefs)) then + deallocate(Table_TypeData%SplineCoefs) + end if + call AFI_DestroyUA_BL_Type(Table_TypeData%UA_BL, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine AFI_PackTable_Type(RF, Indata) + type(RegFile), intent(inout) :: RF + type(AFI_Table_Type), intent(in) :: InData + character(*), parameter :: RoutineName = 'AFI_PackTable_Type' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%Alpha) + call RegPackAlloc(RF, InData%Coefs) + call RegPackAlloc(RF, InData%SplineCoefs) + call RegPack(RF, InData%UserProp) + call RegPack(RF, InData%Re) + call RegPack(RF, InData%NumAlf) + call RegPack(RF, InData%ConstData) + call RegPack(RF, InData%InclUAdata) + call AFI_PackUA_BL_Type(RF, InData%UA_BL) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AFI_UnPackTable_Type(RF, OutData) + type(RegFile), intent(inout) :: RF + type(AFI_Table_Type), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AFI_UnPackTable_Type' + integer(B4Ki) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%Alpha); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Coefs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%SplineCoefs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UserProp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Re); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumAlf); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ConstData); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%InclUAdata); if (RegCheckErr(RF, RoutineName)) return + call AFI_UnpackUA_BL_Type(RF, OutData%UA_BL) ! UA_BL +end subroutine + +subroutine AFI_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) + type(AFI_InitInputType), intent(in) :: SrcInitInputData + type(AFI_InitInputType), intent(inout) :: DstInitInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AFI_CopyInitInput' ErrStat = ErrID_None - ErrMsg = "" - DstOutputData%Cl = SrcOutputData%Cl - DstOutputData%Cd = SrcOutputData%Cd - DstOutputData%Cm = SrcOutputData%Cm - DstOutputData%Cpmin = SrcOutputData%Cpmin - DstOutputData%Cd0 = SrcOutputData%Cd0 - DstOutputData%Cm0 = SrcOutputData%Cm0 - DstOutputData%f_st = SrcOutputData%f_st - DstOutputData%FullySeparate = SrcOutputData%FullySeparate - DstOutputData%FullyAttached = SrcOutputData%FullyAttached - END SUBROUTINE AFI_CopyOutput - - SUBROUTINE AFI_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(AFI_OutputType), INTENT(INOUT) :: OutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AFI_DestroyOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE AFI_DestroyOutput - - SUBROUTINE AFI_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(AFI_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 = 'AFI_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 ! Cl - Re_BufSz = Re_BufSz + 1 ! Cd - Re_BufSz = Re_BufSz + 1 ! Cm - Re_BufSz = Re_BufSz + 1 ! Cpmin - Re_BufSz = Re_BufSz + 1 ! Cd0 - Re_BufSz = Re_BufSz + 1 ! Cm0 - Re_BufSz = Re_BufSz + 1 ! f_st - Re_BufSz = Re_BufSz + 1 ! FullySeparate - Re_BufSz = Re_BufSz + 1 ! FullyAttached - 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%Cl - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Cd - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Cm - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Cpmin - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Cd0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Cm0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%f_st - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%FullySeparate - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%FullyAttached - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AFI_PackOutput - - SUBROUTINE AFI_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(AFI_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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AFI_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%Cl = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Cd = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Cm = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Cpmin = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Cd0 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Cm0 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%f_st = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%FullySeparate = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%FullyAttached = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AFI_UnPackOutput - - - SUBROUTINE AFI_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(AFI_OutputType), INTENT(IN) :: y(:) ! Output at t1 > t2 > t3 - REAL(ReKi), INTENT(IN ) :: t(:) ! Times associated with the Outputs - TYPE(AFI_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(ReKi), 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 + ErrMsg = '' + DstInitInputData%FileName = SrcInitInputData%FileName + DstInitInputData%AFTabMod = SrcInitInputData%AFTabMod + DstInitInputData%InCol_Alfa = SrcInitInputData%InCol_Alfa + DstInitInputData%InCol_Cl = SrcInitInputData%InCol_Cl + DstInitInputData%InCol_Cd = SrcInitInputData%InCol_Cd + DstInitInputData%InCol_Cm = SrcInitInputData%InCol_Cm + DstInitInputData%InCol_Cpmin = SrcInitInputData%InCol_Cpmin + DstInitInputData%UAMod = SrcInitInputData%UAMod +end subroutine + +subroutine AFI_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(AFI_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AFI_DestroyInitInput' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine AFI_PackInitInput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(AFI_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AFI_PackInitInput' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%FileName) + call RegPack(RF, InData%AFTabMod) + call RegPack(RF, InData%InCol_Alfa) + call RegPack(RF, InData%InCol_Cl) + call RegPack(RF, InData%InCol_Cd) + call RegPack(RF, InData%InCol_Cm) + call RegPack(RF, InData%InCol_Cpmin) + call RegPack(RF, InData%UAMod) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AFI_UnPackInitInput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(AFI_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AFI_UnPackInitInput' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%FileName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AFTabMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%InCol_Alfa); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%InCol_Cl); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%InCol_Cd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%InCol_Cm); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%InCol_Cpmin); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UAMod); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AFI_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) + type(AFI_InitOutputType), intent(in) :: SrcInitOutputData + type(AFI_InitOutputType), intent(inout) :: DstInitOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AFI_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 + +subroutine AFI_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(AFI_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AFI_DestroyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine AFI_PackInitOutput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(AFI_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AFI_PackInitOutput' + if (RF%ErrStat >= AbortErrLev) return + call NWTC_Library_PackProgDesc(RF, InData%Ver) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AFI_UnPackInitOutput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(AFI_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AFI_UnPackInitOutput' + if (RF%ErrStat /= ErrID_None) return + call NWTC_Library_UnpackProgDesc(RF, OutData%Ver) ! Ver +end subroutine + +subroutine AFI_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(AFI_ParameterType), intent(in) :: SrcParamData + type(AFI_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AFI_CopyParam' + ErrStat = ErrID_None + ErrMsg = '' + DstParamData%ColCd = SrcParamData%ColCd + DstParamData%ColCl = SrcParamData%ColCl + DstParamData%ColCm = SrcParamData%ColCm + DstParamData%ColCpmin = SrcParamData%ColCpmin + DstParamData%ColUAf = SrcParamData%ColUAf + DstParamData%AFTabMod = SrcParamData%AFTabMod + if (allocated(SrcParamData%secondVals)) then + LB(1:1) = lbound(SrcParamData%secondVals) + UB(1:1) = ubound(SrcParamData%secondVals) + if (.not. allocated(DstParamData%secondVals)) then + allocate(DstParamData%secondVals(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%secondVals.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%secondVals = SrcParamData%secondVals + end if + DstParamData%InterpOrd = SrcParamData%InterpOrd + DstParamData%RelThickness = SrcParamData%RelThickness + DstParamData%NonDimArea = SrcParamData%NonDimArea + DstParamData%NumCoords = SrcParamData%NumCoords + if (allocated(SrcParamData%X_Coord)) then + LB(1:1) = lbound(SrcParamData%X_Coord) + UB(1:1) = ubound(SrcParamData%X_Coord) + if (.not. allocated(DstParamData%X_Coord)) then + allocate(DstParamData%X_Coord(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%X_Coord.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%X_Coord = SrcParamData%X_Coord + end if + if (allocated(SrcParamData%Y_Coord)) then + LB(1:1) = lbound(SrcParamData%Y_Coord) + UB(1:1) = ubound(SrcParamData%Y_Coord) + if (.not. allocated(DstParamData%Y_Coord)) then + allocate(DstParamData%Y_Coord(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Y_Coord.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Y_Coord = SrcParamData%Y_Coord + end if + DstParamData%NumTabs = SrcParamData%NumTabs + if (allocated(SrcParamData%Table)) then + LB(1:1) = lbound(SrcParamData%Table) + UB(1:1) = ubound(SrcParamData%Table) + if (.not. allocated(DstParamData%Table)) then + allocate(DstParamData%Table(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Table.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AFI_CopyTable_Type(SrcParamData%Table(i1), DstParamData%Table(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + DstParamData%BL_file = SrcParamData%BL_file + DstParamData%FileName = SrcParamData%FileName +end subroutine + +subroutine AFI_DestroyParam(ParamData, ErrStat, ErrMsg) + type(AFI_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AFI_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ParamData%secondVals)) then + deallocate(ParamData%secondVals) + end if + if (allocated(ParamData%X_Coord)) then + deallocate(ParamData%X_Coord) + end if + if (allocated(ParamData%Y_Coord)) then + deallocate(ParamData%Y_Coord) + end if + if (allocated(ParamData%Table)) then + LB(1:1) = lbound(ParamData%Table) + UB(1:1) = ubound(ParamData%Table) + do i1 = LB(1), UB(1) + call AFI_DestroyTable_Type(ParamData%Table(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%Table) + end if +end subroutine + +subroutine AFI_PackParam(RF, Indata) + type(RegFile), intent(inout) :: RF + type(AFI_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AFI_PackParam' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%ColCd) + call RegPack(RF, InData%ColCl) + call RegPack(RF, InData%ColCm) + call RegPack(RF, InData%ColCpmin) + call RegPack(RF, InData%ColUAf) + call RegPack(RF, InData%AFTabMod) + call RegPackAlloc(RF, InData%secondVals) + call RegPack(RF, InData%InterpOrd) + call RegPack(RF, InData%RelThickness) + call RegPack(RF, InData%NonDimArea) + call RegPack(RF, InData%NumCoords) + call RegPackAlloc(RF, InData%X_Coord) + call RegPackAlloc(RF, InData%Y_Coord) + call RegPack(RF, InData%NumTabs) + call RegPack(RF, allocated(InData%Table)) + if (allocated(InData%Table)) then + call RegPackBounds(RF, 1, lbound(InData%Table), ubound(InData%Table)) + LB(1:1) = lbound(InData%Table) + UB(1:1) = ubound(InData%Table) + do i1 = LB(1), UB(1) + call AFI_PackTable_Type(RF, InData%Table(i1)) + end do + end if + call RegPack(RF, InData%BL_file) + call RegPack(RF, InData%FileName) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AFI_UnPackParam(RF, OutData) + type(RegFile), intent(inout) :: RF + type(AFI_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AFI_UnPackParam' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%ColCd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ColCl); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ColCm); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ColCpmin); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ColUAf); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AFTabMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%secondVals); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%InterpOrd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RelThickness); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NonDimArea); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumCoords); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%X_Coord); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Y_Coord); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumTabs); if (RegCheckErr(RF, RoutineName)) return + if (allocated(OutData%Table)) deallocate(OutData%Table) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%Table(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Table.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AFI_UnpackTable_Type(RF, OutData%Table(i1)) ! Table + end do + end if + call RegUnpack(RF, OutData%BL_file); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FileName); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AFI_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) + type(AFI_InputType), intent(in) :: SrcInputData + type(AFI_InputType), intent(inout) :: DstInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AFI_CopyInput' + ErrStat = ErrID_None + ErrMsg = '' + DstInputData%AoA = SrcInputData%AoA + DstInputData%UserProp = SrcInputData%UserProp + DstInputData%Re = SrcInputData%Re +end subroutine + +subroutine AFI_DestroyInput(InputData, ErrStat, ErrMsg) + type(AFI_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AFI_DestroyInput' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine AFI_PackInput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(AFI_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AFI_PackInput' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%AoA) + call RegPack(RF, InData%UserProp) + call RegPack(RF, InData%Re) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AFI_UnPackInput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(AFI_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AFI_UnPackInput' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%AoA); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UserProp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Re); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AFI_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(AFI_OutputType), intent(in) :: SrcOutputData + type(AFI_OutputType), intent(inout) :: DstOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AFI_CopyOutput' + ErrStat = ErrID_None + ErrMsg = '' + DstOutputData%Cl = SrcOutputData%Cl + DstOutputData%Cd = SrcOutputData%Cd + DstOutputData%Cm = SrcOutputData%Cm + DstOutputData%Cpmin = SrcOutputData%Cpmin + DstOutputData%Cd0 = SrcOutputData%Cd0 + DstOutputData%Cm0 = SrcOutputData%Cm0 + DstOutputData%f_st = SrcOutputData%f_st + DstOutputData%FullySeparate = SrcOutputData%FullySeparate + DstOutputData%FullyAttached = SrcOutputData%FullyAttached +end subroutine + +subroutine AFI_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(AFI_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AFI_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine AFI_PackOutput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(AFI_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AFI_PackOutput' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%Cl) + call RegPack(RF, InData%Cd) + call RegPack(RF, InData%Cm) + call RegPack(RF, InData%Cpmin) + call RegPack(RF, InData%Cd0) + call RegPack(RF, InData%Cm0) + call RegPack(RF, InData%f_st) + call RegPack(RF, InData%FullySeparate) + call RegPack(RF, InData%FullyAttached) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AFI_UnPackOutput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(AFI_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AFI_UnPackOutput' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%Cl); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Cd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Cm); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Cpmin); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Cd0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Cm0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%f_st); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FullySeparate); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FullyAttached); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AFI_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(AFI_OutputType), intent(in) :: y(:) ! Output at t1 > t2 > t3 + real(ReKi), intent(in ) :: t(:) ! Times associated with the Outputs + type(AFI_OutputType), intent(inout) :: y_out ! Output at tin_out + real(ReKi), 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 = 'AFI_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 AFI_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL AFI_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 AFI_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 AFI_Output_ExtrapInterp - - - SUBROUTINE AFI_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'AFI_Output_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(y)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(y)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(y) - 1 + select case (order) + case (0) + call AFI_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call AFI_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call AFI_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(y) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE AFI_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. @@ -2743,57 +1093,49 @@ SUBROUTINE AFI_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ! !.................................................................................................................................. - TYPE(AFI_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 - TYPE(AFI_OutputType), INTENT(IN) :: y2 ! Output at t2 - REAL(ReKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs - TYPE(AFI_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(ReKi), 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 + TYPE(AFI_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 + TYPE(AFI_OutputType), INTENT(IN) :: y2 ! Output at t2 + REAL(ReKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs + TYPE(AFI_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out + REAL(ReKi), 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(ReKi) :: t(2) ! Times associated with the Outputs - REAL(ReKi) :: t_out ! Time to which to be extrap/interpd - CHARACTER(*), PARAMETER :: RoutineName = 'AFI_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 - ! 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 + REAL(ReKi) :: t(2) ! Times associated with the Outputs + REAL(ReKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'AFI_Output_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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) - b = -(y1%Cl - y2%Cl) - y_out%Cl = y1%Cl + b * ScaleFactor - b = -(y1%Cd - y2%Cd) - y_out%Cd = y1%Cd + b * ScaleFactor - b = -(y1%Cm - y2%Cm) - y_out%Cm = y1%Cm + b * ScaleFactor - b = -(y1%Cpmin - y2%Cpmin) - y_out%Cpmin = y1%Cpmin + b * ScaleFactor - b = -(y1%Cd0 - y2%Cd0) - y_out%Cd0 = y1%Cd0 + b * ScaleFactor - b = -(y1%Cm0 - y2%Cm0) - y_out%Cm0 = y1%Cm0 + b * ScaleFactor - b = -(y1%f_st - y2%f_st) - y_out%f_st = y1%f_st + b * ScaleFactor - b = -(y1%FullySeparate - y2%FullySeparate) - y_out%FullySeparate = y1%FullySeparate + b * ScaleFactor - b = -(y1%FullyAttached - y2%FullyAttached) - y_out%FullyAttached = y1%FullyAttached + b * ScaleFactor - END SUBROUTINE AFI_Output_ExtrapInterp1 - - - SUBROUTINE AFI_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + y_out%Cl = a1*y1%Cl + a2*y2%Cl + y_out%Cd = a1*y1%Cd + a2*y2%Cd + y_out%Cm = a1*y1%Cm + a2*y2%Cm + y_out%Cpmin = a1*y1%Cpmin + a2*y2%Cpmin + y_out%Cd0 = a1*y1%Cd0 + a2*y2%Cd0 + y_out%Cm0 = a1*y1%Cm0 + a2*y2%Cm0 + y_out%f_st = a1*y1%f_st + a2*y2%f_st + y_out%FullySeparate = a1*y1%FullySeparate + a2*y2%FullySeparate + y_out%FullyAttached = a1*y1%FullyAttached + a2*y2%FullyAttached +END SUBROUTINE + +SUBROUTINE AFI_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. @@ -2807,126 +1149,109 @@ SUBROUTINE AFI_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Er ! !.................................................................................................................................. - TYPE(AFI_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 > t3 - TYPE(AFI_OutputType), INTENT(IN) :: y2 ! Output at t2 > t3 - TYPE(AFI_OutputType), INTENT(IN) :: y3 ! Output at t3 - REAL(ReKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs - TYPE(AFI_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(ReKi), 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 + TYPE(AFI_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 > t3 + TYPE(AFI_OutputType), INTENT(IN) :: y2 ! Output at t2 > t3 + TYPE(AFI_OutputType), INTENT(IN) :: y3 ! Output at t3 + REAL(ReKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs + TYPE(AFI_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out + REAL(ReKi), 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(ReKi) :: t(3) ! Times associated with the Outputs - REAL(ReKi) :: 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 = 'AFI_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) - + REAL(ReKi) :: t(3) ! Times associated with the Outputs + REAL(ReKi) :: t_out ! Time to which to be extrap/interpd + INTEGER(IntKi) :: order ! order of polynomial fit (max 2) + REAL(DbKi) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'AFI_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 + 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 + 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 + 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))) - b = (t(3)**2*(y1%Cl - y2%Cl) + t(2)**2*(-y1%Cl + y3%Cl))* scaleFactor - c = ( (t(2)-t(3))*y1%Cl + t(3)*y2%Cl - t(2)*y3%Cl ) * scaleFactor - y_out%Cl = y1%Cl + b + c * t_out - b = (t(3)**2*(y1%Cd - y2%Cd) + t(2)**2*(-y1%Cd + y3%Cd))* scaleFactor - c = ( (t(2)-t(3))*y1%Cd + t(3)*y2%Cd - t(2)*y3%Cd ) * scaleFactor - y_out%Cd = y1%Cd + b + c * t_out - b = (t(3)**2*(y1%Cm - y2%Cm) + t(2)**2*(-y1%Cm + y3%Cm))* scaleFactor - c = ( (t(2)-t(3))*y1%Cm + t(3)*y2%Cm - t(2)*y3%Cm ) * scaleFactor - y_out%Cm = y1%Cm + b + c * t_out - b = (t(3)**2*(y1%Cpmin - y2%Cpmin) + t(2)**2*(-y1%Cpmin + y3%Cpmin))* scaleFactor - c = ( (t(2)-t(3))*y1%Cpmin + t(3)*y2%Cpmin - t(2)*y3%Cpmin ) * scaleFactor - y_out%Cpmin = y1%Cpmin + b + c * t_out - b = (t(3)**2*(y1%Cd0 - y2%Cd0) + t(2)**2*(-y1%Cd0 + y3%Cd0))* scaleFactor - c = ( (t(2)-t(3))*y1%Cd0 + t(3)*y2%Cd0 - t(2)*y3%Cd0 ) * scaleFactor - y_out%Cd0 = y1%Cd0 + b + c * t_out - b = (t(3)**2*(y1%Cm0 - y2%Cm0) + t(2)**2*(-y1%Cm0 + y3%Cm0))* scaleFactor - c = ( (t(2)-t(3))*y1%Cm0 + t(3)*y2%Cm0 - t(2)*y3%Cm0 ) * scaleFactor - y_out%Cm0 = y1%Cm0 + b + c * t_out - b = (t(3)**2*(y1%f_st - y2%f_st) + t(2)**2*(-y1%f_st + y3%f_st))* scaleFactor - c = ( (t(2)-t(3))*y1%f_st + t(3)*y2%f_st - t(2)*y3%f_st ) * scaleFactor - y_out%f_st = y1%f_st + b + c * t_out - b = (t(3)**2*(y1%FullySeparate - y2%FullySeparate) + t(2)**2*(-y1%FullySeparate + y3%FullySeparate))* scaleFactor - c = ( (t(2)-t(3))*y1%FullySeparate + t(3)*y2%FullySeparate - t(2)*y3%FullySeparate ) * scaleFactor - y_out%FullySeparate = y1%FullySeparate + b + c * t_out - b = (t(3)**2*(y1%FullyAttached - y2%FullyAttached) + t(2)**2*(-y1%FullyAttached + y3%FullyAttached))* scaleFactor - c = ( (t(2)-t(3))*y1%FullyAttached + t(3)*y2%FullyAttached - t(2)*y3%FullyAttached ) * scaleFactor - y_out%FullyAttached = y1%FullyAttached + b + c * t_out - END SUBROUTINE AFI_Output_ExtrapInterp2 - - - SUBROUTINE AFI_UA_BL_Type_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) UA_BL_Type 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(AFI_UA_BL_Type), INTENT(IN) :: u(:) ! UA_BL_Type at t1 > t2 > t3 - REAL(ReKi), INTENT(IN ) :: t(:) ! Times associated with the UA_BL_Types - TYPE(AFI_UA_BL_Type), INTENT(INOUT) :: u_out ! UA_BL_Type at tin_out - REAL(ReKi), 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 + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + y_out%Cl = a1*y1%Cl + a2*y2%Cl + a3*y3%Cl + y_out%Cd = a1*y1%Cd + a2*y2%Cd + a3*y3%Cd + y_out%Cm = a1*y1%Cm + a2*y2%Cm + a3*y3%Cm + y_out%Cpmin = a1*y1%Cpmin + a2*y2%Cpmin + a3*y3%Cpmin + y_out%Cd0 = a1*y1%Cd0 + a2*y2%Cd0 + a3*y3%Cd0 + y_out%Cm0 = a1*y1%Cm0 + a2*y2%Cm0 + a3*y3%Cm0 + y_out%f_st = a1*y1%f_st + a2*y2%f_st + a3*y3%f_st + y_out%FullySeparate = a1*y1%FullySeparate + a2*y2%FullySeparate + a3*y3%FullySeparate + y_out%FullyAttached = a1*y1%FullyAttached + a2*y2%FullyAttached + a3*y3%FullyAttached +END SUBROUTINE + +subroutine AFI_UA_BL_Type_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg) + ! + ! This subroutine calculates a extrapolated (or interpolated) UA_BL_Type 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(AFI_UA_BL_Type), intent(in) :: u(:) ! UA_BL_Type at t1 > t2 > t3 + real(ReKi), intent(in ) :: t(:) ! Times associated with the UA_BL_Types + type(AFI_UA_BL_Type), intent(inout) :: u_out ! UA_BL_Type at tin_out + real(ReKi), 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 = 'AFI_UA_BL_Type_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 AFI_CopyUA_BL_Type(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL AFI_UA_BL_Type_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 AFI_UA_BL_Type_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 AFI_UA_BL_Type_ExtrapInterp - - - SUBROUTINE AFI_UA_BL_Type_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'AFI_UA_BL_Type_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(u)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(u)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(u) - 1 + select case (order) + case (0) + call AFI_CopyUA_BL_Type(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call AFI_UA_BL_Type_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call AFI_UA_BL_Type_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(u) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE AFI_UA_BL_Type_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) UA_BL_Type 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. @@ -2938,126 +1263,84 @@ SUBROUTINE AFI_UA_BL_Type_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, Er ! !.................................................................................................................................. - TYPE(AFI_UA_BL_Type), INTENT(IN) :: u1 ! UA_BL_Type at t1 > t2 - TYPE(AFI_UA_BL_Type), INTENT(IN) :: u2 ! UA_BL_Type at t2 - REAL(ReKi), INTENT(IN ) :: tin(2) ! Times associated with the UA_BL_Types - TYPE(AFI_UA_BL_Type), INTENT(INOUT) :: u_out ! UA_BL_Type at tin_out - REAL(ReKi), 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 + TYPE(AFI_UA_BL_Type), INTENT(IN) :: u1 ! UA_BL_Type at t1 > t2 + TYPE(AFI_UA_BL_Type), INTENT(IN) :: u2 ! UA_BL_Type at t2 + REAL(ReKi), INTENT(IN ) :: tin(2) ! Times associated with the UA_BL_Types + TYPE(AFI_UA_BL_Type), INTENT(INOUT) :: u_out ! UA_BL_Type at tin_out + REAL(ReKi), 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(ReKi) :: t(2) ! Times associated with the UA_BL_Types - REAL(ReKi) :: t_out ! Time to which to be extrap/interpd - CHARACTER(*), PARAMETER :: RoutineName = 'AFI_UA_BL_Type_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 + REAL(ReKi) :: t(2) ! Times associated with the UA_BL_Types + REAL(ReKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'AFI_UA_BL_Type_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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 Angles_ExtrapInterp( u1%alpha0, u2%alpha0, tin, u_out%alpha0, tin_out ) - CALL Angles_ExtrapInterp( u1%alpha1, u2%alpha1, tin, u_out%alpha1, tin_out ) - CALL Angles_ExtrapInterp( u1%alpha2, u2%alpha2, tin, u_out%alpha2, tin_out ) - b = -(u1%eta_e - u2%eta_e) - u_out%eta_e = u1%eta_e + b * ScaleFactor - b = -(u1%C_nalpha - u2%C_nalpha) - u_out%C_nalpha = u1%C_nalpha + b * ScaleFactor - b = -(u1%C_lalpha - u2%C_lalpha) - u_out%C_lalpha = u1%C_lalpha + b * ScaleFactor - b = -(u1%T_f0 - u2%T_f0) - u_out%T_f0 = u1%T_f0 + b * ScaleFactor - b = -(u1%T_V0 - u2%T_V0) - u_out%T_V0 = u1%T_V0 + b * ScaleFactor - b = -(u1%T_p - u2%T_p) - u_out%T_p = u1%T_p + b * ScaleFactor - b = -(u1%T_VL - u2%T_VL) - u_out%T_VL = u1%T_VL + b * ScaleFactor - b = -(u1%b1 - u2%b1) - u_out%b1 = u1%b1 + b * ScaleFactor - b = -(u1%b2 - u2%b2) - u_out%b2 = u1%b2 + b * ScaleFactor - b = -(u1%b5 - u2%b5) - u_out%b5 = u1%b5 + b * ScaleFactor - b = -(u1%A1 - u2%A1) - u_out%A1 = u1%A1 + b * ScaleFactor - b = -(u1%A2 - u2%A2) - u_out%A2 = u1%A2 + b * ScaleFactor - b = -(u1%A5 - u2%A5) - u_out%A5 = u1%A5 + b * ScaleFactor - b = -(u1%S1 - u2%S1) - u_out%S1 = u1%S1 + b * ScaleFactor - b = -(u1%S2 - u2%S2) - u_out%S2 = u1%S2 + b * ScaleFactor - b = -(u1%S3 - u2%S3) - u_out%S3 = u1%S3 + b * ScaleFactor - b = -(u1%S4 - u2%S4) - u_out%S4 = u1%S4 + b * ScaleFactor - b = -(u1%Cn1 - u2%Cn1) - u_out%Cn1 = u1%Cn1 + b * ScaleFactor - b = -(u1%Cn2 - u2%Cn2) - u_out%Cn2 = u1%Cn2 + b * ScaleFactor - b = -(u1%St_sh - u2%St_sh) - u_out%St_sh = u1%St_sh + b * ScaleFactor - b = -(u1%Cd0 - u2%Cd0) - u_out%Cd0 = u1%Cd0 + b * ScaleFactor - b = -(u1%Cm0 - u2%Cm0) - u_out%Cm0 = u1%Cm0 + b * ScaleFactor - b = -(u1%k0 - u2%k0) - u_out%k0 = u1%k0 + b * ScaleFactor - b = -(u1%k1 - u2%k1) - u_out%k1 = u1%k1 + b * ScaleFactor - b = -(u1%k2 - u2%k2) - u_out%k2 = u1%k2 + b * ScaleFactor - b = -(u1%k3 - u2%k3) - u_out%k3 = u1%k3 + b * ScaleFactor - b = -(u1%k1_hat - u2%k1_hat) - u_out%k1_hat = u1%k1_hat + b * ScaleFactor - b = -(u1%x_cp_bar - u2%x_cp_bar) - u_out%x_cp_bar = u1%x_cp_bar + b * ScaleFactor - b = -(u1%UACutout - u2%UACutout) - u_out%UACutout = u1%UACutout + b * ScaleFactor - b = -(u1%UACutout_delta - u2%UACutout_delta) - u_out%UACutout_delta = u1%UACutout_delta + b * ScaleFactor - b = -(u1%UACutout_blend - u2%UACutout_blend) - u_out%UACutout_blend = u1%UACutout_blend + b * ScaleFactor - b = -(u1%filtCutOff - u2%filtCutOff) - u_out%filtCutOff = u1%filtCutOff + b * ScaleFactor - CALL Angles_ExtrapInterp( u1%alphaUpper, u2%alphaUpper, tin, u_out%alphaUpper, tin_out ) - CALL Angles_ExtrapInterp( u1%alphaLower, u2%alphaLower, tin, u_out%alphaLower, tin_out ) - b = -(u1%c_Rate - u2%c_Rate) - u_out%c_Rate = u1%c_Rate + b * ScaleFactor - b = -(u1%c_RateUpper - u2%c_RateUpper) - u_out%c_RateUpper = u1%c_RateUpper + b * ScaleFactor - b = -(u1%c_RateLower - u2%c_RateLower) - u_out%c_RateLower = u1%c_RateLower + b * ScaleFactor - b = -(u1%c_alphaLower - u2%c_alphaLower) - u_out%c_alphaLower = u1%c_alphaLower + b * ScaleFactor - b = -(u1%c_alphaUpper - u2%c_alphaUpper) - u_out%c_alphaUpper = u1%c_alphaUpper + b * ScaleFactor - CALL Angles_ExtrapInterp( u1%alphaUpperWrap, u2%alphaUpperWrap, tin, u_out%alphaUpperWrap, tin_out ) - CALL Angles_ExtrapInterp( u1%alphaLowerWrap, u2%alphaLowerWrap, tin, u_out%alphaLowerWrap, tin_out ) - b = -(u1%c_RateWrap - u2%c_RateWrap) - u_out%c_RateWrap = u1%c_RateWrap + b * ScaleFactor - b = -(u1%c_alphaLowerWrap - u2%c_alphaLowerWrap) - u_out%c_alphaLowerWrap = u1%c_alphaLowerWrap + b * ScaleFactor - b = -(u1%c_alphaUpperWrap - u2%c_alphaUpperWrap) - u_out%c_alphaUpperWrap = u1%c_alphaUpperWrap + b * ScaleFactor - END SUBROUTINE AFI_UA_BL_Type_ExtrapInterp1 - - - SUBROUTINE AFI_UA_BL_Type_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + CALL Angles_ExtrapInterp( u1%alpha0, u2%alpha0, tin, u_out%alpha0, tin_out ) + CALL Angles_ExtrapInterp( u1%alpha1, u2%alpha1, tin, u_out%alpha1, tin_out ) + CALL Angles_ExtrapInterp( u1%alpha2, u2%alpha2, tin, u_out%alpha2, tin_out ) + u_out%eta_e = a1*u1%eta_e + a2*u2%eta_e + u_out%C_nalpha = a1*u1%C_nalpha + a2*u2%C_nalpha + u_out%C_lalpha = a1*u1%C_lalpha + a2*u2%C_lalpha + u_out%T_f0 = a1*u1%T_f0 + a2*u2%T_f0 + u_out%T_V0 = a1*u1%T_V0 + a2*u2%T_V0 + u_out%T_p = a1*u1%T_p + a2*u2%T_p + u_out%T_VL = a1*u1%T_VL + a2*u2%T_VL + u_out%b1 = a1*u1%b1 + a2*u2%b1 + u_out%b2 = a1*u1%b2 + a2*u2%b2 + u_out%b5 = a1*u1%b5 + a2*u2%b5 + u_out%A1 = a1*u1%A1 + a2*u2%A1 + u_out%A2 = a1*u1%A2 + a2*u2%A2 + u_out%A5 = a1*u1%A5 + a2*u2%A5 + u_out%S1 = a1*u1%S1 + a2*u2%S1 + u_out%S2 = a1*u1%S2 + a2*u2%S2 + u_out%S3 = a1*u1%S3 + a2*u2%S3 + u_out%S4 = a1*u1%S4 + a2*u2%S4 + u_out%Cn1 = a1*u1%Cn1 + a2*u2%Cn1 + u_out%Cn2 = a1*u1%Cn2 + a2*u2%Cn2 + u_out%St_sh = a1*u1%St_sh + a2*u2%St_sh + u_out%Cd0 = a1*u1%Cd0 + a2*u2%Cd0 + u_out%Cm0 = a1*u1%Cm0 + a2*u2%Cm0 + u_out%k0 = a1*u1%k0 + a2*u2%k0 + u_out%k1 = a1*u1%k1 + a2*u2%k1 + u_out%k2 = a1*u1%k2 + a2*u2%k2 + u_out%k3 = a1*u1%k3 + a2*u2%k3 + u_out%k1_hat = a1*u1%k1_hat + a2*u2%k1_hat + u_out%x_cp_bar = a1*u1%x_cp_bar + a2*u2%x_cp_bar + u_out%UACutout = a1*u1%UACutout + a2*u2%UACutout + u_out%UACutout_delta = a1*u1%UACutout_delta + a2*u2%UACutout_delta + u_out%UACutout_blend = a1*u1%UACutout_blend + a2*u2%UACutout_blend + u_out%filtCutOff = a1*u1%filtCutOff + a2*u2%filtCutOff + CALL Angles_ExtrapInterp( u1%alphaUpper, u2%alphaUpper, tin, u_out%alphaUpper, tin_out ) + CALL Angles_ExtrapInterp( u1%alphaLower, u2%alphaLower, tin, u_out%alphaLower, tin_out ) + u_out%c_alphaLower = a1*u1%c_alphaLower + a2*u2%c_alphaLower + u_out%c_alphaUpper = a1*u1%c_alphaUpper + a2*u2%c_alphaUpper + CALL Angles_ExtrapInterp( u1%alpha0ReverseFlow, u2%alpha0ReverseFlow, tin, u_out%alpha0ReverseFlow, tin_out ) + CALL Angles_ExtrapInterp( u1%alphaBreakUpper, u2%alphaBreakUpper, tin, u_out%alphaBreakUpper, tin_out ) + u_out%CnBreakUpper = a1*u1%CnBreakUpper + a2*u2%CnBreakUpper + CALL Angles_ExtrapInterp( u1%alphaBreakLower, u2%alphaBreakLower, tin, u_out%alphaBreakLower, tin_out ) + u_out%CnBreakLower = a1*u1%CnBreakLower + a2*u2%CnBreakLower +END SUBROUTINE + +SUBROUTINE AFI_UA_BL_Type_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) UA_BL_Type 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. @@ -3071,172 +1354,89 @@ SUBROUTINE AFI_UA_BL_Type_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat ! !.................................................................................................................................. - TYPE(AFI_UA_BL_Type), INTENT(IN) :: u1 ! UA_BL_Type at t1 > t2 > t3 - TYPE(AFI_UA_BL_Type), INTENT(IN) :: u2 ! UA_BL_Type at t2 > t3 - TYPE(AFI_UA_BL_Type), INTENT(IN) :: u3 ! UA_BL_Type at t3 - REAL(ReKi), INTENT(IN ) :: tin(3) ! Times associated with the UA_BL_Types - TYPE(AFI_UA_BL_Type), INTENT(INOUT) :: u_out ! UA_BL_Type at tin_out - REAL(ReKi), 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 + TYPE(AFI_UA_BL_Type), INTENT(IN) :: u1 ! UA_BL_Type at t1 > t2 > t3 + TYPE(AFI_UA_BL_Type), INTENT(IN) :: u2 ! UA_BL_Type at t2 > t3 + TYPE(AFI_UA_BL_Type), INTENT(IN) :: u3 ! UA_BL_Type at t3 + REAL(ReKi), INTENT(IN ) :: tin(3) ! Times associated with the UA_BL_Types + TYPE(AFI_UA_BL_Type), INTENT(INOUT) :: u_out ! UA_BL_Type at tin_out + REAL(ReKi), 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(ReKi) :: t(3) ! Times associated with the UA_BL_Types - REAL(ReKi) :: 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 = 'AFI_UA_BL_Type_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) - + REAL(ReKi) :: t(3) ! Times associated with the UA_BL_Types + REAL(ReKi) :: t_out ! Time to which to be extrap/interpd + INTEGER(IntKi) :: order ! order of polynomial fit (max 2) + REAL(DbKi) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'AFI_UA_BL_Type_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 + 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 + 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 + 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 Angles_ExtrapInterp( u1%alpha0, u2%alpha0, u3%alpha0, tin, u_out%alpha0, tin_out ) - CALL Angles_ExtrapInterp( u1%alpha1, u2%alpha1, u3%alpha1, tin, u_out%alpha1, tin_out ) - CALL Angles_ExtrapInterp( u1%alpha2, u2%alpha2, u3%alpha2, tin, u_out%alpha2, tin_out ) - b = (t(3)**2*(u1%eta_e - u2%eta_e) + t(2)**2*(-u1%eta_e + u3%eta_e))* scaleFactor - c = ( (t(2)-t(3))*u1%eta_e + t(3)*u2%eta_e - t(2)*u3%eta_e ) * scaleFactor - u_out%eta_e = u1%eta_e + b + c * t_out - b = (t(3)**2*(u1%C_nalpha - u2%C_nalpha) + t(2)**2*(-u1%C_nalpha + u3%C_nalpha))* scaleFactor - c = ( (t(2)-t(3))*u1%C_nalpha + t(3)*u2%C_nalpha - t(2)*u3%C_nalpha ) * scaleFactor - u_out%C_nalpha = u1%C_nalpha + b + c * t_out - b = (t(3)**2*(u1%C_lalpha - u2%C_lalpha) + t(2)**2*(-u1%C_lalpha + u3%C_lalpha))* scaleFactor - c = ( (t(2)-t(3))*u1%C_lalpha + t(3)*u2%C_lalpha - t(2)*u3%C_lalpha ) * scaleFactor - u_out%C_lalpha = u1%C_lalpha + b + c * t_out - b = (t(3)**2*(u1%T_f0 - u2%T_f0) + t(2)**2*(-u1%T_f0 + u3%T_f0))* scaleFactor - c = ( (t(2)-t(3))*u1%T_f0 + t(3)*u2%T_f0 - t(2)*u3%T_f0 ) * scaleFactor - u_out%T_f0 = u1%T_f0 + b + c * t_out - b = (t(3)**2*(u1%T_V0 - u2%T_V0) + t(2)**2*(-u1%T_V0 + u3%T_V0))* scaleFactor - c = ( (t(2)-t(3))*u1%T_V0 + t(3)*u2%T_V0 - t(2)*u3%T_V0 ) * scaleFactor - u_out%T_V0 = u1%T_V0 + b + c * t_out - b = (t(3)**2*(u1%T_p - u2%T_p) + t(2)**2*(-u1%T_p + u3%T_p))* scaleFactor - c = ( (t(2)-t(3))*u1%T_p + t(3)*u2%T_p - t(2)*u3%T_p ) * scaleFactor - u_out%T_p = u1%T_p + b + c * t_out - b = (t(3)**2*(u1%T_VL - u2%T_VL) + t(2)**2*(-u1%T_VL + u3%T_VL))* scaleFactor - c = ( (t(2)-t(3))*u1%T_VL + t(3)*u2%T_VL - t(2)*u3%T_VL ) * scaleFactor - u_out%T_VL = u1%T_VL + b + c * t_out - b = (t(3)**2*(u1%b1 - u2%b1) + t(2)**2*(-u1%b1 + u3%b1))* scaleFactor - c = ( (t(2)-t(3))*u1%b1 + t(3)*u2%b1 - t(2)*u3%b1 ) * scaleFactor - u_out%b1 = u1%b1 + b + c * t_out - b = (t(3)**2*(u1%b2 - u2%b2) + t(2)**2*(-u1%b2 + u3%b2))* scaleFactor - c = ( (t(2)-t(3))*u1%b2 + t(3)*u2%b2 - t(2)*u3%b2 ) * scaleFactor - u_out%b2 = u1%b2 + b + c * t_out - b = (t(3)**2*(u1%b5 - u2%b5) + t(2)**2*(-u1%b5 + u3%b5))* scaleFactor - c = ( (t(2)-t(3))*u1%b5 + t(3)*u2%b5 - t(2)*u3%b5 ) * scaleFactor - u_out%b5 = u1%b5 + b + c * t_out - b = (t(3)**2*(u1%A1 - u2%A1) + t(2)**2*(-u1%A1 + u3%A1))* scaleFactor - c = ( (t(2)-t(3))*u1%A1 + t(3)*u2%A1 - t(2)*u3%A1 ) * scaleFactor - u_out%A1 = u1%A1 + b + c * t_out - b = (t(3)**2*(u1%A2 - u2%A2) + t(2)**2*(-u1%A2 + u3%A2))* scaleFactor - c = ( (t(2)-t(3))*u1%A2 + t(3)*u2%A2 - t(2)*u3%A2 ) * scaleFactor - u_out%A2 = u1%A2 + b + c * t_out - b = (t(3)**2*(u1%A5 - u2%A5) + t(2)**2*(-u1%A5 + u3%A5))* scaleFactor - c = ( (t(2)-t(3))*u1%A5 + t(3)*u2%A5 - t(2)*u3%A5 ) * scaleFactor - u_out%A5 = u1%A5 + b + c * t_out - b = (t(3)**2*(u1%S1 - u2%S1) + t(2)**2*(-u1%S1 + u3%S1))* scaleFactor - c = ( (t(2)-t(3))*u1%S1 + t(3)*u2%S1 - t(2)*u3%S1 ) * scaleFactor - u_out%S1 = u1%S1 + b + c * t_out - b = (t(3)**2*(u1%S2 - u2%S2) + t(2)**2*(-u1%S2 + u3%S2))* scaleFactor - c = ( (t(2)-t(3))*u1%S2 + t(3)*u2%S2 - t(2)*u3%S2 ) * scaleFactor - u_out%S2 = u1%S2 + b + c * t_out - b = (t(3)**2*(u1%S3 - u2%S3) + t(2)**2*(-u1%S3 + u3%S3))* scaleFactor - c = ( (t(2)-t(3))*u1%S3 + t(3)*u2%S3 - t(2)*u3%S3 ) * scaleFactor - u_out%S3 = u1%S3 + b + c * t_out - b = (t(3)**2*(u1%S4 - u2%S4) + t(2)**2*(-u1%S4 + u3%S4))* scaleFactor - c = ( (t(2)-t(3))*u1%S4 + t(3)*u2%S4 - t(2)*u3%S4 ) * scaleFactor - u_out%S4 = u1%S4 + b + c * t_out - b = (t(3)**2*(u1%Cn1 - u2%Cn1) + t(2)**2*(-u1%Cn1 + u3%Cn1))* scaleFactor - c = ( (t(2)-t(3))*u1%Cn1 + t(3)*u2%Cn1 - t(2)*u3%Cn1 ) * scaleFactor - u_out%Cn1 = u1%Cn1 + b + c * t_out - b = (t(3)**2*(u1%Cn2 - u2%Cn2) + t(2)**2*(-u1%Cn2 + u3%Cn2))* scaleFactor - c = ( (t(2)-t(3))*u1%Cn2 + t(3)*u2%Cn2 - t(2)*u3%Cn2 ) * scaleFactor - u_out%Cn2 = u1%Cn2 + b + c * t_out - b = (t(3)**2*(u1%St_sh - u2%St_sh) + t(2)**2*(-u1%St_sh + u3%St_sh))* scaleFactor - c = ( (t(2)-t(3))*u1%St_sh + t(3)*u2%St_sh - t(2)*u3%St_sh ) * scaleFactor - u_out%St_sh = u1%St_sh + b + c * t_out - b = (t(3)**2*(u1%Cd0 - u2%Cd0) + t(2)**2*(-u1%Cd0 + u3%Cd0))* scaleFactor - c = ( (t(2)-t(3))*u1%Cd0 + t(3)*u2%Cd0 - t(2)*u3%Cd0 ) * scaleFactor - u_out%Cd0 = u1%Cd0 + b + c * t_out - b = (t(3)**2*(u1%Cm0 - u2%Cm0) + t(2)**2*(-u1%Cm0 + u3%Cm0))* scaleFactor - c = ( (t(2)-t(3))*u1%Cm0 + t(3)*u2%Cm0 - t(2)*u3%Cm0 ) * scaleFactor - u_out%Cm0 = u1%Cm0 + b + c * t_out - b = (t(3)**2*(u1%k0 - u2%k0) + t(2)**2*(-u1%k0 + u3%k0))* scaleFactor - c = ( (t(2)-t(3))*u1%k0 + t(3)*u2%k0 - t(2)*u3%k0 ) * scaleFactor - u_out%k0 = u1%k0 + b + c * t_out - b = (t(3)**2*(u1%k1 - u2%k1) + t(2)**2*(-u1%k1 + u3%k1))* scaleFactor - c = ( (t(2)-t(3))*u1%k1 + t(3)*u2%k1 - t(2)*u3%k1 ) * scaleFactor - u_out%k1 = u1%k1 + b + c * t_out - b = (t(3)**2*(u1%k2 - u2%k2) + t(2)**2*(-u1%k2 + u3%k2))* scaleFactor - c = ( (t(2)-t(3))*u1%k2 + t(3)*u2%k2 - t(2)*u3%k2 ) * scaleFactor - u_out%k2 = u1%k2 + b + c * t_out - b = (t(3)**2*(u1%k3 - u2%k3) + t(2)**2*(-u1%k3 + u3%k3))* scaleFactor - c = ( (t(2)-t(3))*u1%k3 + t(3)*u2%k3 - t(2)*u3%k3 ) * scaleFactor - u_out%k3 = u1%k3 + b + c * t_out - b = (t(3)**2*(u1%k1_hat - u2%k1_hat) + t(2)**2*(-u1%k1_hat + u3%k1_hat))* scaleFactor - c = ( (t(2)-t(3))*u1%k1_hat + t(3)*u2%k1_hat - t(2)*u3%k1_hat ) * scaleFactor - u_out%k1_hat = u1%k1_hat + b + c * t_out - b = (t(3)**2*(u1%x_cp_bar - u2%x_cp_bar) + t(2)**2*(-u1%x_cp_bar + u3%x_cp_bar))* scaleFactor - c = ( (t(2)-t(3))*u1%x_cp_bar + t(3)*u2%x_cp_bar - t(2)*u3%x_cp_bar ) * scaleFactor - u_out%x_cp_bar = u1%x_cp_bar + b + c * t_out - b = (t(3)**2*(u1%UACutout - u2%UACutout) + t(2)**2*(-u1%UACutout + u3%UACutout))* scaleFactor - c = ( (t(2)-t(3))*u1%UACutout + t(3)*u2%UACutout - t(2)*u3%UACutout ) * scaleFactor - u_out%UACutout = u1%UACutout + b + c * t_out - b = (t(3)**2*(u1%UACutout_delta - u2%UACutout_delta) + t(2)**2*(-u1%UACutout_delta + u3%UACutout_delta))* scaleFactor - c = ( (t(2)-t(3))*u1%UACutout_delta + t(3)*u2%UACutout_delta - t(2)*u3%UACutout_delta ) * scaleFactor - u_out%UACutout_delta = u1%UACutout_delta + b + c * t_out - b = (t(3)**2*(u1%UACutout_blend - u2%UACutout_blend) + t(2)**2*(-u1%UACutout_blend + u3%UACutout_blend))* scaleFactor - c = ( (t(2)-t(3))*u1%UACutout_blend + t(3)*u2%UACutout_blend - t(2)*u3%UACutout_blend ) * scaleFactor - u_out%UACutout_blend = u1%UACutout_blend + b + c * t_out - b = (t(3)**2*(u1%filtCutOff - u2%filtCutOff) + t(2)**2*(-u1%filtCutOff + u3%filtCutOff))* scaleFactor - c = ( (t(2)-t(3))*u1%filtCutOff + t(3)*u2%filtCutOff - t(2)*u3%filtCutOff ) * scaleFactor - u_out%filtCutOff = u1%filtCutOff + b + c * t_out - CALL Angles_ExtrapInterp( u1%alphaUpper, u2%alphaUpper, u3%alphaUpper, tin, u_out%alphaUpper, tin_out ) - CALL Angles_ExtrapInterp( u1%alphaLower, u2%alphaLower, u3%alphaLower, tin, u_out%alphaLower, tin_out ) - b = (t(3)**2*(u1%c_Rate - u2%c_Rate) + t(2)**2*(-u1%c_Rate + u3%c_Rate))* scaleFactor - c = ( (t(2)-t(3))*u1%c_Rate + t(3)*u2%c_Rate - t(2)*u3%c_Rate ) * scaleFactor - u_out%c_Rate = u1%c_Rate + b + c * t_out - b = (t(3)**2*(u1%c_RateUpper - u2%c_RateUpper) + t(2)**2*(-u1%c_RateUpper + u3%c_RateUpper))* scaleFactor - c = ( (t(2)-t(3))*u1%c_RateUpper + t(3)*u2%c_RateUpper - t(2)*u3%c_RateUpper ) * scaleFactor - u_out%c_RateUpper = u1%c_RateUpper + b + c * t_out - b = (t(3)**2*(u1%c_RateLower - u2%c_RateLower) + t(2)**2*(-u1%c_RateLower + u3%c_RateLower))* scaleFactor - c = ( (t(2)-t(3))*u1%c_RateLower + t(3)*u2%c_RateLower - t(2)*u3%c_RateLower ) * scaleFactor - u_out%c_RateLower = u1%c_RateLower + b + c * t_out - b = (t(3)**2*(u1%c_alphaLower - u2%c_alphaLower) + t(2)**2*(-u1%c_alphaLower + u3%c_alphaLower))* scaleFactor - c = ( (t(2)-t(3))*u1%c_alphaLower + t(3)*u2%c_alphaLower - t(2)*u3%c_alphaLower ) * scaleFactor - u_out%c_alphaLower = u1%c_alphaLower + b + c * t_out - b = (t(3)**2*(u1%c_alphaUpper - u2%c_alphaUpper) + t(2)**2*(-u1%c_alphaUpper + u3%c_alphaUpper))* scaleFactor - c = ( (t(2)-t(3))*u1%c_alphaUpper + t(3)*u2%c_alphaUpper - t(2)*u3%c_alphaUpper ) * scaleFactor - u_out%c_alphaUpper = u1%c_alphaUpper + b + c * t_out - CALL Angles_ExtrapInterp( u1%alphaUpperWrap, u2%alphaUpperWrap, u3%alphaUpperWrap, tin, u_out%alphaUpperWrap, tin_out ) - CALL Angles_ExtrapInterp( u1%alphaLowerWrap, u2%alphaLowerWrap, u3%alphaLowerWrap, tin, u_out%alphaLowerWrap, tin_out ) - b = (t(3)**2*(u1%c_RateWrap - u2%c_RateWrap) + t(2)**2*(-u1%c_RateWrap + u3%c_RateWrap))* scaleFactor - c = ( (t(2)-t(3))*u1%c_RateWrap + t(3)*u2%c_RateWrap - t(2)*u3%c_RateWrap ) * scaleFactor - u_out%c_RateWrap = u1%c_RateWrap + b + c * t_out - b = (t(3)**2*(u1%c_alphaLowerWrap - u2%c_alphaLowerWrap) + t(2)**2*(-u1%c_alphaLowerWrap + u3%c_alphaLowerWrap))* scaleFactor - c = ( (t(2)-t(3))*u1%c_alphaLowerWrap + t(3)*u2%c_alphaLowerWrap - t(2)*u3%c_alphaLowerWrap ) * scaleFactor - u_out%c_alphaLowerWrap = u1%c_alphaLowerWrap + b + c * t_out - b = (t(3)**2*(u1%c_alphaUpperWrap - u2%c_alphaUpperWrap) + t(2)**2*(-u1%c_alphaUpperWrap + u3%c_alphaUpperWrap))* scaleFactor - c = ( (t(2)-t(3))*u1%c_alphaUpperWrap + t(3)*u2%c_alphaUpperWrap - t(2)*u3%c_alphaUpperWrap ) * scaleFactor - u_out%c_alphaUpperWrap = u1%c_alphaUpperWrap + b + c * t_out - END SUBROUTINE AFI_UA_BL_Type_ExtrapInterp2 - + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + CALL Angles_ExtrapInterp( u1%alpha0, u2%alpha0, u3%alpha0, tin, u_out%alpha0, tin_out ) + CALL Angles_ExtrapInterp( u1%alpha1, u2%alpha1, u3%alpha1, tin, u_out%alpha1, tin_out ) + CALL Angles_ExtrapInterp( u1%alpha2, u2%alpha2, u3%alpha2, tin, u_out%alpha2, tin_out ) + u_out%eta_e = a1*u1%eta_e + a2*u2%eta_e + a3*u3%eta_e + u_out%C_nalpha = a1*u1%C_nalpha + a2*u2%C_nalpha + a3*u3%C_nalpha + u_out%C_lalpha = a1*u1%C_lalpha + a2*u2%C_lalpha + a3*u3%C_lalpha + u_out%T_f0 = a1*u1%T_f0 + a2*u2%T_f0 + a3*u3%T_f0 + u_out%T_V0 = a1*u1%T_V0 + a2*u2%T_V0 + a3*u3%T_V0 + u_out%T_p = a1*u1%T_p + a2*u2%T_p + a3*u3%T_p + u_out%T_VL = a1*u1%T_VL + a2*u2%T_VL + a3*u3%T_VL + u_out%b1 = a1*u1%b1 + a2*u2%b1 + a3*u3%b1 + u_out%b2 = a1*u1%b2 + a2*u2%b2 + a3*u3%b2 + u_out%b5 = a1*u1%b5 + a2*u2%b5 + a3*u3%b5 + u_out%A1 = a1*u1%A1 + a2*u2%A1 + a3*u3%A1 + u_out%A2 = a1*u1%A2 + a2*u2%A2 + a3*u3%A2 + u_out%A5 = a1*u1%A5 + a2*u2%A5 + a3*u3%A5 + u_out%S1 = a1*u1%S1 + a2*u2%S1 + a3*u3%S1 + u_out%S2 = a1*u1%S2 + a2*u2%S2 + a3*u3%S2 + u_out%S3 = a1*u1%S3 + a2*u2%S3 + a3*u3%S3 + u_out%S4 = a1*u1%S4 + a2*u2%S4 + a3*u3%S4 + u_out%Cn1 = a1*u1%Cn1 + a2*u2%Cn1 + a3*u3%Cn1 + u_out%Cn2 = a1*u1%Cn2 + a2*u2%Cn2 + a3*u3%Cn2 + u_out%St_sh = a1*u1%St_sh + a2*u2%St_sh + a3*u3%St_sh + u_out%Cd0 = a1*u1%Cd0 + a2*u2%Cd0 + a3*u3%Cd0 + u_out%Cm0 = a1*u1%Cm0 + a2*u2%Cm0 + a3*u3%Cm0 + u_out%k0 = a1*u1%k0 + a2*u2%k0 + a3*u3%k0 + u_out%k1 = a1*u1%k1 + a2*u2%k1 + a3*u3%k1 + u_out%k2 = a1*u1%k2 + a2*u2%k2 + a3*u3%k2 + u_out%k3 = a1*u1%k3 + a2*u2%k3 + a3*u3%k3 + u_out%k1_hat = a1*u1%k1_hat + a2*u2%k1_hat + a3*u3%k1_hat + u_out%x_cp_bar = a1*u1%x_cp_bar + a2*u2%x_cp_bar + a3*u3%x_cp_bar + u_out%UACutout = a1*u1%UACutout + a2*u2%UACutout + a3*u3%UACutout + u_out%UACutout_delta = a1*u1%UACutout_delta + a2*u2%UACutout_delta + a3*u3%UACutout_delta + u_out%UACutout_blend = a1*u1%UACutout_blend + a2*u2%UACutout_blend + a3*u3%UACutout_blend + u_out%filtCutOff = a1*u1%filtCutOff + a2*u2%filtCutOff + a3*u3%filtCutOff + CALL Angles_ExtrapInterp( u1%alphaUpper, u2%alphaUpper, u3%alphaUpper, tin, u_out%alphaUpper, tin_out ) + CALL Angles_ExtrapInterp( u1%alphaLower, u2%alphaLower, u3%alphaLower, tin, u_out%alphaLower, tin_out ) + u_out%c_alphaLower = a1*u1%c_alphaLower + a2*u2%c_alphaLower + a3*u3%c_alphaLower + u_out%c_alphaUpper = a1*u1%c_alphaUpper + a2*u2%c_alphaUpper + a3*u3%c_alphaUpper + CALL Angles_ExtrapInterp( u1%alpha0ReverseFlow, u2%alpha0ReverseFlow, u3%alpha0ReverseFlow, tin, u_out%alpha0ReverseFlow, tin_out ) + CALL Angles_ExtrapInterp( u1%alphaBreakUpper, u2%alphaBreakUpper, u3%alphaBreakUpper, tin, u_out%alphaBreakUpper, tin_out ) + u_out%CnBreakUpper = a1*u1%CnBreakUpper + a2*u2%CnBreakUpper + a3*u3%CnBreakUpper + CALL Angles_ExtrapInterp( u1%alphaBreakLower, u2%alphaBreakLower, u3%alphaBreakLower, tin, u_out%alphaBreakLower, tin_out ) + u_out%CnBreakLower = a1*u1%CnBreakLower + a2*u2%CnBreakLower + a3*u3%CnBreakLower +END SUBROUTINE END MODULE AirfoilInfo_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/aerodyn/src/BEMT.f90 b/modules/aerodyn/src/BEMT.f90 index 33fe5d2821..04df6a4098 100644 --- a/modules/aerodyn/src/BEMT.f90 +++ b/modules/aerodyn/src/BEMT.f90 @@ -90,6 +90,21 @@ real(ReKi) function ComputePhiWithInduction( Vx, Vy, a, aprime, cantAngle, xVelC end function ComputePhiWithInduction +subroutine ComputePhiFromInductions(u, p, phi, axInduction, tanInduction) + type(BEMT_InputType), intent(in ) :: u + type(BEMT_ParameterType), intent(in ) :: p + real(ReKi), intent(inout) :: phi(:,:) + real(ReKi), intent(in ) :: axInduction(:,:) + real(ReKi), intent(in ) :: tanInduction(:,:) + integer(IntKi) :: i, j + do j = 1,p%numBlades ! Loop through all blades + do i = 1,p%numBladeNodes ! Loop through the blade nodes / elements + phi(i,j) = ComputePhiWithInduction( u%Vx(i,j), u%Vy(i,j), axInduction(i,j), tanInduction(i,j), u%cantAngle(i,j), u%xVelCorr(i,j) ) + enddo ! I - Blade nodes / elements + enddo ! J - All blades +end subroutine ComputePhiFromInductions + + !---------------------------------------------------------------------------------------------------------------------------------- subroutine BEMT_Set_UA_InitData( InitInp, interval, Init_UA_Data, errStat, errMsg ) ! This routine is called from BEMT_Init. @@ -97,7 +112,7 @@ subroutine BEMT_Set_UA_InitData( InitInp, interval, Init_UA_Data, errStat, errMs !.................................................................................................................................. type(BEMT_InitInputType), intent(inout) :: InitInp ! Input data for initialization routine real(DbKi), intent(in ) :: interval ! time interval - type(UA_InitInputType), intent( out) :: Init_UA_Data ! Parameters + type(UA_InitInputType), intent(inout) :: Init_UA_Data ! Parameters integer(IntKi), intent( out) :: errStat ! Error status of the operation character(*), intent( out) :: errMsg ! Error message if ErrStat /= ErrID_None @@ -122,21 +137,14 @@ subroutine BEMT_Set_UA_InitData( InitInp, interval, Init_UA_Data, errStat, errMs end do end do - call move_alloc(InitInp%UAOff_innerNode, Init_UA_Data%UAOff_innerNode) - call move_alloc(InitInp%UAOff_outerNode, Init_UA_Data%UAOff_outerNode) - - Init_UA_Data%dt = interval - Init_UA_Data%OutRootName = InitInp%RootName ! was 'Debug.UA' + Init_UA_Data%dt = interval + Init_UA_Data%OutRootName = trim(InitInp%RootName)//'.UA' Init_UA_Data%numBlades = InitInp%numBlades Init_UA_Data%nNodesPerBlade = InitInp%numBladeNodes - - Init_UA_Data%UAMod = InitInp%UAMod - Init_UA_Data%Flookup = InitInp%Flookup - Init_UA_Data%a_s = InitInp%a_s ! m/s - Init_UA_Data%ShedEffect = .true. ! This should be true when coupled to BEM - Init_UA_Data%WrSum = InitInp%SumPrint + Init_UA_Data%ShedEffect = .true. ! This should be true when coupled to BEM + end subroutine BEMT_Set_UA_InitData @@ -155,7 +163,10 @@ subroutine BEMT_SetParameters( InitInp, p, errStat, errMsg ) integer(IntKi) :: errStat2 ! temporary Error status of the operation character(*), parameter :: RoutineName = 'BEMT_SetParameters' integer(IntKi) :: i, j - + + ! variables for computing weights: + real(ReKi) :: u(InitInp%numBladeNodes) + real(ReKi) :: k_sum real(ReKi), parameter :: FractionMax = 0.7 ! fraction of rotor disk where weighted average should be maximum real(ReKi), parameter :: FractionRadius = 0.1 ! radius of smoothing (fraction of rotor disk around FractionMax) ! constants for kernelType_TRIWEIGHT: @@ -172,10 +183,9 @@ subroutine BEMT_SetParameters( InitInp, p, errStat, errMsg ) p%numBlades = InitInp%numBlades p%UA_Flag = InitInp%UA_Flag p%DBEMT_Mod = InitInp%DBEMT_Mod - p%MomentumCorr = InitInp%MomentumCorr p%BEM_Mod = InitInp%BEM_Mod !call WrScr('>>>> BEM_Mod '//trim(num2lstr(p%BEM_Mod))) - if ((p%BEM_Mod/=BEMMod_2D .and. p%BEM_Mod/=BEMMod_3D )) then + if (.not.(ANY( p%BEM_Mod == (/BEMMod_2D, BEMMod_3D/)))) then call SetErrStat( ErrID_Fatal, 'BEM_Mod needs to be 0 or 2 for now', errStat, errMsg, RoutineName ) return endif @@ -217,6 +227,13 @@ subroutine BEMT_SetParameters( InitInp, p, errStat, errMsg ) return end if + allocate ( p%IntegrateWeight(p%numBladeNodes, p%numBlades), STAT = errStat2 ) + if ( errStat2 /= 0 ) then + call SetErrStat( ErrID_Fatal, 'Error allocating memory for p%IntegrateWeight.', errStat, errMsg, RoutineName ) + return + end if + + p%AFindx = InitInp%AFindx ! Compute the tip and hub loss constants using the distances along the blade (provided as input for now) @@ -235,6 +252,13 @@ subroutine BEMT_SetParameters( InitInp, p, errStat, errMsg ) p%airDens = InitInp%airDens p%kinVisc = InitInp%kinVisc p%skewWakeMod = InitInp%skewWakeMod + if (p%skewWakeMod==Skew_Mod_Active) then + p%SkewRedistrMod = InitInp%SkewRedistrMod + p%MomentumCorr = InitInp%MomentumCorr + else + p%SkewRedistrMod = SkewRedistrMod_None + p%MomentumCorr = .false. + endif p%yawCorrFactor = InitInp%yawCorrFactor p%useTipLoss = InitInp%useTipLoss p%useHubLoss = InitInp%useHubLoss @@ -255,6 +279,36 @@ subroutine BEMT_SetParameters( InitInp, p, errStat, errMsg ) end do p%rTipFixMax = maxval(InitInp%rTipFix) + + + !...................................................... + ! compute the weights for averaging the axial induction + ! compare with kernelSmoothing() + ! note: we should probably add some additional factors to + ! account for non-uniform spacing of nodes. + !...................................................... + + do j=1,p%numBlades + + u = (InitInp%rlocal(:,j)/ maxval(InitInp%rlocal) - FractionMax) / FractionRadius ! whole array operation + do i=1,p%numBladeNodes + u(i) = min( 1.0_ReKi, max( -1.0_ReKi, u(i) ) ) + end do + + k_sum = 0.0_ReKi + do i=1,p%numBladeNodes + p%IntegrateWeight(i,j) = w*(1.0_ReKi-abs(u(i))**Exp1)**Exp2; + k_sum = k_sum + p%IntegrateWeight(i,j) + end do + if (k_sum > 0.0_ReKi) then + p%IntegrateWeight(:,j) = p%IntegrateWeight(:,j) / k_sum + end if + + end do ! j (each blade) + p%IntegrateWeight = p%IntegrateWeight/p%numBlades + + + end subroutine BEMT_SetParameters !---------------------------------------------------------------------------------------------------------------------------------- @@ -540,12 +594,12 @@ subroutine BEMT_Init( InitInp, u, p, x, xd, z, OtherState, AFInfo, y, misc, Inte character(ErrMsgLen) :: errMsg2 ! temporary Error message if ErrStat /= ErrID_None integer(IntKi) :: errStat2 ! temporary Error status of the operation character(*), parameter :: RoutineName = 'BEMT_Init' - type(UA_InitInputType) :: Init_UA_Data type(UA_InitOutputType) :: InitOutData_UA type(DBEMT_InitInputType) :: InitInp_DBEMT type(DBEMT_InitOutputType) :: InitOut_DBEMT + ! Initialize variables for this routine errStat = ErrID_None errMsg = "" @@ -581,7 +635,8 @@ subroutine BEMT_Init( InitInp, u, p, x, xd, z, OtherState, AFInfo, y, misc, Inte call BEMT_InitOtherStates( OtherState, p, errStat, errMsg ) ! initialize the other states if (errStat >= AbortErrLev) return - if ( p%DBEMT_Mod /= DBEMT_none ) then + InitInp_DBEMT%DBEMT_Mod = p%DBEMT_Mod + if ( p%DBEMT_Mod > DBEMT_none ) then InitInp_DBEMT%DBEMT_Mod = p%DBEMT_Mod InitInp_DBEMT%numBlades = p%numBlades InitInp_DBEMT%numNodes = p%numBladeNodes @@ -617,14 +672,14 @@ subroutine BEMT_Init( InitInp, u, p, x, xd, z, OtherState, AFInfo, y, misc, Inte end if if ( p%UA_Flag ) then - call BEMT_Set_UA_InitData( InitInp, interval, Init_UA_Data, errStat2, errMsg2 ) + call BEMT_Set_UA_InitData( InitInp, interval, InitInp%UA_Init, errStat2, errMsg2 ) call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) if (errStat >= AbortErrLev) then call cleanup() return end if - call UA_Init( Init_UA_Data, misc%u_UA(1,1,1), p%UA, x%UA, xd%UA, OtherState%UA, misc%y_UA, misc%UA, interval, AFInfo, p%AFIndx, InitOutData_UA, errStat2, errMsg2 ) + call UA_Init( InitInp%UA_Init, misc%u_UA(1,1,1), p%UA, x%UA, xd%UA, OtherState%UA, misc%y_UA, misc%UA, interval, AFInfo, p%AFIndx, InitOutData_UA, errStat2, errMsg2 ) call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) if (errStat >= AbortErrLev) then call cleanup() @@ -683,7 +738,6 @@ SUBROUTINE Cleanup() ! This subroutine cleans up local variables that may have allocatable arrays !............................................................................................................................... - call UA_DestroyInitInput( Init_UA_Data, ErrStat2, ErrMsg2 ) call UA_DestroyInitOutput( InitOutData_UA, ErrStat2, ErrMsg2 ) END SUBROUTINE Cleanup @@ -720,7 +774,7 @@ subroutine BEMT_ReInit(p,x,xd,z,OtherState,misc,ErrStat,ErrMsg) if (p%UseInduction) then OtherState%ValidPhi = .true. - if (p%DBEMT_Mod /= DBEMT_none ) then + if (p%DBEMT_Mod > DBEMT_none ) then call DBEMT_ReInit(p%DBEMT, x%DBEMT, OtherState%DBEMT, misc%DBEMT) end if @@ -875,14 +929,14 @@ subroutine BEMT_UpdateStates( t, n, u, utimes, p, x, xd, z, OtherState, AFInfo, !............................................................................................................................... ! update DBEMT states to step n+1 !............................................................................................................................... - if (p%DBEMT_Mod /= DBEMT_none) then + if (p%DBEMT_Mod > DBEMT_none) then !........................ ! update DBEMT states to t+dt !........................ do j = 1,p%numBlades do i = 1,p%numBladeNodes - call DBEMT_UpdateStates(i, j, t, n, m%u_DBEMT, p%DBEMT, x%DBEMT, OtherState%DBEMT, m%DBEMT, errStat2, errMsg2) + call DBEMT_UpdateStates(i, j, t, n, m%u_DBEMT, uTimes, p%DBEMT, x%DBEMT, OtherState%DBEMT, m%DBEMT, errStat2, errMsg2) if (ErrStat2 /= ErrID_None) then call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName//trim(NodeText(i,j))) if (errStat >= AbortErrLev) return @@ -902,7 +956,7 @@ subroutine BEMT_UpdateStates( t, n, u, utimes, p, x, xd, z, OtherState, AFInfo, !............................................ ! apply DBEMT correction to axInduction and tanInduction: !............................................ - if (p%DBEMT_Mod /= DBEMT_none) then + if (p%DBEMT_Mod > DBEMT_none) then call calculate_Inductions_from_DBEMT_AllNodes(TimeIndex_t_plus_dt, uTimes(TimeIndex_t_plus_dt), u(TimeIndex_t_plus_dt), p, x, OtherState, m, m%axInduction, m%tanInduction) end if @@ -958,13 +1012,13 @@ subroutine SetInputs_For_DBEMT(u_DBEMT, u, p, axInduction, tanInduction, Rtip) !............................. u_DBEMT%R_disk = maxval( Rtip ) ! Locate the maximum rlocal value for all blades. u_DBEMT%Un_disk = u%Un_disk + !u_DBEMT%AxInd_disk = sum(axInduction) / size(axInduction) ! needed only if p%DBEMT_Mod == DBEMT_tauVaries u_DBEMT%AxInd_disk = 0.0_ReKi do j = 1,p%numBlades do i = 1,p%numBladeNodes - u_DBEMT%AxInd_disk = u_DBEMT%AxInd_disk + axInduction(i,j) + u_DBEMT%AxInd_disk = u_DBEMT%AxInd_disk + axInduction(i,j) * p%IntegrateWeight(i,j) end do end do - u_DBEMT%AxInd_disk = u_DBEMT%AxInd_disk / (p%numBladeNodes*p%numBlades) !............................. ! calculate element-level inputs @@ -1266,7 +1320,8 @@ subroutine BEMT_CalcOutput( t, u, p, x, xd, z, OtherState, AFInfo, y, m, errStat ! calculate inductions using BEMT, applying the DBEMT, and/or skewed wake corrections as applicable: ! NOTE that we don't use the DBEMT inputs when calling its CalcOutput routine, so we'll skip calculating them here !............................................ - call BEMT_CalcOutput_Inductions( InputIndex, t, .false., .true., y%phi, u, p, x, xd, z, OtherState, AFInfo, y%axInduction, y%tanInduction, y%chi, m, errStat, errMsg ) + call BEMT_CalcOutput_Inductions( InputIndex, t, .false., .true., y%phi, u, p, x, xd, z, OtherState, AFInfo, y%axInduction, y%tanInduction, y%chi, m, errStat, errMsg,& + y%axInduction_qs, y%tanInduction_qs, y%k, y%k_p, y%F) !............................................ ! update phi if necessary (consistent with inductions) and calculate inputs to UA (EVEN if UA isn't used, because we use the inputs later): @@ -1386,7 +1441,7 @@ subroutine BEMT_InitStates(t, u, p, x, xd, z, OtherState, m, AFInfo, ErrStat, Er m%phi = z%phi call BEMT_CalcOutput_Inductions( InputIndex, t, CalculateDBEMTInputs, ApplyCorrections, m%phi, u, p, x, xd, z, OtherState, AFInfo, m%axInduction, m%tanInduction, m%chi, m, errStat, errMsg ) - if (p%DBEMT_Mod /= DBEMT_none) then + if (p%DBEMT_Mod > DBEMT_none) then call DBEMT_InitStates_AllNodes( m%u_DBEMT(InputIndex), p%DBEMT, x%DBEMT, OtherState%DBEMT ) end if @@ -1490,7 +1545,7 @@ subroutine BEMT_CalcOutput_Inductions( InputIndex, t, CalculateDBEMTInputs, Appl !............................................ ! apply DBEMT correction to axInduction and tanInduction: !............................................ - if (p%DBEMT_Mod /= DBEMT_none) then + if (p%DBEMT_Mod > DBEMT_none) then ! If we are using DBEMT, then we will obtain the time-filtered versions of axInduction(i,j), tanInduction(i,j) ! Note that the outputs of DBEMT are the state variables x%vind, so we don't NEED to set the inputs except on initialization step (when we output the inputs instead of the states) @@ -1573,7 +1628,7 @@ subroutine ApplySkewedWakeCorrection_AllNodes(p, u, m, x, phi, OtherState, axInd !............................................ ! Apply skewed wake correction to the axial induction (y%axInduction) !............................................ - if ( p%skewWakeMod == SkewMod_PittPeters ) then + if ( p%skewWakeMod == Skew_Mod_Active ) then if (p%BEM_Mod==BEMMod_2D) then ! do nothing else @@ -1585,7 +1640,7 @@ subroutine ApplySkewedWakeCorrection_AllNodes(p, u, m, x, phi, OtherState, axInd do i = 1,p%numBladeNodes ! Loop through the blade nodes / elements if ( .not. p%FixedInductions(i,j) ) then F = getHubTipLossCorrection(p%BEM_Mod, p%useHubLoss, p%useTipLoss, p%hubLossConst(i,j), p%tipLossConst(i,j), phi(i,j), u%cantAngle(i,j) ) - call ApplySkewedWakeCorrection( p%BEM_Mod, p%skewWakeMod, p%yawCorrFactor, F, u%psi_s(j), u%psiSkewOffset, u%chi0, u%rlocal(i,j)/m%Rtip(j), axInduction(i,j), chi(i,j), m%FirstWarn_Skew ) + call ApplySkewedWakeCorrection( p%BEM_Mod, p%SkewRedistrMod, p%yawCorrFactor, F, u%psi_s(j), u%psiSkewOffset, u%chi0, u%rlocal(i,j)/m%Rtip(j), axInduction(i,j), chi(i,j), m%FirstWarn_Skew ) end if ! .not. p%FixedInductions (special case for tip and/or hub loss) enddo ! I - Blade nodes / elements enddo ! J - All blades @@ -1673,7 +1728,7 @@ subroutine BEMT_CalcContStateDeriv( t, u, p, x, xd, z, OtherState, m, dxdt, AFIn !............................................................................................................................... ! compute derivatives for DBEMT continuous states: !............................................................................................................................... - if (p%DBEMT_Mod /= DBEMT_none) then + if (p%DBEMT_Mod > DBEMT_none) then if (.not. allocated(dxdt%DBEMT%element)) then call DBEMT_CopyContState( x%DBEMT, dxdt%DBEMT, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) @@ -2322,6 +2377,11 @@ subroutine SetInputs_for_UA(BEM_Mod, phi, theta, cantAngle, toeAngle, axInductio call GetReynoldsNumber(BEM_Mod, axInduction, tanInduction, Vx, Vy, Vz, chord, kinVisc, theta, phi, cantAngle, toeAngle, u_UA%Re) endif + ! NOTE: + ! U: is here is the norm of the velocity made of Vx(1-a) and Vy(1+a'). + ! Ideally we would go back to the airfoil coordinate system + ! Below, v_ac is in the airfoil coordinate system. In baseline configurations, v_ac(1)>0 and v_ac(2)>0 + u_UA%v_ac(1) = sin(u_UA%alpha)*u_UA%U u_UA%v_ac(2) = cos(u_UA%alpha)*u_UA%U @@ -2446,7 +2506,7 @@ subroutine WriteDEBUGValuesToFile(t, u, p, x, xd, z, OtherState, m, AFInfo) do ii = 1, numPhi ! nonlinear mapping of ii --> phi - phi = smoothStep( real(ii,ReKi), 1.0, -pi+BEMT_epsilon2, real(numPhi,ReKi)/2.0, 0.0_ReKi ) + smoothStep( real(ii,ReKi), real(numPhi,ReKi)/2.0, 0.0_ReKi, real(numPhi,ReKi), pi-BEMT_epsilon2 ) + phi = smoothStep( real(ii,ReKi), 3, 1.0_ReKi, -pi+BEMT_epsilon2, real(numPhi,ReKi)/2.0, 0.0_ReKi ) + smoothStep( real(ii,ReKi), 3, real(numPhi,ReKi)/2.0, 0.0_ReKi, real(numPhi,ReKi), pi-BEMT_epsilon2 ) fzero = BEMTU_InductionWithResidual(p, u, DEBUG_BLADENODE, DEBUG_BLADE, phi, AFInfo(p%AFIndx(DEBUG_BLADENODE,DEBUG_BLADE)), ValidPhi, errStat, errMsg, a=axInd, ap=tnInd ) if (ValidPhi) then diff --git a/modules/aerodyn/src/BEMTUncoupled.f90 b/modules/aerodyn/src/BEMTUncoupled.f90 index e8f65c6961..ac09dccab2 100644 --- a/modules/aerodyn/src/BEMTUncoupled.f90 +++ b/modules/aerodyn/src/BEMTUncoupled.f90 @@ -59,6 +59,8 @@ module BEMTUnCoupled public :: GetEulerAnglesFromOrientation public :: VelocityIsZero + + public :: BEMTU_Test_ACT_Relationship contains !.................................................................................................................................. @@ -227,6 +229,20 @@ subroutine computeAirfoilOperatingAOA( BEM_Mod, phi, theta, cantAngle, toeAngle, end subroutine computeAirfoilOperatingAOA +! --- +!> Angle of attack in the airfoil reference frame +real(ReKi) function computeAirfoilAOA(Vrel_a) result(AoA) + real(ReKi), intent(in ) :: Vrel_a(3) + real(ReKi) :: numer, denom, ratio + ! Determine angle of attack as angle between airfoil chordline (afAxialVec) and inflow + numer = Vrel_a(2) + denom = sqrt(Vrel_a(1)**2 + Vrel_a(2)**2) + ratio = numer / denom + AoA = acos( max( min( ratio, 1.0_ReKi ), -1.0_ReKi ) ) + AoA = sign( AoA, Vrel_a(1) ) +end function computeAirfoilAOA + + !.................................................................................................................................. !> Transform the aerodynamic coefficients (Cl,Cd,Cm) (directed based on Vrel_xy_a ) !! from the airfoil coordinate system (a) to the without sweep pitch coordinate system (w) @@ -433,10 +449,10 @@ real(ReKi) function BEMTU_InductionWithResidual(p, u, i, j, phi, AFInfo, IsValid end function BEMTU_InductionWithResidual !----------------------------------------------------------------------------------------- -subroutine ApplySkewedWakeCorrection(BEM_Mod, SkewMod, yawCorrFactor, F, azimuth, azimuthOffset, chi0, tipRatio, a, chi, FirstWarn ) +subroutine ApplySkewedWakeCorrection(BEM_Mod, SkewRedistrMod, yawCorrFactor, F, azimuth, azimuthOffset, chi0, tipRatio, a, chi, FirstWarn ) integer(IntKi), intent(in ) :: BEM_Mod - integer(IntKi), intent(in ) :: SkewMod + integer(IntKi), intent(in ) :: SkewRedistrMod real(ReKi), intent(in ) :: yawCorrFactor ! set to 15*pi/32 previously; now allowed to be input (to better match data) real(ReKi), intent(in ) :: F ! tip/hub loss factor real(ReKi), intent(in ) :: azimuth @@ -450,7 +466,10 @@ subroutine ApplySkewedWakeCorrection(BEM_Mod, SkewMod, yawCorrFactor, F, azimuth ! Local variables real(ReKi) :: yawCorr real(ReKi) :: yawCorr_tan ! magnitude of the tan(chi/2) correction term (with possible limits) - + + if (SkewRedistrMod==SkewRedistrMod_None) then + return + endif ! Skewed wake correction if(BEM_Mod==BEMMod_2D) then @@ -465,7 +484,7 @@ subroutine ApplySkewedWakeCorrection(BEM_Mod, SkewMod, yawCorrFactor, F, azimuth if (FirstWarn) then call WrScr( 'Warning: SkewedWakeCorrection encountered a large value of chi ('//trim(num2lstr(chi*R2D))// & - ' deg), so the yaw correction will be limited. This warning will not be repeated though the condition may persist. See the AD15 chi output channels, and'// & + ' deg), so the yaw correction will be limited. This warning will not be repeated though the condition may persist. See the AD chi output channels, and'// & ' consider turning off the Pitt/Peters skew model (set SkewMod=1) if this condition persists.'//NewLine) FirstWarn = .false. end if @@ -476,7 +495,14 @@ subroutine ApplySkewedWakeCorrection(BEM_Mod, SkewMod, yawCorrFactor, F, azimuth end if !bjj: modified 22-Sep-2015: RRD recommends 32 instead of 64 in the denominator (like AD14) - yawCorr = ( yawCorrFactor * yawCorr_tan * (tipRatio) * sin(azimuth) ) ! bjj: note that when chi gets close to +/-pi this blows up + ! TODO TODO TODO + if(BEM_Mod==BEMMod_2D) then + ! ADLEG: + yawCorr = ( yawCorrFactor * yawCorr_tan * (tipRatio) * sin(azimuth) ) ! bjj: note that when chi gets close to +/-pi this blows up + else + ! ADENV: + yawCorr = ( yawCorrFactor * F * yawCorr_tan * (tipRatio) * cos(azimuth-azimuthOffset) ) ! bjj: note that when chi gets close to +/-pi this blows up + endif a = a * (1.0 + yawCorr) @@ -633,6 +659,8 @@ subroutine inductionFactors0(B, r, chord, phi, cn, ct, Vx, Vy, F, wakerotation, ! Convert from double to ReKi a_out = real( a, ReKi ) ap_out = real( ap, ReKi ) + k_out = real( k, ReKi ) + kp_out = real( kp, ReKi ) end subroutine inductionFactors0 subroutine getTangentialInduction(a, cphi, sphi, Vx, F, kpCorrectionFactor, sigma_p, ct, VxCorrected, effectiveYaw, H, MomentumCorr, ap, kp) @@ -1079,6 +1107,56 @@ subroutine limitInductionFactors(a,ap) end subroutine limitInductionFactors !----------------------------------------------------------------------------------------- +!> This function returns a smoothstep function +!> See: https://en.wikipedia.org/wiki/Smoothstep +real(reKi) function smoothStep( xIN, order, x1, f1, x2, f2 ) result(f) +! SMOOTHSTEP Blending function. +! +! f = SMOOTHSTEP( x, order, x1, f1, x2, f2 ) +! x: input vector +! order: polynomial order of smoothstep (3, 5, 7 are supported) +! x1: "left edge" x value of the smoothstep +! f1: "left edge" functional value of the smoothstep +! x2: "right edge" x value of the smoothstep +! f2: "right edge" functional value of the smoothstep +! +! https://en.wikipedia.org/wiki/Smoothstep + + implicit none + + real(ReKi), intent(in) :: xIN + INTEGER, intent(in) :: order + real(ReKi), intent(in) :: x1 + real(ReKi), intent(in) :: f1 + real(ReKi), intent(in) :: x2 + real(ReKi), intent(in) :: f2 + real(ReKi) :: x + + x = (xIN-x1)/(x2-x1) + x = min( max( x, 0.0_ReKi ), 1.0_ReKi ) + + select case (order) + case (3) + ! 3rd order + ! f' = 0 at x=0 and x=1 + f = -2.0_ReKi*x**3 + 3.0_ReKi*x**2 + case (5) + ! f' = f'' = 0 at x=0 and x=1 + f = 6.0_ReKi*x**5 - 15.0_ReKi*x**4 + 10.0_ReKi*x**3; + case (7) + ! f' = f'' = f''' = 0 at x=0 and x=1 + f = -20.0_ReKi*x**7 + 70.0_ReKi*x**6 - 84.0_ReKi*x**5 + 35.0_ReKi*x**4; + case default + ! an error? + call WrScr('Programming error in smoothStep. Invalid order specified.') + f = x + end select + + ! Scale f from [0,1] to [f1,f2] + f = (f2-f1)*f+f1 + +end function smoothStep +!----------------------------------------------------------------------------------------- subroutine sortRoots(a) ! Sort the roots complex(R8Ki), intent(inout) :: a(4) @@ -1214,4 +1292,52 @@ FUNCTION GetEulerAnglesFromOrientation(EulerDCM,orientation) RESULT(theta) end function !----------------------------------------------------------------------------------------- + + +!> Simple test for a-Ct relationship. +subroutine BEMTU_Test_ACT_Relationship() + real(R8Ki) :: chi0 + real(R8Ki) :: delta_chi + real(ReKi) :: F + logical :: skewConvention + integer :: i + integer :: iUnit + real(R8Ki) :: c2, c1, c0 ! Empirical CT = c2*a^2 + c1*a + c0 for a > a0 + ! Get Coefficients for Empirical CT + iUnit = 123 + + ! --- No Momentum Corr, F=1 + F=1; skewConvention=.False. + call parametricStudy('ACTCoeffs_F10_NoCo.csv') + ! --- No Momentum Corr, F=0.5 + F=0.5; skewConvention=.False. + call parametricStudy('ACTCoeffs_F05_NoCo.csv') + ! --- Momentum Corr, F=1 + F=1; skewConvention=.True. + call parametricStudy('ACTCoeffs_F10_Corr.csv') + ! --- Momentum Corr, F=0.5 + F=0.5; skewConvention=.True. + call parametricStudy('ACTCoeffs_F05_Corr.csv') + + STOP + +contains + subroutine parametricStudy(filename) + character(len=*) :: filename + chi0=-50 * D2R + open(unit=iUnit, file=filename) + write(iUnit, '(5(A15))') 'chi0', 'c0', 'c1', 'c2', 'F' + do i=1,21 + call getEmpiricalCoefficients(chi0 ,F , c0, c1, c2, skewConvention) + write(iUnit,'(5(F15.5))') chi0*R2D, c0, c1, c2, F + chi0 = chi0 + 5*D2R + enddo + close(iUnit) + end subroutine + + + +end subroutine BEMTU_Test_ACT_Relationship + + end module BEMTUncoupled diff --git a/modules/aerodyn/src/BEMT_Registry.txt b/modules/aerodyn/src/BEMT_Registry.txt index 893fc7fdda..ce329a920b 100644 --- a/modules/aerodyn/src/BEMT_Registry.txt +++ b/modules/aerodyn/src/BEMT_Registry.txt @@ -16,13 +16,16 @@ usefrom AirfoilInfo_Registry.txt usefrom UnsteadyAero_Registry.txt usefrom DBEMT_Registry.txt -param BEMT/BEMT - INTEGER SkewMod_Orthogonal - 0 - "Inflow orthogonal to rotor [-]" - -param BEMT/BEMT - INTEGER SkewMod_Uncoupled - 1 - "Uncoupled (no correction)" - -param BEMT/BEMT - INTEGER SkewMod_PittPeters - 2 - "Pitt/Peters" - -param BEMT/BEMT - INTEGER SkewMod_Coupled - 3 - "Coupled" - -param BEMT/BEMT - INTEGER SkewMod_PittPeters_Cont - 4 - "Pitt/Peters continuous formulation" - +param BEMT/BEMT - INTEGER Skew_Mod_Orthogonal - -1 - "Inflow orthogonal to rotor [-]" - +param BEMT/BEMT - INTEGER Skew_Mod_None - 0 - "No skew model" - +param BEMT/BEMT - INTEGER Skew_Mod_Active - 1 - "Skew model active" - +param BEMT/BEMT - INTEGER Skew_Mod_PittPeters_Cont - 4 - "Pitt/Peters continuous formulation" - -param BEMT/BEMT - INTEGER BEMMod_2D - 0 - "2D BEM assuming Cx, Cy, phi, L, D are in the same plane" - +param BEMT/BEMT - INTEGER SkewRedistrMod_None - 0 - "No redistribution" - +param BEMT/BEMT - INTEGER SkewRedistrMod_PittPeters - 1 - "Pitt/Peters/Glauert redistribution" - +#param BEMT/BEMT - INTEGER SkewRedistrMod_VCyl - 2 - "Vortex cylinder redistribution" - + +param BEMT/BEMT - INTEGER BEMMod_2D - 1 - "2D BEM assuming Cx, Cy, phi, L, D are in the same plane" - param BEMT/BEMT - INTEGER BEMMod_3D - 2 - "3D BEM assuming a momentum balance system, and an airfoil system" - # @@ -35,7 +38,8 @@ typedef BEMT/BEMT InitInputType ReKi typedef ^ ^ INTEGER numBlades - - - "Number of blades" - typedef ^ ^ ReKi airDens - - - "Air density" kg/m^3 typedef ^ ^ ReKi kinVisc - - - "Kinematic air viscosity" m^2/s -typedef ^ ^ INTEGER skewWakeMod - - - "Type of skewed-wake correction model [switch] {1=uncoupled, 2=Pitt/Peters, 3=coupled}" - +typedef ^ ^ INTEGER skewWakeMod - - - "Type of skewed-wake model [switch] {0=None, 1=Glauert}" - +typedef ^ ^ INTEGER skewRedistrMod - - - "Type of skewed-wake redistribution model (switch) {0=no redistribution, 1=Glauert/Pitt/Peters, 2=Vortex Cylinder} [unsed only when SkewMod=1]" - typedef ^ ^ ReKi aTol - - - "Tolerance for the induction solution" - typedef ^ ^ LOGICAL useTipLoss - - - "Use the Prandtl tip-loss model? [flag]" - typedef ^ ^ LOGICAL useHubLoss - - - "Use the Prandtl hub-loss model? [flag]" - @@ -53,18 +57,14 @@ typedef ^ ^ ReKi typedef ^ ^ ReKi zTip {:} - - "Distance to blade tip, measured along the blade" m typedef ^ ^ ReKi rLocal {:}{:} - - "Radial distance to blade node from the center of rotation, measured in the rotor plane, needed for DBEMT" m typedef ^ ^ ReKi rTipFix {:} - - "Nominally the coned rotor diameter (without prebend), used to align with Bladed calculations" m -typedef ^ ^ INTEGER UAMod - - - "Model for the dynamic stall equations [1 = Leishman/Beddoes, 2 = Gonzalez, 3 = Minnema]" - typedef ^ ^ LOGICAL UA_Flag - - - "logical flag indicating whether to use UnsteadyAero" - -typedef ^ ^ LOGICAL Flookup - - - "Use table lookup for f' and f'' " - -typedef ^ ^ ReKi a_s - - - "speed of sound" m/s typedef ^ ^ IntKi DBEMT_Mod - - - "DBEMT model. 1 = constant tau1, 2 = time dependent tau1" - typedef ^ ^ ReKi tau1_const - - - "DBEMT time constant (when DBEMT_Mod=1)" s typedef ^ ^ ReKi yawCorrFactor - - - "constant used in Pitt/Peters skewed wake model (default is 15*pi/32)" - -typedef ^ ^ INTEGER UAOff_innerNode {:} - - "Last node on each blade where UA should be turned off based on span location from blade root (0 if always on)" - -typedef ^ ^ INTEGER UAOff_outerNode {:} - - "First node on each blade where UA should be turned off based on span location from blade tip (>nNodesPerBlade if always on)" - typedef ^ ^ CHARACTER(1024) RootName - - - "RootName for writing output files" - typedef ^ ^ LOGICAL SumPrint - - - "logical flag indicating whether to use UnsteadyAero" - typedef ^ ^ IntKi BEM_Mod - - - "BEM Model 0=OpenFAST 2=Envision " - +typedef ^ ^ UA_InitInputType UA_Init - - - "InitInput data for UA model" # # # Define outputs from the initialization routine here: @@ -139,7 +139,8 @@ typedef ^ ^ ReKi typedef ^ ^ INTEGER numBlades - - - "Number of blades" - typedef ^ ^ ReKi airDens - - - "Air density" kg/m^3 typedef ^ ^ ReKi kinVisc - - - "Kinematic air viscosity" m^2/s -typedef ^ ^ INTEGER skewWakeMod - - - "Type of skewed-wake correction model [switch] {1=uncoupled, 2=Pitt/Peters, 3=coupled}" - +typedef ^ ^ INTEGER skewWakeMod - - - "Type of skewed-wake correction model [switch] {0=None, 1=Glauert/Pitt/Peters}" - +typedef ^ ^ INTEGER skewRedistrMod - - - "Type of skewed-wake redistribution model (switch) {0=no redistribution, 1=Glauert/Pitt/Peters, 2=Vortex Cylinder} [unsed only when SkewMod=1]" - typedef ^ ^ ReKi aTol - - - "Tolerance for the induction solution" - typedef ^ ^ LOGICAL useTipLoss - - - "Use the Prandtl tip-loss model? [flag]" - typedef ^ ^ LOGICAL useHubLoss - - - "Use the Prandtl hub-loss model? [flag]" - diff --git a/modules/aerodyn/src/BEMT_Types.f90 b/modules/aerodyn/src/BEMT_Types.f90 index 13536b274c..88dfc7823e 100644 --- a/modules/aerodyn/src/BEMT_Types.f90 +++ b/modules/aerodyn/src/BEMT_Types.f90 @@ -31,53 +31,52 @@ !! unpack routines associated with each defined data type. This code is automatically generated by the FAST Registry. MODULE BEMT_Types !--------------------------------------------------------------------------------------------------------------------------------- +USE AirfoilInfo_Types USE UnsteadyAero_Types USE DBEMT_Types USE NWTC_Library IMPLICIT NONE - INTEGER(IntKi), PUBLIC, PARAMETER :: SkewMod_Orthogonal = 0 ! Inflow orthogonal to rotor [-] [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: SkewMod_Uncoupled = 1 ! Uncoupled (no correction) [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: SkewMod_PittPeters = 2 ! Pitt/Peters [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: SkewMod_Coupled = 3 ! Coupled [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: SkewMod_PittPeters_Cont = 4 ! Pitt/Peters continuous formulation [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: BEMMod_2D = 0 ! 2D BEM assuming Cx, Cy, phi, L, D are in the same plane [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Skew_Mod_Orthogonal = -1 ! Inflow orthogonal to rotor [-] [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Skew_Mod_None = 0 ! No skew model [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Skew_Mod_Active = 1 ! Skew model active [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Skew_Mod_PittPeters_Cont = 4 ! Pitt/Peters continuous formulation [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: SkewRedistrMod_None = 0 ! No redistribution [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: SkewRedistrMod_PittPeters = 1 ! Pitt/Peters/Glauert redistribution [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: BEMMod_2D = 1 ! 2D BEM assuming Cx, Cy, phi, L, D are in the same plane [-] INTEGER(IntKi), PUBLIC, PARAMETER :: BEMMod_3D = 2 ! 3D BEM assuming a momentum balance system, and an airfoil system [-] ! ========= BEMT_InitInputType ======= TYPE, PUBLIC :: BEMT_InitInputType REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: chord !< Chord length at node [m] - INTEGER(IntKi) :: numBlades !< Number of blades [-] - REAL(ReKi) :: airDens !< Air density [kg/m^3] - REAL(ReKi) :: kinVisc !< Kinematic air viscosity [m^2/s] - INTEGER(IntKi) :: skewWakeMod !< Type of skewed-wake correction model [switch] {1=uncoupled, 2=Pitt/Peters, 3=coupled} [-] - REAL(ReKi) :: aTol !< Tolerance for the induction solution [-] - LOGICAL :: useTipLoss !< Use the Prandtl tip-loss model? [flag] [-] - LOGICAL :: useHubLoss !< Use the Prandtl hub-loss model? [flag] [-] - LOGICAL :: useInduction !< Include induction in BEMT calculations [flag] { If FALSE then useTanInd will be set to FALSE} [-] - LOGICAL :: useTanInd !< Include tangential induction in BEMT calculations [flag] [-] - LOGICAL :: useAIDrag !< Include the drag term in the axial-induction calculation? [flag] [-] - LOGICAL :: useTIDrag !< Include the drag term in the tangential-induction calculation? Ignored if TanInd is False. [flag] [-] - LOGICAL :: MomentumCorr !< Momentum Correction {0=Axial Theory, 1 = Glauert Momentum Theory} [-] - INTEGER(IntKi) :: numBladeNodes !< Number of blade nodes used in the analysis [-] - INTEGER(IntKi) :: numReIterations !< Number of iterations for finding the Reynolds number [-] - INTEGER(IntKi) :: maxIndIterations !< Maximum number of iterations of induction factor solve [-] + INTEGER(IntKi) :: numBlades = 0_IntKi !< Number of blades [-] + REAL(ReKi) :: airDens = 0.0_ReKi !< Air density [kg/m^3] + REAL(ReKi) :: kinVisc = 0.0_ReKi !< Kinematic air viscosity [m^2/s] + INTEGER(IntKi) :: skewWakeMod = 0_IntKi !< Type of skewed-wake model [switch] {0=None, 1=Glauert} [-] + INTEGER(IntKi) :: skewRedistrMod = 0_IntKi !< Type of skewed-wake redistribution model (switch) {0=no redistribution, 1=Glauert/Pitt/Peters, 2=Vortex Cylinder} [unsed only when SkewMod=1] [-] + REAL(ReKi) :: aTol = 0.0_ReKi !< Tolerance for the induction solution [-] + LOGICAL :: useTipLoss = .false. !< Use the Prandtl tip-loss model? [flag] [-] + LOGICAL :: useHubLoss = .false. !< Use the Prandtl hub-loss model? [flag] [-] + LOGICAL :: useInduction = .false. !< Include induction in BEMT calculations [flag] { If FALSE then useTanInd will be set to FALSE} [-] + LOGICAL :: useTanInd = .false. !< Include tangential induction in BEMT calculations [flag] [-] + LOGICAL :: useAIDrag = .false. !< Include the drag term in the axial-induction calculation? [flag] [-] + LOGICAL :: useTIDrag = .false. !< Include the drag term in the tangential-induction calculation? Ignored if TanInd is False. [flag] [-] + LOGICAL :: MomentumCorr = .false. !< Momentum Correction {0=Axial Theory, 1 = Glauert Momentum Theory} [-] + INTEGER(IntKi) :: numBladeNodes = 0_IntKi !< Number of blade nodes used in the analysis [-] + INTEGER(IntKi) :: numReIterations = 0_IntKi !< Number of iterations for finding the Reynolds number [-] + INTEGER(IntKi) :: maxIndIterations = 0_IntKi !< Maximum number of iterations of induction factor solve [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: AFindx !< Index of airfoil data file for blade node location [array of numBladeNodes] [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: zHub !< Distance to hub for each blade [m] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: zLocal !< Distance to blade node, measured along the blade [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: zTip !< Distance to blade tip, measured along the blade [m] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: rLocal !< Radial distance to blade node from the center of rotation, measured in the rotor plane, needed for DBEMT [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: rTipFix !< Nominally the coned rotor diameter (without prebend), used to align with Bladed calculations [m] - INTEGER(IntKi) :: UAMod !< Model for the dynamic stall equations [1 = Leishman/Beddoes, 2 = Gonzalez, 3 = Minnema] [-] - LOGICAL :: UA_Flag !< logical flag indicating whether to use UnsteadyAero [-] - LOGICAL :: Flookup !< Use table lookup for f' and f'' [-] - REAL(ReKi) :: a_s !< speed of sound [m/s] - INTEGER(IntKi) :: DBEMT_Mod !< DBEMT model. 1 = constant tau1, 2 = time dependent tau1 [-] - REAL(ReKi) :: tau1_const !< DBEMT time constant (when DBEMT_Mod=1) [s] - REAL(ReKi) :: yawCorrFactor !< constant used in Pitt/Peters skewed wake model (default is 15*pi/32) [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: UAOff_innerNode !< Last node on each blade where UA should be turned off based on span location from blade root (0 if always on) [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: UAOff_outerNode !< First node on each blade where UA should be turned off based on span location from blade tip (>nNodesPerBlade if always on) [-] + LOGICAL :: UA_Flag = .false. !< logical flag indicating whether to use UnsteadyAero [-] + INTEGER(IntKi) :: DBEMT_Mod = 0_IntKi !< DBEMT model. 1 = constant tau1, 2 = time dependent tau1 [-] + REAL(ReKi) :: tau1_const = 0.0_ReKi !< DBEMT time constant (when DBEMT_Mod=1) [s] + REAL(ReKi) :: yawCorrFactor = 0.0_ReKi !< constant used in Pitt/Peters skewed wake model (default is 15*pi/32) [-] CHARACTER(1024) :: RootName !< RootName for writing output files [-] - LOGICAL :: SumPrint !< logical flag indicating whether to use UnsteadyAero [-] - INTEGER(IntKi) :: BEM_Mod !< BEM Model 0=OpenFAST 2=Envision [-] + LOGICAL :: SumPrint = .false. !< logical flag indicating whether to use UnsteadyAero [-] + INTEGER(IntKi) :: BEM_Mod = 0_IntKi !< BEM Model 0=OpenFAST 2=Envision [-] + TYPE(UA_InitInputType) :: UA_Init !< InitInput data for UA model [-] END TYPE BEMT_InitInputType ! ======================= ! ========= BEMT_InitOutputType ======= @@ -87,16 +86,16 @@ MODULE BEMT_Types ! ======================= ! ========= BEMT_SkewWake_InputType ======= TYPE, PUBLIC :: BEMT_SkewWake_InputType - REAL(ReKi) , DIMENSION(1:3) :: v_qsw !< quasi-steady instantaneous wake velocity (value to be filtered in Skewed Wake model) [m/s] - REAL(ReKi) :: V0 !< magnitude of disk-averaged velocity (for input to SkewWake) [m/s] - REAL(ReKi) :: R !< rotor radius (for input to SkewWake) [m] + REAL(ReKi) , DIMENSION(1:3) :: v_qsw = 0.0_ReKi !< quasi-steady instantaneous wake velocity (value to be filtered in Skewed Wake model) [m/s] + REAL(ReKi) :: V0 = 0.0_ReKi !< magnitude of disk-averaged velocity (for input to SkewWake) [m/s] + REAL(ReKi) :: R = 0.0_ReKi !< rotor radius (for input to SkewWake) [m] END TYPE BEMT_SkewWake_InputType ! ======================= ! ========= BEMT_ContinuousStateType ======= TYPE, PUBLIC :: BEMT_ContinuousStateType TYPE(UA_ContinuousStateType) :: UA !< UA module continuous states [-] TYPE(DBEMT_ContinuousStateType) :: DBEMT !< DBEMT module continuous states [-] - REAL(R8Ki) , DIMENSION(1:3) :: V_w !< continuous state for filtering wake velocity [-] + REAL(R8Ki) , DIMENSION(1:3) :: V_w = 0.0_R8Ki !< continuous state for filtering wake velocity [-] END TYPE BEMT_ContinuousStateType ! ======================= ! ========= BEMT_DiscreteStateType ======= @@ -114,16 +113,16 @@ MODULE BEMT_Types TYPE(UA_OtherStateType) :: UA !< other states for UnsteadyAero [-] TYPE(DBEMT_OtherStateType) :: DBEMT !< other states for DBEMT [-] LOGICAL , DIMENSION(:,:), ALLOCATABLE :: ValidPhi !< set to indicate when there is no valid Phi for this node at this time (temporarially turn off induction when this is false) [-] - LOGICAL :: nodesInitialized !< the node states have been initialized properly [-] + LOGICAL :: nodesInitialized = .false. !< the node states have been initialized properly [-] TYPE(BEMT_ContinuousStateType) , DIMENSION(1:4) :: xdot !< history states for continuous state integration [-] - INTEGER(IntKi) :: n !< time step value used for continuous state integrator [-] + INTEGER(IntKi) :: n = 0_IntKi !< time step # value used for continuous state integrator [-] END TYPE BEMT_OtherStateType ! ======================= ! ========= BEMT_MiscVarType ======= TYPE, PUBLIC :: BEMT_MiscVarType - LOGICAL :: FirstWarn_Skew !< flag so invalid skew warning doesn't get repeated forever [-] - LOGICAL :: FirstWarn_Phi !< flag so Invalid Phi warning doesn't get repeated forever [-] - LOGICAL :: FirstWarn_BEMoff !< flag to warn the BEM was turned off [-] + LOGICAL :: FirstWarn_Skew = .false. !< flag so invalid skew warning doesn't get repeated forever [-] + LOGICAL :: FirstWarn_Phi = .false. !< flag so Invalid Phi warning doesn't get repeated forever [-] + LOGICAL :: FirstWarn_BEMoff = .false. !< flag to warn the BEM was turned off [-] TYPE(UA_MiscVarType) :: UA !< misc vars for UnsteadyAero [-] TYPE(DBEMT_MiscVarType) :: DBEMT !< misc vars for DBEMT [-] TYPE(UA_OutputType) :: y_UA !< outputs from UnsteadyAero [-] @@ -134,66 +133,67 @@ MODULE BEMT_Types REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: AxInd_op !< axial induction at the operating point (for linearization) with frozen wake assumption [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: AxInduction !< axial induction used for code run-time optimization [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: TanInduction !< tangential induction used for code run-time optimization [-] - LOGICAL :: UseFrozenWake !< flag set to determine if frozen values of TnInd_op and AxInd_op should be used for this calculation in the linearization process [-] + LOGICAL :: UseFrozenWake = .false. !< flag set to determine if frozen values of TnInd_op and AxInd_op should be used for this calculation in the linearization process [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Rtip !< maximum rlocal value for each blade (typically the value at the tip) [m] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: phi !< temp variable used in update states for returning phi (to allow computing inputs and states at multiple times) [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: chi !< temp variable used in update states for returning chi (to allow calling same routine from CalcOutput and UpdateStates) [-] LOGICAL , DIMENSION(:,:), ALLOCATABLE :: ValidPhi !< temp variable used in calcOutput for ValidPhi (to allow calling same routine from CalcOutput and UpdateStates) [-] - REAL(ReKi) :: BEM_weight + REAL(ReKi) :: BEM_weight = 0.0_ReKi END TYPE BEMT_MiscVarType ! ======================= ! ========= BEMT_ParameterType ======= TYPE, PUBLIC :: BEMT_ParameterType - REAL(DbKi) :: DT !< time step [s] + REAL(DbKi) :: DT = 0.0_R8Ki !< time step [s] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: chord !< Chord length at node [m] - INTEGER(IntKi) :: numBlades !< Number of blades [-] - REAL(ReKi) :: airDens !< Air density [kg/m^3] - REAL(ReKi) :: kinVisc !< Kinematic air viscosity [m^2/s] - INTEGER(IntKi) :: skewWakeMod !< Type of skewed-wake correction model [switch] {1=uncoupled, 2=Pitt/Peters, 3=coupled} [-] - REAL(ReKi) :: aTol !< Tolerance for the induction solution [-] - LOGICAL :: useTipLoss !< Use the Prandtl tip-loss model? [flag] [-] - LOGICAL :: useHubLoss !< Use the Prandtl hub-loss model? [flag] [-] - LOGICAL :: useInduction !< Include induction in BEMT calculations [flag] { If FALSE then useTanInd will be set to FALSE} [-] - LOGICAL :: useTanInd !< Include tangential induction in BEMT calculations [flag] [-] - LOGICAL :: useAIDrag !< Include the drag term in the axial-induction calculation? [flag] [-] - LOGICAL :: useTIDrag !< Include the drag term in the tangential-induction calculation? Ignored if TanInd is False. [flag] [-] - INTEGER(IntKi) :: numBladeNodes !< Number of blade nodes used in the analysis [-] - INTEGER(IntKi) :: numReIterations !< Number of iterations for finding the Reynolds number [-] - INTEGER(IntKi) :: maxIndIterations !< Maximum number of iterations of induction factor solve [-] + INTEGER(IntKi) :: numBlades = 0_IntKi !< Number of blades [-] + REAL(ReKi) :: airDens = 0.0_ReKi !< Air density [kg/m^3] + REAL(ReKi) :: kinVisc = 0.0_ReKi !< Kinematic air viscosity [m^2/s] + INTEGER(IntKi) :: skewWakeMod = 0_IntKi !< Type of skewed-wake correction model [switch] {0=None, 1=Glauert/Pitt/Peters} [-] + INTEGER(IntKi) :: skewRedistrMod = 0_IntKi !< Type of skewed-wake redistribution model (switch) {0=no redistribution, 1=Glauert/Pitt/Peters, 2=Vortex Cylinder} [unsed only when SkewMod=1] [-] + REAL(ReKi) :: aTol = 0.0_ReKi !< Tolerance for the induction solution [-] + LOGICAL :: useTipLoss = .false. !< Use the Prandtl tip-loss model? [flag] [-] + LOGICAL :: useHubLoss = .false. !< Use the Prandtl hub-loss model? [flag] [-] + LOGICAL :: useInduction = .false. !< Include induction in BEMT calculations [flag] { If FALSE then useTanInd will be set to FALSE} [-] + LOGICAL :: useTanInd = .false. !< Include tangential induction in BEMT calculations [flag] [-] + LOGICAL :: useAIDrag = .false. !< Include the drag term in the axial-induction calculation? [flag] [-] + LOGICAL :: useTIDrag = .false. !< Include the drag term in the tangential-induction calculation? Ignored if TanInd is False. [flag] [-] + INTEGER(IntKi) :: numBladeNodes = 0_IntKi !< Number of blade nodes used in the analysis [-] + INTEGER(IntKi) :: numReIterations = 0_IntKi !< Number of iterations for finding the Reynolds number [-] + INTEGER(IntKi) :: maxIndIterations = 0_IntKi !< Maximum number of iterations of induction factor solve [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: AFindx !< Index of airfoil data file for blade node location [array of numBladeNodes] [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: tipLossConst !< A constant computed during initialization based on B*(zTip-zLocal)/(2*zLocal) [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: hubLossConst !< A constant computed during initialization based on B*(zLocal-zHub)/(2*zHub) [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: zHub !< Distance to hub for each blade [m] TYPE(UA_ParameterType) :: UA !< parameters for UnsteadyAero [-] TYPE(DBEMT_ParameterType) :: DBEMT !< parameters for DBEMT [-] - LOGICAL :: UA_Flag !< logical flag indicating whether to use UnsteadyAero [-] - INTEGER(IntKi) :: DBEMT_Mod !< DBEMT Model. 0 = constant tau1, 1 = time dependent tau1 [-] - REAL(ReKi) :: yawCorrFactor !< constant used in Pitt/Peters skewed wake model (default is 15*pi/32) [-] + LOGICAL :: UA_Flag = .false. !< logical flag indicating whether to use UnsteadyAero [-] + INTEGER(IntKi) :: DBEMT_Mod = 0_IntKi !< DBEMT Model. 0 = constant tau1, 1 = time dependent tau1 [-] + REAL(ReKi) :: yawCorrFactor = 0.0_ReKi !< constant used in Pitt/Peters skewed wake model (default is 15*pi/32) [-] LOGICAL , DIMENSION(:,:), ALLOCATABLE :: FixedInductions !< flag to determine if BEM inductions should be fixed and not modified by dbemt or skewed wake [-] - LOGICAL :: MomentumCorr !< Momentum Correction {0=Axial Theory, 1 = Glauert Momentum Theory} [-] - REAL(ReKi) :: rTipFixMax !< Nominally the coned rotor diameter (without prebend), used to align with Bladed calculations [m] + LOGICAL :: MomentumCorr = .false. !< Momentum Correction {0=Axial Theory, 1 = Glauert Momentum Theory} [-] + REAL(ReKi) :: rTipFixMax = 0.0_ReKi !< Nominally the coned rotor diameter (without prebend), used to align with Bladed calculations [m] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: IntegrateWeight !< A weighting factor for calculating rotor-averaged values (e.g., AxInd) [-] INTEGER(IntKi) :: lin_nx = 0 !< Number of continuous states for linearization [-] - INTEGER(IntKi) :: BEM_Mod !< BEM Model 0=OpenFAST 2=Envision [-] + INTEGER(IntKi) :: BEM_Mod = 0_IntKi !< BEM Model 0=OpenFAST 2=Envision [-] END TYPE BEMT_ParameterType ! ======================= ! ========= BEMT_InputType ======= TYPE, PUBLIC :: BEMT_InputType REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: theta !< Twist angle (includes all sources of twist) [Array of size (NumBlNds,numBlades)] [rad] - REAL(ReKi) :: chi0 !< Angle between the vector normal to the rotor plane and the wind vector (e.g., the yaw angle in the case of no tilt) [rad] - REAL(ReKi) :: psiSkewOffset !< Skew azimuth angle offset (relative to 90 deg) of the most downwind blade when chi0 is non-zero [rad] + REAL(ReKi) :: chi0 = 0.0_ReKi !< Angle between the vector normal to the rotor plane and the wind vector (e.g., the yaw angle in the case of no tilt) [rad] + REAL(ReKi) :: psiSkewOffset = 0.0_ReKi !< Skew azimuth angle offset (relative to 90 deg) of the most downwind blade when chi0 is non-zero [rad] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: psi_s !< Skew azimuth angle [rad] - REAL(ReKi) :: omega !< Angular velocity of rotor [rad/s] - REAL(ReKi) :: TSR !< Tip-speed ratio (to check if BEM should be turned off) [-] + REAL(ReKi) :: omega = 0.0_ReKi !< Angular velocity of rotor [rad/s] + REAL(ReKi) :: TSR = 0.0_ReKi !< Tip-speed ratio (to check if BEM should be turned off) [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Vx !< Local axial velocity at node [m/s] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Vy !< Local tangential velocity at node [m/s] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Vz !< Local radial velocity at node [m/s] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: omega_z !< rotation of no-sweep-pitch-twist coordinate system around z (for CDBEMT and CUA) [rad/s] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: xVelCorr !< projection of velocity when yawed + prebend [m/s] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: rLocal !< Radial distance from center-of-rotation to node [m] - REAL(ReKi) :: Un_disk !< disk-averaged velocity normal to the rotor disk (for input to DBEMT) [m/s] - REAL(ReKi) , DIMENSION(1:3) :: V0 !< disk-averaged velocity (for input to SkewWake) [m/s] - REAL(R8Ki) , DIMENSION(1:3) :: x_hat_disk !< Hub Orientation vector: normal to rotor disk [-] + REAL(ReKi) :: Un_disk = 0.0_ReKi !< disk-averaged velocity normal to the rotor disk (for input to DBEMT) [m/s] + REAL(ReKi) , DIMENSION(1:3) :: V0 = 0.0_ReKi !< disk-averaged velocity (for input to SkewWake) [m/s] + REAL(R8Ki) , DIMENSION(1:3) :: x_hat_disk = 0.0_R8Ki !< Hub Orientation vector: normal to rotor disk [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: UserProp !< Optional user property for interpolating airfoils (per element per blade) [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: CantAngle !< Cant angle [Array of size (NumBlNds,numBlades)] [rad] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: drdz !< dr/dz geometric parameter [-] @@ -227,7239 +227,1910 @@ MODULE BEMT_Types END TYPE BEMT_OutputType ! ======================= CONTAINS - SUBROUTINE BEMT_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(BEMT_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(BEMT_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 = 'BEMT_CopyInitInput' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcInitInputData%chord)) THEN - i1_l = LBOUND(SrcInitInputData%chord,1) - i1_u = UBOUND(SrcInitInputData%chord,1) - i2_l = LBOUND(SrcInitInputData%chord,2) - i2_u = UBOUND(SrcInitInputData%chord,2) - IF (.NOT. ALLOCATED(DstInitInputData%chord)) THEN - ALLOCATE(DstInitInputData%chord(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%chord.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%chord = SrcInitInputData%chord -ENDIF - DstInitInputData%numBlades = SrcInitInputData%numBlades - DstInitInputData%airDens = SrcInitInputData%airDens - DstInitInputData%kinVisc = SrcInitInputData%kinVisc - DstInitInputData%skewWakeMod = SrcInitInputData%skewWakeMod - DstInitInputData%aTol = SrcInitInputData%aTol - DstInitInputData%useTipLoss = SrcInitInputData%useTipLoss - DstInitInputData%useHubLoss = SrcInitInputData%useHubLoss - DstInitInputData%useInduction = SrcInitInputData%useInduction - DstInitInputData%useTanInd = SrcInitInputData%useTanInd - DstInitInputData%useAIDrag = SrcInitInputData%useAIDrag - DstInitInputData%useTIDrag = SrcInitInputData%useTIDrag - DstInitInputData%MomentumCorr = SrcInitInputData%MomentumCorr - DstInitInputData%numBladeNodes = SrcInitInputData%numBladeNodes - DstInitInputData%numReIterations = SrcInitInputData%numReIterations - DstInitInputData%maxIndIterations = SrcInitInputData%maxIndIterations -IF (ALLOCATED(SrcInitInputData%AFindx)) THEN - i1_l = LBOUND(SrcInitInputData%AFindx,1) - i1_u = UBOUND(SrcInitInputData%AFindx,1) - i2_l = LBOUND(SrcInitInputData%AFindx,2) - i2_u = UBOUND(SrcInitInputData%AFindx,2) - IF (.NOT. ALLOCATED(DstInitInputData%AFindx)) THEN - ALLOCATE(DstInitInputData%AFindx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%AFindx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%AFindx = SrcInitInputData%AFindx -ENDIF -IF (ALLOCATED(SrcInitInputData%zHub)) THEN - i1_l = LBOUND(SrcInitInputData%zHub,1) - i1_u = UBOUND(SrcInitInputData%zHub,1) - IF (.NOT. ALLOCATED(DstInitInputData%zHub)) THEN - ALLOCATE(DstInitInputData%zHub(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%zHub.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%zHub = SrcInitInputData%zHub -ENDIF -IF (ALLOCATED(SrcInitInputData%zLocal)) THEN - i1_l = LBOUND(SrcInitInputData%zLocal,1) - i1_u = UBOUND(SrcInitInputData%zLocal,1) - i2_l = LBOUND(SrcInitInputData%zLocal,2) - i2_u = UBOUND(SrcInitInputData%zLocal,2) - IF (.NOT. ALLOCATED(DstInitInputData%zLocal)) THEN - ALLOCATE(DstInitInputData%zLocal(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%zLocal.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%zLocal = SrcInitInputData%zLocal -ENDIF -IF (ALLOCATED(SrcInitInputData%zTip)) THEN - i1_l = LBOUND(SrcInitInputData%zTip,1) - i1_u = UBOUND(SrcInitInputData%zTip,1) - IF (.NOT. ALLOCATED(DstInitInputData%zTip)) THEN - ALLOCATE(DstInitInputData%zTip(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%zTip.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%zTip = SrcInitInputData%zTip -ENDIF -IF (ALLOCATED(SrcInitInputData%rLocal)) THEN - i1_l = LBOUND(SrcInitInputData%rLocal,1) - i1_u = UBOUND(SrcInitInputData%rLocal,1) - i2_l = LBOUND(SrcInitInputData%rLocal,2) - i2_u = UBOUND(SrcInitInputData%rLocal,2) - IF (.NOT. ALLOCATED(DstInitInputData%rLocal)) THEN - ALLOCATE(DstInitInputData%rLocal(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%rLocal.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%rLocal = SrcInitInputData%rLocal -ENDIF -IF (ALLOCATED(SrcInitInputData%rTipFix)) THEN - i1_l = LBOUND(SrcInitInputData%rTipFix,1) - i1_u = UBOUND(SrcInitInputData%rTipFix,1) - IF (.NOT. ALLOCATED(DstInitInputData%rTipFix)) THEN - ALLOCATE(DstInitInputData%rTipFix(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%rTipFix.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%rTipFix = SrcInitInputData%rTipFix -ENDIF - DstInitInputData%UAMod = SrcInitInputData%UAMod - DstInitInputData%UA_Flag = SrcInitInputData%UA_Flag - DstInitInputData%Flookup = SrcInitInputData%Flookup - DstInitInputData%a_s = SrcInitInputData%a_s - DstInitInputData%DBEMT_Mod = SrcInitInputData%DBEMT_Mod - DstInitInputData%tau1_const = SrcInitInputData%tau1_const - DstInitInputData%yawCorrFactor = SrcInitInputData%yawCorrFactor -IF (ALLOCATED(SrcInitInputData%UAOff_innerNode)) THEN - i1_l = LBOUND(SrcInitInputData%UAOff_innerNode,1) - i1_u = UBOUND(SrcInitInputData%UAOff_innerNode,1) - IF (.NOT. ALLOCATED(DstInitInputData%UAOff_innerNode)) THEN - ALLOCATE(DstInitInputData%UAOff_innerNode(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%UAOff_innerNode.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%UAOff_innerNode = SrcInitInputData%UAOff_innerNode -ENDIF -IF (ALLOCATED(SrcInitInputData%UAOff_outerNode)) THEN - i1_l = LBOUND(SrcInitInputData%UAOff_outerNode,1) - i1_u = UBOUND(SrcInitInputData%UAOff_outerNode,1) - IF (.NOT. ALLOCATED(DstInitInputData%UAOff_outerNode)) THEN - ALLOCATE(DstInitInputData%UAOff_outerNode(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%UAOff_outerNode.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%UAOff_outerNode = SrcInitInputData%UAOff_outerNode -ENDIF - DstInitInputData%RootName = SrcInitInputData%RootName - DstInitInputData%SumPrint = SrcInitInputData%SumPrint - DstInitInputData%BEM_Mod = SrcInitInputData%BEM_Mod - END SUBROUTINE BEMT_CopyInitInput - - SUBROUTINE BEMT_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(BEMT_InitInputType), INTENT(INOUT) :: InitInputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_DestroyInitInput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(InitInputData%chord)) THEN - DEALLOCATE(InitInputData%chord) -ENDIF -IF (ALLOCATED(InitInputData%AFindx)) THEN - DEALLOCATE(InitInputData%AFindx) -ENDIF -IF (ALLOCATED(InitInputData%zHub)) THEN - DEALLOCATE(InitInputData%zHub) -ENDIF -IF (ALLOCATED(InitInputData%zLocal)) THEN - DEALLOCATE(InitInputData%zLocal) -ENDIF -IF (ALLOCATED(InitInputData%zTip)) THEN - DEALLOCATE(InitInputData%zTip) -ENDIF -IF (ALLOCATED(InitInputData%rLocal)) THEN - DEALLOCATE(InitInputData%rLocal) -ENDIF -IF (ALLOCATED(InitInputData%rTipFix)) THEN - DEALLOCATE(InitInputData%rTipFix) -ENDIF -IF (ALLOCATED(InitInputData%UAOff_innerNode)) THEN - DEALLOCATE(InitInputData%UAOff_innerNode) -ENDIF -IF (ALLOCATED(InitInputData%UAOff_outerNode)) THEN - DEALLOCATE(InitInputData%UAOff_outerNode) -ENDIF - END SUBROUTINE BEMT_DestroyInitInput - - SUBROUTINE BEMT_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(BEMT_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 = 'BEMT_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 ! chord allocated yes/no - IF ( ALLOCATED(InData%chord) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! chord upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%chord) ! chord - END IF - Int_BufSz = Int_BufSz + 1 ! numBlades - Re_BufSz = Re_BufSz + 1 ! airDens - Re_BufSz = Re_BufSz + 1 ! kinVisc - Int_BufSz = Int_BufSz + 1 ! skewWakeMod - Re_BufSz = Re_BufSz + 1 ! aTol - Int_BufSz = Int_BufSz + 1 ! useTipLoss - Int_BufSz = Int_BufSz + 1 ! useHubLoss - Int_BufSz = Int_BufSz + 1 ! useInduction - Int_BufSz = Int_BufSz + 1 ! useTanInd - Int_BufSz = Int_BufSz + 1 ! useAIDrag - Int_BufSz = Int_BufSz + 1 ! useTIDrag - Int_BufSz = Int_BufSz + 1 ! MomentumCorr - Int_BufSz = Int_BufSz + 1 ! numBladeNodes - Int_BufSz = Int_BufSz + 1 ! numReIterations - Int_BufSz = Int_BufSz + 1 ! maxIndIterations - Int_BufSz = Int_BufSz + 1 ! AFindx allocated yes/no - IF ( ALLOCATED(InData%AFindx) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! AFindx upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%AFindx) ! AFindx - END IF - Int_BufSz = Int_BufSz + 1 ! zHub allocated yes/no - IF ( ALLOCATED(InData%zHub) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! zHub upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%zHub) ! zHub - END IF - Int_BufSz = Int_BufSz + 1 ! zLocal allocated yes/no - IF ( ALLOCATED(InData%zLocal) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! zLocal upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%zLocal) ! zLocal - END IF - Int_BufSz = Int_BufSz + 1 ! zTip allocated yes/no - IF ( ALLOCATED(InData%zTip) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! zTip upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%zTip) ! zTip - END IF - Int_BufSz = Int_BufSz + 1 ! rLocal allocated yes/no - IF ( ALLOCATED(InData%rLocal) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! rLocal upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%rLocal) ! rLocal - END IF - Int_BufSz = Int_BufSz + 1 ! rTipFix allocated yes/no - IF ( ALLOCATED(InData%rTipFix) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! rTipFix upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%rTipFix) ! rTipFix - END IF - Int_BufSz = Int_BufSz + 1 ! UAMod - Int_BufSz = Int_BufSz + 1 ! UA_Flag - Int_BufSz = Int_BufSz + 1 ! Flookup - Re_BufSz = Re_BufSz + 1 ! a_s - Int_BufSz = Int_BufSz + 1 ! DBEMT_Mod - Re_BufSz = Re_BufSz + 1 ! tau1_const - Re_BufSz = Re_BufSz + 1 ! yawCorrFactor - Int_BufSz = Int_BufSz + 1 ! UAOff_innerNode allocated yes/no - IF ( ALLOCATED(InData%UAOff_innerNode) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! UAOff_innerNode upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%UAOff_innerNode) ! UAOff_innerNode - END IF - Int_BufSz = Int_BufSz + 1 ! UAOff_outerNode allocated yes/no - IF ( ALLOCATED(InData%UAOff_outerNode) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! UAOff_outerNode upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%UAOff_outerNode) ! UAOff_outerNode - END IF - Int_BufSz = Int_BufSz + 1*LEN(InData%RootName) ! RootName - Int_BufSz = Int_BufSz + 1 ! SumPrint - Int_BufSz = Int_BufSz + 1 ! BEM_Mod - 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%chord) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%chord,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%chord,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%chord,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%chord,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%chord,2), UBOUND(InData%chord,2) - DO i1 = LBOUND(InData%chord,1), UBOUND(InData%chord,1) - ReKiBuf(Re_Xferred) = InData%chord(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%numBlades - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%airDens - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%kinVisc - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%skewWakeMod - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%aTol - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%useTipLoss, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%useHubLoss, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%useInduction, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%useTanInd, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%useAIDrag, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%useTIDrag, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%MomentumCorr, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%numBladeNodes - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%numReIterations - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%maxIndIterations - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%AFindx) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AFindx,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AFindx,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AFindx,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AFindx,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%AFindx,2), UBOUND(InData%AFindx,2) - DO i1 = LBOUND(InData%AFindx,1), UBOUND(InData%AFindx,1) - IntKiBuf(Int_Xferred) = InData%AFindx(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%zHub) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%zHub,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%zHub,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%zHub,1), UBOUND(InData%zHub,1) - ReKiBuf(Re_Xferred) = InData%zHub(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%zLocal) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%zLocal,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%zLocal,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%zLocal,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%zLocal,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%zLocal,2), UBOUND(InData%zLocal,2) - DO i1 = LBOUND(InData%zLocal,1), UBOUND(InData%zLocal,1) - ReKiBuf(Re_Xferred) = InData%zLocal(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%zTip) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%zTip,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%zTip,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%zTip,1), UBOUND(InData%zTip,1) - ReKiBuf(Re_Xferred) = InData%zTip(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%rLocal) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rLocal,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rLocal,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rLocal,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rLocal,2) - Int_Xferred = Int_Xferred + 2 - DO i2 = LBOUND(InData%rLocal,2), UBOUND(InData%rLocal,2) - DO i1 = LBOUND(InData%rLocal,1), UBOUND(InData%rLocal,1) - ReKiBuf(Re_Xferred) = InData%rLocal(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%rTipFix) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rTipFix,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rTipFix,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%rTipFix,1), UBOUND(InData%rTipFix,1) - ReKiBuf(Re_Xferred) = InData%rTipFix(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%UAMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%UA_Flag, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%Flookup, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%a_s - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%DBEMT_Mod - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%tau1_const - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%yawCorrFactor - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%UAOff_innerNode) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%UAOff_innerNode,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UAOff_innerNode,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%UAOff_innerNode,1), UBOUND(InData%UAOff_innerNode,1) - IntKiBuf(Int_Xferred) = InData%UAOff_innerNode(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%UAOff_outerNode) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%UAOff_outerNode,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UAOff_outerNode,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%UAOff_outerNode,1), UBOUND(InData%UAOff_outerNode,1) - IntKiBuf(Int_Xferred) = InData%UAOff_outerNode(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - 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) = TRANSFER(InData%SumPrint, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%BEM_Mod - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE BEMT_PackInitInput - - SUBROUTINE BEMT_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(BEMT_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 = 'BEMT_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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! chord not allocated - Int_Xferred = Int_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%chord)) DEALLOCATE(OutData%chord) - ALLOCATE(OutData%chord(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%chord.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%chord,2), UBOUND(OutData%chord,2) - DO i1 = LBOUND(OutData%chord,1), UBOUND(OutData%chord,1) - OutData%chord(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%numBlades = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%airDens = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%kinVisc = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%skewWakeMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%aTol = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%useTipLoss = TRANSFER(IntKiBuf(Int_Xferred), OutData%useTipLoss) - Int_Xferred = Int_Xferred + 1 - OutData%useHubLoss = TRANSFER(IntKiBuf(Int_Xferred), OutData%useHubLoss) - Int_Xferred = Int_Xferred + 1 - OutData%useInduction = TRANSFER(IntKiBuf(Int_Xferred), OutData%useInduction) - Int_Xferred = Int_Xferred + 1 - OutData%useTanInd = TRANSFER(IntKiBuf(Int_Xferred), OutData%useTanInd) - Int_Xferred = Int_Xferred + 1 - OutData%useAIDrag = TRANSFER(IntKiBuf(Int_Xferred), OutData%useAIDrag) - Int_Xferred = Int_Xferred + 1 - OutData%useTIDrag = TRANSFER(IntKiBuf(Int_Xferred), OutData%useTIDrag) - Int_Xferred = Int_Xferred + 1 - OutData%MomentumCorr = TRANSFER(IntKiBuf(Int_Xferred), OutData%MomentumCorr) - Int_Xferred = Int_Xferred + 1 - OutData%numBladeNodes = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%numReIterations = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%maxIndIterations = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AFindx not allocated - Int_Xferred = Int_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%AFindx)) DEALLOCATE(OutData%AFindx) - ALLOCATE(OutData%AFindx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AFindx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%AFindx,2), UBOUND(OutData%AFindx,2) - DO i1 = LBOUND(OutData%AFindx,1), UBOUND(OutData%AFindx,1) - OutData%AFindx(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! zHub not allocated - Int_Xferred = Int_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%zHub)) DEALLOCATE(OutData%zHub) - ALLOCATE(OutData%zHub(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%zHub.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%zHub,1), UBOUND(OutData%zHub,1) - OutData%zHub(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! zLocal not allocated - Int_Xferred = Int_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%zLocal)) DEALLOCATE(OutData%zLocal) - ALLOCATE(OutData%zLocal(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%zLocal.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%zLocal,2), UBOUND(OutData%zLocal,2) - DO i1 = LBOUND(OutData%zLocal,1), UBOUND(OutData%zLocal,1) - OutData%zLocal(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! zTip not allocated - Int_Xferred = Int_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%zTip)) DEALLOCATE(OutData%zTip) - ALLOCATE(OutData%zTip(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%zTip.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%zTip,1), UBOUND(OutData%zTip,1) - OutData%zTip(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rLocal not allocated - Int_Xferred = Int_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%rLocal)) DEALLOCATE(OutData%rLocal) - ALLOCATE(OutData%rLocal(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rLocal.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%rLocal,2), UBOUND(OutData%rLocal,2) - DO i1 = LBOUND(OutData%rLocal,1), UBOUND(OutData%rLocal,1) - OutData%rLocal(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rTipFix not allocated - Int_Xferred = Int_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%rTipFix)) DEALLOCATE(OutData%rTipFix) - ALLOCATE(OutData%rTipFix(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rTipFix.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%rTipFix,1), UBOUND(OutData%rTipFix,1) - OutData%rTipFix(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%UAMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%UA_Flag = TRANSFER(IntKiBuf(Int_Xferred), OutData%UA_Flag) - Int_Xferred = Int_Xferred + 1 - OutData%Flookup = TRANSFER(IntKiBuf(Int_Xferred), OutData%Flookup) - Int_Xferred = Int_Xferred + 1 - OutData%a_s = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%DBEMT_Mod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%tau1_const = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%yawCorrFactor = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! UAOff_innerNode not allocated - Int_Xferred = Int_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%UAOff_innerNode)) DEALLOCATE(OutData%UAOff_innerNode) - ALLOCATE(OutData%UAOff_innerNode(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%UAOff_innerNode.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%UAOff_innerNode,1), UBOUND(OutData%UAOff_innerNode,1) - OutData%UAOff_innerNode(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! UAOff_outerNode not allocated - Int_Xferred = Int_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%UAOff_outerNode)) DEALLOCATE(OutData%UAOff_outerNode) - ALLOCATE(OutData%UAOff_outerNode(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%UAOff_outerNode.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%UAOff_outerNode,1), UBOUND(OutData%UAOff_outerNode,1) - OutData%UAOff_outerNode(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%SumPrint = TRANSFER(IntKiBuf(Int_Xferred), OutData%SumPrint) - Int_Xferred = Int_Xferred + 1 - OutData%BEM_Mod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE BEMT_UnPackInitInput - - SUBROUTINE BEMT_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(BEMT_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(BEMT_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 = 'BEMT_CopyInitOutput' -! +subroutine BEMT_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) + type(BEMT_InitInputType), intent(in) :: SrcInitInputData + type(BEMT_InitInputType), intent(inout) :: DstInitInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'BEMT_CopyInitInput' ErrStat = ErrID_None - ErrMsg = "" - CALL NWTC_Library_Copyprogdesc( SrcInitOutputData%Version, DstInitOutputData%Version, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE BEMT_CopyInitOutput - - SUBROUTINE BEMT_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(BEMT_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_DestroyInitOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL NWTC_Library_Destroyprogdesc( InitOutputData%Version, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE BEMT_DestroyInitOutput - - SUBROUTINE BEMT_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(BEMT_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 = 'BEMT_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 ! Version: size of buffers for each call to pack subtype - CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Version, ErrStat2, ErrMsg2, .TRUE. ) ! Version - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Version - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Version - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Version - 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 NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Version, ErrStat2, ErrMsg2, OnlySize ) ! Version - 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 BEMT_PackInitOutput - - SUBROUTINE BEMT_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(BEMT_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 = 'BEMT_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%Version, ErrStat2, ErrMsg2 ) ! Version - 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 BEMT_UnPackInitOutput - - SUBROUTINE BEMT_CopySkewWake_InputType( SrcSkewWake_InputTypeData, DstSkewWake_InputTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(BEMT_SkewWake_InputType), INTENT(IN) :: SrcSkewWake_InputTypeData - TYPE(BEMT_SkewWake_InputType), INTENT(INOUT) :: DstSkewWake_InputTypeData - 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 = 'BEMT_CopySkewWake_InputType' -! + ErrMsg = '' + if (allocated(SrcInitInputData%chord)) then + LB(1:2) = lbound(SrcInitInputData%chord) + UB(1:2) = ubound(SrcInitInputData%chord) + if (.not. allocated(DstInitInputData%chord)) then + allocate(DstInitInputData%chord(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%chord.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%chord = SrcInitInputData%chord + end if + DstInitInputData%numBlades = SrcInitInputData%numBlades + DstInitInputData%airDens = SrcInitInputData%airDens + DstInitInputData%kinVisc = SrcInitInputData%kinVisc + DstInitInputData%skewWakeMod = SrcInitInputData%skewWakeMod + DstInitInputData%skewRedistrMod = SrcInitInputData%skewRedistrMod + DstInitInputData%aTol = SrcInitInputData%aTol + DstInitInputData%useTipLoss = SrcInitInputData%useTipLoss + DstInitInputData%useHubLoss = SrcInitInputData%useHubLoss + DstInitInputData%useInduction = SrcInitInputData%useInduction + DstInitInputData%useTanInd = SrcInitInputData%useTanInd + DstInitInputData%useAIDrag = SrcInitInputData%useAIDrag + DstInitInputData%useTIDrag = SrcInitInputData%useTIDrag + DstInitInputData%MomentumCorr = SrcInitInputData%MomentumCorr + DstInitInputData%numBladeNodes = SrcInitInputData%numBladeNodes + DstInitInputData%numReIterations = SrcInitInputData%numReIterations + DstInitInputData%maxIndIterations = SrcInitInputData%maxIndIterations + if (allocated(SrcInitInputData%AFindx)) then + LB(1:2) = lbound(SrcInitInputData%AFindx) + UB(1:2) = ubound(SrcInitInputData%AFindx) + if (.not. allocated(DstInitInputData%AFindx)) then + allocate(DstInitInputData%AFindx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%AFindx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%AFindx = SrcInitInputData%AFindx + end if + if (allocated(SrcInitInputData%zHub)) then + LB(1:1) = lbound(SrcInitInputData%zHub) + UB(1:1) = ubound(SrcInitInputData%zHub) + if (.not. allocated(DstInitInputData%zHub)) then + allocate(DstInitInputData%zHub(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%zHub.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%zHub = SrcInitInputData%zHub + end if + if (allocated(SrcInitInputData%zLocal)) then + LB(1:2) = lbound(SrcInitInputData%zLocal) + UB(1:2) = ubound(SrcInitInputData%zLocal) + if (.not. allocated(DstInitInputData%zLocal)) then + allocate(DstInitInputData%zLocal(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%zLocal.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%zLocal = SrcInitInputData%zLocal + end if + if (allocated(SrcInitInputData%zTip)) then + LB(1:1) = lbound(SrcInitInputData%zTip) + UB(1:1) = ubound(SrcInitInputData%zTip) + if (.not. allocated(DstInitInputData%zTip)) then + allocate(DstInitInputData%zTip(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%zTip.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%zTip = SrcInitInputData%zTip + end if + if (allocated(SrcInitInputData%rLocal)) then + LB(1:2) = lbound(SrcInitInputData%rLocal) + UB(1:2) = ubound(SrcInitInputData%rLocal) + if (.not. allocated(DstInitInputData%rLocal)) then + allocate(DstInitInputData%rLocal(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%rLocal.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%rLocal = SrcInitInputData%rLocal + end if + if (allocated(SrcInitInputData%rTipFix)) then + LB(1:1) = lbound(SrcInitInputData%rTipFix) + UB(1:1) = ubound(SrcInitInputData%rTipFix) + if (.not. allocated(DstInitInputData%rTipFix)) then + allocate(DstInitInputData%rTipFix(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%rTipFix.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%rTipFix = SrcInitInputData%rTipFix + end if + DstInitInputData%UA_Flag = SrcInitInputData%UA_Flag + DstInitInputData%DBEMT_Mod = SrcInitInputData%DBEMT_Mod + DstInitInputData%tau1_const = SrcInitInputData%tau1_const + DstInitInputData%yawCorrFactor = SrcInitInputData%yawCorrFactor + DstInitInputData%RootName = SrcInitInputData%RootName + DstInitInputData%SumPrint = SrcInitInputData%SumPrint + DstInitInputData%BEM_Mod = SrcInitInputData%BEM_Mod + call UA_CopyInitInput(SrcInitInputData%UA_Init, DstInitInputData%UA_Init, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine BEMT_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(BEMT_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'BEMT_DestroyInitInput' ErrStat = ErrID_None - ErrMsg = "" - DstSkewWake_InputTypeData%v_qsw = SrcSkewWake_InputTypeData%v_qsw - DstSkewWake_InputTypeData%V0 = SrcSkewWake_InputTypeData%V0 - DstSkewWake_InputTypeData%R = SrcSkewWake_InputTypeData%R - END SUBROUTINE BEMT_CopySkewWake_InputType - - SUBROUTINE BEMT_DestroySkewWake_InputType( SkewWake_InputTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(BEMT_SkewWake_InputType), INTENT(INOUT) :: SkewWake_InputTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_DestroySkewWake_InputType' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE BEMT_DestroySkewWake_InputType - - SUBROUTINE BEMT_PackSkewWake_InputType( 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(BEMT_SkewWake_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 = 'BEMT_PackSkewWake_InputType' - ! 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%v_qsw) ! v_qsw - Re_BufSz = Re_BufSz + 1 ! V0 - Re_BufSz = Re_BufSz + 1 ! R - 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%v_qsw,1), UBOUND(InData%v_qsw,1) - ReKiBuf(Re_Xferred) = InData%v_qsw(i1) - Re_Xferred = Re_Xferred + 1 - END DO - ReKiBuf(Re_Xferred) = InData%V0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%R - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE BEMT_PackSkewWake_InputType - - SUBROUTINE BEMT_UnPackSkewWake_InputType( 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(BEMT_SkewWake_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 = 'BEMT_UnPackSkewWake_InputType' - ! 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%v_qsw,1) - i1_u = UBOUND(OutData%v_qsw,1) - DO i1 = LBOUND(OutData%v_qsw,1), UBOUND(OutData%v_qsw,1) - OutData%v_qsw(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%V0 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%R = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE BEMT_UnPackSkewWake_InputType - - SUBROUTINE BEMT_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(BEMT_ContinuousStateType), INTENT(IN) :: SrcContStateData - TYPE(BEMT_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 = 'BEMT_CopyContState' -! + ErrMsg = '' + if (allocated(InitInputData%chord)) then + deallocate(InitInputData%chord) + end if + if (allocated(InitInputData%AFindx)) then + deallocate(InitInputData%AFindx) + end if + if (allocated(InitInputData%zHub)) then + deallocate(InitInputData%zHub) + end if + if (allocated(InitInputData%zLocal)) then + deallocate(InitInputData%zLocal) + end if + if (allocated(InitInputData%zTip)) then + deallocate(InitInputData%zTip) + end if + if (allocated(InitInputData%rLocal)) then + deallocate(InitInputData%rLocal) + end if + if (allocated(InitInputData%rTipFix)) then + deallocate(InitInputData%rTipFix) + end if + call UA_DestroyInitInput(InitInputData%UA_Init, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine BEMT_PackInitInput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(BEMT_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'BEMT_PackInitInput' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%chord) + call RegPack(RF, InData%numBlades) + call RegPack(RF, InData%airDens) + call RegPack(RF, InData%kinVisc) + call RegPack(RF, InData%skewWakeMod) + call RegPack(RF, InData%skewRedistrMod) + call RegPack(RF, InData%aTol) + call RegPack(RF, InData%useTipLoss) + call RegPack(RF, InData%useHubLoss) + call RegPack(RF, InData%useInduction) + call RegPack(RF, InData%useTanInd) + call RegPack(RF, InData%useAIDrag) + call RegPack(RF, InData%useTIDrag) + call RegPack(RF, InData%MomentumCorr) + call RegPack(RF, InData%numBladeNodes) + call RegPack(RF, InData%numReIterations) + call RegPack(RF, InData%maxIndIterations) + call RegPackAlloc(RF, InData%AFindx) + call RegPackAlloc(RF, InData%zHub) + call RegPackAlloc(RF, InData%zLocal) + call RegPackAlloc(RF, InData%zTip) + call RegPackAlloc(RF, InData%rLocal) + call RegPackAlloc(RF, InData%rTipFix) + call RegPack(RF, InData%UA_Flag) + call RegPack(RF, InData%DBEMT_Mod) + call RegPack(RF, InData%tau1_const) + call RegPack(RF, InData%yawCorrFactor) + call RegPack(RF, InData%RootName) + call RegPack(RF, InData%SumPrint) + call RegPack(RF, InData%BEM_Mod) + call UA_PackInitInput(RF, InData%UA_Init) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine BEMT_UnPackInitInput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(BEMT_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'BEMT_UnPackInitInput' + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%chord); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%numBlades); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%airDens); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%kinVisc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%skewWakeMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%skewRedistrMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%aTol); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%useTipLoss); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%useHubLoss); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%useInduction); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%useTanInd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%useAIDrag); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%useTIDrag); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MomentumCorr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%numBladeNodes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%numReIterations); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%maxIndIterations); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AFindx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%zHub); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%zLocal); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%zTip); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%rLocal); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%rTipFix); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UA_Flag); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DBEMT_Mod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%tau1_const); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%yawCorrFactor); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RootName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SumPrint); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BEM_Mod); if (RegCheckErr(RF, RoutineName)) return + call UA_UnpackInitInput(RF, OutData%UA_Init) ! UA_Init +end subroutine + +subroutine BEMT_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) + type(BEMT_InitOutputType), intent(in) :: SrcInitOutputData + type(BEMT_InitOutputType), intent(inout) :: DstInitOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'BEMT_CopyInitOutput' ErrStat = ErrID_None - ErrMsg = "" - CALL UA_CopyContState( SrcContStateData%UA, DstContStateData%UA, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL DBEMT_CopyContState( SrcContStateData%DBEMT, DstContStateData%DBEMT, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstContStateData%V_w = SrcContStateData%V_w - END SUBROUTINE BEMT_CopyContState - - SUBROUTINE BEMT_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(BEMT_ContinuousStateType), INTENT(INOUT) :: ContStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_DestroyContState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL UA_DestroyContState( ContStateData%UA, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL DBEMT_DestroyContState( ContStateData%DBEMT, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE BEMT_DestroyContState - - SUBROUTINE BEMT_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(BEMT_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 = 'BEMT_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 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! UA: size of buffers for each call to pack subtype - CALL UA_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%UA, ErrStat2, ErrMsg2, .TRUE. ) ! UA - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! UA - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! UA - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! UA - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! DBEMT: size of buffers for each call to pack subtype - CALL DBEMT_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%DBEMT, ErrStat2, ErrMsg2, .TRUE. ) ! DBEMT - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! DBEMT - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! DBEMT - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! DBEMT - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Db_BufSz = Db_BufSz + SIZE(InData%V_w) ! V_w - 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 UA_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%UA, ErrStat2, ErrMsg2, OnlySize ) ! UA - 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 DBEMT_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%DBEMT, ErrStat2, ErrMsg2, OnlySize ) ! DBEMT - 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 i1 = LBOUND(InData%V_w,1), UBOUND(InData%V_w,1) - DbKiBuf(Db_Xferred) = InData%V_w(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END SUBROUTINE BEMT_PackContState - - SUBROUTINE BEMT_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(BEMT_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 = 'BEMT_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 - 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 UA_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%UA, ErrStat2, ErrMsg2 ) ! UA - 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 DBEMT_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%DBEMT, ErrStat2, ErrMsg2 ) ! DBEMT - 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) - i1_l = LBOUND(OutData%V_w,1) - i1_u = UBOUND(OutData%V_w,1) - DO i1 = LBOUND(OutData%V_w,1), UBOUND(OutData%V_w,1) - OutData%V_w(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END SUBROUTINE BEMT_UnPackContState - - SUBROUTINE BEMT_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(BEMT_DiscreteStateType), INTENT(IN) :: SrcDiscStateData - TYPE(BEMT_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 = 'BEMT_CopyDiscState' -! + ErrMsg = '' + call NWTC_Library_CopyProgDesc(SrcInitOutputData%Version, DstInitOutputData%Version, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine BEMT_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(BEMT_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'BEMT_DestroyInitOutput' ErrStat = ErrID_None - ErrMsg = "" - CALL UA_CopyDiscState( SrcDiscStateData%UA, DstDiscStateData%UA, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE BEMT_CopyDiscState - - SUBROUTINE BEMT_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(BEMT_DiscreteStateType), INTENT(INOUT) :: DiscStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_DestroyDiscState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL UA_DestroyDiscState( DiscStateData%UA, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE BEMT_DestroyDiscState - - SUBROUTINE BEMT_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(BEMT_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 = 'BEMT_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 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! UA: size of buffers for each call to pack subtype - CALL UA_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%UA, ErrStat2, ErrMsg2, .TRUE. ) ! UA - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! UA - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! UA - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! UA - 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 UA_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%UA, ErrStat2, ErrMsg2, OnlySize ) ! UA - 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 BEMT_PackDiscState - - SUBROUTINE BEMT_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(BEMT_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 = 'BEMT_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 - 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 UA_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%UA, ErrStat2, ErrMsg2 ) ! UA - 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 BEMT_UnPackDiscState - - SUBROUTINE BEMT_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(BEMT_ConstraintStateType), INTENT(IN) :: SrcConstrStateData - TYPE(BEMT_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) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_CopyConstrState' -! + ErrMsg = '' + call NWTC_Library_DestroyProgDesc(InitOutputData%Version, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine BEMT_PackInitOutput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(BEMT_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'BEMT_PackInitOutput' + if (RF%ErrStat >= AbortErrLev) return + call NWTC_Library_PackProgDesc(RF, InData%Version) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine BEMT_UnPackInitOutput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(BEMT_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'BEMT_UnPackInitOutput' + if (RF%ErrStat /= ErrID_None) return + call NWTC_Library_UnpackProgDesc(RF, OutData%Version) ! Version +end subroutine + +subroutine BEMT_CopySkewWake_InputType(SrcSkewWake_InputTypeData, DstSkewWake_InputTypeData, CtrlCode, ErrStat, ErrMsg) + type(BEMT_SkewWake_InputType), intent(in) :: SrcSkewWake_InputTypeData + type(BEMT_SkewWake_InputType), intent(inout) :: DstSkewWake_InputTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'BEMT_CopySkewWake_InputType' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcConstrStateData%phi)) THEN - i1_l = LBOUND(SrcConstrStateData%phi,1) - i1_u = UBOUND(SrcConstrStateData%phi,1) - i2_l = LBOUND(SrcConstrStateData%phi,2) - i2_u = UBOUND(SrcConstrStateData%phi,2) - IF (.NOT. ALLOCATED(DstConstrStateData%phi)) THEN - ALLOCATE(DstConstrStateData%phi(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstConstrStateData%phi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstConstrStateData%phi = SrcConstrStateData%phi -ENDIF - END SUBROUTINE BEMT_CopyConstrState - - SUBROUTINE BEMT_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(BEMT_ConstraintStateType), INTENT(INOUT) :: ConstrStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_DestroyConstrState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(ConstrStateData%phi)) THEN - DEALLOCATE(ConstrStateData%phi) -ENDIF - END SUBROUTINE BEMT_DestroyConstrState - - SUBROUTINE BEMT_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(BEMT_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 = 'BEMT_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 - Int_BufSz = Int_BufSz + 1 ! phi allocated yes/no - IF ( ALLOCATED(InData%phi) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! phi upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%phi) ! phi - 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%phi) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%phi,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%phi,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%phi,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%phi,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%phi,2), UBOUND(InData%phi,2) - DO i1 = LBOUND(InData%phi,1), UBOUND(InData%phi,1) - ReKiBuf(Re_Xferred) = InData%phi(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE BEMT_PackConstrState - - SUBROUTINE BEMT_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(BEMT_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) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! phi not allocated - Int_Xferred = Int_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%phi)) DEALLOCATE(OutData%phi) - ALLOCATE(OutData%phi(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%phi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%phi,2), UBOUND(OutData%phi,2) - DO i1 = LBOUND(OutData%phi,1), UBOUND(OutData%phi,1) - OutData%phi(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE BEMT_UnPackConstrState - - SUBROUTINE BEMT_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(BEMT_OtherStateType), INTENT(IN) :: SrcOtherStateData - TYPE(BEMT_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) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_CopyOtherState' -! + ErrMsg = '' + DstSkewWake_InputTypeData%v_qsw = SrcSkewWake_InputTypeData%v_qsw + DstSkewWake_InputTypeData%V0 = SrcSkewWake_InputTypeData%V0 + DstSkewWake_InputTypeData%R = SrcSkewWake_InputTypeData%R +end subroutine + +subroutine BEMT_DestroySkewWake_InputType(SkewWake_InputTypeData, ErrStat, ErrMsg) + type(BEMT_SkewWake_InputType), intent(inout) :: SkewWake_InputTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'BEMT_DestroySkewWake_InputType' ErrStat = ErrID_None - ErrMsg = "" - CALL UA_CopyOtherState( SrcOtherStateData%UA, DstOtherStateData%UA, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL DBEMT_CopyOtherState( SrcOtherStateData%DBEMT, DstOtherStateData%DBEMT, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcOtherStateData%ValidPhi)) THEN - i1_l = LBOUND(SrcOtherStateData%ValidPhi,1) - i1_u = UBOUND(SrcOtherStateData%ValidPhi,1) - i2_l = LBOUND(SrcOtherStateData%ValidPhi,2) - i2_u = UBOUND(SrcOtherStateData%ValidPhi,2) - IF (.NOT. ALLOCATED(DstOtherStateData%ValidPhi)) THEN - ALLOCATE(DstOtherStateData%ValidPhi(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%ValidPhi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOtherStateData%ValidPhi = SrcOtherStateData%ValidPhi -ENDIF - DstOtherStateData%nodesInitialized = SrcOtherStateData%nodesInitialized - DO i1 = LBOUND(SrcOtherStateData%xdot,1), UBOUND(SrcOtherStateData%xdot,1) - CALL BEMT_CopyContState( SrcOtherStateData%xdot(i1), DstOtherStateData%xdot(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DstOtherStateData%n = SrcOtherStateData%n - END SUBROUTINE BEMT_CopyOtherState - - SUBROUTINE BEMT_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(BEMT_OtherStateType), INTENT(INOUT) :: OtherStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_DestroyOtherState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL UA_DestroyOtherState( OtherStateData%UA, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL DBEMT_DestroyOtherState( OtherStateData%DBEMT, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(OtherStateData%ValidPhi)) THEN - DEALLOCATE(OtherStateData%ValidPhi) -ENDIF -DO i1 = LBOUND(OtherStateData%xdot,1), UBOUND(OtherStateData%xdot,1) - CALL BEMT_DestroyContState( OtherStateData%xdot(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - END SUBROUTINE BEMT_DestroyOtherState - - SUBROUTINE BEMT_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(BEMT_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 = 'BEMT_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 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! UA: size of buffers for each call to pack subtype - CALL UA_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%UA, ErrStat2, ErrMsg2, .TRUE. ) ! UA - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! UA - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! UA - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! UA - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! DBEMT: size of buffers for each call to pack subtype - CALL DBEMT_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%DBEMT, ErrStat2, ErrMsg2, .TRUE. ) ! DBEMT - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! DBEMT - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! DBEMT - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! DBEMT - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! ValidPhi allocated yes/no - IF ( ALLOCATED(InData%ValidPhi) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! ValidPhi upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%ValidPhi) ! ValidPhi - END IF - Int_BufSz = Int_BufSz + 1 ! nodesInitialized - 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 BEMT_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 - 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 - - CALL UA_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%UA, ErrStat2, ErrMsg2, OnlySize ) ! UA - 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 DBEMT_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%DBEMT, ErrStat2, ErrMsg2, OnlySize ) ! DBEMT - 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%ValidPhi) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ValidPhi,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ValidPhi,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ValidPhi,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ValidPhi,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%ValidPhi,2), UBOUND(InData%ValidPhi,2) - DO i1 = LBOUND(InData%ValidPhi,1), UBOUND(InData%ValidPhi,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%ValidPhi(i1,i2), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = TRANSFER(InData%nodesInitialized, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%xdot,1), UBOUND(InData%xdot,1) - CALL BEMT_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 - IntKiBuf(Int_Xferred) = InData%n - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE BEMT_PackOtherState - - SUBROUTINE BEMT_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(BEMT_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) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_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 - 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 UA_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%UA, ErrStat2, ErrMsg2 ) ! UA - 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 DBEMT_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%DBEMT, ErrStat2, ErrMsg2 ) ! DBEMT - 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 ! ValidPhi not allocated - Int_Xferred = Int_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%ValidPhi)) DEALLOCATE(OutData%ValidPhi) - ALLOCATE(OutData%ValidPhi(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ValidPhi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%ValidPhi,2), UBOUND(OutData%ValidPhi,2) - DO i1 = LBOUND(OutData%ValidPhi,1), UBOUND(OutData%ValidPhi,1) - OutData%ValidPhi(i1,i2) = TRANSFER(IntKiBuf(Int_Xferred), OutData%ValidPhi(i1,i2)) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - OutData%nodesInitialized = TRANSFER(IntKiBuf(Int_Xferred), OutData%nodesInitialized) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%xdot,1) - i1_u = UBOUND(OutData%xdot,1) - 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 BEMT_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 - OutData%n = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE BEMT_UnPackOtherState - - SUBROUTINE BEMT_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(BEMT_MiscVarType), INTENT(IN) :: SrcMiscData - TYPE(BEMT_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) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_CopyMisc' -! + ErrMsg = '' +end subroutine + +subroutine BEMT_PackSkewWake_InputType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(BEMT_SkewWake_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'BEMT_PackSkewWake_InputType' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%v_qsw) + call RegPack(RF, InData%V0) + call RegPack(RF, InData%R) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine BEMT_UnPackSkewWake_InputType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(BEMT_SkewWake_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'BEMT_UnPackSkewWake_InputType' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%v_qsw); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%V0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%R); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine BEMT_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) + type(BEMT_ContinuousStateType), intent(in) :: SrcContStateData + type(BEMT_ContinuousStateType), intent(inout) :: DstContStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'BEMT_CopyContState' ErrStat = ErrID_None - ErrMsg = "" - DstMiscData%FirstWarn_Skew = SrcMiscData%FirstWarn_Skew - DstMiscData%FirstWarn_Phi = SrcMiscData%FirstWarn_Phi - DstMiscData%FirstWarn_BEMoff = SrcMiscData%FirstWarn_BEMoff - CALL UA_CopyMisc( SrcMiscData%UA, DstMiscData%UA, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL DBEMT_CopyMisc( SrcMiscData%DBEMT, DstMiscData%DBEMT, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL UA_CopyOutput( SrcMiscData%y_UA, DstMiscData%y_UA, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcMiscData%u_UA)) THEN - i1_l = LBOUND(SrcMiscData%u_UA,1) - i1_u = UBOUND(SrcMiscData%u_UA,1) - i2_l = LBOUND(SrcMiscData%u_UA,2) - i2_u = UBOUND(SrcMiscData%u_UA,2) - i3_l = LBOUND(SrcMiscData%u_UA,3) - i3_u = UBOUND(SrcMiscData%u_UA,3) - IF (.NOT. ALLOCATED(DstMiscData%u_UA)) THEN - ALLOCATE(DstMiscData%u_UA(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%u_UA.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i3 = LBOUND(SrcMiscData%u_UA,3), UBOUND(SrcMiscData%u_UA,3) - DO i2 = LBOUND(SrcMiscData%u_UA,2), UBOUND(SrcMiscData%u_UA,2) - DO i1 = LBOUND(SrcMiscData%u_UA,1), UBOUND(SrcMiscData%u_UA,1) - CALL UA_CopyInput( SrcMiscData%u_UA(i1,i2,i3), DstMiscData%u_UA(i1,i2,i3), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO - ENDDO -ENDIF - DO i1 = LBOUND(SrcMiscData%u_DBEMT,1), UBOUND(SrcMiscData%u_DBEMT,1) - CALL DBEMT_CopyInput( SrcMiscData%u_DBEMT(i1), DstMiscData%u_DBEMT(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcMiscData%u_SkewWake,1), UBOUND(SrcMiscData%u_SkewWake,1) - CALL BEMT_Copyskewwake_inputtype( SrcMiscData%u_SkewWake(i1), DstMiscData%u_SkewWake(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -IF (ALLOCATED(SrcMiscData%TnInd_op)) THEN - i1_l = LBOUND(SrcMiscData%TnInd_op,1) - i1_u = UBOUND(SrcMiscData%TnInd_op,1) - i2_l = LBOUND(SrcMiscData%TnInd_op,2) - i2_u = UBOUND(SrcMiscData%TnInd_op,2) - IF (.NOT. ALLOCATED(DstMiscData%TnInd_op)) THEN - ALLOCATE(DstMiscData%TnInd_op(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%TnInd_op.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%TnInd_op = SrcMiscData%TnInd_op -ENDIF -IF (ALLOCATED(SrcMiscData%AxInd_op)) THEN - i1_l = LBOUND(SrcMiscData%AxInd_op,1) - i1_u = UBOUND(SrcMiscData%AxInd_op,1) - i2_l = LBOUND(SrcMiscData%AxInd_op,2) - i2_u = UBOUND(SrcMiscData%AxInd_op,2) - IF (.NOT. ALLOCATED(DstMiscData%AxInd_op)) THEN - ALLOCATE(DstMiscData%AxInd_op(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%AxInd_op.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%AxInd_op = SrcMiscData%AxInd_op -ENDIF -IF (ALLOCATED(SrcMiscData%AxInduction)) THEN - i1_l = LBOUND(SrcMiscData%AxInduction,1) - i1_u = UBOUND(SrcMiscData%AxInduction,1) - i2_l = LBOUND(SrcMiscData%AxInduction,2) - i2_u = UBOUND(SrcMiscData%AxInduction,2) - IF (.NOT. ALLOCATED(DstMiscData%AxInduction)) THEN - ALLOCATE(DstMiscData%AxInduction(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%AxInduction.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%AxInduction = SrcMiscData%AxInduction -ENDIF -IF (ALLOCATED(SrcMiscData%TanInduction)) THEN - i1_l = LBOUND(SrcMiscData%TanInduction,1) - i1_u = UBOUND(SrcMiscData%TanInduction,1) - i2_l = LBOUND(SrcMiscData%TanInduction,2) - i2_u = UBOUND(SrcMiscData%TanInduction,2) - IF (.NOT. ALLOCATED(DstMiscData%TanInduction)) THEN - ALLOCATE(DstMiscData%TanInduction(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%TanInduction.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%TanInduction = SrcMiscData%TanInduction -ENDIF - DstMiscData%UseFrozenWake = SrcMiscData%UseFrozenWake -IF (ALLOCATED(SrcMiscData%Rtip)) THEN - i1_l = LBOUND(SrcMiscData%Rtip,1) - i1_u = UBOUND(SrcMiscData%Rtip,1) - IF (.NOT. ALLOCATED(DstMiscData%Rtip)) THEN - ALLOCATE(DstMiscData%Rtip(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Rtip.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%Rtip = SrcMiscData%Rtip -ENDIF -IF (ALLOCATED(SrcMiscData%phi)) THEN - i1_l = LBOUND(SrcMiscData%phi,1) - i1_u = UBOUND(SrcMiscData%phi,1) - i2_l = LBOUND(SrcMiscData%phi,2) - i2_u = UBOUND(SrcMiscData%phi,2) - IF (.NOT. ALLOCATED(DstMiscData%phi)) THEN - ALLOCATE(DstMiscData%phi(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%phi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%phi = SrcMiscData%phi -ENDIF -IF (ALLOCATED(SrcMiscData%chi)) THEN - i1_l = LBOUND(SrcMiscData%chi,1) - i1_u = UBOUND(SrcMiscData%chi,1) - i2_l = LBOUND(SrcMiscData%chi,2) - i2_u = UBOUND(SrcMiscData%chi,2) - IF (.NOT. ALLOCATED(DstMiscData%chi)) THEN - ALLOCATE(DstMiscData%chi(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%chi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%chi = SrcMiscData%chi -ENDIF -IF (ALLOCATED(SrcMiscData%ValidPhi)) THEN - i1_l = LBOUND(SrcMiscData%ValidPhi,1) - i1_u = UBOUND(SrcMiscData%ValidPhi,1) - i2_l = LBOUND(SrcMiscData%ValidPhi,2) - i2_u = UBOUND(SrcMiscData%ValidPhi,2) - IF (.NOT. ALLOCATED(DstMiscData%ValidPhi)) THEN - ALLOCATE(DstMiscData%ValidPhi(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%ValidPhi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%ValidPhi = SrcMiscData%ValidPhi -ENDIF - DstMiscData%BEM_weight = SrcMiscData%BEM_weight - END SUBROUTINE BEMT_CopyMisc - - SUBROUTINE BEMT_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(BEMT_MiscVarType), INTENT(INOUT) :: MiscData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_DestroyMisc' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL UA_DestroyMisc( MiscData%UA, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL DBEMT_DestroyMisc( MiscData%DBEMT, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL UA_DestroyOutput( MiscData%y_UA, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(MiscData%u_UA)) THEN -DO i3 = LBOUND(MiscData%u_UA,3), UBOUND(MiscData%u_UA,3) -DO i2 = LBOUND(MiscData%u_UA,2), UBOUND(MiscData%u_UA,2) -DO i1 = LBOUND(MiscData%u_UA,1), UBOUND(MiscData%u_UA,1) - CALL UA_DestroyInput( MiscData%u_UA(i1,i2,i3), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO -ENDDO - DEALLOCATE(MiscData%u_UA) -ENDIF -DO i1 = LBOUND(MiscData%u_DBEMT,1), UBOUND(MiscData%u_DBEMT,1) - CALL DBEMT_DestroyInput( MiscData%u_DBEMT(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(MiscData%u_SkewWake,1), UBOUND(MiscData%u_SkewWake,1) - CALL BEMT_Destroyskewwake_inputtype( MiscData%u_SkewWake(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -IF (ALLOCATED(MiscData%TnInd_op)) THEN - DEALLOCATE(MiscData%TnInd_op) -ENDIF -IF (ALLOCATED(MiscData%AxInd_op)) THEN - DEALLOCATE(MiscData%AxInd_op) -ENDIF -IF (ALLOCATED(MiscData%AxInduction)) THEN - DEALLOCATE(MiscData%AxInduction) -ENDIF -IF (ALLOCATED(MiscData%TanInduction)) THEN - DEALLOCATE(MiscData%TanInduction) -ENDIF -IF (ALLOCATED(MiscData%Rtip)) THEN - DEALLOCATE(MiscData%Rtip) -ENDIF -IF (ALLOCATED(MiscData%phi)) THEN - DEALLOCATE(MiscData%phi) -ENDIF -IF (ALLOCATED(MiscData%chi)) THEN - DEALLOCATE(MiscData%chi) -ENDIF -IF (ALLOCATED(MiscData%ValidPhi)) THEN - DEALLOCATE(MiscData%ValidPhi) -ENDIF - END SUBROUTINE BEMT_DestroyMisc - - SUBROUTINE BEMT_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(BEMT_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 = 'BEMT_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 ! FirstWarn_Skew - Int_BufSz = Int_BufSz + 1 ! FirstWarn_Phi - Int_BufSz = Int_BufSz + 1 ! FirstWarn_BEMoff - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! UA: size of buffers for each call to pack subtype - CALL UA_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%UA, ErrStat2, ErrMsg2, .TRUE. ) ! UA - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! UA - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! UA - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! UA - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! DBEMT: size of buffers for each call to pack subtype - CALL DBEMT_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%DBEMT, ErrStat2, ErrMsg2, .TRUE. ) ! DBEMT - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! DBEMT - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! DBEMT - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! DBEMT - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! y_UA: size of buffers for each call to pack subtype - CALL UA_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_UA, ErrStat2, ErrMsg2, .TRUE. ) ! y_UA - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y_UA - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y_UA - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y_UA - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! u_UA allocated yes/no - IF ( ALLOCATED(InData%u_UA) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! u_UA upper/lower bounds for each dimension - DO i3 = LBOUND(InData%u_UA,3), UBOUND(InData%u_UA,3) - DO i2 = LBOUND(InData%u_UA,2), UBOUND(InData%u_UA,2) - DO i1 = LBOUND(InData%u_UA,1), UBOUND(InData%u_UA,1) - Int_BufSz = Int_BufSz + 3 ! u_UA: size of buffers for each call to pack subtype - CALL UA_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_UA(i1,i2,i3), ErrStat2, ErrMsg2, .TRUE. ) ! u_UA - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_UA - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_UA - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_UA - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - END DO - END IF - DO i1 = LBOUND(InData%u_DBEMT,1), UBOUND(InData%u_DBEMT,1) - Int_BufSz = Int_BufSz + 3 ! u_DBEMT: size of buffers for each call to pack subtype - CALL DBEMT_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_DBEMT(i1), ErrStat2, ErrMsg2, .TRUE. ) ! u_DBEMT - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_DBEMT - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_DBEMT - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_DBEMT - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%u_SkewWake,1), UBOUND(InData%u_SkewWake,1) - Int_BufSz = Int_BufSz + 3 ! u_SkewWake: size of buffers for each call to pack subtype - CALL BEMT_Packskewwake_inputtype( Re_Buf, Db_Buf, Int_Buf, InData%u_SkewWake(i1), ErrStat2, ErrMsg2, .TRUE. ) ! u_SkewWake - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_SkewWake - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_SkewWake - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_SkewWake - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - Int_BufSz = Int_BufSz + 1 ! TnInd_op allocated yes/no - IF ( ALLOCATED(InData%TnInd_op) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! TnInd_op upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TnInd_op) ! TnInd_op - END IF - Int_BufSz = Int_BufSz + 1 ! AxInd_op allocated yes/no - IF ( ALLOCATED(InData%AxInd_op) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! AxInd_op upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AxInd_op) ! AxInd_op - END IF - Int_BufSz = Int_BufSz + 1 ! AxInduction allocated yes/no - IF ( ALLOCATED(InData%AxInduction) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! AxInduction upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AxInduction) ! AxInduction - END IF - Int_BufSz = Int_BufSz + 1 ! TanInduction allocated yes/no - IF ( ALLOCATED(InData%TanInduction) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! TanInduction upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TanInduction) ! TanInduction - END IF - Int_BufSz = Int_BufSz + 1 ! UseFrozenWake - Int_BufSz = Int_BufSz + 1 ! Rtip allocated yes/no - IF ( ALLOCATED(InData%Rtip) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Rtip upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Rtip) ! Rtip - END IF - Int_BufSz = Int_BufSz + 1 ! phi allocated yes/no - IF ( ALLOCATED(InData%phi) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! phi upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%phi) ! phi - END IF - Int_BufSz = Int_BufSz + 1 ! chi allocated yes/no - IF ( ALLOCATED(InData%chi) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! chi upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%chi) ! chi - END IF - Int_BufSz = Int_BufSz + 1 ! ValidPhi allocated yes/no - IF ( ALLOCATED(InData%ValidPhi) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! ValidPhi upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%ValidPhi) ! ValidPhi - END IF - Re_BufSz = Re_BufSz + 1 ! BEM_weight - 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%FirstWarn_Skew, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%FirstWarn_Phi, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%FirstWarn_BEMoff, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - CALL UA_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%UA, ErrStat2, ErrMsg2, OnlySize ) ! UA - 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 DBEMT_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%DBEMT, ErrStat2, ErrMsg2, OnlySize ) ! DBEMT - 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 UA_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_UA, ErrStat2, ErrMsg2, OnlySize ) ! y_UA - 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%u_UA) ) THEN - 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_UA,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_UA,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%u_UA,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_UA,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%u_UA,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_UA,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%u_UA,3), UBOUND(InData%u_UA,3) - DO i2 = LBOUND(InData%u_UA,2), UBOUND(InData%u_UA,2) - DO i1 = LBOUND(InData%u_UA,1), UBOUND(InData%u_UA,1) - CALL UA_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_UA(i1,i2,i3), ErrStat2, ErrMsg2, OnlySize ) ! u_UA - 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 DO - END DO - END IF - DO i1 = LBOUND(InData%u_DBEMT,1), UBOUND(InData%u_DBEMT,1) - CALL DBEMT_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_DBEMT(i1), ErrStat2, ErrMsg2, OnlySize ) ! u_DBEMT - 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 - DO i1 = LBOUND(InData%u_SkewWake,1), UBOUND(InData%u_SkewWake,1) - CALL BEMT_Packskewwake_inputtype( Re_Buf, Db_Buf, Int_Buf, InData%u_SkewWake(i1), ErrStat2, ErrMsg2, OnlySize ) ! u_SkewWake - 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 - IF ( .NOT. ALLOCATED(InData%TnInd_op) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TnInd_op,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TnInd_op,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TnInd_op,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TnInd_op,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%TnInd_op,2), UBOUND(InData%TnInd_op,2) - DO i1 = LBOUND(InData%TnInd_op,1), UBOUND(InData%TnInd_op,1) - ReKiBuf(Re_Xferred) = InData%TnInd_op(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AxInd_op) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AxInd_op,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AxInd_op,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AxInd_op,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AxInd_op,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%AxInd_op,2), UBOUND(InData%AxInd_op,2) - DO i1 = LBOUND(InData%AxInd_op,1), UBOUND(InData%AxInd_op,1) - ReKiBuf(Re_Xferred) = InData%AxInd_op(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AxInduction) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AxInduction,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AxInduction,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AxInduction,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AxInduction,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%AxInduction,2), UBOUND(InData%AxInduction,2) - DO i1 = LBOUND(InData%AxInduction,1), UBOUND(InData%AxInduction,1) - ReKiBuf(Re_Xferred) = InData%AxInduction(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TanInduction) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TanInduction,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TanInduction,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TanInduction,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TanInduction,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%TanInduction,2), UBOUND(InData%TanInduction,2) - DO i1 = LBOUND(InData%TanInduction,1), UBOUND(InData%TanInduction,1) - ReKiBuf(Re_Xferred) = InData%TanInduction(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = TRANSFER(InData%UseFrozenWake, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%Rtip) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Rtip,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Rtip,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Rtip,1), UBOUND(InData%Rtip,1) - ReKiBuf(Re_Xferred) = InData%Rtip(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%phi) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%phi,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%phi,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%phi,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%phi,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%phi,2), UBOUND(InData%phi,2) - DO i1 = LBOUND(InData%phi,1), UBOUND(InData%phi,1) - ReKiBuf(Re_Xferred) = InData%phi(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%chi) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%chi,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%chi,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%chi,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%chi,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%chi,2), UBOUND(InData%chi,2) - DO i1 = LBOUND(InData%chi,1), UBOUND(InData%chi,1) - ReKiBuf(Re_Xferred) = InData%chi(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ValidPhi) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ValidPhi,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ValidPhi,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ValidPhi,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ValidPhi,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%ValidPhi,2), UBOUND(InData%ValidPhi,2) - DO i1 = LBOUND(InData%ValidPhi,1), UBOUND(InData%ValidPhi,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%ValidPhi(i1,i2), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - ReKiBuf(Re_Xferred) = InData%BEM_weight - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE BEMT_PackMisc - - SUBROUTINE BEMT_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(BEMT_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) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_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%FirstWarn_Skew = TRANSFER(IntKiBuf(Int_Xferred), OutData%FirstWarn_Skew) - Int_Xferred = Int_Xferred + 1 - OutData%FirstWarn_Phi = TRANSFER(IntKiBuf(Int_Xferred), OutData%FirstWarn_Phi) - Int_Xferred = Int_Xferred + 1 - OutData%FirstWarn_BEMoff = TRANSFER(IntKiBuf(Int_Xferred), OutData%FirstWarn_BEMoff) - 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 UA_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%UA, ErrStat2, ErrMsg2 ) ! UA - 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 DBEMT_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%DBEMT, ErrStat2, ErrMsg2 ) ! DBEMT - 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 UA_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y_UA, ErrStat2, ErrMsg2 ) ! y_UA - 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 ! u_UA not allocated - Int_Xferred = Int_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%u_UA)) DEALLOCATE(OutData%u_UA) - ALLOCATE(OutData%u_UA(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%u_UA.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%u_UA,3), UBOUND(OutData%u_UA,3) - DO i2 = LBOUND(OutData%u_UA,2), UBOUND(OutData%u_UA,2) - DO i1 = LBOUND(OutData%u_UA,1), UBOUND(OutData%u_UA,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 UA_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u_UA(i1,i2,i3), ErrStat2, ErrMsg2 ) ! u_UA - 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 DO - END DO - END IF - i1_l = LBOUND(OutData%u_DBEMT,1) - i1_u = UBOUND(OutData%u_DBEMT,1) - DO i1 = LBOUND(OutData%u_DBEMT,1), UBOUND(OutData%u_DBEMT,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 DBEMT_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u_DBEMT(i1), ErrStat2, ErrMsg2 ) ! u_DBEMT - 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 - i1_l = LBOUND(OutData%u_SkewWake,1) - i1_u = UBOUND(OutData%u_SkewWake,1) - DO i1 = LBOUND(OutData%u_SkewWake,1), UBOUND(OutData%u_SkewWake,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 BEMT_Unpackskewwake_inputtype( Re_Buf, Db_Buf, Int_Buf, OutData%u_SkewWake(i1), ErrStat2, ErrMsg2 ) ! u_SkewWake - 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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TnInd_op not allocated - Int_Xferred = Int_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%TnInd_op)) DEALLOCATE(OutData%TnInd_op) - ALLOCATE(OutData%TnInd_op(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TnInd_op.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%TnInd_op,2), UBOUND(OutData%TnInd_op,2) - DO i1 = LBOUND(OutData%TnInd_op,1), UBOUND(OutData%TnInd_op,1) - OutData%TnInd_op(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AxInd_op not allocated - Int_Xferred = Int_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%AxInd_op)) DEALLOCATE(OutData%AxInd_op) - ALLOCATE(OutData%AxInd_op(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AxInd_op.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%AxInd_op,2), UBOUND(OutData%AxInd_op,2) - DO i1 = LBOUND(OutData%AxInd_op,1), UBOUND(OutData%AxInd_op,1) - OutData%AxInd_op(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AxInduction not allocated - Int_Xferred = Int_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%AxInduction)) DEALLOCATE(OutData%AxInduction) - ALLOCATE(OutData%AxInduction(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AxInduction.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%AxInduction,2), UBOUND(OutData%AxInduction,2) - DO i1 = LBOUND(OutData%AxInduction,1), UBOUND(OutData%AxInduction,1) - OutData%AxInduction(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TanInduction not allocated - Int_Xferred = Int_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%TanInduction)) DEALLOCATE(OutData%TanInduction) - ALLOCATE(OutData%TanInduction(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TanInduction.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%TanInduction,2), UBOUND(OutData%TanInduction,2) - DO i1 = LBOUND(OutData%TanInduction,1), UBOUND(OutData%TanInduction,1) - OutData%TanInduction(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%UseFrozenWake = TRANSFER(IntKiBuf(Int_Xferred), OutData%UseFrozenWake) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Rtip not allocated - Int_Xferred = Int_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%Rtip)) DEALLOCATE(OutData%Rtip) - ALLOCATE(OutData%Rtip(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Rtip.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Rtip,1), UBOUND(OutData%Rtip,1) - OutData%Rtip(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! phi not allocated - Int_Xferred = Int_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%phi)) DEALLOCATE(OutData%phi) - ALLOCATE(OutData%phi(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%phi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%phi,2), UBOUND(OutData%phi,2) - DO i1 = LBOUND(OutData%phi,1), UBOUND(OutData%phi,1) - OutData%phi(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! chi not allocated - Int_Xferred = Int_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%chi)) DEALLOCATE(OutData%chi) - ALLOCATE(OutData%chi(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%chi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%chi,2), UBOUND(OutData%chi,2) - DO i1 = LBOUND(OutData%chi,1), UBOUND(OutData%chi,1) - OutData%chi(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ValidPhi not allocated - Int_Xferred = Int_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%ValidPhi)) DEALLOCATE(OutData%ValidPhi) - ALLOCATE(OutData%ValidPhi(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ValidPhi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%ValidPhi,2), UBOUND(OutData%ValidPhi,2) - DO i1 = LBOUND(OutData%ValidPhi,1), UBOUND(OutData%ValidPhi,1) - OutData%ValidPhi(i1,i2) = TRANSFER(IntKiBuf(Int_Xferred), OutData%ValidPhi(i1,i2)) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - OutData%BEM_weight = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE BEMT_UnPackMisc - - SUBROUTINE BEMT_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(BEMT_ParameterType), INTENT(IN) :: SrcParamData - TYPE(BEMT_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 = 'BEMT_CopyParam' -! + ErrMsg = '' + call UA_CopyContState(SrcContStateData%UA, DstContStateData%UA, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call DBEMT_CopyContState(SrcContStateData%DBEMT, DstContStateData%DBEMT, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstContStateData%V_w = SrcContStateData%V_w +end subroutine + +subroutine BEMT_DestroyContState(ContStateData, ErrStat, ErrMsg) + type(BEMT_ContinuousStateType), intent(inout) :: ContStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'BEMT_DestroyContState' ErrStat = ErrID_None - ErrMsg = "" - DstParamData%DT = SrcParamData%DT -IF (ALLOCATED(SrcParamData%chord)) THEN - i1_l = LBOUND(SrcParamData%chord,1) - i1_u = UBOUND(SrcParamData%chord,1) - i2_l = LBOUND(SrcParamData%chord,2) - i2_u = UBOUND(SrcParamData%chord,2) - IF (.NOT. ALLOCATED(DstParamData%chord)) THEN - ALLOCATE(DstParamData%chord(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%chord.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%chord = SrcParamData%chord -ENDIF - DstParamData%numBlades = SrcParamData%numBlades - DstParamData%airDens = SrcParamData%airDens - DstParamData%kinVisc = SrcParamData%kinVisc - DstParamData%skewWakeMod = SrcParamData%skewWakeMod - DstParamData%aTol = SrcParamData%aTol - DstParamData%useTipLoss = SrcParamData%useTipLoss - DstParamData%useHubLoss = SrcParamData%useHubLoss - DstParamData%useInduction = SrcParamData%useInduction - DstParamData%useTanInd = SrcParamData%useTanInd - DstParamData%useAIDrag = SrcParamData%useAIDrag - DstParamData%useTIDrag = SrcParamData%useTIDrag - DstParamData%numBladeNodes = SrcParamData%numBladeNodes - DstParamData%numReIterations = SrcParamData%numReIterations - DstParamData%maxIndIterations = SrcParamData%maxIndIterations -IF (ALLOCATED(SrcParamData%AFindx)) THEN - i1_l = LBOUND(SrcParamData%AFindx,1) - i1_u = UBOUND(SrcParamData%AFindx,1) - i2_l = LBOUND(SrcParamData%AFindx,2) - i2_u = UBOUND(SrcParamData%AFindx,2) - IF (.NOT. ALLOCATED(DstParamData%AFindx)) THEN - ALLOCATE(DstParamData%AFindx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AFindx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%AFindx = SrcParamData%AFindx -ENDIF -IF (ALLOCATED(SrcParamData%tipLossConst)) THEN - i1_l = LBOUND(SrcParamData%tipLossConst,1) - i1_u = UBOUND(SrcParamData%tipLossConst,1) - i2_l = LBOUND(SrcParamData%tipLossConst,2) - i2_u = UBOUND(SrcParamData%tipLossConst,2) - IF (.NOT. ALLOCATED(DstParamData%tipLossConst)) THEN - ALLOCATE(DstParamData%tipLossConst(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%tipLossConst.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%tipLossConst = SrcParamData%tipLossConst -ENDIF -IF (ALLOCATED(SrcParamData%hubLossConst)) THEN - i1_l = LBOUND(SrcParamData%hubLossConst,1) - i1_u = UBOUND(SrcParamData%hubLossConst,1) - i2_l = LBOUND(SrcParamData%hubLossConst,2) - i2_u = UBOUND(SrcParamData%hubLossConst,2) - IF (.NOT. ALLOCATED(DstParamData%hubLossConst)) THEN - ALLOCATE(DstParamData%hubLossConst(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%hubLossConst.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%hubLossConst = SrcParamData%hubLossConst -ENDIF -IF (ALLOCATED(SrcParamData%zHub)) THEN - i1_l = LBOUND(SrcParamData%zHub,1) - i1_u = UBOUND(SrcParamData%zHub,1) - IF (.NOT. ALLOCATED(DstParamData%zHub)) THEN - ALLOCATE(DstParamData%zHub(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%zHub.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%zHub = SrcParamData%zHub -ENDIF - CALL UA_CopyParam( SrcParamData%UA, DstParamData%UA, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL DBEMT_CopyParam( SrcParamData%DBEMT, DstParamData%DBEMT, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstParamData%UA_Flag = SrcParamData%UA_Flag - DstParamData%DBEMT_Mod = SrcParamData%DBEMT_Mod - DstParamData%yawCorrFactor = SrcParamData%yawCorrFactor -IF (ALLOCATED(SrcParamData%FixedInductions)) THEN - i1_l = LBOUND(SrcParamData%FixedInductions,1) - i1_u = UBOUND(SrcParamData%FixedInductions,1) - i2_l = LBOUND(SrcParamData%FixedInductions,2) - i2_u = UBOUND(SrcParamData%FixedInductions,2) - IF (.NOT. ALLOCATED(DstParamData%FixedInductions)) THEN - ALLOCATE(DstParamData%FixedInductions(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%FixedInductions.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%FixedInductions = SrcParamData%FixedInductions -ENDIF - DstParamData%MomentumCorr = SrcParamData%MomentumCorr - DstParamData%rTipFixMax = SrcParamData%rTipFixMax -IF (ALLOCATED(SrcParamData%IntegrateWeight)) THEN - i1_l = LBOUND(SrcParamData%IntegrateWeight,1) - i1_u = UBOUND(SrcParamData%IntegrateWeight,1) - i2_l = LBOUND(SrcParamData%IntegrateWeight,2) - i2_u = UBOUND(SrcParamData%IntegrateWeight,2) - IF (.NOT. ALLOCATED(DstParamData%IntegrateWeight)) THEN - ALLOCATE(DstParamData%IntegrateWeight(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IntegrateWeight.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%IntegrateWeight = SrcParamData%IntegrateWeight -ENDIF - DstParamData%lin_nx = SrcParamData%lin_nx - DstParamData%BEM_Mod = SrcParamData%BEM_Mod - END SUBROUTINE BEMT_CopyParam - - SUBROUTINE BEMT_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(BEMT_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(ParamData%chord)) THEN - DEALLOCATE(ParamData%chord) -ENDIF -IF (ALLOCATED(ParamData%AFindx)) THEN - DEALLOCATE(ParamData%AFindx) -ENDIF -IF (ALLOCATED(ParamData%tipLossConst)) THEN - DEALLOCATE(ParamData%tipLossConst) -ENDIF -IF (ALLOCATED(ParamData%hubLossConst)) THEN - DEALLOCATE(ParamData%hubLossConst) -ENDIF -IF (ALLOCATED(ParamData%zHub)) THEN - DEALLOCATE(ParamData%zHub) -ENDIF - CALL UA_DestroyParam( ParamData%UA, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL DBEMT_DestroyParam( ParamData%DBEMT, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(ParamData%FixedInductions)) THEN - DEALLOCATE(ParamData%FixedInductions) -ENDIF -IF (ALLOCATED(ParamData%IntegrateWeight)) THEN - DEALLOCATE(ParamData%IntegrateWeight) -ENDIF - END SUBROUTINE BEMT_DestroyParam - - SUBROUTINE BEMT_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(BEMT_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 = 'BEMT_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 ! chord allocated yes/no - IF ( ALLOCATED(InData%chord) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! chord upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%chord) ! chord - END IF - Int_BufSz = Int_BufSz + 1 ! numBlades - Re_BufSz = Re_BufSz + 1 ! airDens - Re_BufSz = Re_BufSz + 1 ! kinVisc - Int_BufSz = Int_BufSz + 1 ! skewWakeMod - Re_BufSz = Re_BufSz + 1 ! aTol - Int_BufSz = Int_BufSz + 1 ! useTipLoss - Int_BufSz = Int_BufSz + 1 ! useHubLoss - Int_BufSz = Int_BufSz + 1 ! useInduction - Int_BufSz = Int_BufSz + 1 ! useTanInd - Int_BufSz = Int_BufSz + 1 ! useAIDrag - Int_BufSz = Int_BufSz + 1 ! useTIDrag - Int_BufSz = Int_BufSz + 1 ! numBladeNodes - Int_BufSz = Int_BufSz + 1 ! numReIterations - Int_BufSz = Int_BufSz + 1 ! maxIndIterations - Int_BufSz = Int_BufSz + 1 ! AFindx allocated yes/no - IF ( ALLOCATED(InData%AFindx) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! AFindx upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%AFindx) ! AFindx - END IF - Int_BufSz = Int_BufSz + 1 ! tipLossConst allocated yes/no - IF ( ALLOCATED(InData%tipLossConst) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! tipLossConst upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%tipLossConst) ! tipLossConst - END IF - Int_BufSz = Int_BufSz + 1 ! hubLossConst allocated yes/no - IF ( ALLOCATED(InData%hubLossConst) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! hubLossConst upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%hubLossConst) ! hubLossConst - END IF - Int_BufSz = Int_BufSz + 1 ! zHub allocated yes/no - IF ( ALLOCATED(InData%zHub) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! zHub upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%zHub) ! zHub - END IF - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! UA: size of buffers for each call to pack subtype - CALL UA_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%UA, ErrStat2, ErrMsg2, .TRUE. ) ! UA - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! UA - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! UA - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! UA - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! DBEMT: size of buffers for each call to pack subtype - CALL DBEMT_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%DBEMT, ErrStat2, ErrMsg2, .TRUE. ) ! DBEMT - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! DBEMT - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! DBEMT - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! DBEMT - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! UA_Flag - Int_BufSz = Int_BufSz + 1 ! DBEMT_Mod - Re_BufSz = Re_BufSz + 1 ! yawCorrFactor - Int_BufSz = Int_BufSz + 1 ! FixedInductions allocated yes/no - IF ( ALLOCATED(InData%FixedInductions) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! FixedInductions upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%FixedInductions) ! FixedInductions - END IF - Int_BufSz = Int_BufSz + 1 ! MomentumCorr - Re_BufSz = Re_BufSz + 1 ! rTipFixMax - Int_BufSz = Int_BufSz + 1 ! IntegrateWeight allocated yes/no - IF ( ALLOCATED(InData%IntegrateWeight) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! IntegrateWeight upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%IntegrateWeight) ! IntegrateWeight - END IF - Int_BufSz = Int_BufSz + 1 ! lin_nx - Int_BufSz = Int_BufSz + 1 ! BEM_Mod - 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 - IF ( .NOT. ALLOCATED(InData%chord) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%chord,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%chord,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%chord,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%chord,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%chord,2), UBOUND(InData%chord,2) - DO i1 = LBOUND(InData%chord,1), UBOUND(InData%chord,1) - ReKiBuf(Re_Xferred) = InData%chord(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%numBlades - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%airDens - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%kinVisc - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%skewWakeMod - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%aTol - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%useTipLoss, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%useHubLoss, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%useInduction, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%useTanInd, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%useAIDrag, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%useTIDrag, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%numBladeNodes - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%numReIterations - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%maxIndIterations - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%AFindx) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AFindx,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AFindx,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AFindx,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AFindx,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%AFindx,2), UBOUND(InData%AFindx,2) - DO i1 = LBOUND(InData%AFindx,1), UBOUND(InData%AFindx,1) - IntKiBuf(Int_Xferred) = InData%AFindx(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%tipLossConst) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%tipLossConst,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%tipLossConst,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%tipLossConst,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%tipLossConst,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%tipLossConst,2), UBOUND(InData%tipLossConst,2) - DO i1 = LBOUND(InData%tipLossConst,1), UBOUND(InData%tipLossConst,1) - ReKiBuf(Re_Xferred) = InData%tipLossConst(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%hubLossConst) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%hubLossConst,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%hubLossConst,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%hubLossConst,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%hubLossConst,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%hubLossConst,2), UBOUND(InData%hubLossConst,2) - DO i1 = LBOUND(InData%hubLossConst,1), UBOUND(InData%hubLossConst,1) - ReKiBuf(Re_Xferred) = InData%hubLossConst(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%zHub) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%zHub,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%zHub,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%zHub,1), UBOUND(InData%zHub,1) - ReKiBuf(Re_Xferred) = InData%zHub(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - CALL UA_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%UA, ErrStat2, ErrMsg2, OnlySize ) ! UA - 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 DBEMT_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%DBEMT, ErrStat2, ErrMsg2, OnlySize ) ! DBEMT - 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%UA_Flag, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%DBEMT_Mod - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%yawCorrFactor - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%FixedInductions) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FixedInductions,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FixedInductions,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FixedInductions,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FixedInductions,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%FixedInductions,2), UBOUND(InData%FixedInductions,2) - DO i1 = LBOUND(InData%FixedInductions,1), UBOUND(InData%FixedInductions,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%FixedInductions(i1,i2), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = TRANSFER(InData%MomentumCorr, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%rTipFixMax - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%IntegrateWeight) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%IntegrateWeight,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IntegrateWeight,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%IntegrateWeight,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IntegrateWeight,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%IntegrateWeight,2), UBOUND(InData%IntegrateWeight,2) - DO i1 = LBOUND(InData%IntegrateWeight,1), UBOUND(InData%IntegrateWeight,1) - ReKiBuf(Re_Xferred) = InData%IntegrateWeight(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%lin_nx - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%BEM_Mod - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE BEMT_PackParam - - SUBROUTINE BEMT_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(BEMT_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 = 'BEMT_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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! chord not allocated - Int_Xferred = Int_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%chord)) DEALLOCATE(OutData%chord) - ALLOCATE(OutData%chord(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%chord.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%chord,2), UBOUND(OutData%chord,2) - DO i1 = LBOUND(OutData%chord,1), UBOUND(OutData%chord,1) - OutData%chord(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%numBlades = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%airDens = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%kinVisc = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%skewWakeMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%aTol = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%useTipLoss = TRANSFER(IntKiBuf(Int_Xferred), OutData%useTipLoss) - Int_Xferred = Int_Xferred + 1 - OutData%useHubLoss = TRANSFER(IntKiBuf(Int_Xferred), OutData%useHubLoss) - Int_Xferred = Int_Xferred + 1 - OutData%useInduction = TRANSFER(IntKiBuf(Int_Xferred), OutData%useInduction) - Int_Xferred = Int_Xferred + 1 - OutData%useTanInd = TRANSFER(IntKiBuf(Int_Xferred), OutData%useTanInd) - Int_Xferred = Int_Xferred + 1 - OutData%useAIDrag = TRANSFER(IntKiBuf(Int_Xferred), OutData%useAIDrag) - Int_Xferred = Int_Xferred + 1 - OutData%useTIDrag = TRANSFER(IntKiBuf(Int_Xferred), OutData%useTIDrag) - Int_Xferred = Int_Xferred + 1 - OutData%numBladeNodes = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%numReIterations = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%maxIndIterations = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AFindx not allocated - Int_Xferred = Int_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%AFindx)) DEALLOCATE(OutData%AFindx) - ALLOCATE(OutData%AFindx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AFindx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%AFindx,2), UBOUND(OutData%AFindx,2) - DO i1 = LBOUND(OutData%AFindx,1), UBOUND(OutData%AFindx,1) - OutData%AFindx(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! tipLossConst not allocated - Int_Xferred = Int_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%tipLossConst)) DEALLOCATE(OutData%tipLossConst) - ALLOCATE(OutData%tipLossConst(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%tipLossConst.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%tipLossConst,2), UBOUND(OutData%tipLossConst,2) - DO i1 = LBOUND(OutData%tipLossConst,1), UBOUND(OutData%tipLossConst,1) - OutData%tipLossConst(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! hubLossConst not allocated - Int_Xferred = Int_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%hubLossConst)) DEALLOCATE(OutData%hubLossConst) - ALLOCATE(OutData%hubLossConst(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%hubLossConst.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%hubLossConst,2), UBOUND(OutData%hubLossConst,2) - DO i1 = LBOUND(OutData%hubLossConst,1), UBOUND(OutData%hubLossConst,1) - OutData%hubLossConst(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! zHub not allocated - Int_Xferred = Int_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%zHub)) DEALLOCATE(OutData%zHub) - ALLOCATE(OutData%zHub(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%zHub.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%zHub,1), UBOUND(OutData%zHub,1) - OutData%zHub(i1) = ReKiBuf(Re_Xferred) - 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 UA_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%UA, ErrStat2, ErrMsg2 ) ! UA - 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 DBEMT_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%DBEMT, ErrStat2, ErrMsg2 ) ! DBEMT - 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%UA_Flag = TRANSFER(IntKiBuf(Int_Xferred), OutData%UA_Flag) - Int_Xferred = Int_Xferred + 1 - OutData%DBEMT_Mod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%yawCorrFactor = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FixedInductions not allocated - Int_Xferred = Int_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%FixedInductions)) DEALLOCATE(OutData%FixedInductions) - ALLOCATE(OutData%FixedInductions(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FixedInductions.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%FixedInductions,2), UBOUND(OutData%FixedInductions,2) - DO i1 = LBOUND(OutData%FixedInductions,1), UBOUND(OutData%FixedInductions,1) - OutData%FixedInductions(i1,i2) = TRANSFER(IntKiBuf(Int_Xferred), OutData%FixedInductions(i1,i2)) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - OutData%MomentumCorr = TRANSFER(IntKiBuf(Int_Xferred), OutData%MomentumCorr) - Int_Xferred = Int_Xferred + 1 - OutData%rTipFixMax = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IntegrateWeight not allocated - Int_Xferred = Int_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%IntegrateWeight)) DEALLOCATE(OutData%IntegrateWeight) - ALLOCATE(OutData%IntegrateWeight(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IntegrateWeight.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%IntegrateWeight,2), UBOUND(OutData%IntegrateWeight,2) - DO i1 = LBOUND(OutData%IntegrateWeight,1), UBOUND(OutData%IntegrateWeight,1) - OutData%IntegrateWeight(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%lin_nx = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%BEM_Mod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE BEMT_UnPackParam - - SUBROUTINE BEMT_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(BEMT_InputType), INTENT(IN) :: SrcInputData - TYPE(BEMT_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 = 'BEMT_CopyInput' -! + ErrMsg = '' + call UA_DestroyContState(ContStateData%UA, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call DBEMT_DestroyContState(ContStateData%DBEMT, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine BEMT_PackContState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(BEMT_ContinuousStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'BEMT_PackContState' + if (RF%ErrStat >= AbortErrLev) return + call UA_PackContState(RF, InData%UA) + call DBEMT_PackContState(RF, InData%DBEMT) + call RegPack(RF, InData%V_w) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine BEMT_UnPackContState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(BEMT_ContinuousStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'BEMT_UnPackContState' + if (RF%ErrStat /= ErrID_None) return + call UA_UnpackContState(RF, OutData%UA) ! UA + call DBEMT_UnpackContState(RF, OutData%DBEMT) ! DBEMT + call RegUnpack(RF, OutData%V_w); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine BEMT_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) + type(BEMT_DiscreteStateType), intent(in) :: SrcDiscStateData + type(BEMT_DiscreteStateType), intent(inout) :: DstDiscStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'BEMT_CopyDiscState' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcInputData%theta)) THEN - i1_l = LBOUND(SrcInputData%theta,1) - i1_u = UBOUND(SrcInputData%theta,1) - i2_l = LBOUND(SrcInputData%theta,2) - i2_u = UBOUND(SrcInputData%theta,2) - IF (.NOT. ALLOCATED(DstInputData%theta)) THEN - ALLOCATE(DstInputData%theta(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%theta.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%theta = SrcInputData%theta -ENDIF - DstInputData%chi0 = SrcInputData%chi0 - DstInputData%psiSkewOffset = SrcInputData%psiSkewOffset -IF (ALLOCATED(SrcInputData%psi_s)) THEN - i1_l = LBOUND(SrcInputData%psi_s,1) - i1_u = UBOUND(SrcInputData%psi_s,1) - IF (.NOT. ALLOCATED(DstInputData%psi_s)) THEN - ALLOCATE(DstInputData%psi_s(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%psi_s.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%psi_s = SrcInputData%psi_s -ENDIF - DstInputData%omega = SrcInputData%omega - DstInputData%TSR = SrcInputData%TSR -IF (ALLOCATED(SrcInputData%Vx)) THEN - i1_l = LBOUND(SrcInputData%Vx,1) - i1_u = UBOUND(SrcInputData%Vx,1) - i2_l = LBOUND(SrcInputData%Vx,2) - i2_u = UBOUND(SrcInputData%Vx,2) - IF (.NOT. ALLOCATED(DstInputData%Vx)) THEN - ALLOCATE(DstInputData%Vx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%Vx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%Vx = SrcInputData%Vx -ENDIF -IF (ALLOCATED(SrcInputData%Vy)) THEN - i1_l = LBOUND(SrcInputData%Vy,1) - i1_u = UBOUND(SrcInputData%Vy,1) - i2_l = LBOUND(SrcInputData%Vy,2) - i2_u = UBOUND(SrcInputData%Vy,2) - IF (.NOT. ALLOCATED(DstInputData%Vy)) THEN - ALLOCATE(DstInputData%Vy(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%Vy.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%Vy = SrcInputData%Vy -ENDIF -IF (ALLOCATED(SrcInputData%Vz)) THEN - i1_l = LBOUND(SrcInputData%Vz,1) - i1_u = UBOUND(SrcInputData%Vz,1) - i2_l = LBOUND(SrcInputData%Vz,2) - i2_u = UBOUND(SrcInputData%Vz,2) - IF (.NOT. ALLOCATED(DstInputData%Vz)) THEN - ALLOCATE(DstInputData%Vz(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%Vz.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%Vz = SrcInputData%Vz -ENDIF -IF (ALLOCATED(SrcInputData%omega_z)) THEN - i1_l = LBOUND(SrcInputData%omega_z,1) - i1_u = UBOUND(SrcInputData%omega_z,1) - i2_l = LBOUND(SrcInputData%omega_z,2) - i2_u = UBOUND(SrcInputData%omega_z,2) - IF (.NOT. ALLOCATED(DstInputData%omega_z)) THEN - ALLOCATE(DstInputData%omega_z(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%omega_z.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%omega_z = SrcInputData%omega_z -ENDIF -IF (ALLOCATED(SrcInputData%xVelCorr)) THEN - i1_l = LBOUND(SrcInputData%xVelCorr,1) - i1_u = UBOUND(SrcInputData%xVelCorr,1) - i2_l = LBOUND(SrcInputData%xVelCorr,2) - i2_u = UBOUND(SrcInputData%xVelCorr,2) - IF (.NOT. ALLOCATED(DstInputData%xVelCorr)) THEN - ALLOCATE(DstInputData%xVelCorr(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%xVelCorr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%xVelCorr = SrcInputData%xVelCorr -ENDIF -IF (ALLOCATED(SrcInputData%rLocal)) THEN - i1_l = LBOUND(SrcInputData%rLocal,1) - i1_u = UBOUND(SrcInputData%rLocal,1) - i2_l = LBOUND(SrcInputData%rLocal,2) - i2_u = UBOUND(SrcInputData%rLocal,2) - IF (.NOT. ALLOCATED(DstInputData%rLocal)) THEN - ALLOCATE(DstInputData%rLocal(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%rLocal.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%rLocal = SrcInputData%rLocal -ENDIF - DstInputData%Un_disk = SrcInputData%Un_disk - DstInputData%V0 = SrcInputData%V0 - DstInputData%x_hat_disk = SrcInputData%x_hat_disk -IF (ALLOCATED(SrcInputData%UserProp)) THEN - i1_l = LBOUND(SrcInputData%UserProp,1) - i1_u = UBOUND(SrcInputData%UserProp,1) - i2_l = LBOUND(SrcInputData%UserProp,2) - i2_u = UBOUND(SrcInputData%UserProp,2) - IF (.NOT. ALLOCATED(DstInputData%UserProp)) THEN - ALLOCATE(DstInputData%UserProp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%UserProp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%UserProp = SrcInputData%UserProp -ENDIF -IF (ALLOCATED(SrcInputData%CantAngle)) THEN - i1_l = LBOUND(SrcInputData%CantAngle,1) - i1_u = UBOUND(SrcInputData%CantAngle,1) - i2_l = LBOUND(SrcInputData%CantAngle,2) - i2_u = UBOUND(SrcInputData%CantAngle,2) - IF (.NOT. ALLOCATED(DstInputData%CantAngle)) THEN - ALLOCATE(DstInputData%CantAngle(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%CantAngle.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%CantAngle = SrcInputData%CantAngle -ENDIF -IF (ALLOCATED(SrcInputData%drdz)) THEN - i1_l = LBOUND(SrcInputData%drdz,1) - i1_u = UBOUND(SrcInputData%drdz,1) - i2_l = LBOUND(SrcInputData%drdz,2) - i2_u = UBOUND(SrcInputData%drdz,2) - IF (.NOT. ALLOCATED(DstInputData%drdz)) THEN - ALLOCATE(DstInputData%drdz(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%drdz.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%drdz = SrcInputData%drdz -ENDIF -IF (ALLOCATED(SrcInputData%toeAngle)) THEN - i1_l = LBOUND(SrcInputData%toeAngle,1) - i1_u = UBOUND(SrcInputData%toeAngle,1) - i2_l = LBOUND(SrcInputData%toeAngle,2) - i2_u = UBOUND(SrcInputData%toeAngle,2) - IF (.NOT. ALLOCATED(DstInputData%toeAngle)) THEN - ALLOCATE(DstInputData%toeAngle(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%toeAngle.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%toeAngle = SrcInputData%toeAngle -ENDIF - END SUBROUTINE BEMT_CopyInput - - SUBROUTINE BEMT_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(BEMT_InputType), INTENT(INOUT) :: InputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_DestroyInput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(InputData%theta)) THEN - DEALLOCATE(InputData%theta) -ENDIF -IF (ALLOCATED(InputData%psi_s)) THEN - DEALLOCATE(InputData%psi_s) -ENDIF -IF (ALLOCATED(InputData%Vx)) THEN - DEALLOCATE(InputData%Vx) -ENDIF -IF (ALLOCATED(InputData%Vy)) THEN - DEALLOCATE(InputData%Vy) -ENDIF -IF (ALLOCATED(InputData%Vz)) THEN - DEALLOCATE(InputData%Vz) -ENDIF -IF (ALLOCATED(InputData%omega_z)) THEN - DEALLOCATE(InputData%omega_z) -ENDIF -IF (ALLOCATED(InputData%xVelCorr)) THEN - DEALLOCATE(InputData%xVelCorr) -ENDIF -IF (ALLOCATED(InputData%rLocal)) THEN - DEALLOCATE(InputData%rLocal) -ENDIF -IF (ALLOCATED(InputData%UserProp)) THEN - DEALLOCATE(InputData%UserProp) -ENDIF -IF (ALLOCATED(InputData%CantAngle)) THEN - DEALLOCATE(InputData%CantAngle) -ENDIF -IF (ALLOCATED(InputData%drdz)) THEN - DEALLOCATE(InputData%drdz) -ENDIF -IF (ALLOCATED(InputData%toeAngle)) THEN - DEALLOCATE(InputData%toeAngle) -ENDIF - END SUBROUTINE BEMT_DestroyInput - - SUBROUTINE BEMT_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(BEMT_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 = 'BEMT_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 ! theta allocated yes/no - IF ( ALLOCATED(InData%theta) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! theta upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%theta) ! theta - END IF - Re_BufSz = Re_BufSz + 1 ! chi0 - Re_BufSz = Re_BufSz + 1 ! psiSkewOffset - Int_BufSz = Int_BufSz + 1 ! psi_s allocated yes/no - IF ( ALLOCATED(InData%psi_s) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! psi_s upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%psi_s) ! psi_s - END IF - Re_BufSz = Re_BufSz + 1 ! omega - Re_BufSz = Re_BufSz + 1 ! TSR - Int_BufSz = Int_BufSz + 1 ! Vx allocated yes/no - IF ( ALLOCATED(InData%Vx) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Vx upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vx) ! Vx - END IF - Int_BufSz = Int_BufSz + 1 ! Vy allocated yes/no - IF ( ALLOCATED(InData%Vy) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Vy upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vy) ! Vy - END IF - Int_BufSz = Int_BufSz + 1 ! Vz allocated yes/no - IF ( ALLOCATED(InData%Vz) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Vz upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vz) ! Vz - END IF - Int_BufSz = Int_BufSz + 1 ! omega_z allocated yes/no - IF ( ALLOCATED(InData%omega_z) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! omega_z upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%omega_z) ! omega_z - END IF - Int_BufSz = Int_BufSz + 1 ! xVelCorr allocated yes/no - IF ( ALLOCATED(InData%xVelCorr) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! xVelCorr upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%xVelCorr) ! xVelCorr - END IF - Int_BufSz = Int_BufSz + 1 ! rLocal allocated yes/no - IF ( ALLOCATED(InData%rLocal) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! rLocal upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%rLocal) ! rLocal - END IF - Re_BufSz = Re_BufSz + 1 ! Un_disk - Re_BufSz = Re_BufSz + SIZE(InData%V0) ! V0 - Db_BufSz = Db_BufSz + SIZE(InData%x_hat_disk) ! x_hat_disk - Int_BufSz = Int_BufSz + 1 ! UserProp allocated yes/no - IF ( ALLOCATED(InData%UserProp) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! UserProp upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%UserProp) ! UserProp - END IF - Int_BufSz = Int_BufSz + 1 ! CantAngle allocated yes/no - IF ( ALLOCATED(InData%CantAngle) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! CantAngle upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CantAngle) ! CantAngle - END IF - Int_BufSz = Int_BufSz + 1 ! drdz allocated yes/no - IF ( ALLOCATED(InData%drdz) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! drdz upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%drdz) ! drdz - END IF - Int_BufSz = Int_BufSz + 1 ! toeAngle allocated yes/no - IF ( ALLOCATED(InData%toeAngle) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! toeAngle upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%toeAngle) ! toeAngle - 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%theta) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%theta,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%theta,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%theta,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%theta,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%theta,2), UBOUND(InData%theta,2) - DO i1 = LBOUND(InData%theta,1), UBOUND(InData%theta,1) - ReKiBuf(Re_Xferred) = InData%theta(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - ReKiBuf(Re_Xferred) = InData%chi0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%psiSkewOffset - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%psi_s) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%psi_s,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%psi_s,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%psi_s,1), UBOUND(InData%psi_s,1) - ReKiBuf(Re_Xferred) = InData%psi_s(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%omega - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TSR - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%Vx) ) THEN - 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,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vx,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vx,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vx,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Vx,2), UBOUND(InData%Vx,2) - DO i1 = LBOUND(InData%Vx,1), UBOUND(InData%Vx,1) - ReKiBuf(Re_Xferred) = InData%Vx(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Vy) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vy,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vy,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vy,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vy,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Vy,2), UBOUND(InData%Vy,2) - DO i1 = LBOUND(InData%Vy,1), UBOUND(InData%Vy,1) - ReKiBuf(Re_Xferred) = InData%Vy(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Vz) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vz,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vz,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vz,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vz,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Vz,2), UBOUND(InData%Vz,2) - DO i1 = LBOUND(InData%Vz,1), UBOUND(InData%Vz,1) - ReKiBuf(Re_Xferred) = InData%Vz(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%omega_z) ) THEN - 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_z,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%omega_z,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%omega_z,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%omega_z,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%omega_z,2), UBOUND(InData%omega_z,2) - DO i1 = LBOUND(InData%omega_z,1), UBOUND(InData%omega_z,1) - ReKiBuf(Re_Xferred) = InData%omega_z(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%xVelCorr) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%xVelCorr,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xVelCorr,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%xVelCorr,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xVelCorr,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%xVelCorr,2), UBOUND(InData%xVelCorr,2) - DO i1 = LBOUND(InData%xVelCorr,1), UBOUND(InData%xVelCorr,1) - ReKiBuf(Re_Xferred) = InData%xVelCorr(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%rLocal) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rLocal,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rLocal,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rLocal,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rLocal,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%rLocal,2), UBOUND(InData%rLocal,2) - DO i1 = LBOUND(InData%rLocal,1), UBOUND(InData%rLocal,1) - ReKiBuf(Re_Xferred) = InData%rLocal(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - ReKiBuf(Re_Xferred) = InData%Un_disk - Re_Xferred = Re_Xferred + 1 - DO i1 = LBOUND(InData%V0,1), UBOUND(InData%V0,1) - ReKiBuf(Re_Xferred) = InData%V0(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%x_hat_disk,1), UBOUND(InData%x_hat_disk,1) - DbKiBuf(Db_Xferred) = InData%x_hat_disk(i1) - Db_Xferred = Db_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%UserProp) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%UserProp,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UserProp,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%UserProp,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UserProp,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%UserProp,2), UBOUND(InData%UserProp,2) - DO i1 = LBOUND(InData%UserProp,1), UBOUND(InData%UserProp,1) - ReKiBuf(Re_Xferred) = InData%UserProp(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CantAngle) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CantAngle,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CantAngle,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CantAngle,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CantAngle,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%CantAngle,2), UBOUND(InData%CantAngle,2) - DO i1 = LBOUND(InData%CantAngle,1), UBOUND(InData%CantAngle,1) - ReKiBuf(Re_Xferred) = InData%CantAngle(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%drdz) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%drdz,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%drdz,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%drdz,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%drdz,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%drdz,2), UBOUND(InData%drdz,2) - DO i1 = LBOUND(InData%drdz,1), UBOUND(InData%drdz,1) - ReKiBuf(Re_Xferred) = InData%drdz(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%toeAngle) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%toeAngle,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%toeAngle,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%toeAngle,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%toeAngle,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%toeAngle,2), UBOUND(InData%toeAngle,2) - DO i1 = LBOUND(InData%toeAngle,1), UBOUND(InData%toeAngle,1) - ReKiBuf(Re_Xferred) = InData%toeAngle(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE BEMT_PackInput - - SUBROUTINE BEMT_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(BEMT_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 = 'BEMT_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 ! theta not allocated - Int_Xferred = Int_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%theta)) DEALLOCATE(OutData%theta) - ALLOCATE(OutData%theta(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%theta.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%theta,2), UBOUND(OutData%theta,2) - DO i1 = LBOUND(OutData%theta,1), UBOUND(OutData%theta,1) - OutData%theta(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%chi0 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%psiSkewOffset = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! psi_s not allocated - Int_Xferred = Int_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%psi_s)) DEALLOCATE(OutData%psi_s) - ALLOCATE(OutData%psi_s(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%psi_s.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%psi_s,1), UBOUND(OutData%psi_s,1) - OutData%psi_s(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%omega = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TSR = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vx not allocated - Int_Xferred = Int_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)) DEALLOCATE(OutData%Vx) - ALLOCATE(OutData%Vx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Vx,2), UBOUND(OutData%Vx,2) - DO i1 = LBOUND(OutData%Vx,1), UBOUND(OutData%Vx,1) - OutData%Vx(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vy not allocated - Int_Xferred = Int_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%Vy)) DEALLOCATE(OutData%Vy) - ALLOCATE(OutData%Vy(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vy.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Vy,2), UBOUND(OutData%Vy,2) - DO i1 = LBOUND(OutData%Vy,1), UBOUND(OutData%Vy,1) - OutData%Vy(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vz not allocated - Int_Xferred = Int_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%Vz)) DEALLOCATE(OutData%Vz) - ALLOCATE(OutData%Vz(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vz.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Vz,2), UBOUND(OutData%Vz,2) - DO i1 = LBOUND(OutData%Vz,1), UBOUND(OutData%Vz,1) - OutData%Vz(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! omega_z not allocated - Int_Xferred = Int_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_z)) DEALLOCATE(OutData%omega_z) - ALLOCATE(OutData%omega_z(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%omega_z.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%omega_z,2), UBOUND(OutData%omega_z,2) - DO i1 = LBOUND(OutData%omega_z,1), UBOUND(OutData%omega_z,1) - OutData%omega_z(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! xVelCorr not allocated - Int_Xferred = Int_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%xVelCorr)) DEALLOCATE(OutData%xVelCorr) - ALLOCATE(OutData%xVelCorr(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xVelCorr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%xVelCorr,2), UBOUND(OutData%xVelCorr,2) - DO i1 = LBOUND(OutData%xVelCorr,1), UBOUND(OutData%xVelCorr,1) - OutData%xVelCorr(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rLocal not allocated - Int_Xferred = Int_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%rLocal)) DEALLOCATE(OutData%rLocal) - ALLOCATE(OutData%rLocal(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rLocal.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%rLocal,2), UBOUND(OutData%rLocal,2) - DO i1 = LBOUND(OutData%rLocal,1), UBOUND(OutData%rLocal,1) - OutData%rLocal(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%Un_disk = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%V0,1) - i1_u = UBOUND(OutData%V0,1) - DO i1 = LBOUND(OutData%V0,1), UBOUND(OutData%V0,1) - OutData%V0(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%x_hat_disk,1) - i1_u = UBOUND(OutData%x_hat_disk,1) - DO i1 = LBOUND(OutData%x_hat_disk,1), UBOUND(OutData%x_hat_disk,1) - OutData%x_hat_disk(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! UserProp not allocated - Int_Xferred = Int_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%UserProp)) DEALLOCATE(OutData%UserProp) - ALLOCATE(OutData%UserProp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%UserProp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%UserProp,2), UBOUND(OutData%UserProp,2) - DO i1 = LBOUND(OutData%UserProp,1), UBOUND(OutData%UserProp,1) - OutData%UserProp(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CantAngle not allocated - Int_Xferred = Int_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%CantAngle)) DEALLOCATE(OutData%CantAngle) - ALLOCATE(OutData%CantAngle(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CantAngle.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%CantAngle,2), UBOUND(OutData%CantAngle,2) - DO i1 = LBOUND(OutData%CantAngle,1), UBOUND(OutData%CantAngle,1) - OutData%CantAngle(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! drdz not allocated - Int_Xferred = Int_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%drdz)) DEALLOCATE(OutData%drdz) - ALLOCATE(OutData%drdz(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%drdz.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%drdz,2), UBOUND(OutData%drdz,2) - DO i1 = LBOUND(OutData%drdz,1), UBOUND(OutData%drdz,1) - OutData%drdz(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! toeAngle not allocated - Int_Xferred = Int_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%toeAngle)) DEALLOCATE(OutData%toeAngle) - ALLOCATE(OutData%toeAngle(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%toeAngle.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%toeAngle,2), UBOUND(OutData%toeAngle,2) - DO i1 = LBOUND(OutData%toeAngle,1), UBOUND(OutData%toeAngle,1) - OutData%toeAngle(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE BEMT_UnPackInput - - SUBROUTINE BEMT_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(BEMT_OutputType), INTENT(IN) :: SrcOutputData - TYPE(BEMT_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 = 'BEMT_CopyOutput' -! + ErrMsg = '' + call UA_CopyDiscState(SrcDiscStateData%UA, DstDiscStateData%UA, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine BEMT_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) + type(BEMT_DiscreteStateType), intent(inout) :: DiscStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'BEMT_DestroyDiscState' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcOutputData%Vrel)) THEN - i1_l = LBOUND(SrcOutputData%Vrel,1) - i1_u = UBOUND(SrcOutputData%Vrel,1) - i2_l = LBOUND(SrcOutputData%Vrel,2) - i2_u = UBOUND(SrcOutputData%Vrel,2) - IF (.NOT. ALLOCATED(DstOutputData%Vrel)) THEN - ALLOCATE(DstOutputData%Vrel(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Vrel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%Vrel = SrcOutputData%Vrel -ENDIF -IF (ALLOCATED(SrcOutputData%phi)) THEN - i1_l = LBOUND(SrcOutputData%phi,1) - i1_u = UBOUND(SrcOutputData%phi,1) - i2_l = LBOUND(SrcOutputData%phi,2) - i2_u = UBOUND(SrcOutputData%phi,2) - IF (.NOT. ALLOCATED(DstOutputData%phi)) THEN - ALLOCATE(DstOutputData%phi(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%phi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%phi = SrcOutputData%phi -ENDIF -IF (ALLOCATED(SrcOutputData%axInduction)) THEN - i1_l = LBOUND(SrcOutputData%axInduction,1) - i1_u = UBOUND(SrcOutputData%axInduction,1) - i2_l = LBOUND(SrcOutputData%axInduction,2) - i2_u = UBOUND(SrcOutputData%axInduction,2) - IF (.NOT. ALLOCATED(DstOutputData%axInduction)) THEN - ALLOCATE(DstOutputData%axInduction(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%axInduction.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%axInduction = SrcOutputData%axInduction -ENDIF -IF (ALLOCATED(SrcOutputData%tanInduction)) THEN - i1_l = LBOUND(SrcOutputData%tanInduction,1) - i1_u = UBOUND(SrcOutputData%tanInduction,1) - i2_l = LBOUND(SrcOutputData%tanInduction,2) - i2_u = UBOUND(SrcOutputData%tanInduction,2) - IF (.NOT. ALLOCATED(DstOutputData%tanInduction)) THEN - ALLOCATE(DstOutputData%tanInduction(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%tanInduction.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%tanInduction = SrcOutputData%tanInduction -ENDIF -IF (ALLOCATED(SrcOutputData%axInduction_qs)) THEN - i1_l = LBOUND(SrcOutputData%axInduction_qs,1) - i1_u = UBOUND(SrcOutputData%axInduction_qs,1) - i2_l = LBOUND(SrcOutputData%axInduction_qs,2) - i2_u = UBOUND(SrcOutputData%axInduction_qs,2) - IF (.NOT. ALLOCATED(DstOutputData%axInduction_qs)) THEN - ALLOCATE(DstOutputData%axInduction_qs(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%axInduction_qs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%axInduction_qs = SrcOutputData%axInduction_qs -ENDIF -IF (ALLOCATED(SrcOutputData%tanInduction_qs)) THEN - i1_l = LBOUND(SrcOutputData%tanInduction_qs,1) - i1_u = UBOUND(SrcOutputData%tanInduction_qs,1) - i2_l = LBOUND(SrcOutputData%tanInduction_qs,2) - i2_u = UBOUND(SrcOutputData%tanInduction_qs,2) - IF (.NOT. ALLOCATED(DstOutputData%tanInduction_qs)) THEN - ALLOCATE(DstOutputData%tanInduction_qs(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%tanInduction_qs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%tanInduction_qs = SrcOutputData%tanInduction_qs -ENDIF -IF (ALLOCATED(SrcOutputData%k)) THEN - i1_l = LBOUND(SrcOutputData%k,1) - i1_u = UBOUND(SrcOutputData%k,1) - i2_l = LBOUND(SrcOutputData%k,2) - i2_u = UBOUND(SrcOutputData%k,2) - IF (.NOT. ALLOCATED(DstOutputData%k)) THEN - ALLOCATE(DstOutputData%k(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%k.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%k = SrcOutputData%k -ENDIF -IF (ALLOCATED(SrcOutputData%k_p)) THEN - i1_l = LBOUND(SrcOutputData%k_p,1) - i1_u = UBOUND(SrcOutputData%k_p,1) - i2_l = LBOUND(SrcOutputData%k_p,2) - i2_u = UBOUND(SrcOutputData%k_p,2) - IF (.NOT. ALLOCATED(DstOutputData%k_p)) THEN - ALLOCATE(DstOutputData%k_p(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%k_p.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%k_p = SrcOutputData%k_p -ENDIF -IF (ALLOCATED(SrcOutputData%F)) THEN - i1_l = LBOUND(SrcOutputData%F,1) - i1_u = UBOUND(SrcOutputData%F,1) - i2_l = LBOUND(SrcOutputData%F,2) - i2_u = UBOUND(SrcOutputData%F,2) - IF (.NOT. ALLOCATED(DstOutputData%F)) THEN - ALLOCATE(DstOutputData%F(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%F.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%F = SrcOutputData%F -ENDIF -IF (ALLOCATED(SrcOutputData%Re)) THEN - i1_l = LBOUND(SrcOutputData%Re,1) - i1_u = UBOUND(SrcOutputData%Re,1) - i2_l = LBOUND(SrcOutputData%Re,2) - i2_u = UBOUND(SrcOutputData%Re,2) - IF (.NOT. ALLOCATED(DstOutputData%Re)) THEN - ALLOCATE(DstOutputData%Re(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Re.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%Re = SrcOutputData%Re -ENDIF -IF (ALLOCATED(SrcOutputData%AOA)) THEN - i1_l = LBOUND(SrcOutputData%AOA,1) - i1_u = UBOUND(SrcOutputData%AOA,1) - i2_l = LBOUND(SrcOutputData%AOA,2) - i2_u = UBOUND(SrcOutputData%AOA,2) - IF (.NOT. ALLOCATED(DstOutputData%AOA)) THEN - ALLOCATE(DstOutputData%AOA(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%AOA.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%AOA = SrcOutputData%AOA -ENDIF -IF (ALLOCATED(SrcOutputData%Cx)) THEN - i1_l = LBOUND(SrcOutputData%Cx,1) - i1_u = UBOUND(SrcOutputData%Cx,1) - i2_l = LBOUND(SrcOutputData%Cx,2) - i2_u = UBOUND(SrcOutputData%Cx,2) - IF (.NOT. ALLOCATED(DstOutputData%Cx)) THEN - ALLOCATE(DstOutputData%Cx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Cx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%Cx = SrcOutputData%Cx -ENDIF -IF (ALLOCATED(SrcOutputData%Cy)) THEN - i1_l = LBOUND(SrcOutputData%Cy,1) - i1_u = UBOUND(SrcOutputData%Cy,1) - i2_l = LBOUND(SrcOutputData%Cy,2) - i2_u = UBOUND(SrcOutputData%Cy,2) - IF (.NOT. ALLOCATED(DstOutputData%Cy)) THEN - ALLOCATE(DstOutputData%Cy(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Cy.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%Cy = SrcOutputData%Cy -ENDIF -IF (ALLOCATED(SrcOutputData%Cz)) THEN - i1_l = LBOUND(SrcOutputData%Cz,1) - i1_u = UBOUND(SrcOutputData%Cz,1) - i2_l = LBOUND(SrcOutputData%Cz,2) - i2_u = UBOUND(SrcOutputData%Cz,2) - IF (.NOT. ALLOCATED(DstOutputData%Cz)) THEN - ALLOCATE(DstOutputData%Cz(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Cz.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%Cz = SrcOutputData%Cz -ENDIF -IF (ALLOCATED(SrcOutputData%Cmx)) THEN - i1_l = LBOUND(SrcOutputData%Cmx,1) - i1_u = UBOUND(SrcOutputData%Cmx,1) - i2_l = LBOUND(SrcOutputData%Cmx,2) - i2_u = UBOUND(SrcOutputData%Cmx,2) - IF (.NOT. ALLOCATED(DstOutputData%Cmx)) THEN - ALLOCATE(DstOutputData%Cmx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Cmx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%Cmx = SrcOutputData%Cmx -ENDIF -IF (ALLOCATED(SrcOutputData%Cmy)) THEN - i1_l = LBOUND(SrcOutputData%Cmy,1) - i1_u = UBOUND(SrcOutputData%Cmy,1) - i2_l = LBOUND(SrcOutputData%Cmy,2) - i2_u = UBOUND(SrcOutputData%Cmy,2) - IF (.NOT. ALLOCATED(DstOutputData%Cmy)) THEN - ALLOCATE(DstOutputData%Cmy(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Cmy.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%Cmy = SrcOutputData%Cmy -ENDIF -IF (ALLOCATED(SrcOutputData%Cmz)) THEN - i1_l = LBOUND(SrcOutputData%Cmz,1) - i1_u = UBOUND(SrcOutputData%Cmz,1) - i2_l = LBOUND(SrcOutputData%Cmz,2) - i2_u = UBOUND(SrcOutputData%Cmz,2) - IF (.NOT. ALLOCATED(DstOutputData%Cmz)) THEN - ALLOCATE(DstOutputData%Cmz(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Cmz.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%Cmz = SrcOutputData%Cmz -ENDIF -IF (ALLOCATED(SrcOutputData%Cm)) THEN - i1_l = LBOUND(SrcOutputData%Cm,1) - i1_u = UBOUND(SrcOutputData%Cm,1) - i2_l = LBOUND(SrcOutputData%Cm,2) - i2_u = UBOUND(SrcOutputData%Cm,2) - IF (.NOT. ALLOCATED(DstOutputData%Cm)) THEN - ALLOCATE(DstOutputData%Cm(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Cm.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%Cm = SrcOutputData%Cm -ENDIF -IF (ALLOCATED(SrcOutputData%Cl)) THEN - i1_l = LBOUND(SrcOutputData%Cl,1) - i1_u = UBOUND(SrcOutputData%Cl,1) - i2_l = LBOUND(SrcOutputData%Cl,2) - i2_u = UBOUND(SrcOutputData%Cl,2) - IF (.NOT. ALLOCATED(DstOutputData%Cl)) THEN - ALLOCATE(DstOutputData%Cl(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Cl.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%Cl = SrcOutputData%Cl -ENDIF -IF (ALLOCATED(SrcOutputData%Cd)) THEN - i1_l = LBOUND(SrcOutputData%Cd,1) - i1_u = UBOUND(SrcOutputData%Cd,1) - i2_l = LBOUND(SrcOutputData%Cd,2) - i2_u = UBOUND(SrcOutputData%Cd,2) - IF (.NOT. ALLOCATED(DstOutputData%Cd)) THEN - ALLOCATE(DstOutputData%Cd(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Cd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%Cd = SrcOutputData%Cd -ENDIF -IF (ALLOCATED(SrcOutputData%chi)) THEN - i1_l = LBOUND(SrcOutputData%chi,1) - i1_u = UBOUND(SrcOutputData%chi,1) - i2_l = LBOUND(SrcOutputData%chi,2) - i2_u = UBOUND(SrcOutputData%chi,2) - IF (.NOT. ALLOCATED(DstOutputData%chi)) THEN - ALLOCATE(DstOutputData%chi(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%chi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%chi = SrcOutputData%chi -ENDIF -IF (ALLOCATED(SrcOutputData%Cpmin)) THEN - i1_l = LBOUND(SrcOutputData%Cpmin,1) - i1_u = UBOUND(SrcOutputData%Cpmin,1) - i2_l = LBOUND(SrcOutputData%Cpmin,2) - i2_u = UBOUND(SrcOutputData%Cpmin,2) - IF (.NOT. ALLOCATED(DstOutputData%Cpmin)) THEN - ALLOCATE(DstOutputData%Cpmin(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Cpmin.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%Cpmin = SrcOutputData%Cpmin -ENDIF - END SUBROUTINE BEMT_CopyOutput - - SUBROUTINE BEMT_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(BEMT_OutputType), INTENT(INOUT) :: OutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_DestroyOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(OutputData%Vrel)) THEN - DEALLOCATE(OutputData%Vrel) -ENDIF -IF (ALLOCATED(OutputData%phi)) THEN - DEALLOCATE(OutputData%phi) -ENDIF -IF (ALLOCATED(OutputData%axInduction)) THEN - DEALLOCATE(OutputData%axInduction) -ENDIF -IF (ALLOCATED(OutputData%tanInduction)) THEN - DEALLOCATE(OutputData%tanInduction) -ENDIF -IF (ALLOCATED(OutputData%axInduction_qs)) THEN - DEALLOCATE(OutputData%axInduction_qs) -ENDIF -IF (ALLOCATED(OutputData%tanInduction_qs)) THEN - DEALLOCATE(OutputData%tanInduction_qs) -ENDIF -IF (ALLOCATED(OutputData%k)) THEN - DEALLOCATE(OutputData%k) -ENDIF -IF (ALLOCATED(OutputData%k_p)) THEN - DEALLOCATE(OutputData%k_p) -ENDIF -IF (ALLOCATED(OutputData%F)) THEN - DEALLOCATE(OutputData%F) -ENDIF -IF (ALLOCATED(OutputData%Re)) THEN - DEALLOCATE(OutputData%Re) -ENDIF -IF (ALLOCATED(OutputData%AOA)) THEN - DEALLOCATE(OutputData%AOA) -ENDIF -IF (ALLOCATED(OutputData%Cx)) THEN - DEALLOCATE(OutputData%Cx) -ENDIF -IF (ALLOCATED(OutputData%Cy)) THEN - DEALLOCATE(OutputData%Cy) -ENDIF -IF (ALLOCATED(OutputData%Cz)) THEN - DEALLOCATE(OutputData%Cz) -ENDIF -IF (ALLOCATED(OutputData%Cmx)) THEN - DEALLOCATE(OutputData%Cmx) -ENDIF -IF (ALLOCATED(OutputData%Cmy)) THEN - DEALLOCATE(OutputData%Cmy) -ENDIF -IF (ALLOCATED(OutputData%Cmz)) THEN - DEALLOCATE(OutputData%Cmz) -ENDIF -IF (ALLOCATED(OutputData%Cm)) THEN - DEALLOCATE(OutputData%Cm) -ENDIF -IF (ALLOCATED(OutputData%Cl)) THEN - DEALLOCATE(OutputData%Cl) -ENDIF -IF (ALLOCATED(OutputData%Cd)) THEN - DEALLOCATE(OutputData%Cd) -ENDIF -IF (ALLOCATED(OutputData%chi)) THEN - DEALLOCATE(OutputData%chi) -ENDIF -IF (ALLOCATED(OutputData%Cpmin)) THEN - DEALLOCATE(OutputData%Cpmin) -ENDIF - END SUBROUTINE BEMT_DestroyOutput - - SUBROUTINE BEMT_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(BEMT_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 = 'BEMT_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 ! Vrel allocated yes/no - IF ( ALLOCATED(InData%Vrel) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Vrel upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vrel) ! Vrel - END IF - Int_BufSz = Int_BufSz + 1 ! phi allocated yes/no - IF ( ALLOCATED(InData%phi) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! phi upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%phi) ! phi - END IF - Int_BufSz = Int_BufSz + 1 ! axInduction allocated yes/no - IF ( ALLOCATED(InData%axInduction) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! axInduction upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%axInduction) ! axInduction - END IF - Int_BufSz = Int_BufSz + 1 ! tanInduction allocated yes/no - IF ( ALLOCATED(InData%tanInduction) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! tanInduction upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%tanInduction) ! tanInduction - END IF - Int_BufSz = Int_BufSz + 1 ! axInduction_qs allocated yes/no - IF ( ALLOCATED(InData%axInduction_qs) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! axInduction_qs upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%axInduction_qs) ! axInduction_qs - END IF - Int_BufSz = Int_BufSz + 1 ! tanInduction_qs allocated yes/no - IF ( ALLOCATED(InData%tanInduction_qs) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! tanInduction_qs upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%tanInduction_qs) ! tanInduction_qs - 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 - Re_BufSz = Re_BufSz + SIZE(InData%k) ! k - END IF - Int_BufSz = Int_BufSz + 1 ! k_p allocated yes/no - IF ( ALLOCATED(InData%k_p) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! k_p upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%k_p) ! k_p - END IF - Int_BufSz = Int_BufSz + 1 ! F allocated yes/no - IF ( ALLOCATED(InData%F) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! F upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F) ! F - END IF - Int_BufSz = Int_BufSz + 1 ! Re allocated yes/no - IF ( ALLOCATED(InData%Re) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Re upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Re) ! Re - END IF - Int_BufSz = Int_BufSz + 1 ! AOA allocated yes/no - IF ( ALLOCATED(InData%AOA) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! AOA upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AOA) ! AOA - END IF - Int_BufSz = Int_BufSz + 1 ! Cx allocated yes/no - IF ( ALLOCATED(InData%Cx) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Cx upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Cx) ! Cx - END IF - Int_BufSz = Int_BufSz + 1 ! Cy allocated yes/no - IF ( ALLOCATED(InData%Cy) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Cy upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Cy) ! Cy - END IF - Int_BufSz = Int_BufSz + 1 ! Cz allocated yes/no - IF ( ALLOCATED(InData%Cz) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Cz upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Cz) ! Cz - END IF - Int_BufSz = Int_BufSz + 1 ! Cmx allocated yes/no - IF ( ALLOCATED(InData%Cmx) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Cmx upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Cmx) ! Cmx - END IF - Int_BufSz = Int_BufSz + 1 ! Cmy allocated yes/no - IF ( ALLOCATED(InData%Cmy) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Cmy upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Cmy) ! Cmy - END IF - Int_BufSz = Int_BufSz + 1 ! Cmz allocated yes/no - IF ( ALLOCATED(InData%Cmz) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Cmz upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Cmz) ! Cmz - END IF - Int_BufSz = Int_BufSz + 1 ! Cm allocated yes/no - IF ( ALLOCATED(InData%Cm) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Cm upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Cm) ! Cm - END IF - Int_BufSz = Int_BufSz + 1 ! Cl allocated yes/no - IF ( ALLOCATED(InData%Cl) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Cl upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Cl) ! Cl - END IF - Int_BufSz = Int_BufSz + 1 ! Cd allocated yes/no - IF ( ALLOCATED(InData%Cd) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Cd upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Cd) ! Cd - END IF - Int_BufSz = Int_BufSz + 1 ! chi allocated yes/no - IF ( ALLOCATED(InData%chi) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! chi upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%chi) ! chi - END IF - Int_BufSz = Int_BufSz + 1 ! Cpmin allocated yes/no - IF ( ALLOCATED(InData%Cpmin) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Cpmin upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Cpmin) ! Cpmin - 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%Vrel) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vrel,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vrel,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vrel,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vrel,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Vrel,2), UBOUND(InData%Vrel,2) - DO i1 = LBOUND(InData%Vrel,1), UBOUND(InData%Vrel,1) - ReKiBuf(Re_Xferred) = InData%Vrel(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%phi) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%phi,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%phi,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%phi,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%phi,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%phi,2), UBOUND(InData%phi,2) - DO i1 = LBOUND(InData%phi,1), UBOUND(InData%phi,1) - ReKiBuf(Re_Xferred) = InData%phi(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%axInduction) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%axInduction,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%axInduction,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%axInduction,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%axInduction,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%axInduction,2), UBOUND(InData%axInduction,2) - DO i1 = LBOUND(InData%axInduction,1), UBOUND(InData%axInduction,1) - ReKiBuf(Re_Xferred) = InData%axInduction(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%tanInduction) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%tanInduction,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%tanInduction,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%tanInduction,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%tanInduction,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%tanInduction,2), UBOUND(InData%tanInduction,2) - DO i1 = LBOUND(InData%tanInduction,1), UBOUND(InData%tanInduction,1) - ReKiBuf(Re_Xferred) = InData%tanInduction(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%axInduction_qs) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%axInduction_qs,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%axInduction_qs,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%axInduction_qs,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%axInduction_qs,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%axInduction_qs,2), UBOUND(InData%axInduction_qs,2) - DO i1 = LBOUND(InData%axInduction_qs,1), UBOUND(InData%axInduction_qs,1) - ReKiBuf(Re_Xferred) = InData%axInduction_qs(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%tanInduction_qs) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%tanInduction_qs,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%tanInduction_qs,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%tanInduction_qs,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%tanInduction_qs,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%tanInduction_qs,2), UBOUND(InData%tanInduction_qs,2) - DO i1 = LBOUND(InData%tanInduction_qs,1), UBOUND(InData%tanInduction_qs,1) - ReKiBuf(Re_Xferred) = InData%tanInduction_qs(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) - ReKiBuf(Re_Xferred) = InData%k(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%k_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%k_p,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%k_p,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%k_p,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%k_p,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%k_p,2), UBOUND(InData%k_p,2) - DO i1 = LBOUND(InData%k_p,1), UBOUND(InData%k_p,1) - ReKiBuf(Re_Xferred) = InData%k_p(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%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%F,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%F,2), UBOUND(InData%F,2) - DO i1 = LBOUND(InData%F,1), UBOUND(InData%F,1) - ReKiBuf(Re_Xferred) = InData%F(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Re) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Re,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Re,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Re,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Re,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Re,2), UBOUND(InData%Re,2) - DO i1 = LBOUND(InData%Re,1), UBOUND(InData%Re,1) - ReKiBuf(Re_Xferred) = InData%Re(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AOA) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AOA,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AOA,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AOA,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AOA,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%AOA,2), UBOUND(InData%AOA,2) - DO i1 = LBOUND(InData%AOA,1), UBOUND(InData%AOA,1) - ReKiBuf(Re_Xferred) = InData%AOA(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Cx) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Cx,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cx,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Cx,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cx,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Cx,2), UBOUND(InData%Cx,2) - DO i1 = LBOUND(InData%Cx,1), UBOUND(InData%Cx,1) - ReKiBuf(Re_Xferred) = InData%Cx(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Cy) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Cy,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cy,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Cy,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cy,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Cy,2), UBOUND(InData%Cy,2) - DO i1 = LBOUND(InData%Cy,1), UBOUND(InData%Cy,1) - ReKiBuf(Re_Xferred) = InData%Cy(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Cz) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Cz,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cz,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Cz,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cz,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Cz,2), UBOUND(InData%Cz,2) - DO i1 = LBOUND(InData%Cz,1), UBOUND(InData%Cz,1) - ReKiBuf(Re_Xferred) = InData%Cz(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Cmx) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Cmx,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cmx,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Cmx,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cmx,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Cmx,2), UBOUND(InData%Cmx,2) - DO i1 = LBOUND(InData%Cmx,1), UBOUND(InData%Cmx,1) - ReKiBuf(Re_Xferred) = InData%Cmx(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Cmy) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Cmy,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cmy,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Cmy,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cmy,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Cmy,2), UBOUND(InData%Cmy,2) - DO i1 = LBOUND(InData%Cmy,1), UBOUND(InData%Cmy,1) - ReKiBuf(Re_Xferred) = InData%Cmy(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Cmz) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Cmz,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cmz,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Cmz,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cmz,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Cmz,2), UBOUND(InData%Cmz,2) - DO i1 = LBOUND(InData%Cmz,1), UBOUND(InData%Cmz,1) - ReKiBuf(Re_Xferred) = InData%Cmz(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Cm) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Cm,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cm,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Cm,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cm,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Cm,2), UBOUND(InData%Cm,2) - DO i1 = LBOUND(InData%Cm,1), UBOUND(InData%Cm,1) - ReKiBuf(Re_Xferred) = InData%Cm(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Cl) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Cl,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cl,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Cl,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cl,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Cl,2), UBOUND(InData%Cl,2) - DO i1 = LBOUND(InData%Cl,1), UBOUND(InData%Cl,1) - ReKiBuf(Re_Xferred) = InData%Cl(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Cd) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Cd,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cd,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Cd,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cd,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Cd,2), UBOUND(InData%Cd,2) - DO i1 = LBOUND(InData%Cd,1), UBOUND(InData%Cd,1) - ReKiBuf(Re_Xferred) = InData%Cd(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%chi) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%chi,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%chi,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%chi,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%chi,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%chi,2), UBOUND(InData%chi,2) - DO i1 = LBOUND(InData%chi,1), UBOUND(InData%chi,1) - ReKiBuf(Re_Xferred) = InData%chi(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Cpmin) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Cpmin,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cpmin,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Cpmin,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cpmin,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Cpmin,2), UBOUND(InData%Cpmin,2) - DO i1 = LBOUND(InData%Cpmin,1), UBOUND(InData%Cpmin,1) - ReKiBuf(Re_Xferred) = InData%Cpmin(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE BEMT_PackOutput - - SUBROUTINE BEMT_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(BEMT_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 = 'BEMT_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 ! Vrel not allocated - Int_Xferred = Int_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%Vrel)) DEALLOCATE(OutData%Vrel) - ALLOCATE(OutData%Vrel(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vrel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Vrel,2), UBOUND(OutData%Vrel,2) - DO i1 = LBOUND(OutData%Vrel,1), UBOUND(OutData%Vrel,1) - OutData%Vrel(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! phi not allocated - Int_Xferred = Int_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%phi)) DEALLOCATE(OutData%phi) - ALLOCATE(OutData%phi(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%phi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%phi,2), UBOUND(OutData%phi,2) - DO i1 = LBOUND(OutData%phi,1), UBOUND(OutData%phi,1) - OutData%phi(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! axInduction not allocated - Int_Xferred = Int_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%axInduction)) DEALLOCATE(OutData%axInduction) - ALLOCATE(OutData%axInduction(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%axInduction.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%axInduction,2), UBOUND(OutData%axInduction,2) - DO i1 = LBOUND(OutData%axInduction,1), UBOUND(OutData%axInduction,1) - OutData%axInduction(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! tanInduction not allocated - Int_Xferred = Int_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%tanInduction)) DEALLOCATE(OutData%tanInduction) - ALLOCATE(OutData%tanInduction(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%tanInduction.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%tanInduction,2), UBOUND(OutData%tanInduction,2) - DO i1 = LBOUND(OutData%tanInduction,1), UBOUND(OutData%tanInduction,1) - OutData%tanInduction(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! axInduction_qs not allocated - Int_Xferred = Int_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%axInduction_qs)) DEALLOCATE(OutData%axInduction_qs) - ALLOCATE(OutData%axInduction_qs(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%axInduction_qs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%axInduction_qs,2), UBOUND(OutData%axInduction_qs,2) - DO i1 = LBOUND(OutData%axInduction_qs,1), UBOUND(OutData%axInduction_qs,1) - OutData%axInduction_qs(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! tanInduction_qs not allocated - Int_Xferred = Int_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%tanInduction_qs)) DEALLOCATE(OutData%tanInduction_qs) - ALLOCATE(OutData%tanInduction_qs(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%tanInduction_qs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%tanInduction_qs,2), UBOUND(OutData%tanInduction_qs,2) - DO i1 = LBOUND(OutData%tanInduction_qs,1), UBOUND(OutData%tanInduction_qs,1) - OutData%tanInduction_qs(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) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! k_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%k_p)) DEALLOCATE(OutData%k_p) - ALLOCATE(OutData%k_p(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%k_p.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%k_p,2), UBOUND(OutData%k_p,2) - DO i1 = LBOUND(OutData%k_p,1), UBOUND(OutData%k_p,1) - OutData%k_p(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! 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 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%F)) DEALLOCATE(OutData%F) - ALLOCATE(OutData%F(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%F,2), UBOUND(OutData%F,2) - DO i1 = LBOUND(OutData%F,1), UBOUND(OutData%F,1) - OutData%F(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Re not allocated - Int_Xferred = Int_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%Re)) DEALLOCATE(OutData%Re) - ALLOCATE(OutData%Re(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Re.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Re,2), UBOUND(OutData%Re,2) - DO i1 = LBOUND(OutData%Re,1), UBOUND(OutData%Re,1) - OutData%Re(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AOA not allocated - Int_Xferred = Int_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%AOA)) DEALLOCATE(OutData%AOA) - ALLOCATE(OutData%AOA(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AOA.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%AOA,2), UBOUND(OutData%AOA,2) - DO i1 = LBOUND(OutData%AOA,1), UBOUND(OutData%AOA,1) - OutData%AOA(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Cx not allocated - Int_Xferred = Int_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%Cx)) DEALLOCATE(OutData%Cx) - ALLOCATE(OutData%Cx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Cx,2), UBOUND(OutData%Cx,2) - DO i1 = LBOUND(OutData%Cx,1), UBOUND(OutData%Cx,1) - OutData%Cx(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Cy not allocated - Int_Xferred = Int_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%Cy)) DEALLOCATE(OutData%Cy) - ALLOCATE(OutData%Cy(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cy.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Cy,2), UBOUND(OutData%Cy,2) - DO i1 = LBOUND(OutData%Cy,1), UBOUND(OutData%Cy,1) - OutData%Cy(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Cz not allocated - Int_Xferred = Int_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%Cz)) DEALLOCATE(OutData%Cz) - ALLOCATE(OutData%Cz(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cz.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Cz,2), UBOUND(OutData%Cz,2) - DO i1 = LBOUND(OutData%Cz,1), UBOUND(OutData%Cz,1) - OutData%Cz(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Cmx not allocated - Int_Xferred = Int_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%Cmx)) DEALLOCATE(OutData%Cmx) - ALLOCATE(OutData%Cmx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cmx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Cmx,2), UBOUND(OutData%Cmx,2) - DO i1 = LBOUND(OutData%Cmx,1), UBOUND(OutData%Cmx,1) - OutData%Cmx(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Cmy not allocated - Int_Xferred = Int_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%Cmy)) DEALLOCATE(OutData%Cmy) - ALLOCATE(OutData%Cmy(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cmy.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Cmy,2), UBOUND(OutData%Cmy,2) - DO i1 = LBOUND(OutData%Cmy,1), UBOUND(OutData%Cmy,1) - OutData%Cmy(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Cmz not allocated - Int_Xferred = Int_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%Cmz)) DEALLOCATE(OutData%Cmz) - ALLOCATE(OutData%Cmz(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cmz.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Cmz,2), UBOUND(OutData%Cmz,2) - DO i1 = LBOUND(OutData%Cmz,1), UBOUND(OutData%Cmz,1) - OutData%Cmz(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Cm not allocated - Int_Xferred = Int_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%Cm)) DEALLOCATE(OutData%Cm) - ALLOCATE(OutData%Cm(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cm.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Cm,2), UBOUND(OutData%Cm,2) - DO i1 = LBOUND(OutData%Cm,1), UBOUND(OutData%Cm,1) - OutData%Cm(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Cl not allocated - Int_Xferred = Int_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%Cl)) DEALLOCATE(OutData%Cl) - ALLOCATE(OutData%Cl(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cl.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Cl,2), UBOUND(OutData%Cl,2) - DO i1 = LBOUND(OutData%Cl,1), UBOUND(OutData%Cl,1) - OutData%Cl(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Cd not allocated - Int_Xferred = Int_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%Cd)) DEALLOCATE(OutData%Cd) - ALLOCATE(OutData%Cd(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Cd,2), UBOUND(OutData%Cd,2) - DO i1 = LBOUND(OutData%Cd,1), UBOUND(OutData%Cd,1) - OutData%Cd(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! chi not allocated - Int_Xferred = Int_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%chi)) DEALLOCATE(OutData%chi) - ALLOCATE(OutData%chi(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%chi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%chi,2), UBOUND(OutData%chi,2) - DO i1 = LBOUND(OutData%chi,1), UBOUND(OutData%chi,1) - OutData%chi(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Cpmin not allocated - Int_Xferred = Int_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%Cpmin)) DEALLOCATE(OutData%Cpmin) - ALLOCATE(OutData%Cpmin(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cpmin.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Cpmin,2), UBOUND(OutData%Cpmin,2) - DO i1 = LBOUND(OutData%Cpmin,1), UBOUND(OutData%Cpmin,1) - OutData%Cpmin(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE BEMT_UnPackOutput - - - SUBROUTINE BEMT_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(BEMT_InputType), INTENT(IN) :: u(:) ! Input at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Inputs - TYPE(BEMT_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 + ErrMsg = '' + call UA_DestroyDiscState(DiscStateData%UA, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine BEMT_PackDiscState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(BEMT_DiscreteStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'BEMT_PackDiscState' + if (RF%ErrStat >= AbortErrLev) return + call UA_PackDiscState(RF, InData%UA) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine BEMT_UnPackDiscState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(BEMT_DiscreteStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'BEMT_UnPackDiscState' + if (RF%ErrStat /= ErrID_None) return + call UA_UnpackDiscState(RF, OutData%UA) ! UA +end subroutine + +subroutine BEMT_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) + type(BEMT_ConstraintStateType), intent(in) :: SrcConstrStateData + type(BEMT_ConstraintStateType), intent(inout) :: DstConstrStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'BEMT_CopyConstrState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcConstrStateData%phi)) then + LB(1:2) = lbound(SrcConstrStateData%phi) + UB(1:2) = ubound(SrcConstrStateData%phi) + if (.not. allocated(DstConstrStateData%phi)) then + allocate(DstConstrStateData%phi(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstConstrStateData%phi.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstConstrStateData%phi = SrcConstrStateData%phi + end if +end subroutine + +subroutine BEMT_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) + type(BEMT_ConstraintStateType), intent(inout) :: ConstrStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'BEMT_DestroyConstrState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ConstrStateData%phi)) then + deallocate(ConstrStateData%phi) + end if +end subroutine + +subroutine BEMT_PackConstrState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(BEMT_ConstraintStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'BEMT_PackConstrState' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%phi) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine BEMT_UnPackConstrState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(BEMT_ConstraintStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'BEMT_UnPackConstrState' + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%phi); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine BEMT_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) + type(BEMT_OtherStateType), intent(in) :: SrcOtherStateData + type(BEMT_OtherStateType), intent(inout) :: DstOtherStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'BEMT_CopyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + call UA_CopyOtherState(SrcOtherStateData%UA, DstOtherStateData%UA, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call DBEMT_CopyOtherState(SrcOtherStateData%DBEMT, DstOtherStateData%DBEMT, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcOtherStateData%ValidPhi)) then + LB(1:2) = lbound(SrcOtherStateData%ValidPhi) + UB(1:2) = ubound(SrcOtherStateData%ValidPhi) + if (.not. allocated(DstOtherStateData%ValidPhi)) then + allocate(DstOtherStateData%ValidPhi(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%ValidPhi.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOtherStateData%ValidPhi = SrcOtherStateData%ValidPhi + end if + DstOtherStateData%nodesInitialized = SrcOtherStateData%nodesInitialized + LB(1:1) = lbound(SrcOtherStateData%xdot) + UB(1:1) = ubound(SrcOtherStateData%xdot) + do i1 = LB(1), UB(1) + call BEMT_CopyContState(SrcOtherStateData%xdot(i1), DstOtherStateData%xdot(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + DstOtherStateData%n = SrcOtherStateData%n +end subroutine + +subroutine BEMT_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) + type(BEMT_OtherStateType), intent(inout) :: OtherStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'BEMT_DestroyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + call UA_DestroyOtherState(OtherStateData%UA, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call DBEMT_DestroyOtherState(OtherStateData%DBEMT, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(OtherStateData%ValidPhi)) then + deallocate(OtherStateData%ValidPhi) + end if + LB(1:1) = lbound(OtherStateData%xdot) + UB(1:1) = ubound(OtherStateData%xdot) + do i1 = LB(1), UB(1) + call BEMT_DestroyContState(OtherStateData%xdot(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do +end subroutine + +subroutine BEMT_PackOtherState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(BEMT_OtherStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'BEMT_PackOtherState' + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + if (RF%ErrStat >= AbortErrLev) return + call UA_PackOtherState(RF, InData%UA) + call DBEMT_PackOtherState(RF, InData%DBEMT) + call RegPackAlloc(RF, InData%ValidPhi) + call RegPack(RF, InData%nodesInitialized) + LB(1:1) = lbound(InData%xdot) + UB(1:1) = ubound(InData%xdot) + do i1 = LB(1), UB(1) + call BEMT_PackContState(RF, InData%xdot(i1)) + end do + call RegPack(RF, InData%n) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine BEMT_UnPackOtherState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(BEMT_OtherStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'BEMT_UnPackOtherState' + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call UA_UnpackOtherState(RF, OutData%UA) ! UA + call DBEMT_UnpackOtherState(RF, OutData%DBEMT) ! DBEMT + call RegUnpackAlloc(RF, OutData%ValidPhi); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nodesInitialized); if (RegCheckErr(RF, RoutineName)) return + LB(1:1) = lbound(OutData%xdot) + UB(1:1) = ubound(OutData%xdot) + do i1 = LB(1), UB(1) + call BEMT_UnpackContState(RF, OutData%xdot(i1)) ! xdot + end do + call RegUnpack(RF, OutData%n); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine BEMT_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(BEMT_MiscVarType), intent(in) :: SrcMiscData + type(BEMT_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'BEMT_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + DstMiscData%FirstWarn_Skew = SrcMiscData%FirstWarn_Skew + DstMiscData%FirstWarn_Phi = SrcMiscData%FirstWarn_Phi + DstMiscData%FirstWarn_BEMoff = SrcMiscData%FirstWarn_BEMoff + call UA_CopyMisc(SrcMiscData%UA, DstMiscData%UA, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call DBEMT_CopyMisc(SrcMiscData%DBEMT, DstMiscData%DBEMT, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call UA_CopyOutput(SrcMiscData%y_UA, DstMiscData%y_UA, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcMiscData%u_UA)) then + LB(1:3) = lbound(SrcMiscData%u_UA) + UB(1:3) = ubound(SrcMiscData%u_UA) + if (.not. allocated(DstMiscData%u_UA)) then + allocate(DstMiscData%u_UA(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%u_UA.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i3 = LB(3), UB(3) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call UA_CopyInput(SrcMiscData%u_UA(i1,i2,i3), DstMiscData%u_UA(i1,i2,i3), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do + end do + end if + LB(1:1) = lbound(SrcMiscData%u_DBEMT) + UB(1:1) = ubound(SrcMiscData%u_DBEMT) + do i1 = LB(1), UB(1) + call DBEMT_CopyInput(SrcMiscData%u_DBEMT(i1), DstMiscData%u_DBEMT(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + LB(1:1) = lbound(SrcMiscData%u_SkewWake) + UB(1:1) = ubound(SrcMiscData%u_SkewWake) + do i1 = LB(1), UB(1) + call BEMT_CopySkewWake_InputType(SrcMiscData%u_SkewWake(i1), DstMiscData%u_SkewWake(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + if (allocated(SrcMiscData%TnInd_op)) then + LB(1:2) = lbound(SrcMiscData%TnInd_op) + UB(1:2) = ubound(SrcMiscData%TnInd_op) + if (.not. allocated(DstMiscData%TnInd_op)) then + allocate(DstMiscData%TnInd_op(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%TnInd_op.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%TnInd_op = SrcMiscData%TnInd_op + end if + if (allocated(SrcMiscData%AxInd_op)) then + LB(1:2) = lbound(SrcMiscData%AxInd_op) + UB(1:2) = ubound(SrcMiscData%AxInd_op) + if (.not. allocated(DstMiscData%AxInd_op)) then + allocate(DstMiscData%AxInd_op(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%AxInd_op.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%AxInd_op = SrcMiscData%AxInd_op + end if + if (allocated(SrcMiscData%AxInduction)) then + LB(1:2) = lbound(SrcMiscData%AxInduction) + UB(1:2) = ubound(SrcMiscData%AxInduction) + if (.not. allocated(DstMiscData%AxInduction)) then + allocate(DstMiscData%AxInduction(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%AxInduction.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%AxInduction = SrcMiscData%AxInduction + end if + if (allocated(SrcMiscData%TanInduction)) then + LB(1:2) = lbound(SrcMiscData%TanInduction) + UB(1:2) = ubound(SrcMiscData%TanInduction) + if (.not. allocated(DstMiscData%TanInduction)) then + allocate(DstMiscData%TanInduction(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%TanInduction.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%TanInduction = SrcMiscData%TanInduction + end if + DstMiscData%UseFrozenWake = SrcMiscData%UseFrozenWake + if (allocated(SrcMiscData%Rtip)) then + LB(1:1) = lbound(SrcMiscData%Rtip) + UB(1:1) = ubound(SrcMiscData%Rtip) + if (.not. allocated(DstMiscData%Rtip)) then + allocate(DstMiscData%Rtip(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Rtip.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%Rtip = SrcMiscData%Rtip + end if + if (allocated(SrcMiscData%phi)) then + LB(1:2) = lbound(SrcMiscData%phi) + UB(1:2) = ubound(SrcMiscData%phi) + if (.not. allocated(DstMiscData%phi)) then + allocate(DstMiscData%phi(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%phi.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%phi = SrcMiscData%phi + end if + if (allocated(SrcMiscData%chi)) then + LB(1:2) = lbound(SrcMiscData%chi) + UB(1:2) = ubound(SrcMiscData%chi) + if (.not. allocated(DstMiscData%chi)) then + allocate(DstMiscData%chi(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%chi.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%chi = SrcMiscData%chi + end if + if (allocated(SrcMiscData%ValidPhi)) then + LB(1:2) = lbound(SrcMiscData%ValidPhi) + UB(1:2) = ubound(SrcMiscData%ValidPhi) + if (.not. allocated(DstMiscData%ValidPhi)) then + allocate(DstMiscData%ValidPhi(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%ValidPhi.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%ValidPhi = SrcMiscData%ValidPhi + end if + DstMiscData%BEM_weight = SrcMiscData%BEM_weight +end subroutine + +subroutine BEMT_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(BEMT_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'BEMT_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' + call UA_DestroyMisc(MiscData%UA, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call DBEMT_DestroyMisc(MiscData%DBEMT, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call UA_DestroyOutput(MiscData%y_UA, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(MiscData%u_UA)) then + LB(1:3) = lbound(MiscData%u_UA) + UB(1:3) = ubound(MiscData%u_UA) + do i3 = LB(3), UB(3) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call UA_DestroyInput(MiscData%u_UA(i1,i2,i3), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + end do + deallocate(MiscData%u_UA) + end if + LB(1:1) = lbound(MiscData%u_DBEMT) + UB(1:1) = ubound(MiscData%u_DBEMT) + do i1 = LB(1), UB(1) + call DBEMT_DestroyInput(MiscData%u_DBEMT(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(MiscData%u_SkewWake) + UB(1:1) = ubound(MiscData%u_SkewWake) + do i1 = LB(1), UB(1) + call BEMT_DestroySkewWake_InputType(MiscData%u_SkewWake(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + if (allocated(MiscData%TnInd_op)) then + deallocate(MiscData%TnInd_op) + end if + if (allocated(MiscData%AxInd_op)) then + deallocate(MiscData%AxInd_op) + end if + if (allocated(MiscData%AxInduction)) then + deallocate(MiscData%AxInduction) + end if + if (allocated(MiscData%TanInduction)) then + deallocate(MiscData%TanInduction) + end if + if (allocated(MiscData%Rtip)) then + deallocate(MiscData%Rtip) + end if + if (allocated(MiscData%phi)) then + deallocate(MiscData%phi) + end if + if (allocated(MiscData%chi)) then + deallocate(MiscData%chi) + end if + if (allocated(MiscData%ValidPhi)) then + deallocate(MiscData%ValidPhi) + end if +end subroutine + +subroutine BEMT_PackMisc(RF, Indata) + type(RegFile), intent(inout) :: RF + type(BEMT_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'BEMT_PackMisc' + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%FirstWarn_Skew) + call RegPack(RF, InData%FirstWarn_Phi) + call RegPack(RF, InData%FirstWarn_BEMoff) + call UA_PackMisc(RF, InData%UA) + call DBEMT_PackMisc(RF, InData%DBEMT) + call UA_PackOutput(RF, InData%y_UA) + call RegPack(RF, allocated(InData%u_UA)) + if (allocated(InData%u_UA)) then + call RegPackBounds(RF, 3, lbound(InData%u_UA), ubound(InData%u_UA)) + LB(1:3) = lbound(InData%u_UA) + UB(1:3) = ubound(InData%u_UA) + do i3 = LB(3), UB(3) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call UA_PackInput(RF, InData%u_UA(i1,i2,i3)) + end do + end do + end do + end if + LB(1:1) = lbound(InData%u_DBEMT) + UB(1:1) = ubound(InData%u_DBEMT) + do i1 = LB(1), UB(1) + call DBEMT_PackInput(RF, InData%u_DBEMT(i1)) + end do + LB(1:1) = lbound(InData%u_SkewWake) + UB(1:1) = ubound(InData%u_SkewWake) + do i1 = LB(1), UB(1) + call BEMT_PackSkewWake_InputType(RF, InData%u_SkewWake(i1)) + end do + call RegPackAlloc(RF, InData%TnInd_op) + call RegPackAlloc(RF, InData%AxInd_op) + call RegPackAlloc(RF, InData%AxInduction) + call RegPackAlloc(RF, InData%TanInduction) + call RegPack(RF, InData%UseFrozenWake) + call RegPackAlloc(RF, InData%Rtip) + call RegPackAlloc(RF, InData%phi) + call RegPackAlloc(RF, InData%chi) + call RegPackAlloc(RF, InData%ValidPhi) + call RegPack(RF, InData%BEM_weight) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine BEMT_UnPackMisc(RF, OutData) + type(RegFile), intent(inout) :: RF + type(BEMT_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'BEMT_UnPackMisc' + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%FirstWarn_Skew); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FirstWarn_Phi); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FirstWarn_BEMoff); if (RegCheckErr(RF, RoutineName)) return + call UA_UnpackMisc(RF, OutData%UA) ! UA + call DBEMT_UnpackMisc(RF, OutData%DBEMT) ! DBEMT + call UA_UnpackOutput(RF, OutData%y_UA) ! y_UA + if (allocated(OutData%u_UA)) deallocate(OutData%u_UA) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 3, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%u_UA(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_UA.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i3 = LB(3), UB(3) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call UA_UnpackInput(RF, OutData%u_UA(i1,i2,i3)) ! u_UA + end do + end do + end do + end if + LB(1:1) = lbound(OutData%u_DBEMT) + UB(1:1) = ubound(OutData%u_DBEMT) + do i1 = LB(1), UB(1) + call DBEMT_UnpackInput(RF, OutData%u_DBEMT(i1)) ! u_DBEMT + end do + LB(1:1) = lbound(OutData%u_SkewWake) + UB(1:1) = ubound(OutData%u_SkewWake) + do i1 = LB(1), UB(1) + call BEMT_UnpackSkewWake_InputType(RF, OutData%u_SkewWake(i1)) ! u_SkewWake + end do + call RegUnpackAlloc(RF, OutData%TnInd_op); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AxInd_op); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AxInduction); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TanInduction); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UseFrozenWake); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Rtip); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%phi); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%chi); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ValidPhi); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BEM_weight); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine BEMT_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(BEMT_ParameterType), intent(in) :: SrcParamData + type(BEMT_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'BEMT_CopyParam' + ErrStat = ErrID_None + ErrMsg = '' + DstParamData%DT = SrcParamData%DT + if (allocated(SrcParamData%chord)) then + LB(1:2) = lbound(SrcParamData%chord) + UB(1:2) = ubound(SrcParamData%chord) + if (.not. allocated(DstParamData%chord)) then + allocate(DstParamData%chord(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%chord.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%chord = SrcParamData%chord + end if + DstParamData%numBlades = SrcParamData%numBlades + DstParamData%airDens = SrcParamData%airDens + DstParamData%kinVisc = SrcParamData%kinVisc + DstParamData%skewWakeMod = SrcParamData%skewWakeMod + DstParamData%skewRedistrMod = SrcParamData%skewRedistrMod + DstParamData%aTol = SrcParamData%aTol + DstParamData%useTipLoss = SrcParamData%useTipLoss + DstParamData%useHubLoss = SrcParamData%useHubLoss + DstParamData%useInduction = SrcParamData%useInduction + DstParamData%useTanInd = SrcParamData%useTanInd + DstParamData%useAIDrag = SrcParamData%useAIDrag + DstParamData%useTIDrag = SrcParamData%useTIDrag + DstParamData%numBladeNodes = SrcParamData%numBladeNodes + DstParamData%numReIterations = SrcParamData%numReIterations + DstParamData%maxIndIterations = SrcParamData%maxIndIterations + if (allocated(SrcParamData%AFindx)) then + LB(1:2) = lbound(SrcParamData%AFindx) + UB(1:2) = ubound(SrcParamData%AFindx) + if (.not. allocated(DstParamData%AFindx)) then + allocate(DstParamData%AFindx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AFindx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%AFindx = SrcParamData%AFindx + end if + if (allocated(SrcParamData%tipLossConst)) then + LB(1:2) = lbound(SrcParamData%tipLossConst) + UB(1:2) = ubound(SrcParamData%tipLossConst) + if (.not. allocated(DstParamData%tipLossConst)) then + allocate(DstParamData%tipLossConst(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%tipLossConst.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%tipLossConst = SrcParamData%tipLossConst + end if + if (allocated(SrcParamData%hubLossConst)) then + LB(1:2) = lbound(SrcParamData%hubLossConst) + UB(1:2) = ubound(SrcParamData%hubLossConst) + if (.not. allocated(DstParamData%hubLossConst)) then + allocate(DstParamData%hubLossConst(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%hubLossConst.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%hubLossConst = SrcParamData%hubLossConst + end if + if (allocated(SrcParamData%zHub)) then + LB(1:1) = lbound(SrcParamData%zHub) + UB(1:1) = ubound(SrcParamData%zHub) + if (.not. allocated(DstParamData%zHub)) then + allocate(DstParamData%zHub(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%zHub.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%zHub = SrcParamData%zHub + end if + call UA_CopyParam(SrcParamData%UA, DstParamData%UA, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call DBEMT_CopyParam(SrcParamData%DBEMT, DstParamData%DBEMT, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstParamData%UA_Flag = SrcParamData%UA_Flag + DstParamData%DBEMT_Mod = SrcParamData%DBEMT_Mod + DstParamData%yawCorrFactor = SrcParamData%yawCorrFactor + if (allocated(SrcParamData%FixedInductions)) then + LB(1:2) = lbound(SrcParamData%FixedInductions) + UB(1:2) = ubound(SrcParamData%FixedInductions) + if (.not. allocated(DstParamData%FixedInductions)) then + allocate(DstParamData%FixedInductions(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%FixedInductions.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%FixedInductions = SrcParamData%FixedInductions + end if + DstParamData%MomentumCorr = SrcParamData%MomentumCorr + DstParamData%rTipFixMax = SrcParamData%rTipFixMax + if (allocated(SrcParamData%IntegrateWeight)) then + LB(1:2) = lbound(SrcParamData%IntegrateWeight) + UB(1:2) = ubound(SrcParamData%IntegrateWeight) + if (.not. allocated(DstParamData%IntegrateWeight)) then + allocate(DstParamData%IntegrateWeight(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IntegrateWeight.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%IntegrateWeight = SrcParamData%IntegrateWeight + end if + DstParamData%lin_nx = SrcParamData%lin_nx + DstParamData%BEM_Mod = SrcParamData%BEM_Mod +end subroutine + +subroutine BEMT_DestroyParam(ParamData, ErrStat, ErrMsg) + type(BEMT_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'BEMT_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ParamData%chord)) then + deallocate(ParamData%chord) + end if + if (allocated(ParamData%AFindx)) then + deallocate(ParamData%AFindx) + end if + if (allocated(ParamData%tipLossConst)) then + deallocate(ParamData%tipLossConst) + end if + if (allocated(ParamData%hubLossConst)) then + deallocate(ParamData%hubLossConst) + end if + if (allocated(ParamData%zHub)) then + deallocate(ParamData%zHub) + end if + call UA_DestroyParam(ParamData%UA, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call DBEMT_DestroyParam(ParamData%DBEMT, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(ParamData%FixedInductions)) then + deallocate(ParamData%FixedInductions) + end if + if (allocated(ParamData%IntegrateWeight)) then + deallocate(ParamData%IntegrateWeight) + end if +end subroutine + +subroutine BEMT_PackParam(RF, Indata) + type(RegFile), intent(inout) :: RF + type(BEMT_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'BEMT_PackParam' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DT) + call RegPackAlloc(RF, InData%chord) + call RegPack(RF, InData%numBlades) + call RegPack(RF, InData%airDens) + call RegPack(RF, InData%kinVisc) + call RegPack(RF, InData%skewWakeMod) + call RegPack(RF, InData%skewRedistrMod) + call RegPack(RF, InData%aTol) + call RegPack(RF, InData%useTipLoss) + call RegPack(RF, InData%useHubLoss) + call RegPack(RF, InData%useInduction) + call RegPack(RF, InData%useTanInd) + call RegPack(RF, InData%useAIDrag) + call RegPack(RF, InData%useTIDrag) + call RegPack(RF, InData%numBladeNodes) + call RegPack(RF, InData%numReIterations) + call RegPack(RF, InData%maxIndIterations) + call RegPackAlloc(RF, InData%AFindx) + call RegPackAlloc(RF, InData%tipLossConst) + call RegPackAlloc(RF, InData%hubLossConst) + call RegPackAlloc(RF, InData%zHub) + call UA_PackParam(RF, InData%UA) + call DBEMT_PackParam(RF, InData%DBEMT) + call RegPack(RF, InData%UA_Flag) + call RegPack(RF, InData%DBEMT_Mod) + call RegPack(RF, InData%yawCorrFactor) + call RegPackAlloc(RF, InData%FixedInductions) + call RegPack(RF, InData%MomentumCorr) + call RegPack(RF, InData%rTipFixMax) + call RegPackAlloc(RF, InData%IntegrateWeight) + call RegPack(RF, InData%lin_nx) + call RegPack(RF, InData%BEM_Mod) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine BEMT_UnPackParam(RF, OutData) + type(RegFile), intent(inout) :: RF + type(BEMT_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'BEMT_UnPackParam' + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%chord); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%numBlades); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%airDens); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%kinVisc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%skewWakeMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%skewRedistrMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%aTol); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%useTipLoss); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%useHubLoss); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%useInduction); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%useTanInd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%useAIDrag); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%useTIDrag); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%numBladeNodes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%numReIterations); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%maxIndIterations); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AFindx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%tipLossConst); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%hubLossConst); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%zHub); if (RegCheckErr(RF, RoutineName)) return + call UA_UnpackParam(RF, OutData%UA) ! UA + call DBEMT_UnpackParam(RF, OutData%DBEMT) ! DBEMT + call RegUnpack(RF, OutData%UA_Flag); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DBEMT_Mod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%yawCorrFactor); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%FixedInductions); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MomentumCorr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rTipFixMax); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%IntegrateWeight); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%lin_nx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BEM_Mod); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine BEMT_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) + type(BEMT_InputType), intent(in) :: SrcInputData + type(BEMT_InputType), intent(inout) :: DstInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'BEMT_CopyInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcInputData%theta)) then + LB(1:2) = lbound(SrcInputData%theta) + UB(1:2) = ubound(SrcInputData%theta) + if (.not. allocated(DstInputData%theta)) then + allocate(DstInputData%theta(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%theta.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%theta = SrcInputData%theta + end if + DstInputData%chi0 = SrcInputData%chi0 + DstInputData%psiSkewOffset = SrcInputData%psiSkewOffset + if (allocated(SrcInputData%psi_s)) then + LB(1:1) = lbound(SrcInputData%psi_s) + UB(1:1) = ubound(SrcInputData%psi_s) + if (.not. allocated(DstInputData%psi_s)) then + allocate(DstInputData%psi_s(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%psi_s.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%psi_s = SrcInputData%psi_s + end if + DstInputData%omega = SrcInputData%omega + DstInputData%TSR = SrcInputData%TSR + if (allocated(SrcInputData%Vx)) then + LB(1:2) = lbound(SrcInputData%Vx) + UB(1:2) = ubound(SrcInputData%Vx) + if (.not. allocated(DstInputData%Vx)) then + allocate(DstInputData%Vx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%Vx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%Vx = SrcInputData%Vx + end if + if (allocated(SrcInputData%Vy)) then + LB(1:2) = lbound(SrcInputData%Vy) + UB(1:2) = ubound(SrcInputData%Vy) + if (.not. allocated(DstInputData%Vy)) then + allocate(DstInputData%Vy(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%Vy.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%Vy = SrcInputData%Vy + end if + if (allocated(SrcInputData%Vz)) then + LB(1:2) = lbound(SrcInputData%Vz) + UB(1:2) = ubound(SrcInputData%Vz) + if (.not. allocated(DstInputData%Vz)) then + allocate(DstInputData%Vz(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%Vz.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%Vz = SrcInputData%Vz + end if + if (allocated(SrcInputData%omega_z)) then + LB(1:2) = lbound(SrcInputData%omega_z) + UB(1:2) = ubound(SrcInputData%omega_z) + if (.not. allocated(DstInputData%omega_z)) then + allocate(DstInputData%omega_z(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%omega_z.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%omega_z = SrcInputData%omega_z + end if + if (allocated(SrcInputData%xVelCorr)) then + LB(1:2) = lbound(SrcInputData%xVelCorr) + UB(1:2) = ubound(SrcInputData%xVelCorr) + if (.not. allocated(DstInputData%xVelCorr)) then + allocate(DstInputData%xVelCorr(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%xVelCorr.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%xVelCorr = SrcInputData%xVelCorr + end if + if (allocated(SrcInputData%rLocal)) then + LB(1:2) = lbound(SrcInputData%rLocal) + UB(1:2) = ubound(SrcInputData%rLocal) + if (.not. allocated(DstInputData%rLocal)) then + allocate(DstInputData%rLocal(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%rLocal.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%rLocal = SrcInputData%rLocal + end if + DstInputData%Un_disk = SrcInputData%Un_disk + DstInputData%V0 = SrcInputData%V0 + DstInputData%x_hat_disk = SrcInputData%x_hat_disk + if (allocated(SrcInputData%UserProp)) then + LB(1:2) = lbound(SrcInputData%UserProp) + UB(1:2) = ubound(SrcInputData%UserProp) + if (.not. allocated(DstInputData%UserProp)) then + allocate(DstInputData%UserProp(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%UserProp.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%UserProp = SrcInputData%UserProp + end if + if (allocated(SrcInputData%CantAngle)) then + LB(1:2) = lbound(SrcInputData%CantAngle) + UB(1:2) = ubound(SrcInputData%CantAngle) + if (.not. allocated(DstInputData%CantAngle)) then + allocate(DstInputData%CantAngle(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%CantAngle.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%CantAngle = SrcInputData%CantAngle + end if + if (allocated(SrcInputData%drdz)) then + LB(1:2) = lbound(SrcInputData%drdz) + UB(1:2) = ubound(SrcInputData%drdz) + if (.not. allocated(DstInputData%drdz)) then + allocate(DstInputData%drdz(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%drdz.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%drdz = SrcInputData%drdz + end if + if (allocated(SrcInputData%toeAngle)) then + LB(1:2) = lbound(SrcInputData%toeAngle) + UB(1:2) = ubound(SrcInputData%toeAngle) + if (.not. allocated(DstInputData%toeAngle)) then + allocate(DstInputData%toeAngle(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%toeAngle.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%toeAngle = SrcInputData%toeAngle + end if +end subroutine + +subroutine BEMT_DestroyInput(InputData, ErrStat, ErrMsg) + type(BEMT_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'BEMT_DestroyInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InputData%theta)) then + deallocate(InputData%theta) + end if + if (allocated(InputData%psi_s)) then + deallocate(InputData%psi_s) + end if + if (allocated(InputData%Vx)) then + deallocate(InputData%Vx) + end if + if (allocated(InputData%Vy)) then + deallocate(InputData%Vy) + end if + if (allocated(InputData%Vz)) then + deallocate(InputData%Vz) + end if + if (allocated(InputData%omega_z)) then + deallocate(InputData%omega_z) + end if + if (allocated(InputData%xVelCorr)) then + deallocate(InputData%xVelCorr) + end if + if (allocated(InputData%rLocal)) then + deallocate(InputData%rLocal) + end if + if (allocated(InputData%UserProp)) then + deallocate(InputData%UserProp) + end if + if (allocated(InputData%CantAngle)) then + deallocate(InputData%CantAngle) + end if + if (allocated(InputData%drdz)) then + deallocate(InputData%drdz) + end if + if (allocated(InputData%toeAngle)) then + deallocate(InputData%toeAngle) + end if +end subroutine + +subroutine BEMT_PackInput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(BEMT_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'BEMT_PackInput' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%theta) + call RegPack(RF, InData%chi0) + call RegPack(RF, InData%psiSkewOffset) + call RegPackAlloc(RF, InData%psi_s) + call RegPack(RF, InData%omega) + call RegPack(RF, InData%TSR) + call RegPackAlloc(RF, InData%Vx) + call RegPackAlloc(RF, InData%Vy) + call RegPackAlloc(RF, InData%Vz) + call RegPackAlloc(RF, InData%omega_z) + call RegPackAlloc(RF, InData%xVelCorr) + call RegPackAlloc(RF, InData%rLocal) + call RegPack(RF, InData%Un_disk) + call RegPack(RF, InData%V0) + call RegPack(RF, InData%x_hat_disk) + call RegPackAlloc(RF, InData%UserProp) + call RegPackAlloc(RF, InData%CantAngle) + call RegPackAlloc(RF, InData%drdz) + call RegPackAlloc(RF, InData%toeAngle) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine BEMT_UnPackInput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(BEMT_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'BEMT_UnPackInput' + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%theta); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%chi0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%psiSkewOffset); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%psi_s); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%omega); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TSR); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Vx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Vy); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Vz); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%omega_z); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%xVelCorr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%rLocal); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Un_disk); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%V0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%x_hat_disk); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%UserProp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%CantAngle); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%drdz); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%toeAngle); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine BEMT_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(BEMT_OutputType), intent(in) :: SrcOutputData + type(BEMT_OutputType), intent(inout) :: DstOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'BEMT_CopyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcOutputData%Vrel)) then + LB(1:2) = lbound(SrcOutputData%Vrel) + UB(1:2) = ubound(SrcOutputData%Vrel) + if (.not. allocated(DstOutputData%Vrel)) then + allocate(DstOutputData%Vrel(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Vrel.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%Vrel = SrcOutputData%Vrel + end if + if (allocated(SrcOutputData%phi)) then + LB(1:2) = lbound(SrcOutputData%phi) + UB(1:2) = ubound(SrcOutputData%phi) + if (.not. allocated(DstOutputData%phi)) then + allocate(DstOutputData%phi(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%phi.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%phi = SrcOutputData%phi + end if + if (allocated(SrcOutputData%axInduction)) then + LB(1:2) = lbound(SrcOutputData%axInduction) + UB(1:2) = ubound(SrcOutputData%axInduction) + if (.not. allocated(DstOutputData%axInduction)) then + allocate(DstOutputData%axInduction(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%axInduction.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%axInduction = SrcOutputData%axInduction + end if + if (allocated(SrcOutputData%tanInduction)) then + LB(1:2) = lbound(SrcOutputData%tanInduction) + UB(1:2) = ubound(SrcOutputData%tanInduction) + if (.not. allocated(DstOutputData%tanInduction)) then + allocate(DstOutputData%tanInduction(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%tanInduction.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%tanInduction = SrcOutputData%tanInduction + end if + if (allocated(SrcOutputData%axInduction_qs)) then + LB(1:2) = lbound(SrcOutputData%axInduction_qs) + UB(1:2) = ubound(SrcOutputData%axInduction_qs) + if (.not. allocated(DstOutputData%axInduction_qs)) then + allocate(DstOutputData%axInduction_qs(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%axInduction_qs.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%axInduction_qs = SrcOutputData%axInduction_qs + end if + if (allocated(SrcOutputData%tanInduction_qs)) then + LB(1:2) = lbound(SrcOutputData%tanInduction_qs) + UB(1:2) = ubound(SrcOutputData%tanInduction_qs) + if (.not. allocated(DstOutputData%tanInduction_qs)) then + allocate(DstOutputData%tanInduction_qs(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%tanInduction_qs.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%tanInduction_qs = SrcOutputData%tanInduction_qs + end if + if (allocated(SrcOutputData%k)) then + LB(1:2) = lbound(SrcOutputData%k) + UB(1:2) = ubound(SrcOutputData%k) + if (.not. allocated(DstOutputData%k)) then + allocate(DstOutputData%k(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%k.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%k = SrcOutputData%k + end if + if (allocated(SrcOutputData%k_p)) then + LB(1:2) = lbound(SrcOutputData%k_p) + UB(1:2) = ubound(SrcOutputData%k_p) + if (.not. allocated(DstOutputData%k_p)) then + allocate(DstOutputData%k_p(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%k_p.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%k_p = SrcOutputData%k_p + end if + if (allocated(SrcOutputData%F)) then + LB(1:2) = lbound(SrcOutputData%F) + UB(1:2) = ubound(SrcOutputData%F) + if (.not. allocated(DstOutputData%F)) then + allocate(DstOutputData%F(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%F.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%F = SrcOutputData%F + end if + if (allocated(SrcOutputData%Re)) then + LB(1:2) = lbound(SrcOutputData%Re) + UB(1:2) = ubound(SrcOutputData%Re) + if (.not. allocated(DstOutputData%Re)) then + allocate(DstOutputData%Re(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Re.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%Re = SrcOutputData%Re + end if + if (allocated(SrcOutputData%AOA)) then + LB(1:2) = lbound(SrcOutputData%AOA) + UB(1:2) = ubound(SrcOutputData%AOA) + if (.not. allocated(DstOutputData%AOA)) then + allocate(DstOutputData%AOA(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%AOA.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%AOA = SrcOutputData%AOA + end if + if (allocated(SrcOutputData%Cx)) then + LB(1:2) = lbound(SrcOutputData%Cx) + UB(1:2) = ubound(SrcOutputData%Cx) + if (.not. allocated(DstOutputData%Cx)) then + allocate(DstOutputData%Cx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Cx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%Cx = SrcOutputData%Cx + end if + if (allocated(SrcOutputData%Cy)) then + LB(1:2) = lbound(SrcOutputData%Cy) + UB(1:2) = ubound(SrcOutputData%Cy) + if (.not. allocated(DstOutputData%Cy)) then + allocate(DstOutputData%Cy(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Cy.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%Cy = SrcOutputData%Cy + end if + if (allocated(SrcOutputData%Cz)) then + LB(1:2) = lbound(SrcOutputData%Cz) + UB(1:2) = ubound(SrcOutputData%Cz) + if (.not. allocated(DstOutputData%Cz)) then + allocate(DstOutputData%Cz(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Cz.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%Cz = SrcOutputData%Cz + end if + if (allocated(SrcOutputData%Cmx)) then + LB(1:2) = lbound(SrcOutputData%Cmx) + UB(1:2) = ubound(SrcOutputData%Cmx) + if (.not. allocated(DstOutputData%Cmx)) then + allocate(DstOutputData%Cmx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Cmx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%Cmx = SrcOutputData%Cmx + end if + if (allocated(SrcOutputData%Cmy)) then + LB(1:2) = lbound(SrcOutputData%Cmy) + UB(1:2) = ubound(SrcOutputData%Cmy) + if (.not. allocated(DstOutputData%Cmy)) then + allocate(DstOutputData%Cmy(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Cmy.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%Cmy = SrcOutputData%Cmy + end if + if (allocated(SrcOutputData%Cmz)) then + LB(1:2) = lbound(SrcOutputData%Cmz) + UB(1:2) = ubound(SrcOutputData%Cmz) + if (.not. allocated(DstOutputData%Cmz)) then + allocate(DstOutputData%Cmz(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Cmz.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%Cmz = SrcOutputData%Cmz + end if + if (allocated(SrcOutputData%Cm)) then + LB(1:2) = lbound(SrcOutputData%Cm) + UB(1:2) = ubound(SrcOutputData%Cm) + if (.not. allocated(DstOutputData%Cm)) then + allocate(DstOutputData%Cm(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Cm.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%Cm = SrcOutputData%Cm + end if + if (allocated(SrcOutputData%Cl)) then + LB(1:2) = lbound(SrcOutputData%Cl) + UB(1:2) = ubound(SrcOutputData%Cl) + if (.not. allocated(DstOutputData%Cl)) then + allocate(DstOutputData%Cl(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Cl.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%Cl = SrcOutputData%Cl + end if + if (allocated(SrcOutputData%Cd)) then + LB(1:2) = lbound(SrcOutputData%Cd) + UB(1:2) = ubound(SrcOutputData%Cd) + if (.not. allocated(DstOutputData%Cd)) then + allocate(DstOutputData%Cd(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Cd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%Cd = SrcOutputData%Cd + end if + if (allocated(SrcOutputData%chi)) then + LB(1:2) = lbound(SrcOutputData%chi) + UB(1:2) = ubound(SrcOutputData%chi) + if (.not. allocated(DstOutputData%chi)) then + allocate(DstOutputData%chi(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%chi.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%chi = SrcOutputData%chi + end if + if (allocated(SrcOutputData%Cpmin)) then + LB(1:2) = lbound(SrcOutputData%Cpmin) + UB(1:2) = ubound(SrcOutputData%Cpmin) + if (.not. allocated(DstOutputData%Cpmin)) then + allocate(DstOutputData%Cpmin(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Cpmin.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%Cpmin = SrcOutputData%Cpmin + end if +end subroutine + +subroutine BEMT_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(BEMT_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'BEMT_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OutputData%Vrel)) then + deallocate(OutputData%Vrel) + end if + if (allocated(OutputData%phi)) then + deallocate(OutputData%phi) + end if + if (allocated(OutputData%axInduction)) then + deallocate(OutputData%axInduction) + end if + if (allocated(OutputData%tanInduction)) then + deallocate(OutputData%tanInduction) + end if + if (allocated(OutputData%axInduction_qs)) then + deallocate(OutputData%axInduction_qs) + end if + if (allocated(OutputData%tanInduction_qs)) then + deallocate(OutputData%tanInduction_qs) + end if + if (allocated(OutputData%k)) then + deallocate(OutputData%k) + end if + if (allocated(OutputData%k_p)) then + deallocate(OutputData%k_p) + end if + if (allocated(OutputData%F)) then + deallocate(OutputData%F) + end if + if (allocated(OutputData%Re)) then + deallocate(OutputData%Re) + end if + if (allocated(OutputData%AOA)) then + deallocate(OutputData%AOA) + end if + if (allocated(OutputData%Cx)) then + deallocate(OutputData%Cx) + end if + if (allocated(OutputData%Cy)) then + deallocate(OutputData%Cy) + end if + if (allocated(OutputData%Cz)) then + deallocate(OutputData%Cz) + end if + if (allocated(OutputData%Cmx)) then + deallocate(OutputData%Cmx) + end if + if (allocated(OutputData%Cmy)) then + deallocate(OutputData%Cmy) + end if + if (allocated(OutputData%Cmz)) then + deallocate(OutputData%Cmz) + end if + if (allocated(OutputData%Cm)) then + deallocate(OutputData%Cm) + end if + if (allocated(OutputData%Cl)) then + deallocate(OutputData%Cl) + end if + if (allocated(OutputData%Cd)) then + deallocate(OutputData%Cd) + end if + if (allocated(OutputData%chi)) then + deallocate(OutputData%chi) + end if + if (allocated(OutputData%Cpmin)) then + deallocate(OutputData%Cpmin) + end if +end subroutine + +subroutine BEMT_PackOutput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(BEMT_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'BEMT_PackOutput' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%Vrel) + call RegPackAlloc(RF, InData%phi) + call RegPackAlloc(RF, InData%axInduction) + call RegPackAlloc(RF, InData%tanInduction) + call RegPackAlloc(RF, InData%axInduction_qs) + call RegPackAlloc(RF, InData%tanInduction_qs) + call RegPackAlloc(RF, InData%k) + call RegPackAlloc(RF, InData%k_p) + call RegPackAlloc(RF, InData%F) + call RegPackAlloc(RF, InData%Re) + call RegPackAlloc(RF, InData%AOA) + call RegPackAlloc(RF, InData%Cx) + call RegPackAlloc(RF, InData%Cy) + call RegPackAlloc(RF, InData%Cz) + call RegPackAlloc(RF, InData%Cmx) + call RegPackAlloc(RF, InData%Cmy) + call RegPackAlloc(RF, InData%Cmz) + call RegPackAlloc(RF, InData%Cm) + call RegPackAlloc(RF, InData%Cl) + call RegPackAlloc(RF, InData%Cd) + call RegPackAlloc(RF, InData%chi) + call RegPackAlloc(RF, InData%Cpmin) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine BEMT_UnPackOutput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(BEMT_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'BEMT_UnPackOutput' + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%Vrel); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%phi); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%axInduction); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%tanInduction); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%axInduction_qs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%tanInduction_qs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%k); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%k_p); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%F); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Re); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AOA); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Cx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Cy); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Cz); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Cmx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Cmy); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Cmz); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Cm); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Cl); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Cd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%chi); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Cpmin); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine BEMT_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(BEMT_InputType), intent(in) :: u(:) ! Input at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Inputs + type(BEMT_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 = 'BEMT_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 BEMT_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL BEMT_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 BEMT_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 BEMT_Input_ExtrapInterp - - - SUBROUTINE BEMT_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'BEMT_Input_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(u)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(u)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(u) - 1 + select case (order) + case (0) + call BEMT_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call BEMT_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call BEMT_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(u) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE BEMT_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. @@ -7471,155 +2142,87 @@ SUBROUTINE BEMT_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ! !.................................................................................................................................. - TYPE(BEMT_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 - TYPE(BEMT_InputType), INTENT(IN) :: u2 ! Input at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs - TYPE(BEMT_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 + TYPE(BEMT_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 + TYPE(BEMT_InputType), INTENT(IN) :: u2 ! Input at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs + TYPE(BEMT_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 = 'BEMT_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 :: i02 ! dim2 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - INTEGER :: i2 ! dim2 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 + REAL(DbKi) :: t(2) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_Input_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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 :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 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%theta) .AND. ALLOCATED(u1%theta)) THEN - DO i2 = LBOUND(u_out%theta,2),UBOUND(u_out%theta,2) - DO i1 = LBOUND(u_out%theta,1),UBOUND(u_out%theta,1) - b = -(u1%theta(i1,i2) - u2%theta(i1,i2)) - u_out%theta(i1,i2) = u1%theta(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated - b = -(u1%chi0 - u2%chi0) - u_out%chi0 = u1%chi0 + b * ScaleFactor - b = -(u1%psiSkewOffset - u2%psiSkewOffset) - u_out%psiSkewOffset = u1%psiSkewOffset + b * ScaleFactor -IF (ALLOCATED(u_out%psi_s) .AND. ALLOCATED(u1%psi_s)) THEN - DO i1 = LBOUND(u_out%psi_s,1),UBOUND(u_out%psi_s,1) - b = -(u1%psi_s(i1) - u2%psi_s(i1)) - u_out%psi_s(i1) = u1%psi_s(i1) + b * ScaleFactor - END DO -END IF ! check if allocated - b = -(u1%omega - u2%omega) - u_out%omega = u1%omega + b * ScaleFactor - b = -(u1%TSR - u2%TSR) - u_out%TSR = u1%TSR + b * ScaleFactor -IF (ALLOCATED(u_out%Vx) .AND. ALLOCATED(u1%Vx)) THEN - DO i2 = LBOUND(u_out%Vx,2),UBOUND(u_out%Vx,2) - DO i1 = LBOUND(u_out%Vx,1),UBOUND(u_out%Vx,1) - b = -(u1%Vx(i1,i2) - u2%Vx(i1,i2)) - u_out%Vx(i1,i2) = u1%Vx(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%Vy) .AND. ALLOCATED(u1%Vy)) THEN - DO i2 = LBOUND(u_out%Vy,2),UBOUND(u_out%Vy,2) - DO i1 = LBOUND(u_out%Vy,1),UBOUND(u_out%Vy,1) - b = -(u1%Vy(i1,i2) - u2%Vy(i1,i2)) - u_out%Vy(i1,i2) = u1%Vy(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%Vz) .AND. ALLOCATED(u1%Vz)) THEN - DO i2 = LBOUND(u_out%Vz,2),UBOUND(u_out%Vz,2) - DO i1 = LBOUND(u_out%Vz,1),UBOUND(u_out%Vz,1) - b = -(u1%Vz(i1,i2) - u2%Vz(i1,i2)) - u_out%Vz(i1,i2) = u1%Vz(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%omega_z) .AND. ALLOCATED(u1%omega_z)) THEN - DO i2 = LBOUND(u_out%omega_z,2),UBOUND(u_out%omega_z,2) - DO i1 = LBOUND(u_out%omega_z,1),UBOUND(u_out%omega_z,1) - b = -(u1%omega_z(i1,i2) - u2%omega_z(i1,i2)) - u_out%omega_z(i1,i2) = u1%omega_z(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%xVelCorr) .AND. ALLOCATED(u1%xVelCorr)) THEN - DO i2 = LBOUND(u_out%xVelCorr,2),UBOUND(u_out%xVelCorr,2) - DO i1 = LBOUND(u_out%xVelCorr,1),UBOUND(u_out%xVelCorr,1) - b = -(u1%xVelCorr(i1,i2) - u2%xVelCorr(i1,i2)) - u_out%xVelCorr(i1,i2) = u1%xVelCorr(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%rLocal) .AND. ALLOCATED(u1%rLocal)) THEN - DO i2 = LBOUND(u_out%rLocal,2),UBOUND(u_out%rLocal,2) - DO i1 = LBOUND(u_out%rLocal,1),UBOUND(u_out%rLocal,1) - b = -(u1%rLocal(i1,i2) - u2%rLocal(i1,i2)) - u_out%rLocal(i1,i2) = u1%rLocal(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated - b = -(u1%Un_disk - u2%Un_disk) - u_out%Un_disk = u1%Un_disk + b * ScaleFactor - DO i1 = LBOUND(u_out%V0,1),UBOUND(u_out%V0,1) - b = -(u1%V0(i1) - u2%V0(i1)) - u_out%V0(i1) = u1%V0(i1) + b * ScaleFactor - END DO - DO i1 = LBOUND(u_out%x_hat_disk,1),UBOUND(u_out%x_hat_disk,1) - b = -(u1%x_hat_disk(i1) - u2%x_hat_disk(i1)) - u_out%x_hat_disk(i1) = u1%x_hat_disk(i1) + b * ScaleFactor - END DO -IF (ALLOCATED(u_out%UserProp) .AND. ALLOCATED(u1%UserProp)) THEN - DO i2 = LBOUND(u_out%UserProp,2),UBOUND(u_out%UserProp,2) - DO i1 = LBOUND(u_out%UserProp,1),UBOUND(u_out%UserProp,1) - b = -(u1%UserProp(i1,i2) - u2%UserProp(i1,i2)) - u_out%UserProp(i1,i2) = u1%UserProp(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%CantAngle) .AND. ALLOCATED(u1%CantAngle)) THEN - DO i2 = LBOUND(u_out%CantAngle,2),UBOUND(u_out%CantAngle,2) - DO i1 = LBOUND(u_out%CantAngle,1),UBOUND(u_out%CantAngle,1) - b = -(u1%CantAngle(i1,i2) - u2%CantAngle(i1,i2)) - u_out%CantAngle(i1,i2) = u1%CantAngle(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%drdz) .AND. ALLOCATED(u1%drdz)) THEN - DO i2 = LBOUND(u_out%drdz,2),UBOUND(u_out%drdz,2) - DO i1 = LBOUND(u_out%drdz,1),UBOUND(u_out%drdz,1) - b = -(u1%drdz(i1,i2) - u2%drdz(i1,i2)) - u_out%drdz(i1,i2) = u1%drdz(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%toeAngle) .AND. ALLOCATED(u1%toeAngle)) THEN - DO i2 = LBOUND(u_out%toeAngle,2),UBOUND(u_out%toeAngle,2) - DO i1 = LBOUND(u_out%toeAngle,1),UBOUND(u_out%toeAngle,1) - b = -(u1%toeAngle(i1,i2) - u2%toeAngle(i1,i2)) - u_out%toeAngle(i1,i2) = u1%toeAngle(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated - END SUBROUTINE BEMT_Input_ExtrapInterp1 - - - SUBROUTINE BEMT_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + IF (ALLOCATED(u_out%theta) .AND. ALLOCATED(u1%theta)) THEN + u_out%theta = a1*u1%theta + a2*u2%theta + END IF ! check if allocated + u_out%chi0 = a1*u1%chi0 + a2*u2%chi0 + u_out%psiSkewOffset = a1*u1%psiSkewOffset + a2*u2%psiSkewOffset + IF (ALLOCATED(u_out%psi_s) .AND. ALLOCATED(u1%psi_s)) THEN + u_out%psi_s = a1*u1%psi_s + a2*u2%psi_s + END IF ! check if allocated + u_out%omega = a1*u1%omega + a2*u2%omega + u_out%TSR = a1*u1%TSR + a2*u2%TSR + IF (ALLOCATED(u_out%Vx) .AND. ALLOCATED(u1%Vx)) THEN + u_out%Vx = a1*u1%Vx + a2*u2%Vx + END IF ! check if allocated + IF (ALLOCATED(u_out%Vy) .AND. ALLOCATED(u1%Vy)) THEN + u_out%Vy = a1*u1%Vy + a2*u2%Vy + END IF ! check if allocated + IF (ALLOCATED(u_out%Vz) .AND. ALLOCATED(u1%Vz)) THEN + u_out%Vz = a1*u1%Vz + a2*u2%Vz + END IF ! check if allocated + IF (ALLOCATED(u_out%omega_z) .AND. ALLOCATED(u1%omega_z)) THEN + u_out%omega_z = a1*u1%omega_z + a2*u2%omega_z + END IF ! check if allocated + IF (ALLOCATED(u_out%xVelCorr) .AND. ALLOCATED(u1%xVelCorr)) THEN + u_out%xVelCorr = a1*u1%xVelCorr + a2*u2%xVelCorr + END IF ! check if allocated + IF (ALLOCATED(u_out%rLocal) .AND. ALLOCATED(u1%rLocal)) THEN + u_out%rLocal = a1*u1%rLocal + a2*u2%rLocal + END IF ! check if allocated + u_out%Un_disk = a1*u1%Un_disk + a2*u2%Un_disk + u_out%V0 = a1*u1%V0 + a2*u2%V0 + u_out%x_hat_disk = a1*u1%x_hat_disk + a2*u2%x_hat_disk + IF (ALLOCATED(u_out%UserProp) .AND. ALLOCATED(u1%UserProp)) THEN + u_out%UserProp = a1*u1%UserProp + a2*u2%UserProp + END IF ! check if allocated + IF (ALLOCATED(u_out%CantAngle) .AND. ALLOCATED(u1%CantAngle)) THEN + u_out%CantAngle = a1*u1%CantAngle + a2*u2%CantAngle + END IF ! check if allocated + IF (ALLOCATED(u_out%drdz) .AND. ALLOCATED(u1%drdz)) THEN + u_out%drdz = a1*u1%drdz + a2*u2%drdz + END IF ! check if allocated + IF (ALLOCATED(u_out%toeAngle) .AND. ALLOCATED(u1%toeAngle)) THEN + u_out%toeAngle = a1*u1%toeAngle + a2*u2%toeAngle + END IF ! check if allocated +END SUBROUTINE + +SUBROUTINE BEMT_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. @@ -7633,234 +2236,147 @@ SUBROUTINE BEMT_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Er ! !.................................................................................................................................. - TYPE(BEMT_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 > t3 - TYPE(BEMT_InputType), INTENT(IN) :: u2 ! Input at t2 > t3 - TYPE(BEMT_InputType), INTENT(IN) :: u3 ! Input at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs - TYPE(BEMT_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 + TYPE(BEMT_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 > t3 + TYPE(BEMT_InputType), INTENT(IN) :: u2 ! Input at t2 > t3 + TYPE(BEMT_InputType), INTENT(IN) :: u3 ! Input at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs + TYPE(BEMT_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 = 'BEMT_Input_ExtrapInterp2' - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - INTEGER :: i2 ! dim2 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) - + 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) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_Input_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 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 + 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 + 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 + 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%theta) .AND. ALLOCATED(u1%theta)) THEN - DO i2 = LBOUND(u_out%theta,2),UBOUND(u_out%theta,2) - DO i1 = LBOUND(u_out%theta,1),UBOUND(u_out%theta,1) - b = (t(3)**2*(u1%theta(i1,i2) - u2%theta(i1,i2)) + t(2)**2*(-u1%theta(i1,i2) + u3%theta(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*u1%theta(i1,i2) + t(3)*u2%theta(i1,i2) - t(2)*u3%theta(i1,i2) ) * scaleFactor - u_out%theta(i1,i2) = u1%theta(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated - b = (t(3)**2*(u1%chi0 - u2%chi0) + t(2)**2*(-u1%chi0 + u3%chi0))* scaleFactor - c = ( (t(2)-t(3))*u1%chi0 + t(3)*u2%chi0 - t(2)*u3%chi0 ) * scaleFactor - u_out%chi0 = u1%chi0 + b + c * t_out - b = (t(3)**2*(u1%psiSkewOffset - u2%psiSkewOffset) + t(2)**2*(-u1%psiSkewOffset + u3%psiSkewOffset))* scaleFactor - c = ( (t(2)-t(3))*u1%psiSkewOffset + t(3)*u2%psiSkewOffset - t(2)*u3%psiSkewOffset ) * scaleFactor - u_out%psiSkewOffset = u1%psiSkewOffset + b + c * t_out -IF (ALLOCATED(u_out%psi_s) .AND. ALLOCATED(u1%psi_s)) THEN - DO i1 = LBOUND(u_out%psi_s,1),UBOUND(u_out%psi_s,1) - b = (t(3)**2*(u1%psi_s(i1) - u2%psi_s(i1)) + t(2)**2*(-u1%psi_s(i1) + u3%psi_s(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%psi_s(i1) + t(3)*u2%psi_s(i1) - t(2)*u3%psi_s(i1) ) * scaleFactor - u_out%psi_s(i1) = u1%psi_s(i1) + b + c * t_out - END DO -END IF ! check if allocated - b = (t(3)**2*(u1%omega - u2%omega) + t(2)**2*(-u1%omega + u3%omega))* scaleFactor - c = ( (t(2)-t(3))*u1%omega + t(3)*u2%omega - t(2)*u3%omega ) * scaleFactor - u_out%omega = u1%omega + b + c * t_out - b = (t(3)**2*(u1%TSR - u2%TSR) + t(2)**2*(-u1%TSR + u3%TSR))* scaleFactor - c = ( (t(2)-t(3))*u1%TSR + t(3)*u2%TSR - t(2)*u3%TSR ) * scaleFactor - u_out%TSR = u1%TSR + b + c * t_out -IF (ALLOCATED(u_out%Vx) .AND. ALLOCATED(u1%Vx)) THEN - DO i2 = LBOUND(u_out%Vx,2),UBOUND(u_out%Vx,2) - DO i1 = LBOUND(u_out%Vx,1),UBOUND(u_out%Vx,1) - b = (t(3)**2*(u1%Vx(i1,i2) - u2%Vx(i1,i2)) + t(2)**2*(-u1%Vx(i1,i2) + u3%Vx(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*u1%Vx(i1,i2) + t(3)*u2%Vx(i1,i2) - t(2)*u3%Vx(i1,i2) ) * scaleFactor - u_out%Vx(i1,i2) = u1%Vx(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%Vy) .AND. ALLOCATED(u1%Vy)) THEN - DO i2 = LBOUND(u_out%Vy,2),UBOUND(u_out%Vy,2) - DO i1 = LBOUND(u_out%Vy,1),UBOUND(u_out%Vy,1) - b = (t(3)**2*(u1%Vy(i1,i2) - u2%Vy(i1,i2)) + t(2)**2*(-u1%Vy(i1,i2) + u3%Vy(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*u1%Vy(i1,i2) + t(3)*u2%Vy(i1,i2) - t(2)*u3%Vy(i1,i2) ) * scaleFactor - u_out%Vy(i1,i2) = u1%Vy(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%Vz) .AND. ALLOCATED(u1%Vz)) THEN - DO i2 = LBOUND(u_out%Vz,2),UBOUND(u_out%Vz,2) - DO i1 = LBOUND(u_out%Vz,1),UBOUND(u_out%Vz,1) - b = (t(3)**2*(u1%Vz(i1,i2) - u2%Vz(i1,i2)) + t(2)**2*(-u1%Vz(i1,i2) + u3%Vz(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*u1%Vz(i1,i2) + t(3)*u2%Vz(i1,i2) - t(2)*u3%Vz(i1,i2) ) * scaleFactor - u_out%Vz(i1,i2) = u1%Vz(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%omega_z) .AND. ALLOCATED(u1%omega_z)) THEN - DO i2 = LBOUND(u_out%omega_z,2),UBOUND(u_out%omega_z,2) - DO i1 = LBOUND(u_out%omega_z,1),UBOUND(u_out%omega_z,1) - b = (t(3)**2*(u1%omega_z(i1,i2) - u2%omega_z(i1,i2)) + t(2)**2*(-u1%omega_z(i1,i2) + u3%omega_z(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*u1%omega_z(i1,i2) + t(3)*u2%omega_z(i1,i2) - t(2)*u3%omega_z(i1,i2) ) * scaleFactor - u_out%omega_z(i1,i2) = u1%omega_z(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%xVelCorr) .AND. ALLOCATED(u1%xVelCorr)) THEN - DO i2 = LBOUND(u_out%xVelCorr,2),UBOUND(u_out%xVelCorr,2) - DO i1 = LBOUND(u_out%xVelCorr,1),UBOUND(u_out%xVelCorr,1) - b = (t(3)**2*(u1%xVelCorr(i1,i2) - u2%xVelCorr(i1,i2)) + t(2)**2*(-u1%xVelCorr(i1,i2) + u3%xVelCorr(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*u1%xVelCorr(i1,i2) + t(3)*u2%xVelCorr(i1,i2) - t(2)*u3%xVelCorr(i1,i2) ) * scaleFactor - u_out%xVelCorr(i1,i2) = u1%xVelCorr(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%rLocal) .AND. ALLOCATED(u1%rLocal)) THEN - DO i2 = LBOUND(u_out%rLocal,2),UBOUND(u_out%rLocal,2) - DO i1 = LBOUND(u_out%rLocal,1),UBOUND(u_out%rLocal,1) - b = (t(3)**2*(u1%rLocal(i1,i2) - u2%rLocal(i1,i2)) + t(2)**2*(-u1%rLocal(i1,i2) + u3%rLocal(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*u1%rLocal(i1,i2) + t(3)*u2%rLocal(i1,i2) - t(2)*u3%rLocal(i1,i2) ) * scaleFactor - u_out%rLocal(i1,i2) = u1%rLocal(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated - b = (t(3)**2*(u1%Un_disk - u2%Un_disk) + t(2)**2*(-u1%Un_disk + u3%Un_disk))* scaleFactor - c = ( (t(2)-t(3))*u1%Un_disk + t(3)*u2%Un_disk - t(2)*u3%Un_disk ) * scaleFactor - u_out%Un_disk = u1%Un_disk + b + c * t_out - DO i1 = LBOUND(u_out%V0,1),UBOUND(u_out%V0,1) - b = (t(3)**2*(u1%V0(i1) - u2%V0(i1)) + t(2)**2*(-u1%V0(i1) + u3%V0(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%V0(i1) + t(3)*u2%V0(i1) - t(2)*u3%V0(i1) ) * scaleFactor - u_out%V0(i1) = u1%V0(i1) + b + c * t_out - END DO - DO i1 = LBOUND(u_out%x_hat_disk,1),UBOUND(u_out%x_hat_disk,1) - b = (t(3)**2*(u1%x_hat_disk(i1) - u2%x_hat_disk(i1)) + t(2)**2*(-u1%x_hat_disk(i1) + u3%x_hat_disk(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%x_hat_disk(i1) + t(3)*u2%x_hat_disk(i1) - t(2)*u3%x_hat_disk(i1) ) * scaleFactor - u_out%x_hat_disk(i1) = u1%x_hat_disk(i1) + b + c * t_out - END DO -IF (ALLOCATED(u_out%UserProp) .AND. ALLOCATED(u1%UserProp)) THEN - DO i2 = LBOUND(u_out%UserProp,2),UBOUND(u_out%UserProp,2) - DO i1 = LBOUND(u_out%UserProp,1),UBOUND(u_out%UserProp,1) - b = (t(3)**2*(u1%UserProp(i1,i2) - u2%UserProp(i1,i2)) + t(2)**2*(-u1%UserProp(i1,i2) + u3%UserProp(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*u1%UserProp(i1,i2) + t(3)*u2%UserProp(i1,i2) - t(2)*u3%UserProp(i1,i2) ) * scaleFactor - u_out%UserProp(i1,i2) = u1%UserProp(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%CantAngle) .AND. ALLOCATED(u1%CantAngle)) THEN - DO i2 = LBOUND(u_out%CantAngle,2),UBOUND(u_out%CantAngle,2) - DO i1 = LBOUND(u_out%CantAngle,1),UBOUND(u_out%CantAngle,1) - b = (t(3)**2*(u1%CantAngle(i1,i2) - u2%CantAngle(i1,i2)) + t(2)**2*(-u1%CantAngle(i1,i2) + u3%CantAngle(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*u1%CantAngle(i1,i2) + t(3)*u2%CantAngle(i1,i2) - t(2)*u3%CantAngle(i1,i2) ) * scaleFactor - u_out%CantAngle(i1,i2) = u1%CantAngle(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%drdz) .AND. ALLOCATED(u1%drdz)) THEN - DO i2 = LBOUND(u_out%drdz,2),UBOUND(u_out%drdz,2) - DO i1 = LBOUND(u_out%drdz,1),UBOUND(u_out%drdz,1) - b = (t(3)**2*(u1%drdz(i1,i2) - u2%drdz(i1,i2)) + t(2)**2*(-u1%drdz(i1,i2) + u3%drdz(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*u1%drdz(i1,i2) + t(3)*u2%drdz(i1,i2) - t(2)*u3%drdz(i1,i2) ) * scaleFactor - u_out%drdz(i1,i2) = u1%drdz(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%toeAngle) .AND. ALLOCATED(u1%toeAngle)) THEN - DO i2 = LBOUND(u_out%toeAngle,2),UBOUND(u_out%toeAngle,2) - DO i1 = LBOUND(u_out%toeAngle,1),UBOUND(u_out%toeAngle,1) - b = (t(3)**2*(u1%toeAngle(i1,i2) - u2%toeAngle(i1,i2)) + t(2)**2*(-u1%toeAngle(i1,i2) + u3%toeAngle(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*u1%toeAngle(i1,i2) + t(3)*u2%toeAngle(i1,i2) - t(2)*u3%toeAngle(i1,i2) ) * scaleFactor - u_out%toeAngle(i1,i2) = u1%toeAngle(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated - END SUBROUTINE BEMT_Input_ExtrapInterp2 - - - SUBROUTINE BEMT_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(BEMT_OutputType), INTENT(IN) :: y(:) ! Output at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Outputs - TYPE(BEMT_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 + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + IF (ALLOCATED(u_out%theta) .AND. ALLOCATED(u1%theta)) THEN + u_out%theta = a1*u1%theta + a2*u2%theta + a3*u3%theta + END IF ! check if allocated + u_out%chi0 = a1*u1%chi0 + a2*u2%chi0 + a3*u3%chi0 + u_out%psiSkewOffset = a1*u1%psiSkewOffset + a2*u2%psiSkewOffset + a3*u3%psiSkewOffset + IF (ALLOCATED(u_out%psi_s) .AND. ALLOCATED(u1%psi_s)) THEN + u_out%psi_s = a1*u1%psi_s + a2*u2%psi_s + a3*u3%psi_s + END IF ! check if allocated + u_out%omega = a1*u1%omega + a2*u2%omega + a3*u3%omega + u_out%TSR = a1*u1%TSR + a2*u2%TSR + a3*u3%TSR + IF (ALLOCATED(u_out%Vx) .AND. ALLOCATED(u1%Vx)) THEN + u_out%Vx = a1*u1%Vx + a2*u2%Vx + a3*u3%Vx + END IF ! check if allocated + IF (ALLOCATED(u_out%Vy) .AND. ALLOCATED(u1%Vy)) THEN + u_out%Vy = a1*u1%Vy + a2*u2%Vy + a3*u3%Vy + END IF ! check if allocated + IF (ALLOCATED(u_out%Vz) .AND. ALLOCATED(u1%Vz)) THEN + u_out%Vz = a1*u1%Vz + a2*u2%Vz + a3*u3%Vz + END IF ! check if allocated + IF (ALLOCATED(u_out%omega_z) .AND. ALLOCATED(u1%omega_z)) THEN + u_out%omega_z = a1*u1%omega_z + a2*u2%omega_z + a3*u3%omega_z + END IF ! check if allocated + IF (ALLOCATED(u_out%xVelCorr) .AND. ALLOCATED(u1%xVelCorr)) THEN + u_out%xVelCorr = a1*u1%xVelCorr + a2*u2%xVelCorr + a3*u3%xVelCorr + END IF ! check if allocated + IF (ALLOCATED(u_out%rLocal) .AND. ALLOCATED(u1%rLocal)) THEN + u_out%rLocal = a1*u1%rLocal + a2*u2%rLocal + a3*u3%rLocal + END IF ! check if allocated + u_out%Un_disk = a1*u1%Un_disk + a2*u2%Un_disk + a3*u3%Un_disk + u_out%V0 = a1*u1%V0 + a2*u2%V0 + a3*u3%V0 + u_out%x_hat_disk = a1*u1%x_hat_disk + a2*u2%x_hat_disk + a3*u3%x_hat_disk + IF (ALLOCATED(u_out%UserProp) .AND. ALLOCATED(u1%UserProp)) THEN + u_out%UserProp = a1*u1%UserProp + a2*u2%UserProp + a3*u3%UserProp + END IF ! check if allocated + IF (ALLOCATED(u_out%CantAngle) .AND. ALLOCATED(u1%CantAngle)) THEN + u_out%CantAngle = a1*u1%CantAngle + a2*u2%CantAngle + a3*u3%CantAngle + END IF ! check if allocated + IF (ALLOCATED(u_out%drdz) .AND. ALLOCATED(u1%drdz)) THEN + u_out%drdz = a1*u1%drdz + a2*u2%drdz + a3*u3%drdz + END IF ! check if allocated + IF (ALLOCATED(u_out%toeAngle) .AND. ALLOCATED(u1%toeAngle)) THEN + u_out%toeAngle = a1*u1%toeAngle + a2*u2%toeAngle + a3*u3%toeAngle + END IF ! check if allocated +END SUBROUTINE + +subroutine BEMT_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(BEMT_OutputType), intent(in) :: y(:) ! Output at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Outputs + type(BEMT_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 = 'BEMT_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 BEMT_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL BEMT_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 BEMT_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 BEMT_Output_ExtrapInterp - - - SUBROUTINE BEMT_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'BEMT_Output_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(y)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(y)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(y) - 1 + select case (order) + case (0) + call BEMT_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call BEMT_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call BEMT_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(y) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE BEMT_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. @@ -7872,219 +2388,110 @@ SUBROUTINE BEMT_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMs ! !.................................................................................................................................. - TYPE(BEMT_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 - TYPE(BEMT_OutputType), INTENT(IN) :: y2 ! Output at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs - TYPE(BEMT_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 + TYPE(BEMT_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 + TYPE(BEMT_OutputType), INTENT(IN) :: y2 ! Output at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs + TYPE(BEMT_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 = 'BEMT_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 :: i02 ! dim2 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - INTEGER :: i2 ! dim2 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 + REAL(DbKi) :: t(2) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_Output_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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 :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 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%Vrel) .AND. ALLOCATED(y1%Vrel)) THEN - DO i2 = LBOUND(y_out%Vrel,2),UBOUND(y_out%Vrel,2) - DO i1 = LBOUND(y_out%Vrel,1),UBOUND(y_out%Vrel,1) - b = -(y1%Vrel(i1,i2) - y2%Vrel(i1,i2)) - y_out%Vrel(i1,i2) = y1%Vrel(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%phi) .AND. ALLOCATED(y1%phi)) THEN - DO i2 = LBOUND(y_out%phi,2),UBOUND(y_out%phi,2) - DO i1 = LBOUND(y_out%phi,1),UBOUND(y_out%phi,1) - b = -(y1%phi(i1,i2) - y2%phi(i1,i2)) - y_out%phi(i1,i2) = y1%phi(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%axInduction) .AND. ALLOCATED(y1%axInduction)) THEN - DO i2 = LBOUND(y_out%axInduction,2),UBOUND(y_out%axInduction,2) - DO i1 = LBOUND(y_out%axInduction,1),UBOUND(y_out%axInduction,1) - b = -(y1%axInduction(i1,i2) - y2%axInduction(i1,i2)) - y_out%axInduction(i1,i2) = y1%axInduction(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%tanInduction) .AND. ALLOCATED(y1%tanInduction)) THEN - DO i2 = LBOUND(y_out%tanInduction,2),UBOUND(y_out%tanInduction,2) - DO i1 = LBOUND(y_out%tanInduction,1),UBOUND(y_out%tanInduction,1) - b = -(y1%tanInduction(i1,i2) - y2%tanInduction(i1,i2)) - y_out%tanInduction(i1,i2) = y1%tanInduction(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%axInduction_qs) .AND. ALLOCATED(y1%axInduction_qs)) THEN - DO i2 = LBOUND(y_out%axInduction_qs,2),UBOUND(y_out%axInduction_qs,2) - DO i1 = LBOUND(y_out%axInduction_qs,1),UBOUND(y_out%axInduction_qs,1) - b = -(y1%axInduction_qs(i1,i2) - y2%axInduction_qs(i1,i2)) - y_out%axInduction_qs(i1,i2) = y1%axInduction_qs(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%tanInduction_qs) .AND. ALLOCATED(y1%tanInduction_qs)) THEN - DO i2 = LBOUND(y_out%tanInduction_qs,2),UBOUND(y_out%tanInduction_qs,2) - DO i1 = LBOUND(y_out%tanInduction_qs,1),UBOUND(y_out%tanInduction_qs,1) - b = -(y1%tanInduction_qs(i1,i2) - y2%tanInduction_qs(i1,i2)) - y_out%tanInduction_qs(i1,i2) = y1%tanInduction_qs(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%k) .AND. ALLOCATED(y1%k)) THEN - DO i2 = LBOUND(y_out%k,2),UBOUND(y_out%k,2) - DO i1 = LBOUND(y_out%k,1),UBOUND(y_out%k,1) - b = -(y1%k(i1,i2) - y2%k(i1,i2)) - y_out%k(i1,i2) = y1%k(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%k_p) .AND. ALLOCATED(y1%k_p)) THEN - DO i2 = LBOUND(y_out%k_p,2),UBOUND(y_out%k_p,2) - DO i1 = LBOUND(y_out%k_p,1),UBOUND(y_out%k_p,1) - b = -(y1%k_p(i1,i2) - y2%k_p(i1,i2)) - y_out%k_p(i1,i2) = y1%k_p(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%F) .AND. ALLOCATED(y1%F)) THEN - DO i2 = LBOUND(y_out%F,2),UBOUND(y_out%F,2) - DO i1 = LBOUND(y_out%F,1),UBOUND(y_out%F,1) - b = -(y1%F(i1,i2) - y2%F(i1,i2)) - y_out%F(i1,i2) = y1%F(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%Re) .AND. ALLOCATED(y1%Re)) THEN - DO i2 = LBOUND(y_out%Re,2),UBOUND(y_out%Re,2) - DO i1 = LBOUND(y_out%Re,1),UBOUND(y_out%Re,1) - b = -(y1%Re(i1,i2) - y2%Re(i1,i2)) - y_out%Re(i1,i2) = y1%Re(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%AOA) .AND. ALLOCATED(y1%AOA)) THEN - DO i2 = LBOUND(y_out%AOA,2),UBOUND(y_out%AOA,2) - DO i1 = LBOUND(y_out%AOA,1),UBOUND(y_out%AOA,1) - b = -(y1%AOA(i1,i2) - y2%AOA(i1,i2)) - y_out%AOA(i1,i2) = y1%AOA(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%Cx) .AND. ALLOCATED(y1%Cx)) THEN - DO i2 = LBOUND(y_out%Cx,2),UBOUND(y_out%Cx,2) - DO i1 = LBOUND(y_out%Cx,1),UBOUND(y_out%Cx,1) - b = -(y1%Cx(i1,i2) - y2%Cx(i1,i2)) - y_out%Cx(i1,i2) = y1%Cx(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%Cy) .AND. ALLOCATED(y1%Cy)) THEN - DO i2 = LBOUND(y_out%Cy,2),UBOUND(y_out%Cy,2) - DO i1 = LBOUND(y_out%Cy,1),UBOUND(y_out%Cy,1) - b = -(y1%Cy(i1,i2) - y2%Cy(i1,i2)) - y_out%Cy(i1,i2) = y1%Cy(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%Cz) .AND. ALLOCATED(y1%Cz)) THEN - DO i2 = LBOUND(y_out%Cz,2),UBOUND(y_out%Cz,2) - DO i1 = LBOUND(y_out%Cz,1),UBOUND(y_out%Cz,1) - b = -(y1%Cz(i1,i2) - y2%Cz(i1,i2)) - y_out%Cz(i1,i2) = y1%Cz(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%Cmx) .AND. ALLOCATED(y1%Cmx)) THEN - DO i2 = LBOUND(y_out%Cmx,2),UBOUND(y_out%Cmx,2) - DO i1 = LBOUND(y_out%Cmx,1),UBOUND(y_out%Cmx,1) - b = -(y1%Cmx(i1,i2) - y2%Cmx(i1,i2)) - y_out%Cmx(i1,i2) = y1%Cmx(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%Cmy) .AND. ALLOCATED(y1%Cmy)) THEN - DO i2 = LBOUND(y_out%Cmy,2),UBOUND(y_out%Cmy,2) - DO i1 = LBOUND(y_out%Cmy,1),UBOUND(y_out%Cmy,1) - b = -(y1%Cmy(i1,i2) - y2%Cmy(i1,i2)) - y_out%Cmy(i1,i2) = y1%Cmy(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%Cmz) .AND. ALLOCATED(y1%Cmz)) THEN - DO i2 = LBOUND(y_out%Cmz,2),UBOUND(y_out%Cmz,2) - DO i1 = LBOUND(y_out%Cmz,1),UBOUND(y_out%Cmz,1) - b = -(y1%Cmz(i1,i2) - y2%Cmz(i1,i2)) - y_out%Cmz(i1,i2) = y1%Cmz(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%Cm) .AND. ALLOCATED(y1%Cm)) THEN - DO i2 = LBOUND(y_out%Cm,2),UBOUND(y_out%Cm,2) - DO i1 = LBOUND(y_out%Cm,1),UBOUND(y_out%Cm,1) - b = -(y1%Cm(i1,i2) - y2%Cm(i1,i2)) - y_out%Cm(i1,i2) = y1%Cm(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%Cl) .AND. ALLOCATED(y1%Cl)) THEN - DO i2 = LBOUND(y_out%Cl,2),UBOUND(y_out%Cl,2) - DO i1 = LBOUND(y_out%Cl,1),UBOUND(y_out%Cl,1) - b = -(y1%Cl(i1,i2) - y2%Cl(i1,i2)) - y_out%Cl(i1,i2) = y1%Cl(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%Cd) .AND. ALLOCATED(y1%Cd)) THEN - DO i2 = LBOUND(y_out%Cd,2),UBOUND(y_out%Cd,2) - DO i1 = LBOUND(y_out%Cd,1),UBOUND(y_out%Cd,1) - b = -(y1%Cd(i1,i2) - y2%Cd(i1,i2)) - y_out%Cd(i1,i2) = y1%Cd(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%chi) .AND. ALLOCATED(y1%chi)) THEN - DO i2 = LBOUND(y_out%chi,2),UBOUND(y_out%chi,2) - DO i1 = LBOUND(y_out%chi,1),UBOUND(y_out%chi,1) - b = -(y1%chi(i1,i2) - y2%chi(i1,i2)) - y_out%chi(i1,i2) = y1%chi(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%Cpmin) .AND. ALLOCATED(y1%Cpmin)) THEN - DO i2 = LBOUND(y_out%Cpmin,2),UBOUND(y_out%Cpmin,2) - DO i1 = LBOUND(y_out%Cpmin,1),UBOUND(y_out%Cpmin,1) - b = -(y1%Cpmin(i1,i2) - y2%Cpmin(i1,i2)) - y_out%Cpmin(i1,i2) = y1%Cpmin(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated - END SUBROUTINE BEMT_Output_ExtrapInterp1 - - - SUBROUTINE BEMT_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + IF (ALLOCATED(y_out%Vrel) .AND. ALLOCATED(y1%Vrel)) THEN + y_out%Vrel = a1*y1%Vrel + a2*y2%Vrel + END IF ! check if allocated + IF (ALLOCATED(y_out%phi) .AND. ALLOCATED(y1%phi)) THEN + y_out%phi = a1*y1%phi + a2*y2%phi + END IF ! check if allocated + IF (ALLOCATED(y_out%axInduction) .AND. ALLOCATED(y1%axInduction)) THEN + y_out%axInduction = a1*y1%axInduction + a2*y2%axInduction + END IF ! check if allocated + IF (ALLOCATED(y_out%tanInduction) .AND. ALLOCATED(y1%tanInduction)) THEN + y_out%tanInduction = a1*y1%tanInduction + a2*y2%tanInduction + END IF ! check if allocated + IF (ALLOCATED(y_out%axInduction_qs) .AND. ALLOCATED(y1%axInduction_qs)) THEN + y_out%axInduction_qs = a1*y1%axInduction_qs + a2*y2%axInduction_qs + END IF ! check if allocated + IF (ALLOCATED(y_out%tanInduction_qs) .AND. ALLOCATED(y1%tanInduction_qs)) THEN + y_out%tanInduction_qs = a1*y1%tanInduction_qs + a2*y2%tanInduction_qs + END IF ! check if allocated + IF (ALLOCATED(y_out%k) .AND. ALLOCATED(y1%k)) THEN + y_out%k = a1*y1%k + a2*y2%k + END IF ! check if allocated + IF (ALLOCATED(y_out%k_p) .AND. ALLOCATED(y1%k_p)) THEN + y_out%k_p = a1*y1%k_p + a2*y2%k_p + END IF ! check if allocated + IF (ALLOCATED(y_out%F) .AND. ALLOCATED(y1%F)) THEN + y_out%F = a1*y1%F + a2*y2%F + END IF ! check if allocated + IF (ALLOCATED(y_out%Re) .AND. ALLOCATED(y1%Re)) THEN + y_out%Re = a1*y1%Re + a2*y2%Re + END IF ! check if allocated + IF (ALLOCATED(y_out%AOA) .AND. ALLOCATED(y1%AOA)) THEN + y_out%AOA = a1*y1%AOA + a2*y2%AOA + END IF ! check if allocated + IF (ALLOCATED(y_out%Cx) .AND. ALLOCATED(y1%Cx)) THEN + y_out%Cx = a1*y1%Cx + a2*y2%Cx + END IF ! check if allocated + IF (ALLOCATED(y_out%Cy) .AND. ALLOCATED(y1%Cy)) THEN + y_out%Cy = a1*y1%Cy + a2*y2%Cy + END IF ! check if allocated + IF (ALLOCATED(y_out%Cz) .AND. ALLOCATED(y1%Cz)) THEN + y_out%Cz = a1*y1%Cz + a2*y2%Cz + END IF ! check if allocated + IF (ALLOCATED(y_out%Cmx) .AND. ALLOCATED(y1%Cmx)) THEN + y_out%Cmx = a1*y1%Cmx + a2*y2%Cmx + END IF ! check if allocated + IF (ALLOCATED(y_out%Cmy) .AND. ALLOCATED(y1%Cmy)) THEN + y_out%Cmy = a1*y1%Cmy + a2*y2%Cmy + END IF ! check if allocated + IF (ALLOCATED(y_out%Cmz) .AND. ALLOCATED(y1%Cmz)) THEN + y_out%Cmz = a1*y1%Cmz + a2*y2%Cmz + END IF ! check if allocated + IF (ALLOCATED(y_out%Cm) .AND. ALLOCATED(y1%Cm)) THEN + y_out%Cm = a1*y1%Cm + a2*y2%Cm + END IF ! check if allocated + IF (ALLOCATED(y_out%Cl) .AND. ALLOCATED(y1%Cl)) THEN + y_out%Cl = a1*y1%Cl + a2*y2%Cl + END IF ! check if allocated + IF (ALLOCATED(y_out%Cd) .AND. ALLOCATED(y1%Cd)) THEN + y_out%Cd = a1*y1%Cd + a2*y2%Cd + END IF ! check if allocated + IF (ALLOCATED(y_out%chi) .AND. ALLOCATED(y1%chi)) THEN + y_out%chi = a1*y1%chi + a2*y2%chi + END IF ! check if allocated + IF (ALLOCATED(y_out%Cpmin) .AND. ALLOCATED(y1%Cpmin)) THEN + y_out%Cpmin = a1*y1%Cpmin + a2*y2%Cpmin + END IF ! check if allocated +END SUBROUTINE + +SUBROUTINE BEMT_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. @@ -8098,247 +2505,115 @@ SUBROUTINE BEMT_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, E ! !.................................................................................................................................. - TYPE(BEMT_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 > t3 - TYPE(BEMT_OutputType), INTENT(IN) :: y2 ! Output at t2 > t3 - TYPE(BEMT_OutputType), INTENT(IN) :: y3 ! Output at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs - TYPE(BEMT_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 + TYPE(BEMT_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 > t3 + TYPE(BEMT_OutputType), INTENT(IN) :: y2 ! Output at t2 > t3 + TYPE(BEMT_OutputType), INTENT(IN) :: y3 ! Output at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs + TYPE(BEMT_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 = 'BEMT_Output_ExtrapInterp2' - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - INTEGER :: i2 ! dim2 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) - + 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) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 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 + 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 + 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 + 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%Vrel) .AND. ALLOCATED(y1%Vrel)) THEN - DO i2 = LBOUND(y_out%Vrel,2),UBOUND(y_out%Vrel,2) - DO i1 = LBOUND(y_out%Vrel,1),UBOUND(y_out%Vrel,1) - b = (t(3)**2*(y1%Vrel(i1,i2) - y2%Vrel(i1,i2)) + t(2)**2*(-y1%Vrel(i1,i2) + y3%Vrel(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*y1%Vrel(i1,i2) + t(3)*y2%Vrel(i1,i2) - t(2)*y3%Vrel(i1,i2) ) * scaleFactor - y_out%Vrel(i1,i2) = y1%Vrel(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%phi) .AND. ALLOCATED(y1%phi)) THEN - DO i2 = LBOUND(y_out%phi,2),UBOUND(y_out%phi,2) - DO i1 = LBOUND(y_out%phi,1),UBOUND(y_out%phi,1) - b = (t(3)**2*(y1%phi(i1,i2) - y2%phi(i1,i2)) + t(2)**2*(-y1%phi(i1,i2) + y3%phi(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*y1%phi(i1,i2) + t(3)*y2%phi(i1,i2) - t(2)*y3%phi(i1,i2) ) * scaleFactor - y_out%phi(i1,i2) = y1%phi(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%axInduction) .AND. ALLOCATED(y1%axInduction)) THEN - DO i2 = LBOUND(y_out%axInduction,2),UBOUND(y_out%axInduction,2) - DO i1 = LBOUND(y_out%axInduction,1),UBOUND(y_out%axInduction,1) - b = (t(3)**2*(y1%axInduction(i1,i2) - y2%axInduction(i1,i2)) + t(2)**2*(-y1%axInduction(i1,i2) + y3%axInduction(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*y1%axInduction(i1,i2) + t(3)*y2%axInduction(i1,i2) - t(2)*y3%axInduction(i1,i2) ) * scaleFactor - y_out%axInduction(i1,i2) = y1%axInduction(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%tanInduction) .AND. ALLOCATED(y1%tanInduction)) THEN - DO i2 = LBOUND(y_out%tanInduction,2),UBOUND(y_out%tanInduction,2) - DO i1 = LBOUND(y_out%tanInduction,1),UBOUND(y_out%tanInduction,1) - b = (t(3)**2*(y1%tanInduction(i1,i2) - y2%tanInduction(i1,i2)) + t(2)**2*(-y1%tanInduction(i1,i2) + y3%tanInduction(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*y1%tanInduction(i1,i2) + t(3)*y2%tanInduction(i1,i2) - t(2)*y3%tanInduction(i1,i2) ) * scaleFactor - y_out%tanInduction(i1,i2) = y1%tanInduction(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%axInduction_qs) .AND. ALLOCATED(y1%axInduction_qs)) THEN - DO i2 = LBOUND(y_out%axInduction_qs,2),UBOUND(y_out%axInduction_qs,2) - DO i1 = LBOUND(y_out%axInduction_qs,1),UBOUND(y_out%axInduction_qs,1) - b = (t(3)**2*(y1%axInduction_qs(i1,i2) - y2%axInduction_qs(i1,i2)) + t(2)**2*(-y1%axInduction_qs(i1,i2) + y3%axInduction_qs(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*y1%axInduction_qs(i1,i2) + t(3)*y2%axInduction_qs(i1,i2) - t(2)*y3%axInduction_qs(i1,i2) ) * scaleFactor - y_out%axInduction_qs(i1,i2) = y1%axInduction_qs(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%tanInduction_qs) .AND. ALLOCATED(y1%tanInduction_qs)) THEN - DO i2 = LBOUND(y_out%tanInduction_qs,2),UBOUND(y_out%tanInduction_qs,2) - DO i1 = LBOUND(y_out%tanInduction_qs,1),UBOUND(y_out%tanInduction_qs,1) - b = (t(3)**2*(y1%tanInduction_qs(i1,i2) - y2%tanInduction_qs(i1,i2)) + t(2)**2*(-y1%tanInduction_qs(i1,i2) + y3%tanInduction_qs(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*y1%tanInduction_qs(i1,i2) + t(3)*y2%tanInduction_qs(i1,i2) - t(2)*y3%tanInduction_qs(i1,i2) ) * scaleFactor - y_out%tanInduction_qs(i1,i2) = y1%tanInduction_qs(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%k) .AND. ALLOCATED(y1%k)) THEN - DO i2 = LBOUND(y_out%k,2),UBOUND(y_out%k,2) - DO i1 = LBOUND(y_out%k,1),UBOUND(y_out%k,1) - b = (t(3)**2*(y1%k(i1,i2) - y2%k(i1,i2)) + t(2)**2*(-y1%k(i1,i2) + y3%k(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*y1%k(i1,i2) + t(3)*y2%k(i1,i2) - t(2)*y3%k(i1,i2) ) * scaleFactor - y_out%k(i1,i2) = y1%k(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%k_p) .AND. ALLOCATED(y1%k_p)) THEN - DO i2 = LBOUND(y_out%k_p,2),UBOUND(y_out%k_p,2) - DO i1 = LBOUND(y_out%k_p,1),UBOUND(y_out%k_p,1) - b = (t(3)**2*(y1%k_p(i1,i2) - y2%k_p(i1,i2)) + t(2)**2*(-y1%k_p(i1,i2) + y3%k_p(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*y1%k_p(i1,i2) + t(3)*y2%k_p(i1,i2) - t(2)*y3%k_p(i1,i2) ) * scaleFactor - y_out%k_p(i1,i2) = y1%k_p(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%F) .AND. ALLOCATED(y1%F)) THEN - DO i2 = LBOUND(y_out%F,2),UBOUND(y_out%F,2) - DO i1 = LBOUND(y_out%F,1),UBOUND(y_out%F,1) - b = (t(3)**2*(y1%F(i1,i2) - y2%F(i1,i2)) + t(2)**2*(-y1%F(i1,i2) + y3%F(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*y1%F(i1,i2) + t(3)*y2%F(i1,i2) - t(2)*y3%F(i1,i2) ) * scaleFactor - y_out%F(i1,i2) = y1%F(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%Re) .AND. ALLOCATED(y1%Re)) THEN - DO i2 = LBOUND(y_out%Re,2),UBOUND(y_out%Re,2) - DO i1 = LBOUND(y_out%Re,1),UBOUND(y_out%Re,1) - b = (t(3)**2*(y1%Re(i1,i2) - y2%Re(i1,i2)) + t(2)**2*(-y1%Re(i1,i2) + y3%Re(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*y1%Re(i1,i2) + t(3)*y2%Re(i1,i2) - t(2)*y3%Re(i1,i2) ) * scaleFactor - y_out%Re(i1,i2) = y1%Re(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%AOA) .AND. ALLOCATED(y1%AOA)) THEN - DO i2 = LBOUND(y_out%AOA,2),UBOUND(y_out%AOA,2) - DO i1 = LBOUND(y_out%AOA,1),UBOUND(y_out%AOA,1) - b = (t(3)**2*(y1%AOA(i1,i2) - y2%AOA(i1,i2)) + t(2)**2*(-y1%AOA(i1,i2) + y3%AOA(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*y1%AOA(i1,i2) + t(3)*y2%AOA(i1,i2) - t(2)*y3%AOA(i1,i2) ) * scaleFactor - y_out%AOA(i1,i2) = y1%AOA(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%Cx) .AND. ALLOCATED(y1%Cx)) THEN - DO i2 = LBOUND(y_out%Cx,2),UBOUND(y_out%Cx,2) - DO i1 = LBOUND(y_out%Cx,1),UBOUND(y_out%Cx,1) - b = (t(3)**2*(y1%Cx(i1,i2) - y2%Cx(i1,i2)) + t(2)**2*(-y1%Cx(i1,i2) + y3%Cx(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*y1%Cx(i1,i2) + t(3)*y2%Cx(i1,i2) - t(2)*y3%Cx(i1,i2) ) * scaleFactor - y_out%Cx(i1,i2) = y1%Cx(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%Cy) .AND. ALLOCATED(y1%Cy)) THEN - DO i2 = LBOUND(y_out%Cy,2),UBOUND(y_out%Cy,2) - DO i1 = LBOUND(y_out%Cy,1),UBOUND(y_out%Cy,1) - b = (t(3)**2*(y1%Cy(i1,i2) - y2%Cy(i1,i2)) + t(2)**2*(-y1%Cy(i1,i2) + y3%Cy(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*y1%Cy(i1,i2) + t(3)*y2%Cy(i1,i2) - t(2)*y3%Cy(i1,i2) ) * scaleFactor - y_out%Cy(i1,i2) = y1%Cy(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%Cz) .AND. ALLOCATED(y1%Cz)) THEN - DO i2 = LBOUND(y_out%Cz,2),UBOUND(y_out%Cz,2) - DO i1 = LBOUND(y_out%Cz,1),UBOUND(y_out%Cz,1) - b = (t(3)**2*(y1%Cz(i1,i2) - y2%Cz(i1,i2)) + t(2)**2*(-y1%Cz(i1,i2) + y3%Cz(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*y1%Cz(i1,i2) + t(3)*y2%Cz(i1,i2) - t(2)*y3%Cz(i1,i2) ) * scaleFactor - y_out%Cz(i1,i2) = y1%Cz(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%Cmx) .AND. ALLOCATED(y1%Cmx)) THEN - DO i2 = LBOUND(y_out%Cmx,2),UBOUND(y_out%Cmx,2) - DO i1 = LBOUND(y_out%Cmx,1),UBOUND(y_out%Cmx,1) - b = (t(3)**2*(y1%Cmx(i1,i2) - y2%Cmx(i1,i2)) + t(2)**2*(-y1%Cmx(i1,i2) + y3%Cmx(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*y1%Cmx(i1,i2) + t(3)*y2%Cmx(i1,i2) - t(2)*y3%Cmx(i1,i2) ) * scaleFactor - y_out%Cmx(i1,i2) = y1%Cmx(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%Cmy) .AND. ALLOCATED(y1%Cmy)) THEN - DO i2 = LBOUND(y_out%Cmy,2),UBOUND(y_out%Cmy,2) - DO i1 = LBOUND(y_out%Cmy,1),UBOUND(y_out%Cmy,1) - b = (t(3)**2*(y1%Cmy(i1,i2) - y2%Cmy(i1,i2)) + t(2)**2*(-y1%Cmy(i1,i2) + y3%Cmy(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*y1%Cmy(i1,i2) + t(3)*y2%Cmy(i1,i2) - t(2)*y3%Cmy(i1,i2) ) * scaleFactor - y_out%Cmy(i1,i2) = y1%Cmy(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%Cmz) .AND. ALLOCATED(y1%Cmz)) THEN - DO i2 = LBOUND(y_out%Cmz,2),UBOUND(y_out%Cmz,2) - DO i1 = LBOUND(y_out%Cmz,1),UBOUND(y_out%Cmz,1) - b = (t(3)**2*(y1%Cmz(i1,i2) - y2%Cmz(i1,i2)) + t(2)**2*(-y1%Cmz(i1,i2) + y3%Cmz(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*y1%Cmz(i1,i2) + t(3)*y2%Cmz(i1,i2) - t(2)*y3%Cmz(i1,i2) ) * scaleFactor - y_out%Cmz(i1,i2) = y1%Cmz(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%Cm) .AND. ALLOCATED(y1%Cm)) THEN - DO i2 = LBOUND(y_out%Cm,2),UBOUND(y_out%Cm,2) - DO i1 = LBOUND(y_out%Cm,1),UBOUND(y_out%Cm,1) - b = (t(3)**2*(y1%Cm(i1,i2) - y2%Cm(i1,i2)) + t(2)**2*(-y1%Cm(i1,i2) + y3%Cm(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*y1%Cm(i1,i2) + t(3)*y2%Cm(i1,i2) - t(2)*y3%Cm(i1,i2) ) * scaleFactor - y_out%Cm(i1,i2) = y1%Cm(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%Cl) .AND. ALLOCATED(y1%Cl)) THEN - DO i2 = LBOUND(y_out%Cl,2),UBOUND(y_out%Cl,2) - DO i1 = LBOUND(y_out%Cl,1),UBOUND(y_out%Cl,1) - b = (t(3)**2*(y1%Cl(i1,i2) - y2%Cl(i1,i2)) + t(2)**2*(-y1%Cl(i1,i2) + y3%Cl(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*y1%Cl(i1,i2) + t(3)*y2%Cl(i1,i2) - t(2)*y3%Cl(i1,i2) ) * scaleFactor - y_out%Cl(i1,i2) = y1%Cl(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%Cd) .AND. ALLOCATED(y1%Cd)) THEN - DO i2 = LBOUND(y_out%Cd,2),UBOUND(y_out%Cd,2) - DO i1 = LBOUND(y_out%Cd,1),UBOUND(y_out%Cd,1) - b = (t(3)**2*(y1%Cd(i1,i2) - y2%Cd(i1,i2)) + t(2)**2*(-y1%Cd(i1,i2) + y3%Cd(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*y1%Cd(i1,i2) + t(3)*y2%Cd(i1,i2) - t(2)*y3%Cd(i1,i2) ) * scaleFactor - y_out%Cd(i1,i2) = y1%Cd(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%chi) .AND. ALLOCATED(y1%chi)) THEN - DO i2 = LBOUND(y_out%chi,2),UBOUND(y_out%chi,2) - DO i1 = LBOUND(y_out%chi,1),UBOUND(y_out%chi,1) - b = (t(3)**2*(y1%chi(i1,i2) - y2%chi(i1,i2)) + t(2)**2*(-y1%chi(i1,i2) + y3%chi(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*y1%chi(i1,i2) + t(3)*y2%chi(i1,i2) - t(2)*y3%chi(i1,i2) ) * scaleFactor - y_out%chi(i1,i2) = y1%chi(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%Cpmin) .AND. ALLOCATED(y1%Cpmin)) THEN - DO i2 = LBOUND(y_out%Cpmin,2),UBOUND(y_out%Cpmin,2) - DO i1 = LBOUND(y_out%Cpmin,1),UBOUND(y_out%Cpmin,1) - b = (t(3)**2*(y1%Cpmin(i1,i2) - y2%Cpmin(i1,i2)) + t(2)**2*(-y1%Cpmin(i1,i2) + y3%Cpmin(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*y1%Cpmin(i1,i2) + t(3)*y2%Cpmin(i1,i2) - t(2)*y3%Cpmin(i1,i2) ) * scaleFactor - y_out%Cpmin(i1,i2) = y1%Cpmin(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated - END SUBROUTINE BEMT_Output_ExtrapInterp2 - + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + IF (ALLOCATED(y_out%Vrel) .AND. ALLOCATED(y1%Vrel)) THEN + y_out%Vrel = a1*y1%Vrel + a2*y2%Vrel + a3*y3%Vrel + END IF ! check if allocated + IF (ALLOCATED(y_out%phi) .AND. ALLOCATED(y1%phi)) THEN + y_out%phi = a1*y1%phi + a2*y2%phi + a3*y3%phi + END IF ! check if allocated + IF (ALLOCATED(y_out%axInduction) .AND. ALLOCATED(y1%axInduction)) THEN + y_out%axInduction = a1*y1%axInduction + a2*y2%axInduction + a3*y3%axInduction + END IF ! check if allocated + IF (ALLOCATED(y_out%tanInduction) .AND. ALLOCATED(y1%tanInduction)) THEN + y_out%tanInduction = a1*y1%tanInduction + a2*y2%tanInduction + a3*y3%tanInduction + END IF ! check if allocated + IF (ALLOCATED(y_out%axInduction_qs) .AND. ALLOCATED(y1%axInduction_qs)) THEN + y_out%axInduction_qs = a1*y1%axInduction_qs + a2*y2%axInduction_qs + a3*y3%axInduction_qs + END IF ! check if allocated + IF (ALLOCATED(y_out%tanInduction_qs) .AND. ALLOCATED(y1%tanInduction_qs)) THEN + y_out%tanInduction_qs = a1*y1%tanInduction_qs + a2*y2%tanInduction_qs + a3*y3%tanInduction_qs + END IF ! check if allocated + IF (ALLOCATED(y_out%k) .AND. ALLOCATED(y1%k)) THEN + y_out%k = a1*y1%k + a2*y2%k + a3*y3%k + END IF ! check if allocated + IF (ALLOCATED(y_out%k_p) .AND. ALLOCATED(y1%k_p)) THEN + y_out%k_p = a1*y1%k_p + a2*y2%k_p + a3*y3%k_p + END IF ! check if allocated + IF (ALLOCATED(y_out%F) .AND. ALLOCATED(y1%F)) THEN + y_out%F = a1*y1%F + a2*y2%F + a3*y3%F + END IF ! check if allocated + IF (ALLOCATED(y_out%Re) .AND. ALLOCATED(y1%Re)) THEN + y_out%Re = a1*y1%Re + a2*y2%Re + a3*y3%Re + END IF ! check if allocated + IF (ALLOCATED(y_out%AOA) .AND. ALLOCATED(y1%AOA)) THEN + y_out%AOA = a1*y1%AOA + a2*y2%AOA + a3*y3%AOA + END IF ! check if allocated + IF (ALLOCATED(y_out%Cx) .AND. ALLOCATED(y1%Cx)) THEN + y_out%Cx = a1*y1%Cx + a2*y2%Cx + a3*y3%Cx + END IF ! check if allocated + IF (ALLOCATED(y_out%Cy) .AND. ALLOCATED(y1%Cy)) THEN + y_out%Cy = a1*y1%Cy + a2*y2%Cy + a3*y3%Cy + END IF ! check if allocated + IF (ALLOCATED(y_out%Cz) .AND. ALLOCATED(y1%Cz)) THEN + y_out%Cz = a1*y1%Cz + a2*y2%Cz + a3*y3%Cz + END IF ! check if allocated + IF (ALLOCATED(y_out%Cmx) .AND. ALLOCATED(y1%Cmx)) THEN + y_out%Cmx = a1*y1%Cmx + a2*y2%Cmx + a3*y3%Cmx + END IF ! check if allocated + IF (ALLOCATED(y_out%Cmy) .AND. ALLOCATED(y1%Cmy)) THEN + y_out%Cmy = a1*y1%Cmy + a2*y2%Cmy + a3*y3%Cmy + END IF ! check if allocated + IF (ALLOCATED(y_out%Cmz) .AND. ALLOCATED(y1%Cmz)) THEN + y_out%Cmz = a1*y1%Cmz + a2*y2%Cmz + a3*y3%Cmz + END IF ! check if allocated + IF (ALLOCATED(y_out%Cm) .AND. ALLOCATED(y1%Cm)) THEN + y_out%Cm = a1*y1%Cm + a2*y2%Cm + a3*y3%Cm + END IF ! check if allocated + IF (ALLOCATED(y_out%Cl) .AND. ALLOCATED(y1%Cl)) THEN + y_out%Cl = a1*y1%Cl + a2*y2%Cl + a3*y3%Cl + END IF ! check if allocated + IF (ALLOCATED(y_out%Cd) .AND. ALLOCATED(y1%Cd)) THEN + y_out%Cd = a1*y1%Cd + a2*y2%Cd + a3*y3%Cd + END IF ! check if allocated + IF (ALLOCATED(y_out%chi) .AND. ALLOCATED(y1%chi)) THEN + y_out%chi = a1*y1%chi + a2*y2%chi + a3*y3%chi + END IF ! check if allocated + IF (ALLOCATED(y_out%Cpmin) .AND. ALLOCATED(y1%Cpmin)) THEN + y_out%Cpmin = a1*y1%Cpmin + a2*y2%Cpmin + a3*y3%Cpmin + END IF ! check if allocated +END SUBROUTINE END MODULE BEMT_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/aerodyn/src/DBEMT.f90 b/modules/aerodyn/src/DBEMT.f90 index 3c12e5c3b4..4f5a2d6bd8 100644 --- a/modules/aerodyn/src/DBEMT.f90 +++ b/modules/aerodyn/src/DBEMT.f90 @@ -25,6 +25,7 @@ ! [2] R. Damiani, J.Jonkman ! DBEMT Theory Rev. 3 ! Unpublished +! module DBEMT use NWTC_Library @@ -328,13 +329,14 @@ end subroutine DBEMT_InitStates !!---------------------------------------------------------------------------------------------------------------------------------- !> 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 DBEMT_UpdateStates( i, j, t, n, u, p, x, OtherState, m, errStat, errMsg ) +subroutine DBEMT_UpdateStates( i, j, t, n, u, uTimes, p, x, OtherState, m, errStat, errMsg ) !.................................................................................................................................. integer(IntKi), intent(in ) :: i !< blade node counter integer(IntKi), intent(in ) :: j !< blade counter real(DbKi), intent(in ) :: t !< Current simulation time in seconds integer(IntKi), intent(in ) :: n !< Current simulation time step n = 0,1,... type(DBEMT_InputType), intent(in ) :: u(2) !< Inputs at t and t+dt + real(DbKi), intent(in ) :: uTimes(2) ! Times associated with u(:), in seconds type(DBEMT_ParameterType), intent(in ) :: p !< Parameters type(DBEMT_ContinuousStateType), intent(inout) :: x !< Input: Continuous states at t; !! Output: Continuous states at t + Interval @@ -346,7 +348,6 @@ subroutine DBEMT_UpdateStates( i, j, t, n, u, p, x, OtherState, m, errStat, errM ! local variables real(ReKi) :: A, B, C0, k_tau, C0_2 ! tau1_plus1, C_tau1, C, K1 integer(IntKi) :: indx - real(DbKi) :: utimes(2) TYPE(DBEMT_ElementInputType) :: u_elem(2) !< Inputs at utimes @@ -364,9 +365,6 @@ subroutine DBEMT_UpdateStates( i, j, t, n, u, p, x, OtherState, m, errStat, errM call DBEMT_InitStates( i, j, u(1), p, x, OtherState ) if (p%DBEMT_Mod == DBEMT_cont_tauConst) then ! continuous formulation: - utimes(1) = t - utimes(2) = t + p%dt - u_elem(1) = u(1)%element(i,j) u_elem(2) = u(2)%element(i,j) call DBEMT_ABM4( i, j, t, n, u_elem, utimes, p, x, OtherState, m, ErrStat, ErrMsg ) @@ -782,11 +780,11 @@ SUBROUTINE DBEMT_AB4( i, j, t, n, u, utimes, p, x, OtherState, m, ErrStat, ErrMs else - x%element(i,j)%vind = x%element(i,j)%vind + p%DT/24. * ( 55.*OtherState%xdot(1)%element(i,j)%vind - 59.*OtherState%xdot(2)%element(i,j)%vind & - + 37.*OtherState%xdot(3)%element(i,j)%vind - 9.*OtherState%xdot(4)%element(i,j)%vind ) + x%element(i,j)%vind = x%element(i,j)%vind + p%DT/24. * ( 55.*OtherState%xdot(1)%element(i,j)%vind - 59.*OtherState%xdot(2)%element(i,j)%vind & + + 37.*OtherState%xdot(3)%element(i,j)%vind - 9.*OtherState%xdot(4)%element(i,j)%vind ) - x%element(i,j)%vind_1 = x%element(i,j)%vind_1 + p%DT/24. * ( 55.*OtherState%xdot(1)%element(i,j)%vind_1 - 59.*OtherState%xdot(2)%element(i,j)%vind_1 & - + 37.*OtherState%xdot(3)%element(i,j)%vind_1 - 9.*OtherState%xdot(4)%element(i,j)%vind_1 ) + x%element(i,j)%vind_1 = x%element(i,j)%vind_1 + p%DT/24. * ( 55.*OtherState%xdot(1)%element(i,j)%vind_1 - 59.*OtherState%xdot(2)%element(i,j)%vind_1 & + + 37.*OtherState%xdot(3)%element(i,j)%vind_1 - 9.*OtherState%xdot(4)%element(i,j)%vind_1 ) endif @@ -846,7 +844,7 @@ SUBROUTINE DBEMT_ABM4( i, j, t, n, u, utimes, p, x, OtherState, m, ErrStat, ErrM x_in = x%element(i,j) - ! predict: (note that we are overwritting x%element(i,j)%vind and x%element(i,j)%vind_dot here): + ! predict: (note that we are overwritting x%element(i,j)%vind and x%element(i,j)%vind_1 here): CALL DBEMT_AB4( i, j, t, n, u, utimes, p, x, OtherState, m, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) IF ( ErrStat >= AbortErrLev ) RETURN @@ -865,12 +863,12 @@ SUBROUTINE DBEMT_ABM4( i, j, t, n, u, utimes, p, x, OtherState, m, ErrStat, ErrM x%element(i,j)%vind = x_in%vind + p%DT/24. * ( 9. * xdot_pred%vind + 19. * OtherState%xdot(1)%element(i,j)%vind & - - 5. * OtherState%xdot(2)%element(i,j)%vind & - + 1. * OtherState%xdot(3)%element(i,j)%vind ) + - 5. * OtherState%xdot(2)%element(i,j)%vind & + + 1. * OtherState%xdot(3)%element(i,j)%vind ) x%element(i,j)%vind_1 = x_in%vind_1 + p%DT/24. * ( 9. * xdot_pred%vind_1 + 19. * OtherState%xdot(1)%element(i,j)%vind_1 & - - 5. * OtherState%xdot(2)%element(i,j)%vind_1 & - + 1. * OtherState%xdot(3)%element(i,j)%vind_1 ) + - 5. * OtherState%xdot(2)%element(i,j)%vind_1 & + + 1. * OtherState%xdot(3)%element(i,j)%vind_1 ) endif END SUBROUTINE DBEMT_ABM4 diff --git a/modules/aerodyn/src/DBEMT_Registry.txt b/modules/aerodyn/src/DBEMT_Registry.txt index 21a726a068..db29bf1aec 100644 --- a/modules/aerodyn/src/DBEMT_Registry.txt +++ b/modules/aerodyn/src/DBEMT_Registry.txt @@ -12,6 +12,7 @@ # ...... Include files (definitions from NWTC Library) ............................................................................ include Registry_NWTC_Library.txt +param DBEMT/DBEMT - INTEGER DBEMT_frozen - -1 - "use frozen-wake for linearization (not DBEMT)" - param DBEMT/DBEMT - INTEGER DBEMT_none - 0 - "use BEMT instead (not DBEMT)" - param DBEMT/DBEMT - INTEGER DBEMT_tauConst - 1 - "use constant tau1" - param DBEMT/DBEMT - INTEGER DBEMT_tauVaries - 2 - "use time-dependent tau1" - @@ -78,7 +79,7 @@ typedef ^ DBEMT_ElementInputType ReKi spanRatio - # Define inputs that are not on this mesh here: typedef ^ InputType ReKi AxInd_disk - - - "Disk-averaged axial induction (for time-varying tau)" - typedef ^ InputType ReKi Un_disk - - - "Disk-averaged normal relative inflow velocity (for time-varying tau)" m/s -typedef ^ InputType ReKi R_disk - - - "Disk-averaged rotor radius (for time-varying tau)" m +typedef ^ InputType ReKi R_disk - - - "Disk-maximum rotor radius (for time-varying tau)" m typedef ^ InputType DBEMT_ElementInputType element {:}{:} - - "The element-level inputs at each blade node" - # ..... Outputs ................................................................................................................... # Define outputs that are contained on the mesh here: diff --git a/modules/aerodyn/src/DBEMT_Types.f90 b/modules/aerodyn/src/DBEMT_Types.f90 index 423dd42b0b..967e43cf06 100644 --- a/modules/aerodyn/src/DBEMT_Types.f90 +++ b/modules/aerodyn/src/DBEMT_Types.f90 @@ -33,16 +33,17 @@ MODULE DBEMT_Types !--------------------------------------------------------------------------------------------------------------------------------- USE NWTC_Library IMPLICIT NONE + INTEGER(IntKi), PUBLIC, PARAMETER :: DBEMT_frozen = -1 ! use frozen-wake for linearization (not DBEMT) [-] INTEGER(IntKi), PUBLIC, PARAMETER :: DBEMT_none = 0 ! use BEMT instead (not DBEMT) [-] INTEGER(IntKi), PUBLIC, PARAMETER :: DBEMT_tauConst = 1 ! use constant tau1 [-] INTEGER(IntKi), PUBLIC, PARAMETER :: DBEMT_tauVaries = 2 ! use time-dependent tau1 [-] INTEGER(IntKi), PUBLIC, PARAMETER :: DBEMT_cont_tauConst = 3 ! use continuous formulation with constant tau1 [-] ! ========= DBEMT_InitInputType ======= TYPE, PUBLIC :: DBEMT_InitInputType - INTEGER(IntKi) :: NumBlades !< Number of blades on the turbine [-] - INTEGER(IntKi) :: NumNodes !< Number of nodes on each blade [-] - REAL(ReKi) :: tau1_const !< delay value based on disk-averaged quantities [-] - INTEGER(IntKi) :: DBEMT_Mod !< DBEMT Model. 1 = constant tau1, 2 = time dependent tau1, 3=continuous form with constant tau1 [-] + INTEGER(IntKi) :: NumBlades = 0_IntKi !< Number of blades on the turbine [-] + INTEGER(IntKi) :: NumNodes = 0_IntKi !< Number of nodes on each blade [-] + REAL(ReKi) :: tau1_const = 0.0_ReKi !< delay value based on disk-averaged quantities [-] + INTEGER(IntKi) :: DBEMT_Mod = 0_IntKi !< DBEMT Model. 1 = constant tau1, 2 = time dependent tau1, 3=continuous form with constant tau1 [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: rLocal !< Radial distance to blade node from the center of rotation, measured in the rotor plane, needed for DBEMT [m] END TYPE DBEMT_InitInputType ! ======================= @@ -53,8 +54,8 @@ MODULE DBEMT_Types ! ======================= ! ========= DBEMT_ElementContinuousStateType ======= TYPE, PUBLIC :: DBEMT_ElementContinuousStateType - REAL(R8Ki) , DIMENSION(1:2) :: vind !< The filtered induced velocity, [1,i,j] is the axial induced velocity (-Vx*a) at node i on blade j and [2,i,j] is the tantential induced velocity (Vy*a') [m/s] - REAL(R8Ki) , DIMENSION(1:2) :: vind_1 !< The filtered reduced or intermediate induced velocity [m/s] + REAL(R8Ki) , DIMENSION(1:2) :: vind = 0.0_R8Ki !< The filtered induced velocity, [1,i,j] is the axial induced velocity (-Vx*a) at node i on blade j and [2,i,j] is the tantential induced velocity (Vy*a') [m/s] + REAL(R8Ki) , DIMENSION(1:2) :: vind_1 = 0.0_R8Ki !< The filtered reduced or intermediate induced velocity [m/s] END TYPE DBEMT_ElementContinuousStateType ! ======================= ! ========= DBEMT_ContinuousStateType ======= @@ -64,51 +65,51 @@ MODULE DBEMT_Types ! ======================= ! ========= DBEMT_DiscreteStateType ======= TYPE, PUBLIC :: DBEMT_DiscreteStateType - REAL(SiKi) :: DummyState !< Remove this variable if you have continuous states [-] + REAL(SiKi) :: DummyState = 0.0_R4Ki !< Remove this variable if you have continuous states [-] END TYPE DBEMT_DiscreteStateType ! ======================= ! ========= DBEMT_ConstraintStateType ======= TYPE, PUBLIC :: DBEMT_ConstraintStateType - REAL(SiKi) :: DummyState !< Remove this variable if you have constraint states [-] + REAL(SiKi) :: DummyState = 0.0_R4Ki !< Remove this variable if you have constraint states [-] END TYPE DBEMT_ConstraintStateType ! ======================= ! ========= DBEMT_OtherStateType ======= TYPE, PUBLIC :: DBEMT_OtherStateType LOGICAL , DIMENSION(:,:), ALLOCATABLE :: areStatesInitialized !< Flag indicating whether the module's states have been initialized properly [-] - REAL(ReKi) :: tau1 !< value of tau1 used in updateStates (for output-to-file only) [-] - REAL(ReKi) :: tau2 !< value of tau2 used in updateStates (equal to k_tau * tau1, not used between time steps) [-] - INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: n !< time step value used for continuous state integrator [-] + REAL(ReKi) :: tau1 = 0.0_ReKi !< value of tau1 used in updateStates (for output-to-file only) [-] + REAL(ReKi) :: tau2 = 0.0_ReKi !< value of tau2 used in updateStates (equal to k_tau * tau1, not used between time steps) [-] + INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: n !< time step # value used for continuous state integrator [-] TYPE(DBEMT_ContinuousStateType) , DIMENSION(1:4) :: xdot !< derivative history for continuous state integrators [-] END TYPE DBEMT_OtherStateType ! ======================= ! ========= DBEMT_MiscVarType ======= TYPE, PUBLIC :: DBEMT_MiscVarType - LOGICAL :: FirstWarn_tau1 !< flag so tau1 limit warning doesn't get repeated forever [-] + LOGICAL :: FirstWarn_tau1 = .false. !< flag so tau1 limit warning doesn't get repeated forever [-] END TYPE DBEMT_MiscVarType ! ======================= ! ========= DBEMT_ParameterType ======= TYPE, PUBLIC :: DBEMT_ParameterType - REAL(DbKi) :: DT !< Time step for continuous state integration & discrete state update [seconds] + REAL(DbKi) :: DT = 0.0_R8Ki !< Time step for continuous state integration & discrete state update [seconds] INTEGER(IntKi) :: lin_nx = 0 !< Number of continuous states for linearization [-] - INTEGER(IntKi) :: NumBlades !< Number of blades on the turbine [-] - INTEGER(IntKi) :: NumNodes !< Number of nodes on each blade [-] - REAL(ReKi) :: k_0ye !< Filter dynamics constant [default = 0.6 ] [-] - REAL(ReKi) :: tau1_const !< constant version of the delay value [-] + INTEGER(IntKi) :: NumBlades = 0_IntKi !< Number of blades on the turbine [-] + INTEGER(IntKi) :: NumNodes = 0_IntKi !< Number of nodes on each blade [-] + REAL(ReKi) :: k_0ye = 0.0_ReKi !< Filter dynamics constant [default = 0.6 ] [-] + REAL(ReKi) :: tau1_const = 0.0_ReKi !< constant version of the delay value [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: spanRatio !< static span ratio of each blade node [-] - INTEGER(IntKi) :: DBEMT_Mod !< DBEMT Model. 1 = constant tau1, 2 = time dependent tau1, 3=continuous form of constant tau1 [-] + INTEGER(IntKi) :: DBEMT_Mod = 0_IntKi !< DBEMT Model. 1 = constant tau1, 2 = time dependent tau1, 3=continuous form of constant tau1 [-] END TYPE DBEMT_ParameterType ! ======================= ! ========= DBEMT_ElementInputType ======= TYPE, PUBLIC :: DBEMT_ElementInputType - REAL(ReKi) , DIMENSION(1:2) :: vind_s !< The unfiltered induced velocity, [1] is the axial induced velocity (-Vx*a) and [2] is the tangential induced velocity (Vy*a') at node i on blade j. Note that the inputs are used only operated on at a particular node and blade, so we don't store all elements [m/s] - REAL(ReKi) :: spanRatio !< Normalized span location of blade node [-] + REAL(ReKi) , DIMENSION(1:2) :: vind_s = 0.0_ReKi !< The unfiltered induced velocity, [1] is the axial induced velocity (-Vx*a) and [2] is the tangential induced velocity (Vy*a') at node i on blade j. Note that the inputs are used only operated on at a particular node and blade, so we don't store all elements [m/s] + REAL(ReKi) :: spanRatio = 0.0_ReKi !< Normalized span location of blade node [-] END TYPE DBEMT_ElementInputType ! ======================= ! ========= DBEMT_InputType ======= TYPE, PUBLIC :: DBEMT_InputType - REAL(ReKi) :: AxInd_disk !< Disk-averaged axial induction (for time-varying tau) [-] - REAL(ReKi) :: Un_disk !< Disk-averaged normal relative inflow velocity (for time-varying tau) [m/s] - REAL(ReKi) :: R_disk !< Disk-averaged rotor radius (for time-varying tau) [m] + REAL(ReKi) :: AxInd_disk = 0.0_ReKi !< Disk-averaged axial induction (for time-varying tau) [-] + REAL(ReKi) :: Un_disk = 0.0_ReKi !< Disk-averaged normal relative inflow velocity (for time-varying tau) [m/s] + REAL(ReKi) :: R_disk = 0.0_ReKi !< Disk-maximum rotor radius (for time-varying tau) [m] TYPE(DBEMT_ElementInputType) , DIMENSION(:,:), ALLOCATABLE :: element !< The element-level inputs at each blade node [-] END TYPE DBEMT_InputType ! ======================= @@ -118,2674 +119,835 @@ MODULE DBEMT_Types END TYPE DBEMT_OutputType ! ======================= CONTAINS - SUBROUTINE DBEMT_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(DBEMT_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(DBEMT_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 = 'DBEMT_CopyInitInput' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInitInputData%NumBlades = SrcInitInputData%NumBlades - DstInitInputData%NumNodes = SrcInitInputData%NumNodes - DstInitInputData%tau1_const = SrcInitInputData%tau1_const - DstInitInputData%DBEMT_Mod = SrcInitInputData%DBEMT_Mod -IF (ALLOCATED(SrcInitInputData%rLocal)) THEN - i1_l = LBOUND(SrcInitInputData%rLocal,1) - i1_u = UBOUND(SrcInitInputData%rLocal,1) - i2_l = LBOUND(SrcInitInputData%rLocal,2) - i2_u = UBOUND(SrcInitInputData%rLocal,2) - IF (.NOT. ALLOCATED(DstInitInputData%rLocal)) THEN - ALLOCATE(DstInitInputData%rLocal(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%rLocal.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%rLocal = SrcInitInputData%rLocal -ENDIF - END SUBROUTINE DBEMT_CopyInitInput - - SUBROUTINE DBEMT_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(DBEMT_InitInputType), INTENT(INOUT) :: InitInputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_DestroyInitInput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(InitInputData%rLocal)) THEN - DEALLOCATE(InitInputData%rLocal) -ENDIF - END SUBROUTINE DBEMT_DestroyInitInput - - SUBROUTINE DBEMT_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(DBEMT_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 = 'DBEMT_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 ! NumBlades - Int_BufSz = Int_BufSz + 1 ! NumNodes - Re_BufSz = Re_BufSz + 1 ! tau1_const - Int_BufSz = Int_BufSz + 1 ! DBEMT_Mod - Int_BufSz = Int_BufSz + 1 ! rLocal allocated yes/no - IF ( ALLOCATED(InData%rLocal) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! rLocal upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%rLocal) ! rLocal - 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%NumBlades - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumNodes - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%tau1_const - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%DBEMT_Mod - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%rLocal) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rLocal,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rLocal,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rLocal,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rLocal,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%rLocal,2), UBOUND(InData%rLocal,2) - DO i1 = LBOUND(InData%rLocal,1), UBOUND(InData%rLocal,1) - ReKiBuf(Re_Xferred) = InData%rLocal(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE DBEMT_PackInitInput - - SUBROUTINE DBEMT_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(DBEMT_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 = 'DBEMT_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%NumBlades = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumNodes = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%tau1_const = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%DBEMT_Mod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rLocal not allocated - Int_Xferred = Int_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%rLocal)) DEALLOCATE(OutData%rLocal) - ALLOCATE(OutData%rLocal(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rLocal.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%rLocal,2), UBOUND(OutData%rLocal,2) - DO i1 = LBOUND(OutData%rLocal,1), UBOUND(OutData%rLocal,1) - OutData%rLocal(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE DBEMT_UnPackInitInput - - SUBROUTINE DBEMT_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(DBEMT_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(DBEMT_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 = 'DBEMT_CopyInitOutput' -! +subroutine DBEMT_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) + type(DBEMT_InitInputType), intent(in) :: SrcInitInputData + type(DBEMT_InitInputType), intent(inout) :: DstInitInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'DBEMT_CopyInitInput' 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 DBEMT_CopyInitOutput - - SUBROUTINE DBEMT_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(DBEMT_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_DestroyInitOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL NWTC_Library_Destroyprogdesc( InitOutputData%Ver, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE DBEMT_DestroyInitOutput - - SUBROUTINE DBEMT_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(DBEMT_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 = 'DBEMT_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) - - 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 DBEMT_PackInitOutput - - SUBROUTINE DBEMT_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(DBEMT_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 = 'DBEMT_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 DBEMT_UnPackInitOutput - - SUBROUTINE DBEMT_CopyElementContinuousStateType( SrcElementContinuousStateTypeData, DstElementContinuousStateTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(DBEMT_ElementContinuousStateType), INTENT(IN) :: SrcElementContinuousStateTypeData - TYPE(DBEMT_ElementContinuousStateType), INTENT(INOUT) :: DstElementContinuousStateTypeData - 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 = 'DBEMT_CopyElementContinuousStateType' -! + ErrMsg = '' + DstInitInputData%NumBlades = SrcInitInputData%NumBlades + DstInitInputData%NumNodes = SrcInitInputData%NumNodes + DstInitInputData%tau1_const = SrcInitInputData%tau1_const + DstInitInputData%DBEMT_Mod = SrcInitInputData%DBEMT_Mod + if (allocated(SrcInitInputData%rLocal)) then + LB(1:2) = lbound(SrcInitInputData%rLocal) + UB(1:2) = ubound(SrcInitInputData%rLocal) + if (.not. allocated(DstInitInputData%rLocal)) then + allocate(DstInitInputData%rLocal(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%rLocal.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%rLocal = SrcInitInputData%rLocal + end if +end subroutine + +subroutine DBEMT_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(DBEMT_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'DBEMT_DestroyInitInput' ErrStat = ErrID_None - ErrMsg = "" - DstElementContinuousStateTypeData%vind = SrcElementContinuousStateTypeData%vind - DstElementContinuousStateTypeData%vind_1 = SrcElementContinuousStateTypeData%vind_1 - END SUBROUTINE DBEMT_CopyElementContinuousStateType - - SUBROUTINE DBEMT_DestroyElementContinuousStateType( ElementContinuousStateTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(DBEMT_ElementContinuousStateType), INTENT(INOUT) :: ElementContinuousStateTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_DestroyElementContinuousStateType' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE DBEMT_DestroyElementContinuousStateType - - SUBROUTINE DBEMT_PackElementContinuousStateType( 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(DBEMT_ElementContinuousStateType), 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 = 'DBEMT_PackElementContinuousStateType' - ! 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 + SIZE(InData%vind) ! vind - Db_BufSz = Db_BufSz + SIZE(InData%vind_1) ! vind_1 - 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%vind,1), UBOUND(InData%vind,1) - DbKiBuf(Db_Xferred) = InData%vind(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%vind_1,1), UBOUND(InData%vind_1,1) - DbKiBuf(Db_Xferred) = InData%vind_1(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END SUBROUTINE DBEMT_PackElementContinuousStateType - - SUBROUTINE DBEMT_UnPackElementContinuousStateType( 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(DBEMT_ElementContinuousStateType), 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 = 'DBEMT_UnPackElementContinuousStateType' - ! 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%vind,1) - i1_u = UBOUND(OutData%vind,1) - DO i1 = LBOUND(OutData%vind,1), UBOUND(OutData%vind,1) - OutData%vind(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%vind_1,1) - i1_u = UBOUND(OutData%vind_1,1) - DO i1 = LBOUND(OutData%vind_1,1), UBOUND(OutData%vind_1,1) - OutData%vind_1(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END SUBROUTINE DBEMT_UnPackElementContinuousStateType - - SUBROUTINE DBEMT_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(DBEMT_ContinuousStateType), INTENT(IN) :: SrcContStateData - TYPE(DBEMT_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 = 'DBEMT_CopyContState' -! + ErrMsg = '' + if (allocated(InitInputData%rLocal)) then + deallocate(InitInputData%rLocal) + end if +end subroutine + +subroutine DBEMT_PackInitInput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(DBEMT_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'DBEMT_PackInitInput' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%NumBlades) + call RegPack(RF, InData%NumNodes) + call RegPack(RF, InData%tau1_const) + call RegPack(RF, InData%DBEMT_Mod) + call RegPackAlloc(RF, InData%rLocal) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine DBEMT_UnPackInitInput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(DBEMT_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'DBEMT_UnPackInitInput' + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%NumBlades); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumNodes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%tau1_const); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DBEMT_Mod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%rLocal); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine DBEMT_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) + type(DBEMT_InitOutputType), intent(in) :: SrcInitOutputData + type(DBEMT_InitOutputType), intent(inout) :: DstInitOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'DBEMT_CopyInitOutput' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcContStateData%element)) THEN - i1_l = LBOUND(SrcContStateData%element,1) - i1_u = UBOUND(SrcContStateData%element,1) - i2_l = LBOUND(SrcContStateData%element,2) - i2_u = UBOUND(SrcContStateData%element,2) - IF (.NOT. ALLOCATED(DstContStateData%element)) THEN - ALLOCATE(DstContStateData%element(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%element.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcContStateData%element,2), UBOUND(SrcContStateData%element,2) - DO i1 = LBOUND(SrcContStateData%element,1), UBOUND(SrcContStateData%element,1) - CALL DBEMT_Copyelementcontinuousstatetype( SrcContStateData%element(i1,i2), DstContStateData%element(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF - END SUBROUTINE DBEMT_CopyContState - - SUBROUTINE DBEMT_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(DBEMT_ContinuousStateType), INTENT(INOUT) :: ContStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_DestroyContState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(ContStateData%element)) THEN -DO i2 = LBOUND(ContStateData%element,2), UBOUND(ContStateData%element,2) -DO i1 = LBOUND(ContStateData%element,1), UBOUND(ContStateData%element,1) - CALL DBEMT_Destroyelementcontinuousstatetype( ContStateData%element(i1,i2), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO - DEALLOCATE(ContStateData%element) -ENDIF - END SUBROUTINE DBEMT_DestroyContState - - SUBROUTINE DBEMT_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(DBEMT_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 = 'DBEMT_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 ! element allocated yes/no - IF ( ALLOCATED(InData%element) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! element upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i2 = LBOUND(InData%element,2), UBOUND(InData%element,2) - DO i1 = LBOUND(InData%element,1), UBOUND(InData%element,1) - Int_BufSz = Int_BufSz + 3 ! element: size of buffers for each call to pack subtype - CALL DBEMT_Packelementcontinuousstatetype( Re_Buf, Db_Buf, Int_Buf, InData%element(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! element - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! element - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! element - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! element - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - 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%element) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%element,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%element,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%element,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%element,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%element,2), UBOUND(InData%element,2) - DO i1 = LBOUND(InData%element,1), UBOUND(InData%element,1) - CALL DBEMT_Packelementcontinuousstatetype( Re_Buf, Db_Buf, Int_Buf, InData%element(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! element - 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 DO - END IF - END SUBROUTINE DBEMT_PackContState - - SUBROUTINE DBEMT_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(DBEMT_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 = 'DBEMT_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 ! element not allocated - Int_Xferred = Int_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%element)) DEALLOCATE(OutData%element) - ALLOCATE(OutData%element(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%element.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%element,2), UBOUND(OutData%element,2) - DO i1 = LBOUND(OutData%element,1), UBOUND(OutData%element,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 DBEMT_Unpackelementcontinuousstatetype( Re_Buf, Db_Buf, Int_Buf, OutData%element(i1,i2), ErrStat2, ErrMsg2 ) ! element - 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 DO - END IF - END SUBROUTINE DBEMT_UnPackContState - - SUBROUTINE DBEMT_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(DBEMT_DiscreteStateType), INTENT(IN) :: SrcDiscStateData - TYPE(DBEMT_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 = 'DBEMT_CopyDiscState' -! + 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 + +subroutine DBEMT_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(DBEMT_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'DBEMT_DestroyInitOutput' ErrStat = ErrID_None - ErrMsg = "" - DstDiscStateData%DummyState = SrcDiscStateData%DummyState - END SUBROUTINE DBEMT_CopyDiscState - - SUBROUTINE DBEMT_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(DBEMT_DiscreteStateType), INTENT(INOUT) :: DiscStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_DestroyDiscState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE DBEMT_DestroyDiscState - - SUBROUTINE DBEMT_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(DBEMT_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 = 'DBEMT_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 ! DummyState - 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%DummyState - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE DBEMT_PackDiscState - - SUBROUTINE DBEMT_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(DBEMT_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 = 'DBEMT_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%DummyState = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE DBEMT_UnPackDiscState - - SUBROUTINE DBEMT_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(DBEMT_ConstraintStateType), INTENT(IN) :: SrcConstrStateData - TYPE(DBEMT_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 = 'DBEMT_CopyConstrState' -! + ErrMsg = '' + call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine DBEMT_PackInitOutput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(DBEMT_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'DBEMT_PackInitOutput' + if (RF%ErrStat >= AbortErrLev) return + call NWTC_Library_PackProgDesc(RF, InData%Ver) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine DBEMT_UnPackInitOutput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(DBEMT_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'DBEMT_UnPackInitOutput' + if (RF%ErrStat /= ErrID_None) return + call NWTC_Library_UnpackProgDesc(RF, OutData%Ver) ! Ver +end subroutine + +subroutine DBEMT_CopyElementContinuousStateType(SrcElementContinuousStateTypeData, DstElementContinuousStateTypeData, CtrlCode, ErrStat, ErrMsg) + type(DBEMT_ElementContinuousStateType), intent(in) :: SrcElementContinuousStateTypeData + type(DBEMT_ElementContinuousStateType), intent(inout) :: DstElementContinuousStateTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'DBEMT_CopyElementContinuousStateType' ErrStat = ErrID_None - ErrMsg = "" - DstConstrStateData%DummyState = SrcConstrStateData%DummyState - END SUBROUTINE DBEMT_CopyConstrState - - SUBROUTINE DBEMT_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(DBEMT_ConstraintStateType), INTENT(INOUT) :: ConstrStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_DestroyConstrState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE DBEMT_DestroyConstrState - - SUBROUTINE DBEMT_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(DBEMT_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 = 'DBEMT_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 ! DummyState - 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%DummyState - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE DBEMT_PackConstrState - - SUBROUTINE DBEMT_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(DBEMT_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 = 'DBEMT_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%DummyState = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE DBEMT_UnPackConstrState - - SUBROUTINE DBEMT_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(DBEMT_OtherStateType), INTENT(IN) :: SrcOtherStateData - TYPE(DBEMT_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) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_CopyOtherState' -! + ErrMsg = '' + DstElementContinuousStateTypeData%vind = SrcElementContinuousStateTypeData%vind + DstElementContinuousStateTypeData%vind_1 = SrcElementContinuousStateTypeData%vind_1 +end subroutine + +subroutine DBEMT_DestroyElementContinuousStateType(ElementContinuousStateTypeData, ErrStat, ErrMsg) + type(DBEMT_ElementContinuousStateType), intent(inout) :: ElementContinuousStateTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'DBEMT_DestroyElementContinuousStateType' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcOtherStateData%areStatesInitialized)) THEN - i1_l = LBOUND(SrcOtherStateData%areStatesInitialized,1) - i1_u = UBOUND(SrcOtherStateData%areStatesInitialized,1) - i2_l = LBOUND(SrcOtherStateData%areStatesInitialized,2) - i2_u = UBOUND(SrcOtherStateData%areStatesInitialized,2) - IF (.NOT. ALLOCATED(DstOtherStateData%areStatesInitialized)) THEN - ALLOCATE(DstOtherStateData%areStatesInitialized(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%areStatesInitialized.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOtherStateData%areStatesInitialized = SrcOtherStateData%areStatesInitialized -ENDIF - DstOtherStateData%tau1 = SrcOtherStateData%tau1 - DstOtherStateData%tau2 = SrcOtherStateData%tau2 -IF (ALLOCATED(SrcOtherStateData%n)) THEN - i1_l = LBOUND(SrcOtherStateData%n,1) - i1_u = UBOUND(SrcOtherStateData%n,1) - i2_l = LBOUND(SrcOtherStateData%n,2) - i2_u = UBOUND(SrcOtherStateData%n,2) - IF (.NOT. ALLOCATED(DstOtherStateData%n)) THEN - ALLOCATE(DstOtherStateData%n(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%n.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOtherStateData%n = SrcOtherStateData%n -ENDIF - DO i1 = LBOUND(SrcOtherStateData%xdot,1), UBOUND(SrcOtherStateData%xdot,1) - CALL DBEMT_CopyContState( SrcOtherStateData%xdot(i1), DstOtherStateData%xdot(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - END SUBROUTINE DBEMT_CopyOtherState - - SUBROUTINE DBEMT_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(DBEMT_OtherStateType), INTENT(INOUT) :: OtherStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_DestroyOtherState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(OtherStateData%areStatesInitialized)) THEN - DEALLOCATE(OtherStateData%areStatesInitialized) -ENDIF -IF (ALLOCATED(OtherStateData%n)) THEN - DEALLOCATE(OtherStateData%n) -ENDIF -DO i1 = LBOUND(OtherStateData%xdot,1), UBOUND(OtherStateData%xdot,1) - CALL DBEMT_DestroyContState( OtherStateData%xdot(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - END SUBROUTINE DBEMT_DestroyOtherState - - SUBROUTINE DBEMT_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(DBEMT_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 = 'DBEMT_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 ! areStatesInitialized allocated yes/no - IF ( ALLOCATED(InData%areStatesInitialized) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! areStatesInitialized upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%areStatesInitialized) ! areStatesInitialized - END IF - Re_BufSz = Re_BufSz + 1 ! tau1 - Re_BufSz = Re_BufSz + 1 ! tau2 - Int_BufSz = Int_BufSz + 1 ! n allocated yes/no - IF ( ALLOCATED(InData%n) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! n upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%n) ! n - END IF - ! 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 DBEMT_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 - 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%areStatesInitialized) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%areStatesInitialized,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%areStatesInitialized,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%areStatesInitialized,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%areStatesInitialized,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%areStatesInitialized,2), UBOUND(InData%areStatesInitialized,2) - DO i1 = LBOUND(InData%areStatesInitialized,1), UBOUND(InData%areStatesInitialized,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%areStatesInitialized(i1,i2), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - ReKiBuf(Re_Xferred) = InData%tau1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%tau2 - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%n) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%n,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%n,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%n,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%n,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%n,2), UBOUND(InData%n,2) - DO i1 = LBOUND(InData%n,1), UBOUND(InData%n,1) - IntKiBuf(Int_Xferred) = InData%n(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - DO i1 = LBOUND(InData%xdot,1), UBOUND(InData%xdot,1) - CALL DBEMT_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 SUBROUTINE DBEMT_PackOtherState - - SUBROUTINE DBEMT_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(DBEMT_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) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_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 ! areStatesInitialized not allocated - Int_Xferred = Int_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%areStatesInitialized)) DEALLOCATE(OutData%areStatesInitialized) - ALLOCATE(OutData%areStatesInitialized(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%areStatesInitialized.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%areStatesInitialized,2), UBOUND(OutData%areStatesInitialized,2) - DO i1 = LBOUND(OutData%areStatesInitialized,1), UBOUND(OutData%areStatesInitialized,1) - OutData%areStatesInitialized(i1,i2) = TRANSFER(IntKiBuf(Int_Xferred), OutData%areStatesInitialized(i1,i2)) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - OutData%tau1 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%tau2 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! n not allocated - Int_Xferred = Int_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%n)) DEALLOCATE(OutData%n) - ALLOCATE(OutData%n(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%n.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%n,2), UBOUND(OutData%n,2) - DO i1 = LBOUND(OutData%n,1), UBOUND(OutData%n,1) - OutData%n(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - i1_l = LBOUND(OutData%xdot,1) - i1_u = UBOUND(OutData%xdot,1) - 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 DBEMT_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 SUBROUTINE DBEMT_UnPackOtherState - - SUBROUTINE DBEMT_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(DBEMT_MiscVarType), INTENT(IN) :: SrcMiscData - TYPE(DBEMT_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 = 'DBEMT_CopyMisc' -! + ErrMsg = '' +end subroutine + +subroutine DBEMT_PackElementContinuousStateType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(DBEMT_ElementContinuousStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'DBEMT_PackElementContinuousStateType' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%vind) + call RegPack(RF, InData%vind_1) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine DBEMT_UnPackElementContinuousStateType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(DBEMT_ElementContinuousStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'DBEMT_UnPackElementContinuousStateType' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%vind); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%vind_1); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine DBEMT_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) + type(DBEMT_ContinuousStateType), intent(in) :: SrcContStateData + type(DBEMT_ContinuousStateType), intent(inout) :: DstContStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'DBEMT_CopyContState' ErrStat = ErrID_None - ErrMsg = "" - DstMiscData%FirstWarn_tau1 = SrcMiscData%FirstWarn_tau1 - END SUBROUTINE DBEMT_CopyMisc - - SUBROUTINE DBEMT_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(DBEMT_MiscVarType), INTENT(INOUT) :: MiscData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_DestroyMisc' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE DBEMT_DestroyMisc - - SUBROUTINE DBEMT_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(DBEMT_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 = 'DBEMT_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 ! FirstWarn_tau1 - 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%FirstWarn_tau1, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE DBEMT_PackMisc - - SUBROUTINE DBEMT_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(DBEMT_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 = 'DBEMT_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%FirstWarn_tau1 = TRANSFER(IntKiBuf(Int_Xferred), OutData%FirstWarn_tau1) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE DBEMT_UnPackMisc - - SUBROUTINE DBEMT_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(DBEMT_ParameterType), INTENT(IN) :: SrcParamData - TYPE(DBEMT_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 = 'DBEMT_CopyParam' -! + ErrMsg = '' + if (allocated(SrcContStateData%element)) then + LB(1:2) = lbound(SrcContStateData%element) + UB(1:2) = ubound(SrcContStateData%element) + if (.not. allocated(DstContStateData%element)) then + allocate(DstContStateData%element(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%element.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call DBEMT_CopyElementContinuousStateType(SrcContStateData%element(i1,i2), DstContStateData%element(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do + end if +end subroutine + +subroutine DBEMT_DestroyContState(ContStateData, ErrStat, ErrMsg) + type(DBEMT_ContinuousStateType), intent(inout) :: ContStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'DBEMT_DestroyContState' ErrStat = ErrID_None - ErrMsg = "" - DstParamData%DT = SrcParamData%DT - DstParamData%lin_nx = SrcParamData%lin_nx - DstParamData%NumBlades = SrcParamData%NumBlades - DstParamData%NumNodes = SrcParamData%NumNodes - DstParamData%k_0ye = SrcParamData%k_0ye - DstParamData%tau1_const = SrcParamData%tau1_const -IF (ALLOCATED(SrcParamData%spanRatio)) THEN - i1_l = LBOUND(SrcParamData%spanRatio,1) - i1_u = UBOUND(SrcParamData%spanRatio,1) - i2_l = LBOUND(SrcParamData%spanRatio,2) - i2_u = UBOUND(SrcParamData%spanRatio,2) - IF (.NOT. ALLOCATED(DstParamData%spanRatio)) THEN - ALLOCATE(DstParamData%spanRatio(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%spanRatio.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%spanRatio = SrcParamData%spanRatio -ENDIF - DstParamData%DBEMT_Mod = SrcParamData%DBEMT_Mod - END SUBROUTINE DBEMT_CopyParam - - SUBROUTINE DBEMT_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(DBEMT_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(ParamData%spanRatio)) THEN - DEALLOCATE(ParamData%spanRatio) -ENDIF - END SUBROUTINE DBEMT_DestroyParam - - SUBROUTINE DBEMT_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(DBEMT_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 = 'DBEMT_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 ! lin_nx - Int_BufSz = Int_BufSz + 1 ! NumBlades - Int_BufSz = Int_BufSz + 1 ! NumNodes - Re_BufSz = Re_BufSz + 1 ! k_0ye - Re_BufSz = Re_BufSz + 1 ! tau1_const - Int_BufSz = Int_BufSz + 1 ! spanRatio allocated yes/no - IF ( ALLOCATED(InData%spanRatio) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! spanRatio upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%spanRatio) ! spanRatio - END IF - Int_BufSz = Int_BufSz + 1 ! DBEMT_Mod - 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) = InData%lin_nx - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumBlades - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumNodes - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%k_0ye - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%tau1_const - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%spanRatio) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%spanRatio,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%spanRatio,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%spanRatio,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%spanRatio,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%spanRatio,2), UBOUND(InData%spanRatio,2) - DO i1 = LBOUND(InData%spanRatio,1), UBOUND(InData%spanRatio,1) - ReKiBuf(Re_Xferred) = InData%spanRatio(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%DBEMT_Mod - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE DBEMT_PackParam - - SUBROUTINE DBEMT_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(DBEMT_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 = 'DBEMT_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%lin_nx = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumBlades = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumNodes = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%k_0ye = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%tau1_const = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! spanRatio not allocated - Int_Xferred = Int_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%spanRatio)) DEALLOCATE(OutData%spanRatio) - ALLOCATE(OutData%spanRatio(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%spanRatio.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%spanRatio,2), UBOUND(OutData%spanRatio,2) - DO i1 = LBOUND(OutData%spanRatio,1), UBOUND(OutData%spanRatio,1) - OutData%spanRatio(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%DBEMT_Mod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE DBEMT_UnPackParam - - SUBROUTINE DBEMT_CopyElementInputType( SrcElementInputTypeData, DstElementInputTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(DBEMT_ElementInputType), INTENT(IN) :: SrcElementInputTypeData - TYPE(DBEMT_ElementInputType), INTENT(INOUT) :: DstElementInputTypeData - 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 = 'DBEMT_CopyElementInputType' -! + ErrMsg = '' + if (allocated(ContStateData%element)) then + LB(1:2) = lbound(ContStateData%element) + UB(1:2) = ubound(ContStateData%element) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call DBEMT_DestroyElementContinuousStateType(ContStateData%element(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + deallocate(ContStateData%element) + end if +end subroutine + +subroutine DBEMT_PackContState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(DBEMT_ContinuousStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'DBEMT_PackContState' + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%element)) + if (allocated(InData%element)) then + call RegPackBounds(RF, 2, lbound(InData%element), ubound(InData%element)) + LB(1:2) = lbound(InData%element) + UB(1:2) = ubound(InData%element) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call DBEMT_PackElementContinuousStateType(RF, InData%element(i1,i2)) + end do + end do + end if + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine DBEMT_UnPackContState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(DBEMT_ContinuousStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'DBEMT_UnPackContState' + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + if (allocated(OutData%element)) deallocate(OutData%element) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%element(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%element.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call DBEMT_UnpackElementContinuousStateType(RF, OutData%element(i1,i2)) ! element + end do + end do + end if +end subroutine + +subroutine DBEMT_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) + type(DBEMT_DiscreteStateType), intent(in) :: SrcDiscStateData + type(DBEMT_DiscreteStateType), intent(inout) :: DstDiscStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'DBEMT_CopyDiscState' ErrStat = ErrID_None - ErrMsg = "" - DstElementInputTypeData%vind_s = SrcElementInputTypeData%vind_s - DstElementInputTypeData%spanRatio = SrcElementInputTypeData%spanRatio - END SUBROUTINE DBEMT_CopyElementInputType - - SUBROUTINE DBEMT_DestroyElementInputType( ElementInputTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(DBEMT_ElementInputType), INTENT(INOUT) :: ElementInputTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_DestroyElementInputType' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE DBEMT_DestroyElementInputType - - SUBROUTINE DBEMT_PackElementInputType( 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(DBEMT_ElementInputType), 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 = 'DBEMT_PackElementInputType' - ! 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%vind_s) ! vind_s - Re_BufSz = Re_BufSz + 1 ! spanRatio - 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%vind_s,1), UBOUND(InData%vind_s,1) - ReKiBuf(Re_Xferred) = InData%vind_s(i1) - Re_Xferred = Re_Xferred + 1 - END DO - ReKiBuf(Re_Xferred) = InData%spanRatio - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE DBEMT_PackElementInputType - - SUBROUTINE DBEMT_UnPackElementInputType( 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(DBEMT_ElementInputType), 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 = 'DBEMT_UnPackElementInputType' - ! 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%vind_s,1) - i1_u = UBOUND(OutData%vind_s,1) - DO i1 = LBOUND(OutData%vind_s,1), UBOUND(OutData%vind_s,1) - OutData%vind_s(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%spanRatio = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE DBEMT_UnPackElementInputType - - SUBROUTINE DBEMT_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(DBEMT_InputType), INTENT(IN) :: SrcInputData - TYPE(DBEMT_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 = 'DBEMT_CopyInput' -! + ErrMsg = '' + DstDiscStateData%DummyState = SrcDiscStateData%DummyState +end subroutine + +subroutine DBEMT_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) + type(DBEMT_DiscreteStateType), intent(inout) :: DiscStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'DBEMT_DestroyDiscState' ErrStat = ErrID_None - ErrMsg = "" - DstInputData%AxInd_disk = SrcInputData%AxInd_disk - DstInputData%Un_disk = SrcInputData%Un_disk - DstInputData%R_disk = SrcInputData%R_disk -IF (ALLOCATED(SrcInputData%element)) THEN - i1_l = LBOUND(SrcInputData%element,1) - i1_u = UBOUND(SrcInputData%element,1) - i2_l = LBOUND(SrcInputData%element,2) - i2_u = UBOUND(SrcInputData%element,2) - IF (.NOT. ALLOCATED(DstInputData%element)) THEN - ALLOCATE(DstInputData%element(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%element.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcInputData%element,2), UBOUND(SrcInputData%element,2) - DO i1 = LBOUND(SrcInputData%element,1), UBOUND(SrcInputData%element,1) - CALL DBEMT_Copyelementinputtype( SrcInputData%element(i1,i2), DstInputData%element(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF - END SUBROUTINE DBEMT_CopyInput - - SUBROUTINE DBEMT_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(DBEMT_InputType), INTENT(INOUT) :: InputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_DestroyInput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(InputData%element)) THEN -DO i2 = LBOUND(InputData%element,2), UBOUND(InputData%element,2) -DO i1 = LBOUND(InputData%element,1), UBOUND(InputData%element,1) - CALL DBEMT_Destroyelementinputtype( InputData%element(i1,i2), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO - DEALLOCATE(InputData%element) -ENDIF - END SUBROUTINE DBEMT_DestroyInput - - SUBROUTINE DBEMT_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(DBEMT_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 = 'DBEMT_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 ! AxInd_disk - Re_BufSz = Re_BufSz + 1 ! Un_disk - Re_BufSz = Re_BufSz + 1 ! R_disk - Int_BufSz = Int_BufSz + 1 ! element allocated yes/no - IF ( ALLOCATED(InData%element) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! element upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i2 = LBOUND(InData%element,2), UBOUND(InData%element,2) - DO i1 = LBOUND(InData%element,1), UBOUND(InData%element,1) - Int_BufSz = Int_BufSz + 3 ! element: size of buffers for each call to pack subtype - CALL DBEMT_Packelementinputtype( Re_Buf, Db_Buf, Int_Buf, InData%element(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! element - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! element - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! element - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! element - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - 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%AxInd_disk - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Un_disk - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%R_disk - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%element) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%element,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%element,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%element,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%element,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%element,2), UBOUND(InData%element,2) - DO i1 = LBOUND(InData%element,1), UBOUND(InData%element,1) - CALL DBEMT_Packelementinputtype( Re_Buf, Db_Buf, Int_Buf, InData%element(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! element - 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 DO - END IF - END SUBROUTINE DBEMT_PackInput - - SUBROUTINE DBEMT_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(DBEMT_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 = 'DBEMT_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%AxInd_disk = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Un_disk = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%R_disk = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! element not allocated - Int_Xferred = Int_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%element)) DEALLOCATE(OutData%element) - ALLOCATE(OutData%element(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%element.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%element,2), UBOUND(OutData%element,2) - DO i1 = LBOUND(OutData%element,1), UBOUND(OutData%element,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 DBEMT_Unpackelementinputtype( Re_Buf, Db_Buf, Int_Buf, OutData%element(i1,i2), ErrStat2, ErrMsg2 ) ! element - 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 DO - END IF - END SUBROUTINE DBEMT_UnPackInput - - SUBROUTINE DBEMT_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(DBEMT_OutputType), INTENT(IN) :: SrcOutputData - TYPE(DBEMT_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) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_CopyOutput' -! + ErrMsg = '' +end subroutine + +subroutine DBEMT_PackDiscState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(DBEMT_DiscreteStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'DBEMT_PackDiscState' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyState) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine DBEMT_UnPackDiscState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(DBEMT_DiscreteStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'DBEMT_UnPackDiscState' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyState); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine DBEMT_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) + type(DBEMT_ConstraintStateType), intent(in) :: SrcConstrStateData + type(DBEMT_ConstraintStateType), intent(inout) :: DstConstrStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'DBEMT_CopyConstrState' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcOutputData%vind)) THEN - i1_l = LBOUND(SrcOutputData%vind,1) - i1_u = UBOUND(SrcOutputData%vind,1) - i2_l = LBOUND(SrcOutputData%vind,2) - i2_u = UBOUND(SrcOutputData%vind,2) - i3_l = LBOUND(SrcOutputData%vind,3) - i3_u = UBOUND(SrcOutputData%vind,3) - IF (.NOT. ALLOCATED(DstOutputData%vind)) THEN - ALLOCATE(DstOutputData%vind(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%vind.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%vind = SrcOutputData%vind -ENDIF - END SUBROUTINE DBEMT_CopyOutput - - SUBROUTINE DBEMT_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(DBEMT_OutputType), INTENT(INOUT) :: OutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_DestroyOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(OutputData%vind)) THEN - DEALLOCATE(OutputData%vind) -ENDIF - END SUBROUTINE DBEMT_DestroyOutput - - SUBROUTINE DBEMT_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(DBEMT_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 = 'DBEMT_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 ! vind allocated yes/no - IF ( ALLOCATED(InData%vind) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! vind upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%vind) ! vind - 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%vind) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%vind,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%vind,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%vind,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%vind,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%vind,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%vind,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%vind,3), UBOUND(InData%vind,3) - DO i2 = LBOUND(InData%vind,2), UBOUND(InData%vind,2) - DO i1 = LBOUND(InData%vind,1), UBOUND(InData%vind,1) - ReKiBuf(Re_Xferred) = InData%vind(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - END SUBROUTINE DBEMT_PackOutput - - SUBROUTINE DBEMT_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(DBEMT_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) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_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 ! vind not allocated - Int_Xferred = Int_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%vind)) DEALLOCATE(OutData%vind) - ALLOCATE(OutData%vind(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%vind.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%vind,3), UBOUND(OutData%vind,3) - DO i2 = LBOUND(OutData%vind,2), UBOUND(OutData%vind,2) - DO i1 = LBOUND(OutData%vind,1), UBOUND(OutData%vind,1) - OutData%vind(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - END SUBROUTINE DBEMT_UnPackOutput - - - SUBROUTINE DBEMT_ElementInputType_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) ElementInputType 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(DBEMT_ElementInputType), INTENT(IN) :: u(:) ! ElementInputType at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the ElementInputTypes - TYPE(DBEMT_ElementInputType), INTENT(INOUT) :: u_out ! ElementInputType 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 + ErrMsg = '' + DstConstrStateData%DummyState = SrcConstrStateData%DummyState +end subroutine + +subroutine DBEMT_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) + type(DBEMT_ConstraintStateType), intent(inout) :: ConstrStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'DBEMT_DestroyConstrState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine DBEMT_PackConstrState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(DBEMT_ConstraintStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'DBEMT_PackConstrState' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyState) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine DBEMT_UnPackConstrState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(DBEMT_ConstraintStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'DBEMT_UnPackConstrState' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyState); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine DBEMT_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) + type(DBEMT_OtherStateType), intent(in) :: SrcOtherStateData + type(DBEMT_OtherStateType), intent(inout) :: DstOtherStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'DBEMT_CopyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcOtherStateData%areStatesInitialized)) then + LB(1:2) = lbound(SrcOtherStateData%areStatesInitialized) + UB(1:2) = ubound(SrcOtherStateData%areStatesInitialized) + if (.not. allocated(DstOtherStateData%areStatesInitialized)) then + allocate(DstOtherStateData%areStatesInitialized(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%areStatesInitialized.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOtherStateData%areStatesInitialized = SrcOtherStateData%areStatesInitialized + end if + DstOtherStateData%tau1 = SrcOtherStateData%tau1 + DstOtherStateData%tau2 = SrcOtherStateData%tau2 + if (allocated(SrcOtherStateData%n)) then + LB(1:2) = lbound(SrcOtherStateData%n) + UB(1:2) = ubound(SrcOtherStateData%n) + if (.not. allocated(DstOtherStateData%n)) then + allocate(DstOtherStateData%n(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%n.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOtherStateData%n = SrcOtherStateData%n + end if + LB(1:1) = lbound(SrcOtherStateData%xdot) + UB(1:1) = ubound(SrcOtherStateData%xdot) + do i1 = LB(1), UB(1) + call DBEMT_CopyContState(SrcOtherStateData%xdot(i1), DstOtherStateData%xdot(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do +end subroutine + +subroutine DBEMT_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) + type(DBEMT_OtherStateType), intent(inout) :: OtherStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'DBEMT_DestroyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OtherStateData%areStatesInitialized)) then + deallocate(OtherStateData%areStatesInitialized) + end if + if (allocated(OtherStateData%n)) then + deallocate(OtherStateData%n) + end if + LB(1:1) = lbound(OtherStateData%xdot) + UB(1:1) = ubound(OtherStateData%xdot) + do i1 = LB(1), UB(1) + call DBEMT_DestroyContState(OtherStateData%xdot(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do +end subroutine + +subroutine DBEMT_PackOtherState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(DBEMT_OtherStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'DBEMT_PackOtherState' + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%areStatesInitialized) + call RegPack(RF, InData%tau1) + call RegPack(RF, InData%tau2) + call RegPackAlloc(RF, InData%n) + LB(1:1) = lbound(InData%xdot) + UB(1:1) = ubound(InData%xdot) + do i1 = LB(1), UB(1) + call DBEMT_PackContState(RF, InData%xdot(i1)) + end do + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine DBEMT_UnPackOtherState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(DBEMT_OtherStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'DBEMT_UnPackOtherState' + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%areStatesInitialized); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%tau1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%tau2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%n); if (RegCheckErr(RF, RoutineName)) return + LB(1:1) = lbound(OutData%xdot) + UB(1:1) = ubound(OutData%xdot) + do i1 = LB(1), UB(1) + call DBEMT_UnpackContState(RF, OutData%xdot(i1)) ! xdot + end do +end subroutine + +subroutine DBEMT_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(DBEMT_MiscVarType), intent(in) :: SrcMiscData + type(DBEMT_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'DBEMT_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + DstMiscData%FirstWarn_tau1 = SrcMiscData%FirstWarn_tau1 +end subroutine + +subroutine DBEMT_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(DBEMT_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'DBEMT_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine DBEMT_PackMisc(RF, Indata) + type(RegFile), intent(inout) :: RF + type(DBEMT_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'DBEMT_PackMisc' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%FirstWarn_tau1) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine DBEMT_UnPackMisc(RF, OutData) + type(RegFile), intent(inout) :: RF + type(DBEMT_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'DBEMT_UnPackMisc' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%FirstWarn_tau1); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine DBEMT_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(DBEMT_ParameterType), intent(in) :: SrcParamData + type(DBEMT_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'DBEMT_CopyParam' + ErrStat = ErrID_None + ErrMsg = '' + DstParamData%DT = SrcParamData%DT + DstParamData%lin_nx = SrcParamData%lin_nx + DstParamData%NumBlades = SrcParamData%NumBlades + DstParamData%NumNodes = SrcParamData%NumNodes + DstParamData%k_0ye = SrcParamData%k_0ye + DstParamData%tau1_const = SrcParamData%tau1_const + if (allocated(SrcParamData%spanRatio)) then + LB(1:2) = lbound(SrcParamData%spanRatio) + UB(1:2) = ubound(SrcParamData%spanRatio) + if (.not. allocated(DstParamData%spanRatio)) then + allocate(DstParamData%spanRatio(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%spanRatio.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%spanRatio = SrcParamData%spanRatio + end if + DstParamData%DBEMT_Mod = SrcParamData%DBEMT_Mod +end subroutine + +subroutine DBEMT_DestroyParam(ParamData, ErrStat, ErrMsg) + type(DBEMT_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'DBEMT_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ParamData%spanRatio)) then + deallocate(ParamData%spanRatio) + end if +end subroutine + +subroutine DBEMT_PackParam(RF, Indata) + type(RegFile), intent(inout) :: RF + type(DBEMT_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'DBEMT_PackParam' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DT) + call RegPack(RF, InData%lin_nx) + call RegPack(RF, InData%NumBlades) + call RegPack(RF, InData%NumNodes) + call RegPack(RF, InData%k_0ye) + call RegPack(RF, InData%tau1_const) + call RegPackAlloc(RF, InData%spanRatio) + call RegPack(RF, InData%DBEMT_Mod) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine DBEMT_UnPackParam(RF, OutData) + type(RegFile), intent(inout) :: RF + type(DBEMT_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'DBEMT_UnPackParam' + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%lin_nx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumBlades); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumNodes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%k_0ye); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%tau1_const); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%spanRatio); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DBEMT_Mod); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine DBEMT_CopyElementInputType(SrcElementInputTypeData, DstElementInputTypeData, CtrlCode, ErrStat, ErrMsg) + type(DBEMT_ElementInputType), intent(in) :: SrcElementInputTypeData + type(DBEMT_ElementInputType), intent(inout) :: DstElementInputTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'DBEMT_CopyElementInputType' + ErrStat = ErrID_None + ErrMsg = '' + DstElementInputTypeData%vind_s = SrcElementInputTypeData%vind_s + DstElementInputTypeData%spanRatio = SrcElementInputTypeData%spanRatio +end subroutine + +subroutine DBEMT_DestroyElementInputType(ElementInputTypeData, ErrStat, ErrMsg) + type(DBEMT_ElementInputType), intent(inout) :: ElementInputTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'DBEMT_DestroyElementInputType' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine DBEMT_PackElementInputType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(DBEMT_ElementInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'DBEMT_PackElementInputType' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%vind_s) + call RegPack(RF, InData%spanRatio) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine DBEMT_UnPackElementInputType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(DBEMT_ElementInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'DBEMT_UnPackElementInputType' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%vind_s); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%spanRatio); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine DBEMT_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) + type(DBEMT_InputType), intent(in) :: SrcInputData + type(DBEMT_InputType), intent(inout) :: DstInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'DBEMT_CopyInput' + ErrStat = ErrID_None + ErrMsg = '' + DstInputData%AxInd_disk = SrcInputData%AxInd_disk + DstInputData%Un_disk = SrcInputData%Un_disk + DstInputData%R_disk = SrcInputData%R_disk + if (allocated(SrcInputData%element)) then + LB(1:2) = lbound(SrcInputData%element) + UB(1:2) = ubound(SrcInputData%element) + if (.not. allocated(DstInputData%element)) then + allocate(DstInputData%element(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%element.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call DBEMT_CopyElementInputType(SrcInputData%element(i1,i2), DstInputData%element(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do + end if +end subroutine + +subroutine DBEMT_DestroyInput(InputData, ErrStat, ErrMsg) + type(DBEMT_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'DBEMT_DestroyInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InputData%element)) then + LB(1:2) = lbound(InputData%element) + UB(1:2) = ubound(InputData%element) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call DBEMT_DestroyElementInputType(InputData%element(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + deallocate(InputData%element) + end if +end subroutine + +subroutine DBEMT_PackInput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(DBEMT_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'DBEMT_PackInput' + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%AxInd_disk) + call RegPack(RF, InData%Un_disk) + call RegPack(RF, InData%R_disk) + call RegPack(RF, allocated(InData%element)) + if (allocated(InData%element)) then + call RegPackBounds(RF, 2, lbound(InData%element), ubound(InData%element)) + LB(1:2) = lbound(InData%element) + UB(1:2) = ubound(InData%element) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call DBEMT_PackElementInputType(RF, InData%element(i1,i2)) + end do + end do + end if + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine DBEMT_UnPackInput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(DBEMT_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'DBEMT_UnPackInput' + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%AxInd_disk); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Un_disk); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%R_disk); if (RegCheckErr(RF, RoutineName)) return + if (allocated(OutData%element)) deallocate(OutData%element) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%element(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%element.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call DBEMT_UnpackElementInputType(RF, OutData%element(i1,i2)) ! element + end do + end do + end if +end subroutine + +subroutine DBEMT_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(DBEMT_OutputType), intent(in) :: SrcOutputData + type(DBEMT_OutputType), intent(inout) :: DstOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'DBEMT_CopyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcOutputData%vind)) then + LB(1:3) = lbound(SrcOutputData%vind) + UB(1:3) = ubound(SrcOutputData%vind) + if (.not. allocated(DstOutputData%vind)) then + allocate(DstOutputData%vind(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%vind.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%vind = SrcOutputData%vind + end if +end subroutine + +subroutine DBEMT_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(DBEMT_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'DBEMT_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OutputData%vind)) then + deallocate(OutputData%vind) + end if +end subroutine + +subroutine DBEMT_PackOutput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(DBEMT_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'DBEMT_PackOutput' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%vind) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine DBEMT_UnPackOutput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(DBEMT_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'DBEMT_UnPackOutput' + integer(B4Ki) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%vind); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine DBEMT_ElementInputType_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg) + ! + ! This subroutine calculates a extrapolated (or interpolated) ElementInputType 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(DBEMT_ElementInputType), intent(in) :: u(:) ! ElementInputType at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the ElementInputTypes + type(DBEMT_ElementInputType), intent(inout) :: u_out ! ElementInputType 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 = 'DBEMT_ElementInputType_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 DBEMT_CopyElementInputType(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL DBEMT_ElementInputType_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 DBEMT_ElementInputType_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 DBEMT_ElementInputType_ExtrapInterp - - - SUBROUTINE DBEMT_ElementInputType_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'DBEMT_ElementInputType_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(u)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(u)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(u) - 1 + select case (order) + case (0) + call DBEMT_CopyElementInputType(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call DBEMT_ElementInputType_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call DBEMT_ElementInputType_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(u) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE DBEMT_ElementInputType_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) ElementInputType 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. @@ -2797,47 +959,44 @@ SUBROUTINE DBEMT_ElementInputType_ExtrapInterp1(u1, u2, tin, u_out, tin_out, Err ! !.................................................................................................................................. - TYPE(DBEMT_ElementInputType), INTENT(IN) :: u1 ! ElementInputType at t1 > t2 - TYPE(DBEMT_ElementInputType), INTENT(IN) :: u2 ! ElementInputType at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the ElementInputTypes - TYPE(DBEMT_ElementInputType), INTENT(INOUT) :: u_out ! ElementInputType 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 + TYPE(DBEMT_ElementInputType), INTENT(IN) :: u1 ! ElementInputType at t1 > t2 + TYPE(DBEMT_ElementInputType), INTENT(IN) :: u2 ! ElementInputType at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the ElementInputTypes + TYPE(DBEMT_ElementInputType), INTENT(INOUT) :: u_out ! ElementInputType 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 ElementInputTypes - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_ElementInputType_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 + REAL(DbKi) :: t(2) ! Times associated with the ElementInputTypes + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_ElementInputType_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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) - DO i1 = LBOUND(u_out%vind_s,1),UBOUND(u_out%vind_s,1) - b = -(u1%vind_s(i1) - u2%vind_s(i1)) - u_out%vind_s(i1) = u1%vind_s(i1) + b * ScaleFactor - END DO - b = -(u1%spanRatio - u2%spanRatio) - u_out%spanRatio = u1%spanRatio + b * ScaleFactor - END SUBROUTINE DBEMT_ElementInputType_ExtrapInterp1 - - - SUBROUTINE DBEMT_ElementInputType_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + u_out%vind_s = a1*u1%vind_s + a2*u2%vind_s + u_out%spanRatio = a1*u1%spanRatio + a2*u2%spanRatio +END SUBROUTINE + +SUBROUTINE DBEMT_ElementInputType_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) ElementInputType 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. @@ -2851,109 +1010,104 @@ SUBROUTINE DBEMT_ElementInputType_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ! !.................................................................................................................................. - TYPE(DBEMT_ElementInputType), INTENT(IN) :: u1 ! ElementInputType at t1 > t2 > t3 - TYPE(DBEMT_ElementInputType), INTENT(IN) :: u2 ! ElementInputType at t2 > t3 - TYPE(DBEMT_ElementInputType), INTENT(IN) :: u3 ! ElementInputType at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the ElementInputTypes - TYPE(DBEMT_ElementInputType), INTENT(INOUT) :: u_out ! ElementInputType 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 + TYPE(DBEMT_ElementInputType), INTENT(IN) :: u1 ! ElementInputType at t1 > t2 > t3 + TYPE(DBEMT_ElementInputType), INTENT(IN) :: u2 ! ElementInputType at t2 > t3 + TYPE(DBEMT_ElementInputType), INTENT(IN) :: u3 ! ElementInputType at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the ElementInputTypes + TYPE(DBEMT_ElementInputType), INTENT(INOUT) :: u_out ! ElementInputType 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 ElementInputTypes - 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 = 'DBEMT_ElementInputType_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) - + REAL(DbKi) :: t(3) ! Times associated with the ElementInputTypes + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + INTEGER(IntKi) :: order ! order of polynomial fit (max 2) + REAL(DbKi) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_ElementInputType_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 + 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 + 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 + 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))) - DO i1 = LBOUND(u_out%vind_s,1),UBOUND(u_out%vind_s,1) - b = (t(3)**2*(u1%vind_s(i1) - u2%vind_s(i1)) + t(2)**2*(-u1%vind_s(i1) + u3%vind_s(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%vind_s(i1) + t(3)*u2%vind_s(i1) - t(2)*u3%vind_s(i1) ) * scaleFactor - u_out%vind_s(i1) = u1%vind_s(i1) + b + c * t_out - END DO - b = (t(3)**2*(u1%spanRatio - u2%spanRatio) + t(2)**2*(-u1%spanRatio + u3%spanRatio))* scaleFactor - c = ( (t(2)-t(3))*u1%spanRatio + t(3)*u2%spanRatio - t(2)*u3%spanRatio ) * scaleFactor - u_out%spanRatio = u1%spanRatio + b + c * t_out - END SUBROUTINE DBEMT_ElementInputType_ExtrapInterp2 - - - SUBROUTINE DBEMT_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(DBEMT_InputType), INTENT(IN) :: u(:) ! Input at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Inputs - TYPE(DBEMT_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 + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + u_out%vind_s = a1*u1%vind_s + a2*u2%vind_s + a3*u3%vind_s + u_out%spanRatio = a1*u1%spanRatio + a2*u2%spanRatio + a3*u3%spanRatio +END SUBROUTINE + +subroutine DBEMT_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(DBEMT_InputType), intent(in) :: u(:) ! Input at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Inputs + type(DBEMT_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 = 'DBEMT_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 DBEMT_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL DBEMT_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 DBEMT_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 DBEMT_Input_ExtrapInterp - - - SUBROUTINE DBEMT_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'DBEMT_Input_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(u)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(u)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(u) - 1 + select case (order) + case (0) + call DBEMT_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call DBEMT_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call DBEMT_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(u) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE DBEMT_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. @@ -2965,65 +1119,59 @@ SUBROUTINE DBEMT_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMs ! !.................................................................................................................................. - TYPE(DBEMT_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 - TYPE(DBEMT_InputType), INTENT(IN) :: u2 ! Input at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs - TYPE(DBEMT_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 + TYPE(DBEMT_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 + TYPE(DBEMT_InputType), INTENT(IN) :: u2 ! Input at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs + TYPE(DBEMT_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 = 'DBEMT_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 :: i02 ! dim2 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - INTEGER :: i2 ! dim2 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 + REAL(DbKi) :: t(2) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_Input_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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 :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 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 + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + u_out%AxInd_disk = a1*u1%AxInd_disk + a2*u2%AxInd_disk + u_out%Un_disk = a1*u1%Un_disk + a2*u2%Un_disk + u_out%R_disk = a1*u1%R_disk + a2*u2%R_disk + IF (ALLOCATED(u_out%element) .AND. ALLOCATED(u1%element)) THEN + do i02 = lbound(u_out%element,2),ubound(u_out%element,2) + do i01 = lbound(u_out%element,1),ubound(u_out%element,1) + u_out%element(i01,i02)%vind_s = a1*u1%element(i01,i02)%vind_s + a2*u2%element(i01,i02)%vind_s + END DO + END DO + do i02 = lbound(u_out%element,2),ubound(u_out%element,2) + do i01 = lbound(u_out%element,1),ubound(u_out%element,1) + u_out%element(i01,i02)%spanRatio = a1*u1%element(i01,i02)%spanRatio + a2*u2%element(i01,i02)%spanRatio + END DO + END DO + END IF ! check if allocated +END SUBROUTINE - ScaleFactor = t_out / t(2) - b = -(u1%AxInd_disk - u2%AxInd_disk) - u_out%AxInd_disk = u1%AxInd_disk + b * ScaleFactor - b = -(u1%Un_disk - u2%Un_disk) - u_out%Un_disk = u1%Un_disk + b * ScaleFactor - b = -(u1%R_disk - u2%R_disk) - u_out%R_disk = u1%R_disk + b * ScaleFactor -IF (ALLOCATED(u_out%element) .AND. ALLOCATED(u1%element)) THEN - DO i02 = LBOUND(u_out%element,2),UBOUND(u_out%element,2) - DO i01 = LBOUND(u_out%element,1),UBOUND(u_out%element,1) - DO i1 = LBOUND(u_out%element(i01,i02)%vind_s,1),UBOUND(u_out%element(i01,i02)%vind_s,1) - b = -(u1%element(i01,i02)%vind_s(i1) - u2%element(i01,i02)%vind_s(i1)) - u_out%element(i01,i02)%vind_s(i1) = u1%element(i01,i02)%vind_s(i1) + b * ScaleFactor - END DO - ENDDO - ENDDO - DO i02 = LBOUND(u_out%element,2),UBOUND(u_out%element,2) - DO i01 = LBOUND(u_out%element,1),UBOUND(u_out%element,1) - b = -(u1%element(i01,i02)%spanRatio - u2%element(i01,i02)%spanRatio) - u_out%element(i01,i02)%spanRatio = u1%element(i01,i02)%spanRatio + b * ScaleFactor - ENDDO - ENDDO -END IF ! check if allocated - END SUBROUTINE DBEMT_Input_ExtrapInterp1 - - - SUBROUTINE DBEMT_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) +SUBROUTINE DBEMT_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. @@ -3037,130 +1185,119 @@ SUBROUTINE DBEMT_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, E ! !.................................................................................................................................. - TYPE(DBEMT_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 > t3 - TYPE(DBEMT_InputType), INTENT(IN) :: u2 ! Input at t2 > t3 - TYPE(DBEMT_InputType), INTENT(IN) :: u3 ! Input at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs - TYPE(DBEMT_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 + TYPE(DBEMT_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 > t3 + TYPE(DBEMT_InputType), INTENT(IN) :: u2 ! Input at t2 > t3 + TYPE(DBEMT_InputType), INTENT(IN) :: u3 ! Input at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs + TYPE(DBEMT_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 = 'DBEMT_Input_ExtrapInterp2' - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - INTEGER :: i2 ! dim2 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) - + 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) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_Input_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 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 + 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 + 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 + 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))) - b = (t(3)**2*(u1%AxInd_disk - u2%AxInd_disk) + t(2)**2*(-u1%AxInd_disk + u3%AxInd_disk))* scaleFactor - c = ( (t(2)-t(3))*u1%AxInd_disk + t(3)*u2%AxInd_disk - t(2)*u3%AxInd_disk ) * scaleFactor - u_out%AxInd_disk = u1%AxInd_disk + b + c * t_out - b = (t(3)**2*(u1%Un_disk - u2%Un_disk) + t(2)**2*(-u1%Un_disk + u3%Un_disk))* scaleFactor - c = ( (t(2)-t(3))*u1%Un_disk + t(3)*u2%Un_disk - t(2)*u3%Un_disk ) * scaleFactor - u_out%Un_disk = u1%Un_disk + b + c * t_out - b = (t(3)**2*(u1%R_disk - u2%R_disk) + t(2)**2*(-u1%R_disk + u3%R_disk))* scaleFactor - c = ( (t(2)-t(3))*u1%R_disk + t(3)*u2%R_disk - t(2)*u3%R_disk ) * scaleFactor - u_out%R_disk = u1%R_disk + b + c * t_out -IF (ALLOCATED(u_out%element) .AND. ALLOCATED(u1%element)) THEN - DO i02 = LBOUND(u_out%element,2),UBOUND(u_out%element,2) - DO i01 = LBOUND(u_out%element,1),UBOUND(u_out%element,1) - DO i1 = LBOUND(u_out%element(i01,i02)%vind_s,1),UBOUND(u_out%element(i01,i02)%vind_s,1) - b = (t(3)**2*(u1%element(i01,i02)%vind_s(i1) - u2%element(i01,i02)%vind_s(i1)) + t(2)**2*(-u1%element(i01,i02)%vind_s(i1) + u3%element(i01,i02)%vind_s(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%element(i01,i02)%vind_s(i1) + t(3)*u2%element(i01,i02)%vind_s(i1) - t(2)*u3%element(i01,i02)%vind_s(i1) ) * scaleFactor - u_out%element(i01,i02)%vind_s(i1) = u1%element(i01,i02)%vind_s(i1) + b + c * t_out - END DO - ENDDO - ENDDO - DO i02 = LBOUND(u_out%element,2),UBOUND(u_out%element,2) - DO i01 = LBOUND(u_out%element,1),UBOUND(u_out%element,1) - b = (t(3)**2*(u1%element(i01,i02)%spanRatio - u2%element(i01,i02)%spanRatio) + t(2)**2*(-u1%element(i01,i02)%spanRatio + u3%element(i01,i02)%spanRatio))* scaleFactor - c = ( (t(2)-t(3))*u1%element(i01,i02)%spanRatio + t(3)*u2%element(i01,i02)%spanRatio - t(2)*u3%element(i01,i02)%spanRatio ) * scaleFactor - u_out%element(i01,i02)%spanRatio = u1%element(i01,i02)%spanRatio + b + c * t_out - ENDDO - ENDDO -END IF ! check if allocated - END SUBROUTINE DBEMT_Input_ExtrapInterp2 - - - SUBROUTINE DBEMT_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(DBEMT_OutputType), INTENT(IN) :: y(:) ! Output at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Outputs - TYPE(DBEMT_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 + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + u_out%AxInd_disk = a1*u1%AxInd_disk + a2*u2%AxInd_disk + a3*u3%AxInd_disk + u_out%Un_disk = a1*u1%Un_disk + a2*u2%Un_disk + a3*u3%Un_disk + u_out%R_disk = a1*u1%R_disk + a2*u2%R_disk + a3*u3%R_disk + IF (ALLOCATED(u_out%element) .AND. ALLOCATED(u1%element)) THEN + do i02 = lbound(u_out%element,2),ubound(u_out%element,2) + do i01 = lbound(u_out%element,1),ubound(u_out%element,1) + u_out%element(i01,i02)%vind_s = a1*u1%element(i01,i02)%vind_s + a2*u2%element(i01,i02)%vind_s + a3*u3%element(i01,i02)%vind_s + END DO + END DO + do i02 = lbound(u_out%element,2),ubound(u_out%element,2) + do i01 = lbound(u_out%element,1),ubound(u_out%element,1) + u_out%element(i01,i02)%spanRatio = a1*u1%element(i01,i02)%spanRatio + a2*u2%element(i01,i02)%spanRatio + a3*u3%element(i01,i02)%spanRatio + END DO + END DO + END IF ! check if allocated +END SUBROUTINE + +subroutine DBEMT_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(DBEMT_OutputType), intent(in) :: y(:) ! Output at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Outputs + type(DBEMT_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 = 'DBEMT_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 DBEMT_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL DBEMT_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 DBEMT_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 DBEMT_Output_ExtrapInterp - - - SUBROUTINE DBEMT_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'DBEMT_Output_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(y)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(y)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(y) - 1 + select case (order) + case (0) + call DBEMT_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call DBEMT_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call DBEMT_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(y) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE DBEMT_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. @@ -3172,55 +1309,49 @@ SUBROUTINE DBEMT_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrM ! !.................................................................................................................................. - TYPE(DBEMT_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 - TYPE(DBEMT_OutputType), INTENT(IN) :: y2 ! Output at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs - TYPE(DBEMT_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 + TYPE(DBEMT_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 + TYPE(DBEMT_OutputType), INTENT(IN) :: y2 ! Output at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs + TYPE(DBEMT_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 = 'DBEMT_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 :: i02 ! dim2 level 0 counter variable for arrays of ddts - INTEGER :: i03 ! dim3 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - INTEGER :: i2 ! dim2 counter variable for arrays - INTEGER :: i3 ! dim3 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 + REAL(DbKi) :: t(2) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_Output_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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 :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i03 ! dim3 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 counter variable for arrays + INTEGER :: i3 ! dim3 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%vind) .AND. ALLOCATED(y1%vind)) THEN - DO i3 = LBOUND(y_out%vind,3),UBOUND(y_out%vind,3) - DO i2 = LBOUND(y_out%vind,2),UBOUND(y_out%vind,2) - DO i1 = LBOUND(y_out%vind,1),UBOUND(y_out%vind,1) - b = -(y1%vind(i1,i2,i3) - y2%vind(i1,i2,i3)) - y_out%vind(i1,i2,i3) = y1%vind(i1,i2,i3) + b * ScaleFactor - END DO - END DO - END DO -END IF ! check if allocated - END SUBROUTINE DBEMT_Output_ExtrapInterp1 - - - SUBROUTINE DBEMT_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + IF (ALLOCATED(y_out%vind) .AND. ALLOCATED(y1%vind)) THEN + y_out%vind = a1*y1%vind + a2*y2%vind + END IF ! check if allocated +END SUBROUTINE + +SUBROUTINE DBEMT_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. @@ -3234,62 +1365,54 @@ SUBROUTINE DBEMT_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ! !.................................................................................................................................. - TYPE(DBEMT_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 > t3 - TYPE(DBEMT_OutputType), INTENT(IN) :: y2 ! Output at t2 > t3 - TYPE(DBEMT_OutputType), INTENT(IN) :: y3 ! Output at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs - TYPE(DBEMT_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 + TYPE(DBEMT_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 > t3 + TYPE(DBEMT_OutputType), INTENT(IN) :: y2 ! Output at t2 > t3 + TYPE(DBEMT_OutputType), INTENT(IN) :: y3 ! Output at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs + TYPE(DBEMT_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 = 'DBEMT_Output_ExtrapInterp2' - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts - INTEGER :: i03 ! dim3 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - INTEGER :: i2 ! dim2 counter variable for arrays - INTEGER :: i3 ! dim3 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) - + 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) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i03 ! dim3 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 counter variable for arrays + INTEGER :: i3 ! dim3 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 + 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 + 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 + 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%vind) .AND. ALLOCATED(y1%vind)) THEN - DO i3 = LBOUND(y_out%vind,3),UBOUND(y_out%vind,3) - DO i2 = LBOUND(y_out%vind,2),UBOUND(y_out%vind,2) - DO i1 = LBOUND(y_out%vind,1),UBOUND(y_out%vind,1) - b = (t(3)**2*(y1%vind(i1,i2,i3) - y2%vind(i1,i2,i3)) + t(2)**2*(-y1%vind(i1,i2,i3) + y3%vind(i1,i2,i3)))* scaleFactor - c = ( (t(2)-t(3))*y1%vind(i1,i2,i3) + t(3)*y2%vind(i1,i2,i3) - t(2)*y3%vind(i1,i2,i3) ) * scaleFactor - y_out%vind(i1,i2,i3) = y1%vind(i1,i2,i3) + b + c * t_out - END DO - END DO - END DO -END IF ! check if allocated - END SUBROUTINE DBEMT_Output_ExtrapInterp2 - + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + IF (ALLOCATED(y_out%vind) .AND. ALLOCATED(y1%vind)) THEN + y_out%vind = a1*y1%vind + a2*y2%vind + a3*y3%vind + END IF ! check if allocated +END SUBROUTINE END MODULE DBEMT_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/aerodyn/src/FVW.f90 b/modules/aerodyn/src/FVW.f90 index f3cf5fb330..2c55f4dc27 100644 --- a/modules/aerodyn/src/FVW.f90 +++ b/modules/aerodyn/src/FVW.f90 @@ -352,7 +352,6 @@ subroutine FVW_SetParametersFromInputs( InitInp, p, ErrStat, ErrMsg ) integer(IntKi), intent( out) :: ErrStat !< Error status of the operation character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None ! Local variables - character(1024) :: rootDir, baseName ! Simulation root dir and basename integer(IntKi) :: iW, nBldMax integer(IntKi), allocatable :: nBldPerRot(:) integer(IntKi) :: ErrStat2 @@ -481,7 +480,7 @@ subroutine FVW_FinalWrite(u, p, x, z, m, ErrStat, ErrMsg) ErrMsg = "" ! Place any last minute operations or calculations here: if (p%WrVTK>0 .and. m%VTKstep>> FINAL WRITE' + call WrScr('OLAF: writting final VTK outputs') t=-1.0_ReKi if (p%WrVTK==1) then if (m%VTKstep Export FVW variables to VTK diff --git a/modules/aerodyn/src/FVW_Registry.txt b/modules/aerodyn/src/FVW_Registry.txt index 698cbf0634..bdfef5796e 100644 --- a/modules/aerodyn/src/FVW_Registry.txt +++ b/modules/aerodyn/src/FVW_Registry.txt @@ -209,6 +209,7 @@ typedef ^ ^ ReKi typedef ^ ^ ReKi Uind :: - - "Induced velocities obtained at control points" - # Outputs typedef ^ ^ GridOutType GridOutputs {:} - - "Number of VTK grid to output" - +typedef ^ ^ Logical InfoReeval - .true. - "Give info about Reevaluation: gets set to false after first info statement" - # ........ Input ............ # Rotors @@ -263,11 +264,8 @@ typedef ^ ^ ReKi typedef ^ ^ IntKi MHK - - - "MHK flag" - typedef ^ ^ ReKi WtrDpth - - - "Water depth" m # TODO UA - Should be part of AeroDyn -typedef ^ ^ IntKi UAMod - - - "Model for the dynamic stall equations [1 = Leishman/Beddoes, 2 = Gonzalez, 3 = Minnema]" - typedef ^ ^ LOGICAL UA_Flag - - - "logical flag indicating whether to use UnsteadyAero" - -typedef ^ ^ LOGICAL Flookup - - - "Use table lookup for f' and f'' " - -typedef ^ ^ ReKi a_s - - - "speed of sound" m/s -typedef ^ ^ LOGICAL SumPrint - - - "Whether to print summary file (primarially in in UA)" - +typedef ^ ^ UA_InitInputType UA_Init - - - "InitInput data for UA model" #.......... InputFileType ...... # FVW_InputFile diff --git a/modules/aerodyn/src/FVW_Subs.f90 b/modules/aerodyn/src/FVW_Subs.f90 index 64dc8c6a28..c874f07c8c 100644 --- a/modules/aerodyn/src/FVW_Subs.f90 +++ b/modules/aerodyn/src/FVW_Subs.f90 @@ -130,10 +130,11 @@ subroutine ReadAndInterpGamma(CirculationFileName, s_CP_LL, L, Gamma_CP_LL, ErrS real(ReKi), parameter :: ReNaN = huge(1.0_ReKi) ErrStat = ErrID_None ErrMsg = '' + ! TODO Poentially use ReadDelimFile Instead ! --- call GetNewUnit(iUnit) call OpenFInpFile(iUnit, CirculationFileName, errStat2, errMsg2); if(Failed()) return - nLines=line_count(iUnit)-1 + nLines=line_count(iUnit, errStat2, errMsg2)-1 ! Read Header read(iUnit,*, iostat=errStat2) line ; if(Failed()) return ! Read table: s/L [-], GammaPresc [m^2/s] @@ -172,28 +173,6 @@ logical function Failed() if (Failed) call CleanUp() end function Failed - !> Counts number of lines in a file - integer function line_count(iunit) - integer(IntKi), intent(in) :: iunit - character(len=1054) :: line - ! safety for infinite loop.. - integer(IntKi), parameter :: nline_max=100000000 ! 100 M - integer(IntKi) :: i - line_count=0 - do i=1,nline_max - line='' - read(iunit,'(A)',END=100)line - line_count=line_count+1 - enddo - if (line_count==nline_max) then - print*,'Error: maximum number of line exceeded' - endif - 100 if(len(trim(line))>0) then - line_count=line_count+1 - endif - rewind(iunit) - end function - endsubroutine ReadAndInterpGamma ! ===================================================================================== @@ -415,17 +394,20 @@ end subroutine PropagateWake !> Print the states, useful for debugging -subroutine print_x_NW_FW(p, m, x, label) +subroutine print_x_NW_FW(p, m, x, label, nSteps_in) type(FVW_ParameterType), intent(in) :: p !< Parameters type(FVW_MiscVarType), intent(in) :: m !< Initial misc/optimization variables type(FVW_ContinuousStateType), intent(in) :: x !< Continuous states + integer(IntKi), optional, intent(in) :: nSteps_in !< number of steps to limit to character(len=*),intent(in) :: label - integer(IntKi) :: iAge, iW + integer(IntKi) :: iAge, iW, nSteps character(len=1):: flag + nSteps=99999999 ! big number + if (present(nSteps_in)) nSteps = nSteps_in print*,'------------------------------------------------------------------' print'(A,I0,A,I0)',' NW .....................iNWStart:',p%iNWStart,' nNW:',m%nNW iW=1 - do iAge=1,p%nNWMax+1 + do iAge=1,min(p%nNWMax+1,nSteps) flag='X' if ((iAge)<= m%nNW+1) flag='.' print'(A,A,I0,A)',flag,'iAge ',iAge,' Root Tip' @@ -438,7 +420,7 @@ subroutine print_x_NW_FW(p, m, x, label) endif enddo print'(A,I0)','FW <<<<<<<<<<<<<<<<<<<< nFW:',m%nFW - do iAge=1,p%nFWMax+1 + do iAge=1,min(p%nFWMax+1,nSteps) flag='X' if ((iAge)<= m%nFW+1) flag='.' print'(A,A,I0,A)',flag,'iAge ',iAge,' Root Tip' @@ -480,11 +462,11 @@ logical function have_nan(p, m, x, z, u, label) have_nan=.True. endif if (any(isnan(x%W(iW)%Eps_NW))) then - print*,trim(label),'NaN in G_FW'//trim(num2lstr(iW)) + print*,trim(label),'NaN in E_NW'//trim(num2lstr(iW)) have_nan=.True. endif if (any(isnan(x%W(iW)%Eps_FW))) then - print*,trim(label),'NaN in G_FW'//trim(num2lstr(iW)) + print*,trim(label),'NaN in E_FW'//trim(num2lstr(iW)) have_nan=.True. endif if (any(isnan(z%W(iW)%Gamma_LL))) then @@ -1047,8 +1029,8 @@ subroutine FVW_InitRegularization(x, p, m, ErrStat, ErrMsg) if (p%RegDeterMethod==idRegDeterConstant) then ! Constant reg param throughout the wake if (p%WakeRegMethod==idRegAge) then ! NOTE: age method implies a division by rc - p%WingRegParam=max(0.01, p%WingRegParam) - p%WakeRegParam=max(0.01, p%WakeRegParam) + p%WingRegParam=max(0.01_ReKi, p%WingRegParam) + p%WakeRegParam=max(0.01_ReKi, p%WakeRegParam) endif ! Set reg param on wing and first NW @@ -1620,12 +1602,13 @@ subroutine FakeGroundEffect(p, x, m, ErrStat, ErrMsg) character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None integer(IntKi) :: iAge, iW, iSpan integer(IntKi) :: nBelow + integer(IntKi) :: nBelowFW real(ReKi) :: GROUND real(ReKi) :: ABOVE_GROUND ErrStat = ErrID_None ErrMsg = "" - if ( p%MHK == 1 .or. p%MHK == 2 ) then + if ( p%MHK /= MHK_None ) then GROUND = 1.e-4_ReKi - p%WtrDpth ABOVE_GROUND = 0.1_ReKi - p%WtrDpth else @@ -1634,6 +1617,7 @@ subroutine FakeGroundEffect(p, x, m, ErrStat, ErrMsg) endif nBelow=0 + nBelowFW=0 do iW = 1,p%nWings do iAge = 1,m%nNW+1 do iSpan = 1,p%W(iW)%nSpan+1 @@ -1647,10 +1631,11 @@ subroutine FakeGroundEffect(p, x, m, ErrStat, ErrMsg) if (m%nFW>0) then do iW = 1,p%nWings do iAge = 1,m%nFW+1 - do iSpan = 1,FWnSpan + do iSpan = 1,FWnSpan+1 if (x%W(iW)%r_FW(3, iSpan, iAge) < GROUND) then x%W(iW)%r_FW(3, iSpan, iAge) = ABOVE_GROUND ! could use m%dxdt nBelow=nBelow+1 + nBelowFW=nBelowFW+1 endif enddo enddo @@ -1659,6 +1644,9 @@ subroutine FakeGroundEffect(p, x, m, ErrStat, ErrMsg) if (nBelow>0) then print*,'[WARN] Check the simulation, some vortices were found below the ground: ',nBelow endif + if (nBelowFW>0) then + print*,'[WARN] Check the simulation, some far-wake vortices were found below the ground: ',nBelowFW + endif end subroutine FakeGroundEffect !> Compute typical aerodynamic outputs based on: diff --git a/modules/aerodyn/src/FVW_Tests.f90 b/modules/aerodyn/src/FVW_Tests.f90 index 6de6f7dff1..e2299e97e1 100644 --- a/modules/aerodyn/src/FVW_Tests.f90 +++ b/modules/aerodyn/src/FVW_Tests.f90 @@ -653,8 +653,8 @@ subroutine Test_LatticeToSegment(mvtk,iStat) ! Test trailed vorticity ! LatticeGamma2(1,:)=1 ! LatticeGamma2(2,:)=2 - CALL MeshMe(LatticePoints1,(/0.,0.,0./)) - CALL MeshMe(LatticePoints2,(/0.,0.,1./)) + CALL MeshMe(LatticePoints1,(/0.0_ReKi,0.0_ReKi,0.0_ReKi/)) + CALL MeshMe(LatticePoints2,(/0.0_ReKi,0.0_ReKi,1.0_ReKi/)) CALL WrVTK_Lattice('Points1.vtk',mvtk,LatticePoints1, LatticeGamma1, bladeframe=bladeframe) CALL WrVTK_Lattice('Points2.vtk',mvtk,LatticePoints2, LatticeGamma2, bladeframe=bladeframe) diff --git a/modules/aerodyn/src/FVW_Types.f90 b/modules/aerodyn/src/FVW_Types.f90 index 40021d6932..caad8c1935 100644 --- a/modules/aerodyn/src/FVW_Types.f90 +++ b/modules/aerodyn/src/FVW_Types.f90 @@ -31,6 +31,7 @@ !! unpack routines associated with each defined data type. This code is automatically generated by the FAST Registry. MODULE FVW_Types !--------------------------------------------------------------------------------------------------------------------------------- +USE AirfoilInfo_Types USE UnsteadyAero_Types USE NWTC_Library IMPLICIT NONE @@ -39,22 +40,22 @@ MODULE FVW_Types ! ========= GridOutType ======= TYPE, PUBLIC :: GridOutType CHARACTER(100) :: name !< Grid name [-] - INTEGER(IntKi) :: type !< Grid type [-] - REAL(ReKi) :: tStart !< Time at which outputs starts [-] - REAL(ReKi) :: tEnd !< Time at which outputs ends [-] - REAL(ReKi) :: DTout !< Output frequency of grid [-] - REAL(ReKi) :: xStart !< xStart [-] - REAL(ReKi) :: yStart !< yStart [-] - REAL(ReKi) :: zStart !< zStart [-] - REAL(ReKi) :: xEnd !< xEnd [-] - REAL(ReKi) :: yEnd !< yEnd [-] - REAL(ReKi) :: zEnd !< zEnd [-] - INTEGER(IntKi) :: nx !< nx [-] - INTEGER(IntKi) :: ny !< ny [-] - INTEGER(IntKi) :: nz !< nz [-] + INTEGER(IntKi) :: type = 0_IntKi !< Grid type [-] + REAL(ReKi) :: tStart = 0.0_ReKi !< Time at which outputs starts [-] + REAL(ReKi) :: tEnd = 0.0_ReKi !< Time at which outputs ends [-] + REAL(ReKi) :: DTout = 0.0_ReKi !< Output frequency of grid [-] + REAL(ReKi) :: xStart = 0.0_ReKi !< xStart [-] + REAL(ReKi) :: yStart = 0.0_ReKi !< yStart [-] + REAL(ReKi) :: zStart = 0.0_ReKi !< zStart [-] + REAL(ReKi) :: xEnd = 0.0_ReKi !< xEnd [-] + REAL(ReKi) :: yEnd = 0.0_ReKi !< yEnd [-] + REAL(ReKi) :: zEnd = 0.0_ReKi !< zEnd [-] + INTEGER(IntKi) :: nx = 0_IntKi !< nx [-] + INTEGER(IntKi) :: ny = 0_IntKi !< ny [-] + INTEGER(IntKi) :: nz = 0_IntKi !< nz [-] REAL(ReKi) , DIMENSION(:,:,:,:), ALLOCATABLE :: uGrid !< Grid velocity 3 x nz x ny x nx [-] REAL(ReKi) , DIMENSION(:,:,:,:), ALLOCATABLE :: omGrid !< Grid vorticity 3 x nz x ny x nx [-] - REAL(DbKi) :: tLastOutput !< Last output time [-] + REAL(DbKi) :: tLastOutput = 0.0_R8Ki !< Last output time [-] END TYPE GridOutType ! ======================= ! ========= T_Sgmt ======= @@ -63,9 +64,9 @@ MODULE FVW_Types INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: Connct !< Connectivity of segments [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Gamma !< Segment circulations [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Epsilon !< Segment regularization parameter [-] - INTEGER(IntKi) :: RegFunction !< Type of regularizaion function (LambOseen, Vatistas, see FVW_BiotSavart) [-] - INTEGER(IntKi) :: nAct !< Number of active segments [-] - INTEGER(IntKi) :: nActP !< Number of active segment points [-] + INTEGER(IntKi) :: RegFunction = 0_IntKi !< Type of regularizaion function (LambOseen, Vatistas, see FVW_BiotSavart) [-] + INTEGER(IntKi) :: nAct = 0_IntKi !< Number of active segments [-] + INTEGER(IntKi) :: nActP = 0_IntKi !< Number of active segment points [-] END TYPE T_Sgmt ! ======================= ! ========= T_Part ======= @@ -73,8 +74,8 @@ MODULE FVW_Types REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: P !< Particle Points [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Alpha !< Particle intensity 3 x nP [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: RegParam !< Particle regularization parameter [-] - INTEGER(IntKi) :: RegFunction !< Type of regularizaion function (FVW_BiotSavart) [-] - INTEGER(IntKi) :: nAct !< Number of active particles <=nP [-] + INTEGER(IntKi) :: RegFunction = 0_IntKi !< Type of regularizaion function (FVW_BiotSavart) [-] + INTEGER(IntKi) :: nAct = 0_IntKi !< Number of active particles <=nP [-] END TYPE T_Part ! ======================= ! ========= Wng_ParameterType ======= @@ -83,57 +84,57 @@ MODULE FVW_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: chord_CP !< Chord on LL cp [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: s_LL !< Spanwise coordinate of LL elements [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: s_CP !< Spanwise coordinate of LL CP [m] - INTEGER(IntKi) :: iRotor !< Index of rotor the wing belong to [-] + INTEGER(IntKi) :: iRotor = 0_IntKi !< Index of rotor the wing belong to [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: AFindx !< Index to the airfoils from AD15 [BladeNode,BladeIndex=1] [-] - INTEGER(IntKi) :: nSpan !< TODO, should be defined per wing. Number of spanwise element [-] + INTEGER(IntKi) :: nSpan = 0_IntKi !< TODO, should be defined per wing. Number of spanwise element [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: PrescribedCirculation !< Prescribed circulation on all lifting lines [m/s] END TYPE Wng_ParameterType ! ======================= ! ========= FVW_ParameterType ======= TYPE, PUBLIC :: FVW_ParameterType - INTEGER(IntKi) :: nRotors !< Number of Wings [-] - INTEGER(IntKi) :: nWings !< Number of Wings [-] + INTEGER(IntKi) :: nRotors = 0_IntKi !< Number of Wings [-] + INTEGER(IntKi) :: nWings = 0_IntKi !< Number of Wings [-] TYPE(Wng_ParameterType) , DIMENSION(:), ALLOCATABLE :: W !< Wings parameters [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: Bld2Wings !< Index mapping from blades to wings [-] - INTEGER(IntKi) :: iNWStart !< Index where NW start in r_NW. (iNWStart=2, the first panel contains the lifting line panel, otherwise, start at 1) [-] - INTEGER(IntKi) :: nNWMax !< Maximum number of nw panels, per wing [-] - INTEGER(IntKi) :: nNWFree !< Number of nw panels that are free, per wing [-] - INTEGER(IntKi) :: nFWMax !< Maximum number of fw panels, per wing [-] - INTEGER(IntKi) :: nFWFree !< Number of fw panels that are free, per wing [-] - LOGICAL :: FWShedVorticity !< Include shed vorticity in the far wake [-] - INTEGER(IntKi) :: IntMethod !< Integration Method (1=RK4, 2=AB4, 3=ABM4, 5=Euler1) [-] - REAL(ReKi) :: FreeWakeStart !< Time when wake starts convecting (rolling up) [s] - REAL(ReKi) :: FullCircStart !< Time when the circulation is full [s] - INTEGER(IntKi) :: CircSolvMethod !< Method to determine the circulation [-] - INTEGER(IntKi) :: CircSolvMaxIter !< Maximum number of iterations for circulation solving [-] - REAL(ReKi) :: CircSolvConvCrit !< Convergence criterion for circulation solving [-] - REAL(ReKi) :: CircSolvRelaxation !< Relaxation factor for circulation solving [-] - INTEGER(IntKi) :: CircSolvPolar !< (0=Use AD polars, 1=2PiAlpha, 2=sin(2pialpha) [-] - INTEGER(IntKi) :: DiffusionMethod !< Diffusion method (None, CoreSpreading, PSE) [-] - REAL(ReKi) :: CoreSpreadEddyVisc !< Eddy viscosity used in the core spreading method [-] - INTEGER(IntKi) :: RegDeterMethod !< Regularization determinatino method (manual, automatic) [-] - INTEGER(IntKi) :: RegFunction !< Type of regularizaion function (LambOseen, Vatistas, see FVW_BiotSavart) [-] - INTEGER(IntKi) :: WakeRegMethod !< Method for regularization (constant, stretching, age, etc.) [-] - REAL(ReKi) :: WakeRegParam !< Initial value of the regularization parameter [-] - REAL(ReKi) :: WingRegParam !< Regularization parameter of the wing [-] - INTEGER(IntKi) :: ShearModel !< Option for shear modelling [-] - LOGICAL :: TwrShadowOnWake !< Include tower shadow effects on wake [-] - INTEGER(IntKi) , DIMENSION(1:2) :: VelocityMethod !< Velocity calculation method for Full Wake and for LiftingLine [-] - REAL(ReKi) , DIMENSION(1:2) :: TreeBranchFactor !< Factor used to determine if a point is far enough, for full wake and lifting line [-] - INTEGER(IntKi) , DIMENSION(1:2) :: PartPerSegment !< Number of particles per segment, e.g. for tree method, for full wake and lifting line [-] - REAL(DbKi) :: DTaero !< Time interval for calls calculations [s] - REAL(DbKi) :: DTfvw !< Time interval for calculating wake induced velocities [s] - REAL(ReKi) :: KinVisc !< Kinematic air viscosity [m^2/s] - INTEGER(IntKi) :: MHK !< MHK flag [-] - REAL(ReKi) :: WtrDpth !< Water depth [m] - INTEGER(IntKi) :: WrVTK !< Outputs VTK at each calcoutput call, even if main fst doesnt do it [-] - INTEGER(IntKi) :: VTKBlades !< Outputs VTk for each blade 0=no blade, 1=Bld 1 [-] - REAL(DbKi) :: DTvtk !< DT between vtk writes [s] - INTEGER(IntKi) :: VTKCoord !< Switch for VTK outputs coordinate system [-] + INTEGER(IntKi) :: iNWStart = 0_IntKi !< Index where NW start in r_NW. (iNWStart=2, the first panel contains the lifting line panel, otherwise, start at 1) [-] + INTEGER(IntKi) :: nNWMax = 0_IntKi !< Maximum number of nw panels, per wing [-] + INTEGER(IntKi) :: nNWFree = 0_IntKi !< Number of nw panels that are free, per wing [-] + INTEGER(IntKi) :: nFWMax = 0_IntKi !< Maximum number of fw panels, per wing [-] + INTEGER(IntKi) :: nFWFree = 0_IntKi !< Number of fw panels that are free, per wing [-] + LOGICAL :: FWShedVorticity = .false. !< Include shed vorticity in the far wake [-] + INTEGER(IntKi) :: IntMethod = 0_IntKi !< Integration Method (1=RK4, 2=AB4, 3=ABM4, 5=Euler1) [-] + REAL(ReKi) :: FreeWakeStart = 0.0_ReKi !< Time when wake starts convecting (rolling up) [s] + REAL(ReKi) :: FullCircStart = 0.0_ReKi !< Time when the circulation is full [s] + INTEGER(IntKi) :: CircSolvMethod = 0_IntKi !< Method to determine the circulation [-] + INTEGER(IntKi) :: CircSolvMaxIter = 0_IntKi !< Maximum number of iterations for circulation solving [-] + REAL(ReKi) :: CircSolvConvCrit = 0.0_ReKi !< Convergence criterion for circulation solving [-] + REAL(ReKi) :: CircSolvRelaxation = 0.0_ReKi !< Relaxation factor for circulation solving [-] + INTEGER(IntKi) :: CircSolvPolar = 0_IntKi !< (0=Use AD polars, 1=2PiAlpha, 2=sin(2pialpha) [-] + INTEGER(IntKi) :: DiffusionMethod = 0_IntKi !< Diffusion method (None, CoreSpreading, PSE) [-] + REAL(ReKi) :: CoreSpreadEddyVisc = 0.0_ReKi !< Eddy viscosity used in the core spreading method [-] + INTEGER(IntKi) :: RegDeterMethod = 0_IntKi !< Regularization determinatino method (manual, automatic) [-] + INTEGER(IntKi) :: RegFunction = 0_IntKi !< Type of regularizaion function (LambOseen, Vatistas, see FVW_BiotSavart) [-] + INTEGER(IntKi) :: WakeRegMethod = 0_IntKi !< Method for regularization (constant, stretching, age, etc.) [-] + REAL(ReKi) :: WakeRegParam = 0.0_ReKi !< Initial value of the regularization parameter [-] + REAL(ReKi) :: WingRegParam = 0.0_ReKi !< Regularization parameter of the wing [-] + INTEGER(IntKi) :: ShearModel = 0_IntKi !< Option for shear modelling [-] + LOGICAL :: TwrShadowOnWake = .false. !< Include tower shadow effects on wake [-] + INTEGER(IntKi) , DIMENSION(1:2) :: VelocityMethod = 0_IntKi !< Velocity calculation method for Full Wake and for LiftingLine [-] + REAL(ReKi) , DIMENSION(1:2) :: TreeBranchFactor = 0.0_ReKi !< Factor used to determine if a point is far enough, for full wake and lifting line [-] + INTEGER(IntKi) , DIMENSION(1:2) :: PartPerSegment = 0_IntKi !< Number of particles per segment, e.g. for tree method, for full wake and lifting line [-] + REAL(DbKi) :: DTaero = 0.0_R8Ki !< Time interval for calls calculations [s] + REAL(DbKi) :: DTfvw = 0.0_R8Ki !< Time interval for calculating wake induced velocities [s] + REAL(ReKi) :: KinVisc = 0.0_ReKi !< Kinematic air viscosity [m^2/s] + INTEGER(IntKi) :: MHK = 0_IntKi !< MHK flag [-] + REAL(ReKi) :: WtrDpth = 0.0_ReKi !< Water depth [m] + INTEGER(IntKi) :: WrVTK = 0_IntKi !< Outputs VTK at each calcoutput call, even if main fst doesnt do it [-] + INTEGER(IntKi) :: VTKBlades = 0_IntKi !< Outputs VTk for each blade 0=no blade, 1=Bld 1 [-] + REAL(DbKi) :: DTvtk = 0.0_R8Ki !< DT between vtk writes [s] + INTEGER(IntKi) :: VTKCoord = 0_IntKi !< Switch for VTK outputs coordinate system [-] CHARACTER(1024) :: RootName !< RootName for writing output files [-] CHARACTER(1024) :: VTK_OutFileRoot !< Rootdirectory for writing VTK files [-] CHARACTER(1024) :: VTK_OutFileBase !< Basename for writing VTK files [-] - INTEGER(IntKi) :: nGridOut !< Number of VTK grid to output [-] + INTEGER(IntKi) :: nGridOut = 0_IntKi !< Number of VTK grid to output [-] LOGICAL :: InductionAtCP = .true. !< Compute induced velocities at nodes or CP [-] LOGICAL :: WakeAtTE = .true. !< Start the wake at the trailing edge, or at the LL [-] LOGICAL :: DStallOnWake = .false. !< Dynamic stall has influence on wake [-] @@ -189,8 +190,8 @@ MODULE FVW_Types REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: Vind_NW !< Induced velocity on near wake panels [m/s] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: Vind_FW !< Induced velocity on far wake panels [m/s] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: PitchAndTwist !< Twist angle (includes all sources of twist) [Array of size (NumBlNds,numBlades)] [rad] - INTEGER(IntKi) :: iTip !< Index where tip vorticity will be placed. TODO, per blade [-] - INTEGER(IntKi) :: iRoot !< Index where root vorticity will be placed [-] + INTEGER(IntKi) :: iTip = 0_IntKi !< Index where tip vorticity will be placed. TODO, per blade [-] + INTEGER(IntKi) :: iRoot = 0_IntKi !< Index where root vorticity will be placed [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: alpha_LL !< Angle of attack at lifting line CP, only computed with CircPolarData method [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Vreln_LL !< Norm of Vrel on the lifting line [-] TYPE(UA_InputType) , DIMENSION(:,:), ALLOCATABLE :: u_UA !< inputs to UnsteadyAero numNode x 2 (t and t+dt) [-] @@ -219,32 +220,33 @@ MODULE FVW_Types ! ========= FVW_MiscVarType ======= TYPE, PUBLIC :: FVW_MiscVarType TYPE(Wng_MiscVarType) , DIMENSION(:), ALLOCATABLE :: W !< Misc for all wings [-] - LOGICAL :: FirstCall !< True if this is the first call to update state (used in CalcOutput) [-] - INTEGER(IntKi) :: nNW !< Number of active near wake panels [-] - INTEGER(IntKi) :: nFW !< Number of active far wake panels [-] - INTEGER(IntKi) :: iStep !< Current step number used for update state [-] - INTEGER(IntKi) :: VTKstep !< Current vtk output step number [-] - REAL(DbKi) :: VTKlastTime !< Time the last VTK file set was written out [s] + LOGICAL :: FirstCall = .false. !< True if this is the first call to update state (used in CalcOutput) [-] + INTEGER(IntKi) :: nNW = 0_IntKi !< Number of active near wake panels [-] + INTEGER(IntKi) :: nFW = 0_IntKi !< Number of active far wake panels [-] + INTEGER(IntKi) :: iStep = 0_IntKi !< Current step number used for update state [-] + INTEGER(IntKi) :: VTKstep = 0_IntKi !< Current vtk output step number [-] + REAL(DbKi) :: VTKlastTime = 0.0_R8Ki !< Time the last VTK file set was written out [s] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: r_wind !< List of points where wind is requested for next time step [-] - LOGICAL :: ComputeWakeInduced !< Compute induced velocities on this timestep [-] - REAL(DbKi) :: OldWakeTime !< Time the wake induction velocities were last calculated [s] + LOGICAL :: ComputeWakeInduced = .false. !< Compute induced velocities on this timestep [-] + REAL(DbKi) :: OldWakeTime = 0.0_R8Ki !< Time the wake induction velocities were last calculated [s] TYPE(FVW_ContinuousStateType) :: dxdt !< State time derivatie, stored for overcycling and convenience [-] TYPE(FVW_ContinuousStateType) :: x1 !< States at t (for overcycling) [-] TYPE(FVW_ContinuousStateType) :: x2 !< States at t+DTFVW (for overcycling) [-] - REAL(DbKi) :: t1 !< Time of x1 (for overcycling) [-] - REAL(DbKi) :: t2 !< Time of x2 t+DTFVW (for overcycling) [-] - LOGICAL :: UA_Flag !< logical flag indicating whether to use UnsteadyAero [-] + REAL(DbKi) :: t1 = 0.0_R8Ki !< Time of x1 (for overcycling) [-] + REAL(DbKi) :: t2 = 0.0_R8Ki !< Time of x2 t+DTFVW (for overcycling) [-] + LOGICAL :: UA_Flag = .false. !< logical flag indicating whether to use UnsteadyAero [-] TYPE(T_Sgmt) :: Sgmt !< Segments storage [-] TYPE(T_Part) :: Part !< Particle storage [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: CPs !< Control points used for wake rollup computation [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Uind !< Induced velocities obtained at control points [-] TYPE(GridOutType) , DIMENSION(:), ALLOCATABLE :: GridOutputs !< Number of VTK grid to output [-] + LOGICAL :: InfoReeval = .true. !< Give info about Reevaluation: gets set to false after first info statement [-] END TYPE FVW_MiscVarType ! ======================= ! ========= Rot_InputType ======= TYPE, PUBLIC :: Rot_InputType - REAL(ReKi) , DIMENSION(1:3,1:3) :: HubOrientation !< Orientation of hub coordinate system (for output only) [-] - REAL(ReKi) , DIMENSION(1:3) :: HubPosition !< Origin of hub (for output only) [-] + REAL(ReKi) , DIMENSION(1:3,1:3) :: HubOrientation = 0.0_ReKi !< Orientation of hub coordinate system (for output only) [-] + REAL(ReKi) , DIMENSION(1:3) :: HubPosition = 0.0_ReKi !< Origin of hub (for output only) [-] END TYPE Rot_InputType ! ======================= ! ========= Wng_InputType ======= @@ -263,7 +265,7 @@ MODULE FVW_Types ! ======================= ! ========= FVW_DiscreteStateType ======= TYPE, PUBLIC :: FVW_DiscreteStateType - REAL(ReKi) :: Dummy !< Empty to satisfy framework [-] + REAL(ReKi) :: Dummy = 0.0_ReKi !< Empty to satisfy framework [-] TYPE(UA_DiscreteStateType) , DIMENSION(:), ALLOCATABLE :: UA !< states for UnsteadyAero for each Wing [-] END TYPE FVW_DiscreteStateType ! ======================= @@ -275,12 +277,12 @@ MODULE FVW_Types ! ========= FVW_ConstraintStateType ======= TYPE, PUBLIC :: FVW_ConstraintStateType TYPE(Wng_ConstraintStateType) , DIMENSION(:), ALLOCATABLE :: W !< rotors constr. states [-] - REAL(ReKi) :: residual !< Residual [-] + REAL(ReKi) :: residual = 0.0_ReKi !< Residual [-] END TYPE FVW_ConstraintStateType ! ======================= ! ========= FVW_OtherStateType ======= TYPE, PUBLIC :: FVW_OtherStateType - INTEGER(IntKi) :: Dummy !< Empty to satisfy framework [-] + INTEGER(IntKi) :: Dummy = 0_IntKi !< Empty to satisfy framework [-] TYPE(UA_OtherStateType) , DIMENSION(:), ALLOCATABLE :: UA !< other states for UnsteadyAero for each wing [-] END TYPE FVW_OtherStateType ! ======================= @@ -289,9 +291,9 @@ MODULE FVW_Types INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: AFindx !< Index to the airfoils from AD15 [idx1=BladeNode, idx2=Blade number=1] [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: chord !< Chord of each blade element from input file [idx1=BladeNode, idx2=Blade number] [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: RElm !< radius of center of each element [-] - INTEGER(IntKi) :: iRotor !< Index of rotor the wing belong to [-] - INTEGER(IntKi) :: UAOff_innerNode !< Last node on each blade where UA should be turned off based on span location from blade root (0 if always on) [-] - INTEGER(IntKi) :: UAOff_outerNode !< First node on each blade where UA should be turned off based on span location from blade tip (>nNodesPerBlade if always on) [-] + INTEGER(IntKi) :: iRotor = 0_IntKi !< Index of rotor the wing belong to [-] + INTEGER(IntKi) :: UAOff_innerNode = 0_IntKi !< Last node on each blade where UA should be turned off based on span location from blade root (0 if always on) [-] + INTEGER(IntKi) :: UAOff_outerNode = 0_IntKi !< First node on each blade where UA should be turned off based on span location from blade tip (>nNodesPerBlade if always on) [-] END TYPE Wng_InitInputType ! ======================= ! ========= FVW_InitInputType ======= @@ -300,11243 +302,3445 @@ MODULE FVW_Types CHARACTER(1024) :: RootName !< RootName for writing output files [-] TYPE(Wng_InitInputType) , DIMENSION(:), ALLOCATABLE :: W !< Number of blades [-] TYPE(MeshType) , DIMENSION(:), ALLOCATABLE :: WingsMesh !< Input Mesh defining position and orientation of wings (nSpan+1) [-] - INTEGER(IntKi) :: numBladeNodes !< Number of nodes on each blade [-] - REAL(DbKi) :: DTaero !< Time interval for calls (from AD15) [s] - REAL(ReKi) :: KinVisc !< Kinematic air viscosity [m^2/s] - INTEGER(IntKi) :: MHK !< MHK flag [-] - REAL(ReKi) :: WtrDpth !< Water depth [m] - INTEGER(IntKi) :: UAMod !< Model for the dynamic stall equations [1 = Leishman/Beddoes, 2 = Gonzalez, 3 = Minnema] [-] - LOGICAL :: UA_Flag !< logical flag indicating whether to use UnsteadyAero [-] - LOGICAL :: Flookup !< Use table lookup for f' and f'' [-] - REAL(ReKi) :: a_s !< speed of sound [m/s] - LOGICAL :: SumPrint !< Whether to print summary file (primarially in in UA) [-] + INTEGER(IntKi) :: numBladeNodes = 0_IntKi !< Number of nodes on each blade [-] + REAL(DbKi) :: DTaero = 0.0_R8Ki !< Time interval for calls (from AD15) [s] + REAL(ReKi) :: KinVisc = 0.0_ReKi !< Kinematic air viscosity [m^2/s] + INTEGER(IntKi) :: MHK = 0_IntKi !< MHK flag [-] + REAL(ReKi) :: WtrDpth = 0.0_ReKi !< Water depth [m] + LOGICAL :: UA_Flag = .false. !< logical flag indicating whether to use UnsteadyAero [-] + TYPE(UA_InitInputType) :: UA_Init !< InitInput data for UA model [-] END TYPE FVW_InitInputType ! ======================= ! ========= FVW_InputFile ======= TYPE, PUBLIC :: FVW_InputFile - INTEGER(IntKi) :: CircSolvMethod !< Method to determine the circulation [-] + INTEGER(IntKi) :: CircSolvMethod = 0_IntKi !< Method to determine the circulation [-] CHARACTER(1024) :: CirculationFile !< Prescribed circulation file [-] - INTEGER(IntKi) :: CircSolvMaxIter !< Maximum number of iterations for circulation solving [-] - REAL(ReKi) :: CircSolvConvCrit !< Convergence criterion for circulation solving [-] - REAL(ReKi) :: CircSolvRelaxation !< Relaxation factor for circulation solving [-] - INTEGER(IntKi) :: IntMethod !< Integration Method (1=RK4, 2=AB4, 3=ABM4, 5=Euler1, 7=Corrector/Predictor) [-] - LOGICAL :: FreeWake !< Disable roll up, wake convects with wind only (flag) [-] - REAL(ReKi) :: FreeWakeStart !< Time when wake starts convecting (rolling up) [s] - REAL(ReKi) :: FullCircStart !< Time when the circulation is full [s] - REAL(DbKi) :: DTfvw !< Time interval for calculating wake induced velocities [s] - INTEGER(IntKi) :: CircSolvPolar !< (0=Use AD polars, 1=2PiAlpha, 2=sin(2pialpha) [-] - INTEGER(IntKi) :: nNWPanels !< Number of nw panels [-] - INTEGER(IntKi) :: nNWPanelsFree !< Number of nw panels [-] - INTEGER(IntKi) :: nFWPanels !< Number of fw panels [-] - INTEGER(IntKi) :: nFWPanelsFree !< Number of fw panels that are free [-] - LOGICAL :: FWShedVorticity !< Include shed vorticity in the far wake [-] - INTEGER(IntKi) :: DiffusionMethod !< Diffusion method (None, CoreSpreading, PSE) [-] - REAL(ReKi) :: CoreSpreadEddyVisc !< Eddy viscosity used in the core spreading method [-] - INTEGER(IntKi) :: RegDeterMethod !< Regularization determinatino method (manual, automatic) [-] - INTEGER(IntKi) :: RegFunction !< Type of regularizaion function (LambOseen, Vatistas, see FVW_BiotSavart) [-] - INTEGER(IntKi) :: WakeRegMethod !< Method for regularization (constant, stretching, age, etc.) [-] - REAL(ReKi) :: WakeRegParam !< Factor used in the regularization [-] - REAL(ReKi) :: WingRegParam !< Factor used in the regularization [-] - INTEGER(IntKi) :: ShearModel !< Option for shear modelling [-] - LOGICAL :: TwrShadowOnWake !< Include tower shadow effects on wake [-] - INTEGER(IntKi) , DIMENSION(1:2) :: VelocityMethod !< Velocity calculation method for Full Wake and for LiftingLine [-] - REAL(ReKi) , DIMENSION(1:2) :: TreeBranchFactor !< Factor used to determine if a point is far enough, for full wake and lifting line [-] - INTEGER(IntKi) , DIMENSION(1:2) :: PartPerSegment !< Number of particles per segment, e.g. for tree method, for full wake and lifting line [-] - INTEGER(IntKi) :: WrVTK !< Outputs VTK at each calcoutput call, even if main fst doesnt do it [-] - INTEGER(IntKi) :: VTKBlades !< Outputs VTk for each blade 0=no blade, 1=Bld 1 [-] - REAL(DbKi) :: DTvtk !< Requested timestep between VTK outputs (calculated from the VTK_fps read in) [s] - INTEGER(IntKi) :: VTKCoord !< Switch for VTK outputs coordinate system [-] + INTEGER(IntKi) :: CircSolvMaxIter = 0_IntKi !< Maximum number of iterations for circulation solving [-] + REAL(ReKi) :: CircSolvConvCrit = 0.0_ReKi !< Convergence criterion for circulation solving [-] + REAL(ReKi) :: CircSolvRelaxation = 0.0_ReKi !< Relaxation factor for circulation solving [-] + INTEGER(IntKi) :: IntMethod = 0_IntKi !< Integration Method (1=RK4, 2=AB4, 3=ABM4, 5=Euler1, 7=Corrector/Predictor) [-] + LOGICAL :: FreeWake = .false. !< Disable roll up, wake convects with wind only (flag) [-] + REAL(ReKi) :: FreeWakeStart = 0.0_ReKi !< Time when wake starts convecting (rolling up) [s] + REAL(ReKi) :: FullCircStart = 0.0_ReKi !< Time when the circulation is full [s] + REAL(DbKi) :: DTfvw = 0.0_R8Ki !< Time interval for calculating wake induced velocities [s] + INTEGER(IntKi) :: CircSolvPolar = 0_IntKi !< (0=Use AD polars, 1=2PiAlpha, 2=sin(2pialpha) [-] + INTEGER(IntKi) :: nNWPanels = 0_IntKi !< Number of nw panels [-] + INTEGER(IntKi) :: nNWPanelsFree = 0_IntKi !< Number of nw panels [-] + INTEGER(IntKi) :: nFWPanels = 0_IntKi !< Number of fw panels [-] + INTEGER(IntKi) :: nFWPanelsFree = 0_IntKi !< Number of fw panels that are free [-] + LOGICAL :: FWShedVorticity = .false. !< Include shed vorticity in the far wake [-] + INTEGER(IntKi) :: DiffusionMethod = 0_IntKi !< Diffusion method (None, CoreSpreading, PSE) [-] + REAL(ReKi) :: CoreSpreadEddyVisc = 0.0_ReKi !< Eddy viscosity used in the core spreading method [-] + INTEGER(IntKi) :: RegDeterMethod = 0_IntKi !< Regularization determinatino method (manual, automatic) [-] + INTEGER(IntKi) :: RegFunction = 0_IntKi !< Type of regularizaion function (LambOseen, Vatistas, see FVW_BiotSavart) [-] + INTEGER(IntKi) :: WakeRegMethod = 0_IntKi !< Method for regularization (constant, stretching, age, etc.) [-] + REAL(ReKi) :: WakeRegParam = 0.0_ReKi !< Factor used in the regularization [-] + REAL(ReKi) :: WingRegParam = 0.0_ReKi !< Factor used in the regularization [-] + INTEGER(IntKi) :: ShearModel = 0_IntKi !< Option for shear modelling [-] + LOGICAL :: TwrShadowOnWake = .false. !< Include tower shadow effects on wake [-] + INTEGER(IntKi) , DIMENSION(1:2) :: VelocityMethod = 0_IntKi !< Velocity calculation method for Full Wake and for LiftingLine [-] + REAL(ReKi) , DIMENSION(1:2) :: TreeBranchFactor = 0.0_ReKi !< Factor used to determine if a point is far enough, for full wake and lifting line [-] + INTEGER(IntKi) , DIMENSION(1:2) :: PartPerSegment = 0_IntKi !< Number of particles per segment, e.g. for tree method, for full wake and lifting line [-] + INTEGER(IntKi) :: WrVTK = 0_IntKi !< Outputs VTK at each calcoutput call, even if main fst doesnt do it [-] + INTEGER(IntKi) :: VTKBlades = 0_IntKi !< Outputs VTk for each blade 0=no blade, 1=Bld 1 [-] + REAL(DbKi) :: DTvtk = 0.0_R8Ki !< Requested timestep between VTK outputs (calculated from the VTK_fps read in) [s] + INTEGER(IntKi) :: VTKCoord = 0_IntKi !< Switch for VTK outputs coordinate system [-] END TYPE FVW_InputFile ! ======================= ! ========= FVW_InitOutputType ======= TYPE, PUBLIC :: FVW_InitOutputType - INTEGER(IntKi) :: Dummy !< Empty parameter to satisfy framework [-] + INTEGER(IntKi) :: Dummy = 0_IntKi !< Empty parameter to satisfy framework [-] END TYPE FVW_InitOutputType ! ======================= CONTAINS - SUBROUTINE FVW_CopyGridOutType( SrcGridOutTypeData, DstGridOutTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(GridOutType), INTENT(IN) :: SrcGridOutTypeData - TYPE(GridOutType), INTENT(INOUT) :: DstGridOutTypeData - 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 = 'FVW_CopyGridOutType' -! - ErrStat = ErrID_None - ErrMsg = "" - DstGridOutTypeData%name = SrcGridOutTypeData%name - DstGridOutTypeData%type = SrcGridOutTypeData%type - DstGridOutTypeData%tStart = SrcGridOutTypeData%tStart - DstGridOutTypeData%tEnd = SrcGridOutTypeData%tEnd - DstGridOutTypeData%DTout = SrcGridOutTypeData%DTout - DstGridOutTypeData%xStart = SrcGridOutTypeData%xStart - DstGridOutTypeData%yStart = SrcGridOutTypeData%yStart - DstGridOutTypeData%zStart = SrcGridOutTypeData%zStart - DstGridOutTypeData%xEnd = SrcGridOutTypeData%xEnd - DstGridOutTypeData%yEnd = SrcGridOutTypeData%yEnd - DstGridOutTypeData%zEnd = SrcGridOutTypeData%zEnd - DstGridOutTypeData%nx = SrcGridOutTypeData%nx - DstGridOutTypeData%ny = SrcGridOutTypeData%ny - DstGridOutTypeData%nz = SrcGridOutTypeData%nz -IF (ALLOCATED(SrcGridOutTypeData%uGrid)) THEN - i1_l = LBOUND(SrcGridOutTypeData%uGrid,1) - i1_u = UBOUND(SrcGridOutTypeData%uGrid,1) - i2_l = LBOUND(SrcGridOutTypeData%uGrid,2) - i2_u = UBOUND(SrcGridOutTypeData%uGrid,2) - i3_l = LBOUND(SrcGridOutTypeData%uGrid,3) - i3_u = UBOUND(SrcGridOutTypeData%uGrid,3) - i4_l = LBOUND(SrcGridOutTypeData%uGrid,4) - i4_u = UBOUND(SrcGridOutTypeData%uGrid,4) - IF (.NOT. ALLOCATED(DstGridOutTypeData%uGrid)) THEN - ALLOCATE(DstGridOutTypeData%uGrid(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 DstGridOutTypeData%uGrid.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstGridOutTypeData%uGrid = SrcGridOutTypeData%uGrid -ENDIF -IF (ALLOCATED(SrcGridOutTypeData%omGrid)) THEN - i1_l = LBOUND(SrcGridOutTypeData%omGrid,1) - i1_u = UBOUND(SrcGridOutTypeData%omGrid,1) - i2_l = LBOUND(SrcGridOutTypeData%omGrid,2) - i2_u = UBOUND(SrcGridOutTypeData%omGrid,2) - i3_l = LBOUND(SrcGridOutTypeData%omGrid,3) - i3_u = UBOUND(SrcGridOutTypeData%omGrid,3) - i4_l = LBOUND(SrcGridOutTypeData%omGrid,4) - i4_u = UBOUND(SrcGridOutTypeData%omGrid,4) - IF (.NOT. ALLOCATED(DstGridOutTypeData%omGrid)) THEN - ALLOCATE(DstGridOutTypeData%omGrid(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 DstGridOutTypeData%omGrid.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstGridOutTypeData%omGrid = SrcGridOutTypeData%omGrid -ENDIF - DstGridOutTypeData%tLastOutput = SrcGridOutTypeData%tLastOutput - END SUBROUTINE FVW_CopyGridOutType - - SUBROUTINE FVW_DestroyGridOutType( GridOutTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(GridOutType), INTENT(INOUT) :: GridOutTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_DestroyGridOutType' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(GridOutTypeData%uGrid)) THEN - DEALLOCATE(GridOutTypeData%uGrid) -ENDIF -IF (ALLOCATED(GridOutTypeData%omGrid)) THEN - DEALLOCATE(GridOutTypeData%omGrid) -ENDIF - END SUBROUTINE FVW_DestroyGridOutType - - SUBROUTINE FVW_PackGridOutType( 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(GridOutType), 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 = 'FVW_PackGridOutType' - ! 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%name) ! name - Int_BufSz = Int_BufSz + 1 ! type - Re_BufSz = Re_BufSz + 1 ! tStart - Re_BufSz = Re_BufSz + 1 ! tEnd - Re_BufSz = Re_BufSz + 1 ! DTout - Re_BufSz = Re_BufSz + 1 ! xStart - Re_BufSz = Re_BufSz + 1 ! yStart - Re_BufSz = Re_BufSz + 1 ! zStart - Re_BufSz = Re_BufSz + 1 ! xEnd - Re_BufSz = Re_BufSz + 1 ! yEnd - Re_BufSz = Re_BufSz + 1 ! zEnd - Int_BufSz = Int_BufSz + 1 ! nx - Int_BufSz = Int_BufSz + 1 ! ny - Int_BufSz = Int_BufSz + 1 ! nz - Int_BufSz = Int_BufSz + 1 ! uGrid allocated yes/no - IF ( ALLOCATED(InData%uGrid) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! uGrid upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%uGrid) ! uGrid - END IF - Int_BufSz = Int_BufSz + 1 ! omGrid allocated yes/no - IF ( ALLOCATED(InData%omGrid) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! omGrid upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%omGrid) ! omGrid - END IF - Db_BufSz = Db_BufSz + 1 ! tLastOutput - 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%name) - IntKiBuf(Int_Xferred) = ICHAR(InData%name(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = InData%type - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%tStart - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%tEnd - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%DTout - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%xStart - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%yStart - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%zStart - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%xEnd - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%yEnd - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%zEnd - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nx - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%ny - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nz - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%uGrid) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%uGrid,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uGrid,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%uGrid,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uGrid,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%uGrid,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uGrid,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%uGrid,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uGrid,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%uGrid,4), UBOUND(InData%uGrid,4) - DO i3 = LBOUND(InData%uGrid,3), UBOUND(InData%uGrid,3) - DO i2 = LBOUND(InData%uGrid,2), UBOUND(InData%uGrid,2) - DO i1 = LBOUND(InData%uGrid,1), UBOUND(InData%uGrid,1) - ReKiBuf(Re_Xferred) = InData%uGrid(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%omGrid) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%omGrid,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%omGrid,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%omGrid,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%omGrid,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%omGrid,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%omGrid,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%omGrid,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%omGrid,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%omGrid,4), UBOUND(InData%omGrid,4) - DO i3 = LBOUND(InData%omGrid,3), UBOUND(InData%omGrid,3) - DO i2 = LBOUND(InData%omGrid,2), UBOUND(InData%omGrid,2) - DO i1 = LBOUND(InData%omGrid,1), UBOUND(InData%omGrid,1) - ReKiBuf(Re_Xferred) = InData%omGrid(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - DbKiBuf(Db_Xferred) = InData%tLastOutput - Db_Xferred = Db_Xferred + 1 - END SUBROUTINE FVW_PackGridOutType - - SUBROUTINE FVW_UnPackGridOutType( 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(GridOutType), 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 = 'FVW_UnPackGridOutType' - ! 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%name) - OutData%name(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%type = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%tStart = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%tEnd = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%DTout = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%xStart = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%yStart = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%zStart = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%xEnd = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%yEnd = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%zEnd = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%nx = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%ny = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nz = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! uGrid not allocated - Int_Xferred = Int_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%uGrid)) DEALLOCATE(OutData%uGrid) - ALLOCATE(OutData%uGrid(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%uGrid.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%uGrid,4), UBOUND(OutData%uGrid,4) - DO i3 = LBOUND(OutData%uGrid,3), UBOUND(OutData%uGrid,3) - DO i2 = LBOUND(OutData%uGrid,2), UBOUND(OutData%uGrid,2) - DO i1 = LBOUND(OutData%uGrid,1), UBOUND(OutData%uGrid,1) - OutData%uGrid(i1,i2,i3,i4) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! omGrid not allocated - Int_Xferred = Int_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%omGrid)) DEALLOCATE(OutData%omGrid) - ALLOCATE(OutData%omGrid(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%omGrid.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%omGrid,4), UBOUND(OutData%omGrid,4) - DO i3 = LBOUND(OutData%omGrid,3), UBOUND(OutData%omGrid,3) - DO i2 = LBOUND(OutData%omGrid,2), UBOUND(OutData%omGrid,2) - DO i1 = LBOUND(OutData%omGrid,1), UBOUND(OutData%omGrid,1) - OutData%omGrid(i1,i2,i3,i4) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - OutData%tLastOutput = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END SUBROUTINE FVW_UnPackGridOutType - - SUBROUTINE FVW_CopyT_Sgmt( SrcT_SgmtData, DstT_SgmtData, CtrlCode, ErrStat, ErrMsg ) - TYPE(T_Sgmt), INTENT(IN) :: SrcT_SgmtData - TYPE(T_Sgmt), INTENT(INOUT) :: DstT_SgmtData - 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 = 'FVW_CopyT_Sgmt' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcT_SgmtData%Points)) THEN - i1_l = LBOUND(SrcT_SgmtData%Points,1) - i1_u = UBOUND(SrcT_SgmtData%Points,1) - i2_l = LBOUND(SrcT_SgmtData%Points,2) - i2_u = UBOUND(SrcT_SgmtData%Points,2) - IF (.NOT. ALLOCATED(DstT_SgmtData%Points)) THEN - ALLOCATE(DstT_SgmtData%Points(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstT_SgmtData%Points.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstT_SgmtData%Points = SrcT_SgmtData%Points -ENDIF -IF (ALLOCATED(SrcT_SgmtData%Connct)) THEN - i1_l = LBOUND(SrcT_SgmtData%Connct,1) - i1_u = UBOUND(SrcT_SgmtData%Connct,1) - i2_l = LBOUND(SrcT_SgmtData%Connct,2) - i2_u = UBOUND(SrcT_SgmtData%Connct,2) - IF (.NOT. ALLOCATED(DstT_SgmtData%Connct)) THEN - ALLOCATE(DstT_SgmtData%Connct(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstT_SgmtData%Connct.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstT_SgmtData%Connct = SrcT_SgmtData%Connct -ENDIF -IF (ALLOCATED(SrcT_SgmtData%Gamma)) THEN - i1_l = LBOUND(SrcT_SgmtData%Gamma,1) - i1_u = UBOUND(SrcT_SgmtData%Gamma,1) - IF (.NOT. ALLOCATED(DstT_SgmtData%Gamma)) THEN - ALLOCATE(DstT_SgmtData%Gamma(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstT_SgmtData%Gamma.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstT_SgmtData%Gamma = SrcT_SgmtData%Gamma -ENDIF -IF (ALLOCATED(SrcT_SgmtData%Epsilon)) THEN - i1_l = LBOUND(SrcT_SgmtData%Epsilon,1) - i1_u = UBOUND(SrcT_SgmtData%Epsilon,1) - IF (.NOT. ALLOCATED(DstT_SgmtData%Epsilon)) THEN - ALLOCATE(DstT_SgmtData%Epsilon(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstT_SgmtData%Epsilon.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstT_SgmtData%Epsilon = SrcT_SgmtData%Epsilon -ENDIF - DstT_SgmtData%RegFunction = SrcT_SgmtData%RegFunction - DstT_SgmtData%nAct = SrcT_SgmtData%nAct - DstT_SgmtData%nActP = SrcT_SgmtData%nActP - END SUBROUTINE FVW_CopyT_Sgmt - - SUBROUTINE FVW_DestroyT_Sgmt( T_SgmtData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(T_Sgmt), INTENT(INOUT) :: T_SgmtData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_DestroyT_Sgmt' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(T_SgmtData%Points)) THEN - DEALLOCATE(T_SgmtData%Points) -ENDIF -IF (ALLOCATED(T_SgmtData%Connct)) THEN - DEALLOCATE(T_SgmtData%Connct) -ENDIF -IF (ALLOCATED(T_SgmtData%Gamma)) THEN - DEALLOCATE(T_SgmtData%Gamma) -ENDIF -IF (ALLOCATED(T_SgmtData%Epsilon)) THEN - DEALLOCATE(T_SgmtData%Epsilon) -ENDIF - END SUBROUTINE FVW_DestroyT_Sgmt - - SUBROUTINE FVW_PackT_Sgmt( 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(T_Sgmt), 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 = 'FVW_PackT_Sgmt' - ! 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 ! Points allocated yes/no - IF ( ALLOCATED(InData%Points) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Points upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Points) ! Points - END IF - Int_BufSz = Int_BufSz + 1 ! Connct allocated yes/no - IF ( ALLOCATED(InData%Connct) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Connct upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Connct) ! Connct - END IF - Int_BufSz = Int_BufSz + 1 ! Gamma allocated yes/no - IF ( ALLOCATED(InData%Gamma) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Gamma upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Gamma) ! Gamma - END IF - Int_BufSz = Int_BufSz + 1 ! Epsilon allocated yes/no - IF ( ALLOCATED(InData%Epsilon) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Epsilon upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Epsilon) ! Epsilon - END IF - Int_BufSz = Int_BufSz + 1 ! RegFunction - Int_BufSz = Int_BufSz + 1 ! nAct - Int_BufSz = Int_BufSz + 1 ! nActP - 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%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%Points,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Points,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Points,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Points,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Points,2), UBOUND(InData%Points,2) - DO i1 = LBOUND(InData%Points,1), UBOUND(InData%Points,1) - ReKiBuf(Re_Xferred) = InData%Points(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Connct) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Connct,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Connct,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Connct,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Connct,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Connct,2), UBOUND(InData%Connct,2) - DO i1 = LBOUND(InData%Connct,1), UBOUND(InData%Connct,1) - IntKiBuf(Int_Xferred) = InData%Connct(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Gamma) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Gamma,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Gamma,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Gamma,1), UBOUND(InData%Gamma,1) - ReKiBuf(Re_Xferred) = InData%Gamma(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Epsilon) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Epsilon,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Epsilon,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Epsilon,1), UBOUND(InData%Epsilon,1) - ReKiBuf(Re_Xferred) = InData%Epsilon(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%RegFunction - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nAct - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nActP - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE FVW_PackT_Sgmt - - SUBROUTINE FVW_UnPackT_Sgmt( 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(T_Sgmt), 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 = 'FVW_UnPackT_Sgmt' - ! 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 ! 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%Points)) DEALLOCATE(OutData%Points) - ALLOCATE(OutData%Points(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Points.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Points,2), UBOUND(OutData%Points,2) - DO i1 = LBOUND(OutData%Points,1), UBOUND(OutData%Points,1) - OutData%Points(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Connct not allocated - Int_Xferred = Int_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%Connct)) DEALLOCATE(OutData%Connct) - ALLOCATE(OutData%Connct(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Connct.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Connct,2), UBOUND(OutData%Connct,2) - DO i1 = LBOUND(OutData%Connct,1), UBOUND(OutData%Connct,1) - OutData%Connct(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Gamma not allocated - Int_Xferred = Int_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%Gamma)) DEALLOCATE(OutData%Gamma) - ALLOCATE(OutData%Gamma(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Gamma.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Gamma,1), UBOUND(OutData%Gamma,1) - OutData%Gamma(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Epsilon not allocated - Int_Xferred = Int_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%Epsilon)) DEALLOCATE(OutData%Epsilon) - ALLOCATE(OutData%Epsilon(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Epsilon.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Epsilon,1), UBOUND(OutData%Epsilon,1) - OutData%Epsilon(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%RegFunction = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nAct = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nActP = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE FVW_UnPackT_Sgmt - - SUBROUTINE FVW_CopyT_Part( SrcT_PartData, DstT_PartData, CtrlCode, ErrStat, ErrMsg ) - TYPE(T_Part), INTENT(IN) :: SrcT_PartData - TYPE(T_Part), INTENT(INOUT) :: DstT_PartData - 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 = 'FVW_CopyT_Part' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcT_PartData%P)) THEN - i1_l = LBOUND(SrcT_PartData%P,1) - i1_u = UBOUND(SrcT_PartData%P,1) - i2_l = LBOUND(SrcT_PartData%P,2) - i2_u = UBOUND(SrcT_PartData%P,2) - IF (.NOT. ALLOCATED(DstT_PartData%P)) THEN - ALLOCATE(DstT_PartData%P(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstT_PartData%P.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstT_PartData%P = SrcT_PartData%P -ENDIF -IF (ALLOCATED(SrcT_PartData%Alpha)) THEN - i1_l = LBOUND(SrcT_PartData%Alpha,1) - i1_u = UBOUND(SrcT_PartData%Alpha,1) - i2_l = LBOUND(SrcT_PartData%Alpha,2) - i2_u = UBOUND(SrcT_PartData%Alpha,2) - IF (.NOT. ALLOCATED(DstT_PartData%Alpha)) THEN - ALLOCATE(DstT_PartData%Alpha(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstT_PartData%Alpha.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstT_PartData%Alpha = SrcT_PartData%Alpha -ENDIF -IF (ALLOCATED(SrcT_PartData%RegParam)) THEN - i1_l = LBOUND(SrcT_PartData%RegParam,1) - i1_u = UBOUND(SrcT_PartData%RegParam,1) - IF (.NOT. ALLOCATED(DstT_PartData%RegParam)) THEN - ALLOCATE(DstT_PartData%RegParam(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstT_PartData%RegParam.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstT_PartData%RegParam = SrcT_PartData%RegParam -ENDIF - DstT_PartData%RegFunction = SrcT_PartData%RegFunction - DstT_PartData%nAct = SrcT_PartData%nAct - END SUBROUTINE FVW_CopyT_Part - - SUBROUTINE FVW_DestroyT_Part( T_PartData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(T_Part), INTENT(INOUT) :: T_PartData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_DestroyT_Part' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(T_PartData%P)) THEN - DEALLOCATE(T_PartData%P) -ENDIF -IF (ALLOCATED(T_PartData%Alpha)) THEN - DEALLOCATE(T_PartData%Alpha) -ENDIF -IF (ALLOCATED(T_PartData%RegParam)) THEN - DEALLOCATE(T_PartData%RegParam) -ENDIF - END SUBROUTINE FVW_DestroyT_Part - - SUBROUTINE FVW_PackT_Part( 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(T_Part), 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 = 'FVW_PackT_Part' - ! 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 ! P allocated yes/no - IF ( ALLOCATED(InData%P) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! P upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%P) ! P - END IF - Int_BufSz = Int_BufSz + 1 ! Alpha allocated yes/no - IF ( ALLOCATED(InData%Alpha) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Alpha upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Alpha) ! Alpha - END IF - Int_BufSz = Int_BufSz + 1 ! RegParam allocated yes/no - IF ( ALLOCATED(InData%RegParam) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! RegParam upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%RegParam) ! RegParam - END IF - Int_BufSz = Int_BufSz + 1 ! RegFunction - Int_BufSz = Int_BufSz + 1 ! nAct - 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%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%P,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%P,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%P,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%P,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%P,2), UBOUND(InData%P,2) - DO i1 = LBOUND(InData%P,1), UBOUND(InData%P,1) - ReKiBuf(Re_Xferred) = InData%P(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Alpha) ) THEN - 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,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Alpha,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Alpha,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Alpha,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Alpha,2), UBOUND(InData%Alpha,2) - DO i1 = LBOUND(InData%Alpha,1), UBOUND(InData%Alpha,1) - ReKiBuf(Re_Xferred) = InData%Alpha(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%RegParam) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RegParam,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RegParam,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%RegParam,1), UBOUND(InData%RegParam,1) - ReKiBuf(Re_Xferred) = InData%RegParam(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%RegFunction - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nAct - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE FVW_PackT_Part - - SUBROUTINE FVW_UnPackT_Part( 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(T_Part), 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 = 'FVW_UnPackT_Part' - ! 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 ! 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%P)) DEALLOCATE(OutData%P) - ALLOCATE(OutData%P(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%P.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%P,2), UBOUND(OutData%P,2) - DO i1 = LBOUND(OutData%P,1), UBOUND(OutData%P,1) - OutData%P(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Alpha not allocated - Int_Xferred = Int_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)) DEALLOCATE(OutData%Alpha) - ALLOCATE(OutData%Alpha(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Alpha.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Alpha,2), UBOUND(OutData%Alpha,2) - DO i1 = LBOUND(OutData%Alpha,1), UBOUND(OutData%Alpha,1) - OutData%Alpha(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RegParam not allocated - Int_Xferred = Int_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%RegParam)) DEALLOCATE(OutData%RegParam) - ALLOCATE(OutData%RegParam(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RegParam.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%RegParam,1), UBOUND(OutData%RegParam,1) - OutData%RegParam(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%RegFunction = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nAct = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE FVW_UnPackT_Part - - SUBROUTINE FVW_CopyWng_ParameterType( SrcWng_ParameterTypeData, DstWng_ParameterTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Wng_ParameterType), INTENT(IN) :: SrcWng_ParameterTypeData - TYPE(Wng_ParameterType), INTENT(INOUT) :: DstWng_ParameterTypeData - 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 = 'FVW_CopyWng_ParameterType' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcWng_ParameterTypeData%chord_LL)) THEN - i1_l = LBOUND(SrcWng_ParameterTypeData%chord_LL,1) - i1_u = UBOUND(SrcWng_ParameterTypeData%chord_LL,1) - IF (.NOT. ALLOCATED(DstWng_ParameterTypeData%chord_LL)) THEN - ALLOCATE(DstWng_ParameterTypeData%chord_LL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_ParameterTypeData%chord_LL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_ParameterTypeData%chord_LL = SrcWng_ParameterTypeData%chord_LL -ENDIF -IF (ALLOCATED(SrcWng_ParameterTypeData%chord_CP)) THEN - i1_l = LBOUND(SrcWng_ParameterTypeData%chord_CP,1) - i1_u = UBOUND(SrcWng_ParameterTypeData%chord_CP,1) - IF (.NOT. ALLOCATED(DstWng_ParameterTypeData%chord_CP)) THEN - ALLOCATE(DstWng_ParameterTypeData%chord_CP(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_ParameterTypeData%chord_CP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_ParameterTypeData%chord_CP = SrcWng_ParameterTypeData%chord_CP -ENDIF -IF (ALLOCATED(SrcWng_ParameterTypeData%s_LL)) THEN - i1_l = LBOUND(SrcWng_ParameterTypeData%s_LL,1) - i1_u = UBOUND(SrcWng_ParameterTypeData%s_LL,1) - IF (.NOT. ALLOCATED(DstWng_ParameterTypeData%s_LL)) THEN - ALLOCATE(DstWng_ParameterTypeData%s_LL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_ParameterTypeData%s_LL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_ParameterTypeData%s_LL = SrcWng_ParameterTypeData%s_LL -ENDIF -IF (ALLOCATED(SrcWng_ParameterTypeData%s_CP)) THEN - i1_l = LBOUND(SrcWng_ParameterTypeData%s_CP,1) - i1_u = UBOUND(SrcWng_ParameterTypeData%s_CP,1) - IF (.NOT. ALLOCATED(DstWng_ParameterTypeData%s_CP)) THEN - ALLOCATE(DstWng_ParameterTypeData%s_CP(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_ParameterTypeData%s_CP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_ParameterTypeData%s_CP = SrcWng_ParameterTypeData%s_CP -ENDIF - DstWng_ParameterTypeData%iRotor = SrcWng_ParameterTypeData%iRotor -IF (ALLOCATED(SrcWng_ParameterTypeData%AFindx)) THEN - i1_l = LBOUND(SrcWng_ParameterTypeData%AFindx,1) - i1_u = UBOUND(SrcWng_ParameterTypeData%AFindx,1) - i2_l = LBOUND(SrcWng_ParameterTypeData%AFindx,2) - i2_u = UBOUND(SrcWng_ParameterTypeData%AFindx,2) - IF (.NOT. ALLOCATED(DstWng_ParameterTypeData%AFindx)) THEN - ALLOCATE(DstWng_ParameterTypeData%AFindx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_ParameterTypeData%AFindx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_ParameterTypeData%AFindx = SrcWng_ParameterTypeData%AFindx -ENDIF - DstWng_ParameterTypeData%nSpan = SrcWng_ParameterTypeData%nSpan -IF (ALLOCATED(SrcWng_ParameterTypeData%PrescribedCirculation)) THEN - i1_l = LBOUND(SrcWng_ParameterTypeData%PrescribedCirculation,1) - i1_u = UBOUND(SrcWng_ParameterTypeData%PrescribedCirculation,1) - IF (.NOT. ALLOCATED(DstWng_ParameterTypeData%PrescribedCirculation)) THEN - ALLOCATE(DstWng_ParameterTypeData%PrescribedCirculation(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_ParameterTypeData%PrescribedCirculation.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_ParameterTypeData%PrescribedCirculation = SrcWng_ParameterTypeData%PrescribedCirculation -ENDIF - END SUBROUTINE FVW_CopyWng_ParameterType - - SUBROUTINE FVW_DestroyWng_ParameterType( Wng_ParameterTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(Wng_ParameterType), INTENT(INOUT) :: Wng_ParameterTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_DestroyWng_ParameterType' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(Wng_ParameterTypeData%chord_LL)) THEN - DEALLOCATE(Wng_ParameterTypeData%chord_LL) -ENDIF -IF (ALLOCATED(Wng_ParameterTypeData%chord_CP)) THEN - DEALLOCATE(Wng_ParameterTypeData%chord_CP) -ENDIF -IF (ALLOCATED(Wng_ParameterTypeData%s_LL)) THEN - DEALLOCATE(Wng_ParameterTypeData%s_LL) -ENDIF -IF (ALLOCATED(Wng_ParameterTypeData%s_CP)) THEN - DEALLOCATE(Wng_ParameterTypeData%s_CP) -ENDIF -IF (ALLOCATED(Wng_ParameterTypeData%AFindx)) THEN - DEALLOCATE(Wng_ParameterTypeData%AFindx) -ENDIF -IF (ALLOCATED(Wng_ParameterTypeData%PrescribedCirculation)) THEN - DEALLOCATE(Wng_ParameterTypeData%PrescribedCirculation) -ENDIF - END SUBROUTINE FVW_DestroyWng_ParameterType - - SUBROUTINE FVW_PackWng_ParameterType( 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(Wng_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 = 'FVW_PackWng_ParameterType' - ! 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 ! chord_LL allocated yes/no - IF ( ALLOCATED(InData%chord_LL) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! chord_LL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%chord_LL) ! chord_LL - END IF - Int_BufSz = Int_BufSz + 1 ! chord_CP allocated yes/no - IF ( ALLOCATED(InData%chord_CP) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! chord_CP upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%chord_CP) ! chord_CP - END IF - Int_BufSz = Int_BufSz + 1 ! s_LL allocated yes/no - IF ( ALLOCATED(InData%s_LL) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! s_LL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%s_LL) ! s_LL - END IF - Int_BufSz = Int_BufSz + 1 ! s_CP allocated yes/no - IF ( ALLOCATED(InData%s_CP) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! s_CP upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%s_CP) ! s_CP - END IF - Int_BufSz = Int_BufSz + 1 ! iRotor - Int_BufSz = Int_BufSz + 1 ! AFindx allocated yes/no - IF ( ALLOCATED(InData%AFindx) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! AFindx upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%AFindx) ! AFindx - END IF - Int_BufSz = Int_BufSz + 1 ! nSpan - Int_BufSz = Int_BufSz + 1 ! PrescribedCirculation allocated yes/no - IF ( ALLOCATED(InData%PrescribedCirculation) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PrescribedCirculation upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PrescribedCirculation) ! PrescribedCirculation - 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%chord_LL) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%chord_LL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%chord_LL,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%chord_LL,1), UBOUND(InData%chord_LL,1) - ReKiBuf(Re_Xferred) = InData%chord_LL(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%chord_CP) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%chord_CP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%chord_CP,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%chord_CP,1), UBOUND(InData%chord_CP,1) - ReKiBuf(Re_Xferred) = InData%chord_CP(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%s_LL) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%s_LL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%s_LL,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%s_LL,1), UBOUND(InData%s_LL,1) - ReKiBuf(Re_Xferred) = InData%s_LL(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%s_CP) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%s_CP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%s_CP,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%s_CP,1), UBOUND(InData%s_CP,1) - ReKiBuf(Re_Xferred) = InData%s_CP(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%iRotor - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%AFindx) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AFindx,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AFindx,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AFindx,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AFindx,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%AFindx,2), UBOUND(InData%AFindx,2) - DO i1 = LBOUND(InData%AFindx,1), UBOUND(InData%AFindx,1) - IntKiBuf(Int_Xferred) = InData%AFindx(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%nSpan - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%PrescribedCirculation) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PrescribedCirculation,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PrescribedCirculation,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PrescribedCirculation,1), UBOUND(InData%PrescribedCirculation,1) - ReKiBuf(Re_Xferred) = InData%PrescribedCirculation(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE FVW_PackWng_ParameterType - - SUBROUTINE FVW_UnPackWng_ParameterType( 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(Wng_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 = 'FVW_UnPackWng_ParameterType' - ! 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 ! chord_LL not allocated - Int_Xferred = Int_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%chord_LL)) DEALLOCATE(OutData%chord_LL) - ALLOCATE(OutData%chord_LL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%chord_LL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%chord_LL,1), UBOUND(OutData%chord_LL,1) - OutData%chord_LL(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! chord_CP not allocated - Int_Xferred = Int_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%chord_CP)) DEALLOCATE(OutData%chord_CP) - ALLOCATE(OutData%chord_CP(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%chord_CP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%chord_CP,1), UBOUND(OutData%chord_CP,1) - OutData%chord_CP(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! s_LL not allocated - Int_Xferred = Int_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%s_LL)) DEALLOCATE(OutData%s_LL) - ALLOCATE(OutData%s_LL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%s_LL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%s_LL,1), UBOUND(OutData%s_LL,1) - OutData%s_LL(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! s_CP not allocated - Int_Xferred = Int_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%s_CP)) DEALLOCATE(OutData%s_CP) - ALLOCATE(OutData%s_CP(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%s_CP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%s_CP,1), UBOUND(OutData%s_CP,1) - OutData%s_CP(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%iRotor = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AFindx not allocated - Int_Xferred = Int_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%AFindx)) DEALLOCATE(OutData%AFindx) - ALLOCATE(OutData%AFindx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AFindx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%AFindx,2), UBOUND(OutData%AFindx,2) - DO i1 = LBOUND(OutData%AFindx,1), UBOUND(OutData%AFindx,1) - OutData%AFindx(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - OutData%nSpan = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PrescribedCirculation not allocated - Int_Xferred = Int_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%PrescribedCirculation)) DEALLOCATE(OutData%PrescribedCirculation) - ALLOCATE(OutData%PrescribedCirculation(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PrescribedCirculation.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PrescribedCirculation,1), UBOUND(OutData%PrescribedCirculation,1) - OutData%PrescribedCirculation(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE FVW_UnPackWng_ParameterType - - SUBROUTINE FVW_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FVW_ParameterType), INTENT(IN) :: SrcParamData - TYPE(FVW_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 = 'FVW_CopyParam' -! - ErrStat = ErrID_None - ErrMsg = "" - DstParamData%nRotors = SrcParamData%nRotors - DstParamData%nWings = SrcParamData%nWings -IF (ALLOCATED(SrcParamData%W)) THEN - i1_l = LBOUND(SrcParamData%W,1) - i1_u = UBOUND(SrcParamData%W,1) - IF (.NOT. ALLOCATED(DstParamData%W)) THEN - ALLOCATE(DstParamData%W(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%W.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcParamData%W,1), UBOUND(SrcParamData%W,1) - CALL FVW_Copywng_parametertype( SrcParamData%W(i1), DstParamData%W(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcParamData%Bld2Wings)) THEN - i1_l = LBOUND(SrcParamData%Bld2Wings,1) - i1_u = UBOUND(SrcParamData%Bld2Wings,1) - i2_l = LBOUND(SrcParamData%Bld2Wings,2) - i2_u = UBOUND(SrcParamData%Bld2Wings,2) - IF (.NOT. ALLOCATED(DstParamData%Bld2Wings)) THEN - ALLOCATE(DstParamData%Bld2Wings(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Bld2Wings.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Bld2Wings = SrcParamData%Bld2Wings -ENDIF - DstParamData%iNWStart = SrcParamData%iNWStart - DstParamData%nNWMax = SrcParamData%nNWMax - DstParamData%nNWFree = SrcParamData%nNWFree - DstParamData%nFWMax = SrcParamData%nFWMax - DstParamData%nFWFree = SrcParamData%nFWFree - DstParamData%FWShedVorticity = SrcParamData%FWShedVorticity - DstParamData%IntMethod = SrcParamData%IntMethod - DstParamData%FreeWakeStart = SrcParamData%FreeWakeStart - DstParamData%FullCircStart = SrcParamData%FullCircStart - DstParamData%CircSolvMethod = SrcParamData%CircSolvMethod - DstParamData%CircSolvMaxIter = SrcParamData%CircSolvMaxIter - DstParamData%CircSolvConvCrit = SrcParamData%CircSolvConvCrit - DstParamData%CircSolvRelaxation = SrcParamData%CircSolvRelaxation - DstParamData%CircSolvPolar = SrcParamData%CircSolvPolar - DstParamData%DiffusionMethod = SrcParamData%DiffusionMethod - DstParamData%CoreSpreadEddyVisc = SrcParamData%CoreSpreadEddyVisc - DstParamData%RegDeterMethod = SrcParamData%RegDeterMethod - DstParamData%RegFunction = SrcParamData%RegFunction - DstParamData%WakeRegMethod = SrcParamData%WakeRegMethod - DstParamData%WakeRegParam = SrcParamData%WakeRegParam - DstParamData%WingRegParam = SrcParamData%WingRegParam - DstParamData%ShearModel = SrcParamData%ShearModel - DstParamData%TwrShadowOnWake = SrcParamData%TwrShadowOnWake - DstParamData%VelocityMethod = SrcParamData%VelocityMethod - DstParamData%TreeBranchFactor = SrcParamData%TreeBranchFactor - DstParamData%PartPerSegment = SrcParamData%PartPerSegment - DstParamData%DTaero = SrcParamData%DTaero - DstParamData%DTfvw = SrcParamData%DTfvw - DstParamData%KinVisc = SrcParamData%KinVisc - DstParamData%MHK = SrcParamData%MHK - DstParamData%WtrDpth = SrcParamData%WtrDpth - DstParamData%WrVTK = SrcParamData%WrVTK - DstParamData%VTKBlades = SrcParamData%VTKBlades - DstParamData%DTvtk = SrcParamData%DTvtk - DstParamData%VTKCoord = SrcParamData%VTKCoord - DstParamData%RootName = SrcParamData%RootName - DstParamData%VTK_OutFileRoot = SrcParamData%VTK_OutFileRoot - DstParamData%VTK_OutFileBase = SrcParamData%VTK_OutFileBase - DstParamData%nGridOut = SrcParamData%nGridOut - DstParamData%InductionAtCP = SrcParamData%InductionAtCP - DstParamData%WakeAtTE = SrcParamData%WakeAtTE - DstParamData%DStallOnWake = SrcParamData%DStallOnWake - DstParamData%Induction = SrcParamData%Induction - DstParamData%kFrozenNWStart = SrcParamData%kFrozenNWStart - DstParamData%kFrozenNWEnd = SrcParamData%kFrozenNWEnd - END SUBROUTINE FVW_CopyParam - - SUBROUTINE FVW_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(FVW_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(ParamData%W)) THEN -DO i1 = LBOUND(ParamData%W,1), UBOUND(ParamData%W,1) - CALL FVW_Destroywng_parametertype( ParamData%W(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ParamData%W) -ENDIF -IF (ALLOCATED(ParamData%Bld2Wings)) THEN - DEALLOCATE(ParamData%Bld2Wings) -ENDIF - END SUBROUTINE FVW_DestroyParam - - SUBROUTINE FVW_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(FVW_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 = 'FVW_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 ! nRotors - Int_BufSz = Int_BufSz + 1 ! nWings - Int_BufSz = Int_BufSz + 1 ! W allocated yes/no - IF ( ALLOCATED(InData%W) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! W upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%W,1), UBOUND(InData%W,1) - Int_BufSz = Int_BufSz + 3 ! W: size of buffers for each call to pack subtype - CALL FVW_Packwng_parametertype( Re_Buf, Db_Buf, Int_Buf, InData%W(i1), ErrStat2, ErrMsg2, .TRUE. ) ! W - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! W - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! W - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! W - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! Bld2Wings allocated yes/no - IF ( ALLOCATED(InData%Bld2Wings) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Bld2Wings upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Bld2Wings) ! Bld2Wings - END IF - Int_BufSz = Int_BufSz + 1 ! iNWStart - Int_BufSz = Int_BufSz + 1 ! nNWMax - Int_BufSz = Int_BufSz + 1 ! nNWFree - Int_BufSz = Int_BufSz + 1 ! nFWMax - Int_BufSz = Int_BufSz + 1 ! nFWFree - Int_BufSz = Int_BufSz + 1 ! FWShedVorticity - Int_BufSz = Int_BufSz + 1 ! IntMethod - Re_BufSz = Re_BufSz + 1 ! FreeWakeStart - Re_BufSz = Re_BufSz + 1 ! FullCircStart - Int_BufSz = Int_BufSz + 1 ! CircSolvMethod - Int_BufSz = Int_BufSz + 1 ! CircSolvMaxIter - Re_BufSz = Re_BufSz + 1 ! CircSolvConvCrit - Re_BufSz = Re_BufSz + 1 ! CircSolvRelaxation - Int_BufSz = Int_BufSz + 1 ! CircSolvPolar - Int_BufSz = Int_BufSz + 1 ! DiffusionMethod - Re_BufSz = Re_BufSz + 1 ! CoreSpreadEddyVisc - Int_BufSz = Int_BufSz + 1 ! RegDeterMethod - Int_BufSz = Int_BufSz + 1 ! RegFunction - Int_BufSz = Int_BufSz + 1 ! WakeRegMethod - Re_BufSz = Re_BufSz + 1 ! WakeRegParam - Re_BufSz = Re_BufSz + 1 ! WingRegParam - Int_BufSz = Int_BufSz + 1 ! ShearModel - Int_BufSz = Int_BufSz + 1 ! TwrShadowOnWake - Int_BufSz = Int_BufSz + SIZE(InData%VelocityMethod) ! VelocityMethod - Re_BufSz = Re_BufSz + SIZE(InData%TreeBranchFactor) ! TreeBranchFactor - Int_BufSz = Int_BufSz + SIZE(InData%PartPerSegment) ! PartPerSegment - Db_BufSz = Db_BufSz + 1 ! DTaero - Db_BufSz = Db_BufSz + 1 ! DTfvw - Re_BufSz = Re_BufSz + 1 ! KinVisc - Int_BufSz = Int_BufSz + 1 ! MHK - Re_BufSz = Re_BufSz + 1 ! WtrDpth - Int_BufSz = Int_BufSz + 1 ! WrVTK - Int_BufSz = Int_BufSz + 1 ! VTKBlades - Db_BufSz = Db_BufSz + 1 ! DTvtk - Int_BufSz = Int_BufSz + 1 ! VTKCoord - Int_BufSz = Int_BufSz + 1*LEN(InData%RootName) ! RootName - Int_BufSz = Int_BufSz + 1*LEN(InData%VTK_OutFileRoot) ! VTK_OutFileRoot - Int_BufSz = Int_BufSz + 1*LEN(InData%VTK_OutFileBase) ! VTK_OutFileBase - Int_BufSz = Int_BufSz + 1 ! nGridOut - Int_BufSz = Int_BufSz + 1 ! InductionAtCP - Int_BufSz = Int_BufSz + 1 ! WakeAtTE - Int_BufSz = Int_BufSz + 1 ! DStallOnWake - Int_BufSz = Int_BufSz + 1 ! Induction - Re_BufSz = Re_BufSz + 1 ! kFrozenNWStart - Re_BufSz = Re_BufSz + 1 ! kFrozenNWEnd - 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%nRotors - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nWings - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(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) - CALL FVW_Packwng_parametertype( Re_Buf, Db_Buf, Int_Buf, InData%W(i1), ErrStat2, ErrMsg2, OnlySize ) ! W - 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%Bld2Wings) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Bld2Wings,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Bld2Wings,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Bld2Wings,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Bld2Wings,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Bld2Wings,2), UBOUND(InData%Bld2Wings,2) - DO i1 = LBOUND(InData%Bld2Wings,1), UBOUND(InData%Bld2Wings,1) - IntKiBuf(Int_Xferred) = InData%Bld2Wings(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%iNWStart - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nNWMax - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nNWFree - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nFWMax - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nFWFree - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%FWShedVorticity, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%IntMethod - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%FreeWakeStart - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%FullCircStart - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%CircSolvMethod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%CircSolvMaxIter - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%CircSolvConvCrit - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%CircSolvRelaxation - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%CircSolvPolar - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%DiffusionMethod - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%CoreSpreadEddyVisc - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%RegDeterMethod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%RegFunction - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%WakeRegMethod - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WakeRegParam - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WingRegParam - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%ShearModel - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%TwrShadowOnWake, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%VelocityMethod,1), UBOUND(InData%VelocityMethod,1) - IntKiBuf(Int_Xferred) = InData%VelocityMethod(i1) - Int_Xferred = Int_Xferred + 1 - END DO - DO i1 = LBOUND(InData%TreeBranchFactor,1), UBOUND(InData%TreeBranchFactor,1) - ReKiBuf(Re_Xferred) = InData%TreeBranchFactor(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%PartPerSegment,1), UBOUND(InData%PartPerSegment,1) - IntKiBuf(Int_Xferred) = InData%PartPerSegment(i1) - Int_Xferred = Int_Xferred + 1 - END DO - DbKiBuf(Db_Xferred) = InData%DTaero - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%DTfvw - Db_Xferred = Db_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%KinVisc - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%MHK - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WtrDpth - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%WrVTK - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%VTKBlades - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%DTvtk - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%VTKCoord - 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 - DO I = 1, LEN(InData%VTK_OutFileRoot) - IntKiBuf(Int_Xferred) = ICHAR(InData%VTK_OutFileRoot(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%VTK_OutFileBase) - IntKiBuf(Int_Xferred) = ICHAR(InData%VTK_OutFileBase(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = InData%nGridOut - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%InductionAtCP, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%WakeAtTE, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%DStallOnWake, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%Induction, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%kFrozenNWStart - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%kFrozenNWEnd - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE FVW_PackParam - - SUBROUTINE FVW_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(FVW_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 = 'FVW_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%nRotors = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nWings = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - 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 (ALLOCATED(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 - DO i1 = LBOUND(OutData%W,1), UBOUND(OutData%W,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 FVW_Unpackwng_parametertype( Re_Buf, Db_Buf, Int_Buf, OutData%W(i1), ErrStat2, ErrMsg2 ) ! W - 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 ! Bld2Wings not allocated - Int_Xferred = Int_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%Bld2Wings)) DEALLOCATE(OutData%Bld2Wings) - ALLOCATE(OutData%Bld2Wings(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Bld2Wings.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Bld2Wings,2), UBOUND(OutData%Bld2Wings,2) - DO i1 = LBOUND(OutData%Bld2Wings,1), UBOUND(OutData%Bld2Wings,1) - OutData%Bld2Wings(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - OutData%iNWStart = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nNWMax = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nNWFree = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nFWMax = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nFWFree = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%FWShedVorticity = TRANSFER(IntKiBuf(Int_Xferred), OutData%FWShedVorticity) - Int_Xferred = Int_Xferred + 1 - OutData%IntMethod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%FreeWakeStart = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%FullCircStart = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%CircSolvMethod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%CircSolvMaxIter = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%CircSolvConvCrit = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%CircSolvRelaxation = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%CircSolvPolar = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%DiffusionMethod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%CoreSpreadEddyVisc = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RegDeterMethod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%RegFunction = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WakeRegMethod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WakeRegParam = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%WingRegParam = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%ShearModel = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TwrShadowOnWake = TRANSFER(IntKiBuf(Int_Xferred), OutData%TwrShadowOnWake) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%VelocityMethod,1) - i1_u = UBOUND(OutData%VelocityMethod,1) - DO i1 = LBOUND(OutData%VelocityMethod,1), UBOUND(OutData%VelocityMethod,1) - OutData%VelocityMethod(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - i1_l = LBOUND(OutData%TreeBranchFactor,1) - i1_u = UBOUND(OutData%TreeBranchFactor,1) - DO i1 = LBOUND(OutData%TreeBranchFactor,1), UBOUND(OutData%TreeBranchFactor,1) - OutData%TreeBranchFactor(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%PartPerSegment,1) - i1_u = UBOUND(OutData%PartPerSegment,1) - DO i1 = LBOUND(OutData%PartPerSegment,1), UBOUND(OutData%PartPerSegment,1) - OutData%PartPerSegment(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - OutData%DTaero = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%DTfvw = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%KinVisc = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MHK = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WtrDpth = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%WrVTK = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%VTKBlades = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%DTvtk = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%VTKCoord = 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 - DO I = 1, LEN(OutData%VTK_OutFileRoot) - OutData%VTK_OutFileRoot(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%VTK_OutFileBase) - OutData%VTK_OutFileBase(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%nGridOut = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%InductionAtCP = TRANSFER(IntKiBuf(Int_Xferred), OutData%InductionAtCP) - Int_Xferred = Int_Xferred + 1 - OutData%WakeAtTE = TRANSFER(IntKiBuf(Int_Xferred), OutData%WakeAtTE) - Int_Xferred = Int_Xferred + 1 - OutData%DStallOnWake = TRANSFER(IntKiBuf(Int_Xferred), OutData%DStallOnWake) - Int_Xferred = Int_Xferred + 1 - OutData%Induction = TRANSFER(IntKiBuf(Int_Xferred), OutData%Induction) - Int_Xferred = Int_Xferred + 1 - OutData%kFrozenNWStart = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%kFrozenNWEnd = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE FVW_UnPackParam - - SUBROUTINE FVW_CopyWng_ContinuousStateType( SrcWng_ContinuousStateTypeData, DstWng_ContinuousStateTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Wng_ContinuousStateType), INTENT(IN) :: SrcWng_ContinuousStateTypeData - TYPE(Wng_ContinuousStateType), INTENT(INOUT) :: DstWng_ContinuousStateTypeData - 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 = 'FVW_CopyWng_ContinuousStateType' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcWng_ContinuousStateTypeData%Gamma_NW)) THEN - i1_l = LBOUND(SrcWng_ContinuousStateTypeData%Gamma_NW,1) - i1_u = UBOUND(SrcWng_ContinuousStateTypeData%Gamma_NW,1) - i2_l = LBOUND(SrcWng_ContinuousStateTypeData%Gamma_NW,2) - i2_u = UBOUND(SrcWng_ContinuousStateTypeData%Gamma_NW,2) - IF (.NOT. ALLOCATED(DstWng_ContinuousStateTypeData%Gamma_NW)) THEN - ALLOCATE(DstWng_ContinuousStateTypeData%Gamma_NW(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_ContinuousStateTypeData%Gamma_NW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_ContinuousStateTypeData%Gamma_NW = SrcWng_ContinuousStateTypeData%Gamma_NW -ENDIF -IF (ALLOCATED(SrcWng_ContinuousStateTypeData%Gamma_FW)) THEN - i1_l = LBOUND(SrcWng_ContinuousStateTypeData%Gamma_FW,1) - i1_u = UBOUND(SrcWng_ContinuousStateTypeData%Gamma_FW,1) - i2_l = LBOUND(SrcWng_ContinuousStateTypeData%Gamma_FW,2) - i2_u = UBOUND(SrcWng_ContinuousStateTypeData%Gamma_FW,2) - IF (.NOT. ALLOCATED(DstWng_ContinuousStateTypeData%Gamma_FW)) THEN - ALLOCATE(DstWng_ContinuousStateTypeData%Gamma_FW(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_ContinuousStateTypeData%Gamma_FW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_ContinuousStateTypeData%Gamma_FW = SrcWng_ContinuousStateTypeData%Gamma_FW -ENDIF -IF (ALLOCATED(SrcWng_ContinuousStateTypeData%Eps_NW)) THEN - i1_l = LBOUND(SrcWng_ContinuousStateTypeData%Eps_NW,1) - i1_u = UBOUND(SrcWng_ContinuousStateTypeData%Eps_NW,1) - i2_l = LBOUND(SrcWng_ContinuousStateTypeData%Eps_NW,2) - i2_u = UBOUND(SrcWng_ContinuousStateTypeData%Eps_NW,2) - i3_l = LBOUND(SrcWng_ContinuousStateTypeData%Eps_NW,3) - i3_u = UBOUND(SrcWng_ContinuousStateTypeData%Eps_NW,3) - IF (.NOT. ALLOCATED(DstWng_ContinuousStateTypeData%Eps_NW)) THEN - ALLOCATE(DstWng_ContinuousStateTypeData%Eps_NW(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_ContinuousStateTypeData%Eps_NW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_ContinuousStateTypeData%Eps_NW = SrcWng_ContinuousStateTypeData%Eps_NW -ENDIF -IF (ALLOCATED(SrcWng_ContinuousStateTypeData%Eps_FW)) THEN - i1_l = LBOUND(SrcWng_ContinuousStateTypeData%Eps_FW,1) - i1_u = UBOUND(SrcWng_ContinuousStateTypeData%Eps_FW,1) - i2_l = LBOUND(SrcWng_ContinuousStateTypeData%Eps_FW,2) - i2_u = UBOUND(SrcWng_ContinuousStateTypeData%Eps_FW,2) - i3_l = LBOUND(SrcWng_ContinuousStateTypeData%Eps_FW,3) - i3_u = UBOUND(SrcWng_ContinuousStateTypeData%Eps_FW,3) - IF (.NOT. ALLOCATED(DstWng_ContinuousStateTypeData%Eps_FW)) THEN - ALLOCATE(DstWng_ContinuousStateTypeData%Eps_FW(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_ContinuousStateTypeData%Eps_FW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_ContinuousStateTypeData%Eps_FW = SrcWng_ContinuousStateTypeData%Eps_FW -ENDIF -IF (ALLOCATED(SrcWng_ContinuousStateTypeData%r_NW)) THEN - i1_l = LBOUND(SrcWng_ContinuousStateTypeData%r_NW,1) - i1_u = UBOUND(SrcWng_ContinuousStateTypeData%r_NW,1) - i2_l = LBOUND(SrcWng_ContinuousStateTypeData%r_NW,2) - i2_u = UBOUND(SrcWng_ContinuousStateTypeData%r_NW,2) - i3_l = LBOUND(SrcWng_ContinuousStateTypeData%r_NW,3) - i3_u = UBOUND(SrcWng_ContinuousStateTypeData%r_NW,3) - IF (.NOT. ALLOCATED(DstWng_ContinuousStateTypeData%r_NW)) THEN - ALLOCATE(DstWng_ContinuousStateTypeData%r_NW(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_ContinuousStateTypeData%r_NW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_ContinuousStateTypeData%r_NW = SrcWng_ContinuousStateTypeData%r_NW -ENDIF -IF (ALLOCATED(SrcWng_ContinuousStateTypeData%r_FW)) THEN - i1_l = LBOUND(SrcWng_ContinuousStateTypeData%r_FW,1) - i1_u = UBOUND(SrcWng_ContinuousStateTypeData%r_FW,1) - i2_l = LBOUND(SrcWng_ContinuousStateTypeData%r_FW,2) - i2_u = UBOUND(SrcWng_ContinuousStateTypeData%r_FW,2) - i3_l = LBOUND(SrcWng_ContinuousStateTypeData%r_FW,3) - i3_u = UBOUND(SrcWng_ContinuousStateTypeData%r_FW,3) - IF (.NOT. ALLOCATED(DstWng_ContinuousStateTypeData%r_FW)) THEN - ALLOCATE(DstWng_ContinuousStateTypeData%r_FW(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_ContinuousStateTypeData%r_FW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_ContinuousStateTypeData%r_FW = SrcWng_ContinuousStateTypeData%r_FW -ENDIF - END SUBROUTINE FVW_CopyWng_ContinuousStateType - - SUBROUTINE FVW_DestroyWng_ContinuousStateType( Wng_ContinuousStateTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(Wng_ContinuousStateType), INTENT(INOUT) :: Wng_ContinuousStateTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_DestroyWng_ContinuousStateType' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(Wng_ContinuousStateTypeData%Gamma_NW)) THEN - DEALLOCATE(Wng_ContinuousStateTypeData%Gamma_NW) -ENDIF -IF (ALLOCATED(Wng_ContinuousStateTypeData%Gamma_FW)) THEN - DEALLOCATE(Wng_ContinuousStateTypeData%Gamma_FW) -ENDIF -IF (ALLOCATED(Wng_ContinuousStateTypeData%Eps_NW)) THEN - DEALLOCATE(Wng_ContinuousStateTypeData%Eps_NW) -ENDIF -IF (ALLOCATED(Wng_ContinuousStateTypeData%Eps_FW)) THEN - DEALLOCATE(Wng_ContinuousStateTypeData%Eps_FW) -ENDIF -IF (ALLOCATED(Wng_ContinuousStateTypeData%r_NW)) THEN - DEALLOCATE(Wng_ContinuousStateTypeData%r_NW) -ENDIF -IF (ALLOCATED(Wng_ContinuousStateTypeData%r_FW)) THEN - DEALLOCATE(Wng_ContinuousStateTypeData%r_FW) -ENDIF - END SUBROUTINE FVW_DestroyWng_ContinuousStateType - - SUBROUTINE FVW_PackWng_ContinuousStateType( 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(Wng_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 = 'FVW_PackWng_ContinuousStateType' - ! 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 ! Gamma_NW allocated yes/no - IF ( ALLOCATED(InData%Gamma_NW) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Gamma_NW upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Gamma_NW) ! Gamma_NW - END IF - Int_BufSz = Int_BufSz + 1 ! Gamma_FW allocated yes/no - IF ( ALLOCATED(InData%Gamma_FW) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Gamma_FW upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Gamma_FW) ! Gamma_FW - END IF - Int_BufSz = Int_BufSz + 1 ! Eps_NW allocated yes/no - IF ( ALLOCATED(InData%Eps_NW) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Eps_NW upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Eps_NW) ! Eps_NW - END IF - Int_BufSz = Int_BufSz + 1 ! Eps_FW allocated yes/no - IF ( ALLOCATED(InData%Eps_FW) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Eps_FW upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Eps_FW) ! Eps_FW - END IF - Int_BufSz = Int_BufSz + 1 ! r_NW allocated yes/no - IF ( ALLOCATED(InData%r_NW) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! r_NW upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%r_NW) ! r_NW - END IF - Int_BufSz = Int_BufSz + 1 ! r_FW allocated yes/no - IF ( ALLOCATED(InData%r_FW) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! r_FW upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%r_FW) ! r_FW - 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%Gamma_NW) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Gamma_NW,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Gamma_NW,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Gamma_NW,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Gamma_NW,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Gamma_NW,2), UBOUND(InData%Gamma_NW,2) - DO i1 = LBOUND(InData%Gamma_NW,1), UBOUND(InData%Gamma_NW,1) - ReKiBuf(Re_Xferred) = InData%Gamma_NW(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Gamma_FW) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Gamma_FW,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Gamma_FW,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Gamma_FW,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Gamma_FW,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Gamma_FW,2), UBOUND(InData%Gamma_FW,2) - DO i1 = LBOUND(InData%Gamma_FW,1), UBOUND(InData%Gamma_FW,1) - ReKiBuf(Re_Xferred) = InData%Gamma_FW(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Eps_NW) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Eps_NW,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Eps_NW,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Eps_NW,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Eps_NW,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Eps_NW,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Eps_NW,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Eps_NW,3), UBOUND(InData%Eps_NW,3) - DO i2 = LBOUND(InData%Eps_NW,2), UBOUND(InData%Eps_NW,2) - DO i1 = LBOUND(InData%Eps_NW,1), UBOUND(InData%Eps_NW,1) - ReKiBuf(Re_Xferred) = InData%Eps_NW(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Eps_FW) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Eps_FW,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Eps_FW,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Eps_FW,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Eps_FW,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Eps_FW,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Eps_FW,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Eps_FW,3), UBOUND(InData%Eps_FW,3) - DO i2 = LBOUND(InData%Eps_FW,2), UBOUND(InData%Eps_FW,2) - DO i1 = LBOUND(InData%Eps_FW,1), UBOUND(InData%Eps_FW,1) - ReKiBuf(Re_Xferred) = InData%Eps_FW(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%r_NW) ) THEN - 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_NW,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%r_NW,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%r_NW,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%r_NW,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%r_NW,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%r_NW,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%r_NW,3), UBOUND(InData%r_NW,3) - DO i2 = LBOUND(InData%r_NW,2), UBOUND(InData%r_NW,2) - DO i1 = LBOUND(InData%r_NW,1), UBOUND(InData%r_NW,1) - ReKiBuf(Re_Xferred) = InData%r_NW(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%r_FW) ) THEN - 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_FW,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%r_FW,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%r_FW,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%r_FW,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%r_FW,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%r_FW,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%r_FW,3), UBOUND(InData%r_FW,3) - DO i2 = LBOUND(InData%r_FW,2), UBOUND(InData%r_FW,2) - DO i1 = LBOUND(InData%r_FW,1), UBOUND(InData%r_FW,1) - ReKiBuf(Re_Xferred) = InData%r_FW(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - END SUBROUTINE FVW_PackWng_ContinuousStateType - - SUBROUTINE FVW_UnPackWng_ContinuousStateType( 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(Wng_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) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_UnPackWng_ContinuousStateType' - ! 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 ! Gamma_NW not allocated - Int_Xferred = Int_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%Gamma_NW)) DEALLOCATE(OutData%Gamma_NW) - ALLOCATE(OutData%Gamma_NW(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Gamma_NW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Gamma_NW,2), UBOUND(OutData%Gamma_NW,2) - DO i1 = LBOUND(OutData%Gamma_NW,1), UBOUND(OutData%Gamma_NW,1) - OutData%Gamma_NW(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Gamma_FW not allocated - Int_Xferred = Int_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%Gamma_FW)) DEALLOCATE(OutData%Gamma_FW) - ALLOCATE(OutData%Gamma_FW(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Gamma_FW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Gamma_FW,2), UBOUND(OutData%Gamma_FW,2) - DO i1 = LBOUND(OutData%Gamma_FW,1), UBOUND(OutData%Gamma_FW,1) - OutData%Gamma_FW(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Eps_NW not allocated - Int_Xferred = Int_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%Eps_NW)) DEALLOCATE(OutData%Eps_NW) - ALLOCATE(OutData%Eps_NW(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%Eps_NW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Eps_NW,3), UBOUND(OutData%Eps_NW,3) - DO i2 = LBOUND(OutData%Eps_NW,2), UBOUND(OutData%Eps_NW,2) - DO i1 = LBOUND(OutData%Eps_NW,1), UBOUND(OutData%Eps_NW,1) - OutData%Eps_NW(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 ! Eps_FW not allocated - Int_Xferred = Int_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%Eps_FW)) DEALLOCATE(OutData%Eps_FW) - ALLOCATE(OutData%Eps_FW(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%Eps_FW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Eps_FW,3), UBOUND(OutData%Eps_FW,3) - DO i2 = LBOUND(OutData%Eps_FW,2), UBOUND(OutData%Eps_FW,2) - DO i1 = LBOUND(OutData%Eps_FW,1), UBOUND(OutData%Eps_FW,1) - OutData%Eps_FW(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 ! r_NW not allocated - Int_Xferred = Int_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%r_NW)) DEALLOCATE(OutData%r_NW) - ALLOCATE(OutData%r_NW(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%r_NW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%r_NW,3), UBOUND(OutData%r_NW,3) - DO i2 = LBOUND(OutData%r_NW,2), UBOUND(OutData%r_NW,2) - DO i1 = LBOUND(OutData%r_NW,1), UBOUND(OutData%r_NW,1) - OutData%r_NW(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 ! r_FW not allocated - Int_Xferred = Int_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%r_FW)) DEALLOCATE(OutData%r_FW) - ALLOCATE(OutData%r_FW(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%r_FW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%r_FW,3), UBOUND(OutData%r_FW,3) - DO i2 = LBOUND(OutData%r_FW,2), UBOUND(OutData%r_FW,2) - DO i1 = LBOUND(OutData%r_FW,1), UBOUND(OutData%r_FW,1) - OutData%r_FW(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - END SUBROUTINE FVW_UnPackWng_ContinuousStateType - - SUBROUTINE FVW_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FVW_ContinuousStateType), INTENT(IN) :: SrcContStateData - TYPE(FVW_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 = 'FVW_CopyContState' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcContStateData%W)) THEN - i1_l = LBOUND(SrcContStateData%W,1) - i1_u = UBOUND(SrcContStateData%W,1) - IF (.NOT. ALLOCATED(DstContStateData%W)) THEN - ALLOCATE(DstContStateData%W(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%W.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcContStateData%W,1), UBOUND(SrcContStateData%W,1) - CALL FVW_Copywng_continuousstatetype( SrcContStateData%W(i1), DstContStateData%W(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcContStateData%UA)) THEN - i1_l = LBOUND(SrcContStateData%UA,1) - i1_u = UBOUND(SrcContStateData%UA,1) - IF (.NOT. ALLOCATED(DstContStateData%UA)) THEN - ALLOCATE(DstContStateData%UA(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%UA.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcContStateData%UA,1), UBOUND(SrcContStateData%UA,1) - CALL UA_CopyContState( SrcContStateData%UA(i1), DstContStateData%UA(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - END SUBROUTINE FVW_CopyContState - - SUBROUTINE FVW_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(FVW_ContinuousStateType), INTENT(INOUT) :: ContStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_DestroyContState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(ContStateData%W)) THEN -DO i1 = LBOUND(ContStateData%W,1), UBOUND(ContStateData%W,1) - CALL FVW_Destroywng_continuousstatetype( ContStateData%W(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ContStateData%W) -ENDIF -IF (ALLOCATED(ContStateData%UA)) THEN -DO i1 = LBOUND(ContStateData%UA,1), UBOUND(ContStateData%UA,1) - CALL UA_DestroyContState( ContStateData%UA(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ContStateData%UA) -ENDIF - END SUBROUTINE FVW_DestroyContState - - SUBROUTINE FVW_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(FVW_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 = 'FVW_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 ! W allocated yes/no - IF ( ALLOCATED(InData%W) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! W upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%W,1), UBOUND(InData%W,1) - Int_BufSz = Int_BufSz + 3 ! W: size of buffers for each call to pack subtype - CALL FVW_Packwng_continuousstatetype( Re_Buf, Db_Buf, Int_Buf, InData%W(i1), ErrStat2, ErrMsg2, .TRUE. ) ! W - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! W - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! W - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! W - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! UA allocated yes/no - IF ( ALLOCATED(InData%UA) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! UA upper/lower bounds for each dimension - DO i1 = LBOUND(InData%UA,1), UBOUND(InData%UA,1) - Int_BufSz = Int_BufSz + 3 ! UA: size of buffers for each call to pack subtype - CALL UA_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%UA(i1), ErrStat2, ErrMsg2, .TRUE. ) ! UA - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! UA - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! UA - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! UA - 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%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) - CALL FVW_Packwng_continuousstatetype( Re_Buf, Db_Buf, Int_Buf, InData%W(i1), ErrStat2, ErrMsg2, OnlySize ) ! W - 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%UA) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%UA,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UA,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%UA,1), UBOUND(InData%UA,1) - CALL UA_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%UA(i1), ErrStat2, ErrMsg2, OnlySize ) ! UA - 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 FVW_PackContState - - SUBROUTINE FVW_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(FVW_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 = 'FVW_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 ! 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 (ALLOCATED(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 - DO i1 = LBOUND(OutData%W,1), UBOUND(OutData%W,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 FVW_Unpackwng_continuousstatetype( Re_Buf, Db_Buf, Int_Buf, OutData%W(i1), ErrStat2, ErrMsg2 ) ! W - 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 ! UA not allocated - Int_Xferred = Int_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%UA)) DEALLOCATE(OutData%UA) - ALLOCATE(OutData%UA(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%UA.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%UA,1), UBOUND(OutData%UA,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 UA_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%UA(i1), ErrStat2, ErrMsg2 ) ! UA - 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 FVW_UnPackContState - - SUBROUTINE FVW_CopyWng_OutputType( SrcWng_OutputTypeData, DstWng_OutputTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Wng_OutputType), INTENT(IN) :: SrcWng_OutputTypeData - TYPE(Wng_OutputType), INTENT(INOUT) :: DstWng_OutputTypeData - 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 = 'FVW_CopyWng_OutputType' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcWng_OutputTypeData%Vind)) THEN - i1_l = LBOUND(SrcWng_OutputTypeData%Vind,1) - i1_u = UBOUND(SrcWng_OutputTypeData%Vind,1) - i2_l = LBOUND(SrcWng_OutputTypeData%Vind,2) - i2_u = UBOUND(SrcWng_OutputTypeData%Vind,2) - IF (.NOT. ALLOCATED(DstWng_OutputTypeData%Vind)) THEN - ALLOCATE(DstWng_OutputTypeData%Vind(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_OutputTypeData%Vind.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_OutputTypeData%Vind = SrcWng_OutputTypeData%Vind -ENDIF - END SUBROUTINE FVW_CopyWng_OutputType - - SUBROUTINE FVW_DestroyWng_OutputType( Wng_OutputTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(Wng_OutputType), INTENT(INOUT) :: Wng_OutputTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_DestroyWng_OutputType' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(Wng_OutputTypeData%Vind)) THEN - DEALLOCATE(Wng_OutputTypeData%Vind) -ENDIF - END SUBROUTINE FVW_DestroyWng_OutputType - - SUBROUTINE FVW_PackWng_OutputType( 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(Wng_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 = 'FVW_PackWng_OutputType' - ! 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 ! Vind allocated yes/no - IF ( ALLOCATED(InData%Vind) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Vind upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vind) ! Vind - 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%Vind) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vind,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vind,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vind,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vind,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Vind,2), UBOUND(InData%Vind,2) - DO i1 = LBOUND(InData%Vind,1), UBOUND(InData%Vind,1) - ReKiBuf(Re_Xferred) = InData%Vind(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE FVW_PackWng_OutputType - - SUBROUTINE FVW_UnPackWng_OutputType( 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(Wng_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 = 'FVW_UnPackWng_OutputType' - ! 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 ! Vind not allocated - Int_Xferred = Int_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%Vind)) DEALLOCATE(OutData%Vind) - ALLOCATE(OutData%Vind(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vind.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Vind,2), UBOUND(OutData%Vind,2) - DO i1 = LBOUND(OutData%Vind,1), UBOUND(OutData%Vind,1) - OutData%Vind(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE FVW_UnPackWng_OutputType - - SUBROUTINE FVW_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FVW_OutputType), INTENT(IN) :: SrcOutputData - TYPE(FVW_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 = 'FVW_CopyOutput' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcOutputData%W)) THEN - i1_l = LBOUND(SrcOutputData%W,1) - i1_u = UBOUND(SrcOutputData%W,1) - IF (.NOT. ALLOCATED(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 - END IF - DO i1 = LBOUND(SrcOutputData%W,1), UBOUND(SrcOutputData%W,1) - CALL FVW_Copywng_outputtype( SrcOutputData%W(i1), DstOutputData%W(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - END SUBROUTINE FVW_CopyOutput - - SUBROUTINE FVW_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(FVW_OutputType), INTENT(INOUT) :: OutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_DestroyOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(OutputData%W)) THEN -DO i1 = LBOUND(OutputData%W,1), UBOUND(OutputData%W,1) - CALL FVW_Destroywng_outputtype( OutputData%W(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(OutputData%W) -ENDIF - END SUBROUTINE FVW_DestroyOutput - - SUBROUTINE FVW_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(FVW_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 = 'FVW_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 ! W allocated yes/no - IF ( ALLOCATED(InData%W) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! W upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%W,1), UBOUND(InData%W,1) - Int_BufSz = Int_BufSz + 3 ! W: size of buffers for each call to pack subtype - CALL FVW_Packwng_outputtype( Re_Buf, Db_Buf, Int_Buf, InData%W(i1), ErrStat2, ErrMsg2, .TRUE. ) ! W - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! W - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! W - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! W - 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%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) - CALL FVW_Packwng_outputtype( Re_Buf, Db_Buf, Int_Buf, InData%W(i1), ErrStat2, ErrMsg2, OnlySize ) ! W - 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 FVW_PackOutput - - SUBROUTINE FVW_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(FVW_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 = 'FVW_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 ! 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 (ALLOCATED(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 - DO i1 = LBOUND(OutData%W,1), UBOUND(OutData%W,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 FVW_Unpackwng_outputtype( Re_Buf, Db_Buf, Int_Buf, OutData%W(i1), ErrStat2, ErrMsg2 ) ! W - 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 FVW_UnPackOutput - - SUBROUTINE FVW_CopyWng_MiscVarType( SrcWng_MiscVarTypeData, DstWng_MiscVarTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Wng_MiscVarType), INTENT(IN) :: SrcWng_MiscVarTypeData - TYPE(Wng_MiscVarType), INTENT(INOUT) :: DstWng_MiscVarTypeData - 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 = 'FVW_CopyWng_MiscVarType' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcWng_MiscVarTypeData%LE)) THEN - i1_l = LBOUND(SrcWng_MiscVarTypeData%LE,1) - i1_u = UBOUND(SrcWng_MiscVarTypeData%LE,1) - i2_l = LBOUND(SrcWng_MiscVarTypeData%LE,2) - i2_u = UBOUND(SrcWng_MiscVarTypeData%LE,2) - IF (.NOT. ALLOCATED(DstWng_MiscVarTypeData%LE)) THEN - ALLOCATE(DstWng_MiscVarTypeData%LE(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%LE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_MiscVarTypeData%LE = SrcWng_MiscVarTypeData%LE -ENDIF -IF (ALLOCATED(SrcWng_MiscVarTypeData%TE)) THEN - i1_l = LBOUND(SrcWng_MiscVarTypeData%TE,1) - i1_u = UBOUND(SrcWng_MiscVarTypeData%TE,1) - i2_l = LBOUND(SrcWng_MiscVarTypeData%TE,2) - i2_u = UBOUND(SrcWng_MiscVarTypeData%TE,2) - IF (.NOT. ALLOCATED(DstWng_MiscVarTypeData%TE)) THEN - ALLOCATE(DstWng_MiscVarTypeData%TE(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%TE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_MiscVarTypeData%TE = SrcWng_MiscVarTypeData%TE -ENDIF -IF (ALLOCATED(SrcWng_MiscVarTypeData%r_LL)) THEN - i1_l = LBOUND(SrcWng_MiscVarTypeData%r_LL,1) - i1_u = UBOUND(SrcWng_MiscVarTypeData%r_LL,1) - i2_l = LBOUND(SrcWng_MiscVarTypeData%r_LL,2) - i2_u = UBOUND(SrcWng_MiscVarTypeData%r_LL,2) - i3_l = LBOUND(SrcWng_MiscVarTypeData%r_LL,3) - i3_u = UBOUND(SrcWng_MiscVarTypeData%r_LL,3) - IF (.NOT. ALLOCATED(DstWng_MiscVarTypeData%r_LL)) THEN - ALLOCATE(DstWng_MiscVarTypeData%r_LL(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%r_LL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_MiscVarTypeData%r_LL = SrcWng_MiscVarTypeData%r_LL -ENDIF -IF (ALLOCATED(SrcWng_MiscVarTypeData%CP)) THEN - i1_l = LBOUND(SrcWng_MiscVarTypeData%CP,1) - i1_u = UBOUND(SrcWng_MiscVarTypeData%CP,1) - i2_l = LBOUND(SrcWng_MiscVarTypeData%CP,2) - i2_u = UBOUND(SrcWng_MiscVarTypeData%CP,2) - IF (.NOT. ALLOCATED(DstWng_MiscVarTypeData%CP)) THEN - ALLOCATE(DstWng_MiscVarTypeData%CP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%CP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_MiscVarTypeData%CP = SrcWng_MiscVarTypeData%CP -ENDIF -IF (ALLOCATED(SrcWng_MiscVarTypeData%Tang)) THEN - i1_l = LBOUND(SrcWng_MiscVarTypeData%Tang,1) - i1_u = UBOUND(SrcWng_MiscVarTypeData%Tang,1) - i2_l = LBOUND(SrcWng_MiscVarTypeData%Tang,2) - i2_u = UBOUND(SrcWng_MiscVarTypeData%Tang,2) - IF (.NOT. ALLOCATED(DstWng_MiscVarTypeData%Tang)) THEN - ALLOCATE(DstWng_MiscVarTypeData%Tang(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%Tang.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_MiscVarTypeData%Tang = SrcWng_MiscVarTypeData%Tang -ENDIF -IF (ALLOCATED(SrcWng_MiscVarTypeData%Norm)) THEN - i1_l = LBOUND(SrcWng_MiscVarTypeData%Norm,1) - i1_u = UBOUND(SrcWng_MiscVarTypeData%Norm,1) - i2_l = LBOUND(SrcWng_MiscVarTypeData%Norm,2) - i2_u = UBOUND(SrcWng_MiscVarTypeData%Norm,2) - IF (.NOT. ALLOCATED(DstWng_MiscVarTypeData%Norm)) THEN - ALLOCATE(DstWng_MiscVarTypeData%Norm(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%Norm.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_MiscVarTypeData%Norm = SrcWng_MiscVarTypeData%Norm -ENDIF -IF (ALLOCATED(SrcWng_MiscVarTypeData%Orth)) THEN - i1_l = LBOUND(SrcWng_MiscVarTypeData%Orth,1) - i1_u = UBOUND(SrcWng_MiscVarTypeData%Orth,1) - i2_l = LBOUND(SrcWng_MiscVarTypeData%Orth,2) - i2_u = UBOUND(SrcWng_MiscVarTypeData%Orth,2) - IF (.NOT. ALLOCATED(DstWng_MiscVarTypeData%Orth)) THEN - ALLOCATE(DstWng_MiscVarTypeData%Orth(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%Orth.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_MiscVarTypeData%Orth = SrcWng_MiscVarTypeData%Orth -ENDIF -IF (ALLOCATED(SrcWng_MiscVarTypeData%dl)) THEN - i1_l = LBOUND(SrcWng_MiscVarTypeData%dl,1) - i1_u = UBOUND(SrcWng_MiscVarTypeData%dl,1) - i2_l = LBOUND(SrcWng_MiscVarTypeData%dl,2) - i2_u = UBOUND(SrcWng_MiscVarTypeData%dl,2) - IF (.NOT. ALLOCATED(DstWng_MiscVarTypeData%dl)) THEN - ALLOCATE(DstWng_MiscVarTypeData%dl(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%dl.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_MiscVarTypeData%dl = SrcWng_MiscVarTypeData%dl -ENDIF -IF (ALLOCATED(SrcWng_MiscVarTypeData%Area)) THEN - i1_l = LBOUND(SrcWng_MiscVarTypeData%Area,1) - i1_u = UBOUND(SrcWng_MiscVarTypeData%Area,1) - IF (.NOT. ALLOCATED(DstWng_MiscVarTypeData%Area)) THEN - ALLOCATE(DstWng_MiscVarTypeData%Area(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%Area.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_MiscVarTypeData%Area = SrcWng_MiscVarTypeData%Area -ENDIF -IF (ALLOCATED(SrcWng_MiscVarTypeData%diag_LL)) THEN - i1_l = LBOUND(SrcWng_MiscVarTypeData%diag_LL,1) - i1_u = UBOUND(SrcWng_MiscVarTypeData%diag_LL,1) - IF (.NOT. ALLOCATED(DstWng_MiscVarTypeData%diag_LL)) THEN - ALLOCATE(DstWng_MiscVarTypeData%diag_LL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%diag_LL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_MiscVarTypeData%diag_LL = SrcWng_MiscVarTypeData%diag_LL -ENDIF -IF (ALLOCATED(SrcWng_MiscVarTypeData%Vind_CP)) THEN - i1_l = LBOUND(SrcWng_MiscVarTypeData%Vind_CP,1) - i1_u = UBOUND(SrcWng_MiscVarTypeData%Vind_CP,1) - i2_l = LBOUND(SrcWng_MiscVarTypeData%Vind_CP,2) - i2_u = UBOUND(SrcWng_MiscVarTypeData%Vind_CP,2) - IF (.NOT. ALLOCATED(DstWng_MiscVarTypeData%Vind_CP)) THEN - ALLOCATE(DstWng_MiscVarTypeData%Vind_CP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%Vind_CP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_MiscVarTypeData%Vind_CP = SrcWng_MiscVarTypeData%Vind_CP -ENDIF -IF (ALLOCATED(SrcWng_MiscVarTypeData%Vtot_CP)) THEN - i1_l = LBOUND(SrcWng_MiscVarTypeData%Vtot_CP,1) - i1_u = UBOUND(SrcWng_MiscVarTypeData%Vtot_CP,1) - i2_l = LBOUND(SrcWng_MiscVarTypeData%Vtot_CP,2) - i2_u = UBOUND(SrcWng_MiscVarTypeData%Vtot_CP,2) - IF (.NOT. ALLOCATED(DstWng_MiscVarTypeData%Vtot_CP)) THEN - ALLOCATE(DstWng_MiscVarTypeData%Vtot_CP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%Vtot_CP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_MiscVarTypeData%Vtot_CP = SrcWng_MiscVarTypeData%Vtot_CP -ENDIF -IF (ALLOCATED(SrcWng_MiscVarTypeData%Vstr_CP)) THEN - i1_l = LBOUND(SrcWng_MiscVarTypeData%Vstr_CP,1) - i1_u = UBOUND(SrcWng_MiscVarTypeData%Vstr_CP,1) - i2_l = LBOUND(SrcWng_MiscVarTypeData%Vstr_CP,2) - i2_u = UBOUND(SrcWng_MiscVarTypeData%Vstr_CP,2) - IF (.NOT. ALLOCATED(DstWng_MiscVarTypeData%Vstr_CP)) THEN - ALLOCATE(DstWng_MiscVarTypeData%Vstr_CP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%Vstr_CP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_MiscVarTypeData%Vstr_CP = SrcWng_MiscVarTypeData%Vstr_CP -ENDIF -IF (ALLOCATED(SrcWng_MiscVarTypeData%Vwnd_CP)) THEN - i1_l = LBOUND(SrcWng_MiscVarTypeData%Vwnd_CP,1) - i1_u = UBOUND(SrcWng_MiscVarTypeData%Vwnd_CP,1) - i2_l = LBOUND(SrcWng_MiscVarTypeData%Vwnd_CP,2) - i2_u = UBOUND(SrcWng_MiscVarTypeData%Vwnd_CP,2) - IF (.NOT. ALLOCATED(DstWng_MiscVarTypeData%Vwnd_CP)) THEN - ALLOCATE(DstWng_MiscVarTypeData%Vwnd_CP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%Vwnd_CP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_MiscVarTypeData%Vwnd_CP = SrcWng_MiscVarTypeData%Vwnd_CP -ENDIF -IF (ALLOCATED(SrcWng_MiscVarTypeData%Vwnd_NW)) THEN - i1_l = LBOUND(SrcWng_MiscVarTypeData%Vwnd_NW,1) - i1_u = UBOUND(SrcWng_MiscVarTypeData%Vwnd_NW,1) - i2_l = LBOUND(SrcWng_MiscVarTypeData%Vwnd_NW,2) - i2_u = UBOUND(SrcWng_MiscVarTypeData%Vwnd_NW,2) - i3_l = LBOUND(SrcWng_MiscVarTypeData%Vwnd_NW,3) - i3_u = UBOUND(SrcWng_MiscVarTypeData%Vwnd_NW,3) - IF (.NOT. ALLOCATED(DstWng_MiscVarTypeData%Vwnd_NW)) THEN - ALLOCATE(DstWng_MiscVarTypeData%Vwnd_NW(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%Vwnd_NW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_MiscVarTypeData%Vwnd_NW = SrcWng_MiscVarTypeData%Vwnd_NW -ENDIF -IF (ALLOCATED(SrcWng_MiscVarTypeData%Vwnd_FW)) THEN - i1_l = LBOUND(SrcWng_MiscVarTypeData%Vwnd_FW,1) - i1_u = UBOUND(SrcWng_MiscVarTypeData%Vwnd_FW,1) - i2_l = LBOUND(SrcWng_MiscVarTypeData%Vwnd_FW,2) - i2_u = UBOUND(SrcWng_MiscVarTypeData%Vwnd_FW,2) - i3_l = LBOUND(SrcWng_MiscVarTypeData%Vwnd_FW,3) - i3_u = UBOUND(SrcWng_MiscVarTypeData%Vwnd_FW,3) - IF (.NOT. ALLOCATED(DstWng_MiscVarTypeData%Vwnd_FW)) THEN - ALLOCATE(DstWng_MiscVarTypeData%Vwnd_FW(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%Vwnd_FW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_MiscVarTypeData%Vwnd_FW = SrcWng_MiscVarTypeData%Vwnd_FW -ENDIF -IF (ALLOCATED(SrcWng_MiscVarTypeData%Vind_NW)) THEN - i1_l = LBOUND(SrcWng_MiscVarTypeData%Vind_NW,1) - i1_u = UBOUND(SrcWng_MiscVarTypeData%Vind_NW,1) - i2_l = LBOUND(SrcWng_MiscVarTypeData%Vind_NW,2) - i2_u = UBOUND(SrcWng_MiscVarTypeData%Vind_NW,2) - i3_l = LBOUND(SrcWng_MiscVarTypeData%Vind_NW,3) - i3_u = UBOUND(SrcWng_MiscVarTypeData%Vind_NW,3) - IF (.NOT. ALLOCATED(DstWng_MiscVarTypeData%Vind_NW)) THEN - ALLOCATE(DstWng_MiscVarTypeData%Vind_NW(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%Vind_NW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_MiscVarTypeData%Vind_NW = SrcWng_MiscVarTypeData%Vind_NW -ENDIF -IF (ALLOCATED(SrcWng_MiscVarTypeData%Vind_FW)) THEN - i1_l = LBOUND(SrcWng_MiscVarTypeData%Vind_FW,1) - i1_u = UBOUND(SrcWng_MiscVarTypeData%Vind_FW,1) - i2_l = LBOUND(SrcWng_MiscVarTypeData%Vind_FW,2) - i2_u = UBOUND(SrcWng_MiscVarTypeData%Vind_FW,2) - i3_l = LBOUND(SrcWng_MiscVarTypeData%Vind_FW,3) - i3_u = UBOUND(SrcWng_MiscVarTypeData%Vind_FW,3) - IF (.NOT. ALLOCATED(DstWng_MiscVarTypeData%Vind_FW)) THEN - ALLOCATE(DstWng_MiscVarTypeData%Vind_FW(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%Vind_FW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_MiscVarTypeData%Vind_FW = SrcWng_MiscVarTypeData%Vind_FW -ENDIF -IF (ALLOCATED(SrcWng_MiscVarTypeData%PitchAndTwist)) THEN - i1_l = LBOUND(SrcWng_MiscVarTypeData%PitchAndTwist,1) - i1_u = UBOUND(SrcWng_MiscVarTypeData%PitchAndTwist,1) - IF (.NOT. ALLOCATED(DstWng_MiscVarTypeData%PitchAndTwist)) THEN - ALLOCATE(DstWng_MiscVarTypeData%PitchAndTwist(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%PitchAndTwist.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_MiscVarTypeData%PitchAndTwist = SrcWng_MiscVarTypeData%PitchAndTwist -ENDIF - DstWng_MiscVarTypeData%iTip = SrcWng_MiscVarTypeData%iTip - DstWng_MiscVarTypeData%iRoot = SrcWng_MiscVarTypeData%iRoot -IF (ALLOCATED(SrcWng_MiscVarTypeData%alpha_LL)) THEN - i1_l = LBOUND(SrcWng_MiscVarTypeData%alpha_LL,1) - i1_u = UBOUND(SrcWng_MiscVarTypeData%alpha_LL,1) - IF (.NOT. ALLOCATED(DstWng_MiscVarTypeData%alpha_LL)) THEN - ALLOCATE(DstWng_MiscVarTypeData%alpha_LL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%alpha_LL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_MiscVarTypeData%alpha_LL = SrcWng_MiscVarTypeData%alpha_LL -ENDIF -IF (ALLOCATED(SrcWng_MiscVarTypeData%Vreln_LL)) THEN - i1_l = LBOUND(SrcWng_MiscVarTypeData%Vreln_LL,1) - i1_u = UBOUND(SrcWng_MiscVarTypeData%Vreln_LL,1) - IF (.NOT. ALLOCATED(DstWng_MiscVarTypeData%Vreln_LL)) THEN - ALLOCATE(DstWng_MiscVarTypeData%Vreln_LL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%Vreln_LL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_MiscVarTypeData%Vreln_LL = SrcWng_MiscVarTypeData%Vreln_LL -ENDIF -IF (ALLOCATED(SrcWng_MiscVarTypeData%u_UA)) THEN - i1_l = LBOUND(SrcWng_MiscVarTypeData%u_UA,1) - i1_u = UBOUND(SrcWng_MiscVarTypeData%u_UA,1) - i2_l = LBOUND(SrcWng_MiscVarTypeData%u_UA,2) - i2_u = UBOUND(SrcWng_MiscVarTypeData%u_UA,2) - IF (.NOT. ALLOCATED(DstWng_MiscVarTypeData%u_UA)) THEN - ALLOCATE(DstWng_MiscVarTypeData%u_UA(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%u_UA.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcWng_MiscVarTypeData%u_UA,2), UBOUND(SrcWng_MiscVarTypeData%u_UA,2) - DO i1 = LBOUND(SrcWng_MiscVarTypeData%u_UA,1), UBOUND(SrcWng_MiscVarTypeData%u_UA,1) - CALL UA_CopyInput( SrcWng_MiscVarTypeData%u_UA(i1,i2), DstWng_MiscVarTypeData%u_UA(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF - CALL UA_CopyMisc( SrcWng_MiscVarTypeData%m_UA, DstWng_MiscVarTypeData%m_UA, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL UA_CopyOutput( SrcWng_MiscVarTypeData%y_UA, DstWng_MiscVarTypeData%y_UA, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL UA_CopyParam( SrcWng_MiscVarTypeData%p_UA, DstWng_MiscVarTypeData%p_UA, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcWng_MiscVarTypeData%Vind_LL)) THEN - i1_l = LBOUND(SrcWng_MiscVarTypeData%Vind_LL,1) - i1_u = UBOUND(SrcWng_MiscVarTypeData%Vind_LL,1) - i2_l = LBOUND(SrcWng_MiscVarTypeData%Vind_LL,2) - i2_u = UBOUND(SrcWng_MiscVarTypeData%Vind_LL,2) - IF (.NOT. ALLOCATED(DstWng_MiscVarTypeData%Vind_LL)) THEN - ALLOCATE(DstWng_MiscVarTypeData%Vind_LL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%Vind_LL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_MiscVarTypeData%Vind_LL = SrcWng_MiscVarTypeData%Vind_LL -ENDIF -IF (ALLOCATED(SrcWng_MiscVarTypeData%BN_AxInd)) THEN - i1_l = LBOUND(SrcWng_MiscVarTypeData%BN_AxInd,1) - i1_u = UBOUND(SrcWng_MiscVarTypeData%BN_AxInd,1) - IF (.NOT. ALLOCATED(DstWng_MiscVarTypeData%BN_AxInd)) THEN - ALLOCATE(DstWng_MiscVarTypeData%BN_AxInd(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%BN_AxInd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_MiscVarTypeData%BN_AxInd = SrcWng_MiscVarTypeData%BN_AxInd -ENDIF -IF (ALLOCATED(SrcWng_MiscVarTypeData%BN_TanInd)) THEN - i1_l = LBOUND(SrcWng_MiscVarTypeData%BN_TanInd,1) - i1_u = UBOUND(SrcWng_MiscVarTypeData%BN_TanInd,1) - IF (.NOT. ALLOCATED(DstWng_MiscVarTypeData%BN_TanInd)) THEN - ALLOCATE(DstWng_MiscVarTypeData%BN_TanInd(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%BN_TanInd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_MiscVarTypeData%BN_TanInd = SrcWng_MiscVarTypeData%BN_TanInd -ENDIF -IF (ALLOCATED(SrcWng_MiscVarTypeData%BN_Vrel)) THEN - i1_l = LBOUND(SrcWng_MiscVarTypeData%BN_Vrel,1) - i1_u = UBOUND(SrcWng_MiscVarTypeData%BN_Vrel,1) - IF (.NOT. ALLOCATED(DstWng_MiscVarTypeData%BN_Vrel)) THEN - ALLOCATE(DstWng_MiscVarTypeData%BN_Vrel(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%BN_Vrel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_MiscVarTypeData%BN_Vrel = SrcWng_MiscVarTypeData%BN_Vrel -ENDIF -IF (ALLOCATED(SrcWng_MiscVarTypeData%BN_alpha)) THEN - i1_l = LBOUND(SrcWng_MiscVarTypeData%BN_alpha,1) - i1_u = UBOUND(SrcWng_MiscVarTypeData%BN_alpha,1) - IF (.NOT. ALLOCATED(DstWng_MiscVarTypeData%BN_alpha)) THEN - ALLOCATE(DstWng_MiscVarTypeData%BN_alpha(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%BN_alpha.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_MiscVarTypeData%BN_alpha = SrcWng_MiscVarTypeData%BN_alpha -ENDIF -IF (ALLOCATED(SrcWng_MiscVarTypeData%BN_phi)) THEN - i1_l = LBOUND(SrcWng_MiscVarTypeData%BN_phi,1) - i1_u = UBOUND(SrcWng_MiscVarTypeData%BN_phi,1) - IF (.NOT. ALLOCATED(DstWng_MiscVarTypeData%BN_phi)) THEN - ALLOCATE(DstWng_MiscVarTypeData%BN_phi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%BN_phi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_MiscVarTypeData%BN_phi = SrcWng_MiscVarTypeData%BN_phi -ENDIF -IF (ALLOCATED(SrcWng_MiscVarTypeData%BN_Re)) THEN - i1_l = LBOUND(SrcWng_MiscVarTypeData%BN_Re,1) - i1_u = UBOUND(SrcWng_MiscVarTypeData%BN_Re,1) - IF (.NOT. ALLOCATED(DstWng_MiscVarTypeData%BN_Re)) THEN - ALLOCATE(DstWng_MiscVarTypeData%BN_Re(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%BN_Re.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_MiscVarTypeData%BN_Re = SrcWng_MiscVarTypeData%BN_Re -ENDIF -IF (ALLOCATED(SrcWng_MiscVarTypeData%BN_URelWind_s)) THEN - i1_l = LBOUND(SrcWng_MiscVarTypeData%BN_URelWind_s,1) - i1_u = UBOUND(SrcWng_MiscVarTypeData%BN_URelWind_s,1) - i2_l = LBOUND(SrcWng_MiscVarTypeData%BN_URelWind_s,2) - i2_u = UBOUND(SrcWng_MiscVarTypeData%BN_URelWind_s,2) - IF (.NOT. ALLOCATED(DstWng_MiscVarTypeData%BN_URelWind_s)) THEN - ALLOCATE(DstWng_MiscVarTypeData%BN_URelWind_s(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%BN_URelWind_s.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_MiscVarTypeData%BN_URelWind_s = SrcWng_MiscVarTypeData%BN_URelWind_s -ENDIF -IF (ALLOCATED(SrcWng_MiscVarTypeData%BN_Cl_Static)) THEN - i1_l = LBOUND(SrcWng_MiscVarTypeData%BN_Cl_Static,1) - i1_u = UBOUND(SrcWng_MiscVarTypeData%BN_Cl_Static,1) - IF (.NOT. ALLOCATED(DstWng_MiscVarTypeData%BN_Cl_Static)) THEN - ALLOCATE(DstWng_MiscVarTypeData%BN_Cl_Static(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%BN_Cl_Static.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_MiscVarTypeData%BN_Cl_Static = SrcWng_MiscVarTypeData%BN_Cl_Static -ENDIF -IF (ALLOCATED(SrcWng_MiscVarTypeData%BN_Cd_Static)) THEN - i1_l = LBOUND(SrcWng_MiscVarTypeData%BN_Cd_Static,1) - i1_u = UBOUND(SrcWng_MiscVarTypeData%BN_Cd_Static,1) - IF (.NOT. ALLOCATED(DstWng_MiscVarTypeData%BN_Cd_Static)) THEN - ALLOCATE(DstWng_MiscVarTypeData%BN_Cd_Static(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%BN_Cd_Static.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_MiscVarTypeData%BN_Cd_Static = SrcWng_MiscVarTypeData%BN_Cd_Static -ENDIF -IF (ALLOCATED(SrcWng_MiscVarTypeData%BN_Cm_Static)) THEN - i1_l = LBOUND(SrcWng_MiscVarTypeData%BN_Cm_Static,1) - i1_u = UBOUND(SrcWng_MiscVarTypeData%BN_Cm_Static,1) - IF (.NOT. ALLOCATED(DstWng_MiscVarTypeData%BN_Cm_Static)) THEN - ALLOCATE(DstWng_MiscVarTypeData%BN_Cm_Static(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%BN_Cm_Static.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_MiscVarTypeData%BN_Cm_Static = SrcWng_MiscVarTypeData%BN_Cm_Static -ENDIF -IF (ALLOCATED(SrcWng_MiscVarTypeData%BN_Cpmin)) THEN - i1_l = LBOUND(SrcWng_MiscVarTypeData%BN_Cpmin,1) - i1_u = UBOUND(SrcWng_MiscVarTypeData%BN_Cpmin,1) - IF (.NOT. ALLOCATED(DstWng_MiscVarTypeData%BN_Cpmin)) THEN - ALLOCATE(DstWng_MiscVarTypeData%BN_Cpmin(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%BN_Cpmin.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_MiscVarTypeData%BN_Cpmin = SrcWng_MiscVarTypeData%BN_Cpmin -ENDIF -IF (ALLOCATED(SrcWng_MiscVarTypeData%BN_Cl)) THEN - i1_l = LBOUND(SrcWng_MiscVarTypeData%BN_Cl,1) - i1_u = UBOUND(SrcWng_MiscVarTypeData%BN_Cl,1) - IF (.NOT. ALLOCATED(DstWng_MiscVarTypeData%BN_Cl)) THEN - ALLOCATE(DstWng_MiscVarTypeData%BN_Cl(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%BN_Cl.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_MiscVarTypeData%BN_Cl = SrcWng_MiscVarTypeData%BN_Cl -ENDIF -IF (ALLOCATED(SrcWng_MiscVarTypeData%BN_Cd)) THEN - i1_l = LBOUND(SrcWng_MiscVarTypeData%BN_Cd,1) - i1_u = UBOUND(SrcWng_MiscVarTypeData%BN_Cd,1) - IF (.NOT. ALLOCATED(DstWng_MiscVarTypeData%BN_Cd)) THEN - ALLOCATE(DstWng_MiscVarTypeData%BN_Cd(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%BN_Cd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_MiscVarTypeData%BN_Cd = SrcWng_MiscVarTypeData%BN_Cd -ENDIF -IF (ALLOCATED(SrcWng_MiscVarTypeData%BN_Cm)) THEN - i1_l = LBOUND(SrcWng_MiscVarTypeData%BN_Cm,1) - i1_u = UBOUND(SrcWng_MiscVarTypeData%BN_Cm,1) - IF (.NOT. ALLOCATED(DstWng_MiscVarTypeData%BN_Cm)) THEN - ALLOCATE(DstWng_MiscVarTypeData%BN_Cm(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%BN_Cm.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_MiscVarTypeData%BN_Cm = SrcWng_MiscVarTypeData%BN_Cm -ENDIF -IF (ALLOCATED(SrcWng_MiscVarTypeData%BN_Cx)) THEN - i1_l = LBOUND(SrcWng_MiscVarTypeData%BN_Cx,1) - i1_u = UBOUND(SrcWng_MiscVarTypeData%BN_Cx,1) - IF (.NOT. ALLOCATED(DstWng_MiscVarTypeData%BN_Cx)) THEN - ALLOCATE(DstWng_MiscVarTypeData%BN_Cx(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%BN_Cx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_MiscVarTypeData%BN_Cx = SrcWng_MiscVarTypeData%BN_Cx -ENDIF -IF (ALLOCATED(SrcWng_MiscVarTypeData%BN_Cy)) THEN - i1_l = LBOUND(SrcWng_MiscVarTypeData%BN_Cy,1) - i1_u = UBOUND(SrcWng_MiscVarTypeData%BN_Cy,1) - IF (.NOT. ALLOCATED(DstWng_MiscVarTypeData%BN_Cy)) THEN - ALLOCATE(DstWng_MiscVarTypeData%BN_Cy(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%BN_Cy.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_MiscVarTypeData%BN_Cy = SrcWng_MiscVarTypeData%BN_Cy -ENDIF - END SUBROUTINE FVW_CopyWng_MiscVarType - - SUBROUTINE FVW_DestroyWng_MiscVarType( Wng_MiscVarTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(Wng_MiscVarType), INTENT(INOUT) :: Wng_MiscVarTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_DestroyWng_MiscVarType' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(Wng_MiscVarTypeData%LE)) THEN - DEALLOCATE(Wng_MiscVarTypeData%LE) -ENDIF -IF (ALLOCATED(Wng_MiscVarTypeData%TE)) THEN - DEALLOCATE(Wng_MiscVarTypeData%TE) -ENDIF -IF (ALLOCATED(Wng_MiscVarTypeData%r_LL)) THEN - DEALLOCATE(Wng_MiscVarTypeData%r_LL) -ENDIF -IF (ALLOCATED(Wng_MiscVarTypeData%CP)) THEN - DEALLOCATE(Wng_MiscVarTypeData%CP) -ENDIF -IF (ALLOCATED(Wng_MiscVarTypeData%Tang)) THEN - DEALLOCATE(Wng_MiscVarTypeData%Tang) -ENDIF -IF (ALLOCATED(Wng_MiscVarTypeData%Norm)) THEN - DEALLOCATE(Wng_MiscVarTypeData%Norm) -ENDIF -IF (ALLOCATED(Wng_MiscVarTypeData%Orth)) THEN - DEALLOCATE(Wng_MiscVarTypeData%Orth) -ENDIF -IF (ALLOCATED(Wng_MiscVarTypeData%dl)) THEN - DEALLOCATE(Wng_MiscVarTypeData%dl) -ENDIF -IF (ALLOCATED(Wng_MiscVarTypeData%Area)) THEN - DEALLOCATE(Wng_MiscVarTypeData%Area) -ENDIF -IF (ALLOCATED(Wng_MiscVarTypeData%diag_LL)) THEN - DEALLOCATE(Wng_MiscVarTypeData%diag_LL) -ENDIF -IF (ALLOCATED(Wng_MiscVarTypeData%Vind_CP)) THEN - DEALLOCATE(Wng_MiscVarTypeData%Vind_CP) -ENDIF -IF (ALLOCATED(Wng_MiscVarTypeData%Vtot_CP)) THEN - DEALLOCATE(Wng_MiscVarTypeData%Vtot_CP) -ENDIF -IF (ALLOCATED(Wng_MiscVarTypeData%Vstr_CP)) THEN - DEALLOCATE(Wng_MiscVarTypeData%Vstr_CP) -ENDIF -IF (ALLOCATED(Wng_MiscVarTypeData%Vwnd_CP)) THEN - DEALLOCATE(Wng_MiscVarTypeData%Vwnd_CP) -ENDIF -IF (ALLOCATED(Wng_MiscVarTypeData%Vwnd_NW)) THEN - DEALLOCATE(Wng_MiscVarTypeData%Vwnd_NW) -ENDIF -IF (ALLOCATED(Wng_MiscVarTypeData%Vwnd_FW)) THEN - DEALLOCATE(Wng_MiscVarTypeData%Vwnd_FW) -ENDIF -IF (ALLOCATED(Wng_MiscVarTypeData%Vind_NW)) THEN - DEALLOCATE(Wng_MiscVarTypeData%Vind_NW) -ENDIF -IF (ALLOCATED(Wng_MiscVarTypeData%Vind_FW)) THEN - DEALLOCATE(Wng_MiscVarTypeData%Vind_FW) -ENDIF -IF (ALLOCATED(Wng_MiscVarTypeData%PitchAndTwist)) THEN - DEALLOCATE(Wng_MiscVarTypeData%PitchAndTwist) -ENDIF -IF (ALLOCATED(Wng_MiscVarTypeData%alpha_LL)) THEN - DEALLOCATE(Wng_MiscVarTypeData%alpha_LL) -ENDIF -IF (ALLOCATED(Wng_MiscVarTypeData%Vreln_LL)) THEN - DEALLOCATE(Wng_MiscVarTypeData%Vreln_LL) -ENDIF -IF (ALLOCATED(Wng_MiscVarTypeData%u_UA)) THEN -DO i2 = LBOUND(Wng_MiscVarTypeData%u_UA,2), UBOUND(Wng_MiscVarTypeData%u_UA,2) -DO i1 = LBOUND(Wng_MiscVarTypeData%u_UA,1), UBOUND(Wng_MiscVarTypeData%u_UA,1) - CALL UA_DestroyInput( Wng_MiscVarTypeData%u_UA(i1,i2), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO - DEALLOCATE(Wng_MiscVarTypeData%u_UA) -ENDIF - CALL UA_DestroyMisc( Wng_MiscVarTypeData%m_UA, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL UA_DestroyOutput( Wng_MiscVarTypeData%y_UA, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL UA_DestroyParam( Wng_MiscVarTypeData%p_UA, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(Wng_MiscVarTypeData%Vind_LL)) THEN - DEALLOCATE(Wng_MiscVarTypeData%Vind_LL) -ENDIF -IF (ALLOCATED(Wng_MiscVarTypeData%BN_AxInd)) THEN - DEALLOCATE(Wng_MiscVarTypeData%BN_AxInd) -ENDIF -IF (ALLOCATED(Wng_MiscVarTypeData%BN_TanInd)) THEN - DEALLOCATE(Wng_MiscVarTypeData%BN_TanInd) -ENDIF -IF (ALLOCATED(Wng_MiscVarTypeData%BN_Vrel)) THEN - DEALLOCATE(Wng_MiscVarTypeData%BN_Vrel) -ENDIF -IF (ALLOCATED(Wng_MiscVarTypeData%BN_alpha)) THEN - DEALLOCATE(Wng_MiscVarTypeData%BN_alpha) -ENDIF -IF (ALLOCATED(Wng_MiscVarTypeData%BN_phi)) THEN - DEALLOCATE(Wng_MiscVarTypeData%BN_phi) -ENDIF -IF (ALLOCATED(Wng_MiscVarTypeData%BN_Re)) THEN - DEALLOCATE(Wng_MiscVarTypeData%BN_Re) -ENDIF -IF (ALLOCATED(Wng_MiscVarTypeData%BN_URelWind_s)) THEN - DEALLOCATE(Wng_MiscVarTypeData%BN_URelWind_s) -ENDIF -IF (ALLOCATED(Wng_MiscVarTypeData%BN_Cl_Static)) THEN - DEALLOCATE(Wng_MiscVarTypeData%BN_Cl_Static) -ENDIF -IF (ALLOCATED(Wng_MiscVarTypeData%BN_Cd_Static)) THEN - DEALLOCATE(Wng_MiscVarTypeData%BN_Cd_Static) -ENDIF -IF (ALLOCATED(Wng_MiscVarTypeData%BN_Cm_Static)) THEN - DEALLOCATE(Wng_MiscVarTypeData%BN_Cm_Static) -ENDIF -IF (ALLOCATED(Wng_MiscVarTypeData%BN_Cpmin)) THEN - DEALLOCATE(Wng_MiscVarTypeData%BN_Cpmin) -ENDIF -IF (ALLOCATED(Wng_MiscVarTypeData%BN_Cl)) THEN - DEALLOCATE(Wng_MiscVarTypeData%BN_Cl) -ENDIF -IF (ALLOCATED(Wng_MiscVarTypeData%BN_Cd)) THEN - DEALLOCATE(Wng_MiscVarTypeData%BN_Cd) -ENDIF -IF (ALLOCATED(Wng_MiscVarTypeData%BN_Cm)) THEN - DEALLOCATE(Wng_MiscVarTypeData%BN_Cm) -ENDIF -IF (ALLOCATED(Wng_MiscVarTypeData%BN_Cx)) THEN - DEALLOCATE(Wng_MiscVarTypeData%BN_Cx) -ENDIF -IF (ALLOCATED(Wng_MiscVarTypeData%BN_Cy)) THEN - DEALLOCATE(Wng_MiscVarTypeData%BN_Cy) -ENDIF - END SUBROUTINE FVW_DestroyWng_MiscVarType - - SUBROUTINE FVW_PackWng_MiscVarType( 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(Wng_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 = 'FVW_PackWng_MiscVarType' - ! 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 ! LE allocated yes/no - IF ( ALLOCATED(InData%LE) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! LE upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%LE) ! LE - END IF - Int_BufSz = Int_BufSz + 1 ! TE allocated yes/no - IF ( ALLOCATED(InData%TE) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! TE upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TE) ! TE - END IF - Int_BufSz = Int_BufSz + 1 ! r_LL allocated yes/no - IF ( ALLOCATED(InData%r_LL) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! r_LL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%r_LL) ! r_LL - END IF - Int_BufSz = Int_BufSz + 1 ! CP allocated yes/no - IF ( ALLOCATED(InData%CP) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! CP upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CP) ! CP - END IF - Int_BufSz = Int_BufSz + 1 ! Tang allocated yes/no - IF ( ALLOCATED(InData%Tang) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Tang upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Tang) ! Tang - END IF - Int_BufSz = Int_BufSz + 1 ! Norm allocated yes/no - IF ( ALLOCATED(InData%Norm) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Norm upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Norm) ! Norm - END IF - Int_BufSz = Int_BufSz + 1 ! Orth allocated yes/no - IF ( ALLOCATED(InData%Orth) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Orth upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Orth) ! Orth - END IF - Int_BufSz = Int_BufSz + 1 ! dl allocated yes/no - IF ( ALLOCATED(InData%dl) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! dl upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%dl) ! dl - END IF - Int_BufSz = Int_BufSz + 1 ! Area allocated yes/no - IF ( ALLOCATED(InData%Area) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Area upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Area) ! Area - END IF - Int_BufSz = Int_BufSz + 1 ! diag_LL allocated yes/no - IF ( ALLOCATED(InData%diag_LL) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! diag_LL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%diag_LL) ! diag_LL - END IF - Int_BufSz = Int_BufSz + 1 ! Vind_CP allocated yes/no - IF ( ALLOCATED(InData%Vind_CP) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Vind_CP upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vind_CP) ! Vind_CP - END IF - Int_BufSz = Int_BufSz + 1 ! Vtot_CP allocated yes/no - IF ( ALLOCATED(InData%Vtot_CP) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Vtot_CP upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vtot_CP) ! Vtot_CP - END IF - Int_BufSz = Int_BufSz + 1 ! Vstr_CP allocated yes/no - IF ( ALLOCATED(InData%Vstr_CP) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Vstr_CP upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vstr_CP) ! Vstr_CP - END IF - Int_BufSz = Int_BufSz + 1 ! Vwnd_CP allocated yes/no - IF ( ALLOCATED(InData%Vwnd_CP) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Vwnd_CP upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vwnd_CP) ! Vwnd_CP - END IF - Int_BufSz = Int_BufSz + 1 ! Vwnd_NW allocated yes/no - IF ( ALLOCATED(InData%Vwnd_NW) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Vwnd_NW upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vwnd_NW) ! Vwnd_NW - END IF - Int_BufSz = Int_BufSz + 1 ! Vwnd_FW allocated yes/no - IF ( ALLOCATED(InData%Vwnd_FW) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Vwnd_FW upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vwnd_FW) ! Vwnd_FW - END IF - Int_BufSz = Int_BufSz + 1 ! Vind_NW allocated yes/no - IF ( ALLOCATED(InData%Vind_NW) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Vind_NW upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vind_NW) ! Vind_NW - END IF - Int_BufSz = Int_BufSz + 1 ! Vind_FW allocated yes/no - IF ( ALLOCATED(InData%Vind_FW) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Vind_FW upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vind_FW) ! Vind_FW - END IF - Int_BufSz = Int_BufSz + 1 ! PitchAndTwist allocated yes/no - IF ( ALLOCATED(InData%PitchAndTwist) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PitchAndTwist upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PitchAndTwist) ! PitchAndTwist - END IF - Int_BufSz = Int_BufSz + 1 ! iTip - Int_BufSz = Int_BufSz + 1 ! iRoot - Int_BufSz = Int_BufSz + 1 ! alpha_LL allocated yes/no - IF ( ALLOCATED(InData%alpha_LL) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! alpha_LL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%alpha_LL) ! alpha_LL - END IF - Int_BufSz = Int_BufSz + 1 ! Vreln_LL allocated yes/no - IF ( ALLOCATED(InData%Vreln_LL) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Vreln_LL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vreln_LL) ! Vreln_LL - END IF - Int_BufSz = Int_BufSz + 1 ! u_UA allocated yes/no - IF ( ALLOCATED(InData%u_UA) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! u_UA upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i2 = LBOUND(InData%u_UA,2), UBOUND(InData%u_UA,2) - DO i1 = LBOUND(InData%u_UA,1), UBOUND(InData%u_UA,1) - Int_BufSz = Int_BufSz + 3 ! u_UA: size of buffers for each call to pack subtype - CALL UA_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_UA(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! u_UA - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_UA - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_UA - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_UA - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! m_UA: size of buffers for each call to pack subtype - CALL UA_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m_UA, ErrStat2, ErrMsg2, .TRUE. ) ! m_UA - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! m_UA - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! m_UA - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! m_UA - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! y_UA: size of buffers for each call to pack subtype - CALL UA_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_UA, ErrStat2, ErrMsg2, .TRUE. ) ! y_UA - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y_UA - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y_UA - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y_UA - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! p_UA: size of buffers for each call to pack subtype - CALL UA_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p_UA, ErrStat2, ErrMsg2, .TRUE. ) ! p_UA - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! p_UA - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! p_UA - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! p_UA - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! Vind_LL allocated yes/no - IF ( ALLOCATED(InData%Vind_LL) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Vind_LL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vind_LL) ! Vind_LL - END IF - Int_BufSz = Int_BufSz + 1 ! BN_AxInd allocated yes/no - IF ( ALLOCATED(InData%BN_AxInd) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BN_AxInd upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BN_AxInd) ! BN_AxInd - END IF - Int_BufSz = Int_BufSz + 1 ! BN_TanInd allocated yes/no - IF ( ALLOCATED(InData%BN_TanInd) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BN_TanInd upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BN_TanInd) ! BN_TanInd - END IF - Int_BufSz = Int_BufSz + 1 ! BN_Vrel allocated yes/no - IF ( ALLOCATED(InData%BN_Vrel) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BN_Vrel upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BN_Vrel) ! BN_Vrel - END IF - Int_BufSz = Int_BufSz + 1 ! BN_alpha allocated yes/no - IF ( ALLOCATED(InData%BN_alpha) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BN_alpha upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BN_alpha) ! BN_alpha - END IF - Int_BufSz = Int_BufSz + 1 ! BN_phi allocated yes/no - IF ( ALLOCATED(InData%BN_phi) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BN_phi upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BN_phi) ! BN_phi - END IF - Int_BufSz = Int_BufSz + 1 ! BN_Re allocated yes/no - IF ( ALLOCATED(InData%BN_Re) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BN_Re upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BN_Re) ! BN_Re - END IF - Int_BufSz = Int_BufSz + 1 ! BN_URelWind_s allocated yes/no - IF ( ALLOCATED(InData%BN_URelWind_s) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BN_URelWind_s upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BN_URelWind_s) ! BN_URelWind_s - END IF - Int_BufSz = Int_BufSz + 1 ! BN_Cl_Static allocated yes/no - IF ( ALLOCATED(InData%BN_Cl_Static) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BN_Cl_Static upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BN_Cl_Static) ! BN_Cl_Static - END IF - Int_BufSz = Int_BufSz + 1 ! BN_Cd_Static allocated yes/no - IF ( ALLOCATED(InData%BN_Cd_Static) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BN_Cd_Static upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BN_Cd_Static) ! BN_Cd_Static - END IF - Int_BufSz = Int_BufSz + 1 ! BN_Cm_Static allocated yes/no - IF ( ALLOCATED(InData%BN_Cm_Static) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BN_Cm_Static upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BN_Cm_Static) ! BN_Cm_Static - END IF - Int_BufSz = Int_BufSz + 1 ! BN_Cpmin allocated yes/no - IF ( ALLOCATED(InData%BN_Cpmin) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BN_Cpmin upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BN_Cpmin) ! BN_Cpmin - END IF - Int_BufSz = Int_BufSz + 1 ! BN_Cl allocated yes/no - IF ( ALLOCATED(InData%BN_Cl) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BN_Cl upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BN_Cl) ! BN_Cl - END IF - Int_BufSz = Int_BufSz + 1 ! BN_Cd allocated yes/no - IF ( ALLOCATED(InData%BN_Cd) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BN_Cd upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BN_Cd) ! BN_Cd - END IF - Int_BufSz = Int_BufSz + 1 ! BN_Cm allocated yes/no - IF ( ALLOCATED(InData%BN_Cm) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BN_Cm upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BN_Cm) ! BN_Cm - END IF - Int_BufSz = Int_BufSz + 1 ! BN_Cx allocated yes/no - IF ( ALLOCATED(InData%BN_Cx) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BN_Cx upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BN_Cx) ! BN_Cx - END IF - Int_BufSz = Int_BufSz + 1 ! BN_Cy allocated yes/no - IF ( ALLOCATED(InData%BN_Cy) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BN_Cy upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BN_Cy) ! BN_Cy - 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%LE) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LE,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LE,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LE,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LE,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%LE,2), UBOUND(InData%LE,2) - DO i1 = LBOUND(InData%LE,1), UBOUND(InData%LE,1) - ReKiBuf(Re_Xferred) = InData%LE(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TE) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TE,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TE,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TE,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TE,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%TE,2), UBOUND(InData%TE,2) - DO i1 = LBOUND(InData%TE,1), UBOUND(InData%TE,1) - ReKiBuf(Re_Xferred) = InData%TE(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%r_LL) ) THEN - 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_LL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%r_LL,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%r_LL,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%r_LL,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%r_LL,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%r_LL,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%r_LL,3), UBOUND(InData%r_LL,3) - DO i2 = LBOUND(InData%r_LL,2), UBOUND(InData%r_LL,2) - DO i1 = LBOUND(InData%r_LL,1), UBOUND(InData%r_LL,1) - ReKiBuf(Re_Xferred) = InData%r_LL(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CP) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CP,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CP,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CP,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%CP,2), UBOUND(InData%CP,2) - DO i1 = LBOUND(InData%CP,1), UBOUND(InData%CP,1) - ReKiBuf(Re_Xferred) = InData%CP(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Tang) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Tang,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Tang,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Tang,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Tang,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Tang,2), UBOUND(InData%Tang,2) - DO i1 = LBOUND(InData%Tang,1), UBOUND(InData%Tang,1) - ReKiBuf(Re_Xferred) = InData%Tang(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Norm) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Norm,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Norm,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Norm,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Norm,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Norm,2), UBOUND(InData%Norm,2) - DO i1 = LBOUND(InData%Norm,1), UBOUND(InData%Norm,1) - ReKiBuf(Re_Xferred) = InData%Norm(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Orth) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Orth,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Orth,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Orth,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Orth,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Orth,2), UBOUND(InData%Orth,2) - DO i1 = LBOUND(InData%Orth,1), UBOUND(InData%Orth,1) - ReKiBuf(Re_Xferred) = InData%Orth(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%dl) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%dl,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dl,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%dl,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dl,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%dl,2), UBOUND(InData%dl,2) - DO i1 = LBOUND(InData%dl,1), UBOUND(InData%dl,1) - ReKiBuf(Re_Xferred) = InData%dl(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Area) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Area,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Area,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Area,1), UBOUND(InData%Area,1) - ReKiBuf(Re_Xferred) = InData%Area(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%diag_LL) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%diag_LL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%diag_LL,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%diag_LL,1), UBOUND(InData%diag_LL,1) - ReKiBuf(Re_Xferred) = InData%diag_LL(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Vind_CP) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vind_CP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vind_CP,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vind_CP,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vind_CP,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Vind_CP,2), UBOUND(InData%Vind_CP,2) - DO i1 = LBOUND(InData%Vind_CP,1), UBOUND(InData%Vind_CP,1) - ReKiBuf(Re_Xferred) = InData%Vind_CP(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Vtot_CP) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vtot_CP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vtot_CP,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vtot_CP,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vtot_CP,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Vtot_CP,2), UBOUND(InData%Vtot_CP,2) - DO i1 = LBOUND(InData%Vtot_CP,1), UBOUND(InData%Vtot_CP,1) - ReKiBuf(Re_Xferred) = InData%Vtot_CP(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Vstr_CP) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vstr_CP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vstr_CP,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vstr_CP,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vstr_CP,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Vstr_CP,2), UBOUND(InData%Vstr_CP,2) - DO i1 = LBOUND(InData%Vstr_CP,1), UBOUND(InData%Vstr_CP,1) - ReKiBuf(Re_Xferred) = InData%Vstr_CP(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Vwnd_CP) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vwnd_CP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vwnd_CP,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vwnd_CP,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vwnd_CP,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Vwnd_CP,2), UBOUND(InData%Vwnd_CP,2) - DO i1 = LBOUND(InData%Vwnd_CP,1), UBOUND(InData%Vwnd_CP,1) - ReKiBuf(Re_Xferred) = InData%Vwnd_CP(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Vwnd_NW) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vwnd_NW,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vwnd_NW,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vwnd_NW,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vwnd_NW,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vwnd_NW,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vwnd_NW,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Vwnd_NW,3), UBOUND(InData%Vwnd_NW,3) - DO i2 = LBOUND(InData%Vwnd_NW,2), UBOUND(InData%Vwnd_NW,2) - DO i1 = LBOUND(InData%Vwnd_NW,1), UBOUND(InData%Vwnd_NW,1) - ReKiBuf(Re_Xferred) = InData%Vwnd_NW(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Vwnd_FW) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vwnd_FW,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vwnd_FW,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vwnd_FW,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vwnd_FW,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vwnd_FW,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vwnd_FW,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Vwnd_FW,3), UBOUND(InData%Vwnd_FW,3) - DO i2 = LBOUND(InData%Vwnd_FW,2), UBOUND(InData%Vwnd_FW,2) - DO i1 = LBOUND(InData%Vwnd_FW,1), UBOUND(InData%Vwnd_FW,1) - ReKiBuf(Re_Xferred) = InData%Vwnd_FW(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Vind_NW) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vind_NW,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vind_NW,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vind_NW,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vind_NW,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vind_NW,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vind_NW,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Vind_NW,3), UBOUND(InData%Vind_NW,3) - DO i2 = LBOUND(InData%Vind_NW,2), UBOUND(InData%Vind_NW,2) - DO i1 = LBOUND(InData%Vind_NW,1), UBOUND(InData%Vind_NW,1) - ReKiBuf(Re_Xferred) = InData%Vind_NW(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Vind_FW) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vind_FW,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vind_FW,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vind_FW,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vind_FW,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vind_FW,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vind_FW,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Vind_FW,3), UBOUND(InData%Vind_FW,3) - DO i2 = LBOUND(InData%Vind_FW,2), UBOUND(InData%Vind_FW,2) - DO i1 = LBOUND(InData%Vind_FW,1), UBOUND(InData%Vind_FW,1) - ReKiBuf(Re_Xferred) = InData%Vind_FW(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PitchAndTwist) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PitchAndTwist,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PitchAndTwist,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PitchAndTwist,1), UBOUND(InData%PitchAndTwist,1) - ReKiBuf(Re_Xferred) = InData%PitchAndTwist(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%iTip - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%iRoot - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%alpha_LL) ) THEN - 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_LL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%alpha_LL,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%alpha_LL,1), UBOUND(InData%alpha_LL,1) - ReKiBuf(Re_Xferred) = InData%alpha_LL(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Vreln_LL) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vreln_LL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vreln_LL,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Vreln_LL,1), UBOUND(InData%Vreln_LL,1) - ReKiBuf(Re_Xferred) = InData%Vreln_LL(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%u_UA) ) THEN - 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_UA,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_UA,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%u_UA,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_UA,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%u_UA,2), UBOUND(InData%u_UA,2) - DO i1 = LBOUND(InData%u_UA,1), UBOUND(InData%u_UA,1) - CALL UA_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_UA(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! u_UA - 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 DO - END IF - CALL UA_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m_UA, ErrStat2, ErrMsg2, OnlySize ) ! m_UA - 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 UA_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_UA, ErrStat2, ErrMsg2, OnlySize ) ! y_UA - 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 UA_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p_UA, ErrStat2, ErrMsg2, OnlySize ) ! p_UA - 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%Vind_LL) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vind_LL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vind_LL,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vind_LL,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vind_LL,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Vind_LL,2), UBOUND(InData%Vind_LL,2) - DO i1 = LBOUND(InData%Vind_LL,1), UBOUND(InData%Vind_LL,1) - ReKiBuf(Re_Xferred) = InData%Vind_LL(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BN_AxInd) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BN_AxInd,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_AxInd,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BN_AxInd,1), UBOUND(InData%BN_AxInd,1) - ReKiBuf(Re_Xferred) = InData%BN_AxInd(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BN_TanInd) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BN_TanInd,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_TanInd,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BN_TanInd,1), UBOUND(InData%BN_TanInd,1) - ReKiBuf(Re_Xferred) = InData%BN_TanInd(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BN_Vrel) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BN_Vrel,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_Vrel,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BN_Vrel,1), UBOUND(InData%BN_Vrel,1) - ReKiBuf(Re_Xferred) = InData%BN_Vrel(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BN_alpha) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BN_alpha,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_alpha,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BN_alpha,1), UBOUND(InData%BN_alpha,1) - ReKiBuf(Re_Xferred) = InData%BN_alpha(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BN_phi) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BN_phi,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_phi,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BN_phi,1), UBOUND(InData%BN_phi,1) - ReKiBuf(Re_Xferred) = InData%BN_phi(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BN_Re) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BN_Re,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_Re,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BN_Re,1), UBOUND(InData%BN_Re,1) - ReKiBuf(Re_Xferred) = InData%BN_Re(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BN_URelWind_s) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BN_URelWind_s,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_URelWind_s,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BN_URelWind_s,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_URelWind_s,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%BN_URelWind_s,2), UBOUND(InData%BN_URelWind_s,2) - DO i1 = LBOUND(InData%BN_URelWind_s,1), UBOUND(InData%BN_URelWind_s,1) - ReKiBuf(Re_Xferred) = InData%BN_URelWind_s(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BN_Cl_Static) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BN_Cl_Static,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_Cl_Static,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BN_Cl_Static,1), UBOUND(InData%BN_Cl_Static,1) - ReKiBuf(Re_Xferred) = InData%BN_Cl_Static(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BN_Cd_Static) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BN_Cd_Static,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_Cd_Static,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BN_Cd_Static,1), UBOUND(InData%BN_Cd_Static,1) - ReKiBuf(Re_Xferred) = InData%BN_Cd_Static(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BN_Cm_Static) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BN_Cm_Static,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_Cm_Static,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BN_Cm_Static,1), UBOUND(InData%BN_Cm_Static,1) - ReKiBuf(Re_Xferred) = InData%BN_Cm_Static(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BN_Cpmin) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BN_Cpmin,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_Cpmin,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BN_Cpmin,1), UBOUND(InData%BN_Cpmin,1) - ReKiBuf(Re_Xferred) = InData%BN_Cpmin(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BN_Cl) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BN_Cl,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_Cl,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BN_Cl,1), UBOUND(InData%BN_Cl,1) - ReKiBuf(Re_Xferred) = InData%BN_Cl(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BN_Cd) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BN_Cd,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_Cd,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BN_Cd,1), UBOUND(InData%BN_Cd,1) - ReKiBuf(Re_Xferred) = InData%BN_Cd(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BN_Cm) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BN_Cm,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_Cm,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BN_Cm,1), UBOUND(InData%BN_Cm,1) - ReKiBuf(Re_Xferred) = InData%BN_Cm(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BN_Cx) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BN_Cx,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_Cx,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BN_Cx,1), UBOUND(InData%BN_Cx,1) - ReKiBuf(Re_Xferred) = InData%BN_Cx(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BN_Cy) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BN_Cy,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_Cy,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BN_Cy,1), UBOUND(InData%BN_Cy,1) - ReKiBuf(Re_Xferred) = InData%BN_Cy(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE FVW_PackWng_MiscVarType - - SUBROUTINE FVW_UnPackWng_MiscVarType( 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(Wng_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) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_UnPackWng_MiscVarType' - ! 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 ! LE not allocated - Int_Xferred = Int_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%LE)) DEALLOCATE(OutData%LE) - ALLOCATE(OutData%LE(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%LE,2), UBOUND(OutData%LE,2) - DO i1 = LBOUND(OutData%LE,1), UBOUND(OutData%LE,1) - OutData%LE(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TE not allocated - Int_Xferred = Int_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%TE)) DEALLOCATE(OutData%TE) - ALLOCATE(OutData%TE(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%TE,2), UBOUND(OutData%TE,2) - DO i1 = LBOUND(OutData%TE,1), UBOUND(OutData%TE,1) - OutData%TE(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! r_LL not allocated - Int_Xferred = Int_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%r_LL)) DEALLOCATE(OutData%r_LL) - ALLOCATE(OutData%r_LL(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%r_LL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%r_LL,3), UBOUND(OutData%r_LL,3) - DO i2 = LBOUND(OutData%r_LL,2), UBOUND(OutData%r_LL,2) - DO i1 = LBOUND(OutData%r_LL,1), UBOUND(OutData%r_LL,1) - OutData%r_LL(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 ! CP not allocated - Int_Xferred = Int_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%CP)) DEALLOCATE(OutData%CP) - ALLOCATE(OutData%CP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%CP,2), UBOUND(OutData%CP,2) - DO i1 = LBOUND(OutData%CP,1), UBOUND(OutData%CP,1) - OutData%CP(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Tang not allocated - Int_Xferred = Int_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%Tang)) DEALLOCATE(OutData%Tang) - ALLOCATE(OutData%Tang(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Tang.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Tang,2), UBOUND(OutData%Tang,2) - DO i1 = LBOUND(OutData%Tang,1), UBOUND(OutData%Tang,1) - OutData%Tang(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Norm not allocated - Int_Xferred = Int_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%Norm)) DEALLOCATE(OutData%Norm) - ALLOCATE(OutData%Norm(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Norm.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Norm,2), UBOUND(OutData%Norm,2) - DO i1 = LBOUND(OutData%Norm,1), UBOUND(OutData%Norm,1) - OutData%Norm(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Orth not allocated - Int_Xferred = Int_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%Orth)) DEALLOCATE(OutData%Orth) - ALLOCATE(OutData%Orth(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Orth.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Orth,2), UBOUND(OutData%Orth,2) - DO i1 = LBOUND(OutData%Orth,1), UBOUND(OutData%Orth,1) - OutData%Orth(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! dl not allocated - Int_Xferred = Int_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%dl)) DEALLOCATE(OutData%dl) - ALLOCATE(OutData%dl(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%dl.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%dl,2), UBOUND(OutData%dl,2) - DO i1 = LBOUND(OutData%dl,1), UBOUND(OutData%dl,1) - OutData%dl(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Area not allocated - Int_Xferred = Int_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%Area)) DEALLOCATE(OutData%Area) - ALLOCATE(OutData%Area(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Area.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Area,1), UBOUND(OutData%Area,1) - OutData%Area(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! diag_LL not allocated - Int_Xferred = Int_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%diag_LL)) DEALLOCATE(OutData%diag_LL) - ALLOCATE(OutData%diag_LL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%diag_LL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%diag_LL,1), UBOUND(OutData%diag_LL,1) - OutData%diag_LL(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vind_CP not allocated - Int_Xferred = Int_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%Vind_CP)) DEALLOCATE(OutData%Vind_CP) - ALLOCATE(OutData%Vind_CP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vind_CP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Vind_CP,2), UBOUND(OutData%Vind_CP,2) - DO i1 = LBOUND(OutData%Vind_CP,1), UBOUND(OutData%Vind_CP,1) - OutData%Vind_CP(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vtot_CP not allocated - Int_Xferred = Int_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%Vtot_CP)) DEALLOCATE(OutData%Vtot_CP) - ALLOCATE(OutData%Vtot_CP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vtot_CP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Vtot_CP,2), UBOUND(OutData%Vtot_CP,2) - DO i1 = LBOUND(OutData%Vtot_CP,1), UBOUND(OutData%Vtot_CP,1) - OutData%Vtot_CP(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vstr_CP not allocated - Int_Xferred = Int_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%Vstr_CP)) DEALLOCATE(OutData%Vstr_CP) - ALLOCATE(OutData%Vstr_CP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vstr_CP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Vstr_CP,2), UBOUND(OutData%Vstr_CP,2) - DO i1 = LBOUND(OutData%Vstr_CP,1), UBOUND(OutData%Vstr_CP,1) - OutData%Vstr_CP(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vwnd_CP not allocated - Int_Xferred = Int_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%Vwnd_CP)) DEALLOCATE(OutData%Vwnd_CP) - ALLOCATE(OutData%Vwnd_CP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vwnd_CP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Vwnd_CP,2), UBOUND(OutData%Vwnd_CP,2) - DO i1 = LBOUND(OutData%Vwnd_CP,1), UBOUND(OutData%Vwnd_CP,1) - OutData%Vwnd_CP(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vwnd_NW not allocated - Int_Xferred = Int_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%Vwnd_NW)) DEALLOCATE(OutData%Vwnd_NW) - ALLOCATE(OutData%Vwnd_NW(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%Vwnd_NW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Vwnd_NW,3), UBOUND(OutData%Vwnd_NW,3) - DO i2 = LBOUND(OutData%Vwnd_NW,2), UBOUND(OutData%Vwnd_NW,2) - DO i1 = LBOUND(OutData%Vwnd_NW,1), UBOUND(OutData%Vwnd_NW,1) - OutData%Vwnd_NW(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 ! Vwnd_FW not allocated - Int_Xferred = Int_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%Vwnd_FW)) DEALLOCATE(OutData%Vwnd_FW) - ALLOCATE(OutData%Vwnd_FW(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%Vwnd_FW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Vwnd_FW,3), UBOUND(OutData%Vwnd_FW,3) - DO i2 = LBOUND(OutData%Vwnd_FW,2), UBOUND(OutData%Vwnd_FW,2) - DO i1 = LBOUND(OutData%Vwnd_FW,1), UBOUND(OutData%Vwnd_FW,1) - OutData%Vwnd_FW(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 ! Vind_NW not allocated - Int_Xferred = Int_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%Vind_NW)) DEALLOCATE(OutData%Vind_NW) - ALLOCATE(OutData%Vind_NW(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%Vind_NW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Vind_NW,3), UBOUND(OutData%Vind_NW,3) - DO i2 = LBOUND(OutData%Vind_NW,2), UBOUND(OutData%Vind_NW,2) - DO i1 = LBOUND(OutData%Vind_NW,1), UBOUND(OutData%Vind_NW,1) - OutData%Vind_NW(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 ! Vind_FW not allocated - Int_Xferred = Int_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%Vind_FW)) DEALLOCATE(OutData%Vind_FW) - ALLOCATE(OutData%Vind_FW(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%Vind_FW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Vind_FW,3), UBOUND(OutData%Vind_FW,3) - DO i2 = LBOUND(OutData%Vind_FW,2), UBOUND(OutData%Vind_FW,2) - DO i1 = LBOUND(OutData%Vind_FW,1), UBOUND(OutData%Vind_FW,1) - OutData%Vind_FW(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 ! PitchAndTwist not allocated - Int_Xferred = Int_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%PitchAndTwist)) DEALLOCATE(OutData%PitchAndTwist) - ALLOCATE(OutData%PitchAndTwist(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PitchAndTwist.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PitchAndTwist,1), UBOUND(OutData%PitchAndTwist,1) - OutData%PitchAndTwist(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%iTip = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%iRoot = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! alpha_LL not allocated - Int_Xferred = Int_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%alpha_LL)) DEALLOCATE(OutData%alpha_LL) - ALLOCATE(OutData%alpha_LL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%alpha_LL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%alpha_LL,1), UBOUND(OutData%alpha_LL,1) - OutData%alpha_LL(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vreln_LL not allocated - Int_Xferred = Int_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%Vreln_LL)) DEALLOCATE(OutData%Vreln_LL) - ALLOCATE(OutData%Vreln_LL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vreln_LL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Vreln_LL,1), UBOUND(OutData%Vreln_LL,1) - OutData%Vreln_LL(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! u_UA not allocated - Int_Xferred = Int_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%u_UA)) DEALLOCATE(OutData%u_UA) - ALLOCATE(OutData%u_UA(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_UA.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%u_UA,2), UBOUND(OutData%u_UA,2) - DO i1 = LBOUND(OutData%u_UA,1), UBOUND(OutData%u_UA,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 UA_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u_UA(i1,i2), ErrStat2, ErrMsg2 ) ! u_UA - 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 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 UA_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m_UA, ErrStat2, ErrMsg2 ) ! m_UA - 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 UA_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y_UA, ErrStat2, ErrMsg2 ) ! y_UA - 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 UA_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p_UA, ErrStat2, ErrMsg2 ) ! p_UA - 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 ! Vind_LL not allocated - Int_Xferred = Int_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%Vind_LL)) DEALLOCATE(OutData%Vind_LL) - ALLOCATE(OutData%Vind_LL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vind_LL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Vind_LL,2), UBOUND(OutData%Vind_LL,2) - DO i1 = LBOUND(OutData%Vind_LL,1), UBOUND(OutData%Vind_LL,1) - OutData%Vind_LL(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BN_AxInd not allocated - Int_Xferred = Int_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%BN_AxInd)) DEALLOCATE(OutData%BN_AxInd) - ALLOCATE(OutData%BN_AxInd(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_AxInd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BN_AxInd,1), UBOUND(OutData%BN_AxInd,1) - OutData%BN_AxInd(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BN_TanInd not allocated - Int_Xferred = Int_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%BN_TanInd)) DEALLOCATE(OutData%BN_TanInd) - ALLOCATE(OutData%BN_TanInd(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_TanInd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BN_TanInd,1), UBOUND(OutData%BN_TanInd,1) - OutData%BN_TanInd(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BN_Vrel not allocated - Int_Xferred = Int_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%BN_Vrel)) DEALLOCATE(OutData%BN_Vrel) - ALLOCATE(OutData%BN_Vrel(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_Vrel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BN_Vrel,1), UBOUND(OutData%BN_Vrel,1) - OutData%BN_Vrel(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BN_alpha not allocated - Int_Xferred = Int_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%BN_alpha)) DEALLOCATE(OutData%BN_alpha) - ALLOCATE(OutData%BN_alpha(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_alpha.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BN_alpha,1), UBOUND(OutData%BN_alpha,1) - OutData%BN_alpha(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BN_phi not allocated - Int_Xferred = Int_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%BN_phi)) DEALLOCATE(OutData%BN_phi) - ALLOCATE(OutData%BN_phi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_phi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BN_phi,1), UBOUND(OutData%BN_phi,1) - OutData%BN_phi(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BN_Re not allocated - Int_Xferred = Int_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%BN_Re)) DEALLOCATE(OutData%BN_Re) - ALLOCATE(OutData%BN_Re(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_Re.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BN_Re,1), UBOUND(OutData%BN_Re,1) - OutData%BN_Re(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BN_URelWind_s not allocated - Int_Xferred = Int_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%BN_URelWind_s)) DEALLOCATE(OutData%BN_URelWind_s) - ALLOCATE(OutData%BN_URelWind_s(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_URelWind_s.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%BN_URelWind_s,2), UBOUND(OutData%BN_URelWind_s,2) - DO i1 = LBOUND(OutData%BN_URelWind_s,1), UBOUND(OutData%BN_URelWind_s,1) - OutData%BN_URelWind_s(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BN_Cl_Static not allocated - Int_Xferred = Int_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%BN_Cl_Static)) DEALLOCATE(OutData%BN_Cl_Static) - ALLOCATE(OutData%BN_Cl_Static(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_Cl_Static.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BN_Cl_Static,1), UBOUND(OutData%BN_Cl_Static,1) - OutData%BN_Cl_Static(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BN_Cd_Static not allocated - Int_Xferred = Int_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%BN_Cd_Static)) DEALLOCATE(OutData%BN_Cd_Static) - ALLOCATE(OutData%BN_Cd_Static(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_Cd_Static.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BN_Cd_Static,1), UBOUND(OutData%BN_Cd_Static,1) - OutData%BN_Cd_Static(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BN_Cm_Static not allocated - Int_Xferred = Int_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%BN_Cm_Static)) DEALLOCATE(OutData%BN_Cm_Static) - ALLOCATE(OutData%BN_Cm_Static(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_Cm_Static.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BN_Cm_Static,1), UBOUND(OutData%BN_Cm_Static,1) - OutData%BN_Cm_Static(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BN_Cpmin not allocated - Int_Xferred = Int_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%BN_Cpmin)) DEALLOCATE(OutData%BN_Cpmin) - ALLOCATE(OutData%BN_Cpmin(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_Cpmin.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BN_Cpmin,1), UBOUND(OutData%BN_Cpmin,1) - OutData%BN_Cpmin(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BN_Cl not allocated - Int_Xferred = Int_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%BN_Cl)) DEALLOCATE(OutData%BN_Cl) - ALLOCATE(OutData%BN_Cl(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_Cl.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BN_Cl,1), UBOUND(OutData%BN_Cl,1) - OutData%BN_Cl(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BN_Cd not allocated - Int_Xferred = Int_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%BN_Cd)) DEALLOCATE(OutData%BN_Cd) - ALLOCATE(OutData%BN_Cd(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_Cd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BN_Cd,1), UBOUND(OutData%BN_Cd,1) - OutData%BN_Cd(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BN_Cm not allocated - Int_Xferred = Int_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%BN_Cm)) DEALLOCATE(OutData%BN_Cm) - ALLOCATE(OutData%BN_Cm(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_Cm.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BN_Cm,1), UBOUND(OutData%BN_Cm,1) - OutData%BN_Cm(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BN_Cx not allocated - Int_Xferred = Int_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%BN_Cx)) DEALLOCATE(OutData%BN_Cx) - ALLOCATE(OutData%BN_Cx(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_Cx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BN_Cx,1), UBOUND(OutData%BN_Cx,1) - OutData%BN_Cx(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BN_Cy not allocated - Int_Xferred = Int_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%BN_Cy)) DEALLOCATE(OutData%BN_Cy) - ALLOCATE(OutData%BN_Cy(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_Cy.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BN_Cy,1), UBOUND(OutData%BN_Cy,1) - OutData%BN_Cy(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE FVW_UnPackWng_MiscVarType - - SUBROUTINE FVW_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FVW_MiscVarType), INTENT(IN) :: SrcMiscData - TYPE(FVW_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 = 'FVW_CopyMisc' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcMiscData%W)) THEN - i1_l = LBOUND(SrcMiscData%W,1) - i1_u = UBOUND(SrcMiscData%W,1) - IF (.NOT. ALLOCATED(DstMiscData%W)) THEN - ALLOCATE(DstMiscData%W(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%W.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%W,1), UBOUND(SrcMiscData%W,1) - CALL FVW_Copywng_miscvartype( SrcMiscData%W(i1), DstMiscData%W(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - DstMiscData%FirstCall = SrcMiscData%FirstCall - DstMiscData%nNW = SrcMiscData%nNW - DstMiscData%nFW = SrcMiscData%nFW - DstMiscData%iStep = SrcMiscData%iStep - DstMiscData%VTKstep = SrcMiscData%VTKstep - DstMiscData%VTKlastTime = SrcMiscData%VTKlastTime -IF (ALLOCATED(SrcMiscData%r_wind)) THEN - i1_l = LBOUND(SrcMiscData%r_wind,1) - i1_u = UBOUND(SrcMiscData%r_wind,1) - i2_l = LBOUND(SrcMiscData%r_wind,2) - i2_u = UBOUND(SrcMiscData%r_wind,2) - IF (.NOT. ALLOCATED(DstMiscData%r_wind)) THEN - ALLOCATE(DstMiscData%r_wind(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%r_wind.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%r_wind = SrcMiscData%r_wind -ENDIF - DstMiscData%ComputeWakeInduced = SrcMiscData%ComputeWakeInduced - DstMiscData%OldWakeTime = SrcMiscData%OldWakeTime - CALL FVW_CopyContState( SrcMiscData%dxdt, DstMiscData%dxdt, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL FVW_CopyContState( SrcMiscData%x1, DstMiscData%x1, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL FVW_CopyContState( SrcMiscData%x2, DstMiscData%x2, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstMiscData%t1 = SrcMiscData%t1 - DstMiscData%t2 = SrcMiscData%t2 - DstMiscData%UA_Flag = SrcMiscData%UA_Flag - CALL FVW_Copyt_sgmt( SrcMiscData%Sgmt, DstMiscData%Sgmt, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL FVW_Copyt_part( SrcMiscData%Part, DstMiscData%Part, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcMiscData%CPs)) THEN - i1_l = LBOUND(SrcMiscData%CPs,1) - i1_u = UBOUND(SrcMiscData%CPs,1) - i2_l = LBOUND(SrcMiscData%CPs,2) - i2_u = UBOUND(SrcMiscData%CPs,2) - IF (.NOT. ALLOCATED(DstMiscData%CPs)) THEN - ALLOCATE(DstMiscData%CPs(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%CPs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%CPs = SrcMiscData%CPs -ENDIF -IF (ALLOCATED(SrcMiscData%Uind)) THEN - i1_l = LBOUND(SrcMiscData%Uind,1) - i1_u = UBOUND(SrcMiscData%Uind,1) - i2_l = LBOUND(SrcMiscData%Uind,2) - i2_u = UBOUND(SrcMiscData%Uind,2) - IF (.NOT. ALLOCATED(DstMiscData%Uind)) THEN - ALLOCATE(DstMiscData%Uind(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Uind.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%Uind = SrcMiscData%Uind -ENDIF -IF (ALLOCATED(SrcMiscData%GridOutputs)) THEN - i1_l = LBOUND(SrcMiscData%GridOutputs,1) - i1_u = UBOUND(SrcMiscData%GridOutputs,1) - IF (.NOT. ALLOCATED(DstMiscData%GridOutputs)) THEN - ALLOCATE(DstMiscData%GridOutputs(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%GridOutputs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%GridOutputs,1), UBOUND(SrcMiscData%GridOutputs,1) - CALL FVW_Copygridouttype( SrcMiscData%GridOutputs(i1), DstMiscData%GridOutputs(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - END SUBROUTINE FVW_CopyMisc - - SUBROUTINE FVW_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(FVW_MiscVarType), INTENT(INOUT) :: MiscData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_DestroyMisc' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(MiscData%W)) THEN -DO i1 = LBOUND(MiscData%W,1), UBOUND(MiscData%W,1) - CALL FVW_Destroywng_miscvartype( MiscData%W(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MiscData%W) -ENDIF -IF (ALLOCATED(MiscData%r_wind)) THEN - DEALLOCATE(MiscData%r_wind) -ENDIF - CALL FVW_DestroyContState( MiscData%dxdt, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FVW_DestroyContState( MiscData%x1, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FVW_DestroyContState( MiscData%x2, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FVW_Destroyt_sgmt( MiscData%Sgmt, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FVW_Destroyt_part( MiscData%Part, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(MiscData%CPs)) THEN - DEALLOCATE(MiscData%CPs) -ENDIF -IF (ALLOCATED(MiscData%Uind)) THEN - DEALLOCATE(MiscData%Uind) -ENDIF -IF (ALLOCATED(MiscData%GridOutputs)) THEN -DO i1 = LBOUND(MiscData%GridOutputs,1), UBOUND(MiscData%GridOutputs,1) - CALL FVW_Destroygridouttype( MiscData%GridOutputs(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MiscData%GridOutputs) -ENDIF - END SUBROUTINE FVW_DestroyMisc - - SUBROUTINE FVW_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(FVW_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 = 'FVW_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 ! W allocated yes/no - IF ( ALLOCATED(InData%W) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! W upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%W,1), UBOUND(InData%W,1) - Int_BufSz = Int_BufSz + 3 ! W: size of buffers for each call to pack subtype - CALL FVW_Packwng_miscvartype( Re_Buf, Db_Buf, Int_Buf, InData%W(i1), ErrStat2, ErrMsg2, .TRUE. ) ! W - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! W - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! W - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! W - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! FirstCall - Int_BufSz = Int_BufSz + 1 ! nNW - Int_BufSz = Int_BufSz + 1 ! nFW - Int_BufSz = Int_BufSz + 1 ! iStep - Int_BufSz = Int_BufSz + 1 ! VTKstep - Db_BufSz = Db_BufSz + 1 ! VTKlastTime - Int_BufSz = Int_BufSz + 1 ! r_wind allocated yes/no - IF ( ALLOCATED(InData%r_wind) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! r_wind upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%r_wind) ! r_wind - END IF - Int_BufSz = Int_BufSz + 1 ! ComputeWakeInduced - Db_BufSz = Db_BufSz + 1 ! OldWakeTime - Int_BufSz = Int_BufSz + 3 ! dxdt: size of buffers for each call to pack subtype - CALL FVW_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%dxdt, ErrStat2, ErrMsg2, .TRUE. ) ! dxdt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! dxdt - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! dxdt - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! dxdt - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! x1: size of buffers for each call to pack subtype - CALL FVW_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x1, ErrStat2, ErrMsg2, .TRUE. ) ! x1 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x1 - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x1 - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x1 - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! x2: size of buffers for each call to pack subtype - CALL FVW_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x2, ErrStat2, ErrMsg2, .TRUE. ) ! x2 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x2 - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x2 - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x2 - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Db_BufSz = Db_BufSz + 1 ! t1 - Db_BufSz = Db_BufSz + 1 ! t2 - Int_BufSz = Int_BufSz + 1 ! UA_Flag - Int_BufSz = Int_BufSz + 3 ! Sgmt: size of buffers for each call to pack subtype - CALL FVW_Packt_sgmt( Re_Buf, Db_Buf, Int_Buf, InData%Sgmt, ErrStat2, ErrMsg2, .TRUE. ) ! Sgmt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Sgmt - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Sgmt - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Sgmt - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! Part: size of buffers for each call to pack subtype - CALL FVW_Packt_part( Re_Buf, Db_Buf, Int_Buf, InData%Part, ErrStat2, ErrMsg2, .TRUE. ) ! Part - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Part - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Part - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Part - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! CPs allocated yes/no - IF ( ALLOCATED(InData%CPs) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! CPs upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CPs) ! CPs - END IF - Int_BufSz = Int_BufSz + 1 ! Uind allocated yes/no - IF ( ALLOCATED(InData%Uind) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Uind upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Uind) ! Uind - END IF - Int_BufSz = Int_BufSz + 1 ! GridOutputs allocated yes/no - IF ( ALLOCATED(InData%GridOutputs) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! GridOutputs upper/lower bounds for each dimension - DO i1 = LBOUND(InData%GridOutputs,1), UBOUND(InData%GridOutputs,1) - Int_BufSz = Int_BufSz + 3 ! GridOutputs: size of buffers for each call to pack subtype - CALL FVW_Packgridouttype( Re_Buf, Db_Buf, Int_Buf, InData%GridOutputs(i1), ErrStat2, ErrMsg2, .TRUE. ) ! GridOutputs - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! GridOutputs - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! GridOutputs - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! GridOutputs - 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%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) - CALL FVW_Packwng_miscvartype( Re_Buf, Db_Buf, Int_Buf, InData%W(i1), ErrStat2, ErrMsg2, OnlySize ) ! W - 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%FirstCall, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nNW - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nFW - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%iStep - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%VTKstep - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%VTKlastTime - Db_Xferred = Db_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%r_wind) ) THEN - 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_wind,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%r_wind,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%r_wind,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%r_wind,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%r_wind,2), UBOUND(InData%r_wind,2) - DO i1 = LBOUND(InData%r_wind,1), UBOUND(InData%r_wind,1) - ReKiBuf(Re_Xferred) = InData%r_wind(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = TRANSFER(InData%ComputeWakeInduced, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%OldWakeTime - Db_Xferred = Db_Xferred + 1 - CALL FVW_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%dxdt, ErrStat2, ErrMsg2, OnlySize ) ! dxdt - 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 FVW_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x1, ErrStat2, ErrMsg2, OnlySize ) ! x1 - 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 FVW_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x2, ErrStat2, ErrMsg2, OnlySize ) ! x2 - 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 - DbKiBuf(Db_Xferred) = InData%t1 - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%t2 - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%UA_Flag, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - CALL FVW_Packt_sgmt( Re_Buf, Db_Buf, Int_Buf, InData%Sgmt, ErrStat2, ErrMsg2, OnlySize ) ! Sgmt - 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 FVW_Packt_part( Re_Buf, Db_Buf, Int_Buf, InData%Part, ErrStat2, ErrMsg2, OnlySize ) ! Part - 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%CPs) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CPs,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CPs,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CPs,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CPs,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%CPs,2), UBOUND(InData%CPs,2) - DO i1 = LBOUND(InData%CPs,1), UBOUND(InData%CPs,1) - ReKiBuf(Re_Xferred) = InData%CPs(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Uind) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Uind,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Uind,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Uind,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Uind,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Uind,2), UBOUND(InData%Uind,2) - DO i1 = LBOUND(InData%Uind,1), UBOUND(InData%Uind,1) - ReKiBuf(Re_Xferred) = InData%Uind(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%GridOutputs) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%GridOutputs,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GridOutputs,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%GridOutputs,1), UBOUND(InData%GridOutputs,1) - CALL FVW_Packgridouttype( Re_Buf, Db_Buf, Int_Buf, InData%GridOutputs(i1), ErrStat2, ErrMsg2, OnlySize ) ! GridOutputs - 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 FVW_PackMisc - - SUBROUTINE FVW_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(FVW_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 = 'FVW_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 ! 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 (ALLOCATED(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 - DO i1 = LBOUND(OutData%W,1), UBOUND(OutData%W,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 FVW_Unpackwng_miscvartype( Re_Buf, Db_Buf, Int_Buf, OutData%W(i1), ErrStat2, ErrMsg2 ) ! W - 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%FirstCall = TRANSFER(IntKiBuf(Int_Xferred), OutData%FirstCall) - Int_Xferred = Int_Xferred + 1 - OutData%nNW = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nFW = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%iStep = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%VTKstep = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%VTKlastTime = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! r_wind not allocated - Int_Xferred = Int_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%r_wind)) DEALLOCATE(OutData%r_wind) - ALLOCATE(OutData%r_wind(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%r_wind.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%r_wind,2), UBOUND(OutData%r_wind,2) - DO i1 = LBOUND(OutData%r_wind,1), UBOUND(OutData%r_wind,1) - OutData%r_wind(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%ComputeWakeInduced = TRANSFER(IntKiBuf(Int_Xferred), OutData%ComputeWakeInduced) - Int_Xferred = Int_Xferred + 1 - OutData%OldWakeTime = 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 FVW_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%dxdt, ErrStat2, ErrMsg2 ) ! dxdt - 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 FVW_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x1, ErrStat2, ErrMsg2 ) ! x1 - 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 FVW_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x2, ErrStat2, ErrMsg2 ) ! x2 - 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%t1 = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%t2 = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%UA_Flag = TRANSFER(IntKiBuf(Int_Xferred), OutData%UA_Flag) - 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 FVW_Unpackt_sgmt( Re_Buf, Db_Buf, Int_Buf, OutData%Sgmt, ErrStat2, ErrMsg2 ) ! Sgmt - 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 FVW_Unpackt_part( Re_Buf, Db_Buf, Int_Buf, OutData%Part, ErrStat2, ErrMsg2 ) ! Part - 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 ! CPs not allocated - Int_Xferred = Int_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%CPs)) DEALLOCATE(OutData%CPs) - ALLOCATE(OutData%CPs(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CPs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%CPs,2), UBOUND(OutData%CPs,2) - DO i1 = LBOUND(OutData%CPs,1), UBOUND(OutData%CPs,1) - OutData%CPs(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Uind not allocated - Int_Xferred = Int_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%Uind)) DEALLOCATE(OutData%Uind) - ALLOCATE(OutData%Uind(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Uind.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Uind,2), UBOUND(OutData%Uind,2) - DO i1 = LBOUND(OutData%Uind,1), UBOUND(OutData%Uind,1) - OutData%Uind(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! GridOutputs not allocated - Int_Xferred = Int_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%GridOutputs)) DEALLOCATE(OutData%GridOutputs) - ALLOCATE(OutData%GridOutputs(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%GridOutputs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%GridOutputs,1), UBOUND(OutData%GridOutputs,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 FVW_Unpackgridouttype( Re_Buf, Db_Buf, Int_Buf, OutData%GridOutputs(i1), ErrStat2, ErrMsg2 ) ! GridOutputs - 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 FVW_UnPackMisc - - SUBROUTINE FVW_CopyRot_InputType( SrcRot_InputTypeData, DstRot_InputTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Rot_InputType), INTENT(IN) :: SrcRot_InputTypeData - TYPE(Rot_InputType), INTENT(INOUT) :: DstRot_InputTypeData - 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 = 'FVW_CopyRot_InputType' -! - ErrStat = ErrID_None - ErrMsg = "" - DstRot_InputTypeData%HubOrientation = SrcRot_InputTypeData%HubOrientation - DstRot_InputTypeData%HubPosition = SrcRot_InputTypeData%HubPosition - END SUBROUTINE FVW_CopyRot_InputType - - SUBROUTINE FVW_DestroyRot_InputType( Rot_InputTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(Rot_InputType), INTENT(INOUT) :: Rot_InputTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_DestroyRot_InputType' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE FVW_DestroyRot_InputType - - SUBROUTINE FVW_PackRot_InputType( 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(Rot_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 = 'FVW_PackRot_InputType' - ! 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%HubOrientation) ! HubOrientation - Re_BufSz = Re_BufSz + SIZE(InData%HubPosition) ! HubPosition - 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%HubOrientation,2), UBOUND(InData%HubOrientation,2) - DO i1 = LBOUND(InData%HubOrientation,1), UBOUND(InData%HubOrientation,1) - ReKiBuf(Re_Xferred) = InData%HubOrientation(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - DO i1 = LBOUND(InData%HubPosition,1), UBOUND(InData%HubPosition,1) - ReKiBuf(Re_Xferred) = InData%HubPosition(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END SUBROUTINE FVW_PackRot_InputType - - SUBROUTINE FVW_UnPackRot_InputType( 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(Rot_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 = 'FVW_UnPackRot_InputType' - ! 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%HubOrientation,1) - i1_u = UBOUND(OutData%HubOrientation,1) - i2_l = LBOUND(OutData%HubOrientation,2) - i2_u = UBOUND(OutData%HubOrientation,2) - DO i2 = LBOUND(OutData%HubOrientation,2), UBOUND(OutData%HubOrientation,2) - DO i1 = LBOUND(OutData%HubOrientation,1), UBOUND(OutData%HubOrientation,1) - OutData%HubOrientation(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%HubPosition,1) - i1_u = UBOUND(OutData%HubPosition,1) - DO i1 = LBOUND(OutData%HubPosition,1), UBOUND(OutData%HubPosition,1) - OutData%HubPosition(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END SUBROUTINE FVW_UnPackRot_InputType - - SUBROUTINE FVW_CopyWng_InputType( SrcWng_InputTypeData, DstWng_InputTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Wng_InputType), INTENT(IN) :: SrcWng_InputTypeData - TYPE(Wng_InputType), INTENT(INOUT) :: DstWng_InputTypeData - 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 = 'FVW_CopyWng_InputType' -! +subroutine FVW_CopyGridOutType(SrcGridOutTypeData, DstGridOutTypeData, CtrlCode, ErrStat, ErrMsg) + type(GridOutType), intent(in) :: SrcGridOutTypeData + type(GridOutType), intent(inout) :: DstGridOutTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(4), UB(4) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'FVW_CopyGridOutType' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcWng_InputTypeData%Vwnd_LL)) THEN - i1_l = LBOUND(SrcWng_InputTypeData%Vwnd_LL,1) - i1_u = UBOUND(SrcWng_InputTypeData%Vwnd_LL,1) - i2_l = LBOUND(SrcWng_InputTypeData%Vwnd_LL,2) - i2_u = UBOUND(SrcWng_InputTypeData%Vwnd_LL,2) - IF (.NOT. ALLOCATED(DstWng_InputTypeData%Vwnd_LL)) THEN - ALLOCATE(DstWng_InputTypeData%Vwnd_LL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_InputTypeData%Vwnd_LL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_InputTypeData%Vwnd_LL = SrcWng_InputTypeData%Vwnd_LL -ENDIF -IF (ALLOCATED(SrcWng_InputTypeData%omega_z)) THEN - i1_l = LBOUND(SrcWng_InputTypeData%omega_z,1) - i1_u = UBOUND(SrcWng_InputTypeData%omega_z,1) - IF (.NOT. ALLOCATED(DstWng_InputTypeData%omega_z)) THEN - ALLOCATE(DstWng_InputTypeData%omega_z(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_InputTypeData%omega_z.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_InputTypeData%omega_z = SrcWng_InputTypeData%omega_z -ENDIF - END SUBROUTINE FVW_CopyWng_InputType - - SUBROUTINE FVW_DestroyWng_InputType( Wng_InputTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(Wng_InputType), INTENT(INOUT) :: Wng_InputTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_DestroyWng_InputType' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(Wng_InputTypeData%Vwnd_LL)) THEN - DEALLOCATE(Wng_InputTypeData%Vwnd_LL) -ENDIF -IF (ALLOCATED(Wng_InputTypeData%omega_z)) THEN - DEALLOCATE(Wng_InputTypeData%omega_z) -ENDIF - END SUBROUTINE FVW_DestroyWng_InputType - - SUBROUTINE FVW_PackWng_InputType( 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(Wng_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 = 'FVW_PackWng_InputType' - ! 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 ! Vwnd_LL allocated yes/no - IF ( ALLOCATED(InData%Vwnd_LL) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Vwnd_LL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vwnd_LL) ! Vwnd_LL - END IF - Int_BufSz = Int_BufSz + 1 ! omega_z allocated yes/no - IF ( ALLOCATED(InData%omega_z) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! omega_z upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%omega_z) ! omega_z - 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%Vwnd_LL) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vwnd_LL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vwnd_LL,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vwnd_LL,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vwnd_LL,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Vwnd_LL,2), UBOUND(InData%Vwnd_LL,2) - DO i1 = LBOUND(InData%Vwnd_LL,1), UBOUND(InData%Vwnd_LL,1) - ReKiBuf(Re_Xferred) = InData%Vwnd_LL(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%omega_z) ) THEN - 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_z,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%omega_z,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%omega_z,1), UBOUND(InData%omega_z,1) - ReKiBuf(Re_Xferred) = InData%omega_z(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE FVW_PackWng_InputType - - SUBROUTINE FVW_UnPackWng_InputType( 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(Wng_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 = 'FVW_UnPackWng_InputType' - ! 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 ! Vwnd_LL not allocated - Int_Xferred = Int_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%Vwnd_LL)) DEALLOCATE(OutData%Vwnd_LL) - ALLOCATE(OutData%Vwnd_LL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vwnd_LL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Vwnd_LL,2), UBOUND(OutData%Vwnd_LL,2) - DO i1 = LBOUND(OutData%Vwnd_LL,1), UBOUND(OutData%Vwnd_LL,1) - OutData%Vwnd_LL(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! omega_z not allocated - Int_Xferred = Int_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%omega_z)) DEALLOCATE(OutData%omega_z) - ALLOCATE(OutData%omega_z(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%omega_z.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%omega_z,1), UBOUND(OutData%omega_z,1) - OutData%omega_z(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE FVW_UnPackWng_InputType - - SUBROUTINE FVW_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FVW_InputType), INTENT(INOUT) :: SrcInputData - TYPE(FVW_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 = 'FVW_CopyInput' -! + ErrMsg = '' + DstGridOutTypeData%name = SrcGridOutTypeData%name + DstGridOutTypeData%type = SrcGridOutTypeData%type + DstGridOutTypeData%tStart = SrcGridOutTypeData%tStart + DstGridOutTypeData%tEnd = SrcGridOutTypeData%tEnd + DstGridOutTypeData%DTout = SrcGridOutTypeData%DTout + DstGridOutTypeData%xStart = SrcGridOutTypeData%xStart + DstGridOutTypeData%yStart = SrcGridOutTypeData%yStart + DstGridOutTypeData%zStart = SrcGridOutTypeData%zStart + DstGridOutTypeData%xEnd = SrcGridOutTypeData%xEnd + DstGridOutTypeData%yEnd = SrcGridOutTypeData%yEnd + DstGridOutTypeData%zEnd = SrcGridOutTypeData%zEnd + DstGridOutTypeData%nx = SrcGridOutTypeData%nx + DstGridOutTypeData%ny = SrcGridOutTypeData%ny + DstGridOutTypeData%nz = SrcGridOutTypeData%nz + if (allocated(SrcGridOutTypeData%uGrid)) then + LB(1:4) = lbound(SrcGridOutTypeData%uGrid) + UB(1:4) = ubound(SrcGridOutTypeData%uGrid) + if (.not. allocated(DstGridOutTypeData%uGrid)) then + allocate(DstGridOutTypeData%uGrid(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstGridOutTypeData%uGrid.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstGridOutTypeData%uGrid = SrcGridOutTypeData%uGrid + end if + if (allocated(SrcGridOutTypeData%omGrid)) then + LB(1:4) = lbound(SrcGridOutTypeData%omGrid) + UB(1:4) = ubound(SrcGridOutTypeData%omGrid) + if (.not. allocated(DstGridOutTypeData%omGrid)) then + allocate(DstGridOutTypeData%omGrid(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstGridOutTypeData%omGrid.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstGridOutTypeData%omGrid = SrcGridOutTypeData%omGrid + end if + DstGridOutTypeData%tLastOutput = SrcGridOutTypeData%tLastOutput +end subroutine + +subroutine FVW_DestroyGridOutType(GridOutTypeData, ErrStat, ErrMsg) + type(GridOutType), intent(inout) :: GridOutTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FVW_DestroyGridOutType' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcInputData%rotors)) THEN - i1_l = LBOUND(SrcInputData%rotors,1) - i1_u = UBOUND(SrcInputData%rotors,1) - IF (.NOT. ALLOCATED(DstInputData%rotors)) THEN - ALLOCATE(DstInputData%rotors(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%rotors.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcInputData%rotors,1), UBOUND(SrcInputData%rotors,1) - CALL FVW_Copyrot_inputtype( SrcInputData%rotors(i1), DstInputData%rotors(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcInputData%W)) THEN - i1_l = LBOUND(SrcInputData%W,1) - i1_u = UBOUND(SrcInputData%W,1) - IF (.NOT. ALLOCATED(DstInputData%W)) THEN - ALLOCATE(DstInputData%W(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%W.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcInputData%W,1), UBOUND(SrcInputData%W,1) - CALL FVW_Copywng_inputtype( SrcInputData%W(i1), DstInputData%W(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcInputData%WingsMesh)) THEN - i1_l = LBOUND(SrcInputData%WingsMesh,1) - i1_u = UBOUND(SrcInputData%WingsMesh,1) - IF (.NOT. ALLOCATED(DstInputData%WingsMesh)) THEN - ALLOCATE(DstInputData%WingsMesh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%WingsMesh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcInputData%WingsMesh,1), UBOUND(SrcInputData%WingsMesh,1) - CALL MeshCopy( SrcInputData%WingsMesh(i1), DstInputData%WingsMesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcInputData%V_wind)) THEN - i1_l = LBOUND(SrcInputData%V_wind,1) - i1_u = UBOUND(SrcInputData%V_wind,1) - i2_l = LBOUND(SrcInputData%V_wind,2) - i2_u = UBOUND(SrcInputData%V_wind,2) - IF (.NOT. ALLOCATED(DstInputData%V_wind)) THEN - ALLOCATE(DstInputData%V_wind(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%V_wind.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%V_wind = SrcInputData%V_wind -ENDIF - END SUBROUTINE FVW_CopyInput - - SUBROUTINE FVW_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(FVW_InputType), INTENT(INOUT) :: InputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_DestroyInput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(InputData%rotors)) THEN -DO i1 = LBOUND(InputData%rotors,1), UBOUND(InputData%rotors,1) - CALL FVW_Destroyrot_inputtype( InputData%rotors(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(InputData%rotors) -ENDIF -IF (ALLOCATED(InputData%W)) THEN -DO i1 = LBOUND(InputData%W,1), UBOUND(InputData%W,1) - CALL FVW_Destroywng_inputtype( InputData%W(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(InputData%W) -ENDIF -IF (ALLOCATED(InputData%WingsMesh)) THEN -DO i1 = LBOUND(InputData%WingsMesh,1), UBOUND(InputData%WingsMesh,1) - CALL MeshDestroy( InputData%WingsMesh(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(InputData%WingsMesh) -ENDIF -IF (ALLOCATED(InputData%V_wind)) THEN - DEALLOCATE(InputData%V_wind) -ENDIF - END SUBROUTINE FVW_DestroyInput - - SUBROUTINE FVW_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(FVW_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 = 'FVW_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 ! rotors allocated yes/no - IF ( ALLOCATED(InData%rotors) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! rotors upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%rotors,1), UBOUND(InData%rotors,1) - Int_BufSz = Int_BufSz + 3 ! rotors: size of buffers for each call to pack subtype - CALL FVW_Packrot_inputtype( Re_Buf, Db_Buf, Int_Buf, InData%rotors(i1), ErrStat2, ErrMsg2, .TRUE. ) ! rotors - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! rotors - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! rotors - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! rotors - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! W allocated yes/no - IF ( ALLOCATED(InData%W) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! W upper/lower bounds for each dimension - DO i1 = LBOUND(InData%W,1), UBOUND(InData%W,1) - Int_BufSz = Int_BufSz + 3 ! W: size of buffers for each call to pack subtype - CALL FVW_Packwng_inputtype( Re_Buf, Db_Buf, Int_Buf, InData%W(i1), ErrStat2, ErrMsg2, .TRUE. ) ! W - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! W - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! W - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! W - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! WingsMesh allocated yes/no - IF ( ALLOCATED(InData%WingsMesh) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WingsMesh upper/lower bounds for each dimension - DO i1 = LBOUND(InData%WingsMesh,1), UBOUND(InData%WingsMesh,1) - Int_BufSz = Int_BufSz + 3 ! WingsMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%WingsMesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! WingsMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! WingsMesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! WingsMesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! WingsMesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! V_wind allocated yes/no - IF ( ALLOCATED(InData%V_wind) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! V_wind upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%V_wind) ! V_wind - 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%rotors) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rotors,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rotors,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%rotors,1), UBOUND(InData%rotors,1) - CALL FVW_Packrot_inputtype( Re_Buf, Db_Buf, Int_Buf, InData%rotors(i1), ErrStat2, ErrMsg2, OnlySize ) ! rotors - 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%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) - CALL FVW_Packwng_inputtype( Re_Buf, Db_Buf, Int_Buf, InData%W(i1), ErrStat2, ErrMsg2, OnlySize ) ! W - 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%WingsMesh) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WingsMesh,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WingsMesh,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WingsMesh,1), UBOUND(InData%WingsMesh,1) - CALL MeshPack( InData%WingsMesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! WingsMesh - 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%V_wind) ) THEN - 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_wind,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%V_wind,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%V_wind,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%V_wind,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%V_wind,2), UBOUND(InData%V_wind,2) - DO i1 = LBOUND(InData%V_wind,1), UBOUND(InData%V_wind,1) - ReKiBuf(Re_Xferred) = InData%V_wind(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE FVW_PackInput - - SUBROUTINE FVW_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(FVW_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 = 'FVW_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 ! rotors not allocated - Int_Xferred = Int_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%rotors)) DEALLOCATE(OutData%rotors) - ALLOCATE(OutData%rotors(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotors.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%rotors,1), UBOUND(OutData%rotors,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 FVW_Unpackrot_inputtype( Re_Buf, Db_Buf, Int_Buf, OutData%rotors(i1), ErrStat2, ErrMsg2 ) ! rotors - 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 ! 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 (ALLOCATED(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 - DO i1 = LBOUND(OutData%W,1), UBOUND(OutData%W,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 FVW_Unpackwng_inputtype( Re_Buf, Db_Buf, Int_Buf, OutData%W(i1), ErrStat2, ErrMsg2 ) ! W - 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 ! WingsMesh not allocated - Int_Xferred = Int_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%WingsMesh)) DEALLOCATE(OutData%WingsMesh) - ALLOCATE(OutData%WingsMesh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WingsMesh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WingsMesh,1), UBOUND(OutData%WingsMesh,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%WingsMesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! WingsMesh - 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 ! V_wind not allocated - Int_Xferred = Int_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_wind)) DEALLOCATE(OutData%V_wind) - ALLOCATE(OutData%V_wind(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%V_wind.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%V_wind,2), UBOUND(OutData%V_wind,2) - DO i1 = LBOUND(OutData%V_wind,1), UBOUND(OutData%V_wind,1) - OutData%V_wind(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE FVW_UnPackInput - - SUBROUTINE FVW_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FVW_DiscreteStateType), INTENT(IN) :: SrcDiscStateData - TYPE(FVW_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 = 'FVW_CopyDiscState' -! + ErrMsg = '' + if (allocated(GridOutTypeData%uGrid)) then + deallocate(GridOutTypeData%uGrid) + end if + if (allocated(GridOutTypeData%omGrid)) then + deallocate(GridOutTypeData%omGrid) + end if +end subroutine + +subroutine FVW_PackGridOutType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(GridOutType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FVW_PackGridOutType' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%name) + call RegPack(RF, InData%type) + call RegPack(RF, InData%tStart) + call RegPack(RF, InData%tEnd) + call RegPack(RF, InData%DTout) + call RegPack(RF, InData%xStart) + call RegPack(RF, InData%yStart) + call RegPack(RF, InData%zStart) + call RegPack(RF, InData%xEnd) + call RegPack(RF, InData%yEnd) + call RegPack(RF, InData%zEnd) + call RegPack(RF, InData%nx) + call RegPack(RF, InData%ny) + call RegPack(RF, InData%nz) + call RegPackAlloc(RF, InData%uGrid) + call RegPackAlloc(RF, InData%omGrid) + call RegPack(RF, InData%tLastOutput) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FVW_UnPackGridOutType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(GridOutType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FVW_UnPackGridOutType' + integer(B4Ki) :: LB(4), UB(4) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%name); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%type); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%tStart); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%tEnd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DTout); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%xStart); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%yStart); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%zStart); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%xEnd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%yEnd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%zEnd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ny); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nz); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%uGrid); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%omGrid); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%tLastOutput); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FVW_CopyT_Sgmt(SrcT_SgmtData, DstT_SgmtData, CtrlCode, ErrStat, ErrMsg) + type(T_Sgmt), intent(in) :: SrcT_SgmtData + type(T_Sgmt), intent(inout) :: DstT_SgmtData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'FVW_CopyT_Sgmt' ErrStat = ErrID_None - ErrMsg = "" - DstDiscStateData%Dummy = SrcDiscStateData%Dummy -IF (ALLOCATED(SrcDiscStateData%UA)) THEN - i1_l = LBOUND(SrcDiscStateData%UA,1) - i1_u = UBOUND(SrcDiscStateData%UA,1) - IF (.NOT. ALLOCATED(DstDiscStateData%UA)) THEN - ALLOCATE(DstDiscStateData%UA(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%UA.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcDiscStateData%UA,1), UBOUND(SrcDiscStateData%UA,1) - CALL UA_CopyDiscState( SrcDiscStateData%UA(i1), DstDiscStateData%UA(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - END SUBROUTINE FVW_CopyDiscState - - SUBROUTINE FVW_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(FVW_DiscreteStateType), INTENT(INOUT) :: DiscStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_DestroyDiscState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(DiscStateData%UA)) THEN -DO i1 = LBOUND(DiscStateData%UA,1), UBOUND(DiscStateData%UA,1) - CALL UA_DestroyDiscState( DiscStateData%UA(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(DiscStateData%UA) -ENDIF - END SUBROUTINE FVW_DestroyDiscState - - SUBROUTINE FVW_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(FVW_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 = 'FVW_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 - Int_BufSz = Int_BufSz + 1 ! UA allocated yes/no - IF ( ALLOCATED(InData%UA) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! UA upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%UA,1), UBOUND(InData%UA,1) - Int_BufSz = Int_BufSz + 3 ! UA: size of buffers for each call to pack subtype - CALL UA_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%UA(i1), ErrStat2, ErrMsg2, .TRUE. ) ! UA - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! UA - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! UA - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! UA - 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%Dummy - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%UA) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%UA,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UA,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%UA,1), UBOUND(InData%UA,1) - CALL UA_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%UA(i1), ErrStat2, ErrMsg2, OnlySize ) ! UA - 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 FVW_PackDiscState - - SUBROUTINE FVW_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(FVW_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 = 'FVW_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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! UA not allocated - Int_Xferred = Int_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%UA)) DEALLOCATE(OutData%UA) - ALLOCATE(OutData%UA(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%UA.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%UA,1), UBOUND(OutData%UA,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 UA_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%UA(i1), ErrStat2, ErrMsg2 ) ! UA - 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 FVW_UnPackDiscState - - SUBROUTINE FVW_CopyWng_ConstraintStateType( SrcWng_ConstraintStateTypeData, DstWng_ConstraintStateTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Wng_ConstraintStateType), INTENT(IN) :: SrcWng_ConstraintStateTypeData - TYPE(Wng_ConstraintStateType), INTENT(INOUT) :: DstWng_ConstraintStateTypeData - 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 = 'FVW_CopyWng_ConstraintStateType' -! + ErrMsg = '' + if (allocated(SrcT_SgmtData%Points)) then + LB(1:2) = lbound(SrcT_SgmtData%Points) + UB(1:2) = ubound(SrcT_SgmtData%Points) + if (.not. allocated(DstT_SgmtData%Points)) then + allocate(DstT_SgmtData%Points(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstT_SgmtData%Points.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstT_SgmtData%Points = SrcT_SgmtData%Points + end if + if (allocated(SrcT_SgmtData%Connct)) then + LB(1:2) = lbound(SrcT_SgmtData%Connct) + UB(1:2) = ubound(SrcT_SgmtData%Connct) + if (.not. allocated(DstT_SgmtData%Connct)) then + allocate(DstT_SgmtData%Connct(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstT_SgmtData%Connct.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstT_SgmtData%Connct = SrcT_SgmtData%Connct + end if + if (allocated(SrcT_SgmtData%Gamma)) then + LB(1:1) = lbound(SrcT_SgmtData%Gamma) + UB(1:1) = ubound(SrcT_SgmtData%Gamma) + if (.not. allocated(DstT_SgmtData%Gamma)) then + allocate(DstT_SgmtData%Gamma(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstT_SgmtData%Gamma.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstT_SgmtData%Gamma = SrcT_SgmtData%Gamma + end if + if (allocated(SrcT_SgmtData%Epsilon)) then + LB(1:1) = lbound(SrcT_SgmtData%Epsilon) + UB(1:1) = ubound(SrcT_SgmtData%Epsilon) + if (.not. allocated(DstT_SgmtData%Epsilon)) then + allocate(DstT_SgmtData%Epsilon(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstT_SgmtData%Epsilon.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstT_SgmtData%Epsilon = SrcT_SgmtData%Epsilon + end if + DstT_SgmtData%RegFunction = SrcT_SgmtData%RegFunction + DstT_SgmtData%nAct = SrcT_SgmtData%nAct + DstT_SgmtData%nActP = SrcT_SgmtData%nActP +end subroutine + +subroutine FVW_DestroyT_Sgmt(T_SgmtData, ErrStat, ErrMsg) + type(T_Sgmt), intent(inout) :: T_SgmtData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FVW_DestroyT_Sgmt' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcWng_ConstraintStateTypeData%Gamma_LL)) THEN - i1_l = LBOUND(SrcWng_ConstraintStateTypeData%Gamma_LL,1) - i1_u = UBOUND(SrcWng_ConstraintStateTypeData%Gamma_LL,1) - IF (.NOT. ALLOCATED(DstWng_ConstraintStateTypeData%Gamma_LL)) THEN - ALLOCATE(DstWng_ConstraintStateTypeData%Gamma_LL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_ConstraintStateTypeData%Gamma_LL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_ConstraintStateTypeData%Gamma_LL = SrcWng_ConstraintStateTypeData%Gamma_LL -ENDIF - END SUBROUTINE FVW_CopyWng_ConstraintStateType - - SUBROUTINE FVW_DestroyWng_ConstraintStateType( Wng_ConstraintStateTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(Wng_ConstraintStateType), INTENT(INOUT) :: Wng_ConstraintStateTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_DestroyWng_ConstraintStateType' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(Wng_ConstraintStateTypeData%Gamma_LL)) THEN - DEALLOCATE(Wng_ConstraintStateTypeData%Gamma_LL) -ENDIF - END SUBROUTINE FVW_DestroyWng_ConstraintStateType - - SUBROUTINE FVW_PackWng_ConstraintStateType( 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(Wng_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 = 'FVW_PackWng_ConstraintStateType' - ! 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 ! Gamma_LL allocated yes/no - IF ( ALLOCATED(InData%Gamma_LL) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Gamma_LL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Gamma_LL) ! Gamma_LL - 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%Gamma_LL) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Gamma_LL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Gamma_LL,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Gamma_LL,1), UBOUND(InData%Gamma_LL,1) - ReKiBuf(Re_Xferred) = InData%Gamma_LL(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE FVW_PackWng_ConstraintStateType - - SUBROUTINE FVW_UnPackWng_ConstraintStateType( 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(Wng_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 = 'FVW_UnPackWng_ConstraintStateType' - ! 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 ! Gamma_LL not allocated - Int_Xferred = Int_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%Gamma_LL)) DEALLOCATE(OutData%Gamma_LL) - ALLOCATE(OutData%Gamma_LL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Gamma_LL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Gamma_LL,1), UBOUND(OutData%Gamma_LL,1) - OutData%Gamma_LL(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE FVW_UnPackWng_ConstraintStateType - - SUBROUTINE FVW_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FVW_ConstraintStateType), INTENT(IN) :: SrcConstrStateData - TYPE(FVW_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 = 'FVW_CopyConstrState' -! + ErrMsg = '' + if (allocated(T_SgmtData%Points)) then + deallocate(T_SgmtData%Points) + end if + if (allocated(T_SgmtData%Connct)) then + deallocate(T_SgmtData%Connct) + end if + if (allocated(T_SgmtData%Gamma)) then + deallocate(T_SgmtData%Gamma) + end if + if (allocated(T_SgmtData%Epsilon)) then + deallocate(T_SgmtData%Epsilon) + end if +end subroutine + +subroutine FVW_PackT_Sgmt(RF, Indata) + type(RegFile), intent(inout) :: RF + type(T_Sgmt), intent(in) :: InData + character(*), parameter :: RoutineName = 'FVW_PackT_Sgmt' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%Points) + call RegPackAlloc(RF, InData%Connct) + call RegPackAlloc(RF, InData%Gamma) + call RegPackAlloc(RF, InData%Epsilon) + call RegPack(RF, InData%RegFunction) + call RegPack(RF, InData%nAct) + call RegPack(RF, InData%nActP) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FVW_UnPackT_Sgmt(RF, OutData) + type(RegFile), intent(inout) :: RF + type(T_Sgmt), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FVW_UnPackT_Sgmt' + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%Points); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Connct); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Gamma); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Epsilon); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RegFunction); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nAct); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nActP); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FVW_CopyT_Part(SrcT_PartData, DstT_PartData, CtrlCode, ErrStat, ErrMsg) + type(T_Part), intent(in) :: SrcT_PartData + type(T_Part), intent(inout) :: DstT_PartData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'FVW_CopyT_Part' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcConstrStateData%W)) THEN - i1_l = LBOUND(SrcConstrStateData%W,1) - i1_u = UBOUND(SrcConstrStateData%W,1) - IF (.NOT. ALLOCATED(DstConstrStateData%W)) THEN - ALLOCATE(DstConstrStateData%W(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstConstrStateData%W.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcConstrStateData%W,1), UBOUND(SrcConstrStateData%W,1) - CALL FVW_Copywng_constraintstatetype( SrcConstrStateData%W(i1), DstConstrStateData%W(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - DstConstrStateData%residual = SrcConstrStateData%residual - END SUBROUTINE FVW_CopyConstrState - - SUBROUTINE FVW_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(FVW_ConstraintStateType), INTENT(INOUT) :: ConstrStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_DestroyConstrState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(ConstrStateData%W)) THEN -DO i1 = LBOUND(ConstrStateData%W,1), UBOUND(ConstrStateData%W,1) - CALL FVW_Destroywng_constraintstatetype( ConstrStateData%W(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ConstrStateData%W) -ENDIF - END SUBROUTINE FVW_DestroyConstrState - - SUBROUTINE FVW_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(FVW_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 = 'FVW_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 - Int_BufSz = Int_BufSz + 1 ! W allocated yes/no - IF ( ALLOCATED(InData%W) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! W upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%W,1), UBOUND(InData%W,1) - Int_BufSz = Int_BufSz + 3 ! W: size of buffers for each call to pack subtype - CALL FVW_Packwng_constraintstatetype( Re_Buf, Db_Buf, Int_Buf, InData%W(i1), ErrStat2, ErrMsg2, .TRUE. ) ! W - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! W - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! W - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! W - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Re_BufSz = Re_BufSz + 1 ! residual - 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%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) - CALL FVW_Packwng_constraintstatetype( Re_Buf, Db_Buf, Int_Buf, InData%W(i1), ErrStat2, ErrMsg2, OnlySize ) ! W - 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 - ReKiBuf(Re_Xferred) = InData%residual - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE FVW_PackConstrState - - SUBROUTINE FVW_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(FVW_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 = 'FVW_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 - 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 (ALLOCATED(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 - DO i1 = LBOUND(OutData%W,1), UBOUND(OutData%W,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 FVW_Unpackwng_constraintstatetype( Re_Buf, Db_Buf, Int_Buf, OutData%W(i1), ErrStat2, ErrMsg2 ) ! W - 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%residual = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE FVW_UnPackConstrState - - SUBROUTINE FVW_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FVW_OtherStateType), INTENT(IN) :: SrcOtherStateData - TYPE(FVW_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 = 'FVW_CopyOtherState' -! + ErrMsg = '' + if (allocated(SrcT_PartData%P)) then + LB(1:2) = lbound(SrcT_PartData%P) + UB(1:2) = ubound(SrcT_PartData%P) + if (.not. allocated(DstT_PartData%P)) then + allocate(DstT_PartData%P(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstT_PartData%P.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstT_PartData%P = SrcT_PartData%P + end if + if (allocated(SrcT_PartData%Alpha)) then + LB(1:2) = lbound(SrcT_PartData%Alpha) + UB(1:2) = ubound(SrcT_PartData%Alpha) + if (.not. allocated(DstT_PartData%Alpha)) then + allocate(DstT_PartData%Alpha(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstT_PartData%Alpha.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstT_PartData%Alpha = SrcT_PartData%Alpha + end if + if (allocated(SrcT_PartData%RegParam)) then + LB(1:1) = lbound(SrcT_PartData%RegParam) + UB(1:1) = ubound(SrcT_PartData%RegParam) + if (.not. allocated(DstT_PartData%RegParam)) then + allocate(DstT_PartData%RegParam(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstT_PartData%RegParam.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstT_PartData%RegParam = SrcT_PartData%RegParam + end if + DstT_PartData%RegFunction = SrcT_PartData%RegFunction + DstT_PartData%nAct = SrcT_PartData%nAct +end subroutine + +subroutine FVW_DestroyT_Part(T_PartData, ErrStat, ErrMsg) + type(T_Part), intent(inout) :: T_PartData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FVW_DestroyT_Part' ErrStat = ErrID_None - ErrMsg = "" - DstOtherStateData%Dummy = SrcOtherStateData%Dummy -IF (ALLOCATED(SrcOtherStateData%UA)) THEN - i1_l = LBOUND(SrcOtherStateData%UA,1) - i1_u = UBOUND(SrcOtherStateData%UA,1) - IF (.NOT. ALLOCATED(DstOtherStateData%UA)) THEN - ALLOCATE(DstOtherStateData%UA(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%UA.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcOtherStateData%UA,1), UBOUND(SrcOtherStateData%UA,1) - CALL UA_CopyOtherState( SrcOtherStateData%UA(i1), DstOtherStateData%UA(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - END SUBROUTINE FVW_CopyOtherState - - SUBROUTINE FVW_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(FVW_OtherStateType), INTENT(INOUT) :: OtherStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_DestroyOtherState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(OtherStateData%UA)) THEN -DO i1 = LBOUND(OtherStateData%UA,1), UBOUND(OtherStateData%UA,1) - CALL UA_DestroyOtherState( OtherStateData%UA(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(OtherStateData%UA) -ENDIF - END SUBROUTINE FVW_DestroyOtherState - - SUBROUTINE FVW_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(FVW_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 = 'FVW_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 - Int_BufSz = Int_BufSz + 1 ! UA allocated yes/no - IF ( ALLOCATED(InData%UA) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! UA upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%UA,1), UBOUND(InData%UA,1) - Int_BufSz = Int_BufSz + 3 ! UA: size of buffers for each call to pack subtype - CALL UA_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%UA(i1), ErrStat2, ErrMsg2, .TRUE. ) ! UA - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! UA - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! UA - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! UA - 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 - - IntKiBuf(Int_Xferred) = InData%Dummy - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%UA) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%UA,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UA,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%UA,1), UBOUND(InData%UA,1) - CALL UA_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%UA(i1), ErrStat2, ErrMsg2, OnlySize ) ! UA - 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 FVW_PackOtherState - - SUBROUTINE FVW_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(FVW_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 = 'FVW_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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! UA not allocated - Int_Xferred = Int_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%UA)) DEALLOCATE(OutData%UA) - ALLOCATE(OutData%UA(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%UA.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%UA,1), UBOUND(OutData%UA,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 UA_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%UA(i1), ErrStat2, ErrMsg2 ) ! UA - 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 FVW_UnPackOtherState - - SUBROUTINE FVW_CopyWng_InitInputType( SrcWng_InitInputTypeData, DstWng_InitInputTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Wng_InitInputType), INTENT(IN) :: SrcWng_InitInputTypeData - TYPE(Wng_InitInputType), INTENT(INOUT) :: DstWng_InitInputTypeData - 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 = 'FVW_CopyWng_InitInputType' -! + ErrMsg = '' + if (allocated(T_PartData%P)) then + deallocate(T_PartData%P) + end if + if (allocated(T_PartData%Alpha)) then + deallocate(T_PartData%Alpha) + end if + if (allocated(T_PartData%RegParam)) then + deallocate(T_PartData%RegParam) + end if +end subroutine + +subroutine FVW_PackT_Part(RF, Indata) + type(RegFile), intent(inout) :: RF + type(T_Part), intent(in) :: InData + character(*), parameter :: RoutineName = 'FVW_PackT_Part' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%P) + call RegPackAlloc(RF, InData%Alpha) + call RegPackAlloc(RF, InData%RegParam) + call RegPack(RF, InData%RegFunction) + call RegPack(RF, InData%nAct) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FVW_UnPackT_Part(RF, OutData) + type(RegFile), intent(inout) :: RF + type(T_Part), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FVW_UnPackT_Part' + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%P); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Alpha); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%RegParam); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RegFunction); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nAct); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FVW_CopyWng_ParameterType(SrcWng_ParameterTypeData, DstWng_ParameterTypeData, CtrlCode, ErrStat, ErrMsg) + type(Wng_ParameterType), intent(in) :: SrcWng_ParameterTypeData + type(Wng_ParameterType), intent(inout) :: DstWng_ParameterTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'FVW_CopyWng_ParameterType' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcWng_InitInputTypeData%AFindx)) THEN - i1_l = LBOUND(SrcWng_InitInputTypeData%AFindx,1) - i1_u = UBOUND(SrcWng_InitInputTypeData%AFindx,1) - i2_l = LBOUND(SrcWng_InitInputTypeData%AFindx,2) - i2_u = UBOUND(SrcWng_InitInputTypeData%AFindx,2) - IF (.NOT. ALLOCATED(DstWng_InitInputTypeData%AFindx)) THEN - ALLOCATE(DstWng_InitInputTypeData%AFindx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_InitInputTypeData%AFindx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_InitInputTypeData%AFindx = SrcWng_InitInputTypeData%AFindx -ENDIF -IF (ALLOCATED(SrcWng_InitInputTypeData%chord)) THEN - i1_l = LBOUND(SrcWng_InitInputTypeData%chord,1) - i1_u = UBOUND(SrcWng_InitInputTypeData%chord,1) - IF (.NOT. ALLOCATED(DstWng_InitInputTypeData%chord)) THEN - ALLOCATE(DstWng_InitInputTypeData%chord(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_InitInputTypeData%chord.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_InitInputTypeData%chord = SrcWng_InitInputTypeData%chord -ENDIF -IF (ALLOCATED(SrcWng_InitInputTypeData%RElm)) THEN - i1_l = LBOUND(SrcWng_InitInputTypeData%RElm,1) - i1_u = UBOUND(SrcWng_InitInputTypeData%RElm,1) - IF (.NOT. ALLOCATED(DstWng_InitInputTypeData%RElm)) THEN - ALLOCATE(DstWng_InitInputTypeData%RElm(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_InitInputTypeData%RElm.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_InitInputTypeData%RElm = SrcWng_InitInputTypeData%RElm -ENDIF - DstWng_InitInputTypeData%iRotor = SrcWng_InitInputTypeData%iRotor - DstWng_InitInputTypeData%UAOff_innerNode = SrcWng_InitInputTypeData%UAOff_innerNode - DstWng_InitInputTypeData%UAOff_outerNode = SrcWng_InitInputTypeData%UAOff_outerNode - END SUBROUTINE FVW_CopyWng_InitInputType - - SUBROUTINE FVW_DestroyWng_InitInputType( Wng_InitInputTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(Wng_InitInputType), INTENT(INOUT) :: Wng_InitInputTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_DestroyWng_InitInputType' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(Wng_InitInputTypeData%AFindx)) THEN - DEALLOCATE(Wng_InitInputTypeData%AFindx) -ENDIF -IF (ALLOCATED(Wng_InitInputTypeData%chord)) THEN - DEALLOCATE(Wng_InitInputTypeData%chord) -ENDIF -IF (ALLOCATED(Wng_InitInputTypeData%RElm)) THEN - DEALLOCATE(Wng_InitInputTypeData%RElm) -ENDIF - END SUBROUTINE FVW_DestroyWng_InitInputType - - SUBROUTINE FVW_PackWng_InitInputType( 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(Wng_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 = 'FVW_PackWng_InitInputType' - ! 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 ! AFindx allocated yes/no - IF ( ALLOCATED(InData%AFindx) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! AFindx upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%AFindx) ! AFindx - END IF - Int_BufSz = Int_BufSz + 1 ! chord allocated yes/no - IF ( ALLOCATED(InData%chord) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! chord upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%chord) ! chord - END IF - Int_BufSz = Int_BufSz + 1 ! RElm allocated yes/no - IF ( ALLOCATED(InData%RElm) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! RElm upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%RElm) ! RElm - END IF - Int_BufSz = Int_BufSz + 1 ! iRotor - Int_BufSz = Int_BufSz + 1 ! UAOff_innerNode - Int_BufSz = Int_BufSz + 1 ! UAOff_outerNode - 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%AFindx) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AFindx,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AFindx,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AFindx,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AFindx,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%AFindx,2), UBOUND(InData%AFindx,2) - DO i1 = LBOUND(InData%AFindx,1), UBOUND(InData%AFindx,1) - IntKiBuf(Int_Xferred) = InData%AFindx(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%chord) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%chord,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%chord,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%chord,1), UBOUND(InData%chord,1) - ReKiBuf(Re_Xferred) = InData%chord(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%RElm) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RElm,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RElm,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%RElm,1), UBOUND(InData%RElm,1) - ReKiBuf(Re_Xferred) = InData%RElm(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%iRotor - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%UAOff_innerNode - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%UAOff_outerNode - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE FVW_PackWng_InitInputType - - SUBROUTINE FVW_UnPackWng_InitInputType( 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(Wng_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 = 'FVW_UnPackWng_InitInputType' - ! 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 ! AFindx not allocated - Int_Xferred = Int_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%AFindx)) DEALLOCATE(OutData%AFindx) - ALLOCATE(OutData%AFindx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AFindx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%AFindx,2), UBOUND(OutData%AFindx,2) - DO i1 = LBOUND(OutData%AFindx,1), UBOUND(OutData%AFindx,1) - OutData%AFindx(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! chord not allocated - Int_Xferred = Int_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%chord)) DEALLOCATE(OutData%chord) - ALLOCATE(OutData%chord(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%chord.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%chord,1), UBOUND(OutData%chord,1) - OutData%chord(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RElm not allocated - Int_Xferred = Int_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%RElm)) DEALLOCATE(OutData%RElm) - ALLOCATE(OutData%RElm(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RElm.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%RElm,1), UBOUND(OutData%RElm,1) - OutData%RElm(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%iRotor = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%UAOff_innerNode = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%UAOff_outerNode = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE FVW_UnPackWng_InitInputType - - SUBROUTINE FVW_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FVW_InitInputType), INTENT(INOUT) :: SrcInitInputData - TYPE(FVW_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 = 'FVW_CopyInitInput' -! + ErrMsg = '' + if (allocated(SrcWng_ParameterTypeData%chord_LL)) then + LB(1:1) = lbound(SrcWng_ParameterTypeData%chord_LL) + UB(1:1) = ubound(SrcWng_ParameterTypeData%chord_LL) + if (.not. allocated(DstWng_ParameterTypeData%chord_LL)) then + allocate(DstWng_ParameterTypeData%chord_LL(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_ParameterTypeData%chord_LL.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_ParameterTypeData%chord_LL = SrcWng_ParameterTypeData%chord_LL + end if + if (allocated(SrcWng_ParameterTypeData%chord_CP)) then + LB(1:1) = lbound(SrcWng_ParameterTypeData%chord_CP) + UB(1:1) = ubound(SrcWng_ParameterTypeData%chord_CP) + if (.not. allocated(DstWng_ParameterTypeData%chord_CP)) then + allocate(DstWng_ParameterTypeData%chord_CP(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_ParameterTypeData%chord_CP.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_ParameterTypeData%chord_CP = SrcWng_ParameterTypeData%chord_CP + end if + if (allocated(SrcWng_ParameterTypeData%s_LL)) then + LB(1:1) = lbound(SrcWng_ParameterTypeData%s_LL) + UB(1:1) = ubound(SrcWng_ParameterTypeData%s_LL) + if (.not. allocated(DstWng_ParameterTypeData%s_LL)) then + allocate(DstWng_ParameterTypeData%s_LL(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_ParameterTypeData%s_LL.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_ParameterTypeData%s_LL = SrcWng_ParameterTypeData%s_LL + end if + if (allocated(SrcWng_ParameterTypeData%s_CP)) then + LB(1:1) = lbound(SrcWng_ParameterTypeData%s_CP) + UB(1:1) = ubound(SrcWng_ParameterTypeData%s_CP) + if (.not. allocated(DstWng_ParameterTypeData%s_CP)) then + allocate(DstWng_ParameterTypeData%s_CP(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_ParameterTypeData%s_CP.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_ParameterTypeData%s_CP = SrcWng_ParameterTypeData%s_CP + end if + DstWng_ParameterTypeData%iRotor = SrcWng_ParameterTypeData%iRotor + if (allocated(SrcWng_ParameterTypeData%AFindx)) then + LB(1:2) = lbound(SrcWng_ParameterTypeData%AFindx) + UB(1:2) = ubound(SrcWng_ParameterTypeData%AFindx) + if (.not. allocated(DstWng_ParameterTypeData%AFindx)) then + allocate(DstWng_ParameterTypeData%AFindx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_ParameterTypeData%AFindx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_ParameterTypeData%AFindx = SrcWng_ParameterTypeData%AFindx + end if + DstWng_ParameterTypeData%nSpan = SrcWng_ParameterTypeData%nSpan + if (allocated(SrcWng_ParameterTypeData%PrescribedCirculation)) then + LB(1:1) = lbound(SrcWng_ParameterTypeData%PrescribedCirculation) + UB(1:1) = ubound(SrcWng_ParameterTypeData%PrescribedCirculation) + if (.not. allocated(DstWng_ParameterTypeData%PrescribedCirculation)) then + allocate(DstWng_ParameterTypeData%PrescribedCirculation(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_ParameterTypeData%PrescribedCirculation.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_ParameterTypeData%PrescribedCirculation = SrcWng_ParameterTypeData%PrescribedCirculation + end if +end subroutine + +subroutine FVW_DestroyWng_ParameterType(Wng_ParameterTypeData, ErrStat, ErrMsg) + type(Wng_ParameterType), intent(inout) :: Wng_ParameterTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FVW_DestroyWng_ParameterType' ErrStat = ErrID_None - ErrMsg = "" - DstInitInputData%FVWFileName = SrcInitInputData%FVWFileName - DstInitInputData%RootName = SrcInitInputData%RootName -IF (ALLOCATED(SrcInitInputData%W)) THEN - i1_l = LBOUND(SrcInitInputData%W,1) - i1_u = UBOUND(SrcInitInputData%W,1) - IF (.NOT. ALLOCATED(DstInitInputData%W)) THEN - ALLOCATE(DstInitInputData%W(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%W.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcInitInputData%W,1), UBOUND(SrcInitInputData%W,1) - CALL FVW_Copywng_initinputtype( SrcInitInputData%W(i1), DstInitInputData%W(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcInitInputData%WingsMesh)) THEN - i1_l = LBOUND(SrcInitInputData%WingsMesh,1) - i1_u = UBOUND(SrcInitInputData%WingsMesh,1) - IF (.NOT. ALLOCATED(DstInitInputData%WingsMesh)) THEN - ALLOCATE(DstInitInputData%WingsMesh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WingsMesh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcInitInputData%WingsMesh,1), UBOUND(SrcInitInputData%WingsMesh,1) - CALL MeshCopy( SrcInitInputData%WingsMesh(i1), DstInitInputData%WingsMesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - DstInitInputData%numBladeNodes = SrcInitInputData%numBladeNodes - DstInitInputData%DTaero = SrcInitInputData%DTaero - DstInitInputData%KinVisc = SrcInitInputData%KinVisc - DstInitInputData%MHK = SrcInitInputData%MHK - DstInitInputData%WtrDpth = SrcInitInputData%WtrDpth - DstInitInputData%UAMod = SrcInitInputData%UAMod - DstInitInputData%UA_Flag = SrcInitInputData%UA_Flag - DstInitInputData%Flookup = SrcInitInputData%Flookup - DstInitInputData%a_s = SrcInitInputData%a_s - DstInitInputData%SumPrint = SrcInitInputData%SumPrint - END SUBROUTINE FVW_CopyInitInput - - SUBROUTINE FVW_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(FVW_InitInputType), INTENT(INOUT) :: InitInputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_DestroyInitInput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(InitInputData%W)) THEN -DO i1 = LBOUND(InitInputData%W,1), UBOUND(InitInputData%W,1) - CALL FVW_Destroywng_initinputtype( InitInputData%W(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(InitInputData%W) -ENDIF -IF (ALLOCATED(InitInputData%WingsMesh)) THEN -DO i1 = LBOUND(InitInputData%WingsMesh,1), UBOUND(InitInputData%WingsMesh,1) - CALL MeshDestroy( InitInputData%WingsMesh(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(InitInputData%WingsMesh) -ENDIF - END SUBROUTINE FVW_DestroyInitInput - - SUBROUTINE FVW_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(FVW_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 = 'FVW_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%FVWFileName) ! FVWFileName - Int_BufSz = Int_BufSz + 1*LEN(InData%RootName) ! RootName - Int_BufSz = Int_BufSz + 1 ! W allocated yes/no - IF ( ALLOCATED(InData%W) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! W upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%W,1), UBOUND(InData%W,1) - Int_BufSz = Int_BufSz + 3 ! W: size of buffers for each call to pack subtype - CALL FVW_Packwng_initinputtype( Re_Buf, Db_Buf, Int_Buf, InData%W(i1), ErrStat2, ErrMsg2, .TRUE. ) ! W - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! W - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! W - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! W - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! WingsMesh allocated yes/no - IF ( ALLOCATED(InData%WingsMesh) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WingsMesh upper/lower bounds for each dimension - DO i1 = LBOUND(InData%WingsMesh,1), UBOUND(InData%WingsMesh,1) - Int_BufSz = Int_BufSz + 3 ! WingsMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%WingsMesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! WingsMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! WingsMesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! WingsMesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! WingsMesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! numBladeNodes - Db_BufSz = Db_BufSz + 1 ! DTaero - Re_BufSz = Re_BufSz + 1 ! KinVisc - Int_BufSz = Int_BufSz + 1 ! MHK - Re_BufSz = Re_BufSz + 1 ! WtrDpth - Int_BufSz = Int_BufSz + 1 ! UAMod - Int_BufSz = Int_BufSz + 1 ! UA_Flag - Int_BufSz = Int_BufSz + 1 ! Flookup - Re_BufSz = Re_BufSz + 1 ! a_s - Int_BufSz = Int_BufSz + 1 ! SumPrint - 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%FVWFileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%FVWFileName(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 - IF ( .NOT. ALLOCATED(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) - CALL FVW_Packwng_initinputtype( Re_Buf, Db_Buf, Int_Buf, InData%W(i1), ErrStat2, ErrMsg2, OnlySize ) ! W - 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%WingsMesh) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WingsMesh,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WingsMesh,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WingsMesh,1), UBOUND(InData%WingsMesh,1) - CALL MeshPack( InData%WingsMesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! WingsMesh - 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%numBladeNodes - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%DTaero - Db_Xferred = Db_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%KinVisc - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%MHK - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WtrDpth - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%UAMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%UA_Flag, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%Flookup, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%a_s - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%SumPrint, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE FVW_PackInitInput - - SUBROUTINE FVW_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(FVW_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 = 'FVW_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%FVWFileName) - OutData%FVWFileName(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 - 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 (ALLOCATED(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 - DO i1 = LBOUND(OutData%W,1), UBOUND(OutData%W,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 FVW_Unpackwng_initinputtype( Re_Buf, Db_Buf, Int_Buf, OutData%W(i1), ErrStat2, ErrMsg2 ) ! W - 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 ! WingsMesh not allocated - Int_Xferred = Int_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%WingsMesh)) DEALLOCATE(OutData%WingsMesh) - ALLOCATE(OutData%WingsMesh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WingsMesh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WingsMesh,1), UBOUND(OutData%WingsMesh,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%WingsMesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! WingsMesh - 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%numBladeNodes = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%DTaero = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%KinVisc = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MHK = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WtrDpth = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%UAMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%UA_Flag = TRANSFER(IntKiBuf(Int_Xferred), OutData%UA_Flag) - Int_Xferred = Int_Xferred + 1 - OutData%Flookup = TRANSFER(IntKiBuf(Int_Xferred), OutData%Flookup) - Int_Xferred = Int_Xferred + 1 - OutData%a_s = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SumPrint = TRANSFER(IntKiBuf(Int_Xferred), OutData%SumPrint) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE FVW_UnPackInitInput - - SUBROUTINE FVW_CopyInputFile( SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FVW_InputFile), INTENT(IN) :: SrcInputFileData - TYPE(FVW_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 = 'FVW_CopyInputFile' -! + ErrMsg = '' + if (allocated(Wng_ParameterTypeData%chord_LL)) then + deallocate(Wng_ParameterTypeData%chord_LL) + end if + if (allocated(Wng_ParameterTypeData%chord_CP)) then + deallocate(Wng_ParameterTypeData%chord_CP) + end if + if (allocated(Wng_ParameterTypeData%s_LL)) then + deallocate(Wng_ParameterTypeData%s_LL) + end if + if (allocated(Wng_ParameterTypeData%s_CP)) then + deallocate(Wng_ParameterTypeData%s_CP) + end if + if (allocated(Wng_ParameterTypeData%AFindx)) then + deallocate(Wng_ParameterTypeData%AFindx) + end if + if (allocated(Wng_ParameterTypeData%PrescribedCirculation)) then + deallocate(Wng_ParameterTypeData%PrescribedCirculation) + end if +end subroutine + +subroutine FVW_PackWng_ParameterType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Wng_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FVW_PackWng_ParameterType' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%chord_LL) + call RegPackAlloc(RF, InData%chord_CP) + call RegPackAlloc(RF, InData%s_LL) + call RegPackAlloc(RF, InData%s_CP) + call RegPack(RF, InData%iRotor) + call RegPackAlloc(RF, InData%AFindx) + call RegPack(RF, InData%nSpan) + call RegPackAlloc(RF, InData%PrescribedCirculation) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FVW_UnPackWng_ParameterType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Wng_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FVW_UnPackWng_ParameterType' + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%chord_LL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%chord_CP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%s_LL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%s_CP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iRotor); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AFindx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nSpan); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PrescribedCirculation); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FVW_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(FVW_ParameterType), intent(in) :: SrcParamData + type(FVW_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FVW_CopyParam' ErrStat = ErrID_None - ErrMsg = "" - DstInputFileData%CircSolvMethod = SrcInputFileData%CircSolvMethod - DstInputFileData%CirculationFile = SrcInputFileData%CirculationFile - DstInputFileData%CircSolvMaxIter = SrcInputFileData%CircSolvMaxIter - DstInputFileData%CircSolvConvCrit = SrcInputFileData%CircSolvConvCrit - DstInputFileData%CircSolvRelaxation = SrcInputFileData%CircSolvRelaxation - DstInputFileData%IntMethod = SrcInputFileData%IntMethod - DstInputFileData%FreeWake = SrcInputFileData%FreeWake - DstInputFileData%FreeWakeStart = SrcInputFileData%FreeWakeStart - DstInputFileData%FullCircStart = SrcInputFileData%FullCircStart - DstInputFileData%DTfvw = SrcInputFileData%DTfvw - DstInputFileData%CircSolvPolar = SrcInputFileData%CircSolvPolar - DstInputFileData%nNWPanels = SrcInputFileData%nNWPanels - DstInputFileData%nNWPanelsFree = SrcInputFileData%nNWPanelsFree - DstInputFileData%nFWPanels = SrcInputFileData%nFWPanels - DstInputFileData%nFWPanelsFree = SrcInputFileData%nFWPanelsFree - DstInputFileData%FWShedVorticity = SrcInputFileData%FWShedVorticity - DstInputFileData%DiffusionMethod = SrcInputFileData%DiffusionMethod - DstInputFileData%CoreSpreadEddyVisc = SrcInputFileData%CoreSpreadEddyVisc - DstInputFileData%RegDeterMethod = SrcInputFileData%RegDeterMethod - DstInputFileData%RegFunction = SrcInputFileData%RegFunction - DstInputFileData%WakeRegMethod = SrcInputFileData%WakeRegMethod - DstInputFileData%WakeRegParam = SrcInputFileData%WakeRegParam - DstInputFileData%WingRegParam = SrcInputFileData%WingRegParam - DstInputFileData%ShearModel = SrcInputFileData%ShearModel - DstInputFileData%TwrShadowOnWake = SrcInputFileData%TwrShadowOnWake - DstInputFileData%VelocityMethod = SrcInputFileData%VelocityMethod - DstInputFileData%TreeBranchFactor = SrcInputFileData%TreeBranchFactor - DstInputFileData%PartPerSegment = SrcInputFileData%PartPerSegment - DstInputFileData%WrVTK = SrcInputFileData%WrVTK - DstInputFileData%VTKBlades = SrcInputFileData%VTKBlades - DstInputFileData%DTvtk = SrcInputFileData%DTvtk - DstInputFileData%VTKCoord = SrcInputFileData%VTKCoord - END SUBROUTINE FVW_CopyInputFile - - SUBROUTINE FVW_DestroyInputFile( InputFileData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(FVW_InputFile), INTENT(INOUT) :: InputFileData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_DestroyInputFile' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE FVW_DestroyInputFile - - SUBROUTINE FVW_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(FVW_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 = 'FVW_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 ! CircSolvMethod - Int_BufSz = Int_BufSz + 1*LEN(InData%CirculationFile) ! CirculationFile - Int_BufSz = Int_BufSz + 1 ! CircSolvMaxIter - Re_BufSz = Re_BufSz + 1 ! CircSolvConvCrit - Re_BufSz = Re_BufSz + 1 ! CircSolvRelaxation - Int_BufSz = Int_BufSz + 1 ! IntMethod - Int_BufSz = Int_BufSz + 1 ! FreeWake - Re_BufSz = Re_BufSz + 1 ! FreeWakeStart - Re_BufSz = Re_BufSz + 1 ! FullCircStart - Db_BufSz = Db_BufSz + 1 ! DTfvw - Int_BufSz = Int_BufSz + 1 ! CircSolvPolar - Int_BufSz = Int_BufSz + 1 ! nNWPanels - Int_BufSz = Int_BufSz + 1 ! nNWPanelsFree - Int_BufSz = Int_BufSz + 1 ! nFWPanels - Int_BufSz = Int_BufSz + 1 ! nFWPanelsFree - Int_BufSz = Int_BufSz + 1 ! FWShedVorticity - Int_BufSz = Int_BufSz + 1 ! DiffusionMethod - Re_BufSz = Re_BufSz + 1 ! CoreSpreadEddyVisc - Int_BufSz = Int_BufSz + 1 ! RegDeterMethod - Int_BufSz = Int_BufSz + 1 ! RegFunction - Int_BufSz = Int_BufSz + 1 ! WakeRegMethod - Re_BufSz = Re_BufSz + 1 ! WakeRegParam - Re_BufSz = Re_BufSz + 1 ! WingRegParam - Int_BufSz = Int_BufSz + 1 ! ShearModel - Int_BufSz = Int_BufSz + 1 ! TwrShadowOnWake - Int_BufSz = Int_BufSz + SIZE(InData%VelocityMethod) ! VelocityMethod - Re_BufSz = Re_BufSz + SIZE(InData%TreeBranchFactor) ! TreeBranchFactor - Int_BufSz = Int_BufSz + SIZE(InData%PartPerSegment) ! PartPerSegment - Int_BufSz = Int_BufSz + 1 ! WrVTK - Int_BufSz = Int_BufSz + 1 ! VTKBlades - Db_BufSz = Db_BufSz + 1 ! DTvtk - Int_BufSz = Int_BufSz + 1 ! VTKCoord - 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%CircSolvMethod - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%CirculationFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%CirculationFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = InData%CircSolvMaxIter - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%CircSolvConvCrit - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%CircSolvRelaxation - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%IntMethod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%FreeWake, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%FreeWakeStart - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%FullCircStart - Re_Xferred = Re_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%DTfvw - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%CircSolvPolar - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nNWPanels - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nNWPanelsFree - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nFWPanels - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nFWPanelsFree - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%FWShedVorticity, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%DiffusionMethod - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%CoreSpreadEddyVisc - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%RegDeterMethod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%RegFunction - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%WakeRegMethod - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WakeRegParam - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WingRegParam - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%ShearModel - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%TwrShadowOnWake, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%VelocityMethod,1), UBOUND(InData%VelocityMethod,1) - IntKiBuf(Int_Xferred) = InData%VelocityMethod(i1) - Int_Xferred = Int_Xferred + 1 - END DO - DO i1 = LBOUND(InData%TreeBranchFactor,1), UBOUND(InData%TreeBranchFactor,1) - ReKiBuf(Re_Xferred) = InData%TreeBranchFactor(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%PartPerSegment,1), UBOUND(InData%PartPerSegment,1) - IntKiBuf(Int_Xferred) = InData%PartPerSegment(i1) - Int_Xferred = Int_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%WrVTK - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%VTKBlades - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%DTvtk - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%VTKCoord - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE FVW_PackInputFile - - SUBROUTINE FVW_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(FVW_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 = 'FVW_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%CircSolvMethod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%CirculationFile) - OutData%CirculationFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%CircSolvMaxIter = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%CircSolvConvCrit = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%CircSolvRelaxation = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%IntMethod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%FreeWake = TRANSFER(IntKiBuf(Int_Xferred), OutData%FreeWake) - Int_Xferred = Int_Xferred + 1 - OutData%FreeWakeStart = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%FullCircStart = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%DTfvw = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%CircSolvPolar = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nNWPanels = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nNWPanelsFree = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nFWPanels = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nFWPanelsFree = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%FWShedVorticity = TRANSFER(IntKiBuf(Int_Xferred), OutData%FWShedVorticity) - Int_Xferred = Int_Xferred + 1 - OutData%DiffusionMethod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%CoreSpreadEddyVisc = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RegDeterMethod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%RegFunction = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WakeRegMethod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WakeRegParam = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%WingRegParam = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%ShearModel = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TwrShadowOnWake = TRANSFER(IntKiBuf(Int_Xferred), OutData%TwrShadowOnWake) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%VelocityMethod,1) - i1_u = UBOUND(OutData%VelocityMethod,1) - DO i1 = LBOUND(OutData%VelocityMethod,1), UBOUND(OutData%VelocityMethod,1) - OutData%VelocityMethod(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - i1_l = LBOUND(OutData%TreeBranchFactor,1) - i1_u = UBOUND(OutData%TreeBranchFactor,1) - DO i1 = LBOUND(OutData%TreeBranchFactor,1), UBOUND(OutData%TreeBranchFactor,1) - OutData%TreeBranchFactor(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%PartPerSegment,1) - i1_u = UBOUND(OutData%PartPerSegment,1) - DO i1 = LBOUND(OutData%PartPerSegment,1), UBOUND(OutData%PartPerSegment,1) - OutData%PartPerSegment(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - OutData%WrVTK = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%VTKBlades = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%DTvtk = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%VTKCoord = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE FVW_UnPackInputFile - - SUBROUTINE FVW_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FVW_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(FVW_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 = 'FVW_CopyInitOutput' -! + ErrMsg = '' + DstParamData%nRotors = SrcParamData%nRotors + DstParamData%nWings = SrcParamData%nWings + if (allocated(SrcParamData%W)) then + LB(1:1) = lbound(SrcParamData%W) + UB(1:1) = ubound(SrcParamData%W) + if (.not. allocated(DstParamData%W)) then + allocate(DstParamData%W(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%W.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call FVW_CopyWng_ParameterType(SrcParamData%W(i1), DstParamData%W(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcParamData%Bld2Wings)) then + LB(1:2) = lbound(SrcParamData%Bld2Wings) + UB(1:2) = ubound(SrcParamData%Bld2Wings) + if (.not. allocated(DstParamData%Bld2Wings)) then + allocate(DstParamData%Bld2Wings(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Bld2Wings.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Bld2Wings = SrcParamData%Bld2Wings + end if + DstParamData%iNWStart = SrcParamData%iNWStart + DstParamData%nNWMax = SrcParamData%nNWMax + DstParamData%nNWFree = SrcParamData%nNWFree + DstParamData%nFWMax = SrcParamData%nFWMax + DstParamData%nFWFree = SrcParamData%nFWFree + DstParamData%FWShedVorticity = SrcParamData%FWShedVorticity + DstParamData%IntMethod = SrcParamData%IntMethod + DstParamData%FreeWakeStart = SrcParamData%FreeWakeStart + DstParamData%FullCircStart = SrcParamData%FullCircStart + DstParamData%CircSolvMethod = SrcParamData%CircSolvMethod + DstParamData%CircSolvMaxIter = SrcParamData%CircSolvMaxIter + DstParamData%CircSolvConvCrit = SrcParamData%CircSolvConvCrit + DstParamData%CircSolvRelaxation = SrcParamData%CircSolvRelaxation + DstParamData%CircSolvPolar = SrcParamData%CircSolvPolar + DstParamData%DiffusionMethod = SrcParamData%DiffusionMethod + DstParamData%CoreSpreadEddyVisc = SrcParamData%CoreSpreadEddyVisc + DstParamData%RegDeterMethod = SrcParamData%RegDeterMethod + DstParamData%RegFunction = SrcParamData%RegFunction + DstParamData%WakeRegMethod = SrcParamData%WakeRegMethod + DstParamData%WakeRegParam = SrcParamData%WakeRegParam + DstParamData%WingRegParam = SrcParamData%WingRegParam + DstParamData%ShearModel = SrcParamData%ShearModel + DstParamData%TwrShadowOnWake = SrcParamData%TwrShadowOnWake + DstParamData%VelocityMethod = SrcParamData%VelocityMethod + DstParamData%TreeBranchFactor = SrcParamData%TreeBranchFactor + DstParamData%PartPerSegment = SrcParamData%PartPerSegment + DstParamData%DTaero = SrcParamData%DTaero + DstParamData%DTfvw = SrcParamData%DTfvw + DstParamData%KinVisc = SrcParamData%KinVisc + DstParamData%MHK = SrcParamData%MHK + DstParamData%WtrDpth = SrcParamData%WtrDpth + DstParamData%WrVTK = SrcParamData%WrVTK + DstParamData%VTKBlades = SrcParamData%VTKBlades + DstParamData%DTvtk = SrcParamData%DTvtk + DstParamData%VTKCoord = SrcParamData%VTKCoord + DstParamData%RootName = SrcParamData%RootName + DstParamData%VTK_OutFileRoot = SrcParamData%VTK_OutFileRoot + DstParamData%VTK_OutFileBase = SrcParamData%VTK_OutFileBase + DstParamData%nGridOut = SrcParamData%nGridOut + DstParamData%InductionAtCP = SrcParamData%InductionAtCP + DstParamData%WakeAtTE = SrcParamData%WakeAtTE + DstParamData%DStallOnWake = SrcParamData%DStallOnWake + DstParamData%Induction = SrcParamData%Induction + DstParamData%kFrozenNWStart = SrcParamData%kFrozenNWStart + DstParamData%kFrozenNWEnd = SrcParamData%kFrozenNWEnd +end subroutine + +subroutine FVW_DestroyParam(ParamData, ErrStat, ErrMsg) + type(FVW_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FVW_DestroyParam' ErrStat = ErrID_None - ErrMsg = "" - DstInitOutputData%Dummy = SrcInitOutputData%Dummy - END SUBROUTINE FVW_CopyInitOutput - - SUBROUTINE FVW_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(FVW_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_DestroyInitOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE FVW_DestroyInitOutput - - SUBROUTINE FVW_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(FVW_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 = 'FVW_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 ! 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 - - IntKiBuf(Int_Xferred) = InData%Dummy - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE FVW_PackInitOutput - - SUBROUTINE FVW_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(FVW_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 = 'FVW_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%Dummy = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE FVW_UnPackInitOutput - - - SUBROUTINE FVW_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(FVW_InputType), INTENT(INOUT) :: u(:) ! Input at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Inputs - TYPE(FVW_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 + ErrMsg = '' + if (allocated(ParamData%W)) then + LB(1:1) = lbound(ParamData%W) + UB(1:1) = ubound(ParamData%W) + do i1 = LB(1), UB(1) + call FVW_DestroyWng_ParameterType(ParamData%W(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%W) + end if + if (allocated(ParamData%Bld2Wings)) then + deallocate(ParamData%Bld2Wings) + end if +end subroutine + +subroutine FVW_PackParam(RF, Indata) + type(RegFile), intent(inout) :: RF + type(FVW_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FVW_PackParam' + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%nRotors) + call RegPack(RF, InData%nWings) + call RegPack(RF, allocated(InData%W)) + if (allocated(InData%W)) then + call RegPackBounds(RF, 1, lbound(InData%W), ubound(InData%W)) + LB(1:1) = lbound(InData%W) + UB(1:1) = ubound(InData%W) + do i1 = LB(1), UB(1) + call FVW_PackWng_ParameterType(RF, InData%W(i1)) + end do + end if + call RegPackAlloc(RF, InData%Bld2Wings) + call RegPack(RF, InData%iNWStart) + call RegPack(RF, InData%nNWMax) + call RegPack(RF, InData%nNWFree) + call RegPack(RF, InData%nFWMax) + call RegPack(RF, InData%nFWFree) + call RegPack(RF, InData%FWShedVorticity) + call RegPack(RF, InData%IntMethod) + call RegPack(RF, InData%FreeWakeStart) + call RegPack(RF, InData%FullCircStart) + call RegPack(RF, InData%CircSolvMethod) + call RegPack(RF, InData%CircSolvMaxIter) + call RegPack(RF, InData%CircSolvConvCrit) + call RegPack(RF, InData%CircSolvRelaxation) + call RegPack(RF, InData%CircSolvPolar) + call RegPack(RF, InData%DiffusionMethod) + call RegPack(RF, InData%CoreSpreadEddyVisc) + call RegPack(RF, InData%RegDeterMethod) + call RegPack(RF, InData%RegFunction) + call RegPack(RF, InData%WakeRegMethod) + call RegPack(RF, InData%WakeRegParam) + call RegPack(RF, InData%WingRegParam) + call RegPack(RF, InData%ShearModel) + call RegPack(RF, InData%TwrShadowOnWake) + call RegPack(RF, InData%VelocityMethod) + call RegPack(RF, InData%TreeBranchFactor) + call RegPack(RF, InData%PartPerSegment) + call RegPack(RF, InData%DTaero) + call RegPack(RF, InData%DTfvw) + call RegPack(RF, InData%KinVisc) + call RegPack(RF, InData%MHK) + call RegPack(RF, InData%WtrDpth) + call RegPack(RF, InData%WrVTK) + call RegPack(RF, InData%VTKBlades) + call RegPack(RF, InData%DTvtk) + call RegPack(RF, InData%VTKCoord) + call RegPack(RF, InData%RootName) + call RegPack(RF, InData%VTK_OutFileRoot) + call RegPack(RF, InData%VTK_OutFileBase) + call RegPack(RF, InData%nGridOut) + call RegPack(RF, InData%InductionAtCP) + call RegPack(RF, InData%WakeAtTE) + call RegPack(RF, InData%DStallOnWake) + call RegPack(RF, InData%Induction) + call RegPack(RF, InData%kFrozenNWStart) + call RegPack(RF, InData%kFrozenNWEnd) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FVW_UnPackParam(RF, OutData) + type(RegFile), intent(inout) :: RF + type(FVW_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FVW_UnPackParam' + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%nRotors); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nWings); if (RegCheckErr(RF, RoutineName)) return + if (allocated(OutData%W)) deallocate(OutData%W) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%W(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%W.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call FVW_UnpackWng_ParameterType(RF, OutData%W(i1)) ! W + end do + end if + call RegUnpackAlloc(RF, OutData%Bld2Wings); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iNWStart); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nNWMax); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nNWFree); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nFWMax); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nFWFree); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FWShedVorticity); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%IntMethod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FreeWakeStart); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FullCircStart); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CircSolvMethod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CircSolvMaxIter); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CircSolvConvCrit); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CircSolvRelaxation); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CircSolvPolar); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DiffusionMethod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CoreSpreadEddyVisc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RegDeterMethod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RegFunction); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WakeRegMethod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WakeRegParam); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WingRegParam); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ShearModel); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TwrShadowOnWake); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VelocityMethod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TreeBranchFactor); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PartPerSegment); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DTaero); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DTfvw); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%KinVisc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MHK); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WtrDpth); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WrVTK); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VTKBlades); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DTvtk); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VTKCoord); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RootName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VTK_OutFileRoot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VTK_OutFileBase); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nGridOut); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%InductionAtCP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WakeAtTE); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DStallOnWake); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Induction); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%kFrozenNWStart); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%kFrozenNWEnd); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FVW_CopyWng_ContinuousStateType(SrcWng_ContinuousStateTypeData, DstWng_ContinuousStateTypeData, CtrlCode, ErrStat, ErrMsg) + type(Wng_ContinuousStateType), intent(in) :: SrcWng_ContinuousStateTypeData + type(Wng_ContinuousStateType), intent(inout) :: DstWng_ContinuousStateTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'FVW_CopyWng_ContinuousStateType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcWng_ContinuousStateTypeData%Gamma_NW)) then + LB(1:2) = lbound(SrcWng_ContinuousStateTypeData%Gamma_NW) + UB(1:2) = ubound(SrcWng_ContinuousStateTypeData%Gamma_NW) + if (.not. allocated(DstWng_ContinuousStateTypeData%Gamma_NW)) then + allocate(DstWng_ContinuousStateTypeData%Gamma_NW(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_ContinuousStateTypeData%Gamma_NW.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_ContinuousStateTypeData%Gamma_NW = SrcWng_ContinuousStateTypeData%Gamma_NW + end if + if (allocated(SrcWng_ContinuousStateTypeData%Gamma_FW)) then + LB(1:2) = lbound(SrcWng_ContinuousStateTypeData%Gamma_FW) + UB(1:2) = ubound(SrcWng_ContinuousStateTypeData%Gamma_FW) + if (.not. allocated(DstWng_ContinuousStateTypeData%Gamma_FW)) then + allocate(DstWng_ContinuousStateTypeData%Gamma_FW(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_ContinuousStateTypeData%Gamma_FW.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_ContinuousStateTypeData%Gamma_FW = SrcWng_ContinuousStateTypeData%Gamma_FW + end if + if (allocated(SrcWng_ContinuousStateTypeData%Eps_NW)) then + LB(1:3) = lbound(SrcWng_ContinuousStateTypeData%Eps_NW) + UB(1:3) = ubound(SrcWng_ContinuousStateTypeData%Eps_NW) + if (.not. allocated(DstWng_ContinuousStateTypeData%Eps_NW)) then + allocate(DstWng_ContinuousStateTypeData%Eps_NW(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_ContinuousStateTypeData%Eps_NW.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_ContinuousStateTypeData%Eps_NW = SrcWng_ContinuousStateTypeData%Eps_NW + end if + if (allocated(SrcWng_ContinuousStateTypeData%Eps_FW)) then + LB(1:3) = lbound(SrcWng_ContinuousStateTypeData%Eps_FW) + UB(1:3) = ubound(SrcWng_ContinuousStateTypeData%Eps_FW) + if (.not. allocated(DstWng_ContinuousStateTypeData%Eps_FW)) then + allocate(DstWng_ContinuousStateTypeData%Eps_FW(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_ContinuousStateTypeData%Eps_FW.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_ContinuousStateTypeData%Eps_FW = SrcWng_ContinuousStateTypeData%Eps_FW + end if + if (allocated(SrcWng_ContinuousStateTypeData%r_NW)) then + LB(1:3) = lbound(SrcWng_ContinuousStateTypeData%r_NW) + UB(1:3) = ubound(SrcWng_ContinuousStateTypeData%r_NW) + if (.not. allocated(DstWng_ContinuousStateTypeData%r_NW)) then + allocate(DstWng_ContinuousStateTypeData%r_NW(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_ContinuousStateTypeData%r_NW.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_ContinuousStateTypeData%r_NW = SrcWng_ContinuousStateTypeData%r_NW + end if + if (allocated(SrcWng_ContinuousStateTypeData%r_FW)) then + LB(1:3) = lbound(SrcWng_ContinuousStateTypeData%r_FW) + UB(1:3) = ubound(SrcWng_ContinuousStateTypeData%r_FW) + if (.not. allocated(DstWng_ContinuousStateTypeData%r_FW)) then + allocate(DstWng_ContinuousStateTypeData%r_FW(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_ContinuousStateTypeData%r_FW.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_ContinuousStateTypeData%r_FW = SrcWng_ContinuousStateTypeData%r_FW + end if +end subroutine + +subroutine FVW_DestroyWng_ContinuousStateType(Wng_ContinuousStateTypeData, ErrStat, ErrMsg) + type(Wng_ContinuousStateType), intent(inout) :: Wng_ContinuousStateTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FVW_DestroyWng_ContinuousStateType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(Wng_ContinuousStateTypeData%Gamma_NW)) then + deallocate(Wng_ContinuousStateTypeData%Gamma_NW) + end if + if (allocated(Wng_ContinuousStateTypeData%Gamma_FW)) then + deallocate(Wng_ContinuousStateTypeData%Gamma_FW) + end if + if (allocated(Wng_ContinuousStateTypeData%Eps_NW)) then + deallocate(Wng_ContinuousStateTypeData%Eps_NW) + end if + if (allocated(Wng_ContinuousStateTypeData%Eps_FW)) then + deallocate(Wng_ContinuousStateTypeData%Eps_FW) + end if + if (allocated(Wng_ContinuousStateTypeData%r_NW)) then + deallocate(Wng_ContinuousStateTypeData%r_NW) + end if + if (allocated(Wng_ContinuousStateTypeData%r_FW)) then + deallocate(Wng_ContinuousStateTypeData%r_FW) + end if +end subroutine + +subroutine FVW_PackWng_ContinuousStateType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Wng_ContinuousStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FVW_PackWng_ContinuousStateType' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%Gamma_NW) + call RegPackAlloc(RF, InData%Gamma_FW) + call RegPackAlloc(RF, InData%Eps_NW) + call RegPackAlloc(RF, InData%Eps_FW) + call RegPackAlloc(RF, InData%r_NW) + call RegPackAlloc(RF, InData%r_FW) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FVW_UnPackWng_ContinuousStateType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Wng_ContinuousStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FVW_UnPackWng_ContinuousStateType' + integer(B4Ki) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%Gamma_NW); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Gamma_FW); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Eps_NW); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Eps_FW); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%r_NW); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%r_FW); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FVW_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) + type(FVW_ContinuousStateType), intent(in) :: SrcContStateData + type(FVW_ContinuousStateType), intent(inout) :: DstContStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FVW_CopyContState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcContStateData%W)) then + LB(1:1) = lbound(SrcContStateData%W) + UB(1:1) = ubound(SrcContStateData%W) + if (.not. allocated(DstContStateData%W)) then + allocate(DstContStateData%W(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%W.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call FVW_CopyWng_ContinuousStateType(SrcContStateData%W(i1), DstContStateData%W(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcContStateData%UA)) then + LB(1:1) = lbound(SrcContStateData%UA) + UB(1:1) = ubound(SrcContStateData%UA) + if (.not. allocated(DstContStateData%UA)) then + allocate(DstContStateData%UA(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%UA.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call UA_CopyContState(SrcContStateData%UA(i1), DstContStateData%UA(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if +end subroutine + +subroutine FVW_DestroyContState(ContStateData, ErrStat, ErrMsg) + type(FVW_ContinuousStateType), intent(inout) :: ContStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FVW_DestroyContState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ContStateData%W)) then + LB(1:1) = lbound(ContStateData%W) + UB(1:1) = ubound(ContStateData%W) + do i1 = LB(1), UB(1) + call FVW_DestroyWng_ContinuousStateType(ContStateData%W(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ContStateData%W) + end if + if (allocated(ContStateData%UA)) then + LB(1:1) = lbound(ContStateData%UA) + UB(1:1) = ubound(ContStateData%UA) + do i1 = LB(1), UB(1) + call UA_DestroyContState(ContStateData%UA(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ContStateData%UA) + end if +end subroutine + +subroutine FVW_PackContState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(FVW_ContinuousStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FVW_PackContState' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%W)) + if (allocated(InData%W)) then + call RegPackBounds(RF, 1, lbound(InData%W), ubound(InData%W)) + LB(1:1) = lbound(InData%W) + UB(1:1) = ubound(InData%W) + do i1 = LB(1), UB(1) + call FVW_PackWng_ContinuousStateType(RF, InData%W(i1)) + end do + end if + call RegPack(RF, allocated(InData%UA)) + if (allocated(InData%UA)) then + call RegPackBounds(RF, 1, lbound(InData%UA), ubound(InData%UA)) + LB(1:1) = lbound(InData%UA) + UB(1:1) = ubound(InData%UA) + do i1 = LB(1), UB(1) + call UA_PackContState(RF, InData%UA(i1)) + end do + end if + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FVW_UnPackContState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(FVW_ContinuousStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FVW_UnPackContState' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + if (allocated(OutData%W)) deallocate(OutData%W) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%W(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%W.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call FVW_UnpackWng_ContinuousStateType(RF, OutData%W(i1)) ! W + end do + end if + if (allocated(OutData%UA)) deallocate(OutData%UA) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%UA(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%UA.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call UA_UnpackContState(RF, OutData%UA(i1)) ! UA + end do + end if +end subroutine + +subroutine FVW_CopyWng_OutputType(SrcWng_OutputTypeData, DstWng_OutputTypeData, CtrlCode, ErrStat, ErrMsg) + type(Wng_OutputType), intent(in) :: SrcWng_OutputTypeData + type(Wng_OutputType), intent(inout) :: DstWng_OutputTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'FVW_CopyWng_OutputType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcWng_OutputTypeData%Vind)) then + LB(1:2) = lbound(SrcWng_OutputTypeData%Vind) + UB(1:2) = ubound(SrcWng_OutputTypeData%Vind) + if (.not. allocated(DstWng_OutputTypeData%Vind)) then + allocate(DstWng_OutputTypeData%Vind(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_OutputTypeData%Vind.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_OutputTypeData%Vind = SrcWng_OutputTypeData%Vind + end if +end subroutine + +subroutine FVW_DestroyWng_OutputType(Wng_OutputTypeData, ErrStat, ErrMsg) + type(Wng_OutputType), intent(inout) :: Wng_OutputTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FVW_DestroyWng_OutputType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(Wng_OutputTypeData%Vind)) then + deallocate(Wng_OutputTypeData%Vind) + end if +end subroutine + +subroutine FVW_PackWng_OutputType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Wng_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FVW_PackWng_OutputType' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%Vind) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FVW_UnPackWng_OutputType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Wng_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FVW_UnPackWng_OutputType' + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%Vind); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FVW_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(FVW_OutputType), intent(in) :: SrcOutputData + type(FVW_OutputType), intent(inout) :: DstOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FVW_CopyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcOutputData%W)) then + LB(1:1) = lbound(SrcOutputData%W) + UB(1:1) = ubound(SrcOutputData%W) + if (.not. allocated(DstOutputData%W)) then + allocate(DstOutputData%W(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%W.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call FVW_CopyWng_OutputType(SrcOutputData%W(i1), DstOutputData%W(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if +end subroutine + +subroutine FVW_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(FVW_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FVW_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OutputData%W)) then + LB(1:1) = lbound(OutputData%W) + UB(1:1) = ubound(OutputData%W) + do i1 = LB(1), UB(1) + call FVW_DestroyWng_OutputType(OutputData%W(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(OutputData%W) + end if +end subroutine + +subroutine FVW_PackOutput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(FVW_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FVW_PackOutput' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%W)) + if (allocated(InData%W)) then + call RegPackBounds(RF, 1, lbound(InData%W), ubound(InData%W)) + LB(1:1) = lbound(InData%W) + UB(1:1) = ubound(InData%W) + do i1 = LB(1), UB(1) + call FVW_PackWng_OutputType(RF, InData%W(i1)) + end do + end if + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FVW_UnPackOutput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(FVW_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FVW_UnPackOutput' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + if (allocated(OutData%W)) deallocate(OutData%W) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%W(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%W.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call FVW_UnpackWng_OutputType(RF, OutData%W(i1)) ! W + end do + end if +end subroutine + +subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeData, CtrlCode, ErrStat, ErrMsg) + type(Wng_MiscVarType), intent(in) :: SrcWng_MiscVarTypeData + type(Wng_MiscVarType), intent(inout) :: DstWng_MiscVarTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FVW_CopyWng_MiscVarType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcWng_MiscVarTypeData%LE)) then + LB(1:2) = lbound(SrcWng_MiscVarTypeData%LE) + UB(1:2) = ubound(SrcWng_MiscVarTypeData%LE) + if (.not. allocated(DstWng_MiscVarTypeData%LE)) then + allocate(DstWng_MiscVarTypeData%LE(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%LE.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_MiscVarTypeData%LE = SrcWng_MiscVarTypeData%LE + end if + if (allocated(SrcWng_MiscVarTypeData%TE)) then + LB(1:2) = lbound(SrcWng_MiscVarTypeData%TE) + UB(1:2) = ubound(SrcWng_MiscVarTypeData%TE) + if (.not. allocated(DstWng_MiscVarTypeData%TE)) then + allocate(DstWng_MiscVarTypeData%TE(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%TE.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_MiscVarTypeData%TE = SrcWng_MiscVarTypeData%TE + end if + if (allocated(SrcWng_MiscVarTypeData%r_LL)) then + LB(1:3) = lbound(SrcWng_MiscVarTypeData%r_LL) + UB(1:3) = ubound(SrcWng_MiscVarTypeData%r_LL) + if (.not. allocated(DstWng_MiscVarTypeData%r_LL)) then + allocate(DstWng_MiscVarTypeData%r_LL(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%r_LL.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_MiscVarTypeData%r_LL = SrcWng_MiscVarTypeData%r_LL + end if + if (allocated(SrcWng_MiscVarTypeData%CP)) then + LB(1:2) = lbound(SrcWng_MiscVarTypeData%CP) + UB(1:2) = ubound(SrcWng_MiscVarTypeData%CP) + if (.not. allocated(DstWng_MiscVarTypeData%CP)) then + allocate(DstWng_MiscVarTypeData%CP(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%CP.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_MiscVarTypeData%CP = SrcWng_MiscVarTypeData%CP + end if + if (allocated(SrcWng_MiscVarTypeData%Tang)) then + LB(1:2) = lbound(SrcWng_MiscVarTypeData%Tang) + UB(1:2) = ubound(SrcWng_MiscVarTypeData%Tang) + if (.not. allocated(DstWng_MiscVarTypeData%Tang)) then + allocate(DstWng_MiscVarTypeData%Tang(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%Tang.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_MiscVarTypeData%Tang = SrcWng_MiscVarTypeData%Tang + end if + if (allocated(SrcWng_MiscVarTypeData%Norm)) then + LB(1:2) = lbound(SrcWng_MiscVarTypeData%Norm) + UB(1:2) = ubound(SrcWng_MiscVarTypeData%Norm) + if (.not. allocated(DstWng_MiscVarTypeData%Norm)) then + allocate(DstWng_MiscVarTypeData%Norm(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%Norm.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_MiscVarTypeData%Norm = SrcWng_MiscVarTypeData%Norm + end if + if (allocated(SrcWng_MiscVarTypeData%Orth)) then + LB(1:2) = lbound(SrcWng_MiscVarTypeData%Orth) + UB(1:2) = ubound(SrcWng_MiscVarTypeData%Orth) + if (.not. allocated(DstWng_MiscVarTypeData%Orth)) then + allocate(DstWng_MiscVarTypeData%Orth(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%Orth.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_MiscVarTypeData%Orth = SrcWng_MiscVarTypeData%Orth + end if + if (allocated(SrcWng_MiscVarTypeData%dl)) then + LB(1:2) = lbound(SrcWng_MiscVarTypeData%dl) + UB(1:2) = ubound(SrcWng_MiscVarTypeData%dl) + if (.not. allocated(DstWng_MiscVarTypeData%dl)) then + allocate(DstWng_MiscVarTypeData%dl(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%dl.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_MiscVarTypeData%dl = SrcWng_MiscVarTypeData%dl + end if + if (allocated(SrcWng_MiscVarTypeData%Area)) then + LB(1:1) = lbound(SrcWng_MiscVarTypeData%Area) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%Area) + if (.not. allocated(DstWng_MiscVarTypeData%Area)) then + allocate(DstWng_MiscVarTypeData%Area(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%Area.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_MiscVarTypeData%Area = SrcWng_MiscVarTypeData%Area + end if + if (allocated(SrcWng_MiscVarTypeData%diag_LL)) then + LB(1:1) = lbound(SrcWng_MiscVarTypeData%diag_LL) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%diag_LL) + if (.not. allocated(DstWng_MiscVarTypeData%diag_LL)) then + allocate(DstWng_MiscVarTypeData%diag_LL(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%diag_LL.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_MiscVarTypeData%diag_LL = SrcWng_MiscVarTypeData%diag_LL + end if + if (allocated(SrcWng_MiscVarTypeData%Vind_CP)) then + LB(1:2) = lbound(SrcWng_MiscVarTypeData%Vind_CP) + UB(1:2) = ubound(SrcWng_MiscVarTypeData%Vind_CP) + if (.not. allocated(DstWng_MiscVarTypeData%Vind_CP)) then + allocate(DstWng_MiscVarTypeData%Vind_CP(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%Vind_CP.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_MiscVarTypeData%Vind_CP = SrcWng_MiscVarTypeData%Vind_CP + end if + if (allocated(SrcWng_MiscVarTypeData%Vtot_CP)) then + LB(1:2) = lbound(SrcWng_MiscVarTypeData%Vtot_CP) + UB(1:2) = ubound(SrcWng_MiscVarTypeData%Vtot_CP) + if (.not. allocated(DstWng_MiscVarTypeData%Vtot_CP)) then + allocate(DstWng_MiscVarTypeData%Vtot_CP(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%Vtot_CP.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_MiscVarTypeData%Vtot_CP = SrcWng_MiscVarTypeData%Vtot_CP + end if + if (allocated(SrcWng_MiscVarTypeData%Vstr_CP)) then + LB(1:2) = lbound(SrcWng_MiscVarTypeData%Vstr_CP) + UB(1:2) = ubound(SrcWng_MiscVarTypeData%Vstr_CP) + if (.not. allocated(DstWng_MiscVarTypeData%Vstr_CP)) then + allocate(DstWng_MiscVarTypeData%Vstr_CP(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%Vstr_CP.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_MiscVarTypeData%Vstr_CP = SrcWng_MiscVarTypeData%Vstr_CP + end if + if (allocated(SrcWng_MiscVarTypeData%Vwnd_CP)) then + LB(1:2) = lbound(SrcWng_MiscVarTypeData%Vwnd_CP) + UB(1:2) = ubound(SrcWng_MiscVarTypeData%Vwnd_CP) + if (.not. allocated(DstWng_MiscVarTypeData%Vwnd_CP)) then + allocate(DstWng_MiscVarTypeData%Vwnd_CP(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%Vwnd_CP.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_MiscVarTypeData%Vwnd_CP = SrcWng_MiscVarTypeData%Vwnd_CP + end if + if (allocated(SrcWng_MiscVarTypeData%Vwnd_NW)) then + LB(1:3) = lbound(SrcWng_MiscVarTypeData%Vwnd_NW) + UB(1:3) = ubound(SrcWng_MiscVarTypeData%Vwnd_NW) + if (.not. allocated(DstWng_MiscVarTypeData%Vwnd_NW)) then + allocate(DstWng_MiscVarTypeData%Vwnd_NW(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%Vwnd_NW.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_MiscVarTypeData%Vwnd_NW = SrcWng_MiscVarTypeData%Vwnd_NW + end if + if (allocated(SrcWng_MiscVarTypeData%Vwnd_FW)) then + LB(1:3) = lbound(SrcWng_MiscVarTypeData%Vwnd_FW) + UB(1:3) = ubound(SrcWng_MiscVarTypeData%Vwnd_FW) + if (.not. allocated(DstWng_MiscVarTypeData%Vwnd_FW)) then + allocate(DstWng_MiscVarTypeData%Vwnd_FW(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%Vwnd_FW.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_MiscVarTypeData%Vwnd_FW = SrcWng_MiscVarTypeData%Vwnd_FW + end if + if (allocated(SrcWng_MiscVarTypeData%Vind_NW)) then + LB(1:3) = lbound(SrcWng_MiscVarTypeData%Vind_NW) + UB(1:3) = ubound(SrcWng_MiscVarTypeData%Vind_NW) + if (.not. allocated(DstWng_MiscVarTypeData%Vind_NW)) then + allocate(DstWng_MiscVarTypeData%Vind_NW(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%Vind_NW.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_MiscVarTypeData%Vind_NW = SrcWng_MiscVarTypeData%Vind_NW + end if + if (allocated(SrcWng_MiscVarTypeData%Vind_FW)) then + LB(1:3) = lbound(SrcWng_MiscVarTypeData%Vind_FW) + UB(1:3) = ubound(SrcWng_MiscVarTypeData%Vind_FW) + if (.not. allocated(DstWng_MiscVarTypeData%Vind_FW)) then + allocate(DstWng_MiscVarTypeData%Vind_FW(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%Vind_FW.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_MiscVarTypeData%Vind_FW = SrcWng_MiscVarTypeData%Vind_FW + end if + if (allocated(SrcWng_MiscVarTypeData%PitchAndTwist)) then + LB(1:1) = lbound(SrcWng_MiscVarTypeData%PitchAndTwist) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%PitchAndTwist) + if (.not. allocated(DstWng_MiscVarTypeData%PitchAndTwist)) then + allocate(DstWng_MiscVarTypeData%PitchAndTwist(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%PitchAndTwist.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_MiscVarTypeData%PitchAndTwist = SrcWng_MiscVarTypeData%PitchAndTwist + end if + DstWng_MiscVarTypeData%iTip = SrcWng_MiscVarTypeData%iTip + DstWng_MiscVarTypeData%iRoot = SrcWng_MiscVarTypeData%iRoot + if (allocated(SrcWng_MiscVarTypeData%alpha_LL)) then + LB(1:1) = lbound(SrcWng_MiscVarTypeData%alpha_LL) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%alpha_LL) + if (.not. allocated(DstWng_MiscVarTypeData%alpha_LL)) then + allocate(DstWng_MiscVarTypeData%alpha_LL(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%alpha_LL.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_MiscVarTypeData%alpha_LL = SrcWng_MiscVarTypeData%alpha_LL + end if + if (allocated(SrcWng_MiscVarTypeData%Vreln_LL)) then + LB(1:1) = lbound(SrcWng_MiscVarTypeData%Vreln_LL) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%Vreln_LL) + if (.not. allocated(DstWng_MiscVarTypeData%Vreln_LL)) then + allocate(DstWng_MiscVarTypeData%Vreln_LL(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%Vreln_LL.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_MiscVarTypeData%Vreln_LL = SrcWng_MiscVarTypeData%Vreln_LL + end if + if (allocated(SrcWng_MiscVarTypeData%u_UA)) then + LB(1:2) = lbound(SrcWng_MiscVarTypeData%u_UA) + UB(1:2) = ubound(SrcWng_MiscVarTypeData%u_UA) + if (.not. allocated(DstWng_MiscVarTypeData%u_UA)) then + allocate(DstWng_MiscVarTypeData%u_UA(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%u_UA.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call UA_CopyInput(SrcWng_MiscVarTypeData%u_UA(i1,i2), DstWng_MiscVarTypeData%u_UA(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do + end if + call UA_CopyMisc(SrcWng_MiscVarTypeData%m_UA, DstWng_MiscVarTypeData%m_UA, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call UA_CopyOutput(SrcWng_MiscVarTypeData%y_UA, DstWng_MiscVarTypeData%y_UA, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call UA_CopyParam(SrcWng_MiscVarTypeData%p_UA, DstWng_MiscVarTypeData%p_UA, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcWng_MiscVarTypeData%Vind_LL)) then + LB(1:2) = lbound(SrcWng_MiscVarTypeData%Vind_LL) + UB(1:2) = ubound(SrcWng_MiscVarTypeData%Vind_LL) + if (.not. allocated(DstWng_MiscVarTypeData%Vind_LL)) then + allocate(DstWng_MiscVarTypeData%Vind_LL(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%Vind_LL.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_MiscVarTypeData%Vind_LL = SrcWng_MiscVarTypeData%Vind_LL + end if + if (allocated(SrcWng_MiscVarTypeData%BN_AxInd)) then + LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_AxInd) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_AxInd) + if (.not. allocated(DstWng_MiscVarTypeData%BN_AxInd)) then + allocate(DstWng_MiscVarTypeData%BN_AxInd(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%BN_AxInd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_MiscVarTypeData%BN_AxInd = SrcWng_MiscVarTypeData%BN_AxInd + end if + if (allocated(SrcWng_MiscVarTypeData%BN_TanInd)) then + LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_TanInd) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_TanInd) + if (.not. allocated(DstWng_MiscVarTypeData%BN_TanInd)) then + allocate(DstWng_MiscVarTypeData%BN_TanInd(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%BN_TanInd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_MiscVarTypeData%BN_TanInd = SrcWng_MiscVarTypeData%BN_TanInd + end if + if (allocated(SrcWng_MiscVarTypeData%BN_Vrel)) then + LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_Vrel) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_Vrel) + if (.not. allocated(DstWng_MiscVarTypeData%BN_Vrel)) then + allocate(DstWng_MiscVarTypeData%BN_Vrel(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%BN_Vrel.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_MiscVarTypeData%BN_Vrel = SrcWng_MiscVarTypeData%BN_Vrel + end if + if (allocated(SrcWng_MiscVarTypeData%BN_alpha)) then + LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_alpha) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_alpha) + if (.not. allocated(DstWng_MiscVarTypeData%BN_alpha)) then + allocate(DstWng_MiscVarTypeData%BN_alpha(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%BN_alpha.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_MiscVarTypeData%BN_alpha = SrcWng_MiscVarTypeData%BN_alpha + end if + if (allocated(SrcWng_MiscVarTypeData%BN_phi)) then + LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_phi) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_phi) + if (.not. allocated(DstWng_MiscVarTypeData%BN_phi)) then + allocate(DstWng_MiscVarTypeData%BN_phi(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%BN_phi.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_MiscVarTypeData%BN_phi = SrcWng_MiscVarTypeData%BN_phi + end if + if (allocated(SrcWng_MiscVarTypeData%BN_Re)) then + LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_Re) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_Re) + if (.not. allocated(DstWng_MiscVarTypeData%BN_Re)) then + allocate(DstWng_MiscVarTypeData%BN_Re(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%BN_Re.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_MiscVarTypeData%BN_Re = SrcWng_MiscVarTypeData%BN_Re + end if + if (allocated(SrcWng_MiscVarTypeData%BN_URelWind_s)) then + LB(1:2) = lbound(SrcWng_MiscVarTypeData%BN_URelWind_s) + UB(1:2) = ubound(SrcWng_MiscVarTypeData%BN_URelWind_s) + if (.not. allocated(DstWng_MiscVarTypeData%BN_URelWind_s)) then + allocate(DstWng_MiscVarTypeData%BN_URelWind_s(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%BN_URelWind_s.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_MiscVarTypeData%BN_URelWind_s = SrcWng_MiscVarTypeData%BN_URelWind_s + end if + if (allocated(SrcWng_MiscVarTypeData%BN_Cl_Static)) then + LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_Cl_Static) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_Cl_Static) + if (.not. allocated(DstWng_MiscVarTypeData%BN_Cl_Static)) then + allocate(DstWng_MiscVarTypeData%BN_Cl_Static(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%BN_Cl_Static.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_MiscVarTypeData%BN_Cl_Static = SrcWng_MiscVarTypeData%BN_Cl_Static + end if + if (allocated(SrcWng_MiscVarTypeData%BN_Cd_Static)) then + LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_Cd_Static) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_Cd_Static) + if (.not. allocated(DstWng_MiscVarTypeData%BN_Cd_Static)) then + allocate(DstWng_MiscVarTypeData%BN_Cd_Static(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%BN_Cd_Static.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_MiscVarTypeData%BN_Cd_Static = SrcWng_MiscVarTypeData%BN_Cd_Static + end if + if (allocated(SrcWng_MiscVarTypeData%BN_Cm_Static)) then + LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_Cm_Static) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_Cm_Static) + if (.not. allocated(DstWng_MiscVarTypeData%BN_Cm_Static)) then + allocate(DstWng_MiscVarTypeData%BN_Cm_Static(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%BN_Cm_Static.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_MiscVarTypeData%BN_Cm_Static = SrcWng_MiscVarTypeData%BN_Cm_Static + end if + if (allocated(SrcWng_MiscVarTypeData%BN_Cpmin)) then + LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_Cpmin) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_Cpmin) + if (.not. allocated(DstWng_MiscVarTypeData%BN_Cpmin)) then + allocate(DstWng_MiscVarTypeData%BN_Cpmin(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%BN_Cpmin.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_MiscVarTypeData%BN_Cpmin = SrcWng_MiscVarTypeData%BN_Cpmin + end if + if (allocated(SrcWng_MiscVarTypeData%BN_Cl)) then + LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_Cl) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_Cl) + if (.not. allocated(DstWng_MiscVarTypeData%BN_Cl)) then + allocate(DstWng_MiscVarTypeData%BN_Cl(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%BN_Cl.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_MiscVarTypeData%BN_Cl = SrcWng_MiscVarTypeData%BN_Cl + end if + if (allocated(SrcWng_MiscVarTypeData%BN_Cd)) then + LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_Cd) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_Cd) + if (.not. allocated(DstWng_MiscVarTypeData%BN_Cd)) then + allocate(DstWng_MiscVarTypeData%BN_Cd(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%BN_Cd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_MiscVarTypeData%BN_Cd = SrcWng_MiscVarTypeData%BN_Cd + end if + if (allocated(SrcWng_MiscVarTypeData%BN_Cm)) then + LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_Cm) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_Cm) + if (.not. allocated(DstWng_MiscVarTypeData%BN_Cm)) then + allocate(DstWng_MiscVarTypeData%BN_Cm(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%BN_Cm.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_MiscVarTypeData%BN_Cm = SrcWng_MiscVarTypeData%BN_Cm + end if + if (allocated(SrcWng_MiscVarTypeData%BN_Cx)) then + LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_Cx) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_Cx) + if (.not. allocated(DstWng_MiscVarTypeData%BN_Cx)) then + allocate(DstWng_MiscVarTypeData%BN_Cx(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%BN_Cx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_MiscVarTypeData%BN_Cx = SrcWng_MiscVarTypeData%BN_Cx + end if + if (allocated(SrcWng_MiscVarTypeData%BN_Cy)) then + LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_Cy) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_Cy) + if (.not. allocated(DstWng_MiscVarTypeData%BN_Cy)) then + allocate(DstWng_MiscVarTypeData%BN_Cy(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%BN_Cy.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_MiscVarTypeData%BN_Cy = SrcWng_MiscVarTypeData%BN_Cy + end if +end subroutine + +subroutine FVW_DestroyWng_MiscVarType(Wng_MiscVarTypeData, ErrStat, ErrMsg) + type(Wng_MiscVarType), intent(inout) :: Wng_MiscVarTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FVW_DestroyWng_MiscVarType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(Wng_MiscVarTypeData%LE)) then + deallocate(Wng_MiscVarTypeData%LE) + end if + if (allocated(Wng_MiscVarTypeData%TE)) then + deallocate(Wng_MiscVarTypeData%TE) + end if + if (allocated(Wng_MiscVarTypeData%r_LL)) then + deallocate(Wng_MiscVarTypeData%r_LL) + end if + if (allocated(Wng_MiscVarTypeData%CP)) then + deallocate(Wng_MiscVarTypeData%CP) + end if + if (allocated(Wng_MiscVarTypeData%Tang)) then + deallocate(Wng_MiscVarTypeData%Tang) + end if + if (allocated(Wng_MiscVarTypeData%Norm)) then + deallocate(Wng_MiscVarTypeData%Norm) + end if + if (allocated(Wng_MiscVarTypeData%Orth)) then + deallocate(Wng_MiscVarTypeData%Orth) + end if + if (allocated(Wng_MiscVarTypeData%dl)) then + deallocate(Wng_MiscVarTypeData%dl) + end if + if (allocated(Wng_MiscVarTypeData%Area)) then + deallocate(Wng_MiscVarTypeData%Area) + end if + if (allocated(Wng_MiscVarTypeData%diag_LL)) then + deallocate(Wng_MiscVarTypeData%diag_LL) + end if + if (allocated(Wng_MiscVarTypeData%Vind_CP)) then + deallocate(Wng_MiscVarTypeData%Vind_CP) + end if + if (allocated(Wng_MiscVarTypeData%Vtot_CP)) then + deallocate(Wng_MiscVarTypeData%Vtot_CP) + end if + if (allocated(Wng_MiscVarTypeData%Vstr_CP)) then + deallocate(Wng_MiscVarTypeData%Vstr_CP) + end if + if (allocated(Wng_MiscVarTypeData%Vwnd_CP)) then + deallocate(Wng_MiscVarTypeData%Vwnd_CP) + end if + if (allocated(Wng_MiscVarTypeData%Vwnd_NW)) then + deallocate(Wng_MiscVarTypeData%Vwnd_NW) + end if + if (allocated(Wng_MiscVarTypeData%Vwnd_FW)) then + deallocate(Wng_MiscVarTypeData%Vwnd_FW) + end if + if (allocated(Wng_MiscVarTypeData%Vind_NW)) then + deallocate(Wng_MiscVarTypeData%Vind_NW) + end if + if (allocated(Wng_MiscVarTypeData%Vind_FW)) then + deallocate(Wng_MiscVarTypeData%Vind_FW) + end if + if (allocated(Wng_MiscVarTypeData%PitchAndTwist)) then + deallocate(Wng_MiscVarTypeData%PitchAndTwist) + end if + if (allocated(Wng_MiscVarTypeData%alpha_LL)) then + deallocate(Wng_MiscVarTypeData%alpha_LL) + end if + if (allocated(Wng_MiscVarTypeData%Vreln_LL)) then + deallocate(Wng_MiscVarTypeData%Vreln_LL) + end if + if (allocated(Wng_MiscVarTypeData%u_UA)) then + LB(1:2) = lbound(Wng_MiscVarTypeData%u_UA) + UB(1:2) = ubound(Wng_MiscVarTypeData%u_UA) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call UA_DestroyInput(Wng_MiscVarTypeData%u_UA(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + deallocate(Wng_MiscVarTypeData%u_UA) + end if + call UA_DestroyMisc(Wng_MiscVarTypeData%m_UA, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call UA_DestroyOutput(Wng_MiscVarTypeData%y_UA, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call UA_DestroyParam(Wng_MiscVarTypeData%p_UA, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(Wng_MiscVarTypeData%Vind_LL)) then + deallocate(Wng_MiscVarTypeData%Vind_LL) + end if + if (allocated(Wng_MiscVarTypeData%BN_AxInd)) then + deallocate(Wng_MiscVarTypeData%BN_AxInd) + end if + if (allocated(Wng_MiscVarTypeData%BN_TanInd)) then + deallocate(Wng_MiscVarTypeData%BN_TanInd) + end if + if (allocated(Wng_MiscVarTypeData%BN_Vrel)) then + deallocate(Wng_MiscVarTypeData%BN_Vrel) + end if + if (allocated(Wng_MiscVarTypeData%BN_alpha)) then + deallocate(Wng_MiscVarTypeData%BN_alpha) + end if + if (allocated(Wng_MiscVarTypeData%BN_phi)) then + deallocate(Wng_MiscVarTypeData%BN_phi) + end if + if (allocated(Wng_MiscVarTypeData%BN_Re)) then + deallocate(Wng_MiscVarTypeData%BN_Re) + end if + if (allocated(Wng_MiscVarTypeData%BN_URelWind_s)) then + deallocate(Wng_MiscVarTypeData%BN_URelWind_s) + end if + if (allocated(Wng_MiscVarTypeData%BN_Cl_Static)) then + deallocate(Wng_MiscVarTypeData%BN_Cl_Static) + end if + if (allocated(Wng_MiscVarTypeData%BN_Cd_Static)) then + deallocate(Wng_MiscVarTypeData%BN_Cd_Static) + end if + if (allocated(Wng_MiscVarTypeData%BN_Cm_Static)) then + deallocate(Wng_MiscVarTypeData%BN_Cm_Static) + end if + if (allocated(Wng_MiscVarTypeData%BN_Cpmin)) then + deallocate(Wng_MiscVarTypeData%BN_Cpmin) + end if + if (allocated(Wng_MiscVarTypeData%BN_Cl)) then + deallocate(Wng_MiscVarTypeData%BN_Cl) + end if + if (allocated(Wng_MiscVarTypeData%BN_Cd)) then + deallocate(Wng_MiscVarTypeData%BN_Cd) + end if + if (allocated(Wng_MiscVarTypeData%BN_Cm)) then + deallocate(Wng_MiscVarTypeData%BN_Cm) + end if + if (allocated(Wng_MiscVarTypeData%BN_Cx)) then + deallocate(Wng_MiscVarTypeData%BN_Cx) + end if + if (allocated(Wng_MiscVarTypeData%BN_Cy)) then + deallocate(Wng_MiscVarTypeData%BN_Cy) + end if +end subroutine + +subroutine FVW_PackWng_MiscVarType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Wng_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FVW_PackWng_MiscVarType' + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%LE) + call RegPackAlloc(RF, InData%TE) + call RegPackAlloc(RF, InData%r_LL) + call RegPackAlloc(RF, InData%CP) + call RegPackAlloc(RF, InData%Tang) + call RegPackAlloc(RF, InData%Norm) + call RegPackAlloc(RF, InData%Orth) + call RegPackAlloc(RF, InData%dl) + call RegPackAlloc(RF, InData%Area) + call RegPackAlloc(RF, InData%diag_LL) + call RegPackAlloc(RF, InData%Vind_CP) + call RegPackAlloc(RF, InData%Vtot_CP) + call RegPackAlloc(RF, InData%Vstr_CP) + call RegPackAlloc(RF, InData%Vwnd_CP) + call RegPackAlloc(RF, InData%Vwnd_NW) + call RegPackAlloc(RF, InData%Vwnd_FW) + call RegPackAlloc(RF, InData%Vind_NW) + call RegPackAlloc(RF, InData%Vind_FW) + call RegPackAlloc(RF, InData%PitchAndTwist) + call RegPack(RF, InData%iTip) + call RegPack(RF, InData%iRoot) + call RegPackAlloc(RF, InData%alpha_LL) + call RegPackAlloc(RF, InData%Vreln_LL) + call RegPack(RF, allocated(InData%u_UA)) + if (allocated(InData%u_UA)) then + call RegPackBounds(RF, 2, lbound(InData%u_UA), ubound(InData%u_UA)) + LB(1:2) = lbound(InData%u_UA) + UB(1:2) = ubound(InData%u_UA) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call UA_PackInput(RF, InData%u_UA(i1,i2)) + end do + end do + end if + call UA_PackMisc(RF, InData%m_UA) + call UA_PackOutput(RF, InData%y_UA) + call UA_PackParam(RF, InData%p_UA) + call RegPackAlloc(RF, InData%Vind_LL) + call RegPackAlloc(RF, InData%BN_AxInd) + call RegPackAlloc(RF, InData%BN_TanInd) + call RegPackAlloc(RF, InData%BN_Vrel) + call RegPackAlloc(RF, InData%BN_alpha) + call RegPackAlloc(RF, InData%BN_phi) + call RegPackAlloc(RF, InData%BN_Re) + call RegPackAlloc(RF, InData%BN_URelWind_s) + call RegPackAlloc(RF, InData%BN_Cl_Static) + call RegPackAlloc(RF, InData%BN_Cd_Static) + call RegPackAlloc(RF, InData%BN_Cm_Static) + call RegPackAlloc(RF, InData%BN_Cpmin) + call RegPackAlloc(RF, InData%BN_Cl) + call RegPackAlloc(RF, InData%BN_Cd) + call RegPackAlloc(RF, InData%BN_Cm) + call RegPackAlloc(RF, InData%BN_Cx) + call RegPackAlloc(RF, InData%BN_Cy) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FVW_UnPackWng_MiscVarType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Wng_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FVW_UnPackWng_MiscVarType' + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%LE); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TE); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%r_LL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%CP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Tang); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Norm); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Orth); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dl); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Area); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%diag_LL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Vind_CP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Vtot_CP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Vstr_CP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Vwnd_CP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Vwnd_NW); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Vwnd_FW); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Vind_NW); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Vind_FW); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PitchAndTwist); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iTip); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iRoot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%alpha_LL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Vreln_LL); if (RegCheckErr(RF, RoutineName)) return + if (allocated(OutData%u_UA)) deallocate(OutData%u_UA) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%u_UA(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_UA.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call UA_UnpackInput(RF, OutData%u_UA(i1,i2)) ! u_UA + end do + end do + end if + call UA_UnpackMisc(RF, OutData%m_UA) ! m_UA + call UA_UnpackOutput(RF, OutData%y_UA) ! y_UA + call UA_UnpackParam(RF, OutData%p_UA) ! p_UA + call RegUnpackAlloc(RF, OutData%Vind_LL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BN_AxInd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BN_TanInd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BN_Vrel); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BN_alpha); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BN_phi); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BN_Re); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BN_URelWind_s); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BN_Cl_Static); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BN_Cd_Static); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BN_Cm_Static); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BN_Cpmin); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BN_Cl); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BN_Cd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BN_Cm); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BN_Cx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BN_Cy); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FVW_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(FVW_MiscVarType), intent(in) :: SrcMiscData + type(FVW_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FVW_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcMiscData%W)) then + LB(1:1) = lbound(SrcMiscData%W) + UB(1:1) = ubound(SrcMiscData%W) + if (.not. allocated(DstMiscData%W)) then + allocate(DstMiscData%W(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%W.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call FVW_CopyWng_MiscVarType(SrcMiscData%W(i1), DstMiscData%W(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + DstMiscData%FirstCall = SrcMiscData%FirstCall + DstMiscData%nNW = SrcMiscData%nNW + DstMiscData%nFW = SrcMiscData%nFW + DstMiscData%iStep = SrcMiscData%iStep + DstMiscData%VTKstep = SrcMiscData%VTKstep + DstMiscData%VTKlastTime = SrcMiscData%VTKlastTime + if (allocated(SrcMiscData%r_wind)) then + LB(1:2) = lbound(SrcMiscData%r_wind) + UB(1:2) = ubound(SrcMiscData%r_wind) + if (.not. allocated(DstMiscData%r_wind)) then + allocate(DstMiscData%r_wind(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%r_wind.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%r_wind = SrcMiscData%r_wind + end if + DstMiscData%ComputeWakeInduced = SrcMiscData%ComputeWakeInduced + DstMiscData%OldWakeTime = SrcMiscData%OldWakeTime + call FVW_CopyContState(SrcMiscData%dxdt, DstMiscData%dxdt, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FVW_CopyContState(SrcMiscData%x1, DstMiscData%x1, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FVW_CopyContState(SrcMiscData%x2, DstMiscData%x2, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstMiscData%t1 = SrcMiscData%t1 + DstMiscData%t2 = SrcMiscData%t2 + DstMiscData%UA_Flag = SrcMiscData%UA_Flag + call FVW_CopyT_Sgmt(SrcMiscData%Sgmt, DstMiscData%Sgmt, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FVW_CopyT_Part(SrcMiscData%Part, DstMiscData%Part, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcMiscData%CPs)) then + LB(1:2) = lbound(SrcMiscData%CPs) + UB(1:2) = ubound(SrcMiscData%CPs) + if (.not. allocated(DstMiscData%CPs)) then + allocate(DstMiscData%CPs(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%CPs.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%CPs = SrcMiscData%CPs + end if + if (allocated(SrcMiscData%Uind)) then + LB(1:2) = lbound(SrcMiscData%Uind) + UB(1:2) = ubound(SrcMiscData%Uind) + if (.not. allocated(DstMiscData%Uind)) then + allocate(DstMiscData%Uind(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Uind.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%Uind = SrcMiscData%Uind + end if + if (allocated(SrcMiscData%GridOutputs)) then + LB(1:1) = lbound(SrcMiscData%GridOutputs) + UB(1:1) = ubound(SrcMiscData%GridOutputs) + if (.not. allocated(DstMiscData%GridOutputs)) then + allocate(DstMiscData%GridOutputs(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%GridOutputs.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call FVW_CopyGridOutType(SrcMiscData%GridOutputs(i1), DstMiscData%GridOutputs(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + DstMiscData%InfoReeval = SrcMiscData%InfoReeval +end subroutine + +subroutine FVW_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(FVW_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FVW_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(MiscData%W)) then + LB(1:1) = lbound(MiscData%W) + UB(1:1) = ubound(MiscData%W) + do i1 = LB(1), UB(1) + call FVW_DestroyWng_MiscVarType(MiscData%W(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%W) + end if + if (allocated(MiscData%r_wind)) then + deallocate(MiscData%r_wind) + end if + call FVW_DestroyContState(MiscData%dxdt, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FVW_DestroyContState(MiscData%x1, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FVW_DestroyContState(MiscData%x2, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FVW_DestroyT_Sgmt(MiscData%Sgmt, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FVW_DestroyT_Part(MiscData%Part, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(MiscData%CPs)) then + deallocate(MiscData%CPs) + end if + if (allocated(MiscData%Uind)) then + deallocate(MiscData%Uind) + end if + if (allocated(MiscData%GridOutputs)) then + LB(1:1) = lbound(MiscData%GridOutputs) + UB(1:1) = ubound(MiscData%GridOutputs) + do i1 = LB(1), UB(1) + call FVW_DestroyGridOutType(MiscData%GridOutputs(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%GridOutputs) + end if +end subroutine + +subroutine FVW_PackMisc(RF, Indata) + type(RegFile), intent(inout) :: RF + type(FVW_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FVW_PackMisc' + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%W)) + if (allocated(InData%W)) then + call RegPackBounds(RF, 1, lbound(InData%W), ubound(InData%W)) + LB(1:1) = lbound(InData%W) + UB(1:1) = ubound(InData%W) + do i1 = LB(1), UB(1) + call FVW_PackWng_MiscVarType(RF, InData%W(i1)) + end do + end if + call RegPack(RF, InData%FirstCall) + call RegPack(RF, InData%nNW) + call RegPack(RF, InData%nFW) + call RegPack(RF, InData%iStep) + call RegPack(RF, InData%VTKstep) + call RegPack(RF, InData%VTKlastTime) + call RegPackAlloc(RF, InData%r_wind) + call RegPack(RF, InData%ComputeWakeInduced) + call RegPack(RF, InData%OldWakeTime) + call FVW_PackContState(RF, InData%dxdt) + call FVW_PackContState(RF, InData%x1) + call FVW_PackContState(RF, InData%x2) + call RegPack(RF, InData%t1) + call RegPack(RF, InData%t2) + call RegPack(RF, InData%UA_Flag) + call FVW_PackT_Sgmt(RF, InData%Sgmt) + call FVW_PackT_Part(RF, InData%Part) + call RegPackAlloc(RF, InData%CPs) + call RegPackAlloc(RF, InData%Uind) + call RegPack(RF, allocated(InData%GridOutputs)) + if (allocated(InData%GridOutputs)) then + call RegPackBounds(RF, 1, lbound(InData%GridOutputs), ubound(InData%GridOutputs)) + LB(1:1) = lbound(InData%GridOutputs) + UB(1:1) = ubound(InData%GridOutputs) + do i1 = LB(1), UB(1) + call FVW_PackGridOutType(RF, InData%GridOutputs(i1)) + end do + end if + call RegPack(RF, InData%InfoReeval) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FVW_UnPackMisc(RF, OutData) + type(RegFile), intent(inout) :: RF + type(FVW_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FVW_UnPackMisc' + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + if (allocated(OutData%W)) deallocate(OutData%W) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%W(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%W.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call FVW_UnpackWng_MiscVarType(RF, OutData%W(i1)) ! W + end do + end if + call RegUnpack(RF, OutData%FirstCall); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nNW); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nFW); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iStep); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VTKstep); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VTKlastTime); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%r_wind); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ComputeWakeInduced); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OldWakeTime); if (RegCheckErr(RF, RoutineName)) return + call FVW_UnpackContState(RF, OutData%dxdt) ! dxdt + call FVW_UnpackContState(RF, OutData%x1) ! x1 + call FVW_UnpackContState(RF, OutData%x2) ! x2 + call RegUnpack(RF, OutData%t1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%t2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UA_Flag); if (RegCheckErr(RF, RoutineName)) return + call FVW_UnpackT_Sgmt(RF, OutData%Sgmt) ! Sgmt + call FVW_UnpackT_Part(RF, OutData%Part) ! Part + call RegUnpackAlloc(RF, OutData%CPs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Uind); if (RegCheckErr(RF, RoutineName)) return + if (allocated(OutData%GridOutputs)) deallocate(OutData%GridOutputs) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%GridOutputs(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%GridOutputs.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call FVW_UnpackGridOutType(RF, OutData%GridOutputs(i1)) ! GridOutputs + end do + end if + call RegUnpack(RF, OutData%InfoReeval); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FVW_CopyRot_InputType(SrcRot_InputTypeData, DstRot_InputTypeData, CtrlCode, ErrStat, ErrMsg) + type(Rot_InputType), intent(in) :: SrcRot_InputTypeData + type(Rot_InputType), intent(inout) :: DstRot_InputTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FVW_CopyRot_InputType' + ErrStat = ErrID_None + ErrMsg = '' + DstRot_InputTypeData%HubOrientation = SrcRot_InputTypeData%HubOrientation + DstRot_InputTypeData%HubPosition = SrcRot_InputTypeData%HubPosition +end subroutine + +subroutine FVW_DestroyRot_InputType(Rot_InputTypeData, ErrStat, ErrMsg) + type(Rot_InputType), intent(inout) :: Rot_InputTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FVW_DestroyRot_InputType' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine FVW_PackRot_InputType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Rot_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FVW_PackRot_InputType' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%HubOrientation) + call RegPack(RF, InData%HubPosition) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FVW_UnPackRot_InputType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Rot_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FVW_UnPackRot_InputType' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%HubOrientation); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HubPosition); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FVW_CopyWng_InputType(SrcWng_InputTypeData, DstWng_InputTypeData, CtrlCode, ErrStat, ErrMsg) + type(Wng_InputType), intent(in) :: SrcWng_InputTypeData + type(Wng_InputType), intent(inout) :: DstWng_InputTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'FVW_CopyWng_InputType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcWng_InputTypeData%Vwnd_LL)) then + LB(1:2) = lbound(SrcWng_InputTypeData%Vwnd_LL) + UB(1:2) = ubound(SrcWng_InputTypeData%Vwnd_LL) + if (.not. allocated(DstWng_InputTypeData%Vwnd_LL)) then + allocate(DstWng_InputTypeData%Vwnd_LL(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_InputTypeData%Vwnd_LL.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_InputTypeData%Vwnd_LL = SrcWng_InputTypeData%Vwnd_LL + end if + if (allocated(SrcWng_InputTypeData%omega_z)) then + LB(1:1) = lbound(SrcWng_InputTypeData%omega_z) + UB(1:1) = ubound(SrcWng_InputTypeData%omega_z) + if (.not. allocated(DstWng_InputTypeData%omega_z)) then + allocate(DstWng_InputTypeData%omega_z(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_InputTypeData%omega_z.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_InputTypeData%omega_z = SrcWng_InputTypeData%omega_z + end if +end subroutine + +subroutine FVW_DestroyWng_InputType(Wng_InputTypeData, ErrStat, ErrMsg) + type(Wng_InputType), intent(inout) :: Wng_InputTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FVW_DestroyWng_InputType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(Wng_InputTypeData%Vwnd_LL)) then + deallocate(Wng_InputTypeData%Vwnd_LL) + end if + if (allocated(Wng_InputTypeData%omega_z)) then + deallocate(Wng_InputTypeData%omega_z) + end if +end subroutine + +subroutine FVW_PackWng_InputType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Wng_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FVW_PackWng_InputType' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%Vwnd_LL) + call RegPackAlloc(RF, InData%omega_z) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FVW_UnPackWng_InputType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Wng_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FVW_UnPackWng_InputType' + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%Vwnd_LL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%omega_z); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FVW_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) + type(FVW_InputType), intent(inout) :: SrcInputData + type(FVW_InputType), intent(inout) :: DstInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FVW_CopyInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcInputData%rotors)) then + LB(1:1) = lbound(SrcInputData%rotors) + UB(1:1) = ubound(SrcInputData%rotors) + if (.not. allocated(DstInputData%rotors)) then + allocate(DstInputData%rotors(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%rotors.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call FVW_CopyRot_InputType(SrcInputData%rotors(i1), DstInputData%rotors(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcInputData%W)) then + LB(1:1) = lbound(SrcInputData%W) + UB(1:1) = ubound(SrcInputData%W) + if (.not. allocated(DstInputData%W)) then + allocate(DstInputData%W(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%W.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call FVW_CopyWng_InputType(SrcInputData%W(i1), DstInputData%W(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcInputData%WingsMesh)) then + LB(1:1) = lbound(SrcInputData%WingsMesh) + UB(1:1) = ubound(SrcInputData%WingsMesh) + if (.not. allocated(DstInputData%WingsMesh)) then + allocate(DstInputData%WingsMesh(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%WingsMesh.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MeshCopy(SrcInputData%WingsMesh(i1), DstInputData%WingsMesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcInputData%V_wind)) then + LB(1:2) = lbound(SrcInputData%V_wind) + UB(1:2) = ubound(SrcInputData%V_wind) + if (.not. allocated(DstInputData%V_wind)) then + allocate(DstInputData%V_wind(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%V_wind.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%V_wind = SrcInputData%V_wind + end if +end subroutine + +subroutine FVW_DestroyInput(InputData, ErrStat, ErrMsg) + type(FVW_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FVW_DestroyInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InputData%rotors)) then + LB(1:1) = lbound(InputData%rotors) + UB(1:1) = ubound(InputData%rotors) + do i1 = LB(1), UB(1) + call FVW_DestroyRot_InputType(InputData%rotors(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InputData%rotors) + end if + if (allocated(InputData%W)) then + LB(1:1) = lbound(InputData%W) + UB(1:1) = ubound(InputData%W) + do i1 = LB(1), UB(1) + call FVW_DestroyWng_InputType(InputData%W(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InputData%W) + end if + if (allocated(InputData%WingsMesh)) then + LB(1:1) = lbound(InputData%WingsMesh) + UB(1:1) = ubound(InputData%WingsMesh) + do i1 = LB(1), UB(1) + call MeshDestroy( InputData%WingsMesh(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InputData%WingsMesh) + end if + if (allocated(InputData%V_wind)) then + deallocate(InputData%V_wind) + end if +end subroutine + +subroutine FVW_PackInput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(FVW_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FVW_PackInput' + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%rotors)) + if (allocated(InData%rotors)) then + call RegPackBounds(RF, 1, lbound(InData%rotors), ubound(InData%rotors)) + LB(1:1) = lbound(InData%rotors) + UB(1:1) = ubound(InData%rotors) + do i1 = LB(1), UB(1) + call FVW_PackRot_InputType(RF, InData%rotors(i1)) + end do + end if + call RegPack(RF, allocated(InData%W)) + if (allocated(InData%W)) then + call RegPackBounds(RF, 1, lbound(InData%W), ubound(InData%W)) + LB(1:1) = lbound(InData%W) + UB(1:1) = ubound(InData%W) + do i1 = LB(1), UB(1) + call FVW_PackWng_InputType(RF, InData%W(i1)) + end do + end if + call RegPack(RF, allocated(InData%WingsMesh)) + if (allocated(InData%WingsMesh)) then + call RegPackBounds(RF, 1, lbound(InData%WingsMesh), ubound(InData%WingsMesh)) + LB(1:1) = lbound(InData%WingsMesh) + UB(1:1) = ubound(InData%WingsMesh) + do i1 = LB(1), UB(1) + call MeshPack(RF, InData%WingsMesh(i1)) + end do + end if + call RegPackAlloc(RF, InData%V_wind) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FVW_UnPackInput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(FVW_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FVW_UnPackInput' + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + if (allocated(OutData%rotors)) deallocate(OutData%rotors) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%rotors(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotors.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call FVW_UnpackRot_InputType(RF, OutData%rotors(i1)) ! rotors + end do + end if + if (allocated(OutData%W)) deallocate(OutData%W) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%W(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%W.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call FVW_UnpackWng_InputType(RF, OutData%W(i1)) ! W + end do + end if + if (allocated(OutData%WingsMesh)) deallocate(OutData%WingsMesh) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%WingsMesh(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WingsMesh.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(RF, OutData%WingsMesh(i1)) ! WingsMesh + end do + end if + call RegUnpackAlloc(RF, OutData%V_wind); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FVW_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) + type(FVW_DiscreteStateType), intent(in) :: SrcDiscStateData + type(FVW_DiscreteStateType), intent(inout) :: DstDiscStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FVW_CopyDiscState' + ErrStat = ErrID_None + ErrMsg = '' + DstDiscStateData%Dummy = SrcDiscStateData%Dummy + if (allocated(SrcDiscStateData%UA)) then + LB(1:1) = lbound(SrcDiscStateData%UA) + UB(1:1) = ubound(SrcDiscStateData%UA) + if (.not. allocated(DstDiscStateData%UA)) then + allocate(DstDiscStateData%UA(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%UA.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call UA_CopyDiscState(SrcDiscStateData%UA(i1), DstDiscStateData%UA(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if +end subroutine + +subroutine FVW_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) + type(FVW_DiscreteStateType), intent(inout) :: DiscStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FVW_DestroyDiscState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(DiscStateData%UA)) then + LB(1:1) = lbound(DiscStateData%UA) + UB(1:1) = ubound(DiscStateData%UA) + do i1 = LB(1), UB(1) + call UA_DestroyDiscState(DiscStateData%UA(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(DiscStateData%UA) + end if +end subroutine + +subroutine FVW_PackDiscState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(FVW_DiscreteStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FVW_PackDiscState' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%Dummy) + call RegPack(RF, allocated(InData%UA)) + if (allocated(InData%UA)) then + call RegPackBounds(RF, 1, lbound(InData%UA), ubound(InData%UA)) + LB(1:1) = lbound(InData%UA) + UB(1:1) = ubound(InData%UA) + do i1 = LB(1), UB(1) + call UA_PackDiscState(RF, InData%UA(i1)) + end do + end if + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FVW_UnPackDiscState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(FVW_DiscreteStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FVW_UnPackDiscState' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%Dummy); if (RegCheckErr(RF, RoutineName)) return + if (allocated(OutData%UA)) deallocate(OutData%UA) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%UA(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%UA.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call UA_UnpackDiscState(RF, OutData%UA(i1)) ! UA + end do + end if +end subroutine + +subroutine FVW_CopyWng_ConstraintStateType(SrcWng_ConstraintStateTypeData, DstWng_ConstraintStateTypeData, CtrlCode, ErrStat, ErrMsg) + type(Wng_ConstraintStateType), intent(in) :: SrcWng_ConstraintStateTypeData + type(Wng_ConstraintStateType), intent(inout) :: DstWng_ConstraintStateTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'FVW_CopyWng_ConstraintStateType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcWng_ConstraintStateTypeData%Gamma_LL)) then + LB(1:1) = lbound(SrcWng_ConstraintStateTypeData%Gamma_LL) + UB(1:1) = ubound(SrcWng_ConstraintStateTypeData%Gamma_LL) + if (.not. allocated(DstWng_ConstraintStateTypeData%Gamma_LL)) then + allocate(DstWng_ConstraintStateTypeData%Gamma_LL(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_ConstraintStateTypeData%Gamma_LL.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_ConstraintStateTypeData%Gamma_LL = SrcWng_ConstraintStateTypeData%Gamma_LL + end if +end subroutine + +subroutine FVW_DestroyWng_ConstraintStateType(Wng_ConstraintStateTypeData, ErrStat, ErrMsg) + type(Wng_ConstraintStateType), intent(inout) :: Wng_ConstraintStateTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FVW_DestroyWng_ConstraintStateType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(Wng_ConstraintStateTypeData%Gamma_LL)) then + deallocate(Wng_ConstraintStateTypeData%Gamma_LL) + end if +end subroutine + +subroutine FVW_PackWng_ConstraintStateType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Wng_ConstraintStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FVW_PackWng_ConstraintStateType' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%Gamma_LL) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FVW_UnPackWng_ConstraintStateType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Wng_ConstraintStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FVW_UnPackWng_ConstraintStateType' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%Gamma_LL); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FVW_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) + type(FVW_ConstraintStateType), intent(in) :: SrcConstrStateData + type(FVW_ConstraintStateType), intent(inout) :: DstConstrStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FVW_CopyConstrState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcConstrStateData%W)) then + LB(1:1) = lbound(SrcConstrStateData%W) + UB(1:1) = ubound(SrcConstrStateData%W) + if (.not. allocated(DstConstrStateData%W)) then + allocate(DstConstrStateData%W(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstConstrStateData%W.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call FVW_CopyWng_ConstraintStateType(SrcConstrStateData%W(i1), DstConstrStateData%W(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + DstConstrStateData%residual = SrcConstrStateData%residual +end subroutine + +subroutine FVW_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) + type(FVW_ConstraintStateType), intent(inout) :: ConstrStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FVW_DestroyConstrState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ConstrStateData%W)) then + LB(1:1) = lbound(ConstrStateData%W) + UB(1:1) = ubound(ConstrStateData%W) + do i1 = LB(1), UB(1) + call FVW_DestroyWng_ConstraintStateType(ConstrStateData%W(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ConstrStateData%W) + end if +end subroutine + +subroutine FVW_PackConstrState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(FVW_ConstraintStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FVW_PackConstrState' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%W)) + if (allocated(InData%W)) then + call RegPackBounds(RF, 1, lbound(InData%W), ubound(InData%W)) + LB(1:1) = lbound(InData%W) + UB(1:1) = ubound(InData%W) + do i1 = LB(1), UB(1) + call FVW_PackWng_ConstraintStateType(RF, InData%W(i1)) + end do + end if + call RegPack(RF, InData%residual) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FVW_UnPackConstrState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(FVW_ConstraintStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FVW_UnPackConstrState' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + if (allocated(OutData%W)) deallocate(OutData%W) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%W(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%W.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call FVW_UnpackWng_ConstraintStateType(RF, OutData%W(i1)) ! W + end do + end if + call RegUnpack(RF, OutData%residual); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FVW_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) + type(FVW_OtherStateType), intent(in) :: SrcOtherStateData + type(FVW_OtherStateType), intent(inout) :: DstOtherStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FVW_CopyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + DstOtherStateData%Dummy = SrcOtherStateData%Dummy + if (allocated(SrcOtherStateData%UA)) then + LB(1:1) = lbound(SrcOtherStateData%UA) + UB(1:1) = ubound(SrcOtherStateData%UA) + if (.not. allocated(DstOtherStateData%UA)) then + allocate(DstOtherStateData%UA(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%UA.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call UA_CopyOtherState(SrcOtherStateData%UA(i1), DstOtherStateData%UA(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if +end subroutine + +subroutine FVW_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) + type(FVW_OtherStateType), intent(inout) :: OtherStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FVW_DestroyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OtherStateData%UA)) then + LB(1:1) = lbound(OtherStateData%UA) + UB(1:1) = ubound(OtherStateData%UA) + do i1 = LB(1), UB(1) + call UA_DestroyOtherState(OtherStateData%UA(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(OtherStateData%UA) + end if +end subroutine + +subroutine FVW_PackOtherState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(FVW_OtherStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FVW_PackOtherState' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%Dummy) + call RegPack(RF, allocated(InData%UA)) + if (allocated(InData%UA)) then + call RegPackBounds(RF, 1, lbound(InData%UA), ubound(InData%UA)) + LB(1:1) = lbound(InData%UA) + UB(1:1) = ubound(InData%UA) + do i1 = LB(1), UB(1) + call UA_PackOtherState(RF, InData%UA(i1)) + end do + end if + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FVW_UnPackOtherState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(FVW_OtherStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FVW_UnPackOtherState' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%Dummy); if (RegCheckErr(RF, RoutineName)) return + if (allocated(OutData%UA)) deallocate(OutData%UA) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%UA(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%UA.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call UA_UnpackOtherState(RF, OutData%UA(i1)) ! UA + end do + end if +end subroutine + +subroutine FVW_CopyWng_InitInputType(SrcWng_InitInputTypeData, DstWng_InitInputTypeData, CtrlCode, ErrStat, ErrMsg) + type(Wng_InitInputType), intent(in) :: SrcWng_InitInputTypeData + type(Wng_InitInputType), intent(inout) :: DstWng_InitInputTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'FVW_CopyWng_InitInputType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcWng_InitInputTypeData%AFindx)) then + LB(1:2) = lbound(SrcWng_InitInputTypeData%AFindx) + UB(1:2) = ubound(SrcWng_InitInputTypeData%AFindx) + if (.not. allocated(DstWng_InitInputTypeData%AFindx)) then + allocate(DstWng_InitInputTypeData%AFindx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_InitInputTypeData%AFindx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_InitInputTypeData%AFindx = SrcWng_InitInputTypeData%AFindx + end if + if (allocated(SrcWng_InitInputTypeData%chord)) then + LB(1:1) = lbound(SrcWng_InitInputTypeData%chord) + UB(1:1) = ubound(SrcWng_InitInputTypeData%chord) + if (.not. allocated(DstWng_InitInputTypeData%chord)) then + allocate(DstWng_InitInputTypeData%chord(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_InitInputTypeData%chord.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_InitInputTypeData%chord = SrcWng_InitInputTypeData%chord + end if + if (allocated(SrcWng_InitInputTypeData%RElm)) then + LB(1:1) = lbound(SrcWng_InitInputTypeData%RElm) + UB(1:1) = ubound(SrcWng_InitInputTypeData%RElm) + if (.not. allocated(DstWng_InitInputTypeData%RElm)) then + allocate(DstWng_InitInputTypeData%RElm(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_InitInputTypeData%RElm.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_InitInputTypeData%RElm = SrcWng_InitInputTypeData%RElm + end if + DstWng_InitInputTypeData%iRotor = SrcWng_InitInputTypeData%iRotor + DstWng_InitInputTypeData%UAOff_innerNode = SrcWng_InitInputTypeData%UAOff_innerNode + DstWng_InitInputTypeData%UAOff_outerNode = SrcWng_InitInputTypeData%UAOff_outerNode +end subroutine + +subroutine FVW_DestroyWng_InitInputType(Wng_InitInputTypeData, ErrStat, ErrMsg) + type(Wng_InitInputType), intent(inout) :: Wng_InitInputTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FVW_DestroyWng_InitInputType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(Wng_InitInputTypeData%AFindx)) then + deallocate(Wng_InitInputTypeData%AFindx) + end if + if (allocated(Wng_InitInputTypeData%chord)) then + deallocate(Wng_InitInputTypeData%chord) + end if + if (allocated(Wng_InitInputTypeData%RElm)) then + deallocate(Wng_InitInputTypeData%RElm) + end if +end subroutine + +subroutine FVW_PackWng_InitInputType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Wng_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FVW_PackWng_InitInputType' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%AFindx) + call RegPackAlloc(RF, InData%chord) + call RegPackAlloc(RF, InData%RElm) + call RegPack(RF, InData%iRotor) + call RegPack(RF, InData%UAOff_innerNode) + call RegPack(RF, InData%UAOff_outerNode) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FVW_UnPackWng_InitInputType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Wng_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FVW_UnPackWng_InitInputType' + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%AFindx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%chord); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%RElm); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iRotor); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UAOff_innerNode); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UAOff_outerNode); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FVW_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) + type(FVW_InitInputType), intent(inout) :: SrcInitInputData + type(FVW_InitInputType), intent(inout) :: DstInitInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FVW_CopyInitInput' + ErrStat = ErrID_None + ErrMsg = '' + DstInitInputData%FVWFileName = SrcInitInputData%FVWFileName + DstInitInputData%RootName = SrcInitInputData%RootName + if (allocated(SrcInitInputData%W)) then + LB(1:1) = lbound(SrcInitInputData%W) + UB(1:1) = ubound(SrcInitInputData%W) + if (.not. allocated(DstInitInputData%W)) then + allocate(DstInitInputData%W(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%W.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call FVW_CopyWng_InitInputType(SrcInitInputData%W(i1), DstInitInputData%W(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcInitInputData%WingsMesh)) then + LB(1:1) = lbound(SrcInitInputData%WingsMesh) + UB(1:1) = ubound(SrcInitInputData%WingsMesh) + if (.not. allocated(DstInitInputData%WingsMesh)) then + allocate(DstInitInputData%WingsMesh(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WingsMesh.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MeshCopy(SrcInitInputData%WingsMesh(i1), DstInitInputData%WingsMesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + DstInitInputData%numBladeNodes = SrcInitInputData%numBladeNodes + DstInitInputData%DTaero = SrcInitInputData%DTaero + DstInitInputData%KinVisc = SrcInitInputData%KinVisc + DstInitInputData%MHK = SrcInitInputData%MHK + DstInitInputData%WtrDpth = SrcInitInputData%WtrDpth + DstInitInputData%UA_Flag = SrcInitInputData%UA_Flag + call UA_CopyInitInput(SrcInitInputData%UA_Init, DstInitInputData%UA_Init, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine FVW_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(FVW_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FVW_DestroyInitInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InitInputData%W)) then + LB(1:1) = lbound(InitInputData%W) + UB(1:1) = ubound(InitInputData%W) + do i1 = LB(1), UB(1) + call FVW_DestroyWng_InitInputType(InitInputData%W(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InitInputData%W) + end if + if (allocated(InitInputData%WingsMesh)) then + LB(1:1) = lbound(InitInputData%WingsMesh) + UB(1:1) = ubound(InitInputData%WingsMesh) + do i1 = LB(1), UB(1) + call MeshDestroy( InitInputData%WingsMesh(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InitInputData%WingsMesh) + end if + call UA_DestroyInitInput(InitInputData%UA_Init, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine FVW_PackInitInput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(FVW_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FVW_PackInitInput' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%FVWFileName) + call RegPack(RF, InData%RootName) + call RegPack(RF, allocated(InData%W)) + if (allocated(InData%W)) then + call RegPackBounds(RF, 1, lbound(InData%W), ubound(InData%W)) + LB(1:1) = lbound(InData%W) + UB(1:1) = ubound(InData%W) + do i1 = LB(1), UB(1) + call FVW_PackWng_InitInputType(RF, InData%W(i1)) + end do + end if + call RegPack(RF, allocated(InData%WingsMesh)) + if (allocated(InData%WingsMesh)) then + call RegPackBounds(RF, 1, lbound(InData%WingsMesh), ubound(InData%WingsMesh)) + LB(1:1) = lbound(InData%WingsMesh) + UB(1:1) = ubound(InData%WingsMesh) + do i1 = LB(1), UB(1) + call MeshPack(RF, InData%WingsMesh(i1)) + end do + end if + call RegPack(RF, InData%numBladeNodes) + call RegPack(RF, InData%DTaero) + call RegPack(RF, InData%KinVisc) + call RegPack(RF, InData%MHK) + call RegPack(RF, InData%WtrDpth) + call RegPack(RF, InData%UA_Flag) + call UA_PackInitInput(RF, InData%UA_Init) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FVW_UnPackInitInput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(FVW_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FVW_UnPackInitInput' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%FVWFileName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RootName); if (RegCheckErr(RF, RoutineName)) return + if (allocated(OutData%W)) deallocate(OutData%W) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%W(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%W.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call FVW_UnpackWng_InitInputType(RF, OutData%W(i1)) ! W + end do + end if + if (allocated(OutData%WingsMesh)) deallocate(OutData%WingsMesh) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%WingsMesh(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WingsMesh.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(RF, OutData%WingsMesh(i1)) ! WingsMesh + end do + end if + call RegUnpack(RF, OutData%numBladeNodes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DTaero); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%KinVisc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MHK); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WtrDpth); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UA_Flag); if (RegCheckErr(RF, RoutineName)) return + call UA_UnpackInitInput(RF, OutData%UA_Init) ! UA_Init +end subroutine + +subroutine FVW_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg) + type(FVW_InputFile), intent(in) :: SrcInputFileData + type(FVW_InputFile), intent(inout) :: DstInputFileData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FVW_CopyInputFile' + ErrStat = ErrID_None + ErrMsg = '' + DstInputFileData%CircSolvMethod = SrcInputFileData%CircSolvMethod + DstInputFileData%CirculationFile = SrcInputFileData%CirculationFile + DstInputFileData%CircSolvMaxIter = SrcInputFileData%CircSolvMaxIter + DstInputFileData%CircSolvConvCrit = SrcInputFileData%CircSolvConvCrit + DstInputFileData%CircSolvRelaxation = SrcInputFileData%CircSolvRelaxation + DstInputFileData%IntMethod = SrcInputFileData%IntMethod + DstInputFileData%FreeWake = SrcInputFileData%FreeWake + DstInputFileData%FreeWakeStart = SrcInputFileData%FreeWakeStart + DstInputFileData%FullCircStart = SrcInputFileData%FullCircStart + DstInputFileData%DTfvw = SrcInputFileData%DTfvw + DstInputFileData%CircSolvPolar = SrcInputFileData%CircSolvPolar + DstInputFileData%nNWPanels = SrcInputFileData%nNWPanels + DstInputFileData%nNWPanelsFree = SrcInputFileData%nNWPanelsFree + DstInputFileData%nFWPanels = SrcInputFileData%nFWPanels + DstInputFileData%nFWPanelsFree = SrcInputFileData%nFWPanelsFree + DstInputFileData%FWShedVorticity = SrcInputFileData%FWShedVorticity + DstInputFileData%DiffusionMethod = SrcInputFileData%DiffusionMethod + DstInputFileData%CoreSpreadEddyVisc = SrcInputFileData%CoreSpreadEddyVisc + DstInputFileData%RegDeterMethod = SrcInputFileData%RegDeterMethod + DstInputFileData%RegFunction = SrcInputFileData%RegFunction + DstInputFileData%WakeRegMethod = SrcInputFileData%WakeRegMethod + DstInputFileData%WakeRegParam = SrcInputFileData%WakeRegParam + DstInputFileData%WingRegParam = SrcInputFileData%WingRegParam + DstInputFileData%ShearModel = SrcInputFileData%ShearModel + DstInputFileData%TwrShadowOnWake = SrcInputFileData%TwrShadowOnWake + DstInputFileData%VelocityMethod = SrcInputFileData%VelocityMethod + DstInputFileData%TreeBranchFactor = SrcInputFileData%TreeBranchFactor + DstInputFileData%PartPerSegment = SrcInputFileData%PartPerSegment + DstInputFileData%WrVTK = SrcInputFileData%WrVTK + DstInputFileData%VTKBlades = SrcInputFileData%VTKBlades + DstInputFileData%DTvtk = SrcInputFileData%DTvtk + DstInputFileData%VTKCoord = SrcInputFileData%VTKCoord +end subroutine + +subroutine FVW_DestroyInputFile(InputFileData, ErrStat, ErrMsg) + type(FVW_InputFile), intent(inout) :: InputFileData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FVW_DestroyInputFile' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine FVW_PackInputFile(RF, Indata) + type(RegFile), intent(inout) :: RF + type(FVW_InputFile), intent(in) :: InData + character(*), parameter :: RoutineName = 'FVW_PackInputFile' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%CircSolvMethod) + call RegPack(RF, InData%CirculationFile) + call RegPack(RF, InData%CircSolvMaxIter) + call RegPack(RF, InData%CircSolvConvCrit) + call RegPack(RF, InData%CircSolvRelaxation) + call RegPack(RF, InData%IntMethod) + call RegPack(RF, InData%FreeWake) + call RegPack(RF, InData%FreeWakeStart) + call RegPack(RF, InData%FullCircStart) + call RegPack(RF, InData%DTfvw) + call RegPack(RF, InData%CircSolvPolar) + call RegPack(RF, InData%nNWPanels) + call RegPack(RF, InData%nNWPanelsFree) + call RegPack(RF, InData%nFWPanels) + call RegPack(RF, InData%nFWPanelsFree) + call RegPack(RF, InData%FWShedVorticity) + call RegPack(RF, InData%DiffusionMethod) + call RegPack(RF, InData%CoreSpreadEddyVisc) + call RegPack(RF, InData%RegDeterMethod) + call RegPack(RF, InData%RegFunction) + call RegPack(RF, InData%WakeRegMethod) + call RegPack(RF, InData%WakeRegParam) + call RegPack(RF, InData%WingRegParam) + call RegPack(RF, InData%ShearModel) + call RegPack(RF, InData%TwrShadowOnWake) + call RegPack(RF, InData%VelocityMethod) + call RegPack(RF, InData%TreeBranchFactor) + call RegPack(RF, InData%PartPerSegment) + call RegPack(RF, InData%WrVTK) + call RegPack(RF, InData%VTKBlades) + call RegPack(RF, InData%DTvtk) + call RegPack(RF, InData%VTKCoord) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FVW_UnPackInputFile(RF, OutData) + type(RegFile), intent(inout) :: RF + type(FVW_InputFile), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FVW_UnPackInputFile' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%CircSolvMethod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CirculationFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CircSolvMaxIter); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CircSolvConvCrit); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CircSolvRelaxation); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%IntMethod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FreeWake); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FreeWakeStart); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FullCircStart); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DTfvw); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CircSolvPolar); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nNWPanels); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nNWPanelsFree); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nFWPanels); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nFWPanelsFree); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FWShedVorticity); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DiffusionMethod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CoreSpreadEddyVisc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RegDeterMethod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RegFunction); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WakeRegMethod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WakeRegParam); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WingRegParam); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ShearModel); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TwrShadowOnWake); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VelocityMethod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TreeBranchFactor); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PartPerSegment); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WrVTK); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VTKBlades); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DTvtk); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VTKCoord); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FVW_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) + type(FVW_InitOutputType), intent(in) :: SrcInitOutputData + type(FVW_InitOutputType), intent(inout) :: DstInitOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FVW_CopyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + DstInitOutputData%Dummy = SrcInitOutputData%Dummy +end subroutine + +subroutine FVW_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(FVW_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FVW_DestroyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine FVW_PackInitOutput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(FVW_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FVW_PackInitOutput' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%Dummy) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FVW_UnPackInitOutput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(FVW_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FVW_UnPackInitOutput' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%Dummy); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FVW_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(FVW_InputType), intent(inout) :: u(:) ! Input at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Inputs + type(FVW_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 = 'FVW_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 FVW_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL FVW_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 FVW_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 FVW_Input_ExtrapInterp - - - SUBROUTINE FVW_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'FVW_Input_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(u)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(u)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(u) - 1 + select case (order) + case (0) + call FVW_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call FVW_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call FVW_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(u) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE FVW_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. @@ -11548,93 +3752,73 @@ SUBROUTINE FVW_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ! !.................................................................................................................................. - TYPE(FVW_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 - TYPE(FVW_InputType), INTENT(INOUT) :: u2 ! Input at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs - TYPE(FVW_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 + TYPE(FVW_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 + TYPE(FVW_InputType), INTENT(INOUT) :: u2 ! Input at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs + TYPE(FVW_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 = 'FVW_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 :: i02 ! dim2 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - INTEGER :: i2 ! dim2 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 + REAL(DbKi) :: t(2) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'FVW_Input_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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 :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 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%rotors) .AND. ALLOCATED(u1%rotors)) THEN - DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) - DO i2 = LBOUND(u_out%rotors(i01)%HubOrientation,2),UBOUND(u_out%rotors(i01)%HubOrientation,2) - DO i1 = LBOUND(u_out%rotors(i01)%HubOrientation,1),UBOUND(u_out%rotors(i01)%HubOrientation,1) - b = -(u1%rotors(i01)%HubOrientation(i1,i2) - u2%rotors(i01)%HubOrientation(i1,i2)) - u_out%rotors(i01)%HubOrientation(i1,i2) = u1%rotors(i01)%HubOrientation(i1,i2) + b * ScaleFactor - END DO - END DO - ENDDO - DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) - DO i1 = LBOUND(u_out%rotors(i01)%HubPosition,1),UBOUND(u_out%rotors(i01)%HubPosition,1) - b = -(u1%rotors(i01)%HubPosition(i1) - u2%rotors(i01)%HubPosition(i1)) - u_out%rotors(i01)%HubPosition(i1) = u1%rotors(i01)%HubPosition(i1) + b * ScaleFactor - END DO - ENDDO -END IF ! check if allocated -IF (ALLOCATED(u_out%W) .AND. ALLOCATED(u1%W)) THEN - DO i01 = LBOUND(u_out%W,1),UBOUND(u_out%W,1) -IF (ALLOCATED(u_out%W(i01)%Vwnd_LL) .AND. ALLOCATED(u1%W(i01)%Vwnd_LL)) THEN - DO i2 = LBOUND(u_out%W(i01)%Vwnd_LL,2),UBOUND(u_out%W(i01)%Vwnd_LL,2) - DO i1 = LBOUND(u_out%W(i01)%Vwnd_LL,1),UBOUND(u_out%W(i01)%Vwnd_LL,1) - b = -(u1%W(i01)%Vwnd_LL(i1,i2) - u2%W(i01)%Vwnd_LL(i1,i2)) - u_out%W(i01)%Vwnd_LL(i1,i2) = u1%W(i01)%Vwnd_LL(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated - ENDDO - DO i01 = LBOUND(u_out%W,1),UBOUND(u_out%W,1) -IF (ALLOCATED(u_out%W(i01)%omega_z) .AND. ALLOCATED(u1%W(i01)%omega_z)) THEN - DO i1 = LBOUND(u_out%W(i01)%omega_z,1),UBOUND(u_out%W(i01)%omega_z,1) - b = -(u1%W(i01)%omega_z(i1) - u2%W(i01)%omega_z(i1)) - u_out%W(i01)%omega_z(i1) = u1%W(i01)%omega_z(i1) + b * ScaleFactor - END DO -END IF ! check if allocated - ENDDO -END IF ! check if allocated -IF (ALLOCATED(u_out%WingsMesh) .AND. ALLOCATED(u1%WingsMesh)) THEN - DO i1 = LBOUND(u_out%WingsMesh,1),UBOUND(u_out%WingsMesh,1) - CALL MeshExtrapInterp1(u1%WingsMesh(i1), u2%WingsMesh(i1), tin, u_out%WingsMesh(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated -IF (ALLOCATED(u_out%V_wind) .AND. ALLOCATED(u1%V_wind)) THEN - DO i2 = LBOUND(u_out%V_wind,2),UBOUND(u_out%V_wind,2) - DO i1 = LBOUND(u_out%V_wind,1),UBOUND(u_out%V_wind,1) - b = -(u1%V_wind(i1,i2) - u2%V_wind(i1,i2)) - u_out%V_wind(i1,i2) = u1%V_wind(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated - END SUBROUTINE FVW_Input_ExtrapInterp1 - - - SUBROUTINE FVW_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + IF (ALLOCATED(u_out%rotors) .AND. ALLOCATED(u1%rotors)) THEN + do i01 = lbound(u_out%rotors,1),ubound(u_out%rotors,1) + u_out%rotors(i01)%HubOrientation = a1*u1%rotors(i01)%HubOrientation + a2*u2%rotors(i01)%HubOrientation + END DO + do i01 = lbound(u_out%rotors,1),ubound(u_out%rotors,1) + u_out%rotors(i01)%HubPosition = a1*u1%rotors(i01)%HubPosition + a2*u2%rotors(i01)%HubPosition + END DO + END IF ! check if allocated + IF (ALLOCATED(u_out%W) .AND. ALLOCATED(u1%W)) THEN + do i01 = lbound(u_out%W,1),ubound(u_out%W,1) + IF (ALLOCATED(u_out%W(i01)%Vwnd_LL) .AND. ALLOCATED(u1%W(i01)%Vwnd_LL)) THEN + u_out%W(i01)%Vwnd_LL = a1*u1%W(i01)%Vwnd_LL + a2*u2%W(i01)%Vwnd_LL + END IF ! check if allocated + END DO + do i01 = lbound(u_out%W,1),ubound(u_out%W,1) + IF (ALLOCATED(u_out%W(i01)%omega_z) .AND. ALLOCATED(u1%W(i01)%omega_z)) THEN + u_out%W(i01)%omega_z = a1*u1%W(i01)%omega_z + a2*u2%W(i01)%omega_z + END IF ! check if allocated + END DO + END IF ! check if allocated + IF (ALLOCATED(u_out%WingsMesh) .AND. ALLOCATED(u1%WingsMesh)) THEN + do i1 = lbound(u_out%WingsMesh,1),ubound(u_out%WingsMesh,1) + CALL MeshExtrapInterp1(u1%WingsMesh(i1), u2%WingsMesh(i1), tin, u_out%WingsMesh(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + IF (ALLOCATED(u_out%V_wind) .AND. ALLOCATED(u1%V_wind)) THEN + u_out%V_wind = a1*u1%V_wind + a2*u2%V_wind + END IF ! check if allocated +END SUBROUTINE + +SUBROUTINE FVW_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. @@ -11648,158 +3832,133 @@ SUBROUTINE FVW_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Err ! !.................................................................................................................................. - TYPE(FVW_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 > t3 - TYPE(FVW_InputType), INTENT(INOUT) :: u2 ! Input at t2 > t3 - TYPE(FVW_InputType), INTENT(INOUT) :: u3 ! Input at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs - TYPE(FVW_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 + TYPE(FVW_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 > t3 + TYPE(FVW_InputType), INTENT(INOUT) :: u2 ! Input at t2 > t3 + TYPE(FVW_InputType), INTENT(INOUT) :: u3 ! Input at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs + TYPE(FVW_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 = 'FVW_Input_ExtrapInterp2' - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - INTEGER :: i2 ! dim2 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) - + 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) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'FVW_Input_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 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 + 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 + 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 + 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%rotors) .AND. ALLOCATED(u1%rotors)) THEN - DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) - DO i2 = LBOUND(u_out%rotors(i01)%HubOrientation,2),UBOUND(u_out%rotors(i01)%HubOrientation,2) - DO i1 = LBOUND(u_out%rotors(i01)%HubOrientation,1),UBOUND(u_out%rotors(i01)%HubOrientation,1) - b = (t(3)**2*(u1%rotors(i01)%HubOrientation(i1,i2) - u2%rotors(i01)%HubOrientation(i1,i2)) + t(2)**2*(-u1%rotors(i01)%HubOrientation(i1,i2) + u3%rotors(i01)%HubOrientation(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*u1%rotors(i01)%HubOrientation(i1,i2) + t(3)*u2%rotors(i01)%HubOrientation(i1,i2) - t(2)*u3%rotors(i01)%HubOrientation(i1,i2) ) * scaleFactor - u_out%rotors(i01)%HubOrientation(i1,i2) = u1%rotors(i01)%HubOrientation(i1,i2) + b + c * t_out - END DO - END DO - ENDDO - DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) - DO i1 = LBOUND(u_out%rotors(i01)%HubPosition,1),UBOUND(u_out%rotors(i01)%HubPosition,1) - b = (t(3)**2*(u1%rotors(i01)%HubPosition(i1) - u2%rotors(i01)%HubPosition(i1)) + t(2)**2*(-u1%rotors(i01)%HubPosition(i1) + u3%rotors(i01)%HubPosition(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%rotors(i01)%HubPosition(i1) + t(3)*u2%rotors(i01)%HubPosition(i1) - t(2)*u3%rotors(i01)%HubPosition(i1) ) * scaleFactor - u_out%rotors(i01)%HubPosition(i1) = u1%rotors(i01)%HubPosition(i1) + b + c * t_out - END DO - ENDDO -END IF ! check if allocated -IF (ALLOCATED(u_out%W) .AND. ALLOCATED(u1%W)) THEN - DO i01 = LBOUND(u_out%W,1),UBOUND(u_out%W,1) -IF (ALLOCATED(u_out%W(i01)%Vwnd_LL) .AND. ALLOCATED(u1%W(i01)%Vwnd_LL)) THEN - DO i2 = LBOUND(u_out%W(i01)%Vwnd_LL,2),UBOUND(u_out%W(i01)%Vwnd_LL,2) - DO i1 = LBOUND(u_out%W(i01)%Vwnd_LL,1),UBOUND(u_out%W(i01)%Vwnd_LL,1) - b = (t(3)**2*(u1%W(i01)%Vwnd_LL(i1,i2) - u2%W(i01)%Vwnd_LL(i1,i2)) + t(2)**2*(-u1%W(i01)%Vwnd_LL(i1,i2) + u3%W(i01)%Vwnd_LL(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*u1%W(i01)%Vwnd_LL(i1,i2) + t(3)*u2%W(i01)%Vwnd_LL(i1,i2) - t(2)*u3%W(i01)%Vwnd_LL(i1,i2) ) * scaleFactor - u_out%W(i01)%Vwnd_LL(i1,i2) = u1%W(i01)%Vwnd_LL(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated - ENDDO - DO i01 = LBOUND(u_out%W,1),UBOUND(u_out%W,1) -IF (ALLOCATED(u_out%W(i01)%omega_z) .AND. ALLOCATED(u1%W(i01)%omega_z)) THEN - DO i1 = LBOUND(u_out%W(i01)%omega_z,1),UBOUND(u_out%W(i01)%omega_z,1) - b = (t(3)**2*(u1%W(i01)%omega_z(i1) - u2%W(i01)%omega_z(i1)) + t(2)**2*(-u1%W(i01)%omega_z(i1) + u3%W(i01)%omega_z(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%W(i01)%omega_z(i1) + t(3)*u2%W(i01)%omega_z(i1) - t(2)*u3%W(i01)%omega_z(i1) ) * scaleFactor - u_out%W(i01)%omega_z(i1) = u1%W(i01)%omega_z(i1) + b + c * t_out - END DO -END IF ! check if allocated - ENDDO -END IF ! check if allocated -IF (ALLOCATED(u_out%WingsMesh) .AND. ALLOCATED(u1%WingsMesh)) THEN - DO i1 = LBOUND(u_out%WingsMesh,1),UBOUND(u_out%WingsMesh,1) - CALL MeshExtrapInterp2(u1%WingsMesh(i1), u2%WingsMesh(i1), u3%WingsMesh(i1), tin, u_out%WingsMesh(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated -IF (ALLOCATED(u_out%V_wind) .AND. ALLOCATED(u1%V_wind)) THEN - DO i2 = LBOUND(u_out%V_wind,2),UBOUND(u_out%V_wind,2) - DO i1 = LBOUND(u_out%V_wind,1),UBOUND(u_out%V_wind,1) - b = (t(3)**2*(u1%V_wind(i1,i2) - u2%V_wind(i1,i2)) + t(2)**2*(-u1%V_wind(i1,i2) + u3%V_wind(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*u1%V_wind(i1,i2) + t(3)*u2%V_wind(i1,i2) - t(2)*u3%V_wind(i1,i2) ) * scaleFactor - u_out%V_wind(i1,i2) = u1%V_wind(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated - END SUBROUTINE FVW_Input_ExtrapInterp2 - - - SUBROUTINE FVW_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(FVW_OutputType), INTENT(IN) :: y(:) ! Output at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Outputs - TYPE(FVW_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 + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + IF (ALLOCATED(u_out%rotors) .AND. ALLOCATED(u1%rotors)) THEN + do i01 = lbound(u_out%rotors,1),ubound(u_out%rotors,1) + u_out%rotors(i01)%HubOrientation = a1*u1%rotors(i01)%HubOrientation + a2*u2%rotors(i01)%HubOrientation + a3*u3%rotors(i01)%HubOrientation + END DO + do i01 = lbound(u_out%rotors,1),ubound(u_out%rotors,1) + u_out%rotors(i01)%HubPosition = a1*u1%rotors(i01)%HubPosition + a2*u2%rotors(i01)%HubPosition + a3*u3%rotors(i01)%HubPosition + END DO + END IF ! check if allocated + IF (ALLOCATED(u_out%W) .AND. ALLOCATED(u1%W)) THEN + do i01 = lbound(u_out%W,1),ubound(u_out%W,1) + IF (ALLOCATED(u_out%W(i01)%Vwnd_LL) .AND. ALLOCATED(u1%W(i01)%Vwnd_LL)) THEN + u_out%W(i01)%Vwnd_LL = a1*u1%W(i01)%Vwnd_LL + a2*u2%W(i01)%Vwnd_LL + a3*u3%W(i01)%Vwnd_LL + END IF ! check if allocated + END DO + do i01 = lbound(u_out%W,1),ubound(u_out%W,1) + IF (ALLOCATED(u_out%W(i01)%omega_z) .AND. ALLOCATED(u1%W(i01)%omega_z)) THEN + u_out%W(i01)%omega_z = a1*u1%W(i01)%omega_z + a2*u2%W(i01)%omega_z + a3*u3%W(i01)%omega_z + END IF ! check if allocated + END DO + END IF ! check if allocated + IF (ALLOCATED(u_out%WingsMesh) .AND. ALLOCATED(u1%WingsMesh)) THEN + do i1 = lbound(u_out%WingsMesh,1),ubound(u_out%WingsMesh,1) + CALL MeshExtrapInterp2(u1%WingsMesh(i1), u2%WingsMesh(i1), u3%WingsMesh(i1), tin, u_out%WingsMesh(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + IF (ALLOCATED(u_out%V_wind) .AND. ALLOCATED(u1%V_wind)) THEN + u_out%V_wind = a1*u1%V_wind + a2*u2%V_wind + a3*u3%V_wind + END IF ! check if allocated +END SUBROUTINE + +subroutine FVW_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(FVW_OutputType), intent(in) :: y(:) ! Output at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Outputs + type(FVW_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 = 'FVW_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 FVW_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL FVW_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 FVW_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 FVW_Output_ExtrapInterp - - - SUBROUTINE FVW_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'FVW_Output_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(y)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(y)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(y) - 1 + select case (order) + case (0) + call FVW_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call FVW_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call FVW_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(y) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE FVW_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. @@ -11811,55 +3970,51 @@ SUBROUTINE FVW_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ! !.................................................................................................................................. - TYPE(FVW_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 - TYPE(FVW_OutputType), INTENT(IN) :: y2 ! Output at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs - TYPE(FVW_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 + TYPE(FVW_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 + TYPE(FVW_OutputType), INTENT(IN) :: y2 ! Output at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs + TYPE(FVW_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 = 'FVW_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 :: i02 ! dim2 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - INTEGER :: i2 ! dim2 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 + REAL(DbKi) :: t(2) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'FVW_Output_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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 :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 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%W) .AND. ALLOCATED(y1%W)) THEN - DO i01 = LBOUND(y_out%W,1),UBOUND(y_out%W,1) -IF (ALLOCATED(y_out%W(i01)%Vind) .AND. ALLOCATED(y1%W(i01)%Vind)) THEN - DO i2 = LBOUND(y_out%W(i01)%Vind,2),UBOUND(y_out%W(i01)%Vind,2) - DO i1 = LBOUND(y_out%W(i01)%Vind,1),UBOUND(y_out%W(i01)%Vind,1) - b = -(y1%W(i01)%Vind(i1,i2) - y2%W(i01)%Vind(i1,i2)) - y_out%W(i01)%Vind(i1,i2) = y1%W(i01)%Vind(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated - ENDDO -END IF ! check if allocated - END SUBROUTINE FVW_Output_ExtrapInterp1 - - - SUBROUTINE FVW_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + IF (ALLOCATED(y_out%W) .AND. ALLOCATED(y1%W)) THEN + do i01 = lbound(y_out%W,1),ubound(y_out%W,1) + IF (ALLOCATED(y_out%W(i01)%Vind) .AND. ALLOCATED(y1%W(i01)%Vind)) THEN + y_out%W(i01)%Vind = a1*y1%W(i01)%Vind + a2*y2%W(i01)%Vind + END IF ! check if allocated + END DO + END IF ! check if allocated +END SUBROUTINE + +SUBROUTINE FVW_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. @@ -11873,62 +4028,56 @@ SUBROUTINE FVW_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Er ! !.................................................................................................................................. - TYPE(FVW_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 > t3 - TYPE(FVW_OutputType), INTENT(IN) :: y2 ! Output at t2 > t3 - TYPE(FVW_OutputType), INTENT(IN) :: y3 ! Output at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs - TYPE(FVW_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 + TYPE(FVW_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 > t3 + TYPE(FVW_OutputType), INTENT(IN) :: y2 ! Output at t2 > t3 + TYPE(FVW_OutputType), INTENT(IN) :: y3 ! Output at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs + TYPE(FVW_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 = 'FVW_Output_ExtrapInterp2' - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - INTEGER :: i2 ! dim2 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) - + 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) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'FVW_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 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 + 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 + 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 + 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%W) .AND. ALLOCATED(y1%W)) THEN - DO i01 = LBOUND(y_out%W,1),UBOUND(y_out%W,1) -IF (ALLOCATED(y_out%W(i01)%Vind) .AND. ALLOCATED(y1%W(i01)%Vind)) THEN - DO i2 = LBOUND(y_out%W(i01)%Vind,2),UBOUND(y_out%W(i01)%Vind,2) - DO i1 = LBOUND(y_out%W(i01)%Vind,1),UBOUND(y_out%W(i01)%Vind,1) - b = (t(3)**2*(y1%W(i01)%Vind(i1,i2) - y2%W(i01)%Vind(i1,i2)) + t(2)**2*(-y1%W(i01)%Vind(i1,i2) + y3%W(i01)%Vind(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*y1%W(i01)%Vind(i1,i2) + t(3)*y2%W(i01)%Vind(i1,i2) - t(2)*y3%W(i01)%Vind(i1,i2) ) * scaleFactor - y_out%W(i01)%Vind(i1,i2) = y1%W(i01)%Vind(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated - ENDDO -END IF ! check if allocated - END SUBROUTINE FVW_Output_ExtrapInterp2 - + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + IF (ALLOCATED(y_out%W) .AND. ALLOCATED(y1%W)) THEN + do i01 = lbound(y_out%W,1),ubound(y_out%W,1) + IF (ALLOCATED(y_out%W(i01)%Vind) .AND. ALLOCATED(y1%W(i01)%Vind)) THEN + y_out%W(i01)%Vind = a1*y1%W(i01)%Vind + a2*y2%W(i01)%Vind + a3*y3%W(i01)%Vind + END IF ! check if allocated + END DO + END IF ! check if allocated +END SUBROUTINE END MODULE FVW_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/aerodyn/src/UA_Dvr_Subs.f90 b/modules/aerodyn/src/UA_Dvr_Subs.f90 index 0577387f87..9d897ddf0b 100644 --- a/modules/aerodyn/src/UA_Dvr_Subs.f90 +++ b/modules/aerodyn/src/UA_Dvr_Subs.f90 @@ -5,21 +5,41 @@ module UA_Dvr_Subs use AirfoilInfo_Types use UnsteadyAero_Types use UnsteadyAero + use LinDyn + use LinDyn_Types implicit none - - type UA_Dvr_InitInput + integer, parameter :: NumAFfiles = 1 + integer(IntKi), parameter :: NumInp = 2 ! Number of inputs sent to UA_UpdateStates (must be at least 2) + integer(IntKi), parameter :: InflowMod_Cst = 1 ! Inflow is constant + integer(IntKi), parameter :: InflowMod_File = 2 ! Inflow is read from file + integer(IntKi), parameter, dimension(2) :: InflowMod_Valid = (/InflowMod_Cst, InflowMod_File/) + integer(IntKi), parameter :: MotionMod_Cst = 1 ! Motion is constant + integer(IntKi), parameter :: MotionMod_File = 2 ! Motion is read from file + integer(IntKi), parameter, dimension(2) :: MotionMod_Valid = (/MotionMod_Cst, MotionMod_File/) + real(ReKi), parameter :: myNaN = -9999.9_ReKi + integer(IntKi), parameter :: idFmt_Ascii = 1 + integer(IntKi), parameter :: idFmt_Binary = 2 + integer(IntKi), parameter :: idFmt_Both = 3 + integer(IntKi), parameter, dimension(3) :: idFmt_Valid = (/idFmt_Ascii, idFmt_Binary, idFmt_Both/) + + type Dvr_Parameters logical :: Echo + ! Environment + real(ReKi) :: KinVisc + real(ReKi) :: FldDens real(ReKi) :: SpdSound - character(1024) :: OutRootName - real(ReKi) :: InflowVel + ! integer :: UAMod logical :: Flookup logical :: UseCm character(1024) :: AirFoil1 real(ReKi) :: Chord + ! integer :: SimMod + ! Reduced frequency - SimMod = 1 + real(ReKi) :: InflowVel real(ReKi) :: NCycles real(ReKi) :: Frequency real(ReKi) :: Re @@ -27,521 +47,413 @@ module UA_Dvr_Subs real(ReKi) :: Amplitude real(ReKi) :: Mean integer :: Phase - character(1024) :: InputsFile + ! Prescribed Aero - SimMod = 2 + real(ReKi) :: TMax_PA + real(DbKi) :: dt_PA + character(1024) :: AeroTSFile + ! AeroElastic Section - SimMod =3 + real(ReKi) :: TMax + real(DbKi) :: dt + real(ReKi) :: MM(3,3) + real(ReKi) :: CC(3,3) + real(ReKi) :: KK(3,3) + logical :: activeDOFs(3) + real(ReKi) :: GFScaling(3,3) + real(ReKi) :: initPos(3) + real(ReKi) :: initVel(3) + real(ReKi) :: Vec_AQ(2) ! Vector from A to quarter chord /aerodynamic center + real(ReKi) :: Vec_AT(2) ! Vector from A to three quarter chord + real(ReKi) :: Twist ! Twist of the airfoil section (input deg, but stored in rad afterwards) + ! Inflow + integer :: InflowMod = InflowMod_Cst + real(ReKi) :: Inflow(2) + character(1024) :: InflowTSFile + ! Motion + integer :: MotionMod = MotionMod_Cst + character(1024) :: MotionTSFile + ! Outputs logical :: SumPrint logical :: WrAFITables - end type UA_Dvr_InitInput - - contains - - subroutine ReadDriverInputFile( inputFile, InitInp, ErrStat, ErrMsg ) - - character(1024), intent( in ) :: inputFile - type(UA_Dvr_InitInput), intent( out ) :: InitInp - 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 :: UnIn ! Unit number for the input file - integer :: UnEchoLocal ! The local unit number for this module's echo file - character(1024) :: EchoFile ! Name of HydroDyn echo file - character(1024) :: FileName ! Name of HydroDyn input file - - integer(IntKi) :: errStat2 ! Status of error message - character(1024) :: errMsg2 ! Error message if ErrStat /= ErrID_None - character(*), parameter :: RoutineName = 'ReadDriverInputFile' - - character(1024) :: PriPath ! the path to the primary input file - CALL GetPath( inputFile, PriPath ) ! Input files will be relative to the path where the primary input file is located. - - - ! Initialize the echo file unit to -1 which is the default to prevent echoing, we will alter this based on user input - UnEchoLocal = -1 - ErrStat = ErrID_None - ErrMsg = '' - FileName = trim(inputFile) - - call GetNewUnit( UnIn ) - call OpenFInpFile( UnIn, FileName, errStat2, errMsg2 ) - call SetErrStat(errStat2, errMsg2, ErrStat, ErrMsg, RoutineName ) - if (ErrStat >= AbortErrLev) then - call Cleanup() - return - end if + ! ---- Parameters + real(ReKi) :: d_34_to_ac + !real(DbKi) :: dt + real(DbKi) :: simTime + integer :: numSteps + character(1024) :: OutRootName ! Automatically obtained from input file name + ! Prescribed AoA simulations + real(DbKi), allocatable :: timeArr(:) + real(ReKi), allocatable :: vPrescrAero(:,:) ! Aero as function of time, shape nt x 4: Time, AOA, U, Omega + ! Prescribed inflow simulations + real(ReKi), allocatable :: vU0(:,:) ! Inflow as function of time, shape nt x 3 : Time, U0x, U0y + end type Dvr_Parameters + + + type :: Dvr_Outputs + integer(intki) :: unOutFile = -1 !< unit number for writing output file + !integer(intki) :: actualchanlen !< actual length of channels written to text file (less than or equal to chanlen) [-] + integer(intki) :: ny !< total number of outputs for the driver + integer(intki) :: ny_dvr !< number of outputs for the driver (without UA and LD, and Time) + integer(intki) :: ny_UA !< number of outputs for UA + integer(intki) :: ny_LD !< number of outputs for LD + !character(20) :: fmt_t !< format specifier for time channel [-] + !character(25) :: fmt_a !< format specifier for each column (including delimiter) [-] + !character(1) :: delim !< column delimiter [-] + !character(20) :: outfmt !< format specifier [-] + integer(intki) :: fileFmt = idFmt_Binary !< output format 1=text, 2=binary, 3=both [-] + character(1024) :: root = '' !< output file rootname [-] + character(ChanLen) , dimension(:), allocatable :: WriteOutputHdr !< channel headers [-] + character(ChanLen) , dimension(:), allocatable :: WriteOutputUnt !< channel units [-] + real(ReKi) , dimension(:,:), allocatable :: storage !< nchannel x ntime [-] + real(ReKi) , dimension(:), allocatable :: outline !< output line to be written to disk [-] + !real(dbki) :: dt_outs !< output time resolution [s] + !integer(intki) :: n_dt_out !< number of time steps between writing a line in the time-marching output files [-] + end type Dvr_Outputs + + type :: Dvr_Misc + ! Reminder: + ! Q: 1/4 chord / aerodynamic center + ! T: 3/4 chord + ! A: Airfoil origin + real(ReKi) :: Vst_Q(2) !< Structural velocity at Q [m/s] + real(ReKi) :: Vst_T(2) !< Structural velocity at T [m/s] + real(ReKi) :: Vrel_Q(2) !< Relative velocity at Q [m/s] + real(ReKi) :: Vrel_T(2) !< Relative velocity at T [m/s] + real(ReKi) :: Vrel_norm2_T !< Squared velocity norm at T [m^2/s^2] + real(ReKi) :: Vrel_norm2_Q !< Squared velocity norm at Q [m^2/s^2] + real(ReKi) :: alpha_Q !< Angle of attack at Q [rad] + real(ReKi) :: alpha_T !< Angle of attack at T [rad] + real(ReKi) :: phi_Q !< Flow angle at Q [rad] + real(ReKi) :: phi_T !< Flow angle at T [rad] + real(ReKi) :: Re !< Reynolds number (NOT in Million!) + real(ReKi) :: L, D, tau_Q !< Aerodynamic loads at Q [N/m & Nm/m] + real(ReKi) :: FxA, FyA, tau_A !< Aerodynamic loads at A [N/m & Nm/m] + real(ReKi) :: GF(3) !< Generalized force, Scaled aerodynamic loads to be representative of the blade + real(ReKi) :: twist_full !< Full twist (includes initial twist, potential pitch, and torsion) + integer :: iU0Last = 1 !< Index for faster interpolation of wind speed + integer :: iPALast = 1 !< Index for faster interpolation of prescribed aero + real(ReKi) :: uPA(3) !< Prescribed Aero inputs + end type Dvr_Misc + + type Dvr_Data + ! Time control + real(DbKi) :: uTimes(NumInp) + ! Parameters / initinp set as the same... + type(Dvr_Parameters) :: p ! Initialization/parameter data for the driver program + type(Dvr_Misc) :: m ! Misc variables for aerodynamic calculations + ! Outputs + type(Dvr_Outputs) :: out + ! Inflow + real(ReKi) :: U0(NumInp, 2) ! Inflow velocity vector at time t and t+dt + ! AFI + type(AFI_ParameterType) :: AFI_Params(NumAFfiles) + integer, allocatable :: AFIndx(:,:) + ! UA + type(UA_InitInputType) :: UA_InitInData ! Input data for initialization + type(UA_InitOutputType) :: UA_InitOutData ! Output data from initialization + type(UA_ContinuousStateType) :: UA_x ! Continuous states + type(UA_DiscreteStateType) :: UA_xd ! Discrete states + type(UA_OtherStateType) :: UA_OtherState ! Other/optimization states + type(UA_MiscVarType) :: UA_m ! Misc/optimization variables + type(UA_ParameterType) :: UA_p ! Parameters + type(UA_InputType) :: UA_u(NumInp) ! System inputs + type(UA_OutputType) :: UA_y ! System outputs + ! Dynamics + type(LD_InitInputType) :: LD_InitInData ! Input data for initialization + type(LD_InitOutputType) :: LD_InitOutData ! Output data from initialization + type(LD_ContinuousStateType) :: LD_x ! Continuous states + type(LD_DiscreteStateType) :: LD_xd ! Discrete states + type(LD_OtherStateType) :: LD_OtherState ! Other/optimization states + type(LD_ConstraintStateType) :: LD_z ! Constraint states + type(LD_MiscVarType) :: LD_m ! Misc/optimization variables + type(LD_ParameterType) :: LD_p ! Parameters + type(LD_InputType) :: LD_u(NumInp) ! System inputs + type(LD_OutputType) :: LD_y ! System outputs + ! + type(LD_ContinuousStateType) :: LD_x_swp ! Continuous states + type(LD_OtherStateType) :: LD_OtherState_swp ! Other/optimization states + type(UA_ContinuousStateType) :: UA_x_swp ! Continuous states + type(UA_DiscreteStateType) :: UA_xd_swp ! Discrete states + type(UA_OtherStateType) :: UA_OtherState_swp ! Other/optimization states + end type Dvr_Data +contains - call WrScr( ' Opening UnsteadyAero Driver input file: '//FileName ) - - - !------------------------------------------------------------------------------------------------- - ! File header - !------------------------------------------------------------------------------------------------- - - call ReadCom( UnIn, FileName, ' UnsteadyAero Driver input file header line 1', errStat2, errMsg2 ) - call SetErrStat(errStat2, errMsg2, ErrStat, ErrMsg, RoutineName ) - if (ErrStat >= AbortErrLev) then - call Cleanup() - return - end if - +!-------------------------------------------------------------------------------------------------------------- +subroutine ReadDriverInputFile( FileName, InitInp, ErrStat, ErrMsg ) + character(1024), intent( in ) :: filename + type(Dvr_Parameters), intent( out ) :: InitInp + integer, intent( out ) :: ErrStat ! returns a non-zero value when an error occurs + character(*), intent( out ) :: ErrMsg ! Error message if ErrStat /= ErrID_None + ! Local variables + integer :: UnEcho ! The local unit number for this module's echo file + integer :: iLine + character(1024) :: EchoFile ! Name of HydroDyn echo file + character(1024) :: PriPath ! the path to the primary input file + character(1024) :: Line ! the path to the primary input file + type(FileInfoType) :: FI !< The derived type for holding the file information. + integer(IntKi) :: errStat2 ! Status of error message + character(1024) :: errMsg2 ! Error message if ErrStat /= ErrID_None + character(*), parameter :: RoutineName = 'ReadDriverInputFile' + ! Initialize the echo file unit to -1 which is the default to prevent echoing, we will alter this based on user input + UnEcho = -1 + ErrStat = ErrID_None + ErrMsg = '' + + ! Read all input file lines into fileinfo + call WrScr(' Opening UnsteadyAero Driver input file: '//trim(FileName) ) + call ProcessComFile(FileName, FI, errStat2, errMsg2); if (Failed()) return + CALL GetPath( FileName, PriPath ) ! Input files will be relative to the path where the primary input file is located. + !call GetRoot(FileName, dvr%root) + + ! --- Header and echo + iLine = 3 ! Skip the first two lines as they are known to be header lines and separators + call ParseVar(FI, iLine, 'Echo', InitInp%Echo, errStat2, errMsg2); if (Failed()) return; + if ( InitInp%Echo ) then + EchoFile = trim(FileName)//'.ech' + call OpenEcho (UnEcho, EchoFile, errStat2, errMsg2 ); if(Failed()) return + do iLine = 1, 3 + write(UnEcho, '(A)') trim(FI%Lines(iLine)) + enddo + end if - call ReadCom( UnIn, FileName, 'UnsteadyAero Driver input file header line 2', errStat2, errMsg2 ) - call SetErrStat(errStat2, errMsg2, ErrStat, ErrMsg, RoutineName ) - if (ErrStat >= AbortErrLev) then - call Cleanup() - return - end if + iLine = 4 + ! --- Environmental conditions section + call ParseCom(FI, iLine, Line , errStat2, errMsg2, UnEcho); if(Failed()) return + call ParseVar(FI, iLine, 'FldDens', InitInp%FldDens , errStat2, errMsg2, UnEcho); if(Failed()) return + call ParseVar(FI, iLine, 'KinVisc', InitInp%KinVisc , errStat2, errMsg2, UnEcho); if(Failed()) return + call ParseVar(FI, iLine, 'SpdSound', InitInp%SpdSound, errStat2, errMsg2, UnEcho); if(Failed()) return + + ! --- UNSTEADYAERO section + call ParseCom(FI, iLine, Line , errStat2, errMsg2, UnEcho); if(Failed()) return + call ParseVar(FI, iLine, 'UAMod' , InitInp%UAMod , errStat2, errMsg2, UnEcho); if(Failed()) return + call ParseVar(FI, iLine, 'Flookup' , InitInp%Flookup , errStat2, errMsg2, UnEcho); if(Failed()) return + + ! --- AIRFOIL PROPERTIES section + call ParseCom(FI, iLine, Line , errStat2, errMsg2, UnEcho); if(Failed()) return + call ParseVar(FI, iLine, 'AirFoil' , InitInp%AirFoil1, errStat2, errMsg2, UnEcho); if(Failed()) return + call ParseVar(FI, iLine, 'Chord' , InitInp%Chord , errStat2, errMsg2, UnEcho); if(Failed()) return + call ParseAry(FI, iLine, 'Vec_AQ' , InitInp%Vec_AQ , 2, errStat2, errMsg2, UnEcho); if(Failed()) return + call ParseAry(FI, iLine, 'Vec_AT' , InitInp%Vec_AT , 2, errStat2, errMsg2, UnEcho); if(Failed()) return + call ParseVar(FI, iLine, 'UseCm' , InitInp%UseCm , errStat2, errMsg2, UnEcho); if(Failed()) return + + ! --- SIMULATION CONTROL section + call ParseCom(FI, iLine, Line , errStat2, errMsg2, UnEcho); if(Failed()) return + call ParseVar(FI, iLine, 'SimMod' , InitInp%SimMod , errStat2, errMsg2, UnEcho); if(Failed()) return + + ! --- REDUCED FREQUENCY + call ParseCom(FI, iLine, Line , errStat2, errMsg2, UnEcho); if(Failed()) return + call ParseVar(FI, iLine, 'InflowVel' , InitInp%InflowVel , errStat2, errMsg2, UnEcho); if(Failed()) return + call ParseVar(FI, iLine, 'NCycles' , InitInp%NCycles , errStat2, errMsg2, UnEcho); if(Failed()) return + call ParseVar(FI, iLine, 'StepsPerCycle', InitInp%StepsPerCycle, errStat2, errMsg2, UnEcho); if(Failed()) return + call ParseVar(FI, iLine, 'Frequency' , InitInp%Frequency , errStat2, errMsg2, UnEcho); if(Failed()) return + call ParseVar(FI, iLine, 'Amplitude' , InitInp%Amplitude , errStat2, errMsg2, UnEcho); if(Failed()) return + call ParseVar(FI, iLine, 'Mean' , InitInp%Mean , errStat2, errMsg2, UnEcho); if(Failed()) return + call ParseVar(FI, iLine, 'Phase' , InitInp%Phase , errStat2, errMsg2, UnEcho); if(Failed()) return + + ! --- PRESCRIBED AERO section + call ParseCom(FI, iLine, Line , errStat2, errMsg2, UnEcho); if(Failed()) return + call ParseVar(FI, iLine, 'TMax_PA' , InitInp%Tmax_PA , errStat2, errMsg2, UnEcho); if(Failed()) return + call ParseVar(FI, iLine, 'DT_PA' , InitInp%dt_PA , errStat2, errMsg2, UnEcho); if(Failed()) return + call ParseVar(FI, iLine, 'AeroTSFile' , InitInp%AeroTSFile , errStat2, errMsg2, UnEcho); if(Failed()) return + + ! --- ELASTIC SECTION section + call ParseCom(FI, iLine, Line , errStat2, errMsg2, UnEcho); if(Failed()) return + call ParseVar(FI, iLine, 'TMax' , InitInp%Tmax , errStat2, errMsg2, UnEcho); if(Failed()) return + call ParseVar(FI, iLine, 'DT' , InitInp%dt , errStat2, errMsg2, UnEcho); if(Failed()) return + call ParseAry(FI, iLine, 'activeDOFs' , InitInp%activeDOFs, 3, errStat2, errMsg2, UnEcho); if(Failed()) return + call ParseAry(FI, iLine, 'initPos' , InitInp%initPos , 3, errStat2, errMsg2, UnEcho); if(Failed()) return + call ParseAry(FI, iLine, 'initVel' , InitInp%initVel , 3, errStat2, errMsg2, UnEcho); if(Failed()) return + call ParseAry(FI, iLine, 'GFScaling1' , InitInp%GFScaling(1,:) , 3, errStat2, errMsg2, UnEcho); if(Failed()) return + call ParseAry(FI, iLine, 'GFScaling2' , InitInp%GFScaling(2,:) , 3, errStat2, errMsg2, UnEcho); if(Failed()) return + call ParseAry(FI, iLine, 'GFScaling3' , InitInp%GFScaling(3,:) , 3, errStat2, errMsg2, UnEcho); if(Failed()) return + call ParseAry(FI, iLine, 'MassMatrix1' , InitInp%MM(1,:) , 3, errStat2, errMsg2, UnEcho); if(Failed()) return + call ParseAry(FI, iLine, 'MassMatrix2' , InitInp%MM(2,:) , 3, errStat2, errMsg2, UnEcho); if(Failed()) return + call ParseAry(FI, iLine, 'MassMatrix3' , InitInp%MM(3,:) , 3, errStat2, errMsg2, UnEcho); if(Failed()) return + call ParseAry(FI, iLine, 'DampMatrix1' , InitInp%CC(1,:) , 3, errStat2, errMsg2, UnEcho); if(Failed()) return + call ParseAry(FI, iLine, 'DampMatrix2' , InitInp%CC(2,:) , 3, errStat2, errMsg2, UnEcho); if(Failed()) return + call ParseAry(FI, iLine, 'DampMatrix3' , InitInp%CC(3,:) , 3, errStat2, errMsg2, UnEcho); if(Failed()) return + call ParseAry(FI, iLine, 'StifMatrix1' , InitInp%KK(1,:) , 3, errStat2, errMsg2, UnEcho); if(Failed()) return + call ParseAry(FI, iLine, 'StifMatrix2' , InitInp%KK(2,:) , 3, errStat2, errMsg2, UnEcho); if(Failed()) return + call ParseAry(FI, iLine, 'StifMatrix3' , InitInp%KK(3,:) , 3, errStat2, errMsg2, UnEcho); if(Failed()) return + call ParseVar(FI, iLine, 'Twist' , InitInp%Twist , errStat2, errMsg2, UnEcho); if(Failed()) return + call ParseVar(FI, iLine, 'InflowMod' , InitInp%InflowMod , errStat2, errMsg2, UnEcho); if(Failed()) return + call ParseAry(FI, iLine, 'Inflow' , InitInp%Inflow , 2, errStat2, errMsg2, UnEcho); if(Failed()) return + call ParseVar(FI, iLine, 'InflowTSFile' , InitInp%InflowTSFile, errStat2, errMsg2, UnEcho); if(Failed()) return + call ParseVar(FI, iLine, 'MotionMod' , InitInp%MotionMod , errStat2, errMsg2, UnEcho); if(Failed()) return + call ParseVar(FI, iLine, 'MotionTSFile' , InitInp%MotionTSFile, errStat2, errMsg2, UnEcho); if(Failed()) return + + ! --- OUTPUT section + call ParseCom(FI, iLine, Line , errStat2, errMsg2, UnEcho); if(Failed()) return + call ParseVar(FI, iLine, 'SumPrint' , InitInp%SumPrint , errStat2, errMsg2, UnEcho); if(Failed()) return + call ParseVar(FI, iLine, 'WrAFITables', InitInp%WrAFITables, errStat2, errMsg2, UnEcho); if(Failed()) return + + ! --- Triggers + call GetRoot(FileName, InitInp%OutRootName) ! OutRootName is inferred from current filename. + !InitInp%OutRootName=trim(InitInp%OutRootName)//'.UA' ! For backward compatibility + !if (PathIsRelative(InitInp%OutRootName)) InitInp%OutRootName = TRIM(PriPath)//TRIM(InitInp%OutRootName) + if (PathIsRelative(InitInp%Airfoil1)) InitInp%Airfoil1 = TRIM(PriPath)//TRIM(InitInp%Airfoil1) + if (PathIsRelative(InitInp%AeroTSFile )) InitInp%AeroTSFile = TRIM(PriPath)//TRIM(InitInp%AeroTSFile ) + if (PathIsRelative(InitInp%InflowTSFile )) InitInp%InflowTSFile = TRIM(PriPath)//TRIM(InitInp%InflowTSFile) + if (PathIsRelative(InitInp%MotionTSFile )) InitInp%MotionTSFile = TRIM(PriPath)//TRIM(InitInp%MotionTSFile) + + ! --- Checks + !if (Check(.not.(any(dvr%out%fileFmt==idFmt_Valid )), 'FileFormat not implemented: '//trim(Num2LStr(InitInp%InflowMod)))) return + if (Check(.not.(any(InitInp%InflowMod==InflowMod_Valid)), 'InflowMod not implemented: '//trim(Num2LStr(InitInp%MotionMod)))) return + if (Check(.not.(any(InitInp%MotionMod==MotionMod_Valid)), 'MotionMod not implemented: '//trim(Num2LStr(InitInp%MotionMod)))) return + if (InitInp%SimMod==3) then ! Temporary to avoid changing r-test for now + !if (Check(.not.EqualRealNos(InitInp%MM(1,1), InitInp%MM(2,2), 'Mass matrix entries 11 and 22 should match.') return + + if (InitInp%Vec_AT(2)<0) call WrScr('[WARN] Vec_AT(2) is negative, but this value is usually positive (for A between T and Q)') + if (InitInp%Vec_AQ(2)>0) call WrScr('[WARN] Vec_AQ(2) is positive, but this value is usually negative (for A between T and Q)') + endif - - ! Echo Input Files. - - call ReadVar ( UnIn, FileName, InitInp%Echo, 'Echo', 'Echo Input', errStat2, errMsg2 ) - call SetErrStat(errStat2, errMsg2, ErrStat, ErrMsg, RoutineName ) - if (ErrStat >= AbortErrLev) then - call Cleanup() - return - end if - - - ! 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. - + call Cleanup() +contains + logical function Failed() + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + Failed = ErrStat >= AbortErrLev + if (Failed) call Cleanup() + end function Failed + + subroutine Cleanup() + ! Close this module's echo file if ( InitInp%Echo ) then - - EchoFile = TRIM(FileName)//'.ech' - call GetNewUnit( UnEchoLocal ) - call OpenEcho ( UnEchoLocal, EchoFile, errStat2, errMsg2 ) - call SetErrStat(errStat2, errMsg2, ErrStat, ErrMsg, RoutineName ) - if (ErrStat >= AbortErrLev) then - call Cleanup() - return - end if - - rewind(UnIn) - - call ReadCom( UnIn, FileName, 'UnsteadyAero Driver input file header line 1', errStat2, errMsg2, UnEchoLocal ) - call SetErrStat(errStat2, errMsg2, ErrStat, ErrMsg, RoutineName ) - if (ErrStat >= AbortErrLev) then - call Cleanup() - return - end if - - - call ReadCom( UnIn, FileName, 'UnsteadyAero Driver input file header line 2', errStat2, errMsg2, UnEchoLocal ) - call SetErrStat(errStat2, errMsg2, ErrStat, ErrMsg, RoutineName ) - if (ErrStat >= AbortErrLev) then - call Cleanup() - return - end if - - - ! Echo Input Files. Note this line is prevented from being echoed by the ReadVar routine. - - call ReadVar ( UnIn, FileName, InitInp%Echo, 'Echo', 'Echo the input file data', errStat2, errMsg2, UnEchoLocal ) - call SetErrStat(errStat2, errMsg2, ErrStat, ErrMsg, RoutineName ) - if (ErrStat >= AbortErrLev) then - call Cleanup() - return - end if - + close(UnEcho) end if - - !------------------------------------------------------------------------------------------------- - ! Environmental conditions section - !------------------------------------------------------------------------------------------------- - - ! Header - - call ReadCom( UnIn, FileName, 'Environmental conditions header', errStat2, errMsg2, UnEchoLocal ) - call SetErrStat(errStat2, errMsg2, ErrStat, ErrMsg, RoutineName ) - if (ErrStat >= AbortErrLev) then - call Cleanup() - return - end if - - - ! SpdSound - Speed of Sound. - - call ReadVar ( UnIn, FileName, InitInp%SpdSound, 'SpdSound', 'SpdSound', errStat2, errMsg2, UnEchoLocal ) - call SetErrStat(errStat2, errMsg2, ErrStat, ErrMsg, RoutineName ) - if (ErrStat >= AbortErrLev) then - call Cleanup() - return - end if - - - !------------------------------------------------------------------------------------------------- - ! UNSTEADYAERO section - !------------------------------------------------------------------------------------------------- - - ! Header - - call ReadCom( UnIn, FileName, 'UNSTEADYAERO header', errStat2, errMsg2, UnEchoLocal ) - call SetErrStat(errStat2, errMsg2, ErrStat, ErrMsg, RoutineName ) - if (ErrStat >= AbortErrLev) then - call Cleanup() - return - end if - - - ! OutRootName - call ReadVar ( UnIn, FileName, InitInp%OutRootName, 'OutRootName', & - 'UnsteadyAero output root filename', errStat2, errMsg2, UnEchoLocal ) - call SetErrStat(errStat2, errMsg2, ErrStat, ErrMsg, RoutineName ) - if (ErrStat >= AbortErrLev) then - call Cleanup() - return - end if - if (PathIsRelative(InitInp%OutRootName)) InitInp%OutRootName = TRIM(PriPath)//TRIM(InitInp%OutRootName) - - ! InflowVel - - call ReadVar ( UnIn, FileName, InitInp%InflowVel, 'InflowVel', & - 'Inflow velocity', errStat2, errMsg2, UnEchoLocal ) - call SetErrStat(errStat2, errMsg2, ErrStat, ErrMsg, RoutineName ) - if (ErrStat >= AbortErrLev) then - call Cleanup() - return - end if - - ! Re - - call ReadVar ( UnIn, FileName, InitInp%Re, 'Re', & - 'Reynolds number in millions', errStat2, errMsg2, UnEchoLocal ) - call SetErrStat(errStat2, errMsg2, ErrStat, ErrMsg, RoutineName ) - if (ErrStat >= AbortErrLev) then - call Cleanup() - return - end if - - ! UAMod - call ReadVar ( UnIn, FileName, InitInp%UAMod, 'UAMod', & - 'Unsteady Aero Model Switch', errStat2, errMsg2, UnEchoLocal ) - call SetErrStat(errStat2, errMsg2, ErrStat, ErrMsg, RoutineName ) - if (ErrStat >= AbortErrLev) then - call Cleanup() - return - end if - - ! Flookup - call ReadVar ( UnIn, FileName, InitInp%Flookup, 'Flookup', & - "Lookup used to determine f'", errStat2, errMsg2, UnEchoLocal ) - call SetErrStat(errStat2, errMsg2, ErrStat, ErrMsg, RoutineName ) - if (ErrStat >= AbortErrLev) then - call Cleanup() - return - end if - - - - - !------------------------------------------------------------------------------------------------- - ! AIRFOIL PROPERTIES section - !------------------------------------------------------------------------------------------------- - - ! Header - - call ReadCom( UnIn, FileName, 'AIRFOIL PROPERTIES header', errStat2, errMsg2, UnEchoLocal ) - call SetErrStat(errStat2, errMsg2, ErrStat, ErrMsg, RoutineName ) - if (ErrStat >= AbortErrLev) then - call Cleanup() - return - end if - - - - ! AirFoil1 - - call ReadVar ( UnIn, FileName, InitInp%AirFoil1, 'AirFoil1', & - 'Filename for the airfoil table and properties', errStat2, errMsg2, UnEchoLocal ) - call SetErrStat(errStat2, errMsg2, ErrStat, ErrMsg, RoutineName ) - if (ErrStat >= AbortErrLev) then - call Cleanup() - return - end if - if (PathIsRelative(InitInp%Airfoil1)) InitInp%Airfoil1 = TRIM(PriPath)//TRIM(InitInp%Airfoil1) - - ! Chord - - call ReadVar ( UnIn, FileName, InitInp%Chord, 'Chord', & - 'Chord length', errStat2, errMsg2, UnEchoLocal ) - call SetErrStat(errStat2, errMsg2, ErrStat, ErrMsg, RoutineName ) - if (ErrStat >= AbortErrLev) then - call Cleanup() - return - end if - - ! Using Cm column - call ReadVar ( UnIn, FileName, InitInp%UseCm, 'UseCm', & - "Using Cm Airfoil table data", errStat2, errMsg2, UnEchoLocal ) - call SetErrStat(errStat2, errMsg2, ErrStat, ErrMsg, RoutineName ) - if (ErrStat >= AbortErrLev) then - call Cleanup() - return - end if - - !------------------------------------------------------------------------------------------------- - ! SIMULATION CONTROL section - !------------------------------------------------------------------------------------------------- - - ! Header - - call ReadCom( UnIn, FileName, 'SIMULATION CONTROL header', errStat2, errMsg2, UnEchoLocal ) - call SetErrStat(errStat2, errMsg2, ErrStat, ErrMsg, RoutineName ) - if (ErrStat >= AbortErrLev) then - call Cleanup() - return - end if - - - ! SimMod - call ReadVar ( UnIn, FileName, InitInp%SimMod, 'SimMod', & - 'Simulation model', errStat2, errMsg2, UnEchoLocal ) - call SetErrStat(errStat2, errMsg2, ErrStat, ErrMsg, RoutineName ) - if (ErrStat >= AbortErrLev) then - call Cleanup() - return - end if - - ! NCycles - call ReadVar ( UnIn, FileName, InitInp%NCycles, 'NCycles', & - 'Number of cycles for angle-of-attack inputs', errStat2, errMsg2, UnEchoLocal ) - call SetErrStat(errStat2, errMsg2, ErrStat, ErrMsg, RoutineName ) - if (ErrStat >= AbortErrLev) then - call Cleanup() - return - end if - - ! StepsPerCycle - call ReadVar ( UnIn, FileName, InitInp%StepsPerCycle, 'StepsPerCycle', & - 'Number of timesteps per cycle', errStat2, errMsg2, UnEchoLocal ) - call SetErrStat(errStat2, errMsg2, ErrStat, ErrMsg, RoutineName ) - if (ErrStat >= AbortErrLev) then - call Cleanup() - return - end if - - ! Frequency - call ReadVar ( UnIn, FileName, InitInp%Frequency, 'Frequency', & - 'Frequency of angle-of-attack inputs', errStat2, errMsg2, UnEchoLocal ) - call SetErrStat(errStat2, errMsg2, ErrStat, ErrMsg, RoutineName ) - if (ErrStat >= AbortErrLev) then - call Cleanup() - return - end if - - ! Amplitude - call ReadVar ( UnIn, FileName, InitInp%Amplitude, 'Amplitude', & - 'Amplitude for angle-of-attack inputs', errStat2, errMsg2, UnEchoLocal ) - call SetErrStat(errStat2, errMsg2, ErrStat, ErrMsg, RoutineName ) - if (ErrStat >= AbortErrLev) then - call Cleanup() - return - end if - - ! Mean - call ReadVar ( UnIn, FileName, InitInp%Mean, 'Mean', & - 'Mean for angle-of-attack inputs', errStat2, errMsg2, UnEchoLocal ) - call SetErrStat(errStat2, errMsg2, ErrStat, ErrMsg, RoutineName ) - if (ErrStat >= AbortErrLev) then - call Cleanup() - return - end if - - ! Phase - call ReadVar ( UnIn, FileName, InitInp%Phase, 'Phase', & - 'Initial phase for angle-of-attack inputs', errStat2, errMsg2, UnEchoLocal ) - call SetErrStat(errStat2, errMsg2, ErrStat, ErrMsg, RoutineName ) - if (ErrStat >= AbortErrLev) then - call Cleanup() - return - end if - - ! InputsFile - call ReadVar ( UnIn, FileName, InitInp%InputsFile, 'InputsFile', & - 'Filename for Time series data in an ASCII input file', errStat2, errMsg2, UnEchoLocal ) - call SetErrStat(errStat2, errMsg2, ErrStat, ErrMsg, RoutineName ) - if (ErrStat >= AbortErrLev) then - call Cleanup() - return - end if - - - !------------------------------------------------------------------------------------------------- - ! OUTPUT section - !------------------------------------------------------------------------------------------------- - call ReadCom( UnIn, FileName, 'Output conditions header', errStat2, errMsg2, UnEchoLocal ); if(Failed()) return - call ReadVar( UnIn, FileName, InitInp%SumPrint, 'SumPrint', 'Write unsteady aerodynamic summary file', errStat2, errMsg2, UnEchoLocal ); call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - call ReadVar( UnIn, FileName, InitInp%WrAFITables, 'WrAFITables', 'Write airfoil coefficients used by Airfoil Info', errStat2, errMsg2, UnEchoLocal ); call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - if (ErrStat >= AbortErrLev) then - ! Temporarily allowing backward compatibility.. - call WrScr('') - call WrScr('[WARN] An error occured when reading the output section of the UA Driver input file.') - call WrScr(' Make sure it is at the latest version. See error message below:') - call WrScr(trim(ErrMsg)) - call WrScr('') - call WrScr('[INFO] Continuing using default output options.') - call WrScr('') - InitInp%SumPrint = .True. - InitInp%WrAFITables = .True. - ErrStat = ErrID_None - ErrMsg = '' + Call NWTC_Library_Destroyfileinfotype(FI, errStat2, errMsg2) + end subroutine Cleanup + + logical function Check(Condition, errMsg_in) + logical, intent(in) :: Condition + character(len=*), intent(in) :: errMsg_in + Check=Condition + if (Check) then + call SetErrStat( ErrID_Fatal, errMsg_in, errStat, errMsg, RoutineName ) + endif + end function Check + +end subroutine ReadDriverInputFile +!-------------------------------------------------------------------------------------------------------------- +subroutine Dvr_SetParameters(p, errStat, errMsg) + type(Dvr_Parameters), intent(inout) :: p + integer, intent(out ) :: errStat ! returns a non-zero value when an error occurs + character(*), intent(out ) :: errMsg ! Error message if ErrStat /= ErrID_None + integer(IntKi) :: errStat2 ! Status of error message + character(1024) :: errMsg2 ! Error message if ErrStat /= ErrID_None + errStat2= ErrID_None + errStat = ErrID_None + errMsg = '' + ! Unit conversions + p%Twist = p%Twist * D2R + p%d_34_to_ac = (-p%Vec_AQ(2) + p%Vec_AT(2)) ! d_34_to_ac = d_QT ~0.5 [-], Approximated using y coordinate + p%Vec_AT = p%Vec_AT * p%chord + p%Vec_AQ = p%Vec_AQ * p%chord + + if ( p%SimMod == 1 ) then + call WrScr('[WARN] The behavior of SimMod=1 might change in the future.') + + ! We will use a constant Reynolds.. + p%Re = p%InflowVel * p%chord/ p%KinVisc ! NOT IN MILLIONS + print*,' Re ',p%Re + ! Using the frequency and NCycles, determine how long the simulation needs to run + p%simTime = p%NCycles/p%Frequency + p%numSteps = p%StepsPerCycle*p%NCycles ! we could add 1 here to make this a complete cycle + p%dt = p%simTime / p%numSteps + + else if ( p%SimMod == 2 ) then + ! Read time-series data file with columns:( time, Angle-of-attack, Vrel, omega ) + call WrScr( ' Opening prescribed-aero time-series input file: '//trim(p%AeroTSFile) ) + call ReadDelimFile(p%AeroTSFile, 4, p%vPrescrAero, errStat2, errMsg2); if(Failed()) return + p%vPrescrAero(:,2) = p%vPrescrAero(:,2)*D2R ! Deg 2 rad + p%dt = p%dt_PA + p%simTime = p%TMax_PA + p%numSteps = int(p%simTime/p%dt) + + elseif ( p%SimMod == 3 ) then + p%simTime = p%TMax + p%numSteps = int(p%simTime/p%dt) + + if (p%InflowMod==InflowMod_File) then + ! Read inflow file + call ReadDelimFile(p%InflowTSFile, 3, p%vU0, errStat2, errMsg2); if(Failed()) return endif - call Cleanup() - contains - logical function Failed() - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - Failed = ErrStat >= AbortErrLev - if (Failed) call Cleanup() - end function Failed - subroutine Cleanup() - ! Close this module's echo file - if ( InitInp%Echo ) then - close(UnEchoLocal) - end if - close( UnIn ) - end subroutine Cleanup - end subroutine ReadDriverInputFile - - subroutine ReadTimeSeriesData( inputsFile, nSimSteps, timeArr, AOAarr, Uarr, OmegaArr, ErrStat, ErrMsg ) - character(1024), intent( in ) :: inputsFile - integer, intent( out ) :: nSimSteps - real(DbKi),allocatable, intent( out ) :: timeArr(:) - real(ReKi),allocatable, intent( out ) :: AOAarr(:) - real(ReKi),allocatable, intent( out ) :: Uarr(:) !RRD - real(ReKi),allocatable, intent( out ) :: OmegaArr(:) - integer, intent( out ) :: ErrStat ! returns a non-zero value when an error occurs - character(*), intent( out ) :: ErrMsg ! Error message if ErrStat /= ErrID_None - - real(SiKi) :: dt - real(DbKi) :: tmpArr(4) - integer(IntKi) :: errStat2 ! Status of error message - character(1024) :: errMsg2 ! Error message if ErrStat /= ErrID_None - character(*), parameter :: RoutineName = 'ReadTimeSeriesData' - character(1024) :: FileName - integer :: UnIn - integer :: i - integer, PARAMETER ::hdrlines=8 ! RRD - - ErrStat = ErrID_None - ErrMsg = '' - nSimSteps = 0 ! allocate here in case errors occur - - FileName = trim(inputsFile) - - call GetNewUnit( UnIn ) - call OpenFInpFile( UnIn, FileName, errStat2, errMsg2 ) - call SetErrStat(errStat2, errMsg2, ErrStat, ErrMsg, RoutineName ) - if (ErrStat >= AbortErrLev) then - call Cleanup() - return - end if - - - call WrScr( ' Opening UnsteadyAero time-series input file: '//FileName ) - - - !------------------------------------------------------------------------------------------------- - ! Determine how many lines of data are in the file: - !------------------------------------------------------------------------------------------------- - do i=1,hdrlines !RRD - call ReadCom( UnIn, FileName, ' UnsteadyAero time-series input file header line 1', errStat2, errMsg2 ) - call SetErrStat(errStat2, errMsg2, ErrStat, ErrMsg, RoutineName ) - if (ErrStat >= AbortErrLev) then - call Cleanup() - return - end if - enddo - - do - call ReadAry( UnIn, FileName, tmpArr, 4, 'Data', 'Time-series data', errStat2, errMsg2 ) - ! The assumption is that the only parsing error occurs at the end of the file and therefore we stop reading data - if (errStat2 > ErrID_None) then - exit - else - nSimSteps = nSimSteps + 1 - end if - end do - - !------------------------------------------------------------------------------------------------- - ! Allocate arrays to be read - !------------------------------------------------------------------------------------------------- - allocate ( timeArr( nSimSteps ), STAT=ErrStat2 ) - if ( ErrStat2 /= 0 ) then - call SetErrStat( ErrID_Fatal, 'Error trying to allocate timeArr.', ErrStat, ErrMsg, RoutineName) - call Cleanup() - return - end if - - allocate ( AOAarr( nSimSteps ), STAT=ErrStat2 ) - if ( ErrStat2 /= 0 ) then - call SetErrStat( ErrID_Fatal, 'Error trying to allocate AOAarr.', ErrStat, ErrMsg, RoutineName) - call Cleanup() - return - end if + endif - allocate ( Uarr( nSimSteps ), OmegaArr( nSimSteps ), STAT=ErrStat2 ) - if ( ErrStat2 /= 0 ) then - call SetErrStat( ErrID_Fatal, 'Error trying to allocate Uarr and OmegaArr.', ErrStat, ErrMsg, RoutineName) - call Cleanup() - return - end if - - - !------------------------------------------------------------------------------------------------- - ! Read arrays from file - !------------------------------------------------------------------------------------------------- - rewind(UnIn) - do i=1,hdrlines !RRD - call ReadCom( UnIn, FileName, ' UnsteadyAero time-series input file header line 1', errStat2, errMsg2 ) - enddo - do i = 1,nSimSteps - call ReadAry( UnIn, FileName, tmpArr, 4, 'Data', 'Time-series data', errStat2, errMsg2 ) - timeArr(i) = tmpArr(1) - AOAarr(i) = real(tmpArr(2),ReKi) - Uarr(i) = real(tmpArr(3),ReKi) - OmegaArr(i) = real(tmpArr(4),ReKi) - end do - - if (nSimSteps > 1) then - dt = timeArr(2) - timeArr(1) - - do i = 2,nSimSteps-1 - if (.not. EqualRealNos(dt, REAL(timeArr(i+1)-timeArr(i), SiKi) ) ) then - call SetErrStat( ErrID_Fatal, 'Times in InputsFile must be contain the same delta t.', ErrStat, ErrMsg, RoutineName) - exit !exit the do loop - end if - end do - end if - - call Cleanup() - - contains - !==================================================================================================== - subroutine Cleanup() - ! The routine cleans up the module echo file and resets the NWTC_Library, reattaching it to - ! any existing echo information - !---------------------------------------------------------------------------------------------------- - ! logical, intent( in ) :: EchoFlag ! local version of echo flag - ! integer, intent( in ) :: UnEcho ! echo unit number - - ! Close this module's echo file - - - close( UnIn ) - - end subroutine Cleanup - end subroutine ReadTimeSeriesData + if(Failed()) return +contains + logical function Failed() + call setErrStat(errStat2, errMsg2, errStat, errMsg, 'Dvr_SetParameters') + Failed = ErrStat >= AbortErrLev + end function Failed +end subroutine Dvr_SetParameters !-------------------------------------------------------------------------------------------------------------- - subroutine Init_AFI(UAMod, NumAFfiles, afNames, UseCm, UA_f_cn, AFI_Params, ErrStat, ErrMsg) - +subroutine driverInputsToUAInitData(p, InitInData, AFI_Params, AFIndx, errStat, errMsg) + type(Dvr_Parameters) , intent(in ) :: p ! Initialization data for the driver program + type(UA_InitInputType) , intent(out) :: InitInData ! Input data for initialization + type(AFI_ParameterType), intent(out) :: AFI_Params(NumAFfiles) + integer, allocatable , intent(out) :: AFIndx(:,:) + integer(IntKi), intent(out) :: errStat ! Error status. + character(*), intent(out) :: errMsg ! Error message. + character(1024) :: afNames(NumAFfiles) + integer(IntKi) :: errStat2 ! Status of error message + character(1024) :: errMsg2 ! Error message if ErrStat /= ErrID_None + character(*), parameter :: RoutineName = 'driverInputsToUAInitData' + + errStat = ErrID_None + errMsg = '' + + InitInData%UA_OUTS = 1 ! 0=None, 1=Write Outputs, 2=Separate File +#ifdef ADD_UA_OUTS + InitInData%UA_OUTS = 2 ! Compiler Flag Override, 2=Write a separate file +#endif + + + ! -- UA Init Input Data + InitInData%nNodesPerBlade = 1 + InitInData%numBlades = 1 + call AllocAry(InitInData%c, InitInData%nNodesPerBlade, InitInData%numBlades, 'chord', errStat2, errMsg2); if(Failed()) return + call AllocAry(InitInData%UAOff_innerNode , InitInData%numBlades, 'UAO' , errStat2, errMsg2); if(Failed()) return + call AllocAry(InitInData%UAOff_outerNode , InitInData%numBlades, 'UAO' , errStat2, errMsg2); if(Failed()) return + + ! don't turn off UA based on span location: + InitInData%UAOff_innerNode = 0 + InitInData%UAOff_outerNode = InitInData%nNodesPerBlade + 1 + InitInData%a_s = p%SpdSound + InitInData%c(1,1) = p%Chord + InitInData%UAMod = p%UAMod + InitInData%IntegrationMethod = UA_Method_ABM4 + InitInData%Flookup = p%Flookup + InitInData%OutRootName = trim(p%OutRootName)//'.UA' + InitInData%WrSum = p%SumPrint + InitInData%d_34_to_ac = p%d_34_to_ac ! d_34_to_ac = d_QT ~0.5 [-], Approximated using y coordinate + + ! --- AFI + allocate(AFIndx(InitInData%nNodesPerBlade,InitInData%numBlades), STAT = errStat2) + if ( errStat2 /= 0 ) then + call SetErrStat( ErrID_Fatal, 'Error trying to allocate InitInData%AFIndx.', errStat, errMsg, RoutineName) + return + end if + AFIndx(1,1) = 1 + + afNames(1) = p%AirFoil1 ! All nodes/blades are using the same 2D airfoil + call Init_AFI( InitInData%UAMod, NumAFfiles, afNames, p%UseCm, AFI_Params, errStat2, errMsg2); if(Failed()) return + + if (p%WrAFITables) then + call AFI_WrTables(AFI_Params(1), InitInData%UAMod, p%OutRootName) + endif +contains + logical function Failed() + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + Failed = ErrStat >= AbortErrLev + end function Failed +endsubroutine driverInputsToUAInitData +!-------------------------------------------------------------------------------------------------------------- +subroutine Init_AFI(UAMod, NumAFfiles, afNames, UseCm, AFI_Params, ErrStat, ErrMsg) integer, intent(in ) :: UAMod integer, intent(in ) :: NumAFfiles CHARACTER(1024), intent(in ) :: afNames(NumAFfiles) logical, intent(in ) :: UseCm - logical, intent(in ) :: UA_f_cn type(AFI_ParameterType), intent( out) :: AFI_Params(NumAFfiles) integer(IntKi), intent( out) :: ErrStat ! Error status. character(*), intent( out) :: ErrMsg ! Error message. @@ -552,16 +464,10 @@ subroutine Init_AFI(UAMod, NumAFfiles, afNames, UseCm, UA_f_cn, AFI_Params, ErrS integer(IntKi) :: errStat2 ! Status of error message character(1024) :: errMsg2 ! Error message if ErrStat /= ErrID_None character(*), parameter :: RoutineName = 'Init_AFI' - - ! Initialize the Airfoil Info module - ! Setup Airfoil info - + UnEc = 0 - ErrStat = ErrID_None ErrMsg = "" - - ! Set this to 1 to use the UA coefs !AFI_InitInputs%UA_Model = 1 ! This is the number of columns of coefs in the AOA table: Cl, Cd, Cm, for example, but doesn't include Alpha @@ -575,15 +481,15 @@ subroutine Init_AFI(UAMod, NumAFfiles, afNames, UseCm, UA_f_cn, AFI_Params, ErrS else AFI_InitInputs%InCol_Cm = 0 end if - + AFI_InitInputs%InCol_Cpmin = 0 AFI_InitInputs%AFTabMod = AFITable_1 ! 1D-interpolation (on AoA only) - AFI_InitInputs%UA_f_cn = UA_f_cn + AFI_InitInputs%UAMod = UAMod ! We calculate some of the UA coefficients based on UA Model do i=1,NumAFfiles AFI_InitInputs%FileName = afNames(i) !InitInp%AF_File(i) - ! Call AFI_Init to read in and process the airfoil files. + ! Read in and process the airfoil files. ! This includes creating the spline coefficients to be used for interpolation. call AFI_Init ( AFI_InitInputs, AFI_Params(i), errStat2, errMsg2, UnEc ) @@ -595,128 +501,517 @@ subroutine Init_AFI(UAMod, NumAFfiles, afNames, UseCm, UA_f_cn, AFI_Params, ErrS end do call Cleanup() - - - contains - - !==================================================================================================== - subroutine Cleanup() - ! The routine cleans up data arrays framework structures - ! - !---------------------------------------------------------------------------------------------------- - !Clean up initialization inputs - call AFI_DestroyInitInput(AFI_InitInputs, errStat2, errMsg2) - - - - end subroutine Cleanup - end subroutine Init_AFI - - - subroutine WriteAFITables(AFI_Params, OutRootName, UseCm, UA_f_cn) - - type(AFI_ParameterType), intent(in), target :: AFI_Params - character(len=*) , intent(in) :: OutRootName - logical , intent(in) :: UseCm - logical , intent(in) :: UA_f_cn - - integer(IntKi) :: unOutFile - integer(IntKi) :: ErrStat - character(ErrMsgLen) :: ErrMsg - - Real(ReKi), allocatable :: cl_smooth(:) - Real(ReKi), allocatable :: cn_smooth(:) - Real(ReKi), allocatable :: cn(:) - Real(ReKi), allocatable :: cl_lin(:) - Real(ReKi), allocatable :: cn_lin(:) - character(len=3) :: Prefix - character(len=11) :: sFullyAtt - character(len=8) :: sCm - integer :: iTab, iRow, iStartUA - type(AFI_Table_Type), pointer :: tab !< Alias - - if (UA_f_cn) then - Prefix='Cn_' - sFullyAtt='Cn_FullyAtt' - else - Prefix='Cl_' - sFullyAtt='Dummy' - endif - if (UseCm) then - sCm='Cm' + +contains + subroutine Cleanup() + call AFI_DestroyInitInput(AFI_InitInputs, errStat2, errMsg2) + end subroutine Cleanup +end subroutine Init_AFI +!-------------------------------------------------------------------------------------------------------------- +!> Set Inflow inputs +subroutine setInflow(t, p, U0, m) + real(DbKi), intent(in) :: t + type(Dvr_Parameters), intent(in) :: p + type(Dvr_Misc ), intent(inout) :: m + real(ReKi), dimension(:), intent(out) :: U0 + if (p%InflowMod == InflowMod_Cst) then + U0(:) = p%Inflow + else if (p%InflowMod == InflowMod_File) then + call interpTimeValue(p%vU0, t, m%iU0Last, U0(:)) + else + print*,'Should never happen' + STOP + endif +end subroutine setInflow +!-------------------------------------------------------------------------------------------------------------- +!> Compute aerodynamic kinematics quantities (velocities and angles) at different points +subroutine AeroKinematics(U0, q, qd, p, m) + real(ReKi), intent(in) :: U0(2) !< Free stream + real(ReKi), intent(in) :: q(3) !< Elastic positions x,y,th + real(ReKi), intent(in) :: qd(3) !< Elastic velocities + type(Dvr_Parameters), intent(in ) :: p !< Parameters + type(Dvr_Misc), intent(inout) :: m !< Misc aero var + real(ReKi), parameter :: W(2) =0 ! Induced velocities + real(ReKi) :: ST, CT + + ! Full twist + m%twist_full = q(3) + p%Twist ! + Pitch if a controller is added + ST = sin(m%twist_full) + CT = cos(m%twist_full) + + ! Structual velocity including torsional velocity + m%Vst_T(1) = qd(1) + qd(3) * (-p%Vec_AT(1)*ST + p%Vec_AT(2)*CT) + m%Vst_T(2) = qd(2) + qd(3) * ( p%Vec_AT(1)*CT + p%Vec_AT(2)*ST) + + m%Vst_Q(1) = qd(1) + qd(3) * (-p%Vec_AQ(1)*ST + p%Vec_AQ(2)*CT) + m%Vst_Q(2) = qd(2) + qd(3) * ( p%Vec_AQ(1)*CT + p%Vec_AQ(2)*ST) + + ! Relative velocity, Vrel = U0 - Vst + W + m%Vrel_T = U0 - m%Vst_T + W + m%Vrel_Q = U0 - m%Vst_Q + W + + ! Squared velocity norm + m%Vrel_norm2_T = m%Vrel_T(1)**2 + m%Vrel_T(2)**2 + m%Vrel_norm2_Q = m%Vrel_Q(1)**2 + m%Vrel_Q(2)**2 + + ! Flow angle + m%phi_Q = atan2(m%Vrel_Q(1), m%Vrel_Q(2)) + m%phi_T = atan2(m%Vrel_T(1), m%Vrel_T(2)) + + ! Angle of attack + m%alpha_Q = m%phi_Q - m%twist_full + m%alpha_T = m%phi_T - m%twist_full + + ! Reynolds at 1/4 chord + m%Re = sqrt(m%Vrel_norm2_Q) * p%chord / p%KinVisc +end subroutine AeroKinematics + +!-------------------------------------------------------------------------------------------------------------- +!> Compute aerodynamic kinetics quantities (loads) +subroutine AeroKinetics(U0, q, qd, C_dyn, p, m) + real(ReKi), intent(in) :: U0(2) !< Free stream + real(ReKi), intent(in) :: q(3) !< Elastic positions x,y,th + real(ReKi), intent(in) :: qd(3) !< Elastic velocities + real(ReKi), intent(in) :: C_dyn(3) !< Dynamic aerodynamic coefficients (Cl, Cd, Cm) + type(Dvr_Parameters), intent(in ) :: p !< Parameters + type(Dvr_Misc), intent(inout) :: m !< Misc aero var + real(ReKi) :: ST, CT + real(ReKi) :: SP, CP + real(ReKi) :: q_dyn + + ! First get kinematics + call AeroKinematics(U0, q, qd, p, m) + + ST = sin(m%twist_full) + CT = cos(m%twist_full) + + ! Loads at Q + q_dyn = 0.5_ReKi * p%FldDens * p%chord * m%Vrel_norm2_Q + m%L = q_dyn * C_dyn(1) + m%D = q_dyn * C_dyn(2) + m%tau_Q = q_dyn * C_dyn(3) * p%chord + + ! Loads at A + SP = sin(m%phi_Q) + CP = cos(m%phi_Q) + m%FxA = m%L * CP + m%D * SP + m%FyA = -m%L * SP + m%D * CP + ! Tau A (Positive about "z") - version 1 + m%tau_A = m%tau_Q + m%tau_A = m%tau_A - m%FxA * (- p%Vec_AQ(1) * ST + p%Vec_AQ(2) * CT) + m%tau_A = m%tau_A + m%FyA * ( p%Vec_AQ(1) * CT + p%Vec_AQ(2) * ST) + ! Tau A (Positive about "z") - version 2 + !SA = sin(m%alpha_Q) + !CA = cos(m%alpha_Q) + !tau_A2 = m%tau_Q + !tau_A2 = tau_A2 - q_dyn *C_dyn(1)* ( p%Vec_AQ(1) * SA + p%Vec_AQ(2) * CA) + !tau_A2 = tau_A2 + q_dyn *C_dyn(2)* ( p%Vec_AQ(1) * CA - p%Vec_AQ(2) * SA) + + ! Generalized loads + m%GF(1) = m%FxA * p%GFScaling(1,1) + m%FyA * p%GFScaling(1,2) - m%tau_A * p%GFScaling(1,3) + m%GF(2) = m%FxA * p%GFScaling(2,1) + m%FyA * p%GFScaling(2,2) - m%tau_A * p%GFScaling(2,3) + m%GF(3) = m%FxA * p%GFScaling(3,1) + m%FyA * p%GFScaling(3,2) - m%tau_A * p%GFScaling(3,3) + +end subroutine AeroKinetics +!---------------------------------------------------------------------------------------------------- + +!> Set LinDyn inputs (scaled aerodynamic forces at point A) +subroutine setLDinputs(U0, LD_x, UA_y, p, m, LD_u) + real(ReKi) , intent(in ) :: U0(2) !< Parameters + type(LD_ContinuousStateType), intent(in ) :: LD_x !< LinDyn states + type(UA_OutputType), intent(in ) :: UA_y !< UA outputs + type(Dvr_Parameters), intent(in ) :: p !< Parameters + type(Dvr_Misc), intent(inout) :: m !< Misc aero var + type(LD_InputType), intent(inout) :: LD_u !< LinDyn inputs + + call AeroKinetics (U0, LD_x%q(1:3), LD_x%q(4:6), (/UA_y%Cl, UA_y%Cd, UA_y%Cm/), p, m) + LD_u%Fext(1) = m%GF(1) + LD_u%Fext(2) = m%GF(2) + LD_u%Fext(3) = m%GF(3) + +end subroutine setLDinputs + +!---------------------------------------------------------------------------------------------------- +!> Set UA Inputs from Flow and LinDyn +subroutine setUAinputs(U0, LD_x, p, m, UA_u) + real(ReKi) , intent(in ) :: U0(2) !< Parameters + type(LD_ContinuousStateType), intent(in ) :: LD_x !< LinDyn states + type(Dvr_Parameters), intent(in ) :: p !< Parameters + type(Dvr_Misc), intent(inout) :: m !< Misc aero var + type(UA_InputType), intent(inout) :: UA_u !< UA inputs + + call AeroKinematics(U0, LD_x%q(1:3), LD_x%q(4:6), p, m) + UA_u%UserProp = 0 + UA_u%Re = m%Re + UA_u%omega = -LD_x%q(6) ! NOTE: theta convention for the driver is negative along z, but UA expect an omega along z + ! Angle of attack and relative velocity at 1/4 point/aerodynamic center point "Q" + UA_u%alpha = m%alpha_Q + UA_u%U = sqrt(m%Vrel_norm2_Q) + UA_u%v_ac(1) = UA_u%U * sin(UA_u%alpha) ! In airfoil coordinate system (a) + UA_u%v_ac(2) = UA_u%U * cos(UA_u%alpha) ! In airfoil coordinate system (a) +end subroutine setUAinputs + +!---------------------------------------------------------------------------------------------------- +!> Set UA inptus for a simulation where the angle of attack is prescribed and the relative velocity is constant +subroutine setUAinputsAlphaSim(n, u, t, p, m, errStat, errMsg) + integer, intent(in) :: n + type(UA_InputType), intent(inout) :: u ! System inputs + real(DbKi), intent( out) :: t + type(Dvr_Parameters), intent(in) :: p ! Initialization data for the driver program + type(Dvr_Misc ), intent(inout) :: m ! Initialization data for the driver program + integer, intent(out) :: errStat + character(len=*), intent(out) :: errMsg + real(ReKi) :: phase + real(ReKi) :: d_ref2AC + real(ReKi) :: alpha_ref + real(ReKi) :: U_ref + real(ReKi) :: v_ref(2) + real(ReKi) :: v_34(2) + logical, parameter :: OscillationAtMidChord=.true. ! for legacy, use false + logical, parameter :: VelocityAt34 =.true. ! for legacy, use false + + ! Initialize error handling variables + ErrMsg = '' + ErrStat = ErrID_None + + u%UserProp = 0 + t = (n-1)*p%dt + + if ( p%SimMod == 1 ) then + if (OscillationAtMidChord) then + d_ref2AC = -0.25_ReKi ! -0.25: oscillations at mid_chord + d_ref2AC = -p%d_34_to_ac/2. ! TODO else - sCm='Cm_Dummy' + d_ref2AC = 0.0_ReKi ! 0: oscillations at AC endif + U_ref = p%InflowVel ! m/s + phase = (n+p%Phase-1)*2*pi/p%StepsPerCycle + alpha_ref = (p%Amplitude * sin(phase) + p%Mean)*D2R ! This needs to be in radians + v_ref(1) = sin(alpha_ref)*U_ref + v_ref(2) = cos(alpha_ref)*U_ref + u%omega = p%Amplitude * cos(phase) * 2*pi/p%StepsPerCycle / p%dt * D2R ! This needs to be in radians derivative: d_alpha /d_t - ! Loop on tables, write a different file for each table. - do iTab = 1, size(AFI_Params%Table) - tab => AFI_Params%Table(iTab) + u%v_ac(1) = v_ref(1) + u%omega * d_ref2AC* p%Chord + u%v_ac(2) = v_ref(2) - ! Compute derived parameters from cl and cd, and UA_BL - if(allocated(cl_smooth)) deallocate(cl_smooth) - if(allocated(cn_smooth)) deallocate(cn_smooth) - if(allocated(cn )) deallocate(cn ) - if(allocated(cl_lin )) deallocate(cl_lin ) - if(allocated(cn_lin )) deallocate(cn_lin ) - allocate(cl_smooth(tab%NumAlf)) - allocate(cn_smooth(tab%NumAlf)) - allocate(cn (tab%NumAlf)) - allocate(cl_lin (tab%NumAlf)) - allocate(cn_lin (tab%NumAlf)) + u%alpha = atan2(u%v_ac(1), u%v_ac(2) ) ! + if (VelocityAt34) then + v_34(1) = u%v_ac(1) + u%omega * 0.5* p%Chord + v_34(2) = u%v_ac(2) + + u%U = sqrt(v_34(1)**2 + v_34(2)**2) ! Using U at 3/4 + else + u%U = sqrt(u%v_ac(1)**2 + u%v_ac(2)**2) ! Using U at 1/4 + endif + u%Re = p%Re ! Option for constant Reynolds or not? + + else + ! Interpolate at current time + call interpTimeValue(p%vPrescrAero, t, m%iPALast, m%uPA) + u%alpha = m%uPA(1) ! rad + u%U = m%uPA(2) + u%omega = m%uPA(3) + u%v_ac(1) = sin(u%alpha)*u%U + u%v_ac(2) = cos(u%alpha)*u%U + u%Re = u%U * p%chord / p%KinVisc + end if + +end subroutine setUAinputsAlphaSim + +!---------------------------------------------------------------------------------------------------------------------------------- +subroutine Dvr_EndSim(dvr, errStat, errMsg) + type(Dvr_Data), target, intent(inout) :: dvr ! driver data + integer(IntKi) , intent(out) :: errStat ! Status of error message + character(*) , intent(out) :: errMsg ! Error message if errStat /= ErrID_None + character(ErrMsgLen) :: errMsg2 ! temporary Error message if errStat /= ErrID_None + integer(IntKi) :: errStat2 ! temporary Error status of the operation + character(*), parameter :: RoutineName = 'Dvr_EndSim' + type(Dvr_Outputs), pointer :: out ! driver output, data + out => dvr%out + errStat = ErrID_None + errMsg = '' + ! Close the output file + if (out%fileFmt==idFmt_Both .or. out%fileFmt == idFmt_Ascii) then + if (out%unOutFile > 0) close(out%unOutFile) + endif + if (out%fileFmt==idFmt_Both .or. out%fileFmt == idFmt_Binary) then + call WrScr(' Writing output file: '//trim(out%Root)//'.outb') + call WrBinFAST(trim(out%Root)//'.outb', FileFmtID_ChanLen_In, 'AeroDynDriver', out%WriteOutputHdr, out%WriteOutputUnt, (/0.0_DbKi, dvr%p%dt/), out%storage(:,:), errStat2, errMsg2) + call SetErrStat(errStat2, errMsg2, errStat, errMsg, RoutineName) + endif +end subroutine Dvr_EndSim + + + + + +! -------------------------------------------------------------------------------- +! --- IO +! -------------------------------------------------------------------------------- +!---------------------------------------------------------------------------------------------------------------------------------- +!> Concatenate new output channels info to the extisting ones in the driver +!! TODO COPY PASTED FROM AeroDyn_Inflow. Should be placed in NWTC_Lib NWTC_Str +subroutine concatOutputHeaders(WriteOutputHdr0, WriteOutputUnt0, WriteOutputHdr, WriteOutputUnt, errStat, errMsg) + character(ChanLen), dimension(:), allocatable, intent(inout) :: WriteOutputHdr0 !< Channel headers + character(ChanLen), dimension(:), allocatable, intent(inout) :: WriteOutputUnt0 !< Channel units + character(ChanLen), dimension(:), allocatable, intent(inout) :: WriteOutputHdr !< Channel headers + character(ChanLen), dimension(:), allocatable, intent(inout) :: WriteOutputUnt !< Channel units + integer(IntKi) , intent( out) :: errStat !< Status of error message + character(*) , intent( out) :: errMsg !< Error message if errStat /= ErrID_None + ! Locals + character(ChanLen), allocatable :: TmpHdr(:) + character(ChanLen), allocatable :: TmpUnt(:) + integer :: nOld, nAdd + errStat = ErrID_None + errMsg = '' + if (.not.allocated(WriteOutputHdr)) return + if (.not.allocated(WriteOutputHdr0)) then + call move_alloc(WriteOutputHdr, WriteOutputHdr0) + call move_alloc(WriteOutputUnt, WriteOutputUnt0) + else + nOld = size(WriteOutputHdr0) + nAdd = size(WriteOutputHdr) + + call move_alloc(WriteOutputHdr0, TmpHdr) + call move_alloc(WriteOutputUnt0, TmpUnt) + + allocate(WriteOutputHdr0(nOld+nAdd)) + allocate(WriteOutputUnt0(nOld+nAdd)) + WriteOutputHdr0(1:nOld) = TmpHdr + WriteOutputUnt0(1:nOld) = TmpUnt + WriteOutputHdr0(nOld+1:nOld+nAdd) = WriteOutputHdr + WriteOutputUnt0(nOld+1:nOld+nAdd) = WriteOutputUnt + deallocate(TmpHdr) + deallocate(TmpUnt) + endif +end subroutine concatOutputHeaders +!---------------------------------------------------------------------------------------------------------------------------------- +!> Initialize outputs to file for driver +subroutine Dvr_InitializeOutputs(out, numSteps, errStat, errMsg) + type(Dvr_Outputs), intent(inout) :: out + integer(IntKi) , intent(in ) :: numSteps ! Number of time steps + integer(IntKi) , intent( out) :: errStat ! Status of error message + character(*) , intent( out) :: errMsg ! Error message if errStat /= ErrID_None + ! locals + integer(IntKi) :: numOuts +! integer(IntKi) :: i +! integer(IntKi) :: numSpaces +! integer(IntKi) :: iWT +! character(ChanLen) :: colTxt +! character(ChanLen) :: caseTxt +! + numOuts = size(out%WriteOutputHdr) + + call AllocAry(out%outLine, numOuts-1, 'outLine', errStat, errMsg); ! NOTE: time not stored + out%outLine=0.0_ReKi +! +! ! --- Ascii +! if (out%fileFmt==idFmt_Both .or. out%fileFmt == idFmt_Ascii) then +! +! ! compute the width of the column output +! numSpaces = out%ActualChanLen ! the size of column produced by OutFmt +! out%ActualChanLen = max( out%ActualChanLen, MinChanLen ) ! set this to at least MinChanLen , or the size of the column produced by OutFmt +! do i=1,numOuts +! out%ActualChanLen = max(out%ActualChanLen, LEN_TRIM(out%WriteOutputHdr(i))) +! out%ActualChanLen = max(out%ActualChanLen, LEN_TRIM(out%WriteOutputUnt(i))) +! end do +! +! ! create format statements for time and the array outputs: +! out%Fmt_t = '(F'//trim(num2lstr(out%ActualChanLen))//'.4)' +! out%Fmt_a = '"'//out%delim//'"'//trim(out%outFmt) ! format for array elements from individual modules +! numSpaces = out%ActualChanLen - numSpaces ! the difference between the size of the headers and what is produced by OutFmt +! if (numSpaces > 0) then +! out%Fmt_a = trim(out%Fmt_a)//','//trim(num2lstr(numSpaces))//'x' +! end if +! +! ! --- Start writing to ascii input file +! do iWT=1,nWT +! if (nWT>1) then +! sWT = '.T'//trim(num2lstr(iWT)) +! else +! sWT = '' +! endif +! call GetNewUnit(out%unOutFile(iWT), errStat, errMsg) +! if ( errStat >= AbortErrLev ) then +! out%unOutFile(iWT) = -1 +! return +! end if +! call OpenFOutFile ( out%unOutFile(iWT), trim(out%Root)//trim(sWT)//'.out', errStat, errMsg ) +! if ( errStat >= AbortErrLev ) return +! write (out%unOutFile(iWT),'(/,A)') 'Predictions were generated on '//CurDate()//' at '//CurTime()//' using '//trim( version%Name ) +! write (out%unOutFile(iWT),'(1X,A)') trim(GetNVD(out%AD_ver)) +! write (out%unOutFile(iWT),'()' ) !print a blank line +! write (out%unOutFile(iWT),'()' ) !print a blank line +! write (out%unOutFile(iWT),'()' ) !print a blank line +! +! ! Write the names of the output parameters on one line: +! do i=1,numOuts +! call WrFileNR ( out%unOutFile(iWT), out%delim//out%WriteOutputHdr(i)(1:out%ActualChanLen) ) +! end do ! i +! write (out%unOutFile(iWT),'()') +! +! ! Write the units of the output parameters on one line: +! do i=1,numOuts +! call WrFileNR ( out%unOutFile(iWT), out%delim//out%WriteOutputUnt(i)(1:out%ActualChanLen) ) +! end do ! i +! write (out%unOutFile(iWT),'()') +! enddo +! endif +! + ! --- Binary + if (out%fileFmt==idFmt_Both .or. out%fileFmt == idFmt_Binary) then + call AllocAry(out%storage, numOuts-1, numSteps, 'storage', errStat, errMsg) + out%storage= myNaN !0.0_ReKi ! Alternative: myNaN + endif +end subroutine Dvr_InitializeOutputs +!---------------------------------------------------------------------------------------------------------------------------------- +!> Initialize driver (not module-level) output channels +subroutine Dvr_InitializeDriverOutputs(dvr, out, errStat, errMsg) + type(Dvr_Data), intent(inout) :: dvr ! driver data + type(Dvr_Outputs), intent(inout) :: out ! driver output data + integer(IntKi) , intent( out) :: errStat ! Status of error message + character(*) , intent( out) :: errMsg ! Error message if errStat /= ErrID_None + integer(IntKi) :: errStat2 ! Status of error message + character(ErrMsgLen) :: errMsg2 ! Error message + integer :: j + errStat = ErrID_None + errMsg = '' + + out%ny_UA = size(dvr%UA_InitOutData%WriteOutputHdr) + if (dvr%p%SimMod==3) then + out%ny_dvr = 27 ! Driver only ! TODO + out%ny_LD = size(dvr%LD_InitOutData%WriteOutputHdr) + else + out%ny_dvr = 0 + out%ny_LD = 0 + endif + + + ! --- Allocate driver-level outputs + call AllocAry(out%WriteOutputHdr, 1+out%ny_dvr, 'WriteOutputHdr', errStat2, errMsg2); if(Failed()) return + call AllocAry(out%WriteOutputUnt, 1+out%ny_dvr, 'WriteOutputUnt', errStat2, errMsg2); if(Failed()) return + + j=1 + out%WriteOutputHdr(j) = 'Time' ; out%WriteOutputUnt(j) = '(s)' ; j=j+1 + if (dvr%p%SimMod==3) then + ! TODO SIMMOD HARMONIZATION + ! Driver Variables + out%WriteOutputHdr(j) = 'VUndx' ; out%WriteOutputUnt(j) = '(m/s)' ; j=j+1 + out%WriteOutputHdr(j) = 'VUndy' ; out%WriteOutputUnt(j) = '(m/s)' ; j=j+1 + out%WriteOutputHdr(j) = 'VSTx_Q' ; out%WriteOutputUnt(j) = '(m/s)' ; j=j+1 + out%WriteOutputHdr(j) = 'VSTy_Q' ; out%WriteOutputUnt(j) = '(m/s)' ; j=j+1 + out%WriteOutputHdr(j) = 'VSTx_T' ; out%WriteOutputUnt(j) = '(m/s)' ; j=j+1 + out%WriteOutputHdr(j) = 'VSTy_T' ; out%WriteOutputUnt(j) = '(m/s)' ; j=j+1 + out%WriteOutputHdr(j) = 'Vrelx_Q' ; out%WriteOutputUnt(j) = '(m/s)' ; j=j+1 + out%WriteOutputHdr(j) = 'Vrely_Q' ; out%WriteOutputUnt(j) = '(m/s)' ; j=j+1 + out%WriteOutputHdr(j) = 'Vrelx_T' ; out%WriteOutputUnt(j) = '(m/s)' ; j=j+1 + out%WriteOutputHdr(j) = 'Vrely_T' ; out%WriteOutputUnt(j) = '(m/s)' ; j=j+1 + out%WriteOutputHdr(j) = 'Vrel_Q' ; out%WriteOutputUnt(j) = '(m/s)' ; j=j+1 + out%WriteOutputHdr(j) = 'Vrel_T' ; out%WriteOutputUnt(j) = '(m/s)' ; j=j+1 + out%WriteOutputHdr(j) = 'alpha_Q' ; out%WriteOutputUnt(j) = '(deg)' ; j=j+1 + out%WriteOutputHdr(j) = 'alpha_T' ; out%WriteOutputUnt(j) = '(deg)' ; j=j+1 + out%WriteOutputHdr(j) = 'phi_Q' ; out%WriteOutputUnt(j) = '(deg)' ; j=j+1 + out%WriteOutputHdr(j) = 'phi_T' ; out%WriteOutputUnt(j) = '(deg)' ; j=j+1 + out%WriteOutputHdr(j) = 'twist_full' ; out%WriteOutputUnt(j) = '(deg)' ; j=j+1 + out%WriteOutputHdr(j) = 'Re_T' ; out%WriteOutputUnt(j) = '(-)' ; j=j+1 + out%WriteOutputHdr(j) = 'L' ; out%WriteOutputUnt(j) = '(N/m)' ; j=j+1 + out%WriteOutputHdr(j) = 'D' ; out%WriteOutputUnt(j) = '(N/m)' ; j=j+1 + out%WriteOutputHdr(j) = 'M' ; out%WriteOutputUnt(j) = '(Nm/m)' ; j=j+1 + out%WriteOutputHdr(j) = 'Fx_A' ; out%WriteOutputUnt(j) = '(N/m)' ; j=j+1 + out%WriteOutputHdr(j) = 'Fy_A' ; out%WriteOutputUnt(j) = '(N/m)' ; j=j+1 + out%WriteOutputHdr(j) = 'M_A' ; out%WriteOutputUnt(j) = '(Nm/m)' ; j=j+1 + out%WriteOutputHdr(j) = 'GFx' ; out%WriteOutputUnt(j) = '(N/m)' ; j=j+1 + out%WriteOutputHdr(j) = 'GFy' ; out%WriteOutputUnt(j) = '(N/m)' ; j=j+1 + out%WriteOutputHdr(j) = 'GFM' ; out%WriteOutputUnt(j) = '(Nm/m)' ; j=j+1 + ! Dynamics + call concatOutputHeaders(out%WriteOutputHdr, out%WriteOutputUnt, dvr%LD_InitOutData%WriteOutputHdr, dvr%LD_InitOutData%WriteOutputUnt, errStat2, errMsg2) + endif + ! UA + call concatOutputHeaders(out%WriteOutputHdr, out%WriteOutputUnt, dvr%UA_InitOutData%WriteOutputHdr, dvr%UA_InitOutData%WriteOutputUnt, errStat2, errMsg2) + + out%ny = size(out%WriteOutputHdr) + ! Debug Write + !do j = 1, out%ny + ! print*,'Write Out: ',j, trim(out%WriteOutputHdr(j)), ' ', trim(out%WriteOutputUnt(j)) + !enddo +contains + logical function Failed() + CALL SetErrStat(errStat2, errMsg2, errStat, errMsg, 'Dvr_InitializeDriverOutputs' ) + Failed = errStat >= AbortErrLev + end function Failed +end subroutine Dvr_InitializeDriverOutputs +!---------------------------------------------------------------------------------------------------------------------------------- +subroutine Dvr_WriteOutputs(nt, t, dvr, out, errStat, errMsg) + integer(IntKi) , intent(in ) :: nt ! simulation time step + real(DbKi) , intent(in ) :: t ! simulation time (s) + type(Dvr_Data), intent(inout) :: dvr ! driver data + type(Dvr_Outputs) , intent(inout) :: out ! driver uotput options + integer(IntKi) , intent(inout) :: errStat ! Status of error message + character(*) , intent(inout) :: errMsg ! Error message if errStat /= ErrID_None +! ! Local variables. +! character(ChanLen) :: tmpStr ! temporary string to print the time output as text + integer :: nDV , nUA, nLD,j + errStat = ErrID_None + errMsg = '' + out%outLine = myNaN ! Safety +! + ! --- Packing all outputs except time into one array + nDV = out%ny_dvr + nLD = out%ny_LD + nUA = out%ny_UA + ! Driver outputs + j = 1 + if (dvr%p%SimMod==3) then + ! TODO harmonization + out%outLine(j) = dvr%U0(1, 1) ; j=j+1 ! Ux + out%outLine(j) = dvr%U0(1, 2) ; j=j+1 ! Uy + out%outLine(j) = dvr%m%Vst_Q(1) ; j=j+1 ! VSTx_Q + out%outLine(j) = dvr%m%Vst_Q(2) ; j=j+1 ! VSTy_Q + out%outLine(j) = dvr%m%Vst_T(1) ; j=j+1 ! VSTx_T + out%outLine(j) = dvr%m%Vst_T(2) ; j=j+1 ! VSTy_T + out%outLine(j) = dvr%m%Vrel_Q(1) ; j=j+1 ! Vrelx_Q + out%outLine(j) = dvr%m%Vrel_Q(2) ; j=j+1 ! Vrely_Q + out%outLine(j) = dvr%m%Vrel_T(1) ; j=j+1 ! Vrelx_T + out%outLine(j) = dvr%m%Vrel_T(2) ; j=j+1 ! Vrely_T + out%outLine(j) = sqrt(dvr%m%Vrel_norm2_Q) ; j=j+1 ! Vrel_Q + out%outLine(j) = sqrt(dvr%m%Vrel_norm2_T) ; j=j+1 ! Vrel_T + out%outLine(j) = dvr%m%alpha_Q*R2D ; j=j+1 ! alpha_Q + out%outLine(j) = dvr%m%alpha_T*R2D ; j=j+1 ! alpha_T + out%outLine(j) = dvr%m%phi_Q *R2D ; j=j+1 ! phi_Q + out%outLine(j) = dvr%m%phi_T *R2D ; j=j+1 ! phi_T + out%outLine(j) = dvr%m%twist_full*R2D ; j=j+1 ! twist_full + out%outLine(j) = dvr%m%Re ; j=j+1 ! Re_T + out%outLine(j) = dvr%m%L ; j=j+1 ! L + out%outLine(j) = dvr%m%D ; j=j+1 ! D + out%outLine(j) = dvr%m%tau_Q ; j=j+1 ! M + out%outLine(j) = dvr%m%FxA ; j=j+1 ! Fx_A + out%outLine(j) = dvr%m%FyA ; j=j+1 ! Fy_A + out%outLine(j) = dvr%m%tau_A ; j=j+1 ! M_A + out%outLine(j) = dvr%m%GF(1) ; j=j+1 ! GFx + out%outLine(j) = dvr%m%GF(2) ; j=j+1 ! GFy + out%outLine(j) = dvr%m%GF(3) ; j=j+1 ! GFM + ! LD Outputs + out%outLine(nDV+1:nDV+nLD) = dvr%LD_y%WriteOutput(1:nLD) + endif + ! UA Outputs + out%outLine(nDV+nLD+1:nDV+nLD+nUA) = dvr%UA_y%WriteOutput(1:nUA) + + !if (out%fileFmt==idFmt_Both .or. out%fileFmt == idFmt_Ascii) then + ! ! ASCII + ! ! time + ! write( tmpStr, out%Fmt_t ) t ! '(F15.4)' + ! call WrFileNR( out%unOutFile, tmpStr(1:out%ActualChanLen) ) + ! call WrNumAryFileNR(out%unOutFile, out%outLine, out%Fmt_a, errStat, errMsg) + ! ! write a new line (advance to the next line) + ! write(out%unOutFile,'()') + !endif + if (out%fileFmt==idFmt_Both .or. out%fileFmt == idFmt_Binary) then + ! Store for binary + out%storage(:, nt) = out%outLine(:) + !out%storage(1:nDV+nAD+nIW, nt) = out%outLine(1:nDV+nAD+nIW) + endif +end subroutine Dvr_WriteOutputs - - cn = tab%Coefs(:,AFI_Params%ColCl) * cos(tab%alpha) + (tab%Coefs(:,AFI_Params%ColCd) - tab%UA_BL%Cd0) * sin(tab%alpha); - cn_lin = tab%UA_BL%C_nalpha * (tab%alpha - tab%UA_BL%alpha0) - cl_lin = tab%UA_BL%C_lalpha * (tab%alpha - tab%UA_BL%alpha0) - - do iRow = 1, tab%NumAlf - if ((tab%alpha(iRow)tab%UA_BL%alphaUpperWrap) then - cl_lin(iRow) =0.0_ReKi - cn_lin(iRow) =0.0_ReKi - endif - enddo - - ! Smoothing (used priot to compute slope in CalculateUACoeffs) - call kernelSmoothing(tab%alpha, cn , kernelType_TRIWEIGHT, 2.0_ReKi*D2R, cn_smooth) - call kernelSmoothing(tab%alpha, tab%Coefs(:,AFI_Params%ColCl), kernelType_TRIWEIGHT, 2.0_ReKi*D2R, cl_smooth) - - ! Write to file - - CALL GetNewUnit( unOutFile, ErrStat, ErrMsg ) - IF ( ErrStat /= ErrID_None ) RETURN - - CALL OpenFOutFile ( unOutFile, trim(OutRootName)//'.UA.Coefs.'//trim(num2lstr(iTab))//'.out', ErrStat, ErrMsg ) - if (ErrStat >= AbortErrLev) then - call WrScr(Trim(ErrMsg)) - return - end if - - WRITE (unOutFile,'(/,A/)') 'These predictions were generated by UnsteadyAero Driver on '//CurDate()//' at '//CurTime()//'.' - WRITE (unOutFile,'(/,A/)') ' ' - - WRITE(unOutFile, '(20(A20,1x))') 'Alpha', 'Cl', 'Cd', sCm, 'Cn', 'f_st', Prefix//'FullySep', sFullyAtt , 'Cl_lin','Cn_lin','Cl_smooth', 'Cn_smooth' - WRITE(unOutFile, '(20(A20,1x))') '(deg)', '(-)', '(-)', '(-)', '(-)', '(-)', '(-)' , '(-)' , '(-)' , '(-)' , '(-)' ,'(-)' - - ! TODO, we could do something with ColCpmim and ColUAf - if (UseCm) then - iStartUA = 4 - do iRow=1,size(tab%Alpha) - WRITE(unOutFile, '(20(F20.6,1x))') tab%Alpha(iRow)*R2D, tab%Coefs(iRow,AFI_Params%ColCl), tab%Coefs(iRow,AFI_Params%ColCd), tab%Coefs(iRow,AFI_Params%ColCm), & - cn(iRow), tab%Coefs(iRow,iStartUA:), cl_lin(iRow), cn_lin(iRow), cl_smooth(iRow), cn_smooth(iRow) - end do - else - iStartUA = 3 - do iRow=1,size(tab%Alpha) - WRITE(unOutFile, '(20(F20.6,1x))') tab%Alpha(iRow)*R2D, tab%Coefs(iRow,AFI_Params%ColCl), tab%Coefs(iRow,AFI_Params%ColCd), 0.0_ReKi, & - cn(iRow), tab%Coefs(iRow,iStartUA:), cl_lin(iRow), cn_lin(iRow), cl_smooth(iRow), cn_smooth(iRow) - end do - endif - - CLOSE(unOutFile) - enddo - - end subroutine WriteAFITables - end module UA_Dvr_Subs diff --git a/modules/aerodyn/src/UnsteadyAero.f90 b/modules/aerodyn/src/UnsteadyAero.f90 index a6686580f4..673ba0eddf 100644 --- a/modules/aerodyn/src/UnsteadyAero.f90 +++ b/modules/aerodyn/src/UnsteadyAero.f90 @@ -28,7 +28,7 @@ ! Development plan for the aerodynamic linearization in OpenFAST ! Unpublished ! -! [70] User Documentation / AeroDyn / Unsteady Aerodynamics / Boing-Vertol model +! [70] User Documentation / AeroDyn / Unsteady Aerodynamics / Boeing-Vertol model ! https://openfast.readthedocs.io/ ! ! [other] R. Damiani and G. Hayman (2017) @@ -42,6 +42,7 @@ module UnsteadyAero use NWTC_Library use UnsteadyAero_Types use AirfoilInfo + use NWTC_LAPACK implicit none @@ -61,6 +62,7 @@ module UnsteadyAero real(ReKi), parameter :: Gonzalez_factor = 0.2_ReKi ! this factor, proposed by Gonzalez (for "all" models) is used to modify Cc to account for negative values seen at f=0 (see Eqn 1.40) real(ReKi), parameter, public :: UA_u_min = 0.01_ReKi ! m/s; used to provide a minimum value so UA equations don't blow up (this should be much lower than range where UA is turned off) real(ReKi), parameter :: K1pos=1.0_ReKi, K1neg=0.5_ReKi ! K1 coefficients for BV model + real(ReKi), parameter :: MaxTuOmega = 1.5_ReKi ! adding a little safety factor for UA models contains @@ -521,7 +523,7 @@ subroutine ComputeKelvinChain( i, j, u, p, xd, OtherState, misc, AFInfo, KC, BL_ KC%Cn_q_circ = KC%C_nalpha_circ*KC%q_f_cur/2.0 - KC%X3 - KC%X4 ! Eqn 1.16 - else ! these aren't used (they are possibly output to UA output file (when UA_OUTS defined) file, though) + else ! these aren't used (they are possibly output to UA output file when UA_OUTS is > 0 file, though) KC%X3 = 0.0_ReKi KC%X4 = 0.0_ReKi KC%Cn_q_circ = 0.0_ReKi @@ -723,8 +725,9 @@ subroutine UA_SetParameters( dt, InitInp, p, AFInfo, AFIndx, ErrStat, ErrMsg ) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'UA_SetParameters' logical :: IsUsed(size(AFInfo)) + INTEGER :: UA_NumLinStates ! potentially put in p, number of states per blade node that are linearized - INTEGER(IntKi) :: i, j + INTEGER(IntKi) :: i, j, k, n @@ -738,27 +741,42 @@ subroutine UA_SetParameters( dt, InitInp, p, AFInfo, AFIndx, ErrStat, ErrMsg ) if (ErrStat >= AbortErrLev) return p%c = InitInp%c ! this can't be 0 + p%d_34_to_ac = InitInp%d_34_to_ac ! In the future, set this for all nodes! p%numBlades = InitInp%numBlades p%nNodesPerBlade = InitInp%nNodesPerBlade p%UAMod = InitInp%UAMod p%a_s = InitInp%a_s ! this can't be 0 p%Flookup = InitInp%Flookup p%ShedEffect = InitInp%ShedEffect + p%UA_OUTS = InitInp%UA_OUTS - if (p%UAMod==UA_HGM .or. p%UAMod==UA_HGMV) then - p%lin_nx = p%numBlades*p%nNodesPerBlade*4 ! 4 continuous states per node per blade (5th state isn't currently linearizable) + if (p%UAMod==UA_HGM .or. p%UAMod==UA_HGMV .or. p%UAMod==UA_HGMV360) then + UA_NumLinStates = 4 + ! set the maximum number of states + ! note: we will subtract states for nodes where UA is off for good, below + p%lin_nx = p%numBlades*p%nNodesPerBlade*UA_NumLinStates ! 4 continuous states per node per blade (5th state isn't currently linearizable) else if (p%UAMod==UA_OYE) then - p%lin_nx = p%numBlades*p%nNodesPerBlade*1 ! continuous state per node per blade, but stored at position 4 + UA_NumLinStates = 1 + p%lin_nx = p%numBlades*p%nNodesPerBlade*UA_NumLinStates ! continuous state per node per blade, but stored at position 4 + else if (p%UAMod==UA_None) then + p%lin_nx = 0 + UA_NumLinStates = 0 else p%lin_nx = 0 + UA_NumLinStates = 0 end if + ! Compute derivative step size + p%dx = 0.5_R8Ki * D2R_D + p%dx(4) = 0.0001_R8Ki + p%UA_off_forGood = .false. ! flag that determines if UA should be turned off for the whole simulation if (allocated(InitInp%UAOff_innerNode)) then do j=1,min(size(p%UA_off_forGood,2), size(InitInp%UAOff_innerNode)) !blade do i=1,min(InitInp%UAOff_innerNode(j),size(p%UA_off_forGood,1)) !node ! call WrScr( 'Warning: Turning off Unsteady Aerodynamics on inner node (node '//trim(num2lstr(i))//', blade '//trim(num2lstr(j))//')' ) p%UA_off_forGood(i,j) = .true. + p%lin_nx = p%lin_nx - UA_NumLinStates end do end do end if @@ -767,7 +785,10 @@ subroutine UA_SetParameters( dt, InitInp, p, AFInfo, AFIndx, ErrStat, ErrMsg ) do j=1,min(size(p%UA_off_forGood,2), size(InitInp%UAOff_outerNode)) !blade do i=InitInp%UAOff_outerNode(j), size(p%UA_off_forGood,1) !node ! call WrScr( 'Warning: Turning off Unsteady Aerodynamics on outer node (node '//trim(num2lstr(i))//', blade '//trim(num2lstr(j))//')' ) - p%UA_off_forGood(i,j) = .true. + if (.not. p%UA_off_forGood(i,j)) then + p%UA_off_forGood(i,j) = .true. + p%lin_nx = p%lin_nx - UA_NumLinStates + end if end do end do end if @@ -780,12 +801,40 @@ subroutine UA_SetParameters( dt, InitInp, p, AFInfo, AFIndx, ErrStat, ErrMsg ) if (ErrStat2 > ErrID_None) then call WrScr( 'Warning: Turning off Unsteady Aerodynamics because '//trim(ErrMsg2)//' (node '//trim(num2lstr(i))//', blade '//trim(num2lstr(j))//')' ) p%UA_off_forGood(i,j) = .true. + p%lin_nx = p%lin_nx - UA_NumLinStates end if end if end do end do + + ! set up index array for linearization + p%lin_nx = max(0, p%lin_nx) + call AllocAry(p%lin_xIndx,p%lin_nx,3,'p%lin_xIndx',ErrStat2,ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (ErrStat >= AbortErrLev) return + + if (p%lin_nx > 0) then + n = 1 + do j=1,size(p%UA_off_forGood,2) !blade + do i=1,size(p%UA_off_forGood,1) !node + if (.not. p%UA_off_forGood(i,j)) then + do k=1,UA_NumLinStates + p%lin_xIndx(n,1) = i ! node + p%lin_xIndx(n,2) = j ! blade + + if (p%UAMod==UA_OYE) then + p%lin_xIndx(n,3) = 4 ! Hack for UA_Oye, state is 4 instead of 1 for now + else + p%lin_xIndx(n,3) = k ! state + endif + n = n + 1 + end do + end if + end do + end do + end if + ! check that the airfoils have appropriate data for UA IsUsed = .false. do j=1,size(p%UA_off_forGood,2) !blade @@ -798,10 +847,21 @@ subroutine UA_SetParameters( dt, InitInp, p, AFInfo, AFIndx, ErrStat, ErrMsg ) do i=1,size(AFInfo,1) if (IsUsed(i)) then - call UA_ValidateAFI(InitInp%UAMod, AFInfo(i), ErrStat2, ErrMsg2) + call UA_ValidateAFI(p%UAMod, p%Flookup, AFInfo(i), ErrStat2, ErrMsg2) + if (LEN_TRIM(ErrMsg2) + LEN_TRIM(ErrMsg) > LEN(ErrMsg) ) then + if (LEN_TRIM(ErrMsg) > LEN_TRIM(ErrMsg2)) then + call WrScr(TRIM(ErrMsg)) + ErrMsg = "" + else + call WrScr(TRIM(RoutineName)//TRIM(ErrMsg2)) + ErrMsg2 = "" + end if + end if call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end if end do + + p%integrationMethod = InitInp%integrationMethod end subroutine UA_SetParameters !============================================================================== @@ -829,7 +889,7 @@ subroutine UA_InitStates_Misc( p, x, xd, OtherState, m, ErrStat, ErrMsg ) ! allocate all the state arrays - if (p%UAMod == UA_HGM .or. p%UAMod == UA_HGMV .or. p%UAMod == UA_OYE) then + if (p%UAMod == UA_HGM .or. p%UAMod == UA_HGMV .or. p%UAMod == UA_OYE .or. p%UAMod==UA_HGMV360) then allocate( x%element( p%nNodesPerBlade, p%numBlades ), stat=ErrStat2 ) if (ErrStat2 /= 0) call SetErrStat(ErrID_Fatal,"Cannot allocate x%x.",ErrStat,ErrMsg,RoutineName) @@ -901,13 +961,12 @@ subroutine UA_InitStates_Misc( p, x, xd, OtherState, m, ErrStat, ErrMsg ) call AllocAry(OtherState%sigma1m ,p%nNodesPerBlade,p%numBlades,'OtherState%sigma1m',ErrStat2,ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) call AllocAry(OtherState%sigma3 ,p%nNodesPerBlade,p%numBlades,'OtherState%sigma3',ErrStat2,ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - -# ifdef UA_OUTS + if(p%UA_OUTS>0) then call AllocAry(m%TESF ,p%nNodesPerBlade,p%numBlades,'m%TESF',ErrStat2,ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) call AllocAry(m%LESF ,p%nNodesPerBlade,p%numBlades,'m%LESF',ErrStat2,ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) call AllocAry(m%VRTX ,p%nNodesPerBlade,p%numBlades,'m%VRTX',ErrStat2,ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) call AllocAry(m%T_Sh ,p%nNodesPerBlade,p%numBlades,'m%T_Sh',ErrStat2,ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) -# endif + endif end if call AllocAry(m%weight ,p%nNodesPerBlade,p%numBlades,'m%weight',ErrStat2,ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) @@ -958,7 +1017,7 @@ subroutine UA_ReInit( p, x, xd, OtherState, m, ErrStat, ErrMsg ) end do end do - if ( p%UAMod == UA_HGM .or. p%UAMod == UA_HGMV .or. p%UAMod == UA_OYE) then + if ( p%UAMod == UA_HGM .or. p%UAMod == UA_HGMV .or. p%UAMod == UA_OYE .or. p%UAMod==UA_HGMV360) then OtherState%n = -1 ! we haven't updated OtherState%xdot, yet @@ -971,6 +1030,8 @@ subroutine UA_ReInit( p, x, xd, OtherState, m, ErrStat, ErrMsg ) do i = 1, size(OtherState%xdot) call UA_CopyContState( x, OtherState%xdot(i), MESH_UPDATECOPY, ErrStat2, ErrMsg2) ! there are no meshes, so the control code is irrelevant call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + call UA_CopyContState( x, OtherState%xHistory(i), MESH_UPDATECOPY, ErrStat2, ErrMsg2) ! there are no meshes, so the control code is irrelevant + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) end do if (p%UAMod == UA_HGMV) then @@ -996,12 +1057,12 @@ subroutine UA_ReInit( p, x, xd, OtherState, m, ErrStat, ErrMsg ) OtherState%sigma1m = 1.0_ReKi OtherState%sigma3 = 1.0_ReKi -# ifdef UA_OUTS + if (p%UA_OUTS>0) then m%TESF = .FALSE. m%LESF = .FALSE. m%VRTX = .FALSE. m%T_sh = 0.0_ReKi -# endif + endif xd%Cn_prime_minus1 = 0.0_ReKi xd%alpha_minus1 = 0.0_ReKi @@ -1075,12 +1136,6 @@ subroutine UA_Init( InitInp, u, p, x, xd, OtherState, y, m, Interval, & integer(IntKi) :: errStat2 ! temporary Error status of the operation character(*), parameter :: RoutineName = 'UA_Init' -#ifdef UA_OUTS - CHARACTER(6) :: TmpChar ! Temporary char array to hold the node digits (3 places only!!!!) - integer(IntKi) :: i,j, iNode, iOffset - character(64) :: chanPrefix -#endif - ! Initialize variables for this routine ErrStat = ErrID_None ErrMsg = "" @@ -1090,33 +1145,61 @@ subroutine UA_Init( InitInp, u, p, x, xd, OtherState, y, m, Interval, & call NWTC_Init( EchoLibVer=.FALSE. ) if (InitInp%WrSum) then - call UA_WriteAFIParamsToFile(InitInp, AFInfo, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return + call UA_WriteAFIParamsToFile(InitInp, AFInfo, ErrStat2, ErrMsg2); if(Failed()) return end if - call UA_ValidateInput(InitInp, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return + call UA_ValidateInput(InitInp, ErrStat2, ErrMsg2); if(Failed()) return ! Allocate and set parameter data structure using initialization data - call UA_SetParameters( interval, InitInp, p, AFInfo, AFIndx, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return + call UA_SetParameters( interval, InitInp, p, AFInfo, AFIndx, ErrStat2, ErrMsg2 ); if(Failed()) return - ! initialize the discrete states, other states, and misc variables - call UA_InitStates_Misc( p, x, xd, OtherState, m, ErrStat2, ErrMsg2 ) ! initialize the continuous states - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return + ! initialize the states and misc variables + call UA_InitStates_Misc( p, x, xd, OtherState, m, ErrStat2, ErrMsg2 ); if(Failed()) return + ! --- Write Outputs + call UA_Init_Outputs(InitInp, p, y, InitOut, errStat2, errMsg2); if(Failed()) return -#ifdef UA_OUTS +contains + logical function Failed() + call SetErrStat( errStat2, errMsg2, errStat, errMsg, 'UA_Init' ) + Failed = errStat >= AbortErrLev + end function Failed +end subroutine UA_Init + +!============================================================================== +subroutine UA_Init_Outputs(InitInp, p, y, InitOut, errStat, errMsg) + type(UA_InitInputType), intent(in ) :: InitInp ! input data for initialization routine ; we're moving allocated data from InitInp to p so must also be intent(out) + type(UA_ParameterType), intent(inout) :: p ! Parameters + type(UA_OutputType), intent(inout) :: y ! Initial system outputs (outputs are not calculated; + type(UA_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 + character(6) :: TmpChar ! Temporary char array to hold the node digits (3 places only!!!!) + integer(IntKi) :: i,j, iNode, iOffset + character(64) :: chanPrefix + character(ErrMsgLen) :: errMsg2 ! temporary Error message if ErrStat /= ErrID_None + integer(IntKi) :: errStat2 ! temporary Error status of the operation + character(*), parameter :: RoutineName = 'UA_Init' + + errStat = errID_None + errMsg = "" + InitOut%Version = ProgDesc( 'UnsteadyAero', '', '' ) ! used only to avoid warnings about InitOut not getting set + + if (p%UA_OUTS==0) then + p%NumOuts = 0 + p%unOutFile = -1 + return + endif ! Allocate and set the InitOut data - if (p%UAMod == UA_HGM .or. p%UAMod == UA_OYE) then + if (p%UAMod == UA_None) then + p%NumOuts = 11 + elseif (p%UAMod == UA_HGM .or. p%UAMod == UA_OYE) then p%NumOuts = 20 elseif(p%UAMod == UA_HGMV) then p%NumOuts = 21 + elseif(p%UAMod == UA_HGMV360) then + p%NumOuts = 22 elseif(p%UAMod == UA_BV) then p%NumOuts = 26 else @@ -1139,8 +1222,13 @@ subroutine UA_Init( InitInp, u, p, x, xd, OtherState, y, m, Interval, & iOffset = (i-1)*p%NumOuts + (j-1)*p%nNodesPerBlade*p%NumOuts !chanPrefix = "B"//trim(num2lstr(j))//"N"//trim(num2lstr(i)) - write (TmpChar,'(I3.3)') i ! 3 digit number - chanPrefix = 'AB' // TRIM(Num2LStr(j)) // 'N' // TRIM(TmpChar) + if ((p%numBlades==1) .and. (p%nNodesPerBlade==1) .and. p%UA_OUTS==1) then + chanPrefix='' ! UA_Driver with one node and one blade only + else + !chanPrefix = "B"//trim(num2lstr(j))//"N"//trim(num2lstr(i))//'_' + write (TmpChar,'(I3.3)') i ! 3 digit number + chanPrefix = 'AB' // TRIM(Num2LStr(j)) // 'N' // TRIM(TmpChar) + endif InitOut%WriteOutputHdr(iOffset+ 1) = trim(chanPrefix)//'Alpha' InitOut%WriteOutputHdr(iOffset+ 2) = trim(chanPrefix)//'Vrel' @@ -1158,7 +1246,20 @@ subroutine UA_Init( InitInp, u, p, x, xd, OtherState, y, m, Interval, & InitOut%WriteOutputUnt(iOffset+ 6) ='(-)' InitOut%WriteOutputUnt(iOffset+ 7) ='(-)' - if (p%UAmod == UA_HGM .or. p%UAMod == UA_HGMV .or. p%UAMod == UA_OYE) then + if (p%UAmod == UA_None) then + + InitOut%WriteOutputHdr(iOffset+ 8) = trim(chanPrefix)//'omega' + InitOut%WriteOutputHdr(iOffset+ 9) = trim(chanPrefix)//'alphaE' + InitOut%WriteOutputHdr(iOffset+10) = trim(chanPrefix)//'Tu' + InitOut%WriteOutputHdr(iOffset+11) = trim(chanPrefix)//'alpha_34' + + InitOut%WriteOutputUnt(iOffset+ 8) = '(deg/sec)' + InitOut%WriteOutputUnt(iOffset+ 9) = '(deg)' + InitOut%WriteOutputUnt(iOffset+10) = '(s)' + InitOut%WriteOutputUnt(iOffset+11) = '(deg)' + + + elseif (p%UAmod == UA_HGM .or. p%UAMod == UA_HGMV .or. p%UAMod == UA_OYE .or. p%UAMod == UA_HGMV360) then InitOut%WriteOutputHdr(iOffset+ 8) = trim(chanPrefix)//'omega' InitOut%WriteOutputHdr(iOffset+ 9) = trim(chanPrefix)//'alphaE' @@ -1194,6 +1295,11 @@ subroutine UA_Init( InitInp, u, p, x, xd, OtherState, y, m, Interval, & if (p%UAmod == UA_HGMV) then InitOut%WriteOutputHdr(iOffset+21) = trim(chanPrefix)//'x5' InitOut%WriteOutputUnt(iOffset+21) = '(-)' + else if (p%UAmod == UA_HGMV360) then + InitOut%WriteOutputHdr(iOffset+21) = trim(chanPrefix)//'Q' + InitOut%WriteOutputHdr(iOffset+22) = trim(chanPrefix)//'Qdot' + InitOut%WriteOutputUnt(iOffset+21) = '(-)' + InitOut%WriteOutputUnt(iOffset+22) = '(-)' end if elseif(p%UAMod == UA_BV) then @@ -1237,7 +1343,7 @@ subroutine UA_Init( InitInp, u, p, x, xd, OtherState, y, m, Interval, & InitOut%WriteOutputUnt(iOffset+25) = '(m/s)' InitOut%WriteOutputUnt(iOffset+26) = '(m/s)' - else + else if (p%UAmod == UA_Baseline .or. p%UAMod == UA_Gonzalez .or. p%UAMod == UA_MinnemaPierce) then InitOut%WriteOutputHdr(iOffset+ 8) = trim(chanPrefix)//'Cn_aq_circ' InitOut%WriteOutputHdr(iOffset+ 9) = trim(chanPrefix)//'Cn_aq_nc' @@ -1315,9 +1421,11 @@ subroutine UA_Init( InitInp, u, p, x, xd, OtherState, y, m, Interval, & InitOut%WriteOutputUnt(iOffset+41) ='(-)' InitOut%WriteOutputUnt(iOffset+42) ='(-)' InitOut%WriteOutputUnt(iOffset+43) ='(-)' - InitOut%WriteOutputUnt(iOffset+44) ='(deg)' - InitOut%WriteOutputUnt(iOffset+45) ='(-)' + InitOut%WriteOutputUnt(iOffset+44) ='(-)' + InitOut%WriteOutputUnt(iOffset+45) ='(deg)' + else + call SetErrStat( ErrID_Fatal, 'Programming error UAmod case not accounted for.', ErrStat, ErrMsg, RoutineName ); return end if end do @@ -1327,7 +1435,9 @@ subroutine UA_Init( InitInp, u, p, x, xd, OtherState, y, m, Interval, & p%OutFmt = 'ES19.5e3' p%Delim ='' - if (p%NumOuts > 0) then + ! --- Write to File + if ((p%NumOuts > 0) .and. p%UA_OUTS==2) then + call WrScr(' UA: Writing separate output file: '//trim(InitInp%OutRootName)//'.out') !$OMP critical(filename) CALL GetNewUnit( p%unOutFile, ErrStat2, ErrMsg2 ) if (ErrStat2 < AbortErrLev) then @@ -1353,54 +1463,57 @@ subroutine UA_Init( InitInp, u, p, x, xd, OtherState, y, m, Interval, & WRITE (p%unOutFile,'(:,A,'//trim( p%OutSFmt )//')', ADVANCE='no' ) p%Delim, trim(InitOut%WriteOutputUnt(i)) end do WRITE (p%unOutFile,'()', IOSTAT=ErrStat2) ! write the line return - end if - + else -#else - p%NumOuts = 0 - p%unOutFile = -1 - !..................................... - ! add the following two lines only to avoid compiler warnings about uninitialized variables when not building the UA driver: - y%cm = 0.0_ReKi - InitOut%Version = ProgDesc( 'Unsteady Aero', '', '' ) - !..................................... - -#endif - -end subroutine UA_Init + call WrScr(' UA: saving write outputs') + + end if +end subroutine UA_Init_Outputs !============================================================================== subroutine UA_ValidateInput(InitInp, ErrStat, ErrMsg) type(UA_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 + integer, parameter :: UA_VALID(8) = (/UA_None, UA_Gonzalez, UA_MinnemaPierce, UA_HGM, UA_HGMV, UA_Oye, UA_BV, UA_HGMV360/) character(*), parameter :: RoutineName = 'UA_ValidateInput' ErrStat = ErrID_None ErrMsg = "" - if (InitInp%UAMod < UA_Gonzalez .or. InitInp%UAMod > UA_BV ) call SetErrStat( ErrID_Fatal, & - "In this version, UAMod must be 2 (Gonzalez's variant), 3 (Minnema/Pierce variant), 4 (continuous HGM model), 5 (HGM with vortex), & - &6 (Oye), 7 (Boing-Vertol)", ErrStat, ErrMsg, RoutineName ) ! NOTE: for later- 1 (baseline/original) + if (.not.(any(InitInp%UAMod==UA_VALID))) call SetErrStat( ErrID_Fatal, & + "In this version, UAMod must be 0 (None), 2 (Gonzalez's variant), 3 (Minnema/Pierce variant), 4 (continuous HGM model), 5 (HGM with vortex), & + &6 (Oye), 7 (Boeing-Vertol), or 8 (HGM-360)", ErrStat, ErrMsg, RoutineName ) ! NOTE: for later- 1 (baseline/original) if (.not. InitInp%FLookUp ) call SetErrStat( ErrID_Fatal, 'FLookUp must be TRUE for this version.', ErrStat, ErrMsg, RoutineName ) if (InitInp%a_s <= 0.0) call SetErrStat ( ErrID_Fatal, 'The speed of sound (SpdSound) must be greater than zero.', ErrStat, ErrMsg, RoutineName ) + if (InitInp%UAMod == UA_HGM .or. InitInp%UAMod == UA_HGMV .or. InitInp%UAMod == UA_OYE .or. InitInp%UAMod == UA_HGMV360) then ! these are the continuous methods that integrate states + if ( InitInp%IntegrationMethod /= UA_Method_RK4 & + .and. InitInp%IntegrationMethod /= UA_Method_AB4 & + .and. InitInp%IntegrationMethod /= UA_Method_ABM4 & + .and. InitInp%IntegrationMethod /= UA_Method_BDF2 ) call SetErrStat ( ErrID_Fatal, 'Invalid integration method in UA. Integration method must be 1, 2, 3, or 4.', ErrStat, ErrMsg, RoutineName ) + end if + + if (InitInp%UAMod == UA_HGMV360) call SetErrStat( ErrID_Fatal, 'HGMV360 model not implemented for this version. Choose another model for UA_Mod.', ErrStat, ErrMsg, RoutineName ) end subroutine UA_ValidateInput !============================================================================== -subroutine UA_ValidateAFI(UAMod, AFInfo, ErrStat, ErrMsg) +subroutine UA_ValidateAFI(UAMod, FLookup, AFInfo, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: UAMod ! which UA model we are using + logical, intent(in ) :: FLookup ! lookup table type(AFI_ParameterType), target, intent(in ) :: AFInfo ! The airfoil parameter data integer(IntKi), intent( out) :: ErrStat ! Error status of the operation character(*), intent( out) :: ErrMsg ! Error message if ErrStat /= ErrID_None - integer(IntKi) :: j - integer(IntKi) :: indx - real(ReKi) :: cl_fs, vmax - character(*), parameter :: RoutineName = 'UA_ValidateAFI' - type(AFI_Table_Type), pointer :: tab !< Alias + integer(IntKi) :: j + integer(IntKi) :: indx + real(ReKi) :: cl_fs, vmax + character(*), parameter :: RoutineName = 'UA_ValidateAFI' + + integer(IntKi) :: ErrStat_tab ! Error status of the operation + character(ErrMsgLen) :: ErrMsg_tab ! Error message if ErrStat_tab /= ErrID_None ErrStat = ErrID_None ErrMsg = "" @@ -1410,90 +1523,94 @@ subroutine UA_ValidateAFI(UAMod, AFInfo, ErrStat, ErrMsg) else do j=1, AFInfo%NumTabs - tab => AFInfo%Table(j) + associate( tab => AFInfo%Table(j) ) + ErrStat_tab = ErrID_None + ErrMsg_tab = " " - if ( AFInfo%Table(j)%InclUAdata ) then + if ( tab%InclUAdata ) then ! parameters used only for UAMod/=UA_HGM) if (UAMod == UA_Baseline .or. UAMod == UA_Gonzalez .or. UAMod == UA_MinnemaPierce .or. UAMod == UA_HGMV) then if (UAMod /= UA_HGMV) then - if ( EqualRealNos(AFInfo%Table(j)%UA_BL%St_sh, 0.0_ReKi) ) then - call SetErrStat(ErrID_Fatal, 'UA St_sh parameter must not be 0 in "'//trim(AFInfo%FileName)//'".', ErrStat, ErrMsg, RoutineName ) + if ( EqualRealNos(tab%UA_BL%St_sh, 0.0_ReKi) ) then + call SetErrStat(ErrID_Fatal, 'UA St_sh parameter must not be 0.', ErrStat_tab, ErrMsg_tab, "" ) end if - if ( AFInfo%Table(j)%UA_BL%alpha1 > pi .or. AFInfo%Table(j)%UA_BL%alpha1 < -pi ) then - call SetErrStat(ErrID_Fatal, 'UA alpha1 parameter must be between -180 and 180 degrees in "'//trim(AFInfo%FileName)//'".', ErrStat, ErrMsg, RoutineName ) - end if + ! we won't check alpha1 or alph2 validity if we aren't using them for the lookup (curve fit) + if (.not. Flookup) then + if ( tab%UA_BL%alpha1 > pi .or. tab%UA_BL%alpha1 < -pi ) then + call SetErrStat(ErrID_Fatal, 'UA alpha1 parameter must be between -180 and 180 degrees.', ErrStat_tab, ErrMsg_tab, "" ) + end if - if ( AFInfo%Table(j)%UA_BL%alpha2 > pi .or. AFInfo%Table(j)%UA_BL%alpha2 < -pi ) then - call SetErrStat(ErrID_Fatal, 'UA alpha2 parameter must be between -180 and 180 degrees in "'//trim(AFInfo%FileName)//'".', ErrStat, ErrMsg, RoutineName ) - end if + if ( tab%UA_BL%alpha2 > pi .or. tab%UA_BL%alpha2 < -pi ) then + call SetErrStat(ErrID_Fatal, 'UA alpha2 parameter must be between -180 and 180 degrees.', ErrStat_tab, ErrMsg_tab, "" ) + end if - if ( AFInfo%Table(j)%UA_BL%alpha1 < AFInfo%Table(j)%UA_BL%alpha2 ) then - call SetErrStat(ErrID_Fatal, 'UA alpha2 parameter must be less than alpha1 in "'//trim(AFInfo%FileName)//'".', ErrStat, ErrMsg, RoutineName ) - end if - - if ( AFInfo%Table(j)%UA_BL%alpha0 > AFInfo%Table(j)%UA_BL%alpha1 ) then - call SetErrStat(ErrID_Fatal, 'UA alpha0 parameter must be less than alpha1 in "'//trim(AFInfo%FileName)//'".', ErrStat, ErrMsg, RoutineName ) - end if + if ( tab%UA_BL%alpha1 < tab%UA_BL%alpha2 ) then + call SetErrStat(ErrID_Fatal, 'UA alpha2 parameter must be less than alpha1.', ErrStat_tab, ErrMsg_tab, "" ) + end if - if ( AFInfo%Table(j)%UA_BL%alpha2 > AFInfo%Table(j)%UA_BL%alpha0 ) then - call SetErrStat(ErrID_Fatal, 'UA alpha0 parameter must be greater than alpha2 in "'//trim(AFInfo%FileName)//'".', ErrStat, ErrMsg, RoutineName ) - end if + if ( tab%UA_BL%alpha0 > tab%UA_BL%alpha1 ) then + call SetErrStat(ErrID_Fatal, 'UA alpha0 parameter must be less than alpha1.', ErrStat_tab, ErrMsg_tab, "" ) + end if - if ( AFInfo%Table(j)%UA_BL%filtCutOff < 0.0_ReKi ) then - call SetErrStat(ErrID_Fatal, 'UA filtCutOff parameter must be greater than 0 in "'//trim(AFInfo%FileName)//'".', ErrStat, ErrMsg, RoutineName ) + if ( tab%UA_BL%alpha2 > tab%UA_BL%alpha0 ) then + call SetErrStat(ErrID_Fatal, 'UA alpha0 parameter must be greater than alpha2.', ErrStat_tab, ErrMsg_tab, "" ) + end if + end if ! don't check alpha1 and alpha2 unless they are going to be used + if ( tab%UA_BL%filtCutOff < 0.0_ReKi ) then + call SetErrStat(ErrID_Fatal, 'UA filtCutOff parameter must be greater than 0.', ErrStat_tab, ErrMsg_tab, "" ) end if end if ! not UA_HGMV - if ( AFInfo%Table(j)%UA_BL%T_VL <= 0.0_ReKi ) then - call SetErrStat(ErrID_Fatal, 'UA T_VL parameter must be greater than 0 in "'//trim(AFInfo%FileName)//'".', ErrStat, ErrMsg, RoutineName ) + if ( tab%UA_BL%T_VL <= 0.0_ReKi ) then + call SetErrStat(ErrID_Fatal, 'UA T_VL parameter must be greater than 0.', ErrStat_tab, ErrMsg_tab, "" ) end if - if ( AFInfo%Table(j)%UA_BL%T_V0 <= 0.0_ReKi ) then - call SetErrStat(ErrID_Fatal, 'UA T_V0 parameter must be greater than 0 in "'//trim(AFInfo%FileName)//'".', ErrStat, ErrMsg, RoutineName ) + if ( tab%UA_BL%T_V0 <= 0.0_ReKi ) then + call SetErrStat(ErrID_Fatal, 'UA T_V0 parameter must be greater than 0.', ErrStat_tab, ErrMsg_tab, "" ) end if - if (AFInfo%Table(j)%UA_BL%Cn2 >= AFInfo%Table(j)%UA_BL%Cn1) call SetErrStat(ErrID_Fatal, 'Cn2 must be less than Cn1 in "'//trim(AFInfo%FileName)//'".', ErrStat, ErrMsg, RoutineName ) + if (tab%UA_BL%Cn2 >= tab%UA_BL%Cn1) call SetErrStat(ErrID_Fatal, 'Cn2 must be less than Cn1.', ErrStat_tab, ErrMsg_tab, "" ) end if if (UAMod /= UA_HGMV) then - if ( AFInfo%Table(j)%UA_BL%alpha0 > pi .or. AFInfo%Table(j)%UA_BL%alpha0 < -pi ) then - call SetErrStat(ErrID_Fatal, 'UA alpha0 parameter must be between -180 and 180 degrees in "'//trim(AFInfo%FileName)//'".', ErrStat, ErrMsg, RoutineName ) + if ( tab%UA_BL%alpha0 > pi .or. tab%UA_BL%alpha0 < -pi ) then + call SetErrStat(ErrID_Fatal, 'UA alpha0 parameter must be between -180 and 180 degrees.', ErrStat_tab, ErrMsg_tab, "" ) end if end if ! Not UA_HGM - if (UAMod == UA_HGM .or. UAMod == UA_HGMV .or. UAMod == UA_OYE) then - cl_fs = InterpStp( AFInfo%Table(j)%UA_BL%UACutout, AFInfo%Table(j)%alpha, AFInfo%Table(j)%Coefs(:,AFInfo%ColUAf), indx, AFInfo%Table(j)%NumAlf ) + if ( tab%UA_BL%UACutout < Pi .and. (UAMod == UA_HGM .or. UAMod == UA_HGMV .or. UAMod == UA_OYE .or. UAMod == UA_HGMV360) ) then + cl_fs = InterpStp( tab%UA_BL%UACutout, tab%alpha, tab%Coefs(:,AFInfo%ColUAf), indx, tab%NumAlf ) if (.not. EqualRealNos( cl_fs, 0.0_ReKi ) ) then - call SetErrStat(ErrID_Severe, 'UA cutout parameter should be at a value where the separation function is 0 in "'//trim(AFInfo%FileName)//'".'// & - " Separation function is "//trim(num2lstr(cl_fs)), ErrStat, ErrMsg, RoutineName ) + call SetErrStat(ErrID_Severe, 'UA cutout parameter should be at a value where the separation function is 0;'// & + ' separation function is '//trim(num2lstr(cl_fs))//'.' , ErrStat_tab, ErrMsg_tab, "" ) end if ! C_alpha should have a reasonable value if (abs(tab%UA_BL%C_lalpha)>9.11_ReKi) then ! 45% above 2*pi, arbitrary.. - call SetErrStat(ErrID_Severe, 'Large value of C_lalpha in "'//trim(AFInfo%FileName)//'".'// & + call SetErrStat(ErrID_Severe, 'Large value of C_lalpha.'// & " C_lalpha="//trim(num2lstr(tab%UA_BL%C_lalpha))//& - ". We advise to check this value or provide it in the input file.", ErrStat, ErrMsg, RoutineName ) + ". We advise to check this value or provide it in the input file.", ErrStat_tab, ErrMsg_tab, "" ) endif ! NOTE: check if C_nalpha is alwasy defined ! C_lalpha and C_nalpha should be in the same ballpark if (abs(tab%UA_BL%C_nalpha-tab%UA_BL%C_lalpha)>3.0_ReKi) then ! arbitrary criteria.. - call SetErrStat(ErrID_Severe, 'Large difference between C_lalpha and C_nalpha in "'//trim(AFInfo%FileName)//'".'// & + call SetErrStat(ErrID_Severe, 'Large difference between C_lalpha and C_nalpha.'// & " C_lalpha="//trim(num2lstr(tab%UA_BL%C_lalpha))//& " C_nalpha="//trim(num2lstr(tab%UA_BL%C_nalpha))//& - ". We advise to check these value or provide them in the input file.", ErrStat, ErrMsg, RoutineName ) + ". We advise to check these values or provide them in the input file.", ErrStat_tab, ErrMsg_tab, "" ) endif vmax = maxval(tab%Coefs(:,AFInfo%ColUAf)) if (vmax>1.00_ReKi) then - call SetErrStat(ErrID_Severe, 'The separation function f_st exceed 1 in "'//trim(AFInfo%FileName)//'".'// & + call SetErrStat(ErrID_Severe, 'The separation function f_st exceeds 1;'// & " max(f_st)="//trim(num2lstr(vmax))//& - ". Check the calculation or provide f_st in the input file.", ErrStat, ErrMsg, RoutineName ) + ". Check the calculation or provide f_st in the input file.", ErrStat_tab, ErrMsg_tab, "" ) endif if (vmax<0.70_ReKi) then - call SetErrStat(ErrID_Severe, 'The separation function f_st does not reach 1 in "'//trim(AFInfo%FileName)//'".'// & + call SetErrStat(ErrID_Severe, 'The separation function f_st does not reach 1;'// & " max(f_st)="//trim(num2lstr(vmax))//& - ". Check the calculation or provide f_st in the input file.", ErrStat, ErrMsg, RoutineName ) + ". Check the calculation or provide f_st in the input file.", ErrStat_tab, ErrMsg_tab, "" ) endif end if @@ -1502,25 +1619,31 @@ subroutine UA_ValidateAFI(UAMod, AFInfo, ErrStat, ErrMsg) endif ! variables used in all UA models: - if ( AFInfo%Table(j)%UA_BL%T_f0 <= 0.0_ReKi ) then - call SetErrStat(ErrID_Fatal, 'UA T_f0 parameter must be greater than 0 in "'//trim(AFInfo%FileName)//'".', ErrStat, ErrMsg, RoutineName ) + if ( tab%UA_BL%T_f0 <= 0.0_ReKi ) then + call SetErrStat(ErrID_Fatal, 'UA T_f0 parameter must be greater than 0.', ErrStat_tab, ErrMsg_tab, "" ) end if - if ( AFInfo%Table(j)%UA_BL%T_p <= 0.0_ReKi ) then - call SetErrStat(ErrID_Fatal, 'UA T_p parameter must be greater than 0 in "'//trim(AFInfo%FileName)//'".', ErrStat, ErrMsg, RoutineName ) + if ( tab%UA_BL%T_p <= 0.0_ReKi ) then + call SetErrStat(ErrID_Fatal, 'UA T_p parameter must be greater than 0.', ErrStat_tab, ErrMsg_tab, "" ) end if end if ! UAtable included - if ( AFInfo%Table(j)%UA_BL%UACutout < 0.0_ReKi ) then - call SetErrStat(ErrID_Fatal, 'UA UACutout parameter must not be negative in "'//trim(AFInfo%FileName)//'".', ErrStat, ErrMsg, RoutineName ) + if ( tab%UA_BL%UACutout < 0.0_ReKi ) then + call SetErrStat(ErrID_Fatal, 'UA UACutout parameter must not be negative.', ErrStat_tab, ErrMsg_tab, "" ) end if ! this should never occur (if it does, check how it is set in AirfoilInfo) - if ( AFInfo%Table(j)%UA_BL%UACutout_blend > AFInfo%Table(j)%UA_BL%UACutout ) then - call SetErrStat(ErrID_Fatal, 'UA UACutout parameter must not be smaller than than UACutout_blend in "'//trim(AFInfo%FileName)//'".', ErrStat, ErrMsg, RoutineName ) + if ( tab%UA_BL%UACutout_blend > tab%UA_BL%UACutout ) then + call SetErrStat(ErrID_Fatal, 'UA UACutout parameter must not be smaller than than UACutout_blend.', ErrStat_tab, ErrMsg_tab, "" ) + end if + + if (ErrStat_tab /= ErrID_None) then + call SetErrStat(ErrStat_tab, 'File "'//trim(AFInfo%FileName)//'"'//trim(ErrMsg_tab)//NewLine, ErrStat, ErrMsg, RoutineName ) end if + end associate ! tab => AFInfo%Table(j) + end do if (ErrStat >= AbortErrLev) return @@ -1564,11 +1687,18 @@ subroutine UA_TurnOff_param(p, AFInfo, ErrStat, ErrMsg) ErrStat = ErrID_Fatal ErrMsg = 'UA parameters are not included in airfoil.' return + else if ( (p%UAMod == UA_HGM .or. p%UAMod == UA_OYE .or. p%UAMod == UA_HGMV .or. p%UAMod==UA_HGMV360) .and. & + (maxval( AFInfo%Table(j)%Coefs(:, AFInfo%ColUAf) ) == 0.0_ReKi ) ) then + ErrStat = ErrID_Fatal + ErrMsg = 'separation function is 0 at all values.' + return end if end do + if (p%UAMod == UA_None) then + ! pass - if (p%UAMod == UA_HGM .or. p%UAMod == UA_OYE) then + else if (p%UAMod == UA_HGM .or. p%UAMod == UA_OYE) then ! unsteady aerodynamics will be turned off if Cl,alpha = 0 do j=1, AFInfo%NumTabs if ( EqualRealNos(AFInfo%Table(j)%UA_BL%C_lalpha, 0.0_ReKi) ) then @@ -1588,7 +1718,7 @@ subroutine UA_TurnOff_param(p, AFInfo, ErrStat, ErrMsg) end if end do - elseif (p%UAMod == UA_HGMV) then + elseif (p%UAMod == UA_HGMV .or. p%UAMod==UA_HGMV360) then ! pass elseif (p%UAMod == UA_Baseline .or. p%UAMod == UA_Gonzalez .or. p%UAMod == UA_MinnemaPierce) then @@ -1618,7 +1748,7 @@ subroutine UA_TurnOff_param(p, AFInfo, ErrStat, ErrMsg) end subroutine UA_TurnOff_param !============================================================================== -!> Update discrete states for Boieng Vertol model +!> Update discrete states for Boeing Vertol model subroutine UA_UpdateDiscOtherState_BV( i, j, u, p, xd, OtherState, AFInfo, m, ErrStat, ErrMsg ) integer , intent(in ) :: i !< node index within a blade integer , intent(in ) :: j !< blade index @@ -1636,7 +1766,6 @@ subroutine UA_UpdateDiscOtherState_BV( i, j, u, p, xd, OtherState, AFInfo, m, Er real(ReKi) :: alpha_minus1 !< 3/4 chord angle of attack at real(ReKi) :: alpha_filt_cur !< real(ReKi) :: alpha_filt_minus1 !< - real(ReKi) :: Tu !< Time constant based on u=Vrel and chord real(ReKi) :: dynamicFilterCutoffHz !< find frequency based on reduced frequency of k = BL_p%filtCutOff real(ReKi) :: LowPassConst !< ! @@ -1653,7 +1782,7 @@ subroutine UA_UpdateDiscOtherState_BV( i, j, u, p, xd, OtherState, AFInfo, m, Er ! --- Filter angle of attack ! Using angle of attack at AC or 3/4 point - alpha_34 = Get_Alpha34(u%v_ac, u%omega, 0.5_ReKi*p%c(i,j)) + alpha_34 = Get_Alpha34(u%v_ac, u%omega, p%d_34_to_ac*p%c(i,j)) ! Angle of attack at previous time if (OtherState%FirstPass(i,j)) then alpha_minus1 = alpha_34 @@ -1722,7 +1851,7 @@ subroutine BV_getAlphas(i, j, u, p, xd, BL_p, tc, alpha_34, alphaE_L, alphaLag_D real(ReKi), parameter :: umach = 0.0_ReKi !< Mach number umach=Urel*Minf, Minf (freestrem Mach) for incompressible ! Angle of attack at 3/4 chord point - alpha_34 = Get_Alpha34(u%v_ac, u%omega, 0.5_ReKi*p%c(i,j)) + alpha_34 = Get_Alpha34(u%v_ac, u%omega, p%d_34_to_ac*p%c(i,j)) ! --- Intermediate variables, using CACTUS notations adotnorm = xd%alpha_dot(i,j) * Get_Tu(u%u, p%c(i,j)) @@ -1755,12 +1884,12 @@ subroutine BV_getAlphas(i, j, u, p, xd, BL_p, tc, alpha_34, alphaE_L, alphaLag_D !print*,'dalpha ', dalphaL,dalphaD ! --- Alpha dynamic - isgn = sign(1.0,adotnorm) + isgn = sign(1.0_ReKi,adotnorm) alphaE_L = alpha_34 - dalphaL*isgn alphaLag_D = alpha_34 - dalphaD*isgn ! NOTE: not effective alpha yet for drag end subroutine BV_getAlphas !============================================================================== -!> Calculate gamma for lift and drag based rel thickness. See CACTUS BV_DynStall.f95 +!> Calculate gamma for lift and drag based rel thickness. See CACTUS BV_DynStall.f95 subroutine BV_getGammas(tc, umach, gammaL, gammaD) real(ReKi), intent(in) :: tc !< Relative thickness of airfoil real(ReKi), intent(in) :: umach !< Mach number of Urel, = Urel*MinfMinf (freestrem Mach), 0 for incompressible @@ -2173,12 +2302,12 @@ subroutine UA_UpdateDiscOtherState( i, j, u, p, xd, OtherState, AFInfo, m, ErrSt end if end if -#ifdef UA_OUTS - m%TESF(i,j) = TESF - m%LESF(i,j) = LESF - m%VRTX(i,j) = VRTX - m%T_sh(i,j) = T_sh -#endif + if (p%UA_OUTS>0) then + m%TESF(i,j) = TESF + m%LESF(i,j) = LESF + m%VRTX(i,j) = VRTX + m%T_sh(i,j) = T_sh + endif end subroutine UA_UpdateDiscOtherState @@ -2216,7 +2345,7 @@ subroutine UA_UpdateStates( i, j, t, n, u, uTimes, p, x, xd, OtherState, AFInfo, type(UA_InputType) :: u_interp_raw ! Input at current timestep, t and t+dt type(UA_InputType) :: u_interp ! Input at current timestep, t and t+dt type(AFI_UA_BL_Type) :: BL_p ! airfoil UA parameters retrieved in Kelvin Chain - real(ReKi) :: Tu + real(R8Ki) :: Tu ! Initialize variables @@ -2225,6 +2354,7 @@ subroutine UA_UpdateStates( i, j, t, n, u, uTimes, p, x, xd, OtherState, AFInfo, !BJJ: u%u == 0 seems to be the root cause of all sorts of numerical problems.... + if (p%UAMod == UA_None) return ! we don't have any states to update here if (p%UA_off_forGood(i,j)) return ! we don't have any states to update here @@ -2237,18 +2367,43 @@ subroutine UA_UpdateStates( i, j, t, n, u, uTimes, p, x, xd, OtherState, AFInfo, call UA_fixInputs(u_interp_raw, u_interp, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (p%UAMod == UA_HGM .or. p%UAMod == UA_HGMV) then + + if (p%UAMod == UA_HGM .or. p%UAMod == UA_HGMV .or. p%UAMod == UA_OYE .or. p%UAMod == UA_HGMV360) then - ! initialize states to steady-state values: if (OtherState%FirstPass(i,j)) then - call HGM_Steady( i, j, u_interp, p, x%element(i,j), AFInfo, ErrStat2, ErrMsg2 ) + call HGM_Steady( i, j, u_interp, p, x%element(i,j), AFInfo, ErrStat2, ErrMsg2 ) ! u_interp at t end if - call UA_ABM4( i, j, t, n, u, utimes, p, x, OtherState, AFInfo, m, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (.not. p%ShedEffect) then + ! update states to value at t+dt: + SELECT CASE ( p%integrationMethod ) + CASE (UA_Method_RK4) + call UA_RK4( i, j, t, n, u, utimes, p, x, OtherState, AFInfo, m, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CASE (UA_Method_AB4) + call UA_AB4( i, j, t, n, u, utimes, p, x, OtherState, AFInfo, m, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CASE (UA_Method_ABM4) + call UA_ABM4( i, j, t, n, u, utimes, p, x, OtherState, AFInfo, m, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CASE (UA_Method_BDF2) + ! get inputs at t+dt + CALL UA_Input_ExtrapInterp( u, utimes, u_interp_raw, t+p%dt, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + IF ( ErrStat >= AbortErrLev ) RETURN + + ! make sure that u%u is not zero (this previously turned off UA for the entire simulation. + ! Now, we keep it on, but we don't want the math to blow up when we divide by u%u) + call UA_fixInputs(u_interp_raw, u_interp, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + call UA_BDF2( i, j, t, n, u_interp, p, x, OtherState, AFInfo, m, ErrStat2, ErrMsg2 ) ! u_interp at t+dt + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + END SELECT + + + if (.not. p%ShedEffect .or. p%UAMod == UA_OYE) then ! Safety x%element(i,j)%x(1) = 0.0_R8Ki x%element(i,j)%x(2) = 0.0_R8Ki @@ -2261,17 +2416,13 @@ subroutine UA_UpdateStates( i, j, t, n, u, uTimes, p, x, xd, OtherState, AFInfo, CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! these are angles that should not get too large, so I am fixing them here (should turn off UA if this exceeds reasonable numbers) - if (abs(x%element(i,j)%x(1)) > TwoPi .or. abs(x%element(i,j)%x(2)) > TwoPi) then + if (abs(x%element(i,j)%x(1)) > 3*TwoPi_R8 .or. abs(x%element(i,j)%x(2)) > 3*TwoPi_R8) then if (m%FirstWarn_UA) then - call SetErrStat(ErrID_Severe, "Divergent states in UA HGM model", ErrStat, ErrMsg, RoutineName ) + call SetErrStat(ErrID_Warn, "Divergent states in UA HGM model", ErrStat, ErrMsg, RoutineName ) m%FirstWarn_UA = .false. end if - - call Mpi2pi(x%element(i,j)%x(1)) - call Mpi2pi(x%element(i,j)%x(2)) end if - if (p%UAMod == UA_HGMV) then ! Lookup values using Airfoil Info module @@ -2326,18 +2477,6 @@ subroutine UA_UpdateStates( i, j, t, n, u, uTimes, p, x, xd, OtherState, AFInfo, end if ! p%UAMod == UA_HGMV - elseif (p%UAMod == UA_OYE) then - - ! First time, initialize states to steady-state values: - if (OtherState%FirstPass(i,j)) then - call HGM_Steady( i, j, u_interp, p, x%element(i,j), AFInfo, ErrStat2, ErrMsg2 ) - end if - ! Time integrate - call UA_ABM4(i, j, t, n, u, utimes, p, x, OtherState, AFInfo, m, ErrStat2, ErrMsg2); call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - ! Make sure the states aren't getting out of control - x%element(i,j)%x(4) = max( min( x%element(i,j)%x(4), 1.0_R8Ki ), 0.0_R8Ki ) - call UA_BlendSteadyStates(i, j, u_interp, p, AFInfo, x%element(i,j), m%FirstWarn_UA_off, m%weight(i,j), ErrStat2, ErrMsg2); CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - elseif (p%UAMod == UA_BV) then ! Integrate discrete states (alpha_dot, alpha_filt_minus1) call UA_UpdateDiscOtherState_BV( i, j, u_interp, p, xd, OtherState, AFInfo, m, ErrStat2, ErrMsg2 ) @@ -2380,7 +2519,7 @@ subroutine UA_InitStates_AllNodes( u, p, x, OtherState, AFInfo, AFIndx ) !............................................................................................................................... ! compute UA states at t=0 (with known inputs) !............................................................................................................................... - if (p%UAMod == UA_HGM .or. p%UAMod == UA_HGMV .or. p%UAMod == UA_OYE) then + if (p%UAMod == UA_HGM .or. p%UAMod == UA_HGMV .or. p%UAMod == UA_OYE .or. p%UAMod == UA_HGMV360) then do j = 1,size(p%UA_off_forGood,2) ! blades do i = 1,size(p%UA_off_forGood,1) ! nodes @@ -2423,7 +2562,7 @@ SUBROUTINE HGM_Steady( i, j, u, p, x, AFInfo, ErrStat, ErrMsg ) integer(IntKi) :: errStat2 character(*), parameter :: RoutineName = 'HGM_Steady' - real(ReKi) :: Tu + real(R8Ki) :: Tu real(ReKi) :: alphaE real(ReKi) :: alphaF real(ReKi) :: alpha_34 @@ -2433,6 +2572,8 @@ SUBROUTINE HGM_Steady( i, j, u, p, x, AFInfo, ErrStat, ErrMsg ) ErrStat = ErrID_None ErrMsg = "" + + x%x=0.0_R8Ki ! initialize all states (in case they aren't used) ! Lookup values using Airfoil Info module call AFI_ComputeUACoefs( AFInfo, u%Re, u%UserProp, BL_p, ErrMsg2, ErrStat2 ) @@ -2476,9 +2617,9 @@ SUBROUTINE HGM_Steady( i, j, u, p, x, AFInfo, ErrStat, ErrMsg ) !call AFI_ComputeAirfoilCoefs( alphaF, u%Re, u%UserProp, AFInfo, AFI_interp, ErrStat, ErrMsg) !x%x(4) = AFI_interp%f_st - elseif (p%UAMod==UA_HGMV) then + elseif (p%UAMod==UA_HGMV .or. p%UAMod==UA_HGMV360) then !call AFI_ComputeAirfoilCoefs( alphaE, u%Re, u%UserProp, AFInfo, AFI_interp, ErrStat, ErrMsg) - x%x(3) = AFI_interp%FullyAttached ! ~ (alpha-alphaLower)*c_Rate + c_alphaLower + x%x(3) = AFI_interp%FullyAttached ! find alphaF where cn_FullyAttached(alphaF) = x(3) ! and note that we just set x(3) = cn_FullyAttached(alphaE) @@ -2488,10 +2629,12 @@ SUBROUTINE HGM_Steady( i, j, u, p, x, AFInfo, ErrStat, ErrMsg ) !call AFI_ComputeAirfoilCoefs( alphaF, u%Re, u%UserProp, AFInfo, AFI_interp, ErrStat, ErrMsg) !x%x(4) = AFI_interp%f_st else - print*,'HGM_steady, should never happen' - STOP + call WrScr('>>> HGM_steady logic error: should never happen.') + call SetErrStat(ErrID_FATAL,"Programming error.",ErrStat,ErrMsg,RoutineName) + return end if + ! calculate x%x(4) = fs_aF = f_st(alphaF): x%x(4) = AFI_interp%f_st x%x(5) = 0.0_R8Ki @@ -2517,20 +2660,22 @@ subroutine UA_CalcContStateDeriv( i, j, t, u_in, p, x, OtherState, AFInfo, m, dx ! Local variables type(AFI_UA_BL_Type) :: BL_p ! potentially interpolated UA parameters - type(AFI_OutputType) :: AFI_AlphaE ! interploated values at alphaE + type(AFI_OutputType) :: AFI_AlphaE ! interpolated values at alphaE type(AFI_OutputType) :: AFI_AlphaF ! interpolated values at alphaF + type(AFI_OutputType) :: AFI_Alpha ! interpolated values at u%alpha character(ErrMsgLen) :: errMsg2 integer(IntKi) :: errStat2 character(*), parameter :: RoutineName = 'UA_CalcContStateDeriv' - real(ReKi) :: Tu + real(R8Ki) :: Tu real(ReKi) :: alphaE real(ReKi) :: alphaF - real(ReKi) :: Clp + real(R8Ki) :: Clp real(ReKi) :: cRate ! slope of the piecewise linear region of fully attached polar real(R8Ki) :: x4 real(ReKi) :: alpha_34 - real(ReKi), parameter :: U_dot = 0.0_ReKi ! at some point we may add this term + real(ReKi) :: TuOmega + real(R8Ki), parameter :: U_dot = 0.0_R8Ki ! at some point we may add this term TYPE(UA_InputType) :: u ! Inputs at t real(R8Ki) :: CnC_dot, One_Plus_Sqrt_x4, cv_dot, CnC @@ -2539,10 +2684,10 @@ subroutine UA_CalcContStateDeriv( i, j, t, u_in, p, x, OtherState, AFInfo, m, dx ErrStat = ErrID_None ErrMsg = "" - if (p%UA_off_forGood(i,j)) then - dxdt%x = 0.0_R8Ki - return - end if + ! initialize for models that don't use all of the state terms: + dxdt%x = 0.0_R8Ki + + if (p%UA_off_forGood(i,j)) return ! make sure that u%u is not zero (this previously turned off UA for the entire simulation. ! Now, we keep it on, but we don't want the math to blow up when we divide by u%u) @@ -2562,30 +2707,12 @@ subroutine UA_CalcContStateDeriv( i, j, t, u_in, p, x, OtherState, AFInfo, m, dx BL_p%T_f0 = BL_p%T_f0 * Tu ! Emmanuel wants a factor of 2 here to match HAWC2, but we don't want that factor for Bladed comparisons BL_p%T_p = BL_p%T_p * Tu + TuOmega = Tu * u%omega + TuOmega = MIN( MAX(TuOmega, -MaxTuOmega), MaxTuOmega) + ! calculate fs_aF (stored in AFI_interp%f_st): ! find alphaF where FullyAttached(alphaF) = x(3) - if (p%UAMod == UA_HGM) then - !note: BL_p%c_lalpha cannot be zero. UA is turned off at initialization if this occurs. - alphaF = x%x(3)/BL_p%c_lalpha + BL_p%alpha0 ! Eq. 15 [40] - - else if (p%UAMod == UA_OYE) then - alphaF = alpha_34 - - else if (p%UAMod == UA_HGMV) then - if (x%x(3) < BL_p%c_alphaLowerWrap) then - alphaF = (x%x(3) - BL_p%c_alphaLowerWrap) / BL_p%c_RateWrap + BL_p%alphaLowerWrap - elseif (x%x(3) < BL_p%c_alphaLower) then - alphaF = (x%x(3) - BL_p%c_alphaLower) / BL_p%c_RateLower + BL_p%alphaLower - elseif(x%x(3) < BL_p%c_alphaUpper) then - ! this alphaF might be slightly different for alphaLower < x(3) < alphaUpper (it's not quite linear there) - ! however, the separation function is 1 there, so it doesn't matter if we're off a little bit - alphaF = (x%x(3) - BL_p%c_alphaLower) / BL_p%c_Rate + BL_p%alphaLower - elseif(x%x(3) < BL_p%c_alphaUpperWrap) then - alphaF = (x%x(3) - BL_p%c_alphaUpper) / BL_p%c_RateUpper + BL_p%alphaUpper - else - alphaF = (x%x(3) - BL_p%c_alphaUpperWrap) / BL_p%c_RateWrap + BL_p%alphaUpperWrap - end if - end if + alphaF = Get_alphaF(p, u, x, BL_p, alpha_34, alphaE) call AFI_ComputeAirfoilCoefs( alphaF, u%Re, u%UserProp, AFInfo, AFI_AlphaF, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) @@ -2597,67 +2724,77 @@ subroutine UA_CalcContStateDeriv( i, j, t, u_in, p, x, OtherState, AFInfo, m, dx !x2: Downwash memory term 2 (rad) !x3: Clp', Lift coefficient with a time lag to the attached lift coeff !x4: f'' , Final separation point function - + ! Constraining x4 between 0 and 1 increases numerical stability (should be done elsewhere, but we'll double check here in case there were perturbations on the state value) x4 = max( min( x%x(4), 1.0_R8Ki ), 0.0_R8Ki ) - call AddOrSub2Pi(real(x%x(1),ReKi), alpha_34) ! make sure we use the same alpha_34 for both x1 and x2 equations. if (p%ShedEffect) then - dxdt%x(1) = -1.0_R8Ki / Tu * (BL_p%b1 + p%c(i,j) * U_dot/(2*u%u**2)) * x%x(1) + BL_p%b1 * BL_p%A1 / Tu * alpha_34 ! Eq. 8 [40] - dxdt%x(2) = -1.0_R8Ki / Tu * (BL_p%b2 + p%c(i,j) * U_dot/(2*u%u**2)) * x%x(2) + BL_p%b2 * BL_p%A2 / Tu * alpha_34 ! Eq. 9 [40] + if (.NOT. EqualRealNos(BL_p%A1,0.0_ReKi)) call AddOrSub2Pi(real(x%x(1)/BL_p%A1,ReKi), alpha_34) ! beause U_dot == 0, dx%x1 is A1*b1/Tu*(alpha_34 - x1/A1), we want the angle difference to be calculated correctly + dxdt%x(1) = -1.0_R8Ki / Tu * (BL_p%b1 + p%c(i,j) * U_dot/(2*u%u**2)) * x%x(1) + BL_p%b1 * BL_p%A1 / Tu * alpha_34 ! Eq. 8 [40] + + if (.NOT. EqualRealNos(BL_p%A2,0.0_ReKi)) call AddOrSub2Pi(real(x%x(2)/BL_p%A2,ReKi), alpha_34) ! beause U_dot == 0, dx%x2 is A2*b2/Tu*(alpha_34 - x2/A2), we want the angle difference to be calculated correctly + dxdt%x(2) = -1.0_R8Ki / Tu * (BL_p%b2 + p%c(i,j) * U_dot/(2*u%u**2)) * x%x(2) + BL_p%b2 * BL_p%A2 / Tu * alpha_34 ! Eq. 9 [40] else - dxdt%x(1) = 0.0_ReKi - dxdt%x(2) = 0.0_ReKi + dxdt%x(1) = 0.0_R8Ki + dxdt%x(2) = 0.0_R8Ki endif if (p%UAMod == UA_HGM) then call AddOrSub2Pi(BL_p%alpha0, alphaE) - Clp = BL_p%c_lalpha * (alphaE - BL_p%alpha0) + pi * Tu * u%omega ! Eq. 13 - dxdt%x(3) = -1.0_R8Ki / BL_p%T_p * x%x(3) + 1.0_ReKi / BL_p%T_p * Clp ! Eq. 10 [40] - dxdt%x(4) = -1.0_R8Ki / BL_p%T_f0 * x4 + 1.0_ReKi / BL_p%T_f0 * AFI_AlphaF%f_st ! Eq. 11 [40] + Clp = BL_p%c_lalpha * (alphaE - BL_p%alpha0) + pi * TuOmega ! Eq. 13 + dxdt%x(3) = ( Clp - x%x(3) ) / BL_p%T_p ! Eq. 10 [40] + dxdt%x(4) = ( AFI_AlphaF%f_st - x4 ) / BL_p%T_f0 ! Eq. 11 [40] dxdt%x(5) = 0.0_R8Ki elseif (p%UAMod == UA_OYE) then - dxdt%x(4) = -1.0_R8Ki / BL_p%T_f0 * x4 + 1.0_ReKi / BL_p%T_f0 * AFI_AlphaF%f_st + dxdt%x(4) = ( AFI_AlphaF%f_st - x4 ) / BL_p%T_f0 dxdt%x(1) = 0.0_R8Ki dxdt%x(2) = 0.0_R8Ki dxdt%x(3) = 0.0_R8Ki dxdt%x(5) = 0.0_R8Ki - elseif (p%UAMod == UA_HGMV) then + elseif (p%UAMod == UA_HGMV .OR. p%UAMod == UA_HGMV360) then call AFI_ComputeAirfoilCoefs( alphaE, u%Re, u%UserProp, AFInfo, AFI_AlphaE, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) if (ErrStat >= AbortErrLev) return - Clp = AFI_AlphaE%FullyAttached + pi * Tu * u%omega ! Eq. 13 (this is really Cnp) - dxdt%x(3) = -1.0_R8Ki / BL_p%T_p * x%x(3) + 1.0_ReKi / BL_p%T_p * Clp - - dxdt%x(4) = -1.0_R8Ki / BL_p%T_f0 * x4 + 1.0_ReKi / BL_p%T_f0 * AFI_AlphaF%f_st + Clp = AFI_AlphaE%FullyAttached + pi * TuOmega ! Eq. 13 (this is really Cnp) + dxdt%x(3) = ( Clp - x%x(3) ) / BL_p%T_p + dxdt%x(4) = ( AFI_AlphaF%f_st - x4 ) / BL_p%T_f0 - if (OtherState%VortexOn(i,j)) then - One_Plus_Sqrt_x4 =1.0_R8Ki + sqrt(x4) + if (p%UAMod == UA_HGMV360) then + dxdt%x(5) = 0.0_R8Ki + else + if (OtherState%VortexOn(i,j)) then + call MPi2Pi(alphaE) + + One_Plus_Sqrt_x4 =1.0_R8Ki + sqrt(x4) - if (alphaE < BL_p%alphaLower) then - cRate = BL_p%c_RateLower - elseif(alphaE < BL_p%alphaUpper) then - cRate = BL_p%c_Rate + if (alphaE < BL_p%alphaBreakLower .or. alphaE > BL_p%alphaBreakUpper) then + cRate = ( BL_p%CnBreakUpper - BL_p%CnBreakLower ) / ( BL_p%alphaBreakUpper - TwoPi - BL_p%alphaBreakLower ) + elseif (alphaE < BL_p%alphaLower) then + cRate = ( BL_p%CnBreakLower - BL_p%c_alphaLower ) / ( BL_p%alphaBreakLower - BL_p%alphaLower ) + elseif(alphaE < BL_p%alphaUpper) then + cRate = ( BL_p%c_alphaLower - BL_p%c_alphaUpper ) / ( BL_p%alphaLower - BL_p%alphaUpper ) + else + cRate = ( BL_p%c_alphaUpper - BL_p%CnBreakUpper ) / ( BL_p%alphaUpper - BL_p%alphaBreakUpper ) + end if + CnC_dot = cRate * u%omega * (1.0_R8Ki - BL_p%A1 - BL_p%A2) + dxdt%x(1) + dxdt%x(2) + cv_dot = CnC_dot*(1.0_R8Ki - 0.25_R8Ki*(One_Plus_Sqrt_x4)**2) + + CnC = AFI_AlphaE%FullyAttached + cv_dot = cv_dot - CnC*0.25_R8Ki*One_Plus_Sqrt_x4/sqrt(max(0.0001_R8Ki,x4))*dxdt%x(4) else - cRate = BL_p%c_RateUpper + cv_dot = 0.0_R8Ki end if - CnC_dot = cRate * u%omega * (1.0_R8Ki - BL_p%A1 - BL_p%A2) + dxdt%x(1) + dxdt%x(2) - cv_dot = CnC_dot*(1.0_R8Ki - 0.25_R8Ki*(One_Plus_Sqrt_x4)**2) - CnC = AFI_AlphaE%FullyAttached - cv_dot = cv_dot - CnC*0.25_R8Ki*One_Plus_Sqrt_x4/sqrt(max(0.0001_R8Ki,x4))*dxdt%x(4) - else - cv_dot = 0.0_R8Ki + dxdt%x(5) = cv_dot - x%x(5)/(BL_p%T_V0 * Tu) end if - - dxdt%x(5) = cv_dot - x%x(5)/(BL_p%T_V0 * Tu) else - print*,'>>> UA_CalcContStateDeriv, should never happen.' - STOP ! should never happen + call WrScr('>>> UA_CalcContStateDeriv logic error: should never happen.') + call SetErrStat(ErrID_FATAL,"Programming error.",ErrStat,ErrMsg,RoutineName) + return end if END SUBROUTINE UA_CalcContStateDeriv @@ -2670,48 +2807,112 @@ SUBROUTINE Get_HGM_constants(i, j, p, u, x, BL_p, Tu, alpha_34, alphaE) TYPE(UA_ElementContinuousStateType), INTENT(IN ) :: x ! Continuous states at t TYPE(AFI_UA_BL_Type), INTENT(IN ) :: BL_p ! potentially interpolated UA parameters + REAL(R8Ki), INTENT( OUT) :: Tu REAL(ReKi), optional, INTENT( OUT) :: alpha_34 - REAL(ReKi), INTENT( OUT) :: Tu REAL(ReKi), optional, INTENT( OUT) :: alphaE - ! Local variables - real(ReKi) :: vx_34 - - ! Variables derived from inputs !u%u = U_ac = TwoNorm(u%v_ac) ! page 4 definitions Tu = Get_Tu(u%u, p%c(i,j)) if (present(alpha_34)) then - alpha_34 = Get_Alpha34(u%v_ac, u%omega, 0.5_ReKi*p%c(i,j)) - + alpha_34 = Get_Alpha34(u%v_ac, u%omega, p%d_34_to_ac*p%c(i,j)) + if (present(alphaE)) then ! Variables derived from states if (p%UAMod == UA_OYE .or. .not. p%ShedEffect) then alphaE = alpha_34 else + !call AddOrSub2Pi( real(x%x(1) + x%x(2),ReKi), alpha_34 ) ! Ensure that alpha_34 is well behaved during +/-180 deg wrap + call MPi2Pi(alpha_34) ! let's not make alphaE too large? + alphaE = alpha_34*(1.0_ReKi - BL_p%A1 - BL_p%A2) + x%x(1) + x%x(2) ! Eq. 12 endif - call MPi2Pi(alphaE) + end if end if END SUBROUTINE Get_HGM_constants +!--------------------------------------------------------------------------------- +FUNCTION Get_alphaF(p, u, x, BL_p, alpha_34, alphaE_in) RESULT(alphaF) + TYPE(UA_InputType), INTENT(IN ) :: u ! Inputs at t + TYPE(UA_ParameterType), INTENT(IN ) :: p ! Parameters + TYPE(UA_ElementContinuousStateType), INTENT(IN ) :: x ! Continuous states at t + TYPE(AFI_UA_BL_Type), INTENT(IN ) :: BL_p ! potentially interpolated UA parameters + + REAL(ReKi), INTENT(IN ) :: alpha_34 + REAL(ReKi), INTENT(IN ) :: alphaE_in + REAL(ReKi) :: alphaF ! function result + + REAL(ReKi) :: alphaE ! value that can be changed (+/- 2pi) + REAL(ReKi) :: alpha_(2), c_(2) + REAL(ReKi) :: alphaN_(4), cN_(4) + integer(IntKi) :: Indx + + + alphaE = alphaE_in + + ! calculate fs_aF (stored in AFI_interp%f_st): + ! find alphaF where FullyAttached(alphaF) = x(3) + if (p%UAMod == UA_OYE) then + alphaF = alpha_34 + elseif (p%UAMod == UA_HGM) then + + !note: BL_p%c_lalpha cannot be zero. UA is turned off at initialization if this occurs. + alphaF = x%x(3)/BL_p%c_lalpha + BL_p%alpha0 ! Eq. 15 [40] + elseif (p%UAMod==UA_HGMV360 .or. p%UAMod == UA_HGMV) then + call MPi2Pi(alphaE) + + ! this is for the wrap-around in the first two cases in the if statement below + Indx = 1 + alpha_ = (/ BL_p%alphaBreakUpper, BL_p%alphaBreakLower+TwoPi /) + c_ = (/ BL_p%CnBreakUpper, BL_p%CnBreakLower /) + + if ( alphaE < BL_p%alphaBreakLower) then ! reverseFlowAngleMaskLow + ! Assemble alpha lookup from Cn based on "reverse" flow angles in the range of approximately +90 to +270 deg + alphaF = InterpExtrapStp(REAL(x%x(3),ReKi), c_, alpha_, Indx, size(c_)) - TwoPi + + elseif ( alphaE > BL_p%alphaBreakUpper) then ! reverseFlowAngleMaskHigh + ! Assemble alpha lookup from Cn based on "reverse" flow angles in the range of approximately +90 to +270 deg + alphaF = InterpExtrapStp(REAL(x%x(3),ReKi), c_, alpha_, Indx, size(c_)) + + else ! normalFlowAngleMask + ! Assemble alpha lookup from Cn based on "normal" flow angles in the range of approximately -90 to +90 deg + + ! this alphaF might be different for alphaLower < x(3) < alphaUpper (it's not necessarily exactly linear there) + ! however, the separation function is 1 there, so it doesn't matter if we're off a little bit + + alphaN_ = (/ BL_p%alphaBreakLower, BL_p%alphaLower, BL_p%alphaUpper, BL_p%alphaBreakUpper /) + cN_ = (/ BL_p%CnBreakLower, BL_p%c_alphaLower, BL_p%c_alphaUpper, BL_p%CnBreakUpper /) + alphaF = InterpExtrapStp(REAL(x%x(3),ReKi), cN_, alphaN_, Indx, size(cN_)) + end if + + else + !PROGRAMMING ERROR IF WE GET TO THIS PART OF THE IF STATEMENT! + alphaF = 0 + end if + + +END FUNCTION Get_alphaF +!--------------------------------------------------------------------------------- !> Compute angle of attack at 3/4 chord point based on values at Aerodynamic center -real(ReKi) function Get_Alpha34(v_ac, omega, d_ac_to_34) - real(ReKi), intent(in) :: v_ac(2) !< Velocity at aerodynamic center +real(ReKi) function Get_Alpha34(v_ac, omega, d_34_to_ac) + real(ReKi), intent(in) :: v_ac(2) !< Velocity at aerodynamic center (AC) real(ReKi), intent(in) :: omega !< pitching rate of airfoil - real(ReKi), intent(in) :: d_ac_to_34 !< distance from aerodynamic center to 3/4 chord point - Get_Alpha34 = atan2(v_ac(1) + omega * d_ac_to_34, v_ac(2) ) ! Uaero - Uelast + real(ReKi), intent(in) :: d_34_to_ac !< distance from 3/4 chord to AC point, assumed >0, e.g. =0.5c + real(ReKi) :: vx_34 + + vx_34 = v_ac(1) + omega * d_34_to_ac ! Eq. 1 (fix on sign) + Get_Alpha34 = atan2(vx_34, v_ac(2) ) ! Uaero - Uelast ! page 5 definitions end function Get_Alpha34 !> Compute angle of attack at 2/4 chord point based on values at Aerodynamic center -real(ReKi) function Get_Alpha24(v_ac, omega, d_ac_to_24) - real(ReKi), intent(in) :: v_ac(2) !< Velocity at aerodynamic center +real(ReKi) function Get_Alpha24(v_ac, omega, d_24_to_ac) + real(ReKi), intent(in) :: v_ac(2) !< Velocity at aerodynamic center (AC) real(ReKi), intent(in) :: omega !< pitching rate of airfoil - real(ReKi), intent(in) :: d_ac_to_24 !< distance from aerodynamic center to 2/4 chord point - Get_Alpha24 = atan2(v_ac(1) + omega * d_ac_to_24, v_ac(2) ) ! Uaero - Uelast + real(ReKi), intent(in) :: d_24_to_ac !< distance from 2/4 chord to AC point, assumed >0, e.g. =0.25c + Get_Alpha24 = atan2(v_ac(1) + omega * d_24_to_ac, v_ac(2) ) ! Uaero - Uelast end function Get_Alpha24 !> Compute time constant based on relative velocity u_rel @@ -2784,7 +2985,7 @@ SUBROUTINE UA_RK4( i, j, t, n, u, utimes, p, x, OtherState, AFInfo, m, ErrStat, ErrMsg = "" ! interpolate u to find u_interp = u(t) - CALL UA_Input_ExtrapInterp( u, utimes, u_interp, t, ErrStat2, ErrMsg2 ) + CALL UA_Input_ExtrapInterp( u, utimes, u_interp, t, ErrStat2, ErrMsg2 ) ! don't need to fix inputs after this call because UA_CalcContStateDeriv() calls that routine CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) IF ( ErrStat >= AbortErrLev ) RETURN @@ -2797,11 +2998,11 @@ SUBROUTINE UA_RK4( i, j, t, n, u, utimes, p, x, OtherState, AFInfo, m, ErrStat, k1%x = p%dt * k1%x - x_tmp%x = x%element(i,j)%x + 0.5 * k1%x + x_tmp%x = x%element(i,j)%x + 0.5_R8Ki * k1%x ! interpolate u to find u_interp = u(t + dt/2) TPlusHalfDt = t + 0.5_DbKi*p%dt - CALL UA_Input_ExtrapInterp(u, utimes, u_interp, TPlusHalfDt, ErrStat2, ErrMsg2) + CALL UA_Input_ExtrapInterp(u, utimes, u_interp, TPlusHalfDt, ErrStat2, ErrMsg2) ! don't need to fix inputs after this call because UA_CalcContStateDeriv() calls that routine CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) IF ( ErrStat >= AbortErrLev ) RETURN @@ -2810,7 +3011,7 @@ SUBROUTINE UA_RK4( i, j, t, n, u, utimes, p, x, OtherState, AFInfo, m, ErrStat, k2%x = p%dt * k2%x - x_tmp%x = x%element(i,j)%x + 0.5 * k2%x + x_tmp%x = x%element(i,j)%x + 0.5_R8Ki * k2%x ! find xdot at t + dt/2 (note x_tmp has changed) CALL UA_CalcContStateDeriv( i, j, TPlusHalfDt, u_interp, p, x_tmp, OtherState, AFInfo, m, k3, ErrStat2, ErrMsg2 ) @@ -2821,7 +3022,7 @@ SUBROUTINE UA_RK4( i, j, t, n, u, utimes, p, x, OtherState, AFInfo, m, ErrStat, ! interpolate u to find u_interp = u(t + dt) TPlusDt = t + p%dt - CALL UA_Input_ExtrapInterp(u, utimes, u_interp, TPlusDt, ErrStat2, ErrMsg2) + CALL UA_Input_ExtrapInterp(u, utimes, u_interp, TPlusDt, ErrStat2, ErrMsg2) ! don't need to fix inputs after this call because UA_CalcContStateDeriv() calls that routine CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) IF ( ErrStat >= AbortErrLev ) RETURN @@ -2830,11 +3031,11 @@ SUBROUTINE UA_RK4( i, j, t, n, u, utimes, p, x, OtherState, AFInfo, m, ErrStat, k4%x = p%dt * k4%x - x%element(i,j)%x = x%element(i,j)%x + ( k1%x + 2. * k2%x + 2. * k3%x + k4%x ) / 6. + x%element(i,j)%x = x%element(i,j)%x + ( k1%x + 2.0_R8Ki * k2%x + 2.0_R8Ki * k3%x + k4%x ) / 6.0_R8Ki END SUBROUTINE UA_RK4 !---------------------------------------------------------------------------------------------------------------------------------- -!> This subroutine implements the fourth-order Adams-Bashforth Method (RK4) for numerically integrating ordinary differential +!> This subroutine implements the fourth-order Adams-Bashforth Method (AB4) for numerically integrating ordinary differential !! equations: !! !! Let f(t, x) = xdot denote the time (t) derivative of the continuous states (x). @@ -2897,7 +3098,7 @@ SUBROUTINE UA_AB4( i, j, t, n, u, utimes, p, x, OtherState, AFInfo, m, ErrStat, ! need xdot at t, get inputs at t - CALL UA_Input_ExtrapInterp(u, utimes, u_interp, t, ErrStat2, ErrMsg2) + CALL UA_Input_ExtrapInterp(u, utimes, u_interp, t, ErrStat2, ErrMsg2) ! don't need to fix inputs after this call because UA_CalcContStateDeriv() calls that routine CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) IF ( ErrStat >= AbortErrLev ) RETURN @@ -2917,16 +3118,15 @@ SUBROUTINE UA_AB4( i, j, t, n, u, utimes, p, x, OtherState, AFInfo, m, ErrStat, IF ( ErrStat >= AbortErrLev ) RETURN else - x%element(i,j)%x = x%element(i,j)%x + p%DT/24. * ( 55.*OtherState%xdot(1)%element(i,j)%x - 59.*OtherState%xdot(2)%element(i,j)%x & - + 37.*OtherState%xdot(3)%element(i,j)%x - 9.*OtherState%xdot(4)%element(i,j)%x ) - + x%element(i,j)%x = x%element(i,j)%x + p%DT/24.0_R8Ki * ( 55.0_R8Ki*OtherState%xdot(1)%element(i,j)%x - 59.0_R8Ki*OtherState%xdot(2)%element(i,j)%x & + + 37.0_R8Ki*OtherState%xdot(3)%element(i,j)%x - 9.0_R8Ki*OtherState%xdot(4)%element(i,j)%x ) endif END SUBROUTINE UA_AB4 !---------------------------------------------------------------------------------------------------------------------------------- -!> This subroutine implements the fourth-order Adams-Bashforth-Moulton Method (RK4) for numerically integrating ordinary +!> This subroutine implements the fourth-order Adams-Bashforth-Moulton Method (ABM4) for numerically integrating ordinary !! differential equations: !! !! Let f(t, x) = xdot denote the time (t) derivative of the continuous states (x). @@ -2988,7 +3188,7 @@ SUBROUTINE UA_ABM4( i, j, t, n, u, utimes, p, x, OtherState, AFInfo, m, ErrStat, ! correct: - CALL UA_Input_ExtrapInterp(u, utimes, u_interp, t + p%dt, ErrStat2, ErrMsg2) + CALL UA_Input_ExtrapInterp(u, utimes, u_interp, t + p%dt, ErrStat2, ErrMsg2) ! don't need to fix inputs after this call because UA_CalcContStateDeriv() calls that routine CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) IF ( ErrStat >= AbortErrLev ) RETURN @@ -2997,17 +3197,228 @@ SUBROUTINE UA_ABM4( i, j, t, n, u, utimes, p, x, OtherState, AFInfo, m, ErrStat, IF ( ErrStat >= AbortErrLev ) RETURN - x%element(i,j)%x = x_in%x + p%DT/24. * ( 9. * xdot_pred%x + 19. * OtherState%xdot(1)%element(i,j)%x & - - 5. * OtherState%xdot(2)%element(i,j)%x & - + 1. * OtherState%xdot(3)%element(i,j)%x ) + x%element(i,j)%x = x_in%x + p%DT/24.0_R8Ki * ( 9.0_R8Ki * xdot_pred%x + 19.0_R8Ki * OtherState%xdot(1)%element(i,j)%x & + - 5.0_R8Ki * OtherState%xdot(2)%element(i,j)%x & + + 1.0_R8Ki * OtherState%xdot(3)%element(i,j)%x ) endif END SUBROUTINE UA_ABM4 !---------------------------------------------------------------------------------------------------------------------------------- !---------------------------------------------------------------------------------------------------------------------------------- +!> This subroutine implements a Newton solve of the 2nd-order backward differentiation formula (BDF2) system for numerically integrating ordinary differential equations: +SUBROUTINE UA_BDF2( i, j, t, n, u_interp, p, x, OtherState, AFInfo, m, ErrStat, ErrMsg ) +!.................................................................................................................................. + + integer(IntKi), INTENT(IN ) :: i !< blade node counter + integer(IntKi), INTENT(IN ) :: j !< blade counter + REAL(DbKi), INTENT(IN ) :: t !< Current simulation time in seconds + INTEGER(IntKi), INTENT(IN ) :: n !< time step number + TYPE(UA_InputType), INTENT(IN ) :: u_interp !< Inputs at t + dt + TYPE(UA_ParameterType), INTENT(IN ) :: p !< Parameters + TYPE(UA_ContinuousStateType), INTENT(INOUT) :: x !< Continuous states at t on input at t + dt on output + TYPE(UA_OtherStateType), INTENT(INOUT) :: OtherState !< Other states + TYPE(AFI_ParameterType), INTENT(IN ) :: AFInfo ! The airfoil parameter data + TYPE(UA_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 + INTEGER(IntKi) :: KMax + REAL(R8Ki), parameter :: TolerSquared = (1D-6)**2 + + INTEGER(IntKi) :: ErrStat2 ! local error status + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local error message (ErrMsg) + CHARACTER(*), PARAMETER :: RoutineName = 'UA_BDF2' + REAL(R8Ki) :: JMat(size(x%element(i,j)%x), size(x%element(i,j)%x)) + INTEGER :: iPivot(size(JMat,1)) + REAL(R8Ki) :: x_delta(size(JMat,1)) + REAL(R8Ki) :: x_constant(size(JMat,1)) + REAL(R8Ki) :: err + REAL(R8Ki) :: err_prev + logical :: try2 + REAL(R8Ki), PARAMETER :: reduction_factor = 0.25_R8Ki + + TYPE(UA_ElementContinuousStateType) :: xdot_pred ! Derivative of continuous states at t + + REAL(R8Ki), parameter :: Beta = 2.0_R8Ki/3.0_R8Ki + REAL(R8Ki), parameter :: Alpha0 = 4.0_R8Ki/3.0_R8Ki + REAL(R8Ki), parameter :: Alpha1 = -1.0_R8Ki/3.0_R8Ki + + !!!! for p=0, we get backward Euler: + !!!REAL(R8Ki), parameter :: Beta = 1.0_R8Ki + !!!REAL(R8Ki), parameter :: Alpha0 = 1.0_R8Ki + !!!REAL(R8Ki), parameter :: Alpha1 = 0.0_R8Ki + + + !NOTE: the error handling here assumes that we do not have any allocatable data in the inputs (u_interp) to be concerned with. + ! Also, We assume that if there is going to be an error in UA_CalcContStateDeriv, it will happen only on the first call + ! to the routine. + + ! Initialize ErrStat + + ErrStat = ErrID_None + ErrMsg = "" + + if (OtherState%n(i,j) < n) then + + OtherState%n(i,j) = n + + OtherState%xHistory(4)%element(i,j) = OtherState%xHistory(3)%element(i,j) + OtherState%xHistory(3)%element(i,j) = OtherState%xHistory(2)%element(i,j) + OtherState%xHistory(2)%element(i,j) = OtherState%xHistory(1)%element(i,j) + + if (n <= 1) then + OtherState%xHistory(2)%element(i,j) = x%element(i,j) + end if + + elseif (OtherState%n(i,j) > n) then + + CALL SetErrStat(ErrID_Fatal,'Backing up in time is not supported with a multistep method.',ErrStat,ErrMsg,RoutineName) + RETURN + + endif + + OtherState%xHistory(1)%element(i,j) = x%element(i,j) + + !!if (n<=1) then ! initialize because we don't have values for x + !! CALL UA_RK4(i, j, t, n, u, utimes, p, x, OtherState, AFInfo, m, ErrStat2, ErrMsg2 ) + !! CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + !! RETURN + !!end if + + + x_constant = Alpha0 * x%element(i,j)%x + Alpha1 * OtherState%xHistory(2)%element(i,j)%x + + err = HUGE(err) + k = 0 + try2 = .false. + KMax = 10 + + DO + + IF (K==0 .NEQV. try2) THEN ! exclusive OR (XOR is not part of Fortran 2003 standard) + ! This Jacobian will change when x changes, only if the values of x1, x2, or x3 are near boundaries of slope changes in + ! the FullyAttached function of the airfoil. At that point, it should be okay if the derivative is computed + ! on a slightly different region anyway. + CALL UA_Jacobian( i, j, t, n, u_interp, p, x, OtherState, AFInfo, m, Beta, JMat, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ! Get the LU decomposition of this matrix using a LAPACK routine: + ! The result is of the form JMat = P * L * U + + CALL LAPACK_getrf( M=size(JMat,1), N=size(JMat,2), A=JMat, IPIV=iPivot, ErrStat=ErrStat2, ErrMsg=ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + IF ( ErrStat >= AbortErrLev ) RETURN + END IF + + !------------------------------------------------------------------------------------------------- + ! Solve for delta x: JMat * x_delta = - F = - ( x(t+dt) - x(t) - dt * X(t+dt) + ! using the LAPACK routine + !------------------------------------------------------------------------------------------------- + CALL UA_CalcContStateDeriv( i, j, t, u_interp, p, x%element(i,j), OtherState, AFInfo, m, xdot_pred, ErrStat=ErrStat2, ErrMsg=ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + IF ( ErrStat >= AbortErrLev ) RETURN + + x_delta = - x%element(i,j)%x + x_constant + p%dt * Beta * xdot_pred%x + CALL LAPACK_getrs( TRANS="N", N=SIZE(JMat,1), A=JMat, & + IPIV=iPivot, B=x_delta, ErrStat=ErrStat2, ErrMsg=ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + IF ( ErrStat >= AbortErrLev ) RETURN + + !------------------------------------------------------------------------------------------------- + ! check for error, update inputs if necessary, and iterate again + !------------------------------------------------------------------------------------------------- + err_prev = err + err = DOT_PRODUCT(x_delta, x_delta) + IF ( err <= TolerSquared) EXIT + + !!------------------------------------------------------------------------------------------------- + !! modify states for next iteration + !!------------------------------------------------------------------------------------------------- + if (err > err_prev .and. K < KMax - 1) then + x_delta = x_delta * reduction_factor ! don't take a full step if we're getting farther from the solution! (except for the last step) + end if + + x%element(i,j)%x = x%element(i,j)%x + x_delta + + + K = K + 1 + IF (K >= KMax ) THEN + + if (try2) then + if (err > TolerSquared*(100)**2) then + CALL SetErrStat( ErrID_Severe, "Could not find solution in Newton solve. Error is "//trim(num2lstr(sqrt(err)))//'.', ErrStat, ErrMsg, RoutineName ) + end if + EXIT + else + x%element(i,j) = OtherState%xHistory(1)%element(i,j) + try2 = .true. + K = 0 + err = HUGE(err) + KMax = 13 + end if + END IF + + + END DO ! K + +END SUBROUTINE UA_BDF2 +!---------------------------------------------------------------------------------------------------------------------------------- +SUBROUTINE UA_Jacobian( i, j, t, n, u_interp, p, x, OtherState, AFInfo, m, Beta, JMat, ErrStat, ErrMsg ) + integer(IntKi), INTENT(IN ) :: i !< blade node counter + integer(IntKi), INTENT(IN ) :: j !< blade counter + REAL(DbKi), INTENT(IN ) :: t !< Current simulation time in seconds + INTEGER(IntKi), INTENT(IN ) :: n !< time step number + TYPE(UA_InputType), INTENT(IN ) :: u_interp !< Inputs at utimes + TYPE(UA_ParameterType), INTENT(IN ) :: p !< Parameters + TYPE(UA_ContinuousStateType), INTENT(INOUT) :: x !< Continuous states at t on input at t + dt on output + TYPE(UA_OtherStateType), INTENT(INOUT) :: OtherState !< Other states + TYPE(AFI_ParameterType), INTENT(IN ) :: AFInfo ! The airfoil parameter data + TYPE(UA_MiscVarType), INTENT(INOUT) :: m !< misc/optimization variables + REAL(R8Ki), INTENT(IN ) :: Beta !< Value of Beta for p-th order BDF method + REAL(R8Ki), INTENT( OUT) :: JMat(:,:) !< Jacobian matrix + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + TYPE(UA_ElementContinuousStateType) :: x_tmp ! Holds temporary modification to x + TYPE(UA_ElementContinuousStateType) :: X_p ! Holds derivative of X + TYPE(UA_ElementContinuousStateType) :: X_m ! Holds derivative of X + + INTEGER :: k + + ! Initialize ErrStat + + ErrStat = ErrID_None + ErrMsg = "" + ! compute JMat = I - dt*dXdx + + call eye(JMat, ErrStat, ErrMsg) + + x_tmp%x = x%element(i,j)%x + do k=1,size(p%dx) + x_tmp%x(k) = x%element(i,j)%x(k) + p%dx(k) + CALL UA_CalcContStateDeriv( i, j, t, u_interp, p, x_tmp, OtherState, AFInfo, m, X_p, ErrStat, ErrMsg ) + if (ErrStat >= AbortErrLev) return + + x_tmp%x(k) = x%element(i,j)%x(k) - p%dx(k) + CALL UA_CalcContStateDeriv( i, j, t, u_interp, p, x_tmp, OtherState, AFInfo, m, X_m, ErrStat, ErrMsg ) + if (ErrStat >= AbortErrLev) return + + ! reset + x_tmp%x(k) = x%element(i,j)%x(k) + + ! compute I(:,k) - dt * dXdx(:,k) + JMat(:,k) = JMat(:,k) - p%dt*Beta*(X_p%x - X_m%x) / (2.0_R8Ki * p%dx(k)) + end do + +END SUBROUTINE UA_Jacobian +!---------------------------------------------------------------------------------------------------------------------------------- + !============================================================================== subroutine UA_CalcOutput( i, j, t, u_in, p, x, xd, OtherState, AFInfo, y, misc, ErrStat, ErrMsg ) @@ -3049,10 +3460,12 @@ subroutine UA_CalcOutput( i, j, t, u_in, p, x, xd, OtherState, AFInfo, y, misc, real(ReKi) :: x_cp_hat ! center-of-pressure distance from LE in chord fraction real(ReKi) :: Cm_common ! real(ReKi) :: k ! reduced frequency + real(ReKi) :: SinAlpha, CosAlpha ! for UA_HGM real(ReKi) :: alphaE - real(ReKi) :: Tu + real(ReKi) :: alphaF + real(R8Ki) :: Tu real(ReKi) :: alpha_34 real(ReKi) :: fs_aE real(ReKi) :: cl_fs @@ -3067,27 +3480,26 @@ subroutine UA_CalcOutput( i, j, t, u_in, p, x, xd, OtherState, AFInfo, y, misc, real(ReKi) :: alphaE_L, alphaE_D ! effective angle of attack for lift and drag real(ReKi) :: alphaLag_D ! lagged angle of attack for drag calculation real(ReKi) :: adotnorm -#ifdef UA_OUTS real(ReKi) :: delN real(ReKi) :: delP real(ReKi) :: gammaL real(ReKi) :: gammaD real(ReKi) :: TransA -#endif + real(ReKi) :: TuOmega type(AFI_OutputType) :: AFI_interp + type(AFI_OutputType) :: AFI_interpE + type(AFI_OutputType) :: AFI_interpF -#ifdef UA_OUTS - integer :: iOffset -#endif ErrStat = ErrID_None ! no error has occurred ErrMsg = "" Cm_alpha_nc = 0.0_ReKi + Tu = 0.0_ReKi ! initialize for output file - AFI_interp%Cm = 0.0_ReKi ! value will be output if not computed below - alpha_prime_f = 0.0_ReKi ! value will be output if not computed below +! AFI_interpE%Cm = 0.0_ReKi ! value will be output if not computed below; this is set in the type definition + alpha_prime_f = 0.0_ReKi ! value will be output if not computed below ! make sure that u%u is not zero (this previously turned off UA for the entire simulation. ! Now, we keep it on, but we don't want the math to blow up when we divide by u%u) @@ -3095,7 +3507,24 @@ subroutine UA_CalcOutput( i, j, t, u_in, p, x, xd, OtherState, AFInfo, y, misc, call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) k = abs(u%omega * p%c(i, j) / (2.0_ReKi* u%u)) - if ( p%UA_off_forGood(i,j) .or. (OtherState%FirstPass(i, j) .and. p%UAMod < UA_HGM) ) then ! note: if u%U isn't zero because we've called UA_fixInputs + CosAlpha = cos(u%alpha) + SinAlpha = sin(u%alpha) + + + if ( p%UAMod == UA_None) then + + ! Compute steady aero using alpha 34 to be consistent with most UA models + Tu = Get_Tu(u%u, p%c(i,j)) + alpha_34 = Get_Alpha34(u%v_ac, u%omega, p%d_34_to_ac*p%c(i,j)) + call AFI_ComputeAirfoilCoefs( alpha_34, u%Re, u%UserProp, AFInfo, AFI_interp, ErrStat2, ErrMsg2); call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + y%Cl = AFI_interp%Cl + y%Cd = AFI_interp%Cd + y%Cm = AFI_interp%Cm + y%Cn = y%Cl*cos(u%alpha) + y%Cd*sin(u%alpha) + y%Cc = y%Cl*sin(u%alpha) - y%Cd*cos(u%alpha) + if (AFInfo%ColCm == 0) y%Cm = 0.0_ReKi + + else if ( p%UA_off_forGood(i,j) .or. (OtherState%FirstPass(i, j) .and. p%UAMod < UA_HGM) ) then ! note: if u%U isn't zero because we've called UA_fixInputs misc%weight(i,j) = 0.0 @@ -3106,8 +3535,8 @@ subroutine UA_CalcOutput( i, j, t, u_in, p, x, xd, OtherState, AFInfo, y, misc, y%Cm = AFI_interp%Cm - y%Cn = y%Cl*cos(u%alpha) + (y%Cd-AFI_interp%Cd0)*sin(u%alpha) - y%Cc = y%Cl*sin(u%alpha) - (y%Cd-AFI_interp%Cd0)*cos(u%alpha) + y%Cn = y%Cl*CosAlpha + (y%Cd-AFI_interp%Cd0)*SinAlpha + y%Cc = y%Cl*SinAlpha - (y%Cd-AFI_interp%Cd0)*CosAlpha Cm_v = 0.0_ReKi KC%Cn_alpha_q_circ = 0.0_ReKi @@ -3132,7 +3561,7 @@ subroutine UA_CalcOutput( i, j, t, u_in, p, x, xd, OtherState, AFInfo, y, misc, alpha_34 = u%alpha ! NOTE: no omega for UA= AbortErrLev) return - elseif (p%UAMod == UA_HGM .or. p%UAMod == UA_HGMV .or. p%UAMod == UA_OYE) then + elseif (p%UAMod == UA_HGM .or. p%UAMod == UA_HGMV .or. p%UAMod == UA_OYE .or. p%UAMod == UA_HGMV360) then ! --- CalcOutput State Space models x_in = x%element(i,j) @@ -3161,32 +3590,56 @@ subroutine UA_CalcOutput( i, j, t, u_in, p, x, xd, OtherState, AFInfo, y, misc, if (ErrStat >= AbortErrLev) return call Get_HGM_constants(i, j, p, u, x_in, BL_p, Tu, alpha_34, alphaE) ! compute Tu, alpha_34, and alphaE - - call AFI_ComputeAirfoilCoefs( alphaE, u%Re, u%UserProp, AFInfo, AFI_interp, ErrStat2, ErrMsg2 ) + TuOmega = Tu * u%omega + TuOmega = MIN( MAX(TuOmega, -MaxTuOmega), MaxTuOmega) + + call AFI_ComputeAirfoilCoefs( alphaE, u%Re, u%UserProp, AFInfo, AFI_interpE, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - + ! Constraining x4 between 0 and 1 increases numerical stability (should be done elsewhere, but we'll double check here in case there were perturbations on the state value) x4 = max( min( x_in%x(4), 1.0_R8Ki ), 0.0_R8Ki ) ! calculate values for output: - cl_fs = AFI_interp%FullySeparate - cl_fa = AFI_interp%FullyAttached - fs_aE = AFI_interp%f_st + cl_fs = AFI_interpE%FullySeparate + cl_fa = AFI_interpE%FullyAttached + fs_aE = AFI_interpE%f_st if (p%UAMod == UA_OYE) then ! calculate fully attached value: call AddOrSub2Pi(BL_p%alpha0, alphaE) cl_fa = (alphaE - BL_p%alpha0) * BL_p%c_lalpha ! Cl fully attached + y%Cl = x4 * cl_fa + (1.0_ReKi - x4) * cl_fs ! TODO consider adding simple corrections + pi * Tu * u%omega - y%Cd = AFI_interp%Cd ! TODO consider adding simple corrections + y%Cd = AFI_interpE%Cd ! TODO consider adding simple corrections if (AFInfo%ColCm == 0) then ! we don't have a cm column, so make everything 0 y%Cm = 0.0_ReKi else - y%Cm = AFI_interp%Cm ! TODO consider adding simple corrections + y%Cl * delta_c_mf_primeprime - piBy2 * Tu * u%omega + y%Cm = AFI_interpE%Cm ! TODO consider adding simple corrections + y%Cl * delta_c_mf_primeprime - piBy2 * Tu * u%omega endif - y%Cn = y%Cl*cos(u%alpha) + y%Cd*sin(u%alpha) - y%Cc = y%Cl*sin(u%alpha) - y%Cd*cos(u%alpha) + y%Cn = y%Cl*CosAlpha + y%Cd*SinAlpha + y%Cc = y%Cl*SinAlpha - y%Cd*CosAlpha + + elseif (p%UAMod == UA_HGMV360) then + y%Cn = x4 * AFI_interpE%FullyAttached + (1.0_ReKi - x4) * AFI_interpE%FullySeparate + pi * TuOmega + + y%Cc = AFI_interpE%Cl * SinAlpha - AFI_interpE%Cd * CosAlpha ! static Cc value at u%alpha + + y%Cl = y%Cn * CosAlpha + y%Cc * SinAlpha; + + alphaF = Get_alphaF(p, u, x_in, BL_p, alpha_34, alphaE) + call AFI_ComputeAirfoilCoefs( alphaF, u%Re, u%UserProp, AFInfo, AFI_interpF, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + y%Cd = AFI_interpF%Cd ! static Cd value at alphaF + + if (AFInfo%ColCm == 0) then ! we don't have a cm column, so make everything 0 + y%Cm = 0.0_ReKi + else + ! NOTE: EAM may want the term with u%omega zeroed out (THIS DOES NOT MATCH EAM's implementation) + y%Cm = AFI_interpE%Cm + y%Cl * delta_c_mf_primeprime - piBy2 * TuOmega ! Eq. 80 + end if + elseif (p%UAMod == UA_HGM) then ! calculate fully attached value: call AddOrSub2Pi(BL_p%alpha0, alphaE) @@ -3195,49 +3648,50 @@ subroutine UA_CalcOutput( i, j, t, u_in, p, x, xd, OtherState, AFInfo, y, misc, delta_c_df_primeprime = 0.5_ReKi * (sqrt(fs_aE) - sqrt(x4)) - 0.25_ReKi * (fs_aE - x4) ! Eq. 20 [40] ! bjj: do we need to check that u%alpha is between -pi and + pi? - cl_circ = x4 * cl_fa + (1.0_ReKi - x4) * cl_fs ! Eq. 19 [40] - y%Cl = cl_circ + pi * Tu * u%omega ! Eq. 16 [40] + cl_circ = x4 * cl_fa + (1.0_ReKi - x4) * AFI_interpE%FullySeparate ! Eq. 19 [40] + y%Cl = cl_circ + pi * TuOmega ! Eq. 16 [40] - call AddOrSub2Pi(u%alpha, alphaE) - cd_tors = cl_circ * Tu * u%omega - y%Cd = AFI_interp%Cd + (alpha_34 - alphaE) * cl_circ + (AFI_interp%Cd - BL_p%Cd0) * delta_c_df_primeprime + cd_tors ! Eq. 17 [40] + cd_tors = cl_circ * TuOmega + call AddOrSub2Pi(alpha_34, alphaE) + y%Cd = AFI_interpE%Cd + (alpha_34 - alphaE) * cl_circ + (AFI_interpE%Cd - BL_p%Cd0) * delta_c_df_primeprime + cd_tors ! Eq. 17 [40] if (AFInfo%ColCm == 0) then ! we don't have a cm column, so make everything 0 y%Cm = 0.0_ReKi else - y%Cm = AFI_interp%Cm + y%Cl * delta_c_mf_primeprime - piBy2 * Tu * u%omega ! Eq. 18 [40] + y%Cm = AFI_interpE%Cm + y%Cl * delta_c_mf_primeprime - piBy2 * TuOmega ! Eq. 18 [40] end if - y%Cn = y%Cl*cos(u%alpha) + y%Cd*sin(u%alpha) - y%Cc = y%Cl*sin(u%alpha) - y%Cd*cos(u%alpha) - else + y%Cn = y%Cl*CosAlpha + y%Cd*SinAlpha + y%Cc = y%Cl*SinAlpha - y%Cd*CosAlpha + + elseif (p%UAMod == UA_HGMV) then ! limit x5?: x5 = x_in%x(5) - cn_circ = x4 * AFI_interp%FullyAttached + (1.0_ReKi - x4) * AFI_interp%FullySeparate + x5 - y%Cn = cn_circ + pi * Tu * u%omega - y%Cc = AFI_interp%Cl*sin(alphaE) - AFI_interp%Cd*cos(alphaE) ! static value at alphaE - - y%Cl = y%Cn*cos(u%alpha) + y%Cc*sin(u%alpha) + cn_circ = x4 * AFI_interpE%FullyAttached + (1.0_ReKi - x4) * AFI_interpE%FullySeparate + x5 + y%Cn = cn_circ + pi * TuOmega - ! for cm: - tau_vl = t - OtherState%t_vortexBegin(i,j) - tau_vl = tau_vl / Tu ! make this non-dimensional (to compare with T_VL) - tV_ratio = min(1.5_ReKi, tau_vl/BL_p%T_VL) - - delta_c_df_primeprime = 0.5_ReKi * (sqrt(fs_aE) - sqrt(x4)) - 0.25_ReKi * (fs_aE - x4) ! Eq. 20 [40] + y%Cc = AFI_interpE%Cl*sin(alphaE) - AFI_interpE%Cd*cos(alphaE) ! static value at alphaE + y%Cl = y%Cn*CosAlpha + y%Cc*SinAlpha + + delta_c_df_primeprime = 0.5_ReKi * (sqrt(fs_aE) - sqrt(x4)) - 0.25_ReKi * (fs_aE - x4) ! Eq. 20 [40] call AddOrSub2Pi(u%alpha, alphaE) - y%Cd = AFI_interp%Cd + (u%alpha - alphaE) * y%Cn + (AFI_interp%Cd - BL_p%Cd0) * delta_c_df_primeprime ! Eq. 79 [41] - + y%Cd = AFI_interpE%Cd + (u%alpha - alphaE) * y%Cn + (AFI_interpE%Cd - BL_p%Cd0) * delta_c_df_primeprime ! Eq. 79 [41] if (AFInfo%ColCm == 0) then ! we don't have a cm column, so make everything 0 y%Cm = 0.0_ReKi else -! alphaF = x_in%x(3) / BL_p%c_lalpha + BL_p%alpha0 - y%Cm = AFI_interp%Cm + cn_circ * delta_c_mf_primeprime - 0.0_ReKi * piBy2 * Tu * u%omega - 0.25_ReKi*(1.0_ReKi - cos(pi * tV_ratio ))*x5 + tau_vl = t - OtherState%t_vortexBegin(i,j) + tau_vl = tau_vl / Tu ! make this non-dimensional (to compare with T_VL) + tV_ratio = min(1.5_ReKi, tau_vl/BL_p%T_VL) + + y%Cm = AFI_interpE%Cm + cn_circ * delta_c_mf_primeprime - 0.0_ReKi * piBy2 * TuOmega - 0.25_ReKi*(1.0_ReKi - cos(pi * tV_ratio ))*x5 end if + + else + call SetErrStat(ErrID_Fatal, "Programming error, UAMod continuous model not accounted for", ErrStat, ErrMsg, RoutineName) end if @@ -3245,7 +3699,7 @@ subroutine UA_CalcOutput( i, j, t, u_in, p, x, xd, OtherState, AFInfo, y, misc, call UA_BlendSteady(u, p, AFInfo, y, misc%FirstWarn_UA_off, misc%weight(i,j), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - else + elseif (p%UAMod == UA_Baseline .or. p%UAMod == UA_Gonzalez .or. p%UAMod == UA_MinnemaPierce) then ! --- CalcOutput Beddoes-Leishman type models M = u%U / p%a_s @@ -3322,12 +3776,12 @@ subroutine UA_CalcOutput( i, j, t, u_in, p, x, xd, OtherState, AFInfo, y, misc, ! convert cc and cn to cl and cd !............................. - y%Cl = y%Cn*cos(u%alpha) + y%Cc*sin(u%alpha) ! Eqn 1.2a - y%Cd = y%Cn*sin(u%alpha) - y%Cc*cos(u%alpha) + BL_p%Cd0 ! Eqn 1.2b + y%Cl = y%Cn*CosAlpha + y%Cc*SinAlpha ! Eqn 1.2a + y%Cd = y%Cn*SinAlpha - y%Cc*CosAlpha + BL_p%Cd0 ! Eqn 1.2b ! Make Cn and CC consistent with the added contribution of Cd0 in Cd: - y%Cn = y%Cl*cos(u%alpha) + y%Cd*sin(u%alpha) !Added the contribution of Cd0 in Cn and Cc - y%Cc = y%Cl*sin(u%alpha) - y%Cd*cos(u%alpha) + y%Cn = y%Cl*CosAlpha + y%Cd*SinAlpha !Added the contribution of Cd0 in Cn and Cc + y%Cc = y%Cl*SinAlpha - y%Cd*CosAlpha !............................. ! convert cm @@ -3393,11 +3847,22 @@ subroutine UA_CalcOutput( i, j, t, u_in, p, x, xd, OtherState, AFInfo, y, misc, call UA_BlendSteady(u, p, AFInfo, y, misc%FirstWarn_UA_off, misc%weight(i,j), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + else + call SetErrStat(ErrID_Fatal, "Programming error, UAMod not accounted for", ErrStat, ErrMsg, RoutineName) + end if ! Switch on UAMod + + if (p%UA_OUTS>0) then + if (allocated(y%WriteOutput)) then !bjj: because BEMT uses local variables for UA output, y%WriteOutput is not necessarially allocated. Need to figure out a better solution. + call CalcWriteOutputs() + endif + endif -#ifdef UA_OUTS - iOffset = (i-1)*p%NumOuts + (j-1)*p%nNodesPerBlade*p%NumOuts - if (allocated(y%WriteOutput)) then !bjj: because BEMT uses local variables for UA output, y%WriteOutput is not necessarially allocated. Need to figure out a better solution. +contains + + subroutine CalcWriteOutputs() + integer :: iOffset + iOffset = (i-1)*p%NumOuts + (j-1)*p%nNodesPerBlade*p%NumOuts y%WriteOutput(iOffset+ 1) = u%alpha*R2D y%WriteOutput(iOffset+ 2) = u%U @@ -3406,8 +3871,14 @@ subroutine UA_CalcOutput( i, j, t, u_in, p, x, xd, OtherState, AFInfo, y, misc, y%WriteOutput(iOffset+ 5) = y%Cl y%WriteOutput(iOffset+ 6) = y%Cd y%WriteOutput(iOffset+ 7) = y%Cm + + if (p%UAMod == UA_None) then + y%WriteOutput(iOffset+ 8) = u%omega*R2D + y%WriteOutput(iOffset+ 9) = alpha_34*R2D + y%WriteOutput(iOffset+10) = Tu + y%WriteOutput(iOffset+11) = alpha_34*R2D - if (p%UAMod == UA_HGM .or. p%UAMod == UA_HGMV .or. p%UAMod == UA_OYE) then + elseif (p%UAMod == UA_HGM .or. p%UAMod == UA_HGMV .or. p%UAMod == UA_OYE .or. p%UAMod == UA_HGMV360) then y%WriteOutput(iOffset+ 8) = u%omega*R2D y%WriteOutput(iOffset+ 9) = alphaE*R2D y%WriteOutput(iOffset+10) = Tu @@ -3425,6 +3896,9 @@ subroutine UA_CalcOutput( i, j, t, u_in, p, x, xd, OtherState, AFInfo, y, misc, if (p%UAMod == UA_HGMV) then y%WriteOutput(iOffset+21) = x_in%x(5) !x%element(i,j)%x(5) + else if (p%UAMod == UA_HGMV360) then + y%WriteOutput(iOffset+21) = x_in%x(6) !x%element(i,j)%x(6) + y%WriteOutput(iOffset+22) = x_in%x(7) !x%element(i,j)%x(7) end if elseif(p%UAMod == UA_BV) then @@ -3504,11 +3978,9 @@ subroutine UA_CalcOutput( i, j, t, u_in, p, x, xd, OtherState, AFInfo, y, misc, y%WriteOutput(iOffset+45) = KC%alpha_filt_cur*R2D end if - end if -#endif + end subroutine CalcWriteOutputs -contains - !> Calc Outputs for Boieng-Vertol dynamic stall + !> Calc Outputs for Boeing-Vertol dynamic stall !! See BV_DynStall.f95 of CACTUS, and [70], notations kept more or less consistent subroutine BV_CalcOutput() real(ReKi) :: alpha_50 @@ -3524,15 +3996,13 @@ subroutine BV_CalcOutput() call BV_getAlphas(i, j, u, p, xd, BL_p, AFInfo%RelThickness, alpha_34, alphaE_L, alphaLag_D, adotnorm) alphaE_D = BV_alphaE_D(adotnorm, alpha_34, alphaLag_D, BL_p, OtherState%activeD(i,j)) -#ifdef UA_OUTS ! --- Recompute variables, for temporary output to file only ! Calculate deltas to negative and positive stall angle (delN, and delP) - call BV_delNP(adotnorm, alpha_34, alphaLag_D, BL_p, OtherState%activeD(i,j), delN, delP) - call BV_getGammas(tc=AFInfo%RelThickness, umach=0.0_ReKi, gammaL=gammaL, gammaD=gammaD) - TransA = BV_TransA(BL_p) -#endif - - + if (p%UA_OUTS>0) then + call BV_delNP(adotnorm, alpha_34, alphaLag_D, BL_p, OtherState%activeD(i,j), delN, delP) + call BV_getGammas(tc=AFInfo%RelThickness, umach=0.0_ReKi, gammaL=gammaL, gammaD=gammaD) + TransA = BV_TransA(BL_p) + endif ! --- Cl, _, at effective angle of attack alphaE if (OtherState%activeL(i,j)) then @@ -3560,7 +4030,7 @@ subroutine BV_CalcOutput() Cm25_stat = AFI_interp%Cm endif ! Static coeffs at 1/2 chord (alpha_50) - alpha_50 = Get_Alpha24(u%v_ac, u%omega, 0.25_ReKi*p%c(i,j)) + alpha_50 = Get_Alpha24(u%v_ac, u%omega, (p%d_34_to_ac-0.25)*p%c(i,j)) ! NOTE: d_24_to_ac = (d_34_to_ac - 1/4) call AFI_ComputeAirfoilCoefs(alpha_50, u%Re, u%UserProp, AFInfo, AFI_interp, ErrStat2, ErrMsg2); call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) Cl50_stat = AFI_interp%Cl ! Static coeffs at 3/4 chord (alpha_34) @@ -3569,8 +4039,8 @@ subroutine BV_CalcOutput() y%Cm = Cm25_stat + cos(alpha_50) * (Cl75_stat - Cl50_stat)*0.25_ReKi ! TODO projection using alpha 5 and back for added mass - !y%Cn = y%Cl*cos(u%alpha) + y%Cd*sin(u%alpha) - !y%Cc = y%Cl*sin(u%alpha) - y%Cd*cos(u%alpha) + !y%Cn = y%Cl*CosAlpha + y%Cd*SinAlpha + !y%Cc = y%Cl*SinAlpha - y%Cd*CosAlpha y%Cn = y%Cl*cos(alpha_50) + y%Cd*sin(alpha_50) y%Cc = y%Cl*sin(alpha_50) - y%Cd*cos(alpha_50) @@ -3597,8 +4067,7 @@ subroutine UA_WriteOutputToFile(t, p, y) integer :: k ! Generate file outputs -#ifdef UA_OUTS - if (p%unOutFile > 0 .and. allocated(y%WriteOutput)) then + if (p%UA_OUTS==2 .and. p%unOutFile > 0 .and. allocated(y%WriteOutput)) then write (p%unOutFile,"(F19.6)",ADVANCE='no') t do k=1,size(y%WriteOutput) @@ -3607,10 +4076,10 @@ subroutine UA_WriteOutputToFile(t, p, y) WRITE (p%unOutFile,'()') ! write the line return end if -#endif end subroutine UA_WriteOutputToFile !============================================================================== +! TODO Somehow merge this content with the unsteady aero driver summary file? subroutine UA_WriteAFIParamsToFile(InitInp, AFInfo, ErrStat, ErrMsg) type(AFI_ParameterType), intent(in ) :: AFInfo(:) ! The airfoil parameter data (for all airfoils) type(UA_InitInputType), intent(in ) :: InitInp ! input data for initialization routine @@ -3619,171 +4088,18 @@ subroutine UA_WriteAFIParamsToFile(InitInp, AFInfo, ErrStat, ErrMsg) character(*), intent( out) :: ErrMsg ! Error message if ErrStat /= ErrID_None integer :: k - integer(IntKi) :: i integer(IntKi) :: unOutFile - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'UA_WriteAFIParamsToFile' character(*), parameter :: delim = ' ' - integer, parameter :: MaxLen = 16 - integer, parameter :: NumChans = 49 - character(MaxLen) :: ChanName( NumChans) - character(MaxLen) :: ChanUnit( NumChans) - real(ReKi) :: TmpValues(NumChans) - character(3) :: MaxLenStr - character(80) :: Fmt - - MaxLenStr = trim(num2lstr(MaxLen)) - - i=1 - ChanName(i) = 'AirfoilNumber'; ChanUnit(i) = '(-)'; i = i+1; - ChanName(i) = 'TableNumber'; ChanUnit(i) = '(-)'; i = i+1; - ChanName(i) = 'alpha0'; ChanUnit(i) = '(deg)'; i = i+1; - ChanName(i) = 'alpha1'; ChanUnit(i) = '(deg)'; i = i+1; - ChanName(i) = 'alpha2'; ChanUnit(i) = '(deg)'; i = i+1; - ChanName(i) = 'eta_e'; ChanUnit(i) = '(-)'; i = i+1; - ChanName(i) = 'C_nalpha'; ChanUnit(i) = '(-/rad)'; i = i+1; - ChanName(i) = 'C_lalpha'; ChanUnit(i) = '(-/rad)'; i = i+1; - ChanName(i) = 'T_f0'; ChanUnit(i) = '(-)'; i = i+1; - ChanName(i) = 'T_V0'; ChanUnit(i) = '(-)'; i = i+1; - ChanName(i) = 'T_p'; ChanUnit(i) = '(-)'; i = i+1; - ChanName(i) = 'T_VL'; ChanUnit(i) = '(-)'; i = i+1; - ChanName(i) = 'b1'; ChanUnit(i) = '(-)'; i = i+1; - ChanName(i) = 'b2'; ChanUnit(i) = '(-)'; i = i+1; - ChanName(i) = 'b5'; ChanUnit(i) = '(-)'; i = i+1; - ChanName(i) = 'A1'; ChanUnit(i) = '(-)'; i = i+1; - ChanName(i) = 'A2'; ChanUnit(i) = '(-)'; i = i+1; - ChanName(i) = 'A5'; ChanUnit(i) = '(-)'; i = i+1; - ChanName(i) = 'S1'; ChanUnit(i) = '(-)'; i = i+1; - ChanName(i) = 'S2'; ChanUnit(i) = '(-)'; i = i+1; - ChanName(i) = 'S3'; ChanUnit(i) = '(-)'; i = i+1; - ChanName(i) = 'S4'; ChanUnit(i) = '(-)'; i = i+1; - ChanName(i) = 'Cn1'; ChanUnit(i) = '(-)'; i = i+1; - ChanName(i) = 'Cn2'; ChanUnit(i) = '(-)'; i = i+1; - ChanName(i) = 'St_sh'; ChanUnit(i) = '(-)'; i = i+1; - ChanName(i) = 'Cd0'; ChanUnit(i) = '(-)'; i = i+1; - ChanName(i) = 'Cm0'; ChanUnit(i) = '(-)'; i = i+1; - ChanName(i) = 'k0'; ChanUnit(i) = '(-)'; i = i+1; - ChanName(i) = 'k1'; ChanUnit(i) = '(-)'; i = i+1; - ChanName(i) = 'k2'; ChanUnit(i) = '(-)'; i = i+1; - ChanName(i) = 'k3'; ChanUnit(i) = '(-)'; i = i+1; - ChanName(i) = 'k1_hat'; ChanUnit(i) = '(-)'; i = i+1; - ChanName(i) = 'x_cp_bar'; ChanUnit(i) = '(-)'; i = i+1; - ChanName(i) = 'UACutout'; ChanUnit(i) = '(deg)'; i = i+1; - ChanName(i) = 'UACutout_delta'; ChanUnit(i) = '(deg)'; i = i+1; - ChanName(i) = 'UACutout_blend'; ChanUnit(i) = '(deg)'; i = i+1; - ChanName(i) = 'filtCutOff'; ChanUnit(i) = '(-)'; i = i+1; - ChanName(i) = 'alphaLowerWrap'; ChanUnit(i) = '(deg)'; i = i+1; - ChanName(i) = 'alphaLower'; ChanUnit(i) = '(deg)'; i = i+1; - ChanName(i) = 'alphaUpper'; ChanUnit(i) = '(deg)'; i = i+1; - ChanName(i) = 'alphaUpperWrap'; ChanUnit(i) = '(deg)'; i = i+1; - ChanName(i) = 'c_alphaLowerWrap'; ChanUnit(i) = '(-)'; i = i+1; - ChanName(i) = 'c_alphaLower'; ChanUnit(i) = '(-)'; i = i+1; - ChanName(i) = 'c_alphaUpper'; ChanUnit(i) = '(-)'; i = i+1; - ChanName(i) = 'c_alphaUpperWrap'; ChanUnit(i) = '(-)'; i = i+1; - ChanName(i) = 'c_RateWrap'; ChanUnit(i) = '(-/rad)'; i = i+1; - ChanName(i) = 'c_RateLower'; ChanUnit(i) = '(-/rad)'; i = i+1; - ChanName(i) = 'c_Rate'; ChanUnit(i) = '(-/rad)'; i = i+1; - ChanName(i) = 'c_RateUpper'; ChanUnit(i) = '(-/rad)'; i = i+1; - - !$OMP critical(filename) - CALL GetNewUnit( unOutFile, ErrStat, ErrMsg ) - if (ErrStat < AbortErrLev) then - CALL OpenFOutFile ( unOutFile, trim(InitInp%OutRootName)//'.UA.sum', ErrStat2, ErrMsg2 ) - endif - !$OMP end critical(filename) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - - - ! Generate file outputs - - write (unOutFile,'(/,A)') 'Predictions were generated on '//CurDate()//' at '//CurTime() !//' using '//trim(GetNVD(version)) - write (unOutFile,'(1X,A)') trim(ProgName) - write (unOutFile,'()' ) !print a blank line - write (unOutFile,'()' ) !print a blank line - write (unOutFile,'()' ) !print a blank line - - - !...................................................... - ! Write the names of the output parameters on one line: - !...................................................... - call WrFileNR ( unOutFile, ChanName(1) ) - do i=2,size(ChanName) - call WrFileNR ( unOutFile, delim//ChanName(i) ) - end do - write (unOutFile,'()') - - !...................................................... - ! Write the units of the output parameters on one line: - !...................................................... - call WrFileNR ( unOutFile, ChanUnit(1) ) - do i=2,size(ChanName) - call WrFileNR ( unOutFile, delim//ChanUnit(i) ) - end do - write (unOutFile,'()') - - TmpValues = 0.0_ReKi ! initialize in case UAdata is not included in the airfoil table + call AFI_WrHeader(delim, trim(InitInp%OutRootName)//'.sum', unOutFile, ErrStat, ErrMsg) + if (ErrStat >= AbortErrLev) return + !...................................................... ! Write the data for each table in each file !...................................................... - Fmt = '(I'//MaxLenStr//',"'//delim//'",I'//MaxLenStr//','//trim(num2lstr(NumChans))//'("'//delim//'",F'//MaxLenStr//'.5))' do k=1,size(AFInfo) - do i=1,size(AFInfo(k)%Table) - IF (AFInfo(k)%Table(i)%InclUAdata) then - WRITE(unOutFile, Fmt) k, i, & - AFInfo(k)%Table(i)%UA_BL%alpha0*R2D , & - AFInfo(k)%Table(i)%UA_BL%alpha1*R2D , & - AFInfo(k)%Table(i)%UA_BL%alpha2*R2D , & - AFInfo(k)%Table(i)%UA_BL%eta_e , & - AFInfo(k)%Table(i)%UA_BL%C_nalpha , & - AFInfo(k)%Table(i)%UA_BL%C_lalpha , & - AFInfo(k)%Table(i)%UA_BL%T_f0 , & - AFInfo(k)%Table(i)%UA_BL%T_V0 , & - AFInfo(k)%Table(i)%UA_BL%T_p , & - AFInfo(k)%Table(i)%UA_BL%T_VL , & - AFInfo(k)%Table(i)%UA_BL%b1 , & - AFInfo(k)%Table(i)%UA_BL%b2 , & - AFInfo(k)%Table(i)%UA_BL%b5 , & - AFInfo(k)%Table(i)%UA_BL%A1 , & - AFInfo(k)%Table(i)%UA_BL%A2 , & - AFInfo(k)%Table(i)%UA_BL%A5 , & - AFInfo(k)%Table(i)%UA_BL%S1 , & - AFInfo(k)%Table(i)%UA_BL%S2 , & - AFInfo(k)%Table(i)%UA_BL%S3 , & - AFInfo(k)%Table(i)%UA_BL%S4 , & - AFInfo(k)%Table(i)%UA_BL%Cn1 , & - AFInfo(k)%Table(i)%UA_BL%Cn2 , & - AFInfo(k)%Table(i)%UA_BL%St_sh , & - AFInfo(k)%Table(i)%UA_BL%Cd0 , & - AFInfo(k)%Table(i)%UA_BL%Cm0 , & - AFInfo(k)%Table(i)%UA_BL%k0 , & - AFInfo(k)%Table(i)%UA_BL%k1 , & - AFInfo(k)%Table(i)%UA_BL%k2 , & - AFInfo(k)%Table(i)%UA_BL%k3 , & - AFInfo(k)%Table(i)%UA_BL%k1_hat , & - AFInfo(k)%Table(i)%UA_BL%x_cp_bar , & - AFInfo(k)%Table(i)%UA_BL%UACutout*R2D , & - AFInfo(k)%Table(i)%UA_BL%UACutout_delta*R2D, & - AFInfo(k)%Table(i)%UA_BL%UACutout_blend*R2D, & - AFInfo(k)%Table(i)%UA_BL%filtCutOff , & - AFInfo(k)%Table(i)%UA_BL%alphaLowerWrap*R2D, & - AFInfo(k)%Table(i)%UA_BL%alphaLower*R2D , & - AFInfo(k)%Table(i)%UA_BL%alphaUpper*R2D , & - AFInfo(k)%Table(i)%UA_BL%alphaUpperWrap*R2D, & - AFInfo(k)%Table(i)%UA_BL%c_alphaLowerWrap , & - AFInfo(k)%Table(i)%UA_BL%c_alphaLower , & - AFInfo(k)%Table(i)%UA_BL%c_alphaUpper , & - AFInfo(k)%Table(i)%UA_BL%c_alphaUpperWrap , & - AFInfo(k)%Table(i)%UA_BL%c_RateWrap , & - AFInfo(k)%Table(i)%UA_BL%c_RateLower , & - AFInfo(k)%Table(i)%UA_BL%c_Rate , & - AFInfo(k)%Table(i)%UA_BL%c_RateUpper - ELSE - WRITE(unOutFile, Fmt) k, i, TmpValues(3:) - END IF - end do + call AFI_WrData(k, unOutFile, delim, AFInfo(k)) end do close(unOutFile) diff --git a/modules/aerodyn/src/UnsteadyAero_Driver.f90 b/modules/aerodyn/src/UnsteadyAero_Driver.f90 index 1ffac32865..f04e4391b7 100644 --- a/modules/aerodyn/src/UnsteadyAero_Driver.f90 +++ b/modules/aerodyn/src/UnsteadyAero_Driver.f90 @@ -19,10 +19,6 @@ ! limitations under the License. ! !********************************************************************************************************************************** - - - - program UnsteadyAero_Driver use NWTC_Library @@ -31,45 +27,24 @@ program UnsteadyAero_Driver use UnsteadyAero_Types use UnsteadyAero use UA_Dvr_Subs - USE VersionInfo + use VersionInfo - implicit none + use LinDyn - - - - + implicit none ! Variables - integer(IntKi), parameter :: NumInp = 2 ! Number of inputs sent to UA_UpdateStates (must be at least 2) - real(DbKi) :: dt, t, uTimes(NumInp) + real(DbKi) :: t, tnext integer :: i, j, n, iu - type(UA_InitInputType) :: InitInData ! Input data for initialization - type(UA_InitOutputType) :: InitOutData ! Output data from initialization - type(UA_ContinuousStateType) :: x ! Continuous states - type(UA_DiscreteStateType) :: xd ! Discrete states - type(UA_OtherStateType) :: OtherState ! Other/optimization states - type(UA_MiscVarType) :: m ! Misc/optimization variables - type(UA_ParameterType) :: p ! Parameters - type(UA_InputType) :: u(NumInp) ! System inputs - type(UA_OutputType) :: y ! System outputs + + ! --- All Data + type(Dvr_Data) :: dvr + integer(IntKi) :: ErrStat ! Status of error message character(ErrMsgLen) :: ErrMsg ! Error message if ErrStat /= ErrID_None - integer, parameter :: NumAFfiles = 1 - character(1024) :: afNames(NumAFfiles) - type(AFI_ParameterType) :: AFI_Params(NumAFfiles) - integer, allocatable :: AFIndx(:,:) CHARACTER(1024) :: dvrFilename ! Filename and path for the driver input file. This is passed in as a command line argument when running the Driver exe. - TYPE(UA_Dvr_InitInput) :: dvrInitInp ! Initialization data for the driver program - real(DbKi) :: simTime - integer :: nSimSteps character(*), parameter :: RoutineName = 'UnsteadyAero_Driver' - real(DbKi), allocatable :: timeArr(:) - real(ReKi), allocatable :: AOAarr(:) - real(ReKi), allocatable :: Uarr(:) - real(ReKi), allocatable :: OmegaArr(:) - logical :: UA_f_cn ! Should the separation function be computed using Cn or Cl CHARACTER(200) :: git_commit TYPE(ProgDesc), PARAMETER :: version = ProgDesc( 'UnsteadyAero Driver', '', '' ) ! The version number of this program. @@ -80,189 +55,230 @@ program UnsteadyAero_Driver ErrMsg = '' ErrStat = ErrID_None - ! 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 ) + CALL WrScr(' Running '//TRIM( version%Name )//' a part of OpenFAST - '//TRIM(git_Commit)) - ! Parse the driver file if one was provided, if not, then set driver parameters using hardcoded values + ! --- Parse the driver file if one if ( command_argument_count() > 1 ) then call print_help() - call checkError() - end if - - - ! Establish initialization inputs which are fixed for the stand-alone driver, but would be - ! variable for a coupled simulation - InitInData%nNodesPerBlade = 1 - InitInData%numBlades = 1 - - ! Set up initialization data - allocate(AFIndx(InitInData%nNodesPerBlade,InitInData%numBlades), STAT = ErrStat) - if ( ErrStat /= 0 ) then - call SetErrStat( ErrID_Fatal, 'Error trying to allocate InitInData%AFIndx.', ErrStat, ErrMsg, RoutineName) - call checkError() - end if - - allocate(InitInData%c(InitInData%nNodesPerBlade,InitInData%numBlades), STAT = ErrStat) - if ( ErrStat /= 0 ) then - call SetErrStat( ErrID_Fatal, 'Error trying to allocate InitInData%c.', ErrStat, ErrMsg, RoutineName) - call checkError() - end if - - allocate( InitInData%UAOff_innerNode(InitInData%numBlades), InitInData%UAOff_outerNode(InitInData%numBlades), STAT = ErrStat) - if ( ErrStat /= 0 ) then - call SetErrStat( ErrID_Fatal, 'Error trying to allocate UAOff_innerNode and UAOff_outerNode.', ErrStat, ErrMsg, RoutineName) - call checkError() - end if - ! don't turn off UA based on span location: - InitInData%UAOff_innerNode = 0 - InitInData%UAOff_outerNode = InitInData%nNodesPerBlade + 1 - - ! Parse the driver input file and run the simulation based on that file - - if ( command_argument_count() == 1 ) then - - call get_command_argument(1, dvrFilename) - call ReadDriverInputFile( dvrFilename, dvrInitInp, errStat, errMsg ) - call checkError() - InitInData%a_s = dvrInitInp%SpdSound - InitInData%c(1,1) = dvrInitInp%Chord - InitInData%UAMod = dvrInitInp%UAMod - InitInData%Flookup = dvrInitInp%Flookup - - else - - dvrInitInp%OutRootName = './TestingUA_Driver' - InitInData%UAMod = 1 - InitInData%Flookup = .FALSE. - InitInData%a_s = 340.29 ! m/s - InitInData%c(1,1) = 1.0 - - dvrInitInp%InflowVel = 30.0 ! m/s - dvrInitInp%Re = 75 ! million - dvrInitInp%AirFoil1 = './OSU075_FAST.txt' - dvrInitInp%SimMod = 1 - dvrInitInp%NCycles = 3.0 - dvrInitInp%Frequency = 1.2 ! Hz - dvrInitInp%StepsPerCycle= 180 - dvrInitInp%Amplitude = 10.0 ! deg - dvrInitInp%Mean = 2.0 ! deg - dvrInitInp%Phase = 0 ! steps of a cycle - dvrInitInp%InputsFile = '' - - end if - InitInData%OutRootName = dvrInitInp%OutRootName - - InitInData%WrSum = dvrInitInp%SumPrint ! write all the AFI data + call NormStop() + endif + call get_command_argument(1, dvrFilename) + call ReadDriverInputFile( dvrFilename, dvr%p, errStat, errMsg ); call checkError() - - if ( dvrInitInp%SimMod == 1 ) then - ! Using the frequency and NCycles, determine how long the simulation needs to run - simTime = dvrInitInp%NCycles/dvrInitInp%Frequency - nSimSteps = dvrInitInp%StepsPerCycle*dvrInitInp%NCycles ! we could add 1 here to make this a complete cycle - dt = simTime / nSimSteps - - else - ! Read time-series data file with a 1 line header and then each row contains time-step data with 4, white-space-separated columns - ! time, Angle-of-attack, Vrel, omega - call ReadTimeSeriesData( dvrInitInp%InputsFile, nSimSteps, timeArr, AOAarr, Uarr, OmegaArr, errStat, errMsg ) - call checkError() - dt = (timeArr(nSimSteps) - timeArr(1)) / (nSimSteps-1) - nSimSteps = nSimSteps-NumInp + 1 - - end if - - ! Initialize the Airfoil Info Params - afNames(1) = dvrInitInp%AirFoil1 ! All nodes/blades are using the same 2D airfoil - AFIndx(1,1) = 1 - UA_f_cn = (InitInData%UAMod /= UA_HGM).and.(InitInData%UAMod /= UA_OYE) ! HGM and OYE use the separation function based on cl instead of cn - call Init_AFI( InitInData%UAMod, NumAFfiles, afNames, dvrInitInp%UseCm, UA_f_cn, AFI_Params, errStat, errMsg ) - call checkError() + ! --- Driver Parameters + call Dvr_SetParameters(dvr%p, errStat, errMsg); call checkError() - if (dvrInitInp%WrAFITables) then - call WriteAFITables(AFI_Params(1), dvrInitInp%OutRootName, dvrInitInp%UseCm, UA_f_cn) - endif - - - ! Initialize UnsteadyAero (after AFI) - call UA_Init( InitInData, u(1), p, x, xd, OtherState, y, m, dt, AFI_Params, AFIndx, InitOutData, errStat, errMsg ) - call checkError() + ! --- Initialize Elastic Section + if ( dvr%p%SimMod == 3 ) then + call LD_InitInputData(3, dvr%LD_InitInData, errStat, errMsg); call checkError() + dvr%LD_InitInData%dt = dvr%p%dt + dvr%LD_InitInData%IntMethod = 1 ! 1=RK4, TODO expose to user + dvr%LD_InitInData%prefix = '' ! for output channel names + dvr%LD_InitInData%MM = dvr%p%MM + dvr%LD_InitInData%CC = dvr%p%CC + dvr%LD_InitInData%KK = dvr%p%KK + dvr%LD_InitInData%x0 = dvr%p%initPos + dvr%LD_InitInData%xd0 = dvr%p%initVel + dvr%LD_InitInData%activeDOFs = dvr%p%activeDOFs + dvr%LD_InitInData%DOFsNames = (/'x ','y ','th '/) + dvr%LD_InitInData%DOFsUnits = (/'m ','m ','rad'/) + if (dvr%p%MotionMod==MotionMod_File) then + dvr%LD_InitInData%PrescribedMotionFile = dvr%p%MotionTSFile + else + dvr%LD_InitInData%PrescribedMotionFile = '' + endif + call LD_Init(dvr%LD_InitInData, dvr%LD_u(1), dvr%LD_p, dvr%LD_x, dvr%LD_xd, dvr%LD_z, dvr%LD_OtherState, dvr%LD_y, dvr%LD_m, dvr%LD_InitOutData, errStat, errMsg); call checkError() + ! Allocate other inputs of LD + do iu = 2,NumInp + call AllocAry(dvr%LD_u(iu)%Fext, dvr%LD_p%nx, 'Fext', errStat, errMsg); call checkError() + enddo + end if + ! --- Init UA input data based on driver inputs + call driverInputsToUAInitData(dvr%p, dvr%UA_InitInData, dvr%AFI_Params, dvr%AFIndx, errStat, errMsg); call checkError() - if (p%NumOuts <= 0) then - ErrStat = ErrID_Fatal - ErrMsg = "No outputs have been selected. Rebuild the executable with -DUA_OUTS" + ! --- Initialize UnsteadyAero (need AFI) + call UA_Init( dvr%UA_InitInData, dvr%UA_u(1), dvr%UA_p, dvr%UA_x, dvr%UA_xd, dvr%UA_OtherState, dvr%UA_y, dvr%UA_m, dvr%p%dt, dvr%AFI_Params, dvr%AFIndx, dvr%UA_InitOutData, errStat, errMsg ); call checkError() + if (dvr%UA_p%NumOuts <= 0) then + ErrStat = ErrID_Warn + ErrMsg = "No outputs from UA are generated." call checkError() end if - ! set inputs: + ! --- Driver Outputs + dvr%out%Root = dvr%p%OutRootName + call Dvr_InitializeDriverOutputs(dvr, dvr%out, errStat, errMsg); call checkError() + + i = 1 ! nodes per blade + j = 1 ! number of blades + ! --- Initialize Inputs !u(1) = time at n=1 (t= 0) !u(2) = time at n=0 (t= -dt) !u(3) = time at n=-1 (t= -2dt) if NumInp > 2 + if ( dvr%p%SimMod == 3 ) then + ! General inputs + do iu = 1, NumInp !u(NumInp) is overwritten in time-sim loop, so no need to init here + dvr%uTimes(iu) = (2-iu-1)*dvr%p%dt + enddo + ! Inflow "inputs" + do iu = 1,NumInp + call setInflow(t=dvr%uTimes(iu), p=dvr%p, m=dvr%m, U0=dvr%U0(iu,:)) + enddo + ! UA inputs at t=0, stored in u(1) + do iu = 1, NumInp-1 !u(NumInp) is overwritten in time-sim loop, so no need to init here + call setUAinputs(dvr%U0(iu,:), dvr%LD_x, dvr%p, dvr%m, dvr%UA_u(iu)) + enddo + ! LD inputs + do iu = 1, NumInp-1 !u(NumInp) is overwritten in time-sim loop, so no need to init here + call UA_CalcOutput(i, j, dvr%uTimes(iu), dvr%UA_u(iu), dvr%UA_p, dvr%UA_x, dvr%UA_xd, dvr%UA_OtherState, dvr%AFI_Params(dvr%AFIndx(i,j)), dvr%UA_y, dvr%UA_m, errStat, errMsg ); call checkError() + call setLDinputs(dvr%U0(iu,:), dvr%LD_x, dvr%UA_y, dvr%p, dvr%m, dvr%LD_u(iu)) + enddo - DO iu = 1, NumInp-1 !u(NumInp) is overwritten in time-sim loop, so no need to init here - call setUAinputs(2-iu, u(iu), uTimes(iu), dt, dvrInitInp, timeArr, AOAarr, Uarr, OmegaArr, errStat, errMsg) - call checkError() - END DO - - ! Set inputs which do not vary with node or time + else + ! UA inputs at t=0, stored in u(1) + do iu = 1, NumInp-1 !u(NumInp) is overwritten in time-sim loop, so no need to init here + call setUAinputsAlphaSim(2-iu, dvr%UA_u(iu), dvr%uTimes(iu), dvr%p, dvr%m, errStat, errMsg); call checkError() + end do + endif - ! time marching loop - do n = 1, nSimSteps + ! --- Time marching loop + call Dvr_InitializeOutputs(dvr%out, dvr%p%numSteps, errStat, errMsg) - i = 1 ! nodes per blade - j = 1 ! number of blades - - ! set inputs: - DO iu = NumInp-1, 1, -1 - u( iu+1) = u( iu) - uTimes(iu+1) = uTimes(iu) - END DO - - ! first value of uTimes/u contain inputs at t+dt - call setUAinputs(n+1, u(1), uTimes(1), dt, dvrInitInp, timeArr, AOAarr, Uarr, OmegaArr, errStat, errMsg) - call checkError() - - t = uTimes(2) + if ( dvr%p%SimMod == 3 ) then + + ! --- Time marching loop + call WrScr(' Aeroelastic simulation - TMax = '//trim(num2lstr(dvr%p%numSteps*dvr%p%dt))) + do n = 1, dvr%p%numSteps + ! --- Set inputs at t by storing in u(2) what was in u(1) at previous time step + !u(1) = time at n=n+1 (t=t+dt) + !u(2) = time at n=n (t=t ) + do iu = NumInp-1, 1, -1 + dvr%uTimes(iu+1) = dvr%uTimes(iu) + dvr%U0( iu+1,:)= dvr%U0(iu,:) + dvr%UA_u( iu+1) = dvr%UA_u( iu) + dvr%LD_u( iu+1) = dvr%LD_u( iu) + end do + + ! ---------------------------------------------------------------------------- + ! --- t + ! ---------------------------------------------------------------------------- + iu = 2 ! Index 2 is t + dvr%uTimes(iu) = (n -1)*dvr%p%dt ! t + t = dvr%uTimes(iu) ! t(2)= t + ! --- Calc Outputs at t ! Use existing states to compute the outputs - call UA_CalcOutput(i, j, t, u(2), p, x, xd, OtherState, AFI_Params(AFIndx(i,j)), y, m, errStat, errMsg ) - call checkError() - + call UA_CalcOutput(i, j, t, dvr%UA_u(iu), dvr%UA_p, dvr%UA_x, dvr%UA_xd, dvr%UA_OtherState, dvr%AFI_Params(dvr%AFIndx(i,j)), dvr%UA_y, dvr%UA_m, errStat, errMsg ); call checkError() + ! "True" force based on UA outputs - Also compute Misc outputs + !call AeroKinetics(dvr%U0(iu,:), dvr%LD_x%q(1:3), dvr%LD_x%q(4:6), (/dvr%UA_y%Cl, dvr%UA_y%Cd, dvr%UA_y%Cm/), dvr%p, dvr%m) + call setLDinputs(dvr%U0(iu,:), dvr%LD_x, dvr%UA_y, dvr%p, dvr%m, dvr%LD_u(iu)) + ! Use existing states to compute the outputs + call LD_CalcOutput(t, dvr%LD_u(iu), dvr%LD_p, dvr%LD_x, dvr%LD_xd, dvr%LD_z, dvr%LD_OtherState, dvr%LD_y, dvr%LD_m, errStat, errMsg); call checkError() ! Generate file outputs - call UA_WriteOutputToFile(t, p, y) + call UA_WriteOutputToFile(t, dvr%UA_p, dvr%UA_y) + ! Write/Store outputs + call Dvr_WriteOutputs(n, t, dvr, dvr%out, errStat, errMsg); call checkError() - - ! Prepare states for next time step - call UA_UpdateStates(i, j, t, n, u, uTimes, p, x, xd, OtherState, AFI_Params(AFIndx(i,j)), m, errStat, errMsg ) - call checkError() + ! Backup at t - if iteration needed + !call backupStates() + ! ---------------------------------------------------------------------------- + ! --- From t to t+dt + ! ---------------------------------------------------------------------------- + iu = 1 ! Index 1 is t+dt + dvr%uTimes(iu) = (n+1-1)*dvr%p%dt ! t+dt + tnext = dvr%uTimes(iu) ! t(2)= t+dt + ! --- Set inputs at t+dt in u(1) + ! Inflow inputs + call setInflow(t=tnext, p=dvr%p, m=dvr%m, U0=dvr%U0(iu,:)) + ! LinDyn inputs at t+dt + call LD_Input_ExtrapInterp(dvr%LD_u(:), dvr%uTimes(:), dvr%LD_u(iu), tnext, errStat, errMsg); call checkError() + + ! --- Integrate LinDyn from t to t+dt + call LD_UpdateStates(t, n, dvr%LD_u, dvr%uTimes, dvr%LD_p, dvr%LD_x, dvr%LD_xd, dvr%LD_z, dvr%LD_OtherState, dvr%LD_m, errStat, errMsg); call checkError() + ! Calc LinDyn outputs at t+dt + call LD_CalcOutput(t, dvr%LD_u(iu), dvr%LD_p, dvr%LD_x, dvr%LD_xd, dvr%LD_z, dvr%LD_OtherState, dvr%LD_y, dvr%LD_m, errStat, errMsg); call checkError() + + ! --- Set UA Inputs at t+dt + call setUAinputs(dvr%U0(iu,:), dvr%LD_x, dvr%p, dvr%m, dvr%UA_u(iu)) + + ! --- Integrate UA from t to t+dt + call UA_UpdateStates(i, j, t, n, dvr%UA_u, dvr%uTimes, dvr%UA_p, dvr%UA_x, dvr%UA_xd, dvr%UA_OtherState, dvr%AFI_Params(dvr%AFIndx(i,j)), dvr%UA_m, errStat, errMsg ); call checkError() + + ! --- One extra iteration with better LD inputs at t+dt + !call UA_CalcOutput(i, j, tnext, dvr%UA_u(iu), dvr%UA_p, dvr%UA_x, dvr%UA_xd, dvr%UA_OtherState, dvr%AFI_Params(dvr%AFIndx(i,j)), dvr%UA_y, dvr%UA_m, errStat, errMsg ); call checkError() + !call setLDinputs(dvr%U0(iu,:), dvr%LD_x, dvr%UA_y, dvr%p, dvr%m, dvr%LD_u(iu)) + !call restoreLDStates() + !call LD_UpdateStates(t, n, dvr%LD_u, dvr%uTimes, dvr%LD_p, dvr%LD_x, dvr%LD_xd, dvr%LD_z, dvr%LD_OtherState, dvr%LD_m, errStat, errMsg); call checkError() + !call LD_CalcOutput(tnext, dvr%LD_u(iu), dvr%LD_p, dvr%LD_x, dvr%LD_xd, dvr%LD_z, dvr%LD_OtherState, dvr%LD_y, dvr%LD_m, errStat, errMsg); call checkError() + !call setUAinputs(dvr%U0(iu,:), dvr%LD_x, dvr%p, dvr%m, dvr%UA_u(iu)) + !call restoreUAStates() + !call UA_UpdateStates(i, j, t, n, dvr%UA_u, dvr%uTimes, dvr%UA_p, dvr%UA_x, dvr%UA_xd, dvr%UA_OtherState, dvr%AFI_Params(dvr%AFIndx(i,j)), dvr%UA_m, errStat, errMsg ); call checkError() + end do + + else + ! --- Time marching loop + call WrScr(' UA time simulation - TMax = '//trim(num2lstr(dvr%p%numSteps*dvr%p%dt))) + do n = 1, dvr%p%numSteps + + ! --- Set inputs at t by storing in u(2) what was in u(1) at previous time step + !u(1) = time at n=n+1 (t=t+dt) + !u(2) = time at n=n (t=t ) + do iu = NumInp-1, 1, -1 + dvr%UA_u( iu+1) = dvr%UA_u( iu) + dvr%uTimes(iu+1) = dvr%uTimes(iu) + end do + + ! first value of uTimes/u contain inputs at t+dt + call setUAinputsAlphaSim(n+1, dvr%UA_u(1), dvr%uTimes(1), dvr%p, dvr%m, errStat, errMsg); call checkError() + + t = dvr%uTimes(2) + + ! Use existing states to compute the outputs + call UA_CalcOutput(i, j, t, dvr%UA_u(2), dvr%UA_p, dvr%UA_x, dvr%UA_xd, dvr%UA_OtherState, dvr%AFI_Params(dvr%AFIndx(i,j)), dvr%UA_y, dvr%UA_m, errStat, errMsg ); call checkError() - - end do - - - !------------------------------------------------------------------------------------------------- - ! Close our output file - !------------------------------------------------------------------------------------------------- + ! Generate file outputs + call UA_WriteOutputToFile(t, dvr%UA_p, dvr%UA_y) + ! Write/Store outputs + call Dvr_WriteOutputs(n, t, dvr, dvr%out, errStat, errMsg); call checkError() + + ! Prepare states for next time step + call UA_UpdateStates(i, j, t, n, dvr%UA_u, dvr%uTimes, dvr%UA_p, dvr%UA_x, dvr%UA_xd, dvr%UA_OtherState, dvr%AFI_Params(dvr%AFIndx(i,j)), dvr%UA_m, errStat, errMsg ); call checkError() + + end do + endif + call Dvr_EndSim(dvr, errStat, errMsg) + ! --- Exit call Cleanup() call NormStop() - - contains - + +contains + subroutine backupStates() + call UA_CopyContState (dvr%UA_x , dvr%UA_x_swp , MESH_UPDATECOPY , errStat , errMsg) + call UA_CopyDiscState (dvr%UA_xd , dvr%UA_xd_swp , MESH_UPDATECOPY , errStat , errMsg) + call UA_CopyOtherState(dvr%UA_OtherState , dvr%UA_OtherState_swp , MESH_UPDATECOPY , errStat , errMsg) + call LD_CopyContState (dvr%LD_x , dvr%LD_x_swp , MESH_UPDATECOPY , errStat , errMsg) + call LD_CopyOtherState(dvr%LD_OtherState , dvr%LD_OtherState_swp , MESH_UPDATECOPY , errStat , errMsg) + end subroutine + subroutine restoreUAStates() + call UA_CopyContState (dvr%UA_x_swp , dvr%UA_x , MESH_UPDATECOPY , errStat , errMsg) + call UA_CopyDiscState (dvr%UA_xd_swp , dvr%UA_xd , MESH_UPDATECOPY , errStat , errMsg) + call UA_CopyOtherState(dvr%UA_OtherState_swp, dvr%UA_OtherState , MESH_UPDATECOPY , errStat , errMsg) + end subroutine + subroutine restoreLDStates() + call LD_CopyContState (dvr%LD_x_swp , dvr%LD_x , MESH_UPDATECOPY , errStat , errMsg) + call LD_CopyOtherState(dvr%LD_OtherState_swp, dvr%LD_OtherState , MESH_UPDATECOPY , errStat , errMsg) + end subroutine !==================================================================================================== subroutine Cleanup() - ! The routine cleans up the module echo file and resets the NWTC_Library, reattaching it to - ! any existing echo information - !---------------------------------------------------------------------------------------------------- - call UA_End(p) - - ! probably should also deallocate driver variables here + call UA_End(dvr%UA_p) + ! probably should also deallocate driver variables here... end subroutine Cleanup @@ -282,94 +298,6 @@ subroutine checkError() end subroutine checkError !---------------------------------------------------------------------------------------------------- - subroutine setUAinputs(n,u,t,dt,dvrInitInp,timeArr,AOAarr,Uarr,OmegaArr,errStat,errMsg) - - integer, intent(in) :: n - type(UA_InputType), intent(inout) :: u ! System inputs - real(DbKi), intent( out) :: t - real(DbKi), intent(in) :: dt - TYPE(UA_Dvr_InitInput), intent(in) :: dvrInitInp ! Initialization data for the driver program - real(DbKi), intent(in), allocatable :: timeArr(:) - real(ReKi), intent(in), allocatable :: AOAarr(:) - real(ReKi), intent(in), allocatable :: Uarr(:) - real(ReKi), intent(in), allocatable :: OmegaArr(:) - integer, intent(out) :: errStat - character(len=*), intent(out) :: errMsg - integer :: indx - real(ReKi) :: phase - real(ReKi) :: d_ref2AC - real(ReKi) :: alpha_ref - real(ReKi) :: U_ref - real(ReKi) :: v_ref(2) - real(ReKi) :: v_34(2) - logical, parameter :: OscillationAtMidChord=.true. ! for legacy, use false - logical, parameter :: VelocityAt34 =.true. ! for legacy, use false - - ! Initialize error handling variables - ErrMsg = '' - ErrStat = ErrID_None - - u%UserProp = 0 - u%Re = dvrInitInp%Re - - if ( dvrInitInp%SimMod == 1 ) then - if (OscillationAtMidChord) then - d_ref2AC =-0.25_ReKi ! -0.25: oscillations at mid_chord - else - d_ref2AC = 0.0_ReKi ! 0: oscillations at AC - endif - U_ref = dvrInitInp%InflowVel ! m/s - - t = (n-1)*dt - phase = (n+dvrInitInp%Phase-1)*2*pi/dvrInitInp%StepsPerCycle - alpha_ref = (dvrInitInp%Amplitude * sin(phase) + dvrInitInp%Mean)*D2R ! This needs to be in radians - v_ref(1) = sin(alpha_ref)*U_ref - v_ref(2) = cos(alpha_ref)*U_ref - u%omega = dvrInitInp%Amplitude * cos(phase) * 2*pi/dvrInitInp%StepsPerCycle / dt * D2R ! This needs to be in radians derivative: d_alpha /d_t - - u%v_ac(1) = v_ref(1) + u%omega * d_ref2AC* dvrInitInp%Chord - u%v_ac(2) = v_ref(2) - - v_34(1) = u%v_ac(1) + u%omega * 0.5* dvrInitInp%Chord - v_34(2) = u%v_ac(2) - - - u%alpha = atan2(u%v_ac(1), u%v_ac(2) ) ! - if (VelocityAt34) then - u%U = sqrt(v_34(1)**2 + v_34(2)**2) ! Using U at 3/4 - else - u%U = sqrt(u%v_ac(1)**2 + u%v_ac(2)**2) ! Using U at 1/4 - endif - - - else - ! check optional variables and allocation status - if (all( (/ allocated(timeArr),allocated(AOAarr),allocated(OmegaArr),allocated(Uarr) /) )) then - - indx = min(n,size(timeArr)) - indx = max(1, indx) ! use constant data at initialization - - ! Load timestep data from the time-series inputs which were previous read from input file - t = timeArr(indx) - u%alpha = AOAarr(indx)*pi/180.0 ! This needs to be in radians - u%omega = OmegaArr(indx) - u%U = Uarr(indx) - if (n> size(timeArr)) then - t = t + dt*(n - size(timeArr) ) ! update for NumInp>1; - elseif (n < 1) then - t = (n-1)*dt - end if - u%v_ac(1) = sin(u%alpha)*u%U - u%v_ac(2) = cos(u%alpha)*u%U - else - errStat = ErrID_Fatal - errMsg = 'mandatory input arrays are not allocated: timeArr,AOAarr,OmegaArr,Uarr' - end if - - end if - - end subroutine setUAinputs - !---------------------------------------------------------------------------------------------------- subroutine print_help() print '(a)', 'usage: ' diff --git a/modules/aerodyn/src/UnsteadyAero_Registry.txt b/modules/aerodyn/src/UnsteadyAero_Registry.txt index b71aef051d..3b3a30df66 100644 --- a/modules/aerodyn/src/UnsteadyAero_Registry.txt +++ b/modules/aerodyn/src/UnsteadyAero_Registry.txt @@ -16,14 +16,12 @@ include Registry_NWTC_Library.txt usefrom AirfoilInfo_Registry.txt # # - -param UnsteadyAero/UA - INTEGER UA_Baseline - 1 - "UAMod = 1 [Baseline model (Original)]" - -param UnsteadyAero/UA - INTEGER UA_Gonzalez - 2 - "UAMod = 2 [Gonzalez's variant (changes in Cn,Cc,Cm)]" - -param UnsteadyAero/UA - INTEGER UA_MinnemaPierce - 3 - "[Minnema/Pierce variant (changes in Cc and Cm)]" - -param UnsteadyAero/UA - INTEGER UA_HGM - 4 - "[continuous variant of HGM (Hansen) model]" - -param UnsteadyAero/UA - INTEGER UA_HGMV - 5 - "[continuous variant of HGM (Hansen) model with vortex modifications]" - -param UnsteadyAero/UA - INTEGER UA_Oye - 6 - "Stieg Oye dynamic stall model" - -param UnsteadyAero/UA - INTEGER UA_BV - 7 - "Boeing-Vertol dynamic stall model (e.g. used in CACTUS)" - +# NOTE: UA model parameters are defined in AirfoilInfo_Registry.txt +# +param UnsteadyAero/UA - INTEGER UA_Method_RK4 - 1 - "RK4 integration method" - +param UnsteadyAero/UA - INTEGER UA_Method_AB4 - 2 - "AB4 integration method" - +param UnsteadyAero/UA - INTEGER UA_Method_ABM4 - 3 - "ABM4 integration method" - +param UnsteadyAero/UA - INTEGER UA_Method_BDF2 - 4 - "BDF2 integration method" - # ..... Initialization data ....................................................................................................... # Define inputs that the initialization routine may need here: @@ -32,6 +30,7 @@ param UnsteadyAero/UA - INTEGER UA_BV typedef UnsteadyAero/UA InitInputType DbKi dt - - - "time step" s typedef ^ ^ CHARACTER(1024) OutRootName - - - "Supplied by Driver: The name of the root file (without extension) including the full path" - typedef ^ ^ ReKi c {:}{:} - - "Chord length at node" m +typedef ^ ^ ReKi d_34_to_ac - 0.5 - "Distance from 3/4 chord to aerodynamic center (typically 0.5) in chord length (no dimension)" - typedef ^ ^ INTEGER numBlades - - - "Number nodes of all blades" - typedef ^ ^ INTEGER nNodesPerBlade - - - "Number nodes per blades" - typedef ^ ^ INTEGER UAMod - - - "Model for the dynamic stall equations [1 = Leishman/Beddoes, 2 = Gonzalez, 3 = Minnema]" - @@ -41,13 +40,15 @@ typedef ^ ^ Logical typedef ^ ^ LOGICAL WrSum - .false. - "Write UA AFI parameters to summary file?" - typedef ^ ^ INTEGER UAOff_innerNode {:} - - "Last node on each blade where UA should be turned off based on span location from blade root (0 if always on)" - typedef ^ ^ INTEGER UAOff_outerNode {:} - - "First node on each blade where UA should be turned off based on span location from blade tip (>nNodesPerBlade if always on)" - +typedef ^ ^ IntKi UA_OUTS - 0 - "Store write outputs 0=None, 1=WriteOutpus, 2=WriteToFile" - +typedef ^ ^ INTEGER integrationMethod - 3 - "method to integrate states (default is 3=UA_Method_ABM4)" - # # Define outputs from the initialization routine here: # typedef ^ InitOutputType ProgDesc Version - - - "Version structure" - -typedef ^ InitOutputType CHARACTER(19) WriteOutputHdr {:} - - "The is the list of all UA-related output channel header strings (includes all sub-module channels)" - -typedef ^ ^ CHARACTER(19) WriteOutputUnt {:} - - "The is the list of all UA-related output channel unit strings (includes all sub-module channels)" - +typedef ^ InitOutputType CHARACTER(ChanLen) WriteOutputHdr {:} - - "The is the list of all UA-related output channel header strings (includes all sub-module channels)" - +typedef ^ ^ CHARACTER(ChanLen) WriteOutputUnt {:} - - "The is the list of all UA-related output channel unit strings (includes all sub-module channels)" - # Variables local to the Kelvin Chain: @@ -107,7 +108,7 @@ typedef ^ UA_KelvinChainType ReKi # ..... States .................................................................................................................... # Define continuous (differentiable) states here: -typedef ^ UA_ElementContinuousStateType R8Ki x 5 - - "continuous states when UA_Mod=4 (x1 and x2:Downwash memory terms; x3:Clp', Lift coefficient with a time lag to the attached lift coeff; x4: f'' , Final separation point function)" "{rad, rad, - -}" +typedef ^ UA_ElementContinuousStateType R8Ki x 7 - - "continuous states when UA_Mod=4 (x1 and x2:Downwash memory terms; x3:Clp', Lift coefficient with a time lag to the attached lift coeff; x4: f'' , Final separation point function)" "{rad, rad, - -}" typedef ^ ContinuousStateType UA_ElementContinuousStateType element {:}{:} - - "continuous states when UA_Mod=4 for each blade/node" "-" # Define discrete (non-differentiable) states here: @@ -115,7 +116,7 @@ typedef ^ ContinuousStateType UA_ElementC typedef ^ DiscreteStateType ReKi alpha_minus1 {:}{:} - - "angle of attack, previous time step" rad typedef ^ DiscreteStateType ReKi alpha_filt_minus1 {:}{:} - - "filtered angle of attack, previous time step" rad typedef ^ DiscreteStateType ReKi alpha_dot {:}{:} - - "Rate of change of angle of attack (filtered); BV model" rad/s -typedef ^ DiscreteStateType ReKi alpha_dot_minus1 {:}{:} - - "Rate of change of angle of attack (filtered); BV modeldata" rad/s +typedef ^ DiscreteStateType ReKi alpha_dot_minus1 {:}{:} - - "Rate of change of angle of attack (filtered); BV model" rad/s typedef ^ DiscreteStateType ReKi q_minus1 {:}{:} - - "non-dimensional pitching rate, previous time step" - typedef ^ DiscreteStateType ReKi Kalpha_f_minus1 {:}{:} - - "filtered pitching rate, previous time step" - typedef ^ DiscreteStateType ReKi Kq_f_minus1 {:}{:} - - "filtered pitching acceleration, previous time step" - @@ -161,6 +162,7 @@ typedef ^ OtherStateType ReKi typedef ^ OtherStateType ReKi sigma3 {:}{:} - - "multiplier for T_V" - typedef ^ OtherStateType IntKi n {:}{:} - - "counter for continuous state integration" - typedef ^ OtherStateType UA_ContinuousStateType xdot 4 - - "history states for continuous state integration" - +typedef ^ OtherStateType UA_ContinuousStateType xHistory 4 - - "history states for continuous state integration" - typedef ^ OtherStateType ReKi t_vortexBegin {:}{:} - - "HGMV model: simulation time when vortex lift term became active" s typedef ^ OtherStateType ReKi SignOfOmega {:}{:} - - "HGMV model: sign of omega when vortex lift term became active " s typedef ^ OtherStateType LOGICAL PositivePressure {:}{:} - - "HGMV model: logical flag indicating if the vortex lift became active because of positive pressure (or negative)" - @@ -180,7 +182,7 @@ typedef ^ MiscVarType LOGICAL typedef ^ MiscVarType LOGICAL LESF {:}{:} - - "logical flag indicating if leading edge separation is possible" - typedef ^ MiscVarType LOGICAL VRTX {:}{:} - - "logical flag indicating if a vortex is being processed" - typedef ^ MiscVarType ReKi T_Sh {:}{:} - - "shedding frequency" - -typedef ^ MiscVarType LOGICAL BEDSEP {:}{:} - - "logical flag indicating if this is undergoing separated flow (for compison with AD14)" - +typedef ^ MiscVarType LOGICAL BEDSEP {:}{:} - - "logical flag indicating if this is undergoing separated flow" - typedef ^ MiscVarType ReKi weight {:}{:} - - "value between 0 and 1 indicating if UA is on (1) or off (0) or somewhere in between" - @@ -188,6 +190,7 @@ typedef ^ MiscVarType ReKi # Define parameters here: typedef ^ ParameterType DbKi dt - - - "time step" s typedef ^ ^ ReKi c {:}{:} - - "Chord length at node" m +typedef ^ ^ ReKi d_34_to_ac - 0.5 - "Distance from 3/4 chord to aerodynamic center (typically 0.5) in chord length (no dimension)" - typedef ^ ^ INTEGER numBlades - - - "Number nodes of all blades" - typedef ^ ^ INTEGER nNodesPerBlade - - - "Number nodes per blades" - typedef ^ ^ INTEGER UAMod - - - "Model for the dynamic stall equations [1 = Leishman/Beddoes, 2 = Gonzalez, 3 = Minnema]" - @@ -202,6 +205,10 @@ typedef ^ ^ INTEGER typedef ^ ^ Logical ShedEffect - - - "Include the effect of shed vorticity. If False, the input alpha is assumed to already contain this effect (e.g. vortex methods)" - typedef ^ ParameterType IntKi lin_nx - 0 - "Number of continuous states for linearization" - typedef ^ ^ LOGICAL UA_off_forGood {:}{:} - - "logical flag indicating if UA is off for good" - +typedef ^ ^ INTEGER lin_xIndx {:}{:} - - "array to indicate which state to perturb for UA" - +typedef ^ ^ R8Ki dx {7} - - "array to indicate size of state perturbations (x array)" - +typedef ^ ^ IntKi UA_OUTS - 0 - "Store write outputs 0=None, 1=WriteOutpus, 2=WriteToFile" - +typedef ^ ^ INTEGER integrationMethod - 3 - "method to integrate states" - # ..... Inputs .................................................................................................................... # Define inputs that are contained on the mesh here: diff --git a/modules/aerodyn/src/UnsteadyAero_Types.f90 b/modules/aerodyn/src/UnsteadyAero_Types.f90 index 3a42342068..8f26807364 100644 --- a/modules/aerodyn/src/UnsteadyAero_Types.f90 +++ b/modules/aerodyn/src/UnsteadyAero_Types.f90 @@ -34,34 +34,34 @@ MODULE UnsteadyAero_Types USE AirfoilInfo_Types USE NWTC_Library IMPLICIT NONE - INTEGER(IntKi), PUBLIC, PARAMETER :: UA_Baseline = 1 ! UAMod = 1 [Baseline model (Original)] [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: UA_Gonzalez = 2 ! UAMod = 2 [Gonzalez's variant (changes in Cn,Cc,Cm)] [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: UA_MinnemaPierce = 3 ! [Minnema/Pierce variant (changes in Cc and Cm)] [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: UA_HGM = 4 ! [continuous variant of HGM (Hansen) model] [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: UA_HGMV = 5 ! [continuous variant of HGM (Hansen) model with vortex modifications] [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: UA_Oye = 6 ! Stieg Oye dynamic stall model [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: UA_BV = 7 ! Boeing-Vertol dynamic stall model (e.g. used in CACTUS) [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: UA_Method_RK4 = 1 ! RK4 integration method [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: UA_Method_AB4 = 2 ! AB4 integration method [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: UA_Method_ABM4 = 3 ! ABM4 integration method [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: UA_Method_BDF2 = 4 ! BDF2 integration method [-] ! ========= UA_InitInputType ======= TYPE, PUBLIC :: UA_InitInputType - REAL(DbKi) :: dt !< time step [s] + REAL(DbKi) :: dt = 0.0_R8Ki !< time step [s] CHARACTER(1024) :: OutRootName !< Supplied by Driver: The name of the root file (without extension) including the full path [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: c !< Chord length at node [m] - INTEGER(IntKi) :: numBlades !< Number nodes of all blades [-] - INTEGER(IntKi) :: nNodesPerBlade !< Number nodes per blades [-] - INTEGER(IntKi) :: UAMod !< Model for the dynamic stall equations [1 = Leishman/Beddoes, 2 = Gonzalez, 3 = Minnema] [-] - REAL(ReKi) :: a_s !< speed of sound [m/s] - LOGICAL :: Flookup !< Use table lookup for f' and f'' [-] + REAL(ReKi) :: d_34_to_ac = 0.5 !< Distance from 3/4 chord to aerodynamic center (typically 0.5) in chord length (no dimension) [-] + INTEGER(IntKi) :: numBlades = 0_IntKi !< Number nodes of all blades [-] + INTEGER(IntKi) :: nNodesPerBlade = 0_IntKi !< Number nodes per blades [-] + INTEGER(IntKi) :: UAMod = 0_IntKi !< Model for the dynamic stall equations [1 = Leishman/Beddoes, 2 = Gonzalez, 3 = Minnema] [-] + REAL(ReKi) :: a_s = 0.0_ReKi !< speed of sound [m/s] + LOGICAL :: Flookup = .false. !< Use table lookup for f' and f'' [-] LOGICAL :: ShedEffect = .True. !< Include the effect of shed vorticity. If False, the input alpha is assumed to already contain this effect (e.g. vortex methods) [-] LOGICAL :: WrSum = .false. !< Write UA AFI parameters to summary file? [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: UAOff_innerNode !< Last node on each blade where UA should be turned off based on span location from blade root (0 if always on) [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: UAOff_outerNode !< First node on each blade where UA should be turned off based on span location from blade tip (>nNodesPerBlade if always on) [-] + INTEGER(IntKi) :: UA_OUTS = 0 !< Store write outputs 0=None, 1=WriteOutpus, 2=WriteToFile [-] + INTEGER(IntKi) :: integrationMethod = 3 !< method to integrate states (default is 3=UA_Method_ABM4) [-] END TYPE UA_InitInputType ! ======================= ! ========= UA_InitOutputType ======= TYPE, PUBLIC :: UA_InitOutputType TYPE(ProgDesc) :: Version !< Version structure [-] - CHARACTER(19) , DIMENSION(:), ALLOCATABLE :: WriteOutputHdr !< The is the list of all UA-related output channel header strings (includes all sub-module channels) [-] - CHARACTER(19) , DIMENSION(:), ALLOCATABLE :: WriteOutputUnt !< The is the list of all UA-related output channel unit strings (includes all sub-module channels) [-] + CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputHdr !< The is the list of all UA-related output channel header strings (includes all sub-module channels) [-] + CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputUnt !< The is the list of all UA-related output channel unit strings (includes all sub-module channels) [-] END TYPE UA_InitOutputType ! ======================= ! ========= UA_KelvinChainType ======= @@ -121,7 +121,7 @@ MODULE UnsteadyAero_Types ! ======================= ! ========= UA_ElementContinuousStateType ======= TYPE, PUBLIC :: UA_ElementContinuousStateType - REAL(R8Ki) , DIMENSION(1:5) :: x !< continuous states when UA_Mod=4 (x1 and x2:Downwash memory terms; x3:Clp', Lift coefficient with a time lag to the attached lift coeff; x4: f'' , Final separation point function) [{rad, rad, - -}] + REAL(R8Ki) , DIMENSION(1:7) :: x = 0.0_R8Ki !< continuous states when UA_Mod=4 (x1 and x2:Downwash memory terms; x3:Clp', Lift coefficient with a time lag to the attached lift coeff; x4: f'' , Final separation point function) [{rad, rad, - -}] END TYPE UA_ElementContinuousStateType ! ======================= ! ========= UA_ContinuousStateType ======= @@ -134,7 +134,7 @@ MODULE UnsteadyAero_Types REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: alpha_minus1 !< angle of attack, previous time step [rad] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: alpha_filt_minus1 !< filtered angle of attack, previous time step [rad] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: alpha_dot !< Rate of change of angle of attack (filtered); BV model [rad/s] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: alpha_dot_minus1 !< Rate of change of angle of attack (filtered); BV modeldata [rad/s] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: alpha_dot_minus1 !< Rate of change of angle of attack (filtered); BV model [rad/s] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: q_minus1 !< non-dimensional pitching rate, previous time step [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Kalpha_f_minus1 !< filtered pitching rate, previous time step [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Kq_f_minus1 !< filtered pitching acceleration, previous time step [-] @@ -169,7 +169,7 @@ MODULE UnsteadyAero_Types ! ======================= ! ========= UA_ConstraintStateType ======= TYPE, PUBLIC :: UA_ConstraintStateType - REAL(ReKi) :: DummyConstraintState !< [-] + REAL(ReKi) :: DummyConstraintState = 0.0_ReKi !< [-] END TYPE UA_ConstraintStateType ! ======================= ! ========= UA_OtherStateType ======= @@ -181,6 +181,7 @@ MODULE UnsteadyAero_Types REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: sigma3 !< multiplier for T_V [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: n !< counter for continuous state integration [-] TYPE(UA_ContinuousStateType) , DIMENSION(1:4) :: xdot !< history states for continuous state integration [-] + TYPE(UA_ContinuousStateType) , DIMENSION(1:4) :: xHistory !< history states for continuous state integration [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: t_vortexBegin !< HGMV model: simulation time when vortex lift term became active [s] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: SignOfOmega !< HGMV model: sign of omega when vortex lift term became active [s] LOGICAL , DIMENSION(:,:), ALLOCATABLE :: PositivePressure !< HGMV model: logical flag indicating if the vortex lift became active because of positive pressure (or negative) [-] @@ -192,6552 +193,2051 @@ MODULE UnsteadyAero_Types ! ======================= ! ========= UA_MiscVarType ======= TYPE, PUBLIC :: UA_MiscVarType - LOGICAL :: FirstWarn_M !< flag so Mach number warning doesn't get repeated forever [-] - LOGICAL :: FirstWarn_UA !< flag so UA state warning doesn't get repeated forever [-] - LOGICAL :: FirstWarn_UA_off !< flag so UA state warning doesn't get repeated forever [-] + LOGICAL :: FirstWarn_M = .false. !< flag so Mach number warning doesn't get repeated forever [-] + LOGICAL :: FirstWarn_UA = .false. !< flag so UA state warning doesn't get repeated forever [-] + LOGICAL :: FirstWarn_UA_off = .false. !< flag so UA state warning doesn't get repeated forever [-] LOGICAL , DIMENSION(:,:), ALLOCATABLE :: TESF !< logical flag indicating if trailing edge separation is possible [-] LOGICAL , DIMENSION(:,:), ALLOCATABLE :: LESF !< logical flag indicating if leading edge separation is possible [-] LOGICAL , DIMENSION(:,:), ALLOCATABLE :: VRTX !< logical flag indicating if a vortex is being processed [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: T_Sh !< shedding frequency [-] - LOGICAL , DIMENSION(:,:), ALLOCATABLE :: BEDSEP !< logical flag indicating if this is undergoing separated flow (for compison with AD14) [-] + LOGICAL , DIMENSION(:,:), ALLOCATABLE :: BEDSEP !< logical flag indicating if this is undergoing separated flow [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: weight !< value between 0 and 1 indicating if UA is on (1) or off (0) or somewhere in between [-] END TYPE UA_MiscVarType ! ======================= ! ========= UA_ParameterType ======= TYPE, PUBLIC :: UA_ParameterType - REAL(DbKi) :: dt !< time step [s] + REAL(DbKi) :: dt = 0.0_R8Ki !< time step [s] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: c !< Chord length at node [m] - INTEGER(IntKi) :: numBlades !< Number nodes of all blades [-] - INTEGER(IntKi) :: nNodesPerBlade !< Number nodes per blades [-] - INTEGER(IntKi) :: UAMod !< Model for the dynamic stall equations [1 = Leishman/Beddoes, 2 = Gonzalez, 3 = Minnema] [-] - LOGICAL :: Flookup !< Use table lookup for f' and f'' [-] - REAL(ReKi) :: a_s !< speed of sound [m/s] + REAL(ReKi) :: d_34_to_ac = 0.5 !< Distance from 3/4 chord to aerodynamic center (typically 0.5) in chord length (no dimension) [-] + INTEGER(IntKi) :: numBlades = 0_IntKi !< Number nodes of all blades [-] + INTEGER(IntKi) :: nNodesPerBlade = 0_IntKi !< Number nodes per blades [-] + INTEGER(IntKi) :: UAMod = 0_IntKi !< Model for the dynamic stall equations [1 = Leishman/Beddoes, 2 = Gonzalez, 3 = Minnema] [-] + LOGICAL :: Flookup = .false. !< Use table lookup for f' and f'' [-] + REAL(ReKi) :: a_s = 0.0_ReKi !< speed of sound [m/s] INTEGER(IntKi) :: NumOuts = 0 !< Number of outputs [-] - INTEGER(IntKi) :: OutSwtch !< Output requested channels to: [1=Unsteady.out 2=GlueCode.out 3=both files] [-] + INTEGER(IntKi) :: OutSwtch = 0_IntKi !< Output requested channels to: [1=Unsteady.out 2=GlueCode.out 3=both files] [-] CHARACTER(20) :: OutFmt !< Output format for numerical results [-] CHARACTER(20) :: OutSFmt !< Output format for header strings [-] CHARACTER(1) :: Delim !< Delimiter string for outputs, defaults to tab-delimiters [-] INTEGER(IntKi) :: UnOutFile = 0 !< File unit for the UnsteadyAero outputs [-] - LOGICAL :: ShedEffect !< Include the effect of shed vorticity. If False, the input alpha is assumed to already contain this effect (e.g. vortex methods) [-] + LOGICAL :: ShedEffect = .false. !< Include the effect of shed vorticity. If False, the input alpha is assumed to already contain this effect (e.g. vortex methods) [-] INTEGER(IntKi) :: lin_nx = 0 !< Number of continuous states for linearization [-] LOGICAL , DIMENSION(:,:), ALLOCATABLE :: UA_off_forGood !< logical flag indicating if UA is off for good [-] + INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: lin_xIndx !< array to indicate which state to perturb for UA [-] + REAL(R8Ki) , DIMENSION(1:7) :: dx = 0.0_R8Ki !< array to indicate size of state perturbations (x array) [-] + INTEGER(IntKi) :: UA_OUTS = 0 !< Store write outputs 0=None, 1=WriteOutpus, 2=WriteToFile [-] + INTEGER(IntKi) :: integrationMethod = 3 !< method to integrate states [-] END TYPE UA_ParameterType ! ======================= ! ========= UA_InputType ======= TYPE, PUBLIC :: UA_InputType - REAL(ReKi) :: U !< air velocity magnitude relative to the airfoil [m/s] - REAL(ReKi) :: alpha !< angle of attack [rad] - REAL(ReKi) :: Re !< Reynold's number [-] + REAL(ReKi) :: U = 0.0_ReKi !< air velocity magnitude relative to the airfoil [m/s] + REAL(ReKi) :: alpha = 0.0_ReKi !< angle of attack [rad] + REAL(ReKi) :: Re = 0.0_ReKi !< Reynold's number [-] REAL(ReKi) :: UserProp = 0.0 !< UserProp value for interpolating airfoil tables [-] - REAL(ReKi) , DIMENSION(1:2) :: v_ac !< Relative fluid velocity at the aerodynamic center (UAMod=4) [m/s] - REAL(ReKi) :: omega !< pitching/twisting rate of the airfoil section (UAMod=4) [rad/s] + REAL(ReKi) , DIMENSION(1:2) :: v_ac = 0.0_ReKi !< Relative fluid velocity at the aerodynamic center (UAMod=4) [m/s] + REAL(ReKi) :: omega = 0.0_ReKi !< pitching/twisting rate of the airfoil section (UAMod=4) [rad/s] END TYPE UA_InputType ! ======================= ! ========= UA_OutputType ======= TYPE, PUBLIC :: UA_OutputType - REAL(ReKi) :: Cn !< 2D, normal to chord, force coefficient [-] - REAL(ReKi) :: Cc !< 2D, tangent to chord, force coefficient [-] - REAL(ReKi) :: Cm !< 2D pitching moment coefficient about the 1/4 chord, positive when nose is up [-] - REAL(ReKi) :: Cl !< 2D lift coefficient [-] - REAL(ReKi) :: Cd !< 2D drag coefficient [-] + REAL(ReKi) :: Cn = 0.0_ReKi !< 2D, normal to chord, force coefficient [-] + REAL(ReKi) :: Cc = 0.0_ReKi !< 2D, tangent to chord, force coefficient [-] + REAL(ReKi) :: Cm = 0.0_ReKi !< 2D pitching moment coefficient about the 1/4 chord, positive when nose is up [-] + REAL(ReKi) :: Cl = 0.0_ReKi !< 2D lift coefficient [-] + REAL(ReKi) :: Cd = 0.0_ReKi !< 2D drag coefficient [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: WriteOutput !< outputs to be written to a file [-] END TYPE UA_OutputType ! ======================= CONTAINS - SUBROUTINE UA_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(UA_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(UA_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 = 'UA_CopyInitInput' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInitInputData%dt = SrcInitInputData%dt - DstInitInputData%OutRootName = SrcInitInputData%OutRootName -IF (ALLOCATED(SrcInitInputData%c)) THEN - i1_l = LBOUND(SrcInitInputData%c,1) - i1_u = UBOUND(SrcInitInputData%c,1) - i2_l = LBOUND(SrcInitInputData%c,2) - i2_u = UBOUND(SrcInitInputData%c,2) - IF (.NOT. ALLOCATED(DstInitInputData%c)) THEN - ALLOCATE(DstInitInputData%c(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%c.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%c = SrcInitInputData%c -ENDIF - DstInitInputData%numBlades = SrcInitInputData%numBlades - DstInitInputData%nNodesPerBlade = SrcInitInputData%nNodesPerBlade - DstInitInputData%UAMod = SrcInitInputData%UAMod - DstInitInputData%a_s = SrcInitInputData%a_s - DstInitInputData%Flookup = SrcInitInputData%Flookup - DstInitInputData%ShedEffect = SrcInitInputData%ShedEffect - DstInitInputData%WrSum = SrcInitInputData%WrSum -IF (ALLOCATED(SrcInitInputData%UAOff_innerNode)) THEN - i1_l = LBOUND(SrcInitInputData%UAOff_innerNode,1) - i1_u = UBOUND(SrcInitInputData%UAOff_innerNode,1) - IF (.NOT. ALLOCATED(DstInitInputData%UAOff_innerNode)) THEN - ALLOCATE(DstInitInputData%UAOff_innerNode(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%UAOff_innerNode.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%UAOff_innerNode = SrcInitInputData%UAOff_innerNode -ENDIF -IF (ALLOCATED(SrcInitInputData%UAOff_outerNode)) THEN - i1_l = LBOUND(SrcInitInputData%UAOff_outerNode,1) - i1_u = UBOUND(SrcInitInputData%UAOff_outerNode,1) - IF (.NOT. ALLOCATED(DstInitInputData%UAOff_outerNode)) THEN - ALLOCATE(DstInitInputData%UAOff_outerNode(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%UAOff_outerNode.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%UAOff_outerNode = SrcInitInputData%UAOff_outerNode -ENDIF - END SUBROUTINE UA_CopyInitInput - - SUBROUTINE UA_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(UA_InitInputType), INTENT(INOUT) :: InitInputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'UA_DestroyInitInput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(InitInputData%c)) THEN - DEALLOCATE(InitInputData%c) -ENDIF -IF (ALLOCATED(InitInputData%UAOff_innerNode)) THEN - DEALLOCATE(InitInputData%UAOff_innerNode) -ENDIF -IF (ALLOCATED(InitInputData%UAOff_outerNode)) THEN - DEALLOCATE(InitInputData%UAOff_outerNode) -ENDIF - END SUBROUTINE UA_DestroyInitInput - - SUBROUTINE UA_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(UA_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 = 'UA_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 - Db_BufSz = Db_BufSz + 1 ! dt - Int_BufSz = Int_BufSz + 1*LEN(InData%OutRootName) ! OutRootName - Int_BufSz = Int_BufSz + 1 ! c allocated yes/no - IF ( ALLOCATED(InData%c) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! c upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%c) ! c - END IF - Int_BufSz = Int_BufSz + 1 ! numBlades - Int_BufSz = Int_BufSz + 1 ! nNodesPerBlade - Int_BufSz = Int_BufSz + 1 ! UAMod - Re_BufSz = Re_BufSz + 1 ! a_s - Int_BufSz = Int_BufSz + 1 ! Flookup - Int_BufSz = Int_BufSz + 1 ! ShedEffect - Int_BufSz = Int_BufSz + 1 ! WrSum - Int_BufSz = Int_BufSz + 1 ! UAOff_innerNode allocated yes/no - IF ( ALLOCATED(InData%UAOff_innerNode) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! UAOff_innerNode upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%UAOff_innerNode) ! UAOff_innerNode - END IF - Int_BufSz = Int_BufSz + 1 ! UAOff_outerNode allocated yes/no - IF ( ALLOCATED(InData%UAOff_outerNode) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! UAOff_outerNode upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%UAOff_outerNode) ! UAOff_outerNode - 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%OutRootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutRootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - 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 - IntKiBuf( Int_Xferred ) = LBOUND(InData%c,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%c,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%c,2), UBOUND(InData%c,2) - DO i1 = LBOUND(InData%c,1), UBOUND(InData%c,1) - ReKiBuf(Re_Xferred) = InData%c(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%numBlades - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nNodesPerBlade - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%UAMod - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%a_s - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%Flookup, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%ShedEffect, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%WrSum, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%UAOff_innerNode) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%UAOff_innerNode,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UAOff_innerNode,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%UAOff_innerNode,1), UBOUND(InData%UAOff_innerNode,1) - IntKiBuf(Int_Xferred) = InData%UAOff_innerNode(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%UAOff_outerNode) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%UAOff_outerNode,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UAOff_outerNode,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%UAOff_outerNode,1), UBOUND(InData%UAOff_outerNode,1) - IntKiBuf(Int_Xferred) = InData%UAOff_outerNode(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - END SUBROUTINE UA_PackInitInput - - SUBROUTINE UA_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(UA_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 = 'UA_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%dt = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - DO I = 1, LEN(OutData%OutRootName) - OutData%OutRootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - 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 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%c)) DEALLOCATE(OutData%c) - ALLOCATE(OutData%c(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%c.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%c,2), UBOUND(OutData%c,2) - DO i1 = LBOUND(OutData%c,1), UBOUND(OutData%c,1) - OutData%c(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%numBlades = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nNodesPerBlade = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%UAMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%a_s = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Flookup = TRANSFER(IntKiBuf(Int_Xferred), OutData%Flookup) - Int_Xferred = Int_Xferred + 1 - OutData%ShedEffect = TRANSFER(IntKiBuf(Int_Xferred), OutData%ShedEffect) - Int_Xferred = Int_Xferred + 1 - OutData%WrSum = TRANSFER(IntKiBuf(Int_Xferred), OutData%WrSum) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! UAOff_innerNode not allocated - Int_Xferred = Int_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%UAOff_innerNode)) DEALLOCATE(OutData%UAOff_innerNode) - ALLOCATE(OutData%UAOff_innerNode(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%UAOff_innerNode.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%UAOff_innerNode,1), UBOUND(OutData%UAOff_innerNode,1) - OutData%UAOff_innerNode(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! UAOff_outerNode not allocated - Int_Xferred = Int_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%UAOff_outerNode)) DEALLOCATE(OutData%UAOff_outerNode) - ALLOCATE(OutData%UAOff_outerNode(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%UAOff_outerNode.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%UAOff_outerNode,1), UBOUND(OutData%UAOff_outerNode,1) - OutData%UAOff_outerNode(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - END SUBROUTINE UA_UnPackInitInput - - SUBROUTINE UA_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(UA_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(UA_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 = 'UA_CopyInitOutput' -! +subroutine UA_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) + type(UA_InitInputType), intent(in) :: SrcInitInputData + type(UA_InitInputType), intent(inout) :: DstInitInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'UA_CopyInitInput' ErrStat = ErrID_None - ErrMsg = "" - CALL NWTC_Library_Copyprogdesc( SrcInitOutputData%Version, DstInitOutputData%Version, 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 UA_CopyInitOutput - - SUBROUTINE UA_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(UA_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'UA_DestroyInitOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL NWTC_Library_Destroyprogdesc( InitOutputData%Version, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(InitOutputData%WriteOutputHdr)) THEN - DEALLOCATE(InitOutputData%WriteOutputHdr) -ENDIF -IF (ALLOCATED(InitOutputData%WriteOutputUnt)) THEN - DEALLOCATE(InitOutputData%WriteOutputUnt) -ENDIF - END SUBROUTINE UA_DestroyInitOutput - - SUBROUTINE UA_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(UA_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 = 'UA_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 ! Version: size of buffers for each call to pack subtype - CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Version, ErrStat2, ErrMsg2, .TRUE. ) ! Version - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Version - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Version - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Version - 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%Version, ErrStat2, ErrMsg2, OnlySize ) ! Version - 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 UA_PackInitOutput - - SUBROUTINE UA_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(UA_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 = 'UA_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%Version, ErrStat2, ErrMsg2 ) ! Version - 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 UA_UnPackInitOutput - - SUBROUTINE UA_CopyKelvinChainType( SrcKelvinChainTypeData, DstKelvinChainTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(UA_KelvinChainType), INTENT(IN) :: SrcKelvinChainTypeData - TYPE(UA_KelvinChainType), INTENT(INOUT) :: DstKelvinChainTypeData - 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 = 'UA_CopyKelvinChainType' -! + ErrMsg = '' + DstInitInputData%dt = SrcInitInputData%dt + DstInitInputData%OutRootName = SrcInitInputData%OutRootName + if (allocated(SrcInitInputData%c)) then + LB(1:2) = lbound(SrcInitInputData%c) + UB(1:2) = ubound(SrcInitInputData%c) + if (.not. allocated(DstInitInputData%c)) then + allocate(DstInitInputData%c(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%c.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%c = SrcInitInputData%c + end if + DstInitInputData%d_34_to_ac = SrcInitInputData%d_34_to_ac + DstInitInputData%numBlades = SrcInitInputData%numBlades + DstInitInputData%nNodesPerBlade = SrcInitInputData%nNodesPerBlade + DstInitInputData%UAMod = SrcInitInputData%UAMod + DstInitInputData%a_s = SrcInitInputData%a_s + DstInitInputData%Flookup = SrcInitInputData%Flookup + DstInitInputData%ShedEffect = SrcInitInputData%ShedEffect + DstInitInputData%WrSum = SrcInitInputData%WrSum + if (allocated(SrcInitInputData%UAOff_innerNode)) then + LB(1:1) = lbound(SrcInitInputData%UAOff_innerNode) + UB(1:1) = ubound(SrcInitInputData%UAOff_innerNode) + if (.not. allocated(DstInitInputData%UAOff_innerNode)) then + allocate(DstInitInputData%UAOff_innerNode(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%UAOff_innerNode.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%UAOff_innerNode = SrcInitInputData%UAOff_innerNode + end if + if (allocated(SrcInitInputData%UAOff_outerNode)) then + LB(1:1) = lbound(SrcInitInputData%UAOff_outerNode) + UB(1:1) = ubound(SrcInitInputData%UAOff_outerNode) + if (.not. allocated(DstInitInputData%UAOff_outerNode)) then + allocate(DstInitInputData%UAOff_outerNode(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%UAOff_outerNode.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%UAOff_outerNode = SrcInitInputData%UAOff_outerNode + end if + DstInitInputData%UA_OUTS = SrcInitInputData%UA_OUTS + DstInitInputData%integrationMethod = SrcInitInputData%integrationMethod +end subroutine + +subroutine UA_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(UA_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'UA_DestroyInitInput' ErrStat = ErrID_None - ErrMsg = "" - DstKelvinChainTypeData%Cn_prime = SrcKelvinChainTypeData%Cn_prime - DstKelvinChainTypeData%C_nalpha_circ = SrcKelvinChainTypeData%C_nalpha_circ - DstKelvinChainTypeData%Kalpha_f = SrcKelvinChainTypeData%Kalpha_f - DstKelvinChainTypeData%Kq_f = SrcKelvinChainTypeData%Kq_f - DstKelvinChainTypeData%alpha_filt_cur = SrcKelvinChainTypeData%alpha_filt_cur - DstKelvinChainTypeData%alpha_e = SrcKelvinChainTypeData%alpha_e - DstKelvinChainTypeData%dalpha0 = SrcKelvinChainTypeData%dalpha0 - DstKelvinChainTypeData%alpha_f = SrcKelvinChainTypeData%alpha_f - DstKelvinChainTypeData%Kq = SrcKelvinChainTypeData%Kq - DstKelvinChainTypeData%q_cur = SrcKelvinChainTypeData%q_cur - DstKelvinChainTypeData%q_f_cur = SrcKelvinChainTypeData%q_f_cur - DstKelvinChainTypeData%X1 = SrcKelvinChainTypeData%X1 - DstKelvinChainTypeData%X2 = SrcKelvinChainTypeData%X2 - DstKelvinChainTypeData%X3 = SrcKelvinChainTypeData%X3 - DstKelvinChainTypeData%X4 = SrcKelvinChainTypeData%X4 - DstKelvinChainTypeData%Kprime_alpha = SrcKelvinChainTypeData%Kprime_alpha - DstKelvinChainTypeData%Kprime_q = SrcKelvinChainTypeData%Kprime_q - DstKelvinChainTypeData%K3prime_q = SrcKelvinChainTypeData%K3prime_q - DstKelvinChainTypeData%Kprimeprime_q = SrcKelvinChainTypeData%Kprimeprime_q - DstKelvinChainTypeData%Dp = SrcKelvinChainTypeData%Dp - DstKelvinChainTypeData%Cn_pot = SrcKelvinChainTypeData%Cn_pot - DstKelvinChainTypeData%Cc_pot = SrcKelvinChainTypeData%Cc_pot - DstKelvinChainTypeData%Cn_alpha_q_circ = SrcKelvinChainTypeData%Cn_alpha_q_circ - DstKelvinChainTypeData%Cn_alpha_q_nc = SrcKelvinChainTypeData%Cn_alpha_q_nc - DstKelvinChainTypeData%Cm_q_circ = SrcKelvinChainTypeData%Cm_q_circ - DstKelvinChainTypeData%Cn_alpha_nc = SrcKelvinChainTypeData%Cn_alpha_nc - DstKelvinChainTypeData%Cn_q_circ = SrcKelvinChainTypeData%Cn_q_circ - DstKelvinChainTypeData%Cn_q_nc = SrcKelvinChainTypeData%Cn_q_nc - DstKelvinChainTypeData%Cm_q_nc = SrcKelvinChainTypeData%Cm_q_nc - DstKelvinChainTypeData%fprimeprime = SrcKelvinChainTypeData%fprimeprime - DstKelvinChainTypeData%Df = SrcKelvinChainTypeData%Df - DstKelvinChainTypeData%Df_c = SrcKelvinChainTypeData%Df_c - DstKelvinChainTypeData%Df_m = SrcKelvinChainTypeData%Df_m - DstKelvinChainTypeData%Dalphaf = SrcKelvinChainTypeData%Dalphaf - DstKelvinChainTypeData%fprime = SrcKelvinChainTypeData%fprime - DstKelvinChainTypeData%fprime_c = SrcKelvinChainTypeData%fprime_c - DstKelvinChainTypeData%fprimeprime_c = SrcKelvinChainTypeData%fprimeprime_c - DstKelvinChainTypeData%fprime_m = SrcKelvinChainTypeData%fprime_m - DstKelvinChainTypeData%fprimeprime_m = SrcKelvinChainTypeData%fprimeprime_m - DstKelvinChainTypeData%Cn_v = SrcKelvinChainTypeData%Cn_v - DstKelvinChainTypeData%C_V = SrcKelvinChainTypeData%C_V - DstKelvinChainTypeData%Cn_FS = SrcKelvinChainTypeData%Cn_FS - DstKelvinChainTypeData%T_f = SrcKelvinChainTypeData%T_f - DstKelvinChainTypeData%T_fc = SrcKelvinChainTypeData%T_fc - DstKelvinChainTypeData%T_fm = SrcKelvinChainTypeData%T_fm - DstKelvinChainTypeData%T_V = SrcKelvinChainTypeData%T_V - DstKelvinChainTypeData%k_alpha = SrcKelvinChainTypeData%k_alpha - DstKelvinChainTypeData%k_q = SrcKelvinChainTypeData%k_q - DstKelvinChainTypeData%T_alpha = SrcKelvinChainTypeData%T_alpha - DstKelvinChainTypeData%T_q = SrcKelvinChainTypeData%T_q - DstKelvinChainTypeData%ds = SrcKelvinChainTypeData%ds - END SUBROUTINE UA_CopyKelvinChainType - - SUBROUTINE UA_DestroyKelvinChainType( KelvinChainTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(UA_KelvinChainType), INTENT(INOUT) :: KelvinChainTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'UA_DestroyKelvinChainType' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE UA_DestroyKelvinChainType - - SUBROUTINE UA_PackKelvinChainType( 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(UA_KelvinChainType), 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 = 'UA_PackKelvinChainType' - ! 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 ! Cn_prime - Re_BufSz = Re_BufSz + 1 ! C_nalpha_circ - Re_BufSz = Re_BufSz + 1 ! Kalpha_f - Re_BufSz = Re_BufSz + 1 ! Kq_f - Re_BufSz = Re_BufSz + 1 ! alpha_filt_cur - Re_BufSz = Re_BufSz + 1 ! alpha_e - Re_BufSz = Re_BufSz + 1 ! dalpha0 - Re_BufSz = Re_BufSz + 1 ! alpha_f - Re_BufSz = Re_BufSz + 1 ! Kq - Re_BufSz = Re_BufSz + 1 ! q_cur - Re_BufSz = Re_BufSz + 1 ! q_f_cur - Re_BufSz = Re_BufSz + 1 ! X1 - Re_BufSz = Re_BufSz + 1 ! X2 - Re_BufSz = Re_BufSz + 1 ! X3 - Re_BufSz = Re_BufSz + 1 ! X4 - Re_BufSz = Re_BufSz + 1 ! Kprime_alpha - Re_BufSz = Re_BufSz + 1 ! Kprime_q - Re_BufSz = Re_BufSz + 1 ! K3prime_q - Re_BufSz = Re_BufSz + 1 ! Kprimeprime_q - Re_BufSz = Re_BufSz + 1 ! Dp - Re_BufSz = Re_BufSz + 1 ! Cn_pot - Re_BufSz = Re_BufSz + 1 ! Cc_pot - Re_BufSz = Re_BufSz + 1 ! Cn_alpha_q_circ - Re_BufSz = Re_BufSz + 1 ! Cn_alpha_q_nc - Re_BufSz = Re_BufSz + 1 ! Cm_q_circ - Re_BufSz = Re_BufSz + 1 ! Cn_alpha_nc - Re_BufSz = Re_BufSz + 1 ! Cn_q_circ - Re_BufSz = Re_BufSz + 1 ! Cn_q_nc - Re_BufSz = Re_BufSz + 1 ! Cm_q_nc - Re_BufSz = Re_BufSz + 1 ! fprimeprime - Re_BufSz = Re_BufSz + 1 ! Df - Re_BufSz = Re_BufSz + 1 ! Df_c - Re_BufSz = Re_BufSz + 1 ! Df_m - Re_BufSz = Re_BufSz + 1 ! Dalphaf - Re_BufSz = Re_BufSz + 1 ! fprime - Re_BufSz = Re_BufSz + 1 ! fprime_c - Re_BufSz = Re_BufSz + 1 ! fprimeprime_c - Re_BufSz = Re_BufSz + 1 ! fprime_m - Re_BufSz = Re_BufSz + 1 ! fprimeprime_m - Re_BufSz = Re_BufSz + 1 ! Cn_v - Re_BufSz = Re_BufSz + 1 ! C_V - Re_BufSz = Re_BufSz + 1 ! Cn_FS - Re_BufSz = Re_BufSz + 1 ! T_f - Re_BufSz = Re_BufSz + 1 ! T_fc - Re_BufSz = Re_BufSz + 1 ! T_fm - Re_BufSz = Re_BufSz + 1 ! T_V - Re_BufSz = Re_BufSz + 1 ! k_alpha - Re_BufSz = Re_BufSz + 1 ! k_q - Re_BufSz = Re_BufSz + 1 ! T_alpha - Re_BufSz = Re_BufSz + 1 ! T_q - Re_BufSz = Re_BufSz + 1 ! ds - 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%Cn_prime - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%C_nalpha_circ - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Kalpha_f - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Kq_f - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%alpha_filt_cur - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%alpha_e - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%dalpha0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%alpha_f - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Kq - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%q_cur - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%q_f_cur - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%X1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%X2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%X3 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%X4 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Kprime_alpha - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Kprime_q - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%K3prime_q - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Kprimeprime_q - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Dp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Cn_pot - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Cc_pot - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Cn_alpha_q_circ - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Cn_alpha_q_nc - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Cm_q_circ - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Cn_alpha_nc - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Cn_q_circ - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Cn_q_nc - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Cm_q_nc - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%fprimeprime - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Df - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Df_c - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Df_m - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Dalphaf - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%fprime - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%fprime_c - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%fprimeprime_c - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%fprime_m - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%fprimeprime_m - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Cn_v - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%C_V - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Cn_FS - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%T_f - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%T_fc - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%T_fm - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%T_V - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%k_alpha - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%k_q - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%T_alpha - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%T_q - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%ds - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE UA_PackKelvinChainType - - SUBROUTINE UA_UnPackKelvinChainType( 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(UA_KelvinChainType), 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 = 'UA_UnPackKelvinChainType' - ! 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%Cn_prime = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_nalpha_circ = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Kalpha_f = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Kq_f = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%alpha_filt_cur = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%alpha_e = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%dalpha0 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%alpha_f = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Kq = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%q_cur = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%q_f_cur = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%X1 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%X2 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%X3 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%X4 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Kprime_alpha = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Kprime_q = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%K3prime_q = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Kprimeprime_q = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Dp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Cn_pot = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Cc_pot = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Cn_alpha_q_circ = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Cn_alpha_q_nc = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Cm_q_circ = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Cn_alpha_nc = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Cn_q_circ = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Cn_q_nc = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Cm_q_nc = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%fprimeprime = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Df = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Df_c = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Df_m = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Dalphaf = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%fprime = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%fprime_c = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%fprimeprime_c = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%fprime_m = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%fprimeprime_m = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Cn_v = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_V = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Cn_FS = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%T_f = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%T_fc = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%T_fm = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%T_V = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%k_alpha = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%k_q = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%T_alpha = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%T_q = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%ds = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE UA_UnPackKelvinChainType - - SUBROUTINE UA_CopyElementContinuousStateType( SrcElementContinuousStateTypeData, DstElementContinuousStateTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(UA_ElementContinuousStateType), INTENT(IN) :: SrcElementContinuousStateTypeData - TYPE(UA_ElementContinuousStateType), INTENT(INOUT) :: DstElementContinuousStateTypeData - 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 = 'UA_CopyElementContinuousStateType' -! + ErrMsg = '' + if (allocated(InitInputData%c)) then + deallocate(InitInputData%c) + end if + if (allocated(InitInputData%UAOff_innerNode)) then + deallocate(InitInputData%UAOff_innerNode) + end if + if (allocated(InitInputData%UAOff_outerNode)) then + deallocate(InitInputData%UAOff_outerNode) + end if +end subroutine + +subroutine UA_PackInitInput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(UA_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'UA_PackInitInput' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%dt) + call RegPack(RF, InData%OutRootName) + call RegPackAlloc(RF, InData%c) + call RegPack(RF, InData%d_34_to_ac) + call RegPack(RF, InData%numBlades) + call RegPack(RF, InData%nNodesPerBlade) + call RegPack(RF, InData%UAMod) + call RegPack(RF, InData%a_s) + call RegPack(RF, InData%Flookup) + call RegPack(RF, InData%ShedEffect) + call RegPack(RF, InData%WrSum) + call RegPackAlloc(RF, InData%UAOff_innerNode) + call RegPackAlloc(RF, InData%UAOff_outerNode) + call RegPack(RF, InData%UA_OUTS) + call RegPack(RF, InData%integrationMethod) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine UA_UnPackInitInput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(UA_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'UA_UnPackInitInput' + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%dt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutRootName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%c); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%d_34_to_ac); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%numBlades); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nNodesPerBlade); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UAMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%a_s); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Flookup); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ShedEffect); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WrSum); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%UAOff_innerNode); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%UAOff_outerNode); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UA_OUTS); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%integrationMethod); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine UA_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) + type(UA_InitOutputType), intent(in) :: SrcInitOutputData + type(UA_InitOutputType), intent(inout) :: DstInitOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'UA_CopyInitOutput' ErrStat = ErrID_None - ErrMsg = "" - DstElementContinuousStateTypeData%x = SrcElementContinuousStateTypeData%x - END SUBROUTINE UA_CopyElementContinuousStateType - - SUBROUTINE UA_DestroyElementContinuousStateType( ElementContinuousStateTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(UA_ElementContinuousStateType), INTENT(INOUT) :: ElementContinuousStateTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'UA_DestroyElementContinuousStateType' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE UA_DestroyElementContinuousStateType - - SUBROUTINE UA_PackElementContinuousStateType( 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(UA_ElementContinuousStateType), 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 = 'UA_PackElementContinuousStateType' - ! 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 + SIZE(InData%x) ! x - 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%x,1), UBOUND(InData%x,1) - DbKiBuf(Db_Xferred) = InData%x(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END SUBROUTINE UA_PackElementContinuousStateType - - SUBROUTINE UA_UnPackElementContinuousStateType( 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(UA_ElementContinuousStateType), 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 = 'UA_UnPackElementContinuousStateType' - ! 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%x,1) - i1_u = UBOUND(OutData%x,1) - DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,1) - OutData%x(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END SUBROUTINE UA_UnPackElementContinuousStateType - - SUBROUTINE UA_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(UA_ContinuousStateType), INTENT(IN) :: SrcContStateData - TYPE(UA_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 = 'UA_CopyContState' -! + ErrMsg = '' + call NWTC_Library_CopyProgDesc(SrcInitOutputData%Version, DstInitOutputData%Version, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcInitOutputData%WriteOutputHdr)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) + if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then + allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitOutputData%WriteOutputUnt)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) + if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then + allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), 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 + end if +end subroutine + +subroutine UA_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(UA_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'UA_DestroyInitOutput' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcContStateData%element)) THEN - i1_l = LBOUND(SrcContStateData%element,1) - i1_u = UBOUND(SrcContStateData%element,1) - i2_l = LBOUND(SrcContStateData%element,2) - i2_u = UBOUND(SrcContStateData%element,2) - IF (.NOT. ALLOCATED(DstContStateData%element)) THEN - ALLOCATE(DstContStateData%element(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%element.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcContStateData%element,2), UBOUND(SrcContStateData%element,2) - DO i1 = LBOUND(SrcContStateData%element,1), UBOUND(SrcContStateData%element,1) - CALL UA_Copyelementcontinuousstatetype( SrcContStateData%element(i1,i2), DstContStateData%element(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF - END SUBROUTINE UA_CopyContState - - SUBROUTINE UA_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(UA_ContinuousStateType), INTENT(INOUT) :: ContStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'UA_DestroyContState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(ContStateData%element)) THEN -DO i2 = LBOUND(ContStateData%element,2), UBOUND(ContStateData%element,2) -DO i1 = LBOUND(ContStateData%element,1), UBOUND(ContStateData%element,1) - CALL UA_Destroyelementcontinuousstatetype( ContStateData%element(i1,i2), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO - DEALLOCATE(ContStateData%element) -ENDIF - END SUBROUTINE UA_DestroyContState - - SUBROUTINE UA_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(UA_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 = 'UA_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 ! element allocated yes/no - IF ( ALLOCATED(InData%element) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! element upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i2 = LBOUND(InData%element,2), UBOUND(InData%element,2) - DO i1 = LBOUND(InData%element,1), UBOUND(InData%element,1) - Int_BufSz = Int_BufSz + 3 ! element: size of buffers for each call to pack subtype - CALL UA_Packelementcontinuousstatetype( Re_Buf, Db_Buf, Int_Buf, InData%element(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! element - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! element - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! element - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! element - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - 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%element) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%element,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%element,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%element,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%element,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%element,2), UBOUND(InData%element,2) - DO i1 = LBOUND(InData%element,1), UBOUND(InData%element,1) - CALL UA_Packelementcontinuousstatetype( Re_Buf, Db_Buf, Int_Buf, InData%element(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! element - 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 DO - END IF - END SUBROUTINE UA_PackContState - - SUBROUTINE UA_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(UA_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 = 'UA_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 ! element not allocated - Int_Xferred = Int_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%element)) DEALLOCATE(OutData%element) - ALLOCATE(OutData%element(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%element.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%element,2), UBOUND(OutData%element,2) - DO i1 = LBOUND(OutData%element,1), UBOUND(OutData%element,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 UA_Unpackelementcontinuousstatetype( Re_Buf, Db_Buf, Int_Buf, OutData%element(i1,i2), ErrStat2, ErrMsg2 ) ! element - 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 DO - END IF - END SUBROUTINE UA_UnPackContState - - SUBROUTINE UA_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(UA_DiscreteStateType), INTENT(IN) :: SrcDiscStateData - TYPE(UA_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 = 'UA_CopyDiscState' -! + ErrMsg = '' + call NWTC_Library_DestroyProgDesc(InitOutputData%Version, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(InitOutputData%WriteOutputHdr)) then + deallocate(InitOutputData%WriteOutputHdr) + end if + if (allocated(InitOutputData%WriteOutputUnt)) then + deallocate(InitOutputData%WriteOutputUnt) + end if +end subroutine + +subroutine UA_PackInitOutput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(UA_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'UA_PackInitOutput' + if (RF%ErrStat >= AbortErrLev) return + call NWTC_Library_PackProgDesc(RF, InData%Version) + call RegPackAlloc(RF, InData%WriteOutputHdr) + call RegPackAlloc(RF, InData%WriteOutputUnt) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine UA_UnPackInitOutput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(UA_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'UA_UnPackInitOutput' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call NWTC_Library_UnpackProgDesc(RF, OutData%Version) ! Version + call RegUnpackAlloc(RF, OutData%WriteOutputHdr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WriteOutputUnt); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine UA_CopyKelvinChainType(SrcKelvinChainTypeData, DstKelvinChainTypeData, CtrlCode, ErrStat, ErrMsg) + type(UA_KelvinChainType), intent(in) :: SrcKelvinChainTypeData + type(UA_KelvinChainType), intent(inout) :: DstKelvinChainTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'UA_CopyKelvinChainType' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcDiscStateData%alpha_minus1)) THEN - i1_l = LBOUND(SrcDiscStateData%alpha_minus1,1) - i1_u = UBOUND(SrcDiscStateData%alpha_minus1,1) - i2_l = LBOUND(SrcDiscStateData%alpha_minus1,2) - i2_u = UBOUND(SrcDiscStateData%alpha_minus1,2) - IF (.NOT. ALLOCATED(DstDiscStateData%alpha_minus1)) THEN - ALLOCATE(DstDiscStateData%alpha_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%alpha_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%alpha_minus1 = SrcDiscStateData%alpha_minus1 -ENDIF -IF (ALLOCATED(SrcDiscStateData%alpha_filt_minus1)) THEN - i1_l = LBOUND(SrcDiscStateData%alpha_filt_minus1,1) - i1_u = UBOUND(SrcDiscStateData%alpha_filt_minus1,1) - i2_l = LBOUND(SrcDiscStateData%alpha_filt_minus1,2) - i2_u = UBOUND(SrcDiscStateData%alpha_filt_minus1,2) - IF (.NOT. ALLOCATED(DstDiscStateData%alpha_filt_minus1)) THEN - ALLOCATE(DstDiscStateData%alpha_filt_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%alpha_filt_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%alpha_filt_minus1 = SrcDiscStateData%alpha_filt_minus1 -ENDIF -IF (ALLOCATED(SrcDiscStateData%alpha_dot)) THEN - i1_l = LBOUND(SrcDiscStateData%alpha_dot,1) - i1_u = UBOUND(SrcDiscStateData%alpha_dot,1) - i2_l = LBOUND(SrcDiscStateData%alpha_dot,2) - i2_u = UBOUND(SrcDiscStateData%alpha_dot,2) - IF (.NOT. ALLOCATED(DstDiscStateData%alpha_dot)) THEN - ALLOCATE(DstDiscStateData%alpha_dot(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%alpha_dot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%alpha_dot = SrcDiscStateData%alpha_dot -ENDIF -IF (ALLOCATED(SrcDiscStateData%alpha_dot_minus1)) THEN - i1_l = LBOUND(SrcDiscStateData%alpha_dot_minus1,1) - i1_u = UBOUND(SrcDiscStateData%alpha_dot_minus1,1) - i2_l = LBOUND(SrcDiscStateData%alpha_dot_minus1,2) - i2_u = UBOUND(SrcDiscStateData%alpha_dot_minus1,2) - IF (.NOT. ALLOCATED(DstDiscStateData%alpha_dot_minus1)) THEN - ALLOCATE(DstDiscStateData%alpha_dot_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%alpha_dot_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%alpha_dot_minus1 = SrcDiscStateData%alpha_dot_minus1 -ENDIF -IF (ALLOCATED(SrcDiscStateData%q_minus1)) THEN - i1_l = LBOUND(SrcDiscStateData%q_minus1,1) - i1_u = UBOUND(SrcDiscStateData%q_minus1,1) - i2_l = LBOUND(SrcDiscStateData%q_minus1,2) - i2_u = UBOUND(SrcDiscStateData%q_minus1,2) - IF (.NOT. ALLOCATED(DstDiscStateData%q_minus1)) THEN - ALLOCATE(DstDiscStateData%q_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%q_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%q_minus1 = SrcDiscStateData%q_minus1 -ENDIF -IF (ALLOCATED(SrcDiscStateData%Kalpha_f_minus1)) THEN - i1_l = LBOUND(SrcDiscStateData%Kalpha_f_minus1,1) - i1_u = UBOUND(SrcDiscStateData%Kalpha_f_minus1,1) - i2_l = LBOUND(SrcDiscStateData%Kalpha_f_minus1,2) - i2_u = UBOUND(SrcDiscStateData%Kalpha_f_minus1,2) - IF (.NOT. ALLOCATED(DstDiscStateData%Kalpha_f_minus1)) THEN - ALLOCATE(DstDiscStateData%Kalpha_f_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Kalpha_f_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%Kalpha_f_minus1 = SrcDiscStateData%Kalpha_f_minus1 -ENDIF -IF (ALLOCATED(SrcDiscStateData%Kq_f_minus1)) THEN - i1_l = LBOUND(SrcDiscStateData%Kq_f_minus1,1) - i1_u = UBOUND(SrcDiscStateData%Kq_f_minus1,1) - i2_l = LBOUND(SrcDiscStateData%Kq_f_minus1,2) - i2_u = UBOUND(SrcDiscStateData%Kq_f_minus1,2) - IF (.NOT. ALLOCATED(DstDiscStateData%Kq_f_minus1)) THEN - ALLOCATE(DstDiscStateData%Kq_f_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Kq_f_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%Kq_f_minus1 = SrcDiscStateData%Kq_f_minus1 -ENDIF -IF (ALLOCATED(SrcDiscStateData%q_f_minus1)) THEN - i1_l = LBOUND(SrcDiscStateData%q_f_minus1,1) - i1_u = UBOUND(SrcDiscStateData%q_f_minus1,1) - i2_l = LBOUND(SrcDiscStateData%q_f_minus1,2) - i2_u = UBOUND(SrcDiscStateData%q_f_minus1,2) - IF (.NOT. ALLOCATED(DstDiscStateData%q_f_minus1)) THEN - ALLOCATE(DstDiscStateData%q_f_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%q_f_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%q_f_minus1 = SrcDiscStateData%q_f_minus1 -ENDIF -IF (ALLOCATED(SrcDiscStateData%X1_minus1)) THEN - i1_l = LBOUND(SrcDiscStateData%X1_minus1,1) - i1_u = UBOUND(SrcDiscStateData%X1_minus1,1) - i2_l = LBOUND(SrcDiscStateData%X1_minus1,2) - i2_u = UBOUND(SrcDiscStateData%X1_minus1,2) - IF (.NOT. ALLOCATED(DstDiscStateData%X1_minus1)) THEN - ALLOCATE(DstDiscStateData%X1_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%X1_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%X1_minus1 = SrcDiscStateData%X1_minus1 -ENDIF -IF (ALLOCATED(SrcDiscStateData%X2_minus1)) THEN - i1_l = LBOUND(SrcDiscStateData%X2_minus1,1) - i1_u = UBOUND(SrcDiscStateData%X2_minus1,1) - i2_l = LBOUND(SrcDiscStateData%X2_minus1,2) - i2_u = UBOUND(SrcDiscStateData%X2_minus1,2) - IF (.NOT. ALLOCATED(DstDiscStateData%X2_minus1)) THEN - ALLOCATE(DstDiscStateData%X2_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%X2_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%X2_minus1 = SrcDiscStateData%X2_minus1 -ENDIF -IF (ALLOCATED(SrcDiscStateData%X3_minus1)) THEN - i1_l = LBOUND(SrcDiscStateData%X3_minus1,1) - i1_u = UBOUND(SrcDiscStateData%X3_minus1,1) - i2_l = LBOUND(SrcDiscStateData%X3_minus1,2) - i2_u = UBOUND(SrcDiscStateData%X3_minus1,2) - IF (.NOT. ALLOCATED(DstDiscStateData%X3_minus1)) THEN - ALLOCATE(DstDiscStateData%X3_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%X3_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%X3_minus1 = SrcDiscStateData%X3_minus1 -ENDIF -IF (ALLOCATED(SrcDiscStateData%X4_minus1)) THEN - i1_l = LBOUND(SrcDiscStateData%X4_minus1,1) - i1_u = UBOUND(SrcDiscStateData%X4_minus1,1) - i2_l = LBOUND(SrcDiscStateData%X4_minus1,2) - i2_u = UBOUND(SrcDiscStateData%X4_minus1,2) - IF (.NOT. ALLOCATED(DstDiscStateData%X4_minus1)) THEN - ALLOCATE(DstDiscStateData%X4_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%X4_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%X4_minus1 = SrcDiscStateData%X4_minus1 -ENDIF -IF (ALLOCATED(SrcDiscStateData%Kprime_alpha_minus1)) THEN - i1_l = LBOUND(SrcDiscStateData%Kprime_alpha_minus1,1) - i1_u = UBOUND(SrcDiscStateData%Kprime_alpha_minus1,1) - i2_l = LBOUND(SrcDiscStateData%Kprime_alpha_minus1,2) - i2_u = UBOUND(SrcDiscStateData%Kprime_alpha_minus1,2) - IF (.NOT. ALLOCATED(DstDiscStateData%Kprime_alpha_minus1)) THEN - ALLOCATE(DstDiscStateData%Kprime_alpha_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Kprime_alpha_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%Kprime_alpha_minus1 = SrcDiscStateData%Kprime_alpha_minus1 -ENDIF -IF (ALLOCATED(SrcDiscStateData%Kprime_q_minus1)) THEN - i1_l = LBOUND(SrcDiscStateData%Kprime_q_minus1,1) - i1_u = UBOUND(SrcDiscStateData%Kprime_q_minus1,1) - i2_l = LBOUND(SrcDiscStateData%Kprime_q_minus1,2) - i2_u = UBOUND(SrcDiscStateData%Kprime_q_minus1,2) - IF (.NOT. ALLOCATED(DstDiscStateData%Kprime_q_minus1)) THEN - ALLOCATE(DstDiscStateData%Kprime_q_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Kprime_q_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%Kprime_q_minus1 = SrcDiscStateData%Kprime_q_minus1 -ENDIF -IF (ALLOCATED(SrcDiscStateData%Kprimeprime_q_minus1)) THEN - i1_l = LBOUND(SrcDiscStateData%Kprimeprime_q_minus1,1) - i1_u = UBOUND(SrcDiscStateData%Kprimeprime_q_minus1,1) - i2_l = LBOUND(SrcDiscStateData%Kprimeprime_q_minus1,2) - i2_u = UBOUND(SrcDiscStateData%Kprimeprime_q_minus1,2) - IF (.NOT. ALLOCATED(DstDiscStateData%Kprimeprime_q_minus1)) THEN - ALLOCATE(DstDiscStateData%Kprimeprime_q_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Kprimeprime_q_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%Kprimeprime_q_minus1 = SrcDiscStateData%Kprimeprime_q_minus1 -ENDIF -IF (ALLOCATED(SrcDiscStateData%K3prime_q_minus1)) THEN - i1_l = LBOUND(SrcDiscStateData%K3prime_q_minus1,1) - i1_u = UBOUND(SrcDiscStateData%K3prime_q_minus1,1) - i2_l = LBOUND(SrcDiscStateData%K3prime_q_minus1,2) - i2_u = UBOUND(SrcDiscStateData%K3prime_q_minus1,2) - IF (.NOT. ALLOCATED(DstDiscStateData%K3prime_q_minus1)) THEN - ALLOCATE(DstDiscStateData%K3prime_q_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%K3prime_q_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%K3prime_q_minus1 = SrcDiscStateData%K3prime_q_minus1 -ENDIF -IF (ALLOCATED(SrcDiscStateData%Dp_minus1)) THEN - i1_l = LBOUND(SrcDiscStateData%Dp_minus1,1) - i1_u = UBOUND(SrcDiscStateData%Dp_minus1,1) - i2_l = LBOUND(SrcDiscStateData%Dp_minus1,2) - i2_u = UBOUND(SrcDiscStateData%Dp_minus1,2) - IF (.NOT. ALLOCATED(DstDiscStateData%Dp_minus1)) THEN - ALLOCATE(DstDiscStateData%Dp_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Dp_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%Dp_minus1 = SrcDiscStateData%Dp_minus1 -ENDIF -IF (ALLOCATED(SrcDiscStateData%Cn_pot_minus1)) THEN - i1_l = LBOUND(SrcDiscStateData%Cn_pot_minus1,1) - i1_u = UBOUND(SrcDiscStateData%Cn_pot_minus1,1) - i2_l = LBOUND(SrcDiscStateData%Cn_pot_minus1,2) - i2_u = UBOUND(SrcDiscStateData%Cn_pot_minus1,2) - IF (.NOT. ALLOCATED(DstDiscStateData%Cn_pot_minus1)) THEN - ALLOCATE(DstDiscStateData%Cn_pot_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Cn_pot_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%Cn_pot_minus1 = SrcDiscStateData%Cn_pot_minus1 -ENDIF -IF (ALLOCATED(SrcDiscStateData%fprimeprime_minus1)) THEN - i1_l = LBOUND(SrcDiscStateData%fprimeprime_minus1,1) - i1_u = UBOUND(SrcDiscStateData%fprimeprime_minus1,1) - i2_l = LBOUND(SrcDiscStateData%fprimeprime_minus1,2) - i2_u = UBOUND(SrcDiscStateData%fprimeprime_minus1,2) - IF (.NOT. ALLOCATED(DstDiscStateData%fprimeprime_minus1)) THEN - ALLOCATE(DstDiscStateData%fprimeprime_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%fprimeprime_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%fprimeprime_minus1 = SrcDiscStateData%fprimeprime_minus1 -ENDIF -IF (ALLOCATED(SrcDiscStateData%fprimeprime_c_minus1)) THEN - i1_l = LBOUND(SrcDiscStateData%fprimeprime_c_minus1,1) - i1_u = UBOUND(SrcDiscStateData%fprimeprime_c_minus1,1) - i2_l = LBOUND(SrcDiscStateData%fprimeprime_c_minus1,2) - i2_u = UBOUND(SrcDiscStateData%fprimeprime_c_minus1,2) - IF (.NOT. ALLOCATED(DstDiscStateData%fprimeprime_c_minus1)) THEN - ALLOCATE(DstDiscStateData%fprimeprime_c_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%fprimeprime_c_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%fprimeprime_c_minus1 = SrcDiscStateData%fprimeprime_c_minus1 -ENDIF -IF (ALLOCATED(SrcDiscStateData%fprimeprime_m_minus1)) THEN - i1_l = LBOUND(SrcDiscStateData%fprimeprime_m_minus1,1) - i1_u = UBOUND(SrcDiscStateData%fprimeprime_m_minus1,1) - i2_l = LBOUND(SrcDiscStateData%fprimeprime_m_minus1,2) - i2_u = UBOUND(SrcDiscStateData%fprimeprime_m_minus1,2) - IF (.NOT. ALLOCATED(DstDiscStateData%fprimeprime_m_minus1)) THEN - ALLOCATE(DstDiscStateData%fprimeprime_m_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%fprimeprime_m_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%fprimeprime_m_minus1 = SrcDiscStateData%fprimeprime_m_minus1 -ENDIF -IF (ALLOCATED(SrcDiscStateData%Df_minus1)) THEN - i1_l = LBOUND(SrcDiscStateData%Df_minus1,1) - i1_u = UBOUND(SrcDiscStateData%Df_minus1,1) - i2_l = LBOUND(SrcDiscStateData%Df_minus1,2) - i2_u = UBOUND(SrcDiscStateData%Df_minus1,2) - IF (.NOT. ALLOCATED(DstDiscStateData%Df_minus1)) THEN - ALLOCATE(DstDiscStateData%Df_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Df_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%Df_minus1 = SrcDiscStateData%Df_minus1 -ENDIF -IF (ALLOCATED(SrcDiscStateData%Df_c_minus1)) THEN - i1_l = LBOUND(SrcDiscStateData%Df_c_minus1,1) - i1_u = UBOUND(SrcDiscStateData%Df_c_minus1,1) - i2_l = LBOUND(SrcDiscStateData%Df_c_minus1,2) - i2_u = UBOUND(SrcDiscStateData%Df_c_minus1,2) - IF (.NOT. ALLOCATED(DstDiscStateData%Df_c_minus1)) THEN - ALLOCATE(DstDiscStateData%Df_c_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Df_c_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%Df_c_minus1 = SrcDiscStateData%Df_c_minus1 -ENDIF -IF (ALLOCATED(SrcDiscStateData%Df_m_minus1)) THEN - i1_l = LBOUND(SrcDiscStateData%Df_m_minus1,1) - i1_u = UBOUND(SrcDiscStateData%Df_m_minus1,1) - i2_l = LBOUND(SrcDiscStateData%Df_m_minus1,2) - i2_u = UBOUND(SrcDiscStateData%Df_m_minus1,2) - IF (.NOT. ALLOCATED(DstDiscStateData%Df_m_minus1)) THEN - ALLOCATE(DstDiscStateData%Df_m_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Df_m_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%Df_m_minus1 = SrcDiscStateData%Df_m_minus1 -ENDIF -IF (ALLOCATED(SrcDiscStateData%Dalphaf_minus1)) THEN - i1_l = LBOUND(SrcDiscStateData%Dalphaf_minus1,1) - i1_u = UBOUND(SrcDiscStateData%Dalphaf_minus1,1) - i2_l = LBOUND(SrcDiscStateData%Dalphaf_minus1,2) - i2_u = UBOUND(SrcDiscStateData%Dalphaf_minus1,2) - IF (.NOT. ALLOCATED(DstDiscStateData%Dalphaf_minus1)) THEN - ALLOCATE(DstDiscStateData%Dalphaf_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Dalphaf_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%Dalphaf_minus1 = SrcDiscStateData%Dalphaf_minus1 -ENDIF -IF (ALLOCATED(SrcDiscStateData%alphaf_minus1)) THEN - i1_l = LBOUND(SrcDiscStateData%alphaf_minus1,1) - i1_u = UBOUND(SrcDiscStateData%alphaf_minus1,1) - i2_l = LBOUND(SrcDiscStateData%alphaf_minus1,2) - i2_u = UBOUND(SrcDiscStateData%alphaf_minus1,2) - IF (.NOT. ALLOCATED(DstDiscStateData%alphaf_minus1)) THEN - ALLOCATE(DstDiscStateData%alphaf_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%alphaf_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%alphaf_minus1 = SrcDiscStateData%alphaf_minus1 -ENDIF -IF (ALLOCATED(SrcDiscStateData%fprime_minus1)) THEN - i1_l = LBOUND(SrcDiscStateData%fprime_minus1,1) - i1_u = UBOUND(SrcDiscStateData%fprime_minus1,1) - i2_l = LBOUND(SrcDiscStateData%fprime_minus1,2) - i2_u = UBOUND(SrcDiscStateData%fprime_minus1,2) - IF (.NOT. ALLOCATED(DstDiscStateData%fprime_minus1)) THEN - ALLOCATE(DstDiscStateData%fprime_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%fprime_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%fprime_minus1 = SrcDiscStateData%fprime_minus1 -ENDIF -IF (ALLOCATED(SrcDiscStateData%fprime_c_minus1)) THEN - i1_l = LBOUND(SrcDiscStateData%fprime_c_minus1,1) - i1_u = UBOUND(SrcDiscStateData%fprime_c_minus1,1) - i2_l = LBOUND(SrcDiscStateData%fprime_c_minus1,2) - i2_u = UBOUND(SrcDiscStateData%fprime_c_minus1,2) - IF (.NOT. ALLOCATED(DstDiscStateData%fprime_c_minus1)) THEN - ALLOCATE(DstDiscStateData%fprime_c_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%fprime_c_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%fprime_c_minus1 = SrcDiscStateData%fprime_c_minus1 -ENDIF -IF (ALLOCATED(SrcDiscStateData%fprime_m_minus1)) THEN - i1_l = LBOUND(SrcDiscStateData%fprime_m_minus1,1) - i1_u = UBOUND(SrcDiscStateData%fprime_m_minus1,1) - i2_l = LBOUND(SrcDiscStateData%fprime_m_minus1,2) - i2_u = UBOUND(SrcDiscStateData%fprime_m_minus1,2) - IF (.NOT. ALLOCATED(DstDiscStateData%fprime_m_minus1)) THEN - ALLOCATE(DstDiscStateData%fprime_m_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%fprime_m_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%fprime_m_minus1 = SrcDiscStateData%fprime_m_minus1 -ENDIF -IF (ALLOCATED(SrcDiscStateData%tau_V)) THEN - i1_l = LBOUND(SrcDiscStateData%tau_V,1) - i1_u = UBOUND(SrcDiscStateData%tau_V,1) - i2_l = LBOUND(SrcDiscStateData%tau_V,2) - i2_u = UBOUND(SrcDiscStateData%tau_V,2) - IF (.NOT. ALLOCATED(DstDiscStateData%tau_V)) THEN - ALLOCATE(DstDiscStateData%tau_V(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%tau_V.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%tau_V = SrcDiscStateData%tau_V -ENDIF -IF (ALLOCATED(SrcDiscStateData%tau_V_minus1)) THEN - i1_l = LBOUND(SrcDiscStateData%tau_V_minus1,1) - i1_u = UBOUND(SrcDiscStateData%tau_V_minus1,1) - i2_l = LBOUND(SrcDiscStateData%tau_V_minus1,2) - i2_u = UBOUND(SrcDiscStateData%tau_V_minus1,2) - IF (.NOT. ALLOCATED(DstDiscStateData%tau_V_minus1)) THEN - ALLOCATE(DstDiscStateData%tau_V_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%tau_V_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%tau_V_minus1 = SrcDiscStateData%tau_V_minus1 -ENDIF -IF (ALLOCATED(SrcDiscStateData%Cn_v_minus1)) THEN - i1_l = LBOUND(SrcDiscStateData%Cn_v_minus1,1) - i1_u = UBOUND(SrcDiscStateData%Cn_v_minus1,1) - i2_l = LBOUND(SrcDiscStateData%Cn_v_minus1,2) - i2_u = UBOUND(SrcDiscStateData%Cn_v_minus1,2) - IF (.NOT. ALLOCATED(DstDiscStateData%Cn_v_minus1)) THEN - ALLOCATE(DstDiscStateData%Cn_v_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Cn_v_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%Cn_v_minus1 = SrcDiscStateData%Cn_v_minus1 -ENDIF -IF (ALLOCATED(SrcDiscStateData%C_V_minus1)) THEN - i1_l = LBOUND(SrcDiscStateData%C_V_minus1,1) - i1_u = UBOUND(SrcDiscStateData%C_V_minus1,1) - i2_l = LBOUND(SrcDiscStateData%C_V_minus1,2) - i2_u = UBOUND(SrcDiscStateData%C_V_minus1,2) - IF (.NOT. ALLOCATED(DstDiscStateData%C_V_minus1)) THEN - ALLOCATE(DstDiscStateData%C_V_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%C_V_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%C_V_minus1 = SrcDiscStateData%C_V_minus1 -ENDIF -IF (ALLOCATED(SrcDiscStateData%Cn_prime_minus1)) THEN - i1_l = LBOUND(SrcDiscStateData%Cn_prime_minus1,1) - i1_u = UBOUND(SrcDiscStateData%Cn_prime_minus1,1) - i2_l = LBOUND(SrcDiscStateData%Cn_prime_minus1,2) - i2_u = UBOUND(SrcDiscStateData%Cn_prime_minus1,2) - IF (.NOT. ALLOCATED(DstDiscStateData%Cn_prime_minus1)) THEN - ALLOCATE(DstDiscStateData%Cn_prime_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Cn_prime_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%Cn_prime_minus1 = SrcDiscStateData%Cn_prime_minus1 -ENDIF - END SUBROUTINE UA_CopyDiscState - - SUBROUTINE UA_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(UA_DiscreteStateType), INTENT(INOUT) :: DiscStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'UA_DestroyDiscState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(DiscStateData%alpha_minus1)) THEN - DEALLOCATE(DiscStateData%alpha_minus1) -ENDIF -IF (ALLOCATED(DiscStateData%alpha_filt_minus1)) THEN - DEALLOCATE(DiscStateData%alpha_filt_minus1) -ENDIF -IF (ALLOCATED(DiscStateData%alpha_dot)) THEN - DEALLOCATE(DiscStateData%alpha_dot) -ENDIF -IF (ALLOCATED(DiscStateData%alpha_dot_minus1)) THEN - DEALLOCATE(DiscStateData%alpha_dot_minus1) -ENDIF -IF (ALLOCATED(DiscStateData%q_minus1)) THEN - DEALLOCATE(DiscStateData%q_minus1) -ENDIF -IF (ALLOCATED(DiscStateData%Kalpha_f_minus1)) THEN - DEALLOCATE(DiscStateData%Kalpha_f_minus1) -ENDIF -IF (ALLOCATED(DiscStateData%Kq_f_minus1)) THEN - DEALLOCATE(DiscStateData%Kq_f_minus1) -ENDIF -IF (ALLOCATED(DiscStateData%q_f_minus1)) THEN - DEALLOCATE(DiscStateData%q_f_minus1) -ENDIF -IF (ALLOCATED(DiscStateData%X1_minus1)) THEN - DEALLOCATE(DiscStateData%X1_minus1) -ENDIF -IF (ALLOCATED(DiscStateData%X2_minus1)) THEN - DEALLOCATE(DiscStateData%X2_minus1) -ENDIF -IF (ALLOCATED(DiscStateData%X3_minus1)) THEN - DEALLOCATE(DiscStateData%X3_minus1) -ENDIF -IF (ALLOCATED(DiscStateData%X4_minus1)) THEN - DEALLOCATE(DiscStateData%X4_minus1) -ENDIF -IF (ALLOCATED(DiscStateData%Kprime_alpha_minus1)) THEN - DEALLOCATE(DiscStateData%Kprime_alpha_minus1) -ENDIF -IF (ALLOCATED(DiscStateData%Kprime_q_minus1)) THEN - DEALLOCATE(DiscStateData%Kprime_q_minus1) -ENDIF -IF (ALLOCATED(DiscStateData%Kprimeprime_q_minus1)) THEN - DEALLOCATE(DiscStateData%Kprimeprime_q_minus1) -ENDIF -IF (ALLOCATED(DiscStateData%K3prime_q_minus1)) THEN - DEALLOCATE(DiscStateData%K3prime_q_minus1) -ENDIF -IF (ALLOCATED(DiscStateData%Dp_minus1)) THEN - DEALLOCATE(DiscStateData%Dp_minus1) -ENDIF -IF (ALLOCATED(DiscStateData%Cn_pot_minus1)) THEN - DEALLOCATE(DiscStateData%Cn_pot_minus1) -ENDIF -IF (ALLOCATED(DiscStateData%fprimeprime_minus1)) THEN - DEALLOCATE(DiscStateData%fprimeprime_minus1) -ENDIF -IF (ALLOCATED(DiscStateData%fprimeprime_c_minus1)) THEN - DEALLOCATE(DiscStateData%fprimeprime_c_minus1) -ENDIF -IF (ALLOCATED(DiscStateData%fprimeprime_m_minus1)) THEN - DEALLOCATE(DiscStateData%fprimeprime_m_minus1) -ENDIF -IF (ALLOCATED(DiscStateData%Df_minus1)) THEN - DEALLOCATE(DiscStateData%Df_minus1) -ENDIF -IF (ALLOCATED(DiscStateData%Df_c_minus1)) THEN - DEALLOCATE(DiscStateData%Df_c_minus1) -ENDIF -IF (ALLOCATED(DiscStateData%Df_m_minus1)) THEN - DEALLOCATE(DiscStateData%Df_m_minus1) -ENDIF -IF (ALLOCATED(DiscStateData%Dalphaf_minus1)) THEN - DEALLOCATE(DiscStateData%Dalphaf_minus1) -ENDIF -IF (ALLOCATED(DiscStateData%alphaf_minus1)) THEN - DEALLOCATE(DiscStateData%alphaf_minus1) -ENDIF -IF (ALLOCATED(DiscStateData%fprime_minus1)) THEN - DEALLOCATE(DiscStateData%fprime_minus1) -ENDIF -IF (ALLOCATED(DiscStateData%fprime_c_minus1)) THEN - DEALLOCATE(DiscStateData%fprime_c_minus1) -ENDIF -IF (ALLOCATED(DiscStateData%fprime_m_minus1)) THEN - DEALLOCATE(DiscStateData%fprime_m_minus1) -ENDIF -IF (ALLOCATED(DiscStateData%tau_V)) THEN - DEALLOCATE(DiscStateData%tau_V) -ENDIF -IF (ALLOCATED(DiscStateData%tau_V_minus1)) THEN - DEALLOCATE(DiscStateData%tau_V_minus1) -ENDIF -IF (ALLOCATED(DiscStateData%Cn_v_minus1)) THEN - DEALLOCATE(DiscStateData%Cn_v_minus1) -ENDIF -IF (ALLOCATED(DiscStateData%C_V_minus1)) THEN - DEALLOCATE(DiscStateData%C_V_minus1) -ENDIF -IF (ALLOCATED(DiscStateData%Cn_prime_minus1)) THEN - DEALLOCATE(DiscStateData%Cn_prime_minus1) -ENDIF - END SUBROUTINE UA_DestroyDiscState - - SUBROUTINE UA_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(UA_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 = 'UA_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 ! alpha_minus1 allocated yes/no - IF ( ALLOCATED(InData%alpha_minus1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! alpha_minus1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%alpha_minus1) ! alpha_minus1 - END IF - Int_BufSz = Int_BufSz + 1 ! alpha_filt_minus1 allocated yes/no - IF ( ALLOCATED(InData%alpha_filt_minus1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! alpha_filt_minus1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%alpha_filt_minus1) ! alpha_filt_minus1 - END IF - Int_BufSz = Int_BufSz + 1 ! alpha_dot allocated yes/no - IF ( ALLOCATED(InData%alpha_dot) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! alpha_dot upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%alpha_dot) ! alpha_dot - END IF - Int_BufSz = Int_BufSz + 1 ! alpha_dot_minus1 allocated yes/no - IF ( ALLOCATED(InData%alpha_dot_minus1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! alpha_dot_minus1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%alpha_dot_minus1) ! alpha_dot_minus1 - END IF - Int_BufSz = Int_BufSz + 1 ! q_minus1 allocated yes/no - IF ( ALLOCATED(InData%q_minus1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! q_minus1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%q_minus1) ! q_minus1 - END IF - Int_BufSz = Int_BufSz + 1 ! Kalpha_f_minus1 allocated yes/no - IF ( ALLOCATED(InData%Kalpha_f_minus1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Kalpha_f_minus1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Kalpha_f_minus1) ! Kalpha_f_minus1 - END IF - Int_BufSz = Int_BufSz + 1 ! Kq_f_minus1 allocated yes/no - IF ( ALLOCATED(InData%Kq_f_minus1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Kq_f_minus1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Kq_f_minus1) ! Kq_f_minus1 - END IF - Int_BufSz = Int_BufSz + 1 ! q_f_minus1 allocated yes/no - IF ( ALLOCATED(InData%q_f_minus1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! q_f_minus1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%q_f_minus1) ! q_f_minus1 - END IF - Int_BufSz = Int_BufSz + 1 ! X1_minus1 allocated yes/no - IF ( ALLOCATED(InData%X1_minus1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! X1_minus1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%X1_minus1) ! X1_minus1 - END IF - Int_BufSz = Int_BufSz + 1 ! X2_minus1 allocated yes/no - IF ( ALLOCATED(InData%X2_minus1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! X2_minus1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%X2_minus1) ! X2_minus1 - END IF - Int_BufSz = Int_BufSz + 1 ! X3_minus1 allocated yes/no - IF ( ALLOCATED(InData%X3_minus1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! X3_minus1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%X3_minus1) ! X3_minus1 - END IF - Int_BufSz = Int_BufSz + 1 ! X4_minus1 allocated yes/no - IF ( ALLOCATED(InData%X4_minus1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! X4_minus1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%X4_minus1) ! X4_minus1 - END IF - Int_BufSz = Int_BufSz + 1 ! Kprime_alpha_minus1 allocated yes/no - IF ( ALLOCATED(InData%Kprime_alpha_minus1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Kprime_alpha_minus1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Kprime_alpha_minus1) ! Kprime_alpha_minus1 - END IF - Int_BufSz = Int_BufSz + 1 ! Kprime_q_minus1 allocated yes/no - IF ( ALLOCATED(InData%Kprime_q_minus1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Kprime_q_minus1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Kprime_q_minus1) ! Kprime_q_minus1 - END IF - Int_BufSz = Int_BufSz + 1 ! Kprimeprime_q_minus1 allocated yes/no - IF ( ALLOCATED(InData%Kprimeprime_q_minus1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Kprimeprime_q_minus1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Kprimeprime_q_minus1) ! Kprimeprime_q_minus1 - END IF - Int_BufSz = Int_BufSz + 1 ! K3prime_q_minus1 allocated yes/no - IF ( ALLOCATED(InData%K3prime_q_minus1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! K3prime_q_minus1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%K3prime_q_minus1) ! K3prime_q_minus1 - END IF - Int_BufSz = Int_BufSz + 1 ! Dp_minus1 allocated yes/no - IF ( ALLOCATED(InData%Dp_minus1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Dp_minus1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Dp_minus1) ! Dp_minus1 - END IF - Int_BufSz = Int_BufSz + 1 ! Cn_pot_minus1 allocated yes/no - IF ( ALLOCATED(InData%Cn_pot_minus1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Cn_pot_minus1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Cn_pot_minus1) ! Cn_pot_minus1 - END IF - Int_BufSz = Int_BufSz + 1 ! fprimeprime_minus1 allocated yes/no - IF ( ALLOCATED(InData%fprimeprime_minus1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! fprimeprime_minus1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%fprimeprime_minus1) ! fprimeprime_minus1 - END IF - Int_BufSz = Int_BufSz + 1 ! fprimeprime_c_minus1 allocated yes/no - IF ( ALLOCATED(InData%fprimeprime_c_minus1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! fprimeprime_c_minus1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%fprimeprime_c_minus1) ! fprimeprime_c_minus1 - END IF - Int_BufSz = Int_BufSz + 1 ! fprimeprime_m_minus1 allocated yes/no - IF ( ALLOCATED(InData%fprimeprime_m_minus1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! fprimeprime_m_minus1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%fprimeprime_m_minus1) ! fprimeprime_m_minus1 - END IF - Int_BufSz = Int_BufSz + 1 ! Df_minus1 allocated yes/no - IF ( ALLOCATED(InData%Df_minus1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Df_minus1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Df_minus1) ! Df_minus1 - END IF - Int_BufSz = Int_BufSz + 1 ! Df_c_minus1 allocated yes/no - IF ( ALLOCATED(InData%Df_c_minus1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Df_c_minus1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Df_c_minus1) ! Df_c_minus1 - END IF - Int_BufSz = Int_BufSz + 1 ! Df_m_minus1 allocated yes/no - IF ( ALLOCATED(InData%Df_m_minus1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Df_m_minus1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Df_m_minus1) ! Df_m_minus1 - END IF - Int_BufSz = Int_BufSz + 1 ! Dalphaf_minus1 allocated yes/no - IF ( ALLOCATED(InData%Dalphaf_minus1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Dalphaf_minus1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Dalphaf_minus1) ! Dalphaf_minus1 - END IF - Int_BufSz = Int_BufSz + 1 ! alphaf_minus1 allocated yes/no - IF ( ALLOCATED(InData%alphaf_minus1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! alphaf_minus1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%alphaf_minus1) ! alphaf_minus1 - END IF - Int_BufSz = Int_BufSz + 1 ! fprime_minus1 allocated yes/no - IF ( ALLOCATED(InData%fprime_minus1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! fprime_minus1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%fprime_minus1) ! fprime_minus1 - END IF - Int_BufSz = Int_BufSz + 1 ! fprime_c_minus1 allocated yes/no - IF ( ALLOCATED(InData%fprime_c_minus1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! fprime_c_minus1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%fprime_c_minus1) ! fprime_c_minus1 - END IF - Int_BufSz = Int_BufSz + 1 ! fprime_m_minus1 allocated yes/no - IF ( ALLOCATED(InData%fprime_m_minus1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! fprime_m_minus1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%fprime_m_minus1) ! fprime_m_minus1 - END IF - Int_BufSz = Int_BufSz + 1 ! tau_V allocated yes/no - IF ( ALLOCATED(InData%tau_V) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! tau_V upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%tau_V) ! tau_V - END IF - Int_BufSz = Int_BufSz + 1 ! tau_V_minus1 allocated yes/no - IF ( ALLOCATED(InData%tau_V_minus1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! tau_V_minus1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%tau_V_minus1) ! tau_V_minus1 - END IF - Int_BufSz = Int_BufSz + 1 ! Cn_v_minus1 allocated yes/no - IF ( ALLOCATED(InData%Cn_v_minus1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Cn_v_minus1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Cn_v_minus1) ! Cn_v_minus1 - END IF - Int_BufSz = Int_BufSz + 1 ! C_V_minus1 allocated yes/no - IF ( ALLOCATED(InData%C_V_minus1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! C_V_minus1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%C_V_minus1) ! C_V_minus1 - END IF - Int_BufSz = Int_BufSz + 1 ! Cn_prime_minus1 allocated yes/no - IF ( ALLOCATED(InData%Cn_prime_minus1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Cn_prime_minus1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Cn_prime_minus1) ! Cn_prime_minus1 - 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%alpha_minus1) ) THEN - 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_minus1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%alpha_minus1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%alpha_minus1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%alpha_minus1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%alpha_minus1,2), UBOUND(InData%alpha_minus1,2) - DO i1 = LBOUND(InData%alpha_minus1,1), UBOUND(InData%alpha_minus1,1) - ReKiBuf(Re_Xferred) = InData%alpha_minus1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%alpha_filt_minus1) ) THEN - 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_filt_minus1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%alpha_filt_minus1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%alpha_filt_minus1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%alpha_filt_minus1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%alpha_filt_minus1,2), UBOUND(InData%alpha_filt_minus1,2) - DO i1 = LBOUND(InData%alpha_filt_minus1,1), UBOUND(InData%alpha_filt_minus1,1) - ReKiBuf(Re_Xferred) = InData%alpha_filt_minus1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%alpha_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%alpha_dot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%alpha_dot,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%alpha_dot,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%alpha_dot,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%alpha_dot,2), UBOUND(InData%alpha_dot,2) - DO i1 = LBOUND(InData%alpha_dot,1), UBOUND(InData%alpha_dot,1) - ReKiBuf(Re_Xferred) = InData%alpha_dot(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%alpha_dot_minus1) ) THEN - 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_dot_minus1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%alpha_dot_minus1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%alpha_dot_minus1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%alpha_dot_minus1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%alpha_dot_minus1,2), UBOUND(InData%alpha_dot_minus1,2) - DO i1 = LBOUND(InData%alpha_dot_minus1,1), UBOUND(InData%alpha_dot_minus1,1) - ReKiBuf(Re_Xferred) = InData%alpha_dot_minus1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%q_minus1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%q_minus1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%q_minus1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%q_minus1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%q_minus1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%q_minus1,2), UBOUND(InData%q_minus1,2) - DO i1 = LBOUND(InData%q_minus1,1), UBOUND(InData%q_minus1,1) - ReKiBuf(Re_Xferred) = InData%q_minus1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Kalpha_f_minus1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Kalpha_f_minus1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Kalpha_f_minus1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Kalpha_f_minus1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Kalpha_f_minus1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Kalpha_f_minus1,2), UBOUND(InData%Kalpha_f_minus1,2) - DO i1 = LBOUND(InData%Kalpha_f_minus1,1), UBOUND(InData%Kalpha_f_minus1,1) - ReKiBuf(Re_Xferred) = InData%Kalpha_f_minus1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Kq_f_minus1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Kq_f_minus1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Kq_f_minus1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Kq_f_minus1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Kq_f_minus1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Kq_f_minus1,2), UBOUND(InData%Kq_f_minus1,2) - DO i1 = LBOUND(InData%Kq_f_minus1,1), UBOUND(InData%Kq_f_minus1,1) - ReKiBuf(Re_Xferred) = InData%Kq_f_minus1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%q_f_minus1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%q_f_minus1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%q_f_minus1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%q_f_minus1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%q_f_minus1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%q_f_minus1,2), UBOUND(InData%q_f_minus1,2) - DO i1 = LBOUND(InData%q_f_minus1,1), UBOUND(InData%q_f_minus1,1) - ReKiBuf(Re_Xferred) = InData%q_f_minus1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%X1_minus1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%X1_minus1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%X1_minus1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%X1_minus1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%X1_minus1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%X1_minus1,2), UBOUND(InData%X1_minus1,2) - DO i1 = LBOUND(InData%X1_minus1,1), UBOUND(InData%X1_minus1,1) - ReKiBuf(Re_Xferred) = InData%X1_minus1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%X2_minus1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%X2_minus1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%X2_minus1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%X2_minus1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%X2_minus1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%X2_minus1,2), UBOUND(InData%X2_minus1,2) - DO i1 = LBOUND(InData%X2_minus1,1), UBOUND(InData%X2_minus1,1) - ReKiBuf(Re_Xferred) = InData%X2_minus1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%X3_minus1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%X3_minus1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%X3_minus1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%X3_minus1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%X3_minus1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%X3_minus1,2), UBOUND(InData%X3_minus1,2) - DO i1 = LBOUND(InData%X3_minus1,1), UBOUND(InData%X3_minus1,1) - ReKiBuf(Re_Xferred) = InData%X3_minus1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%X4_minus1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%X4_minus1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%X4_minus1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%X4_minus1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%X4_minus1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%X4_minus1,2), UBOUND(InData%X4_minus1,2) - DO i1 = LBOUND(InData%X4_minus1,1), UBOUND(InData%X4_minus1,1) - ReKiBuf(Re_Xferred) = InData%X4_minus1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Kprime_alpha_minus1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Kprime_alpha_minus1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Kprime_alpha_minus1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Kprime_alpha_minus1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Kprime_alpha_minus1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Kprime_alpha_minus1,2), UBOUND(InData%Kprime_alpha_minus1,2) - DO i1 = LBOUND(InData%Kprime_alpha_minus1,1), UBOUND(InData%Kprime_alpha_minus1,1) - ReKiBuf(Re_Xferred) = InData%Kprime_alpha_minus1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Kprime_q_minus1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Kprime_q_minus1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Kprime_q_minus1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Kprime_q_minus1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Kprime_q_minus1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Kprime_q_minus1,2), UBOUND(InData%Kprime_q_minus1,2) - DO i1 = LBOUND(InData%Kprime_q_minus1,1), UBOUND(InData%Kprime_q_minus1,1) - ReKiBuf(Re_Xferred) = InData%Kprime_q_minus1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Kprimeprime_q_minus1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Kprimeprime_q_minus1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Kprimeprime_q_minus1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Kprimeprime_q_minus1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Kprimeprime_q_minus1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Kprimeprime_q_minus1,2), UBOUND(InData%Kprimeprime_q_minus1,2) - DO i1 = LBOUND(InData%Kprimeprime_q_minus1,1), UBOUND(InData%Kprimeprime_q_minus1,1) - ReKiBuf(Re_Xferred) = InData%Kprimeprime_q_minus1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%K3prime_q_minus1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%K3prime_q_minus1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%K3prime_q_minus1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%K3prime_q_minus1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%K3prime_q_minus1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%K3prime_q_minus1,2), UBOUND(InData%K3prime_q_minus1,2) - DO i1 = LBOUND(InData%K3prime_q_minus1,1), UBOUND(InData%K3prime_q_minus1,1) - ReKiBuf(Re_Xferred) = InData%K3prime_q_minus1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Dp_minus1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Dp_minus1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Dp_minus1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Dp_minus1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Dp_minus1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Dp_minus1,2), UBOUND(InData%Dp_minus1,2) - DO i1 = LBOUND(InData%Dp_minus1,1), UBOUND(InData%Dp_minus1,1) - ReKiBuf(Re_Xferred) = InData%Dp_minus1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Cn_pot_minus1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Cn_pot_minus1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cn_pot_minus1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Cn_pot_minus1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cn_pot_minus1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Cn_pot_minus1,2), UBOUND(InData%Cn_pot_minus1,2) - DO i1 = LBOUND(InData%Cn_pot_minus1,1), UBOUND(InData%Cn_pot_minus1,1) - ReKiBuf(Re_Xferred) = InData%Cn_pot_minus1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%fprimeprime_minus1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%fprimeprime_minus1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fprimeprime_minus1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%fprimeprime_minus1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fprimeprime_minus1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%fprimeprime_minus1,2), UBOUND(InData%fprimeprime_minus1,2) - DO i1 = LBOUND(InData%fprimeprime_minus1,1), UBOUND(InData%fprimeprime_minus1,1) - ReKiBuf(Re_Xferred) = InData%fprimeprime_minus1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%fprimeprime_c_minus1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%fprimeprime_c_minus1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fprimeprime_c_minus1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%fprimeprime_c_minus1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fprimeprime_c_minus1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%fprimeprime_c_minus1,2), UBOUND(InData%fprimeprime_c_minus1,2) - DO i1 = LBOUND(InData%fprimeprime_c_minus1,1), UBOUND(InData%fprimeprime_c_minus1,1) - ReKiBuf(Re_Xferred) = InData%fprimeprime_c_minus1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%fprimeprime_m_minus1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%fprimeprime_m_minus1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fprimeprime_m_minus1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%fprimeprime_m_minus1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fprimeprime_m_minus1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%fprimeprime_m_minus1,2), UBOUND(InData%fprimeprime_m_minus1,2) - DO i1 = LBOUND(InData%fprimeprime_m_minus1,1), UBOUND(InData%fprimeprime_m_minus1,1) - ReKiBuf(Re_Xferred) = InData%fprimeprime_m_minus1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Df_minus1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Df_minus1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Df_minus1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Df_minus1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Df_minus1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Df_minus1,2), UBOUND(InData%Df_minus1,2) - DO i1 = LBOUND(InData%Df_minus1,1), UBOUND(InData%Df_minus1,1) - ReKiBuf(Re_Xferred) = InData%Df_minus1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Df_c_minus1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Df_c_minus1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Df_c_minus1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Df_c_minus1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Df_c_minus1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Df_c_minus1,2), UBOUND(InData%Df_c_minus1,2) - DO i1 = LBOUND(InData%Df_c_minus1,1), UBOUND(InData%Df_c_minus1,1) - ReKiBuf(Re_Xferred) = InData%Df_c_minus1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Df_m_minus1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Df_m_minus1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Df_m_minus1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Df_m_minus1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Df_m_minus1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Df_m_minus1,2), UBOUND(InData%Df_m_minus1,2) - DO i1 = LBOUND(InData%Df_m_minus1,1), UBOUND(InData%Df_m_minus1,1) - ReKiBuf(Re_Xferred) = InData%Df_m_minus1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Dalphaf_minus1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Dalphaf_minus1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Dalphaf_minus1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Dalphaf_minus1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Dalphaf_minus1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Dalphaf_minus1,2), UBOUND(InData%Dalphaf_minus1,2) - DO i1 = LBOUND(InData%Dalphaf_minus1,1), UBOUND(InData%Dalphaf_minus1,1) - ReKiBuf(Re_Xferred) = InData%Dalphaf_minus1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%alphaf_minus1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%alphaf_minus1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%alphaf_minus1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%alphaf_minus1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%alphaf_minus1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%alphaf_minus1,2), UBOUND(InData%alphaf_minus1,2) - DO i1 = LBOUND(InData%alphaf_minus1,1), UBOUND(InData%alphaf_minus1,1) - ReKiBuf(Re_Xferred) = InData%alphaf_minus1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%fprime_minus1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%fprime_minus1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fprime_minus1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%fprime_minus1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fprime_minus1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%fprime_minus1,2), UBOUND(InData%fprime_minus1,2) - DO i1 = LBOUND(InData%fprime_minus1,1), UBOUND(InData%fprime_minus1,1) - ReKiBuf(Re_Xferred) = InData%fprime_minus1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%fprime_c_minus1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%fprime_c_minus1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fprime_c_minus1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%fprime_c_minus1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fprime_c_minus1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%fprime_c_minus1,2), UBOUND(InData%fprime_c_minus1,2) - DO i1 = LBOUND(InData%fprime_c_minus1,1), UBOUND(InData%fprime_c_minus1,1) - ReKiBuf(Re_Xferred) = InData%fprime_c_minus1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%fprime_m_minus1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%fprime_m_minus1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fprime_m_minus1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%fprime_m_minus1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fprime_m_minus1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%fprime_m_minus1,2), UBOUND(InData%fprime_m_minus1,2) - DO i1 = LBOUND(InData%fprime_m_minus1,1), UBOUND(InData%fprime_m_minus1,1) - ReKiBuf(Re_Xferred) = InData%fprime_m_minus1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%tau_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%tau_V,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%tau_V,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%tau_V,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%tau_V,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%tau_V,2), UBOUND(InData%tau_V,2) - DO i1 = LBOUND(InData%tau_V,1), UBOUND(InData%tau_V,1) - ReKiBuf(Re_Xferred) = InData%tau_V(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%tau_V_minus1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%tau_V_minus1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%tau_V_minus1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%tau_V_minus1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%tau_V_minus1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%tau_V_minus1,2), UBOUND(InData%tau_V_minus1,2) - DO i1 = LBOUND(InData%tau_V_minus1,1), UBOUND(InData%tau_V_minus1,1) - ReKiBuf(Re_Xferred) = InData%tau_V_minus1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Cn_v_minus1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Cn_v_minus1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cn_v_minus1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Cn_v_minus1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cn_v_minus1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Cn_v_minus1,2), UBOUND(InData%Cn_v_minus1,2) - DO i1 = LBOUND(InData%Cn_v_minus1,1), UBOUND(InData%Cn_v_minus1,1) - ReKiBuf(Re_Xferred) = InData%Cn_v_minus1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%C_V_minus1) ) THEN - 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_V_minus1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C_V_minus1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%C_V_minus1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C_V_minus1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%C_V_minus1,2), UBOUND(InData%C_V_minus1,2) - DO i1 = LBOUND(InData%C_V_minus1,1), UBOUND(InData%C_V_minus1,1) - ReKiBuf(Re_Xferred) = InData%C_V_minus1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Cn_prime_minus1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Cn_prime_minus1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cn_prime_minus1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Cn_prime_minus1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cn_prime_minus1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Cn_prime_minus1,2), UBOUND(InData%Cn_prime_minus1,2) - DO i1 = LBOUND(InData%Cn_prime_minus1,1), UBOUND(InData%Cn_prime_minus1,1) - ReKiBuf(Re_Xferred) = InData%Cn_prime_minus1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE UA_PackDiscState - - SUBROUTINE UA_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(UA_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 = 'UA_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 ! alpha_minus1 not allocated - Int_Xferred = Int_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_minus1)) DEALLOCATE(OutData%alpha_minus1) - ALLOCATE(OutData%alpha_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%alpha_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%alpha_minus1,2), UBOUND(OutData%alpha_minus1,2) - DO i1 = LBOUND(OutData%alpha_minus1,1), UBOUND(OutData%alpha_minus1,1) - OutData%alpha_minus1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! alpha_filt_minus1 not allocated - Int_Xferred = Int_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_filt_minus1)) DEALLOCATE(OutData%alpha_filt_minus1) - ALLOCATE(OutData%alpha_filt_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%alpha_filt_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%alpha_filt_minus1,2), UBOUND(OutData%alpha_filt_minus1,2) - DO i1 = LBOUND(OutData%alpha_filt_minus1,1), UBOUND(OutData%alpha_filt_minus1,1) - OutData%alpha_filt_minus1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! alpha_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 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%alpha_dot)) DEALLOCATE(OutData%alpha_dot) - ALLOCATE(OutData%alpha_dot(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%alpha_dot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%alpha_dot,2), UBOUND(OutData%alpha_dot,2) - DO i1 = LBOUND(OutData%alpha_dot,1), UBOUND(OutData%alpha_dot,1) - OutData%alpha_dot(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! alpha_dot_minus1 not allocated - Int_Xferred = Int_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_dot_minus1)) DEALLOCATE(OutData%alpha_dot_minus1) - ALLOCATE(OutData%alpha_dot_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%alpha_dot_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%alpha_dot_minus1,2), UBOUND(OutData%alpha_dot_minus1,2) - DO i1 = LBOUND(OutData%alpha_dot_minus1,1), UBOUND(OutData%alpha_dot_minus1,1) - OutData%alpha_dot_minus1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! q_minus1 not allocated - Int_Xferred = Int_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%q_minus1)) DEALLOCATE(OutData%q_minus1) - ALLOCATE(OutData%q_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%q_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%q_minus1,2), UBOUND(OutData%q_minus1,2) - DO i1 = LBOUND(OutData%q_minus1,1), UBOUND(OutData%q_minus1,1) - OutData%q_minus1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Kalpha_f_minus1 not allocated - Int_Xferred = Int_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%Kalpha_f_minus1)) DEALLOCATE(OutData%Kalpha_f_minus1) - ALLOCATE(OutData%Kalpha_f_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Kalpha_f_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Kalpha_f_minus1,2), UBOUND(OutData%Kalpha_f_minus1,2) - DO i1 = LBOUND(OutData%Kalpha_f_minus1,1), UBOUND(OutData%Kalpha_f_minus1,1) - OutData%Kalpha_f_minus1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Kq_f_minus1 not allocated - Int_Xferred = Int_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%Kq_f_minus1)) DEALLOCATE(OutData%Kq_f_minus1) - ALLOCATE(OutData%Kq_f_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Kq_f_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Kq_f_minus1,2), UBOUND(OutData%Kq_f_minus1,2) - DO i1 = LBOUND(OutData%Kq_f_minus1,1), UBOUND(OutData%Kq_f_minus1,1) - OutData%Kq_f_minus1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! q_f_minus1 not allocated - Int_Xferred = Int_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%q_f_minus1)) DEALLOCATE(OutData%q_f_minus1) - ALLOCATE(OutData%q_f_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%q_f_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%q_f_minus1,2), UBOUND(OutData%q_f_minus1,2) - DO i1 = LBOUND(OutData%q_f_minus1,1), UBOUND(OutData%q_f_minus1,1) - OutData%q_f_minus1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! X1_minus1 not allocated - Int_Xferred = Int_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%X1_minus1)) DEALLOCATE(OutData%X1_minus1) - ALLOCATE(OutData%X1_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%X1_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%X1_minus1,2), UBOUND(OutData%X1_minus1,2) - DO i1 = LBOUND(OutData%X1_minus1,1), UBOUND(OutData%X1_minus1,1) - OutData%X1_minus1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! X2_minus1 not allocated - Int_Xferred = Int_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%X2_minus1)) DEALLOCATE(OutData%X2_minus1) - ALLOCATE(OutData%X2_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%X2_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%X2_minus1,2), UBOUND(OutData%X2_minus1,2) - DO i1 = LBOUND(OutData%X2_minus1,1), UBOUND(OutData%X2_minus1,1) - OutData%X2_minus1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! X3_minus1 not allocated - Int_Xferred = Int_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%X3_minus1)) DEALLOCATE(OutData%X3_minus1) - ALLOCATE(OutData%X3_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%X3_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%X3_minus1,2), UBOUND(OutData%X3_minus1,2) - DO i1 = LBOUND(OutData%X3_minus1,1), UBOUND(OutData%X3_minus1,1) - OutData%X3_minus1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! X4_minus1 not allocated - Int_Xferred = Int_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%X4_minus1)) DEALLOCATE(OutData%X4_minus1) - ALLOCATE(OutData%X4_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%X4_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%X4_minus1,2), UBOUND(OutData%X4_minus1,2) - DO i1 = LBOUND(OutData%X4_minus1,1), UBOUND(OutData%X4_minus1,1) - OutData%X4_minus1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Kprime_alpha_minus1 not allocated - Int_Xferred = Int_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%Kprime_alpha_minus1)) DEALLOCATE(OutData%Kprime_alpha_minus1) - ALLOCATE(OutData%Kprime_alpha_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Kprime_alpha_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Kprime_alpha_minus1,2), UBOUND(OutData%Kprime_alpha_minus1,2) - DO i1 = LBOUND(OutData%Kprime_alpha_minus1,1), UBOUND(OutData%Kprime_alpha_minus1,1) - OutData%Kprime_alpha_minus1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Kprime_q_minus1 not allocated - Int_Xferred = Int_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%Kprime_q_minus1)) DEALLOCATE(OutData%Kprime_q_minus1) - ALLOCATE(OutData%Kprime_q_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Kprime_q_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Kprime_q_minus1,2), UBOUND(OutData%Kprime_q_minus1,2) - DO i1 = LBOUND(OutData%Kprime_q_minus1,1), UBOUND(OutData%Kprime_q_minus1,1) - OutData%Kprime_q_minus1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Kprimeprime_q_minus1 not allocated - Int_Xferred = Int_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%Kprimeprime_q_minus1)) DEALLOCATE(OutData%Kprimeprime_q_minus1) - ALLOCATE(OutData%Kprimeprime_q_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Kprimeprime_q_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Kprimeprime_q_minus1,2), UBOUND(OutData%Kprimeprime_q_minus1,2) - DO i1 = LBOUND(OutData%Kprimeprime_q_minus1,1), UBOUND(OutData%Kprimeprime_q_minus1,1) - OutData%Kprimeprime_q_minus1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! K3prime_q_minus1 not allocated - Int_Xferred = Int_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%K3prime_q_minus1)) DEALLOCATE(OutData%K3prime_q_minus1) - ALLOCATE(OutData%K3prime_q_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%K3prime_q_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%K3prime_q_minus1,2), UBOUND(OutData%K3prime_q_minus1,2) - DO i1 = LBOUND(OutData%K3prime_q_minus1,1), UBOUND(OutData%K3prime_q_minus1,1) - OutData%K3prime_q_minus1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Dp_minus1 not allocated - Int_Xferred = Int_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%Dp_minus1)) DEALLOCATE(OutData%Dp_minus1) - ALLOCATE(OutData%Dp_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Dp_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Dp_minus1,2), UBOUND(OutData%Dp_minus1,2) - DO i1 = LBOUND(OutData%Dp_minus1,1), UBOUND(OutData%Dp_minus1,1) - OutData%Dp_minus1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Cn_pot_minus1 not allocated - Int_Xferred = Int_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%Cn_pot_minus1)) DEALLOCATE(OutData%Cn_pot_minus1) - ALLOCATE(OutData%Cn_pot_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cn_pot_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Cn_pot_minus1,2), UBOUND(OutData%Cn_pot_minus1,2) - DO i1 = LBOUND(OutData%Cn_pot_minus1,1), UBOUND(OutData%Cn_pot_minus1,1) - OutData%Cn_pot_minus1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! fprimeprime_minus1 not allocated - Int_Xferred = Int_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%fprimeprime_minus1)) DEALLOCATE(OutData%fprimeprime_minus1) - ALLOCATE(OutData%fprimeprime_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%fprimeprime_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%fprimeprime_minus1,2), UBOUND(OutData%fprimeprime_minus1,2) - DO i1 = LBOUND(OutData%fprimeprime_minus1,1), UBOUND(OutData%fprimeprime_minus1,1) - OutData%fprimeprime_minus1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! fprimeprime_c_minus1 not allocated - Int_Xferred = Int_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%fprimeprime_c_minus1)) DEALLOCATE(OutData%fprimeprime_c_minus1) - ALLOCATE(OutData%fprimeprime_c_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%fprimeprime_c_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%fprimeprime_c_minus1,2), UBOUND(OutData%fprimeprime_c_minus1,2) - DO i1 = LBOUND(OutData%fprimeprime_c_minus1,1), UBOUND(OutData%fprimeprime_c_minus1,1) - OutData%fprimeprime_c_minus1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! fprimeprime_m_minus1 not allocated - Int_Xferred = Int_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%fprimeprime_m_minus1)) DEALLOCATE(OutData%fprimeprime_m_minus1) - ALLOCATE(OutData%fprimeprime_m_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%fprimeprime_m_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%fprimeprime_m_minus1,2), UBOUND(OutData%fprimeprime_m_minus1,2) - DO i1 = LBOUND(OutData%fprimeprime_m_minus1,1), UBOUND(OutData%fprimeprime_m_minus1,1) - OutData%fprimeprime_m_minus1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Df_minus1 not allocated - Int_Xferred = Int_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%Df_minus1)) DEALLOCATE(OutData%Df_minus1) - ALLOCATE(OutData%Df_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Df_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Df_minus1,2), UBOUND(OutData%Df_minus1,2) - DO i1 = LBOUND(OutData%Df_minus1,1), UBOUND(OutData%Df_minus1,1) - OutData%Df_minus1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Df_c_minus1 not allocated - Int_Xferred = Int_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%Df_c_minus1)) DEALLOCATE(OutData%Df_c_minus1) - ALLOCATE(OutData%Df_c_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Df_c_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Df_c_minus1,2), UBOUND(OutData%Df_c_minus1,2) - DO i1 = LBOUND(OutData%Df_c_minus1,1), UBOUND(OutData%Df_c_minus1,1) - OutData%Df_c_minus1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Df_m_minus1 not allocated - Int_Xferred = Int_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%Df_m_minus1)) DEALLOCATE(OutData%Df_m_minus1) - ALLOCATE(OutData%Df_m_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Df_m_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Df_m_minus1,2), UBOUND(OutData%Df_m_minus1,2) - DO i1 = LBOUND(OutData%Df_m_minus1,1), UBOUND(OutData%Df_m_minus1,1) - OutData%Df_m_minus1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Dalphaf_minus1 not allocated - Int_Xferred = Int_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%Dalphaf_minus1)) DEALLOCATE(OutData%Dalphaf_minus1) - ALLOCATE(OutData%Dalphaf_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Dalphaf_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Dalphaf_minus1,2), UBOUND(OutData%Dalphaf_minus1,2) - DO i1 = LBOUND(OutData%Dalphaf_minus1,1), UBOUND(OutData%Dalphaf_minus1,1) - OutData%Dalphaf_minus1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! alphaf_minus1 not allocated - Int_Xferred = Int_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%alphaf_minus1)) DEALLOCATE(OutData%alphaf_minus1) - ALLOCATE(OutData%alphaf_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%alphaf_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%alphaf_minus1,2), UBOUND(OutData%alphaf_minus1,2) - DO i1 = LBOUND(OutData%alphaf_minus1,1), UBOUND(OutData%alphaf_minus1,1) - OutData%alphaf_minus1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! fprime_minus1 not allocated - Int_Xferred = Int_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%fprime_minus1)) DEALLOCATE(OutData%fprime_minus1) - ALLOCATE(OutData%fprime_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%fprime_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%fprime_minus1,2), UBOUND(OutData%fprime_minus1,2) - DO i1 = LBOUND(OutData%fprime_minus1,1), UBOUND(OutData%fprime_minus1,1) - OutData%fprime_minus1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! fprime_c_minus1 not allocated - Int_Xferred = Int_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%fprime_c_minus1)) DEALLOCATE(OutData%fprime_c_minus1) - ALLOCATE(OutData%fprime_c_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%fprime_c_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%fprime_c_minus1,2), UBOUND(OutData%fprime_c_minus1,2) - DO i1 = LBOUND(OutData%fprime_c_minus1,1), UBOUND(OutData%fprime_c_minus1,1) - OutData%fprime_c_minus1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! fprime_m_minus1 not allocated - Int_Xferred = Int_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%fprime_m_minus1)) DEALLOCATE(OutData%fprime_m_minus1) - ALLOCATE(OutData%fprime_m_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%fprime_m_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%fprime_m_minus1,2), UBOUND(OutData%fprime_m_minus1,2) - DO i1 = LBOUND(OutData%fprime_m_minus1,1), UBOUND(OutData%fprime_m_minus1,1) - OutData%fprime_m_minus1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! tau_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 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%tau_V)) DEALLOCATE(OutData%tau_V) - ALLOCATE(OutData%tau_V(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%tau_V.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%tau_V,2), UBOUND(OutData%tau_V,2) - DO i1 = LBOUND(OutData%tau_V,1), UBOUND(OutData%tau_V,1) - OutData%tau_V(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! tau_V_minus1 not allocated - Int_Xferred = Int_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%tau_V_minus1)) DEALLOCATE(OutData%tau_V_minus1) - ALLOCATE(OutData%tau_V_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%tau_V_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%tau_V_minus1,2), UBOUND(OutData%tau_V_minus1,2) - DO i1 = LBOUND(OutData%tau_V_minus1,1), UBOUND(OutData%tau_V_minus1,1) - OutData%tau_V_minus1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Cn_v_minus1 not allocated - Int_Xferred = Int_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%Cn_v_minus1)) DEALLOCATE(OutData%Cn_v_minus1) - ALLOCATE(OutData%Cn_v_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cn_v_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Cn_v_minus1,2), UBOUND(OutData%Cn_v_minus1,2) - DO i1 = LBOUND(OutData%Cn_v_minus1,1), UBOUND(OutData%Cn_v_minus1,1) - OutData%Cn_v_minus1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! C_V_minus1 not allocated - Int_Xferred = Int_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_V_minus1)) DEALLOCATE(OutData%C_V_minus1) - ALLOCATE(OutData%C_V_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%C_V_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%C_V_minus1,2), UBOUND(OutData%C_V_minus1,2) - DO i1 = LBOUND(OutData%C_V_minus1,1), UBOUND(OutData%C_V_minus1,1) - OutData%C_V_minus1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Cn_prime_minus1 not allocated - Int_Xferred = Int_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%Cn_prime_minus1)) DEALLOCATE(OutData%Cn_prime_minus1) - ALLOCATE(OutData%Cn_prime_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cn_prime_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Cn_prime_minus1,2), UBOUND(OutData%Cn_prime_minus1,2) - DO i1 = LBOUND(OutData%Cn_prime_minus1,1), UBOUND(OutData%Cn_prime_minus1,1) - OutData%Cn_prime_minus1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE UA_UnPackDiscState - - SUBROUTINE UA_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(UA_ConstraintStateType), INTENT(IN) :: SrcConstrStateData - TYPE(UA_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 = 'UA_CopyConstrState' -! + ErrMsg = '' + DstKelvinChainTypeData%Cn_prime = SrcKelvinChainTypeData%Cn_prime + DstKelvinChainTypeData%C_nalpha_circ = SrcKelvinChainTypeData%C_nalpha_circ + DstKelvinChainTypeData%Kalpha_f = SrcKelvinChainTypeData%Kalpha_f + DstKelvinChainTypeData%Kq_f = SrcKelvinChainTypeData%Kq_f + DstKelvinChainTypeData%alpha_filt_cur = SrcKelvinChainTypeData%alpha_filt_cur + DstKelvinChainTypeData%alpha_e = SrcKelvinChainTypeData%alpha_e + DstKelvinChainTypeData%dalpha0 = SrcKelvinChainTypeData%dalpha0 + DstKelvinChainTypeData%alpha_f = SrcKelvinChainTypeData%alpha_f + DstKelvinChainTypeData%Kq = SrcKelvinChainTypeData%Kq + DstKelvinChainTypeData%q_cur = SrcKelvinChainTypeData%q_cur + DstKelvinChainTypeData%q_f_cur = SrcKelvinChainTypeData%q_f_cur + DstKelvinChainTypeData%X1 = SrcKelvinChainTypeData%X1 + DstKelvinChainTypeData%X2 = SrcKelvinChainTypeData%X2 + DstKelvinChainTypeData%X3 = SrcKelvinChainTypeData%X3 + DstKelvinChainTypeData%X4 = SrcKelvinChainTypeData%X4 + DstKelvinChainTypeData%Kprime_alpha = SrcKelvinChainTypeData%Kprime_alpha + DstKelvinChainTypeData%Kprime_q = SrcKelvinChainTypeData%Kprime_q + DstKelvinChainTypeData%K3prime_q = SrcKelvinChainTypeData%K3prime_q + DstKelvinChainTypeData%Kprimeprime_q = SrcKelvinChainTypeData%Kprimeprime_q + DstKelvinChainTypeData%Dp = SrcKelvinChainTypeData%Dp + DstKelvinChainTypeData%Cn_pot = SrcKelvinChainTypeData%Cn_pot + DstKelvinChainTypeData%Cc_pot = SrcKelvinChainTypeData%Cc_pot + DstKelvinChainTypeData%Cn_alpha_q_circ = SrcKelvinChainTypeData%Cn_alpha_q_circ + DstKelvinChainTypeData%Cn_alpha_q_nc = SrcKelvinChainTypeData%Cn_alpha_q_nc + DstKelvinChainTypeData%Cm_q_circ = SrcKelvinChainTypeData%Cm_q_circ + DstKelvinChainTypeData%Cn_alpha_nc = SrcKelvinChainTypeData%Cn_alpha_nc + DstKelvinChainTypeData%Cn_q_circ = SrcKelvinChainTypeData%Cn_q_circ + DstKelvinChainTypeData%Cn_q_nc = SrcKelvinChainTypeData%Cn_q_nc + DstKelvinChainTypeData%Cm_q_nc = SrcKelvinChainTypeData%Cm_q_nc + DstKelvinChainTypeData%fprimeprime = SrcKelvinChainTypeData%fprimeprime + DstKelvinChainTypeData%Df = SrcKelvinChainTypeData%Df + DstKelvinChainTypeData%Df_c = SrcKelvinChainTypeData%Df_c + DstKelvinChainTypeData%Df_m = SrcKelvinChainTypeData%Df_m + DstKelvinChainTypeData%Dalphaf = SrcKelvinChainTypeData%Dalphaf + DstKelvinChainTypeData%fprime = SrcKelvinChainTypeData%fprime + DstKelvinChainTypeData%fprime_c = SrcKelvinChainTypeData%fprime_c + DstKelvinChainTypeData%fprimeprime_c = SrcKelvinChainTypeData%fprimeprime_c + DstKelvinChainTypeData%fprime_m = SrcKelvinChainTypeData%fprime_m + DstKelvinChainTypeData%fprimeprime_m = SrcKelvinChainTypeData%fprimeprime_m + DstKelvinChainTypeData%Cn_v = SrcKelvinChainTypeData%Cn_v + DstKelvinChainTypeData%C_V = SrcKelvinChainTypeData%C_V + DstKelvinChainTypeData%Cn_FS = SrcKelvinChainTypeData%Cn_FS + DstKelvinChainTypeData%T_f = SrcKelvinChainTypeData%T_f + DstKelvinChainTypeData%T_fc = SrcKelvinChainTypeData%T_fc + DstKelvinChainTypeData%T_fm = SrcKelvinChainTypeData%T_fm + DstKelvinChainTypeData%T_V = SrcKelvinChainTypeData%T_V + DstKelvinChainTypeData%k_alpha = SrcKelvinChainTypeData%k_alpha + DstKelvinChainTypeData%k_q = SrcKelvinChainTypeData%k_q + DstKelvinChainTypeData%T_alpha = SrcKelvinChainTypeData%T_alpha + DstKelvinChainTypeData%T_q = SrcKelvinChainTypeData%T_q + DstKelvinChainTypeData%ds = SrcKelvinChainTypeData%ds +end subroutine + +subroutine UA_DestroyKelvinChainType(KelvinChainTypeData, ErrStat, ErrMsg) + type(UA_KelvinChainType), intent(inout) :: KelvinChainTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'UA_DestroyKelvinChainType' ErrStat = ErrID_None - ErrMsg = "" - DstConstrStateData%DummyConstraintState = SrcConstrStateData%DummyConstraintState - END SUBROUTINE UA_CopyConstrState - - SUBROUTINE UA_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(UA_ConstraintStateType), INTENT(INOUT) :: ConstrStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'UA_DestroyConstrState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE UA_DestroyConstrState - - SUBROUTINE UA_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(UA_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 = 'UA_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 ! DummyConstraintState - 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%DummyConstraintState - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE UA_PackConstrState - - SUBROUTINE UA_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(UA_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 = 'UA_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%DummyConstraintState = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE UA_UnPackConstrState - - SUBROUTINE UA_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(UA_OtherStateType), INTENT(IN) :: SrcOtherStateData - TYPE(UA_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) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'UA_CopyOtherState' -! + ErrMsg = '' +end subroutine + +subroutine UA_PackKelvinChainType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(UA_KelvinChainType), intent(in) :: InData + character(*), parameter :: RoutineName = 'UA_PackKelvinChainType' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%Cn_prime) + call RegPack(RF, InData%C_nalpha_circ) + call RegPack(RF, InData%Kalpha_f) + call RegPack(RF, InData%Kq_f) + call RegPack(RF, InData%alpha_filt_cur) + call RegPack(RF, InData%alpha_e) + call RegPack(RF, InData%dalpha0) + call RegPack(RF, InData%alpha_f) + call RegPack(RF, InData%Kq) + call RegPack(RF, InData%q_cur) + call RegPack(RF, InData%q_f_cur) + call RegPack(RF, InData%X1) + call RegPack(RF, InData%X2) + call RegPack(RF, InData%X3) + call RegPack(RF, InData%X4) + call RegPack(RF, InData%Kprime_alpha) + call RegPack(RF, InData%Kprime_q) + call RegPack(RF, InData%K3prime_q) + call RegPack(RF, InData%Kprimeprime_q) + call RegPack(RF, InData%Dp) + call RegPack(RF, InData%Cn_pot) + call RegPack(RF, InData%Cc_pot) + call RegPack(RF, InData%Cn_alpha_q_circ) + call RegPack(RF, InData%Cn_alpha_q_nc) + call RegPack(RF, InData%Cm_q_circ) + call RegPack(RF, InData%Cn_alpha_nc) + call RegPack(RF, InData%Cn_q_circ) + call RegPack(RF, InData%Cn_q_nc) + call RegPack(RF, InData%Cm_q_nc) + call RegPack(RF, InData%fprimeprime) + call RegPack(RF, InData%Df) + call RegPack(RF, InData%Df_c) + call RegPack(RF, InData%Df_m) + call RegPack(RF, InData%Dalphaf) + call RegPack(RF, InData%fprime) + call RegPack(RF, InData%fprime_c) + call RegPack(RF, InData%fprimeprime_c) + call RegPack(RF, InData%fprime_m) + call RegPack(RF, InData%fprimeprime_m) + call RegPack(RF, InData%Cn_v) + call RegPack(RF, InData%C_V) + call RegPack(RF, InData%Cn_FS) + call RegPack(RF, InData%T_f) + call RegPack(RF, InData%T_fc) + call RegPack(RF, InData%T_fm) + call RegPack(RF, InData%T_V) + call RegPack(RF, InData%k_alpha) + call RegPack(RF, InData%k_q) + call RegPack(RF, InData%T_alpha) + call RegPack(RF, InData%T_q) + call RegPack(RF, InData%ds) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine UA_UnPackKelvinChainType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(UA_KelvinChainType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'UA_UnPackKelvinChainType' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%Cn_prime); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%C_nalpha_circ); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Kalpha_f); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Kq_f); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%alpha_filt_cur); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%alpha_e); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%dalpha0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%alpha_f); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Kq); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%q_cur); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%q_f_cur); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%X1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%X2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%X3); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%X4); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Kprime_alpha); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Kprime_q); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%K3prime_q); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Kprimeprime_q); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Dp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Cn_pot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Cc_pot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Cn_alpha_q_circ); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Cn_alpha_q_nc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Cm_q_circ); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Cn_alpha_nc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Cn_q_circ); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Cn_q_nc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Cm_q_nc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%fprimeprime); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Df); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Df_c); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Df_m); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Dalphaf); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%fprime); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%fprime_c); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%fprimeprime_c); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%fprime_m); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%fprimeprime_m); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Cn_v); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%C_V); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Cn_FS); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%T_f); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%T_fc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%T_fm); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%T_V); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%k_alpha); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%k_q); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%T_alpha); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%T_q); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ds); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine UA_CopyElementContinuousStateType(SrcElementContinuousStateTypeData, DstElementContinuousStateTypeData, CtrlCode, ErrStat, ErrMsg) + type(UA_ElementContinuousStateType), intent(in) :: SrcElementContinuousStateTypeData + type(UA_ElementContinuousStateType), intent(inout) :: DstElementContinuousStateTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'UA_CopyElementContinuousStateType' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcOtherStateData%FirstPass)) THEN - i1_l = LBOUND(SrcOtherStateData%FirstPass,1) - i1_u = UBOUND(SrcOtherStateData%FirstPass,1) - i2_l = LBOUND(SrcOtherStateData%FirstPass,2) - i2_u = UBOUND(SrcOtherStateData%FirstPass,2) - IF (.NOT. ALLOCATED(DstOtherStateData%FirstPass)) THEN - ALLOCATE(DstOtherStateData%FirstPass(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%FirstPass.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOtherStateData%FirstPass = SrcOtherStateData%FirstPass -ENDIF -IF (ALLOCATED(SrcOtherStateData%sigma1)) THEN - i1_l = LBOUND(SrcOtherStateData%sigma1,1) - i1_u = UBOUND(SrcOtherStateData%sigma1,1) - i2_l = LBOUND(SrcOtherStateData%sigma1,2) - i2_u = UBOUND(SrcOtherStateData%sigma1,2) - IF (.NOT. ALLOCATED(DstOtherStateData%sigma1)) THEN - ALLOCATE(DstOtherStateData%sigma1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%sigma1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOtherStateData%sigma1 = SrcOtherStateData%sigma1 -ENDIF -IF (ALLOCATED(SrcOtherStateData%sigma1c)) THEN - i1_l = LBOUND(SrcOtherStateData%sigma1c,1) - i1_u = UBOUND(SrcOtherStateData%sigma1c,1) - i2_l = LBOUND(SrcOtherStateData%sigma1c,2) - i2_u = UBOUND(SrcOtherStateData%sigma1c,2) - IF (.NOT. ALLOCATED(DstOtherStateData%sigma1c)) THEN - ALLOCATE(DstOtherStateData%sigma1c(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%sigma1c.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOtherStateData%sigma1c = SrcOtherStateData%sigma1c -ENDIF -IF (ALLOCATED(SrcOtherStateData%sigma1m)) THEN - i1_l = LBOUND(SrcOtherStateData%sigma1m,1) - i1_u = UBOUND(SrcOtherStateData%sigma1m,1) - i2_l = LBOUND(SrcOtherStateData%sigma1m,2) - i2_u = UBOUND(SrcOtherStateData%sigma1m,2) - IF (.NOT. ALLOCATED(DstOtherStateData%sigma1m)) THEN - ALLOCATE(DstOtherStateData%sigma1m(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%sigma1m.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOtherStateData%sigma1m = SrcOtherStateData%sigma1m -ENDIF -IF (ALLOCATED(SrcOtherStateData%sigma3)) THEN - i1_l = LBOUND(SrcOtherStateData%sigma3,1) - i1_u = UBOUND(SrcOtherStateData%sigma3,1) - i2_l = LBOUND(SrcOtherStateData%sigma3,2) - i2_u = UBOUND(SrcOtherStateData%sigma3,2) - IF (.NOT. ALLOCATED(DstOtherStateData%sigma3)) THEN - ALLOCATE(DstOtherStateData%sigma3(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%sigma3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOtherStateData%sigma3 = SrcOtherStateData%sigma3 -ENDIF -IF (ALLOCATED(SrcOtherStateData%n)) THEN - i1_l = LBOUND(SrcOtherStateData%n,1) - i1_u = UBOUND(SrcOtherStateData%n,1) - i2_l = LBOUND(SrcOtherStateData%n,2) - i2_u = UBOUND(SrcOtherStateData%n,2) - IF (.NOT. ALLOCATED(DstOtherStateData%n)) THEN - ALLOCATE(DstOtherStateData%n(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%n.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOtherStateData%n = SrcOtherStateData%n -ENDIF - DO i1 = LBOUND(SrcOtherStateData%xdot,1), UBOUND(SrcOtherStateData%xdot,1) - CALL UA_CopyContState( SrcOtherStateData%xdot(i1), DstOtherStateData%xdot(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -IF (ALLOCATED(SrcOtherStateData%t_vortexBegin)) THEN - i1_l = LBOUND(SrcOtherStateData%t_vortexBegin,1) - i1_u = UBOUND(SrcOtherStateData%t_vortexBegin,1) - i2_l = LBOUND(SrcOtherStateData%t_vortexBegin,2) - i2_u = UBOUND(SrcOtherStateData%t_vortexBegin,2) - IF (.NOT. ALLOCATED(DstOtherStateData%t_vortexBegin)) THEN - ALLOCATE(DstOtherStateData%t_vortexBegin(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%t_vortexBegin.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOtherStateData%t_vortexBegin = SrcOtherStateData%t_vortexBegin -ENDIF -IF (ALLOCATED(SrcOtherStateData%SignOfOmega)) THEN - i1_l = LBOUND(SrcOtherStateData%SignOfOmega,1) - i1_u = UBOUND(SrcOtherStateData%SignOfOmega,1) - i2_l = LBOUND(SrcOtherStateData%SignOfOmega,2) - i2_u = UBOUND(SrcOtherStateData%SignOfOmega,2) - IF (.NOT. ALLOCATED(DstOtherStateData%SignOfOmega)) THEN - ALLOCATE(DstOtherStateData%SignOfOmega(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%SignOfOmega.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOtherStateData%SignOfOmega = SrcOtherStateData%SignOfOmega -ENDIF -IF (ALLOCATED(SrcOtherStateData%PositivePressure)) THEN - i1_l = LBOUND(SrcOtherStateData%PositivePressure,1) - i1_u = UBOUND(SrcOtherStateData%PositivePressure,1) - i2_l = LBOUND(SrcOtherStateData%PositivePressure,2) - i2_u = UBOUND(SrcOtherStateData%PositivePressure,2) - IF (.NOT. ALLOCATED(DstOtherStateData%PositivePressure)) THEN - ALLOCATE(DstOtherStateData%PositivePressure(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%PositivePressure.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOtherStateData%PositivePressure = SrcOtherStateData%PositivePressure -ENDIF -IF (ALLOCATED(SrcOtherStateData%vortexOn)) THEN - i1_l = LBOUND(SrcOtherStateData%vortexOn,1) - i1_u = UBOUND(SrcOtherStateData%vortexOn,1) - i2_l = LBOUND(SrcOtherStateData%vortexOn,2) - i2_u = UBOUND(SrcOtherStateData%vortexOn,2) - IF (.NOT. ALLOCATED(DstOtherStateData%vortexOn)) THEN - ALLOCATE(DstOtherStateData%vortexOn(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%vortexOn.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOtherStateData%vortexOn = SrcOtherStateData%vortexOn -ENDIF -IF (ALLOCATED(SrcOtherStateData%BelowThreshold)) THEN - i1_l = LBOUND(SrcOtherStateData%BelowThreshold,1) - i1_u = UBOUND(SrcOtherStateData%BelowThreshold,1) - i2_l = LBOUND(SrcOtherStateData%BelowThreshold,2) - i2_u = UBOUND(SrcOtherStateData%BelowThreshold,2) - IF (.NOT. ALLOCATED(DstOtherStateData%BelowThreshold)) THEN - ALLOCATE(DstOtherStateData%BelowThreshold(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%BelowThreshold.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOtherStateData%BelowThreshold = SrcOtherStateData%BelowThreshold -ENDIF -IF (ALLOCATED(SrcOtherStateData%activeL)) THEN - i1_l = LBOUND(SrcOtherStateData%activeL,1) - i1_u = UBOUND(SrcOtherStateData%activeL,1) - i2_l = LBOUND(SrcOtherStateData%activeL,2) - i2_u = UBOUND(SrcOtherStateData%activeL,2) - IF (.NOT. ALLOCATED(DstOtherStateData%activeL)) THEN - ALLOCATE(DstOtherStateData%activeL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%activeL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOtherStateData%activeL = SrcOtherStateData%activeL -ENDIF -IF (ALLOCATED(SrcOtherStateData%activeD)) THEN - i1_l = LBOUND(SrcOtherStateData%activeD,1) - i1_u = UBOUND(SrcOtherStateData%activeD,1) - i2_l = LBOUND(SrcOtherStateData%activeD,2) - i2_u = UBOUND(SrcOtherStateData%activeD,2) - IF (.NOT. ALLOCATED(DstOtherStateData%activeD)) THEN - ALLOCATE(DstOtherStateData%activeD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%activeD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOtherStateData%activeD = SrcOtherStateData%activeD -ENDIF - END SUBROUTINE UA_CopyOtherState - - SUBROUTINE UA_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(UA_OtherStateType), INTENT(INOUT) :: OtherStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'UA_DestroyOtherState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(OtherStateData%FirstPass)) THEN - DEALLOCATE(OtherStateData%FirstPass) -ENDIF -IF (ALLOCATED(OtherStateData%sigma1)) THEN - DEALLOCATE(OtherStateData%sigma1) -ENDIF -IF (ALLOCATED(OtherStateData%sigma1c)) THEN - DEALLOCATE(OtherStateData%sigma1c) -ENDIF -IF (ALLOCATED(OtherStateData%sigma1m)) THEN - DEALLOCATE(OtherStateData%sigma1m) -ENDIF -IF (ALLOCATED(OtherStateData%sigma3)) THEN - DEALLOCATE(OtherStateData%sigma3) -ENDIF -IF (ALLOCATED(OtherStateData%n)) THEN - DEALLOCATE(OtherStateData%n) -ENDIF -DO i1 = LBOUND(OtherStateData%xdot,1), UBOUND(OtherStateData%xdot,1) - CALL UA_DestroyContState( OtherStateData%xdot(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -IF (ALLOCATED(OtherStateData%t_vortexBegin)) THEN - DEALLOCATE(OtherStateData%t_vortexBegin) -ENDIF -IF (ALLOCATED(OtherStateData%SignOfOmega)) THEN - DEALLOCATE(OtherStateData%SignOfOmega) -ENDIF -IF (ALLOCATED(OtherStateData%PositivePressure)) THEN - DEALLOCATE(OtherStateData%PositivePressure) -ENDIF -IF (ALLOCATED(OtherStateData%vortexOn)) THEN - DEALLOCATE(OtherStateData%vortexOn) -ENDIF -IF (ALLOCATED(OtherStateData%BelowThreshold)) THEN - DEALLOCATE(OtherStateData%BelowThreshold) -ENDIF -IF (ALLOCATED(OtherStateData%activeL)) THEN - DEALLOCATE(OtherStateData%activeL) -ENDIF -IF (ALLOCATED(OtherStateData%activeD)) THEN - DEALLOCATE(OtherStateData%activeD) -ENDIF - END SUBROUTINE UA_DestroyOtherState - - SUBROUTINE UA_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(UA_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 = 'UA_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 allocated yes/no - IF ( ALLOCATED(InData%FirstPass) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! FirstPass upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%FirstPass) ! FirstPass - END IF - Int_BufSz = Int_BufSz + 1 ! sigma1 allocated yes/no - IF ( ALLOCATED(InData%sigma1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! sigma1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%sigma1) ! sigma1 - END IF - Int_BufSz = Int_BufSz + 1 ! sigma1c allocated yes/no - IF ( ALLOCATED(InData%sigma1c) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! sigma1c upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%sigma1c) ! sigma1c - END IF - Int_BufSz = Int_BufSz + 1 ! sigma1m allocated yes/no - IF ( ALLOCATED(InData%sigma1m) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! sigma1m upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%sigma1m) ! sigma1m - END IF - Int_BufSz = Int_BufSz + 1 ! sigma3 allocated yes/no - IF ( ALLOCATED(InData%sigma3) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! sigma3 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%sigma3) ! sigma3 - END IF - Int_BufSz = Int_BufSz + 1 ! n allocated yes/no - IF ( ALLOCATED(InData%n) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! n upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%n) ! n - END IF - ! 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 UA_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 - Int_BufSz = Int_BufSz + 1 ! t_vortexBegin allocated yes/no - IF ( ALLOCATED(InData%t_vortexBegin) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! t_vortexBegin upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%t_vortexBegin) ! t_vortexBegin - END IF - Int_BufSz = Int_BufSz + 1 ! SignOfOmega allocated yes/no - IF ( ALLOCATED(InData%SignOfOmega) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! SignOfOmega upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%SignOfOmega) ! SignOfOmega - END IF - Int_BufSz = Int_BufSz + 1 ! PositivePressure allocated yes/no - IF ( ALLOCATED(InData%PositivePressure) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PositivePressure upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%PositivePressure) ! PositivePressure - END IF - Int_BufSz = Int_BufSz + 1 ! vortexOn allocated yes/no - IF ( ALLOCATED(InData%vortexOn) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! vortexOn upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%vortexOn) ! vortexOn - END IF - Int_BufSz = Int_BufSz + 1 ! BelowThreshold allocated yes/no - IF ( ALLOCATED(InData%BelowThreshold) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BelowThreshold upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%BelowThreshold) ! BelowThreshold - END IF - Int_BufSz = Int_BufSz + 1 ! activeL allocated yes/no - IF ( ALLOCATED(InData%activeL) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! activeL upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%activeL) ! activeL - END IF - Int_BufSz = Int_BufSz + 1 ! activeD allocated yes/no - IF ( ALLOCATED(InData%activeD) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! activeD upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%activeD) ! activeD - 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%FirstPass) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FirstPass,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FirstPass,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FirstPass,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FirstPass,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%FirstPass,2), UBOUND(InData%FirstPass,2) - DO i1 = LBOUND(InData%FirstPass,1), UBOUND(InData%FirstPass,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%FirstPass(i1,i2), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%sigma1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%sigma1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%sigma1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%sigma1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%sigma1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%sigma1,2), UBOUND(InData%sigma1,2) - DO i1 = LBOUND(InData%sigma1,1), UBOUND(InData%sigma1,1) - ReKiBuf(Re_Xferred) = InData%sigma1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%sigma1c) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%sigma1c,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%sigma1c,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%sigma1c,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%sigma1c,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%sigma1c,2), UBOUND(InData%sigma1c,2) - DO i1 = LBOUND(InData%sigma1c,1), UBOUND(InData%sigma1c,1) - ReKiBuf(Re_Xferred) = InData%sigma1c(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%sigma1m) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%sigma1m,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%sigma1m,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%sigma1m,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%sigma1m,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%sigma1m,2), UBOUND(InData%sigma1m,2) - DO i1 = LBOUND(InData%sigma1m,1), UBOUND(InData%sigma1m,1) - ReKiBuf(Re_Xferred) = InData%sigma1m(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%sigma3) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%sigma3,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%sigma3,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%sigma3,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%sigma3,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%sigma3,2), UBOUND(InData%sigma3,2) - DO i1 = LBOUND(InData%sigma3,1), UBOUND(InData%sigma3,1) - ReKiBuf(Re_Xferred) = InData%sigma3(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%n) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%n,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%n,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%n,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%n,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%n,2), UBOUND(InData%n,2) - DO i1 = LBOUND(InData%n,1), UBOUND(InData%n,1) - IntKiBuf(Int_Xferred) = InData%n(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - DO i1 = LBOUND(InData%xdot,1), UBOUND(InData%xdot,1) - CALL UA_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 - IF ( .NOT. ALLOCATED(InData%t_vortexBegin) ) THEN - 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_vortexBegin,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%t_vortexBegin,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%t_vortexBegin,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%t_vortexBegin,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%t_vortexBegin,2), UBOUND(InData%t_vortexBegin,2) - DO i1 = LBOUND(InData%t_vortexBegin,1), UBOUND(InData%t_vortexBegin,1) - ReKiBuf(Re_Xferred) = InData%t_vortexBegin(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%SignOfOmega) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SignOfOmega,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SignOfOmega,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SignOfOmega,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SignOfOmega,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%SignOfOmega,2), UBOUND(InData%SignOfOmega,2) - DO i1 = LBOUND(InData%SignOfOmega,1), UBOUND(InData%SignOfOmega,1) - ReKiBuf(Re_Xferred) = InData%SignOfOmega(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PositivePressure) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PositivePressure,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PositivePressure,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PositivePressure,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PositivePressure,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PositivePressure,2), UBOUND(InData%PositivePressure,2) - DO i1 = LBOUND(InData%PositivePressure,1), UBOUND(InData%PositivePressure,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%PositivePressure(i1,i2), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%vortexOn) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%vortexOn,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%vortexOn,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%vortexOn,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%vortexOn,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%vortexOn,2), UBOUND(InData%vortexOn,2) - DO i1 = LBOUND(InData%vortexOn,1), UBOUND(InData%vortexOn,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%vortexOn(i1,i2), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BelowThreshold) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BelowThreshold,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BelowThreshold,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BelowThreshold,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BelowThreshold,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%BelowThreshold,2), UBOUND(InData%BelowThreshold,2) - DO i1 = LBOUND(InData%BelowThreshold,1), UBOUND(InData%BelowThreshold,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%BelowThreshold(i1,i2), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%activeL) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%activeL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%activeL,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%activeL,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%activeL,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%activeL,2), UBOUND(InData%activeL,2) - DO i1 = LBOUND(InData%activeL,1), UBOUND(InData%activeL,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%activeL(i1,i2), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%activeD) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%activeD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%activeD,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%activeD,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%activeD,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%activeD,2), UBOUND(InData%activeD,2) - DO i1 = LBOUND(InData%activeD,1), UBOUND(InData%activeD,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%activeD(i1,i2), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE UA_PackOtherState - - SUBROUTINE UA_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(UA_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) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'UA_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 ! FirstPass not allocated - Int_Xferred = Int_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%FirstPass)) DEALLOCATE(OutData%FirstPass) - ALLOCATE(OutData%FirstPass(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FirstPass.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%FirstPass,2), UBOUND(OutData%FirstPass,2) - DO i1 = LBOUND(OutData%FirstPass,1), UBOUND(OutData%FirstPass,1) - OutData%FirstPass(i1,i2) = TRANSFER(IntKiBuf(Int_Xferred), OutData%FirstPass(i1,i2)) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! sigma1 not allocated - Int_Xferred = Int_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%sigma1)) DEALLOCATE(OutData%sigma1) - ALLOCATE(OutData%sigma1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%sigma1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%sigma1,2), UBOUND(OutData%sigma1,2) - DO i1 = LBOUND(OutData%sigma1,1), UBOUND(OutData%sigma1,1) - OutData%sigma1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! sigma1c not allocated - Int_Xferred = Int_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%sigma1c)) DEALLOCATE(OutData%sigma1c) - ALLOCATE(OutData%sigma1c(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%sigma1c.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%sigma1c,2), UBOUND(OutData%sigma1c,2) - DO i1 = LBOUND(OutData%sigma1c,1), UBOUND(OutData%sigma1c,1) - OutData%sigma1c(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! sigma1m not allocated - Int_Xferred = Int_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%sigma1m)) DEALLOCATE(OutData%sigma1m) - ALLOCATE(OutData%sigma1m(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%sigma1m.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%sigma1m,2), UBOUND(OutData%sigma1m,2) - DO i1 = LBOUND(OutData%sigma1m,1), UBOUND(OutData%sigma1m,1) - OutData%sigma1m(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! sigma3 not allocated - Int_Xferred = Int_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%sigma3)) DEALLOCATE(OutData%sigma3) - ALLOCATE(OutData%sigma3(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%sigma3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%sigma3,2), UBOUND(OutData%sigma3,2) - DO i1 = LBOUND(OutData%sigma3,1), UBOUND(OutData%sigma3,1) - OutData%sigma3(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! n not allocated - Int_Xferred = Int_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%n)) DEALLOCATE(OutData%n) - ALLOCATE(OutData%n(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%n.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%n,2), UBOUND(OutData%n,2) - DO i1 = LBOUND(OutData%n,1), UBOUND(OutData%n,1) - OutData%n(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - i1_l = LBOUND(OutData%xdot,1) - i1_u = UBOUND(OutData%xdot,1) - 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 UA_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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! t_vortexBegin not allocated - Int_Xferred = Int_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_vortexBegin)) DEALLOCATE(OutData%t_vortexBegin) - ALLOCATE(OutData%t_vortexBegin(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%t_vortexBegin.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%t_vortexBegin,2), UBOUND(OutData%t_vortexBegin,2) - DO i1 = LBOUND(OutData%t_vortexBegin,1), UBOUND(OutData%t_vortexBegin,1) - OutData%t_vortexBegin(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SignOfOmega not allocated - Int_Xferred = Int_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%SignOfOmega)) DEALLOCATE(OutData%SignOfOmega) - ALLOCATE(OutData%SignOfOmega(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SignOfOmega.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%SignOfOmega,2), UBOUND(OutData%SignOfOmega,2) - DO i1 = LBOUND(OutData%SignOfOmega,1), UBOUND(OutData%SignOfOmega,1) - OutData%SignOfOmega(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PositivePressure not allocated - Int_Xferred = Int_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%PositivePressure)) DEALLOCATE(OutData%PositivePressure) - ALLOCATE(OutData%PositivePressure(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PositivePressure.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PositivePressure,2), UBOUND(OutData%PositivePressure,2) - DO i1 = LBOUND(OutData%PositivePressure,1), UBOUND(OutData%PositivePressure,1) - OutData%PositivePressure(i1,i2) = TRANSFER(IntKiBuf(Int_Xferred), OutData%PositivePressure(i1,i2)) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! vortexOn not allocated - Int_Xferred = Int_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%vortexOn)) DEALLOCATE(OutData%vortexOn) - ALLOCATE(OutData%vortexOn(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%vortexOn.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%vortexOn,2), UBOUND(OutData%vortexOn,2) - DO i1 = LBOUND(OutData%vortexOn,1), UBOUND(OutData%vortexOn,1) - OutData%vortexOn(i1,i2) = TRANSFER(IntKiBuf(Int_Xferred), OutData%vortexOn(i1,i2)) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BelowThreshold not allocated - Int_Xferred = Int_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%BelowThreshold)) DEALLOCATE(OutData%BelowThreshold) - ALLOCATE(OutData%BelowThreshold(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BelowThreshold.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%BelowThreshold,2), UBOUND(OutData%BelowThreshold,2) - DO i1 = LBOUND(OutData%BelowThreshold,1), UBOUND(OutData%BelowThreshold,1) - OutData%BelowThreshold(i1,i2) = TRANSFER(IntKiBuf(Int_Xferred), OutData%BelowThreshold(i1,i2)) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! activeL not allocated - Int_Xferred = Int_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%activeL)) DEALLOCATE(OutData%activeL) - ALLOCATE(OutData%activeL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%activeL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%activeL,2), UBOUND(OutData%activeL,2) - DO i1 = LBOUND(OutData%activeL,1), UBOUND(OutData%activeL,1) - OutData%activeL(i1,i2) = TRANSFER(IntKiBuf(Int_Xferred), OutData%activeL(i1,i2)) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! activeD not allocated - Int_Xferred = Int_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%activeD)) DEALLOCATE(OutData%activeD) - ALLOCATE(OutData%activeD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%activeD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%activeD,2), UBOUND(OutData%activeD,2) - DO i1 = LBOUND(OutData%activeD,1), UBOUND(OutData%activeD,1) - OutData%activeD(i1,i2) = TRANSFER(IntKiBuf(Int_Xferred), OutData%activeD(i1,i2)) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE UA_UnPackOtherState - - SUBROUTINE UA_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(UA_MiscVarType), INTENT(IN) :: SrcMiscData - TYPE(UA_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 = 'UA_CopyMisc' -! + ErrMsg = '' + DstElementContinuousStateTypeData%x = SrcElementContinuousStateTypeData%x +end subroutine + +subroutine UA_DestroyElementContinuousStateType(ElementContinuousStateTypeData, ErrStat, ErrMsg) + type(UA_ElementContinuousStateType), intent(inout) :: ElementContinuousStateTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'UA_DestroyElementContinuousStateType' ErrStat = ErrID_None - ErrMsg = "" - DstMiscData%FirstWarn_M = SrcMiscData%FirstWarn_M - DstMiscData%FirstWarn_UA = SrcMiscData%FirstWarn_UA - DstMiscData%FirstWarn_UA_off = SrcMiscData%FirstWarn_UA_off -IF (ALLOCATED(SrcMiscData%TESF)) THEN - i1_l = LBOUND(SrcMiscData%TESF,1) - i1_u = UBOUND(SrcMiscData%TESF,1) - i2_l = LBOUND(SrcMiscData%TESF,2) - i2_u = UBOUND(SrcMiscData%TESF,2) - IF (.NOT. ALLOCATED(DstMiscData%TESF)) THEN - ALLOCATE(DstMiscData%TESF(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%TESF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%TESF = SrcMiscData%TESF -ENDIF -IF (ALLOCATED(SrcMiscData%LESF)) THEN - i1_l = LBOUND(SrcMiscData%LESF,1) - i1_u = UBOUND(SrcMiscData%LESF,1) - i2_l = LBOUND(SrcMiscData%LESF,2) - i2_u = UBOUND(SrcMiscData%LESF,2) - IF (.NOT. ALLOCATED(DstMiscData%LESF)) THEN - ALLOCATE(DstMiscData%LESF(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%LESF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%LESF = SrcMiscData%LESF -ENDIF -IF (ALLOCATED(SrcMiscData%VRTX)) THEN - i1_l = LBOUND(SrcMiscData%VRTX,1) - i1_u = UBOUND(SrcMiscData%VRTX,1) - i2_l = LBOUND(SrcMiscData%VRTX,2) - i2_u = UBOUND(SrcMiscData%VRTX,2) - IF (.NOT. ALLOCATED(DstMiscData%VRTX)) THEN - ALLOCATE(DstMiscData%VRTX(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%VRTX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%VRTX = SrcMiscData%VRTX -ENDIF -IF (ALLOCATED(SrcMiscData%T_Sh)) THEN - i1_l = LBOUND(SrcMiscData%T_Sh,1) - i1_u = UBOUND(SrcMiscData%T_Sh,1) - i2_l = LBOUND(SrcMiscData%T_Sh,2) - i2_u = UBOUND(SrcMiscData%T_Sh,2) - IF (.NOT. ALLOCATED(DstMiscData%T_Sh)) THEN - ALLOCATE(DstMiscData%T_Sh(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%T_Sh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%T_Sh = SrcMiscData%T_Sh -ENDIF -IF (ALLOCATED(SrcMiscData%BEDSEP)) THEN - i1_l = LBOUND(SrcMiscData%BEDSEP,1) - i1_u = UBOUND(SrcMiscData%BEDSEP,1) - i2_l = LBOUND(SrcMiscData%BEDSEP,2) - i2_u = UBOUND(SrcMiscData%BEDSEP,2) - IF (.NOT. ALLOCATED(DstMiscData%BEDSEP)) THEN - ALLOCATE(DstMiscData%BEDSEP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BEDSEP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%BEDSEP = SrcMiscData%BEDSEP -ENDIF -IF (ALLOCATED(SrcMiscData%weight)) THEN - i1_l = LBOUND(SrcMiscData%weight,1) - i1_u = UBOUND(SrcMiscData%weight,1) - i2_l = LBOUND(SrcMiscData%weight,2) - i2_u = UBOUND(SrcMiscData%weight,2) - IF (.NOT. ALLOCATED(DstMiscData%weight)) THEN - ALLOCATE(DstMiscData%weight(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%weight.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%weight = SrcMiscData%weight -ENDIF - END SUBROUTINE UA_CopyMisc - - SUBROUTINE UA_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(UA_MiscVarType), INTENT(INOUT) :: MiscData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'UA_DestroyMisc' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(MiscData%TESF)) THEN - DEALLOCATE(MiscData%TESF) -ENDIF -IF (ALLOCATED(MiscData%LESF)) THEN - DEALLOCATE(MiscData%LESF) -ENDIF -IF (ALLOCATED(MiscData%VRTX)) THEN - DEALLOCATE(MiscData%VRTX) -ENDIF -IF (ALLOCATED(MiscData%T_Sh)) THEN - DEALLOCATE(MiscData%T_Sh) -ENDIF -IF (ALLOCATED(MiscData%BEDSEP)) THEN - DEALLOCATE(MiscData%BEDSEP) -ENDIF -IF (ALLOCATED(MiscData%weight)) THEN - DEALLOCATE(MiscData%weight) -ENDIF - END SUBROUTINE UA_DestroyMisc - - SUBROUTINE UA_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(UA_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 = 'UA_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 ! FirstWarn_M - Int_BufSz = Int_BufSz + 1 ! FirstWarn_UA - Int_BufSz = Int_BufSz + 1 ! FirstWarn_UA_off - Int_BufSz = Int_BufSz + 1 ! TESF allocated yes/no - IF ( ALLOCATED(InData%TESF) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! TESF upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%TESF) ! TESF - END IF - Int_BufSz = Int_BufSz + 1 ! LESF allocated yes/no - IF ( ALLOCATED(InData%LESF) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! LESF upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%LESF) ! LESF - END IF - Int_BufSz = Int_BufSz + 1 ! VRTX allocated yes/no - IF ( ALLOCATED(InData%VRTX) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! VRTX upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%VRTX) ! VRTX - END IF - Int_BufSz = Int_BufSz + 1 ! T_Sh allocated yes/no - IF ( ALLOCATED(InData%T_Sh) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! T_Sh upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%T_Sh) ! T_Sh - END IF - Int_BufSz = Int_BufSz + 1 ! BEDSEP allocated yes/no - IF ( ALLOCATED(InData%BEDSEP) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BEDSEP upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%BEDSEP) ! BEDSEP - END IF - Int_BufSz = Int_BufSz + 1 ! weight allocated yes/no - IF ( ALLOCATED(InData%weight) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! weight upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%weight) ! weight - 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) = TRANSFER(InData%FirstWarn_M, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%FirstWarn_UA, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%FirstWarn_UA_off, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%TESF) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TESF,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TESF,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TESF,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TESF,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%TESF,2), UBOUND(InData%TESF,2) - DO i1 = LBOUND(InData%TESF,1), UBOUND(InData%TESF,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%TESF(i1,i2), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LESF) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LESF,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LESF,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LESF,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LESF,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%LESF,2), UBOUND(InData%LESF,2) - DO i1 = LBOUND(InData%LESF,1), UBOUND(InData%LESF,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%LESF(i1,i2), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%VRTX) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%VRTX,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VRTX,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%VRTX,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VRTX,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%VRTX,2), UBOUND(InData%VRTX,2) - DO i1 = LBOUND(InData%VRTX,1), UBOUND(InData%VRTX,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%VRTX(i1,i2), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%T_Sh) ) THEN - 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_Sh,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%T_Sh,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%T_Sh,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%T_Sh,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%T_Sh,2), UBOUND(InData%T_Sh,2) - DO i1 = LBOUND(InData%T_Sh,1), UBOUND(InData%T_Sh,1) - ReKiBuf(Re_Xferred) = InData%T_Sh(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BEDSEP) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BEDSEP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BEDSEP,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BEDSEP,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BEDSEP,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%BEDSEP,2), UBOUND(InData%BEDSEP,2) - DO i1 = LBOUND(InData%BEDSEP,1), UBOUND(InData%BEDSEP,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%BEDSEP(i1,i2), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%weight) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%weight,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%weight,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%weight,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%weight,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%weight,2), UBOUND(InData%weight,2) - DO i1 = LBOUND(InData%weight,1), UBOUND(InData%weight,1) - ReKiBuf(Re_Xferred) = InData%weight(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE UA_PackMisc - - SUBROUTINE UA_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(UA_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 = 'UA_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%FirstWarn_M = TRANSFER(IntKiBuf(Int_Xferred), OutData%FirstWarn_M) - Int_Xferred = Int_Xferred + 1 - OutData%FirstWarn_UA = TRANSFER(IntKiBuf(Int_Xferred), OutData%FirstWarn_UA) - Int_Xferred = Int_Xferred + 1 - OutData%FirstWarn_UA_off = TRANSFER(IntKiBuf(Int_Xferred), OutData%FirstWarn_UA_off) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TESF not allocated - Int_Xferred = Int_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%TESF)) DEALLOCATE(OutData%TESF) - ALLOCATE(OutData%TESF(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TESF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%TESF,2), UBOUND(OutData%TESF,2) - DO i1 = LBOUND(OutData%TESF,1), UBOUND(OutData%TESF,1) - OutData%TESF(i1,i2) = TRANSFER(IntKiBuf(Int_Xferred), OutData%TESF(i1,i2)) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LESF not allocated - Int_Xferred = Int_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%LESF)) DEALLOCATE(OutData%LESF) - ALLOCATE(OutData%LESF(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LESF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%LESF,2), UBOUND(OutData%LESF,2) - DO i1 = LBOUND(OutData%LESF,1), UBOUND(OutData%LESF,1) - OutData%LESF(i1,i2) = TRANSFER(IntKiBuf(Int_Xferred), OutData%LESF(i1,i2)) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! VRTX not allocated - Int_Xferred = Int_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%VRTX)) DEALLOCATE(OutData%VRTX) - ALLOCATE(OutData%VRTX(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%VRTX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%VRTX,2), UBOUND(OutData%VRTX,2) - DO i1 = LBOUND(OutData%VRTX,1), UBOUND(OutData%VRTX,1) - OutData%VRTX(i1,i2) = TRANSFER(IntKiBuf(Int_Xferred), OutData%VRTX(i1,i2)) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! T_Sh not allocated - Int_Xferred = Int_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_Sh)) DEALLOCATE(OutData%T_Sh) - ALLOCATE(OutData%T_Sh(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%T_Sh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%T_Sh,2), UBOUND(OutData%T_Sh,2) - DO i1 = LBOUND(OutData%T_Sh,1), UBOUND(OutData%T_Sh,1) - OutData%T_Sh(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BEDSEP not allocated - Int_Xferred = Int_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%BEDSEP)) DEALLOCATE(OutData%BEDSEP) - ALLOCATE(OutData%BEDSEP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BEDSEP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%BEDSEP,2), UBOUND(OutData%BEDSEP,2) - DO i1 = LBOUND(OutData%BEDSEP,1), UBOUND(OutData%BEDSEP,1) - OutData%BEDSEP(i1,i2) = TRANSFER(IntKiBuf(Int_Xferred), OutData%BEDSEP(i1,i2)) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! weight not allocated - Int_Xferred = Int_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%weight)) DEALLOCATE(OutData%weight) - ALLOCATE(OutData%weight(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%weight.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%weight,2), UBOUND(OutData%weight,2) - DO i1 = LBOUND(OutData%weight,1), UBOUND(OutData%weight,1) - OutData%weight(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE UA_UnPackMisc - - SUBROUTINE UA_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(UA_ParameterType), INTENT(IN) :: SrcParamData - TYPE(UA_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 = 'UA_CopyParam' -! + ErrMsg = '' +end subroutine + +subroutine UA_PackElementContinuousStateType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(UA_ElementContinuousStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'UA_PackElementContinuousStateType' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%x) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine UA_UnPackElementContinuousStateType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(UA_ElementContinuousStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'UA_UnPackElementContinuousStateType' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%x); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine UA_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) + type(UA_ContinuousStateType), intent(in) :: SrcContStateData + type(UA_ContinuousStateType), intent(inout) :: DstContStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'UA_CopyContState' ErrStat = ErrID_None - ErrMsg = "" - DstParamData%dt = SrcParamData%dt -IF (ALLOCATED(SrcParamData%c)) THEN - i1_l = LBOUND(SrcParamData%c,1) - i1_u = UBOUND(SrcParamData%c,1) - i2_l = LBOUND(SrcParamData%c,2) - i2_u = UBOUND(SrcParamData%c,2) - IF (.NOT. ALLOCATED(DstParamData%c)) THEN - ALLOCATE(DstParamData%c(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%c.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%c = SrcParamData%c -ENDIF - DstParamData%numBlades = SrcParamData%numBlades - DstParamData%nNodesPerBlade = SrcParamData%nNodesPerBlade - DstParamData%UAMod = SrcParamData%UAMod - DstParamData%Flookup = SrcParamData%Flookup - DstParamData%a_s = SrcParamData%a_s - DstParamData%NumOuts = SrcParamData%NumOuts - DstParamData%OutSwtch = SrcParamData%OutSwtch - DstParamData%OutFmt = SrcParamData%OutFmt - DstParamData%OutSFmt = SrcParamData%OutSFmt - DstParamData%Delim = SrcParamData%Delim - DstParamData%UnOutFile = SrcParamData%UnOutFile - DstParamData%ShedEffect = SrcParamData%ShedEffect - DstParamData%lin_nx = SrcParamData%lin_nx -IF (ALLOCATED(SrcParamData%UA_off_forGood)) THEN - i1_l = LBOUND(SrcParamData%UA_off_forGood,1) - i1_u = UBOUND(SrcParamData%UA_off_forGood,1) - i2_l = LBOUND(SrcParamData%UA_off_forGood,2) - i2_u = UBOUND(SrcParamData%UA_off_forGood,2) - IF (.NOT. ALLOCATED(DstParamData%UA_off_forGood)) THEN - ALLOCATE(DstParamData%UA_off_forGood(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%UA_off_forGood.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%UA_off_forGood = SrcParamData%UA_off_forGood -ENDIF - END SUBROUTINE UA_CopyParam - - SUBROUTINE UA_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(UA_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'UA_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(ParamData%c)) THEN - DEALLOCATE(ParamData%c) -ENDIF -IF (ALLOCATED(ParamData%UA_off_forGood)) THEN - DEALLOCATE(ParamData%UA_off_forGood) -ENDIF - END SUBROUTINE UA_DestroyParam - - SUBROUTINE UA_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(UA_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 = 'UA_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 ! c allocated yes/no - IF ( ALLOCATED(InData%c) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! c upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%c) ! c - END IF - Int_BufSz = Int_BufSz + 1 ! numBlades - Int_BufSz = Int_BufSz + 1 ! nNodesPerBlade - Int_BufSz = Int_BufSz + 1 ! UAMod - Int_BufSz = Int_BufSz + 1 ! Flookup - Re_BufSz = Re_BufSz + 1 ! a_s - Int_BufSz = Int_BufSz + 1 ! NumOuts - Int_BufSz = Int_BufSz + 1 ! OutSwtch - Int_BufSz = Int_BufSz + 1*LEN(InData%OutFmt) ! OutFmt - Int_BufSz = Int_BufSz + 1*LEN(InData%OutSFmt) ! OutSFmt - Int_BufSz = Int_BufSz + 1*LEN(InData%Delim) ! Delim - Int_BufSz = Int_BufSz + 1 ! UnOutFile - Int_BufSz = Int_BufSz + 1 ! ShedEffect - Int_BufSz = Int_BufSz + 1 ! lin_nx - Int_BufSz = Int_BufSz + 1 ! UA_off_forGood allocated yes/no - IF ( ALLOCATED(InData%UA_off_forGood) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! UA_off_forGood upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%UA_off_forGood) ! UA_off_forGood - 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 - 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 - IntKiBuf( Int_Xferred ) = LBOUND(InData%c,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%c,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%c,2), UBOUND(InData%c,2) - DO i1 = LBOUND(InData%c,1), UBOUND(InData%c,1) - ReKiBuf(Re_Xferred) = InData%c(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%numBlades - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nNodesPerBlade - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%UAMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%Flookup, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%a_s - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%OutSwtch - 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 - DO I = 1, LEN(InData%OutSFmt) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutSFmt(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - 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) = InData%UnOutFile - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%ShedEffect, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%lin_nx - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%UA_off_forGood) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%UA_off_forGood,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UA_off_forGood,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%UA_off_forGood,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UA_off_forGood,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%UA_off_forGood,2), UBOUND(InData%UA_off_forGood,2) - DO i1 = LBOUND(InData%UA_off_forGood,1), UBOUND(InData%UA_off_forGood,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%UA_off_forGood(i1,i2), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE UA_PackParam - - SUBROUTINE UA_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(UA_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 = 'UA_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 - 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 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%c)) DEALLOCATE(OutData%c) - ALLOCATE(OutData%c(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%c.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%c,2), UBOUND(OutData%c,2) - DO i1 = LBOUND(OutData%c,1), UBOUND(OutData%c,1) - OutData%c(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%numBlades = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nNodesPerBlade = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%UAMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%Flookup = TRANSFER(IntKiBuf(Int_Xferred), OutData%Flookup) - Int_Xferred = Int_Xferred + 1 - OutData%a_s = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NumOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%OutSwtch = IntKiBuf(Int_Xferred) - 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 - DO I = 1, LEN(OutData%OutSFmt) - OutData%OutSFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%Delim) - OutData%Delim(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%UnOutFile = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%ShedEffect = TRANSFER(IntKiBuf(Int_Xferred), OutData%ShedEffect) - Int_Xferred = Int_Xferred + 1 - OutData%lin_nx = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! UA_off_forGood not allocated - Int_Xferred = Int_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%UA_off_forGood)) DEALLOCATE(OutData%UA_off_forGood) - ALLOCATE(OutData%UA_off_forGood(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%UA_off_forGood.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%UA_off_forGood,2), UBOUND(OutData%UA_off_forGood,2) - DO i1 = LBOUND(OutData%UA_off_forGood,1), UBOUND(OutData%UA_off_forGood,1) - OutData%UA_off_forGood(i1,i2) = TRANSFER(IntKiBuf(Int_Xferred), OutData%UA_off_forGood(i1,i2)) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE UA_UnPackParam - - SUBROUTINE UA_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(UA_InputType), INTENT(IN) :: SrcInputData - TYPE(UA_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 = 'UA_CopyInput' -! + ErrMsg = '' + if (allocated(SrcContStateData%element)) then + LB(1:2) = lbound(SrcContStateData%element) + UB(1:2) = ubound(SrcContStateData%element) + if (.not. allocated(DstContStateData%element)) then + allocate(DstContStateData%element(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%element.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call UA_CopyElementContinuousStateType(SrcContStateData%element(i1,i2), DstContStateData%element(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do + end if +end subroutine + +subroutine UA_DestroyContState(ContStateData, ErrStat, ErrMsg) + type(UA_ContinuousStateType), intent(inout) :: ContStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'UA_DestroyContState' ErrStat = ErrID_None - ErrMsg = "" - DstInputData%U = SrcInputData%U - DstInputData%alpha = SrcInputData%alpha - DstInputData%Re = SrcInputData%Re - DstInputData%UserProp = SrcInputData%UserProp - DstInputData%v_ac = SrcInputData%v_ac - DstInputData%omega = SrcInputData%omega - END SUBROUTINE UA_CopyInput - - SUBROUTINE UA_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(UA_InputType), INTENT(INOUT) :: InputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'UA_DestroyInput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE UA_DestroyInput - - SUBROUTINE UA_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(UA_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 = 'UA_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 ! U - Re_BufSz = Re_BufSz + 1 ! alpha - Re_BufSz = Re_BufSz + 1 ! Re - Re_BufSz = Re_BufSz + 1 ! UserProp - Re_BufSz = Re_BufSz + SIZE(InData%v_ac) ! v_ac - Re_BufSz = Re_BufSz + 1 ! omega - 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%U - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%alpha - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Re - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%UserProp - Re_Xferred = Re_Xferred + 1 - DO i1 = LBOUND(InData%v_ac,1), UBOUND(InData%v_ac,1) - ReKiBuf(Re_Xferred) = InData%v_ac(i1) - Re_Xferred = Re_Xferred + 1 - END DO - ReKiBuf(Re_Xferred) = InData%omega - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE UA_PackInput - - SUBROUTINE UA_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(UA_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 = 'UA_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%U = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%alpha = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Re = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%UserProp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%v_ac,1) - i1_u = UBOUND(OutData%v_ac,1) - DO i1 = LBOUND(OutData%v_ac,1), UBOUND(OutData%v_ac,1) - OutData%v_ac(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%omega = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE UA_UnPackInput - - SUBROUTINE UA_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(UA_OutputType), INTENT(IN) :: SrcOutputData - TYPE(UA_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 = 'UA_CopyOutput' -! + ErrMsg = '' + if (allocated(ContStateData%element)) then + LB(1:2) = lbound(ContStateData%element) + UB(1:2) = ubound(ContStateData%element) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call UA_DestroyElementContinuousStateType(ContStateData%element(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + deallocate(ContStateData%element) + end if +end subroutine + +subroutine UA_PackContState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(UA_ContinuousStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'UA_PackContState' + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%element)) + if (allocated(InData%element)) then + call RegPackBounds(RF, 2, lbound(InData%element), ubound(InData%element)) + LB(1:2) = lbound(InData%element) + UB(1:2) = ubound(InData%element) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call UA_PackElementContinuousStateType(RF, InData%element(i1,i2)) + end do + end do + end if + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine UA_UnPackContState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(UA_ContinuousStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'UA_UnPackContState' + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + if (allocated(OutData%element)) deallocate(OutData%element) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%element(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%element.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call UA_UnpackElementContinuousStateType(RF, OutData%element(i1,i2)) ! element + end do + end do + end if +end subroutine + +subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) + type(UA_DiscreteStateType), intent(in) :: SrcDiscStateData + type(UA_DiscreteStateType), intent(inout) :: DstDiscStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'UA_CopyDiscState' ErrStat = ErrID_None - ErrMsg = "" - DstOutputData%Cn = SrcOutputData%Cn - DstOutputData%Cc = SrcOutputData%Cc - DstOutputData%Cm = SrcOutputData%Cm - DstOutputData%Cl = SrcOutputData%Cl - DstOutputData%Cd = SrcOutputData%Cd -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 UA_CopyOutput - - SUBROUTINE UA_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(UA_OutputType), INTENT(INOUT) :: OutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'UA_DestroyOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(OutputData%WriteOutput)) THEN - DEALLOCATE(OutputData%WriteOutput) -ENDIF - END SUBROUTINE UA_DestroyOutput - - SUBROUTINE UA_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(UA_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 = 'UA_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 ! Cn - Re_BufSz = Re_BufSz + 1 ! Cc - Re_BufSz = Re_BufSz + 1 ! Cm - Re_BufSz = Re_BufSz + 1 ! Cl - Re_BufSz = Re_BufSz + 1 ! Cd - 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) = InData%Cn - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Cc - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Cm - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Cl - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Cd - 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 - - 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 UA_PackOutput - - SUBROUTINE UA_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(UA_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 = 'UA_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%Cn = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Cc = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Cm = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Cl = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Cd = 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 - 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 UA_UnPackOutput - - - SUBROUTINE UA_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(UA_InputType), INTENT(IN) :: u(:) ! Input at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Inputs - TYPE(UA_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 + ErrMsg = '' + if (allocated(SrcDiscStateData%alpha_minus1)) then + LB(1:2) = lbound(SrcDiscStateData%alpha_minus1) + UB(1:2) = ubound(SrcDiscStateData%alpha_minus1) + if (.not. allocated(DstDiscStateData%alpha_minus1)) then + allocate(DstDiscStateData%alpha_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%alpha_minus1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%alpha_minus1 = SrcDiscStateData%alpha_minus1 + end if + if (allocated(SrcDiscStateData%alpha_filt_minus1)) then + LB(1:2) = lbound(SrcDiscStateData%alpha_filt_minus1) + UB(1:2) = ubound(SrcDiscStateData%alpha_filt_minus1) + if (.not. allocated(DstDiscStateData%alpha_filt_minus1)) then + allocate(DstDiscStateData%alpha_filt_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%alpha_filt_minus1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%alpha_filt_minus1 = SrcDiscStateData%alpha_filt_minus1 + end if + if (allocated(SrcDiscStateData%alpha_dot)) then + LB(1:2) = lbound(SrcDiscStateData%alpha_dot) + UB(1:2) = ubound(SrcDiscStateData%alpha_dot) + if (.not. allocated(DstDiscStateData%alpha_dot)) then + allocate(DstDiscStateData%alpha_dot(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%alpha_dot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%alpha_dot = SrcDiscStateData%alpha_dot + end if + if (allocated(SrcDiscStateData%alpha_dot_minus1)) then + LB(1:2) = lbound(SrcDiscStateData%alpha_dot_minus1) + UB(1:2) = ubound(SrcDiscStateData%alpha_dot_minus1) + if (.not. allocated(DstDiscStateData%alpha_dot_minus1)) then + allocate(DstDiscStateData%alpha_dot_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%alpha_dot_minus1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%alpha_dot_minus1 = SrcDiscStateData%alpha_dot_minus1 + end if + if (allocated(SrcDiscStateData%q_minus1)) then + LB(1:2) = lbound(SrcDiscStateData%q_minus1) + UB(1:2) = ubound(SrcDiscStateData%q_minus1) + if (.not. allocated(DstDiscStateData%q_minus1)) then + allocate(DstDiscStateData%q_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%q_minus1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%q_minus1 = SrcDiscStateData%q_minus1 + end if + if (allocated(SrcDiscStateData%Kalpha_f_minus1)) then + LB(1:2) = lbound(SrcDiscStateData%Kalpha_f_minus1) + UB(1:2) = ubound(SrcDiscStateData%Kalpha_f_minus1) + if (.not. allocated(DstDiscStateData%Kalpha_f_minus1)) then + allocate(DstDiscStateData%Kalpha_f_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Kalpha_f_minus1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%Kalpha_f_minus1 = SrcDiscStateData%Kalpha_f_minus1 + end if + if (allocated(SrcDiscStateData%Kq_f_minus1)) then + LB(1:2) = lbound(SrcDiscStateData%Kq_f_minus1) + UB(1:2) = ubound(SrcDiscStateData%Kq_f_minus1) + if (.not. allocated(DstDiscStateData%Kq_f_minus1)) then + allocate(DstDiscStateData%Kq_f_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Kq_f_minus1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%Kq_f_minus1 = SrcDiscStateData%Kq_f_minus1 + end if + if (allocated(SrcDiscStateData%q_f_minus1)) then + LB(1:2) = lbound(SrcDiscStateData%q_f_minus1) + UB(1:2) = ubound(SrcDiscStateData%q_f_minus1) + if (.not. allocated(DstDiscStateData%q_f_minus1)) then + allocate(DstDiscStateData%q_f_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%q_f_minus1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%q_f_minus1 = SrcDiscStateData%q_f_minus1 + end if + if (allocated(SrcDiscStateData%X1_minus1)) then + LB(1:2) = lbound(SrcDiscStateData%X1_minus1) + UB(1:2) = ubound(SrcDiscStateData%X1_minus1) + if (.not. allocated(DstDiscStateData%X1_minus1)) then + allocate(DstDiscStateData%X1_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%X1_minus1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%X1_minus1 = SrcDiscStateData%X1_minus1 + end if + if (allocated(SrcDiscStateData%X2_minus1)) then + LB(1:2) = lbound(SrcDiscStateData%X2_minus1) + UB(1:2) = ubound(SrcDiscStateData%X2_minus1) + if (.not. allocated(DstDiscStateData%X2_minus1)) then + allocate(DstDiscStateData%X2_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%X2_minus1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%X2_minus1 = SrcDiscStateData%X2_minus1 + end if + if (allocated(SrcDiscStateData%X3_minus1)) then + LB(1:2) = lbound(SrcDiscStateData%X3_minus1) + UB(1:2) = ubound(SrcDiscStateData%X3_minus1) + if (.not. allocated(DstDiscStateData%X3_minus1)) then + allocate(DstDiscStateData%X3_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%X3_minus1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%X3_minus1 = SrcDiscStateData%X3_minus1 + end if + if (allocated(SrcDiscStateData%X4_minus1)) then + LB(1:2) = lbound(SrcDiscStateData%X4_minus1) + UB(1:2) = ubound(SrcDiscStateData%X4_minus1) + if (.not. allocated(DstDiscStateData%X4_minus1)) then + allocate(DstDiscStateData%X4_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%X4_minus1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%X4_minus1 = SrcDiscStateData%X4_minus1 + end if + if (allocated(SrcDiscStateData%Kprime_alpha_minus1)) then + LB(1:2) = lbound(SrcDiscStateData%Kprime_alpha_minus1) + UB(1:2) = ubound(SrcDiscStateData%Kprime_alpha_minus1) + if (.not. allocated(DstDiscStateData%Kprime_alpha_minus1)) then + allocate(DstDiscStateData%Kprime_alpha_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Kprime_alpha_minus1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%Kprime_alpha_minus1 = SrcDiscStateData%Kprime_alpha_minus1 + end if + if (allocated(SrcDiscStateData%Kprime_q_minus1)) then + LB(1:2) = lbound(SrcDiscStateData%Kprime_q_minus1) + UB(1:2) = ubound(SrcDiscStateData%Kprime_q_minus1) + if (.not. allocated(DstDiscStateData%Kprime_q_minus1)) then + allocate(DstDiscStateData%Kprime_q_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Kprime_q_minus1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%Kprime_q_minus1 = SrcDiscStateData%Kprime_q_minus1 + end if + if (allocated(SrcDiscStateData%Kprimeprime_q_minus1)) then + LB(1:2) = lbound(SrcDiscStateData%Kprimeprime_q_minus1) + UB(1:2) = ubound(SrcDiscStateData%Kprimeprime_q_minus1) + if (.not. allocated(DstDiscStateData%Kprimeprime_q_minus1)) then + allocate(DstDiscStateData%Kprimeprime_q_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Kprimeprime_q_minus1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%Kprimeprime_q_minus1 = SrcDiscStateData%Kprimeprime_q_minus1 + end if + if (allocated(SrcDiscStateData%K3prime_q_minus1)) then + LB(1:2) = lbound(SrcDiscStateData%K3prime_q_minus1) + UB(1:2) = ubound(SrcDiscStateData%K3prime_q_minus1) + if (.not. allocated(DstDiscStateData%K3prime_q_minus1)) then + allocate(DstDiscStateData%K3prime_q_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%K3prime_q_minus1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%K3prime_q_minus1 = SrcDiscStateData%K3prime_q_minus1 + end if + if (allocated(SrcDiscStateData%Dp_minus1)) then + LB(1:2) = lbound(SrcDiscStateData%Dp_minus1) + UB(1:2) = ubound(SrcDiscStateData%Dp_minus1) + if (.not. allocated(DstDiscStateData%Dp_minus1)) then + allocate(DstDiscStateData%Dp_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Dp_minus1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%Dp_minus1 = SrcDiscStateData%Dp_minus1 + end if + if (allocated(SrcDiscStateData%Cn_pot_minus1)) then + LB(1:2) = lbound(SrcDiscStateData%Cn_pot_minus1) + UB(1:2) = ubound(SrcDiscStateData%Cn_pot_minus1) + if (.not. allocated(DstDiscStateData%Cn_pot_minus1)) then + allocate(DstDiscStateData%Cn_pot_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Cn_pot_minus1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%Cn_pot_minus1 = SrcDiscStateData%Cn_pot_minus1 + end if + if (allocated(SrcDiscStateData%fprimeprime_minus1)) then + LB(1:2) = lbound(SrcDiscStateData%fprimeprime_minus1) + UB(1:2) = ubound(SrcDiscStateData%fprimeprime_minus1) + if (.not. allocated(DstDiscStateData%fprimeprime_minus1)) then + allocate(DstDiscStateData%fprimeprime_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%fprimeprime_minus1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%fprimeprime_minus1 = SrcDiscStateData%fprimeprime_minus1 + end if + if (allocated(SrcDiscStateData%fprimeprime_c_minus1)) then + LB(1:2) = lbound(SrcDiscStateData%fprimeprime_c_minus1) + UB(1:2) = ubound(SrcDiscStateData%fprimeprime_c_minus1) + if (.not. allocated(DstDiscStateData%fprimeprime_c_minus1)) then + allocate(DstDiscStateData%fprimeprime_c_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%fprimeprime_c_minus1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%fprimeprime_c_minus1 = SrcDiscStateData%fprimeprime_c_minus1 + end if + if (allocated(SrcDiscStateData%fprimeprime_m_minus1)) then + LB(1:2) = lbound(SrcDiscStateData%fprimeprime_m_minus1) + UB(1:2) = ubound(SrcDiscStateData%fprimeprime_m_minus1) + if (.not. allocated(DstDiscStateData%fprimeprime_m_minus1)) then + allocate(DstDiscStateData%fprimeprime_m_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%fprimeprime_m_minus1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%fprimeprime_m_minus1 = SrcDiscStateData%fprimeprime_m_minus1 + end if + if (allocated(SrcDiscStateData%Df_minus1)) then + LB(1:2) = lbound(SrcDiscStateData%Df_minus1) + UB(1:2) = ubound(SrcDiscStateData%Df_minus1) + if (.not. allocated(DstDiscStateData%Df_minus1)) then + allocate(DstDiscStateData%Df_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Df_minus1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%Df_minus1 = SrcDiscStateData%Df_minus1 + end if + if (allocated(SrcDiscStateData%Df_c_minus1)) then + LB(1:2) = lbound(SrcDiscStateData%Df_c_minus1) + UB(1:2) = ubound(SrcDiscStateData%Df_c_minus1) + if (.not. allocated(DstDiscStateData%Df_c_minus1)) then + allocate(DstDiscStateData%Df_c_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Df_c_minus1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%Df_c_minus1 = SrcDiscStateData%Df_c_minus1 + end if + if (allocated(SrcDiscStateData%Df_m_minus1)) then + LB(1:2) = lbound(SrcDiscStateData%Df_m_minus1) + UB(1:2) = ubound(SrcDiscStateData%Df_m_minus1) + if (.not. allocated(DstDiscStateData%Df_m_minus1)) then + allocate(DstDiscStateData%Df_m_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Df_m_minus1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%Df_m_minus1 = SrcDiscStateData%Df_m_minus1 + end if + if (allocated(SrcDiscStateData%Dalphaf_minus1)) then + LB(1:2) = lbound(SrcDiscStateData%Dalphaf_minus1) + UB(1:2) = ubound(SrcDiscStateData%Dalphaf_minus1) + if (.not. allocated(DstDiscStateData%Dalphaf_minus1)) then + allocate(DstDiscStateData%Dalphaf_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Dalphaf_minus1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%Dalphaf_minus1 = SrcDiscStateData%Dalphaf_minus1 + end if + if (allocated(SrcDiscStateData%alphaf_minus1)) then + LB(1:2) = lbound(SrcDiscStateData%alphaf_minus1) + UB(1:2) = ubound(SrcDiscStateData%alphaf_minus1) + if (.not. allocated(DstDiscStateData%alphaf_minus1)) then + allocate(DstDiscStateData%alphaf_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%alphaf_minus1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%alphaf_minus1 = SrcDiscStateData%alphaf_minus1 + end if + if (allocated(SrcDiscStateData%fprime_minus1)) then + LB(1:2) = lbound(SrcDiscStateData%fprime_minus1) + UB(1:2) = ubound(SrcDiscStateData%fprime_minus1) + if (.not. allocated(DstDiscStateData%fprime_minus1)) then + allocate(DstDiscStateData%fprime_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%fprime_minus1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%fprime_minus1 = SrcDiscStateData%fprime_minus1 + end if + if (allocated(SrcDiscStateData%fprime_c_minus1)) then + LB(1:2) = lbound(SrcDiscStateData%fprime_c_minus1) + UB(1:2) = ubound(SrcDiscStateData%fprime_c_minus1) + if (.not. allocated(DstDiscStateData%fprime_c_minus1)) then + allocate(DstDiscStateData%fprime_c_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%fprime_c_minus1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%fprime_c_minus1 = SrcDiscStateData%fprime_c_minus1 + end if + if (allocated(SrcDiscStateData%fprime_m_minus1)) then + LB(1:2) = lbound(SrcDiscStateData%fprime_m_minus1) + UB(1:2) = ubound(SrcDiscStateData%fprime_m_minus1) + if (.not. allocated(DstDiscStateData%fprime_m_minus1)) then + allocate(DstDiscStateData%fprime_m_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%fprime_m_minus1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%fprime_m_minus1 = SrcDiscStateData%fprime_m_minus1 + end if + if (allocated(SrcDiscStateData%tau_V)) then + LB(1:2) = lbound(SrcDiscStateData%tau_V) + UB(1:2) = ubound(SrcDiscStateData%tau_V) + if (.not. allocated(DstDiscStateData%tau_V)) then + allocate(DstDiscStateData%tau_V(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%tau_V.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%tau_V = SrcDiscStateData%tau_V + end if + if (allocated(SrcDiscStateData%tau_V_minus1)) then + LB(1:2) = lbound(SrcDiscStateData%tau_V_minus1) + UB(1:2) = ubound(SrcDiscStateData%tau_V_minus1) + if (.not. allocated(DstDiscStateData%tau_V_minus1)) then + allocate(DstDiscStateData%tau_V_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%tau_V_minus1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%tau_V_minus1 = SrcDiscStateData%tau_V_minus1 + end if + if (allocated(SrcDiscStateData%Cn_v_minus1)) then + LB(1:2) = lbound(SrcDiscStateData%Cn_v_minus1) + UB(1:2) = ubound(SrcDiscStateData%Cn_v_minus1) + if (.not. allocated(DstDiscStateData%Cn_v_minus1)) then + allocate(DstDiscStateData%Cn_v_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Cn_v_minus1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%Cn_v_minus1 = SrcDiscStateData%Cn_v_minus1 + end if + if (allocated(SrcDiscStateData%C_V_minus1)) then + LB(1:2) = lbound(SrcDiscStateData%C_V_minus1) + UB(1:2) = ubound(SrcDiscStateData%C_V_minus1) + if (.not. allocated(DstDiscStateData%C_V_minus1)) then + allocate(DstDiscStateData%C_V_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%C_V_minus1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%C_V_minus1 = SrcDiscStateData%C_V_minus1 + end if + if (allocated(SrcDiscStateData%Cn_prime_minus1)) then + LB(1:2) = lbound(SrcDiscStateData%Cn_prime_minus1) + UB(1:2) = ubound(SrcDiscStateData%Cn_prime_minus1) + if (.not. allocated(DstDiscStateData%Cn_prime_minus1)) then + allocate(DstDiscStateData%Cn_prime_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Cn_prime_minus1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%Cn_prime_minus1 = SrcDiscStateData%Cn_prime_minus1 + end if +end subroutine + +subroutine UA_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) + type(UA_DiscreteStateType), intent(inout) :: DiscStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'UA_DestroyDiscState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(DiscStateData%alpha_minus1)) then + deallocate(DiscStateData%alpha_minus1) + end if + if (allocated(DiscStateData%alpha_filt_minus1)) then + deallocate(DiscStateData%alpha_filt_minus1) + end if + if (allocated(DiscStateData%alpha_dot)) then + deallocate(DiscStateData%alpha_dot) + end if + if (allocated(DiscStateData%alpha_dot_minus1)) then + deallocate(DiscStateData%alpha_dot_minus1) + end if + if (allocated(DiscStateData%q_minus1)) then + deallocate(DiscStateData%q_minus1) + end if + if (allocated(DiscStateData%Kalpha_f_minus1)) then + deallocate(DiscStateData%Kalpha_f_minus1) + end if + if (allocated(DiscStateData%Kq_f_minus1)) then + deallocate(DiscStateData%Kq_f_minus1) + end if + if (allocated(DiscStateData%q_f_minus1)) then + deallocate(DiscStateData%q_f_minus1) + end if + if (allocated(DiscStateData%X1_minus1)) then + deallocate(DiscStateData%X1_minus1) + end if + if (allocated(DiscStateData%X2_minus1)) then + deallocate(DiscStateData%X2_minus1) + end if + if (allocated(DiscStateData%X3_minus1)) then + deallocate(DiscStateData%X3_minus1) + end if + if (allocated(DiscStateData%X4_minus1)) then + deallocate(DiscStateData%X4_minus1) + end if + if (allocated(DiscStateData%Kprime_alpha_minus1)) then + deallocate(DiscStateData%Kprime_alpha_minus1) + end if + if (allocated(DiscStateData%Kprime_q_minus1)) then + deallocate(DiscStateData%Kprime_q_minus1) + end if + if (allocated(DiscStateData%Kprimeprime_q_minus1)) then + deallocate(DiscStateData%Kprimeprime_q_minus1) + end if + if (allocated(DiscStateData%K3prime_q_minus1)) then + deallocate(DiscStateData%K3prime_q_minus1) + end if + if (allocated(DiscStateData%Dp_minus1)) then + deallocate(DiscStateData%Dp_minus1) + end if + if (allocated(DiscStateData%Cn_pot_minus1)) then + deallocate(DiscStateData%Cn_pot_minus1) + end if + if (allocated(DiscStateData%fprimeprime_minus1)) then + deallocate(DiscStateData%fprimeprime_minus1) + end if + if (allocated(DiscStateData%fprimeprime_c_minus1)) then + deallocate(DiscStateData%fprimeprime_c_minus1) + end if + if (allocated(DiscStateData%fprimeprime_m_minus1)) then + deallocate(DiscStateData%fprimeprime_m_minus1) + end if + if (allocated(DiscStateData%Df_minus1)) then + deallocate(DiscStateData%Df_minus1) + end if + if (allocated(DiscStateData%Df_c_minus1)) then + deallocate(DiscStateData%Df_c_minus1) + end if + if (allocated(DiscStateData%Df_m_minus1)) then + deallocate(DiscStateData%Df_m_minus1) + end if + if (allocated(DiscStateData%Dalphaf_minus1)) then + deallocate(DiscStateData%Dalphaf_minus1) + end if + if (allocated(DiscStateData%alphaf_minus1)) then + deallocate(DiscStateData%alphaf_minus1) + end if + if (allocated(DiscStateData%fprime_minus1)) then + deallocate(DiscStateData%fprime_minus1) + end if + if (allocated(DiscStateData%fprime_c_minus1)) then + deallocate(DiscStateData%fprime_c_minus1) + end if + if (allocated(DiscStateData%fprime_m_minus1)) then + deallocate(DiscStateData%fprime_m_minus1) + end if + if (allocated(DiscStateData%tau_V)) then + deallocate(DiscStateData%tau_V) + end if + if (allocated(DiscStateData%tau_V_minus1)) then + deallocate(DiscStateData%tau_V_minus1) + end if + if (allocated(DiscStateData%Cn_v_minus1)) then + deallocate(DiscStateData%Cn_v_minus1) + end if + if (allocated(DiscStateData%C_V_minus1)) then + deallocate(DiscStateData%C_V_minus1) + end if + if (allocated(DiscStateData%Cn_prime_minus1)) then + deallocate(DiscStateData%Cn_prime_minus1) + end if +end subroutine + +subroutine UA_PackDiscState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(UA_DiscreteStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'UA_PackDiscState' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%alpha_minus1) + call RegPackAlloc(RF, InData%alpha_filt_minus1) + call RegPackAlloc(RF, InData%alpha_dot) + call RegPackAlloc(RF, InData%alpha_dot_minus1) + call RegPackAlloc(RF, InData%q_minus1) + call RegPackAlloc(RF, InData%Kalpha_f_minus1) + call RegPackAlloc(RF, InData%Kq_f_minus1) + call RegPackAlloc(RF, InData%q_f_minus1) + call RegPackAlloc(RF, InData%X1_minus1) + call RegPackAlloc(RF, InData%X2_minus1) + call RegPackAlloc(RF, InData%X3_minus1) + call RegPackAlloc(RF, InData%X4_minus1) + call RegPackAlloc(RF, InData%Kprime_alpha_minus1) + call RegPackAlloc(RF, InData%Kprime_q_minus1) + call RegPackAlloc(RF, InData%Kprimeprime_q_minus1) + call RegPackAlloc(RF, InData%K3prime_q_minus1) + call RegPackAlloc(RF, InData%Dp_minus1) + call RegPackAlloc(RF, InData%Cn_pot_minus1) + call RegPackAlloc(RF, InData%fprimeprime_minus1) + call RegPackAlloc(RF, InData%fprimeprime_c_minus1) + call RegPackAlloc(RF, InData%fprimeprime_m_minus1) + call RegPackAlloc(RF, InData%Df_minus1) + call RegPackAlloc(RF, InData%Df_c_minus1) + call RegPackAlloc(RF, InData%Df_m_minus1) + call RegPackAlloc(RF, InData%Dalphaf_minus1) + call RegPackAlloc(RF, InData%alphaf_minus1) + call RegPackAlloc(RF, InData%fprime_minus1) + call RegPackAlloc(RF, InData%fprime_c_minus1) + call RegPackAlloc(RF, InData%fprime_m_minus1) + call RegPackAlloc(RF, InData%tau_V) + call RegPackAlloc(RF, InData%tau_V_minus1) + call RegPackAlloc(RF, InData%Cn_v_minus1) + call RegPackAlloc(RF, InData%C_V_minus1) + call RegPackAlloc(RF, InData%Cn_prime_minus1) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine UA_UnPackDiscState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(UA_DiscreteStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'UA_UnPackDiscState' + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%alpha_minus1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%alpha_filt_minus1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%alpha_dot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%alpha_dot_minus1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%q_minus1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Kalpha_f_minus1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Kq_f_minus1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%q_f_minus1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%X1_minus1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%X2_minus1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%X3_minus1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%X4_minus1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Kprime_alpha_minus1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Kprime_q_minus1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Kprimeprime_q_minus1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%K3prime_q_minus1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Dp_minus1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Cn_pot_minus1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%fprimeprime_minus1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%fprimeprime_c_minus1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%fprimeprime_m_minus1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Df_minus1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Df_c_minus1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Df_m_minus1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Dalphaf_minus1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%alphaf_minus1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%fprime_minus1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%fprime_c_minus1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%fprime_m_minus1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%tau_V); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%tau_V_minus1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Cn_v_minus1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%C_V_minus1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Cn_prime_minus1); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine UA_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) + type(UA_ConstraintStateType), intent(in) :: SrcConstrStateData + type(UA_ConstraintStateType), intent(inout) :: DstConstrStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'UA_CopyConstrState' + ErrStat = ErrID_None + ErrMsg = '' + DstConstrStateData%DummyConstraintState = SrcConstrStateData%DummyConstraintState +end subroutine + +subroutine UA_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) + type(UA_ConstraintStateType), intent(inout) :: ConstrStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'UA_DestroyConstrState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine UA_PackConstrState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(UA_ConstraintStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'UA_PackConstrState' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyConstraintState) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine UA_UnPackConstrState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(UA_ConstraintStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'UA_UnPackConstrState' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyConstraintState); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine UA_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) + type(UA_OtherStateType), intent(in) :: SrcOtherStateData + type(UA_OtherStateType), intent(inout) :: DstOtherStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'UA_CopyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcOtherStateData%FirstPass)) then + LB(1:2) = lbound(SrcOtherStateData%FirstPass) + UB(1:2) = ubound(SrcOtherStateData%FirstPass) + if (.not. allocated(DstOtherStateData%FirstPass)) then + allocate(DstOtherStateData%FirstPass(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%FirstPass.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOtherStateData%FirstPass = SrcOtherStateData%FirstPass + end if + if (allocated(SrcOtherStateData%sigma1)) then + LB(1:2) = lbound(SrcOtherStateData%sigma1) + UB(1:2) = ubound(SrcOtherStateData%sigma1) + if (.not. allocated(DstOtherStateData%sigma1)) then + allocate(DstOtherStateData%sigma1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%sigma1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOtherStateData%sigma1 = SrcOtherStateData%sigma1 + end if + if (allocated(SrcOtherStateData%sigma1c)) then + LB(1:2) = lbound(SrcOtherStateData%sigma1c) + UB(1:2) = ubound(SrcOtherStateData%sigma1c) + if (.not. allocated(DstOtherStateData%sigma1c)) then + allocate(DstOtherStateData%sigma1c(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%sigma1c.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOtherStateData%sigma1c = SrcOtherStateData%sigma1c + end if + if (allocated(SrcOtherStateData%sigma1m)) then + LB(1:2) = lbound(SrcOtherStateData%sigma1m) + UB(1:2) = ubound(SrcOtherStateData%sigma1m) + if (.not. allocated(DstOtherStateData%sigma1m)) then + allocate(DstOtherStateData%sigma1m(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%sigma1m.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOtherStateData%sigma1m = SrcOtherStateData%sigma1m + end if + if (allocated(SrcOtherStateData%sigma3)) then + LB(1:2) = lbound(SrcOtherStateData%sigma3) + UB(1:2) = ubound(SrcOtherStateData%sigma3) + if (.not. allocated(DstOtherStateData%sigma3)) then + allocate(DstOtherStateData%sigma3(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%sigma3.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOtherStateData%sigma3 = SrcOtherStateData%sigma3 + end if + if (allocated(SrcOtherStateData%n)) then + LB(1:2) = lbound(SrcOtherStateData%n) + UB(1:2) = ubound(SrcOtherStateData%n) + if (.not. allocated(DstOtherStateData%n)) then + allocate(DstOtherStateData%n(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%n.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOtherStateData%n = SrcOtherStateData%n + end if + LB(1:1) = lbound(SrcOtherStateData%xdot) + UB(1:1) = ubound(SrcOtherStateData%xdot) + do i1 = LB(1), UB(1) + call UA_CopyContState(SrcOtherStateData%xdot(i1), DstOtherStateData%xdot(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + LB(1:1) = lbound(SrcOtherStateData%xHistory) + UB(1:1) = ubound(SrcOtherStateData%xHistory) + do i1 = LB(1), UB(1) + call UA_CopyContState(SrcOtherStateData%xHistory(i1), DstOtherStateData%xHistory(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + if (allocated(SrcOtherStateData%t_vortexBegin)) then + LB(1:2) = lbound(SrcOtherStateData%t_vortexBegin) + UB(1:2) = ubound(SrcOtherStateData%t_vortexBegin) + if (.not. allocated(DstOtherStateData%t_vortexBegin)) then + allocate(DstOtherStateData%t_vortexBegin(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%t_vortexBegin.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOtherStateData%t_vortexBegin = SrcOtherStateData%t_vortexBegin + end if + if (allocated(SrcOtherStateData%SignOfOmega)) then + LB(1:2) = lbound(SrcOtherStateData%SignOfOmega) + UB(1:2) = ubound(SrcOtherStateData%SignOfOmega) + if (.not. allocated(DstOtherStateData%SignOfOmega)) then + allocate(DstOtherStateData%SignOfOmega(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%SignOfOmega.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOtherStateData%SignOfOmega = SrcOtherStateData%SignOfOmega + end if + if (allocated(SrcOtherStateData%PositivePressure)) then + LB(1:2) = lbound(SrcOtherStateData%PositivePressure) + UB(1:2) = ubound(SrcOtherStateData%PositivePressure) + if (.not. allocated(DstOtherStateData%PositivePressure)) then + allocate(DstOtherStateData%PositivePressure(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%PositivePressure.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOtherStateData%PositivePressure = SrcOtherStateData%PositivePressure + end if + if (allocated(SrcOtherStateData%vortexOn)) then + LB(1:2) = lbound(SrcOtherStateData%vortexOn) + UB(1:2) = ubound(SrcOtherStateData%vortexOn) + if (.not. allocated(DstOtherStateData%vortexOn)) then + allocate(DstOtherStateData%vortexOn(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%vortexOn.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOtherStateData%vortexOn = SrcOtherStateData%vortexOn + end if + if (allocated(SrcOtherStateData%BelowThreshold)) then + LB(1:2) = lbound(SrcOtherStateData%BelowThreshold) + UB(1:2) = ubound(SrcOtherStateData%BelowThreshold) + if (.not. allocated(DstOtherStateData%BelowThreshold)) then + allocate(DstOtherStateData%BelowThreshold(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%BelowThreshold.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOtherStateData%BelowThreshold = SrcOtherStateData%BelowThreshold + end if + if (allocated(SrcOtherStateData%activeL)) then + LB(1:2) = lbound(SrcOtherStateData%activeL) + UB(1:2) = ubound(SrcOtherStateData%activeL) + if (.not. allocated(DstOtherStateData%activeL)) then + allocate(DstOtherStateData%activeL(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%activeL.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOtherStateData%activeL = SrcOtherStateData%activeL + end if + if (allocated(SrcOtherStateData%activeD)) then + LB(1:2) = lbound(SrcOtherStateData%activeD) + UB(1:2) = ubound(SrcOtherStateData%activeD) + if (.not. allocated(DstOtherStateData%activeD)) then + allocate(DstOtherStateData%activeD(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%activeD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOtherStateData%activeD = SrcOtherStateData%activeD + end if +end subroutine + +subroutine UA_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) + type(UA_OtherStateType), intent(inout) :: OtherStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'UA_DestroyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OtherStateData%FirstPass)) then + deallocate(OtherStateData%FirstPass) + end if + if (allocated(OtherStateData%sigma1)) then + deallocate(OtherStateData%sigma1) + end if + if (allocated(OtherStateData%sigma1c)) then + deallocate(OtherStateData%sigma1c) + end if + if (allocated(OtherStateData%sigma1m)) then + deallocate(OtherStateData%sigma1m) + end if + if (allocated(OtherStateData%sigma3)) then + deallocate(OtherStateData%sigma3) + end if + if (allocated(OtherStateData%n)) then + deallocate(OtherStateData%n) + end if + LB(1:1) = lbound(OtherStateData%xdot) + UB(1:1) = ubound(OtherStateData%xdot) + do i1 = LB(1), UB(1) + call UA_DestroyContState(OtherStateData%xdot(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(OtherStateData%xHistory) + UB(1:1) = ubound(OtherStateData%xHistory) + do i1 = LB(1), UB(1) + call UA_DestroyContState(OtherStateData%xHistory(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + if (allocated(OtherStateData%t_vortexBegin)) then + deallocate(OtherStateData%t_vortexBegin) + end if + if (allocated(OtherStateData%SignOfOmega)) then + deallocate(OtherStateData%SignOfOmega) + end if + if (allocated(OtherStateData%PositivePressure)) then + deallocate(OtherStateData%PositivePressure) + end if + if (allocated(OtherStateData%vortexOn)) then + deallocate(OtherStateData%vortexOn) + end if + if (allocated(OtherStateData%BelowThreshold)) then + deallocate(OtherStateData%BelowThreshold) + end if + if (allocated(OtherStateData%activeL)) then + deallocate(OtherStateData%activeL) + end if + if (allocated(OtherStateData%activeD)) then + deallocate(OtherStateData%activeD) + end if +end subroutine + +subroutine UA_PackOtherState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(UA_OtherStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'UA_PackOtherState' + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%FirstPass) + call RegPackAlloc(RF, InData%sigma1) + call RegPackAlloc(RF, InData%sigma1c) + call RegPackAlloc(RF, InData%sigma1m) + call RegPackAlloc(RF, InData%sigma3) + call RegPackAlloc(RF, InData%n) + LB(1:1) = lbound(InData%xdot) + UB(1:1) = ubound(InData%xdot) + do i1 = LB(1), UB(1) + call UA_PackContState(RF, InData%xdot(i1)) + end do + LB(1:1) = lbound(InData%xHistory) + UB(1:1) = ubound(InData%xHistory) + do i1 = LB(1), UB(1) + call UA_PackContState(RF, InData%xHistory(i1)) + end do + call RegPackAlloc(RF, InData%t_vortexBegin) + call RegPackAlloc(RF, InData%SignOfOmega) + call RegPackAlloc(RF, InData%PositivePressure) + call RegPackAlloc(RF, InData%vortexOn) + call RegPackAlloc(RF, InData%BelowThreshold) + call RegPackAlloc(RF, InData%activeL) + call RegPackAlloc(RF, InData%activeD) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine UA_UnPackOtherState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(UA_OtherStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'UA_UnPackOtherState' + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%FirstPass); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%sigma1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%sigma1c); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%sigma1m); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%sigma3); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%n); if (RegCheckErr(RF, RoutineName)) return + LB(1:1) = lbound(OutData%xdot) + UB(1:1) = ubound(OutData%xdot) + do i1 = LB(1), UB(1) + call UA_UnpackContState(RF, OutData%xdot(i1)) ! xdot + end do + LB(1:1) = lbound(OutData%xHistory) + UB(1:1) = ubound(OutData%xHistory) + do i1 = LB(1), UB(1) + call UA_UnpackContState(RF, OutData%xHistory(i1)) ! xHistory + end do + call RegUnpackAlloc(RF, OutData%t_vortexBegin); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%SignOfOmega); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PositivePressure); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%vortexOn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BelowThreshold); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%activeL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%activeD); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine UA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(UA_MiscVarType), intent(in) :: SrcMiscData + type(UA_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'UA_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + DstMiscData%FirstWarn_M = SrcMiscData%FirstWarn_M + DstMiscData%FirstWarn_UA = SrcMiscData%FirstWarn_UA + DstMiscData%FirstWarn_UA_off = SrcMiscData%FirstWarn_UA_off + if (allocated(SrcMiscData%TESF)) then + LB(1:2) = lbound(SrcMiscData%TESF) + UB(1:2) = ubound(SrcMiscData%TESF) + if (.not. allocated(DstMiscData%TESF)) then + allocate(DstMiscData%TESF(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%TESF.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%TESF = SrcMiscData%TESF + end if + if (allocated(SrcMiscData%LESF)) then + LB(1:2) = lbound(SrcMiscData%LESF) + UB(1:2) = ubound(SrcMiscData%LESF) + if (.not. allocated(DstMiscData%LESF)) then + allocate(DstMiscData%LESF(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%LESF.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%LESF = SrcMiscData%LESF + end if + if (allocated(SrcMiscData%VRTX)) then + LB(1:2) = lbound(SrcMiscData%VRTX) + UB(1:2) = ubound(SrcMiscData%VRTX) + if (.not. allocated(DstMiscData%VRTX)) then + allocate(DstMiscData%VRTX(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%VRTX.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%VRTX = SrcMiscData%VRTX + end if + if (allocated(SrcMiscData%T_Sh)) then + LB(1:2) = lbound(SrcMiscData%T_Sh) + UB(1:2) = ubound(SrcMiscData%T_Sh) + if (.not. allocated(DstMiscData%T_Sh)) then + allocate(DstMiscData%T_Sh(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%T_Sh.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%T_Sh = SrcMiscData%T_Sh + end if + if (allocated(SrcMiscData%BEDSEP)) then + LB(1:2) = lbound(SrcMiscData%BEDSEP) + UB(1:2) = ubound(SrcMiscData%BEDSEP) + if (.not. allocated(DstMiscData%BEDSEP)) then + allocate(DstMiscData%BEDSEP(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BEDSEP.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%BEDSEP = SrcMiscData%BEDSEP + end if + if (allocated(SrcMiscData%weight)) then + LB(1:2) = lbound(SrcMiscData%weight) + UB(1:2) = ubound(SrcMiscData%weight) + if (.not. allocated(DstMiscData%weight)) then + allocate(DstMiscData%weight(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%weight.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%weight = SrcMiscData%weight + end if +end subroutine + +subroutine UA_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(UA_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'UA_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(MiscData%TESF)) then + deallocate(MiscData%TESF) + end if + if (allocated(MiscData%LESF)) then + deallocate(MiscData%LESF) + end if + if (allocated(MiscData%VRTX)) then + deallocate(MiscData%VRTX) + end if + if (allocated(MiscData%T_Sh)) then + deallocate(MiscData%T_Sh) + end if + if (allocated(MiscData%BEDSEP)) then + deallocate(MiscData%BEDSEP) + end if + if (allocated(MiscData%weight)) then + deallocate(MiscData%weight) + end if +end subroutine + +subroutine UA_PackMisc(RF, Indata) + type(RegFile), intent(inout) :: RF + type(UA_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'UA_PackMisc' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%FirstWarn_M) + call RegPack(RF, InData%FirstWarn_UA) + call RegPack(RF, InData%FirstWarn_UA_off) + call RegPackAlloc(RF, InData%TESF) + call RegPackAlloc(RF, InData%LESF) + call RegPackAlloc(RF, InData%VRTX) + call RegPackAlloc(RF, InData%T_Sh) + call RegPackAlloc(RF, InData%BEDSEP) + call RegPackAlloc(RF, InData%weight) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine UA_UnPackMisc(RF, OutData) + type(RegFile), intent(inout) :: RF + type(UA_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'UA_UnPackMisc' + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%FirstWarn_M); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FirstWarn_UA); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FirstWarn_UA_off); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TESF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LESF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%VRTX); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%T_Sh); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BEDSEP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%weight); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine UA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(UA_ParameterType), intent(in) :: SrcParamData + type(UA_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'UA_CopyParam' + ErrStat = ErrID_None + ErrMsg = '' + DstParamData%dt = SrcParamData%dt + if (allocated(SrcParamData%c)) then + LB(1:2) = lbound(SrcParamData%c) + UB(1:2) = ubound(SrcParamData%c) + if (.not. allocated(DstParamData%c)) then + allocate(DstParamData%c(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%c.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%c = SrcParamData%c + end if + DstParamData%d_34_to_ac = SrcParamData%d_34_to_ac + DstParamData%numBlades = SrcParamData%numBlades + DstParamData%nNodesPerBlade = SrcParamData%nNodesPerBlade + DstParamData%UAMod = SrcParamData%UAMod + DstParamData%Flookup = SrcParamData%Flookup + DstParamData%a_s = SrcParamData%a_s + DstParamData%NumOuts = SrcParamData%NumOuts + DstParamData%OutSwtch = SrcParamData%OutSwtch + DstParamData%OutFmt = SrcParamData%OutFmt + DstParamData%OutSFmt = SrcParamData%OutSFmt + DstParamData%Delim = SrcParamData%Delim + DstParamData%UnOutFile = SrcParamData%UnOutFile + DstParamData%ShedEffect = SrcParamData%ShedEffect + DstParamData%lin_nx = SrcParamData%lin_nx + if (allocated(SrcParamData%UA_off_forGood)) then + LB(1:2) = lbound(SrcParamData%UA_off_forGood) + UB(1:2) = ubound(SrcParamData%UA_off_forGood) + if (.not. allocated(DstParamData%UA_off_forGood)) then + allocate(DstParamData%UA_off_forGood(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%UA_off_forGood.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%UA_off_forGood = SrcParamData%UA_off_forGood + end if + if (allocated(SrcParamData%lin_xIndx)) then + LB(1:2) = lbound(SrcParamData%lin_xIndx) + UB(1:2) = ubound(SrcParamData%lin_xIndx) + if (.not. allocated(DstParamData%lin_xIndx)) then + allocate(DstParamData%lin_xIndx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%lin_xIndx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%lin_xIndx = SrcParamData%lin_xIndx + end if + DstParamData%dx = SrcParamData%dx + DstParamData%UA_OUTS = SrcParamData%UA_OUTS + DstParamData%integrationMethod = SrcParamData%integrationMethod +end subroutine + +subroutine UA_DestroyParam(ParamData, ErrStat, ErrMsg) + type(UA_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'UA_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ParamData%c)) then + deallocate(ParamData%c) + end if + if (allocated(ParamData%UA_off_forGood)) then + deallocate(ParamData%UA_off_forGood) + end if + if (allocated(ParamData%lin_xIndx)) then + deallocate(ParamData%lin_xIndx) + end if +end subroutine + +subroutine UA_PackParam(RF, Indata) + type(RegFile), intent(inout) :: RF + type(UA_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'UA_PackParam' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%dt) + call RegPackAlloc(RF, InData%c) + call RegPack(RF, InData%d_34_to_ac) + call RegPack(RF, InData%numBlades) + call RegPack(RF, InData%nNodesPerBlade) + call RegPack(RF, InData%UAMod) + call RegPack(RF, InData%Flookup) + call RegPack(RF, InData%a_s) + call RegPack(RF, InData%NumOuts) + call RegPack(RF, InData%OutSwtch) + call RegPack(RF, InData%OutFmt) + call RegPack(RF, InData%OutSFmt) + call RegPack(RF, InData%Delim) + call RegPack(RF, InData%UnOutFile) + call RegPack(RF, InData%ShedEffect) + call RegPack(RF, InData%lin_nx) + call RegPackAlloc(RF, InData%UA_off_forGood) + call RegPackAlloc(RF, InData%lin_xIndx) + call RegPack(RF, InData%dx) + call RegPack(RF, InData%UA_OUTS) + call RegPack(RF, InData%integrationMethod) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine UA_UnPackParam(RF, OutData) + type(RegFile), intent(inout) :: RF + type(UA_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'UA_UnPackParam' + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%dt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%c); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%d_34_to_ac); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%numBlades); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nNodesPerBlade); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UAMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Flookup); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%a_s); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumOuts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutSwtch); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutFmt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutSFmt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Delim); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UnOutFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ShedEffect); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%lin_nx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%UA_off_forGood); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%lin_xIndx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%dx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UA_OUTS); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%integrationMethod); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine UA_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) + type(UA_InputType), intent(in) :: SrcInputData + type(UA_InputType), intent(inout) :: DstInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'UA_CopyInput' + ErrStat = ErrID_None + ErrMsg = '' + DstInputData%U = SrcInputData%U + DstInputData%alpha = SrcInputData%alpha + DstInputData%Re = SrcInputData%Re + DstInputData%UserProp = SrcInputData%UserProp + DstInputData%v_ac = SrcInputData%v_ac + DstInputData%omega = SrcInputData%omega +end subroutine + +subroutine UA_DestroyInput(InputData, ErrStat, ErrMsg) + type(UA_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'UA_DestroyInput' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine UA_PackInput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(UA_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'UA_PackInput' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%U) + call RegPack(RF, InData%alpha) + call RegPack(RF, InData%Re) + call RegPack(RF, InData%UserProp) + call RegPack(RF, InData%v_ac) + call RegPack(RF, InData%omega) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine UA_UnPackInput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(UA_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'UA_UnPackInput' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%U); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%alpha); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Re); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UserProp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%v_ac); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%omega); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine UA_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(UA_OutputType), intent(in) :: SrcOutputData + type(UA_OutputType), intent(inout) :: DstOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'UA_CopyOutput' + ErrStat = ErrID_None + ErrMsg = '' + DstOutputData%Cn = SrcOutputData%Cn + DstOutputData%Cc = SrcOutputData%Cc + DstOutputData%Cm = SrcOutputData%Cm + DstOutputData%Cl = SrcOutputData%Cl + DstOutputData%Cd = SrcOutputData%Cd + if (allocated(SrcOutputData%WriteOutput)) then + LB(1:1) = lbound(SrcOutputData%WriteOutput) + UB(1:1) = ubound(SrcOutputData%WriteOutput) + if (.not. allocated(DstOutputData%WriteOutput)) then + allocate(DstOutputData%WriteOutput(LB(1):UB(1)), 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 + end if +end subroutine + +subroutine UA_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(UA_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'UA_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OutputData%WriteOutput)) then + deallocate(OutputData%WriteOutput) + end if +end subroutine + +subroutine UA_PackOutput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(UA_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'UA_PackOutput' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%Cn) + call RegPack(RF, InData%Cc) + call RegPack(RF, InData%Cm) + call RegPack(RF, InData%Cl) + call RegPack(RF, InData%Cd) + call RegPackAlloc(RF, InData%WriteOutput) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine UA_UnPackOutput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(UA_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'UA_UnPackOutput' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%Cn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Cc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Cm); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Cl); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Cd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WriteOutput); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine UA_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(UA_InputType), intent(in) :: u(:) ! Input at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Inputs + type(UA_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 = 'UA_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 UA_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL UA_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 UA_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 UA_Input_ExtrapInterp - - - SUBROUTINE UA_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'UA_Input_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(u)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(u)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(u) - 1 + select case (order) + case (0) + call UA_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call UA_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call UA_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(u) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE UA_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. @@ -6749,54 +2249,48 @@ SUBROUTINE UA_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) ! !.................................................................................................................................. - TYPE(UA_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 - TYPE(UA_InputType), INTENT(IN) :: u2 ! Input at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs - TYPE(UA_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 + TYPE(UA_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 + TYPE(UA_InputType), INTENT(IN) :: u2 ! Input at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs + TYPE(UA_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 = 'UA_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 + REAL(DbKi) :: t(2) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'UA_Input_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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) - b = -(u1%U - u2%U) - u_out%U = u1%U + b * ScaleFactor - CALL Angles_ExtrapInterp( u1%alpha, u2%alpha, tin, u_out%alpha, tin_out ) - b = -(u1%Re - u2%Re) - u_out%Re = u1%Re + b * ScaleFactor - b = -(u1%UserProp - u2%UserProp) - u_out%UserProp = u1%UserProp + b * ScaleFactor - DO i1 = LBOUND(u_out%v_ac,1),UBOUND(u_out%v_ac,1) - b = -(u1%v_ac(i1) - u2%v_ac(i1)) - u_out%v_ac(i1) = u1%v_ac(i1) + b * ScaleFactor - END DO - b = -(u1%omega - u2%omega) - u_out%omega = u1%omega + b * ScaleFactor - END SUBROUTINE UA_Input_ExtrapInterp1 - - - SUBROUTINE UA_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + u_out%U = a1*u1%U + a2*u2%U + CALL Angles_ExtrapInterp( u1%alpha, u2%alpha, tin, u_out%alpha, tin_out ) + u_out%Re = a1*u1%Re + a2*u2%Re + u_out%UserProp = a1*u1%UserProp + a2*u2%UserProp + u_out%v_ac = a1*u1%v_ac + a2*u2%v_ac + u_out%omega = a1*u1%omega + a2*u2%omega +END SUBROUTINE + +SUBROUTINE UA_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. @@ -6810,119 +2304,108 @@ SUBROUTINE UA_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrM ! !.................................................................................................................................. - TYPE(UA_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 > t3 - TYPE(UA_InputType), INTENT(IN) :: u2 ! Input at t2 > t3 - TYPE(UA_InputType), INTENT(IN) :: u3 ! Input at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs - TYPE(UA_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 + TYPE(UA_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 > t3 + TYPE(UA_InputType), INTENT(IN) :: u2 ! Input at t2 > t3 + TYPE(UA_InputType), INTENT(IN) :: u3 ! Input at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs + TYPE(UA_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 = 'UA_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) - + 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) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'UA_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 + 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 + 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 + 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))) - b = (t(3)**2*(u1%U - u2%U) + t(2)**2*(-u1%U + u3%U))* scaleFactor - c = ( (t(2)-t(3))*u1%U + t(3)*u2%U - t(2)*u3%U ) * scaleFactor - u_out%U = u1%U + b + c * t_out - CALL Angles_ExtrapInterp( u1%alpha, u2%alpha, u3%alpha, tin, u_out%alpha, tin_out ) - b = (t(3)**2*(u1%Re - u2%Re) + t(2)**2*(-u1%Re + u3%Re))* scaleFactor - c = ( (t(2)-t(3))*u1%Re + t(3)*u2%Re - t(2)*u3%Re ) * scaleFactor - u_out%Re = u1%Re + b + c * t_out - b = (t(3)**2*(u1%UserProp - u2%UserProp) + t(2)**2*(-u1%UserProp + u3%UserProp))* scaleFactor - c = ( (t(2)-t(3))*u1%UserProp + t(3)*u2%UserProp - t(2)*u3%UserProp ) * scaleFactor - u_out%UserProp = u1%UserProp + b + c * t_out - DO i1 = LBOUND(u_out%v_ac,1),UBOUND(u_out%v_ac,1) - b = (t(3)**2*(u1%v_ac(i1) - u2%v_ac(i1)) + t(2)**2*(-u1%v_ac(i1) + u3%v_ac(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%v_ac(i1) + t(3)*u2%v_ac(i1) - t(2)*u3%v_ac(i1) ) * scaleFactor - u_out%v_ac(i1) = u1%v_ac(i1) + b + c * t_out - END DO - b = (t(3)**2*(u1%omega - u2%omega) + t(2)**2*(-u1%omega + u3%omega))* scaleFactor - c = ( (t(2)-t(3))*u1%omega + t(3)*u2%omega - t(2)*u3%omega ) * scaleFactor - u_out%omega = u1%omega + b + c * t_out - END SUBROUTINE UA_Input_ExtrapInterp2 - - - SUBROUTINE UA_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(UA_OutputType), INTENT(IN) :: y(:) ! Output at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Outputs - TYPE(UA_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 + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + u_out%U = a1*u1%U + a2*u2%U + a3*u3%U + CALL Angles_ExtrapInterp( u1%alpha, u2%alpha, u3%alpha, tin, u_out%alpha, tin_out ) + u_out%Re = a1*u1%Re + a2*u2%Re + a3*u3%Re + u_out%UserProp = a1*u1%UserProp + a2*u2%UserProp + a3*u3%UserProp + u_out%v_ac = a1*u1%v_ac + a2*u2%v_ac + a3*u3%v_ac + u_out%omega = a1*u1%omega + a2*u2%omega + a3*u3%omega +END SUBROUTINE + +subroutine UA_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(UA_OutputType), intent(in) :: y(:) ! Output at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Outputs + type(UA_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 = 'UA_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 UA_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL UA_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 UA_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 UA_Output_ExtrapInterp - - - SUBROUTINE UA_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'UA_Output_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(y)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(y)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(y) - 1 + select case (order) + case (0) + call UA_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call UA_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call UA_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(y) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE UA_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. @@ -6934,57 +2417,50 @@ SUBROUTINE UA_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ! !.................................................................................................................................. - TYPE(UA_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 - TYPE(UA_OutputType), INTENT(IN) :: y2 ! Output at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs - TYPE(UA_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 + TYPE(UA_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 + TYPE(UA_OutputType), INTENT(IN) :: y2 ! Output at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs + TYPE(UA_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 = 'UA_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 + REAL(DbKi) :: t(2) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'UA_Output_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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) - b = -(y1%Cn - y2%Cn) - y_out%Cn = y1%Cn + b * ScaleFactor - b = -(y1%Cc - y2%Cc) - y_out%Cc = y1%Cc + b * ScaleFactor - b = -(y1%Cm - y2%Cm) - y_out%Cm = y1%Cm + b * ScaleFactor - b = -(y1%Cl - y2%Cl) - y_out%Cl = y1%Cl + b * ScaleFactor - b = -(y1%Cd - y2%Cd) - y_out%Cd = y1%Cd + b * ScaleFactor -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 UA_Output_ExtrapInterp1 - - - SUBROUTINE UA_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + y_out%Cn = a1*y1%Cn + a2*y2%Cn + y_out%Cc = a1*y1%Cc + a2*y2%Cc + y_out%Cm = a1*y1%Cm + a2*y2%Cm + y_out%Cl = a1*y1%Cl + a2*y2%Cl + y_out%Cd = a1*y1%Cd + a2*y2%Cd + IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + END IF ! check if allocated +END SUBROUTINE + +SUBROUTINE UA_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. @@ -6998,69 +2474,55 @@ SUBROUTINE UA_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Err ! !.................................................................................................................................. - TYPE(UA_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 > t3 - TYPE(UA_OutputType), INTENT(IN) :: y2 ! Output at t2 > t3 - TYPE(UA_OutputType), INTENT(IN) :: y3 ! Output at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs - TYPE(UA_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 + TYPE(UA_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 > t3 + TYPE(UA_OutputType), INTENT(IN) :: y2 ! Output at t2 > t3 + TYPE(UA_OutputType), INTENT(IN) :: y3 ! Output at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs + TYPE(UA_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 = 'UA_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) - + 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) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'UA_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 + 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 + 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 + 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))) - b = (t(3)**2*(y1%Cn - y2%Cn) + t(2)**2*(-y1%Cn + y3%Cn))* scaleFactor - c = ( (t(2)-t(3))*y1%Cn + t(3)*y2%Cn - t(2)*y3%Cn ) * scaleFactor - y_out%Cn = y1%Cn + b + c * t_out - b = (t(3)**2*(y1%Cc - y2%Cc) + t(2)**2*(-y1%Cc + y3%Cc))* scaleFactor - c = ( (t(2)-t(3))*y1%Cc + t(3)*y2%Cc - t(2)*y3%Cc ) * scaleFactor - y_out%Cc = y1%Cc + b + c * t_out - b = (t(3)**2*(y1%Cm - y2%Cm) + t(2)**2*(-y1%Cm + y3%Cm))* scaleFactor - c = ( (t(2)-t(3))*y1%Cm + t(3)*y2%Cm - t(2)*y3%Cm ) * scaleFactor - y_out%Cm = y1%Cm + b + c * t_out - b = (t(3)**2*(y1%Cl - y2%Cl) + t(2)**2*(-y1%Cl + y3%Cl))* scaleFactor - c = ( (t(2)-t(3))*y1%Cl + t(3)*y2%Cl - t(2)*y3%Cl ) * scaleFactor - y_out%Cl = y1%Cl + b + c * t_out - b = (t(3)**2*(y1%Cd - y2%Cd) + t(2)**2*(-y1%Cd + y3%Cd))* scaleFactor - c = ( (t(2)-t(3))*y1%Cd + t(3)*y2%Cd - t(2)*y3%Cd ) * scaleFactor - y_out%Cd = y1%Cd + b + c * t_out -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 UA_Output_ExtrapInterp2 - + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + y_out%Cn = a1*y1%Cn + a2*y2%Cn + a3*y3%Cn + y_out%Cc = a1*y1%Cc + a2*y2%Cc + a3*y3%Cc + y_out%Cm = a1*y1%Cm + a2*y2%Cm + a3*y3%Cm + y_out%Cl = a1*y1%Cl + a2*y2%Cl + a3*y3%Cl + y_out%Cd = a1*y1%Cd + a2*y2%Cd + a3*y3%Cd + IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + a3*y3%WriteOutput + END IF ! check if allocated +END SUBROUTINE END MODULE UnsteadyAero_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/aerodyn/tests/aerodyn_utest.F90 b/modules/aerodyn/tests/aerodyn_utest.F90 new file mode 100644 index 0000000000..5d2097235a --- /dev/null +++ b/modules/aerodyn/tests/aerodyn_utest.F90 @@ -0,0 +1,34 @@ +program aerodyn_utest +use, intrinsic :: iso_fortran_env, only: error_unit +use testdrive, only: run_testsuite, new_testsuite, testsuite_type + +use test_AD_FVW, only: test_AD_FVW_suite +use NWTC_Num + +implicit none +integer :: stat, is, total_tests +type(testsuite_type), allocatable :: testsuites(:) +character(len=*), parameter :: fmt = '("#", *(1x, a))' + +stat = 0 + +call SetConstants() + +testsuites = [ & + new_testsuite("FVW", test_AD_FVW_suite) & + ] + +total_tests = 0 +do is = 1, size(testsuites) + write (error_unit, fmt) "Testing:", testsuites(is)%name + call run_testsuite(testsuites(is)%collect, error_unit, stat) +end do + +if (stat > 0) then + write (error_unit, '(i0, 1x, a)') stat, "test(s) failed!" + error stop +end if + +write (error_unit, fmt) "All tests PASSED" + +end program diff --git a/modules/aerodyn/tests/test_AD_FVW.F90 b/modules/aerodyn/tests/test_AD_FVW.F90 new file mode 100644 index 0000000000..fb6e233b4f --- /dev/null +++ b/modules/aerodyn/tests/test_AD_FVW.F90 @@ -0,0 +1,62 @@ +module test_AD_FVW + +use testdrive, only: new_unittest, unittest_type, error_type, check +use NWTC_Num +use FVW_Tests + +implicit none + +private +public :: test_AD_FVW_suite + +contains + +!> Collect all exported unit tests +subroutine test_AD_FVW_suite(testsuite) + type(unittest_type), allocatable, intent(out) :: testsuite(:) + testsuite = [new_unittest("test_AD_FVW_all", test_AD_FVW_all)] +end subroutine + +subroutine test_AD_FVW_all(error) + type(error_type), allocatable, intent(out) :: error + ! test branches + ! - known valid checks for various FVW routines (contained in own module) + ! - known invalid rotation matrix: halve the angle of the diagonal elements + + integer(IntKi) :: ErrStat + character(ErrMsgLen) :: ErrMsg + character(1024) :: testname + + ! initialize NWTC_Num constants + call SetConstants() + + ! This is a single routine that contains the test cases below. + ! -------------------------------------------------------------------------- + testname = "Set of FVW tests" + call FVW_RunTests(ErrStat, ErrMsg) + call check(error, ErrID_None, ErrStat); if (allocated(error)) return + + ! test routines from FVW_RunTests to be run individually -- except these are all private + ! ! -------------------------------------------------------------------------- + ! testname = "known valid Biot-Savart segment" + ! call Test_BiotSavart_Sgmt(testname, ErrStat, ErrMsg) + ! call check(error, 0, ErrStat); if (allocated(error)) return + ! + ! ! -------------------------------------------------------------------------- + ! testname = "known valid Biot-Savart part" + ! call Test_BiotSavart_Part(testname, ErrStat, ErrMsg) + ! call check(error, 0, ErrStat); if (allocated(error)) return + ! + ! ! -------------------------------------------------------------------------- + ! testname = "known valid Biot-Savart to part-tree" + ! call Test_BiotSavart_PartTree(testname, ErrStat, ErrMsg) + ! call check(error, 0, ErrStat); if (allocated(error)) return + ! + ! ! -------------------------------------------------------------------------- + ! testname = "known valid segment split to parts" + ! call Test_SegmentsToPart(testname, ErrStat, ErrMsg) + ! call check(error, 0, ErrStat); if (allocated(error)) return + +end subroutine + +end module diff --git a/modules/aerodyn/tests/test_FVW_testsuite.F90 b/modules/aerodyn/tests/test_FVW_testsuite.F90 deleted file mode 100644 index 57a72ea24b..0000000000 --- a/modules/aerodyn/tests/test_FVW_testsuite.F90 +++ /dev/null @@ -1,48 +0,0 @@ -@test -subroutine test_AD_FVW() - ! test branches - ! - known valid checks for various FVW routines (contained in own module) - ! - known invalid rotation matrix: halve the angle of the diagonal elements - - use pFUnit_mod - use NWTC_Num - use FVW_Tests - - implicit none - - integer(IntKi) :: ErrStat - character(ErrMsgLen) :: ErrMsg - character(1024) :: testname - - ! initialize NWTC_Num constants - call SetConstants() - -!This is a single routine that contains the test cases below. - ! -------------------------------------------------------------------------- - testname = "Set of FVW tests" - call FVW_RunTests( ErrStat, ErrMsg ) - @assertEqual(0, ErrStat, testname) - - -! test routines from FVW_RunTests to be run individually -- except these are all private -! ! -------------------------------------------------------------------------- -! testname = "known valid Biot-Savart segment" -! call Test_BiotSavart_Sgmt(testname, ErrStat, ErrMsg) -! @assertEqual(0, ErrStat, testname) -! -! ! -------------------------------------------------------------------------- -! testname = "known valid Biot-Savart part" -! call Test_BiotSavart_Part(testname, ErrStat, ErrMsg) -! @assertEqual(0, ErrStat, testname) -! -! ! -------------------------------------------------------------------------- -! testname = "known valid Biot-Savart to part-tree" -! call Test_BiotSavart_PartTree(testname, ErrStat, ErrMsg) -! @assertEqual(0, ErrStat, testname) -! -! ! -------------------------------------------------------------------------- -! testname = "known valid segment split to parts" -! call Test_SegmentsToPart(testname, ErrStat, ErrMsg) -! @assertEqual(0, ErrStat, testname) - -end subroutine test_AD_FVW diff --git a/modules/aerodyn14/README.md b/modules/aerodyn14/README.md deleted file mode 100644 index eb6b856846..0000000000 --- a/modules/aerodyn14/README.md +++ /dev/null @@ -1,14 +0,0 @@ -# AeroDyn 14 Module -The legacy version of this module and additional documentation are available -at the [NWTC Software Portal](https://nwtc.nrel.gov/AeroDyn14/). - -**DEPRECATED** -AeroDyn 14 will be replaced with DBEMT and FAST.Farm as discussed in -[issue #93](https://github.com/OpenFAST/openfast/issues/93). - -## Overview -AeroDyn 14 is an aerodynamics software library (module) for use by designers of -horizontal-axis wind turbines. It is written to be interfaced with a dynamics -analysis software package for aero-elastic analysis of wind turbine models. -This version of AeroDyn works only with the modularization framework used in -OpenFAST. diff --git a/modules/aerodyn14/src/AD14AeroConf_Types.f90 b/modules/aerodyn14/src/AD14AeroConf_Types.f90 deleted file mode 100644 index 91c5a37363..0000000000 --- a/modules/aerodyn14/src/AD14AeroConf_Types.f90 +++ /dev/null @@ -1,2921 +0,0 @@ -!STARTOFREGISTRYGENERATEDFILE 'AD14AeroConf_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 -!********************************************************************************************************************************* -! AD14AeroConf_Types -!................................................................................................................................. -! This file is part of AD14AeroConf. -! -! 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 AD14AeroConf. 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 AD14AeroConf_Types -!--------------------------------------------------------------------------------------------------------------------------------- -USE NWTC_Library -IMPLICIT NONE -! ========= Marker ======= - TYPE, PUBLIC :: Marker - REAL(ReKi) , DIMENSION(1:3) :: Position - REAL(ReKi) , DIMENSION(1:3,1:3) :: Orientation - REAL(ReKi) , DIMENSION(1:3) :: TranslationVel - REAL(ReKi) , DIMENSION(1:3) :: RotationVel - END TYPE Marker -! ======================= -! ========= AD14AeroConf_MiscVarType ======= - TYPE, PUBLIC :: AD14AeroConf_MiscVarType - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: AL - REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: CD - REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: CL - REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: CM - REAL(ReKi) :: PMC - REAL(ReKi) :: MulTabLoc - END TYPE AD14AeroConf_MiscVarType -! ======================= -! ========= AD14AeroConf_ParameterType ======= - TYPE, PUBLIC :: AD14AeroConf_ParameterType - INTEGER(IntKi) :: MaxTable = 20 - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: NTables - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: NLift - INTEGER(IntKi) :: NumCL - INTEGER(IntKi) :: NumFoil - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: NFoil - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: MulTabMet - CHARACTER(1024) , DIMENSION(:), ALLOCATABLE :: FoilNm - END TYPE AD14AeroConf_ParameterType -! ======================= -! ========= AD14AeroConf_InputType ======= - TYPE, PUBLIC :: AD14AeroConf_InputType - TYPE(Marker) , DIMENSION(:), ALLOCATABLE :: Blade - TYPE(Marker) :: Hub - TYPE(Marker) :: RotorFurl - TYPE(Marker) :: Nacelle - TYPE(Marker) :: TailFin - TYPE(Marker) :: Tower - TYPE(Marker) :: SubStructure - TYPE(Marker) :: Foundation - REAL(ReKi) :: BladeLength - END TYPE AD14AeroConf_InputType -! ======================= -! ========= AD14AeroConf_OutputType ======= - TYPE, PUBLIC :: AD14AeroConf_OutputType - REAL(ReKi) :: Dummy - END TYPE AD14AeroConf_OutputType -! ======================= -CONTAINS - SUBROUTINE AD14AeroConf_CopyMarker( SrcMarkerData, DstMarkerData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Marker), INTENT(IN) :: SrcMarkerData - TYPE(Marker), INTENT(INOUT) :: DstMarkerData - 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 = 'AD14AeroConf_CopyMarker' -! - ErrStat = ErrID_None - ErrMsg = "" - DstMarkerData%Position = SrcMarkerData%Position - DstMarkerData%Orientation = SrcMarkerData%Orientation - DstMarkerData%TranslationVel = SrcMarkerData%TranslationVel - DstMarkerData%RotationVel = SrcMarkerData%RotationVel - END SUBROUTINE AD14AeroConf_CopyMarker - - SUBROUTINE AD14AeroConf_DestroyMarker( MarkerData, ErrStat, ErrMsg ) - TYPE(Marker), INTENT(INOUT) :: MarkerData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'AD14AeroConf_DestroyMarker' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" - END SUBROUTINE AD14AeroConf_DestroyMarker - - SUBROUTINE AD14AeroConf_PackMarker( 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(Marker), 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 = 'AD14AeroConf_PackMarker' - ! 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%Position) ! Position - Re_BufSz = Re_BufSz + SIZE(InData%Orientation) ! Orientation - Re_BufSz = Re_BufSz + SIZE(InData%TranslationVel) ! TranslationVel - Re_BufSz = Re_BufSz + SIZE(InData%RotationVel) ! RotationVel - 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+(SIZE(InData%Position))-1 ) = PACK(InData%Position,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Position) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Orientation))-1 ) = PACK(InData%Orientation,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Orientation) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TranslationVel))-1 ) = PACK(InData%TranslationVel,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TranslationVel) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%RotationVel))-1 ) = PACK(InData%RotationVel,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%RotationVel) - END SUBROUTINE AD14AeroConf_PackMarker - - SUBROUTINE AD14AeroConf_UnPackMarker( 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(Marker), 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) :: 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 = 'AD14AeroConf_UnPackMarker' - ! 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%Position,1) - i1_u = UBOUND(OutData%Position,1) - 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. - OutData%Position = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Position))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Position) - DEALLOCATE(mask1) - i1_l = LBOUND(OutData%Orientation,1) - i1_u = UBOUND(OutData%Orientation,1) - i2_l = LBOUND(OutData%Orientation,2) - i2_u = UBOUND(OutData%Orientation,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%Orientation = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Orientation))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Orientation) - DEALLOCATE(mask2) - i1_l = LBOUND(OutData%TranslationVel,1) - i1_u = UBOUND(OutData%TranslationVel,1) - 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. - OutData%TranslationVel = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TranslationVel))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TranslationVel) - DEALLOCATE(mask1) - i1_l = LBOUND(OutData%RotationVel,1) - i1_u = UBOUND(OutData%RotationVel,1) - 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. - OutData%RotationVel = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%RotationVel))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%RotationVel) - DEALLOCATE(mask1) - END SUBROUTINE AD14AeroConf_UnPackMarker - - SUBROUTINE AD14AeroConf_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AD14AeroConf_MiscVarType), INTENT(IN) :: SrcMiscData - TYPE(AD14AeroConf_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) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14AeroConf_CopyMisc' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcMiscData%AL)) THEN - i1_l = LBOUND(SrcMiscData%AL,1) - i1_u = UBOUND(SrcMiscData%AL,1) - i2_l = LBOUND(SrcMiscData%AL,2) - i2_u = UBOUND(SrcMiscData%AL,2) - IF (.NOT. ALLOCATED(DstMiscData%AL)) THEN - ALLOCATE(DstMiscData%AL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%AL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%AL = SrcMiscData%AL -ENDIF -IF (ALLOCATED(SrcMiscData%CD)) THEN - i1_l = LBOUND(SrcMiscData%CD,1) - i1_u = UBOUND(SrcMiscData%CD,1) - i2_l = LBOUND(SrcMiscData%CD,2) - i2_u = UBOUND(SrcMiscData%CD,2) - i3_l = LBOUND(SrcMiscData%CD,3) - i3_u = UBOUND(SrcMiscData%CD,3) - IF (.NOT. ALLOCATED(DstMiscData%CD)) THEN - ALLOCATE(DstMiscData%CD(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%CD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%CD = SrcMiscData%CD -ENDIF -IF (ALLOCATED(SrcMiscData%CL)) THEN - i1_l = LBOUND(SrcMiscData%CL,1) - i1_u = UBOUND(SrcMiscData%CL,1) - i2_l = LBOUND(SrcMiscData%CL,2) - i2_u = UBOUND(SrcMiscData%CL,2) - i3_l = LBOUND(SrcMiscData%CL,3) - i3_u = UBOUND(SrcMiscData%CL,3) - IF (.NOT. ALLOCATED(DstMiscData%CL)) THEN - ALLOCATE(DstMiscData%CL(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%CL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%CL = SrcMiscData%CL -ENDIF -IF (ALLOCATED(SrcMiscData%CM)) THEN - i1_l = LBOUND(SrcMiscData%CM,1) - i1_u = UBOUND(SrcMiscData%CM,1) - i2_l = LBOUND(SrcMiscData%CM,2) - i2_u = UBOUND(SrcMiscData%CM,2) - i3_l = LBOUND(SrcMiscData%CM,3) - i3_u = UBOUND(SrcMiscData%CM,3) - IF (.NOT. ALLOCATED(DstMiscData%CM)) THEN - ALLOCATE(DstMiscData%CM(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%CM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%CM = SrcMiscData%CM -ENDIF - DstMiscData%PMC = SrcMiscData%PMC - DstMiscData%MulTabLoc = SrcMiscData%MulTabLoc - END SUBROUTINE AD14AeroConf_CopyMisc - - SUBROUTINE AD14AeroConf_DestroyMisc( MiscData, ErrStat, ErrMsg ) - TYPE(AD14AeroConf_MiscVarType), INTENT(INOUT) :: MiscData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'AD14AeroConf_DestroyMisc' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(MiscData%AL)) THEN - DEALLOCATE(MiscData%AL) -ENDIF -IF (ALLOCATED(MiscData%CD)) THEN - DEALLOCATE(MiscData%CD) -ENDIF -IF (ALLOCATED(MiscData%CL)) THEN - DEALLOCATE(MiscData%CL) -ENDIF -IF (ALLOCATED(MiscData%CM)) THEN - DEALLOCATE(MiscData%CM) -ENDIF - END SUBROUTINE AD14AeroConf_DestroyMisc - - SUBROUTINE AD14AeroConf_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(AD14AeroConf_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 = 'AD14AeroConf_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 ! AL allocated yes/no - IF ( ALLOCATED(InData%AL) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! AL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AL) ! AL - END IF - Int_BufSz = Int_BufSz + 1 ! CD allocated yes/no - IF ( ALLOCATED(InData%CD) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! CD upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CD) ! CD - END IF - Int_BufSz = Int_BufSz + 1 ! CL allocated yes/no - IF ( ALLOCATED(InData%CL) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! CL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CL) ! CL - END IF - Int_BufSz = Int_BufSz + 1 ! CM allocated yes/no - IF ( ALLOCATED(InData%CM) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! CM upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CM) ! CM - END IF - Re_BufSz = Re_BufSz + 1 ! PMC - Re_BufSz = Re_BufSz + 1 ! MulTabLoc - 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%AL) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AL,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AL,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AL,2) - Int_Xferred = Int_Xferred + 2 - - IF (SIZE(InData%AL)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AL))-1 ) = PACK(InData%AL,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AL) - END IF - IF ( .NOT. ALLOCATED(InData%CD) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CD,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CD,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CD,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CD,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CD,3) - Int_Xferred = Int_Xferred + 2 - - IF (SIZE(InData%CD)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%CD))-1 ) = PACK(InData%CD,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%CD) - END IF - IF ( .NOT. ALLOCATED(InData%CL) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CL,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CL,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CL,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CL,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CL,3) - Int_Xferred = Int_Xferred + 2 - - IF (SIZE(InData%CL)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%CL))-1 ) = PACK(InData%CL,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%CL) - END IF - IF ( .NOT. ALLOCATED(InData%CM) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CM,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CM,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CM,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CM,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CM,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CM,3) - Int_Xferred = Int_Xferred + 2 - - IF (SIZE(InData%CM)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%CM))-1 ) = PACK(InData%CM,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%CM) - END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PMC - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MulTabLoc - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AD14AeroConf_PackMisc - - SUBROUTINE AD14AeroConf_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(AD14AeroConf_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) :: 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 = 'AD14AeroConf_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 ! AL not allocated - Int_Xferred = Int_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%AL)) DEALLOCATE(OutData%AL) - ALLOCATE(OutData%AL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%AL)>0) OutData%AL = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AL))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AL) - DEALLOCATE(mask2) - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CD not allocated - Int_Xferred = Int_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%CD)) DEALLOCATE(OutData%CD) - ALLOCATE(OutData%CD(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%CD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%CD)>0) OutData%CD = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%CD))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%CD) - DEALLOCATE(mask3) - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CL not allocated - Int_Xferred = Int_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%CL)) DEALLOCATE(OutData%CL) - ALLOCATE(OutData%CL(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%CL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%CL)>0) OutData%CL = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%CL))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%CL) - DEALLOCATE(mask3) - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CM not allocated - Int_Xferred = Int_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%CM)) DEALLOCATE(OutData%CM) - ALLOCATE(OutData%CM(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%CM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%CM)>0) OutData%CM = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%CM))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%CM) - DEALLOCATE(mask3) - END IF - OutData%PMC = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%MulTabLoc = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AD14AeroConf_UnPackMisc - - SUBROUTINE AD14AeroConf_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AD14AeroConf_ParameterType), INTENT(IN) :: SrcParamData - TYPE(AD14AeroConf_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 = 'AD14AeroConf_CopyParam' -! - ErrStat = ErrID_None - ErrMsg = "" - DstParamData%MaxTable = SrcParamData%MaxTable -IF (ALLOCATED(SrcParamData%NTables)) THEN - i1_l = LBOUND(SrcParamData%NTables,1) - i1_u = UBOUND(SrcParamData%NTables,1) - IF (.NOT. ALLOCATED(DstParamData%NTables)) THEN - ALLOCATE(DstParamData%NTables(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%NTables.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%NTables = SrcParamData%NTables -ENDIF -IF (ALLOCATED(SrcParamData%NLift)) THEN - i1_l = LBOUND(SrcParamData%NLift,1) - i1_u = UBOUND(SrcParamData%NLift,1) - IF (.NOT. ALLOCATED(DstParamData%NLift)) THEN - ALLOCATE(DstParamData%NLift(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%NLift.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%NLift = SrcParamData%NLift -ENDIF - DstParamData%NumCL = SrcParamData%NumCL - DstParamData%NumFoil = SrcParamData%NumFoil -IF (ALLOCATED(SrcParamData%NFoil)) THEN - i1_l = LBOUND(SrcParamData%NFoil,1) - i1_u = UBOUND(SrcParamData%NFoil,1) - IF (.NOT. ALLOCATED(DstParamData%NFoil)) THEN - ALLOCATE(DstParamData%NFoil(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%NFoil.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%NFoil = SrcParamData%NFoil -ENDIF -IF (ALLOCATED(SrcParamData%MulTabMet)) THEN - i1_l = LBOUND(SrcParamData%MulTabMet,1) - i1_u = UBOUND(SrcParamData%MulTabMet,1) - i2_l = LBOUND(SrcParamData%MulTabMet,2) - i2_u = UBOUND(SrcParamData%MulTabMet,2) - IF (.NOT. ALLOCATED(DstParamData%MulTabMet)) THEN - ALLOCATE(DstParamData%MulTabMet(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%MulTabMet.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%MulTabMet = SrcParamData%MulTabMet -ENDIF -IF (ALLOCATED(SrcParamData%FoilNm)) THEN - i1_l = LBOUND(SrcParamData%FoilNm,1) - i1_u = UBOUND(SrcParamData%FoilNm,1) - IF (.NOT. ALLOCATED(DstParamData%FoilNm)) THEN - ALLOCATE(DstParamData%FoilNm(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%FoilNm.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%FoilNm = SrcParamData%FoilNm -ENDIF - END SUBROUTINE AD14AeroConf_CopyParam - - SUBROUTINE AD14AeroConf_DestroyParam( ParamData, ErrStat, ErrMsg ) - TYPE(AD14AeroConf_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'AD14AeroConf_DestroyParam' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(ParamData%NTables)) THEN - DEALLOCATE(ParamData%NTables) -ENDIF -IF (ALLOCATED(ParamData%NLift)) THEN - DEALLOCATE(ParamData%NLift) -ENDIF -IF (ALLOCATED(ParamData%NFoil)) THEN - DEALLOCATE(ParamData%NFoil) -ENDIF -IF (ALLOCATED(ParamData%MulTabMet)) THEN - DEALLOCATE(ParamData%MulTabMet) -ENDIF -IF (ALLOCATED(ParamData%FoilNm)) THEN - DEALLOCATE(ParamData%FoilNm) -ENDIF - END SUBROUTINE AD14AeroConf_DestroyParam - - SUBROUTINE AD14AeroConf_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(AD14AeroConf_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 = 'AD14AeroConf_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 ! MaxTable - Int_BufSz = Int_BufSz + 1 ! NTables allocated yes/no - IF ( ALLOCATED(InData%NTables) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! NTables upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%NTables) ! NTables - END IF - Int_BufSz = Int_BufSz + 1 ! NLift allocated yes/no - IF ( ALLOCATED(InData%NLift) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! NLift upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%NLift) ! NLift - END IF - Int_BufSz = Int_BufSz + 1 ! NumCL - Int_BufSz = Int_BufSz + 1 ! NumFoil - Int_BufSz = Int_BufSz + 1 ! NFoil allocated yes/no - IF ( ALLOCATED(InData%NFoil) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! NFoil upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%NFoil) ! NFoil - END IF - Int_BufSz = Int_BufSz + 1 ! MulTabMet allocated yes/no - IF ( ALLOCATED(InData%MulTabMet) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! MulTabMet upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%MulTabMet) ! MulTabMet - END IF - Int_BufSz = Int_BufSz + 1 ! FoilNm allocated yes/no - IF ( ALLOCATED(InData%FoilNm) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! FoilNm upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%FoilNm)*LEN(InData%FoilNm) ! FoilNm - 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:Int_Xferred+(1)-1 ) = InData%MaxTable - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%NTables) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%NTables,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NTables,1) - Int_Xferred = Int_Xferred + 2 - - IF (SIZE(InData%NTables)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%NTables))-1 ) = PACK(InData%NTables,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%NTables) - END IF - IF ( .NOT. ALLOCATED(InData%NLift) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%NLift,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NLift,1) - Int_Xferred = Int_Xferred + 2 - - IF (SIZE(InData%NLift)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%NLift))-1 ) = PACK(InData%NLift,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%NLift) - END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumCL - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumFoil - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%NFoil) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%NFoil,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NFoil,1) - Int_Xferred = Int_Xferred + 2 - - IF (SIZE(InData%NFoil)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%NFoil))-1 ) = PACK(InData%NFoil,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%NFoil) - END IF - IF ( .NOT. ALLOCATED(InData%MulTabMet) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MulTabMet,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MulTabMet,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MulTabMet,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MulTabMet,2) - Int_Xferred = Int_Xferred + 2 - - IF (SIZE(InData%MulTabMet)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%MulTabMet))-1 ) = PACK(InData%MulTabMet,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%MulTabMet) - END IF - IF ( .NOT. ALLOCATED(InData%FoilNm) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FoilNm,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FoilNm,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%FoilNm,1), UBOUND(InData%FoilNm,1) - DO I = 1, LEN(InData%FoilNm) - IntKiBuf(Int_Xferred) = ICHAR(InData%FoilNm(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO !i1 - END IF - END SUBROUTINE AD14AeroConf_PackParam - - SUBROUTINE AD14AeroConf_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(AD14AeroConf_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) :: 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 = 'AD14AeroConf_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%MaxTable = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NTables not allocated - Int_Xferred = Int_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%NTables)) DEALLOCATE(OutData%NTables) - ALLOCATE(OutData%NTables(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NTables.', 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%NTables)>0) OutData%NTables = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%NTables))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%NTables) - DEALLOCATE(mask1) - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NLift not allocated - Int_Xferred = Int_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%NLift)) DEALLOCATE(OutData%NLift) - ALLOCATE(OutData%NLift(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NLift.', 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%NLift)>0) OutData%NLift = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%NLift))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%NLift) - DEALLOCATE(mask1) - END IF - OutData%NumCL = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NumFoil = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NFoil not allocated - Int_Xferred = Int_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%NFoil)) DEALLOCATE(OutData%NFoil) - ALLOCATE(OutData%NFoil(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NFoil.', 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%NFoil)>0) OutData%NFoil = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%NFoil))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%NFoil) - DEALLOCATE(mask1) - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MulTabMet not allocated - Int_Xferred = Int_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%MulTabMet)) DEALLOCATE(OutData%MulTabMet) - ALLOCATE(OutData%MulTabMet(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MulTabMet.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%MulTabMet)>0) OutData%MulTabMet = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%MulTabMet))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%MulTabMet) - DEALLOCATE(mask2) - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FoilNm not allocated - Int_Xferred = Int_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%FoilNm)) DEALLOCATE(OutData%FoilNm) - ALLOCATE(OutData%FoilNm(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FoilNm.', 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%FoilNm,1), UBOUND(OutData%FoilNm,1) - DO I = 1, LEN(OutData%FoilNm) - OutData%FoilNm(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO !i1 - DEALLOCATE(mask1) - END IF - END SUBROUTINE AD14AeroConf_UnPackParam - - SUBROUTINE AD14AeroConf_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AD14AeroConf_InputType), INTENT(IN) :: SrcInputData - TYPE(AD14AeroConf_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 = 'AD14AeroConf_CopyInput' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcInputData%Blade)) THEN - i1_l = LBOUND(SrcInputData%Blade,1) - i1_u = UBOUND(SrcInputData%Blade,1) - IF (.NOT. ALLOCATED(DstInputData%Blade)) THEN - ALLOCATE(DstInputData%Blade(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%Blade.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcInputData%Blade,1), UBOUND(SrcInputData%Blade,1) - CALL AD14AeroConf_Copymarker( SrcInputData%Blade(i1), DstInputData%Blade(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL AD14AeroConf_Copymarker( SrcInputData%Hub, DstInputData%Hub, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD14AeroConf_Copymarker( SrcInputData%RotorFurl, DstInputData%RotorFurl, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD14AeroConf_Copymarker( SrcInputData%Nacelle, DstInputData%Nacelle, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD14AeroConf_Copymarker( SrcInputData%TailFin, DstInputData%TailFin, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD14AeroConf_Copymarker( SrcInputData%Tower, DstInputData%Tower, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD14AeroConf_Copymarker( SrcInputData%SubStructure, DstInputData%SubStructure, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD14AeroConf_Copymarker( SrcInputData%Foundation, DstInputData%Foundation, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstInputData%BladeLength = SrcInputData%BladeLength - END SUBROUTINE AD14AeroConf_CopyInput - - SUBROUTINE AD14AeroConf_DestroyInput( InputData, ErrStat, ErrMsg ) - TYPE(AD14AeroConf_InputType), INTENT(INOUT) :: InputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'AD14AeroConf_DestroyInput' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(InputData%Blade)) THEN -DO i1 = LBOUND(InputData%Blade,1), UBOUND(InputData%Blade,1) - CALL AD14AeroConf_Destroymarker( InputData%Blade(i1), ErrStat, ErrMsg ) -ENDDO - DEALLOCATE(InputData%Blade) -ENDIF - CALL AD14AeroConf_Destroymarker( InputData%Hub, ErrStat, ErrMsg ) - CALL AD14AeroConf_Destroymarker( InputData%RotorFurl, ErrStat, ErrMsg ) - CALL AD14AeroConf_Destroymarker( InputData%Nacelle, ErrStat, ErrMsg ) - CALL AD14AeroConf_Destroymarker( InputData%TailFin, ErrStat, ErrMsg ) - CALL AD14AeroConf_Destroymarker( InputData%Tower, ErrStat, ErrMsg ) - CALL AD14AeroConf_Destroymarker( InputData%SubStructure, ErrStat, ErrMsg ) - CALL AD14AeroConf_Destroymarker( InputData%Foundation, ErrStat, ErrMsg ) - END SUBROUTINE AD14AeroConf_DestroyInput - - SUBROUTINE AD14AeroConf_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(AD14AeroConf_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 = 'AD14AeroConf_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 ! Blade allocated yes/no - IF ( ALLOCATED(InData%Blade) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Blade upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%Blade,1), UBOUND(InData%Blade,1) - Int_BufSz = Int_BufSz + 3 ! Blade: size of buffers for each call to pack subtype - CALL AD14AeroConf_Packmarker( Re_Buf, Db_Buf, Int_Buf, InData%Blade(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Blade - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Blade - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Blade - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Blade - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! Hub: size of buffers for each call to pack subtype - CALL AD14AeroConf_Packmarker( Re_Buf, Db_Buf, Int_Buf, InData%Hub, ErrStat2, ErrMsg2, .TRUE. ) ! Hub - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Hub - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Hub - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Hub - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! RotorFurl: size of buffers for each call to pack subtype - CALL AD14AeroConf_Packmarker( Re_Buf, Db_Buf, Int_Buf, InData%RotorFurl, ErrStat2, ErrMsg2, .TRUE. ) ! RotorFurl - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! RotorFurl - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! RotorFurl - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! RotorFurl - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! Nacelle: size of buffers for each call to pack subtype - CALL AD14AeroConf_Packmarker( Re_Buf, Db_Buf, Int_Buf, InData%Nacelle, ErrStat2, ErrMsg2, .TRUE. ) ! Nacelle - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Nacelle - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Nacelle - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Nacelle - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! TailFin: size of buffers for each call to pack subtype - CALL AD14AeroConf_Packmarker( Re_Buf, Db_Buf, Int_Buf, InData%TailFin, ErrStat2, ErrMsg2, .TRUE. ) ! TailFin - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! TailFin - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! TailFin - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! TailFin - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! Tower: size of buffers for each call to pack subtype - CALL AD14AeroConf_Packmarker( Re_Buf, Db_Buf, Int_Buf, InData%Tower, ErrStat2, ErrMsg2, .TRUE. ) ! Tower - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Tower - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Tower - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Tower - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! SubStructure: size of buffers for each call to pack subtype - CALL AD14AeroConf_Packmarker( Re_Buf, Db_Buf, Int_Buf, InData%SubStructure, ErrStat2, ErrMsg2, .TRUE. ) ! SubStructure - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SubStructure - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SubStructure - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SubStructure - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! Foundation: size of buffers for each call to pack subtype - CALL AD14AeroConf_Packmarker( Re_Buf, Db_Buf, Int_Buf, InData%Foundation, ErrStat2, ErrMsg2, .TRUE. ) ! Foundation - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Foundation - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Foundation - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Foundation - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Re_BufSz = Re_BufSz + 1 ! BladeLength - 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%Blade) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Blade,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Blade,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Blade,1), UBOUND(InData%Blade,1) - CALL AD14AeroConf_Packmarker( Re_Buf, Db_Buf, Int_Buf, InData%Blade(i1), ErrStat2, ErrMsg2, OnlySize ) ! Blade - 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 - CALL AD14AeroConf_Packmarker( Re_Buf, Db_Buf, Int_Buf, InData%Hub, ErrStat2, ErrMsg2, OnlySize ) ! Hub - 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 AD14AeroConf_Packmarker( Re_Buf, Db_Buf, Int_Buf, InData%RotorFurl, ErrStat2, ErrMsg2, OnlySize ) ! RotorFurl - 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 AD14AeroConf_Packmarker( Re_Buf, Db_Buf, Int_Buf, InData%Nacelle, ErrStat2, ErrMsg2, OnlySize ) ! Nacelle - 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 AD14AeroConf_Packmarker( Re_Buf, Db_Buf, Int_Buf, InData%TailFin, ErrStat2, ErrMsg2, OnlySize ) ! TailFin - 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 AD14AeroConf_Packmarker( Re_Buf, Db_Buf, Int_Buf, InData%Tower, ErrStat2, ErrMsg2, OnlySize ) ! Tower - 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 AD14AeroConf_Packmarker( Re_Buf, Db_Buf, Int_Buf, InData%SubStructure, ErrStat2, ErrMsg2, OnlySize ) ! SubStructure - 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 AD14AeroConf_Packmarker( Re_Buf, Db_Buf, Int_Buf, InData%Foundation, ErrStat2, ErrMsg2, OnlySize ) ! Foundation - 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 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%BladeLength - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AD14AeroConf_PackInput - - SUBROUTINE AD14AeroConf_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(AD14AeroConf_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) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14AeroConf_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 ! Blade not allocated - Int_Xferred = Int_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%Blade)) DEALLOCATE(OutData%Blade) - ALLOCATE(OutData%Blade(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Blade.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Blade,1), UBOUND(OutData%Blade,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 AD14AeroConf_Unpackmarker( Re_Buf, Db_Buf, Int_Buf, OutData%Blade(i1), ErrStat2, ErrMsg2 ) ! Blade - 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 - 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 AD14AeroConf_Unpackmarker( Re_Buf, Db_Buf, Int_Buf, OutData%Hub, ErrStat2, ErrMsg2 ) ! Hub - 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 AD14AeroConf_Unpackmarker( Re_Buf, Db_Buf, Int_Buf, OutData%RotorFurl, ErrStat2, ErrMsg2 ) ! RotorFurl - 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 AD14AeroConf_Unpackmarker( Re_Buf, Db_Buf, Int_Buf, OutData%Nacelle, ErrStat2, ErrMsg2 ) ! Nacelle - 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 AD14AeroConf_Unpackmarker( Re_Buf, Db_Buf, Int_Buf, OutData%TailFin, ErrStat2, ErrMsg2 ) ! TailFin - 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 AD14AeroConf_Unpackmarker( Re_Buf, Db_Buf, Int_Buf, OutData%Tower, ErrStat2, ErrMsg2 ) ! Tower - 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 AD14AeroConf_Unpackmarker( Re_Buf, Db_Buf, Int_Buf, OutData%SubStructure, ErrStat2, ErrMsg2 ) ! SubStructure - 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 AD14AeroConf_Unpackmarker( Re_Buf, Db_Buf, Int_Buf, OutData%Foundation, ErrStat2, ErrMsg2 ) ! Foundation - 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%BladeLength = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AD14AeroConf_UnPackInput - - SUBROUTINE AD14AeroConf_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AD14AeroConf_OutputType), INTENT(IN) :: SrcOutputData - TYPE(AD14AeroConf_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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14AeroConf_CopyOutput' -! - ErrStat = ErrID_None - ErrMsg = "" - DstOutputData%Dummy = SrcOutputData%Dummy - END SUBROUTINE AD14AeroConf_CopyOutput - - SUBROUTINE AD14AeroConf_DestroyOutput( OutputData, ErrStat, ErrMsg ) - TYPE(AD14AeroConf_OutputType), INTENT(INOUT) :: OutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'AD14AeroConf_DestroyOutput' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" - END SUBROUTINE AD14AeroConf_DestroyOutput - - SUBROUTINE AD14AeroConf_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(AD14AeroConf_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 = 'AD14AeroConf_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 ! 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:Re_Xferred+(1)-1 ) = InData%Dummy - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AD14AeroConf_PackOutput - - SUBROUTINE AD14AeroConf_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(AD14AeroConf_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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14AeroConf_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%Dummy = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AD14AeroConf_UnPackOutput - - - SUBROUTINE AD14AeroConf_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(AD14AeroConf_InputType), INTENT(IN) :: u(:) ! Input at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Inputs - TYPE(AD14AeroConf_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 = 'AD14AeroConf_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 AD14AeroConf_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL AD14AeroConf_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 AD14AeroConf_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 AD14AeroConf_Input_ExtrapInterp - - - SUBROUTINE AD14AeroConf_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(AD14AeroConf_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 - TYPE(AD14AeroConf_InputType), INTENT(IN) :: u2 ! Input at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs - TYPE(AD14AeroConf_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 = 'AD14AeroConf_Input_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 - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: b2 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: c2 ! 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 - ! 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 -IF (ALLOCATED(u_out%Blade) .AND. ALLOCATED(u1%Blade)) THEN - DO i01 = LBOUND(u_out%Blade,1),UBOUND(u_out%Blade,1) - ALLOCATE(b1(SIZE(u_out%Blade(i01)%Position,1))) - ALLOCATE(c1(SIZE(u_out%Blade(i01)%Position,1))) - b1 = -(u1%Blade(i01)%Position - u2%Blade(i01)%Position)/t(2) - u_out%Blade(i01)%Position = u1%Blade(i01)%Position + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) - ENDDO - DO i01 = LBOUND(u_out%Blade,1),UBOUND(u_out%Blade,1) - ALLOCATE(b2(SIZE(u_out%Blade(i01)%Orientation,1),SIZE(u_out%Blade(i01)%Orientation,2) )) - ALLOCATE(c2(SIZE(u_out%Blade(i01)%Orientation,1),SIZE(u_out%Blade(i01)%Orientation,2) )) - b2 = -(u1%Blade(i01)%Orientation - u2%Blade(i01)%Orientation)/t(2) - u_out%Blade(i01)%Orientation = u1%Blade(i01)%Orientation + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) - ENDDO - DO i01 = LBOUND(u_out%Blade,1),UBOUND(u_out%Blade,1) - ALLOCATE(b1(SIZE(u_out%Blade(i01)%TranslationVel,1))) - ALLOCATE(c1(SIZE(u_out%Blade(i01)%TranslationVel,1))) - b1 = -(u1%Blade(i01)%TranslationVel - u2%Blade(i01)%TranslationVel)/t(2) - u_out%Blade(i01)%TranslationVel = u1%Blade(i01)%TranslationVel + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) - ENDDO - DO i01 = LBOUND(u_out%Blade,1),UBOUND(u_out%Blade,1) - ALLOCATE(b1(SIZE(u_out%Blade(i01)%RotationVel,1))) - ALLOCATE(c1(SIZE(u_out%Blade(i01)%RotationVel,1))) - b1 = -(u1%Blade(i01)%RotationVel - u2%Blade(i01)%RotationVel)/t(2) - u_out%Blade(i01)%RotationVel = u1%Blade(i01)%RotationVel + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) - ENDDO -END IF ! check if allocated - ALLOCATE(b1(SIZE(u_out%Hub%Position,1))) - ALLOCATE(c1(SIZE(u_out%Hub%Position,1))) - b1 = -(u1%Hub%Position - u2%Hub%Position)/t(2) - u_out%Hub%Position = u1%Hub%Position + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b2(SIZE(u_out%Hub%Orientation,1),SIZE(u_out%Hub%Orientation,2) )) - ALLOCATE(c2(SIZE(u_out%Hub%Orientation,1),SIZE(u_out%Hub%Orientation,2) )) - b2 = -(u1%Hub%Orientation - u2%Hub%Orientation)/t(2) - u_out%Hub%Orientation = u1%Hub%Orientation + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) - ALLOCATE(b1(SIZE(u_out%Hub%TranslationVel,1))) - ALLOCATE(c1(SIZE(u_out%Hub%TranslationVel,1))) - b1 = -(u1%Hub%TranslationVel - u2%Hub%TranslationVel)/t(2) - u_out%Hub%TranslationVel = u1%Hub%TranslationVel + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(u_out%Hub%RotationVel,1))) - ALLOCATE(c1(SIZE(u_out%Hub%RotationVel,1))) - b1 = -(u1%Hub%RotationVel - u2%Hub%RotationVel)/t(2) - u_out%Hub%RotationVel = u1%Hub%RotationVel + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(u_out%RotorFurl%Position,1))) - ALLOCATE(c1(SIZE(u_out%RotorFurl%Position,1))) - b1 = -(u1%RotorFurl%Position - u2%RotorFurl%Position)/t(2) - u_out%RotorFurl%Position = u1%RotorFurl%Position + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b2(SIZE(u_out%RotorFurl%Orientation,1),SIZE(u_out%RotorFurl%Orientation,2) )) - ALLOCATE(c2(SIZE(u_out%RotorFurl%Orientation,1),SIZE(u_out%RotorFurl%Orientation,2) )) - b2 = -(u1%RotorFurl%Orientation - u2%RotorFurl%Orientation)/t(2) - u_out%RotorFurl%Orientation = u1%RotorFurl%Orientation + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) - ALLOCATE(b1(SIZE(u_out%RotorFurl%TranslationVel,1))) - ALLOCATE(c1(SIZE(u_out%RotorFurl%TranslationVel,1))) - b1 = -(u1%RotorFurl%TranslationVel - u2%RotorFurl%TranslationVel)/t(2) - u_out%RotorFurl%TranslationVel = u1%RotorFurl%TranslationVel + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(u_out%RotorFurl%RotationVel,1))) - ALLOCATE(c1(SIZE(u_out%RotorFurl%RotationVel,1))) - b1 = -(u1%RotorFurl%RotationVel - u2%RotorFurl%RotationVel)/t(2) - u_out%RotorFurl%RotationVel = u1%RotorFurl%RotationVel + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(u_out%Nacelle%Position,1))) - ALLOCATE(c1(SIZE(u_out%Nacelle%Position,1))) - b1 = -(u1%Nacelle%Position - u2%Nacelle%Position)/t(2) - u_out%Nacelle%Position = u1%Nacelle%Position + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b2(SIZE(u_out%Nacelle%Orientation,1),SIZE(u_out%Nacelle%Orientation,2) )) - ALLOCATE(c2(SIZE(u_out%Nacelle%Orientation,1),SIZE(u_out%Nacelle%Orientation,2) )) - b2 = -(u1%Nacelle%Orientation - u2%Nacelle%Orientation)/t(2) - u_out%Nacelle%Orientation = u1%Nacelle%Orientation + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) - ALLOCATE(b1(SIZE(u_out%Nacelle%TranslationVel,1))) - ALLOCATE(c1(SIZE(u_out%Nacelle%TranslationVel,1))) - b1 = -(u1%Nacelle%TranslationVel - u2%Nacelle%TranslationVel)/t(2) - u_out%Nacelle%TranslationVel = u1%Nacelle%TranslationVel + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(u_out%Nacelle%RotationVel,1))) - ALLOCATE(c1(SIZE(u_out%Nacelle%RotationVel,1))) - b1 = -(u1%Nacelle%RotationVel - u2%Nacelle%RotationVel)/t(2) - u_out%Nacelle%RotationVel = u1%Nacelle%RotationVel + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(u_out%TailFin%Position,1))) - ALLOCATE(c1(SIZE(u_out%TailFin%Position,1))) - b1 = -(u1%TailFin%Position - u2%TailFin%Position)/t(2) - u_out%TailFin%Position = u1%TailFin%Position + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b2(SIZE(u_out%TailFin%Orientation,1),SIZE(u_out%TailFin%Orientation,2) )) - ALLOCATE(c2(SIZE(u_out%TailFin%Orientation,1),SIZE(u_out%TailFin%Orientation,2) )) - b2 = -(u1%TailFin%Orientation - u2%TailFin%Orientation)/t(2) - u_out%TailFin%Orientation = u1%TailFin%Orientation + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) - ALLOCATE(b1(SIZE(u_out%TailFin%TranslationVel,1))) - ALLOCATE(c1(SIZE(u_out%TailFin%TranslationVel,1))) - b1 = -(u1%TailFin%TranslationVel - u2%TailFin%TranslationVel)/t(2) - u_out%TailFin%TranslationVel = u1%TailFin%TranslationVel + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(u_out%TailFin%RotationVel,1))) - ALLOCATE(c1(SIZE(u_out%TailFin%RotationVel,1))) - b1 = -(u1%TailFin%RotationVel - u2%TailFin%RotationVel)/t(2) - u_out%TailFin%RotationVel = u1%TailFin%RotationVel + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(u_out%Tower%Position,1))) - ALLOCATE(c1(SIZE(u_out%Tower%Position,1))) - b1 = -(u1%Tower%Position - u2%Tower%Position)/t(2) - u_out%Tower%Position = u1%Tower%Position + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b2(SIZE(u_out%Tower%Orientation,1),SIZE(u_out%Tower%Orientation,2) )) - ALLOCATE(c2(SIZE(u_out%Tower%Orientation,1),SIZE(u_out%Tower%Orientation,2) )) - b2 = -(u1%Tower%Orientation - u2%Tower%Orientation)/t(2) - u_out%Tower%Orientation = u1%Tower%Orientation + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) - ALLOCATE(b1(SIZE(u_out%Tower%TranslationVel,1))) - ALLOCATE(c1(SIZE(u_out%Tower%TranslationVel,1))) - b1 = -(u1%Tower%TranslationVel - u2%Tower%TranslationVel)/t(2) - u_out%Tower%TranslationVel = u1%Tower%TranslationVel + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(u_out%Tower%RotationVel,1))) - ALLOCATE(c1(SIZE(u_out%Tower%RotationVel,1))) - b1 = -(u1%Tower%RotationVel - u2%Tower%RotationVel)/t(2) - u_out%Tower%RotationVel = u1%Tower%RotationVel + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(u_out%SubStructure%Position,1))) - ALLOCATE(c1(SIZE(u_out%SubStructure%Position,1))) - b1 = -(u1%SubStructure%Position - u2%SubStructure%Position)/t(2) - u_out%SubStructure%Position = u1%SubStructure%Position + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b2(SIZE(u_out%SubStructure%Orientation,1),SIZE(u_out%SubStructure%Orientation,2) )) - ALLOCATE(c2(SIZE(u_out%SubStructure%Orientation,1),SIZE(u_out%SubStructure%Orientation,2) )) - b2 = -(u1%SubStructure%Orientation - u2%SubStructure%Orientation)/t(2) - u_out%SubStructure%Orientation = u1%SubStructure%Orientation + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) - ALLOCATE(b1(SIZE(u_out%SubStructure%TranslationVel,1))) - ALLOCATE(c1(SIZE(u_out%SubStructure%TranslationVel,1))) - b1 = -(u1%SubStructure%TranslationVel - u2%SubStructure%TranslationVel)/t(2) - u_out%SubStructure%TranslationVel = u1%SubStructure%TranslationVel + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(u_out%SubStructure%RotationVel,1))) - ALLOCATE(c1(SIZE(u_out%SubStructure%RotationVel,1))) - b1 = -(u1%SubStructure%RotationVel - u2%SubStructure%RotationVel)/t(2) - u_out%SubStructure%RotationVel = u1%SubStructure%RotationVel + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(u_out%Foundation%Position,1))) - ALLOCATE(c1(SIZE(u_out%Foundation%Position,1))) - b1 = -(u1%Foundation%Position - u2%Foundation%Position)/t(2) - u_out%Foundation%Position = u1%Foundation%Position + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b2(SIZE(u_out%Foundation%Orientation,1),SIZE(u_out%Foundation%Orientation,2) )) - ALLOCATE(c2(SIZE(u_out%Foundation%Orientation,1),SIZE(u_out%Foundation%Orientation,2) )) - b2 = -(u1%Foundation%Orientation - u2%Foundation%Orientation)/t(2) - u_out%Foundation%Orientation = u1%Foundation%Orientation + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) - ALLOCATE(b1(SIZE(u_out%Foundation%TranslationVel,1))) - ALLOCATE(c1(SIZE(u_out%Foundation%TranslationVel,1))) - b1 = -(u1%Foundation%TranslationVel - u2%Foundation%TranslationVel)/t(2) - u_out%Foundation%TranslationVel = u1%Foundation%TranslationVel + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(u_out%Foundation%RotationVel,1))) - ALLOCATE(c1(SIZE(u_out%Foundation%RotationVel,1))) - b1 = -(u1%Foundation%RotationVel - u2%Foundation%RotationVel)/t(2) - u_out%Foundation%RotationVel = u1%Foundation%RotationVel + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) - b0 = -(u1%BladeLength - u2%BladeLength)/t(2) - u_out%BladeLength = u1%BladeLength + b0 * t_out - END SUBROUTINE AD14AeroConf_Input_ExtrapInterp1 - - - SUBROUTINE AD14AeroConf_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(AD14AeroConf_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 > t3 - TYPE(AD14AeroConf_InputType), INTENT(IN) :: u2 ! Input at t2 > t3 - TYPE(AD14AeroConf_InputType), INTENT(IN) :: u3 ! Input at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs - TYPE(AD14AeroConf_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 - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: b2 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: c2 ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'AD14AeroConf_Input_ExtrapInterp2' - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - ! 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 -IF (ALLOCATED(u_out%Blade) .AND. ALLOCATED(u1%Blade)) THEN - DO i01 = LBOUND(u_out%Blade,1),UBOUND(u_out%Blade,1) - ALLOCATE(b1(SIZE(u_out%Blade(i01)%Position,1))) - ALLOCATE(c1(SIZE(u_out%Blade(i01)%Position,1))) - b1 = (t(3)**2*(u1%Blade(i01)%Position - u2%Blade(i01)%Position) + t(2)**2*(-u1%Blade(i01)%Position + u3%Blade(i01)%Position))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%Blade(i01)%Position + t(3)*u2%Blade(i01)%Position - t(2)*u3%Blade(i01)%Position ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%Blade(i01)%Position = u1%Blade(i01)%Position + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) - ENDDO - DO i01 = LBOUND(u_out%Blade,1),UBOUND(u_out%Blade,1) - ALLOCATE(b2(SIZE(u_out%Blade(i01)%Orientation,1),SIZE(u_out%Blade(i01)%Orientation,2) )) - ALLOCATE(c2(SIZE(u_out%Blade(i01)%Orientation,1),SIZE(u_out%Blade(i01)%Orientation,2) )) - b2 = (t(3)**2*(u1%Blade(i01)%Orientation - u2%Blade(i01)%Orientation) + t(2)**2*(-u1%Blade(i01)%Orientation + u3%Blade(i01)%Orientation))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*u1%Blade(i01)%Orientation + t(3)*u2%Blade(i01)%Orientation - t(2)*u3%Blade(i01)%Orientation ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%Blade(i01)%Orientation = u1%Blade(i01)%Orientation + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) - ENDDO - DO i01 = LBOUND(u_out%Blade,1),UBOUND(u_out%Blade,1) - ALLOCATE(b1(SIZE(u_out%Blade(i01)%TranslationVel,1))) - ALLOCATE(c1(SIZE(u_out%Blade(i01)%TranslationVel,1))) - b1 = (t(3)**2*(u1%Blade(i01)%TranslationVel - u2%Blade(i01)%TranslationVel) + t(2)**2*(-u1%Blade(i01)%TranslationVel + u3%Blade(i01)%TranslationVel))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%Blade(i01)%TranslationVel + t(3)*u2%Blade(i01)%TranslationVel - t(2)*u3%Blade(i01)%TranslationVel ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%Blade(i01)%TranslationVel = u1%Blade(i01)%TranslationVel + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) - ENDDO - DO i01 = LBOUND(u_out%Blade,1),UBOUND(u_out%Blade,1) - ALLOCATE(b1(SIZE(u_out%Blade(i01)%RotationVel,1))) - ALLOCATE(c1(SIZE(u_out%Blade(i01)%RotationVel,1))) - b1 = (t(3)**2*(u1%Blade(i01)%RotationVel - u2%Blade(i01)%RotationVel) + t(2)**2*(-u1%Blade(i01)%RotationVel + u3%Blade(i01)%RotationVel))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%Blade(i01)%RotationVel + t(3)*u2%Blade(i01)%RotationVel - t(2)*u3%Blade(i01)%RotationVel ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%Blade(i01)%RotationVel = u1%Blade(i01)%RotationVel + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) - ENDDO -END IF ! check if allocated - ALLOCATE(b1(SIZE(u_out%Hub%Position,1))) - ALLOCATE(c1(SIZE(u_out%Hub%Position,1))) - b1 = (t(3)**2*(u1%Hub%Position - u2%Hub%Position) + t(2)**2*(-u1%Hub%Position + u3%Hub%Position))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%Hub%Position + t(3)*u2%Hub%Position - t(2)*u3%Hub%Position ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%Hub%Position = u1%Hub%Position + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b2(SIZE(u_out%Hub%Orientation,1),SIZE(u_out%Hub%Orientation,2) )) - ALLOCATE(c2(SIZE(u_out%Hub%Orientation,1),SIZE(u_out%Hub%Orientation,2) )) - b2 = (t(3)**2*(u1%Hub%Orientation - u2%Hub%Orientation) + t(2)**2*(-u1%Hub%Orientation + u3%Hub%Orientation))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*u1%Hub%Orientation + t(3)*u2%Hub%Orientation - t(2)*u3%Hub%Orientation ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%Hub%Orientation = u1%Hub%Orientation + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) - ALLOCATE(b1(SIZE(u_out%Hub%TranslationVel,1))) - ALLOCATE(c1(SIZE(u_out%Hub%TranslationVel,1))) - b1 = (t(3)**2*(u1%Hub%TranslationVel - u2%Hub%TranslationVel) + t(2)**2*(-u1%Hub%TranslationVel + u3%Hub%TranslationVel))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%Hub%TranslationVel + t(3)*u2%Hub%TranslationVel - t(2)*u3%Hub%TranslationVel ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%Hub%TranslationVel = u1%Hub%TranslationVel + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(u_out%Hub%RotationVel,1))) - ALLOCATE(c1(SIZE(u_out%Hub%RotationVel,1))) - b1 = (t(3)**2*(u1%Hub%RotationVel - u2%Hub%RotationVel) + t(2)**2*(-u1%Hub%RotationVel + u3%Hub%RotationVel))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%Hub%RotationVel + t(3)*u2%Hub%RotationVel - t(2)*u3%Hub%RotationVel ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%Hub%RotationVel = u1%Hub%RotationVel + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(u_out%RotorFurl%Position,1))) - ALLOCATE(c1(SIZE(u_out%RotorFurl%Position,1))) - b1 = (t(3)**2*(u1%RotorFurl%Position - u2%RotorFurl%Position) + t(2)**2*(-u1%RotorFurl%Position + u3%RotorFurl%Position))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%RotorFurl%Position + t(3)*u2%RotorFurl%Position - t(2)*u3%RotorFurl%Position ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%RotorFurl%Position = u1%RotorFurl%Position + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b2(SIZE(u_out%RotorFurl%Orientation,1),SIZE(u_out%RotorFurl%Orientation,2) )) - ALLOCATE(c2(SIZE(u_out%RotorFurl%Orientation,1),SIZE(u_out%RotorFurl%Orientation,2) )) - b2 = (t(3)**2*(u1%RotorFurl%Orientation - u2%RotorFurl%Orientation) + t(2)**2*(-u1%RotorFurl%Orientation + u3%RotorFurl%Orientation))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*u1%RotorFurl%Orientation + t(3)*u2%RotorFurl%Orientation - t(2)*u3%RotorFurl%Orientation ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%RotorFurl%Orientation = u1%RotorFurl%Orientation + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) - ALLOCATE(b1(SIZE(u_out%RotorFurl%TranslationVel,1))) - ALLOCATE(c1(SIZE(u_out%RotorFurl%TranslationVel,1))) - b1 = (t(3)**2*(u1%RotorFurl%TranslationVel - u2%RotorFurl%TranslationVel) + t(2)**2*(-u1%RotorFurl%TranslationVel + u3%RotorFurl%TranslationVel))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%RotorFurl%TranslationVel + t(3)*u2%RotorFurl%TranslationVel - t(2)*u3%RotorFurl%TranslationVel ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%RotorFurl%TranslationVel = u1%RotorFurl%TranslationVel + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(u_out%RotorFurl%RotationVel,1))) - ALLOCATE(c1(SIZE(u_out%RotorFurl%RotationVel,1))) - b1 = (t(3)**2*(u1%RotorFurl%RotationVel - u2%RotorFurl%RotationVel) + t(2)**2*(-u1%RotorFurl%RotationVel + u3%RotorFurl%RotationVel))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%RotorFurl%RotationVel + t(3)*u2%RotorFurl%RotationVel - t(2)*u3%RotorFurl%RotationVel ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%RotorFurl%RotationVel = u1%RotorFurl%RotationVel + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(u_out%Nacelle%Position,1))) - ALLOCATE(c1(SIZE(u_out%Nacelle%Position,1))) - b1 = (t(3)**2*(u1%Nacelle%Position - u2%Nacelle%Position) + t(2)**2*(-u1%Nacelle%Position + u3%Nacelle%Position))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%Nacelle%Position + t(3)*u2%Nacelle%Position - t(2)*u3%Nacelle%Position ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%Nacelle%Position = u1%Nacelle%Position + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b2(SIZE(u_out%Nacelle%Orientation,1),SIZE(u_out%Nacelle%Orientation,2) )) - ALLOCATE(c2(SIZE(u_out%Nacelle%Orientation,1),SIZE(u_out%Nacelle%Orientation,2) )) - b2 = (t(3)**2*(u1%Nacelle%Orientation - u2%Nacelle%Orientation) + t(2)**2*(-u1%Nacelle%Orientation + u3%Nacelle%Orientation))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*u1%Nacelle%Orientation + t(3)*u2%Nacelle%Orientation - t(2)*u3%Nacelle%Orientation ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%Nacelle%Orientation = u1%Nacelle%Orientation + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) - ALLOCATE(b1(SIZE(u_out%Nacelle%TranslationVel,1))) - ALLOCATE(c1(SIZE(u_out%Nacelle%TranslationVel,1))) - b1 = (t(3)**2*(u1%Nacelle%TranslationVel - u2%Nacelle%TranslationVel) + t(2)**2*(-u1%Nacelle%TranslationVel + u3%Nacelle%TranslationVel))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%Nacelle%TranslationVel + t(3)*u2%Nacelle%TranslationVel - t(2)*u3%Nacelle%TranslationVel ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%Nacelle%TranslationVel = u1%Nacelle%TranslationVel + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(u_out%Nacelle%RotationVel,1))) - ALLOCATE(c1(SIZE(u_out%Nacelle%RotationVel,1))) - b1 = (t(3)**2*(u1%Nacelle%RotationVel - u2%Nacelle%RotationVel) + t(2)**2*(-u1%Nacelle%RotationVel + u3%Nacelle%RotationVel))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%Nacelle%RotationVel + t(3)*u2%Nacelle%RotationVel - t(2)*u3%Nacelle%RotationVel ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%Nacelle%RotationVel = u1%Nacelle%RotationVel + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(u_out%TailFin%Position,1))) - ALLOCATE(c1(SIZE(u_out%TailFin%Position,1))) - b1 = (t(3)**2*(u1%TailFin%Position - u2%TailFin%Position) + t(2)**2*(-u1%TailFin%Position + u3%TailFin%Position))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%TailFin%Position + t(3)*u2%TailFin%Position - t(2)*u3%TailFin%Position ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%TailFin%Position = u1%TailFin%Position + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b2(SIZE(u_out%TailFin%Orientation,1),SIZE(u_out%TailFin%Orientation,2) )) - ALLOCATE(c2(SIZE(u_out%TailFin%Orientation,1),SIZE(u_out%TailFin%Orientation,2) )) - b2 = (t(3)**2*(u1%TailFin%Orientation - u2%TailFin%Orientation) + t(2)**2*(-u1%TailFin%Orientation + u3%TailFin%Orientation))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*u1%TailFin%Orientation + t(3)*u2%TailFin%Orientation - t(2)*u3%TailFin%Orientation ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%TailFin%Orientation = u1%TailFin%Orientation + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) - ALLOCATE(b1(SIZE(u_out%TailFin%TranslationVel,1))) - ALLOCATE(c1(SIZE(u_out%TailFin%TranslationVel,1))) - b1 = (t(3)**2*(u1%TailFin%TranslationVel - u2%TailFin%TranslationVel) + t(2)**2*(-u1%TailFin%TranslationVel + u3%TailFin%TranslationVel))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%TailFin%TranslationVel + t(3)*u2%TailFin%TranslationVel - t(2)*u3%TailFin%TranslationVel ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%TailFin%TranslationVel = u1%TailFin%TranslationVel + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(u_out%TailFin%RotationVel,1))) - ALLOCATE(c1(SIZE(u_out%TailFin%RotationVel,1))) - b1 = (t(3)**2*(u1%TailFin%RotationVel - u2%TailFin%RotationVel) + t(2)**2*(-u1%TailFin%RotationVel + u3%TailFin%RotationVel))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%TailFin%RotationVel + t(3)*u2%TailFin%RotationVel - t(2)*u3%TailFin%RotationVel ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%TailFin%RotationVel = u1%TailFin%RotationVel + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(u_out%Tower%Position,1))) - ALLOCATE(c1(SIZE(u_out%Tower%Position,1))) - b1 = (t(3)**2*(u1%Tower%Position - u2%Tower%Position) + t(2)**2*(-u1%Tower%Position + u3%Tower%Position))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%Tower%Position + t(3)*u2%Tower%Position - t(2)*u3%Tower%Position ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%Tower%Position = u1%Tower%Position + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b2(SIZE(u_out%Tower%Orientation,1),SIZE(u_out%Tower%Orientation,2) )) - ALLOCATE(c2(SIZE(u_out%Tower%Orientation,1),SIZE(u_out%Tower%Orientation,2) )) - b2 = (t(3)**2*(u1%Tower%Orientation - u2%Tower%Orientation) + t(2)**2*(-u1%Tower%Orientation + u3%Tower%Orientation))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*u1%Tower%Orientation + t(3)*u2%Tower%Orientation - t(2)*u3%Tower%Orientation ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%Tower%Orientation = u1%Tower%Orientation + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) - ALLOCATE(b1(SIZE(u_out%Tower%TranslationVel,1))) - ALLOCATE(c1(SIZE(u_out%Tower%TranslationVel,1))) - b1 = (t(3)**2*(u1%Tower%TranslationVel - u2%Tower%TranslationVel) + t(2)**2*(-u1%Tower%TranslationVel + u3%Tower%TranslationVel))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%Tower%TranslationVel + t(3)*u2%Tower%TranslationVel - t(2)*u3%Tower%TranslationVel ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%Tower%TranslationVel = u1%Tower%TranslationVel + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(u_out%Tower%RotationVel,1))) - ALLOCATE(c1(SIZE(u_out%Tower%RotationVel,1))) - b1 = (t(3)**2*(u1%Tower%RotationVel - u2%Tower%RotationVel) + t(2)**2*(-u1%Tower%RotationVel + u3%Tower%RotationVel))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%Tower%RotationVel + t(3)*u2%Tower%RotationVel - t(2)*u3%Tower%RotationVel ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%Tower%RotationVel = u1%Tower%RotationVel + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(u_out%SubStructure%Position,1))) - ALLOCATE(c1(SIZE(u_out%SubStructure%Position,1))) - b1 = (t(3)**2*(u1%SubStructure%Position - u2%SubStructure%Position) + t(2)**2*(-u1%SubStructure%Position + u3%SubStructure%Position))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%SubStructure%Position + t(3)*u2%SubStructure%Position - t(2)*u3%SubStructure%Position ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%SubStructure%Position = u1%SubStructure%Position + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b2(SIZE(u_out%SubStructure%Orientation,1),SIZE(u_out%SubStructure%Orientation,2) )) - ALLOCATE(c2(SIZE(u_out%SubStructure%Orientation,1),SIZE(u_out%SubStructure%Orientation,2) )) - b2 = (t(3)**2*(u1%SubStructure%Orientation - u2%SubStructure%Orientation) + t(2)**2*(-u1%SubStructure%Orientation + u3%SubStructure%Orientation))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*u1%SubStructure%Orientation + t(3)*u2%SubStructure%Orientation - t(2)*u3%SubStructure%Orientation ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%SubStructure%Orientation = u1%SubStructure%Orientation + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) - ALLOCATE(b1(SIZE(u_out%SubStructure%TranslationVel,1))) - ALLOCATE(c1(SIZE(u_out%SubStructure%TranslationVel,1))) - b1 = (t(3)**2*(u1%SubStructure%TranslationVel - u2%SubStructure%TranslationVel) + t(2)**2*(-u1%SubStructure%TranslationVel + u3%SubStructure%TranslationVel))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%SubStructure%TranslationVel + t(3)*u2%SubStructure%TranslationVel - t(2)*u3%SubStructure%TranslationVel ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%SubStructure%TranslationVel = u1%SubStructure%TranslationVel + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(u_out%SubStructure%RotationVel,1))) - ALLOCATE(c1(SIZE(u_out%SubStructure%RotationVel,1))) - b1 = (t(3)**2*(u1%SubStructure%RotationVel - u2%SubStructure%RotationVel) + t(2)**2*(-u1%SubStructure%RotationVel + u3%SubStructure%RotationVel))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%SubStructure%RotationVel + t(3)*u2%SubStructure%RotationVel - t(2)*u3%SubStructure%RotationVel ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%SubStructure%RotationVel = u1%SubStructure%RotationVel + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(u_out%Foundation%Position,1))) - ALLOCATE(c1(SIZE(u_out%Foundation%Position,1))) - b1 = (t(3)**2*(u1%Foundation%Position - u2%Foundation%Position) + t(2)**2*(-u1%Foundation%Position + u3%Foundation%Position))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%Foundation%Position + t(3)*u2%Foundation%Position - t(2)*u3%Foundation%Position ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%Foundation%Position = u1%Foundation%Position + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b2(SIZE(u_out%Foundation%Orientation,1),SIZE(u_out%Foundation%Orientation,2) )) - ALLOCATE(c2(SIZE(u_out%Foundation%Orientation,1),SIZE(u_out%Foundation%Orientation,2) )) - b2 = (t(3)**2*(u1%Foundation%Orientation - u2%Foundation%Orientation) + t(2)**2*(-u1%Foundation%Orientation + u3%Foundation%Orientation))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*u1%Foundation%Orientation + t(3)*u2%Foundation%Orientation - t(2)*u3%Foundation%Orientation ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%Foundation%Orientation = u1%Foundation%Orientation + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) - ALLOCATE(b1(SIZE(u_out%Foundation%TranslationVel,1))) - ALLOCATE(c1(SIZE(u_out%Foundation%TranslationVel,1))) - b1 = (t(3)**2*(u1%Foundation%TranslationVel - u2%Foundation%TranslationVel) + t(2)**2*(-u1%Foundation%TranslationVel + u3%Foundation%TranslationVel))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%Foundation%TranslationVel + t(3)*u2%Foundation%TranslationVel - t(2)*u3%Foundation%TranslationVel ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%Foundation%TranslationVel = u1%Foundation%TranslationVel + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(u_out%Foundation%RotationVel,1))) - ALLOCATE(c1(SIZE(u_out%Foundation%RotationVel,1))) - b1 = (t(3)**2*(u1%Foundation%RotationVel - u2%Foundation%RotationVel) + t(2)**2*(-u1%Foundation%RotationVel + u3%Foundation%RotationVel))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%Foundation%RotationVel + t(3)*u2%Foundation%RotationVel - t(2)*u3%Foundation%RotationVel ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%Foundation%RotationVel = u1%Foundation%RotationVel + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) - b0 = (t(3)**2*(u1%BladeLength - u2%BladeLength) + t(2)**2*(-u1%BladeLength + u3%BladeLength))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%BladeLength + t(3)*u2%BladeLength - t(2)*u3%BladeLength ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%BladeLength = u1%BladeLength + b0 * t_out + c0 * t_out**2 - END SUBROUTINE AD14AeroConf_Input_ExtrapInterp2 - - - SUBROUTINE AD14AeroConf_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(AD14AeroConf_OutputType), INTENT(IN) :: y(:) ! Output at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Outputs - TYPE(AD14AeroConf_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 = 'AD14AeroConf_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 AD14AeroConf_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL AD14AeroConf_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 AD14AeroConf_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 AD14AeroConf_Output_ExtrapInterp - - - SUBROUTINE AD14AeroConf_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(AD14AeroConf_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 - TYPE(AD14AeroConf_OutputType), INTENT(IN) :: y2 ! Output at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs - TYPE(AD14AeroConf_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 = 'AD14AeroConf_Output_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 = -(y1%Dummy - y2%Dummy)/t(2) - y_out%Dummy = y1%Dummy + b0 * t_out - END SUBROUTINE AD14AeroConf_Output_ExtrapInterp1 - - - SUBROUTINE AD14AeroConf_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(AD14AeroConf_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 > t3 - TYPE(AD14AeroConf_OutputType), INTENT(IN) :: y2 ! Output at t2 > t3 - TYPE(AD14AeroConf_OutputType), INTENT(IN) :: y3 ! Output at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs - TYPE(AD14AeroConf_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 - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'AD14AeroConf_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%Dummy - y2%Dummy) + t(2)**2*(-y1%Dummy + y3%Dummy))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%Dummy + t(3)*y2%Dummy - t(2)*y3%Dummy ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%Dummy = y1%Dummy + b0 * t_out + c0 * t_out**2 - END SUBROUTINE AD14AeroConf_Output_ExtrapInterp2 - -END MODULE AD14AeroConf_Types -!ENDOFREGISTRYGENERATEDFILE diff --git a/modules/aerodyn14/src/AD_RegistryEntries.xlsx b/modules/aerodyn14/src/AD_RegistryEntries.xlsx deleted file mode 100644 index c7648aec13..0000000000 Binary files a/modules/aerodyn14/src/AD_RegistryEntries.xlsx and /dev/null differ diff --git a/modules/aerodyn14/src/AeroDyn14.f90 b/modules/aerodyn14/src/AeroDyn14.f90 deleted file mode 100644 index 52eb44358f..0000000000 --- a/modules/aerodyn14/src/AeroDyn14.f90 +++ /dev/null @@ -1,1249 +0,0 @@ -!********************************************************************************************************************************** -! LICENSING -! Copyright (C) 2012-2016 National Renewable Energy Laboratory -! -! This file is part of AeroDyn. -! -! Licensed under the Apache License, Version 2.0 (the "License"); -! you may not use this file except in compliance with the License. -! You may obtain a copy of the License at -! -! http://www.apache.org/licenses/LICENSE-2.0 -! -! Unless required by applicable law or agreed to in writing, software -! distributed under the License is distributed on an "AS IS" BASIS, -! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -! See the License for the specific language governing permissions and -! limitations under the License. -! -!********************************************************************************************************************************** -!> Module for the old aerodynamic routines. This module is for loose coupling only, without linearization, because it does not -!! fully conform to the FAST framework. This module will eventually be replaced by AeroDyn (i.e., AeroDyn v15 [aerodyn.f90]) -MODULE AeroDyn14 - - USE AeroDyn14_Types - USE AeroSubs - USE NWTC_Library - - - IMPLICIT NONE - - PRIVATE - - TYPE(ProgDesc), PARAMETER :: AD14_Ver = ProgDesc( 'AeroDyn14', '', '' ) - - ! ..... Public Subroutines ............ - - PUBLIC :: AD14_Init ! Initialization routine - PUBLIC :: AD14_End ! Ending routine (includes clean up) - - PUBLIC :: AD14_UpdateStates ! Loose coupling routine for solving for constraint states, integrating - ! continuous states, and updating discrete states - PUBLIC :: AD14_CalcOutput ! Routine for computing outputs - - -CONTAINS -!---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE AD14_Init( InitInp, u, p, x, xd, z, O, y, m, Interval, InitOut, ErrStat, ErrMess ) -!.................................................................................................................................. - USE AeroGenSubs, ONLY: ElemOpen - USE DWM - IMPLICIT NONE - - TYPE(AD14_InitInputType), INTENT(INOUT) :: InitInp ! Input data for initialization routine - TYPE(AD14_InputType), INTENT( OUT) :: u ! An initial guess for the input; input mesh must be defined - TYPE(AD14_ParameterType), INTENT( OUT) :: p ! Parameters - TYPE(AD14_ContinuousStateType), INTENT( OUT) :: x ! Initial continuous states - TYPE(AD14_DiscreteStateType), INTENT( OUT) :: xd ! Initial discrete states - TYPE(AD14_ConstraintStateType), INTENT( OUT) :: z ! Initial guess of the constraint states - TYPE(AD14_OtherStateType), INTENT( OUT) :: O ! Initial other states - TYPE(AD14_OutputType), INTENT( OUT) :: y ! Initial system outputs (outputs are not calculated; - ! only the output mesh is initialized) - TYPE(AD14_MiscVarType), INTENT( OUT) :: m ! Misc/optimization variables - REAL(DbKi), INTENT(INOUT) :: Interval ! Coupling interval in seconds: the rate that - ! (1) AD14_UpdateStates() is called in loose coupling & - ! (2) AD14_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(AD14_InitOutputType), INTENT( OUT) :: InitOut ! Output for initialization routine - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMess ! Error message if ErrStat /= ErrID_None - - - ! Internal variables - REAL(ReKi) :: CosPrecone - REAL(ReKi) :: DTip, ElemRad, Dhub, Rhub ! variables for calculating hub- and tip-loss constants - REAL(ReKi) :: HubRadius -! REAL(ReKi) :: MeanWind - REAL(ReKi) :: TipRadius - REAL(ReKi) :: TmpVar - REAL(ReKi) :: TmpPos(3) - REAL(ReKi) :: TwrNodeHt ! The height of the current tower node. - - INTEGER :: IB, IE - INTEGER :: IELM - -! CHARACTER(1024) :: Title - - INTEGER :: Elem ! Index for mesh element. - INTEGER :: InterpIndx ! Index telling the interpolation routine where to start in the array. - INTEGER :: Node ! Index used to pull points out of the array of values at given node location. - INTEGER :: ErrStatLcL ! Error status returned by called routines. - - CHARACTER(ErrMsgLen) :: ErrMessLcl ! Error message returned by called routines. - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_Init' - - ! Initialize ErrStat - - ErrStat = ErrID_None - ErrMess = "" - InterpIndx = 1 - - - CALL NWTC_Init( ) - - - ! Display the module information - - CALL DispNVD( AD14_Ver ) - - CALL ProgWarn( ' AeroDyn 14 is deprecated and will be removed in a future release.' ) - - InitOut%Ver = AD14_Ver - m%FirstWarn = .TRUE. - !------------------------------------------------------------------------------------------------- - ! Set up AD variables - !------------------------------------------------------------------------------------------------- - - p%LinearizeFlag = .FALSE. ! InitInp%LinearizeFlag - p%Blade%BladeLength = InitInp%TurbineComponents%BladeLength - p%DtAero = Interval ! set the default DT here; may be overwritten later, when we read the input file in AD14_GetInput() - p%UseDWM = InitInp%UseDWM - - ! 2022.09.06 -- ADP - ! Recent changes to how the disk average velocity is calculated in InflowWind will likely cause seg-faults in DWM. Therefore - ! changes will need to be made to DWM for this to work properly. Since AD14 and DWM will be removed in the very near future, - ! it is not a good use of time to fix this. Instead I'll leave this comment here for anyone who really wants to use DWM. - if (p%UseDWM) then - call SetErrStat(ErrID_Fatal, ' DWM is no longer supported and will be deprecated in the near future. We recommend using FAST.Farm instead.', ErrStat,ErrMess,RoutineName ) - return - endif - - ! Define parameters here: - - p%WrOptFile = InitInp%WrSumFile - - p%NumBl = SIZE( InitInp%TurbineComponents%Blade ) - IF ( p%NumBl < 1 ) THEN - CALL SetErrStat( ErrID_Fatal,'AeroDyn cannot run without blades in the model.',ErrStat,ErrMess,RoutineName) - RETURN - END IF -!bjj: what's the difference between p%NumBl, p%Blade%NB, and InitInp%NumBl? -!MLB: Heck if I know! - - ! Define initial system states here: - !------------------------------------------------------------------------------------------------- - ! Read the AeroDyn14 input file and open the output file if requested - ! bjj: these should perhaps be combined - !------------------------------------------------------------------------------------------------- - CALL AD14_GetInput(InitInp, P, x, xd, z, m, y, ErrStatLcl, ErrMessLcl ) - CALL SetErrStat( ErrStatLcl,ErrMessLcl,ErrStat,ErrMess,RoutineName) - IF (ErrStat >= AbortErrLev ) RETURN - - - ! allocate variables for aerodyn forces - p%LinearizeFlag = .FALSE. - - Interval = p%DtAero - - - IF ( .NOT. ALLOCATED( m%StoredForces )) THEN - CALL AllocAry(m%StoredForces, 3,p%Element%NELM,p%NumBl,'m%StoredForces',ErrStatLcl,ErrMessLcl ) - CALL SetErrStat( ErrStatLcl,ErrMessLcl,ErrStat,ErrMess,RoutineName) - END IF - IF ( .NOT. ALLOCATED( m%StoredMoments )) THEN - CALL AllocAry(m%StoredMoments, 3,p%Element%NELM,p%NumBl,'m%StoredForces',ErrStatLcl,ErrMessLcl ) - CALL SetErrStat( ErrStatLcl,ErrMessLcl,ErrStat,ErrMess,RoutineName) - END IF - - IF (.NOT. ALLOCATED(m%Element%W2) ) THEN - CALL AllocAry(m%Element%W2, p%Element%NELM, p%NumBl,'m%Element%W2',ErrStatLcl,ErrMessLcl ) - CALL SetErrStat( ErrStatLcl,ErrMessLcl,ErrStat,ErrMess,RoutineName) - END IF - - IF (.NOT. ALLOCATED(m%Element%Alpha) ) THEN - CALL AllocAry(m%Element%Alpha, p%Element%NELM, p%NumBl,'m%Element%Alpha',ErrStatLcl,ErrMessLcl ) - CALL SetErrStat( ErrStatLcl,ErrMessLcl,ErrStat,ErrMess,RoutineName) - END IF - - IF (.NOT. ALLOCATED(m%Element%PitNow) ) THEN - CALL AllocAry(m%Element%PitNow, p%Element%NELM, p%NumBl,'m%Element%PitNow',ErrStatLcl,ErrMessLcl ) - CALL SetErrStat( ErrStatLcl,ErrMessLcl,ErrStat,ErrMess,RoutineName) - END IF - IF (ErrStat >= AbortErrLev ) RETURN - - - P%UnWndOut = -1 - P%UnElem = -1 - IF ( p%ElemPrn ) THEN - CALL ElemOpen ( TRIM( InitInp%OutRootName )//'.AD.out', P, m, ErrStat, ErrMess, AD14_Ver ) - CALL SetErrStat( ErrStatLcl,ErrMessLcl,ErrStat,ErrMess,RoutineName) - IF (ErrStat >= AbortErrLev ) RETURN - END IF - - - !------------------------------------------------------------------------------------------------- - ! Calculate the rotor and hub radaii from the input values - !------------------------------------------------------------------------------------------------- - HubRadius = DOT_PRODUCT( InitInp%TurbineComponents%Blade(1)%Position(:) & - - InitInp%TurbineComponents%Hub%Position(:), & - InitInp%TurbineComponents%Blade(1)%Orientation(3,:) ) - - DO IB = 2,p%NumBl - TmpVar = DOT_PRODUCT( InitInp%TurbineComponents%Blade(IB)%Position(:) & - - InitInp%TurbineComponents%Hub%Position(:), & - InitInp%TurbineComponents%Blade(IB)%Orientation(3,:) ) - IF ( ABS( TmpVar - HubRadius ) > 0.001 ) THEN ! within 1 mm - CALL ProgWarn( ' AeroDyn\AD14_Init() calculated HubRadius is not the same for all '// & - 'blades. Using value from blade 1.' ) - EXIT - END IF - END DO !IB - - TipRadius = InitInp%TurbineComponents%BladeLength + HubRadius - - CosPrecone = ASIN( DOT_PRODUCT( InitInp%TurbineComponents%Blade(1)%Orientation(3,:), & - InitInp%TurbineComponents%Hub%Orientation(1,:) ) ) ! precone angle -- do COS later - - DO IB = 2,p%NumBl - TmpVar = ASIN( DOT_PRODUCT( InitInp%TurbineComponents%Blade(IB)%Orientation(3,:), & - InitInp%TurbineComponents%Hub%Orientation(1,:) ) ) - IF ( ABS( TmpVar - CosPrecone ) > 0.009 ) THEN ! within ~ 1/2 degree - CALL ProgWarn( ' AeroDyn\AD14_Init() calculated precone angle is not the same for all'// & - ' blades. Using value from blade 1.' ) - EXIT - END IF - END DO !IBld - - CosPrecone = COS( CosPrecone ) - - p%Blade%R = TipRadius * CosPrecone - RHub = HubRadius * CosPrecone - p%HubRad = RHub - - ! Check that the AeroDyn input DR and RElm match (use the HubRadius and TipRadius to verify) - ! before using them to calculate the tip- and hub-loss constants - CALL CheckRComp( P, x, xd, z, m, y, ErrStat, ErrMess, & - InitInp%ADFileName, HubRadius, TipRadius ) - - IF ( ErrStat /= ErrID_None ) RETURN - - !------------------------------------------------------------------------------------------------- - ! Calculate tip-loss constants - !------------------------------------------------------------------------------------------------- - DO IElm = 1,p%Element%NElm ! Loop through all blade elements - - ElemRad = p%Element%RELM(IElm)*CosPrecone - - IF( ElemRad == 0.0 ) THEN !BJJ: should this be 0.001 (or another small number) instead of exactly 0.0? - CALL SetErrStat( ErrID_Fatal,'Error calculating tip loss constant for element '//TRIM(Int2LStr(IElm))//& - '. Division by zero.',ErrStat,ErrMess,RoutineName) - - RETURN - ELSE - DTip = p%Blade%R - ElemRad - p%Element%TLCNST(IElm) = 0.5 * p%NumBl * DTip / ElemRad - ENDIF - - ENDDO ! IElm - all blade elements - - - !------------------------------------------------------------------------------------------------- - ! Calculate hub-loss constants - !------------------------------------------------------------------------------------------------- - IF ( RHub > 0.001 ) THEN - - DO Ielm = 1,p%Element%NELM ! Loop through all blade elements - - ElemRad = p%Element%RELM(Ielm)*CosPrecone ! Use only the precone angle of blade 1 (assumed very similar to other blades) - - DHub = ElemRad - RHub - p%Element%HLCNST(Ielm) = 0.5 * p%NumBl * DHub / RHub - - ENDDO ! IELM - all blade elements - - ELSE - - p%Element%HLCNST(:) = 0.0 - - ENDIF - - - - !------------------------------------------------------------------------------------------------- - ! Interpolate the tower diameter at ElastoDyn's tower nodes if we will be computing tower aerodynamics. - !------------------------------------------------------------------------------------------------- - - IF ( p%TwrProps%CalcTwrAero ) THEN - - !------------------------------------------------------------------------------------------------- - ! IMPORTANT NOTES: - ! o Supposedly, the glue code will not try to do anything with the tower-aero mesh if is is - ! not created, so the creation is inside the test for CalcTwrAero. - ! o The tower properties from AeroDyn's tower file are for heights from the origin (ground or - ! MSL) to the hub height--not the top of the tower. - ! o For now, we are allowing only one set of Cd for the entire tower. - ! o InterpIndx is initialize to 1 at compile time. - !------------------------------------------------------------------------------------------------- - - - ! Create the mesh for the tower aerodynamics. - - CALL MeshCreate ( BlankMesh = u%Twr_InputMarkers & - , IOS = COMPONENT_INPUT & - , NNodes = InitInp%NumTwrNodes & - , Orientation = .TRUE. & - , TranslationDisp = .TRUE. & - , TranslationVel = .TRUE. & - , ErrStat = ErrStatLcl & - , ErrMess = ErrMessLcl ) - - CALL SetErrStat(ErrStatLcl,ErrMessLcl,ErrStat,ErrMess,RoutineName ) - IF ( ErrStat >= AbortErrLev ) RETURN - - - ! Set the positions of the nodes. MeshCreate() allocated the Position array. - - DO Node = 1,u%Twr_InputMarkers%Nnodes - CALL MeshPositionNode ( Mesh = u%Twr_InputMarkers & - ,INode = Node & - ,Pos = InitInp%TwrNodeLocs(:,Node) & - ,ErrStat = ErrStatLcl & - ,ErrMess = ErrMessLcl ) - CALL SetErrStat(ErrStatLcl,ErrMessLcl,ErrStat,ErrMess,RoutineName ) - IF ( ErrStat >= AbortErrLev ) RETURN - - END DO - - - ! Construct the tower with Line-2 elements. - - DO Elem=1,u%Twr_InputMarkers%Nnodes-1 - - CALL MeshConstructElement ( Mesh = u%Twr_InputMarkers & - , Xelement = ELEMENT_LINE2 & - , P1 = Elem & - , P2 = Elem+1 & - , ErrStat = ErrStatLcl & - , ErrMess = ErrMessLcl ) - - CALL SetErrStat(ErrStatLcl,ErrMessLcl,ErrStat,ErrMess,RoutineName ) - IF ( ErrStat >= AbortErrLev ) RETURN - - ENDDO - - - ! Commit the mesh to the funny farm. - - CALL MeshCommit ( u%Twr_InputMarkers, ErrStatLcl, ErrMessLcl ) - CALL SetErrStat(ErrStatLcl,ErrMessLcl,ErrStat,ErrMess,RoutineName ) - IF ( ErrStat >= AbortErrLev ) RETURN - - - ! Copy the input mesh to create the output mesh. Does - - CALL MeshCopy ( SrcMesh = u%Twr_InputMarkers & - , DestMesh = y%Twr_OutputLoads & - , CtrlCode = MESH_SIBLING & - , Force = .TRUE. & - , ErrStat = ErrStatLcl & - , ErrMess = ErrMessLcl ) - - CALL SetErrStat(ErrStatLcl,ErrMessLcl,ErrStat,ErrMess,RoutineName ) - IF ( ErrStat >= AbortErrLev ) RETURN - - - ! Check to ensure that the user did not specify more than one set of Cd(Re) tables. Temporary restriction. - - IF ( p%TwrProps%NTwrCD /= 1 ) THEN - CALL SetErrStat(ErrID_Fatal,'You must have one and only one set of drag coefficients for the AeroDyn tower file.',ErrStat,ErrMess,RoutineName ) - RETURN - END IF - - - ! Build the TwrNodeWidth array. - - p%TwrProps%NumTwrNodes = InitInp%NumTwrNodes - - IF (.NOT. ALLOCATED( p%TwrProps%TwrNodeWidth ) ) THEN - CALL AllocAry( p%TwrProps%TwrNodeWidth, p%TwrProps%NumTwrNodes, "array for tower widths at ED node locations", ErrStatLcl, ErrMessLcl ) - CALL SetErrStat(ErrStatLcl,ErrMessLcl,ErrStat,ErrMess,RoutineName ) - IF ( ErrStat >= AbortErrLev ) RETURN - END IF - - DO Node=1,p%TwrProps%NumTwrNodes - - TwrNodeHt = InitInp%TwrNodeLocs(3,Node)/p%Rotor%HH - - p%TwrProps%TwrNodeWidth(Node) = InterpStp( TwrNodeHt, p%TwrProps%TwrHtFr, p%TwrProps%TwrWid, InterpIndx, p%TwrProps%NTwrHT ) - - END DO ! Node - - ELSE - u%Twr_InputMarkers%Nnodes = 0 - y%Twr_OutputLoads%Nnodes = 0 - END IF ! ( p%TwrProps%CalcTwrAero ) - - - !------------------------------------------------------------------------------------------------- - ! Write the summary (opt) file, then close it - !------------------------------------------------------------------------------------------------- - - IF (p%WrOptFile) THEN - - CALL ADOut(InitInp, P, m, AD14_Ver, TRIM(InitInp%OutRootName)//'.AD.sum', ErrStatLcl, ErrMessLcl ) - CALL SetErrStat(ErrStatLcl,ErrMessLcl,ErrStat,ErrMess,RoutineName ) - IF ( ErrStat >= AbortErrLev ) RETURN - - ENDIF - - - !------------------------------------------------------------------------------------------------- - ! Initialize the inputs from the wind inflow module - !------------------------------------------------------------------------------------------------- - CALL AllocAry( u%InflowVelocity, 3, p%Element%NElm*p%NumBl + u%Twr_InputMarkers%Nnodes, 'u%InflowVelocity', ErrStatLcl, ErrMessLcl ) - CALL SetErrStat(ErrStatLcl,ErrMessLcl,ErrStat,ErrMess,RoutineName ) - IF ( ErrStat >= AbortErrLev ) RETURN - u%InflowVelocity = 0.0_ReKi - - !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - ! Calling the DWM - !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - IF ( p%UseDWM ) THEN - ! InitInp%DWM%IfW%InputFileName is already set in FAST - - ! bjj: all this stuff should be put in DWM_Init.....> - p%DWM%RR = p%Blade%R - p%DWM%BNum = p%NumBl - !p%DWM%ElementNum = m%ElOut%NumElOut !bjj: NumElOut is the number of elements to be printed in an output file. I really think you want the number of blade elements. I guess we should check that NumElOut is the same as p%Element%NElm - p%DWM%ElementNum = p%Element%NElm ! yj: 1/18/2016 - p%DWM%air_density = p%Wind%Rho - - IF (.NOT. ALLOCATED(m%DWM%Nforce )) ALLOCATE ( m%DWM%Nforce( p%Element%NElm,p%NumBl),STAT=ErrStatLcl);CALL SetErrStat(ErrStatLcl, 'Error allocating DWM Nforce array', ErrStat,ErrMess,RoutineName ) - IF (.NOT. ALLOCATED(m%DWM%blade_dr )) ALLOCATE ( m%DWM%blade_dr( p%Element%NElm), STAT=ErrStatLcl);CALL SetErrStat(ErrStatLcl, 'Error allocating DWM blade_dr array', ErrStat,ErrMess,RoutineName ) - IF (.NOT. ALLOCATED(p%DWM%ElementRad)) ALLOCATE ( p%DWM%ElementRad(p%Element%NElm), STAT=ErrStatLcl);CALL SetErrStat(ErrStatLcl, 'Error allocating DWM ElementRad array', ErrStat,ErrMess,RoutineName ) - if (errStat >= AbortErrLev) return - - m%DWM%blade_dr = p%Blade%DR(:) - p%DWM%ElementRad = p%Element%RELM(:) - - CALL DWM_Init( InitInp%DWM, m%DWM_Inputs, p%DWM, x%DWM, xd%DWM, z%DWM, O%DWM, m%DWM_Outputs, m%DWM, Interval, InitOut%DWM, ErrStatLcl, ErrMessLcl) - - - CALL SetErrStat ( ErrStatLcl, ErrMessLcl, ErrStat,ErrMess,RoutineName ) - IF (ErrStat >= AbortErrLev) RETURN - - END IF !UseDWM - - !------------------------------------------------------------------------------------------------- - ! Turn off dynamic inflow for wind less than 8 m/s (per DJL: 8 m/s is really just an empirical guess) - ! DJL: Comment out this code when using new proposed GDW check in ELEMFRC - ! BJJ: FIX THIS!!!! - !------------------------------------------------------------------------------------------------- - - ! BJJ: can't put this here b/c we need InitInp%MWS from InflowWind - !IF (p%DynInfl) THEN - ! - ! IF ( InitInp%MWS < 8.0 ) THEN - ! p%DynInfl = .FALSE. - ! CALL SetErrStat(ErrID_Info,'Estimated average inflow wind speed is less than 8 m/s. Dynamic Inflow will be turned off.',ErrStat,ErrMess,RoutineName ) - ! IF ( ErrStat >= AbortErrLev ) RETURN - ! END IF - ! - !ENDIF - - - !------------------------------------------------------------------------------------------------- - ! Set initial guesses for inputs: - !------------------------------------------------------------------------------------------------- - - !.......... - ! u%TurbineComponents - !.......... - - CALL AD14_CopyAeroConfig( InitInp%TurbineComponents, u%TurbineComponents, MESH_NEWCOPY, ErrStatLcl, ErrMessLcl ) - CALL SetErrStat ( ErrStatLcl, ErrMessLcl, ErrStat,ErrMess,RoutineName ) - IF (ErrStat >= AbortErrLev) RETURN - - !.......... - ! u%InputMarkers (blade meshes): - !.......... - - ALLOCATE( u%InputMarkers(p%NumBl), STAT=ErrStatLcl ) - IF (ErrStatLcl /= 0 ) THEN - CALL SetErrStat ( ErrID_Fatal, 'Could not allocate u%InputMarkers (meshes)', ErrStat,ErrMess,RoutineName ) - RETURN - END IF - - - DO IB = 1, p%NumBl - CALL MeshCreate( BlankMesh = u%InputMarkers(IB) & - ,IOS = COMPONENT_INPUT & - ,NNodes = p%Element%NELM & - ,Orientation = .TRUE. & - ,TranslationVel = .TRUE. & - ,TranslationAcc = .TRUE. & !bjj: added for MHK turbines - ,RotationVel = .TRUE. & - ,nScalars = 2 & ! scalar 1 is W, scalar 2 is Alpha - ,ErrStat = ErrStatLcl & - ,ErrMess = ErrMessLcl ) - - CALL SetErrStat ( ErrStatLcl, ErrMessLcl, ErrStat,ErrMess,RoutineName ) - IF (ErrStat >= AbortErrLev) RETURN - - ! create the elements - DO IE = 1, p%Element%NELM-1 ! construct the blades into Line2 elements - CALL MeshConstructElement ( Mesh = u%InputMarkers(IB) & - ,Xelement = ELEMENT_LINE2 & - ,P1 = IE & - ,P2 = IE+1 & - ,ErrStat = ErrStatLcl & - ,ErrMess = ErrMessLcl ) - CALL SetErrStat ( ErrStatLcl, ErrMessLcl, ErrStat,ErrMess,RoutineName ) - IF (ErrStat >= AbortErrLev) RETURN - - ENDDO - - ! position/orient the nodes - DO IE = 1, p%Element%NELM - TmpPos(1) = 0. - TmpPos(2) = 0. - TmpPos(3) = p%Element%Relm(IE) - HubRadius - CALL MeshPositionNode ( Mesh = u%InputMarkers(IB) & - ,INode = IE & - ,Pos= TmpPos & ! this info comes from FAST (not yet) - ,ErrStat = ErrStatLcl & - ,ErrMess = ErrMessLcl ) - CALL SetErrStat ( ErrStatLcl, ErrMessLcl, ErrStat,ErrMess,RoutineName ) - IF (ErrStat >= AbortErrLev) RETURN - - ! RELATIVE ORIENTATION OF BLADE ELEMENTS - u%InputMarkers(IB)%Orientation(1,1,IE) = COS( P%Element%TWIST(IE) ) - u%InputMarkers(IB)%Orientation(2,1,IE) = SIN( P%Element%TWIST(IE) ) - u%InputMarkers(IB)%Orientation(3,1,IE) = SIN( P%Element%TWIST(IE) ) - u%InputMarkers(IB)%Orientation(1,2,IE) = -1. * u%InputMarkers(IB)%Orientation(2,1,IE) - u%InputMarkers(IB)%Orientation(2,2,IE) = u%InputMarkers(IB)%Orientation(1,1,IE) - u%InputMarkers(IB)%Orientation(3,2,IE) = 0.0 - u%InputMarkers(IB)%Orientation(1,3,IE) = 0.0 - u%InputMarkers(IB)%Orientation(2,3,IE) = 0.0 - u%InputMarkers(IB)%Orientation(3,3,IE) = 1.0 - ENDDO - - CALL MeshCommit ( Mesh = u%InputMarkers(IB) & - ,ErrStat = ErrStatLcl & - ,ErrMess = ErrMessLcl ) - CALL SetErrStat ( ErrStatLcl, ErrMessLcl, ErrStat,ErrMess,RoutineName ) - IF (ErrStat >= AbortErrLev) RETURN - - ENDDO - - - !.......... - ! u%Twr_InputMarkers (tower meshes): - !.......... - - !bjj: done above in section for IF Tower Loads is on - - - !.......... - ! u%MulTabLoc: - !.......... - - IF (.NOT. ALLOCATED(u%MulTabLoc)) THEN - ALLOCATE( u%MulTabLoc(p%Element%NELM, p%NumBl), STAT = ErrStatLcl ) - IF (ErrStatLcl /= 0) THEN - CALL SetErrStat ( ErrID_Fatal, 'Could not allocate u%MulTabLoc', ErrStat,ErrMess,RoutineName ) - RETURN - END IF - END IF - - u%MulTabLoc(:,:) = 0.0 - - - !------------------------------------------------------------------------------------------------- - ! Allocate space for outputs and set up output meshes: - !------------------------------------------------------------------------------------------------- - - !.......... - ! y%OutputLoads (blade meshes): - !.......... - - - ALLOCATE( y%OutputLoads(p%NumBl), STAT = ErrStatLcl ) - IF (ErrStatLcl /= 0) THEN - CALL SetErrStat ( ErrID_Fatal, 'Could not allocate y%OutputLoads (meshes)', ErrStat,ErrMess,RoutineName ) - RETURN - END IF - - DO IB = 1, p%NumBl - - CALL MeshCopy ( SrcMesh = u%InputMarkers(IB) & - ,DestMesh = y%OutputLoads(IB) & - ,CtrlCode = MESH_SIBLING & - ,Force = .TRUE. & - ,Moment = .TRUE. & - ,ErrStat = ErrStatLcl & - ,ErrMess = ErrMessLcl ) - CALL SetErrStat ( ErrStatLcl, ErrMessLcl, ErrStat,ErrMess,RoutineName ) - IF (ErrStat >= AbortErrLev) RETURN - ENDDO - - - !.......... - ! y%Twr_OutputLoads (tower meshes): - !.......... - - !bjj: done above in section for IF Tower Loads is on - - - !------------------------------------------------------------------------------------------------- - ! Initialize AeroDyn variables not initialized elsewhere (except in module initialization) - ! and return - !------------------------------------------------------------------------------------------------- - m%InducedVel%SumInfl = 0.0_ReKi - m%Rotor%AvgInfl = 0.0_ReKi - m%OldTime = 0.0_DbKi - m%SuperSonic = .FALSE. - m%NoLoadsCalculated = .TRUE. - - p%TwoPiNB = TwoPi / REAL( p%NumBl, ReKi ) - - - DO ie = 1, maxInfl - p%DynInflow%xMinv(ie) = PIBY2 / hfunc(MRvector(ie), NJvector(ie)) !bjj: this is really just a Fortran parameter, too. - END DO !ie - - - InitOut%AirDens = p%Wind%Rho - - - RETURN - -END SUBROUTINE AD14_Init -!---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE AD14_End( u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMess ) -! This routine is called at the end of the simulation. -!.................................................................................................................................. - USE DWM_Types - USE DWM - - TYPE(AD14_InputType), INTENT(INOUT) :: u ! System inputs - TYPE(AD14_ParameterType), INTENT(INOUT) :: p ! Parameters - TYPE(AD14_ContinuousStateType), INTENT(INOUT) :: x ! Continuous states - TYPE(AD14_DiscreteStateType), INTENT(INOUT) :: xd ! Discrete states - TYPE(AD14_ConstraintStateType), INTENT(INOUT) :: z ! Constraint states - TYPE(AD14_OtherStateType), INTENT(INOUT) :: OtherState ! Other states - TYPE(AD14_OutputType), INTENT(INOUT) :: y ! System outputs - TYPE(AD14_MiscVarType), INTENT(INOUT) :: m ! Misc/optimization variables - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMess ! Error message if ErrStat /= ErrID_None - - - - ! Initialize ErrStat - - ErrStat = ErrID_None - ErrMess = "" - - - ! Place any last minute operations or calculations here: - - IF (p%UseDWM ) THEN - !----- Call the DWM ------- - - CALL DWM_End( m%DWM_Inputs, p%DWM, x%DWM, xd%DWM, z%DWM, OtherState%DWM, m%DWM_Outputs, m%DWM, ErrStat, ErrMess ) - END IF ! UseDWM - - !-------------------------- - - - ! Close files here: - - ! AD14_IOParams - IF (P%UnEc > 0) CLOSE(P%UnEc) ! not currently used - - IF (P%UnWndOut > 0) CLOSE(P%UnWndOut) - IF (P%UnElem > 0) CLOSE(P%UnElem) - - ! Destroy the input data: - - CALL AD14_DestroyInput( u, ErrStat, ErrMess ) - - - ! Destroy the parameter data: - - CALL AD14_DestroyParam( p, ErrStat, ErrMess ) - - - ! Destroy the state data: - - CALL AD14_DestroyContState( x, ErrStat, ErrMess ) - CALL AD14_DestroyDiscState( xd, ErrStat, ErrMess ) - CALL AD14_DestroyConstrState( z, ErrStat, ErrMess ) - CALL AD14_DestroyOtherState( OtherState, ErrStat, ErrMess ) - - CALL AD14_DestroyMisc( m, ErrStat, ErrMess ) - - ! Destroy the output data: - - CALL AD14_DestroyOutput( y, ErrStat, ErrMess ) - - -END SUBROUTINE AD14_End -!---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE AD14_UpdateStates( t, n, u, utimes, p, x, xd, z, OtherState, m, ErrStat, ErrMess ) -! Loose coupling routine for solving for constraint states, integrating continuous states, and updating discrete states -! Constraint states are solved for input Time; Continuous and discrete states are updated for Time + Interval -!.................................................................................................................................. - - REAL(DbKi), INTENT(IN ) :: t ! Current simulation time in seconds - INTEGER(IntKi), INTENT(IN ) :: n ! Current simulation time step n = 0,1,... - TYPE(AD14_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(AD14_ParameterType), INTENT(IN ) :: p ! Parameters - TYPE(AD14_ContinuousStateType), INTENT(INOUT) :: x ! Input: Continuous states at t; - ! Output: Continuous states at t + Interval - TYPE(AD14_DiscreteStateType), INTENT(INOUT) :: xd ! Input: Discrete states at t; - ! Output: Discrete states at t + Interval - TYPE(AD14_ConstraintStateType), INTENT(INOUT) :: z ! Input: Constraint states at t; - ! Output: Constraint states at t + Interval - TYPE(AD14_OtherStateType), INTENT(INOUT) :: OtherState ! Input: Other states at t; - ! Output: Other states at t + Interval - TYPE(AD14_MiscVarType), INTENT(INOUT) :: m ! Misc/optimization variables - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMess ! Error message if ErrStat /= ErrID_None - - ! Local variables - - TYPE(AD14_ContinuousStateType) :: dxdt ! Continuous state derivatives at Time - TYPE(AD14_ConstraintStateType) :: z_Residual ! Residual of the constraint state equations (Z) - -! INTEGER(IntKi) :: ErrStat2 ! Error status of the operation (occurs after initial error) -! CHARACTER(ErrMsgLen) :: ErrMess2 ! Error message if ErrStat2 /= ErrID_None - - ! Initialize ErrStat - - ErrStat = ErrID_None - ErrMess = "" - - - ! AeroDyn v14 DOES actually have states, but they are updated in CalcOutput because no one ever took the time to - ! identify which variables are states. - -END SUBROUTINE AD14_UpdateStates - -!---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE AD14_CalcOutput( Time, u, p, x, xd, z, O, y, m, ErrStat, ErrMess ) -! Routine for computing outputs, used in both loose and tight coupling. -!.................................................................................................................................. - - USE AeroGenSubs, ONLY: ElemOut - USE DWM_Types - USE DWM - - REAL(DbKi), INTENT(IN ) :: Time ! Current simulation time in seconds - TYPE(AD14_InputType), INTENT(INOUT) :: u ! Inputs at Time - TYPE(AD14_ParameterType), INTENT(IN ) :: p ! Parameters - TYPE(AD14_ContinuousStateType), INTENT(IN ) :: x ! Continuous states at Time - TYPE(AD14_DiscreteStateType), INTENT(IN ) :: xd ! Discrete states at Time - TYPE(AD14_ConstraintStateType), INTENT(INOUT) :: z ! Constraint states at Time - TYPE(AD14_OtherStateType), INTENT(IN ) :: O ! Other states at Time - TYPE(AD14_OutputType), INTENT(INOUT) :: y ! Outputs computed at Time (Input only so that mesh con- - ! nectivity information does not have to be recalculated) - TYPE(AD14_MiscVarType), INTENT(INOUT) :: m ! Misc/optimization variables - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMess ! Error message if ErrStat /= ErrID_None - - - ! Local variables - REAL(DbKi), PARAMETER :: OnePlusEpsilon = 1 + EPSILON(Time) - - REAL(ReKi) :: VelNormalToRotor2 - REAL(ReKi) :: VTWind - REAL(ReKi) :: VNWind - REAL(ReKi) :: VNElement - REAL(ReKi) :: VTElement - REAL(ReKi) :: VN_ind - REAL(ReKi) :: VT_ind - REAL(ReKi) :: VN - REAL(ReKi) :: VT - REAL(ReKi) :: VTTotal - REAL(ReKi) :: DFN - REAL(ReKi) :: DFT - REAL(ReKi) :: PMA - REAL(ReKi) :: SPitch ! sine of PitNow - REAL(ReKi) :: CPitch ! cosine of PitNow - REAL(ReKi) :: Phi ! Local value of Phi - - REAL(ReKi) :: AvgVelNacelleRotorFurlYaw - REAL(ReKi) :: AvgVelTowerBaseNacelleYaw - REAL(ReKi) :: AvgVelTowerBaseYaw - REAL(ReKi) :: AzimuthAngle - REAL(ReKi) :: rNacelleHub (2) - REAL(ReKi) :: rLocal - REAL(ReKi) :: rRotorFurlHub (2) - REAL(ReKi) :: rTowerBaseHub (2) - - REAL(ReKi) :: tmpVector (3) - REAL(ReKi) :: norm_Vector (3) ! Unit vector normal to chord - REAL(ReKi) :: tang_Vector (3) ! Unit vector tangent to chord - REAL(ReKi) :: VelocityVec (3) - - INTEGER :: ErrStatLcL ! Error status returned by called routines. - INTEGER :: IBlade - INTEGER :: IElement - INTEGER :: Node ! Node index. - - INTEGER :: I - CHARACTER(ErrMsgLen) :: ErrMessLcl ! Error message returned by called routines. - - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_AeroSubs' !KS Not sure why I added this - - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMess = "" - - - !------------------------------------------------------------------------------------------------- - ! Determine if loads should be recalculated or just returned - !------------------------------------------------------------------------------------------------- - ! NOTE: Time is scaled by OnePlusEps to ensure that loads are calculated at every - ! time step when DTAero = DT, even in the presence of numerical precision errors. - - IF ( m%NoLoadsCalculated .OR. ( Time*OnePlusEpsilon - m%OldTime ) >= p%DTAERO ) THEN - ! It's time to update the aero forces - - ! First we reset the DTAERO parameters for next time - m%DT = Time - m%OldTime !bjj: DT = 0 on first step, - !but the subroutines that use DT check for NoLoadsCalculated (or time > 0) - m%OldTime = Time - - ELSE IF ( .NOT. p%LinearizeFlag ) THEN - - ! Return the previously-calculated loads - -! CurrentOutputs = ADCurrentLoads - - DO IBlade=1,p%NumBl - DO IElement=1,p%Element%Nelm - y%OutputLoads(IBlade)%Force(:,IElement) = m%StoredForces(:,IElement,IBlade) - y%OutputLoads(IBlade)%Moment(:,IElement) = m%StoredMoments(:,IElement,IBlade) - ENDDO - ENDDO - - IF ( m%FirstWarn ) THEN - CALL SetErrStat ( ErrID_Warn, 'AeroDyn was designed for an explicit-loose coupling scheme. '//& - 'Using last calculated values from AeroDyn on all subsequent calls until time is advanced. '//& - 'Warning will not be displayed again.', ErrStat,ErrMess,'AD14_CalcOutput' ) - m%FirstWarn = .FALSE. - IF (ErrStat >= AbortErrLev) THEN - CALL CleanUp() - RETURN - END IF - END IF - - RETURN - - ENDIF - - - !------------------------------------------------------------------------------------------------- - ! Calculate the forces and moments for the blade: SUBROUTINE AeroFrcIntrface( FirstLoop, JElemt, DFN, DFT, PMA ) - !------------------------------------------------------------------------------------------------- - - ! calculate rotor speed - ! note: Subtracting the RotorFurl rotational velocity for REVS is needed to get the - ! same answers as before v13.00.00. RotorFurl shouldn't be needed. - - m%Rotor%REVS = ABS( DOT_PRODUCT( u%TurbineComponents%Hub%RotationVel(:) - u%TurbineComponents%RotorFurl%RotationVel(:), & - u%TurbineComponents%Hub%Orientation(1,:) ) ) - - - ! calculate yaw angle - ! note: YawAng should use the Hub instead of the RotorFurl, but it is calculated this way to - ! get the same answers as previous version. - m%Rotor%YawAng = ATAN2( -1.*u%TurbineComponents%RotorFurl%Orientation(1,2), u%TurbineComponents%RotorFurl%Orientation(1,1) ) - m%Rotor%SYaw = SIN( m%Rotor%YawAng ) - m%Rotor%CYaw = COS( m%Rotor%YawAng ) - - ! tilt angle - ! note: tilt angle should use the Hub instead of RotorFurl, but it needs hub to get the same - ! answers as the version before v13.00.00 - - m%Rotor%Tilt = ATAN2( u%TurbineComponents%RotorFurl%Orientation(1,3), & - SQRT( u%TurbineComponents%RotorFurl%Orientation(1,1)**2 + & - u%TurbineComponents%RotorFurl%Orientation(1,2)**2 ) ) - - m%Rotor%CTilt = COS( m%Rotor%Tilt ) - m%Rotor%STilt = SIN( m%Rotor%Tilt ) - - - ! HubVDue2Yaw - yaw velocity due solely to yaw - - AvgVelNacelleRotorFurlYaw = u%TurbineComponents%RotorFurl%RotationVel(3) - u%TurbineComponents%Nacelle%RotationVel(3) - AvgVelTowerBaseNacelleYaw = u%TurbineComponents%Nacelle%RotationVel(3) - u%TurbineComponents%Tower%RotationVel(3) - AvgVelTowerBaseYaw = u%TurbineComponents%Tower%RotationVel(3) - - rRotorFurlHub(1:2) = u%TurbineComponents%Hub%Position(1:2) - u%TurbineComponents%RotorFurl%Position(1:2) - rNacelleHub(1:2) = u%TurbineComponents%Hub%Position(1:2) - u%TurbineComponents%Nacelle%Position(1:2) - rTowerBaseHub(1:2) = u%TurbineComponents%Hub%Position(1:2) - u%TurbineComponents%Tower%Position(1:2) - - m%Rotor%YawVel = ( AvgVelNacelleRotorFurlYaw * rRotorFurlHub(2) + AvgVelTowerBaseNacelleYaw * rNacelleHub(2) & - + AvgVelTowerBaseYaw * rTowerBaseHub(2) ) * m%Rotor%SYaw & - - ( AvgVelNacelleRotorFurlYaw * rRotorFurlHub(1) + AvgVelTowerBaseNacelleYaw * rNacelleHub(1) & - + AvgVelTowerBaseYaw * rTowerBaseHub(1) ) * m%Rotor%CYaw - - - !................................................................................................. - ! start of NewTime routine - !................................................................................................. - - m%Rotor%AvgInfl = m%InducedVel%SumInfl * 2.0 / (p%Blade%R*p%Blade%R*p%NumBl) ! Average inflow from the previous time step - m%InducedVel%SumInfl = 0.0 ! reset to sum for the current time step - - CALL DiskVel(Time, P, m, u%AvgInfVel, ErrStatLcl, ErrMessLcl) ! Get a sort of "Average velocity" - sets a bunch of stored variables... - CALL SetErrStat ( ErrStatLcl, ErrMessLcl, ErrStat,ErrMess,'AD14_CalcOutput/DiskVel' ) - IF (ErrStat >= AbortErrLev) THEN - CALL CleanUp() - RETURN - END IF - - IF ( P%DStall ) CALL BedUpdate( m ) - - ! Enter the dynamic inflow routines here - - IF ( p%Wake ) THEN - CALL Inflow(Time, P, m, ErrStatLcl, ErrMessLcl) - CALL SetErrStat ( ErrStatLcl, ErrMessLcl, ErrStat,ErrMess,'AD14_CalcOutput/Inflow' ) - IF (ErrStat >= AbortErrLev) THEN - CALL CleanUp() - RETURN - END IF - END IF - - !bjj: perhaps we should send NoLoadsCalculated to initialize dynamic inflow [subroutine Infinit()] - !bjj: instead of the check that time > 0...? - - !................................................................................................. - ! end of NewTime routine - !................................................................................................. - - ! Set blade element pitches - DO IBlade = 1,p%NumBl - DO IElement = 1,p%Element%NElm - ! calculate element pitch - m%Element%PitNow(IElement,IBlade) = -1.*ATAN2( -1.*DOT_PRODUCT( u%TurbineComponents%Blade(IBlade)%Orientation(1,:), & - u%InputMarkers(IBlade)%Orientation(2,:,IElement) ) , & - DOT_PRODUCT( u%TurbineComponents%Blade(IBlade)%Orientation(1,:), & - u%InputMarkers(IBlade)%Orientation(1,:,IElement) ) ) - ENDDO - ENDDO - - - Node = 0 - ! --- Loop on blades - DO IBlade = 1,p%NumBl - - ! calculate the azimuth angle ( we add pi because AeroDyn defines 0 as pointing downward) - ! note: the equation below should use TurbineComponents%Blade markers, but this is used to get the - ! same answers as the previous version (before v13.00.00) - - AzimuthAngle = ATAN2( -1.*DOT_PRODUCT( u%TurbineComponents%Hub%Orientation(3,:), & - u%TurbineComponents%RotorFurl%Orientation(2,:) ), & - DOT_PRODUCT( u%TurbineComponents%Hub%Orientation(3,:), & - u%TurbineComponents%RotorFurl%Orientation(3,:) ) ) + pi + (IBlade - 1)*p%TwoPiNB - ! --- Loop on elements - DO IElement = 1,p%Element%NElm - - SPitch = SIN( m%Element%PitNow(IElement,IBlade) ) - CPitch = COS( m%Element%PitNow(IElement,IBlade) ) - - ! calculate distance between hub and element - tmpVector = u%InputMarkers(IBlade)%Position(:,IElement) - u%TurbineComponents%Hub%Position(:) - rLocal = SQRT( DOT_PRODUCT( tmpVector, u%TurbineComponents%Hub%Orientation(2,:) )**2 & - + DOT_PRODUCT( tmpVector, u%TurbineComponents%Hub%Orientation(3,:) )**2 ) - - ! determine if MulTabLoc should be set. - - IF (.not. p%Reynolds) m%AirFoil%MulTabLoc = u%MulTabLoc(IElement,IBlade) - - !------------------------------------------------------------------------------------------- - ! Get wind velocity components; calculate velocity normal to the rotor squared - ! Save variables for printing in a file later; - !------------------------------------------------------------------------------------------- - Node = Node + 1 - VelocityVec(:) = AD_WindVelocityWithDisturbance( Time, u, p, x, xd, z, m, y, ErrStatLcl, ErrMessLcl, & - u%InputMarkers(IBlade)%Position(:,IElement), & - u%InflowVelocity(:,Node) ) - CALL SetErrStat ( ErrStatLcl, ErrMessLcl, ErrStat,ErrMess,'AD14_CalcOutput' ) - IF (ErrStat >= AbortErrLev) THEN - CALL CleanUp() - RETURN - END IF - - !------------------------------------------------------------------------------------------- - ! DWM wind input update phase 1 - !------------------------------------------------------------------------------------------- - IF (p%UseDWM) THEN - !bjj: FIX THIS!!!! - !bjj: where do p%DWM%RTPD%SimulationOrder_index and p%DWM%RTPD%upwindturbine_number get set? - - IF ( p%DWM%RTPD%SimulationOrder_index > 1) THEN - IF( p%DWM%RTPD%upwindturbine_number /= 0 ) THEN - - m%DWM%position_y = u%InputMarkers(IBlade)%Position(2,IElement) - - m%DWM%position_z = u%InputMarkers(IBlade)%Position(3,IElement) - - m%DWM%velocity_wake_mean = 1 - - DO I = 1,p%DWM%RTPD%upwindturbine_number - m%DWM%DWM_tb%Aerodyn_turbine_num = I - - CALL DWM_phase1( Time, m%DWM_Inputs, p%DWM, x%DWM, xd%DWM, z%DWM, & - O%DWM, m%DWM_Outputs, m%DWM, ErrStatLcl, ErrMessLcl ) - - CALL SetErrStat ( ErrStatLcl, ErrMessLcl, ErrStat,ErrMess,'AD14_CalcOutput/DWM_phase1' ) - IF (ErrStat >= AbortErrLev) THEN - CALL CleanUp() - RETURN - END IF - - m%DWM%velocity_wake_mean = (1-((1-m%DWM%velocity_wake_mean)**2 + (1-m%DWM%shifted_velocity_aerodyn)**2)**0.5) - END DO - - m%DWM%velocity_wake_mean = m%DWM%velocity_wake_mean * p%DWM%Wind_file_Mean_u - - VelocityVec(1) = (VelocityVec(1) - p%DWM%Wind_file_Mean_u)*(m%DWM_Inputs%Upwind_result%upwind_small_TI(1)/p%DWM%TI_amb) & - + m%DWM%velocity_wake_mean - - END IF - END IF - - !------------------------DWM PHASE 2----------------------------------------------- - IF (Time > 50.00 ) THEN - m%DWM%U_velocity = VelocityVec(1) - m%DWM%V_velocity = VelocityVec(2) - m%DWM%NacYaw = m%Rotor%YawAng - m%DWM%DWM_tb%Blade_index = IBlade - m%DWM%DWM_tb%Element_index = IElement - - CALL DWM_phase2( Time, m%DWM_Inputs, p%DWM, x%DWM, xd%DWM, z%DWM, O%DWM, m%DWM_Outputs, m%DWM, ErrStatLcl, ErrMessLcl ) - - CALL SetErrStat ( ErrStatLcl, ErrMessLcl, ErrStat,ErrMess,'AD14_CalcOutput/DWM_phase1' ) - IF (ErrStat >= AbortErrLev) THEN - CALL CleanUp() - RETURN - END IF - - - !CALL CalVelScale(VelocityVec(1),VelocityVec(2),m%DWM_Outputs,z%DWM) - - !CALL turbine_average_velocity( VelocityVec(1), IBlade, IElement, m%DWM_Outputs,x%DWM,z%DWM) - END IF - END IF ! UseDWM - - !----------------------------------------------------------------------------------------------------------------------- - - ! NOTE: VelocityVec is freestream with disturbances from Tower Shadow and Wakes (DWM) - VelNormalToRotor2 = ( VelocityVec(3) * m%Rotor%STilt + (VelocityVec(1) * m%Rotor%CYaw & - - VelocityVec(2) * m%Rotor%SYaw) * m%Rotor%CTilt )**2 - - !------------------------------------------------------------------------------------------- - ! Normal and tangential velocities from wind and relative blade motion - !------------------------------------------------------------------------------------------- - tang_Vector = - SPitch*u%InputMarkers(IBlade)%Orientation(1,:,IElement) & - & + CPitch*u%InputMarkers(IBlade)%Orientation(2,:,IElement) - norm_Vector = CPitch*u%InputMarkers(IBlade)%Orientation(1,:,IElement) & - & + SPitch*u%InputMarkers(IBlade)%Orientation(2,:,IElement) - - VTTotal = DOT_PRODUCT( tang_Vector, VelocityVec - u%InputMarkers(IBlade)%TranslationVel(:,IElement) ) - VTElement = - DOT_PRODUCT( tang_Vector, u%InputMarkers(IBlade)%TranslationVel(:,IElement) ) - VNElement = - DOT_PRODUCT( norm_Vector, u%InputMarkers(IBlade)%TranslationVel(:,IElement ) ) - - VTWind = DOT_PRODUCT( tang_Vector, VelocityVec) - VNWind = DOT_PRODUCT( norm_Vector, VelocityVec) - - !------------------------------------------------------------------------------------------- - ! Get blade element forces and induced velocity - !------------------------------------------------------------------------------------------- - ! --------------------------------------------------------------------------------} - ! --- Setting Element% values: W2, Alpha, A, AP - ! --------------------------------------------------------------------------------{ - ! --- BEM - CALL ELEM_INDUCTIONS( p, m, ErrStatLcl, ErrMessLcl, & - AzimuthAngle, rLocal, IElement, IBlade, VelNormalToRotor2, VTTotal, VNWind, & - VNElement, m%NoLoadsCalculated) - ! Normal and tangential induced velocities - VN_ind = - VNWind * m%Element%A (IElement, IBLADE) - VT_ind = VTTotal * m%Element%AP(IElement, IBLADE) - - ! Cumulative (integrated) induction over the blades - m%InducedVel%SumInfl = m%InducedVel%SumInfl - VN_IND * RLOCAL * p%Blade%DR(IElement) - - ! --- Total flow velocity at the blade element - VN = VN_IND + VNWind + VNElement ! Normal velocity : Indution + Wind + Rel. blade vel - VT = VT_IND + VTTotal ! Tangential velocity : Indution + (Wind + Rel. blade vel) - - PHI = ATAN2( VN, VT) ! Flow angle [rad] - m%Element%ALPHA(IElement,IBlade) = PHI - m%Element%PitNow(IElement,IBlade) ! Angle of attack [rad] - CALL MPI2PI ( m%Element%ALPHA(IElement,IBlade) ) - m%Element%W2(IElement,IBlade) = VN * VN + VT * VT ! Relative velocity norm - - CALL ELEMFRC2( p, m, ErrStatLcl, ErrMessLcl, IElement, IBlade, & - DFN, DFT, PMA, m%NoLoadsCalculated, phi ) - CALL SetErrStat ( ErrStatLcl, ErrMessLcl, ErrStat,ErrMess,'AD14_CalcOutput' ) - IF (ErrStat >= AbortErrLev) THEN - CALL CleanUp() - RETURN - END IF - - !------------------------------------------------------------------------------------------- - ! Set up dynamic inflow parameters - !------------------------------------------------------------------------------------------- - IF ( p%DynInfl .OR. m%DynInit ) THEN - CALL GetRM (P, m, ErrStatLcl, ErrMessLcl, & - rLocal, DFN, DFT, AzimuthAngle, IElement, IBlade) - CALL SetErrStat ( ErrStatLcl, ErrMessLcl, ErrStat,ErrMess,'AD14_CalcOutput' ) - IF (ErrStat >= AbortErrLev) THEN - CALL CleanUp() - RETURN - END IF - - ENDIF - - IF (p%UseDWM) THEN - m%DWM%Nforce(IElement,IBlade) = DFN ! 12.4.2014 add by yh - END IF ! UseDWM - - m%StoredForces(1,IElement,IBlade) = ( DFN*CPitch + DFT*SPitch ) / p%Blade%DR(IElement) - m%StoredForces(2,IElement,IBlade) = ( DFN*SPitch - DFT*CPitch ) / p%Blade%DR(IElement) - m%StoredForces(3,IElement,IBlade) = 0.0 - - m%StoredMoments(1,IElement,IBlade) = 0.0 - m%StoredMoments(2,IElement,IBlade) = 0.0 - m%StoredMoments(3,IElement,IBlade) = PMA / p%Blade%DR(IElement) - -! DO IBlade=1,p%NumBl -! DO IElement=1,p%Element%Nelm -! y%OutputLoads(IBlade)%Force(:,IElement) = m%StoredForces(:,IElement,IBlade) -! y%OutputLoads(IBlade)%Moment(:,IElement) = m%StoredMoments(:,IElement,IBlade) -! ENDDO -!! ENDDO - - ! save velocities for output, if requested - - IF ( m%ElOut%WndElPrList(IElement) > 0 ) THEN - m%ElOut%SaveVX( m%ElOut%WndElPrList(IElement), IBlade ) = VelocityVec(1) - m%ElOut%SaveVY( m%ElOut%WndElPrList(IElement), IBlade ) = VelocityVec(2) - m%ElOut%SaveVZ( m%ElOut%WndElPrList(IElement), IBlade ) = VelocityVec(3) - ENDIF - - - END DO !IElement - - IF ( IBlade == 1 .AND. p%ElemPrn ) THEN - m%ElOut%VXSAV = VelocityVec(1) - m%ElOut%VYSAV = VelocityVec(2) - m%ElOut%VZSAV = VelocityVec(3) - ENDIF - - - END DO !IBlade - - m%NoLoadsCalculated = .FALSE. - - DO IBlade=1,p%NumBl - DO IElement=1,p%Element%Nelm - y%OutputLoads(IBlade)%Force(:,IElement) = m%StoredForces(:,IElement,IBlade) - y%OutputLoads(IBlade)%Moment(:,IElement) = m%StoredMoments(:,IElement,IBlade) - ENDDO - ENDDO - - - !------------------------DWM PHASE 3----------------------------------------------- - IF (p%UseDWM) THEN - - IF (Time > 50.00 ) THEN !BJJ: why is 50 hard-coded here and above??? - - !m%DWM%Nforce(:,:) = m%DWM%DFN_DWM(:,:) - CALL DWM_phase3( Time, m%DWM_Inputs, p%DWM, x%DWM, xd%DWM, z%DWM, O%DWM, m%DWM_Outputs, m%DWM, ErrStatLcl, ErrMessLcl ) - - CALL SetErrStat ( ErrStatLcl, ErrMessLcl, ErrStat,ErrMess,'AD14_CalcOutput/DWM_phase3' ) - IF (ErrStat >= AbortErrLev) THEN - CALL CleanUp() - RETURN - END IF - - !CALL filter_average_induction_factor( AD14_ParameterType, DWM_ConstraintStateType, m%DWM_Outputs ) - END IF - END IF !UseDWM - - !----------------------------------------------------------------------------------- - - - - - - - ! Loop through all the tower nodes to calculate the aerodynamic loads on the tower if aerodynamics were requested. - - IF ( p%TwrProps%CalcTwrAero ) THEN - - DO Node=1,u%Twr_InputMarkers%Nnodes - - - ! Calculate the aerodynamic load on this tower node: TwrAeroLoads ( p, Node, NodeDCMGbl, NodeVelGbl, NodeWindVelGbl, NodeFrcGbl ) - - CALL TwrAeroLoads ( p, Node, u%Twr_InputMarkers%Orientation(:,:,Node), u%Twr_InputMarkers%TranslationVel(:,Node) & - , u%InflowVelocity(:,Node+p%NumBl*p%Element%NElm), y%Twr_OutputLoads%Force(:,Node) ) - - END DO ! Node - - END IF ! ( p%TwrProps%CalcTwrAero ) - - !................................................................................................ - - - CALL ElemOut(time, P, m ) - - CALL CleanUp ( ) - - RETURN - - !======================================================================= - CONTAINS - !======================================================================= - SUBROUTINE CleanUp ( ) - - - ! This subroutine cleans up the parent routine before exiting. - - - ! ! Deallocate the IfW_Inputs%Position array if it had been allocated. - ! - !CALL IfW_DestroyInput( IfW_Inputs, ErrStatLcl, ErrMessLcl ) - - - RETURN - - END SUBROUTINE CleanUp - - -END SUBROUTINE AD14_CalcOutput - -!---------------------------------------------------------------------------------------------------------------------------------- -END MODULE AeroDyn14 -!********************************************************************************************************************************** - diff --git a/modules/aerodyn14/src/AeroDyn14_Types.f90 b/modules/aerodyn14/src/AeroDyn14_Types.f90 deleted file mode 100644 index 51041bf082..0000000000 --- a/modules/aerodyn14/src/AeroDyn14_Types.f90 +++ /dev/null @@ -1,17305 +0,0 @@ -!STARTOFREGISTRYGENERATEDFILE 'AeroDyn14_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 -!********************************************************************************************************************************* -! AeroDyn14_Types -!................................................................................................................................. -! This file is part of AeroDyn14. -! -! 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 AeroDyn14. 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 AeroDyn14_Types -!--------------------------------------------------------------------------------------------------------------------------------- -USE DWM_Types -USE NWTC_Library -IMPLICIT NONE -! ========= Marker ======= - TYPE, PUBLIC :: Marker - REAL(ReKi) , DIMENSION(1:3) :: Position - REAL(ReKi) , DIMENSION(1:3,1:3) :: Orientation - REAL(ReKi) , DIMENSION(1:3) :: TranslationVel - REAL(ReKi) , DIMENSION(1:3) :: RotationVel - END TYPE Marker -! ======================= -! ========= AeroConfig ======= - TYPE, PUBLIC :: AeroConfig - TYPE(Marker) , DIMENSION(:), ALLOCATABLE :: Blade - TYPE(Marker) :: Hub - TYPE(Marker) :: RotorFurl - TYPE(Marker) :: Nacelle - TYPE(Marker) :: TailFin - TYPE(Marker) :: Tower - TYPE(Marker) :: SubStructure - TYPE(Marker) :: Foundation - REAL(ReKi) :: BladeLength - END TYPE AeroConfig -! ======================= -! ========= AirFoil ======= - TYPE, PUBLIC :: AirFoil - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: AL - REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: CD - REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: CL - REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: CM - REAL(ReKi) :: PMC - REAL(ReKi) :: MulTabLoc - END TYPE AirFoil -! ======================= -! ========= AirFoilParms ======= - TYPE, PUBLIC :: AirFoilParms - INTEGER(IntKi) :: MaxTable = 20 - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: NTables - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: NLift - INTEGER(IntKi) :: NumCL - INTEGER(IntKi) :: NumFoil - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: NFoil - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: MulTabMet - CHARACTER(1024) , DIMENSION(:), ALLOCATABLE :: FoilNm - END TYPE AirFoilParms -! ======================= -! ========= Beddoes ======= - TYPE, PUBLIC :: Beddoes - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: ADOT - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: ADOT1 - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: AFE - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: AFE1 - REAL(ReKi) :: AN - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: ANE - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: ANE1 - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: AOD - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: AOL - LOGICAL , DIMENSION(:,:), ALLOCATABLE :: BEDSEP - LOGICAL , DIMENSION(:,:), ALLOCATABLE :: OLDSEP - REAL(ReKi) :: CC - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: CDO - REAL(ReKi) :: CMI - REAL(ReKi) :: CMQ - REAL(ReKi) :: CN - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: CNA - REAL(ReKi) :: CNCP - REAL(ReKi) :: CNIQ - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: CNP - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: CNP1 - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: CNPD - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: CNPD1 - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: CNPOT - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: CNPOT1 - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: CNS - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: CNSL - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: CNV - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: CVN - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: CVN1 - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: DF - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: DFAFE - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: DFAFE1 - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: DFC - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: DN - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: DPP - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: DQ - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: DQP - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: DQP1 - REAL(ReKi) :: DS - REAL(ReKi) :: FK - REAL(ReKi) :: FP - REAL(ReKi) :: FPC - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: FSP - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: FSP1 - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: FSPC - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: FSPC1 - REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: FTB - REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: FTBC - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: OLDCNV - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: OLDDF - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: OLDDFC - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: OLDDN - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: OLDDPP - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: OLDDQ - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: OLDTAU - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: OLDXN - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: OLDYN - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: QX - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: QX1 - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: TAU - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: XN - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: YN - LOGICAL :: SHIFT - LOGICAL :: VOR - END TYPE Beddoes -! ======================= -! ========= BeddoesParms ======= - TYPE, PUBLIC :: BeddoesParms - REAL(ReKi) :: AS !< Speed of sound for mach num calc [-] - REAL(ReKi) :: TF !< Time constant applied to loc of separation pt [-] - REAL(ReKi) :: TP !< Time constant for pressure lag [-] - REAL(ReKi) :: TV !< Time constant for strength and shed of vortex [-] - REAL(ReKi) :: TVL !< Nondim time of transit of vort moving across airfoil surf [-] - END TYPE BeddoesParms -! ======================= -! ========= BladeParms ======= - TYPE, PUBLIC :: BladeParms - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: C !< Chord of each blade element from input file [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: DR !< Span-wise width of elem (len of elem ctred at RELM(i) [-] - REAL(ReKi) :: R !< Rotor radius [-] - REAL(ReKi) :: BladeLength !< Blade Length [-] - END TYPE BladeParms -! ======================= -! ========= DynInflow ======= - TYPE, PUBLIC :: DynInflow - REAL(ReKi) , DIMENSION(1:6,1:4) :: dAlph_dt - REAL(ReKi) , DIMENSION(3:6,1:4) :: dBeta_dt - REAL(ReKi) :: DTO - REAL(ReKi) , DIMENSION(1:6) :: old_Alph - REAL(ReKi) , DIMENSION(3:6) :: old_Beta - REAL(ReKi) :: old_LmdM - REAL(ReKi) :: oldKai - REAL(ReKi) , DIMENSION(1:6) :: PhiLqC - REAL(ReKi) , DIMENSION(3:6) :: PhiLqS - REAL(ReKi) :: Pzero - REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: RMC_SAVE - REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: RMS_SAVE - REAL(ReKi) :: TipSpeed - REAL(ReKi) :: totalInf - REAL(ReKi) :: Vparam - REAL(ReKi) :: Vtotal - REAL(ReKi) , DIMENSION(1:6) :: xAlpha - REAL(ReKi) , DIMENSION(3:6) :: xBeta - REAL(ReKi) :: xKai - REAL(ReKi) :: XLAMBDA_M - REAL(ReKi) , DIMENSION(1:6,1:6) :: xLcos - REAL(ReKi) , DIMENSION(3:6,3:6) :: xLsin - INTEGER(IntKi) , DIMENSION(1:6,1:6) :: MminR - INTEGER(IntKi) , DIMENSION(1:6,1:6) :: MminusR - INTEGER(IntKi) , DIMENSION(1:6,1:6) :: MplusR - REAL(ReKi) , DIMENSION(1:6,1:6) :: GAMMA - END TYPE DynInflow -! ======================= -! ========= DynInflowParms ======= - TYPE, PUBLIC :: DynInflowParms - INTEGER(IntKi) :: MAXINFLO = 2 - REAL(ReKi) , DIMENSION(1:6) :: xMinv - END TYPE DynInflowParms -! ======================= -! ========= Element ======= - TYPE, PUBLIC :: Element - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: A !< - [Axial induction factor] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: AP !< - [Tangential induction factor] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: ALPHA !< - [Angle of attack] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: W2 !< - [Relative velocity norm ] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: OLD_A_NS - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: OLD_AP_NS - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PITNOW !< - [Current pitch angle - Based on blade orientation (to verify)] - END TYPE Element -! ======================= -! ========= ElementParms ======= - TYPE, PUBLIC :: ElementParms - INTEGER(IntKi) :: NELM !< - [Number of elements (constant)] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TWIST !< - [Airfoil twist angle (constant)] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: RELM !< - [Radius of element (constant)] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: HLCNST !< - [Hub loss constant B/2*(r-rh)/rh (constant)] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TLCNST !< - [Tip loss constant B/2*(R-r)/R (constant) ] - END TYPE ElementParms -! ======================= -! ========= ElOutParms ======= - TYPE, PUBLIC :: ElOutParms - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: AAA - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: AAP - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: ALF - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: CDD - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: CLL - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: CMM - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: CNN - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: CTT - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: DFNSAV - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: DFTSAV - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: DynPres - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: PMM - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: PITSAV - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: ReyNum - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Gamma !< - [Circulation along the span, 1/2 c Vrel Cl] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: SaveVX - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: SaveVY - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: SaveVZ - REAL(ReKi) :: VXSAV - REAL(ReKi) :: VYSAV - REAL(ReKi) :: VZSAV - INTEGER(IntKi) :: NumWndElOut !< Number of Blade Elements [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: WndElPrList - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: WndElPrNum - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: ElPrList - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: ElPrNum - INTEGER(IntKi) :: NumElOut !< Number of Blade Elements [-] - END TYPE ElOutParms -! ======================= -! ========= InducedVel ======= - TYPE, PUBLIC :: InducedVel - REAL(ReKi) :: SumInFl = 0 - END TYPE InducedVel -! ======================= -! ========= InducedVelParms ======= - TYPE, PUBLIC :: InducedVelParms - REAL(ReKi) :: AToler !< Convergence tolerance for induction factor [-] - REAL(ReKi) :: EqAIDmult !< Multiplier for drag term in axial-induction equation. [-] - LOGICAL :: EquilDA !< False unless DB or DA appended to EQUIL [-] - LOGICAL :: EquilDT !< False unless DB or DT appended to EQUIL [-] - LOGICAL :: TLoss !< Tip-loss model (EQUIL only) [PRANDtl, GTECH, or NONE] [-] - LOGICAL :: GTech !< Tip-loss model (EQUIL only) [PRANDtl, GTECH, or NONE] [-] - LOGICAL :: HLoss !< Hub-loss model (EQUIL only) [PRANDtl or NONE] [-] - END TYPE InducedVelParms -! ======================= -! ========= Rotor ======= - TYPE, PUBLIC :: Rotor - REAL(ReKi) :: AVGINFL !< average induced velocity at the previous time [-] - REAL(ReKi) :: CTILT - REAL(ReKi) :: CYaw - REAL(ReKi) :: REVS - REAL(ReKi) :: STILT - REAL(ReKi) :: SYaw - REAL(ReKi) :: TILT - REAL(ReKi) :: YawAng - REAL(ReKi) :: YawVEL - END TYPE Rotor -! ======================= -! ========= RotorParms ======= - TYPE, PUBLIC :: RotorParms - REAL(ReKi) :: HH - END TYPE RotorParms -! ======================= -! ========= TwrPropsParms ======= - TYPE, PUBLIC :: TwrPropsParms - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TwrHtFr - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TwrWid - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: TwrCD - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TwrRe - REAL(ReKi) , DIMENSION(1:3) :: VTwr - REAL(ReKi) :: Tower_Wake_Constant - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: NTwrCDCol !< The tower CD column that represents a particular twr ht [-] - INTEGER(IntKi) :: NTwrHT !< The number of tower height rows in the table [-] - INTEGER(IntKi) :: NTwrRe !< The number of tower Re entry rows in the table [-] - INTEGER(IntKi) :: NTwrCD !< The number of tower CD columns in the table [-] - LOGICAL :: TwrPotent !< Tower influence model [-] - LOGICAL :: TwrShadow !< Tower shadow model [-] - REAL(ReKi) :: ShadHWid !< Tower-shadow half width [m] - REAL(ReKi) :: TShadC1 !< Tower-shadow constant [-] - REAL(ReKi) :: TShadC2 !< Tower-shadow constant [-] - REAL(ReKi) :: TwrShad !< Tower-shadow velocity deficit [-] - LOGICAL :: PJM_Version !< Only true if new tower influence model, by PJM [-] - CHARACTER(1024) :: TwrFile !< Tower data file name [-] - REAL(ReKi) :: T_Shad_Refpt !< Tower-shadow reference point [m] - LOGICAL :: CalcTwrAero !< Flag to tell AeroDyn to calculate drag on the tower [m] - INTEGER(IntKi) :: NumTwrNodes !< Number of ElastoDyn tower nodes. Tower drag will be computed at those points. [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TwrNodeWidth !< The width (diameter) of the tower at the ElastoDyn node locations. [-] - END TYPE TwrPropsParms -! ======================= -! ========= Wind ======= - TYPE, PUBLIC :: Wind - REAL(ReKi) :: ANGFLW - REAL(ReKi) :: CDEL - REAL(ReKi) :: VROTORX - REAL(ReKi) :: VROTORY - REAL(ReKi) :: VROTORZ - REAL(ReKi) :: SDEL - END TYPE Wind -! ======================= -! ========= WindParms ======= - TYPE, PUBLIC :: WindParms - REAL(ReKi) :: Rho !< Air density [kg/m^3] - REAL(ReKi) :: KinVisc !< Kinematic air viscosity [(m^2/sec)] - END TYPE WindParms -! ======================= -! ========= PositionType ======= - TYPE, PUBLIC :: PositionType - REAL(ReKi) , DIMENSION(1:3) :: Pos !< X,Y,Z coordinate of a point [-] - END TYPE PositionType -! ======================= -! ========= OrientationType ======= - TYPE, PUBLIC :: OrientationType - REAL(ReKi) , DIMENSION(1:3,1:3) :: Orient !< Direction Cosine Matrix [-] - END TYPE OrientationType -! ======================= -! ========= AD14_InitInputType ======= - TYPE, PUBLIC :: AD14_InitInputType - CHARACTER(1024) :: Title !< Title [-] - CHARACTER(1024) :: OutRootName - CHARACTER(1024) :: ADFileName !< AeroDyn file name [-] - LOGICAL :: WrSumFile !< T/F: Write an AeroDyn summary [-] - INTEGER(IntKi) :: NumBl !< Number of Blades [-] - REAL(ReKi) :: BladeLength !< Blade Length [-] - LOGICAL :: LinearizeFlag - LOGICAL :: UseDWM = .FALSE. !< flag to determine if DWM module should be used [-] - TYPE(AeroConfig) :: TurbineComponents - INTEGER(IntKi) :: NumTwrNodes !< Number of ElastoDyn tower nodes. Tower drag will be computed at those points. [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: TwrNodeLocs !< Location of ElastoDyn tower nodes with respect to the inertial origin. [-] - REAL(ReKi) :: HubHt !< hub height wrt inertial origin [m] - TYPE(DWM_InitInputType) :: DWM - END TYPE AD14_InitInputType -! ======================= -! ========= AD14_InitOutputType ======= - TYPE, PUBLIC :: AD14_InitOutputType - TYPE(ProgDesc) :: Ver !< version information [-] - TYPE(DWM_InitOutputType) :: DWM - REAL(ReKi) :: AirDens !< Air density [kg/m^3] - END TYPE AD14_InitOutputType -! ======================= -! ========= AD14_ContinuousStateType ======= - TYPE, PUBLIC :: AD14_ContinuousStateType - TYPE(DWM_ContinuousStateType) :: DWM - END TYPE AD14_ContinuousStateType -! ======================= -! ========= AD14_DiscreteStateType ======= - TYPE, PUBLIC :: AD14_DiscreteStateType - TYPE(DWM_DiscreteStateType) :: DWM - END TYPE AD14_DiscreteStateType -! ======================= -! ========= AD14_ConstraintStateType ======= - TYPE, PUBLIC :: AD14_ConstraintStateType - TYPE(DWM_ConstraintStateType) :: DWM - END TYPE AD14_ConstraintStateType -! ======================= -! ========= AD14_OtherStateType ======= - TYPE, PUBLIC :: AD14_OtherStateType - TYPE(DWM_OtherStateType) :: DWM !< variables for DWM module [-] - END TYPE AD14_OtherStateType -! ======================= -! ========= AD14_MiscVarType ======= - TYPE, PUBLIC :: AD14_MiscVarType - TYPE(DWM_MiscVarType) :: DWM !< variables for DWM module [-] - TYPE(DWM_InputType) :: DWM_Inputs - TYPE(DWM_OutputType) :: DWM_Outputs - REAL(DbKi) :: DT !< actual Time step [seconds] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: ElPrNum - REAL(DbKi) :: OldTime - REAL(ReKi) :: HubLoss = 1 - REAL(ReKi) :: Loss = 1 - REAL(ReKi) :: TipLoss = 1 - REAL(ReKi) :: TLpt7 - LOGICAL :: FirstPassGTL = .TRUE. - LOGICAL :: SuperSonic = .FALSE. - LOGICAL :: AFLAGVinderr = .FALSE. - LOGICAL :: AFLAGTwrInflu = .FALSE. - LOGICAL :: OnePassDynDbg = .TRUE. - LOGICAL :: NoLoadsCalculated = .TRUE. - INTEGER(IntKi) :: NERRORS = 0 - TYPE(AirFoil) :: AirFoil - TYPE(Beddoes) :: Beddoes - TYPE(DynInflow) :: DynInflow - TYPE(Element) :: Element - TYPE(Rotor) :: Rotor - TYPE(Wind) :: Wind - TYPE(InducedVel) :: InducedVel - TYPE(ElOutParms) :: ElOut - LOGICAL :: Skew - LOGICAL :: DynInit !< FALSE=EQUIL, TRUE=DYNIN [-] - LOGICAL :: FirstWarn !< If it's the first warning about AeroDyn not recalculating loads [-] - REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: StoredForces - REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: StoredMoments - END TYPE AD14_MiscVarType -! ======================= -! ========= AD14_ParameterType ======= - TYPE, PUBLIC :: AD14_ParameterType - CHARACTER(1024) :: Title !< Title [-] - LOGICAL :: SIUnit - LOGICAL :: Echo = .FALSE. - LOGICAL :: MultiTab - LOGICAL :: LinearizeFlag - LOGICAL :: OutputPlottingInfo = .FALSE. - LOGICAL :: UseDWM = .FALSE. !< flag to determine if DWM module should be used [-] - REAL(ReKi) :: TwoPiNB !< 2*pi/num of blades [-] - INTEGER(IntKi) :: NumBl !< Number of Blades [-] - INTEGER(IntKi) :: NBlInpSt !< Number of Blade Input Stations [-] - LOGICAL :: ElemPrn - LOGICAL :: DStall !< FALSE=Steady, TRUE=BEDDOES [-] - LOGICAL :: PMoment !< FALSE=NO_CM, TRUE=USE_CM [-] - LOGICAL :: Reynolds - LOGICAL :: DynInfl !< FALSE=EQUIL, TRUE=DYNIN [-] - LOGICAL :: Wake !< False unless WAKE or SWIRL [-] - LOGICAL :: Swirl !< False unless WAKE or SWIRL [-] - REAL(DbKi) :: DtAero !< Time interval for aerodynamic calculations [-] - REAL(ReKi) :: HubRad !< Hub radius [m] - INTEGER(IntKi) :: UnEc = -1 - INTEGER(IntKi) :: UnElem = -1 - INTEGER(IntKi) :: UnWndOut = -1 - INTEGER(IntKi) :: MAXICOUNT = 1000 - LOGICAL :: WrOptFile = .TRUE. !< T/F: Write an AeroDyn summary [-] - INTEGER(IntKi) :: DEFAULT_Wind = -1 - TYPE(AirFoilParms) :: AirFoil - TYPE(BladeParms) :: Blade - TYPE(BeddoesParms) :: Beddoes - TYPE(DynInflowParms) :: DynInflow - TYPE(ElementParms) :: Element - TYPE(TwrPropsParms) :: TwrProps - TYPE(InducedVelParms) :: InducedVel - TYPE(WindParms) :: Wind - TYPE(RotorParms) :: Rotor - TYPE(DWM_ParameterType) :: DWM - END TYPE AD14_ParameterType -! ======================= -! ========= AD14_InputType ======= - TYPE, PUBLIC :: AD14_InputType - TYPE(MeshType) , DIMENSION(:), ALLOCATABLE :: InputMarkers !< Input Forces and positions for the blades (mesh) for each blade [-] - TYPE(MeshType) :: Twr_InputMarkers !< Input Forces and positions for the tower (mesh) [-] - TYPE(AeroConfig) :: TurbineComponents !< Current locations of components [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: MulTabLoc - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: InflowVelocity !< U,V,W wind inflow speeds at all locations on the Inputmarker and Twr_InputMarker meshes [m/s] - REAL(ReKi) , DIMENSION(1:3) :: AvgInfVel !< an average disk velocity (depends on wind type and should be removed) [m/s] - END TYPE AD14_InputType -! ======================= -! ========= AD14_OutputType ======= - TYPE, PUBLIC :: AD14_OutputType - TYPE(MeshType) , DIMENSION(:), ALLOCATABLE :: OutputLoads !< Output Loads (mesh) for each blade [-] - TYPE(MeshType) :: Twr_OutputLoads !< Tower Output Loads (mesh) [-] - END TYPE AD14_OutputType -! ======================= -CONTAINS - SUBROUTINE AD14_CopyMarker( SrcMarkerData, DstMarkerData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Marker), INTENT(IN) :: SrcMarkerData - TYPE(Marker), INTENT(INOUT) :: DstMarkerData - 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 = 'AD14_CopyMarker' -! - ErrStat = ErrID_None - ErrMsg = "" - DstMarkerData%Position = SrcMarkerData%Position - DstMarkerData%Orientation = SrcMarkerData%Orientation - DstMarkerData%TranslationVel = SrcMarkerData%TranslationVel - DstMarkerData%RotationVel = SrcMarkerData%RotationVel - END SUBROUTINE AD14_CopyMarker - - SUBROUTINE AD14_DestroyMarker( MarkerData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(Marker), INTENT(INOUT) :: MarkerData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyMarker' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE AD14_DestroyMarker - - SUBROUTINE AD14_PackMarker( 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(Marker), 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 = 'AD14_PackMarker' - ! 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%Position) ! Position - Re_BufSz = Re_BufSz + SIZE(InData%Orientation) ! Orientation - Re_BufSz = Re_BufSz + SIZE(InData%TranslationVel) ! TranslationVel - Re_BufSz = Re_BufSz + SIZE(InData%RotationVel) ! RotationVel - 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%Position,1), UBOUND(InData%Position,1) - ReKiBuf(Re_Xferred) = InData%Position(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i2 = LBOUND(InData%Orientation,2), UBOUND(InData%Orientation,2) - DO i1 = LBOUND(InData%Orientation,1), UBOUND(InData%Orientation,1) - ReKiBuf(Re_Xferred) = InData%Orientation(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - DO i1 = LBOUND(InData%TranslationVel,1), UBOUND(InData%TranslationVel,1) - ReKiBuf(Re_Xferred) = InData%TranslationVel(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%RotationVel,1), UBOUND(InData%RotationVel,1) - ReKiBuf(Re_Xferred) = InData%RotationVel(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END SUBROUTINE AD14_PackMarker - - SUBROUTINE AD14_UnPackMarker( 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(Marker), 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 = 'AD14_UnPackMarker' - ! 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%Position,1) - i1_u = UBOUND(OutData%Position,1) - DO i1 = LBOUND(OutData%Position,1), UBOUND(OutData%Position,1) - OutData%Position(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%Orientation,1) - i1_u = UBOUND(OutData%Orientation,1) - i2_l = LBOUND(OutData%Orientation,2) - i2_u = UBOUND(OutData%Orientation,2) - DO i2 = LBOUND(OutData%Orientation,2), UBOUND(OutData%Orientation,2) - DO i1 = LBOUND(OutData%Orientation,1), UBOUND(OutData%Orientation,1) - OutData%Orientation(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%TranslationVel,1) - i1_u = UBOUND(OutData%TranslationVel,1) - DO i1 = LBOUND(OutData%TranslationVel,1), UBOUND(OutData%TranslationVel,1) - OutData%TranslationVel(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%RotationVel,1) - i1_u = UBOUND(OutData%RotationVel,1) - DO i1 = LBOUND(OutData%RotationVel,1), UBOUND(OutData%RotationVel,1) - OutData%RotationVel(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END SUBROUTINE AD14_UnPackMarker - - SUBROUTINE AD14_CopyAeroConfig( SrcAeroConfigData, DstAeroConfigData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AeroConfig), INTENT(IN) :: SrcAeroConfigData - TYPE(AeroConfig), INTENT(INOUT) :: DstAeroConfigData - 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 = 'AD14_CopyAeroConfig' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcAeroConfigData%Blade)) THEN - i1_l = LBOUND(SrcAeroConfigData%Blade,1) - i1_u = UBOUND(SrcAeroConfigData%Blade,1) - IF (.NOT. ALLOCATED(DstAeroConfigData%Blade)) THEN - ALLOCATE(DstAeroConfigData%Blade(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstAeroConfigData%Blade.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcAeroConfigData%Blade,1), UBOUND(SrcAeroConfigData%Blade,1) - CALL AD14_Copymarker( SrcAeroConfigData%Blade(i1), DstAeroConfigData%Blade(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL AD14_Copymarker( SrcAeroConfigData%Hub, DstAeroConfigData%Hub, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD14_Copymarker( SrcAeroConfigData%RotorFurl, DstAeroConfigData%RotorFurl, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD14_Copymarker( SrcAeroConfigData%Nacelle, DstAeroConfigData%Nacelle, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD14_Copymarker( SrcAeroConfigData%TailFin, DstAeroConfigData%TailFin, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD14_Copymarker( SrcAeroConfigData%Tower, DstAeroConfigData%Tower, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD14_Copymarker( SrcAeroConfigData%SubStructure, DstAeroConfigData%SubStructure, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD14_Copymarker( SrcAeroConfigData%Foundation, DstAeroConfigData%Foundation, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstAeroConfigData%BladeLength = SrcAeroConfigData%BladeLength - END SUBROUTINE AD14_CopyAeroConfig - - SUBROUTINE AD14_DestroyAeroConfig( AeroConfigData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(AeroConfig), INTENT(INOUT) :: AeroConfigData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyAeroConfig' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(AeroConfigData%Blade)) THEN -DO i1 = LBOUND(AeroConfigData%Blade,1), UBOUND(AeroConfigData%Blade,1) - CALL AD14_Destroymarker( AeroConfigData%Blade(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(AeroConfigData%Blade) -ENDIF - CALL AD14_Destroymarker( AeroConfigData%Hub, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD14_Destroymarker( AeroConfigData%RotorFurl, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD14_Destroymarker( AeroConfigData%Nacelle, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD14_Destroymarker( AeroConfigData%TailFin, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD14_Destroymarker( AeroConfigData%Tower, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD14_Destroymarker( AeroConfigData%SubStructure, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD14_Destroymarker( AeroConfigData%Foundation, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE AD14_DestroyAeroConfig - - SUBROUTINE AD14_PackAeroConfig( 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(AeroConfig), 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 = 'AD14_PackAeroConfig' - ! 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 ! Blade allocated yes/no - IF ( ALLOCATED(InData%Blade) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Blade upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%Blade,1), UBOUND(InData%Blade,1) - Int_BufSz = Int_BufSz + 3 ! Blade: size of buffers for each call to pack subtype - CALL AD14_Packmarker( Re_Buf, Db_Buf, Int_Buf, InData%Blade(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Blade - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Blade - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Blade - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Blade - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! Hub: size of buffers for each call to pack subtype - CALL AD14_Packmarker( Re_Buf, Db_Buf, Int_Buf, InData%Hub, ErrStat2, ErrMsg2, .TRUE. ) ! Hub - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Hub - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Hub - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Hub - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! RotorFurl: size of buffers for each call to pack subtype - CALL AD14_Packmarker( Re_Buf, Db_Buf, Int_Buf, InData%RotorFurl, ErrStat2, ErrMsg2, .TRUE. ) ! RotorFurl - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! RotorFurl - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! RotorFurl - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! RotorFurl - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! Nacelle: size of buffers for each call to pack subtype - CALL AD14_Packmarker( Re_Buf, Db_Buf, Int_Buf, InData%Nacelle, ErrStat2, ErrMsg2, .TRUE. ) ! Nacelle - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Nacelle - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Nacelle - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Nacelle - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! TailFin: size of buffers for each call to pack subtype - CALL AD14_Packmarker( Re_Buf, Db_Buf, Int_Buf, InData%TailFin, ErrStat2, ErrMsg2, .TRUE. ) ! TailFin - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! TailFin - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! TailFin - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! TailFin - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! Tower: size of buffers for each call to pack subtype - CALL AD14_Packmarker( Re_Buf, Db_Buf, Int_Buf, InData%Tower, ErrStat2, ErrMsg2, .TRUE. ) ! Tower - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Tower - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Tower - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Tower - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! SubStructure: size of buffers for each call to pack subtype - CALL AD14_Packmarker( Re_Buf, Db_Buf, Int_Buf, InData%SubStructure, ErrStat2, ErrMsg2, .TRUE. ) ! SubStructure - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SubStructure - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SubStructure - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SubStructure - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! Foundation: size of buffers for each call to pack subtype - CALL AD14_Packmarker( Re_Buf, Db_Buf, Int_Buf, InData%Foundation, ErrStat2, ErrMsg2, .TRUE. ) ! Foundation - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Foundation - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Foundation - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Foundation - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Re_BufSz = Re_BufSz + 1 ! BladeLength - 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%Blade) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Blade,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Blade,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Blade,1), UBOUND(InData%Blade,1) - CALL AD14_Packmarker( Re_Buf, Db_Buf, Int_Buf, InData%Blade(i1), ErrStat2, ErrMsg2, OnlySize ) ! Blade - 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 - CALL AD14_Packmarker( Re_Buf, Db_Buf, Int_Buf, InData%Hub, ErrStat2, ErrMsg2, OnlySize ) ! Hub - 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 AD14_Packmarker( Re_Buf, Db_Buf, Int_Buf, InData%RotorFurl, ErrStat2, ErrMsg2, OnlySize ) ! RotorFurl - 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 AD14_Packmarker( Re_Buf, Db_Buf, Int_Buf, InData%Nacelle, ErrStat2, ErrMsg2, OnlySize ) ! Nacelle - 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 AD14_Packmarker( Re_Buf, Db_Buf, Int_Buf, InData%TailFin, ErrStat2, ErrMsg2, OnlySize ) ! TailFin - 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 AD14_Packmarker( Re_Buf, Db_Buf, Int_Buf, InData%Tower, ErrStat2, ErrMsg2, OnlySize ) ! Tower - 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 AD14_Packmarker( Re_Buf, Db_Buf, Int_Buf, InData%SubStructure, ErrStat2, ErrMsg2, OnlySize ) ! SubStructure - 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 AD14_Packmarker( Re_Buf, Db_Buf, Int_Buf, InData%Foundation, ErrStat2, ErrMsg2, OnlySize ) ! Foundation - 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 - ReKiBuf(Re_Xferred) = InData%BladeLength - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AD14_PackAeroConfig - - SUBROUTINE AD14_UnPackAeroConfig( 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(AeroConfig), 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 = 'AD14_UnPackAeroConfig' - ! 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 ! Blade not allocated - Int_Xferred = Int_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%Blade)) DEALLOCATE(OutData%Blade) - ALLOCATE(OutData%Blade(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Blade.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Blade,1), UBOUND(OutData%Blade,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 AD14_Unpackmarker( Re_Buf, Db_Buf, Int_Buf, OutData%Blade(i1), ErrStat2, ErrMsg2 ) ! Blade - 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 - 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 AD14_Unpackmarker( Re_Buf, Db_Buf, Int_Buf, OutData%Hub, ErrStat2, ErrMsg2 ) ! Hub - 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 AD14_Unpackmarker( Re_Buf, Db_Buf, Int_Buf, OutData%RotorFurl, ErrStat2, ErrMsg2 ) ! RotorFurl - 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 AD14_Unpackmarker( Re_Buf, Db_Buf, Int_Buf, OutData%Nacelle, ErrStat2, ErrMsg2 ) ! Nacelle - 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 AD14_Unpackmarker( Re_Buf, Db_Buf, Int_Buf, OutData%TailFin, ErrStat2, ErrMsg2 ) ! TailFin - 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 AD14_Unpackmarker( Re_Buf, Db_Buf, Int_Buf, OutData%Tower, ErrStat2, ErrMsg2 ) ! Tower - 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 AD14_Unpackmarker( Re_Buf, Db_Buf, Int_Buf, OutData%SubStructure, ErrStat2, ErrMsg2 ) ! SubStructure - 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 AD14_Unpackmarker( Re_Buf, Db_Buf, Int_Buf, OutData%Foundation, ErrStat2, ErrMsg2 ) ! Foundation - 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%BladeLength = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AD14_UnPackAeroConfig - - SUBROUTINE AD14_CopyAirFoil( SrcAirFoilData, DstAirFoilData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AirFoil), INTENT(IN) :: SrcAirFoilData - TYPE(AirFoil), INTENT(INOUT) :: DstAirFoilData - 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 = 'AD14_CopyAirFoil' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcAirFoilData%AL)) THEN - i1_l = LBOUND(SrcAirFoilData%AL,1) - i1_u = UBOUND(SrcAirFoilData%AL,1) - i2_l = LBOUND(SrcAirFoilData%AL,2) - i2_u = UBOUND(SrcAirFoilData%AL,2) - IF (.NOT. ALLOCATED(DstAirFoilData%AL)) THEN - ALLOCATE(DstAirFoilData%AL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstAirFoilData%AL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstAirFoilData%AL = SrcAirFoilData%AL -ENDIF -IF (ALLOCATED(SrcAirFoilData%CD)) THEN - i1_l = LBOUND(SrcAirFoilData%CD,1) - i1_u = UBOUND(SrcAirFoilData%CD,1) - i2_l = LBOUND(SrcAirFoilData%CD,2) - i2_u = UBOUND(SrcAirFoilData%CD,2) - i3_l = LBOUND(SrcAirFoilData%CD,3) - i3_u = UBOUND(SrcAirFoilData%CD,3) - IF (.NOT. ALLOCATED(DstAirFoilData%CD)) THEN - ALLOCATE(DstAirFoilData%CD(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstAirFoilData%CD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstAirFoilData%CD = SrcAirFoilData%CD -ENDIF -IF (ALLOCATED(SrcAirFoilData%CL)) THEN - i1_l = LBOUND(SrcAirFoilData%CL,1) - i1_u = UBOUND(SrcAirFoilData%CL,1) - i2_l = LBOUND(SrcAirFoilData%CL,2) - i2_u = UBOUND(SrcAirFoilData%CL,2) - i3_l = LBOUND(SrcAirFoilData%CL,3) - i3_u = UBOUND(SrcAirFoilData%CL,3) - IF (.NOT. ALLOCATED(DstAirFoilData%CL)) THEN - ALLOCATE(DstAirFoilData%CL(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstAirFoilData%CL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstAirFoilData%CL = SrcAirFoilData%CL -ENDIF -IF (ALLOCATED(SrcAirFoilData%CM)) THEN - i1_l = LBOUND(SrcAirFoilData%CM,1) - i1_u = UBOUND(SrcAirFoilData%CM,1) - i2_l = LBOUND(SrcAirFoilData%CM,2) - i2_u = UBOUND(SrcAirFoilData%CM,2) - i3_l = LBOUND(SrcAirFoilData%CM,3) - i3_u = UBOUND(SrcAirFoilData%CM,3) - IF (.NOT. ALLOCATED(DstAirFoilData%CM)) THEN - ALLOCATE(DstAirFoilData%CM(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstAirFoilData%CM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstAirFoilData%CM = SrcAirFoilData%CM -ENDIF - DstAirFoilData%PMC = SrcAirFoilData%PMC - DstAirFoilData%MulTabLoc = SrcAirFoilData%MulTabLoc - END SUBROUTINE AD14_CopyAirFoil - - SUBROUTINE AD14_DestroyAirFoil( AirFoilData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(AirFoil), INTENT(INOUT) :: AirFoilData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyAirFoil' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(AirFoilData%AL)) THEN - DEALLOCATE(AirFoilData%AL) -ENDIF -IF (ALLOCATED(AirFoilData%CD)) THEN - DEALLOCATE(AirFoilData%CD) -ENDIF -IF (ALLOCATED(AirFoilData%CL)) THEN - DEALLOCATE(AirFoilData%CL) -ENDIF -IF (ALLOCATED(AirFoilData%CM)) THEN - DEALLOCATE(AirFoilData%CM) -ENDIF - END SUBROUTINE AD14_DestroyAirFoil - - SUBROUTINE AD14_PackAirFoil( 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(AirFoil), 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 = 'AD14_PackAirFoil' - ! 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 ! AL allocated yes/no - IF ( ALLOCATED(InData%AL) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! AL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AL) ! AL - END IF - Int_BufSz = Int_BufSz + 1 ! CD allocated yes/no - IF ( ALLOCATED(InData%CD) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! CD upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CD) ! CD - END IF - Int_BufSz = Int_BufSz + 1 ! CL allocated yes/no - IF ( ALLOCATED(InData%CL) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! CL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CL) ! CL - END IF - Int_BufSz = Int_BufSz + 1 ! CM allocated yes/no - IF ( ALLOCATED(InData%CM) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! CM upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CM) ! CM - END IF - Re_BufSz = Re_BufSz + 1 ! PMC - Re_BufSz = Re_BufSz + 1 ! MulTabLoc - 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%AL) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AL,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AL,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AL,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%AL,2), UBOUND(InData%AL,2) - DO i1 = LBOUND(InData%AL,1), UBOUND(InData%AL,1) - ReKiBuf(Re_Xferred) = InData%AL(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CD) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CD,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CD,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CD,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CD,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CD,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%CD,3), UBOUND(InData%CD,3) - DO i2 = LBOUND(InData%CD,2), UBOUND(InData%CD,2) - DO i1 = LBOUND(InData%CD,1), UBOUND(InData%CD,1) - ReKiBuf(Re_Xferred) = InData%CD(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CL) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CL,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CL,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CL,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CL,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CL,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%CL,3), UBOUND(InData%CL,3) - DO i2 = LBOUND(InData%CL,2), UBOUND(InData%CL,2) - DO i1 = LBOUND(InData%CL,1), UBOUND(InData%CL,1) - ReKiBuf(Re_Xferred) = InData%CL(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CM) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CM,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CM,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CM,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CM,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CM,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CM,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%CM,3), UBOUND(InData%CM,3) - DO i2 = LBOUND(InData%CM,2), UBOUND(InData%CM,2) - DO i1 = LBOUND(InData%CM,1), UBOUND(InData%CM,1) - ReKiBuf(Re_Xferred) = InData%CM(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - ReKiBuf(Re_Xferred) = InData%PMC - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MulTabLoc - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AD14_PackAirFoil - - SUBROUTINE AD14_UnPackAirFoil( 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(AirFoil), 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 = 'AD14_UnPackAirFoil' - ! 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 ! AL not allocated - Int_Xferred = Int_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%AL)) DEALLOCATE(OutData%AL) - ALLOCATE(OutData%AL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%AL,2), UBOUND(OutData%AL,2) - DO i1 = LBOUND(OutData%AL,1), UBOUND(OutData%AL,1) - OutData%AL(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CD not allocated - Int_Xferred = Int_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%CD)) DEALLOCATE(OutData%CD) - ALLOCATE(OutData%CD(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%CD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%CD,3), UBOUND(OutData%CD,3) - DO i2 = LBOUND(OutData%CD,2), UBOUND(OutData%CD,2) - DO i1 = LBOUND(OutData%CD,1), UBOUND(OutData%CD,1) - OutData%CD(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 ! CL not allocated - Int_Xferred = Int_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%CL)) DEALLOCATE(OutData%CL) - ALLOCATE(OutData%CL(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%CL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%CL,3), UBOUND(OutData%CL,3) - DO i2 = LBOUND(OutData%CL,2), UBOUND(OutData%CL,2) - DO i1 = LBOUND(OutData%CL,1), UBOUND(OutData%CL,1) - OutData%CL(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 ! CM not allocated - Int_Xferred = Int_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%CM)) DEALLOCATE(OutData%CM) - ALLOCATE(OutData%CM(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%CM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%CM,3), UBOUND(OutData%CM,3) - DO i2 = LBOUND(OutData%CM,2), UBOUND(OutData%CM,2) - DO i1 = LBOUND(OutData%CM,1), UBOUND(OutData%CM,1) - OutData%CM(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - OutData%PMC = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MulTabLoc = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AD14_UnPackAirFoil - - SUBROUTINE AD14_CopyAirFoilParms( SrcAirFoilParmsData, DstAirFoilParmsData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AirFoilParms), INTENT(IN) :: SrcAirFoilParmsData - TYPE(AirFoilParms), INTENT(INOUT) :: DstAirFoilParmsData - 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 = 'AD14_CopyAirFoilParms' -! - ErrStat = ErrID_None - ErrMsg = "" - DstAirFoilParmsData%MaxTable = SrcAirFoilParmsData%MaxTable -IF (ALLOCATED(SrcAirFoilParmsData%NTables)) THEN - i1_l = LBOUND(SrcAirFoilParmsData%NTables,1) - i1_u = UBOUND(SrcAirFoilParmsData%NTables,1) - IF (.NOT. ALLOCATED(DstAirFoilParmsData%NTables)) THEN - ALLOCATE(DstAirFoilParmsData%NTables(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstAirFoilParmsData%NTables.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstAirFoilParmsData%NTables = SrcAirFoilParmsData%NTables -ENDIF -IF (ALLOCATED(SrcAirFoilParmsData%NLift)) THEN - i1_l = LBOUND(SrcAirFoilParmsData%NLift,1) - i1_u = UBOUND(SrcAirFoilParmsData%NLift,1) - IF (.NOT. ALLOCATED(DstAirFoilParmsData%NLift)) THEN - ALLOCATE(DstAirFoilParmsData%NLift(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstAirFoilParmsData%NLift.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstAirFoilParmsData%NLift = SrcAirFoilParmsData%NLift -ENDIF - DstAirFoilParmsData%NumCL = SrcAirFoilParmsData%NumCL - DstAirFoilParmsData%NumFoil = SrcAirFoilParmsData%NumFoil -IF (ALLOCATED(SrcAirFoilParmsData%NFoil)) THEN - i1_l = LBOUND(SrcAirFoilParmsData%NFoil,1) - i1_u = UBOUND(SrcAirFoilParmsData%NFoil,1) - IF (.NOT. ALLOCATED(DstAirFoilParmsData%NFoil)) THEN - ALLOCATE(DstAirFoilParmsData%NFoil(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstAirFoilParmsData%NFoil.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstAirFoilParmsData%NFoil = SrcAirFoilParmsData%NFoil -ENDIF -IF (ALLOCATED(SrcAirFoilParmsData%MulTabMet)) THEN - i1_l = LBOUND(SrcAirFoilParmsData%MulTabMet,1) - i1_u = UBOUND(SrcAirFoilParmsData%MulTabMet,1) - i2_l = LBOUND(SrcAirFoilParmsData%MulTabMet,2) - i2_u = UBOUND(SrcAirFoilParmsData%MulTabMet,2) - IF (.NOT. ALLOCATED(DstAirFoilParmsData%MulTabMet)) THEN - ALLOCATE(DstAirFoilParmsData%MulTabMet(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstAirFoilParmsData%MulTabMet.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstAirFoilParmsData%MulTabMet = SrcAirFoilParmsData%MulTabMet -ENDIF -IF (ALLOCATED(SrcAirFoilParmsData%FoilNm)) THEN - i1_l = LBOUND(SrcAirFoilParmsData%FoilNm,1) - i1_u = UBOUND(SrcAirFoilParmsData%FoilNm,1) - IF (.NOT. ALLOCATED(DstAirFoilParmsData%FoilNm)) THEN - ALLOCATE(DstAirFoilParmsData%FoilNm(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstAirFoilParmsData%FoilNm.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstAirFoilParmsData%FoilNm = SrcAirFoilParmsData%FoilNm -ENDIF - END SUBROUTINE AD14_CopyAirFoilParms - - SUBROUTINE AD14_DestroyAirFoilParms( AirFoilParmsData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(AirFoilParms), INTENT(INOUT) :: AirFoilParmsData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyAirFoilParms' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(AirFoilParmsData%NTables)) THEN - DEALLOCATE(AirFoilParmsData%NTables) -ENDIF -IF (ALLOCATED(AirFoilParmsData%NLift)) THEN - DEALLOCATE(AirFoilParmsData%NLift) -ENDIF -IF (ALLOCATED(AirFoilParmsData%NFoil)) THEN - DEALLOCATE(AirFoilParmsData%NFoil) -ENDIF -IF (ALLOCATED(AirFoilParmsData%MulTabMet)) THEN - DEALLOCATE(AirFoilParmsData%MulTabMet) -ENDIF -IF (ALLOCATED(AirFoilParmsData%FoilNm)) THEN - DEALLOCATE(AirFoilParmsData%FoilNm) -ENDIF - END SUBROUTINE AD14_DestroyAirFoilParms - - SUBROUTINE AD14_PackAirFoilParms( 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(AirFoilParms), 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 = 'AD14_PackAirFoilParms' - ! 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 ! MaxTable - Int_BufSz = Int_BufSz + 1 ! NTables allocated yes/no - IF ( ALLOCATED(InData%NTables) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! NTables upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%NTables) ! NTables - END IF - Int_BufSz = Int_BufSz + 1 ! NLift allocated yes/no - IF ( ALLOCATED(InData%NLift) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! NLift upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%NLift) ! NLift - END IF - Int_BufSz = Int_BufSz + 1 ! NumCL - Int_BufSz = Int_BufSz + 1 ! NumFoil - Int_BufSz = Int_BufSz + 1 ! NFoil allocated yes/no - IF ( ALLOCATED(InData%NFoil) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! NFoil upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%NFoil) ! NFoil - END IF - Int_BufSz = Int_BufSz + 1 ! MulTabMet allocated yes/no - IF ( ALLOCATED(InData%MulTabMet) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! MulTabMet upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%MulTabMet) ! MulTabMet - END IF - Int_BufSz = Int_BufSz + 1 ! FoilNm allocated yes/no - IF ( ALLOCATED(InData%FoilNm) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! FoilNm upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%FoilNm)*LEN(InData%FoilNm) ! FoilNm - 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%MaxTable - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%NTables) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%NTables,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NTables,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%NTables,1), UBOUND(InData%NTables,1) - IntKiBuf(Int_Xferred) = InData%NTables(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%NLift) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%NLift,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NLift,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%NLift,1), UBOUND(InData%NLift,1) - IntKiBuf(Int_Xferred) = InData%NLift(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NumCL - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumFoil - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%NFoil) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%NFoil,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NFoil,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%NFoil,1), UBOUND(InData%NFoil,1) - IntKiBuf(Int_Xferred) = InData%NFoil(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%MulTabMet) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MulTabMet,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MulTabMet,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MulTabMet,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MulTabMet,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%MulTabMet,2), UBOUND(InData%MulTabMet,2) - DO i1 = LBOUND(InData%MulTabMet,1), UBOUND(InData%MulTabMet,1) - ReKiBuf(Re_Xferred) = InData%MulTabMet(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%FoilNm) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FoilNm,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FoilNm,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%FoilNm,1), UBOUND(InData%FoilNm,1) - DO I = 1, LEN(InData%FoilNm) - IntKiBuf(Int_Xferred) = ICHAR(InData%FoilNm(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - END SUBROUTINE AD14_PackAirFoilParms - - SUBROUTINE AD14_UnPackAirFoilParms( 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(AirFoilParms), 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 = 'AD14_UnPackAirFoilParms' - ! 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%MaxTable = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NTables not allocated - Int_Xferred = Int_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%NTables)) DEALLOCATE(OutData%NTables) - ALLOCATE(OutData%NTables(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NTables.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%NTables,1), UBOUND(OutData%NTables,1) - OutData%NTables(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NLift not allocated - Int_Xferred = Int_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%NLift)) DEALLOCATE(OutData%NLift) - ALLOCATE(OutData%NLift(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NLift.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%NLift,1), UBOUND(OutData%NLift,1) - OutData%NLift(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - OutData%NumCL = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumFoil = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NFoil not allocated - Int_Xferred = Int_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%NFoil)) DEALLOCATE(OutData%NFoil) - ALLOCATE(OutData%NFoil(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NFoil.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%NFoil,1), UBOUND(OutData%NFoil,1) - OutData%NFoil(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MulTabMet not allocated - Int_Xferred = Int_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%MulTabMet)) DEALLOCATE(OutData%MulTabMet) - ALLOCATE(OutData%MulTabMet(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MulTabMet.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%MulTabMet,2), UBOUND(OutData%MulTabMet,2) - DO i1 = LBOUND(OutData%MulTabMet,1), UBOUND(OutData%MulTabMet,1) - OutData%MulTabMet(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FoilNm not allocated - Int_Xferred = Int_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%FoilNm)) DEALLOCATE(OutData%FoilNm) - ALLOCATE(OutData%FoilNm(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FoilNm.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%FoilNm,1), UBOUND(OutData%FoilNm,1) - DO I = 1, LEN(OutData%FoilNm) - OutData%FoilNm(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - END SUBROUTINE AD14_UnPackAirFoilParms - - SUBROUTINE AD14_CopyBeddoes( SrcBeddoesData, DstBeddoesData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Beddoes), INTENT(IN) :: SrcBeddoesData - TYPE(Beddoes), INTENT(INOUT) :: DstBeddoesData - 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 = 'AD14_CopyBeddoes' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcBeddoesData%ADOT)) THEN - i1_l = LBOUND(SrcBeddoesData%ADOT,1) - i1_u = UBOUND(SrcBeddoesData%ADOT,1) - i2_l = LBOUND(SrcBeddoesData%ADOT,2) - i2_u = UBOUND(SrcBeddoesData%ADOT,2) - IF (.NOT. ALLOCATED(DstBeddoesData%ADOT)) THEN - ALLOCATE(DstBeddoesData%ADOT(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%ADOT.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%ADOT = SrcBeddoesData%ADOT -ENDIF -IF (ALLOCATED(SrcBeddoesData%ADOT1)) THEN - i1_l = LBOUND(SrcBeddoesData%ADOT1,1) - i1_u = UBOUND(SrcBeddoesData%ADOT1,1) - i2_l = LBOUND(SrcBeddoesData%ADOT1,2) - i2_u = UBOUND(SrcBeddoesData%ADOT1,2) - IF (.NOT. ALLOCATED(DstBeddoesData%ADOT1)) THEN - ALLOCATE(DstBeddoesData%ADOT1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%ADOT1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%ADOT1 = SrcBeddoesData%ADOT1 -ENDIF -IF (ALLOCATED(SrcBeddoesData%AFE)) THEN - i1_l = LBOUND(SrcBeddoesData%AFE,1) - i1_u = UBOUND(SrcBeddoesData%AFE,1) - i2_l = LBOUND(SrcBeddoesData%AFE,2) - i2_u = UBOUND(SrcBeddoesData%AFE,2) - IF (.NOT. ALLOCATED(DstBeddoesData%AFE)) THEN - ALLOCATE(DstBeddoesData%AFE(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%AFE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%AFE = SrcBeddoesData%AFE -ENDIF -IF (ALLOCATED(SrcBeddoesData%AFE1)) THEN - i1_l = LBOUND(SrcBeddoesData%AFE1,1) - i1_u = UBOUND(SrcBeddoesData%AFE1,1) - i2_l = LBOUND(SrcBeddoesData%AFE1,2) - i2_u = UBOUND(SrcBeddoesData%AFE1,2) - IF (.NOT. ALLOCATED(DstBeddoesData%AFE1)) THEN - ALLOCATE(DstBeddoesData%AFE1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%AFE1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%AFE1 = SrcBeddoesData%AFE1 -ENDIF - DstBeddoesData%AN = SrcBeddoesData%AN -IF (ALLOCATED(SrcBeddoesData%ANE)) THEN - i1_l = LBOUND(SrcBeddoesData%ANE,1) - i1_u = UBOUND(SrcBeddoesData%ANE,1) - i2_l = LBOUND(SrcBeddoesData%ANE,2) - i2_u = UBOUND(SrcBeddoesData%ANE,2) - IF (.NOT. ALLOCATED(DstBeddoesData%ANE)) THEN - ALLOCATE(DstBeddoesData%ANE(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%ANE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%ANE = SrcBeddoesData%ANE -ENDIF -IF (ALLOCATED(SrcBeddoesData%ANE1)) THEN - i1_l = LBOUND(SrcBeddoesData%ANE1,1) - i1_u = UBOUND(SrcBeddoesData%ANE1,1) - i2_l = LBOUND(SrcBeddoesData%ANE1,2) - i2_u = UBOUND(SrcBeddoesData%ANE1,2) - IF (.NOT. ALLOCATED(DstBeddoesData%ANE1)) THEN - ALLOCATE(DstBeddoesData%ANE1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%ANE1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%ANE1 = SrcBeddoesData%ANE1 -ENDIF -IF (ALLOCATED(SrcBeddoesData%AOD)) THEN - i1_l = LBOUND(SrcBeddoesData%AOD,1) - i1_u = UBOUND(SrcBeddoesData%AOD,1) - i2_l = LBOUND(SrcBeddoesData%AOD,2) - i2_u = UBOUND(SrcBeddoesData%AOD,2) - IF (.NOT. ALLOCATED(DstBeddoesData%AOD)) THEN - ALLOCATE(DstBeddoesData%AOD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%AOD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%AOD = SrcBeddoesData%AOD -ENDIF -IF (ALLOCATED(SrcBeddoesData%AOL)) THEN - i1_l = LBOUND(SrcBeddoesData%AOL,1) - i1_u = UBOUND(SrcBeddoesData%AOL,1) - i2_l = LBOUND(SrcBeddoesData%AOL,2) - i2_u = UBOUND(SrcBeddoesData%AOL,2) - IF (.NOT. ALLOCATED(DstBeddoesData%AOL)) THEN - ALLOCATE(DstBeddoesData%AOL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%AOL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%AOL = SrcBeddoesData%AOL -ENDIF -IF (ALLOCATED(SrcBeddoesData%BEDSEP)) THEN - i1_l = LBOUND(SrcBeddoesData%BEDSEP,1) - i1_u = UBOUND(SrcBeddoesData%BEDSEP,1) - i2_l = LBOUND(SrcBeddoesData%BEDSEP,2) - i2_u = UBOUND(SrcBeddoesData%BEDSEP,2) - IF (.NOT. ALLOCATED(DstBeddoesData%BEDSEP)) THEN - ALLOCATE(DstBeddoesData%BEDSEP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%BEDSEP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%BEDSEP = SrcBeddoesData%BEDSEP -ENDIF -IF (ALLOCATED(SrcBeddoesData%OLDSEP)) THEN - i1_l = LBOUND(SrcBeddoesData%OLDSEP,1) - i1_u = UBOUND(SrcBeddoesData%OLDSEP,1) - i2_l = LBOUND(SrcBeddoesData%OLDSEP,2) - i2_u = UBOUND(SrcBeddoesData%OLDSEP,2) - IF (.NOT. ALLOCATED(DstBeddoesData%OLDSEP)) THEN - ALLOCATE(DstBeddoesData%OLDSEP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%OLDSEP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%OLDSEP = SrcBeddoesData%OLDSEP -ENDIF - DstBeddoesData%CC = SrcBeddoesData%CC -IF (ALLOCATED(SrcBeddoesData%CDO)) THEN - i1_l = LBOUND(SrcBeddoesData%CDO,1) - i1_u = UBOUND(SrcBeddoesData%CDO,1) - i2_l = LBOUND(SrcBeddoesData%CDO,2) - i2_u = UBOUND(SrcBeddoesData%CDO,2) - IF (.NOT. ALLOCATED(DstBeddoesData%CDO)) THEN - ALLOCATE(DstBeddoesData%CDO(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%CDO.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%CDO = SrcBeddoesData%CDO -ENDIF - DstBeddoesData%CMI = SrcBeddoesData%CMI - DstBeddoesData%CMQ = SrcBeddoesData%CMQ - DstBeddoesData%CN = SrcBeddoesData%CN -IF (ALLOCATED(SrcBeddoesData%CNA)) THEN - i1_l = LBOUND(SrcBeddoesData%CNA,1) - i1_u = UBOUND(SrcBeddoesData%CNA,1) - i2_l = LBOUND(SrcBeddoesData%CNA,2) - i2_u = UBOUND(SrcBeddoesData%CNA,2) - IF (.NOT. ALLOCATED(DstBeddoesData%CNA)) THEN - ALLOCATE(DstBeddoesData%CNA(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%CNA.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%CNA = SrcBeddoesData%CNA -ENDIF - DstBeddoesData%CNCP = SrcBeddoesData%CNCP - DstBeddoesData%CNIQ = SrcBeddoesData%CNIQ -IF (ALLOCATED(SrcBeddoesData%CNP)) THEN - i1_l = LBOUND(SrcBeddoesData%CNP,1) - i1_u = UBOUND(SrcBeddoesData%CNP,1) - i2_l = LBOUND(SrcBeddoesData%CNP,2) - i2_u = UBOUND(SrcBeddoesData%CNP,2) - IF (.NOT. ALLOCATED(DstBeddoesData%CNP)) THEN - ALLOCATE(DstBeddoesData%CNP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%CNP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%CNP = SrcBeddoesData%CNP -ENDIF -IF (ALLOCATED(SrcBeddoesData%CNP1)) THEN - i1_l = LBOUND(SrcBeddoesData%CNP1,1) - i1_u = UBOUND(SrcBeddoesData%CNP1,1) - i2_l = LBOUND(SrcBeddoesData%CNP1,2) - i2_u = UBOUND(SrcBeddoesData%CNP1,2) - IF (.NOT. ALLOCATED(DstBeddoesData%CNP1)) THEN - ALLOCATE(DstBeddoesData%CNP1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%CNP1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%CNP1 = SrcBeddoesData%CNP1 -ENDIF -IF (ALLOCATED(SrcBeddoesData%CNPD)) THEN - i1_l = LBOUND(SrcBeddoesData%CNPD,1) - i1_u = UBOUND(SrcBeddoesData%CNPD,1) - i2_l = LBOUND(SrcBeddoesData%CNPD,2) - i2_u = UBOUND(SrcBeddoesData%CNPD,2) - IF (.NOT. ALLOCATED(DstBeddoesData%CNPD)) THEN - ALLOCATE(DstBeddoesData%CNPD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%CNPD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%CNPD = SrcBeddoesData%CNPD -ENDIF -IF (ALLOCATED(SrcBeddoesData%CNPD1)) THEN - i1_l = LBOUND(SrcBeddoesData%CNPD1,1) - i1_u = UBOUND(SrcBeddoesData%CNPD1,1) - i2_l = LBOUND(SrcBeddoesData%CNPD1,2) - i2_u = UBOUND(SrcBeddoesData%CNPD1,2) - IF (.NOT. ALLOCATED(DstBeddoesData%CNPD1)) THEN - ALLOCATE(DstBeddoesData%CNPD1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%CNPD1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%CNPD1 = SrcBeddoesData%CNPD1 -ENDIF -IF (ALLOCATED(SrcBeddoesData%CNPOT)) THEN - i1_l = LBOUND(SrcBeddoesData%CNPOT,1) - i1_u = UBOUND(SrcBeddoesData%CNPOT,1) - i2_l = LBOUND(SrcBeddoesData%CNPOT,2) - i2_u = UBOUND(SrcBeddoesData%CNPOT,2) - IF (.NOT. ALLOCATED(DstBeddoesData%CNPOT)) THEN - ALLOCATE(DstBeddoesData%CNPOT(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%CNPOT.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%CNPOT = SrcBeddoesData%CNPOT -ENDIF -IF (ALLOCATED(SrcBeddoesData%CNPOT1)) THEN - i1_l = LBOUND(SrcBeddoesData%CNPOT1,1) - i1_u = UBOUND(SrcBeddoesData%CNPOT1,1) - i2_l = LBOUND(SrcBeddoesData%CNPOT1,2) - i2_u = UBOUND(SrcBeddoesData%CNPOT1,2) - IF (.NOT. ALLOCATED(DstBeddoesData%CNPOT1)) THEN - ALLOCATE(DstBeddoesData%CNPOT1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%CNPOT1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%CNPOT1 = SrcBeddoesData%CNPOT1 -ENDIF -IF (ALLOCATED(SrcBeddoesData%CNS)) THEN - i1_l = LBOUND(SrcBeddoesData%CNS,1) - i1_u = UBOUND(SrcBeddoesData%CNS,1) - i2_l = LBOUND(SrcBeddoesData%CNS,2) - i2_u = UBOUND(SrcBeddoesData%CNS,2) - IF (.NOT. ALLOCATED(DstBeddoesData%CNS)) THEN - ALLOCATE(DstBeddoesData%CNS(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%CNS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%CNS = SrcBeddoesData%CNS -ENDIF -IF (ALLOCATED(SrcBeddoesData%CNSL)) THEN - i1_l = LBOUND(SrcBeddoesData%CNSL,1) - i1_u = UBOUND(SrcBeddoesData%CNSL,1) - i2_l = LBOUND(SrcBeddoesData%CNSL,2) - i2_u = UBOUND(SrcBeddoesData%CNSL,2) - IF (.NOT. ALLOCATED(DstBeddoesData%CNSL)) THEN - ALLOCATE(DstBeddoesData%CNSL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%CNSL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%CNSL = SrcBeddoesData%CNSL -ENDIF -IF (ALLOCATED(SrcBeddoesData%CNV)) THEN - i1_l = LBOUND(SrcBeddoesData%CNV,1) - i1_u = UBOUND(SrcBeddoesData%CNV,1) - i2_l = LBOUND(SrcBeddoesData%CNV,2) - i2_u = UBOUND(SrcBeddoesData%CNV,2) - IF (.NOT. ALLOCATED(DstBeddoesData%CNV)) THEN - ALLOCATE(DstBeddoesData%CNV(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%CNV.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%CNV = SrcBeddoesData%CNV -ENDIF -IF (ALLOCATED(SrcBeddoesData%CVN)) THEN - i1_l = LBOUND(SrcBeddoesData%CVN,1) - i1_u = UBOUND(SrcBeddoesData%CVN,1) - i2_l = LBOUND(SrcBeddoesData%CVN,2) - i2_u = UBOUND(SrcBeddoesData%CVN,2) - IF (.NOT. ALLOCATED(DstBeddoesData%CVN)) THEN - ALLOCATE(DstBeddoesData%CVN(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%CVN.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%CVN = SrcBeddoesData%CVN -ENDIF -IF (ALLOCATED(SrcBeddoesData%CVN1)) THEN - i1_l = LBOUND(SrcBeddoesData%CVN1,1) - i1_u = UBOUND(SrcBeddoesData%CVN1,1) - i2_l = LBOUND(SrcBeddoesData%CVN1,2) - i2_u = UBOUND(SrcBeddoesData%CVN1,2) - IF (.NOT. ALLOCATED(DstBeddoesData%CVN1)) THEN - ALLOCATE(DstBeddoesData%CVN1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%CVN1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%CVN1 = SrcBeddoesData%CVN1 -ENDIF -IF (ALLOCATED(SrcBeddoesData%DF)) THEN - i1_l = LBOUND(SrcBeddoesData%DF,1) - i1_u = UBOUND(SrcBeddoesData%DF,1) - i2_l = LBOUND(SrcBeddoesData%DF,2) - i2_u = UBOUND(SrcBeddoesData%DF,2) - IF (.NOT. ALLOCATED(DstBeddoesData%DF)) THEN - ALLOCATE(DstBeddoesData%DF(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%DF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%DF = SrcBeddoesData%DF -ENDIF -IF (ALLOCATED(SrcBeddoesData%DFAFE)) THEN - i1_l = LBOUND(SrcBeddoesData%DFAFE,1) - i1_u = UBOUND(SrcBeddoesData%DFAFE,1) - i2_l = LBOUND(SrcBeddoesData%DFAFE,2) - i2_u = UBOUND(SrcBeddoesData%DFAFE,2) - IF (.NOT. ALLOCATED(DstBeddoesData%DFAFE)) THEN - ALLOCATE(DstBeddoesData%DFAFE(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%DFAFE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%DFAFE = SrcBeddoesData%DFAFE -ENDIF -IF (ALLOCATED(SrcBeddoesData%DFAFE1)) THEN - i1_l = LBOUND(SrcBeddoesData%DFAFE1,1) - i1_u = UBOUND(SrcBeddoesData%DFAFE1,1) - i2_l = LBOUND(SrcBeddoesData%DFAFE1,2) - i2_u = UBOUND(SrcBeddoesData%DFAFE1,2) - IF (.NOT. ALLOCATED(DstBeddoesData%DFAFE1)) THEN - ALLOCATE(DstBeddoesData%DFAFE1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%DFAFE1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%DFAFE1 = SrcBeddoesData%DFAFE1 -ENDIF -IF (ALLOCATED(SrcBeddoesData%DFC)) THEN - i1_l = LBOUND(SrcBeddoesData%DFC,1) - i1_u = UBOUND(SrcBeddoesData%DFC,1) - i2_l = LBOUND(SrcBeddoesData%DFC,2) - i2_u = UBOUND(SrcBeddoesData%DFC,2) - IF (.NOT. ALLOCATED(DstBeddoesData%DFC)) THEN - ALLOCATE(DstBeddoesData%DFC(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%DFC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%DFC = SrcBeddoesData%DFC -ENDIF -IF (ALLOCATED(SrcBeddoesData%DN)) THEN - i1_l = LBOUND(SrcBeddoesData%DN,1) - i1_u = UBOUND(SrcBeddoesData%DN,1) - i2_l = LBOUND(SrcBeddoesData%DN,2) - i2_u = UBOUND(SrcBeddoesData%DN,2) - IF (.NOT. ALLOCATED(DstBeddoesData%DN)) THEN - ALLOCATE(DstBeddoesData%DN(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%DN.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%DN = SrcBeddoesData%DN -ENDIF -IF (ALLOCATED(SrcBeddoesData%DPP)) THEN - i1_l = LBOUND(SrcBeddoesData%DPP,1) - i1_u = UBOUND(SrcBeddoesData%DPP,1) - i2_l = LBOUND(SrcBeddoesData%DPP,2) - i2_u = UBOUND(SrcBeddoesData%DPP,2) - IF (.NOT. ALLOCATED(DstBeddoesData%DPP)) THEN - ALLOCATE(DstBeddoesData%DPP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%DPP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%DPP = SrcBeddoesData%DPP -ENDIF -IF (ALLOCATED(SrcBeddoesData%DQ)) THEN - i1_l = LBOUND(SrcBeddoesData%DQ,1) - i1_u = UBOUND(SrcBeddoesData%DQ,1) - i2_l = LBOUND(SrcBeddoesData%DQ,2) - i2_u = UBOUND(SrcBeddoesData%DQ,2) - IF (.NOT. ALLOCATED(DstBeddoesData%DQ)) THEN - ALLOCATE(DstBeddoesData%DQ(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%DQ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%DQ = SrcBeddoesData%DQ -ENDIF -IF (ALLOCATED(SrcBeddoesData%DQP)) THEN - i1_l = LBOUND(SrcBeddoesData%DQP,1) - i1_u = UBOUND(SrcBeddoesData%DQP,1) - i2_l = LBOUND(SrcBeddoesData%DQP,2) - i2_u = UBOUND(SrcBeddoesData%DQP,2) - IF (.NOT. ALLOCATED(DstBeddoesData%DQP)) THEN - ALLOCATE(DstBeddoesData%DQP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%DQP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%DQP = SrcBeddoesData%DQP -ENDIF -IF (ALLOCATED(SrcBeddoesData%DQP1)) THEN - i1_l = LBOUND(SrcBeddoesData%DQP1,1) - i1_u = UBOUND(SrcBeddoesData%DQP1,1) - i2_l = LBOUND(SrcBeddoesData%DQP1,2) - i2_u = UBOUND(SrcBeddoesData%DQP1,2) - IF (.NOT. ALLOCATED(DstBeddoesData%DQP1)) THEN - ALLOCATE(DstBeddoesData%DQP1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%DQP1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%DQP1 = SrcBeddoesData%DQP1 -ENDIF - DstBeddoesData%DS = SrcBeddoesData%DS - DstBeddoesData%FK = SrcBeddoesData%FK - DstBeddoesData%FP = SrcBeddoesData%FP - DstBeddoesData%FPC = SrcBeddoesData%FPC -IF (ALLOCATED(SrcBeddoesData%FSP)) THEN - i1_l = LBOUND(SrcBeddoesData%FSP,1) - i1_u = UBOUND(SrcBeddoesData%FSP,1) - i2_l = LBOUND(SrcBeddoesData%FSP,2) - i2_u = UBOUND(SrcBeddoesData%FSP,2) - IF (.NOT. ALLOCATED(DstBeddoesData%FSP)) THEN - ALLOCATE(DstBeddoesData%FSP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%FSP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%FSP = SrcBeddoesData%FSP -ENDIF -IF (ALLOCATED(SrcBeddoesData%FSP1)) THEN - i1_l = LBOUND(SrcBeddoesData%FSP1,1) - i1_u = UBOUND(SrcBeddoesData%FSP1,1) - i2_l = LBOUND(SrcBeddoesData%FSP1,2) - i2_u = UBOUND(SrcBeddoesData%FSP1,2) - IF (.NOT. ALLOCATED(DstBeddoesData%FSP1)) THEN - ALLOCATE(DstBeddoesData%FSP1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%FSP1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%FSP1 = SrcBeddoesData%FSP1 -ENDIF -IF (ALLOCATED(SrcBeddoesData%FSPC)) THEN - i1_l = LBOUND(SrcBeddoesData%FSPC,1) - i1_u = UBOUND(SrcBeddoesData%FSPC,1) - i2_l = LBOUND(SrcBeddoesData%FSPC,2) - i2_u = UBOUND(SrcBeddoesData%FSPC,2) - IF (.NOT. ALLOCATED(DstBeddoesData%FSPC)) THEN - ALLOCATE(DstBeddoesData%FSPC(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%FSPC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%FSPC = SrcBeddoesData%FSPC -ENDIF -IF (ALLOCATED(SrcBeddoesData%FSPC1)) THEN - i1_l = LBOUND(SrcBeddoesData%FSPC1,1) - i1_u = UBOUND(SrcBeddoesData%FSPC1,1) - i2_l = LBOUND(SrcBeddoesData%FSPC1,2) - i2_u = UBOUND(SrcBeddoesData%FSPC1,2) - IF (.NOT. ALLOCATED(DstBeddoesData%FSPC1)) THEN - ALLOCATE(DstBeddoesData%FSPC1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%FSPC1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%FSPC1 = SrcBeddoesData%FSPC1 -ENDIF -IF (ALLOCATED(SrcBeddoesData%FTB)) THEN - i1_l = LBOUND(SrcBeddoesData%FTB,1) - i1_u = UBOUND(SrcBeddoesData%FTB,1) - i2_l = LBOUND(SrcBeddoesData%FTB,2) - i2_u = UBOUND(SrcBeddoesData%FTB,2) - i3_l = LBOUND(SrcBeddoesData%FTB,3) - i3_u = UBOUND(SrcBeddoesData%FTB,3) - IF (.NOT. ALLOCATED(DstBeddoesData%FTB)) THEN - ALLOCATE(DstBeddoesData%FTB(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%FTB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%FTB = SrcBeddoesData%FTB -ENDIF -IF (ALLOCATED(SrcBeddoesData%FTBC)) THEN - i1_l = LBOUND(SrcBeddoesData%FTBC,1) - i1_u = UBOUND(SrcBeddoesData%FTBC,1) - i2_l = LBOUND(SrcBeddoesData%FTBC,2) - i2_u = UBOUND(SrcBeddoesData%FTBC,2) - i3_l = LBOUND(SrcBeddoesData%FTBC,3) - i3_u = UBOUND(SrcBeddoesData%FTBC,3) - IF (.NOT. ALLOCATED(DstBeddoesData%FTBC)) THEN - ALLOCATE(DstBeddoesData%FTBC(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%FTBC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%FTBC = SrcBeddoesData%FTBC -ENDIF -IF (ALLOCATED(SrcBeddoesData%OLDCNV)) THEN - i1_l = LBOUND(SrcBeddoesData%OLDCNV,1) - i1_u = UBOUND(SrcBeddoesData%OLDCNV,1) - i2_l = LBOUND(SrcBeddoesData%OLDCNV,2) - i2_u = UBOUND(SrcBeddoesData%OLDCNV,2) - IF (.NOT. ALLOCATED(DstBeddoesData%OLDCNV)) THEN - ALLOCATE(DstBeddoesData%OLDCNV(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%OLDCNV.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%OLDCNV = SrcBeddoesData%OLDCNV -ENDIF -IF (ALLOCATED(SrcBeddoesData%OLDDF)) THEN - i1_l = LBOUND(SrcBeddoesData%OLDDF,1) - i1_u = UBOUND(SrcBeddoesData%OLDDF,1) - i2_l = LBOUND(SrcBeddoesData%OLDDF,2) - i2_u = UBOUND(SrcBeddoesData%OLDDF,2) - IF (.NOT. ALLOCATED(DstBeddoesData%OLDDF)) THEN - ALLOCATE(DstBeddoesData%OLDDF(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%OLDDF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%OLDDF = SrcBeddoesData%OLDDF -ENDIF -IF (ALLOCATED(SrcBeddoesData%OLDDFC)) THEN - i1_l = LBOUND(SrcBeddoesData%OLDDFC,1) - i1_u = UBOUND(SrcBeddoesData%OLDDFC,1) - i2_l = LBOUND(SrcBeddoesData%OLDDFC,2) - i2_u = UBOUND(SrcBeddoesData%OLDDFC,2) - IF (.NOT. ALLOCATED(DstBeddoesData%OLDDFC)) THEN - ALLOCATE(DstBeddoesData%OLDDFC(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%OLDDFC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%OLDDFC = SrcBeddoesData%OLDDFC -ENDIF -IF (ALLOCATED(SrcBeddoesData%OLDDN)) THEN - i1_l = LBOUND(SrcBeddoesData%OLDDN,1) - i1_u = UBOUND(SrcBeddoesData%OLDDN,1) - i2_l = LBOUND(SrcBeddoesData%OLDDN,2) - i2_u = UBOUND(SrcBeddoesData%OLDDN,2) - IF (.NOT. ALLOCATED(DstBeddoesData%OLDDN)) THEN - ALLOCATE(DstBeddoesData%OLDDN(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%OLDDN.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%OLDDN = SrcBeddoesData%OLDDN -ENDIF -IF (ALLOCATED(SrcBeddoesData%OLDDPP)) THEN - i1_l = LBOUND(SrcBeddoesData%OLDDPP,1) - i1_u = UBOUND(SrcBeddoesData%OLDDPP,1) - i2_l = LBOUND(SrcBeddoesData%OLDDPP,2) - i2_u = UBOUND(SrcBeddoesData%OLDDPP,2) - IF (.NOT. ALLOCATED(DstBeddoesData%OLDDPP)) THEN - ALLOCATE(DstBeddoesData%OLDDPP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%OLDDPP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%OLDDPP = SrcBeddoesData%OLDDPP -ENDIF -IF (ALLOCATED(SrcBeddoesData%OLDDQ)) THEN - i1_l = LBOUND(SrcBeddoesData%OLDDQ,1) - i1_u = UBOUND(SrcBeddoesData%OLDDQ,1) - i2_l = LBOUND(SrcBeddoesData%OLDDQ,2) - i2_u = UBOUND(SrcBeddoesData%OLDDQ,2) - IF (.NOT. ALLOCATED(DstBeddoesData%OLDDQ)) THEN - ALLOCATE(DstBeddoesData%OLDDQ(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%OLDDQ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%OLDDQ = SrcBeddoesData%OLDDQ -ENDIF -IF (ALLOCATED(SrcBeddoesData%OLDTAU)) THEN - i1_l = LBOUND(SrcBeddoesData%OLDTAU,1) - i1_u = UBOUND(SrcBeddoesData%OLDTAU,1) - i2_l = LBOUND(SrcBeddoesData%OLDTAU,2) - i2_u = UBOUND(SrcBeddoesData%OLDTAU,2) - IF (.NOT. ALLOCATED(DstBeddoesData%OLDTAU)) THEN - ALLOCATE(DstBeddoesData%OLDTAU(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%OLDTAU.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%OLDTAU = SrcBeddoesData%OLDTAU -ENDIF -IF (ALLOCATED(SrcBeddoesData%OLDXN)) THEN - i1_l = LBOUND(SrcBeddoesData%OLDXN,1) - i1_u = UBOUND(SrcBeddoesData%OLDXN,1) - i2_l = LBOUND(SrcBeddoesData%OLDXN,2) - i2_u = UBOUND(SrcBeddoesData%OLDXN,2) - IF (.NOT. ALLOCATED(DstBeddoesData%OLDXN)) THEN - ALLOCATE(DstBeddoesData%OLDXN(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%OLDXN.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%OLDXN = SrcBeddoesData%OLDXN -ENDIF -IF (ALLOCATED(SrcBeddoesData%OLDYN)) THEN - i1_l = LBOUND(SrcBeddoesData%OLDYN,1) - i1_u = UBOUND(SrcBeddoesData%OLDYN,1) - i2_l = LBOUND(SrcBeddoesData%OLDYN,2) - i2_u = UBOUND(SrcBeddoesData%OLDYN,2) - IF (.NOT. ALLOCATED(DstBeddoesData%OLDYN)) THEN - ALLOCATE(DstBeddoesData%OLDYN(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%OLDYN.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%OLDYN = SrcBeddoesData%OLDYN -ENDIF -IF (ALLOCATED(SrcBeddoesData%QX)) THEN - i1_l = LBOUND(SrcBeddoesData%QX,1) - i1_u = UBOUND(SrcBeddoesData%QX,1) - i2_l = LBOUND(SrcBeddoesData%QX,2) - i2_u = UBOUND(SrcBeddoesData%QX,2) - IF (.NOT. ALLOCATED(DstBeddoesData%QX)) THEN - ALLOCATE(DstBeddoesData%QX(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%QX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%QX = SrcBeddoesData%QX -ENDIF -IF (ALLOCATED(SrcBeddoesData%QX1)) THEN - i1_l = LBOUND(SrcBeddoesData%QX1,1) - i1_u = UBOUND(SrcBeddoesData%QX1,1) - i2_l = LBOUND(SrcBeddoesData%QX1,2) - i2_u = UBOUND(SrcBeddoesData%QX1,2) - IF (.NOT. ALLOCATED(DstBeddoesData%QX1)) THEN - ALLOCATE(DstBeddoesData%QX1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%QX1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%QX1 = SrcBeddoesData%QX1 -ENDIF -IF (ALLOCATED(SrcBeddoesData%TAU)) THEN - i1_l = LBOUND(SrcBeddoesData%TAU,1) - i1_u = UBOUND(SrcBeddoesData%TAU,1) - i2_l = LBOUND(SrcBeddoesData%TAU,2) - i2_u = UBOUND(SrcBeddoesData%TAU,2) - IF (.NOT. ALLOCATED(DstBeddoesData%TAU)) THEN - ALLOCATE(DstBeddoesData%TAU(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%TAU.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%TAU = SrcBeddoesData%TAU -ENDIF -IF (ALLOCATED(SrcBeddoesData%XN)) THEN - i1_l = LBOUND(SrcBeddoesData%XN,1) - i1_u = UBOUND(SrcBeddoesData%XN,1) - i2_l = LBOUND(SrcBeddoesData%XN,2) - i2_u = UBOUND(SrcBeddoesData%XN,2) - IF (.NOT. ALLOCATED(DstBeddoesData%XN)) THEN - ALLOCATE(DstBeddoesData%XN(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%XN.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%XN = SrcBeddoesData%XN -ENDIF -IF (ALLOCATED(SrcBeddoesData%YN)) THEN - i1_l = LBOUND(SrcBeddoesData%YN,1) - i1_u = UBOUND(SrcBeddoesData%YN,1) - i2_l = LBOUND(SrcBeddoesData%YN,2) - i2_u = UBOUND(SrcBeddoesData%YN,2) - IF (.NOT. ALLOCATED(DstBeddoesData%YN)) THEN - ALLOCATE(DstBeddoesData%YN(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%YN.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%YN = SrcBeddoesData%YN -ENDIF - DstBeddoesData%SHIFT = SrcBeddoesData%SHIFT - DstBeddoesData%VOR = SrcBeddoesData%VOR - END SUBROUTINE AD14_CopyBeddoes - - SUBROUTINE AD14_DestroyBeddoes( BeddoesData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(Beddoes), INTENT(INOUT) :: BeddoesData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyBeddoes' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(BeddoesData%ADOT)) THEN - DEALLOCATE(BeddoesData%ADOT) -ENDIF -IF (ALLOCATED(BeddoesData%ADOT1)) THEN - DEALLOCATE(BeddoesData%ADOT1) -ENDIF -IF (ALLOCATED(BeddoesData%AFE)) THEN - DEALLOCATE(BeddoesData%AFE) -ENDIF -IF (ALLOCATED(BeddoesData%AFE1)) THEN - DEALLOCATE(BeddoesData%AFE1) -ENDIF -IF (ALLOCATED(BeddoesData%ANE)) THEN - DEALLOCATE(BeddoesData%ANE) -ENDIF -IF (ALLOCATED(BeddoesData%ANE1)) THEN - DEALLOCATE(BeddoesData%ANE1) -ENDIF -IF (ALLOCATED(BeddoesData%AOD)) THEN - DEALLOCATE(BeddoesData%AOD) -ENDIF -IF (ALLOCATED(BeddoesData%AOL)) THEN - DEALLOCATE(BeddoesData%AOL) -ENDIF -IF (ALLOCATED(BeddoesData%BEDSEP)) THEN - DEALLOCATE(BeddoesData%BEDSEP) -ENDIF -IF (ALLOCATED(BeddoesData%OLDSEP)) THEN - DEALLOCATE(BeddoesData%OLDSEP) -ENDIF -IF (ALLOCATED(BeddoesData%CDO)) THEN - DEALLOCATE(BeddoesData%CDO) -ENDIF -IF (ALLOCATED(BeddoesData%CNA)) THEN - DEALLOCATE(BeddoesData%CNA) -ENDIF -IF (ALLOCATED(BeddoesData%CNP)) THEN - DEALLOCATE(BeddoesData%CNP) -ENDIF -IF (ALLOCATED(BeddoesData%CNP1)) THEN - DEALLOCATE(BeddoesData%CNP1) -ENDIF -IF (ALLOCATED(BeddoesData%CNPD)) THEN - DEALLOCATE(BeddoesData%CNPD) -ENDIF -IF (ALLOCATED(BeddoesData%CNPD1)) THEN - DEALLOCATE(BeddoesData%CNPD1) -ENDIF -IF (ALLOCATED(BeddoesData%CNPOT)) THEN - DEALLOCATE(BeddoesData%CNPOT) -ENDIF -IF (ALLOCATED(BeddoesData%CNPOT1)) THEN - DEALLOCATE(BeddoesData%CNPOT1) -ENDIF -IF (ALLOCATED(BeddoesData%CNS)) THEN - DEALLOCATE(BeddoesData%CNS) -ENDIF -IF (ALLOCATED(BeddoesData%CNSL)) THEN - DEALLOCATE(BeddoesData%CNSL) -ENDIF -IF (ALLOCATED(BeddoesData%CNV)) THEN - DEALLOCATE(BeddoesData%CNV) -ENDIF -IF (ALLOCATED(BeddoesData%CVN)) THEN - DEALLOCATE(BeddoesData%CVN) -ENDIF -IF (ALLOCATED(BeddoesData%CVN1)) THEN - DEALLOCATE(BeddoesData%CVN1) -ENDIF -IF (ALLOCATED(BeddoesData%DF)) THEN - DEALLOCATE(BeddoesData%DF) -ENDIF -IF (ALLOCATED(BeddoesData%DFAFE)) THEN - DEALLOCATE(BeddoesData%DFAFE) -ENDIF -IF (ALLOCATED(BeddoesData%DFAFE1)) THEN - DEALLOCATE(BeddoesData%DFAFE1) -ENDIF -IF (ALLOCATED(BeddoesData%DFC)) THEN - DEALLOCATE(BeddoesData%DFC) -ENDIF -IF (ALLOCATED(BeddoesData%DN)) THEN - DEALLOCATE(BeddoesData%DN) -ENDIF -IF (ALLOCATED(BeddoesData%DPP)) THEN - DEALLOCATE(BeddoesData%DPP) -ENDIF -IF (ALLOCATED(BeddoesData%DQ)) THEN - DEALLOCATE(BeddoesData%DQ) -ENDIF -IF (ALLOCATED(BeddoesData%DQP)) THEN - DEALLOCATE(BeddoesData%DQP) -ENDIF -IF (ALLOCATED(BeddoesData%DQP1)) THEN - DEALLOCATE(BeddoesData%DQP1) -ENDIF -IF (ALLOCATED(BeddoesData%FSP)) THEN - DEALLOCATE(BeddoesData%FSP) -ENDIF -IF (ALLOCATED(BeddoesData%FSP1)) THEN - DEALLOCATE(BeddoesData%FSP1) -ENDIF -IF (ALLOCATED(BeddoesData%FSPC)) THEN - DEALLOCATE(BeddoesData%FSPC) -ENDIF -IF (ALLOCATED(BeddoesData%FSPC1)) THEN - DEALLOCATE(BeddoesData%FSPC1) -ENDIF -IF (ALLOCATED(BeddoesData%FTB)) THEN - DEALLOCATE(BeddoesData%FTB) -ENDIF -IF (ALLOCATED(BeddoesData%FTBC)) THEN - DEALLOCATE(BeddoesData%FTBC) -ENDIF -IF (ALLOCATED(BeddoesData%OLDCNV)) THEN - DEALLOCATE(BeddoesData%OLDCNV) -ENDIF -IF (ALLOCATED(BeddoesData%OLDDF)) THEN - DEALLOCATE(BeddoesData%OLDDF) -ENDIF -IF (ALLOCATED(BeddoesData%OLDDFC)) THEN - DEALLOCATE(BeddoesData%OLDDFC) -ENDIF -IF (ALLOCATED(BeddoesData%OLDDN)) THEN - DEALLOCATE(BeddoesData%OLDDN) -ENDIF -IF (ALLOCATED(BeddoesData%OLDDPP)) THEN - DEALLOCATE(BeddoesData%OLDDPP) -ENDIF -IF (ALLOCATED(BeddoesData%OLDDQ)) THEN - DEALLOCATE(BeddoesData%OLDDQ) -ENDIF -IF (ALLOCATED(BeddoesData%OLDTAU)) THEN - DEALLOCATE(BeddoesData%OLDTAU) -ENDIF -IF (ALLOCATED(BeddoesData%OLDXN)) THEN - DEALLOCATE(BeddoesData%OLDXN) -ENDIF -IF (ALLOCATED(BeddoesData%OLDYN)) THEN - DEALLOCATE(BeddoesData%OLDYN) -ENDIF -IF (ALLOCATED(BeddoesData%QX)) THEN - DEALLOCATE(BeddoesData%QX) -ENDIF -IF (ALLOCATED(BeddoesData%QX1)) THEN - DEALLOCATE(BeddoesData%QX1) -ENDIF -IF (ALLOCATED(BeddoesData%TAU)) THEN - DEALLOCATE(BeddoesData%TAU) -ENDIF -IF (ALLOCATED(BeddoesData%XN)) THEN - DEALLOCATE(BeddoesData%XN) -ENDIF -IF (ALLOCATED(BeddoesData%YN)) THEN - DEALLOCATE(BeddoesData%YN) -ENDIF - END SUBROUTINE AD14_DestroyBeddoes - - SUBROUTINE AD14_PackBeddoes( 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(Beddoes), 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 = 'AD14_PackBeddoes' - ! 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 ! ADOT allocated yes/no - IF ( ALLOCATED(InData%ADOT) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! ADOT upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%ADOT) ! ADOT - END IF - Int_BufSz = Int_BufSz + 1 ! ADOT1 allocated yes/no - IF ( ALLOCATED(InData%ADOT1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! ADOT1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%ADOT1) ! ADOT1 - END IF - Int_BufSz = Int_BufSz + 1 ! AFE allocated yes/no - IF ( ALLOCATED(InData%AFE) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! AFE upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AFE) ! AFE - END IF - Int_BufSz = Int_BufSz + 1 ! AFE1 allocated yes/no - IF ( ALLOCATED(InData%AFE1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! AFE1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AFE1) ! AFE1 - END IF - Re_BufSz = Re_BufSz + 1 ! AN - Int_BufSz = Int_BufSz + 1 ! ANE allocated yes/no - IF ( ALLOCATED(InData%ANE) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! ANE upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%ANE) ! ANE - END IF - Int_BufSz = Int_BufSz + 1 ! ANE1 allocated yes/no - IF ( ALLOCATED(InData%ANE1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! ANE1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%ANE1) ! ANE1 - END IF - Int_BufSz = Int_BufSz + 1 ! AOD allocated yes/no - IF ( ALLOCATED(InData%AOD) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! AOD upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AOD) ! AOD - END IF - Int_BufSz = Int_BufSz + 1 ! AOL allocated yes/no - IF ( ALLOCATED(InData%AOL) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! AOL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AOL) ! AOL - END IF - Int_BufSz = Int_BufSz + 1 ! BEDSEP allocated yes/no - IF ( ALLOCATED(InData%BEDSEP) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BEDSEP upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%BEDSEP) ! BEDSEP - END IF - Int_BufSz = Int_BufSz + 1 ! OLDSEP allocated yes/no - IF ( ALLOCATED(InData%OLDSEP) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! OLDSEP upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%OLDSEP) ! OLDSEP - END IF - Re_BufSz = Re_BufSz + 1 ! CC - Int_BufSz = Int_BufSz + 1 ! CDO allocated yes/no - IF ( ALLOCATED(InData%CDO) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! CDO upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CDO) ! CDO - END IF - Re_BufSz = Re_BufSz + 1 ! CMI - Re_BufSz = Re_BufSz + 1 ! CMQ - Re_BufSz = Re_BufSz + 1 ! CN - Int_BufSz = Int_BufSz + 1 ! CNA allocated yes/no - IF ( ALLOCATED(InData%CNA) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! CNA upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CNA) ! CNA - END IF - Re_BufSz = Re_BufSz + 1 ! CNCP - Re_BufSz = Re_BufSz + 1 ! CNIQ - Int_BufSz = Int_BufSz + 1 ! CNP allocated yes/no - IF ( ALLOCATED(InData%CNP) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! CNP upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CNP) ! CNP - END IF - Int_BufSz = Int_BufSz + 1 ! CNP1 allocated yes/no - IF ( ALLOCATED(InData%CNP1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! CNP1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CNP1) ! CNP1 - END IF - Int_BufSz = Int_BufSz + 1 ! CNPD allocated yes/no - IF ( ALLOCATED(InData%CNPD) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! CNPD upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CNPD) ! CNPD - END IF - Int_BufSz = Int_BufSz + 1 ! CNPD1 allocated yes/no - IF ( ALLOCATED(InData%CNPD1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! CNPD1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CNPD1) ! CNPD1 - END IF - Int_BufSz = Int_BufSz + 1 ! CNPOT allocated yes/no - IF ( ALLOCATED(InData%CNPOT) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! CNPOT upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CNPOT) ! CNPOT - END IF - Int_BufSz = Int_BufSz + 1 ! CNPOT1 allocated yes/no - IF ( ALLOCATED(InData%CNPOT1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! CNPOT1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CNPOT1) ! CNPOT1 - END IF - Int_BufSz = Int_BufSz + 1 ! CNS allocated yes/no - IF ( ALLOCATED(InData%CNS) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! CNS upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CNS) ! CNS - END IF - Int_BufSz = Int_BufSz + 1 ! CNSL allocated yes/no - IF ( ALLOCATED(InData%CNSL) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! CNSL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CNSL) ! CNSL - END IF - Int_BufSz = Int_BufSz + 1 ! CNV allocated yes/no - IF ( ALLOCATED(InData%CNV) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! CNV upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CNV) ! CNV - END IF - Int_BufSz = Int_BufSz + 1 ! CVN allocated yes/no - IF ( ALLOCATED(InData%CVN) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! CVN upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CVN) ! CVN - END IF - Int_BufSz = Int_BufSz + 1 ! CVN1 allocated yes/no - IF ( ALLOCATED(InData%CVN1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! CVN1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CVN1) ! CVN1 - END IF - Int_BufSz = Int_BufSz + 1 ! DF allocated yes/no - IF ( ALLOCATED(InData%DF) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! DF upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%DF) ! DF - END IF - Int_BufSz = Int_BufSz + 1 ! DFAFE allocated yes/no - IF ( ALLOCATED(InData%DFAFE) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! DFAFE upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%DFAFE) ! DFAFE - END IF - Int_BufSz = Int_BufSz + 1 ! DFAFE1 allocated yes/no - IF ( ALLOCATED(InData%DFAFE1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! DFAFE1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%DFAFE1) ! DFAFE1 - END IF - Int_BufSz = Int_BufSz + 1 ! DFC allocated yes/no - IF ( ALLOCATED(InData%DFC) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! DFC upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%DFC) ! DFC - END IF - Int_BufSz = Int_BufSz + 1 ! DN allocated yes/no - IF ( ALLOCATED(InData%DN) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! DN upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%DN) ! DN - END IF - Int_BufSz = Int_BufSz + 1 ! DPP allocated yes/no - IF ( ALLOCATED(InData%DPP) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! DPP upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%DPP) ! DPP - END IF - Int_BufSz = Int_BufSz + 1 ! DQ allocated yes/no - IF ( ALLOCATED(InData%DQ) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! DQ upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%DQ) ! DQ - END IF - Int_BufSz = Int_BufSz + 1 ! DQP allocated yes/no - IF ( ALLOCATED(InData%DQP) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! DQP upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%DQP) ! DQP - END IF - Int_BufSz = Int_BufSz + 1 ! DQP1 allocated yes/no - IF ( ALLOCATED(InData%DQP1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! DQP1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%DQP1) ! DQP1 - END IF - Re_BufSz = Re_BufSz + 1 ! DS - Re_BufSz = Re_BufSz + 1 ! FK - Re_BufSz = Re_BufSz + 1 ! FP - Re_BufSz = Re_BufSz + 1 ! FPC - Int_BufSz = Int_BufSz + 1 ! FSP allocated yes/no - IF ( ALLOCATED(InData%FSP) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! FSP upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%FSP) ! FSP - END IF - Int_BufSz = Int_BufSz + 1 ! FSP1 allocated yes/no - IF ( ALLOCATED(InData%FSP1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! FSP1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%FSP1) ! FSP1 - END IF - Int_BufSz = Int_BufSz + 1 ! FSPC allocated yes/no - IF ( ALLOCATED(InData%FSPC) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! FSPC upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%FSPC) ! FSPC - END IF - Int_BufSz = Int_BufSz + 1 ! FSPC1 allocated yes/no - IF ( ALLOCATED(InData%FSPC1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! FSPC1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%FSPC1) ! FSPC1 - END IF - Int_BufSz = Int_BufSz + 1 ! FTB allocated yes/no - IF ( ALLOCATED(InData%FTB) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! FTB upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%FTB) ! FTB - END IF - Int_BufSz = Int_BufSz + 1 ! FTBC allocated yes/no - IF ( ALLOCATED(InData%FTBC) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! FTBC upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%FTBC) ! FTBC - END IF - Int_BufSz = Int_BufSz + 1 ! OLDCNV allocated yes/no - IF ( ALLOCATED(InData%OLDCNV) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! OLDCNV upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%OLDCNV) ! OLDCNV - END IF - Int_BufSz = Int_BufSz + 1 ! OLDDF allocated yes/no - IF ( ALLOCATED(InData%OLDDF) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! OLDDF upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%OLDDF) ! OLDDF - END IF - Int_BufSz = Int_BufSz + 1 ! OLDDFC allocated yes/no - IF ( ALLOCATED(InData%OLDDFC) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! OLDDFC upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%OLDDFC) ! OLDDFC - END IF - Int_BufSz = Int_BufSz + 1 ! OLDDN allocated yes/no - IF ( ALLOCATED(InData%OLDDN) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! OLDDN upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%OLDDN) ! OLDDN - END IF - Int_BufSz = Int_BufSz + 1 ! OLDDPP allocated yes/no - IF ( ALLOCATED(InData%OLDDPP) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! OLDDPP upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%OLDDPP) ! OLDDPP - END IF - Int_BufSz = Int_BufSz + 1 ! OLDDQ allocated yes/no - IF ( ALLOCATED(InData%OLDDQ) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! OLDDQ upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%OLDDQ) ! OLDDQ - END IF - Int_BufSz = Int_BufSz + 1 ! OLDTAU allocated yes/no - IF ( ALLOCATED(InData%OLDTAU) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! OLDTAU upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%OLDTAU) ! OLDTAU - END IF - Int_BufSz = Int_BufSz + 1 ! OLDXN allocated yes/no - IF ( ALLOCATED(InData%OLDXN) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! OLDXN upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%OLDXN) ! OLDXN - END IF - Int_BufSz = Int_BufSz + 1 ! OLDYN allocated yes/no - IF ( ALLOCATED(InData%OLDYN) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! OLDYN upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%OLDYN) ! OLDYN - END IF - Int_BufSz = Int_BufSz + 1 ! QX allocated yes/no - IF ( ALLOCATED(InData%QX) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! QX upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%QX) ! QX - END IF - Int_BufSz = Int_BufSz + 1 ! QX1 allocated yes/no - IF ( ALLOCATED(InData%QX1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! QX1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%QX1) ! QX1 - END IF - Int_BufSz = Int_BufSz + 1 ! TAU allocated yes/no - IF ( ALLOCATED(InData%TAU) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! TAU upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TAU) ! TAU - END IF - Int_BufSz = Int_BufSz + 1 ! XN allocated yes/no - IF ( ALLOCATED(InData%XN) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! XN upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%XN) ! XN - END IF - Int_BufSz = Int_BufSz + 1 ! YN allocated yes/no - IF ( ALLOCATED(InData%YN) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! YN upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%YN) ! YN - END IF - Int_BufSz = Int_BufSz + 1 ! SHIFT - Int_BufSz = Int_BufSz + 1 ! VOR - 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%ADOT) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ADOT,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ADOT,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ADOT,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ADOT,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%ADOT,2), UBOUND(InData%ADOT,2) - DO i1 = LBOUND(InData%ADOT,1), UBOUND(InData%ADOT,1) - ReKiBuf(Re_Xferred) = InData%ADOT(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ADOT1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ADOT1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ADOT1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ADOT1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ADOT1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%ADOT1,2), UBOUND(InData%ADOT1,2) - DO i1 = LBOUND(InData%ADOT1,1), UBOUND(InData%ADOT1,1) - ReKiBuf(Re_Xferred) = InData%ADOT1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AFE) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AFE,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AFE,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AFE,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AFE,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%AFE,2), UBOUND(InData%AFE,2) - DO i1 = LBOUND(InData%AFE,1), UBOUND(InData%AFE,1) - ReKiBuf(Re_Xferred) = InData%AFE(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AFE1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AFE1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AFE1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AFE1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AFE1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%AFE1,2), UBOUND(InData%AFE1,2) - DO i1 = LBOUND(InData%AFE1,1), UBOUND(InData%AFE1,1) - ReKiBuf(Re_Xferred) = InData%AFE1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - ReKiBuf(Re_Xferred) = InData%AN - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%ANE) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ANE,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ANE,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ANE,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ANE,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%ANE,2), UBOUND(InData%ANE,2) - DO i1 = LBOUND(InData%ANE,1), UBOUND(InData%ANE,1) - ReKiBuf(Re_Xferred) = InData%ANE(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ANE1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ANE1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ANE1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ANE1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ANE1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%ANE1,2), UBOUND(InData%ANE1,2) - DO i1 = LBOUND(InData%ANE1,1), UBOUND(InData%ANE1,1) - ReKiBuf(Re_Xferred) = InData%ANE1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AOD) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AOD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AOD,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AOD,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AOD,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%AOD,2), UBOUND(InData%AOD,2) - DO i1 = LBOUND(InData%AOD,1), UBOUND(InData%AOD,1) - ReKiBuf(Re_Xferred) = InData%AOD(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AOL) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AOL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AOL,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AOL,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AOL,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%AOL,2), UBOUND(InData%AOL,2) - DO i1 = LBOUND(InData%AOL,1), UBOUND(InData%AOL,1) - ReKiBuf(Re_Xferred) = InData%AOL(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BEDSEP) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BEDSEP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BEDSEP,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BEDSEP,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BEDSEP,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%BEDSEP,2), UBOUND(InData%BEDSEP,2) - DO i1 = LBOUND(InData%BEDSEP,1), UBOUND(InData%BEDSEP,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%BEDSEP(i1,i2), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%OLDSEP) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OLDSEP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OLDSEP,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OLDSEP,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OLDSEP,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%OLDSEP,2), UBOUND(InData%OLDSEP,2) - DO i1 = LBOUND(InData%OLDSEP,1), UBOUND(InData%OLDSEP,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%OLDSEP(i1,i2), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - ReKiBuf(Re_Xferred) = InData%CC - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%CDO) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CDO,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CDO,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CDO,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CDO,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%CDO,2), UBOUND(InData%CDO,2) - DO i1 = LBOUND(InData%CDO,1), UBOUND(InData%CDO,1) - ReKiBuf(Re_Xferred) = InData%CDO(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - ReKiBuf(Re_Xferred) = InData%CMI - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%CMQ - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%CN - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%CNA) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CNA,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CNA,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CNA,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CNA,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%CNA,2), UBOUND(InData%CNA,2) - DO i1 = LBOUND(InData%CNA,1), UBOUND(InData%CNA,1) - ReKiBuf(Re_Xferred) = InData%CNA(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - ReKiBuf(Re_Xferred) = InData%CNCP - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%CNIQ - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%CNP) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CNP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CNP,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CNP,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CNP,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%CNP,2), UBOUND(InData%CNP,2) - DO i1 = LBOUND(InData%CNP,1), UBOUND(InData%CNP,1) - ReKiBuf(Re_Xferred) = InData%CNP(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CNP1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CNP1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CNP1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CNP1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CNP1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%CNP1,2), UBOUND(InData%CNP1,2) - DO i1 = LBOUND(InData%CNP1,1), UBOUND(InData%CNP1,1) - ReKiBuf(Re_Xferred) = InData%CNP1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CNPD) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CNPD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CNPD,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CNPD,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CNPD,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%CNPD,2), UBOUND(InData%CNPD,2) - DO i1 = LBOUND(InData%CNPD,1), UBOUND(InData%CNPD,1) - ReKiBuf(Re_Xferred) = InData%CNPD(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CNPD1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CNPD1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CNPD1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CNPD1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CNPD1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%CNPD1,2), UBOUND(InData%CNPD1,2) - DO i1 = LBOUND(InData%CNPD1,1), UBOUND(InData%CNPD1,1) - ReKiBuf(Re_Xferred) = InData%CNPD1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CNPOT) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CNPOT,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CNPOT,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CNPOT,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CNPOT,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%CNPOT,2), UBOUND(InData%CNPOT,2) - DO i1 = LBOUND(InData%CNPOT,1), UBOUND(InData%CNPOT,1) - ReKiBuf(Re_Xferred) = InData%CNPOT(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CNPOT1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CNPOT1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CNPOT1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CNPOT1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CNPOT1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%CNPOT1,2), UBOUND(InData%CNPOT1,2) - DO i1 = LBOUND(InData%CNPOT1,1), UBOUND(InData%CNPOT1,1) - ReKiBuf(Re_Xferred) = InData%CNPOT1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CNS) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CNS,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CNS,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CNS,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CNS,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%CNS,2), UBOUND(InData%CNS,2) - DO i1 = LBOUND(InData%CNS,1), UBOUND(InData%CNS,1) - ReKiBuf(Re_Xferred) = InData%CNS(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CNSL) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CNSL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CNSL,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CNSL,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CNSL,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%CNSL,2), UBOUND(InData%CNSL,2) - DO i1 = LBOUND(InData%CNSL,1), UBOUND(InData%CNSL,1) - ReKiBuf(Re_Xferred) = InData%CNSL(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CNV) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CNV,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CNV,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CNV,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CNV,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%CNV,2), UBOUND(InData%CNV,2) - DO i1 = LBOUND(InData%CNV,1), UBOUND(InData%CNV,1) - ReKiBuf(Re_Xferred) = InData%CNV(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CVN) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CVN,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CVN,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CVN,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CVN,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%CVN,2), UBOUND(InData%CVN,2) - DO i1 = LBOUND(InData%CVN,1), UBOUND(InData%CVN,1) - ReKiBuf(Re_Xferred) = InData%CVN(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CVN1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CVN1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CVN1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CVN1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CVN1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%CVN1,2), UBOUND(InData%CVN1,2) - DO i1 = LBOUND(InData%CVN1,1), UBOUND(InData%CVN1,1) - ReKiBuf(Re_Xferred) = InData%CVN1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%DF) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DF,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DF,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DF,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DF,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%DF,2), UBOUND(InData%DF,2) - DO i1 = LBOUND(InData%DF,1), UBOUND(InData%DF,1) - ReKiBuf(Re_Xferred) = InData%DF(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%DFAFE) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DFAFE,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DFAFE,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DFAFE,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DFAFE,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%DFAFE,2), UBOUND(InData%DFAFE,2) - DO i1 = LBOUND(InData%DFAFE,1), UBOUND(InData%DFAFE,1) - ReKiBuf(Re_Xferred) = InData%DFAFE(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%DFAFE1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DFAFE1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DFAFE1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DFAFE1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DFAFE1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%DFAFE1,2), UBOUND(InData%DFAFE1,2) - DO i1 = LBOUND(InData%DFAFE1,1), UBOUND(InData%DFAFE1,1) - ReKiBuf(Re_Xferred) = InData%DFAFE1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%DFC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DFC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DFC,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DFC,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DFC,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%DFC,2), UBOUND(InData%DFC,2) - DO i1 = LBOUND(InData%DFC,1), UBOUND(InData%DFC,1) - ReKiBuf(Re_Xferred) = InData%DFC(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%DN) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DN,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DN,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DN,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DN,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%DN,2), UBOUND(InData%DN,2) - DO i1 = LBOUND(InData%DN,1), UBOUND(InData%DN,1) - ReKiBuf(Re_Xferred) = InData%DN(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%DPP) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DPP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DPP,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DPP,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DPP,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%DPP,2), UBOUND(InData%DPP,2) - DO i1 = LBOUND(InData%DPP,1), UBOUND(InData%DPP,1) - ReKiBuf(Re_Xferred) = InData%DPP(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%DQ) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DQ,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DQ,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DQ,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DQ,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%DQ,2), UBOUND(InData%DQ,2) - DO i1 = LBOUND(InData%DQ,1), UBOUND(InData%DQ,1) - ReKiBuf(Re_Xferred) = InData%DQ(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%DQP) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DQP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DQP,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DQP,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DQP,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%DQP,2), UBOUND(InData%DQP,2) - DO i1 = LBOUND(InData%DQP,1), UBOUND(InData%DQP,1) - ReKiBuf(Re_Xferred) = InData%DQP(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%DQP1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DQP1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DQP1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DQP1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DQP1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%DQP1,2), UBOUND(InData%DQP1,2) - DO i1 = LBOUND(InData%DQP1,1), UBOUND(InData%DQP1,1) - ReKiBuf(Re_Xferred) = InData%DQP1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - ReKiBuf(Re_Xferred) = InData%DS - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%FK - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%FP - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%FPC - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%FSP) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FSP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FSP,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FSP,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FSP,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%FSP,2), UBOUND(InData%FSP,2) - DO i1 = LBOUND(InData%FSP,1), UBOUND(InData%FSP,1) - ReKiBuf(Re_Xferred) = InData%FSP(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%FSP1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FSP1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FSP1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FSP1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FSP1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%FSP1,2), UBOUND(InData%FSP1,2) - DO i1 = LBOUND(InData%FSP1,1), UBOUND(InData%FSP1,1) - ReKiBuf(Re_Xferred) = InData%FSP1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%FSPC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FSPC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FSPC,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FSPC,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FSPC,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%FSPC,2), UBOUND(InData%FSPC,2) - DO i1 = LBOUND(InData%FSPC,1), UBOUND(InData%FSPC,1) - ReKiBuf(Re_Xferred) = InData%FSPC(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%FSPC1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FSPC1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FSPC1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FSPC1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FSPC1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%FSPC1,2), UBOUND(InData%FSPC1,2) - DO i1 = LBOUND(InData%FSPC1,1), UBOUND(InData%FSPC1,1) - ReKiBuf(Re_Xferred) = InData%FSPC1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%FTB) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FTB,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FTB,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FTB,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FTB,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FTB,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FTB,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%FTB,3), UBOUND(InData%FTB,3) - DO i2 = LBOUND(InData%FTB,2), UBOUND(InData%FTB,2) - DO i1 = LBOUND(InData%FTB,1), UBOUND(InData%FTB,1) - ReKiBuf(Re_Xferred) = InData%FTB(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%FTBC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FTBC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FTBC,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FTBC,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FTBC,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FTBC,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FTBC,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%FTBC,3), UBOUND(InData%FTBC,3) - DO i2 = LBOUND(InData%FTBC,2), UBOUND(InData%FTBC,2) - DO i1 = LBOUND(InData%FTBC,1), UBOUND(InData%FTBC,1) - ReKiBuf(Re_Xferred) = InData%FTBC(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%OLDCNV) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OLDCNV,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OLDCNV,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OLDCNV,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OLDCNV,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%OLDCNV,2), UBOUND(InData%OLDCNV,2) - DO i1 = LBOUND(InData%OLDCNV,1), UBOUND(InData%OLDCNV,1) - ReKiBuf(Re_Xferred) = InData%OLDCNV(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%OLDDF) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OLDDF,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OLDDF,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OLDDF,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OLDDF,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%OLDDF,2), UBOUND(InData%OLDDF,2) - DO i1 = LBOUND(InData%OLDDF,1), UBOUND(InData%OLDDF,1) - ReKiBuf(Re_Xferred) = InData%OLDDF(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%OLDDFC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OLDDFC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OLDDFC,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OLDDFC,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OLDDFC,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%OLDDFC,2), UBOUND(InData%OLDDFC,2) - DO i1 = LBOUND(InData%OLDDFC,1), UBOUND(InData%OLDDFC,1) - ReKiBuf(Re_Xferred) = InData%OLDDFC(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%OLDDN) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OLDDN,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OLDDN,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OLDDN,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OLDDN,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%OLDDN,2), UBOUND(InData%OLDDN,2) - DO i1 = LBOUND(InData%OLDDN,1), UBOUND(InData%OLDDN,1) - ReKiBuf(Re_Xferred) = InData%OLDDN(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%OLDDPP) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OLDDPP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OLDDPP,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OLDDPP,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OLDDPP,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%OLDDPP,2), UBOUND(InData%OLDDPP,2) - DO i1 = LBOUND(InData%OLDDPP,1), UBOUND(InData%OLDDPP,1) - ReKiBuf(Re_Xferred) = InData%OLDDPP(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%OLDDQ) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OLDDQ,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OLDDQ,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OLDDQ,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OLDDQ,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%OLDDQ,2), UBOUND(InData%OLDDQ,2) - DO i1 = LBOUND(InData%OLDDQ,1), UBOUND(InData%OLDDQ,1) - ReKiBuf(Re_Xferred) = InData%OLDDQ(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%OLDTAU) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OLDTAU,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OLDTAU,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OLDTAU,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OLDTAU,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%OLDTAU,2), UBOUND(InData%OLDTAU,2) - DO i1 = LBOUND(InData%OLDTAU,1), UBOUND(InData%OLDTAU,1) - ReKiBuf(Re_Xferred) = InData%OLDTAU(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%OLDXN) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OLDXN,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OLDXN,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OLDXN,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OLDXN,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%OLDXN,2), UBOUND(InData%OLDXN,2) - DO i1 = LBOUND(InData%OLDXN,1), UBOUND(InData%OLDXN,1) - ReKiBuf(Re_Xferred) = InData%OLDXN(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%OLDYN) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OLDYN,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OLDYN,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OLDYN,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OLDYN,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%OLDYN,2), UBOUND(InData%OLDYN,2) - DO i1 = LBOUND(InData%OLDYN,1), UBOUND(InData%OLDYN,1) - ReKiBuf(Re_Xferred) = InData%OLDYN(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%QX) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%QX,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%QX,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%QX,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%QX,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%QX,2), UBOUND(InData%QX,2) - DO i1 = LBOUND(InData%QX,1), UBOUND(InData%QX,1) - ReKiBuf(Re_Xferred) = InData%QX(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%QX1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%QX1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%QX1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%QX1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%QX1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%QX1,2), UBOUND(InData%QX1,2) - DO i1 = LBOUND(InData%QX1,1), UBOUND(InData%QX1,1) - ReKiBuf(Re_Xferred) = InData%QX1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TAU) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TAU,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TAU,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TAU,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TAU,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%TAU,2), UBOUND(InData%TAU,2) - DO i1 = LBOUND(InData%TAU,1), UBOUND(InData%TAU,1) - ReKiBuf(Re_Xferred) = InData%TAU(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%XN) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%XN,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%XN,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%XN,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%XN,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%XN,2), UBOUND(InData%XN,2) - DO i1 = LBOUND(InData%XN,1), UBOUND(InData%XN,1) - ReKiBuf(Re_Xferred) = InData%XN(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%YN) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%YN,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%YN,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%YN,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%YN,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%YN,2), UBOUND(InData%YN,2) - DO i1 = LBOUND(InData%YN,1), UBOUND(InData%YN,1) - ReKiBuf(Re_Xferred) = InData%YN(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = TRANSFER(InData%SHIFT, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%VOR, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE AD14_PackBeddoes - - SUBROUTINE AD14_UnPackBeddoes( 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(Beddoes), 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 = 'AD14_UnPackBeddoes' - ! 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 ! ADOT not allocated - Int_Xferred = Int_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%ADOT)) DEALLOCATE(OutData%ADOT) - ALLOCATE(OutData%ADOT(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ADOT.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%ADOT,2), UBOUND(OutData%ADOT,2) - DO i1 = LBOUND(OutData%ADOT,1), UBOUND(OutData%ADOT,1) - OutData%ADOT(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ADOT1 not allocated - Int_Xferred = Int_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%ADOT1)) DEALLOCATE(OutData%ADOT1) - ALLOCATE(OutData%ADOT1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ADOT1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%ADOT1,2), UBOUND(OutData%ADOT1,2) - DO i1 = LBOUND(OutData%ADOT1,1), UBOUND(OutData%ADOT1,1) - OutData%ADOT1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AFE not allocated - Int_Xferred = Int_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%AFE)) DEALLOCATE(OutData%AFE) - ALLOCATE(OutData%AFE(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AFE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%AFE,2), UBOUND(OutData%AFE,2) - DO i1 = LBOUND(OutData%AFE,1), UBOUND(OutData%AFE,1) - OutData%AFE(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AFE1 not allocated - Int_Xferred = Int_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%AFE1)) DEALLOCATE(OutData%AFE1) - ALLOCATE(OutData%AFE1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AFE1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%AFE1,2), UBOUND(OutData%AFE1,2) - DO i1 = LBOUND(OutData%AFE1,1), UBOUND(OutData%AFE1,1) - OutData%AFE1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%AN = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ANE not allocated - Int_Xferred = Int_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%ANE)) DEALLOCATE(OutData%ANE) - ALLOCATE(OutData%ANE(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ANE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%ANE,2), UBOUND(OutData%ANE,2) - DO i1 = LBOUND(OutData%ANE,1), UBOUND(OutData%ANE,1) - OutData%ANE(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ANE1 not allocated - Int_Xferred = Int_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%ANE1)) DEALLOCATE(OutData%ANE1) - ALLOCATE(OutData%ANE1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ANE1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%ANE1,2), UBOUND(OutData%ANE1,2) - DO i1 = LBOUND(OutData%ANE1,1), UBOUND(OutData%ANE1,1) - OutData%ANE1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AOD not allocated - Int_Xferred = Int_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%AOD)) DEALLOCATE(OutData%AOD) - ALLOCATE(OutData%AOD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AOD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%AOD,2), UBOUND(OutData%AOD,2) - DO i1 = LBOUND(OutData%AOD,1), UBOUND(OutData%AOD,1) - OutData%AOD(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AOL not allocated - Int_Xferred = Int_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%AOL)) DEALLOCATE(OutData%AOL) - ALLOCATE(OutData%AOL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AOL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%AOL,2), UBOUND(OutData%AOL,2) - DO i1 = LBOUND(OutData%AOL,1), UBOUND(OutData%AOL,1) - OutData%AOL(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BEDSEP not allocated - Int_Xferred = Int_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%BEDSEP)) DEALLOCATE(OutData%BEDSEP) - ALLOCATE(OutData%BEDSEP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BEDSEP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%BEDSEP,2), UBOUND(OutData%BEDSEP,2) - DO i1 = LBOUND(OutData%BEDSEP,1), UBOUND(OutData%BEDSEP,1) - OutData%BEDSEP(i1,i2) = TRANSFER(IntKiBuf(Int_Xferred), OutData%BEDSEP(i1,i2)) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OLDSEP not allocated - Int_Xferred = Int_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%OLDSEP)) DEALLOCATE(OutData%OLDSEP) - ALLOCATE(OutData%OLDSEP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OLDSEP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%OLDSEP,2), UBOUND(OutData%OLDSEP,2) - DO i1 = LBOUND(OutData%OLDSEP,1), UBOUND(OutData%OLDSEP,1) - OutData%OLDSEP(i1,i2) = TRANSFER(IntKiBuf(Int_Xferred), OutData%OLDSEP(i1,i2)) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - OutData%CC = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CDO not allocated - Int_Xferred = Int_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%CDO)) DEALLOCATE(OutData%CDO) - ALLOCATE(OutData%CDO(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CDO.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%CDO,2), UBOUND(OutData%CDO,2) - DO i1 = LBOUND(OutData%CDO,1), UBOUND(OutData%CDO,1) - OutData%CDO(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%CMI = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%CMQ = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%CN = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CNA not allocated - Int_Xferred = Int_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%CNA)) DEALLOCATE(OutData%CNA) - ALLOCATE(OutData%CNA(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CNA.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%CNA,2), UBOUND(OutData%CNA,2) - DO i1 = LBOUND(OutData%CNA,1), UBOUND(OutData%CNA,1) - OutData%CNA(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%CNCP = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%CNIQ = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CNP not allocated - Int_Xferred = Int_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%CNP)) DEALLOCATE(OutData%CNP) - ALLOCATE(OutData%CNP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CNP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%CNP,2), UBOUND(OutData%CNP,2) - DO i1 = LBOUND(OutData%CNP,1), UBOUND(OutData%CNP,1) - OutData%CNP(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CNP1 not allocated - Int_Xferred = Int_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%CNP1)) DEALLOCATE(OutData%CNP1) - ALLOCATE(OutData%CNP1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CNP1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%CNP1,2), UBOUND(OutData%CNP1,2) - DO i1 = LBOUND(OutData%CNP1,1), UBOUND(OutData%CNP1,1) - OutData%CNP1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CNPD not allocated - Int_Xferred = Int_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%CNPD)) DEALLOCATE(OutData%CNPD) - ALLOCATE(OutData%CNPD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CNPD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%CNPD,2), UBOUND(OutData%CNPD,2) - DO i1 = LBOUND(OutData%CNPD,1), UBOUND(OutData%CNPD,1) - OutData%CNPD(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CNPD1 not allocated - Int_Xferred = Int_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%CNPD1)) DEALLOCATE(OutData%CNPD1) - ALLOCATE(OutData%CNPD1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CNPD1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%CNPD1,2), UBOUND(OutData%CNPD1,2) - DO i1 = LBOUND(OutData%CNPD1,1), UBOUND(OutData%CNPD1,1) - OutData%CNPD1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CNPOT not allocated - Int_Xferred = Int_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%CNPOT)) DEALLOCATE(OutData%CNPOT) - ALLOCATE(OutData%CNPOT(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CNPOT.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%CNPOT,2), UBOUND(OutData%CNPOT,2) - DO i1 = LBOUND(OutData%CNPOT,1), UBOUND(OutData%CNPOT,1) - OutData%CNPOT(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CNPOT1 not allocated - Int_Xferred = Int_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%CNPOT1)) DEALLOCATE(OutData%CNPOT1) - ALLOCATE(OutData%CNPOT1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CNPOT1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%CNPOT1,2), UBOUND(OutData%CNPOT1,2) - DO i1 = LBOUND(OutData%CNPOT1,1), UBOUND(OutData%CNPOT1,1) - OutData%CNPOT1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CNS not allocated - Int_Xferred = Int_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%CNS)) DEALLOCATE(OutData%CNS) - ALLOCATE(OutData%CNS(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CNS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%CNS,2), UBOUND(OutData%CNS,2) - DO i1 = LBOUND(OutData%CNS,1), UBOUND(OutData%CNS,1) - OutData%CNS(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CNSL not allocated - Int_Xferred = Int_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%CNSL)) DEALLOCATE(OutData%CNSL) - ALLOCATE(OutData%CNSL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CNSL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%CNSL,2), UBOUND(OutData%CNSL,2) - DO i1 = LBOUND(OutData%CNSL,1), UBOUND(OutData%CNSL,1) - OutData%CNSL(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CNV not allocated - Int_Xferred = Int_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%CNV)) DEALLOCATE(OutData%CNV) - ALLOCATE(OutData%CNV(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CNV.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%CNV,2), UBOUND(OutData%CNV,2) - DO i1 = LBOUND(OutData%CNV,1), UBOUND(OutData%CNV,1) - OutData%CNV(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CVN not allocated - Int_Xferred = Int_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%CVN)) DEALLOCATE(OutData%CVN) - ALLOCATE(OutData%CVN(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CVN.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%CVN,2), UBOUND(OutData%CVN,2) - DO i1 = LBOUND(OutData%CVN,1), UBOUND(OutData%CVN,1) - OutData%CVN(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CVN1 not allocated - Int_Xferred = Int_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%CVN1)) DEALLOCATE(OutData%CVN1) - ALLOCATE(OutData%CVN1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CVN1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%CVN1,2), UBOUND(OutData%CVN1,2) - DO i1 = LBOUND(OutData%CVN1,1), UBOUND(OutData%CVN1,1) - OutData%CVN1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DF not allocated - Int_Xferred = Int_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%DF)) DEALLOCATE(OutData%DF) - ALLOCATE(OutData%DF(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%DF,2), UBOUND(OutData%DF,2) - DO i1 = LBOUND(OutData%DF,1), UBOUND(OutData%DF,1) - OutData%DF(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DFAFE not allocated - Int_Xferred = Int_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%DFAFE)) DEALLOCATE(OutData%DFAFE) - ALLOCATE(OutData%DFAFE(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DFAFE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%DFAFE,2), UBOUND(OutData%DFAFE,2) - DO i1 = LBOUND(OutData%DFAFE,1), UBOUND(OutData%DFAFE,1) - OutData%DFAFE(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DFAFE1 not allocated - Int_Xferred = Int_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%DFAFE1)) DEALLOCATE(OutData%DFAFE1) - ALLOCATE(OutData%DFAFE1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DFAFE1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%DFAFE1,2), UBOUND(OutData%DFAFE1,2) - DO i1 = LBOUND(OutData%DFAFE1,1), UBOUND(OutData%DFAFE1,1) - OutData%DFAFE1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DFC not allocated - Int_Xferred = Int_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%DFC)) DEALLOCATE(OutData%DFC) - ALLOCATE(OutData%DFC(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DFC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%DFC,2), UBOUND(OutData%DFC,2) - DO i1 = LBOUND(OutData%DFC,1), UBOUND(OutData%DFC,1) - OutData%DFC(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DN not allocated - Int_Xferred = Int_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%DN)) DEALLOCATE(OutData%DN) - ALLOCATE(OutData%DN(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DN.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%DN,2), UBOUND(OutData%DN,2) - DO i1 = LBOUND(OutData%DN,1), UBOUND(OutData%DN,1) - OutData%DN(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DPP not allocated - Int_Xferred = Int_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%DPP)) DEALLOCATE(OutData%DPP) - ALLOCATE(OutData%DPP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DPP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%DPP,2), UBOUND(OutData%DPP,2) - DO i1 = LBOUND(OutData%DPP,1), UBOUND(OutData%DPP,1) - OutData%DPP(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DQ not allocated - Int_Xferred = Int_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%DQ)) DEALLOCATE(OutData%DQ) - ALLOCATE(OutData%DQ(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DQ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%DQ,2), UBOUND(OutData%DQ,2) - DO i1 = LBOUND(OutData%DQ,1), UBOUND(OutData%DQ,1) - OutData%DQ(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DQP not allocated - Int_Xferred = Int_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%DQP)) DEALLOCATE(OutData%DQP) - ALLOCATE(OutData%DQP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DQP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%DQP,2), UBOUND(OutData%DQP,2) - DO i1 = LBOUND(OutData%DQP,1), UBOUND(OutData%DQP,1) - OutData%DQP(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DQP1 not allocated - Int_Xferred = Int_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%DQP1)) DEALLOCATE(OutData%DQP1) - ALLOCATE(OutData%DQP1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DQP1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%DQP1,2), UBOUND(OutData%DQP1,2) - DO i1 = LBOUND(OutData%DQP1,1), UBOUND(OutData%DQP1,1) - OutData%DQP1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%DS = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%FK = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%FP = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%FPC = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FSP not allocated - Int_Xferred = Int_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%FSP)) DEALLOCATE(OutData%FSP) - ALLOCATE(OutData%FSP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FSP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%FSP,2), UBOUND(OutData%FSP,2) - DO i1 = LBOUND(OutData%FSP,1), UBOUND(OutData%FSP,1) - OutData%FSP(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FSP1 not allocated - Int_Xferred = Int_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%FSP1)) DEALLOCATE(OutData%FSP1) - ALLOCATE(OutData%FSP1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FSP1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%FSP1,2), UBOUND(OutData%FSP1,2) - DO i1 = LBOUND(OutData%FSP1,1), UBOUND(OutData%FSP1,1) - OutData%FSP1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FSPC not allocated - Int_Xferred = Int_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%FSPC)) DEALLOCATE(OutData%FSPC) - ALLOCATE(OutData%FSPC(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FSPC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%FSPC,2), UBOUND(OutData%FSPC,2) - DO i1 = LBOUND(OutData%FSPC,1), UBOUND(OutData%FSPC,1) - OutData%FSPC(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FSPC1 not allocated - Int_Xferred = Int_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%FSPC1)) DEALLOCATE(OutData%FSPC1) - ALLOCATE(OutData%FSPC1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FSPC1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%FSPC1,2), UBOUND(OutData%FSPC1,2) - DO i1 = LBOUND(OutData%FSPC1,1), UBOUND(OutData%FSPC1,1) - OutData%FSPC1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FTB not allocated - Int_Xferred = Int_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%FTB)) DEALLOCATE(OutData%FTB) - ALLOCATE(OutData%FTB(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%FTB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%FTB,3), UBOUND(OutData%FTB,3) - DO i2 = LBOUND(OutData%FTB,2), UBOUND(OutData%FTB,2) - DO i1 = LBOUND(OutData%FTB,1), UBOUND(OutData%FTB,1) - OutData%FTB(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 ! FTBC not allocated - Int_Xferred = Int_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%FTBC)) DEALLOCATE(OutData%FTBC) - ALLOCATE(OutData%FTBC(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%FTBC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%FTBC,3), UBOUND(OutData%FTBC,3) - DO i2 = LBOUND(OutData%FTBC,2), UBOUND(OutData%FTBC,2) - DO i1 = LBOUND(OutData%FTBC,1), UBOUND(OutData%FTBC,1) - OutData%FTBC(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 ! OLDCNV not allocated - Int_Xferred = Int_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%OLDCNV)) DEALLOCATE(OutData%OLDCNV) - ALLOCATE(OutData%OLDCNV(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OLDCNV.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%OLDCNV,2), UBOUND(OutData%OLDCNV,2) - DO i1 = LBOUND(OutData%OLDCNV,1), UBOUND(OutData%OLDCNV,1) - OutData%OLDCNV(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OLDDF not allocated - Int_Xferred = Int_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%OLDDF)) DEALLOCATE(OutData%OLDDF) - ALLOCATE(OutData%OLDDF(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OLDDF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%OLDDF,2), UBOUND(OutData%OLDDF,2) - DO i1 = LBOUND(OutData%OLDDF,1), UBOUND(OutData%OLDDF,1) - OutData%OLDDF(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OLDDFC not allocated - Int_Xferred = Int_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%OLDDFC)) DEALLOCATE(OutData%OLDDFC) - ALLOCATE(OutData%OLDDFC(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OLDDFC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%OLDDFC,2), UBOUND(OutData%OLDDFC,2) - DO i1 = LBOUND(OutData%OLDDFC,1), UBOUND(OutData%OLDDFC,1) - OutData%OLDDFC(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OLDDN not allocated - Int_Xferred = Int_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%OLDDN)) DEALLOCATE(OutData%OLDDN) - ALLOCATE(OutData%OLDDN(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OLDDN.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%OLDDN,2), UBOUND(OutData%OLDDN,2) - DO i1 = LBOUND(OutData%OLDDN,1), UBOUND(OutData%OLDDN,1) - OutData%OLDDN(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OLDDPP not allocated - Int_Xferred = Int_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%OLDDPP)) DEALLOCATE(OutData%OLDDPP) - ALLOCATE(OutData%OLDDPP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OLDDPP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%OLDDPP,2), UBOUND(OutData%OLDDPP,2) - DO i1 = LBOUND(OutData%OLDDPP,1), UBOUND(OutData%OLDDPP,1) - OutData%OLDDPP(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OLDDQ not allocated - Int_Xferred = Int_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%OLDDQ)) DEALLOCATE(OutData%OLDDQ) - ALLOCATE(OutData%OLDDQ(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OLDDQ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%OLDDQ,2), UBOUND(OutData%OLDDQ,2) - DO i1 = LBOUND(OutData%OLDDQ,1), UBOUND(OutData%OLDDQ,1) - OutData%OLDDQ(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OLDTAU not allocated - Int_Xferred = Int_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%OLDTAU)) DEALLOCATE(OutData%OLDTAU) - ALLOCATE(OutData%OLDTAU(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OLDTAU.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%OLDTAU,2), UBOUND(OutData%OLDTAU,2) - DO i1 = LBOUND(OutData%OLDTAU,1), UBOUND(OutData%OLDTAU,1) - OutData%OLDTAU(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OLDXN not allocated - Int_Xferred = Int_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%OLDXN)) DEALLOCATE(OutData%OLDXN) - ALLOCATE(OutData%OLDXN(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OLDXN.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%OLDXN,2), UBOUND(OutData%OLDXN,2) - DO i1 = LBOUND(OutData%OLDXN,1), UBOUND(OutData%OLDXN,1) - OutData%OLDXN(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OLDYN not allocated - Int_Xferred = Int_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%OLDYN)) DEALLOCATE(OutData%OLDYN) - ALLOCATE(OutData%OLDYN(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OLDYN.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%OLDYN,2), UBOUND(OutData%OLDYN,2) - DO i1 = LBOUND(OutData%OLDYN,1), UBOUND(OutData%OLDYN,1) - OutData%OLDYN(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! QX not allocated - Int_Xferred = Int_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%QX)) DEALLOCATE(OutData%QX) - ALLOCATE(OutData%QX(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%QX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%QX,2), UBOUND(OutData%QX,2) - DO i1 = LBOUND(OutData%QX,1), UBOUND(OutData%QX,1) - OutData%QX(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! QX1 not allocated - Int_Xferred = Int_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%QX1)) DEALLOCATE(OutData%QX1) - ALLOCATE(OutData%QX1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%QX1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%QX1,2), UBOUND(OutData%QX1,2) - DO i1 = LBOUND(OutData%QX1,1), UBOUND(OutData%QX1,1) - OutData%QX1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TAU not allocated - Int_Xferred = Int_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%TAU)) DEALLOCATE(OutData%TAU) - ALLOCATE(OutData%TAU(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TAU.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%TAU,2), UBOUND(OutData%TAU,2) - DO i1 = LBOUND(OutData%TAU,1), UBOUND(OutData%TAU,1) - OutData%TAU(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! XN not allocated - Int_Xferred = Int_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%XN)) DEALLOCATE(OutData%XN) - ALLOCATE(OutData%XN(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%XN.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%XN,2), UBOUND(OutData%XN,2) - DO i1 = LBOUND(OutData%XN,1), UBOUND(OutData%XN,1) - OutData%XN(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! YN not allocated - Int_Xferred = Int_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%YN)) DEALLOCATE(OutData%YN) - ALLOCATE(OutData%YN(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%YN.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%YN,2), UBOUND(OutData%YN,2) - DO i1 = LBOUND(OutData%YN,1), UBOUND(OutData%YN,1) - OutData%YN(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%SHIFT = TRANSFER(IntKiBuf(Int_Xferred), OutData%SHIFT) - Int_Xferred = Int_Xferred + 1 - OutData%VOR = TRANSFER(IntKiBuf(Int_Xferred), OutData%VOR) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE AD14_UnPackBeddoes - - SUBROUTINE AD14_CopyBeddoesParms( SrcBeddoesParmsData, DstBeddoesParmsData, CtrlCode, ErrStat, ErrMsg ) - TYPE(BeddoesParms), INTENT(IN) :: SrcBeddoesParmsData - TYPE(BeddoesParms), INTENT(INOUT) :: DstBeddoesParmsData - 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 = 'AD14_CopyBeddoesParms' -! - ErrStat = ErrID_None - ErrMsg = "" - DstBeddoesParmsData%AS = SrcBeddoesParmsData%AS - DstBeddoesParmsData%TF = SrcBeddoesParmsData%TF - DstBeddoesParmsData%TP = SrcBeddoesParmsData%TP - DstBeddoesParmsData%TV = SrcBeddoesParmsData%TV - DstBeddoesParmsData%TVL = SrcBeddoesParmsData%TVL - END SUBROUTINE AD14_CopyBeddoesParms - - SUBROUTINE AD14_DestroyBeddoesParms( BeddoesParmsData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(BeddoesParms), INTENT(INOUT) :: BeddoesParmsData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyBeddoesParms' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE AD14_DestroyBeddoesParms - - SUBROUTINE AD14_PackBeddoesParms( 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(BeddoesParms), 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 = 'AD14_PackBeddoesParms' - ! 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 ! AS - Re_BufSz = Re_BufSz + 1 ! TF - Re_BufSz = Re_BufSz + 1 ! TP - Re_BufSz = Re_BufSz + 1 ! TV - Re_BufSz = Re_BufSz + 1 ! TVL - 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%AS - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TF - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TP - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TV - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TVL - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AD14_PackBeddoesParms - - SUBROUTINE AD14_UnPackBeddoesParms( 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(BeddoesParms), 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 = 'AD14_UnPackBeddoesParms' - ! 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%AS = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TF = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TP = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TV = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TVL = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AD14_UnPackBeddoesParms - - SUBROUTINE AD14_CopyBladeParms( SrcBladeParmsData, DstBladeParmsData, CtrlCode, ErrStat, ErrMsg ) - TYPE(BladeParms), INTENT(IN) :: SrcBladeParmsData - TYPE(BladeParms), INTENT(INOUT) :: DstBladeParmsData - 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 = 'AD14_CopyBladeParms' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcBladeParmsData%C)) THEN - i1_l = LBOUND(SrcBladeParmsData%C,1) - i1_u = UBOUND(SrcBladeParmsData%C,1) - IF (.NOT. ALLOCATED(DstBladeParmsData%C)) THEN - ALLOCATE(DstBladeParmsData%C(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladeParmsData%C.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladeParmsData%C = SrcBladeParmsData%C -ENDIF -IF (ALLOCATED(SrcBladeParmsData%DR)) THEN - i1_l = LBOUND(SrcBladeParmsData%DR,1) - i1_u = UBOUND(SrcBladeParmsData%DR,1) - IF (.NOT. ALLOCATED(DstBladeParmsData%DR)) THEN - ALLOCATE(DstBladeParmsData%DR(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladeParmsData%DR.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladeParmsData%DR = SrcBladeParmsData%DR -ENDIF - DstBladeParmsData%R = SrcBladeParmsData%R - DstBladeParmsData%BladeLength = SrcBladeParmsData%BladeLength - END SUBROUTINE AD14_CopyBladeParms - - SUBROUTINE AD14_DestroyBladeParms( BladeParmsData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(BladeParms), INTENT(INOUT) :: BladeParmsData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyBladeParms' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(BladeParmsData%C)) THEN - DEALLOCATE(BladeParmsData%C) -ENDIF -IF (ALLOCATED(BladeParmsData%DR)) THEN - DEALLOCATE(BladeParmsData%DR) -ENDIF - END SUBROUTINE AD14_DestroyBladeParms - - SUBROUTINE AD14_PackBladeParms( 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(BladeParms), 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 = 'AD14_PackBladeParms' - ! 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 ! 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 ! DR allocated yes/no - IF ( ALLOCATED(InData%DR) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! DR upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%DR) ! DR - END IF - Re_BufSz = Re_BufSz + 1 ! R - Re_BufSz = Re_BufSz + 1 ! BladeLength - 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%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%DR) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DR,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DR,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%DR,1), UBOUND(InData%DR,1) - ReKiBuf(Re_Xferred) = InData%DR(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%R - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%BladeLength - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AD14_PackBladeParms - - SUBROUTINE AD14_UnPackBladeParms( 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(BladeParms), 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 = 'AD14_UnPackBladeParms' - ! 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 ! 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 ! DR not allocated - Int_Xferred = Int_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%DR)) DEALLOCATE(OutData%DR) - ALLOCATE(OutData%DR(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DR.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%DR,1), UBOUND(OutData%DR,1) - OutData%DR(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%R = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%BladeLength = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AD14_UnPackBladeParms - - SUBROUTINE AD14_CopyDynInflow( SrcDynInflowData, DstDynInflowData, CtrlCode, ErrStat, ErrMsg ) - TYPE(DynInflow), INTENT(IN) :: SrcDynInflowData - TYPE(DynInflow), INTENT(INOUT) :: DstDynInflowData - 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 = 'AD14_CopyDynInflow' -! - ErrStat = ErrID_None - ErrMsg = "" - DstDynInflowData%dAlph_dt = SrcDynInflowData%dAlph_dt - DstDynInflowData%dBeta_dt = SrcDynInflowData%dBeta_dt - DstDynInflowData%DTO = SrcDynInflowData%DTO - DstDynInflowData%old_Alph = SrcDynInflowData%old_Alph - DstDynInflowData%old_Beta = SrcDynInflowData%old_Beta - DstDynInflowData%old_LmdM = SrcDynInflowData%old_LmdM - DstDynInflowData%oldKai = SrcDynInflowData%oldKai - DstDynInflowData%PhiLqC = SrcDynInflowData%PhiLqC - DstDynInflowData%PhiLqS = SrcDynInflowData%PhiLqS - DstDynInflowData%Pzero = SrcDynInflowData%Pzero -IF (ALLOCATED(SrcDynInflowData%RMC_SAVE)) THEN - i1_l = LBOUND(SrcDynInflowData%RMC_SAVE,1) - i1_u = UBOUND(SrcDynInflowData%RMC_SAVE,1) - i2_l = LBOUND(SrcDynInflowData%RMC_SAVE,2) - i2_u = UBOUND(SrcDynInflowData%RMC_SAVE,2) - i3_l = LBOUND(SrcDynInflowData%RMC_SAVE,3) - i3_u = UBOUND(SrcDynInflowData%RMC_SAVE,3) - IF (.NOT. ALLOCATED(DstDynInflowData%RMC_SAVE)) THEN - ALLOCATE(DstDynInflowData%RMC_SAVE(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDynInflowData%RMC_SAVE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDynInflowData%RMC_SAVE = SrcDynInflowData%RMC_SAVE -ENDIF -IF (ALLOCATED(SrcDynInflowData%RMS_SAVE)) THEN - i1_l = LBOUND(SrcDynInflowData%RMS_SAVE,1) - i1_u = UBOUND(SrcDynInflowData%RMS_SAVE,1) - i2_l = LBOUND(SrcDynInflowData%RMS_SAVE,2) - i2_u = UBOUND(SrcDynInflowData%RMS_SAVE,2) - i3_l = LBOUND(SrcDynInflowData%RMS_SAVE,3) - i3_u = UBOUND(SrcDynInflowData%RMS_SAVE,3) - IF (.NOT. ALLOCATED(DstDynInflowData%RMS_SAVE)) THEN - ALLOCATE(DstDynInflowData%RMS_SAVE(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDynInflowData%RMS_SAVE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDynInflowData%RMS_SAVE = SrcDynInflowData%RMS_SAVE -ENDIF - DstDynInflowData%TipSpeed = SrcDynInflowData%TipSpeed - DstDynInflowData%totalInf = SrcDynInflowData%totalInf - DstDynInflowData%Vparam = SrcDynInflowData%Vparam - DstDynInflowData%Vtotal = SrcDynInflowData%Vtotal - DstDynInflowData%xAlpha = SrcDynInflowData%xAlpha - DstDynInflowData%xBeta = SrcDynInflowData%xBeta - DstDynInflowData%xKai = SrcDynInflowData%xKai - DstDynInflowData%XLAMBDA_M = SrcDynInflowData%XLAMBDA_M - DstDynInflowData%xLcos = SrcDynInflowData%xLcos - DstDynInflowData%xLsin = SrcDynInflowData%xLsin - DstDynInflowData%MminR = SrcDynInflowData%MminR - DstDynInflowData%MminusR = SrcDynInflowData%MminusR - DstDynInflowData%MplusR = SrcDynInflowData%MplusR - DstDynInflowData%GAMMA = SrcDynInflowData%GAMMA - END SUBROUTINE AD14_CopyDynInflow - - SUBROUTINE AD14_DestroyDynInflow( DynInflowData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(DynInflow), INTENT(INOUT) :: DynInflowData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyDynInflow' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(DynInflowData%RMC_SAVE)) THEN - DEALLOCATE(DynInflowData%RMC_SAVE) -ENDIF -IF (ALLOCATED(DynInflowData%RMS_SAVE)) THEN - DEALLOCATE(DynInflowData%RMS_SAVE) -ENDIF - END SUBROUTINE AD14_DestroyDynInflow - - SUBROUTINE AD14_PackDynInflow( 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(DynInflow), 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 = 'AD14_PackDynInflow' - ! 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%dAlph_dt) ! dAlph_dt - Re_BufSz = Re_BufSz + SIZE(InData%dBeta_dt) ! dBeta_dt - Re_BufSz = Re_BufSz + 1 ! DTO - Re_BufSz = Re_BufSz + SIZE(InData%old_Alph) ! old_Alph - Re_BufSz = Re_BufSz + SIZE(InData%old_Beta) ! old_Beta - Re_BufSz = Re_BufSz + 1 ! old_LmdM - Re_BufSz = Re_BufSz + 1 ! oldKai - Re_BufSz = Re_BufSz + SIZE(InData%PhiLqC) ! PhiLqC - Re_BufSz = Re_BufSz + SIZE(InData%PhiLqS) ! PhiLqS - Re_BufSz = Re_BufSz + 1 ! Pzero - Int_BufSz = Int_BufSz + 1 ! RMC_SAVE allocated yes/no - IF ( ALLOCATED(InData%RMC_SAVE) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! RMC_SAVE upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%RMC_SAVE) ! RMC_SAVE - END IF - Int_BufSz = Int_BufSz + 1 ! RMS_SAVE allocated yes/no - IF ( ALLOCATED(InData%RMS_SAVE) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! RMS_SAVE upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%RMS_SAVE) ! RMS_SAVE - END IF - Re_BufSz = Re_BufSz + 1 ! TipSpeed - Re_BufSz = Re_BufSz + 1 ! totalInf - Re_BufSz = Re_BufSz + 1 ! Vparam - Re_BufSz = Re_BufSz + 1 ! Vtotal - Re_BufSz = Re_BufSz + SIZE(InData%xAlpha) ! xAlpha - Re_BufSz = Re_BufSz + SIZE(InData%xBeta) ! xBeta - Re_BufSz = Re_BufSz + 1 ! xKai - Re_BufSz = Re_BufSz + 1 ! XLAMBDA_M - Re_BufSz = Re_BufSz + SIZE(InData%xLcos) ! xLcos - Re_BufSz = Re_BufSz + SIZE(InData%xLsin) ! xLsin - Int_BufSz = Int_BufSz + SIZE(InData%MminR) ! MminR - Int_BufSz = Int_BufSz + SIZE(InData%MminusR) ! MminusR - Int_BufSz = Int_BufSz + SIZE(InData%MplusR) ! MplusR - Re_BufSz = Re_BufSz + SIZE(InData%GAMMA) ! GAMMA - 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%dAlph_dt,2), UBOUND(InData%dAlph_dt,2) - DO i1 = LBOUND(InData%dAlph_dt,1), UBOUND(InData%dAlph_dt,1) - ReKiBuf(Re_Xferred) = InData%dAlph_dt(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - DO i2 = LBOUND(InData%dBeta_dt,2), UBOUND(InData%dBeta_dt,2) - DO i1 = LBOUND(InData%dBeta_dt,1), UBOUND(InData%dBeta_dt,1) - ReKiBuf(Re_Xferred) = InData%dBeta_dt(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - ReKiBuf(Re_Xferred) = InData%DTO - Re_Xferred = Re_Xferred + 1 - DO i1 = LBOUND(InData%old_Alph,1), UBOUND(InData%old_Alph,1) - ReKiBuf(Re_Xferred) = InData%old_Alph(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%old_Beta,1), UBOUND(InData%old_Beta,1) - ReKiBuf(Re_Xferred) = InData%old_Beta(i1) - Re_Xferred = Re_Xferred + 1 - END DO - ReKiBuf(Re_Xferred) = InData%old_LmdM - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%oldKai - Re_Xferred = Re_Xferred + 1 - DO i1 = LBOUND(InData%PhiLqC,1), UBOUND(InData%PhiLqC,1) - ReKiBuf(Re_Xferred) = InData%PhiLqC(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%PhiLqS,1), UBOUND(InData%PhiLqS,1) - ReKiBuf(Re_Xferred) = InData%PhiLqS(i1) - Re_Xferred = Re_Xferred + 1 - END DO - ReKiBuf(Re_Xferred) = InData%Pzero - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%RMC_SAVE) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RMC_SAVE,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RMC_SAVE,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RMC_SAVE,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RMC_SAVE,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RMC_SAVE,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RMC_SAVE,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%RMC_SAVE,3), UBOUND(InData%RMC_SAVE,3) - DO i2 = LBOUND(InData%RMC_SAVE,2), UBOUND(InData%RMC_SAVE,2) - DO i1 = LBOUND(InData%RMC_SAVE,1), UBOUND(InData%RMC_SAVE,1) - ReKiBuf(Re_Xferred) = InData%RMC_SAVE(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%RMS_SAVE) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RMS_SAVE,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RMS_SAVE,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RMS_SAVE,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RMS_SAVE,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RMS_SAVE,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RMS_SAVE,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%RMS_SAVE,3), UBOUND(InData%RMS_SAVE,3) - DO i2 = LBOUND(InData%RMS_SAVE,2), UBOUND(InData%RMS_SAVE,2) - DO i1 = LBOUND(InData%RMS_SAVE,1), UBOUND(InData%RMS_SAVE,1) - ReKiBuf(Re_Xferred) = InData%RMS_SAVE(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - ReKiBuf(Re_Xferred) = InData%TipSpeed - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%totalInf - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Vparam - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Vtotal - Re_Xferred = Re_Xferred + 1 - DO i1 = LBOUND(InData%xAlpha,1), UBOUND(InData%xAlpha,1) - ReKiBuf(Re_Xferred) = InData%xAlpha(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%xBeta,1), UBOUND(InData%xBeta,1) - ReKiBuf(Re_Xferred) = InData%xBeta(i1) - Re_Xferred = Re_Xferred + 1 - END DO - ReKiBuf(Re_Xferred) = InData%xKai - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%XLAMBDA_M - Re_Xferred = Re_Xferred + 1 - DO i2 = LBOUND(InData%xLcos,2), UBOUND(InData%xLcos,2) - DO i1 = LBOUND(InData%xLcos,1), UBOUND(InData%xLcos,1) - ReKiBuf(Re_Xferred) = InData%xLcos(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - DO i2 = LBOUND(InData%xLsin,2), UBOUND(InData%xLsin,2) - DO i1 = LBOUND(InData%xLsin,1), UBOUND(InData%xLsin,1) - ReKiBuf(Re_Xferred) = InData%xLsin(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - DO i2 = LBOUND(InData%MminR,2), UBOUND(InData%MminR,2) - DO i1 = LBOUND(InData%MminR,1), UBOUND(InData%MminR,1) - IntKiBuf(Int_Xferred) = InData%MminR(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - DO i2 = LBOUND(InData%MminusR,2), UBOUND(InData%MminusR,2) - DO i1 = LBOUND(InData%MminusR,1), UBOUND(InData%MminusR,1) - IntKiBuf(Int_Xferred) = InData%MminusR(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - DO i2 = LBOUND(InData%MplusR,2), UBOUND(InData%MplusR,2) - DO i1 = LBOUND(InData%MplusR,1), UBOUND(InData%MplusR,1) - IntKiBuf(Int_Xferred) = InData%MplusR(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - DO i2 = LBOUND(InData%GAMMA,2), UBOUND(InData%GAMMA,2) - DO i1 = LBOUND(InData%GAMMA,1), UBOUND(InData%GAMMA,1) - ReKiBuf(Re_Xferred) = InData%GAMMA(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END SUBROUTINE AD14_PackDynInflow - - SUBROUTINE AD14_UnPackDynInflow( 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(DynInflow), 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 = 'AD14_UnPackDynInflow' - ! 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%dAlph_dt,1) - i1_u = UBOUND(OutData%dAlph_dt,1) - i2_l = LBOUND(OutData%dAlph_dt,2) - i2_u = UBOUND(OutData%dAlph_dt,2) - DO i2 = LBOUND(OutData%dAlph_dt,2), UBOUND(OutData%dAlph_dt,2) - DO i1 = LBOUND(OutData%dAlph_dt,1), UBOUND(OutData%dAlph_dt,1) - OutData%dAlph_dt(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%dBeta_dt,1) - i1_u = UBOUND(OutData%dBeta_dt,1) - i2_l = LBOUND(OutData%dBeta_dt,2) - i2_u = UBOUND(OutData%dBeta_dt,2) - DO i2 = LBOUND(OutData%dBeta_dt,2), UBOUND(OutData%dBeta_dt,2) - DO i1 = LBOUND(OutData%dBeta_dt,1), UBOUND(OutData%dBeta_dt,1) - OutData%dBeta_dt(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - OutData%DTO = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%old_Alph,1) - i1_u = UBOUND(OutData%old_Alph,1) - DO i1 = LBOUND(OutData%old_Alph,1), UBOUND(OutData%old_Alph,1) - OutData%old_Alph(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%old_Beta,1) - i1_u = UBOUND(OutData%old_Beta,1) - DO i1 = LBOUND(OutData%old_Beta,1), UBOUND(OutData%old_Beta,1) - OutData%old_Beta(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%old_LmdM = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%oldKai = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%PhiLqC,1) - i1_u = UBOUND(OutData%PhiLqC,1) - DO i1 = LBOUND(OutData%PhiLqC,1), UBOUND(OutData%PhiLqC,1) - OutData%PhiLqC(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%PhiLqS,1) - i1_u = UBOUND(OutData%PhiLqS,1) - DO i1 = LBOUND(OutData%PhiLqS,1), UBOUND(OutData%PhiLqS,1) - OutData%PhiLqS(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%Pzero = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RMC_SAVE not allocated - Int_Xferred = Int_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%RMC_SAVE)) DEALLOCATE(OutData%RMC_SAVE) - ALLOCATE(OutData%RMC_SAVE(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%RMC_SAVE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%RMC_SAVE,3), UBOUND(OutData%RMC_SAVE,3) - DO i2 = LBOUND(OutData%RMC_SAVE,2), UBOUND(OutData%RMC_SAVE,2) - DO i1 = LBOUND(OutData%RMC_SAVE,1), UBOUND(OutData%RMC_SAVE,1) - OutData%RMC_SAVE(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 ! RMS_SAVE not allocated - Int_Xferred = Int_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%RMS_SAVE)) DEALLOCATE(OutData%RMS_SAVE) - ALLOCATE(OutData%RMS_SAVE(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%RMS_SAVE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%RMS_SAVE,3), UBOUND(OutData%RMS_SAVE,3) - DO i2 = LBOUND(OutData%RMS_SAVE,2), UBOUND(OutData%RMS_SAVE,2) - DO i1 = LBOUND(OutData%RMS_SAVE,1), UBOUND(OutData%RMS_SAVE,1) - OutData%RMS_SAVE(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - OutData%TipSpeed = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%totalInf = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Vparam = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Vtotal = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%xAlpha,1) - i1_u = UBOUND(OutData%xAlpha,1) - DO i1 = LBOUND(OutData%xAlpha,1), UBOUND(OutData%xAlpha,1) - OutData%xAlpha(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%xBeta,1) - i1_u = UBOUND(OutData%xBeta,1) - DO i1 = LBOUND(OutData%xBeta,1), UBOUND(OutData%xBeta,1) - OutData%xBeta(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%xKai = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%XLAMBDA_M = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%xLcos,1) - i1_u = UBOUND(OutData%xLcos,1) - i2_l = LBOUND(OutData%xLcos,2) - i2_u = UBOUND(OutData%xLcos,2) - DO i2 = LBOUND(OutData%xLcos,2), UBOUND(OutData%xLcos,2) - DO i1 = LBOUND(OutData%xLcos,1), UBOUND(OutData%xLcos,1) - OutData%xLcos(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%xLsin,1) - i1_u = UBOUND(OutData%xLsin,1) - i2_l = LBOUND(OutData%xLsin,2) - i2_u = UBOUND(OutData%xLsin,2) - DO i2 = LBOUND(OutData%xLsin,2), UBOUND(OutData%xLsin,2) - DO i1 = LBOUND(OutData%xLsin,1), UBOUND(OutData%xLsin,1) - OutData%xLsin(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%MminR,1) - i1_u = UBOUND(OutData%MminR,1) - i2_l = LBOUND(OutData%MminR,2) - i2_u = UBOUND(OutData%MminR,2) - DO i2 = LBOUND(OutData%MminR,2), UBOUND(OutData%MminR,2) - DO i1 = LBOUND(OutData%MminR,1), UBOUND(OutData%MminR,1) - OutData%MminR(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%MminusR,1) - i1_u = UBOUND(OutData%MminusR,1) - i2_l = LBOUND(OutData%MminusR,2) - i2_u = UBOUND(OutData%MminusR,2) - DO i2 = LBOUND(OutData%MminusR,2), UBOUND(OutData%MminusR,2) - DO i1 = LBOUND(OutData%MminusR,1), UBOUND(OutData%MminusR,1) - OutData%MminusR(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%MplusR,1) - i1_u = UBOUND(OutData%MplusR,1) - i2_l = LBOUND(OutData%MplusR,2) - i2_u = UBOUND(OutData%MplusR,2) - DO i2 = LBOUND(OutData%MplusR,2), UBOUND(OutData%MplusR,2) - DO i1 = LBOUND(OutData%MplusR,1), UBOUND(OutData%MplusR,1) - OutData%MplusR(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%GAMMA,1) - i1_u = UBOUND(OutData%GAMMA,1) - i2_l = LBOUND(OutData%GAMMA,2) - i2_u = UBOUND(OutData%GAMMA,2) - DO i2 = LBOUND(OutData%GAMMA,2), UBOUND(OutData%GAMMA,2) - DO i1 = LBOUND(OutData%GAMMA,1), UBOUND(OutData%GAMMA,1) - OutData%GAMMA(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END SUBROUTINE AD14_UnPackDynInflow - - SUBROUTINE AD14_CopyDynInflowParms( SrcDynInflowParmsData, DstDynInflowParmsData, CtrlCode, ErrStat, ErrMsg ) - TYPE(DynInflowParms), INTENT(IN) :: SrcDynInflowParmsData - TYPE(DynInflowParms), INTENT(INOUT) :: DstDynInflowParmsData - 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 = 'AD14_CopyDynInflowParms' -! - ErrStat = ErrID_None - ErrMsg = "" - DstDynInflowParmsData%MAXINFLO = SrcDynInflowParmsData%MAXINFLO - DstDynInflowParmsData%xMinv = SrcDynInflowParmsData%xMinv - END SUBROUTINE AD14_CopyDynInflowParms - - SUBROUTINE AD14_DestroyDynInflowParms( DynInflowParmsData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(DynInflowParms), INTENT(INOUT) :: DynInflowParmsData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyDynInflowParms' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE AD14_DestroyDynInflowParms - - SUBROUTINE AD14_PackDynInflowParms( 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(DynInflowParms), 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 = 'AD14_PackDynInflowParms' - ! 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 ! MAXINFLO - Re_BufSz = Re_BufSz + SIZE(InData%xMinv) ! xMinv - 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%MAXINFLO - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%xMinv,1), UBOUND(InData%xMinv,1) - ReKiBuf(Re_Xferred) = InData%xMinv(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END SUBROUTINE AD14_PackDynInflowParms - - SUBROUTINE AD14_UnPackDynInflowParms( 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(DynInflowParms), 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 = 'AD14_UnPackDynInflowParms' - ! 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%MAXINFLO = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%xMinv,1) - i1_u = UBOUND(OutData%xMinv,1) - DO i1 = LBOUND(OutData%xMinv,1), UBOUND(OutData%xMinv,1) - OutData%xMinv(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END SUBROUTINE AD14_UnPackDynInflowParms - - SUBROUTINE AD14_CopyElement( SrcElementData, DstElementData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Element), INTENT(IN) :: SrcElementData - TYPE(Element), INTENT(INOUT) :: DstElementData - 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 = 'AD14_CopyElement' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcElementData%A)) THEN - i1_l = LBOUND(SrcElementData%A,1) - i1_u = UBOUND(SrcElementData%A,1) - i2_l = LBOUND(SrcElementData%A,2) - i2_u = UBOUND(SrcElementData%A,2) - IF (.NOT. ALLOCATED(DstElementData%A)) THEN - ALLOCATE(DstElementData%A(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElementData%A.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstElementData%A = SrcElementData%A -ENDIF -IF (ALLOCATED(SrcElementData%AP)) THEN - i1_l = LBOUND(SrcElementData%AP,1) - i1_u = UBOUND(SrcElementData%AP,1) - i2_l = LBOUND(SrcElementData%AP,2) - i2_u = UBOUND(SrcElementData%AP,2) - IF (.NOT. ALLOCATED(DstElementData%AP)) THEN - ALLOCATE(DstElementData%AP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElementData%AP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstElementData%AP = SrcElementData%AP -ENDIF -IF (ALLOCATED(SrcElementData%ALPHA)) THEN - i1_l = LBOUND(SrcElementData%ALPHA,1) - i1_u = UBOUND(SrcElementData%ALPHA,1) - i2_l = LBOUND(SrcElementData%ALPHA,2) - i2_u = UBOUND(SrcElementData%ALPHA,2) - IF (.NOT. ALLOCATED(DstElementData%ALPHA)) THEN - ALLOCATE(DstElementData%ALPHA(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElementData%ALPHA.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstElementData%ALPHA = SrcElementData%ALPHA -ENDIF -IF (ALLOCATED(SrcElementData%W2)) THEN - i1_l = LBOUND(SrcElementData%W2,1) - i1_u = UBOUND(SrcElementData%W2,1) - i2_l = LBOUND(SrcElementData%W2,2) - i2_u = UBOUND(SrcElementData%W2,2) - IF (.NOT. ALLOCATED(DstElementData%W2)) THEN - ALLOCATE(DstElementData%W2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElementData%W2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstElementData%W2 = SrcElementData%W2 -ENDIF -IF (ALLOCATED(SrcElementData%OLD_A_NS)) THEN - i1_l = LBOUND(SrcElementData%OLD_A_NS,1) - i1_u = UBOUND(SrcElementData%OLD_A_NS,1) - i2_l = LBOUND(SrcElementData%OLD_A_NS,2) - i2_u = UBOUND(SrcElementData%OLD_A_NS,2) - IF (.NOT. ALLOCATED(DstElementData%OLD_A_NS)) THEN - ALLOCATE(DstElementData%OLD_A_NS(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElementData%OLD_A_NS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstElementData%OLD_A_NS = SrcElementData%OLD_A_NS -ENDIF -IF (ALLOCATED(SrcElementData%OLD_AP_NS)) THEN - i1_l = LBOUND(SrcElementData%OLD_AP_NS,1) - i1_u = UBOUND(SrcElementData%OLD_AP_NS,1) - i2_l = LBOUND(SrcElementData%OLD_AP_NS,2) - i2_u = UBOUND(SrcElementData%OLD_AP_NS,2) - IF (.NOT. ALLOCATED(DstElementData%OLD_AP_NS)) THEN - ALLOCATE(DstElementData%OLD_AP_NS(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElementData%OLD_AP_NS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstElementData%OLD_AP_NS = SrcElementData%OLD_AP_NS -ENDIF -IF (ALLOCATED(SrcElementData%PITNOW)) THEN - i1_l = LBOUND(SrcElementData%PITNOW,1) - i1_u = UBOUND(SrcElementData%PITNOW,1) - i2_l = LBOUND(SrcElementData%PITNOW,2) - i2_u = UBOUND(SrcElementData%PITNOW,2) - IF (.NOT. ALLOCATED(DstElementData%PITNOW)) THEN - ALLOCATE(DstElementData%PITNOW(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElementData%PITNOW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstElementData%PITNOW = SrcElementData%PITNOW -ENDIF - END SUBROUTINE AD14_CopyElement - - SUBROUTINE AD14_DestroyElement( ElementData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(Element), INTENT(INOUT) :: ElementData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyElement' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(ElementData%A)) THEN - DEALLOCATE(ElementData%A) -ENDIF -IF (ALLOCATED(ElementData%AP)) THEN - DEALLOCATE(ElementData%AP) -ENDIF -IF (ALLOCATED(ElementData%ALPHA)) THEN - DEALLOCATE(ElementData%ALPHA) -ENDIF -IF (ALLOCATED(ElementData%W2)) THEN - DEALLOCATE(ElementData%W2) -ENDIF -IF (ALLOCATED(ElementData%OLD_A_NS)) THEN - DEALLOCATE(ElementData%OLD_A_NS) -ENDIF -IF (ALLOCATED(ElementData%OLD_AP_NS)) THEN - DEALLOCATE(ElementData%OLD_AP_NS) -ENDIF -IF (ALLOCATED(ElementData%PITNOW)) THEN - DEALLOCATE(ElementData%PITNOW) -ENDIF - END SUBROUTINE AD14_DestroyElement - - SUBROUTINE AD14_PackElement( 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(Element), 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 = 'AD14_PackElement' - ! 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 ! A allocated yes/no - IF ( ALLOCATED(InData%A) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! A upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%A) ! A - END IF - Int_BufSz = Int_BufSz + 1 ! AP allocated yes/no - IF ( ALLOCATED(InData%AP) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! AP upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AP) ! AP - END IF - Int_BufSz = Int_BufSz + 1 ! ALPHA allocated yes/no - IF ( ALLOCATED(InData%ALPHA) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! ALPHA upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%ALPHA) ! ALPHA - END IF - Int_BufSz = Int_BufSz + 1 ! W2 allocated yes/no - IF ( ALLOCATED(InData%W2) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! W2 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%W2) ! W2 - END IF - Int_BufSz = Int_BufSz + 1 ! OLD_A_NS allocated yes/no - IF ( ALLOCATED(InData%OLD_A_NS) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! OLD_A_NS upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%OLD_A_NS) ! OLD_A_NS - END IF - Int_BufSz = Int_BufSz + 1 ! OLD_AP_NS allocated yes/no - IF ( ALLOCATED(InData%OLD_AP_NS) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! OLD_AP_NS upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%OLD_AP_NS) ! OLD_AP_NS - END IF - Int_BufSz = Int_BufSz + 1 ! PITNOW allocated yes/no - IF ( ALLOCATED(InData%PITNOW) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PITNOW upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PITNOW) ! PITNOW - 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%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 - IntKiBuf( Int_Xferred ) = LBOUND(InData%A,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%A,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%A,2), UBOUND(InData%A,2) - DO i1 = LBOUND(InData%A,1), UBOUND(InData%A,1) - ReKiBuf(Re_Xferred) = InData%A(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AP) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AP,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AP,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AP,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%AP,2), UBOUND(InData%AP,2) - DO i1 = LBOUND(InData%AP,1), UBOUND(InData%AP,1) - ReKiBuf(Re_Xferred) = InData%AP(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ALPHA) ) THEN - 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,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ALPHA,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ALPHA,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ALPHA,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%ALPHA,2), UBOUND(InData%ALPHA,2) - DO i1 = LBOUND(InData%ALPHA,1), UBOUND(InData%ALPHA,1) - ReKiBuf(Re_Xferred) = InData%ALPHA(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%W2) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%W2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%W2,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%W2,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%W2,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%W2,2), UBOUND(InData%W2,2) - DO i1 = LBOUND(InData%W2,1), UBOUND(InData%W2,1) - ReKiBuf(Re_Xferred) = InData%W2(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%OLD_A_NS) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OLD_A_NS,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OLD_A_NS,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OLD_A_NS,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OLD_A_NS,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%OLD_A_NS,2), UBOUND(InData%OLD_A_NS,2) - DO i1 = LBOUND(InData%OLD_A_NS,1), UBOUND(InData%OLD_A_NS,1) - ReKiBuf(Re_Xferred) = InData%OLD_A_NS(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%OLD_AP_NS) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OLD_AP_NS,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OLD_AP_NS,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OLD_AP_NS,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OLD_AP_NS,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%OLD_AP_NS,2), UBOUND(InData%OLD_AP_NS,2) - DO i1 = LBOUND(InData%OLD_AP_NS,1), UBOUND(InData%OLD_AP_NS,1) - ReKiBuf(Re_Xferred) = InData%OLD_AP_NS(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PITNOW) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PITNOW,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PITNOW,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PITNOW,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PITNOW,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PITNOW,2), UBOUND(InData%PITNOW,2) - DO i1 = LBOUND(InData%PITNOW,1), UBOUND(InData%PITNOW,1) - ReKiBuf(Re_Xferred) = InData%PITNOW(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE AD14_PackElement - - SUBROUTINE AD14_UnPackElement( 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(Element), 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 = 'AD14_UnPackElement' - ! 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 ! 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 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%A)) DEALLOCATE(OutData%A) - ALLOCATE(OutData%A(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%A.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%A,2), UBOUND(OutData%A,2) - DO i1 = LBOUND(OutData%A,1), UBOUND(OutData%A,1) - OutData%A(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AP not allocated - Int_Xferred = Int_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%AP)) DEALLOCATE(OutData%AP) - ALLOCATE(OutData%AP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%AP,2), UBOUND(OutData%AP,2) - DO i1 = LBOUND(OutData%AP,1), UBOUND(OutData%AP,1) - OutData%AP(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ALPHA not allocated - Int_Xferred = Int_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)) DEALLOCATE(OutData%ALPHA) - ALLOCATE(OutData%ALPHA(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ALPHA.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%ALPHA,2), UBOUND(OutData%ALPHA,2) - DO i1 = LBOUND(OutData%ALPHA,1), UBOUND(OutData%ALPHA,1) - OutData%ALPHA(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! W2 not allocated - Int_Xferred = Int_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%W2)) DEALLOCATE(OutData%W2) - ALLOCATE(OutData%W2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%W2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%W2,2), UBOUND(OutData%W2,2) - DO i1 = LBOUND(OutData%W2,1), UBOUND(OutData%W2,1) - OutData%W2(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OLD_A_NS not allocated - Int_Xferred = Int_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%OLD_A_NS)) DEALLOCATE(OutData%OLD_A_NS) - ALLOCATE(OutData%OLD_A_NS(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OLD_A_NS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%OLD_A_NS,2), UBOUND(OutData%OLD_A_NS,2) - DO i1 = LBOUND(OutData%OLD_A_NS,1), UBOUND(OutData%OLD_A_NS,1) - OutData%OLD_A_NS(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OLD_AP_NS not allocated - Int_Xferred = Int_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%OLD_AP_NS)) DEALLOCATE(OutData%OLD_AP_NS) - ALLOCATE(OutData%OLD_AP_NS(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OLD_AP_NS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%OLD_AP_NS,2), UBOUND(OutData%OLD_AP_NS,2) - DO i1 = LBOUND(OutData%OLD_AP_NS,1), UBOUND(OutData%OLD_AP_NS,1) - OutData%OLD_AP_NS(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PITNOW not allocated - Int_Xferred = Int_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%PITNOW)) DEALLOCATE(OutData%PITNOW) - ALLOCATE(OutData%PITNOW(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PITNOW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PITNOW,2), UBOUND(OutData%PITNOW,2) - DO i1 = LBOUND(OutData%PITNOW,1), UBOUND(OutData%PITNOW,1) - OutData%PITNOW(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE AD14_UnPackElement - - SUBROUTINE AD14_CopyElementParms( SrcElementParmsData, DstElementParmsData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ElementParms), INTENT(IN) :: SrcElementParmsData - TYPE(ElementParms), INTENT(INOUT) :: DstElementParmsData - 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 = 'AD14_CopyElementParms' -! - ErrStat = ErrID_None - ErrMsg = "" - DstElementParmsData%NELM = SrcElementParmsData%NELM -IF (ALLOCATED(SrcElementParmsData%TWIST)) THEN - i1_l = LBOUND(SrcElementParmsData%TWIST,1) - i1_u = UBOUND(SrcElementParmsData%TWIST,1) - IF (.NOT. ALLOCATED(DstElementParmsData%TWIST)) THEN - ALLOCATE(DstElementParmsData%TWIST(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElementParmsData%TWIST.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstElementParmsData%TWIST = SrcElementParmsData%TWIST -ENDIF -IF (ALLOCATED(SrcElementParmsData%RELM)) THEN - i1_l = LBOUND(SrcElementParmsData%RELM,1) - i1_u = UBOUND(SrcElementParmsData%RELM,1) - IF (.NOT. ALLOCATED(DstElementParmsData%RELM)) THEN - ALLOCATE(DstElementParmsData%RELM(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElementParmsData%RELM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstElementParmsData%RELM = SrcElementParmsData%RELM -ENDIF -IF (ALLOCATED(SrcElementParmsData%HLCNST)) THEN - i1_l = LBOUND(SrcElementParmsData%HLCNST,1) - i1_u = UBOUND(SrcElementParmsData%HLCNST,1) - IF (.NOT. ALLOCATED(DstElementParmsData%HLCNST)) THEN - ALLOCATE(DstElementParmsData%HLCNST(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElementParmsData%HLCNST.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstElementParmsData%HLCNST = SrcElementParmsData%HLCNST -ENDIF -IF (ALLOCATED(SrcElementParmsData%TLCNST)) THEN - i1_l = LBOUND(SrcElementParmsData%TLCNST,1) - i1_u = UBOUND(SrcElementParmsData%TLCNST,1) - IF (.NOT. ALLOCATED(DstElementParmsData%TLCNST)) THEN - ALLOCATE(DstElementParmsData%TLCNST(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElementParmsData%TLCNST.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstElementParmsData%TLCNST = SrcElementParmsData%TLCNST -ENDIF - END SUBROUTINE AD14_CopyElementParms - - SUBROUTINE AD14_DestroyElementParms( ElementParmsData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(ElementParms), INTENT(INOUT) :: ElementParmsData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyElementParms' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(ElementParmsData%TWIST)) THEN - DEALLOCATE(ElementParmsData%TWIST) -ENDIF -IF (ALLOCATED(ElementParmsData%RELM)) THEN - DEALLOCATE(ElementParmsData%RELM) -ENDIF -IF (ALLOCATED(ElementParmsData%HLCNST)) THEN - DEALLOCATE(ElementParmsData%HLCNST) -ENDIF -IF (ALLOCATED(ElementParmsData%TLCNST)) THEN - DEALLOCATE(ElementParmsData%TLCNST) -ENDIF - END SUBROUTINE AD14_DestroyElementParms - - SUBROUTINE AD14_PackElementParms( 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(ElementParms), 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 = 'AD14_PackElementParms' - ! 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 ! NELM - Int_BufSz = Int_BufSz + 1 ! TWIST allocated yes/no - IF ( ALLOCATED(InData%TWIST) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TWIST upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TWIST) ! TWIST - END IF - Int_BufSz = Int_BufSz + 1 ! RELM allocated yes/no - IF ( ALLOCATED(InData%RELM) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! RELM upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%RELM) ! RELM - END IF - Int_BufSz = Int_BufSz + 1 ! HLCNST allocated yes/no - IF ( ALLOCATED(InData%HLCNST) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! HLCNST upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%HLCNST) ! HLCNST - END IF - Int_BufSz = Int_BufSz + 1 ! TLCNST allocated yes/no - IF ( ALLOCATED(InData%TLCNST) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TLCNST upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TLCNST) ! TLCNST - 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%NELM - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%TWIST) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TWIST,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TWIST,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TWIST,1), UBOUND(InData%TWIST,1) - ReKiBuf(Re_Xferred) = InData%TWIST(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%RELM) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RELM,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RELM,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%RELM,1), UBOUND(InData%RELM,1) - ReKiBuf(Re_Xferred) = InData%RELM(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%HLCNST) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%HLCNST,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%HLCNST,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%HLCNST,1), UBOUND(InData%HLCNST,1) - ReKiBuf(Re_Xferred) = InData%HLCNST(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TLCNST) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TLCNST,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TLCNST,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TLCNST,1), UBOUND(InData%TLCNST,1) - ReKiBuf(Re_Xferred) = InData%TLCNST(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE AD14_PackElementParms - - SUBROUTINE AD14_UnPackElementParms( 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(ElementParms), 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 = 'AD14_UnPackElementParms' - ! 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%NELM = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TWIST not allocated - Int_Xferred = Int_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%TWIST)) DEALLOCATE(OutData%TWIST) - ALLOCATE(OutData%TWIST(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TWIST.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TWIST,1), UBOUND(OutData%TWIST,1) - OutData%TWIST(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RELM not allocated - Int_Xferred = Int_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%RELM)) DEALLOCATE(OutData%RELM) - ALLOCATE(OutData%RELM(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RELM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%RELM,1), UBOUND(OutData%RELM,1) - OutData%RELM(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! HLCNST not allocated - Int_Xferred = Int_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%HLCNST)) DEALLOCATE(OutData%HLCNST) - ALLOCATE(OutData%HLCNST(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%HLCNST.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%HLCNST,1), UBOUND(OutData%HLCNST,1) - OutData%HLCNST(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TLCNST not allocated - Int_Xferred = Int_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%TLCNST)) DEALLOCATE(OutData%TLCNST) - ALLOCATE(OutData%TLCNST(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TLCNST.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TLCNST,1), UBOUND(OutData%TLCNST,1) - OutData%TLCNST(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE AD14_UnPackElementParms - - SUBROUTINE AD14_CopyElOutParms( SrcElOutParmsData, DstElOutParmsData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ElOutParms), INTENT(IN) :: SrcElOutParmsData - TYPE(ElOutParms), INTENT(INOUT) :: DstElOutParmsData - 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 = 'AD14_CopyElOutParms' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcElOutParmsData%AAA)) THEN - i1_l = LBOUND(SrcElOutParmsData%AAA,1) - i1_u = UBOUND(SrcElOutParmsData%AAA,1) - IF (.NOT. ALLOCATED(DstElOutParmsData%AAA)) THEN - ALLOCATE(DstElOutParmsData%AAA(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElOutParmsData%AAA.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstElOutParmsData%AAA = SrcElOutParmsData%AAA -ENDIF -IF (ALLOCATED(SrcElOutParmsData%AAP)) THEN - i1_l = LBOUND(SrcElOutParmsData%AAP,1) - i1_u = UBOUND(SrcElOutParmsData%AAP,1) - IF (.NOT. ALLOCATED(DstElOutParmsData%AAP)) THEN - ALLOCATE(DstElOutParmsData%AAP(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElOutParmsData%AAP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstElOutParmsData%AAP = SrcElOutParmsData%AAP -ENDIF -IF (ALLOCATED(SrcElOutParmsData%ALF)) THEN - i1_l = LBOUND(SrcElOutParmsData%ALF,1) - i1_u = UBOUND(SrcElOutParmsData%ALF,1) - IF (.NOT. ALLOCATED(DstElOutParmsData%ALF)) THEN - ALLOCATE(DstElOutParmsData%ALF(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElOutParmsData%ALF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstElOutParmsData%ALF = SrcElOutParmsData%ALF -ENDIF -IF (ALLOCATED(SrcElOutParmsData%CDD)) THEN - i1_l = LBOUND(SrcElOutParmsData%CDD,1) - i1_u = UBOUND(SrcElOutParmsData%CDD,1) - IF (.NOT. ALLOCATED(DstElOutParmsData%CDD)) THEN - ALLOCATE(DstElOutParmsData%CDD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElOutParmsData%CDD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstElOutParmsData%CDD = SrcElOutParmsData%CDD -ENDIF -IF (ALLOCATED(SrcElOutParmsData%CLL)) THEN - i1_l = LBOUND(SrcElOutParmsData%CLL,1) - i1_u = UBOUND(SrcElOutParmsData%CLL,1) - IF (.NOT. ALLOCATED(DstElOutParmsData%CLL)) THEN - ALLOCATE(DstElOutParmsData%CLL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElOutParmsData%CLL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstElOutParmsData%CLL = SrcElOutParmsData%CLL -ENDIF -IF (ALLOCATED(SrcElOutParmsData%CMM)) THEN - i1_l = LBOUND(SrcElOutParmsData%CMM,1) - i1_u = UBOUND(SrcElOutParmsData%CMM,1) - IF (.NOT. ALLOCATED(DstElOutParmsData%CMM)) THEN - ALLOCATE(DstElOutParmsData%CMM(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElOutParmsData%CMM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstElOutParmsData%CMM = SrcElOutParmsData%CMM -ENDIF -IF (ALLOCATED(SrcElOutParmsData%CNN)) THEN - i1_l = LBOUND(SrcElOutParmsData%CNN,1) - i1_u = UBOUND(SrcElOutParmsData%CNN,1) - IF (.NOT. ALLOCATED(DstElOutParmsData%CNN)) THEN - ALLOCATE(DstElOutParmsData%CNN(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElOutParmsData%CNN.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstElOutParmsData%CNN = SrcElOutParmsData%CNN -ENDIF -IF (ALLOCATED(SrcElOutParmsData%CTT)) THEN - i1_l = LBOUND(SrcElOutParmsData%CTT,1) - i1_u = UBOUND(SrcElOutParmsData%CTT,1) - IF (.NOT. ALLOCATED(DstElOutParmsData%CTT)) THEN - ALLOCATE(DstElOutParmsData%CTT(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElOutParmsData%CTT.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstElOutParmsData%CTT = SrcElOutParmsData%CTT -ENDIF -IF (ALLOCATED(SrcElOutParmsData%DFNSAV)) THEN - i1_l = LBOUND(SrcElOutParmsData%DFNSAV,1) - i1_u = UBOUND(SrcElOutParmsData%DFNSAV,1) - IF (.NOT. ALLOCATED(DstElOutParmsData%DFNSAV)) THEN - ALLOCATE(DstElOutParmsData%DFNSAV(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElOutParmsData%DFNSAV.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstElOutParmsData%DFNSAV = SrcElOutParmsData%DFNSAV -ENDIF -IF (ALLOCATED(SrcElOutParmsData%DFTSAV)) THEN - i1_l = LBOUND(SrcElOutParmsData%DFTSAV,1) - i1_u = UBOUND(SrcElOutParmsData%DFTSAV,1) - IF (.NOT. ALLOCATED(DstElOutParmsData%DFTSAV)) THEN - ALLOCATE(DstElOutParmsData%DFTSAV(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElOutParmsData%DFTSAV.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstElOutParmsData%DFTSAV = SrcElOutParmsData%DFTSAV -ENDIF -IF (ALLOCATED(SrcElOutParmsData%DynPres)) THEN - i1_l = LBOUND(SrcElOutParmsData%DynPres,1) - i1_u = UBOUND(SrcElOutParmsData%DynPres,1) - IF (.NOT. ALLOCATED(DstElOutParmsData%DynPres)) THEN - ALLOCATE(DstElOutParmsData%DynPres(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElOutParmsData%DynPres.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstElOutParmsData%DynPres = SrcElOutParmsData%DynPres -ENDIF -IF (ALLOCATED(SrcElOutParmsData%PMM)) THEN - i1_l = LBOUND(SrcElOutParmsData%PMM,1) - i1_u = UBOUND(SrcElOutParmsData%PMM,1) - IF (.NOT. ALLOCATED(DstElOutParmsData%PMM)) THEN - ALLOCATE(DstElOutParmsData%PMM(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElOutParmsData%PMM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstElOutParmsData%PMM = SrcElOutParmsData%PMM -ENDIF -IF (ALLOCATED(SrcElOutParmsData%PITSAV)) THEN - i1_l = LBOUND(SrcElOutParmsData%PITSAV,1) - i1_u = UBOUND(SrcElOutParmsData%PITSAV,1) - IF (.NOT. ALLOCATED(DstElOutParmsData%PITSAV)) THEN - ALLOCATE(DstElOutParmsData%PITSAV(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElOutParmsData%PITSAV.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstElOutParmsData%PITSAV = SrcElOutParmsData%PITSAV -ENDIF -IF (ALLOCATED(SrcElOutParmsData%ReyNum)) THEN - i1_l = LBOUND(SrcElOutParmsData%ReyNum,1) - i1_u = UBOUND(SrcElOutParmsData%ReyNum,1) - IF (.NOT. ALLOCATED(DstElOutParmsData%ReyNum)) THEN - ALLOCATE(DstElOutParmsData%ReyNum(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElOutParmsData%ReyNum.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstElOutParmsData%ReyNum = SrcElOutParmsData%ReyNum -ENDIF -IF (ALLOCATED(SrcElOutParmsData%Gamma)) THEN - i1_l = LBOUND(SrcElOutParmsData%Gamma,1) - i1_u = UBOUND(SrcElOutParmsData%Gamma,1) - IF (.NOT. ALLOCATED(DstElOutParmsData%Gamma)) THEN - ALLOCATE(DstElOutParmsData%Gamma(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElOutParmsData%Gamma.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstElOutParmsData%Gamma = SrcElOutParmsData%Gamma -ENDIF -IF (ALLOCATED(SrcElOutParmsData%SaveVX)) THEN - i1_l = LBOUND(SrcElOutParmsData%SaveVX,1) - i1_u = UBOUND(SrcElOutParmsData%SaveVX,1) - i2_l = LBOUND(SrcElOutParmsData%SaveVX,2) - i2_u = UBOUND(SrcElOutParmsData%SaveVX,2) - IF (.NOT. ALLOCATED(DstElOutParmsData%SaveVX)) THEN - ALLOCATE(DstElOutParmsData%SaveVX(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElOutParmsData%SaveVX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstElOutParmsData%SaveVX = SrcElOutParmsData%SaveVX -ENDIF -IF (ALLOCATED(SrcElOutParmsData%SaveVY)) THEN - i1_l = LBOUND(SrcElOutParmsData%SaveVY,1) - i1_u = UBOUND(SrcElOutParmsData%SaveVY,1) - i2_l = LBOUND(SrcElOutParmsData%SaveVY,2) - i2_u = UBOUND(SrcElOutParmsData%SaveVY,2) - IF (.NOT. ALLOCATED(DstElOutParmsData%SaveVY)) THEN - ALLOCATE(DstElOutParmsData%SaveVY(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElOutParmsData%SaveVY.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstElOutParmsData%SaveVY = SrcElOutParmsData%SaveVY -ENDIF -IF (ALLOCATED(SrcElOutParmsData%SaveVZ)) THEN - i1_l = LBOUND(SrcElOutParmsData%SaveVZ,1) - i1_u = UBOUND(SrcElOutParmsData%SaveVZ,1) - i2_l = LBOUND(SrcElOutParmsData%SaveVZ,2) - i2_u = UBOUND(SrcElOutParmsData%SaveVZ,2) - IF (.NOT. ALLOCATED(DstElOutParmsData%SaveVZ)) THEN - ALLOCATE(DstElOutParmsData%SaveVZ(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElOutParmsData%SaveVZ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstElOutParmsData%SaveVZ = SrcElOutParmsData%SaveVZ -ENDIF - DstElOutParmsData%VXSAV = SrcElOutParmsData%VXSAV - DstElOutParmsData%VYSAV = SrcElOutParmsData%VYSAV - DstElOutParmsData%VZSAV = SrcElOutParmsData%VZSAV - DstElOutParmsData%NumWndElOut = SrcElOutParmsData%NumWndElOut -IF (ALLOCATED(SrcElOutParmsData%WndElPrList)) THEN - i1_l = LBOUND(SrcElOutParmsData%WndElPrList,1) - i1_u = UBOUND(SrcElOutParmsData%WndElPrList,1) - IF (.NOT. ALLOCATED(DstElOutParmsData%WndElPrList)) THEN - ALLOCATE(DstElOutParmsData%WndElPrList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElOutParmsData%WndElPrList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstElOutParmsData%WndElPrList = SrcElOutParmsData%WndElPrList -ENDIF -IF (ALLOCATED(SrcElOutParmsData%WndElPrNum)) THEN - i1_l = LBOUND(SrcElOutParmsData%WndElPrNum,1) - i1_u = UBOUND(SrcElOutParmsData%WndElPrNum,1) - IF (.NOT. ALLOCATED(DstElOutParmsData%WndElPrNum)) THEN - ALLOCATE(DstElOutParmsData%WndElPrNum(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElOutParmsData%WndElPrNum.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstElOutParmsData%WndElPrNum = SrcElOutParmsData%WndElPrNum -ENDIF -IF (ALLOCATED(SrcElOutParmsData%ElPrList)) THEN - i1_l = LBOUND(SrcElOutParmsData%ElPrList,1) - i1_u = UBOUND(SrcElOutParmsData%ElPrList,1) - IF (.NOT. ALLOCATED(DstElOutParmsData%ElPrList)) THEN - ALLOCATE(DstElOutParmsData%ElPrList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElOutParmsData%ElPrList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstElOutParmsData%ElPrList = SrcElOutParmsData%ElPrList -ENDIF -IF (ALLOCATED(SrcElOutParmsData%ElPrNum)) THEN - i1_l = LBOUND(SrcElOutParmsData%ElPrNum,1) - i1_u = UBOUND(SrcElOutParmsData%ElPrNum,1) - IF (.NOT. ALLOCATED(DstElOutParmsData%ElPrNum)) THEN - ALLOCATE(DstElOutParmsData%ElPrNum(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElOutParmsData%ElPrNum.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstElOutParmsData%ElPrNum = SrcElOutParmsData%ElPrNum -ENDIF - DstElOutParmsData%NumElOut = SrcElOutParmsData%NumElOut - END SUBROUTINE AD14_CopyElOutParms - - SUBROUTINE AD14_DestroyElOutParms( ElOutParmsData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(ElOutParms), INTENT(INOUT) :: ElOutParmsData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyElOutParms' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(ElOutParmsData%AAA)) THEN - DEALLOCATE(ElOutParmsData%AAA) -ENDIF -IF (ALLOCATED(ElOutParmsData%AAP)) THEN - DEALLOCATE(ElOutParmsData%AAP) -ENDIF -IF (ALLOCATED(ElOutParmsData%ALF)) THEN - DEALLOCATE(ElOutParmsData%ALF) -ENDIF -IF (ALLOCATED(ElOutParmsData%CDD)) THEN - DEALLOCATE(ElOutParmsData%CDD) -ENDIF -IF (ALLOCATED(ElOutParmsData%CLL)) THEN - DEALLOCATE(ElOutParmsData%CLL) -ENDIF -IF (ALLOCATED(ElOutParmsData%CMM)) THEN - DEALLOCATE(ElOutParmsData%CMM) -ENDIF -IF (ALLOCATED(ElOutParmsData%CNN)) THEN - DEALLOCATE(ElOutParmsData%CNN) -ENDIF -IF (ALLOCATED(ElOutParmsData%CTT)) THEN - DEALLOCATE(ElOutParmsData%CTT) -ENDIF -IF (ALLOCATED(ElOutParmsData%DFNSAV)) THEN - DEALLOCATE(ElOutParmsData%DFNSAV) -ENDIF -IF (ALLOCATED(ElOutParmsData%DFTSAV)) THEN - DEALLOCATE(ElOutParmsData%DFTSAV) -ENDIF -IF (ALLOCATED(ElOutParmsData%DynPres)) THEN - DEALLOCATE(ElOutParmsData%DynPres) -ENDIF -IF (ALLOCATED(ElOutParmsData%PMM)) THEN - DEALLOCATE(ElOutParmsData%PMM) -ENDIF -IF (ALLOCATED(ElOutParmsData%PITSAV)) THEN - DEALLOCATE(ElOutParmsData%PITSAV) -ENDIF -IF (ALLOCATED(ElOutParmsData%ReyNum)) THEN - DEALLOCATE(ElOutParmsData%ReyNum) -ENDIF -IF (ALLOCATED(ElOutParmsData%Gamma)) THEN - DEALLOCATE(ElOutParmsData%Gamma) -ENDIF -IF (ALLOCATED(ElOutParmsData%SaveVX)) THEN - DEALLOCATE(ElOutParmsData%SaveVX) -ENDIF -IF (ALLOCATED(ElOutParmsData%SaveVY)) THEN - DEALLOCATE(ElOutParmsData%SaveVY) -ENDIF -IF (ALLOCATED(ElOutParmsData%SaveVZ)) THEN - DEALLOCATE(ElOutParmsData%SaveVZ) -ENDIF -IF (ALLOCATED(ElOutParmsData%WndElPrList)) THEN - DEALLOCATE(ElOutParmsData%WndElPrList) -ENDIF -IF (ALLOCATED(ElOutParmsData%WndElPrNum)) THEN - DEALLOCATE(ElOutParmsData%WndElPrNum) -ENDIF -IF (ALLOCATED(ElOutParmsData%ElPrList)) THEN - DEALLOCATE(ElOutParmsData%ElPrList) -ENDIF -IF (ALLOCATED(ElOutParmsData%ElPrNum)) THEN - DEALLOCATE(ElOutParmsData%ElPrNum) -ENDIF - END SUBROUTINE AD14_DestroyElOutParms - - SUBROUTINE AD14_PackElOutParms( 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(ElOutParms), 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 = 'AD14_PackElOutParms' - ! 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 ! AAA allocated yes/no - IF ( ALLOCATED(InData%AAA) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! AAA upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AAA) ! AAA - END IF - Int_BufSz = Int_BufSz + 1 ! AAP allocated yes/no - IF ( ALLOCATED(InData%AAP) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! AAP upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AAP) ! AAP - END IF - Int_BufSz = Int_BufSz + 1 ! ALF allocated yes/no - IF ( ALLOCATED(InData%ALF) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ALF upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%ALF) ! ALF - END IF - Int_BufSz = Int_BufSz + 1 ! CDD allocated yes/no - IF ( ALLOCATED(InData%CDD) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! CDD upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CDD) ! CDD - END IF - Int_BufSz = Int_BufSz + 1 ! CLL allocated yes/no - IF ( ALLOCATED(InData%CLL) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! CLL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CLL) ! CLL - END IF - Int_BufSz = Int_BufSz + 1 ! CMM allocated yes/no - IF ( ALLOCATED(InData%CMM) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! CMM upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CMM) ! CMM - END IF - Int_BufSz = Int_BufSz + 1 ! CNN allocated yes/no - IF ( ALLOCATED(InData%CNN) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! CNN upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CNN) ! CNN - END IF - Int_BufSz = Int_BufSz + 1 ! CTT allocated yes/no - IF ( ALLOCATED(InData%CTT) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! CTT upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CTT) ! CTT - END IF - Int_BufSz = Int_BufSz + 1 ! DFNSAV allocated yes/no - IF ( ALLOCATED(InData%DFNSAV) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! DFNSAV upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%DFNSAV) ! DFNSAV - END IF - Int_BufSz = Int_BufSz + 1 ! DFTSAV allocated yes/no - IF ( ALLOCATED(InData%DFTSAV) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! DFTSAV upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%DFTSAV) ! DFTSAV - END IF - Int_BufSz = Int_BufSz + 1 ! DynPres allocated yes/no - IF ( ALLOCATED(InData%DynPres) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! DynPres upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%DynPres) ! DynPres - END IF - Int_BufSz = Int_BufSz + 1 ! PMM allocated yes/no - IF ( ALLOCATED(InData%PMM) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PMM upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PMM) ! PMM - END IF - Int_BufSz = Int_BufSz + 1 ! PITSAV allocated yes/no - IF ( ALLOCATED(InData%PITSAV) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PITSAV upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PITSAV) ! PITSAV - END IF - Int_BufSz = Int_BufSz + 1 ! ReyNum allocated yes/no - IF ( ALLOCATED(InData%ReyNum) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ReyNum upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%ReyNum) ! ReyNum - END IF - Int_BufSz = Int_BufSz + 1 ! Gamma allocated yes/no - IF ( ALLOCATED(InData%Gamma) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Gamma upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Gamma) ! Gamma - END IF - Int_BufSz = Int_BufSz + 1 ! SaveVX allocated yes/no - IF ( ALLOCATED(InData%SaveVX) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! SaveVX upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%SaveVX) ! SaveVX - END IF - Int_BufSz = Int_BufSz + 1 ! SaveVY allocated yes/no - IF ( ALLOCATED(InData%SaveVY) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! SaveVY upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%SaveVY) ! SaveVY - END IF - Int_BufSz = Int_BufSz + 1 ! SaveVZ allocated yes/no - IF ( ALLOCATED(InData%SaveVZ) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! SaveVZ upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%SaveVZ) ! SaveVZ - END IF - Re_BufSz = Re_BufSz + 1 ! VXSAV - Re_BufSz = Re_BufSz + 1 ! VYSAV - Re_BufSz = Re_BufSz + 1 ! VZSAV - Int_BufSz = Int_BufSz + 1 ! NumWndElOut - Int_BufSz = Int_BufSz + 1 ! WndElPrList allocated yes/no - IF ( ALLOCATED(InData%WndElPrList) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WndElPrList upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%WndElPrList) ! WndElPrList - END IF - Int_BufSz = Int_BufSz + 1 ! WndElPrNum allocated yes/no - IF ( ALLOCATED(InData%WndElPrNum) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WndElPrNum upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%WndElPrNum) ! WndElPrNum - END IF - Int_BufSz = Int_BufSz + 1 ! ElPrList allocated yes/no - IF ( ALLOCATED(InData%ElPrList) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ElPrList upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%ElPrList) ! ElPrList - END IF - Int_BufSz = Int_BufSz + 1 ! ElPrNum allocated yes/no - IF ( ALLOCATED(InData%ElPrNum) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ElPrNum upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%ElPrNum) ! ElPrNum - END IF - Int_BufSz = Int_BufSz + 1 ! NumElOut - 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%AAA) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AAA,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AAA,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%AAA,1), UBOUND(InData%AAA,1) - ReKiBuf(Re_Xferred) = InData%AAA(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AAP) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AAP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AAP,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%AAP,1), UBOUND(InData%AAP,1) - ReKiBuf(Re_Xferred) = InData%AAP(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ALF) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ALF,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ALF,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ALF,1), UBOUND(InData%ALF,1) - ReKiBuf(Re_Xferred) = InData%ALF(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CDD) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CDD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CDD,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%CDD,1), UBOUND(InData%CDD,1) - ReKiBuf(Re_Xferred) = InData%CDD(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CLL) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CLL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CLL,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%CLL,1), UBOUND(InData%CLL,1) - ReKiBuf(Re_Xferred) = InData%CLL(i1) - Re_Xferred = Re_Xferred + 1 - 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 - - DO i1 = LBOUND(InData%CMM,1), UBOUND(InData%CMM,1) - ReKiBuf(Re_Xferred) = InData%CMM(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CNN) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CNN,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CNN,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%CNN,1), UBOUND(InData%CNN,1) - ReKiBuf(Re_Xferred) = InData%CNN(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CTT) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CTT,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CTT,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%CTT,1), UBOUND(InData%CTT,1) - ReKiBuf(Re_Xferred) = InData%CTT(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%DFNSAV) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DFNSAV,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DFNSAV,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%DFNSAV,1), UBOUND(InData%DFNSAV,1) - ReKiBuf(Re_Xferred) = InData%DFNSAV(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%DFTSAV) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DFTSAV,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DFTSAV,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%DFTSAV,1), UBOUND(InData%DFTSAV,1) - ReKiBuf(Re_Xferred) = InData%DFTSAV(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%DynPres) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DynPres,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DynPres,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%DynPres,1), UBOUND(InData%DynPres,1) - ReKiBuf(Re_Xferred) = InData%DynPres(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PMM) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PMM,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PMM,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PMM,1), UBOUND(InData%PMM,1) - ReKiBuf(Re_Xferred) = InData%PMM(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PITSAV) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PITSAV,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PITSAV,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PITSAV,1), UBOUND(InData%PITSAV,1) - ReKiBuf(Re_Xferred) = InData%PITSAV(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ReyNum) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ReyNum,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ReyNum,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ReyNum,1), UBOUND(InData%ReyNum,1) - ReKiBuf(Re_Xferred) = InData%ReyNum(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Gamma) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Gamma,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Gamma,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Gamma,1), UBOUND(InData%Gamma,1) - ReKiBuf(Re_Xferred) = InData%Gamma(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%SaveVX) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SaveVX,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SaveVX,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SaveVX,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SaveVX,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%SaveVX,2), UBOUND(InData%SaveVX,2) - DO i1 = LBOUND(InData%SaveVX,1), UBOUND(InData%SaveVX,1) - ReKiBuf(Re_Xferred) = InData%SaveVX(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%SaveVY) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SaveVY,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SaveVY,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SaveVY,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SaveVY,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%SaveVY,2), UBOUND(InData%SaveVY,2) - DO i1 = LBOUND(InData%SaveVY,1), UBOUND(InData%SaveVY,1) - ReKiBuf(Re_Xferred) = InData%SaveVY(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%SaveVZ) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SaveVZ,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SaveVZ,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SaveVZ,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SaveVZ,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%SaveVZ,2), UBOUND(InData%SaveVZ,2) - DO i1 = LBOUND(InData%SaveVZ,1), UBOUND(InData%SaveVZ,1) - ReKiBuf(Re_Xferred) = InData%SaveVZ(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - ReKiBuf(Re_Xferred) = InData%VXSAV - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%VYSAV - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%VZSAV - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumWndElOut - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%WndElPrList) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WndElPrList,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WndElPrList,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WndElPrList,1), UBOUND(InData%WndElPrList,1) - IntKiBuf(Int_Xferred) = InData%WndElPrList(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WndElPrNum) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WndElPrNum,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WndElPrNum,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WndElPrNum,1), UBOUND(InData%WndElPrNum,1) - IntKiBuf(Int_Xferred) = InData%WndElPrNum(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ElPrList) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ElPrList,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ElPrList,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ElPrList,1), UBOUND(InData%ElPrList,1) - IntKiBuf(Int_Xferred) = InData%ElPrList(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ElPrNum) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ElPrNum,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ElPrNum,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ElPrNum,1), UBOUND(InData%ElPrNum,1) - IntKiBuf(Int_Xferred) = InData%ElPrNum(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NumElOut - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE AD14_PackElOutParms - - SUBROUTINE AD14_UnPackElOutParms( 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(ElOutParms), 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 = 'AD14_UnPackElOutParms' - ! 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 ! AAA not allocated - Int_Xferred = Int_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%AAA)) DEALLOCATE(OutData%AAA) - ALLOCATE(OutData%AAA(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AAA.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%AAA,1), UBOUND(OutData%AAA,1) - OutData%AAA(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AAP not allocated - Int_Xferred = Int_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%AAP)) DEALLOCATE(OutData%AAP) - ALLOCATE(OutData%AAP(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AAP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%AAP,1), UBOUND(OutData%AAP,1) - OutData%AAP(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ALF not allocated - Int_Xferred = Int_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%ALF)) DEALLOCATE(OutData%ALF) - ALLOCATE(OutData%ALF(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ALF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ALF,1), UBOUND(OutData%ALF,1) - OutData%ALF(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CDD not allocated - Int_Xferred = Int_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%CDD)) DEALLOCATE(OutData%CDD) - ALLOCATE(OutData%CDD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CDD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%CDD,1), UBOUND(OutData%CDD,1) - OutData%CDD(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CLL not allocated - Int_Xferred = Int_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%CLL)) DEALLOCATE(OutData%CLL) - ALLOCATE(OutData%CLL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CLL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%CLL,1), UBOUND(OutData%CLL,1) - OutData%CLL(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - 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 - IF (ALLOCATED(OutData%CMM)) DEALLOCATE(OutData%CMM) - ALLOCATE(OutData%CMM(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CMM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%CMM,1), UBOUND(OutData%CMM,1) - OutData%CMM(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CNN not allocated - Int_Xferred = Int_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%CNN)) DEALLOCATE(OutData%CNN) - ALLOCATE(OutData%CNN(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CNN.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%CNN,1), UBOUND(OutData%CNN,1) - OutData%CNN(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CTT not allocated - Int_Xferred = Int_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%CTT)) DEALLOCATE(OutData%CTT) - ALLOCATE(OutData%CTT(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CTT.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%CTT,1), UBOUND(OutData%CTT,1) - OutData%CTT(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DFNSAV not allocated - Int_Xferred = Int_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%DFNSAV)) DEALLOCATE(OutData%DFNSAV) - ALLOCATE(OutData%DFNSAV(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DFNSAV.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%DFNSAV,1), UBOUND(OutData%DFNSAV,1) - OutData%DFNSAV(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DFTSAV not allocated - Int_Xferred = Int_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%DFTSAV)) DEALLOCATE(OutData%DFTSAV) - ALLOCATE(OutData%DFTSAV(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DFTSAV.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%DFTSAV,1), UBOUND(OutData%DFTSAV,1) - OutData%DFTSAV(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DynPres not allocated - Int_Xferred = Int_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%DynPres)) DEALLOCATE(OutData%DynPres) - ALLOCATE(OutData%DynPres(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DynPres.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%DynPres,1), UBOUND(OutData%DynPres,1) - OutData%DynPres(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PMM not allocated - Int_Xferred = Int_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%PMM)) DEALLOCATE(OutData%PMM) - ALLOCATE(OutData%PMM(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PMM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PMM,1), UBOUND(OutData%PMM,1) - OutData%PMM(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PITSAV not allocated - Int_Xferred = Int_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%PITSAV)) DEALLOCATE(OutData%PITSAV) - ALLOCATE(OutData%PITSAV(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PITSAV.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PITSAV,1), UBOUND(OutData%PITSAV,1) - OutData%PITSAV(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ReyNum not allocated - Int_Xferred = Int_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%ReyNum)) DEALLOCATE(OutData%ReyNum) - ALLOCATE(OutData%ReyNum(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ReyNum.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ReyNum,1), UBOUND(OutData%ReyNum,1) - OutData%ReyNum(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Gamma not allocated - Int_Xferred = Int_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%Gamma)) DEALLOCATE(OutData%Gamma) - ALLOCATE(OutData%Gamma(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Gamma.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Gamma,1), UBOUND(OutData%Gamma,1) - OutData%Gamma(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SaveVX not allocated - Int_Xferred = Int_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%SaveVX)) DEALLOCATE(OutData%SaveVX) - ALLOCATE(OutData%SaveVX(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SaveVX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%SaveVX,2), UBOUND(OutData%SaveVX,2) - DO i1 = LBOUND(OutData%SaveVX,1), UBOUND(OutData%SaveVX,1) - OutData%SaveVX(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SaveVY not allocated - Int_Xferred = Int_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%SaveVY)) DEALLOCATE(OutData%SaveVY) - ALLOCATE(OutData%SaveVY(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SaveVY.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%SaveVY,2), UBOUND(OutData%SaveVY,2) - DO i1 = LBOUND(OutData%SaveVY,1), UBOUND(OutData%SaveVY,1) - OutData%SaveVY(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SaveVZ not allocated - Int_Xferred = Int_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%SaveVZ)) DEALLOCATE(OutData%SaveVZ) - ALLOCATE(OutData%SaveVZ(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SaveVZ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%SaveVZ,2), UBOUND(OutData%SaveVZ,2) - DO i1 = LBOUND(OutData%SaveVZ,1), UBOUND(OutData%SaveVZ,1) - OutData%SaveVZ(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%VXSAV = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%VYSAV = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%VZSAV = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NumWndElOut = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WndElPrList not allocated - Int_Xferred = Int_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%WndElPrList)) DEALLOCATE(OutData%WndElPrList) - ALLOCATE(OutData%WndElPrList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WndElPrList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WndElPrList,1), UBOUND(OutData%WndElPrList,1) - OutData%WndElPrList(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WndElPrNum not allocated - Int_Xferred = Int_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%WndElPrNum)) DEALLOCATE(OutData%WndElPrNum) - ALLOCATE(OutData%WndElPrNum(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WndElPrNum.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WndElPrNum,1), UBOUND(OutData%WndElPrNum,1) - OutData%WndElPrNum(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ElPrList not allocated - Int_Xferred = Int_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%ElPrList)) DEALLOCATE(OutData%ElPrList) - ALLOCATE(OutData%ElPrList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ElPrList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ElPrList,1), UBOUND(OutData%ElPrList,1) - OutData%ElPrList(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ElPrNum not allocated - Int_Xferred = Int_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%ElPrNum)) DEALLOCATE(OutData%ElPrNum) - ALLOCATE(OutData%ElPrNum(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ElPrNum.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ElPrNum,1), UBOUND(OutData%ElPrNum,1) - OutData%ElPrNum(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - OutData%NumElOut = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE AD14_UnPackElOutParms - - SUBROUTINE AD14_CopyInducedVel( SrcInducedVelData, DstInducedVelData, CtrlCode, ErrStat, ErrMsg ) - TYPE(InducedVel), INTENT(IN) :: SrcInducedVelData - TYPE(InducedVel), INTENT(INOUT) :: DstInducedVelData - 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 = 'AD14_CopyInducedVel' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInducedVelData%SumInFl = SrcInducedVelData%SumInFl - END SUBROUTINE AD14_CopyInducedVel - - SUBROUTINE AD14_DestroyInducedVel( InducedVelData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(InducedVel), INTENT(INOUT) :: InducedVelData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyInducedVel' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE AD14_DestroyInducedVel - - SUBROUTINE AD14_PackInducedVel( 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(InducedVel), 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 = 'AD14_PackInducedVel' - ! 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 ! SumInFl - 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%SumInFl - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AD14_PackInducedVel - - SUBROUTINE AD14_UnPackInducedVel( 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(InducedVel), 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 = 'AD14_UnPackInducedVel' - ! 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%SumInFl = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AD14_UnPackInducedVel - - SUBROUTINE AD14_CopyInducedVelParms( SrcInducedVelParmsData, DstInducedVelParmsData, CtrlCode, ErrStat, ErrMsg ) - TYPE(InducedVelParms), INTENT(IN) :: SrcInducedVelParmsData - TYPE(InducedVelParms), INTENT(INOUT) :: DstInducedVelParmsData - 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 = 'AD14_CopyInducedVelParms' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInducedVelParmsData%AToler = SrcInducedVelParmsData%AToler - DstInducedVelParmsData%EqAIDmult = SrcInducedVelParmsData%EqAIDmult - DstInducedVelParmsData%EquilDA = SrcInducedVelParmsData%EquilDA - DstInducedVelParmsData%EquilDT = SrcInducedVelParmsData%EquilDT - DstInducedVelParmsData%TLoss = SrcInducedVelParmsData%TLoss - DstInducedVelParmsData%GTech = SrcInducedVelParmsData%GTech - DstInducedVelParmsData%HLoss = SrcInducedVelParmsData%HLoss - END SUBROUTINE AD14_CopyInducedVelParms - - SUBROUTINE AD14_DestroyInducedVelParms( InducedVelParmsData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(InducedVelParms), INTENT(INOUT) :: InducedVelParmsData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyInducedVelParms' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE AD14_DestroyInducedVelParms - - SUBROUTINE AD14_PackInducedVelParms( 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(InducedVelParms), 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 = 'AD14_PackInducedVelParms' - ! 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 ! AToler - Re_BufSz = Re_BufSz + 1 ! EqAIDmult - Int_BufSz = Int_BufSz + 1 ! EquilDA - Int_BufSz = Int_BufSz + 1 ! EquilDT - Int_BufSz = Int_BufSz + 1 ! TLoss - Int_BufSz = Int_BufSz + 1 ! GTech - Int_BufSz = Int_BufSz + 1 ! HLoss - 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%AToler - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%EqAIDmult - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%EquilDA, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%EquilDT, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%TLoss, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%GTech, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%HLoss, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE AD14_PackInducedVelParms - - SUBROUTINE AD14_UnPackInducedVelParms( 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(InducedVelParms), 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 = 'AD14_UnPackInducedVelParms' - ! 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%AToler = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%EqAIDmult = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%EquilDA = TRANSFER(IntKiBuf(Int_Xferred), OutData%EquilDA) - Int_Xferred = Int_Xferred + 1 - OutData%EquilDT = TRANSFER(IntKiBuf(Int_Xferred), OutData%EquilDT) - Int_Xferred = Int_Xferred + 1 - OutData%TLoss = TRANSFER(IntKiBuf(Int_Xferred), OutData%TLoss) - Int_Xferred = Int_Xferred + 1 - OutData%GTech = TRANSFER(IntKiBuf(Int_Xferred), OutData%GTech) - Int_Xferred = Int_Xferred + 1 - OutData%HLoss = TRANSFER(IntKiBuf(Int_Xferred), OutData%HLoss) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE AD14_UnPackInducedVelParms - - SUBROUTINE AD14_CopyRotor( SrcRotorData, DstRotorData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Rotor), INTENT(IN) :: SrcRotorData - TYPE(Rotor), INTENT(INOUT) :: DstRotorData - 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 = 'AD14_CopyRotor' -! - ErrStat = ErrID_None - ErrMsg = "" - DstRotorData%AVGINFL = SrcRotorData%AVGINFL - DstRotorData%CTILT = SrcRotorData%CTILT - DstRotorData%CYaw = SrcRotorData%CYaw - DstRotorData%REVS = SrcRotorData%REVS - DstRotorData%STILT = SrcRotorData%STILT - DstRotorData%SYaw = SrcRotorData%SYaw - DstRotorData%TILT = SrcRotorData%TILT - DstRotorData%YawAng = SrcRotorData%YawAng - DstRotorData%YawVEL = SrcRotorData%YawVEL - END SUBROUTINE AD14_CopyRotor - - SUBROUTINE AD14_DestroyRotor( RotorData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(Rotor), INTENT(INOUT) :: RotorData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyRotor' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE AD14_DestroyRotor - - SUBROUTINE AD14_PackRotor( 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(Rotor), 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 = 'AD14_PackRotor' - ! 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 ! AVGINFL - Re_BufSz = Re_BufSz + 1 ! CTILT - Re_BufSz = Re_BufSz + 1 ! CYaw - Re_BufSz = Re_BufSz + 1 ! REVS - Re_BufSz = Re_BufSz + 1 ! STILT - Re_BufSz = Re_BufSz + 1 ! SYaw - Re_BufSz = Re_BufSz + 1 ! TILT - Re_BufSz = Re_BufSz + 1 ! YawAng - Re_BufSz = Re_BufSz + 1 ! YawVEL - 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%AVGINFL - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%CTILT - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%CYaw - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%REVS - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%STILT - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%SYaw - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TILT - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%YawAng - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%YawVEL - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AD14_PackRotor - - SUBROUTINE AD14_UnPackRotor( 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(Rotor), 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 = 'AD14_UnPackRotor' - ! 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%AVGINFL = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%CTILT = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%CYaw = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%REVS = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%STILT = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SYaw = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TILT = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%YawAng = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%YawVEL = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AD14_UnPackRotor - - SUBROUTINE AD14_CopyRotorParms( SrcRotorParmsData, DstRotorParmsData, CtrlCode, ErrStat, ErrMsg ) - TYPE(RotorParms), INTENT(IN) :: SrcRotorParmsData - TYPE(RotorParms), INTENT(INOUT) :: DstRotorParmsData - 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 = 'AD14_CopyRotorParms' -! - ErrStat = ErrID_None - ErrMsg = "" - DstRotorParmsData%HH = SrcRotorParmsData%HH - END SUBROUTINE AD14_CopyRotorParms - - SUBROUTINE AD14_DestroyRotorParms( RotorParmsData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(RotorParms), INTENT(INOUT) :: RotorParmsData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyRotorParms' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE AD14_DestroyRotorParms - - SUBROUTINE AD14_PackRotorParms( 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(RotorParms), 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 = 'AD14_PackRotorParms' - ! 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 ! HH - 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%HH - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AD14_PackRotorParms - - SUBROUTINE AD14_UnPackRotorParms( 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(RotorParms), 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 = 'AD14_UnPackRotorParms' - ! 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%HH = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AD14_UnPackRotorParms - - SUBROUTINE AD14_CopyTwrPropsParms( SrcTwrPropsParmsData, DstTwrPropsParmsData, CtrlCode, ErrStat, ErrMsg ) - TYPE(TwrPropsParms), INTENT(IN) :: SrcTwrPropsParmsData - TYPE(TwrPropsParms), INTENT(INOUT) :: DstTwrPropsParmsData - 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 = 'AD14_CopyTwrPropsParms' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcTwrPropsParmsData%TwrHtFr)) THEN - i1_l = LBOUND(SrcTwrPropsParmsData%TwrHtFr,1) - i1_u = UBOUND(SrcTwrPropsParmsData%TwrHtFr,1) - IF (.NOT. ALLOCATED(DstTwrPropsParmsData%TwrHtFr)) THEN - ALLOCATE(DstTwrPropsParmsData%TwrHtFr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstTwrPropsParmsData%TwrHtFr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstTwrPropsParmsData%TwrHtFr = SrcTwrPropsParmsData%TwrHtFr -ENDIF -IF (ALLOCATED(SrcTwrPropsParmsData%TwrWid)) THEN - i1_l = LBOUND(SrcTwrPropsParmsData%TwrWid,1) - i1_u = UBOUND(SrcTwrPropsParmsData%TwrWid,1) - IF (.NOT. ALLOCATED(DstTwrPropsParmsData%TwrWid)) THEN - ALLOCATE(DstTwrPropsParmsData%TwrWid(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstTwrPropsParmsData%TwrWid.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstTwrPropsParmsData%TwrWid = SrcTwrPropsParmsData%TwrWid -ENDIF -IF (ALLOCATED(SrcTwrPropsParmsData%TwrCD)) THEN - i1_l = LBOUND(SrcTwrPropsParmsData%TwrCD,1) - i1_u = UBOUND(SrcTwrPropsParmsData%TwrCD,1) - i2_l = LBOUND(SrcTwrPropsParmsData%TwrCD,2) - i2_u = UBOUND(SrcTwrPropsParmsData%TwrCD,2) - IF (.NOT. ALLOCATED(DstTwrPropsParmsData%TwrCD)) THEN - ALLOCATE(DstTwrPropsParmsData%TwrCD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstTwrPropsParmsData%TwrCD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstTwrPropsParmsData%TwrCD = SrcTwrPropsParmsData%TwrCD -ENDIF -IF (ALLOCATED(SrcTwrPropsParmsData%TwrRe)) THEN - i1_l = LBOUND(SrcTwrPropsParmsData%TwrRe,1) - i1_u = UBOUND(SrcTwrPropsParmsData%TwrRe,1) - IF (.NOT. ALLOCATED(DstTwrPropsParmsData%TwrRe)) THEN - ALLOCATE(DstTwrPropsParmsData%TwrRe(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstTwrPropsParmsData%TwrRe.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstTwrPropsParmsData%TwrRe = SrcTwrPropsParmsData%TwrRe -ENDIF - DstTwrPropsParmsData%VTwr = SrcTwrPropsParmsData%VTwr - DstTwrPropsParmsData%Tower_Wake_Constant = SrcTwrPropsParmsData%Tower_Wake_Constant -IF (ALLOCATED(SrcTwrPropsParmsData%NTwrCDCol)) THEN - i1_l = LBOUND(SrcTwrPropsParmsData%NTwrCDCol,1) - i1_u = UBOUND(SrcTwrPropsParmsData%NTwrCDCol,1) - IF (.NOT. ALLOCATED(DstTwrPropsParmsData%NTwrCDCol)) THEN - ALLOCATE(DstTwrPropsParmsData%NTwrCDCol(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstTwrPropsParmsData%NTwrCDCol.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstTwrPropsParmsData%NTwrCDCol = SrcTwrPropsParmsData%NTwrCDCol -ENDIF - DstTwrPropsParmsData%NTwrHT = SrcTwrPropsParmsData%NTwrHT - DstTwrPropsParmsData%NTwrRe = SrcTwrPropsParmsData%NTwrRe - DstTwrPropsParmsData%NTwrCD = SrcTwrPropsParmsData%NTwrCD - DstTwrPropsParmsData%TwrPotent = SrcTwrPropsParmsData%TwrPotent - DstTwrPropsParmsData%TwrShadow = SrcTwrPropsParmsData%TwrShadow - DstTwrPropsParmsData%ShadHWid = SrcTwrPropsParmsData%ShadHWid - DstTwrPropsParmsData%TShadC1 = SrcTwrPropsParmsData%TShadC1 - DstTwrPropsParmsData%TShadC2 = SrcTwrPropsParmsData%TShadC2 - DstTwrPropsParmsData%TwrShad = SrcTwrPropsParmsData%TwrShad - DstTwrPropsParmsData%PJM_Version = SrcTwrPropsParmsData%PJM_Version - DstTwrPropsParmsData%TwrFile = SrcTwrPropsParmsData%TwrFile - DstTwrPropsParmsData%T_Shad_Refpt = SrcTwrPropsParmsData%T_Shad_Refpt - DstTwrPropsParmsData%CalcTwrAero = SrcTwrPropsParmsData%CalcTwrAero - DstTwrPropsParmsData%NumTwrNodes = SrcTwrPropsParmsData%NumTwrNodes -IF (ALLOCATED(SrcTwrPropsParmsData%TwrNodeWidth)) THEN - i1_l = LBOUND(SrcTwrPropsParmsData%TwrNodeWidth,1) - i1_u = UBOUND(SrcTwrPropsParmsData%TwrNodeWidth,1) - IF (.NOT. ALLOCATED(DstTwrPropsParmsData%TwrNodeWidth)) THEN - ALLOCATE(DstTwrPropsParmsData%TwrNodeWidth(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstTwrPropsParmsData%TwrNodeWidth.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstTwrPropsParmsData%TwrNodeWidth = SrcTwrPropsParmsData%TwrNodeWidth -ENDIF - END SUBROUTINE AD14_CopyTwrPropsParms - - SUBROUTINE AD14_DestroyTwrPropsParms( TwrPropsParmsData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(TwrPropsParms), INTENT(INOUT) :: TwrPropsParmsData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyTwrPropsParms' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(TwrPropsParmsData%TwrHtFr)) THEN - DEALLOCATE(TwrPropsParmsData%TwrHtFr) -ENDIF -IF (ALLOCATED(TwrPropsParmsData%TwrWid)) THEN - DEALLOCATE(TwrPropsParmsData%TwrWid) -ENDIF -IF (ALLOCATED(TwrPropsParmsData%TwrCD)) THEN - DEALLOCATE(TwrPropsParmsData%TwrCD) -ENDIF -IF (ALLOCATED(TwrPropsParmsData%TwrRe)) THEN - DEALLOCATE(TwrPropsParmsData%TwrRe) -ENDIF -IF (ALLOCATED(TwrPropsParmsData%NTwrCDCol)) THEN - DEALLOCATE(TwrPropsParmsData%NTwrCDCol) -ENDIF -IF (ALLOCATED(TwrPropsParmsData%TwrNodeWidth)) THEN - DEALLOCATE(TwrPropsParmsData%TwrNodeWidth) -ENDIF - END SUBROUTINE AD14_DestroyTwrPropsParms - - SUBROUTINE AD14_PackTwrPropsParms( 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(TwrPropsParms), 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 = 'AD14_PackTwrPropsParms' - ! 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 ! TwrHtFr allocated yes/no - IF ( ALLOCATED(InData%TwrHtFr) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TwrHtFr upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TwrHtFr) ! TwrHtFr - END IF - Int_BufSz = Int_BufSz + 1 ! TwrWid allocated yes/no - IF ( ALLOCATED(InData%TwrWid) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TwrWid upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TwrWid) ! TwrWid - END IF - Int_BufSz = Int_BufSz + 1 ! TwrCD allocated yes/no - IF ( ALLOCATED(InData%TwrCD) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! TwrCD upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TwrCD) ! TwrCD - END IF - Int_BufSz = Int_BufSz + 1 ! TwrRe allocated yes/no - IF ( ALLOCATED(InData%TwrRe) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TwrRe upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TwrRe) ! TwrRe - END IF - Re_BufSz = Re_BufSz + SIZE(InData%VTwr) ! VTwr - Re_BufSz = Re_BufSz + 1 ! Tower_Wake_Constant - Int_BufSz = Int_BufSz + 1 ! NTwrCDCol allocated yes/no - IF ( ALLOCATED(InData%NTwrCDCol) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! NTwrCDCol upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%NTwrCDCol) ! NTwrCDCol - END IF - Int_BufSz = Int_BufSz + 1 ! NTwrHT - Int_BufSz = Int_BufSz + 1 ! NTwrRe - Int_BufSz = Int_BufSz + 1 ! NTwrCD - Int_BufSz = Int_BufSz + 1 ! TwrPotent - Int_BufSz = Int_BufSz + 1 ! TwrShadow - Re_BufSz = Re_BufSz + 1 ! ShadHWid - Re_BufSz = Re_BufSz + 1 ! TShadC1 - Re_BufSz = Re_BufSz + 1 ! TShadC2 - Re_BufSz = Re_BufSz + 1 ! TwrShad - Int_BufSz = Int_BufSz + 1 ! PJM_Version - Int_BufSz = Int_BufSz + 1*LEN(InData%TwrFile) ! TwrFile - Re_BufSz = Re_BufSz + 1 ! T_Shad_Refpt - Int_BufSz = Int_BufSz + 1 ! CalcTwrAero - Int_BufSz = Int_BufSz + 1 ! NumTwrNodes - Int_BufSz = Int_BufSz + 1 ! TwrNodeWidth allocated yes/no - IF ( ALLOCATED(InData%TwrNodeWidth) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TwrNodeWidth upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TwrNodeWidth) ! TwrNodeWidth - 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%TwrHtFr) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwrHtFr,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrHtFr,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TwrHtFr,1), UBOUND(InData%TwrHtFr,1) - ReKiBuf(Re_Xferred) = InData%TwrHtFr(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TwrWid) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwrWid,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrWid,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TwrWid,1), UBOUND(InData%TwrWid,1) - ReKiBuf(Re_Xferred) = InData%TwrWid(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TwrCD) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwrCD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrCD,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwrCD,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrCD,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%TwrCD,2), UBOUND(InData%TwrCD,2) - DO i1 = LBOUND(InData%TwrCD,1), UBOUND(InData%TwrCD,1) - ReKiBuf(Re_Xferred) = InData%TwrCD(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TwrRe) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwrRe,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrRe,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TwrRe,1), UBOUND(InData%TwrRe,1) - ReKiBuf(Re_Xferred) = InData%TwrRe(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - DO i1 = LBOUND(InData%VTwr,1), UBOUND(InData%VTwr,1) - ReKiBuf(Re_Xferred) = InData%VTwr(i1) - Re_Xferred = Re_Xferred + 1 - END DO - ReKiBuf(Re_Xferred) = InData%Tower_Wake_Constant - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%NTwrCDCol) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%NTwrCDCol,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NTwrCDCol,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%NTwrCDCol,1), UBOUND(InData%NTwrCDCol,1) - IntKiBuf(Int_Xferred) = InData%NTwrCDCol(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NTwrHT - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NTwrRe - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NTwrCD - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%TwrPotent, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%TwrShadow, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%ShadHWid - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TShadC1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TShadC2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TwrShad - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%PJM_Version, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%TwrFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%TwrFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - ReKiBuf(Re_Xferred) = InData%T_Shad_Refpt - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%CalcTwrAero, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumTwrNodes - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%TwrNodeWidth) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwrNodeWidth,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrNodeWidth,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TwrNodeWidth,1), UBOUND(InData%TwrNodeWidth,1) - ReKiBuf(Re_Xferred) = InData%TwrNodeWidth(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE AD14_PackTwrPropsParms - - SUBROUTINE AD14_UnPackTwrPropsParms( 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(TwrPropsParms), 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 = 'AD14_UnPackTwrPropsParms' - ! 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 ! TwrHtFr not allocated - Int_Xferred = Int_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%TwrHtFr)) DEALLOCATE(OutData%TwrHtFr) - ALLOCATE(OutData%TwrHtFr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrHtFr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TwrHtFr,1), UBOUND(OutData%TwrHtFr,1) - OutData%TwrHtFr(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrWid not allocated - Int_Xferred = Int_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%TwrWid)) DEALLOCATE(OutData%TwrWid) - ALLOCATE(OutData%TwrWid(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrWid.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TwrWid,1), UBOUND(OutData%TwrWid,1) - OutData%TwrWid(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrCD not allocated - Int_Xferred = Int_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%TwrCD)) DEALLOCATE(OutData%TwrCD) - ALLOCATE(OutData%TwrCD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrCD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%TwrCD,2), UBOUND(OutData%TwrCD,2) - DO i1 = LBOUND(OutData%TwrCD,1), UBOUND(OutData%TwrCD,1) - OutData%TwrCD(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrRe not allocated - Int_Xferred = Int_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%TwrRe)) DEALLOCATE(OutData%TwrRe) - ALLOCATE(OutData%TwrRe(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrRe.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TwrRe,1), UBOUND(OutData%TwrRe,1) - OutData%TwrRe(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - i1_l = LBOUND(OutData%VTwr,1) - i1_u = UBOUND(OutData%VTwr,1) - DO i1 = LBOUND(OutData%VTwr,1), UBOUND(OutData%VTwr,1) - OutData%VTwr(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%Tower_Wake_Constant = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NTwrCDCol not allocated - Int_Xferred = Int_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%NTwrCDCol)) DEALLOCATE(OutData%NTwrCDCol) - ALLOCATE(OutData%NTwrCDCol(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NTwrCDCol.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%NTwrCDCol,1), UBOUND(OutData%NTwrCDCol,1) - OutData%NTwrCDCol(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - OutData%NTwrHT = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NTwrRe = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NTwrCD = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TwrPotent = TRANSFER(IntKiBuf(Int_Xferred), OutData%TwrPotent) - Int_Xferred = Int_Xferred + 1 - OutData%TwrShadow = TRANSFER(IntKiBuf(Int_Xferred), OutData%TwrShadow) - Int_Xferred = Int_Xferred + 1 - OutData%ShadHWid = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TShadC1 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TShadC2 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TwrShad = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PJM_Version = TRANSFER(IntKiBuf(Int_Xferred), OutData%PJM_Version) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%TwrFile) - OutData%TwrFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%T_Shad_Refpt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%CalcTwrAero = TRANSFER(IntKiBuf(Int_Xferred), OutData%CalcTwrAero) - Int_Xferred = Int_Xferred + 1 - OutData%NumTwrNodes = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrNodeWidth not allocated - Int_Xferred = Int_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%TwrNodeWidth)) DEALLOCATE(OutData%TwrNodeWidth) - ALLOCATE(OutData%TwrNodeWidth(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrNodeWidth.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TwrNodeWidth,1), UBOUND(OutData%TwrNodeWidth,1) - OutData%TwrNodeWidth(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE AD14_UnPackTwrPropsParms - - SUBROUTINE AD14_CopyWind( SrcWindData, DstWindData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Wind), INTENT(IN) :: SrcWindData - TYPE(Wind), INTENT(INOUT) :: DstWindData - 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 = 'AD14_CopyWind' -! - ErrStat = ErrID_None - ErrMsg = "" - DstWindData%ANGFLW = SrcWindData%ANGFLW - DstWindData%CDEL = SrcWindData%CDEL - DstWindData%VROTORX = SrcWindData%VROTORX - DstWindData%VROTORY = SrcWindData%VROTORY - DstWindData%VROTORZ = SrcWindData%VROTORZ - DstWindData%SDEL = SrcWindData%SDEL - END SUBROUTINE AD14_CopyWind - - SUBROUTINE AD14_DestroyWind( WindData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(Wind), INTENT(INOUT) :: WindData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyWind' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE AD14_DestroyWind - - SUBROUTINE AD14_PackWind( 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(Wind), 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 = 'AD14_PackWind' - ! 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 ! ANGFLW - Re_BufSz = Re_BufSz + 1 ! CDEL - Re_BufSz = Re_BufSz + 1 ! VROTORX - Re_BufSz = Re_BufSz + 1 ! VROTORY - Re_BufSz = Re_BufSz + 1 ! VROTORZ - Re_BufSz = Re_BufSz + 1 ! SDEL - 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%ANGFLW - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%CDEL - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%VROTORX - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%VROTORY - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%VROTORZ - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%SDEL - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AD14_PackWind - - SUBROUTINE AD14_UnPackWind( 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(Wind), 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 = 'AD14_UnPackWind' - ! 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%ANGFLW = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%CDEL = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%VROTORX = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%VROTORY = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%VROTORZ = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SDEL = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AD14_UnPackWind - - SUBROUTINE AD14_CopyWindParms( SrcWindParmsData, DstWindParmsData, CtrlCode, ErrStat, ErrMsg ) - TYPE(WindParms), INTENT(IN) :: SrcWindParmsData - TYPE(WindParms), INTENT(INOUT) :: DstWindParmsData - 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 = 'AD14_CopyWindParms' -! - ErrStat = ErrID_None - ErrMsg = "" - DstWindParmsData%Rho = SrcWindParmsData%Rho - DstWindParmsData%KinVisc = SrcWindParmsData%KinVisc - END SUBROUTINE AD14_CopyWindParms - - SUBROUTINE AD14_DestroyWindParms( WindParmsData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(WindParms), INTENT(INOUT) :: WindParmsData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyWindParms' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE AD14_DestroyWindParms - - SUBROUTINE AD14_PackWindParms( 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(WindParms), 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 = 'AD14_PackWindParms' - ! 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 ! Rho - Re_BufSz = Re_BufSz + 1 ! KinVisc - 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%Rho - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%KinVisc - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AD14_PackWindParms - - SUBROUTINE AD14_UnPackWindParms( 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(WindParms), 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 = 'AD14_UnPackWindParms' - ! 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%Rho = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%KinVisc = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AD14_UnPackWindParms - - SUBROUTINE AD14_CopyPositionType( SrcPositionTypeData, DstPositionTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(PositionType), INTENT(IN) :: SrcPositionTypeData - TYPE(PositionType), INTENT(INOUT) :: DstPositionTypeData - 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 = 'AD14_CopyPositionType' -! - ErrStat = ErrID_None - ErrMsg = "" - DstPositionTypeData%Pos = SrcPositionTypeData%Pos - END SUBROUTINE AD14_CopyPositionType - - SUBROUTINE AD14_DestroyPositionType( PositionTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(PositionType), INTENT(INOUT) :: PositionTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyPositionType' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE AD14_DestroyPositionType - - SUBROUTINE AD14_PackPositionType( 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(PositionType), 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 = 'AD14_PackPositionType' - ! 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%Pos) ! Pos - 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%Pos,1), UBOUND(InData%Pos,1) - ReKiBuf(Re_Xferred) = InData%Pos(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END SUBROUTINE AD14_PackPositionType - - SUBROUTINE AD14_UnPackPositionType( 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(PositionType), 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 = 'AD14_UnPackPositionType' - ! 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%Pos,1) - i1_u = UBOUND(OutData%Pos,1) - DO i1 = LBOUND(OutData%Pos,1), UBOUND(OutData%Pos,1) - OutData%Pos(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END SUBROUTINE AD14_UnPackPositionType - - SUBROUTINE AD14_CopyOrientationType( SrcOrientationTypeData, DstOrientationTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(OrientationType), INTENT(IN) :: SrcOrientationTypeData - TYPE(OrientationType), INTENT(INOUT) :: DstOrientationTypeData - 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 = 'AD14_CopyOrientationType' -! - ErrStat = ErrID_None - ErrMsg = "" - DstOrientationTypeData%Orient = SrcOrientationTypeData%Orient - END SUBROUTINE AD14_CopyOrientationType - - SUBROUTINE AD14_DestroyOrientationType( OrientationTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(OrientationType), INTENT(INOUT) :: OrientationTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyOrientationType' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE AD14_DestroyOrientationType - - SUBROUTINE AD14_PackOrientationType( 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(OrientationType), 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 = 'AD14_PackOrientationType' - ! 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%Orient) ! Orient - 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%Orient,2), UBOUND(InData%Orient,2) - DO i1 = LBOUND(InData%Orient,1), UBOUND(InData%Orient,1) - ReKiBuf(Re_Xferred) = InData%Orient(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END SUBROUTINE AD14_PackOrientationType - - SUBROUTINE AD14_UnPackOrientationType( 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(OrientationType), 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 = 'AD14_UnPackOrientationType' - ! 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%Orient,1) - i1_u = UBOUND(OutData%Orient,1) - i2_l = LBOUND(OutData%Orient,2) - i2_u = UBOUND(OutData%Orient,2) - DO i2 = LBOUND(OutData%Orient,2), UBOUND(OutData%Orient,2) - DO i1 = LBOUND(OutData%Orient,1), UBOUND(OutData%Orient,1) - OutData%Orient(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END SUBROUTINE AD14_UnPackOrientationType - - SUBROUTINE AD14_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AD14_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(AD14_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 = 'AD14_CopyInitInput' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInitInputData%Title = SrcInitInputData%Title - DstInitInputData%OutRootName = SrcInitInputData%OutRootName - DstInitInputData%ADFileName = SrcInitInputData%ADFileName - DstInitInputData%WrSumFile = SrcInitInputData%WrSumFile - DstInitInputData%NumBl = SrcInitInputData%NumBl - DstInitInputData%BladeLength = SrcInitInputData%BladeLength - DstInitInputData%LinearizeFlag = SrcInitInputData%LinearizeFlag - DstInitInputData%UseDWM = SrcInitInputData%UseDWM - CALL AD14_Copyaeroconfig( SrcInitInputData%TurbineComponents, DstInitInputData%TurbineComponents, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstInitInputData%NumTwrNodes = SrcInitInputData%NumTwrNodes -IF (ALLOCATED(SrcInitInputData%TwrNodeLocs)) THEN - i1_l = LBOUND(SrcInitInputData%TwrNodeLocs,1) - i1_u = UBOUND(SrcInitInputData%TwrNodeLocs,1) - i2_l = LBOUND(SrcInitInputData%TwrNodeLocs,2) - i2_u = UBOUND(SrcInitInputData%TwrNodeLocs,2) - IF (.NOT. ALLOCATED(DstInitInputData%TwrNodeLocs)) THEN - ALLOCATE(DstInitInputData%TwrNodeLocs(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%TwrNodeLocs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%TwrNodeLocs = SrcInitInputData%TwrNodeLocs -ENDIF - DstInitInputData%HubHt = SrcInitInputData%HubHt - CALL DWM_CopyInitInput( SrcInitInputData%DWM, DstInitInputData%DWM, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE AD14_CopyInitInput - - SUBROUTINE AD14_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(AD14_InitInputType), INTENT(INOUT) :: InitInputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyInitInput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL AD14_Destroyaeroconfig( InitInputData%TurbineComponents, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(InitInputData%TwrNodeLocs)) THEN - DEALLOCATE(InitInputData%TwrNodeLocs) -ENDIF - CALL DWM_DestroyInitInput( InitInputData%DWM, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE AD14_DestroyInitInput - - SUBROUTINE AD14_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(AD14_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 = 'AD14_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%Title) ! Title - Int_BufSz = Int_BufSz + 1*LEN(InData%OutRootName) ! OutRootName - Int_BufSz = Int_BufSz + 1*LEN(InData%ADFileName) ! ADFileName - Int_BufSz = Int_BufSz + 1 ! WrSumFile - Int_BufSz = Int_BufSz + 1 ! NumBl - Re_BufSz = Re_BufSz + 1 ! BladeLength - Int_BufSz = Int_BufSz + 1 ! LinearizeFlag - Int_BufSz = Int_BufSz + 1 ! UseDWM - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! TurbineComponents: size of buffers for each call to pack subtype - CALL AD14_Packaeroconfig( Re_Buf, Db_Buf, Int_Buf, InData%TurbineComponents, ErrStat2, ErrMsg2, .TRUE. ) ! TurbineComponents - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! TurbineComponents - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! TurbineComponents - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! TurbineComponents - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! NumTwrNodes - Int_BufSz = Int_BufSz + 1 ! TwrNodeLocs allocated yes/no - IF ( ALLOCATED(InData%TwrNodeLocs) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! TwrNodeLocs upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TwrNodeLocs) ! TwrNodeLocs - END IF - Re_BufSz = Re_BufSz + 1 ! HubHt - Int_BufSz = Int_BufSz + 3 ! DWM: size of buffers for each call to pack subtype - CALL DWM_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%DWM, ErrStat2, ErrMsg2, .TRUE. ) ! DWM - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! DWM - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! DWM - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! DWM - 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%Title) - IntKiBuf(Int_Xferred) = ICHAR(InData%Title(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%OutRootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutRootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%ADFileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%ADFileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = TRANSFER(InData%WrSumFile, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumBl - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%BladeLength - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%LinearizeFlag, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%UseDWM, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - CALL AD14_Packaeroconfig( Re_Buf, Db_Buf, Int_Buf, InData%TurbineComponents, ErrStat2, ErrMsg2, OnlySize ) ! TurbineComponents - 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%NumTwrNodes - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%TwrNodeLocs) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwrNodeLocs,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrNodeLocs,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwrNodeLocs,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrNodeLocs,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%TwrNodeLocs,2), UBOUND(InData%TwrNodeLocs,2) - DO i1 = LBOUND(InData%TwrNodeLocs,1), UBOUND(InData%TwrNodeLocs,1) - ReKiBuf(Re_Xferred) = InData%TwrNodeLocs(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - ReKiBuf(Re_Xferred) = InData%HubHt - Re_Xferred = Re_Xferred + 1 - CALL DWM_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%DWM, ErrStat2, ErrMsg2, OnlySize ) ! DWM - 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 AD14_PackInitInput - - SUBROUTINE AD14_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(AD14_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 = 'AD14_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%Title) - OutData%Title(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%OutRootName) - OutData%OutRootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%ADFileName) - OutData%ADFileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%WrSumFile = TRANSFER(IntKiBuf(Int_Xferred), OutData%WrSumFile) - Int_Xferred = Int_Xferred + 1 - OutData%NumBl = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%BladeLength = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%LinearizeFlag = TRANSFER(IntKiBuf(Int_Xferred), OutData%LinearizeFlag) - Int_Xferred = Int_Xferred + 1 - OutData%UseDWM = TRANSFER(IntKiBuf(Int_Xferred), OutData%UseDWM) - 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 AD14_Unpackaeroconfig( Re_Buf, Db_Buf, Int_Buf, OutData%TurbineComponents, ErrStat2, ErrMsg2 ) ! TurbineComponents - 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%NumTwrNodes = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrNodeLocs not allocated - Int_Xferred = Int_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%TwrNodeLocs)) DEALLOCATE(OutData%TwrNodeLocs) - ALLOCATE(OutData%TwrNodeLocs(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrNodeLocs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%TwrNodeLocs,2), UBOUND(OutData%TwrNodeLocs,2) - DO i1 = LBOUND(OutData%TwrNodeLocs,1), UBOUND(OutData%TwrNodeLocs,1) - OutData%TwrNodeLocs(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%HubHt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_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 DWM_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%DWM, ErrStat2, ErrMsg2 ) ! DWM - 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 AD14_UnPackInitInput - - SUBROUTINE AD14_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AD14_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(AD14_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 = 'AD14_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 - CALL DWM_CopyInitOutput( SrcInitOutputData%DWM, DstInitOutputData%DWM, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstInitOutputData%AirDens = SrcInitOutputData%AirDens - END SUBROUTINE AD14_CopyInitOutput - - SUBROUTINE AD14_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(AD14_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyInitOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL NWTC_Library_Destroyprogdesc( InitOutputData%Ver, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL DWM_DestroyInitOutput( InitOutputData%DWM, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE AD14_DestroyInitOutput - - SUBROUTINE AD14_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(AD14_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 = 'AD14_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 + 3 ! DWM: size of buffers for each call to pack subtype - CALL DWM_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%DWM, ErrStat2, ErrMsg2, .TRUE. ) ! DWM - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! DWM - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! DWM - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! DWM - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Re_BufSz = Re_BufSz + 1 ! AirDens - 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 - CALL DWM_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%DWM, ErrStat2, ErrMsg2, OnlySize ) ! DWM - 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 - ReKiBuf(Re_Xferred) = InData%AirDens - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AD14_PackInitOutput - - SUBROUTINE AD14_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(AD14_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 = 'AD14_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) - 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 DWM_UnpackInitOutput( Re_Buf, Db_Buf, Int_Buf, OutData%DWM, ErrStat2, ErrMsg2 ) ! DWM - 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%AirDens = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AD14_UnPackInitOutput - - SUBROUTINE AD14_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AD14_ContinuousStateType), INTENT(IN) :: SrcContStateData - TYPE(AD14_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 = 'AD14_CopyContState' -! - ErrStat = ErrID_None - ErrMsg = "" - CALL DWM_CopyContState( SrcContStateData%DWM, DstContStateData%DWM, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE AD14_CopyContState - - SUBROUTINE AD14_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(AD14_ContinuousStateType), INTENT(INOUT) :: ContStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyContState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL DWM_DestroyContState( ContStateData%DWM, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE AD14_DestroyContState - - SUBROUTINE AD14_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(AD14_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 = 'AD14_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 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! DWM: size of buffers for each call to pack subtype - CALL DWM_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%DWM, ErrStat2, ErrMsg2, .TRUE. ) ! DWM - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! DWM - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! DWM - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! DWM - 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 DWM_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%DWM, ErrStat2, ErrMsg2, OnlySize ) ! DWM - 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 AD14_PackContState - - SUBROUTINE AD14_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(AD14_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 = 'AD14_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 - 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 DWM_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%DWM, ErrStat2, ErrMsg2 ) ! DWM - 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 AD14_UnPackContState - - SUBROUTINE AD14_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AD14_DiscreteStateType), INTENT(IN) :: SrcDiscStateData - TYPE(AD14_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 = 'AD14_CopyDiscState' -! - ErrStat = ErrID_None - ErrMsg = "" - CALL DWM_CopyDiscState( SrcDiscStateData%DWM, DstDiscStateData%DWM, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE AD14_CopyDiscState - - SUBROUTINE AD14_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(AD14_DiscreteStateType), INTENT(INOUT) :: DiscStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyDiscState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL DWM_DestroyDiscState( DiscStateData%DWM, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE AD14_DestroyDiscState - - SUBROUTINE AD14_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(AD14_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 = 'AD14_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 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! DWM: size of buffers for each call to pack subtype - CALL DWM_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%DWM, ErrStat2, ErrMsg2, .TRUE. ) ! DWM - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! DWM - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! DWM - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! DWM - 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 DWM_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%DWM, ErrStat2, ErrMsg2, OnlySize ) ! DWM - 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 AD14_PackDiscState - - SUBROUTINE AD14_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(AD14_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 = 'AD14_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 - 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 DWM_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%DWM, ErrStat2, ErrMsg2 ) ! DWM - 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 AD14_UnPackDiscState - - SUBROUTINE AD14_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AD14_ConstraintStateType), INTENT(IN) :: SrcConstrStateData - TYPE(AD14_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 = 'AD14_CopyConstrState' -! - ErrStat = ErrID_None - ErrMsg = "" - CALL DWM_CopyConstrState( SrcConstrStateData%DWM, DstConstrStateData%DWM, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE AD14_CopyConstrState - - SUBROUTINE AD14_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(AD14_ConstraintStateType), INTENT(INOUT) :: ConstrStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyConstrState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL DWM_DestroyConstrState( ConstrStateData%DWM, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE AD14_DestroyConstrState - - SUBROUTINE AD14_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(AD14_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 = 'AD14_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 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! DWM: size of buffers for each call to pack subtype - CALL DWM_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%DWM, ErrStat2, ErrMsg2, .TRUE. ) ! DWM - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! DWM - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! DWM - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! DWM - 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 DWM_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%DWM, ErrStat2, ErrMsg2, OnlySize ) ! DWM - 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 AD14_PackConstrState - - SUBROUTINE AD14_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(AD14_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 = 'AD14_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 - 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 DWM_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%DWM, ErrStat2, ErrMsg2 ) ! DWM - 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 AD14_UnPackConstrState - - SUBROUTINE AD14_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AD14_OtherStateType), INTENT(IN) :: SrcOtherStateData - TYPE(AD14_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 = 'AD14_CopyOtherState' -! - ErrStat = ErrID_None - ErrMsg = "" - CALL DWM_CopyOtherState( SrcOtherStateData%DWM, DstOtherStateData%DWM, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE AD14_CopyOtherState - - SUBROUTINE AD14_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(AD14_OtherStateType), INTENT(INOUT) :: OtherStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyOtherState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL DWM_DestroyOtherState( OtherStateData%DWM, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE AD14_DestroyOtherState - - SUBROUTINE AD14_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(AD14_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 = 'AD14_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 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! DWM: size of buffers for each call to pack subtype - CALL DWM_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%DWM, ErrStat2, ErrMsg2, .TRUE. ) ! DWM - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! DWM - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! DWM - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! DWM - 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 DWM_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%DWM, ErrStat2, ErrMsg2, OnlySize ) ! DWM - 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 AD14_PackOtherState - - SUBROUTINE AD14_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(AD14_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 = 'AD14_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 - 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 DWM_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%DWM, ErrStat2, ErrMsg2 ) ! DWM - 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 AD14_UnPackOtherState - - SUBROUTINE AD14_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AD14_MiscVarType), INTENT(IN) :: SrcMiscData - TYPE(AD14_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) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_CopyMisc' -! - ErrStat = ErrID_None - ErrMsg = "" - CALL DWM_CopyMisc( SrcMiscData%DWM, DstMiscData%DWM, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL DWM_CopyInput( SrcMiscData%DWM_Inputs, DstMiscData%DWM_Inputs, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL DWM_CopyOutput( SrcMiscData%DWM_Outputs, DstMiscData%DWM_Outputs, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstMiscData%DT = SrcMiscData%DT -IF (ALLOCATED(SrcMiscData%ElPrNum)) THEN - i1_l = LBOUND(SrcMiscData%ElPrNum,1) - i1_u = UBOUND(SrcMiscData%ElPrNum,1) - IF (.NOT. ALLOCATED(DstMiscData%ElPrNum)) THEN - ALLOCATE(DstMiscData%ElPrNum(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%ElPrNum.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%ElPrNum = SrcMiscData%ElPrNum -ENDIF - DstMiscData%OldTime = SrcMiscData%OldTime - DstMiscData%HubLoss = SrcMiscData%HubLoss - DstMiscData%Loss = SrcMiscData%Loss - DstMiscData%TipLoss = SrcMiscData%TipLoss - DstMiscData%TLpt7 = SrcMiscData%TLpt7 - DstMiscData%FirstPassGTL = SrcMiscData%FirstPassGTL - DstMiscData%SuperSonic = SrcMiscData%SuperSonic - DstMiscData%AFLAGVinderr = SrcMiscData%AFLAGVinderr - DstMiscData%AFLAGTwrInflu = SrcMiscData%AFLAGTwrInflu - DstMiscData%OnePassDynDbg = SrcMiscData%OnePassDynDbg - DstMiscData%NoLoadsCalculated = SrcMiscData%NoLoadsCalculated - DstMiscData%NERRORS = SrcMiscData%NERRORS - CALL AD14_Copyairfoil( SrcMiscData%AirFoil, DstMiscData%AirFoil, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD14_Copybeddoes( SrcMiscData%Beddoes, DstMiscData%Beddoes, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD14_Copydyninflow( SrcMiscData%DynInflow, DstMiscData%DynInflow, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD14_Copyelement( SrcMiscData%Element, DstMiscData%Element, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD14_Copyrotor( SrcMiscData%Rotor, DstMiscData%Rotor, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD14_Copywind( SrcMiscData%Wind, DstMiscData%Wind, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD14_Copyinducedvel( SrcMiscData%InducedVel, DstMiscData%InducedVel, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD14_Copyeloutparms( SrcMiscData%ElOut, DstMiscData%ElOut, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstMiscData%Skew = SrcMiscData%Skew - DstMiscData%DynInit = SrcMiscData%DynInit - DstMiscData%FirstWarn = SrcMiscData%FirstWarn -IF (ALLOCATED(SrcMiscData%StoredForces)) THEN - i1_l = LBOUND(SrcMiscData%StoredForces,1) - i1_u = UBOUND(SrcMiscData%StoredForces,1) - i2_l = LBOUND(SrcMiscData%StoredForces,2) - i2_u = UBOUND(SrcMiscData%StoredForces,2) - i3_l = LBOUND(SrcMiscData%StoredForces,3) - i3_u = UBOUND(SrcMiscData%StoredForces,3) - IF (.NOT. ALLOCATED(DstMiscData%StoredForces)) THEN - ALLOCATE(DstMiscData%StoredForces(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%StoredForces.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%StoredForces = SrcMiscData%StoredForces -ENDIF -IF (ALLOCATED(SrcMiscData%StoredMoments)) THEN - i1_l = LBOUND(SrcMiscData%StoredMoments,1) - i1_u = UBOUND(SrcMiscData%StoredMoments,1) - i2_l = LBOUND(SrcMiscData%StoredMoments,2) - i2_u = UBOUND(SrcMiscData%StoredMoments,2) - i3_l = LBOUND(SrcMiscData%StoredMoments,3) - i3_u = UBOUND(SrcMiscData%StoredMoments,3) - IF (.NOT. ALLOCATED(DstMiscData%StoredMoments)) THEN - ALLOCATE(DstMiscData%StoredMoments(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%StoredMoments.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%StoredMoments = SrcMiscData%StoredMoments -ENDIF - END SUBROUTINE AD14_CopyMisc - - SUBROUTINE AD14_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(AD14_MiscVarType), INTENT(INOUT) :: MiscData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyMisc' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL DWM_DestroyMisc( MiscData%DWM, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL DWM_DestroyInput( MiscData%DWM_Inputs, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL DWM_DestroyOutput( MiscData%DWM_Outputs, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(MiscData%ElPrNum)) THEN - DEALLOCATE(MiscData%ElPrNum) -ENDIF - CALL AD14_Destroyairfoil( MiscData%AirFoil, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD14_Destroybeddoes( MiscData%Beddoes, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD14_Destroydyninflow( MiscData%DynInflow, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD14_Destroyelement( MiscData%Element, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD14_Destroyrotor( MiscData%Rotor, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD14_Destroywind( MiscData%Wind, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD14_Destroyinducedvel( MiscData%InducedVel, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD14_Destroyeloutparms( MiscData%ElOut, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(MiscData%StoredForces)) THEN - DEALLOCATE(MiscData%StoredForces) -ENDIF -IF (ALLOCATED(MiscData%StoredMoments)) THEN - DEALLOCATE(MiscData%StoredMoments) -ENDIF - END SUBROUTINE AD14_DestroyMisc - - SUBROUTINE AD14_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(AD14_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 = 'AD14_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 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! DWM: size of buffers for each call to pack subtype - CALL DWM_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%DWM, ErrStat2, ErrMsg2, .TRUE. ) ! DWM - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! DWM - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! DWM - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! DWM - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! DWM_Inputs: size of buffers for each call to pack subtype - CALL DWM_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%DWM_Inputs, ErrStat2, ErrMsg2, .TRUE. ) ! DWM_Inputs - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! DWM_Inputs - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! DWM_Inputs - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! DWM_Inputs - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! DWM_Outputs: size of buffers for each call to pack subtype - CALL DWM_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%DWM_Outputs, ErrStat2, ErrMsg2, .TRUE. ) ! DWM_Outputs - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! DWM_Outputs - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! DWM_Outputs - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! DWM_Outputs - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Db_BufSz = Db_BufSz + 1 ! DT - Int_BufSz = Int_BufSz + 1 ! ElPrNum allocated yes/no - IF ( ALLOCATED(InData%ElPrNum) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ElPrNum upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%ElPrNum) ! ElPrNum - END IF - Db_BufSz = Db_BufSz + 1 ! OldTime - Re_BufSz = Re_BufSz + 1 ! HubLoss - Re_BufSz = Re_BufSz + 1 ! Loss - Re_BufSz = Re_BufSz + 1 ! TipLoss - Re_BufSz = Re_BufSz + 1 ! TLpt7 - Int_BufSz = Int_BufSz + 1 ! FirstPassGTL - Int_BufSz = Int_BufSz + 1 ! SuperSonic - Int_BufSz = Int_BufSz + 1 ! AFLAGVinderr - Int_BufSz = Int_BufSz + 1 ! AFLAGTwrInflu - Int_BufSz = Int_BufSz + 1 ! OnePassDynDbg - Int_BufSz = Int_BufSz + 1 ! NoLoadsCalculated - Int_BufSz = Int_BufSz + 1 ! NERRORS - Int_BufSz = Int_BufSz + 3 ! AirFoil: size of buffers for each call to pack subtype - CALL AD14_Packairfoil( Re_Buf, Db_Buf, Int_Buf, InData%AirFoil, ErrStat2, ErrMsg2, .TRUE. ) ! AirFoil - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! AirFoil - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! AirFoil - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! AirFoil - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! Beddoes: size of buffers for each call to pack subtype - CALL AD14_Packbeddoes( Re_Buf, Db_Buf, Int_Buf, InData%Beddoes, ErrStat2, ErrMsg2, .TRUE. ) ! Beddoes - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Beddoes - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Beddoes - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Beddoes - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! DynInflow: size of buffers for each call to pack subtype - CALL AD14_Packdyninflow( Re_Buf, Db_Buf, Int_Buf, InData%DynInflow, ErrStat2, ErrMsg2, .TRUE. ) ! DynInflow - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! DynInflow - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! DynInflow - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! DynInflow - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! Element: size of buffers for each call to pack subtype - CALL AD14_Packelement( Re_Buf, Db_Buf, Int_Buf, InData%Element, ErrStat2, ErrMsg2, .TRUE. ) ! Element - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Element - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Element - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Element - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! Rotor: size of buffers for each call to pack subtype - CALL AD14_Packrotor( Re_Buf, Db_Buf, Int_Buf, InData%Rotor, ErrStat2, ErrMsg2, .TRUE. ) ! Rotor - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Rotor - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Rotor - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Rotor - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! Wind: size of buffers for each call to pack subtype - CALL AD14_Packwind( Re_Buf, Db_Buf, Int_Buf, InData%Wind, ErrStat2, ErrMsg2, .TRUE. ) ! Wind - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Wind - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Wind - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Wind - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! InducedVel: size of buffers for each call to pack subtype - CALL AD14_Packinducedvel( Re_Buf, Db_Buf, Int_Buf, InData%InducedVel, ErrStat2, ErrMsg2, .TRUE. ) ! InducedVel - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! InducedVel - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! InducedVel - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! InducedVel - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! ElOut: size of buffers for each call to pack subtype - CALL AD14_Packeloutparms( Re_Buf, Db_Buf, Int_Buf, InData%ElOut, ErrStat2, ErrMsg2, .TRUE. ) ! ElOut - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! ElOut - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! ElOut - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! ElOut - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! Skew - Int_BufSz = Int_BufSz + 1 ! DynInit - Int_BufSz = Int_BufSz + 1 ! FirstWarn - Int_BufSz = Int_BufSz + 1 ! StoredForces allocated yes/no - IF ( ALLOCATED(InData%StoredForces) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! StoredForces upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%StoredForces) ! StoredForces - END IF - Int_BufSz = Int_BufSz + 1 ! StoredMoments allocated yes/no - IF ( ALLOCATED(InData%StoredMoments) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! StoredMoments upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%StoredMoments) ! StoredMoments - 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 DWM_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%DWM, ErrStat2, ErrMsg2, OnlySize ) ! DWM - 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 DWM_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%DWM_Inputs, ErrStat2, ErrMsg2, OnlySize ) ! DWM_Inputs - 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 DWM_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%DWM_Outputs, ErrStat2, ErrMsg2, OnlySize ) ! DWM_Outputs - 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 - DbKiBuf(Db_Xferred) = InData%DT - Db_Xferred = Db_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%ElPrNum) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ElPrNum,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ElPrNum,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ElPrNum,1), UBOUND(InData%ElPrNum,1) - IntKiBuf(Int_Xferred) = InData%ElPrNum(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - DbKiBuf(Db_Xferred) = InData%OldTime - Db_Xferred = Db_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%HubLoss - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Loss - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TipLoss - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TLpt7 - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%FirstPassGTL, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%SuperSonic, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%AFLAGVinderr, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%AFLAGTwrInflu, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%OnePassDynDbg, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%NoLoadsCalculated, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NERRORS - Int_Xferred = Int_Xferred + 1 - CALL AD14_Packairfoil( Re_Buf, Db_Buf, Int_Buf, InData%AirFoil, ErrStat2, ErrMsg2, OnlySize ) ! AirFoil - 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 AD14_Packbeddoes( Re_Buf, Db_Buf, Int_Buf, InData%Beddoes, ErrStat2, ErrMsg2, OnlySize ) ! Beddoes - 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 AD14_Packdyninflow( Re_Buf, Db_Buf, Int_Buf, InData%DynInflow, ErrStat2, ErrMsg2, OnlySize ) ! DynInflow - 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 AD14_Packelement( Re_Buf, Db_Buf, Int_Buf, InData%Element, ErrStat2, ErrMsg2, OnlySize ) ! Element - 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 AD14_Packrotor( Re_Buf, Db_Buf, Int_Buf, InData%Rotor, ErrStat2, ErrMsg2, OnlySize ) ! Rotor - 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 AD14_Packwind( Re_Buf, Db_Buf, Int_Buf, InData%Wind, ErrStat2, ErrMsg2, OnlySize ) ! Wind - 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 AD14_Packinducedvel( Re_Buf, Db_Buf, Int_Buf, InData%InducedVel, ErrStat2, ErrMsg2, OnlySize ) ! InducedVel - 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 AD14_Packeloutparms( Re_Buf, Db_Buf, Int_Buf, InData%ElOut, ErrStat2, ErrMsg2, OnlySize ) ! ElOut - 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%Skew, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%DynInit, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%FirstWarn, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%StoredForces) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StoredForces,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StoredForces,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StoredForces,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StoredForces,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StoredForces,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StoredForces,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%StoredForces,3), UBOUND(InData%StoredForces,3) - DO i2 = LBOUND(InData%StoredForces,2), UBOUND(InData%StoredForces,2) - DO i1 = LBOUND(InData%StoredForces,1), UBOUND(InData%StoredForces,1) - ReKiBuf(Re_Xferred) = InData%StoredForces(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%StoredMoments) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StoredMoments,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StoredMoments,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StoredMoments,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StoredMoments,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StoredMoments,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StoredMoments,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%StoredMoments,3), UBOUND(InData%StoredMoments,3) - DO i2 = LBOUND(InData%StoredMoments,2), UBOUND(InData%StoredMoments,2) - DO i1 = LBOUND(InData%StoredMoments,1), UBOUND(InData%StoredMoments,1) - ReKiBuf(Re_Xferred) = InData%StoredMoments(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - END SUBROUTINE AD14_PackMisc - - SUBROUTINE AD14_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(AD14_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) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_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 - 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 DWM_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%DWM, ErrStat2, ErrMsg2 ) ! DWM - 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 DWM_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%DWM_Inputs, ErrStat2, ErrMsg2 ) ! DWM_Inputs - 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 DWM_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%DWM_Outputs, ErrStat2, ErrMsg2 ) ! DWM_Outputs - 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%DT = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ElPrNum not allocated - Int_Xferred = Int_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%ElPrNum)) DEALLOCATE(OutData%ElPrNum) - ALLOCATE(OutData%ElPrNum(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ElPrNum.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ElPrNum,1), UBOUND(OutData%ElPrNum,1) - OutData%ElPrNum(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - OutData%OldTime = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%HubLoss = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Loss = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TipLoss = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TLpt7 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%FirstPassGTL = TRANSFER(IntKiBuf(Int_Xferred), OutData%FirstPassGTL) - Int_Xferred = Int_Xferred + 1 - OutData%SuperSonic = TRANSFER(IntKiBuf(Int_Xferred), OutData%SuperSonic) - Int_Xferred = Int_Xferred + 1 - OutData%AFLAGVinderr = TRANSFER(IntKiBuf(Int_Xferred), OutData%AFLAGVinderr) - Int_Xferred = Int_Xferred + 1 - OutData%AFLAGTwrInflu = TRANSFER(IntKiBuf(Int_Xferred), OutData%AFLAGTwrInflu) - Int_Xferred = Int_Xferred + 1 - OutData%OnePassDynDbg = TRANSFER(IntKiBuf(Int_Xferred), OutData%OnePassDynDbg) - Int_Xferred = Int_Xferred + 1 - OutData%NoLoadsCalculated = TRANSFER(IntKiBuf(Int_Xferred), OutData%NoLoadsCalculated) - Int_Xferred = Int_Xferred + 1 - OutData%NERRORS = IntKiBuf(Int_Xferred) - 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 AD14_Unpackairfoil( Re_Buf, Db_Buf, Int_Buf, OutData%AirFoil, ErrStat2, ErrMsg2 ) ! AirFoil - 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 AD14_Unpackbeddoes( Re_Buf, Db_Buf, Int_Buf, OutData%Beddoes, ErrStat2, ErrMsg2 ) ! Beddoes - 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 AD14_Unpackdyninflow( Re_Buf, Db_Buf, Int_Buf, OutData%DynInflow, ErrStat2, ErrMsg2 ) ! DynInflow - 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 AD14_Unpackelement( Re_Buf, Db_Buf, Int_Buf, OutData%Element, ErrStat2, ErrMsg2 ) ! Element - 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 AD14_Unpackrotor( Re_Buf, Db_Buf, Int_Buf, OutData%Rotor, ErrStat2, ErrMsg2 ) ! Rotor - 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 AD14_Unpackwind( Re_Buf, Db_Buf, Int_Buf, OutData%Wind, ErrStat2, ErrMsg2 ) ! Wind - 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 AD14_Unpackinducedvel( Re_Buf, Db_Buf, Int_Buf, OutData%InducedVel, ErrStat2, ErrMsg2 ) ! InducedVel - 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 AD14_Unpackeloutparms( Re_Buf, Db_Buf, Int_Buf, OutData%ElOut, ErrStat2, ErrMsg2 ) ! ElOut - 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%Skew = TRANSFER(IntKiBuf(Int_Xferred), OutData%Skew) - Int_Xferred = Int_Xferred + 1 - OutData%DynInit = TRANSFER(IntKiBuf(Int_Xferred), OutData%DynInit) - Int_Xferred = Int_Xferred + 1 - OutData%FirstWarn = TRANSFER(IntKiBuf(Int_Xferred), OutData%FirstWarn) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StoredForces not allocated - Int_Xferred = Int_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%StoredForces)) DEALLOCATE(OutData%StoredForces) - ALLOCATE(OutData%StoredForces(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%StoredForces.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%StoredForces,3), UBOUND(OutData%StoredForces,3) - DO i2 = LBOUND(OutData%StoredForces,2), UBOUND(OutData%StoredForces,2) - DO i1 = LBOUND(OutData%StoredForces,1), UBOUND(OutData%StoredForces,1) - OutData%StoredForces(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 ! StoredMoments not allocated - Int_Xferred = Int_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%StoredMoments)) DEALLOCATE(OutData%StoredMoments) - ALLOCATE(OutData%StoredMoments(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%StoredMoments.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%StoredMoments,3), UBOUND(OutData%StoredMoments,3) - DO i2 = LBOUND(OutData%StoredMoments,2), UBOUND(OutData%StoredMoments,2) - DO i1 = LBOUND(OutData%StoredMoments,1), UBOUND(OutData%StoredMoments,1) - OutData%StoredMoments(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - END SUBROUTINE AD14_UnPackMisc - - SUBROUTINE AD14_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AD14_ParameterType), INTENT(IN) :: SrcParamData - TYPE(AD14_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 = 'AD14_CopyParam' -! - ErrStat = ErrID_None - ErrMsg = "" - DstParamData%Title = SrcParamData%Title - DstParamData%SIUnit = SrcParamData%SIUnit - DstParamData%Echo = SrcParamData%Echo - DstParamData%MultiTab = SrcParamData%MultiTab - DstParamData%LinearizeFlag = SrcParamData%LinearizeFlag - DstParamData%OutputPlottingInfo = SrcParamData%OutputPlottingInfo - DstParamData%UseDWM = SrcParamData%UseDWM - DstParamData%TwoPiNB = SrcParamData%TwoPiNB - DstParamData%NumBl = SrcParamData%NumBl - DstParamData%NBlInpSt = SrcParamData%NBlInpSt - DstParamData%ElemPrn = SrcParamData%ElemPrn - DstParamData%DStall = SrcParamData%DStall - DstParamData%PMoment = SrcParamData%PMoment - DstParamData%Reynolds = SrcParamData%Reynolds - DstParamData%DynInfl = SrcParamData%DynInfl - DstParamData%Wake = SrcParamData%Wake - DstParamData%Swirl = SrcParamData%Swirl - DstParamData%DtAero = SrcParamData%DtAero - DstParamData%HubRad = SrcParamData%HubRad - DstParamData%UnEc = SrcParamData%UnEc - DstParamData%UnElem = SrcParamData%UnElem - DstParamData%UnWndOut = SrcParamData%UnWndOut - DstParamData%MAXICOUNT = SrcParamData%MAXICOUNT - DstParamData%WrOptFile = SrcParamData%WrOptFile - DstParamData%DEFAULT_Wind = SrcParamData%DEFAULT_Wind - CALL AD14_Copyairfoilparms( SrcParamData%AirFoil, DstParamData%AirFoil, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD14_Copybladeparms( SrcParamData%Blade, DstParamData%Blade, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD14_Copybeddoesparms( SrcParamData%Beddoes, DstParamData%Beddoes, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD14_Copydyninflowparms( SrcParamData%DynInflow, DstParamData%DynInflow, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD14_Copyelementparms( SrcParamData%Element, DstParamData%Element, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD14_Copytwrpropsparms( SrcParamData%TwrProps, DstParamData%TwrProps, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD14_Copyinducedvelparms( SrcParamData%InducedVel, DstParamData%InducedVel, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD14_Copywindparms( SrcParamData%Wind, DstParamData%Wind, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD14_Copyrotorparms( SrcParamData%Rotor, DstParamData%Rotor, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL DWM_CopyParam( SrcParamData%DWM, DstParamData%DWM, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE AD14_CopyParam - - SUBROUTINE AD14_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(AD14_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL AD14_Destroyairfoilparms( ParamData%AirFoil, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD14_Destroybladeparms( ParamData%Blade, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD14_Destroybeddoesparms( ParamData%Beddoes, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD14_Destroydyninflowparms( ParamData%DynInflow, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD14_Destroyelementparms( ParamData%Element, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD14_Destroytwrpropsparms( ParamData%TwrProps, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD14_Destroyinducedvelparms( ParamData%InducedVel, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD14_Destroywindparms( ParamData%Wind, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD14_Destroyrotorparms( ParamData%Rotor, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL DWM_DestroyParam( ParamData%DWM, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE AD14_DestroyParam - - SUBROUTINE AD14_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(AD14_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 = 'AD14_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*LEN(InData%Title) ! Title - Int_BufSz = Int_BufSz + 1 ! SIUnit - Int_BufSz = Int_BufSz + 1 ! Echo - Int_BufSz = Int_BufSz + 1 ! MultiTab - Int_BufSz = Int_BufSz + 1 ! LinearizeFlag - Int_BufSz = Int_BufSz + 1 ! OutputPlottingInfo - Int_BufSz = Int_BufSz + 1 ! UseDWM - Re_BufSz = Re_BufSz + 1 ! TwoPiNB - Int_BufSz = Int_BufSz + 1 ! NumBl - Int_BufSz = Int_BufSz + 1 ! NBlInpSt - Int_BufSz = Int_BufSz + 1 ! ElemPrn - Int_BufSz = Int_BufSz + 1 ! DStall - Int_BufSz = Int_BufSz + 1 ! PMoment - Int_BufSz = Int_BufSz + 1 ! Reynolds - Int_BufSz = Int_BufSz + 1 ! DynInfl - Int_BufSz = Int_BufSz + 1 ! Wake - Int_BufSz = Int_BufSz + 1 ! Swirl - Db_BufSz = Db_BufSz + 1 ! DtAero - Re_BufSz = Re_BufSz + 1 ! HubRad - Int_BufSz = Int_BufSz + 1 ! UnEc - Int_BufSz = Int_BufSz + 1 ! UnElem - Int_BufSz = Int_BufSz + 1 ! UnWndOut - Int_BufSz = Int_BufSz + 1 ! MAXICOUNT - Int_BufSz = Int_BufSz + 1 ! WrOptFile - Int_BufSz = Int_BufSz + 1 ! DEFAULT_Wind - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! AirFoil: size of buffers for each call to pack subtype - CALL AD14_Packairfoilparms( Re_Buf, Db_Buf, Int_Buf, InData%AirFoil, ErrStat2, ErrMsg2, .TRUE. ) ! AirFoil - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! AirFoil - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! AirFoil - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! AirFoil - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! Blade: size of buffers for each call to pack subtype - CALL AD14_Packbladeparms( Re_Buf, Db_Buf, Int_Buf, InData%Blade, ErrStat2, ErrMsg2, .TRUE. ) ! Blade - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Blade - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Blade - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Blade - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! Beddoes: size of buffers for each call to pack subtype - CALL AD14_Packbeddoesparms( Re_Buf, Db_Buf, Int_Buf, InData%Beddoes, ErrStat2, ErrMsg2, .TRUE. ) ! Beddoes - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Beddoes - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Beddoes - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Beddoes - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! DynInflow: size of buffers for each call to pack subtype - CALL AD14_Packdyninflowparms( Re_Buf, Db_Buf, Int_Buf, InData%DynInflow, ErrStat2, ErrMsg2, .TRUE. ) ! DynInflow - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! DynInflow - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! DynInflow - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! DynInflow - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! Element: size of buffers for each call to pack subtype - CALL AD14_Packelementparms( Re_Buf, Db_Buf, Int_Buf, InData%Element, ErrStat2, ErrMsg2, .TRUE. ) ! Element - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Element - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Element - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Element - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! TwrProps: size of buffers for each call to pack subtype - CALL AD14_Packtwrpropsparms( Re_Buf, Db_Buf, Int_Buf, InData%TwrProps, ErrStat2, ErrMsg2, .TRUE. ) ! TwrProps - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! TwrProps - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! TwrProps - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! TwrProps - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! InducedVel: size of buffers for each call to pack subtype - CALL AD14_Packinducedvelparms( Re_Buf, Db_Buf, Int_Buf, InData%InducedVel, ErrStat2, ErrMsg2, .TRUE. ) ! InducedVel - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! InducedVel - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! InducedVel - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! InducedVel - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! Wind: size of buffers for each call to pack subtype - CALL AD14_Packwindparms( Re_Buf, Db_Buf, Int_Buf, InData%Wind, ErrStat2, ErrMsg2, .TRUE. ) ! Wind - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Wind - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Wind - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Wind - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! Rotor: size of buffers for each call to pack subtype - CALL AD14_Packrotorparms( Re_Buf, Db_Buf, Int_Buf, InData%Rotor, ErrStat2, ErrMsg2, .TRUE. ) ! Rotor - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Rotor - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Rotor - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Rotor - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! DWM: size of buffers for each call to pack subtype - CALL DWM_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%DWM, ErrStat2, ErrMsg2, .TRUE. ) ! DWM - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! DWM - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! DWM - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! DWM - 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%Title) - IntKiBuf(Int_Xferred) = ICHAR(InData%Title(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = TRANSFER(InData%SIUnit, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%Echo, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%MultiTab, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%LinearizeFlag, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%OutputPlottingInfo, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%UseDWM, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TwoPiNB - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumBl - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NBlInpSt - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%ElemPrn, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%DStall, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%PMoment, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%Reynolds, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%DynInfl, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%Wake, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%Swirl, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%DtAero - Db_Xferred = Db_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%HubRad - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%UnEc - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%UnElem - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%UnWndOut - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%MAXICOUNT - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%WrOptFile, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%DEFAULT_Wind - Int_Xferred = Int_Xferred + 1 - CALL AD14_Packairfoilparms( Re_Buf, Db_Buf, Int_Buf, InData%AirFoil, ErrStat2, ErrMsg2, OnlySize ) ! AirFoil - 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 AD14_Packbladeparms( Re_Buf, Db_Buf, Int_Buf, InData%Blade, ErrStat2, ErrMsg2, OnlySize ) ! Blade - 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 AD14_Packbeddoesparms( Re_Buf, Db_Buf, Int_Buf, InData%Beddoes, ErrStat2, ErrMsg2, OnlySize ) ! Beddoes - 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 AD14_Packdyninflowparms( Re_Buf, Db_Buf, Int_Buf, InData%DynInflow, ErrStat2, ErrMsg2, OnlySize ) ! DynInflow - 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 AD14_Packelementparms( Re_Buf, Db_Buf, Int_Buf, InData%Element, ErrStat2, ErrMsg2, OnlySize ) ! Element - 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 AD14_Packtwrpropsparms( Re_Buf, Db_Buf, Int_Buf, InData%TwrProps, ErrStat2, ErrMsg2, OnlySize ) ! TwrProps - 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 AD14_Packinducedvelparms( Re_Buf, Db_Buf, Int_Buf, InData%InducedVel, ErrStat2, ErrMsg2, OnlySize ) ! InducedVel - 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 AD14_Packwindparms( Re_Buf, Db_Buf, Int_Buf, InData%Wind, ErrStat2, ErrMsg2, OnlySize ) ! Wind - 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 AD14_Packrotorparms( Re_Buf, Db_Buf, Int_Buf, InData%Rotor, ErrStat2, ErrMsg2, OnlySize ) ! Rotor - 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 DWM_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%DWM, ErrStat2, ErrMsg2, OnlySize ) ! DWM - 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 AD14_PackParam - - SUBROUTINE AD14_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(AD14_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 = 'AD14_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 - DO I = 1, LEN(OutData%Title) - OutData%Title(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%SIUnit = TRANSFER(IntKiBuf(Int_Xferred), OutData%SIUnit) - Int_Xferred = Int_Xferred + 1 - OutData%Echo = TRANSFER(IntKiBuf(Int_Xferred), OutData%Echo) - Int_Xferred = Int_Xferred + 1 - OutData%MultiTab = TRANSFER(IntKiBuf(Int_Xferred), OutData%MultiTab) - Int_Xferred = Int_Xferred + 1 - OutData%LinearizeFlag = TRANSFER(IntKiBuf(Int_Xferred), OutData%LinearizeFlag) - Int_Xferred = Int_Xferred + 1 - OutData%OutputPlottingInfo = TRANSFER(IntKiBuf(Int_Xferred), OutData%OutputPlottingInfo) - Int_Xferred = Int_Xferred + 1 - OutData%UseDWM = TRANSFER(IntKiBuf(Int_Xferred), OutData%UseDWM) - Int_Xferred = Int_Xferred + 1 - OutData%TwoPiNB = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NumBl = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NBlInpSt = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%ElemPrn = TRANSFER(IntKiBuf(Int_Xferred), OutData%ElemPrn) - Int_Xferred = Int_Xferred + 1 - OutData%DStall = TRANSFER(IntKiBuf(Int_Xferred), OutData%DStall) - Int_Xferred = Int_Xferred + 1 - OutData%PMoment = TRANSFER(IntKiBuf(Int_Xferred), OutData%PMoment) - Int_Xferred = Int_Xferred + 1 - OutData%Reynolds = TRANSFER(IntKiBuf(Int_Xferred), OutData%Reynolds) - Int_Xferred = Int_Xferred + 1 - OutData%DynInfl = TRANSFER(IntKiBuf(Int_Xferred), OutData%DynInfl) - Int_Xferred = Int_Xferred + 1 - OutData%Wake = TRANSFER(IntKiBuf(Int_Xferred), OutData%Wake) - Int_Xferred = Int_Xferred + 1 - OutData%Swirl = TRANSFER(IntKiBuf(Int_Xferred), OutData%Swirl) - Int_Xferred = Int_Xferred + 1 - OutData%DtAero = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%HubRad = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%UnEc = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%UnElem = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%UnWndOut = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%MAXICOUNT = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WrOptFile = TRANSFER(IntKiBuf(Int_Xferred), OutData%WrOptFile) - Int_Xferred = Int_Xferred + 1 - OutData%DEFAULT_Wind = IntKiBuf(Int_Xferred) - 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 AD14_Unpackairfoilparms( Re_Buf, Db_Buf, Int_Buf, OutData%AirFoil, ErrStat2, ErrMsg2 ) ! AirFoil - 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 AD14_Unpackbladeparms( Re_Buf, Db_Buf, Int_Buf, OutData%Blade, ErrStat2, ErrMsg2 ) ! Blade - 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 AD14_Unpackbeddoesparms( Re_Buf, Db_Buf, Int_Buf, OutData%Beddoes, ErrStat2, ErrMsg2 ) ! Beddoes - 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 AD14_Unpackdyninflowparms( Re_Buf, Db_Buf, Int_Buf, OutData%DynInflow, ErrStat2, ErrMsg2 ) ! DynInflow - 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 AD14_Unpackelementparms( Re_Buf, Db_Buf, Int_Buf, OutData%Element, ErrStat2, ErrMsg2 ) ! Element - 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 AD14_Unpacktwrpropsparms( Re_Buf, Db_Buf, Int_Buf, OutData%TwrProps, ErrStat2, ErrMsg2 ) ! TwrProps - 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 AD14_Unpackinducedvelparms( Re_Buf, Db_Buf, Int_Buf, OutData%InducedVel, ErrStat2, ErrMsg2 ) ! InducedVel - 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 AD14_Unpackwindparms( Re_Buf, Db_Buf, Int_Buf, OutData%Wind, ErrStat2, ErrMsg2 ) ! Wind - 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 AD14_Unpackrotorparms( Re_Buf, Db_Buf, Int_Buf, OutData%Rotor, ErrStat2, ErrMsg2 ) ! Rotor - 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 DWM_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%DWM, ErrStat2, ErrMsg2 ) ! DWM - 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 AD14_UnPackParam - - SUBROUTINE AD14_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AD14_InputType), INTENT(INOUT) :: SrcInputData - TYPE(AD14_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 = 'AD14_CopyInput' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcInputData%InputMarkers)) THEN - i1_l = LBOUND(SrcInputData%InputMarkers,1) - i1_u = UBOUND(SrcInputData%InputMarkers,1) - IF (.NOT. ALLOCATED(DstInputData%InputMarkers)) THEN - ALLOCATE(DstInputData%InputMarkers(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%InputMarkers.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcInputData%InputMarkers,1), UBOUND(SrcInputData%InputMarkers,1) - CALL MeshCopy( SrcInputData%InputMarkers(i1), DstInputData%InputMarkers(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL MeshCopy( SrcInputData%Twr_InputMarkers, DstInputData%Twr_InputMarkers, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD14_Copyaeroconfig( SrcInputData%TurbineComponents, DstInputData%TurbineComponents, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcInputData%MulTabLoc)) THEN - i1_l = LBOUND(SrcInputData%MulTabLoc,1) - i1_u = UBOUND(SrcInputData%MulTabLoc,1) - i2_l = LBOUND(SrcInputData%MulTabLoc,2) - i2_u = UBOUND(SrcInputData%MulTabLoc,2) - IF (.NOT. ALLOCATED(DstInputData%MulTabLoc)) THEN - ALLOCATE(DstInputData%MulTabLoc(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%MulTabLoc.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%MulTabLoc = SrcInputData%MulTabLoc -ENDIF -IF (ALLOCATED(SrcInputData%InflowVelocity)) THEN - i1_l = LBOUND(SrcInputData%InflowVelocity,1) - i1_u = UBOUND(SrcInputData%InflowVelocity,1) - i2_l = LBOUND(SrcInputData%InflowVelocity,2) - i2_u = UBOUND(SrcInputData%InflowVelocity,2) - IF (.NOT. ALLOCATED(DstInputData%InflowVelocity)) THEN - ALLOCATE(DstInputData%InflowVelocity(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%InflowVelocity.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%InflowVelocity = SrcInputData%InflowVelocity -ENDIF - DstInputData%AvgInfVel = SrcInputData%AvgInfVel - END SUBROUTINE AD14_CopyInput - - SUBROUTINE AD14_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(AD14_InputType), INTENT(INOUT) :: InputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyInput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(InputData%InputMarkers)) THEN -DO i1 = LBOUND(InputData%InputMarkers,1), UBOUND(InputData%InputMarkers,1) - CALL MeshDestroy( InputData%InputMarkers(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(InputData%InputMarkers) -ENDIF - CALL MeshDestroy( InputData%Twr_InputMarkers, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD14_Destroyaeroconfig( InputData%TurbineComponents, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(InputData%MulTabLoc)) THEN - DEALLOCATE(InputData%MulTabLoc) -ENDIF -IF (ALLOCATED(InputData%InflowVelocity)) THEN - DEALLOCATE(InputData%InflowVelocity) -ENDIF - END SUBROUTINE AD14_DestroyInput - - SUBROUTINE AD14_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(AD14_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 = 'AD14_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 ! InputMarkers allocated yes/no - IF ( ALLOCATED(InData%InputMarkers) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! InputMarkers upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%InputMarkers,1), UBOUND(InData%InputMarkers,1) - Int_BufSz = Int_BufSz + 3 ! InputMarkers: size of buffers for each call to pack subtype - CALL MeshPack( InData%InputMarkers(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! InputMarkers - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! InputMarkers - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! InputMarkers - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! InputMarkers - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! Twr_InputMarkers: size of buffers for each call to pack subtype - CALL MeshPack( InData%Twr_InputMarkers, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! Twr_InputMarkers - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Twr_InputMarkers - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Twr_InputMarkers - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Twr_InputMarkers - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! TurbineComponents: size of buffers for each call to pack subtype - CALL AD14_Packaeroconfig( Re_Buf, Db_Buf, Int_Buf, InData%TurbineComponents, ErrStat2, ErrMsg2, .TRUE. ) ! TurbineComponents - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! TurbineComponents - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! TurbineComponents - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! TurbineComponents - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! MulTabLoc allocated yes/no - IF ( ALLOCATED(InData%MulTabLoc) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! MulTabLoc upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%MulTabLoc) ! MulTabLoc - END IF - Int_BufSz = Int_BufSz + 1 ! InflowVelocity allocated yes/no - IF ( ALLOCATED(InData%InflowVelocity) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! InflowVelocity upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%InflowVelocity) ! InflowVelocity - END IF - Re_BufSz = Re_BufSz + SIZE(InData%AvgInfVel) ! AvgInfVel - 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%InputMarkers) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InputMarkers,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputMarkers,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%InputMarkers,1), UBOUND(InData%InputMarkers,1) - CALL MeshPack( InData%InputMarkers(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! InputMarkers - 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 - CALL MeshPack( InData%Twr_InputMarkers, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! Twr_InputMarkers - 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 AD14_Packaeroconfig( Re_Buf, Db_Buf, Int_Buf, InData%TurbineComponents, ErrStat2, ErrMsg2, OnlySize ) ! TurbineComponents - 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%MulTabLoc) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MulTabLoc,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MulTabLoc,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MulTabLoc,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MulTabLoc,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%MulTabLoc,2), UBOUND(InData%MulTabLoc,2) - DO i1 = LBOUND(InData%MulTabLoc,1), UBOUND(InData%MulTabLoc,1) - ReKiBuf(Re_Xferred) = InData%MulTabLoc(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%InflowVelocity) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InflowVelocity,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InflowVelocity,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InflowVelocity,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InflowVelocity,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%InflowVelocity,2), UBOUND(InData%InflowVelocity,2) - DO i1 = LBOUND(InData%InflowVelocity,1), UBOUND(InData%InflowVelocity,1) - ReKiBuf(Re_Xferred) = InData%InflowVelocity(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - DO i1 = LBOUND(InData%AvgInfVel,1), UBOUND(InData%AvgInfVel,1) - ReKiBuf(Re_Xferred) = InData%AvgInfVel(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END SUBROUTINE AD14_PackInput - - SUBROUTINE AD14_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(AD14_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 = 'AD14_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 ! InputMarkers not allocated - Int_Xferred = Int_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%InputMarkers)) DEALLOCATE(OutData%InputMarkers) - ALLOCATE(OutData%InputMarkers(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputMarkers.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%InputMarkers,1), UBOUND(OutData%InputMarkers,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%InputMarkers(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! InputMarkers - 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 - 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%Twr_InputMarkers, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! Twr_InputMarkers - 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 AD14_Unpackaeroconfig( Re_Buf, Db_Buf, Int_Buf, OutData%TurbineComponents, ErrStat2, ErrMsg2 ) ! TurbineComponents - 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 ! MulTabLoc not allocated - Int_Xferred = Int_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%MulTabLoc)) DEALLOCATE(OutData%MulTabLoc) - ALLOCATE(OutData%MulTabLoc(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MulTabLoc.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%MulTabLoc,2), UBOUND(OutData%MulTabLoc,2) - DO i1 = LBOUND(OutData%MulTabLoc,1), UBOUND(OutData%MulTabLoc,1) - OutData%MulTabLoc(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InflowVelocity not allocated - Int_Xferred = Int_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%InflowVelocity)) DEALLOCATE(OutData%InflowVelocity) - ALLOCATE(OutData%InflowVelocity(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InflowVelocity.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%InflowVelocity,2), UBOUND(OutData%InflowVelocity,2) - DO i1 = LBOUND(OutData%InflowVelocity,1), UBOUND(OutData%InflowVelocity,1) - OutData%InflowVelocity(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - i1_l = LBOUND(OutData%AvgInfVel,1) - i1_u = UBOUND(OutData%AvgInfVel,1) - DO i1 = LBOUND(OutData%AvgInfVel,1), UBOUND(OutData%AvgInfVel,1) - OutData%AvgInfVel(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END SUBROUTINE AD14_UnPackInput - - SUBROUTINE AD14_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AD14_OutputType), INTENT(INOUT) :: SrcOutputData - TYPE(AD14_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 = 'AD14_CopyOutput' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcOutputData%OutputLoads)) THEN - i1_l = LBOUND(SrcOutputData%OutputLoads,1) - i1_u = UBOUND(SrcOutputData%OutputLoads,1) - IF (.NOT. ALLOCATED(DstOutputData%OutputLoads)) THEN - ALLOCATE(DstOutputData%OutputLoads(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%OutputLoads.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcOutputData%OutputLoads,1), UBOUND(SrcOutputData%OutputLoads,1) - CALL MeshCopy( SrcOutputData%OutputLoads(i1), DstOutputData%OutputLoads(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL MeshCopy( SrcOutputData%Twr_OutputLoads, DstOutputData%Twr_OutputLoads, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE AD14_CopyOutput - - SUBROUTINE AD14_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(AD14_OutputType), INTENT(INOUT) :: OutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(OutputData%OutputLoads)) THEN -DO i1 = LBOUND(OutputData%OutputLoads,1), UBOUND(OutputData%OutputLoads,1) - CALL MeshDestroy( OutputData%OutputLoads(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(OutputData%OutputLoads) -ENDIF - CALL MeshDestroy( OutputData%Twr_OutputLoads, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE AD14_DestroyOutput - - SUBROUTINE AD14_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(AD14_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 = 'AD14_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 ! OutputLoads allocated yes/no - IF ( ALLOCATED(InData%OutputLoads) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OutputLoads upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%OutputLoads,1), UBOUND(InData%OutputLoads,1) - Int_BufSz = Int_BufSz + 3 ! OutputLoads: size of buffers for each call to pack subtype - CALL MeshPack( InData%OutputLoads(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! OutputLoads - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OutputLoads - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OutputLoads - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OutputLoads - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! Twr_OutputLoads: size of buffers for each call to pack subtype - CALL MeshPack( InData%Twr_OutputLoads, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! Twr_OutputLoads - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Twr_OutputLoads - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Twr_OutputLoads - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Twr_OutputLoads - 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%OutputLoads) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OutputLoads,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutputLoads,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%OutputLoads,1), UBOUND(InData%OutputLoads,1) - CALL MeshPack( InData%OutputLoads(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! OutputLoads - 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 - CALL MeshPack( InData%Twr_OutputLoads, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! Twr_OutputLoads - 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 AD14_PackOutput - - SUBROUTINE AD14_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(AD14_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 = 'AD14_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 ! OutputLoads not allocated - Int_Xferred = Int_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%OutputLoads)) DEALLOCATE(OutData%OutputLoads) - ALLOCATE(OutData%OutputLoads(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutputLoads.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%OutputLoads,1), UBOUND(OutData%OutputLoads,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%OutputLoads(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! OutputLoads - 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 - 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%Twr_OutputLoads, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! Twr_OutputLoads - 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 AD14_UnPackOutput - - - SUBROUTINE AD14_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(AD14_InputType), INTENT(INOUT) :: u(:) ! Input at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Inputs - TYPE(AD14_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 = 'AD14_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 AD14_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL AD14_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 AD14_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 AD14_Input_ExtrapInterp - - - SUBROUTINE AD14_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(AD14_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 - TYPE(AD14_InputType), INTENT(INOUT) :: u2 ! Input at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs - TYPE(AD14_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 = 'AD14_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 :: i11 ! dim1 level 1 counter variable for arrays of ddts - INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts - INTEGER :: i12 ! dim2 level 1 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - INTEGER :: i2 ! dim2 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%InputMarkers) .AND. ALLOCATED(u1%InputMarkers)) THEN - DO i1 = LBOUND(u_out%InputMarkers,1),UBOUND(u_out%InputMarkers,1) - CALL MeshExtrapInterp1(u1%InputMarkers(i1), u2%InputMarkers(i1), tin, u_out%InputMarkers(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated - CALL MeshExtrapInterp1(u1%Twr_InputMarkers, u2%Twr_InputMarkers, tin, u_out%Twr_InputMarkers, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) -IF (ALLOCATED(u_out%TurbineComponents%Blade) .AND. ALLOCATED(u1%TurbineComponents%Blade)) THEN - DO i11 = LBOUND(u_out%TurbineComponents%Blade,1),UBOUND(u_out%TurbineComponents%Blade,1) - DO i1 = LBOUND(u_out%TurbineComponents%Blade(i11)%Position,1),UBOUND(u_out%TurbineComponents%Blade(i11)%Position,1) - b = -(u1%TurbineComponents%Blade(i11)%Position(i1) - u2%TurbineComponents%Blade(i11)%Position(i1)) - u_out%TurbineComponents%Blade(i11)%Position(i1) = u1%TurbineComponents%Blade(i11)%Position(i1) + b * ScaleFactor - END DO - ENDDO - DO i11 = LBOUND(u_out%TurbineComponents%Blade,1),UBOUND(u_out%TurbineComponents%Blade,1) - DO i2 = LBOUND(u_out%TurbineComponents%Blade(i11)%Orientation,2),UBOUND(u_out%TurbineComponents%Blade(i11)%Orientation,2) - DO i1 = LBOUND(u_out%TurbineComponents%Blade(i11)%Orientation,1),UBOUND(u_out%TurbineComponents%Blade(i11)%Orientation,1) - b = -(u1%TurbineComponents%Blade(i11)%Orientation(i1,i2) - u2%TurbineComponents%Blade(i11)%Orientation(i1,i2)) - u_out%TurbineComponents%Blade(i11)%Orientation(i1,i2) = u1%TurbineComponents%Blade(i11)%Orientation(i1,i2) + b * ScaleFactor - END DO - END DO - ENDDO - DO i11 = LBOUND(u_out%TurbineComponents%Blade,1),UBOUND(u_out%TurbineComponents%Blade,1) - DO i1 = LBOUND(u_out%TurbineComponents%Blade(i11)%TranslationVel,1),UBOUND(u_out%TurbineComponents%Blade(i11)%TranslationVel,1) - b = -(u1%TurbineComponents%Blade(i11)%TranslationVel(i1) - u2%TurbineComponents%Blade(i11)%TranslationVel(i1)) - u_out%TurbineComponents%Blade(i11)%TranslationVel(i1) = u1%TurbineComponents%Blade(i11)%TranslationVel(i1) + b * ScaleFactor - END DO - ENDDO - DO i11 = LBOUND(u_out%TurbineComponents%Blade,1),UBOUND(u_out%TurbineComponents%Blade,1) - DO i1 = LBOUND(u_out%TurbineComponents%Blade(i11)%RotationVel,1),UBOUND(u_out%TurbineComponents%Blade(i11)%RotationVel,1) - b = -(u1%TurbineComponents%Blade(i11)%RotationVel(i1) - u2%TurbineComponents%Blade(i11)%RotationVel(i1)) - u_out%TurbineComponents%Blade(i11)%RotationVel(i1) = u1%TurbineComponents%Blade(i11)%RotationVel(i1) + b * ScaleFactor - END DO - ENDDO -END IF ! check if allocated - DO i1 = LBOUND(u_out%TurbineComponents%Hub%Position,1),UBOUND(u_out%TurbineComponents%Hub%Position,1) - b = -(u1%TurbineComponents%Hub%Position(i1) - u2%TurbineComponents%Hub%Position(i1)) - u_out%TurbineComponents%Hub%Position(i1) = u1%TurbineComponents%Hub%Position(i1) + b * ScaleFactor - END DO - DO i2 = LBOUND(u_out%TurbineComponents%Hub%Orientation,2),UBOUND(u_out%TurbineComponents%Hub%Orientation,2) - DO i1 = LBOUND(u_out%TurbineComponents%Hub%Orientation,1),UBOUND(u_out%TurbineComponents%Hub%Orientation,1) - b = -(u1%TurbineComponents%Hub%Orientation(i1,i2) - u2%TurbineComponents%Hub%Orientation(i1,i2)) - u_out%TurbineComponents%Hub%Orientation(i1,i2) = u1%TurbineComponents%Hub%Orientation(i1,i2) + b * ScaleFactor - END DO - END DO - DO i1 = LBOUND(u_out%TurbineComponents%Hub%TranslationVel,1),UBOUND(u_out%TurbineComponents%Hub%TranslationVel,1) - b = -(u1%TurbineComponents%Hub%TranslationVel(i1) - u2%TurbineComponents%Hub%TranslationVel(i1)) - u_out%TurbineComponents%Hub%TranslationVel(i1) = u1%TurbineComponents%Hub%TranslationVel(i1) + b * ScaleFactor - END DO - DO i1 = LBOUND(u_out%TurbineComponents%Hub%RotationVel,1),UBOUND(u_out%TurbineComponents%Hub%RotationVel,1) - b = -(u1%TurbineComponents%Hub%RotationVel(i1) - u2%TurbineComponents%Hub%RotationVel(i1)) - u_out%TurbineComponents%Hub%RotationVel(i1) = u1%TurbineComponents%Hub%RotationVel(i1) + b * ScaleFactor - END DO - DO i1 = LBOUND(u_out%TurbineComponents%RotorFurl%Position,1),UBOUND(u_out%TurbineComponents%RotorFurl%Position,1) - b = -(u1%TurbineComponents%RotorFurl%Position(i1) - u2%TurbineComponents%RotorFurl%Position(i1)) - u_out%TurbineComponents%RotorFurl%Position(i1) = u1%TurbineComponents%RotorFurl%Position(i1) + b * ScaleFactor - END DO - DO i2 = LBOUND(u_out%TurbineComponents%RotorFurl%Orientation,2),UBOUND(u_out%TurbineComponents%RotorFurl%Orientation,2) - DO i1 = LBOUND(u_out%TurbineComponents%RotorFurl%Orientation,1),UBOUND(u_out%TurbineComponents%RotorFurl%Orientation,1) - b = -(u1%TurbineComponents%RotorFurl%Orientation(i1,i2) - u2%TurbineComponents%RotorFurl%Orientation(i1,i2)) - u_out%TurbineComponents%RotorFurl%Orientation(i1,i2) = u1%TurbineComponents%RotorFurl%Orientation(i1,i2) + b * ScaleFactor - END DO - END DO - DO i1 = LBOUND(u_out%TurbineComponents%RotorFurl%TranslationVel,1),UBOUND(u_out%TurbineComponents%RotorFurl%TranslationVel,1) - b = -(u1%TurbineComponents%RotorFurl%TranslationVel(i1) - u2%TurbineComponents%RotorFurl%TranslationVel(i1)) - u_out%TurbineComponents%RotorFurl%TranslationVel(i1) = u1%TurbineComponents%RotorFurl%TranslationVel(i1) + b * ScaleFactor - END DO - DO i1 = LBOUND(u_out%TurbineComponents%RotorFurl%RotationVel,1),UBOUND(u_out%TurbineComponents%RotorFurl%RotationVel,1) - b = -(u1%TurbineComponents%RotorFurl%RotationVel(i1) - u2%TurbineComponents%RotorFurl%RotationVel(i1)) - u_out%TurbineComponents%RotorFurl%RotationVel(i1) = u1%TurbineComponents%RotorFurl%RotationVel(i1) + b * ScaleFactor - END DO - DO i1 = LBOUND(u_out%TurbineComponents%Nacelle%Position,1),UBOUND(u_out%TurbineComponents%Nacelle%Position,1) - b = -(u1%TurbineComponents%Nacelle%Position(i1) - u2%TurbineComponents%Nacelle%Position(i1)) - u_out%TurbineComponents%Nacelle%Position(i1) = u1%TurbineComponents%Nacelle%Position(i1) + b * ScaleFactor - END DO - DO i2 = LBOUND(u_out%TurbineComponents%Nacelle%Orientation,2),UBOUND(u_out%TurbineComponents%Nacelle%Orientation,2) - DO i1 = LBOUND(u_out%TurbineComponents%Nacelle%Orientation,1),UBOUND(u_out%TurbineComponents%Nacelle%Orientation,1) - b = -(u1%TurbineComponents%Nacelle%Orientation(i1,i2) - u2%TurbineComponents%Nacelle%Orientation(i1,i2)) - u_out%TurbineComponents%Nacelle%Orientation(i1,i2) = u1%TurbineComponents%Nacelle%Orientation(i1,i2) + b * ScaleFactor - END DO - END DO - DO i1 = LBOUND(u_out%TurbineComponents%Nacelle%TranslationVel,1),UBOUND(u_out%TurbineComponents%Nacelle%TranslationVel,1) - b = -(u1%TurbineComponents%Nacelle%TranslationVel(i1) - u2%TurbineComponents%Nacelle%TranslationVel(i1)) - u_out%TurbineComponents%Nacelle%TranslationVel(i1) = u1%TurbineComponents%Nacelle%TranslationVel(i1) + b * ScaleFactor - END DO - DO i1 = LBOUND(u_out%TurbineComponents%Nacelle%RotationVel,1),UBOUND(u_out%TurbineComponents%Nacelle%RotationVel,1) - b = -(u1%TurbineComponents%Nacelle%RotationVel(i1) - u2%TurbineComponents%Nacelle%RotationVel(i1)) - u_out%TurbineComponents%Nacelle%RotationVel(i1) = u1%TurbineComponents%Nacelle%RotationVel(i1) + b * ScaleFactor - END DO - DO i1 = LBOUND(u_out%TurbineComponents%TailFin%Position,1),UBOUND(u_out%TurbineComponents%TailFin%Position,1) - b = -(u1%TurbineComponents%TailFin%Position(i1) - u2%TurbineComponents%TailFin%Position(i1)) - u_out%TurbineComponents%TailFin%Position(i1) = u1%TurbineComponents%TailFin%Position(i1) + b * ScaleFactor - END DO - DO i2 = LBOUND(u_out%TurbineComponents%TailFin%Orientation,2),UBOUND(u_out%TurbineComponents%TailFin%Orientation,2) - DO i1 = LBOUND(u_out%TurbineComponents%TailFin%Orientation,1),UBOUND(u_out%TurbineComponents%TailFin%Orientation,1) - b = -(u1%TurbineComponents%TailFin%Orientation(i1,i2) - u2%TurbineComponents%TailFin%Orientation(i1,i2)) - u_out%TurbineComponents%TailFin%Orientation(i1,i2) = u1%TurbineComponents%TailFin%Orientation(i1,i2) + b * ScaleFactor - END DO - END DO - DO i1 = LBOUND(u_out%TurbineComponents%TailFin%TranslationVel,1),UBOUND(u_out%TurbineComponents%TailFin%TranslationVel,1) - b = -(u1%TurbineComponents%TailFin%TranslationVel(i1) - u2%TurbineComponents%TailFin%TranslationVel(i1)) - u_out%TurbineComponents%TailFin%TranslationVel(i1) = u1%TurbineComponents%TailFin%TranslationVel(i1) + b * ScaleFactor - END DO - DO i1 = LBOUND(u_out%TurbineComponents%TailFin%RotationVel,1),UBOUND(u_out%TurbineComponents%TailFin%RotationVel,1) - b = -(u1%TurbineComponents%TailFin%RotationVel(i1) - u2%TurbineComponents%TailFin%RotationVel(i1)) - u_out%TurbineComponents%TailFin%RotationVel(i1) = u1%TurbineComponents%TailFin%RotationVel(i1) + b * ScaleFactor - END DO - DO i1 = LBOUND(u_out%TurbineComponents%Tower%Position,1),UBOUND(u_out%TurbineComponents%Tower%Position,1) - b = -(u1%TurbineComponents%Tower%Position(i1) - u2%TurbineComponents%Tower%Position(i1)) - u_out%TurbineComponents%Tower%Position(i1) = u1%TurbineComponents%Tower%Position(i1) + b * ScaleFactor - END DO - DO i2 = LBOUND(u_out%TurbineComponents%Tower%Orientation,2),UBOUND(u_out%TurbineComponents%Tower%Orientation,2) - DO i1 = LBOUND(u_out%TurbineComponents%Tower%Orientation,1),UBOUND(u_out%TurbineComponents%Tower%Orientation,1) - b = -(u1%TurbineComponents%Tower%Orientation(i1,i2) - u2%TurbineComponents%Tower%Orientation(i1,i2)) - u_out%TurbineComponents%Tower%Orientation(i1,i2) = u1%TurbineComponents%Tower%Orientation(i1,i2) + b * ScaleFactor - END DO - END DO - DO i1 = LBOUND(u_out%TurbineComponents%Tower%TranslationVel,1),UBOUND(u_out%TurbineComponents%Tower%TranslationVel,1) - b = -(u1%TurbineComponents%Tower%TranslationVel(i1) - u2%TurbineComponents%Tower%TranslationVel(i1)) - u_out%TurbineComponents%Tower%TranslationVel(i1) = u1%TurbineComponents%Tower%TranslationVel(i1) + b * ScaleFactor - END DO - DO i1 = LBOUND(u_out%TurbineComponents%Tower%RotationVel,1),UBOUND(u_out%TurbineComponents%Tower%RotationVel,1) - b = -(u1%TurbineComponents%Tower%RotationVel(i1) - u2%TurbineComponents%Tower%RotationVel(i1)) - u_out%TurbineComponents%Tower%RotationVel(i1) = u1%TurbineComponents%Tower%RotationVel(i1) + b * ScaleFactor - END DO - DO i1 = LBOUND(u_out%TurbineComponents%SubStructure%Position,1),UBOUND(u_out%TurbineComponents%SubStructure%Position,1) - b = -(u1%TurbineComponents%SubStructure%Position(i1) - u2%TurbineComponents%SubStructure%Position(i1)) - u_out%TurbineComponents%SubStructure%Position(i1) = u1%TurbineComponents%SubStructure%Position(i1) + b * ScaleFactor - END DO - DO i2 = LBOUND(u_out%TurbineComponents%SubStructure%Orientation,2),UBOUND(u_out%TurbineComponents%SubStructure%Orientation,2) - DO i1 = LBOUND(u_out%TurbineComponents%SubStructure%Orientation,1),UBOUND(u_out%TurbineComponents%SubStructure%Orientation,1) - b = -(u1%TurbineComponents%SubStructure%Orientation(i1,i2) - u2%TurbineComponents%SubStructure%Orientation(i1,i2)) - u_out%TurbineComponents%SubStructure%Orientation(i1,i2) = u1%TurbineComponents%SubStructure%Orientation(i1,i2) + b * ScaleFactor - END DO - END DO - DO i1 = LBOUND(u_out%TurbineComponents%SubStructure%TranslationVel,1),UBOUND(u_out%TurbineComponents%SubStructure%TranslationVel,1) - b = -(u1%TurbineComponents%SubStructure%TranslationVel(i1) - u2%TurbineComponents%SubStructure%TranslationVel(i1)) - u_out%TurbineComponents%SubStructure%TranslationVel(i1) = u1%TurbineComponents%SubStructure%TranslationVel(i1) + b * ScaleFactor - END DO - DO i1 = LBOUND(u_out%TurbineComponents%SubStructure%RotationVel,1),UBOUND(u_out%TurbineComponents%SubStructure%RotationVel,1) - b = -(u1%TurbineComponents%SubStructure%RotationVel(i1) - u2%TurbineComponents%SubStructure%RotationVel(i1)) - u_out%TurbineComponents%SubStructure%RotationVel(i1) = u1%TurbineComponents%SubStructure%RotationVel(i1) + b * ScaleFactor - END DO - DO i1 = LBOUND(u_out%TurbineComponents%Foundation%Position,1),UBOUND(u_out%TurbineComponents%Foundation%Position,1) - b = -(u1%TurbineComponents%Foundation%Position(i1) - u2%TurbineComponents%Foundation%Position(i1)) - u_out%TurbineComponents%Foundation%Position(i1) = u1%TurbineComponents%Foundation%Position(i1) + b * ScaleFactor - END DO - DO i2 = LBOUND(u_out%TurbineComponents%Foundation%Orientation,2),UBOUND(u_out%TurbineComponents%Foundation%Orientation,2) - DO i1 = LBOUND(u_out%TurbineComponents%Foundation%Orientation,1),UBOUND(u_out%TurbineComponents%Foundation%Orientation,1) - b = -(u1%TurbineComponents%Foundation%Orientation(i1,i2) - u2%TurbineComponents%Foundation%Orientation(i1,i2)) - u_out%TurbineComponents%Foundation%Orientation(i1,i2) = u1%TurbineComponents%Foundation%Orientation(i1,i2) + b * ScaleFactor - END DO - END DO - DO i1 = LBOUND(u_out%TurbineComponents%Foundation%TranslationVel,1),UBOUND(u_out%TurbineComponents%Foundation%TranslationVel,1) - b = -(u1%TurbineComponents%Foundation%TranslationVel(i1) - u2%TurbineComponents%Foundation%TranslationVel(i1)) - u_out%TurbineComponents%Foundation%TranslationVel(i1) = u1%TurbineComponents%Foundation%TranslationVel(i1) + b * ScaleFactor - END DO - DO i1 = LBOUND(u_out%TurbineComponents%Foundation%RotationVel,1),UBOUND(u_out%TurbineComponents%Foundation%RotationVel,1) - b = -(u1%TurbineComponents%Foundation%RotationVel(i1) - u2%TurbineComponents%Foundation%RotationVel(i1)) - u_out%TurbineComponents%Foundation%RotationVel(i1) = u1%TurbineComponents%Foundation%RotationVel(i1) + b * ScaleFactor - END DO - b = -(u1%TurbineComponents%BladeLength - u2%TurbineComponents%BladeLength) - u_out%TurbineComponents%BladeLength = u1%TurbineComponents%BladeLength + b * ScaleFactor -IF (ALLOCATED(u_out%MulTabLoc) .AND. ALLOCATED(u1%MulTabLoc)) THEN - DO i2 = LBOUND(u_out%MulTabLoc,2),UBOUND(u_out%MulTabLoc,2) - DO i1 = LBOUND(u_out%MulTabLoc,1),UBOUND(u_out%MulTabLoc,1) - b = -(u1%MulTabLoc(i1,i2) - u2%MulTabLoc(i1,i2)) - u_out%MulTabLoc(i1,i2) = u1%MulTabLoc(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%InflowVelocity) .AND. ALLOCATED(u1%InflowVelocity)) THEN - DO i2 = LBOUND(u_out%InflowVelocity,2),UBOUND(u_out%InflowVelocity,2) - DO i1 = LBOUND(u_out%InflowVelocity,1),UBOUND(u_out%InflowVelocity,1) - b = -(u1%InflowVelocity(i1,i2) - u2%InflowVelocity(i1,i2)) - u_out%InflowVelocity(i1,i2) = u1%InflowVelocity(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated - DO i1 = LBOUND(u_out%AvgInfVel,1),UBOUND(u_out%AvgInfVel,1) - b = -(u1%AvgInfVel(i1) - u2%AvgInfVel(i1)) - u_out%AvgInfVel(i1) = u1%AvgInfVel(i1) + b * ScaleFactor - END DO - END SUBROUTINE AD14_Input_ExtrapInterp1 - - - SUBROUTINE AD14_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(AD14_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 > t3 - TYPE(AD14_InputType), INTENT(INOUT) :: u2 ! Input at t2 > t3 - TYPE(AD14_InputType), INTENT(INOUT) :: u3 ! Input at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs - TYPE(AD14_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 = 'AD14_Input_ExtrapInterp2' - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i11 ! dim1 level 1 counter variable for arrays of ddts - INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts - INTEGER :: i12 ! dim2 level 1 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - INTEGER :: i2 ! dim2 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%InputMarkers) .AND. ALLOCATED(u1%InputMarkers)) THEN - DO i1 = LBOUND(u_out%InputMarkers,1),UBOUND(u_out%InputMarkers,1) - CALL MeshExtrapInterp2(u1%InputMarkers(i1), u2%InputMarkers(i1), u3%InputMarkers(i1), tin, u_out%InputMarkers(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated - CALL MeshExtrapInterp2(u1%Twr_InputMarkers, u2%Twr_InputMarkers, u3%Twr_InputMarkers, tin, u_out%Twr_InputMarkers, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) -IF (ALLOCATED(u_out%TurbineComponents%Blade) .AND. ALLOCATED(u1%TurbineComponents%Blade)) THEN - DO i11 = LBOUND(u_out%TurbineComponents%Blade,1),UBOUND(u_out%TurbineComponents%Blade,1) - DO i1 = LBOUND(u_out%TurbineComponents%Blade(i11)%Position,1),UBOUND(u_out%TurbineComponents%Blade(i11)%Position,1) - b = (t(3)**2*(u1%TurbineComponents%Blade(i11)%Position(i1) - u2%TurbineComponents%Blade(i11)%Position(i1)) + t(2)**2*(-u1%TurbineComponents%Blade(i11)%Position(i1) + u3%TurbineComponents%Blade(i11)%Position(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%TurbineComponents%Blade(i11)%Position(i1) + t(3)*u2%TurbineComponents%Blade(i11)%Position(i1) - t(2)*u3%TurbineComponents%Blade(i11)%Position(i1) ) * scaleFactor - u_out%TurbineComponents%Blade(i11)%Position(i1) = u1%TurbineComponents%Blade(i11)%Position(i1) + b + c * t_out - END DO - ENDDO - DO i11 = LBOUND(u_out%TurbineComponents%Blade,1),UBOUND(u_out%TurbineComponents%Blade,1) - DO i2 = LBOUND(u_out%TurbineComponents%Blade(i11)%Orientation,2),UBOUND(u_out%TurbineComponents%Blade(i11)%Orientation,2) - DO i1 = LBOUND(u_out%TurbineComponents%Blade(i11)%Orientation,1),UBOUND(u_out%TurbineComponents%Blade(i11)%Orientation,1) - b = (t(3)**2*(u1%TurbineComponents%Blade(i11)%Orientation(i1,i2) - u2%TurbineComponents%Blade(i11)%Orientation(i1,i2)) + t(2)**2*(-u1%TurbineComponents%Blade(i11)%Orientation(i1,i2) + u3%TurbineComponents%Blade(i11)%Orientation(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*u1%TurbineComponents%Blade(i11)%Orientation(i1,i2) + t(3)*u2%TurbineComponents%Blade(i11)%Orientation(i1,i2) - t(2)*u3%TurbineComponents%Blade(i11)%Orientation(i1,i2) ) * scaleFactor - u_out%TurbineComponents%Blade(i11)%Orientation(i1,i2) = u1%TurbineComponents%Blade(i11)%Orientation(i1,i2) + b + c * t_out - END DO - END DO - ENDDO - DO i11 = LBOUND(u_out%TurbineComponents%Blade,1),UBOUND(u_out%TurbineComponents%Blade,1) - DO i1 = LBOUND(u_out%TurbineComponents%Blade(i11)%TranslationVel,1),UBOUND(u_out%TurbineComponents%Blade(i11)%TranslationVel,1) - b = (t(3)**2*(u1%TurbineComponents%Blade(i11)%TranslationVel(i1) - u2%TurbineComponents%Blade(i11)%TranslationVel(i1)) + t(2)**2*(-u1%TurbineComponents%Blade(i11)%TranslationVel(i1) + u3%TurbineComponents%Blade(i11)%TranslationVel(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%TurbineComponents%Blade(i11)%TranslationVel(i1) + t(3)*u2%TurbineComponents%Blade(i11)%TranslationVel(i1) - t(2)*u3%TurbineComponents%Blade(i11)%TranslationVel(i1) ) * scaleFactor - u_out%TurbineComponents%Blade(i11)%TranslationVel(i1) = u1%TurbineComponents%Blade(i11)%TranslationVel(i1) + b + c * t_out - END DO - ENDDO - DO i11 = LBOUND(u_out%TurbineComponents%Blade,1),UBOUND(u_out%TurbineComponents%Blade,1) - DO i1 = LBOUND(u_out%TurbineComponents%Blade(i11)%RotationVel,1),UBOUND(u_out%TurbineComponents%Blade(i11)%RotationVel,1) - b = (t(3)**2*(u1%TurbineComponents%Blade(i11)%RotationVel(i1) - u2%TurbineComponents%Blade(i11)%RotationVel(i1)) + t(2)**2*(-u1%TurbineComponents%Blade(i11)%RotationVel(i1) + u3%TurbineComponents%Blade(i11)%RotationVel(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%TurbineComponents%Blade(i11)%RotationVel(i1) + t(3)*u2%TurbineComponents%Blade(i11)%RotationVel(i1) - t(2)*u3%TurbineComponents%Blade(i11)%RotationVel(i1) ) * scaleFactor - u_out%TurbineComponents%Blade(i11)%RotationVel(i1) = u1%TurbineComponents%Blade(i11)%RotationVel(i1) + b + c * t_out - END DO - ENDDO -END IF ! check if allocated - DO i1 = LBOUND(u_out%TurbineComponents%Hub%Position,1),UBOUND(u_out%TurbineComponents%Hub%Position,1) - b = (t(3)**2*(u1%TurbineComponents%Hub%Position(i1) - u2%TurbineComponents%Hub%Position(i1)) + t(2)**2*(-u1%TurbineComponents%Hub%Position(i1) + u3%TurbineComponents%Hub%Position(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%TurbineComponents%Hub%Position(i1) + t(3)*u2%TurbineComponents%Hub%Position(i1) - t(2)*u3%TurbineComponents%Hub%Position(i1) ) * scaleFactor - u_out%TurbineComponents%Hub%Position(i1) = u1%TurbineComponents%Hub%Position(i1) + b + c * t_out - END DO - DO i2 = LBOUND(u_out%TurbineComponents%Hub%Orientation,2),UBOUND(u_out%TurbineComponents%Hub%Orientation,2) - DO i1 = LBOUND(u_out%TurbineComponents%Hub%Orientation,1),UBOUND(u_out%TurbineComponents%Hub%Orientation,1) - b = (t(3)**2*(u1%TurbineComponents%Hub%Orientation(i1,i2) - u2%TurbineComponents%Hub%Orientation(i1,i2)) + t(2)**2*(-u1%TurbineComponents%Hub%Orientation(i1,i2) + u3%TurbineComponents%Hub%Orientation(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*u1%TurbineComponents%Hub%Orientation(i1,i2) + t(3)*u2%TurbineComponents%Hub%Orientation(i1,i2) - t(2)*u3%TurbineComponents%Hub%Orientation(i1,i2) ) * scaleFactor - u_out%TurbineComponents%Hub%Orientation(i1,i2) = u1%TurbineComponents%Hub%Orientation(i1,i2) + b + c * t_out - END DO - END DO - DO i1 = LBOUND(u_out%TurbineComponents%Hub%TranslationVel,1),UBOUND(u_out%TurbineComponents%Hub%TranslationVel,1) - b = (t(3)**2*(u1%TurbineComponents%Hub%TranslationVel(i1) - u2%TurbineComponents%Hub%TranslationVel(i1)) + t(2)**2*(-u1%TurbineComponents%Hub%TranslationVel(i1) + u3%TurbineComponents%Hub%TranslationVel(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%TurbineComponents%Hub%TranslationVel(i1) + t(3)*u2%TurbineComponents%Hub%TranslationVel(i1) - t(2)*u3%TurbineComponents%Hub%TranslationVel(i1) ) * scaleFactor - u_out%TurbineComponents%Hub%TranslationVel(i1) = u1%TurbineComponents%Hub%TranslationVel(i1) + b + c * t_out - END DO - DO i1 = LBOUND(u_out%TurbineComponents%Hub%RotationVel,1),UBOUND(u_out%TurbineComponents%Hub%RotationVel,1) - b = (t(3)**2*(u1%TurbineComponents%Hub%RotationVel(i1) - u2%TurbineComponents%Hub%RotationVel(i1)) + t(2)**2*(-u1%TurbineComponents%Hub%RotationVel(i1) + u3%TurbineComponents%Hub%RotationVel(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%TurbineComponents%Hub%RotationVel(i1) + t(3)*u2%TurbineComponents%Hub%RotationVel(i1) - t(2)*u3%TurbineComponents%Hub%RotationVel(i1) ) * scaleFactor - u_out%TurbineComponents%Hub%RotationVel(i1) = u1%TurbineComponents%Hub%RotationVel(i1) + b + c * t_out - END DO - DO i1 = LBOUND(u_out%TurbineComponents%RotorFurl%Position,1),UBOUND(u_out%TurbineComponents%RotorFurl%Position,1) - b = (t(3)**2*(u1%TurbineComponents%RotorFurl%Position(i1) - u2%TurbineComponents%RotorFurl%Position(i1)) + t(2)**2*(-u1%TurbineComponents%RotorFurl%Position(i1) + u3%TurbineComponents%RotorFurl%Position(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%TurbineComponents%RotorFurl%Position(i1) + t(3)*u2%TurbineComponents%RotorFurl%Position(i1) - t(2)*u3%TurbineComponents%RotorFurl%Position(i1) ) * scaleFactor - u_out%TurbineComponents%RotorFurl%Position(i1) = u1%TurbineComponents%RotorFurl%Position(i1) + b + c * t_out - END DO - DO i2 = LBOUND(u_out%TurbineComponents%RotorFurl%Orientation,2),UBOUND(u_out%TurbineComponents%RotorFurl%Orientation,2) - DO i1 = LBOUND(u_out%TurbineComponents%RotorFurl%Orientation,1),UBOUND(u_out%TurbineComponents%RotorFurl%Orientation,1) - b = (t(3)**2*(u1%TurbineComponents%RotorFurl%Orientation(i1,i2) - u2%TurbineComponents%RotorFurl%Orientation(i1,i2)) + t(2)**2*(-u1%TurbineComponents%RotorFurl%Orientation(i1,i2) + u3%TurbineComponents%RotorFurl%Orientation(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*u1%TurbineComponents%RotorFurl%Orientation(i1,i2) + t(3)*u2%TurbineComponents%RotorFurl%Orientation(i1,i2) - t(2)*u3%TurbineComponents%RotorFurl%Orientation(i1,i2) ) * scaleFactor - u_out%TurbineComponents%RotorFurl%Orientation(i1,i2) = u1%TurbineComponents%RotorFurl%Orientation(i1,i2) + b + c * t_out - END DO - END DO - DO i1 = LBOUND(u_out%TurbineComponents%RotorFurl%TranslationVel,1),UBOUND(u_out%TurbineComponents%RotorFurl%TranslationVel,1) - b = (t(3)**2*(u1%TurbineComponents%RotorFurl%TranslationVel(i1) - u2%TurbineComponents%RotorFurl%TranslationVel(i1)) + t(2)**2*(-u1%TurbineComponents%RotorFurl%TranslationVel(i1) + u3%TurbineComponents%RotorFurl%TranslationVel(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%TurbineComponents%RotorFurl%TranslationVel(i1) + t(3)*u2%TurbineComponents%RotorFurl%TranslationVel(i1) - t(2)*u3%TurbineComponents%RotorFurl%TranslationVel(i1) ) * scaleFactor - u_out%TurbineComponents%RotorFurl%TranslationVel(i1) = u1%TurbineComponents%RotorFurl%TranslationVel(i1) + b + c * t_out - END DO - DO i1 = LBOUND(u_out%TurbineComponents%RotorFurl%RotationVel,1),UBOUND(u_out%TurbineComponents%RotorFurl%RotationVel,1) - b = (t(3)**2*(u1%TurbineComponents%RotorFurl%RotationVel(i1) - u2%TurbineComponents%RotorFurl%RotationVel(i1)) + t(2)**2*(-u1%TurbineComponents%RotorFurl%RotationVel(i1) + u3%TurbineComponents%RotorFurl%RotationVel(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%TurbineComponents%RotorFurl%RotationVel(i1) + t(3)*u2%TurbineComponents%RotorFurl%RotationVel(i1) - t(2)*u3%TurbineComponents%RotorFurl%RotationVel(i1) ) * scaleFactor - u_out%TurbineComponents%RotorFurl%RotationVel(i1) = u1%TurbineComponents%RotorFurl%RotationVel(i1) + b + c * t_out - END DO - DO i1 = LBOUND(u_out%TurbineComponents%Nacelle%Position,1),UBOUND(u_out%TurbineComponents%Nacelle%Position,1) - b = (t(3)**2*(u1%TurbineComponents%Nacelle%Position(i1) - u2%TurbineComponents%Nacelle%Position(i1)) + t(2)**2*(-u1%TurbineComponents%Nacelle%Position(i1) + u3%TurbineComponents%Nacelle%Position(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%TurbineComponents%Nacelle%Position(i1) + t(3)*u2%TurbineComponents%Nacelle%Position(i1) - t(2)*u3%TurbineComponents%Nacelle%Position(i1) ) * scaleFactor - u_out%TurbineComponents%Nacelle%Position(i1) = u1%TurbineComponents%Nacelle%Position(i1) + b + c * t_out - END DO - DO i2 = LBOUND(u_out%TurbineComponents%Nacelle%Orientation,2),UBOUND(u_out%TurbineComponents%Nacelle%Orientation,2) - DO i1 = LBOUND(u_out%TurbineComponents%Nacelle%Orientation,1),UBOUND(u_out%TurbineComponents%Nacelle%Orientation,1) - b = (t(3)**2*(u1%TurbineComponents%Nacelle%Orientation(i1,i2) - u2%TurbineComponents%Nacelle%Orientation(i1,i2)) + t(2)**2*(-u1%TurbineComponents%Nacelle%Orientation(i1,i2) + u3%TurbineComponents%Nacelle%Orientation(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*u1%TurbineComponents%Nacelle%Orientation(i1,i2) + t(3)*u2%TurbineComponents%Nacelle%Orientation(i1,i2) - t(2)*u3%TurbineComponents%Nacelle%Orientation(i1,i2) ) * scaleFactor - u_out%TurbineComponents%Nacelle%Orientation(i1,i2) = u1%TurbineComponents%Nacelle%Orientation(i1,i2) + b + c * t_out - END DO - END DO - DO i1 = LBOUND(u_out%TurbineComponents%Nacelle%TranslationVel,1),UBOUND(u_out%TurbineComponents%Nacelle%TranslationVel,1) - b = (t(3)**2*(u1%TurbineComponents%Nacelle%TranslationVel(i1) - u2%TurbineComponents%Nacelle%TranslationVel(i1)) + t(2)**2*(-u1%TurbineComponents%Nacelle%TranslationVel(i1) + u3%TurbineComponents%Nacelle%TranslationVel(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%TurbineComponents%Nacelle%TranslationVel(i1) + t(3)*u2%TurbineComponents%Nacelle%TranslationVel(i1) - t(2)*u3%TurbineComponents%Nacelle%TranslationVel(i1) ) * scaleFactor - u_out%TurbineComponents%Nacelle%TranslationVel(i1) = u1%TurbineComponents%Nacelle%TranslationVel(i1) + b + c * t_out - END DO - DO i1 = LBOUND(u_out%TurbineComponents%Nacelle%RotationVel,1),UBOUND(u_out%TurbineComponents%Nacelle%RotationVel,1) - b = (t(3)**2*(u1%TurbineComponents%Nacelle%RotationVel(i1) - u2%TurbineComponents%Nacelle%RotationVel(i1)) + t(2)**2*(-u1%TurbineComponents%Nacelle%RotationVel(i1) + u3%TurbineComponents%Nacelle%RotationVel(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%TurbineComponents%Nacelle%RotationVel(i1) + t(3)*u2%TurbineComponents%Nacelle%RotationVel(i1) - t(2)*u3%TurbineComponents%Nacelle%RotationVel(i1) ) * scaleFactor - u_out%TurbineComponents%Nacelle%RotationVel(i1) = u1%TurbineComponents%Nacelle%RotationVel(i1) + b + c * t_out - END DO - DO i1 = LBOUND(u_out%TurbineComponents%TailFin%Position,1),UBOUND(u_out%TurbineComponents%TailFin%Position,1) - b = (t(3)**2*(u1%TurbineComponents%TailFin%Position(i1) - u2%TurbineComponents%TailFin%Position(i1)) + t(2)**2*(-u1%TurbineComponents%TailFin%Position(i1) + u3%TurbineComponents%TailFin%Position(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%TurbineComponents%TailFin%Position(i1) + t(3)*u2%TurbineComponents%TailFin%Position(i1) - t(2)*u3%TurbineComponents%TailFin%Position(i1) ) * scaleFactor - u_out%TurbineComponents%TailFin%Position(i1) = u1%TurbineComponents%TailFin%Position(i1) + b + c * t_out - END DO - DO i2 = LBOUND(u_out%TurbineComponents%TailFin%Orientation,2),UBOUND(u_out%TurbineComponents%TailFin%Orientation,2) - DO i1 = LBOUND(u_out%TurbineComponents%TailFin%Orientation,1),UBOUND(u_out%TurbineComponents%TailFin%Orientation,1) - b = (t(3)**2*(u1%TurbineComponents%TailFin%Orientation(i1,i2) - u2%TurbineComponents%TailFin%Orientation(i1,i2)) + t(2)**2*(-u1%TurbineComponents%TailFin%Orientation(i1,i2) + u3%TurbineComponents%TailFin%Orientation(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*u1%TurbineComponents%TailFin%Orientation(i1,i2) + t(3)*u2%TurbineComponents%TailFin%Orientation(i1,i2) - t(2)*u3%TurbineComponents%TailFin%Orientation(i1,i2) ) * scaleFactor - u_out%TurbineComponents%TailFin%Orientation(i1,i2) = u1%TurbineComponents%TailFin%Orientation(i1,i2) + b + c * t_out - END DO - END DO - DO i1 = LBOUND(u_out%TurbineComponents%TailFin%TranslationVel,1),UBOUND(u_out%TurbineComponents%TailFin%TranslationVel,1) - b = (t(3)**2*(u1%TurbineComponents%TailFin%TranslationVel(i1) - u2%TurbineComponents%TailFin%TranslationVel(i1)) + t(2)**2*(-u1%TurbineComponents%TailFin%TranslationVel(i1) + u3%TurbineComponents%TailFin%TranslationVel(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%TurbineComponents%TailFin%TranslationVel(i1) + t(3)*u2%TurbineComponents%TailFin%TranslationVel(i1) - t(2)*u3%TurbineComponents%TailFin%TranslationVel(i1) ) * scaleFactor - u_out%TurbineComponents%TailFin%TranslationVel(i1) = u1%TurbineComponents%TailFin%TranslationVel(i1) + b + c * t_out - END DO - DO i1 = LBOUND(u_out%TurbineComponents%TailFin%RotationVel,1),UBOUND(u_out%TurbineComponents%TailFin%RotationVel,1) - b = (t(3)**2*(u1%TurbineComponents%TailFin%RotationVel(i1) - u2%TurbineComponents%TailFin%RotationVel(i1)) + t(2)**2*(-u1%TurbineComponents%TailFin%RotationVel(i1) + u3%TurbineComponents%TailFin%RotationVel(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%TurbineComponents%TailFin%RotationVel(i1) + t(3)*u2%TurbineComponents%TailFin%RotationVel(i1) - t(2)*u3%TurbineComponents%TailFin%RotationVel(i1) ) * scaleFactor - u_out%TurbineComponents%TailFin%RotationVel(i1) = u1%TurbineComponents%TailFin%RotationVel(i1) + b + c * t_out - END DO - DO i1 = LBOUND(u_out%TurbineComponents%Tower%Position,1),UBOUND(u_out%TurbineComponents%Tower%Position,1) - b = (t(3)**2*(u1%TurbineComponents%Tower%Position(i1) - u2%TurbineComponents%Tower%Position(i1)) + t(2)**2*(-u1%TurbineComponents%Tower%Position(i1) + u3%TurbineComponents%Tower%Position(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%TurbineComponents%Tower%Position(i1) + t(3)*u2%TurbineComponents%Tower%Position(i1) - t(2)*u3%TurbineComponents%Tower%Position(i1) ) * scaleFactor - u_out%TurbineComponents%Tower%Position(i1) = u1%TurbineComponents%Tower%Position(i1) + b + c * t_out - END DO - DO i2 = LBOUND(u_out%TurbineComponents%Tower%Orientation,2),UBOUND(u_out%TurbineComponents%Tower%Orientation,2) - DO i1 = LBOUND(u_out%TurbineComponents%Tower%Orientation,1),UBOUND(u_out%TurbineComponents%Tower%Orientation,1) - b = (t(3)**2*(u1%TurbineComponents%Tower%Orientation(i1,i2) - u2%TurbineComponents%Tower%Orientation(i1,i2)) + t(2)**2*(-u1%TurbineComponents%Tower%Orientation(i1,i2) + u3%TurbineComponents%Tower%Orientation(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*u1%TurbineComponents%Tower%Orientation(i1,i2) + t(3)*u2%TurbineComponents%Tower%Orientation(i1,i2) - t(2)*u3%TurbineComponents%Tower%Orientation(i1,i2) ) * scaleFactor - u_out%TurbineComponents%Tower%Orientation(i1,i2) = u1%TurbineComponents%Tower%Orientation(i1,i2) + b + c * t_out - END DO - END DO - DO i1 = LBOUND(u_out%TurbineComponents%Tower%TranslationVel,1),UBOUND(u_out%TurbineComponents%Tower%TranslationVel,1) - b = (t(3)**2*(u1%TurbineComponents%Tower%TranslationVel(i1) - u2%TurbineComponents%Tower%TranslationVel(i1)) + t(2)**2*(-u1%TurbineComponents%Tower%TranslationVel(i1) + u3%TurbineComponents%Tower%TranslationVel(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%TurbineComponents%Tower%TranslationVel(i1) + t(3)*u2%TurbineComponents%Tower%TranslationVel(i1) - t(2)*u3%TurbineComponents%Tower%TranslationVel(i1) ) * scaleFactor - u_out%TurbineComponents%Tower%TranslationVel(i1) = u1%TurbineComponents%Tower%TranslationVel(i1) + b + c * t_out - END DO - DO i1 = LBOUND(u_out%TurbineComponents%Tower%RotationVel,1),UBOUND(u_out%TurbineComponents%Tower%RotationVel,1) - b = (t(3)**2*(u1%TurbineComponents%Tower%RotationVel(i1) - u2%TurbineComponents%Tower%RotationVel(i1)) + t(2)**2*(-u1%TurbineComponents%Tower%RotationVel(i1) + u3%TurbineComponents%Tower%RotationVel(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%TurbineComponents%Tower%RotationVel(i1) + t(3)*u2%TurbineComponents%Tower%RotationVel(i1) - t(2)*u3%TurbineComponents%Tower%RotationVel(i1) ) * scaleFactor - u_out%TurbineComponents%Tower%RotationVel(i1) = u1%TurbineComponents%Tower%RotationVel(i1) + b + c * t_out - END DO - DO i1 = LBOUND(u_out%TurbineComponents%SubStructure%Position,1),UBOUND(u_out%TurbineComponents%SubStructure%Position,1) - b = (t(3)**2*(u1%TurbineComponents%SubStructure%Position(i1) - u2%TurbineComponents%SubStructure%Position(i1)) + t(2)**2*(-u1%TurbineComponents%SubStructure%Position(i1) + u3%TurbineComponents%SubStructure%Position(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%TurbineComponents%SubStructure%Position(i1) + t(3)*u2%TurbineComponents%SubStructure%Position(i1) - t(2)*u3%TurbineComponents%SubStructure%Position(i1) ) * scaleFactor - u_out%TurbineComponents%SubStructure%Position(i1) = u1%TurbineComponents%SubStructure%Position(i1) + b + c * t_out - END DO - DO i2 = LBOUND(u_out%TurbineComponents%SubStructure%Orientation,2),UBOUND(u_out%TurbineComponents%SubStructure%Orientation,2) - DO i1 = LBOUND(u_out%TurbineComponents%SubStructure%Orientation,1),UBOUND(u_out%TurbineComponents%SubStructure%Orientation,1) - b = (t(3)**2*(u1%TurbineComponents%SubStructure%Orientation(i1,i2) - u2%TurbineComponents%SubStructure%Orientation(i1,i2)) + t(2)**2*(-u1%TurbineComponents%SubStructure%Orientation(i1,i2) + u3%TurbineComponents%SubStructure%Orientation(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*u1%TurbineComponents%SubStructure%Orientation(i1,i2) + t(3)*u2%TurbineComponents%SubStructure%Orientation(i1,i2) - t(2)*u3%TurbineComponents%SubStructure%Orientation(i1,i2) ) * scaleFactor - u_out%TurbineComponents%SubStructure%Orientation(i1,i2) = u1%TurbineComponents%SubStructure%Orientation(i1,i2) + b + c * t_out - END DO - END DO - DO i1 = LBOUND(u_out%TurbineComponents%SubStructure%TranslationVel,1),UBOUND(u_out%TurbineComponents%SubStructure%TranslationVel,1) - b = (t(3)**2*(u1%TurbineComponents%SubStructure%TranslationVel(i1) - u2%TurbineComponents%SubStructure%TranslationVel(i1)) + t(2)**2*(-u1%TurbineComponents%SubStructure%TranslationVel(i1) + u3%TurbineComponents%SubStructure%TranslationVel(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%TurbineComponents%SubStructure%TranslationVel(i1) + t(3)*u2%TurbineComponents%SubStructure%TranslationVel(i1) - t(2)*u3%TurbineComponents%SubStructure%TranslationVel(i1) ) * scaleFactor - u_out%TurbineComponents%SubStructure%TranslationVel(i1) = u1%TurbineComponents%SubStructure%TranslationVel(i1) + b + c * t_out - END DO - DO i1 = LBOUND(u_out%TurbineComponents%SubStructure%RotationVel,1),UBOUND(u_out%TurbineComponents%SubStructure%RotationVel,1) - b = (t(3)**2*(u1%TurbineComponents%SubStructure%RotationVel(i1) - u2%TurbineComponents%SubStructure%RotationVel(i1)) + t(2)**2*(-u1%TurbineComponents%SubStructure%RotationVel(i1) + u3%TurbineComponents%SubStructure%RotationVel(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%TurbineComponents%SubStructure%RotationVel(i1) + t(3)*u2%TurbineComponents%SubStructure%RotationVel(i1) - t(2)*u3%TurbineComponents%SubStructure%RotationVel(i1) ) * scaleFactor - u_out%TurbineComponents%SubStructure%RotationVel(i1) = u1%TurbineComponents%SubStructure%RotationVel(i1) + b + c * t_out - END DO - DO i1 = LBOUND(u_out%TurbineComponents%Foundation%Position,1),UBOUND(u_out%TurbineComponents%Foundation%Position,1) - b = (t(3)**2*(u1%TurbineComponents%Foundation%Position(i1) - u2%TurbineComponents%Foundation%Position(i1)) + t(2)**2*(-u1%TurbineComponents%Foundation%Position(i1) + u3%TurbineComponents%Foundation%Position(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%TurbineComponents%Foundation%Position(i1) + t(3)*u2%TurbineComponents%Foundation%Position(i1) - t(2)*u3%TurbineComponents%Foundation%Position(i1) ) * scaleFactor - u_out%TurbineComponents%Foundation%Position(i1) = u1%TurbineComponents%Foundation%Position(i1) + b + c * t_out - END DO - DO i2 = LBOUND(u_out%TurbineComponents%Foundation%Orientation,2),UBOUND(u_out%TurbineComponents%Foundation%Orientation,2) - DO i1 = LBOUND(u_out%TurbineComponents%Foundation%Orientation,1),UBOUND(u_out%TurbineComponents%Foundation%Orientation,1) - b = (t(3)**2*(u1%TurbineComponents%Foundation%Orientation(i1,i2) - u2%TurbineComponents%Foundation%Orientation(i1,i2)) + t(2)**2*(-u1%TurbineComponents%Foundation%Orientation(i1,i2) + u3%TurbineComponents%Foundation%Orientation(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*u1%TurbineComponents%Foundation%Orientation(i1,i2) + t(3)*u2%TurbineComponents%Foundation%Orientation(i1,i2) - t(2)*u3%TurbineComponents%Foundation%Orientation(i1,i2) ) * scaleFactor - u_out%TurbineComponents%Foundation%Orientation(i1,i2) = u1%TurbineComponents%Foundation%Orientation(i1,i2) + b + c * t_out - END DO - END DO - DO i1 = LBOUND(u_out%TurbineComponents%Foundation%TranslationVel,1),UBOUND(u_out%TurbineComponents%Foundation%TranslationVel,1) - b = (t(3)**2*(u1%TurbineComponents%Foundation%TranslationVel(i1) - u2%TurbineComponents%Foundation%TranslationVel(i1)) + t(2)**2*(-u1%TurbineComponents%Foundation%TranslationVel(i1) + u3%TurbineComponents%Foundation%TranslationVel(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%TurbineComponents%Foundation%TranslationVel(i1) + t(3)*u2%TurbineComponents%Foundation%TranslationVel(i1) - t(2)*u3%TurbineComponents%Foundation%TranslationVel(i1) ) * scaleFactor - u_out%TurbineComponents%Foundation%TranslationVel(i1) = u1%TurbineComponents%Foundation%TranslationVel(i1) + b + c * t_out - END DO - DO i1 = LBOUND(u_out%TurbineComponents%Foundation%RotationVel,1),UBOUND(u_out%TurbineComponents%Foundation%RotationVel,1) - b = (t(3)**2*(u1%TurbineComponents%Foundation%RotationVel(i1) - u2%TurbineComponents%Foundation%RotationVel(i1)) + t(2)**2*(-u1%TurbineComponents%Foundation%RotationVel(i1) + u3%TurbineComponents%Foundation%RotationVel(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%TurbineComponents%Foundation%RotationVel(i1) + t(3)*u2%TurbineComponents%Foundation%RotationVel(i1) - t(2)*u3%TurbineComponents%Foundation%RotationVel(i1) ) * scaleFactor - u_out%TurbineComponents%Foundation%RotationVel(i1) = u1%TurbineComponents%Foundation%RotationVel(i1) + b + c * t_out - END DO - b = (t(3)**2*(u1%TurbineComponents%BladeLength - u2%TurbineComponents%BladeLength) + t(2)**2*(-u1%TurbineComponents%BladeLength + u3%TurbineComponents%BladeLength))* scaleFactor - c = ( (t(2)-t(3))*u1%TurbineComponents%BladeLength + t(3)*u2%TurbineComponents%BladeLength - t(2)*u3%TurbineComponents%BladeLength ) * scaleFactor - u_out%TurbineComponents%BladeLength = u1%TurbineComponents%BladeLength + b + c * t_out -IF (ALLOCATED(u_out%MulTabLoc) .AND. ALLOCATED(u1%MulTabLoc)) THEN - DO i2 = LBOUND(u_out%MulTabLoc,2),UBOUND(u_out%MulTabLoc,2) - DO i1 = LBOUND(u_out%MulTabLoc,1),UBOUND(u_out%MulTabLoc,1) - b = (t(3)**2*(u1%MulTabLoc(i1,i2) - u2%MulTabLoc(i1,i2)) + t(2)**2*(-u1%MulTabLoc(i1,i2) + u3%MulTabLoc(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*u1%MulTabLoc(i1,i2) + t(3)*u2%MulTabLoc(i1,i2) - t(2)*u3%MulTabLoc(i1,i2) ) * scaleFactor - u_out%MulTabLoc(i1,i2) = u1%MulTabLoc(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%InflowVelocity) .AND. ALLOCATED(u1%InflowVelocity)) THEN - DO i2 = LBOUND(u_out%InflowVelocity,2),UBOUND(u_out%InflowVelocity,2) - DO i1 = LBOUND(u_out%InflowVelocity,1),UBOUND(u_out%InflowVelocity,1) - b = (t(3)**2*(u1%InflowVelocity(i1,i2) - u2%InflowVelocity(i1,i2)) + t(2)**2*(-u1%InflowVelocity(i1,i2) + u3%InflowVelocity(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*u1%InflowVelocity(i1,i2) + t(3)*u2%InflowVelocity(i1,i2) - t(2)*u3%InflowVelocity(i1,i2) ) * scaleFactor - u_out%InflowVelocity(i1,i2) = u1%InflowVelocity(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated - DO i1 = LBOUND(u_out%AvgInfVel,1),UBOUND(u_out%AvgInfVel,1) - b = (t(3)**2*(u1%AvgInfVel(i1) - u2%AvgInfVel(i1)) + t(2)**2*(-u1%AvgInfVel(i1) + u3%AvgInfVel(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%AvgInfVel(i1) + t(3)*u2%AvgInfVel(i1) - t(2)*u3%AvgInfVel(i1) ) * scaleFactor - u_out%AvgInfVel(i1) = u1%AvgInfVel(i1) + b + c * t_out - END DO - END SUBROUTINE AD14_Input_ExtrapInterp2 - - - SUBROUTINE AD14_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(AD14_OutputType), INTENT(INOUT) :: y(:) ! Output at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Outputs - TYPE(AD14_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 = 'AD14_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 AD14_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL AD14_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 AD14_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 AD14_Output_ExtrapInterp - - - SUBROUTINE AD14_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(AD14_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 - TYPE(AD14_OutputType), INTENT(INOUT) :: y2 ! Output at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs - TYPE(AD14_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 = 'AD14_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%OutputLoads) .AND. ALLOCATED(y1%OutputLoads)) THEN - DO i1 = LBOUND(y_out%OutputLoads,1),UBOUND(y_out%OutputLoads,1) - CALL MeshExtrapInterp1(y1%OutputLoads(i1), y2%OutputLoads(i1), tin, y_out%OutputLoads(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated - CALL MeshExtrapInterp1(y1%Twr_OutputLoads, y2%Twr_OutputLoads, tin, y_out%Twr_OutputLoads, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - END SUBROUTINE AD14_Output_ExtrapInterp1 - - - SUBROUTINE AD14_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(AD14_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 > t3 - TYPE(AD14_OutputType), INTENT(INOUT) :: y2 ! Output at t2 > t3 - TYPE(AD14_OutputType), INTENT(INOUT) :: y3 ! Output at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs - TYPE(AD14_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 = 'AD14_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%OutputLoads) .AND. ALLOCATED(y1%OutputLoads)) THEN - DO i1 = LBOUND(y_out%OutputLoads,1),UBOUND(y_out%OutputLoads,1) - CALL MeshExtrapInterp2(y1%OutputLoads(i1), y2%OutputLoads(i1), y3%OutputLoads(i1), tin, y_out%OutputLoads(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated - CALL MeshExtrapInterp2(y1%Twr_OutputLoads, y2%Twr_OutputLoads, y3%Twr_OutputLoads, tin, y_out%Twr_OutputLoads, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - END SUBROUTINE AD14_Output_ExtrapInterp2 - -END MODULE AeroDyn14_Types -!ENDOFREGISTRYGENERATEDFILE diff --git a/modules/aerodyn14/src/AeroSubs.f90 b/modules/aerodyn14/src/AeroSubs.f90 deleted file mode 100644 index d47f5137c7..0000000000 --- a/modules/aerodyn14/src/AeroSubs.f90 +++ /dev/null @@ -1,5531 +0,0 @@ -!********************************************************************************************************************************** -MODULE AeroSubs - - USE NWTC_Library - USE AeroDyn14_Types - - USE AeroGenSubs, ONLY : MaxInfl - - - IMPLICIT NONE - - - INTEGER(IntKi) , PARAMETER, DIMENSION(1:6) :: MRvector = (/ 0, 0, 1, 1, 2, 3 /) !bjj why aren't these parameters? Now they are. - INTEGER(IntKi) , PARAMETER, DIMENSION(1:6) :: NJVector = (/ 1, 3, 2, 4, 3, 4 /) - - -CONTAINS -! ************************************************ -! AeroDyn Subroutines for YawDyn, ADAMS, -! SymDyn and FAST. -! ************************************************ -! UNIVERSITY OF UTAH, MECHANICAL ENGINEERING DEPARTMENT - - -! Updated version that uses FAST Interface types -!==================================================================================================== -SUBROUTINE AD14_GetInput(InitInp, P, x, xd, z, m, y, ErrStat, ErrMess ) -!==================================================================================================== - USE AeroGenSubs, ONLY: AllocArrays - IMPLICIT NONE - ! Passed Variables: - TYPE(AD14_InitInputType), INTENT(INOUT) :: InitInp - TYPE(AD14_ParameterType), INTENT(INOUT) :: p ! Parameters - TYPE(AD14_ContinuousStateType), INTENT(INOUT) :: x ! Initial continuous states - TYPE(AD14_DiscreteStateType), INTENT(INOUT) :: xd ! Initial discrete states - TYPE(AD14_ConstraintStateType), INTENT(INOUT) :: z ! Initial guess of the constraint states - TYPE(AD14_MiscVarType), INTENT(INOUT) :: m ! Initial misc/optimization variables - TYPE(AD14_OutputType), INTENT(INOUT) :: y ! Initial system outputs (outputs are not calculated; - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMess - - ! Local Variables: - - INTEGER :: ElIndex - INTEGER :: IELM - INTEGER :: IndPrint - INTEGER :: K - INTEGER :: UnIn - INTEGER :: ErrStatLcl - - LOGICAL :: PremEOF_indicator - CHARACTER(1024) :: LINE - CHARACTER(1024) :: FilePath ! The path name of the AeroDyn input file (so files listed in it can be defined relative to the main input file location) - CHARACTER(ErrMsgLen) :: ErrMessLcl - character(*), parameter :: RoutineName = 'AD14_GetInput' - - !bjj: error handling here needs to be fixed! (we overwrite any non-AbortErrLev errors) - - ErrStat = ErrID_None - ErrMess = '' - - ! Function definition - - call GetNewUnit(UnIn, ErrStatLcl, ErrMessLcl) - - !------------------------------------------------------------------------------------------------- - ! Open the AeroDyn input file - !------------------------------------------------------------------------------------------------- - CALL OpenFInpFile(UnIn, TRIM(InitInp%ADFileName), ErrStatLcl, ErrMessLcl) - CALL SetErrStat(ErrStatLcl, ErrMessLcl,ErrStat, ErrMess,RoutineName) - IF (ErrStat >= AbortErrLev) THEN - CLOSE(UnIn) - RETURN - END IF - - CALL GetPath( InitInp%ADFileName, FilePath ) - - !------------------------------------------------------------------------------------------------- - ! If the echo file is open, write the header... - !------------------------------------------------------------------------------------------------- - IF ( p%Echo ) THEN - WRITE( p%UnEc, '(// A /)' ) 'AeroDyn input data from file "'//TRIM( InitInp%ADFileName )//'":' - END IF - - !------------------------------------------------------------------------------------------------- - ! Read the AeroDyn input file - !------------------------------------------------------------------------------------------------- - - CALL ReadCom( UnIn, InitInp%ADFileName, 'Header', ErrStatLcl, ErrMessLcl ) - CALL SetErrStat(ErrStatLcl, ErrMessLcl,ErrStat, ErrMess,RoutineName) - - ! Read in the title line - CALL ReadStr( UnIn, InitInp%ADFileName, InitInp%Title, VarName='Title', VarDescr='File title', ErrStat=ErrStatLcl, ErrMsg=ErrMessLcl) - CALL SetErrStat(ErrStatLcl, ErrMessLcl,ErrStat, ErrMess,RoutineName) - IF (ErrStat >= AbortErrLev) THEN - CLOSE(UnIn) - RETURN - END IF - - IF (NWTC_VerboseLevel == NWTC_Verbose) THEN - CALL WrScr( ' Heading of the AeroDyn input file: '//NewLine//' '//TRIM(InitInp%Title) ) - END IF - p%TITLE = InitInp%TITLE - - p%SIunit = .TRUE. - - ! Read in the stall model - CALL ReadVar( UnIn, InitInp%ADFileName, LINE, VarName='DStall', VarDescr='Stall model', ErrStat=ErrStat, ErrMsg=ErrMess) - IF (ErrStat >= AbortErrLev) THEN - CLOSE(UnIn) - RETURN - END IF - - CALL Conv2UC(LINE(1:7)) - - SELECT CASE ( TRIM(Line) ) - CASE ('STEADY') - P%DStall = .FALSE. - CASE ('BEDDOES') ! added -- maybe the input format changed? jm - P%DStall = .TRUE. - CASE DEFAULT - CALL ProgWarn( ' Error: Expecting "STEADY" or "BEDDOES" stall model option.') - ErrStat = ErrID_Fatal - CLOSE(UnIn) - RETURN - END SELECT - - - ! Read in the CM option - CALL ReadVar( UnIn, InitInp%ADFileName, LINE, VarName='PMoment', VarDescr='Pitching moment option', ErrStat=ErrStat, ErrMsg=ErrMess) - IF (ErrStat >= AbortErrLev) THEN - CLOSE(UnIn) - RETURN - END IF - - CALL Conv2UC(LINE(1:6)) - - SELECT CASE ( TRIM(Line) ) - CASE ('USE_CM') - P%PMoment = .TRUE. - CASE ('NO_CM') - P%PMoment = .FALSE. - CASE DEFAULT - CALL ProgWarn( ' Error: Expecting "USE_CM" or "NO_CM" pitching moment option.') - ErrStat = ErrID_Fatal - CLOSE(UnIn) - RETURN - END SELECT - - - ! Read in the inflow model option - CALL ReadVar( UnIn, InitInp%ADFileName, LINE, VarName='DynInfl', VarDescr='Inflow model', ErrStat=ErrStat, ErrMsg=ErrMess) - IF (ErrStat >= AbortErrLev) THEN - CLOSE(UnIn) - RETURN - END IF - - CALL Conv2UC(LINE(1:7)) - - SELECT CASE ( Line(1:5) ) - CASE ('EQUIL') - P%DynInfl = .FALSE. - m%DynInit = .FALSE. - - IF (Line(6:7) == 'DA') THEN - P%Inducedvel%EqAIDmult = 1.0 - P%Inducedvel%EquilDA = .TRUE. - P%Inducedvel%EquilDT = .FALSE. - ELSEIF (LINE(6:7) == 'DB') THEN - P%Inducedvel%EqAIDmult = 1.0 - P%Inducedvel%EquilDA = .TRUE. - P%Inducedvel%EquilDT = .TRUE. - ELSEIF (LINE(6:7) == 'DT') THEN - P%Inducedvel%EqAIDmult = 0.0 - P%Inducedvel%EquilDA = .FALSE. - P%Inducedvel%EquilDT = .TRUE. - ELSE - P%Inducedvel%EqAIDmult = 0.0 - P%Inducedvel%EquilDA = .FALSE. - P%Inducedvel%EquilDT = .FALSE. - ENDIF - - CASE ('DYNIN') - P%DynInfl = .TRUE. - m%DynInit = .TRUE. - CASE DEFAULT - CALL ProgWarn( ' Error: Expecting "EQUIL" or "DYNIN" inflow model option.') - ErrStat = ErrID_Fatal - CLOSE(UnIn) - RETURN - END SELECT - - - ! Read in the wake model - CALL ReadVar( UnIn, InitInp%ADFileName, LINE, VarName='Wake', VarDescr='Wake model', ErrStat=ErrStat, ErrMsg=ErrMess) - IF (ErrStat >= AbortErrLev) THEN - CLOSE(UnIn) - RETURN - END IF - CALL Conv2UC(LINE(1:5)) - - SELECT CASE ( TRIM(Line) ) - CASE ('NONE') - P%Wake = .FALSE. - P%Swirl = .FALSE. - - CALL ProgWarn( ' All wake calculations are turned off! This option is recommended only '// & - 'in high winds or for debugging.' ) - CASE ('WAKE') - P%Wake = .TRUE. - P%Swirl = .FALSE. - CASE ('SWIRL') - P%Wake = .TRUE. - P%Swirl = .TRUE. - CASE DEFAULT - CALL ProgWarn( ' Error: Expecting "NONE", "WAKE", or "SWIRL" wake model option.') - ErrStat = ErrID_Fatal - CLOSE(UnIn) - RETURN - END SELECT - - ! Read in the tolerance for the wake model - CALL ReadVar( UnIn, InitInp%ADFileName, P%Inducedvel%AToler, VarName='AToler', VarDescr='Induction factor tolerance', ErrStat=ErrStat, ErrMsg=ErrMess) - IF (ErrStat >= AbortErrLev) THEN - CLOSE(UnIn) - RETURN - END IF - - ! Read in the tip-loss model for EQUIL inflow - CALL ReadVar( UnIn, InitInp%ADFileName, LINE, VarName='TLoss', VarDescr='Tip-loss model', ErrStat=ErrStat, ErrMsg=ErrMess) - IF (ErrStat >= AbortErrLev) THEN - CLOSE(UnIn) - RETURN - END IF - - IF ( P%DynInfl ) THEN ! Initialize these variables, though they shouldn't be used - P%Inducedvel%TLoss = .FALSE. - P%Inducedvel%GTech = .FALSE. - ELSE - CALL Conv2UC(LINE(1:5)) - - SELECT CASE ( LINE(1:5) ) - CASE ('NONE ') - P%Inducedvel%TLoss = .FALSE. - P%Inducedvel%GTech = .FALSE. - CASE ('PRAND') - P%Inducedvel%TLoss = .TRUE. - P%Inducedvel%GTech = .FALSE. - CASE ('GTECH') - P%Inducedvel%TLoss = .TRUE. - P%Inducedvel%GTech = .TRUE. - CASE DEFAULT - CALL ProgWarn( ' Error: Expecting "NONE", "PRAND", or "GTECH" tip-loss model option.') - ErrStat = ErrID_Fatal - CLOSE(UnIn) - RETURN - END SELECT - END IF - - - ! Read in the hub-loss model for EQUIL inflow - CALL ReadVar( UnIn, InitInp%ADFileName, LINE, VarName='HLoss', VarDescr='Hub-loss model', ErrStat=ErrStat, ErrMsg=ErrMess) - IF (ErrStat >= AbortErrLev) RETURN - - IF ( P%DynInfl ) THEN ! Initialize these variables, though they shouldn't be used - P%Inducedvel%HLoss = .FALSE. - ELSE - CALL Conv2UC( LINE(1:5) ) - - SELECT CASE ( LINE(1:5) ) - CASE ('NONE') - P%Inducedvel%HLoss = .FALSE. - CASE ('PRAND') - P%Inducedvel%HLoss = .TRUE. - CASE DEFAULT - CALL ProgWarn( ' Error: Expecting "NONE" or "PRAND" hub-loss model option.') - ErrStat = ErrID_Fatal - CLOSE(UnIn) - RETURN - END SELECT - END IF - - p%Rotor%HH = InitInp%HubHt - -!bjj: this is a hack job to allow both the new tower influence and the old tower wake models to be used -! CALL ReadStr( UnIn, InitInp%ADFileName, LINE, VarName='NewTowerModel?', VarDescr='Check for tower influence model', ErrStat=ErrStat ) - CALL ReadVar( UnIn, InitInp%ADFileName, LINE, VarName='NewTowerModel?', VarDescr='Check for tower influence model', ErrStat=ErrStat, ErrMsg=ErrMess ) - IF (ErrStat >= AbortErrLev) THEN - CLOSE(UnIn) - RETURN - END IF - - ! Check if this is the "special string" to indicate the new tower influence model - CALL Conv2UC( Line ) - IF ( INDEX(Line, "NEWTOWER" ) > 0 ) THEN - - !---------------------------------------------------------------------------------------------- - ! New tower influence model, as implemented by PJM - !---------------------------------------------------------------------------------------------- - P%TwrProps%PJM_Version = .TRUE. - - ! Read in the tower potential flow switch - CALL ReadVar( UnIn, InitInp%ADFileName, P%TwrProps%TwrPotent, VarName='TwrPotent', VarDescr='Tower influence model', ErrStat=ErrStat, ErrMsg=ErrMess) - IF (ErrStat >= AbortErrLev) THEN - CLOSE(UnIn) - RETURN - END IF - - ! Read in the tower shadow switch - CALL ReadVar( UnIn, InitInp%ADFileName, P%TwrProps%TwrShadow, VarName='TwrShadow', VarDescr='Tower shadow model', ErrStat=ErrStat, ErrMsg=ErrMess) - IF (ErrStat >= AbortErrLev) THEN - CLOSE(UnIn) - RETURN - END IF - - ! Read in the tower drag file name - CALL ReadVar( UnIn, InitInp%ADFileName, P%TwrProps%TwrFile, VarName='TwrFile', VarDescr='Tower data file name', ErrStat=ErrStat, ErrMsg=ErrMess) - IF (ErrStat >= AbortErrLev) THEN - CLOSE(UnIn) - RETURN - END IF - - IF ( PathIsRelative( P%TwrProps%TwrFile ) ) P%TwrProps%TwrFile = TRIM(FilePath)//TRIM(P%TwrProps%TwrFile) - - ! Read in the flag to tell AeroDyn to compute tower aerodynamics. - CALL ReadVar( UnIn, InitInp%ADFileName, P%TwrProps%CalcTwrAero, VarName='CalcTwrAero', VarDescr='Flag to calculate tower aerodynamics', ErrStat=ErrStat, ErrMsg=ErrMess) - IF (ErrStat >= AbortErrLev) THEN - CLOSE(UnIn) - RETURN - END IF - - ELSE - !---------------------------------------------------------------------------------------------- - ! Old tower influence model, read TwrShad from Line for now - !---------------------------------------------------------------------------------------------- - P%TwrProps%PJM_Version = .FALSE. - - P%TwrProps%TwrPotent = .FALSE. ! We don't want to read the tower file! - P%TwrProps%TwrShadow = .FALSE. ! We don't want to read the tower file! - P%TwrProps%CalcTwrAero = .FALSE. ! We don't want to read the tower file! - - ! Read in the tower shadow deficit - IF ( INDEX( 'FTft', Line(:1) ) > 0 ) THEN - CALL ProgWarn( ' Invalid numeric input. "'//TRIM( Line )//'" found when trying to read TwrShad.' ) - close(unin) - ErrStat = ErrID_Fatal - RETURN - ELSE - READ (Line,*,IOSTAT=ErrStat) P%TwrProps%TwrShad - CALL CheckIOS ( ErrStat, InitInp%ADFileName, 'TwrShad', NumType, ErrStat, ErrMess ) -!bjj: is this aborting? - IF ( p%Echo ) THEN - WRITE (p%UnEc,"( 2X, ES11.4e2, 2X, A, T30, ' - ', A )") P%TwrProps%TwrShad, "TwrShad", 'Tower shadow deficit' - END IF - - END IF -!---------------- - - IF ( P%TwrProps%TwrShad >= 1.0 ) THEN - CALL ProgWarn( ' Tower shadow deficit cannot be >= 1. Setting default deficit = 0.3' ) - P%TwrProps%TwrShad = 0.3 - END IF - - - ! Read in the tower shadow width - CALL ReadVar( UnIn, InitInp%ADFileName, P%TwrProps%ShadHWid, VarName='ShadHWid', VarDescr='Tower shadow half width', ErrStat=ErrStat, ErrMsg=ErrMess) - IF ( ErrStat /= ErrID_None ) RETURN - - IF ( P%TwrProps%ShadHWid <= 0.0 ) THEN - CALL ProgWarn( ' Tower shadow width cannot be <= zero. Setting default half width = 1.0' ) - P%TwrProps%ShadHWid = 1.0 - END IF - - - ! Read in the tower shadow reference point (distance from yaw axis to hub) - CALL ReadVar( UnIn, InitInp%ADFileName, P%TwrProps%T_Shad_Refpt, VarName='T_Shad_Refpt', VarDescr='Tower shadow reference point', ErrStat=ErrStat, ErrMsg=ErrMess) - IF (ErrStat >= AbortErrLev) THEN - CLOSE(UnIn) - RETURN - END IF - - ! Constants used in tower shadow calculations - P%TwrProps%TShadC1 = P%TwrProps%ShadHWid / SQRT ( ABS( P%TwrProps%T_Shad_Refpt ) ) - P%TwrProps%TShadC2 = P%TwrProps%TwrShad * SQRT ( ABS( P%TwrProps%T_Shad_Refpt ) ) - - END IF - - ! Read in the air density - CALL ReadVar( UnIn, InitInp%ADFileName, P%Wind%Rho, VarName='Rho', VarDescr='Air density', ErrStat=ErrStat, ErrMsg=ErrMess) - IF (ErrStat >= AbortErrLev) THEN - CLOSE(UnIn) - RETURN - END IF - - !bjj do we need to check the the air density is non-negative? - - IF ( P%Wind%Rho == 0.0 .AND. P%DynInfl ) THEN ! Turn off the GDW if RHO = 0. It will crash - CALL ProgWarn( 'Air density is zero. Dynamic Inflow will be turned off to avoid program crash.' ) - P%DynInfl = .FALSE. - ENDIF - - ! Read in the kinematic viscosity - CALL ReadVar( UnIn, InitInp%ADFileName, P%Wind%KinVisc, 'KinVisc', 'Kinematic viscosity', ErrStat, ErrMsg=ErrMess) - IF (ErrStat >= AbortErrLev) THEN - CLOSE(UnIn) - RETURN - END IF - - ! Aero calculation time interval - CALL ReadVar( UnIn, InitInp%ADFileName, Line, 'DtAero', 'Aero calculation time step', ErrStat, ErrMsg=ErrMess) - IF (ErrStat >= AbortErrLev) THEN - CLOSE(UnIn) - RETURN - END IF - CALL Conv2UC( Line ) - IF ( INDEX(Line, "DEFAULT" ) /= 1 ) THEN ! If it's not "default", read this variable; otherwise use the value already stored in P%DtAero - READ( Line, *, IOSTAT=ErrStatLcl) P%DtAero - IF ( ErrStatLcl /= 0 ) THEN - CALL CheckIOS ( ErrStatLcl, InitInp%ADFileName, "DT", NumType, ErrStat, ErrMess ) - RETURN - ELSE - ErrStat = ErrID_None - END IF - END IF - - - ! Read the number of airfoil files - CALL ReadVar( UnIn, InitInp%ADFileName, P%AirFoil%NumFoil, 'NumFoil', 'Number of airfoil files', ErrStat, ErrMsg=ErrMess) - IF (ErrStat >= AbortErrLev) THEN - CLOSE(UnIn) - RETURN - END IF - - IF ( P%AirFoil%NumFoil < 1 ) THEN - CALL ProgWarn( ' Error: Number of airfoil files must be a positive integer.') - ErrStat = ErrID_Fatal - close(unin) - RETURN - END IF - - !.............................................................................................. - ! Allocate space for the airfoil data file name(s), then read them - !.............................................................................................. - IF (.NOT. ALLOCATED(P%AirFoil%FoilNm)) THEN - ALLOCATE ( P%AirFoil%FoilNm( P%AirFoil%NumFoil ) , STAT=ErrStat ) - IF ( ErrStat /= ErrID_None ) THEN - CALL ProgWarn(' Error allocating space for the FoilNm array.') - close(unin) - RETURN - END IF - END IF - - CALL ReadAryLines( UnIn, InitInp%ADFileName, P%AirFoil%FoilNm, P%AirFoil%NumFoil, AryName='FoilNm', AryDescr='Airfoil file names', ErrStat=ErrStat, ErrMsg=ErrMess ) - IF (ErrStat >= AbortErrLev) THEN - CLOSE(UnIn) - RETURN - END IF - - DO K=1,P%AirFoil%NumFoil - IF ( PathIsRelative( P%AirFoil%FoilNm(K) ) ) P%AirFoil%FoilNm(K) = TRIM(FilePath)//TRIM( P%AirFoil%FoilNm(K) ) - END DO - - - ! Read in the number of blade elements - CALL ReadVar( UnIn, InitInp%ADFileName, P%Element%NElm, VarName='NElm', VarDescr='Number of blade elements', ErrStat=ErrStat, ErrMsg=ErrMess) - IF (ErrStat >= AbortErrLev) THEN - CLOSE(UnIn) - RETURN - END IF - - - !.............................................................................................. - ! Allocate space for blade element data and read the arrays - ! Read blade element data, check some inputs, convert twist to radians - !.............................................................................................. - CALL AllocArrays (InitInp, P, x, xd, z, m, y, 'Element') - - m%ElOut%NumElOut = 0 ! Initialize the element print array index - m%ElOut%NumWndElOut = 0 - - CALL ReadCom( UnIn, InitInp%ADFileName, 'Element table headers', ErrStat, ErrMess) - IF (ErrStat >= AbortErrLev) THEN - CLOSE(UnIn) - RETURN - END IF - - DO IElm = 1, p%Element%NElm - - READ(UnIn,'(A)',IOSTAT=ErrStat) Line !read into a line to see if print/no print is enabled - - IF (ErrStat == 0) THEN - READ(Line,*,IOSTAT=ErrStat) P%Element%RElm(IElm), P%Element%Twist(IElm), P%Blade%DR(IElm), P%Blade%C(IElm), P%AirFoil%NFoil(IElm) - END IF - - IF ( ErrStat == 0 ) THEN - - !''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' - ! Check if AeroDyn will print out the element and/or wind data - !''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' - - CALL Conv2UC(LINE) - - m%ElOut%ElPrList(IElm) = 0 ! INITIALIZE - IndPrint = INDEX(LINE,"PRINT") - IF (IndPrint > 0) THEN - IF (LINE(IndPrint-2:IndPrint+4) /= "NOPRINT") THEN - m%ElOut%NumElOut = m%ElOut%NumElOut + 1 - m%ElOut%ElPrList(IElm) = m%ElOut%NumElOut - END IF - ENDIF - - - m%ElOut%WndElPrList(IElm) = 0 ! INITIALIZE - IndPrint = INDEX(LINE,"WIND") - IF (IndPrint > 0) THEN - IF (LINE(IndPrint-2:IndPrint-1) /= "NO") THEN - m%ElOut%NumWndElOut = m%ElOut%NumWndElOut + 1 - m%ElOut%WndElPrList(IElm) = m%ElOut%NumWndElOut - END IF - ENDIF - - !''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' - ! Echo data to the file NWTC_Library echo file, if requested - !''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' - - IF ( p%Echo ) THEN ! NWTC_Library echo file - WRITE (p%UnEc,'(4(2X,ES11.4e2),2X,I11,1(2X,L11))') P%Element%RElm(IElm), P%Element%Twist(IElm), P%Blade%DR(IElm), P%Blade%C(IElm), P%AirFoil%NFoil(IElm), & - m%ElOut%ElPrList(IElm) /= 0 !, m%ElOut%WndElPrList(IElm) == 0 - END IF - - ELSE IF ( ErrStat < 0 ) THEN - - CALL ProgWarn( ' Premature end of file while reading line '//TRIM(Int2Lstr(IElm))// & - ' of the AeroDyn element table in file "'//TRIM(InitInp%ADFileName)//'."' ) - close(unin) - ErrStat = ErrID_Fatal - ErrMess = 'Error reading from line '//TRIM(Int2Lstr(IElm))//' of the AeroDyn element table.' - RETURN - ELSE - close(unin) - ErrStat = ErrID_Fatal - ErrMess = 'Error reading from line '//TRIM(Int2Lstr(IElm))// & - ' of the AeroDyn element table in file "'//TRIM(InitInp%ADFileName)//'."' - RETURN - END IF - - - ! Check for valid data: - - IF( P%Blade%C(IElm) <= 0.0 ) THEN - CALL ProgWarn(' Error reading from line '//TRIM(Int2Lstr(IElm))//' of the AeroDyn element table.'// & - ' Chord length must be larger than 0.' ) - ErrStat = ErrID_Fatal - close(unin) - RETURN - ENDIF - - IF (p%AirFoil%NFoil(IElm) < 1 .OR. p%AirFoil%NFoil(IElm) > p%AirFoil%NumFoil) THEN - CALL ProgWarn(' Error reading from line '//TRIM(Int2Lstr(IElm))//' of the AeroDyn element table.'// & - ' Airfoil file ID must be a number between 1 and '//TRIM(Int2Lstr(p%AirFoil%NumFoil))//'.' ) - ErrStat = ErrID_Fatal - close(unin) - RETURN - END IF - - ! Convert Twist to radians: - - P%Element%Twist(IElm) = P%Element%Twist(IElm)*D2R - - ENDDO ! IELM - - - !.............................................................................................. - ! Read multiple airfoil table option - !.............................................................................................. - - PremEOF_indicator = .FALSE. - READ(UnIn,*,IOSTAT=ErrStatLcl) Line !read MultiTab -- it may not exist - IF (ErrStatLcl > 0 ) THEN - CALL WrScr1 ( ' Invalid character input for file "'//TRIM( InitInp%ADFileName )//'".' ) - CALL ProgWarn ( ' The error occurred while trying to read "MultiTab".' ) - ErrStat=ErrID_Fatal - close(unin) - RETURN - ELSE IF (ErrStatLcl == 0) THEN - IF ( p%Echo ) THEN - WRITE (p%UnEc, "( 15X, A, T30, ' - ', A, /, 2X, A )" ) & - 'MultiTab', 'Multiple airfoil table option', '"'//TRIM( Line )//'"' - END IF - ELSE - p%MultiTab = .FALSE. - p%Reynolds = .FALSE. - PremEOF_indicator = .TRUE. - ! CALL PremEOF ( TRIM( Fil ), Variable, TrapThisError ) - END IF - - !------------------------------------------------------------------------------------------------- - ! Close AeroDyn input file - !------------------------------------------------------------------------------------------------- - CLOSE(UnIn) - - !------------------------------------------------------------------------------------------------- - ! Read airfoil data and check for MultiTab values using LINE, which was read above - !------------------------------------------------------------------------------------------------- - CALL READFL(InitInp, P, x, xd, z, m, y, ErrStatLcl, ErrMessLcl) - CALL SetErrStat(ErrStatLcl, ErrMessLcl, ErrStat, ErrMess,'AD_GetInput') - IF ( ErrStat >= AbortErrLev ) THEN - close(unin) - RETURN - END IF - - m%AirFoil%MulTabLoc = 0.0 ! Initialize this value - - - ! Read in the type of airfoil data table in each file - IF ( PremEOF_indicator ) THEN ! If we hit the end of the file without MultiTab, use only 1 airfoil table - IF ( ANY( p%AirFoil%NTables(1:p%AirFoil%NumFoil) > 1 ) ) THEN - CALL ProgWarn( ' Error reading multiple airfoil table option. Only one table for each file will be used.' ) - END IF - p%MultiTab = .FALSE. - p%Reynolds = .FALSE. - ELSE ! not PremEOF_indicator - - IF ( ANY( p%AirFoil%NTables(1:p%AirFoil%NumFoil) > 1 ) ) THEN - CALL Conv2UC(LINE(1:6)) - - SELECT CASE ( TRIM(Line) ) - CASE ( 'USER' ) - p%MultiTab = .TRUE. - p%Reynolds = .FALSE. - - DO K = 1, p%AirFoil%NumFoil - IF ( p%AirFoil%NTables(K) > 1 ) THEN - IF ( ( m%AirFoil%MulTabLoc < p%AirFoil%MulTabMet(K,1) ) .OR. & - ( m%AirFoil%MulTabLoc > p%AirFoil%MulTabMet(K,p%AirFoil%NTables(K) ) ))THEN - CALL ProgWarn( 'Error interpolating between airfoil tables. '// & - ' Initial interpolation value = '//TRIM(Num2LStr(m%AirFoil%MulTabLoc))// & - ' is outside table range of '//TRIM(Num2LStr(p%AirFoil%MulTabMet(K,1)))// & - ' to '//TRIM(Num2LStr(p%AirFoil%MulTabMet(K,p%AirFoil%NTables(K))))// & - ' in airfoil file #'//TRIM(Int2LStr(K))//'.' ) - ErrStat = ErrID_Fatal - RETURN - END IF - END IF ! NTables(K) > 1 - ENDDO ! K - - CASE ( 'RENUM' ) - p%MultiTab = .TRUE. - p%Reynolds = .TRUE. - CASE ( 'SINGLE' ) - p%MultiTab = .FALSE. - p%Reynolds = .FALSE. - CASE DEFAULT - CALL WrScr( ' Error: control model option must be "USER", "RENUM" or "SINGLE".' ) - END SELECT - ELSE - p%MultiTab = .FALSE. - p%Reynolds = .FALSE. - END IF - - ENDIF - - !------------------------------------------------------------------------------------------------- - ! Read tower drag input file, if necessary - !------------------------------------------------------------------------------------------------- - IF (p%TwrProps%TwrPotent .OR. p%TwrProps%TwrShadow .OR. p%TwrProps%CalcTwrAero) THEN ! Read in the tower drag file - CALL READTwr(UnIn, InitInp, P, x, xd, z, m, y, ErrStat, ErrMess ) - IF (ErrStat /= ErrID_None) RETURN - END IF - - !------------------------------------------------------------------------------------------------- - ! Initialize variables for printing - !------------------------------------------------------------------------------------------------- - IF ( m%ElOut%NumElOut > 0 .OR. m%ElOut%NumWndElOut > 0 ) THEN - p%ElemPrn = .TRUE. - CALL AllocArrays (InitInp, P, x, xd, z, m, y, 'ElPrint') - - ElIndex = 0 ! Re-Initialize the element print array index for wind - DO IElm = 1, p%Element%NElm - IF (m%ElOut%WndElPrList(IElm) > 0) THEN - ElIndex = ElIndex + 1 - m%ElOut%WndElPrNum(ElIndex) = IElm - END IF - END DO ! IELM - - ElIndex = 0 ! Re-Initialize the element print array index - DO IElm = 1, p%Element%NElm - IF (m%ElOut%ElPrList(IElm) > 0) THEN - ElIndex = ElIndex + 1 - m%ElOut%ElPrNum(ElIndex) = IElm - END IF - END DO ! IELM - ELSE - p%ElemPrn = .FALSE. - END IF - - !------------------------------------------------------------------------------------------------- - ! Initialize Beddoes dynamic stall data - !------------------------------------------------------------------------------------------------- - IF ( p%DStall ) CALL BEDDAT( P, x, xd, z, m, y, ErrStat, ErrMess ) - - - RETURN - -contains - SUBROUTINE CleanUp() - - CLOSE(UnIn) - - END SUBROUTINE CleanUp - -END SUBROUTINE AD14_GetInput -!==================================================================================================== - SUBROUTINE ADOut(InitInp, P, m, AD14_Ver, FileName, ErrStat, ErrMess ) - ! used to output data to a summary file - ! ***************************************************** - IMPLICIT NONE - ! Passed Variables: - TYPE(AD14_InitInputType), INTENT(IN ) :: InitInp - TYPE(AD14_ParameterType), INTENT(IN ) :: p ! Parameters - TYPE(AD14_MiscVarType), INTENT(IN ) :: m ! Misc/optimization variables - TYPE(ProgDesc), INTENT(IN ) :: AD14_ver - INTEGER, INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMess - CHARACTER(*), INTENT(IN ) :: FileName - - - - ! Local Variables: - - INTEGER :: IElm - INTEGER :: IFoil - INTEGER :: UnOut - INTEGER :: I,K - INTEGER(IntKi) :: ErrStatLcl - - CHARACTER( 2) :: Dst_Unit - CHARACTER(150) :: Frmt - CHARACTER( 4) :: Mass_Unit - CHARACTER( 35) :: MESAGE - CHARACTER( 3) :: Vel_Unit - - CHARACTER(1),PARAMETER :: Delim = ' ' ! bjj: made this a parameter because I don't think tabs work very well in a summary file - CHARACTER(ErrMsgLen) :: ErrMessLcl - - - ErrStat = ErrID_None - ErrMess = "" - - ! Function definition - - CALL GetNewUnit( UnOut, ErrStat, ErrMess ) - CALL OpenFOutFile( UnOut, FileName, ErrStatLcl, ErrMessLcl) - CALL SetErrStat(ErrStatLcl,ErrMessLcl,ErrStat,ErrMess,'ADOut' ) - IF ( ErrStat >= AbortErrLev ) THEN - CLOSE(UnOut) - RETURN - END IF - - - WRITE (UnOut,"(/A)") 'This file was generated by '//TRIM(GetNVD(AD14_Ver))//& - ' on '//CurDate()//' at '//CurTime()//'.' - - -IF (p%SIUNIT) THEN - Dst_Unit = 'm' - Mass_Unit = 'kg' - Vel_Unit = 'mps' -ELSE - Dst_Unit = 'ft' - Mass_Unit = 'slug' - Vel_Unit = 'fps' -ENDIF - - ! Reiterate the input file -WRITE(UnOut,'(/A)') 'Inputs read in from the AeroDyn input file:' -WRITE(UnOut,'(A/)') TRIM(p%TITLE) - -! Ec_Ch11Frmt is a parameter defined for echo output in the NWTC Subroutine Library -MESAGE = 'Units for input and output' -IF ( p%SIUNIT ) THEN - WRITE(UnOut,Ec_Ch11Frmt) 'SI','SysUnits',MESAGE -ELSE - WRITE(UnOut,Ec_Ch11Frmt) 'ENGLISH','SysUnits',MESAGE -ENDIF - -MESAGE = 'Dynamic stall model' -IF ( p%DSTALL ) THEN - WRITE(UnOut,Ec_Ch11Frmt) 'BEDDOES',"StallMod", MESAGE//' [Beddoes]' -ELSE - WRITE(UnOut,Ec_Ch11Frmt) 'STEADY',"StallMod", MESAGE//' [NO Dynamic stall]' -ENDIF - -MESAGE = 'Aerodynamic pitching moment model' -IF ( p%PMOMENT ) THEN - WRITE(UnOut,Ec_Ch11Frmt) 'USE_CM','UseCm',MESAGE//' [Pitching Moments calculated]' -ELSE - WRITE(UnOut,Ec_Ch11Frmt) 'NO_CM','UseCm',MESAGE//' [NO Pitching Moments calculated]' -ENDIF - -MESAGE = 'Inflow model' -IF ( p%DYNINFL ) THEN - WRITE(UnOut,Ec_Ch11Frmt) 'DYNIN','InfModel',MESAGE//' [Dynamic Inflow]' -ELSE - IF ( p%InducedVel%EquilDA .AND. p%InducedVel%EquilDT ) THEN - WRITE(UnOut,Ec_Ch11Frmt) 'EQUILDB','InfModel',MESAGE//' [Equilibrium w/ axial and tangential drag]' - ELSEIF ( p%InducedVel%EquilDA ) THEN - WRITE(UnOut,Ec_Ch11Frmt) 'EQUILDA','InfModel',MESAGE//' [Equilibrium w/ axial drag]' - ELSEIF ( p%InducedVel%EquilDT ) THEN - WRITE(UnOut,Ec_Ch11Frmt) 'EQUILDT','InfModel',MESAGE//' [Equilibrium w/ tangential drag]' - ELSE - WRITE(UnOut,Ec_Ch11Frmt) 'EQUIL','InfModel',MESAGE//' [Equilibrium]' - ENDIF -ENDIF - - -MESAGE = 'Induction factor model' -IF ( p%WAKE ) THEN - IF (p%SWIRL) THEN - WRITE(UnOut,Ec_Ch11Frmt) 'SWIRL','IndModel',MESAGE//' [Normal and Radial flow induction factors calculated]' - ELSE - WRITE(UnOut,Ec_Ch11Frmt) 'WAKE','IndModel',MESAGE//' [Normal flow induction factors calculated]' - ENDIF - WRITE(UnOut,Ec_ReFrmt) p%InducedVel%ATOLER,'AToler','Convergence tolerance for induction factor' -ELSE - WRITE(UnOut,Ec_Ch11Frmt) 'NONE','IndModel',MESAGE//' [NO induction factors calculated]' - WRITE(UnOut,Ec_Ch11Frmt) '[Not Used]','AToler','Convergence tolerance for induction factor' -ENDIF - -MESAGE = 'Tip-loss model' -IF (.NOT. p%DYNINFL) THEN - IF ( p%InducedVel%TLOSS ) THEN - IF (p%InducedVel%GTECH) THEN - WRITE(UnOut,Ec_Ch11Frmt) 'GTECH','TLModel',MESAGE//' [Georgia Tech correction to Prandtl model]' - ELSE - WRITE(UnOut,Ec_Ch11Frmt) 'PRAND','TLModel',MESAGE//' [Prandtl model]' - ENDIF - ELSE - WRITE(UnOut,Ec_Ch11Frmt) 'NONE','TLModel',MESAGE//' [NO tip-loss calculated]' - ENDIF -ELSE - WRITE(UnOut,Ec_Ch11Frmt) '[Not Used]','TLModel',MESAGE -ENDIF - -MESAGE = 'Hub-loss model' -IF (.NOT. p%DYNINFL) THEN - IF ( p%InducedVel%HLOSS ) THEN - WRITE(UnOut,Ec_Ch11Frmt) 'PRAND','HLModel',MESAGE//' [Prandtl model]' - ELSE - WRITE(UnOut,Ec_Ch11Frmt) 'NONE','HLModel',MESAGE//' [NO hub-loss calculated]' - ENDIF -ELSE - WRITE(UnOut,Ec_Ch11Frmt) '[Not Used]','HLModel',MESAGE -ENDIF - - -WRITE(UnOut,Ec_ReFrmt) p%Rotor%HH,'HH','Wind reference (hub) height, '//TRIM(Dst_Unit) - -IF ( p%TwrProps%PJM_Version ) THEN - WRITE(UnOut,Ec_LgFrmt) p%TwrProps%TwrPotent,'TwrPotent','Calculate tower potential flow [T or F]' - WRITE(UnOut,Ec_LgFrmt) p%TwrProps%TwrShadow,'TwrShadow','Calculate tower shadow [T or F]' - IF ( p%TwrProps%TwrPotent .OR. p%TwrProps%TwrShadow ) THEN - WRITE(UnOut,Ec_StrFrmt) 'TwrFile','Tower drag file name',TRIM(P%TwrProps%TwrFile) - ELSE - WRITE(UnOut,Ec_Ch11Frmt) '[none]','TwrFile','No tower drag properties file' - ENDIF -ELSE - WRITE(UnOut,Ec_ReFrmt) p%TwrProps%TwrShad,'TwrShad','Tower shadow centerline velocity deficit' - WRITE(UnOut,Ec_ReFrmt) p%TwrProps%ShadHWid,'ShadHWid','Tower shadow half width, '//TRIM(Dst_Unit) - WRITE(UnOut,Ec_ReFrmt) p%TwrProps%T_Shad_Refpt,'T_Shad_Refpt','Tower shadow reference point, '//TRIM(Dst_Unit) -END IF - - -WRITE(UnOut,Ec_ReFrmt) p%Wind%RHO,'AirDens','Air density, '//TRIM(Mass_Unit)//'/'//TRIM(Dst_Unit)//'^3' -WRITE(UnOut,Ec_ReFrmt) p%Wind%KinVisc,'KinVisc','Kinematic air viscosity, '//TRIM(Dst_Unit)//'^2/sec' -WRITE(UnOut,Ec_ReFrmt) p%DTAERO,'DTAERO','Time interval for aerodynamic calculations, sec' -WRITE(UnOut,Ec_IntFrmt) p%AirFoil%NUMFOIL,'NumFoil','Number of airfoil files used. Files listed below:' - -DO IFoil = 1, p%AirFoil%NUMFOIL - WRITE(UnOut,'(A)') '"'//TRIM(p%AirFoil%FOILNM(IFoil))//'"' -END DO ! IFoil - -WRITE(UnOut,Ec_IntFrmt) p%Element%NELM,'BldNodes','Number of blade elements per blade' - - !------------------------------------------------------------------------------------------------- - ! write out element information - !------------------------------------------------------------------------------------------------- - Frmt = '(3X,A10,8("'//Delim//'",A10))' - - WRITE(UnOut,'( )') - - ! column names - - WRITE(UnOut,Frmt) ' Element ', & - ' RELM ', & - ' Twist ', & - ' DR ', & - ' Chord ', & - ' NFoil ', & - ' Print? ', & - ' Tip-loss ', & - ' Hub-loss ' - - ! column units - - WRITE(UnOut,Frmt) ' (-) ', & - ' (m) ', & - ' (deg) ', & - ' (m) ', & - ' (m) ', & - ' (-) ', & - ' (Yes/No) ', & - ' constant ', & - ' constant ' - - WRITE(UnOut,Frmt) '----------', & - '----------', & - '----------', & - '----------', & - '----------', & - '----------', & - '----------', & - '----------', & - '----------' - - ! column data - Frmt = '(3X, I10, 4("'//Delim//'",F10.5),"'//Delim//'",I10,"'//Delim//'",A10, 2("'//Delim//'",F10.5) )' - - DO IElm = 1, p%Element%NELM - - IF (m%ElOut%ElPrList(IElm) /= 0) THEN - MESAGE = 'Yes' - ELSE - MESAGE = 'No' - ENDIF - - WRITE(UnOut, Frmt) IElm, p%Element%RELM(IElm), p%Element%TWIST(IElm)*R2D, p%Blade%DR(IElm), p%Blade%C(IElm), & - p%AirFoil%NFOIL(IElm), TRIM(Mesage), p%Element%TLCNST(IElm), p%Element%HLCNST(IElm) - END DO - - -IF ( p%MultiTab ) THEN - WRITE(UnOut,'(A)') 'MULTI Multiple airfoil tables used' -ELSE - WRITE(UnOut,'( )') -ENDIF - - WRITE(UnOut,"(/' Rotor radius = ',F7.3,' m')") p%Blade%R - WRITE(UnOut,"( ' Hub radius = ',F7.3,' m')") p%HubRad - WRITE(UnOut,"( ' Number of blades = ',I3 )") p%NumBl - -IF ( p%DSTALL ) THEN - Frmt = '(3X,A, 21(:F8.4,3X) )' - DO K = 1, P%AirFoil%NTables(1) - WRITE(UnOut,'(/A/)') ' BEDDOES DYNAMIC STALL PARAMETERS:' - WRITE(UnOut, Frmt) 'CN SLOPE ', ( m%Beddoes%CNA(I,K), I = 1, P%AirFoil%NUMFOIL ) - WRITE(UnOut, Frmt) 'STALL CN (UPPER) ', ( m%Beddoes%CNS(I,K), I = 1, P%AirFoil%NUMFOIL ) - WRITE(UnOut, Frmt) 'STALL CN (LOWER) ', ( m%Beddoes%CNSL(I,K), I = 1, P%AirFoil%NUMFOIL ) - WRITE(UnOut, Frmt) 'ZERO LIFT AOA ', ( m%Beddoes%AOL(I,K)*R2D, I = 1, P%AirFoil%NUMFOIL ) - WRITE(UnOut, Frmt) 'MIN DRAG AOA ', ( m%Beddoes%AOD(I,K)*R2D, I = 1, P%AirFoil%NUMFOIL ) - WRITE(UnOut, Frmt) 'MIN DRAG COEFF ', ( m%Beddoes%CDO(I,K), I = 1, P%AirFoil%NUMFOIL ) - WRITE(UnOut,'(/)') - ENDDO !K - - WRITE(UnOut,*) ' VORTEX TRANSIT TIME FROM LE TO TE ', P%Beddoes%TVL - WRITE(UnOut,*) ' PRESSURE TIME CONSTANT ', P%Beddoes%TP - WRITE(UnOut,*) ' VORTEX TIME CONSTANT ', P%Beddoes%TV - WRITE(UnOut,*) ' F-PARAMETER TIME CONSTANT ', P%Beddoes%TF -END IF - -IF ( p%ELEMPRN ) WRITE(UnOut,'(/A/)')'Blade element aerodynamic time series data written to file.' - -CLOSE (UnOut ) - -RETURN -END SUBROUTINE ADOut - - ! **************************************************** - SUBROUTINE READFL(InitInp, P, x, xd, z, m, y, ErrStat, ErrMess ) - ! Reads a data file containing airfoil angle of attack, - ! CL and CD, and dynamic stall parameters - ! **************************************************** -!==================================================================================================== - USE AeroGenSubs, ONLY: AllocArrays - IMPLICIT NONE - ! Passed Variables: - TYPE(AD14_InitInputType), INTENT(INOUT) :: InitInp - TYPE(AD14_ParameterType), INTENT(INOUT) :: p ! Parameters - TYPE(AD14_ContinuousStateType), INTENT(INOUT) :: x ! Initial continuous states - TYPE(AD14_DiscreteStateType), INTENT(INOUT) :: xd ! Initial discrete states - TYPE(AD14_ConstraintStateType), INTENT(INOUT) :: z ! Initial guess of the constraint states - TYPE(AD14_MiscVarType), INTENT(INOUT) :: m ! Misc/optimization variables - TYPE(AD14_OutputType), INTENT(INOUT) :: y ! Initial system outputs (outputs are not calculated; - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMess - - ! Local Variables: - -REAL(ReKi), ALLOCATABLE :: CDNegPI(:) -REAL(ReKi), ALLOCATABLE :: CDPosPI(:) -REAL(ReKi), ALLOCATABLE :: CLNegPI(:) -REAL(ReKi), ALLOCATABLE :: CLPosPI(:) -REAL(ReKi), ALLOCATABLE :: CMNegPI(:) -REAL(ReKi), ALLOCATABLE :: CMPosPI(:) - -INTEGER :: IPHI -INTEGER :: I -INTEGER :: K -INTEGER :: Sttus -INTEGER :: NFOILID -INTEGER :: NumLines -INTEGER :: NUNIT -INTEGER :: IOS - -LOGICAL :: ALPosPI -LOGICAL :: ALNegPI - -CHARACTER( 40) :: TITLE (2) -CHARACTER(1024) :: LINE - - INTEGER :: ErrStatLcL ! Error status returned by called routines. - CHARACTER(ErrMsgLen) :: ErrMessLcl ! Error message returned by called routines. - - - - ErrStat = ErrID_None - ErrMess = "" - - CALL GetNewUnit(NUNIT, ErrStat, ErrMess) - p%AirFoil%NumCL = 0 - - ! The first loop checks existence and file length to set NumCL -DO NFOILID = 1, p%AirFoil%NUMFOIL - - ! Open the file for reading # of lines - CALL OpenFInpFile (NUNIT, TRIM(p%AirFoil%FOILNM(NFOILID)), ErrStatLcL, ErrMessLcl) - CALL SetErrStat( ErrStatLcL, ErrMessLcl, ErrStat, ErrMess, 'READFL') - IF (ErrStat >= AbortErrLev) THEN - CLOSE(NUNIT) - RETURN - END IF - - ! Determine the maximum number of aerodata points in all files - - NumLines = 0 - IOS = 0 - DO WHILE (IOS == 0) - READ ( NUNIT, '()', IOSTAT=IOS ) - NumLines = NumLines + 1 - END DO - - p%AirFoil%NumCL = MAX(NumLines - 14, p%AirFoil%NumCL) - - CLOSE (NUNIT) - -END DO ! NFOILID - - ! Allocate the arrays - -CALL AllocArrays (InitInp, P, x, xd, z, m, y, 'Aerodata') - !CALL SetErrStat( ErrStatLcL, ErrMessLcl, ErrStat, ErrMess, 'READFL') - !IF (ErrStat >= AbortErrLev) RETURN - - ! The second loop reads the files -DO NFOILID = 1, p%AirFoil%NUMFOIL - - ! Open the file for reading inputs - CALL OpenFInpFile (NUNIT, TRIM(Adjustl(p%AirFoil%FOILNM(NFOILID))), ErrStatLcL, ErrMessLcl ) - CALL SetErrStat( ErrStatLcL, ErrMessLcl, ErrStat, ErrMess, 'READFL') - IF (ErrStat >= AbortErrLev) THEN - CLOSE(NUNIT) - RETURN - END IF - - ! Set up the file to read the aerodata - READ(NUNIT,'( A )',IOSTAT=IOS) TITLE(1) - READ(NUNIT,'( A )',IOSTAT=IOS) TITLE(2) - - ! Read in airfoil table dimension parameters: - ! NTables = number of airfoil data tables - - READ(NUNIT,'( A )',IOSTAT=IOS) LINE - IF ( IOS < 0 ) THEN - CALL PremEOF ( Trim(p%AirFoil%FOILNM(NFOILID)) , '# of tables', .TRUE., ErrMessLcl ) - close(NUNIT) - CALL SetErrStat( ErrID_Fatal, ErrMessLcl, ErrStat, ErrMess, 'READFL') - END IF - - - READ(LINE,*,ERR=205) p%AirFoil%NTables( NFOILID ) - - ! Allocate local arrays with NTables dimension - - Sttus = 0 - IF (.NOT. ALLOCATED(CLPosPI)) THEN - ALLOCATE ( CLPosPI(P%AirFoil%NTables(NFOILID)) , STAT=Sttus ) - IF ( Sttus /= 0 ) THEN - CALL SetErrStat( ErrID_Fatal, ' Error allocating memory for CLPosPI array.', ErrStat, ErrMess, 'READFL' ) - close(NUNIT) - RETURN - END IF - END IF - - - IF (.NOT. ALLOCATED(CDPosPI)) THEN - ALLOCATE ( CDPosPI(P%AirFoil%NTables(NFOILID)) , STAT=Sttus ) - IF ( Sttus /= 0 ) THEN - CALL SetErrStat( ErrID_Fatal, ' Error allocating memory for CDPosPI array.', ErrStat, ErrMess, 'READFL' ) - close(NUNIT) - RETURN - END IF - END IF - - IF (.NOT. ALLOCATED(CMPosPI)) THEN - ALLOCATE ( CMPosPI(P%AirFoil%NTables(NFOILID)) , STAT=Sttus ) - IF ( Sttus /= 0 ) THEN - CALL SetErrStat( ErrID_Fatal, ' Error allocating memory for CMPosPI array.', ErrStat, ErrMess, 'READFL' ) - close(NUNIT) - RETURN - END IF - END IF - - IF (.NOT. ALLOCATED(CLNegPI)) THEN - ALLOCATE ( CLNegPI(P%AirFoil%NTables(NFOILID)) , STAT=Sttus ) - IF ( Sttus /= 0 ) THEN - CALL SetErrStat( ErrID_Fatal, ' Error allocating memory for CLNegPI array.', ErrStat, ErrMess, 'READFL' ) - close(NUNIT) - RETURN - END IF - END IF - - IF (.NOT. ALLOCATED(CDNegPI)) THEN - ALLOCATE ( CDNegPI(P%AirFoil%NTables(NFOILID)) , STAT=Sttus ) - IF ( Sttus /= 0 ) THEN - CALL SetErrStat( ErrID_Fatal, ' Error allocating memory for CDNegPI array.', ErrStat, ErrMess, 'READFL' ) - close(NUNIT) - RETURN - END IF - END IF - - IF (.NOT. ALLOCATED(CMNegPI)) THEN - ALLOCATE ( CMNegPI(P%AirFoil%NTables(NFOILID)) , STAT=Sttus ) - IF ( Sttus /= 0 ) THEN - CALL SetErrStat( ErrID_Fatal, ' Error allocating memory for CMNegPI array.', ErrStat, ErrMess, 'READFL' ) - close(NUNIT) - RETURN - END IF - END IF - - - ! Read in airfoil data table identification array - - READ(NUNIT,'( A )',IOSTAT=IOS) LINE - IF ( IOS < 0 ) then - CALL PremEOF ( Trim(p%AirFoil%FOILNM(NFOILID)) , 'multi-table metric', .TRUE., ErrMessLcl ) - close(NUNIT) - CALL SetErrStat( ErrID_Fatal, ErrMessLcl, ErrStat, ErrMess, 'READFL') - RETURN - END IF - READ(LINE,*,ERR=205) (p%AirFoil%MulTabMet ( NFOILID, K ), K = 1, p%AirFoil%NTables(NFOILID)) - - ! Read in four lines that are no longer used - ! These are retained for future USE and backwards compatibility only - - READ(NUNIT,'( A )',IOSTAT=IOS) LINE - IF ( IOS < 0 ) then - CALL PremEOF ( Trim(p%AirFoil%FOILNM(NFOILID)) , '5th line', .TRUE., ErrMessLcl ) - close(NUNIT) - CALL SetErrStat( ErrID_Fatal, ErrMessLcl, ErrStat, ErrMess, 'READFL') - RETURN - END IF - READ(NUNIT,'( A )',IOSTAT=IOS) LINE - IF ( IOS < 0 ) then - CALL PremEOF ( Trim(p%AirFoil%FOILNM(NFOILID)) , '6th line', .TRUE., ErrMessLcl ) - close(NUNIT) - CALL SetErrStat( ErrID_Fatal, ErrMessLcl, ErrStat, ErrMess, 'READFL') - RETURN - END IF - READ(NUNIT,'( A )',IOSTAT=IOS) LINE - IF ( IOS < 0 ) then - CALL PremEOF ( Trim(p%AirFoil%FOILNM(NFOILID)) , '7th line', .TRUE., ErrMessLcl ) - close(NUNIT) - CALL SetErrStat( ErrID_Fatal, ErrMessLcl, ErrStat, ErrMess, 'READFL') - RETURN - END IF - READ(NUNIT,'( A )',IOSTAT=IOS) LINE - IF ( IOS < 0 ) then - CALL PremEOF ( Trim(p%AirFoil%FOILNM(NFOILID)) , '8th line', .TRUE., ErrMessLcl ) - close(NUNIT) - CALL SetErrStat( ErrID_Fatal, ErrMessLcl, ErrStat, ErrMess, 'READFL') - RETURN - END IF - - ! Read Beddoes stall parameters - - READ(NUNIT,'( A )',IOSTAT=IOS) LINE - IF ( IOS < 0 ) THEN - CALL PremEOF ( Trim(p%AirFoil%FOILNM(NFOILID)) , 'Angle of zero lift (AOL)', .TRUE., ErrMessLcl ) - close(NUNIT) - CALL SetErrStat( ErrID_Fatal, ErrMessLcl, ErrStat, ErrMess, 'READFL') - RETURN - END IF - IF (p%DSTALL) READ(LINE,*,ERR=205) (m%Beddoes%AOL( NFOILID, K ), K = 1, p%AirFoil%NTables(NFOILID)) - - READ(NUNIT,'( A )',IOSTAT=IOS) LINE - IF ( IOS < 0 ) THEN - CALL PremEOF ( Trim(p%AirFoil%FOILNM(NFOILID)) , 'CNA', .TRUE., ErrMessLcl ) - close(NUNIT) - CALL SetErrStat( ErrID_Fatal, ErrMessLcl, ErrStat, ErrMess, 'READFL') - RETURN - END IF - IF (p%DSTALL) READ(LINE,*,ERR=205) (m%Beddoes%CNA ( NFOILID, K ), K = 1, p%AirFoil%NTables(NFOILID)) - - READ(NUNIT,'( A )',IOSTAT=IOS) LINE - IF ( IOS < 0 ) THEN - CALL PremEOF ( Trim(p%AirFoil%FOILNM(NFOILID)) , 'CNS', .TRUE., ErrMessLcl ) - close(NUNIT) - CALL SetErrStat( ErrID_Fatal, ErrMessLcl, ErrStat, ErrMess, 'READFL') - RETURN - END IF - IF (p%DSTALL) READ(LINE,*,ERR=205) (m%Beddoes%CNS ( NFOILID, K ), K = 1, p%AirFoil%NTables(NFOILID)) - - READ(NUNIT,'( A )',IOSTAT=IOS) LINE - IF ( IOS < 0 ) THEN - CALL PremEOF ( Trim(p%AirFoil%FOILNM(NFOILID)) , 'CNSL', .TRUE., ErrMessLcl ) - close(NUNIT) - CALL SetErrStat( ErrID_Fatal, ErrMessLcl, ErrStat, ErrMess, 'READFL') - RETURN - END IF - IF (p%DSTALL) READ(LINE,*,ERR=205) (m%Beddoes%CNSL ( NFOILID, K ), K = 1, p%AirFoil%NTables(NFOILID)) - - READ(NUNIT,'( A )',IOSTAT=IOS) LINE - IF ( IOS < 0 ) THEN - CALL PremEOF ( Trim(p%AirFoil%FOILNM(NFOILID)) , 'AOD', .TRUE., ErrMessLcl ) - close(NUNIT) - CALL SetErrStat( ErrID_Fatal, ErrMessLcl, ErrStat, ErrMess, 'READFL') - RETURN - END IF - IF (p%DSTALL) READ(LINE,*,ERR=205) (m%Beddoes%AOD ( NFOILID, K ), K = 1, p%AirFoil%NTables(NFOILID)) - - READ(NUNIT,'( A )',IOSTAT=IOS) LINE - IF ( IOS < 0 ) THEN - CALL PremEOF ( Trim(p%AirFoil%FOILNM(NFOILID)) , 'CDO', .TRUE., ErrMessLcl ) - close(NUNIT) - CALL SetErrStat( ErrID_Fatal, ErrMessLcl, ErrStat, ErrMess, 'READFL') - RETURN - END IF - IF (p%DSTALL) READ(LINE,*,ERR=205) (m%Beddoes%CDO ( NFOILID, K ), K = 1, p%AirFoil%NTables(NFOILID)) - - ! Convert angles to radians - IF (p%DSTALL) THEN - m%Beddoes%AOD ( NFOILID, : ) = m%Beddoes%AOD( NFOILID, : )*D2R - m%Beddoes%AOL ( NFOILID, : ) = m%Beddoes%AOL( NFOILID, : )*D2R - ENDIF - - - ! Read airfoil data tables to end of file - - p%AirFoil%NLIFT(NFOILID) = 0 - ALPosPI = .FALSE. - ALNegPI = .FALSE. - - DO I = 1, p%AirFoil%NumCL - - IF ( p%PMOMENT ) THEN - - READ( NUNIT,*,END=150,ERR=150 ) m%AirFoil%AL(NFOILID,I), & - (m%AirFoil%CL(NFOILID,I,IPHI), m%AirFoil%CD(NFOILID,I,IPHI), & - m%AirFoil%CM(NFOILID,I,IPHI), IPHI = 1, p%AirFoil%NTables(NFOILID)) - - ELSE - - READ( NUNIT,*,END=150,ERR=150 ) m%AirFoil%AL(NFOILID,I), & - (m%AirFoil%CL(NFOILID,I,IPHI), m%AirFoil%CD(NFOILID,I,IPHI), & - IPHI = 1, p%AirFoil%NTables(NFOILID)) - - m%AirFoil%CM(NFOILID,I,:) = 0. - - ENDIF - - ! Check to see if values look reasonable - - DO IPHI = 1, p%AirFoil%NTables(NFOILID) - IF ( ABS( m%AirFoil%AL( NFOILID, I ) ) > 185.) THEN - CALL SetErrStat( ErrID_Fatal, 'Probable error in airfoil data table number '//TRIM(Int2LStr(NFOILID))// & - ' Angle of attack exceeds 185 degrees.', ErrStat, ErrMess, 'READFL') - CLOSE(NUNIT) - RETURN - - ELSEIF (ABS( m%AirFoil%CL( NFOILID, I, IPHI ) ) > 3. ) THEN - CALL SetErrStat( ErrID_Fatal, 'Probable error in airfoil data table number '//TRIM(Int2LStr(NFOILID))// & - ' Coefficient of Lift exceeds 3.0.', ErrStat, ErrMess, 'READFL') - CLOSE(NUNIT) - RETURN - ELSEIF (ABS( m%AirFoil%CD( NFOILID, I, IPHI ) ) > 3. ) THEN - CALL SetErrStat( ErrID_Fatal, 'Probable error in airfoil data table number '//TRIM(Int2LStr(NFOILID))// & - ' Coefficient of Drag exceeds 3.0.', ErrStat, ErrMess, 'READFL') - CLOSE(NUNIT) - RETURN - ELSEIF (ABS( m%AirFoil%CM( NFOILID, I, IPHI ) ) > 3. ) THEN - CALL SetErrStat( ErrID_Fatal, 'Probable error in airfoil data table number '//TRIM(Int2LStr(NFOILID))// & - ' Coefficient of Moment exceeds 3.0.', ErrStat, ErrMess, 'READFL') - CLOSE(NUNIT) - RETURN - - - ENDIF - ENDDO ! IPHI - - ! Store the values at 180 deg. and -180 deg. for check - IF ( m%AirFoil%AL (NFOILID, I ) == 180. ) THEN - ALPosPI = .TRUE. - Do IPHI = 1, p%AirFoil%NTables(NFOILID) - CLPosPI(IPHI) = m%AirFoil%CL(NFOILID,I,IPHI) - CDPosPI(IPHI) = m%AirFoil%CD(NFOILID,I,IPHI) - CMPosPI(IPHI) = m%AirFoil%CM(NFOILID,I,IPHI) - END Do ! IPHI - - ELSEIF ( m%AirFoil%AL (NFOILID, I ) == -180. ) THEN - ALNegPI = .TRUE. - Do IPHI = 1, p%AirFoil%NTables(NFOILID) - CLNegPI(IPHI) = m%AirFoil%CL(NFOILID,I,IPHI) - CDNegPI(IPHI) = m%AirFoil%CD(NFOILID,I,IPHI) - CMNegPI(IPHI) = m%AirFoil%CM(NFOILID,I,IPHI) - END Do ! IPHI - ENDIF - - m%AirFoil%AL ( NFOILID, I ) = m%AirFoil%AL(NFOILID,I) * D2R - p%AirFoil%NLIFT ( NFOILID ) = p%AirFoil%NLIFT(NFOILID) + 1 - - ENDDO ! I - - 150 CLOSE( NUNIT ) - - ! Check to see if values at 180 deg. equal those at -180 deg. - IF (ALPosPI .AND. ALNegPI) THEN - Do IPHI = 1, p%AirFoil%NTables(NFOILID) - IF (CLPosPI(IPHI) /= CLNegPI(IPHI) .OR. & - CDPosPI(IPHI) /= CDNegPI(IPHI) .OR. & - CMPosPI(IPHI) /= CMNegPI(IPHI)) THEN - CALL SetErrStat( ErrID_Fatal, ' The airfoil data at +180 deg is different from -180 deg in file :'//Trim(P%AirFoil%FOILNM(NFOILID)), ErrStat, ErrMess, 'READFL') - return - ENDIF - END Do ! IPHI - ENDIF - - ! Deallocate arrays to make them available for the next file - - IF ( ALLOCATED(CLPosPI) ) DEALLOCATE ( CLPosPI ) - IF ( ALLOCATED(CDPosPI) ) DEALLOCATE ( CDPosPI ) - IF ( ALLOCATED(CMPosPI) ) DEALLOCATE ( CMPosPI ) - IF ( ALLOCATED(CLNegPI) ) DEALLOCATE ( CLNegPI ) - IF ( ALLOCATED(CDNegPI) ) DEALLOCATE ( CDNegPI ) - IF ( ALLOCATED(CMNegPI) ) DEALLOCATE ( CMNegPI ) - - -END DO !NUMFOIL -RETURN - -205 CALL SetErrStat( ErrID_Fatal, ' Error reading line: "'//TRIM(Line)//'" in file : "'//TRIM(P%AirFoil%FOILNM(NFOILID))//'"', ErrStat, ErrMess, 'READFL') - CLOSE(NUNIT) - RETURN - -RETURN -END SUBROUTINE READFL - - ! **************************************************** - SUBROUTINE READTwr(UnIn, InitInp, P, x, xd, z, m, y, ErrStat, ErrMess ) -! This subroutine reads the tower properties input file, allocating TwrProps variables to do so. -! The tower data file contains radius and Re vs CD data as well as the tower wake constant. - ! **************************************************** -!==================================================================================================== - IMPLICIT NONE - ! Passed Variables: - INTEGER, INTENT(IN) :: UnIn - TYPE(AD14_InitInputType), INTENT(INOUT) :: InitInp - TYPE(AD14_ParameterType), INTENT(INOUT) :: p ! Parameters - TYPE(AD14_ContinuousStateType), INTENT(INOUT) :: x ! Initial continuous states - TYPE(AD14_DiscreteStateType), INTENT(INOUT) :: xd ! Initial discrete states - TYPE(AD14_ConstraintStateType), INTENT(INOUT) :: z ! Initial guess of the constraint states - TYPE(AD14_MiscVarType), INTENT(INOUT) :: m ! Misc/optimization variables - TYPE(AD14_OutputType), INTENT(INOUT) :: y ! Initial system outputs (outputs are not calculated; - INTEGER, INTENT(OUT) :: ErrStat - CHARACTER(*), INTENT(OUT) :: ErrMess - - ! Local Variables: - - INTEGER :: I ! loop counter for rows in the data tables - INTEGER :: J ! loop counter for columns in the data tables - - CHARACTER(99) :: Fmt ! format for printing to an echo file - CHARACTER(1024) :: FilName ! file name - - !------------------------------------------------------------------------------------------------- - ! Open the file for reading - !------------------------------------------------------------------------------------------------- - FilName = p%TwrProps%TwrFile - CALL OpenFInpFile (UnIn, TRIM(FilName), ErrStat, ErrMess ) - IF ( ErrStat /= ErrID_None ) RETURN - - - !------------------------------------------------------------------------------------------------- - ! Read the heading, section 1 - !------------------------------------------------------------------------------------------------- - - ! Read in 2 header/comment lines - CALL ReadCom( UnIn, FilName, 'Title line 1', ErrStat, ErrMess ) - IF ( ErrStat /= ErrID_None ) RETURN - - CALL ReadCom( UnIn, FilName, 'Title line 2', ErrStat, ErrMess ) - IF ( ErrStat /= ErrID_None ) RETURN - - - ! Read in number of tower height entries, NTwrHt - CALL ReadVar( UnIn, FilName, p%TwrProps%NTwrHt, 'NTwrHt', 'Number of tower stations', ErrStat, ErrMess ) - IF ( ErrStat /= ErrID_None ) RETURN - - IF (p%TwrProps%NTwrHt < 1) THEN - CALL ProgWarn( 'Number of tower height entries, NTwrHt, must be greater than zero.' ) - ErrStat = ErrID_Fatal - RETURN - ENDIF - - ! Read in number of tower Reynolds number entries, NTwrRe - CALL ReadVar( UnIn, FilName, p%TwrProps%NTwrRe, 'NTwrRe', 'Number of tower Reynolds number rows', ErrStat, ErrMess ) - IF ( ErrStat /= ErrID_None ) RETURN - - IF (p%TwrProps%NTwrRe < 1) THEN - CALL ProgWarn( 'Number of tower Reynolds number entries, NTwrRe, must be greater than zero.' ) - ErrStat = ErrID_Fatal - RETURN - ENDIF - - - ! Read in number of tower CD entries, NTwrCD - CALL ReadVar( UnIn, FilName, p%TwrProps%NTwrCD, 'NTwrCD', 'Number of tower CD columns', ErrStat, ErrMess ) - IF ( ErrStat /= ErrID_None ) RETURN - - IF (p%TwrProps%NTwrCD < 1) THEN - CALL ProgWarn( 'Number of tower CD entries, NTwrCD, must be greater than zero.' ) - ErrStat = ErrID_Fatal - RETURN - ENDIF - - - ! Read in constant for tower wake model = 0 full potential flow = 0.1 model of Bak et al. - CALL ReadVar( UnIn, FilName, p%TwrProps%Tower_Wake_Constant, 'Tower_Wake_Constant', 'Constant for tower wake model', ErrStat, ErrMess ) - IF ( ErrStat /= ErrID_None ) RETURN - - ! bjj: should there be a sanity check here, too? - - !------------------------------------------------------------------------------------------------- - ! Allocate TwrProps arrays with NTwrHt, NTwrRe, and NTwrCD dimensions; these arrays are - ! read in the next 2 sections of this file. - !------------------------------------------------------------------------------------------------- - - IF ( .NOT. ALLOCATED( p%TwrProps%TwrHtFr ) ) THEN - ALLOCATE ( p%TwrProps%TwrHtFr(p%TwrProps%NTwrHt) , STAT=ErrStat ) - IF ( ErrStat /= 0 ) THEN - CALL ProgWarn( ' Error allocating memory for TwrHtFr array.' ) - ErrStat = ErrID_Fatal - RETURN - END IF - END IF - - IF ( .NOT. ALLOCATED( p%TwrProps%TwrWid ) ) THEN - ALLOCATE ( p%TwrProps%TwrWid(p%TwrProps%NTwrHt) , STAT=ErrStat ) - IF ( ErrStat /= 0 ) THEN - CALL ProgWarn( ' Error allocating memory for TwrWid array.' ) - ErrStat = ErrID_Fatal - RETURN - END IF - END IF - - IF ( .NOT. ALLOCATED( p%TwrProps%NTwrCDCol ) ) THEN - ALLOCATE ( p%TwrProps%NTwrCDCol(p%TwrProps%NTwrHt) , STAT=ErrStat ) - IF ( ErrStat /= 0 ) THEN - CALL ProgWarn( ' Error allocating memory for NTwrCDCol array.' ) - ErrStat = ErrID_Fatal - RETURN - END IF - END IF - - IF ( .NOT. ALLOCATED( p%TwrProps%TwrRe ) ) THEN - ALLOCATE ( p%TwrProps%TwrRe(p%TwrProps%NTwrRe) , STAT=ErrStat ) - IF ( ErrStat /= 0 ) THEN - CALL ProgWarn( ' Error allocating memory for TwrRe array.' ) - ErrStat = ErrID_Fatal - RETURN - END IF - END IF - - IF ( .NOT. ALLOCATED( p%TwrProps%TwrCD ) ) THEN - ALLOCATE ( p%TwrProps%TwrCD(p%TwrProps%NTwrRe, p%TwrProps%NTwrCD) , STAT=ErrStat ) - IF ( ErrStat /= 0 ) THEN - CALL ProgWarn( ' Error allocating memory for TwrCD array.' ) - ErrStat = ErrID_Fatal - RETURN - END IF - END IF - - !------------------------------------------------------------------------------------------------- - ! Read section 2, DISTRIBUTED TOWER PROPERTIES; - ! section contains 2 heading lines in addition to NTwrHt rows of data with 3 columns - !------------------------------------------------------------------------------------------------- - ! Read in 2 header/comment lines - CALL ReadCom( UnIn, FilName, 'Distributed Tower Properties header 1', ErrStat, ErrMess ) - IF ( ErrStat /= ErrID_None ) RETURN - - CALL ReadCom( UnIn, FilName, 'Distributed Tower Properties header 2', ErrStat, ErrMess ) - IF ( ErrStat /= ErrID_None ) RETURN - - - ! Read tower height data table - - DO I = 1, p%TwrProps%NTwrHt ! 1 line per fraction of height - - - READ( UnIn,*,IOSTAT=ErrStat ) p%TwrProps%TwrHtFr(I), p%TwrProps%TwrWid(I), p%TwrProps%NTwrCDCol(I) - - IF ( ErrStat == 0 ) THEN - IF ( p%Echo ) THEN - WRITE (p%UnEc,'(2X,ES11.4e2, 2X,ES11.4e2, 2X,I11)') p%TwrProps%TwrHtFr(I), p%TwrProps%TwrWid(I), p%TwrProps%NTwrCDCol(I) - END IF - ELSE IF ( ErrStat < 0 ) THEN - CALL ProgWarn( ' Premature end of file while reading line '//TRIM(Int2Lstr(I))// & - ' of the distributed tower properties in file "'//TRIM(FilName)//'."' ) - RETURN - ELSE - CALL ProgWarn( ' Error reading line '//TRIM(Int2Lstr(I))// & - ' of the distributed tower properties in file "'//TRIM(FilName)//'."' ) - RETURN - END IF - - - !.............................................................................................. - ! Check to see if values look reasonable - !.............................................................................................. - - ! Make sure tower height fractions are between 0 and 1 - IF ( p%TwrProps%TwrHtFr( I ) < 0.0 .OR. p%TwrProps%TwrHtFr( I ) > 1.0 ) THEN - CALL ProgWarn( ' Error on line '//TRIM(Int2Lstr(I))//' of the distributed tower properties in file "' & - //TRIM(FilName)//'." Tower height fractions must be between 0.0 and 1.0.' ) - ErrStat = ErrID_Fatal - RETURN - END IF - - - ! Make sure the tower height increases for each entry - IF (I > 1) THEN - IF (p%TwrProps%TwrHtFr(I) <= p%TwrProps%TwrHtFr(I-1)) THEN - CALL ProgWarn( ' Error on line '//TRIM(Int2Lstr(I))//' of the distributed tower properties in file "' & - //TRIM(FilName)//'." Tower height fraction entries must be in order of increasing height.' ) - ErrStat = ErrID_Fatal - RETURN - ENDIF - ENDIF - - ! Make sure tower width is positive - IF ( p%TwrProps%TwrWid( I ) <= 0.0 ) THEN - CALL ProgWarn( ' Error on line '//TRIM(Int2Lstr(I))//' of the distributed tower properties in file "' & - //TRIM(FilName)//'." Tower width must be positive.' ) - ErrStat = ErrID_Fatal - RETURN - ENDIF - - ! Make sure the tower CD column is within range - IF ( p%TwrProps%NTwrCDCol(I) < 1 .OR. p%TwrProps%NTwrCDCol(I) > P%TwrProps%NTwrCD ) THEN - CALL ProgWarn( ' Error on line '//TRIM(Int2Lstr(I))//' of the distributed tower properties in file "' & - //TRIM(FilName)//'." Tower height CD column must be between 1 and '//TRIM(Int2Lstr(P%TwrProps%NTwrCD))//'.' ) - ErrStat = ErrID_Fatal - RETURN - END IF - - END DO ! I - - !------------------------------------------------------------------------------------------------- - ! Read section 3, Re vs CD PROPERTIES; - ! this section has 2 header lines plus NTwrRe rows of data with NTwrCD+1 columns - !------------------------------------------------------------------------------------------------- - - ! Read in 2 header/comment lines - CALL ReadCom( UnIn, FilName, 'Re vs CD Properties header 1', ErrStat, ErrMess ) - IF ( ErrStat /= ErrID_None ) RETURN - - CALL ReadCom( UnIn, FilName, 'Re vs CD Properties header 2', ErrStat, ErrMess ) - IF ( ErrStat /= ErrID_None ) RETURN - - Fmt = '('//TRIM(Int2Lstr(p%TwrProps%NTwrCD+1))//'(2X,ES11.4e2))' - - DO I = 1, p%TwrProps%NTwrRe - - READ( UnIn,*,IOSTAT=ErrStat ) p%TwrProps%TwrRe(I), (p%TwrProps%TwrCD(I,J), J = 1, p%TwrProps%NTwrCD) - - IF ( ErrStat == 0 ) THEN - IF ( p%Echo ) THEN - WRITE (p%UnEc,Fmt) p%TwrProps%TwrRe(I), (p%TwrProps%TwrCD(I,J), J = 1, p%TwrProps%NTwrCD) - END IF - ELSE IF ( ErrStat < 0 ) THEN - CALL ProgWarn( ' Premature end of file while reading line '//TRIM(Int2Lstr(I))// & - ' of the tower Re vs CD properties in file "'//TRIM(FilName)//'."' ) - RETURN - ELSE - CALL ProgWarn( ' Error reading line '//TRIM(Int2Lstr(I))// & - ' of the tower Re vs CD properties in file "'//TRIM(FilName)//'."' ) - RETURN - END IF - - END DO ! I - - !------------------------------------------------------------------------------------------------- - ! close the file and return - !------------------------------------------------------------------------------------------------- - - CLOSE( UnIn ) - - RETURN - -END SUBROUTINE READTwr - -!==================================================================================================== -!> Calculates the axial and tangential induction factor for each annular segment -! and time step (i.e. sets m%Element%A and m%Element%AP) - SUBROUTINE ELEM_INDUCTIONS( p, m, ErrStat, ErrMess, & - PSI, RLOCAL, J, IBlade, VNROTOR2, VT, VNW, & - VNB, Initial) - - IMPLICIT NONE - ! Passed Variables: - TYPE(AD14_ParameterType), INTENT(IN) :: p ! Parameters - TYPE(AD14_MiscVarType), INTENT(INOUT) :: m ! Misc/optimization variables - INTEGER, INTENT(OUT) :: ErrStat - CHARACTER(*), INTENT(OUT) :: ErrMess - - REAL(ReKi),INTENT(IN) :: PSI - REAL(ReKi),INTENT(IN) :: RLOCAL - REAL(ReKi), INTENT(IN ) :: VNB ! Normal (relative) velocity of the element - REAL(ReKi),INTENT(IN) :: VNROTOR2 - REAL(ReKi),INTENT(IN) :: VNW - REAL(ReKi), INTENT(IN ) :: VT - INTEGER, INTENT(IN) :: J - INTEGER, INTENT(IN) :: IBlade - LOGICAL, INTENT(IN) :: Initial - - INTEGER :: ErrStatLcL ! Error status returned by called routines. - CHARACTER(ErrMsgLen) :: ErrMessLcl ! Error message returned by called routines. - - ErrStat = ErrID_None - ErrMess = "" - - !-mlb Check for being at the center of rotation. - ! If we are at the center of rotation, the induction equations - ! are undefined, so let's just USE zeros. - -! initialize AxInd and TanInd variables - m%Element%A (J,IBLADE) = 0.0 - m%Element%AP(J,IBLADE) = 0.0 - -IF ( RLOCAL < 0.01 ) THEN - ! Already set to 0 -ELSEIF( P%DYNINFL .AND. P%Blade%R * m%Rotor%REVS < 2.0 ) THEN !ACH 3/10/03 This block deals with dyn. inflow problems at low tip speed - ! Already set to 0 - m%DYNINIT = .TRUE. !Re-initialize if we begin using dynamic inflow again -ELSE - - ! Turn wake off when using dynamic inflow and tip speed goes low. Wake will remain off. - ! Get induction factor = A using static airfoil coefficients - IF ( P%WAKE .AND. .NOT. Initial) THEN - - IF ( P%DYNINFL ) THEN - ! USE dynamic inflow model to find A - CALL VINDINF( P, m, ErrStatLcl, ErrMessLcl, & - J, IBlade, RLOCAL, VNW, VNB, VT, PSI ) !possibly changes A, and AP - CALL SetErrStat ( ErrStatLcl, ErrMessLcl, ErrStat,ErrMess,'ELEM_INDUCTIONS' ) - IF (ErrStat >= AbortErrLev) RETURN - ELSE - ! USE momentum balance to find A - CALL VIND( P, m, ErrStatLcl, ErrMessLcl, & - J, IBlade, RLOCAL, VNROTOR2, VNW, VNB, VT ) !changes A, and AP - CALL SetErrStat ( ErrStatLcl, ErrMessLcl, ErrStat,ErrMess,'ELEM_INDUCTIONS' ) - IF (ErrStat >= AbortErrLev) RETURN - ! Apply skewed-wake correction, if applicable - IF( m%SKEW ) CALL VNMOD( P, m, ErrStatLcl, ErrMessLcl,& - J, IBlade, RLOCAL, PSI ) !changes A - CALL SetErrStat ( ErrStatLcl, ErrMessLcl, ErrStat,ErrMess,'ELEM_INDUCTIONS' ) - IF (ErrStat >= AbortErrLev) RETURN - ENDIF - ENDIF -ENDIF - -END SUBROUTINE ELEM_INDUCTIONS - -SUBROUTINE ELEMFRC2( p, m, ErrStat, ErrMess, J, IBlade, & - DFN, DFT, PMA, Initial, phi ) - - IMPLICIT NONE - ! Passed Variables: - TYPE(AD14_ParameterType), INTENT(IN) :: p ! Parameters - TYPE(AD14_MiscVarType), INTENT(INOUT) :: m ! Misc/optimization variables - INTEGER, INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMess - - REAL(ReKi), INTENT( OUT) :: DFN - REAL(ReKi), INTENT( OUT) :: DFT - REAL(ReKi), INTENT( OUT) :: PMA - INTEGER, INTENT(IN) :: J - INTEGER, INTENT(IN) :: IBlade - LOGICAL, INTENT(IN) :: Initial - - ! Local Variables: - - REAL(ReKi) :: CDA - REAL(ReKi) :: CLA - REAL(ReKi) :: CMA - REAL(ReKi) :: CPHI - REAL(ReKi), intent(in) :: PHI - REAL(ReKi) :: QA - REAL(ReKi) :: ReNum - REAL(ReKi) :: SPHI - - INTEGER :: ErrStatLcL ! Error status returned by called routines. - CHARACTER(ErrMsgLen) :: ErrMessLcl ! Error message returned by called routines. - - ErrStat = ErrID_None - ErrMess = "" - - ! Get the Reynold's number for the element - ! Returns Reynold's number x 10^6 !bjj: Reynold's number x 10^-6 ? -ReNum = GetReynolds( SQRT(m%Element%W2(J,IBlade)), P%Blade%C(J), P%Wind%KinVisc ) -IF (P%Reynolds) m%AirFoil%MulTabLoc = ReNum - - ! Get lift coefficient from dynamic stall routine if desired - ! note that the induced velocity was calculated - ! using the static CL, not the dynamic CL - -IF ( P%DSTALL ) THEN - ! USE Beddoes dynamic stall model - IF (Initial) THEN ! USE static data on first pass - CALL BEDINIT ( P, m, ErrStatLcl, ErrMessLcl, & - J, IBlade, m%Element%ALPHA(J,IBlade)) - CALL SetErrStat ( ErrStatLcl, ErrMessLcl, ErrStat,ErrMess,'ELEMFRC' ) - IF (ErrStat >= AbortErrLev) RETURN - - CALL CLCD( P, m, ErrStatLcl, ErrMessLcl, & - m%Element%ALPHA(J,IBlade), CLA, CDA, CMA, P%AirFoil%NFOIL(J) ) - CALL SetErrStat ( ErrStatLcl, ErrMessLcl, ErrStat,ErrMess,'ELEMFRC' ) - IF (ErrStat >= AbortErrLev) RETURN - ELSE - CALL BeddoesModel( P, m, ErrStatLcl, ErrMessLcl, & - m%Element%W2(J,IBlade), J, IBlade, m%Element%ALPHA(J,IBlade), CLA, CDA, CMA) - CALL SetErrStat ( ErrStatLcl, ErrMessLcl, ErrStat,ErrMess,'ELEMFRC' ) - IF (ErrStat >= AbortErrLev) RETURN - ENDIF -ELSE - ! Don't USE dynamic stall model - CALL CLCD( P, m, ErrStatLcl, ErrMessLcl, & - m%Element%ALPHA(J,IBlade), CLA, CDA, CMA, P%AirFoil%NFOIL(J) ) - CALL SetErrStat ( ErrStatLcl, ErrMessLcl, ErrStat,ErrMess,'ELEMFRC' ) - IF (ErrStat >= AbortErrLev) RETURN -ENDIF - -QA = 0.5 * P%Wind%RHO * m%Element%W2(J,IBlade) * P%Blade%DR(J) * P%Blade%C(J) -CPHI = COS( PHI ) -SPHI = SIN( PHI ) -DFN = ( CLA * CPHI + CDA * SPHI ) * QA -DFT = ( CLA * SPHI - CDA * CPHI ) * QA - -IF ( P%PMOMENT ) THEN - PMA = CMA * QA * P%Blade%C(J) -ELSE - PMA = 0. - CMA = 0. -ENDIF - - - ! Save values at appropriate station - -IF ( IBLADE == 1 ) THEN - IF ( m%ElOut%ElPrList(J) > 0 ) THEN - m%ElOut%AAA ( m%ElOut%ElPrList(J) ) = m%Element%A (J,IBLADE) - m%ElOut%AAP ( m%ElOut%ElPrList(J) ) = m%Element%AP(J,IBLADE) - m%ElOut%ALF ( m%ElOut%ElPrList(J) ) = m%Element%ALPHA(J,IBlade) * R2D - m%ElOut%CDD ( m%ElOut%ElPrList(J) ) = CDA - m%ElOut%CLL ( m%ElOut%ElPrList(J) ) = CLA - m%ElOut%CMM ( m%ElOut%ElPrList(J) ) = CMA - m%ElOut%CNN ( m%ElOut%ElPrList(J) ) = CLA * COS(m%Element%ALPHA(J,IBlade)) + CDA * SIN(m%Element%ALPHA(J,IBlade)) - m%ElOut%CTT ( m%ElOut%ElPrList(J) ) =-CDA * COS(m%Element%ALPHA(J,IBlade)) + CLA * SIN(m%Element%ALPHA(J,IBlade)) - m%ElOut%DFNSAV ( m%ElOut%ElPrList(J) ) = DFN - m%ElOut%DFTSAV ( m%ElOut%ElPrList(J) ) = DFT - m%ElOut%DynPres( m%ElOut%ElPrList(J) ) = 0.5 * P%Wind%RHO * m%Element%W2(J,IBlade) - m%ElOut%PITSAV ( m%ElOut%ElPrList(J) ) = m%Element%PitNow(J,IBlade) * R2D - m%ElOut%PMM ( m%ElOut%ElPrList(J) ) = PMA - m%ElOut%ReyNum ( m%ElOut%ElPrList(J) ) = ReNum - m%ElOut%Gamma ( m%ElOut%ElPrList(J) ) = 0.5 * P%Blade%C(J) * sqrt(m%Element%W2(J,IBlade)) * CLA ! 1/2 c Urel Cl [m^2/s] - ENDIF - -ENDIF - -RETURN -END SUBROUTINE ELEMFRC2 - -!====================================================== - SUBROUTINE VIND( p, m, ErrStat, ErrMess, & - J, IBlade, RLOCAL, VNROTOR2, VNW, VNB, VT ) - ! Calculates the axial and tangential induction factor for each annular segment - ! and time step (i.e. sets m%Element%A and m%Element%AP) - ! *************************************************** - IMPLICIT NONE - ! Passed Variables: - TYPE(AD14_ParameterType), INTENT(IN ) :: p ! Parameters - TYPE(AD14_MiscVarType), INTENT(INOUT) :: m ! Misc/optimization variables - - REAL(ReKi), INTENT(IN ) :: RLOCAL - REAL(ReKi), INTENT(IN ) :: VNB - REAL(ReKi), INTENT(IN ) :: VNROTOR2 - REAL(ReKi), INTENT(IN ) :: VNW - REAL(ReKi), INTENT(IN ) :: VT ! tangential velocity from relative blade motion and wind, no induction - - INTEGER, INTENT(IN ) :: J - INTEGER, INTENT(IN ) :: IBlade - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMess - - - ! Local Variables: - - REAL(ReKi) :: A2 - REAL(ReKi) :: A2P - REAL(ReKi) :: AI - REAL(ReKi) :: ALPHA - REAL(ReKi) :: ASTEP - REAL(ReKi) :: ATOLER2 - REAL(ReKi) :: ATOLERBY10 - REAL(ReKi) :: CDA - REAL(ReKi) :: CLA - REAL(ReKi) :: CMA - REAL(ReKi) :: DAI - REAL(ReKi) :: DAI1 - REAL(ReKi) :: DELAI - REAL(ReKi) :: PHI - REAL(ReKi) :: SOLFACT - REAL(ReKi) :: VNA - REAL(ReKi) :: VT2_Inv - REAL(ReKi) :: VTA - - INTEGER :: ICOUNT - INTEGER :: MAXICOUNT - INTEGER :: Sttus - INTEGER(IntKi) :: ErrStatLcl - character(ErrMsgLen) :: ErrMessLcl - - ErrStat = ErrID_None - ErrMess = "" - - ! Allocate and initialize the local array on the first pass -IF ( .NOT. ALLOCATED (m%Element%OLD_A_NS) ) THEN - ALLOCATE ( m%Element%OLD_A_NS ( P%Element%NELM, P%NumBl) , STAT=Sttus ) - IF ( Sttus /= 0 ) CALL ProgAbort ( ' Error allocating memory for OLD_A_NS array.' ) - m%Element%OLD_A_NS(:,:) = 0.0 -ENDIF - - ! Allocate and initialize the local array on the first pass -IF ( .NOT. ALLOCATED (m%Element%OLD_AP_NS) ) THEN - ALLOCATE ( m%Element%OLD_AP_NS ( P%Element%NELM, P%NumBl) , STAT=Sttus ) - IF ( Sttus /= 0 ) CALL ProgAbort ( ' Error allocating memory for OLD_AP_NS array.' ) - m%Element%OLD_AP_NS(:,:) = 0.0 -ENDIF - - ! Set maximum iterations -MAXICOUNT = P%MAXICOUNT - - ! CH-- Alternate convergence criteria -ATOLER2 = 2.0 * P%InducedVel%ATOLER -ATOLERBY10 = 0.1 * P%InducedVel%ATOLER - - ! Bypass calculations for low wind speed, assume no induced velocity. - -IF ( VNROTOR2 < 0.1 ) THEN - m%Element%A(J,IBLADE) = 0.0 - RETURN -ENDIF - - ! SOLFACT is solidity factor divided by 2*VNROTOR2 - ! VT2_Inv is 1./VT**2 to save computation time - -IF ( RLOCAL == 0.0 ) THEN ! Avoid div/0 in FAST2 - SOLFACT = 1.0/VNROTOR2 -ELSE - SOLFACT = P%NumBl * P%Blade%C(J) / ( TWOPI * RLOCAL * VNROTOR2) -ENDIF -VT2_Inv = 1. / ( VT * VT ) - - !-mlb Let's USE the old value of the A from before it was corrected for skew. -AI = m%Element%OLD_A_NS( J, IBLADE ) -DAI1 = 0.05 -A2P = m%Element%OLD_AP_NS( J, IBLADE ) -ASTEP = 0.5 -ICOUNT = 0 - - ! Check for extremely high VN and bypass calculations if necessary - -IF ( ABS( VNB ) > 100. ) THEN - m%Element%A( J, IBLADE ) = 0.0 - CALL VINDERR( m, ErrStat, ErrMess, & - VNW, VNB, 'VNB', J, IBLADE ) - RETURN -ELSEIF ( ABS( VT ) > 400. ) THEN - m%Element%A( J, IBLADE ) = 0.0 - CALL VINDERR( m, ErrStat, ErrMess, & - VNW, VT, 'VT', J, IBLADE ) - RETURN -ENDIF - -A2 = AI - -CALL AXIND ( P, m, ErrStat, ErrMess, & - VNW, VNB, VNA, VTA, VT, VT2_Inv, VNROTOR2, A2, A2P, & - J, IBlade, SOLFACT, ALPHA, PHI, CLA, CDA, CMA, RLOCAL ) - IF (ErrStat >= AbortErrLev) RETURN - -DAI = A2 - AI - -DELAI = ASTEP * DAI - - !CH-- Modification of mlb's proposed change - ! Must pass two criteria. If we have crossed zero many times - ! then the first criterion will be easier to meet than the second - ! because ASTEP will be small (but the second is relaxed to ATOLER2) - -DO WHILE ( ABS( DELAI ) > ATOLERBY10 .AND. ABS(DAI) > ATOLER2 ) - - ICOUNT = ICOUNT + 1 - - A2 = AI - - CALL AXIND ( P, m, ErrStatLcl, ErrMessLcl, & - VNW, VNB, VNA, VTA, VT, VT2_Inv, VNROTOR2, A2, A2P, & - J, IBlade, SOLFACT, ALPHA, PHI, CLA, CDA, CMA, RLOCAL ) - CALL SetErrStat(ErrStatLcl,ErrMessLcl,ErrStat,ErrMess,'VIND' ) - IF (ErrStat >= AbortErrLev) RETURN - - DAI = A2 - AI - - DELAI = ASTEP * DAI - - ! Test for convergence, program warning after 1000 iterations - - IF ( ICOUNT > MAXICOUNT ) THEN - CALL ProgWarn( 'Induction factor calculation did not converge after'//TRIM(Int2LStr(MAXICOUNT))// & - ' iterations. AeroDyn will continue using induction factors from previous successful time step.' ) - A2 = m%Element%OLD_A_NS (J,IBLADE) - A2P = m%Element%OLD_AP_NS(J,IBLADE) - !CALL SetErrStat(ErrID_Warn,ErrMessLcl,ErrStat,ErrMess,'VIND' ) - - EXIT - ENDIF - - ! Reduce step size after a zero crossing - !CH-- Put floor under ASTEP to keep it reasonable after many zero crossings - - IF( NINT( SIGN(1.0_ReKi, DAI) ) /= NINT( SIGN(1.0_ReKi, DAI1) ) ) ASTEP = MAX( 1.0E-4_ReKi, 0.5_ReKi*ASTEP ) - - AI = AI + DELAI - DAI1 = DELAI - -END DO - - ! Passed test, we're done -m%Element%A (J,IBLADE) = A2 -m%Element%AP(J,IBLADE) = A2P -m%Element%OLD_A_NS (J,IBLADE) = A2 -m%Element%OLD_AP_NS (J,IBLADE) = A2P - -RETURN -END SUBROUTINE VIND - - - ! *************************************************** - SUBROUTINE VINDERR( m, ErrStat, ErrMess, & - VNW, VX, VID, J, IBLADE ) -! SUBROUTINE VINDERR( VNW, VX, VID, J, IBLADE ) - ! used to write warning messages to the screen - ! when VN or VT is high. - ! *************************************************** - IMPLICIT NONE - ! Passed Variables: - TYPE(AD14_MiscVarType), INTENT(INOUT) :: m ! Misc/optimization variables - INTEGER, INTENT(OUT) :: ErrStat - CHARACTER(*), INTENT(OUT) :: ErrMess - - REAL(ReKi),INTENT(IN) :: VNW - REAL(ReKi),INTENT(IN) :: VX - - INTEGER ,INTENT(IN) :: IBLADE - INTEGER ,INTENT(IN) :: J - - CHARACTER( *),INTENT(IN) :: VID - - - ErrStat = ErrID_None - ErrMess = "" - - ! Don't write messages if we've already done it 5 times - -IF ( m%AFLAGVinderr ) RETURN - -m%NERRORS = m%NERRORS + 1 - - CALL ProgWarn( ' High '//TRIM(VID)//' velocity encountered during induction factor calculation.' ) - CALL WrScr( ' Blade number '//TRIM(Int2LStr(IBLADE))//', Element number '//TRIM(Int2LStr(J )) ) - CALL WrScr( ' VNW = ' //TRIM(Num2LStr(VNW))//', '//TRIM(VID)//' = '//TRIM(Num2LStr(VX)) ) - -IF ( m%NERRORS >= 5 ) THEN - m%AFLAGVinderr = .TRUE. - CALL ProgWarn( ' Induced velocity warning written 5 times. '//& - ' The message will not be repeated, though the condition may persist.' ) -ENDIF - - -RETURN -END SUBROUTINE VINDERR - - ! ****************************************************** - SUBROUTINE AXIND (P, m, ErrStat, ErrMess, & - VNW, VNB, VNA, VTA, VT, VT2_Inv, VNROTOR2, A2, & - A2P, J, IBlade, SOLFACT, ALPHA, PHI, CLA, CDA, CMA, RLOCAL ) -! SUBROUTINE AXIND ( VNW, VNB, VNA, VTA, VT, VT2_Inv, VNROTOR2, A2, & -! A2P, J, SOLFACT, ALPHA, PHI, CLA, CDA, CMA, RLOCAL ) - ! calculates a new axial induction factor from - ! given values of velocities and geometry. This routine - ! is called by vind as part of the iteration process - ! ****************************************************** - IMPLICIT NONE - ! Passed Variables: - TYPE(AD14_ParameterType), INTENT(IN) :: p ! Parameters - TYPE(AD14_MiscVarType), INTENT(INOUT) :: m ! Misc/optimization variables - INTEGER, INTENT(OUT) :: ErrStat - CHARACTER(*), INTENT(OUT) :: ErrMess - - REAL(ReKi),INTENT(INOUT) :: A2 - REAL(ReKi),INTENT(INOUT) :: A2P - REAL(ReKi),INTENT(OUT) :: ALPHA - REAL(ReKi),INTENT(OUT) :: CDA - REAL(ReKi),INTENT(OUT) :: CLA - REAL(ReKi),INTENT(OUT) :: CMA - REAL(ReKi),INTENT(OUT) :: PHI - REAL(ReKi),INTENT(IN) :: RLOCAL - REAL(ReKi),INTENT(IN) :: SOLFACT - REAL(ReKi),INTENT(OUT) :: VNA - REAL(ReKi),INTENT(IN) :: VNB - REAL(ReKi),INTENT(IN) :: VNROTOR2 - REAL(ReKi),INTENT(IN) :: VNW - REAL(ReKi),INTENT(IN) :: VT - REAL(ReKi),INTENT(IN) :: VT2_Inv - REAL(ReKi),INTENT(OUT) :: VTA - - INTEGER ,INTENT(IN) :: J - INTEGER ,INTENT(IN) :: IBlade - - ! Local Variables: - - REAL(ReKi) :: CH - REAL(ReKi) :: CPhi ! COS( PHI ) - REAL(ReKi) :: SPHI - REAL(ReKi) :: SWRLARG - REAL(ReKi) :: W2 - - - ErrStat = ErrID_None - ErrMess = "" - - -VNA = VNW * ( 1. - A2 ) + VNB -VTA = VT * ( 1. + A2P ) - - ! Get airfoil CL and CD -PHI = ATAN2( VNA, VTA ) -ALPHA = PHI - m%Element%PitNow(J,IBlade) - -CALL MPI2PI ( ALPHA ) - -CALL CLCD ( P, m, ErrStat, ErrMess, & - ALPHA, CLA, CDA, CMA, P%AirFoil%NFoil(J) ) - IF (ErrStat >= AbortErrLev) RETURN - -W2 = VNA * VNA + VTA * VTA -SPHI = VNA/SQRT( W2 ) -CPhi = COS( Phi ) - - ! Calculate new value of A. Optionally include normal force due to drag. - -CH = W2*SOLFACT*( CLA*CPhi + P%InducedVel%EqAIDmult*CDA*SPhi ) - - - ! Get the tip loss values for the element (if they change) -IF (p%InducedVel%TLOSS) CALL GetTipLoss ( P, m, ErrStat, ErrMess, & - J, SPHI, m%TIPLOSS, RLOCAL) - - ! Get the hub loss values for the element (if they change) -IF (p%InducedVel%HLOSS) CALL GetPrandtlLoss ( P%Element%HLCNST(J), SPHI, m%HUBLOSS) - - ! Get the total loss for the element -m%LOSS = m%TIPLOSS * m%HUBLOSS - - ! Check for diverging CH and correct if necessary - -IF ( ABS( CH ) > 2. ) CH = SIGN( 2.0_ReKi, CH ) - -IF ( CH < 0.96*m%LOSS ) THEN - A2 = 0.5*( 1 - SQRT( 1.0 - CH/m%LOSS ) ) -ELSE - A2 = 0.1432 + SQRT( -0.55106 + .6427*CH/m%LOSS) -ENDIF - - ! Calculate induced swirl (a') if desired. - ! From C. Ross Harmon's paper on PROPX. - -IF ( p%SWIRL ) THEN - IF ( p%InducedVel%EquilDT ) THEN ! USE PROP-PC style tangential induction equation with the addition of the drag term. - ! Because of the singularity that occurs when phi approaches zero, - ! let's test for small phi and set a' equal to a small, negative number. - IF ( ( ABS( SPhi ) > 0.01 ) .AND. ( ABS( CPhi ) > 0.01 ) ) THEN - A2P = SOLFACT*( CLA*SPhi - CDA*CPhi )*( 1.0 + A2P )*VNROTOR2/( 4.0*m%LOSS*SPhi*CPhi ) - ELSEIF ( ABS( SPhi ) > 0.01 ) THEN ! Tangential velocity near zero, phi near 90 degrees. - A2P = SOLFACT*( CLA*SPhi - CDA*SIGN( 0.01_ReKi, CPhi ) )*( 1.0 + A2P )*VNROTOR2/( 4.0*m%LOSS*SPhi*SIGN( 0.01_ReKi, CPhi ) ) - ELSE ! Normal velocity near zero, phi near 0 degrees. - A2P = SOLFACT*( CLA*SIGN( 0.01_ReKi, SPhi ) - CDA*CPhi )*( 1.0 + A2P )*VNROTOR2/( 4.0*m%LOSS*SIGN( 0.01_ReKi, SPhi )*CPhi ) - ENDIF - ELSE - SWRLARG = 1.0 + 4.0*m%LOSS*A2*VNW*VNA*VT2_Inv - IF ( SWRLARG < 0.0 ) THEN - A2P = 0.0 - ELSE - A2P = 0.5*( -1.0 + SQRT( SWRLARG ) ) - ENDIF - ENDIF -ELSE - A2P = 0.0 -ENDIF - - -RETURN -END SUBROUTINE AXIND - - - ! *************************************************** - FUNCTION GetReynolds( WindSpd, ChordLen, KinVisc ) - ! computes the Reynolds number for the element, divided by 1.0E6 - ! *************************************************** - -IMPLICIT NONE - - ! Passed Variables: - -REAL(ReKi),INTENT(IN) :: WindSpd -REAL(ReKi),INTENT(IN) :: ChordLen -REAL(ReKi),INTENT(IN) :: KinVisc - - ! function definition -REAL(ReKi) :: GetReynolds - -GetReynolds = 1.0E-6 * WindSpd * ChordLen / KinVisc - - -RETURN -END FUNCTION GetReynolds - - ! *************************************************** - SUBROUTINE GetTipLoss( P, m, ErrStat, ErrMess, & - J, SPHI, TIPLOSS, RLOCAL ) -! SUBROUTINE GetTipLoss( J, SPHI, TIPLOSS, RLOCAL ) - ! computes the tip loss constant for element J - ! TIPLOSS is returned to AXIND - ! Uses the Prandtl tip loss model with a correction - ! from Georgia Tech (2002 ASME Wind Energy Symposium) - ! *************************************************** - IMPLICIT NONE - ! Passed Variables: - TYPE(AD14_ParameterType), INTENT(IN) :: p ! Parameters - TYPE(AD14_MiscVarType), INTENT(INOUT) :: m ! Misc/optimization variables - INTEGER, INTENT(OUT) :: ErrStat - CHARACTER(*), INTENT(OUT) :: ErrMess - - ! Passed Variables: - REAL(ReKi), INTENT(IN) :: SPHI - REAL(ReKi), INTENT(IN) :: RLOCAL - REAL(ReKi), INTENT(OUT) :: TIPLOSS - - INTEGER , INTENT(IN) :: J - - - ! Local Variables: - - REAL(ReKi) :: Dist2pt7 = 0.7 ! current element distance to r/R = 0.7 - REAL(ReKi) :: OLDDist7 ! previous element distance to r/R = 0.7 - REAL(ReKi) :: percentR - - INTEGER :: Jpt7 = 0 ! The element closest to r/R = 0.7 - - - ErrStat = ErrID_None - ErrMess = "" - - ! Calculate PRANDTL tip loss model -CALL GetPrandtlLoss( P%Element%TLCNST(J), SPHI, TIPLOSS ) - - - ! Apply Georgia Tech correction to Prandtl model if activated -IF (p%InducedVel%GTECH) THEN - percentR = RLOCAL/P%Blade%R - - ! Search for the element closest to r/R = 0.7 - IF (m%FirstPassGTL) THEN - ! If the current element is closer than the previous, update values - IF ( ABS(percentR - 0.7) < Dist2pt7 ) THEN - OLDDist7 = Dist2pt7 - Dist2pt7 = ABS(percentR - 0.7) - Jpt7 = J - m%TLpt7 = TIPLOSS - ENDIF - IF (J == P%Element%NELM) THEN ! We're done after one pass through the blades - m%FirstPassGTL = .FALSE. - ELSE - RETURN ! Don't do the correction until we calculate the correct TLpt7 - ENDIF - ENDIF - - IF ( J == Jpt7 ) m%TLpt7 = TIPLOSS ! Update the value of TLpt7 at the proper element - - ! Do the actual Georgia Tech correction to the Prandtl model - IF (percentR >= 0.7) THEN - TIPLOSS = (TIPLOSS**0.85 + 0.5 ) / 2.0 - ELSE - TIPLOSS = 1.0 - percentR*(1.0 - m%TLpt7)/0.7 - ENDIF -ENDIF - - - -RETURN -END SUBROUTINE GetTipLoss - - - ! *************************************************** - - SUBROUTINE GetPrandtlLoss( LCnst, SPHI, PrLOSS ) - ! computes the hub loss constant for element J - ! HUBLOSS is returned to AXIND - ! Uses the Prandtl loss model - ! *************************************************** - IMPLICIT NONE - ! Passed Variables: - - REAL(ReKi),INTENT(IN) :: LCnst - REAL(ReKi),INTENT(OUT) :: PrLOSS - REAL(ReKi),INTENT(IN) :: SPHI - - ! Local Variables: - - REAL(ReKi) :: F - - ! Calculate PRANDTL loss model - ! Check values of SPHI to save runtime. - IF ( ABS( SPHI ) < 1.E-4 ) THEN - PrLOSS = 1.0 - ELSE - ! USE ABS function to account for unusual PHI. - F = ABS( LCnst / SPHI ) - ! Check values of F to avoid underflow of EXP function. - IF ( F < 7. ) THEN - PrLOSS = ACOS( EXP( -F ) ) / PIBY2 - ELSE - PrLOSS = 1.0 - ENDIF - ENDIF - - -RETURN -END SUBROUTINE GetPrandtlLoss - -!==================================================================================================== -SUBROUTINE GetTwrInfluence ( P, m, ErrStat, ErrMess, & - VX, VY, InputPosition) -!SUBROUTINE GetTwrInfluence (VX, VY, InputPosition) -! Computes tower shadow or dam influence on the blade -! Note that this routine assumes there are NO tower deflections. -! -! Use the Riso tower dam model of Bak, Madsen and Johansen -! This model is based on potential flow and is applicable in front of and behind the tower, -! although in the wake we use the method of Powles -! PJM, NREL -! -! bjj, jmj: this function should return the influence parameters, which will be based on some mean -! wind direction (or possibly the direction at the tower) for a given height, instead of using the -! local velocity/direction so that all points on a horizontal slice of air can use the same -! deficit at each given time. Will need the tower position, too. -!==================================================================================================== - - IMPLICIT NONE - ! Passed Variables: - TYPE(AD14_ParameterType), INTENT(IN) :: p ! Parameters - TYPE(AD14_MiscVarType), INTENT(INOUT) :: m ! Misc/optimization variables - INTEGER, INTENT(OUT) :: ErrStat - CHARACTER(*), INTENT(OUT) :: ErrMess - - ! Passed Variables: - - REAL(ReKi), INTENT(INOUT) :: VX ! on input, U-velocity without tower effect; on output, U-velocity including tower effect - REAL(ReKi), INTENT(INOUT) :: VY ! on input, V-velocity without tower effect; on output, V-velocity including tower effect - REAL(ReKi), INTENT(IN) :: InputPosition(3) !velocities in global coordinates with tower effect - - ! Local Variables: - - REAL(ReKi) :: ANGLE ! Angle determining whether blade is upwind or downwind of tower - REAL(ReKi) :: CenterDist ! Distance from blade element to wake centerline - REAL(ReKi) :: phi ! Angle between x-axis and horizontal wind direction based upon instantaneous velocities VY and VX (at the blade element) - REAL(ReKi) :: CosPhi ! COS(phi) - REAL(ReKi) :: SinPhi ! SIN(phi) - REAL(ReKi) :: Distance ! Normalized horizontal distance from tower to blade element - REAL(ReKi) :: SHADOW ! Value of the tower shadow deficit at the blade element - REAL(ReKi) :: THETA ! Angle between x-axis and line from tower to blade element - REAL(ReKi) :: TwrCD_Station ! Drag coefficient of the tower - REAL(ReKi) :: TwrRad ! Radius of the tower at the height of interest - REAL(ReKi) :: WIDTH ! Half width of the wake after accounting for wake expansion proportional to square root of Distance - - REAL(ReKi) :: V_total ! total freestream wind speed - REAL(ReKi) :: VX_wind ! tower influenced wind speeds in wind coordinates - REAL(ReKi) :: VY_wind ! tower influenced wind speeds in wind coordinates - REAL(ReKi) :: WindXInf ! Influence of the tower on X wind velocity in wind reference frame - REAL(ReKi) :: WindYInf ! Influence of the tower on Y wind velocity in wind reference frame - REAL(ReKi) :: Xtemp ! Temporary variable used in tower dam calculations - REAL(ReKi) :: Xtemp2 ! Temporary variable used in tower dam calculations - REAL(ReKi) :: Xwind ! X Location of element in a wind-based coordinate system - REAL(ReKi) :: Yg ! Variable used to smooth dam effect above the tower - REAL(ReKi) :: Ytemp2 ! Temporary variable used in tower dam calculations - REAL(ReKi) :: Ywind ! Y Location of element in a wind-based coordinate system - - REAL(ReKi) :: ZGrnd ! distance between position and undeflected hub - - - ErrStat = ErrID_None - ErrMess = "" - - !------------------------------------------------------------------------------------------------- - ! This subroutine is only valid for TwrPotent and TwrShadow features - !------------------------------------------------------------------------------------------------- - IF (.NOT. p%TwrProps%TwrPotent .AND. .NOT. p%TwrProps%TwrShadow) RETURN - - !------------------------------------------------------------------------------------------------- - ! Initialize some variables - !------------------------------------------------------------------------------------------------- - ZGrnd = InputPosition(3) - p%Rotor%HH ! distance between position and hub !BJJ: this should really be the tower height (position), not HH - V_total = SQRT( VX**2 + VY**2 ) ! total wind speed - - !------------------------------------------------------------------------------------------------- - ! Tower influence calculations aren't necessary for zero velocity - !------------------------------------------------------------------------------------------------- - IF ( V_total <= 0.0 ) RETURN - - !------------------------------------------------------------------------------------------------- - ! For the current element location, get the appropriate tower properties and calculate the - ! element distance from from the tower. - ! BJJ: If we're above the tower top, is the radius zero? - !------------------------------------------------------------------------------------------------- - - CALL GetTwrSectProp (P, m, ErrStat, ErrMess, & - InputPosition(:), V_total, TwrRad, TwrCD_Station) ! Get the tower properties for the current element location - - Distance = SQRT ( InputPosition(1)**2 + InputPosition(2)**2 ) / TwrRad ! normalized distance to tower center - - ! Check for tower strike - IF ( Distance < 1.0 ) THEN ! potentially inside the tower !bjj: only if we're not ABOVE the tower, though.... - - IF (ZGrnd < 0.0) THEN !bjj added this condition.... check that it's correct -!bjj: what does this exactly mean? "temporarily disabled?" - IF( .NOT. m%AFLAGTwrInflu) THEN - CALL ProgWarn( ' Tower model temporarily disabled due to possible tower strike.'// & - ' This message will not be repeated though the condition may persist.' ) - !write a blank line (so FAST doesn't write over it) - CALL WrScr( ' ' ) - m%AFLAGTwrInflu = .TRUE. - ENDIF - - RETURN - - END IF - - ENDIF - - - !------------------------------------------------------------------------------------------------- - ! Store the wind direction for later - !------------------------------------------------------------------------------------------------- - - phi = ATAN2( VY, VX ) ! angle between x-axis and instantaneous horizontal wind direction - CosPhi = COS( phi ) - SinPhi = SIN( phi ) - - - !------------------------------------------------------------------------------------------------- - ! Calculate the influence due to potential flow around tower based on velocity at element - !------------------------------------------------------------------------------------------------- - - IF ( P%TwrProps%TwrPotent ) THEN - - ! When above the tower, smooth the transition to the free-stream - IF ( ZGrnd > 0 ) THEN - Yg = SQRT( InputPosition(2)**2 + ZGrnd**2 ) - ELSE - Yg = InputPosition(2) - ENDIF - - ! Get the element location in the wind reference frame - Xwind = InputPosition(1) * CosPhi + Yg * SinPhi - Ywind = Yg * CosPhi - InputPosition(1) * SinPhi - - ! Normalize the location coordinates - Xwind = Xwind / TwrRad - Ywind = Ywind / TwrRad - - - Xtemp = Xwind + P%TwrProps%Tower_Wake_Constant !PJM fixed this error 3/30/06 - Xtemp2 = Xtemp * Xtemp - Ytemp2 = Ywind * Ywind - - - ! Calculate the tower influence - WindXInf = 1.0 - (Xtemp2 - Ytemp2)/( (Xtemp2 + Ytemp2)**2 ) & - + TwrCD_Station/TwoPi * Xtemp/(Xtemp2 + Ytemp2) - WindYInf = -2.0 * (Xtemp * Ywind)/( (Xtemp2 + Ytemp2)**2 ) & !PJM fixed sign error 3/30/06 added minus sign from Bak - + TwrCD_Station/TwoPi * Ywind/(Xtemp2 + Ytemp2) - ELSE - WindXInf = 1.0 - WindYInf = 0.0 - ENDIF - - !------------------------------------------------------------------------------------------------- - ! Calculate the influence of tower shadow if user specifies and we are downwind of the tower - !------------------------------------------------------------------------------------------------- - - IF ( P%TwrProps%TwrShadow ) THEN - - theta = ATAN2( InputPosition(2), InputPosition(1) ) ! angle between x-axis and line from tower to blade element - angle = ABS( theta - phi ) - - CALL mPi2Pi( angle ) ! angle difference between -pi and pi - angle = ABS(angle) !BJJ: SHOULDN'T THIS BE ABS(angle)? I'm adding it here.... - - IF ( angle <= PiBy2 ) THEN ! We are downwind of the tower in shadow territory - - width = SQRT ( Distance ) - - ! Calculate how far we are from the free-stream centerline - CenterDist = Distance * SIN ( angle ) ! bjj: non-negative because angle is non-negative (now) - - ! If above hub height apply shadow in arc above hub to maintain a continuous deficit function. Somewhat of a nacelle deficit. - IF ( ZGrnd > 0.0 ) THEN - CenterDist = SQRT( CenterDist**2 + ZGrnd**2 ) - END IF - - ! See if we are in the wake. If not, then no velocity deficit - - IF ( CenterDist < width ) THEN ! We are in the wake - - shadow = ( COS( PiBy2 * CenterDist / width ) )**2 * TwrCD_Station / width - WindXInf = 1.0 - shadow ! Overwrites the potential flow solution in the x direction only (BJJ: longitudinal? not x?) - - WindXInf = MAX( WindXInf, REAL(0.0, ReKi) ) ! Assume tower does not reverse flow direction - - END IF - - END IF ! angle <= PiBy2 - - END IF !TwrShadow - - - !------------------------------------------------------------------------------------------------- - ! Apply the tower influence to the input wind speeds - !------------------------------------------------------------------------------------------------- - - VX_wind = WindXInf*V_total - VY_wind = WindYInf*V_total - - ! Need to transpose these back to the global reference frame - VX = VX_wind * CosPhi - VY_wind * SinPhi - VY = VY_wind * CosPhi + VX_wind * SinPhi - - RETURN - -END SUBROUTINE GetTwrInfluence - -!==================================================================================================== -SUBROUTINE GetTwrSectProp ( P, m, ErrStat, ErrMess, & - InputPosition, VelHor, TwrElRad, TwrElCD ) -!SUBROUTINE GetTwrSectProp (InputPosition, VelHor, TwrElRad, TwrElCD) -! Returns the tower radius and CD for the vertical location -! of the element currently being evaluated for tower influence. -!==================================================================================================== - - IMPLICIT NONE - ! Passed Variables: - TYPE(AD14_ParameterType), INTENT(IN) :: p ! Parameters - TYPE(AD14_MiscVarType), INTENT(INOUT) :: m ! Misc/optimization variables - INTEGER, INTENT(OUT) :: ErrStat - CHARACTER(*), INTENT(OUT) :: ErrMess - - - ! Passed Variables: - REAL(ReKi), INTENT(IN) :: InputPosition(3) ! Location where tower properties are desired - REAL(ReKi), INTENT(IN) :: VelHor ! The horizontal wind speed, used to get Reynolds number, if necessary - REAL(ReKi), INTENT(OUT) :: TwrElRad ! Radius of the tower element - REAL(ReKi), INTENT(OUT) :: TwrElCD ! Drag coefficient of the tower element - - - ! Local Variables: - REAL(ReKi) :: P1 ! Interpolation weighting factor - REAL(ReKi) :: P2 ! Interpolation weighting factor - REAL(ReKi) :: TwrElCD1 ! Dummy variable for 2-D interpolation - REAL(ReKi) :: TwrElCD2 ! Dummy variable for 2-D interpolation - REAL(ReKi) :: TwrElHt ! Non-dimensional height of the tower element - REAL(ReKi) :: TwrElRe ! Reynold's # of the tower element - - INTEGER :: N1 ! Index position in table for interpolation - INTEGER :: N2 ! Index position in table for interpolation - INTEGER :: N1P1 ! Index position + 1 in table for interpolation - INTEGER :: N2P1 ! Index position + 1 in table for interpolation - - - ErrStat = ErrID_None - ErrMess = "" - - !------------------------------------------------------------------------------------------------- - ! Get the tower radius, TwrElRad, by interpolating into the TwrWid(:) array - !------------------------------------------------------------------------------------------------- - - TwrElHt = InputPosition(3) / P%Rotor%HH !!!!BJJ!!!! HH???? !MLB: It's the hub height. It really should be the tower height. - TwrElRad = 0.5*InterpBin( TwrElHt, p%TwrProps%TwrHtFr, p%TwrProps%TwrWid, N2, p%TwrProps%NTwrHt ) - - !------------------------------------------------------------------------------------------------- - ! Get the section CD, TwrElCD, by interpolating into the TwrCD(:,:) array - !------------------------------------------------------------------------------------------------- - - IF ( p%TwrProps%NTwrRe == 1 ) THEN ! There is only one Re row - - IF ( p%TwrProps%NTwrCD == 1 ) THEN ! There is only one CD column - TwrElCD = p%TwrProps%TwrCD(1,1) - ELSE IF ( p%TwrProps%NTwrHt == 1 ) THEN ! There is more than one column of CD, but only one used - TwrElCD = p%TwrProps%TwrCD(1,p%TwrProps%NTwrCDCol(1)) - ELSE ! Interpolate; this will be the same Indx as before... - TwrElCD = InterpStp( TwrElHt, p%TwrProps%TwrHtFr, p%TwrProps%TwrCD(1,:), N2, p%TwrProps%NTwrHt ) - END IF - - ELSE ! There are multiple Re rows - - TwrElRe = GetReynolds( VelHor, 2.0_ReKi*TwrElRad, P%Wind%KinVisc ) - - IF ( p%TwrProps%NTwrCD == 1 ) THEN ! There is only one CD column - TwrElCD = InterpBin( TwrElRe, p%TwrProps%TwrRe, p%TwrProps%TwrCD(:,1), N1, p%TwrProps%NTwrRe ) - ELSE IF ( p%TwrProps%NTwrHt == 1 ) THEN ! Interpolate over Re only - TwrElCD = InterpBin( TwrElRe, p%TwrProps%TwrRe, p%TwrProps%TwrCD(:,p%TwrProps%NTwrCDCol(1)), N1, p%TwrProps%NTwrRe ) - ELSE ! A 2-D interpolation is needed - CALL LocateBin( TwrElRe, p%TwrProps%TwrRe, N1, p%TwrProps%NTwrRe ) - - ! Let's use nearest-neighbor extrapolation with bi-linear interpolation: - - N1 = MIN( MAX( N1, 1 ), p%TwrProps%NTwrRe-1 ) - N1P1 = N1+1 - - P1 = MIN( MAX( (TwrElRe - p%TwrProps%TwrRe(N1)) / (p%TwrProps%TwrRe(N1P1) - p%TwrProps%TwrRe(N1)) , REAL(0.0, ReKi) ), REAL(1.0, ReKi) ) - - N2P1 = N2 + 1 - P2 = MIN( MAX( (TwrElHt - p%TwrProps%TwrHtFr(N2)) / (p%TwrProps%TwrHtFr(N2P1) - p%TwrProps%TwrHtFr(N2)), REAL(0.0, ReKi) ), REAL(1.0, ReKi) ) - - - TwrElCD1 = p%TwrProps%TwrCD(N1,N2 ) + P1 * ( p%TwrProps%TwrCD(N1P1,N2 ) - p%TwrProps%TwrCD(N1,N2 ) ) - TwrElCD2 = p%TwrProps%TwrCD(N1,N2P1) + P1 * ( p%TwrProps%TwrCD(N1P1,N2P1) - p%TwrProps%TwrCD(N1,N2P1) ) - - - TwrElCD = TwrElCD1 + P2 * ( TwrElCD2 - TwrElCD1 ) - END IF - - END IF - - -RETURN -END SUBROUTINE GetTwrSectProp - - -!==================================================================================================== -FUNCTION AD_WindVelocityWithDisturbance( Time, u, p, x, xd, z, m, y, ErrStat, ErrMsg, & - InputPosition, InputVelocity ) -! InputPosition, TShadC1, TShadC2, PJM_Version ) -!FUNCTION AD_WindVelocityWithDisturbance( InputPosition, TShadC1, TShadC2, PJM_Version, LeStat ) -! This function computes the (dimensional) wind velocity components at the location InputPosition -! in the inertial frame of reference, including any tower shadow defecit. -! ** Formerly SUBROUTINE VEL and later SUBROUTINE VWrel2G( VNRotor2, At_Hub ) ** -!---------------------------------------------------------------------------------------------------- - - - IMPLICIT NONE - - ! Passed Variables: - - REAL(DbKi), INTENT(IN ) :: Time ! Current simulation time in seconds - TYPE(AD14_InputType), INTENT(IN ) :: u ! Inputs at Time - TYPE(AD14_ParameterType), INTENT(IN ) :: p ! Parameters - TYPE(AD14_ContinuousStateType), INTENT(IN ) :: x ! Continuous states at Time - TYPE(AD14_DiscreteStateType), INTENT(IN ) :: xd ! Discrete states at Time - TYPE(AD14_ConstraintStateType), INTENT(IN ) :: z ! Constraint states at Time - TYPE(AD14_MiscVarType), INTENT(INOUT) :: m ! Misc/optimization variables - TYPE(AD14_OutputType), INTENT(INOUT) :: y ! Outputs computed at Time (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 - - REAL(ReKi),INTENT(IN) :: InputPosition(3) ! - REAL(ReKi),INTENT(IN) :: InputVelocity(3) ! undisturbed velocity - - ! REAL(ReKi),INTENT(IN) :: TShadC1 -! REAL(ReKi),INTENT(IN) :: TShadC2 -! LOGICAL,INTENT(IN) :: PJM_Version - - ! function definition - - REAL(ReKi) :: AD_WindVelocityWithDisturbance(3) - - ! Local variables - - REAL(ReKi) :: angle ! absolute difference between theta and phi - REAL(ReKi) :: dist ! distance from blade element to wake centerline - REAL(ReKi) :: phi ! angle between x-axis and instantaneous horizontal wind direction - REAL(ReKi) :: RADIUS ! horizontal distance from tower to blade element ** BJJ NOTE: in actuality, it's the distance from the undeflected tower centerline, not the actual tower - REAL(ReKi) :: ROOTR ! SQRT(radius) - REAL(ReKi) :: SHADOW - REAL(ReKi) :: TEMP - REAL(ReKi) :: theta ! Angle between x-axis and line from tower to blade element - REAL(ReKi) :: width ! half width of the wake after accounting for wake expansion proportional to square root of RADIUS - -! INTEGER :: Sttus - -! INTEGER :: TmpErrStat -! CHARACTER(ErrMsgLen) :: TmpErrMsg - - - ErrStat = ErrID_None - ErrMsg = "" - - ! Get the undisturbed velocity - - AD_WindVelocityWithDisturbance(:) = InputVelocity - - ! Add the tower influence to the undisturbed velocity. - - IF ( p%TwrProps%PJM_Version ) THEN - - CALL GetTwrInfluence ( P, m, ErrStat, ErrMsg, & - AD_WindVelocityWithDisturbance(1), AD_WindVelocityWithDisturbance(2), InputPosition(:) ) - - ELSE !Old tower version - - ! Apply tower shadow if the blade element is in the wake - - IF ( p%TwrProps%TShadC2 > 0.0 ) THEN ! Perform calculations only if the wake strength is positive - - ! Bypass tower shadow for zero horizontal wind, check U-component first to save time. - - IF ( AD_WindVelocityWithDisturbance(1) /= 0.0 .OR. AD_WindVelocityWithDisturbance(2) /= 0.0 ) THEN - - phi = ATAN2( AD_WindVelocityWithDisturbance(2), AD_WindVelocityWithDisturbance(1) ) ! angle between x-axis and instantaneous horizontal wind direction - theta = ATAN2( InputPosition(2), InputPosition(1) ) ! angle between x-axis and line from tower to blade element - angle = ABS( theta - phi ) - - CALL MPi2Pi( angle ) - angle = ABS( angle ) - - IF ( angle <= PiBy2 ) THEN ! Skip cases where we are upwind of the tower -- bjj: DOES THIS ACTUALLY WORK? WHAT ABOUT - - radius = SQRT( InputPosition(1)**2 + InputPosition(2)**2 ) ! bjj: shouldn't this be relative to the hub position? - - RootR = SQRT( radius ) - width = p%TwrProps%TShadC1 * RootR ! half width of the wake after accounting for wake expansion proportional to square root of RADIUS - - IF ( width > 0 ) THEN ! Skip cases with zero width or radius so we don't divide by zero - - dist = radius * SIN( angle ) ! distance from blade element to wake centerline - IF ( InputPosition(3) > p%Rotor%HH ) THEN ! Apply shadow in arc above hub to maintain a continuous deficit function. Somewhat of a nacelle deficit. - dist = SQRT( dist**2 + (InputPosition(3)-p%Rotor%HH)**2 ) !bjj: I think this should use hub position, not HH - END IF - - IF ( width > dist ) THEN ! There is velocity deficit in the wake only. - temp = COS ( PiBy2 * dist/width ) - shadow = p%TwrProps%TShadC2/RootR * temp * temp - - ! Adjust only the horizontal components; vertical wind is not changed - - AD_WindVelocityWithDisturbance(1:2) = AD_WindVelocityWithDisturbance(1:2) * ( 1. - shadow ) - - END IF ! width > dist - END IF ! width > 0 - - END IF ! angle <= PiBy2 - - END IF !AD_WindVelocityWithDisturbance(1) /= 0.0 .OR. AD_WindVelocityWithDisturbance(2) /= 0.0 - END IF ! TShadC2 > 0.0 - - END IF - -RETURN - -END FUNCTION AD_WindVelocityWithDisturbance - -!==================================================================================================== -SUBROUTINE DiskVel ( Time, P, m, AvgInfVel, ErrStat, ErrMess ) -! SUBROUTINE DiskVel - ! calculates the mean velocities relative to the rotor disk - ! calls routine to get wind velocity at a specified location - ! - ! Updated on 08/12/97 xyz-direction changed - ! Combined VELD and GETSKEW 04/24/01 - ! Updated 12/1/09 to use new inflow module; WindInf_ADhack_diskVel MUST be replaced! - ! ******************************************** - IMPLICIT NONE - ! Passed Variables: - REAL(DbKi), INTENT(IN) :: Time - TYPE(AD14_ParameterType), INTENT(IN) :: p ! Parameters - TYPE(AD14_MiscVarType), INTENT(INOUT) :: m ! Misc/optimization variables - REAL(ReKi), INTENT(IN) :: AvgInfVel(3) !some sort of averaged wind speed (currently depends on wind file type) - INTEGER, INTENT(OUT) :: ErrStat - CHARACTER(*), INTENT(OUT) :: ErrMess - - - REAL(ReKi) :: Vinplane - REAL(ReKi) :: VXY - - ErrStat = ErrID_None - ErrMess = "" - -!Position = (/0.0_ReKi, 0.0_ReKi, P%Rotor%HH /) -!AvgInfVel(:) = WindInf_ADhack_diskVel( REAL(Time, ReKi), Position, ErrStat ) - - -VXY = AvgInfVel(1) * m%Rotor%CYaw - AvgInfVel(2) * m%Rotor%SYaw - - ! Mean velocities in rotor disk coord. Includes yaw rate. - ! X = Normal to plane, parallel to axis of rotation DOWNWIND - ! Y = Inplane, horizontal to left (looking downwind) - ! Z = Inplane, vertical up - -m%Wind%VROTORX = VXY * m%Rotor%CTILT + AvgInfVel(3) * m%Rotor%STILT - -m%Wind%VROTORY = AvgInfVel(1) * m%Rotor%SYaw + AvgInfVel(2) * m%Rotor%CYaw + m%Rotor%YAWVEL - -m%Wind%VROTORZ = -1.* VXY * m%Rotor%STILT + AvgInfVel(3) * m%Rotor%CTILT - - ! Skewed wake correction not needed for GDW -IF (.NOT. P%DYNINFL) THEN - ! Set SKEW flag and assign values to related parameters - ! used in the skewed wake correction. - - ! Vinplane is the resultant in-plane velocity - Vinplane = SQRT( m%Wind%VROTORY * m%Wind%VROTORY + m%Wind%VROTORZ * m%Wind%VROTORZ ) - - ! SKEW is TRUE if there is a cross flow, FALSE otherwise. - IF ( Vinplane >= 1.0E-3 ) THEN - m%SKEW = .TRUE. - m%Wind%SDEL = m%Wind%VROTORY/Vinplane - m%Wind%CDEL = -m%Wind%VROTORZ/Vinplane - m%Wind%ANGFLW = ATAN2( ABS( m%Wind%VROTORX - m%Rotor%AVGINFL ), Vinplane ) - ELSE - m%SKEW = .FALSE. - ENDIF - -ENDIF - - - -RETURN -END SUBROUTINE DiskVel -!======================================================================= -SUBROUTINE TwrAeroLoads ( p, Node, NodeDCMGbl, NodeVelGbl, NodeWindVelGbl, NodeFrcGbl ) - - - ! This routine calcualtes the aeroynamic loads of all tower nodes above the mean sea level. - ! It doesn't worry about whether or not a node is below water. The aero loads will be far less than the hydro loads. - - IMPLICIT NONE - - - ! Arguments: - - REAL(R8Ki), INTENT(IN ) :: NodeDCMGbl (3,3) ! The direction-cosine matrix used to transform from the global system to the node system. - REAL(ReKi), INTENT(OUT) :: NodeFrcGbl (3) ! The forces per unit length at the current tower element. - REAL(ReKi), INTENT(IN ) :: NodeVelGbl (3) ! The 3 components of the translational velocity at the node in the global system. - REAL(ReKi), INTENT(IN ) :: NodeWindVelGbl(3) ! The 3 components of the wind at the node in the global system. - - INTEGER, INTENT(IN ) :: Node ! Tower node index. - - TYPE(AD14_ParameterType), INTENT(IN) :: p ! The AeroDyn parameters. - - - ! Local variables. - - REAL(ReKi) :: NodeFrcLcl (3) ! The forces per unit length on the tower node in the local system. -! REAL(ReKi) :: NodeLocTwr (3) ! The location of the node in the tower coordinate system. This is used to get the tower section properties. - REAL(ReKi) :: NodeVelRelGbl (3) ! The relative wind velocity in the global reference frame.. - REAL(ReKi) :: NodeVelRelLcl (3) ! The relative wind velocity in the local reference frame.. - REAL(ReKi) :: RelNmlWndSpd ! The relative wind speed normal to the tower axis. sqrt(u^2+v^2) -! REAL(ReKi) :: TwrFrcLcl (3) ! The drag coefficient corresponding to the computed Reynolds Number. - REAL(ReKi) :: TwrNodeCd ! The drag coefficient corresponding to the computed Reynolds Number. - REAL(ReKi) :: TwrNodeRe ! The Reynolds Number computed using the wind speed normal to the tower axis. -! REAL(ReKi) :: WndDirLcl ! The wind direction relative to the local node coordinate system using only the u and v components. - - INTEGER(IntKi) :: IndLo ! The index pointing to the lower of the two points bounding an interpolated value. - - - - ! Calculate the relative local wind velocity. - - NodeVelRelGbl(:) = NodeWindVelGbl(:) - NodeVelGbl(:) - - - ! Transform the relative velocity into the node coordinate system. - - NodeVelRelLcl(:) = MATMUL( NodeDCMGbl, NodeVelRelGbl ) - - - ! Compute the relative normal wind speed and its square. - - RelNmlWndSpd = SQRT( DOT_PRODUCT( NodeVelRelLcl(1:2), NodeVelRelLcl(1:2) ) ) - - - ! Compute the Reynolds Number. Because interpolation is expensive, we will compute the magnitude of the drag and resolve it into components. - - TwrNodeRe = GetReynolds( RelNmlWndSpd, p%TwrProps%TwrNodeWidth(Node), p%Wind%KinVisc ) - - - ! Get the local value of the drag coefficient. - - IndLo = 1 - -!MLB: Why have two different calls? Can't the second accommodate the first? Is the first method more efficient than the second method if there is only one Cd column? -!MLB: This logic was stolen from AeroSubs.f90\GetTwrSectProp(). - - IF ( p%TwrProps%NTwrCD == 1 ) THEN ! There is only one CD column - TwrNodeCd = InterpBin( TwrNodeRe, p%TwrProps%TwrRe, p%TwrProps%TwrCD(:,1), IndLo, p%TwrProps%NTwrRe ) - ELSE IF ( p%TwrProps%NTwrHt == 1 ) THEN ! Interpolate over Re only - TwrNodeCd = InterpBin( TwrNodeRe, p%TwrProps%TwrRe, p%TwrProps%TwrCD(:,p%TwrProps%NTwrCDCol(1)), IndLo, p%TwrProps%NTwrRe ) !MLB Why have two different calls? Can't the second accommodate the first? - END IF - - - ! Compute the forces on the tower in the local system. - - NodeFrcLcl(1) = 0.5*TwrNodeCd*p%Wind%Rho*p%TwrProps%TwrNodeWidth(Node)*RelNmlWndSpd*NodeVelRelLcl(1) - NodeFrcLcl(2) = 0.5*TwrNodeCd*p%Wind%Rho*p%TwrProps%TwrNodeWidth(Node)*RelNmlWndSpd*NodeVelRelLcl(2) - NodeFrcLcl(3) = 0.0 - - - ! Convert the force to global coordinates. - - NodeFrcGbl = MATMUL( TRANSPOSE( NodeDCMGbl ), NodeFrcLcl ) - - -! Temporarily set the returned force to zero until we figure why the forces are not being applied correctly. -!NodeFrcGbl(:) = 0.0 - - - RETURN - -END SUBROUTINE TwrAeroLoads -!======================================================================= - - - ! **************************************** - SUBROUTINE VNMOD( P, m, ErrStat, ErrMess, & - J, IBlade, RLOCAL, PSI ) -! SUBROUTINE VNMOD( J, IBlade, RLOCAL, PSI ) - ! applies the skewed wake correction - ! to the axial induction factor A. - ! **************************************** -!USE Blade -!USE Element -!USE Wind - IMPLICIT NONE - ! Passed Variables: - TYPE(AD14_ParameterType), INTENT(IN) :: p ! Parameters - TYPE(AD14_MiscVarType), INTENT(INOUT) :: m ! Misc/optimization variables - INTEGER, INTENT(OUT) :: ErrStat - CHARACTER(*), INTENT(OUT) :: ErrMess - - ! Passed Variables: - - REAL(ReKi),INTENT(IN) :: PSI - REAL(ReKi),INTENT(IN) :: RLOCAL - - INTEGER, INTENT(IN) :: J - INTEGER, INTENT(IN) :: IBlade - - ! Local Variables: - - REAL(ReKi) :: BB - REAL(ReKi) :: SANG - - - ErrStat = ErrID_None - ErrMess = "" - -SANG = SIN( m%Wind%ANGFLW ) -BB = 0.7363 * SQRT( ( 1. - SANG )/(1. + SANG) ) - -m%Element%A(J,IBLADE) = m%Element%A(J,IBLADE) * ( 1. + 2. * RLOCAL/P%Blade%R * BB * & - ( m%Wind%SDEL * SIN( PSI ) + m%Wind%CDEL * COS( PSI ) ) ) - - - -RETURN -END SUBROUTINE VNMOD - - - ! ********************************************************** - SUBROUTINE BEDINIT( P, m, ErrStat, ErrMess, & - J, IBlade, ALPHA ) -! SUBROUTINE BEDINIT( J, IBlade, ALPHA ) - ! calculates initial values of Beddoes 'f' arrays - ! ********************************************************** -!USE Airfoil -!USE Beddoes - IMPLICIT NONE - ! Passed Variables: - TYPE(AD14_ParameterType), INTENT(IN) :: p ! Parameters - TYPE(AD14_MiscVarType), INTENT(INOUT) :: m ! Misc/optimization variables - INTEGER, INTENT(OUT) :: ErrStat - CHARACTER(*), INTENT(OUT) :: ErrMess - - ! Passed Variables: - REAL(ReKi),INTENT(INOUT) :: ALPHA - - INTEGER, INTENT(IN) :: J - INTEGER, INTENT(IN) :: IBlade - - - ! Local Variables: - - REAL(ReKi) :: AOL1 - REAL(ReKi) :: CNA1 - REAL(ReKi) :: FSPA - REAL(ReKi) :: FSPB - REAL(ReKi) :: FSPCA - REAL(ReKi) :: FSPCB - REAL(ReKi) :: P0 - REAL(ReKi) :: P1 - REAL(ReKi) :: P2 - REAL(ReKi) :: SRFP - REAL(ReKi) :: TEMP - - INTEGER :: I - INTEGER :: I1 - INTEGER :: I1P1 - INTEGER :: I2 - INTEGER :: I2P1 - INTEGER :: N - INTEGER :: NP1 - - ErrStat = ErrID_None - ErrMess = "" - -m%Beddoes%ANE(J,IBLADE) = ALPHA -m%Beddoes%AFE(J,IBLADE) = ALPHA - -I = P%AirFoil%NFOIL(J) - -IF ( P%AirFoil%NTables(I) > 1 ) THEN - m%AirFoil%MulTabLoc = MIN( MAX( m%AirFoil%MulTabLoc, P%AirFoil%MulTabMet(I,1) ), P%AirFoil%MulTabMet(I,P%AirFoil%NTables(I)) ) - CALL LocateBin( m%AirFoil%MulTabLoc, P%AirFoil%MulTabMet(I,1:P%AirFoil%NTables(I)), N, P%AirFoil%NTables(I) ) - - IF (N == 0 ) THEN - CNA1 = m%Beddoes%CNA(I,1) - AOL1 = m%Beddoes%AOL(I,1) - ELSE IF( N == P%AirFoil%NTables(I) ) THEN - CNA1 = m%Beddoes%CNA(I,N) - AOL1 = m%Beddoes%AOL(I,N) - ELSE - NP1 = N+1 - P0 = (m%AirFoil%MulTabLoc-P%AirFoil%MulTabMet(I,N))/(P%AirFoil%MulTabMet(I,NP1)-P%AirFoil%MulTabMet(I,N)) - CNA1 = m%Beddoes%CNA(I,N) + P0 * ( m%Beddoes%CNA(I,NP1) - m%Beddoes%CNA(I,N) ) - AOL1 = m%Beddoes%AOL(I,N) + P0 * ( m%Beddoes%AOL(I,NP1) - m%Beddoes%AOL(I,N) ) - END IF -ELSE - CNA1 = m%Beddoes%CNA(I,1) - AOL1 = m%Beddoes%AOL(I,1) -ENDIF - -m%Beddoes%CNPOT(J,IBLADE) = CNA1 * (ALPHA - AOL1) -m%Beddoes%CNP(J,IBLADE) = m%Beddoes%CNPOT(J,IBLADE) - - -ALPHA = MIN( MAX( ALPHA, m%AirFoil%AL(I,1) ), m%AirFoil%AL(I,P%AirFoil%NLIFT(I)) ) -CALL LocateBin( ALPHA, m%AirFoil%AL(I,1:P%AirFoil%NLIFT(I)), I1, P%AirFoil%NLIFT(I) ) - -IF ( I1 == 0 ) THEN - I1 = 1 - I1P1 = 2 - P1 = 0.0 -ELSEIF ( I1 == P%AirFoil%NLIFT(I) ) THEN - I1P1 = I1 - I1 = I1 - 1 - P1 = 1.0 -ELSE - I1P1 = I1 + 1 - !bjj: check for division by zero? - P1 = ( m%AirFoil%AL(I,I1) - ALPHA ) / ( m%AirFoil%AL(I,I1) - m%AirFoil%AL(I,I1P1) ) -ENDIF - - -IF ( P%AirFoil%NTables(I) > 1 ) THEN - - ! Locate the multiple airfoil table position in the table - - - m%AirFoil%MulTabLoc = MIN( MAX( m%AirFoil%MulTabLoc, P%AirFoil%MulTabMet(I,1) ), P%AirFoil%MulTabMet(I,P%AirFoil%NTables(I)) ) - CALL LocateBin( m%AirFoil%MulTabLoc, P%AirFoil%MulTabMet(I,1:P%AirFoil%NTables(I)), I2, P%AirFoil%NTables(I) ) - - IF ( I2 == 0 ) THEN - I2P1 = 2 - I2 = 1 - P2 = 0.0 - ELSE IF( I2 == P%AirFoil%NTables(I) ) THEN - I2P1 = I2 - I2 = I2 - 1 - P2 = 1.0 - ELSE - I2P1 = I2 + 1 - P2 = (m%AirFoil%MulTabLoc-P%AirFoil%MulTabMet(I,I2))/(P%AirFoil%MulTabMet(I,I2P1)-P%AirFoil%MulTabMet(I,I2)) - ENDIF - - ! Interpolate the F-table values - - FSPB = m%Beddoes%FTB( I,I1,I2P1) - (m%Beddoes%FTB( I,I1,I2P1) - m%Beddoes%FTB( I,I1P1,I2P1))*P1 - FSPCB = m%Beddoes%FTBC(I,I1,I2P1) - (m%Beddoes%FTBC(I,I1,I2P1) - m%Beddoes%FTBC(I,I1P1,I2P1))*P1 - FSPA = m%Beddoes%FTB( I,I1,I2 ) - (m%Beddoes%FTB( I,I1,I2 ) - m%Beddoes%FTB( I,I1P1,I2 ))*P1 - FSPCA = m%Beddoes%FTBC(I,I1,I2 ) - (m%Beddoes%FTBC(I,I1,I2 ) - m%Beddoes%FTBC(I,I1P1,I2 ))*P1 - - m%Beddoes%FSP( J,IBLADE) = FSPA + P2 * ( FSPB - FSPA ) - m%Beddoes%FSPC(J,IBLADE) = FSPCA + P2 * ( FSPCB - FSPCA ) - -ELSE - - m%Beddoes%FSP( J,IBLADE) = m%Beddoes%FTB( I,I1,1) - ( m%Beddoes%FTB( I,I1,1) - m%Beddoes%FTB( I,I1P1,1) )*P1 - m%Beddoes%FSPC(J,IBLADE) = m%Beddoes%FTBC(I,I1,1) - ( m%Beddoes%FTBC(I,I1,1) - m%Beddoes%FTBC(I,I1P1,1) )*P1 - -ENDIF - -IF ( ABS( m%Beddoes%AFE(J,IBLADE) - AOL1 ) < 1.E-10 ) THEN - - m%Beddoes%FSP(J,IBLADE) = 1.0 - m%Beddoes%FSPC(J,IBLADE) = 1.0 - -ELSE - - TEMP = 2.*SQRT(ABS(m%Beddoes%FSP(J,IBLADE)/(m%Beddoes%AFE(J,IBLADE)-AOL1)))-1. - m%Beddoes%FSP(J,IBLADE) = TEMP * TEMP * SIGN ( 1.0_ReKi, TEMP ) - IF ( m%Beddoes%FSP(J,IBLADE) > 1.0 ) m%Beddoes%FSP(J,IBLADE) = 1.0 - IF ( m%Beddoes%FSP(J,IBLADE) < -1.0 ) m%Beddoes%FSP(J,IBLADE) = -1.0 - - IF ( ABS( m%Beddoes%AFE(J,IBLADE) ) < 1.E-10 ) THEN - m%Beddoes%FSPC(J,IBLADE) = 1.0 - ELSE - TEMP = m%Beddoes%FSPC(J,IBLADE)/((m%Beddoes%AFE(J,IBLADE)-AOL1)*m%Beddoes%AFE(J,IBLADE)) - m%Beddoes%FSPC(J,IBLADE) = TEMP * TEMP * SIGN ( 1.0_ReKi, TEMP ) - IF ( m%Beddoes%FSPC(J,IBLADE) > 1.0 ) m%Beddoes%FSPC(J,IBLADE) = 1.0 - IF ( m%Beddoes%FSPC(J,IBLADE) < -1.0 ) m%Beddoes%FSPC(J,IBLADE) = -1.0 - ENDIF - -ENDIF - -SRFP = SQRT( ABS( m%Beddoes%FSP(J,IBLADE) ) ) * SIGN( 1.0_ReKi, m%Beddoes%FSP(J,IBLADE) ) + 1. -m%Beddoes%FK = 0.25 * SRFP * SRFP -m%Beddoes%CVN(J,IBLADE) = m%Beddoes%CNPOT(J,IBLADE) * ( 1. - m%Beddoes%FK ) - -RETURN -END SUBROUTINE BEDINIT - - - ! ***************************************************** - SUBROUTINE BedUpdate( m ) - ! Update old Beddoes parameters at new time step - ! ***************************************************** -!USE Beddoes - IMPLICIT NONE - TYPE(AD14_MiscVarType), INTENT(INOUT) :: m ! Misc/optimization variables - -m%Beddoes%ANE1 = m%Beddoes%ANE -m%Beddoes%ADOT1 = m%Beddoes%ADOT -m%Beddoes%OLDXN = m%Beddoes%XN -m%Beddoes%OLDYN = m%Beddoes%YN -m%Beddoes%CNPOT1 = m%Beddoes%CNPOT -m%Beddoes%OLDDPP = m%Beddoes%DPP -m%Beddoes%FSP1 = m%Beddoes%FSP -m%Beddoes%FSPC1 = m%Beddoes%FSPC -m%Beddoes%OLDTAU = m%Beddoes%TAU -m%Beddoes%OLDDF = m%Beddoes%DF -m%Beddoes%OLDDFC = m%Beddoes%DFC -m%Beddoes%OLDDN = m%Beddoes%DN -m%Beddoes%OLDCNV = m%Beddoes%CNV -m%Beddoes%CVN1 = m%Beddoes%CVN -m%Beddoes%CNP1 = m%Beddoes%CNP -m%Beddoes%CNPD1 = m%Beddoes%CNPD -m%Beddoes%OLDSEP = m%Beddoes%BEDSEP -m%Beddoes%QX1 = m%Beddoes%QX -m%Beddoes%OLDDQ = m%Beddoes%DQ -m%Beddoes%AFE1 = m%Beddoes%AFE -m%Beddoes%DQP1 = m%Beddoes%DQP -m%Beddoes%DFAFE1 = m%Beddoes%DFAFE - - -RETURN -END SUBROUTINE BedUpdate - - - ! ***************************************************** - SUBROUTINE BEDDAT ( P, x, xd, z, m, y, ErrStat, ErrMess ) - ! USED TO INPUT PARAMETERS FOR THE - ! Beddoes DYNAMIC STALL MODEL - ! ***************************************************** -!USE Airfoil -!USE Beddoes -!USE Switch - IMPLICIT NONE - ! Passed Variables: - TYPE(AD14_ParameterType), INTENT(INOUT) :: p ! Parameters - TYPE(AD14_ContinuousStateType), INTENT(INOUT) :: x ! Initial continuous states - TYPE(AD14_DiscreteStateType), INTENT(INOUT) :: xd ! Initial discrete states - TYPE(AD14_ConstraintStateType), INTENT(INOUT) :: z ! Initial guess of the constraint states - TYPE(AD14_MiscVarType), INTENT(INOUT) :: m ! Misc/optimization variables - TYPE(AD14_OutputType), INTENT(INOUT) :: y ! Initial system outputs (outputs are not calculated; - INTEGER, INTENT(OUT) :: ErrStat - CHARACTER(*), INTENT(OUT) :: ErrMess - - ! Local Variables: - - REAL(ReKi) :: ETA - REAL(ReKi) :: CA - REAL(ReKi) :: SA - - INTEGER :: I - INTEGER :: J - INTEGER :: K - - - ErrStat = ErrID_None - ErrMess = "" - - ! Empirical constants for the Beddoes model - - ! TVL = Non-dimensional time of transit for the - ! vortex moving across the airfoil surface - ! TP = Time constant for pressure lag - ! TV = Time constant for strength of shed vortex - ! TF = Time constant applied to location of - ! the separation point - ! AS = Speed of sound for Mach number calculation - -P%Beddoes%TVL = 11.0 -P%Beddoes%TP = 1.7 -P%Beddoes%TV = 6.0 -P%Beddoes%TF = 3.0 -ETA = .99 !bjj: this doesn't seem to be used for anything.... - -IF ( P%SIUNIT ) THEN - ! SI UNITS--m/sec - P%Beddoes%AS = 335. -ELSE - ! ENGLISH UNITS--ft/sec - P%Beddoes%AS = 1100. -ENDIF - - ! Generate table of F values from airfoil data table - -DO J =1,P%AirFoil%NUMFOIL - DO K =1,P%AirFoil%NTables(J) - DO I = 1, P%AirFoil%NLIFT(J) - - CA = COS( m%AirFoil%AL(J,I) ) - SA = SIN( m%AirFoil%AL(J,I) ) - m%Beddoes%CN = m%AirFoil%CL(J,I,K) * CA + ( m%AirFoil%CD(J,I,K) - m%Beddoes%CDO(J,K) ) * SA - m%Beddoes%CC = m%AirFoil%CL(J,I,K) * SA - ( m%AirFoil%CD(J,I,K) - m%Beddoes%CDO(J,K) ) * CA - - IF ( ABS( m%Beddoes%CNA(J,K) ) .GT. 1.E-6 ) THEN - m%Beddoes%FTB(J,I,K) = m%Beddoes%CN / m%Beddoes%CNA(J,K) - m%Beddoes%FTBC(J,I,K) = m%Beddoes%CC / m%Beddoes%CNA(J,K) - ELSE - m%Beddoes%FTB(J,I,K) = 1.0 - m%Beddoes%FTBC(J,I,K) = 1.0 - ENDIF - - END DO !I - END DO !K -END DO !J - -m%Beddoes%VOR = .FALSE. -m%Beddoes%SHIFT = .FALSE. - -m%Beddoes%BEDSEP = .FALSE. -m%Beddoes%ANE1 = 0. -m%Beddoes%OLDCNV = 0. -m%Beddoes%CVN1 = 0. -m%Beddoes%CNPOT1 = 0. -m%Beddoes%CNP1 = 0. -m%Beddoes%CNPD1 = 0. -m%Beddoes%OLDDF = 0. -m%Beddoes%OLDDFC = 0. -m%Beddoes%OLDDPP = 0. -m%Beddoes%FSP1 = 0. -m%Beddoes%FSPC1 = 0. -m%Beddoes%TAU = 0. -m%Beddoes%OLDTAU = 0. -m%Beddoes%OLDXN = 0. -m%Beddoes%OLDYN = 0. - -RETURN -END SUBROUTINE BEDDAT - - - ! ****************************************************** - SUBROUTINE BeddoesModel( P, m, ErrStat, ErrMess, & - W2, J, IBlade, ALPHA, CLA, CDA ,CMA ) - ! uses the Beddoes dynamic stall model - ! the routine is entered with an angle of attack - ! and returns CL, CD, and CM. - ! This routine is used regardless of whether the element - ! is actually in dynamic stall state. - ! - ! VARIABLES: - ! W2 = Relative velocity squared over blade element - ! J = Index which identifies the blade element - ! ALPHA = Angle of attack in radians - ! CLA = Lift coeff. which is calculated by the routine - ! CDA = Drag coeff. which is calculated by the routine - ! CMA = Moment coeff. which is calculated by the routine - ! ****************************************************** - - IMPLICIT NONE - ! Passed Variables: - TYPE(AD14_ParameterType), INTENT(IN) :: p ! Parameters - TYPE(AD14_MiscVarType), INTENT(INOUT) :: m ! Misc/optimization variables - INTEGER, INTENT(OUT) :: ErrStat - CHARACTER(*), INTENT(OUT) :: ErrMess - - ! Passed Variables: - REAL(ReKi),INTENT(IN) :: ALPHA - REAL(ReKi),INTENT(OUT) :: CDA - REAL(ReKi),INTENT(OUT) :: CLA - REAL(ReKi),INTENT(OUT) :: CMA - REAL(ReKi),INTENT(IN) :: W2 - - INTEGER, INTENT(IN) :: J - INTEGER, INTENT(IN) :: IBlade - - ! Local Variables: - - REAL(ReKi) :: AE - REAL(ReKi) :: AOD1 - REAL(ReKi) :: AOL1 - REAL(ReKi) :: CA - REAL(ReKi) :: CDO1 - REAL(ReKi) :: CNA1 - REAL(ReKi) :: CNS1 - REAL(ReKi) :: CNSL1 - REAL(ReKi) :: P1 - REAL(ReKi) :: SA - REAL(ReKi) :: VREL - - INTEGER :: I - INTEGER :: N - INTEGER :: NP1 - - INTEGER :: ErrStatLcL ! Error status returned by called routines. - CHARACTER(ErrMsgLen) :: ErrMessLcl ! Error message returned by called routines. - - ErrStat = ErrID_None - ErrMess = "" - - ! Check to see if element has multiple airfoil tables, then interpolate values - ! of constants based on the current location. - -I = P%AirFoil%NFOIL(J) - -IF (P%AirFoil%NTables(I) > 1)THEN - - m%AirFoil%MulTabLoc = MIN( MAX( m%AirFoil%MulTabLoc, P%AirFoil%MulTabMet(I,1) ), P%AirFoil%MulTabMet(I,P%AirFoil%NTables(I)) ) - CALL LocateBin( m%AirFoil%MulTabLoc, P%AirFoil%MulTabMet(I,1:P%AirFoil%NTables(I)), N, P%AirFoil%NTables(I) ) - - IF ( N == 0 ) THEN - CNA1 = m%Beddoes%CNA( I,1) - AOL1 = m%Beddoes%AOL( I,1) - CNS1 = m%Beddoes%CNS( I,1) - CNSL1 = m%Beddoes%CNSL(I,1) - AOD1 = m%Beddoes%AOD( I,1) - CDO1 = m%Beddoes%CDO( I,1) - ELSE IF ( N == P%AirFoil%NTables(I) ) THEN - CNA1 = m%Beddoes%CNA( I,N) - AOL1 = m%Beddoes%AOL( I,N) - CNS1 = m%Beddoes%CNS( I,N) - CNSL1 = m%Beddoes%CNSL(I,N) - AOD1 = m%Beddoes%AOD( I,N) - CDO1 = m%Beddoes%CDO( I,N) - ELSE - NP1 = N+1 - !bjj: check for division by zero? - P1 = (m%AirFoil%MulTabLoc-P%AirFoil%MulTabMet(I,N))/(P%AirFoil%MulTabMet(I,NP1)-P%AirFoil%MulTabMet(I,N)) - - CNA1 = m%Beddoes%CNA(I,N) + P1 * ( m%Beddoes%CNA(I,NP1) - m%Beddoes%CNA(I,N) ) - AOL1 = m%Beddoes%AOL(I,N) + P1 * ( m%Beddoes%AOL(I,NP1) - m%Beddoes%AOL(I,N) ) - CNS1 = m%Beddoes%CNS(I,N) + P1 * ( m%Beddoes%CNS(I,NP1) - m%Beddoes%CNS(I,N) ) - CNSL1 = m%Beddoes%CNSL(I,N)+ P1 * ( m%Beddoes%CNSL(I,NP1)- m%Beddoes%CNSL(I,N)) - AOD1 = m%Beddoes%AOD(I,N) + P1 * ( m%Beddoes%AOD(I,NP1) - m%Beddoes%AOD(I,N) ) - CDO1 = m%Beddoes%CDO(I,N) + P1 * ( m%Beddoes%CDO(I,NP1) - m%Beddoes%CDO(I,N) ) - END IF - -ELSE - CNA1 = m%Beddoes%CNA(I,1) - AOL1 = m%Beddoes%AOL(I,1) - CNS1 = m%Beddoes%CNS(I,1) - CNSL1 = m%Beddoes%CNSL(I,1) - AOD1 = m%Beddoes%AOD(I,1) - CDO1 = m%Beddoes%CDO(I,1) -ENDIF - - ! Jump back if lift-curve slope is zero - -IF ( EqualRealNos(CNA1, 0.0_ReKi) ) THEN - CLA = 0.0 - CDA = CDO1 - CMA = 0.0 - RETURN -ENDIF - -m%Beddoes%AN = ALPHA -VREL = SQRT( W2 ) - -CALL ATTACH( P, m, ErrStatLcl, ErrMessLcl, VREL, J, IBlade, CNA1, AOL1, AE ) - CALL SetErrStat ( ErrStatLcl, ErrMessLcl, ErrStat,ErrMess,'BeddoesModel' ) - IF (ErrStat >= AbortErrLev) RETURN - - -CALL SEPAR( P, m, ErrStatLcl, ErrMessLcl, P%AirFoil%NLIFT(I), J, IBlade, I, CNA1, AOL1, CNS1, CNSL1 ) - CALL SetErrStat ( ErrStatLcl, ErrMessLcl, ErrStat,ErrMess,'BeddoesModel' ) - IF (ErrStat >= AbortErrLev) RETURN - -CALL VORTEX( P, m, ErrStatLcl, ErrMessLcl, J, IBlade, AE ) - CALL SetErrStat ( ErrStatLcl, ErrMessLcl, ErrStat,ErrMess,'BeddoesModel' ) - IF (ErrStat >= AbortErrLev) RETURN - -CA = COS( m%Beddoes%AN ) -SA = SIN( m%Beddoes%AN ) -CLA = m%Beddoes%CN * CA + m%Beddoes%CC * SA -CDA = m%Beddoes%CN * SA - m%Beddoes%CC * CA + CDO1 -CMA = m%AirFoil%PMC - -RETURN -END SUBROUTINE BeddoesModel - - - ! ****************************************************** - SUBROUTINE ATTACH( P, m, ErrStat, ErrMess, & - VREL, J, IBlade, CNA1, AOL1, AE ) - ! PART OF THE Beddoes DYNAMIC STALL MODEL. - ! ****************************************************** - - IMPLICIT NONE - ! Passed Variables: - TYPE(AD14_ParameterType), INTENT(IN) :: p ! Parameters - TYPE(AD14_MiscVarType), INTENT(INOUT) :: m ! Misc/optimization variables - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMess - - REAL(ReKi), INTENT( OUT) :: AE - REAL(ReKi), INTENT(IN) :: AOL1 - REAL(ReKi), INTENT(IN) :: CNA1 - REAL(ReKi), INTENT(IN) :: VREL - - INTEGER, INTENT(IN) :: J - INTEGER, INTENT(IN) :: IBlade - - ! Local Variables: - - REAL(ReKi) :: B2 - REAL(ReKi) :: BS - REAL(ReKi) :: CNI - REAL(ReKi) :: CNQ - REAL(ReKi) :: CO - REAL(ReKi) :: DA - REAL(ReKi) :: PRP - REAL(ReKi) :: X0 - REAL(ReKi) :: XKA - REAL(ReKi) :: XM - - - ErrStat = ErrID_None - ErrMess = "" - -IF ( ABS( m%Beddoes%AN ) <= PIBY2 ) THEN - m%Beddoes%ANE(J,IBLADE) = m%Beddoes%AN -ELSEIF ( m%Beddoes%AN > PiBy2 ) THEN - m%Beddoes%ANE(J,IBLADE) = PI - m%Beddoes%AN -ELSE - m%Beddoes%ANE(J,IBLADE) = - PI - m%Beddoes%AN -ENDIF - - -XM = VREL / p%Beddoes%AS - - ! Check to see that the element is not supersonic -IF ( .NOT. m%SuperSonic .AND. XM >= 1.0 ) THEN - XM = 0.7 - m%SuperSonic = .TRUE. - ErrMess = 'ATTACH: Blade #'//TRIM(Int2LStr(IBLADE))//' element #'//TRIM(Int2LStr(J))//' is supersonic! '//& - ' Other elements are likely supersonic as well. Supersonic mach nos. will be set to '//& - TRIM(Num2LStr(XM))//' to attempt continuation.' - ErrStat = ErrID_Warn -ELSEIF (m%SuperSonic .AND. XM < 1.0) THEN - m%SuperSonic = .FALSE. - ErrMess = 'ATTACH: Supersonic condition has subsided with Blade #'// TRIM(Int2LStr(IBLADE))// & - ' element #'//TRIM(Int2LStr(J))//'.' - ErrStat = ErrID_Info -ENDIF -IF (ErrStat >= AbortErrLev) RETURN - -B2 = 1.0 - XM * XM -m%Beddoes%DS = 2. * m%DT * VREL/p%Blade%C(J) -BS = B2 * m%Beddoes%DS -XKA = .75/( ( 1. - XM ) + PI * B2 * XM * XM * 0.413 ) -X0 = m%DT * p%Beddoes%AS / p%Blade%C(J) / XKA -CO = XKA * p%Blade%C(J) / p%Beddoes%AS / XM - -DA = m%Beddoes%ANE(J,IBLADE) - m%Beddoes%ANE1(J,IBLADE) -m%Beddoes%ADOT(J,IBLADE) = DA / m%DT - -PRP = m%Beddoes%ADOT(J,IBLADE) * p%Blade%C(J) / VREL -PRP = SAT( PRP, 0.03_ReKi, 0.1_ReKi ) -m%Beddoes%ADOT(J,IBLADE) = PRP * VREL / p%Blade%C(J) - -m%Beddoes%DN(J,IBLADE) = m%Beddoes%OLDDN(J,IBLADE) * EXP(-X0) + & - (m%Beddoes%ADOT(J,IBLADE) - m%Beddoes%ADOT1(J,IBLADE)) * EXP(-.5*X0) -CNI = 4._ReKi * CO * ( m%Beddoes%ADOT(J,IBLADE) - m%Beddoes%DN(J,IBLADE) ) -m%Beddoes%CMI = -.25_ReKi * CNI - -m%Beddoes%QX(J,IBLADE) = (m%Beddoes%ADOT(J,IBLADE) - m%Beddoes%ADOT1(J,IBLADE)) * P%Blade%C(J)/VREL/m%DT -m%Beddoes%DQ(J,IBLADE) = m%Beddoes%OLDDQ(J,IBLADE)*EXP(-X0) + & - ( m%Beddoes%QX(J,IBLADE) - m%Beddoes%QX1(J,IBLADE) ) * EXP(-.5*X0) -CNQ = -CO * (m%Beddoes%QX(J,IBLADE) - m%Beddoes%DQ(J,IBLADE)) -m%Beddoes%DQP(J,IBLADE) = m%Beddoes%DQP1(J,IBLADE) * EXP(-X0/XKA) + (m%Beddoes%QX(J,IBLADE) & - - m%Beddoes%QX1(J,IBLADE)) * EXP(-.5*X0/XKA) - -m%Beddoes%CMQ = -.25 * CNQ - (XKA*CO/3.) * (m%Beddoes%QX(J,IBLADE) - m%Beddoes%DQP(J,IBLADE)) - -m%Beddoes%CNIQ = MIN( ABS( CNI+CNQ ), 1.0_ReKi ) * SIGN( 1.0_ReKi, CNI+CNQ ) - -m%Beddoes%XN(J,IBLADE) = m%Beddoes%OLDXN(J,IBLADE)*EXP(-.14*BS) + .3*DA*EXP(-.07*BS) -m%Beddoes%YN(J,IBLADE) = m%Beddoes%OLDYN(J,IBLADE)*EXP(-.53*BS) + .7*DA*EXP(-.265*BS) - -AE = m%Beddoes%ANE(J,IBLADE) - m%Beddoes%YN(J,IBLADE) - m%Beddoes%XN(J,IBLADE) -m%Beddoes%CNCP = CNA1 * ( AE - AOL1 ) -m%Beddoes%CNPOT(J,IBLADE) = m%Beddoes%CNCP + m%Beddoes%CNIQ -m%Beddoes%CC = m%Beddoes%CNPOT(J,IBLADE) * AE - - -RETURN -END SUBROUTINE ATTACH - - - ! ****************************************************** - SUBROUTINE SEPAR( P, m, ErrStat, ErrMess, & - NFT, J, IBlade, IFOIL, CNA1, AOL1, CNS1, CNSL1 ) -! SUBROUTINE SEPAR( NFT, J, IBlade, IFOIL, CNA1, AOL1, CNS1, CNSL1 ) - ! PART OF THE Beddoes DYNAMIC STALL MODEL - ! ****************************************************** - - IMPLICIT NONE - ! Passed Variables: - TYPE(AD14_ParameterType), INTENT(IN) :: p ! Parameters - TYPE(AD14_MiscVarType), INTENT(INOUT) :: m ! Misc/optimization variables - INTEGER, INTENT(OUT) :: ErrStat - CHARACTER(*), INTENT(OUT) :: ErrMess - - REAL(ReKi),INTENT(IN) :: AOL1 - REAL(ReKi),INTENT(IN) :: CNA1 - REAL(ReKi),INTENT(IN) :: CNS1 - REAL(ReKi),INTENT(IN) :: CNSL1 - - INTEGER ,INTENT(IN) :: IFOIL - INTEGER, INTENT(IN) :: J - INTEGER, INTENT(IN) :: IBlade - INTEGER ,INTENT(IN) :: NFT - - ! Local Variables: - - REAL(ReKi) :: AFEP - REAL(ReKi) :: AFF - REAL(ReKi) :: CMPA - REAL(ReKi) :: CMPB - REAL(ReKi) :: FSPA - REAL(ReKi) :: FSPB - REAL(ReKi) :: FSPCA - REAL(ReKi) :: FSPCB - REAL(ReKi) :: P1 - REAL(ReKi) :: P2 - REAL(ReKi) :: SRFP - REAL(ReKi) :: SRFPC - REAL(ReKi) :: TEMP - REAL(ReKi) :: TFE - - INTEGER :: I1 - INTEGER :: I1P1 - INTEGER :: I2 - INTEGER :: I2P1 - - ErrStat = ErrID_None - ErrMess = "" - - -TFE = p%Beddoes%TF -m%Beddoes%DPP(J,IBLADE) = m%Beddoes%OLDDPP(J,IBLADE) * EXP(-m%Beddoes%DS/P%Beddoes%TP) & - + ( m%Beddoes%CNPOT(J,IBLADE) - m%Beddoes%CNPOT1(J,IBLADE) ) * EXP(-.5*m%Beddoes%DS/P%Beddoes%TP) -m%Beddoes%CNP(J,IBLADE) = m%Beddoes%CNPOT(J,IBLADE) - m%Beddoes%DPP(J,IBLADE) -m%Beddoes%CNPD(J,IBLADE) = m%Beddoes%CNP(J,IBLADE) - m%Beddoes%CNP1(J,IBLADE) - - ! USE CNPD to determine if AOA is increasing or decreasing. - ! Vortex lift decays more rapidly for decreasing AOA. - -IF ( m%Beddoes%ANE(J,IBLADE) * m%Beddoes%CNPD(J,IBLADE) < 0. ) THEN - m%Beddoes%SHIFT = .TRUE. -ELSE - m%Beddoes%SHIFT = .FALSE. -ENDIF - -AFF = m%Beddoes%CNP(J,IBLADE)/CNA1 + AOL1 - -IF ( ABS( m%Beddoes%AN ) <= PIBY2 ) THEN - m%Beddoes%AFE(J,IBLADE) = AFF -ELSEIF ( m%Beddoes%AN > PIBY2 ) THEN - m%Beddoes%AFE(J,IBLADE) = PI - AFF -ELSE - m%Beddoes%AFE(J,IBLADE) = -PI - AFF -ENDIF - -CALL MPI2PI ( m%Beddoes%AFE(J,IBLADE) ) - -IF ( ( m%Beddoes%AFE(J,IBLADE) < m%AirFoil%AL(IFOIL,1) ) .OR. & - ( m%Beddoes%AFE(J,IBLADE) > m%AirFoil%AL(IFOIL,p%AirFoil%NLIFT(IFOIL) ) ) ) THEN - ErrMess = 'SEPAR: Angle of attack = '//TRIM(Num2LStr( m%Beddoes%AFE(J,IBLADE)*R2D ))//' is outside table.' - ErrStat = ErrID_Fatal - RETURN -ENDIF - -m%Beddoes%AFE(J,IBLADE) = MIN( MAX( m%Beddoes%AFE(J,IBLADE), m%AirFoil%AL(IFOIL,1) ), m%AirFoil%AL(IFOIL,NFT) ) -CALL LocateBin( m%Beddoes%AFE(J,IBLADE), m%AirFoil%AL(IFOIL,1:NFT), I1, NFT ) - -IF (I1 == 0) THEN - I1 = 1 -ELSE IF ( I1 == NFT ) THEN - I1 = I1 - 1 -END IF - -I1P1 = I1 + 1 - - !bjj: check for division by zero? -P1 = ( m%AirFoil%AL(IFOIL,I1) - m%Beddoes%AFE(J,IBLADE) ) / ( m%AirFoil%AL(IFOIL,I1) - m%AirFoil%AL(IFOIL,I1P1) ) - -IF ( p%AirFoil%NTables(IFOIL) > 1 ) THEN - - ! Locate the multiple airfoil position in the table - - m%AirFoil%MulTabLoc = MIN( MAX( m%AirFoil%MulTabLoc, p%AirFoil%MulTabMet(IFOIL,1) ), p%AirFoil%MulTabMet(IFOIL,p%AirFoil%NTables(IFOIL)) ) - CALL LocateBin( m%AirFoil%MulTabLoc, p%AirFoil%MulTabMet(IFOIL,1:p%AirFoil%NTables(IFOIL)),I2,p%AirFoil%NTables(IFOIL) ) - - IF ( I2 == 0 ) THEN - I2 = 1 - I2P1 = 2 - P2 = 0.0 - ELSE IF ( I2 == p%AirFoil%NTables(IFOIL) ) THEN - I2P1 = I2 - I2 = I2 - 1 - - P2 = 1.0 - ELSE - I2P1 = I2 + 1 - - P2=(m%AirFoil%MulTabLoc-p%AirFoil%MulTabMet(IFOIL,I2))/(p%AirFoil%MulTabMet(IFOIL,I2P1)-p%AirFoil%MulTabMet(IFOIL,I2)) - END IF - - ! Interpolate the F-table values - - - FSPB = m%Beddoes%FTB( IFOIL,I1,I2P1) - (m%Beddoes%FTB( IFOIL,I1,I2P1) - m%Beddoes%FTB( IFOIL,I1P1,I2P1) ) * P1 - FSPCB = m%Beddoes%FTBC(IFOIL,I1,I2P1) - (m%Beddoes%FTBC(IFOIL,I1,I2P1) - m%Beddoes%FTBC(IFOIL,I1P1,I2P1) ) * P1 - FSPA = m%Beddoes%FTB( IFOIL,I1,I2 ) - (m%Beddoes%FTB( IFOIL,I1,I2 ) - m%Beddoes%FTB( IFOIL,I1P1,I2 ) ) * P1 - FSPCA = m%Beddoes%FTBC(IFOIL,I1,I2 ) - (m%Beddoes%FTBC(IFOIL,I1,I2 ) - m%Beddoes%FTBC(IFOIL,I1P1,I2 ) ) * P1 - - m%Beddoes%FSP(J,IBLADE) = FSPA + P2 * (FSPB-FSPA) - - m%Beddoes%FSPC(J,IBLADE)= FSPCA + P2 * (FSPCB-FSPCA) - -ELSE - - m%Beddoes%FSP(J,IBLADE) = m%Beddoes%FTB(IFOIL,I1,1) - (m%Beddoes%FTB(IFOIL,I1,1) - m%Beddoes%FTB(IFOIL,I1P1,1) ) * P1 - - m%Beddoes%FSPC(J,IBLADE)= m%Beddoes%FTBC(IFOIL,I1,1) - (m%Beddoes%FTBC(IFOIL,I1,1) - m%Beddoes%FTBC(IFOIL,I1P1,1) ) * P1 - -ENDIF - -IF ( ABS( m%Beddoes%AFE(J,IBLADE) - AOL1 ) < 1.E-10 ) THEN - m%Beddoes%FSP(J,IBLADE) = 1.0 - m%Beddoes%FSPC(J,IBLADE) = 1.0 -ELSE - TEMP = 2.*SQRT(ABS(m%Beddoes%FSP(J,IBLADE)/(m%Beddoes%AFE(J,IBLADE)-AOL1)))-1. - m%Beddoes%FSP(J,IBLADE) = TEMP * TEMP * SIGN ( 1.0_ReKi, TEMP ) - IF ( m%Beddoes%FSP(J,IBLADE) > 1.0 ) m%Beddoes%FSP(J,IBLADE) = 1.0 - IF ( m%Beddoes%FSP(J,IBLADE) < -1.0 ) m%Beddoes%FSP(J,IBLADE) = -1.0 - - IF ( ABS( m%Beddoes%AFE(J,IBLADE) ) < 1.E-10 ) THEN - m%Beddoes%FSPC(J,IBLADE) = 1.0 - ELSE - TEMP = m%Beddoes%FSPC(J,IBLADE)/((m%Beddoes%AFE(J,IBLADE)-AOL1)*m%Beddoes%AFE(J,IBLADE)) - m%Beddoes%FSPC(J,IBLADE) = TEMP * TEMP * SIGN ( 1.0_ReKi, TEMP ) - IF ( m%Beddoes%FSPC(J,IBLADE) > 1.0 ) m%Beddoes%FSPC(J,IBLADE) = 1.0 - IF ( m%Beddoes%FSPC(J,IBLADE) < -1.0 ) m%Beddoes%FSPC(J,IBLADE) = -1.0 - ENDIF - -ENDIF - -IF ( m%Beddoes%CNP(J,IBLADE) > CNS1 ) m%Beddoes%BEDSEP(J,IBLADE) = .TRUE. -IF ( m%Beddoes%CNP(J,IBLADE) < CNSL1 ) m%Beddoes%BEDSEP(J,IBLADE) = .TRUE. - -IF ( m%Beddoes%BEDSEP(J,IBLADE) ) m%Beddoes%TAU(J,IBLADE) = m%Beddoes%OLDTAU(J,IBLADE) + m%Beddoes%DS/P%Beddoes%TVL - -IF (m%Beddoes%SHIFT) TFE = 1.5*TFE - -m%Beddoes%DF(J,IBLADE) = m%Beddoes%OLDDF(J,IBLADE) * EXP(-m%Beddoes%DS/TFE) & - + (m%Beddoes%FSP(J,IBLADE) - m%Beddoes%FSP1(J,IBLADE)) * EXP(-.5*m%Beddoes%DS/TFE) -m%Beddoes%DFC(J,IBLADE)= m%Beddoes%OLDDFC(J,IBLADE) * EXP(-m%Beddoes%DS/TFE) & - + (m%Beddoes%FSPC(J,IBLADE) - m%Beddoes%FSPC1(J,IBLADE)) * EXP(-.5*m%Beddoes%DS/TFE) - -m%Beddoes%FP = m%Beddoes%FSP(J,IBLADE) - m%Beddoes%DF(J,IBLADE) -m%Beddoes%FPC = m%Beddoes%FSPC(J,IBLADE) - m%Beddoes%DFC(J,IBLADE) -SRFP = SQRT( ABS(m%Beddoes%FP) ) * SIGN( 1.0_ReKi, m%Beddoes%FP ) + 1. -SRFPC= SQRT( ABS(m%Beddoes%FPC) ) * SIGN( 1.0_ReKi,m%Beddoes%FPC ) - -m%Beddoes%FK = 0.25 * SRFP * SRFP -m%Beddoes%CN = m%Beddoes%CNCP * m%Beddoes%FK + m%Beddoes%CNIQ - -m%Beddoes%CC = m%Beddoes%CC * SRFPC - -m%Beddoes%DFAFE(J,IBLADE) = m%Beddoes%DFAFE1(J,IBLADE) * EXP(-m%Beddoes%DS/(.1*TFE)) & - + (m%Beddoes%AFE(J,IBLADE) - m%Beddoes%AFE1(J,IBLADE)) * EXP(-.5*m%Beddoes%DS/(.1*TFE)) - -AFEP=m%Beddoes%AFE(J,IBLADE) - m%Beddoes%DFAFE(J,IBLADE) - - -AFEP = MIN( MAX( AFEP, m%AirFoil%AL(IFOIL,1) ), m%AirFoil%AL(IFOIL,NFT) ) -CALL LocateBin( AFEP, m%AirFoil%AL(IFOIL,1:NFT), I1, NFT ) - -IF (I1 == 0) THEN - I1 = 1 - I1P1 = 2 - P1 = 0.0 -ELSEIF ( I1 == NFT ) THEN - I1P1 = I1 - I1 = I1 - 1 - P1 = 1.0 -ELSE - I1P1 = I1 + 1 - P1 = (m%AirFoil%AL(IFOIL,I1) - AFEP)/(m%AirFoil%AL(IFOIL,I1) - m%AirFoil%AL(IFOIL,I1P1)) -END IF - - -IF (p%AirFoil%NTables(IFOIL) > 1) THEN - - ! Interpolate the F-table values - - CMPB = m%AirFoil%CM(IFOIL,I1,I2P1) - (m%AirFoil%CM(IFOIL,I1,I2P1) - m%AirFoil%CM(IFOIL,I1P1,I2P1) ) * P1 - - CMPA = m%AirFoil%CM(IFOIL,I1,I2) - (m%AirFoil%CM(IFOIL,I1,I2) - m%AirFoil%CM(IFOIL,I1P1,I2) ) * P1 - - m%AirFoil%PMC = CMPA + P2*(CMPB-CMPA) - -ELSE - - m%AirFoil%PMC = m%AirFoil%CM(IFOIL,I1,1) - ( (m%AirFoil%CM(IFOIL,I1,1) - m%AirFoil%CM(IFOIL,I1P1,1) ) * P1 ) - -ENDIF - - - -RETURN -END SUBROUTINE SEPAR - - - ! ****************************************************** - SUBROUTINE VORTEX( P, m, ErrStat, ErrMess, & - J, IBlade, AE ) - ! PART OF THE Beddoes DYNAMIC STALL MODEL - ! ****************************************************** - - IMPLICIT NONE - ! Passed Variables: - TYPE(AD14_ParameterType), INTENT(IN) :: p ! Parameters - TYPE(AD14_MiscVarType), INTENT(INOUT) :: m ! Misc/optimization variables - INTEGER, INTENT(OUT) :: ErrStat - CHARACTER(*), INTENT(OUT) :: ErrMess - - ! Passed Variables: - REAL(ReKi),INTENT(IN) :: AE - - INTEGER, INTENT(IN) :: J - INTEGER, INTENT(IN) :: IBlade - - ! Local Variables: - REAL(ReKi) :: CMV - REAL(ReKi) :: TSH - REAL(ReKi) :: TVE - - ErrStat = ErrID_None - ErrMess = "" - -TVE = P%Beddoes%TV -m%Beddoes%CVN(J,IBLADE) = m%Beddoes%CNCP * ( 1. - m%Beddoes%FK ) - -IF ( m%Beddoes%TAU(J,IBLADE) < 1. ) THEN - m%Beddoes%VOR = .TRUE. - IF (m%Beddoes%SHIFT) m%Beddoes%VOR = .FALSE. -ELSE - m%Beddoes%VOR = .FALSE. -ENDIF - -IF (m%Beddoes%VOR) THEN - m%Beddoes%CNV(J,IBLADE) = m%Beddoes%OLDCNV(J,IBLADE) * EXP(-m%Beddoes%DS/TVE) & - + (m%Beddoes%CVN(J,IBLADE) - m%Beddoes%CVN1(J,IBLADE)) * EXP(-.5*m%Beddoes%DS/TVE) -ELSE - m%Beddoes%CNV(J,IBLADE) = m%Beddoes%OLDCNV(J,IBLADE) * EXP(-m%Beddoes%DS/(TVE*.5)) -ENDIF - -m%Beddoes%CN = m%Beddoes%CN + m%Beddoes%CNV(J,IBLADE) -m%Beddoes%CC = m%Beddoes%CC + m%Beddoes%CNV(J,IBLADE) * AE * (1.- m%Beddoes%TAU(J,IBLADE)) -CMV = -0.2 * (1. - COS(PI*m%Beddoes%TAU(J,IBLADE)) ) * m%Beddoes%CNV(J,IBLADE) -m%AirFoil%PMC = m%AirFoil%PMC + CMV + m%Beddoes%CMI + m%Beddoes%CMQ - -TSH = 2.*(1.- m%Beddoes%FP)/.19 - -IF ( m%Beddoes%TAU(J,IBLADE) .GT. 1. + TSH/p%Beddoes%TVL .AND. .NOT. m%Beddoes%SHIFT) THEN - m%Beddoes%TAU(J,IBLADE) = 0. - m%Beddoes%BEDSEP(J,IBLADE) = .FALSE. -ENDIF - -IF ( m%Beddoes%TAU(J,IBLADE) .GT. 1. ) THEN - IF ( m%Beddoes%ANE(J,IBLADE) .LT. 0. ) THEN - - IF (m%Beddoes%CNPD(J,IBLADE) .LE. 0. .AND. m%Beddoes%CNPD1(J,IBLADE) .GE. 0.) THEN - m%Beddoes%BEDSEP(J,IBLADE) = .FALSE. - m%Beddoes%TAU(J,IBLADE) = 0. - ENDIF - - IF (m%Beddoes%ANE1(J,IBLADE) .GT. 0.) THEN - m%Beddoes%BEDSEP(J,IBLADE) = .FALSE. - m%Beddoes%TAU(J,IBLADE) = 0. - ENDIF - - ELSE - - IF (m%Beddoes%CNPD(J,IBLADE) .GE. 0. .AND. m%Beddoes%CNPD1(J,IBLADE) .LE. 0.) THEN - m%Beddoes%BEDSEP(J,IBLADE) = .FALSE. - m%Beddoes%TAU(J,IBLADE) = 0. - ENDIF - - IF (m%Beddoes%ANE1(J,IBLADE) .LT. 0.) THEN - m%Beddoes%BEDSEP(J,IBLADE) = .FALSE. - m%Beddoes%TAU(J,IBLADE) = 0. - ENDIF - - ENDIF -ENDIF - - - -RETURN -END SUBROUTINE VORTEX - - - ! ****************************************************** - SUBROUTINE CLCD( P, m, ErrStat, ErrMess, & - ALPHA, CLA, CDA, CMA, I ) -! SUBROUTINE CLCD( ALPHA, CLA, CDA, CMA, I, ErrStat ) - ! returns values of lift and drag coeffs. - ! This subroutine interpolates airfoil coefficients - ! from a table of airfoil data. The table must consist - ! of ALPHA, CL and CD over the entire range of angles - ! that will be encountered. - ! - ! VARIABLES: - ! CLA = Returned value of lift coefficient - ! CDA = Returned value of drag coeff - ! CMA = Returned value of pitching moment coeff - ! ALPHA = Angle of attack (radians) - ! AL = Array containing the angle of attack - ! CL = Array containing the lift coeffs. at AL(I) - ! CD = Array containing the drag coeffs. at AL(I) - ! CM = Array containing the moment coeffs. at AL(I) - ! I = Airfoil ID for this element, equal to NFoil(J), where J is the index identifying the blade element - ! MulTabLoc= Multiple airfoil table location for this element - ! MulTabMet= Array containing the multiple airfoil table metric - ! ****************************************************** -!USE Airfoil - IMPLICIT NONE - ! Passed Variables: - TYPE(AD14_ParameterType), INTENT(IN) :: p ! Parameters - TYPE(AD14_MiscVarType), INTENT(INOUT) :: m ! Misc/optimization variables - INTEGER, INTENT(OUT) :: ErrStat - CHARACTER(*), INTENT(OUT) :: ErrMess - - ! Passed Variables: - REAL(ReKi),INTENT(INOUT) :: ALPHA - REAL(ReKi),INTENT(OUT) :: CDA - REAL(ReKi),INTENT(OUT) :: CLA - REAL(ReKi),INTENT(OUT) :: CMA - - INTEGER ,INTENT(IN) :: I ! NFOIL(J) - - ! Local Variables: - - REAL(ReKi) :: CDA1 - REAL(ReKi) :: CDA2 - REAL(ReKi) :: CLA1 - REAL(ReKi) :: CLA2 - REAL(ReKi) :: CMA1 - REAL(ReKi) :: CMA2 - REAL(ReKi) :: P1 - REAL(ReKi) :: P2 - - INTEGER :: N1 - INTEGER :: N1P1 - INTEGER :: N2 - INTEGER :: N2P1 - INTEGER :: NTAB - -ErrStat = ErrID_None -ErrMess = "" - -IF (.NOT. ALLOCATED(P%AirFoil%NFoil) ) THEN - CDA = 0. - CLA = 0. - CMA = 0. - ErrStat = ErrID_Fatal - RETURN -ELSE - ErrStat = ErrID_None -END IF - -NTAB = P%AirFoil%NLIFT(I) - -IF ( ( ALPHA < m%AirFoil%AL(I,1) ) .OR. ( ALPHA > m%AirFoil%AL(I,NTAB) ) ) THEN -!bjj: This error message isn't necessarially accurate: - CDA = 0. - CLA = 0. - CMA = 0. - ErrMess = ' Angle of attack = '//TRIM(Num2LStr(ALPHA*R2D))// & - ' deg is outside data table range. '// & !Blade #'//TRIM(Int2LStr(IBLADE))//& - ' Airfoil '//TRIM(Int2LStr(I))//'.' -! ' element '//TRIM(Int2LStr(J))//'.' ) - - ErrStat = ErrID_Fatal - RETURN -ENDIF - -ALPHA = MIN( MAX( ALPHA, m%AirFoil%AL(I,1) ), m%AirFoil%AL(I,NTAB) ) -CALL LocateBin (ALPHA, m%AirFoil%AL(I,1:NTAB), N1, NTAB ) - -IF (N1 == 0) THEN - N1 = 1 - N1P1 = 2 - P1 = 0.0 -ELSEIF(N1 == NTAB) THEN - N1P1 = N1 - N1 = N1 - 1 - P1 = 1.0 -ELSE - N1P1 = N1 + 1 - P1 = ( ALPHA - m%AirFoil%AL(I, N1) )/( m%AirFoil%AL(I, N1P1) - m%AirFoil%AL(I, N1) ) -END IF - - ! If the element has multiple airfoil tables, do a 2-D linear interpolation - ! for Cl and CD - -IF (P%AirFoil%NTables(I) > 1) THEN - - m%AirFoil%MulTabLoc = MIN( MAX( m%AirFoil%MulTabLoc, P%AirFoil%MulTabMet(I,1) ), P%AirFoil%MulTabMet(I,P%AirFoil%NTables(I)) ) - CALL LocateBin (m%AirFoil%MulTabLoc, P%AirFoil%MulTabMet(I,1:P%AirFoil%NTables(I)),N2,P%AirFoil%NTables(I)) - - IF (N2 == 0) THEN - N2 = 1 - N2P1 = 2 - P2 = 0.0 - ELSE IF ( N2 == P%AirFoil%NTables(I) ) THEN - N2P1 = N2 - N2 = N2 - 1 - P2 = 1.0 - ELSE - N2P1 = N2 + 1 - P2 = (m%AirFoil%MulTabLoc - P%AirFoil%MulTabMet(I,N2))/(P%AirFoil%MulTabMet(I,N2P1)-P%AirFoil%MulTabMet(I,N2)) - END IF - - CLA1 = m%AirFoil%CL(I,N1,N2) + P1 * ( m%AirFoil%CL(I,N1P1,N2) - m%AirFoil%CL(I,N1,N2) ) - CDA1 = m%AirFoil%CD(I,N1,N2) + P1 * ( m%AirFoil%CD(I,N1P1,N2) - m%AirFoil%CD(I,N1,N2) ) - CMA1 = m%AirFoil%CM(I,N1,N2) + P1 * ( m%AirFoil%CM(I,N1P1,N2) - m%AirFoil%CM(I,N1,N2) ) - - CLA2 = m%AirFoil%CL(I,N1,N2P1) + P1 * ( m%AirFoil%CL(I,N1P1,N2P1) - m%AirFoil%CL(I,N1,N2P1) ) - CDA2 = m%AirFoil%CD(I,N1,N2P1) + P1 * ( m%AirFoil%CD(I,N1P1,N2P1) - m%AirFoil%CD(I,N1,N2P1) ) - CMA2 = m%AirFoil%CM(I,N1,N2P1) + P1 * ( m%AirFoil%CM(I,N1P1,N2P1) - m%AirFoil%CM(I,N1,N2P1) ) - - CLA = CLA1 + P2 * ( CLA2 - CLA1 ) - CDA = CDA1 + P2 * ( CDA2 - CDA1 ) - CMA = CMA1 + P2 * ( CMA2 - CMA1 ) - -ELSE - - CLA = m%AirFoil%CL(I,N1,1) + P1 * ( m%AirFoil%CL(I,N1P1,1) - m%AirFoil%CL(I,N1,1) ) - CDA = m%AirFoil%CD(I,N1,1) + P1 * ( m%AirFoil%CD(I,N1P1,1) - m%AirFoil%CD(I,N1,1) ) - CMA = m%AirFoil%CM(I,N1,1) + P1 * ( m%AirFoil%CM(I,N1P1,1) - m%AirFoil%CM(I,N1,1) ) - -ENDIF - - -RETURN -END SUBROUTINE CLCD - - ! ************************************************** - FUNCTION SAT( X, VAL, SLOPE ) - ! AOA saturation function 02/15/98 - ! ************************************************** - -IMPLICIT NONE - - - ! Passed Variables: - -REAL(ReKi) :: SAT -REAL(ReKi),INTENT(IN) :: SLOPE -REAL(ReKi),INTENT(IN) :: VAL -REAL(ReKi),INTENT(IN) :: X - - -IF ( ABS(X) <= VAL ) THEN - SAT = X -ELSEIF ( X > VAL) THEN - SAT = SLOPE * X + VAL * ( 1. - SLOPE ) -ELSE - SAT = SLOPE * X - VAL * ( 1. - SLOPE ) -ENDIF - - -RETURN -END FUNCTION SAT - - - ! **************** Dynamic Inflow Subroutines *************** - ! - ! Generalized Dynamic Wake (GDW) Model replaced the Pitt & - ! Peters model. - ! A. Suzuki, 06/23/00 - - ! Subroutine VG2ROTOR was added again to v11.31 - ! A. Suzuki, 01/24/00 - - ! - ! Modified for FFWIND. Subroutine VG2ROTOR was added. - ! A. Suzuki, 11/05/99. - - ! This model is based on Pitt & Peters model. - ! AB predictor-corrector is used for integration. - ! A. Suzuki, 07/22/98. - ! - ! ************************************************************* - - ! ************************************** - - SUBROUTINE Inflow( Time, P, m, ErrStat, ErrMess ) - - ! Gateway to the dynamic inflow routines. - ! Called by NEWTIME after a time step. - ! ************************************** - - IMPLICIT NONE - ! Passed Variables: - REAL(DbKi), INTENT(IN) :: Time - TYPE(AD14_ParameterType), INTENT(IN) :: p ! Parameters - TYPE(AD14_MiscVarType), INTENT(INOUT) :: m ! Misc/optimization variables - INTEGER, INTENT(OUT) :: ErrStat - CHARACTER(*), INTENT(OUT) :: ErrMess - - INTEGER :: ErrStatLcL ! Error status returned by called routines. - CHARACTER(ErrMsgLen) :: ErrMessLcl ! Error message returned by called routines. - - ErrStat = ErrID_None - ErrMess = "" - - IF ( P%DYNINFL ) THEN - -! INITIALIZE DYNAMIC INFLOW PARAMETERS - IF ( m%DYNINIT .AND. ( TIME > 0.0D0 ) ) THEN - CALL INFINIT( P, m, ErrStatLcl, ErrMessLcl ) - CALL SetErrStat ( ErrStatLcl, ErrMessLcl, ErrStat,ErrMess,'Inflow' ) - IF (ErrStat >= AbortErrLev) RETURN - !WRITE(*,*) 'Activating dynamic inflow calculation' - m%DynInflow%old_Alph = 0.0 - m%DynInflow%old_Beta = 0.0 - m%DYNINIT = .FALSE. - m%SKEW = .FALSE. - ENDIF - - ! Update the dynamic inflow parameters - CALL INFUPDT(P, m, ErrStatLcl, ErrMessLcl) - CALL SetErrStat ( ErrStatLcl, ErrMessLcl, ErrStat,ErrMess,'Inflow' ) - IF (ErrStat >= AbortErrLev) RETURN - - CALL GetPhiLq(P, m, ErrStatLcl, ErrMessLcl) - CALL SetErrStat ( ErrStatLcl, ErrMessLcl, ErrStat,ErrMess,'Inflow' ) - IF (ErrStat >= AbortErrLev) RETURN - - ! Calculate the dynamic inflow paremeters for the new time step - IF( TIME > 1.0D0 ) THEN - CALL INFDIST(P, m, ErrStatLcl, ErrMessLcl) - CALL SetErrStat ( ErrStatLcl, ErrMessLcl, ErrStat,ErrMess,'Inflow' ) - IF (ErrStat >= AbortErrLev) RETURN - END IF - - ENDIF ! DYNINFL - -RETURN -END SUBROUTINE Inflow - - - ! ************************************** - - SUBROUTINE GetRM ( P, m, ErrStat, ErrMess, & - rLocal, DFN, DFT, psi, J, IBlade) - - ! Returns RM(MODE), the [mode]-th moment of the blade normal force. - ! Here, the force is in [N/m], while the moment arm is - ! non-dimensional (RLOCAL/R). Also see FUNCTION XPHI. - ! Called as each element is processed by AeroDyn. - ! ************************************** - IMPLICIT NONE - ! Passed Variables: - TYPE(AD14_ParameterType), INTENT(IN) :: p ! Parameters - TYPE(AD14_MiscVarType), INTENT(INOUT) :: m ! Misc/optimization variables - - REAL(ReKi),INTENT(IN) :: DFN - REAL(ReKi),INTENT(IN) :: DFT - REAL(ReKi),INTENT(IN) :: psi - REAL(ReKi),INTENT(IN) :: rLocal - - INTEGER, INTENT(IN) :: J - INTEGER, INTENT(IN) :: IBlade - INTEGER, INTENT(OUT) :: ErrStat - CHARACTER(*), INTENT(OUT) :: ErrMess - - ! Local Variables: - REAL(ReKi) :: fElem - ! psiBar is Suzuki's, WindPsi is Shawler's - !REAL(ReKi) :: psiBar - REAL(ReKi) :: Rzero - REAL(ReKi) :: WindPsi - - INTEGER :: ErrStatLcL ! Error status returned by called routines. - CHARACTER(ErrMsgLen) :: ErrMessLcl ! Error message returned by called routines. - - - INTEGER :: mode - - ErrStat = ErrID_None - ErrMess = "" - - -IF ( P%SWIRL ) THEN - fElem = SQRT( DFN * DFN + DFT * DFT ) -ELSE - fElem = DFN -ENDIF -fElem = fElem / P%Blade%R - -Rzero = rLocal / P%Blade%R -! Suzukis inflow azimuth measure -!psiBar = - psi - piBy2 -! Shawler: wind based inflow azimuth measure -CALL WindAzimuthZero (psi,m%Wind%VrotorY,m%Wind%VrotorZ,WindPsi) - -! Save values rotor loads for USE in Newtime (to accumulate rotor loads) -DO mode = 1, P%DynInflow%MAXINFLO - m%DynInflow%RMC_SAVE(IBLADE, J, mode) = fElem * XPHI( Rzero, mode, ErrStatLcl, ErrMessLcl ) - CALL SetErrStat ( ErrStatLcl, ErrMessLcl, ErrStat,ErrMess,'GetRM' ) - IF (ErrStat >= AbortErrLev) RETURN -END DO ! mode - -!+++++++++++++++++++++++++++++++++++++++++++++++++++++ -!Suzuki's method -!DO mode = MaxInflo+1, maxInfl -! m%DynInflow%RMC_SAVE(IBLADE, J, mode) = fElem * XPHI( Rzero, mode ) * COS( REAL(MRvector(mode), ReKi) * psiBar ) -! m%DynInflow%RMS_SAVE(IBLADE, J, mode) = fElem * XPHI( Rzero, mode ) * SIN( REAL(MRvector(mode), ReKi) * psiBar ) -!END DO ! mode -! Shawler's method -DO mode = p%DynInflow%MaxInflo+1, maxInfl - m%DynInflow%RMC_SAVE(IBLADE, J, mode) = fElem * XPHI( Rzero, mode, ErrStatLcl, ErrMessLcl ) * COS( REAL(MRvector(mode), ReKi) * WindPsi ) - CALL SetErrStat ( ErrStatLcl, ErrMessLcl, ErrStat,ErrMess,'GetRM' ) - IF (ErrStat >= AbortErrLev) RETURN - - m%DynInflow%RMS_SAVE(IBLADE, J, mode) = fElem * XPHI( Rzero, mode, ErrStatLcl, ErrMessLcl ) * SIN( REAL(MRvector(mode), ReKi) * WindPsi ) - CALL SetErrStat ( ErrStatLcl, ErrMessLcl, ErrStat,ErrMess,'GetRM' ) - IF (ErrStat >= AbortErrLev) RETURN - -END DO ! mode -!++++++++++++++++++++++++++++++++++++++++++++++++++++++ - -RETURN -END SUBROUTINE GetRM - - - ! ************************************** - - SUBROUTINE GetPhiLq( P, m, ErrStat, ErrMess ) - - ! Accumulate the rotor forces for dynamic inflow calculations - ! PhiLqC is Lq times PHI (shape function) in COS equation. - ! PhiLqS is Lq times PHI (shape function) in SIN equation. - ! RM?_SAVE, which were calculated for each element, - ! are summed here after a time step. - ! ************************************** - -!USE Blade -!USE DynInflow -!USE Element - - IMPLICIT NONE - ! Passed Variables: - TYPE(AD14_ParameterType), INTENT(IN) :: p ! Parameters - TYPE(AD14_MiscVarType), INTENT(INOUT) :: m ! Misc/optimization variables - INTEGER, INTENT(OUT) :: ErrStat - CHARACTER(*), INTENT(OUT) :: ErrMess - - - INTEGER :: iblad - INTEGER :: ielem - INTEGER :: mode - - ErrStat = ErrID_None - ErrMess = "" - -m%DynInflow%PhiLqC = 0. -m%DynInflow%PhiLqS = 0. - -DO mode = 1, maxInfl - DO iblad = 1, P%NumBl - DO ielem = 1, P%Element%NELM - m%DynInflow%PhiLqC(mode) = m%DynInflow%PhiLqC(mode) + m%DynInflow%RMC_SAVE(iblad, ielem, mode) - IF (mode >= p%DynInflow%MaxInflo+1) & - m%DynInflow%PhiLqS(mode) = m%DynInflow%PhiLqS(mode) + m%DynInflow%RMS_SAVE(iblad, ielem, mode) - END DO !ielem - END DO !iblad -END DO !mode - -RETURN -END SUBROUTINE GetPhiLq - - - ! ************************************************************* - SUBROUTINE infinit( P, m, ErrStat, ErrMess ) - ! Initializes the variables in the dynamic inflow equation. - ! Called only once to initialize the GDW parameters. - ! ************************************************************* - IMPLICIT NONE - - TYPE(AD14_ParameterType), INTENT(IN) :: p ! Parameters - TYPE(AD14_MiscVarType), INTENT(INOUT) :: m ! Misc/optimization variables - INTEGER, INTENT(OUT) :: ErrStat - CHARACTER(*), INTENT(OUT) :: ErrMess - - ! Local Variables: - - REAL(ReKi) :: tauCos ( maxInfl ) - REAL(ReKi) :: tauSin ( P%DynInflow%MaxInflo+1 : maxInfl ) - REAL(ReKi) :: v1 - REAL(ReKi) :: v2 - REAL(ReKi) :: v3 - REAL(ReKi) :: Vplane2 - - INTEGER :: i - INTEGER :: iElem - INTEGER :: irow - INTEGER :: jBlade - INTEGER :: jcol - INTEGER :: k - INTEGER :: mode - - ErrStat = ErrID_None - ErrMess = "" - - ! Initialize the MRvector & NJVector. - ! MRvector is the azimuthal mode of the inflow distribution. - ! NJvector is the radial mode of the inflow distribution. - -!P%DynInflow%MRVector(:) = (/ 0, 0, 1, 1, 2, 3 /) !bjj why aren't these parameters? Now they are. -!P%DynInflow%NJVector(:) = (/ 1, 3, 2, 4, 3, 4 /) - - ! For your reference, - ! Marray(irow,jcol) = MRvector(jcol) - ! Rarray(irow,jcol) = MRvector(irow) - ! Narray(irow,jcol) = NJvector(jcol) - ! Jarray(irow,jcol) = NJvector(irow) - - ! Initialize the time derivatives. -m%DynInflow%dAlph_dt(:,:) = 0. -m%DynInflow%dBeta_dt(:,:) = 0. - -! ! Set up the constants. -! ! xMinv is [M]^-1. Because [M]^-1 is just a diagonal matrix, -! ! it is stored as a column vector. -!bjj: this is a parameter that we'll set at initialization -!DO irow = 1, maxInfl -! p%DynInflow%xMinv(irow) = PIBY2 / hfunc(MRvector(irow), NJvector(irow)) !bjj: this is really just a parameter, too. -!END DO !irow - - ! Set up the GAMMA matrix which is used to calculate [L] matrix. - ! FUNCTION FGAMMA is called. -DO irow = 1, maxInfl - DO jcol = 1, maxInfl - m%DynInflow%gamma( irow, jcol ) & - = fgamma( MRvector( irow ), NJvector( irow ), & - MRvector( jcol ), NJvector( jcol ) ) !bjj: this is really just a parameter, too. - END DO !jcol -END DO !irow - - ! calculate and store the M-R matrices, which are used in Subroutine LMATRIX. -DO irow = 1, maxInfl - DO jcol = 1, maxInfl - m%DynInflow%MminR (irow,jcol) = MIN( MRvector(jcol) , MRvector(irow) ) - m%DynInflow%MplusR (irow,jcol) = MRvector(jcol) + MRvector(irow) - m%DynInflow%MminusR(irow,jcol) = ABS( MRvector(jcol) - MRvector(irow) ) - END DO !jcol -END DO !irow - - ! Calculate the tip speed of the rotor. This isn't constant in ADAMS. - ! Thus, it will be updated at every time step in ADAMS. -m%DynInflow%TipSpeed = MAX(P%Blade%r * m%Rotor%revs, 1.0e-6_ReKi) - - ! Calculate the disk loading normalization factor. - ! This is not exactly pressure but let's call it P0. - ! The actual unit is [N/m] or [Pa*m]. - ! Pzero = PI * AirDensity * (Rotational Speed)^2 * (Radius)^3 - ! Pzero = pi * rho * revs**2 * P%Blade%r**3 - ! Pzero = pi * rho * revs * revs * P%Blade%r * P%Blade%r * P%Blade%r -m%DynInflow%Pzero = pi * p%Wind%rho * m%DynInflow%TipSpeed * m%DynInflow%TipSpeed * P%Blade%r - ! Non-dimensional time -m%DynInflow%DTO = m%DT * m%Rotor%REVS !bjj: this isn't used in this subroutine? - - ! Calculate the initial values of inflow distribution parameters - - ! Calculate the non-dimensional wind velocity components. - -v1 = m%Wind%VrotorZ / m%DynInflow%TipSpeed !inplane, upward -v2 = m%Wind%VrotorY / m%DynInflow%TipSpeed !inplane, right looking downwind -v3 = - m%Wind%VrotorX / m%DynInflow%TipSpeed !out-of-plane, normal to the rotor - - ! Calculate the initial value of lambda_m by taking the average - ! of the induction factors(A). The A's are calculated by - ! momentum balance during the first rotation of the trim solution. -m%DynInflow%xLambda_M = 0. -DO jBlade=1,P%NumBl - DO iElem =1,P%Element%nelm - m%DynInflow%xLambda_M = m%DynInflow%xLambda_M + m%Element%a(iElem,jBlade) - END DO !iElem -END DO !jBlade -m%DynInflow%xLambda_M = m%DynInflow%xLambda_M / ( P%NumBl * P%Element%nelm ) - - ! A's are normalized by the normal wind speed, while Lambda's are - ! mormalized by the tip speed. Make the conversion. - ! xLambda_M = xLambda_M * (-VrotorX/TipSpeed) -m%DynInflow%xLambda_M = m%DynInflow%xLambda_M * v3 - - ! totalInf is the non-dimensional total wind speed normal to the rotor. -m%DynInflow%totalInf = - v3 + m%DynInflow%xLambda_M - ! Vplane2 is the square of in-plane component of the non-dimensional - ! wind velocity. -Vplane2 = v1 * v1 + v2 * v2 - ! VTOTAL is the total wind speed at the rotor. -m%DynInflow%Vtotal = SQRT( m%DynInflow%totalInf * m%DynInflow%totalInf + Vplane2 ) - ! VPARAM is the velocity parameter. -m%DynInflow%Vparam =( Vplane2 + ( m%DynInflow%totalInf + m%DynInflow%old_LmdM ) * m%DynInflow%totalInf ) / m%DynInflow%Vtotal - - ! Calculate the disk skew angle function using the effective disk angle - ! of attack. - !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - ! Shawler - USE the single wake skew angle, squared variable means its always positive - ! and because blade azimuth position is measured using windpsi the wake skew - ! is defined in the right direction relative to the oncoming wind, - ! ie directly downwind. - !Suzuki: -!xKaiC = TAN( .5 * ATAN( -v2 / totalInf ) ) -!xKaiS = TAN( .5 * ATAN( v1 / totalInf ) ) - !xkai = TAN( .5 * SIGN( ATAN( SQRT( vplane2 ) / totalInf ), v2 ) ) - !Shawler: -m%DynInflow%xkai = TAN( .5 * ATAN( SQRT( Vplane2 ) / m%DynInflow%totalInf ) ) - !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - - ! To calculate the initial values of xAlpha & xBeta, get [L] matrices - !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - ! Suzuki: -!CALL LMATRIX ( m,p,xKaiC, 1 ) -!CALL LMATRIX ( m,p,xKaiS, 2 ) - ! Shawler: -CALL LMATRIX ( m,p, 1, ErrStat, ErrMess ) - IF (ErrStat /= ErrID_None) THEN - ErrMess='infinit:'//TRIM(ErrMess) - RETURN - END IF -CALL LMATRIX ( m,p, 2, ErrStat, ErrMess ) - IF (ErrStat /= ErrID_None) THEN - ErrMess='infinit:'//TRIM(ErrMess) - RETURN - END IF - -! CALL LMATRIX ( xkai ) - ! Here we need [L_cos] & [L_sin], not [L_***}^-1. - !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - - ! Get TAU's (pressure coefficient). Refer to Subroutine INFDIST. -DO mode = 1, P%DynInflow%MaxInflo - tauCos(mode) = - m%DynInflow%PhiLqC(mode) / m%DynInflow%Pzero * .5 -END DO !mode - -DO mode = P%DynInflow%MaxInflo+1, maxInfl - tauCos(mode) = - m%DynInflow%PhiLqC(mode) / m%DynInflow%Pzero - tauSin(mode) = - m%DynInflow%PhiLqS(mode) / m%DynInflow%Pzero -END DO !mode - - ! Get the steady values of alpha(1) - ! If m=0 and n=1, USE VTOTAL. -m%DynInflow%xAlpha(1) = 0. -DO k = 1, maxInfl - m%DynInflow%xAlpha(1) = m%DynInflow%xAlpha(1) + m%DynInflow%xLcos(1,k) * tauCos(k) -END DO !k -m%DynInflow%xAlpha(1) = .5 * m%DynInflow%xAlpha(1) / m%DynInflow%Vtotal - - ! If m=0 but NOT n=1, USE VPARAM. -DO i = 2, P%DynInflow%MaxInflo - m%DynInflow%xAlpha(i) = 0. - DO k = 1, maxInfl - m%DynInflow%xAlpha(i) = m%DynInflow%xAlpha(i) + m%DynInflow%xLcos(i,k) * tauCos(k) - END DO !k - m%DynInflow%xAlpha(i) = .5 * m%DynInflow%xAlpha(i) / m%DynInflow%Vparam -END DO !i - - ! Get the steady values of alpha's & beta's -DO i = P%DynInflow%MaxInflo+1, maxInfl - m%DynInflow%xAlpha(i) = 0. - ! akihiro -! DO k = 1, maxInfl - DO k = P%DynInflow%MaxInflo+1, maxInfl - m%DynInflow%xAlpha(i) = m%DynInflow%xAlpha(i) + m%DynInflow%xLcos(i,k) * tauCos(k) - END DO !k - m%DynInflow%xAlpha(i) = .5 * m%DynInflow%xAlpha(i) / m%DynInflow%Vparam - - m%DynInflow%xBeta (i) = 0. - DO k = P%DynInflow%MaxInflo+1, maxInfl - m%DynInflow%xBeta (i) = m%DynInflow%xBeta (i) + m%DynInflow%xLsin(i,k) * tauSin(k) - END DO !k - m%DynInflow%xBeta (i) = .5 * m%DynInflow%xBeta (i) / m%DynInflow%Vparam -END DO !i - - ! Invert [L_cos] & [L_sin] matrices in case the XKAI is constant - ! and the same [L]'s are used later. -CALL MATINV ( m%DynInflow%xLcos, m%DynInflow%xLsin, maxInfl, P%DynInflow%MaxInflo, 1, ErrStat, ErrMess ) - IF (ErrStat /= ErrID_None) THEN - ErrMess='infinit:'//TRIM(ErrMess) - RETURN - END IF -CALL MATINV ( m%DynInflow%xLcos, m%DynInflow%xLsin, maxInfl, P%DynInflow%MaxInflo, 2, ErrStat, ErrMess ) - IF (ErrStat /= ErrID_None) THEN - ErrMess='infinit:'//TRIM(ErrMess) - RETURN - END IF - -RETURN -END SUBROUTINE infinit - - - ! ********************************************************************** - SUBROUTINE infupdt( P, m, ErrStat, ErrMess ) - ! INFUPDT updates the OLD variables of inflow distribution parameters. - ! The program must call this subroutine before calling - ! the subroutine INFDIST. - ! ********************************************************************** - -!USE DynInflow - - IMPLICIT NONE - - TYPE(AD14_ParameterType), INTENT(IN) :: p ! Parameters - TYPE(AD14_MiscVarType), INTENT(INOUT) :: m ! Misc/optimization variables - INTEGER, INTENT(OUT) :: ErrStat - CHARACTER(*), INTENT(OUT) :: ErrMess - INTEGER :: i - - - ErrStat = ErrID_None - ErrMess = "" - -!+++++++++++++++++++++++++++ -!Suzuki: -!oldKaiC = xKaiC -!oldKaiS = xKaiS -!Shawler: -m%DynInflow%oldKai = m%DynInflow%xKai -!+++++++++++++++++++++++++++ - -m%DynInflow%old_LmdM = m%DynInflow%xLambda_M - -DO i = 1, maxInfl - m%DynInflow%old_Alph(i) = m%DynInflow%xAlpha (i) - m%DynInflow%dAlph_dt(i,4) = m%DynInflow%dAlph_dt(i,3) - m%DynInflow%dAlph_dt(i,3) = m%DynInflow%dAlph_dt(i,2) - m%DynInflow%dAlph_dt(i,2) = m%DynInflow%dAlph_dt(i,1) -END DO !i - -DO i = P%DynInflow%MaxInflo+1, maxInfl - m%DynInflow%old_Beta(i) = m%DynInflow%xBeta (i) - m%DynInflow%dBeta_dt(i,4) = m%DynInflow%dBeta_dt(i,3) - m%DynInflow%dBeta_dt(i,3) = m%DynInflow%dBeta_dt(i,2) - m%DynInflow%dBeta_dt(i,2) = m%DynInflow%dBeta_dt(i,1) -END DO !i - -RETURN -END SUBROUTINE infupdt - - - ! ********************************************************************** - SUBROUTINE DynDebug (Time, P, x, xd, z, m, y, ErrStat, ErrMess, RHScos, RHSsin) - ! Write out debugging information - ! ********************************************************************** - - IMPLICIT NONE - REAL(DbKi), INTENT(IN) :: Time - TYPE(AD14_ParameterType), INTENT(IN) :: p ! Parameters - TYPE(AD14_ContinuousStateType), INTENT(INOUT) :: x ! Initial continuous states - TYPE(AD14_DiscreteStateType), INTENT(INOUT) :: xd ! Initial discrete states - TYPE(AD14_ConstraintStateType), INTENT(INOUT) :: z ! Initial guess of the constraint states - TYPE(AD14_MiscVarType), INTENT(INOUT) :: m ! Misc/optimization variables - TYPE(AD14_OutputType), INTENT(INOUT) :: y ! Initial system outputs (outputs are not calculated; - INTEGER, INTENT(OUT) :: ErrStat - CHARACTER(*), INTENT(OUT) :: ErrMess - - ! Passed Variables: - - REAL(ReKi) :: RHScos ( maxInfl ) - REAL(ReKi) :: RHSsin ( P%DynInflow%MaxInflo+1:maxInfl ) - - - ! Local Variables: - - INTEGER :: i - INTEGER :: NumOut - INTEGER, PARAMETER :: UnDyn = 80 - - CHARACTER(50) :: Frmt - - ErrStat = ErrID_None - ErrMess = "" - -!SAVE ! Save *all* local variables. Is this necessary, or is OnePass enough. - -NumOut = maxInfl+(maxInfl-P%DynInflow%MaxInflo) + 1 - -IF (m%OnePassDynDbg) THEN - - CALL OpenFOutFile (UnDyn, 'DynDebug.plt', ErrStat, ErrMess) - IF (ErrStat>=AbortErrLev) RETURN - - Frmt = '( A4, (: A1, A, I1.1 ) )' - - WRITE(Frmt(7:9), '(I3)') NumOut - WRITE(UnDyn, Frmt) 'Time', & - ( TAB, 'dAlph_dt', i, & - i = 1, maxInfl ), & - ( TAB, 'dBeta_dt', i, & - i = P%DynInflow%MaxInflo+1, maxInfl ), & - TAB, 'TotalInf' - - m%OnePassDynDbg = .FALSE. - -ENDIF - -Frmt = '( F10.3, ( : A1, ES12.5 ) )' - -IF (TIME > 0.0D0) THEN - - WRITE(Frmt(10:12), '(I3)') NumOut - WRITE(UnDyn,Frmt) TIME, & - ( TAB, m%DynInflow%dAlph_dt(i,1), & - i = 1, maxInfl ), & - ( TAB, m%DynInflow%dBeta_dt(i,1), & - i = P%DynInflow%MaxInflo+1, maxInfl ), & - TAB, m%DynInflow%totalInf - -ENDIF - -RETURN -END SUBROUTINE DynDebug - - - ! ********************************************************************** - SUBROUTINE infdist( P, m, ErrStat, ErrMess ) - ! INFDIST calculates the inflow (induced flow) distribution - ! parameters using Generalized Dynamic Wake Theory. - ! ********************************************************************** - IMPLICIT NONE - TYPE(AD14_ParameterType), INTENT(IN) :: p ! Parameters - TYPE(AD14_MiscVarType), INTENT(INOUT) :: m ! Misc/optimization variables - INTEGER, INTENT(OUT) :: ErrStat - CHARACTER(*), INTENT(OUT) :: ErrMess - - ! Local Variables: - - REAL(ReKi) :: RHScos ( maxInfl ) ! The cosine terms go from 1 to 6. The sine terms go from 3 to 6. - REAL(ReKi) :: RHSsin ( P%DynInflow%MaxInflo+1:maxInfl ) ! The right hand side of the governing equation. - REAL(ReKi) :: tauCos ( maxInfl ) ! Forcing Functions - REAL(ReKi) :: tauSin ( P%DynInflow%MaxInflo+1:maxInfl ) - REAL(ReKi) :: v1 - REAL(ReKi) :: v2 - REAL(ReKi) :: v3 - REAL(ReKi) :: Vplane2 - - INTEGER :: i - INTEGER :: k - INTEGER :: mode - - ErrStat = ErrID_None - ErrMess = "" -m%DynInflow%TipSpeed = MAX(P%Blade%r * m%Rotor%revs, 1.0e-6_ReKi) !bjj: why is this here AND in InfInit()? - -m%DynInflow%Pzero = pi * p%Wind%rho * m%DynInflow%TipSpeed * m%DynInflow%TipSpeed * P%Blade%r - - ! Non-dimensional time -m%DynInflow%DTO = m%DT * m%Rotor%REVS - - ! Calculate the wind velocity components in rotor-fixed - ! coordinates(1-2-3), which are normalized by the tipspeed. -v1 = m%Wind%VrotorZ / m%DynInflow%TipSpeed !inplane, upward -v2 = m%Wind%VrotorY / m%DynInflow%TipSpeed !inplane, right looking downwind -v3 = - m%Wind%VrotorX / m%DynInflow%TipSpeed !out-of-plane (normal to the rotor) - ! Vplane2 is the square of in-plane component of the non-dimensional - ! wind velocity. -Vplane2 = v1 * v1 + v2 * v2 - - ! Note: Direction of non-dimensional velocity (All normal to the rotor plane). - ! totalInf: positive downwind. This is the total inflow to the rotor. - ! v3: positive upwind (thus, in normal condition, v3 < 0 ) - ! xLambda_M: positive downwind (opposite to A(i,j) ) - ! old_LmdM: positive downwind (opposite to A(i,j) ) -m%DynInflow%totalInf = - v3 + m%DynInflow%old_LmdM -! if ( m%DynInflow%totalInf .le. 0. ) then -! call usrmes( .true. , & -! 'In SUBROUTINE INFDIST. totalInf =< 0.', & -! 27, 'WARN' ) -! endif - - ! VTOTAL is the speed of the total inflow to the rotor. -m%DynInflow%Vtotal = SQRT( m%DynInflow%totalInf * m%DynInflow%totalInf + Vplane2 ) -IF (m%DynInflow%vtotal <= 1.0e-6) m%DynInflow%vtotal=1.0e-6 - - ! VPARAM is the inflow velocity parameter. -m%DynInflow%Vparam = ( Vplane2 + ( m%DynInflow%totalInf + m%DynInflow%old_LmdM ) * m%DynInflow%totalInf ) / m%DynInflow%Vtotal - ! Calculate the disk skew angle function - ! using the effective disk angle of attack. -IF (m%DynInflow% totalInf == 0. ) THEN -! WRITE(*,*) v3, m%DynInflow%old_LmdM - !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -! Suzuki: -! xKaiC = 0. -! xKaiS = 0. -! Shawler: - m%DynInflow%xKai = 0 - !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -ELSE - ! Note the definition of Yaw Angle is around -Z axis. - !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -! Suzuki: -! xKaiC = TAN( .5 * ATAN( -v2 / totalInf ) ) -! xKaiS = TAN( .5 * ATAN( v1 / totalInf ) ) -!! xKaiC = TAN( .5 * SIGN( ATAN( SQRT( vplane2 ) / totalInf ), v2 ) ) -! Shawler: - m%DynInflow%xkai = TAN( .5 * ATAN( SQRT( vplane2 ) / m%DynInflow%totalInf ) ) - !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -ENDIF - - !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -! Suzuki: - ! Update [L_cos] and [L_sin] matrices only if 'xkai' has changed. - ! Then invert [L_cos] & [L_sin] matrices. -!IF ( xKaiC /= oldKaiC ) THEN -! CALL LMATRIX ( xKaiC, 1 ) -! CALL MATINV ( xLcos, xLsin, maxInfl, MaxInflo, 1 ) -!ENDIF - -!IF ( xKaiS /= oldKaiS ) THEN -! CALL LMATRIX ( m%DynInflow%xKaiS, 2 ) -! CALL MATINV ( m%DynInflow%xLcos, m%DynInflow%xLsin, maxInfl, P%DynInflow%MaxInflo, 2 ) -!ENDIF -! Shawler: -!IF ( xKai /= oldKai ) THEN - CALL LMATRIX ( m,p, 1, ErrStat, ErrMess ) - IF (ErrStat /= ErrID_None) THEN - ErrMess='infdist:'//TRIM(ErrMess) - RETURN - END IF - CALL LMATRIX ( m,p, 2, ErrStat, ErrMess ) - IF (ErrStat /= ErrID_None) THEN - ErrMess='infdist:'//TRIM(ErrMess) - RETURN - END IF - CALL MATINV ( m%DynInflow%xLcos, m%DynInflow%xLsin, maxInfl, P%DynInflow%MaxInflo, 1, ErrStat, ErrMess ) - IF (ErrStat /= ErrID_None) THEN - ErrMess='infdist:'//TRIM(ErrMess) - RETURN - END IF - CALL MATINV ( m%DynInflow%xLcos, m%DynInflow%xLsin, maxInfl, P%DynInflow%MaxInflo, 2, ErrStat, ErrMess ) - IF (ErrStat /= ErrID_None) THEN - ErrMess='infdist:'//TRIM(ErrMess) - RETURN - END IF -!ENDIF - !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - - ! [L_***] is now [L_***]^-1. - - ! Calculate the forcing functions (lift or normal forces). - ! In the generalized dynamic wake model, the normal forces on the blades - ! are positve upwind (just like a helicopter rotor). On the other hand, - ! they are positve downwind in YawDyn, which is normal in wind turbine rotor. - ! Put a minus sign for each forcing function. - - ! The modes for r=0. -DO mode = 1, P%DynInflow%MaxInflo - tauCos(mode) = - m%DynInflow%PhiLqC(mode) / m%DynInflow%Pzero * .5 -END DO !mode - - ! The modes for r>0. -DO mode = P%DynInflow%MaxInflo+1, maxInfl - tauCos(mode) = - m%DynInflow%PhiLqC(mode) / m%DynInflow%Pzero - tauSin(mode) = - m%DynInflow%PhiLqS(mode) / m%DynInflow%Pzero -END DO !mode - - ! Solve for the time derivatives of xAlpha's, {d(alpha)_dt}. - ! Calculate the right hand side of the governing equation. - ! {rhs} = 0.5*{tau} - [V][L]^-1*{alpha} - - ! First, calculate {rhs} = V[L]^-1*{alpha} - ! USE "VTOTAL" for the first row of r=0. Cosine Matrix only. -RHScos(1) = 0. -DO k = 1, maxInfl - RHScos(1) = RHScos(1) + m%DynInflow%xLcos(1,k) * m%DynInflow%old_Alph(k) -END DO !k -RHScos(1) = .5 * tauCos(1) - m%DynInflow%vtotal * RHScos(1) - - ! USE "VPARAM" for the second row or higher of r=0. -DO i = 2, P%DynInflow%MaxInflo - RHScos(i) = 0. - DO k = 1, maxInfl - RHScos(i) = RHScos(i) + m%DynInflow%xLcos(i,k) * m%DynInflow%old_Alph(k) - END DO !k - RHScos(i) = .5 * tauCos(i) - m%DynInflow%Vparam * RHScos(i) -END DO !i - - ! Rows with r=1 or greater. Both cosine and sine matrices. -DO i = P%DynInflow%MaxInflo+1, maxInfl - RHScos(i) = 0. - RHSsin(i) = 0. - ! First, calculate {rhs} = V[L]^-1*{alpha} - RHScos(i) = sum(m%DynInflow%xLcos(i,1:maxInfl) * m%DynInflow%old_Alph(1:maxInfl)) - RHSsin(i) = sum(m%DynInflow%xLsin(i,P%DynInflow%MaxInflo+1:maxInfl) * m%DynInflow%old_Beta(P%DynInflow%MaxInflo+1:maxInfl)) - ! Second, calculate {rhs} = 0.5*{tau} - [V]{rhs} - ! = 0.5*{tau} - [V][L]^-1*{alpha} - ! USE "VPARAM" for m>0 - RHScos(i) = .5 * tauCos(i) - m%DynInflow%Vparam * RHScos(i) - RHSsin(i) = .5 * tauSin(i) - m%DynInflow%Vparam * RHSsin(i) -END DO !i - -DO i = 1, P%DynInflow%MaxInflo - m%DynInflow%dAlph_dt(i,1) = p%DynInflow%xMinv(i) * RHScos(i) -END DO !i -DO i = P%DynInflow%MaxInflo+1, maxInfl - m%DynInflow%dAlph_dt(i,1) = p%DynInflow%xMinv(i) * RHScos(i) - m%DynInflow%dBeta_dt(i,1) = p%DynInflow%xMinv(i) * RHSsin(i) -END DO !i - - ! Integration using Adams-Bashford predictor corrector method. - ! Note: The time step is nondimensional. t0=Omega*t - ! Thus, in YawDyn, DT0=DT*REVS=(DELPSI/REVS)*REVS=DELPSI - ! USE DT*REVS for compatibility with AeroDyn (DT0 not constant). - ! DT is in module 'Lift' - ! Determines xAlpha and xBeta -CALL ABPRECOR ( m%DynInflow%xAlpha, m%DynInflow%old_Alph, m%DynInflow%dAlph_dt, m%DynInflow%DTO, maxInfl, 1 ) -CALL ABPRECOR ( m%DynInflow%xBeta, m%DynInflow%old_Beta, m%DynInflow%dBeta_dt, m%DynInflow%DTO, maxInfl, P%DynInflow%MaxInflo+1 ) - - ! Calculate the new lambda_m. -!bjj: why are there 2 do loops? can't they be combined???? (assuming MaxInflo < maxInfl) or is one of these supposed to be sin? -m%DynInflow%xLambda_M= 0. -DO k = 1, P%DynInflow%MaxInflo-1 - m%DynInflow%xLambda_M = m%DynInflow%xLambda_M + m%DynInflow%xLcos(1,k) * m%DynInflow%xAlpha(k) -END DO !k -DO k = P%DynInflow%MaxInflo, maxInfl - m%DynInflow%xLambda_M = m%DynInflow%xLambda_M + m%DynInflow%xLcos(1,k) * m%DynInflow%xAlpha(k) -END DO !k -! xLambda_M = 2. / sqrt(3.) * xLambda_M -m%DynInflow%xLambda_M = 1.1547005 * m%DynInflow%xLambda_M - -! Added additional output for GDW debugging - comment out for distribution -!CALL DynDebug (Time, P, x, xd, z, m, y, ErrStat, ErrMess, RHScos, RHSsin) - -RETURN -END SUBROUTINE infdist - - ! ************************************************************* - SUBROUTINE VINDINF( P, m, ErrStat, ErrMess, & - iradius, iblade, rlocal, vnw, VNB, VT, psi ) - ! Calculates the axial and tangential induction factor for each annular segment - ! and time step (i.e. sets m%Element%A and m%Element%AP) - ! Uses the calculated inflow parameters - ! Called by ElemFrc for each element at a new time step. - ! ************************************************************* - - IMPLICIT NONE - TYPE(AD14_ParameterType), INTENT(IN) :: p ! Parameters - TYPE(AD14_MiscVarType), INTENT(INOUT) :: m ! Misc/optimization variables - INTEGER, INTENT(OUT) :: ErrStat - CHARACTER(*), INTENT(OUT) :: ErrMess - - - ! Passed Variables: - REAL(ReKi),INTENT(IN) :: psi - REAL(ReKi),INTENT(IN) :: rlocal - REAL(ReKi),INTENT(IN) :: VNB - REAL(ReKi),INTENT(IN) :: vnw - REAL(ReKi),INTENT(IN ) :: VT ! Tangential velocity from relative blade motion and wind, no induction - - INTEGER, INTENT(IN) :: iradius - INTEGER, INTENT(IN) :: iblade - - ! Local Variables: - - REAL(ReKi) :: A2P - !Suzuki uses psiBar, Shawler - WindPsi - !REAL(ReKi) :: psibar - REAL(ReKi) :: Rzero - REAL(ReKi) :: SWRLARG - REAL(ReKi) :: Windpsi - - INTEGER :: mode - - INTEGER :: ErrStatLcL ! Error status returned by called routines. - CHARACTER(ErrMsgLen) :: ErrMessLcl ! Error message returned by called routines. - - -ErrStat = ErrID_None -ErrMess = "" - - ! Rzero is the non-dimensional radius. -Rzero = rlocal / P%Blade%r - - ! PSIBAR is the azimuth angle measured counterclockwise from - ! the horizontal to the left looking downwind. The directions - ! of PSI and PSIBAR are opposite and there is 90 deg difference. - !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -!Suzuki: -! psiBar = - psi - piBy2 -! Shawler: -CALL WindAzimuthZero (psi,m%Wind%VrotorY,m%Wind%VrotorZ,WindPsi) - !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - - ! Calculate the induction factor using the inflow parameters. - ! Here it's normalized by the tipspeed. - -m%Element%A(iRadius,iBlade) = 0. - -DO mode = 1, p%DynInflow%MaxInflo - m%Element%A(iRadius,iBlade) = m%Element%A(iRadius,iBlade) & - + xphi(Rzero,mode,ErrStatLcl, ErrMessLcl) * m%DynInflow%xAlpha(mode) - CALL SetErrStat ( ErrStatLcl, ErrMessLcl, ErrStat,ErrMess,'VINDINF' ) - IF (ErrStat >= AbortErrLev) RETURN - -! & + phis(Rzero, MRvector(mode), NJvector(mode) )* xAlpha(mode) -END DO !mode - - !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -!Suzuki: -!DO mode = MaxInflo+1, maxInfl -! A(iRadius,iBlade) = A(iRadius,iBlade) + xphi(Rzero,mode) * & -!! & + phis(Rzero, MRvector(mode), NJvector(mode) ) * -! ( xAlpha(mode) * COS( REAL(MRvector(MODE), ReKi) * psibar ) & -! + xBeta (mode) * SIN( REAL(MRvector(MODE), ReKi) * psibar ) ) -!END DO !mode -! Shawler: -DO mode = p%DynInflow%MaxInflo+1, maxInfl - m%Element%A(iRadius,iBlade) = m%Element%A(iRadius,iBlade) + xphi(Rzero,mode,ErrStatLcl, ErrMessLcl) * & - ( m%DynInflow%xAlpha(mode) * COS( REAL(MRvector(MODE), ReKi) * Windpsi ) & - + m%DynInflow%xBeta (mode) * SIN( REAL(MRvector(MODE), ReKi) * Windpsi ) ) - CALL SetErrStat ( ErrStatLcl, ErrMessLcl, ErrStat,ErrMess,'VINDINF' ) - IF (ErrStat >= AbortErrLev) RETURN - -END DO !mode - !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - - ! A is positive upwind, while alpha's & beta's are positve downwind. - ! Also, they are normalized by different factors. -m%Element%A(iRadius,iBlade) = - m%Element%A(iRadius,iBlade) * m%DynInflow%TipSpeed / VNW - - ! Calculate induced swirl (a') if desired. - -m%Element%AP(iRadius,iBlade) = 0.0_ReKi ! Default value - -IF ( P%SWIRL ) THEN - ! akihiro 10/26/99 - SWRLARG = 1.0 + 4.0 * m%Element%A(iradius,iblade) * VNW * & - ( (1.0 - m%Element%A(iradius,iblade)) * VNW + VNB ) / VT / VT - IF ( SWRLARG > 0.0 ) THEN - A2P = 0.5 * ( -1.0 + SQRT( SWRLARG ) ) -! bjj: this value was not properly set before. We could also just replace the local A2P variable with AP() instead. - m%Element%AP(iRadius,iBlade) = A2P - ENDIF - -ENDIF - -RETURN -END SUBROUTINE VINDINF - - ! *********************************************************************** - SUBROUTINE ABPRECOR( F, OLDF, DFDT, DT, N, N0 ) - ! Integrates Function F by Adams-Bashford Predictor and Adams-Moulton - ! Corrector using four previous values of dF/dt. - ! *********************************************************************** - - -IMPLICIT NONE - - - ! Passed Variables: -INTEGER ,INTENT(IN) :: N -INTEGER ,INTENT(IN) :: N0 - -REAL(ReKi),INTENT(IN) :: DT -REAL(ReKi),INTENT(IN) :: DFDT ( N0:N, 4 ) -REAL(ReKi),INTENT(OUT) :: F ( N0:N ) -REAL(ReKi),INTENT(IN) :: OLDF ( N0:N ) - - ! Local Variables: - -REAL(ReKi) :: DFDT0 - -INTEGER :: I - - - -DO I = N0, N - ! Adams-Bashford Predictor - F(I) = OLDF(I) + ( 55. * DFDT(I,1) - 59. * DFDT(I,2) & - + 37. * DFDT(I,3) - 9. * DFDT(I,4) ) * DT / 24. - - ! New time derivative for corrector - DFDT0 = ( F(I) - OLDF(I) ) / DT - - ! Adams-Moulton Corrector - F(I) = OLDF(I) + ( 9. * DFDT0 + 19. * DFDT(I,1) & - - 5. * DFDT(I,2) + DFDT(I,3) ) * DT / 24. - -END DO !I - - - -RETURN -END SUBROUTINE ABPRECOR - - ! *********************************************************************** - SUBROUTINE LMATRIX ( m, p, matrixMode,ErrStat, ErrMess) - ! LMATRIX calculates the [L_***] matrix using Gamma matrix and xkai=X. - ! matrixMode = 1 : Calculate [L_cos] matrix - ! matrixMode = 2 : Calculate [L_sin] matrix - ! *********************************************************************** - -IMPLICIT NONE - ! Passed Variables: - TYPE(AD14_MiscVarType), INTENT(INOUT) :: m ! Misc/optimization variables -TYPE(AD14_ParameterType), INTENT(IN) :: p ! Parameters -INTEGER ,INTENT(IN) :: matrixMode - -INTEGER(IntKi), INTENT(OUT) :: ErrStat ! Error status of the operation -CHARACTER(*), INTENT(OUT) :: ErrMess ! Error message if ErrStat /= ErrID_None - - -REAL(ReKi) :: X - - - ! Local Variables: - -REAL(ReKi) :: XM - -INTEGER :: IROW -INTEGER :: JCOL - - ErrStat = ErrID_None - ErrMess = "" - - -X = m%DynInflow%xKai - - ! Check the value of X -IF ( ( X < -1.) .OR. ( X > 1.) ) THEN -! IF ( ( X < 0.) .OR. ( X > 1.) ) THEN - ErrStat = ErrID_Fatal - ErrMess = 'LMATRIX: Value of X = '//TRIM(Num2LStr(X))//' must be between -1 and 1.' - RETURN -ENDIF - -SELECT CASE ( matrixMode ) - - ! Calculate the rows for r=0 of [L_cos] matrix, - ! which needs a separate formula. - CASE (1) - DO JCOL = 1, maxInfl - XM = X ** MRvector(JCOL) - DO IROW = 1, p%DynInflow%MaxInflo - m%DynInflow%xLcos( IROW, JCOL ) = m%DynInflow%gamma( IROW, JCOL ) * XM - END DO !IROW - END DO !JCOL - - ! Calculate the [L_cos] matrix, - ! the rows for r=1 and higher. - DO IROW = p%DynInflow%MaxInflo+1, maxInfl - DO JCOL = 1, maxInfl - m%DynInflow%xLcos( IROW, JCOL ) = m%DynInflow%GAMMA( IROW, JCOL ) & - *( X ** m%DynInflow%MminusR( IROW, JCOL ) & - + X ** m%DynInflow%MplusR ( IROW, JCOL ) & - * (-1.) ** m%DynInflow%MminR ( IROW, JCOL ) ) - END DO !JCOL - END DO !IROW - - ! Calculate [L_sin] matrix. - CASE (2) - DO IROW = p%DynInflow%MaxInflo+1, maxInfl - DO JCOL = p%DynInflow%MaxInflo+1, maxInfl - m%DynInflow%xLsin( IROW, JCOL ) = m%DynInflow%GAMMA( IROW, JCOL ) & - *( X ** m%DynInflow%MminusR( IROW, JCOL ) & - - X ** m%DynInflow%MplusR ( IROW, JCOL ) & - * (-1.) ** m%DynInflow%MminR ( IROW, JCOL ) ) - END DO !JCOL - END DO !IROW - - CASE DEFAULT - CALL ProgAbort( 'Value of matrixMode = '//TRIM(Int2LStr(matrixMode))//' must be 1 or 2.') -END SELECT - -RETURN -END SUBROUTINE LMATRIX - - ! *********************************************************************** - SUBROUTINE MATINV( A0, A1, N, N0, invMode,ErrStat,ErrMsg ) - ! Inverts the [L_cos] and [L_sin] matrices. - ! Subroutine GAUSSJ (modified) from "Numerical Recipe" is needed. - ! invMode = 1 : Invert [L_cos] matrix - ! invMode = 2 : Invert [L_sin] matrix - !********************************************************************** - - -IMPLICIT NONE - - - ! Passed Variables: -INTEGER ,INTENT(IN) :: invMode -INTEGER ,INTENT(IN) :: N -INTEGER ,INTENT(IN) :: N0 - -REAL(ReKi),INTENT(INOUT) :: A0 ( N , N ) -REAL(ReKi),INTENT(INOUT) :: A1 ( N0+1:N , N0+1:N ) - -INTEGER(IntKi), INTENT(OUT) :: ErrStat ! Error status of the operation -CHARACTER(*), INTENT(OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None - - - ! Local Variables: - -REAL(ReKi) :: DUMMY( N-N0, N-N0 ) - -INTEGER :: I -INTEGER :: J - - ErrStat = ErrID_None - ErrMsg = "" - - - ! Invert [L_cos] in all cases - ! [L_cos] matrix can be inverted without a dummy. - ! Invert the [A0]=[L_cos] matrix by Gauss-Jordan Method -SELECT CASE ( invMode ) - - CASE (1) - CALL GAUSSJ(A0,N,ErrStat,ErrMsg) - IF (ErrStat /= ErrID_None) THEN - ErrMsg = 'MATINV:'//TRIM(ErrMsg) - RETURN - END IF - - ! [L_sin] matrix needs a dummy array, because the index goes - ! from MaxInflo(=N0) to maxInfl(=N), - ! which is incompatible with SUBROUTINE GAUSSJ. - !BJJ: IS THIS REALLY NECESSARY? Aren't the indicies an abstraction?? if you pass an array (1:3) and use it as (0:2) in another subroutine, it's really okay??? - CASE (2) - DO I=1,N-N0 - DO J=1,N-N0 - DUMMY(I,J) = A1(I+N0,J+N0) - END DO !J - END DO !I - - ! Invert the [A1]=[L_sin] matrix by Gauss-Jordan Method. - CALL GAUSSJ(DUMMY,N-N0,ErrStat,ErrMsg) - IF (ErrStat /= ErrID_None) THEN - ErrMsg = 'MATINV:'//TRIM(ErrMsg) - RETURN - END IF - - ! Put the dummy back into [A1]=[L_sin]. - DO I=1,N-N0 - DO J=1,N-N0 - A1(I+N0,J+N0) = DUMMY(I,J) - END DO !J - END DO !I - - CASE DEFAULT - CALL ProgAbort( 'Value of invMode = '//TRIM(Int2LStr(invMode))//' must be 1 or 2.') - IF (ErrStat >= AbortErrLev) RETURN - - -END SELECT - - - -RETURN -END SUBROUTINE MATINV - - ! *********************************************************************** - SUBROUTINE gaussj(a,n, ErrStat, ErrMsg) - ! Invert a matrix by Gauss-Jordan Method. The original source code - ! from "Numerical Recipe" was slightly modified. - ! *********************************************************************** - - -IMPLICIT NONE - - - ! Passed Variables: -INTEGER , INTENT(IN) :: n -REAL(ReKi), INTENT(INOUT) :: a(n,n) - -INTEGER(IntKi), INTENT(OUT) :: ErrStat ! Error status of the operation -CHARACTER(*), INTENT(OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None - - - ! Local Variables: - -INTEGER , PARAMETER :: NMAX = 6 - -REAL(ReKi) :: big -REAL(ReKi) :: dum -REAL(ReKi) :: pivinv - -INTEGER :: i -INTEGER :: icol -INTEGER :: indxc(NMAX) -INTEGER :: indxr(NMAX) -INTEGER :: ipiv(NMAX) -INTEGER :: irow -INTEGER :: j -INTEGER :: k -INTEGER :: l -INTEGER :: ll - - -ErrStat=ErrID_None -ErrMsg="" - -DO j=1,n - ipiv(j)=0 -END DO !j -DO i=1,n - big=0. - DO j=1,n - IF (ipiv(j) /= 1) THEN - DO k=1,n - IF (ipiv(k) == 0) THEN - IF (ABS(a(j,k)) >= big) THEN - big=ABS(a(j,k)) - irow=j - icol=k - ENDIF - - ELSE IF (ipiv(k) > 1) THEN - ErrStat = ErrID_Fatal - ErrMsg = "gaussj: Singular matrix encountered." - RETURN - ENDIF - END DO !k - ENDIF - END DO !j - ipiv(icol)=ipiv(icol)+1 - IF (irow /= icol) THEN - DO l=1,n - dum=a(irow,l) - a(irow,l)=a(icol,l) - a(icol,l)=dum - END DO !l - ENDIF - indxr(i)=irow - indxc(i)=icol - IF (a(icol,icol) == 0.) THEN - ErrStat = ErrID_Fatal - ErrMsg = "gaussj: Singular matrix encountered." - RETURN - ENDIF - pivinv=1./a(icol,icol) - a(icol,icol)=1. - DO l=1,n - a(icol,l)=a(icol,l)*pivinv - END DO !l - DO ll=1,n - if (ll /= icol) THEN - dum=a(ll,icol) - a(ll,icol)=0. - DO l=1,n - a(ll,l)=a(ll,l)-a(icol,l)*dum - END DO !l - ENDIF - END DO !ll -END DO !i -DO l=n,1,-1 - IF (indxr(l) /= indxc(l)) THEN - - DO k=1,n - dum=a(k,indxr(l)) - a(k,indxr(l))=a(k,indxc(l)) - a(k,indxc(l))=dum - END DO !k - ENDIF -END DO !l - - - -RETURN -END SUBROUTINE gaussj - -! *********************************************************************** - FUNCTION FGAMMA( R, J, M, N ) -! Calculate the GAMMA matrix. It is NOT the statistical function. -! *********************************************************************** - - -IMPLICIT NONE - - - ! Passed Variables: - -REAL(ReKi) :: FGAMMA -INTEGER ,INTENT(IN) :: J -INTEGER ,INTENT(IN) :: M -INTEGER ,INTENT(IN) :: N -INTEGER ,INTENT(IN) :: R - - -IF ( MOD(R+M,2) == 0 ) THEN - FGAMMA = (-1)**((N+J-2*R)*.5) * 2. & - * SQRT( REAL( (2*N+1) * (2*J+1), ReKi ) ) & - / SQRT( HFUNC(M,N) * HFUNC(R,J) ) & - / REAL( (J+N) * (J+N+2) * ((J-N)*(J-N)-1), ReKi ) - -ELSE IF ( ABS(J-N) == 1 ) THEN !bjj: why don't we use the pi() variable? or PibyTwo - FGAMMA = 3.14159265 * SIGN(1., REAL(R-M, ReKi) ) * .5 & - / SQRT( HFUNC(M,N) * HFUNC(R,J) ) & - / SQRT( REAL( (2*N+1) * (2*J+1) , ReKi) ) - -ELSE - FGAMMA = 0. - -ENDIF - - - -RETURN -END FUNCTION FGAMMA - - ! *********************************************************************** - FUNCTION HFUNC( M, N ) - ! Calculates the value of function H(m,n). - ! Warning: This subroutine is not optimized for large m or n. - ! Although H(m,n) is a well behaving function, it may - ! cause math overflow, if m or n is large. - !bjj: we only call with with the MRvector and NJvector (parameter) values. This could - ! possibly increase performance if implemented differently.... - ! *********************************************************************** - - -IMPLICIT NONE - - - ! Passed Variables: - -REAL(ReKi) :: HFUNC - -INTEGER ,INTENT(IN) :: M -INTEGER ,INTENT(IN) :: N - - - ! Local Variables: - -INTEGER :: NMM ! n minus M -INTEGER :: NPM ! N plus M - - - -IF ( N <= M ) THEN - CALL ProgAbort( 'Value of N = '//TRIM(Int2LStr(N))//' must be geater than M = '//TRIM(Int2LStr(M))//'.' ) -ENDIF - -NPM = N + M -NMM = N - M - -HFUNC = ( REAL( IDUBFACT(NPM-1), ReKi ) / REAL( IDUBFACT(NPM), ReKi ) ) & - * ( REAL( IDUBFACT(NMM-1), ReKi ) / REAL( IDUBFACT(NMM), ReKi ) ) - - - -RETURN -END FUNCTION HFUNC - - ! *********************************************************************** - INTEGER FUNCTION IDUBFACT( I ) - ! Calculates the double factorial of an integer I - ! IDUBFACT( I ) = I!! = I*(I-2)*(I-4)*...*4*2 for I = even - ! or = I*(I-2)*(I-4)*...*3*1 for I = odd - ! *********************************************************************** - - -IMPLICIT NONE - - - ! Passed Variables: -INTEGER ,INTENT(IN) :: I - - ! Local Variables: - -INTEGER :: K - - - -IF ( I >= 1 ) THEN - IDUBFACT = 1 - - DO K = I, 1, -2 - IDUBFACT = IDUBFACT * K - END DO !K - -ELSE IF ( I == 0 .OR. I == -1 ) THEN - IDUBFACT = 1 -ELSE IF ( I == -3 ) THEN ! use definition of n!! for odd negative numbers - IDUBFACT = -1 -ELSE - CALL ProgAbort( 'Double factorial is NOT defined for '//TRIM(Int2LStr(I))//' in FUNCTION IDUBFACT.') -ENDIF - - - -RETURN -END FUNCTION IDUBFACT - - ! *********************************************************************** - FUNCTION xphi( Rzero, mode,ErrStat, ErrMsg ) - ! Set up the PHI coefficients. They are the results from Mathematica. - ! phi(1) = sqrt( 3.) ! m=0, n=1 - ! phi(2) = 2*sqrt(7) (1.5 - 3.75 Rzero**2 ) / 3.! m=0, n=3 - ! phi(3) = sqrt( 15./ 2.) *Rzero ! m=1, n=2 - ! phi(4) = 4*(15/4 * Rzero - 105/16 *Rzero**3 )/sqrt(5)! m=1, n=4 - ! phi(5) = sqrt( 105./ 2.) / 2. *Rzero**2 ! m=2, n=3 - ! phi(6) = sqrt( 35.) *3. / 4. *Rzero**3 ! m=3, n=4 - ! *********************************************************************** - - -IMPLICIT NONE - - - ! Passed Variables: -REAL(ReKi),INTENT(IN) :: Rzero -REAL(ReKi) :: xphi - -INTEGER ,INTENT(IN) :: mode -INTEGER(IntKi), INTENT(OUT) :: ErrStat ! Error status of the operation -CHARACTER(*), INTENT(OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None - - - - -IF ( Rzero < 0. ) THEN - ErrStat = ErrID_Fatal - ErrMsg = 'Value of Rzero = '//TRIM(Num2LStr(Rzero))//' must be larger than 0 in xphi().' - RETURN -ELSE IF ( Rzero > 1. ) THEN - ErrStat = ErrID_Fatal - ErrMsg = 'Value of Rzero = '//TRIM(Num2LStr(Rzero))//' must be smaller than 1 in xphi().' - RETURN -ELSE - ErrStat = ErrID_None - ErrMsg = '' -ENDIF - -SELECT CASE ( mode ) - CASE (1) - xphi = 1.732051 - CASE (2) - xphi = 2.645751 - 6.6143783 * Rzero * Rzero - CASE (3) - xphi = 2.738613 * Rzero - CASE (4) - xphi = ( 6.708204 - 11.73936 * Rzero * Rzero ) * Rzero - CASE (5) - xphi = 3.622844 * Rzero * Rzero - CASE (6) - xphi = 4.437060 * Rzero * Rzero * Rzero - CASE DEFAULT - CALL ProgAbort('Integer MODE = '//TRIM(Int2LStr(MODE))//' must be 1 through 6.' ) -END SELECT - - - -RETURN -END FUNCTION xphi - - !*********************************************************************** - ! akihiro 06/25/00 - ! This subroutine is not currently used, may be used in the future. - ! - FUNCTION phis( Rzero, r, j ) - ! Calculates the PHI coefficients. This function is not used unless - ! the # of inflow states is increased greater than 10 (Mode 7 and higher) - ! *********************************************************************** - - -IMPLICIT NONE - - - ! Passed Variables: - -REAL(ReKi) :: phis -REAL(ReKi),INTENT(IN) :: Rzero - -INTEGER ,INTENT(IN) :: j -INTEGER ,INTENT(IN) :: r - - ! Local Variables: - -INTEGER :: q - - -IF ( Rzero < 0. ) THEN - CALL ProgAbort('Value of Rzero = '//TRIM(Num2LStr(Rzero))//' must be larger than 0 in phis().' ) -ELSE IF ( Rzero > 1. ) THEN - CALL ProgAbort('Value of Rzero = '//TRIM(Num2LStr(Rzero))//' must be smaller than 1 in phis().' ) -ENDIF - -phis = 0. - -DO q = r, j-1, 2 - phis = phis & - + Rzero ** q * (-1.) **((q-r)/2) * REAL( idubfact(j+q), ReKi ) & - / REAL( idubfact(q-r) * idubfact(q+r) * idubfact(j-q-1), ReKi ) -END DO !q - -phis = phis * SQRT( REAL( 2*j+1, ReKi ) * hfunc(r,j) ) - - -RETURN -END FUNCTION phis - - -!*********************************************************** -SUBROUTINE WindAzimuthZero (psi,VrotorY,VrotorZ,WindPsi) -! Subroutine added by JRS to define the zero azimuth datum in -! a wind based co-ordinate system, for USE in the dynamic inflow -! routines. -! Calculates the rotational measurement in radians -! of the resultant of two vectors, VrotorZ and VrotorY. -! VrotorZ is positive vertically upwards and negative vertically -! downwards, VrotorY is positive to the left and negative -! to the right, both when looking towards the rotor from upwind. -! Zero degrees azimuth is defined when veritically down -! and rises with a clockwise rotation. - - -IMPLICIT NONE - - - ! Passed Variables: -REAL(ReKi),INTENT(IN) :: psi,VrotorY,VrotorZ -REAL(ReKi),INTENT(OUT) :: WindPsi - -WindPsi = psi - ATAN2(VrotorY,-VrotorZ) - -RETURN -END SUBROUTINE WindAzimuthZero - - ! ************* END OF FILE *************** - -! ******************************************************************** -!==================================================================================================== -SUBROUTINE CheckRComp( P, x, xd, z, m, y, ErrStat, ErrMess, & - ADFile, HubRadius, TipRadius ) -! This routine checks to see if RElm(:) and DR(:) are compatible within a millimeter; -!---------------------------------------------------------------------------------------------------- - IMPLICIT NONE - TYPE(AD14_ParameterType), INTENT(IN) :: p ! Parameters - TYPE(AD14_ContinuousStateType), INTENT(INOUT) :: x ! Initial continuous states - TYPE(AD14_DiscreteStateType), INTENT(INOUT) :: xd ! Initial discrete states - TYPE(AD14_ConstraintStateType), INTENT(INOUT) :: z ! Initial guess of the constraint states - TYPE(AD14_MiscVarType), INTENT(INOUT) :: m ! Misc/optimization variables - TYPE(AD14_OutputType), INTENT(INOUT) :: y ! Initial system outputs (outputs are not calculated; - INTEGER, INTENT(OUT) :: ErrStat - CHARACTER(*), INTENT(OUT) :: ErrMess - - ! Passed variables - - CHARACTER(*), INTENT(IN) :: ADFile ! Name of the AeroDyn input file, used for printing error message - REAL(ReKi), INTENT(IN) :: HubRadius ! Hub radius, used to verify that RElm and DR are input correctly - REAL(ReKi), INTENT(IN) :: TipRadius ! Tip radius, used to verify that RElm and DR are input correctly - - - ! Local variables. - - REAL(ReKi) :: DRNodesNew(P%Element%NElm) ! Length of variable-spaced blade elements--calculated from input RElm(:). - REAL(ReKi) :: DRSum ! Sum of DRs--should be close to TipRadius - REAL(ReKi), PARAMETER :: EPS = EPSILON(HubRadius) ! A small value used to compare two numbers - - INTEGER :: I ! Generic index. - - CHARACTER(33) :: DRChange ! A string showing how to change DR to get campatibility - - - - ! Initialize ErrStat to 0 (no error): - - ErrStat = ErrID_None - ErrMess = "" - - - ! Calculate DRNodesNew(:) based on input RElm(:) and compare to input DR(:): - -! AssumedHubRadius = P%Element%RElm(1) - 0.5*P%Blade%DR(1) - DRNodesNew(1) = 2.0*( P%Element%RElm(1) - HubRadius ) - DRSum = DRNodesNew(1) + HubRadius - - IF ( DRNodesNew(1) <= EPS ) THEN ! Check to see if RElm(1) > HubRad; if not, ProgAbort program - ErrMess = 'CheckRComp: RElm(1) must be larger than the hub radius (HubRadius = RElm(1) - 0.5*DR(1)). ' - ErrStat = ErrID_Fatal - RETURN - ELSEIF ( ABS( DRNodesNew(1) - P%Blade%DR(1) ) > 0.001 ) THEN ! Check to see if the calculated DRNodes(1) is close to the inputted DRNodes(1); if not, set flag--this will cause the program to ProgAbort later. - !ErrMess = ' this error message will be written at the end of the routine ' - ErrStat = ErrID_Fatal - ENDIF - - DO I = 2,P%Element%NElm ! Loop through all but the innermost blade element - - DRNodesNew(I) = 2.0*( P%Element%RElm(I) - P%Element%RElm(I-1) ) - DRNodesNew(I-1) - DRSum = DRSum + DRNodesNew(I) - - - IF ( DRNodesNew(I) <= EPS ) THEN ! Check to see if it is possible to have compatible DR(:) with the input RElm(:); if not, abort program - ErrMess = 'CheckRComp: RElm('//TRIM( Int2LStr(I) )//') produces ill-conditioned DR(:)' - ErrStat = ErrID_Fatal - RETURN - ELSEIF ( ABS( DRNodesNew(I) - P%Blade%DR(I) ) > 0.001 ) THEN ! Check to see if the calculated DRNodes(I) is close to the inputted DRNodes(I); if not, set flag--this will cause the program to Abort later. - !ErrMess = ' this error message will be written at the end of the routine ' - ErrStat = ErrID_Fatal - ENDIF - - END DO ! I - all but the innermost blade element - - - ! Abort program if necessary - - IF ( ErrStat /= ErrID_None ) THEN - - ! Write error message since the input DR(:) are not close to the calculated DRNodesNew(:) - - ErrMess = ' Input values for DR(:) are not compatible with input RElm(:).' - CALL WrScr1(TRIM(ErrMess)) - CALL WrScr( ' To make them compatible, please modify DR in the AeroDyn input file, '// TRIM( ADFile ) //', as follows:' ) - CALL WrScr1(' DR (Old) --> DR (New) ') - - DO I = 1,P%Element%NElm - WRITE( DRChange, "(' ', F13.4, ' --> ', F13.4, ' ')" ) P%Blade%DR(I), DRNodesNew(I) - CALL WrScr( DRChange ) - ENDDO !I - - ErrMess = 'CheckRComp: '//TRIM(ErrMess) - RETURN - - ELSEIF ( ABS( DRSum - TipRadius ) > 0.001 ) THEN - - ! Abort program since SUM( DRNodes(:) ) /= ( TipRadius - HubRadius) - - ErrMess = 'CheckRComp: TipRadius must be equal to HubRadius + SUM( P%Blade%DR(:) ).' - ErrStat = ErrID_Fatal - - RETURN - - ENDIF - - - RETURN -END SUBROUTINE CheckRComp - - -END MODULE AeroSubs diff --git a/modules/aerodyn14/src/DWM.f90 b/modules/aerodyn14/src/DWM.f90 deleted file mode 100644 index 2889057e3c..0000000000 --- a/modules/aerodyn14/src/DWM.f90 +++ /dev/null @@ -1,341 +0,0 @@ -MODULE DWM - USE DWM_Types - USE NWTC_Library - USE DWM_Wake_Sub - - IMPLICIT NONE - - PRIVATE - - TYPE(ProgDesc), PARAMETER :: DWM_Ver = ProgDesc( 'DWM', '', '' ) - - ! ..... Public Subroutines ................................................................................................... - - PUBLIC :: DWM_Init ! Initialization routine - PUBLIC :: DWM_End ! Ending routine (includes clean up) - - PUBLIC :: DWM_UpdateStates ! Loose coupling routine for solving for constraint states, integrating - ! continuous states, and updating discrete states - - PUBLIC :: DWM_phase1 - - PUBLIC :: DWM_phase2 - - PUBLIC :: DWM_phase3 - -CONTAINS -!---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE DWM_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut, ErrStat, ErrMess ) -! -! 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. -!.................................................................................................................................. - USE InflowWind - - !bjj: for a true FAST module, u,p,x,xs,z,OtherState, and y should be INTENT(OUT) instead of INTENT(INOUT) - - TYPE(DWM_InitInputType), INTENT(INOUT) :: InitInp ! Input data for initialization routine - TYPE(DWM_InputType), INTENT(INOUT) :: u ! An initial guess for the input; input mesh must be defined - TYPE(DWM_ParameterType), INTENT(INOUT) :: p ! Parameters - TYPE(DWM_ContinuousStateType), INTENT(INOUT) :: x ! Initial continuous states - TYPE(DWM_DiscreteStateType), INTENT(INOUT) :: xd ! Initial discrete states - TYPE(DWM_ConstraintStateType), INTENT(INOUT) :: z ! Initial guess of the constraint states - TYPE(DWM_OtherStateType), INTENT(INOUT) :: OtherState ! Initial other states - TYPE(DWM_OutputType), INTENT(INOUT) :: y ! Initial system outputs (outputs are not calculated; - ! only the output mesh is initialized) - TYPE(DWM_MiscVarType), INTENT(INOUT) :: m ! Misc/optimization variables - 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(DWM_InitOutputType), INTENT( OUT) :: InitOut ! Output for initialization routine - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMess ! Error message if ErrStat /= ErrID_None - - - ! Initialize ErrStat - - ErrStat = ErrID_None - - ! Initialize the NWTC Subroutine Library - - CALL NWTC_Init( ) - - ! Display the module information - CALL WrScr('') - CALL DispNVD(DWM_Ver) - - ! read the wind file for DWM - - CALL WrScr(" Reading the wind file for DWM simulation." ) - - ! InitInp%IfW%InputFileName is already set in FAST - InitInp%IfW%UseInputFile = .TRUE. - InitInp%IfW%NumWindPoints = 1 - InitInp%IfW%lidar%SensorType = SensorType_None - InitInp%IfW%Use4Dext = .false. - - CALL InflowWind_Init( InitInp%IfW, u%IfW, p%IfW, x%IfW, xd%IfW, z%IfW, OtherState%IfW, y%IfW, m%IfW, & - Interval, InitOut%IfW, ErrStat, ErrMess ) - - ! Read the parameter data from the text input file - - CALL read_parameter_file( p ) - - ! Read the turbine position index - - CALL read_turbine_position( m, p, u ) - - ! Read the result from upwind turbines - - CALL read_upwind_result_file( m, p, u ) - -END SUBROUTINE DWM_Init - -!---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE DWM_End( u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMess ) -! This routine is called at the end of the simulation. -!.................................................................................................................................. - USE InflowWind - - TYPE(DWM_InputType), INTENT(INOUT) :: u ! System inputs - TYPE(DWM_ParameterType), INTENT(INOUT) :: p ! Parameters - TYPE(DWM_ContinuousStateType), INTENT(INOUT) :: x ! Continuous states - TYPE(DWM_DiscreteStateType), INTENT(INOUT) :: xd ! Discrete states - TYPE(DWM_ConstraintStateType), INTENT(INOUT) :: z ! Constraint states - TYPE(DWM_OtherStateType), INTENT(INOUT) :: OtherState ! Other/optimization states - TYPE(DWM_OutputType), INTENT(INOUT) :: y ! System outputs - TYPE(DWM_MiscVarType), INTENT(INOUT) :: m ! Misc/optimization variables - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMess ! Error message if ErrStat /= ErrID_None - - - - ! Initialize ErrStat - - ErrStat = ErrID_None - ErrMess = "" - - - ! Place any last minute operations or calculations here: - CALL DWM_phase4( u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMess ) - - CALL write_result_file( m, p, y, u ) - - CALL InflowWind_End( u%IfW, p%IfW, x%IfW, xd%IfW, z%IfW, OtherState%IfW, y%IfW, m%IfW, ErrStat, ErrMess ) - - ! Close files here: - - - - ! Destroy the input data: - - CALL DWM_DestroyInput( u, ErrStat, ErrMess ) - - - ! Destroy the parameter data: - - CALL DWM_DestroyParam( p, ErrStat, ErrMess ) - - - ! Destroy the state data: - - CALL DWM_DestroyContState( x, ErrStat, ErrMess ) - CALL DWM_DestroyDiscState( xd, ErrStat, ErrMess ) - CALL DWM_DestroyConstrState( z, ErrStat, ErrMess ) - CALL DWM_DestroyOtherState( OtherState, ErrStat, ErrMess ) - - - ! Destroy the output data: - - CALL DWM_DestroyOutput( y, ErrStat, ErrMess ) - - - -END SUBROUTINE DWM_End - -!---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE DWM_UpdateStates( Time, u, p, x, xd, z, OtherState, m, ErrStat, ErrMess ) -! Loose coupling routine for solving for constraint states, integrating continuous states, and updating discrete states -! Constraint states are solved for input Time; Continuous and discrete states are updated for Time + Interval -!.................................................................................................................................. - - REAL(DbKi), INTENT(IN ) :: Time ! Current simulation time in seconds - TYPE(DWM_InputType), INTENT(IN ) :: u ! Inputs at Time - TYPE(DWM_ParameterType), INTENT(IN ) :: p ! Parameters - TYPE(DWM_ContinuousStateType), INTENT(INOUT) :: x ! Input: Continuous states at Time; - ! Output: Continuous states at Time + Interval - TYPE(DWM_DiscreteStateType), INTENT(INOUT) :: xd ! Input: Discrete states at Time; - ! Output: Discrete states at Time + Interval - TYPE(DWM_ConstraintStateType), INTENT(INOUT) :: z ! Input: Constraint states at Time; - ! Output: Constraint states at Time + Interval - TYPE(DWM_OtherStateType), INTENT(INOUT) :: OtherState ! Input: Other states at Time; - ! Output: Other states at Time + Interval - TYPE(DWM_MiscVarType), INTENT(INOUT) :: m ! Misc/optimization variables - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMess ! Error message if ErrStat /= ErrID_None - - ErrStat = ErrID_None - ErrMess = "" - -END SUBROUTINE DWM_UpdateStates - -!--------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE DWM_phase1( Time, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMess ) -! DWM_phase1 subroutine -! it is called at every time step for each blade and element, -! used to superimpose the wake velocity from upwind turbine onto the downwind turbine in the AeroDyn_CalcOutput, -! then to perform loads and power analysis. -!................................................................................................................................. - - REAL(DbKi), INTENT(IN ) :: Time ! Current simulation time in seconds - TYPE(DWM_InputType), INTENT(IN ) :: u ! Inputs at Time - TYPE(DWM_ParameterType) ,INTENT(IN ) :: p ! Parameters - TYPE(DWM_ContinuousStateType) ,INTENT(IN ) :: x ! Continuous states at Time - TYPE(DWM_DiscreteStateType) ,INTENT(IN ) :: xd ! Discrete states at Time - TYPE(DWM_ConstraintStateType) ,INTENT(IN ) :: z ! Constraint states at Time - TYPE(DWM_OtherStateType), INTENT(IN ) :: OtherState ! Other states at Time - TYPE(DWM_OutputType), INTENT(INOUT) :: y ! Outputs computed at Time (Input only so that mesh con- - ! nectivity information does not have to be recalculated) - TYPE(DWM_MiscVarType), INTENT(INOUT) :: m ! Misc/optimization variables - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMess ! Error message if ErrStat /= ErrID_None - - ErrStat = ErrID_None - ErrMess = "" - - m%shifted_velocity_aerodyn = shifted_velocity( Time, p, m, m%position_y, m%position_z, & - u%upwind_result%upwind_meanU (m%DWM_tb%Aerodyn_turbine_num ),& - u%upwind_result%upwind_U (m%DWM_tb%Aerodyn_turbine_num,: ),& - u%upwind_result%upwind_wakecenter (m%DWM_tb%Aerodyn_turbine_num,:,:,:),& - p%RTPD %upwind_turbine_projected_distance(m%DWM_tb%Aerodyn_turbine_num ),& - p%RTPD %upwind_align_angle (m%DWM_tb%Aerodyn_turbine_num ) ) - -END SUBROUTINE DWM_phase1 - -!--------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE DWM_phase2( Time, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMess ) -! DWM phase2 subroutine -! it is called at every time step for each blade and element, -! used to calculate the average wind speed on blade for different nodal positions. -!................................................................................................................................. - - REAL(DbKi), INTENT(IN ) :: Time ! Current simulation time in seconds - TYPE(DWM_InputType) ,INTENT(IN ) :: u ! Inputs at Time - TYPE(DWM_ParameterType) ,INTENT(IN ) :: p ! Parameters - TYPE(DWM_ContinuousStateType) ,INTENT(IN ) :: x ! Continuous states at Time - TYPE(DWM_DiscreteStateType) ,INTENT(IN ) :: xd ! Discrete states at Time - TYPE(DWM_ConstraintStateType) ,INTENT(IN ) :: z ! Constraint states at Time - TYPE(DWM_OtherStateType), INTENT(IN ) :: OtherState ! Other states at Time - TYPE(DWM_OutputType), INTENT(INOUT) :: y ! Outputs computed at Time (Input only so that mesh con- - ! nectivity information does not have to be recalculated) - TYPE(DWM_MiscVarType), INTENT(INOUT) :: m ! Misc/optimization variables - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMess ! Error message if ErrStat /= ErrID_None - - ErrStat = ErrID_None - ErrMess = "" - - CALL turbine_average_velocity( p, m, m%U_velocity, m%DWM_tb%Blade_index, m%DWM_tb%Element_index, y%Mean_FFWS_array ) - - -END SUBROUTINE DWM_phase2 - -!--------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE DWM_phase3( Time, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMess ) -! DWM phase2 subroutine -! it is called at every time step (after finishing looping over the blade elements) , -! to calculate the cumulative time averaged induction factor. -!................................................................................................................................. - - REAL(DbKi), INTENT(IN ) :: Time ! Current simulation time in seconds - TYPE(DWM_InputType) ,INTENT(IN ) :: u ! Inputs at Time - TYPE(DWM_ParameterType) ,INTENT(IN ) :: p ! Parameters - TYPE(DWM_ContinuousStateType) ,INTENT(IN ) :: x ! Continuous states at Time - TYPE(DWM_DiscreteStateType) ,INTENT(IN ) :: xd ! Discrete states at Time - TYPE(DWM_ConstraintStateType) ,INTENT(IN ) :: z ! Constraint states at Time - TYPE(DWM_OtherStateType), INTENT(IN ) :: OtherState ! Other states at Time - TYPE(DWM_OutputType), INTENT(INOUT) :: y ! Outputs computed at Time (Input only so that mesh con- - ! nectivity information does not have to be recalculated) - TYPE(DWM_MiscVarType), INTENT(INOUT) :: m ! Misc/optimization variables - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMess ! Error message if ErrStat /= ErrID_None - - ErrStat = ErrID_None - ErrMess = "" - CALL filter_average_induction_factor( m, p, y, m%Nforce, p%ElementNum, m%blade_dr ) - - m%FAST_Time = Time - - -END SUBROUTINE DWM_phase3 - -!--------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE DWM_phase4( u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMess ) -! DWM phase2 subroutine -! contains the main subroutines that calculate the wake deficit and meandered wake center location. (no time integration) -!................................................................................................................................. - - TYPE(DWM_InputType), INTENT(INOUT) :: u ! Inputs at Time - TYPE(DWM_ParameterType), INTENT(INOUT) :: p ! Parameters - TYPE(DWM_ContinuousStateType), INTENT(INOUT) :: x ! Continuous states at Time - TYPE(DWM_DiscreteStateType), INTENT(INOUT) :: xd ! Discrete states at Time - TYPE(DWM_ConstraintStateType), INTENT(INOUT) :: z ! Constraint states at Time - TYPE(DWM_OtherStateType), INTENT(INOUT) :: OtherState ! Other/optimization states - TYPE(DWM_OutputType), INTENT(INOUT) :: y ! Outputs computed at Time (Input only so that mesh con- - ! nectivity information does not have to be recalculated) - TYPE(DWM_MiscVarType), INTENT(INOUT) :: m ! Misc/optimization variables - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMess ! Error message if ErrStat /= ErrID_None - - INTEGER :: I - - ErrStat = ErrID_None - ErrMess = "" - - !CALL calculate_SD_averagePower( OtherState,y ) - - CALL calculate_mean_u( m, p, u, p%ElementNum, p%ElementRad(:), y%Mean_FFWS, y%TI, m%FAST_Time) - - - CALL get_initial_condition ( m, p, u, y, y%induction_factor, p%ElementRad(:), p%ElementNum, y%r_initial, y%U_initial ) - - CALL calculate_wake ( m, p, y, y%r_initial, y%U_initial, p%ElementNum, y%wake_u, m%WMC%wake_width ) - - !--test-- - !ALLOCATE ( y%wake_u(1750,250) ) - !y%wake_u(:,:) = 0.75 - !m%DWDD%n_x_vector = 1750 - !m%DWDD%n_r_vector = 250 - !ALLOCATE ( m%DWDD%Turb_Stress_DWM (m%DWDD%n_x_vector,m%DWDD%n_r_vector)) - !m%DWDD%Turb_Stress_DWM = 0.1 - !m%DWDD%ppR = 50 - !------- - - CALL Get_wake_center ( OtherState, m, p, y, u, x, xd, z, m%WMC%wake_width, y%wake_position ) - - - IF (p%RTPD%downwindturbine_number >0 ) THEN - DO I = 1,p%RTPD%downwindturbine_number - CALL smooth_out_wake(m, p, y%wake_u,y%wake_position,u%Upwind_result%smoothed_velocity_array(I,:),p%RTPD%downwind_turbine_projected_distance(I),& - p%RTPD%downwind_align_angle(I),u%Upwind_result%vel_matrix(I,:,:)) - u%Upwind_result%TI_downstream (I) = TI_downstream_total (m, p, y, p%RTPD%downwind_turbine_projected_distance(I),& - p%RTPD%downwind_align_angle(I),u%Upwind_result%vel_matrix(I,:,:)) - u%Upwind_result%small_scale_TI_downstream (I) = smallscale_TI (m, p, y, p%RTPD%downwind_turbine_projected_distance(I),& - p%RTPD%downwind_align_angle(I),u%Upwind_result%vel_matrix(I,:,:)) - - END DO - END IF - - -END SUBROUTINE DWM_phase4 - -END MODULE DWM - - - - - \ No newline at end of file diff --git a/modules/aerodyn14/src/DWM_Types.f90 b/modules/aerodyn14/src/DWM_Types.f90 deleted file mode 100644 index 9e6784c86a..0000000000 --- a/modules/aerodyn14/src/DWM_Types.f90 +++ /dev/null @@ -1,10159 +0,0 @@ -!STARTOFREGISTRYGENERATEDFILE 'DWM_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 -!********************************************************************************************************************************* -! DWM_Types -!................................................................................................................................. -! This file is part of DWM. -! -! 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 DWM. 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 DWM_Types -!--------------------------------------------------------------------------------------------------------------------------------- -USE InflowWind_Types -USE NWTC_Library -IMPLICIT NONE -! ========= CVSD ======= - TYPE, PUBLIC :: CVSD - INTEGER(IntKi) :: counter = 0 !< [-] - REAL(ReKi) :: Denominator = 0.0 !< [-] - REAL(ReKi) :: Numerator = 0.0 !< [-] - END TYPE CVSD -! ======================= -! ========= turbine_average_velocity_data ======= - TYPE, PUBLIC :: turbine_average_velocity_data - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: average_velocity_array_temp !< the average velocity of the whole blade sections in a specific time step [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: average_velocity_array !< [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: swept_area !< [m2] - INTEGER(IntKi) :: time_step_velocity = -1 !< [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: time_step_velocity_array !< [-] - INTEGER(IntKi) :: time_step_pass_velocity = -1 !< [-] - INTEGER(IntKi) :: time_step_force = -1 !< [-] - END TYPE turbine_average_velocity_data -! ======================= -! ========= DWM_Wake_Deficit_Data ======= - TYPE, PUBLIC :: DWM_Wake_Deficit_Data - INTEGER(IntKi) :: np_x !< point per axial distance [-] - REAL(ReKi) :: X_length !< normalized length in axial direction [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Turb_Stress_DWM !< [-] - INTEGER(IntKi) :: n_x_vector !< [-] - INTEGER(IntKi) :: n_r_vector !< [-] - REAL(ReKi) :: ppR !< Point_per_R_resoulution [-] - END TYPE DWM_Wake_Deficit_Data -! ======================= -! ========= MeanderData ======= - TYPE, PUBLIC :: MeanderData - INTEGER(IntKi) :: scale_factor !< [-] - INTEGER(IntKi) :: moving_time !< [-] - END TYPE MeanderData -! ======================= -! ========= read_turbine_position_data ======= - TYPE, PUBLIC :: read_turbine_position_data - INTEGER(IntKi) :: SimulationOrder_index !< [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: Turbine_sort_order !< [-] - INTEGER(IntKi) :: WT_index !< wind turbine index in the wind farm [-] - INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: TurbineInfluenceData !< [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: upwind_turbine_index !< the upwind turbines that affecting this turbine [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: downwind_turbine_index !< [-] - INTEGER(IntKi) :: upwindturbine_number !< the number of upwind turbines affecting the downwind turbine [-] - INTEGER(IntKi) :: downwindturbine_number !< [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: turbine_windorigin_length !< [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: upwind_turbine_projected_distance !< the projected distance between two turbines [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: downwind_turbine_projected_distance !< [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: turbine_angle !< [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: upwind_align_angle !< the angle beween the line connecting the upwind turbine and this turbine and the wind direction vector [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: downwind_align_angle !< [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: upwind_turbine_Xcoor !< the coordinate of the upwind turbine which affects this investigated turbine [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: upwind_turbine_Ycoor !< [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: wind_farm_Xcoor !< the coordinates of all the turbines in the wind farm [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: wind_farm_Ycoor !< [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: downwind_turbine_Xcoor !< the coordinate of the downwind turbine which is affected by this investigated turbine [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: downwind_turbine_Ycoor !< [-] - END TYPE read_turbine_position_data -! ======================= -! ========= WeiMethod ======= - TYPE, PUBLIC :: WeiMethod - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: sweptarea !< [-] - REAL(ReKi) :: weighting_denominator !< [-] - END TYPE WeiMethod -! ======================= -! ========= TIDownstream ======= - TYPE, PUBLIC :: TIDownstream - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: TI_downstream_matrix !< [-] - INTEGER(IntKi) :: i !< [-] - INTEGER(IntKi) :: j !< [-] - INTEGER(IntKi) :: k !< [-] - INTEGER(IntKi) :: cross_plane_position_ds !< the cross plane position which to be investigated in term of the flying time [-] - INTEGER(IntKi) :: cross_plane_position_TI !< the cross plane position which to be investigated in term of the n_x_vector [-] - INTEGER(IntKi) :: distance_index !< the index of the distance in the TI axisymmetric array [-] - INTEGER(IntKi) :: counter1 !< [-] - INTEGER(IntKi) :: counter2 !< [-] - INTEGER(IntKi) :: initial_timestep !< [-] - REAL(ReKi) :: y_axis_turbine !< [-] - REAL(ReKi) :: z_axis_turbine !< [-] - REAL(ReKi) :: distance !< the distance between one point to the meandered wake center [-] - REAL(ReKi) :: TI_downstream_node !< the TI at a specfic point in the inbestigated cross plane [-] - REAL(ReKi) :: TI_node_temp !< [-] - REAL(ReKi) :: TI_node !< [-] - REAL(ReKi) :: TI_accumulation !< [-] - REAL(ReKi) :: TI_apprant_accumulation !< [-] - REAL(ReKi) :: TI_average !< THE AVERAGE TI OF THE CROSS PLANE [-] - REAL(ReKi) :: TI_apprant !< The TI due to the meadering [-] - REAL(ReKi) :: HubHt !< [-] - REAL(ReKi) :: wake_center_y !< [-] - REAL(ReKi) :: wake_center_z !< [-] - REAL(ReKi) :: Rscale !< [-] - REAL(ReKi) :: y !< [-] - REAL(ReKi) :: z !< [-] - REAL(ReKi) :: zero_spacing !< [-] - REAL(ReKi) :: temp1 !< [-] - REAL(ReKi) :: temp2 !< [-] - REAL(ReKi) :: temp3 !< [-] - END TYPE TIDownstream -! ======================= -! ========= TurbKaimal ======= - TYPE, PUBLIC :: TurbKaimal - INTEGER(IntKi) :: fs !< sample frequency [-] - INTEGER(IntKi) :: temp_n !< [-] - INTEGER(IntKi) :: i !< [-] - REAL(ReKi) :: low_f !< lower bound of frequency range [-] - REAL(ReKi) :: high_f !< upper bound of frequency range [-] - REAL(ReKi) :: lk_facor !< turbulence length-scale [-] - REAL(ReKi) :: STD !< standard deviation of the turbulence [-] - END TYPE TurbKaimal -! ======================= -! ========= Shinozuka ======= - TYPE, PUBLIC :: Shinozuka - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: f_syn !< frequency series [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: t_syn !< time series [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: phi !< random phase angle [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: p_k !< [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: a_k !< [-] - INTEGER(IntKi) :: num_points !< total number of points [-] - INTEGER(IntKi) :: ILo !< [-] - INTEGER(IntKi) :: i !< [-] - INTEGER(IntKi) :: j !< [-] - REAL(ReKi) :: dt !< time step [-] - REAL(ReKi) :: t_min !< [-] - REAL(ReKi) :: t_max !< [-] - REAL(ReKi) :: df !< frequency step [-] - END TYPE Shinozuka -! ======================= -! ========= smooth_out_wake_data ======= - TYPE, PUBLIC :: smooth_out_wake_data - INTEGER(IntKi) :: length_velocity_array !< the length of velocity_array [-] - END TYPE smooth_out_wake_data -! ======================= -! ========= SWSV ======= - TYPE, PUBLIC :: SWSV - INTEGER(IntKi) :: p1 !< [-] - INTEGER(IntKi) :: p2 !< [-] - REAL(ReKi) :: distance !< the distance from the point to the meandered wake center [-] - REAL(ReKi) :: y0 !< wake center position on y axis [-] - REAL(ReKi) :: z0 !< wake center position on z axis [-] - REAL(ReKi) :: unit !< single unit length R/ppR [-] - END TYPE SWSV -! ======================= -! ========= read_upwind_result ======= - TYPE, PUBLIC :: read_upwind_result - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: upwind_U !< [-] - REAL(ReKi) , DIMENSION(:,:,:,:), ALLOCATABLE :: upwind_wakecenter !< [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: upwind_meanU !< [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: upwind_TI !< [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: upwind_small_TI !< [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: upwind_smoothWake !< [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: velocity_aerodyn !< [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TI_downstream !< [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: small_scale_TI_downstream !< [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: smoothed_velocity_array !< [-] - REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: vel_matrix !< The smoothed out wake velocity matrix for n downwind turbine [-] - END TYPE read_upwind_result -! ======================= -! ========= wake_meandered_center ======= - TYPE, PUBLIC :: wake_meandered_center - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: wake_width !< wake width [-] - END TYPE wake_meandered_center -! ======================= -! ========= DWM_turbine_blade ======= - TYPE, PUBLIC :: DWM_turbine_blade - INTEGER(IntKi) :: Aerodyn_turbine_num !< [-] - INTEGER(IntKi) :: Blade_index !< the index of Aerodyn Blade [-] - INTEGER(IntKi) :: Element_index !< the index of Aerodyn Element [-] - END TYPE DWM_turbine_blade -! ======================= -! ========= DWM_ParameterType ======= - TYPE, PUBLIC :: DWM_ParameterType - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: velocityU !< the wake velocity profile @ the downstream turbine plane [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: smoothed_wake !< [-] - REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: WakePosition !< meandered wake center [-] - INTEGER(IntKi) :: WakePosition_1 !< size of the WakePosition [-] - INTEGER(IntKi) :: WakePosition_2 !< size of the WakePosition [-] - INTEGER(IntKi) :: smooth_flag !< Whether or not use the smoothed out upstream wake profile (1-yes, 0-no) [-] - INTEGER(IntKi) :: p_p_r !< [-] - INTEGER(IntKi) :: NumWT !< Number of wind turbines [-] - INTEGER(IntKi) :: Tinfluencer !< [-] - REAL(ReKi) :: RotorR !< Rotor radius [-] - REAL(ReKi) :: r_domain !< [-] - REAL(ReKi) :: x_domain !< [-] - REAL(ReKi) :: Uambient !< The ambient wind velocity [-] - REAL(ReKi) :: TI_amb !< Ambient turbulence intensity [%] - REAL(ReKi) :: TI_wake !< [-] - REAL(ReKi) :: hub_height !< [-] - REAL(ReKi) :: length_velocityU !< [-] - REAL(ReKi) :: WFLowerBd !< The lower bound height of the wind file [-] - REAL(ReKi) :: Wind_file_Mean_u !< The mean velocity of the first turbine [-] - REAL(ReKi) :: Winddir !< [-] - REAL(ReKi) :: air_density !< air density [-] - REAL(ReKi) :: RR !< [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: ElementRad !< the element node radius [-] - INTEGER(IntKi) :: Bnum !< the number of blade [-] - INTEGER(IntKi) :: ElementNum !< the number of element [-] - TYPE(read_turbine_position_data) :: RTPD - TYPE(InflowWind_ParameterType) :: IfW - END TYPE DWM_ParameterType -! ======================= -! ========= DWM_OtherStateType ======= - TYPE, PUBLIC :: DWM_OtherStateType - TYPE(InflowWind_OtherStateType) :: IfW - END TYPE DWM_OtherStateType -! ======================= -! ========= DWM_MiscVarType ======= - TYPE, PUBLIC :: DWM_MiscVarType - TYPE(InflowWind_MiscVarType) :: IfW - REAL(ReKi) :: position_y !< the y position of the blade node [-] - REAL(ReKi) :: position_z !< the z position of the blade node [-] - REAL(ReKi) :: velocity_wake_mean !< [-] - REAL(ReKi) :: shifted_velocity_Aerodyn !< [-] - REAL(ReKi) :: U_velocity !< the u component velocity of blade [-] - REAL(ReKi) :: V_velocity !< the v component velocity of blade [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Nforce !< the normal force [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: blade_dr !< blade dr [-] - REAL(ReKi) :: NacYaw !< [-] - REAL(ReKi) :: TI_original !< [-] - TYPE(turbine_average_velocity_data) :: TAVD - TYPE(CVSD) :: CalVelScale_data - TYPE(MeanderData) :: meandering_data - TYPE(WeiMethod) :: weighting_method - TYPE(TIDownstream) :: TI_downstream_data - TYPE(TurbKaimal) :: Turbulence_KS - TYPE(Shinozuka) :: shinozuka_data - TYPE(smooth_out_wake_data) :: SmoothOut - TYPE(SWSV) :: smooth_wake_shifted_velocity_data - TYPE(DWM_Wake_Deficit_Data) :: DWDD - REAL(ReKi) :: ct_tilde !< the tilde Ct [-] - REAL(ReKi) :: FAST_Time !< FAST simulation time [-] - INTEGER(IntKi) :: SDtimestep = 0 !< [-] - TYPE(DWM_turbine_blade) :: DWM_tb - TYPE(wake_meandered_center) :: WMC - END TYPE DWM_MiscVarType -! ======================= -! ========= DWM_InputType ======= - TYPE, PUBLIC :: DWM_InputType - TYPE(read_upwind_result) :: Upwind_result - TYPE(InflowWind_InputType) :: IfW - END TYPE DWM_InputType -! ======================= -! ========= DWM_OutputType ======= - TYPE, PUBLIC :: DWM_OutputType - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: turbine_thrust_force !< [N] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: induction_factor !< [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: r_initial !< scaled rotor radius [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: U_initial !< scaled velocity at the rotor [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Mean_FFWS_array !< Mean velocity of each section on the blade [-] - REAL(ReKi) :: Mean_FFWS !< Mean (total) wind speed at the hub height [m/s] - REAL(ReKi) :: TI !< the turbulence intensity of the turbine [-] - REAL(ReKi) :: TI_downstream !< the TI of a downstream turbine before normalization [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: wake_u !< wake velocity [-] - REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: wake_position !< wake center position [m] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: smoothed_velocity_array !< smoothed out upstream axisymetric wake profile [-] - REAL(ReKi) :: AtmUscale !< atmospheric velocity scale before introducing TI [-] - REAL(ReKi) :: du_dz_ABL !< atmosperic shear gradient [-] - REAL(ReKi) :: total_SDgenpwr = 0.0 !< [-] - REAL(ReKi) :: mean_SDgenpwr !< [-] - REAL(ReKi) :: avg_ct !< average Ct over the rotor [-] - TYPE(InflowWind_OutputType) :: IfW - END TYPE DWM_OutputType -! ======================= -! ========= DWM_ContinuousStateType ======= - TYPE, PUBLIC :: DWM_ContinuousStateType - REAL(ReKi) :: dummy !< [-] - TYPE(InflowWind_ContinuousStateType) :: IfW - END TYPE DWM_ContinuousStateType -! ======================= -! ========= DWM_DiscreteStateType ======= - TYPE, PUBLIC :: DWM_DiscreteStateType - REAL(ReKi) :: dummy !< [-] - TYPE(InflowWind_DiscreteStateType) :: IfW - END TYPE DWM_DiscreteStateType -! ======================= -! ========= DWM_ConstraintStateType ======= - TYPE, PUBLIC :: DWM_ConstraintStateType - REAL(ReKi) :: dummy !< [-] - TYPE(InflowWind_ConstraintStateType) :: IfW - END TYPE DWM_ConstraintStateType -! ======================= -! ========= DWM_InitInputType ======= - TYPE, PUBLIC :: DWM_InitInputType - REAL(ReKi) :: dummy !< [-] - TYPE(InflowWind_InitInputType) :: IfW - END TYPE DWM_InitInputType -! ======================= -! ========= DWM_InitOutputType ======= - TYPE, PUBLIC :: DWM_InitOutputType - REAL(ReKi) :: dummy !< [-] - TYPE(InflowWind_InitOutputType) :: IfW - END TYPE DWM_InitOutputType -! ======================= -CONTAINS - SUBROUTINE DWM_CopyCVSD( SrcCVSDData, DstCVSDData, CtrlCode, ErrStat, ErrMsg ) - TYPE(CVSD), INTENT(IN) :: SrcCVSDData - TYPE(CVSD), INTENT(INOUT) :: DstCVSDData - 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 = 'DWM_CopyCVSD' -! - ErrStat = ErrID_None - ErrMsg = "" - DstCVSDData%counter = SrcCVSDData%counter - DstCVSDData%Denominator = SrcCVSDData%Denominator - DstCVSDData%Numerator = SrcCVSDData%Numerator - END SUBROUTINE DWM_CopyCVSD - - SUBROUTINE DWM_DestroyCVSD( CVSDData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(CVSD), INTENT(INOUT) :: CVSDData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_DestroyCVSD' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE DWM_DestroyCVSD - - SUBROUTINE DWM_PackCVSD( 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(CVSD), 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 = 'DWM_PackCVSD' - ! 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 ! counter - Re_BufSz = Re_BufSz + 1 ! Denominator - Re_BufSz = Re_BufSz + 1 ! Numerator - 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%counter - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Denominator - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Numerator - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE DWM_PackCVSD - - SUBROUTINE DWM_UnPackCVSD( 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(CVSD), 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 = 'DWM_UnPackCVSD' - ! 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%counter = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%Denominator = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Numerator = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE DWM_UnPackCVSD - - SUBROUTINE DWM_Copyturbine_average_velocity_data( Srcturbine_average_velocity_dataData, Dstturbine_average_velocity_dataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(turbine_average_velocity_data), INTENT(IN) :: Srcturbine_average_velocity_dataData - TYPE(turbine_average_velocity_data), INTENT(INOUT) :: Dstturbine_average_velocity_dataData - 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 = 'DWM_Copyturbine_average_velocity_data' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(Srcturbine_average_velocity_dataData%average_velocity_array_temp)) THEN - i1_l = LBOUND(Srcturbine_average_velocity_dataData%average_velocity_array_temp,1) - i1_u = UBOUND(Srcturbine_average_velocity_dataData%average_velocity_array_temp,1) - IF (.NOT. ALLOCATED(Dstturbine_average_velocity_dataData%average_velocity_array_temp)) THEN - ALLOCATE(Dstturbine_average_velocity_dataData%average_velocity_array_temp(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Dstturbine_average_velocity_dataData%average_velocity_array_temp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - Dstturbine_average_velocity_dataData%average_velocity_array_temp = Srcturbine_average_velocity_dataData%average_velocity_array_temp -ENDIF -IF (ALLOCATED(Srcturbine_average_velocity_dataData%average_velocity_array)) THEN - i1_l = LBOUND(Srcturbine_average_velocity_dataData%average_velocity_array,1) - i1_u = UBOUND(Srcturbine_average_velocity_dataData%average_velocity_array,1) - IF (.NOT. ALLOCATED(Dstturbine_average_velocity_dataData%average_velocity_array)) THEN - ALLOCATE(Dstturbine_average_velocity_dataData%average_velocity_array(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Dstturbine_average_velocity_dataData%average_velocity_array.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - Dstturbine_average_velocity_dataData%average_velocity_array = Srcturbine_average_velocity_dataData%average_velocity_array -ENDIF -IF (ALLOCATED(Srcturbine_average_velocity_dataData%swept_area)) THEN - i1_l = LBOUND(Srcturbine_average_velocity_dataData%swept_area,1) - i1_u = UBOUND(Srcturbine_average_velocity_dataData%swept_area,1) - IF (.NOT. ALLOCATED(Dstturbine_average_velocity_dataData%swept_area)) THEN - ALLOCATE(Dstturbine_average_velocity_dataData%swept_area(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Dstturbine_average_velocity_dataData%swept_area.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - Dstturbine_average_velocity_dataData%swept_area = Srcturbine_average_velocity_dataData%swept_area -ENDIF - Dstturbine_average_velocity_dataData%time_step_velocity = Srcturbine_average_velocity_dataData%time_step_velocity -IF (ALLOCATED(Srcturbine_average_velocity_dataData%time_step_velocity_array)) THEN - i1_l = LBOUND(Srcturbine_average_velocity_dataData%time_step_velocity_array,1) - i1_u = UBOUND(Srcturbine_average_velocity_dataData%time_step_velocity_array,1) - IF (.NOT. ALLOCATED(Dstturbine_average_velocity_dataData%time_step_velocity_array)) THEN - ALLOCATE(Dstturbine_average_velocity_dataData%time_step_velocity_array(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Dstturbine_average_velocity_dataData%time_step_velocity_array.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - Dstturbine_average_velocity_dataData%time_step_velocity_array = Srcturbine_average_velocity_dataData%time_step_velocity_array -ENDIF - Dstturbine_average_velocity_dataData%time_step_pass_velocity = Srcturbine_average_velocity_dataData%time_step_pass_velocity - Dstturbine_average_velocity_dataData%time_step_force = Srcturbine_average_velocity_dataData%time_step_force - END SUBROUTINE DWM_Copyturbine_average_velocity_data - - SUBROUTINE DWM_Destroyturbine_average_velocity_data( turbine_average_velocity_dataData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(turbine_average_velocity_data), INTENT(INOUT) :: turbine_average_velocity_dataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_Destroyturbine_average_velocity_data' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(turbine_average_velocity_dataData%average_velocity_array_temp)) THEN - DEALLOCATE(turbine_average_velocity_dataData%average_velocity_array_temp) -ENDIF -IF (ALLOCATED(turbine_average_velocity_dataData%average_velocity_array)) THEN - DEALLOCATE(turbine_average_velocity_dataData%average_velocity_array) -ENDIF -IF (ALLOCATED(turbine_average_velocity_dataData%swept_area)) THEN - DEALLOCATE(turbine_average_velocity_dataData%swept_area) -ENDIF -IF (ALLOCATED(turbine_average_velocity_dataData%time_step_velocity_array)) THEN - DEALLOCATE(turbine_average_velocity_dataData%time_step_velocity_array) -ENDIF - END SUBROUTINE DWM_Destroyturbine_average_velocity_data - - SUBROUTINE DWM_Packturbine_average_velocity_data( 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(turbine_average_velocity_data), 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 = 'DWM_Packturbine_average_velocity_data' - ! 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 ! average_velocity_array_temp allocated yes/no - IF ( ALLOCATED(InData%average_velocity_array_temp) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! average_velocity_array_temp upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%average_velocity_array_temp) ! average_velocity_array_temp - END IF - Int_BufSz = Int_BufSz + 1 ! average_velocity_array allocated yes/no - IF ( ALLOCATED(InData%average_velocity_array) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! average_velocity_array upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%average_velocity_array) ! average_velocity_array - END IF - Int_BufSz = Int_BufSz + 1 ! swept_area allocated yes/no - IF ( ALLOCATED(InData%swept_area) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! swept_area upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%swept_area) ! swept_area - END IF - Int_BufSz = Int_BufSz + 1 ! time_step_velocity - Int_BufSz = Int_BufSz + 1 ! time_step_velocity_array allocated yes/no - IF ( ALLOCATED(InData%time_step_velocity_array) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! time_step_velocity_array upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%time_step_velocity_array) ! time_step_velocity_array - END IF - Int_BufSz = Int_BufSz + 1 ! time_step_pass_velocity - Int_BufSz = Int_BufSz + 1 ! time_step_force - 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%average_velocity_array_temp) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%average_velocity_array_temp,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%average_velocity_array_temp,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%average_velocity_array_temp,1), UBOUND(InData%average_velocity_array_temp,1) - ReKiBuf(Re_Xferred) = InData%average_velocity_array_temp(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%average_velocity_array) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%average_velocity_array,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%average_velocity_array,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%average_velocity_array,1), UBOUND(InData%average_velocity_array,1) - ReKiBuf(Re_Xferred) = InData%average_velocity_array(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%swept_area) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%swept_area,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%swept_area,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%swept_area,1), UBOUND(InData%swept_area,1) - ReKiBuf(Re_Xferred) = InData%swept_area(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%time_step_velocity - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%time_step_velocity_array) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%time_step_velocity_array,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%time_step_velocity_array,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%time_step_velocity_array,1), UBOUND(InData%time_step_velocity_array,1) - IntKiBuf(Int_Xferred) = InData%time_step_velocity_array(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%time_step_pass_velocity - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%time_step_force - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE DWM_Packturbine_average_velocity_data - - SUBROUTINE DWM_UnPackturbine_average_velocity_data( 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(turbine_average_velocity_data), 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 = 'DWM_UnPackturbine_average_velocity_data' - ! 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 ! average_velocity_array_temp not allocated - Int_Xferred = Int_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%average_velocity_array_temp)) DEALLOCATE(OutData%average_velocity_array_temp) - ALLOCATE(OutData%average_velocity_array_temp(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%average_velocity_array_temp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%average_velocity_array_temp,1), UBOUND(OutData%average_velocity_array_temp,1) - OutData%average_velocity_array_temp(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! average_velocity_array not allocated - Int_Xferred = Int_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%average_velocity_array)) DEALLOCATE(OutData%average_velocity_array) - ALLOCATE(OutData%average_velocity_array(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%average_velocity_array.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%average_velocity_array,1), UBOUND(OutData%average_velocity_array,1) - OutData%average_velocity_array(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! swept_area not allocated - Int_Xferred = Int_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%swept_area)) DEALLOCATE(OutData%swept_area) - ALLOCATE(OutData%swept_area(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%swept_area.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%swept_area,1), UBOUND(OutData%swept_area,1) - OutData%swept_area(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%time_step_velocity = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! time_step_velocity_array not allocated - Int_Xferred = Int_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%time_step_velocity_array)) DEALLOCATE(OutData%time_step_velocity_array) - ALLOCATE(OutData%time_step_velocity_array(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%time_step_velocity_array.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%time_step_velocity_array,1), UBOUND(OutData%time_step_velocity_array,1) - OutData%time_step_velocity_array(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - OutData%time_step_pass_velocity = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%time_step_force = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE DWM_UnPackturbine_average_velocity_data - - SUBROUTINE DWM_CopyWake_Deficit_Data( SrcWake_Deficit_DataData, DstWake_Deficit_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(DWM_Wake_Deficit_Data), INTENT(IN) :: SrcWake_Deficit_DataData - TYPE(DWM_Wake_Deficit_Data), INTENT(INOUT) :: DstWake_Deficit_DataData - 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 = 'DWM_CopyWake_Deficit_Data' -! - ErrStat = ErrID_None - ErrMsg = "" - DstWake_Deficit_DataData%np_x = SrcWake_Deficit_DataData%np_x - DstWake_Deficit_DataData%X_length = SrcWake_Deficit_DataData%X_length -IF (ALLOCATED(SrcWake_Deficit_DataData%Turb_Stress_DWM)) THEN - i1_l = LBOUND(SrcWake_Deficit_DataData%Turb_Stress_DWM,1) - i1_u = UBOUND(SrcWake_Deficit_DataData%Turb_Stress_DWM,1) - i2_l = LBOUND(SrcWake_Deficit_DataData%Turb_Stress_DWM,2) - i2_u = UBOUND(SrcWake_Deficit_DataData%Turb_Stress_DWM,2) - IF (.NOT. ALLOCATED(DstWake_Deficit_DataData%Turb_Stress_DWM)) THEN - ALLOCATE(DstWake_Deficit_DataData%Turb_Stress_DWM(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWake_Deficit_DataData%Turb_Stress_DWM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWake_Deficit_DataData%Turb_Stress_DWM = SrcWake_Deficit_DataData%Turb_Stress_DWM -ENDIF - DstWake_Deficit_DataData%n_x_vector = SrcWake_Deficit_DataData%n_x_vector - DstWake_Deficit_DataData%n_r_vector = SrcWake_Deficit_DataData%n_r_vector - DstWake_Deficit_DataData%ppR = SrcWake_Deficit_DataData%ppR - END SUBROUTINE DWM_CopyWake_Deficit_Data - - SUBROUTINE DWM_DestroyWake_Deficit_Data( Wake_Deficit_DataData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(DWM_Wake_Deficit_Data), INTENT(INOUT) :: Wake_Deficit_DataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_DestroyWake_Deficit_Data' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(Wake_Deficit_DataData%Turb_Stress_DWM)) THEN - DEALLOCATE(Wake_Deficit_DataData%Turb_Stress_DWM) -ENDIF - END SUBROUTINE DWM_DestroyWake_Deficit_Data - - SUBROUTINE DWM_PackWake_Deficit_Data( 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(DWM_Wake_Deficit_Data), 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 = 'DWM_PackWake_Deficit_Data' - ! 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 ! np_x - Re_BufSz = Re_BufSz + 1 ! X_length - Int_BufSz = Int_BufSz + 1 ! Turb_Stress_DWM allocated yes/no - IF ( ALLOCATED(InData%Turb_Stress_DWM) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Turb_Stress_DWM upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Turb_Stress_DWM) ! Turb_Stress_DWM - END IF - Int_BufSz = Int_BufSz + 1 ! n_x_vector - Int_BufSz = Int_BufSz + 1 ! n_r_vector - Re_BufSz = Re_BufSz + 1 ! ppR - 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%np_x - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%X_length - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%Turb_Stress_DWM) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Turb_Stress_DWM,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Turb_Stress_DWM,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Turb_Stress_DWM,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Turb_Stress_DWM,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Turb_Stress_DWM,2), UBOUND(InData%Turb_Stress_DWM,2) - DO i1 = LBOUND(InData%Turb_Stress_DWM,1), UBOUND(InData%Turb_Stress_DWM,1) - ReKiBuf(Re_Xferred) = InData%Turb_Stress_DWM(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%n_x_vector - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%n_r_vector - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%ppR - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE DWM_PackWake_Deficit_Data - - SUBROUTINE DWM_UnPackWake_Deficit_Data( 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(DWM_Wake_Deficit_Data), 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 = 'DWM_UnPackWake_Deficit_Data' - ! 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%np_x = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%X_length = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Turb_Stress_DWM not allocated - Int_Xferred = Int_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%Turb_Stress_DWM)) DEALLOCATE(OutData%Turb_Stress_DWM) - ALLOCATE(OutData%Turb_Stress_DWM(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Turb_Stress_DWM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Turb_Stress_DWM,2), UBOUND(OutData%Turb_Stress_DWM,2) - DO i1 = LBOUND(OutData%Turb_Stress_DWM,1), UBOUND(OutData%Turb_Stress_DWM,1) - OutData%Turb_Stress_DWM(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%n_x_vector = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%n_r_vector = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%ppR = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE DWM_UnPackWake_Deficit_Data - - SUBROUTINE DWM_CopyMeanderData( SrcMeanderDataData, DstMeanderDataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MeanderData), INTENT(IN) :: SrcMeanderDataData - TYPE(MeanderData), INTENT(INOUT) :: DstMeanderDataData - 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 = 'DWM_CopyMeanderData' -! - ErrStat = ErrID_None - ErrMsg = "" - DstMeanderDataData%scale_factor = SrcMeanderDataData%scale_factor - DstMeanderDataData%moving_time = SrcMeanderDataData%moving_time - END SUBROUTINE DWM_CopyMeanderData - - SUBROUTINE DWM_DestroyMeanderData( MeanderDataData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(MeanderData), INTENT(INOUT) :: MeanderDataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_DestroyMeanderData' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE DWM_DestroyMeanderData - - SUBROUTINE DWM_PackMeanderData( 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(MeanderData), 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 = 'DWM_PackMeanderData' - ! 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 ! scale_factor - Int_BufSz = Int_BufSz + 1 ! moving_time - 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%scale_factor - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%moving_time - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE DWM_PackMeanderData - - SUBROUTINE DWM_UnPackMeanderData( 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(MeanderData), 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 = 'DWM_UnPackMeanderData' - ! 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%scale_factor = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%moving_time = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE DWM_UnPackMeanderData - - SUBROUTINE DWM_Copyread_turbine_position_data( Srcread_turbine_position_dataData, Dstread_turbine_position_dataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(read_turbine_position_data), INTENT(IN) :: Srcread_turbine_position_dataData - TYPE(read_turbine_position_data), INTENT(INOUT) :: Dstread_turbine_position_dataData - 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 = 'DWM_Copyread_turbine_position_data' -! - ErrStat = ErrID_None - ErrMsg = "" - Dstread_turbine_position_dataData%SimulationOrder_index = Srcread_turbine_position_dataData%SimulationOrder_index -IF (ALLOCATED(Srcread_turbine_position_dataData%Turbine_sort_order)) THEN - i1_l = LBOUND(Srcread_turbine_position_dataData%Turbine_sort_order,1) - i1_u = UBOUND(Srcread_turbine_position_dataData%Turbine_sort_order,1) - IF (.NOT. ALLOCATED(Dstread_turbine_position_dataData%Turbine_sort_order)) THEN - ALLOCATE(Dstread_turbine_position_dataData%Turbine_sort_order(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Dstread_turbine_position_dataData%Turbine_sort_order.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - Dstread_turbine_position_dataData%Turbine_sort_order = Srcread_turbine_position_dataData%Turbine_sort_order -ENDIF - Dstread_turbine_position_dataData%WT_index = Srcread_turbine_position_dataData%WT_index -IF (ALLOCATED(Srcread_turbine_position_dataData%TurbineInfluenceData)) THEN - i1_l = LBOUND(Srcread_turbine_position_dataData%TurbineInfluenceData,1) - i1_u = UBOUND(Srcread_turbine_position_dataData%TurbineInfluenceData,1) - i2_l = LBOUND(Srcread_turbine_position_dataData%TurbineInfluenceData,2) - i2_u = UBOUND(Srcread_turbine_position_dataData%TurbineInfluenceData,2) - IF (.NOT. ALLOCATED(Dstread_turbine_position_dataData%TurbineInfluenceData)) THEN - ALLOCATE(Dstread_turbine_position_dataData%TurbineInfluenceData(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Dstread_turbine_position_dataData%TurbineInfluenceData.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - Dstread_turbine_position_dataData%TurbineInfluenceData = Srcread_turbine_position_dataData%TurbineInfluenceData -ENDIF -IF (ALLOCATED(Srcread_turbine_position_dataData%upwind_turbine_index)) THEN - i1_l = LBOUND(Srcread_turbine_position_dataData%upwind_turbine_index,1) - i1_u = UBOUND(Srcread_turbine_position_dataData%upwind_turbine_index,1) - IF (.NOT. ALLOCATED(Dstread_turbine_position_dataData%upwind_turbine_index)) THEN - ALLOCATE(Dstread_turbine_position_dataData%upwind_turbine_index(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Dstread_turbine_position_dataData%upwind_turbine_index.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - Dstread_turbine_position_dataData%upwind_turbine_index = Srcread_turbine_position_dataData%upwind_turbine_index -ENDIF -IF (ALLOCATED(Srcread_turbine_position_dataData%downwind_turbine_index)) THEN - i1_l = LBOUND(Srcread_turbine_position_dataData%downwind_turbine_index,1) - i1_u = UBOUND(Srcread_turbine_position_dataData%downwind_turbine_index,1) - IF (.NOT. ALLOCATED(Dstread_turbine_position_dataData%downwind_turbine_index)) THEN - ALLOCATE(Dstread_turbine_position_dataData%downwind_turbine_index(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Dstread_turbine_position_dataData%downwind_turbine_index.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - Dstread_turbine_position_dataData%downwind_turbine_index = Srcread_turbine_position_dataData%downwind_turbine_index -ENDIF - Dstread_turbine_position_dataData%upwindturbine_number = Srcread_turbine_position_dataData%upwindturbine_number - Dstread_turbine_position_dataData%downwindturbine_number = Srcread_turbine_position_dataData%downwindturbine_number -IF (ALLOCATED(Srcread_turbine_position_dataData%turbine_windorigin_length)) THEN - i1_l = LBOUND(Srcread_turbine_position_dataData%turbine_windorigin_length,1) - i1_u = UBOUND(Srcread_turbine_position_dataData%turbine_windorigin_length,1) - IF (.NOT. ALLOCATED(Dstread_turbine_position_dataData%turbine_windorigin_length)) THEN - ALLOCATE(Dstread_turbine_position_dataData%turbine_windorigin_length(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Dstread_turbine_position_dataData%turbine_windorigin_length.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - Dstread_turbine_position_dataData%turbine_windorigin_length = Srcread_turbine_position_dataData%turbine_windorigin_length -ENDIF -IF (ALLOCATED(Srcread_turbine_position_dataData%upwind_turbine_projected_distance)) THEN - i1_l = LBOUND(Srcread_turbine_position_dataData%upwind_turbine_projected_distance,1) - i1_u = UBOUND(Srcread_turbine_position_dataData%upwind_turbine_projected_distance,1) - IF (.NOT. ALLOCATED(Dstread_turbine_position_dataData%upwind_turbine_projected_distance)) THEN - ALLOCATE(Dstread_turbine_position_dataData%upwind_turbine_projected_distance(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Dstread_turbine_position_dataData%upwind_turbine_projected_distance.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - Dstread_turbine_position_dataData%upwind_turbine_projected_distance = Srcread_turbine_position_dataData%upwind_turbine_projected_distance -ENDIF -IF (ALLOCATED(Srcread_turbine_position_dataData%downwind_turbine_projected_distance)) THEN - i1_l = LBOUND(Srcread_turbine_position_dataData%downwind_turbine_projected_distance,1) - i1_u = UBOUND(Srcread_turbine_position_dataData%downwind_turbine_projected_distance,1) - IF (.NOT. ALLOCATED(Dstread_turbine_position_dataData%downwind_turbine_projected_distance)) THEN - ALLOCATE(Dstread_turbine_position_dataData%downwind_turbine_projected_distance(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Dstread_turbine_position_dataData%downwind_turbine_projected_distance.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - Dstread_turbine_position_dataData%downwind_turbine_projected_distance = Srcread_turbine_position_dataData%downwind_turbine_projected_distance -ENDIF -IF (ALLOCATED(Srcread_turbine_position_dataData%turbine_angle)) THEN - i1_l = LBOUND(Srcread_turbine_position_dataData%turbine_angle,1) - i1_u = UBOUND(Srcread_turbine_position_dataData%turbine_angle,1) - i2_l = LBOUND(Srcread_turbine_position_dataData%turbine_angle,2) - i2_u = UBOUND(Srcread_turbine_position_dataData%turbine_angle,2) - IF (.NOT. ALLOCATED(Dstread_turbine_position_dataData%turbine_angle)) THEN - ALLOCATE(Dstread_turbine_position_dataData%turbine_angle(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Dstread_turbine_position_dataData%turbine_angle.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - Dstread_turbine_position_dataData%turbine_angle = Srcread_turbine_position_dataData%turbine_angle -ENDIF -IF (ALLOCATED(Srcread_turbine_position_dataData%upwind_align_angle)) THEN - i1_l = LBOUND(Srcread_turbine_position_dataData%upwind_align_angle,1) - i1_u = UBOUND(Srcread_turbine_position_dataData%upwind_align_angle,1) - IF (.NOT. ALLOCATED(Dstread_turbine_position_dataData%upwind_align_angle)) THEN - ALLOCATE(Dstread_turbine_position_dataData%upwind_align_angle(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Dstread_turbine_position_dataData%upwind_align_angle.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - Dstread_turbine_position_dataData%upwind_align_angle = Srcread_turbine_position_dataData%upwind_align_angle -ENDIF -IF (ALLOCATED(Srcread_turbine_position_dataData%downwind_align_angle)) THEN - i1_l = LBOUND(Srcread_turbine_position_dataData%downwind_align_angle,1) - i1_u = UBOUND(Srcread_turbine_position_dataData%downwind_align_angle,1) - IF (.NOT. ALLOCATED(Dstread_turbine_position_dataData%downwind_align_angle)) THEN - ALLOCATE(Dstread_turbine_position_dataData%downwind_align_angle(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Dstread_turbine_position_dataData%downwind_align_angle.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - Dstread_turbine_position_dataData%downwind_align_angle = Srcread_turbine_position_dataData%downwind_align_angle -ENDIF -IF (ALLOCATED(Srcread_turbine_position_dataData%upwind_turbine_Xcoor)) THEN - i1_l = LBOUND(Srcread_turbine_position_dataData%upwind_turbine_Xcoor,1) - i1_u = UBOUND(Srcread_turbine_position_dataData%upwind_turbine_Xcoor,1) - IF (.NOT. ALLOCATED(Dstread_turbine_position_dataData%upwind_turbine_Xcoor)) THEN - ALLOCATE(Dstread_turbine_position_dataData%upwind_turbine_Xcoor(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Dstread_turbine_position_dataData%upwind_turbine_Xcoor.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - Dstread_turbine_position_dataData%upwind_turbine_Xcoor = Srcread_turbine_position_dataData%upwind_turbine_Xcoor -ENDIF -IF (ALLOCATED(Srcread_turbine_position_dataData%upwind_turbine_Ycoor)) THEN - i1_l = LBOUND(Srcread_turbine_position_dataData%upwind_turbine_Ycoor,1) - i1_u = UBOUND(Srcread_turbine_position_dataData%upwind_turbine_Ycoor,1) - IF (.NOT. ALLOCATED(Dstread_turbine_position_dataData%upwind_turbine_Ycoor)) THEN - ALLOCATE(Dstread_turbine_position_dataData%upwind_turbine_Ycoor(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Dstread_turbine_position_dataData%upwind_turbine_Ycoor.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - Dstread_turbine_position_dataData%upwind_turbine_Ycoor = Srcread_turbine_position_dataData%upwind_turbine_Ycoor -ENDIF -IF (ALLOCATED(Srcread_turbine_position_dataData%wind_farm_Xcoor)) THEN - i1_l = LBOUND(Srcread_turbine_position_dataData%wind_farm_Xcoor,1) - i1_u = UBOUND(Srcread_turbine_position_dataData%wind_farm_Xcoor,1) - IF (.NOT. ALLOCATED(Dstread_turbine_position_dataData%wind_farm_Xcoor)) THEN - ALLOCATE(Dstread_turbine_position_dataData%wind_farm_Xcoor(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Dstread_turbine_position_dataData%wind_farm_Xcoor.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - Dstread_turbine_position_dataData%wind_farm_Xcoor = Srcread_turbine_position_dataData%wind_farm_Xcoor -ENDIF -IF (ALLOCATED(Srcread_turbine_position_dataData%wind_farm_Ycoor)) THEN - i1_l = LBOUND(Srcread_turbine_position_dataData%wind_farm_Ycoor,1) - i1_u = UBOUND(Srcread_turbine_position_dataData%wind_farm_Ycoor,1) - IF (.NOT. ALLOCATED(Dstread_turbine_position_dataData%wind_farm_Ycoor)) THEN - ALLOCATE(Dstread_turbine_position_dataData%wind_farm_Ycoor(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Dstread_turbine_position_dataData%wind_farm_Ycoor.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - Dstread_turbine_position_dataData%wind_farm_Ycoor = Srcread_turbine_position_dataData%wind_farm_Ycoor -ENDIF -IF (ALLOCATED(Srcread_turbine_position_dataData%downwind_turbine_Xcoor)) THEN - i1_l = LBOUND(Srcread_turbine_position_dataData%downwind_turbine_Xcoor,1) - i1_u = UBOUND(Srcread_turbine_position_dataData%downwind_turbine_Xcoor,1) - IF (.NOT. ALLOCATED(Dstread_turbine_position_dataData%downwind_turbine_Xcoor)) THEN - ALLOCATE(Dstread_turbine_position_dataData%downwind_turbine_Xcoor(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Dstread_turbine_position_dataData%downwind_turbine_Xcoor.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - Dstread_turbine_position_dataData%downwind_turbine_Xcoor = Srcread_turbine_position_dataData%downwind_turbine_Xcoor -ENDIF -IF (ALLOCATED(Srcread_turbine_position_dataData%downwind_turbine_Ycoor)) THEN - i1_l = LBOUND(Srcread_turbine_position_dataData%downwind_turbine_Ycoor,1) - i1_u = UBOUND(Srcread_turbine_position_dataData%downwind_turbine_Ycoor,1) - IF (.NOT. ALLOCATED(Dstread_turbine_position_dataData%downwind_turbine_Ycoor)) THEN - ALLOCATE(Dstread_turbine_position_dataData%downwind_turbine_Ycoor(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Dstread_turbine_position_dataData%downwind_turbine_Ycoor.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - Dstread_turbine_position_dataData%downwind_turbine_Ycoor = Srcread_turbine_position_dataData%downwind_turbine_Ycoor -ENDIF - END SUBROUTINE DWM_Copyread_turbine_position_data - - SUBROUTINE DWM_Destroyread_turbine_position_data( read_turbine_position_dataData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(read_turbine_position_data), INTENT(INOUT) :: read_turbine_position_dataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_Destroyread_turbine_position_data' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(read_turbine_position_dataData%Turbine_sort_order)) THEN - DEALLOCATE(read_turbine_position_dataData%Turbine_sort_order) -ENDIF -IF (ALLOCATED(read_turbine_position_dataData%TurbineInfluenceData)) THEN - DEALLOCATE(read_turbine_position_dataData%TurbineInfluenceData) -ENDIF -IF (ALLOCATED(read_turbine_position_dataData%upwind_turbine_index)) THEN - DEALLOCATE(read_turbine_position_dataData%upwind_turbine_index) -ENDIF -IF (ALLOCATED(read_turbine_position_dataData%downwind_turbine_index)) THEN - DEALLOCATE(read_turbine_position_dataData%downwind_turbine_index) -ENDIF -IF (ALLOCATED(read_turbine_position_dataData%turbine_windorigin_length)) THEN - DEALLOCATE(read_turbine_position_dataData%turbine_windorigin_length) -ENDIF -IF (ALLOCATED(read_turbine_position_dataData%upwind_turbine_projected_distance)) THEN - DEALLOCATE(read_turbine_position_dataData%upwind_turbine_projected_distance) -ENDIF -IF (ALLOCATED(read_turbine_position_dataData%downwind_turbine_projected_distance)) THEN - DEALLOCATE(read_turbine_position_dataData%downwind_turbine_projected_distance) -ENDIF -IF (ALLOCATED(read_turbine_position_dataData%turbine_angle)) THEN - DEALLOCATE(read_turbine_position_dataData%turbine_angle) -ENDIF -IF (ALLOCATED(read_turbine_position_dataData%upwind_align_angle)) THEN - DEALLOCATE(read_turbine_position_dataData%upwind_align_angle) -ENDIF -IF (ALLOCATED(read_turbine_position_dataData%downwind_align_angle)) THEN - DEALLOCATE(read_turbine_position_dataData%downwind_align_angle) -ENDIF -IF (ALLOCATED(read_turbine_position_dataData%upwind_turbine_Xcoor)) THEN - DEALLOCATE(read_turbine_position_dataData%upwind_turbine_Xcoor) -ENDIF -IF (ALLOCATED(read_turbine_position_dataData%upwind_turbine_Ycoor)) THEN - DEALLOCATE(read_turbine_position_dataData%upwind_turbine_Ycoor) -ENDIF -IF (ALLOCATED(read_turbine_position_dataData%wind_farm_Xcoor)) THEN - DEALLOCATE(read_turbine_position_dataData%wind_farm_Xcoor) -ENDIF -IF (ALLOCATED(read_turbine_position_dataData%wind_farm_Ycoor)) THEN - DEALLOCATE(read_turbine_position_dataData%wind_farm_Ycoor) -ENDIF -IF (ALLOCATED(read_turbine_position_dataData%downwind_turbine_Xcoor)) THEN - DEALLOCATE(read_turbine_position_dataData%downwind_turbine_Xcoor) -ENDIF -IF (ALLOCATED(read_turbine_position_dataData%downwind_turbine_Ycoor)) THEN - DEALLOCATE(read_turbine_position_dataData%downwind_turbine_Ycoor) -ENDIF - END SUBROUTINE DWM_Destroyread_turbine_position_data - - SUBROUTINE DWM_Packread_turbine_position_data( 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(read_turbine_position_data), 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 = 'DWM_Packread_turbine_position_data' - ! 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 ! SimulationOrder_index - Int_BufSz = Int_BufSz + 1 ! Turbine_sort_order allocated yes/no - IF ( ALLOCATED(InData%Turbine_sort_order) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Turbine_sort_order upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Turbine_sort_order) ! Turbine_sort_order - END IF - Int_BufSz = Int_BufSz + 1 ! WT_index - Int_BufSz = Int_BufSz + 1 ! TurbineInfluenceData allocated yes/no - IF ( ALLOCATED(InData%TurbineInfluenceData) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! TurbineInfluenceData upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%TurbineInfluenceData) ! TurbineInfluenceData - END IF - Int_BufSz = Int_BufSz + 1 ! upwind_turbine_index allocated yes/no - IF ( ALLOCATED(InData%upwind_turbine_index) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! upwind_turbine_index upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%upwind_turbine_index) ! upwind_turbine_index - END IF - Int_BufSz = Int_BufSz + 1 ! downwind_turbine_index allocated yes/no - IF ( ALLOCATED(InData%downwind_turbine_index) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! downwind_turbine_index upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%downwind_turbine_index) ! downwind_turbine_index - END IF - Int_BufSz = Int_BufSz + 1 ! upwindturbine_number - Int_BufSz = Int_BufSz + 1 ! downwindturbine_number - Int_BufSz = Int_BufSz + 1 ! turbine_windorigin_length allocated yes/no - IF ( ALLOCATED(InData%turbine_windorigin_length) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! turbine_windorigin_length upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%turbine_windorigin_length) ! turbine_windorigin_length - END IF - Int_BufSz = Int_BufSz + 1 ! upwind_turbine_projected_distance allocated yes/no - IF ( ALLOCATED(InData%upwind_turbine_projected_distance) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! upwind_turbine_projected_distance upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%upwind_turbine_projected_distance) ! upwind_turbine_projected_distance - END IF - Int_BufSz = Int_BufSz + 1 ! downwind_turbine_projected_distance allocated yes/no - IF ( ALLOCATED(InData%downwind_turbine_projected_distance) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! downwind_turbine_projected_distance upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%downwind_turbine_projected_distance) ! downwind_turbine_projected_distance - END IF - Int_BufSz = Int_BufSz + 1 ! turbine_angle allocated yes/no - IF ( ALLOCATED(InData%turbine_angle) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! turbine_angle upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%turbine_angle) ! turbine_angle - END IF - Int_BufSz = Int_BufSz + 1 ! upwind_align_angle allocated yes/no - IF ( ALLOCATED(InData%upwind_align_angle) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! upwind_align_angle upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%upwind_align_angle) ! upwind_align_angle - END IF - Int_BufSz = Int_BufSz + 1 ! downwind_align_angle allocated yes/no - IF ( ALLOCATED(InData%downwind_align_angle) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! downwind_align_angle upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%downwind_align_angle) ! downwind_align_angle - END IF - Int_BufSz = Int_BufSz + 1 ! upwind_turbine_Xcoor allocated yes/no - IF ( ALLOCATED(InData%upwind_turbine_Xcoor) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! upwind_turbine_Xcoor upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%upwind_turbine_Xcoor) ! upwind_turbine_Xcoor - END IF - Int_BufSz = Int_BufSz + 1 ! upwind_turbine_Ycoor allocated yes/no - IF ( ALLOCATED(InData%upwind_turbine_Ycoor) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! upwind_turbine_Ycoor upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%upwind_turbine_Ycoor) ! upwind_turbine_Ycoor - END IF - Int_BufSz = Int_BufSz + 1 ! wind_farm_Xcoor allocated yes/no - IF ( ALLOCATED(InData%wind_farm_Xcoor) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! wind_farm_Xcoor upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%wind_farm_Xcoor) ! wind_farm_Xcoor - END IF - Int_BufSz = Int_BufSz + 1 ! wind_farm_Ycoor allocated yes/no - IF ( ALLOCATED(InData%wind_farm_Ycoor) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! wind_farm_Ycoor upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%wind_farm_Ycoor) ! wind_farm_Ycoor - END IF - Int_BufSz = Int_BufSz + 1 ! downwind_turbine_Xcoor allocated yes/no - IF ( ALLOCATED(InData%downwind_turbine_Xcoor) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! downwind_turbine_Xcoor upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%downwind_turbine_Xcoor) ! downwind_turbine_Xcoor - END IF - Int_BufSz = Int_BufSz + 1 ! downwind_turbine_Ycoor allocated yes/no - IF ( ALLOCATED(InData%downwind_turbine_Ycoor) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! downwind_turbine_Ycoor upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%downwind_turbine_Ycoor) ! downwind_turbine_Ycoor - 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%SimulationOrder_index - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%Turbine_sort_order) ) THEN - 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_sort_order,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Turbine_sort_order,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Turbine_sort_order,1), UBOUND(InData%Turbine_sort_order,1) - IntKiBuf(Int_Xferred) = InData%Turbine_sort_order(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%WT_index - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%TurbineInfluenceData) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TurbineInfluenceData,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TurbineInfluenceData,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TurbineInfluenceData,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TurbineInfluenceData,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%TurbineInfluenceData,2), UBOUND(InData%TurbineInfluenceData,2) - DO i1 = LBOUND(InData%TurbineInfluenceData,1), UBOUND(InData%TurbineInfluenceData,1) - IntKiBuf(Int_Xferred) = InData%TurbineInfluenceData(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%upwind_turbine_index) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%upwind_turbine_index,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%upwind_turbine_index,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%upwind_turbine_index,1), UBOUND(InData%upwind_turbine_index,1) - IntKiBuf(Int_Xferred) = InData%upwind_turbine_index(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%downwind_turbine_index) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%downwind_turbine_index,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%downwind_turbine_index,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%downwind_turbine_index,1), UBOUND(InData%downwind_turbine_index,1) - IntKiBuf(Int_Xferred) = InData%downwind_turbine_index(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%upwindturbine_number - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%downwindturbine_number - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%turbine_windorigin_length) ) THEN - 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_windorigin_length,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%turbine_windorigin_length,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%turbine_windorigin_length,1), UBOUND(InData%turbine_windorigin_length,1) - ReKiBuf(Re_Xferred) = InData%turbine_windorigin_length(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%upwind_turbine_projected_distance) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%upwind_turbine_projected_distance,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%upwind_turbine_projected_distance,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%upwind_turbine_projected_distance,1), UBOUND(InData%upwind_turbine_projected_distance,1) - ReKiBuf(Re_Xferred) = InData%upwind_turbine_projected_distance(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%downwind_turbine_projected_distance) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%downwind_turbine_projected_distance,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%downwind_turbine_projected_distance,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%downwind_turbine_projected_distance,1), UBOUND(InData%downwind_turbine_projected_distance,1) - ReKiBuf(Re_Xferred) = InData%downwind_turbine_projected_distance(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%turbine_angle) ) THEN - 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_angle,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%turbine_angle,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%turbine_angle,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%turbine_angle,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%turbine_angle,2), UBOUND(InData%turbine_angle,2) - DO i1 = LBOUND(InData%turbine_angle,1), UBOUND(InData%turbine_angle,1) - ReKiBuf(Re_Xferred) = InData%turbine_angle(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%upwind_align_angle) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%upwind_align_angle,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%upwind_align_angle,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%upwind_align_angle,1), UBOUND(InData%upwind_align_angle,1) - ReKiBuf(Re_Xferred) = InData%upwind_align_angle(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%downwind_align_angle) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%downwind_align_angle,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%downwind_align_angle,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%downwind_align_angle,1), UBOUND(InData%downwind_align_angle,1) - ReKiBuf(Re_Xferred) = InData%downwind_align_angle(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%upwind_turbine_Xcoor) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%upwind_turbine_Xcoor,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%upwind_turbine_Xcoor,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%upwind_turbine_Xcoor,1), UBOUND(InData%upwind_turbine_Xcoor,1) - ReKiBuf(Re_Xferred) = InData%upwind_turbine_Xcoor(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%upwind_turbine_Ycoor) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%upwind_turbine_Ycoor,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%upwind_turbine_Ycoor,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%upwind_turbine_Ycoor,1), UBOUND(InData%upwind_turbine_Ycoor,1) - ReKiBuf(Re_Xferred) = InData%upwind_turbine_Ycoor(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%wind_farm_Xcoor) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%wind_farm_Xcoor,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%wind_farm_Xcoor,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%wind_farm_Xcoor,1), UBOUND(InData%wind_farm_Xcoor,1) - ReKiBuf(Re_Xferred) = InData%wind_farm_Xcoor(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%wind_farm_Ycoor) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%wind_farm_Ycoor,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%wind_farm_Ycoor,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%wind_farm_Ycoor,1), UBOUND(InData%wind_farm_Ycoor,1) - ReKiBuf(Re_Xferred) = InData%wind_farm_Ycoor(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%downwind_turbine_Xcoor) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%downwind_turbine_Xcoor,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%downwind_turbine_Xcoor,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%downwind_turbine_Xcoor,1), UBOUND(InData%downwind_turbine_Xcoor,1) - ReKiBuf(Re_Xferred) = InData%downwind_turbine_Xcoor(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%downwind_turbine_Ycoor) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%downwind_turbine_Ycoor,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%downwind_turbine_Ycoor,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%downwind_turbine_Ycoor,1), UBOUND(InData%downwind_turbine_Ycoor,1) - ReKiBuf(Re_Xferred) = InData%downwind_turbine_Ycoor(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE DWM_Packread_turbine_position_data - - SUBROUTINE DWM_UnPackread_turbine_position_data( 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(read_turbine_position_data), 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 = 'DWM_UnPackread_turbine_position_data' - ! 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%SimulationOrder_index = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Turbine_sort_order not allocated - Int_Xferred = Int_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%Turbine_sort_order)) DEALLOCATE(OutData%Turbine_sort_order) - ALLOCATE(OutData%Turbine_sort_order(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Turbine_sort_order.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Turbine_sort_order,1), UBOUND(OutData%Turbine_sort_order,1) - OutData%Turbine_sort_order(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - OutData%WT_index = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TurbineInfluenceData not allocated - Int_Xferred = Int_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%TurbineInfluenceData)) DEALLOCATE(OutData%TurbineInfluenceData) - ALLOCATE(OutData%TurbineInfluenceData(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TurbineInfluenceData.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%TurbineInfluenceData,2), UBOUND(OutData%TurbineInfluenceData,2) - DO i1 = LBOUND(OutData%TurbineInfluenceData,1), UBOUND(OutData%TurbineInfluenceData,1) - OutData%TurbineInfluenceData(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! upwind_turbine_index not allocated - Int_Xferred = Int_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%upwind_turbine_index)) DEALLOCATE(OutData%upwind_turbine_index) - ALLOCATE(OutData%upwind_turbine_index(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%upwind_turbine_index.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%upwind_turbine_index,1), UBOUND(OutData%upwind_turbine_index,1) - OutData%upwind_turbine_index(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! downwind_turbine_index not allocated - Int_Xferred = Int_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%downwind_turbine_index)) DEALLOCATE(OutData%downwind_turbine_index) - ALLOCATE(OutData%downwind_turbine_index(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%downwind_turbine_index.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%downwind_turbine_index,1), UBOUND(OutData%downwind_turbine_index,1) - OutData%downwind_turbine_index(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - OutData%upwindturbine_number = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%downwindturbine_number = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! turbine_windorigin_length not allocated - Int_Xferred = Int_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%turbine_windorigin_length)) DEALLOCATE(OutData%turbine_windorigin_length) - ALLOCATE(OutData%turbine_windorigin_length(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%turbine_windorigin_length.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%turbine_windorigin_length,1), UBOUND(OutData%turbine_windorigin_length,1) - OutData%turbine_windorigin_length(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! upwind_turbine_projected_distance not allocated - Int_Xferred = Int_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%upwind_turbine_projected_distance)) DEALLOCATE(OutData%upwind_turbine_projected_distance) - ALLOCATE(OutData%upwind_turbine_projected_distance(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%upwind_turbine_projected_distance.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%upwind_turbine_projected_distance,1), UBOUND(OutData%upwind_turbine_projected_distance,1) - OutData%upwind_turbine_projected_distance(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! downwind_turbine_projected_distance not allocated - Int_Xferred = Int_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%downwind_turbine_projected_distance)) DEALLOCATE(OutData%downwind_turbine_projected_distance) - ALLOCATE(OutData%downwind_turbine_projected_distance(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%downwind_turbine_projected_distance.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%downwind_turbine_projected_distance,1), UBOUND(OutData%downwind_turbine_projected_distance,1) - OutData%downwind_turbine_projected_distance(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! turbine_angle not allocated - Int_Xferred = Int_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%turbine_angle)) DEALLOCATE(OutData%turbine_angle) - ALLOCATE(OutData%turbine_angle(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%turbine_angle.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%turbine_angle,2), UBOUND(OutData%turbine_angle,2) - DO i1 = LBOUND(OutData%turbine_angle,1), UBOUND(OutData%turbine_angle,1) - OutData%turbine_angle(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! upwind_align_angle not allocated - Int_Xferred = Int_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%upwind_align_angle)) DEALLOCATE(OutData%upwind_align_angle) - ALLOCATE(OutData%upwind_align_angle(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%upwind_align_angle.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%upwind_align_angle,1), UBOUND(OutData%upwind_align_angle,1) - OutData%upwind_align_angle(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! downwind_align_angle not allocated - Int_Xferred = Int_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%downwind_align_angle)) DEALLOCATE(OutData%downwind_align_angle) - ALLOCATE(OutData%downwind_align_angle(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%downwind_align_angle.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%downwind_align_angle,1), UBOUND(OutData%downwind_align_angle,1) - OutData%downwind_align_angle(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! upwind_turbine_Xcoor not allocated - Int_Xferred = Int_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%upwind_turbine_Xcoor)) DEALLOCATE(OutData%upwind_turbine_Xcoor) - ALLOCATE(OutData%upwind_turbine_Xcoor(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%upwind_turbine_Xcoor.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%upwind_turbine_Xcoor,1), UBOUND(OutData%upwind_turbine_Xcoor,1) - OutData%upwind_turbine_Xcoor(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! upwind_turbine_Ycoor not allocated - Int_Xferred = Int_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%upwind_turbine_Ycoor)) DEALLOCATE(OutData%upwind_turbine_Ycoor) - ALLOCATE(OutData%upwind_turbine_Ycoor(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%upwind_turbine_Ycoor.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%upwind_turbine_Ycoor,1), UBOUND(OutData%upwind_turbine_Ycoor,1) - OutData%upwind_turbine_Ycoor(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! wind_farm_Xcoor not allocated - Int_Xferred = Int_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%wind_farm_Xcoor)) DEALLOCATE(OutData%wind_farm_Xcoor) - ALLOCATE(OutData%wind_farm_Xcoor(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%wind_farm_Xcoor.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%wind_farm_Xcoor,1), UBOUND(OutData%wind_farm_Xcoor,1) - OutData%wind_farm_Xcoor(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! wind_farm_Ycoor not allocated - Int_Xferred = Int_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%wind_farm_Ycoor)) DEALLOCATE(OutData%wind_farm_Ycoor) - ALLOCATE(OutData%wind_farm_Ycoor(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%wind_farm_Ycoor.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%wind_farm_Ycoor,1), UBOUND(OutData%wind_farm_Ycoor,1) - OutData%wind_farm_Ycoor(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! downwind_turbine_Xcoor not allocated - Int_Xferred = Int_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%downwind_turbine_Xcoor)) DEALLOCATE(OutData%downwind_turbine_Xcoor) - ALLOCATE(OutData%downwind_turbine_Xcoor(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%downwind_turbine_Xcoor.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%downwind_turbine_Xcoor,1), UBOUND(OutData%downwind_turbine_Xcoor,1) - OutData%downwind_turbine_Xcoor(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! downwind_turbine_Ycoor not allocated - Int_Xferred = Int_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%downwind_turbine_Ycoor)) DEALLOCATE(OutData%downwind_turbine_Ycoor) - ALLOCATE(OutData%downwind_turbine_Ycoor(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%downwind_turbine_Ycoor.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%downwind_turbine_Ycoor,1), UBOUND(OutData%downwind_turbine_Ycoor,1) - OutData%downwind_turbine_Ycoor(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE DWM_UnPackread_turbine_position_data - - SUBROUTINE DWM_CopyWeiMethod( SrcWeiMethodData, DstWeiMethodData, CtrlCode, ErrStat, ErrMsg ) - TYPE(WeiMethod), INTENT(IN) :: SrcWeiMethodData - TYPE(WeiMethod), INTENT(INOUT) :: DstWeiMethodData - 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 = 'DWM_CopyWeiMethod' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcWeiMethodData%sweptarea)) THEN - i1_l = LBOUND(SrcWeiMethodData%sweptarea,1) - i1_u = UBOUND(SrcWeiMethodData%sweptarea,1) - IF (.NOT. ALLOCATED(DstWeiMethodData%sweptarea)) THEN - ALLOCATE(DstWeiMethodData%sweptarea(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWeiMethodData%sweptarea.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWeiMethodData%sweptarea = SrcWeiMethodData%sweptarea -ENDIF - DstWeiMethodData%weighting_denominator = SrcWeiMethodData%weighting_denominator - END SUBROUTINE DWM_CopyWeiMethod - - SUBROUTINE DWM_DestroyWeiMethod( WeiMethodData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(WeiMethod), INTENT(INOUT) :: WeiMethodData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_DestroyWeiMethod' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(WeiMethodData%sweptarea)) THEN - DEALLOCATE(WeiMethodData%sweptarea) -ENDIF - END SUBROUTINE DWM_DestroyWeiMethod - - SUBROUTINE DWM_PackWeiMethod( 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(WeiMethod), 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 = 'DWM_PackWeiMethod' - ! 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 ! sweptarea allocated yes/no - IF ( ALLOCATED(InData%sweptarea) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! sweptarea upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%sweptarea) ! sweptarea - END IF - Re_BufSz = Re_BufSz + 1 ! weighting_denominator - 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%sweptarea) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%sweptarea,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%sweptarea,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%sweptarea,1), UBOUND(InData%sweptarea,1) - ReKiBuf(Re_Xferred) = InData%sweptarea(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%weighting_denominator - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE DWM_PackWeiMethod - - SUBROUTINE DWM_UnPackWeiMethod( 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(WeiMethod), 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 = 'DWM_UnPackWeiMethod' - ! 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 ! sweptarea not allocated - Int_Xferred = Int_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%sweptarea)) DEALLOCATE(OutData%sweptarea) - ALLOCATE(OutData%sweptarea(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%sweptarea.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%sweptarea,1), UBOUND(OutData%sweptarea,1) - OutData%sweptarea(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%weighting_denominator = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE DWM_UnPackWeiMethod - - SUBROUTINE DWM_CopyTIDownstream( SrcTIDownstreamData, DstTIDownstreamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(TIDownstream), INTENT(IN) :: SrcTIDownstreamData - TYPE(TIDownstream), INTENT(INOUT) :: DstTIDownstreamData - 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 = 'DWM_CopyTIDownstream' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcTIDownstreamData%TI_downstream_matrix)) THEN - i1_l = LBOUND(SrcTIDownstreamData%TI_downstream_matrix,1) - i1_u = UBOUND(SrcTIDownstreamData%TI_downstream_matrix,1) - i2_l = LBOUND(SrcTIDownstreamData%TI_downstream_matrix,2) - i2_u = UBOUND(SrcTIDownstreamData%TI_downstream_matrix,2) - IF (.NOT. ALLOCATED(DstTIDownstreamData%TI_downstream_matrix)) THEN - ALLOCATE(DstTIDownstreamData%TI_downstream_matrix(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstTIDownstreamData%TI_downstream_matrix.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstTIDownstreamData%TI_downstream_matrix = SrcTIDownstreamData%TI_downstream_matrix -ENDIF - DstTIDownstreamData%i = SrcTIDownstreamData%i - DstTIDownstreamData%j = SrcTIDownstreamData%j - DstTIDownstreamData%k = SrcTIDownstreamData%k - DstTIDownstreamData%cross_plane_position_ds = SrcTIDownstreamData%cross_plane_position_ds - DstTIDownstreamData%cross_plane_position_TI = SrcTIDownstreamData%cross_plane_position_TI - DstTIDownstreamData%distance_index = SrcTIDownstreamData%distance_index - DstTIDownstreamData%counter1 = SrcTIDownstreamData%counter1 - DstTIDownstreamData%counter2 = SrcTIDownstreamData%counter2 - DstTIDownstreamData%initial_timestep = SrcTIDownstreamData%initial_timestep - DstTIDownstreamData%y_axis_turbine = SrcTIDownstreamData%y_axis_turbine - DstTIDownstreamData%z_axis_turbine = SrcTIDownstreamData%z_axis_turbine - DstTIDownstreamData%distance = SrcTIDownstreamData%distance - DstTIDownstreamData%TI_downstream_node = SrcTIDownstreamData%TI_downstream_node - DstTIDownstreamData%TI_node_temp = SrcTIDownstreamData%TI_node_temp - DstTIDownstreamData%TI_node = SrcTIDownstreamData%TI_node - DstTIDownstreamData%TI_accumulation = SrcTIDownstreamData%TI_accumulation - DstTIDownstreamData%TI_apprant_accumulation = SrcTIDownstreamData%TI_apprant_accumulation - DstTIDownstreamData%TI_average = SrcTIDownstreamData%TI_average - DstTIDownstreamData%TI_apprant = SrcTIDownstreamData%TI_apprant - DstTIDownstreamData%HubHt = SrcTIDownstreamData%HubHt - DstTIDownstreamData%wake_center_y = SrcTIDownstreamData%wake_center_y - DstTIDownstreamData%wake_center_z = SrcTIDownstreamData%wake_center_z - DstTIDownstreamData%Rscale = SrcTIDownstreamData%Rscale - DstTIDownstreamData%y = SrcTIDownstreamData%y - DstTIDownstreamData%z = SrcTIDownstreamData%z - DstTIDownstreamData%zero_spacing = SrcTIDownstreamData%zero_spacing - DstTIDownstreamData%temp1 = SrcTIDownstreamData%temp1 - DstTIDownstreamData%temp2 = SrcTIDownstreamData%temp2 - DstTIDownstreamData%temp3 = SrcTIDownstreamData%temp3 - END SUBROUTINE DWM_CopyTIDownstream - - SUBROUTINE DWM_DestroyTIDownstream( TIDownstreamData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(TIDownstream), INTENT(INOUT) :: TIDownstreamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_DestroyTIDownstream' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(TIDownstreamData%TI_downstream_matrix)) THEN - DEALLOCATE(TIDownstreamData%TI_downstream_matrix) -ENDIF - END SUBROUTINE DWM_DestroyTIDownstream - - SUBROUTINE DWM_PackTIDownstream( 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(TIDownstream), 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 = 'DWM_PackTIDownstream' - ! 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 ! TI_downstream_matrix allocated yes/no - IF ( ALLOCATED(InData%TI_downstream_matrix) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! TI_downstream_matrix upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TI_downstream_matrix) ! TI_downstream_matrix - END IF - Int_BufSz = Int_BufSz + 1 ! i - Int_BufSz = Int_BufSz + 1 ! j - Int_BufSz = Int_BufSz + 1 ! k - Int_BufSz = Int_BufSz + 1 ! cross_plane_position_ds - Int_BufSz = Int_BufSz + 1 ! cross_plane_position_TI - Int_BufSz = Int_BufSz + 1 ! distance_index - Int_BufSz = Int_BufSz + 1 ! counter1 - Int_BufSz = Int_BufSz + 1 ! counter2 - Int_BufSz = Int_BufSz + 1 ! initial_timestep - Re_BufSz = Re_BufSz + 1 ! y_axis_turbine - Re_BufSz = Re_BufSz + 1 ! z_axis_turbine - Re_BufSz = Re_BufSz + 1 ! distance - Re_BufSz = Re_BufSz + 1 ! TI_downstream_node - Re_BufSz = Re_BufSz + 1 ! TI_node_temp - Re_BufSz = Re_BufSz + 1 ! TI_node - Re_BufSz = Re_BufSz + 1 ! TI_accumulation - Re_BufSz = Re_BufSz + 1 ! TI_apprant_accumulation - Re_BufSz = Re_BufSz + 1 ! TI_average - Re_BufSz = Re_BufSz + 1 ! TI_apprant - Re_BufSz = Re_BufSz + 1 ! HubHt - Re_BufSz = Re_BufSz + 1 ! wake_center_y - Re_BufSz = Re_BufSz + 1 ! wake_center_z - Re_BufSz = Re_BufSz + 1 ! Rscale - Re_BufSz = Re_BufSz + 1 ! y - Re_BufSz = Re_BufSz + 1 ! z - Re_BufSz = Re_BufSz + 1 ! zero_spacing - Re_BufSz = Re_BufSz + 1 ! temp1 - Re_BufSz = Re_BufSz + 1 ! temp2 - Re_BufSz = Re_BufSz + 1 ! temp3 - 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%TI_downstream_matrix) ) THEN - 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_downstream_matrix,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TI_downstream_matrix,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TI_downstream_matrix,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TI_downstream_matrix,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%TI_downstream_matrix,2), UBOUND(InData%TI_downstream_matrix,2) - DO i1 = LBOUND(InData%TI_downstream_matrix,1), UBOUND(InData%TI_downstream_matrix,1) - ReKiBuf(Re_Xferred) = InData%TI_downstream_matrix(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%i - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%j - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%k - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%cross_plane_position_ds - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%cross_plane_position_TI - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%distance_index - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%counter1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%counter2 - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%initial_timestep - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%y_axis_turbine - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%z_axis_turbine - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%distance - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TI_downstream_node - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TI_node_temp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TI_node - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TI_accumulation - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TI_apprant_accumulation - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TI_average - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TI_apprant - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%HubHt - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%wake_center_y - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%wake_center_z - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Rscale - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%y - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%z - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%zero_spacing - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%temp1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%temp2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%temp3 - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE DWM_PackTIDownstream - - SUBROUTINE DWM_UnPackTIDownstream( 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(TIDownstream), 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 = 'DWM_UnPackTIDownstream' - ! 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 ! TI_downstream_matrix not allocated - Int_Xferred = Int_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_downstream_matrix)) DEALLOCATE(OutData%TI_downstream_matrix) - ALLOCATE(OutData%TI_downstream_matrix(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TI_downstream_matrix.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%TI_downstream_matrix,2), UBOUND(OutData%TI_downstream_matrix,2) - DO i1 = LBOUND(OutData%TI_downstream_matrix,1), UBOUND(OutData%TI_downstream_matrix,1) - OutData%TI_downstream_matrix(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%i = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%j = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%k = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%cross_plane_position_ds = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%cross_plane_position_TI = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%distance_index = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%counter1 = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%counter2 = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%initial_timestep = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%y_axis_turbine = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%z_axis_turbine = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%distance = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TI_downstream_node = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TI_node_temp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TI_node = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TI_accumulation = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TI_apprant_accumulation = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TI_average = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TI_apprant = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%HubHt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%wake_center_y = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%wake_center_z = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Rscale = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%y = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%z = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%zero_spacing = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%temp1 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%temp2 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%temp3 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE DWM_UnPackTIDownstream - - SUBROUTINE DWM_CopyTurbKaimal( SrcTurbKaimalData, DstTurbKaimalData, CtrlCode, ErrStat, ErrMsg ) - TYPE(TurbKaimal), INTENT(IN) :: SrcTurbKaimalData - TYPE(TurbKaimal), INTENT(INOUT) :: DstTurbKaimalData - 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 = 'DWM_CopyTurbKaimal' -! - ErrStat = ErrID_None - ErrMsg = "" - DstTurbKaimalData%fs = SrcTurbKaimalData%fs - DstTurbKaimalData%temp_n = SrcTurbKaimalData%temp_n - DstTurbKaimalData%i = SrcTurbKaimalData%i - DstTurbKaimalData%low_f = SrcTurbKaimalData%low_f - DstTurbKaimalData%high_f = SrcTurbKaimalData%high_f - DstTurbKaimalData%lk_facor = SrcTurbKaimalData%lk_facor - DstTurbKaimalData%STD = SrcTurbKaimalData%STD - END SUBROUTINE DWM_CopyTurbKaimal - - SUBROUTINE DWM_DestroyTurbKaimal( TurbKaimalData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(TurbKaimal), INTENT(INOUT) :: TurbKaimalData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_DestroyTurbKaimal' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE DWM_DestroyTurbKaimal - - SUBROUTINE DWM_PackTurbKaimal( 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(TurbKaimal), 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 = 'DWM_PackTurbKaimal' - ! 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 ! fs - Int_BufSz = Int_BufSz + 1 ! temp_n - Int_BufSz = Int_BufSz + 1 ! i - Re_BufSz = Re_BufSz + 1 ! low_f - Re_BufSz = Re_BufSz + 1 ! high_f - Re_BufSz = Re_BufSz + 1 ! lk_facor - Re_BufSz = Re_BufSz + 1 ! STD - 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%fs - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%temp_n - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%i - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%low_f - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%high_f - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%lk_facor - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%STD - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE DWM_PackTurbKaimal - - SUBROUTINE DWM_UnPackTurbKaimal( 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(TurbKaimal), 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 = 'DWM_UnPackTurbKaimal' - ! 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%fs = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%temp_n = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%i = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%low_f = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%high_f = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%lk_facor = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%STD = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE DWM_UnPackTurbKaimal - - SUBROUTINE DWM_CopyShinozuka( SrcShinozukaData, DstShinozukaData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Shinozuka), INTENT(IN) :: SrcShinozukaData - TYPE(Shinozuka), INTENT(INOUT) :: DstShinozukaData - 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 = 'DWM_CopyShinozuka' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcShinozukaData%f_syn)) THEN - i1_l = LBOUND(SrcShinozukaData%f_syn,1) - i1_u = UBOUND(SrcShinozukaData%f_syn,1) - IF (.NOT. ALLOCATED(DstShinozukaData%f_syn)) THEN - ALLOCATE(DstShinozukaData%f_syn(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstShinozukaData%f_syn.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstShinozukaData%f_syn = SrcShinozukaData%f_syn -ENDIF -IF (ALLOCATED(SrcShinozukaData%t_syn)) THEN - i1_l = LBOUND(SrcShinozukaData%t_syn,1) - i1_u = UBOUND(SrcShinozukaData%t_syn,1) - IF (.NOT. ALLOCATED(DstShinozukaData%t_syn)) THEN - ALLOCATE(DstShinozukaData%t_syn(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstShinozukaData%t_syn.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstShinozukaData%t_syn = SrcShinozukaData%t_syn -ENDIF -IF (ALLOCATED(SrcShinozukaData%phi)) THEN - i1_l = LBOUND(SrcShinozukaData%phi,1) - i1_u = UBOUND(SrcShinozukaData%phi,1) - IF (.NOT. ALLOCATED(DstShinozukaData%phi)) THEN - ALLOCATE(DstShinozukaData%phi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstShinozukaData%phi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstShinozukaData%phi = SrcShinozukaData%phi -ENDIF -IF (ALLOCATED(SrcShinozukaData%p_k)) THEN - i1_l = LBOUND(SrcShinozukaData%p_k,1) - i1_u = UBOUND(SrcShinozukaData%p_k,1) - IF (.NOT. ALLOCATED(DstShinozukaData%p_k)) THEN - ALLOCATE(DstShinozukaData%p_k(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstShinozukaData%p_k.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstShinozukaData%p_k = SrcShinozukaData%p_k -ENDIF -IF (ALLOCATED(SrcShinozukaData%a_k)) THEN - i1_l = LBOUND(SrcShinozukaData%a_k,1) - i1_u = UBOUND(SrcShinozukaData%a_k,1) - IF (.NOT. ALLOCATED(DstShinozukaData%a_k)) THEN - ALLOCATE(DstShinozukaData%a_k(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstShinozukaData%a_k.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstShinozukaData%a_k = SrcShinozukaData%a_k -ENDIF - DstShinozukaData%num_points = SrcShinozukaData%num_points - DstShinozukaData%ILo = SrcShinozukaData%ILo - DstShinozukaData%i = SrcShinozukaData%i - DstShinozukaData%j = SrcShinozukaData%j - DstShinozukaData%dt = SrcShinozukaData%dt - DstShinozukaData%t_min = SrcShinozukaData%t_min - DstShinozukaData%t_max = SrcShinozukaData%t_max - DstShinozukaData%df = SrcShinozukaData%df - END SUBROUTINE DWM_CopyShinozuka - - SUBROUTINE DWM_DestroyShinozuka( ShinozukaData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(Shinozuka), INTENT(INOUT) :: ShinozukaData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_DestroyShinozuka' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(ShinozukaData%f_syn)) THEN - DEALLOCATE(ShinozukaData%f_syn) -ENDIF -IF (ALLOCATED(ShinozukaData%t_syn)) THEN - DEALLOCATE(ShinozukaData%t_syn) -ENDIF -IF (ALLOCATED(ShinozukaData%phi)) THEN - DEALLOCATE(ShinozukaData%phi) -ENDIF -IF (ALLOCATED(ShinozukaData%p_k)) THEN - DEALLOCATE(ShinozukaData%p_k) -ENDIF -IF (ALLOCATED(ShinozukaData%a_k)) THEN - DEALLOCATE(ShinozukaData%a_k) -ENDIF - END SUBROUTINE DWM_DestroyShinozuka - - SUBROUTINE DWM_PackShinozuka( 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(Shinozuka), 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 = 'DWM_PackShinozuka' - ! 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_syn allocated yes/no - IF ( ALLOCATED(InData%f_syn) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! f_syn upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%f_syn) ! f_syn - END IF - Int_BufSz = Int_BufSz + 1 ! t_syn allocated yes/no - IF ( ALLOCATED(InData%t_syn) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! t_syn upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%t_syn) ! t_syn - END IF - Int_BufSz = Int_BufSz + 1 ! phi allocated yes/no - IF ( ALLOCATED(InData%phi) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! phi upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%phi) ! phi - END IF - Int_BufSz = Int_BufSz + 1 ! p_k allocated yes/no - IF ( ALLOCATED(InData%p_k) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! p_k upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%p_k) ! p_k - END IF - Int_BufSz = Int_BufSz + 1 ! a_k allocated yes/no - IF ( ALLOCATED(InData%a_k) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! a_k upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%a_k) ! a_k - END IF - Int_BufSz = Int_BufSz + 1 ! num_points - Int_BufSz = Int_BufSz + 1 ! ILo - Int_BufSz = Int_BufSz + 1 ! i - Int_BufSz = Int_BufSz + 1 ! j - Re_BufSz = Re_BufSz + 1 ! dt - Re_BufSz = Re_BufSz + 1 ! t_min - Re_BufSz = Re_BufSz + 1 ! t_max - Re_BufSz = Re_BufSz + 1 ! df - 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_syn) ) THEN - 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_syn,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%f_syn,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%f_syn,1), UBOUND(InData%f_syn,1) - ReKiBuf(Re_Xferred) = InData%f_syn(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%t_syn) ) THEN - 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_syn,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%t_syn,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%t_syn,1), UBOUND(InData%t_syn,1) - ReKiBuf(Re_Xferred) = InData%t_syn(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%phi) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%phi,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%phi,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%phi,1), UBOUND(InData%phi,1) - ReKiBuf(Re_Xferred) = InData%phi(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%p_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%p_k,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%p_k,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%p_k,1), UBOUND(InData%p_k,1) - ReKiBuf(Re_Xferred) = InData%p_k(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%a_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%a_k,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%a_k,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%a_k,1), UBOUND(InData%a_k,1) - ReKiBuf(Re_Xferred) = InData%a_k(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%num_points - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%ILo - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%i - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%j - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%dt - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%t_min - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%t_max - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%df - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE DWM_PackShinozuka - - SUBROUTINE DWM_UnPackShinozuka( 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(Shinozuka), 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 = 'DWM_UnPackShinozuka' - ! 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_syn not allocated - Int_Xferred = Int_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_syn)) DEALLOCATE(OutData%f_syn) - ALLOCATE(OutData%f_syn(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%f_syn.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%f_syn,1), UBOUND(OutData%f_syn,1) - OutData%f_syn(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! t_syn not allocated - Int_Xferred = Int_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%t_syn)) DEALLOCATE(OutData%t_syn) - ALLOCATE(OutData%t_syn(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%t_syn.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%t_syn,1), UBOUND(OutData%t_syn,1) - OutData%t_syn(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! phi not allocated - Int_Xferred = Int_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%phi)) DEALLOCATE(OutData%phi) - ALLOCATE(OutData%phi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%phi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%phi,1), UBOUND(OutData%phi,1) - OutData%phi(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! p_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 - IF (ALLOCATED(OutData%p_k)) DEALLOCATE(OutData%p_k) - ALLOCATE(OutData%p_k(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%p_k.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%p_k,1), UBOUND(OutData%p_k,1) - OutData%p_k(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! a_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 - IF (ALLOCATED(OutData%a_k)) DEALLOCATE(OutData%a_k) - ALLOCATE(OutData%a_k(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%a_k.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%a_k,1), UBOUND(OutData%a_k,1) - OutData%a_k(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%num_points = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%ILo = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%i = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%j = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%dt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%t_min = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%t_max = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%df = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE DWM_UnPackShinozuka - - SUBROUTINE DWM_Copysmooth_out_wake_data( Srcsmooth_out_wake_dataData, Dstsmooth_out_wake_dataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(smooth_out_wake_data), INTENT(IN) :: Srcsmooth_out_wake_dataData - TYPE(smooth_out_wake_data), INTENT(INOUT) :: Dstsmooth_out_wake_dataData - 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 = 'DWM_Copysmooth_out_wake_data' -! - ErrStat = ErrID_None - ErrMsg = "" - Dstsmooth_out_wake_dataData%length_velocity_array = Srcsmooth_out_wake_dataData%length_velocity_array - END SUBROUTINE DWM_Copysmooth_out_wake_data - - SUBROUTINE DWM_Destroysmooth_out_wake_data( smooth_out_wake_dataData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(smooth_out_wake_data), INTENT(INOUT) :: smooth_out_wake_dataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_Destroysmooth_out_wake_data' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE DWM_Destroysmooth_out_wake_data - - SUBROUTINE DWM_Packsmooth_out_wake_data( 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(smooth_out_wake_data), 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 = 'DWM_Packsmooth_out_wake_data' - ! 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 ! length_velocity_array - 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%length_velocity_array - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE DWM_Packsmooth_out_wake_data - - SUBROUTINE DWM_UnPacksmooth_out_wake_data( 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(smooth_out_wake_data), 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 = 'DWM_UnPacksmooth_out_wake_data' - ! 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%length_velocity_array = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE DWM_UnPacksmooth_out_wake_data - - SUBROUTINE DWM_CopySWSV( SrcSWSVData, DstSWSVData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SWSV), INTENT(IN) :: SrcSWSVData - TYPE(SWSV), INTENT(INOUT) :: DstSWSVData - 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 = 'DWM_CopySWSV' -! - ErrStat = ErrID_None - ErrMsg = "" - DstSWSVData%p1 = SrcSWSVData%p1 - DstSWSVData%p2 = SrcSWSVData%p2 - DstSWSVData%distance = SrcSWSVData%distance - DstSWSVData%y0 = SrcSWSVData%y0 - DstSWSVData%z0 = SrcSWSVData%z0 - DstSWSVData%unit = SrcSWSVData%unit - END SUBROUTINE DWM_CopySWSV - - SUBROUTINE DWM_DestroySWSV( SWSVData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(SWSV), INTENT(INOUT) :: SWSVData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_DestroySWSV' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE DWM_DestroySWSV - - SUBROUTINE DWM_PackSWSV( 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(SWSV), 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 = 'DWM_PackSWSV' - ! 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 ! p1 - Int_BufSz = Int_BufSz + 1 ! p2 - Re_BufSz = Re_BufSz + 1 ! distance - Re_BufSz = Re_BufSz + 1 ! y0 - Re_BufSz = Re_BufSz + 1 ! z0 - Re_BufSz = Re_BufSz + 1 ! unit - 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%p1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%p2 - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%distance - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%y0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%z0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%unit - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE DWM_PackSWSV - - SUBROUTINE DWM_UnPackSWSV( 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(SWSV), 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 = 'DWM_UnPackSWSV' - ! 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%p1 = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%p2 = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%distance = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%y0 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%z0 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%unit = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE DWM_UnPackSWSV - - SUBROUTINE DWM_Copyread_upwind_result( Srcread_upwind_resultData, Dstread_upwind_resultData, CtrlCode, ErrStat, ErrMsg ) - TYPE(read_upwind_result), INTENT(IN) :: Srcread_upwind_resultData - TYPE(read_upwind_result), INTENT(INOUT) :: Dstread_upwind_resultData - 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 = 'DWM_Copyread_upwind_result' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(Srcread_upwind_resultData%upwind_U)) THEN - i1_l = LBOUND(Srcread_upwind_resultData%upwind_U,1) - i1_u = UBOUND(Srcread_upwind_resultData%upwind_U,1) - i2_l = LBOUND(Srcread_upwind_resultData%upwind_U,2) - i2_u = UBOUND(Srcread_upwind_resultData%upwind_U,2) - IF (.NOT. ALLOCATED(Dstread_upwind_resultData%upwind_U)) THEN - ALLOCATE(Dstread_upwind_resultData%upwind_U(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Dstread_upwind_resultData%upwind_U.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - Dstread_upwind_resultData%upwind_U = Srcread_upwind_resultData%upwind_U -ENDIF -IF (ALLOCATED(Srcread_upwind_resultData%upwind_wakecenter)) THEN - i1_l = LBOUND(Srcread_upwind_resultData%upwind_wakecenter,1) - i1_u = UBOUND(Srcread_upwind_resultData%upwind_wakecenter,1) - i2_l = LBOUND(Srcread_upwind_resultData%upwind_wakecenter,2) - i2_u = UBOUND(Srcread_upwind_resultData%upwind_wakecenter,2) - i3_l = LBOUND(Srcread_upwind_resultData%upwind_wakecenter,3) - i3_u = UBOUND(Srcread_upwind_resultData%upwind_wakecenter,3) - i4_l = LBOUND(Srcread_upwind_resultData%upwind_wakecenter,4) - i4_u = UBOUND(Srcread_upwind_resultData%upwind_wakecenter,4) - IF (.NOT. ALLOCATED(Dstread_upwind_resultData%upwind_wakecenter)) THEN - ALLOCATE(Dstread_upwind_resultData%upwind_wakecenter(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 Dstread_upwind_resultData%upwind_wakecenter.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - Dstread_upwind_resultData%upwind_wakecenter = Srcread_upwind_resultData%upwind_wakecenter -ENDIF -IF (ALLOCATED(Srcread_upwind_resultData%upwind_meanU)) THEN - i1_l = LBOUND(Srcread_upwind_resultData%upwind_meanU,1) - i1_u = UBOUND(Srcread_upwind_resultData%upwind_meanU,1) - IF (.NOT. ALLOCATED(Dstread_upwind_resultData%upwind_meanU)) THEN - ALLOCATE(Dstread_upwind_resultData%upwind_meanU(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Dstread_upwind_resultData%upwind_meanU.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - Dstread_upwind_resultData%upwind_meanU = Srcread_upwind_resultData%upwind_meanU -ENDIF -IF (ALLOCATED(Srcread_upwind_resultData%upwind_TI)) THEN - i1_l = LBOUND(Srcread_upwind_resultData%upwind_TI,1) - i1_u = UBOUND(Srcread_upwind_resultData%upwind_TI,1) - IF (.NOT. ALLOCATED(Dstread_upwind_resultData%upwind_TI)) THEN - ALLOCATE(Dstread_upwind_resultData%upwind_TI(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Dstread_upwind_resultData%upwind_TI.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - Dstread_upwind_resultData%upwind_TI = Srcread_upwind_resultData%upwind_TI -ENDIF -IF (ALLOCATED(Srcread_upwind_resultData%upwind_small_TI)) THEN - i1_l = LBOUND(Srcread_upwind_resultData%upwind_small_TI,1) - i1_u = UBOUND(Srcread_upwind_resultData%upwind_small_TI,1) - IF (.NOT. ALLOCATED(Dstread_upwind_resultData%upwind_small_TI)) THEN - ALLOCATE(Dstread_upwind_resultData%upwind_small_TI(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Dstread_upwind_resultData%upwind_small_TI.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - Dstread_upwind_resultData%upwind_small_TI = Srcread_upwind_resultData%upwind_small_TI -ENDIF -IF (ALLOCATED(Srcread_upwind_resultData%upwind_smoothWake)) THEN - i1_l = LBOUND(Srcread_upwind_resultData%upwind_smoothWake,1) - i1_u = UBOUND(Srcread_upwind_resultData%upwind_smoothWake,1) - i2_l = LBOUND(Srcread_upwind_resultData%upwind_smoothWake,2) - i2_u = UBOUND(Srcread_upwind_resultData%upwind_smoothWake,2) - IF (.NOT. ALLOCATED(Dstread_upwind_resultData%upwind_smoothWake)) THEN - ALLOCATE(Dstread_upwind_resultData%upwind_smoothWake(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Dstread_upwind_resultData%upwind_smoothWake.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - Dstread_upwind_resultData%upwind_smoothWake = Srcread_upwind_resultData%upwind_smoothWake -ENDIF -IF (ALLOCATED(Srcread_upwind_resultData%velocity_aerodyn)) THEN - i1_l = LBOUND(Srcread_upwind_resultData%velocity_aerodyn,1) - i1_u = UBOUND(Srcread_upwind_resultData%velocity_aerodyn,1) - IF (.NOT. ALLOCATED(Dstread_upwind_resultData%velocity_aerodyn)) THEN - ALLOCATE(Dstread_upwind_resultData%velocity_aerodyn(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Dstread_upwind_resultData%velocity_aerodyn.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - Dstread_upwind_resultData%velocity_aerodyn = Srcread_upwind_resultData%velocity_aerodyn -ENDIF -IF (ALLOCATED(Srcread_upwind_resultData%TI_downstream)) THEN - i1_l = LBOUND(Srcread_upwind_resultData%TI_downstream,1) - i1_u = UBOUND(Srcread_upwind_resultData%TI_downstream,1) - IF (.NOT. ALLOCATED(Dstread_upwind_resultData%TI_downstream)) THEN - ALLOCATE(Dstread_upwind_resultData%TI_downstream(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Dstread_upwind_resultData%TI_downstream.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - Dstread_upwind_resultData%TI_downstream = Srcread_upwind_resultData%TI_downstream -ENDIF -IF (ALLOCATED(Srcread_upwind_resultData%small_scale_TI_downstream)) THEN - i1_l = LBOUND(Srcread_upwind_resultData%small_scale_TI_downstream,1) - i1_u = UBOUND(Srcread_upwind_resultData%small_scale_TI_downstream,1) - IF (.NOT. ALLOCATED(Dstread_upwind_resultData%small_scale_TI_downstream)) THEN - ALLOCATE(Dstread_upwind_resultData%small_scale_TI_downstream(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Dstread_upwind_resultData%small_scale_TI_downstream.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - Dstread_upwind_resultData%small_scale_TI_downstream = Srcread_upwind_resultData%small_scale_TI_downstream -ENDIF -IF (ALLOCATED(Srcread_upwind_resultData%smoothed_velocity_array)) THEN - i1_l = LBOUND(Srcread_upwind_resultData%smoothed_velocity_array,1) - i1_u = UBOUND(Srcread_upwind_resultData%smoothed_velocity_array,1) - i2_l = LBOUND(Srcread_upwind_resultData%smoothed_velocity_array,2) - i2_u = UBOUND(Srcread_upwind_resultData%smoothed_velocity_array,2) - IF (.NOT. ALLOCATED(Dstread_upwind_resultData%smoothed_velocity_array)) THEN - ALLOCATE(Dstread_upwind_resultData%smoothed_velocity_array(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Dstread_upwind_resultData%smoothed_velocity_array.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - Dstread_upwind_resultData%smoothed_velocity_array = Srcread_upwind_resultData%smoothed_velocity_array -ENDIF -IF (ALLOCATED(Srcread_upwind_resultData%vel_matrix)) THEN - i1_l = LBOUND(Srcread_upwind_resultData%vel_matrix,1) - i1_u = UBOUND(Srcread_upwind_resultData%vel_matrix,1) - i2_l = LBOUND(Srcread_upwind_resultData%vel_matrix,2) - i2_u = UBOUND(Srcread_upwind_resultData%vel_matrix,2) - i3_l = LBOUND(Srcread_upwind_resultData%vel_matrix,3) - i3_u = UBOUND(Srcread_upwind_resultData%vel_matrix,3) - IF (.NOT. ALLOCATED(Dstread_upwind_resultData%vel_matrix)) THEN - ALLOCATE(Dstread_upwind_resultData%vel_matrix(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Dstread_upwind_resultData%vel_matrix.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - Dstread_upwind_resultData%vel_matrix = Srcread_upwind_resultData%vel_matrix -ENDIF - END SUBROUTINE DWM_Copyread_upwind_result - - SUBROUTINE DWM_Destroyread_upwind_result( read_upwind_resultData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(read_upwind_result), INTENT(INOUT) :: read_upwind_resultData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_Destroyread_upwind_result' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(read_upwind_resultData%upwind_U)) THEN - DEALLOCATE(read_upwind_resultData%upwind_U) -ENDIF -IF (ALLOCATED(read_upwind_resultData%upwind_wakecenter)) THEN - DEALLOCATE(read_upwind_resultData%upwind_wakecenter) -ENDIF -IF (ALLOCATED(read_upwind_resultData%upwind_meanU)) THEN - DEALLOCATE(read_upwind_resultData%upwind_meanU) -ENDIF -IF (ALLOCATED(read_upwind_resultData%upwind_TI)) THEN - DEALLOCATE(read_upwind_resultData%upwind_TI) -ENDIF -IF (ALLOCATED(read_upwind_resultData%upwind_small_TI)) THEN - DEALLOCATE(read_upwind_resultData%upwind_small_TI) -ENDIF -IF (ALLOCATED(read_upwind_resultData%upwind_smoothWake)) THEN - DEALLOCATE(read_upwind_resultData%upwind_smoothWake) -ENDIF -IF (ALLOCATED(read_upwind_resultData%velocity_aerodyn)) THEN - DEALLOCATE(read_upwind_resultData%velocity_aerodyn) -ENDIF -IF (ALLOCATED(read_upwind_resultData%TI_downstream)) THEN - DEALLOCATE(read_upwind_resultData%TI_downstream) -ENDIF -IF (ALLOCATED(read_upwind_resultData%small_scale_TI_downstream)) THEN - DEALLOCATE(read_upwind_resultData%small_scale_TI_downstream) -ENDIF -IF (ALLOCATED(read_upwind_resultData%smoothed_velocity_array)) THEN - DEALLOCATE(read_upwind_resultData%smoothed_velocity_array) -ENDIF -IF (ALLOCATED(read_upwind_resultData%vel_matrix)) THEN - DEALLOCATE(read_upwind_resultData%vel_matrix) -ENDIF - END SUBROUTINE DWM_Destroyread_upwind_result - - SUBROUTINE DWM_Packread_upwind_result( 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(read_upwind_result), 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 = 'DWM_Packread_upwind_result' - ! 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 ! upwind_U allocated yes/no - IF ( ALLOCATED(InData%upwind_U) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! upwind_U upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%upwind_U) ! upwind_U - END IF - Int_BufSz = Int_BufSz + 1 ! upwind_wakecenter allocated yes/no - IF ( ALLOCATED(InData%upwind_wakecenter) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! upwind_wakecenter upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%upwind_wakecenter) ! upwind_wakecenter - END IF - Int_BufSz = Int_BufSz + 1 ! upwind_meanU allocated yes/no - IF ( ALLOCATED(InData%upwind_meanU) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! upwind_meanU upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%upwind_meanU) ! upwind_meanU - END IF - Int_BufSz = Int_BufSz + 1 ! upwind_TI allocated yes/no - IF ( ALLOCATED(InData%upwind_TI) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! upwind_TI upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%upwind_TI) ! upwind_TI - END IF - Int_BufSz = Int_BufSz + 1 ! upwind_small_TI allocated yes/no - IF ( ALLOCATED(InData%upwind_small_TI) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! upwind_small_TI upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%upwind_small_TI) ! upwind_small_TI - END IF - Int_BufSz = Int_BufSz + 1 ! upwind_smoothWake allocated yes/no - IF ( ALLOCATED(InData%upwind_smoothWake) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! upwind_smoothWake upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%upwind_smoothWake) ! upwind_smoothWake - END IF - Int_BufSz = Int_BufSz + 1 ! velocity_aerodyn allocated yes/no - IF ( ALLOCATED(InData%velocity_aerodyn) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! velocity_aerodyn upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%velocity_aerodyn) ! velocity_aerodyn - END IF - Int_BufSz = Int_BufSz + 1 ! TI_downstream allocated yes/no - IF ( ALLOCATED(InData%TI_downstream) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TI_downstream upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TI_downstream) ! TI_downstream - END IF - Int_BufSz = Int_BufSz + 1 ! small_scale_TI_downstream allocated yes/no - IF ( ALLOCATED(InData%small_scale_TI_downstream) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! small_scale_TI_downstream upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%small_scale_TI_downstream) ! small_scale_TI_downstream - END IF - Int_BufSz = Int_BufSz + 1 ! smoothed_velocity_array allocated yes/no - IF ( ALLOCATED(InData%smoothed_velocity_array) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! smoothed_velocity_array upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%smoothed_velocity_array) ! smoothed_velocity_array - END IF - Int_BufSz = Int_BufSz + 1 ! vel_matrix allocated yes/no - IF ( ALLOCATED(InData%vel_matrix) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! vel_matrix upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%vel_matrix) ! vel_matrix - 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%upwind_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%upwind_U,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%upwind_U,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%upwind_U,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%upwind_U,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%upwind_U,2), UBOUND(InData%upwind_U,2) - DO i1 = LBOUND(InData%upwind_U,1), UBOUND(InData%upwind_U,1) - ReKiBuf(Re_Xferred) = InData%upwind_U(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%upwind_wakecenter) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%upwind_wakecenter,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%upwind_wakecenter,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%upwind_wakecenter,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%upwind_wakecenter,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%upwind_wakecenter,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%upwind_wakecenter,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%upwind_wakecenter,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%upwind_wakecenter,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%upwind_wakecenter,4), UBOUND(InData%upwind_wakecenter,4) - DO i3 = LBOUND(InData%upwind_wakecenter,3), UBOUND(InData%upwind_wakecenter,3) - DO i2 = LBOUND(InData%upwind_wakecenter,2), UBOUND(InData%upwind_wakecenter,2) - DO i1 = LBOUND(InData%upwind_wakecenter,1), UBOUND(InData%upwind_wakecenter,1) - ReKiBuf(Re_Xferred) = InData%upwind_wakecenter(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%upwind_meanU) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%upwind_meanU,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%upwind_meanU,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%upwind_meanU,1), UBOUND(InData%upwind_meanU,1) - ReKiBuf(Re_Xferred) = InData%upwind_meanU(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%upwind_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%upwind_TI,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%upwind_TI,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%upwind_TI,1), UBOUND(InData%upwind_TI,1) - ReKiBuf(Re_Xferred) = InData%upwind_TI(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%upwind_small_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%upwind_small_TI,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%upwind_small_TI,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%upwind_small_TI,1), UBOUND(InData%upwind_small_TI,1) - ReKiBuf(Re_Xferred) = InData%upwind_small_TI(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%upwind_smoothWake) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%upwind_smoothWake,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%upwind_smoothWake,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%upwind_smoothWake,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%upwind_smoothWake,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%upwind_smoothWake,2), UBOUND(InData%upwind_smoothWake,2) - DO i1 = LBOUND(InData%upwind_smoothWake,1), UBOUND(InData%upwind_smoothWake,1) - ReKiBuf(Re_Xferred) = InData%upwind_smoothWake(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%velocity_aerodyn) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%velocity_aerodyn,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%velocity_aerodyn,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%velocity_aerodyn,1), UBOUND(InData%velocity_aerodyn,1) - ReKiBuf(Re_Xferred) = InData%velocity_aerodyn(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TI_downstream) ) THEN - 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_downstream,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TI_downstream,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TI_downstream,1), UBOUND(InData%TI_downstream,1) - ReKiBuf(Re_Xferred) = InData%TI_downstream(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%small_scale_TI_downstream) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%small_scale_TI_downstream,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%small_scale_TI_downstream,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%small_scale_TI_downstream,1), UBOUND(InData%small_scale_TI_downstream,1) - ReKiBuf(Re_Xferred) = InData%small_scale_TI_downstream(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%smoothed_velocity_array) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%smoothed_velocity_array,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%smoothed_velocity_array,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%smoothed_velocity_array,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%smoothed_velocity_array,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%smoothed_velocity_array,2), UBOUND(InData%smoothed_velocity_array,2) - DO i1 = LBOUND(InData%smoothed_velocity_array,1), UBOUND(InData%smoothed_velocity_array,1) - ReKiBuf(Re_Xferred) = InData%smoothed_velocity_array(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%vel_matrix) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%vel_matrix,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%vel_matrix,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%vel_matrix,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%vel_matrix,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%vel_matrix,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%vel_matrix,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%vel_matrix,3), UBOUND(InData%vel_matrix,3) - DO i2 = LBOUND(InData%vel_matrix,2), UBOUND(InData%vel_matrix,2) - DO i1 = LBOUND(InData%vel_matrix,1), UBOUND(InData%vel_matrix,1) - ReKiBuf(Re_Xferred) = InData%vel_matrix(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - END SUBROUTINE DWM_Packread_upwind_result - - SUBROUTINE DWM_UnPackread_upwind_result( 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(read_upwind_result), 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 = 'DWM_UnPackread_upwind_result' - ! 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 ! upwind_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 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%upwind_U)) DEALLOCATE(OutData%upwind_U) - ALLOCATE(OutData%upwind_U(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%upwind_U.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%upwind_U,2), UBOUND(OutData%upwind_U,2) - DO i1 = LBOUND(OutData%upwind_U,1), UBOUND(OutData%upwind_U,1) - OutData%upwind_U(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! upwind_wakecenter not allocated - Int_Xferred = Int_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%upwind_wakecenter)) DEALLOCATE(OutData%upwind_wakecenter) - ALLOCATE(OutData%upwind_wakecenter(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%upwind_wakecenter.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%upwind_wakecenter,4), UBOUND(OutData%upwind_wakecenter,4) - DO i3 = LBOUND(OutData%upwind_wakecenter,3), UBOUND(OutData%upwind_wakecenter,3) - DO i2 = LBOUND(OutData%upwind_wakecenter,2), UBOUND(OutData%upwind_wakecenter,2) - DO i1 = LBOUND(OutData%upwind_wakecenter,1), UBOUND(OutData%upwind_wakecenter,1) - OutData%upwind_wakecenter(i1,i2,i3,i4) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! upwind_meanU not allocated - Int_Xferred = Int_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%upwind_meanU)) DEALLOCATE(OutData%upwind_meanU) - ALLOCATE(OutData%upwind_meanU(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%upwind_meanU.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%upwind_meanU,1), UBOUND(OutData%upwind_meanU,1) - OutData%upwind_meanU(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! upwind_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 - IF (ALLOCATED(OutData%upwind_TI)) DEALLOCATE(OutData%upwind_TI) - ALLOCATE(OutData%upwind_TI(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%upwind_TI.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%upwind_TI,1), UBOUND(OutData%upwind_TI,1) - OutData%upwind_TI(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! upwind_small_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 - IF (ALLOCATED(OutData%upwind_small_TI)) DEALLOCATE(OutData%upwind_small_TI) - ALLOCATE(OutData%upwind_small_TI(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%upwind_small_TI.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%upwind_small_TI,1), UBOUND(OutData%upwind_small_TI,1) - OutData%upwind_small_TI(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! upwind_smoothWake not allocated - Int_Xferred = Int_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%upwind_smoothWake)) DEALLOCATE(OutData%upwind_smoothWake) - ALLOCATE(OutData%upwind_smoothWake(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%upwind_smoothWake.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%upwind_smoothWake,2), UBOUND(OutData%upwind_smoothWake,2) - DO i1 = LBOUND(OutData%upwind_smoothWake,1), UBOUND(OutData%upwind_smoothWake,1) - OutData%upwind_smoothWake(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! velocity_aerodyn not allocated - Int_Xferred = Int_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%velocity_aerodyn)) DEALLOCATE(OutData%velocity_aerodyn) - ALLOCATE(OutData%velocity_aerodyn(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%velocity_aerodyn.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%velocity_aerodyn,1), UBOUND(OutData%velocity_aerodyn,1) - OutData%velocity_aerodyn(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TI_downstream not allocated - Int_Xferred = Int_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_downstream)) DEALLOCATE(OutData%TI_downstream) - ALLOCATE(OutData%TI_downstream(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TI_downstream.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TI_downstream,1), UBOUND(OutData%TI_downstream,1) - OutData%TI_downstream(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! small_scale_TI_downstream not allocated - Int_Xferred = Int_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%small_scale_TI_downstream)) DEALLOCATE(OutData%small_scale_TI_downstream) - ALLOCATE(OutData%small_scale_TI_downstream(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%small_scale_TI_downstream.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%small_scale_TI_downstream,1), UBOUND(OutData%small_scale_TI_downstream,1) - OutData%small_scale_TI_downstream(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! smoothed_velocity_array not allocated - Int_Xferred = Int_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%smoothed_velocity_array)) DEALLOCATE(OutData%smoothed_velocity_array) - ALLOCATE(OutData%smoothed_velocity_array(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%smoothed_velocity_array.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%smoothed_velocity_array,2), UBOUND(OutData%smoothed_velocity_array,2) - DO i1 = LBOUND(OutData%smoothed_velocity_array,1), UBOUND(OutData%smoothed_velocity_array,1) - OutData%smoothed_velocity_array(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! vel_matrix not allocated - Int_Xferred = Int_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%vel_matrix)) DEALLOCATE(OutData%vel_matrix) - ALLOCATE(OutData%vel_matrix(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%vel_matrix.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%vel_matrix,3), UBOUND(OutData%vel_matrix,3) - DO i2 = LBOUND(OutData%vel_matrix,2), UBOUND(OutData%vel_matrix,2) - DO i1 = LBOUND(OutData%vel_matrix,1), UBOUND(OutData%vel_matrix,1) - OutData%vel_matrix(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - END SUBROUTINE DWM_UnPackread_upwind_result - - SUBROUTINE DWM_Copywake_meandered_center( Srcwake_meandered_centerData, Dstwake_meandered_centerData, CtrlCode, ErrStat, ErrMsg ) - TYPE(wake_meandered_center), INTENT(IN) :: Srcwake_meandered_centerData - TYPE(wake_meandered_center), INTENT(INOUT) :: Dstwake_meandered_centerData - 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 = 'DWM_Copywake_meandered_center' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(Srcwake_meandered_centerData%wake_width)) THEN - i1_l = LBOUND(Srcwake_meandered_centerData%wake_width,1) - i1_u = UBOUND(Srcwake_meandered_centerData%wake_width,1) - IF (.NOT. ALLOCATED(Dstwake_meandered_centerData%wake_width)) THEN - ALLOCATE(Dstwake_meandered_centerData%wake_width(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Dstwake_meandered_centerData%wake_width.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - Dstwake_meandered_centerData%wake_width = Srcwake_meandered_centerData%wake_width -ENDIF - END SUBROUTINE DWM_Copywake_meandered_center - - SUBROUTINE DWM_Destroywake_meandered_center( wake_meandered_centerData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(wake_meandered_center), INTENT(INOUT) :: wake_meandered_centerData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_Destroywake_meandered_center' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(wake_meandered_centerData%wake_width)) THEN - DEALLOCATE(wake_meandered_centerData%wake_width) -ENDIF - END SUBROUTINE DWM_Destroywake_meandered_center - - SUBROUTINE DWM_Packwake_meandered_center( 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(wake_meandered_center), 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 = 'DWM_Packwake_meandered_center' - ! 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 ! wake_width allocated yes/no - IF ( ALLOCATED(InData%wake_width) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! wake_width upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%wake_width) ! wake_width - 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%wake_width) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%wake_width,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%wake_width,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%wake_width,1), UBOUND(InData%wake_width,1) - IntKiBuf(Int_Xferred) = InData%wake_width(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - END SUBROUTINE DWM_Packwake_meandered_center - - SUBROUTINE DWM_UnPackwake_meandered_center( 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(wake_meandered_center), 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 = 'DWM_UnPackwake_meandered_center' - ! 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 ! wake_width not allocated - Int_Xferred = Int_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%wake_width)) DEALLOCATE(OutData%wake_width) - ALLOCATE(OutData%wake_width(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%wake_width.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%wake_width,1), UBOUND(OutData%wake_width,1) - OutData%wake_width(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - END SUBROUTINE DWM_UnPackwake_meandered_center - - SUBROUTINE DWM_Copyturbine_blade( Srcturbine_bladeData, Dstturbine_bladeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(DWM_turbine_blade), INTENT(IN) :: Srcturbine_bladeData - TYPE(DWM_turbine_blade), INTENT(INOUT) :: Dstturbine_bladeData - 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 = 'DWM_Copyturbine_blade' -! - ErrStat = ErrID_None - ErrMsg = "" - Dstturbine_bladeData%Aerodyn_turbine_num = Srcturbine_bladeData%Aerodyn_turbine_num - Dstturbine_bladeData%Blade_index = Srcturbine_bladeData%Blade_index - Dstturbine_bladeData%Element_index = Srcturbine_bladeData%Element_index - END SUBROUTINE DWM_Copyturbine_blade - - SUBROUTINE DWM_Destroyturbine_blade( turbine_bladeData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(DWM_turbine_blade), INTENT(INOUT) :: turbine_bladeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_Destroyturbine_blade' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE DWM_Destroyturbine_blade - - SUBROUTINE DWM_Packturbine_blade( 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(DWM_turbine_blade), 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 = 'DWM_Packturbine_blade' - ! 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 ! Aerodyn_turbine_num - Int_BufSz = Int_BufSz + 1 ! Blade_index - Int_BufSz = Int_BufSz + 1 ! Element_index - 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%Aerodyn_turbine_num - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%Blade_index - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%Element_index - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE DWM_Packturbine_blade - - SUBROUTINE DWM_UnPackturbine_blade( 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(DWM_turbine_blade), 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 = 'DWM_UnPackturbine_blade' - ! 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%Aerodyn_turbine_num = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%Blade_index = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%Element_index = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE DWM_UnPackturbine_blade - - SUBROUTINE DWM_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(DWM_ParameterType), INTENT(IN) :: SrcParamData - TYPE(DWM_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) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_CopyParam' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcParamData%velocityU)) THEN - i1_l = LBOUND(SrcParamData%velocityU,1) - i1_u = UBOUND(SrcParamData%velocityU,1) - IF (.NOT. ALLOCATED(DstParamData%velocityU)) THEN - ALLOCATE(DstParamData%velocityU(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%velocityU.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%velocityU = SrcParamData%velocityU -ENDIF -IF (ALLOCATED(SrcParamData%smoothed_wake)) THEN - i1_l = LBOUND(SrcParamData%smoothed_wake,1) - i1_u = UBOUND(SrcParamData%smoothed_wake,1) - IF (.NOT. ALLOCATED(DstParamData%smoothed_wake)) THEN - ALLOCATE(DstParamData%smoothed_wake(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%smoothed_wake.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%smoothed_wake = SrcParamData%smoothed_wake -ENDIF -IF (ALLOCATED(SrcParamData%WakePosition)) THEN - i1_l = LBOUND(SrcParamData%WakePosition,1) - i1_u = UBOUND(SrcParamData%WakePosition,1) - i2_l = LBOUND(SrcParamData%WakePosition,2) - i2_u = UBOUND(SrcParamData%WakePosition,2) - i3_l = LBOUND(SrcParamData%WakePosition,3) - i3_u = UBOUND(SrcParamData%WakePosition,3) - IF (.NOT. ALLOCATED(DstParamData%WakePosition)) THEN - ALLOCATE(DstParamData%WakePosition(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WakePosition.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%WakePosition = SrcParamData%WakePosition -ENDIF - DstParamData%WakePosition_1 = SrcParamData%WakePosition_1 - DstParamData%WakePosition_2 = SrcParamData%WakePosition_2 - DstParamData%smooth_flag = SrcParamData%smooth_flag - DstParamData%p_p_r = SrcParamData%p_p_r - DstParamData%NumWT = SrcParamData%NumWT - DstParamData%Tinfluencer = SrcParamData%Tinfluencer - DstParamData%RotorR = SrcParamData%RotorR - DstParamData%r_domain = SrcParamData%r_domain - DstParamData%x_domain = SrcParamData%x_domain - DstParamData%Uambient = SrcParamData%Uambient - DstParamData%TI_amb = SrcParamData%TI_amb - DstParamData%TI_wake = SrcParamData%TI_wake - DstParamData%hub_height = SrcParamData%hub_height - DstParamData%length_velocityU = SrcParamData%length_velocityU - DstParamData%WFLowerBd = SrcParamData%WFLowerBd - DstParamData%Wind_file_Mean_u = SrcParamData%Wind_file_Mean_u - DstParamData%Winddir = SrcParamData%Winddir - DstParamData%air_density = SrcParamData%air_density - DstParamData%RR = SrcParamData%RR -IF (ALLOCATED(SrcParamData%ElementRad)) THEN - i1_l = LBOUND(SrcParamData%ElementRad,1) - i1_u = UBOUND(SrcParamData%ElementRad,1) - IF (.NOT. ALLOCATED(DstParamData%ElementRad)) THEN - ALLOCATE(DstParamData%ElementRad(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ElementRad.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%ElementRad = SrcParamData%ElementRad -ENDIF - DstParamData%Bnum = SrcParamData%Bnum - DstParamData%ElementNum = SrcParamData%ElementNum - CALL DWM_Copyread_turbine_position_data( SrcParamData%RTPD, DstParamData%RTPD, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL InflowWind_CopyParam( SrcParamData%IfW, DstParamData%IfW, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE DWM_CopyParam - - SUBROUTINE DWM_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(DWM_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(ParamData%velocityU)) THEN - DEALLOCATE(ParamData%velocityU) -ENDIF -IF (ALLOCATED(ParamData%smoothed_wake)) THEN - DEALLOCATE(ParamData%smoothed_wake) -ENDIF -IF (ALLOCATED(ParamData%WakePosition)) THEN - DEALLOCATE(ParamData%WakePosition) -ENDIF -IF (ALLOCATED(ParamData%ElementRad)) THEN - DEALLOCATE(ParamData%ElementRad) -ENDIF - CALL DWM_Destroyread_turbine_position_data( ParamData%RTPD, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL InflowWind_DestroyParam( ParamData%IfW, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE DWM_DestroyParam - - SUBROUTINE DWM_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(DWM_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 = 'DWM_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 ! velocityU allocated yes/no - IF ( ALLOCATED(InData%velocityU) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! velocityU upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%velocityU) ! velocityU - END IF - Int_BufSz = Int_BufSz + 1 ! smoothed_wake allocated yes/no - IF ( ALLOCATED(InData%smoothed_wake) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! smoothed_wake upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%smoothed_wake) ! smoothed_wake - END IF - Int_BufSz = Int_BufSz + 1 ! WakePosition allocated yes/no - IF ( ALLOCATED(InData%WakePosition) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! WakePosition upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WakePosition) ! WakePosition - END IF - Int_BufSz = Int_BufSz + 1 ! WakePosition_1 - Int_BufSz = Int_BufSz + 1 ! WakePosition_2 - Int_BufSz = Int_BufSz + 1 ! smooth_flag - Int_BufSz = Int_BufSz + 1 ! p_p_r - Int_BufSz = Int_BufSz + 1 ! NumWT - Int_BufSz = Int_BufSz + 1 ! Tinfluencer - Re_BufSz = Re_BufSz + 1 ! RotorR - Re_BufSz = Re_BufSz + 1 ! r_domain - Re_BufSz = Re_BufSz + 1 ! x_domain - Re_BufSz = Re_BufSz + 1 ! Uambient - Re_BufSz = Re_BufSz + 1 ! TI_amb - Re_BufSz = Re_BufSz + 1 ! TI_wake - Re_BufSz = Re_BufSz + 1 ! hub_height - Re_BufSz = Re_BufSz + 1 ! length_velocityU - Re_BufSz = Re_BufSz + 1 ! WFLowerBd - Re_BufSz = Re_BufSz + 1 ! Wind_file_Mean_u - Re_BufSz = Re_BufSz + 1 ! Winddir - Re_BufSz = Re_BufSz + 1 ! air_density - Re_BufSz = Re_BufSz + 1 ! RR - Int_BufSz = Int_BufSz + 1 ! ElementRad allocated yes/no - IF ( ALLOCATED(InData%ElementRad) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ElementRad upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%ElementRad) ! ElementRad - END IF - Int_BufSz = Int_BufSz + 1 ! Bnum - Int_BufSz = Int_BufSz + 1 ! ElementNum - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! RTPD: size of buffers for each call to pack subtype - CALL DWM_Packread_turbine_position_data( Re_Buf, Db_Buf, Int_Buf, InData%RTPD, ErrStat2, ErrMsg2, .TRUE. ) ! RTPD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! RTPD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! RTPD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! RTPD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! IfW: size of buffers for each call to pack subtype - CALL InflowWind_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%IfW, ErrStat2, ErrMsg2, .TRUE. ) ! IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! IfW - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! IfW - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! IfW - 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%velocityU) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%velocityU,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%velocityU,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%velocityU,1), UBOUND(InData%velocityU,1) - ReKiBuf(Re_Xferred) = InData%velocityU(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%smoothed_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%smoothed_wake,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%smoothed_wake,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%smoothed_wake,1), UBOUND(InData%smoothed_wake,1) - ReKiBuf(Re_Xferred) = InData%smoothed_wake(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WakePosition) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WakePosition,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WakePosition,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WakePosition,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WakePosition,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WakePosition,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WakePosition,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%WakePosition,3), UBOUND(InData%WakePosition,3) - DO i2 = LBOUND(InData%WakePosition,2), UBOUND(InData%WakePosition,2) - DO i1 = LBOUND(InData%WakePosition,1), UBOUND(InData%WakePosition,1) - ReKiBuf(Re_Xferred) = InData%WakePosition(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%WakePosition_1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%WakePosition_2 - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%smooth_flag - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%p_p_r - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumWT - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%Tinfluencer - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RotorR - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%r_domain - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%x_domain - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Uambient - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TI_amb - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TI_wake - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%hub_height - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%length_velocityU - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WFLowerBd - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Wind_file_Mean_u - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Winddir - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%air_density - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RR - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%ElementRad) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ElementRad,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ElementRad,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ElementRad,1), UBOUND(InData%ElementRad,1) - ReKiBuf(Re_Xferred) = InData%ElementRad(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%Bnum - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%ElementNum - Int_Xferred = Int_Xferred + 1 - CALL DWM_Packread_turbine_position_data( Re_Buf, Db_Buf, Int_Buf, InData%RTPD, ErrStat2, ErrMsg2, OnlySize ) ! RTPD - 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 InflowWind_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%IfW, ErrStat2, ErrMsg2, OnlySize ) ! IfW - 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 DWM_PackParam - - SUBROUTINE DWM_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(DWM_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) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! velocityU not allocated - Int_Xferred = Int_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%velocityU)) DEALLOCATE(OutData%velocityU) - ALLOCATE(OutData%velocityU(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%velocityU.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%velocityU,1), UBOUND(OutData%velocityU,1) - OutData%velocityU(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! smoothed_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%smoothed_wake)) DEALLOCATE(OutData%smoothed_wake) - ALLOCATE(OutData%smoothed_wake(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%smoothed_wake.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%smoothed_wake,1), UBOUND(OutData%smoothed_wake,1) - OutData%smoothed_wake(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WakePosition not allocated - Int_Xferred = Int_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%WakePosition)) DEALLOCATE(OutData%WakePosition) - ALLOCATE(OutData%WakePosition(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%WakePosition.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%WakePosition,3), UBOUND(OutData%WakePosition,3) - DO i2 = LBOUND(OutData%WakePosition,2), UBOUND(OutData%WakePosition,2) - DO i1 = LBOUND(OutData%WakePosition,1), UBOUND(OutData%WakePosition,1) - OutData%WakePosition(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - OutData%WakePosition_1 = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WakePosition_2 = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%smooth_flag = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%p_p_r = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumWT = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%Tinfluencer = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%RotorR = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%r_domain = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%x_domain = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Uambient = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TI_amb = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TI_wake = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%hub_height = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%length_velocityU = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%WFLowerBd = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Wind_file_Mean_u = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Winddir = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%air_density = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RR = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ElementRad not allocated - Int_Xferred = Int_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%ElementRad)) DEALLOCATE(OutData%ElementRad) - ALLOCATE(OutData%ElementRad(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ElementRad.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ElementRad,1), UBOUND(OutData%ElementRad,1) - OutData%ElementRad(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%Bnum = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%ElementNum = IntKiBuf(Int_Xferred) - 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 DWM_Unpackread_turbine_position_data( Re_Buf, Db_Buf, Int_Buf, OutData%RTPD, ErrStat2, ErrMsg2 ) ! RTPD - 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 InflowWind_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%IfW, ErrStat2, ErrMsg2 ) ! IfW - 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 DWM_UnPackParam - - SUBROUTINE DWM_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(DWM_OtherStateType), INTENT(IN) :: SrcOtherStateData - TYPE(DWM_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 = 'DWM_CopyOtherState' -! - ErrStat = ErrID_None - ErrMsg = "" - CALL InflowWind_CopyOtherState( SrcOtherStateData%IfW, DstOtherStateData%IfW, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE DWM_CopyOtherState - - SUBROUTINE DWM_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(DWM_OtherStateType), INTENT(INOUT) :: OtherStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_DestroyOtherState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL InflowWind_DestroyOtherState( OtherStateData%IfW, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE DWM_DestroyOtherState - - SUBROUTINE DWM_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(DWM_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 = 'DWM_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 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! IfW: size of buffers for each call to pack subtype - CALL InflowWind_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%IfW, ErrStat2, ErrMsg2, .TRUE. ) ! IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! IfW - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! IfW - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! IfW - 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 InflowWind_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%IfW, ErrStat2, ErrMsg2, OnlySize ) ! IfW - 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 DWM_PackOtherState - - SUBROUTINE DWM_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(DWM_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 = 'DWM_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 - 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 InflowWind_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%IfW, ErrStat2, ErrMsg2 ) ! IfW - 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 DWM_UnPackOtherState - - SUBROUTINE DWM_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(DWM_MiscVarType), INTENT(IN) :: SrcMiscData - TYPE(DWM_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 = 'DWM_CopyMisc' -! - ErrStat = ErrID_None - ErrMsg = "" - CALL InflowWind_CopyMisc( SrcMiscData%IfW, DstMiscData%IfW, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstMiscData%position_y = SrcMiscData%position_y - DstMiscData%position_z = SrcMiscData%position_z - DstMiscData%velocity_wake_mean = SrcMiscData%velocity_wake_mean - DstMiscData%shifted_velocity_Aerodyn = SrcMiscData%shifted_velocity_Aerodyn - DstMiscData%U_velocity = SrcMiscData%U_velocity - DstMiscData%V_velocity = SrcMiscData%V_velocity -IF (ALLOCATED(SrcMiscData%Nforce)) THEN - i1_l = LBOUND(SrcMiscData%Nforce,1) - i1_u = UBOUND(SrcMiscData%Nforce,1) - i2_l = LBOUND(SrcMiscData%Nforce,2) - i2_u = UBOUND(SrcMiscData%Nforce,2) - IF (.NOT. ALLOCATED(DstMiscData%Nforce)) THEN - ALLOCATE(DstMiscData%Nforce(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Nforce.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%Nforce = SrcMiscData%Nforce -ENDIF -IF (ALLOCATED(SrcMiscData%blade_dr)) THEN - i1_l = LBOUND(SrcMiscData%blade_dr,1) - i1_u = UBOUND(SrcMiscData%blade_dr,1) - IF (.NOT. ALLOCATED(DstMiscData%blade_dr)) THEN - ALLOCATE(DstMiscData%blade_dr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%blade_dr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%blade_dr = SrcMiscData%blade_dr -ENDIF - DstMiscData%NacYaw = SrcMiscData%NacYaw - DstMiscData%TI_original = SrcMiscData%TI_original - CALL DWM_Copyturbine_average_velocity_data( SrcMiscData%TAVD, DstMiscData%TAVD, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL DWM_Copycvsd( SrcMiscData%CalVelScale_data, DstMiscData%CalVelScale_data, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL DWM_Copymeanderdata( SrcMiscData%meandering_data, DstMiscData%meandering_data, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL DWM_Copyweimethod( SrcMiscData%weighting_method, DstMiscData%weighting_method, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL DWM_Copytidownstream( SrcMiscData%TI_downstream_data, DstMiscData%TI_downstream_data, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL DWM_Copyturbkaimal( SrcMiscData%Turbulence_KS, DstMiscData%Turbulence_KS, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL DWM_Copyshinozuka( SrcMiscData%shinozuka_data, DstMiscData%shinozuka_data, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL DWM_Copysmooth_out_wake_data( SrcMiscData%SmoothOut, DstMiscData%SmoothOut, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL DWM_Copyswsv( SrcMiscData%smooth_wake_shifted_velocity_data, DstMiscData%smooth_wake_shifted_velocity_data, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL DWM_Copywake_deficit_data( SrcMiscData%DWDD, DstMiscData%DWDD, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstMiscData%ct_tilde = SrcMiscData%ct_tilde - DstMiscData%FAST_Time = SrcMiscData%FAST_Time - DstMiscData%SDtimestep = SrcMiscData%SDtimestep - CALL DWM_Copyturbine_blade( SrcMiscData%DWM_tb, DstMiscData%DWM_tb, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL DWM_Copywake_meandered_center( SrcMiscData%WMC, DstMiscData%WMC, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE DWM_CopyMisc - - SUBROUTINE DWM_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(DWM_MiscVarType), INTENT(INOUT) :: MiscData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_DestroyMisc' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL InflowWind_DestroyMisc( MiscData%IfW, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(MiscData%Nforce)) THEN - DEALLOCATE(MiscData%Nforce) -ENDIF -IF (ALLOCATED(MiscData%blade_dr)) THEN - DEALLOCATE(MiscData%blade_dr) -ENDIF - CALL DWM_Destroyturbine_average_velocity_data( MiscData%TAVD, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL DWM_Destroycvsd( MiscData%CalVelScale_data, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL DWM_Destroymeanderdata( MiscData%meandering_data, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL DWM_Destroyweimethod( MiscData%weighting_method, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL DWM_Destroytidownstream( MiscData%TI_downstream_data, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL DWM_Destroyturbkaimal( MiscData%Turbulence_KS, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL DWM_Destroyshinozuka( MiscData%shinozuka_data, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL DWM_Destroysmooth_out_wake_data( MiscData%SmoothOut, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL DWM_Destroyswsv( MiscData%smooth_wake_shifted_velocity_data, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL DWM_Destroywake_deficit_data( MiscData%DWDD, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL DWM_Destroyturbine_blade( MiscData%DWM_tb, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL DWM_Destroywake_meandered_center( MiscData%WMC, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE DWM_DestroyMisc - - SUBROUTINE DWM_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(DWM_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 = 'DWM_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 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! IfW: size of buffers for each call to pack subtype - CALL InflowWind_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%IfW, ErrStat2, ErrMsg2, .TRUE. ) ! IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! IfW - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! IfW - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! IfW - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Re_BufSz = Re_BufSz + 1 ! position_y - Re_BufSz = Re_BufSz + 1 ! position_z - Re_BufSz = Re_BufSz + 1 ! velocity_wake_mean - Re_BufSz = Re_BufSz + 1 ! shifted_velocity_Aerodyn - Re_BufSz = Re_BufSz + 1 ! U_velocity - Re_BufSz = Re_BufSz + 1 ! V_velocity - Int_BufSz = Int_BufSz + 1 ! Nforce allocated yes/no - IF ( ALLOCATED(InData%Nforce) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Nforce upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Nforce) ! Nforce - END IF - Int_BufSz = Int_BufSz + 1 ! blade_dr allocated yes/no - IF ( ALLOCATED(InData%blade_dr) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! blade_dr upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%blade_dr) ! blade_dr - END IF - Re_BufSz = Re_BufSz + 1 ! NacYaw - Re_BufSz = Re_BufSz + 1 ! TI_original - Int_BufSz = Int_BufSz + 3 ! TAVD: size of buffers for each call to pack subtype - CALL DWM_Packturbine_average_velocity_data( Re_Buf, Db_Buf, Int_Buf, InData%TAVD, ErrStat2, ErrMsg2, .TRUE. ) ! TAVD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! TAVD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! TAVD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! TAVD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! CalVelScale_data: size of buffers for each call to pack subtype - CALL DWM_Packcvsd( Re_Buf, Db_Buf, Int_Buf, InData%CalVelScale_data, ErrStat2, ErrMsg2, .TRUE. ) ! CalVelScale_data - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! CalVelScale_data - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! CalVelScale_data - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! CalVelScale_data - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! meandering_data: size of buffers for each call to pack subtype - CALL DWM_Packmeanderdata( Re_Buf, Db_Buf, Int_Buf, InData%meandering_data, ErrStat2, ErrMsg2, .TRUE. ) ! meandering_data - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! meandering_data - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! meandering_data - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! meandering_data - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! weighting_method: size of buffers for each call to pack subtype - CALL DWM_Packweimethod( Re_Buf, Db_Buf, Int_Buf, InData%weighting_method, ErrStat2, ErrMsg2, .TRUE. ) ! weighting_method - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! weighting_method - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! weighting_method - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! weighting_method - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! TI_downstream_data: size of buffers for each call to pack subtype - CALL DWM_Packtidownstream( Re_Buf, Db_Buf, Int_Buf, InData%TI_downstream_data, ErrStat2, ErrMsg2, .TRUE. ) ! TI_downstream_data - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! TI_downstream_data - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! TI_downstream_data - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! TI_downstream_data - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! Turbulence_KS: size of buffers for each call to pack subtype - CALL DWM_Packturbkaimal( Re_Buf, Db_Buf, Int_Buf, InData%Turbulence_KS, ErrStat2, ErrMsg2, .TRUE. ) ! Turbulence_KS - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Turbulence_KS - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Turbulence_KS - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Turbulence_KS - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! shinozuka_data: size of buffers for each call to pack subtype - CALL DWM_Packshinozuka( Re_Buf, Db_Buf, Int_Buf, InData%shinozuka_data, ErrStat2, ErrMsg2, .TRUE. ) ! shinozuka_data - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! shinozuka_data - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! shinozuka_data - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! shinozuka_data - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! SmoothOut: size of buffers for each call to pack subtype - CALL DWM_Packsmooth_out_wake_data( Re_Buf, Db_Buf, Int_Buf, InData%SmoothOut, ErrStat2, ErrMsg2, .TRUE. ) ! SmoothOut - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SmoothOut - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SmoothOut - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SmoothOut - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! smooth_wake_shifted_velocity_data: size of buffers for each call to pack subtype - CALL DWM_Packswsv( Re_Buf, Db_Buf, Int_Buf, InData%smooth_wake_shifted_velocity_data, ErrStat2, ErrMsg2, .TRUE. ) ! smooth_wake_shifted_velocity_data - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! smooth_wake_shifted_velocity_data - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! smooth_wake_shifted_velocity_data - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! smooth_wake_shifted_velocity_data - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! DWDD: size of buffers for each call to pack subtype - CALL DWM_Packwake_deficit_data( Re_Buf, Db_Buf, Int_Buf, InData%DWDD, ErrStat2, ErrMsg2, .TRUE. ) ! DWDD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! DWDD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! DWDD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! DWDD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Re_BufSz = Re_BufSz + 1 ! ct_tilde - Re_BufSz = Re_BufSz + 1 ! FAST_Time - Int_BufSz = Int_BufSz + 1 ! SDtimestep - Int_BufSz = Int_BufSz + 3 ! DWM_tb: size of buffers for each call to pack subtype - CALL DWM_Packturbine_blade( Re_Buf, Db_Buf, Int_Buf, InData%DWM_tb, ErrStat2, ErrMsg2, .TRUE. ) ! DWM_tb - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! DWM_tb - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! DWM_tb - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! DWM_tb - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! WMC: size of buffers for each call to pack subtype - CALL DWM_Packwake_meandered_center( Re_Buf, Db_Buf, Int_Buf, InData%WMC, ErrStat2, ErrMsg2, .TRUE. ) ! WMC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! WMC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! WMC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! WMC - 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 InflowWind_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%IfW, ErrStat2, ErrMsg2, OnlySize ) ! IfW - 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 - ReKiBuf(Re_Xferred) = InData%position_y - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%position_z - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%velocity_wake_mean - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%shifted_velocity_Aerodyn - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%U_velocity - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%V_velocity - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%Nforce) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Nforce,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Nforce,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Nforce,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Nforce,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Nforce,2), UBOUND(InData%Nforce,2) - DO i1 = LBOUND(InData%Nforce,1), UBOUND(InData%Nforce,1) - ReKiBuf(Re_Xferred) = InData%Nforce(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%blade_dr) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%blade_dr,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%blade_dr,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%blade_dr,1), UBOUND(InData%blade_dr,1) - ReKiBuf(Re_Xferred) = InData%blade_dr(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%NacYaw - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TI_original - Re_Xferred = Re_Xferred + 1 - CALL DWM_Packturbine_average_velocity_data( Re_Buf, Db_Buf, Int_Buf, InData%TAVD, ErrStat2, ErrMsg2, OnlySize ) ! TAVD - 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 DWM_Packcvsd( Re_Buf, Db_Buf, Int_Buf, InData%CalVelScale_data, ErrStat2, ErrMsg2, OnlySize ) ! CalVelScale_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 - CALL DWM_Packmeanderdata( Re_Buf, Db_Buf, Int_Buf, InData%meandering_data, ErrStat2, ErrMsg2, OnlySize ) ! meandering_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 - CALL DWM_Packweimethod( Re_Buf, Db_Buf, Int_Buf, InData%weighting_method, ErrStat2, ErrMsg2, OnlySize ) ! weighting_method - 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 DWM_Packtidownstream( Re_Buf, Db_Buf, Int_Buf, InData%TI_downstream_data, ErrStat2, ErrMsg2, OnlySize ) ! TI_downstream_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 - CALL DWM_Packturbkaimal( Re_Buf, Db_Buf, Int_Buf, InData%Turbulence_KS, ErrStat2, ErrMsg2, OnlySize ) ! Turbulence_KS - 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 DWM_Packshinozuka( Re_Buf, Db_Buf, Int_Buf, InData%shinozuka_data, ErrStat2, ErrMsg2, OnlySize ) ! shinozuka_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 - CALL DWM_Packsmooth_out_wake_data( Re_Buf, Db_Buf, Int_Buf, InData%SmoothOut, ErrStat2, ErrMsg2, OnlySize ) ! SmoothOut - 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 DWM_Packswsv( Re_Buf, Db_Buf, Int_Buf, InData%smooth_wake_shifted_velocity_data, ErrStat2, ErrMsg2, OnlySize ) ! smooth_wake_shifted_velocity_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 - CALL DWM_Packwake_deficit_data( Re_Buf, Db_Buf, Int_Buf, InData%DWDD, ErrStat2, ErrMsg2, OnlySize ) ! DWDD - 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 - ReKiBuf(Re_Xferred) = InData%ct_tilde - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%FAST_Time - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%SDtimestep - Int_Xferred = Int_Xferred + 1 - CALL DWM_Packturbine_blade( Re_Buf, Db_Buf, Int_Buf, InData%DWM_tb, ErrStat2, ErrMsg2, OnlySize ) ! DWM_tb - 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 DWM_Packwake_meandered_center( Re_Buf, Db_Buf, Int_Buf, InData%WMC, ErrStat2, ErrMsg2, OnlySize ) ! WMC - 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 DWM_PackMisc - - SUBROUTINE DWM_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(DWM_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 = 'DWM_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 - 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 InflowWind_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%IfW, ErrStat2, ErrMsg2 ) ! IfW - 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%position_y = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%position_z = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%velocity_wake_mean = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%shifted_velocity_Aerodyn = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%U_velocity = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%V_velocity = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Nforce not allocated - Int_Xferred = Int_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%Nforce)) DEALLOCATE(OutData%Nforce) - ALLOCATE(OutData%Nforce(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Nforce.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Nforce,2), UBOUND(OutData%Nforce,2) - DO i1 = LBOUND(OutData%Nforce,1), UBOUND(OutData%Nforce,1) - OutData%Nforce(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! blade_dr not allocated - Int_Xferred = Int_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%blade_dr)) DEALLOCATE(OutData%blade_dr) - ALLOCATE(OutData%blade_dr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%blade_dr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%blade_dr,1), UBOUND(OutData%blade_dr,1) - OutData%blade_dr(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%NacYaw = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TI_original = ReKiBuf(Re_Xferred) - Re_Xferred = Re_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 DWM_Unpackturbine_average_velocity_data( Re_Buf, Db_Buf, Int_Buf, OutData%TAVD, ErrStat2, ErrMsg2 ) ! TAVD - 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 DWM_Unpackcvsd( Re_Buf, Db_Buf, Int_Buf, OutData%CalVelScale_data, ErrStat2, ErrMsg2 ) ! CalVelScale_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) - 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 DWM_Unpackmeanderdata( Re_Buf, Db_Buf, Int_Buf, OutData%meandering_data, ErrStat2, ErrMsg2 ) ! meandering_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) - 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 DWM_Unpackweimethod( Re_Buf, Db_Buf, Int_Buf, OutData%weighting_method, ErrStat2, ErrMsg2 ) ! weighting_method - 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 DWM_Unpacktidownstream( Re_Buf, Db_Buf, Int_Buf, OutData%TI_downstream_data, ErrStat2, ErrMsg2 ) ! TI_downstream_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) - 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 DWM_Unpackturbkaimal( Re_Buf, Db_Buf, Int_Buf, OutData%Turbulence_KS, ErrStat2, ErrMsg2 ) ! Turbulence_KS - 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 DWM_Unpackshinozuka( Re_Buf, Db_Buf, Int_Buf, OutData%shinozuka_data, ErrStat2, ErrMsg2 ) ! shinozuka_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) - 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 DWM_Unpacksmooth_out_wake_data( Re_Buf, Db_Buf, Int_Buf, OutData%SmoothOut, ErrStat2, ErrMsg2 ) ! SmoothOut - 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 DWM_Unpackswsv( Re_Buf, Db_Buf, Int_Buf, OutData%smooth_wake_shifted_velocity_data, ErrStat2, ErrMsg2 ) ! smooth_wake_shifted_velocity_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) - 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 DWM_Unpackwake_deficit_data( Re_Buf, Db_Buf, Int_Buf, OutData%DWDD, ErrStat2, ErrMsg2 ) ! DWDD - 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%ct_tilde = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%FAST_Time = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SDtimestep = IntKiBuf(Int_Xferred) - 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 DWM_Unpackturbine_blade( Re_Buf, Db_Buf, Int_Buf, OutData%DWM_tb, ErrStat2, ErrMsg2 ) ! DWM_tb - 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 DWM_Unpackwake_meandered_center( Re_Buf, Db_Buf, Int_Buf, OutData%WMC, ErrStat2, ErrMsg2 ) ! WMC - 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 DWM_UnPackMisc - - SUBROUTINE DWM_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(DWM_InputType), INTENT(IN) :: SrcInputData - TYPE(DWM_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 = 'DWM_CopyInput' -! - ErrStat = ErrID_None - ErrMsg = "" - CALL DWM_Copyread_upwind_result( SrcInputData%Upwind_result, DstInputData%Upwind_result, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL InflowWind_CopyInput( SrcInputData%IfW, DstInputData%IfW, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE DWM_CopyInput - - SUBROUTINE DWM_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(DWM_InputType), INTENT(INOUT) :: InputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_DestroyInput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL DWM_Destroyread_upwind_result( InputData%Upwind_result, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL InflowWind_DestroyInput( InputData%IfW, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE DWM_DestroyInput - - SUBROUTINE DWM_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(DWM_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 = 'DWM_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 ! Upwind_result: size of buffers for each call to pack subtype - CALL DWM_Packread_upwind_result( Re_Buf, Db_Buf, Int_Buf, InData%Upwind_result, ErrStat2, ErrMsg2, .TRUE. ) ! Upwind_result - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Upwind_result - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Upwind_result - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Upwind_result - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! IfW: size of buffers for each call to pack subtype - CALL InflowWind_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%IfW, ErrStat2, ErrMsg2, .TRUE. ) ! IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! IfW - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! IfW - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! IfW - 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 DWM_Packread_upwind_result( Re_Buf, Db_Buf, Int_Buf, InData%Upwind_result, ErrStat2, ErrMsg2, OnlySize ) ! Upwind_result - 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 InflowWind_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%IfW, ErrStat2, ErrMsg2, OnlySize ) ! IfW - 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 DWM_PackInput - - SUBROUTINE DWM_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(DWM_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 = 'DWM_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 DWM_Unpackread_upwind_result( Re_Buf, Db_Buf, Int_Buf, OutData%Upwind_result, ErrStat2, ErrMsg2 ) ! Upwind_result - 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 InflowWind_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%IfW, ErrStat2, ErrMsg2 ) ! IfW - 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 DWM_UnPackInput - - SUBROUTINE DWM_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(DWM_OutputType), INTENT(IN) :: SrcOutputData - TYPE(DWM_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) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_CopyOutput' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcOutputData%turbine_thrust_force)) THEN - i1_l = LBOUND(SrcOutputData%turbine_thrust_force,1) - i1_u = UBOUND(SrcOutputData%turbine_thrust_force,1) - IF (.NOT. ALLOCATED(DstOutputData%turbine_thrust_force)) THEN - ALLOCATE(DstOutputData%turbine_thrust_force(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%turbine_thrust_force.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%turbine_thrust_force = SrcOutputData%turbine_thrust_force -ENDIF -IF (ALLOCATED(SrcOutputData%induction_factor)) THEN - i1_l = LBOUND(SrcOutputData%induction_factor,1) - i1_u = UBOUND(SrcOutputData%induction_factor,1) - IF (.NOT. ALLOCATED(DstOutputData%induction_factor)) THEN - ALLOCATE(DstOutputData%induction_factor(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%induction_factor.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%induction_factor = SrcOutputData%induction_factor -ENDIF -IF (ALLOCATED(SrcOutputData%r_initial)) THEN - i1_l = LBOUND(SrcOutputData%r_initial,1) - i1_u = UBOUND(SrcOutputData%r_initial,1) - IF (.NOT. ALLOCATED(DstOutputData%r_initial)) THEN - ALLOCATE(DstOutputData%r_initial(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%r_initial.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%r_initial = SrcOutputData%r_initial -ENDIF -IF (ALLOCATED(SrcOutputData%U_initial)) THEN - i1_l = LBOUND(SrcOutputData%U_initial,1) - i1_u = UBOUND(SrcOutputData%U_initial,1) - IF (.NOT. ALLOCATED(DstOutputData%U_initial)) THEN - ALLOCATE(DstOutputData%U_initial(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%U_initial.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%U_initial = SrcOutputData%U_initial -ENDIF -IF (ALLOCATED(SrcOutputData%Mean_FFWS_array)) THEN - i1_l = LBOUND(SrcOutputData%Mean_FFWS_array,1) - i1_u = UBOUND(SrcOutputData%Mean_FFWS_array,1) - IF (.NOT. ALLOCATED(DstOutputData%Mean_FFWS_array)) THEN - ALLOCATE(DstOutputData%Mean_FFWS_array(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Mean_FFWS_array.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%Mean_FFWS_array = SrcOutputData%Mean_FFWS_array -ENDIF - DstOutputData%Mean_FFWS = SrcOutputData%Mean_FFWS - DstOutputData%TI = SrcOutputData%TI - DstOutputData%TI_downstream = SrcOutputData%TI_downstream -IF (ALLOCATED(SrcOutputData%wake_u)) THEN - i1_l = LBOUND(SrcOutputData%wake_u,1) - i1_u = UBOUND(SrcOutputData%wake_u,1) - i2_l = LBOUND(SrcOutputData%wake_u,2) - i2_u = UBOUND(SrcOutputData%wake_u,2) - IF (.NOT. ALLOCATED(DstOutputData%wake_u)) THEN - ALLOCATE(DstOutputData%wake_u(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%wake_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%wake_u = SrcOutputData%wake_u -ENDIF -IF (ALLOCATED(SrcOutputData%wake_position)) THEN - i1_l = LBOUND(SrcOutputData%wake_position,1) - i1_u = UBOUND(SrcOutputData%wake_position,1) - i2_l = LBOUND(SrcOutputData%wake_position,2) - i2_u = UBOUND(SrcOutputData%wake_position,2) - i3_l = LBOUND(SrcOutputData%wake_position,3) - i3_u = UBOUND(SrcOutputData%wake_position,3) - IF (.NOT. ALLOCATED(DstOutputData%wake_position)) THEN - ALLOCATE(DstOutputData%wake_position(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%wake_position.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%wake_position = SrcOutputData%wake_position -ENDIF -IF (ALLOCATED(SrcOutputData%smoothed_velocity_array)) THEN - i1_l = LBOUND(SrcOutputData%smoothed_velocity_array,1) - i1_u = UBOUND(SrcOutputData%smoothed_velocity_array,1) - i2_l = LBOUND(SrcOutputData%smoothed_velocity_array,2) - i2_u = UBOUND(SrcOutputData%smoothed_velocity_array,2) - IF (.NOT. ALLOCATED(DstOutputData%smoothed_velocity_array)) THEN - ALLOCATE(DstOutputData%smoothed_velocity_array(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%smoothed_velocity_array.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%smoothed_velocity_array = SrcOutputData%smoothed_velocity_array -ENDIF - DstOutputData%AtmUscale = SrcOutputData%AtmUscale - DstOutputData%du_dz_ABL = SrcOutputData%du_dz_ABL - DstOutputData%total_SDgenpwr = SrcOutputData%total_SDgenpwr - DstOutputData%mean_SDgenpwr = SrcOutputData%mean_SDgenpwr - DstOutputData%avg_ct = SrcOutputData%avg_ct - CALL InflowWind_CopyOutput( SrcOutputData%IfW, DstOutputData%IfW, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE DWM_CopyOutput - - SUBROUTINE DWM_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(DWM_OutputType), INTENT(INOUT) :: OutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_DestroyOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(OutputData%turbine_thrust_force)) THEN - DEALLOCATE(OutputData%turbine_thrust_force) -ENDIF -IF (ALLOCATED(OutputData%induction_factor)) THEN - DEALLOCATE(OutputData%induction_factor) -ENDIF -IF (ALLOCATED(OutputData%r_initial)) THEN - DEALLOCATE(OutputData%r_initial) -ENDIF -IF (ALLOCATED(OutputData%U_initial)) THEN - DEALLOCATE(OutputData%U_initial) -ENDIF -IF (ALLOCATED(OutputData%Mean_FFWS_array)) THEN - DEALLOCATE(OutputData%Mean_FFWS_array) -ENDIF -IF (ALLOCATED(OutputData%wake_u)) THEN - DEALLOCATE(OutputData%wake_u) -ENDIF -IF (ALLOCATED(OutputData%wake_position)) THEN - DEALLOCATE(OutputData%wake_position) -ENDIF -IF (ALLOCATED(OutputData%smoothed_velocity_array)) THEN - DEALLOCATE(OutputData%smoothed_velocity_array) -ENDIF - CALL InflowWind_DestroyOutput( OutputData%IfW, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE DWM_DestroyOutput - - SUBROUTINE DWM_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(DWM_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 = 'DWM_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 ! turbine_thrust_force allocated yes/no - IF ( ALLOCATED(InData%turbine_thrust_force) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! turbine_thrust_force upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%turbine_thrust_force) ! turbine_thrust_force - END IF - Int_BufSz = Int_BufSz + 1 ! induction_factor allocated yes/no - IF ( ALLOCATED(InData%induction_factor) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! induction_factor upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%induction_factor) ! induction_factor - END IF - Int_BufSz = Int_BufSz + 1 ! r_initial allocated yes/no - IF ( ALLOCATED(InData%r_initial) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! r_initial upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%r_initial) ! r_initial - END IF - Int_BufSz = Int_BufSz + 1 ! U_initial allocated yes/no - IF ( ALLOCATED(InData%U_initial) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! U_initial upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%U_initial) ! U_initial - END IF - Int_BufSz = Int_BufSz + 1 ! Mean_FFWS_array allocated yes/no - IF ( ALLOCATED(InData%Mean_FFWS_array) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Mean_FFWS_array upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Mean_FFWS_array) ! Mean_FFWS_array - END IF - Re_BufSz = Re_BufSz + 1 ! Mean_FFWS - Re_BufSz = Re_BufSz + 1 ! TI - Re_BufSz = Re_BufSz + 1 ! TI_downstream - Int_BufSz = Int_BufSz + 1 ! wake_u allocated yes/no - IF ( ALLOCATED(InData%wake_u) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! wake_u upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%wake_u) ! wake_u - END IF - Int_BufSz = Int_BufSz + 1 ! wake_position allocated yes/no - IF ( ALLOCATED(InData%wake_position) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! wake_position upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%wake_position) ! wake_position - END IF - Int_BufSz = Int_BufSz + 1 ! smoothed_velocity_array allocated yes/no - IF ( ALLOCATED(InData%smoothed_velocity_array) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! smoothed_velocity_array upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%smoothed_velocity_array) ! smoothed_velocity_array - END IF - Re_BufSz = Re_BufSz + 1 ! AtmUscale - Re_BufSz = Re_BufSz + 1 ! du_dz_ABL - Re_BufSz = Re_BufSz + 1 ! total_SDgenpwr - Re_BufSz = Re_BufSz + 1 ! mean_SDgenpwr - Re_BufSz = Re_BufSz + 1 ! avg_ct - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! IfW: size of buffers for each call to pack subtype - CALL InflowWind_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%IfW, ErrStat2, ErrMsg2, .TRUE. ) ! IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! IfW - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! IfW - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! IfW - 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%turbine_thrust_force) ) THEN - 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_thrust_force,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%turbine_thrust_force,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%turbine_thrust_force,1), UBOUND(InData%turbine_thrust_force,1) - ReKiBuf(Re_Xferred) = InData%turbine_thrust_force(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%induction_factor) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%induction_factor,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%induction_factor,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%induction_factor,1), UBOUND(InData%induction_factor,1) - ReKiBuf(Re_Xferred) = InData%induction_factor(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%r_initial) ) THEN - 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_initial,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%r_initial,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%r_initial,1), UBOUND(InData%r_initial,1) - ReKiBuf(Re_Xferred) = InData%r_initial(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%U_initial) ) THEN - 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_initial,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%U_initial,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%U_initial,1), UBOUND(InData%U_initial,1) - ReKiBuf(Re_Xferred) = InData%U_initial(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Mean_FFWS_array) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Mean_FFWS_array,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Mean_FFWS_array,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Mean_FFWS_array,1), UBOUND(InData%Mean_FFWS_array,1) - ReKiBuf(Re_Xferred) = InData%Mean_FFWS_array(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%Mean_FFWS - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TI - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TI_downstream - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%wake_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%wake_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%wake_u,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%wake_u,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%wake_u,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%wake_u,2), UBOUND(InData%wake_u,2) - DO i1 = LBOUND(InData%wake_u,1), UBOUND(InData%wake_u,1) - ReKiBuf(Re_Xferred) = InData%wake_u(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%wake_position) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%wake_position,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%wake_position,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%wake_position,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%wake_position,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%wake_position,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%wake_position,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%wake_position,3), UBOUND(InData%wake_position,3) - DO i2 = LBOUND(InData%wake_position,2), UBOUND(InData%wake_position,2) - DO i1 = LBOUND(InData%wake_position,1), UBOUND(InData%wake_position,1) - ReKiBuf(Re_Xferred) = InData%wake_position(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%smoothed_velocity_array) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%smoothed_velocity_array,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%smoothed_velocity_array,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%smoothed_velocity_array,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%smoothed_velocity_array,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%smoothed_velocity_array,2), UBOUND(InData%smoothed_velocity_array,2) - DO i1 = LBOUND(InData%smoothed_velocity_array,1), UBOUND(InData%smoothed_velocity_array,1) - ReKiBuf(Re_Xferred) = InData%smoothed_velocity_array(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - ReKiBuf(Re_Xferred) = InData%AtmUscale - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%du_dz_ABL - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%total_SDgenpwr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%mean_SDgenpwr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%avg_ct - Re_Xferred = Re_Xferred + 1 - CALL InflowWind_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%IfW, ErrStat2, ErrMsg2, OnlySize ) ! IfW - 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 DWM_PackOutput - - SUBROUTINE DWM_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(DWM_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) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_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 ! turbine_thrust_force not allocated - Int_Xferred = Int_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%turbine_thrust_force)) DEALLOCATE(OutData%turbine_thrust_force) - ALLOCATE(OutData%turbine_thrust_force(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%turbine_thrust_force.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%turbine_thrust_force,1), UBOUND(OutData%turbine_thrust_force,1) - OutData%turbine_thrust_force(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! induction_factor not allocated - Int_Xferred = Int_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%induction_factor)) DEALLOCATE(OutData%induction_factor) - ALLOCATE(OutData%induction_factor(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%induction_factor.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%induction_factor,1), UBOUND(OutData%induction_factor,1) - OutData%induction_factor(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! r_initial not allocated - Int_Xferred = Int_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_initial)) DEALLOCATE(OutData%r_initial) - ALLOCATE(OutData%r_initial(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%r_initial.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%r_initial,1), UBOUND(OutData%r_initial,1) - OutData%r_initial(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! U_initial not allocated - Int_Xferred = Int_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_initial)) DEALLOCATE(OutData%U_initial) - ALLOCATE(OutData%U_initial(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%U_initial.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%U_initial,1), UBOUND(OutData%U_initial,1) - OutData%U_initial(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Mean_FFWS_array not allocated - Int_Xferred = Int_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%Mean_FFWS_array)) DEALLOCATE(OutData%Mean_FFWS_array) - ALLOCATE(OutData%Mean_FFWS_array(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Mean_FFWS_array.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Mean_FFWS_array,1), UBOUND(OutData%Mean_FFWS_array,1) - OutData%Mean_FFWS_array(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%Mean_FFWS = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TI = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TI_downstream = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! wake_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 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%wake_u)) DEALLOCATE(OutData%wake_u) - ALLOCATE(OutData%wake_u(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%wake_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%wake_u,2), UBOUND(OutData%wake_u,2) - DO i1 = LBOUND(OutData%wake_u,1), UBOUND(OutData%wake_u,1) - OutData%wake_u(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! wake_position not allocated - Int_Xferred = Int_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%wake_position)) DEALLOCATE(OutData%wake_position) - ALLOCATE(OutData%wake_position(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%wake_position.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%wake_position,3), UBOUND(OutData%wake_position,3) - DO i2 = LBOUND(OutData%wake_position,2), UBOUND(OutData%wake_position,2) - DO i1 = LBOUND(OutData%wake_position,1), UBOUND(OutData%wake_position,1) - OutData%wake_position(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 ! smoothed_velocity_array not allocated - Int_Xferred = Int_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%smoothed_velocity_array)) DEALLOCATE(OutData%smoothed_velocity_array) - ALLOCATE(OutData%smoothed_velocity_array(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%smoothed_velocity_array.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%smoothed_velocity_array,2), UBOUND(OutData%smoothed_velocity_array,2) - DO i1 = LBOUND(OutData%smoothed_velocity_array,1), UBOUND(OutData%smoothed_velocity_array,1) - OutData%smoothed_velocity_array(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%AtmUscale = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%du_dz_ABL = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%total_SDgenpwr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%mean_SDgenpwr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%avg_ct = ReKiBuf(Re_Xferred) - Re_Xferred = Re_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 InflowWind_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%IfW, ErrStat2, ErrMsg2 ) ! IfW - 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 DWM_UnPackOutput - - SUBROUTINE DWM_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(DWM_ContinuousStateType), INTENT(IN) :: SrcContStateData - TYPE(DWM_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 = 'DWM_CopyContState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstContStateData%dummy = SrcContStateData%dummy - CALL InflowWind_CopyContState( SrcContStateData%IfW, DstContStateData%IfW, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE DWM_CopyContState - - SUBROUTINE DWM_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(DWM_ContinuousStateType), INTENT(INOUT) :: ContStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_DestroyContState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL InflowWind_DestroyContState( ContStateData%IfW, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE DWM_DestroyContState - - SUBROUTINE DWM_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(DWM_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 = 'DWM_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 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! IfW: size of buffers for each call to pack subtype - CALL InflowWind_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%IfW, ErrStat2, ErrMsg2, .TRUE. ) ! IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! IfW - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! IfW - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! IfW - 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 - - ReKiBuf(Re_Xferred) = InData%dummy - Re_Xferred = Re_Xferred + 1 - CALL InflowWind_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%IfW, ErrStat2, ErrMsg2, OnlySize ) ! IfW - 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 DWM_PackContState - - SUBROUTINE DWM_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(DWM_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 = 'DWM_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 - 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 InflowWind_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%IfW, ErrStat2, ErrMsg2 ) ! IfW - 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 DWM_UnPackContState - - SUBROUTINE DWM_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(DWM_DiscreteStateType), INTENT(IN) :: SrcDiscStateData - TYPE(DWM_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 = 'DWM_CopyDiscState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstDiscStateData%dummy = SrcDiscStateData%dummy - CALL InflowWind_CopyDiscState( SrcDiscStateData%IfW, DstDiscStateData%IfW, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE DWM_CopyDiscState - - SUBROUTINE DWM_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(DWM_DiscreteStateType), INTENT(INOUT) :: DiscStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_DestroyDiscState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL InflowWind_DestroyDiscState( DiscStateData%IfW, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE DWM_DestroyDiscState - - SUBROUTINE DWM_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(DWM_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 = 'DWM_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 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! IfW: size of buffers for each call to pack subtype - CALL InflowWind_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%IfW, ErrStat2, ErrMsg2, .TRUE. ) ! IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! IfW - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! IfW - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! IfW - 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 - - ReKiBuf(Re_Xferred) = InData%dummy - Re_Xferred = Re_Xferred + 1 - CALL InflowWind_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%IfW, ErrStat2, ErrMsg2, OnlySize ) ! IfW - 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 DWM_PackDiscState - - SUBROUTINE DWM_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(DWM_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 = 'DWM_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 - 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 InflowWind_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%IfW, ErrStat2, ErrMsg2 ) ! IfW - 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 DWM_UnPackDiscState - - SUBROUTINE DWM_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(DWM_ConstraintStateType), INTENT(IN) :: SrcConstrStateData - TYPE(DWM_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 = 'DWM_CopyConstrState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstConstrStateData%dummy = SrcConstrStateData%dummy - CALL InflowWind_CopyConstrState( SrcConstrStateData%IfW, DstConstrStateData%IfW, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE DWM_CopyConstrState - - SUBROUTINE DWM_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(DWM_ConstraintStateType), INTENT(INOUT) :: ConstrStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_DestroyConstrState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL InflowWind_DestroyConstrState( ConstrStateData%IfW, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE DWM_DestroyConstrState - - SUBROUTINE DWM_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(DWM_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 = 'DWM_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 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! IfW: size of buffers for each call to pack subtype - CALL InflowWind_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%IfW, ErrStat2, ErrMsg2, .TRUE. ) ! IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! IfW - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! IfW - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! IfW - 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 - - ReKiBuf(Re_Xferred) = InData%dummy - Re_Xferred = Re_Xferred + 1 - CALL InflowWind_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%IfW, ErrStat2, ErrMsg2, OnlySize ) ! IfW - 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 DWM_PackConstrState - - SUBROUTINE DWM_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(DWM_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 = 'DWM_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 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_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 InflowWind_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%IfW, ErrStat2, ErrMsg2 ) ! IfW - 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 DWM_UnPackConstrState - - SUBROUTINE DWM_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(DWM_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(DWM_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 = 'DWM_CopyInitInput' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInitInputData%dummy = SrcInitInputData%dummy - CALL InflowWind_CopyInitInput( SrcInitInputData%IfW, DstInitInputData%IfW, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE DWM_CopyInitInput - - SUBROUTINE DWM_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(DWM_InitInputType), INTENT(INOUT) :: InitInputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_DestroyInitInput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL InflowWind_DestroyInitInput( InitInputData%IfW, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE DWM_DestroyInitInput - - SUBROUTINE DWM_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(DWM_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 = 'DWM_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 - Re_BufSz = Re_BufSz + 1 ! dummy - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! IfW: size of buffers for each call to pack subtype - CALL InflowWind_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%IfW, ErrStat2, ErrMsg2, .TRUE. ) ! IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! IfW - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! IfW - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! IfW - 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 - - ReKiBuf(Re_Xferred) = InData%dummy - Re_Xferred = Re_Xferred + 1 - CALL InflowWind_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%IfW, ErrStat2, ErrMsg2, OnlySize ) ! IfW - 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 DWM_PackInitInput - - SUBROUTINE DWM_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(DWM_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 = 'DWM_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%dummy = ReKiBuf(Re_Xferred) - Re_Xferred = Re_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 InflowWind_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%IfW, ErrStat2, ErrMsg2 ) ! IfW - 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 DWM_UnPackInitInput - - SUBROUTINE DWM_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(DWM_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(DWM_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 = 'DWM_CopyInitOutput' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInitOutputData%dummy = SrcInitOutputData%dummy - CALL InflowWind_CopyInitOutput( SrcInitOutputData%IfW, DstInitOutputData%IfW, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE DWM_CopyInitOutput - - SUBROUTINE DWM_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(DWM_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_DestroyInitOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL InflowWind_DestroyInitOutput( InitOutputData%IfW, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE DWM_DestroyInitOutput - - SUBROUTINE DWM_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(DWM_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 = 'DWM_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 ! dummy - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! IfW: size of buffers for each call to pack subtype - CALL InflowWind_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%IfW, ErrStat2, ErrMsg2, .TRUE. ) ! IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! IfW - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! IfW - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! IfW - 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 - - ReKiBuf(Re_Xferred) = InData%dummy - Re_Xferred = Re_Xferred + 1 - CALL InflowWind_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%IfW, ErrStat2, ErrMsg2, OnlySize ) ! IfW - 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 DWM_PackInitOutput - - SUBROUTINE DWM_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(DWM_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 = 'DWM_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%dummy = ReKiBuf(Re_Xferred) - Re_Xferred = Re_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 InflowWind_UnpackInitOutput( Re_Buf, Db_Buf, Int_Buf, OutData%IfW, ErrStat2, ErrMsg2 ) ! IfW - 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 DWM_UnPackInitOutput - - - SUBROUTINE DWM_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(DWM_InputType), INTENT(IN) :: u(:) ! Input at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Inputs - TYPE(DWM_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 = 'DWM_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 DWM_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL DWM_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 DWM_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 DWM_Input_ExtrapInterp - - - SUBROUTINE DWM_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(DWM_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 - TYPE(DWM_InputType), INTENT(IN) :: u2 ! Input at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs - TYPE(DWM_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 = 'DWM_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 :: i02 ! dim2 level 0 counter variable for arrays of ddts - INTEGER :: i03 ! dim3 level 0 counter variable for arrays of ddts - INTEGER :: i04 ! dim4 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - INTEGER :: i2 ! dim2 counter variable for arrays - INTEGER :: i3 ! dim3 counter variable for arrays - INTEGER :: i4 ! dim4 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%Upwind_result%upwind_U) .AND. ALLOCATED(u1%Upwind_result%upwind_U)) THEN - DO i2 = LBOUND(u_out%Upwind_result%upwind_U,2),UBOUND(u_out%Upwind_result%upwind_U,2) - DO i1 = LBOUND(u_out%Upwind_result%upwind_U,1),UBOUND(u_out%Upwind_result%upwind_U,1) - b = -(u1%Upwind_result%upwind_U(i1,i2) - u2%Upwind_result%upwind_U(i1,i2)) - u_out%Upwind_result%upwind_U(i1,i2) = u1%Upwind_result%upwind_U(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%Upwind_result%upwind_wakecenter) .AND. ALLOCATED(u1%Upwind_result%upwind_wakecenter)) THEN - DO i4 = LBOUND(u_out%Upwind_result%upwind_wakecenter,4),UBOUND(u_out%Upwind_result%upwind_wakecenter,4) - DO i3 = LBOUND(u_out%Upwind_result%upwind_wakecenter,3),UBOUND(u_out%Upwind_result%upwind_wakecenter,3) - DO i2 = LBOUND(u_out%Upwind_result%upwind_wakecenter,2),UBOUND(u_out%Upwind_result%upwind_wakecenter,2) - DO i1 = LBOUND(u_out%Upwind_result%upwind_wakecenter,1),UBOUND(u_out%Upwind_result%upwind_wakecenter,1) - b = -(u1%Upwind_result%upwind_wakecenter(i1,i2,i3,i4) - u2%Upwind_result%upwind_wakecenter(i1,i2,i3,i4)) - u_out%Upwind_result%upwind_wakecenter(i1,i2,i3,i4) = u1%Upwind_result%upwind_wakecenter(i1,i2,i3,i4) + b * ScaleFactor - END DO - END DO - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%Upwind_result%upwind_meanU) .AND. ALLOCATED(u1%Upwind_result%upwind_meanU)) THEN - DO i1 = LBOUND(u_out%Upwind_result%upwind_meanU,1),UBOUND(u_out%Upwind_result%upwind_meanU,1) - b = -(u1%Upwind_result%upwind_meanU(i1) - u2%Upwind_result%upwind_meanU(i1)) - u_out%Upwind_result%upwind_meanU(i1) = u1%Upwind_result%upwind_meanU(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%Upwind_result%upwind_TI) .AND. ALLOCATED(u1%Upwind_result%upwind_TI)) THEN - DO i1 = LBOUND(u_out%Upwind_result%upwind_TI,1),UBOUND(u_out%Upwind_result%upwind_TI,1) - b = -(u1%Upwind_result%upwind_TI(i1) - u2%Upwind_result%upwind_TI(i1)) - u_out%Upwind_result%upwind_TI(i1) = u1%Upwind_result%upwind_TI(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%Upwind_result%upwind_small_TI) .AND. ALLOCATED(u1%Upwind_result%upwind_small_TI)) THEN - DO i1 = LBOUND(u_out%Upwind_result%upwind_small_TI,1),UBOUND(u_out%Upwind_result%upwind_small_TI,1) - b = -(u1%Upwind_result%upwind_small_TI(i1) - u2%Upwind_result%upwind_small_TI(i1)) - u_out%Upwind_result%upwind_small_TI(i1) = u1%Upwind_result%upwind_small_TI(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%Upwind_result%upwind_smoothWake) .AND. ALLOCATED(u1%Upwind_result%upwind_smoothWake)) THEN - DO i2 = LBOUND(u_out%Upwind_result%upwind_smoothWake,2),UBOUND(u_out%Upwind_result%upwind_smoothWake,2) - DO i1 = LBOUND(u_out%Upwind_result%upwind_smoothWake,1),UBOUND(u_out%Upwind_result%upwind_smoothWake,1) - b = -(u1%Upwind_result%upwind_smoothWake(i1,i2) - u2%Upwind_result%upwind_smoothWake(i1,i2)) - u_out%Upwind_result%upwind_smoothWake(i1,i2) = u1%Upwind_result%upwind_smoothWake(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%Upwind_result%velocity_aerodyn) .AND. ALLOCATED(u1%Upwind_result%velocity_aerodyn)) THEN - DO i1 = LBOUND(u_out%Upwind_result%velocity_aerodyn,1),UBOUND(u_out%Upwind_result%velocity_aerodyn,1) - b = -(u1%Upwind_result%velocity_aerodyn(i1) - u2%Upwind_result%velocity_aerodyn(i1)) - u_out%Upwind_result%velocity_aerodyn(i1) = u1%Upwind_result%velocity_aerodyn(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%Upwind_result%TI_downstream) .AND. ALLOCATED(u1%Upwind_result%TI_downstream)) THEN - DO i1 = LBOUND(u_out%Upwind_result%TI_downstream,1),UBOUND(u_out%Upwind_result%TI_downstream,1) - b = -(u1%Upwind_result%TI_downstream(i1) - u2%Upwind_result%TI_downstream(i1)) - u_out%Upwind_result%TI_downstream(i1) = u1%Upwind_result%TI_downstream(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%Upwind_result%small_scale_TI_downstream) .AND. ALLOCATED(u1%Upwind_result%small_scale_TI_downstream)) THEN - DO i1 = LBOUND(u_out%Upwind_result%small_scale_TI_downstream,1),UBOUND(u_out%Upwind_result%small_scale_TI_downstream,1) - b = -(u1%Upwind_result%small_scale_TI_downstream(i1) - u2%Upwind_result%small_scale_TI_downstream(i1)) - u_out%Upwind_result%small_scale_TI_downstream(i1) = u1%Upwind_result%small_scale_TI_downstream(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%Upwind_result%smoothed_velocity_array) .AND. ALLOCATED(u1%Upwind_result%smoothed_velocity_array)) THEN - DO i2 = LBOUND(u_out%Upwind_result%smoothed_velocity_array,2),UBOUND(u_out%Upwind_result%smoothed_velocity_array,2) - DO i1 = LBOUND(u_out%Upwind_result%smoothed_velocity_array,1),UBOUND(u_out%Upwind_result%smoothed_velocity_array,1) - b = -(u1%Upwind_result%smoothed_velocity_array(i1,i2) - u2%Upwind_result%smoothed_velocity_array(i1,i2)) - u_out%Upwind_result%smoothed_velocity_array(i1,i2) = u1%Upwind_result%smoothed_velocity_array(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%Upwind_result%vel_matrix) .AND. ALLOCATED(u1%Upwind_result%vel_matrix)) THEN - DO i3 = LBOUND(u_out%Upwind_result%vel_matrix,3),UBOUND(u_out%Upwind_result%vel_matrix,3) - DO i2 = LBOUND(u_out%Upwind_result%vel_matrix,2),UBOUND(u_out%Upwind_result%vel_matrix,2) - DO i1 = LBOUND(u_out%Upwind_result%vel_matrix,1),UBOUND(u_out%Upwind_result%vel_matrix,1) - b = -(u1%Upwind_result%vel_matrix(i1,i2,i3) - u2%Upwind_result%vel_matrix(i1,i2,i3)) - u_out%Upwind_result%vel_matrix(i1,i2,i3) = u1%Upwind_result%vel_matrix(i1,i2,i3) + b * ScaleFactor - END DO - END DO - END DO -END IF ! check if allocated - CALL InflowWind_Input_ExtrapInterp1( u1%IfW, u2%IfW, tin, u_out%IfW, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - END SUBROUTINE DWM_Input_ExtrapInterp1 - - - SUBROUTINE DWM_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(DWM_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 > t3 - TYPE(DWM_InputType), INTENT(IN) :: u2 ! Input at t2 > t3 - TYPE(DWM_InputType), INTENT(IN) :: u3 ! Input at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs - TYPE(DWM_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 = 'DWM_Input_ExtrapInterp2' - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts - INTEGER :: i03 ! dim3 level 0 counter variable for arrays of ddts - INTEGER :: i04 ! dim4 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - INTEGER :: i2 ! dim2 counter variable for arrays - INTEGER :: i3 ! dim3 counter variable for arrays - INTEGER :: i4 ! dim4 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%Upwind_result%upwind_U) .AND. ALLOCATED(u1%Upwind_result%upwind_U)) THEN - DO i2 = LBOUND(u_out%Upwind_result%upwind_U,2),UBOUND(u_out%Upwind_result%upwind_U,2) - DO i1 = LBOUND(u_out%Upwind_result%upwind_U,1),UBOUND(u_out%Upwind_result%upwind_U,1) - b = (t(3)**2*(u1%Upwind_result%upwind_U(i1,i2) - u2%Upwind_result%upwind_U(i1,i2)) + t(2)**2*(-u1%Upwind_result%upwind_U(i1,i2) + u3%Upwind_result%upwind_U(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*u1%Upwind_result%upwind_U(i1,i2) + t(3)*u2%Upwind_result%upwind_U(i1,i2) - t(2)*u3%Upwind_result%upwind_U(i1,i2) ) * scaleFactor - u_out%Upwind_result%upwind_U(i1,i2) = u1%Upwind_result%upwind_U(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%Upwind_result%upwind_wakecenter) .AND. ALLOCATED(u1%Upwind_result%upwind_wakecenter)) THEN - DO i4 = LBOUND(u_out%Upwind_result%upwind_wakecenter,4),UBOUND(u_out%Upwind_result%upwind_wakecenter,4) - DO i3 = LBOUND(u_out%Upwind_result%upwind_wakecenter,3),UBOUND(u_out%Upwind_result%upwind_wakecenter,3) - DO i2 = LBOUND(u_out%Upwind_result%upwind_wakecenter,2),UBOUND(u_out%Upwind_result%upwind_wakecenter,2) - DO i1 = LBOUND(u_out%Upwind_result%upwind_wakecenter,1),UBOUND(u_out%Upwind_result%upwind_wakecenter,1) - b = (t(3)**2*(u1%Upwind_result%upwind_wakecenter(i1,i2,i3,i4) - u2%Upwind_result%upwind_wakecenter(i1,i2,i3,i4)) + t(2)**2*(-u1%Upwind_result%upwind_wakecenter(i1,i2,i3,i4) + u3%Upwind_result%upwind_wakecenter(i1,i2,i3,i4)))* scaleFactor - c = ( (t(2)-t(3))*u1%Upwind_result%upwind_wakecenter(i1,i2,i3,i4) + t(3)*u2%Upwind_result%upwind_wakecenter(i1,i2,i3,i4) - t(2)*u3%Upwind_result%upwind_wakecenter(i1,i2,i3,i4) ) * scaleFactor - u_out%Upwind_result%upwind_wakecenter(i1,i2,i3,i4) = u1%Upwind_result%upwind_wakecenter(i1,i2,i3,i4) + b + c * t_out - END DO - END DO - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%Upwind_result%upwind_meanU) .AND. ALLOCATED(u1%Upwind_result%upwind_meanU)) THEN - DO i1 = LBOUND(u_out%Upwind_result%upwind_meanU,1),UBOUND(u_out%Upwind_result%upwind_meanU,1) - b = (t(3)**2*(u1%Upwind_result%upwind_meanU(i1) - u2%Upwind_result%upwind_meanU(i1)) + t(2)**2*(-u1%Upwind_result%upwind_meanU(i1) + u3%Upwind_result%upwind_meanU(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%Upwind_result%upwind_meanU(i1) + t(3)*u2%Upwind_result%upwind_meanU(i1) - t(2)*u3%Upwind_result%upwind_meanU(i1) ) * scaleFactor - u_out%Upwind_result%upwind_meanU(i1) = u1%Upwind_result%upwind_meanU(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%Upwind_result%upwind_TI) .AND. ALLOCATED(u1%Upwind_result%upwind_TI)) THEN - DO i1 = LBOUND(u_out%Upwind_result%upwind_TI,1),UBOUND(u_out%Upwind_result%upwind_TI,1) - b = (t(3)**2*(u1%Upwind_result%upwind_TI(i1) - u2%Upwind_result%upwind_TI(i1)) + t(2)**2*(-u1%Upwind_result%upwind_TI(i1) + u3%Upwind_result%upwind_TI(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%Upwind_result%upwind_TI(i1) + t(3)*u2%Upwind_result%upwind_TI(i1) - t(2)*u3%Upwind_result%upwind_TI(i1) ) * scaleFactor - u_out%Upwind_result%upwind_TI(i1) = u1%Upwind_result%upwind_TI(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%Upwind_result%upwind_small_TI) .AND. ALLOCATED(u1%Upwind_result%upwind_small_TI)) THEN - DO i1 = LBOUND(u_out%Upwind_result%upwind_small_TI,1),UBOUND(u_out%Upwind_result%upwind_small_TI,1) - b = (t(3)**2*(u1%Upwind_result%upwind_small_TI(i1) - u2%Upwind_result%upwind_small_TI(i1)) + t(2)**2*(-u1%Upwind_result%upwind_small_TI(i1) + u3%Upwind_result%upwind_small_TI(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%Upwind_result%upwind_small_TI(i1) + t(3)*u2%Upwind_result%upwind_small_TI(i1) - t(2)*u3%Upwind_result%upwind_small_TI(i1) ) * scaleFactor - u_out%Upwind_result%upwind_small_TI(i1) = u1%Upwind_result%upwind_small_TI(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%Upwind_result%upwind_smoothWake) .AND. ALLOCATED(u1%Upwind_result%upwind_smoothWake)) THEN - DO i2 = LBOUND(u_out%Upwind_result%upwind_smoothWake,2),UBOUND(u_out%Upwind_result%upwind_smoothWake,2) - DO i1 = LBOUND(u_out%Upwind_result%upwind_smoothWake,1),UBOUND(u_out%Upwind_result%upwind_smoothWake,1) - b = (t(3)**2*(u1%Upwind_result%upwind_smoothWake(i1,i2) - u2%Upwind_result%upwind_smoothWake(i1,i2)) + t(2)**2*(-u1%Upwind_result%upwind_smoothWake(i1,i2) + u3%Upwind_result%upwind_smoothWake(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*u1%Upwind_result%upwind_smoothWake(i1,i2) + t(3)*u2%Upwind_result%upwind_smoothWake(i1,i2) - t(2)*u3%Upwind_result%upwind_smoothWake(i1,i2) ) * scaleFactor - u_out%Upwind_result%upwind_smoothWake(i1,i2) = u1%Upwind_result%upwind_smoothWake(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%Upwind_result%velocity_aerodyn) .AND. ALLOCATED(u1%Upwind_result%velocity_aerodyn)) THEN - DO i1 = LBOUND(u_out%Upwind_result%velocity_aerodyn,1),UBOUND(u_out%Upwind_result%velocity_aerodyn,1) - b = (t(3)**2*(u1%Upwind_result%velocity_aerodyn(i1) - u2%Upwind_result%velocity_aerodyn(i1)) + t(2)**2*(-u1%Upwind_result%velocity_aerodyn(i1) + u3%Upwind_result%velocity_aerodyn(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%Upwind_result%velocity_aerodyn(i1) + t(3)*u2%Upwind_result%velocity_aerodyn(i1) - t(2)*u3%Upwind_result%velocity_aerodyn(i1) ) * scaleFactor - u_out%Upwind_result%velocity_aerodyn(i1) = u1%Upwind_result%velocity_aerodyn(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%Upwind_result%TI_downstream) .AND. ALLOCATED(u1%Upwind_result%TI_downstream)) THEN - DO i1 = LBOUND(u_out%Upwind_result%TI_downstream,1),UBOUND(u_out%Upwind_result%TI_downstream,1) - b = (t(3)**2*(u1%Upwind_result%TI_downstream(i1) - u2%Upwind_result%TI_downstream(i1)) + t(2)**2*(-u1%Upwind_result%TI_downstream(i1) + u3%Upwind_result%TI_downstream(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%Upwind_result%TI_downstream(i1) + t(3)*u2%Upwind_result%TI_downstream(i1) - t(2)*u3%Upwind_result%TI_downstream(i1) ) * scaleFactor - u_out%Upwind_result%TI_downstream(i1) = u1%Upwind_result%TI_downstream(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%Upwind_result%small_scale_TI_downstream) .AND. ALLOCATED(u1%Upwind_result%small_scale_TI_downstream)) THEN - DO i1 = LBOUND(u_out%Upwind_result%small_scale_TI_downstream,1),UBOUND(u_out%Upwind_result%small_scale_TI_downstream,1) - b = (t(3)**2*(u1%Upwind_result%small_scale_TI_downstream(i1) - u2%Upwind_result%small_scale_TI_downstream(i1)) + t(2)**2*(-u1%Upwind_result%small_scale_TI_downstream(i1) + u3%Upwind_result%small_scale_TI_downstream(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%Upwind_result%small_scale_TI_downstream(i1) + t(3)*u2%Upwind_result%small_scale_TI_downstream(i1) - t(2)*u3%Upwind_result%small_scale_TI_downstream(i1) ) * scaleFactor - u_out%Upwind_result%small_scale_TI_downstream(i1) = u1%Upwind_result%small_scale_TI_downstream(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%Upwind_result%smoothed_velocity_array) .AND. ALLOCATED(u1%Upwind_result%smoothed_velocity_array)) THEN - DO i2 = LBOUND(u_out%Upwind_result%smoothed_velocity_array,2),UBOUND(u_out%Upwind_result%smoothed_velocity_array,2) - DO i1 = LBOUND(u_out%Upwind_result%smoothed_velocity_array,1),UBOUND(u_out%Upwind_result%smoothed_velocity_array,1) - b = (t(3)**2*(u1%Upwind_result%smoothed_velocity_array(i1,i2) - u2%Upwind_result%smoothed_velocity_array(i1,i2)) + t(2)**2*(-u1%Upwind_result%smoothed_velocity_array(i1,i2) + u3%Upwind_result%smoothed_velocity_array(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*u1%Upwind_result%smoothed_velocity_array(i1,i2) + t(3)*u2%Upwind_result%smoothed_velocity_array(i1,i2) - t(2)*u3%Upwind_result%smoothed_velocity_array(i1,i2) ) * scaleFactor - u_out%Upwind_result%smoothed_velocity_array(i1,i2) = u1%Upwind_result%smoothed_velocity_array(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%Upwind_result%vel_matrix) .AND. ALLOCATED(u1%Upwind_result%vel_matrix)) THEN - DO i3 = LBOUND(u_out%Upwind_result%vel_matrix,3),UBOUND(u_out%Upwind_result%vel_matrix,3) - DO i2 = LBOUND(u_out%Upwind_result%vel_matrix,2),UBOUND(u_out%Upwind_result%vel_matrix,2) - DO i1 = LBOUND(u_out%Upwind_result%vel_matrix,1),UBOUND(u_out%Upwind_result%vel_matrix,1) - b = (t(3)**2*(u1%Upwind_result%vel_matrix(i1,i2,i3) - u2%Upwind_result%vel_matrix(i1,i2,i3)) + t(2)**2*(-u1%Upwind_result%vel_matrix(i1,i2,i3) + u3%Upwind_result%vel_matrix(i1,i2,i3)))* scaleFactor - c = ( (t(2)-t(3))*u1%Upwind_result%vel_matrix(i1,i2,i3) + t(3)*u2%Upwind_result%vel_matrix(i1,i2,i3) - t(2)*u3%Upwind_result%vel_matrix(i1,i2,i3) ) * scaleFactor - u_out%Upwind_result%vel_matrix(i1,i2,i3) = u1%Upwind_result%vel_matrix(i1,i2,i3) + b + c * t_out - END DO - END DO - END DO -END IF ! check if allocated - CALL InflowWind_Input_ExtrapInterp2( u1%IfW, u2%IfW, u3%IfW, tin, u_out%IfW, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - END SUBROUTINE DWM_Input_ExtrapInterp2 - - - SUBROUTINE DWM_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(DWM_OutputType), INTENT(IN) :: y(:) ! Output at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Outputs - TYPE(DWM_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 = 'DWM_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 DWM_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL DWM_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 DWM_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 DWM_Output_ExtrapInterp - - - SUBROUTINE DWM_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(DWM_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 - TYPE(DWM_OutputType), INTENT(IN) :: y2 ! Output at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs - TYPE(DWM_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 = 'DWM_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 :: i02 ! dim2 level 0 counter variable for arrays of ddts - INTEGER :: i03 ! dim3 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - INTEGER :: i2 ! dim2 counter variable for arrays - INTEGER :: i3 ! dim3 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%turbine_thrust_force) .AND. ALLOCATED(y1%turbine_thrust_force)) THEN - DO i1 = LBOUND(y_out%turbine_thrust_force,1),UBOUND(y_out%turbine_thrust_force,1) - b = -(y1%turbine_thrust_force(i1) - y2%turbine_thrust_force(i1)) - y_out%turbine_thrust_force(i1) = y1%turbine_thrust_force(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%induction_factor) .AND. ALLOCATED(y1%induction_factor)) THEN - DO i1 = LBOUND(y_out%induction_factor,1),UBOUND(y_out%induction_factor,1) - b = -(y1%induction_factor(i1) - y2%induction_factor(i1)) - y_out%induction_factor(i1) = y1%induction_factor(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%r_initial) .AND. ALLOCATED(y1%r_initial)) THEN - DO i1 = LBOUND(y_out%r_initial,1),UBOUND(y_out%r_initial,1) - b = -(y1%r_initial(i1) - y2%r_initial(i1)) - y_out%r_initial(i1) = y1%r_initial(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%U_initial) .AND. ALLOCATED(y1%U_initial)) THEN - DO i1 = LBOUND(y_out%U_initial,1),UBOUND(y_out%U_initial,1) - b = -(y1%U_initial(i1) - y2%U_initial(i1)) - y_out%U_initial(i1) = y1%U_initial(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%Mean_FFWS_array) .AND. ALLOCATED(y1%Mean_FFWS_array)) THEN - DO i1 = LBOUND(y_out%Mean_FFWS_array,1),UBOUND(y_out%Mean_FFWS_array,1) - b = -(y1%Mean_FFWS_array(i1) - y2%Mean_FFWS_array(i1)) - y_out%Mean_FFWS_array(i1) = y1%Mean_FFWS_array(i1) + b * ScaleFactor - END DO -END IF ! check if allocated - b = -(y1%Mean_FFWS - y2%Mean_FFWS) - y_out%Mean_FFWS = y1%Mean_FFWS + b * ScaleFactor - b = -(y1%TI - y2%TI) - y_out%TI = y1%TI + b * ScaleFactor - b = -(y1%TI_downstream - y2%TI_downstream) - y_out%TI_downstream = y1%TI_downstream + b * ScaleFactor -IF (ALLOCATED(y_out%wake_u) .AND. ALLOCATED(y1%wake_u)) THEN - DO i2 = LBOUND(y_out%wake_u,2),UBOUND(y_out%wake_u,2) - DO i1 = LBOUND(y_out%wake_u,1),UBOUND(y_out%wake_u,1) - b = -(y1%wake_u(i1,i2) - y2%wake_u(i1,i2)) - y_out%wake_u(i1,i2) = y1%wake_u(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%wake_position) .AND. ALLOCATED(y1%wake_position)) THEN - DO i3 = LBOUND(y_out%wake_position,3),UBOUND(y_out%wake_position,3) - DO i2 = LBOUND(y_out%wake_position,2),UBOUND(y_out%wake_position,2) - DO i1 = LBOUND(y_out%wake_position,1),UBOUND(y_out%wake_position,1) - b = -(y1%wake_position(i1,i2,i3) - y2%wake_position(i1,i2,i3)) - y_out%wake_position(i1,i2,i3) = y1%wake_position(i1,i2,i3) + b * ScaleFactor - END DO - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%smoothed_velocity_array) .AND. ALLOCATED(y1%smoothed_velocity_array)) THEN - DO i2 = LBOUND(y_out%smoothed_velocity_array,2),UBOUND(y_out%smoothed_velocity_array,2) - DO i1 = LBOUND(y_out%smoothed_velocity_array,1),UBOUND(y_out%smoothed_velocity_array,1) - b = -(y1%smoothed_velocity_array(i1,i2) - y2%smoothed_velocity_array(i1,i2)) - y_out%smoothed_velocity_array(i1,i2) = y1%smoothed_velocity_array(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated - b = -(y1%AtmUscale - y2%AtmUscale) - y_out%AtmUscale = y1%AtmUscale + b * ScaleFactor - b = -(y1%du_dz_ABL - y2%du_dz_ABL) - y_out%du_dz_ABL = y1%du_dz_ABL + b * ScaleFactor - b = -(y1%total_SDgenpwr - y2%total_SDgenpwr) - y_out%total_SDgenpwr = y1%total_SDgenpwr + b * ScaleFactor - b = -(y1%mean_SDgenpwr - y2%mean_SDgenpwr) - y_out%mean_SDgenpwr = y1%mean_SDgenpwr + b * ScaleFactor - b = -(y1%avg_ct - y2%avg_ct) - y_out%avg_ct = y1%avg_ct + b * ScaleFactor - CALL InflowWind_Output_ExtrapInterp1( y1%IfW, y2%IfW, tin, y_out%IfW, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - END SUBROUTINE DWM_Output_ExtrapInterp1 - - - SUBROUTINE DWM_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(DWM_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 > t3 - TYPE(DWM_OutputType), INTENT(IN) :: y2 ! Output at t2 > t3 - TYPE(DWM_OutputType), INTENT(IN) :: y3 ! Output at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs - TYPE(DWM_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 = 'DWM_Output_ExtrapInterp2' - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts - INTEGER :: i03 ! dim3 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - INTEGER :: i2 ! dim2 counter variable for arrays - INTEGER :: i3 ! dim3 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%turbine_thrust_force) .AND. ALLOCATED(y1%turbine_thrust_force)) THEN - DO i1 = LBOUND(y_out%turbine_thrust_force,1),UBOUND(y_out%turbine_thrust_force,1) - b = (t(3)**2*(y1%turbine_thrust_force(i1) - y2%turbine_thrust_force(i1)) + t(2)**2*(-y1%turbine_thrust_force(i1) + y3%turbine_thrust_force(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%turbine_thrust_force(i1) + t(3)*y2%turbine_thrust_force(i1) - t(2)*y3%turbine_thrust_force(i1) ) * scaleFactor - y_out%turbine_thrust_force(i1) = y1%turbine_thrust_force(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%induction_factor) .AND. ALLOCATED(y1%induction_factor)) THEN - DO i1 = LBOUND(y_out%induction_factor,1),UBOUND(y_out%induction_factor,1) - b = (t(3)**2*(y1%induction_factor(i1) - y2%induction_factor(i1)) + t(2)**2*(-y1%induction_factor(i1) + y3%induction_factor(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%induction_factor(i1) + t(3)*y2%induction_factor(i1) - t(2)*y3%induction_factor(i1) ) * scaleFactor - y_out%induction_factor(i1) = y1%induction_factor(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%r_initial) .AND. ALLOCATED(y1%r_initial)) THEN - DO i1 = LBOUND(y_out%r_initial,1),UBOUND(y_out%r_initial,1) - b = (t(3)**2*(y1%r_initial(i1) - y2%r_initial(i1)) + t(2)**2*(-y1%r_initial(i1) + y3%r_initial(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%r_initial(i1) + t(3)*y2%r_initial(i1) - t(2)*y3%r_initial(i1) ) * scaleFactor - y_out%r_initial(i1) = y1%r_initial(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%U_initial) .AND. ALLOCATED(y1%U_initial)) THEN - DO i1 = LBOUND(y_out%U_initial,1),UBOUND(y_out%U_initial,1) - b = (t(3)**2*(y1%U_initial(i1) - y2%U_initial(i1)) + t(2)**2*(-y1%U_initial(i1) + y3%U_initial(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%U_initial(i1) + t(3)*y2%U_initial(i1) - t(2)*y3%U_initial(i1) ) * scaleFactor - y_out%U_initial(i1) = y1%U_initial(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%Mean_FFWS_array) .AND. ALLOCATED(y1%Mean_FFWS_array)) THEN - DO i1 = LBOUND(y_out%Mean_FFWS_array,1),UBOUND(y_out%Mean_FFWS_array,1) - b = (t(3)**2*(y1%Mean_FFWS_array(i1) - y2%Mean_FFWS_array(i1)) + t(2)**2*(-y1%Mean_FFWS_array(i1) + y3%Mean_FFWS_array(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%Mean_FFWS_array(i1) + t(3)*y2%Mean_FFWS_array(i1) - t(2)*y3%Mean_FFWS_array(i1) ) * scaleFactor - y_out%Mean_FFWS_array(i1) = y1%Mean_FFWS_array(i1) + b + c * t_out - END DO -END IF ! check if allocated - b = (t(3)**2*(y1%Mean_FFWS - y2%Mean_FFWS) + t(2)**2*(-y1%Mean_FFWS + y3%Mean_FFWS))* scaleFactor - c = ( (t(2)-t(3))*y1%Mean_FFWS + t(3)*y2%Mean_FFWS - t(2)*y3%Mean_FFWS ) * scaleFactor - y_out%Mean_FFWS = y1%Mean_FFWS + b + c * t_out - b = (t(3)**2*(y1%TI - y2%TI) + t(2)**2*(-y1%TI + y3%TI))* scaleFactor - c = ( (t(2)-t(3))*y1%TI + t(3)*y2%TI - t(2)*y3%TI ) * scaleFactor - y_out%TI = y1%TI + b + c * t_out - b = (t(3)**2*(y1%TI_downstream - y2%TI_downstream) + t(2)**2*(-y1%TI_downstream + y3%TI_downstream))* scaleFactor - c = ( (t(2)-t(3))*y1%TI_downstream + t(3)*y2%TI_downstream - t(2)*y3%TI_downstream ) * scaleFactor - y_out%TI_downstream = y1%TI_downstream + b + c * t_out -IF (ALLOCATED(y_out%wake_u) .AND. ALLOCATED(y1%wake_u)) THEN - DO i2 = LBOUND(y_out%wake_u,2),UBOUND(y_out%wake_u,2) - DO i1 = LBOUND(y_out%wake_u,1),UBOUND(y_out%wake_u,1) - b = (t(3)**2*(y1%wake_u(i1,i2) - y2%wake_u(i1,i2)) + t(2)**2*(-y1%wake_u(i1,i2) + y3%wake_u(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*y1%wake_u(i1,i2) + t(3)*y2%wake_u(i1,i2) - t(2)*y3%wake_u(i1,i2) ) * scaleFactor - y_out%wake_u(i1,i2) = y1%wake_u(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%wake_position) .AND. ALLOCATED(y1%wake_position)) THEN - DO i3 = LBOUND(y_out%wake_position,3),UBOUND(y_out%wake_position,3) - DO i2 = LBOUND(y_out%wake_position,2),UBOUND(y_out%wake_position,2) - DO i1 = LBOUND(y_out%wake_position,1),UBOUND(y_out%wake_position,1) - b = (t(3)**2*(y1%wake_position(i1,i2,i3) - y2%wake_position(i1,i2,i3)) + t(2)**2*(-y1%wake_position(i1,i2,i3) + y3%wake_position(i1,i2,i3)))* scaleFactor - c = ( (t(2)-t(3))*y1%wake_position(i1,i2,i3) + t(3)*y2%wake_position(i1,i2,i3) - t(2)*y3%wake_position(i1,i2,i3) ) * scaleFactor - y_out%wake_position(i1,i2,i3) = y1%wake_position(i1,i2,i3) + b + c * t_out - END DO - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%smoothed_velocity_array) .AND. ALLOCATED(y1%smoothed_velocity_array)) THEN - DO i2 = LBOUND(y_out%smoothed_velocity_array,2),UBOUND(y_out%smoothed_velocity_array,2) - DO i1 = LBOUND(y_out%smoothed_velocity_array,1),UBOUND(y_out%smoothed_velocity_array,1) - b = (t(3)**2*(y1%smoothed_velocity_array(i1,i2) - y2%smoothed_velocity_array(i1,i2)) + t(2)**2*(-y1%smoothed_velocity_array(i1,i2) + y3%smoothed_velocity_array(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*y1%smoothed_velocity_array(i1,i2) + t(3)*y2%smoothed_velocity_array(i1,i2) - t(2)*y3%smoothed_velocity_array(i1,i2) ) * scaleFactor - y_out%smoothed_velocity_array(i1,i2) = y1%smoothed_velocity_array(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated - b = (t(3)**2*(y1%AtmUscale - y2%AtmUscale) + t(2)**2*(-y1%AtmUscale + y3%AtmUscale))* scaleFactor - c = ( (t(2)-t(3))*y1%AtmUscale + t(3)*y2%AtmUscale - t(2)*y3%AtmUscale ) * scaleFactor - y_out%AtmUscale = y1%AtmUscale + b + c * t_out - b = (t(3)**2*(y1%du_dz_ABL - y2%du_dz_ABL) + t(2)**2*(-y1%du_dz_ABL + y3%du_dz_ABL))* scaleFactor - c = ( (t(2)-t(3))*y1%du_dz_ABL + t(3)*y2%du_dz_ABL - t(2)*y3%du_dz_ABL ) * scaleFactor - y_out%du_dz_ABL = y1%du_dz_ABL + b + c * t_out - b = (t(3)**2*(y1%total_SDgenpwr - y2%total_SDgenpwr) + t(2)**2*(-y1%total_SDgenpwr + y3%total_SDgenpwr))* scaleFactor - c = ( (t(2)-t(3))*y1%total_SDgenpwr + t(3)*y2%total_SDgenpwr - t(2)*y3%total_SDgenpwr ) * scaleFactor - y_out%total_SDgenpwr = y1%total_SDgenpwr + b + c * t_out - b = (t(3)**2*(y1%mean_SDgenpwr - y2%mean_SDgenpwr) + t(2)**2*(-y1%mean_SDgenpwr + y3%mean_SDgenpwr))* scaleFactor - c = ( (t(2)-t(3))*y1%mean_SDgenpwr + t(3)*y2%mean_SDgenpwr - t(2)*y3%mean_SDgenpwr ) * scaleFactor - y_out%mean_SDgenpwr = y1%mean_SDgenpwr + b + c * t_out - b = (t(3)**2*(y1%avg_ct - y2%avg_ct) + t(2)**2*(-y1%avg_ct + y3%avg_ct))* scaleFactor - c = ( (t(2)-t(3))*y1%avg_ct + t(3)*y2%avg_ct - t(2)*y3%avg_ct ) * scaleFactor - y_out%avg_ct = y1%avg_ct + b + c * t_out - CALL InflowWind_Output_ExtrapInterp2( y1%IfW, y2%IfW, y3%IfW, tin, y_out%IfW, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - END SUBROUTINE DWM_Output_ExtrapInterp2 - -END MODULE DWM_Types -!ENDOFREGISTRYGENERATEDFILE diff --git a/modules/aerodyn14/src/DWM_Wake_Sub_ver2.f90 b/modules/aerodyn14/src/DWM_Wake_Sub_ver2.f90 deleted file mode 100644 index b6eaefee07..0000000000 --- a/modules/aerodyn14/src/DWM_Wake_Sub_ver2.f90 +++ /dev/null @@ -1,2851 +0,0 @@ -MODULE DWM_Wake_Sub - - USE DWM_Types - USE NWTC_Library - !USE InflowWind - - IMPLICIT NONE - - ! ..... Public Subroutines ............ - - PUBLIC :: turbine_average_velocity - PUBLIC :: pass_velocity - PUBLIC :: filter_average_induction_factor - PUBLIC :: calculate_mean_u - PUBLIC :: calculate_element_area - PUBLIC :: calculate_induction_factor - PUBLIC :: get_initial_condition - PUBLIC :: calculate_wake - PUBLIC :: create_F1_filter - PUBLIC :: create_F2_filter - PUBLIC :: Gauss - PUBLIC :: shear_correction - PUBLIC :: filter_velocity - PUBLIC :: Get_wake_center - PUBLIC :: smooth_out_wake - PUBLIC :: smooth_wake_shifted_velocity - PUBLIC :: shifted_velocity - PUBLIC :: TI_downstream_total - PUBLIC :: smallscale_TI - PUBLIC :: read_parameter_file - PUBLIC :: read_turbine_position - PUBLIC :: read_upwind_result_file - PUBLIC :: write_result_file -! PUBLIC :: rename_FAST_output - PUBLIC :: min_of_array - PUBLIC :: max_of_array - -CONTAINS -!---------------------------------------------------------------------------------------------------------------------------------- -!SUBROUTINE CalVelScale(u,v,y,z) -!.................................................................................................................................. -! This routine is to calculat the atmospheric length scale before introducing the TI term (which will be used later) -!.................................................................................................................................. - ! IMPLICIT NONE - - ! TYPE(DWM_OutputType), INTENT(INOUT) :: y - !TYPE(DWM_ConstraintStateType), INTENT(INOUT) :: z - - !! Internal variables - !REAL(ReKi) :: u ! atmospheric U velocity - !REAL(ReKi) :: v ! atmospheric V velocity - - !z%CalVelScale_data%counter = z%CalVelScale_data%counter + 1 - - !z%CalVelScale_data%Denominator = (z%CalVelScale_data%Denominator * (z%CalVelScale_data%counter-1) + u*v)/z%CalVelScale_data%counter - !z%CalVelScale_data%Numerator = (z%CalVelScale_data%Numerator * (z%CalVelScale_data%counter-1) + u*v)/z%CalVelScale_data%counter - - !y%AtmUscale = z%CalVelScale_data%Numerator / z%CalVelScale_data%Denominator - -!END SUBROUTINE CalVelScale - - -!!---------------------------------------------------------------------------------------------------------------------------------- -!SUBROUTINE turbine_average_velocity( single_velocity, blade_num, element, y,X,z) -!.................................................................................................................................. -! This routine is called at every time step of the Aerodyn simuilation. -! To calculate the average of the wind speed of a specific blade ring, the outpout is the average_velocity_array -!.................................................................................................................................. - ! IMPLICIT NONE - - ! TYPE(DWM_ConstraintStateType), INTENT(INOUT) :: z - !TYPE(DWM_OutputType), INTENT(INOUT) :: y - - ! ! Internal variables - !REAL(ReKi) :: single_velocity - !REAL(ReKi),ALLOCATABLE :: y%Mean_FFWS_array(:) - !INTEGER(IntKi) :: element - !INTEGER(IntKi) :: blade_num - !INTEGER(IntKi) :: I - - !z%turbine_average_velocity_data%time_step_velocity = z%turbine_average_velocity_data%time_step_velocity + 1 - - !IF (z%turbine_average_velocity_data%time_step_velocity == 0) THEN - ! ALLOCATE (y%Mean_FFWS_array (X%ElOut%NumElOut)) - ! ALLOCATE (z%turbine_average_velocity_data%time_step_velocity_array(X%ElOut%NumElOut)) - !y%Mean_FFWS_array = 0 - !z%turbine_average_velocity_data%time_step_velocity_array = 0 - !y%Mean_FFWS_array(element) = single_velocity - !z%turbine_average_velocity_data%time_step_velocity_array(element) = 1 - - !ELSE IF (z%turbine_average_velocity_data%time_step_velocity > 0) THEN - ! DO I = 1,X%ElOut%NumElOut - ! IF ( element == I ) THEN - ! z%turbine_average_velocity_data%time_step_velocity_array(element) = z%turbine_average_velocity_data%time_step_velocity_array(element) + 1 - ! y%Mean_FFWS_array(element) = ( y%Mean_FFWS_array(element)*( (z%turbine_average_velocity_data%time_step_velocity_array(element)-1) )& - ! +single_velocity)/z%turbine_average_velocity_data%time_step_velocity_array(element) - ! IF ( I == X%ElOut%NumElOut .AND. blade_num = X%Blade%NB ) THEN - ! CALL pass_velocity(y%Mean_FFWS_array,Q,X) - ! z%turbine_average_velocity_data%time_step_velocity = -1 - ! IF ( ALLOCATED( y%Mean_FFWS_array )) DEALLOCATE ( y%Mean_FFWS_array ) - ! IF ( ALLOCATED( z%turbine_average_velocity_data%time_step_velocity_array )) DEALLOCATE ( z%turbine_average_velocity_data%time_step_velocity_array ) - !END IF - !END IF - !END DO - !END IF - -!END SUBROUTINE turbine_average_velocity - -!---------------------------------------------------------------------------------- -SUBROUTINE turbine_average_velocity( p, m, single_velocity, blade_num, element, average_velocity_array_local ) -!.................................................................................. -! This routine is called at every time step of the Aerodyn simuilation. -! To calculate the average of the wind speed of a specific blade ring -! the outpout is the average_velocity_array -!.................................................................................. - !USE TAVD, ONLY: m%TAVD%time_step_velocity_array, m%TAVD%time_step_velocity - - TYPE(DWM_MiscVarType), INTENT(INOUT) :: m - TYPE(DWM_ParameterType), INTENT(IN ) :: p - - REAL(ReKi), INTENT(IN) :: single_velocity - REAL(ReKi),ALLOCATABLE, INTENT(INOUT) :: average_velocity_array_local(:) - INTEGER, intent(in) :: element - INTEGER, intent(in) :: blade_num - INTEGER :: i - !INTEGER :: m%TAVD%time_step_velocity = -1 - !INTEGER,ALLOCATABLE,SAVE :: m%TAVD%time_step_velocity_array(:) ! counter of each section of the blade - - m%TAVD%time_step_velocity = m%TAVD%time_step_velocity +1 - - IF ( m%TAVD%time_step_velocity==0) THEN - ALLOCATE ( average_velocity_array_local(p%ElementNum) ) - ALLOCATE ( m%TAVD%time_step_velocity_array(p%ElementNum) ) - average_velocity_array_local(:) = 0 - m%TAVD%time_step_velocity_array(:) = 0 - average_velocity_array_local(element) = single_velocity - m%TAVD%time_step_velocity_array(element) = 1 - - ELSE IF (m%TAVD%time_step_velocity > 0) THEN - DO i=1,p%ElementNum - IF ( element == i) THEN - m%TAVD%time_step_velocity_array(element) = m%TAVD%time_step_velocity_array(element)+1 - average_velocity_array_local(element) = (average_velocity_array_local(element)*( (m%TAVD%time_step_velocity_array(element)-1) ) + single_velocity) & - / (m%TAVD%time_step_velocity_array(element)) - IF ( element == p%ElementNum ) THEN - IF ( blade_num == p%Bnum) THEN - CALL pass_velocity(p, m, average_velocity_array_local) - m%TAVD%time_step_velocity = -1 - IF (ALLOCATED( average_velocity_array_local )) DEALLOCATE ( average_velocity_array_local ) - IF (ALLOCATED( m%TAVD%time_step_velocity_array )) DEALLOCATE ( m%TAVD%time_step_velocity_array ) - END IF - END IF - END IF - END DO - END IF - - -END SUBROUTINE turbine_average_velocity - -!!---------------------------------------------------------------------------------------------------------------------------------- -!SUBROUTINE pass_velocity(array_velocity,z,X) -!.................................................................................................................................. -!.................................................................................................................................. - ! IMPLICIT NONE - !TYPE(DWM_ConstraintStateType), INTENT(INOUT) :: z - - ! ! Internal variables - !REAL(ReKi),ALLOCATEBLE :: array_velocity(:) - - - !z%turbine_average_velocity_data%time_step_pass_velocity = z%turbine_average_velocity_data%time_step_pass_velocity+1 - - !IF( z%turbine_average_velocity_data%time_step_pass_velocity==0 ) THEN - ! ALLOCATE (z%turbine_average_velocity_data%average_velocity_array_temp(X%ElOut%NumElOut)) - ! z%turbine_average_velocity_data%average_velocity_array_temp(:) = array_velocity(:) - !ELSE IF( z%turbine_average_velocity_data%time_step_pass_velocity>0 ) THEN - ! z%turbine_average_velocity_data%average_velocity_array_temp(:) = array_velocity(:) - !END IF - -!END SUBROUTINE pass_velocity - -!---------------------------------------------------------------------------------- -SUBROUTINE pass_velocity(p, m, array_velocity) -!.................................................................................. -! -! -! -!.................................................................................. - !USE TAVD, ONLY: m%TAVD%average_velocity_array_temp, m%TAVD%time_step_pass_velocity - - TYPE(DWM_MiscVarType), INTENT(INOUT) :: m - TYPE(DWM_ParameterType), INTENT(IN ) :: p ! Parameters - - - REAL(ReKi) :: array_velocity(p%ElementNum) - !INTEGER,SAVE :: m%TAVD%time_step_pass_velocity = -1 - - m%TAVD%time_step_pass_velocity = m%TAVD%time_step_pass_velocity+1 - - IF (m%TAVD%time_step_pass_velocity==0) THEN - ALLOCATE (m%TAVD%average_velocity_array_temp(p%ElementNum)) - m%TAVD%average_velocity_array_temp(:) = array_velocity(:) - ELSE IF(m%TAVD%time_step_pass_velocity>0) THEN - m%TAVD%average_velocity_array_temp(:) = array_velocity(:) - END IF - -END SUBROUTINE pass_velocity -!!---------------------------------------------------------------------------------------------------------------------------------- -!SUBROUTINE filter_average_induction_factor( X, z, y ) -!.................................................................................................................................. -! This routine is called at every time step of the Aerodyn simuilation. -! The output of the subroutine is induction factor at this time step -! and the average induction factor through all the time steps which have been simulated -!.................................................................................................................................. - ! IMPLICIT NONE - ! TYPE(DWM_OutputType), INTENT(INOUT) :: y - ! TYPE(DWM_ConstraintStateType), INTENT(INOUT) :: z - - ! ! Internal variables - !REAL(ReKi) :: thrust_coefficient ( X%Element%NELM ) - !REAL(ReKi) :: average_induction_factor ( X%Element%NELM ) - !REAL(ReKi) :: induction_factor_local_temp ( X%Element%NELM ) - - - !z%turbine_average_velocity_data%time_step_force = z%turbine_average_velocity_data%time_step_force +1 - - - !IF ( z%turbine_average_velocity_data%time_step_force==0) THEN - ! ALLOCATE (y%induction_factor ( X%Element%NELM )) - ! ALLOCATE (z%turbine_average_velocity_data%average_velocity_array ( X%Element%NELM )) - !ALLOCATE (y%turbine_thrust_force (X%Element%NELM )) - !ALLOCATE (z%turbine_average_velocity_data%swept_area (X%Element%NELM )) - !y%turbine_thrust_force (:) = X%Blade%NB * X%Element%DFNSAV(:) - !CALL calculate_element_area ( X%Blade%R, X%Element%NElm, X%Element%RELM(:), z%turbine_average_velocity_data%swept_area ) - !CALL calculate_induction_factor ( y%turbine_thrust_force , z%turbine_average_velocity_data%swept_area , X%Element%NELM, & - ! z%turbine_average_velocity_data%average_velocity_array_temp, induction_factor_local_temp ) - !y%induction_factor = induction_factor_local_temp - !z%turbine_average_velocity_data%average_velocity_array = z%turbine_average_velocity_data%average_velocity_array_temp - !ELSE IF ( z%turbine_average_velocity_data%time_step_force>0) THEN - ! y%turbine_thrust_force (:) = X%Blade%NB * X%Element%DFNSAV(:) - ! CALL calculate_induction_factor ( y%turbine_thrust_force , z%turbine_average_velocity_data%swept_area , X%Element%NELM, & - ! z%turbine_average_velocity_data%average_velocity_array_temp, induction_factor_local_temp ) - !y%induction_factor = ( y%induction_factor(:) * z%turbine_average_velocity_data%time_step_force + induction_factor_local_temp(:) ) & - ! / ( z%turbine_average_velocity_data%time_step_force+1 ) - !z%turbine_average_velocity_data%average_velocity_array = ( z%turbine_average_velocity_data%average_velocity_array(:) * & - ! z%turbine_average_velocity_data%time_step_force + z%turbine_average_velocity_data%average_velocity_array_temp(:) ) & - ! / ( z%turbine_average_velocity_data%time_step_force+1 ) - !END IF - -!END SUBROUTINE filter_average_induction_factor - -!---------------------------------------------------------------------------------- -SUBROUTINE filter_average_induction_factor( m, p, y, thrust_force, num_of_element, dr_blade) -!.................................................................................. -! This routine is called at every time step of the Aerodyn simuilation. -! The output of the subroutine is induction factor at this time step -! and the average induction factor through all the time steps which have been simulated -!.................................................................................. - !USE TAVD, ONLY: m%TAVD%time_step_force, m%TAVD%swept_area, m%TAVD%average_velocity_array, m%TAVD%average_velocity_array_temp - !USE DWN_OutputType, ONLY: m%induction_factor, m%turbine_thrust_force - !USE Blade, ONLY: R - - TYPE(DWM_MiscVarType), INTENT(INOUT) :: m - TYPE(DWM_ParameterType), INTENT(IN ) :: p ! Parameters - TYPE(DWM_OutputType), INTENT(INOUT) :: y - - - INTEGER, INTENT(IN) :: num_of_element ! The number of the nodes in the blade - REAL(ReKi), INTENT(IN) :: thrust_force ( num_of_element,p%BNum ) ! Thrust force at each node - !INTEGER, SAVE :: m%TAVD%time_step_force = -1 ! The time step (save attribute) of the FAST simulation - REAL(ReKi) :: thrust_coefficient ( num_of_element ) - REAL(ReKi) :: average_induction_factor ( num_of_element ) - REAL(ReKi) :: induction_factor_local_temp ( num_of_element ) - INTEGER :: I,J - REAL(ReKi), INTENT(IN) :: dr_blade ( num_of_element ) - - - m%TAVD%time_step_force = m%TAVD%time_step_force +1 - - - IF ( m%TAVD%time_step_force==0) THEN - ALLOCATE (y%induction_factor ( num_of_element )) - ALLOCATE (m%TAVD%average_velocity_array ( num_of_element )) - ALLOCATE (y%turbine_thrust_force (num_of_element )) - ALLOCATE (m%TAVD%swept_area (num_of_element )) - - y%turbine_thrust_force = 0 - DO I = 1,num_of_element - DO J = 1,p%BNum - y%turbine_thrust_force (I) = y%turbine_thrust_force (I) + thrust_force(I,J) - END DO - END DO - - DO I = 1,num_of_element - y%turbine_thrust_force (I) = y%turbine_thrust_force(I) !* dr_blade(I) ! integrate dFn through blade - END DO - - CALL calculate_element_area ( p%RotorR, p%ElementNum, p%ElementRad(:), m%TAVD%swept_area ) - CALL calculate_induction_factor ( p, y%turbine_thrust_force , m%TAVD%swept_area , num_of_element, m%TAVD%average_velocity_array_temp, induction_factor_local_temp ) - y%induction_factor = induction_factor_local_temp - m%TAVD%average_velocity_array = m%TAVD%average_velocity_array_temp - - ELSE IF ( m%TAVD%time_step_force>0) THEN - - y%turbine_thrust_force = 0 - DO J = 1,p%BNum - DO I = 1,num_of_element - y%turbine_thrust_force (I) = y%turbine_thrust_force (I) + thrust_force(I,J) - END DO - END DO - - DO I = 1,num_of_element - y%turbine_thrust_force (I) = y%turbine_thrust_force(I) !* dr_blade(I) ! integrate dFn through blade - END DO - - CALL calculate_induction_factor ( p, y%turbine_thrust_force , m%TAVD%swept_area , num_of_element, m%TAVD%average_velocity_array_temp, induction_factor_local_temp ) - y%induction_factor = ( y%induction_factor(:) * m%TAVD%time_step_force + induction_factor_local_temp(:) ) / ( m%TAVD%time_step_force+1 ) - m%TAVD%average_velocity_array = ( m%TAVD%average_velocity_array(:) * m%TAVD%time_step_force + m%TAVD%average_velocity_array_temp(:) ) / ( m%TAVD%time_step_force+1 ) - END IF - - !print*, y%induction_factor(40), induction_factor_local_temp(40) - -END SUBROUTINE filter_average_induction_factor - -!---------------------------------------------------------------------------------- -SUBROUTINE calculate_mean_u( m, p, u, num_element,r_t,turbine_mean_velocity,TI_normalization, FAST_Time ) -!.................................................................................. -! This routine is called to calculate the mean velocity and the TI of the turbine -! Using weighting method according to the blade ring area -!.................................................................................. - !USE TAVD, ONLY : m%TAVD%average_velocity_array - !USE read_turbine_position_data , ONLY : m%RTPD%SimulationOrder_index,m%RTPD%upwindturbine_number - !USE weighting_method , ONLY : m%weighting_method%sweptarea,m%weighting_method%weighting_denominator - !USE read_upwind_result_file_data , ONLY : m%Upwind_result%upwind_TI - !USE Blade , ONLY : R - - TYPE(DWM_MiscVarType), INTENT(INOUT) :: m - TYPE(DWM_ParameterType), INTENT(IN ) :: p ! Parameters - TYPE(DWM_InputType), INTENT(INOUT) :: u - - INTEGER :: num_element - INTEGER :: i - REAL(ReKi) :: r_t ( num_element ) ! The distance from the node to the hub - REAL(ReKi) :: turbine_mean_velocity ! turbine mean velocity - REAL(ReKi) :: node_radius ( num_element ) - REAL(ReKi) :: element_length ( num_element ) - REAL(ReKi) :: TI_normalization - REAL(ReKi) :: FAST_Time - - ! check if the meandering simulation time is valid - IF (p%WakePosition_1 < FAST_Time/ ( (20*p%RotorR/p%p_p_r)/(0.32*p%Uambient) ) + 1 ) THEN - ! bjj: this at least is standard fortran, but calling ProgAbort is not allowed in a module in the FAST framework. Please trap your errors and return an error code. - CALL ProgAbort('WARNING: Meandering_simulation_time is not valid, please refer to the DWM manual') - END IF - - ALLOCATE (m%weighting_method%sweptarea(num_element)) - - m%weighting_method%weighting_denominator = 0 - turbine_mean_velocity = 0 - - element_length (num_element) = 2.0*( p%RotorR - r_t(num_element) ) - DO i=num_element-1,1,(-1) - element_length(i)= 2.0*( r_t(i+1)-r_t(i) ) - element_length (i+1) - END DO - - node_radius ( num_element ) = p%RotorR - element_length (num_element) - DO i=num_element-1,1,(-1) - node_radius (i) = node_radius (i+1) - element_length (i) - END DO - - DO i=1, num_element-1,1 - m%weighting_method%sweptarea (i) = Pi * (node_radius (i+1) **2 - node_radius (i) **2) - END DO - m%weighting_method%sweptarea (num_element) = Pi * (p%RotorR**2-node_radius (num_element)**2) ! ring area - - DO i=1,num_element - m%weighting_method%weighting_denominator = m%weighting_method%weighting_denominator + m%weighting_method%sweptarea (i) ! denominator - END DO - - ! calculate the mean velocity of the turbine using weighting method - DO i=1,num_element - turbine_mean_velocity = turbine_mean_velocity + m%weighting_method%sweptarea (i) / m%weighting_method%weighting_denominator * m%TAVD%average_velocity_array(i) - END DO - - IF (p%RTPD%SimulationOrder_index == 1 .OR. p%RTPD%SimulationOrder_index == 0) THEN - TI_normalization = p%TI_amb - ELSE - IF(p%RTPD%upwindturbine_number /= 0) THEN ! superimpose the TI from upstream wakes - TI_normalization = 0 - DO I = 1,p%RTPD%upwindturbine_number - TI_normalization = (TI_normalization**2 + u%Upwind_result%upwind_TI(I)**2)**0.5 - END DO - !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - TI_normalization = u%Upwind_result%upwind_TI(1) ! only take the TI effect from the closest upstream turbine - !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - TI_normalization = TI_normalization/(turbine_mean_velocity/p%Uambient) - ELSE - TI_normalization = p%TI_amb - END IF - END IF - -END SUBROUTINE calculate_mean_u - -!---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE calculate_element_area (blade_radius, num_element, r_t, sweptarea) -!.................................................................................................................................. -! This routine is called when the Aerodyn simuilation finishes. -! This routine is called to calculate the swept area of each blade section. -! The output of the subroutine is swept_area (:), which is the swept area of of each blade element. -!.................................................................................................................................. - IMPLICIT NONE - - ! Internal variables - INTEGER(IntKi) :: num_element - INTEGER(IntKi) :: I - REAL(ReKi) :: blade_radius - REAL(ReKi) :: r_t ( num_element ) ! The distance from the node to the hub - REAL(ReKi) :: node_radius ( num_element ) - REAL(ReKi) :: element_length ( num_element ) - REAL(ReKi) :: sweptarea(num_element) - - element_length (num_element) = 2.0*( blade_radius - r_t(num_element) ) - DO I=num_element-1,1,(-1) - element_length(I)= 2.0*( r_t(I+1)-r_t(I) ) - element_length (I+1) - END DO - - node_radius ( num_element ) = blade_radius - element_length (num_element) - DO I=num_element-1,1,(-1) - node_radius (I) = node_radius (I+1) - element_length (I) - END DO - - DO I=1, num_element-1,1 - sweptarea (I) = Pi * (node_radius (I+1) **2 - node_radius (I) **2) - END DO - sweptarea (num_element) = Pi * (blade_radius**2-node_radius (num_element)**2) - -END SUBROUTINE calculate_element_area - -!---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE calculate_induction_factor ( p, normal_force , element_swept_area , num_element, FFWS_array, induction_factor_local ) -!.................................................................................................................................. -! This routine is called to calculate thrust coefficient then the induction factor using local thrust force. -! The output of the subroutine is induction_factor (:), which is the induction factor of each blade node. -!.................................................................................................................................. - - TYPE(DWM_ParameterType), INTENT(IN ) :: p - - - ! Internal variables - INTEGER(IntKi) :: num_element - INTEGER(IntKi) :: I - REAL(ReKi) :: normal_force ( num_element ) - REAL(ReKi) :: element_swept_area ( num_element ) - REAL(ReKi) :: thrust_coefficient ( num_element ) - REAL(ReKi) :: induction_factor_local ( num_element ) - REAL(ReKi) :: FFWS_array( num_element) - REAL(ReKi) :: Ct_1 - REAL(ReKi) :: a_t - REAL(ReKi) :: Ct_critical - - - !Calculate thrust coefficient - DO I=1,num_element - thrust_coefficient (I) = normal_force(I)/(0.5* p%air_density * element_swept_area(I)* FFWS_array(I)**2) - END DO - - - ! Then calculate the induction factor by solving 4a(1-a)= Ct - ! Applying the Glauert empirical Ct modification (10.7.2013) - - Ct_1 = 1.816 - a_t = 1 - 0.5*SQRT(Ct_1) - Ct_critical = 4*a_t*(1-a_t) - - DO I=1,num_element - IF (thrust_coefficient(I)<=Ct_critical) THEN - induction_factor_local (I) = (-4 + (16-16*thrust_coefficient(I))**(0.5))/(2*(-4)) - ELSE - induction_factor_local (I) = 1 - (thrust_coefficient(I)-Ct_1) / (-4*(SQRT(Ct_1)-1)) - END IF - END DO - -END SUBROUTINE calculate_induction_factor - -!---------------------------------------------------------------------------------- -SUBROUTINE get_initial_condition( m, p, u, y, induc_array, r_t, element_num, r_w, U_w ) -!.................................................................................. -! This routine is called at the end of the subroutine calculate_initial_condition. -! This routine is called to calculate the initial condition of the DWM model. -! The output of the subroutine is r_wake (:) and U_wake (:). -! Which are the the scaled rotor radius and the scaled velocity at the rotor. -!.................................................................................. - !USE read_turbine_position_data, ONLY: m%RTPD%SimulationOrder_index,m%RTPD%upwindturbine_number - !USE DWM_ParameterType, ONLY: p%smoothed_wake,p%smooth_flag,p%Uambient - !USE DWM_OutputType, ONLY: m%Mean_FFWS - !USE read_upwind_result_file_data, ONLY: m%Upwind_result%upwind_smoothWake - !USE BLADE, ONLY: R - - TYPE(DWM_MiscVarType), INTENT(INOUT) :: m - TYPE(DWM_ParameterType), INTENT(IN ) :: p ! Parameters - TYPE(DWM_InputType), INTENT(INOUT) :: u - TYPE(DWM_OutputType), INTENT(INOUT) :: y - - - INTEGER :: element_num - INTEGER :: i,J - REAL(ReKi) :: induc_array(element_num) - REAL(ReKi) :: r_t(element_num) - REAL(ReKi) :: dA (element_num-1) - REAL(ReKi) :: a_cellC (element_num-1) - REAL(ReKi) :: mean_a - REAL(ReKi) :: f_w - REAL(ReKi) :: fU !fU factor (realised induction for wake depth) {0-1} - REAL(ReKi) :: fR !fR factor (realised expansion for wake width) {0-1} - REAL(ReKi), ALLOCATABLE :: r_w(:) - REAL(ReKi), ALLOCATABLE :: U_w(:) - - - ALLOCATE (r_w(element_num)) - ALLOCATE (U_w(element_num)) - fU = 1.10 !1.10 is not working when induction factor is reaching 0.5: (1-a*(fu+1))<1 !!!! 0.92 - fR = 0.98 - - - !------------------------------------------------------------------------------------------------- - ! apply the smoothed wake profile as the input wind profile for downstream turbine - !------------------------------------------------------------------------------------------------- - - !------------------------------------------------------------------------------------------------- - ! calculate the boundary condition - !------------------------------------------------------------------------------------------------- - !===Initial Condition=== - DO i=1,element_num-1 - dA (i) =( (r_t(i+1)/p%RotorR)**2 - (r_t(i)/p%RotorR)**2 )*Pi - END DO - !== simple approximation of cell center value - DO i=1,element_num-1 - a_cellC (i) = ( induc_array(i+1) +induc_array(i) ) /2 - END DO - - !== Boundary Condition r_w - mean_a = 0.0 - DO i=1,element_num-1 - mean_a = ( a_cellC (i) * dA (i) ) /Pi + mean_a - END DO - - !== Uniform expansion - f_w = ( (1-mean_a) / (1- ((1+fR) * mean_a)) )**0.5 - r_w = r_t /p%RotorR * f_w - - !== Boundary velocity - !U_w = 1 - (induc_array * (1+fU)) - - ! superimpose the smoothed wake from upwind turbines - IF (p%RTPD%SimulationOrder_index == 1 .OR. p%RTPD%SimulationOrder_index == 0) THEN - U_w = 1 - (induc_array * (1+fU)) - ELSEIF(p%RTPD%SimulationOrder_index > 1) THEN - IF (p%RTPD%upwindturbine_number == 0) THEN - U_w = 1 - (induc_array * (1+fU)) - ELSEIF (p%RTPD%upwindturbine_number > 0) THEN - !!ALLOCATE (p%smoothed_wake(element_num)) - !!p%smoothed_wake = 1 - !!DO I = 1,p%RTPD%upwindturbine_number - !!DO J = 1,element_num - !!p%smoothed_wake(J) = 1- ( (1-p%smoothed_wake(J))**2 + (1-u%Upwind_result%upwind_smoothWake(I,J))**2 )**0.5 - !!END DO - !!END DO - - DO I = 1,element_num - !U_w(I) = (p%Uambient/y%Mean_FFWS) * u%Upwind_result%upwind_smoothWake(1,I)*(1 - (induc_array(I) * (1+fU))) - U_w(I) = (y%Mean_FFWS/p%Uambient) *(1 - (induc_array(I) * (1+fU))) - END DO - END IF - END IF - - DO i=1,element_num,1 ! modification for low wind speed, high thrust situation - IF (U_w(i) < 0.0) THEN - U_w(i) = 0.01 - END IF - END DO - - ! calculate the average induction factor of the rotor plane - !avg_induction_factor = 0 - - !DO i=1,element_num - !avg_induction_factor = avg_induction_factor + m%weighting_method%sweptarea (i) / m%weighting_method%weighting_denominator * induc_array(i) - !END DO - - !m%skew_angle = 0.60*avg_induction_factor*NacYaw *(-1) ! minus sign means different direction - - - !--- calculate the average thrust coefficient and the ct_tilde --- - - y%avg_ct = 0 - - !-------test-------- - !u%NacYaw = 0.00 - !------------------- - - DO i=1,element_num - y%avg_ct = y%avg_ct + m%weighting_method%sweptarea (i) / m%weighting_method%weighting_denominator * ( 4*induc_array(i)*(1-induc_array(i)) ) - END DO - - !m%ct_tilde = 0.5*COS(m%NacYaw)**2*SIN(m%NacYaw)*y%avg_ct - m%ct_tilde = y%avg_ct - -END SUBROUTINE get_initial_condition - -!------------------------------------------------------------------------- -SUBROUTINE calculate_wake(m, p, y, r_w, U_w, element_num, U, b) -!.................................................................................. -! This routine is the main routine to calculate the wake -! This routine is called after receiving the scaled rotor radius and the scaled velocity at the rotor -! The output of this routine is the wake velocity which is "U" -! and the wake width which is the "b" -!.................................................................................. - !USE DWM_Wake_Deficit_Data - !USE DWM_ParameterType, ONLY: p%p_p_r, p%r_domain, p%Uambient, p%x_domain, p%hub_height, p%TI_amb - - TYPE(DWM_MiscVarType), INTENT(INOUT) :: m - TYPE(DWM_ParameterType), INTENT(IN ) :: p ! Parameters - TYPE(DWM_OutputType), INTENT(INOUT) :: y - - INTEGER :: element_num - REAL(ReKi) :: r_w (element_num) ! scaled rotor radius r_w - REAL(ReKi) :: U_w (element_num) ! scaled velocity U_w - REAL(ReKi),ALLOCATABLE :: U(:,:) - INTEGER,ALLOCATABLE :: b(:) - - ! local variables - REAL(ReKi) :: mtemp - REAL(ReKi) :: ntemp - REAL(ReKi) :: xtemp - REAL(ReKi) :: ytemp - - REAL(ReKi), DIMENSION(2) :: filter1 - REAL(ReKi), DIMENSION(2) :: filter2 - REAL(ReKi), ALLOCATABLE :: F1_vector (:) - REAL(ReKi), ALLOCATABLE :: F2_vector (:) - !REAL(ReKi) :: m%DWDD%ppR ! Point_per_R_resoulution - REAL(ReKi) :: Domain_R ! Domain_size_in_radial_direction - REAL(ReKi) :: Domain_X ! Domain_size_in_flow_direction - !REAL(ReKi) :: TI_original ! Turbulence_intensity normalized back to ambient wind speed - REAL(ReKi) :: k1 ! Amb turb. coeff. - REAL(ReKi) :: k2 ! Shear layer coeff. - - !INTEGER :: m%DWDD%n_x_vector - !INTEGER :: m%DWDD%n_r_vector - - !%%%%% Rolf modification - INTEGER :: length_F1_vector - REAL(ReKi) :: L_ABL_vector(3) - REAL(ReKi) :: UW_UU_vector(3) - REAL(ReKi) :: L_DEF_vector(3) - REAL(ReKi) :: UU_DEF_UU_ABL_vector(3) - REAL(ReKi) :: UW_DEF_UU_DEF_vector(3) - REAL(ReKi) :: x_ary(3) - REAL(ReKi) :: L_ABL - REAL(ReKi) :: UW_UU - REAL(ReKi) :: L_DEF - REAL(ReKi) :: UU_DEF_UU_ABL - REAL(ReKi) :: UW_DEF_UU_DEF - REAL(ReKi) :: Rotor_fixed_R - REAL(ReKi) :: l_star_ABL - REAL(ReKi) :: l_star_DEF - REAL(ReKi) :: UU_DEF_UU_ABL_fac - REAL(ReKi) :: u_star_ABL - REAL(ReKi) :: u_star_DEF - REAL(ReKi) :: Shear_add_du_dz - REAL(ReKi),ALLOCATABLE :: visc_wake(:,:) - REAL(ReKi),ALLOCATABLE :: visc_wake1(:,:) - REAL(ReKi),ALLOCATABLE :: visc_wake2(:,:) - REAL(ReKi) :: visc_norm_factor - REAL(ReKi),ALLOCATABLE :: alfa_1(:) - REAL(ReKi),ALLOCATABLE :: alfa_2(:) - REAL(ReKi),ALLOCATABLE :: du_dr_tot(:,:) - INTEGER,ALLOCATABLE :: shear_flag(:) - REAL(ReKi),ALLOCATABLE :: One_div_du_dr_DWM(:,:) - REAL(ReKi),ALLOCATABLE :: visc_fac(:) - - REAL(ReKi) :: R_WTG ! normalized radius - REAL(ReKi) :: U0 ! normalized wind speed - REAL(ReKi) :: D_WTG ! normalized diameter - REAL(ReKi) :: R_length ! normalized length in radial direction - !REAL(ReKi) :: m%DWDD%X_length ! normalized length in axial direction - INTEGER :: np_r ! point per radial distance - !INTEGER :: m%DWDD%np_x ! point per axial distance - REAL(ReKi) :: delrad ! delta r - REAL(ReKi) :: delaxi ! delta x - - REAL(ReKi), ALLOCATABLE :: x_vector(:) - REAL(ReKi), ALLOCATABLE :: r_vector(:) - - REAL(ReKi), ALLOCATABLE :: V(:,:) - REAL(ReKi), ALLOCATABLE :: visc(:,:) - REAL(ReKi), ALLOCATABLE :: visc_DWM(:,:) - REAL(ReKi), ALLOCATABLE :: du_dr_DWM(:,:) - REAL(ReKi), ALLOCATABLE :: du_dr_total(:,:) - !REAL(ReKi), ALLOCATABLE :: m%DWDD%Turb_Stress_DWM(:,:) - !REAL(ReKi), ALLOCATABLE :: TI_DWM(:,:) - !REAL(ReKi), ALLOCATABLE :: U_face(:,:) - !REAL(ReKi), ALLOCATABLE :: VOL_x_jhigh(:,:) - !REAL(ReKi), ALLOCATABLE :: VOL_x_jlow (:,:) - !REAL(ReKi), ALLOCATABLE :: VOL_r_ihigh(:,:) - !REAL(ReKi), ALLOCATABLE :: VOL_r_ilow (:,:) - REAL(ReKi), ALLOCATABLE :: r_vec_DWM (:) - REAL(ReKi), ALLOCATABLE :: dA_DWM (:) - - INTEGER :: n_r_vec_DWM - INTEGER :: b_loop - INTEGER :: b_counter - REAL(ReKi) :: dr_DWM - REAL(ReKi) :: Def_DWM - REAL(ReKi) :: Def_DWM_mixL - REAL(ReKi) :: A_total - REAL(ReKi) :: k_wiener - - INTEGER, ALLOCATABLE :: counter(:) - INTEGER :: i - INTEGER :: j - INTEGER :: k - INTEGER :: ILo - INTEGER :: NumEqu - INTEGER :: n_xi - INTEGER :: n_U_tmp_2 - - REAL(ReKi), ALLOCATABLE :: bin_filter(:) - REAL(ReKi), ALLOCATABLE :: xi(:) - REAL(ReKi), ALLOCATABLE :: U_tmp_1(:) - REAL(ReKi), ALLOCATABLE :: U_tmp_2(:) - REAL(ReKi), ALLOCATABLE :: U_tmp(:) - REAL(ReKi), ALLOCATABLE :: mat(:,:) - REAL(ReKi), ALLOCATABLE :: RHS(:) - REAL(ReKi), ALLOCATABLE :: Soln(:) - REAL(ReKi), ALLOCATABLE :: AugMat(:,:) - - REAL(ReKi) :: LHS1 - REAL(ReKi) :: LHS2 - REAL(ReKi) :: LHS3 - REAL(ReKi) :: LHS11 - REAL(ReKi) :: LHS12 - REAL(ReKi) :: LHS13 - REAL(ReKi) :: LHS21 - REAL(ReKi) :: LHS22 - REAL(ReKi) :: LHS23 - REAL(ReKi) :: LHS31 - REAL(ReKi) :: LHS41 - REAL(ReKi) :: LHS32 - REAL(ReKi) :: LHS33 - REAL(ReKi) :: LHS43 - - REAL(ReKi),ALLOCATABLE :: main_diagonal(:) - REAL(ReKi),ALLOCATABLE :: sub_diagonal(:) - REAL(ReKi),ALLOCATABLE :: sup_diagonal(:) - - m%DWDD%ppR = p%p_p_r - Domain_R = p%r_domain !10.0 domain size in R [R] - Domain_X = p%x_domain !42.0 domain size in X [R] - filter1 = (/0.0, 4.0 /) - filter2 = (/0.035, 0.35/) - k1 = 0.0919 - k2 = 0.0178 - R_WTG = 1.0 - U0 = 1.0 - D_WTG = 2.0 - R_length = Domain_R - m%DWDD%X_length = Domain_X - - m%TI_original = y%TI*(y%Mean_FFWS/p%Uambient) ! calculate the TI if under ambient wind speed - - np_r = m%DWDD%ppR ! per R ie. R resolution is 50 - m%DWDD%np_x = m%DWDD%ppR ! per D ie. X resolution is 50 - delrad = R_WTG/np_r ! dr - delaxi = D_WTG/m%DWDD%np_x ! dx - m%DWDD%n_x_vector = floor((m%DWDD%X_length)/D_WTG*m%DWDD%np_x) ! number of point in equally spaced array x_vector - m%DWDD%n_r_vector = floor((R_length)/R_WTG*np_r) ! number of point in equally spaced array r_vector - - ! create coordinate vectors - ALLOCATE (x_vector(m%DWDD%n_x_vector)) - ALLOCATE (r_vector(m%DWDD%n_r_vector)) - ! similar to linspace function - x_vector = ( (m%DWDD%X_length-delaxi)/(m%DWDD%n_x_vector-1 ) )*[(i,i=1,m%DWDD%n_x_vector)]+(0-( (m%DWDD%X_length-delaxi)/(m%DWDD%n_x_vector-1) )) - r_vector = ( (R_length-delrad)/(m%DWDD%n_r_vector-1 ) )*[(i,i=1,m%DWDD%n_r_vector)]+(0-( (R_length-delrad)/(m%DWDD%n_r_vector-1) )) - - ! Create the F1 filter - - CALL create_F1_filter (F1_vector, filter1, length_F1_vector,m%DWDD%np_x,m%DWDD%X_length) - !OPEN (unit=25,file="DWM\results\F1_filter.txt") - !WRITE (25,'(f13.6)'), F1_vector(:) - !CLOSE(25) - - CALL create_F2_filter (F2_vector, filter2, m%DWDD%np_x, length_F1_vector) - - - !CALL create_filter_vector ( filter1, F1_vector ) - - !CALL create_filter_vector ( filter2, F2_vector ) - - !OPEN (unit=25,file="DWM\results\F2_filter.txt") - !WRITE (25,'(f13.6)'), F2_vector(:) - !CLOSE(25) - - ! Initiate the U, V, visc, TI_add, Turb_stress matrices - ALLOCATE (V (m%DWDD%n_x_vector,m%DWDD%n_r_vector)) - ALLOCATE (U (m%DWDD%n_x_vector,m%DWDD%n_r_vector)) !axial velocity matrix - ALLOCATE (visc (m%DWDD%n_x_vector,m%DWDD%n_r_vector)) - ALLOCATE (visc_DWM (m%DWDD%n_x_vector,m%DWDD%n_r_vector)) - ALLOCATE (du_dr_DWM (m%DWDD%n_x_vector,m%DWDD%n_r_vector)) - ALLOCATE (du_dr_total (m%DWDD%n_x_vector,m%DWDD%n_r_vector)) - ALLOCATE (m%DWDD%Turb_Stress_DWM (m%DWDD%n_x_vector,m%DWDD%n_r_vector)) - !ALLOCATE (TI_DWM (m%DWDD%n_x_vector,m%DWDD%n_r_vector)) - !ALLOCATE (U_face (m%DWDD%n_x_vector,m%DWDD%n_r_vector-1)) - !ALLOCATE (VOL_x_jhigh (m%DWDD%n_x_vector,m%DWDD%n_r_vector-1)) - !ALLOCATE (VOL_x_jlow (m%DWDD%n_x_vector,m%DWDD%n_r_vector-1)) - !ALLOCATE (VOL_r_ihigh (m%DWDD%n_x_vector,m%DWDD%n_r_vector-1)) - !ALLOCATE (VOL_r_ilow (m%DWDD%n_x_vector,m%DWDD%n_r_vector-1)) - ALLOCATE (visc_wake (m%DWDD%n_x_vector,m%DWDD%n_r_vector)) - ALLOCATE (visc_wake1 (m%DWDD%n_x_vector,m%DWDD%n_r_vector)) - ALLOCATE (visc_wake2 (m%DWDD%n_x_vector,m%DWDD%n_r_vector)) - ALLOCATE (alfa_1 (m%DWDD%n_r_vector )) - ALLOCATE (alfa_2 (m%DWDD%n_r_vector )) - ALLOCATE (du_dr_tot (m%DWDD%n_x_vector,m%DWDD%n_r_vector)) - ALLOCATE (shear_flag (m%DWDD%n_r_vector )) - ALLOCATE (One_div_du_dr_DWM (m%DWDD%n_x_vector,m%DWDD%n_r_vector)) - ALLOCATE (visc_fac (m%DWDD%n_r_vector )) - - ALLOCATE (main_diagonal (m%DWDD%n_r_vector )) - ALLOCATE (sub_diagonal (m%DWDD%n_r_vector )) - ALLOCATE (sup_diagonal (m%DWDD%n_r_vector )) - - V = 0 - U = 0 - visc = 0 - du_dr_DWM = 0 - m%DWDD%Turb_Stress_DWM = 0 - !TI_DWM = 0 - !U_face = 0 - !VOL_x_jhigh = 0 - !VOL_x_jlow = 0 - !VOL_r_ihigh = 0 - !VOL_r_ilow = 0 - - !%%%% BOUNDARY CONDITIONS - ! ROTOR PLANE - ALLOCATE (bin_filter(m%DWDD%n_r_vector)) - DO i=1,m%DWDD%n_r_vector - IF (MAXVAL(r_w)>r_vector(i)) THEN - bin_filter(i) = 1 - ELSE - bin_filter(i) = 0 - END IF - END DO - - - n_xi=floor(sum(bin_filter)) - ALLOCATE (xi(n_xi)) - xi=r_vector(1:n_xi)*bin_filter(1:n_xi) - - ALLOCATE (U_tmp_1(n_xi)) - ILo = 1 - DO i=1,n_xi - U_tmp_1(i) = InterpBin( xi(i), r_w, U_w, ILo, size(r_w)) - END DO - - n_U_tmp_2 = size(r_vector)-n_xi - ALLOCATE (U_tmp_2(n_U_tmp_2)) - U_tmp_2 = U0 - - ALLOCATE (U_tmp(n_xi +n_U_tmp_2)) ! =m%DWDD%n_r_vector - U_tmp = (/U_tmp_1, U_tmp_2/) - U (1,:) = U_tmp(1:m%DWDD%n_r_vector) - - ! Centerline - V (1,:) = 0 - - - - !%%%% SOLVING FLOW FIELD - ALLOCATE (b(m%DWDD%n_x_vector)) - ALLOCATE (counter(m%DWDD%n_x_vector)) - counter=1 - ALLOCATE (AugMat (m%DWDD%n_r_vector,m%DWDD%n_r_vector+1) ) - ALLOCATE (Soln (m%DWDD%n_r_vector) ) - - ALLOCATE (mat(m%DWDD%n_r_vector,m%DWDD%n_r_vector)) - ALLOCATE (RHS(m%DWDD%n_r_vector)) - - n_r_vec_DWM = floor(m%DWDD%ppR*Domain_R) - ALLOCATE ( r_vec_DWM (n_r_vec_DWM) ) - ALLOCATE ( dA_DWM (n_r_vec_DWM-1) ) - - !%%%%%%%%%%%%%%% Atmospheric stability effects %%%%%%%%%%%%%%%%%% - L_ABL_vector = (/26.5352, 34.026, 40.7458/) - UW_UU_vector = (/-0.27359, -0.27887, -0.27935/) - L_DEF_vector = (/11.065, 12.9746, 14.4395/) - UU_DEF_UU_ABL_vector = (/0.63044, 0.57982, 0.5287/) - UW_DEF_UU_DEF_vector = (/-0.27341, -0.25684, -0.24217/) - - !%%%%% interpolation wrt to the hub height - x_ary = (/40,100,160/) - L_ABL = InterpBin( p%hub_height, x_ary, L_ABL_vector, ILo, size(x_ary) ) !int_Lww(k3) i.e (Integral length scale (in vertical directions), from ww(k3)) - UW_UU = InterpBin( p%hub_height, x_ary, UW_UU_vector, ILo, size(x_ary) ) ! ratio of UW and UU stresses for whole spectra - L_DEF = InterpBin( p%hub_height, x_ary, L_DEF_vector, ILo, size(x_ary) ) ! Integral length scale (in vertical directions), Meandering length scale subtracted, from ww(k3) - UU_DEF_UU_ABL = InterpBin( p%hub_height, x_ary, UU_DEF_UU_ABL_vector, ILo, size(x_ary) ) ! Part of normal stress in the deficit module - UW_DEF_UU_DEF = InterpBin( p%hub_height, x_ary, UW_DEF_UU_DEF_vector, ILo, size(x_ary) ) ! ratio of UW and UU stresses for spectra in deficit scales - - !%%%%% normalized by the fixed rotor R - Rotor_fixed_R = 40 !ATMOSTAB ANALYSIS IS CARRIED OUT OVER R = 40m, which should be used to normalize the length scales - l_star_ABL = L_ABL / Rotor_fixed_R; - l_star_DEF = L_DEF / Rotor_fixed_R; - - !%%%%% Normalize UU_160m to neutral condition - UU_DEF_UU_ABL_fac = InterpBin( p%hub_height, x_ary, (/0.63044_ReKi, 0.57982_ReKi, 0.5287_ReKi/), ILo, size(x_ary) ) - UU_DEF_UU_ABL = UU_DEF_UU_ABL / UU_DEF_UU_ABL_fac - - !%%%%% CALCULATE u* according to: - ! 1. u* ~= (mean(u'w')^2 )^0.25 - ! 2. {mean(u'w') = mean(u'u')*Cuw_uu} - ! 3. {u' ~= TI (in normalized form)} - ! => u* ~= ((TI^2 * Cuw_uu )^2)^0.25 - u_star_ABL = ( ( (p%TI_amb/100)**2 * ABS(UW_UU) )**2 )**0.25 - u_star_DEF = ( ( (m%TI_original/100)**2 * UU_DEF_UU_ABL * abs(UW_DEF_UU_DEF) )**2 )**0.25; - - Shear_add_du_dz = u_star_ABL / l_star_ABL - - !k_wiener = du_dz_ABL + delrad**2 - - DO j=2, m%DWDD%n_x_vector, 1 ! start from the plane next to the rotor plane - - !==== Calculating wake width "b" where 95% of the deficit is captured - dr_DWM = 1.0/m%DWDD%ppR - - DO i=1,n_r_vec_DWM ! build r_vec_DWM - r_vec_DWM (i) = dr_DWM/2 + (i-1)*dr_DWM - END DO - - DO i=1,n_r_vec_DWM-1 ! build dA_DWM - dA_DWM (i) = Pi * ( r_vec_DWM (i+1)**2 - r_vec_DWM (i)**2 ) - END DO - - Def_DWM = 0 ! Calculate Def_DWM - DO i=1, n_r_vec_DWM-1 - Def_DWM = (1-U (j-1,i+1)) * dA_DWM (i) + Def_DWM - END DO - - Def_DWM_mixL = 0 ! Calculate the wake width "b" - DO i = 2,NINT( m%DWDD%ppR ) - Def_DWM_mixL = ( 1- U(j-1,i) ) * dA_DWM(i) + Def_DWM_mixL - END DO - DO b_counter = NINT(m%DWDD%ppR)+1, n_r_vec_DWM-1 - Def_DWM_mixL = ( 1- U(j-1,b_counter) ) * dA_DWM(b_counter) + Def_DWM_mixL - IF ( Def_DWM_mixL > Def_DWM * 0.99 ) THEN - EXIT - ELSE IF (b_counter == n_r_vec_DWM-1) THEN - EXIT - END IF - END DO - b(j-1) = b_counter - - ! %%%%% Calculate eddy viscosity - ! Include blend between original Prandtl model and Ainslie to avoid issues when wake turbulence goes to 0. - ! The largest eddy viscosity at each point is applied. - - ! Calculate mean flow gradient - du/dr is created with CDS (apart from 1st and last point) - du_dr_DWM(j-1,1) = (U(j-1,2) - U(j-1,1))/delrad - du_dr_DWM(j-1,2:NINT(R_length*np_r)-1) = ( U(j-1,3:NINT(R_length*np_r-1)+1) - U(j-1,1:NINT(R_length*np_r-1)-1))/(2*delrad) - du_dr_DWM(j-1, NINT(R_length*np_r) ) = ( U(j-1, NINT(R_length*np_r ) ) - U(j-1, NINT(R_length*np_r-1) ))/delrad - - ! %%% Blend of mixL and Ainslie eddy visc - DO I = 1,m%DWDD%n_r_vector - visc_wake1(j-1,I) = F2_vector(j-1)* k2 *( r_vector(b(j-1))/R_WTG )**2 * ABS(du_dr_DWM(j-1,I)); - visc_wake2(j-1,I) = F2_vector(j-1)* k2 *( r_vector(b(j-1))/R_WTG ) * ( 1 - min_of_array( U(j-1,:),SIZE(U(j-1,:)) ) ); - visc_wake (j-1,I) = max( visc_wake1(j-1,I),visc_wake2(j-1,I) ); - END DO - - ! %%% Atmospheric eddy visc as u*l*, yields total eddy viscosity - visc_norm_factor = 6.3918 - DO I = 1,m%DWDD%n_r_vector - visc(j-1,I) = F1_vector(j-1) * k1 * visc_norm_factor * u_star_DEF * l_star_DEF + visc_wake(j-1,I); - END DO - - ! %%%%% Include contribution from atmospheric boundary layer on DWM - ! % 1. Calculate the azimuthally averaged local gradient (du/dr tot) acting of the eddy viscosity as a combination of du/dr in the DWM model and du/dz from ABL - ! % 2. The du/dr contribution is constant in azimuthal direction. The du/dz part is assumed linear, which gives a sinus curve in a du/dr system - - !% Calculate total mean flow gradient - adds shear contribution via - !% sin function. This gets the stresses right, but sign is wrong in - !% regions where du/dr_DWM - sign of du/dz_ABL is negative - - DO I = 1,m%DWDD%n_r_vector - !alfa_1(I) = ASIN(ABS(du_dr_DWM(j-1,I)) / Shear_add_du_dz) - !alfa_2(I) = Pi - alfa_1(I) - - ! % condition for added shear gradient (if du/dr_DWM >= du/dz_ABL there are no contribution) - IF ( ABS(du_dr_DWM(j-1,I)) < Shear_add_du_dz ) THEN - shear_flag(I) = 1 - alfa_1(I) = ASIN(ABS(du_dr_DWM(j-1,I)) / Shear_add_du_dz) - alfa_2(I) = Pi - alfa_1(I) - ELSE - shear_flag(I) = 0 - alfa_1(I) = 0 - alfa_2(I) = 0 - END IF - - - du_dr_tot(j-1,I) = ( ABS(du_dr_DWM(j-1,I))*2*Pi + shear_flag(I)*2*& - ( Shear_add_du_dz*2*COS(alfa_1(I))-ABS(du_dr_DWM(j-1,I))*(alfa_2(I) - alfa_1(I))) )/(2*Pi) - END DO - - ! %%% Use "wiener filter" for numerical stability: 1/f(x) ~= f(x) / (f(x)^2 + k) - k_wiener = 2*Shear_add_du_dz * delrad**2; - DO I = 1,m%DWDD%n_r_vector - One_div_du_dr_DWM(j-1,I) = du_dr_DWM(j-1,I) / (du_dr_DWM(j-1,I)**2 + k_wiener) - visc_fac(I) = max(1.0_ReKi, (du_dr_tot(j-1,I) * ABS(One_div_du_dr_DWM(j-1,I)))) - visc(j-1,I) = visc(j-1,I) * visc_fac(I) - END DO - - - - - - - - - - !!!DO i = 1,m%DWDD%n_r_vector - !!! IF ( ABS(du_dr_DWM(j-1,i)) >= du_dz_ABL ) THEN - !! ! A_total = 2*Pi*du_dr_DWM(j-1,i) - !!! ELSE - !!! ytemp = du_dr_DWM(j-1,i) - !!! xtemp = 2 * shear_correction( du_dr_DWM(j-1,i),du_dz_ABL ) - !!! A_total = 2*Pi*du_dr_DWM(j-1,i) + 2 * shear_correction( du_dr_DWM(j-1,i),du_dz_ABL ) - !!!END IF - !!!du_dr_total(j-1,i) = A_total / (2*Pi) - !!!END DO - - !!!visc_DWM(j-1,:) = F1_vector(j-1)*k1*(TI_original/100) + F2_vector(j-1)* k2 *( r_vector(b(j-1))/R_WTG )**2 * ABS( du_dr_DWM(j-1,:) ) - !!!visc(j-1,:) = visc_DWM(j-1,:) - - - !DO i = 1,m%DWDD%n_r_vector - !mtemp = du_dr_total(j-1,i) - !ntemp = du_dr_DWM(j-1,i) - !IF (ABS( du_dr_DWM(j-1,i) < 0.0001 ) ) THEN - ! visc(j-1,i) = visc_DWM(j-1,i) * du_dr_total(j-1,i) * ABS( du_dr_DWM(j-1,i)/(du_dr_DWM(j-1,i)**2 + k_wiener) ) - !ELSE - ! visc(j-1,i) = visc_DWM(j-1,i) * du_dr_total(j-1,i) / ABS( du_dr_DWM(j-1,i) ) - !END IF - !visc(j-1,i) = visc_DWM(j-1,i) * du_dr_total(j-1,i) * ABS( 1/du_dr_DWM(j-1,i)) - !END DO - - mat=0 - ! ====SHORT INSTRUCIONS TO SOLVE RUTINE: - ! The terms LHS and RHS (left/right hand side) refers to the terms of - ! the coefficient matrix developed to solve the then shear layer - ! approximation of NS. The numbers indicate the position in the equation, - ! ex LHS21 is the 2nd part of the 1st term on the left side in eq.2.8, - ! see document "Numerical implementation of DWM deficit module" for details. - - ! Input BC for wake center - - LHS2 = U(j-1,1)/delaxi + (2*visc(j-1,1)/(delrad**2)) - LHS3 = -(2*visc(j-1,1) /(delrad**2)) - RHS(1) = (U(j-1,1)**2 / delaxi) - mat(1,1) = LHS2 - mat(2,1) = LHS3 - - ! Calculation of U for the wake body - DO i=2,(m%DWDD%n_r_vector-1),1 ! starts from the point next to the hub center - LHS11 = -V(j-1,i) / (2*delrad) - LHS21 = visc(j-1,i) / (2*r_vector(i)*delrad) - LHS31 = -visc(j-1,i) / (delrad**2) - LHS41 = (visc(j-1,i+1) - visc(j-1,i-1)) / (2*delrad)**2; ! new term due to d(nu_t)/dr dependence - LHS12 = U(j-1,i) / (delaxi) - LHS22 = 2*visc(j-1,i) / (delrad**2) - LHS13 = V(j-1,i) / (2*delrad) - LHS23 = -visc(j-1,i) / (2*r_vector(i)*delrad) - LHS33 = -visc(j-1,i) / (delrad**2) - LHS43 = -(visc(j-1,i+1) - visc(j-1,i-1)) / (2*delrad)**2; ! new term due to d(nu_t)/dr dependence - LHS1 = LHS11 + LHS21 + LHS31 + LHS41 - LHS2 = LHS12 + LHS22 - LHS3 = LHS13 + LHS23 + LHS33 + LHS43 - RHS(i) = (U(j-1,i)**2 / delaxi) - ! Build the matrix for X =A/B - mat(i-1,i) = LHS1 - mat(i ,i) = LHS2 - mat(i+1,i) = LHS3 - END DO - - ! Input BC for wake edge - LHS1 = 0 - LHS2 = 1/delaxi - RHS(NINT(R_length*np_r)) = (U(j-1,NINT(R_length*np_r))/ delaxi) - mat(NINT(R_length*np_r)-1, NINT(R_length*np_r) ) = LHS1 - mat(NINT(R_length*np_r) , NINT(R_length*np_r) ) = LHS2 - - ! Solve for the U - ! Use Gauss-Jordan elimination - AugMat (1:m%DWDD%n_r_vector, 1:m%DWDD%n_r_vector) = TRANSPOSE(mat) - AugMat (: , m%DWDD%n_r_vector+1) = RHS - NumEqu = m%DWDD%n_r_vector - !CALL Gauss(AugMat, NumEqu, Soln) - !U(j,:)=Soln - - ! === USE Thomas Algorithm to solve the matrix ==== 6.30.2014 - main_diagonal (1) = AugMat(1,1) - sub_diagonal (1) = 0 ! means it is the diagonal below the main diagonal - sup_diagonal (1) = AugMat(1,2) ! means it is the diagonal above the main diagonal - - DO I = 2,m%DWDD%n_r_vector-1 - main_diagonal (I) = AugMat(I,I) - sub_diagonal (I) = AugMat(I,I-1) - sup_diagonal (I) = AugMat(I,I+1) - END DO - - main_diagonal (m%DWDD%n_r_vector) = AugMat(m%DWDD%n_r_vector, m%DWDD%n_r_vector) - sub_diagonal (m%DWDD%n_r_vector) = AugMat(m%DWDD%n_r_vector, m%DWDD%n_r_vector-1) - sup_diagonal (m%DWDD%n_r_vector) = 0 - - CALL Thomas_diagonal (sub_diagonal, main_diagonal, sup_diagonal, RHS, Soln, NumEqu) - U(j,:)=Soln - - ! === Solve for V - DO i = 1,NINT(R_length)*np_r-1,1 - V(j,i+1) = (r_vector(i) / r_vector(i+1)) * V(j,i) -(delrad/(2*delaxi))*( (U(j,i+1) - U(j-1,i+1)) + & - (r_vector(i) / r_vector(i+1)) * ((U(j,i) - U(j-1,i))) ) - END DO - - ! POST PROCESSING SIGNAL: Turbulent stress - DO i=1,m%DWDD%n_r_vector,1 - !m%DWDD%Turb_Stress_DWM(j-1,i) = visc_DWM(j-1,i) * du_dr_total(j-1,i) - m%DWDD%Turb_Stress_DWM(j-1,i) = visc(j-1,i) * du_dr_DWM(j-1,i) - END DO - - ! Control calculatoins of mass flux over cells - - !!DO i=1,m%DWDD%n_r_vector-1,1 - !! VOL_x_jhigh(j-1,i) = (Pi/3) *((U(j,i) *(r_vector(i+1)**3 - (3 *r_vector(i)**2 *r_vector(i+1)) + 2 *r_vector(i)**3)) +& - !! (U(j,i+1) *(r_vector(i)**3 - (3*r_vector(i+1)**2 *r_vector(i)) + 2 *r_vector(i+1)**3)))/ delrad - !! VOL_x_jlow(j-1,i) = (Pi/3) *((U(j-1,i) *(r_vector(i+1)**3 - (3*r_vector(i)**2 *r_vector(i+1)) + 2 *r_vector(i)**3)) +& - !! (U(j-1,i+1) *(r_vector(i)**3 - (3*r_vector(i+1)**2 *r_vector(i)) + 2 *r_vector(i+1)**3)))/ delrad - !! VOL_r_ilow(j-1,i) = Pi * r_vector(i) * (V(j-1,i)+V(j,i)) * delaxi - - !! V(j,i+1) = ((VOL_x_jlow(j-1,i) - VOL_x_jhigh(j-1,i) + VOL_r_ilow(j-1,i)) / (Pi*(r_vector(i+1)) *delaxi)) - V(j-1,i+1) !! changed to version 2 2012/4/11 - !! VOL_r_ihigh(j-1,i) = Pi * r_vector(i+1) * (V(j-1,i+1)+V(j,i+1)) * delaxi - !! specificly U_face for mass flow and momentum calculations - !! U_face(j-1,i) = VOL_x_jlow(j-1,i) / (Pi*((r_vector(i+1)**2)-(r_vector(i))**2)) - !!END DO - - END DO - - b(m%DWDD%n_x_vector) = b(m%DWDD%n_x_vector-1) - - IF (ALLOCATED( V )) DEALLOCATE ( V ) - IF (ALLOCATED( visc )) DEALLOCATE ( visc ) - IF (ALLOCATED( du_dr_DWM )) DEALLOCATE ( du_dr_DWM ) - !IF (ALLOCATED( m%DWDD%Turb_Stress_DWM )) DEALLOCATE ( m%DWDD%Turb_Stress_DWM ) - !IF (ALLOCATED( TI_DWM )) DEALLOCATE ( TI_DWM ) - !IF (ALLOCATED( U_face )) DEALLOCATE ( U_face ) - !IF (ALLOCATED( VOL_x_jhigh )) DEALLOCATE ( VOL_x_jhigh ) - !IF (ALLOCATED( VOL_x_jlow )) DEALLOCATE ( VOL_x_jlow ) - !IF (ALLOCATED( VOL_r_ihigh )) DEALLOCATE ( VOL_r_ihigh ) - !IF (ALLOCATED( VOL_r_ilow )) DEALLOCATE ( VOL_r_ilow ) - IF (ALLOCATED( r_vec_DWM )) DEALLOCATE ( r_vec_DWM ) - IF (ALLOCATED( dA_DWM )) DEALLOCATE ( dA_DWM ) - IF (ALLOCATED( bin_filter )) DEALLOCATE ( bin_filter ) - IF (ALLOCATED( xi )) DEALLOCATE ( xi ) - IF (ALLOCATED( U_tmp_1 )) DEALLOCATE ( U_tmp_1 ) - IF (ALLOCATED( U_tmp_2 )) DEALLOCATE ( U_tmp_2 ) - IF (ALLOCATED( U_tmp )) DEALLOCATE ( U_tmp ) - IF (ALLOCATED( mat )) DEALLOCATE ( mat ) - IF (ALLOCATED( U_tmp )) DEALLOCATE ( U_tmp ) - IF (ALLOCATED( RHS )) DEALLOCATE ( RHS ) - IF (ALLOCATED( Soln )) DEALLOCATE ( Soln ) - IF (ALLOCATED( AugMat )) DEALLOCATE ( AugMat ) - - !OPEN(unit = 10, status='replace',file='sizeof_Uvelocity_2nd.bin',form='unformatted') ! create sizeof_Uvelocity_2nd.bin, or overwrite an existing on - !WRITE(10) m%DWDD%ppR,Domain_R ! write the length of the velocity vector - !CLOSE(10) - - !OPEN(unit = 10, status='replace',file='DWM\results\Uvelocity.bin',form='unformatted') - !WRITE(10) U(floor(spacing_turbine * m%DWDD%ppR)+1,:) ! write the wind data of the plane where the downstream turbine locates - !CLOSE(10) - - !OPEN (unit=25,file="DWM\results\wake_width.txt") - !WRITE (25,'(I5)'), b(:) - !close(25) - - -END SUBROUTINE calculate_wake - -!--------------------------------------------------------------------------------------------- -SUBROUTINE Thomas_diagonal (lowerDia, mainDia, upperDia, RightHS, SolnVec, NumEq) -!............................................................................................. -! This function returns the F1 filter function -!............................................................................................. - - INTEGER :: NumEq - - REAL(ReKi) :: lowerDia(NumEq) - REAL(ReKi) :: mainDia(NumEq) - REAL(ReKi) :: upperDia(NumEq) - REAL(ReKi) :: RightHS(NumEq) - REAL(ReKi) :: SolnVec(NumEq) - - REAL(ReKi) :: cp_vec(NumEq) - REAL(ReKi) :: dp_vec(NumEq) - REAL(ReKi) :: temp - INTEGER :: I - - ! initialize c-prime and d-prime - cp_vec(1) = upperDia(1) / mainDia(1) - dp_vec(1) = RightHS(1) / mainDia(1) - - ! solve for vectors c-prime and d-prime - DO I = 2,NumEq - temp = mainDia(i) - cp_vec(i-1)*lowerDia(i) - cp_vec(i) = upperDia(i)/temp - dp_vec(i) = (RightHS(i)-dp_vec(i-1)*lowerDia(i))/temp - END DO - - ! initialized SolnVec - SolnVec(NumEq) = dp_vec(NumEq) - - ! solve for x from the vectors c-prime and d-prime - DO I = NumEq-1, 1,-1 - SolnVec(i) = dp_vec(i) - cp_vec(i)*SolnVec(i+1) - END DO - -END SUBROUTINE Thomas_diagonal - -!--------------------------------------------------------------------------------------------- -SUBROUTINE create_F1_filter (F1_vector, filter1, length_F1_vector,np_x,X_length) -!............................................................................................. -! This function returns the F1 filter function -!............................................................................................. - REAL(ReKi),ALLOCATABLE :: F1_vector(:) - REAL(ReKi) :: filter1(2) - INTEGER :: length_F1_vector - INTEGER :: np_x - REAL(ReKi) :: X_length - - INTEGER :: length_F1_vector_1 - INTEGER :: length_F1_vector_2 - REAL(ReKi),ALLOCATABLE :: F1_vector_1(:) - REAL(ReKi),ALLOCATABLE :: F1_vector_2(:) - INTEGER :: I - - length_F1_vector_1 = floor(filter1(2)*np_x/2) - length_F1_vector_2 = floor(X_length*np_x/2) - length_F1_vector = length_F1_vector_1 + length_F1_vector_2 - ALLOCATE (F1_vector_1(length_F1_vector_1)) - ALLOCATE (F1_vector_2(length_F1_vector_2)) - ALLOCATE (F1_vector (length_F1_vector )) - - F1_vector_1 = ( (1-filter1(1)) /(length_F1_vector_1-1 ) )*[(i,i=1,length_F1_vector_1)]+(0-( (1-filter1(1) )/(length_F1_vector_1-1 ) )) - !r_vector = ( (R_length-delrad)/(n_r_vector-1 ) )*[(i,i=1,n_r_vector)]+(0-( (R_length-delrad)/(n_r_vector-1) )) - F1_vector_2 = 1 - - F1_vector = (/F1_vector_1,F1_vector_2/) - -END SUBROUTINE create_F1_filter - -!--------------------------------------------------------------------------------------------- -SUBROUTINE create_F2_filter (F2_vector, filter2, np_x, length_F1_vector) -!............................................................................................. -! This function returns the F2 filter function -!............................................................................................. - REAL(ReKi),ALLOCATABLE :: F2_vector(:) - REAL(ReKi) :: filter2(2) - INTEGER :: np_x - INTEGER :: length_F1_vector - - REAL(ReKi),ALLOCATABLE :: F2_vector_x(:) - REAL(ReKi),ALLOCATABLE :: F2_vector_1(:) - REAL(ReKi),ALLOCATABLE :: F2_vector_2(:) - INTEGER :: length_F2_vector_x - INTEGER :: length_F2_vector_1 - INTEGER :: length_F2_vector_2 - INTEGER :: length_F2_vector - INTEGER :: I - - length_F2_vector_x = floor(( REAL(length_F1_vector,ReKi) * (1/REAL(np_x,ReKi)) - (2+1/REAL(np_x,ReKi)) ) / (1/REAL(np_x,ReKi)) + 1) - length_F2_vector_1 = 2*np_x - length_F2_vector_2 = length_F2_vector_x - length_F2_vector = length_F2_vector_1 + length_F2_vector_2 - - ALLOCATE ( F2_vector_x(length_F2_vector_x) ) - ALLOCATE ( F2_vector_1(length_F2_vector_1) ) - ALLOCATE ( F2_vector_2(length_F2_vector_2) ) - ALLOCATE ( F2_vector (length_F2_vector ) ) - - F2_vector_x = ( (length_F1_vector * (1/REAL(np_x,ReKi)) - (2+1/REAL(np_x,ReKi))) /(length_F2_vector_x-1 ) )*[(i,i=1,length_F2_vector_x)]+(2+1/REAL(np_x,ReKi)-( (length_F1_vector * (1/REAL(np_x,ReKi)) - (2+1/REAL(np_x,ReKi))) /(length_F2_vector_x-1 ) )) - F2_vector_1 = filter2(1) - - DO I = 1,length_F2_vector_2 - F2_vector_2(I) = 1-(1-filter2(1))*EXP(-filter2(2)*(F2_vector_x(I)-2)) - END DO - - F2_vector = (/F2_vector_1,F2_vector_2/) - -END SUBROUTINE create_F2_filter - -!---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE Gauss( AugMatIn, NumEq, SolnVec ) -!.................................................................................................................................. -! This routine uses the Gauss-Jordan elimination method for the solution of -! a given set of simultaneous linear equations. -! NOTE: this routine works if no pivot points are zero and you don't want -! the eschelon or reduced eschelon form of the augmented matrix. The form of -! the original augmented matrix IS preserved in this call. -!.................................................................................................................................. - IMPLICIT NONE - - - ! Passed variables: - - INTEGER(4), INTENT(IN ) :: NumEq ! Number of equations in augmented matrix. - - REAL(ReKi), INTENT(IN ) :: AugMatIn (NumEq,( NumEq + 1 )) ! Augmented matrix passed into this subroutine. - REAL(ReKi), INTENT(OUT) :: SolnVec (NumEq) ! Solution vector. - - - ! Local variables: - - REAL(ReKi) :: AugMat (NumEq,( NumEq + 1 )) ! A copy of the augmented matrix. - - INTEGER(4) :: I ! Steps through columns - INTEGER(4) :: J ! Steps through rows - INTEGER(4) :: L ! Steps through rows - INTEGER(4) :: NAug ! Column dimension of augmented matrix - - - - ! Transfer the data from AugMatIn to AugMat: - - AugMat = AugMatIn - - - ! Find the column dimension of the augmented matrix: - - NAug = NumEq + 1 - - - ! Perform Gauss-Jordan elimination and store the solution vector - ! in the last column of the augmented matrix: - - DO L = 1,NumEq ! Loop through all rows - DO I = ( L + 1 ), NAug ! Loop through all columns above current row number - AugMat(L,I) = AugMat(L,I) / AugMat(L,L) - DO J = 1,NumEq ! Loop through all rows except L - IF ( J /= L ) AugMat(J,I) = AugMat(J,I) - ( AugMat(J,L)*AugMat(L,I) ) - ENDDO ! J - All rows except L - ENDDO ! I - All columns above current row number - ENDDO ! L - All rows - - - ! Transfer the solution vector from AugMat() to SolnVec(): - - SolnVec = AugMat(:,NAug) - - - - RETURN - -END SUBROUTINE Gauss - -!---------------------------------------------------------------------------------------------------------------------------------- -FUNCTION shear_correction (du_dr_dwm,du_dz) -!.................................................................................................................................. -! This function returns the shear correction factor A1 and A2 -!.................................................................................................................................. - IMPLICIT NONE - - REAL(ReKi) :: shear_correction - REAL(ReKi) :: du_dr_dwm - REAL(ReKi) :: du_dz ! du_dz_abl - - ! Internal variables - REAL(ReKi) :: alpha_1 - REAL(ReKi) :: alpha_2 - REAL(ReKi) :: temp_integration - REAL(ReKi) :: correction_factor - REAL(ReKi),ALLOCATABLE :: alpha_array(:) - REAL(ReKi) :: delta_alpha - INTEGER(IntKi) :: I - INTEGER(IntKi) :: temp_n - - alpha_1 = ASIN(du_dr_dwm/du_dz) - alpha_2 = Pi/2 - alpha_1 - temp_integration = 0 - - temp_n = 100 - ALLOCATE ( alpha_array (temp_n) ) - - alpha_array = ((alpha_2-alpha_1)/(temp_n-1))*[(i,i=1,temp_n)]+(alpha_1-((alpha_2-alpha_1)/(temp_n-1))) - delta_alpha = (alpha_2-alpha_1)/(temp_n-1) - - DO I = 1,temp_n - temp_integration = du_dz * SIN(alpha_array(I)) * delta_alpha + temp_integration - END DO - - shear_correction = temp_integration - (alpha_2 - alpha_1) * du_dr_dwm - - IF (ALLOCATED( alpha_array )) DEALLOCATE ( alpha_array ) - -END FUNCTION shear_correction - -!------------------------------------------------------------------------------- -FUNCTION filter_velocity (OS,m,p,u,x,xd,z,y,timestep,y_0,z_0,wake_radius) -!............................................................................... -! This function is called to calculate the filtered wake velocity -! The filter is a low pass filter -! The output is the filtered wake velocity at a certain wake center -!............................................................................... - !USE DWM_Wake_Deficit_Data, ONLY: m%DWDD%ppR - !USE filter_velocity_data - USE InflowWind - - TYPE(DWM_OtherStateType), INTENT(IN ) :: OS - TYPE(DWM_MiscVarType), INTENT(INOUT) :: m - TYPE(DWM_ParameterType), INTENT(IN ) :: p - TYPE(DWM_OutputType), INTENT(INOUT) :: y - TYPE(DWM_InputType), INTENT(INOUT) :: u ! An initial guess for the input; input mesh must be defined - TYPE(DWM_ContinuousStateType), INTENT(INOUT) :: x ! Initial continuous states - TYPE(DWM_DiscreteStateType), INTENT(INOUT) :: xd ! Initial discrete states - TYPE(DWM_ConstraintStateType), INTENT(INOUT) :: z ! Initial guess of the constraint states - - - REAL(DbKi) :: timestep ! upper limit = usable time + grid width / mean wind speed %%% will change wrt wind speed - ! = second / 0.05 timestep >= 1 - REAL(ReKi) :: y_0 ! wake center point - REAL(ReKi) :: z_0 - INTEGER :: wake_radius ! b(:) in cal_mixl - REAL(ReKi) :: filter_velocity (3) ! only v,w components - - INTEGER :: number_counter ! counter : how many points are in the circle - INTEGER :: radius_length ! wake radius (meters) - INTEGER :: y_axis - INTEGER :: z_axis - REAL(ReKi) :: temp_filter_velocity (3) ! interpolation function, has u,v,w three components - REAL(ReKi) :: temp_wind_velocity (3) - - INTEGER( IntKi ) :: ErrStat ! Error status of the operation - CHARACTER :: ErrMsg ! Error message if ErrStat /= ErrID_None - - - !Print*, y_0 - - temp_filter_velocity = 0.0 - number_counter = 0 - !radius_length = NINT( wake_radius/m%DWDD%ppR*p%RotorR ) ! R(m): turbine radius - radius_length = NINT(2*p%RotorR ) - - IF (.NOT. ALLOCATED(u%IfW%PositionXYZ) ) THEN - CALL AllocAry( u%IfW%PositionXYZ, 3, 1, "Position array to send to IfW_CalcOutput", ErrStat, ErrMsg ) - IF (ErrStat >= AbortErrLev) RETURN - END IF - - DO y_axis = NINT(y_0-radius_length),NINT(y_0+radius_length),1 - !IF (y_axis > p%WFLowerBd) THEN ! add 9/25/2014 - DO z_axis = NINT(z_0-radius_length),NINT(z_0+radius_length),1 - IF ( z_axis > p%WFLowerBd ) THEN !(make sure the circle does not exceed wind field) - IF ( ((y_axis-y_0)**2+(z_axis-z_0)**2)**0.5 <= radius_length ) THEN - - - - u%IfW%PositionXYZ(1,1) = 0.0 - u%IfW%PositionXYZ(2,1) = REAL(y_axis,ReKi) - u%IfW%PositionXYZ(3,1) = REAL(z_axis,ReKi) - CALL InflowWind_CalcOutput( timestep, u%IfW, p%IfW, x%IfW, xd%IfW, z%IfW, OS%IfW, y%IfW, m%IfW, ErrStat, ErrMsg ) - temp_wind_velocity (:) = y%IfW%VelocityUVW(:,1) - - !temp_filter_velocity(:) = temp_filter_velocity(:) + AD_WindVelocityWithDisturbance( REAL(timestep,ReKi), A_u, A_p, A_x, A_xd, A_z, A_O, A_y, ErrStat, ErrMsg,& - !(/0.0,REAL(y_axis,ReKi),REAL(z_axis,ReKi)/) ) - temp_filter_velocity(:) = temp_filter_velocity(:) + temp_wind_velocity(:) - - !+ AD_GetUndisturbedWind ( (REAL(timestep,ReKi)), (/0.0,& - !REAL(y_axis,ReKi),REAL(z_axis,ReKi)/), ErrStat) - - ! AD_GetUndisturbedWind ( (REAL(timestep,ReKi)/20.0)-315.0, (/0.0,& - !REAL(y_axis,ReKi),REAL(z_axis,ReKi)/), ErrStat) - number_counter = number_counter + 1 - END IF - END IF - END DO - !END IF - END DO - - filter_velocity (1) = temp_filter_velocity(1) / number_counter - - filter_velocity (2) = temp_filter_velocity(2) / number_counter ! Filtered V velocity in the certain radius circle - - filter_velocity (3) = temp_filter_velocity(3) / number_counter ! Filtered W velocity in the certain radius circle - -END FUNCTION filter_velocity - -!--------------------------------------------------------------------------------- -SUBROUTINE Get_wake_center ( OS, m, p, y, u, x, xd, z, wakewidth, wake_center ) -!................................................................................ -! This routine is called to calculate the wake center of a specific release time -! and flying time wind plane. -! The wake center is passed to the filter to calculate the averaged wind velocity for -! the downstream turbine. -!................................................................................. - !USE DWM_Wake_Deficit_Data, ONLY : m%DWDD%n_x_vector,m%DWDD%ppR - !USE MeanderData - !USE DWM_ParameterType, ONLY : p%WakePosition_1, p%WakePosition_2, p%hub_height, p%TurbRefHt, p%Uambient - !USE BLADE, ONLY : R - !USE AeroDyn_Types - USE InflowWind - - TYPE(DWM_OtherStateType), INTENT(IN ) :: OS - TYPE(DWM_MiscVarType), INTENT(INOUT) :: m - TYPE(DWM_ParameterType), INTENT(IN ) :: p ! Parameters - TYPE(DWM_OutputType), INTENT(INOUT) :: y - TYPE(DWM_InputType), INTENT(INOUT) :: u ! An initial guess for the input; input mesh must be defined - TYPE(DWM_ContinuousStateType), INTENT(INOUT) :: x ! continuous states - TYPE(DWM_DiscreteStateType), INTENT(INOUT) :: xd ! discrete states - TYPE(DWM_ConstraintStateType), INTENT(INOUT) :: z ! constraint states - - REAL(ReKi), ALLOCATABLE, INTENT(INOUT) :: wake_center (:,:,:) !bjj: this is actually y%wake_position - INTEGER, ALLOCATABLE, INTENT(INOUT) :: wakewidth(:) - - ! local variables - - REAL(ReKi) :: Modified_U - INTEGER :: release_time - INTEGER :: flying_time - INTEGER :: simulation_time_length - REAL(DbKi) :: DWM_time_step - REAL(ReKi) :: temp_center_wake (3) - REAL(ReKi) :: temp_velocity (3) - REAL(ReKi) :: U_Scale_Factor - REAL(ReKi) :: U_factor - REAL(ReKi) :: x_step - - INTEGER( IntKi ) :: ErrStat ! Error status of the operation - CHARACTER :: ErrMsg ! Error message if ErrStat /= ErrID_None - - real(ReKi) :: test_1, test_2 - - !------------------------------------------------------------- - !!m%DWDD%n_x_vector = 1700 - !!ALLOCATE (wakewidth(m%DWDD%n_x_vector)) - !!wakewidth = 50 - !!m%DWDD%ppR = 50 - !--------------------------------------------------------------- - - U_factor = 1.00 - - Modified_U = y%Mean_FFWS * U_factor - - - !------------------------------ TEST --------------------------- - !m%DWDD%ppR = 50 - !allocate (wakewidth(1750)) - !wakewidth(:) = 60 - !--------------------------------------------------------------- - - - DWM_time_step = (2*p%RotorR/m%DWDD%ppR)/Modified_U ! resolution (126m/50) / wind speed (8m/s) => make sure there is always a wake width at every time step - ! D/(DWM_time_step*Mean_FFWS)= 50 which is the X resolution - - U_Scale_Factor = Modified_U / (p%Uambient*U_factor) ! modify the wake displacement error caused by the change of Mean_FFWS - - U_Scale_Factor = 1 ! 7.15.2015 - - simulation_time_length = p%WakePosition_1 !80 in reality, 80*scale_factor*DWM_time_step - ! from 1 to 800 (scale_factor : 800/80=10) to 16D (16*50) - m%meandering_data%moving_time = p%WakePosition_2 !50 from 0 to 49 0: wind turbine plane - ! ppR/scale_factor = 5 presents 1D - - - release_time = simulation_time_length - flying_time = m%meandering_data%moving_time - m%meandering_data%scale_factor = 10 ! to decrease the calculation time - ALLOCATE (wake_center (release_time,flying_time+1,3) ) - ! ex. @8D: (1~release_time,8*[ppR/scale_factor]+1,:) - - DO release_time = 1,simulation_time_length,1 ! wake center position at turbine plane - wake_center (release_time,1,1) = 0 - wake_center (release_time,1,2) = 0 - wake_center (release_time,1,3) = REAL(p%hub_height,ReKi) - END DO - - x_step = Modified_U * (DWM_time_step*m%meandering_data%scale_factor) - - IF (.NOT. ALLOCATED(u%IfW%PositionXYZ) ) THEN - CALL AllocAry( u%IfW%PositionXYZ, 3, 1, "Position array to send to IfW_CalcOutput", ErrStat, ErrMsg ) - IF (ErrStat >= AbortErrLev) RETURN - END IF - - - ! get the initial wake center position of each cross scetion (from the velocity at the turbine plane * dt) - DO release_time=1,simulation_time_length,1 - wake_center (release_time,2,1) = Modified_U * (DWM_time_step*m%meandering_data%scale_factor) +0 - - - !temp_center_wake (:) = AD_WindVelocityWithDisturbance( (REAL(((release_time-1)+1)*DWM_time_step*m%meandering_data%scale_factor,ReKi)), & - !A_u, A_p, A_x, A_xd, A_z, A_O, A_y, ErrStat, ErrMsg, (/0.0,REAL(0,ReKi),REAL(p%TurbRefHt,ReKi)/) ) - !AD_GetUndisturbedWind ( (REAL(((release_time-1)+1)*DWM_time_step*m%meandering_data%scale_factor,ReKi)), (/0.0,& - !REAL(0,ReKi),REAL(p%TurbRefHt,ReKi)/), ErrStat) ! get the velocity at the turbine plane - - u%IfW%PositionXYZ(1,1) = (0.0_ReKi) - u%IfW%PositionXYZ(2,1) = (0.0_ReKi) - u%IfW%PositionXYZ(3,1) = (p%hub_height) - - - CALL InflowWind_CalcOutput( ( ((release_time-1)+1)*DWM_time_step*m%meandering_data%scale_factor), u%IfW, p%IfW, & - x%IfW, xd%IfW, z%IfW, OS%IfW, y%IfW, m%IfW, ErrStat, ErrMsg ) - - temp_center_wake (:) = y%IfW%VelocityUVW(:,1) - !temp_center_wake (3) = y%IfW%Velocity(3,1) - - wake_center (release_time,2,2) = temp_center_wake (2) * (DWM_time_step*m%meandering_data%scale_factor) * U_Scale_Factor + wake_center (release_time,1,2)+ & - local_skew_angle(m%NacYaw, m%ct_tilde, wake_center (release_time,2,1), NINT(m%DWDD%ppR), m%DWDD%ppR) * x_step !+ & - !rotation_lateral_offset( wake_center (release_time,2,1) ) - - wake_center (release_time,2,3) = temp_center_wake (3) * (DWM_time_step*m%meandering_data%scale_factor) * U_Scale_Factor + wake_center (release_time,1,3) - END DO - - - DO flying_time = 2,m%meandering_data%moving_time,1 - DO release_time = 1,simulation_time_length,1 - wake_center (release_time,flying_time+1,1) = wake_center (release_time,flying_time+1-1,1) + Modified_U * (DWM_time_step*m%meandering_data%scale_factor) - - temp_velocity(:) = filter_velocity (OS,m,p,u,x,xd,z,y,((release_time-1)+1)*DWM_time_step*m%meandering_data%scale_factor, wake_center (release_time,flying_time+1-1,2), & - wake_center (release_time,flying_time+1-1,3), wakewidth((flying_time-1)*m%meandering_data%scale_factor) ) - - !!!--------- temp data------ - test_1 = temp_velocity (2) * (DWM_time_step*m%meandering_data%scale_factor) * U_Scale_Factor + wake_center (release_time,flying_time,2)+ & - local_skew_angle(m%NacYaw, m%ct_tilde, wake_center (release_time,flying_time,1), wakewidth((flying_time-1)*m%meandering_data%scale_factor), m%DWDD%ppR) * x_step - test_2 = temp_velocity (3) * (DWM_time_step*m%meandering_data%scale_factor) * U_Scale_Factor + wake_center (release_time,flying_time,3) - !!!------------------------- - - wake_center (release_time,flying_time+1,2) = temp_velocity (2) * (DWM_time_step*m%meandering_data%scale_factor) * U_Scale_Factor + wake_center (release_time,flying_time,2)+ & - local_skew_angle(m%NacYaw, m%ct_tilde, wake_center (release_time,flying_time,1), wakewidth((flying_time-1)*m%meandering_data%scale_factor), m%DWDD%ppR) * x_step !+ & - !rotation_lateral_offset( wake_center (release_time,flying_time+1,1) ) - & - !rotation_lateral_offset( wake_center (release_time,flying_time, 1) ) - - wake_center (release_time,flying_time+1,3) = temp_velocity (3) * (DWM_time_step*m%meandering_data%scale_factor) * U_Scale_Factor + wake_center (release_time,flying_time,3) - - - END DO - END DO - - - -END SUBROUTINE Get_wake_center - -!------------------------------------------------------------------------------------------------ -FUNCTION shifted_velocity( ZTime, p, m, y, z, upwind_mean_u, Uwake, WakeCenter,spacing,angle) -!............................................................................ -! This routine is called to get the DWM wake velocity at a certain point in the downstream turbine plane -! Consideirng the meandered wake center -! Uwake(:) is the axial velocity of the wake at the downstream turbine plane -! WakeCenter(:,:,:) is the wake center (y,z) at the downstream turbine plane -!............................................................................ - - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !USE SimCont, ONLY: ZTime - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - !USE DWM_Wake_Deficit_Data, ONLY: m%DWDD%ppR - !USE DWM_ParameterType, ONLY: p%Wind_file_Mean_u,p%hub_height,p%TurbRefHt - - TYPE(DWM_MiscVarType), INTENT(IN ) :: m - TYPE(DWM_ParameterType), INTENT(IN ) :: p ! Parameters - - REAL(DbKi), INTENT(IN ) :: ZTime - REAL(ReKi), intent(in) :: y,z ! point location on the y,z axis - REAL(ReKi), intent(in) :: Uwake(:) ! axial velocity of the wake at the downstream turbine plane - REAL(ReKi), intent(in) :: upwind_mean_u ! the mean velocity of the turbine UPstream - REAL(ReKi), intent(in) :: WakeCenter(:,:,:) ! wake_center - REAL(ReKi), intent(in) :: spacing ! the distance from the downstream turbine to the upstream turbine - REAL(ReKi), intent(in) :: angle ! the angle between the investigated turbine and the line connecting the upwind turbine and wind origin - - REAL(ReKi) :: shifted_velocity ! the output - ! the velocity at a certain point - - REAL(ReKi) :: distance ! the distance from the point to the meandered wake center - REAL(ReKi) :: y0 ! wake center position on y axis - REAL(ReKi) :: z0 ! wake center position on z axis - REAL(ReKi) :: unit ! single unit length R/ppR - REAL(ReKi) :: scale_factor - INTEGER :: p1 - INTEGER :: p2 - INTEGER :: time_position ! to define which plane's wake center is used - REAL(ReKi) :: Yshifted - REAL(ReKi) :: Zshifted - - - !ALLOCATE (Uwake(NINT( m%DWDD%ppR*Rdomain ))) ! the axis symmetrical velocity - !ALLOCATE (WakeCenter( size_of_WakeCenter1,size_of_WakeCenter2,3 )) - - scale_factor = 10 - - time_position = floor(ZTime/( (2*p%RotorR/p%p_p_r/upwind_mean_u/1.00)*scale_factor ))+1 ! ZTime/(DWM_time_step*scale_factor) - - - - y0 = WakeCenter(time_position,FLOOR(spacing*p%p_p_r/scale_factor)+1,2) !+ 2*P%RotorR*spacing*TAN(m%skew_angle) - z0 = WakeCenter(time_position,FLOOR(spacing*p%p_p_r/scale_factor)+1,3) !! - REAL(p%TurbRefHt-p%hub_height) - - Yshifted = y + 2*p%RotorR*spacing*TAN(angle*Pi/180) - Zshifted = z - - distance = ( (Yshifted-y0)**2 + (Zshifted-z0)**2 )**(0.5) - unit=p%RotorR / p%p_p_r - - p1=FLOOR(distance/unit) - p2=p1+1 - IF (p1>0) THEN - shifted_velocity = Uwake(p1)+( Uwake(p2)-Uwake(p1) )*( (distance/unit)-p1 ) ! Weighting method - ELSE - shifted_velocity = Uwake(p2) - END IF - -END FUNCTION shifted_velocity - -!---------------------------------------------------------------------------------- -SUBROUTINE smooth_out_wake(m, p, Uvelocity,Uwake_center,wake_array,spacing,angle,velocity_matrix) -!.................................................................................. -! This routine is called to fillter out the smoothed out upstream wake profile -! The output is the wake_array -! Which is the axisymmetrical wake velocity profile -!.................................................................................. - !USE DWM_Wake_Deficit_Data, ONLY: m%DWDD%n_x_vector, m%DWDD%n_r_vector, m%DWDD%ppR - !USE DWM_ParameterType, ONLY: p%hub_height, p%WakePosition_1 - !USE smooth_out_wake_data, ONLY: m%SmoothOut%length_velocity_array - - TYPE(DWM_ParameterType), INTENT(IN ) :: p ! Parameters - TYPE(DWM_MiscVarType), INTENT(INOUT) :: m - - REAL(ReKi),ALLOCATABLE :: Uvelocity(:,:) - REAL(ReKi),ALLOCATABLE :: Uwake_center(:,:,:) - REAL(ReKi) :: wake_array(:) - REAL(ReKi) :: spacing ! the spacing between two turbines - REAL(ReKi) :: angle ! the angle between the downwind turbine and the line conneting the upwind(investigated) turbine and the wind origin - REAL(ReKi) :: velocity_matrix(:,:) ! the velocity matrix that store the velocity of the downstream turbine plane - - INTEGER,ALLOCATABLE :: counter_array(:) - REAL(ReKi),ALLOCATABLE :: velocity_array(:) - !INTEGER :: m%SmoothOut%length_velocity_array ! the length of velocity_array - INTEGER :: low - INTEGER :: high - INTEGER :: i,j,k,n - INTEGER :: counter - REAL(ReKi) :: y ! y coordinate - REAL(ReKi) :: z ! z coordinate - - !m%SmoothOut%length_velocity_array = NINT(1.2*R) - - !ALLOCATE ( Uvelocity(m%DWDD%n_x_vector,m%DWDD%n_r_vector) ) - !ALLOCATE ( Uwake_center(release_time,flying_time+1,3) ) - IF (ALLOCATED( velocity_array )) DEALLOCATE ( velocity_array ) - IF (ALLOCATED( counter_array )) DEALLOCATE ( counter_array ) - ALLOCATE ( velocity_array (m%SmoothOut%length_velocity_array) ) - !ALLOCATE ( velocity_matrix (2*m%SmoothOut%length_velocity_array,2*m%SmoothOut%length_velocity_array) ) ! twice the size of the velocity array - ALLOCATE ( counter_array (m%SmoothOut%length_velocity_array) ) - !ALLOCATE ( wake_array (p%ElementNum) ) - - velocity_array=0 - velocity_matrix = 0 - counter=0 - counter_array=0 - - !------------------------------------------------------------------------------------------------- - ! get the time averaged velocity matrix - !------------------------------------------------------------------------------------------------- - DO i=1,p%WakePosition_1,1 - DO j=1,2*m%SmoothOut%length_velocity_array,1 ! y axis - DO k=1,2*m%SmoothOut%length_velocity_array,1 ! z axis - y = (0-m%SmoothOut%length_velocity_array) + (j-1) ! y coordinate - z = (p%hub_height-m%SmoothOut%length_velocity_array) + (k-1) ! z coordinate - velocity_matrix(j,k) = velocity_matrix(j,k) + smooth_wake_shifted_velocity( m, p, y, z, Uvelocity(floor(spacing * m%DWDD%ppR)+1,:), Uwake_center(:,:,:),spacing,i,angle) - !velocity_matrix(j,k) = velocity_matrix(j,k) + smooth_wake_shifted_velocity( y, z, Uvelocity(floor(4.4 * m%DWDD%ppR)+1,:), Uwake_center(:,:,:),4.4,i) - END DO - END DO - counter = counter+1 - END DO - - velocity_matrix = velocity_matrix / counter - - !------------------------------------------------------------------------------------------------- - ! get the time averaged axisymmetrical velocity array - !------------------------------------------------------------------------------------------------- - DO i=1,m%SmoothOut%length_velocity_array,1 ! velocity array - DO j=1,2*m%SmoothOut%length_velocity_array,1 ! velocity_matrix (j,:) - DO k=1,2*m%SmoothOut%length_velocity_array,1 ! velocity_matrix (:,k) - y = (0-m%SmoothOut%length_velocity_array) + (j-1) ! y coordinate - z = (p%hub_height-m%SmoothOut%length_velocity_array) + (k-1) ! z coordinate - IF ( ((y-0)**2+(z-p%hub_height)**2)**0.5>(i-1) .and. ((y-0)**2+(z-p%hub_height)**2)**0.5<=i) THEN - velocity_array(i) = velocity_array(i)+velocity_matrix(j,k) - counter_array(i) = counter_array(i)+1 - END IF - END DO - END DO - END DO - - DO i=1,m%SmoothOut%length_velocity_array,1 - velocity_array(i) = velocity_array(i) / counter_array(i) - END DO - - !------------------------------------------------------------------------------------------------- - ! get the wake array at the RELM node point - !------------------------------------------------------------------------------------------------- - - DO i=1,p%ElementNum,1 - low = FLOOR(p%ElementRad(i)) - high = low+1 - wake_array(i) = velocity_array(low) + ( velocity_array(high)-velocity_array(low) )*(p%ElementRad(i)-low) ! Weighting method - END DO - -END SUBROUTINE smooth_out_wake - -!------------------------------------------------------------------------------------------------ -FUNCTION smooth_wake_shifted_velocity( m, p, y_coor, z_coor, Uwake, WakeCenter,spacing,time_position,angle) -!............................................................................ -! This routine is called to get the DWM wake velocity at a certain point in the downstream turbine plane -! Consideirng the meandered wake center -! Uwake(:) is the axial velocity of the wake at the downstream turbine plane -! WakeCenter(:,:,:) is the wake center -! Used to calculate the smoothed out wake profile -! (y,z) at the downstream turbine plane -!............................................................................ - - !USE DWM_ParameterType, ONLY: p%p_p_r, p%hub_height, p%TurbRefHt - !USE MeanderData, ONLY: m%meandering_data%scale_factor - - TYPE(DWM_ParameterType), INTENT(IN ) :: p ! Parameters - TYPE(DWM_MiscVarType), INTENT(INOUT) :: m - - REAL(ReKi) :: y_coor,z_coor ! point location on the y,z axis - REAL(ReKi) :: Uwake(:) ! axial velocity of the wake at the downstream turbine plane - REAL(ReKi) :: WakeCenter(:,:,:) ! wake_center - REAL(ReKi) :: spacing ! the distance from the downstream turbine to the upstream turbine - INTEGER :: time_position ! to define which plane's wake center is used - REAL(ReKi) :: angle ! the angle between the downwind turbine and the line conneting the upwind(investigated) turbine and the wind origin - - REAL(ReKi) :: smooth_wake_shifted_velocity ! the output - ! the velocity at a certain point - REAL(ReKi) :: Yshifted - REAL(ReKi) :: Zshifted - - INTEGER :: p1 - INTEGER :: p2 - REAL(ReKi) :: distance ! the distance from the point to the meandered wake center - REAL(ReKi) :: y0 ! wake center position on y axis - REAL(ReKi) :: z0 ! wake center position on z axis - REAL(ReKi) :: unit ! single unit length R/ppR - - y0 = WakeCenter(time_position,FLOOR(spacing*p%p_p_r/m%meandering_data%scale_factor)+1,2) !+ 2*P%RotorR*spacing*TAN(m%skew_angle) - z0 = WakeCenter(time_position,FLOOR(spacing*p%p_p_r/m%meandering_data%scale_factor)+1,3) !!- REAL(p%TurbRefHt-p%hub_height) - - Yshifted = y_coor + 2*p%RotorR*spacing*TAN(angle*Pi/180) - Zshifted = z_coor - - distance = ( (Yshifted-y0)**2 + (Zshifted-z0)**2 )**(0.5) - unit=p%RotorR/p%p_p_r - - p1=FLOOR(distance/unit) - p2=p1+1 - IF (p1>0) THEN - smooth_wake_shifted_velocity = Uwake(p1)+( Uwake(p2)-Uwake(p1) )*( (distance/unit)-p1 ) ! Weighting method - ELSE - smooth_wake_shifted_velocity = Uwake(p2) - END IF - - -END FUNCTION smooth_wake_shifted_velocity -!---------------------------------------------------------------------------------- -FUNCTION TI_downstream_total (m, p, y, spacing,angle,velocity_matrix) ! name should be calculate_TI_downstream -!.................................................................................. -! This subroutine is called to calculate the TI of the wake deficit -! The method is by the paper of Rolf-Erik -! The output is TI_downstream_matrix which is the TI for each computating node in the DWM domain -!.................................................................................. - !USE DWM_Wake_Deficit_Data, ONLY: m%DWDD%Turb_Stress_DWM, m%DWDD%n_x_vector, m%DWDD%n_r_vector, m%DWDD%ppR - !USE DWM_OutputType, ONLY: m%wake_position,m%wake_u - !USE MeanderData, ONLY: m%meandering_data%moving_time, m%meandering_data%scale_factor - !USE DWM_ParameterType, ONLY: p%TI_amb, p%hub_height,p%TurbRefHt,p%Uambient,p%WakePosition_1 - !USE smooth_out_wake_data, ONLY: m%SmoothOut%length_velocity_array - !USE BLADE, ONLY: R - - TYPE(DWM_ParameterType), INTENT(IN ) :: p ! Parameters - TYPE(DWM_MiscVarType), INTENT(INOUT) :: m - TYPE(DWM_OutputType), INTENT(INOUT) :: y - - REAL(ReKi) :: TI_downstream_total ! TI of a downstream turbine - REAL(ReKi) :: spacing ! the spacing between the downwind turbine and this upwind turbine - REAL(ReKi) :: angle ! the angle between the downwind turbine and the line connecting this upwind turbine and the wind direction - REAL(ReKi) :: velocity_matrix(:,:) ! the velocity matrix at the certain downswind turbine - - ! local variables - REAL(ReKi), ALLOCATABLE :: TI_downstream_matrix(:,:) - INTEGER :: i,j,k - INTEGER :: cross_plane_position_ds ! the cross plane position which to be investigated in term of the flying time - INTEGER :: cross_plane_position_TI ! the cross plane position which to be investigated in term of the m%DWDD%n_x_vector - INTEGER :: distance_index ! the index of the distance in the TI axisymmetric array - INTEGER :: counter1 - INTEGER :: counter2 - INTEGER :: initial_timestep - REAL(ReKi) :: y_axis_turbine - REAL(ReKi) :: z_axis_turbine - REAL(ReKi) :: distance ! the distance between one point to the meandered wake center - REAL(ReKi) :: TI_downstream_node ! the TI at a specfic point in the inbestigated cross plane - REAL(ReKi) :: TI_node_temp - REAL(ReKi) :: TI_node - REAL(ReKi) :: TI_accumulation - REAL(ReKi) :: TI_apprant_accumulation - REAl(ReKi) :: TI_average ! THE AVERAGE TI OF THE CROSS PLANE - REAL(ReKi) :: TI_apprant ! The TI due to the meadering - REAL(ReKi) :: HubHt - REAL(ReKi) :: wake_center_y - REAL(ReKi) :: wake_center_z - REAL(ReKi) :: Rscale - REAL(ReKi) :: y_coor - REAL(ReKi) :: z_coor - REAL(ReKi) :: zero_spacing - REAL(ReKi) :: temp1,temp2,temp3 - REAL(ReKi) :: c_uw - - !------------------------------------------------------------------------------------------------- - ! calculate the TI at each node at the downstream turbine plane from the wake deficit calculation - !------------------------------------------------------------------------------------------------- - IF (ALLOCATED( TI_downstream_matrix )) DEALLOCATE ( TI_downstream_matrix ) - ALLOCATE (TI_downstream_matrix(m%DWDD%n_x_vector,m%DWDD%n_r_vector)) - c_uw = (0.7550 - m%TI_original/100 *1.75) / 2 - - DO i=1,m%DWDD%n_x_vector - DO j=1,m%DWDD%n_r_vector - TI_downstream_matrix(i,j) = abs( ( 1/c_uw *m%DWDD%Turb_Stress_DWM(i,j) ) )**0.5 - END DO - END DO - - !------------------------------------------------------------------------------------------------- - ! calculate the TI of the downstream turbine grid considering the meandering effect - !------------------------------------------------------------------------------------------------- - cross_plane_position_TI = ANINT( m%DWDD%ppR*spacing+1 ) - !cross_plane_position_TI = ANINT( m%DWDD%ppR*4.4+1 ) - cross_plane_position_ds = ANINT( (m%DWDD%ppR/m%meandering_data%scale_factor)*spacing+1 ) ! the moving time index of the cross plane in the wake_position(:,:,:) - !cross_plane_position_ds = ANINT( (m%DWDD%ppR/m%meandering_data%scale_factor)*4.4+1 ) - - Rscale = 2 !1.3 - HubHt = p%hub_height - counter1 = 0 - counter2 = 0 - TI_accumulation = 0 - TI_apprant_accumulation = 0 - - DO i=1,p%WakePosition_1,1 - DO j=NINT(HubHt-Rscale*p%RotorR),NINT(HubHt+Rscale*p%RotorR),1 ! Z direction - DO k=1,NINT(2*Rscale*p%RotorR)+1,1 ! Y direction - y_axis_turbine = k-(p%RotorR+1) + 2*p%RotorR*spacing*TAN(angle*Pi/180) ! shift effect - z_axis_turbine = j - - wake_center_y=y%wake_position(i,cross_plane_position_ds,2) !+ 2*P%RotorR*spacing*TAN(m%skew_angle) - wake_center_z=y%wake_position(i,cross_plane_position_ds,3) !!- REAL(p%TurbRefHt-p%hub_height,ReKi) - - distance = ( (y_axis_turbine-wake_center_y)**2 + (z_axis_turbine-wake_center_z)**2)**0.5 - - distance_index = FLOOR(distance/(p%RotorR/m%DWDD%ppR)) + 1 - - TI_node_temp = TI_downstream_matrix( cross_plane_position_TI,distance_index ) - - IF ( TI_node_temp > (y%TI/100*(y%Mean_FFWS/p%Uambient)) ) THEN - TI_node = TI_node_temp - ELSE - TI_node = y%TI/100*(y%Mean_FFWS/p%Uambient) - END IF - - TI_accumulation = TI_accumulation + TI_node - counter1 = counter1+1 - - END DO - END DO - END DO - - TI_average = TI_accumulation / REAL(counter1,ReKi) - - !------------------------------------------------------------------------------------------------- - ! calculate the apprant TI due to the meadering - !------------------------------------------------------------------------------------------------- - zero_spacing = 0 - initial_timestep = 1 - !ALLOCATE (velocity_matrix(2*m%SmoothOut%length_velocity_array,2*m%SmoothOut%length_velocity_array)) - - DO i=1,2*m%SmoothOut%length_velocity_array,1 ! velocity_matrix (i,:) - DO j=1,2*m%SmoothOut%length_velocity_array,1 ! velocity_matrix (i,:) - y_coor = (0-m%SmoothOut%length_velocity_array) + (i-1) ! y coordinate - z_coor = (p%hub_height-m%SmoothOut%length_velocity_array) + (j-1) ! z coordinate - TI_apprant_accumulation = TI_apprant_accumulation + & - !(smooth_wake_shifted_velocity(y,z,m%wake_u(floor(spacing_turbine * m%DWDD%ppR)+1,:), m%wake_position(:,:,:),spacing_turbine,k) - & - !velocity_matrix(i,j))**2 - (velocity_matrix(i,j) - & - smooth_wake_shifted_velocity(m, p, y_coor, z_coor, y%wake_u(floor(spacing * m%DWDD%ppR)+1,:), y%wake_position(:,:,:),zero_spacing,initial_timestep,angle))**2 - !smooth_wake_shifted_velocity(y,z,m%wake_u(floor(4.4 * m%DWDD%ppR)+1,:), m%wake_position(:,:,:),zero_spacing,initial_timestep))**2 - counter2=counter2+1 - END DO - END DO - - TI_apprant = ((TI_apprant_accumulation / REAL(counter2,ReKi))**0.5) - - - !------------------------------------------------------------------------------------------------- - ! calculate the total TI - !------------------------------------------------------------------------------------------------- - !TI_downstream_total = (TI_average**2 + TI_apprant**2)**0.5*100 - - TI_downstream_total = TI_average * 100 - - !OPEN(unit = 10, status='replace',file='DWM\results\Downstream_TI_b4normalization.bin',form='unformatted') - !WRITE(10) TI_total - !CLOSE(10) - - !open (unit=25,file="D:\5MW_simulation\after_release\results\TI.txt") - !write (25,'(f13.7)'), TI_total - - !print*, TI_downstream_matrix(300,120) - -END FUNCTION TI_downstream_total - -!---------------------------------------------------------------------------------- -FUNCTION smallscale_TI (m, p, y, spacing,angle,velocity_matrix) -!.................................................................................. -! This subroutine is called to calculate the smalle scale TI of the wake deficit -! -! -!.................................................................................. - !USE DWM_Wake_Deficit_Data, ONLY: m%DWDD%Turb_Stress_DWM, m%DWDD%n_x_vector, m%DWDD%n_r_vector, m%DWDD%ppR - !USE DWM_OutputType, ONLY: m%wake_position,m%wake_u - !USE MeanderData, ONLY: m%meandering_data%moving_time, m%meandering_data%scale_factor - !USE DWM_ParameterType, ONLY: p%TI_amb, p%hub_height,p%TurbRefHt,p%Uambient,p%WakePosition_1 - !USE smooth_out_wake_data, ONLY: m%SmoothOut%length_velocity_array - !USE BLADE, ONLY: R - - TYPE(DWM_ParameterType), INTENT(IN ) :: p ! Parameters - TYPE(DWM_MiscVarType), INTENT(INOUT) :: m - TYPE(DWM_OutputType), INTENT(INOUT) :: y - - REAL(ReKi) :: spacing ! the spacing between the downwind turbine and this upwind turbine - REAL(ReKi) :: angle ! the angle between the downwind turbine and the line connecting this upwind turbine and the wind direction - REAL(ReKi) :: velocity_matrix(:,:) ! the velocity matrix at the certain downswind turbine - REAL(ReKi) :: smallscale_TI - - ! local variables - REAL(ReKi), ALLOCATABLE :: TI_downstream_matrix(:,:) - INTEGER :: i,j,k - INTEGER :: cross_plane_position_ds ! the cross plane position which to be investigated in term of the flying time - INTEGER :: cross_plane_position_TI ! the cross plane position which to be investigated in term of the m%DWDD%n_x_vector - INTEGER :: distance_index ! the index of the distance in the TI axisymmetric array - INTEGER :: counter1 - INTEGER :: counter2 - INTEGER :: initial_timestep - REAL(ReKi) :: y_axis_turbine - REAL(ReKi) :: z_axis_turbine - REAL(ReKi) :: distance ! the distance between one point to the meandered wake center - REAL(ReKi) :: TI_downstream_node ! the TI at a specfic point in the inbestigated cross plane - REAL(ReKi) :: TI_node_temp - REAL(ReKi) :: TI_node - REAL(ReKi) :: TI_accumulation - REAL(ReKi) :: TI_apprant_accumulation - REAl(ReKi) :: TI_average ! THE AVERAGE TI OF THE CROSS PLANE - REAL(ReKi) :: TI_apprant ! The TI due to the meadering - REAL(ReKi) :: HubHt - REAL(ReKi) :: wake_center_y - REAL(ReKi) :: wake_center_z - REAL(ReKi) :: Rscale - REAL(ReKi) :: y_coor - REAL(ReKi) :: z_coor - REAL(ReKi) :: zero_spacing - REAL(ReKi) :: temp1,temp2,temp3 - - !------------------------------------------------------------------------------------------------- - ! calculate the TI at each node at the downstream turbine plane from the wake deficit calculation - !------------------------------------------------------------------------------------------------- - IF (ALLOCATED( TI_downstream_matrix )) DEALLOCATE ( TI_downstream_matrix ) - ALLOCATE (TI_downstream_matrix(m%DWDD%n_x_vector,m%DWDD%n_r_vector)) - - DO i=1,m%DWDD%n_x_vector - DO j=1,m%DWDD%n_r_vector - TI_downstream_matrix(i,j) = abs( ( 10/3*m%DWDD%Turb_Stress_DWM(i,j) ) )**0.5 - END DO - END DO - - !------------------------------------------------------------------------------------------------- - ! calculate the TI of the downstream turbine grid considering the meandering effect - !------------------------------------------------------------------------------------------------- - cross_plane_position_TI = ANINT( m%DWDD%ppR*spacing+1 ) - !cross_plane_position_TI = ANINT( m%DWDD%ppR*4.4+1 ) - cross_plane_position_ds = ANINT( (m%DWDD%ppR/m%meandering_data%scale_factor)*spacing+1 ) ! the moving time index of the cross plane in the wake_position(:,:,:) - !cross_plane_position_ds = ANINT( (m%DWDD%ppR/m%meandering_data%scale_factor)*4.4+1 ) - - Rscale = 2 !1.3 - HubHt = p%hub_height - counter1 = 0 - counter2 = 0 - TI_accumulation = 0 - TI_apprant_accumulation = 0 - - DO i=1,p%WakePosition_1,1 - DO j=NINT(HubHt-Rscale*p%RotorR),NINT(HubHt+Rscale*p%RotorR),1 ! Z direction - DO k=1,NINT(2*Rscale*p%RotorR)+1,1 ! Y direction - y_axis_turbine = k-(p%RotorR+1) + 2*p%RotorR*spacing*TAN(angle*Pi/180) ! shift effect - z_axis_turbine = j - - wake_center_y=y%wake_position(i,cross_plane_position_ds,2) !+ 2*P%RotorR*spacing*TAN(m%skew_angle) - wake_center_z=y%wake_position(i,cross_plane_position_ds,3) !!- REAL(p%TurbRefHt-p%hub_height) - - distance = ( (y_axis_turbine-wake_center_y)**2 + (z_axis_turbine-wake_center_z)**2)**0.5 - - distance_index = FLOOR(distance/(p%RotorR/m%DWDD%ppR)) + 1 - - TI_node_temp = TI_downstream_matrix( cross_plane_position_TI,distance_index ) - - IF ( TI_node_temp > (y%TI/100*(y%Mean_FFWS/p%Uambient)) ) THEN - TI_node = TI_node_temp - ELSE - TI_node = y%TI/100*(y%Mean_FFWS/p%Uambient) - END IF - - TI_accumulation = TI_accumulation + TI_node - counter1 = counter1+1 - - END DO - END DO - END DO - - TI_average = TI_accumulation / REAL(counter1, ReKi) - - smallscale_TI = TI_average * 100 - -END FUNCTION smallscale_TI - -!------------------------------------------------------------------------------------------------ -SUBROUTINE read_parameter_file( p ) -!............................................................................ -! This routine is called to read the parameter file from the DWM simulation of upstream turbine -! read wake velocity @ the downstream turbine from the upstream wake -! read the meandered wake center -! read the mean velocity of the upstream turbine -!............................................................................ - TYPE(DWM_ParameterType), INTENT(INOUT) :: p - INTEGER :: OPENNUM - INTEGER ErrStat - - CALL GetNewUnit(OPENNUM) - - OPEN(unit = OPENNUM, status='old',file='DWM-driver'//trim(PathSep)//'DWM_parameter.bin',form='unformatted',IOSTAT=ErrStat) ! open an existing file - IF (ErrStat /= 0) CALL ProgAbort('Error opening existing file, "'//'DWM-driver'//trim(PathSep)//'DWM_parameter.bin"' ) - - READ(OPENNUM) p%hub_height, p%RotorR, p%NumWT, p%Uambient, & - p%TI_amb, p%r_domain, p%x_domain, p%p_p_r, & - p%WakePosition_1, p%WakePosition_2, p%WFLowerBd, & - p%Winddir - CLOSE(OPENNUM) ! close the file - - p%Tinfluencer = 1 - - - -END SUBROUTINE read_parameter_file - -!---------------------------------------------------------------------------------- -SUBROUTINE read_turbine_position( m, p, u ) -!.................................................................................. -! This routine is called at the first of the FAST. -! To decide the position of the turbine in a row -! if it is the first turbine or not -!.................................................................................. - - TYPE(DWM_ParameterType), INTENT(INOUT) :: p - TYPE(DWM_MiscVarType), INTENT(INOUT) :: m - TYPE(DWM_InputType), INTENT(INOUT) :: u - - - INTEGER(IntKi) :: N_ARGU - CHARACTER(20) :: SimulationOrder_index_char - !USE read_turbine_position_data - !USE DWM_ParameterType, ONLY: p%NumWT,p%Tinfluencer - - - - INTEGER :: I,J - INTEGER :: MyUn - - N_ARGU = COMMAND_ARGUMENT_COUNT() - IF (N_ARGU < 2) THEN - CALL ProgAbort('Incorrect number of command arguments in DWM. Arg_1=InputFileName, Arg_2=SimulationOrder_Index, Arg_n="DWM"') - END IF - - - CALL GET_COMMAND_ARGUMENT(2, SimulationOrder_index_char) - !print*,SimulationOrder_index_char - READ(SimulationOrder_index_char,*) p%RTPD%SimulationOrder_index - !print*,p%RTPD%SimulationOrder_index - !CALL WrScr(' simulation order index = '//TRIM(Num2LStr(p%RTPD%SimulationOrder_index) ) - - CALL GetNewUnit(MyUn) - - IF ( p%RTPD%SimulationOrder_index /= 0 ) THEN ! exclude the base turbine - !''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' - ! obtain the wind turbine index - !''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' - - ALLOCATE (p%RTPD%Turbine_sort_order(p%NumWT)) - OPEN(unit = MyUn, status='old',file='DWM-results'//trim(PathSep)//'wind_farm_turbine_sort.bin',form='unformatted') ! open an existing file - READ(MyUn) p%RTPD%Turbine_sort_order - CLOSE(MyUn) ! close the file - - - p%RTPD%WT_index = p%RTPD%Turbine_sort_order(p%RTPD%SimulationOrder_index) - - - !''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' - !''''''''''''''''''''''''''''''''''''UPWIND DIRECTION'''''''''''''''''''''''''''''''''''''' - !''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' - ! obtain the index of upwind turbines that affecting this turbine, and the distance/angle - !''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' - IF (p%RTPD%SimulationOrder_index > 0) THEN - ALLOCATE (p%RTPD%TurbineInfluenceData(p%NumWT,p%Tinfluencer ) ) - - OPEN(unit = MyUn, status='old',file='DWM-results'//trim(PathSep)//'turbine_interaction.bin',form='unformatted') - READ(MyUn) p%RTPD%TurbineInfluenceData - CLOSE(MyUn) - - ! obtain the upwind turbine index - ALLOCATE (p%RTPD%upwind_turbine_index(p%Tinfluencer)) - DO I = 1,p%Tinfluencer - p%RTPD%upwind_turbine_index(I) = p%RTPD%TurbineInfluenceData(p%RTPD%WT_index,I) - END DO - - ! calculate the number of upwind turbines affecting the downwind turbine - p%RTPD%upwindturbine_number = 0 - DO I = 1,p%Tinfluencer - IF (p%RTPD%upwind_turbine_index(I) /=0) THEN - p%RTPD%upwindturbine_number = p%RTPD%upwindturbine_number + 1 - END IF - END DO - - ! obtain the upwind turbine coordinates - ALLOCATE (p%RTPD%wind_farm_Xcoor (p%NumWT)) - ALLOCATE (p%RTPD%wind_farm_Ycoor (p%NumWT)) - - OPEN(unit = MyUn, status='old',file='DWM-driver'//trim(PathSep)//'wind_farm_coordinate.bin',form='unformatted') - READ(MyUn) p%RTPD%wind_farm_Xcoor,p%RTPD%wind_farm_Ycoor - CLOSE(MyUn) - - - IF (p%RTPD%upwindturbine_number /= 0) THEN - ALLOCATE(p%RTPD%upwind_turbine_Xcoor(p%RTPD%upwindturbine_number)) - ALLOCATE(p%RTPD%upwind_turbine_Ycoor(p%RTPD%upwindturbine_number)) - DO I = 1,p%RTPD%upwindturbine_number - p%RTPD%upwind_turbine_Xcoor(I) = p%RTPD%wind_farm_Xcoor(p%RTPD%upwind_turbine_index(I)) - p%RTPD%upwind_turbine_Ycoor(I) = p%RTPD%wind_farm_Ycoor(p%RTPD%upwind_turbine_index(I)) - END DO - END IF - - ! obtain the distance beween the upwind turbine and this turbine - ALLOCATE (p%RTPD%turbine_windorigin_length (p%NumWT )) - - OPEN(unit = MyUn, status='old',file='DWM-results'//trim(PathSep)//'turbine_distance.bin',form='unformatted') - READ(MyUn) p%RTPD%turbine_windorigin_length - CLOSE(MyUn) - - - IF (p%RTPD%upwindturbine_number /= 0) THEN - ALLOCATE (p%RTPD%upwind_turbine_projected_distance(p%RTPD%upwindturbine_number)) - DO I = 1,p%RTPD%upwindturbine_number - p%RTPD%upwind_turbine_projected_distance(I) = p%RTPD%turbine_windorigin_length(p%RTPD%WT_index) - p%RTPD%turbine_windorigin_length(p%RTPD%upwind_turbine_index(I)) - END DO - END IF - - - ! obtain the angle beween the line connecting the upwind turbine and this turbine and the wind direction vector - ALLOCATE (p%RTPD%turbine_angle(p%NumWT,p%NumWT)) - - OPEN(unit = MyUn, status='old',file='DWM-results'//trim(PathSep)//'turbine_angles.bin',form='unformatted') - READ(MyUn) p%RTPD%turbine_angle - CLOSE(MyUn) - - IF (p%RTPD%upwindturbine_number /= 0) THEN - ALLOCATE (p%RTPD%upwind_align_angle(p%RTPD%upwindturbine_number)) - DO I = 1,p%RTPD%upwindturbine_number - p%RTPD%upwind_align_angle(I) = p%RTPD%turbine_angle(p%RTPD%upwind_turbine_index(I),p%RTPD%WT_index) - END DO - END IF - - END IF - - !''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' - !''''''''''''''''''''''''''''''''''DOWNWIND DIRECTION'''''''''''''''''''''''''''''''''''''' - !''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' - ! obtain the index of downwind turbines that being affected by this turbine, and the distance/angle - !''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' - - IF (p%RTPD%SimulationOrder_index/=p%NumWT) THEN ! WHEN index = 0, there will not such files (which are generated by the 0 turbine) - - ! obtain the downwind turbine index and calculate the downwind turbine numbers - p%RTPD%downwindturbine_number = 0 - ALLOCATE (p%RTPD%downwind_turbine_index(p%NumWT-1)) - DO I = 1,p%Tinfluencer - DO J = 1,p%NumWT - IF (p%RTPD%TurbineInfluenceData(J,I) == p%RTPD%WT_index) THEN - p%RTPD%downwindturbine_number = p%RTPD%downwindturbine_number + 1 - p%RTPD%downwind_turbine_index(p%RTPD%downwindturbine_number) = J - END IF - END DO - END DO - - ! obtain the downwind turbine coordinates - IF (p%RTPD%downwindturbine_number /= 0) THEN - ALLOCATE(p%RTPD%downwind_turbine_Xcoor(p%RTPD%downwindturbine_number)) - ALLOCATE(p%RTPD%downwind_turbine_Ycoor(p%RTPD%downwindturbine_number)) - DO I = 1,p%RTPD%downwindturbine_number - p%RTPD%downwind_turbine_Xcoor(I) = p%RTPD%wind_farm_Xcoor(p%RTPD%downwind_turbine_index(I)) - p%RTPD%downwind_turbine_Ycoor(I) = p%RTPD%wind_farm_Ycoor(p%RTPD%downwind_turbine_index(I)) - END DO - END IF - - ! obtain the distance beween the upwind turbine and this turbine - IF (p%RTPD%downwindturbine_number/=0) THEN - ALLOCATE (p%RTPD%downwind_turbine_projected_distance(p%RTPD%downwindturbine_number)) - DO I = 1,p%RTPD%downwindturbine_number - p%RTPD%downwind_turbine_projected_distance(I) = p%RTPD%turbine_windorigin_length(p%RTPD%downwind_turbine_index(I)) - p%RTPD%turbine_windorigin_length(p%RTPD%WT_index) - END DO - END IF - - ! obtain the angle beween the line connecting the downwind turbine and this turbine and the wind direction vector - IF (p%RTPD%downwindturbine_number/=0) THEN - ALLOCATE (p%RTPD%downwind_align_angle(p%RTPD%downwindturbine_number)) - DO I = 1,p%RTPD%downwindturbine_number - p%RTPD%downwind_align_angle(I) = p%RTPD%turbine_angle(p%RTPD%WT_index,p%RTPD%downwind_turbine_index(I)) - END DO - END IF - - END IF - END IF - - ! check if the Meandering_Moving_time is valid - DO I = 1,p%RTPD%downwindturbine_number - IF (p%WakePosition_2 < p%RTPD%downwind_turbine_projected_distance(I) * p%p_p_r/10 + 1) THEN - ! bjj: ProgAbort at least is standard fortran (as opposed to "CALL EXIT"), but calling ProgAbort is not allowed in a module in the FAST framework. Please trap your errors and return an error code. - CALL ProgAbort('WARNING: Meandering_Moving_time should be larger than the maximum turbine spacing') - END IF - END DO - -END SUBROUTINE read_turbine_position - -!------------------------------------------------------------------------------------------------ -SUBROUTINE read_upwind_result_file( m, p, u ) -!............................................................................ -! This routine is called to read the results from the DWM simulation of upwind turbines -! and to generate the output variables -!............................................................................ - TYPE(DWM_ParameterType), INTENT(INOUT) :: p - TYPE(DWM_MiscVarType), INTENT(INOUT) :: m - TYPE(DWM_InputType), INTENT(INOUT) :: u - - !USE read_turbine_position_data, ONLY:m%RTPD%upwindturbine_number,m%RTPD%upwind_turbine_index,m%RTPD%WT_index,m%RTPD%downwindturbine_number,m%RTPD%SimulationOrder_index,m%RTPD%Turbine_sort_order - !USE DWM_ParameterType, ONLY:p%p_p_r,p%r_domain,p%WakePosition_1,p%WakePosition_2,p%Wind_file_Mean_u - !USE read_upwind_result - !USE smooth_out_wake_data, ONLY:m%SmoothOut%length_velocity_array - - CHARACTER(LEN=3) :: invetigated_turbine_index_character - CHARACTER(LEN=3) :: upwind_turbine_index_character - CHARACTER(LEN=80) :: filename_u_bin,filename_wakecenter_bin,filename_meanU_bin,filename_TI_bin,filename_smoothWake_bin,filename_smallTI_bin - CHARACTER(LEN=80) :: filename_meanU_txt - CHARACTER(LEN=2) :: Uprefix_bin = 'U_' - CHARACTER(LEN=3) :: WCprefix_bin = 'WC_' - CHARACTER(LEN=7) :: MeanUprefix_bin = 'Mean_U_' - CHARACTER(LEN=3) :: Tiprefix_bin = 'TI_' - CHARACTER(LEN=8) :: smallTIprefix_bin = 'SmallTI_' - CHARACTER(LEN=11) :: SmoothWprefix_bin = 'Smoothwake_' - CHARACTER(LEN=22) :: Prefix = 'DWM-results'//trim(PathSep) - CHARACTER(LEN=4) :: connectionprefix = '_to_' - CHARACTER(LEN=8) :: Turbineprefix = 'Turbine_' - INTEGER :: I - INTEGER :: MyUn - CHARACTER(LEN=3) :: turbine_sort_order_char - - !''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' - ! read the wind file mean velocity at the turbine plane from the very first turbine - !''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' - IF (p%RTPD%SimulationOrder_index > 1) THEN - IF (p%RTPD%Turbine_sort_order(1) <= 9) THEN - write(turbine_sort_order_char,'(i1)') p%RTPD%Turbine_sort_order(1) - ELSEIF (p%RTPD%Turbine_sort_order(1) <= 99) THEN - write(turbine_sort_order_char,'(i2)') p%RTPD%Turbine_sort_order(1) - ELSE - write(turbine_sort_order_char,'(i3)') p%RTPD%Turbine_sort_order(1) - END IF - - filename_meanU_txt = trim(Prefix)//trim(MeanUprefix_bin)//trim(Turbineprefix)//trim(turbine_sort_order_char)//".txt" - CALL GetNewUnit(MyUn) - OPEN(unit = MyUn, status='old',file=filename_meanU_txt,form='formatted') - READ(MyUn,'(f13.7)') p%Wind_file_Mean_u - CLOSE(MyUn) - END IF - - - !''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' - ! read the upwind results if have any - !''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' - IF (p%RTPD%upwindturbine_number > 0) THEN - ALLOCATE (u%Upwind_result%upwind_U (p%RTPD%upwindturbine_number,floor(p%p_p_r*p%r_domain))) ! declare the input - ALLOCATE (u%Upwind_result%upwind_wakecenter (p%RTPD%upwindturbine_number,p%WakePosition_1,p%WakePosition_2,3)) - ALLOCATE (u%Upwind_result%upwind_meanU (p%RTPD%upwindturbine_number)) - ALLOCATE (u%Upwind_result%upwind_TI (p%RTPD%upwindturbine_number)) - ALLOCATE (u%Upwind_result%upwind_small_TI (p%RTPD%upwindturbine_number)) - ALLOCATE (u%Upwind_result%upwind_smoothWake (p%RTPD%upwindturbine_number,p%ElementNum)) - ALLOCATE (u%Upwind_result%velocity_aerodyn (p%RTPD%upwindturbine_number)) ! the temp velocity used by the aerodyn - - ! transfer the turbine index from integer to character - IF (p%RTPD%WT_index <= 9) THEN - write(invetigated_turbine_index_character,'(i1)') p%RTPD%WT_index - ELSEIF (p%RTPD%WT_index <= 99) THEN - write(invetigated_turbine_index_character,'(i2)') p%RTPD%WT_index - ELSE - write(invetigated_turbine_index_character,'(i3)') p%RTPD%WT_index - END IF - - DO I = 1,p%RTPD%upwindturbine_number - - IF (p%RTPD%upwind_turbine_index(I) <= 9) THEN - write(upwind_turbine_index_character,'(i1)') p%RTPD%upwind_turbine_index(I) - ELSEIF (p%RTPD%upwind_turbine_index(I) <= 99) THEN - write(upwind_turbine_index_character,'(i2)') p%RTPD%upwind_turbine_index(I) - ELSE - write(upwind_turbine_index_character,'(i3)') p%RTPD%upwind_turbine_index(I) - END IF - - ! obtain the coresponded profile name - - filename_u_bin = trim(Prefix)//trim(Uprefix_bin)//trim(Turbineprefix)//trim(upwind_turbine_index_character)& - //trim(connectionprefix)//trim(invetigated_turbine_index_character)//".bin" ! the file name needs to be read - - filename_TI_bin = trim(Prefix)//trim(TIprefix_bin)//trim(Turbineprefix)//trim(upwind_turbine_index_character)& - //trim(connectionprefix)//trim(invetigated_turbine_index_character)//".bin" - - filename_smallTI_bin = trim(Prefix)//trim(smallTIprefix_bin)//trim(Turbineprefix)//trim(upwind_turbine_index_character)& - //trim(connectionprefix)//trim(invetigated_turbine_index_character)//".bin" - - filename_smoothWake_bin = trim(Prefix)//trim(SmoothWprefix_bin)//trim(Turbineprefix)//trim(upwind_turbine_index_character)& - //trim(connectionprefix)//trim(invetigated_turbine_index_character)//".bin" - - filename_wakecenter_bin = trim(Prefix)//trim(WCprefix_bin)//trim(Turbineprefix)//trim(upwind_turbine_index_character)//".bin" - - filename_meanU_bin = trim(Prefix)//trim(MeanUprefix_bin)//trim(Turbineprefix)//trim(upwind_turbine_index_character)//".bin" - - ! open the file and read - OPEN(unit = MyUn, status='old',file=filename_u_bin,form='unformatted') - READ(MyUn) u%Upwind_result%upwind_U(I,:) - CLOSE(MyUn) - - OPEN(unit = MyUn, status='old',file=filename_TI_bin,form='unformatted') - READ(MyUn) u%Upwind_result%upwind_TI(I) - CLOSE(MyUn) - - OPEN(unit = MyUn, status='old',file=filename_smallTI_bin,form='unformatted') - READ(MyUn) u%Upwind_result%upwind_small_TI(I) - CLOSE(MyUn) - - OPEN(unit = MyUn, status='old',file=filename_smoothWake_bin,form='unformatted') - READ(MyUn) u%Upwind_result%upwind_smoothWake(I,:) - CLOSE(MyUn) - - OPEN(unit = MyUn, status='old',file=filename_wakecenter_bin,form='unformatted') - READ(MyUn) u%Upwind_result%upwind_wakecenter(I,:,:,:) - CLOSE(MyUn) - - OPEN(unit = MyUn, status='old',file=filename_meanU_bin,form='unformatted') - READ(MyUn) u%Upwind_result%upwind_meanU(I) - CLOSE(MyUn) - - END DO - END IF - - - !''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' - ! declare the downwind output variables - !''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' - - IF (p%RTPD%SimulationOrder_index > 0) THEN ! not for the base 0 turbine - IF (p%RTPD%downwindturbine_number /= 0 ) THEN ! not for the turbines that don't have a downwind turbine - m%SmoothOut%length_velocity_array = NINT(1.2*p%RotorR) - ALLOCATE ( u%Upwind_result%TI_downstream (p%RTPD%downwindturbine_number ) ) - ALLOCATE ( u%Upwind_result%small_scale_TI_downstream (p%RTPD%downwindturbine_number ) ) - ALLOCATE ( u%Upwind_result%smoothed_velocity_array (p%RTPD%downwindturbine_number,p%ElementNum ) ) - ALLOCATE ( u%Upwind_result%vel_matrix (p%RTPD%downwindturbine_number,2*m%SmoothOut%length_velocity_array,2*m%SmoothOut%length_velocity_array) ) - END IF - END IF - -END SUBROUTINE read_upwind_result_file - -!------------------------------------------------------------------------------------------------ -SUBROUTINE write_result_file(m,p,y,u) -!............................................................................ -! This routine is called to write the results from the DWM simulation of this turbine -!............................................................................ - - TYPE(DWM_ParameterType), INTENT(INOUT) :: p - TYPE(DWM_MiscVarType), INTENT(INOUT) :: m - TYPE(DWM_OutputType), INTENT(INOUT) :: y - TYPE(DWM_InputType), INTENT(INOUT) :: u - - CHARACTER(LEN=3) :: invetigated_turbine_index_character - CHARACTER(LEN=3) :: downwind_turbine_index_character - CHARACTER(LEN=80) :: filename_u_bin,filename_wakecenter_bin,filename_meanU_bin,filename_TI_bin,filename_smallTI_bin,filename_smoothWake_bin,filename_wakewidth_bin,filename_wake_bin - CHARACTER(LEN=80) :: filename_TI_txt,filename_meanU_txt,filename_induction_txt,filename_wake_txt,filename_wakecenter_txt,filename_SDpower_txt,filename_Ct_txt - CHARACTER(LEN=2) :: Uprefix_bin = 'U_' - CHARACTER(LEN=3) :: WCprefix_bin = 'WC_' - CHARACTER(LEN=7) :: MeanUprefix_bin = 'Mean_U_' - CHARACTER(LEN=3) :: Tiprefix_bin = 'TI_' - CHARACTER(LEN=8) :: smallTIprefix_bin = 'SmallTI_' - CHARACTER(LEN=11) :: SmoothWprefix_bin = 'Smoothwake_' - CHARACTER(LEN=10) :: InductionPrefix = 'Induction_' - CHARACTER(LEN=6) :: Wakeprefix = 'WakeU_' - CHARACTER(LEN=11) :: WWprefix_bin = 'Wake_width_' - CHARACTER(LEN=22) :: Prefix = 'DWM-results'//trim(PathSep) - CHARACTER(LEN=4) :: connectionprefix = '_to_' - CHARACTER(LEN=8) :: Turbineprefix = 'Turbine_' - CHARACTER(LEN=8) :: Powerprefix = 'SDpower_' - CHARACTER(LEN=7) :: MeanCtPrefix = 'MeanCt_' - INTEGER :: I,RESULT - - INTEGER :: write_unit - - CHARACTER(LEN=80) :: filename_TI_to_txt - CHARACTER(LEN=80) :: filename_SmallTI_to_txt - -!bjj: use GetNewUnit() and parameters instead of "25" and "10". "10" is especially bad, because some other file is bound to be using it! - - IF ( p%RTPD%SimulationOrder_index > 0 ) THEN ! exclude the first turbine - - IF (p%RTPD%WT_index <= 9) THEN - write(invetigated_turbine_index_character,'(i1)') p%RTPD%WT_index - ELSEIF (p%RTPD%WT_index <= 99) THEN - write(invetigated_turbine_index_character,'(i2)') p%RTPD%WT_index - ELSE - write(invetigated_turbine_index_character,'(i3)') p%RTPD%WT_index - END IF - - ! Write the TI of this turbine - filename_TI_txt = trim(Prefix)//trim(Tiprefix_bin)//trim(Turbineprefix)//trim(invetigated_turbine_index_character)//".txt" - - CALL GetNewUnit (write_unit) - OPEN (unit = write_unit,file=filename_TI_txt) - WRITE (write_unit,'(f13.7)') y%TI - CLOSE (write_unit) - - ! Write the mean velocity of this turbine - filename_meanU_bin = trim(Prefix)//trim(MeanUprefix_bin)//trim(Turbineprefix)//trim(invetigated_turbine_index_character)//".bin" - filename_meanU_txt = trim(Prefix)//trim(MeanUprefix_bin)//trim(Turbineprefix)//trim(invetigated_turbine_index_character)//".txt" - - CALL GetNewUnit (write_unit) - OPEN (unit = write_unit,file=filename_meanU_txt) - WRITE (write_unit,'(f13.7)') y%Mean_FFWS - CLOSE (write_unit) - - CALL GetNewUnit (write_unit) - OPEN (unit = write_unit, status='replace',file=filename_meanU_bin,form='unformatted') - WRITE (write_unit) y%Mean_FFWS - CLOSE (write_unit) - - ! Write the induction factor of this turbine - filename_induction_txt = trim(Prefix)//trim(InductionPrefix)//trim(Turbineprefix)//trim(invetigated_turbine_index_character)//".txt" - - CALL GetNewUnit (write_unit) - OPEN (unit = write_unit,file=filename_induction_txt) - WRITE (write_unit,'(f13.7)') y%induction_factor(:) - CLOSE (write_unit) - - ! Write the mean Ct of this turbine - filename_Ct_txt = trim(Prefix)//trim(MeanCtPrefix)//trim(Turbineprefix)//trim(invetigated_turbine_index_character)//".txt" - - CALL GetNewUnit (write_unit) - OPEN (unit = write_unit,file=filename_Ct_txt) - WRITE (write_unit,'(f13.7)') y%avg_ct - CLOSE (write_unit) - - ! Write the averaged SD power of this turbine - filename_SDpower_txt = trim(Prefix)//trim(Powerprefix)//trim(Turbineprefix)//trim(invetigated_turbine_index_character)//".txt" - - CALL GetNewUnit (write_unit) - OPEN (unit = write_unit,file=filename_SDpower_txt,POSITION = 'APPEND') - WRITE (write_unit,'(f13.7)') y%mean_SDgenpwr - CLOSE (write_unit) - - - ! Write the wake deficit profile of this turbine - filename_wake_txt = trim(Prefix)//trim(Wakeprefix)//trim(Turbineprefix)//trim(invetigated_turbine_index_character)//".txt" - filename_wake_bin = trim(Prefix)//trim(Wakeprefix)//trim(Turbineprefix)//trim(invetigated_turbine_index_character)//".bin" - - CALL GetNewUnit (write_unit) - OPEN (unit = write_unit,file=filename_wake_txt) - WRITE (write_unit,'(f10.7)') y%wake_u(:,:) - CLOSE (write_unit) - - CALL GetNewUnit (write_unit) - OPEN (unit = write_unit, status='replace',file=filename_wake_bin,form='unformatted') - WRITE (write_unit) y%wake_u(:,:) - CLOSE (write_unit) - - ! Write the meandered wake center result of this turbine - filename_wakecenter_bin = trim(Prefix)//trim(WCprefix_bin)//trim(Turbineprefix)//trim(invetigated_turbine_index_character)//".bin" - filename_wakecenter_txt = trim(Prefix)//trim(WCprefix_bin)//trim(Turbineprefix)//trim(invetigated_turbine_index_character)//".txt" - - CALL GetNewUnit (write_unit) - OPEN (unit = write_unit,file=filename_wakecenter_txt) - WRITE (write_unit,'(f13.7)') y%wake_position(:,:,:) - CLOSE (write_unit) - - CALL GetNewUnit (write_unit) - OPEN (unit = write_unit, status='replace',file=filename_wakecenter_bin,form='unformatted') - WRITE (write_unit) y%wake_position(:,:,:) - CLOSE (write_unit) - - ! Write the downstream turbine customized output files - IF (p%RTPD%downwindturbine_number /= 0) THEN - - DO I = 1,p%RTPD%downwindturbine_number - IF (p%RTPD%downwind_turbine_index(I) <= 9) THEN - write(downwind_turbine_index_character,'(i1)') p%RTPD%downwind_turbine_index(I) - ELSEIF (p%RTPD%downwind_turbine_index(I) <= 99) THEN - write(downwind_turbine_index_character,'(i2)') p%RTPD%downwind_turbine_index(I) - ELSE - write(downwind_turbine_index_character,'(i3)') p%RTPD%downwind_turbine_index(I) - END IF - - filename_u_bin = trim(Prefix)//trim(Uprefix_bin)//trim(Turbineprefix)//trim(invetigated_turbine_index_character)& - //trim(connectionprefix)//trim(downwind_turbine_index_character)//".bin" - filename_TI_bin = trim(Prefix)//trim(TIprefix_bin)//trim(Turbineprefix)//trim(invetigated_turbine_index_character)& - //trim(connectionprefix)//trim(downwind_turbine_index_character)//".bin" - filename_smallTI_bin = trim(Prefix)//trim(smallTIprefix_bin)//trim(Turbineprefix)//trim(invetigated_turbine_index_character)& - //trim(connectionprefix)//trim(downwind_turbine_index_character)//".bin" - filename_smoothWake_bin = trim(Prefix)//trim(SmoothWprefix_bin)//trim(Turbineprefix)//trim(invetigated_turbine_index_character)& - //trim(connectionprefix)//trim(downwind_turbine_index_character)//".bin" - - - filename_TI_to_txt = trim(Prefix)//trim(TIprefix_bin)//trim(Turbineprefix)//trim(invetigated_turbine_index_character)& - //trim(connectionprefix)//trim(downwind_turbine_index_character)//".txt" - filename_SmallTI_to_txt = trim(Prefix)//trim(smallTIprefix_bin)//trim(Turbineprefix)//trim(invetigated_turbine_index_character)& - //trim(connectionprefix)//trim(downwind_turbine_index_character)//".txt" - - ! Write the wake velocity at the certain downstream turbine plane - CALL GetNewUnit (write_unit) - OPEN (unit = write_unit, status='replace',file=filename_u_bin,form='unformatted') - WRITE (write_unit) y%wake_u(floor(p%RTPD%downwind_turbine_projected_distance(I) * p%p_p_r)+1,:) - CLOSE (write_unit) - - ! Write the TI at the certain downstream turbine plane - CALL GetNewUnit (write_unit) - OPEN (unit = write_unit, status='replace',file=filename_TI_bin,form='unformatted') - WRITE (write_unit) u%Upwind_result%TI_downstream (I) - CLOSE (write_unit) - - CALL GetNewUnit (write_unit) - OPEN (unit = write_unit, status='replace',file=filename_smallTI_bin,form='unformatted') - WRITE (write_unit) u%Upwind_result%small_scale_TI_downstream (I) - CLOSE (write_unit) - - CALL GetNewUnit (write_unit) - OPEN (unit = write_unit,file=filename_TI_to_txt) - WRITE (write_unit,'(f14.7)') u%Upwind_result%TI_downstream (I) - CLOSE (write_unit) - - CALL GetNewUnit (write_unit) - OPEN (unit = write_unit,file=filename_smallTI_to_txt) - WRITE (write_unit,'(f14.7)') u%Upwind_result%small_scale_TI_downstream (I) - CLOSE (write_unit) - - ! Write the smoothed wake profile at the certain downstream turbine plane - CALL GetNewUnit (write_unit) - OPEN (unit = write_unit, status='replace',file=filename_smoothWake_bin,form='unformatted') - WRITE (write_unit) u%Upwind_result%smoothed_velocity_array(I,:) ! write the wind data of the plane where the downstream turbine locates, - CLOSE (write_unit) - END DO - END IF - END IF - - ! Write the meandered wake center and the wake width result from the 0 base wind turbine - IF (p%RTPD%SimulationOrder_index == 0) THEN - - filename_wakecenter_bin = trim(Prefix)//trim(WCprefix_bin)//trim(Turbineprefix)//"0"//".bin" - filename_wakewidth_bin = trim(Prefix)//trim(WWprefix_bin)//trim(Turbineprefix)//"0"//".bin" - - CALL GetNewUnit (write_unit) - OPEN (unit = write_unit, status='replace',file=filename_wakecenter_bin,form='unformatted') - WRITE (write_unit) y%wake_position(:,:,:) - CLOSE (write_unit) - - CALL GetNewUnit (write_unit) - OPEN (unit = write_unit, status='replace',file=filename_wakewidth_bin,form='unformatted') - WRITE (write_unit) m%WMC%wake_width(:) - CLOSE (write_unit) - - END IF - -END SUBROUTINE write_result_file - -!!---------------------------------------------------------------------------------- -!!BJJ: THIS routine uses non-standard Fortran. IFPORT and DFLIB are incompatible with gfortran. Since this routine isn't used, I'm commenting it out. -!SUBROUTINE rename_FAST_output(m, u, p) -!!............................................................................ -!! This routine is called to rename the fast output -!!............................................................................ -! USE IFPORT -! USE DFLIB -! -! TYPE(DWM_InputType), INTENT(INOUT) :: u ! Inputs at Time -! TYPE(DWM_MiscVarType), INTENT(INOUT) :: m -! TYPE(DWM_ParameterType), INTENT(INOUT) :: p -! -! CHARACTER(LEN=80) :: filename_FastOutput,filename_FastElm -! CHARACTER(LEN=11) :: Fastprefix = 'FastOutput_' ! Fast output file -! CHARACTER(LEN=8) :: FastElmprefix = 'FastElm_' ! Fast Elm output file -! INTEGER :: RESULT -! CHARACTER(LEN=22) :: Prefix = 'DWM-results'//trim(PathSep) -! CHARACTER(LEN=8) :: Turbineprefix = 'Turbine_' -! CHARACTER(LEN=3) :: invetigated_turbine_index_character -! -! IF ( p%RTPD%SimulationOrder_index > 0 ) THEN ! exclude the first turbine -! -! IF (p%RTPD%WT_index <= 9) THEN -! write(invetigated_turbine_index_character,'(i1)') p%RTPD%WT_index -! ELSEIF (p%RTPD%WT_index <= 99) THEN -! write(invetigated_turbine_index_character,'(i2)') p%RTPD%WT_index -! ELSE -! write(invetigated_turbine_index_character,'(i3)') p%RTPD%WT_index -! END IF -! -! ! Rename the FAST output wrt the turbine index -! filename_FastOutput = trim(Prefix)//trim(Fastprefix)//trim(Turbineprefix)//trim(invetigated_turbine_index_character)//".out" -! filename_FastElm = trim(Prefix)//trim(FastElmprefix)//trim(Turbineprefix)//trim(invetigated_turbine_index_character)//".AD.out" -! -! !RESULT =rename('V80_2MW.out',filename_FastOutput) -! !RESULT =rename('V80_2MW.elm',filename_FastElm ) -! -! RESULT =rename('FAST_V80.out',filename_FastOutput) -! RESULT =rename('FAST_V80.elm',filename_FastElm ) -! END IF -! -!END SUBROUTINE rename_FAST_output - -!------------------------------------------------------------------------------------------------ -FUNCTION min_of_array(ary, ary_length) -!............................................................................ -! This routine is called to return the minmum value in an array -!............................................................................ - - INTEGER :: ary_length - REAL(ReKi) :: ary(ary_length) - REAL(ReKi) :: min_of_array - INTEGER :: I - - - min_of_array = ary(1) - - DO I = 2,ary_length - IF (ary(I) < min_of_array) THEN - min_of_array = ary(I) - END IF - END DO - -END FUNCTION min_of_array - -!------------------------------------------------------------------------------------------------ -FUNCTION max_of_array(ary, ary_length) -!............................................................................ -! This routine is called to return the maximum value in an array -!............................................................................ - - INTEGER :: ary_length - REAL :: ary(ary_length) - REAL :: max_of_array - INTEGER :: I - - max_of_array = ary(1) - - DO I = 2,ary_length - IF (ary(I) > max_of_array) THEN - max_of_array = ary(I) - END IF - END DO - -END FUNCTION max_of_array - -!------------------------------------------------------------------------------------------------ -FUNCTION rotation_lateral_offset(x_spacing) -!............................................................................ -! This routine is called to return the wake lateral offset due to the turbine rotation -! (assume the rotor spins clockwise) --> always shift to right (negative) -!............................................................................ - - REAL :: x_spacing - REAL :: rotation_lateral_offset - - ! parameters - REAL :: ad = -4.5 - REAL :: bd = -0.01 - - rotation_lateral_offset = ad + bd*x_spacing - -END FUNCTION rotation_lateral_offset - -!------------------------------------------------------------------------------------------------ -FUNCTION local_skew_angle(yaw_angle, tilde_ct, x_spacing, wake_width, ppr) -!............................................................................ -! This routine is called to return the local skew angle at a certain downstream location -!............................................................................ - - REAL(ReKi) :: yaw_angle - REAL(ReKi) :: tilde_ct - REAL(ReKi) :: x_spacing - INTEGER :: wake_width - REAL(ReKi) :: ppr - REAL(ReKi) :: local_skew_angle - - IF ( ABS(yaw_angle) > 0.000001 ) THEN - local_skew_angle = (ppr/wake_width)**2 *COS(yaw_angle)**2 *SIN(yaw_angle) *tilde_ct/2 - local_skew_angle = -local_skew_angle ! the direction (positive or negative) is opposite to the turbine yaw angle - ELSE - local_skew_angle = 0.0 - END IF - - local_skew_angle = TAN(local_skew_angle) - -END FUNCTION local_skew_angle - -!------------------------------------------------------------------------------------------------ -SUBROUTINE calculate_SD_averagePower( m,y ) -!------------------------------------------------------------------------------------------------ -! This routine is used to calculate the average time step power from SD subroutine -!------------------------------------------------------------------------------------------------ - - TYPE(DWM_MiscVarType), INTENT(IN ) :: m - TYPE(DWM_OutputType), INTENT(INOUT) :: y - - - y%mean_SDgenpwr = y%total_SDgenpwr / m%SDtimestep - -END SUBROUTINE calculate_SD_averagePower - -END MODULE DWM_Wake_Sub - - - - diff --git a/modules/aerodyn14/src/DWM_driver_wind_farm.f90 b/modules/aerodyn14/src/DWM_driver_wind_farm.f90 deleted file mode 100644 index f59052165f..0000000000 --- a/modules/aerodyn14/src/DWM_driver_wind_farm.f90 +++ /dev/null @@ -1,51 +0,0 @@ -PROGRAM DWM_driver_wind_farm - - USE DWM_driver_wind_farm_sub - USE read_wind_farm_parameter_data, ONLY: NumWT, DWM_exe_name - USE DWM_init_data, ONLY:InputFile -#ifdef __INTEL_COMPILER - USE IFPORT -#endif - - IMPLICIT NONE - - INTEGER :: simulation_index - INTEGER :: RESULT - REAL :: T1,T2 - - ! pre-processing - CALL Driver_Init - CALL read_wind_farm_parameter(InputFile) - CALL Check_DWM_parameter - CALL write_parameter_to_file - - ! sort the turbines - CALL wind_farm_geometry - - !run the DWM for the very first base turbine to generate the turbine interaction information - simulation_index = 0 - - ! FAST 8 - RESULT = system("echo "//TRIM(DWM_exe_name)//" "// TRIM(InputFile)//".fst" // " " //TRIM(Int2LStr(simulation_index)) //" "// "DWM") - RESULT = system(TRIM(DWM_exe_name)//" "// TRIM(InputFile)//".fst" // " " //TRIM(Int2LStr(simulation_index)) //" "// "DWM") - - ! calculate the wake sector angle and the turbine interaction information - CALL cal_wake_sector_angle - - ! Run the simulation for all the turbines in the wind farm - DO simulation_index = 1,NumWT - !RESULT = system("DWM_Wind_Farm.exe "// TRIM(Int2LStr(simulation_index)) //" V80_2MW.fst") ! 2MW NEW - - !general DWM FAST input - !RESULT = system(TRIM(DWM_exe_name)//".exe "// TRIM(Int2LStr(simulation_index)) //" "//TRIM(InputFile)//".fst") - - ! FAST 8 - RESULT = system(TRIM(DWM_exe_name)//" "// TRIM(InputFile)//".fst" // " " //TRIM(Int2LStr(simulation_index)) //" "// "DWM") - - result = 0 !SetExitQQ (QWIN$EXITNOPERSIST) - CALL rename_FAST_output(simulation_index) - END DO - - CALL delete_temp_files - -END PROGRAM DWM_driver_wind_farm \ No newline at end of file diff --git a/modules/aerodyn14/src/DWM_driver_wind_farm_mod.f90 b/modules/aerodyn14/src/DWM_driver_wind_farm_mod.f90 deleted file mode 100644 index 75ec54a474..0000000000 --- a/modules/aerodyn14/src/DWM_driver_wind_farm_mod.f90 +++ /dev/null @@ -1,42 +0,0 @@ -MODULE read_wind_farm_parameter_data - IMPLICIT NONE - REAL :: HubHt - REAL :: RotorR - INTEGER :: NumWT ! The total number of wind turbines - REAL :: Uambient - REAL :: TI - INTEGER :: ppR - REAL :: Domain_R - REAL :: Domain_X - INTEGER :: Mstl ! Meandering_simulation_time_length - INTEGER :: Mmt ! Meandering_Moving_time - INTEGER :: smooth_flag ! smoothed out upstream wake profile flag - REAL :: WFLowerBd ! The lower bound height of the wind file (m) - REAL :: Winddir ! The ambient wind direction - INTEGER :: Tinfluencer ! The max number of upstream turbines that affects a downstream turbine (-) - CHARACTER(1024):: DWM_exe_name - - REAL(8), ALLOCATABLE :: Xcoordinate (:) ! wind turbine x location - REAL(8), ALLOCATABLE :: Ycoordinate (:) ! wind turbine y location - -END MODULE read_wind_farm_parameter_data - -!------------------------------------------------------------ -MODULE wind_farm_geometry_data - IMPLICIT NONE - INTEGER,ALLOCATABLE :: turbine_sort(:) ! the array that stores the order of the turbines from upstream to downstream - INTEGER,ALLOCATABLE :: TurbineInfluenceData(:,:) - REAL,ALLOCATABLE :: wake_sector_angle_array(:) - REAL(8) :: xwind - REAL(8) :: ywind - INTEGER :: scale_factor - REAL :: Pi - REAL,ALLOCATABLE :: length(:) ! projected length on the wind direction vector - -END MODULE wind_farm_geometry_data - -!------------------------------------------------------------ -MODULE DWM_init_data - CHARACTER(1024) :: OutFileRoot - CHARACTER(1024) :: InputFile -END MODULE DWM_init_data diff --git a/modules/aerodyn14/src/DWM_driver_wind_farm_sub.f90 b/modules/aerodyn14/src/DWM_driver_wind_farm_sub.f90 deleted file mode 100644 index b2492b0462..0000000000 --- a/modules/aerodyn14/src/DWM_driver_wind_farm_sub.f90 +++ /dev/null @@ -1,880 +0,0 @@ -MODULE DWM_driver_wind_farm_sub - USE NWTC_Library - USE VersionInfo - IMPLICIT NONE - -!PUBLIC SUBROUTINES - PUBLIC :: read_wind_farm_parameter - PUBLIC :: write_parameter_to_file - PUBLIC :: wind_farm_geometry - PUBLIC :: projected_length - PUBLIC :: AngleBetweenVectors - PUBLIC :: turbine_position_LorR - PUBLIC :: Driver_init - PUBLIC :: delete_temp_files - PUBLIC :: Check_DWM_parameter - - -CONTAINS -!------------------------------------------------------------------- -SUBROUTINE read_wind_farm_parameter(PriFile) -!................................................................... -! This subroutine is to read the wind farm parameter files -! Including the number of rows of the wind farm, the number of turbine in each row -! and the turbine spacing -!................................................................... - USE read_wind_farm_parameter_data - IMPLICIT NONE - - CHARACTER(*), INTENT(IN) :: PriFile - INTEGER :: UnIn = 0 - INTEGER :: UnEc = -1 - INTEGER :: I - CHARACTER(1024) :: DWM_Title,comment - INTEGER :: ErrStat = 0 - CHARACTER(ErrMsgLen) :: ErrMsg - INTEGER(4) :: IOS - - CALL OpenFInpFile ( UnIn, PriFile, ErrStat, ErrMsg ) - - READ (UnIn,'(//,A,/)',IOSTAT=IOS) DWM_Title ! read the words (title) - CALL CheckIOS( IOS, PriFile, 'file title', StrType ) - - READ (UnIn,'(A)',IOSTAT=IOS) Comment ! read the words (comment) - CALL CheckIOS( IOS, PriFile, 'simulation control parameters comment', StrType ) - - ! Read in the hub height - CALL ReadVar ( UnIn, PriFile, HubHt, 'HubHt', 'The hub height (m)', ErrStat, ErrMsg, UnEc ) - IF ( ErrStat /= 0 ) RETURN - - ! Read in the rotor radius - CALL ReadVar ( UnIn, PriFile, RotorR, 'RotorR', 'The Rotor radius (m)', ErrStat, ErrMsg, UnEc ) - IF ( ErrStat /= 0 ) RETURN - - ! Read in the total number of wind turbines - CALL ReadVar ( UnIn, PriFile, NumWT, 'NumWT', 'The total number of wind turbines (-)', ErrStat, ErrMsg, UnEc ) - IF ( ErrStat /= 0 ) RETURN - - ! Read in the ambient wind velocity - CALL ReadVar ( UnIn, PriFile, Uambient, 'Uambient', 'The ambient wind velocity (m/s)', ErrStat, ErrMsg, UnEc ) - IF ( ErrStat /= 0 ) RETURN - - ! Read in the ambient TI - CALL ReadVar ( UnIn, PriFile, TI, 'TI', 'TI for first turbine (%)', ErrStat, ErrMsg, UnEc ) - IF ( ErrStat /= 0 ) RETURN - - ! Read in the radial domain size - CALL ReadVar ( UnIn, PriFile, ppR, 'ppR', 'Point per R resolution (-)', ErrStat, ErrMsg, UnEc ) - IF ( ErrStat /= 0 ) RETURN - - ! Read in the point per R resolution - CALL ReadVar ( UnIn, PriFile, Domain_R, 'Domain_R', 'Radial domain size (R)', ErrStat, ErrMsg, UnEc ) - IF ( ErrStat /= 0 ) RETURN - - ! Read in the point per R resolution - CALL ReadVar ( UnIn, PriFile, Domain_X, 'Domain_X', 'Longitudinal domain size (R)', ErrStat, ErrMsg, UnEc ) - IF ( ErrStat /= 0 ) RETURN - - ! Read in the simulation time length of the meandering wake model - CALL ReadVar ( UnIn, PriFile, Mstl, 'Meandering_simulation_time_length', 'The length of the simulation time in the meandering wake model (-)', ErrStat, ErrMsg, UnEc ) - IF ( ErrStat /= 0 ) RETURN - - ! Read in the moving time length of the meandering wake model - CALL ReadVar ( UnIn, PriFile, Mmt, 'Meandering_Moving_time', 'The length of the moving time in the meandering wake model (-)', ErrStat, ErrMsg, UnEc ) - IF ( ErrStat /= 0 ) RETURN - - ! Read in the lower bound height of the wind file - CALL ReadVar ( UnIn, PriFile, WFLowerBd, 'WFLowerBd', 'The lower bound height of the wind file (m)', ErrStat, ErrMsg, UnEc ) - IF ( ErrStat /= 0 ) RETURN - - ! Read in the ambient wind direction - CALL ReadVar ( UnIn, PriFile, Winddir, 'Winddir', 'The ambient wind direction (degree)', ErrStat, ErrMsg, UnEc ) - IF ( ErrStat /= 0 ) RETURN - - ! Read in the DWM_FAST.exe file rootname - CALL ReadVar ( UnIn, PriFile, DWM_exe_name, 'DWM_exe_name', 'The file rootname of the DWM-FAST program', ErrStat, ErrMsg, UnEc ) - - ALLOCATE (Xcoordinate(NumWT)) - ALLOCATE (Ycoordinate(NumWT)) - - CALL ReadCom( UnIn, PriFile, 'Coordinate table headers', ErrStat, ErrMsg) - IF ( ErrStat /= 0 ) RETURN - - DO i = 1, NumWT - IF (ErrStat == 0) THEN - READ(UnIn,*,IOSTAT=ErrStat) Xcoordinate(i), Ycoordinate(i) - END IF - END DO - - Tinfluencer = 1 - !Tinfluencer = 10 - -END SUBROUTINE read_wind_farm_parameter - -!------------------------------------------------------------------- -SUBROUTINE Check_DWM_parameter() -!................................................................... -! This subroutine is to check if the input parameters are valid -!................................................................... - USE read_wind_farm_parameter_data - - IF (HubHt < 0.0) THEN - PRINT*, 'WARNING: HubHt should be positive' - CALL EXIT - END IF - - IF (RotorR < 0.0) THEN - PRINT*, 'WARNING: RotorR should be positive' - CALL EXIT - END IF - IF (RotorR > HubHt) THEN - PRINT*, 'WARNING: RotorR should be smaller than HubHt' - CALL EXIT - END IF - - IF (NumWT < 1.0) THEN - PRINT*, 'WARNING: NumWT should be positive' - CALL EXIT - END IF - - IF (Uambient < 0.0) THEN - PRINT*, 'WARNING: Uambient should be positive' - CALL EXIT - END IF - - IF (TI < 0.0) THEN - PRINT*, 'WARNING: TI should be positive' - CALL EXIT - END IF - - IF (ppR < 1.0) THEN - PRINT*, 'WARNING: ppR should be positive' - CALL EXIT - END IF - - IF (Domain_R < 0.0) THEN - PRINT*, 'WARNING: Domain_R should be positive' - CALL EXIT - END IF - - IF (Domain_X < 0.0) THEN - PRINT*, 'WARNING: Domain_X should be positive' - CALL EXIT - END IF - -END SUBROUTINE Check_DWM_parameter - -!------------------------------------------------------------------- -SUBROUTINE write_parameter_to_file() -!................................................................... -! This subroutine is to write the turbine spacing from the input file -! to a bin file, which enables the DWM to read the turbine spacing at every -! instances of running -!................................................................... - - USE read_wind_farm_parameter_data - IMPLICIT NONE - integer :: Un - - !CALL GetNewUnit(Un) - Un = 10 - - OPEN(unit = Un, status='replace',file='DWM_parameter.bin',form='unformatted') - WRITE(Un) HubHt,RotorR,NumWT,Uambient,TI,Domain_R,Domain_X,ppR,Mstl,Mmt,WFLowerBd,Winddir,Tinfluencer - CLOSE(Un) - - OPEN(unit = Un, status='replace',file='wind_farm_coordinate.bin',form='unformatted') - WRITE(Un) Xcoordinate,Ycoordinate - CLOSE(Un) - -END SUBROUTINE write_parameter_to_file - -!------------------------------------------------------------------- -SUBROUTINE wind_farm_geometry() -!................................................................... -! This subroutine is to calculate the wind direction and sort the wind -! turbines as the order from upstream to downstream -! output the angles between turbines -!................................................................... - USE read_wind_farm_parameter_data, ONLY: Xcoordinate, Ycoordinate, NumWT, Winddir, Tinfluencer,Mmt,ppR, Domain_X - USE wind_farm_geometry_data, ONLY: turbine_sort, xwind, ywind,length - - INTEGER :: I,J,K - INTEGER :: temp, Un - REAL :: origin_turbine_x - REAL :: origin_turbine_y - REAL :: downwind_turbine_x - REAL :: downwind_turbine_y - REAL :: max_xturbine - REAL :: max_yturbine - REAL :: Circle_Radius - REAL :: Pi - REAL :: vector1x - REAL :: vector1y - REAL :: vector2x - REAL :: vector2y - REAL :: Max_spacing - REAL :: spacing_temp - - INTEGER,ALLOCATABLE :: position_sign(:,:) - - REAL,ALLOCATABLE :: length_sort(:) - REAL,ALLOCATABLE :: turbine_angle(:,:) - - !''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' - ! determine the SIZE of the wind farm - !''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' - max_xturbine = 0 - max_yturbine = 0 - - - DO I = 1,NumWT - IF ( ABS(Xcoordinate(I)) > max_xturbine ) THEN - max_xturbine = ABS(Xcoordinate(I)) - END IF - - IF ( ABS(Ycoordinate(I)) > max_yturbine ) THEN - max_yturbine = ABS(Ycoordinate(I)) - END IF - END DO - - Circle_Radius = 2*SQRT(max_xturbine*max_xturbine + max_yturbine*max_yturbine) - - !''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' - ! determine the inflow wind origin - !''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' - Pi = ACOS( -1.0 ) - xwind = SIN(Winddir*Pi/180) * circle_radius - ywind = COS(Winddir*Pi/180) * circle_radius - - !''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' - ! sort the wind turbines as the order from upstream to downstream - !''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' - ALLOCATE ( turbine_sort(NumWT) ) - ALLOCATE ( length(NumWT) ) - ALLOCATE ( length_sort(NumWT) ) - - DO I = 1,NumWT - length(I) = projected_length(xwind,ywind,Xcoordinate(I),Ycoordinate(I)) - END DO - - length_sort = length - - DO I=1,NumWT - turbine_sort(I) = I - END DO - - - DO I = 1,NumWt-1 - DO J = 1,NumWt-1 - IF ( length_sort(J) > length_sort(J+1) ) THEN - temp = turbine_sort(J) - turbine_sort(J) = turbine_sort(J+1) - turbine_sort(J+1) = temp - - temp = length_sort(J) - length_sort(J) = length_sort(J+1) - length_sort(J+1) = temp - END IF - END DO - END DO - - !CALL GetNewUnit(Un) - Un = 10 - OPEN(unit = Un, status='replace',file='wind_farm_turbine_sort.bin',form='unformatted') - WRITE(Un) turbine_sort(:) - CLOSE(Un) - - !''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' - ! calculate the angles between the line connecting two turbines and the wind direction - !''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' - ALLOCATE (turbine_angle(NumWT,NumWT)) - ALLOCATE (position_sign(NumWT,NumWT)) - turbine_angle = 0.0 - position_sign = 0 - - DO I = 1,NumWT - DO J = 1,NumWT - origin_turbine_x = Xcoordinate(I) - origin_turbine_y = Ycoordinate(I) - downwind_turbine_x = Xcoordinate(J) - downwind_turbine_y = Ycoordinate(J) - - vector1x = 0 - xwind ! the wind direction - vector1y = 0 - ywind - vector2x = downwind_turbine_x - origin_turbine_x ! the vector between two turbines - vector2y = downwind_turbine_y - origin_turbine_y - - IF (I /= J) THEN - turbine_angle(I,J) = AngleBetweenVectors(vector1x,vector1y,vector2x,vector2y) - position_sign(I,J) = turbine_position_LorR(xwind,ywind,origin_turbine_x,origin_turbine_y,downwind_turbine_x,downwind_turbine_y) - turbine_angle(I,J) = turbine_angle(I,J)*position_sign(I,J) ! to specify the downstream turbine is on left side (+) or right side (-) - END IF - END DO - END DO - - !CALL GetNewUnit(Un) - Un = 10 - OPEN(unit = Un, status='replace',file='turbine_angles.bin',form='unformatted') - WRITE(Un) turbine_angle(:,:) - CLOSE(Un) - - OPEN(unit = Un, status='replace',file='turbine_distance.bin',form='unformatted') - WRITE(Un) length(:) - CLOSE(Un) - - ! check if the Domain_X is larger than the maximum spacing - Max_spacing = 0.0 - DO I = 1,NumWT - IF (I+Tinfluencer < NumWT+1) THEN - spacing_temp = length(I+Tinfluencer) - length(I) - IF (spacing_temp > Max_spacing) THEN - Max_spacing = spacing_temp - END IF - END IF - END DO - - - ! LOGIC WRONG ! 2.14.2014 - !IF ( Domain_X/2 < Max_spacing ) THEN - ! PRINT*, 'WARNING: Domain_x should be larger than the maximum turbine spacing' - ! CALL EXIT - !END IF - - ! test - - OPEN (unit=25,file="turbine_spacing.txt") - WRITE (25,*) length(:) - CLOSE(25) - -END SUBROUTINE wind_farm_geometry - -!------------------------------------------------------------------- -SUBROUTINE cal_wake_sector_angle() -!................................................................... -! This subroutine is to calculate the wake sector angle -! with respect to the change of the downstream distance -!................................................................... - USE wind_farm_geometry_data, ONLY: wake_sector_angle_array,scale_factor,Pi,TurbineInfluenceData,length,xwind,ywind,turbine_sort - USE read_wind_farm_parameter_data, ONLY: NumWT, Winddir, Tinfluencer,Mmt,ppR,Xcoordinate, Ycoordinate,Mstl,Domain_X - - REAL,ALLOCATABLE :: distance_array(:) - INTEGER :: I,J - - REAL :: DownStart - REAL :: DownEnd - REAL :: delta - INTEGER :: node - - INTEGER, ALLOCATABLE :: wake_width(:) - REAL, ALLOCATABLE :: wake_center_position(:,:,:) - - INTEGER :: Turbine0_index - INTEGER :: Turbine1_index - INTEGER :: Counter - REAL :: Turbine_Spacing - REAL :: vector1x - REAL :: vector1y - REAL :: vector2x - REAL :: vector2y - REAL :: Angle - REAL :: Spacing_rounding - REAL :: Sector_angle_boundary - - INTEGER :: T7_wake - INTEGER :: T8_wake - - - !''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' - ! read the wake file and wake width - !''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' - ALLOCATE (wake_width (NINT(ppR * Domain_X/2 ))) - !ALLOCATE (wake_width (ppR * 36/2 )) - ALLOCATE (wake_center_position(Mstl ,Mmt+1,3 )) - scale_factor = 10 - Pi = ACOS( -1.0 ) - - ! read the wake file and wake width - OPEN(unit = 10, status='old',file='Wake_width_Turbine_0.bin',form='unformatted') ! open an existing file - READ(10) wake_width(:) - CLOSE(10) - - OPEN(unit = 10, status='old',file='WC_Turbine_0.bin',form='unformatted') ! open an existing file - READ(10) wake_center_position(:,:,:) - CLOSE(10) - - !''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' - ! calculate the wake sector angle array - !''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' - DownStart = 1 - DownEnd = 12 ! from 1D to 34D - delta = 0.1 - node = (DownEnd-Downstart)/delta + 1 - - ALLOCATE (distance_array(node)) - ALLOCATE (wake_sector_angle_array(node)) - distance_array = ((DownEnd-DownStart)/(node-1))*[(I,I=1,node)]+(DownStart-((DownEnd-DownStart)/(node-1))) - - DO I = 1,node - wake_sector_angle_array(I) = Sector_angle(wake_width,wake_center_position,distance_array(I)) - END DO - - OPEN(unit = 10, status='replace',file='wake_sector_angle.bin',form='unformatted') - WRITE(10) wake_sector_angle_array(:) - CLOSE(10) - - !''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' - ! for a specfic downstream turbine, determine the wakes from which upstream turbines will make an effect - !''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' - !WindSectorAngle = 7 - ALLOCATE ( TurbineInfluenceData (NumWT,Tinfluencer ) ) - - TurbineInfluenceData = 0 - - DO I = 1,NumWt - Turbine0_index = turbine_sort(NumWt-I+1) ! Start from the most downwind turbine - Counter = 0 - DO J = 1,NumWt-1 - IF (Counter 0) THEN - Turbine1_index = turbine_sort(NumWt-I+1-J) - - Turbine_Spacing = length(Turbine0_index) - length(Turbine1_index) ! Absolute spacing - - Spacing_rounding = NINT(Turbine_Spacing*10.0)/10.0 ! the rounding spacing x.x to calculate the sector angle - IF (Spacing_rounding>(Mmt/(ppR/scale_factor))) THEN - Spacing_rounding = Mmt/(ppR/scale_factor) - END IF - IF (Spacing_rounding<0.1) THEN - Spacing_rounding = 0.1 - END IF - - vector1x = 0 - xwind ! the wind direction - vector1y = 0 - ywind - vector2x = Xcoordinate(Turbine0_index) - Xcoordinate(Turbine1_index) ! the vector between two turbines - vector2y = Ycoordinate(Turbine0_index) - Ycoordinate(Turbine1_index) - - !IF (Turbine_Spacing >= 3) THEN - Angle = AngleBetweenVectors(vector1x,vector1y,vector2x,vector2y) - Sector_angle_boundary = Sector_angle(wake_width,wake_center_position,Spacing_rounding) - IF ( Angle < Sector_angle_boundary ) THEN - Counter = Counter + 1 - TurbineInfluenceData(Turbine0_index,Counter) = Turbine1_index - END IF - !END IF - END IF - - END IF - END DO - END DO - - OPEN(unit = 10, status='replace',file='turbine_interaction.bin',form='unformatted') - WRITE(10) TurbineInfluenceData(:,:) - CLOSE(10) - -END SUBROUTINE cal_wake_sector_angle - -!------------------------------------------------------------------- -FUNCTION projected_length(ax,ay,bx,by) -!................................................................... -! This function is to calculate the downstream distance from the specific -! turbine to the origin of the inflow wind -! The distance is used to sort the turbines from ipstream to downstream -!................................................................... - - REAL(8) :: ax ! the x coordinate of the point a (reference point) - REAL(8) :: ay ! the y coordinate of the point a - REAL(8) :: bx ! the x coordinate of the point b - REAL(8) :: by ! the y coordinate of the point b - REAL :: projected_length - - REAL :: side_a ! triangle side a length - REAL :: side_b ! triangle side b length - REAL :: side_c ! triangle side c length - REAL :: semi ! triangle semiperimeter - REAL :: area ! triangle area - REAL :: height ! triangle height - - - !'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' - ! calculate the area of the triangle whose corners are the (0,0), turbine location and the wind origin using Heron's method - !'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' - - side_a = SQRT( (bx-ax)*(bx-ax) + (by-ay)*(by-ay) ) - side_b = SQRT( bx*bx + by*by ) - side_c = SQRT( ax*ax + ay*ay ) - semi = (side_a + side_b + side_c)/2 - - area = SQRT(ABS( semi * ( semi - side_a ) * ( semi - side_b ) * ( semi - side_c ) )) - - !'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' - ! calculate the projected length of the turbine on the wind direction vector - !'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' - - height = 2 * area / side_c - - projected_length = SQRT( side_a*side_a - height*height ) - - -END FUNCTION projected_length - -!------------------------------------------------------------------- -FUNCTION AngleBetweenVectors(x1,y1,x2,y2) -!................................................................... -! This function is to calculate the angle between two vectors -! x1,y1,x2,y2 are the vector coordinates -!................................................................... - - REAL :: x1 - REAL :: y1 - REAL :: x2 - REAL :: y2 - REAL :: Pi = ACOS( -1.0 ) - REAL :: AngleBetweenVectors - REAL :: CosAlpha - REAL :: Rad - - Pi = ACOS( -1.0 ) - - CosAlpha = (x1*x2 + y1*y2) / ( SQRT(x1*x1+y1*y1) * SQRT(x2*x2+y2*y2) ) - - !Rad = ACOS(CosAlpha-0.00001) ! ACOS(1) = NaN??!!!! - - IF (CosAlpha>1.0) THEN - CosAlpha = 1.0 - END IF - - IF (CosAlpha<-1.0) THEN - CosAlpha = -1.0 - END IF - - Rad = ACOS(CosAlpha) - - AngleBetweenVectors = Rad * 180/Pi - -END FUNCTION AngleBetweenVectors -!------------------------------------------------------------------- -FUNCTION Sector_angle(wake_width,wake_center,downstream_distance) -!................................................................... -! This function is to calculate the maximum sector angle at a certain downstream -! distance behind a wind turbine -!................................................................... - USE read_wind_farm_parameter_data, ONLY: ppR,Mstl,Mmt,RotorR - USE wind_farm_geometry_data, ONLY: Pi,scale_factor - - REAL :: Sector_angle - INTEGER :: wake_width(:) - REAL :: wake_center(:,:,:) - REAL :: downstream_distance - - INTEGER :: I,J,K - REAL :: max_temp - INTEGER :: index_I - REAL :: Wakewidth - REAL :: angle_temp - REAL :: y1_temp,y2_temp,y_temp,x_temp - - !'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' - ! Calculate the max arctan(y/x) as the 1/2 sector angle - !'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' - max_temp = 0 - - ! Calculate the index of the corresponding downstream distance - IF (MOD(downstream_distance,(1.0/(ppR/scale_factor))) == 0) THEN - J = FLOOR(downstream_distance/(1.0/(ppR/scale_factor)))+1 ! resolution = 1/(ppR/scale_factor) D - ELSE - J = FLOOR(downstream_distance/(1.0/(ppR/scale_factor)))+2 - END IF - - IF (J> Mmt+1) THEN - J = Mmt+1 - END IF - - DO I = 1,Mstl - !DO J = downstream_distance*ppR/scale_factor+1,Mmt+1 - Wakewidth = wake_width( (J-1)*scale_factor ) - - y1_temp = ABS(wake_center(I,J,2)) - y2_temp = Wakewidth/ppR*RotorR - y_temp = y1_temp + y2_temp - x_temp = wake_center(I,J,1) - - angle_temp = ATAN( y_temp / x_temp ) - - IF (angle_temp > max_temp) THEN - max_temp = angle_temp - index_I = I - END IF - !END DO - END DO - - Sector_angle = max_temp * 180/Pi - -END FUNCTION Sector_angle - -!------------------------------------------------------------------- -FUNCTION turbine_position_LorR(xwind,ywind,x0,y0,x1,y1) -!................................................................... -! This function is to see if the downwind turbine is on the left side or right side of the line -! connecting the wind origin and the upwind turbine -!................................................................... - REAL(8) :: xwind ! wind origin - REAL(8) :: ywind - REAL :: x0 ! investigated origin turbine - REAL :: y0 - REAL :: x1 ! turbine other than the investigated turbine - REAL :: y1 - INTEGER :: turbine_position_LorR - - REAL :: flag - - flag = -xwind*(y1-y0) + ywind*(x1-x0) - - IF (flag >= 0) THEN - turbine_position_LorR = 1 ! the downwind turbine is on the left side - ELSE - turbine_position_LorR = -1 ! the downwind turbine is on the right side - END IF - -END FUNCTION turbine_position_LorR - -!------------------------------------------------------------------- -SUBROUTINE rename_files(turbine_index) -!................................................................... -! This subroutine is to called to rename the output files of the DWM -! according to the turbine index -!................................................................... - - INTEGER :: turbine_index - CHARACTER(LEN=30) :: filename_u,filename_wakecenter,filename_meanU,filename_TI,filename_A,filename_FastOutput,filename_FastElm - CHARACTER(LEN=30) :: filename_u_bin,filename_wakecenter_bin,filename_meanU_bin - CHARACTER(LEN=3) :: turbine_index_character - CHARACTER(LEN=2) :: Uprefix_txt = 'U_' ! wake_velocity - CHARACTER(LEN=3) :: WCprefix_txt = 'WC_' ! wake center - CHARACTER(LEN=7) :: MeanUprefix_txt = 'Mean_U_' ! average velocity - CHARACTER(LEN=3) :: TIprefix_txt = 'TI_' ! TI of each turbine downstream - CHARACTER(LEN=6) :: Inducprefix_txt = 'Induc_' ! Induction factor of each turbine - CHARACTER(LEN=11) :: Fastprefix_out = 'FastOutput_' ! Fast output file - CHARACTER(LEN=8) :: FastElmprefix_elm = 'FastElm_' ! Fast Elm output file - !CHARACTER(LEN=11) :: Smoothprefix_bin = 'Smoothwake_' ! Smoothed out wake for downwind turbines - CHARACTER(LEN=2) :: Uprefix_bin = 'U_' - CHARACTER(LEN=3) :: WCprefix_bin = 'WC_' - CHARACTER(LEN=7) :: MeanUprefix_bin = 'Mean_U_' - - - CHARACTER(LEN=8) :: Turbineprefix = 'Turbine_' - - IF (turbine_index <= 9) THEN - write(turbine_index_character,'(i1)') turbine_index - ELSEIF (turbine_index <= 99) THEN - write(turbine_index_character,'(i2)') turbine_index - ELSE - write(turbine_index_character,'(i3)') turbine_index - END IF - - filename_u = trim(Uprefix_txt)//trim(Turbineprefix)//trim(turbine_index_character)//".txt" - filename_wakecenter = trim(WCprefix_txt)//trim(Turbineprefix)//trim(turbine_index_character)//".txt" - filename_meanU = trim(MeanUprefix_txt)//trim(Turbineprefix)//trim(turbine_index_character)//".txt" - filename_TI = trim(TIprefix_txt)//trim(Turbineprefix)//trim(turbine_index_character)//".txt" - filename_A = trim(Inducprefix_txt)//trim(Turbineprefix)//trim(turbine_index_character)//".txt" - - filename_FastOutput = trim(Fastprefix_out)//trim(Turbineprefix)//trim(turbine_index_character)//".out" - filename_FastElm = trim(FastElmprefix_elm)//trim(Turbineprefix)//trim(turbine_index_character)//".elm" - - !filename_u_bin = trim(Uprefix_bin)//trim(Turbineprefix)//trim(turbine_index_character)//".bin" - !filename_wakecenter_bin = trim(WCprefix_bin)//trim(Turbineprefix)//trim(turbine_index_character)//".bin" - !filename_meanU_bin = trim(MeanUprefix_bin)//trim(Turbineprefix)//trim(turbine_index_character)//".bin" - - -END SUBROUTINE rename_files - -!------------------------------------------------------------------- -SUBROUTINE delete_temp_files() -!................................................................... -! This routine is called to delete the temporary DWM binary files -!................................................................... - USE read_wind_farm_parameter_data, ONLY : NumWT - USE wind_farm_geometry_data, ONLY : TurbineInfluenceData - - - CHARACTER(LEN=3) :: invetigated_turbine_index_character - CHARACTER(LEN=3) :: downwind_turbine_index_character - CHARACTER(LEN=80) :: filename_u_bin,filename_wakecenter_bin,filename_meanU_bin,filename_TI_bin,filename_smoothWake_bin,filename_wakewidth_bin - CHARACTER(LEN=80) :: filename_TI_txt,filename_meanU_txt,filename_induction_txt,filename_wake_txt,filename_wakecenter_txt - CHARACTER(LEN=2) :: Uprefix_bin = 'U_' - CHARACTER(LEN=3) :: WCprefix_bin = 'WC_' - CHARACTER(LEN=7) :: MeanUprefix_bin = 'Mean_U_' - CHARACTER(LEN=3) :: Tiprefix_bin = 'TI_' - CHARACTER(LEN=11) :: SmoothWprefix_bin = 'Smoothwake_' - CHARACTER(LEN=10) :: InductionPrefix = 'Induction_' - CHARACTER(LEN=6) :: Wakeprefix = 'WakeU_' - CHARACTER(LEN=11) :: WWprefix_bin = 'Wake_width_' - CHARACTER(LEN=22) :: Prefix = 'DWM-results/' - CHARACTER(LEN=4) :: connectionprefix = '_to_' - CHARACTER(LEN=8) :: Turbineprefix = 'Turbine_' - INTEGER :: I,J,K - INTEGER :: downwindturbine_number - INTEGER,ALLOCATABLE :: downwind_turbine_index(:) - - - DO I = 1,NumWT - !bjj: you could call Num2LStr(I) instead of using this if statement: - IF (I <= 9) THEN - write(invetigated_turbine_index_character,'(i1)') I - ELSEIF (I <= 99) THEN - write(invetigated_turbine_index_character,'(i2)') I - ELSE - write(invetigated_turbine_index_character,'(i3)') I - END IF - - filename_meanU_bin = trim(Prefix)//trim(MeanUprefix_bin)//trim(Turbineprefix)//trim(invetigated_turbine_index_character)//".bin" - OPEN (29, file=filename_meanU_bin) - CLOSE (29, status='delete') - - filename_wakecenter_bin = trim(Prefix)//trim(WCprefix_bin)//trim(Turbineprefix)//trim(invetigated_turbine_index_character)//".bin" - OPEN (29, file=filename_wakecenter_bin) - CLOSE (29, status='delete') - END DO - - - - DO K = 1,NumWT - IF (K <= 9) THEN - write(invetigated_turbine_index_character,'(i1)') K - ELSEIF (K <= 99) THEN - write(invetigated_turbine_index_character,'(i2)') K - ELSE - write(invetigated_turbine_index_character,'(i3)') K - END IF - - - downwindturbine_number = 0 - IF (.NOT. ALLOCATED(downwind_turbine_index) ) THEN - ALLOCATE (downwind_turbine_index(NumWT-1)) - END IF - - DO I = 1,1 !Tinfluencer - DO J = 1,NumWT - IF (TurbineInfluenceData(J,I) == K) THEN - downwindturbine_number = downwindturbine_number + 1 - downwind_turbine_index(downwindturbine_number) = J - END IF - END DO - END DO - - IF (downwindturbine_number /= 0 ) THEN - DO I = 1,downwindturbine_number - IF (downwind_turbine_index(I) <= 9) THEN - write(downwind_turbine_index_character,'(i1)') downwind_turbine_index(I) - ELSEIF (downwind_turbine_index(I) <= 99) THEN - write(downwind_turbine_index_character,'(i2)') downwind_turbine_index(I) - ELSE - write(downwind_turbine_index_character,'(i3)') downwind_turbine_index(I) - END IF - - filename_u_bin = trim(Prefix)//trim(Uprefix_bin)//trim(Turbineprefix)//trim(invetigated_turbine_index_character)& - //trim(connectionprefix)//trim(downwind_turbine_index_character)//".bin" - filename_TI_bin = trim(Prefix)//trim(TIprefix_bin)//trim(Turbineprefix)//trim(invetigated_turbine_index_character)& - //trim(connectionprefix)//trim(downwind_turbine_index_character)//".bin" - filename_smoothWake_bin = trim(Prefix)//trim(SmoothWprefix_bin)//trim(Turbineprefix)//trim(invetigated_turbine_index_character)& - //trim(connectionprefix)//trim(downwind_turbine_index_character)//".bin" - - OPEN (29, file=filename_u_bin) - CLOSE (29, status='delete') - - OPEN (29, file=filename_TI_bin) - CLOSE (29, status='delete') - - OPEN (29, file=filename_smoothWake_bin) - CLOSE (29, status='delete') - END DO - END IF - END DO - - - OPEN (29, file='turbine_angles.bin') - CLOSE (29, status='delete') - - OPEN (29, file='turbine_distance.bin') - CLOSE (29, status='delete') - - OPEN (29, file='turbine_interaction.bin') - CLOSE (29, status='delete') - - OPEN (29, file='wake_sector_angle.bin') - CLOSE (29, status='delete') - - OPEN (29, file='Wake_width_Turbine_0.bin') - CLOSE (29, status='delete') - - OPEN (29, file='WC_Turbine_0.bin') - CLOSE (29, status='delete') - - OPEN (29, file='wind_farm_turbine_sort.bin') - CLOSE (29, status='delete') - - -END SUBROUTINE delete_temp_files - -!------------------------------------------------------------------- -SUBROUTINE Driver_init() -!................................................................... -! This routine called to initiate the Driver program -!................................................................... - USE DWM_init_data, ONLY:OutFileRoot, InputFile - - INTEGER :: Stat - CHARACTER(1024) :: DirName - - CALL CheckArgs( InputFile, Stat ) - - CALL GetRoot( InputFile, OutFileRoot ) - - CALL Get_CWD ( DirName, Stat ) - -END SUBROUTINE Driver_init - -!---------------------------------------------------------------------------------- -SUBROUTINE rename_FAST_output(SimulationOrder_index) -!............................................................................ -! This routine is called to rename the fast output -!............................................................................ -#ifdef __INTEL_COMPILER - USE IFPORT -#endif - USE wind_farm_geometry_data, ONLY: turbine_sort - USE DWM_init_data, ONLY: OutFileRoot - - CHARACTER(LEN=80) :: filename_FastOutput,filename_FastElm - CHARACTER(LEN=11) :: Fastprefix = 'FastOutput_' ! Fast output file - CHARACTER(LEN=8) :: FastElmprefix = 'FastElm_' ! Fast Elm output file - INTEGER :: RESULT - CHARACTER(LEN=22) :: Prefix = 'DWM-results/' - CHARACTER(LEN=8) :: Turbineprefix = 'Turbine_' - CHARACTER(LEN=3) :: invetigated_turbine_index_character - INTEGER :: WT_index - INTEGER :: SimulationOrder_index - - IF ( SimulationOrder_index > 0 ) THEN ! exclude the first turbine - - WT_index = turbine_sort(SimulationOrder_index) - - IF (WT_index <= 9) THEN - write(invetigated_turbine_index_character,'(i1)') WT_index - ELSEIF (WT_index <= 99) THEN - write(invetigated_turbine_index_character,'(i2)') WT_index - ELSE - write(invetigated_turbine_index_character,'(i3)') WT_index - END IF - - ! Rename the FAST output wrt the turbine index - filename_FastOutput = trim(Prefix)//trim(Fastprefix)//trim(Turbineprefix)//trim(invetigated_turbine_index_character)//".out" - filename_FastElm = trim(Prefix)//trim(FastElmprefix)//trim(Turbineprefix)//trim(invetigated_turbine_index_character)//".AD.out" - - RESULT =rename( TRIM(OutFileRoot)//'.out', filename_FastOutput) !bjj: what if I'm using .outb in FAST instead of .out? - RESULT =rename( TRIM(OutFileRoot)//'.AD.out',filename_FastElm ) !bjj: *.elm has been renamed *.AD.out in FAST v8. Also, .AD.out files are not always generated. - END IF - -END SUBROUTINE rename_FAST_output - -END MODULE DWM_driver_wind_farm_sub \ No newline at end of file diff --git a/modules/aerodyn14/src/GenSubs.f90 b/modules/aerodyn14/src/GenSubs.f90 deleted file mode 100644 index e02fd5cbc4..0000000000 --- a/modules/aerodyn14/src/GenSubs.f90 +++ /dev/null @@ -1,669 +0,0 @@ -!********************************************************************************************************************************** - MODULE AeroGenSubs - - - USE NWTC_LIBRARY - USE AeroDyn14_Types - -IMPLICIT NONE - -! SUBROUTINE AllocArrays( Arg ) -! SUBROUTINE ElemOpen( ElemFile ) -! SUBROUTINE ElemOut( ) - - INTEGER(IntKi) , PARAMETER :: MAXINFL = 6 - - - CONTAINS - ! **************************************************** - SUBROUTINE AllocArrays ( InitInp, P, xc, xd, z, m, y, Arg ) - ! Allocates space to the phenomenal number of arrays - ! we use in this program - ! **************************************************** - ! Passed Variables: - TYPE(AD14_InitInputType), INTENT(INOUT) :: InitInp - TYPE(AD14_ParameterType), INTENT(INOUT) :: p ! Parameters - TYPE(AD14_ContinuousStateType), INTENT(INOUT) :: xc ! Initial continuous states - TYPE(AD14_DiscreteStateType), INTENT(INOUT) :: xd ! Initial discrete states - TYPE(AD14_ConstraintStateType), INTENT(INOUT) :: z ! Initial guess of the constraint states - TYPE(AD14_MiscVarType), INTENT(INOUT) :: m ! Initial misc/optimization variables - TYPE(AD14_OutputType), INTENT(INOUT) :: y ! Initial system outputs (outputs are not calculated; - CHARACTER(*), INTENT(IN ) :: Arg - - ! Local Variables: - - INTEGER(4) :: Sttus - - INTEGER :: NElm, NB, MaxTable, NumCl, NumFoil, NumElOut, NumWndElOut - - -!bjj: I really don't understand why these aren't 3 separate subroutines... - - -NB = P%NumBl -Nelm = P%Element%Nelm -NumFoil = P%AirFoil%NumFoil -NumCl = P%AirFoil%NumCl -MaxTable = P%AirFoil%MaxTable -NumElOut = m%ElOut%NumElOut -NumWndElOut = m%ElOut%NumWndElOut - - -Sttus = 0.0 - -IF (Arg(1:7) == 'Element') THEN - - IF (.NOT. ALLOCATED(m%ElOut%ElPrList)) ALLOCATE ( m%ElOut%ElPrList(NELM) , STAT=Sttus ) - IF ( Sttus /= 0 ) CALL ProgAbort ( ' Error allocating memory for ElPrList array.' ) - m%ElOut%ElPrList ( : ) = 0 - - IF (.NOT. ALLOCATED(m%ElOut%WndElPrList)) ALLOCATE ( m%ElOut%WndElPrList(NELM) , STAT=Sttus ) - IF ( Sttus /= 0 ) CALL ProgAbort ( ' Error allocating memory for WndElPrList array.' ) - m%ElOut%WndElPrList ( : ) = 0 - - IF (.NOT. ALLOCATED(m%Element%A)) ALLOCATE ( m%Element%A(NELM,NB) , STAT=Sttus ) - IF ( Sttus /= 0 ) CALL ProgAbort ( ' Error allocating memory for A array.' ) - m%Element%A ( :, : ) = 0.0 - - IF (.NOT. ALLOCATED(m%Element%AP)) ALLOCATE ( m%Element%AP(NELM,NB) , STAT=Sttus ) - IF ( Sttus /= 0 ) CALL ProgAbort ( ' Error allocating memory for AP array.' ) - -! Beddoes arrays - IF (P%Dstall) THEN - - IF (.NOT. ALLOCATED(m%Beddoes%ADOT)) ALLOCATE ( m%Beddoes%ADOT(NELM,NB) , STAT=Sttus ) - IF ( Sttus /= 0 ) CALL ProgAbort ( ' Error allocating memory for ADOT array.' ) - m%Beddoes%ADOT ( :, : ) = 0.0 - - IF (.NOT. ALLOCATED(m%Beddoes%ADOT1)) ALLOCATE ( m%Beddoes%ADOT1(NELM,NB) , STAT=Sttus ) - IF ( Sttus /= 0 ) CALL ProgAbort ( ' Error allocating memory for ADOT1 array.' ) - - IF (.NOT. ALLOCATED(m%Beddoes%AFE)) ALLOCATE ( m%Beddoes%AFE(NELM,NB) , STAT=Sttus ) - IF ( Sttus /= 0 ) CALL ProgAbort ( ' Error allocating memory for AFE array.' ) - m%Beddoes%AFE(:,:) = 0.0 - - IF (.NOT. ALLOCATED(m%Beddoes%AFE1)) ALLOCATE ( m%Beddoes%AFE1(NELM,NB) , STAT=Sttus ) - IF ( Sttus /= 0 ) CALL ProgAbort ( ' Error allocating memory for AFE1 array.' ) - - IF (.NOT. ALLOCATED(m%Beddoes%ANE)) ALLOCATE ( m%Beddoes%ANE(NELM,NB) , STAT=Sttus ) - IF ( Sttus /= 0 ) CALL ProgAbort ( ' Error allocating memory for ANE array.' ) - m%Beddoes%ANE ( :, : ) = 0.0 - - IF (.NOT. ALLOCATED(m%Beddoes%ANE1)) ALLOCATE ( m%Beddoes%ANE1(NELM,NB) , STAT=Sttus ) - IF ( Sttus /= 0 ) CALL ProgAbort ( ' Error allocating memory for ANE1 array.' ) - - IF (.NOT. ALLOCATED(m%Beddoes%AOD)) ALLOCATE ( m%Beddoes%AOD(NELM,MAXTABLE) , STAT=Sttus ) - IF ( Sttus /= 0 ) CALL ProgAbort ( ' Error allocating memory for AOD array.' ) - m%Beddoes%AOD = 0.0_ReKi - - IF (.NOT. ALLOCATED(m%Beddoes%AOL)) ALLOCATE ( m%Beddoes%AOL(NELM,MAXTABLE) , STAT=Sttus ) - IF ( Sttus /= 0 ) CALL ProgAbort ( ' Error allocating memory for AOL array.' ) - m%Beddoes%AOL = 0.0_ReKi - - - IF (.NOT. ALLOCATED(m%Beddoes%CDO)) ALLOCATE ( m%Beddoes%CDO(NELM,MAXTABLE) , STAT=Sttus ) - IF ( Sttus /= 0 ) CALL ProgAbort ( ' Error allocating memory for CDO array.' ) - - IF (.NOT. ALLOCATED(m%Beddoes%CNA)) ALLOCATE ( m%Beddoes%CNA(NELM,MAXTABLE) , STAT=Sttus ) - IF ( Sttus /= 0 ) CALL ProgAbort ( ' Error allocating memory for CNA array.' ) - - IF (.NOT. ALLOCATED(m%Beddoes%CNP)) ALLOCATE ( m%Beddoes%CNP(NELM,NB) , STAT=Sttus ) - IF ( Sttus /= 0 ) CALL ProgAbort ( ' Error allocating memory for CNP array.' ) - m%Beddoes%CNP ( :, : ) = 0.0 - - IF (.NOT. ALLOCATED(m%Beddoes%CNP1)) ALLOCATE ( m%Beddoes%CNP1(NELM,NB) , STAT=Sttus ) - IF ( Sttus /= 0 ) CALL ProgAbort ( ' Error allocating memory for CNP1 array.' ) - - IF (.NOT. ALLOCATED(m%Beddoes%CNPD)) ALLOCATE ( m%Beddoes%CNPD(NELM,NB) , STAT=Sttus ) - IF ( Sttus /= 0 ) CALL ProgAbort ( ' Error allocating memory for CNPD array.' ) - m%Beddoes%CNPD ( :, : ) = 0.0 - - IF (.NOT. ALLOCATED(m%Beddoes%CNPD1)) ALLOCATE ( m%Beddoes%CNPD1(NELM,NB) , STAT=Sttus ) - IF ( Sttus /= 0 ) CALL ProgAbort ( ' Error allocating memory for CNPD1 array.' ) - - IF (.NOT. ALLOCATED(m%Beddoes%CNPOT)) ALLOCATE ( m%Beddoes%CNPOT(NELM,NB) , STAT=Sttus ) - IF ( Sttus /= 0 ) CALL ProgAbort ( ' Error allocating memory for CNPOT array.' ) - m%Beddoes%CNPOT ( :, : ) = 0.0 - - IF (.NOT. ALLOCATED(m%Beddoes%CNPOT1)) ALLOCATE ( m%Beddoes%CNPOT1(NELM,NB) , STAT=Sttus ) - IF ( Sttus /= 0 ) CALL ProgAbort ( ' Error allocating memory for CNPOT1 array.' ) - - IF (.NOT. ALLOCATED(m%Beddoes%CNS)) ALLOCATE ( m%Beddoes%CNS(NELM,MAXTABLE) , STAT=Sttus ) - IF ( Sttus /= 0 ) CALL ProgAbort ( ' Error allocating memory for CNS array.' ) - - IF (.NOT. ALLOCATED(m%Beddoes%CNSL)) ALLOCATE ( m%Beddoes%CNSL(NELM,MAXTABLE) , STAT=Sttus ) - IF ( Sttus /= 0 ) CALL ProgAbort ( ' Error allocating memory for CNSL array.' ) - - IF (.NOT. ALLOCATED(m%Beddoes%CNV)) ALLOCATE ( m%Beddoes%CNV(NELM,NB) , STAT=Sttus ) - IF ( Sttus /= 0 ) CALL ProgAbort ( ' Error allocating memory for CNV array.' ) - m%Beddoes%CNV ( :, : ) = 0.0 - - IF (.NOT. ALLOCATED(m%Beddoes%CVN)) ALLOCATE ( m%Beddoes%CVN(NELM,NB) , STAT=Sttus ) - IF ( Sttus /= 0 ) CALL ProgAbort ( ' Error allocating memory for CVN array.' ) - m%Beddoes%CVN ( :, : ) = 0.0 - - IF (.NOT. ALLOCATED(m%Beddoes%CVN1)) ALLOCATE ( m%Beddoes%CVN1(NELM,NB) , STAT=Sttus ) - IF ( Sttus /= 0 ) CALL ProgAbort ( ' Error allocating memory for CVN1 array.' ) - - IF (.NOT. ALLOCATED(m%Beddoes%DF)) ALLOCATE ( m%Beddoes%DF(NELM,NB) , STAT=Sttus ) - IF ( Sttus /= 0 ) CALL ProgAbort ( ' Error allocating memory for DF array.' ) - m%Beddoes%DF( :, : ) = 0.0 - - IF (.NOT. ALLOCATED(m%Beddoes%DFAFE)) ALLOCATE ( m%Beddoes%DFAFE(NELM,NB) , STAT=Sttus ) - IF ( Sttus /= 0 ) CALL ProgAbort ( ' Error allocating memory for DFAFE array.' ) - m%Beddoes%DFAFE ( :, : ) = 0.0 - - IF (.NOT. ALLOCATED(m%Beddoes%DFAFE1)) ALLOCATE ( m%Beddoes%DFAFE1(NELM,NB) , STAT=Sttus ) - IF ( Sttus /= 0 ) CALL ProgAbort ( ' Error allocating memory for DFAFE1 array.' ) - - IF (.NOT. ALLOCATED(m%Beddoes%DFC)) ALLOCATE ( m%Beddoes%DFC(NELM,NB) , STAT=Sttus ) - IF ( Sttus /= 0 ) CALL ProgAbort ( ' Error allocating memory for DFC array.' ) - m%Beddoes%DFC ( :, : ) = 0.0 - - IF (.NOT. ALLOCATED(m%Beddoes%DN)) ALLOCATE ( m%Beddoes%DN(NELM,NB) , STAT=Sttus ) - IF ( Sttus /= 0 ) CALL ProgAbort ( ' Error allocating memory for DN array.' ) - m%Beddoes%DN ( :, : ) = 0.0 - - IF (.NOT. ALLOCATED(m%Beddoes%DPP)) ALLOCATE ( m%Beddoes%DPP(NELM,NB) , STAT=Sttus ) - IF ( Sttus /= 0 ) CALL ProgAbort ( ' Error allocating memory for DP array.' ) - m%Beddoes%DPP ( :, : ) = 0.0 - - IF (.NOT. ALLOCATED(m%Beddoes%DQ)) ALLOCATE ( m%Beddoes%DQ(NELM,NB) , STAT=Sttus ) - IF ( Sttus /= 0 ) CALL ProgAbort ( ' Error allocating memory for DQ array.' ) - m%Beddoes%DQ ( :, : ) = 0.0 - - IF (.NOT. ALLOCATED(m%Beddoes%DQP)) ALLOCATE ( m%Beddoes%DQP(NELM,NB) , STAT=Sttus ) - IF ( Sttus /= 0 ) CALL ProgAbort ( ' Error allocating memory for DQP array.' ) - m%Beddoes%DQP ( :, : ) = 0.0 - - IF (.NOT. ALLOCATED(m%Beddoes%DQP1)) ALLOCATE ( m%Beddoes%DQP1(NELM,NB) , STAT=Sttus ) - IF ( Sttus /= 0 ) CALL ProgAbort ( ' Error allocating memory for DQP1 array.' ) - - IF (.NOT. ALLOCATED(m%Beddoes%FSP)) ALLOCATE ( m%Beddoes%FSP(NELM,NB) , STAT=Sttus ) - IF ( Sttus /= 0 ) CALL ProgAbort ( ' Error allocating memory for FSP array.' ) - m%Beddoes%FSP ( :, : ) = 0.0 - - IF (.NOT. ALLOCATED(m%Beddoes%FSP1)) ALLOCATE ( m%Beddoes%FSP1(NELM,NB) , STAT=Sttus ) - IF ( Sttus /= 0 ) CALL ProgAbort ( ' Error allocating memory for FSP1 array.' ) - - IF (.NOT. ALLOCATED(m%Beddoes%FSPC)) ALLOCATE ( m%Beddoes%FSPC(NELM,NB) , STAT=Sttus ) - IF ( Sttus /= 0 ) CALL ProgAbort ( ' Error allocating memory for FSPC array.' ) - m%Beddoes%FSPC ( :, : ) = 0.0 - - IF (.NOT. ALLOCATED(m%Beddoes%FSPC1)) ALLOCATE ( m%Beddoes%FSPC1(NELM,NB) , STAT=Sttus ) - IF ( Sttus /= 0 ) CALL ProgAbort ( ' Error allocating memory for FSPC1 array.' ) - - IF (.NOT. ALLOCATED(m%Beddoes%OLDCNV)) ALLOCATE ( m%Beddoes%OLDCNV(NELM,NB) , STAT=Sttus ) - IF ( Sttus /= 0 ) CALL ProgAbort ( ' Error allocating memory for OLDCNV array.' ) - - IF (.NOT. ALLOCATED(m%Beddoes%OLDDF)) ALLOCATE ( m%Beddoes%OLDDF(NELM,NB) , STAT=Sttus ) - IF ( Sttus /= 0 ) CALL ProgAbort ( ' Error allocating memory for OLDDF array.' ) - - IF (.NOT. ALLOCATED(m%Beddoes%OLDDFC)) ALLOCATE ( m%Beddoes%OLDDFC(NELM,NB) , STAT=Sttus ) - IF ( Sttus /= 0 ) CALL ProgAbort ( ' Error allocating memory for OLDDFC array.' ) - - IF (.NOT. ALLOCATED(m%Beddoes%OLDDN)) ALLOCATE ( m%Beddoes%OLDDN(NELM,NB) , STAT=Sttus ) - IF ( Sttus /= 0 ) CALL ProgAbort ( ' Error allocating memory for OLDDN array.' ) - - IF (.NOT. ALLOCATED(m%Beddoes%OLDDPP)) ALLOCATE ( m%Beddoes%OLDDPP(NELM,NB) , STAT=Sttus ) - IF ( Sttus /= 0 ) CALL ProgAbort ( ' Error allocating memory for OLDDP array.' ) - - IF (.NOT. ALLOCATED(m%Beddoes%OLDDQ)) ALLOCATE ( m%Beddoes%OLDDQ(NELM,NB) , STAT=Sttus ) - IF ( Sttus /= 0 ) CALL ProgAbort ( ' Error allocating memory for OLDDQ array.' ) - - IF (.NOT. ALLOCATED(m%Beddoes%OLDTAU)) ALLOCATE ( m%Beddoes%OLDTAU(NELM,NB) , STAT=Sttus ) - IF ( Sttus /= 0 ) CALL ProgAbort ( ' Error allocating memory for OLDTAU array.' ) - - IF (.NOT. ALLOCATED(m%Beddoes%OLDXN)) ALLOCATE ( m%Beddoes%OLDXN(NELM,NB) , STAT=Sttus ) - IF ( Sttus /= 0 ) CALL ProgAbort ( ' Error allocating memory for OLDXN array.' ) - - IF (.NOT. ALLOCATED(m%Beddoes%OLDYN)) ALLOCATE ( m%Beddoes%OLDYN(NELM,NB) , STAT=Sttus ) - IF ( Sttus /= 0 ) CALL ProgAbort ( ' Error allocating memory for OLDYN array.' ) - - IF (.NOT. ALLOCATED(m%Beddoes%QX)) ALLOCATE ( m%Beddoes%QX(NELM,NB) , STAT=Sttus ) - IF ( Sttus /= 0 ) CALL ProgAbort ( ' Error allocating memory for QX array.' ) - m%Beddoes%QX ( :, : ) = 0.0 - - IF (.NOT. ALLOCATED(m%Beddoes%QX1)) ALLOCATE ( m%Beddoes%QX1(NELM,NB) , STAT=Sttus ) - IF ( Sttus /= 0 ) CALL ProgAbort ( ' Error allocating memory for QX1 array.' ) - - IF (.NOT. ALLOCATED(m%Beddoes%TAU)) ALLOCATE ( m%Beddoes%TAU(NELM,NB) , STAT=Sttus ) - IF ( Sttus /= 0 ) CALL ProgAbort ( ' Error allocating memory for TAU array.' ) - m%Beddoes%TAU(:,:) = 0.0 - - IF (.NOT. ALLOCATED(m%Beddoes%XN)) ALLOCATE ( m%Beddoes%XN(NELM,NB) , STAT=Sttus ) - IF ( Sttus /= 0 ) CALL ProgAbort ( ' Error allocating memory for XN array.' ) - m%Beddoes%XN ( :, : ) = 0.0 - - IF (.NOT. ALLOCATED(m%Beddoes%YN)) ALLOCATE ( m%Beddoes%YN(NELM,NB) , STAT=Sttus ) - IF ( Sttus /= 0 ) CALL ProgAbort ( ' Error allocating memory for YN array.' ) - m%Beddoes%YN ( :, : ) = 0.0 - - IF (.NOT. ALLOCATED(m%Beddoes%OLDSEP)) ALLOCATE ( m%Beddoes%OLDSEP(NELM,NB) , STAT=Sttus ) - IF ( Sttus /= 0 ) CALL ProgAbort ( ' Error allocating memory for OLDSEP array.' ) - - IF (.NOT. ALLOCATED(m%Beddoes%BEDSEP)) ALLOCATE ( m%Beddoes%BEDSEP(NELM,NB) , STAT=Sttus ) - IF ( Sttus /= 0 ) CALL ProgAbort ( ' Error allocating memory for BEDSEP array.' ) - m%Beddoes%BEDSEP(:,:) = .FALSE. - - ENDIF ! Beddoes arrays - - IF (.NOT. ALLOCATED(P%Blade%C)) ALLOCATE ( P%Blade%C(NELM) , STAT=Sttus ) - IF ( Sttus /= 0 ) CALL ProgAbort ( ' Error allocating memory for C array.' ) - - IF (.NOT. ALLOCATED(P%Blade%DR)) ALLOCATE ( P%Blade%DR(NELM) , STAT=Sttus ) - IF ( Sttus /= 0 ) CALL ProgAbort ( ' Error allocating memory for DR array.' ) - - IF (.NOT. ALLOCATED(P%Element%RELM)) ALLOCATE ( P%Element%RELM(NELM) , STAT=Sttus ) - IF ( Sttus /= 0 ) CALL ProgAbort ( ' Error allocating memory for RELM array.' ) - - IF (.NOT. ALLOCATED(P%Element%TWIST)) ALLOCATE ( P%Element%TWIST(NELM) , STAT=Sttus ) - IF ( Sttus /= 0 ) CALL ProgAbort ( ' Error allocating memory for TWIST array.' ) - - IF (.NOT. ALLOCATED(P%Element%TLCNST)) ALLOCATE ( P%Element%TLCNST(NELM) , STAT=Sttus ) - IF ( Sttus /= 0 ) CALL ProgAbort ( ' Error allocating memory for TLCNST array.' ) - P%Element%TLCNST = 99.0 - - IF (.NOT. ALLOCATED(P%Element%HLCNST)) ALLOCATE ( P%Element%HLCNST(NELM) , STAT=Sttus ) - IF ( Sttus /= 0 ) CALL ProgAbort ( ' Error allocating memory for HLCNST array.' ) - P%Element%HLCNST = 99.0 - - IF (.NOT. ALLOCATED(P%AirFoil%NFOIL)) ALLOCATE ( P%AirFoil%NFOIL(NELM) , STAT=Sttus ) - IF ( Sttus /= 0 ) CALL ProgAbort ( ' Error allocating memory for NFOIL array.' ) - - IF (.NOT. ALLOCATED(P%AirFoil%NLIFT)) ALLOCATE ( P%AirFoil%NLIFT(NELM) , STAT=Sttus ) - IF ( Sttus /= 0 ) CALL ProgAbort ( ' Error allocating memory for NLIFT array.' ) - - IF (.NOT. ALLOCATED(P%AirFoil%NTables)) ALLOCATE ( P%AirFoil%NTables(NELM) , STAT=Sttus ) - IF ( Sttus /= 0 ) CALL ProgAbort ( ' Error allocating memory for NTables array.' ) - - IF (P%Dyninfl .OR. m%Dyninit) THEN - IF (.NOT. ALLOCATED(m%DynInflow%RMC_SAVE)) ALLOCATE ( m%DynInflow%RMC_SAVE ( NB, NELM, MAXINFL ) , STAT=Sttus ) - IF ( Sttus /= 0 ) CALL ProgAbort ( ' Error allocating memory for RMC_SAVE array.' ) - m%DynInflow%RMC_SAVE = 0.0 - - IF (.NOT. ALLOCATED(m%DynInflow%RMS_SAVE)) ALLOCATE ( m%DynInflow%RMS_SAVE ( NB, NELM, MAXINFL ) , STAT=Sttus ) - IF ( Sttus /= 0 ) CALL ProgAbort ( ' Error allocating memory for RMS_SAVE array.' ) - m%DynInflow%RMS_SAVE = 0.0 - ENDIF - -ELSEIF (Arg(1:7) == 'ElPrint') THEN - - IF ( m%ElOut%NumElOut > 0 ) THEN - IF (.NOT. ALLOCATED(m%ElOut%AAA)) ALLOCATE ( m%ElOut%AAA(NumElOut) , STAT=Sttus ) - IF ( Sttus /= 0 ) CALL ProgAbort ( ' Error allocating memory for AAA array.' ) - - IF (.NOT. ALLOCATED(m%ElOut%AAP)) ALLOCATE ( m%ElOut%AAP(NumElOut) , STAT=Sttus ) - IF ( Sttus /= 0 ) CALL ProgAbort ( ' Error allocating memory for AAP array.' ) - - IF (.NOT. ALLOCATED(m%ElOut%ALF)) ALLOCATE ( m%ElOut%ALF(NumElOut) , STAT=Sttus ) - IF ( Sttus /= 0 ) CALL ProgAbort ( ' Error allocating memory for ALF array.' ) - - IF (.NOT. ALLOCATED(m%ElOut%CDD)) ALLOCATE ( m%ElOut%CDD(NumElOut) , STAT=Sttus ) - IF ( Sttus /= 0 ) CALL ProgAbort ( ' Error allocating memory for CDD array.' ) - - IF (.NOT. ALLOCATED(m%ElOut%CLL)) ALLOCATE ( m%ElOut%CLL(NumElOut) , STAT=Sttus ) - IF ( Sttus /= 0 ) CALL ProgAbort ( ' Error allocating memory for CLL array.' ) - - IF (.NOT. ALLOCATED(m%ElOut%CMM)) ALLOCATE ( m%ElOut%CMM(NumElOut) , STAT=Sttus ) - IF ( Sttus /= 0 ) CALL ProgAbort ( ' Error allocating memory for CMM array.' ) - - IF (.NOT. ALLOCATED(m%ElOut%CNN)) ALLOCATE ( m%ElOut%CNN(NumElOut) , STAT=Sttus ) - IF ( Sttus /= 0 ) CALL ProgAbort ( ' Error allocating memory for CNN array.' ) - - IF (.NOT. ALLOCATED(m%ElOut%CTT)) ALLOCATE ( m%ElOut%CTT(NumElOut) , STAT=Sttus ) - IF ( Sttus /= 0 ) CALL ProgAbort ( ' Error allocating memory for CTT array.' ) - - IF (.NOT. ALLOCATED(m%ElOut%DFNSAV)) ALLOCATE ( m%ElOut%DFNSAV(NumElOut) , STAT=Sttus ) - IF ( Sttus /= 0 ) CALL ProgAbort ( ' Error allocating memory for DFNSAV array.' ) - - IF (.NOT. ALLOCATED(m%ElOut%DFTSAV)) ALLOCATE ( m%ElOut%DFTSAV(NumElOut) , STAT=Sttus ) - IF ( Sttus /= 0 ) CALL ProgAbort ( ' Error allocating memory for DFTSAV array.' ) - - IF (.NOT. ALLOCATED(m%ElOut%DynPres)) ALLOCATE ( m%ElOut%DynPres(NumElOut) , STAT=Sttus ) - IF ( Sttus /= 0 ) CALL ProgAbort ( ' Error allocating memory for DynPres array.' ) - - IF (.NOT. ALLOCATED(m%ElOut%PMM)) ALLOCATE ( m%ElOut%PMM(NumElOut) , STAT=Sttus ) - IF ( Sttus /= 0 ) CALL ProgAbort ( ' Error allocating memory for PMM array.' ) - - IF (.NOT. ALLOCATED(m%ElOut%PITSAV)) ALLOCATE ( m%ElOut%PITSAV(NumElOut) , STAT=Sttus ) - IF ( Sttus /= 0 ) CALL ProgAbort ( ' Error allocating memory for PITSAV array.' ) - - IF (.NOT. ALLOCATED(m%ElOut%ReyNum)) ALLOCATE ( m%ElOut%ReyNum(NumElOut) , STAT=Sttus ) - IF ( Sttus /= 0 ) CALL ProgAbort ( ' Error allocating memory for ReyNum array.' ) - - IF (.NOT. ALLOCATED(m%ElOut%Gamma)) ALLOCATE ( m%ElOut%Gamma(NumElOut) , STAT=Sttus ) - IF ( Sttus /= 0 ) CALL ProgAbort ( ' Error allocating memory for Gamma array.' ) - - IF (.NOT. ALLOCATED(m%ElOut%ElPrNum)) ALLOCATE ( m%ElOut%ElPrNum(NumElOut) , STAT=Sttus ) - IF ( Sttus /= 0 ) CALL ProgAbort ( ' Error allocating memory for ElPrNum array.' ) - m%ElOut%ElPrNum ( : ) = 0 - - END IF - - IF ( NumWndElOut > 0 ) THEN - - IF (.NOT. ALLOCATED(m%ElOut%WndElPrNum)) ALLOCATE ( m%ElOut%WndElPrNum(NumWndElOut) , STAT=Sttus ) - IF ( Sttus /= 0 ) CALL ProgAbort ( ' Error allocating memory for WndElPrNum array.' ) - m%ElOut%WndElPrNum ( : ) = 0 - - IF (.NOT. ALLOCATED(m%ElOut%SaveVX)) ALLOCATE ( m%ElOut%SaveVX(NumWndElOut,NB) , STAT=Sttus ) - IF ( Sttus /= 0 ) CALL ProgAbort ( ' Error allocating memory for SaveVX array.' ) - - IF (.NOT. ALLOCATED(m%ElOut%SaveVY)) ALLOCATE ( m%ElOut%SaveVY(NumWndElOut,NB) , STAT=Sttus ) - IF ( Sttus /= 0 ) CALL ProgAbort ( ' Error allocating memory for SaveVY array.' ) - - IF (.NOT. ALLOCATED(m%ElOut%SaveVZ)) ALLOCATE ( m%ElOut%SaveVZ(NumWndElOut,NB) , STAT=Sttus ) - IF ( Sttus /= 0 ) CALL ProgAbort ( ' Error allocating memory for SaveVZ array.' ) - - END IF - -ELSEIF (Arg(1:8) == 'Aerodata') THEN - - IF (.NOT. ALLOCATED(m%AirFoil%AL)) ALLOCATE ( m%AirFoil%AL(NumFoil,NumCL) , STAT=Sttus ) - IF ( Sttus /= 0 ) CALL ProgAbort ( ' Error allocating memory for AL array.' ) - - IF (.NOT. ALLOCATED(m%AirFoil%CD)) ALLOCATE ( m%AirFoil%CD(NumFoil,NumCL,MAXTABLE) , STAT=Sttus ) - IF ( Sttus /= 0 ) CALL ProgAbort ( ' Error allocating memory for CD array.' ) - - IF (.NOT. ALLOCATED(m%AirFoil%CL)) ALLOCATE ( m%AirFoil%CL(NumFoil,NumCL,MAXTABLE) , STAT=Sttus ) - IF ( Sttus /= 0 ) CALL ProgAbort ( ' Error allocating memory for CL array.' ) - - IF (.NOT. ALLOCATED(m%AirFoil%CM)) ALLOCATE ( m%AirFoil%CM(NumFoil,NumCL,MAXTABLE) , STAT=Sttus ) - IF ( Sttus /= 0 ) CALL ProgAbort ( ' Error allocating memory for CM array.' ) - - IF (.NOT. ALLOCATED(p%AirFoil%MulTabMet)) ALLOCATE ( p%AirFoil%MulTabMet(NumFoil,MAXTABLE) , STAT=Sttus ) - IF ( Sttus /= 0 ) CALL ProgAbort ( ' Error allocating memory for MulTabMet array.' ) - - IF (P%DSTALL) THEN - - IF (.NOT. ALLOCATED(m%Beddoes%FTB)) ALLOCATE ( m%Beddoes%FTB(NumFoil,NumCL,MAXTABLE) , STAT=Sttus ) - IF ( Sttus /= 0 ) CALL ProgAbort ( ' Error allocating memory for FTB array.' ) - - IF (.NOT. ALLOCATED(m%Beddoes%FTBC)) ALLOCATE ( m%Beddoes%FTBC(NumFoil,NumCL,MAXTABLE) , STAT=Sttus ) - IF ( Sttus /= 0 ) CALL ProgAbort ( ' Error allocating memory for FTBC array.' ) - - ENDIF ! Beddoes arrays - -!jm we did not recognize the argument consider that an error -ELSE - - CALL ProgAbort( 'Unknown switch argument to AllocArrays' ) - -ENDIF - - - -RETURN -END SUBROUTINE AllocArrays - - ! ***************************************************** - SUBROUTINE ElemOpen (ElemFile, P, m, ErrStat, ErrMsg, AD14_Ver ) - ! This subroutine opens the element output file and writes - ! column headings separated by tab characters - ! ElemFile = file name - ! ***************************************************** - - ! Passed Variables: - CHARACTER(*), INTENT(IN) :: ElemFile - TYPE(AD14_ParameterType), INTENT(INOUT) :: p ! Parameters - TYPE(AD14_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 - TYPE(ProgDesc) , INTENT(IN) :: AD14_Ver - - ! Local Variables: - -INTEGER(4) :: JE - -INTEGER(4) :: JB ! Counter for number of blades - -CHARACTER( 2) :: Dst_Unit -CHARACTER( 2) :: Frc_Unit -CHARACTER(140) :: Frmt -CHARACTER( 3) :: Prs_Unit - - -ErrStat = ErrID_None -ErrMsg = "" - - - -IF (m%ElOut%NumWndElOut > 0) THEN - CALL GetNewUnit(P%UnWndOut) - CALL OpenFOutFile (P%UnWndOut, TRIM(ElemFile)//'.wind', ErrStat, ErrMsg) - IF (ErrStat /= ErrID_None) RETURN - WRITE (P%UnWndOut,"( 'This file was generated by ' , A , ' on ' , A , ' at ' , A , '.' )") & - TRIM(GETNVD(AD14_Ver)), CurDate(), CurTime() -ENDIF - - - ! Open the Element Print file if requested -IF (p%ELEMPRN) THEN - CALL GetNewUnit(P%UnElem) - CALL OpenFOutFile (p%UnElem, TRIM(ElemFile), ErrStat, ErrMsg) - IF (ErrStat >= AbortErrLev) RETURN - WRITE (p%UnElem,"(/, 'This file was generated by ' , A , ' on ' , A , ' at ' , A , '.' )") & - TRIM(GETNVD(AD14_Ver)), CurDate(), CurTime() - WRITE (p%UnElem,'(/,/,/)') ! write some blank lines so the output file so the headers are on the same line as FAST's -ELSE - RETURN -ENDIF - - ! Set the units labels -IF (p%SIUNIT) THEN - Dst_Unit = 'm' - Frc_Unit = 'N' - Prs_Unit = 'Pa' -ELSE - Dst_Unit = 'ft' - Frc_Unit = 'lb' - Prs_Unit = 'psf' -ENDIF - - -Frmt = '( A4, 3(A1,A2,I2.2), (: A1, A, I2.2 ) )' - -IF ( p%PMOMENT ) THEN - WRITE(Frmt(22:24), '(I3)') 15*m%ElOut%NumElOut - WRITE(p%UnElem, Frmt) 'Time', & - TAB, 'VX', p%Element%NELM, & - TAB, 'VY', p%Element%NELM, & - TAB, 'VZ', p%Element%NELM, & - ( TAB, 'Alpha', m%ElOut%ElPrNum(JE), & - TAB, 'DynPres', m%ElOut%ElPrNum(JE), & - TAB, 'CLift', m%ElOut%ElPrNum(JE), & - TAB, 'CDrag', m%ElOut%ElPrNum(JE), & - TAB, 'CNorm', m%ElOut%ElPrNum(JE), & - TAB, 'CTang', m%ElOut%ElPrNum(JE), & - TAB, 'CMomt', m%ElOut%ElPrNum(JE), & - TAB, 'Pitch', m%ElOut%ElPrNum(JE), & - TAB, 'AxInd', m%ElOut%ElPrNum(JE), & - TAB, 'TanInd', m%ElOut%ElPrNum(JE), & - TAB, 'ForcN', m%ElOut%ElPrNum(JE), & - TAB, 'ForcT', m%ElOut%ElPrNum(JE), & - TAB, 'Pmomt', m%ElOut%ElPrNum(JE), & - TAB, 'ReNum', m%ElOut%ElPrNum(JE), & - TAB, 'Gamma', m%ElOut%ElPrNum(JE), & - JE = 1, m%ElOut%NumElOut ) - - Frmt = '( A5, 3(A1,A8), (: A1, A ) )' - WRITE(Frmt(17:19), '(I3)') 15*m%ElOut%NumElOut - WRITE(p%UnElem, Frmt) '(sec)', & - TAB, '('//TRIM(Dst_Unit)//'/sec)', & - TAB, '('//TRIM(Dst_Unit)//'/sec)', & - TAB, '('//TRIM(Dst_Unit)//'/sec)', & - ( TAB, '(deg)', & - TAB, '('//TRIM(Prs_Unit)//')', & - TAB, '(-)', & - TAB, '(-)', & - TAB, '(-)', & - TAB, '(-)', & - TAB, '(-)', & - TAB, '(deg)', & - TAB, '(-)', & - TAB, '(-)', & - TAB, '('//TRIM(Frc_Unit)//')', & - TAB, '('//TRIM(Frc_Unit)//')', & - TAB, '('//TRIM(Frc_Unit)//'-'//TRIM(Dst_Unit)//')', & - TAB, '(x10^6)', & - TAB, '(m^2/sec)', & - JE = 1, m%ElOut%NumElOut ) - -ELSE - WRITE(Frmt(22:24), '(I3)') 13*m%ElOut%NumElOut - WRITE(p%UnElem, Frmt) 'Time', & - TAB, 'VX', p%Element%NELM, & - TAB, 'VY', p%Element%NELM, & - TAB, 'VZ', p%Element%NELM, & - ( TAB, 'Alpha', m%ElOut%ElPrNum(JE), & - TAB, 'DynPres', m%ElOut%ElPrNum(JE), & - TAB, 'CLift', m%ElOut%ElPrNum(JE), & - TAB, 'CDrag', m%ElOut%ElPrNum(JE), & - TAB, 'CNorm', m%ElOut%ElPrNum(JE), & - TAB, 'CTang', m%ElOut%ElPrNum(JE), & - TAB, 'Pitch', m%ElOut%ElPrNum(JE), & - TAB, 'AxInd', m%ElOut%ElPrNum(JE), & - TAB, 'TanInd', m%ElOut%ElPrNum(JE), & - TAB, 'ForcN', m%ElOut%ElPrNum(JE), & - TAB, 'ForcT', m%ElOut%ElPrNum(JE), & - TAB, 'ReNum', m%ElOut%ElPrNum(JE), & - TAB, 'Gamma', m%ElOut%ElPrNum(JE), & - JE = 1, m%ElOut%NumElOut ) - - Frmt = '( A5, 3(A1,A8), (: A1, A ) )' - WRITE(Frmt(17:19), '(I3)') 13*m%ElOut%NumElOut - WRITE(p%UnElem, Frmt) '(sec)', & - TAB, '('//TRIM(Dst_Unit)//'/sec)', & - TAB, '('//TRIM(Dst_Unit)//'/sec)', & - TAB, '('//TRIM(Dst_Unit)//'/sec)', & - ( TAB, '(deg)', & - TAB, '('//TRIM(Prs_Unit)//')', & - TAB, '(-)', & - TAB, '(-)', & - TAB, '(-)', & - TAB, '(-)', & - TAB, '(deg)', & - TAB, '(-)', & - TAB, '(-)', & - TAB, '('//TRIM(Frc_Unit)//')', & - TAB, '('//TRIM(Frc_Unit)//')', & - TAB, '(x10^6)', & - TAB, '(m^2/sec)', & - JE = 1, m%ElOut%NumElOut ) -ENDIF - -IF ( m%ElOut%NumWndElOut > 0 ) THEN - Frmt = '( A4, XXX(A1,A2,I2.2,"-B",I1.1) )' - WRITE(Frmt(7:9), '(I3)') 3*m%ElOut%NumWndElOut*p%NumBl - - WRITE(p%UnWndOut, Frmt) 'Time', & - ( ( TAB, 'VX', m%ElOut%WndElPrNum(JE), JB, & - TAB, 'VY', m%ElOut%WndElPrNum(JE), JB, & - TAB, 'VZ', m%ElOut%WndElPrNum(JE), JB, & - JE = 1, m%ElOut%NumWndElOut ) , & - JB = 1, p%NumBl ) - - Frmt = '( A5, XXX(A1,A8) )' - WRITE(Frmt(7:9), '(I3)') 3*m%ElOut%NumWndElOut*p%NumBl - - WRITE(p%UnWndOut, Frmt) '(sec)', & - ( TAB, '('//TRIM(Dst_Unit)//'/sec)', & - TAB, '('//TRIM(Dst_Unit)//'/sec)', & - TAB, '('//TRIM(Dst_Unit)//'/sec)', & - JE = 1, m%ElOut%NumWndElOut*p%NumBl ) -ENDIF - -RETURN -END SUBROUTINE ElemOpen - - - ! ***************************************************** - SUBROUTINE ElemOut( time, P, m ) - ! This subroutine writes the element output values - ! for the desired elements - ! ***************************************************** - - - REAL(DbKi), INTENT(IN) :: time - TYPE(AD14_ParameterType), INTENT(IN) :: p ! Parameters - TYPE(AD14_MiscVarType), INTENT(IN) :: m ! misc/optimization variables - - - ! Local Variables: - - INTEGER(IntKi) :: JE - INTEGER(IntKi) :: JB ! Counter for number of blades - CHARACTER(30) :: Frmt - - - ! Write the element data if requested -IF (p%ELEMPRN) THEN - - Frmt = '( F10.3, ( : A1, ES12.5 ) )' - - IF ( P%PMOMENT ) THEN - WRITE(Frmt(10:12), '(I3)') 15*m%ElOut%NumElOut + 3 - WRITE(p%UnElem,Frmt) TIME, & - TAB, m%ElOut%VXSAV, & - TAB, m%ElOut%VYSAV, & - TAB, m%ElOut%VZSAV, & - ( TAB, m%ElOut%ALF (JE), & - TAB, m%ElOut%DynPres(JE), & - TAB, m%ElOut%CLL (JE), & - TAB, m%ElOut%CDD (JE), & - TAB, m%ElOut%CNN (JE), & - TAB, m%ElOut%CTT (JE), & - TAB, m%ElOut%CMM (JE), & - TAB, m%ElOut%PITSAV (JE), & - TAB, m%ElOut%AAA (JE), & - TAB, m%ElOut%AAP (JE), & - TAB, m%ElOut%DFNSAV (JE), & - TAB, m%ElOut%DFTSAV (JE), & - TAB, m%ElOut%PMM (JE), & - TAB, m%ElOut%ReyNum (JE), & - TAB, m%ElOut%Gamma (JE), & - JE= 1, m%ElOut%NumElOut ) - - - ELSE - WRITE(Frmt(10:12), '(I3)') 13*m%ElOut%NumElOut + 3 - WRITE(p%UnElem,Frmt) TIME, & - TAB, m%ElOut%VXSAV, & - TAB, m%ElOut%VYSAV, & - TAB, m%ElOut%VZSAV, & - ( TAB, m%ElOut%ALF (JE), & - TAB, m%ElOut%DynPres(JE), & - TAB, m%ElOut%CLL (JE), & - TAB, m%ElOut%CDD (JE), & - TAB, m%ElOut%CNN (JE), & - TAB, m%ElOut%CTT (JE), & - TAB, m%ElOut%PITSAV (JE), & - TAB, m%ElOut%AAA (JE), & - TAB, m%ElOut%AAP (JE), & - TAB, m%ElOut%DFNSAV (JE), & - TAB, m%ElOut%DFTSAV (JE), & - TAB, m%ElOut%ReyNum (JE), & - TAB, m%ElOut%Gamma (JE), & - JE= 1, m%ElOut%NumElOut ) - ENDIF ! PMOMENT - -IF (m%ElOut%NumWndElOut > 0) THEN - - WRITE(Frmt(10:12), '(I3)') 3*m%ElOut%NumWndElOut*p%NumBl - WRITE(p%UnWndOut,Frmt) TIME, & - ( ( TAB, m%ElOut%SaveVX( JE, JB ), & - TAB, m%ElOut%SaveVY( JE, JB ), & - TAB, m%ElOut%SaveVZ( JE, JB ), & - JE = 1,m%ElOut%NumWndElOut ), JB = 1,p%NumBl ) -ENDIF - -ENDIF ! ELEMPRN - - - -RETURN -END SUBROUTINE ElemOut -!======================================================================= - -END MODULE AeroGenSubs diff --git a/modules/aerodyn14/src/Registry-AD14.txt b/modules/aerodyn14/src/Registry-AD14.txt deleted file mode 100644 index 59eceb2c7b..0000000000 --- a/modules/aerodyn14/src/Registry-AD14.txt +++ /dev/null @@ -1,412 +0,0 @@ -################################################################################################################################### -# Registry for AeroDyn14 in the FAST Modularization Framework -# This Registry file is used to create MODULE AeroDyn_Types which contains all of the user-defined types needed in AeroDyn14. -# 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 Registry_NWTC_Library.txt -usefrom Registry-DWM.txt - -# AeroDyn Subtypes -typedef AeroDyn14/AD14 Marker Reki Position 3 0.0 - - -typedef ^ Marker ^ Orientation {3}{3} 0.0 - - -typedef ^ Marker ^ TranslationVel 3 0.0 - - -typedef ^ Marker ^ RotationVel 3 0.0 - - - -#ADOptions -#typedef AeroDyn14/AD14 ADOptions CHARACTER(1024) ADFile -#typedef ^ ADOptions CHARACTER(1024) RootName -#typedef ^ ADOptions CHARACTER(1024) SumFile -#typedef ^ ADOptions LOGICAL WrSumFile - -#AeroConfig -typedef AeroDyn14/AD14 AeroConfig Marker Blade {:} - - - -typedef ^ AeroConfig ^ Hub - - - - -typedef ^ AeroConfig ^ RotorFurl - - - - -typedef ^ AeroConfig ^ Nacelle - - - - -typedef ^ AeroConfig ^ TailFin - - - - -typedef ^ AeroConfig ^ Tower - - - - -typedef ^ AeroConfig ^ SubStructure - - - - -typedef ^ AeroConfig ^ Foundation - - - - -typedef ^ AeroConfig ReKi BladeLength - - - - - - -#Airfoil -typedef AeroDyn14/AD14 AirFoil ReKi AL {:}{:} - - - -typedef ^ AirFoil ReKi CD {:}{:}{:} - - - -typedef ^ AirFoil ReKi CL {:}{:}{:} - - - -typedef ^ AirFoil ReKi CM {:}{:}{:} - - - -typedef ^ AirFoil ReKi PMC - - - - -typedef ^ AirFoil ReKi MulTabLoc - -typedef ^ AirFoilParms IntKi MaxTable - 20 - -typedef ^ AirFoilParms IntKi NTables {:} - - - -typedef ^ AirFoilParms IntKi NLift {:} - - - -typedef ^ AirFoilParms IntKi NumCL - - - - -typedef ^ AirFoilParms IntKi NumFoil - - - -typedef ^ AirFoilParms IntKi NFoil {:} - - - -typedef ^ AirFoilParms ReKi MulTabMet {:}{:} - - - -typedef ^ AirFoilParms CHARACTER(1024) FoilNm {:} "Number of airfoil data sets" - -#Beddoes -typedef ^ Beddoes ReKi ADOT {:}{:} - - - -typedef ^ Beddoes ReKi ADOT1 {:}{:} - - - -typedef ^ Beddoes ReKi AFE {:}{:} - - - -typedef ^ Beddoes ReKi AFE1 {:}{:} - - - -typedef ^ Beddoes ReKi AN - - - - -typedef ^ Beddoes ReKi ANE {:}{:} - - - -typedef ^ Beddoes ReKi ANE1 {:}{:} - - - -typedef ^ Beddoes ReKi AOD {:}{:} - - - -typedef ^ Beddoes ReKi AOL {:}{:} - - - -typedef ^ Beddoes LOGICAL BEDSEP {:}{:} - - - -typedef ^ Beddoes LOGICAL OLDSEP {:}{:} - - - -typedef ^ Beddoes ReKi CC - - - - -typedef ^ Beddoes ReKi CDO {:}{:} - - - -typedef ^ Beddoes ReKi CMI - - - - -typedef ^ Beddoes ReKi CMQ - - - - -typedef ^ Beddoes ReKi CN - - - - -typedef ^ Beddoes ReKi CNA {:}{:} - - - -typedef ^ Beddoes ReKi CNCP - - - - -typedef ^ Beddoes ReKi CNIQ - - - - -typedef ^ Beddoes ReKi CNP {:}{:} - - - -typedef ^ Beddoes ReKi CNP1 {:}{:} - - - -typedef ^ Beddoes ReKi CNPD {:}{:} - - - -typedef ^ Beddoes ReKi CNPD1 {:}{:} - - - -typedef ^ Beddoes ReKi CNPOT {:}{:} - - - -typedef ^ Beddoes ReKi CNPOT1 {:}{:} - - - -typedef ^ Beddoes ReKi CNS {:}{:} - - - -typedef ^ Beddoes ReKi CNSL {:}{:} - - - -typedef ^ Beddoes ReKi CNV {:}{:} - - - -typedef ^ Beddoes ReKi CVN {:}{:} - - - -typedef ^ Beddoes ReKi CVN1 {:}{:} - - - -typedef ^ Beddoes ReKi DF {:}{:} - - - -typedef ^ Beddoes ReKi DFAFE {:}{:} - - - -typedef ^ Beddoes ReKi DFAFE1 {:}{:} - - - -typedef ^ Beddoes ReKi DFC {:}{:} - - - -typedef ^ Beddoes ReKi DN {:}{:} - - - -typedef ^ Beddoes ReKi DPP {:}{:} - - - -typedef ^ Beddoes ReKi DQ {:}{:} - - - -typedef ^ Beddoes ReKi DQP {:}{:} - - - -typedef ^ Beddoes ReKi DQP1 {:}{:} - - - -typedef ^ Beddoes ReKi DS - - - - -typedef ^ Beddoes ReKi FK - - - - -typedef ^ Beddoes ReKi FP - - - - -typedef ^ Beddoes ReKi FPC - - - - -typedef ^ Beddoes ReKi FSP {:}{:} - - - -typedef ^ Beddoes ReKi FSP1 {:}{:} - - - -typedef ^ Beddoes ReKi FSPC {:}{:} - - - -typedef ^ Beddoes ReKi FSPC1 {:}{:} - - - -typedef ^ Beddoes ReKi FTB {:}{:}{:} - - - -typedef ^ Beddoes ReKi FTBC {:}{:}{:} - - - -typedef ^ Beddoes ReKi OLDCNV {:}{:} - - - -typedef ^ Beddoes ReKi OLDDF {:}{:} - - - -typedef ^ Beddoes ReKi OLDDFC {:}{:} - - - -typedef ^ Beddoes ReKi OLDDN {:}{:} - - - -typedef ^ Beddoes ReKi OLDDPP {:}{:} - - - -typedef ^ Beddoes ReKi OLDDQ {:}{:} - - - -typedef ^ Beddoes ReKi OLDTAU {:}{:} - - - -typedef ^ Beddoes ReKi OLDXN {:}{:} - - - -typedef ^ Beddoes ReKi OLDYN {:}{:} - - - -typedef ^ Beddoes ReKi QX {:}{:} - - - -typedef ^ Beddoes ReKi QX1 {:}{:} - - - -typedef ^ Beddoes ReKi TAU {:}{:} - - - -typedef ^ Beddoes ReKi XN {:}{:} - - - -typedef ^ Beddoes ReKi YN {:}{:} - - - -typedef ^ BeddoesParms ReKi AS - - - "Speed of sound for mach num calc" - -typedef ^ BeddoesParms ReKi TF - - - "Time constant applied to loc of separation pt" - -typedef ^ BeddoesParms ReKi TP - - - "Time constant for pressure lag" - -typedef ^ BeddoesParms ReKi TV - - - "Time constant for strength and shed of vortex" - -typedef ^ BeddoesParms ReKi TVL - - - "Nondim time of transit of vort moving across airfoil surf" - -typedef ^ Beddoes LOGICAL SHIFT - - - - -typedef ^ Beddoes LOGICAL VOR - - - - - -#Blade -typedef ^ BladeParms ReKi C {:} - - "Chord of each blade element from input file" -typedef ^ BladeParms ReKi DR {:} - - "Span-wise width of elem (len of elem ctred at RELM(i)" -typedef ^ BladeParms ReKi R - - - "Rotor radius" -typedef ^ BladeParms ReKi BladeLength - - - "Blade Length" -#typedef ^ BladeParms INTEGER NB - - - "Number odem blades" - -#DynInflow -dimspec maxinfl constant=6 -dimspec maxinfl0 constant=2 -dimspec maxinfl1 constant=3:6 -typedef AeroDyn14/AD14 DynInflow ReKi dAlph_dt {maxinfl}{4} - - -typedef ^ DynInflow ReKi dBeta_dt {maxinfl1}{4} - - -typedef ^ DynInflow ReKi DTO - - - -typedef ^ DynInflow ReKi old_Alph {maxinfl} - - -typedef ^ DynInflow ReKi old_Beta {maxinfl1} - - -typedef ^ DynInflow ReKi old_LmdM - - - -typedef ^ DynInflow ReKi oldKai - - - -typedef ^ DynInflow ReKi PhiLqC {maxinfl} - - -typedef ^ DynInflow ReKi PhiLqS {maxinfl1} - - -typedef ^ DynInflow ReKi Pzero - - - -typedef ^ DynInflow ReKi RMC_SAVE {:}{:}{:} - - - -typedef ^ DynInflow ReKi RMS_SAVE {:}{:}{:} - - - -typedef ^ DynInflow ReKi TipSpeed - - - -typedef ^ DynInflow ReKi totalInf - - - -typedef ^ DynInflow ReKi Vparam - - - -typedef ^ DynInflow ReKi Vtotal - - - -typedef ^ DynInflow ReKi xAlpha {maxinfl} - - -typedef ^ DynInflow ReKi xBeta {maxinfl1} - - -typedef ^ DynInflow ReKi xKai - - - -typedef ^ DynInflow ReKi XLAMBDA_M - - - -typedef ^ DynInflow ReKi xLcos {maxinfl}{maxinfl} - - -typedef ^ DynInflow ReKi xLsin {maxinfl1}{maxinfl1} - - -typedef ^ DynInflow IntKi MminR {maxinfl}{maxinfl} - - -typedef ^ DynInflow IntKi MminusR {maxinfl}{maxinfl} - - -typedef ^ DynInflow IntKi MplusR {maxinfl}{maxinfl} - - -typedef ^ DynInflow ReKi GAMMA {maxinfl}{maxinfl} - - -#typedef ^ DynInflowParms IntKi MAXINFL - 6 - #should be possible to spec with maxinfl -typedef ^ DynInflowParms IntKi MAXINFLO - 2 - #should be possible to spec with maxinfl0 -#typedef ^ DynInflowParms IntKi MRvector {maxinfl} - - -#typedef ^ DynInflowParms IntKi NJvector {maxinfl} - - -typedef ^ DynInflowParms ReKi xMinv {maxinfl} - - - -#Element -typedef ^ Element ReKi A {:}{:} - - - "Axial induction factor" - -typedef ^ Element ReKi AP {:}{:} - - - "Tangential induction factor" - -typedef ^ Element ReKi ALPHA {:}{:} - - - "Angle of attack" rad -typedef ^ Element ReKi W2 {:}{:} - - - "Relative velocity norm " m/s -typedef ^ Element ReKi OLD_A_NS {:}{:} - - - #allocated in VIND -typedef ^ Element ReKi OLD_AP_NS {:}{:} - - - #allocated in VIND -typedef ^ Element ReKi PITNOW :: - - - "Current pitch angle - Based on blade orientation (to verify)" rad -typedef ^ ElementParms IntKi NELM - - - - "Number of elements (constant)" - -typedef ^ ElementParms ReKi TWIST {:} - - - "Airfoil twist angle (constant)" - rad -typedef ^ ElementParms ReKi RELM {:} - - - "Radius of element (constant)" m -typedef ^ ElementParms ReKi HLCNST {:} - - - "Hub loss constant B/2*(r-rh)/rh (constant)" - -typedef ^ ElementParms ReKi TLCNST {:} - - - "Tip loss constant B/2*(R-r)/R (constant) " - - -#ElOutParams -typedef ^ ElOutParms ReKi AAA {:} - - - -typedef ^ ElOutParms ReKi AAP {:} - - - -typedef ^ ElOutParms ReKi ALF {:} - - - -typedef ^ ElOutParms ReKi CDD {:} - - - -typedef ^ ElOutParms ReKi CLL {:} - - - -typedef ^ ElOutParms ReKi CMM {:} - - - -typedef ^ ElOutParms ReKi CNN {:} - - - -typedef ^ ElOutParms ReKi CTT {:} - - - -typedef ^ ElOutParms ReKi DFNSAV {:} - - - -typedef ^ ElOutParms ReKi DFTSAV {:} - - - -typedef ^ ElOutParms ReKi DynPres {:} - - - -typedef ^ ElOutParms ReKi PMM {:} - - - -typedef ^ ElOutParms ReKi PITSAV {:} - - - -typedef ^ ElOutParms ReKi ReyNum {:} - - - -typedef ^ ElOutParms ReKi Gamma {:} - - - "Circulation along the span, 1/2 c Vrel Cl" m^2/s -typedef ^ ElOutParms ReKi SaveVX {:}{:} - - - -typedef ^ ElOutParms ReKi SaveVY {:}{:} - - - -typedef ^ ElOutParms ReKi SaveVZ {:}{:} - - - -typedef ^ ElOutParms ReKi VXSAV - - - - -typedef ^ ElOutParms ReKi VYSAV - - - - -typedef ^ ElOutParms ReKi VZSAV - - - - -typedef ^ ElOutParms IntKi NumWndElOut - - - "Number of Blade Elements" -typedef ^ ElOutParms IntKi WndElPrList {:} - - - -typedef ^ ElOutParms IntKi WndElPrNum {:} - - - -typedef ^ ElOutParms IntKi ElPrList {:} - - - -typedef ^ ElOutParms IntKi ElPrNum {:} - - - -typedef ^ ElOutParms IntKi NumElOut - - - "Number of Blade Elements" - -#InducedVel -typedef ^ InducedVel ReKi SumInFl - 0 - -typedef ^ InducedVelParms ReKi AToler - - - "Convergence tolerance for induction factor" - -typedef ^ InducedVelParms ReKi EqAIDmult - - - "Multiplier for drag term in axial-induction equation." -typedef ^ InducedVelParms LOGICAL EquilDA - - - "False unless DB or DA appended to EQUIL" -typedef ^ InducedVelParms LOGICAL EquilDT - - - "False unless DB or DT appended to EQUIL" -typedef ^ InducedVelParms LOGICAL TLoss - - - "Tip-loss model (EQUIL only) [PRANDtl, GTECH, or NONE]" -typedef ^ InducedVelParms LOGICAL GTech - - - "Tip-loss model (EQUIL only) [PRANDtl, GTECH, or NONE]" -typedef ^ InducedVelParms LOGICAL HLoss - - - "Hub-loss model (EQUIL only) [PRANDtl or NONE]" - - -#Rotor -typedef ^ Rotor ReKi AVGINFL - - - "average induced velocity at the previous time" -typedef ^ Rotor ReKi CTILT - - - -typedef ^ Rotor ReKi CYaw - - - -typedef ^ Rotor ReKi REVS - - - -typedef ^ Rotor ReKi STILT - - - -typedef ^ Rotor ReKi SYaw - - - -typedef ^ Rotor ReKi TILT - - - -typedef ^ Rotor ReKi YawAng - - - -typedef ^ Rotor ReKi YawVEL - - - -typedef ^ RotorParms ReKi HH - - - - -#TwrProps -typedef ^ TwrPropsParms ReKi TwrHtFr {:} - - -typedef ^ TwrPropsParms ReKi TwrWid {:} - - -typedef ^ TwrPropsParms ReKi TwrCD {:}{:} - - -typedef ^ TwrPropsParms ReKi TwrRe {:} - - -typedef ^ TwrPropsParms ReKi VTwr 3 - - -typedef ^ TwrPropsParms ReKi Tower_Wake_Constant - - - -typedef ^ TwrPropsParms IntKi NTwrCDCol {:} - - "The tower CD column that represents a particular twr ht" -typedef ^ TwrPropsParms IntKi NTwrHT - - - "The number of tower height rows in the table" -typedef ^ TwrPropsParms IntKi NTwrRe - - - "The number of tower Re entry rows in the table" -typedef ^ TwrPropsParms IntKi NTwrCD - - - "The number of tower CD columns in the table" -typedef ^ TwrPropsParms LOGICAL TwrPotent - - - "Tower influence model" -typedef ^ TwrPropsParms LOGICAL TwrShadow - - - "Tower shadow model" -typedef ^ TwrPropsParms ReKi ShadHWid - - - "Tower-shadow half width" m -typedef ^ TwrPropsParms ReKi TShadC1 - - - "Tower-shadow constant" -typedef ^ TwrPropsParms ReKi TShadC2 - - - "Tower-shadow constant" -typedef ^ TwrPropsParms ReKi TwrShad - - - "Tower-shadow velocity deficit" -typedef ^ TwrPropsParms LOGICAL PJM_Version - - - "Only true if new tower influence model, by PJM" -typedef ^ TwrPropsParms CHARACTER(1024) TwrFile - - - "Tower data file name" -typedef ^ TwrPropsParms ReKi T_Shad_Refpt - - - "Tower-shadow reference point" m -typedef ^ TwrPropsParms LOGICAL CalcTwrAero - - - "Flag to tell AeroDyn to calculate drag on the tower" m -typedef ^ TwrPropsParms INTEGER NumTwrNodes - - - "Number of ElastoDyn tower nodes. Tower drag will be computed at those points." -typedef ^ TwrPropsParms ReKi TwrNodeWidth {:} - - "The width (diameter) of the tower at the ElastoDyn node locations." - - -#Wind -typedef ^ Wind ReKi ANGFLW - - - -typedef ^ Wind ReKi CDEL - - - -typedef ^ Wind ReKi VROTORX - - - -typedef ^ Wind ReKi VROTORY - - - -typedef ^ Wind ReKi VROTORZ - - - -typedef ^ Wind ReKi SDEL - - - -typedef ^ WindParms ReKi Rho - - - "Air density" kg/m^3 -typedef ^ WindParms ReKi KinVisc - - - "Kinematic air viscosity" (m^2/sec) - -################## Registry for AeroDyn ############### - -typedef AeroDyn14/AD14 PositionType ReKi Pos 3 - - "X,Y,Z coordinate of a point" -typedef AeroDyn14/AD14 OrientationType ReKi Orient {3}{3} - - "Direction Cosine Matrix" - -# ..... Initialization data ....................................................................................................... -# Define inputs that the initialization routine may need here: -#typedef AeroDyn14/AD14 InitInputType ADOptions ADOptions - - - -typedef AeroDyn14/AD14 InitInputType CHARACTER(1024) Title - - - "Title" -typedef ^ InitInputType CHARACTER(1024) OutRootName - - - -typedef ^ InitInputType CHARACTER(1024) ADFileName - - - "AeroDyn file name" -typedef ^ InitInputType LOGICAL WrSumFile - - - "T/F: Write an AeroDyn summary" -typedef ^ InitInputType INTEGER NumBl - - - "Number of Blades" -#typedef ^ InitInputType INTEGER NBlInpSt - - - "Number of Blade Input Stations" -typedef ^ InitInputType ReKi BladeLength - - - "Blade Length" -#typedef ^ InitInputType PositionType InitBladePos {:}{:} - - "Positions of the blades elements, initially, from FAST" -#typedef ^ InitInputType PositionType HubPos - - - "Positions of the blades, initially, from FAST" -#typedef ^ InitInputType OrientationType InitBladeOrient {:}{:} - - "Positions of the blades, initially, from FAST" -typedef ^ InitInputType LOGICAL LinearizeFlag -typedef ^ InitInputType LOGICAL UseDWM - .FALSE. - "flag to determine if DWM module should be used" - -typedef ^ InitInputType AeroConfig TurbineComponents - - - - -typedef ^ InitInputType INTEGER NumTwrNodes - - - "Number of ElastoDyn tower nodes. Tower drag will be computed at those points." -typedef ^ InitInputType ReKi TwrNodeLocs {:}{:} - - "Location of ElastoDyn tower nodes with respect to the inertial origin." - -typedef ^ InitInputType ReKi HubHt - - - "hub height wrt inertial origin" m -typedef ^ InitInputType DWM_InitInputType DWM - - - - - -# Define outputs from the initialization routine here: -typedef AeroDyn14/AD14 InitOutputType ProgDesc Ver - - - "version information" -typedef ^ InitOutputType DWM_InitOutputType DWM - - - - -typedef ^ InitOutputType ReKi AirDens - - - "Air density" kg/m^3 - -# ..... States .................................................................................................................... -# Define continuous (differentiable) states here: -typedef ^ ContinuousStateType DWM_ContinuousStateType DWM - - - - - -# Define discrete (nondifferentiable) states here: -typedef ^ DiscreteStateType DWM_DiscreteStateType DWM - - - - - -# Define constraint states here: -typedef ^ ConstraintStateType DWM_ConstraintStateType DWM - - - - - - -# Define any other states, including integer or logical states here: -typedef ^ OtherStateType DWM_OtherStateType DWM - - - "variables for DWM module" - - -# ..... 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 DWM_MiscVarType DWM - - - "variables for DWM module" -typedef ^ MiscVarType DWM_InputType DWM_Inputs - - - - -typedef ^ MiscVarType DWM_OutputType DWM_Outputs - - - - - -# -# JM: At this point, I don't know which of these are actually discrete, continuous, or constraint, so they're all misc variables for now -# -typedef ^ MiscVarType DbKi DT - - - "actual Time step" seconds -typedef ^ MiscVarType IntKi ElPrNum {:} - - - -typedef ^ MiscVarType DbKi OldTime - - - -typedef ^ MiscVarType ReKi HubLoss - 1 - # was saved in AXIND -typedef ^ MiscVarType ReKi Loss - 1 - # was saved in AXIND -typedef ^ MiscVarType ReKi TipLoss - 1 - # was saved in AXIND -typedef ^ MiscVarType ReKi TLpt7 - - - # was saved in GetTipLoss -typedef ^ MiscVarType LOGICAL FirstPassGTL - .TRUE. - # was saved latch in GetTipLoss -typedef ^ MiscVarType LOGICAL SuperSonic - .FALSE. - # was saved latch in Attach() -typedef ^ MiscVarType LOGICAL AFLAGVinderr - .FALSE. - # was saved latch in GetTwrInfluence -typedef ^ MiscVarType LOGICAL AFLAGTwrInflu - .FALSE. - # was saved latch in GetTwrInfluence -typedef ^ MiscVarType LOGICAL OnePassDynDbg - .TRUE. - # -typedef ^ MiscVarType LOGICAL NoLoadsCalculated - .TRUE. - - -typedef ^ MiscVarType IntKi NERRORS - 0 - # was saved variable in vinderr -typedef ^ MiscVarType AirFoil AirFoil -typedef ^ MiscVarType Beddoes Beddoes -typedef ^ MiscVarType DynInflow DynInflow -typedef ^ MiscVarType Element Element -typedef ^ MiscVarType Rotor Rotor -typedef ^ MiscVarType Wind Wind -typedef ^ MiscVarType InducedVel InducedVel -typedef ^ MiscVarType ElOutParms ElOut -typedef ^ MiscVarType LOGICAL Skew - - - -typedef ^ MiscVarType LOGICAL DynInit - - - "FALSE=EQUIL, TRUE=DYNIN" -typedef ^ MiscVarType LOGICAL FirstWarn - - - "If it's the first warning about AeroDyn not recalculating loads" -#### Stores previously calculated loads: -typedef ^ MiscVarType Reki StoredForces {:}{:}{:} #indices: force, ielm, iblade -typedef ^ MiscVarType Reki StoredMoments {:}{:}{:} #indices: force, ielm, iblade - -# ..... 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 ADOptions ADOptions -typedef ^ ParameterType CHARACTER(1024) Title - - - "Title" -typedef ^ ParameterType LOGICAL SIUnit - -typedef ^ ParameterType LOGICAL Echo - .FALSE. - -typedef ^ ParameterType LOGICAL MultiTab - -typedef ^ ParameterType LOGICAL LinearizeFlag -typedef ^ ParameterType LOGICAL OutputPlottingInfo - .FALSE. -typedef ^ ParameterType LOGICAL UseDWM - .FALSE. - "flag to determine if DWM module should be used" - -typedef ^ ParameterType ReKi TwoPiNB - - - "2*pi/num of blades" - -typedef ^ ParameterType INTEGER NumBl - - - "Number of Blades" -typedef ^ ParameterType INTEGER NBlInpSt - - - "Number of Blade Input Stations" -typedef ^ ParameterType LOGICAL ElemPrn - - - -typedef ^ ParameterType LOGICAL DStall - - - "FALSE=Steady, TRUE=BEDDOES" -typedef ^ ParameterType LOGICAL PMoment - - - "FALSE=NO_CM, TRUE=USE_CM" -typedef ^ ParameterType LOGICAL Reynolds - -typedef ^ ParameterType LOGICAL DynInfl - - - "FALSE=EQUIL, TRUE=DYNIN" -typedef ^ ParameterType LOGICAL Wake - - - "False unless WAKE or SWIRL" -typedef ^ ParameterType LOGICAL Swirl - - - "False unless WAKE or SWIRL" -typedef ^ ParameterType DbKi DtAero - - - "Time interval for aerodynamic calculations" -typedef ^ ParameterType ReKi HubRad - - - "Hub radius" m -#typedef ^ ParameterType ReKi RotorRad - - - "Rotor radius" m -typedef ^ ParameterType INTEGER UnEc - -1 #patch this in for now; lost in NWTC_Library -typedef ^ ParameterType INTEGER UnElem - -1 -typedef ^ ParameterType INTEGER UnWndOut - -1 # note, these are not minus signs -typedef ^ ParameterType INTEGER MAXICOUNT - 1000 - # used in VIND -typedef ^ ParameterType LOGICAL WrOptFile - .TRUE. - "T/F: Write an AeroDyn summary" -typedef ^ ParameterType IntKi DEFAULT_Wind - -1 - -typedef ^ ParameterType AirFoilParms AirFoil -typedef ^ ParameterType BladeParms Blade -typedef ^ ParameterType BeddoesParms Beddoes -typedef ^ ParameterType DynInflowParms DynInflow -typedef ^ ParameterType ElementParms Element -typedef ^ ParameterType TwrPropsParms TwrProps -typedef ^ ParameterType InducedVelParms InducedVel -typedef ^ ParameterType WindParms Wind -typedef ^ ParameterType RotorParms Rotor -typedef ^ ParameterType DWM_ParameterType DWM - - - - - -# ..... Inputs .................................................................................................................... -# Define inputs that are contained on the mesh here: -#typedef ^ InputType MeshType MeshedInput - - - "Meshed input data" - -# Define inputs that are not on this mesh here: -typedef ^ InputType MeshType InputMarkers {:} - - "Input Forces and positions for the blades (mesh) for each blade" - -typedef ^ InputType MeshType Twr_InputMarkers - - - "Input Forces and positions for the tower (mesh)" - -typedef ^ InputType AeroConfig TurbineComponents - - - "Current locations of components" -typedef ^ InputType ReKi MulTabLoc {:}{:} -typedef ^ InputType ReKi InflowVelocity {:}{:} - - "U,V,W wind inflow speeds at all locations on the Inputmarker and Twr_InputMarker meshes" "m/s" -typedef ^ InputType ReKi AvgInfVel {3} - - "an average disk velocity (depends on wind type and should be removed)" "m/s" - -# ..... 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 MeshType OutputLoads {:} - - "Output Loads (mesh) for each blade" - -typedef ^ OutputType MeshType Twr_OutputLoads - - - "Tower Output Loads (mesh)" - diff --git a/modules/aerodyn14/src/Registry-AD14AeroConf.txt b/modules/aerodyn14/src/Registry-AD14AeroConf.txt deleted file mode 100644 index 920e646bcc..0000000000 --- a/modules/aerodyn14/src/Registry-AD14AeroConf.txt +++ /dev/null @@ -1,56 +0,0 @@ -################################################################################################################################### -# Registry for AD14AeroConf in the FAST Modularization Framework -# This Registry file is used to create MODULE AD14AeroConf_Types which contains all of the user-defined types needed in AD14AeroConf. -# This module is used within the FVW_Types and AeroDyn_Types modules. -# 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 Registry_NWTC_Library.txt - - -## This bit is redundant with AD14 registry. Could not figure out how to have both this and the AD14 registry use a third common chunk -# AeroDyn Subtypes -typedef AD14AeroConf/AD14AeroConf Marker Reki Position 3 0.0 - - -typedef ^ Marker ^ Orientation {3}{3} 0.0 - - -typedef ^ Marker ^ TranslationVel 3 0.0 - - -typedef ^ Marker ^ RotationVel 3 0.0 - - - - -# Airfoil -typedef AD14AeroConf/AD14AeroConf MiscVarType ReKi AL :: - - - -typedef ^ MiscVarType ReKi CD ::: - - - -typedef ^ MiscVarType ReKi CL ::: - - - -typedef ^ MiscVarType ReKi CM ::: - - - -typedef ^ MiscVarType ReKi PMC - - - - -typedef ^ MiscVarType ReKi MulTabLoc - - - - - -# Parameters: this used to be called AirFoilParms -typedef ^ ParameterType IntKi MaxTable - 20 - - -typedef ^ ParameterType IntKi NTables : - - - -typedef ^ ParameterType IntKi NLift : - - - -typedef ^ ParameterType IntKi NumCL - - - - -typedef ^ ParameterType IntKi NumFoil - - - - -typedef ^ ParameterType IntKi NFoil : - - - -typedef ^ ParameterType ReKi MulTabMet :: - - - -typedef ^ ParameterType CHARACTER(1024) FoilNm : "Number of airfoil data sets" - - - - -# Aero input-type --> this used to be called AeroConfig -typedef AD14AeroConf/AD14AeroConf InputType Marker Blade : - - - -typedef ^ InputType ^ Hub - - - - -typedef ^ InputType ^ RotorFurl - - - - -typedef ^ InputType ^ Nacelle - - - - -typedef ^ InputType ^ TailFin - - - - -typedef ^ InputType ^ Tower - - - - -typedef ^ InputType ^ SubStructure - - - - -typedef ^ InputType ^ Foundation - - - - -typedef ^ InputType ReKi BladeLength - - - - - -# Dummy outputtype so that the registry is happy -typedef AD14AeroConf/AD14AeroConf OutputType ReKi Dummy - - - - - diff --git a/modules/aerodyn14/src/Registry-DWM.txt b/modules/aerodyn14/src/Registry-DWM.txt deleted file mode 100644 index 9b4221129f..0000000000 --- a/modules/aerodyn14/src/Registry-DWM.txt +++ /dev/null @@ -1,274 +0,0 @@ -################################################################################################################################## -# Registry for DWM -# Entries are of the form -# keyword "" "" -################################################################################################################################## -include Registry_NWTC_Library.txt -usefrom InflowWind.txt - -# CalVelScale_data -typedef DWM/DWM CVSD IntKi counter - 0 - "" - -typedef ^ ^ Reki Denominator - 0.0 - "" - -typedef ^ ^ ^ Numerator - 0.0 - "" - - -# turbine_average_velocity_data -typedef DWM/DWM turbine_average_velocity_data Reki average_velocity_array_temp : - - "the average velocity of the whole blade sections in a specific time step" - -typedef ^ ^ ^ average_velocity_array : - - "" - -typedef ^ ^ ^ swept_area : - - "" m2 -typedef ^ ^ IntKi time_step_velocity - -1 - "" - -typedef ^ ^ ^ time_step_velocity_array : - - "" - -typedef ^ ^ ^ time_step_pass_velocity - -1 - "" - -typedef ^ ^ ^ time_step_force - -1 - "" - - -# DWM_Wake_Deficit_Data -typedef ^ DWM_Wake_Deficit_Data IntKi np_x - - - "point per axial distance" - -typedef ^ ^ Reki X_length - - - "normalized length in axial direction" - -typedef ^ ^ Reki Turb_Stress_DWM :: - - "" - -typedef ^ ^ IntKi n_x_vector - - - "" - -typedef ^ ^ IntKi n_r_vector - - - "" - -typedef ^ ^ Reki ppR - - - "Point_per_R_resoulution" - - -# meandering_data -typedef DWM/DWM MeanderData IntKi scale_factor - - - "" - -#typedef ^ ^ ^ release_time - - - "" - -#typedef ^ ^ ^ flying_time - - - "" - -#typedef ^ ^ ^ simulation_time_length - - - "" - -typedef ^ ^ ^ moving_time - - - "" - -#typedef ^ ^ Reki DWM_time_step - - - "" - -#typedef ^ ^ ^ temp_center_wake 3 - - "" - -#typedef ^ ^ ^ temp_velocity 3 - - "" - -#typedef ^ ^ ^ U_Scale_Factor - - - "" - -#typedef ^ ^ ^ U_factor - - - "" - - - -# RTPD -typedef DWM/DWM read_turbine_position_data IntKi SimulationOrder_index - - - "" - -typedef ^ ^ ^ Turbine_sort_order : - - "" - -typedef ^ ^ ^ WT_index - - - "wind turbine index in the wind farm" - -typedef ^ ^ ^ TurbineInfluenceData :: - - "" - -typedef ^ ^ ^ upwind_turbine_index : - - "the upwind turbines that affecting this turbine" - -typedef ^ ^ ^ downwind_turbine_index : - - "" - -typedef ^ ^ ^ upwindturbine_number - - - "the number of upwind turbines affecting the downwind turbine" - -typedef ^ ^ ^ downwindturbine_number - - - "" - -typedef ^ ^ Reki turbine_windorigin_length : - - "" - -typedef ^ ^ ^ upwind_turbine_projected_distance : - - "the projected distance between two turbines" - -typedef ^ ^ ^ downwind_turbine_projected_distance : - - "" - -typedef ^ ^ ^ turbine_angle :: - - "" - -typedef ^ ^ ^ upwind_align_angle : - - "the angle beween the line connecting the upwind turbine and this turbine and the wind direction vector" - -typedef ^ ^ ^ downwind_align_angle : - - "" - -typedef ^ ^ ^ upwind_turbine_Xcoor : - - "the coordinate of the upwind turbine which affects this investigated turbine" - -typedef ^ ^ ^ upwind_turbine_Ycoor : - - "" - -typedef ^ ^ ^ wind_farm_Xcoor : - - "the coordinates of all the turbines in the wind farm" - -typedef ^ ^ ^ wind_farm_Ycoor : - - "" - -typedef ^ ^ ^ downwind_turbine_Xcoor : - - "the coordinate of the downwind turbine which is affected by this investigated turbine" - -typedef ^ ^ ^ downwind_turbine_Ycoor : - - "" - - - -# weighting_method -typedef DWM/DWM WeiMethod Reki sweptarea : - - "" - -typedef ^ ^ ^ weighting_denominator - - - "" - - -# TI_downstream_data -typedef DWM/DWM TIDownstream Reki TI_downstream_matrix :: - - "" - -typedef ^ ^ IntKi i - - - "" - -typedef ^ ^ ^ j - - - "" - -typedef ^ ^ ^ k - - - "" - -typedef ^ ^ ^ cross_plane_position_ds - - - "the cross plane position which to be investigated in term of the flying time" - -typedef ^ ^ ^ cross_plane_position_TI - - - "the cross plane position which to be investigated in term of the n_x_vector" - -typedef ^ ^ ^ distance_index - - - "the index of the distance in the TI axisymmetric array" - -typedef ^ ^ ^ counter1 - - - "" - -typedef ^ ^ ^ counter2 - - - "" - -typedef ^ ^ ^ initial_timestep - - - "" - -typedef ^ ^ Reki y_axis_turbine - - - "" - -typedef ^ ^ ^ z_axis_turbine - - - "" - -typedef ^ ^ ^ distance - - - "the distance between one point to the meandered wake center" - -typedef ^ ^ ^ TI_downstream_node - - - "the TI at a specfic point in the inbestigated cross plane" - -typedef ^ ^ ^ TI_node_temp - - - "" - -typedef ^ ^ ^ TI_node - - - "" - -typedef ^ ^ ^ TI_accumulation - - - "" - -typedef ^ ^ ^ TI_apprant_accumulation - - - "" - -typedef ^ ^ ^ TI_average - - - "THE AVERAGE TI OF THE CROSS PLANE" - -typedef ^ ^ ^ TI_apprant - - - "The TI due to the meadering" - -typedef ^ ^ ^ HubHt - - - "" - -typedef ^ ^ ^ wake_center_y - - - "" - -typedef ^ ^ ^ wake_center_z - - - "" - -typedef ^ ^ ^ Rscale - - - "" - -typedef ^ ^ ^ y - - - "" - -typedef ^ ^ ^ z - - - "" - -typedef ^ ^ ^ zero_spacing - - - "" - -typedef ^ ^ ^ temp1 - - - "" - -typedef ^ ^ ^ temp2 - - - "" - -typedef ^ ^ ^ temp3 - - - "" - - -# Turbulence_KS -typedef DWM/DWM TurbKaimal IntKi fs - - - "sample frequency" - -typedef ^ ^ ^ temp_n - - - "" - -typedef ^ ^ ^ i - - - "" - -typedef ^ ^ Reki low_f - - - "lower bound of frequency range" - -typedef ^ ^ ^ high_f - - - "upper bound of frequency range" - -typedef ^ ^ ^ lk_facor - - - "turbulence length-scale" - -typedef ^ ^ ^ STD - - - "standard deviation of the turbulence" - - -# shinozuka_data -typedef DWM/DWM Shinozuka Reki f_syn : - - "frequency series" - -typedef ^ ^ ^ t_syn : - - "time series" - -typedef ^ ^ ^ phi : - - "random phase angle" - -typedef ^ ^ ^ p_k : - - "" - -typedef ^ ^ ^ a_k : - - "" - -typedef ^ ^ IntKi num_points - - - "total number of points" - -typedef ^ ^ ^ ILo - - - "" - -typedef ^ ^ ^ i - - - "" - -typedef ^ ^ ^ j - - - "" - -typedef ^ ^ Reki dt - - - "time step" - -typedef ^ ^ ^ t_min - - - "" - -typedef ^ ^ ^ t_max - - - "" - -typedef ^ ^ ^ df - - - "frequency step" - - -# smooth_out_wake_data -typedef ^ smooth_out_wake_data IntKi length_velocity_array - - - "the length of velocity_array" - - -# smooth_wake_shifted_velocity_data -typedef DWM/DWM SWSV IntKi p1 - - - "" - -typedef ^ ^ ^ p2 - - - "" - -typedef ^ ^ Reki distance - - - "the distance from the point to the meandered wake center" - -typedef ^ ^ ^ y0 - - - "wake center position on y axis" - -typedef ^ ^ ^ z0 - - - "wake center position on z axis" - -typedef ^ ^ ^ unit - - - "single unit length R/ppR" - - -# Upwind_result -typedef DWM/DWM read_upwind_result Reki upwind_U :: - - "" - -typedef ^ ^ ^ upwind_wakecenter :::: - - "" - -typedef ^ ^ ^ upwind_meanU : - - "" - -typedef ^ ^ ^ upwind_TI : - - "" - -typedef ^ ^ ^ upwind_small_TI : - - "" - -typedef ^ ^ ^ upwind_smoothWake :: - - "" - -typedef ^ ^ ^ velocity_aerodyn : - - "" - -typedef ^ ^ ^ TI_downstream : - - "" - -typedef ^ ^ ^ small_scale_TI_downstream : - - "" - -typedef ^ ^ ^ smoothed_velocity_array :: - - "" - -typedef ^ ^ ^ vel_matrix ::: - - "The smoothed out wake velocity matrix for n downwind turbine" - - -# wake_meandered_center -typedef DWM/DWM wake_meandered_center IntKi wake_width : - - "wake width" - - -# DWM_turbine_blade -typedef DWM/DWM DWM_turbine_blade IntKi Aerodyn_turbine_num - - - "" - -typedef ^ ^ ^ Blade_index - - - " the index of Aerodyn Blade" - -typedef ^ ^ ^ Element_index - - - " the index of Aerodyn Element" - - - -################## Registry for DWM ############### -# ..... PARAMETERS ......................... -# DWM_Parameters -typedef DWM/DWM ParameterType Reki velocityU : - - "the wake velocity profile @ the downstream turbine plane" - -typedef ^ ^ ^ smoothed_wake : - - "" - -typedef ^ ^ ^ WakePosition ::: - - "meandered wake center" - -typedef ^ ^ IntKi WakePosition_1 - - - "size of the WakePosition" - -typedef ^ ^ ^ WakePosition_2 - - - "size of the WakePosition" - -typedef ^ ^ ^ smooth_flag - - - "Whether or not use the smoothed out upstream wake profile (1-yes, 0-no)" - -typedef ^ ^ ^ p_p_r - - - "" - -typedef ^ ^ ^ NumWT - - - "Number of wind turbines" - -typedef ^ ^ ^ Tinfluencer - - - "" - -typedef ^ ^ Reki RotorR - - - "Rotor radius" - -typedef ^ ^ ^ r_domain - - - "" - -typedef ^ ^ ^ x_domain - - - "" - -typedef ^ ^ ^ Uambient - - - "The ambient wind velocity" - -typedef ^ ^ ^ TI_amb - - - "Ambient turbulence intensity" % -typedef ^ ^ ^ TI_wake - - - "" - -typedef ^ ^ ^ hub_height - - - "" - -typedef ^ ^ ^ length_velocityU - - - "" - -typedef ^ ^ ^ WFLowerBd - - - "The lower bound height of the wind file" - -typedef ^ ^ ^ Wind_file_Mean_u - - - "The mean velocity of the first turbine" - -typedef ^ ^ ^ Winddir - - - "" - -typedef ^ ^ ^ air_density - - - "air density" - -typedef ^ ^ ^ RR - - - "" - -typedef ^ ^ ^ ElementRad : - - " the element node radius" - -typedef ^ ^ IntKi Bnum - - - " the number of blade" - -typedef ^ ^ ^ ElementNum - - - " the number of element" - -typedef ^ ^ read_turbine_position_data RTPD -typedef ^ ParameterType InflowWind_ParameterType IfW - - - - - -# ....... OtherStateType ............ -# DWM_OtherStateType -typedef ^ OtherStateType InflowWind_OtherStateType IfW - - - - - -# ....... OtherStateType ............ -# DWM_MiscVarType -typedef ^ MiscVarType InflowWind_MiscVarType IfW - - - - -typedef DWM/DWM ^ Reki position_y - - - "the y position of the blade node" - -typedef ^ ^ ^ position_z - - - "the z position of the blade node" - -typedef ^ ^ ^ velocity_wake_mean - - - "" - -typedef ^ ^ ^ shifted_velocity_Aerodyn - - - "" - -typedef ^ ^ ^ U_velocity - - - " the u component velocity of blade" - -typedef ^ ^ ^ V_velocity - - - " the v component velocity of blade" - -typedef ^ ^ ^ Nforce :: - - " the normal force" - -typedef ^ ^ ^ blade_dr : - - " blade dr" - -typedef ^ ^ ^ NacYaw - - - "" - -typedef ^ ^ ^ TI_original - - - "" - -typedef ^ ^ turbine_average_velocity_data TAVD -typedef ^ ^ CVSD CalVelScale_data -typedef ^ ^ MeanderData meandering_data -typedef ^ ^ WeiMethod weighting_method -typedef ^ ^ TIDownstream TI_downstream_data -typedef ^ ^ TurbKaimal Turbulence_KS -typedef ^ ^ Shinozuka shinozuka_data -typedef ^ ^ smooth_out_wake_data SmoothOut -typedef ^ ^ SWSV smooth_wake_shifted_velocity_data -typedef ^ ^ DWM_Wake_Deficit_Data DWDD -typedef ^ ^ Reki ct_tilde - - - "the tilde Ct" - -typedef ^ ^ ^ FAST_Time - - - "FAST simulation time" - -typedef ^ ^ IntKi SDtimestep - 0 - "" - -typedef ^ ^ DWM_turbine_blade DWM_tb -typedef ^ ^ wake_meandered_center WMC - -# ........ Input ............ -# DWM_InputType -typedef DWM/DWM InputType read_upwind_result Upwind_result -typedef ^ InputType InflowWind_InputType IfW - - - - - -# ........ Output ............ -# DWM_OutputType - -typedef DWM/DWM OutputType Reki turbine_thrust_force : - - "" N -typedef ^ ^ ^ induction_factor : - - "" - -typedef ^ ^ ^ r_initial : - - "scaled rotor radius" - -typedef ^ ^ ^ U_initial : - - "scaled velocity at the rotor" - -typedef ^ ^ ^ Mean_FFWS_array : - - "Mean velocity of each section on the blade" - -typedef ^ ^ ^ Mean_FFWS - - - "Mean (total) wind speed at the hub height" m/s -typedef ^ ^ ^ TI - - - "the turbulence intensity of the turbine" - -typedef ^ ^ ^ TI_downstream - - - "the TI of a downstream turbine before normalization" - -typedef ^ ^ ^ wake_u :: - - "wake velocity" - -typedef ^ ^ ^ wake_position ::: - - "wake center position" m -typedef ^ ^ ^ smoothed_velocity_array :: - - "smoothed out upstream axisymetric wake profile" - -typedef ^ ^ ^ AtmUscale - - - "atmospheric velocity scale before introducing TI" - -typedef ^ ^ ^ du_dz_ABL - - - "atmosperic shear gradient" - -typedef ^ ^ ^ total_SDgenpwr - 0.0 - "" - -typedef ^ ^ ^ mean_SDgenpwr - - - "" - -typedef ^ ^ ^ avg_ct - - - "average Ct over the rotor" - -typedef ^ OutputType InflowWind_OutputType IfW - - - - - -#.......... ContinuousStateType ...... -# DWM_ContinuousStateType -typedef DWM/DWM ContinuousStateType Reki dummy - - - "" - -typedef ^ ContinuousStateType InflowWind_ContinuousStateType IfW - - - - - -#.......... DiscreteStateType ...... -# DWM_DiscreteStateType -typedef DWM/DWM DiscreteStateType Reki dummy - - - "" - -typedef ^ DiscreteStateType InflowWind_DiscreteStateType IfW - - - - - -#.......... ConstraintStateType ...... -# DWM_ConstraintStateType -typedef DWM/DWM ConstraintStateType Reki dummy - - - "" - -typedef ^ ConstraintStateType InflowWind_ConstraintStateType IfW - - - - - - -#.......... InitInputType ...... -# DWM_InitInputType -typedef DWM/DWM InitInputType Reki dummy - - - "" - -typedef ^ InitInputType InflowWind_InitInputType IfW - - - - - -#.......... InitOutputType ...... -# DWM_InitOutputType -typedef DWM/DWM InitOutputType Reki dummy - - - "" - -typedef ^ InitOutputType InflowWind_InitOutputType IfW - - - - \ No newline at end of file diff --git a/modules/awae/CMakeLists.txt b/modules/awae/CMakeLists.txt index ee236b36b6..25beec5ace 100644 --- a/modules/awae/CMakeLists.txt +++ b/modules/awae/CMakeLists.txt @@ -17,7 +17,7 @@ if (GENERATE_TYPES) generate_f90_types(src/AWAE_Registry.txt ${CMAKE_CURRENT_LIST_DIR}/src/AWAE_Types.f90 -noextrap) endif() -add_library(awaelib +add_library(awaelib STATIC src/AWAE.f90 src/AWAE_IO.f90 src/AWAE_Types.f90 @@ -29,3 +29,15 @@ install(TARGETS awaelib RUNTIME DESTINATION bin LIBRARY DESTINATION lib ARCHIVE DESTINATION lib) + +#set(AWAE_DRIVER_SOURCES +# src/driver/AWAE_Driver_Subs.f90 +# src/driver/AWAE_Driver.f90) +# +#add_executable(awae_driver ${AWAE_DRIVER_SOURCES}) +#target_link_libraries(awae_driver awaelib ifwlib nwtclibs versioninfolib ${CMAKE_DL_LIBS}) +# +#install(TARGETS awae_driver +# RUNTIME DESTINATION bin +# LIBRARY DESTINATION lib +# ARCHIVE DESTINATION lib) diff --git a/modules/awae/src/AWAE.f90 b/modules/awae/src/AWAE.f90 index 5a19a7315c..cec3d20e3e 100644 --- a/modules/awae/src/AWAE.f90 +++ b/modules/awae/src/AWAE.f90 @@ -27,7 +27,6 @@ module AWAE use NWTC_Library use AWAE_Types use AWAE_IO - use InflowWind_Types use InflowWind #ifdef _OPENMP @@ -169,54 +168,221 @@ real(ReKi) function jinc ( x ) end if end function jinc + + +!> Interpolate values at grid point based on surrounding planes (if surrounded by planes) +!! Compute velocity, k_WAT, and store surrounding plane orientation +!! Orientations from plane to inertial for each wake, shape: 3x3xnWake +!! R_p2i = [xphat|i^t yphat|i^t zphat|i^t] +subroutine interp_planes_2_point(u, p, m, GridP, iWT, maxPln, & + iw, wk_R_p2i, wk_V, wk_WAT_k) + type(AWAE_InputType), intent(in ) :: u !< Inputs at Time t + type(AWAE_ParameterType), intent(in ) :: p !< Parameters + type(AWAE_MiscVarType), intent(in ) :: m !< Misc/optimization variables + integer(IntKi), intent(in ) :: iWT + integer(IntKi), intent(in ) :: maxPln + real(ReKi), intent(in ) :: GridP(3) !< grid point, 3 x nFlat + integer(IntKi), intent(inout) :: iw !< Cumulative index on numbre of wakes intersecting at that point + real(ReKi), intent(inout) :: wk_R_p2i(:,:,:)!< Orientations from plane to inertial for each wake, shape: 3x3xnWake + real(ReKi), intent(inout) :: wk_V(:,:) !< Wake velocity from each overlapping wake, shape: 3xnWake + real(ReKi), intent(inout) :: wk_WAT_k(:) !< WAT scaling factors for all wakes (for overlap), shape: nWake + ! Local + real(ReKi) :: x_end_plane + real(ReKi) :: x_start_plane + real(ReKi) :: p_tmp_plane(3) + real(ReKi) :: r_vec_plane(3) + integer(IntKi) :: np, np1 + real(ReKi) :: delta, deltad + real(ReKi) :: tmp_vec(3) + real(ReKi) :: xHat_plane(3), yHat_plane(3), zHat_plane(3) + real(ReKi) :: y_tmp_plane + real(ReKi) :: z_tmp_plane + + !x_end_plane = dot_product(u%xhat_plane(:,0,iWT), (GridP(:) - u%p_plane(:,0,iWT)) ) + x_end_plane = u%xhat_plane(1,0,iWT) * (GridP(1) - u%p_plane(1,0,iWT)) & + &+ u%xhat_plane(2,0,iWT) * (GridP(2) - u%p_plane(2,0,iWT)) & + &+ u%xhat_plane(3,0,iWT) * (GridP(3) - u%p_plane(3,0,iWT)) + + do np = 0, maxPln !p%NumPlanes-2 + np1 = np + 1 + ! Construct the endcaps of the current wake plane volume + x_start_plane = x_end_plane + !x_end_plane = dot_product(u%xhat_plane(:,np1,iWT), (GridP(:) - u%p_plane(:,np1,iWT)) ) + x_end_plane = u%xhat_plane(1,np1,iWT) * (GridP(1) - u%p_plane(1,np1,iWT)) & + &+ u%xhat_plane(2,np1,iWT) * (GridP(2) - u%p_plane(2,np1,iWT)) & + &+ u%xhat_plane(3,np1,iWT) * (GridP(3) - u%p_plane(3,np1,iWT)) + + ! test if the point is within the endcaps of the wake volume + if ( ( ( x_start_plane >= 0.0_ReKi ) .and. ( x_end_plane < 0.0_ReKi ) ) .or. & + ( ( x_start_plane <= 0.0_ReKi ) .and. ( x_end_plane > 0.0_ReKi ) ) ) then + + ! Plane interpolation factor + if ( EqualRealNos( x_start_plane, x_end_plane ) ) then + delta = 0.5_ReKi + else + delta = x_start_plane / ( x_start_plane - x_end_plane ) + end if + deltad = (1.0_ReKi - delta) + + ! Interpolate x_hat, plane normal at grid point + if ( m%parallelFlag(np,iWT) ) then + p_tmp_plane = delta*u%p_plane(:,np+1,iWT) + deltad*u%p_plane(:,np,iWT) + else + tmp_vec = delta*m%rhat_e(:,np,iWT) + deltad*m%rhat_s(:,np,iWT) + p_tmp_plane = delta*m%pvec_ce(:,np,iWT) + deltad*m%pvec_cs(:,np,iWT) + ( delta*m%r_e(np,iWT) + deltad*m%r_s(np,iWT) )* tmp_vec / TwoNorm(tmp_vec) + end if + + ! Vector between current grid and plane position + r_vec_plane = GridP(:) - p_tmp_plane + + ! Interpolate x_hat + xHat_plane(1:3) = delta*u%xhat_plane(:,np1,iWT) + deltad*u%xhat_plane(:,np,iWT) + xHat_plane(1:3) = xHat_plane(:) / TwoNorm(xHat_plane(:)) + ! Construct y_hat, orthogonal to x_hat when its z component is neglected (in a projected horizontal plane) + yHat_plane(1:3) = (/ -xHat_plane(2), xHat_plane(1), 0.0_ReKi /) + yHat_plane(1:3) = yHat_plane / TwoNorm(yHat_plane) + ! Construct z_hat + zHat_plane(1) = -xHat_plane(1)*xHat_plane(3) + zHat_plane(2) = -xHat_plane(2)*xHat_plane(3) + zHat_plane(3) = xHat_plane(1)*xHat_plane(1) + xHat_plane(2)*xHat_plane(2) + zHat_plane(1:3) = zHat_plane / TwoNorm(zHat_plane) + + ! Point positions in plane, y = yhat . (p-p_plane), z = zhat . (p-p_plane) + y_tmp_plane = yHat_plane(1)*r_vec_plane(1) + yHat_plane(2)*r_vec_plane(2) + yHat_plane(3)*r_vec_plane(3) + z_tmp_plane = zHat_plane(1)*r_vec_plane(1) + zHat_plane(2)*r_vec_plane(2) + zHat_plane(3)*r_vec_plane(3) + + ! test if the point is within finite-difference grid + if ( (abs(y_tmp_plane) <= p%y(p%numRadii-1)).and.(abs(z_tmp_plane) <= p%z(p%numRadii-1)) ) then + ! Increment number of wakes contributing to current grid point + iw = iw + 1 + + ! Store unit vectors for projection + wk_R_p2i(:,1,iw) = xHat_plane + wk_R_p2i(:,2,iw) = yHat_plane + wk_R_p2i(:,3,iw) = zHat_plane + + ! Velocity at point (y,z) by 2d interpolation in plane, and interpolations between planes (delta) + wk_V(1,iw) = delta *interp2d((/y_tmp_plane, z_tmp_plane/), p%y, p%z, u%Vx_wake(:,:,np1,iWT)) & + + deltad*interp2d((/y_tmp_plane, z_tmp_plane/), p%y, p%z, u%Vx_wake(:,:,np, iWT)) + wk_V(2,iw) = delta *interp2d((/y_tmp_plane, z_tmp_plane/), p%y, p%z, u%Vy_wake(:,:,np1,iWT)) & + + deltad*interp2d((/y_tmp_plane, z_tmp_plane/), p%y, p%z, u%Vy_wake(:,:,np, iWT)) + wk_V(3,iw) = delta *interp2d((/y_tmp_plane, z_tmp_plane/), p%y, p%z, u%Vz_wake(:,:,np1,iWT)) & + + deltad*interp2d((/y_tmp_plane, z_tmp_plane/), p%y, p%z, u%Vz_wake(:,:,np, iWT)) + + ! WAT scaling factor + if (p%WAT_Enabled) then + wk_WAT_k(iw) = delta *interp2d((/y_tmp_plane, z_tmp_plane/), p%y, p%z, u%WAT_k(:,:,np1,iWT)) & + + deltad*interp2d((/y_tmp_plane, z_tmp_plane/), p%y, p%z, u%WAT_k(:,:,np, iWT)) + endif + + end if ! if the point is within radial finite-difference grid + end if ! if the point is within the endcaps of the wake volume + end do ! np = 0, p%NumPlanes-2 + +endsubroutine interp_planes_2_point + +!> +subroutine mergeWakeVel(n_wake, wk_V, wk_R_p2i, V_qs) + integer(IntKi), intent(in ) :: n_wake !< Total number of wakes crossing at a given point + real(ReKi) , intent(in ) :: wk_V(:,:) !< Velocity for each wake crossing at a given point, shape: 3xnWake + real(ReKi) , intent(in ) :: wk_R_p2i(:,:,:) !< Orientations from plane to inertial for each wake, shape: 3x3xnWake + real(SiKi) , intent(out) :: V_qs(3) !< Merged quasi-steady wake deficit, after wake-intersection averaging (without WAT) + ! Local + real(ReKi) :: V_wake(3) ! Wake velocity vector from a given plane + real(ReKi) :: xhatBar(3) !< plane x normal (in inertial coordinates) averaged over all wakes + real(ReKi) :: xhatBar_norm + real(ReKi) :: Vx_term + real(SiKi) :: Vx_sum2 ! Squared sum of all quasi-steady x-components of wakes, oriented along their respective normal + real(SiKi) :: V_sum(3) ! Sum of all wake deficit components + real(ReKi) :: Vax_qs(3) ! Axial quasi-steady wake, after wake-intersection averaging (without WAT) + real(ReKi) :: Vtv_qs(3) ! Transvere quasi-steady wake, after wake-intersection averaging (without WAT) + integer :: iw + + ! --- Average xhat over overlapping wakes + xhatBar(:) = 0.0_ReKi + do iw=1,n_wake + !weighted xhat: Vx|p * xHat_plane|i + xhatBar = xhatBar + abs(wk_V(1,iw)) * wk_R_p2i(:,1,iw) + enddo + ! Normalize xhatBar to unit vector + xhatBar_norm = sqrt(xhatBar(1)*xhatBar(1)+ xhatBar(2)*xhatBar(2)+ xhatBar(3)*xhatBar(3)) + if ( EqualRealNos(xhatBar_norm, 0.0_ReKi) ) then + xhatBar = 0.0_ReKi + else + xhatBar = xhatBar / xhatBar_norm + end if + + ! -- Compute average contributions - Quasi steady wake + ! - sqrt[ sum (e_x. V)^2 ] e_x ! Axial (sqrt-avg) + ! + sum [(I-e_x.e_x^T). V ] ! Radial (sum) + Vx_sum2 = 0.0_ReKi + V_sum = 0.0_ReKi + do iw = 1,n_wake + ! Transform V_wake from plane coordinate to inertial + V_wake = wk_V(1,iw) * wk_R_p2i(:,1,iw) + wk_V(2,iw) * wk_R_p2i(:,2,iw) + wk_V(3,iw) * wk_R_p2i(:,3,iw) + V_sum = V_sum + V_wake + Vx_term = dot_product( xhatBar, V_wake ) + Vx_sum2 = Vx_sum2 + Vx_term*Vx_term + end do + ! [I - XX']V = V - (V dot X)X + Vtv_qs = V_sum - dot_product(V_sum, xhatBar)*xhatBar + Vax_qs = - xhatBar*sqrt(Vx_sum2) + V_qs = real(Vax_qs + Vtv_qs, SiKi) +end subroutine mergeWakeVel + +!> +subroutine mergeWakeWAT_k(n_wake, wk_WAT_k, WAT_k) + integer(IntKi), intent(in ) :: n_wake !< Total number of wakes crossing at a given point + real(ReKi) , intent(in ) :: wk_WAT_k(:) !< value of k for each wake crossing at a given point, shape: 3xnWake + real(ReKi) , intent(out) :: WAT_k !< Merged WAT_k + integer :: iw + WAT_k = 0.0_ReKi + do iw = 1,n_wake + WAT_k = WAT_k + wk_WAT_k(iw)*wk_WAT_k(iw) + enddo + WAT_k = sqrt(WAT_k) +end subroutine mergeWakeWAT_k + !---------------------------------------------------------------------------------------------------------------------------------- !> Loop over the entire grid of low resolution ambient wind data to compute: !! 1) the disturbed flow at each point and 2) the averaged disturbed velocity of each wake plane !! TODO explain algorithm -subroutine LowResGridCalcOutput(n, u, p, y, m, errStat, errMsg) +subroutine LowResGridCalcOutput(n, u, p, xd, y, m, errStat, errMsg) integer(IntKi), intent(in ) :: n !< Current simulation time increment (zero-based) type(AWAE_InputType), intent(in ) :: u !< Inputs at Time t type(AWAE_ParameterType), intent(in ) :: p !< Parameters + type(AWAE_DiscreteStateType), intent(in ) :: xd !< Discrete states at t type(AWAE_OutputType), intent(inout) :: y !< Outputs computed at t (Input only so that mesh con- !! nectivity information does not have to be recalculated) type(AWAE_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) :: nx, ny, nz, nt, np, nw, nx_low, ny_low, nz_low, nr, npsi, wamb, iwsum !< loop counters - integer(IntKi) :: nXYZ_low, n_wake, n_r_polar, n_psi_polar !< accumulating counters - real(ReKi) :: xhatBar_plane(3) !< - real(ReKi) :: xHat_plane(3), yHat_plane(3), zHat_plane(3) - real(ReKi) :: x_end_plane - real(ReKi) :: x_start_plane - real(ReKi) :: r_vec_plane(3) - real(ReKi) :: xhatBar_plane_norm - real(ReKi) :: y_tmp_plane - real(ReKi) :: z_tmp_plane - real(ReKi) :: Vx_wake_tmp - real(ReKi) :: Vr_wake_tmp(3) - real(ReKi) :: Vr_term(3) - real(ReKi) :: Vx_term - real(ReKi) :: Vsum_low(3) - real(ReKi) :: p_tmp_plane(3) - real(ReKi) :: tmp_vec(3) + integer(IntKi) :: nt, np, ix, iy, iz, nr, npsi, wamb, iwsum !< loop counters + integer(IntKi) :: n_wake, n_r_polar, n_psi_polar !< accumulating counters + real(SiKi) :: V_qs(3) ! Quasi-steady wake deficit , after wake-intersection averaging (without WAT) real(ReKi) :: Vave_amb_low_norm, Vamb_lowpol_tmp(3), Vdist_lowpol_tmp(3), Vamb_low_tmp(3,8) - real(ReKi) :: delta, deltad real(ReKi) :: wsum_tmp, w real(ReKi) :: tmp_x,tmp_y,tmp_z !, tm1, tm2 real(ReKi) :: xxplane(3), xyplane(3), yyplane(3), yxplane(3), psi_polar, r_polar, p_polar(3) real(ReKi) :: yzplane_Y(3), xyplane_norm real(ReKi) :: xplane_sq, yplane_sq, xysq_Z(3), xzplane_X(3) + real(ReKi) :: WAT_k ! WAT scaling factor (averaged from overlapping wakes) + real(ReKi) :: WAT_V(3) ! WAT velocity contribution + real(ReKi) :: Pos_global(3) ! global position integer(IntKi) :: tmpPln - real(ReKi), ALLOCATABLE :: tmp_xhat_plane(:,:), tmp_yhat_plane(:,:), tmp_zhat_plane(:,:) - real(ReKi), ALLOCATABLE :: tmp_Vx_wake(:), tmp_Vz_wake(:), tmp_Vy_wake(:) - integer(IntKi) :: np1 - integer(IntKi) :: i !< Flat counter on X,Y,Z low res grid - integer(IntKi) :: maxN_wake + real(ReKi), allocatable :: wk_R_p2i(:,:,:)!< Orientations from plane to inertial for each wake, shape: 3x3xnWake + real(ReKi), allocatable :: wk_V(:,:) !< Wake velocity from each overlapping wake, shape: 3xnWake + real(ReKi), allocatable :: wk_WAT_k(:) !< WAT scaling factors for all wakes (for overlap) + integer(IntKi) :: iXYZ !< Flat counter on X,Y,Z grid + integer(IntKi) :: i integer(IntKi) :: maxPln + integer(IntKi) :: maxN_wake + integer(IntKi) :: WAT_iT,WAT_iY,WAT_iZ !< indexes for WAT point (Time interchangeable with X) integer(IntKi) :: errStat2 character(*), parameter :: RoutineName = 'LowResGridCalcOutput' logical :: within + real(ReKi) :: yHat_plane(3), zHat_plane(3) real(SiKi), dimension(3,3) :: C_rot real(SiKi) :: C_rot_norm @@ -226,193 +392,99 @@ subroutine LowResGridCalcOutput(n, u, p, y, m, errStat, errMsg) maxPln = min(n,p%NumPlanes-2) tmpPln = min(p%NumPlanes-1, n+1) - -!#ifdef _OPENMP -! tm1 = omp_get_wtime() -!#endif - maxN_wake = p%NumTurbines*( p%NumPlanes-1 ) - ! Temporary variables needed by OpenMP - allocate ( tmp_xhat_plane ( 3, 1:maxN_wake ), STAT=errStat2 ); if (errStat2 /= 0) call SetErrStat ( ErrID_Fatal, 'Could not allocate memory for tmp_xhat_plane.', errStat, errMsg, RoutineName ) - allocate ( tmp_yhat_plane ( 3, 1:maxN_wake ), STAT=errStat2 ); if (errStat2 /= 0) call SetErrStat ( ErrID_Fatal, 'Could not allocate memory for tmp_yhat_plane.', errStat, errMsg, RoutineName ) - allocate ( tmp_zhat_plane ( 3, 1:maxN_wake ), STAT=errStat2 ); if (errStat2 /= 0) call SetErrStat ( ErrID_Fatal, 'Could not allocate memory for tmp_zhat_plane.', errStat, errMsg, RoutineName ) - allocate ( tmp_Vx_wake ( 1:maxN_wake ) , STAT=errStat2 ); if (errStat2 /= 0) call SetErrStat ( ErrID_Fatal, 'Could not allocate memory for tmp_Vx_wake.', errStat, errMsg, RoutineName ) - allocate ( tmp_Vy_wake ( 1:maxN_wake ) , STAT=errStat2 ); if (errStat2 /= 0) call SetErrStat ( ErrID_Fatal, 'Could not allocate memory for tmp_Vy_wake.', errStat, errMsg, RoutineName ) - allocate ( tmp_Vz_wake ( 1:maxN_wake ) , STAT=errStat2 ); if (errStat2 /= 0) call SetErrStat ( ErrID_Fatal, 'Could not allocate memory for tmp_Vz_wake.', errStat, errMsg, RoutineName ) + ! Variables stored for each wake crossing at a given point + allocate ( wk_R_p2i (3, 3, 1:maxN_wake ), STAT=errStat2 ); if (errStat2 /= 0) call SetErrStat ( ErrID_Fatal, 'Could not allocate memory for wk_R_p2i.', errStat, errMsg, RoutineName ) + allocate ( wk_V ( 3, 1:maxN_wake ), STAT=errStat2 ); if (errStat2 /= 0) call SetErrStat ( ErrID_Fatal, 'Could not allocate memory for wk_V.', errStat, errMsg, RoutineName ) + allocate ( wk_WAT_k ( 1:maxN_wake ), STAT=errStat2 ); if (errStat2 /= 0) call SetErrStat ( ErrID_Fatal, 'Could not allocate memory for wk_WAT_k.', errStat, errMsg, RoutineName ) if (ErrStat >= AbortErrLev) return - - ! Loop over the entire grid of low resolution ambient wind data to compute: - ! 1) the disturbed flow at each point and 2) the averaged disturbed velocity of each wake plane + ! --- Loop over the entire grid of low resolution ambient wind data to compute: + ! 1) the disturbed flow at each point and 2) the averaged disturbed velocity of each wake plane !$OMP PARALLEL DO & - !$OMP PRIVATE(i, nx_low, ny_low, nz_low, & - !$OMP& nXYZ_low, n_wake, xhatBar_plane, & - !$OMP& tmp_x,tmp_y,tmp_z,& - !$OMP& x_end_plane, nt, np, np1, & - !$OMP& x_start_plane, delta, deltad, p_tmp_plane, tmp_vec, r_vec_plane, & - !$OMP& xHat_plane, yHat_plane, zHat_plane, & - !$OMP& y_tmp_plane, z_tmp_plane, & - !$OMP& tmp_xhat_plane, tmp_yhat_plane, tmp_zhat_plane,& - !$OMP& tmp_Vx_wake, tmp_Vy_wake, tmp_Vz_wake, & - !$OMP& xhatBar_plane_norm, Vx_wake_tmp, Vr_wake_tmp, nw, Vr_term, Vx_term, & - !$OMP& C_rot, C_rot_norm) & - !$OMP SHARED(m, u, p, maxPln, errStat, errMsg) DEFAULT(NONE) - do i = 0 , p%NumGrid_low - 1 - ! From flat index iXYZ to grid indices nx, ny, nz - nx_low = mod( i ,p%nX_low) - ny_low = mod(int( i / (p%nX_low ) ),p%nY_low) - nz_low = int( i / (p%nX_low*p%nY_low) ) - - ! set the disturbed flow equal to the ambient flow for this time step - m%Vdist_low (:,nx_low,ny_low,nz_low) = m%Vamb_low(:,nx_low,ny_low,nz_low) - m%Vdist_low_full(:,nx_low,ny_low,nz_low) = m%Vamb_low(:,nx_low,ny_low,nz_low) - - !nXYZ_low = nXYZ_low + 1 - nXYZ_low = i + 1 - n_wake = 0 - xhatBar_plane = 0.0_ReKi - - do nt = 1,p%NumTurbines - - ! H Long: replace intrinsic dot_product with explicit do product can save as much as 10% of total calculation time! - !x_end_plane = dot_product(u%xhat_plane(:,0,nt), (p%Grid_Low(:,nXYZ_low) - u%p_plane(:,0,nt)) ) - tmp_x = u%xhat_plane(1,0,nt) * (p%Grid_Low(1,nXYZ_low) - u%p_plane(1,0,nt)) - tmp_y = u%xhat_plane(2,0,nt) * (p%Grid_Low(2,nXYZ_low) - u%p_plane(2,0,nt)) - tmp_z = u%xhat_plane(3,0,nt) * (p%Grid_Low(3,nXYZ_low) - u%p_plane(3,0,nt)) - x_end_plane = tmp_x + tmp_y + tmp_z - - do np = 0, maxPln - np1 = np + 1 - ! Construct the endcaps of the current wake plane volume - x_start_plane = x_end_plane - ! H Long: again, replace intrinsic dot_product - !x_end_plane = dot_product(u%xhat_plane(:,np+1,nt), (p%Grid_Low(:,nXYZ_low) - u%p_plane(:,np+1,nt)) ) - tmp_x = u%xhat_plane(1,np1,nt) * (p%Grid_Low(1,nXYZ_low) - u%p_plane(1,np1,nt)) - tmp_y = u%xhat_plane(2,np1,nt) * (p%Grid_Low(2,nXYZ_low) - u%p_plane(2,np1,nt)) - tmp_z = u%xhat_plane(3,np1,nt) * (p%Grid_Low(3,nXYZ_low) - u%p_plane(3,np1,nt)) - x_end_plane = tmp_x + tmp_y + tmp_z - - ! test if the point is within the endcaps of the wake volume - if ( ( ( x_start_plane >= 0.0_ReKi ) .and. ( x_end_plane < 0.0_ReKi ) ) .or. & - ( ( x_start_plane <= 0.0_ReKi ) .and. ( x_end_plane > 0.0_ReKi ) ) ) then - - ! Plane interpolation factor - if ( EqualRealNos( x_start_plane, x_end_plane ) ) then - delta = 0.5_ReKi - else - delta = x_start_plane / ( x_start_plane - x_end_plane ) - end if - deltad = (1.0_ReKi - delta) - - ! Interpolated plane position - if ( m%parallelFlag(np,nt) ) then - p_tmp_plane = delta*u%p_plane(:,np1,nt) + deltad*u%p_plane(:,np,nt) - else - tmp_vec = delta*m%rhat_e(:,np,nt) + deltad*m%rhat_s(:,np,nt) - p_tmp_plane = delta*m%pvec_ce(:,np,nt) + deltad*m%pvec_cs(:,np,nt) + ( delta*m%r_e(np,nt) + deltad*m%r_s(np,nt) )* tmp_vec / TwoNorm(tmp_vec) - end if - - ! Vector between current grid point and plane position - r_vec_plane = p%Grid_Low(:,nXYZ_low) - p_tmp_plane - - ! Interpolate x_hat, plane normal at grid point - xHat_plane(1:3) = delta*u%xhat_plane(:,np1,nt) + deltad*u%xhat_plane(:,np,nt) - xHat_plane(1:3) = xHat_plane(:) / TwoNorm(xHat_plane(:)) - ! Construct y_hat, orthogonal to x_hat when its z component is neglected (in a projected horizontal plane) - yHat_plane(1:3) = (/ -xHat_plane(2), xHat_plane(1), 0.0_ReKi /) - yHat_plane(1:3) = yHat_plane / TwoNorm(yHat_plane) - ! Construct z_hat - zHat_plane(1) = -xHat_plane(1)*xHat_plane(3) - zHat_plane(2) = -xHat_plane(2)*xHat_plane(3) - zHat_plane(3) = xHat_plane(1)*xHat_plane(1) + xHat_plane(2)*xHat_plane(2) - zHat_plane(1:3) = zHat_plane / TwoNorm(zHat_plane) - - ! Point positions in plane, y = yhat . (p-p_plane), z = zhat . (p-p_plane) - y_tmp_plane = yHat_plane(1)*r_vec_plane(1) + yHat_plane(2)*r_vec_plane(2) + yHat_plane(3)*r_vec_plane(3) - z_tmp_plane = zHat_plane(1)*r_vec_plane(1) + zHat_plane(2)*r_vec_plane(2) + zHat_plane(3)*r_vec_plane(3) - - ! test if the point is within finite-difference grid - if ( (abs(y_tmp_plane) <= p%y(p%numRadii-1)).and.(abs(z_tmp_plane) <= p%z(p%numRadii-1)) ) then - ! Increment number of wakes contributing to current grid point - n_wake = n_wake + 1 - - ! Store unit vectors for projection - tmp_xhat_plane(:,n_wake) = xHat_plane - tmp_yhat_plane(:,n_wake) = yHat_plane - tmp_zhat_plane(:,n_wake) = zHat_plane - - ! Velocity at point (y,z) by 2d interpolation in plane, and interpolations between planes (delta) - tmp_Vx_wake(n_wake) = delta *interp2d((/y_tmp_plane, z_tmp_plane/), p%y, p%z, u%Vx_wake(:,:,np1,nt)) & - + deltad*interp2d((/y_tmp_plane, z_tmp_plane/), p%y, p%z, u%Vx_wake(:,:,np, nt)) - tmp_Vy_wake(n_wake) = delta *interp2d((/y_tmp_plane, z_tmp_plane/), p%y, p%z, u%Vy_wake(:,:,np1,nt)) & - + deltad*interp2d((/y_tmp_plane, z_tmp_plane/), p%y, p%z, u%Vy_wake(:,:,np, nt)) - tmp_Vz_wake(n_wake) = delta *interp2d((/y_tmp_plane, z_tmp_plane/), p%y, p%z, u%Vz_wake(:,:,np1,nt)) & - + deltad*interp2d((/y_tmp_plane, z_tmp_plane/), p%y, p%z, u%Vz_wake(:,:,np, nt)) - ! Average xhat over overlapping wakes - xhatBar_plane = xhatBar_plane + abs(tmp_Vx_wake(n_wake))*tmp_xhat_plane(:,n_wake) - - end if ! if the point is within radial finite-difference grid - end if - end do ! do np = 0, p%NumPlanes-2 - end do ! do nt = 1,p%NumTurbines - - if (n_wake > 0) then - ! Normalize xhatBar to unit vector - xhatBar_plane_norm = TwoNorm(xhatBar_plane) - if ( EqualRealNos(xhatBar_plane_norm, 0.0_ReKi) ) then - xhatBar_plane = 0.0_ReKi - else - xhatBar_plane = xhatBar_plane / xhatBar_plane_norm - end if - ! Compute average contributions - ! - sqrt[ sum (e_x. V)^2 ] e_x ! Axial (sqrt-avg) - ! + sum [(I-e_x.e_x^T). V ] ! Radial (sum) - Vx_wake_tmp = 0.0_ReKi - Vr_wake_tmp = 0.0_ReKi - do nw = 1,n_wake - Vr_term = tmp_Vx_wake(nw)*tmp_xhat_plane(:,nw) + tmp_Vy_wake(nw)*tmp_yhat_plane(:,nw) + tmp_Vz_wake(nw)*tmp_zhat_plane(:,nw) - Vx_term = dot_product( xhatBar_plane, Vr_term ) - Vx_wake_tmp = Vx_wake_tmp + Vx_term*Vx_term - Vr_wake_tmp = Vr_wake_tmp + Vr_term - end do - ! [I - XX']V = V - (V dot X)X - Vr_wake_tmp = Vr_wake_tmp - dot_product(Vr_wake_tmp,xhatBar_plane)*xhatBar_plane - ! Compute C matrix and update Vdist_low - if(p%Mod_Projection==1) then - ! We keep the full field (including cross flow components), done for outputs and VTK outputs - m%Vdist_low (:,nx_low,ny_low,nz_low) = m%Vdist_low (:,nx_low,ny_low,nz_low) + real(Vr_wake_tmp - xhatBar_plane*sqrt(Vx_wake_tmp),SiKi) - m%Vdist_low_full(:,nx_low,ny_low,nz_low) = m%Vdist_low_full(:,nx_low,ny_low,nz_low) + real(Vr_wake_tmp - xhatBar_plane*sqrt(Vx_wake_tmp),SiKi) - - else if (p%Mod_Projection==2) then - ! We project against the normal of the plane to remove the cross flow components - C_rot(1,1) = m%Vamb_low(1,nx_low,ny_low,nz_low) * m%Vamb_low(1,nx_low,ny_low,nz_low) - C_rot(1,2) = m%Vamb_low(1,nx_low,ny_low,nz_low) * m%Vamb_low(2,nx_low,ny_low,nz_low) - C_rot(1,3) = m%Vamb_low(1,nx_low,ny_low,nz_low) * m%Vamb_low(3,nx_low,ny_low,nz_low) - - C_rot(2,1) = m%Vamb_low(2,nx_low,ny_low,nz_low) * m%Vamb_low(1,nx_low,ny_low,nz_low) - C_rot(2,2) = m%Vamb_low(2,nx_low,ny_low,nz_low) * m%Vamb_low(2,nx_low,ny_low,nz_low) - C_rot(2,3) = m%Vamb_low(2,nx_low,ny_low,nz_low) * m%Vamb_low(3,nx_low,ny_low,nz_low) - - C_rot(3,1) = m%Vamb_low(3,nx_low,ny_low,nz_low) * m%Vamb_low(1,nx_low,ny_low,nz_low) - C_rot(3,2) = m%Vamb_low(3,nx_low,ny_low,nz_low) * m%Vamb_low(2,nx_low,ny_low,nz_low) - C_rot(3,3) = m%Vamb_low(3,nx_low,ny_low,nz_low) * m%Vamb_low(3,nx_low,ny_low,nz_low) - - C_rot_norm = C_rot(1,1) + C_rot(2,2) + C_rot(3,3) - if (EqualRealNos( C_rot_norm, 0.0_SiKi) ) then - ! do nothing - else - C_rot = C_rot / C_rot_norm - ! Full field is for VTK outputs, contains the cross flow components - m%Vdist_low (:,nx_low,ny_low,nz_low) = m%Vdist_low (:,nx_low,ny_low,nz_low) + matmul(C_rot, real(Vr_wake_tmp - xhatBar_plane*sqrt(Vx_wake_tmp),SiKi)) - m%Vdist_low_full(:,nx_low,ny_low,nz_low) = m%Vdist_low_full(:,nx_low,ny_low,nz_low) + real(Vr_wake_tmp - xhatBar_plane*sqrt(Vx_wake_tmp),SiKi) - endif - endif - - end if ! (n_wake > 0) - end do ! i, loop NumGrid_low points - ! end do ! do nx_low=0, p%nX_low-1 - ! end do ! do ny_low=0, p%nY_low-1 - !end do ! do nz_low=0, p%nZ_low-1 + !$OMP PRIVATE(iXYZ, ix, iy, iz, n_wake, nt, np, & + !$OMP& wk_R_p2i, wk_V,& + !$OMP& V_qs, & + !$OMP& C_rot, C_rot_norm, Pos_global,& + !$OMP& wk_WAT_k, WAT_k, WAT_iT, WAT_iY, WAT_iZ, WAT_V)& + !$OMP SHARED(m, u, p, xd, maxPln, errStat, errMsg) DEFAULT(NONE) + do iXYZ = 1 , p%NumGrid_low + ! From flat index iXYZ to grid indices + ix = mod( (iXYZ-1) ,p%nX_low) + iy = mod(int( (iXYZ-1) / (p%nX_low ) ),p%nY_low) + iz = int( (iXYZ-1) / (p%nX_low*p%nY_low) ) + + ! set the disturbed flow equal to the ambient flow for this time step + m%Vdist_low (:,ix,iy,iz) = m%Vamb_low(:,ix,iy,iz) + m%Vdist_low_full(:,ix,iy,iz) = m%Vamb_low(:,ix,iy,iz) + + ! --- Compute variables wk_* (e.g. velocity) from each wakes reaching the current grid point + n_wake = 0 ! cumulative index, increases if point is at intersection of multiple wakes + do nt = 1,p%NumTurbines + call interp_planes_2_point(u, p, m, p%Grid_low(:,iXYZ), nt, maxPln, & ! In + n_wake, wk_R_p2i, wk_V, wk_WAT_k ) ! InOut + end do ! do nt = 1,p%NumTurbines + + if (n_wake > 0) then + + ! --- Compute merged wake velocity V_qs + call mergeWakeVel(n_wake, wk_V, wk_R_p2i, V_qs) + + ! --- Compute average WAT scaling factor and WAT velocity + if (p%WAT_Enabled) then + call mergeWakeWAT_k(n_wake, wk_WAT_k, WAT_k) + ! Position of current grid point + Pos_global(1) = real(ix,ReKi) * p%dX_low + p%X0_low + Pos_global(2) = real(iy,ReKi) * p%dY_low + p%Y0_low + Pos_global(3) = real(iz,ReKi) * p%dZ_low + p%Z0_low + ! The FlowField stores data in Y,Z,T -- Mean wind speed was set to 1.0, so Rate is 1/DT = 1/DX + ! NOTE: the field moves with the average wind field. So the +X is -T in the Mann box + WAT_iT = modulo( nint( (Pos_global(1) - xd%WAT_B_Box(1)) * p%WAT_FlowField%Grid3D%Rate ), p%WAT_FlowField%Grid3D%NSteps ) + 1 ! eq 23 + WAT_iY = modulo( nint( (Pos_global(2) + xd%WAT_B_Box(2)) * p%WAT_FlowField%Grid3D%InvDY ), p%WAT_FlowField%Grid3D%NYGrids) + 1 ! eq 24 + WAT_iZ = modulo( nint( (Pos_global(3) + xd%WAT_B_Box(3)) * p%WAT_FlowField%Grid3D%InvDZ ), p%WAT_FlowField%Grid3D%NZGrids) + 1 ! eq 25 + WAT_V(1:3) = real(p%WAT_FlowField%Grid3D%Vel(1:3,WAT_iY,WAT_iZ,WAT_iT) * WAT_k, SiKi) + else + WAT_V = 0.0_SiKi + endif + + !--- Store full velocity (Ambient + Wake QS + WAT) in grid + if(p%Mod_Projection==3) then + ! We do not convect using WAT_T, but we include it in outputs + m%Vdist_low (:,ix,iy,iz) = m%Vdist_low (:,ix,iy,iz) + V_qs + m%Vdist_low_full(:,ix,iy,iz) = m%Vdist_low_full(:,ix,iy,iz) + V_qs + WAT_V + + else if(p%Mod_Projection==1) then + ! We keep the full field (including cross flow components), done for outputs and VTK outputs + m%Vdist_low (:,ix,iy,iz) = m%Vdist_low (:,ix,iy,iz) + V_qs + WAT_V + m%Vdist_low_full(:,ix,iy,iz) = m%Vdist_low_full(:,ix,iy,iz) + V_qs + WAT_V + + else if (p%Mod_Projection==2) then + ! We project against the normal of the plane to remove the cross flow components + C_rot(1,1) = m%Vamb_low(1,ix,iy,iz) * m%Vamb_low(1,ix,iy,iz) + C_rot(1,2) = m%Vamb_low(1,ix,iy,iz) * m%Vamb_low(2,ix,iy,iz) + C_rot(1,3) = m%Vamb_low(1,ix,iy,iz) * m%Vamb_low(3,ix,iy,iz) + + C_rot(2,1) = m%Vamb_low(2,ix,iy,iz) * m%Vamb_low(1,ix,iy,iz) + C_rot(2,2) = m%Vamb_low(2,ix,iy,iz) * m%Vamb_low(2,ix,iy,iz) + C_rot(2,3) = m%Vamb_low(2,ix,iy,iz) * m%Vamb_low(3,ix,iy,iz) + + C_rot(3,1) = m%Vamb_low(3,ix,iy,iz) * m%Vamb_low(1,ix,iy,iz) + C_rot(3,2) = m%Vamb_low(3,ix,iy,iz) * m%Vamb_low(2,ix,iy,iz) + C_rot(3,3) = m%Vamb_low(3,ix,iy,iz) * m%Vamb_low(3,ix,iy,iz) + + C_rot_norm = C_rot(1,1) + C_rot(2,2) + C_rot(3,3) + if (EqualRealNos( C_rot_norm, 0.0_SiKi) ) then + ! do nothing + else + C_rot = C_rot / C_rot_norm + ! Full field is for VTK outputs, contains the cross flow components + m%Vdist_low (:,ix,iy,iz) = m%Vdist_low (:,ix,iy,iz) + matmul(C_rot, V_qs + WAT_V) + m%Vdist_low_full(:,ix,iy,iz) = m%Vdist_low_full(:,ix,iy,iz) + V_qs + WAT_V + endif + endif + + end if ! (n_wake > 0) + end do ! iXYZ, loop NumGrid_low points !$OMP END PARALLEL DO do nt = 1,p%NumTurbines @@ -457,7 +529,7 @@ subroutine LowResGridCalcOutput(n, u, p, y, m, errStat, errMsg) if ( np == 0 ) then - Vsum_low = 0.0_ReKi + m%V_amb_low_disk(1:3,nt) = 0.0_ReKi iwsum = 0 n_r_polar = FLOOR((p%C_Meander*u%D_wake(np,nt))/(2.0_ReKi*p%dpol)) @@ -472,7 +544,7 @@ subroutine LowResGridCalcOutput(n, u, p, y, m, errStat, errMsg) p_polar = u%p_plane(:,np,nt) + r_polar*COS(psi_polar)*yHat_plane + r_polar*SIN(psi_polar)*zHat_plane Vamb_lowpol_tmp = INTERP3D( p_polar, p%Grid_Low(:,1), p%dXYZ_Low, m%Vamb_low, within, p%nX_low, p%nY_low, p%nZ_low, Vbox=Vamb_low_tmp ) if ( within ) then - Vsum_low = Vsum_low + Vamb_lowpol_tmp + m%V_amb_low_disk(1:3,nt) = m%V_amb_low_disk(1:3,nt) + Vamb_lowpol_tmp do i = 1,8 iwsum = iwsum + 1 m%Vamb_lowpol(:,iwsum) = Vamb_low_tmp(:,i) @@ -490,16 +562,16 @@ subroutine LowResGridCalcOutput(n, u, p, y, m, errStat, errMsg) else - Vsum_low = Vsum_low/REAL(iwsum/8,ReKi) ! iwsum is always a multiple of 8 - Vave_amb_low_norm = TwoNorm(Vsum_low) + m%V_amb_low_disk(1:3,nt) = m%V_amb_low_disk(1:3,nt)/REAL(iwsum/8,ReKi) ! iwsum is always a multiple of 8 + Vave_amb_low_norm = TwoNorm(m%V_amb_low_disk(1:3,nt)) if ( EqualRealNos(Vave_amb_low_norm, 0.0_ReKi ) ) then call SetErrStat( ErrID_Fatal, 'The magnitude of the spatial-averaged ambient wind speed in the low-resolution domain associated with the wake plane at the rotor disk for turbine #'//trim(num2lstr(nt))//' is zero.', errStat, errMsg, RoutineName ) return else - y%Vx_wind_disk(nt) = dot_product( u%xhat_plane(:,np,nt),Vsum_low ) + y%Vx_wind_disk(nt) = dot_product( u%xhat_plane(:,np,nt),m%V_amb_low_disk(1:3,nt) ) y%TI_amb(nt) = 0.0_ReKi do wamb = 1, iwsum - y%TI_amb(nt) = y%TI_amb(nt)+TwoNorm(m%Vamb_lowpol(:,wamb)-Vsum_low)**2.0_ReKi + y%TI_amb(nt) = y%TI_amb(nt)+TwoNorm(m%Vamb_lowpol(:,wamb)-m%V_amb_low_disk(1:3,nt))**2.0_ReKi end do !wamb y%TI_amb(nt) = sqrt(y%TI_amb(nt)/(3.0_ReKi*REAL(iwsum,ReKi)))/Vave_amb_low_norm end if !Vave_amb_low_norm @@ -555,62 +627,44 @@ subroutine LowResGridCalcOutput(n, u, p, y, m, errStat, errMsg) end do ! np, tmpPln end do ! nt, turbines -!#ifdef _OPENMP -! tm2 = omp_get_wtime() -! write(*,*) 'Total AWAE:LowResGridCalcOutput using '//trim(num2lstr(tm2-tm1))//' seconds' - -!#endif - - if (allocated(tmp_xhat_plane)) deallocate(tmp_xhat_plane) - if (allocated(tmp_yhat_plane)) deallocate(tmp_yhat_plane) - if (allocated(tmp_zhat_plane)) deallocate(tmp_zhat_plane) - if (allocated(tmp_Vx_wake)) deallocate(tmp_Vx_wake) - if (allocated(tmp_Vy_wake)) deallocate(tmp_Vy_wake) - if (allocated(tmp_Vz_wake)) deallocate(tmp_Vz_wake) + if (allocated(wk_R_p2i)) deallocate(wk_R_p2i) + if (allocated(wk_V)) deallocate(wk_V) + if (allocated(wk_WAT_k)) deallocate(wk_WAT_k) end subroutine LowResGridCalcOutput - !---------------------------------------------------------------------------------------------------------------------------------- !> Loop over each point of the high resolution ambient wind to compute: !! 1) the disturbed flow at each point and 2) the averaged disturbed velocity of each wake plane !! TODO explain algorithm -subroutine HighResGridCalcOutput(n, u, p, y, m, errStat, errMsg) +subroutine HighResGridCalcOutput(n, u, p, xd, y, m, errStat, errMsg) integer(IntKi), intent(in ) :: n !< Current high-res, simulation time increment (zero-based) type(AWAE_InputType), intent(in ) :: u !< Inputs at Time t type(AWAE_ParameterType), intent(in ) :: p !< Parameters + type(AWAE_DiscreteStateType), intent(in ) :: xd !< Discrete states at t type(AWAE_OutputType), intent(inout) :: y !< Outputs computed at t (Input only so that mesh con- !! nectivity information does not have to be recalculated) type(AWAE_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) :: nx, ny, nz, nt, nt2, np, nw, nx_high, ny_high, nz_high, n_hl !< loop counters - integer(IntKi) :: nXYZ_high, n_wake !< accumulating counters - real(ReKi) :: xhatBar_plane(3) !< - real(ReKi) :: xHat_plane(3), yHat_plane(3), zHat_plane(3) - real(ReKi) :: xhatBar_plane_norm - real(ReKi) :: x_end_plane - real(ReKi) :: x_start_plane - real(ReKi) :: r_vec_plane(3) - real(ReKi) :: y_tmp_plane - real(ReKi) :: z_tmp_plane - real(ReKi) :: Vx_wake_tmp - real(ReKi) :: Vr_wake_tmp(3) - real(ReKi) :: Vr_term(3) - real(ReKi) :: Vx_term - real(ReKi) :: Vsum_low(3) - real(ReKi) :: p_tmp_plane(3) - real(ReKi) :: tmp_vec(3) - real(ReKi) :: delta, deltad - real(ReKi), ALLOCATABLE :: tmp_xhat_plane(:,:), tmp_yhat_plane(:,:), tmp_zhat_plane(:,:) - real(ReKi), ALLOCATABLE :: tmp_Vx_wake(:), tmp_Vz_wake(:), tmp_Vy_wake(:) + integer(IntKi) :: nt, nt2, np, ix, iy, iz, i_hl !< loop counters + integer(IntKi) :: n_wake !< accumulating counters + real(SiKi) :: V_qs(3) ! Quasi-steady wake deficit , after wake-intersection averaging (without WAT) + real(ReKi) :: WAT_k ! WAT scaling factor (averaged from overlapping wakes) + real(SiKi) :: WAT_V(3) ! WAT velocity contribution + real(ReKi) :: Pos_global(3) ! global position + real(ReKi), allocatable :: WAT_B_BoxHi(:,:) ! position of WAT box (global) for each intermediate steps, shape: 3 x n_high_low + real(ReKi), allocatable :: wk_R_p2i(:,:,:)!< Orientations from plane to inertial for each wake, shape: 3x3xnWake + real(ReKi), allocatable :: wk_V(:,:) !< Wake velocity from each overlapping wake, shape: 3xnWake + real(ReKi), allocatable :: wk_WAT_k(:) !< WAT scaling factors for all wakes (for overlap) integer(IntKi) :: np1 integer(IntKi) :: iXYZ !< Flat counter on X,Y,Z high res grid integer(IntKi) :: maxPln integer(IntKi) :: maxN_wake integer(IntKi) :: NumGrid_high !< number of points in high res grid grid integer(IntKi) :: n_high_low + integer(IntKi) :: WAT_iT,WAT_iY,WAT_iZ !< indexes for WAT point (Time interchangeable with X) integer(IntKi) :: errStat2 character(*), parameter :: RoutineName = 'HighResGridCalcOutput' errStat = ErrID_None @@ -625,178 +679,104 @@ subroutine HighResGridCalcOutput(n, u, p, y, m, errStat, errMsg) n_high_low = p%n_high_low end if - maxN_wake = p%NumTurbines*( p%NumPlanes-1 ) - ! Temporary variables needed by OpenMP - allocate ( tmp_xhat_plane ( 3, 1:maxN_wake ), STAT=errStat2 ); if (errStat2 /= 0) call SetErrStat ( ErrID_Fatal, 'Could not allocate memory for tmp_xhat_plane.', errStat, errMsg, RoutineName ) - allocate ( tmp_yhat_plane ( 3, 1:maxN_wake ), STAT=errStat2 ); if (errStat2 /= 0) call SetErrStat ( ErrID_Fatal, 'Could not allocate memory for tmp_yhat_plane.', errStat, errMsg, RoutineName ) - allocate ( tmp_zhat_plane ( 3, 1:maxN_wake ), STAT=errStat2 ); if (errStat2 /= 0) call SetErrStat ( ErrID_Fatal, 'Could not allocate memory for tmp_zhat_plane.', errStat, errMsg, RoutineName ) - allocate ( tmp_Vx_wake ( 1:maxN_wake ) , STAT=errStat2 ); if (errStat2 /= 0) call SetErrStat ( ErrID_Fatal, 'Could not allocate memory for tmp_Vx_wake.', errStat, errMsg, RoutineName ) - allocate ( tmp_Vy_wake ( 1:maxN_wake ) , STAT=errStat2 ); if (errStat2 /= 0) call SetErrStat ( ErrID_Fatal, 'Could not allocate memory for tmp_Vy_wake.', errStat, errMsg, RoutineName ) - allocate ( tmp_Vz_wake ( 1:maxN_wake ) , STAT=errStat2 ); if (errStat2 /= 0) call SetErrStat ( ErrID_Fatal, 'Could not allocate memory for tmp_Vz_wake.', errStat, errMsg, RoutineName ) + ! Variables stored for each wake crossing at a given point + allocate ( wk_R_p2i (3, 3, 1:maxN_wake ), STAT=errStat2 ); if (errStat2 /= 0) call SetErrStat ( ErrID_Fatal, 'Could not allocate memory for wk_R_p2i.', errStat, errMsg, RoutineName ) + allocate ( wk_V ( 3, 1:maxN_wake ), STAT=errStat2 ); if (errStat2 /= 0) call SetErrStat ( ErrID_Fatal, 'Could not allocate memory for wk_V.', errStat, errMsg, RoutineName ) + allocate ( wk_WAT_k ( 1:maxN_wake ), STAT=errStat2 ); if (errStat2 /= 0) call SetErrStat ( ErrID_Fatal, 'Could not allocate memory for wk_WAT_k.', errStat, errMsg, RoutineName ) if (ErrStat >= AbortErrLev) return - ! Loop over the entire grid of high resolution ambient wind data to compute: - ! 1) the disturbed flow at each point and 2) the averaged disturbed velocity of each wake plane - ! NOTE: loop here is different from low res grid, doing: turbines > grid > turbines(nt/=nt2) > planes - ! instead of grid > turbines > planes - ! TODO explain + ! Convect WAT Box tracer for each intermediate step + ! Note: we substract because the high-res points are "before" current low res point + if (p%WAT_Enabled) then + allocate ( WAT_B_BoxHi ( 3, 0:n_high_low), STAT=errStat2 ); if (errStat2 /= 0) call SetErrStat ( ErrID_Fatal, 'Could not allocate memory for WAT_B_BoxHi.', errStat, errMsg, RoutineName ) + if (ErrStat >= AbortErrLev) return + do i_hl=0, n_high_low + WAT_B_BoxHi(1:3, i_hl) = xd%WAT_B_Box(1:3) - (n_high_low-i_hl) * xd%Ufarm(1:3) * real(p%DT_high,ReKi) + enddo + endif + ! --- Loop over the entire grid of high resolution ambient wind data to compute: + ! 1) the disturbed flow at each point and 2) the averaged disturbed velocity of each wake plane + ! NOTE: loop here is different from low res grid, doing: turbines > grid > turbines(nt/=nt2) > planes + ! instead of grid > turbines > planes + ! TODO explain NumGrid_high = p%nX_high*p%nY_high*p%nZ_high do nt = 1,p%NumTurbines - - ! set the disturbed flow equal to the ambient flow for this time step + ! set the disturbed flow equal to the ambient flow for this time step y%Vdist_high(nt)%data = m%Vamb_high(nt)%data !$OMP PARALLEL DO DEFAULT(NONE) & - !$OMP PRIVATE (nx_high, ny_high, nz_high,& - !$OMP& nXYZ_high, n_wake, xhatBar_plane,& - !$OMP& nt2, x_end_plane, np, np1,& - !$OMP& x_start_plane, delta, deltad, p_tmp_plane, tmp_vec, r_vec_plane,& - !$OMP& xHat_plane, yHat_plane, zHat_plane,& - !$OMP& y_tmp_plane, z_tmp_plane,& - !$OMP& tmp_xhat_plane, tmp_yhat_plane, tmp_zhat_plane,& - !$OMP& tmp_Vx_wake, tmp_Vy_wake, tmp_Vz_wake,& - !$OMP& xhatBar_plane_norm, Vx_wake_tmp, Vr_wake_tmp, nw, Vr_term, Vx_term,& - !$OMP& n_hl)& - !$OMP SHARED(NumGrid_High, m, u, p, y, nt, maxPln, n_high_low, errStat, errMsg) - ! Loop over all points of the high resolution ambiend wind - do iXYZ=0, NumGrid_high-1 - ! From flat index iXYZ to grid indices nx, ny, nz - nx_high = mod( iXYZ ,p%nX_high) - ny_high = mod(int( iXYZ / (p%nX_high ) ),p%nY_high) - nz_high = int( iXYZ / (p%nX_high*p%nY_high) ) - - nXYZ_high = iXYZ + 1 - n_wake = 0 - xhatBar_plane = 0.0_ReKi - - do nt2 = 1,p%NumTurbines - if (nt /= nt2) then - - x_end_plane = dot_product(u%xhat_plane(:,0,nt2), (p%Grid_high(:,nXYZ_high,nt) - u%p_plane(:,0,nt2)) ) - - do np = 0, maxPln !p%NumPlanes-2 - np1 = np + 1 - ! Construct the endcaps of the current wake plane volume - x_start_plane = x_end_plane - x_end_plane = dot_product(u%xhat_plane(:,np+1,nt2), (p%Grid_high(:,nXYZ_high,nt) - u%p_plane(:,np+1,nt2)) ) - - ! test if the point is within the endcaps of the wake volume - if ( ( ( x_start_plane >= 0.0_ReKi ) .and. ( x_end_plane < 0.0_ReKi ) ) .or. & - ( ( x_start_plane <= 0.0_ReKi ) .and. ( x_end_plane > 0.0_ReKi ) ) ) then - - ! Plane interpolation factor - if ( EqualRealNos( x_start_plane, x_end_plane ) ) then - delta = 0.5_ReKi - else - delta = x_start_plane / ( x_start_plane - x_end_plane ) - end if - deltad = (1.0_ReKi - delta) - - ! Interpolate x_hat, plane normal at grid point - if ( m%parallelFlag(np,nt2) ) then - p_tmp_plane = delta*u%p_plane(:,np+1,nt2) + deltad*u%p_plane(:,np,nt2) - else - tmp_vec = delta*m%rhat_e(:,np,nt2) + deltad*m%rhat_s(:,np,nt2) - p_tmp_plane = delta*m%pvec_ce(:,np,nt2) + deltad*m%pvec_cs(:,np,nt2) + ( delta*m%r_e(np,nt2) + deltad*m%r_s(np,nt2) )* tmp_vec / TwoNorm(tmp_vec) - end if - - ! Vector between current grid and plane position - r_vec_plane = p%Grid_high(:,nXYZ_high,nt) - p_tmp_plane - - ! Interpolate x_hat - xHat_plane(1:3) = delta*u%xhat_plane(:,np1,nt2) + deltad*u%xhat_plane(:,np,nt2) - xHat_plane(1:3) = xHat_plane(:) / TwoNorm(xHat_plane(:)) - ! Construct y_hat, orthogonal to x_hat when its z component is neglected (in a projected horizontal plane) - yHat_plane(1:3) = (/ -xHat_plane(2), xHat_plane(1), 0.0_ReKi /) - yHat_plane(1:3) = yHat_plane / TwoNorm(yHat_plane) - ! Construct z_hat - zHat_plane(1) = -xHat_plane(1)*xHat_plane(3) - zHat_plane(2) = -xHat_plane(2)*xHat_plane(3) - zHat_plane(3) = xHat_plane(1)*xHat_plane(1) + xHat_plane(2)*xHat_plane(2) - zHat_plane(1:3) = zHat_plane / TwoNorm(zHat_plane) - - ! Point positions in plane, y = yhat . (p-p_plane), z = zhat . (p-p_plane) - y_tmp_plane = yHat_plane(1)*r_vec_plane(1) + yHat_plane(2)*r_vec_plane(2) + yHat_plane(3)*r_vec_plane(3) - z_tmp_plane = zHat_plane(1)*r_vec_plane(1) + zHat_plane(2)*r_vec_plane(2) + zHat_plane(3)*r_vec_plane(3) - - ! test if the point is within finite-difference grid - if ( (abs(y_tmp_plane) <= p%y(p%numRadii-1)).and.(abs(z_tmp_plane) <= p%z(p%numRadii-1)) ) then - ! Increment number of wakes contributing to current grid point - n_wake = n_wake + 1 - - ! Store unit vectors for projection - tmp_xhat_plane(:,n_wake) = xHat_plane - tmp_yhat_plane(:,n_wake) = yHat_plane - tmp_zhat_plane(:,n_wake) = zHat_plane - - ! Velocity at point (y,z) by 2d interpolation in plane, and interpolations between planes (delta) - tmp_Vx_wake(n_wake) = delta *interp2d((/y_tmp_plane, z_tmp_plane/), p%y, p%z, u%Vx_wake(:,:,np1,nt2)) & - + deltad*interp2d((/y_tmp_plane, z_tmp_plane/), p%y, p%z, u%Vx_wake(:,:,np, nt2)) - tmp_Vy_wake(n_wake) = delta *interp2d((/y_tmp_plane, z_tmp_plane/), p%y, p%z, u%Vy_wake(:,:,np1,nt2)) & - + deltad*interp2d((/y_tmp_plane, z_tmp_plane/), p%y, p%z, u%Vy_wake(:,:,np, nt2)) - tmp_Vz_wake(n_wake) = delta *interp2d((/y_tmp_plane, z_tmp_plane/), p%y, p%z, u%Vz_wake(:,:,np1,nt2)) & - + deltad*interp2d((/y_tmp_plane, z_tmp_plane/), p%y, p%z, u%Vz_wake(:,:,np, nt2)) - - ! Average xhat over overlapping wakes - xhatBar_plane = xhatBar_plane + abs(tmp_Vx_wake(n_wake))*tmp_xhat_plane(:,n_wake) - - end if ! if the point is within radial finite-difference grid - - end if ! if the point is within the endcaps of the wake volume - end do ! np = 0, p%NumPlanes-2 - end if ! nt /= nt2 - end do ! nt2 = 1,p%NumTurbines - if (n_wake > 0) then - ! Normalize xhatBar to unit vector - xhatBar_plane_norm = TwoNorm(xhatBar_plane) - if ( EqualRealNos(xhatBar_plane_norm, 0.0_ReKi) ) then - xhatBar_plane = 0.0_ReKi - else - xhatBar_plane = xhatBar_plane / xhatBar_plane_norm - end if - - ! Compute average contributions - ! - sqrt[ sum (e_x. V)^2 ] e_x ! Axial (sqrt-avg) - ! + sum [(I-e_x.e_x^T). V ] ! Radial (sum) - Vx_wake_tmp = 0.0_ReKi - Vr_wake_tmp = 0.0_ReKi - do nw = 1,n_wake - Vr_term = tmp_Vx_wake(nw)*tmp_xhat_plane(:,nw) + tmp_Vy_wake(nw)*tmp_yhat_plane(:,nw) + tmp_Vz_wake(nw)*tmp_zhat_plane(:,nw) - Vx_term = dot_product( xhatBar_plane, Vr_term ) - Vx_wake_tmp = Vx_wake_tmp + Vx_term*Vx_term - Vr_wake_tmp = Vr_wake_tmp + Vr_term - end do - ! [I - XX']V = V - (V dot X)X - Vr_wake_tmp = Vr_wake_tmp - dot_product(Vr_wake_tmp,xhatBar_plane)*xhatBar_plane - do n_hl=0, n_high_low - y%Vdist_high(nt)%data(:,nx_high,ny_high,nz_high,n_hl) = y%Vdist_high(nt)%data(:,nx_high,ny_high,nz_high,n_hl) + real(Vr_wake_tmp - xhatBar_plane*sqrt(Vx_wake_tmp),SiKi) - end do - end if ! (n_wake > 0) + !$OMP PRIVATE (iXYZ, ix, iy, iz, n_wake, nt2, np,& + !$OMP& wk_R_p2i, wk_V, & + !$OMP& V_qs, & + !$OMP& i_hl, Pos_global,& + !$OMP& wk_WAT_k, WAT_k, WAT_iT, WAT_iY, WAT_iZ, WAT_V)& + !$OMP SHARED(NumGrid_High, m, u, p, y, xd, nt, maxPln, n_high_low, WAT_B_BoxHi, errStat, errMsg) + ! Loop over all points of the high resolution ambient wind + do iXYZ=1, NumGrid_high + ! From flat index iXYZ to grid indices + ix = mod( (iXYZ-1) ,p%nX_high) + iy = mod(int( (iXYZ-1) / (p%nX_high ) ),p%nY_high) + iz = int( (iXYZ-1) / (p%nX_high*p%nY_high) ) + + ! --- Compute variables wk_* (e.g. velocity) from each wakes reaching the current grid point + n_wake = 0 ! cumulative index, increases if point is at intersection of multiple wakes + do nt2 = 1,p%NumTurbines + if (nt /= nt2) then + call interp_planes_2_point(u, p, m, p%Grid_high(:,iXYZ,nt), nt2, maxPln, & ! In + n_wake, wk_R_p2i, wk_V, wk_WAT_k ) ! InOut + end if ! nt /= nt2 + end do ! nt2 = 1,p%NumTurbines + if (n_wake > 0) then + ! --- Compute merged wake velocity V_qs + call mergeWakeVel(n_wake, wk_V, wk_R_p2i, V_qs) + + ! --- Compute average WAT scaling factor and WAT velocity + if (p%WAT_Enabled) then + call mergeWakeWAT_k(n_wake, wk_WAT_k, WAT_k) + ! Position of current grid point + Pos_global(1) = real(ix,ReKi) * p%dX_high(nt) + p%X0_high(nt) + Pos_global(2) = real(iy,ReKi) * p%dY_high(nt) + p%Y0_high(nt) + Pos_global(3) = real(iz,ReKi) * p%dZ_high(nt) + p%Z0_high(nt) + else + WAT_V = 0.0_SiKi + endif + + ! --- Store full velocity (Ambient + Wake QS + WAT) in grid + do i_hl=0, n_high_low + ! Compute WAT velocity + if (p%WAT_Enabled) then + ! find location of grid point in the turbulent box, accounting for the convection of the box in between high res and low res + WAT_iT = modulo( nint( (Pos_global(1) - WAT_B_BoxHi(1, i_hl)) * p%WAT_FlowField%Grid3D%Rate ), p%WAT_FlowField%Grid3D%NSteps ) + 1 ! eq 23 + WAT_iY = modulo( nint( (Pos_global(2) + WAT_B_BoxHi(2, i_hl)) * p%WAT_FlowField%Grid3D%InvDY ), p%WAT_FlowField%Grid3D%NYGrids) + 1 ! eq 24 + WAT_iZ = modulo( nint( (Pos_global(3) + WAT_B_BoxHi(3, i_hl)) * p%WAT_FlowField%Grid3D%InvDZ ), p%WAT_FlowField%Grid3D%NZGrids) + 1 ! eq 25 + WAT_V(1:3) = p%WAT_FlowField%Grid3D%Vel(1:3,WAT_iY,WAT_iZ,WAT_iT) * WAT_k + endif + y%Vdist_high(nt)%data(:,ix,iy,iz,i_hl) = y%Vdist_high(nt)%data(:,ix,iy,iz,i_hl) + V_qs + WAT_V + end do + end if ! (n_wake > 0) end do ! iXYZ=0,NumGrid_high-1 !$OMP END PARALLEL DO end do ! nt = 1,p%NumTurbines - if (allocated(tmp_xhat_plane)) deallocate(tmp_xhat_plane) - if (allocated(tmp_yhat_plane)) deallocate(tmp_yhat_plane) - if (allocated(tmp_zhat_plane)) deallocate(tmp_zhat_plane) - if (allocated(tmp_Vx_wake)) deallocate(tmp_Vx_wake) - if (allocated(tmp_Vy_wake)) deallocate(tmp_Vy_wake) - if (allocated(tmp_Vz_wake)) deallocate(tmp_Vz_wake) + if (allocated(wk_R_p2i)) deallocate(wk_R_p2i) + if (allocated(wk_V)) deallocate(wk_V) + if (allocated(wk_WAT_k)) deallocate(wk_WAT_k) + if (allocated(WAT_B_BoxHi)) deallocate(WAT_B_BoxHi) end subroutine HighResGridCalcOutput + + !---------------------------------------------------------------------------------------------------------------------------------- !> 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 AWAE_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut, errStat, errMsg ) -!.................................................................................................................................. - type(AWAE_InitInputType), intent(in ) :: InitInp !< Input data for initialization routine type(AWAE_InputType), intent( out) :: u !< An initial guess for the input; input mesh must be defined type(AWAE_ParameterType),target,intent( out) :: p !< Parameters @@ -812,8 +792,6 @@ subroutine AWAE_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitO integer(IntKi), intent( out) :: errStat !< Error status of the operation character(*), intent( out) :: errMsg !< Error message if errStat /= ErrID_None - - ! Local variables character(1024) :: rootDir, baseName, OutFileVTKDir ! Simulation root dir, basename for outputs integer(IntKi) :: i,j,nt ! loop counter real(ReKi) :: gridLoc ! Location of requested output slice in grid coordinates [0,sz-1] @@ -822,45 +800,32 @@ subroutine AWAE_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitO character(*), parameter :: RoutineName = 'AWAE_Init' type(InflowWind_InitInputType) :: IfW_InitInp type(InflowWind_InitOutputType), target :: IfW_InitOut - ! Initialize variables for this routine + ! Initialize variables for this routine errStat = ErrID_None errMsg = "" ! Initialize the NWTC Subroutine Library - call NWTC_Init( EchoLibVer=.FALSE. ) ! Display the module information - call DispNVD( AWAE_Ver ) - p%OutFileRoot = TRIM(InitInp%OutFileRoot) - - - ! Validate the initialization inputs - call ValidateInitInputData( InitInp%InputFileData, ErrStat2, ErrMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, errStat, errMsg, RoutineName ) - if (errStat >= AbortErrLev) then - return - end if + call ValidateInitInputData( InitInp%InputFileData, ErrStat2, ErrMsg2 ); if(Failed()) return; - !............................................................................................ - ! Define parameters - !............................................................................................ - - - - ! set the rest of the parameters + ! -------------------------------------------------------------------------------- + ! --- Initialize parameters + ! -------------------------------------------------------------------------------- p%Mod_AmbWind = InitInp%InputFileData%Mod_AmbWind + p%dt_high = InitInp%InputFileData%dt_high + p%dt_low = InitInp%InputFileData%dt_low p%NumPlanes = InitInp%InputFileData%NumPlanes p%NumRadii = InitInp%InputFileData%NumRadii p%NumTurbines = InitInp%InputFileData%NumTurbines p%WindFilePath = InitInp%InputFileData%WindFilePath ! TODO: Make sure this wasn't specified with the trailing folder separator. Note: on Windows a trailing / or \ causes no problem! GJH p%n_high_low = InitInp%n_high_low - p%dt_low = InitInp%InputFileData%dt_low p%NumDT = InitInp%NumDT p%NOutDisWindXY = InitInp%InputFileData%NOutDisWindXY p%NOutDisWindYZ = InitInp%InputFileData%NOutDisWindYZ @@ -871,8 +836,10 @@ subroutine AWAE_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitO p%C_Meander = InitInp%InputFileData%C_Meander p%Mod_Projection = InitInp%InputFileData%Mod_Projection ! Wake Added Turbulence (WAT) Parameters - !p%WAT = InitInp%InputFileData%WAT - !p%WAT_Basename = InitInp%InputFileData%WAT_Basename + p%WAT_Enabled = InitInp%WAT_Enabled + if (p%WAT_Enabled) then + if (associated(InitInp%WAT_FlowField)) p%WAT_FlowField => InitInp%WAT_FlowField + endif select case ( p%Mod_Meander ) case (MeanderMod_Uniform) @@ -883,24 +850,9 @@ subroutine AWAE_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitO p%C_ScaleDiam = 0.5_ReKi*p%C_Meander*2.23313_ReKi end select - - call allocAry( p%OutDisWindZ, p%NOutDisWindXY, "OutDisWindZ", ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if ( ErrStat >= AbortErrLev ) then - RETURN - end if - - call allocAry( p%OutDisWindX, p%NOutDisWindYZ, "OutDisWindX", ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if ( ErrStat >= AbortErrLev ) then - RETURN - end if - - call allocAry( p%OutDisWindY, p%NOutDisWindXZ, "OutDisWindY", ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if ( ErrStat >= AbortErrLev ) then - RETURN - end if + call allocAry( p%OutDisWindZ, p%NOutDisWindXY, "OutDisWindZ", ErrStat2, ErrMsg2 ); if(Failed()) return; + call allocAry( p%OutDisWindX, p%NOutDisWindYZ, "OutDisWindX", ErrStat2, ErrMsg2 ); if(Failed()) return; + call allocAry( p%OutDisWindY, p%NOutDisWindXZ, "OutDisWindY", ErrStat2, ErrMsg2 ); if(Failed()) return; p%OutDisWindZ = InitInp%InputFileData%OutDisWindZ p%OutDisWindX = InitInp%InputFileData%OutDisWindX @@ -915,10 +867,9 @@ subroutine AWAE_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitO call MKDIR(OutFileVTKDir) ! creating output directory end if - ! Plane grids - allocate( p%y(-p%Numradii+1:p%NumRadii-1), stat=errStat2); if (errStat2 /= 0) call SetErrStat ( ErrID_Fatal, 'Could not allocate memory for p%y.', errStat, errMsg, RoutineName ) - allocate( p%z(-p%Numradii+1:p%NumRadii-1), stat=errStat2); if (errStat2 /= 0) call SetErrStat ( ErrID_Fatal, 'Could not allocate memory for p%z.', errStat, errMsg, RoutineName ) + allocate( p%y(-p%Numradii+1:p%NumRadii-1), stat=errStat2); if (Failed0('Could not allocate memory for p%y.')) return; + allocate( p%z(-p%Numradii+1:p%NumRadii-1), stat=errStat2); if (Failed0('Could not allocate memory for p%z.')) return; if ( ErrStat >= AbortErrLev ) then return end if @@ -927,141 +878,80 @@ subroutine AWAE_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitO p%z(i) = InitInp%InputFileData%dr*i end do - allocate( p%WT_Position(3,p%NumTurbines),stat=errStat2) - if (errStat2 /= 0) then - call SetErrStat ( ErrID_Fatal, 'Could not allocate memory for p%WT_Position.', errStat, errMsg, RoutineName ) - return - end if + allocate( p%WT_Position(3,p%NumTurbines),stat=errStat2); if (Failed0('Could not allocate memory for p%WT_Position.')) return; p%WT_Position = InitInp%InputFileData%WT_Position + + ! Obtain the precursor grid information by parsing the necessary input files ! This will establish certain parameters as well as all of the initialization outputs ! Sets: ! Parameters: nX_low, nY_low, nZ_low, nX_high, nY_high, nZ_high, Grid_low, ! Grid_high, n_high_low, n_rp_max ! InitOutput: X0_high, Y0_high, Z0_high, dX_high, dY_high, dZ_high, nX_high, nY_high, nZ_high + call AWAE_IO_InitGridInfo(InitInp, p, InitOut, errStat2, errMsg2); if(Failed()) return; - - call AWAE_IO_InitGridInfo(InitInp, p, InitOut, errStat2, errMsg2) - call SetErrStat ( errStat2, errMsg2, errStat, errMsg, RoutineName ) - if (errStat2 >= AbortErrLev) then - return - end if - + ! -------------------------------------------------------------------------------- + ! --- Initialize states + ! -------------------------------------------------------------------------------- + ! initialize tracer for WAT box location + xd%WAT_B_Box(1:3) = 0.0_ReKi if ( p%Mod_AmbWind > 1 ) then ! Using InflowWind, so initialize that module now IfW_InitInp%Linearize = .false. IfW_InitInp%RootName = TRIM(p%OutFileRoot)//'.IfW' - IfW_InitInp%UseInputFile = .TRUE. + IfW_InitInp%FilePassingMethod = 0_IntKi ! Read IfW input file from disk IfW_InitInp%InputFileName = InitInp%InputFileData%InflowFile IfW_InitInp%lidar%Tmax = 0.0_ReKi IfW_InitInp%lidar%HubPosition = 0.0_ReKi IfW_InitInp%lidar%SensorType = SensorType_None IfW_InitInp%Use4Dext = .false. - IfW_InitInp%MHK = 0 !FIXME: after merge to dev, change this test to use MHK_None + IfW_InitInp%MHK = MHK_None IfW_InitInp%WtrDpth = 0.0_ReKi IfW_InitInp%MSL2SWL = 0.0_ReKi if ( p%Mod_AmbWind == 2 ) then ! one InflowWind module - ALLOCATE(p%IfW(0:0),STAT=ErrStat2) - if (ErrStat2 /= 0) then - CALL SetErrStat( ErrID_Fatal, 'Could not allocate memory for InflowWind parameter data', ErrStat, ErrMsg, RoutineName ) - return - end if - ALLOCATE(x%IfW(0:0),STAT=ErrStat2) - if (ErrStat2 /= 0) then - CALL SetErrStat( ErrID_Fatal, 'Could not allocate memory for InflowWind continuous states data', ErrStat, ErrMsg, RoutineName ) - return - end if - ALLOCATE(xd%IfW(0:0),STAT=ErrStat2) - if (ErrStat2 /= 0) then - CALL SetErrStat( ErrID_Fatal, 'Could not allocate memory for InflowWind discrete states data', ErrStat, ErrMsg, RoutineName ) - return - end if - ALLOCATE(z%IfW(0:0),STAT=ErrStat2) - if (ErrStat2 /= 0) then - CALL SetErrStat( ErrID_Fatal, 'Could not allocate memory for InflowWind constraint states data', ErrStat, ErrMsg, RoutineName ) - return - end if - ALLOCATE(OtherState%IfW(0:0),STAT=ErrStat2) - if (ErrStat2 /= 0) then - CALL SetErrStat( ErrID_Fatal, 'Could not allocate memory for InflowWind other states data', ErrStat, ErrMsg, RoutineName ) - return - end if - ALLOCATE(m%IfW(0:0),STAT=ErrStat2) - if (ErrStat2 /= 0) then - CALL SetErrStat( ErrID_Fatal, 'Could not allocate memory for InflowWind miscvar data', ErrStat, ErrMsg, RoutineName ) - return - end if + ALLOCATE(p%IfW( 0:0),STAT=ErrStat2); if (Failed0('InflowWind parameter data' )) return; + ALLOCATE(x%IfW( 0:0),STAT=ErrStat2); if (Failed0('InflowWind continuous states data')) return; + ALLOCATE(xd%IfW( 0:0),STAT=ErrStat2); if (Failed0('InflowWind discrete states data' )) return; + ALLOCATE(z%IfW( 0:0),STAT=ErrStat2); if (Failed0('InflowWind constraint states data')) return; + ALLOCATE(OtherState%IfW(0:0),STAT=ErrStat2); if (Failed0('InflowWind other states data' )) return; + ALLOCATE(m%IfW( 0:0),STAT=ErrStat2); if (Failed0('InflowWind miscvar data' )) return; ! Initialize InflowWind IfW_InitInp%FixedWindFileRootName = .false. IfW_InitInp%NumWindPoints = p%NumGrid_low IfW_InitInp%RadAvg = 0.25 * p%nZ_low * p%dX_low ! arbitrary garbage, just must be bigger than zero, but not bigger than grid (IfW will complain if this isn't set when it tries to calculate disk average vel) + IfW_InitInp%MHK = 0 ! not an MHK turbine setup - call InflowWind_Init( IfW_InitInp, m%u_IfW_Low, p%IfW(0), x%IfW(0), xd%IfW(0), z%IfW(0), OtherState%IfW(0), m%y_IfW_Low, m%IfW(0), Interval, IfW_InitOut, ErrStat2, ErrMsg2 ) - call SetErrStat ( errStat2, errMsg2, errStat, errMsg, RoutineName ) - if (errStat2 >= AbortErrLev) then - return - end if + call InflowWind_Init( IfW_InitInp, m%u_IfW_Low, p%IfW(0), x%IfW(0), xd%IfW(0), z%IfW(0), OtherState%IfW(0), m%y_IfW_Low, m%IfW(0), Interval, IfW_InitOut, ErrStat2, ErrMsg2 ); if(Failed()) return; + p%IfW(0)%NumOuts = 0 ! override outputs that might be in the input file else if ( p%Mod_AmbWind == 3 ) then ! multiple InflowWind modules - ALLOCATE(p%IfW(0:p%NumTurbines),STAT=ErrStat2) - if (ErrStat2 /= 0) then - CALL SetErrStat( ErrID_Fatal, 'Could not allocate memory for InflowWind parameter data', ErrStat, ErrMsg, RoutineName ) - return - end if - ALLOCATE(x%IfW(0:p%NumTurbines),STAT=ErrStat2) - if (ErrStat2 /= 0) then - CALL SetErrStat( ErrID_Fatal, 'Could not allocate memory for InflowWind continuous states data', ErrStat, ErrMsg, RoutineName ) - return - end if - ALLOCATE(xd%IfW(0:p%NumTurbines),STAT=ErrStat2) - if (ErrStat2 /= 0) then - CALL SetErrStat( ErrID_Fatal, 'Could not allocate memory for InflowWind discrete states data', ErrStat, ErrMsg, RoutineName ) - return - end if - ALLOCATE(z%IfW(0:p%NumTurbines),STAT=ErrStat2) - if (ErrStat2 /= 0) then - CALL SetErrStat( ErrID_Fatal, 'Could not allocate memory for InflowWind constraint states data', ErrStat, ErrMsg, RoutineName ) - return - end if - ALLOCATE(OtherState%IfW(0:p%NumTurbines),STAT=ErrStat2) - if (ErrStat2 /= 0) then - CALL SetErrStat( ErrID_Fatal, 'Could not allocate memory for InflowWind other states data', ErrStat, ErrMsg, RoutineName ) - return - end if - ALLOCATE(m%IfW(0:p%NumTurbines),STAT=ErrStat2) - if (ErrStat2 /= 0) then - CALL SetErrStat( ErrID_Fatal, 'Could not allocate memory for InflowWind miscvar data', ErrStat, ErrMsg, RoutineName ) - return - end if + ALLOCATE(p%IfW( 0:p%NumTurbines),STAT=ErrStat2); if (Failed0('InflowWind parameter data' )) return; + ALLOCATE(x%IfW( 0:p%NumTurbines),STAT=ErrStat2); if (Failed0('InflowWind continuous states data')) return; + ALLOCATE(xd%IfW( 0:p%NumTurbines),STAT=ErrStat2); if (Failed0('InflowWind discrete states data' )) return; + ALLOCATE(z%IfW( 0:p%NumTurbines),STAT=ErrStat2); if (Failed0('InflowWind constraint states data')) return; + ALLOCATE(OtherState%IfW(0:p%NumTurbines),STAT=ErrStat2); if (Failed0('InflowWind other states data' )) return; + ALLOCATE(m%IfW( 0:p%NumTurbines),STAT=ErrStat2); if (Failed0('InflowWind miscvar data' )) return; ! Initialize InflowWind for the low-resolution domain IfW_InitInp%FixedWindFileRootName = .true. IfW_InitInp%NumWindPoints = p%NumGrid_low IfW_InitInp%TurbineID = 0 + IfW_InitInp%MHK = MHK_None - call InflowWind_Init( IfW_InitInp, m%u_IfW_Low, p%IfW(0), x%IfW(0), xd%IfW(0), z%IfW(0), OtherState%IfW(0), m%y_IfW_Low, m%IfW(0), Interval, IfW_InitOut, ErrStat2, ErrMsg2 ) - call SetErrStat ( errStat2, errMsg2, errStat, errMsg, RoutineName ) - if (errStat2 >= AbortErrLev) then - return - end if + call InflowWind_Init( IfW_InitInp, m%u_IfW_Low, p%IfW(0), x%IfW(0), xd%IfW(0), z%IfW(0), OtherState%IfW(0), m%y_IfW_Low, m%IfW(0), Interval, IfW_InitOut, ErrStat2, ErrMsg2 ); if(Failed()) return; + p%IfW(0)%NumOuts = 0 ! override outputs that might be in the input file ! Initialize InflowWind for each high-resolution domain IfW_InitInp%NumWindPoints = p%nX_high*p%nY_high*p%nZ_high - do nt = 1,p%NumTurbines - IfW_InitInp%TurbineID = nt - call WrScr(NewLine//'Initializing high-resolution grid for Turbine '//trim(Num2Lstr(nt))) - call InflowWind_Init( IfW_InitInp, m%u_IfW_High, p%IfW(nt), x%IfW(nt), xd%IfW(nt), z%IfW(nt), OtherState%IfW(nt), m%y_IfW_High, m%IfW(nt), Interval, IfW_InitOut, ErrStat2, ErrMsg2 ) - call SetErrStat ( errStat2, errMsg2, errStat, errMsg, RoutineName ) - if (errStat >= AbortErrLev) then - return - end if + call InflowWind_Init( IfW_InitInp, m%u_IfW_High, p%IfW(nt), x%IfW(nt), xd%IfW(nt), z%IfW(nt), OtherState%IfW(nt), m%y_IfW_High, m%IfW(nt), Interval, IfW_InitOut, ErrStat2, ErrMsg2 ); if(Failed()) return; + p%IfW(nt)%NumOuts = 0 ! override outputs that might be in the input file ! Check that the high resolution grid placement is correct ! The InflowWind grid location is exactly centered on the TurbPos location in the Y direction. The high resolution grid @@ -1082,33 +972,24 @@ subroutine AWAE_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitO ! Initialize the high-resolution grid inputs and outputs IF ( .NOT. ALLOCATED( m%u_IfW_High%PositionXYZ ) ) THEN - call AllocAry(m%u_IfW_High%PositionXYZ, 3, p%nX_high*p%nY_high*p%nZ_high, 'm%u_IfW_High%PositionXYZ', ErrStat2, ErrMsg2) - call SetErrStat ( errStat2, errMsg2, errStat, errMsg, RoutineName ) - call AllocAry(m%y_IfW_High%VelocityUVW, 3, p%nX_high*p%nY_high*p%nZ_high, 'm%y_IfW_High%VelocityUVW', ErrStat2, ErrMsg2) - call SetErrStat ( errStat2, errMsg2, errStat, errMsg, RoutineName ) - call AllocAry(m%y_IfW_High%WriteOutput, size(m%y_IfW_Low%WriteOutput), 'm%y_IfW_High%WriteOutput', ErrStat2, ErrMsg2) - call SetErrStat ( errStat2, errMsg2, errStat, errMsg, RoutineName ) + call AllocAry(m%u_IfW_High%PositionXYZ, 3, p%nX_high*p%nY_high*p%nZ_high, 'm%u_IfW_High%PositionXYZ', ErrStat2, ErrMsg2); if(Failed()) return; + call AllocAry(m%y_IfW_High%VelocityUVW, 3, p%nX_high*p%nY_high*p%nZ_high, 'm%y_IfW_High%VelocityUVW', ErrStat2, ErrMsg2); if(Failed()) return; + call AllocAry(m%y_IfW_High%WriteOutput, size(m%y_IfW_Low%WriteOutput), 'm%y_IfW_High%WriteOutput', ErrStat2, ErrMsg2); if(Failed()) return; if (allocated(m%y_IfW_Low%lidar%LidSpeed)) then - call AllocAry(m%y_IfW_High%lidar%LidSpeed, size(m%y_IfW_Low%lidar%LidSpeed ), 'm%y_IfW_High%lidar%LidSpeed', ErrStat2, ErrMsg2) - call SetErrStat ( errStat2, errMsg2, errStat, errMsg, RoutineName ) + call AllocAry(m%y_IfW_High%lidar%LidSpeed, size(m%y_IfW_Low%lidar%LidSpeed ), 'm%y_IfW_High%lidar%LidSpeed', ErrStat2, ErrMsg2); if(Failed()) return; endif if (allocated(m%y_IfW_High%lidar%MsrPositionsX)) then - call AllocAry(m%y_IfW_High%lidar%MsrPositionsX, size(m%y_IfW_High%lidar%MsrPositionsX), 'm%y_IfW_High%lidar%MsrPositionsX', ErrStat2, ErrMsg2) - call SetErrStat ( errStat2, errMsg2, errStat, errMsg, RoutineName ) + call AllocAry(m%y_IfW_High%lidar%MsrPositionsX, size(m%y_IfW_High%lidar%MsrPositionsX), 'm%y_IfW_High%lidar%MsrPositionsX', ErrStat2, ErrMsg2); if(Failed()) return; endif if (allocated(m%y_IfW_High%lidar%MsrPositionsY)) then - call AllocAry(m%y_IfW_High%lidar%MsrPositionsY, size(m%y_IfW_High%lidar%MsrPositionsY), 'm%y_IfW_High%lidar%MsrPositionsY', ErrStat2, ErrMsg2) - call SetErrStat ( errStat2, errMsg2, errStat, errMsg, RoutineName ) + call AllocAry(m%y_IfW_High%lidar%MsrPositionsY, size(m%y_IfW_High%lidar%MsrPositionsY), 'm%y_IfW_High%lidar%MsrPositionsY', ErrStat2, ErrMsg2); if(Failed()) return; endif if (allocated(m%y_IfW_High%lidar%MsrPositionsZ)) then - call AllocAry(m%y_IfW_High%lidar%MsrPositionsZ, size(m%y_IfW_High%lidar%MsrPositionsZ), 'm%y_IfW_High%lidar%MsrPositionsZ', ErrStat2, ErrMsg2) - call SetErrStat ( errStat2, errMsg2, errStat, errMsg, RoutineName ) + call AllocAry(m%y_IfW_High%lidar%MsrPositionsZ, size(m%y_IfW_High%lidar%MsrPositionsZ), 'm%y_IfW_High%lidar%MsrPositionsZ', ErrStat2, ErrMsg2); if(Failed()) return; endif - - END IF - if (errStat2 >= AbortErrLev) then + if (ErrStat >= AbortErrLev) then return end if @@ -1116,157 +997,114 @@ subroutine AWAE_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitO InitOut%Ver = AWAE_Ver - ! Test the request output wind locations against grid information - - ! XY plane slices - do i = 1,p%NOutDisWindXY - gridLoc = (p%OutDisWindZ(i) - p%Z0_low) / p%dZ_low - if ( ( gridLoc < 0.0_ReKi ) .or. ( gridLoc > real(p%nZ_low-1, ReKi) ) ) then - call SetErrStat(ErrID_Fatal, "The requested low-resolution XY output slice location, Z="//TRIM(Num2LStr(p%OutDisWindZ(i)))//", is outside of the low-resolution grid.", errStat, errMsg, RoutineName ) - end if - end do - - ! XZ plane slices - do i = 1,p%NOutDisWindXZ - gridLoc = (p%OutDisWindY(i) - p%Y0_low) / p%dY_low - if ( ( gridLoc < 0.0_ReKi ) .or. ( gridLoc > real(p%nY_low-1, ReKi) ) ) then - call SetErrStat(ErrID_Fatal, "The requested low-resolution XZ output slice location, Y="//TRIM(Num2LStr(p%OutDisWindY(i)))//", is outside of the low-resolution grid.", errStat, errMsg, RoutineName ) - end if - end do - - ! XZ plane slices - do i = 1,p%NOutDisWindYZ - gridLoc = (p%OutDisWindX(i) - p%X0_low) / p%dX_low - if ( ( gridLoc < 0.0_ReKi ) .or. ( gridLoc > real(p%nX_low-1, ReKi) ) ) then - call SetErrStat(ErrID_Fatal, "The requested low-resolution YZ output slice location, X="//TRIM(Num2LStr(p%OutDisWindX(i)))//", is outside of the low-resolution grid.", errStat, errMsg, RoutineName ) - end if - end do - if (errStat >= AbortErrLev) return + ! Test the request output wind locations against grid information + ! XY plane slices + do i = 1,p%NOutDisWindXY + gridLoc = (p%OutDisWindZ(i) - p%Z0_low) / p%dZ_low + if ( ( gridLoc < 0.0_ReKi ) .or. ( gridLoc > real(p%nZ_low-1, ReKi) ) ) then + call SetErrStat(ErrID_Fatal, "The requested low-resolution XY output slice location, Z="//TRIM(Num2LStr(p%OutDisWindZ(i)))//", is outside of the low-resolution grid.", errStat, errMsg, RoutineName ) + end if + end do + ! XZ plane slices + do i = 1,p%NOutDisWindXZ + gridLoc = (p%OutDisWindY(i) - p%Y0_low) / p%dY_low + if ( ( gridLoc < 0.0_ReKi ) .or. ( gridLoc > real(p%nY_low-1, ReKi) ) ) then + call SetErrStat(ErrID_Fatal, "The requested low-resolution XZ output slice location, Y="//TRIM(Num2LStr(p%OutDisWindY(i)))//", is outside of the low-resolution grid.", errStat, errMsg, RoutineName ) + end if + end do - !interval = InitOut%dt_low + ! XZ plane slices + do i = 1,p%NOutDisWindYZ + gridLoc = (p%OutDisWindX(i) - p%X0_low) / p%dX_low + if ( ( gridLoc < 0.0_ReKi ) .or. ( gridLoc > real(p%nX_low-1, ReKi) ) ) then + call SetErrStat(ErrID_Fatal, "The requested low-resolution YZ output slice location, X="//TRIM(Num2LStr(p%OutDisWindX(i)))//", is outside of the low-resolution grid.", errStat, errMsg, RoutineName ) + end if + end do + if (errStat >= AbortErrLev) return - !............................................................................................ - ! Define and initialize inputs here - !............................................................................................ - allocate ( u%xhat_plane(3,0:p%NumPlanes-1,1:p%NumTurbines) , STAT=ErrStat2 ); if (errStat2 /= 0) call SetErrStat ( ErrID_Fatal, 'Could not allocate memory for u%xhat_plane.', errStat, errMsg, RoutineName ) - allocate ( u%p_plane (3,0:p%NumPlanes-1,1:p%NumTurbines) , STAT=ErrStat2 ); if (errStat2 /= 0) call SetErrStat ( ErrID_Fatal, 'Could not allocate memory for u%p_plane.', errStat, errMsg, RoutineName ) - allocate ( u%Vx_wake (-p%NumRadii+1:p%NumRadii-1, -p%NumRadii+1:p%NumRadii-1, 0:p%NumPlanes-1,1:p%NumTurbines), STAT=ErrStat2 ); if (errStat2 /= 0) call SetErrStat ( ErrID_Fatal, 'Could not allocate memory for u%Vx_wake.', errStat, errMsg, RoutineName ) - allocate ( u%Vy_wake (-p%NumRadii+1:p%NumRadii-1, -p%NumRadii+1:p%NumRadii-1, 0:p%NumPlanes-1,1:p%NumTurbines), STAT=ErrStat2 ); if (errStat2 /= 0) call SetErrStat ( ErrID_Fatal, 'Could not allocate memory for u%Vy_wake.', errStat, errMsg, RoutineName ) - allocate ( u%Vz_wake (-p%NumRadii+1:p%NumRadii-1, -p%NumRadii+1:p%NumRadii-1, 0:p%NumPlanes-1,1:p%NumTurbines), STAT=ErrStat2 ); if (errStat2 /= 0) call SetErrStat ( ErrID_Fatal, 'Could not allocate memory for u%Vz_wake.', errStat, errMsg, RoutineName ) - allocate ( u%D_wake (0:p%NumPlanes-1,1:p%NumTurbines), STAT=ErrStat2 ); if (errStat2 /= 0) call SetErrStat ( ErrID_Fatal, 'Could not allocate memory for u%D_wake.', errStat, errMsg, RoutineName ) - allocate ( u%WAT_k_mt (0:p%NumRadii-1, 0:p%NumPlanes-1, 1:p%NumTurbines), STAT=ErrStat2 ); if (errStat2 /= 0) call SetErrStat ( ErrID_Fatal, 'Could not allocate memory for u%k_mt.', errStat, errMsg, RoutineName ) - if (errStat >= AbortErrLev) return + ! -------------------------------------------------------------------------------- + ! --- Initialize inputs + ! -------------------------------------------------------------------------------- + allocate ( u%xhat_plane( 3, 0:p%NumPlanes-1,1:p%NumTurbines), STAT=ErrStat2 ); if (Failed0('u%xhat_plane.')) return; + allocate ( u%p_plane ( 3, 0:p%NumPlanes-1,1:p%NumTurbines), STAT=ErrStat2 ); if (Failed0('u%p_plane.' )) return; + allocate ( u%Vx_wake (-p%NumRadii+1:p%NumRadii-1, -p%NumRadii+1:p%NumRadii-1, 0:p%NumPlanes-1,1:p%NumTurbines), STAT=ErrStat2 ); if (Failed0('u%Vx_wake.' )) return; + allocate ( u%Vy_wake (-p%NumRadii+1:p%NumRadii-1, -p%NumRadii+1:p%NumRadii-1, 0:p%NumPlanes-1,1:p%NumTurbines), STAT=ErrStat2 ); if (Failed0('u%Vy_wake.' )) return; + allocate ( u%Vz_wake (-p%NumRadii+1:p%NumRadii-1, -p%NumRadii+1:p%NumRadii-1, 0:p%NumPlanes-1,1:p%NumTurbines), STAT=ErrStat2 ); if (Failed0('u%Vz_wake.' )) return; + allocate ( u%D_wake ( 0:p%NumPlanes-1,1:p%NumTurbines), STAT=ErrStat2 ); if (Failed0('u%D_wake.' )) return; + allocate ( u%WAT_k (-p%NumRadii+1:p%NumRadii-1, -p%NumRadii+1:p%NumRadii-1, 0:p%NumPlanes-1,1:p%NumTurbines), STAT=ErrStat2 ); if (Failed0('u%WAT_k.' )) return; u%Vx_wake=0.0_ReKi u%Vy_wake=0.0_ReKi u%Vz_wake=0.0_ReKi + !---------------- + ! initialize outputs + allocate ( y%V_plane(3,0:p%NumPlanes-1,1:p%NumTurbines), STAT=ErrStat2 ); if (Failed0('y%V_plane.' )) return; + allocate ( y%Vdist_High(1:p%NumTurbines), STAT=ErrStat2 ); if (Failed0('y%Vdist_High.')) return; + do i = 1, p%NumTurbines + allocate ( y%Vdist_High(i)%data(3,0:p%nX_high-1,0:p%nY_high-1,0:p%nZ_high-1,0:p%n_high_low), STAT=ErrStat2 ); if (Failed0('y%Vdist_High%data.')) return; + y%Vdist_High(i)%data = 0.0_Siki + end do + allocate ( y%Vx_wind_disk (1:p%NumTurbines), STAT=ErrStat2 ); if (Failed0('y%Vx_rel_disk.')) return; + allocate ( y%TI_amb (1:p%NumTurbines), STAT=ErrStat2 ); if (Failed0('y%TI_amb.')) return; - !............................................................................................ - ! Define outputs here - !............................................................................................ - - allocate ( y%V_plane(3,0:p%NumPlanes-1,1:p%NumTurbines), STAT=ErrStat2 ) - if (errStat2 /= 0) call SetErrStat ( ErrID_Fatal, 'Could not allocate memory for y%V_plane.', errStat, errMsg, RoutineName ) - allocate ( y%Vdist_High(1:p%NumTurbines), STAT=ErrStat2 ) + ! Set pointers to high resolution wind in InitOutput + allocate(InitOut%Vdist_High(1:p%NumTurbines), STAT=ErrStat2 ) if (errStat2 /= 0) call SetErrStat ( ErrID_Fatal, 'Could not allocate memory for y%Vdist_High.', errStat, errMsg, RoutineName ) do i = 1, p%NumTurbines - allocate ( y%Vdist_High(i)%data(3,0:p%nX_high-1,0:p%nY_high-1,0:p%nZ_high-1,0:p%n_high_low), STAT=ErrStat2 ) - if (errStat2 /= 0) call SetErrStat ( ErrID_Fatal, 'Could not allocate memory for y%Vdist_High%data.', errStat, errMsg, RoutineName ) - y%Vdist_High(i)%data = 0.0_Siki + InitOut%Vdist_High(i)%data => y%Vdist_High(i)%data end do - allocate ( y%Vx_wind_disk (1:p%NumTurbines), STAT=ErrStat2 ) - if (errStat2 /= 0) call SetErrStat ( ErrID_Fatal, 'Could not allocate memory for y%Vx_rel_disk.', errStat, errMsg, RoutineName ) - allocate ( y%TI_amb (1:p%NumTurbines), STAT=ErrStat2 ) - if (errStat2 /= 0) call SetErrStat ( ErrID_Fatal, 'Could not allocate memory for y%TI_amb.', errStat, errMsg, RoutineName ) - if (errStat >= AbortErrLev) return - ! This next step is not strictly necessary y%V_plane = 0.0_Reki y%Vx_wind_disk = 0.0_Reki y%TI_amb = 0.0_Reki - + ! -------------------------------------------------------------------------------- + ! --- Initialize misc + ! -------------------------------------------------------------------------------- + ! Initialize 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. if ( p%NOutDisWindXY > 0 ) then - ALLOCATE ( m%OutVizXYPlane(3,p%nX_low, p%nY_low,1) , STAT=ErrStat2 ) - IF ( ErrStat2 /= 0 ) THEN - ErrStat = ErrID_Fatal - ErrMsg = ' Error allocating memory for the Fast.Farm OutVizXYPlane arrays.' - RETURN - ENDIF + ALLOCATE ( m%OutVizXYPlane(3,p%nX_low, p%nY_low,1) , STAT=ErrStat2 ); if (Failed0('the Fast.Farm OutVizXYPlane arrays.')) return; end if if ( p%NOutDisWindYZ > 0 ) then - ALLOCATE ( m%OutVizYZPlane(3,p%nY_low, p%nZ_low,1) , STAT=ErrStat2 ) - IF ( ErrStat2 /= 0 ) THEN - ErrStat = ErrID_Fatal - ErrMsg = ' Error allocating memory for the Fast.Farm OutVizYZPlane arrays.' - RETURN - ENDIF + ALLOCATE ( m%OutVizYZPlane(3,p%nY_low, p%nZ_low,1) , STAT=ErrStat2 ); if (Failed0('the Fast.Farm OutVizYZPlane arrays.')) return; end if if ( p%NOutDisWindXZ > 0 ) then - ALLOCATE ( m%OutVizXZPlane(3,p%nX_low, p%nZ_low,1) , STAT=ErrStat2 ) - IF ( ErrStat2 /= 0 ) THEN - ErrStat = ErrID_Fatal - ErrMsg = ' Error allocating memory for the Fast.Farm OutVizXZPlane arrays.' - RETURN - ENDIF + ALLOCATE ( m%OutVizXZPlane(3,p%nX_low, p%nZ_low,1) , STAT=ErrStat2 ); if (Failed0('the Fast.Farm OutVizXZPlane arrays.')) return; end if - !............................................................................................ - ! Initialize 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. - !............................................................................................ - - - - ! miscvars to avoid the allocation per timestep + ! miscvars to avoid the allocation per timestep + allocate ( m%Vamb_low( 3, 0:p%nX_low-1 , 0:p%nY_low-1 , 0:p%nZ_low-1 ), STAT=errStat2 ); if (Failed0('m%Vamb_low.' )) return; + allocate ( m%Vamb_lowpol( 3, 0:p%n_rp_max*8 ), STAT=errStat2 ); if (Failed0('m%Vamb_lowpol.' )) return; + allocate ( m%Vdist_low( 3, 0:p%nX_low-1 , 0:p%nY_low-1 , 0:p%nZ_low-1 ), STAT=errStat2 ); if (Failed0('m%Vdist_low.' )) return; + allocate ( m%Vdist_low_full( 3, 0:p%nX_low-1 , 0:p%nY_low-1 , 0:p%nZ_low-1 ), STAT=errStat2 ); if (Failed0('m%Vdist_low_full')) return; - allocate ( m%Vamb_low ( 3, 0:p%nX_low-1 , 0:p%nY_low-1 , 0:p%nZ_low-1 ) , STAT=errStat2 ) - if (errStat2 /= 0) call SetErrStat ( ErrID_Fatal, 'Could not allocate memory for m%Vamb_low.', errStat, errMsg, RoutineName ) - allocate ( m%Vamb_lowpol ( 3, 0:p%n_rp_max*8 ) , STAT=errStat2 ) - if (errStat2 /= 0) call SetErrStat ( ErrID_Fatal, 'Could not allocate memory for m%Vamb_lowpol.', errStat, errMsg, RoutineName ) - allocate ( m%Vdist_low ( 3, 0:p%nX_low-1 , 0:p%nY_low-1 , 0:p%nZ_low-1 ) , STAT=errStat2 ) - if (errStat2 /= 0) call SetErrStat ( ErrID_Fatal, 'Could not allocate memory for m%Vdist_low.', errStat, errMsg, RoutineName ) - allocate ( m%Vdist_low_full ( 3, 0:p%nX_low-1 , 0:p%nY_low-1 , 0:p%nZ_low-1 ) , STAT=errStat2 ) - if (errStat2 /= 0) call SetErrStat ( ErrID_Fatal, 'Could not allocate memory for m%Vdist_low_full', errStat, errMsg, RoutineName ) - - allocate ( m%Vamb_high(1:p%NumTurbines), STAT=ErrStat2 ) - if (errStat2 /= 0) call SetErrStat ( ErrID_Fatal, 'Could not allocate memory for m%Vamb_high.', errStat, errMsg, RoutineName ) + allocate ( m%Vamb_high(1:p%NumTurbines), STAT=ErrStat2 ); if (Failed0('Could not allocate memory for m%Vamb_high.')) return; do i = 1, p%NumTurbines - allocate ( m%Vamb_high(i)%data(3,0:p%nX_high-1,0:p%nY_high-1,0:p%nZ_high-1,0:p%n_high_low), STAT=ErrStat2 ) - if (errStat2 /= 0) call SetErrStat ( ErrID_Fatal, 'Could not allocate memory for m%Vamb_high%data.', errStat, errMsg, RoutineName ) + allocate ( m%Vamb_high(i)%data(3,0:p%nX_high-1,0:p%nY_high-1,0:p%nZ_high-1,0:p%n_high_low), STAT=ErrStat2 ); if (Failed0('m%Vamb_high%data.')) return; end do - allocate ( m%parallelFlag( 0:p%NumPlanes-2,1:p%NumTurbines ), STAT=errStat2 ) - if (errStat2 /= 0) call SetErrStat ( ErrID_Fatal, 'Could not allocate memory for m%parallelFlag.', errStat, errMsg, RoutineName ) - allocate ( m%r_s( 0:p%NumPlanes-2,1:p%NumTurbines ), STAT=errStat2 ) - if (errStat2 /= 0) call SetErrStat ( ErrID_Fatal, 'Could not allocate memory for m%r_s.', errStat, errMsg, RoutineName ) - allocate ( m%r_e( 0:p%NumPlanes-2,1:p%NumTurbines ), STAT=errStat2 ) - if (errStat2 /= 0) call SetErrStat ( ErrID_Fatal, 'Could not allocate memory for m%r_e.', errStat, errMsg, RoutineName ) - allocate ( m%rhat_s( 3,0:p%NumPlanes-2,1:p%NumTurbines ), STAT=errStat2 ) - if (errStat2 /= 0) call SetErrStat ( ErrID_Fatal, 'Could not allocate memory for m%rhat_s.', errStat, errMsg, RoutineName ) - allocate ( m%rhat_e( 3,0:p%NumPlanes-2,1:p%NumTurbines ), STAT=errStat2 ) - if (errStat2 /= 0) call SetErrStat ( ErrID_Fatal, 'Could not allocate memory for m%rhat_e.', errStat, errMsg, RoutineName ) - allocate ( m%pvec_cs( 3,0:p%NumPlanes-2,1:p%NumTurbines ), STAT=errStat2 ) - if (errStat2 /= 0) call SetErrStat ( ErrID_Fatal, 'Could not allocate memory for m%pvec_cs.', errStat, errMsg, RoutineName ) - allocate ( m%pvec_ce( 3,0:p%NumPlanes-2,1:p%NumTurbines ), STAT=errStat2 ) - if (errStat2 /= 0) call SetErrStat ( ErrID_Fatal, 'Could not allocate memory for m%pvec_ce.', errStat, errMsg, RoutineName ) - if (errStat >= AbortErrLev) return - + allocate ( m%parallelFlag( 0:p%NumPlanes-2,1:p%NumTurbines ), STAT=errStat2 ); if (Failed0('m%parallelFlag.')) return; + allocate ( m%r_s( 0:p%NumPlanes-2,1:p%NumTurbines ), STAT=errStat2 ); if (Failed0('m%r_s.' )) return; + allocate ( m%r_e( 0:p%NumPlanes-2,1:p%NumTurbines ), STAT=errStat2 ); if (Failed0('m%r_e.' )) return; + allocate ( m%rhat_s( 3,0:p%NumPlanes-2,1:p%NumTurbines ), STAT=errStat2 ); if (Failed0('m%rhat_s.' )) return; + allocate ( m%rhat_e( 3,0:p%NumPlanes-2,1:p%NumTurbines ), STAT=errStat2 ); if (Failed0('m%rhat_e.' )) return; + allocate ( m%pvec_cs( 3,0:p%NumPlanes-2,1:p%NumTurbines ), STAT=errStat2 ); if (Failed0('m%pvec_cs.' )) return; + allocate ( m%pvec_ce( 3,0:p%NumPlanes-2,1:p%NumTurbines ), STAT=errStat2 ); if (Failed0('m%pvec_ce.' )) return; + ! WAT - store array of disk average velocities for all turbines + call AllocAry(m%V_amb_low_disk,3,p%NumTurbines,'m%V_amb_low_disk', ErrStat2, ErrMsg2); if(Failed()) return; + m%V_amb_low_disk=0.0_ReKi ! IMPORTANT ALLOCATION. This misc var is not set before a low res calcoutput ! Read-in the ambient wind data for the initial calculate output - - call AWAE_UpdateStates( 0.0_DbKi, -1, u, p, x, xd, z, OtherState, m, errStat2, errMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, errStat, errMsg, RoutineName ) - - + call AWAE_UpdateStates( 0.0_DbKi, -1, u, p, x, xd, z, OtherState, m, errStat2, errMsg2 ); if(Failed()) return; contains subroutine CheckModAmb3Boundaries() @@ -1356,14 +1194,26 @@ subroutine CheckModAmb3Boundaries() endif end subroutine CheckModAmb3Boundaries - + logical function Failed() + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function Failed + + ! check for failed where /= 0 is fatal + logical function Failed0(txt) + character(*), intent(in) :: txt + if (errStat /= 0) then + ErrStat2 = ErrID_Fatal + ErrMsg2 = "Could not allocate memory for "//trim(txt) + call SetErrStat(errStat2, errMsg2, errStat, errMsg, RoutineName) + endif + Failed0 = errStat >= AbortErrLev + end function Failed0 end subroutine AWAE_Init !---------------------------------------------------------------------------------------------------------------------------------- !> This routine is called at the end of the simulation. subroutine AWAE_End( u, p, x, xd, z, OtherState, y, m, errStat, errMsg ) -!.................................................................................................................................. - type(AWAE_InputType), intent(inout) :: u !< System inputs type(AWAE_ParameterType), intent(inout) :: p !< Parameters type(AWAE_ContinuousStateType), intent(inout) :: x !< Continuous states @@ -1375,22 +1225,13 @@ subroutine AWAE_End( u, p, x, xd, z, OtherState, y, m, errStat, errMsg ) integer(IntKi), intent( out) :: errStat !< Error status of the operation character(*), intent( out) :: errMsg !< Error message if errStat /= ErrID_None - ! Local variables integer(IntKi) :: nt !< loop counter - ! Initialize errStat - errStat = ErrID_None errMsg = "" - - ! Place any last minute operations or calculations here: - - - ! Close files here: - - ! End all instances of the InflowWind module + ! End all instances of the InflowWind module if ( p%Mod_AmbWind == 2 ) then call InflowWind_End( m%u_IfW_Low, p%IfW(0 ), x%IfW(0 ), xd%IfW(0 ), z%IfW(0 ), OtherState%IfW(0 ), m%y_IfW_Low, m%IfW(0 ), errStat, errMsg ) else if ( p%Mod_AmbWind == 3 ) then @@ -1400,64 +1241,48 @@ subroutine AWAE_End( u, p, x, xd, z, OtherState, y, m, errStat, errMsg ) end do end if - - - ! Destroy the input data: - + ! Destroy the input data: call AWAE_DestroyInput( u, errStat, errMsg ) - - ! Destroy the parameter data: - + ! Destroy the parameter data: call AWAE_DestroyParam( p, errStat, errMsg ) - - ! Destroy the state data: - + ! Destroy the state data: call AWAE_DestroyContState( x, errStat, errMsg ) call AWAE_DestroyDiscState( xd, errStat, errMsg ) call AWAE_DestroyConstrState( z, errStat, errMsg ) call AWAE_DestroyOtherState( OtherState, errStat, errMsg ) call AWAE_DestroyMisc( m, errStat, errMsg ) - ! Destroy the output data: - + ! Destroy the output data: call AWAE_DestroyOutput( y, errStat, errMsg ) - - - end subroutine AWAE_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 AWAE_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,... + real(DbKi), intent(in ) :: t !< Current simulation time in seconds + integer(IntKi), intent(in ) :: n !< Current simulation time step n = 0,1,... type(AWAE_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(AWAE_ParameterType), intent(in ) :: p !< Parameters type(AWAE_ContinuousStateType), intent(inout) :: x !< Input: Continuous states at t; - !! Output: Continuous states at t + Interval + !! Output: Continuous states at t + Interval type(AWAE_DiscreteStateType), intent(inout) :: xd !< Input: Discrete states at t; - !! Output: Discrete states at t + Interval + !! Output: Discrete states at t + Interval type(AWAE_ConstraintStateType), intent(inout) :: z !< Input: Constraint states at t; - !! Output: Constraint states at t+dt + !! Output: Constraint states at t+dt type(AWAE_OtherStateType), intent(inout) :: OtherState !< Input: Other states at t; - !! Output: Other states at t+dt + !! Output: Other states at t+dt type(AWAE_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(AWAE_InputType) :: uInterp ! Interpolated/Extrapolated input - integer(intKi) :: errStat2 ! temporary Error status - character(ErrMsgLen) :: errMsg2 ! temporary Error message - character(*), parameter :: RoutineName = 'AWAE_UpdateStates' -! real(DbKi) :: t1, t2 - integer(IntKi) :: n_high_low, nt, n_hl, i,j,k,c + integer(IntKi), intent( out) :: errStat !< Error status of the operation + character(*), intent( out) :: errMsg !< Error message if errStat /= ErrID_None + + type(AWAE_InputType) :: uInterp ! Interpolated/Extrapolated input + integer(intKi) :: errStat2 ! temporary Error status + character(ErrMsgLen) :: errMsg2 ! temporary Error message + character(*), parameter :: RoutineName = 'AWAE_UpdateStates' + integer(IntKi) :: n_high_low, nt, i_hl, i,j,k,c errStat = ErrID_None errMsg = "" @@ -1475,19 +1300,17 @@ subroutine AWAE_UpdateStates( t, n, u, p, x, xd, z, OtherState, m, errStat, errM if ( p%Mod_AmbWind == 1 ) then ! read from file the ambient flow for the n+1 time step - call ReadLowResWindFile(n+1, p, m%Vamb_Low, errStat2, errMsg2) - call SetErrStat( ErrStat2, ErrMsg2, errStat, errMsg, RoutineName ) - if (errStat >= AbortErrLev) return + call ReadLowResWindFile(n+1, p, m%Vamb_Low, errStat2, errMsg2); if (Failed()) return; !#ifdef _OPENMP ! t2 = omp_get_wtime() ! write(*,*) ' AWAE_UpdateStates: Time spent reading Low Res data : '//trim(num2lstr(t2-t1))//' seconds' !#endif - !$OMP PARALLEL DO DEFAULT(Shared) PRIVATE(nt, n_hl, errStat2, errMsg2) !Private(nt,tm2,tm3) + !$OMP PARALLEL DO DEFAULT(Shared) PRIVATE(nt, i_hl, errStat2, errMsg2) !Private(nt,tm2,tm3) do nt = 1,p%NumTurbines - do n_hl=0, n_high_low + do i_hl=0, n_high_low ! read from file the ambient flow for the current time step - call ReadHighResWindFile(nt, (n+1)*p%n_high_low + n_hl, p, m%Vamb_high(nt)%data(:,:,:,:,n_hl), errStat2, errMsg2) + call ReadHighResWindFile(nt, (n+1)*p%n_high_low + i_hl, p, m%Vamb_high(nt)%data(:,:,:,:,i_hl), errStat2, errMsg2) if (ErrStat2 >= AbortErrLev) then !$OMP CRITICAL ! Needed to avoid data race on ErrStat and ErrMsg call SetErrStat( ErrStat2, ErrMsg2, errStat, errMsg, RoutineName ) @@ -1502,11 +1325,9 @@ subroutine AWAE_UpdateStates( t, n, u, p, x, xd, z, OtherState, m, errStat, errM ! Set the hub position and orientation to pass to IfW (IfW always calculates hub and disk avg vel) m%u_IfW_Low%HubPosition = (/ p%X0_low + 0.5*p%nX_low*p%dX_low, p%Y0_low + 0.5*p%nY_low*p%dY_low, p%Z0_low + 0.5*p%nZ_low*p%dZ_low /) - call Eye(m%u_IfW_Low%HubOrientation,ErrStat2,ErrMsg2) + call Eye(m%u_IfW_Low%HubOrientation,ErrStat2,ErrMsg2); if (Failed()) return; ! Set low-resolution inflow wind velocities - call InflowWind_CalcOutput(t+p%dt_low, m%u_IfW_Low, p%IfW(0), x%IfW(0), xd%IfW(0), z%IfW(0), OtherState%IfW(0), m%y_IfW_Low, m%IfW(0), errStat2, errMsg2) - call SetErrStat( ErrStat2, ErrMsg2, errStat, errMsg, RoutineName ) - if (errStat >= AbortErrLev) return + call InflowWind_CalcOutput(t+p%dt_low, m%u_IfW_Low, p%IfW(0), x%IfW(0), xd%IfW(0), z%IfW(0), OtherState%IfW(0), m%y_IfW_Low, m%IfW(0), errStat2, errMsg2); if (Failed()) return; c = 1 do k = 0,p%nZ_low-1 do j = 0,p%nY_low-1 @@ -1523,15 +1344,13 @@ subroutine AWAE_UpdateStates( t, n, u, p, x, xd, z, OtherState, m, errStat, errM ! Set the hub position and orientation to pass to IfW (IfW always calculates hub and disk avg vel) m%u_IfW_High%HubPosition = (/ p%X0_high(nt) + 0.5*p%nX_high*p%dX_high(nt), p%Y0_high(nt) + 0.5*p%nY_high*p%dY_high(nt), p%Z0_high(nt) + 0.5*p%nZ_high*p%dZ_high(nt) /) call Eye(m%u_IfW_High%HubOrientation,ErrStat2,ErrMsg2) - do n_hl=0, n_high_low - call InflowWind_CalcOutput(t+p%dt_low+n_hl*p%DT_high, m%u_IfW_High, p%IfW(0), x%IfW(0), xd%IfW(0), z%IfW(0), OtherState%IfW(0), m%y_IfW_High, m%IfW(0), errStat2, errMsg2) - call SetErrStat( ErrStat2, ErrMsg2, errStat, errMsg, RoutineName ) - if (errStat >= AbortErrLev) return + do i_hl=0, n_high_low + call InflowWind_CalcOutput(t+p%dt_low+i_hl*p%DT_high, m%u_IfW_High, p%IfW(0), x%IfW(0), xd%IfW(0), z%IfW(0), OtherState%IfW(0), m%y_IfW_High, m%IfW(0), errStat2, errMsg2); if (Failed()) return; c = 1 do k = 0,p%nZ_high-1 do j = 0,p%nY_high-1 do i = 0,p%nX_high-1 - m%Vamb_high(nt)%data(:,i,j,k,n_hl) = m%y_IfW_High%VelocityUVW(:,c) + m%Vamb_high(nt)%data(:,i,j,k,i_hl) = m%y_IfW_High%VelocityUVW(:,c) c = c+1 end do end do @@ -1550,18 +1369,16 @@ subroutine AWAE_UpdateStates( t, n, u, p, x, xd, z, OtherState, m, errStat, errM end do end do end do - do n_hl=0, n_high_low + do i_hl=0, n_high_low ! Set the hub position and orientation to pass to IfW (IfW always calculates hub and disk avg vel) m%u_IfW_High%HubPosition = (/ p%X0_high(nt) + 0.5*p%nX_high*p%dX_high(nt), p%Y0_high(nt) + 0.5*p%nY_high*p%dY_high(nt), p%Z0_high(nt) + 0.5*p%nZ_high*p%dZ_high(nt) /) - p%WT_Position(:,nt) call Eye(m%u_IfW_High%HubOrientation,ErrStat2,ErrMsg2) - call InflowWind_CalcOutput(t+p%dt_low+n_hl*p%DT_high, m%u_IfW_High, p%IfW(nt), x%IfW(nt), xd%IfW(nt), z%IfW(nt), OtherState%IfW(nt), m%y_IfW_High, m%IfW(nt), errStat2, errMsg2) - call SetErrStat( ErrStat2, ErrMsg2, errStat, errMsg, RoutineName ) - if (errStat >= AbortErrLev) return + call InflowWind_CalcOutput(t+p%dt_low+i_hl*p%DT_high, m%u_IfW_High, p%IfW(nt), x%IfW(nt), xd%IfW(nt), z%IfW(nt), OtherState%IfW(nt), m%y_IfW_High, m%IfW(nt), errStat2, errMsg2); if (Failed()) return; c = 1 do k = 0,p%nZ_high-1 do j = 0,p%nY_high-1 do i = 0,p%nX_high-1 - m%Vamb_high(nt)%data(:,i,j,k,n_hl) = m%y_IfW_High%VelocityUVW(:,c) + m%Vamb_high(nt)%data(:,i,j,k,i_hl) = m%y_IfW_High%VelocityUVW(:,c) c = c+1 end do end do @@ -1569,14 +1386,30 @@ subroutine AWAE_UpdateStates( t, n, u, p, x, xd, z, OtherState, m, errStat, errM end do end do end if - end if + ! WAT tracer propagation + if (p%WAT_Enabled) then + ! find mean velocity of all turbine disks + xd%Ufarm = 0.0_ReKi + do nt=1,p%NumTurbines + xd%Ufarm(1:3) = xd%Ufarm(1:3) + m%V_amb_low_disk(1:3,nt) + enddo + xd%Ufarm(1:3) = xd%Ufarm(1:3) / real(p%NumTurbines,ReKi) + ! add mean velocity * dt to the tracer for the position of the WAT box + xd%WAT_B_Box(1:3) = xd%WAT_B_Box(1:3) + xd%Ufarm(1:3)*real(p%dt_low,ReKi) + endif + !#ifdef _OPENMP ! t1 = omp_get_wtime() ! write(*,*) ' AWAE_UpdateStates: Time spent reading High Res data : '//trim(num2lstr(t1-t2))//' seconds' -!#endif - +!#endif + +contains + logical function Failed() + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function Failed end subroutine AWAE_UpdateStates @@ -1589,8 +1422,6 @@ subroutine AWAE_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. -!.................................................................................................................................. - use VTK real(DbKi), intent(in ) :: t !< Current simulation time in seconds type(AWAE_InputType), intent(in ) :: u !< Inputs at Time t @@ -1600,45 +1431,36 @@ subroutine AWAE_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, errStat, errMsg type(AWAE_ConstraintStateType), intent(in ) :: z !< Constraint states at t type(AWAE_OtherStateType), intent(in ) :: OtherState !< Other states at t type(AWAE_OutputType), intent(inout) :: y !< Outputs computed at t (Input only so that mesh con- - !! nectivity information does not have to be recalculated) + !! nectivity information does not have to be recalculated) type(AWAE_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 - character(p%VTK_tWidth) :: Tstr ! string for current VTK write-out step (padded with zeros) - integer(intKi) :: i, j, k - integer(intKi) :: errStat2 - character(ErrMsgLen) :: errMsg2 - character(*), parameter :: RoutineName = 'AWAE_CalcOutput' - integer(intKi) :: n, n_high - character(3) :: PlaneNumStr ! 3 digit number of the output plane - CHARACTER(1024) :: FileName - INTEGER(IntKi) :: Un ! unit number of opened file - + integer, parameter :: indx = 1 + character(p%VTK_tWidth) :: Tstr ! string for current VTK write-out step (padded with zeros) + integer(intKi) :: i, j, k + integer(intKi) :: errStat2 + character(ErrMsgLen) :: errMsg2 + character(*), parameter :: RoutineName = 'AWAE_CalcOutput' + integer(intKi) :: n, n_high + character(3) :: PlaneNumStr ! 2 digit number of the output plane + CHARACTER(1024) :: FileName + INTEGER(IntKi) :: Un ! unit number of opened file errStat = ErrID_None errMsg = "" - n = nint(t / p%dt_low) - call ComputeLocals(n, u, p, y, m, errStat2, errMsg2) - call SetErrStat ( errStat2, errMsg2, errStat, errMsg, RoutineName ) - if (errStat2 >= AbortErrLev) then - return - end if - call LowResGridCalcOutput(n, u, p, y, m, errStat2, errMsg2) - call SetErrStat ( errStat2, errMsg2, errStat, errMsg, RoutineName ) - if (errStat2 >= AbortErrLev) then - return - end if - ! starting index for the high-res files + ! some variables and indexing + n = nint(t / p%dt_low) n_high = n*p%n_high_low - call HighResGridCalcOutput(n_high, u, p, y, m, errStat2, errMsg2) - call SetErrStat ( errStat2, errMsg2, errStat, errMsg, RoutineName ) - if (errStat2 >= AbortErrLev) then - return - end if + call ComputeLocals(n, u, p, y, m, errStat2, errMsg2); if (Failed()) return; + + ! high-res + call HighResGridCalcOutput(n_high, u, p, xd, y, m, errStat2, errMsg2); if (Failed()) return; + + ! low-res + call LowResGridCalcOutput(n, u, p, xd, y, m, errStat2, errMsg2); if (Failed()) return; + if (mod(n,p%WrDisSkp1) == 0) then @@ -1655,12 +1477,8 @@ subroutine AWAE_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, errStat, errMsg call ExtractSlice( XYSlice, p%OutDisWindZ(k), p%Z0_low, p%nZ_low, p%nX_low, p%nY_low, p%dZ_low, m%Vdist_low_full, m%outVizXYPlane(:,:,:,1)) ! Create the output vtk file with naming /Low/DisXY.t.vtk FileName = trim(p%OutFileVTKRoot)//".Low.DisXY"//PlaneNumStr//"."//trim(Tstr)//".vtk" - call WrVTK_SP_header( FileName, "Low resolution, disturbed wind of XY Slice at time = "//trim(num2lstr(t))//" seconds.", Un, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call WrVTK_SP_vectors3D( Un, "Velocity", (/p%nX_low,p%nY_low,1_IntKi/), (/p%X0_low,p%Y0_low,p%OutDisWindZ(k)/), (/p%dX_low,p%dY_low,p%dZ_low/), m%outVizXYPlane, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return + call WrVTK_SP_header( FileName, "Low resolution, disturbed wind of XY Slice at time = "//trim(num2lstr(t))//" seconds.", Un, ErrStat2, ErrMsg2 ); if (Failed()) return; + call WrVTK_SP_vectors3D( Un, "Velocity", (/p%nX_low,p%nY_low,1_IntKi/), (/p%X0_low,p%Y0_low,p%OutDisWindZ(k)/), (/p%dX_low,p%dY_low,p%dZ_low/), m%outVizXYPlane, ErrStat2, ErrMsg2 ); if (Failed()) return; end do ! YZ plane slices @@ -1669,12 +1487,8 @@ subroutine AWAE_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, errStat, errMsg call ExtractSlice( YZSlice, p%OutDisWindX(k), p%X0_low, p%nX_low, p%nY_low, p%nZ_low, p%dX_low, m%Vdist_low_full, m%outVizYZPlane(:,:,:,1)) ! Create the output vtk file with naming /Low/DisYZ.t.vtk FileName = trim(p%OutFileVTKRoot)//".Low.DisYZ"//PlaneNumStr//"."//trim(Tstr)//".vtk" - call WrVTK_SP_header( FileName, "Low resolution, disturbed wind of YZ Slice at time = "//trim(num2lstr(t))//" seconds.", Un, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call WrVTK_SP_vectors3D( Un, "Velocity", (/1,p%nY_low,p%nZ_low/), (/p%OutDisWindX(k),p%Y0_low,p%Z0_low/), (/p%dX_low,p%dY_low,p%dZ_low/), m%outVizYZPlane, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return + call WrVTK_SP_header( FileName, "Low resolution, disturbed wind of YZ Slice at time = "//trim(num2lstr(t))//" seconds.", Un, ErrStat2, ErrMsg2 ); if (Failed()) return; + call WrVTK_SP_vectors3D( Un, "Velocity", (/1,p%nY_low,p%nZ_low/), (/p%OutDisWindX(k),p%Y0_low,p%Z0_low/), (/p%dX_low,p%dY_low,p%dZ_low/), m%outVizYZPlane, ErrStat2, ErrMsg2 ); if (Failed()) return; end do ! XZ plane slices @@ -1683,15 +1497,16 @@ subroutine AWAE_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, errStat, errMsg call ExtractSlice( XZSlice, p%OutDisWindY(k), p%Y0_low, p%nY_low, p%nX_low, p%nZ_low, p%dY_low, m%Vdist_low_full, m%outVizXZPlane(:,:,:,1)) ! Create the output vtk file with naming /Low/DisXZ.t.vtk FileName = trim(p%OutFileVTKRoot)//".Low.DisXZ"//PlaneNumStr//"."//trim(Tstr)//".vtk" - call WrVTK_SP_header( FileName, "Low resolution, disturbed wind of XZ Slice at time = "//trim(num2lstr(t))//" seconds.", Un, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call WrVTK_SP_vectors3D( Un, "Velocity", (/p%nX_low,1,p%nZ_low/), (/p%X0_low,p%OutDisWindY(k),p%Z0_low/), (/p%dX_low,p%dY_low,p%dZ_low/), m%outVizXZPlane, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return + call WrVTK_SP_header( FileName, "Low resolution, disturbed wind of XZ Slice at time = "//trim(num2lstr(t))//" seconds.", Un, ErrStat2, ErrMsg2 ); if (Failed()) return; + call WrVTK_SP_vectors3D( Un, "Velocity", (/p%nX_low,1,p%nZ_low/), (/p%X0_low,p%OutDisWindY(k),p%Z0_low/), (/p%dX_low,p%dY_low,p%dZ_low/), m%outVizXZPlane, ErrStat2, ErrMsg2 ); if (Failed()) return; end do end if +contains + logical function Failed() + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function Failed end subroutine AWAE_CalcOutput !---------------------------------------------------------------------------------------------------------------------------------- @@ -1730,15 +1545,10 @@ end subroutine AWAE_CalcConstrStateResidual !---------------------------------------------------------------------------------------------------------------------------------- !> This routine validates the inputs from the Wind_AmbientAndArray input files. subroutine ValidateInitInputData( InputFileData, errStat, errMsg ) -!.................................................................................................................................. - - ! Passed variables: type(AWAE_InputFileType), intent(in) :: InputFileData !< All the data in the Wind_AmbientAndArray 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' @@ -1773,13 +1583,11 @@ end subroutine ValidateInitInputData !======================================================================= ! Unit Tests !======================================================================= - subroutine AWAE_TEST_Init_BadData(errStat, errMsg) integer(IntKi), intent(out) :: errStat !< Error status character(*), intent(out) :: errMsg !< Error message - type(AWAE_InitInputType) :: InitInp !< Input data for initialization routine type(AWAE_InputType) :: u !< An initial guess for the input; input mesh must be defined type(AWAE_ParameterType) :: p !< Parameters @@ -1795,12 +1603,7 @@ subroutine AWAE_TEST_Init_BadData(errStat, errMsg) type(AWAE_InitOutputType) :: initOut !< Input data for initialization routine - - - - ! Set up the initialization inputs - - + ! Set up the initialization inputs interval = 0.0_DbKi InitInp%InputFileData%WindFilePath = '' InitInp%InputFileData%NumTurbines = 0 @@ -1810,11 +1613,9 @@ subroutine AWAE_TEST_Init_BadData(errStat, errMsg) InitInp%InputFileData%Mod_Meander = 0 InitInp%InputFileData%C_Meander = 0.0_ReKi - call AWAE_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut, errStat, errMsg ) return - end subroutine AWAE_TEST_Init_BadData subroutine AWAE_TEST_SetGoodInitInpData(interval, InitInp) @@ -1848,11 +1649,9 @@ end subroutine AWAE_TEST_SetGoodInitInpData subroutine AWAE_TEST_Init_GoodData(errStat, errMsg) - integer(IntKi), intent(out) :: errStat !< Error status character(*), intent(out) :: errMsg !< Error message - type(AWAE_InitInputType) :: InitInp !< Input data for initialization routine type(AWAE_InputType) :: u !< An initial guess for the input; input mesh must be defined type(AWAE_ParameterType) :: p !< Parameters @@ -1867,26 +1666,18 @@ subroutine AWAE_TEST_Init_GoodData(errStat, errMsg) type(AWAE_InitOutputType) :: initOut !< Input data for initialization routine - - - - ! Set up the initialization inputs call AWAE_TEST_SetGoodInitInpData(interval, InitInp) - call AWAE_Init( InitInp, u, p, x, xd, z, OtherState, y, m, interval, InitOut, errStat, errMsg ) return - end subroutine AWAE_TEST_Init_GoodData subroutine AWAE_TEST_CalcOutput(errStat, errMsg) - integer(IntKi), intent(out) :: errStat !< Error status character(*), intent(out) :: errMsg !< Error message - type(AWAE_InitInputType) :: InitInp !< Input data for initialization routine type(AWAE_InputType) :: u !< An initial guess for the input; input mesh must be defined type(AWAE_ParameterType) :: p !< Parameters @@ -1939,7 +1730,6 @@ subroutine AWAE_TEST_CalcOutput(errStat, errMsg) return end if - ! Set up the inputs do nt = 1,p%NumTurbines do np = 0,p%NumPlanes-1 @@ -1953,7 +1743,6 @@ subroutine AWAE_TEST_CalcOutput(errStat, errMsg) end do end do - u%xhat_plane(1,:,:) = 1.0_ReKi u%xhat_plane(2,:,:) = 0.0_ReKi u%xhat_plane(3,:,:) = 0.0_ReKi @@ -1985,8 +1774,6 @@ subroutine AWAE_TEST_CalcOutput(errStat, errMsg) !end if return - - end subroutine AWAE_TEST_CalcOutput ! WAT TODO @@ -2020,7 +1807,6 @@ subroutine TurbPlane(Uconv, t, nr, u_p, v_p, w_p) !u_b = u_b(iy_b, iz_b, ix_b) ! TODO enddo enddo - end subroutine FUNCTION INTERP3D(p,p0,del,V,within,nX,nY,nZ,Vbox) diff --git a/modules/awae/src/AWAE_IO.f90 b/modules/awae/src/AWAE_IO.f90 index a4b2720cf3..b51febcc61 100644 --- a/modules/awae/src/AWAE_IO.f90 +++ b/modules/awae/src/AWAE_IO.f90 @@ -38,45 +38,39 @@ MODULE AWAE_IO contains -subroutine HiResWindCheck(n, nt, nX, nY, nZ, dX, dY, dZ, X0, Y0, Z0, dims, gridSpacing, origin, callingRoutine, errMsg, errStat) +subroutine HiResWindCheck(n, nt, dims1, gridSpacing1, origin1, dims2, gridSpacing2, origin2, callingRoutine, errMsg, errStat) integer(IntKi), intent(in ) :: n !< high-resolution time step number (0-based) integer(IntKi), intent(in ) :: nt !< turbine number - integer(IntKi), intent(in ) :: nX !< number of grid points in the X-direction for turbine 1 at high-res time step 0 - integer(IntKi), intent(in ) :: nY !< number of grid points in the Y-direction for turbine 1 at high-res time step 0 - integer(IntKi), intent(in ) :: nZ !< number of grid points in the Z-direction for turbine 1 at high-res time step 0 - real(ReKi), intent(in ) :: dX !< space between grid points in the X-direction for turbine 1 at high-res time step 0 - real(ReKi), intent(in ) :: dY !< space between grid points in the Y-direction for turbine 1 at high-res time step 0 - real(ReKi), intent(in ) :: dZ !< space between grid points in the Z-direction for turbine 1 at high-res time step 0 - real(ReKi), intent(in ) :: X0 !< starting X-location of the grid for turbine 1 at high-res time step 0 (m) - real(ReKi), intent(in ) :: Y0 !< starting Y-location of the grid for turbine 1 at high-res time step 0 (m) - real(ReKi), intent(in ) :: Z0 !< starting Z-location of the grid for turbine 1 at high-res time step 0 (m) - integer(IntKi), intent(in ) :: dims(3) !< dimensions of the grid for turbine nt at high-res time step n (m) - real(ReKi), intent(in ) :: gridSpacing(3) !< spacing between grid points for turbine nt at high-res time step n (m) - real(ReKi), intent(in ) :: origin(3) !< starting coordinates of the grid for turbine nt at high-res time step n (m) + integer(IntKi), intent(in ) :: dims1(3) !< dimensions of the grid for turbine nt at high-res time step 0 (m) + real(ReKi), intent(in ) :: gridSpacing1(3) !< spacing between grid points for turbine nt at high-res time step 0 (m) + real(ReKi), intent(in ) :: origin1(3) !< starting coordinates of the grid for turbine nt at high-res time step 0 (m) + integer(IntKi), intent(in ) :: dims2(3) !< dimensions of the grid for turbine nt at high-res time step n (m) + real(ReKi), intent(in ) :: gridSpacing2(3)!< spacing between grid points for turbine nt at high-res time step n (m) + real(ReKi), intent(in ) :: origin2(3) !< starting coordinates of the grid for turbine nt at high-res time step n (m) character(*), intent(in ) :: callingRoutine !< string containing the name of the calling routine. integer(IntKi), intent( out) :: errStat !< Error status of the operation character(*), intent( out) :: errMsg !< Error message if errStat /= ErrID_None ! grid must have two points in each direction - if ( (dims(1) < 2) .or. (dims(2) < 2) .or. (dims(3) < 2) ) then + if ( (dims1(1) < 2) .or. (dims1(2) < 2) .or. (dims1(3) < 2) ) then call SetErrStat ( ErrID_Fatal, 'The high resolution grid dimensions must contain a minimum of 2 nodes in each spatial direction. Turbine #'//trim(num2lstr(nt))//', time step '//trim(num2lstr(n)), errStat, errMsg, callingRoutine ) return end if ! All turbines and all time steps must have the same grid dimensions due to array allocation assumptions - if ( ( dims(1) .ne. nX ) .or. ( dims(2) .ne. nY ) .or. ( dims(3) .ne. nZ ) ) then + if ( any(dims1 .ne. dims2) ) then call SetErrStat ( ErrID_Fatal, 'The high resolution grid dimensions for turbine #'//trim(num2lstr(nt))//' and high-res time step '//trim(num2lstr(n))//' do not match turbine #1 and time step 0.', errStat, errMsg, callingRoutine ) return end if ! spacing must be consistent for a given turbine across all time steps - if ( ( gridSpacing(1) .ne. dX ) .or. ( gridSpacing(2) .ne. dY ) .or. ( gridSpacing(3) .ne. dZ ) ) then + if ( any(gridSpacing1 .ne. gridSpacing2) ) then call SetErrStat ( ErrID_Fatal, 'The high resolution grid spacing for turbine #'//trim(num2lstr(nt))//' and high-res time step '//trim(num2lstr(n))//' do not match time step 0.', errStat, errMsg, callingRoutine ) return end if ! verify origin of any given turbine is not changing with time step. - if ( ( origin(1) .ne. X0 ) .or. ( origin(2) .ne. Y0 ) .or. ( origin(3) .ne. Z0 ) ) then + if ( any(origin1 .ne. origin2) ) then call SetErrStat ( ErrID_Fatal, 'The high resolution grid origin for turbine #'//trim(num2lstr(nt))//' and high-res time step '//trim(num2lstr(n))//' do not match time step 0.', errStat, errMsg, callingRoutine ) return end if @@ -131,10 +125,8 @@ subroutine WriteDisWindFiles( n, WrDisSkp1, p, y, m, errStat, errMsg ) end subroutine WriteDisWindFiles - !---------------------------------------------------------------------------------------------------------------------------------- -!> This subroutine -!! +!> This subroutine read the low res wind file (VTK) at a given time step `n` subroutine ReadLowResWindFile(n, p, Vamb_Low, errStat, errMsg) integer(IntKi), intent(in ) :: n !< Current simulation timestep increment (zero-based) type(AWAE_ParameterType), intent(in ) :: p !< Parameters @@ -158,16 +150,9 @@ subroutine ReadLowResWindFile(n, p, Vamb_Low, errStat, errMsg) call ReadVTK_SP_info( FileName, descr, dims, origin, gridSpacing, vecLabel, Un, ErrStat, ErrMsg ) if (ErrStat >= AbortErrLev) return call ReadVTK_SP_vectors( FileName, Un, dims, Vamb_Low, ErrStat, ErrMsg ) - - -!============================================================================== - - end subroutine ReadLowResWindFile - !---------------------------------------------------------------------------------------------------------------------------------- -!> This subroutine -!! +!> This subroutine read the high res wind file (VTK) at a given time step `n` subroutine ReadHighResWindFile(nt, n, p, Vamb_high, errStat, errMsg) integer(IntKi), intent(in ) :: nt @@ -195,11 +180,32 @@ subroutine ReadHighResWindFile(nt, n, p, Vamb_high, errStat, errMsg) if (ErrStat >= AbortErrLev) return call ReadVTK_SP_vectors( FileName, Un, dims, Vamb_high, ErrStat, ErrMsg ) - -!============================================================================== - end subroutine ReadHighResWindFile - +!---------------------------------------------------------------------------------------------------------------------------------- +!> Flat array of Cartesian point coordinates +!! Grid runs from (X0, Y0, Z0) to (X0 + (p%nX-1)*dX, Y0+ (p%nY-1)*dY, Z0+ (p%nZ-1)*dZ) +subroutine flatCartGridCoordinates(Origin, n, d, GridP) + Real(ReKi) , intent(in ) :: Origin(3) !< + integer(IntKi), intent(in ) :: n(3) !< dimension nx, ny, nz + Real(ReKi) , intent(in ) :: d(3) !< grid spacing dx, dy, dz + real(ReKi), intent(out) :: GridP(:,:) !< Grid points, flatten 3 x nTot + integer(IntKi) :: iXYZ + integer :: ix, iy, iz + iXYZ = 0 + do iz=0, n(3)-1 + do iy=0, n(2)-1 + do ix=0, n(1)-1 + iXYZ = iXYZ + 1 + GridP(1,iXYZ) = origin(1) + ix*d(1) + GridP(2,iXYZ) = origin(2) + iy*d(2) + GridP(3,iXYZ) = origin(3) + iz*d(3) + end do + end do + end do +end subroutine flatCartGridCoordinates +!---------------------------------------------------------------------------------------------------------------------------------- +!> Initialize low and high res grid from VTK or InflowWind +!! Set grid points, perform sanity checks subroutine AWAE_IO_InitGridInfo(InitInp, p, InitOut, errStat, errMsg) type(AWAE_InitInputType), intent(in ) :: InitInp !< Input data for initialization routine @@ -212,10 +218,11 @@ subroutine AWAE_IO_InitGridInfo(InitInp, p, InitOut, errStat, errMsg) integer(IntKi) :: errStat2 ! temporary error status of the operation character(ErrMsgLen) :: errMsg2 ! temporary error message character(*), parameter :: RoutineName = 'AWAE_IO_InitGridInfo' - integer(IntKi) :: nXYZ_low, nx_low, ny_low, nz_low, nXYZ_high, nx_high, ny_high, nz_high + integer(IntKi) :: i, k, nXYZ_low, nx_low, ny_low, nz_low, nXYZ_high, nx_high, ny_high, nz_high integer(IntKi) :: dims(3) ! dimension of the 3D grid (nX,nY,nZ) real(ReKi) :: origin(3) ! the lower-left corner of the 3D grid (X0,Y0,Z0) real(ReKi) :: gridSpacing(3) ! spacing between grid points in each of the 3 directions (dX,dY,dZ) + real(ReKi) :: gridSpacingWAT(3) ! character(1024) :: FileName ! Name of output file character(1024) :: descr ! Line describing the contents of the file character(1024) :: vecLabel ! descriptor of the vector data @@ -227,6 +234,9 @@ subroutine AWAE_IO_InitGridInfo(InitInp, p, InitOut, errStat, errMsg) errMsg = "" + ! -------------------------------------------------------------------------------- + ! --- LOW RES + ! -------------------------------------------------------------------------------- !--------------------------------------------------------------------------- ! Parse time 0.0, low res wind input file to gather the grid ! information and set data associated with the low res grid @@ -256,6 +266,7 @@ subroutine AWAE_IO_InitGridInfo(InitInp, p, InitOut, errStat, errMsg) end if + ! --- Checks for grid spacing if ( (gridSpacing(1) <= 0.0_ReKi) .or. (gridSpacing(2) <= 0.0_ReKi) .or. (gridSpacing(3) <= 0.0_ReKi) ) & call SetErrStat ( ErrID_Fatal, 'The low resolution spatial resolution for Turbine 1 must be greater than zero in each spatial direction. ', errStat, errMsg, RoutineName ) if (ErrStat >= AbortErrLev) return @@ -285,146 +296,37 @@ subroutine AWAE_IO_InitGridInfo(InitInp, p, InitOut, errStat, errMsg) p%dXYZ_Low = gridSpacing p%dpol = (gridSpacing(1)+gridSpacing(2)+gridSpacing(3))/3.0_ReKi p%n_rp_max = ceiling(pi*((p%C_Meander*((p%NumRadii-1)*InitInp%InputFileData%dr+p%dpol))/p%dpol)**2.0_ReKi) - ! Grid runs from (X0_low, Y0_low, Z0_low) to (X0_low + (p%nX_Low-1)*dX_low, Y0_low+ (p%nY_Low-1)*dY_low, Z0_low+ (p%nZ_Low-1)*dZ_low) - ! (0,0,0) to (180,180,180) - - - allocate( p%Grid_low(3,p%NumGrid_low),stat=errStat2) - if (errStat2 /= 0) then - call SetErrStat ( ErrID_Fatal, 'Could not allocate memory for Grid_low.', errStat, errMsg, RoutineName ) - return - end if - - nXYZ_low = 0 - do nz_low=0, p%nZ_low-1 - do ny_low=0, p%nY_low-1 - do nx_low=0, p%nX_low-1 - nXYZ_low = nXYZ_low + 1 - p%Grid_low(1,nXYZ_low) = origin(1) + nx_low*gridSpacing(1) - p%Grid_low(2,nXYZ_low) = origin(2) + ny_low*gridSpacing(2) - p%Grid_low(3,nXYZ_low) = origin(3) + nz_low*gridSpacing(3) - end do - end do - end do - - if ( (InitInp%InputFileData%ChkWndFiles) .and. (p%Mod_AmbWind == 1) ) then - do n=1,p%NumDT-1 ! We have already checked the first low res time step - - FileName = trim(p%WindFilePath)//trim(PathSep)//"Low"//trim(PathSep)//"Amb.t"//trim(num2lstr(n))//".vtk" - Un = -1 ! Set to force closing of file on return - call ReadVTK_SP_info( FileName, descr, dims, origin, gridSpacing, vecLabel, Un, ErrStat, ErrMsg ) - if (ErrStat >= AbortErrLev) return - - ! verify dims, origin, gridSpacing match the first input file - if ( ( dims(1) .ne. p%nX_low ) .or. ( dims(2) .ne. p%nY_low ) .or. ( dims(3) .ne. p%nZ_low ) ) then - call SetErrStat ( ErrID_Fatal, 'The low resolution grid dimensions for time step '//trim(num2lstr(n))//' do not match time step 0.', errStat, errMsg, RoutineName ) - return - end if - if ( ( origin(1) .ne. InitOut%X0_Low ) .or. ( origin(2) .ne. InitOut%Y0_Low ) .or. ( origin(3) .ne. InitOut%Z0_Low ) ) then - call SetErrStat ( ErrID_Fatal, 'The low resolution grid origins for time step '//trim(num2lstr(n))//' do not match time step 0.', errStat, errMsg, RoutineName ) - return - end if - if ( ( gridSpacing(1) .ne. p%dX_low ) .or. ( gridSpacing(2) .ne. p%dY_low ) .or. ( gridSpacing(3) .ne. p%dZ_low ) ) then - call SetErrStat ( ErrID_Fatal, 'The low resolution grid spacing for time step '//trim(num2lstr(n))//' do not match time step 0.', errStat, errMsg, RoutineName ) - return - end if - - end do - end if - - - allocate( InitOut%X0_high(p%NumTurbines), InitOut%Y0_high(p%NumTurbines), InitOut%Z0_high(p%NumTurbines), stat=errStat2) - if (errStat2 /= 0) call SetErrStat ( ErrID_Fatal, 'Could not allocate memory for InitOut origin arrays.', errStat, errMsg, RoutineName ) - allocate( InitOut%dX_high(p%NumTurbines), InitOut%dY_high(p%NumTurbines), InitOut%dZ_high(p%NumTurbines), stat=errStat2) - if (errStat2 /= 0) call SetErrStat ( ErrID_Fatal, 'Could not allocate memory for InitOut spatial increment arrays.', errStat, errMsg, RoutineName ) - allocate( p%X0_high(p%NumTurbines), p%Y0_high(p%NumTurbines), p%Z0_high(p%NumTurbines), stat=errStat2) - if (errStat2 /= 0) call SetErrStat ( ErrID_Fatal, 'Could not allocate memory for p origin arrays.', errStat, errMsg, RoutineName ) - allocate( p%dX_high(p%NumTurbines), p%dY_high(p%NumTurbines), p%dZ_high(p%NumTurbines), stat=errStat2) - if (errStat2 /= 0) call SetErrStat ( ErrID_Fatal, 'Could not allocate memory for p spatial increment arrays.', errStat, errMsg, RoutineName ) - if (ErrStat >= AbortErrLev) return - - if ( p%Mod_AmbWind == 1 ) then + ! Set coordinates of points in a flat array (Grid_low) + call AllocAry( p%Grid_low, 3, p%NumGrid_low, 'Grid_low', errStat2, errMsg2); if(Failed()) return + call flatCartGridCoordinates(origin, dims, gridSpacing, p%Grid_low) + + + ! -------------------------------------------------------------------------------- + ! --- HIGH RES + ! -------------------------------------------------------------------------------- + call AllocAry(InitOut%X0_high, p%NumTurbines, 'X0_high', errStat2, errMsg2); if(Failed()) return + call AllocAry(InitOut%Y0_high, p%NumTurbines, 'Y0_high', errStat2, errMsg2); if(Failed()) return + call AllocAry(InitOut%Z0_high, p%NumTurbines, 'Z0_high', errStat2, errMsg2); if(Failed()) return + call AllocAry(InitOut%dX_high, p%NumTurbines, 'dX_high', errStat2, errMsg2); if(Failed()) return + call AllocAry(InitOut%dY_high, p%NumTurbines, 'dY_high', errStat2, errMsg2); if(Failed()) return + call AllocAry(InitOut%dZ_high, p%NumTurbines, 'dZ_high', errStat2, errMsg2); if(Failed()) return + call AllocAry( p%X0_high, p%NumTurbines, 'X0_high', errStat2, errMsg2); if(Failed()) return + call AllocAry( p%Y0_high, p%NumTurbines, 'Y0_high', errStat2, errMsg2); if(Failed()) return + call AllocAry( p%Z0_high, p%NumTurbines, 'Z0_high', errStat2, errMsg2); if(Failed()) return + call AllocAry( p%dX_high, p%NumTurbines, 'dX_high', errStat2, errMsg2); if(Failed()) return + call AllocAry( p%dY_high, p%NumTurbines, 'dY_high', errStat2, errMsg2); if(Failed()) return + call AllocAry( p%dZ_high, p%NumTurbines, 'dZ_high', errStat2, errMsg2); if(Failed()) return + + if (p%WAT_Enabled) then + gridSpacingWAT = (/ 0.0_ReKi, 1/p%WAT_FlowField%Grid3D%InvDY, 1/p%WAT_FlowField%Grid3D%InvDZ /) + endif - !--------------------------------------------------------------------------- - ! Parse turbine 1, 1st timestep, high res wind input file to gather the grid - ! information and set data associated with turbine 1 - !--------------------------------------------------------------------------- - - FileName = trim(p%WindFilePath)//trim(PathSep)//"HighT1"//trim(PathSep)//"Amb.t0.vtk" - Un = -1 ! Set to force closing of file on return - call ReadVTK_SP_info( FileName, descr, dims, origin, gridSpacing, vecLabel, Un, errStat2, errMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, errStat, errMsg, RoutineName ) - if (errStat >= AbortErrLev) return - else - - ! Using InflowWind, so data has been passed in via the InitInp data structure - origin(1) = InitInp%InputFileData%X0_high(1) - origin(2) = InitInp%InputFileData%Y0_high(1) - origin(3) = InitInp%InputFileData%Z0_high(1) - dims(1) = InitInp%InputFileData%nX_high - dims(2) = InitInp%InputFileData%nY_high - dims(3) = InitInp%InputFileData%nZ_high - gridSpacing(1) = InitInp%InputFileData%dX_high(1) - gridSpacing(2) = InitInp%InputFileData%dY_high(1) - gridSpacing(3) = InitInp%InputFileData%dZ_high(1) - p%dt_high = InitInp%InputFileData%dt_high - - end if - - if ( (gridSpacing(1) <= 0.0_ReKi) .or. (gridSpacing(2) <= 0.0_ReKi) .or. (gridSpacing(3) <= 0.0_ReKi) ) & - call SetErrStat ( ErrID_Fatal, 'The high resolution spatial resolution for Turbine 1 must be greater than zero in each spatial direction. ', errStat, errMsg, RoutineName ) - if (errStat >= AbortErrLev ) return - - p%nX_high = dims(1) - p%nY_high = dims(2) - p%nZ_high = dims(3) - p%X0_high(1) = origin(1) - p%Y0_high(1) = origin(2) - p%Z0_high(1) = origin(3) - p%dX_high(1) = gridSpacing(1) - p%dY_high(1) = gridSpacing(2) - p%dZ_high(1) = gridSpacing(3) - NumGrid_high = p%nX_high*p%nY_high*p%nZ_high - - InitOut%X0_high(1) = origin(1) - InitOut%Y0_high(1) = origin(2) - InitOut%Z0_high(1) = origin(3) - InitOut%dX_high(1) = gridSpacing(1) - InitOut%dY_high(1) = gridSpacing(2) - InitOut%dZ_high(1) = gridSpacing(3) - - if ( p%Mod_AmbWind == 1 ) then - ! Just using this to make sure dims are >=2 points in each direction - call HiResWindCheck(0, 1, p%nX_high, p%nY_high, p%nZ_high, p%dX_high(1), p%dY_high(1), p%dZ_high(1), p%X0_high(1), p%Y0_high(1), p%Z0_high(1), dims, gridSpacing, origin, RoutineName, errMsg2, errStat2) - call SetErrStat( ErrStat2, ErrMsg2, errStat, errMsg, RoutineName ) - if (errStat >= AbortErrLev) return - end if - - allocate( p%Grid_high(3,NumGrid_high,p%NumTurbines ),stat=errStat2) - if (errStat2 /= 0) then - call SetErrStat ( ErrID_Fatal, 'Could not allocate memory for Grid_high.', errStat, errMsg, RoutineName ) - return - end if - - nXYZ_high = 0 - do nz_high=0, p%nZ_high-1 - do ny_high=0, p%nY_high-1 - do nx_high=0, p%nX_high-1 - nXYZ_high = nXYZ_high + 1 - p%Grid_high(1,nXYZ_high,1) = InitOut%X0_high(1) + nx_high*InitOut%dX_high(1) - p%Grid_high(2,nXYZ_high,1) = InitOut%Y0_high(1) + ny_high*InitOut%dY_high(1) - p%Grid_high(3,nXYZ_high,1) = InitOut%Z0_high(1) + nz_high*InitOut%dZ_high(1) - end do - end do - end do - !--------------------------------------------------------------------------- - ! Parse the remaining turbine's 1st timestep, high res wind input files to + ! Parse the turbine's 1st timestep, high res wind input files to ! gather the grid information and set data associated with those turbines !--------------------------------------------------------------------------- - - do nt = 2, p%NumTurbines + do nt = 1, p%NumTurbines if ( p%Mod_AmbWind == 1 ) then FileName = trim(p%WindFilePath)//trim(PathSep)//"HighT"//trim(num2lstr(nt))//trim(PathSep)//"Amb.t0.vtk" @@ -437,55 +339,82 @@ subroutine AWAE_IO_InitGridInfo(InitInp, p, InitOut, errStat, errMsg) origin(1) = InitInp%InputFileData%X0_high(nt) origin(2) = InitInp%InputFileData%Y0_high(nt) origin(3) = InitInp%InputFileData%Z0_high(nt) + dims(1) = InitInp%InputFileData%nX_high + dims(2) = InitInp%InputFileData%nY_high + dims(3) = InitInp%InputFileData%nZ_high gridSpacing(1) = InitInp%InputFileData%dX_high(nt) gridSpacing(2) = InitInp%InputFileData%dY_high(nt) gridSpacing(3) = InitInp%InputFileData%dZ_high(nt) end if - if ( (gridSpacing(1) <= 0.0_ReKi) .or. (gridSpacing(2) <= 0.0_ReKi) .or. (gridSpacing(3) <= 0.0_ReKi) ) & - call SetErrStat ( ErrID_Fatal, 'The high resolution spatial resolution for Turbine '//trim(num2lstr(nt))//' must be greater than zero in each spatial direction. ', errStat, errMsg, RoutineName ) - - InitOut%X0_high(nt) = origin(1) - InitOut%Y0_high(nt) = origin(2) - InitOut%Z0_high(nt) = origin(3) - - InitOut%dX_high(nt) = gridSpacing(1) - InitOut%dY_high(nt) = gridSpacing(2) - InitOut%dZ_high(nt) = gridSpacing(3) + ! --- Checks for grid spacing + call checkHighResSpacing(iWT=nt); if(Failed()) return + + if (nt==1) then + p%nX_high = dims(1) + p%nY_high = dims(2) + p%nZ_high = dims(3) + NumGrid_high = p%nX_high*p%nY_high*p%nZ_high + call AllocAry( p%Grid_high, 3, NumGrid_high, p%NumTurbines, 'Grid_high', errStat2, errMsg2); if(Failed()) return + endif p%X0_high(nt) = origin(1) p%Y0_high(nt) = origin(2) p%Z0_high(nt) = origin(3) p%dX_high(nt) = gridSpacing(1) p%dY_high(nt) = gridSpacing(2) p%dZ_high(nt) = gridSpacing(3) + if ( p%Mod_AmbWind == 1 ) then - ! Using this to make sure dims are >=2 points in each direction, and number of grid points in each direction matches turbine 1 - call HiResWindCheck(0, nt, p%nX_high, p%nY_high, p%nZ_high, p%dX_high(nt), p%dY_high(nt), p%dZ_high(nt), p%X0_high(nt), p%Y0_high(nt), p%Z0_high(nt), dims, gridSpacing, origin, RoutineName, errMsg2, errStat2) - call SetErrStat( ErrStat2, ErrMsg2, errStat, errMsg, RoutineName ) - if (ErrStat >= AbortErrLev) return + ! Using this to make sure dims are >=2 points in each direction, and number of grid points in each direction matches turbine 1. Other tests will be true. + call HiResWindCheck(0, nt, (/p%nX_high, p%nY_high, p%nZ_high/), (/p%dX_high(nt), p%dY_high(nt), p%dZ_high(nt)/), (/p%X0_high(nt), p%Y0_high(nt), p%Z0_high(nt)/), dims, gridSpacing, origin, RoutineName, errMsg2, errStat2); if (Failed()) return end if - - nXYZ_high = 0 - do nz_high=0, p%nZ_high-1 - do ny_high=0, p%nY_high-1 - do nx_high=0, p%nX_high-1 - nXYZ_high = nXYZ_high + 1 - p%Grid_high(1,nXYZ_high,nt) = InitOut%X0_high(nt) + nx_high*InitOut%dX_high(nt) - p%Grid_high(2,nXYZ_high,nt) = InitOut%Y0_high(nt) + ny_high*InitOut%dY_high(nt) - p%Grid_high(3,nXYZ_high,nt) = InitOut%Z0_high(nt) + nz_high*InitOut%dZ_high(nt) - end do - end do - end do + + ! Set coordinates of points in a flat array (Grid_low) + call flatCartGridCoordinates(origin, dims, gridSpacing, p%Grid_high(:,:,nt)) end do - InitOut%nx_high = p%nx_high - InitOut%ny_high = p%ny_high - InitOut%nz_high = p%nz_high - + ! --- Transfer from parameters to InitOut + InitOut%X0_high(:) = p%X0_high(:) + InitOut%Y0_high(:) = p%Y0_high(:) + InitOut%Z0_high(:) = p%Z0_high(:) + InitOut%dX_high(:) = p%dX_high(:) + InitOut%dY_high(:) = p%dY_high(:) + InitOut%dZ_high(:) = p%dZ_high(:) + InitOut%nx_high = p%nx_high + InitOut%ny_high = p%ny_high + InitOut%nz_high = p%nz_high + + ! --- Check low res for all time steps and turbines + if ( (InitInp%InputFileData%ChkWndFiles) .and. (p%Mod_AmbWind == 1) ) then + do n=1,p%NumDT-1 ! We have already checked the first low res time step + + FileName = trim(p%WindFilePath)//trim(PathSep)//"Low"//trim(PathSep)//"Amb.t"//trim(num2lstr(n))//".vtk" + Un = -1 ! Set to force closing of file on return + call ReadVTK_SP_info( FileName, descr, dims, origin, gridSpacing, vecLabel, Un, ErrStat, ErrMsg ) + if (ErrStat >= AbortErrLev) return + + ! verify dims, origin, gridSpacing match the first input file + if ( ( dims(1) .ne. p%nX_low ) .or. ( dims(2) .ne. p%nY_low ) .or. ( dims(3) .ne. p%nZ_low ) ) then + call SetErrStat ( ErrID_Fatal, 'The low resolution grid dimensions for time step '//trim(num2lstr(n))//' do not match time step 0.', errStat, errMsg, RoutineName ) + return + end if + if ( ( origin(1) .ne. InitOut%X0_Low ) .or. ( origin(2) .ne. InitOut%Y0_Low ) .or. ( origin(3) .ne. InitOut%Z0_Low ) ) then + call SetErrStat ( ErrID_Fatal, 'The low resolution grid origins for time step '//trim(num2lstr(n))//' do not match time step 0.', errStat, errMsg, RoutineName ) + return + end if + if ( ( gridSpacing(1) .ne. p%dX_low ) .or. ( gridSpacing(2) .ne. p%dY_low ) .or. ( gridSpacing(3) .ne. p%dZ_low ) ) then + call SetErrStat ( ErrID_Fatal, 'The low resolution grid spacing for time step '//trim(num2lstr(n))//' do not match time step 0.', errStat, errMsg, RoutineName ) + return + end if + + end do + end if + + ! --- Check all high res for all time steps and turbines if ( (InitInp%InputFileData%ChkWndFiles) .and. (p%Mod_AmbWind == 1) ) then do nt=1,p%NumTurbines do n=0,p%NumDT-1 ! We have already checked the first high-res files associated with n=0, but need to check the remaining, so for simplicity of code we will repeat the check on the first file @@ -505,17 +434,45 @@ subroutine AWAE_IO_InitGridInfo(InitInp, p, InitOut, errStat, errMsg) call SetErrStat( ErrStat2, ErrMsg2, errStat, errMsg, RoutineName ) if (ErrStat >= AbortErrLev) return - call HiResWindCheck(nhigh, nt, p%nX_high, p%nY_high, p%nZ_high, p%dX_high(nt), p%dY_high(nt), p%dZ_high(nt), p%X0_high(nt), p%Y0_high(nt), p%Z0_high(nt), dims, gridSpacing, origin, RoutineName, errMsg2, errStat2) - call SetErrStat( ErrStat2, ErrMsg2, errStat, errMsg, RoutineName ) - if (errStat >= AbortErrLev ) return + call HiResWindCheck(nhigh, nt, (/p%nX_high, p%nY_high, p%nZ_high/), (/p%dX_high(nt), p%dY_high(nt), p%dZ_high(nt)/), (/p%X0_high(nt), p%Y0_high(nt), p%Z0_high(nt)/), dims, gridSpacing, origin, RoutineName, errMsg2, errStat2); if (Failed()) return end do end do end do end if - -! End simulated read of low and high res ambient wind files -!============================================================================== + +contains + + logical function Failed() + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function Failed + + subroutine checkHighResSpacing(iWT) + integer(IntKi) :: iWT + real(ReKi) :: gridRatio ! Temporary real for checking WAT resolution + integer(IntKi) :: k + character(ErrMsgLen) :: TmpMsg ! Temporary Error message text for WAT resolution checks + real(ReKi), parameter :: fstretch = 2.0_ReKi ! stretching factor for checking WAT resolution + + if ( (gridSpacing(1) <= 0.0_ReKi) .or. (gridSpacing(2) <= 0.0_ReKi) .or. (gridSpacing(3) <= 0.0_ReKi) ) then + errStat2 = ErrID_Fatal + errMsg2 = 'The high resolution spatial resolution for Turbine '//trim(num2lstr(iWT))//' must be greater than zero in each spatial direction. ' + return + endif + + if (p%WAT_Enabled) then + TmpMsg='Ratio of high res domain resolution to wake added turblence resolution should be between '//trim(Num2LStr(1.0_ReKi/fstretch))//' and '//trim(Num2LStr(fstretch))//', but is ' + do k=2,3 + gridRatio = gridSpacing(k)/gridSpacingWAT(k) + if (gridRatio < 1.0_ReKi/fstretch .or. gridRatio > fstretch) then + errStat2 = ErrID_Fatal + errMsg2 = trim(TmpMsg)//' '//trim(Num2LStr(gridSpacing(k)))//' / '//trim(Num2LStr(gridSpacingWAT(k)))// ' = '//trim(Num2LStr(gridRatio))//' for turbine '//trim(Num2LStr(iWT))//' in X.' + return + endif + enddo + endif + end subroutine checkHighResSpacing end subroutine AWAE_IO_InitGridInfo diff --git a/modules/awae/src/AWAE_Registry.txt b/modules/awae/src/AWAE_Registry.txt index a5680f0dc5..33f909be29 100644 --- a/modules/awae/src/AWAE_Registry.txt +++ b/modules/awae/src/AWAE_Registry.txt @@ -22,8 +22,10 @@ param ^ - INTEGER MeanderMod_Uniform param ^ - INTEGER MeanderMod_TruncJinc - 2 - "Spatial filter model for wake meandering: truncated jinc" - param ^ - INTEGER MeanderMod_WndwdJinc - 3 - "Spatial filter model for wake meandering: windowed jinc" - + # ..... Wind 3D Data ....................................................................................................... -typedef AWAE/AWAE AWAE_HighWindGrid SiKi data {:}{:}{:}{:}{:} - - "UVW components of wind data across the high-res regularly-spaced grid" m/s +typedef AWAE/AWAE AWAE_HighWindGrid SiKi &data {:}{:}{:}{:}{:} - - "UVW components of wind data across the high-res regularly-spaced grid" m/s +typedef AWAE/AWAE AWAE_HighWindGridPtr SiKi *data {:}{:}{:}{:}{:} - - "Pointer to UVW components of wind data across the high-res regularly-spaced grid" m/s # ..... InputFile Data ....................................................................................................... typedef AWAE/AWAE AWAE_InputFileType ReKi dr - - - "Radial increment of radial finite-difference grid [>0.0]" m typedef ^ ^ DbKi dt_low - - - "Low-resolution (FAST.Farm driver/glue code) time step" s @@ -75,6 +77,9 @@ typedef ^ InitInputType AWAE_InputFileType InputFileData - - - "FAST.Fa typedef ^ InitInputType IntKi n_high_low - - - "Number of high-resolution time steps per low" - typedef ^ InitInputType IntKi NumDT - - - "Number of low-resolution (FAST.Farm driver/glue code) time steps" - typedef ^ InitInputType CHARACTER(1024) OutFileRoot - - - "The root name derived from the primary FAST.Farm input file" - +#wake added turbulence (WAT) +typedef ^ ^ Logical WAT_Enabled - .false. - "Is WAT enabled?" - +typedef ^ InitInputType FlowFieldType *WAT_FlowField - - - "Pointer to the InflowWinds flow field data type" - # Define outputs from the initialization routine here: @@ -99,19 +104,23 @@ typedef ^ InitOutputType IntKi nZ_low - - - "Number typedef ^ InitOutputType ReKi X0_low - - - "X-component of the origin of the low-resolution spatial domain" m typedef ^ InitOutputType ReKi Y0_low - - - "Y-component of the origin of the low-resolution spatial domain" m typedef ^ InitOutputType ReKi Z0_low - - - "Z-component of the origin of the low-resolution spatial domain" m +typedef ^ InitOutputType AWAE_HighWindGridPtr Vdist_High {:} - - "Pointers to Wind velocity of disturbed wind (ambient + wakes) across each high-resolution domain around a turbine for each high-resolution step within a low-resolution step" m/s # ..... States .................................................................................................................... # Define continuous (differentiable) states here: -typedef ^ ContinuousStateType InflowWind_ContinuousStateType IfW {:} - - "Dummy IfW continuous states" - +typedef ^ ContinuousStateType InflowWind_ContinuousStateType IfW {:} - - "Dummy IfW continuous states" - # Define discrete (nondifferentiable) states here: -typedef ^ DiscreteStateType InflowWind_DiscreteStateType IfW {:} - - "Dummy IfW discrete states" - +typedef ^ DiscreteStateType InflowWind_DiscreteStateType IfW {:} - - "Dummy IfW discrete states" - +#wake added turbulence +typedef ^ DiscreteStateType ReKi WAT_B_Box {3} - - "Position of passive tracer used to offset the WAT box at each low res time step" m +typedef ^ DiscreteStateType ReKi Ufarm {3} - - "mean velocity of all disk average flow for all turbines in farm" m/s # Define constraint states here: -typedef ^ ConstraintStateType InflowWind_ConstraintStateType IfW {:} - - "Dummy IfW constraint states" - +typedef ^ ConstraintStateType InflowWind_ConstraintStateType IfW {:} - - "Dummy IfW constraint states" - # Define any other states, including integer or logical states here: -typedef ^ OtherStateType InflowWind_OtherStateType IfW {:} - - "Dummy IfW other states" - +typedef ^ OtherStateType InflowWind_OtherStateType IfW {:} - - "Dummy IfW other states" - # ..... Misc/Optimization variables................................................................................................. # Define any data that are used only for efficiency purposes (these variables are not associated with time): @@ -129,30 +138,34 @@ typedef ^ MiscVarType ReKi rhat_e {:}{:}{:} - - "" - typedef ^ MiscVarType ReKi pvec_cs {:}{:}{:} - - "" - typedef ^ MiscVarType ReKi pvec_ce {:}{:}{:} - - "" - # -typedef ^ MiscVarType SiKi outVizXYPlane {:}{:}{:}{:} -- "An array holding the output data for a 2D visualization slice" - -typedef ^ MiscVarType SiKi outVizYZPlane {:}{:}{:}{:} -- "An array holding the output data for a 2D visualization slice" - -typedef ^ MiscVarType SiKi outVizXZPlane {:}{:}{:}{:} -- "An array holding the output data for a 2D visualization slice" - -typedef ^ MiscVarType InflowWind_MiscVarType IfW {:} - - "InflowWind module misc vars" -typedef ^ MiscVarType InflowWind_InputType u_IfW_Low - - - "InflowWind module inputs for the low-resolution grid" -typedef ^ MiscVarType InflowWind_InputType u_IfW_High - - - "InflowWind module inputs for the high-resolution grid" -typedef ^ MiscVarType InflowWind_OutputType y_IfW_Low - - - "InflowWind module outputs for the low-resolution grid" -typedef ^ MiscVarType InflowWind_OutputType y_IfW_High - - - "InflowWind module outputs for the high-resolution grid" +typedef ^ MiscVarType SiKi outVizXYPlane {:}{:}{:}{:} - - "An array holding the output data for a 2D visualization slice" - +typedef ^ MiscVarType SiKi outVizYZPlane {:}{:}{:}{:} - - "An array holding the output data for a 2D visualization slice" - +typedef ^ MiscVarType SiKi outVizXZPlane {:}{:}{:}{:} - - "An array holding the output data for a 2D visualization slice" - +typedef ^ MiscVarType InflowWind_MiscVarType IfW {:} - - "InflowWind module misc vars" - +typedef ^ MiscVarType InflowWind_InputType u_IfW_Low - - - "InflowWind module inputs for the low-resolution grid" - +typedef ^ MiscVarType InflowWind_InputType u_IfW_High - - - "InflowWind module inputs for the high-resolution grid" - +typedef ^ MiscVarType InflowWind_OutputType y_IfW_Low - - - "InflowWind module outputs for the low-resolution grid" - +typedef ^ MiscVarType InflowWind_OutputType y_IfW_High - - - "InflowWind module outputs for the high-resolution grid" - + +#wake added turbulence +typedef ^ MiscVarType ReKi V_amb_low_disk {:}{:} - - "Rotor averaged ambiend wind speed for each wind turbine (3 x nWT)" m/s + # ..... 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 CHARACTER(1024) WindFilePath - - - "Path name to the Root folder containing the wind data files from ABLSolver precursor" - -typedef ^ ParameterType IntKi NumTurbines - - - "Number of wind turbines in the farm [>=1]" - -typedef ^ ParameterType IntKi NumRadii - - - "Number of radii in the radial finite-difference grid [>=2]" - -typedef ^ ParameterType IntKi NumPlanes - - - "Number of wake planes downwind of the rotor where the wake is propagated [>=2]" - -typedef ^ ParameterType ReKi y {:} - - "Horizontal discretization of the wake planes" m -typedef ^ ParameterType ReKi z {:} - - "Vertical discretization of the wake planes" m -typedef ^ ^ IntKi Mod_AmbWind - - - "Ambient wind model {1: high-fidelity precursor in VTK format, 2: InflowWind module}" - -typedef ^ ParameterType IntKi nX_low - - - "Number of low-resolution spatial nodes in X direction" - -typedef ^ ParameterType IntKi nY_low - - - "Number of low-resolution spatial nodes in Y direction" - -typedef ^ ParameterType IntKi nZ_low - - - "Number of low-resolution spatial nodes in Z direction" - -typedef ^ ParameterType IntKi NumGrid_low - - - "Total number of low-resolution spatial nodes" - -typedef ^ ParameterType IntKi n_rp_max - - - "Maximum possible number of points in the polar grid for the wake plane at each rotor" - +typedef ^ ParameterType CHARACTER(1024) WindFilePath - - - "Path name to the Root folder containing the wind data files from ABLSolver precursor" - +typedef ^ ParameterType IntKi NumTurbines - - - "Number of wind turbines in the farm [>=1]" - +typedef ^ ParameterType IntKi NumRadii - - - "Number of radii in the radial finite-difference grid [>=2]" - +typedef ^ ParameterType IntKi NumPlanes - - - "Number of wake planes downwind of the rotor where the wake is propagated [>=2]" - +typedef ^ ParameterType ReKi y {:} - - "Horizontal discretization of the wake planes" m +typedef ^ ParameterType ReKi z {:} - - "Vertical discretization of the wake planes" m +typedef ^ ^ IntKi Mod_AmbWind - - - "Ambient wind model {1: high-fidelity precursor in VTK format, 2: InflowWind module}" - +typedef ^ ParameterType IntKi nX_low - - - "Number of low-resolution spatial nodes in X direction" - +typedef ^ ParameterType IntKi nY_low - - - "Number of low-resolution spatial nodes in Y direction" - +typedef ^ ParameterType IntKi nZ_low - - - "Number of low-resolution spatial nodes in Z direction" - +typedef ^ ParameterType IntKi NumGrid_low - - - "Total number of low-resolution spatial nodes" - +typedef ^ ParameterType IntKi n_rp_max - - - "Maximum possible number of points in the polar grid for the wake plane at each rotor" - typedef ^ ParameterTYpe ReKi dpol - - - "Spatial resolution of the polar grid for each wake plane of each turbine" m typedef ^ ParameterType ReKi dXYZ_low {3} - - "XYZ-components of the spatial increment of the low-resolution domain" m typedef ^ ParameterType ReKi dX_low - - - "The spacing of the low-resolution nodes in X direction" m @@ -167,35 +180,38 @@ typedef ^ ParameterType ReKi Z0_high {:} - - "Z-compone typedef ^ ParameterType ReKi dX_high {:} - - "X-component of the spatial increment of the high-resolution spatial domain for each turbine" m typedef ^ ParameterType ReKi dY_high {:} - - "Y-component of the spatial increment of the high-resolution spatial domain for each turbine" m typedef ^ ParameterType ReKi dZ_high {:} - - "Z-component of the spatial increment of the high-resolution spatial domain for each turbine" m -typedef ^ ParameterType IntKi nX_high - - - "Number of high-resolution spatial nodes in X direction " - -typedef ^ ParameterType IntKi nY_high - - - "Number of high-resolution spatial nodes in Y direction" - -typedef ^ ParameterType IntKi nZ_high - - - "Number of high-resolution spatial nodes in Z direction" - -typedef ^ ParameterType ReKi Grid_low {:}{:} - - "XYZ components (global positions) of the spatial discretization of the low-resolution spatial domain" m -typedef ^ ParameterType ReKi Grid_high {:}{:}{:} - - "XYZ components (global positions) of the spatial discretization of the high-resolution spatial domain for each turbine " m -typedef ^ ParameterType ReKi WT_Position {:}{:} - - "X-Y-Z position of each wind turbine; index 1 = XYZ; index 2 = turbine number" meters -typedef ^ ParameterType IntKi n_high_low - - - "Number of high-resolution time steps per low" - -typedef ^ ParameterType DbKi dt_low - - - "Low-resolution (FAST.Farm driver/glue code) time step" s -typedef ^ ParameterType DbKi dt_high - - - "High-resolution (FAST) time step" s -typedef ^ ParameterType IntKi NumDT - - - "Number of low-resolution (FAST.Farm driver/glue code) time steps" - -typedef ^ ParameterType IntKi Mod_Meander - - - "Spatial filter model for wake meandering" - -typedef ^ ParameterType ReKi C_Meander - - - "Calibrated parameter for wake meandering" - -typedef ^ ParameterType ReKi C_ScaleDiam - - - "Normalized wake volume radius for wake meandering (normalized by the wake diameter)" - -typedef ^ ParameterType IntKi Mod_Projection - - - "Switch to select how the wake plane velocity is projected in AWAE {1: keep all components, 2: project against plane normal} or DEFAULT [DEFAULT=1: if Mod_Wake is 1 or 3, or DEFAULT=2: if Mod_Wake is 2]" -typedef ^ ParameterType InflowWind_ParameterType IfW {:} - - "InflowWind module parameters" - +typedef ^ ParameterType IntKi nX_high - - - "Number of high-resolution spatial nodes in X direction " - +typedef ^ ParameterType IntKi nY_high - - - "Number of high-resolution spatial nodes in Y direction" - +typedef ^ ParameterType IntKi nZ_high - - - "Number of high-resolution spatial nodes in Z direction" - +typedef ^ ParameterType ReKi Grid_low {:}{:} - - "XYZ components (global positions) of the spatial discretization of the low-resolution spatial domain" m +typedef ^ ParameterType ReKi Grid_high {:}{:}{:} - - "XYZ components (global positions) of the spatial discretization of the high-resolution spatial domain for each turbine " m +typedef ^ ParameterType ReKi WT_Position {:}{:} - - "X-Y-Z position of each wind turbine; index 1 = XYZ; index 2 = turbine number" meters +typedef ^ ParameterType IntKi n_high_low - - - "Number of high-resolution time steps per low" - +typedef ^ ParameterType DbKi dt_low - - - "Low-resolution (FAST.Farm driver/glue code) time step" s +typedef ^ ParameterType DbKi dt_high - - - "High-resolution (FAST) time step" s +typedef ^ ParameterType IntKi NumDT - - - "Number of low-resolution (FAST.Farm driver/glue code) time steps" - +typedef ^ ParameterType IntKi Mod_Meander - - - "Spatial filter model for wake meandering" - +typedef ^ ParameterType ReKi C_Meander - - - "Calibrated parameter for wake meandering" - +typedef ^ ParameterType ReKi C_ScaleDiam - - - "Normalized wake volume radius for wake meandering (normalized by the wake diameter)" - +typedef ^ ParameterType IntKi Mod_Projection - - - "Switch to select how the wake plane velocity is projected in AWAE {1: keep all components, 2: project against plane normal} or DEFAULT [DEFAULT=1: if Mod_Wake is 1 or 3, or DEFAULT=2: if Mod_Wake is 2]" +typedef ^ ParameterType InflowWind_ParameterType IfW {:} - - "InflowWind module parameters" - # parameters for output -#typedef ^ ParameterType IntKi NumOuts - - - "Number of parameters in the output list (number of outputs requested)" - -typedef ^ ParameterType IntKi WrDisSkp1 - - - "Number of time steps to skip plus one" - -typedef ^ ParameterType LOGICAL WrDisWind - - - "Write disturbed wind data to /Low/Dis.t.vtk etc.?" - -typedef ^ ParameterType IntKi NOutDisWindXY - - - "Number of XY planes for output of disturbed wind data across the low-resolution domain to /Low/DisXY..t.vtk [0 to 9]" - -typedef ^ ParameterType ReKi OutDisWindZ {:} - - "Z coordinates of XY planes for output of disturbed wind data across the low-resolution domain [1 to NOutDisWindXY]" meters -typedef ^ ParameterType IntKi NOutDisWindYZ - - - "Number of YZ planes for output of disturbed wind data across the low-resolution domain to /Low/DisYZ..t.vtk [0 to 9]" - -typedef ^ ParameterType ReKi OutDisWindX {:} - - "X coordinates of YZ planes for output of disturbed wind data across the low-resolution domain [1 to NOutDisWindYZ]" meters -typedef ^ ParameterType IntKi NOutDisWindXZ - - - "Number of XZ planes for output of disturbed wind data across the low-resolution domain to /Low/DisXZ..t.vtk [0 to 9]" - -typedef ^ ParameterType ReKi OutDisWindY {:} - - "Y coordinates of XZ planes for output of disturbed wind data across the low-resolution domain [1 to NOutDisWindXZ]" meters +#typedef ^ ParameterType IntKi NumOuts - - - "Number of parameters in the output list (number of outputs requested)" - +typedef ^ ParameterType IntKi WrDisSkp1 - - - "Number of time steps to skip plus one" - +typedef ^ ParameterType LOGICAL WrDisWind - - - "Write disturbed wind data to /Low/Dis.t.vtk etc.?" - +typedef ^ ParameterType IntKi NOutDisWindXY - - - "Number of XY planes for output of disturbed wind data across the low-resolution domain to /Low/DisXY..t.vtk [0 to 9]" - +typedef ^ ParameterType ReKi OutDisWindZ {:} - - "Z coordinates of XY planes for output of disturbed wind data across the low-resolution domain [1 to NOutDisWindXY]" meters +typedef ^ ParameterType IntKi NOutDisWindYZ - - - "Number of YZ planes for output of disturbed wind data across the low-resolution domain to /Low/DisYZ..t.vtk [0 to 9]" - +typedef ^ ParameterType ReKi OutDisWindX {:} - - "X coordinates of YZ planes for output of disturbed wind data across the low-resolution domain [1 to NOutDisWindYZ]" meters +typedef ^ ParameterType IntKi NOutDisWindXZ - - - "Number of XZ planes for output of disturbed wind data across the low-resolution domain to /Low/DisXZ..t.vtk [0 to 9]" - +typedef ^ ParameterType ReKi OutDisWindY {:} - - "Y coordinates of XZ planes for output of disturbed wind data across the low-resolution domain [1 to NOutDisWindXZ]" meters typedef ^ ParameterType CHARACTER(1024) OutFileRoot - - - "The root name derived from the primary FAST.Farm input file" - typedef ^ ParameterType CHARACTER(1024) OutFileVTKRoot - - - "The root name for VTK outputs" - typedef ^ ParameterType IntKi VTK_tWidth - - - "Number of characters for VTK timestamp outputs" - -#typedef ^ ParameterType OutParmType OutParam {:} - - "Names and units (and other characteristics) of all requested output parameters" - +#typedef ^ ParameterType OutParmType OutParam {:} - - "Names and units (and other characteristics) of all requested output parameters" - +#wake added turbulence +typedef ^ ParameterType Logical WAT_Enabled - - - "Switch for turning on and off wake-added turbulence" - +typedef ^ ParameterType FlowFieldType *WAT_FlowField - - - "Pointer to the InflowWinds flow field data type" - # ..... Outputs .................................................................................................................... @@ -215,4 +231,4 @@ typedef ^ InputType ReKi Vy_wake {:}{:}{:}{:} - typedef ^ InputType ReKi Vz_wake {:}{:}{:}{:} - - "Transverse nominally vertical wake velocity deficit at wake planes, distributed across the plane, for each turbine (ny,nz,np,nWT)" m/s typedef ^ InputType ReKi D_wake {:}{:} - - "Wake diameters at wake planes for each turbine" m # wake added turbulence (WAT) inputs -typedef ^ InputType ReKi WAT_k_mt {:}{:}{:} - - "Scaling factor k_mt(r,x) for wake-added turbulence" - +typedef ^ InputType ReKi WAT_k {:}{:}{:}{:} - - "Scaling factor for each wake plane and turbine (ny, nz, np, nWT)" - diff --git a/modules/awae/src/AWAE_Types.f90 b/modules/awae/src/AWAE_Types.f90 index c183223332..06e9a5b90a 100644 --- a/modules/awae/src/AWAE_Types.f90 +++ b/modules/awae/src/AWAE_Types.f90 @@ -42,59 +42,66 @@ MODULE AWAE_Types INTEGER(IntKi), PUBLIC, PARAMETER :: MeanderMod_WndwdJinc = 3 ! Spatial filter model for wake meandering: windowed jinc [-] ! ========= AWAE_HighWindGrid ======= TYPE, PUBLIC :: AWAE_HighWindGrid - REAL(SiKi) , DIMENSION(:,:,:,:,:), ALLOCATABLE :: data !< UVW components of wind data across the high-res regularly-spaced grid [m/s] + REAL(SiKi) , DIMENSION(:,:,:,:,:), POINTER :: data => NULL() !< UVW components of wind data across the high-res regularly-spaced grid [m/s] END TYPE AWAE_HighWindGrid ! ======================= +! ========= AWAE_HighWindGridPtr ======= + TYPE, PUBLIC :: AWAE_HighWindGridPtr + REAL(SiKi) , DIMENSION(:,:,:,:,:), POINTER :: data => NULL() !< Pointer to UVW components of wind data across the high-res regularly-spaced grid [m/s] + END TYPE AWAE_HighWindGridPtr +! ======================= ! ========= AWAE_InputFileType ======= TYPE, PUBLIC :: AWAE_InputFileType - REAL(ReKi) :: dr !< Radial increment of radial finite-difference grid [>0.0] [m] - REAL(DbKi) :: dt_low !< Low-resolution (FAST.Farm driver/glue code) time step [s] - INTEGER(IntKi) :: NumTurbines !< Number of wind turbines in the farm [>=1] [-] - INTEGER(IntKi) :: NumRadii !< Number of radii in the radial finite-difference grid [>=2] [-] - INTEGER(IntKi) :: NumPlanes !< Number of wake planes downwind of the rotor where the wake is propagated [>=2] [-] + REAL(ReKi) :: dr = 0.0_ReKi !< Radial increment of radial finite-difference grid [>0.0] [m] + REAL(DbKi) :: dt_low = 0.0_R8Ki !< Low-resolution (FAST.Farm driver/glue code) time step [s] + INTEGER(IntKi) :: NumTurbines = 0_IntKi !< Number of wind turbines in the farm [>=1] [-] + INTEGER(IntKi) :: NumRadii = 0_IntKi !< Number of radii in the radial finite-difference grid [>=2] [-] + INTEGER(IntKi) :: NumPlanes = 0_IntKi !< Number of wake planes downwind of the rotor where the wake is propagated [>=2] [-] CHARACTER(1024) :: WindFilePath !< Path name to the Root folder containing the wind data files from ABLSolver precursor [-] - LOGICAL :: WrDisWind !< Write disturbed wind data to /Low/Dis.t.vtk etc.? [-] - INTEGER(IntKi) :: NOutDisWindXY !< Number of XY planes for output of disturbed wind data across the low-resolution domain to /Low/DisXY..t.vtk [0 to 9] [-] + LOGICAL :: WrDisWind = .false. !< Write disturbed wind data to /Low/Dis.t.vtk etc.? [-] + INTEGER(IntKi) :: NOutDisWindXY = 0_IntKi !< Number of XY planes for output of disturbed wind data across the low-resolution domain to /Low/DisXY..t.vtk [0 to 9] [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: OutDisWindZ !< Z coordinates of XY planes for output of disturbed wind data across the low-resolution domain [1 to NOutDisWindXY] [meters] - INTEGER(IntKi) :: NOutDisWindYZ !< Number of YZ planes for output of disturbed wind data across the low-resolution domain to /Low/DisYZ..t.vtk [0 to 9] [-] + INTEGER(IntKi) :: NOutDisWindYZ = 0_IntKi !< Number of YZ planes for output of disturbed wind data across the low-resolution domain to /Low/DisYZ..t.vtk [0 to 9] [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: OutDisWindX !< X coordinates of YZ planes for output of disturbed wind data across the low-resolution domain [1 to NOutDisWindYZ] [meters] - INTEGER(IntKi) :: NOutDisWindXZ !< Number of XZ planes for output of disturbed wind data across the low-resolution domain to /Low/DisXZ..t.vtk [0 to 9] [-] + INTEGER(IntKi) :: NOutDisWindXZ = 0_IntKi !< Number of XZ planes for output of disturbed wind data across the low-resolution domain to /Low/DisXZ..t.vtk [0 to 9] [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: OutDisWindY !< Y coordinates of XZ planes for output of disturbed wind data across the low-resolution domain [1 to NOutDisWindXZ] [meters] - REAL(DbKi) :: WrDisDT !< The time between vtk outputs [must be a multiple of the low resolution time step] [s] - LOGICAL :: ChkWndFiles !< Check all the ambient wind files for data consistency (flag) [-] - INTEGER(IntKi) :: Mod_Meander !< Spatial filter model for wake meandering {1: uniform, 2: truncated jinc, 3: windowed jinc} [DEFAULT=2] [-] - REAL(ReKi) :: C_Meander !< Calibrated parameter for wake meandering [>=1.0] [DEFAULT=1.9] [-] - INTEGER(IntKi) :: Mod_AmbWind !< Ambient wind model {1: high-fidelity precursor in VTK format, 2: InflowWind module} [-] + REAL(DbKi) :: WrDisDT = 0.0_R8Ki !< The time between vtk outputs [must be a multiple of the low resolution time step] [s] + LOGICAL :: ChkWndFiles = .false. !< Check all the ambient wind files for data consistency (flag) [-] + INTEGER(IntKi) :: Mod_Meander = 0_IntKi !< Spatial filter model for wake meandering {1: uniform, 2: truncated jinc, 3: windowed jinc} [DEFAULT=2] [-] + REAL(ReKi) :: C_Meander = 0.0_ReKi !< Calibrated parameter for wake meandering [>=1.0] [DEFAULT=1.9] [-] + INTEGER(IntKi) :: Mod_AmbWind = 0_IntKi !< Ambient wind model {1: high-fidelity precursor in VTK format, 2: InflowWind module} [-] CHARACTER(1024) :: InflowFile !< Name of file containing InflowWind module input parameters [-] - REAL(DbKi) :: dt_high !< High-resolution (FAST) time step [s] + REAL(DbKi) :: dt_high = 0.0_R8Ki !< High-resolution (FAST) time step [s] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: X0_high !< X-component of the origin of the high-resolution spatial domain for each turbine [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Y0_high !< Y-component of the origin of the high-resolution spatial domain for each turbine [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Z0_high !< Z-component of the origin of the high-resolution spatial domain for each turbine [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: dX_high !< X-component of the spatial increment of the high-resolution spatial domain for each turbine [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: dY_high !< Y-component of the spatial increment of the high-resolution spatial domain for each turbine [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: dZ_high !< Z-component of the spatial increment of the high-resolution spatial domain for each turbine [m] - INTEGER(IntKi) :: nX_high !< Number of high-resolution spatial nodes in X direction [-] - INTEGER(IntKi) :: nY_high !< Number of high-resolution spatial nodes in Y direction [-] - INTEGER(IntKi) :: nZ_high !< Number of high-resolution spatial nodes in Z direction [-] - REAL(ReKi) :: dX_low !< The spacing of the low-resolution nodes in X direction [m] - REAL(ReKi) :: dY_low !< The spacing of the low-resolution nodes in Y direction [m] - REAL(ReKi) :: dZ_low !< The spacing of the low-resolution nodes in Z direction [m] - INTEGER(IntKi) :: nX_low !< Number of low-resolution spatial nodes in X direction [-] - INTEGER(IntKi) :: nY_low !< Number of low-resolution spatial nodes in Y direction [-] - INTEGER(IntKi) :: nZ_low !< Number of low-resolution spatial nodes in Z direction [-] - REAL(ReKi) :: X0_low !< X-component of the origin of the low-resolution spatial domain [m] - REAL(ReKi) :: Y0_low !< Y-component of the origin of the low-resolution spatial domain [m] - REAL(ReKi) :: Z0_low !< Z-component of the origin of the low-resolution spatial domain [m] + INTEGER(IntKi) :: nX_high = 0_IntKi !< Number of high-resolution spatial nodes in X direction [-] + INTEGER(IntKi) :: nY_high = 0_IntKi !< Number of high-resolution spatial nodes in Y direction [-] + INTEGER(IntKi) :: nZ_high = 0_IntKi !< Number of high-resolution spatial nodes in Z direction [-] + REAL(ReKi) :: dX_low = 0.0_ReKi !< The spacing of the low-resolution nodes in X direction [m] + REAL(ReKi) :: dY_low = 0.0_ReKi !< The spacing of the low-resolution nodes in Y direction [m] + REAL(ReKi) :: dZ_low = 0.0_ReKi !< The spacing of the low-resolution nodes in Z direction [m] + INTEGER(IntKi) :: nX_low = 0_IntKi !< Number of low-resolution spatial nodes in X direction [-] + INTEGER(IntKi) :: nY_low = 0_IntKi !< Number of low-resolution spatial nodes in Y direction [-] + INTEGER(IntKi) :: nZ_low = 0_IntKi !< Number of low-resolution spatial nodes in Z direction [-] + REAL(ReKi) :: X0_low = 0.0_ReKi !< X-component of the origin of the low-resolution spatial domain [m] + REAL(ReKi) :: Y0_low = 0.0_ReKi !< Y-component of the origin of the low-resolution spatial domain [m] + REAL(ReKi) :: Z0_low = 0.0_ReKi !< Z-component of the origin of the low-resolution spatial domain [m] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: WT_Position !< X-Y-Z position of each wind turbine; index 1 = XYZ; index 2 = turbine number [meters] - INTEGER(IntKi) :: Mod_Projection !< Switch to select how the wake plane velocity is projected in AWAE {1: keep all components, 2: project against plane normal} or DEFAULT [DEFAULT=1: if Mod_Wake is 1 or 3, or DEFAULT=2: if Mod_Wake is 2] [-] + INTEGER(IntKi) :: Mod_Projection = 0_IntKi !< Switch to select how the wake plane velocity is projected in AWAE {1: keep all components, 2: project against plane normal} or DEFAULT [DEFAULT=1: if Mod_Wake is 1 or 3, or DEFAULT=2: if Mod_Wake is 2] [-] END TYPE AWAE_InputFileType ! ======================= ! ========= AWAE_InitInputType ======= TYPE, PUBLIC :: AWAE_InitInputType TYPE(AWAE_InputFileType) :: InputFileData !< FAST.Farm input-file data for AWAE module [-] - INTEGER(IntKi) :: n_high_low !< Number of high-resolution time steps per low [-] - INTEGER(IntKi) :: NumDT !< Number of low-resolution (FAST.Farm driver/glue code) time steps [-] + INTEGER(IntKi) :: n_high_low = 0_IntKi !< Number of high-resolution time steps per low [-] + INTEGER(IntKi) :: NumDT = 0_IntKi !< Number of low-resolution (FAST.Farm driver/glue code) time steps [-] CHARACTER(1024) :: OutFileRoot !< The root name derived from the primary FAST.Farm input file [-] + LOGICAL :: WAT_Enabled = .false. !< Is WAT enabled? [-] + TYPE(FlowFieldType) , POINTER :: WAT_FlowField => NULL() !< Pointer to the InflowWinds flow field data type [-] END TYPE AWAE_InitInputType ! ======================= ! ========= AWAE_InitOutputType ======= @@ -106,18 +113,19 @@ MODULE AWAE_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: dX_high !< X-component of the spatial increment of the high-resolution spatial domain for each turbine [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: dY_high !< Y-component of the spatial increment of the high-resolution spatial domain for each turbine [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: dZ_high !< Z-component of the spatial increment of the high-resolution spatial domain for each turbine [m] - INTEGER(IntKi) :: nX_high !< Number of high-resolution spatial nodes in X direction [-] - INTEGER(IntKi) :: nY_high !< Number of high-resolution spatial nodes in Y direction [-] - INTEGER(IntKi) :: nZ_high !< Number of high-resolution spatial nodes in Z direction [-] - REAL(ReKi) :: dX_low !< The spacing of the low-resolution nodes in X direction [m] - REAL(ReKi) :: dY_low !< The spacing of the low-resolution nodes in Y direction [m] - REAL(ReKi) :: dZ_low !< The spacing of the low-resolution nodes in Z direction [m] - INTEGER(IntKi) :: nX_low !< Number of low-resolution spatial nodes in X direction [-] - INTEGER(IntKi) :: nY_low !< Number of low-resolution spatial nodes in Y direction [-] - INTEGER(IntKi) :: nZ_low !< Number of low-resolution spatial nodes in Z direction [-] - REAL(ReKi) :: X0_low !< X-component of the origin of the low-resolution spatial domain [m] - REAL(ReKi) :: Y0_low !< Y-component of the origin of the low-resolution spatial domain [m] - REAL(ReKi) :: Z0_low !< Z-component of the origin of the low-resolution spatial domain [m] + INTEGER(IntKi) :: nX_high = 0_IntKi !< Number of high-resolution spatial nodes in X direction [-] + INTEGER(IntKi) :: nY_high = 0_IntKi !< Number of high-resolution spatial nodes in Y direction [-] + INTEGER(IntKi) :: nZ_high = 0_IntKi !< Number of high-resolution spatial nodes in Z direction [-] + REAL(ReKi) :: dX_low = 0.0_ReKi !< The spacing of the low-resolution nodes in X direction [m] + REAL(ReKi) :: dY_low = 0.0_ReKi !< The spacing of the low-resolution nodes in Y direction [m] + REAL(ReKi) :: dZ_low = 0.0_ReKi !< The spacing of the low-resolution nodes in Z direction [m] + INTEGER(IntKi) :: nX_low = 0_IntKi !< Number of low-resolution spatial nodes in X direction [-] + INTEGER(IntKi) :: nY_low = 0_IntKi !< Number of low-resolution spatial nodes in Y direction [-] + INTEGER(IntKi) :: nZ_low = 0_IntKi !< Number of low-resolution spatial nodes in Z direction [-] + REAL(ReKi) :: X0_low = 0.0_ReKi !< X-component of the origin of the low-resolution spatial domain [m] + REAL(ReKi) :: Y0_low = 0.0_ReKi !< Y-component of the origin of the low-resolution spatial domain [m] + REAL(ReKi) :: Z0_low = 0.0_ReKi !< Z-component of the origin of the low-resolution spatial domain [m] + TYPE(AWAE_HighWindGridPtr) , DIMENSION(:), ALLOCATABLE :: Vdist_High !< Pointers to Wind velocity of disturbed wind (ambient + wakes) across each high-resolution domain around a turbine for each high-resolution step within a low-resolution step [m/s] END TYPE AWAE_InitOutputType ! ======================= ! ========= AWAE_ContinuousStateType ======= @@ -128,6 +136,8 @@ MODULE AWAE_Types ! ========= AWAE_DiscreteStateType ======= TYPE, PUBLIC :: AWAE_DiscreteStateType TYPE(InflowWind_DiscreteStateType) , DIMENSION(:), ALLOCATABLE :: IfW !< Dummy IfW discrete states [-] + REAL(ReKi) , DIMENSION(1:3) :: WAT_B_Box = 0.0_ReKi !< Position of passive tracer used to offset the WAT box at each low res time step [m] + REAL(ReKi) , DIMENSION(1:3) :: Ufarm = 0.0_ReKi !< mean velocity of all disk average flow for all turbines in farm [m/s] END TYPE AWAE_DiscreteStateType ! ======================= ! ========= AWAE_ConstraintStateType ======= @@ -137,7 +147,7 @@ MODULE AWAE_Types ! ======================= ! ========= AWAE_OtherStateType ======= TYPE, PUBLIC :: AWAE_OtherStateType - TYPE(InflowWind_OtherStateType) , DIMENSION(:), ALLOCATABLE :: IfW !< Dummy IfW other states [-] + TYPE(InflowWind_OtherStateType) , DIMENSION(:), ALLOCATABLE :: IfW !< Dummy IfW other states [-] END TYPE AWAE_OtherStateType ! ======================= ! ========= AWAE_MiscVarType ======= @@ -154,70 +164,73 @@ MODULE AWAE_Types REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: rhat_e !< [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: pvec_cs !< [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: pvec_ce !< [-] - REAL(SiKi) , DIMENSION(:,:,:,:), ALLOCATABLE :: outVizXYPlane - REAL(SiKi) , DIMENSION(:,:,:,:), ALLOCATABLE :: outVizYZPlane - REAL(SiKi) , DIMENSION(:,:,:,:), ALLOCATABLE :: outVizXZPlane + REAL(SiKi) , DIMENSION(:,:,:,:), ALLOCATABLE :: outVizXYPlane !< An array holding the output data for a 2D visualization slice [-] + REAL(SiKi) , DIMENSION(:,:,:,:), ALLOCATABLE :: outVizYZPlane !< An array holding the output data for a 2D visualization slice [-] + REAL(SiKi) , DIMENSION(:,:,:,:), ALLOCATABLE :: outVizXZPlane !< An array holding the output data for a 2D visualization slice [-] TYPE(InflowWind_MiscVarType) , DIMENSION(:), ALLOCATABLE :: IfW !< InflowWind module misc vars [-] TYPE(InflowWind_InputType) :: u_IfW_Low !< InflowWind module inputs for the low-resolution grid [-] TYPE(InflowWind_InputType) :: u_IfW_High !< InflowWind module inputs for the high-resolution grid [-] TYPE(InflowWind_OutputType) :: y_IfW_Low !< InflowWind module outputs for the low-resolution grid [-] TYPE(InflowWind_OutputType) :: y_IfW_High !< InflowWind module outputs for the high-resolution grid [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: V_amb_low_disk !< Rotor averaged ambiend wind speed for each wind turbine (3 x nWT) [m/s] END TYPE AWAE_MiscVarType ! ======================= ! ========= AWAE_ParameterType ======= TYPE, PUBLIC :: AWAE_ParameterType CHARACTER(1024) :: WindFilePath !< Path name to the Root folder containing the wind data files from ABLSolver precursor [-] - INTEGER(IntKi) :: NumTurbines !< Number of wind turbines in the farm [>=1] [-] - INTEGER(IntKi) :: NumRadii !< Number of radii in the radial finite-difference grid [>=2] [-] - INTEGER(IntKi) :: NumPlanes !< Number of wake planes downwind of the rotor where the wake is propagated [>=2] [-] + INTEGER(IntKi) :: NumTurbines = 0_IntKi !< Number of wind turbines in the farm [>=1] [-] + INTEGER(IntKi) :: NumRadii = 0_IntKi !< Number of radii in the radial finite-difference grid [>=2] [-] + INTEGER(IntKi) :: NumPlanes = 0_IntKi !< Number of wake planes downwind of the rotor where the wake is propagated [>=2] [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: y !< Horizontal discretization of the wake planes [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: z !< Vertical discretization of the wake planes [m] - INTEGER(IntKi) :: Mod_AmbWind !< Ambient wind model {1: high-fidelity precursor in VTK format, 2: InflowWind module} [-] - INTEGER(IntKi) :: nX_low !< Number of low-resolution spatial nodes in X direction [-] - INTEGER(IntKi) :: nY_low !< Number of low-resolution spatial nodes in Y direction [-] - INTEGER(IntKi) :: nZ_low !< Number of low-resolution spatial nodes in Z direction [-] - INTEGER(IntKi) :: NumGrid_low !< Total number of low-resolution spatial nodes [-] - INTEGER(IntKi) :: n_rp_max !< Maximum possible number of points in the polar grid for the wake plane at each rotor [-] - REAL(ReKi) :: dpol !< Spatial resolution of the polar grid for each wake plane of each turbine [m] - REAL(ReKi) , DIMENSION(1:3) :: dXYZ_low !< XYZ-components of the spatial increment of the low-resolution domain [m] - REAL(ReKi) :: dX_low !< The spacing of the low-resolution nodes in X direction [m] - REAL(ReKi) :: dY_low !< The spacing of the low-resolution nodes in Y direction [m] - REAL(ReKi) :: dZ_low !< The spacing of the low-resolution nodes in Z direction [m] - REAL(ReKi) :: X0_low !< X-component of the origin of the low-resolution spatial domain [m] - REAL(ReKi) :: Y0_low !< Y-component of the origin of the low-resolution spatial domain [m] - REAL(ReKi) :: Z0_low !< Z-component of the origin of the low-resolution spatial domain [m] + INTEGER(IntKi) :: Mod_AmbWind = 0_IntKi !< Ambient wind model {1: high-fidelity precursor in VTK format, 2: InflowWind module} [-] + INTEGER(IntKi) :: nX_low = 0_IntKi !< Number of low-resolution spatial nodes in X direction [-] + INTEGER(IntKi) :: nY_low = 0_IntKi !< Number of low-resolution spatial nodes in Y direction [-] + INTEGER(IntKi) :: nZ_low = 0_IntKi !< Number of low-resolution spatial nodes in Z direction [-] + INTEGER(IntKi) :: NumGrid_low = 0_IntKi !< Total number of low-resolution spatial nodes [-] + INTEGER(IntKi) :: n_rp_max = 0_IntKi !< Maximum possible number of points in the polar grid for the wake plane at each rotor [-] + REAL(ReKi) :: dpol = 0.0_ReKi !< Spatial resolution of the polar grid for each wake plane of each turbine [m] + REAL(ReKi) , DIMENSION(1:3) :: dXYZ_low = 0.0_ReKi !< XYZ-components of the spatial increment of the low-resolution domain [m] + REAL(ReKi) :: dX_low = 0.0_ReKi !< The spacing of the low-resolution nodes in X direction [m] + REAL(ReKi) :: dY_low = 0.0_ReKi !< The spacing of the low-resolution nodes in Y direction [m] + REAL(ReKi) :: dZ_low = 0.0_ReKi !< The spacing of the low-resolution nodes in Z direction [m] + REAL(ReKi) :: X0_low = 0.0_ReKi !< X-component of the origin of the low-resolution spatial domain [m] + REAL(ReKi) :: Y0_low = 0.0_ReKi !< Y-component of the origin of the low-resolution spatial domain [m] + REAL(ReKi) :: Z0_low = 0.0_ReKi !< Z-component of the origin of the low-resolution spatial domain [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: X0_high !< X-component of the origin of the high-resolution spatial domain for each turbine [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Y0_high !< Y-component of the origin of the high-resolution spatial domain for each turbine [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Z0_high !< Z-component of the origin of the high-resolution spatial domain for each turbine [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: dX_high !< X-component of the spatial increment of the high-resolution spatial domain for each turbine [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: dY_high !< Y-component of the spatial increment of the high-resolution spatial domain for each turbine [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: dZ_high !< Z-component of the spatial increment of the high-resolution spatial domain for each turbine [m] - INTEGER(IntKi) :: nX_high !< Number of high-resolution spatial nodes in X direction [-] - INTEGER(IntKi) :: nY_high !< Number of high-resolution spatial nodes in Y direction [-] - INTEGER(IntKi) :: nZ_high !< Number of high-resolution spatial nodes in Z direction [-] + INTEGER(IntKi) :: nX_high = 0_IntKi !< Number of high-resolution spatial nodes in X direction [-] + INTEGER(IntKi) :: nY_high = 0_IntKi !< Number of high-resolution spatial nodes in Y direction [-] + INTEGER(IntKi) :: nZ_high = 0_IntKi !< Number of high-resolution spatial nodes in Z direction [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Grid_low !< XYZ components (global positions) of the spatial discretization of the low-resolution spatial domain [m] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: Grid_high !< XYZ components (global positions) of the spatial discretization of the high-resolution spatial domain for each turbine [m] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: WT_Position !< X-Y-Z position of each wind turbine; index 1 = XYZ; index 2 = turbine number [meters] - INTEGER(IntKi) :: n_high_low !< Number of high-resolution time steps per low [-] - REAL(DbKi) :: dt_low !< Low-resolution (FAST.Farm driver/glue code) time step [s] - REAL(DbKi) :: dt_high !< High-resolution (FAST) time step [s] - INTEGER(IntKi) :: NumDT !< Number of low-resolution (FAST.Farm driver/glue code) time steps [-] - INTEGER(IntKi) :: Mod_Meander !< Spatial filter model for wake meandering [-] - REAL(ReKi) :: C_Meander !< Calibrated parameter for wake meandering [-] - REAL(ReKi) :: C_ScaleDiam !< Normalized wake volume radius for wake meandering (normalized by the wake diameter) [-] - INTEGER(IntKi) :: Mod_Projection !< Switch to select how the wake plane velocity is projected in AWAE {1: keep all components, 2: project against plane normal} or DEFAULT [DEFAULT=1: if Mod_Wake is 1 or 3, or DEFAULT=2: if Mod_Wake is 2] [-] + INTEGER(IntKi) :: n_high_low = 0_IntKi !< Number of high-resolution time steps per low [-] + REAL(DbKi) :: dt_low = 0.0_R8Ki !< Low-resolution (FAST.Farm driver/glue code) time step [s] + REAL(DbKi) :: dt_high = 0.0_R8Ki !< High-resolution (FAST) time step [s] + INTEGER(IntKi) :: NumDT = 0_IntKi !< Number of low-resolution (FAST.Farm driver/glue code) time steps [-] + INTEGER(IntKi) :: Mod_Meander = 0_IntKi !< Spatial filter model for wake meandering [-] + REAL(ReKi) :: C_Meander = 0.0_ReKi !< Calibrated parameter for wake meandering [-] + REAL(ReKi) :: C_ScaleDiam = 0.0_ReKi !< Normalized wake volume radius for wake meandering (normalized by the wake diameter) [-] + INTEGER(IntKi) :: Mod_Projection = 0_IntKi !< Switch to select how the wake plane velocity is projected in AWAE {1: keep all components, 2: project against plane normal} or DEFAULT [DEFAULT=1: if Mod_Wake is 1 or 3, or DEFAULT=2: if Mod_Wake is 2] [-] TYPE(InflowWind_ParameterType) , DIMENSION(:), ALLOCATABLE :: IfW !< InflowWind module parameters [-] - INTEGER(IntKi) :: WrDisSkp1 !< Number of time steps to skip plus one [-] - LOGICAL :: WrDisWind !< Write disturbed wind data to /Low/Dis.t.vtk etc.? [-] - INTEGER(IntKi) :: NOutDisWindXY !< Number of XY planes for output of disturbed wind data across the low-resolution domain to /Low/DisXY..t.vtk [0 to 9] [-] + INTEGER(IntKi) :: WrDisSkp1 = 0_IntKi !< Number of time steps to skip plus one [-] + LOGICAL :: WrDisWind = .false. !< Write disturbed wind data to /Low/Dis.t.vtk etc.? [-] + INTEGER(IntKi) :: NOutDisWindXY = 0_IntKi !< Number of XY planes for output of disturbed wind data across the low-resolution domain to /Low/DisXY..t.vtk [0 to 9] [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: OutDisWindZ !< Z coordinates of XY planes for output of disturbed wind data across the low-resolution domain [1 to NOutDisWindXY] [meters] - INTEGER(IntKi) :: NOutDisWindYZ !< Number of YZ planes for output of disturbed wind data across the low-resolution domain to /Low/DisYZ..t.vtk [0 to 9] [-] + INTEGER(IntKi) :: NOutDisWindYZ = 0_IntKi !< Number of YZ planes for output of disturbed wind data across the low-resolution domain to /Low/DisYZ..t.vtk [0 to 9] [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: OutDisWindX !< X coordinates of YZ planes for output of disturbed wind data across the low-resolution domain [1 to NOutDisWindYZ] [meters] - INTEGER(IntKi) :: NOutDisWindXZ !< Number of XZ planes for output of disturbed wind data across the low-resolution domain to /Low/DisXZ..t.vtk [0 to 9] [-] + INTEGER(IntKi) :: NOutDisWindXZ = 0_IntKi !< Number of XZ planes for output of disturbed wind data across the low-resolution domain to /Low/DisXZ..t.vtk [0 to 9] [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: OutDisWindY !< Y coordinates of XZ planes for output of disturbed wind data across the low-resolution domain [1 to NOutDisWindXZ] [meters] CHARACTER(1024) :: OutFileRoot !< The root name derived from the primary FAST.Farm input file [-] CHARACTER(1024) :: OutFileVTKRoot !< The root name for VTK outputs [-] - INTEGER(IntKi) :: VTK_tWidth !< Number of characters for VTK timestamp outputs [-] + INTEGER(IntKi) :: VTK_tWidth = 0_IntKi !< Number of characters for VTK timestamp outputs [-] + LOGICAL :: WAT_Enabled = .false. !< Switch for turning on and off wake-added turbulence [-] + TYPE(FlowFieldType) , POINTER :: WAT_FlowField => NULL() !< Pointer to the InflowWinds flow field data type [-] END TYPE AWAE_ParameterType ! ======================= ! ========= AWAE_OutputType ======= @@ -236,7447 +249,2350 @@ MODULE AWAE_Types REAL(ReKi) , DIMENSION(:,:,:,:), ALLOCATABLE :: Vy_wake !< Transverse horizonal wake velocity deficit at wake planes, distributed across the plane, for each turbine (ny,nz,np,nWT) [m/s] REAL(ReKi) , DIMENSION(:,:,:,:), ALLOCATABLE :: Vz_wake !< Transverse nominally vertical wake velocity deficit at wake planes, distributed across the plane, for each turbine (ny,nz,np,nWT) [m/s] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: D_wake !< Wake diameters at wake planes for each turbine [m] - REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: WAT_k_mt !< Scaling factor k_mt(r,x) for wake-added turbulence [-] + REAL(ReKi) , DIMENSION(:,:,:,:), ALLOCATABLE :: WAT_k !< Scaling factor for each wake plane and turbine (ny, nz, np, nWT) [-] END TYPE AWAE_InputType ! ======================= CONTAINS - SUBROUTINE AWAE_CopyHighWindGrid( SrcHighWindGridData, DstHighWindGridData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AWAE_HighWindGrid), INTENT(IN) :: SrcHighWindGridData - TYPE(AWAE_HighWindGrid), INTENT(INOUT) :: DstHighWindGridData - 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) :: i5, i5_l, i5_u ! bounds (upper/lower) for an array dimension 5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AWAE_CopyHighWindGrid' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcHighWindGridData%data)) THEN - i1_l = LBOUND(SrcHighWindGridData%data,1) - i1_u = UBOUND(SrcHighWindGridData%data,1) - i2_l = LBOUND(SrcHighWindGridData%data,2) - i2_u = UBOUND(SrcHighWindGridData%data,2) - i3_l = LBOUND(SrcHighWindGridData%data,3) - i3_u = UBOUND(SrcHighWindGridData%data,3) - i4_l = LBOUND(SrcHighWindGridData%data,4) - i4_u = UBOUND(SrcHighWindGridData%data,4) - i5_l = LBOUND(SrcHighWindGridData%data,5) - i5_u = UBOUND(SrcHighWindGridData%data,5) - IF (.NOT. ALLOCATED(DstHighWindGridData%data)) THEN - ALLOCATE(DstHighWindGridData%data(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u,i5_l:i5_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstHighWindGridData%data.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstHighWindGridData%data = SrcHighWindGridData%data -ENDIF - END SUBROUTINE AWAE_CopyHighWindGrid - - SUBROUTINE AWAE_DestroyHighWindGrid( HighWindGridData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(AWAE_HighWindGrid), INTENT(INOUT) :: HighWindGridData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AWAE_DestroyHighWindGrid' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(HighWindGridData%data)) THEN - DEALLOCATE(HighWindGridData%data) -ENDIF - END SUBROUTINE AWAE_DestroyHighWindGrid - - SUBROUTINE AWAE_PackHighWindGrid( 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(AWAE_HighWindGrid), 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 = 'AWAE_PackHighWindGrid' - ! 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 ! data allocated yes/no - IF ( ALLOCATED(InData%data) ) THEN - Int_BufSz = Int_BufSz + 2*5 ! data upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%data) ! data - 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%data) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%data,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%data,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%data,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%data,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%data,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%data,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%data,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%data,4) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%data,5) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%data,5) - Int_Xferred = Int_Xferred + 2 - - DO i5 = LBOUND(InData%data,5), UBOUND(InData%data,5) - DO i4 = LBOUND(InData%data,4), UBOUND(InData%data,4) - DO i3 = LBOUND(InData%data,3), UBOUND(InData%data,3) - DO i2 = LBOUND(InData%data,2), UBOUND(InData%data,2) - DO i1 = LBOUND(InData%data,1), UBOUND(InData%data,1) - ReKiBuf(Re_Xferred) = InData%data(i1,i2,i3,i4,i5) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END DO - END IF - END SUBROUTINE AWAE_PackHighWindGrid - - SUBROUTINE AWAE_UnPackHighWindGrid( 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(AWAE_HighWindGrid), 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) :: i5, i5_l, i5_u ! bounds (upper/lower) for an array dimension 5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AWAE_UnPackHighWindGrid' - ! 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 ! data not allocated - Int_Xferred = Int_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 - i5_l = IntKiBuf( Int_Xferred ) - i5_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%data)) DEALLOCATE(OutData%data) - ALLOCATE(OutData%data(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u,i5_l:i5_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%data.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i5 = LBOUND(OutData%data,5), UBOUND(OutData%data,5) - DO i4 = LBOUND(OutData%data,4), UBOUND(OutData%data,4) - DO i3 = LBOUND(OutData%data,3), UBOUND(OutData%data,3) - DO i2 = LBOUND(OutData%data,2), UBOUND(OutData%data,2) - DO i1 = LBOUND(OutData%data,1), UBOUND(OutData%data,1) - OutData%data(i1,i2,i3,i4,i5) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END DO - END IF - END SUBROUTINE AWAE_UnPackHighWindGrid - - SUBROUTINE AWAE_CopyInputFileType( SrcInputFileTypeData, DstInputFileTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AWAE_InputFileType), INTENT(IN) :: SrcInputFileTypeData - TYPE(AWAE_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 = 'AWAE_CopyInputFileType' -! +subroutine AWAE_CopyHighWindGrid(SrcHighWindGridData, DstHighWindGridData, CtrlCode, ErrStat, ErrMsg) + type(AWAE_HighWindGrid), intent(in) :: SrcHighWindGridData + type(AWAE_HighWindGrid), intent(inout) :: DstHighWindGridData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(5), UB(5) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'AWAE_CopyHighWindGrid' ErrStat = ErrID_None - ErrMsg = "" - DstInputFileTypeData%dr = SrcInputFileTypeData%dr - DstInputFileTypeData%dt_low = SrcInputFileTypeData%dt_low - DstInputFileTypeData%NumTurbines = SrcInputFileTypeData%NumTurbines - DstInputFileTypeData%NumRadii = SrcInputFileTypeData%NumRadii - DstInputFileTypeData%NumPlanes = SrcInputFileTypeData%NumPlanes - DstInputFileTypeData%WindFilePath = SrcInputFileTypeData%WindFilePath - DstInputFileTypeData%WrDisWind = SrcInputFileTypeData%WrDisWind - DstInputFileTypeData%NOutDisWindXY = SrcInputFileTypeData%NOutDisWindXY -IF (ALLOCATED(SrcInputFileTypeData%OutDisWindZ)) THEN - i1_l = LBOUND(SrcInputFileTypeData%OutDisWindZ,1) - i1_u = UBOUND(SrcInputFileTypeData%OutDisWindZ,1) - IF (.NOT. ALLOCATED(DstInputFileTypeData%OutDisWindZ)) THEN - ALLOCATE(DstInputFileTypeData%OutDisWindZ(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileTypeData%OutDisWindZ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileTypeData%OutDisWindZ = SrcInputFileTypeData%OutDisWindZ -ENDIF - DstInputFileTypeData%NOutDisWindYZ = SrcInputFileTypeData%NOutDisWindYZ -IF (ALLOCATED(SrcInputFileTypeData%OutDisWindX)) THEN - i1_l = LBOUND(SrcInputFileTypeData%OutDisWindX,1) - i1_u = UBOUND(SrcInputFileTypeData%OutDisWindX,1) - IF (.NOT. ALLOCATED(DstInputFileTypeData%OutDisWindX)) THEN - ALLOCATE(DstInputFileTypeData%OutDisWindX(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileTypeData%OutDisWindX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileTypeData%OutDisWindX = SrcInputFileTypeData%OutDisWindX -ENDIF - DstInputFileTypeData%NOutDisWindXZ = SrcInputFileTypeData%NOutDisWindXZ -IF (ALLOCATED(SrcInputFileTypeData%OutDisWindY)) THEN - i1_l = LBOUND(SrcInputFileTypeData%OutDisWindY,1) - i1_u = UBOUND(SrcInputFileTypeData%OutDisWindY,1) - IF (.NOT. ALLOCATED(DstInputFileTypeData%OutDisWindY)) THEN - ALLOCATE(DstInputFileTypeData%OutDisWindY(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileTypeData%OutDisWindY.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileTypeData%OutDisWindY = SrcInputFileTypeData%OutDisWindY -ENDIF - DstInputFileTypeData%WrDisDT = SrcInputFileTypeData%WrDisDT - DstInputFileTypeData%ChkWndFiles = SrcInputFileTypeData%ChkWndFiles - DstInputFileTypeData%Mod_Meander = SrcInputFileTypeData%Mod_Meander - DstInputFileTypeData%C_Meander = SrcInputFileTypeData%C_Meander - DstInputFileTypeData%Mod_AmbWind = SrcInputFileTypeData%Mod_AmbWind - DstInputFileTypeData%InflowFile = SrcInputFileTypeData%InflowFile - DstInputFileTypeData%dt_high = SrcInputFileTypeData%dt_high -IF (ALLOCATED(SrcInputFileTypeData%X0_high)) THEN - i1_l = LBOUND(SrcInputFileTypeData%X0_high,1) - i1_u = UBOUND(SrcInputFileTypeData%X0_high,1) - IF (.NOT. ALLOCATED(DstInputFileTypeData%X0_high)) THEN - ALLOCATE(DstInputFileTypeData%X0_high(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileTypeData%X0_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileTypeData%X0_high = SrcInputFileTypeData%X0_high -ENDIF -IF (ALLOCATED(SrcInputFileTypeData%Y0_high)) THEN - i1_l = LBOUND(SrcInputFileTypeData%Y0_high,1) - i1_u = UBOUND(SrcInputFileTypeData%Y0_high,1) - IF (.NOT. ALLOCATED(DstInputFileTypeData%Y0_high)) THEN - ALLOCATE(DstInputFileTypeData%Y0_high(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileTypeData%Y0_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileTypeData%Y0_high = SrcInputFileTypeData%Y0_high -ENDIF -IF (ALLOCATED(SrcInputFileTypeData%Z0_high)) THEN - i1_l = LBOUND(SrcInputFileTypeData%Z0_high,1) - i1_u = UBOUND(SrcInputFileTypeData%Z0_high,1) - IF (.NOT. ALLOCATED(DstInputFileTypeData%Z0_high)) THEN - ALLOCATE(DstInputFileTypeData%Z0_high(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileTypeData%Z0_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileTypeData%Z0_high = SrcInputFileTypeData%Z0_high -ENDIF -IF (ALLOCATED(SrcInputFileTypeData%dX_high)) THEN - i1_l = LBOUND(SrcInputFileTypeData%dX_high,1) - i1_u = UBOUND(SrcInputFileTypeData%dX_high,1) - IF (.NOT. ALLOCATED(DstInputFileTypeData%dX_high)) THEN - ALLOCATE(DstInputFileTypeData%dX_high(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileTypeData%dX_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileTypeData%dX_high = SrcInputFileTypeData%dX_high -ENDIF -IF (ALLOCATED(SrcInputFileTypeData%dY_high)) THEN - i1_l = LBOUND(SrcInputFileTypeData%dY_high,1) - i1_u = UBOUND(SrcInputFileTypeData%dY_high,1) - IF (.NOT. ALLOCATED(DstInputFileTypeData%dY_high)) THEN - ALLOCATE(DstInputFileTypeData%dY_high(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileTypeData%dY_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileTypeData%dY_high = SrcInputFileTypeData%dY_high -ENDIF -IF (ALLOCATED(SrcInputFileTypeData%dZ_high)) THEN - i1_l = LBOUND(SrcInputFileTypeData%dZ_high,1) - i1_u = UBOUND(SrcInputFileTypeData%dZ_high,1) - IF (.NOT. ALLOCATED(DstInputFileTypeData%dZ_high)) THEN - ALLOCATE(DstInputFileTypeData%dZ_high(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileTypeData%dZ_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileTypeData%dZ_high = SrcInputFileTypeData%dZ_high -ENDIF - DstInputFileTypeData%nX_high = SrcInputFileTypeData%nX_high - DstInputFileTypeData%nY_high = SrcInputFileTypeData%nY_high - DstInputFileTypeData%nZ_high = SrcInputFileTypeData%nZ_high - DstInputFileTypeData%dX_low = SrcInputFileTypeData%dX_low - DstInputFileTypeData%dY_low = SrcInputFileTypeData%dY_low - DstInputFileTypeData%dZ_low = SrcInputFileTypeData%dZ_low - DstInputFileTypeData%nX_low = SrcInputFileTypeData%nX_low - DstInputFileTypeData%nY_low = SrcInputFileTypeData%nY_low - DstInputFileTypeData%nZ_low = SrcInputFileTypeData%nZ_low - DstInputFileTypeData%X0_low = SrcInputFileTypeData%X0_low - DstInputFileTypeData%Y0_low = SrcInputFileTypeData%Y0_low - DstInputFileTypeData%Z0_low = SrcInputFileTypeData%Z0_low -IF (ALLOCATED(SrcInputFileTypeData%WT_Position)) THEN - i1_l = LBOUND(SrcInputFileTypeData%WT_Position,1) - i1_u = UBOUND(SrcInputFileTypeData%WT_Position,1) - i2_l = LBOUND(SrcInputFileTypeData%WT_Position,2) - i2_u = UBOUND(SrcInputFileTypeData%WT_Position,2) - IF (.NOT. ALLOCATED(DstInputFileTypeData%WT_Position)) THEN - ALLOCATE(DstInputFileTypeData%WT_Position(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileTypeData%WT_Position.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileTypeData%WT_Position = SrcInputFileTypeData%WT_Position -ENDIF - DstInputFileTypeData%Mod_Projection = SrcInputFileTypeData%Mod_Projection - END SUBROUTINE AWAE_CopyInputFileType - - SUBROUTINE AWAE_DestroyInputFileType( InputFileTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(AWAE_InputFileType), INTENT(INOUT) :: InputFileTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AWAE_DestroyInputFileType' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(InputFileTypeData%OutDisWindZ)) THEN - DEALLOCATE(InputFileTypeData%OutDisWindZ) -ENDIF -IF (ALLOCATED(InputFileTypeData%OutDisWindX)) THEN - DEALLOCATE(InputFileTypeData%OutDisWindX) -ENDIF -IF (ALLOCATED(InputFileTypeData%OutDisWindY)) THEN - DEALLOCATE(InputFileTypeData%OutDisWindY) -ENDIF -IF (ALLOCATED(InputFileTypeData%X0_high)) THEN - DEALLOCATE(InputFileTypeData%X0_high) -ENDIF -IF (ALLOCATED(InputFileTypeData%Y0_high)) THEN - DEALLOCATE(InputFileTypeData%Y0_high) -ENDIF -IF (ALLOCATED(InputFileTypeData%Z0_high)) THEN - DEALLOCATE(InputFileTypeData%Z0_high) -ENDIF -IF (ALLOCATED(InputFileTypeData%dX_high)) THEN - DEALLOCATE(InputFileTypeData%dX_high) -ENDIF -IF (ALLOCATED(InputFileTypeData%dY_high)) THEN - DEALLOCATE(InputFileTypeData%dY_high) -ENDIF -IF (ALLOCATED(InputFileTypeData%dZ_high)) THEN - DEALLOCATE(InputFileTypeData%dZ_high) -ENDIF -IF (ALLOCATED(InputFileTypeData%WT_Position)) THEN - DEALLOCATE(InputFileTypeData%WT_Position) -ENDIF - END SUBROUTINE AWAE_DestroyInputFileType - - SUBROUTINE AWAE_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(AWAE_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 = 'AWAE_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 - Db_BufSz = Db_BufSz + 1 ! dt_low - Int_BufSz = Int_BufSz + 1 ! NumTurbines - Int_BufSz = Int_BufSz + 1 ! NumRadii - Int_BufSz = Int_BufSz + 1 ! NumPlanes - Int_BufSz = Int_BufSz + 1*LEN(InData%WindFilePath) ! WindFilePath - Int_BufSz = Int_BufSz + 1 ! WrDisWind - Int_BufSz = Int_BufSz + 1 ! NOutDisWindXY - Int_BufSz = Int_BufSz + 1 ! OutDisWindZ allocated yes/no - IF ( ALLOCATED(InData%OutDisWindZ) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OutDisWindZ upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%OutDisWindZ) ! OutDisWindZ - END IF - Int_BufSz = Int_BufSz + 1 ! NOutDisWindYZ - Int_BufSz = Int_BufSz + 1 ! OutDisWindX allocated yes/no - IF ( ALLOCATED(InData%OutDisWindX) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OutDisWindX upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%OutDisWindX) ! OutDisWindX - END IF - Int_BufSz = Int_BufSz + 1 ! NOutDisWindXZ - Int_BufSz = Int_BufSz + 1 ! OutDisWindY allocated yes/no - IF ( ALLOCATED(InData%OutDisWindY) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OutDisWindY upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%OutDisWindY) ! OutDisWindY - END IF - Db_BufSz = Db_BufSz + 1 ! WrDisDT - Int_BufSz = Int_BufSz + 1 ! ChkWndFiles - Int_BufSz = Int_BufSz + 1 ! Mod_Meander - Re_BufSz = Re_BufSz + 1 ! C_Meander - Int_BufSz = Int_BufSz + 1 ! Mod_AmbWind - Int_BufSz = Int_BufSz + 1*LEN(InData%InflowFile) ! InflowFile - Db_BufSz = Db_BufSz + 1 ! dt_high - Int_BufSz = Int_BufSz + 1 ! X0_high allocated yes/no - IF ( ALLOCATED(InData%X0_high) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! X0_high upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%X0_high) ! X0_high - END IF - Int_BufSz = Int_BufSz + 1 ! Y0_high allocated yes/no - IF ( ALLOCATED(InData%Y0_high) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Y0_high upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Y0_high) ! Y0_high - END IF - Int_BufSz = Int_BufSz + 1 ! Z0_high allocated yes/no - IF ( ALLOCATED(InData%Z0_high) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Z0_high upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Z0_high) ! Z0_high - END IF - Int_BufSz = Int_BufSz + 1 ! dX_high allocated yes/no - IF ( ALLOCATED(InData%dX_high) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! dX_high upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%dX_high) ! dX_high - END IF - Int_BufSz = Int_BufSz + 1 ! dY_high allocated yes/no - IF ( ALLOCATED(InData%dY_high) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! dY_high upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%dY_high) ! dY_high - END IF - Int_BufSz = Int_BufSz + 1 ! dZ_high allocated yes/no - IF ( ALLOCATED(InData%dZ_high) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! dZ_high upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%dZ_high) ! dZ_high - END IF - Int_BufSz = Int_BufSz + 1 ! nX_high - Int_BufSz = Int_BufSz + 1 ! nY_high - Int_BufSz = Int_BufSz + 1 ! nZ_high - Re_BufSz = Re_BufSz + 1 ! dX_low - Re_BufSz = Re_BufSz + 1 ! dY_low - Re_BufSz = Re_BufSz + 1 ! dZ_low - Int_BufSz = Int_BufSz + 1 ! nX_low - Int_BufSz = Int_BufSz + 1 ! nY_low - Int_BufSz = Int_BufSz + 1 ! nZ_low - Re_BufSz = Re_BufSz + 1 ! X0_low - Re_BufSz = Re_BufSz + 1 ! Y0_low - Re_BufSz = Re_BufSz + 1 ! Z0_low - Int_BufSz = Int_BufSz + 1 ! WT_Position allocated yes/no - IF ( ALLOCATED(InData%WT_Position) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! WT_Position upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WT_Position) ! WT_Position - END IF - Int_BufSz = Int_BufSz + 1 ! Mod_Projection - 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 - DbKiBuf(Db_Xferred) = InData%dt_low - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumTurbines - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumRadii - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumPlanes - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%WindFilePath) - IntKiBuf(Int_Xferred) = ICHAR(InData%WindFilePath(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = TRANSFER(InData%WrDisWind, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NOutDisWindXY - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%OutDisWindZ) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OutDisWindZ,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutDisWindZ,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%OutDisWindZ,1), UBOUND(InData%OutDisWindZ,1) - ReKiBuf(Re_Xferred) = InData%OutDisWindZ(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NOutDisWindYZ - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%OutDisWindX) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OutDisWindX,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutDisWindX,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%OutDisWindX,1), UBOUND(InData%OutDisWindX,1) - ReKiBuf(Re_Xferred) = InData%OutDisWindX(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NOutDisWindXZ - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%OutDisWindY) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OutDisWindY,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutDisWindY,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%OutDisWindY,1), UBOUND(InData%OutDisWindY,1) - ReKiBuf(Re_Xferred) = InData%OutDisWindY(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - DbKiBuf(Db_Xferred) = InData%WrDisDT - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%ChkWndFiles, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%Mod_Meander - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%C_Meander - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%Mod_AmbWind - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%InflowFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%InflowFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DbKiBuf(Db_Xferred) = InData%dt_high - Db_Xferred = Db_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%X0_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%X0_high,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%X0_high,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%X0_high,1), UBOUND(InData%X0_high,1) - ReKiBuf(Re_Xferred) = InData%X0_high(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Y0_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%Y0_high,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Y0_high,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Y0_high,1), UBOUND(InData%Y0_high,1) - ReKiBuf(Re_Xferred) = InData%Y0_high(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Z0_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%Z0_high,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Z0_high,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Z0_high,1), UBOUND(InData%Z0_high,1) - ReKiBuf(Re_Xferred) = InData%Z0_high(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%dX_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%dX_high,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dX_high,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%dX_high,1), UBOUND(InData%dX_high,1) - ReKiBuf(Re_Xferred) = InData%dX_high(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%dY_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%dY_high,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dY_high,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%dY_high,1), UBOUND(InData%dY_high,1) - ReKiBuf(Re_Xferred) = InData%dY_high(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%dZ_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%dZ_high,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dZ_high,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%dZ_high,1), UBOUND(InData%dZ_high,1) - ReKiBuf(Re_Xferred) = InData%dZ_high(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%nX_high - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nY_high - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nZ_high - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%dX_low - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%dY_low - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%dZ_low - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nX_low - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nY_low - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nZ_low - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%X0_low - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Y0_low - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Z0_low - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%WT_Position) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WT_Position,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WT_Position,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WT_Position,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WT_Position,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%WT_Position,2), UBOUND(InData%WT_Position,2) - DO i1 = LBOUND(InData%WT_Position,1), UBOUND(InData%WT_Position,1) - ReKiBuf(Re_Xferred) = InData%WT_Position(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%Mod_Projection - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE AWAE_PackInputFileType - - SUBROUTINE AWAE_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(AWAE_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 = 'AWAE_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%dt_low = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%NumTurbines = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumRadii = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumPlanes = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%WindFilePath) - OutData%WindFilePath(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%WrDisWind = TRANSFER(IntKiBuf(Int_Xferred), OutData%WrDisWind) - Int_Xferred = Int_Xferred + 1 - OutData%NOutDisWindXY = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutDisWindZ not allocated - Int_Xferred = Int_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%OutDisWindZ)) DEALLOCATE(OutData%OutDisWindZ) - ALLOCATE(OutData%OutDisWindZ(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutDisWindZ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%OutDisWindZ,1), UBOUND(OutData%OutDisWindZ,1) - OutData%OutDisWindZ(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%NOutDisWindYZ = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutDisWindX not allocated - Int_Xferred = Int_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%OutDisWindX)) DEALLOCATE(OutData%OutDisWindX) - ALLOCATE(OutData%OutDisWindX(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutDisWindX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%OutDisWindX,1), UBOUND(OutData%OutDisWindX,1) - OutData%OutDisWindX(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%NOutDisWindXZ = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutDisWindY not allocated - Int_Xferred = Int_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%OutDisWindY)) DEALLOCATE(OutData%OutDisWindY) - ALLOCATE(OutData%OutDisWindY(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutDisWindY.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%OutDisWindY,1), UBOUND(OutData%OutDisWindY,1) - OutData%OutDisWindY(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%WrDisDT = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%ChkWndFiles = TRANSFER(IntKiBuf(Int_Xferred), OutData%ChkWndFiles) - Int_Xferred = Int_Xferred + 1 - OutData%Mod_Meander = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%C_Meander = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Mod_AmbWind = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%InflowFile) - OutData%InflowFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%dt_high = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! X0_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%X0_high)) DEALLOCATE(OutData%X0_high) - ALLOCATE(OutData%X0_high(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%X0_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%X0_high,1), UBOUND(OutData%X0_high,1) - OutData%X0_high(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Y0_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%Y0_high)) DEALLOCATE(OutData%Y0_high) - ALLOCATE(OutData%Y0_high(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Y0_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Y0_high,1), UBOUND(OutData%Y0_high,1) - OutData%Y0_high(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Z0_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%Z0_high)) DEALLOCATE(OutData%Z0_high) - ALLOCATE(OutData%Z0_high(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Z0_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Z0_high,1), UBOUND(OutData%Z0_high,1) - OutData%Z0_high(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! dX_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%dX_high)) DEALLOCATE(OutData%dX_high) - ALLOCATE(OutData%dX_high(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%dX_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%dX_high,1), UBOUND(OutData%dX_high,1) - OutData%dX_high(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! dY_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%dY_high)) DEALLOCATE(OutData%dY_high) - ALLOCATE(OutData%dY_high(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%dY_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%dY_high,1), UBOUND(OutData%dY_high,1) - OutData%dY_high(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! dZ_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%dZ_high)) DEALLOCATE(OutData%dZ_high) - ALLOCATE(OutData%dZ_high(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%dZ_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%dZ_high,1), UBOUND(OutData%dZ_high,1) - OutData%dZ_high(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%nX_high = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nY_high = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nZ_high = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%dX_low = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%dY_low = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%dZ_low = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%nX_low = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nY_low = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nZ_low = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%X0_low = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Y0_low = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Z0_low = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WT_Position not allocated - Int_Xferred = Int_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%WT_Position)) DEALLOCATE(OutData%WT_Position) - ALLOCATE(OutData%WT_Position(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WT_Position.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%WT_Position,2), UBOUND(OutData%WT_Position,2) - DO i1 = LBOUND(OutData%WT_Position,1), UBOUND(OutData%WT_Position,1) - OutData%WT_Position(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%Mod_Projection = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE AWAE_UnPackInputFileType - - SUBROUTINE AWAE_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AWAE_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(AWAE_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 = 'AWAE_CopyInitInput' -! + ErrMsg = '' + if (associated(SrcHighWindGridData%data)) then + LB(1:5) = lbound(SrcHighWindGridData%data) + UB(1:5) = ubound(SrcHighWindGridData%data) + if (.not. associated(DstHighWindGridData%data)) then + allocate(DstHighWindGridData%data(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstHighWindGridData%data.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstHighWindGridData%data = SrcHighWindGridData%data + end if +end subroutine + +subroutine AWAE_DestroyHighWindGrid(HighWindGridData, ErrStat, ErrMsg) + type(AWAE_HighWindGrid), intent(inout) :: HighWindGridData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AWAE_DestroyHighWindGrid' ErrStat = ErrID_None - ErrMsg = "" - CALL AWAE_Copyinputfiletype( SrcInitInputData%InputFileData, DstInitInputData%InputFileData, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstInitInputData%n_high_low = SrcInitInputData%n_high_low - DstInitInputData%NumDT = SrcInitInputData%NumDT - DstInitInputData%OutFileRoot = SrcInitInputData%OutFileRoot - END SUBROUTINE AWAE_CopyInitInput - - SUBROUTINE AWAE_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(AWAE_InitInputType), INTENT(INOUT) :: InitInputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AWAE_DestroyInitInput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL AWAE_Destroyinputfiletype( InitInputData%InputFileData, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE AWAE_DestroyInitInput - - SUBROUTINE AWAE_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(AWAE_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 = 'AWAE_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 AWAE_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 ! n_high_low - Int_BufSz = Int_BufSz + 1 ! NumDT - Int_BufSz = Int_BufSz + 1*LEN(InData%OutFileRoot) ! OutFileRoot - 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 AWAE_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%n_high_low - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumDT - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%OutFileRoot) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutFileRoot(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END SUBROUTINE AWAE_PackInitInput - - SUBROUTINE AWAE_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(AWAE_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 = 'AWAE_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 AWAE_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%n_high_low = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumDT = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%OutFileRoot) - OutData%OutFileRoot(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END SUBROUTINE AWAE_UnPackInitInput - - SUBROUTINE AWAE_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AWAE_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(AWAE_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 = 'AWAE_CopyInitOutput' -! + ErrMsg = '' + if (associated(HighWindGridData%data)) then + deallocate(HighWindGridData%data) + HighWindGridData%data => null() + end if +end subroutine + +subroutine AWAE_PackHighWindGrid(RF, Indata) + type(RegFile), intent(inout) :: RF + type(AWAE_HighWindGrid), intent(in) :: InData + character(*), parameter :: RoutineName = 'AWAE_PackHighWindGrid' + logical :: PtrInIndex + if (RF%ErrStat >= AbortErrLev) return + call RegPackPtr(RF, InData%data) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AWAE_UnPackHighWindGrid(RF, OutData) + type(RegFile), intent(inout) :: RF + type(AWAE_HighWindGrid), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AWAE_UnPackHighWindGrid' + integer(B4Ki) :: LB(5), UB(5) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(B8Ki) :: PtrIdx + type(c_ptr) :: Ptr + if (RF%ErrStat /= ErrID_None) return + call RegUnpackPtr(RF, OutData%data, LB, UB); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AWAE_CopyHighWindGridPtr(SrcHighWindGridPtrData, DstHighWindGridPtrData, CtrlCode, ErrStat, ErrMsg) + type(AWAE_HighWindGridPtr), intent(in) :: SrcHighWindGridPtrData + type(AWAE_HighWindGridPtr), intent(inout) :: DstHighWindGridPtrData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(5), UB(5) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'AWAE_CopyHighWindGridPtr' 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%X0_high)) THEN - i1_l = LBOUND(SrcInitOutputData%X0_high,1) - i1_u = UBOUND(SrcInitOutputData%X0_high,1) - IF (.NOT. ALLOCATED(DstInitOutputData%X0_high)) THEN - ALLOCATE(DstInitOutputData%X0_high(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%X0_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%X0_high = SrcInitOutputData%X0_high -ENDIF -IF (ALLOCATED(SrcInitOutputData%Y0_high)) THEN - i1_l = LBOUND(SrcInitOutputData%Y0_high,1) - i1_u = UBOUND(SrcInitOutputData%Y0_high,1) - IF (.NOT. ALLOCATED(DstInitOutputData%Y0_high)) THEN - ALLOCATE(DstInitOutputData%Y0_high(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%Y0_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%Y0_high = SrcInitOutputData%Y0_high -ENDIF -IF (ALLOCATED(SrcInitOutputData%Z0_high)) THEN - i1_l = LBOUND(SrcInitOutputData%Z0_high,1) - i1_u = UBOUND(SrcInitOutputData%Z0_high,1) - IF (.NOT. ALLOCATED(DstInitOutputData%Z0_high)) THEN - ALLOCATE(DstInitOutputData%Z0_high(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%Z0_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%Z0_high = SrcInitOutputData%Z0_high -ENDIF -IF (ALLOCATED(SrcInitOutputData%dX_high)) THEN - i1_l = LBOUND(SrcInitOutputData%dX_high,1) - i1_u = UBOUND(SrcInitOutputData%dX_high,1) - IF (.NOT. ALLOCATED(DstInitOutputData%dX_high)) THEN - ALLOCATE(DstInitOutputData%dX_high(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%dX_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%dX_high = SrcInitOutputData%dX_high -ENDIF -IF (ALLOCATED(SrcInitOutputData%dY_high)) THEN - i1_l = LBOUND(SrcInitOutputData%dY_high,1) - i1_u = UBOUND(SrcInitOutputData%dY_high,1) - IF (.NOT. ALLOCATED(DstInitOutputData%dY_high)) THEN - ALLOCATE(DstInitOutputData%dY_high(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%dY_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%dY_high = SrcInitOutputData%dY_high -ENDIF -IF (ALLOCATED(SrcInitOutputData%dZ_high)) THEN - i1_l = LBOUND(SrcInitOutputData%dZ_high,1) - i1_u = UBOUND(SrcInitOutputData%dZ_high,1) - IF (.NOT. ALLOCATED(DstInitOutputData%dZ_high)) THEN - ALLOCATE(DstInitOutputData%dZ_high(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%dZ_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%dZ_high = SrcInitOutputData%dZ_high -ENDIF - DstInitOutputData%nX_high = SrcInitOutputData%nX_high - DstInitOutputData%nY_high = SrcInitOutputData%nY_high - DstInitOutputData%nZ_high = SrcInitOutputData%nZ_high - DstInitOutputData%dX_low = SrcInitOutputData%dX_low - DstInitOutputData%dY_low = SrcInitOutputData%dY_low - DstInitOutputData%dZ_low = SrcInitOutputData%dZ_low - DstInitOutputData%nX_low = SrcInitOutputData%nX_low - DstInitOutputData%nY_low = SrcInitOutputData%nY_low - DstInitOutputData%nZ_low = SrcInitOutputData%nZ_low - DstInitOutputData%X0_low = SrcInitOutputData%X0_low - DstInitOutputData%Y0_low = SrcInitOutputData%Y0_low - DstInitOutputData%Z0_low = SrcInitOutputData%Z0_low - END SUBROUTINE AWAE_CopyInitOutput - - SUBROUTINE AWAE_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(AWAE_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AWAE_DestroyInitOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL NWTC_Library_Destroyprogdesc( InitOutputData%Ver, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(InitOutputData%X0_high)) THEN - DEALLOCATE(InitOutputData%X0_high) -ENDIF -IF (ALLOCATED(InitOutputData%Y0_high)) THEN - DEALLOCATE(InitOutputData%Y0_high) -ENDIF -IF (ALLOCATED(InitOutputData%Z0_high)) THEN - DEALLOCATE(InitOutputData%Z0_high) -ENDIF -IF (ALLOCATED(InitOutputData%dX_high)) THEN - DEALLOCATE(InitOutputData%dX_high) -ENDIF -IF (ALLOCATED(InitOutputData%dY_high)) THEN - DEALLOCATE(InitOutputData%dY_high) -ENDIF -IF (ALLOCATED(InitOutputData%dZ_high)) THEN - DEALLOCATE(InitOutputData%dZ_high) -ENDIF - END SUBROUTINE AWAE_DestroyInitOutput - - SUBROUTINE AWAE_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(AWAE_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 = 'AWAE_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 ! X0_high allocated yes/no - IF ( ALLOCATED(InData%X0_high) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! X0_high upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%X0_high) ! X0_high - END IF - Int_BufSz = Int_BufSz + 1 ! Y0_high allocated yes/no - IF ( ALLOCATED(InData%Y0_high) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Y0_high upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Y0_high) ! Y0_high - END IF - Int_BufSz = Int_BufSz + 1 ! Z0_high allocated yes/no - IF ( ALLOCATED(InData%Z0_high) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Z0_high upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Z0_high) ! Z0_high - END IF - Int_BufSz = Int_BufSz + 1 ! dX_high allocated yes/no - IF ( ALLOCATED(InData%dX_high) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! dX_high upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%dX_high) ! dX_high - END IF - Int_BufSz = Int_BufSz + 1 ! dY_high allocated yes/no - IF ( ALLOCATED(InData%dY_high) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! dY_high upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%dY_high) ! dY_high - END IF - Int_BufSz = Int_BufSz + 1 ! dZ_high allocated yes/no - IF ( ALLOCATED(InData%dZ_high) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! dZ_high upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%dZ_high) ! dZ_high - END IF - Int_BufSz = Int_BufSz + 1 ! nX_high - Int_BufSz = Int_BufSz + 1 ! nY_high - Int_BufSz = Int_BufSz + 1 ! nZ_high - Re_BufSz = Re_BufSz + 1 ! dX_low - Re_BufSz = Re_BufSz + 1 ! dY_low - Re_BufSz = Re_BufSz + 1 ! dZ_low - Int_BufSz = Int_BufSz + 1 ! nX_low - Int_BufSz = Int_BufSz + 1 ! nY_low - Int_BufSz = Int_BufSz + 1 ! nZ_low - Re_BufSz = Re_BufSz + 1 ! X0_low - Re_BufSz = Re_BufSz + 1 ! Y0_low - Re_BufSz = Re_BufSz + 1 ! Z0_low - 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%X0_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%X0_high,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%X0_high,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%X0_high,1), UBOUND(InData%X0_high,1) - ReKiBuf(Re_Xferred) = InData%X0_high(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Y0_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%Y0_high,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Y0_high,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Y0_high,1), UBOUND(InData%Y0_high,1) - ReKiBuf(Re_Xferred) = InData%Y0_high(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Z0_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%Z0_high,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Z0_high,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Z0_high,1), UBOUND(InData%Z0_high,1) - ReKiBuf(Re_Xferred) = InData%Z0_high(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%dX_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%dX_high,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dX_high,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%dX_high,1), UBOUND(InData%dX_high,1) - ReKiBuf(Re_Xferred) = InData%dX_high(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%dY_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%dY_high,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dY_high,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%dY_high,1), UBOUND(InData%dY_high,1) - ReKiBuf(Re_Xferred) = InData%dY_high(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%dZ_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%dZ_high,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dZ_high,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%dZ_high,1), UBOUND(InData%dZ_high,1) - ReKiBuf(Re_Xferred) = InData%dZ_high(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%nX_high - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nY_high - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nZ_high - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%dX_low - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%dY_low - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%dZ_low - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nX_low - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nY_low - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nZ_low - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%X0_low - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Y0_low - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Z0_low - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AWAE_PackInitOutput - - SUBROUTINE AWAE_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(AWAE_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 = 'AWAE_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 ! X0_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%X0_high)) DEALLOCATE(OutData%X0_high) - ALLOCATE(OutData%X0_high(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%X0_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%X0_high,1), UBOUND(OutData%X0_high,1) - OutData%X0_high(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Y0_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%Y0_high)) DEALLOCATE(OutData%Y0_high) - ALLOCATE(OutData%Y0_high(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Y0_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Y0_high,1), UBOUND(OutData%Y0_high,1) - OutData%Y0_high(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Z0_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%Z0_high)) DEALLOCATE(OutData%Z0_high) - ALLOCATE(OutData%Z0_high(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Z0_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Z0_high,1), UBOUND(OutData%Z0_high,1) - OutData%Z0_high(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! dX_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%dX_high)) DEALLOCATE(OutData%dX_high) - ALLOCATE(OutData%dX_high(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%dX_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%dX_high,1), UBOUND(OutData%dX_high,1) - OutData%dX_high(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! dY_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%dY_high)) DEALLOCATE(OutData%dY_high) - ALLOCATE(OutData%dY_high(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%dY_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%dY_high,1), UBOUND(OutData%dY_high,1) - OutData%dY_high(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! dZ_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%dZ_high)) DEALLOCATE(OutData%dZ_high) - ALLOCATE(OutData%dZ_high(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%dZ_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%dZ_high,1), UBOUND(OutData%dZ_high,1) - OutData%dZ_high(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%nX_high = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nY_high = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nZ_high = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%dX_low = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%dY_low = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%dZ_low = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%nX_low = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nY_low = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nZ_low = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%X0_low = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Y0_low = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Z0_low = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AWAE_UnPackInitOutput - - SUBROUTINE AWAE_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AWAE_ContinuousStateType), INTENT(IN) :: SrcContStateData - TYPE(AWAE_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 = 'AWAE_CopyContState' -! + ErrMsg = '' + DstHighWindGridPtrData%data => SrcHighWindGridPtrData%data +end subroutine + +subroutine AWAE_DestroyHighWindGridPtr(HighWindGridPtrData, ErrStat, ErrMsg) + type(AWAE_HighWindGridPtr), intent(inout) :: HighWindGridPtrData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AWAE_DestroyHighWindGridPtr' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcContStateData%IfW)) THEN - i1_l = LBOUND(SrcContStateData%IfW,1) - i1_u = UBOUND(SrcContStateData%IfW,1) - IF (.NOT. ALLOCATED(DstContStateData%IfW)) THEN - ALLOCATE(DstContStateData%IfW(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%IfW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcContStateData%IfW,1), UBOUND(SrcContStateData%IfW,1) - CALL InflowWind_CopyContState( SrcContStateData%IfW(i1), DstContStateData%IfW(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - END SUBROUTINE AWAE_CopyContState - - SUBROUTINE AWAE_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(AWAE_ContinuousStateType), INTENT(INOUT) :: ContStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AWAE_DestroyContState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(ContStateData%IfW)) THEN -DO i1 = LBOUND(ContStateData%IfW,1), UBOUND(ContStateData%IfW,1) - CALL InflowWind_DestroyContState( ContStateData%IfW(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ContStateData%IfW) -ENDIF - END SUBROUTINE AWAE_DestroyContState - - SUBROUTINE AWAE_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(AWAE_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 = 'AWAE_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 ! IfW allocated yes/no - IF ( ALLOCATED(InData%IfW) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! IfW upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%IfW,1), UBOUND(InData%IfW,1) - Int_BufSz = Int_BufSz + 3 ! IfW: size of buffers for each call to pack subtype - CALL InflowWind_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%IfW(i1), ErrStat2, ErrMsg2, .TRUE. ) ! IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! IfW - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! IfW - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! IfW - 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%IfW) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%IfW,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IfW,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%IfW,1), UBOUND(InData%IfW,1) - CALL InflowWind_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%IfW(i1), ErrStat2, ErrMsg2, OnlySize ) ! IfW - 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 AWAE_PackContState - - SUBROUTINE AWAE_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(AWAE_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 = 'AWAE_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 ! IfW not allocated - Int_Xferred = Int_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%IfW)) DEALLOCATE(OutData%IfW) - ALLOCATE(OutData%IfW(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IfW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%IfW,1), UBOUND(OutData%IfW,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 InflowWind_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%IfW(i1), ErrStat2, ErrMsg2 ) ! IfW - 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 AWAE_UnPackContState - - SUBROUTINE AWAE_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AWAE_DiscreteStateType), INTENT(IN) :: SrcDiscStateData - TYPE(AWAE_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 = 'AWAE_CopyDiscState' -! + ErrMsg = '' + nullify(HighWindGridPtrData%data) +end subroutine + +subroutine AWAE_PackHighWindGridPtr(RF, Indata) + type(RegFile), intent(inout) :: RF + type(AWAE_HighWindGridPtr), intent(in) :: InData + character(*), parameter :: RoutineName = 'AWAE_PackHighWindGridPtr' + logical :: PtrInIndex + if (RF%ErrStat >= AbortErrLev) return + call RegPackPtr(RF, InData%data) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AWAE_UnPackHighWindGridPtr(RF, OutData) + type(RegFile), intent(inout) :: RF + type(AWAE_HighWindGridPtr), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AWAE_UnPackHighWindGridPtr' + integer(B4Ki) :: LB(5), UB(5) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(B8Ki) :: PtrIdx + type(c_ptr) :: Ptr + if (RF%ErrStat /= ErrID_None) return + call RegUnpackPtr(RF, OutData%data, LB, UB); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AWAE_CopyInputFileType(SrcInputFileTypeData, DstInputFileTypeData, CtrlCode, ErrStat, ErrMsg) + type(AWAE_InputFileType), intent(in) :: SrcInputFileTypeData + type(AWAE_InputFileType), intent(inout) :: DstInputFileTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'AWAE_CopyInputFileType' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcDiscStateData%IfW)) THEN - i1_l = LBOUND(SrcDiscStateData%IfW,1) - i1_u = UBOUND(SrcDiscStateData%IfW,1) - IF (.NOT. ALLOCATED(DstDiscStateData%IfW)) THEN - ALLOCATE(DstDiscStateData%IfW(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%IfW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcDiscStateData%IfW,1), UBOUND(SrcDiscStateData%IfW,1) - CALL InflowWind_CopyDiscState( SrcDiscStateData%IfW(i1), DstDiscStateData%IfW(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - END SUBROUTINE AWAE_CopyDiscState - - SUBROUTINE AWAE_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(AWAE_DiscreteStateType), INTENT(INOUT) :: DiscStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AWAE_DestroyDiscState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(DiscStateData%IfW)) THEN -DO i1 = LBOUND(DiscStateData%IfW,1), UBOUND(DiscStateData%IfW,1) - CALL InflowWind_DestroyDiscState( DiscStateData%IfW(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(DiscStateData%IfW) -ENDIF - END SUBROUTINE AWAE_DestroyDiscState - - SUBROUTINE AWAE_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(AWAE_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 = 'AWAE_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 ! IfW allocated yes/no - IF ( ALLOCATED(InData%IfW) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! IfW upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%IfW,1), UBOUND(InData%IfW,1) - Int_BufSz = Int_BufSz + 3 ! IfW: size of buffers for each call to pack subtype - CALL InflowWind_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%IfW(i1), ErrStat2, ErrMsg2, .TRUE. ) ! IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! IfW - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! IfW - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! IfW - 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%IfW) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%IfW,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IfW,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%IfW,1), UBOUND(InData%IfW,1) - CALL InflowWind_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%IfW(i1), ErrStat2, ErrMsg2, OnlySize ) ! IfW - 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 AWAE_PackDiscState - - SUBROUTINE AWAE_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(AWAE_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 = 'AWAE_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 ! IfW not allocated - Int_Xferred = Int_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%IfW)) DEALLOCATE(OutData%IfW) - ALLOCATE(OutData%IfW(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IfW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%IfW,1), UBOUND(OutData%IfW,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 InflowWind_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%IfW(i1), ErrStat2, ErrMsg2 ) ! IfW - 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 AWAE_UnPackDiscState - - SUBROUTINE AWAE_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AWAE_ConstraintStateType), INTENT(IN) :: SrcConstrStateData - TYPE(AWAE_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 = 'AWAE_CopyConstrState' -! + ErrMsg = '' + DstInputFileTypeData%dr = SrcInputFileTypeData%dr + DstInputFileTypeData%dt_low = SrcInputFileTypeData%dt_low + DstInputFileTypeData%NumTurbines = SrcInputFileTypeData%NumTurbines + DstInputFileTypeData%NumRadii = SrcInputFileTypeData%NumRadii + DstInputFileTypeData%NumPlanes = SrcInputFileTypeData%NumPlanes + DstInputFileTypeData%WindFilePath = SrcInputFileTypeData%WindFilePath + DstInputFileTypeData%WrDisWind = SrcInputFileTypeData%WrDisWind + DstInputFileTypeData%NOutDisWindXY = SrcInputFileTypeData%NOutDisWindXY + if (allocated(SrcInputFileTypeData%OutDisWindZ)) then + LB(1:1) = lbound(SrcInputFileTypeData%OutDisWindZ) + UB(1:1) = ubound(SrcInputFileTypeData%OutDisWindZ) + if (.not. allocated(DstInputFileTypeData%OutDisWindZ)) then + allocate(DstInputFileTypeData%OutDisWindZ(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileTypeData%OutDisWindZ.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileTypeData%OutDisWindZ = SrcInputFileTypeData%OutDisWindZ + end if + DstInputFileTypeData%NOutDisWindYZ = SrcInputFileTypeData%NOutDisWindYZ + if (allocated(SrcInputFileTypeData%OutDisWindX)) then + LB(1:1) = lbound(SrcInputFileTypeData%OutDisWindX) + UB(1:1) = ubound(SrcInputFileTypeData%OutDisWindX) + if (.not. allocated(DstInputFileTypeData%OutDisWindX)) then + allocate(DstInputFileTypeData%OutDisWindX(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileTypeData%OutDisWindX.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileTypeData%OutDisWindX = SrcInputFileTypeData%OutDisWindX + end if + DstInputFileTypeData%NOutDisWindXZ = SrcInputFileTypeData%NOutDisWindXZ + if (allocated(SrcInputFileTypeData%OutDisWindY)) then + LB(1:1) = lbound(SrcInputFileTypeData%OutDisWindY) + UB(1:1) = ubound(SrcInputFileTypeData%OutDisWindY) + if (.not. allocated(DstInputFileTypeData%OutDisWindY)) then + allocate(DstInputFileTypeData%OutDisWindY(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileTypeData%OutDisWindY.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileTypeData%OutDisWindY = SrcInputFileTypeData%OutDisWindY + end if + DstInputFileTypeData%WrDisDT = SrcInputFileTypeData%WrDisDT + DstInputFileTypeData%ChkWndFiles = SrcInputFileTypeData%ChkWndFiles + DstInputFileTypeData%Mod_Meander = SrcInputFileTypeData%Mod_Meander + DstInputFileTypeData%C_Meander = SrcInputFileTypeData%C_Meander + DstInputFileTypeData%Mod_AmbWind = SrcInputFileTypeData%Mod_AmbWind + DstInputFileTypeData%InflowFile = SrcInputFileTypeData%InflowFile + DstInputFileTypeData%dt_high = SrcInputFileTypeData%dt_high + if (allocated(SrcInputFileTypeData%X0_high)) then + LB(1:1) = lbound(SrcInputFileTypeData%X0_high) + UB(1:1) = ubound(SrcInputFileTypeData%X0_high) + if (.not. allocated(DstInputFileTypeData%X0_high)) then + allocate(DstInputFileTypeData%X0_high(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileTypeData%X0_high.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileTypeData%X0_high = SrcInputFileTypeData%X0_high + end if + if (allocated(SrcInputFileTypeData%Y0_high)) then + LB(1:1) = lbound(SrcInputFileTypeData%Y0_high) + UB(1:1) = ubound(SrcInputFileTypeData%Y0_high) + if (.not. allocated(DstInputFileTypeData%Y0_high)) then + allocate(DstInputFileTypeData%Y0_high(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileTypeData%Y0_high.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileTypeData%Y0_high = SrcInputFileTypeData%Y0_high + end if + if (allocated(SrcInputFileTypeData%Z0_high)) then + LB(1:1) = lbound(SrcInputFileTypeData%Z0_high) + UB(1:1) = ubound(SrcInputFileTypeData%Z0_high) + if (.not. allocated(DstInputFileTypeData%Z0_high)) then + allocate(DstInputFileTypeData%Z0_high(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileTypeData%Z0_high.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileTypeData%Z0_high = SrcInputFileTypeData%Z0_high + end if + if (allocated(SrcInputFileTypeData%dX_high)) then + LB(1:1) = lbound(SrcInputFileTypeData%dX_high) + UB(1:1) = ubound(SrcInputFileTypeData%dX_high) + if (.not. allocated(DstInputFileTypeData%dX_high)) then + allocate(DstInputFileTypeData%dX_high(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileTypeData%dX_high.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileTypeData%dX_high = SrcInputFileTypeData%dX_high + end if + if (allocated(SrcInputFileTypeData%dY_high)) then + LB(1:1) = lbound(SrcInputFileTypeData%dY_high) + UB(1:1) = ubound(SrcInputFileTypeData%dY_high) + if (.not. allocated(DstInputFileTypeData%dY_high)) then + allocate(DstInputFileTypeData%dY_high(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileTypeData%dY_high.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileTypeData%dY_high = SrcInputFileTypeData%dY_high + end if + if (allocated(SrcInputFileTypeData%dZ_high)) then + LB(1:1) = lbound(SrcInputFileTypeData%dZ_high) + UB(1:1) = ubound(SrcInputFileTypeData%dZ_high) + if (.not. allocated(DstInputFileTypeData%dZ_high)) then + allocate(DstInputFileTypeData%dZ_high(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileTypeData%dZ_high.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileTypeData%dZ_high = SrcInputFileTypeData%dZ_high + end if + DstInputFileTypeData%nX_high = SrcInputFileTypeData%nX_high + DstInputFileTypeData%nY_high = SrcInputFileTypeData%nY_high + DstInputFileTypeData%nZ_high = SrcInputFileTypeData%nZ_high + DstInputFileTypeData%dX_low = SrcInputFileTypeData%dX_low + DstInputFileTypeData%dY_low = SrcInputFileTypeData%dY_low + DstInputFileTypeData%dZ_low = SrcInputFileTypeData%dZ_low + DstInputFileTypeData%nX_low = SrcInputFileTypeData%nX_low + DstInputFileTypeData%nY_low = SrcInputFileTypeData%nY_low + DstInputFileTypeData%nZ_low = SrcInputFileTypeData%nZ_low + DstInputFileTypeData%X0_low = SrcInputFileTypeData%X0_low + DstInputFileTypeData%Y0_low = SrcInputFileTypeData%Y0_low + DstInputFileTypeData%Z0_low = SrcInputFileTypeData%Z0_low + if (allocated(SrcInputFileTypeData%WT_Position)) then + LB(1:2) = lbound(SrcInputFileTypeData%WT_Position) + UB(1:2) = ubound(SrcInputFileTypeData%WT_Position) + if (.not. allocated(DstInputFileTypeData%WT_Position)) then + allocate(DstInputFileTypeData%WT_Position(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileTypeData%WT_Position.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileTypeData%WT_Position = SrcInputFileTypeData%WT_Position + end if + DstInputFileTypeData%Mod_Projection = SrcInputFileTypeData%Mod_Projection +end subroutine + +subroutine AWAE_DestroyInputFileType(InputFileTypeData, ErrStat, ErrMsg) + type(AWAE_InputFileType), intent(inout) :: InputFileTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AWAE_DestroyInputFileType' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcConstrStateData%IfW)) THEN - i1_l = LBOUND(SrcConstrStateData%IfW,1) - i1_u = UBOUND(SrcConstrStateData%IfW,1) - IF (.NOT. ALLOCATED(DstConstrStateData%IfW)) THEN - ALLOCATE(DstConstrStateData%IfW(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstConstrStateData%IfW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcConstrStateData%IfW,1), UBOUND(SrcConstrStateData%IfW,1) - CALL InflowWind_CopyConstrState( SrcConstrStateData%IfW(i1), DstConstrStateData%IfW(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - END SUBROUTINE AWAE_CopyConstrState - - SUBROUTINE AWAE_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(AWAE_ConstraintStateType), INTENT(INOUT) :: ConstrStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AWAE_DestroyConstrState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(ConstrStateData%IfW)) THEN -DO i1 = LBOUND(ConstrStateData%IfW,1), UBOUND(ConstrStateData%IfW,1) - CALL InflowWind_DestroyConstrState( ConstrStateData%IfW(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ConstrStateData%IfW) -ENDIF - END SUBROUTINE AWAE_DestroyConstrState - - SUBROUTINE AWAE_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(AWAE_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 = 'AWAE_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 - Int_BufSz = Int_BufSz + 1 ! IfW allocated yes/no - IF ( ALLOCATED(InData%IfW) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! IfW upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%IfW,1), UBOUND(InData%IfW,1) - Int_BufSz = Int_BufSz + 3 ! IfW: size of buffers for each call to pack subtype - CALL InflowWind_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%IfW(i1), ErrStat2, ErrMsg2, .TRUE. ) ! IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! IfW - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! IfW - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! IfW - 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%IfW) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%IfW,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IfW,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%IfW,1), UBOUND(InData%IfW,1) - CALL InflowWind_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%IfW(i1), ErrStat2, ErrMsg2, OnlySize ) ! IfW - 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 AWAE_PackConstrState - - SUBROUTINE AWAE_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(AWAE_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 = 'AWAE_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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IfW not allocated - Int_Xferred = Int_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%IfW)) DEALLOCATE(OutData%IfW) - ALLOCATE(OutData%IfW(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IfW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%IfW,1), UBOUND(OutData%IfW,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 InflowWind_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%IfW(i1), ErrStat2, ErrMsg2 ) ! IfW - 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 AWAE_UnPackConstrState - - SUBROUTINE AWAE_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AWAE_OtherStateType), INTENT(IN) :: SrcOtherStateData - TYPE(AWAE_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 = 'AWAE_CopyOtherState' -! + ErrMsg = '' + if (allocated(InputFileTypeData%OutDisWindZ)) then + deallocate(InputFileTypeData%OutDisWindZ) + end if + if (allocated(InputFileTypeData%OutDisWindX)) then + deallocate(InputFileTypeData%OutDisWindX) + end if + if (allocated(InputFileTypeData%OutDisWindY)) then + deallocate(InputFileTypeData%OutDisWindY) + end if + if (allocated(InputFileTypeData%X0_high)) then + deallocate(InputFileTypeData%X0_high) + end if + if (allocated(InputFileTypeData%Y0_high)) then + deallocate(InputFileTypeData%Y0_high) + end if + if (allocated(InputFileTypeData%Z0_high)) then + deallocate(InputFileTypeData%Z0_high) + end if + if (allocated(InputFileTypeData%dX_high)) then + deallocate(InputFileTypeData%dX_high) + end if + if (allocated(InputFileTypeData%dY_high)) then + deallocate(InputFileTypeData%dY_high) + end if + if (allocated(InputFileTypeData%dZ_high)) then + deallocate(InputFileTypeData%dZ_high) + end if + if (allocated(InputFileTypeData%WT_Position)) then + deallocate(InputFileTypeData%WT_Position) + end if +end subroutine + +subroutine AWAE_PackInputFileType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(AWAE_InputFileType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AWAE_PackInputFileType' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%dr) + call RegPack(RF, InData%dt_low) + call RegPack(RF, InData%NumTurbines) + call RegPack(RF, InData%NumRadii) + call RegPack(RF, InData%NumPlanes) + call RegPack(RF, InData%WindFilePath) + call RegPack(RF, InData%WrDisWind) + call RegPack(RF, InData%NOutDisWindXY) + call RegPackAlloc(RF, InData%OutDisWindZ) + call RegPack(RF, InData%NOutDisWindYZ) + call RegPackAlloc(RF, InData%OutDisWindX) + call RegPack(RF, InData%NOutDisWindXZ) + call RegPackAlloc(RF, InData%OutDisWindY) + call RegPack(RF, InData%WrDisDT) + call RegPack(RF, InData%ChkWndFiles) + call RegPack(RF, InData%Mod_Meander) + call RegPack(RF, InData%C_Meander) + call RegPack(RF, InData%Mod_AmbWind) + call RegPack(RF, InData%InflowFile) + call RegPack(RF, InData%dt_high) + call RegPackAlloc(RF, InData%X0_high) + call RegPackAlloc(RF, InData%Y0_high) + call RegPackAlloc(RF, InData%Z0_high) + call RegPackAlloc(RF, InData%dX_high) + call RegPackAlloc(RF, InData%dY_high) + call RegPackAlloc(RF, InData%dZ_high) + call RegPack(RF, InData%nX_high) + call RegPack(RF, InData%nY_high) + call RegPack(RF, InData%nZ_high) + call RegPack(RF, InData%dX_low) + call RegPack(RF, InData%dY_low) + call RegPack(RF, InData%dZ_low) + call RegPack(RF, InData%nX_low) + call RegPack(RF, InData%nY_low) + call RegPack(RF, InData%nZ_low) + call RegPack(RF, InData%X0_low) + call RegPack(RF, InData%Y0_low) + call RegPack(RF, InData%Z0_low) + call RegPackAlloc(RF, InData%WT_Position) + call RegPack(RF, InData%Mod_Projection) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AWAE_UnPackInputFileType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(AWAE_InputFileType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AWAE_UnPackInputFileType' + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%dr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%dt_low); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumTurbines); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumRadii); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumPlanes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WindFilePath); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WrDisWind); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NOutDisWindXY); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%OutDisWindZ); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NOutDisWindYZ); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%OutDisWindX); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NOutDisWindXZ); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%OutDisWindY); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WrDisDT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ChkWndFiles); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Mod_Meander); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%C_Meander); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Mod_AmbWind); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%InflowFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%dt_high); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%X0_high); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Y0_high); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Z0_high); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dX_high); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dY_high); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dZ_high); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nX_high); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nY_high); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nZ_high); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%dX_low); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%dY_low); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%dZ_low); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nX_low); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nY_low); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nZ_low); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%X0_low); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Y0_low); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Z0_low); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WT_Position); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Mod_Projection); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AWAE_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) + type(AWAE_InitInputType), intent(in) :: SrcInitInputData + type(AWAE_InitInputType), intent(inout) :: DstInitInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(0), UB(0) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AWAE_CopyInitInput' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcOtherStateData%IfW)) THEN - i1_l = LBOUND(SrcOtherStateData%IfW,1) - i1_u = UBOUND(SrcOtherStateData%IfW,1) - IF (.NOT. ALLOCATED(DstOtherStateData%IfW)) THEN - ALLOCATE(DstOtherStateData%IfW(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%IfW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcOtherStateData%IfW,1), UBOUND(SrcOtherStateData%IfW,1) - CALL InflowWind_CopyOtherState( SrcOtherStateData%IfW(i1), DstOtherStateData%IfW(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - END SUBROUTINE AWAE_CopyOtherState - - SUBROUTINE AWAE_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(AWAE_OtherStateType), INTENT(INOUT) :: OtherStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AWAE_DestroyOtherState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(OtherStateData%IfW)) THEN -DO i1 = LBOUND(OtherStateData%IfW,1), UBOUND(OtherStateData%IfW,1) - CALL InflowWind_DestroyOtherState( OtherStateData%IfW(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(OtherStateData%IfW) -ENDIF - END SUBROUTINE AWAE_DestroyOtherState - - SUBROUTINE AWAE_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(AWAE_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 = 'AWAE_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 ! IfW allocated yes/no - IF ( ALLOCATED(InData%IfW) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! IfW upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%IfW,1), UBOUND(InData%IfW,1) - Int_BufSz = Int_BufSz + 3 ! IfW: size of buffers for each call to pack subtype - CALL InflowWind_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%IfW(i1), ErrStat2, ErrMsg2, .TRUE. ) ! IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! IfW - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! IfW - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! IfW - 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%IfW) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%IfW,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IfW,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%IfW,1), UBOUND(InData%IfW,1) - CALL InflowWind_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%IfW(i1), ErrStat2, ErrMsg2, OnlySize ) ! IfW - 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 AWAE_PackOtherState - - SUBROUTINE AWAE_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(AWAE_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 = 'AWAE_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 ! IfW not allocated - Int_Xferred = Int_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%IfW)) DEALLOCATE(OutData%IfW) - ALLOCATE(OutData%IfW(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IfW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%IfW,1), UBOUND(OutData%IfW,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 InflowWind_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%IfW(i1), ErrStat2, ErrMsg2 ) ! IfW - 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 AWAE_UnPackOtherState - - SUBROUTINE AWAE_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AWAE_MiscVarType), INTENT(IN) :: SrcMiscData - TYPE(AWAE_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) :: 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 = 'AWAE_CopyMisc' -! + ErrMsg = '' + call AWAE_CopyInputFileType(SrcInitInputData%InputFileData, DstInitInputData%InputFileData, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstInitInputData%n_high_low = SrcInitInputData%n_high_low + DstInitInputData%NumDT = SrcInitInputData%NumDT + DstInitInputData%OutFileRoot = SrcInitInputData%OutFileRoot + DstInitInputData%WAT_Enabled = SrcInitInputData%WAT_Enabled + DstInitInputData%WAT_FlowField => SrcInitInputData%WAT_FlowField +end subroutine + +subroutine AWAE_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(AWAE_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AWAE_DestroyInitInput' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcMiscData%Vamb_low)) THEN - i1_l = LBOUND(SrcMiscData%Vamb_low,1) - i1_u = UBOUND(SrcMiscData%Vamb_low,1) - i2_l = LBOUND(SrcMiscData%Vamb_low,2) - i2_u = UBOUND(SrcMiscData%Vamb_low,2) - i3_l = LBOUND(SrcMiscData%Vamb_low,3) - i3_u = UBOUND(SrcMiscData%Vamb_low,3) - i4_l = LBOUND(SrcMiscData%Vamb_low,4) - i4_u = UBOUND(SrcMiscData%Vamb_low,4) - IF (.NOT. ALLOCATED(DstMiscData%Vamb_low)) THEN - ALLOCATE(DstMiscData%Vamb_low(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 DstMiscData%Vamb_low.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%Vamb_low = SrcMiscData%Vamb_low -ENDIF -IF (ALLOCATED(SrcMiscData%Vamb_lowpol)) THEN - i1_l = LBOUND(SrcMiscData%Vamb_lowpol,1) - i1_u = UBOUND(SrcMiscData%Vamb_lowpol,1) - i2_l = LBOUND(SrcMiscData%Vamb_lowpol,2) - i2_u = UBOUND(SrcMiscData%Vamb_lowpol,2) - IF (.NOT. ALLOCATED(DstMiscData%Vamb_lowpol)) THEN - ALLOCATE(DstMiscData%Vamb_lowpol(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Vamb_lowpol.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%Vamb_lowpol = SrcMiscData%Vamb_lowpol -ENDIF -IF (ALLOCATED(SrcMiscData%Vdist_low)) THEN - i1_l = LBOUND(SrcMiscData%Vdist_low,1) - i1_u = UBOUND(SrcMiscData%Vdist_low,1) - i2_l = LBOUND(SrcMiscData%Vdist_low,2) - i2_u = UBOUND(SrcMiscData%Vdist_low,2) - i3_l = LBOUND(SrcMiscData%Vdist_low,3) - i3_u = UBOUND(SrcMiscData%Vdist_low,3) - i4_l = LBOUND(SrcMiscData%Vdist_low,4) - i4_u = UBOUND(SrcMiscData%Vdist_low,4) - IF (.NOT. ALLOCATED(DstMiscData%Vdist_low)) THEN - ALLOCATE(DstMiscData%Vdist_low(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 DstMiscData%Vdist_low.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%Vdist_low = SrcMiscData%Vdist_low -ENDIF -IF (ALLOCATED(SrcMiscData%Vdist_low_full)) THEN - i1_l = LBOUND(SrcMiscData%Vdist_low_full,1) - i1_u = UBOUND(SrcMiscData%Vdist_low_full,1) - i2_l = LBOUND(SrcMiscData%Vdist_low_full,2) - i2_u = UBOUND(SrcMiscData%Vdist_low_full,2) - i3_l = LBOUND(SrcMiscData%Vdist_low_full,3) - i3_u = UBOUND(SrcMiscData%Vdist_low_full,3) - i4_l = LBOUND(SrcMiscData%Vdist_low_full,4) - i4_u = UBOUND(SrcMiscData%Vdist_low_full,4) - IF (.NOT. ALLOCATED(DstMiscData%Vdist_low_full)) THEN - ALLOCATE(DstMiscData%Vdist_low_full(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 DstMiscData%Vdist_low_full.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%Vdist_low_full = SrcMiscData%Vdist_low_full -ENDIF -IF (ALLOCATED(SrcMiscData%Vamb_High)) THEN - i1_l = LBOUND(SrcMiscData%Vamb_High,1) - i1_u = UBOUND(SrcMiscData%Vamb_High,1) - IF (.NOT. ALLOCATED(DstMiscData%Vamb_High)) THEN - ALLOCATE(DstMiscData%Vamb_High(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Vamb_High.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%Vamb_High,1), UBOUND(SrcMiscData%Vamb_High,1) - CALL AWAE_Copyhighwindgrid( SrcMiscData%Vamb_High(i1), DstMiscData%Vamb_High(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcMiscData%parallelFlag)) THEN - i1_l = LBOUND(SrcMiscData%parallelFlag,1) - i1_u = UBOUND(SrcMiscData%parallelFlag,1) - i2_l = LBOUND(SrcMiscData%parallelFlag,2) - i2_u = UBOUND(SrcMiscData%parallelFlag,2) - IF (.NOT. ALLOCATED(DstMiscData%parallelFlag)) THEN - ALLOCATE(DstMiscData%parallelFlag(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%parallelFlag.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%parallelFlag = SrcMiscData%parallelFlag -ENDIF -IF (ALLOCATED(SrcMiscData%r_s)) THEN - i1_l = LBOUND(SrcMiscData%r_s,1) - i1_u = UBOUND(SrcMiscData%r_s,1) - i2_l = LBOUND(SrcMiscData%r_s,2) - i2_u = UBOUND(SrcMiscData%r_s,2) - IF (.NOT. ALLOCATED(DstMiscData%r_s)) THEN - ALLOCATE(DstMiscData%r_s(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%r_s.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%r_s = SrcMiscData%r_s -ENDIF -IF (ALLOCATED(SrcMiscData%r_e)) THEN - i1_l = LBOUND(SrcMiscData%r_e,1) - i1_u = UBOUND(SrcMiscData%r_e,1) - i2_l = LBOUND(SrcMiscData%r_e,2) - i2_u = UBOUND(SrcMiscData%r_e,2) - IF (.NOT. ALLOCATED(DstMiscData%r_e)) THEN - ALLOCATE(DstMiscData%r_e(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%r_e.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%r_e = SrcMiscData%r_e -ENDIF -IF (ALLOCATED(SrcMiscData%rhat_s)) THEN - i1_l = LBOUND(SrcMiscData%rhat_s,1) - i1_u = UBOUND(SrcMiscData%rhat_s,1) - i2_l = LBOUND(SrcMiscData%rhat_s,2) - i2_u = UBOUND(SrcMiscData%rhat_s,2) - i3_l = LBOUND(SrcMiscData%rhat_s,3) - i3_u = UBOUND(SrcMiscData%rhat_s,3) - IF (.NOT. ALLOCATED(DstMiscData%rhat_s)) THEN - ALLOCATE(DstMiscData%rhat_s(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%rhat_s.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%rhat_s = SrcMiscData%rhat_s -ENDIF -IF (ALLOCATED(SrcMiscData%rhat_e)) THEN - i1_l = LBOUND(SrcMiscData%rhat_e,1) - i1_u = UBOUND(SrcMiscData%rhat_e,1) - i2_l = LBOUND(SrcMiscData%rhat_e,2) - i2_u = UBOUND(SrcMiscData%rhat_e,2) - i3_l = LBOUND(SrcMiscData%rhat_e,3) - i3_u = UBOUND(SrcMiscData%rhat_e,3) - IF (.NOT. ALLOCATED(DstMiscData%rhat_e)) THEN - ALLOCATE(DstMiscData%rhat_e(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%rhat_e.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%rhat_e = SrcMiscData%rhat_e -ENDIF -IF (ALLOCATED(SrcMiscData%pvec_cs)) THEN - i1_l = LBOUND(SrcMiscData%pvec_cs,1) - i1_u = UBOUND(SrcMiscData%pvec_cs,1) - i2_l = LBOUND(SrcMiscData%pvec_cs,2) - i2_u = UBOUND(SrcMiscData%pvec_cs,2) - i3_l = LBOUND(SrcMiscData%pvec_cs,3) - i3_u = UBOUND(SrcMiscData%pvec_cs,3) - IF (.NOT. ALLOCATED(DstMiscData%pvec_cs)) THEN - ALLOCATE(DstMiscData%pvec_cs(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%pvec_cs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%pvec_cs = SrcMiscData%pvec_cs -ENDIF -IF (ALLOCATED(SrcMiscData%pvec_ce)) THEN - i1_l = LBOUND(SrcMiscData%pvec_ce,1) - i1_u = UBOUND(SrcMiscData%pvec_ce,1) - i2_l = LBOUND(SrcMiscData%pvec_ce,2) - i2_u = UBOUND(SrcMiscData%pvec_ce,2) - i3_l = LBOUND(SrcMiscData%pvec_ce,3) - i3_u = UBOUND(SrcMiscData%pvec_ce,3) - IF (.NOT. ALLOCATED(DstMiscData%pvec_ce)) THEN - ALLOCATE(DstMiscData%pvec_ce(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%pvec_ce.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%pvec_ce = SrcMiscData%pvec_ce -ENDIF -IF (ALLOCATED(SrcMiscData%outVizXYPlane)) THEN - i1_l = LBOUND(SrcMiscData%outVizXYPlane,1) - i1_u = UBOUND(SrcMiscData%outVizXYPlane,1) - i2_l = LBOUND(SrcMiscData%outVizXYPlane,2) - i2_u = UBOUND(SrcMiscData%outVizXYPlane,2) - i3_l = LBOUND(SrcMiscData%outVizXYPlane,3) - i3_u = UBOUND(SrcMiscData%outVizXYPlane,3) - i4_l = LBOUND(SrcMiscData%outVizXYPlane,4) - i4_u = UBOUND(SrcMiscData%outVizXYPlane,4) - IF (.NOT. ALLOCATED(DstMiscData%outVizXYPlane)) THEN - ALLOCATE(DstMiscData%outVizXYPlane(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 DstMiscData%outVizXYPlane.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%outVizXYPlane = SrcMiscData%outVizXYPlane -ENDIF -IF (ALLOCATED(SrcMiscData%outVizYZPlane)) THEN - i1_l = LBOUND(SrcMiscData%outVizYZPlane,1) - i1_u = UBOUND(SrcMiscData%outVizYZPlane,1) - i2_l = LBOUND(SrcMiscData%outVizYZPlane,2) - i2_u = UBOUND(SrcMiscData%outVizYZPlane,2) - i3_l = LBOUND(SrcMiscData%outVizYZPlane,3) - i3_u = UBOUND(SrcMiscData%outVizYZPlane,3) - i4_l = LBOUND(SrcMiscData%outVizYZPlane,4) - i4_u = UBOUND(SrcMiscData%outVizYZPlane,4) - IF (.NOT. ALLOCATED(DstMiscData%outVizYZPlane)) THEN - ALLOCATE(DstMiscData%outVizYZPlane(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 DstMiscData%outVizYZPlane.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%outVizYZPlane = SrcMiscData%outVizYZPlane -ENDIF -IF (ALLOCATED(SrcMiscData%outVizXZPlane)) THEN - i1_l = LBOUND(SrcMiscData%outVizXZPlane,1) - i1_u = UBOUND(SrcMiscData%outVizXZPlane,1) - i2_l = LBOUND(SrcMiscData%outVizXZPlane,2) - i2_u = UBOUND(SrcMiscData%outVizXZPlane,2) - i3_l = LBOUND(SrcMiscData%outVizXZPlane,3) - i3_u = UBOUND(SrcMiscData%outVizXZPlane,3) - i4_l = LBOUND(SrcMiscData%outVizXZPlane,4) - i4_u = UBOUND(SrcMiscData%outVizXZPlane,4) - IF (.NOT. ALLOCATED(DstMiscData%outVizXZPlane)) THEN - ALLOCATE(DstMiscData%outVizXZPlane(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 DstMiscData%outVizXZPlane.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%outVizXZPlane = SrcMiscData%outVizXZPlane -ENDIF -IF (ALLOCATED(SrcMiscData%IfW)) THEN - i1_l = LBOUND(SrcMiscData%IfW,1) - i1_u = UBOUND(SrcMiscData%IfW,1) - IF (.NOT. ALLOCATED(DstMiscData%IfW)) THEN - ALLOCATE(DstMiscData%IfW(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%IfW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%IfW,1), UBOUND(SrcMiscData%IfW,1) - CALL InflowWind_CopyMisc( SrcMiscData%IfW(i1), DstMiscData%IfW(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL InflowWind_CopyInput( SrcMiscData%u_IfW_Low, DstMiscData%u_IfW_Low, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL InflowWind_CopyInput( SrcMiscData%u_IfW_High, DstMiscData%u_IfW_High, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL InflowWind_CopyOutput( SrcMiscData%y_IfW_Low, DstMiscData%y_IfW_Low, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL InflowWind_CopyOutput( SrcMiscData%y_IfW_High, DstMiscData%y_IfW_High, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE AWAE_CopyMisc - - SUBROUTINE AWAE_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(AWAE_MiscVarType), INTENT(INOUT) :: MiscData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AWAE_DestroyMisc' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(MiscData%Vamb_low)) THEN - DEALLOCATE(MiscData%Vamb_low) -ENDIF -IF (ALLOCATED(MiscData%Vamb_lowpol)) THEN - DEALLOCATE(MiscData%Vamb_lowpol) -ENDIF -IF (ALLOCATED(MiscData%Vdist_low)) THEN - DEALLOCATE(MiscData%Vdist_low) -ENDIF -IF (ALLOCATED(MiscData%Vdist_low_full)) THEN - DEALLOCATE(MiscData%Vdist_low_full) -ENDIF -IF (ALLOCATED(MiscData%Vamb_High)) THEN -DO i1 = LBOUND(MiscData%Vamb_High,1), UBOUND(MiscData%Vamb_High,1) - CALL AWAE_Destroyhighwindgrid( MiscData%Vamb_High(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MiscData%Vamb_High) -ENDIF -IF (ALLOCATED(MiscData%parallelFlag)) THEN - DEALLOCATE(MiscData%parallelFlag) -ENDIF -IF (ALLOCATED(MiscData%r_s)) THEN - DEALLOCATE(MiscData%r_s) -ENDIF -IF (ALLOCATED(MiscData%r_e)) THEN - DEALLOCATE(MiscData%r_e) -ENDIF -IF (ALLOCATED(MiscData%rhat_s)) THEN - DEALLOCATE(MiscData%rhat_s) -ENDIF -IF (ALLOCATED(MiscData%rhat_e)) THEN - DEALLOCATE(MiscData%rhat_e) -ENDIF -IF (ALLOCATED(MiscData%pvec_cs)) THEN - DEALLOCATE(MiscData%pvec_cs) -ENDIF -IF (ALLOCATED(MiscData%pvec_ce)) THEN - DEALLOCATE(MiscData%pvec_ce) -ENDIF -IF (ALLOCATED(MiscData%outVizXYPlane)) THEN - DEALLOCATE(MiscData%outVizXYPlane) -ENDIF -IF (ALLOCATED(MiscData%outVizYZPlane)) THEN - DEALLOCATE(MiscData%outVizYZPlane) -ENDIF -IF (ALLOCATED(MiscData%outVizXZPlane)) THEN - DEALLOCATE(MiscData%outVizXZPlane) -ENDIF -IF (ALLOCATED(MiscData%IfW)) THEN -DO i1 = LBOUND(MiscData%IfW,1), UBOUND(MiscData%IfW,1) - CALL InflowWind_DestroyMisc( MiscData%IfW(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MiscData%IfW) -ENDIF - CALL InflowWind_DestroyInput( MiscData%u_IfW_Low, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL InflowWind_DestroyInput( MiscData%u_IfW_High, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL InflowWind_DestroyOutput( MiscData%y_IfW_Low, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL InflowWind_DestroyOutput( MiscData%y_IfW_High, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE AWAE_DestroyMisc - - SUBROUTINE AWAE_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(AWAE_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 = 'AWAE_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 ! Vamb_low allocated yes/no - IF ( ALLOCATED(InData%Vamb_low) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! Vamb_low upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vamb_low) ! Vamb_low - END IF - Int_BufSz = Int_BufSz + 1 ! Vamb_lowpol allocated yes/no - IF ( ALLOCATED(InData%Vamb_lowpol) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Vamb_lowpol upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vamb_lowpol) ! Vamb_lowpol - END IF - Int_BufSz = Int_BufSz + 1 ! Vdist_low allocated yes/no - IF ( ALLOCATED(InData%Vdist_low) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! Vdist_low upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vdist_low) ! Vdist_low - END IF - Int_BufSz = Int_BufSz + 1 ! Vdist_low_full allocated yes/no - IF ( ALLOCATED(InData%Vdist_low_full) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! Vdist_low_full upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vdist_low_full) ! Vdist_low_full - END IF - Int_BufSz = Int_BufSz + 1 ! Vamb_High allocated yes/no - IF ( ALLOCATED(InData%Vamb_High) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Vamb_High upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%Vamb_High,1), UBOUND(InData%Vamb_High,1) - Int_BufSz = Int_BufSz + 3 ! Vamb_High: size of buffers for each call to pack subtype - CALL AWAE_Packhighwindgrid( Re_Buf, Db_Buf, Int_Buf, InData%Vamb_High(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Vamb_High - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Vamb_High - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Vamb_High - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Vamb_High - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! parallelFlag allocated yes/no - IF ( ALLOCATED(InData%parallelFlag) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! parallelFlag upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%parallelFlag) ! parallelFlag - END IF - Int_BufSz = Int_BufSz + 1 ! r_s allocated yes/no - IF ( ALLOCATED(InData%r_s) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! r_s upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%r_s) ! r_s - END IF - Int_BufSz = Int_BufSz + 1 ! r_e allocated yes/no - IF ( ALLOCATED(InData%r_e) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! r_e upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%r_e) ! r_e - END IF - Int_BufSz = Int_BufSz + 1 ! rhat_s allocated yes/no - IF ( ALLOCATED(InData%rhat_s) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! rhat_s upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%rhat_s) ! rhat_s - END IF - Int_BufSz = Int_BufSz + 1 ! rhat_e allocated yes/no - IF ( ALLOCATED(InData%rhat_e) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! rhat_e upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%rhat_e) ! rhat_e - END IF - Int_BufSz = Int_BufSz + 1 ! pvec_cs allocated yes/no - IF ( ALLOCATED(InData%pvec_cs) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! pvec_cs upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%pvec_cs) ! pvec_cs - END IF - Int_BufSz = Int_BufSz + 1 ! pvec_ce allocated yes/no - IF ( ALLOCATED(InData%pvec_ce) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! pvec_ce upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%pvec_ce) ! pvec_ce - END IF - Int_BufSz = Int_BufSz + 1 ! outVizXYPlane allocated yes/no - IF ( ALLOCATED(InData%outVizXYPlane) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! outVizXYPlane upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%outVizXYPlane) ! outVizXYPlane - END IF - Int_BufSz = Int_BufSz + 1 ! outVizYZPlane allocated yes/no - IF ( ALLOCATED(InData%outVizYZPlane) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! outVizYZPlane upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%outVizYZPlane) ! outVizYZPlane - END IF - Int_BufSz = Int_BufSz + 1 ! outVizXZPlane allocated yes/no - IF ( ALLOCATED(InData%outVizXZPlane) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! outVizXZPlane upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%outVizXZPlane) ! outVizXZPlane - END IF - Int_BufSz = Int_BufSz + 1 ! IfW allocated yes/no - IF ( ALLOCATED(InData%IfW) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! IfW upper/lower bounds for each dimension - DO i1 = LBOUND(InData%IfW,1), UBOUND(InData%IfW,1) - Int_BufSz = Int_BufSz + 3 ! IfW: size of buffers for each call to pack subtype - CALL InflowWind_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%IfW(i1), ErrStat2, ErrMsg2, .TRUE. ) ! IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! IfW - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! IfW - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! IfW - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! u_IfW_Low: size of buffers for each call to pack subtype - CALL InflowWind_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_IfW_Low, ErrStat2, ErrMsg2, .TRUE. ) ! u_IfW_Low - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_IfW_Low - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_IfW_Low - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_IfW_Low - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! u_IfW_High: size of buffers for each call to pack subtype - CALL InflowWind_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_IfW_High, ErrStat2, ErrMsg2, .TRUE. ) ! u_IfW_High - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_IfW_High - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_IfW_High - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_IfW_High - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! y_IfW_Low: size of buffers for each call to pack subtype - CALL InflowWind_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_IfW_Low, ErrStat2, ErrMsg2, .TRUE. ) ! y_IfW_Low - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y_IfW_Low - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y_IfW_Low - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y_IfW_Low - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! y_IfW_High: size of buffers for each call to pack subtype - CALL InflowWind_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_IfW_High, ErrStat2, ErrMsg2, .TRUE. ) ! y_IfW_High - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y_IfW_High - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y_IfW_High - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y_IfW_High - 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%Vamb_low) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vamb_low,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vamb_low,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vamb_low,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vamb_low,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vamb_low,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vamb_low,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vamb_low,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vamb_low,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%Vamb_low,4), UBOUND(InData%Vamb_low,4) - DO i3 = LBOUND(InData%Vamb_low,3), UBOUND(InData%Vamb_low,3) - DO i2 = LBOUND(InData%Vamb_low,2), UBOUND(InData%Vamb_low,2) - DO i1 = LBOUND(InData%Vamb_low,1), UBOUND(InData%Vamb_low,1) - ReKiBuf(Re_Xferred) = InData%Vamb_low(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Vamb_lowpol) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vamb_lowpol,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vamb_lowpol,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vamb_lowpol,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vamb_lowpol,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Vamb_lowpol,2), UBOUND(InData%Vamb_lowpol,2) - DO i1 = LBOUND(InData%Vamb_lowpol,1), UBOUND(InData%Vamb_lowpol,1) - ReKiBuf(Re_Xferred) = InData%Vamb_lowpol(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Vdist_low) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vdist_low,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vdist_low,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vdist_low,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vdist_low,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vdist_low,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vdist_low,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vdist_low,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vdist_low,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%Vdist_low,4), UBOUND(InData%Vdist_low,4) - DO i3 = LBOUND(InData%Vdist_low,3), UBOUND(InData%Vdist_low,3) - DO i2 = LBOUND(InData%Vdist_low,2), UBOUND(InData%Vdist_low,2) - DO i1 = LBOUND(InData%Vdist_low,1), UBOUND(InData%Vdist_low,1) - ReKiBuf(Re_Xferred) = InData%Vdist_low(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Vdist_low_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%Vdist_low_full,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vdist_low_full,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vdist_low_full,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vdist_low_full,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vdist_low_full,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vdist_low_full,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vdist_low_full,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vdist_low_full,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%Vdist_low_full,4), UBOUND(InData%Vdist_low_full,4) - DO i3 = LBOUND(InData%Vdist_low_full,3), UBOUND(InData%Vdist_low_full,3) - DO i2 = LBOUND(InData%Vdist_low_full,2), UBOUND(InData%Vdist_low_full,2) - DO i1 = LBOUND(InData%Vdist_low_full,1), UBOUND(InData%Vdist_low_full,1) - ReKiBuf(Re_Xferred) = InData%Vdist_low_full(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Vamb_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%Vamb_High,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vamb_High,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Vamb_High,1), UBOUND(InData%Vamb_High,1) - CALL AWAE_Packhighwindgrid( Re_Buf, Db_Buf, Int_Buf, InData%Vamb_High(i1), ErrStat2, ErrMsg2, OnlySize ) ! Vamb_High - 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%parallelFlag) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%parallelFlag,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%parallelFlag,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%parallelFlag,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%parallelFlag,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%parallelFlag,2), UBOUND(InData%parallelFlag,2) - DO i1 = LBOUND(InData%parallelFlag,1), UBOUND(InData%parallelFlag,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%parallelFlag(i1,i2), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%r_s) ) THEN - 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_s,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%r_s,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%r_s,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%r_s,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%r_s,2), UBOUND(InData%r_s,2) - DO i1 = LBOUND(InData%r_s,1), UBOUND(InData%r_s,1) - ReKiBuf(Re_Xferred) = InData%r_s(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%r_e) ) THEN - 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_e,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%r_e,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%r_e,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%r_e,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%r_e,2), UBOUND(InData%r_e,2) - DO i1 = LBOUND(InData%r_e,1), UBOUND(InData%r_e,1) - ReKiBuf(Re_Xferred) = InData%r_e(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%rhat_s) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rhat_s,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rhat_s,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rhat_s,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rhat_s,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rhat_s,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rhat_s,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%rhat_s,3), UBOUND(InData%rhat_s,3) - DO i2 = LBOUND(InData%rhat_s,2), UBOUND(InData%rhat_s,2) - DO i1 = LBOUND(InData%rhat_s,1), UBOUND(InData%rhat_s,1) - ReKiBuf(Re_Xferred) = InData%rhat_s(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%rhat_e) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rhat_e,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rhat_e,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rhat_e,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rhat_e,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rhat_e,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rhat_e,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%rhat_e,3), UBOUND(InData%rhat_e,3) - DO i2 = LBOUND(InData%rhat_e,2), UBOUND(InData%rhat_e,2) - DO i1 = LBOUND(InData%rhat_e,1), UBOUND(InData%rhat_e,1) - ReKiBuf(Re_Xferred) = InData%rhat_e(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%pvec_cs) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%pvec_cs,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%pvec_cs,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%pvec_cs,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%pvec_cs,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%pvec_cs,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%pvec_cs,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%pvec_cs,3), UBOUND(InData%pvec_cs,3) - DO i2 = LBOUND(InData%pvec_cs,2), UBOUND(InData%pvec_cs,2) - DO i1 = LBOUND(InData%pvec_cs,1), UBOUND(InData%pvec_cs,1) - ReKiBuf(Re_Xferred) = InData%pvec_cs(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%pvec_ce) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%pvec_ce,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%pvec_ce,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%pvec_ce,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%pvec_ce,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%pvec_ce,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%pvec_ce,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%pvec_ce,3), UBOUND(InData%pvec_ce,3) - DO i2 = LBOUND(InData%pvec_ce,2), UBOUND(InData%pvec_ce,2) - DO i1 = LBOUND(InData%pvec_ce,1), UBOUND(InData%pvec_ce,1) - ReKiBuf(Re_Xferred) = InData%pvec_ce(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%outVizXYPlane) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%outVizXYPlane,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%outVizXYPlane,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%outVizXYPlane,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%outVizXYPlane,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%outVizXYPlane,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%outVizXYPlane,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%outVizXYPlane,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%outVizXYPlane,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%outVizXYPlane,4), UBOUND(InData%outVizXYPlane,4) - DO i3 = LBOUND(InData%outVizXYPlane,3), UBOUND(InData%outVizXYPlane,3) - DO i2 = LBOUND(InData%outVizXYPlane,2), UBOUND(InData%outVizXYPlane,2) - DO i1 = LBOUND(InData%outVizXYPlane,1), UBOUND(InData%outVizXYPlane,1) - ReKiBuf(Re_Xferred) = InData%outVizXYPlane(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%outVizYZPlane) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%outVizYZPlane,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%outVizYZPlane,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%outVizYZPlane,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%outVizYZPlane,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%outVizYZPlane,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%outVizYZPlane,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%outVizYZPlane,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%outVizYZPlane,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%outVizYZPlane,4), UBOUND(InData%outVizYZPlane,4) - DO i3 = LBOUND(InData%outVizYZPlane,3), UBOUND(InData%outVizYZPlane,3) - DO i2 = LBOUND(InData%outVizYZPlane,2), UBOUND(InData%outVizYZPlane,2) - DO i1 = LBOUND(InData%outVizYZPlane,1), UBOUND(InData%outVizYZPlane,1) - ReKiBuf(Re_Xferred) = InData%outVizYZPlane(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%outVizXZPlane) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%outVizXZPlane,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%outVizXZPlane,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%outVizXZPlane,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%outVizXZPlane,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%outVizXZPlane,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%outVizXZPlane,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%outVizXZPlane,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%outVizXZPlane,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%outVizXZPlane,4), UBOUND(InData%outVizXZPlane,4) - DO i3 = LBOUND(InData%outVizXZPlane,3), UBOUND(InData%outVizXZPlane,3) - DO i2 = LBOUND(InData%outVizXZPlane,2), UBOUND(InData%outVizXZPlane,2) - DO i1 = LBOUND(InData%outVizXZPlane,1), UBOUND(InData%outVizXZPlane,1) - ReKiBuf(Re_Xferred) = InData%outVizXZPlane(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%IfW) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%IfW,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IfW,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%IfW,1), UBOUND(InData%IfW,1) - CALL InflowWind_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%IfW(i1), ErrStat2, ErrMsg2, OnlySize ) ! IfW - 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 - CALL InflowWind_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_IfW_Low, ErrStat2, ErrMsg2, OnlySize ) ! u_IfW_Low - 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 InflowWind_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_IfW_High, ErrStat2, ErrMsg2, OnlySize ) ! u_IfW_High - 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 InflowWind_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_IfW_Low, ErrStat2, ErrMsg2, OnlySize ) ! y_IfW_Low - 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 InflowWind_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_IfW_High, ErrStat2, ErrMsg2, OnlySize ) ! y_IfW_High - 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 AWAE_PackMisc - - SUBROUTINE AWAE_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(AWAE_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) :: 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 = 'AWAE_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 ! Vamb_low not allocated - Int_Xferred = Int_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%Vamb_low)) DEALLOCATE(OutData%Vamb_low) - ALLOCATE(OutData%Vamb_low(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%Vamb_low.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%Vamb_low,4), UBOUND(OutData%Vamb_low,4) - DO i3 = LBOUND(OutData%Vamb_low,3), UBOUND(OutData%Vamb_low,3) - DO i2 = LBOUND(OutData%Vamb_low,2), UBOUND(OutData%Vamb_low,2) - DO i1 = LBOUND(OutData%Vamb_low,1), UBOUND(OutData%Vamb_low,1) - OutData%Vamb_low(i1,i2,i3,i4) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vamb_lowpol not allocated - Int_Xferred = Int_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%Vamb_lowpol)) DEALLOCATE(OutData%Vamb_lowpol) - ALLOCATE(OutData%Vamb_lowpol(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vamb_lowpol.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Vamb_lowpol,2), UBOUND(OutData%Vamb_lowpol,2) - DO i1 = LBOUND(OutData%Vamb_lowpol,1), UBOUND(OutData%Vamb_lowpol,1) - OutData%Vamb_lowpol(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vdist_low not allocated - Int_Xferred = Int_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%Vdist_low)) DEALLOCATE(OutData%Vdist_low) - ALLOCATE(OutData%Vdist_low(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%Vdist_low.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%Vdist_low,4), UBOUND(OutData%Vdist_low,4) - DO i3 = LBOUND(OutData%Vdist_low,3), UBOUND(OutData%Vdist_low,3) - DO i2 = LBOUND(OutData%Vdist_low,2), UBOUND(OutData%Vdist_low,2) - DO i1 = LBOUND(OutData%Vdist_low,1), UBOUND(OutData%Vdist_low,1) - OutData%Vdist_low(i1,i2,i3,i4) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vdist_low_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 - 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%Vdist_low_full)) DEALLOCATE(OutData%Vdist_low_full) - ALLOCATE(OutData%Vdist_low_full(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%Vdist_low_full.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%Vdist_low_full,4), UBOUND(OutData%Vdist_low_full,4) - DO i3 = LBOUND(OutData%Vdist_low_full,3), UBOUND(OutData%Vdist_low_full,3) - DO i2 = LBOUND(OutData%Vdist_low_full,2), UBOUND(OutData%Vdist_low_full,2) - DO i1 = LBOUND(OutData%Vdist_low_full,1), UBOUND(OutData%Vdist_low_full,1) - OutData%Vdist_low_full(i1,i2,i3,i4) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vamb_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%Vamb_High)) DEALLOCATE(OutData%Vamb_High) - ALLOCATE(OutData%Vamb_High(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vamb_High.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Vamb_High,1), UBOUND(OutData%Vamb_High,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 AWAE_Unpackhighwindgrid( Re_Buf, Db_Buf, Int_Buf, OutData%Vamb_High(i1), ErrStat2, ErrMsg2 ) ! Vamb_High - 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 ! parallelFlag not allocated - Int_Xferred = Int_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%parallelFlag)) DEALLOCATE(OutData%parallelFlag) - ALLOCATE(OutData%parallelFlag(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%parallelFlag.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%parallelFlag,2), UBOUND(OutData%parallelFlag,2) - DO i1 = LBOUND(OutData%parallelFlag,1), UBOUND(OutData%parallelFlag,1) - OutData%parallelFlag(i1,i2) = TRANSFER(IntKiBuf(Int_Xferred), OutData%parallelFlag(i1,i2)) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! r_s not allocated - Int_Xferred = Int_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%r_s)) DEALLOCATE(OutData%r_s) - ALLOCATE(OutData%r_s(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%r_s.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%r_s,2), UBOUND(OutData%r_s,2) - DO i1 = LBOUND(OutData%r_s,1), UBOUND(OutData%r_s,1) - OutData%r_s(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! r_e not allocated - Int_Xferred = Int_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%r_e)) DEALLOCATE(OutData%r_e) - ALLOCATE(OutData%r_e(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%r_e.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%r_e,2), UBOUND(OutData%r_e,2) - DO i1 = LBOUND(OutData%r_e,1), UBOUND(OutData%r_e,1) - OutData%r_e(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rhat_s not allocated - Int_Xferred = Int_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%rhat_s)) DEALLOCATE(OutData%rhat_s) - ALLOCATE(OutData%rhat_s(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%rhat_s.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%rhat_s,3), UBOUND(OutData%rhat_s,3) - DO i2 = LBOUND(OutData%rhat_s,2), UBOUND(OutData%rhat_s,2) - DO i1 = LBOUND(OutData%rhat_s,1), UBOUND(OutData%rhat_s,1) - OutData%rhat_s(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 ! rhat_e not allocated - Int_Xferred = Int_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%rhat_e)) DEALLOCATE(OutData%rhat_e) - ALLOCATE(OutData%rhat_e(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%rhat_e.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%rhat_e,3), UBOUND(OutData%rhat_e,3) - DO i2 = LBOUND(OutData%rhat_e,2), UBOUND(OutData%rhat_e,2) - DO i1 = LBOUND(OutData%rhat_e,1), UBOUND(OutData%rhat_e,1) - OutData%rhat_e(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 ! pvec_cs not allocated - Int_Xferred = Int_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%pvec_cs)) DEALLOCATE(OutData%pvec_cs) - ALLOCATE(OutData%pvec_cs(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%pvec_cs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%pvec_cs,3), UBOUND(OutData%pvec_cs,3) - DO i2 = LBOUND(OutData%pvec_cs,2), UBOUND(OutData%pvec_cs,2) - DO i1 = LBOUND(OutData%pvec_cs,1), UBOUND(OutData%pvec_cs,1) - OutData%pvec_cs(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 ! pvec_ce not allocated - Int_Xferred = Int_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%pvec_ce)) DEALLOCATE(OutData%pvec_ce) - ALLOCATE(OutData%pvec_ce(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%pvec_ce.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%pvec_ce,3), UBOUND(OutData%pvec_ce,3) - DO i2 = LBOUND(OutData%pvec_ce,2), UBOUND(OutData%pvec_ce,2) - DO i1 = LBOUND(OutData%pvec_ce,1), UBOUND(OutData%pvec_ce,1) - OutData%pvec_ce(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 ! outVizXYPlane not allocated - Int_Xferred = Int_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%outVizXYPlane)) DEALLOCATE(OutData%outVizXYPlane) - ALLOCATE(OutData%outVizXYPlane(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%outVizXYPlane.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%outVizXYPlane,4), UBOUND(OutData%outVizXYPlane,4) - DO i3 = LBOUND(OutData%outVizXYPlane,3), UBOUND(OutData%outVizXYPlane,3) - DO i2 = LBOUND(OutData%outVizXYPlane,2), UBOUND(OutData%outVizXYPlane,2) - DO i1 = LBOUND(OutData%outVizXYPlane,1), UBOUND(OutData%outVizXYPlane,1) - OutData%outVizXYPlane(i1,i2,i3,i4) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! outVizYZPlane not allocated - Int_Xferred = Int_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%outVizYZPlane)) DEALLOCATE(OutData%outVizYZPlane) - ALLOCATE(OutData%outVizYZPlane(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%outVizYZPlane.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%outVizYZPlane,4), UBOUND(OutData%outVizYZPlane,4) - DO i3 = LBOUND(OutData%outVizYZPlane,3), UBOUND(OutData%outVizYZPlane,3) - DO i2 = LBOUND(OutData%outVizYZPlane,2), UBOUND(OutData%outVizYZPlane,2) - DO i1 = LBOUND(OutData%outVizYZPlane,1), UBOUND(OutData%outVizYZPlane,1) - OutData%outVizYZPlane(i1,i2,i3,i4) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! outVizXZPlane not allocated - Int_Xferred = Int_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%outVizXZPlane)) DEALLOCATE(OutData%outVizXZPlane) - ALLOCATE(OutData%outVizXZPlane(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%outVizXZPlane.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%outVizXZPlane,4), UBOUND(OutData%outVizXZPlane,4) - DO i3 = LBOUND(OutData%outVizXZPlane,3), UBOUND(OutData%outVizXZPlane,3) - DO i2 = LBOUND(OutData%outVizXZPlane,2), UBOUND(OutData%outVizXZPlane,2) - DO i1 = LBOUND(OutData%outVizXZPlane,1), UBOUND(OutData%outVizXZPlane,1) - OutData%outVizXZPlane(i1,i2,i3,i4) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IfW not allocated - Int_Xferred = Int_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%IfW)) DEALLOCATE(OutData%IfW) - ALLOCATE(OutData%IfW(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IfW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%IfW,1), UBOUND(OutData%IfW,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 InflowWind_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%IfW(i1), ErrStat2, ErrMsg2 ) ! IfW - 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 - 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 InflowWind_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u_IfW_Low, ErrStat2, ErrMsg2 ) ! u_IfW_Low - 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 InflowWind_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u_IfW_High, ErrStat2, ErrMsg2 ) ! u_IfW_High - 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 InflowWind_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y_IfW_Low, ErrStat2, ErrMsg2 ) ! y_IfW_Low - 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 InflowWind_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y_IfW_High, ErrStat2, ErrMsg2 ) ! y_IfW_High - 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 AWAE_UnPackMisc - - SUBROUTINE AWAE_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AWAE_ParameterType), INTENT(IN) :: SrcParamData - TYPE(AWAE_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) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AWAE_CopyParam' -! + ErrMsg = '' + call AWAE_DestroyInputFileType(InitInputData%InputFileData, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + nullify(InitInputData%WAT_FlowField) +end subroutine + +subroutine AWAE_PackInitInput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(AWAE_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AWAE_PackInitInput' + logical :: PtrInIndex + if (RF%ErrStat >= AbortErrLev) return + call AWAE_PackInputFileType(RF, InData%InputFileData) + call RegPack(RF, InData%n_high_low) + call RegPack(RF, InData%NumDT) + call RegPack(RF, InData%OutFileRoot) + call RegPack(RF, InData%WAT_Enabled) + call RegPack(RF, associated(InData%WAT_FlowField)) + if (associated(InData%WAT_FlowField)) then + call RegPackPointer(RF, c_loc(InData%WAT_FlowField), PtrInIndex) + if (.not. PtrInIndex) then + call IfW_FlowField_PackFlowFieldType(RF, InData%WAT_FlowField) + end if + end if + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AWAE_UnPackInitInput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(AWAE_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AWAE_UnPackInitInput' + integer(B4Ki) :: LB(0), UB(0) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(B8Ki) :: PtrIdx + type(c_ptr) :: Ptr + if (RF%ErrStat /= ErrID_None) return + call AWAE_UnpackInputFileType(RF, OutData%InputFileData) ! InputFileData + call RegUnpack(RF, OutData%n_high_low); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumDT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutFileRoot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WAT_Enabled); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%WAT_FlowField)) deallocate(OutData%WAT_FlowField) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackPointer(RF, Ptr, PtrIdx); if (RegCheckErr(RF, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WAT_FlowField) + else + allocate(OutData%WAT_FlowField,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WAT_FlowField.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + RF%Pointers(PtrIdx) = c_loc(OutData%WAT_FlowField) + call IfW_FlowField_UnpackFlowFieldType(RF, OutData%WAT_FlowField) ! WAT_FlowField + end if + else + OutData%WAT_FlowField => null() + end if +end subroutine + +subroutine AWAE_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) + type(AWAE_InitOutputType), intent(in) :: SrcInitOutputData + type(AWAE_InitOutputType), intent(inout) :: DstInitOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AWAE_CopyInitOutput' ErrStat = ErrID_None - ErrMsg = "" - DstParamData%WindFilePath = SrcParamData%WindFilePath - DstParamData%NumTurbines = SrcParamData%NumTurbines - DstParamData%NumRadii = SrcParamData%NumRadii - DstParamData%NumPlanes = SrcParamData%NumPlanes -IF (ALLOCATED(SrcParamData%y)) THEN - i1_l = LBOUND(SrcParamData%y,1) - i1_u = UBOUND(SrcParamData%y,1) - IF (.NOT. ALLOCATED(DstParamData%y)) THEN - ALLOCATE(DstParamData%y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%y = SrcParamData%y -ENDIF -IF (ALLOCATED(SrcParamData%z)) THEN - i1_l = LBOUND(SrcParamData%z,1) - i1_u = UBOUND(SrcParamData%z,1) - IF (.NOT. ALLOCATED(DstParamData%z)) THEN - ALLOCATE(DstParamData%z(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%z.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%z = SrcParamData%z -ENDIF - DstParamData%Mod_AmbWind = SrcParamData%Mod_AmbWind - DstParamData%nX_low = SrcParamData%nX_low - DstParamData%nY_low = SrcParamData%nY_low - DstParamData%nZ_low = SrcParamData%nZ_low - DstParamData%NumGrid_low = SrcParamData%NumGrid_low - DstParamData%n_rp_max = SrcParamData%n_rp_max - DstParamData%dpol = SrcParamData%dpol - DstParamData%dXYZ_low = SrcParamData%dXYZ_low - DstParamData%dX_low = SrcParamData%dX_low - DstParamData%dY_low = SrcParamData%dY_low - DstParamData%dZ_low = SrcParamData%dZ_low - DstParamData%X0_low = SrcParamData%X0_low - DstParamData%Y0_low = SrcParamData%Y0_low - DstParamData%Z0_low = SrcParamData%Z0_low -IF (ALLOCATED(SrcParamData%X0_high)) THEN - i1_l = LBOUND(SrcParamData%X0_high,1) - i1_u = UBOUND(SrcParamData%X0_high,1) - IF (.NOT. ALLOCATED(DstParamData%X0_high)) THEN - ALLOCATE(DstParamData%X0_high(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%X0_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%X0_high = SrcParamData%X0_high -ENDIF -IF (ALLOCATED(SrcParamData%Y0_high)) THEN - i1_l = LBOUND(SrcParamData%Y0_high,1) - i1_u = UBOUND(SrcParamData%Y0_high,1) - IF (.NOT. ALLOCATED(DstParamData%Y0_high)) THEN - ALLOCATE(DstParamData%Y0_high(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Y0_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Y0_high = SrcParamData%Y0_high -ENDIF -IF (ALLOCATED(SrcParamData%Z0_high)) THEN - i1_l = LBOUND(SrcParamData%Z0_high,1) - i1_u = UBOUND(SrcParamData%Z0_high,1) - IF (.NOT. ALLOCATED(DstParamData%Z0_high)) THEN - ALLOCATE(DstParamData%Z0_high(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Z0_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Z0_high = SrcParamData%Z0_high -ENDIF -IF (ALLOCATED(SrcParamData%dX_high)) THEN - i1_l = LBOUND(SrcParamData%dX_high,1) - i1_u = UBOUND(SrcParamData%dX_high,1) - IF (.NOT. ALLOCATED(DstParamData%dX_high)) THEN - ALLOCATE(DstParamData%dX_high(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%dX_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%dX_high = SrcParamData%dX_high -ENDIF -IF (ALLOCATED(SrcParamData%dY_high)) THEN - i1_l = LBOUND(SrcParamData%dY_high,1) - i1_u = UBOUND(SrcParamData%dY_high,1) - IF (.NOT. ALLOCATED(DstParamData%dY_high)) THEN - ALLOCATE(DstParamData%dY_high(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%dY_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%dY_high = SrcParamData%dY_high -ENDIF -IF (ALLOCATED(SrcParamData%dZ_high)) THEN - i1_l = LBOUND(SrcParamData%dZ_high,1) - i1_u = UBOUND(SrcParamData%dZ_high,1) - IF (.NOT. ALLOCATED(DstParamData%dZ_high)) THEN - ALLOCATE(DstParamData%dZ_high(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%dZ_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%dZ_high = SrcParamData%dZ_high -ENDIF - DstParamData%nX_high = SrcParamData%nX_high - DstParamData%nY_high = SrcParamData%nY_high - DstParamData%nZ_high = SrcParamData%nZ_high -IF (ALLOCATED(SrcParamData%Grid_low)) THEN - i1_l = LBOUND(SrcParamData%Grid_low,1) - i1_u = UBOUND(SrcParamData%Grid_low,1) - i2_l = LBOUND(SrcParamData%Grid_low,2) - i2_u = UBOUND(SrcParamData%Grid_low,2) - IF (.NOT. ALLOCATED(DstParamData%Grid_low)) THEN - ALLOCATE(DstParamData%Grid_low(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Grid_low.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Grid_low = SrcParamData%Grid_low -ENDIF -IF (ALLOCATED(SrcParamData%Grid_high)) THEN - i1_l = LBOUND(SrcParamData%Grid_high,1) - i1_u = UBOUND(SrcParamData%Grid_high,1) - i2_l = LBOUND(SrcParamData%Grid_high,2) - i2_u = UBOUND(SrcParamData%Grid_high,2) - i3_l = LBOUND(SrcParamData%Grid_high,3) - i3_u = UBOUND(SrcParamData%Grid_high,3) - IF (.NOT. ALLOCATED(DstParamData%Grid_high)) THEN - ALLOCATE(DstParamData%Grid_high(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Grid_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Grid_high = SrcParamData%Grid_high -ENDIF -IF (ALLOCATED(SrcParamData%WT_Position)) THEN - i1_l = LBOUND(SrcParamData%WT_Position,1) - i1_u = UBOUND(SrcParamData%WT_Position,1) - i2_l = LBOUND(SrcParamData%WT_Position,2) - i2_u = UBOUND(SrcParamData%WT_Position,2) - IF (.NOT. ALLOCATED(DstParamData%WT_Position)) THEN - ALLOCATE(DstParamData%WT_Position(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WT_Position.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%WT_Position = SrcParamData%WT_Position -ENDIF - DstParamData%n_high_low = SrcParamData%n_high_low - DstParamData%dt_low = SrcParamData%dt_low - DstParamData%dt_high = SrcParamData%dt_high - DstParamData%NumDT = SrcParamData%NumDT - DstParamData%Mod_Meander = SrcParamData%Mod_Meander - DstParamData%C_Meander = SrcParamData%C_Meander - DstParamData%C_ScaleDiam = SrcParamData%C_ScaleDiam - DstParamData%Mod_Projection = SrcParamData%Mod_Projection -IF (ALLOCATED(SrcParamData%IfW)) THEN - i1_l = LBOUND(SrcParamData%IfW,1) - i1_u = UBOUND(SrcParamData%IfW,1) - IF (.NOT. ALLOCATED(DstParamData%IfW)) THEN - ALLOCATE(DstParamData%IfW(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IfW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcParamData%IfW,1), UBOUND(SrcParamData%IfW,1) - CALL InflowWind_CopyParam( SrcParamData%IfW(i1), DstParamData%IfW(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - DstParamData%WrDisSkp1 = SrcParamData%WrDisSkp1 - DstParamData%WrDisWind = SrcParamData%WrDisWind - DstParamData%NOutDisWindXY = SrcParamData%NOutDisWindXY -IF (ALLOCATED(SrcParamData%OutDisWindZ)) THEN - i1_l = LBOUND(SrcParamData%OutDisWindZ,1) - i1_u = UBOUND(SrcParamData%OutDisWindZ,1) - IF (.NOT. ALLOCATED(DstParamData%OutDisWindZ)) THEN - ALLOCATE(DstParamData%OutDisWindZ(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutDisWindZ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%OutDisWindZ = SrcParamData%OutDisWindZ -ENDIF - DstParamData%NOutDisWindYZ = SrcParamData%NOutDisWindYZ -IF (ALLOCATED(SrcParamData%OutDisWindX)) THEN - i1_l = LBOUND(SrcParamData%OutDisWindX,1) - i1_u = UBOUND(SrcParamData%OutDisWindX,1) - IF (.NOT. ALLOCATED(DstParamData%OutDisWindX)) THEN - ALLOCATE(DstParamData%OutDisWindX(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutDisWindX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%OutDisWindX = SrcParamData%OutDisWindX -ENDIF - DstParamData%NOutDisWindXZ = SrcParamData%NOutDisWindXZ -IF (ALLOCATED(SrcParamData%OutDisWindY)) THEN - i1_l = LBOUND(SrcParamData%OutDisWindY,1) - i1_u = UBOUND(SrcParamData%OutDisWindY,1) - IF (.NOT. ALLOCATED(DstParamData%OutDisWindY)) THEN - ALLOCATE(DstParamData%OutDisWindY(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutDisWindY.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%OutDisWindY = SrcParamData%OutDisWindY -ENDIF - DstParamData%OutFileRoot = SrcParamData%OutFileRoot - DstParamData%OutFileVTKRoot = SrcParamData%OutFileVTKRoot - DstParamData%VTK_tWidth = SrcParamData%VTK_tWidth - END SUBROUTINE AWAE_CopyParam - - SUBROUTINE AWAE_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(AWAE_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AWAE_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(ParamData%y)) THEN - DEALLOCATE(ParamData%y) -ENDIF -IF (ALLOCATED(ParamData%z)) THEN - DEALLOCATE(ParamData%z) -ENDIF -IF (ALLOCATED(ParamData%X0_high)) THEN - DEALLOCATE(ParamData%X0_high) -ENDIF -IF (ALLOCATED(ParamData%Y0_high)) THEN - DEALLOCATE(ParamData%Y0_high) -ENDIF -IF (ALLOCATED(ParamData%Z0_high)) THEN - DEALLOCATE(ParamData%Z0_high) -ENDIF -IF (ALLOCATED(ParamData%dX_high)) THEN - DEALLOCATE(ParamData%dX_high) -ENDIF -IF (ALLOCATED(ParamData%dY_high)) THEN - DEALLOCATE(ParamData%dY_high) -ENDIF -IF (ALLOCATED(ParamData%dZ_high)) THEN - DEALLOCATE(ParamData%dZ_high) -ENDIF -IF (ALLOCATED(ParamData%Grid_low)) THEN - DEALLOCATE(ParamData%Grid_low) -ENDIF -IF (ALLOCATED(ParamData%Grid_high)) THEN - DEALLOCATE(ParamData%Grid_high) -ENDIF -IF (ALLOCATED(ParamData%WT_Position)) THEN - DEALLOCATE(ParamData%WT_Position) -ENDIF -IF (ALLOCATED(ParamData%IfW)) THEN -DO i1 = LBOUND(ParamData%IfW,1), UBOUND(ParamData%IfW,1) - CALL InflowWind_DestroyParam( ParamData%IfW(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ParamData%IfW) -ENDIF -IF (ALLOCATED(ParamData%OutDisWindZ)) THEN - DEALLOCATE(ParamData%OutDisWindZ) -ENDIF -IF (ALLOCATED(ParamData%OutDisWindX)) THEN - DEALLOCATE(ParamData%OutDisWindX) -ENDIF -IF (ALLOCATED(ParamData%OutDisWindY)) THEN - DEALLOCATE(ParamData%OutDisWindY) -ENDIF - END SUBROUTINE AWAE_DestroyParam - - SUBROUTINE AWAE_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(AWAE_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 = 'AWAE_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*LEN(InData%WindFilePath) ! WindFilePath - Int_BufSz = Int_BufSz + 1 ! NumTurbines - Int_BufSz = Int_BufSz + 1 ! NumRadii - Int_BufSz = Int_BufSz + 1 ! NumPlanes - Int_BufSz = Int_BufSz + 1 ! y allocated yes/no - IF ( ALLOCATED(InData%y) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! y upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%y) ! y - END IF - Int_BufSz = Int_BufSz + 1 ! z allocated yes/no - IF ( ALLOCATED(InData%z) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! z upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%z) ! z - END IF - Int_BufSz = Int_BufSz + 1 ! Mod_AmbWind - Int_BufSz = Int_BufSz + 1 ! nX_low - Int_BufSz = Int_BufSz + 1 ! nY_low - Int_BufSz = Int_BufSz + 1 ! nZ_low - Int_BufSz = Int_BufSz + 1 ! NumGrid_low - Int_BufSz = Int_BufSz + 1 ! n_rp_max - Re_BufSz = Re_BufSz + 1 ! dpol - Re_BufSz = Re_BufSz + SIZE(InData%dXYZ_low) ! dXYZ_low - Re_BufSz = Re_BufSz + 1 ! dX_low - Re_BufSz = Re_BufSz + 1 ! dY_low - Re_BufSz = Re_BufSz + 1 ! dZ_low - Re_BufSz = Re_BufSz + 1 ! X0_low - Re_BufSz = Re_BufSz + 1 ! Y0_low - Re_BufSz = Re_BufSz + 1 ! Z0_low - Int_BufSz = Int_BufSz + 1 ! X0_high allocated yes/no - IF ( ALLOCATED(InData%X0_high) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! X0_high upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%X0_high) ! X0_high - END IF - Int_BufSz = Int_BufSz + 1 ! Y0_high allocated yes/no - IF ( ALLOCATED(InData%Y0_high) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Y0_high upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Y0_high) ! Y0_high - END IF - Int_BufSz = Int_BufSz + 1 ! Z0_high allocated yes/no - IF ( ALLOCATED(InData%Z0_high) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Z0_high upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Z0_high) ! Z0_high - END IF - Int_BufSz = Int_BufSz + 1 ! dX_high allocated yes/no - IF ( ALLOCATED(InData%dX_high) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! dX_high upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%dX_high) ! dX_high - END IF - Int_BufSz = Int_BufSz + 1 ! dY_high allocated yes/no - IF ( ALLOCATED(InData%dY_high) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! dY_high upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%dY_high) ! dY_high - END IF - Int_BufSz = Int_BufSz + 1 ! dZ_high allocated yes/no - IF ( ALLOCATED(InData%dZ_high) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! dZ_high upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%dZ_high) ! dZ_high - END IF - Int_BufSz = Int_BufSz + 1 ! nX_high - Int_BufSz = Int_BufSz + 1 ! nY_high - Int_BufSz = Int_BufSz + 1 ! nZ_high - Int_BufSz = Int_BufSz + 1 ! Grid_low allocated yes/no - IF ( ALLOCATED(InData%Grid_low) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Grid_low upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Grid_low) ! Grid_low - END IF - Int_BufSz = Int_BufSz + 1 ! Grid_high allocated yes/no - IF ( ALLOCATED(InData%Grid_high) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Grid_high upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Grid_high) ! Grid_high - END IF - Int_BufSz = Int_BufSz + 1 ! WT_Position allocated yes/no - IF ( ALLOCATED(InData%WT_Position) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! WT_Position upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WT_Position) ! WT_Position - END IF - Int_BufSz = Int_BufSz + 1 ! n_high_low - Db_BufSz = Db_BufSz + 1 ! dt_low - Db_BufSz = Db_BufSz + 1 ! dt_high - Int_BufSz = Int_BufSz + 1 ! NumDT - Int_BufSz = Int_BufSz + 1 ! Mod_Meander - Re_BufSz = Re_BufSz + 1 ! C_Meander - Re_BufSz = Re_BufSz + 1 ! C_ScaleDiam - Int_BufSz = Int_BufSz + 1 ! Mod_Projection - Int_BufSz = Int_BufSz + 1 ! IfW allocated yes/no - IF ( ALLOCATED(InData%IfW) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! IfW upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%IfW,1), UBOUND(InData%IfW,1) - Int_BufSz = Int_BufSz + 3 ! IfW: size of buffers for each call to pack subtype - CALL InflowWind_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%IfW(i1), ErrStat2, ErrMsg2, .TRUE. ) ! IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! IfW - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! IfW - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! IfW - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! WrDisSkp1 - Int_BufSz = Int_BufSz + 1 ! WrDisWind - Int_BufSz = Int_BufSz + 1 ! NOutDisWindXY - Int_BufSz = Int_BufSz + 1 ! OutDisWindZ allocated yes/no - IF ( ALLOCATED(InData%OutDisWindZ) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OutDisWindZ upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%OutDisWindZ) ! OutDisWindZ - END IF - Int_BufSz = Int_BufSz + 1 ! NOutDisWindYZ - Int_BufSz = Int_BufSz + 1 ! OutDisWindX allocated yes/no - IF ( ALLOCATED(InData%OutDisWindX) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OutDisWindX upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%OutDisWindX) ! OutDisWindX - END IF - Int_BufSz = Int_BufSz + 1 ! NOutDisWindXZ - Int_BufSz = Int_BufSz + 1 ! OutDisWindY allocated yes/no - IF ( ALLOCATED(InData%OutDisWindY) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OutDisWindY upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%OutDisWindY) ! OutDisWindY - END IF - Int_BufSz = Int_BufSz + 1*LEN(InData%OutFileRoot) ! OutFileRoot - Int_BufSz = Int_BufSz + 1*LEN(InData%OutFileVTKRoot) ! OutFileVTKRoot - Int_BufSz = Int_BufSz + 1 ! VTK_tWidth - 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%WindFilePath) - IntKiBuf(Int_Xferred) = ICHAR(InData%WindFilePath(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = InData%NumTurbines - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumRadii - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumPlanes - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%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%y,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%y,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%y,1), UBOUND(InData%y,1) - ReKiBuf(Re_Xferred) = InData%y(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%z) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%z,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - ReKiBuf(Re_Xferred) = InData%z(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%Mod_AmbWind - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nX_low - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nY_low - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nZ_low - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumGrid_low - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%n_rp_max - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%dpol - Re_Xferred = Re_Xferred + 1 - DO i1 = LBOUND(InData%dXYZ_low,1), UBOUND(InData%dXYZ_low,1) - ReKiBuf(Re_Xferred) = InData%dXYZ_low(i1) - Re_Xferred = Re_Xferred + 1 - END DO - ReKiBuf(Re_Xferred) = InData%dX_low - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%dY_low - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%dZ_low - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%X0_low - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Y0_low - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Z0_low - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%X0_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%X0_high,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%X0_high,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%X0_high,1), UBOUND(InData%X0_high,1) - ReKiBuf(Re_Xferred) = InData%X0_high(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Y0_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%Y0_high,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Y0_high,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Y0_high,1), UBOUND(InData%Y0_high,1) - ReKiBuf(Re_Xferred) = InData%Y0_high(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Z0_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%Z0_high,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Z0_high,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Z0_high,1), UBOUND(InData%Z0_high,1) - ReKiBuf(Re_Xferred) = InData%Z0_high(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%dX_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%dX_high,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dX_high,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%dX_high,1), UBOUND(InData%dX_high,1) - ReKiBuf(Re_Xferred) = InData%dX_high(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%dY_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%dY_high,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dY_high,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%dY_high,1), UBOUND(InData%dY_high,1) - ReKiBuf(Re_Xferred) = InData%dY_high(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%dZ_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%dZ_high,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dZ_high,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%dZ_high,1), UBOUND(InData%dZ_high,1) - ReKiBuf(Re_Xferred) = InData%dZ_high(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%nX_high - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nY_high - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nZ_high - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%Grid_low) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Grid_low,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Grid_low,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Grid_low,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Grid_low,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Grid_low,2), UBOUND(InData%Grid_low,2) - DO i1 = LBOUND(InData%Grid_low,1), UBOUND(InData%Grid_low,1) - ReKiBuf(Re_Xferred) = InData%Grid_low(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Grid_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%Grid_high,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Grid_high,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Grid_high,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Grid_high,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Grid_high,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Grid_high,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Grid_high,3), UBOUND(InData%Grid_high,3) - DO i2 = LBOUND(InData%Grid_high,2), UBOUND(InData%Grid_high,2) - DO i1 = LBOUND(InData%Grid_high,1), UBOUND(InData%Grid_high,1) - ReKiBuf(Re_Xferred) = InData%Grid_high(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WT_Position) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WT_Position,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WT_Position,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WT_Position,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WT_Position,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%WT_Position,2), UBOUND(InData%WT_Position,2) - DO i1 = LBOUND(InData%WT_Position,1), UBOUND(InData%WT_Position,1) - ReKiBuf(Re_Xferred) = InData%WT_Position(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%n_high_low - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%dt_low - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%dt_high - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumDT - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%Mod_Meander - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%C_Meander - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%C_ScaleDiam - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%Mod_Projection - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%IfW) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%IfW,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IfW,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%IfW,1), UBOUND(InData%IfW,1) - CALL InflowWind_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%IfW(i1), ErrStat2, ErrMsg2, OnlySize ) ! IfW - 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%WrDisSkp1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%WrDisWind, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NOutDisWindXY - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%OutDisWindZ) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OutDisWindZ,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutDisWindZ,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%OutDisWindZ,1), UBOUND(InData%OutDisWindZ,1) - ReKiBuf(Re_Xferred) = InData%OutDisWindZ(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NOutDisWindYZ - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%OutDisWindX) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OutDisWindX,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutDisWindX,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%OutDisWindX,1), UBOUND(InData%OutDisWindX,1) - ReKiBuf(Re_Xferred) = InData%OutDisWindX(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NOutDisWindXZ - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%OutDisWindY) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OutDisWindY,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutDisWindY,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%OutDisWindY,1), UBOUND(InData%OutDisWindY,1) - ReKiBuf(Re_Xferred) = InData%OutDisWindY(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - DO I = 1, LEN(InData%OutFileRoot) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutFileRoot(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%OutFileVTKRoot) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutFileVTKRoot(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = InData%VTK_tWidth - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE AWAE_PackParam - - SUBROUTINE AWAE_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(AWAE_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) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AWAE_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 - DO I = 1, LEN(OutData%WindFilePath) - OutData%WindFilePath(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%NumTurbines = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumRadii = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumPlanes = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! 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%y)) DEALLOCATE(OutData%y) - ALLOCATE(OutData%y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%y,1), UBOUND(OutData%y,1) - OutData%y(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! z not allocated - Int_Xferred = Int_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%z)) DEALLOCATE(OutData%z) - ALLOCATE(OutData%z(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%z.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,1) - OutData%z(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%Mod_AmbWind = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nX_low = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nY_low = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nZ_low = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumGrid_low = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%n_rp_max = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%dpol = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%dXYZ_low,1) - i1_u = UBOUND(OutData%dXYZ_low,1) - DO i1 = LBOUND(OutData%dXYZ_low,1), UBOUND(OutData%dXYZ_low,1) - OutData%dXYZ_low(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%dX_low = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%dY_low = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%dZ_low = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%X0_low = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Y0_low = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Z0_low = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! X0_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%X0_high)) DEALLOCATE(OutData%X0_high) - ALLOCATE(OutData%X0_high(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%X0_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%X0_high,1), UBOUND(OutData%X0_high,1) - OutData%X0_high(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Y0_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%Y0_high)) DEALLOCATE(OutData%Y0_high) - ALLOCATE(OutData%Y0_high(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Y0_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Y0_high,1), UBOUND(OutData%Y0_high,1) - OutData%Y0_high(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Z0_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%Z0_high)) DEALLOCATE(OutData%Z0_high) - ALLOCATE(OutData%Z0_high(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Z0_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Z0_high,1), UBOUND(OutData%Z0_high,1) - OutData%Z0_high(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! dX_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%dX_high)) DEALLOCATE(OutData%dX_high) - ALLOCATE(OutData%dX_high(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%dX_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%dX_high,1), UBOUND(OutData%dX_high,1) - OutData%dX_high(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! dY_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%dY_high)) DEALLOCATE(OutData%dY_high) - ALLOCATE(OutData%dY_high(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%dY_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%dY_high,1), UBOUND(OutData%dY_high,1) - OutData%dY_high(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! dZ_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%dZ_high)) DEALLOCATE(OutData%dZ_high) - ALLOCATE(OutData%dZ_high(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%dZ_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%dZ_high,1), UBOUND(OutData%dZ_high,1) - OutData%dZ_high(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%nX_high = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nY_high = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nZ_high = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Grid_low not allocated - Int_Xferred = Int_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%Grid_low)) DEALLOCATE(OutData%Grid_low) - ALLOCATE(OutData%Grid_low(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Grid_low.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Grid_low,2), UBOUND(OutData%Grid_low,2) - DO i1 = LBOUND(OutData%Grid_low,1), UBOUND(OutData%Grid_low,1) - OutData%Grid_low(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Grid_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 - 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%Grid_high)) DEALLOCATE(OutData%Grid_high) - ALLOCATE(OutData%Grid_high(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%Grid_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Grid_high,3), UBOUND(OutData%Grid_high,3) - DO i2 = LBOUND(OutData%Grid_high,2), UBOUND(OutData%Grid_high,2) - DO i1 = LBOUND(OutData%Grid_high,1), UBOUND(OutData%Grid_high,1) - OutData%Grid_high(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 ! WT_Position not allocated - Int_Xferred = Int_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%WT_Position)) DEALLOCATE(OutData%WT_Position) - ALLOCATE(OutData%WT_Position(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WT_Position.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%WT_Position,2), UBOUND(OutData%WT_Position,2) - DO i1 = LBOUND(OutData%WT_Position,1), UBOUND(OutData%WT_Position,1) - OutData%WT_Position(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%n_high_low = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%dt_low = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%dt_high = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%NumDT = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%Mod_Meander = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%C_Meander = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_ScaleDiam = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Mod_Projection = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IfW not allocated - Int_Xferred = Int_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%IfW)) DEALLOCATE(OutData%IfW) - ALLOCATE(OutData%IfW(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IfW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%IfW,1), UBOUND(OutData%IfW,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 InflowWind_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%IfW(i1), ErrStat2, ErrMsg2 ) ! IfW - 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%WrDisSkp1 = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WrDisWind = TRANSFER(IntKiBuf(Int_Xferred), OutData%WrDisWind) - Int_Xferred = Int_Xferred + 1 - OutData%NOutDisWindXY = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutDisWindZ not allocated - Int_Xferred = Int_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%OutDisWindZ)) DEALLOCATE(OutData%OutDisWindZ) - ALLOCATE(OutData%OutDisWindZ(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutDisWindZ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%OutDisWindZ,1), UBOUND(OutData%OutDisWindZ,1) - OutData%OutDisWindZ(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%NOutDisWindYZ = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutDisWindX not allocated - Int_Xferred = Int_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%OutDisWindX)) DEALLOCATE(OutData%OutDisWindX) - ALLOCATE(OutData%OutDisWindX(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutDisWindX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%OutDisWindX,1), UBOUND(OutData%OutDisWindX,1) - OutData%OutDisWindX(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%NOutDisWindXZ = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutDisWindY not allocated - Int_Xferred = Int_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%OutDisWindY)) DEALLOCATE(OutData%OutDisWindY) - ALLOCATE(OutData%OutDisWindY(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutDisWindY.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%OutDisWindY,1), UBOUND(OutData%OutDisWindY,1) - OutData%OutDisWindY(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - DO I = 1, LEN(OutData%OutFileRoot) - OutData%OutFileRoot(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%OutFileVTKRoot) - OutData%OutFileVTKRoot(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%VTK_tWidth = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE AWAE_UnPackParam - - SUBROUTINE AWAE_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AWAE_OutputType), INTENT(IN) :: SrcOutputData - TYPE(AWAE_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) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AWAE_CopyOutput' -! + 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%X0_high)) then + LB(1:1) = lbound(SrcInitOutputData%X0_high) + UB(1:1) = ubound(SrcInitOutputData%X0_high) + if (.not. allocated(DstInitOutputData%X0_high)) then + allocate(DstInitOutputData%X0_high(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%X0_high.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%X0_high = SrcInitOutputData%X0_high + end if + if (allocated(SrcInitOutputData%Y0_high)) then + LB(1:1) = lbound(SrcInitOutputData%Y0_high) + UB(1:1) = ubound(SrcInitOutputData%Y0_high) + if (.not. allocated(DstInitOutputData%Y0_high)) then + allocate(DstInitOutputData%Y0_high(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%Y0_high.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%Y0_high = SrcInitOutputData%Y0_high + end if + if (allocated(SrcInitOutputData%Z0_high)) then + LB(1:1) = lbound(SrcInitOutputData%Z0_high) + UB(1:1) = ubound(SrcInitOutputData%Z0_high) + if (.not. allocated(DstInitOutputData%Z0_high)) then + allocate(DstInitOutputData%Z0_high(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%Z0_high.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%Z0_high = SrcInitOutputData%Z0_high + end if + if (allocated(SrcInitOutputData%dX_high)) then + LB(1:1) = lbound(SrcInitOutputData%dX_high) + UB(1:1) = ubound(SrcInitOutputData%dX_high) + if (.not. allocated(DstInitOutputData%dX_high)) then + allocate(DstInitOutputData%dX_high(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%dX_high.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%dX_high = SrcInitOutputData%dX_high + end if + if (allocated(SrcInitOutputData%dY_high)) then + LB(1:1) = lbound(SrcInitOutputData%dY_high) + UB(1:1) = ubound(SrcInitOutputData%dY_high) + if (.not. allocated(DstInitOutputData%dY_high)) then + allocate(DstInitOutputData%dY_high(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%dY_high.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%dY_high = SrcInitOutputData%dY_high + end if + if (allocated(SrcInitOutputData%dZ_high)) then + LB(1:1) = lbound(SrcInitOutputData%dZ_high) + UB(1:1) = ubound(SrcInitOutputData%dZ_high) + if (.not. allocated(DstInitOutputData%dZ_high)) then + allocate(DstInitOutputData%dZ_high(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%dZ_high.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%dZ_high = SrcInitOutputData%dZ_high + end if + DstInitOutputData%nX_high = SrcInitOutputData%nX_high + DstInitOutputData%nY_high = SrcInitOutputData%nY_high + DstInitOutputData%nZ_high = SrcInitOutputData%nZ_high + DstInitOutputData%dX_low = SrcInitOutputData%dX_low + DstInitOutputData%dY_low = SrcInitOutputData%dY_low + DstInitOutputData%dZ_low = SrcInitOutputData%dZ_low + DstInitOutputData%nX_low = SrcInitOutputData%nX_low + DstInitOutputData%nY_low = SrcInitOutputData%nY_low + DstInitOutputData%nZ_low = SrcInitOutputData%nZ_low + DstInitOutputData%X0_low = SrcInitOutputData%X0_low + DstInitOutputData%Y0_low = SrcInitOutputData%Y0_low + DstInitOutputData%Z0_low = SrcInitOutputData%Z0_low + if (allocated(SrcInitOutputData%Vdist_High)) then + LB(1:1) = lbound(SrcInitOutputData%Vdist_High) + UB(1:1) = ubound(SrcInitOutputData%Vdist_High) + if (.not. allocated(DstInitOutputData%Vdist_High)) then + allocate(DstInitOutputData%Vdist_High(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%Vdist_High.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AWAE_CopyHighWindGridPtr(SrcInitOutputData%Vdist_High(i1), DstInitOutputData%Vdist_High(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if +end subroutine + +subroutine AWAE_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(AWAE_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AWAE_DestroyInitOutput' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcOutputData%Vdist_High)) THEN - i1_l = LBOUND(SrcOutputData%Vdist_High,1) - i1_u = UBOUND(SrcOutputData%Vdist_High,1) - IF (.NOT. ALLOCATED(DstOutputData%Vdist_High)) THEN - ALLOCATE(DstOutputData%Vdist_High(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Vdist_High.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcOutputData%Vdist_High,1), UBOUND(SrcOutputData%Vdist_High,1) - CALL AWAE_Copyhighwindgrid( SrcOutputData%Vdist_High(i1), DstOutputData%Vdist_High(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcOutputData%V_plane)) THEN - i1_l = LBOUND(SrcOutputData%V_plane,1) - i1_u = UBOUND(SrcOutputData%V_plane,1) - i2_l = LBOUND(SrcOutputData%V_plane,2) - i2_u = UBOUND(SrcOutputData%V_plane,2) - i3_l = LBOUND(SrcOutputData%V_plane,3) - i3_u = UBOUND(SrcOutputData%V_plane,3) - IF (.NOT. ALLOCATED(DstOutputData%V_plane)) THEN - ALLOCATE(DstOutputData%V_plane(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%V_plane.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%V_plane = SrcOutputData%V_plane -ENDIF -IF (ALLOCATED(SrcOutputData%TI_amb)) THEN - i1_l = LBOUND(SrcOutputData%TI_amb,1) - i1_u = UBOUND(SrcOutputData%TI_amb,1) - IF (.NOT. ALLOCATED(DstOutputData%TI_amb)) THEN - ALLOCATE(DstOutputData%TI_amb(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%TI_amb.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%TI_amb = SrcOutputData%TI_amb -ENDIF -IF (ALLOCATED(SrcOutputData%Vx_wind_disk)) THEN - i1_l = LBOUND(SrcOutputData%Vx_wind_disk,1) - i1_u = UBOUND(SrcOutputData%Vx_wind_disk,1) - IF (.NOT. ALLOCATED(DstOutputData%Vx_wind_disk)) THEN - ALLOCATE(DstOutputData%Vx_wind_disk(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Vx_wind_disk.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%Vx_wind_disk = SrcOutputData%Vx_wind_disk -ENDIF - END SUBROUTINE AWAE_CopyOutput - - SUBROUTINE AWAE_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(AWAE_OutputType), INTENT(INOUT) :: OutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AWAE_DestroyOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(OutputData%Vdist_High)) THEN -DO i1 = LBOUND(OutputData%Vdist_High,1), UBOUND(OutputData%Vdist_High,1) - CALL AWAE_Destroyhighwindgrid( OutputData%Vdist_High(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(OutputData%Vdist_High) -ENDIF -IF (ALLOCATED(OutputData%V_plane)) THEN - DEALLOCATE(OutputData%V_plane) -ENDIF -IF (ALLOCATED(OutputData%TI_amb)) THEN - DEALLOCATE(OutputData%TI_amb) -ENDIF -IF (ALLOCATED(OutputData%Vx_wind_disk)) THEN - DEALLOCATE(OutputData%Vx_wind_disk) -ENDIF - END SUBROUTINE AWAE_DestroyOutput - - SUBROUTINE AWAE_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(AWAE_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 = 'AWAE_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 ! Vdist_High allocated yes/no - IF ( ALLOCATED(InData%Vdist_High) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Vdist_High upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%Vdist_High,1), UBOUND(InData%Vdist_High,1) - Int_BufSz = Int_BufSz + 3 ! Vdist_High: size of buffers for each call to pack subtype - CALL AWAE_Packhighwindgrid( Re_Buf, Db_Buf, Int_Buf, InData%Vdist_High(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Vdist_High - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Vdist_High - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Vdist_High - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Vdist_High - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! V_plane allocated yes/no - IF ( ALLOCATED(InData%V_plane) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! V_plane upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%V_plane) ! V_plane - END IF - Int_BufSz = Int_BufSz + 1 ! TI_amb allocated yes/no - IF ( ALLOCATED(InData%TI_amb) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TI_amb upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TI_amb) ! TI_amb - END IF - Int_BufSz = Int_BufSz + 1 ! Vx_wind_disk allocated yes/no - IF ( ALLOCATED(InData%Vx_wind_disk) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Vx_wind_disk upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vx_wind_disk) ! Vx_wind_disk - 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%Vdist_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%Vdist_High,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vdist_High,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Vdist_High,1), UBOUND(InData%Vdist_High,1) - CALL AWAE_Packhighwindgrid( Re_Buf, Db_Buf, Int_Buf, InData%Vdist_High(i1), ErrStat2, ErrMsg2, OnlySize ) ! Vdist_High - 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%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 - IntKiBuf( Int_Xferred ) = LBOUND(InData%V_plane,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%V_plane,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%V_plane,3), UBOUND(InData%V_plane,3) - 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,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TI_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%TI_amb,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TI_amb,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TI_amb,1), UBOUND(InData%TI_amb,1) - ReKiBuf(Re_Xferred) = InData%TI_amb(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Vx_wind_disk) ) THEN - 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,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vx_wind_disk,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Vx_wind_disk,1), UBOUND(InData%Vx_wind_disk,1) - ReKiBuf(Re_Xferred) = InData%Vx_wind_disk(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE AWAE_PackOutput - - SUBROUTINE AWAE_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(AWAE_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) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AWAE_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 ! Vdist_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%Vdist_High)) DEALLOCATE(OutData%Vdist_High) - ALLOCATE(OutData%Vdist_High(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vdist_High.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Vdist_High,1), UBOUND(OutData%Vdist_High,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 AWAE_Unpackhighwindgrid( Re_Buf, Db_Buf, Int_Buf, OutData%Vdist_High(i1), ErrStat2, ErrMsg2 ) ! Vdist_High - 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 ! 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 - i3_l = IntKiBuf( Int_Xferred ) - i3_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,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%V_plane.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%V_plane,3), UBOUND(OutData%V_plane,3) - 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,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TI_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 - IF (ALLOCATED(OutData%TI_amb)) DEALLOCATE(OutData%TI_amb) - ALLOCATE(OutData%TI_amb(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TI_amb.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TI_amb,1), UBOUND(OutData%TI_amb,1) - OutData%TI_amb(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vx_wind_disk not allocated - Int_Xferred = Int_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)) DEALLOCATE(OutData%Vx_wind_disk) - ALLOCATE(OutData%Vx_wind_disk(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vx_wind_disk.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Vx_wind_disk,1), UBOUND(OutData%Vx_wind_disk,1) - OutData%Vx_wind_disk(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE AWAE_UnPackOutput - - SUBROUTINE AWAE_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AWAE_InputType), INTENT(IN) :: SrcInputData - TYPE(AWAE_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) :: 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 = 'AWAE_CopyInput' -! + ErrMsg = '' + call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(InitOutputData%X0_high)) then + deallocate(InitOutputData%X0_high) + end if + if (allocated(InitOutputData%Y0_high)) then + deallocate(InitOutputData%Y0_high) + end if + if (allocated(InitOutputData%Z0_high)) then + deallocate(InitOutputData%Z0_high) + end if + if (allocated(InitOutputData%dX_high)) then + deallocate(InitOutputData%dX_high) + end if + if (allocated(InitOutputData%dY_high)) then + deallocate(InitOutputData%dY_high) + end if + if (allocated(InitOutputData%dZ_high)) then + deallocate(InitOutputData%dZ_high) + end if + if (allocated(InitOutputData%Vdist_High)) then + LB(1:1) = lbound(InitOutputData%Vdist_High) + UB(1:1) = ubound(InitOutputData%Vdist_High) + do i1 = LB(1), UB(1) + call AWAE_DestroyHighWindGridPtr(InitOutputData%Vdist_High(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InitOutputData%Vdist_High) + end if +end subroutine + +subroutine AWAE_PackInitOutput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(AWAE_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AWAE_PackInitOutput' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + if (RF%ErrStat >= AbortErrLev) return + call NWTC_Library_PackProgDesc(RF, InData%Ver) + call RegPackAlloc(RF, InData%X0_high) + call RegPackAlloc(RF, InData%Y0_high) + call RegPackAlloc(RF, InData%Z0_high) + call RegPackAlloc(RF, InData%dX_high) + call RegPackAlloc(RF, InData%dY_high) + call RegPackAlloc(RF, InData%dZ_high) + call RegPack(RF, InData%nX_high) + call RegPack(RF, InData%nY_high) + call RegPack(RF, InData%nZ_high) + call RegPack(RF, InData%dX_low) + call RegPack(RF, InData%dY_low) + call RegPack(RF, InData%dZ_low) + call RegPack(RF, InData%nX_low) + call RegPack(RF, InData%nY_low) + call RegPack(RF, InData%nZ_low) + call RegPack(RF, InData%X0_low) + call RegPack(RF, InData%Y0_low) + call RegPack(RF, InData%Z0_low) + call RegPack(RF, allocated(InData%Vdist_High)) + if (allocated(InData%Vdist_High)) then + call RegPackBounds(RF, 1, lbound(InData%Vdist_High), ubound(InData%Vdist_High)) + LB(1:1) = lbound(InData%Vdist_High) + UB(1:1) = ubound(InData%Vdist_High) + do i1 = LB(1), UB(1) + call AWAE_PackHighWindGridPtr(RF, InData%Vdist_High(i1)) + end do + end if + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AWAE_UnPackInitOutput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(AWAE_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AWAE_UnPackInitOutput' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call NWTC_Library_UnpackProgDesc(RF, OutData%Ver) ! Ver + call RegUnpackAlloc(RF, OutData%X0_high); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Y0_high); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Z0_high); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dX_high); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dY_high); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dZ_high); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nX_high); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nY_high); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nZ_high); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%dX_low); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%dY_low); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%dZ_low); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nX_low); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nY_low); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nZ_low); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%X0_low); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Y0_low); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Z0_low); if (RegCheckErr(RF, RoutineName)) return + if (allocated(OutData%Vdist_High)) deallocate(OutData%Vdist_High) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%Vdist_High(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vdist_High.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AWAE_UnpackHighWindGridPtr(RF, OutData%Vdist_High(i1)) ! Vdist_High + end do + end if +end subroutine + +subroutine AWAE_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) + type(AWAE_ContinuousStateType), intent(in) :: SrcContStateData + type(AWAE_ContinuousStateType), intent(inout) :: DstContStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AWAE_CopyContState' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcInputData%xhat_plane)) THEN - i1_l = LBOUND(SrcInputData%xhat_plane,1) - i1_u = UBOUND(SrcInputData%xhat_plane,1) - i2_l = LBOUND(SrcInputData%xhat_plane,2) - i2_u = UBOUND(SrcInputData%xhat_plane,2) - i3_l = LBOUND(SrcInputData%xhat_plane,3) - i3_u = UBOUND(SrcInputData%xhat_plane,3) - IF (.NOT. ALLOCATED(DstInputData%xhat_plane)) THEN - ALLOCATE(DstInputData%xhat_plane(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%xhat_plane.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%xhat_plane = SrcInputData%xhat_plane -ENDIF -IF (ALLOCATED(SrcInputData%p_plane)) THEN - i1_l = LBOUND(SrcInputData%p_plane,1) - i1_u = UBOUND(SrcInputData%p_plane,1) - i2_l = LBOUND(SrcInputData%p_plane,2) - i2_u = UBOUND(SrcInputData%p_plane,2) - i3_l = LBOUND(SrcInputData%p_plane,3) - i3_u = UBOUND(SrcInputData%p_plane,3) - IF (.NOT. ALLOCATED(DstInputData%p_plane)) THEN - ALLOCATE(DstInputData%p_plane(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%p_plane.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%p_plane = SrcInputData%p_plane -ENDIF -IF (ALLOCATED(SrcInputData%Vx_wake)) THEN - i1_l = LBOUND(SrcInputData%Vx_wake,1) - i1_u = UBOUND(SrcInputData%Vx_wake,1) - i2_l = LBOUND(SrcInputData%Vx_wake,2) - i2_u = UBOUND(SrcInputData%Vx_wake,2) - i3_l = LBOUND(SrcInputData%Vx_wake,3) - i3_u = UBOUND(SrcInputData%Vx_wake,3) - i4_l = LBOUND(SrcInputData%Vx_wake,4) - i4_u = UBOUND(SrcInputData%Vx_wake,4) - IF (.NOT. ALLOCATED(DstInputData%Vx_wake)) THEN - ALLOCATE(DstInputData%Vx_wake(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 DstInputData%Vx_wake.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%Vx_wake = SrcInputData%Vx_wake -ENDIF -IF (ALLOCATED(SrcInputData%Vy_wake)) THEN - i1_l = LBOUND(SrcInputData%Vy_wake,1) - i1_u = UBOUND(SrcInputData%Vy_wake,1) - i2_l = LBOUND(SrcInputData%Vy_wake,2) - i2_u = UBOUND(SrcInputData%Vy_wake,2) - i3_l = LBOUND(SrcInputData%Vy_wake,3) - i3_u = UBOUND(SrcInputData%Vy_wake,3) - i4_l = LBOUND(SrcInputData%Vy_wake,4) - i4_u = UBOUND(SrcInputData%Vy_wake,4) - IF (.NOT. ALLOCATED(DstInputData%Vy_wake)) THEN - ALLOCATE(DstInputData%Vy_wake(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 DstInputData%Vy_wake.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%Vy_wake = SrcInputData%Vy_wake -ENDIF -IF (ALLOCATED(SrcInputData%Vz_wake)) THEN - i1_l = LBOUND(SrcInputData%Vz_wake,1) - i1_u = UBOUND(SrcInputData%Vz_wake,1) - i2_l = LBOUND(SrcInputData%Vz_wake,2) - i2_u = UBOUND(SrcInputData%Vz_wake,2) - i3_l = LBOUND(SrcInputData%Vz_wake,3) - i3_u = UBOUND(SrcInputData%Vz_wake,3) - i4_l = LBOUND(SrcInputData%Vz_wake,4) - i4_u = UBOUND(SrcInputData%Vz_wake,4) - IF (.NOT. ALLOCATED(DstInputData%Vz_wake)) THEN - ALLOCATE(DstInputData%Vz_wake(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 DstInputData%Vz_wake.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%Vz_wake = SrcInputData%Vz_wake -ENDIF -IF (ALLOCATED(SrcInputData%D_wake)) THEN - i1_l = LBOUND(SrcInputData%D_wake,1) - i1_u = UBOUND(SrcInputData%D_wake,1) - i2_l = LBOUND(SrcInputData%D_wake,2) - i2_u = UBOUND(SrcInputData%D_wake,2) - IF (.NOT. ALLOCATED(DstInputData%D_wake)) THEN - ALLOCATE(DstInputData%D_wake(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%D_wake.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%D_wake = SrcInputData%D_wake -ENDIF -IF (ALLOCATED(SrcInputData%WAT_k_mt)) THEN - i1_l = LBOUND(SrcInputData%WAT_k_mt,1) - i1_u = UBOUND(SrcInputData%WAT_k_mt,1) - i2_l = LBOUND(SrcInputData%WAT_k_mt,2) - i2_u = UBOUND(SrcInputData%WAT_k_mt,2) - i3_l = LBOUND(SrcInputData%WAT_k_mt,3) - i3_u = UBOUND(SrcInputData%WAT_k_mt,3) - IF (.NOT. ALLOCATED(DstInputData%WAT_k_mt)) THEN - ALLOCATE(DstInputData%WAT_k_mt(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%WAT_k_mt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%WAT_k_mt = SrcInputData%WAT_k_mt -ENDIF - END SUBROUTINE AWAE_CopyInput - - SUBROUTINE AWAE_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(AWAE_InputType), INTENT(INOUT) :: InputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AWAE_DestroyInput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(InputData%xhat_plane)) THEN - DEALLOCATE(InputData%xhat_plane) -ENDIF -IF (ALLOCATED(InputData%p_plane)) THEN - DEALLOCATE(InputData%p_plane) -ENDIF -IF (ALLOCATED(InputData%Vx_wake)) THEN - DEALLOCATE(InputData%Vx_wake) -ENDIF -IF (ALLOCATED(InputData%Vy_wake)) THEN - DEALLOCATE(InputData%Vy_wake) -ENDIF -IF (ALLOCATED(InputData%Vz_wake)) THEN - DEALLOCATE(InputData%Vz_wake) -ENDIF -IF (ALLOCATED(InputData%D_wake)) THEN - DEALLOCATE(InputData%D_wake) -ENDIF -IF (ALLOCATED(InputData%WAT_k_mt)) THEN - DEALLOCATE(InputData%WAT_k_mt) -ENDIF - END SUBROUTINE AWAE_DestroyInput - - SUBROUTINE AWAE_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(AWAE_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 = 'AWAE_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 ! xhat_plane allocated yes/no - IF ( ALLOCATED(InData%xhat_plane) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! 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*3 ! 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*4 ! 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 ! Vy_wake allocated yes/no - IF ( ALLOCATED(InData%Vy_wake) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! Vy_wake upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vy_wake) ! Vy_wake - END IF - Int_BufSz = Int_BufSz + 1 ! Vz_wake allocated yes/no - IF ( ALLOCATED(InData%Vz_wake) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! Vz_wake upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vz_wake) ! Vz_wake - END IF - Int_BufSz = Int_BufSz + 1 ! D_wake allocated yes/no - IF ( ALLOCATED(InData%D_wake) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! 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 ! WAT_k_mt allocated yes/no - IF ( ALLOCATED(InData%WAT_k_mt) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! WAT_k_mt upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WAT_k_mt) ! WAT_k_mt - 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 - IntKiBuf( Int_Xferred ) = LBOUND(InData%xhat_plane,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xhat_plane,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%xhat_plane,3), UBOUND(InData%xhat_plane,3) - 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,i3) - Re_Xferred = Re_Xferred + 1 - END DO - 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 - IntKiBuf( Int_Xferred ) = LBOUND(InData%p_plane,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%p_plane,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%p_plane,3), UBOUND(InData%p_plane,3) - 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,i3) - Re_Xferred = Re_Xferred + 1 - END DO - 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 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vx_wake,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vx_wake,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vx_wake,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vx_wake,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%Vx_wake,4), UBOUND(InData%Vx_wake,4) - DO i3 = LBOUND(InData%Vx_wake,3), UBOUND(InData%Vx_wake,3) - 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,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Vy_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%Vy_wake,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vy_wake,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vy_wake,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vy_wake,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vy_wake,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vy_wake,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vy_wake,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vy_wake,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%Vy_wake,4), UBOUND(InData%Vy_wake,4) - DO i3 = LBOUND(InData%Vy_wake,3), UBOUND(InData%Vy_wake,3) - DO i2 = LBOUND(InData%Vy_wake,2), UBOUND(InData%Vy_wake,2) - DO i1 = LBOUND(InData%Vy_wake,1), UBOUND(InData%Vy_wake,1) - ReKiBuf(Re_Xferred) = InData%Vy_wake(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Vz_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%Vz_wake,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vz_wake,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vz_wake,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vz_wake,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vz_wake,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vz_wake,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vz_wake,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vz_wake,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%Vz_wake,4), UBOUND(InData%Vz_wake,4) - DO i3 = LBOUND(InData%Vz_wake,3), UBOUND(InData%Vz_wake,3) - DO i2 = LBOUND(InData%Vz_wake,2), UBOUND(InData%Vz_wake,2) - DO i1 = LBOUND(InData%Vz_wake,1), UBOUND(InData%Vz_wake,1) - ReKiBuf(Re_Xferred) = InData%Vz_wake(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - 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 - IntKiBuf( Int_Xferred ) = LBOUND(InData%D_wake,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D_wake,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%D_wake,2), UBOUND(InData%D_wake,2) - DO i1 = LBOUND(InData%D_wake,1), UBOUND(InData%D_wake,1) - ReKiBuf(Re_Xferred) = InData%D_wake(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WAT_k_mt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WAT_k_mt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WAT_k_mt,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WAT_k_mt,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WAT_k_mt,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WAT_k_mt,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WAT_k_mt,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%WAT_k_mt,3), UBOUND(InData%WAT_k_mt,3) - DO i2 = LBOUND(InData%WAT_k_mt,2), UBOUND(InData%WAT_k_mt,2) - DO i1 = LBOUND(InData%WAT_k_mt,1), UBOUND(InData%WAT_k_mt,1) - ReKiBuf(Re_Xferred) = InData%WAT_k_mt(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - END SUBROUTINE AWAE_PackInput - - SUBROUTINE AWAE_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(AWAE_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) :: 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 = 'AWAE_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 ! 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 - i3_l = IntKiBuf( Int_Xferred ) - i3_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,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xhat_plane.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%xhat_plane,3), UBOUND(OutData%xhat_plane,3) - 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,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - 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 - i3_l = IntKiBuf( Int_Xferred ) - i3_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,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%p_plane.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%p_plane,3), UBOUND(OutData%p_plane,3) - 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,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - 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 - 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%Vx_wake)) DEALLOCATE(OutData%Vx_wake) - ALLOCATE(OutData%Vx_wake(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%Vx_wake.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%Vx_wake,4), UBOUND(OutData%Vx_wake,4) - DO i3 = LBOUND(OutData%Vx_wake,3), UBOUND(OutData%Vx_wake,3) - 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,i3,i4) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vy_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 - 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%Vy_wake)) DEALLOCATE(OutData%Vy_wake) - ALLOCATE(OutData%Vy_wake(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%Vy_wake.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%Vy_wake,4), UBOUND(OutData%Vy_wake,4) - DO i3 = LBOUND(OutData%Vy_wake,3), UBOUND(OutData%Vy_wake,3) - DO i2 = LBOUND(OutData%Vy_wake,2), UBOUND(OutData%Vy_wake,2) - DO i1 = LBOUND(OutData%Vy_wake,1), UBOUND(OutData%Vy_wake,1) - OutData%Vy_wake(i1,i2,i3,i4) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vz_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 - 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%Vz_wake)) DEALLOCATE(OutData%Vz_wake) - ALLOCATE(OutData%Vz_wake(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%Vz_wake.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%Vz_wake,4), UBOUND(OutData%Vz_wake,4) - DO i3 = LBOUND(OutData%Vz_wake,3), UBOUND(OutData%Vz_wake,3) - DO i2 = LBOUND(OutData%Vz_wake,2), UBOUND(OutData%Vz_wake,2) - DO i1 = LBOUND(OutData%Vz_wake,1), UBOUND(OutData%Vz_wake,1) - OutData%Vz_wake(i1,i2,i3,i4) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - 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 - i2_l = IntKiBuf( Int_Xferred ) - i2_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,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%D_wake.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%D_wake,2), UBOUND(OutData%D_wake,2) - DO i1 = LBOUND(OutData%D_wake,1), UBOUND(OutData%D_wake,1) - OutData%D_wake(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WAT_k_mt not allocated - Int_Xferred = Int_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%WAT_k_mt)) DEALLOCATE(OutData%WAT_k_mt) - ALLOCATE(OutData%WAT_k_mt(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%WAT_k_mt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%WAT_k_mt,3), UBOUND(OutData%WAT_k_mt,3) - DO i2 = LBOUND(OutData%WAT_k_mt,2), UBOUND(OutData%WAT_k_mt,2) - DO i1 = LBOUND(OutData%WAT_k_mt,1), UBOUND(OutData%WAT_k_mt,1) - OutData%WAT_k_mt(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - END SUBROUTINE AWAE_UnPackInput - + ErrMsg = '' + if (allocated(SrcContStateData%IfW)) then + LB(1:1) = lbound(SrcContStateData%IfW) + UB(1:1) = ubound(SrcContStateData%IfW) + if (.not. allocated(DstContStateData%IfW)) then + allocate(DstContStateData%IfW(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%IfW.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call InflowWind_CopyContState(SrcContStateData%IfW(i1), DstContStateData%IfW(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if +end subroutine + +subroutine AWAE_DestroyContState(ContStateData, ErrStat, ErrMsg) + type(AWAE_ContinuousStateType), intent(inout) :: ContStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AWAE_DestroyContState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ContStateData%IfW)) then + LB(1:1) = lbound(ContStateData%IfW) + UB(1:1) = ubound(ContStateData%IfW) + do i1 = LB(1), UB(1) + call InflowWind_DestroyContState(ContStateData%IfW(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ContStateData%IfW) + end if +end subroutine + +subroutine AWAE_PackContState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(AWAE_ContinuousStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AWAE_PackContState' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%IfW)) + if (allocated(InData%IfW)) then + call RegPackBounds(RF, 1, lbound(InData%IfW), ubound(InData%IfW)) + LB(1:1) = lbound(InData%IfW) + UB(1:1) = ubound(InData%IfW) + do i1 = LB(1), UB(1) + call InflowWind_PackContState(RF, InData%IfW(i1)) + end do + end if + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AWAE_UnPackContState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(AWAE_ContinuousStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AWAE_UnPackContState' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + if (allocated(OutData%IfW)) deallocate(OutData%IfW) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%IfW(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%IfW.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call InflowWind_UnpackContState(RF, OutData%IfW(i1)) ! IfW + end do + end if +end subroutine + +subroutine AWAE_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) + type(AWAE_DiscreteStateType), intent(in) :: SrcDiscStateData + type(AWAE_DiscreteStateType), intent(inout) :: DstDiscStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AWAE_CopyDiscState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcDiscStateData%IfW)) then + LB(1:1) = lbound(SrcDiscStateData%IfW) + UB(1:1) = ubound(SrcDiscStateData%IfW) + if (.not. allocated(DstDiscStateData%IfW)) then + allocate(DstDiscStateData%IfW(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%IfW.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call InflowWind_CopyDiscState(SrcDiscStateData%IfW(i1), DstDiscStateData%IfW(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + DstDiscStateData%WAT_B_Box = SrcDiscStateData%WAT_B_Box + DstDiscStateData%Ufarm = SrcDiscStateData%Ufarm +end subroutine + +subroutine AWAE_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) + type(AWAE_DiscreteStateType), intent(inout) :: DiscStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AWAE_DestroyDiscState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(DiscStateData%IfW)) then + LB(1:1) = lbound(DiscStateData%IfW) + UB(1:1) = ubound(DiscStateData%IfW) + do i1 = LB(1), UB(1) + call InflowWind_DestroyDiscState(DiscStateData%IfW(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(DiscStateData%IfW) + end if +end subroutine + +subroutine AWAE_PackDiscState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(AWAE_DiscreteStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AWAE_PackDiscState' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%IfW)) + if (allocated(InData%IfW)) then + call RegPackBounds(RF, 1, lbound(InData%IfW), ubound(InData%IfW)) + LB(1:1) = lbound(InData%IfW) + UB(1:1) = ubound(InData%IfW) + do i1 = LB(1), UB(1) + call InflowWind_PackDiscState(RF, InData%IfW(i1)) + end do + end if + call RegPack(RF, InData%WAT_B_Box) + call RegPack(RF, InData%Ufarm) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AWAE_UnPackDiscState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(AWAE_DiscreteStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AWAE_UnPackDiscState' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + if (allocated(OutData%IfW)) deallocate(OutData%IfW) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%IfW(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%IfW.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call InflowWind_UnpackDiscState(RF, OutData%IfW(i1)) ! IfW + end do + end if + call RegUnpack(RF, OutData%WAT_B_Box); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Ufarm); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AWAE_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) + type(AWAE_ConstraintStateType), intent(in) :: SrcConstrStateData + type(AWAE_ConstraintStateType), intent(inout) :: DstConstrStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AWAE_CopyConstrState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcConstrStateData%IfW)) then + LB(1:1) = lbound(SrcConstrStateData%IfW) + UB(1:1) = ubound(SrcConstrStateData%IfW) + if (.not. allocated(DstConstrStateData%IfW)) then + allocate(DstConstrStateData%IfW(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstConstrStateData%IfW.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call InflowWind_CopyConstrState(SrcConstrStateData%IfW(i1), DstConstrStateData%IfW(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if +end subroutine + +subroutine AWAE_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) + type(AWAE_ConstraintStateType), intent(inout) :: ConstrStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AWAE_DestroyConstrState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ConstrStateData%IfW)) then + LB(1:1) = lbound(ConstrStateData%IfW) + UB(1:1) = ubound(ConstrStateData%IfW) + do i1 = LB(1), UB(1) + call InflowWind_DestroyConstrState(ConstrStateData%IfW(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ConstrStateData%IfW) + end if +end subroutine + +subroutine AWAE_PackConstrState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(AWAE_ConstraintStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AWAE_PackConstrState' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%IfW)) + if (allocated(InData%IfW)) then + call RegPackBounds(RF, 1, lbound(InData%IfW), ubound(InData%IfW)) + LB(1:1) = lbound(InData%IfW) + UB(1:1) = ubound(InData%IfW) + do i1 = LB(1), UB(1) + call InflowWind_PackConstrState(RF, InData%IfW(i1)) + end do + end if + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AWAE_UnPackConstrState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(AWAE_ConstraintStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AWAE_UnPackConstrState' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + if (allocated(OutData%IfW)) deallocate(OutData%IfW) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%IfW(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%IfW.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call InflowWind_UnpackConstrState(RF, OutData%IfW(i1)) ! IfW + end do + end if +end subroutine + +subroutine AWAE_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) + type(AWAE_OtherStateType), intent(in) :: SrcOtherStateData + type(AWAE_OtherStateType), intent(inout) :: DstOtherStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AWAE_CopyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcOtherStateData%IfW)) then + LB(1:1) = lbound(SrcOtherStateData%IfW) + UB(1:1) = ubound(SrcOtherStateData%IfW) + if (.not. allocated(DstOtherStateData%IfW)) then + allocate(DstOtherStateData%IfW(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%IfW.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call InflowWind_CopyOtherState(SrcOtherStateData%IfW(i1), DstOtherStateData%IfW(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if +end subroutine + +subroutine AWAE_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) + type(AWAE_OtherStateType), intent(inout) :: OtherStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AWAE_DestroyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OtherStateData%IfW)) then + LB(1:1) = lbound(OtherStateData%IfW) + UB(1:1) = ubound(OtherStateData%IfW) + do i1 = LB(1), UB(1) + call InflowWind_DestroyOtherState(OtherStateData%IfW(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(OtherStateData%IfW) + end if +end subroutine + +subroutine AWAE_PackOtherState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(AWAE_OtherStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AWAE_PackOtherState' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%IfW)) + if (allocated(InData%IfW)) then + call RegPackBounds(RF, 1, lbound(InData%IfW), ubound(InData%IfW)) + LB(1:1) = lbound(InData%IfW) + UB(1:1) = ubound(InData%IfW) + do i1 = LB(1), UB(1) + call InflowWind_PackOtherState(RF, InData%IfW(i1)) + end do + end if + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AWAE_UnPackOtherState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(AWAE_OtherStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AWAE_UnPackOtherState' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + if (allocated(OutData%IfW)) deallocate(OutData%IfW) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%IfW(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%IfW.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call InflowWind_UnpackOtherState(RF, OutData%IfW(i1)) ! IfW + end do + end if +end subroutine + +subroutine AWAE_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(AWAE_MiscVarType), intent(in) :: SrcMiscData + type(AWAE_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2, i3, i4 + integer(B4Ki) :: LB(4), UB(4) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AWAE_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcMiscData%Vamb_low)) then + LB(1:4) = lbound(SrcMiscData%Vamb_low) + UB(1:4) = ubound(SrcMiscData%Vamb_low) + if (.not. allocated(DstMiscData%Vamb_low)) then + allocate(DstMiscData%Vamb_low(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Vamb_low.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%Vamb_low = SrcMiscData%Vamb_low + end if + if (allocated(SrcMiscData%Vamb_lowpol)) then + LB(1:2) = lbound(SrcMiscData%Vamb_lowpol) + UB(1:2) = ubound(SrcMiscData%Vamb_lowpol) + if (.not. allocated(DstMiscData%Vamb_lowpol)) then + allocate(DstMiscData%Vamb_lowpol(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Vamb_lowpol.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%Vamb_lowpol = SrcMiscData%Vamb_lowpol + end if + if (allocated(SrcMiscData%Vdist_low)) then + LB(1:4) = lbound(SrcMiscData%Vdist_low) + UB(1:4) = ubound(SrcMiscData%Vdist_low) + if (.not. allocated(DstMiscData%Vdist_low)) then + allocate(DstMiscData%Vdist_low(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Vdist_low.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%Vdist_low = SrcMiscData%Vdist_low + end if + if (allocated(SrcMiscData%Vdist_low_full)) then + LB(1:4) = lbound(SrcMiscData%Vdist_low_full) + UB(1:4) = ubound(SrcMiscData%Vdist_low_full) + if (.not. allocated(DstMiscData%Vdist_low_full)) then + allocate(DstMiscData%Vdist_low_full(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Vdist_low_full.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%Vdist_low_full = SrcMiscData%Vdist_low_full + end if + if (allocated(SrcMiscData%Vamb_High)) then + LB(1:1) = lbound(SrcMiscData%Vamb_High) + UB(1:1) = ubound(SrcMiscData%Vamb_High) + if (.not. allocated(DstMiscData%Vamb_High)) then + allocate(DstMiscData%Vamb_High(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Vamb_High.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AWAE_CopyHighWindGrid(SrcMiscData%Vamb_High(i1), DstMiscData%Vamb_High(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcMiscData%parallelFlag)) then + LB(1:2) = lbound(SrcMiscData%parallelFlag) + UB(1:2) = ubound(SrcMiscData%parallelFlag) + if (.not. allocated(DstMiscData%parallelFlag)) then + allocate(DstMiscData%parallelFlag(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%parallelFlag.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%parallelFlag = SrcMiscData%parallelFlag + end if + if (allocated(SrcMiscData%r_s)) then + LB(1:2) = lbound(SrcMiscData%r_s) + UB(1:2) = ubound(SrcMiscData%r_s) + if (.not. allocated(DstMiscData%r_s)) then + allocate(DstMiscData%r_s(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%r_s.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%r_s = SrcMiscData%r_s + end if + if (allocated(SrcMiscData%r_e)) then + LB(1:2) = lbound(SrcMiscData%r_e) + UB(1:2) = ubound(SrcMiscData%r_e) + if (.not. allocated(DstMiscData%r_e)) then + allocate(DstMiscData%r_e(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%r_e.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%r_e = SrcMiscData%r_e + end if + if (allocated(SrcMiscData%rhat_s)) then + LB(1:3) = lbound(SrcMiscData%rhat_s) + UB(1:3) = ubound(SrcMiscData%rhat_s) + if (.not. allocated(DstMiscData%rhat_s)) then + allocate(DstMiscData%rhat_s(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%rhat_s.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%rhat_s = SrcMiscData%rhat_s + end if + if (allocated(SrcMiscData%rhat_e)) then + LB(1:3) = lbound(SrcMiscData%rhat_e) + UB(1:3) = ubound(SrcMiscData%rhat_e) + if (.not. allocated(DstMiscData%rhat_e)) then + allocate(DstMiscData%rhat_e(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%rhat_e.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%rhat_e = SrcMiscData%rhat_e + end if + if (allocated(SrcMiscData%pvec_cs)) then + LB(1:3) = lbound(SrcMiscData%pvec_cs) + UB(1:3) = ubound(SrcMiscData%pvec_cs) + if (.not. allocated(DstMiscData%pvec_cs)) then + allocate(DstMiscData%pvec_cs(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%pvec_cs.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%pvec_cs = SrcMiscData%pvec_cs + end if + if (allocated(SrcMiscData%pvec_ce)) then + LB(1:3) = lbound(SrcMiscData%pvec_ce) + UB(1:3) = ubound(SrcMiscData%pvec_ce) + if (.not. allocated(DstMiscData%pvec_ce)) then + allocate(DstMiscData%pvec_ce(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%pvec_ce.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%pvec_ce = SrcMiscData%pvec_ce + end if + if (allocated(SrcMiscData%outVizXYPlane)) then + LB(1:4) = lbound(SrcMiscData%outVizXYPlane) + UB(1:4) = ubound(SrcMiscData%outVizXYPlane) + if (.not. allocated(DstMiscData%outVizXYPlane)) then + allocate(DstMiscData%outVizXYPlane(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%outVizXYPlane.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%outVizXYPlane = SrcMiscData%outVizXYPlane + end if + if (allocated(SrcMiscData%outVizYZPlane)) then + LB(1:4) = lbound(SrcMiscData%outVizYZPlane) + UB(1:4) = ubound(SrcMiscData%outVizYZPlane) + if (.not. allocated(DstMiscData%outVizYZPlane)) then + allocate(DstMiscData%outVizYZPlane(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%outVizYZPlane.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%outVizYZPlane = SrcMiscData%outVizYZPlane + end if + if (allocated(SrcMiscData%outVizXZPlane)) then + LB(1:4) = lbound(SrcMiscData%outVizXZPlane) + UB(1:4) = ubound(SrcMiscData%outVizXZPlane) + if (.not. allocated(DstMiscData%outVizXZPlane)) then + allocate(DstMiscData%outVizXZPlane(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%outVizXZPlane.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%outVizXZPlane = SrcMiscData%outVizXZPlane + end if + if (allocated(SrcMiscData%IfW)) then + LB(1:1) = lbound(SrcMiscData%IfW) + UB(1:1) = ubound(SrcMiscData%IfW) + if (.not. allocated(DstMiscData%IfW)) then + allocate(DstMiscData%IfW(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%IfW.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call InflowWind_CopyMisc(SrcMiscData%IfW(i1), DstMiscData%IfW(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call InflowWind_CopyInput(SrcMiscData%u_IfW_Low, DstMiscData%u_IfW_Low, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call InflowWind_CopyInput(SrcMiscData%u_IfW_High, DstMiscData%u_IfW_High, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call InflowWind_CopyOutput(SrcMiscData%y_IfW_Low, DstMiscData%y_IfW_Low, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call InflowWind_CopyOutput(SrcMiscData%y_IfW_High, DstMiscData%y_IfW_High, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcMiscData%V_amb_low_disk)) then + LB(1:2) = lbound(SrcMiscData%V_amb_low_disk) + UB(1:2) = ubound(SrcMiscData%V_amb_low_disk) + if (.not. allocated(DstMiscData%V_amb_low_disk)) then + allocate(DstMiscData%V_amb_low_disk(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%V_amb_low_disk.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%V_amb_low_disk = SrcMiscData%V_amb_low_disk + end if +end subroutine + +subroutine AWAE_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(AWAE_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2, i3, i4 + integer(B4Ki) :: LB(4), UB(4) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AWAE_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(MiscData%Vamb_low)) then + deallocate(MiscData%Vamb_low) + end if + if (allocated(MiscData%Vamb_lowpol)) then + deallocate(MiscData%Vamb_lowpol) + end if + if (allocated(MiscData%Vdist_low)) then + deallocate(MiscData%Vdist_low) + end if + if (allocated(MiscData%Vdist_low_full)) then + deallocate(MiscData%Vdist_low_full) + end if + if (allocated(MiscData%Vamb_High)) then + LB(1:1) = lbound(MiscData%Vamb_High) + UB(1:1) = ubound(MiscData%Vamb_High) + do i1 = LB(1), UB(1) + call AWAE_DestroyHighWindGrid(MiscData%Vamb_High(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%Vamb_High) + end if + if (allocated(MiscData%parallelFlag)) then + deallocate(MiscData%parallelFlag) + end if + if (allocated(MiscData%r_s)) then + deallocate(MiscData%r_s) + end if + if (allocated(MiscData%r_e)) then + deallocate(MiscData%r_e) + end if + if (allocated(MiscData%rhat_s)) then + deallocate(MiscData%rhat_s) + end if + if (allocated(MiscData%rhat_e)) then + deallocate(MiscData%rhat_e) + end if + if (allocated(MiscData%pvec_cs)) then + deallocate(MiscData%pvec_cs) + end if + if (allocated(MiscData%pvec_ce)) then + deallocate(MiscData%pvec_ce) + end if + if (allocated(MiscData%outVizXYPlane)) then + deallocate(MiscData%outVizXYPlane) + end if + if (allocated(MiscData%outVizYZPlane)) then + deallocate(MiscData%outVizYZPlane) + end if + if (allocated(MiscData%outVizXZPlane)) then + deallocate(MiscData%outVizXZPlane) + end if + if (allocated(MiscData%IfW)) then + LB(1:1) = lbound(MiscData%IfW) + UB(1:1) = ubound(MiscData%IfW) + do i1 = LB(1), UB(1) + call InflowWind_DestroyMisc(MiscData%IfW(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%IfW) + end if + call InflowWind_DestroyInput(MiscData%u_IfW_Low, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call InflowWind_DestroyInput(MiscData%u_IfW_High, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call InflowWind_DestroyOutput(MiscData%y_IfW_Low, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call InflowWind_DestroyOutput(MiscData%y_IfW_High, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(MiscData%V_amb_low_disk)) then + deallocate(MiscData%V_amb_low_disk) + end if +end subroutine + +subroutine AWAE_PackMisc(RF, Indata) + type(RegFile), intent(inout) :: RF + type(AWAE_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AWAE_PackMisc' + integer(B4Ki) :: i1, i2, i3, i4 + integer(B4Ki) :: LB(4), UB(4) + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%Vamb_low) + call RegPackAlloc(RF, InData%Vamb_lowpol) + call RegPackAlloc(RF, InData%Vdist_low) + call RegPackAlloc(RF, InData%Vdist_low_full) + call RegPack(RF, allocated(InData%Vamb_High)) + if (allocated(InData%Vamb_High)) then + call RegPackBounds(RF, 1, lbound(InData%Vamb_High), ubound(InData%Vamb_High)) + LB(1:1) = lbound(InData%Vamb_High) + UB(1:1) = ubound(InData%Vamb_High) + do i1 = LB(1), UB(1) + call AWAE_PackHighWindGrid(RF, InData%Vamb_High(i1)) + end do + end if + call RegPackAlloc(RF, InData%parallelFlag) + call RegPackAlloc(RF, InData%r_s) + call RegPackAlloc(RF, InData%r_e) + call RegPackAlloc(RF, InData%rhat_s) + call RegPackAlloc(RF, InData%rhat_e) + call RegPackAlloc(RF, InData%pvec_cs) + call RegPackAlloc(RF, InData%pvec_ce) + call RegPackAlloc(RF, InData%outVizXYPlane) + call RegPackAlloc(RF, InData%outVizYZPlane) + call RegPackAlloc(RF, InData%outVizXZPlane) + call RegPack(RF, allocated(InData%IfW)) + if (allocated(InData%IfW)) then + call RegPackBounds(RF, 1, lbound(InData%IfW), ubound(InData%IfW)) + LB(1:1) = lbound(InData%IfW) + UB(1:1) = ubound(InData%IfW) + do i1 = LB(1), UB(1) + call InflowWind_PackMisc(RF, InData%IfW(i1)) + end do + end if + call InflowWind_PackInput(RF, InData%u_IfW_Low) + call InflowWind_PackInput(RF, InData%u_IfW_High) + call InflowWind_PackOutput(RF, InData%y_IfW_Low) + call InflowWind_PackOutput(RF, InData%y_IfW_High) + call RegPackAlloc(RF, InData%V_amb_low_disk) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AWAE_UnPackMisc(RF, OutData) + type(RegFile), intent(inout) :: RF + type(AWAE_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AWAE_UnPackMisc' + integer(B4Ki) :: i1, i2, i3, i4 + integer(B4Ki) :: LB(4), UB(4) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%Vamb_low); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Vamb_lowpol); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Vdist_low); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Vdist_low_full); if (RegCheckErr(RF, RoutineName)) return + if (allocated(OutData%Vamb_High)) deallocate(OutData%Vamb_High) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%Vamb_High(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vamb_High.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AWAE_UnpackHighWindGrid(RF, OutData%Vamb_High(i1)) ! Vamb_High + end do + end if + call RegUnpackAlloc(RF, OutData%parallelFlag); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%r_s); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%r_e); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%rhat_s); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%rhat_e); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%pvec_cs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%pvec_ce); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%outVizXYPlane); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%outVizYZPlane); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%outVizXZPlane); if (RegCheckErr(RF, RoutineName)) return + if (allocated(OutData%IfW)) deallocate(OutData%IfW) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%IfW(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%IfW.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call InflowWind_UnpackMisc(RF, OutData%IfW(i1)) ! IfW + end do + end if + call InflowWind_UnpackInput(RF, OutData%u_IfW_Low) ! u_IfW_Low + call InflowWind_UnpackInput(RF, OutData%u_IfW_High) ! u_IfW_High + call InflowWind_UnpackOutput(RF, OutData%y_IfW_Low) ! y_IfW_Low + call InflowWind_UnpackOutput(RF, OutData%y_IfW_High) ! y_IfW_High + call RegUnpackAlloc(RF, OutData%V_amb_low_disk); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AWAE_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(AWAE_ParameterType), intent(in) :: SrcParamData + type(AWAE_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AWAE_CopyParam' + ErrStat = ErrID_None + ErrMsg = '' + DstParamData%WindFilePath = SrcParamData%WindFilePath + DstParamData%NumTurbines = SrcParamData%NumTurbines + DstParamData%NumRadii = SrcParamData%NumRadii + DstParamData%NumPlanes = SrcParamData%NumPlanes + if (allocated(SrcParamData%y)) then + LB(1:1) = lbound(SrcParamData%y) + UB(1:1) = ubound(SrcParamData%y) + if (.not. allocated(DstParamData%y)) then + allocate(DstParamData%y(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%y.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%y = SrcParamData%y + end if + if (allocated(SrcParamData%z)) then + LB(1:1) = lbound(SrcParamData%z) + UB(1:1) = ubound(SrcParamData%z) + if (.not. allocated(DstParamData%z)) then + allocate(DstParamData%z(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%z.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%z = SrcParamData%z + end if + DstParamData%Mod_AmbWind = SrcParamData%Mod_AmbWind + DstParamData%nX_low = SrcParamData%nX_low + DstParamData%nY_low = SrcParamData%nY_low + DstParamData%nZ_low = SrcParamData%nZ_low + DstParamData%NumGrid_low = SrcParamData%NumGrid_low + DstParamData%n_rp_max = SrcParamData%n_rp_max + DstParamData%dpol = SrcParamData%dpol + DstParamData%dXYZ_low = SrcParamData%dXYZ_low + DstParamData%dX_low = SrcParamData%dX_low + DstParamData%dY_low = SrcParamData%dY_low + DstParamData%dZ_low = SrcParamData%dZ_low + DstParamData%X0_low = SrcParamData%X0_low + DstParamData%Y0_low = SrcParamData%Y0_low + DstParamData%Z0_low = SrcParamData%Z0_low + if (allocated(SrcParamData%X0_high)) then + LB(1:1) = lbound(SrcParamData%X0_high) + UB(1:1) = ubound(SrcParamData%X0_high) + if (.not. allocated(DstParamData%X0_high)) then + allocate(DstParamData%X0_high(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%X0_high.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%X0_high = SrcParamData%X0_high + end if + if (allocated(SrcParamData%Y0_high)) then + LB(1:1) = lbound(SrcParamData%Y0_high) + UB(1:1) = ubound(SrcParamData%Y0_high) + if (.not. allocated(DstParamData%Y0_high)) then + allocate(DstParamData%Y0_high(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Y0_high.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Y0_high = SrcParamData%Y0_high + end if + if (allocated(SrcParamData%Z0_high)) then + LB(1:1) = lbound(SrcParamData%Z0_high) + UB(1:1) = ubound(SrcParamData%Z0_high) + if (.not. allocated(DstParamData%Z0_high)) then + allocate(DstParamData%Z0_high(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Z0_high.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Z0_high = SrcParamData%Z0_high + end if + if (allocated(SrcParamData%dX_high)) then + LB(1:1) = lbound(SrcParamData%dX_high) + UB(1:1) = ubound(SrcParamData%dX_high) + if (.not. allocated(DstParamData%dX_high)) then + allocate(DstParamData%dX_high(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%dX_high.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%dX_high = SrcParamData%dX_high + end if + if (allocated(SrcParamData%dY_high)) then + LB(1:1) = lbound(SrcParamData%dY_high) + UB(1:1) = ubound(SrcParamData%dY_high) + if (.not. allocated(DstParamData%dY_high)) then + allocate(DstParamData%dY_high(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%dY_high.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%dY_high = SrcParamData%dY_high + end if + if (allocated(SrcParamData%dZ_high)) then + LB(1:1) = lbound(SrcParamData%dZ_high) + UB(1:1) = ubound(SrcParamData%dZ_high) + if (.not. allocated(DstParamData%dZ_high)) then + allocate(DstParamData%dZ_high(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%dZ_high.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%dZ_high = SrcParamData%dZ_high + end if + DstParamData%nX_high = SrcParamData%nX_high + DstParamData%nY_high = SrcParamData%nY_high + DstParamData%nZ_high = SrcParamData%nZ_high + if (allocated(SrcParamData%Grid_low)) then + LB(1:2) = lbound(SrcParamData%Grid_low) + UB(1:2) = ubound(SrcParamData%Grid_low) + if (.not. allocated(DstParamData%Grid_low)) then + allocate(DstParamData%Grid_low(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Grid_low.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Grid_low = SrcParamData%Grid_low + end if + if (allocated(SrcParamData%Grid_high)) then + LB(1:3) = lbound(SrcParamData%Grid_high) + UB(1:3) = ubound(SrcParamData%Grid_high) + if (.not. allocated(DstParamData%Grid_high)) then + allocate(DstParamData%Grid_high(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Grid_high.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Grid_high = SrcParamData%Grid_high + end if + if (allocated(SrcParamData%WT_Position)) then + LB(1:2) = lbound(SrcParamData%WT_Position) + UB(1:2) = ubound(SrcParamData%WT_Position) + if (.not. allocated(DstParamData%WT_Position)) then + allocate(DstParamData%WT_Position(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WT_Position.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%WT_Position = SrcParamData%WT_Position + end if + DstParamData%n_high_low = SrcParamData%n_high_low + DstParamData%dt_low = SrcParamData%dt_low + DstParamData%dt_high = SrcParamData%dt_high + DstParamData%NumDT = SrcParamData%NumDT + DstParamData%Mod_Meander = SrcParamData%Mod_Meander + DstParamData%C_Meander = SrcParamData%C_Meander + DstParamData%C_ScaleDiam = SrcParamData%C_ScaleDiam + DstParamData%Mod_Projection = SrcParamData%Mod_Projection + if (allocated(SrcParamData%IfW)) then + LB(1:1) = lbound(SrcParamData%IfW) + UB(1:1) = ubound(SrcParamData%IfW) + if (.not. allocated(DstParamData%IfW)) then + allocate(DstParamData%IfW(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IfW.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call InflowWind_CopyParam(SrcParamData%IfW(i1), DstParamData%IfW(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + DstParamData%WrDisSkp1 = SrcParamData%WrDisSkp1 + DstParamData%WrDisWind = SrcParamData%WrDisWind + DstParamData%NOutDisWindXY = SrcParamData%NOutDisWindXY + if (allocated(SrcParamData%OutDisWindZ)) then + LB(1:1) = lbound(SrcParamData%OutDisWindZ) + UB(1:1) = ubound(SrcParamData%OutDisWindZ) + if (.not. allocated(DstParamData%OutDisWindZ)) then + allocate(DstParamData%OutDisWindZ(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutDisWindZ.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%OutDisWindZ = SrcParamData%OutDisWindZ + end if + DstParamData%NOutDisWindYZ = SrcParamData%NOutDisWindYZ + if (allocated(SrcParamData%OutDisWindX)) then + LB(1:1) = lbound(SrcParamData%OutDisWindX) + UB(1:1) = ubound(SrcParamData%OutDisWindX) + if (.not. allocated(DstParamData%OutDisWindX)) then + allocate(DstParamData%OutDisWindX(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutDisWindX.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%OutDisWindX = SrcParamData%OutDisWindX + end if + DstParamData%NOutDisWindXZ = SrcParamData%NOutDisWindXZ + if (allocated(SrcParamData%OutDisWindY)) then + LB(1:1) = lbound(SrcParamData%OutDisWindY) + UB(1:1) = ubound(SrcParamData%OutDisWindY) + if (.not. allocated(DstParamData%OutDisWindY)) then + allocate(DstParamData%OutDisWindY(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutDisWindY.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%OutDisWindY = SrcParamData%OutDisWindY + end if + DstParamData%OutFileRoot = SrcParamData%OutFileRoot + DstParamData%OutFileVTKRoot = SrcParamData%OutFileVTKRoot + DstParamData%VTK_tWidth = SrcParamData%VTK_tWidth + DstParamData%WAT_Enabled = SrcParamData%WAT_Enabled + DstParamData%WAT_FlowField => SrcParamData%WAT_FlowField +end subroutine + +subroutine AWAE_DestroyParam(ParamData, ErrStat, ErrMsg) + type(AWAE_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AWAE_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ParamData%y)) then + deallocate(ParamData%y) + end if + if (allocated(ParamData%z)) then + deallocate(ParamData%z) + end if + if (allocated(ParamData%X0_high)) then + deallocate(ParamData%X0_high) + end if + if (allocated(ParamData%Y0_high)) then + deallocate(ParamData%Y0_high) + end if + if (allocated(ParamData%Z0_high)) then + deallocate(ParamData%Z0_high) + end if + if (allocated(ParamData%dX_high)) then + deallocate(ParamData%dX_high) + end if + if (allocated(ParamData%dY_high)) then + deallocate(ParamData%dY_high) + end if + if (allocated(ParamData%dZ_high)) then + deallocate(ParamData%dZ_high) + end if + if (allocated(ParamData%Grid_low)) then + deallocate(ParamData%Grid_low) + end if + if (allocated(ParamData%Grid_high)) then + deallocate(ParamData%Grid_high) + end if + if (allocated(ParamData%WT_Position)) then + deallocate(ParamData%WT_Position) + end if + if (allocated(ParamData%IfW)) then + LB(1:1) = lbound(ParamData%IfW) + UB(1:1) = ubound(ParamData%IfW) + do i1 = LB(1), UB(1) + call InflowWind_DestroyParam(ParamData%IfW(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%IfW) + end if + if (allocated(ParamData%OutDisWindZ)) then + deallocate(ParamData%OutDisWindZ) + end if + if (allocated(ParamData%OutDisWindX)) then + deallocate(ParamData%OutDisWindX) + end if + if (allocated(ParamData%OutDisWindY)) then + deallocate(ParamData%OutDisWindY) + end if + nullify(ParamData%WAT_FlowField) +end subroutine + +subroutine AWAE_PackParam(RF, Indata) + type(RegFile), intent(inout) :: RF + type(AWAE_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AWAE_PackParam' + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) + logical :: PtrInIndex + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%WindFilePath) + call RegPack(RF, InData%NumTurbines) + call RegPack(RF, InData%NumRadii) + call RegPack(RF, InData%NumPlanes) + call RegPackAlloc(RF, InData%y) + call RegPackAlloc(RF, InData%z) + call RegPack(RF, InData%Mod_AmbWind) + call RegPack(RF, InData%nX_low) + call RegPack(RF, InData%nY_low) + call RegPack(RF, InData%nZ_low) + call RegPack(RF, InData%NumGrid_low) + call RegPack(RF, InData%n_rp_max) + call RegPack(RF, InData%dpol) + call RegPack(RF, InData%dXYZ_low) + call RegPack(RF, InData%dX_low) + call RegPack(RF, InData%dY_low) + call RegPack(RF, InData%dZ_low) + call RegPack(RF, InData%X0_low) + call RegPack(RF, InData%Y0_low) + call RegPack(RF, InData%Z0_low) + call RegPackAlloc(RF, InData%X0_high) + call RegPackAlloc(RF, InData%Y0_high) + call RegPackAlloc(RF, InData%Z0_high) + call RegPackAlloc(RF, InData%dX_high) + call RegPackAlloc(RF, InData%dY_high) + call RegPackAlloc(RF, InData%dZ_high) + call RegPack(RF, InData%nX_high) + call RegPack(RF, InData%nY_high) + call RegPack(RF, InData%nZ_high) + call RegPackAlloc(RF, InData%Grid_low) + call RegPackAlloc(RF, InData%Grid_high) + call RegPackAlloc(RF, InData%WT_Position) + call RegPack(RF, InData%n_high_low) + call RegPack(RF, InData%dt_low) + call RegPack(RF, InData%dt_high) + call RegPack(RF, InData%NumDT) + call RegPack(RF, InData%Mod_Meander) + call RegPack(RF, InData%C_Meander) + call RegPack(RF, InData%C_ScaleDiam) + call RegPack(RF, InData%Mod_Projection) + call RegPack(RF, allocated(InData%IfW)) + if (allocated(InData%IfW)) then + call RegPackBounds(RF, 1, lbound(InData%IfW), ubound(InData%IfW)) + LB(1:1) = lbound(InData%IfW) + UB(1:1) = ubound(InData%IfW) + do i1 = LB(1), UB(1) + call InflowWind_PackParam(RF, InData%IfW(i1)) + end do + end if + call RegPack(RF, InData%WrDisSkp1) + call RegPack(RF, InData%WrDisWind) + call RegPack(RF, InData%NOutDisWindXY) + call RegPackAlloc(RF, InData%OutDisWindZ) + call RegPack(RF, InData%NOutDisWindYZ) + call RegPackAlloc(RF, InData%OutDisWindX) + call RegPack(RF, InData%NOutDisWindXZ) + call RegPackAlloc(RF, InData%OutDisWindY) + call RegPack(RF, InData%OutFileRoot) + call RegPack(RF, InData%OutFileVTKRoot) + call RegPack(RF, InData%VTK_tWidth) + call RegPack(RF, InData%WAT_Enabled) + call RegPack(RF, associated(InData%WAT_FlowField)) + if (associated(InData%WAT_FlowField)) then + call RegPackPointer(RF, c_loc(InData%WAT_FlowField), PtrInIndex) + if (.not. PtrInIndex) then + call IfW_FlowField_PackFlowFieldType(RF, InData%WAT_FlowField) + end if + end if + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AWAE_UnPackParam(RF, OutData) + type(RegFile), intent(inout) :: RF + type(AWAE_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AWAE_UnPackParam' + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(B8Ki) :: PtrIdx + type(c_ptr) :: Ptr + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%WindFilePath); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumTurbines); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumRadii); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumPlanes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%z); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Mod_AmbWind); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nX_low); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nY_low); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nZ_low); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumGrid_low); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%n_rp_max); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%dpol); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%dXYZ_low); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%dX_low); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%dY_low); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%dZ_low); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%X0_low); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Y0_low); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Z0_low); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%X0_high); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Y0_high); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Z0_high); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dX_high); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dY_high); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dZ_high); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nX_high); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nY_high); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nZ_high); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Grid_low); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Grid_high); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WT_Position); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%n_high_low); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%dt_low); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%dt_high); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumDT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Mod_Meander); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%C_Meander); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%C_ScaleDiam); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Mod_Projection); if (RegCheckErr(RF, RoutineName)) return + if (allocated(OutData%IfW)) deallocate(OutData%IfW) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%IfW(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%IfW.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call InflowWind_UnpackParam(RF, OutData%IfW(i1)) ! IfW + end do + end if + call RegUnpack(RF, OutData%WrDisSkp1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WrDisWind); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NOutDisWindXY); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%OutDisWindZ); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NOutDisWindYZ); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%OutDisWindX); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NOutDisWindXZ); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%OutDisWindY); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutFileRoot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutFileVTKRoot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VTK_tWidth); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WAT_Enabled); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%WAT_FlowField)) deallocate(OutData%WAT_FlowField) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackPointer(RF, Ptr, PtrIdx); if (RegCheckErr(RF, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WAT_FlowField) + else + allocate(OutData%WAT_FlowField,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WAT_FlowField.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + RF%Pointers(PtrIdx) = c_loc(OutData%WAT_FlowField) + call IfW_FlowField_UnpackFlowFieldType(RF, OutData%WAT_FlowField) ! WAT_FlowField + end if + else + OutData%WAT_FlowField => null() + end if +end subroutine + +subroutine AWAE_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(AWAE_OutputType), intent(in) :: SrcOutputData + type(AWAE_OutputType), intent(inout) :: DstOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AWAE_CopyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcOutputData%Vdist_High)) then + LB(1:1) = lbound(SrcOutputData%Vdist_High) + UB(1:1) = ubound(SrcOutputData%Vdist_High) + if (.not. allocated(DstOutputData%Vdist_High)) then + allocate(DstOutputData%Vdist_High(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Vdist_High.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AWAE_CopyHighWindGrid(SrcOutputData%Vdist_High(i1), DstOutputData%Vdist_High(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcOutputData%V_plane)) then + LB(1:3) = lbound(SrcOutputData%V_plane) + UB(1:3) = ubound(SrcOutputData%V_plane) + if (.not. allocated(DstOutputData%V_plane)) then + allocate(DstOutputData%V_plane(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%V_plane.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%V_plane = SrcOutputData%V_plane + end if + if (allocated(SrcOutputData%TI_amb)) then + LB(1:1) = lbound(SrcOutputData%TI_amb) + UB(1:1) = ubound(SrcOutputData%TI_amb) + if (.not. allocated(DstOutputData%TI_amb)) then + allocate(DstOutputData%TI_amb(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%TI_amb.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%TI_amb = SrcOutputData%TI_amb + end if + if (allocated(SrcOutputData%Vx_wind_disk)) then + LB(1:1) = lbound(SrcOutputData%Vx_wind_disk) + UB(1:1) = ubound(SrcOutputData%Vx_wind_disk) + if (.not. allocated(DstOutputData%Vx_wind_disk)) then + allocate(DstOutputData%Vx_wind_disk(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Vx_wind_disk.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%Vx_wind_disk = SrcOutputData%Vx_wind_disk + end if +end subroutine + +subroutine AWAE_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(AWAE_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AWAE_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OutputData%Vdist_High)) then + LB(1:1) = lbound(OutputData%Vdist_High) + UB(1:1) = ubound(OutputData%Vdist_High) + do i1 = LB(1), UB(1) + call AWAE_DestroyHighWindGrid(OutputData%Vdist_High(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(OutputData%Vdist_High) + end if + if (allocated(OutputData%V_plane)) then + deallocate(OutputData%V_plane) + end if + if (allocated(OutputData%TI_amb)) then + deallocate(OutputData%TI_amb) + end if + if (allocated(OutputData%Vx_wind_disk)) then + deallocate(OutputData%Vx_wind_disk) + end if +end subroutine + +subroutine AWAE_PackOutput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(AWAE_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AWAE_PackOutput' + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%Vdist_High)) + if (allocated(InData%Vdist_High)) then + call RegPackBounds(RF, 1, lbound(InData%Vdist_High), ubound(InData%Vdist_High)) + LB(1:1) = lbound(InData%Vdist_High) + UB(1:1) = ubound(InData%Vdist_High) + do i1 = LB(1), UB(1) + call AWAE_PackHighWindGrid(RF, InData%Vdist_High(i1)) + end do + end if + call RegPackAlloc(RF, InData%V_plane) + call RegPackAlloc(RF, InData%TI_amb) + call RegPackAlloc(RF, InData%Vx_wind_disk) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AWAE_UnPackOutput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(AWAE_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AWAE_UnPackOutput' + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + if (allocated(OutData%Vdist_High)) deallocate(OutData%Vdist_High) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%Vdist_High(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vdist_High.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AWAE_UnpackHighWindGrid(RF, OutData%Vdist_High(i1)) ! Vdist_High + end do + end if + call RegUnpackAlloc(RF, OutData%V_plane); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TI_amb); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Vx_wind_disk); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AWAE_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) + type(AWAE_InputType), intent(in) :: SrcInputData + type(AWAE_InputType), intent(inout) :: DstInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(4), UB(4) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'AWAE_CopyInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcInputData%xhat_plane)) then + LB(1:3) = lbound(SrcInputData%xhat_plane) + UB(1:3) = ubound(SrcInputData%xhat_plane) + if (.not. allocated(DstInputData%xhat_plane)) then + allocate(DstInputData%xhat_plane(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%xhat_plane.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%xhat_plane = SrcInputData%xhat_plane + end if + if (allocated(SrcInputData%p_plane)) then + LB(1:3) = lbound(SrcInputData%p_plane) + UB(1:3) = ubound(SrcInputData%p_plane) + if (.not. allocated(DstInputData%p_plane)) then + allocate(DstInputData%p_plane(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%p_plane.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%p_plane = SrcInputData%p_plane + end if + if (allocated(SrcInputData%Vx_wake)) then + LB(1:4) = lbound(SrcInputData%Vx_wake) + UB(1:4) = ubound(SrcInputData%Vx_wake) + if (.not. allocated(DstInputData%Vx_wake)) then + allocate(DstInputData%Vx_wake(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%Vx_wake.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%Vx_wake = SrcInputData%Vx_wake + end if + if (allocated(SrcInputData%Vy_wake)) then + LB(1:4) = lbound(SrcInputData%Vy_wake) + UB(1:4) = ubound(SrcInputData%Vy_wake) + if (.not. allocated(DstInputData%Vy_wake)) then + allocate(DstInputData%Vy_wake(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%Vy_wake.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%Vy_wake = SrcInputData%Vy_wake + end if + if (allocated(SrcInputData%Vz_wake)) then + LB(1:4) = lbound(SrcInputData%Vz_wake) + UB(1:4) = ubound(SrcInputData%Vz_wake) + if (.not. allocated(DstInputData%Vz_wake)) then + allocate(DstInputData%Vz_wake(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%Vz_wake.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%Vz_wake = SrcInputData%Vz_wake + end if + if (allocated(SrcInputData%D_wake)) then + LB(1:2) = lbound(SrcInputData%D_wake) + UB(1:2) = ubound(SrcInputData%D_wake) + if (.not. allocated(DstInputData%D_wake)) then + allocate(DstInputData%D_wake(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%D_wake.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%D_wake = SrcInputData%D_wake + end if + if (allocated(SrcInputData%WAT_k)) then + LB(1:4) = lbound(SrcInputData%WAT_k) + UB(1:4) = ubound(SrcInputData%WAT_k) + if (.not. allocated(DstInputData%WAT_k)) then + allocate(DstInputData%WAT_k(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%WAT_k.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%WAT_k = SrcInputData%WAT_k + end if +end subroutine + +subroutine AWAE_DestroyInput(InputData, ErrStat, ErrMsg) + type(AWAE_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AWAE_DestroyInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InputData%xhat_plane)) then + deallocate(InputData%xhat_plane) + end if + if (allocated(InputData%p_plane)) then + deallocate(InputData%p_plane) + end if + if (allocated(InputData%Vx_wake)) then + deallocate(InputData%Vx_wake) + end if + if (allocated(InputData%Vy_wake)) then + deallocate(InputData%Vy_wake) + end if + if (allocated(InputData%Vz_wake)) then + deallocate(InputData%Vz_wake) + end if + if (allocated(InputData%D_wake)) then + deallocate(InputData%D_wake) + end if + if (allocated(InputData%WAT_k)) then + deallocate(InputData%WAT_k) + end if +end subroutine + +subroutine AWAE_PackInput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(AWAE_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AWAE_PackInput' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%xhat_plane) + call RegPackAlloc(RF, InData%p_plane) + call RegPackAlloc(RF, InData%Vx_wake) + call RegPackAlloc(RF, InData%Vy_wake) + call RegPackAlloc(RF, InData%Vz_wake) + call RegPackAlloc(RF, InData%D_wake) + call RegPackAlloc(RF, InData%WAT_k) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AWAE_UnPackInput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(AWAE_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AWAE_UnPackInput' + integer(B4Ki) :: LB(4), UB(4) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%xhat_plane); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%p_plane); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Vx_wake); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Vy_wake); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Vz_wake); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%D_wake); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WAT_k); if (RegCheckErr(RF, RoutineName)) return +end subroutine END MODULE AWAE_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/awae/src/AWAE_Driver.f90 b/modules/awae/src/driver/AWAE_Driver.f90 similarity index 97% rename from modules/awae/src/AWAE_Driver.f90 rename to modules/awae/src/driver/AWAE_Driver.f90 index ba02644f78..45e0f80191 100644 --- a/modules/awae/src/AWAE_Driver.f90 +++ b/modules/awae/src/driver/AWAE_Driver.f90 @@ -38,9 +38,9 @@ program AWAE_Driver ! Initialize the NWTC Subroutine Library call NWTC_Init( EchoLibVer=.FALSE. ) !call AWAE_TEST_ExtractSlice(errStat, errMsg) - call AWAE_TEST_LowResGridCalcs(errStat, errMsg) +! call AWAE_TEST_LowResGridCalcs(errStat, errMsg) ! call AWAE_Dvr_Tests(1, errStat, errMsg) - call CheckError( errStat, errMsg ) +! call CheckError( errStat, errMsg ) ! Initialize the Driver and the WD module !call AWAE_TEST_Init_BadData(errStat, ErrMsg) !call CheckError( ErrStat, ErrMsg ) diff --git a/modules/awae/src/AWAE_Driver_Subs.f90 b/modules/awae/src/driver/AWAE_Driver_Subs.f90 similarity index 99% rename from modules/awae/src/AWAE_Driver_Subs.f90 rename to modules/awae/src/driver/AWAE_Driver_Subs.f90 index 24bcc165b8..e66df6d02e 100644 --- a/modules/awae/src/AWAE_Driver_Subs.f90 +++ b/modules/awae/src/driver/AWAE_Driver_Subs.f90 @@ -448,13 +448,13 @@ subroutine AWAE_Dvr_Init( AWAE_InitInp, AWAE_InitOut, AWAE_u,AWAE_p, AWAE_xd, call NWTC_Init() ! Display the copyright notice - CAlL DispCopyrightLicense( version ) +! CAlL DispCopyrightLicense( version ) ! Tell our users what they're running call WrScr( ' Running '//GetNVD( version )//NewLine//' linked with '//trim( GetNVD( NWTC_Ver ))//NewLine ) inputFile = "" ! initialize to empty string to make sure it's input from the command line - call CheckArgs( inputFile, ErrStat2 ) +! call CheckArgs( inputFile, ErrStat2 ) if (len_trim(inputFile) == 0) then ! no input file was specified call SetErrStat(ErrID_Fatal, 'The required input file was not specified on the command line.', ErrStat, ErrMsg, RoutineName) @@ -487,4 +487,4 @@ end subroutine AWAE_Dvr_Init end module AWAE_Driver_Subs - \ No newline at end of file + diff --git a/modules/beamdyn/CMakeLists.txt b/modules/beamdyn/CMakeLists.txt index bf44a71687..9990c4c768 100644 --- a/modules/beamdyn/CMakeLists.txt +++ b/modules/beamdyn/CMakeLists.txt @@ -18,7 +18,7 @@ if (GENERATE_TYPES) generate_f90_types(src/Registry_BeamDyn.txt ${CMAKE_CURRENT_LIST_DIR}/src/BeamDyn_Types.f90) endif() -add_library(beamdynlib +add_library(beamdynlib STATIC src/BeamDyn.f90 src/BeamDyn_IO.f90 src/BeamDyn_BldNdOuts_IO.f90 diff --git a/modules/beamdyn/src/BeamDyn.f90 b/modules/beamdyn/src/BeamDyn.f90 index 25eff3875b..86d3382a47 100644 --- a/modules/beamdyn/src/BeamDyn.f90 +++ b/modules/beamdyn/src/BeamDyn.f90 @@ -244,9 +244,6 @@ SUBROUTINE BD_Init( InitInp, u, p, x, xd, z, OtherState, y, MiscVar, Interval, I z%DummyConstrState = 0.0_BDKi - ! copy data for BeamDyn driver: - call move_alloc ( InputFileData%kp_coordinate, InitOut%kp_coordinate) - InitOut%kp_total = InputFileData%kp_total !............................................................................................ ! Initialize Jacobian: @@ -817,7 +814,6 @@ subroutine SetInitOut(p, InitOut, ErrStat, ErrMsg) InitOut%Ver = BeamDyn_Ver - ! Set the info in WriteOutputHdr and WriteOutputUnt for BldNd sections. CALL BldNdOuts_InitOut( InitOut, p, ErrStat2, ErrMsg2 ) call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -901,7 +897,8 @@ subroutine SetParameters(InitInp, InputFileData, p, OtherState, ErrStat, ErrMsg) ErrStat = ErrID_None ErrMsg = "" - + p%CompAeroMaps = InitInp%CompAeroMaps + ! Gravity vector -- inertial frame! This must be multiplied by OtherState%GlbRot to get into the BD rotating reference frame p%gravity = InitInp%gravity @@ -1005,6 +1002,14 @@ subroutine SetParameters(InitInp, InputFileData, p, OtherState, ErrStat, ErrMsg) if (ErrStat >= AbortErrLev) return + if (p%CompAeroMaps) then + if (p%BldMotionNodeLoc /= BD_MESH_FE) then +! call SetErrStat(ErrID_Warn, "BeamDyn aero maps must have outputs at FEA nodes; this is different than time-series behavior.", ErrStat, ErrMsg, RoutineName ) + p%BldMotionNodeLoc = BD_MESH_FE + call SetErrStat(ErrID_Fatal, "BeamDyn aero maps must have outputs at FEA nodes, which requires Gaussian quadrature. Update the input file.", ErrStat, ErrMsg, RoutineName ) + return + end if + end if !............................................... ! Set start and end node index for each elements @@ -5985,59 +5990,64 @@ SUBROUTINE BD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM end if end if + if (p%CompAeroMaps) then + dYdu = 0.0_R8Ki + else - ! make a copy of outputs because we will need two for the central difference computations (with orientations) - call BD_CopyOutput( y, y_p, MESH_NEWCOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call BD_CopyOutput( y, y_m, MESH_NEWCOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if + ! make a copy of outputs because we will need two for the central difference computations (with orientations) + call BD_CopyOutput( y, y_p, MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + call BD_CopyOutput( y, y_m, MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (ErrStat>=AbortErrLev) then + call cleanup() + return + end if - do i=1,size(p%Jac_u_indx,1) + do i=1,size(p%Jac_u_indx,1) - ! get u_op + delta_p u - call BD_CopyInput( u, u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - call Perturb_u( p, i, 1, u_perturb, delta_p ) + ! get u_op + delta_p u + call BD_CopyInput( u, u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later + call Perturb_u( p, i, 1, u_perturb, delta_p ) - ! compute y at u_op + delta_p u - call BD_CalcOutput( t, u_perturb, p, x, xd, z, OtherState, y_p, m, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later + ! compute y at u_op + delta_p u + call BD_CalcOutput( t, u_perturb, p, x, xd, z, OtherState, y_p, m, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - ! get u_op - delta_m u - call BD_CopyInput( u, u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - call Perturb_u( p, i, -1, u_perturb, delta_m ) + ! get u_op - delta_m u + call BD_CopyInput( u, u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later + call Perturb_u( p, i, -1, u_perturb, delta_m ) - ! compute y at u_op - delta_m u - call BD_CalcOutput( t, u_perturb, p, x, xd, z, OtherState, y_m, m, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later + ! compute y at u_op - delta_m u + call BD_CalcOutput( t, u_perturb, p, x, xd, z, OtherState, y_m, m, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - ! get central difference: - call Compute_dY( p, y_p, y_m, delta_p, dYdu(:,i) ) + ! get central difference: + call Compute_dY( p, y_p, y_m, delta_p, dYdu(:,i) ) - end do + end do - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if - call BD_DestroyOutput( y_p, ErrStat2, ErrMsg2 ) ! we don't need this any more - call BD_DestroyOutput( y_m, ErrStat2, ErrMsg2 ) ! we don't need this any more + if (ErrStat>=AbortErrLev) then + call cleanup() + return + end if + call BD_DestroyOutput( y_p, ErrStat2, ErrMsg2 ) ! we don't need this any more + call BD_DestroyOutput( y_m, ErrStat2, ErrMsg2 ) ! we don't need this any more - if (p%RelStates) then - call BD_JacobianPContState_noRotate( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdx=m%lin_C ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if - dYdu = dYdu + matmul(m%lin_C, RelState_x) - end if + if (p%RelStates) then + call BD_JacobianPContState_noRotate( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdx=m%lin_C ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (ErrStat>=AbortErrLev) then + call cleanup() + return + end if + dYdu = dYdu + matmul(m%lin_C, RelState_x) + end if + + end if ! CompAeroMaps END IF @@ -6653,16 +6663,19 @@ SUBROUTINE BD_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, index = 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%RootMotion, u_op, index, FieldMask=FieldMask) + if (.not. p%CompAeroMaps) then + 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%RootMotion, u_op, index, FieldMask=FieldMask) - call PackLoadMesh(u%PointLoad, u_op, index) + call PackLoadMesh(u%PointLoad, u_op, index) + end if + call PackLoadMesh(u%DistrLoad, u_op, index) END IF @@ -6687,22 +6700,28 @@ SUBROUTINE BD_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, if (ReturnTrimOP) y_op = 0.0_ReKi ! initialize in case we are returning packed orientations and don't fill the entire array index = 1 - call PackLoadMesh(y%ReactionForce, y_op, index) - 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. + + if (.not. p%CompAeroMaps) then + + call PackLoadMesh(y%ReactionForce, y_op, index) + + FieldMask(MASKID_RotationVel) = .true. + FieldMask(MASKID_TranslationAcc) = .true. + FieldMask(MASKID_RotationAcc) = .true. + end if call PackMotionMesh(y%BldMotion, y_op, index, FieldMask=FieldMask, TrimOP=ReturnTrimOP) - index = index - 1 - do i=1,p%NumOuts + p%BldNd_TotNumOuts - y_op(i+index) = y%WriteOutput(i) - end do - + if (.not. p%CompAeroMaps) then + index = index - 1 + do i=1,p%NumOuts + p%BldNd_TotNumOuts + y_op(i+index) = y%WriteOutput(i) + end do + end if + END IF diff --git a/modules/beamdyn/src/BeamDyn_BldNdOuts_IO.f90 b/modules/beamdyn/src/BeamDyn_BldNdOuts_IO.f90 index 34b9d85cda..d976d83777 100644 --- a/modules/beamdyn/src/BeamDyn_BldNdOuts_IO.f90 +++ b/modules/beamdyn/src/BeamDyn_BldNdOuts_IO.f90 @@ -323,7 +323,7 @@ SUBROUTINE Calc_WriteBldNdOutput( p, OtherState, m, y, ErrStat, ErrMsg ) ! Set the root rotation DCM relative to the reference. ! NOTE: the orientations used in this routine are DCM's. These are directly from the mesh. - call LAPACK_DGEMM('T', 'N', 1.0_BDKi, m%u2%RootMotion%Orientation(:,:,1), m%u2%RootMotion%RefOrientation(:,:,1), 0.0_BDKi, RootRelOrient, ErrStat2, ErrMsg2 ) + call LAPACK_GEMM('T', 'N', 1.0_BDKi, m%u2%RootMotion%Orientation(:,:,1), m%u2%RootMotion%RefOrientation(:,:,1), 0.0_BDKi, RootRelOrient, ErrStat2, ErrMsg2 ) ! Loop over the channel sets @@ -407,8 +407,8 @@ SUBROUTINE Calc_WriteBldNdOutput( p, OtherState, m, y, ErrStat, ErrMsg ) !------------------------- !FIXME: we are not trapping errors here. Do we need to? ! Sectional angular/rotational deflection Wiener-Milenkovic parameter (relative to the undeflected orientation) expressed in r - call LAPACK_DGEMM('N', 'T', 1.0_BDKi, y%BldMotion%RefOrientation(:,:,idx_node), RootRelOrient, 0.0_BDKi, Tmp33b, ErrStat2, ErrMsg2 ) - call LAPACK_DGEMM('T', 'N', 1.0_BDKi, y%BldMotion%Orientation( :,:,idx_node), Tmp33b, 0.0_BDKi, Tmp33a, ErrStat2, ErrMsg2 ) + call LAPACK_GEMM('N', 'T', 1.0_BDKi, y%BldMotion%RefOrientation(:,:,idx_node), RootRelOrient, 0.0_BDKi, Tmp33b, ErrStat2, ErrMsg2 ) + call LAPACK_GEMM('T', 'N', 1.0_BDKi, y%BldMotion%Orientation( :,:,idx_node), Tmp33b, 0.0_BDKi, Tmp33a, ErrStat2, ErrMsg2 ) call BD_CrvExtractCrv(Tmp33a,temp_vec2, ErrStat2, ErrMsg2) ! temp_vec2 = the Wiener-Milenkovic parameters of the node's angular/rotational defelctions WM_ParamRD = MATMUL(m%u2%RootMotion%Orientation(:,:,1),temp_vec2) ! Rotate the parameters to the correct coordinate system for output diff --git a/modules/beamdyn/src/BeamDyn_IO.f90 b/modules/beamdyn/src/BeamDyn_IO.f90 index d50d333122..0b52e2fabe 100644 --- a/modules/beamdyn/src/BeamDyn_IO.f90 +++ b/modules/beamdyn/src/BeamDyn_IO.f90 @@ -1008,11 +1008,13 @@ SUBROUTINE BD_ReadPrimaryFile(InputFile,InputFileData,OutFileRoot,UnEc,ErrStat,E ! OutList - List of user-requested output channels at each node(-): CALL ReadOutputList ( UnIn, InputFile, InputFileData%BldNd_OutList, InputFileData%BldNd_NumOuts, 'BldNd_OutList', "List of user-requested output channels", ErrStat2, ErrMsg2, UnEc ) ! Routine in NWTC Subroutine Library - IF ( ErrStat2 >= AbortErrLev ) THEN + IF ( ErrStat2 >= AbortErrLev .and. InputFileData%BldNd_NumOuts < 1) THEN InputFileData%BldNd_NumOuts = 0 call wrscr( trim(ErrMsg_NoBldNdOuts) ) CALL Cleanup() RETURN + ELSE + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ENDIF !---------------------- END OF FILE ----------------------------------------- @@ -1688,7 +1690,7 @@ SUBROUTINE Calc_WriteOutput( p, AllOuts, y, m, ErrStat, ErrMsg, CalcWriteOutput ! compute the root relative orientation, RootRelOrient, which is used in several calculations below ! RootRelOrient = matmul( transpose(m%u2%RootMotion%Orientation(:,:,1)), m%u2%RootMotion%RefOrientation(:,:,1)) - call LAPACK_DGEMM('T', 'N', 1.0_BDKi, m%u2%RootMotion%Orientation(:,:,1), m%u2%RootMotion%RefOrientation(:,:,1), 0.0_BDKi, RootRelOrient, ErrStat2, ErrMsg2 ) + call LAPACK_GEMM('T', 'N', 1.0_BDKi, m%u2%RootMotion%Orientation(:,:,1), m%u2%RootMotion%RefOrientation(:,:,1), 0.0_BDKi, RootRelOrient, ErrStat2, ErrMsg2 ) !------------------------------------ ! Tip translational deflection (relative to the undeflected position) expressed in r @@ -1703,8 +1705,8 @@ SUBROUTINE Calc_WriteOutput( p, AllOuts, y, m, ErrStat, ErrMsg, CalcWriteOutput !------------------------- ! Tip angular/rotational deflection Wiener-Milenkovic parameter (relative to the undeflected orientation) expressed in r - call LAPACK_DGEMM('N', 'T', 1.0_BDKi, y%BldMotion%RefOrientation(:,:,y%BldMotion%NNodes), RootRelOrient, 0.0_BDKi, temp33_2, ErrStat2, ErrMsg2 ) - call LAPACK_DGEMM('T', 'N', 1.0_BDKi, y%BldMotion%Orientation( :,:,y%BldMotion%NNodes), temp33_2, 0.0_BDKi, temp33, ErrStat2, ErrMsg2 ) + call LAPACK_GEMM('N', 'T', 1.0_BDKi, y%BldMotion%RefOrientation(:,:,y%BldMotion%NNodes), RootRelOrient, 0.0_BDKi, temp33_2, ErrStat2, ErrMsg2 ) + call LAPACK_GEMM('T', 'N', 1.0_BDKi, y%BldMotion%Orientation( :,:,y%BldMotion%NNodes), temp33_2, 0.0_BDKi, temp33, ErrStat2, ErrMsg2 ) call BD_CrvExtractCrv(temp33,temp_vec2, ErrStat2, ErrMsg2) ! temp_vec2 = the Wiener-Milenkovic parameters of the tip angular/rotational defelctions CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return @@ -1789,8 +1791,8 @@ SUBROUTINE Calc_WriteOutput( p, AllOuts, y, m, ErrStat, ErrMsg, CalcWriteOutput !------------------------- ! Sectional angular/rotational deflection Wiener-Milenkovic parameter (relative to the undeflected orientation) expressed in r - call LAPACK_DGEMM('N', 'T', 1.0_BDKi, y%BldMotion%RefOrientation(:,:,j_BldMotion), RootRelOrient, 0.0_BDKi, temp33_2, ErrStat2, ErrMsg2 ) - call LAPACK_DGEMM('T', 'N', 1.0_BDKi, y%BldMotion%Orientation( :,:,j_BldMotion), temp33_2, 0.0_BDKi, temp33, ErrStat2, ErrMsg2 ) + call LAPACK_GEMM('N', 'T', 1.0_BDKi, y%BldMotion%RefOrientation(:,:,j_BldMotion), RootRelOrient, 0.0_BDKi, temp33_2, ErrStat2, ErrMsg2 ) + call LAPACK_GEMM('T', 'N', 1.0_BDKi, y%BldMotion%Orientation( :,:,j_BldMotion), temp33_2, 0.0_BDKi, temp33, ErrStat2, ErrMsg2 ) call BD_CrvExtractCrv(temp33,temp_vec2, ErrStat2, ErrMsg2) ! temp_vec2 = the Wiener-Milenkovic parameters of the node's angular/rotational defelctions CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return @@ -2095,10 +2097,14 @@ SUBROUTINE Init_Jacobian( p, u, y, m, InitOut, ErrStat, ErrMsg) if (ErrStat >= AbortErrLev) return ! determine how many inputs there are in the Jacobians - nu = u%RootMotion%NNodes * 18 & ! 3 Translation Displacements + 3 orientations + 6 velocities (rotation+translation) + 6 accelerations at each node - + u%PointLoad%NNodes * 6 & ! 3 forces + 3 moments at each node - + u%DistrLoad%NNodes * 6 ! 3 forces + 3 moments at each node - + if (p%CompAeroMaps) then + nu = u%DistrLoad%NNodes * 6 ! 3 forces + 3 moments at each node + else + nu = u%RootMotion%NNodes * 18 & ! 3 Translation Displacements + 3 orientations + 6 velocities (rotation+translation) + 6 accelerations at each node + + u%PointLoad%NNodes * 6 & ! 3 forces + 3 moments at each node + + u%DistrLoad%NNodes * 6 ! 3 forces + 3 moments at each node + end if + ! all other inputs (e.g., hub motion) ignored !............................ @@ -2123,29 +2129,31 @@ SUBROUTINE Init_Jacobian( p, u, y, m, InitOut, ErrStat, ErrMsg) !Module/Mesh/Field: u%RootMotion%RotationVel = 4; !Module/Mesh/Field: u%RootMotion%TranslationAcc = 5; !Module/Mesh/Field: u%RootMotion%RotationAcc = 6; - do i_meshField = 1,6 - do i=1,u%RootMotion%NNodes - do j=1,3 - p%Jac_u_indx(index,1) = i_meshField - p%Jac_u_indx(index,2) = j !component index: j - p%Jac_u_indx(index,3) = i !Node: i - index = index + 1 - end do !j - end do !i - end do + if (.not. p%CompAeroMaps) then + do i_meshField = 1,6 + do i=1,u%RootMotion%NNodes + do j=1,3 + p%Jac_u_indx(index,1) = i_meshField + p%Jac_u_indx(index,2) = j !component index: j + p%Jac_u_indx(index,3) = i !Node: i + index = index + 1 + end do !j + end do !i + end do - !Module/Mesh/Field: u%PointLoad%Force = 7; - !Module/Mesh/Field: u%PointLoad%Moment = 8; - do i_meshField = 7,8 - do i=1,u%PointLoad%NNodes - do j=1,3 - p%Jac_u_indx(index,1) = i_meshField - p%Jac_u_indx(index,2) = j !component index: j - p%Jac_u_indx(index,3) = i !Node: i - index = index + 1 - end do !j - end do !i - end do + !Module/Mesh/Field: u%PointLoad%Force = 7; + !Module/Mesh/Field: u%PointLoad%Moment = 8; + do i_meshField = 7,8 + do i=1,u%PointLoad%NNodes + do j=1,3 + p%Jac_u_indx(index,1) = i_meshField + p%Jac_u_indx(index,2) = j !component index: j + p%Jac_u_indx(index,3) = i !Node: i + index = index + 1 + end do !j + end do !i + end do + end if !Module/Mesh/Field: u%DistrLoad%Force = 9; !Module/Mesh/Field: u%DistrLoad%Moment = 10; @@ -2201,10 +2209,12 @@ SUBROUTINE Init_Jacobian( p, u, y, m, InitOut, ErrStat, ErrMsg) InitOut%RotFrame_u = .false. ! every input is on a mesh, which stores values in the global (not rotating) frame index = 1 - call PackMotionMesh_Names(u%RootMotion, 'RootMotion', InitOut%LinNames_u, index) ! all 6 motion fields - InitOut%IsLoad_u(1:index-1) = .false. ! the RootMotion inputs are not loads - InitOut%IsLoad_u(index:) = .true. ! the remaining inputs are loads - call PackLoadMesh_Names( u%PointLoad, 'PointLoad', InitOut%LinNames_u, index) + InitOut%IsLoad_u = .true. ! initialize all inputs as loads, and overwrite for the RootMotion mesh, below: + if (.not. p%CompAeroMaps) then + call PackMotionMesh_Names(u%RootMotion, 'RootMotion', InitOut%LinNames_u, index) ! all 6 motion fields + InitOut%IsLoad_u(1:index-1) = .false. ! the RootMotion inputs are not loads + call PackLoadMesh_Names( u%PointLoad, 'PointLoad', InitOut%LinNames_u, index) + end if call PackLoadMesh_Names( u%DistrLoad, 'DistrLoad', InitOut%LinNames_u, index) @@ -2231,16 +2241,20 @@ SUBROUTINE Init_Jacobian_y( p, y, InitOut, ErrStat, ErrMsg) CHARACTER(ChanLen) :: ChannelName LOGICAL :: isRotating + LOGICAL :: BladeMask(FIELDMASK_SIZE) ! flags to determine if this field is part of the packing ErrStat = ErrID_None ErrMsg = "" + if (p%CompAeroMaps) then + p%Jac_ny = y%BldMotion%NNodes * 12 ! 6 displacements (translation, rotation) + 6 velocities + else - ! determine how many outputs there are in the Jacobians - p%Jac_ny = y%ReactionForce%NNodes * 6 & ! 3 forces + 3 moments at each node - + y%BldMotion%NNodes * 18 & ! 6 displacements (translation, rotation) + 6 velocities + 6 accelerations at each node - + p%NumOuts + p%BldNd_TotNumOuts ! WriteOutput values - + ! determine how many outputs there are in the Jacobians + p%Jac_ny = y%ReactionForce%NNodes * 6 & ! 3 forces + 3 moments at each node + + y%BldMotion%NNodes * 18 & ! 6 displacements (translation, rotation) + 6 velocities + 6 accelerations at each node + + p%NumOuts + p%BldNd_TotNumOuts ! WriteOutput values + end if ! get the names of the linearized outputs: call AllocAry(InitOut%LinNames_y, p%Jac_ny,'LinNames_y',ErrStat2,ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) @@ -2251,50 +2265,58 @@ SUBROUTINE Init_Jacobian_y( p, y, InitOut, ErrStat, ErrMsg) InitOut%RotFrame_y = .false. ! need to set all the values in the global system to .false index_next = 1 - call PackLoadMesh_Names( y%ReactionForce, 'Reaction force', InitOut%LinNames_y, index_next) - call PackMotionMesh_Names(y%BldMotion, 'Blade motion', InitOut%LinNames_y, index_next) + if (p%CompAeroMaps) then + BladeMask = .true. ! default is all the fields + BladeMask(MASKID_TRANSLATIONACC) = .false. + BladeMask(MASKID_ROTATIONACC) = .false. + + call PackMotionMesh_Names(y%BldMotion, 'Blade motion', InitOut%LinNames_y, index_next, FieldMask=BladeMask) + else + call PackLoadMesh_Names( y%ReactionForce, 'Reaction force', InitOut%LinNames_y, index_next) + call PackMotionMesh_Names(y%BldMotion, 'Blade motion', InitOut%LinNames_y, index_next) - do i=1,p%NumOuts + p%BldNd_TotNumOuts - InitOut%LinNames_y(i+index_next-1) = trim(InitOut%WriteOutputHdr(i))//', '//trim(InitOut%WriteOutputUnt(i)) - end do + do i=1,p%NumOuts + p%BldNd_TotNumOuts + InitOut%LinNames_y(i+index_next-1) = trim(InitOut%WriteOutputHdr(i))//', '//trim(InitOut%WriteOutputUnt(i)) + end do - AllOut = .true. ! all output values except those specifically in the global system are in the rotating system - AllOut(TipTVXg) = .false. - AllOut(TipTVYg) = .false. - AllOut(TipTVZg) = .false. - AllOut(TipRVXg) = .false. - AllOut(TipRVYg) = .false. - AllOut(TipRVZg) = .false. + AllOut = .true. ! all output values except those specifically in the global system are in the rotating system + AllOut(TipTVXg) = .false. + AllOut(TipTVYg) = .false. + AllOut(TipTVZg) = .false. + AllOut(TipRVXg) = .false. + AllOut(TipRVYg) = .false. + AllOut(TipRVZg) = .false. - do j=1,9 - do i=1,3 !x,y,z - AllOut(NTVg(j,i)) = .false. - AllOut(NRVg(j,i)) = .false. + do j=1,9 + do i=1,3 !x,y,z + AllOut(NTVg(j,i)) = .false. + AllOut(NRVg(j,i)) = .false. + end do end do - end do - do i=1,p%NumOuts - if (p%OutParam(i)%Indx == 0 ) then - InitOut%RotFrame_y(i+index_next-1) = .false. - else - InitOut%RotFrame_y(i+index_next-1) = AllOut( p%OutParam(i)%Indx ) - end if - end do + do i=1,p%NumOuts + if (p%OutParam(i)%Indx == 0 ) then + InitOut%RotFrame_y(i+index_next-1) = .false. + else + InitOut%RotFrame_y(i+index_next-1) = AllOut( p%OutParam(i)%Indx ) + end if + end do - ! set outputs for all nodes out: - index_next = index_next + p%NumOuts - DO i=1,p%BldNd_NumOuts - ChannelName = p%BldNd_OutParam(i)%Name - call Conv2UC(ChannelName) - if ( ChannelName( LEN_TRIM(ChannelName):LEN_TRIM(ChannelName) ) == 'G') then ! channel is in global coordinate system - isRotating = .false. - else - isRotating = .true. - end if - InitOut%RotFrame_y(index_next : index_next+size(p%BldNd_BlOutNd)-1 ) = isRotating - index_next = index_next + size(p%BldNd_BlOutNd) - ENDDO + ! set outputs for all nodes out: + index_next = index_next + p%NumOuts + DO i=1,p%BldNd_NumOuts + ChannelName = p%BldNd_OutParam(i)%Name + call Conv2UC(ChannelName) + if ( ChannelName( LEN_TRIM(ChannelName):LEN_TRIM(ChannelName) ) == 'G') then ! channel is in global coordinate system + isRotating = .false. + else + isRotating = .true. + end if + InitOut%RotFrame_y(index_next : index_next+size(p%BldNd_BlOutNd)-1 ) = isRotating + index_next = index_next + size(p%BldNd_BlOutNd) + ENDDO + end if END SUBROUTINE Init_Jacobian_y @@ -2445,14 +2467,22 @@ SUBROUTINE Compute_dY(p, y_p, y_m, delta, dY) ! local variables: INTEGER(IntKi) :: i ! loop over outputs INTEGER(IntKi) :: indx_first ! index indicating next value of dY to be filled - + LOGICAL :: Mask(FIELDMASK_SIZE) ! flags to determine if this field is part of the packing + indx_first = 1 - call PackLoadMesh_dY( y_p%ReactionForce, y_m%ReactionForce, dY, indx_first) - call PackMotionMesh_dY(y_p%BldMotion, y_m%BldMotion, dY, indx_first) ! all 6 motion fields + if (p%CompAeroMaps) then + Mask = .true. + Mask(MASKID_TRANSLATIONACC) = .false. + Mask(MASKID_ROTATIONACC) = .false. + call PackMotionMesh_dY(y_p%BldMotion, y_m%BldMotion, dY, indx_first, FieldMask=Mask) ! 4 motion fields + else + call PackLoadMesh_dY( y_p%ReactionForce, y_m%ReactionForce, dY, indx_first) + call PackMotionMesh_dY(y_p%BldMotion, y_m%BldMotion, dY, indx_first) ! all 6 motion fields - do i=1,p%NumOuts + p%BldNd_TotNumOuts - dY(i+indx_first-1) = y_p%WriteOutput(i) - y_m%WriteOutput(i) - end do + do i=1,p%NumOuts + p%BldNd_TotNumOuts + dY(i+indx_first-1) = y_p%WriteOutput(i) - y_m%WriteOutput(i) + end do + end if dY = dY / (2.0_R8Ki*delta) diff --git a/modules/beamdyn/src/BeamDyn_Types.f90 b/modules/beamdyn/src/BeamDyn_Types.f90 index 91df93f3ef..81632c30ff 100644 --- a/modules/beamdyn/src/BeamDyn_Types.f90 +++ b/modules/beamdyn/src/BeamDyn_Types.f90 @@ -43,16 +43,17 @@ MODULE BeamDyn_Types TYPE, PUBLIC :: BD_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 [m/s^2] - REAL(ReKi) , DIMENSION(1:3) :: GlbPos !< Initial Position Vector of the local blade coordinate system [-] - REAL(R8Ki) , DIMENSION(1:3,1:3) :: GlbRot !< Initial direction cosine matrix of the local blade coordinate system -- in BD coords [-] - REAL(R8Ki) , DIMENSION(1:3) :: RootDisp !< Initial root displacement [-] - REAL(R8Ki) , DIMENSION(1:3,1:3) :: RootOri !< Initial root orientation [-] - REAL(ReKi) , DIMENSION(1:6) :: RootVel !< Initial root velocities and angular veolcities [-] - REAL(ReKi) , DIMENSION(1:3) :: HubPos !< Initial Hub position vector [-] - REAL(R8Ki) , DIMENSION(1:3,1:3) :: HubRot !< Initial Hub direction cosine matrix [-] + REAL(ReKi) , DIMENSION(1:3) :: gravity = 0.0_ReKi !< Gravitational acceleration [m/s^2] + REAL(ReKi) , DIMENSION(1:3) :: GlbPos = 0.0_ReKi !< Initial Position Vector of the local blade coordinate system [-] + REAL(R8Ki) , DIMENSION(1:3,1:3) :: GlbRot = 0.0_R8Ki !< Initial direction cosine matrix of the local blade coordinate system -- in BD coords [-] + REAL(R8Ki) , DIMENSION(1:3) :: RootDisp = 0.0_R8Ki !< Initial root displacement [-] + REAL(R8Ki) , DIMENSION(1:3,1:3) :: RootOri = 0.0_R8Ki !< Initial root orientation [-] + REAL(ReKi) , DIMENSION(1:6) :: RootVel = 0.0_ReKi !< Initial root velocities and angular veolcities [-] + REAL(ReKi) , DIMENSION(1:3) :: HubPos = 0.0_ReKi !< Initial Hub position vector [-] + REAL(R8Ki) , DIMENSION(1:3,1:3) :: HubRot = 0.0_R8Ki !< Initial Hub direction cosine matrix [-] LOGICAL :: Linearize = .FALSE. !< Flag that tells this module if the glue code wants to linearize. [-] LOGICAL :: DynamicSolve = .TRUE. !< Use dynamic solve option. Set to False for static solving (handled by glue code or driver code). [-] + LOGICAL :: CompAeroMaps = .FALSE. !< flag to determine if BeamDyn is computing aero maps (true) or running a normal simulation (false) [-] END TYPE BD_InitInputType ! ======================= ! ========= BD_InitOutputType ======= @@ -60,8 +61,6 @@ MODULE BeamDyn_Types 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 [-] - REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: kp_coordinate !< Key point coordinates array [-] - INTEGER(IntKi) :: kp_total !< Total number of key points [-] 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 [-] @@ -74,51 +73,51 @@ MODULE BeamDyn_Types ! ======================= ! ========= BladeInputData ======= TYPE, PUBLIC :: BladeInputData - INTEGER(IntKi) :: station_total !< Number of blade input stations [-] - INTEGER(IntKi) :: format_index !< Number of blade input stations [-] + INTEGER(IntKi) :: station_total = 0_IntKi !< Number of blade input stations [-] + INTEGER(IntKi) :: format_index = 0_IntKi !< Number of blade input stations [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: station_eta !< Station location in eta [0,1] [-] REAL(R8Ki) , DIMENSION(:,:,:), ALLOCATABLE :: stiff0 !< C/S stiffness matrix arrays [-] REAL(R8Ki) , DIMENSION(:,:,:), ALLOCATABLE :: mass0 !< C/S mass matrix arrays [-] - REAL(R8Ki) , DIMENSION(1:6) :: beta !< Damping Coefficient [-] - INTEGER(IntKi) :: damp_flag !< Damping Flag: 0-No Damping, 1-Damped [-] + REAL(R8Ki) , DIMENSION(1:6) :: beta = 0.0_R8Ki !< Damping Coefficient [-] + INTEGER(IntKi) :: damp_flag = 0_IntKi !< Damping Flag: 0-No Damping, 1-Damped [-] END TYPE BladeInputData ! ======================= ! ========= BD_InputFile ======= TYPE, PUBLIC :: BD_InputFile - INTEGER(IntKi) :: member_total !< Total number of members [-] - INTEGER(IntKi) :: kp_total !< Total number of key point [-] + INTEGER(IntKi) :: member_total = 0_IntKi !< Total number of members [-] + INTEGER(IntKi) :: kp_total = 0_IntKi !< Total number of key point [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: kp_member !< Number of key points in each member [-] - INTEGER(IntKi) :: order_elem !< Order of interpolation (basis) function [-] - INTEGER(IntKi) :: load_retries !< Maximum Number of factored load retries [-] - INTEGER(IntKi) :: NRMax !< Max number of iterations in Newton Raphson algorithm [-] - INTEGER(IntKi) :: quadrature !< Quadrature: 1: Gauss; 2: Trapezoidal [-] - INTEGER(IntKi) :: n_fact !< Factorization frequency [-] - INTEGER(IntKi) :: refine !< FE mesh refinement factor for trapezoidal quadrature [-] - REAL(DbKi) :: rhoinf !< Numerical damping parameter for generalized-alpha integrator [-] - REAL(DbKi) :: DTBeam !< Time interval for BeamDyn calculations {or default} (s) [-] + INTEGER(IntKi) :: order_elem = 0_IntKi !< Order of interpolation (basis) function [-] + INTEGER(IntKi) :: load_retries = 0_IntKi !< Maximum Number of factored load retries [-] + INTEGER(IntKi) :: NRMax = 0_IntKi !< Max number of iterations in Newton Raphson algorithm [-] + INTEGER(IntKi) :: quadrature = 0_IntKi !< Quadrature: 1: Gauss; 2: Trapezoidal [-] + INTEGER(IntKi) :: n_fact = 0_IntKi !< Factorization frequency [-] + INTEGER(IntKi) :: refine = 0_IntKi !< FE mesh refinement factor for trapezoidal quadrature [-] + REAL(DbKi) :: rhoinf = 0.0_R8Ki !< Numerical damping parameter for generalized-alpha integrator [-] + REAL(DbKi) :: DTBeam = 0.0_R8Ki !< Time interval for BeamDyn calculations {or default} (s) [-] TYPE(BladeInputData) :: InpBl !< Input data for individual blades [see BladeInputData Type] CHARACTER(1024) :: BldFile !< Name of blade input file [-] - LOGICAL :: UsePitchAct !< Whether to use a pitch actuator inside BeamDyn [(flag)] - LOGICAL :: QuasiStaticInit !< Use quasistatic pre-conditioning with centripetal accelerations in initialization (flag) [dynamic solve and enFAST only] [-] - REAL(R8Ki) :: stop_tol !< Tolerance for stopping criterion [-] - REAL(R8Ki) :: tngt_stf_pert !< Perturbation size for computing finite differenced tangent stiffness [-] - REAL(R8Ki) :: tngt_stf_difftol !< When comparing tangent stiffness matrix, stop simulation if error greater than this [-] + LOGICAL :: UsePitchAct = .false. !< Whether to use a pitch actuator inside BeamDyn [(flag)] + LOGICAL :: QuasiStaticInit = .false. !< Use quasistatic pre-conditioning with centripetal accelerations in initialization (flag) [dynamic solve and enFAST only] [-] + REAL(R8Ki) :: stop_tol = 0.0_R8Ki !< Tolerance for stopping criterion [-] + REAL(R8Ki) :: tngt_stf_pert = 0.0_R8Ki !< Perturbation size for computing finite differenced tangent stiffness [-] + REAL(R8Ki) :: tngt_stf_difftol = 0.0_R8Ki !< When comparing tangent stiffness matrix, stop simulation if error greater than this [-] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: kp_coordinate !< Key point coordinates array [-] - REAL(R8Ki) :: pitchJ !< Pitch actuator inertia [(kg-m^2)] - REAL(R8Ki) :: pitchK !< Pitch actuator stiffness [(kg-m^2/s^2)] - REAL(R8Ki) :: pitchC !< Pitch actuator damping [-] - LOGICAL :: Echo !< Echo [-] + REAL(R8Ki) :: pitchJ = 0.0_R8Ki !< Pitch actuator inertia [(kg-m^2)] + REAL(R8Ki) :: pitchK = 0.0_R8Ki !< Pitch actuator stiffness [(kg-m^2/s^2)] + REAL(R8Ki) :: pitchC = 0.0_R8Ki !< Pitch actuator damping [-] + LOGICAL :: Echo = .false. !< Echo [-] LOGICAL :: RotStates = .TRUE. !< Orient states in rotating frame during linearization? (flag) [-] LOGICAL :: RelStates = .FALSE. !< Define states relative to root motion during linearization? (flag) [-] - LOGICAL :: tngt_stf_fd !< Flag to compute tangent stifness matrix via finite difference [-] - LOGICAL :: tngt_stf_comp !< Flag to compare finite differenced and analytical tangent stifness [-] - INTEGER(IntKi) :: NNodeOuts !< Number of node outputs [0 - 9] [-] - INTEGER(IntKi) , DIMENSION(1:9) :: OutNd !< Nodes whose values will be output [-] - INTEGER(IntKi) :: NumOuts !< Number of parameters in the output list (number of outputs requested) [-] + LOGICAL :: tngt_stf_fd = .false. !< Flag to compute tangent stifness matrix via finite difference [-] + LOGICAL :: tngt_stf_comp = .false. !< Flag to compare finite differenced and analytical tangent stifness [-] + INTEGER(IntKi) :: NNodeOuts = 0_IntKi !< Number of node outputs [0 - 9] [-] + INTEGER(IntKi) , DIMENSION(1:9) :: OutNd = 0_IntKi !< Nodes whose values will be output [-] + INTEGER(IntKi) :: NumOuts = 0_IntKi !< Number of parameters in the output list (number of outputs requested) [-] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: OutList !< List of user-requested output channels [-] - LOGICAL :: SumPrint !< Print summary data to file? (.sum) [-] + LOGICAL :: SumPrint = .false. !< Print summary data to file? (.sum) [-] CHARACTER(20) :: OutFmt !< Format specifier [-] - INTEGER(IntKi) :: BldNd_NumOuts !< Number of requested output channels per blade node (BD_BldNdOuts) [-] + INTEGER(IntKi) :: BldNd_NumOuts = 0_IntKi !< Number of requested output channels per blade node (BD_BldNdOuts) [-] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: BldNd_OutList !< List of user-requested output channels (BD_BldNdOuts) [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: BldNd_BlOutNd !< The blade nodes to actually output (BD_BldNdOuts) [-] CHARACTER(1024) :: BldNd_BlOutNd_Str !< String to parse for the blade nodes to actually output (BD_BldNdOuts) [-] @@ -132,24 +131,24 @@ MODULE BeamDyn_Types ! ======================= ! ========= BD_DiscreteStateType ======= TYPE, PUBLIC :: BD_DiscreteStateType - REAL(ReKi) :: thetaP !< Pitch angle state [-] - REAL(ReKi) :: thetaPD !< Pitch rate state [-] + REAL(ReKi) :: thetaP = 0.0_ReKi !< Pitch angle state [-] + REAL(ReKi) :: thetaPD = 0.0_ReKi !< Pitch rate state [-] END TYPE BD_DiscreteStateType ! ======================= ! ========= BD_ConstraintStateType ======= TYPE, PUBLIC :: BD_ConstraintStateType - REAL(ReKi) :: DummyConstrState !< A variable, Replace if you have constraint states [-] + REAL(ReKi) :: DummyConstrState = 0.0_ReKi !< A variable, Replace if you have constraint states [-] END TYPE BD_ConstraintStateType ! ======================= ! ========= BD_OtherStateType ======= TYPE, PUBLIC :: BD_OtherStateType REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: acc !< Acceleration (dqdtdt) [-] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: xcc !< Algorithm acceleration in GA2: (1-alpha_m)*xcc_(n+1) = (1-alpha_f)*Acc_(n+1) + alpha_f*Acc_n - alpha_m*xcc_n [-] - LOGICAL :: InitAcc !< flag to determine if accerlerations have been initialized in updateStates [-] - LOGICAL :: RunQuasiStaticInit !< flag to determine if quasi-static solution initialization should be run again (with load inputs) [-] - REAL(R8Ki) , DIMENSION(1:3) :: GlbPos !< Position Vector between origins of Global (moving frame) and blade frames (BD coordinates) Follows the RootMotion mesh [-] - REAL(R8Ki) , DIMENSION(1:3,1:3) :: GlbRot !< Rotation Tensor between Global (moving frame) and Blade frames (BD coordinates; transfers local to global). Follows the RootMotion mesh [-] - REAL(R8Ki) , DIMENSION(1:3) :: Glb_crv !< CRV parameters of GlbRot. Follows the RootMotion mesh [-] + LOGICAL :: InitAcc = .false. !< flag to determine if accerlerations have been initialized in updateStates [-] + LOGICAL :: RunQuasiStaticInit = .false. !< flag to determine if quasi-static solution initialization should be run again (with load inputs) [-] + REAL(R8Ki) , DIMENSION(1:3) :: GlbPos = 0.0_R8Ki !< Position Vector between origins of Global (moving frame) and blade frames (BD coordinates) Follows the RootMotion mesh [-] + REAL(R8Ki) , DIMENSION(1:3,1:3) :: GlbRot = 0.0_R8Ki !< Rotation Tensor between Global (moving frame) and Blade frames (BD coordinates; transfers local to global). Follows the RootMotion mesh [-] + REAL(R8Ki) , DIMENSION(1:3) :: Glb_crv = 0.0_R8Ki !< CRV parameters of GlbRot. Follows the RootMotion mesh [-] END TYPE BD_OtherStateType ! ======================= ! ========= qpParam ======= @@ -160,21 +159,21 @@ MODULE BeamDyn_Types ! ======================= ! ========= BD_ParameterType ======= TYPE, PUBLIC :: BD_ParameterType - REAL(DbKi) :: dt !< module dt [s] - REAL(DbKi) , DIMENSION(1:9) :: coef !< GA2 Coefficient [-] - REAL(DbKi) :: rhoinf !< Numerical Damping Coefficient for GA2 [-] + REAL(DbKi) :: dt = 0.0_R8Ki !< module dt [s] + REAL(DbKi) , DIMENSION(1:9) :: coef = 0.0_R8Ki !< GA2 Coefficient [-] + REAL(DbKi) :: rhoinf = 0.0_R8Ki !< Numerical Damping Coefficient for GA2 [-] REAL(R8Ki) , DIMENSION(:,:,:), ALLOCATABLE :: uuN0 !< Initial Postion Vector of GLL (FE) nodes (index 1=DOF; index 2=FE nodes; index 3=element) [-] REAL(R8Ki) , DIMENSION(:,:,:), ALLOCATABLE :: Stif0_QP !< Sectional Stiffness Properties at quadrature points (6x6xqp) [-] REAL(R8Ki) , DIMENSION(:,:,:), ALLOCATABLE :: Mass0_QP !< Sectional Mass Properties at quadrature points (6x6xqp) [-] - REAL(R8Ki) , DIMENSION(1:3) :: gravity !< Gravitational acceleration -- intertial frame!!! [m/s^2] + REAL(R8Ki) , DIMENSION(1:3) :: gravity = 0.0_R8Ki !< Gravitational acceleration -- intertial frame!!! [m/s^2] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: segment_eta !< Array stored length ratio of each segment w.r.t. member it lies in [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: member_eta !< Array stored length ratio of each member w.r.t. entire blade [-] - REAL(R8Ki) :: blade_length !< Blade Length [-] - REAL(R8Ki) :: blade_mass !< Blade mass [-] - REAL(R8Ki) , DIMENSION(1:3) :: blade_CG !< Blade center of gravity [-] - REAL(R8Ki) , DIMENSION(1:3,1:3) :: blade_IN !< Blade Length [-] - REAL(R8Ki) , DIMENSION(1:6) :: beta !< Damping Coefficient [-] - REAL(R8Ki) :: tol !< Tolerance used in stopping criterion [-] + REAL(R8Ki) :: blade_length = 0.0_R8Ki !< Blade Length [-] + REAL(R8Ki) :: blade_mass = 0.0_R8Ki !< Blade mass [-] + REAL(R8Ki) , DIMENSION(1:3) :: blade_CG = 0.0_R8Ki !< Blade center of gravity [-] + REAL(R8Ki) , DIMENSION(1:3,1:3) :: blade_IN = 0.0_R8Ki !< Blade Length [-] + REAL(R8Ki) , DIMENSION(1:6) :: beta = 0.0_R8Ki !< Damping Coefficient [-] + REAL(R8Ki) :: tol = 0.0_R8Ki !< Tolerance used in stopping criterion [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: QPtN !< Quadrature (QuadPt) point locations in natural frame [-1, 1] [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: QPtWeight !< Weights at each quadrature point (QuadPt) [-] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: Shp !< Shape function matrix (index 1 = FE nodes; index 2=quadrature points) [-] @@ -183,45 +182,45 @@ MODULE BeamDyn_Types REAL(R8Ki) , DIMENSION(:,:,:), ALLOCATABLE :: uu0 !< Initial Disp/Rot value at quadrature point (at T=0) [-] REAL(R8Ki) , DIMENSION(:,:,:), ALLOCATABLE :: rrN0 !< Initial relative rotation array, relative to root (at T=0) (index 1=rot DOF; index 2=FE nodes; index 3=element) [-] REAL(R8Ki) , DIMENSION(:,:,:), ALLOCATABLE :: E10 !< Initial E10 at quadrature point [-] - INTEGER(IntKi) :: nodes_per_elem !< Finite element (GLL) nodes per element [-] + INTEGER(IntKi) :: nodes_per_elem = 0_IntKi !< Finite element (GLL) nodes per element [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: node_elem_idx !< Index to first and last nodes of element in p%node_total sized arrays [-] - INTEGER(IntKi) :: refine !< FE mesh refinement factor for trapezoidal quadrature [-] - INTEGER(IntKi) :: dof_node !< dof per node [-] - INTEGER(IntKi) :: dof_elem !< dof per element [-] - INTEGER(IntKi) :: rot_elem !< rotational dof per element [-] - INTEGER(IntKi) :: elem_total !< Total number of elements [-] - INTEGER(IntKi) :: node_total !< Total number of finite element (GLL) nodes [-] - INTEGER(IntKi) :: dof_total !< Total number of dofs [-] - INTEGER(IntKi) :: nqp !< Number of quadrature points (per element) [-] - INTEGER(IntKi) :: analysis_type !< analysis_type flag [-] - INTEGER(IntKi) :: damp_flag !< damping flag [-] - INTEGER(IntKi) :: ld_retries !< Maximum Number of factored load retries [-] - INTEGER(IntKi) :: niter !< Maximum number of iterations in Newton-Raphson algorithm [-] - INTEGER(IntKi) :: quadrature !< Quadrature method: 1 Gauss 2 Trapezoidal [-] - INTEGER(IntKi) :: n_fact !< Factorization frequency [-] - LOGICAL :: OutInputs !< Determines if we've asked to output the inputs (do we need mesh transfer?) [-] - INTEGER(IntKi) :: NumOuts !< Number of parameters in the output list (number of outputs requested) [-] + INTEGER(IntKi) :: refine = 0_IntKi !< FE mesh refinement factor for trapezoidal quadrature [-] + INTEGER(IntKi) :: dof_node = 0_IntKi !< dof per node [-] + INTEGER(IntKi) :: dof_elem = 0_IntKi !< dof per element [-] + INTEGER(IntKi) :: rot_elem = 0_IntKi !< rotational dof per element [-] + INTEGER(IntKi) :: elem_total = 0_IntKi !< Total number of elements [-] + INTEGER(IntKi) :: node_total = 0_IntKi !< Total number of finite element (GLL) nodes [-] + INTEGER(IntKi) :: dof_total = 0_IntKi !< Total number of dofs [-] + INTEGER(IntKi) :: nqp = 0_IntKi !< Number of quadrature points (per element) [-] + INTEGER(IntKi) :: analysis_type = 0_IntKi !< analysis_type flag [-] + INTEGER(IntKi) :: damp_flag = 0_IntKi !< damping flag [-] + INTEGER(IntKi) :: ld_retries = 0_IntKi !< Maximum Number of factored load retries [-] + INTEGER(IntKi) :: niter = 0_IntKi !< Maximum number of iterations in Newton-Raphson algorithm [-] + INTEGER(IntKi) :: quadrature = 0_IntKi !< Quadrature method: 1 Gauss 2 Trapezoidal [-] + INTEGER(IntKi) :: n_fact = 0_IntKi !< Factorization frequency [-] + LOGICAL :: OutInputs = .false. !< Determines if we've asked to output the inputs (do we need mesh transfer?) [-] + INTEGER(IntKi) :: NumOuts = 0_IntKi !< 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 [-] - INTEGER(IntKi) :: NNodeOuts !< Number of nodes to output data to a file[0 - 9] [-] - INTEGER(IntKi) , DIMENSION(1:9) :: OutNd !< Nodes whose values will be output [-] + INTEGER(IntKi) :: NNodeOuts = 0_IntKi !< Number of nodes to output data to a file[0 - 9] [-] + INTEGER(IntKi) , DIMENSION(1:9) :: OutNd = 0_IntKi !< Nodes whose values will be output [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: NdIndx !< Index into BldMotion mesh (to number the nodes for output without using collocated nodes) [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: NdIndxInverse !< Index from BldMotion mesh to unique nodes (to number the nodes for output without using collocated nodes) [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: OutNd2NdElem !< To go from an output node number to a node/elem pair [-] CHARACTER(20) :: OutFmt !< Format specifier [-] - LOGICAL :: UsePitchAct !< Whether to use a pitch actuator inside BeamDyn [(flag)] - REAL(ReKi) :: pitchJ !< Pitch actuator inertia [(kg-m^2)] - REAL(ReKi) :: pitchK !< Pitch actuator stiffness [(kg-m^2/s^2)] - REAL(ReKi) :: pitchC !< Pitch actuator damping [-] - REAL(ReKi) , DIMENSION(1:2,1:2) :: torqM !< Pitch actuator matrix: (I-hA)^-1 [-] + LOGICAL :: UsePitchAct = .false. !< Whether to use a pitch actuator inside BeamDyn [(flag)] + REAL(ReKi) :: pitchJ = 0.0_ReKi !< Pitch actuator inertia [(kg-m^2)] + REAL(ReKi) :: pitchK = 0.0_ReKi !< Pitch actuator stiffness [(kg-m^2/s^2)] + REAL(ReKi) :: pitchC = 0.0_ReKi !< Pitch actuator damping [-] + REAL(ReKi) , DIMENSION(1:2,1:2) :: torqM = 0.0_ReKi !< Pitch actuator matrix: (I-hA)^-1 [-] TYPE(qpParam) :: qp !< Quadrature point info that does not change during simulation [-] - INTEGER(IntKi) :: qp_indx_offset !< Offset for computing index of the quadrature arrays (gauss skips the first [end-point] node) [-] - INTEGER(IntKi) :: BldMotionNodeLoc !< switch to determine where the nodes on the blade motion mesh should be located 1=FE (GLL) nodes; 2=quadrature nodes; 3=blade input stations [-] - LOGICAL :: tngt_stf_fd !< Flag to compute tangent stifness matrix via finite difference [-] - LOGICAL :: tngt_stf_comp !< Flag to compare finite differenced and analytical tangent stifness [-] - REAL(R8Ki) :: tngt_stf_pert !< Perturbation size for computing finite differenced tangent stiffness [-] - REAL(R8Ki) :: tngt_stf_difftol !< When comparing tangent stiffness matrix, stop simulation if error greater than this [-] - INTEGER(IntKi) :: BldNd_NumOuts !< [BD_BldNdOuts] Number of requested output channels per blade node [-] - INTEGER(IntKi) :: BldNd_TotNumOuts !< [BD_BldNdOuts] Total number of requested output channels of blade node information (equal to BldNd_NumOuts * BldNd_BlOutNd) [-] + INTEGER(IntKi) :: qp_indx_offset = 0_IntKi !< Offset for computing index of the quadrature arrays (gauss skips the first [end-point] node) [-] + INTEGER(IntKi) :: BldMotionNodeLoc = 0_IntKi !< switch to determine where the nodes on the blade motion mesh should be located 1=FE (GLL) nodes; 2=quadrature nodes; 3=blade input stations [-] + LOGICAL :: tngt_stf_fd = .false. !< Flag to compute tangent stifness matrix via finite difference [-] + LOGICAL :: tngt_stf_comp = .false. !< Flag to compare finite differenced and analytical tangent stifness [-] + REAL(R8Ki) :: tngt_stf_pert = 0.0_R8Ki !< Perturbation size for computing finite differenced tangent stiffness [-] + REAL(R8Ki) :: tngt_stf_difftol = 0.0_R8Ki !< When comparing tangent stiffness matrix, stop simulation if error greater than this [-] + INTEGER(IntKi) :: BldNd_NumOuts = 0_IntKi !< [BD_BldNdOuts] Number of requested output channels per blade node [-] + INTEGER(IntKi) :: BldNd_TotNumOuts = 0_IntKi !< [BD_BldNdOuts] Total number of requested output channels of blade node information (equal to BldNd_NumOuts * BldNd_BlOutNd) [-] TYPE(OutParmType) , DIMENSION(:), ALLOCATABLE :: BldNd_OutParam !< [BD_BldNdOuts] Names and units (and other characteristics) of all requested output parameters [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: BldNd_BlOutNd !< [BD_BldNdOuts] The blade nodes to actually output [-] REAL(R8Ki) , DIMENSION(:,:,:,:), ALLOCATABLE :: QPtw_Shp_Shp_Jac !< optimization variable: QPtw_Shp_Shp_Jac(idx_qp,i,j,nelem) = p%Shp(i,idx_qp)*p%Shp(j,idx_qp)*p%QPtWeight(idx_qp)*p%Jacobian(idx_qp,nelem) [-] @@ -232,11 +231,12 @@ MODULE BeamDyn_Types REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: FEweight !< weighting factors for integrating local sectional loads [-] 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:6) :: 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) [-] - LOGICAL :: RelStates !< Define states relative to root motion during linearization? (flag) [-] + REAL(R8Ki) , DIMENSION(1:6) :: dx = 0.0_R8Ki !< vector that determines size of perturbation for x (continuous states) [-] + INTEGER(IntKi) :: Jac_ny = 0_IntKi !< number of outputs in jacobian matrix [-] + INTEGER(IntKi) :: Jac_nx = 0_IntKi !< half the number of continuous states in jacobian matrix [-] + LOGICAL :: RotStates = .false. !< Orient states in rotating frame during linearization? (flag) [-] + LOGICAL :: RelStates = .false. !< Define states relative to root motion during linearization? (flag) [-] + LOGICAL :: CompAeroMaps = .FALSE. !< flag to determine if BeamDyn is computing aero maps (true) or running a normal simulation (false) [-] END TYPE BD_ParameterType ! ======================= ! ========= BD_InputType ======= @@ -251,8 +251,8 @@ MODULE BeamDyn_Types TYPE, PUBLIC :: BD_OutputType TYPE(MeshType) :: ReactionForce !< contains force and moments [-] TYPE(MeshType) :: BldMotion !< Motion (disp,rot,vel, acc) along beam axis [-] - REAL(ReKi) :: RootMxr !< x-component of the root reaction moment expressed in r (used for ServoDyn Bladed DLL Interface) [Nm] - REAL(ReKi) :: RootMyr !< y-component of the root reaction moment expressed in r (used for ServoDyn Bladed DLL Interface) [Nm] + REAL(ReKi) :: RootMxr = 0.0_ReKi !< x-component of the root reaction moment expressed in r (used for ServoDyn Bladed DLL Interface) [Nm] + REAL(ReKi) :: RootMyr = 0.0_ReKi !< y-component of the root reaction moment expressed in r (used for ServoDyn Bladed DLL Interface) [Nm] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: WriteOutput !< Data to be written to an output file: see WriteOutputHdr for names of each variable [see WriteOutputUnt] END TYPE BD_OutputType ! ======================= @@ -297,7 +297,7 @@ MODULE BeamDyn_Types TYPE(MeshType) :: y_BldMotion_at_u !< output motions at input node locations (displacements necessary for mapping loads) [-] TYPE(MeshMapType) :: Map_u_DistrLoad_to_y !< mapping of input loads to output node locations [-] TYPE(MeshMapType) :: Map_y_BldMotion_to_u !< mapping of output motions to input node locations (for load transfer) [-] - INTEGER(IntKi) :: Un_Sum !< unit number of summary file [-] + INTEGER(IntKi) :: Un_Sum = 0_IntKi !< unit number of summary file [-] TYPE(EqMotionQP) :: qp !< Quadrature point calculation info [-] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: lin_A !< A (dXdx) matrix used in linearization (before RotState is applied) [-] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: lin_C !< C (dYdx) matrix used in linearization (before RotState is applied) [-] @@ -334,12560 +334,3059 @@ MODULE BeamDyn_Types END TYPE BD_MiscVarType ! ======================= CONTAINS - SUBROUTINE BD_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(BD_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(BD_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) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BD_CopyInitInput' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInitInputData%InputFile = SrcInitInputData%InputFile - DstInitInputData%RootName = SrcInitInputData%RootName - DstInitInputData%gravity = SrcInitInputData%gravity - DstInitInputData%GlbPos = SrcInitInputData%GlbPos - DstInitInputData%GlbRot = SrcInitInputData%GlbRot - DstInitInputData%RootDisp = SrcInitInputData%RootDisp - DstInitInputData%RootOri = SrcInitInputData%RootOri - DstInitInputData%RootVel = SrcInitInputData%RootVel - DstInitInputData%HubPos = SrcInitInputData%HubPos - DstInitInputData%HubRot = SrcInitInputData%HubRot - DstInitInputData%Linearize = SrcInitInputData%Linearize - DstInitInputData%DynamicSolve = SrcInitInputData%DynamicSolve - END SUBROUTINE BD_CopyInitInput - - SUBROUTINE BD_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(BD_InitInputType), INTENT(INOUT) :: InitInputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BD_DestroyInitInput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE BD_DestroyInitInput - - SUBROUTINE BD_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(BD_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 = 'BD_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 - Re_BufSz = Re_BufSz + SIZE(InData%GlbPos) ! GlbPos - Db_BufSz = Db_BufSz + SIZE(InData%GlbRot) ! GlbRot - Db_BufSz = Db_BufSz + SIZE(InData%RootDisp) ! RootDisp - Db_BufSz = Db_BufSz + SIZE(InData%RootOri) ! RootOri - Re_BufSz = Re_BufSz + SIZE(InData%RootVel) ! RootVel - Re_BufSz = Re_BufSz + SIZE(InData%HubPos) ! HubPos - Db_BufSz = Db_BufSz + SIZE(InData%HubRot) ! HubRot - Int_BufSz = Int_BufSz + 1 ! Linearize - Int_BufSz = Int_BufSz + 1 ! DynamicSolve - 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 - DO i1 = LBOUND(InData%GlbPos,1), UBOUND(InData%GlbPos,1) - ReKiBuf(Re_Xferred) = InData%GlbPos(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i2 = LBOUND(InData%GlbRot,2), UBOUND(InData%GlbRot,2) - DO i1 = LBOUND(InData%GlbRot,1), UBOUND(InData%GlbRot,1) - DbKiBuf(Db_Xferred) = InData%GlbRot(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - DO i1 = LBOUND(InData%RootDisp,1), UBOUND(InData%RootDisp,1) - DbKiBuf(Db_Xferred) = InData%RootDisp(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i2 = LBOUND(InData%RootOri,2), UBOUND(InData%RootOri,2) - DO i1 = LBOUND(InData%RootOri,1), UBOUND(InData%RootOri,1) - DbKiBuf(Db_Xferred) = InData%RootOri(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - DO i1 = LBOUND(InData%RootVel,1), UBOUND(InData%RootVel,1) - ReKiBuf(Re_Xferred) = InData%RootVel(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%HubPos,1), UBOUND(InData%HubPos,1) - ReKiBuf(Re_Xferred) = InData%HubPos(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i2 = LBOUND(InData%HubRot,2), UBOUND(InData%HubRot,2) - DO i1 = LBOUND(InData%HubRot,1), UBOUND(InData%HubRot,1) - DbKiBuf(Db_Xferred) = InData%HubRot(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - IntKiBuf(Int_Xferred) = TRANSFER(InData%Linearize, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%DynamicSolve, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE BD_PackInitInput - - SUBROUTINE BD_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(BD_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) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BD_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 - i1_l = LBOUND(OutData%GlbPos,1) - i1_u = UBOUND(OutData%GlbPos,1) - DO i1 = LBOUND(OutData%GlbPos,1), UBOUND(OutData%GlbPos,1) - OutData%GlbPos(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%GlbRot,1) - i1_u = UBOUND(OutData%GlbRot,1) - i2_l = LBOUND(OutData%GlbRot,2) - i2_u = UBOUND(OutData%GlbRot,2) - DO i2 = LBOUND(OutData%GlbRot,2), UBOUND(OutData%GlbRot,2) - DO i1 = LBOUND(OutData%GlbRot,1), UBOUND(OutData%GlbRot,1) - OutData%GlbRot(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%RootDisp,1) - i1_u = UBOUND(OutData%RootDisp,1) - DO i1 = LBOUND(OutData%RootDisp,1), UBOUND(OutData%RootDisp,1) - OutData%RootDisp(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%RootOri,1) - i1_u = UBOUND(OutData%RootOri,1) - i2_l = LBOUND(OutData%RootOri,2) - i2_u = UBOUND(OutData%RootOri,2) - DO i2 = LBOUND(OutData%RootOri,2), UBOUND(OutData%RootOri,2) - DO i1 = LBOUND(OutData%RootOri,1), UBOUND(OutData%RootOri,1) - OutData%RootOri(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%RootVel,1) - i1_u = UBOUND(OutData%RootVel,1) - DO i1 = LBOUND(OutData%RootVel,1), UBOUND(OutData%RootVel,1) - OutData%RootVel(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%HubPos,1) - i1_u = UBOUND(OutData%HubPos,1) - DO i1 = LBOUND(OutData%HubPos,1), UBOUND(OutData%HubPos,1) - OutData%HubPos(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%HubRot,1) - i1_u = UBOUND(OutData%HubRot,1) - i2_l = LBOUND(OutData%HubRot,2) - i2_u = UBOUND(OutData%HubRot,2) - DO i2 = LBOUND(OutData%HubRot,2), UBOUND(OutData%HubRot,2) - DO i1 = LBOUND(OutData%HubRot,1), UBOUND(OutData%HubRot,1) - OutData%HubRot(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - OutData%Linearize = TRANSFER(IntKiBuf(Int_Xferred), OutData%Linearize) - Int_Xferred = Int_Xferred + 1 - OutData%DynamicSolve = TRANSFER(IntKiBuf(Int_Xferred), OutData%DynamicSolve) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE BD_UnPackInitInput - - SUBROUTINE BD_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(BD_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(BD_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) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BD_CopyInitOutput' -! +subroutine BD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) + type(BD_InitInputType), intent(in) :: SrcInitInputData + type(BD_InitInputType), intent(inout) :: DstInitInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'BD_CopyInitInput' 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%kp_coordinate)) THEN - i1_l = LBOUND(SrcInitOutputData%kp_coordinate,1) - i1_u = UBOUND(SrcInitOutputData%kp_coordinate,1) - i2_l = LBOUND(SrcInitOutputData%kp_coordinate,2) - i2_u = UBOUND(SrcInitOutputData%kp_coordinate,2) - IF (.NOT. ALLOCATED(DstInitOutputData%kp_coordinate)) THEN - ALLOCATE(DstInitOutputData%kp_coordinate(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%kp_coordinate.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%kp_coordinate = SrcInitOutputData%kp_coordinate -ENDIF - DstInitOutputData%kp_total = SrcInitOutputData%kp_total -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 BD_CopyInitOutput - - SUBROUTINE BD_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(BD_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BD_DestroyInitOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(InitOutputData%WriteOutputHdr)) THEN - DEALLOCATE(InitOutputData%WriteOutputHdr) -ENDIF -IF (ALLOCATED(InitOutputData%WriteOutputUnt)) THEN - DEALLOCATE(InitOutputData%WriteOutputUnt) -ENDIF - CALL NWTC_Library_Destroyprogdesc( InitOutputData%Ver, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(InitOutputData%kp_coordinate)) THEN - DEALLOCATE(InitOutputData%kp_coordinate) -ENDIF -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 BD_DestroyInitOutput - - SUBROUTINE BD_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(BD_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 = 'BD_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 ! kp_coordinate allocated yes/no - IF ( ALLOCATED(InData%kp_coordinate) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! kp_coordinate upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%kp_coordinate) ! kp_coordinate - END IF - Int_BufSz = Int_BufSz + 1 ! kp_total - 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%kp_coordinate) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%kp_coordinate,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%kp_coordinate,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%kp_coordinate,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%kp_coordinate,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%kp_coordinate,2), UBOUND(InData%kp_coordinate,2) - DO i1 = LBOUND(InData%kp_coordinate,1), UBOUND(InData%kp_coordinate,1) - DbKiBuf(Db_Xferred) = InData%kp_coordinate(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%kp_total - 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_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 BD_PackInitOutput - - SUBROUTINE BD_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(BD_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) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BD_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 ! kp_coordinate not allocated - Int_Xferred = Int_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%kp_coordinate)) DEALLOCATE(OutData%kp_coordinate) - ALLOCATE(OutData%kp_coordinate(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%kp_coordinate.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%kp_coordinate,2), UBOUND(OutData%kp_coordinate,2) - DO i1 = LBOUND(OutData%kp_coordinate,1), UBOUND(OutData%kp_coordinate,1) - OutData%kp_coordinate(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - OutData%kp_total = IntKiBuf(Int_Xferred) - 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_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 BD_UnPackInitOutput - - SUBROUTINE BD_CopyBladeInputData( SrcBladeInputDataData, DstBladeInputDataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(BladeInputData), INTENT(IN) :: SrcBladeInputDataData - TYPE(BladeInputData), INTENT(INOUT) :: DstBladeInputDataData - 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 = 'BD_CopyBladeInputData' -! + ErrMsg = '' + DstInitInputData%InputFile = SrcInitInputData%InputFile + DstInitInputData%RootName = SrcInitInputData%RootName + DstInitInputData%gravity = SrcInitInputData%gravity + DstInitInputData%GlbPos = SrcInitInputData%GlbPos + DstInitInputData%GlbRot = SrcInitInputData%GlbRot + DstInitInputData%RootDisp = SrcInitInputData%RootDisp + DstInitInputData%RootOri = SrcInitInputData%RootOri + DstInitInputData%RootVel = SrcInitInputData%RootVel + DstInitInputData%HubPos = SrcInitInputData%HubPos + DstInitInputData%HubRot = SrcInitInputData%HubRot + DstInitInputData%Linearize = SrcInitInputData%Linearize + DstInitInputData%DynamicSolve = SrcInitInputData%DynamicSolve + DstInitInputData%CompAeroMaps = SrcInitInputData%CompAeroMaps +end subroutine + +subroutine BD_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(BD_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'BD_DestroyInitInput' ErrStat = ErrID_None - ErrMsg = "" - DstBladeInputDataData%station_total = SrcBladeInputDataData%station_total - DstBladeInputDataData%format_index = SrcBladeInputDataData%format_index -IF (ALLOCATED(SrcBladeInputDataData%station_eta)) THEN - i1_l = LBOUND(SrcBladeInputDataData%station_eta,1) - i1_u = UBOUND(SrcBladeInputDataData%station_eta,1) - IF (.NOT. ALLOCATED(DstBladeInputDataData%station_eta)) THEN - ALLOCATE(DstBladeInputDataData%station_eta(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladeInputDataData%station_eta.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladeInputDataData%station_eta = SrcBladeInputDataData%station_eta -ENDIF -IF (ALLOCATED(SrcBladeInputDataData%stiff0)) THEN - i1_l = LBOUND(SrcBladeInputDataData%stiff0,1) - i1_u = UBOUND(SrcBladeInputDataData%stiff0,1) - i2_l = LBOUND(SrcBladeInputDataData%stiff0,2) - i2_u = UBOUND(SrcBladeInputDataData%stiff0,2) - i3_l = LBOUND(SrcBladeInputDataData%stiff0,3) - i3_u = UBOUND(SrcBladeInputDataData%stiff0,3) - IF (.NOT. ALLOCATED(DstBladeInputDataData%stiff0)) THEN - ALLOCATE(DstBladeInputDataData%stiff0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladeInputDataData%stiff0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladeInputDataData%stiff0 = SrcBladeInputDataData%stiff0 -ENDIF -IF (ALLOCATED(SrcBladeInputDataData%mass0)) THEN - i1_l = LBOUND(SrcBladeInputDataData%mass0,1) - i1_u = UBOUND(SrcBladeInputDataData%mass0,1) - i2_l = LBOUND(SrcBladeInputDataData%mass0,2) - i2_u = UBOUND(SrcBladeInputDataData%mass0,2) - i3_l = LBOUND(SrcBladeInputDataData%mass0,3) - i3_u = UBOUND(SrcBladeInputDataData%mass0,3) - IF (.NOT. ALLOCATED(DstBladeInputDataData%mass0)) THEN - ALLOCATE(DstBladeInputDataData%mass0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladeInputDataData%mass0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladeInputDataData%mass0 = SrcBladeInputDataData%mass0 -ENDIF - DstBladeInputDataData%beta = SrcBladeInputDataData%beta - DstBladeInputDataData%damp_flag = SrcBladeInputDataData%damp_flag - END SUBROUTINE BD_CopyBladeInputData - - SUBROUTINE BD_DestroyBladeInputData( BladeInputDataData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(BladeInputData), INTENT(INOUT) :: BladeInputDataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BD_DestroyBladeInputData' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(BladeInputDataData%station_eta)) THEN - DEALLOCATE(BladeInputDataData%station_eta) -ENDIF -IF (ALLOCATED(BladeInputDataData%stiff0)) THEN - DEALLOCATE(BladeInputDataData%stiff0) -ENDIF -IF (ALLOCATED(BladeInputDataData%mass0)) THEN - DEALLOCATE(BladeInputDataData%mass0) -ENDIF - END SUBROUTINE BD_DestroyBladeInputData - - SUBROUTINE BD_PackBladeInputData( 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(BladeInputData), 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 = 'BD_PackBladeInputData' - ! 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 ! station_total - Int_BufSz = Int_BufSz + 1 ! format_index - Int_BufSz = Int_BufSz + 1 ! station_eta allocated yes/no - IF ( ALLOCATED(InData%station_eta) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! station_eta upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%station_eta) ! station_eta - END IF - Int_BufSz = Int_BufSz + 1 ! stiff0 allocated yes/no - IF ( ALLOCATED(InData%stiff0) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! stiff0 upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%stiff0) ! stiff0 - END IF - Int_BufSz = Int_BufSz + 1 ! mass0 allocated yes/no - IF ( ALLOCATED(InData%mass0) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! mass0 upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%mass0) ! mass0 - END IF - Db_BufSz = Db_BufSz + SIZE(InData%beta) ! beta - Int_BufSz = Int_BufSz + 1 ! damp_flag - 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%station_total - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%format_index - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%station_eta) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%station_eta,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%station_eta,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%station_eta,1), UBOUND(InData%station_eta,1) - DbKiBuf(Db_Xferred) = InData%station_eta(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%stiff0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%stiff0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%stiff0,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%stiff0,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%stiff0,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%stiff0,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%stiff0,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%stiff0,3), UBOUND(InData%stiff0,3) - DO i2 = LBOUND(InData%stiff0,2), UBOUND(InData%stiff0,2) - DO i1 = LBOUND(InData%stiff0,1), UBOUND(InData%stiff0,1) - DbKiBuf(Db_Xferred) = InData%stiff0(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%mass0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%mass0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%mass0,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%mass0,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%mass0,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%mass0,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%mass0,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%mass0,3), UBOUND(InData%mass0,3) - DO i2 = LBOUND(InData%mass0,2), UBOUND(InData%mass0,2) - DO i1 = LBOUND(InData%mass0,1), UBOUND(InData%mass0,1) - DbKiBuf(Db_Xferred) = InData%mass0(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - DO i1 = LBOUND(InData%beta,1), UBOUND(InData%beta,1) - DbKiBuf(Db_Xferred) = InData%beta(i1) - Db_Xferred = Db_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%damp_flag - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE BD_PackBladeInputData - - SUBROUTINE BD_UnPackBladeInputData( 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(BladeInputData), 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 = 'BD_UnPackBladeInputData' - ! 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%station_total = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%format_index = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! station_eta not allocated - Int_Xferred = Int_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%station_eta)) DEALLOCATE(OutData%station_eta) - ALLOCATE(OutData%station_eta(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%station_eta.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%station_eta,1), UBOUND(OutData%station_eta,1) - OutData%station_eta(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! stiff0 not allocated - Int_Xferred = Int_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%stiff0)) DEALLOCATE(OutData%stiff0) - ALLOCATE(OutData%stiff0(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%stiff0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%stiff0,3), UBOUND(OutData%stiff0,3) - DO i2 = LBOUND(OutData%stiff0,2), UBOUND(OutData%stiff0,2) - DO i1 = LBOUND(OutData%stiff0,1), UBOUND(OutData%stiff0,1) - OutData%stiff0(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! mass0 not allocated - Int_Xferred = Int_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%mass0)) DEALLOCATE(OutData%mass0) - ALLOCATE(OutData%mass0(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%mass0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%mass0,3), UBOUND(OutData%mass0,3) - DO i2 = LBOUND(OutData%mass0,2), UBOUND(OutData%mass0,2) - DO i1 = LBOUND(OutData%mass0,1), UBOUND(OutData%mass0,1) - OutData%mass0(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - i1_l = LBOUND(OutData%beta,1) - i1_u = UBOUND(OutData%beta,1) - DO i1 = LBOUND(OutData%beta,1), UBOUND(OutData%beta,1) - OutData%beta(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - OutData%damp_flag = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE BD_UnPackBladeInputData - - SUBROUTINE BD_CopyInputFile( SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg ) - TYPE(BD_InputFile), INTENT(IN) :: SrcInputFileData - TYPE(BD_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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BD_CopyInputFile' -! + ErrMsg = '' +end subroutine + +subroutine BD_PackInitInput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(BD_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'BD_PackInitInput' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%InputFile) + call RegPack(RF, InData%RootName) + call RegPack(RF, InData%gravity) + call RegPack(RF, InData%GlbPos) + call RegPack(RF, InData%GlbRot) + call RegPack(RF, InData%RootDisp) + call RegPack(RF, InData%RootOri) + call RegPack(RF, InData%RootVel) + call RegPack(RF, InData%HubPos) + call RegPack(RF, InData%HubRot) + call RegPack(RF, InData%Linearize) + call RegPack(RF, InData%DynamicSolve) + call RegPack(RF, InData%CompAeroMaps) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine BD_UnPackInitInput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(BD_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'BD_UnPackInitInput' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%InputFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RootName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%gravity); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GlbPos); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GlbRot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RootDisp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RootOri); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RootVel); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HubPos); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HubRot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Linearize); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DynamicSolve); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CompAeroMaps); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine BD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) + type(BD_InitOutputType), intent(in) :: SrcInitOutputData + type(BD_InitOutputType), intent(inout) :: DstInitOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'BD_CopyInitOutput' ErrStat = ErrID_None - ErrMsg = "" - DstInputFileData%member_total = SrcInputFileData%member_total - DstInputFileData%kp_total = SrcInputFileData%kp_total -IF (ALLOCATED(SrcInputFileData%kp_member)) THEN - i1_l = LBOUND(SrcInputFileData%kp_member,1) - i1_u = UBOUND(SrcInputFileData%kp_member,1) - IF (.NOT. ALLOCATED(DstInputFileData%kp_member)) THEN - ALLOCATE(DstInputFileData%kp_member(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%kp_member.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%kp_member = SrcInputFileData%kp_member -ENDIF - DstInputFileData%order_elem = SrcInputFileData%order_elem - DstInputFileData%load_retries = SrcInputFileData%load_retries - DstInputFileData%NRMax = SrcInputFileData%NRMax - DstInputFileData%quadrature = SrcInputFileData%quadrature - DstInputFileData%n_fact = SrcInputFileData%n_fact - DstInputFileData%refine = SrcInputFileData%refine - DstInputFileData%rhoinf = SrcInputFileData%rhoinf - DstInputFileData%DTBeam = SrcInputFileData%DTBeam - CALL BD_Copybladeinputdata( SrcInputFileData%InpBl, DstInputFileData%InpBl, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstInputFileData%BldFile = SrcInputFileData%BldFile - DstInputFileData%UsePitchAct = SrcInputFileData%UsePitchAct - DstInputFileData%QuasiStaticInit = SrcInputFileData%QuasiStaticInit - DstInputFileData%stop_tol = SrcInputFileData%stop_tol - DstInputFileData%tngt_stf_pert = SrcInputFileData%tngt_stf_pert - DstInputFileData%tngt_stf_difftol = SrcInputFileData%tngt_stf_difftol -IF (ALLOCATED(SrcInputFileData%kp_coordinate)) THEN - i1_l = LBOUND(SrcInputFileData%kp_coordinate,1) - i1_u = UBOUND(SrcInputFileData%kp_coordinate,1) - i2_l = LBOUND(SrcInputFileData%kp_coordinate,2) - i2_u = UBOUND(SrcInputFileData%kp_coordinate,2) - IF (.NOT. ALLOCATED(DstInputFileData%kp_coordinate)) THEN - ALLOCATE(DstInputFileData%kp_coordinate(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%kp_coordinate.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%kp_coordinate = SrcInputFileData%kp_coordinate -ENDIF - DstInputFileData%pitchJ = SrcInputFileData%pitchJ - DstInputFileData%pitchK = SrcInputFileData%pitchK - DstInputFileData%pitchC = SrcInputFileData%pitchC - DstInputFileData%Echo = SrcInputFileData%Echo - DstInputFileData%RotStates = SrcInputFileData%RotStates - DstInputFileData%RelStates = SrcInputFileData%RelStates - DstInputFileData%tngt_stf_fd = SrcInputFileData%tngt_stf_fd - DstInputFileData%tngt_stf_comp = SrcInputFileData%tngt_stf_comp - DstInputFileData%NNodeOuts = SrcInputFileData%NNodeOuts - DstInputFileData%OutNd = SrcInputFileData%OutNd - 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%SumPrint = SrcInputFileData%SumPrint - DstInputFileData%OutFmt = SrcInputFileData%OutFmt - DstInputFileData%BldNd_NumOuts = SrcInputFileData%BldNd_NumOuts -IF (ALLOCATED(SrcInputFileData%BldNd_OutList)) THEN - i1_l = LBOUND(SrcInputFileData%BldNd_OutList,1) - i1_u = UBOUND(SrcInputFileData%BldNd_OutList,1) - IF (.NOT. ALLOCATED(DstInputFileData%BldNd_OutList)) THEN - ALLOCATE(DstInputFileData%BldNd_OutList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%BldNd_OutList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%BldNd_OutList = SrcInputFileData%BldNd_OutList -ENDIF -IF (ALLOCATED(SrcInputFileData%BldNd_BlOutNd)) THEN - i1_l = LBOUND(SrcInputFileData%BldNd_BlOutNd,1) - i1_u = UBOUND(SrcInputFileData%BldNd_BlOutNd,1) - IF (.NOT. ALLOCATED(DstInputFileData%BldNd_BlOutNd)) THEN - ALLOCATE(DstInputFileData%BldNd_BlOutNd(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%BldNd_BlOutNd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%BldNd_BlOutNd = SrcInputFileData%BldNd_BlOutNd -ENDIF - DstInputFileData%BldNd_BlOutNd_Str = SrcInputFileData%BldNd_BlOutNd_Str - END SUBROUTINE BD_CopyInputFile - - SUBROUTINE BD_DestroyInputFile( InputFileData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(BD_InputFile), INTENT(INOUT) :: InputFileData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BD_DestroyInputFile' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(InputFileData%kp_member)) THEN - DEALLOCATE(InputFileData%kp_member) -ENDIF - CALL BD_Destroybladeinputdata( InputFileData%InpBl, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(InputFileData%kp_coordinate)) THEN - DEALLOCATE(InputFileData%kp_coordinate) -ENDIF -IF (ALLOCATED(InputFileData%OutList)) THEN - DEALLOCATE(InputFileData%OutList) -ENDIF -IF (ALLOCATED(InputFileData%BldNd_OutList)) THEN - DEALLOCATE(InputFileData%BldNd_OutList) -ENDIF -IF (ALLOCATED(InputFileData%BldNd_BlOutNd)) THEN - DEALLOCATE(InputFileData%BldNd_BlOutNd) -ENDIF - END SUBROUTINE BD_DestroyInputFile - - SUBROUTINE BD_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(BD_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 = 'BD_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 ! member_total - Int_BufSz = Int_BufSz + 1 ! kp_total - Int_BufSz = Int_BufSz + 1 ! kp_member allocated yes/no - IF ( ALLOCATED(InData%kp_member) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! kp_member upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%kp_member) ! kp_member - END IF - Int_BufSz = Int_BufSz + 1 ! order_elem - Int_BufSz = Int_BufSz + 1 ! load_retries - Int_BufSz = Int_BufSz + 1 ! NRMax - Int_BufSz = Int_BufSz + 1 ! quadrature - Int_BufSz = Int_BufSz + 1 ! n_fact - Int_BufSz = Int_BufSz + 1 ! refine - Db_BufSz = Db_BufSz + 1 ! rhoinf - Db_BufSz = Db_BufSz + 1 ! DTBeam - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! InpBl: size of buffers for each call to pack subtype - CALL BD_Packbladeinputdata( Re_Buf, Db_Buf, Int_Buf, InData%InpBl, ErrStat2, ErrMsg2, .TRUE. ) ! InpBl - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! InpBl - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! InpBl - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! InpBl - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1*LEN(InData%BldFile) ! BldFile - Int_BufSz = Int_BufSz + 1 ! UsePitchAct - Int_BufSz = Int_BufSz + 1 ! QuasiStaticInit - Db_BufSz = Db_BufSz + 1 ! stop_tol - Db_BufSz = Db_BufSz + 1 ! tngt_stf_pert - Db_BufSz = Db_BufSz + 1 ! tngt_stf_difftol - Int_BufSz = Int_BufSz + 1 ! kp_coordinate allocated yes/no - IF ( ALLOCATED(InData%kp_coordinate) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! kp_coordinate upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%kp_coordinate) ! kp_coordinate - END IF - Db_BufSz = Db_BufSz + 1 ! pitchJ - Db_BufSz = Db_BufSz + 1 ! pitchK - Db_BufSz = Db_BufSz + 1 ! pitchC - Int_BufSz = Int_BufSz + 1 ! Echo - Int_BufSz = Int_BufSz + 1 ! RotStates - Int_BufSz = Int_BufSz + 1 ! RelStates - Int_BufSz = Int_BufSz + 1 ! tngt_stf_fd - Int_BufSz = Int_BufSz + 1 ! tngt_stf_comp - Int_BufSz = Int_BufSz + 1 ! NNodeOuts - Int_BufSz = Int_BufSz + SIZE(InData%OutNd) ! OutNd - 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 ! SumPrint - Int_BufSz = Int_BufSz + 1*LEN(InData%OutFmt) ! OutFmt - Int_BufSz = Int_BufSz + 1 ! BldNd_NumOuts - Int_BufSz = Int_BufSz + 1 ! BldNd_OutList allocated yes/no - IF ( ALLOCATED(InData%BldNd_OutList) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BldNd_OutList upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%BldNd_OutList)*LEN(InData%BldNd_OutList) ! BldNd_OutList - END IF - Int_BufSz = Int_BufSz + 1 ! BldNd_BlOutNd allocated yes/no - IF ( ALLOCATED(InData%BldNd_BlOutNd) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BldNd_BlOutNd upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%BldNd_BlOutNd) ! BldNd_BlOutNd - END IF - Int_BufSz = Int_BufSz + 1*LEN(InData%BldNd_BlOutNd_Str) ! BldNd_BlOutNd_Str - 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%member_total - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%kp_total - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%kp_member) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%kp_member,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%kp_member,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%kp_member,1), UBOUND(InData%kp_member,1) - IntKiBuf(Int_Xferred) = InData%kp_member(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%order_elem - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%load_retries - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NRMax - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%quadrature - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%n_fact - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%refine - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%rhoinf - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%DTBeam - Db_Xferred = Db_Xferred + 1 - CALL BD_Packbladeinputdata( Re_Buf, Db_Buf, Int_Buf, InData%InpBl, ErrStat2, ErrMsg2, OnlySize ) ! InpBl - 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%BldFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%BldFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = TRANSFER(InData%UsePitchAct, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%QuasiStaticInit, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%stop_tol - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%tngt_stf_pert - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%tngt_stf_difftol - Db_Xferred = Db_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%kp_coordinate) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%kp_coordinate,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%kp_coordinate,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%kp_coordinate,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%kp_coordinate,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%kp_coordinate,2), UBOUND(InData%kp_coordinate,2) - DO i1 = LBOUND(InData%kp_coordinate,1), UBOUND(InData%kp_coordinate,1) - DbKiBuf(Db_Xferred) = InData%kp_coordinate(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - DbKiBuf(Db_Xferred) = InData%pitchJ - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%pitchK - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%pitchC - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%Echo, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%RotStates, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%RelStates, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%tngt_stf_fd, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%tngt_stf_comp, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NNodeOuts - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%OutNd,1), UBOUND(InData%OutNd,1) - IntKiBuf(Int_Xferred) = InData%OutNd(i1) - Int_Xferred = Int_Xferred + 1 - END DO - 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 - IntKiBuf(Int_Xferred) = TRANSFER(InData%SumPrint, 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 - IntKiBuf(Int_Xferred) = InData%BldNd_NumOuts - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%BldNd_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%BldNd_OutList,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldNd_OutList,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BldNd_OutList,1), UBOUND(InData%BldNd_OutList,1) - DO I = 1, LEN(InData%BldNd_OutList) - IntKiBuf(Int_Xferred) = ICHAR(InData%BldNd_OutList(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BldNd_BlOutNd) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BldNd_BlOutNd,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldNd_BlOutNd,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BldNd_BlOutNd,1), UBOUND(InData%BldNd_BlOutNd,1) - IntKiBuf(Int_Xferred) = InData%BldNd_BlOutNd(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - DO I = 1, LEN(InData%BldNd_BlOutNd_Str) - IntKiBuf(Int_Xferred) = ICHAR(InData%BldNd_BlOutNd_Str(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END SUBROUTINE BD_PackInputFile - - SUBROUTINE BD_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(BD_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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BD_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%member_total = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%kp_total = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! kp_member not allocated - Int_Xferred = Int_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%kp_member)) DEALLOCATE(OutData%kp_member) - ALLOCATE(OutData%kp_member(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%kp_member.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%kp_member,1), UBOUND(OutData%kp_member,1) - OutData%kp_member(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - OutData%order_elem = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%load_retries = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NRMax = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%quadrature = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%n_fact = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%refine = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%rhoinf = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%DTBeam = 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 BD_Unpackbladeinputdata( Re_Buf, Db_Buf, Int_Buf, OutData%InpBl, ErrStat2, ErrMsg2 ) ! InpBl - 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%BldFile) - OutData%BldFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%UsePitchAct = TRANSFER(IntKiBuf(Int_Xferred), OutData%UsePitchAct) - Int_Xferred = Int_Xferred + 1 - OutData%QuasiStaticInit = TRANSFER(IntKiBuf(Int_Xferred), OutData%QuasiStaticInit) - Int_Xferred = Int_Xferred + 1 - OutData%stop_tol = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%tngt_stf_pert = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%tngt_stf_difftol = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! kp_coordinate not allocated - Int_Xferred = Int_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%kp_coordinate)) DEALLOCATE(OutData%kp_coordinate) - ALLOCATE(OutData%kp_coordinate(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%kp_coordinate.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%kp_coordinate,2), UBOUND(OutData%kp_coordinate,2) - DO i1 = LBOUND(OutData%kp_coordinate,1), UBOUND(OutData%kp_coordinate,1) - OutData%kp_coordinate(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - OutData%pitchJ = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%pitchK = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%pitchC = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%Echo = TRANSFER(IntKiBuf(Int_Xferred), OutData%Echo) - Int_Xferred = Int_Xferred + 1 - OutData%RotStates = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotStates) - Int_Xferred = Int_Xferred + 1 - OutData%RelStates = TRANSFER(IntKiBuf(Int_Xferred), OutData%RelStates) - Int_Xferred = Int_Xferred + 1 - OutData%tngt_stf_fd = TRANSFER(IntKiBuf(Int_Xferred), OutData%tngt_stf_fd) - Int_Xferred = Int_Xferred + 1 - OutData%tngt_stf_comp = TRANSFER(IntKiBuf(Int_Xferred), OutData%tngt_stf_comp) - Int_Xferred = Int_Xferred + 1 - OutData%NNodeOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%OutNd,1) - i1_u = UBOUND(OutData%OutNd,1) - DO i1 = LBOUND(OutData%OutNd,1), UBOUND(OutData%OutNd,1) - OutData%OutNd(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - 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 - OutData%SumPrint = TRANSFER(IntKiBuf(Int_Xferred), OutData%SumPrint) - 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%BldNd_NumOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldNd_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%BldNd_OutList)) DEALLOCATE(OutData%BldNd_OutList) - ALLOCATE(OutData%BldNd_OutList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldNd_OutList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BldNd_OutList,1), UBOUND(OutData%BldNd_OutList,1) - DO I = 1, LEN(OutData%BldNd_OutList) - OutData%BldNd_OutList(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 ! BldNd_BlOutNd not allocated - Int_Xferred = Int_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%BldNd_BlOutNd)) DEALLOCATE(OutData%BldNd_BlOutNd) - ALLOCATE(OutData%BldNd_BlOutNd(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldNd_BlOutNd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BldNd_BlOutNd,1), UBOUND(OutData%BldNd_BlOutNd,1) - OutData%BldNd_BlOutNd(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - DO I = 1, LEN(OutData%BldNd_BlOutNd_Str) - OutData%BldNd_BlOutNd_Str(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END SUBROUTINE BD_UnPackInputFile - - SUBROUTINE BD_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(BD_ContinuousStateType), INTENT(IN) :: SrcContStateData - TYPE(BD_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 = 'BD_CopyContState' -! + ErrMsg = '' + if (allocated(SrcInitOutputData%WriteOutputHdr)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) + if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then + allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitOutputData%WriteOutputUnt)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) + if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then + allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), 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 + end if + 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 + LB(1:1) = lbound(SrcInitOutputData%LinNames_y) + UB(1:1) = ubound(SrcInitOutputData%LinNames_y) + if (.not. allocated(DstInitOutputData%LinNames_y)) then + allocate(DstInitOutputData%LinNames_y(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitOutputData%LinNames_x)) then + LB(1:1) = lbound(SrcInitOutputData%LinNames_x) + UB(1:1) = ubound(SrcInitOutputData%LinNames_x) + if (.not. allocated(DstInitOutputData%LinNames_x)) then + allocate(DstInitOutputData%LinNames_x(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitOutputData%LinNames_u)) then + LB(1:1) = lbound(SrcInitOutputData%LinNames_u) + UB(1:1) = ubound(SrcInitOutputData%LinNames_u) + if (.not. allocated(DstInitOutputData%LinNames_u)) then + allocate(DstInitOutputData%LinNames_u(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitOutputData%RotFrame_y)) then + LB(1:1) = lbound(SrcInitOutputData%RotFrame_y) + UB(1:1) = ubound(SrcInitOutputData%RotFrame_y) + if (.not. allocated(DstInitOutputData%RotFrame_y)) then + allocate(DstInitOutputData%RotFrame_y(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitOutputData%RotFrame_x)) then + LB(1:1) = lbound(SrcInitOutputData%RotFrame_x) + UB(1:1) = ubound(SrcInitOutputData%RotFrame_x) + if (.not. allocated(DstInitOutputData%RotFrame_x)) then + allocate(DstInitOutputData%RotFrame_x(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitOutputData%RotFrame_u)) then + LB(1:1) = lbound(SrcInitOutputData%RotFrame_u) + UB(1:1) = ubound(SrcInitOutputData%RotFrame_u) + if (.not. allocated(DstInitOutputData%RotFrame_u)) then + allocate(DstInitOutputData%RotFrame_u(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitOutputData%IsLoad_u)) then + LB(1:1) = lbound(SrcInitOutputData%IsLoad_u) + UB(1:1) = ubound(SrcInitOutputData%IsLoad_u) + if (.not. allocated(DstInitOutputData%IsLoad_u)) then + allocate(DstInitOutputData%IsLoad_u(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitOutputData%DerivOrder_x)) then + LB(1:1) = lbound(SrcInitOutputData%DerivOrder_x) + UB(1:1) = ubound(SrcInitOutputData%DerivOrder_x) + if (.not. allocated(DstInitOutputData%DerivOrder_x)) then + allocate(DstInitOutputData%DerivOrder_x(LB(1):UB(1)), 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 + end if +end subroutine + +subroutine BD_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(BD_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'BD_DestroyInitOutput' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcContStateData%q)) THEN - i1_l = LBOUND(SrcContStateData%q,1) - i1_u = UBOUND(SrcContStateData%q,1) - i2_l = LBOUND(SrcContStateData%q,2) - i2_u = UBOUND(SrcContStateData%q,2) - IF (.NOT. ALLOCATED(DstContStateData%q)) THEN - ALLOCATE(DstContStateData%q(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%q.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstContStateData%q = SrcContStateData%q -ENDIF -IF (ALLOCATED(SrcContStateData%dqdt)) THEN - i1_l = LBOUND(SrcContStateData%dqdt,1) - i1_u = UBOUND(SrcContStateData%dqdt,1) - i2_l = LBOUND(SrcContStateData%dqdt,2) - i2_u = UBOUND(SrcContStateData%dqdt,2) - IF (.NOT. ALLOCATED(DstContStateData%dqdt)) THEN - ALLOCATE(DstContStateData%dqdt(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%dqdt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstContStateData%dqdt = SrcContStateData%dqdt -ENDIF - END SUBROUTINE BD_CopyContState - - SUBROUTINE BD_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(BD_ContinuousStateType), INTENT(INOUT) :: ContStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BD_DestroyContState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(ContStateData%q)) THEN - DEALLOCATE(ContStateData%q) -ENDIF -IF (ALLOCATED(ContStateData%dqdt)) THEN - DEALLOCATE(ContStateData%dqdt) -ENDIF - END SUBROUTINE BD_DestroyContState - - SUBROUTINE BD_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(BD_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 = 'BD_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 ! q allocated yes/no - IF ( ALLOCATED(InData%q) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! q upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%q) ! q - END IF - Int_BufSz = Int_BufSz + 1 ! dqdt allocated yes/no - IF ( ALLOCATED(InData%dqdt) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! dqdt upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%dqdt) ! dqdt - 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%q) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%q,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%q,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%q,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%q,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%q,2), UBOUND(InData%q,2) - DO i1 = LBOUND(InData%q,1), UBOUND(InData%q,1) - DbKiBuf(Db_Xferred) = InData%q(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%dqdt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%dqdt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dqdt,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%dqdt,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dqdt,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%dqdt,2), UBOUND(InData%dqdt,2) - DO i1 = LBOUND(InData%dqdt,1), UBOUND(InData%dqdt,1) - DbKiBuf(Db_Xferred) = InData%dqdt(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE BD_PackContState - - SUBROUTINE BD_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(BD_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 = 'BD_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 ! q not allocated - Int_Xferred = Int_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%q)) DEALLOCATE(OutData%q) - ALLOCATE(OutData%q(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%q.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%q,2), UBOUND(OutData%q,2) - DO i1 = LBOUND(OutData%q,1), UBOUND(OutData%q,1) - OutData%q(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! dqdt not allocated - Int_Xferred = Int_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%dqdt)) DEALLOCATE(OutData%dqdt) - ALLOCATE(OutData%dqdt(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%dqdt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%dqdt,2), UBOUND(OutData%dqdt,2) - DO i1 = LBOUND(OutData%dqdt,1), UBOUND(OutData%dqdt,1) - OutData%dqdt(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE BD_UnPackContState - - SUBROUTINE BD_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(BD_DiscreteStateType), INTENT(IN) :: SrcDiscStateData - TYPE(BD_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 = 'BD_CopyDiscState' -! + ErrMsg = '' + if (allocated(InitOutputData%WriteOutputHdr)) then + deallocate(InitOutputData%WriteOutputHdr) + end if + if (allocated(InitOutputData%WriteOutputUnt)) then + deallocate(InitOutputData%WriteOutputUnt) + end if + call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(InitOutputData%LinNames_y)) then + deallocate(InitOutputData%LinNames_y) + end if + if (allocated(InitOutputData%LinNames_x)) then + deallocate(InitOutputData%LinNames_x) + end if + if (allocated(InitOutputData%LinNames_u)) then + deallocate(InitOutputData%LinNames_u) + end if + if (allocated(InitOutputData%RotFrame_y)) then + deallocate(InitOutputData%RotFrame_y) + end if + if (allocated(InitOutputData%RotFrame_x)) then + deallocate(InitOutputData%RotFrame_x) + end if + if (allocated(InitOutputData%RotFrame_u)) then + deallocate(InitOutputData%RotFrame_u) + end if + if (allocated(InitOutputData%IsLoad_u)) then + deallocate(InitOutputData%IsLoad_u) + end if + if (allocated(InitOutputData%DerivOrder_x)) then + deallocate(InitOutputData%DerivOrder_x) + end if +end subroutine + +subroutine BD_PackInitOutput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(BD_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'BD_PackInitOutput' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%WriteOutputHdr) + call RegPackAlloc(RF, InData%WriteOutputUnt) + call NWTC_Library_PackProgDesc(RF, InData%Ver) + call RegPackAlloc(RF, InData%LinNames_y) + call RegPackAlloc(RF, InData%LinNames_x) + call RegPackAlloc(RF, InData%LinNames_u) + call RegPackAlloc(RF, InData%RotFrame_y) + call RegPackAlloc(RF, InData%RotFrame_x) + call RegPackAlloc(RF, InData%RotFrame_u) + call RegPackAlloc(RF, InData%IsLoad_u) + call RegPackAlloc(RF, InData%DerivOrder_x) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine BD_UnPackInitOutput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(BD_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'BD_UnPackInitOutput' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%WriteOutputHdr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WriteOutputUnt); if (RegCheckErr(RF, RoutineName)) return + call NWTC_Library_UnpackProgDesc(RF, OutData%Ver) ! Ver + call RegUnpackAlloc(RF, OutData%LinNames_y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LinNames_x); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LinNames_u); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%RotFrame_y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%RotFrame_x); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%RotFrame_u); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%IsLoad_u); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%DerivOrder_x); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine BD_CopyBladeInputData(SrcBladeInputDataData, DstBladeInputDataData, CtrlCode, ErrStat, ErrMsg) + type(BladeInputData), intent(in) :: SrcBladeInputDataData + type(BladeInputData), intent(inout) :: DstBladeInputDataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'BD_CopyBladeInputData' ErrStat = ErrID_None - ErrMsg = "" - DstDiscStateData%thetaP = SrcDiscStateData%thetaP - DstDiscStateData%thetaPD = SrcDiscStateData%thetaPD - END SUBROUTINE BD_CopyDiscState - - SUBROUTINE BD_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(BD_DiscreteStateType), INTENT(INOUT) :: DiscStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BD_DestroyDiscState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE BD_DestroyDiscState - - SUBROUTINE BD_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(BD_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 = 'BD_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 ! thetaP - Re_BufSz = Re_BufSz + 1 ! thetaPD - 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%thetaP - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%thetaPD - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE BD_PackDiscState - - SUBROUTINE BD_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(BD_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 = 'BD_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%thetaP = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%thetaPD = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE BD_UnPackDiscState - - SUBROUTINE BD_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(BD_ConstraintStateType), INTENT(IN) :: SrcConstrStateData - TYPE(BD_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 = 'BD_CopyConstrState' -! + ErrMsg = '' + DstBladeInputDataData%station_total = SrcBladeInputDataData%station_total + DstBladeInputDataData%format_index = SrcBladeInputDataData%format_index + if (allocated(SrcBladeInputDataData%station_eta)) then + LB(1:1) = lbound(SrcBladeInputDataData%station_eta) + UB(1:1) = ubound(SrcBladeInputDataData%station_eta) + if (.not. allocated(DstBladeInputDataData%station_eta)) then + allocate(DstBladeInputDataData%station_eta(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladeInputDataData%station_eta.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladeInputDataData%station_eta = SrcBladeInputDataData%station_eta + end if + if (allocated(SrcBladeInputDataData%stiff0)) then + LB(1:3) = lbound(SrcBladeInputDataData%stiff0) + UB(1:3) = ubound(SrcBladeInputDataData%stiff0) + if (.not. allocated(DstBladeInputDataData%stiff0)) then + allocate(DstBladeInputDataData%stiff0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladeInputDataData%stiff0.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladeInputDataData%stiff0 = SrcBladeInputDataData%stiff0 + end if + if (allocated(SrcBladeInputDataData%mass0)) then + LB(1:3) = lbound(SrcBladeInputDataData%mass0) + UB(1:3) = ubound(SrcBladeInputDataData%mass0) + if (.not. allocated(DstBladeInputDataData%mass0)) then + allocate(DstBladeInputDataData%mass0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladeInputDataData%mass0.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladeInputDataData%mass0 = SrcBladeInputDataData%mass0 + end if + DstBladeInputDataData%beta = SrcBladeInputDataData%beta + DstBladeInputDataData%damp_flag = SrcBladeInputDataData%damp_flag +end subroutine + +subroutine BD_DestroyBladeInputData(BladeInputDataData, ErrStat, ErrMsg) + type(BladeInputData), intent(inout) :: BladeInputDataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'BD_DestroyBladeInputData' ErrStat = ErrID_None - ErrMsg = "" - DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState - END SUBROUTINE BD_CopyConstrState - - SUBROUTINE BD_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(BD_ConstraintStateType), INTENT(INOUT) :: ConstrStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BD_DestroyConstrState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE BD_DestroyConstrState - - SUBROUTINE BD_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(BD_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 = 'BD_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 BD_PackConstrState - - SUBROUTINE BD_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(BD_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 = 'BD_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 BD_UnPackConstrState - - SUBROUTINE BD_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(BD_OtherStateType), INTENT(IN) :: SrcOtherStateData - TYPE(BD_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) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BD_CopyOtherState' -! + ErrMsg = '' + if (allocated(BladeInputDataData%station_eta)) then + deallocate(BladeInputDataData%station_eta) + end if + if (allocated(BladeInputDataData%stiff0)) then + deallocate(BladeInputDataData%stiff0) + end if + if (allocated(BladeInputDataData%mass0)) then + deallocate(BladeInputDataData%mass0) + end if +end subroutine + +subroutine BD_PackBladeInputData(RF, Indata) + type(RegFile), intent(inout) :: RF + type(BladeInputData), intent(in) :: InData + character(*), parameter :: RoutineName = 'BD_PackBladeInputData' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%station_total) + call RegPack(RF, InData%format_index) + call RegPackAlloc(RF, InData%station_eta) + call RegPackAlloc(RF, InData%stiff0) + call RegPackAlloc(RF, InData%mass0) + call RegPack(RF, InData%beta) + call RegPack(RF, InData%damp_flag) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine BD_UnPackBladeInputData(RF, OutData) + type(RegFile), intent(inout) :: RF + type(BladeInputData), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'BD_UnPackBladeInputData' + integer(B4Ki) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%station_total); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%format_index); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%station_eta); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%stiff0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%mass0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%beta); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%damp_flag); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine BD_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg) + type(BD_InputFile), intent(in) :: SrcInputFileData + type(BD_InputFile), intent(inout) :: DstInputFileData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'BD_CopyInputFile' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcOtherStateData%acc)) THEN - i1_l = LBOUND(SrcOtherStateData%acc,1) - i1_u = UBOUND(SrcOtherStateData%acc,1) - i2_l = LBOUND(SrcOtherStateData%acc,2) - i2_u = UBOUND(SrcOtherStateData%acc,2) - IF (.NOT. ALLOCATED(DstOtherStateData%acc)) THEN - ALLOCATE(DstOtherStateData%acc(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%acc.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOtherStateData%acc = SrcOtherStateData%acc -ENDIF -IF (ALLOCATED(SrcOtherStateData%xcc)) THEN - i1_l = LBOUND(SrcOtherStateData%xcc,1) - i1_u = UBOUND(SrcOtherStateData%xcc,1) - i2_l = LBOUND(SrcOtherStateData%xcc,2) - i2_u = UBOUND(SrcOtherStateData%xcc,2) - IF (.NOT. ALLOCATED(DstOtherStateData%xcc)) THEN - ALLOCATE(DstOtherStateData%xcc(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%xcc.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOtherStateData%xcc = SrcOtherStateData%xcc -ENDIF - DstOtherStateData%InitAcc = SrcOtherStateData%InitAcc - DstOtherStateData%RunQuasiStaticInit = SrcOtherStateData%RunQuasiStaticInit - DstOtherStateData%GlbPos = SrcOtherStateData%GlbPos - DstOtherStateData%GlbRot = SrcOtherStateData%GlbRot - DstOtherStateData%Glb_crv = SrcOtherStateData%Glb_crv - END SUBROUTINE BD_CopyOtherState - - SUBROUTINE BD_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(BD_OtherStateType), INTENT(INOUT) :: OtherStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BD_DestroyOtherState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(OtherStateData%acc)) THEN - DEALLOCATE(OtherStateData%acc) -ENDIF -IF (ALLOCATED(OtherStateData%xcc)) THEN - DEALLOCATE(OtherStateData%xcc) -ENDIF - END SUBROUTINE BD_DestroyOtherState - - SUBROUTINE BD_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(BD_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 = 'BD_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 ! acc allocated yes/no - IF ( ALLOCATED(InData%acc) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! acc upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%acc) ! acc - END IF - Int_BufSz = Int_BufSz + 1 ! xcc allocated yes/no - IF ( ALLOCATED(InData%xcc) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! xcc upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%xcc) ! xcc - END IF - Int_BufSz = Int_BufSz + 1 ! InitAcc - Int_BufSz = Int_BufSz + 1 ! RunQuasiStaticInit - Db_BufSz = Db_BufSz + SIZE(InData%GlbPos) ! GlbPos - Db_BufSz = Db_BufSz + SIZE(InData%GlbRot) ! GlbRot - Db_BufSz = Db_BufSz + SIZE(InData%Glb_crv) ! Glb_crv - 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%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) - DbKiBuf(Db_Xferred) = InData%acc(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%xcc) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%xcc,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xcc,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%xcc,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xcc,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%xcc,2), UBOUND(InData%xcc,2) - DO i1 = LBOUND(InData%xcc,1), UBOUND(InData%xcc,1) - DbKiBuf(Db_Xferred) = InData%xcc(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = TRANSFER(InData%InitAcc, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%RunQuasiStaticInit, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%GlbPos,1), UBOUND(InData%GlbPos,1) - DbKiBuf(Db_Xferred) = InData%GlbPos(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i2 = LBOUND(InData%GlbRot,2), UBOUND(InData%GlbRot,2) - DO i1 = LBOUND(InData%GlbRot,1), UBOUND(InData%GlbRot,1) - DbKiBuf(Db_Xferred) = InData%GlbRot(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - DO i1 = LBOUND(InData%Glb_crv,1), UBOUND(InData%Glb_crv,1) - DbKiBuf(Db_Xferred) = InData%Glb_crv(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END SUBROUTINE BD_PackOtherState - - SUBROUTINE BD_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(BD_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) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BD_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 ! 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) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! xcc not allocated - Int_Xferred = Int_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%xcc)) DEALLOCATE(OutData%xcc) - ALLOCATE(OutData%xcc(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xcc.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%xcc,2), UBOUND(OutData%xcc,2) - DO i1 = LBOUND(OutData%xcc,1), UBOUND(OutData%xcc,1) - OutData%xcc(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - OutData%InitAcc = TRANSFER(IntKiBuf(Int_Xferred), OutData%InitAcc) - Int_Xferred = Int_Xferred + 1 - OutData%RunQuasiStaticInit = TRANSFER(IntKiBuf(Int_Xferred), OutData%RunQuasiStaticInit) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%GlbPos,1) - i1_u = UBOUND(OutData%GlbPos,1) - DO i1 = LBOUND(OutData%GlbPos,1), UBOUND(OutData%GlbPos,1) - OutData%GlbPos(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%GlbRot,1) - i1_u = UBOUND(OutData%GlbRot,1) - i2_l = LBOUND(OutData%GlbRot,2) - i2_u = UBOUND(OutData%GlbRot,2) - DO i2 = LBOUND(OutData%GlbRot,2), UBOUND(OutData%GlbRot,2) - DO i1 = LBOUND(OutData%GlbRot,1), UBOUND(OutData%GlbRot,1) - OutData%GlbRot(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%Glb_crv,1) - i1_u = UBOUND(OutData%Glb_crv,1) - DO i1 = LBOUND(OutData%Glb_crv,1), UBOUND(OutData%Glb_crv,1) - OutData%Glb_crv(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END SUBROUTINE BD_UnPackOtherState - - SUBROUTINE BD_CopyqpParam( SrcqpParamData, DstqpParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(qpParam), INTENT(IN) :: SrcqpParamData - TYPE(qpParam), INTENT(INOUT) :: DstqpParamData - 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 = 'BD_CopyqpParam' -! + ErrMsg = '' + DstInputFileData%member_total = SrcInputFileData%member_total + DstInputFileData%kp_total = SrcInputFileData%kp_total + if (allocated(SrcInputFileData%kp_member)) then + LB(1:1) = lbound(SrcInputFileData%kp_member) + UB(1:1) = ubound(SrcInputFileData%kp_member) + if (.not. allocated(DstInputFileData%kp_member)) then + allocate(DstInputFileData%kp_member(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%kp_member.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%kp_member = SrcInputFileData%kp_member + end if + DstInputFileData%order_elem = SrcInputFileData%order_elem + DstInputFileData%load_retries = SrcInputFileData%load_retries + DstInputFileData%NRMax = SrcInputFileData%NRMax + DstInputFileData%quadrature = SrcInputFileData%quadrature + DstInputFileData%n_fact = SrcInputFileData%n_fact + DstInputFileData%refine = SrcInputFileData%refine + DstInputFileData%rhoinf = SrcInputFileData%rhoinf + DstInputFileData%DTBeam = SrcInputFileData%DTBeam + call BD_CopyBladeInputData(SrcInputFileData%InpBl, DstInputFileData%InpBl, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstInputFileData%BldFile = SrcInputFileData%BldFile + DstInputFileData%UsePitchAct = SrcInputFileData%UsePitchAct + DstInputFileData%QuasiStaticInit = SrcInputFileData%QuasiStaticInit + DstInputFileData%stop_tol = SrcInputFileData%stop_tol + DstInputFileData%tngt_stf_pert = SrcInputFileData%tngt_stf_pert + DstInputFileData%tngt_stf_difftol = SrcInputFileData%tngt_stf_difftol + if (allocated(SrcInputFileData%kp_coordinate)) then + LB(1:2) = lbound(SrcInputFileData%kp_coordinate) + UB(1:2) = ubound(SrcInputFileData%kp_coordinate) + if (.not. allocated(DstInputFileData%kp_coordinate)) then + allocate(DstInputFileData%kp_coordinate(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%kp_coordinate.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%kp_coordinate = SrcInputFileData%kp_coordinate + end if + DstInputFileData%pitchJ = SrcInputFileData%pitchJ + DstInputFileData%pitchK = SrcInputFileData%pitchK + DstInputFileData%pitchC = SrcInputFileData%pitchC + DstInputFileData%Echo = SrcInputFileData%Echo + DstInputFileData%RotStates = SrcInputFileData%RotStates + DstInputFileData%RelStates = SrcInputFileData%RelStates + DstInputFileData%tngt_stf_fd = SrcInputFileData%tngt_stf_fd + DstInputFileData%tngt_stf_comp = SrcInputFileData%tngt_stf_comp + DstInputFileData%NNodeOuts = SrcInputFileData%NNodeOuts + DstInputFileData%OutNd = SrcInputFileData%OutNd + DstInputFileData%NumOuts = SrcInputFileData%NumOuts + if (allocated(SrcInputFileData%OutList)) then + LB(1:1) = lbound(SrcInputFileData%OutList) + UB(1:1) = ubound(SrcInputFileData%OutList) + if (.not. allocated(DstInputFileData%OutList)) then + allocate(DstInputFileData%OutList(LB(1):UB(1)), 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 + end if + DstInputFileData%SumPrint = SrcInputFileData%SumPrint + DstInputFileData%OutFmt = SrcInputFileData%OutFmt + DstInputFileData%BldNd_NumOuts = SrcInputFileData%BldNd_NumOuts + if (allocated(SrcInputFileData%BldNd_OutList)) then + LB(1:1) = lbound(SrcInputFileData%BldNd_OutList) + UB(1:1) = ubound(SrcInputFileData%BldNd_OutList) + if (.not. allocated(DstInputFileData%BldNd_OutList)) then + allocate(DstInputFileData%BldNd_OutList(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%BldNd_OutList.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%BldNd_OutList = SrcInputFileData%BldNd_OutList + end if + if (allocated(SrcInputFileData%BldNd_BlOutNd)) then + LB(1:1) = lbound(SrcInputFileData%BldNd_BlOutNd) + UB(1:1) = ubound(SrcInputFileData%BldNd_BlOutNd) + if (.not. allocated(DstInputFileData%BldNd_BlOutNd)) then + allocate(DstInputFileData%BldNd_BlOutNd(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%BldNd_BlOutNd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%BldNd_BlOutNd = SrcInputFileData%BldNd_BlOutNd + end if + DstInputFileData%BldNd_BlOutNd_Str = SrcInputFileData%BldNd_BlOutNd_Str +end subroutine + +subroutine BD_DestroyInputFile(InputFileData, ErrStat, ErrMsg) + type(BD_InputFile), intent(inout) :: InputFileData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'BD_DestroyInputFile' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcqpParamData%mmm)) THEN - i1_l = LBOUND(SrcqpParamData%mmm,1) - i1_u = UBOUND(SrcqpParamData%mmm,1) - i2_l = LBOUND(SrcqpParamData%mmm,2) - i2_u = UBOUND(SrcqpParamData%mmm,2) - IF (.NOT. ALLOCATED(DstqpParamData%mmm)) THEN - ALLOCATE(DstqpParamData%mmm(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstqpParamData%mmm.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstqpParamData%mmm = SrcqpParamData%mmm -ENDIF -IF (ALLOCATED(SrcqpParamData%mEta)) THEN - i1_l = LBOUND(SrcqpParamData%mEta,1) - i1_u = UBOUND(SrcqpParamData%mEta,1) - i2_l = LBOUND(SrcqpParamData%mEta,2) - i2_u = UBOUND(SrcqpParamData%mEta,2) - i3_l = LBOUND(SrcqpParamData%mEta,3) - i3_u = UBOUND(SrcqpParamData%mEta,3) - IF (.NOT. ALLOCATED(DstqpParamData%mEta)) THEN - ALLOCATE(DstqpParamData%mEta(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstqpParamData%mEta.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstqpParamData%mEta = SrcqpParamData%mEta -ENDIF - END SUBROUTINE BD_CopyqpParam - - SUBROUTINE BD_DestroyqpParam( qpParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(qpParam), INTENT(INOUT) :: qpParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BD_DestroyqpParam' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(qpParamData%mmm)) THEN - DEALLOCATE(qpParamData%mmm) -ENDIF -IF (ALLOCATED(qpParamData%mEta)) THEN - DEALLOCATE(qpParamData%mEta) -ENDIF - END SUBROUTINE BD_DestroyqpParam - - SUBROUTINE BD_PackqpParam( 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(qpParam), 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 = 'BD_PackqpParam' - ! 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 ! mmm allocated yes/no - IF ( ALLOCATED(InData%mmm) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! mmm upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%mmm) ! mmm - END IF - Int_BufSz = Int_BufSz + 1 ! mEta allocated yes/no - IF ( ALLOCATED(InData%mEta) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! mEta upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%mEta) ! mEta - 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%mmm) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%mmm,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%mmm,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%mmm,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%mmm,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%mmm,2), UBOUND(InData%mmm,2) - DO i1 = LBOUND(InData%mmm,1), UBOUND(InData%mmm,1) - DbKiBuf(Db_Xferred) = InData%mmm(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%mEta) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%mEta,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%mEta,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%mEta,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%mEta,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%mEta,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%mEta,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%mEta,3), UBOUND(InData%mEta,3) - DO i2 = LBOUND(InData%mEta,2), UBOUND(InData%mEta,2) - DO i1 = LBOUND(InData%mEta,1), UBOUND(InData%mEta,1) - DbKiBuf(Db_Xferred) = InData%mEta(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - END SUBROUTINE BD_PackqpParam - - SUBROUTINE BD_UnPackqpParam( 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(qpParam), 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 = 'BD_UnPackqpParam' - ! 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 ! mmm not allocated - Int_Xferred = Int_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%mmm)) DEALLOCATE(OutData%mmm) - ALLOCATE(OutData%mmm(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%mmm.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%mmm,2), UBOUND(OutData%mmm,2) - DO i1 = LBOUND(OutData%mmm,1), UBOUND(OutData%mmm,1) - OutData%mmm(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! mEta not allocated - Int_Xferred = Int_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%mEta)) DEALLOCATE(OutData%mEta) - ALLOCATE(OutData%mEta(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%mEta.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%mEta,3), UBOUND(OutData%mEta,3) - DO i2 = LBOUND(OutData%mEta,2), UBOUND(OutData%mEta,2) - DO i1 = LBOUND(OutData%mEta,1), UBOUND(OutData%mEta,1) - OutData%mEta(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - END SUBROUTINE BD_UnPackqpParam - - SUBROUTINE BD_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(BD_ParameterType), INTENT(IN) :: SrcParamData - TYPE(BD_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) :: 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 = 'BD_CopyParam' -! + ErrMsg = '' + if (allocated(InputFileData%kp_member)) then + deallocate(InputFileData%kp_member) + end if + call BD_DestroyBladeInputData(InputFileData%InpBl, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(InputFileData%kp_coordinate)) then + deallocate(InputFileData%kp_coordinate) + end if + if (allocated(InputFileData%OutList)) then + deallocate(InputFileData%OutList) + end if + if (allocated(InputFileData%BldNd_OutList)) then + deallocate(InputFileData%BldNd_OutList) + end if + if (allocated(InputFileData%BldNd_BlOutNd)) then + deallocate(InputFileData%BldNd_BlOutNd) + end if +end subroutine + +subroutine BD_PackInputFile(RF, Indata) + type(RegFile), intent(inout) :: RF + type(BD_InputFile), intent(in) :: InData + character(*), parameter :: RoutineName = 'BD_PackInputFile' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%member_total) + call RegPack(RF, InData%kp_total) + call RegPackAlloc(RF, InData%kp_member) + call RegPack(RF, InData%order_elem) + call RegPack(RF, InData%load_retries) + call RegPack(RF, InData%NRMax) + call RegPack(RF, InData%quadrature) + call RegPack(RF, InData%n_fact) + call RegPack(RF, InData%refine) + call RegPack(RF, InData%rhoinf) + call RegPack(RF, InData%DTBeam) + call BD_PackBladeInputData(RF, InData%InpBl) + call RegPack(RF, InData%BldFile) + call RegPack(RF, InData%UsePitchAct) + call RegPack(RF, InData%QuasiStaticInit) + call RegPack(RF, InData%stop_tol) + call RegPack(RF, InData%tngt_stf_pert) + call RegPack(RF, InData%tngt_stf_difftol) + call RegPackAlloc(RF, InData%kp_coordinate) + call RegPack(RF, InData%pitchJ) + call RegPack(RF, InData%pitchK) + call RegPack(RF, InData%pitchC) + call RegPack(RF, InData%Echo) + call RegPack(RF, InData%RotStates) + call RegPack(RF, InData%RelStates) + call RegPack(RF, InData%tngt_stf_fd) + call RegPack(RF, InData%tngt_stf_comp) + call RegPack(RF, InData%NNodeOuts) + call RegPack(RF, InData%OutNd) + call RegPack(RF, InData%NumOuts) + call RegPackAlloc(RF, InData%OutList) + call RegPack(RF, InData%SumPrint) + call RegPack(RF, InData%OutFmt) + call RegPack(RF, InData%BldNd_NumOuts) + call RegPackAlloc(RF, InData%BldNd_OutList) + call RegPackAlloc(RF, InData%BldNd_BlOutNd) + call RegPack(RF, InData%BldNd_BlOutNd_Str) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine BD_UnPackInputFile(RF, OutData) + type(RegFile), intent(inout) :: RF + type(BD_InputFile), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'BD_UnPackInputFile' + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%member_total); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%kp_total); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%kp_member); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%order_elem); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%load_retries); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NRMax); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%quadrature); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%n_fact); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%refine); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rhoinf); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DTBeam); if (RegCheckErr(RF, RoutineName)) return + call BD_UnpackBladeInputData(RF, OutData%InpBl) ! InpBl + call RegUnpack(RF, OutData%BldFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UsePitchAct); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%QuasiStaticInit); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%stop_tol); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%tngt_stf_pert); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%tngt_stf_difftol); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%kp_coordinate); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%pitchJ); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%pitchK); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%pitchC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Echo); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RotStates); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RelStates); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%tngt_stf_fd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%tngt_stf_comp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NNodeOuts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutNd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumOuts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%OutList); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SumPrint); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutFmt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BldNd_NumOuts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BldNd_OutList); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BldNd_BlOutNd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BldNd_BlOutNd_Str); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine BD_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) + type(BD_ContinuousStateType), intent(in) :: SrcContStateData + type(BD_ContinuousStateType), intent(inout) :: DstContStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'BD_CopyContState' ErrStat = ErrID_None - ErrMsg = "" - DstParamData%dt = SrcParamData%dt - DstParamData%coef = SrcParamData%coef - DstParamData%rhoinf = SrcParamData%rhoinf -IF (ALLOCATED(SrcParamData%uuN0)) THEN - i1_l = LBOUND(SrcParamData%uuN0,1) - i1_u = UBOUND(SrcParamData%uuN0,1) - i2_l = LBOUND(SrcParamData%uuN0,2) - i2_u = UBOUND(SrcParamData%uuN0,2) - i3_l = LBOUND(SrcParamData%uuN0,3) - i3_u = UBOUND(SrcParamData%uuN0,3) - IF (.NOT. ALLOCATED(DstParamData%uuN0)) THEN - ALLOCATE(DstParamData%uuN0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%uuN0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%uuN0 = SrcParamData%uuN0 -ENDIF -IF (ALLOCATED(SrcParamData%Stif0_QP)) THEN - i1_l = LBOUND(SrcParamData%Stif0_QP,1) - i1_u = UBOUND(SrcParamData%Stif0_QP,1) - i2_l = LBOUND(SrcParamData%Stif0_QP,2) - i2_u = UBOUND(SrcParamData%Stif0_QP,2) - i3_l = LBOUND(SrcParamData%Stif0_QP,3) - i3_u = UBOUND(SrcParamData%Stif0_QP,3) - IF (.NOT. ALLOCATED(DstParamData%Stif0_QP)) THEN - ALLOCATE(DstParamData%Stif0_QP(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Stif0_QP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Stif0_QP = SrcParamData%Stif0_QP -ENDIF -IF (ALLOCATED(SrcParamData%Mass0_QP)) THEN - i1_l = LBOUND(SrcParamData%Mass0_QP,1) - i1_u = UBOUND(SrcParamData%Mass0_QP,1) - i2_l = LBOUND(SrcParamData%Mass0_QP,2) - i2_u = UBOUND(SrcParamData%Mass0_QP,2) - i3_l = LBOUND(SrcParamData%Mass0_QP,3) - i3_u = UBOUND(SrcParamData%Mass0_QP,3) - IF (.NOT. ALLOCATED(DstParamData%Mass0_QP)) THEN - ALLOCATE(DstParamData%Mass0_QP(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Mass0_QP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Mass0_QP = SrcParamData%Mass0_QP -ENDIF - DstParamData%gravity = SrcParamData%gravity -IF (ALLOCATED(SrcParamData%segment_eta)) THEN - i1_l = LBOUND(SrcParamData%segment_eta,1) - i1_u = UBOUND(SrcParamData%segment_eta,1) - IF (.NOT. ALLOCATED(DstParamData%segment_eta)) THEN - ALLOCATE(DstParamData%segment_eta(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%segment_eta.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%segment_eta = SrcParamData%segment_eta -ENDIF -IF (ALLOCATED(SrcParamData%member_eta)) THEN - i1_l = LBOUND(SrcParamData%member_eta,1) - i1_u = UBOUND(SrcParamData%member_eta,1) - IF (.NOT. ALLOCATED(DstParamData%member_eta)) THEN - ALLOCATE(DstParamData%member_eta(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%member_eta.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%member_eta = SrcParamData%member_eta -ENDIF - DstParamData%blade_length = SrcParamData%blade_length - DstParamData%blade_mass = SrcParamData%blade_mass - DstParamData%blade_CG = SrcParamData%blade_CG - DstParamData%blade_IN = SrcParamData%blade_IN - DstParamData%beta = SrcParamData%beta - DstParamData%tol = SrcParamData%tol -IF (ALLOCATED(SrcParamData%QPtN)) THEN - i1_l = LBOUND(SrcParamData%QPtN,1) - i1_u = UBOUND(SrcParamData%QPtN,1) - IF (.NOT. ALLOCATED(DstParamData%QPtN)) THEN - ALLOCATE(DstParamData%QPtN(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%QPtN.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%QPtN = SrcParamData%QPtN -ENDIF -IF (ALLOCATED(SrcParamData%QPtWeight)) THEN - i1_l = LBOUND(SrcParamData%QPtWeight,1) - i1_u = UBOUND(SrcParamData%QPtWeight,1) - IF (.NOT. ALLOCATED(DstParamData%QPtWeight)) THEN - ALLOCATE(DstParamData%QPtWeight(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%QPtWeight.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%QPtWeight = SrcParamData%QPtWeight -ENDIF -IF (ALLOCATED(SrcParamData%Shp)) THEN - i1_l = LBOUND(SrcParamData%Shp,1) - i1_u = UBOUND(SrcParamData%Shp,1) - i2_l = LBOUND(SrcParamData%Shp,2) - i2_u = UBOUND(SrcParamData%Shp,2) - IF (.NOT. ALLOCATED(DstParamData%Shp)) THEN - ALLOCATE(DstParamData%Shp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Shp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Shp = SrcParamData%Shp -ENDIF -IF (ALLOCATED(SrcParamData%ShpDer)) THEN - i1_l = LBOUND(SrcParamData%ShpDer,1) - i1_u = UBOUND(SrcParamData%ShpDer,1) - i2_l = LBOUND(SrcParamData%ShpDer,2) - i2_u = UBOUND(SrcParamData%ShpDer,2) - IF (.NOT. ALLOCATED(DstParamData%ShpDer)) THEN - ALLOCATE(DstParamData%ShpDer(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ShpDer.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%ShpDer = SrcParamData%ShpDer -ENDIF -IF (ALLOCATED(SrcParamData%Jacobian)) THEN - i1_l = LBOUND(SrcParamData%Jacobian,1) - i1_u = UBOUND(SrcParamData%Jacobian,1) - i2_l = LBOUND(SrcParamData%Jacobian,2) - i2_u = UBOUND(SrcParamData%Jacobian,2) - IF (.NOT. ALLOCATED(DstParamData%Jacobian)) THEN - ALLOCATE(DstParamData%Jacobian(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jacobian.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Jacobian = SrcParamData%Jacobian -ENDIF -IF (ALLOCATED(SrcParamData%uu0)) THEN - i1_l = LBOUND(SrcParamData%uu0,1) - i1_u = UBOUND(SrcParamData%uu0,1) - i2_l = LBOUND(SrcParamData%uu0,2) - i2_u = UBOUND(SrcParamData%uu0,2) - i3_l = LBOUND(SrcParamData%uu0,3) - i3_u = UBOUND(SrcParamData%uu0,3) - IF (.NOT. ALLOCATED(DstParamData%uu0)) THEN - ALLOCATE(DstParamData%uu0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%uu0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%uu0 = SrcParamData%uu0 -ENDIF -IF (ALLOCATED(SrcParamData%rrN0)) THEN - i1_l = LBOUND(SrcParamData%rrN0,1) - i1_u = UBOUND(SrcParamData%rrN0,1) - i2_l = LBOUND(SrcParamData%rrN0,2) - i2_u = UBOUND(SrcParamData%rrN0,2) - i3_l = LBOUND(SrcParamData%rrN0,3) - i3_u = UBOUND(SrcParamData%rrN0,3) - IF (.NOT. ALLOCATED(DstParamData%rrN0)) THEN - ALLOCATE(DstParamData%rrN0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rrN0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%rrN0 = SrcParamData%rrN0 -ENDIF -IF (ALLOCATED(SrcParamData%E10)) THEN - i1_l = LBOUND(SrcParamData%E10,1) - i1_u = UBOUND(SrcParamData%E10,1) - i2_l = LBOUND(SrcParamData%E10,2) - i2_u = UBOUND(SrcParamData%E10,2) - i3_l = LBOUND(SrcParamData%E10,3) - i3_u = UBOUND(SrcParamData%E10,3) - IF (.NOT. ALLOCATED(DstParamData%E10)) THEN - ALLOCATE(DstParamData%E10(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%E10.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%E10 = SrcParamData%E10 -ENDIF - DstParamData%nodes_per_elem = SrcParamData%nodes_per_elem -IF (ALLOCATED(SrcParamData%node_elem_idx)) THEN - i1_l = LBOUND(SrcParamData%node_elem_idx,1) - i1_u = UBOUND(SrcParamData%node_elem_idx,1) - i2_l = LBOUND(SrcParamData%node_elem_idx,2) - i2_u = UBOUND(SrcParamData%node_elem_idx,2) - IF (.NOT. ALLOCATED(DstParamData%node_elem_idx)) THEN - ALLOCATE(DstParamData%node_elem_idx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%node_elem_idx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%node_elem_idx = SrcParamData%node_elem_idx -ENDIF - DstParamData%refine = SrcParamData%refine - DstParamData%dof_node = SrcParamData%dof_node - DstParamData%dof_elem = SrcParamData%dof_elem - DstParamData%rot_elem = SrcParamData%rot_elem - DstParamData%elem_total = SrcParamData%elem_total - DstParamData%node_total = SrcParamData%node_total - DstParamData%dof_total = SrcParamData%dof_total - DstParamData%nqp = SrcParamData%nqp - DstParamData%analysis_type = SrcParamData%analysis_type - DstParamData%damp_flag = SrcParamData%damp_flag - DstParamData%ld_retries = SrcParamData%ld_retries - DstParamData%niter = SrcParamData%niter - DstParamData%quadrature = SrcParamData%quadrature - DstParamData%n_fact = SrcParamData%n_fact - DstParamData%OutInputs = SrcParamData%OutInputs - 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 - DstParamData%NNodeOuts = SrcParamData%NNodeOuts - DstParamData%OutNd = SrcParamData%OutNd -IF (ALLOCATED(SrcParamData%NdIndx)) THEN - i1_l = LBOUND(SrcParamData%NdIndx,1) - i1_u = UBOUND(SrcParamData%NdIndx,1) - IF (.NOT. ALLOCATED(DstParamData%NdIndx)) THEN - ALLOCATE(DstParamData%NdIndx(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%NdIndx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%NdIndx = SrcParamData%NdIndx -ENDIF -IF (ALLOCATED(SrcParamData%NdIndxInverse)) THEN - i1_l = LBOUND(SrcParamData%NdIndxInverse,1) - i1_u = UBOUND(SrcParamData%NdIndxInverse,1) - IF (.NOT. ALLOCATED(DstParamData%NdIndxInverse)) THEN - ALLOCATE(DstParamData%NdIndxInverse(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%NdIndxInverse.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%NdIndxInverse = SrcParamData%NdIndxInverse -ENDIF -IF (ALLOCATED(SrcParamData%OutNd2NdElem)) THEN - i1_l = LBOUND(SrcParamData%OutNd2NdElem,1) - i1_u = UBOUND(SrcParamData%OutNd2NdElem,1) - i2_l = LBOUND(SrcParamData%OutNd2NdElem,2) - i2_u = UBOUND(SrcParamData%OutNd2NdElem,2) - IF (.NOT. ALLOCATED(DstParamData%OutNd2NdElem)) THEN - ALLOCATE(DstParamData%OutNd2NdElem(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutNd2NdElem.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%OutNd2NdElem = SrcParamData%OutNd2NdElem -ENDIF - DstParamData%OutFmt = SrcParamData%OutFmt - DstParamData%UsePitchAct = SrcParamData%UsePitchAct - DstParamData%pitchJ = SrcParamData%pitchJ - DstParamData%pitchK = SrcParamData%pitchK - DstParamData%pitchC = SrcParamData%pitchC - DstParamData%torqM = SrcParamData%torqM - CALL BD_Copyqpparam( SrcParamData%qp, DstParamData%qp, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstParamData%qp_indx_offset = SrcParamData%qp_indx_offset - DstParamData%BldMotionNodeLoc = SrcParamData%BldMotionNodeLoc - DstParamData%tngt_stf_fd = SrcParamData%tngt_stf_fd - DstParamData%tngt_stf_comp = SrcParamData%tngt_stf_comp - DstParamData%tngt_stf_pert = SrcParamData%tngt_stf_pert - DstParamData%tngt_stf_difftol = SrcParamData%tngt_stf_difftol - DstParamData%BldNd_NumOuts = SrcParamData%BldNd_NumOuts - DstParamData%BldNd_TotNumOuts = SrcParamData%BldNd_TotNumOuts -IF (ALLOCATED(SrcParamData%BldNd_OutParam)) THEN - i1_l = LBOUND(SrcParamData%BldNd_OutParam,1) - i1_u = UBOUND(SrcParamData%BldNd_OutParam,1) - IF (.NOT. ALLOCATED(DstParamData%BldNd_OutParam)) THEN - ALLOCATE(DstParamData%BldNd_OutParam(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BldNd_OutParam.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcParamData%BldNd_OutParam,1), UBOUND(SrcParamData%BldNd_OutParam,1) - CALL NWTC_Library_Copyoutparmtype( SrcParamData%BldNd_OutParam(i1), DstParamData%BldNd_OutParam(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcParamData%BldNd_BlOutNd)) THEN - i1_l = LBOUND(SrcParamData%BldNd_BlOutNd,1) - i1_u = UBOUND(SrcParamData%BldNd_BlOutNd,1) - IF (.NOT. ALLOCATED(DstParamData%BldNd_BlOutNd)) THEN - ALLOCATE(DstParamData%BldNd_BlOutNd(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BldNd_BlOutNd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%BldNd_BlOutNd = SrcParamData%BldNd_BlOutNd -ENDIF -IF (ALLOCATED(SrcParamData%QPtw_Shp_Shp_Jac)) THEN - i1_l = LBOUND(SrcParamData%QPtw_Shp_Shp_Jac,1) - i1_u = UBOUND(SrcParamData%QPtw_Shp_Shp_Jac,1) - i2_l = LBOUND(SrcParamData%QPtw_Shp_Shp_Jac,2) - i2_u = UBOUND(SrcParamData%QPtw_Shp_Shp_Jac,2) - i3_l = LBOUND(SrcParamData%QPtw_Shp_Shp_Jac,3) - i3_u = UBOUND(SrcParamData%QPtw_Shp_Shp_Jac,3) - i4_l = LBOUND(SrcParamData%QPtw_Shp_Shp_Jac,4) - i4_u = UBOUND(SrcParamData%QPtw_Shp_Shp_Jac,4) - IF (.NOT. ALLOCATED(DstParamData%QPtw_Shp_Shp_Jac)) THEN - ALLOCATE(DstParamData%QPtw_Shp_Shp_Jac(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 DstParamData%QPtw_Shp_Shp_Jac.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%QPtw_Shp_Shp_Jac = SrcParamData%QPtw_Shp_Shp_Jac -ENDIF -IF (ALLOCATED(SrcParamData%QPtw_Shp_ShpDer)) THEN - i1_l = LBOUND(SrcParamData%QPtw_Shp_ShpDer,1) - i1_u = UBOUND(SrcParamData%QPtw_Shp_ShpDer,1) - i2_l = LBOUND(SrcParamData%QPtw_Shp_ShpDer,2) - i2_u = UBOUND(SrcParamData%QPtw_Shp_ShpDer,2) - i3_l = LBOUND(SrcParamData%QPtw_Shp_ShpDer,3) - i3_u = UBOUND(SrcParamData%QPtw_Shp_ShpDer,3) - IF (.NOT. ALLOCATED(DstParamData%QPtw_Shp_ShpDer)) THEN - ALLOCATE(DstParamData%QPtw_Shp_ShpDer(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%QPtw_Shp_ShpDer.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%QPtw_Shp_ShpDer = SrcParamData%QPtw_Shp_ShpDer -ENDIF -IF (ALLOCATED(SrcParamData%QPtw_ShpDer_ShpDer_Jac)) THEN - i1_l = LBOUND(SrcParamData%QPtw_ShpDer_ShpDer_Jac,1) - i1_u = UBOUND(SrcParamData%QPtw_ShpDer_ShpDer_Jac,1) - i2_l = LBOUND(SrcParamData%QPtw_ShpDer_ShpDer_Jac,2) - i2_u = UBOUND(SrcParamData%QPtw_ShpDer_ShpDer_Jac,2) - i3_l = LBOUND(SrcParamData%QPtw_ShpDer_ShpDer_Jac,3) - i3_u = UBOUND(SrcParamData%QPtw_ShpDer_ShpDer_Jac,3) - i4_l = LBOUND(SrcParamData%QPtw_ShpDer_ShpDer_Jac,4) - i4_u = UBOUND(SrcParamData%QPtw_ShpDer_ShpDer_Jac,4) - IF (.NOT. ALLOCATED(DstParamData%QPtw_ShpDer_ShpDer_Jac)) THEN - ALLOCATE(DstParamData%QPtw_ShpDer_ShpDer_Jac(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 DstParamData%QPtw_ShpDer_ShpDer_Jac.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%QPtw_ShpDer_ShpDer_Jac = SrcParamData%QPtw_ShpDer_ShpDer_Jac -ENDIF -IF (ALLOCATED(SrcParamData%QPtw_Shp_Jac)) THEN - i1_l = LBOUND(SrcParamData%QPtw_Shp_Jac,1) - i1_u = UBOUND(SrcParamData%QPtw_Shp_Jac,1) - i2_l = LBOUND(SrcParamData%QPtw_Shp_Jac,2) - i2_u = UBOUND(SrcParamData%QPtw_Shp_Jac,2) - i3_l = LBOUND(SrcParamData%QPtw_Shp_Jac,3) - i3_u = UBOUND(SrcParamData%QPtw_Shp_Jac,3) - IF (.NOT. ALLOCATED(DstParamData%QPtw_Shp_Jac)) THEN - ALLOCATE(DstParamData%QPtw_Shp_Jac(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%QPtw_Shp_Jac.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%QPtw_Shp_Jac = SrcParamData%QPtw_Shp_Jac -ENDIF -IF (ALLOCATED(SrcParamData%QPtw_ShpDer)) THEN - i1_l = LBOUND(SrcParamData%QPtw_ShpDer,1) - i1_u = UBOUND(SrcParamData%QPtw_ShpDer,1) - i2_l = LBOUND(SrcParamData%QPtw_ShpDer,2) - i2_u = UBOUND(SrcParamData%QPtw_ShpDer,2) - IF (.NOT. ALLOCATED(DstParamData%QPtw_ShpDer)) THEN - ALLOCATE(DstParamData%QPtw_ShpDer(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%QPtw_ShpDer.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%QPtw_ShpDer = SrcParamData%QPtw_ShpDer -ENDIF -IF (ALLOCATED(SrcParamData%FEweight)) THEN - i1_l = LBOUND(SrcParamData%FEweight,1) - i1_u = UBOUND(SrcParamData%FEweight,1) - i2_l = LBOUND(SrcParamData%FEweight,2) - i2_u = UBOUND(SrcParamData%FEweight,2) - IF (.NOT. ALLOCATED(DstParamData%FEweight)) THEN - ALLOCATE(DstParamData%FEweight(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%FEweight.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%FEweight = SrcParamData%FEweight -ENDIF -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 - DstParamData%RelStates = SrcParamData%RelStates - END SUBROUTINE BD_CopyParam - - SUBROUTINE BD_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(BD_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BD_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(ParamData%uuN0)) THEN - DEALLOCATE(ParamData%uuN0) -ENDIF -IF (ALLOCATED(ParamData%Stif0_QP)) THEN - DEALLOCATE(ParamData%Stif0_QP) -ENDIF -IF (ALLOCATED(ParamData%Mass0_QP)) THEN - DEALLOCATE(ParamData%Mass0_QP) -ENDIF -IF (ALLOCATED(ParamData%segment_eta)) THEN - DEALLOCATE(ParamData%segment_eta) -ENDIF -IF (ALLOCATED(ParamData%member_eta)) THEN - DEALLOCATE(ParamData%member_eta) -ENDIF -IF (ALLOCATED(ParamData%QPtN)) THEN - DEALLOCATE(ParamData%QPtN) -ENDIF -IF (ALLOCATED(ParamData%QPtWeight)) THEN - DEALLOCATE(ParamData%QPtWeight) -ENDIF -IF (ALLOCATED(ParamData%Shp)) THEN - DEALLOCATE(ParamData%Shp) -ENDIF -IF (ALLOCATED(ParamData%ShpDer)) THEN - DEALLOCATE(ParamData%ShpDer) -ENDIF -IF (ALLOCATED(ParamData%Jacobian)) THEN - DEALLOCATE(ParamData%Jacobian) -ENDIF -IF (ALLOCATED(ParamData%uu0)) THEN - DEALLOCATE(ParamData%uu0) -ENDIF -IF (ALLOCATED(ParamData%rrN0)) THEN - DEALLOCATE(ParamData%rrN0) -ENDIF -IF (ALLOCATED(ParamData%E10)) THEN - DEALLOCATE(ParamData%E10) -ENDIF -IF (ALLOCATED(ParamData%node_elem_idx)) THEN - DEALLOCATE(ParamData%node_elem_idx) -ENDIF -IF (ALLOCATED(ParamData%OutParam)) THEN -DO i1 = LBOUND(ParamData%OutParam,1), UBOUND(ParamData%OutParam,1) - CALL NWTC_Library_Destroyoutparmtype( ParamData%OutParam(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ParamData%OutParam) -ENDIF -IF (ALLOCATED(ParamData%NdIndx)) THEN - DEALLOCATE(ParamData%NdIndx) -ENDIF -IF (ALLOCATED(ParamData%NdIndxInverse)) THEN - DEALLOCATE(ParamData%NdIndxInverse) -ENDIF -IF (ALLOCATED(ParamData%OutNd2NdElem)) THEN - DEALLOCATE(ParamData%OutNd2NdElem) -ENDIF - CALL BD_Destroyqpparam( ParamData%qp, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(ParamData%BldNd_OutParam)) THEN -DO i1 = LBOUND(ParamData%BldNd_OutParam,1), UBOUND(ParamData%BldNd_OutParam,1) - CALL NWTC_Library_Destroyoutparmtype( ParamData%BldNd_OutParam(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ParamData%BldNd_OutParam) -ENDIF -IF (ALLOCATED(ParamData%BldNd_BlOutNd)) THEN - DEALLOCATE(ParamData%BldNd_BlOutNd) -ENDIF -IF (ALLOCATED(ParamData%QPtw_Shp_Shp_Jac)) THEN - DEALLOCATE(ParamData%QPtw_Shp_Shp_Jac) -ENDIF -IF (ALLOCATED(ParamData%QPtw_Shp_ShpDer)) THEN - DEALLOCATE(ParamData%QPtw_Shp_ShpDer) -ENDIF -IF (ALLOCATED(ParamData%QPtw_ShpDer_ShpDer_Jac)) THEN - DEALLOCATE(ParamData%QPtw_ShpDer_ShpDer_Jac) -ENDIF -IF (ALLOCATED(ParamData%QPtw_Shp_Jac)) THEN - DEALLOCATE(ParamData%QPtw_Shp_Jac) -ENDIF -IF (ALLOCATED(ParamData%QPtw_ShpDer)) THEN - DEALLOCATE(ParamData%QPtw_ShpDer) -ENDIF -IF (ALLOCATED(ParamData%FEweight)) THEN - DEALLOCATE(ParamData%FEweight) -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 BD_DestroyParam - - SUBROUTINE BD_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(BD_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 = 'BD_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 + SIZE(InData%coef) ! coef - Db_BufSz = Db_BufSz + 1 ! rhoinf - Int_BufSz = Int_BufSz + 1 ! uuN0 allocated yes/no - IF ( ALLOCATED(InData%uuN0) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! uuN0 upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%uuN0) ! uuN0 - END IF - Int_BufSz = Int_BufSz + 1 ! Stif0_QP allocated yes/no - IF ( ALLOCATED(InData%Stif0_QP) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Stif0_QP upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Stif0_QP) ! Stif0_QP - END IF - Int_BufSz = Int_BufSz + 1 ! Mass0_QP allocated yes/no - IF ( ALLOCATED(InData%Mass0_QP) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Mass0_QP upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Mass0_QP) ! Mass0_QP - END IF - Db_BufSz = Db_BufSz + SIZE(InData%gravity) ! gravity - Int_BufSz = Int_BufSz + 1 ! segment_eta allocated yes/no - IF ( ALLOCATED(InData%segment_eta) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! segment_eta upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%segment_eta) ! segment_eta - END IF - Int_BufSz = Int_BufSz + 1 ! member_eta allocated yes/no - IF ( ALLOCATED(InData%member_eta) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! member_eta upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%member_eta) ! member_eta - END IF - Db_BufSz = Db_BufSz + 1 ! blade_length - Db_BufSz = Db_BufSz + 1 ! blade_mass - Db_BufSz = Db_BufSz + SIZE(InData%blade_CG) ! blade_CG - Db_BufSz = Db_BufSz + SIZE(InData%blade_IN) ! blade_IN - Db_BufSz = Db_BufSz + SIZE(InData%beta) ! beta - Db_BufSz = Db_BufSz + 1 ! tol - Int_BufSz = Int_BufSz + 1 ! QPtN allocated yes/no - IF ( ALLOCATED(InData%QPtN) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! QPtN upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%QPtN) ! QPtN - END IF - Int_BufSz = Int_BufSz + 1 ! QPtWeight allocated yes/no - IF ( ALLOCATED(InData%QPtWeight) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! QPtWeight upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%QPtWeight) ! QPtWeight - END IF - Int_BufSz = Int_BufSz + 1 ! Shp allocated yes/no - IF ( ALLOCATED(InData%Shp) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Shp upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Shp) ! Shp - END IF - Int_BufSz = Int_BufSz + 1 ! ShpDer allocated yes/no - IF ( ALLOCATED(InData%ShpDer) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! ShpDer upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%ShpDer) ! ShpDer - END IF - Int_BufSz = Int_BufSz + 1 ! Jacobian allocated yes/no - IF ( ALLOCATED(InData%Jacobian) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Jacobian upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Jacobian) ! Jacobian - END IF - Int_BufSz = Int_BufSz + 1 ! uu0 allocated yes/no - IF ( ALLOCATED(InData%uu0) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! uu0 upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%uu0) ! uu0 - END IF - Int_BufSz = Int_BufSz + 1 ! rrN0 allocated yes/no - IF ( ALLOCATED(InData%rrN0) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! rrN0 upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%rrN0) ! rrN0 - END IF - Int_BufSz = Int_BufSz + 1 ! E10 allocated yes/no - IF ( ALLOCATED(InData%E10) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! E10 upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%E10) ! E10 - END IF - Int_BufSz = Int_BufSz + 1 ! nodes_per_elem - Int_BufSz = Int_BufSz + 1 ! node_elem_idx allocated yes/no - IF ( ALLOCATED(InData%node_elem_idx) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! node_elem_idx upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%node_elem_idx) ! node_elem_idx - END IF - Int_BufSz = Int_BufSz + 1 ! refine - Int_BufSz = Int_BufSz + 1 ! dof_node - Int_BufSz = Int_BufSz + 1 ! dof_elem - Int_BufSz = Int_BufSz + 1 ! rot_elem - Int_BufSz = Int_BufSz + 1 ! elem_total - Int_BufSz = Int_BufSz + 1 ! node_total - Int_BufSz = Int_BufSz + 1 ! dof_total - Int_BufSz = Int_BufSz + 1 ! nqp - Int_BufSz = Int_BufSz + 1 ! analysis_type - Int_BufSz = Int_BufSz + 1 ! damp_flag - Int_BufSz = Int_BufSz + 1 ! ld_retries - Int_BufSz = Int_BufSz + 1 ! niter - Int_BufSz = Int_BufSz + 1 ! quadrature - Int_BufSz = Int_BufSz + 1 ! n_fact - Int_BufSz = Int_BufSz + 1 ! OutInputs - 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 - ! 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 ! NNodeOuts - Int_BufSz = Int_BufSz + SIZE(InData%OutNd) ! OutNd - Int_BufSz = Int_BufSz + 1 ! NdIndx allocated yes/no - IF ( ALLOCATED(InData%NdIndx) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! NdIndx upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%NdIndx) ! NdIndx - END IF - Int_BufSz = Int_BufSz + 1 ! NdIndxInverse allocated yes/no - IF ( ALLOCATED(InData%NdIndxInverse) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! NdIndxInverse upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%NdIndxInverse) ! NdIndxInverse - END IF - Int_BufSz = Int_BufSz + 1 ! OutNd2NdElem allocated yes/no - IF ( ALLOCATED(InData%OutNd2NdElem) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! OutNd2NdElem upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%OutNd2NdElem) ! OutNd2NdElem - END IF - Int_BufSz = Int_BufSz + 1*LEN(InData%OutFmt) ! OutFmt - Int_BufSz = Int_BufSz + 1 ! UsePitchAct - Re_BufSz = Re_BufSz + 1 ! pitchJ - Re_BufSz = Re_BufSz + 1 ! pitchK - Re_BufSz = Re_BufSz + 1 ! pitchC - Re_BufSz = Re_BufSz + SIZE(InData%torqM) ! torqM - Int_BufSz = Int_BufSz + 3 ! qp: size of buffers for each call to pack subtype - CALL BD_Packqpparam( Re_Buf, Db_Buf, Int_Buf, InData%qp, ErrStat2, ErrMsg2, .TRUE. ) ! qp - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! qp - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! qp - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! qp - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! qp_indx_offset - Int_BufSz = Int_BufSz + 1 ! BldMotionNodeLoc - Int_BufSz = Int_BufSz + 1 ! tngt_stf_fd - Int_BufSz = Int_BufSz + 1 ! tngt_stf_comp - Db_BufSz = Db_BufSz + 1 ! tngt_stf_pert - Db_BufSz = Db_BufSz + 1 ! tngt_stf_difftol - Int_BufSz = Int_BufSz + 1 ! BldNd_NumOuts - Int_BufSz = Int_BufSz + 1 ! BldNd_TotNumOuts - Int_BufSz = Int_BufSz + 1 ! BldNd_OutParam allocated yes/no - IF ( ALLOCATED(InData%BldNd_OutParam) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BldNd_OutParam upper/lower bounds for each dimension - DO i1 = LBOUND(InData%BldNd_OutParam,1), UBOUND(InData%BldNd_OutParam,1) - Int_BufSz = Int_BufSz + 3 ! BldNd_OutParam: size of buffers for each call to pack subtype - CALL NWTC_Library_Packoutparmtype( Re_Buf, Db_Buf, Int_Buf, InData%BldNd_OutParam(i1), ErrStat2, ErrMsg2, .TRUE. ) ! BldNd_OutParam - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BldNd_OutParam - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BldNd_OutParam - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BldNd_OutParam - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! BldNd_BlOutNd allocated yes/no - IF ( ALLOCATED(InData%BldNd_BlOutNd) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BldNd_BlOutNd upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%BldNd_BlOutNd) ! BldNd_BlOutNd - END IF - Int_BufSz = Int_BufSz + 1 ! QPtw_Shp_Shp_Jac allocated yes/no - IF ( ALLOCATED(InData%QPtw_Shp_Shp_Jac) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! QPtw_Shp_Shp_Jac upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%QPtw_Shp_Shp_Jac) ! QPtw_Shp_Shp_Jac - END IF - Int_BufSz = Int_BufSz + 1 ! QPtw_Shp_ShpDer allocated yes/no - IF ( ALLOCATED(InData%QPtw_Shp_ShpDer) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! QPtw_Shp_ShpDer upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%QPtw_Shp_ShpDer) ! QPtw_Shp_ShpDer - END IF - Int_BufSz = Int_BufSz + 1 ! QPtw_ShpDer_ShpDer_Jac allocated yes/no - IF ( ALLOCATED(InData%QPtw_ShpDer_ShpDer_Jac) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! QPtw_ShpDer_ShpDer_Jac upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%QPtw_ShpDer_ShpDer_Jac) ! QPtw_ShpDer_ShpDer_Jac - END IF - Int_BufSz = Int_BufSz + 1 ! QPtw_Shp_Jac allocated yes/no - IF ( ALLOCATED(InData%QPtw_Shp_Jac) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! QPtw_Shp_Jac upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%QPtw_Shp_Jac) ! QPtw_Shp_Jac - END IF - Int_BufSz = Int_BufSz + 1 ! QPtw_ShpDer allocated yes/no - IF ( ALLOCATED(InData%QPtw_ShpDer) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! QPtw_ShpDer upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%QPtw_ShpDer) ! QPtw_ShpDer - END IF - Int_BufSz = Int_BufSz + 1 ! FEweight allocated yes/no - IF ( ALLOCATED(InData%FEweight) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! FEweight upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%FEweight) ! FEweight - END IF - 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 - Int_BufSz = Int_BufSz + 1 ! RelStates - 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 i1 = LBOUND(InData%coef,1), UBOUND(InData%coef,1) - DbKiBuf(Db_Xferred) = InData%coef(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DbKiBuf(Db_Xferred) = InData%rhoinf - Db_Xferred = Db_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%uuN0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%uuN0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uuN0,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%uuN0,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uuN0,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%uuN0,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uuN0,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%uuN0,3), UBOUND(InData%uuN0,3) - DO i2 = LBOUND(InData%uuN0,2), UBOUND(InData%uuN0,2) - DO i1 = LBOUND(InData%uuN0,1), UBOUND(InData%uuN0,1) - DbKiBuf(Db_Xferred) = InData%uuN0(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Stif0_QP) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Stif0_QP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Stif0_QP,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Stif0_QP,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Stif0_QP,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Stif0_QP,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Stif0_QP,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Stif0_QP,3), UBOUND(InData%Stif0_QP,3) - DO i2 = LBOUND(InData%Stif0_QP,2), UBOUND(InData%Stif0_QP,2) - DO i1 = LBOUND(InData%Stif0_QP,1), UBOUND(InData%Stif0_QP,1) - DbKiBuf(Db_Xferred) = InData%Stif0_QP(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Mass0_QP) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Mass0_QP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Mass0_QP,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Mass0_QP,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Mass0_QP,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Mass0_QP,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Mass0_QP,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Mass0_QP,3), UBOUND(InData%Mass0_QP,3) - DO i2 = LBOUND(InData%Mass0_QP,2), UBOUND(InData%Mass0_QP,2) - DO i1 = LBOUND(InData%Mass0_QP,1), UBOUND(InData%Mass0_QP,1) - DbKiBuf(Db_Xferred) = InData%Mass0_QP(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - DO i1 = LBOUND(InData%gravity,1), UBOUND(InData%gravity,1) - DbKiBuf(Db_Xferred) = InData%gravity(i1) - Db_Xferred = Db_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%segment_eta) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%segment_eta,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%segment_eta,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%segment_eta,1), UBOUND(InData%segment_eta,1) - DbKiBuf(Db_Xferred) = InData%segment_eta(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%member_eta) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%member_eta,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%member_eta,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%member_eta,1), UBOUND(InData%member_eta,1) - DbKiBuf(Db_Xferred) = InData%member_eta(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - DbKiBuf(Db_Xferred) = InData%blade_length - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%blade_mass - Db_Xferred = Db_Xferred + 1 - DO i1 = LBOUND(InData%blade_CG,1), UBOUND(InData%blade_CG,1) - DbKiBuf(Db_Xferred) = InData%blade_CG(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i2 = LBOUND(InData%blade_IN,2), UBOUND(InData%blade_IN,2) - DO i1 = LBOUND(InData%blade_IN,1), UBOUND(InData%blade_IN,1) - DbKiBuf(Db_Xferred) = InData%blade_IN(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - DO i1 = LBOUND(InData%beta,1), UBOUND(InData%beta,1) - DbKiBuf(Db_Xferred) = InData%beta(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DbKiBuf(Db_Xferred) = InData%tol - Db_Xferred = Db_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%QPtN) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%QPtN,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%QPtN,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%QPtN,1), UBOUND(InData%QPtN,1) - DbKiBuf(Db_Xferred) = InData%QPtN(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%QPtWeight) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%QPtWeight,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%QPtWeight,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%QPtWeight,1), UBOUND(InData%QPtWeight,1) - DbKiBuf(Db_Xferred) = InData%QPtWeight(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Shp) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Shp,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Shp,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Shp,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Shp,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Shp,2), UBOUND(InData%Shp,2) - DO i1 = LBOUND(InData%Shp,1), UBOUND(InData%Shp,1) - DbKiBuf(Db_Xferred) = InData%Shp(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ShpDer) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ShpDer,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ShpDer,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ShpDer,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ShpDer,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%ShpDer,2), UBOUND(InData%ShpDer,2) - DO i1 = LBOUND(InData%ShpDer,1), UBOUND(InData%ShpDer,1) - DbKiBuf(Db_Xferred) = InData%ShpDer(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Jacobian) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Jacobian,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jacobian,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Jacobian,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jacobian,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Jacobian,2), UBOUND(InData%Jacobian,2) - DO i1 = LBOUND(InData%Jacobian,1), UBOUND(InData%Jacobian,1) - DbKiBuf(Db_Xferred) = InData%Jacobian(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%uu0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%uu0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uu0,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%uu0,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uu0,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%uu0,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uu0,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%uu0,3), UBOUND(InData%uu0,3) - DO i2 = LBOUND(InData%uu0,2), UBOUND(InData%uu0,2) - DO i1 = LBOUND(InData%uu0,1), UBOUND(InData%uu0,1) - DbKiBuf(Db_Xferred) = InData%uu0(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%rrN0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rrN0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rrN0,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rrN0,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rrN0,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rrN0,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rrN0,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%rrN0,3), UBOUND(InData%rrN0,3) - DO i2 = LBOUND(InData%rrN0,2), UBOUND(InData%rrN0,2) - DO i1 = LBOUND(InData%rrN0,1), UBOUND(InData%rrN0,1) - DbKiBuf(Db_Xferred) = InData%rrN0(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%E10) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%E10,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%E10,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%E10,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%E10,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%E10,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%E10,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%E10,3), UBOUND(InData%E10,3) - DO i2 = LBOUND(InData%E10,2), UBOUND(InData%E10,2) - DO i1 = LBOUND(InData%E10,1), UBOUND(InData%E10,1) - DbKiBuf(Db_Xferred) = InData%E10(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%nodes_per_elem - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%node_elem_idx) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%node_elem_idx,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%node_elem_idx,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%node_elem_idx,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%node_elem_idx,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%node_elem_idx,2), UBOUND(InData%node_elem_idx,2) - DO i1 = LBOUND(InData%node_elem_idx,1), UBOUND(InData%node_elem_idx,1) - IntKiBuf(Int_Xferred) = InData%node_elem_idx(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%refine - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%dof_node - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%dof_elem - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%rot_elem - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%elem_total - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%node_total - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%dof_total - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nqp - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%analysis_type - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%damp_flag - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%ld_retries - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%niter - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%quadrature - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%n_fact - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%OutInputs, IntKiBuf(1)) - 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 - IntKiBuf(Int_Xferred) = InData%NNodeOuts - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%OutNd,1), UBOUND(InData%OutNd,1) - IntKiBuf(Int_Xferred) = InData%OutNd(i1) - Int_Xferred = Int_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%NdIndx) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%NdIndx,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NdIndx,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%NdIndx,1), UBOUND(InData%NdIndx,1) - IntKiBuf(Int_Xferred) = InData%NdIndx(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%NdIndxInverse) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%NdIndxInverse,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NdIndxInverse,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%NdIndxInverse,1), UBOUND(InData%NdIndxInverse,1) - IntKiBuf(Int_Xferred) = InData%NdIndxInverse(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%OutNd2NdElem) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OutNd2NdElem,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutNd2NdElem,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OutNd2NdElem,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutNd2NdElem,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%OutNd2NdElem,2), UBOUND(InData%OutNd2NdElem,2) - DO i1 = LBOUND(InData%OutNd2NdElem,1), UBOUND(InData%OutNd2NdElem,1) - IntKiBuf(Int_Xferred) = InData%OutNd2NdElem(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - DO I = 1, LEN(InData%OutFmt) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = TRANSFER(InData%UsePitchAct, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%pitchJ - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%pitchK - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%pitchC - Re_Xferred = Re_Xferred + 1 - DO i2 = LBOUND(InData%torqM,2), UBOUND(InData%torqM,2) - DO i1 = LBOUND(InData%torqM,1), UBOUND(InData%torqM,1) - ReKiBuf(Re_Xferred) = InData%torqM(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - CALL BD_Packqpparam( Re_Buf, Db_Buf, Int_Buf, InData%qp, ErrStat2, ErrMsg2, OnlySize ) ! qp - 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%qp_indx_offset - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%BldMotionNodeLoc - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%tngt_stf_fd, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%tngt_stf_comp, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%tngt_stf_pert - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%tngt_stf_difftol - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%BldNd_NumOuts - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%BldNd_TotNumOuts - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%BldNd_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%BldNd_OutParam,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldNd_OutParam,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BldNd_OutParam,1), UBOUND(InData%BldNd_OutParam,1) - CALL NWTC_Library_Packoutparmtype( Re_Buf, Db_Buf, Int_Buf, InData%BldNd_OutParam(i1), ErrStat2, ErrMsg2, OnlySize ) ! BldNd_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%BldNd_BlOutNd) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BldNd_BlOutNd,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldNd_BlOutNd,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BldNd_BlOutNd,1), UBOUND(InData%BldNd_BlOutNd,1) - IntKiBuf(Int_Xferred) = InData%BldNd_BlOutNd(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%QPtw_Shp_Shp_Jac) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%QPtw_Shp_Shp_Jac,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%QPtw_Shp_Shp_Jac,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%QPtw_Shp_Shp_Jac,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%QPtw_Shp_Shp_Jac,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%QPtw_Shp_Shp_Jac,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%QPtw_Shp_Shp_Jac,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%QPtw_Shp_Shp_Jac,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%QPtw_Shp_Shp_Jac,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%QPtw_Shp_Shp_Jac,4), UBOUND(InData%QPtw_Shp_Shp_Jac,4) - DO i3 = LBOUND(InData%QPtw_Shp_Shp_Jac,3), UBOUND(InData%QPtw_Shp_Shp_Jac,3) - DO i2 = LBOUND(InData%QPtw_Shp_Shp_Jac,2), UBOUND(InData%QPtw_Shp_Shp_Jac,2) - DO i1 = LBOUND(InData%QPtw_Shp_Shp_Jac,1), UBOUND(InData%QPtw_Shp_Shp_Jac,1) - DbKiBuf(Db_Xferred) = InData%QPtw_Shp_Shp_Jac(i1,i2,i3,i4) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%QPtw_Shp_ShpDer) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%QPtw_Shp_ShpDer,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%QPtw_Shp_ShpDer,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%QPtw_Shp_ShpDer,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%QPtw_Shp_ShpDer,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%QPtw_Shp_ShpDer,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%QPtw_Shp_ShpDer,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%QPtw_Shp_ShpDer,3), UBOUND(InData%QPtw_Shp_ShpDer,3) - DO i2 = LBOUND(InData%QPtw_Shp_ShpDer,2), UBOUND(InData%QPtw_Shp_ShpDer,2) - DO i1 = LBOUND(InData%QPtw_Shp_ShpDer,1), UBOUND(InData%QPtw_Shp_ShpDer,1) - DbKiBuf(Db_Xferred) = InData%QPtw_Shp_ShpDer(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%QPtw_ShpDer_ShpDer_Jac) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%QPtw_ShpDer_ShpDer_Jac,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%QPtw_ShpDer_ShpDer_Jac,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%QPtw_ShpDer_ShpDer_Jac,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%QPtw_ShpDer_ShpDer_Jac,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%QPtw_ShpDer_ShpDer_Jac,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%QPtw_ShpDer_ShpDer_Jac,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%QPtw_ShpDer_ShpDer_Jac,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%QPtw_ShpDer_ShpDer_Jac,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%QPtw_ShpDer_ShpDer_Jac,4), UBOUND(InData%QPtw_ShpDer_ShpDer_Jac,4) - DO i3 = LBOUND(InData%QPtw_ShpDer_ShpDer_Jac,3), UBOUND(InData%QPtw_ShpDer_ShpDer_Jac,3) - DO i2 = LBOUND(InData%QPtw_ShpDer_ShpDer_Jac,2), UBOUND(InData%QPtw_ShpDer_ShpDer_Jac,2) - DO i1 = LBOUND(InData%QPtw_ShpDer_ShpDer_Jac,1), UBOUND(InData%QPtw_ShpDer_ShpDer_Jac,1) - DbKiBuf(Db_Xferred) = InData%QPtw_ShpDer_ShpDer_Jac(i1,i2,i3,i4) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%QPtw_Shp_Jac) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%QPtw_Shp_Jac,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%QPtw_Shp_Jac,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%QPtw_Shp_Jac,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%QPtw_Shp_Jac,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%QPtw_Shp_Jac,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%QPtw_Shp_Jac,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%QPtw_Shp_Jac,3), UBOUND(InData%QPtw_Shp_Jac,3) - DO i2 = LBOUND(InData%QPtw_Shp_Jac,2), UBOUND(InData%QPtw_Shp_Jac,2) - DO i1 = LBOUND(InData%QPtw_Shp_Jac,1), UBOUND(InData%QPtw_Shp_Jac,1) - DbKiBuf(Db_Xferred) = InData%QPtw_Shp_Jac(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%QPtw_ShpDer) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%QPtw_ShpDer,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%QPtw_ShpDer,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%QPtw_ShpDer,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%QPtw_ShpDer,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%QPtw_ShpDer,2), UBOUND(InData%QPtw_ShpDer,2) - DO i1 = LBOUND(InData%QPtw_ShpDer,1), UBOUND(InData%QPtw_ShpDer,1) - DbKiBuf(Db_Xferred) = InData%QPtw_ShpDer(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%FEweight) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FEweight,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FEweight,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FEweight,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FEweight,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%FEweight,2), UBOUND(InData%FEweight,2) - DO i1 = LBOUND(InData%FEweight,1), UBOUND(InData%FEweight,1) - DbKiBuf(Db_Xferred) = InData%FEweight(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - 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 - IntKiBuf(Int_Xferred) = TRANSFER(InData%RelStates, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE BD_PackParam - - SUBROUTINE BD_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(BD_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) :: 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 = 'BD_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 - i1_l = LBOUND(OutData%coef,1) - i1_u = UBOUND(OutData%coef,1) - DO i1 = LBOUND(OutData%coef,1), UBOUND(OutData%coef,1) - OutData%coef(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - OutData%rhoinf = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! uuN0 not allocated - Int_Xferred = Int_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%uuN0)) DEALLOCATE(OutData%uuN0) - ALLOCATE(OutData%uuN0(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%uuN0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%uuN0,3), UBOUND(OutData%uuN0,3) - DO i2 = LBOUND(OutData%uuN0,2), UBOUND(OutData%uuN0,2) - DO i1 = LBOUND(OutData%uuN0,1), UBOUND(OutData%uuN0,1) - OutData%uuN0(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Stif0_QP not allocated - Int_Xferred = Int_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%Stif0_QP)) DEALLOCATE(OutData%Stif0_QP) - ALLOCATE(OutData%Stif0_QP(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%Stif0_QP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Stif0_QP,3), UBOUND(OutData%Stif0_QP,3) - DO i2 = LBOUND(OutData%Stif0_QP,2), UBOUND(OutData%Stif0_QP,2) - DO i1 = LBOUND(OutData%Stif0_QP,1), UBOUND(OutData%Stif0_QP,1) - OutData%Stif0_QP(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Mass0_QP not allocated - Int_Xferred = Int_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%Mass0_QP)) DEALLOCATE(OutData%Mass0_QP) - ALLOCATE(OutData%Mass0_QP(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%Mass0_QP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Mass0_QP,3), UBOUND(OutData%Mass0_QP,3) - DO i2 = LBOUND(OutData%Mass0_QP,2), UBOUND(OutData%Mass0_QP,2) - DO i1 = LBOUND(OutData%Mass0_QP,1), UBOUND(OutData%Mass0_QP,1) - OutData%Mass0_QP(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - 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) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! segment_eta not allocated - Int_Xferred = Int_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%segment_eta)) DEALLOCATE(OutData%segment_eta) - ALLOCATE(OutData%segment_eta(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%segment_eta.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%segment_eta,1), UBOUND(OutData%segment_eta,1) - OutData%segment_eta(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! member_eta not allocated - Int_Xferred = Int_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%member_eta)) DEALLOCATE(OutData%member_eta) - ALLOCATE(OutData%member_eta(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%member_eta.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%member_eta,1), UBOUND(OutData%member_eta,1) - OutData%member_eta(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - OutData%blade_length = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%blade_mass = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - i1_l = LBOUND(OutData%blade_CG,1) - i1_u = UBOUND(OutData%blade_CG,1) - DO i1 = LBOUND(OutData%blade_CG,1), UBOUND(OutData%blade_CG,1) - OutData%blade_CG(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%blade_IN,1) - i1_u = UBOUND(OutData%blade_IN,1) - i2_l = LBOUND(OutData%blade_IN,2) - i2_u = UBOUND(OutData%blade_IN,2) - DO i2 = LBOUND(OutData%blade_IN,2), UBOUND(OutData%blade_IN,2) - DO i1 = LBOUND(OutData%blade_IN,1), UBOUND(OutData%blade_IN,1) - OutData%blade_IN(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%beta,1) - i1_u = UBOUND(OutData%beta,1) - DO i1 = LBOUND(OutData%beta,1), UBOUND(OutData%beta,1) - OutData%beta(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - OutData%tol = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! QPtN not allocated - Int_Xferred = Int_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%QPtN)) DEALLOCATE(OutData%QPtN) - ALLOCATE(OutData%QPtN(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%QPtN.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%QPtN,1), UBOUND(OutData%QPtN,1) - OutData%QPtN(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! QPtWeight not allocated - Int_Xferred = Int_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%QPtWeight)) DEALLOCATE(OutData%QPtWeight) - ALLOCATE(OutData%QPtWeight(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%QPtWeight.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%QPtWeight,1), UBOUND(OutData%QPtWeight,1) - OutData%QPtWeight(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Shp not allocated - Int_Xferred = Int_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%Shp)) DEALLOCATE(OutData%Shp) - ALLOCATE(OutData%Shp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Shp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Shp,2), UBOUND(OutData%Shp,2) - DO i1 = LBOUND(OutData%Shp,1), UBOUND(OutData%Shp,1) - OutData%Shp(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ShpDer not allocated - Int_Xferred = Int_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%ShpDer)) DEALLOCATE(OutData%ShpDer) - ALLOCATE(OutData%ShpDer(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ShpDer.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%ShpDer,2), UBOUND(OutData%ShpDer,2) - DO i1 = LBOUND(OutData%ShpDer,1), UBOUND(OutData%ShpDer,1) - OutData%ShpDer(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Jacobian not allocated - Int_Xferred = Int_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%Jacobian)) DEALLOCATE(OutData%Jacobian) - ALLOCATE(OutData%Jacobian(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jacobian.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Jacobian,2), UBOUND(OutData%Jacobian,2) - DO i1 = LBOUND(OutData%Jacobian,1), UBOUND(OutData%Jacobian,1) - OutData%Jacobian(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! uu0 not allocated - Int_Xferred = Int_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%uu0)) DEALLOCATE(OutData%uu0) - ALLOCATE(OutData%uu0(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%uu0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%uu0,3), UBOUND(OutData%uu0,3) - DO i2 = LBOUND(OutData%uu0,2), UBOUND(OutData%uu0,2) - DO i1 = LBOUND(OutData%uu0,1), UBOUND(OutData%uu0,1) - OutData%uu0(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rrN0 not allocated - Int_Xferred = Int_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%rrN0)) DEALLOCATE(OutData%rrN0) - ALLOCATE(OutData%rrN0(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%rrN0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%rrN0,3), UBOUND(OutData%rrN0,3) - DO i2 = LBOUND(OutData%rrN0,2), UBOUND(OutData%rrN0,2) - DO i1 = LBOUND(OutData%rrN0,1), UBOUND(OutData%rrN0,1) - OutData%rrN0(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! E10 not allocated - Int_Xferred = Int_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%E10)) DEALLOCATE(OutData%E10) - ALLOCATE(OutData%E10(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%E10.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%E10,3), UBOUND(OutData%E10,3) - DO i2 = LBOUND(OutData%E10,2), UBOUND(OutData%E10,2) - DO i1 = LBOUND(OutData%E10,1), UBOUND(OutData%E10,1) - OutData%E10(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - OutData%nodes_per_elem = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! node_elem_idx not allocated - Int_Xferred = Int_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%node_elem_idx)) DEALLOCATE(OutData%node_elem_idx) - ALLOCATE(OutData%node_elem_idx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%node_elem_idx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%node_elem_idx,2), UBOUND(OutData%node_elem_idx,2) - DO i1 = LBOUND(OutData%node_elem_idx,1), UBOUND(OutData%node_elem_idx,1) - OutData%node_elem_idx(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - OutData%refine = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%dof_node = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%dof_elem = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%rot_elem = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%elem_total = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%node_total = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%dof_total = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nqp = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%analysis_type = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%damp_flag = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%ld_retries = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%niter = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%quadrature = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%n_fact = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%OutInputs = TRANSFER(IntKiBuf(Int_Xferred), OutData%OutInputs) - 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 - OutData%NNodeOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%OutNd,1) - i1_u = UBOUND(OutData%OutNd,1) - DO i1 = LBOUND(OutData%OutNd,1), UBOUND(OutData%OutNd,1) - OutData%OutNd(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NdIndx not allocated - Int_Xferred = Int_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%NdIndx)) DEALLOCATE(OutData%NdIndx) - ALLOCATE(OutData%NdIndx(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NdIndx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%NdIndx,1), UBOUND(OutData%NdIndx,1) - OutData%NdIndx(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NdIndxInverse not allocated - Int_Xferred = Int_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%NdIndxInverse)) DEALLOCATE(OutData%NdIndxInverse) - ALLOCATE(OutData%NdIndxInverse(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NdIndxInverse.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%NdIndxInverse,1), UBOUND(OutData%NdIndxInverse,1) - OutData%NdIndxInverse(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutNd2NdElem not allocated - Int_Xferred = Int_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%OutNd2NdElem)) DEALLOCATE(OutData%OutNd2NdElem) - ALLOCATE(OutData%OutNd2NdElem(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutNd2NdElem.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%OutNd2NdElem,2), UBOUND(OutData%OutNd2NdElem,2) - DO i1 = LBOUND(OutData%OutNd2NdElem,1), UBOUND(OutData%OutNd2NdElem,1) - OutData%OutNd2NdElem(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - DO I = 1, LEN(OutData%OutFmt) - OutData%OutFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%UsePitchAct = TRANSFER(IntKiBuf(Int_Xferred), OutData%UsePitchAct) - Int_Xferred = Int_Xferred + 1 - OutData%pitchJ = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%pitchK = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%pitchC = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%torqM,1) - i1_u = UBOUND(OutData%torqM,1) - i2_l = LBOUND(OutData%torqM,2) - i2_u = UBOUND(OutData%torqM,2) - DO i2 = LBOUND(OutData%torqM,2), UBOUND(OutData%torqM,2) - DO i1 = LBOUND(OutData%torqM,1), UBOUND(OutData%torqM,1) - OutData%torqM(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - 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 BD_Unpackqpparam( Re_Buf, Db_Buf, Int_Buf, OutData%qp, ErrStat2, ErrMsg2 ) ! qp - 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%qp_indx_offset = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%BldMotionNodeLoc = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%tngt_stf_fd = TRANSFER(IntKiBuf(Int_Xferred), OutData%tngt_stf_fd) - Int_Xferred = Int_Xferred + 1 - OutData%tngt_stf_comp = TRANSFER(IntKiBuf(Int_Xferred), OutData%tngt_stf_comp) - Int_Xferred = Int_Xferred + 1 - OutData%tngt_stf_pert = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%tngt_stf_difftol = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%BldNd_NumOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%BldNd_TotNumOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldNd_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%BldNd_OutParam)) DEALLOCATE(OutData%BldNd_OutParam) - ALLOCATE(OutData%BldNd_OutParam(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldNd_OutParam.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BldNd_OutParam,1), UBOUND(OutData%BldNd_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%BldNd_OutParam(i1), ErrStat2, ErrMsg2 ) ! BldNd_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 ! BldNd_BlOutNd not allocated - Int_Xferred = Int_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%BldNd_BlOutNd)) DEALLOCATE(OutData%BldNd_BlOutNd) - ALLOCATE(OutData%BldNd_BlOutNd(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldNd_BlOutNd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BldNd_BlOutNd,1), UBOUND(OutData%BldNd_BlOutNd,1) - OutData%BldNd_BlOutNd(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! QPtw_Shp_Shp_Jac not allocated - Int_Xferred = Int_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%QPtw_Shp_Shp_Jac)) DEALLOCATE(OutData%QPtw_Shp_Shp_Jac) - ALLOCATE(OutData%QPtw_Shp_Shp_Jac(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%QPtw_Shp_Shp_Jac.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%QPtw_Shp_Shp_Jac,4), UBOUND(OutData%QPtw_Shp_Shp_Jac,4) - DO i3 = LBOUND(OutData%QPtw_Shp_Shp_Jac,3), UBOUND(OutData%QPtw_Shp_Shp_Jac,3) - DO i2 = LBOUND(OutData%QPtw_Shp_Shp_Jac,2), UBOUND(OutData%QPtw_Shp_Shp_Jac,2) - DO i1 = LBOUND(OutData%QPtw_Shp_Shp_Jac,1), UBOUND(OutData%QPtw_Shp_Shp_Jac,1) - OutData%QPtw_Shp_Shp_Jac(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 ! QPtw_Shp_ShpDer not allocated - Int_Xferred = Int_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%QPtw_Shp_ShpDer)) DEALLOCATE(OutData%QPtw_Shp_ShpDer) - ALLOCATE(OutData%QPtw_Shp_ShpDer(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%QPtw_Shp_ShpDer.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%QPtw_Shp_ShpDer,3), UBOUND(OutData%QPtw_Shp_ShpDer,3) - DO i2 = LBOUND(OutData%QPtw_Shp_ShpDer,2), UBOUND(OutData%QPtw_Shp_ShpDer,2) - DO i1 = LBOUND(OutData%QPtw_Shp_ShpDer,1), UBOUND(OutData%QPtw_Shp_ShpDer,1) - OutData%QPtw_Shp_ShpDer(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! QPtw_ShpDer_ShpDer_Jac not allocated - Int_Xferred = Int_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%QPtw_ShpDer_ShpDer_Jac)) DEALLOCATE(OutData%QPtw_ShpDer_ShpDer_Jac) - ALLOCATE(OutData%QPtw_ShpDer_ShpDer_Jac(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%QPtw_ShpDer_ShpDer_Jac.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%QPtw_ShpDer_ShpDer_Jac,4), UBOUND(OutData%QPtw_ShpDer_ShpDer_Jac,4) - DO i3 = LBOUND(OutData%QPtw_ShpDer_ShpDer_Jac,3), UBOUND(OutData%QPtw_ShpDer_ShpDer_Jac,3) - DO i2 = LBOUND(OutData%QPtw_ShpDer_ShpDer_Jac,2), UBOUND(OutData%QPtw_ShpDer_ShpDer_Jac,2) - DO i1 = LBOUND(OutData%QPtw_ShpDer_ShpDer_Jac,1), UBOUND(OutData%QPtw_ShpDer_ShpDer_Jac,1) - OutData%QPtw_ShpDer_ShpDer_Jac(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 ! QPtw_Shp_Jac not allocated - Int_Xferred = Int_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%QPtw_Shp_Jac)) DEALLOCATE(OutData%QPtw_Shp_Jac) - ALLOCATE(OutData%QPtw_Shp_Jac(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%QPtw_Shp_Jac.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%QPtw_Shp_Jac,3), UBOUND(OutData%QPtw_Shp_Jac,3) - DO i2 = LBOUND(OutData%QPtw_Shp_Jac,2), UBOUND(OutData%QPtw_Shp_Jac,2) - DO i1 = LBOUND(OutData%QPtw_Shp_Jac,1), UBOUND(OutData%QPtw_Shp_Jac,1) - OutData%QPtw_Shp_Jac(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! QPtw_ShpDer not allocated - Int_Xferred = Int_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%QPtw_ShpDer)) DEALLOCATE(OutData%QPtw_ShpDer) - ALLOCATE(OutData%QPtw_ShpDer(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%QPtw_ShpDer.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%QPtw_ShpDer,2), UBOUND(OutData%QPtw_ShpDer,2) - DO i1 = LBOUND(OutData%QPtw_ShpDer,1), UBOUND(OutData%QPtw_ShpDer,1) - OutData%QPtw_ShpDer(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FEweight not allocated - Int_Xferred = Int_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%FEweight)) DEALLOCATE(OutData%FEweight) - ALLOCATE(OutData%FEweight(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FEweight.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%FEweight,2), UBOUND(OutData%FEweight,2) - DO i1 = LBOUND(OutData%FEweight,1), UBOUND(OutData%FEweight,1) - OutData%FEweight(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - 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 - OutData%RelStates = TRANSFER(IntKiBuf(Int_Xferred), OutData%RelStates) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE BD_UnPackParam - - SUBROUTINE BD_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(BD_InputType), INTENT(INOUT) :: SrcInputData - TYPE(BD_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 = 'BD_CopyInput' -! + ErrMsg = '' + if (allocated(SrcContStateData%q)) then + LB(1:2) = lbound(SrcContStateData%q) + UB(1:2) = ubound(SrcContStateData%q) + if (.not. allocated(DstContStateData%q)) then + allocate(DstContStateData%q(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%q.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstContStateData%q = SrcContStateData%q + end if + if (allocated(SrcContStateData%dqdt)) then + LB(1:2) = lbound(SrcContStateData%dqdt) + UB(1:2) = ubound(SrcContStateData%dqdt) + if (.not. allocated(DstContStateData%dqdt)) then + allocate(DstContStateData%dqdt(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%dqdt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstContStateData%dqdt = SrcContStateData%dqdt + end if +end subroutine + +subroutine BD_DestroyContState(ContStateData, ErrStat, ErrMsg) + type(BD_ContinuousStateType), intent(inout) :: ContStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'BD_DestroyContState' ErrStat = ErrID_None - ErrMsg = "" - CALL MeshCopy( SrcInputData%RootMotion, DstInputData%RootMotion, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcInputData%PointLoad, DstInputData%PointLoad, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcInputData%DistrLoad, DstInputData%DistrLoad, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcInputData%HubMotion, DstInputData%HubMotion, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE BD_CopyInput - - SUBROUTINE BD_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(BD_InputType), INTENT(INOUT) :: InputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BD_DestroyInput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL MeshDestroy( InputData%RootMotion, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( InputData%PointLoad, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( InputData%DistrLoad, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( InputData%HubMotion, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE BD_DestroyInput - - SUBROUTINE BD_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(BD_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 = 'BD_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 ! RootMotion: size of buffers for each call to pack subtype - CALL MeshPack( InData%RootMotion, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! RootMotion - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! RootMotion - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! RootMotion - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! RootMotion - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! PointLoad: size of buffers for each call to pack subtype - CALL MeshPack( InData%PointLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! PointLoad - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! PointLoad - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! PointLoad - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! PointLoad - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! DistrLoad: size of buffers for each call to pack subtype - CALL MeshPack( InData%DistrLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! DistrLoad - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! DistrLoad - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! DistrLoad - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! DistrLoad - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! HubMotion: size of buffers for each call to pack subtype - CALL MeshPack( InData%HubMotion, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! HubMotion - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! HubMotion - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! HubMotion - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! HubMotion - 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%RootMotion, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! RootMotion - 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%PointLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! PointLoad - 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%DistrLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! DistrLoad - 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%HubMotion, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! HubMotion - 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 BD_PackInput - - SUBROUTINE BD_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(BD_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 = 'BD_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%RootMotion, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! RootMotion - 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%PointLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! PointLoad - 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%DistrLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! DistrLoad - 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%HubMotion, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! HubMotion - 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 BD_UnPackInput - - SUBROUTINE BD_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(BD_OutputType), INTENT(INOUT) :: SrcOutputData - TYPE(BD_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 = 'BD_CopyOutput' -! + ErrMsg = '' + if (allocated(ContStateData%q)) then + deallocate(ContStateData%q) + end if + if (allocated(ContStateData%dqdt)) then + deallocate(ContStateData%dqdt) + end if +end subroutine + +subroutine BD_PackContState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(BD_ContinuousStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'BD_PackContState' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%q) + call RegPackAlloc(RF, InData%dqdt) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine BD_UnPackContState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(BD_ContinuousStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'BD_UnPackContState' + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%q); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dqdt); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine BD_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) + type(BD_DiscreteStateType), intent(in) :: SrcDiscStateData + type(BD_DiscreteStateType), intent(inout) :: DstDiscStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'BD_CopyDiscState' ErrStat = ErrID_None - ErrMsg = "" - CALL MeshCopy( SrcOutputData%ReactionForce, DstOutputData%ReactionForce, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcOutputData%BldMotion, DstOutputData%BldMotion, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstOutputData%RootMxr = SrcOutputData%RootMxr - DstOutputData%RootMyr = SrcOutputData%RootMyr -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 BD_CopyOutput - - SUBROUTINE BD_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(BD_OutputType), INTENT(INOUT) :: OutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BD_DestroyOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL MeshDestroy( OutputData%ReactionForce, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( OutputData%BldMotion, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(OutputData%WriteOutput)) THEN - DEALLOCATE(OutputData%WriteOutput) -ENDIF - END SUBROUTINE BD_DestroyOutput - - SUBROUTINE BD_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(BD_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 = 'BD_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 ! ReactionForce: size of buffers for each call to pack subtype - CALL MeshPack( InData%ReactionForce, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! ReactionForce - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! ReactionForce - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! ReactionForce - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! ReactionForce - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! BldMotion: size of buffers for each call to pack subtype - CALL MeshPack( InData%BldMotion, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! BldMotion - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BldMotion - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BldMotion - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BldMotion - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Re_BufSz = Re_BufSz + 1 ! RootMxr - Re_BufSz = Re_BufSz + 1 ! RootMyr - 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%ReactionForce, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! ReactionForce - 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%BldMotion, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! BldMotion - 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 - ReKiBuf(Re_Xferred) = InData%RootMxr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RootMyr - 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 - - 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 BD_PackOutput - - SUBROUTINE BD_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(BD_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 = 'BD_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%ReactionForce, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! ReactionForce - 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%BldMotion, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! BldMotion - 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%RootMxr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RootMyr = 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 - 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 BD_UnPackOutput - - SUBROUTINE BD_CopyEqMotionQP( SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, ErrStat, ErrMsg ) - TYPE(EqMotionQP), INTENT(IN) :: SrcEqMotionQPData - TYPE(EqMotionQP), INTENT(INOUT) :: DstEqMotionQPData - 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 = 'BD_CopyEqMotionQP' -! + ErrMsg = '' + DstDiscStateData%thetaP = SrcDiscStateData%thetaP + DstDiscStateData%thetaPD = SrcDiscStateData%thetaPD +end subroutine + +subroutine BD_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) + type(BD_DiscreteStateType), intent(inout) :: DiscStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'BD_DestroyDiscState' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcEqMotionQPData%uuu)) THEN - i1_l = LBOUND(SrcEqMotionQPData%uuu,1) - i1_u = UBOUND(SrcEqMotionQPData%uuu,1) - i2_l = LBOUND(SrcEqMotionQPData%uuu,2) - i2_u = UBOUND(SrcEqMotionQPData%uuu,2) - i3_l = LBOUND(SrcEqMotionQPData%uuu,3) - i3_u = UBOUND(SrcEqMotionQPData%uuu,3) - IF (.NOT. ALLOCATED(DstEqMotionQPData%uuu)) THEN - ALLOCATE(DstEqMotionQPData%uuu(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%uuu.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstEqMotionQPData%uuu = SrcEqMotionQPData%uuu -ENDIF -IF (ALLOCATED(SrcEqMotionQPData%uup)) THEN - i1_l = LBOUND(SrcEqMotionQPData%uup,1) - i1_u = UBOUND(SrcEqMotionQPData%uup,1) - i2_l = LBOUND(SrcEqMotionQPData%uup,2) - i2_u = UBOUND(SrcEqMotionQPData%uup,2) - i3_l = LBOUND(SrcEqMotionQPData%uup,3) - i3_u = UBOUND(SrcEqMotionQPData%uup,3) - IF (.NOT. ALLOCATED(DstEqMotionQPData%uup)) THEN - ALLOCATE(DstEqMotionQPData%uup(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%uup.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstEqMotionQPData%uup = SrcEqMotionQPData%uup -ENDIF -IF (ALLOCATED(SrcEqMotionQPData%vvv)) THEN - i1_l = LBOUND(SrcEqMotionQPData%vvv,1) - i1_u = UBOUND(SrcEqMotionQPData%vvv,1) - i2_l = LBOUND(SrcEqMotionQPData%vvv,2) - i2_u = UBOUND(SrcEqMotionQPData%vvv,2) - i3_l = LBOUND(SrcEqMotionQPData%vvv,3) - i3_u = UBOUND(SrcEqMotionQPData%vvv,3) - IF (.NOT. ALLOCATED(DstEqMotionQPData%vvv)) THEN - ALLOCATE(DstEqMotionQPData%vvv(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%vvv.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstEqMotionQPData%vvv = SrcEqMotionQPData%vvv -ENDIF -IF (ALLOCATED(SrcEqMotionQPData%vvp)) THEN - i1_l = LBOUND(SrcEqMotionQPData%vvp,1) - i1_u = UBOUND(SrcEqMotionQPData%vvp,1) - i2_l = LBOUND(SrcEqMotionQPData%vvp,2) - i2_u = UBOUND(SrcEqMotionQPData%vvp,2) - i3_l = LBOUND(SrcEqMotionQPData%vvp,3) - i3_u = UBOUND(SrcEqMotionQPData%vvp,3) - IF (.NOT. ALLOCATED(DstEqMotionQPData%vvp)) THEN - ALLOCATE(DstEqMotionQPData%vvp(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%vvp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstEqMotionQPData%vvp = SrcEqMotionQPData%vvp -ENDIF -IF (ALLOCATED(SrcEqMotionQPData%aaa)) THEN - i1_l = LBOUND(SrcEqMotionQPData%aaa,1) - i1_u = UBOUND(SrcEqMotionQPData%aaa,1) - i2_l = LBOUND(SrcEqMotionQPData%aaa,2) - i2_u = UBOUND(SrcEqMotionQPData%aaa,2) - i3_l = LBOUND(SrcEqMotionQPData%aaa,3) - i3_u = UBOUND(SrcEqMotionQPData%aaa,3) - IF (.NOT. ALLOCATED(DstEqMotionQPData%aaa)) THEN - ALLOCATE(DstEqMotionQPData%aaa(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%aaa.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstEqMotionQPData%aaa = SrcEqMotionQPData%aaa -ENDIF -IF (ALLOCATED(SrcEqMotionQPData%RR0)) THEN - i1_l = LBOUND(SrcEqMotionQPData%RR0,1) - i1_u = UBOUND(SrcEqMotionQPData%RR0,1) - i2_l = LBOUND(SrcEqMotionQPData%RR0,2) - i2_u = UBOUND(SrcEqMotionQPData%RR0,2) - i3_l = LBOUND(SrcEqMotionQPData%RR0,3) - i3_u = UBOUND(SrcEqMotionQPData%RR0,3) - i4_l = LBOUND(SrcEqMotionQPData%RR0,4) - i4_u = UBOUND(SrcEqMotionQPData%RR0,4) - IF (.NOT. ALLOCATED(DstEqMotionQPData%RR0)) THEN - ALLOCATE(DstEqMotionQPData%RR0(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 DstEqMotionQPData%RR0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstEqMotionQPData%RR0 = SrcEqMotionQPData%RR0 -ENDIF -IF (ALLOCATED(SrcEqMotionQPData%kappa)) THEN - i1_l = LBOUND(SrcEqMotionQPData%kappa,1) - i1_u = UBOUND(SrcEqMotionQPData%kappa,1) - i2_l = LBOUND(SrcEqMotionQPData%kappa,2) - i2_u = UBOUND(SrcEqMotionQPData%kappa,2) - i3_l = LBOUND(SrcEqMotionQPData%kappa,3) - i3_u = UBOUND(SrcEqMotionQPData%kappa,3) - IF (.NOT. ALLOCATED(DstEqMotionQPData%kappa)) THEN - ALLOCATE(DstEqMotionQPData%kappa(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%kappa.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstEqMotionQPData%kappa = SrcEqMotionQPData%kappa -ENDIF -IF (ALLOCATED(SrcEqMotionQPData%E1)) THEN - i1_l = LBOUND(SrcEqMotionQPData%E1,1) - i1_u = UBOUND(SrcEqMotionQPData%E1,1) - i2_l = LBOUND(SrcEqMotionQPData%E1,2) - i2_u = UBOUND(SrcEqMotionQPData%E1,2) - i3_l = LBOUND(SrcEqMotionQPData%E1,3) - i3_u = UBOUND(SrcEqMotionQPData%E1,3) - IF (.NOT. ALLOCATED(DstEqMotionQPData%E1)) THEN - ALLOCATE(DstEqMotionQPData%E1(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%E1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstEqMotionQPData%E1 = SrcEqMotionQPData%E1 -ENDIF -IF (ALLOCATED(SrcEqMotionQPData%Stif)) THEN - i1_l = LBOUND(SrcEqMotionQPData%Stif,1) - i1_u = UBOUND(SrcEqMotionQPData%Stif,1) - i2_l = LBOUND(SrcEqMotionQPData%Stif,2) - i2_u = UBOUND(SrcEqMotionQPData%Stif,2) - i3_l = LBOUND(SrcEqMotionQPData%Stif,3) - i3_u = UBOUND(SrcEqMotionQPData%Stif,3) - i4_l = LBOUND(SrcEqMotionQPData%Stif,4) - i4_u = UBOUND(SrcEqMotionQPData%Stif,4) - IF (.NOT. ALLOCATED(DstEqMotionQPData%Stif)) THEN - ALLOCATE(DstEqMotionQPData%Stif(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 DstEqMotionQPData%Stif.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstEqMotionQPData%Stif = SrcEqMotionQPData%Stif -ENDIF -IF (ALLOCATED(SrcEqMotionQPData%Fb)) THEN - i1_l = LBOUND(SrcEqMotionQPData%Fb,1) - i1_u = UBOUND(SrcEqMotionQPData%Fb,1) - i2_l = LBOUND(SrcEqMotionQPData%Fb,2) - i2_u = UBOUND(SrcEqMotionQPData%Fb,2) - i3_l = LBOUND(SrcEqMotionQPData%Fb,3) - i3_u = UBOUND(SrcEqMotionQPData%Fb,3) - IF (.NOT. ALLOCATED(DstEqMotionQPData%Fb)) THEN - ALLOCATE(DstEqMotionQPData%Fb(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%Fb.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstEqMotionQPData%Fb = SrcEqMotionQPData%Fb -ENDIF -IF (ALLOCATED(SrcEqMotionQPData%Fc)) THEN - i1_l = LBOUND(SrcEqMotionQPData%Fc,1) - i1_u = UBOUND(SrcEqMotionQPData%Fc,1) - i2_l = LBOUND(SrcEqMotionQPData%Fc,2) - i2_u = UBOUND(SrcEqMotionQPData%Fc,2) - i3_l = LBOUND(SrcEqMotionQPData%Fc,3) - i3_u = UBOUND(SrcEqMotionQPData%Fc,3) - IF (.NOT. ALLOCATED(DstEqMotionQPData%Fc)) THEN - ALLOCATE(DstEqMotionQPData%Fc(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%Fc.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstEqMotionQPData%Fc = SrcEqMotionQPData%Fc -ENDIF -IF (ALLOCATED(SrcEqMotionQPData%Fd)) THEN - i1_l = LBOUND(SrcEqMotionQPData%Fd,1) - i1_u = UBOUND(SrcEqMotionQPData%Fd,1) - i2_l = LBOUND(SrcEqMotionQPData%Fd,2) - i2_u = UBOUND(SrcEqMotionQPData%Fd,2) - i3_l = LBOUND(SrcEqMotionQPData%Fd,3) - i3_u = UBOUND(SrcEqMotionQPData%Fd,3) - IF (.NOT. ALLOCATED(DstEqMotionQPData%Fd)) THEN - ALLOCATE(DstEqMotionQPData%Fd(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%Fd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstEqMotionQPData%Fd = SrcEqMotionQPData%Fd -ENDIF -IF (ALLOCATED(SrcEqMotionQPData%Fg)) THEN - i1_l = LBOUND(SrcEqMotionQPData%Fg,1) - i1_u = UBOUND(SrcEqMotionQPData%Fg,1) - i2_l = LBOUND(SrcEqMotionQPData%Fg,2) - i2_u = UBOUND(SrcEqMotionQPData%Fg,2) - i3_l = LBOUND(SrcEqMotionQPData%Fg,3) - i3_u = UBOUND(SrcEqMotionQPData%Fg,3) - IF (.NOT. ALLOCATED(DstEqMotionQPData%Fg)) THEN - ALLOCATE(DstEqMotionQPData%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 DstEqMotionQPData%Fg.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstEqMotionQPData%Fg = SrcEqMotionQPData%Fg -ENDIF -IF (ALLOCATED(SrcEqMotionQPData%Fi)) THEN - i1_l = LBOUND(SrcEqMotionQPData%Fi,1) - i1_u = UBOUND(SrcEqMotionQPData%Fi,1) - i2_l = LBOUND(SrcEqMotionQPData%Fi,2) - i2_u = UBOUND(SrcEqMotionQPData%Fi,2) - i3_l = LBOUND(SrcEqMotionQPData%Fi,3) - i3_u = UBOUND(SrcEqMotionQPData%Fi,3) - IF (.NOT. ALLOCATED(DstEqMotionQPData%Fi)) THEN - ALLOCATE(DstEqMotionQPData%Fi(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%Fi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstEqMotionQPData%Fi = SrcEqMotionQPData%Fi -ENDIF -IF (ALLOCATED(SrcEqMotionQPData%Ftemp)) THEN - i1_l = LBOUND(SrcEqMotionQPData%Ftemp,1) - i1_u = UBOUND(SrcEqMotionQPData%Ftemp,1) - i2_l = LBOUND(SrcEqMotionQPData%Ftemp,2) - i2_u = UBOUND(SrcEqMotionQPData%Ftemp,2) - i3_l = LBOUND(SrcEqMotionQPData%Ftemp,3) - i3_u = UBOUND(SrcEqMotionQPData%Ftemp,3) - IF (.NOT. ALLOCATED(DstEqMotionQPData%Ftemp)) THEN - ALLOCATE(DstEqMotionQPData%Ftemp(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%Ftemp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstEqMotionQPData%Ftemp = SrcEqMotionQPData%Ftemp -ENDIF -IF (ALLOCATED(SrcEqMotionQPData%RR0mEta)) THEN - i1_l = LBOUND(SrcEqMotionQPData%RR0mEta,1) - i1_u = UBOUND(SrcEqMotionQPData%RR0mEta,1) - i2_l = LBOUND(SrcEqMotionQPData%RR0mEta,2) - i2_u = UBOUND(SrcEqMotionQPData%RR0mEta,2) - i3_l = LBOUND(SrcEqMotionQPData%RR0mEta,3) - i3_u = UBOUND(SrcEqMotionQPData%RR0mEta,3) - IF (.NOT. ALLOCATED(DstEqMotionQPData%RR0mEta)) THEN - ALLOCATE(DstEqMotionQPData%RR0mEta(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%RR0mEta.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstEqMotionQPData%RR0mEta = SrcEqMotionQPData%RR0mEta -ENDIF -IF (ALLOCATED(SrcEqMotionQPData%rho)) THEN - i1_l = LBOUND(SrcEqMotionQPData%rho,1) - i1_u = UBOUND(SrcEqMotionQPData%rho,1) - i2_l = LBOUND(SrcEqMotionQPData%rho,2) - i2_u = UBOUND(SrcEqMotionQPData%rho,2) - i3_l = LBOUND(SrcEqMotionQPData%rho,3) - i3_u = UBOUND(SrcEqMotionQPData%rho,3) - i4_l = LBOUND(SrcEqMotionQPData%rho,4) - i4_u = UBOUND(SrcEqMotionQPData%rho,4) - IF (.NOT. ALLOCATED(DstEqMotionQPData%rho)) THEN - ALLOCATE(DstEqMotionQPData%rho(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 DstEqMotionQPData%rho.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstEqMotionQPData%rho = SrcEqMotionQPData%rho -ENDIF -IF (ALLOCATED(SrcEqMotionQPData%betaC)) THEN - i1_l = LBOUND(SrcEqMotionQPData%betaC,1) - i1_u = UBOUND(SrcEqMotionQPData%betaC,1) - i2_l = LBOUND(SrcEqMotionQPData%betaC,2) - i2_u = UBOUND(SrcEqMotionQPData%betaC,2) - i3_l = LBOUND(SrcEqMotionQPData%betaC,3) - i3_u = UBOUND(SrcEqMotionQPData%betaC,3) - i4_l = LBOUND(SrcEqMotionQPData%betaC,4) - i4_u = UBOUND(SrcEqMotionQPData%betaC,4) - IF (.NOT. ALLOCATED(DstEqMotionQPData%betaC)) THEN - ALLOCATE(DstEqMotionQPData%betaC(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 DstEqMotionQPData%betaC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstEqMotionQPData%betaC = SrcEqMotionQPData%betaC -ENDIF -IF (ALLOCATED(SrcEqMotionQPData%Gi)) THEN - i1_l = LBOUND(SrcEqMotionQPData%Gi,1) - i1_u = UBOUND(SrcEqMotionQPData%Gi,1) - i2_l = LBOUND(SrcEqMotionQPData%Gi,2) - i2_u = UBOUND(SrcEqMotionQPData%Gi,2) - i3_l = LBOUND(SrcEqMotionQPData%Gi,3) - i3_u = UBOUND(SrcEqMotionQPData%Gi,3) - i4_l = LBOUND(SrcEqMotionQPData%Gi,4) - i4_u = UBOUND(SrcEqMotionQPData%Gi,4) - IF (.NOT. ALLOCATED(DstEqMotionQPData%Gi)) THEN - ALLOCATE(DstEqMotionQPData%Gi(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 DstEqMotionQPData%Gi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstEqMotionQPData%Gi = SrcEqMotionQPData%Gi -ENDIF -IF (ALLOCATED(SrcEqMotionQPData%Ki)) THEN - i1_l = LBOUND(SrcEqMotionQPData%Ki,1) - i1_u = UBOUND(SrcEqMotionQPData%Ki,1) - i2_l = LBOUND(SrcEqMotionQPData%Ki,2) - i2_u = UBOUND(SrcEqMotionQPData%Ki,2) - i3_l = LBOUND(SrcEqMotionQPData%Ki,3) - i3_u = UBOUND(SrcEqMotionQPData%Ki,3) - i4_l = LBOUND(SrcEqMotionQPData%Ki,4) - i4_u = UBOUND(SrcEqMotionQPData%Ki,4) - IF (.NOT. ALLOCATED(DstEqMotionQPData%Ki)) THEN - ALLOCATE(DstEqMotionQPData%Ki(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 DstEqMotionQPData%Ki.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstEqMotionQPData%Ki = SrcEqMotionQPData%Ki -ENDIF -IF (ALLOCATED(SrcEqMotionQPData%Mi)) THEN - i1_l = LBOUND(SrcEqMotionQPData%Mi,1) - i1_u = UBOUND(SrcEqMotionQPData%Mi,1) - i2_l = LBOUND(SrcEqMotionQPData%Mi,2) - i2_u = UBOUND(SrcEqMotionQPData%Mi,2) - i3_l = LBOUND(SrcEqMotionQPData%Mi,3) - i3_u = UBOUND(SrcEqMotionQPData%Mi,3) - i4_l = LBOUND(SrcEqMotionQPData%Mi,4) - i4_u = UBOUND(SrcEqMotionQPData%Mi,4) - IF (.NOT. ALLOCATED(DstEqMotionQPData%Mi)) THEN - ALLOCATE(DstEqMotionQPData%Mi(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 DstEqMotionQPData%Mi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstEqMotionQPData%Mi = SrcEqMotionQPData%Mi -ENDIF -IF (ALLOCATED(SrcEqMotionQPData%Oe)) THEN - i1_l = LBOUND(SrcEqMotionQPData%Oe,1) - i1_u = UBOUND(SrcEqMotionQPData%Oe,1) - i2_l = LBOUND(SrcEqMotionQPData%Oe,2) - i2_u = UBOUND(SrcEqMotionQPData%Oe,2) - i3_l = LBOUND(SrcEqMotionQPData%Oe,3) - i3_u = UBOUND(SrcEqMotionQPData%Oe,3) - i4_l = LBOUND(SrcEqMotionQPData%Oe,4) - i4_u = UBOUND(SrcEqMotionQPData%Oe,4) - IF (.NOT. ALLOCATED(DstEqMotionQPData%Oe)) THEN - ALLOCATE(DstEqMotionQPData%Oe(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 DstEqMotionQPData%Oe.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstEqMotionQPData%Oe = SrcEqMotionQPData%Oe -ENDIF -IF (ALLOCATED(SrcEqMotionQPData%Pe)) THEN - i1_l = LBOUND(SrcEqMotionQPData%Pe,1) - i1_u = UBOUND(SrcEqMotionQPData%Pe,1) - i2_l = LBOUND(SrcEqMotionQPData%Pe,2) - i2_u = UBOUND(SrcEqMotionQPData%Pe,2) - i3_l = LBOUND(SrcEqMotionQPData%Pe,3) - i3_u = UBOUND(SrcEqMotionQPData%Pe,3) - i4_l = LBOUND(SrcEqMotionQPData%Pe,4) - i4_u = UBOUND(SrcEqMotionQPData%Pe,4) - IF (.NOT. ALLOCATED(DstEqMotionQPData%Pe)) THEN - ALLOCATE(DstEqMotionQPData%Pe(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 DstEqMotionQPData%Pe.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstEqMotionQPData%Pe = SrcEqMotionQPData%Pe -ENDIF -IF (ALLOCATED(SrcEqMotionQPData%Qe)) THEN - i1_l = LBOUND(SrcEqMotionQPData%Qe,1) - i1_u = UBOUND(SrcEqMotionQPData%Qe,1) - i2_l = LBOUND(SrcEqMotionQPData%Qe,2) - i2_u = UBOUND(SrcEqMotionQPData%Qe,2) - i3_l = LBOUND(SrcEqMotionQPData%Qe,3) - i3_u = UBOUND(SrcEqMotionQPData%Qe,3) - i4_l = LBOUND(SrcEqMotionQPData%Qe,4) - i4_u = UBOUND(SrcEqMotionQPData%Qe,4) - IF (.NOT. ALLOCATED(DstEqMotionQPData%Qe)) THEN - ALLOCATE(DstEqMotionQPData%Qe(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 DstEqMotionQPData%Qe.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstEqMotionQPData%Qe = SrcEqMotionQPData%Qe -ENDIF -IF (ALLOCATED(SrcEqMotionQPData%Gd)) THEN - i1_l = LBOUND(SrcEqMotionQPData%Gd,1) - i1_u = UBOUND(SrcEqMotionQPData%Gd,1) - i2_l = LBOUND(SrcEqMotionQPData%Gd,2) - i2_u = UBOUND(SrcEqMotionQPData%Gd,2) - i3_l = LBOUND(SrcEqMotionQPData%Gd,3) - i3_u = UBOUND(SrcEqMotionQPData%Gd,3) - i4_l = LBOUND(SrcEqMotionQPData%Gd,4) - i4_u = UBOUND(SrcEqMotionQPData%Gd,4) - IF (.NOT. ALLOCATED(DstEqMotionQPData%Gd)) THEN - ALLOCATE(DstEqMotionQPData%Gd(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 DstEqMotionQPData%Gd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstEqMotionQPData%Gd = SrcEqMotionQPData%Gd -ENDIF -IF (ALLOCATED(SrcEqMotionQPData%Od)) THEN - i1_l = LBOUND(SrcEqMotionQPData%Od,1) - i1_u = UBOUND(SrcEqMotionQPData%Od,1) - i2_l = LBOUND(SrcEqMotionQPData%Od,2) - i2_u = UBOUND(SrcEqMotionQPData%Od,2) - i3_l = LBOUND(SrcEqMotionQPData%Od,3) - i3_u = UBOUND(SrcEqMotionQPData%Od,3) - i4_l = LBOUND(SrcEqMotionQPData%Od,4) - i4_u = UBOUND(SrcEqMotionQPData%Od,4) - IF (.NOT. ALLOCATED(DstEqMotionQPData%Od)) THEN - ALLOCATE(DstEqMotionQPData%Od(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 DstEqMotionQPData%Od.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstEqMotionQPData%Od = SrcEqMotionQPData%Od -ENDIF -IF (ALLOCATED(SrcEqMotionQPData%Pd)) THEN - i1_l = LBOUND(SrcEqMotionQPData%Pd,1) - i1_u = UBOUND(SrcEqMotionQPData%Pd,1) - i2_l = LBOUND(SrcEqMotionQPData%Pd,2) - i2_u = UBOUND(SrcEqMotionQPData%Pd,2) - i3_l = LBOUND(SrcEqMotionQPData%Pd,3) - i3_u = UBOUND(SrcEqMotionQPData%Pd,3) - i4_l = LBOUND(SrcEqMotionQPData%Pd,4) - i4_u = UBOUND(SrcEqMotionQPData%Pd,4) - IF (.NOT. ALLOCATED(DstEqMotionQPData%Pd)) THEN - ALLOCATE(DstEqMotionQPData%Pd(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 DstEqMotionQPData%Pd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstEqMotionQPData%Pd = SrcEqMotionQPData%Pd -ENDIF -IF (ALLOCATED(SrcEqMotionQPData%Qd)) THEN - i1_l = LBOUND(SrcEqMotionQPData%Qd,1) - i1_u = UBOUND(SrcEqMotionQPData%Qd,1) - i2_l = LBOUND(SrcEqMotionQPData%Qd,2) - i2_u = UBOUND(SrcEqMotionQPData%Qd,2) - i3_l = LBOUND(SrcEqMotionQPData%Qd,3) - i3_u = UBOUND(SrcEqMotionQPData%Qd,3) - i4_l = LBOUND(SrcEqMotionQPData%Qd,4) - i4_u = UBOUND(SrcEqMotionQPData%Qd,4) - IF (.NOT. ALLOCATED(DstEqMotionQPData%Qd)) THEN - ALLOCATE(DstEqMotionQPData%Qd(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 DstEqMotionQPData%Qd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstEqMotionQPData%Qd = SrcEqMotionQPData%Qd -ENDIF -IF (ALLOCATED(SrcEqMotionQPData%Sd)) THEN - i1_l = LBOUND(SrcEqMotionQPData%Sd,1) - i1_u = UBOUND(SrcEqMotionQPData%Sd,1) - i2_l = LBOUND(SrcEqMotionQPData%Sd,2) - i2_u = UBOUND(SrcEqMotionQPData%Sd,2) - i3_l = LBOUND(SrcEqMotionQPData%Sd,3) - i3_u = UBOUND(SrcEqMotionQPData%Sd,3) - i4_l = LBOUND(SrcEqMotionQPData%Sd,4) - i4_u = UBOUND(SrcEqMotionQPData%Sd,4) - IF (.NOT. ALLOCATED(DstEqMotionQPData%Sd)) THEN - ALLOCATE(DstEqMotionQPData%Sd(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 DstEqMotionQPData%Sd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstEqMotionQPData%Sd = SrcEqMotionQPData%Sd -ENDIF -IF (ALLOCATED(SrcEqMotionQPData%Xd)) THEN - i1_l = LBOUND(SrcEqMotionQPData%Xd,1) - i1_u = UBOUND(SrcEqMotionQPData%Xd,1) - i2_l = LBOUND(SrcEqMotionQPData%Xd,2) - i2_u = UBOUND(SrcEqMotionQPData%Xd,2) - i3_l = LBOUND(SrcEqMotionQPData%Xd,3) - i3_u = UBOUND(SrcEqMotionQPData%Xd,3) - i4_l = LBOUND(SrcEqMotionQPData%Xd,4) - i4_u = UBOUND(SrcEqMotionQPData%Xd,4) - IF (.NOT. ALLOCATED(DstEqMotionQPData%Xd)) THEN - ALLOCATE(DstEqMotionQPData%Xd(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 DstEqMotionQPData%Xd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstEqMotionQPData%Xd = SrcEqMotionQPData%Xd -ENDIF -IF (ALLOCATED(SrcEqMotionQPData%Yd)) THEN - i1_l = LBOUND(SrcEqMotionQPData%Yd,1) - i1_u = UBOUND(SrcEqMotionQPData%Yd,1) - i2_l = LBOUND(SrcEqMotionQPData%Yd,2) - i2_u = UBOUND(SrcEqMotionQPData%Yd,2) - i3_l = LBOUND(SrcEqMotionQPData%Yd,3) - i3_u = UBOUND(SrcEqMotionQPData%Yd,3) - i4_l = LBOUND(SrcEqMotionQPData%Yd,4) - i4_u = UBOUND(SrcEqMotionQPData%Yd,4) - IF (.NOT. ALLOCATED(DstEqMotionQPData%Yd)) THEN - ALLOCATE(DstEqMotionQPData%Yd(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 DstEqMotionQPData%Yd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstEqMotionQPData%Yd = SrcEqMotionQPData%Yd -ENDIF - END SUBROUTINE BD_CopyEqMotionQP - - SUBROUTINE BD_DestroyEqMotionQP( EqMotionQPData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(EqMotionQP), INTENT(INOUT) :: EqMotionQPData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BD_DestroyEqMotionQP' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(EqMotionQPData%uuu)) THEN - DEALLOCATE(EqMotionQPData%uuu) -ENDIF -IF (ALLOCATED(EqMotionQPData%uup)) THEN - DEALLOCATE(EqMotionQPData%uup) -ENDIF -IF (ALLOCATED(EqMotionQPData%vvv)) THEN - DEALLOCATE(EqMotionQPData%vvv) -ENDIF -IF (ALLOCATED(EqMotionQPData%vvp)) THEN - DEALLOCATE(EqMotionQPData%vvp) -ENDIF -IF (ALLOCATED(EqMotionQPData%aaa)) THEN - DEALLOCATE(EqMotionQPData%aaa) -ENDIF -IF (ALLOCATED(EqMotionQPData%RR0)) THEN - DEALLOCATE(EqMotionQPData%RR0) -ENDIF -IF (ALLOCATED(EqMotionQPData%kappa)) THEN - DEALLOCATE(EqMotionQPData%kappa) -ENDIF -IF (ALLOCATED(EqMotionQPData%E1)) THEN - DEALLOCATE(EqMotionQPData%E1) -ENDIF -IF (ALLOCATED(EqMotionQPData%Stif)) THEN - DEALLOCATE(EqMotionQPData%Stif) -ENDIF -IF (ALLOCATED(EqMotionQPData%Fb)) THEN - DEALLOCATE(EqMotionQPData%Fb) -ENDIF -IF (ALLOCATED(EqMotionQPData%Fc)) THEN - DEALLOCATE(EqMotionQPData%Fc) -ENDIF -IF (ALLOCATED(EqMotionQPData%Fd)) THEN - DEALLOCATE(EqMotionQPData%Fd) -ENDIF -IF (ALLOCATED(EqMotionQPData%Fg)) THEN - DEALLOCATE(EqMotionQPData%Fg) -ENDIF -IF (ALLOCATED(EqMotionQPData%Fi)) THEN - DEALLOCATE(EqMotionQPData%Fi) -ENDIF -IF (ALLOCATED(EqMotionQPData%Ftemp)) THEN - DEALLOCATE(EqMotionQPData%Ftemp) -ENDIF -IF (ALLOCATED(EqMotionQPData%RR0mEta)) THEN - DEALLOCATE(EqMotionQPData%RR0mEta) -ENDIF -IF (ALLOCATED(EqMotionQPData%rho)) THEN - DEALLOCATE(EqMotionQPData%rho) -ENDIF -IF (ALLOCATED(EqMotionQPData%betaC)) THEN - DEALLOCATE(EqMotionQPData%betaC) -ENDIF -IF (ALLOCATED(EqMotionQPData%Gi)) THEN - DEALLOCATE(EqMotionQPData%Gi) -ENDIF -IF (ALLOCATED(EqMotionQPData%Ki)) THEN - DEALLOCATE(EqMotionQPData%Ki) -ENDIF -IF (ALLOCATED(EqMotionQPData%Mi)) THEN - DEALLOCATE(EqMotionQPData%Mi) -ENDIF -IF (ALLOCATED(EqMotionQPData%Oe)) THEN - DEALLOCATE(EqMotionQPData%Oe) -ENDIF -IF (ALLOCATED(EqMotionQPData%Pe)) THEN - DEALLOCATE(EqMotionQPData%Pe) -ENDIF -IF (ALLOCATED(EqMotionQPData%Qe)) THEN - DEALLOCATE(EqMotionQPData%Qe) -ENDIF -IF (ALLOCATED(EqMotionQPData%Gd)) THEN - DEALLOCATE(EqMotionQPData%Gd) -ENDIF -IF (ALLOCATED(EqMotionQPData%Od)) THEN - DEALLOCATE(EqMotionQPData%Od) -ENDIF -IF (ALLOCATED(EqMotionQPData%Pd)) THEN - DEALLOCATE(EqMotionQPData%Pd) -ENDIF -IF (ALLOCATED(EqMotionQPData%Qd)) THEN - DEALLOCATE(EqMotionQPData%Qd) -ENDIF -IF (ALLOCATED(EqMotionQPData%Sd)) THEN - DEALLOCATE(EqMotionQPData%Sd) -ENDIF -IF (ALLOCATED(EqMotionQPData%Xd)) THEN - DEALLOCATE(EqMotionQPData%Xd) -ENDIF -IF (ALLOCATED(EqMotionQPData%Yd)) THEN - DEALLOCATE(EqMotionQPData%Yd) -ENDIF - END SUBROUTINE BD_DestroyEqMotionQP - - SUBROUTINE BD_PackEqMotionQP( 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(EqMotionQP), 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 = 'BD_PackEqMotionQP' - ! 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 ! uuu allocated yes/no - IF ( ALLOCATED(InData%uuu) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! uuu upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%uuu) ! uuu - END IF - Int_BufSz = Int_BufSz + 1 ! uup allocated yes/no - IF ( ALLOCATED(InData%uup) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! uup upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%uup) ! uup - END IF - Int_BufSz = Int_BufSz + 1 ! vvv allocated yes/no - IF ( ALLOCATED(InData%vvv) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! vvv upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%vvv) ! vvv - END IF - Int_BufSz = Int_BufSz + 1 ! vvp allocated yes/no - IF ( ALLOCATED(InData%vvp) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! vvp upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%vvp) ! vvp - END IF - Int_BufSz = Int_BufSz + 1 ! aaa allocated yes/no - IF ( ALLOCATED(InData%aaa) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! aaa upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%aaa) ! aaa - END IF - Int_BufSz = Int_BufSz + 1 ! RR0 allocated yes/no - IF ( ALLOCATED(InData%RR0) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! RR0 upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%RR0) ! RR0 - END IF - Int_BufSz = Int_BufSz + 1 ! kappa allocated yes/no - IF ( ALLOCATED(InData%kappa) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! kappa upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%kappa) ! kappa - END IF - Int_BufSz = Int_BufSz + 1 ! E1 allocated yes/no - IF ( ALLOCATED(InData%E1) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! E1 upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%E1) ! E1 - END IF - Int_BufSz = Int_BufSz + 1 ! Stif allocated yes/no - IF ( ALLOCATED(InData%Stif) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! Stif upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Stif) ! Stif - END IF - Int_BufSz = Int_BufSz + 1 ! Fb allocated yes/no - IF ( ALLOCATED(InData%Fb) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Fb upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Fb) ! Fb - END IF - Int_BufSz = Int_BufSz + 1 ! Fc allocated yes/no - IF ( ALLOCATED(InData%Fc) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Fc upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Fc) ! Fc - END IF - Int_BufSz = Int_BufSz + 1 ! Fd allocated yes/no - IF ( ALLOCATED(InData%Fd) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Fd upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Fd) ! Fd - 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 - Int_BufSz = Int_BufSz + 1 ! Fi allocated yes/no - IF ( ALLOCATED(InData%Fi) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Fi upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Fi) ! Fi - END IF - Int_BufSz = Int_BufSz + 1 ! Ftemp allocated yes/no - IF ( ALLOCATED(InData%Ftemp) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Ftemp upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Ftemp) ! Ftemp - END IF - Int_BufSz = Int_BufSz + 1 ! RR0mEta allocated yes/no - IF ( ALLOCATED(InData%RR0mEta) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! RR0mEta upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%RR0mEta) ! RR0mEta - END IF - Int_BufSz = Int_BufSz + 1 ! rho allocated yes/no - IF ( ALLOCATED(InData%rho) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! rho upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%rho) ! rho - END IF - Int_BufSz = Int_BufSz + 1 ! betaC allocated yes/no - IF ( ALLOCATED(InData%betaC) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! betaC upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%betaC) ! betaC - END IF - Int_BufSz = Int_BufSz + 1 ! Gi allocated yes/no - IF ( ALLOCATED(InData%Gi) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! Gi upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Gi) ! Gi - END IF - Int_BufSz = Int_BufSz + 1 ! Ki allocated yes/no - IF ( ALLOCATED(InData%Ki) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! Ki upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Ki) ! Ki - END IF - Int_BufSz = Int_BufSz + 1 ! Mi allocated yes/no - IF ( ALLOCATED(InData%Mi) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! Mi upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Mi) ! Mi - END IF - Int_BufSz = Int_BufSz + 1 ! Oe allocated yes/no - IF ( ALLOCATED(InData%Oe) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! Oe upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Oe) ! Oe - END IF - Int_BufSz = Int_BufSz + 1 ! Pe allocated yes/no - IF ( ALLOCATED(InData%Pe) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! Pe upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Pe) ! Pe - END IF - Int_BufSz = Int_BufSz + 1 ! Qe allocated yes/no - IF ( ALLOCATED(InData%Qe) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! Qe upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Qe) ! Qe - END IF - Int_BufSz = Int_BufSz + 1 ! Gd allocated yes/no - IF ( ALLOCATED(InData%Gd) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! Gd upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Gd) ! Gd - END IF - Int_BufSz = Int_BufSz + 1 ! Od allocated yes/no - IF ( ALLOCATED(InData%Od) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! Od upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Od) ! Od - END IF - Int_BufSz = Int_BufSz + 1 ! Pd allocated yes/no - IF ( ALLOCATED(InData%Pd) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! Pd upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Pd) ! Pd - END IF - Int_BufSz = Int_BufSz + 1 ! Qd allocated yes/no - IF ( ALLOCATED(InData%Qd) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! Qd upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Qd) ! Qd - END IF - Int_BufSz = Int_BufSz + 1 ! Sd allocated yes/no - IF ( ALLOCATED(InData%Sd) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! Sd upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Sd) ! Sd - END IF - Int_BufSz = Int_BufSz + 1 ! Xd allocated yes/no - IF ( ALLOCATED(InData%Xd) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! Xd upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Xd) ! Xd - END IF - Int_BufSz = Int_BufSz + 1 ! Yd allocated yes/no - IF ( ALLOCATED(InData%Yd) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! Yd upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Yd) ! Yd - 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%uuu) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%uuu,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uuu,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%uuu,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uuu,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%uuu,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uuu,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%uuu,3), UBOUND(InData%uuu,3) - DO i2 = LBOUND(InData%uuu,2), UBOUND(InData%uuu,2) - DO i1 = LBOUND(InData%uuu,1), UBOUND(InData%uuu,1) - DbKiBuf(Db_Xferred) = InData%uuu(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%uup) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%uup,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uup,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%uup,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uup,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%uup,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uup,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%uup,3), UBOUND(InData%uup,3) - DO i2 = LBOUND(InData%uup,2), UBOUND(InData%uup,2) - DO i1 = LBOUND(InData%uup,1), UBOUND(InData%uup,1) - DbKiBuf(Db_Xferred) = InData%uup(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%vvv) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%vvv,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%vvv,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%vvv,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%vvv,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%vvv,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%vvv,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%vvv,3), UBOUND(InData%vvv,3) - DO i2 = LBOUND(InData%vvv,2), UBOUND(InData%vvv,2) - DO i1 = LBOUND(InData%vvv,1), UBOUND(InData%vvv,1) - DbKiBuf(Db_Xferred) = InData%vvv(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%vvp) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%vvp,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%vvp,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%vvp,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%vvp,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%vvp,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%vvp,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%vvp,3), UBOUND(InData%vvp,3) - DO i2 = LBOUND(InData%vvp,2), UBOUND(InData%vvp,2) - DO i1 = LBOUND(InData%vvp,1), UBOUND(InData%vvp,1) - DbKiBuf(Db_Xferred) = InData%vvp(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%aaa) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%aaa,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%aaa,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%aaa,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%aaa,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%aaa,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%aaa,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%aaa,3), UBOUND(InData%aaa,3) - DO i2 = LBOUND(InData%aaa,2), UBOUND(InData%aaa,2) - DO i1 = LBOUND(InData%aaa,1), UBOUND(InData%aaa,1) - DbKiBuf(Db_Xferred) = InData%aaa(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%RR0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RR0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RR0,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RR0,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RR0,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RR0,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RR0,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RR0,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RR0,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%RR0,4), UBOUND(InData%RR0,4) - DO i3 = LBOUND(InData%RR0,3), UBOUND(InData%RR0,3) - DO i2 = LBOUND(InData%RR0,2), UBOUND(InData%RR0,2) - DO i1 = LBOUND(InData%RR0,1), UBOUND(InData%RR0,1) - DbKiBuf(Db_Xferred) = InData%RR0(i1,i2,i3,i4) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%kappa) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%kappa,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%kappa,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%kappa,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%kappa,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%kappa,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%kappa,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%kappa,3), UBOUND(InData%kappa,3) - DO i2 = LBOUND(InData%kappa,2), UBOUND(InData%kappa,2) - DO i1 = LBOUND(InData%kappa,1), UBOUND(InData%kappa,1) - DbKiBuf(Db_Xferred) = InData%kappa(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%E1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%E1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%E1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%E1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%E1,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%E1,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%E1,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%E1,3), UBOUND(InData%E1,3) - DO i2 = LBOUND(InData%E1,2), UBOUND(InData%E1,2) - DO i1 = LBOUND(InData%E1,1), UBOUND(InData%E1,1) - DbKiBuf(Db_Xferred) = InData%E1(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Stif) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Stif,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Stif,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Stif,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Stif,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Stif,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Stif,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Stif,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Stif,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%Stif,4), UBOUND(InData%Stif,4) - DO i3 = LBOUND(InData%Stif,3), UBOUND(InData%Stif,3) - DO i2 = LBOUND(InData%Stif,2), UBOUND(InData%Stif,2) - DO i1 = LBOUND(InData%Stif,1), UBOUND(InData%Stif,1) - DbKiBuf(Db_Xferred) = InData%Stif(i1,i2,i3,i4) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Fb) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Fb,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fb,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Fb,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fb,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Fb,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fb,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Fb,3), UBOUND(InData%Fb,3) - DO i2 = LBOUND(InData%Fb,2), UBOUND(InData%Fb,2) - DO i1 = LBOUND(InData%Fb,1), UBOUND(InData%Fb,1) - DbKiBuf(Db_Xferred) = InData%Fb(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Fc) ) THEN - 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,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fc,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Fc,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fc,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Fc,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fc,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Fc,3), UBOUND(InData%Fc,3) - DO i2 = LBOUND(InData%Fc,2), UBOUND(InData%Fc,2) - DO i1 = LBOUND(InData%Fc,1), UBOUND(InData%Fc,1) - DbKiBuf(Db_Xferred) = InData%Fc(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Fd) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Fd,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fd,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Fd,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fd,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Fd,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fd,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Fd,3), UBOUND(InData%Fd,3) - DO i2 = LBOUND(InData%Fd,2), UBOUND(InData%Fd,2) - DO i1 = LBOUND(InData%Fd,1), UBOUND(InData%Fd,1) - DbKiBuf(Db_Xferred) = InData%Fd(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - 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 - IF ( .NOT. ALLOCATED(InData%Fi) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Fi,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fi,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Fi,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fi,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Fi,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fi,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Fi,3), UBOUND(InData%Fi,3) - DO i2 = LBOUND(InData%Fi,2), UBOUND(InData%Fi,2) - DO i1 = LBOUND(InData%Fi,1), UBOUND(InData%Fi,1) - DbKiBuf(Db_Xferred) = InData%Fi(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Ftemp) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Ftemp,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Ftemp,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Ftemp,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Ftemp,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Ftemp,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Ftemp,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Ftemp,3), UBOUND(InData%Ftemp,3) - DO i2 = LBOUND(InData%Ftemp,2), UBOUND(InData%Ftemp,2) - DO i1 = LBOUND(InData%Ftemp,1), UBOUND(InData%Ftemp,1) - DbKiBuf(Db_Xferred) = InData%Ftemp(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%RR0mEta) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RR0mEta,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RR0mEta,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RR0mEta,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RR0mEta,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RR0mEta,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RR0mEta,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%RR0mEta,3), UBOUND(InData%RR0mEta,3) - DO i2 = LBOUND(InData%RR0mEta,2), UBOUND(InData%RR0mEta,2) - DO i1 = LBOUND(InData%RR0mEta,1), UBOUND(InData%RR0mEta,1) - DbKiBuf(Db_Xferred) = InData%RR0mEta(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%rho) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rho,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rho,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rho,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rho,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rho,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rho,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rho,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rho,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%rho,4), UBOUND(InData%rho,4) - DO i3 = LBOUND(InData%rho,3), UBOUND(InData%rho,3) - DO i2 = LBOUND(InData%rho,2), UBOUND(InData%rho,2) - DO i1 = LBOUND(InData%rho,1), UBOUND(InData%rho,1) - DbKiBuf(Db_Xferred) = InData%rho(i1,i2,i3,i4) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%betaC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%betaC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%betaC,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%betaC,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%betaC,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%betaC,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%betaC,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%betaC,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%betaC,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%betaC,4), UBOUND(InData%betaC,4) - DO i3 = LBOUND(InData%betaC,3), UBOUND(InData%betaC,3) - DO i2 = LBOUND(InData%betaC,2), UBOUND(InData%betaC,2) - DO i1 = LBOUND(InData%betaC,1), UBOUND(InData%betaC,1) - DbKiBuf(Db_Xferred) = InData%betaC(i1,i2,i3,i4) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Gi) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Gi,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Gi,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Gi,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Gi,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Gi,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Gi,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Gi,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Gi,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%Gi,4), UBOUND(InData%Gi,4) - DO i3 = LBOUND(InData%Gi,3), UBOUND(InData%Gi,3) - DO i2 = LBOUND(InData%Gi,2), UBOUND(InData%Gi,2) - DO i1 = LBOUND(InData%Gi,1), UBOUND(InData%Gi,1) - DbKiBuf(Db_Xferred) = InData%Gi(i1,i2,i3,i4) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Ki) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Ki,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Ki,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Ki,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Ki,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Ki,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Ki,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Ki,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Ki,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%Ki,4), UBOUND(InData%Ki,4) - DO i3 = LBOUND(InData%Ki,3), UBOUND(InData%Ki,3) - DO i2 = LBOUND(InData%Ki,2), UBOUND(InData%Ki,2) - DO i1 = LBOUND(InData%Ki,1), UBOUND(InData%Ki,1) - DbKiBuf(Db_Xferred) = InData%Ki(i1,i2,i3,i4) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Mi) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Mi,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Mi,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Mi,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Mi,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Mi,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Mi,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Mi,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Mi,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%Mi,4), UBOUND(InData%Mi,4) - DO i3 = LBOUND(InData%Mi,3), UBOUND(InData%Mi,3) - DO i2 = LBOUND(InData%Mi,2), UBOUND(InData%Mi,2) - DO i1 = LBOUND(InData%Mi,1), UBOUND(InData%Mi,1) - DbKiBuf(Db_Xferred) = InData%Mi(i1,i2,i3,i4) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Oe) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Oe,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Oe,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Oe,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Oe,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Oe,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Oe,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Oe,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Oe,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%Oe,4), UBOUND(InData%Oe,4) - DO i3 = LBOUND(InData%Oe,3), UBOUND(InData%Oe,3) - DO i2 = LBOUND(InData%Oe,2), UBOUND(InData%Oe,2) - DO i1 = LBOUND(InData%Oe,1), UBOUND(InData%Oe,1) - DbKiBuf(Db_Xferred) = InData%Oe(i1,i2,i3,i4) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Pe) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Pe,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Pe,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Pe,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Pe,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Pe,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Pe,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Pe,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Pe,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%Pe,4), UBOUND(InData%Pe,4) - DO i3 = LBOUND(InData%Pe,3), UBOUND(InData%Pe,3) - DO i2 = LBOUND(InData%Pe,2), UBOUND(InData%Pe,2) - DO i1 = LBOUND(InData%Pe,1), UBOUND(InData%Pe,1) - DbKiBuf(Db_Xferred) = InData%Pe(i1,i2,i3,i4) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Qe) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Qe,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Qe,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Qe,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Qe,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Qe,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Qe,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Qe,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Qe,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%Qe,4), UBOUND(InData%Qe,4) - DO i3 = LBOUND(InData%Qe,3), UBOUND(InData%Qe,3) - DO i2 = LBOUND(InData%Qe,2), UBOUND(InData%Qe,2) - DO i1 = LBOUND(InData%Qe,1), UBOUND(InData%Qe,1) - DbKiBuf(Db_Xferred) = InData%Qe(i1,i2,i3,i4) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Gd) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Gd,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Gd,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Gd,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Gd,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Gd,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Gd,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Gd,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Gd,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%Gd,4), UBOUND(InData%Gd,4) - DO i3 = LBOUND(InData%Gd,3), UBOUND(InData%Gd,3) - DO i2 = LBOUND(InData%Gd,2), UBOUND(InData%Gd,2) - DO i1 = LBOUND(InData%Gd,1), UBOUND(InData%Gd,1) - DbKiBuf(Db_Xferred) = InData%Gd(i1,i2,i3,i4) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Od) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Od,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Od,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Od,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Od,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Od,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Od,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Od,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Od,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%Od,4), UBOUND(InData%Od,4) - DO i3 = LBOUND(InData%Od,3), UBOUND(InData%Od,3) - DO i2 = LBOUND(InData%Od,2), UBOUND(InData%Od,2) - DO i1 = LBOUND(InData%Od,1), UBOUND(InData%Od,1) - DbKiBuf(Db_Xferred) = InData%Od(i1,i2,i3,i4) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Pd) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Pd,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Pd,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Pd,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Pd,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Pd,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Pd,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Pd,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Pd,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%Pd,4), UBOUND(InData%Pd,4) - DO i3 = LBOUND(InData%Pd,3), UBOUND(InData%Pd,3) - DO i2 = LBOUND(InData%Pd,2), UBOUND(InData%Pd,2) - DO i1 = LBOUND(InData%Pd,1), UBOUND(InData%Pd,1) - DbKiBuf(Db_Xferred) = InData%Pd(i1,i2,i3,i4) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Qd) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Qd,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Qd,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Qd,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Qd,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Qd,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Qd,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Qd,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Qd,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%Qd,4), UBOUND(InData%Qd,4) - DO i3 = LBOUND(InData%Qd,3), UBOUND(InData%Qd,3) - DO i2 = LBOUND(InData%Qd,2), UBOUND(InData%Qd,2) - DO i1 = LBOUND(InData%Qd,1), UBOUND(InData%Qd,1) - DbKiBuf(Db_Xferred) = InData%Qd(i1,i2,i3,i4) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Sd) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Sd,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Sd,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Sd,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Sd,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Sd,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Sd,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Sd,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Sd,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%Sd,4), UBOUND(InData%Sd,4) - DO i3 = LBOUND(InData%Sd,3), UBOUND(InData%Sd,3) - DO i2 = LBOUND(InData%Sd,2), UBOUND(InData%Sd,2) - DO i1 = LBOUND(InData%Sd,1), UBOUND(InData%Sd,1) - DbKiBuf(Db_Xferred) = InData%Sd(i1,i2,i3,i4) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Xd) ) THEN - 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,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Xd,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Xd,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Xd,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Xd,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Xd,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Xd,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Xd,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%Xd,4), UBOUND(InData%Xd,4) - DO i3 = LBOUND(InData%Xd,3), UBOUND(InData%Xd,3) - DO i2 = LBOUND(InData%Xd,2), UBOUND(InData%Xd,2) - DO i1 = LBOUND(InData%Xd,1), UBOUND(InData%Xd,1) - DbKiBuf(Db_Xferred) = InData%Xd(i1,i2,i3,i4) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Yd) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Yd,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Yd,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Yd,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Yd,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Yd,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Yd,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Yd,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Yd,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%Yd,4), UBOUND(InData%Yd,4) - DO i3 = LBOUND(InData%Yd,3), UBOUND(InData%Yd,3) - DO i2 = LBOUND(InData%Yd,2), UBOUND(InData%Yd,2) - DO i1 = LBOUND(InData%Yd,1), UBOUND(InData%Yd,1) - DbKiBuf(Db_Xferred) = InData%Yd(i1,i2,i3,i4) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - END SUBROUTINE BD_PackEqMotionQP - - SUBROUTINE BD_UnPackEqMotionQP( 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(EqMotionQP), 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 = 'BD_UnPackEqMotionQP' - ! 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 ! uuu not allocated - Int_Xferred = Int_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%uuu)) DEALLOCATE(OutData%uuu) - ALLOCATE(OutData%uuu(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%uuu.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%uuu,3), UBOUND(OutData%uuu,3) - DO i2 = LBOUND(OutData%uuu,2), UBOUND(OutData%uuu,2) - DO i1 = LBOUND(OutData%uuu,1), UBOUND(OutData%uuu,1) - OutData%uuu(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! uup not allocated - Int_Xferred = Int_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%uup)) DEALLOCATE(OutData%uup) - ALLOCATE(OutData%uup(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%uup.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%uup,3), UBOUND(OutData%uup,3) - DO i2 = LBOUND(OutData%uup,2), UBOUND(OutData%uup,2) - DO i1 = LBOUND(OutData%uup,1), UBOUND(OutData%uup,1) - OutData%uup(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! vvv not allocated - Int_Xferred = Int_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%vvv)) DEALLOCATE(OutData%vvv) - ALLOCATE(OutData%vvv(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%vvv.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%vvv,3), UBOUND(OutData%vvv,3) - DO i2 = LBOUND(OutData%vvv,2), UBOUND(OutData%vvv,2) - DO i1 = LBOUND(OutData%vvv,1), UBOUND(OutData%vvv,1) - OutData%vvv(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! vvp not allocated - Int_Xferred = Int_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%vvp)) DEALLOCATE(OutData%vvp) - ALLOCATE(OutData%vvp(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%vvp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%vvp,3), UBOUND(OutData%vvp,3) - DO i2 = LBOUND(OutData%vvp,2), UBOUND(OutData%vvp,2) - DO i1 = LBOUND(OutData%vvp,1), UBOUND(OutData%vvp,1) - OutData%vvp(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! aaa not allocated - Int_Xferred = Int_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%aaa)) DEALLOCATE(OutData%aaa) - ALLOCATE(OutData%aaa(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%aaa.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%aaa,3), UBOUND(OutData%aaa,3) - DO i2 = LBOUND(OutData%aaa,2), UBOUND(OutData%aaa,2) - DO i1 = LBOUND(OutData%aaa,1), UBOUND(OutData%aaa,1) - OutData%aaa(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RR0 not allocated - Int_Xferred = Int_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%RR0)) DEALLOCATE(OutData%RR0) - ALLOCATE(OutData%RR0(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%RR0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%RR0,4), UBOUND(OutData%RR0,4) - DO i3 = LBOUND(OutData%RR0,3), UBOUND(OutData%RR0,3) - DO i2 = LBOUND(OutData%RR0,2), UBOUND(OutData%RR0,2) - DO i1 = LBOUND(OutData%RR0,1), UBOUND(OutData%RR0,1) - OutData%RR0(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 ! kappa not allocated - Int_Xferred = Int_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%kappa)) DEALLOCATE(OutData%kappa) - ALLOCATE(OutData%kappa(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%kappa.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%kappa,3), UBOUND(OutData%kappa,3) - DO i2 = LBOUND(OutData%kappa,2), UBOUND(OutData%kappa,2) - DO i1 = LBOUND(OutData%kappa,1), UBOUND(OutData%kappa,1) - OutData%kappa(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! E1 not allocated - Int_Xferred = Int_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%E1)) DEALLOCATE(OutData%E1) - ALLOCATE(OutData%E1(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%E1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%E1,3), UBOUND(OutData%E1,3) - DO i2 = LBOUND(OutData%E1,2), UBOUND(OutData%E1,2) - DO i1 = LBOUND(OutData%E1,1), UBOUND(OutData%E1,1) - OutData%E1(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Stif not allocated - Int_Xferred = Int_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%Stif)) DEALLOCATE(OutData%Stif) - ALLOCATE(OutData%Stif(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%Stif.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%Stif,4), UBOUND(OutData%Stif,4) - DO i3 = LBOUND(OutData%Stif,3), UBOUND(OutData%Stif,3) - DO i2 = LBOUND(OutData%Stif,2), UBOUND(OutData%Stif,2) - DO i1 = LBOUND(OutData%Stif,1), UBOUND(OutData%Stif,1) - OutData%Stif(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 ! Fb not allocated - Int_Xferred = Int_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%Fb)) DEALLOCATE(OutData%Fb) - ALLOCATE(OutData%Fb(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%Fb.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Fb,3), UBOUND(OutData%Fb,3) - DO i2 = LBOUND(OutData%Fb,2), UBOUND(OutData%Fb,2) - DO i1 = LBOUND(OutData%Fb,1), UBOUND(OutData%Fb,1) - OutData%Fb(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Fc not allocated - Int_Xferred = Int_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%Fc)) DEALLOCATE(OutData%Fc) - ALLOCATE(OutData%Fc(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%Fc.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Fc,3), UBOUND(OutData%Fc,3) - DO i2 = LBOUND(OutData%Fc,2), UBOUND(OutData%Fc,2) - DO i1 = LBOUND(OutData%Fc,1), UBOUND(OutData%Fc,1) - OutData%Fc(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Fd not allocated - Int_Xferred = Int_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%Fd)) DEALLOCATE(OutData%Fd) - ALLOCATE(OutData%Fd(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%Fd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Fd,3), UBOUND(OutData%Fd,3) - DO i2 = LBOUND(OutData%Fd,2), UBOUND(OutData%Fd,2) - DO i1 = LBOUND(OutData%Fd,1), UBOUND(OutData%Fd,1) - OutData%Fd(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - 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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Fi not allocated - Int_Xferred = Int_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%Fi)) DEALLOCATE(OutData%Fi) - ALLOCATE(OutData%Fi(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%Fi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Fi,3), UBOUND(OutData%Fi,3) - DO i2 = LBOUND(OutData%Fi,2), UBOUND(OutData%Fi,2) - DO i1 = LBOUND(OutData%Fi,1), UBOUND(OutData%Fi,1) - OutData%Fi(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Ftemp not allocated - Int_Xferred = Int_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%Ftemp)) DEALLOCATE(OutData%Ftemp) - ALLOCATE(OutData%Ftemp(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%Ftemp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Ftemp,3), UBOUND(OutData%Ftemp,3) - DO i2 = LBOUND(OutData%Ftemp,2), UBOUND(OutData%Ftemp,2) - DO i1 = LBOUND(OutData%Ftemp,1), UBOUND(OutData%Ftemp,1) - OutData%Ftemp(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RR0mEta not allocated - Int_Xferred = Int_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%RR0mEta)) DEALLOCATE(OutData%RR0mEta) - ALLOCATE(OutData%RR0mEta(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%RR0mEta.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%RR0mEta,3), UBOUND(OutData%RR0mEta,3) - DO i2 = LBOUND(OutData%RR0mEta,2), UBOUND(OutData%RR0mEta,2) - DO i1 = LBOUND(OutData%RR0mEta,1), UBOUND(OutData%RR0mEta,1) - OutData%RR0mEta(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rho not allocated - Int_Xferred = Int_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%rho)) DEALLOCATE(OutData%rho) - ALLOCATE(OutData%rho(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%rho.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%rho,4), UBOUND(OutData%rho,4) - DO i3 = LBOUND(OutData%rho,3), UBOUND(OutData%rho,3) - DO i2 = LBOUND(OutData%rho,2), UBOUND(OutData%rho,2) - DO i1 = LBOUND(OutData%rho,1), UBOUND(OutData%rho,1) - OutData%rho(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 ! betaC not allocated - Int_Xferred = Int_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%betaC)) DEALLOCATE(OutData%betaC) - ALLOCATE(OutData%betaC(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%betaC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%betaC,4), UBOUND(OutData%betaC,4) - DO i3 = LBOUND(OutData%betaC,3), UBOUND(OutData%betaC,3) - DO i2 = LBOUND(OutData%betaC,2), UBOUND(OutData%betaC,2) - DO i1 = LBOUND(OutData%betaC,1), UBOUND(OutData%betaC,1) - OutData%betaC(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 ! Gi not allocated - Int_Xferred = Int_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%Gi)) DEALLOCATE(OutData%Gi) - ALLOCATE(OutData%Gi(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%Gi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%Gi,4), UBOUND(OutData%Gi,4) - DO i3 = LBOUND(OutData%Gi,3), UBOUND(OutData%Gi,3) - DO i2 = LBOUND(OutData%Gi,2), UBOUND(OutData%Gi,2) - DO i1 = LBOUND(OutData%Gi,1), UBOUND(OutData%Gi,1) - OutData%Gi(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 ! Ki not allocated - Int_Xferred = Int_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%Ki)) DEALLOCATE(OutData%Ki) - ALLOCATE(OutData%Ki(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%Ki.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%Ki,4), UBOUND(OutData%Ki,4) - DO i3 = LBOUND(OutData%Ki,3), UBOUND(OutData%Ki,3) - DO i2 = LBOUND(OutData%Ki,2), UBOUND(OutData%Ki,2) - DO i1 = LBOUND(OutData%Ki,1), UBOUND(OutData%Ki,1) - OutData%Ki(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 ! Mi not allocated - Int_Xferred = Int_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%Mi)) DEALLOCATE(OutData%Mi) - ALLOCATE(OutData%Mi(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%Mi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%Mi,4), UBOUND(OutData%Mi,4) - DO i3 = LBOUND(OutData%Mi,3), UBOUND(OutData%Mi,3) - DO i2 = LBOUND(OutData%Mi,2), UBOUND(OutData%Mi,2) - DO i1 = LBOUND(OutData%Mi,1), UBOUND(OutData%Mi,1) - OutData%Mi(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 ! Oe not allocated - Int_Xferred = Int_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%Oe)) DEALLOCATE(OutData%Oe) - ALLOCATE(OutData%Oe(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%Oe.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%Oe,4), UBOUND(OutData%Oe,4) - DO i3 = LBOUND(OutData%Oe,3), UBOUND(OutData%Oe,3) - DO i2 = LBOUND(OutData%Oe,2), UBOUND(OutData%Oe,2) - DO i1 = LBOUND(OutData%Oe,1), UBOUND(OutData%Oe,1) - OutData%Oe(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 ! Pe not allocated - Int_Xferred = Int_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%Pe)) DEALLOCATE(OutData%Pe) - ALLOCATE(OutData%Pe(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%Pe.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%Pe,4), UBOUND(OutData%Pe,4) - DO i3 = LBOUND(OutData%Pe,3), UBOUND(OutData%Pe,3) - DO i2 = LBOUND(OutData%Pe,2), UBOUND(OutData%Pe,2) - DO i1 = LBOUND(OutData%Pe,1), UBOUND(OutData%Pe,1) - OutData%Pe(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 ! Qe not allocated - Int_Xferred = Int_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%Qe)) DEALLOCATE(OutData%Qe) - ALLOCATE(OutData%Qe(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%Qe.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%Qe,4), UBOUND(OutData%Qe,4) - DO i3 = LBOUND(OutData%Qe,3), UBOUND(OutData%Qe,3) - DO i2 = LBOUND(OutData%Qe,2), UBOUND(OutData%Qe,2) - DO i1 = LBOUND(OutData%Qe,1), UBOUND(OutData%Qe,1) - OutData%Qe(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 ! Gd not allocated - Int_Xferred = Int_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%Gd)) DEALLOCATE(OutData%Gd) - ALLOCATE(OutData%Gd(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%Gd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%Gd,4), UBOUND(OutData%Gd,4) - DO i3 = LBOUND(OutData%Gd,3), UBOUND(OutData%Gd,3) - DO i2 = LBOUND(OutData%Gd,2), UBOUND(OutData%Gd,2) - DO i1 = LBOUND(OutData%Gd,1), UBOUND(OutData%Gd,1) - OutData%Gd(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 ! Od not allocated - Int_Xferred = Int_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%Od)) DEALLOCATE(OutData%Od) - ALLOCATE(OutData%Od(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%Od.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%Od,4), UBOUND(OutData%Od,4) - DO i3 = LBOUND(OutData%Od,3), UBOUND(OutData%Od,3) - DO i2 = LBOUND(OutData%Od,2), UBOUND(OutData%Od,2) - DO i1 = LBOUND(OutData%Od,1), UBOUND(OutData%Od,1) - OutData%Od(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 ! Pd not allocated - Int_Xferred = Int_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%Pd)) DEALLOCATE(OutData%Pd) - ALLOCATE(OutData%Pd(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%Pd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%Pd,4), UBOUND(OutData%Pd,4) - DO i3 = LBOUND(OutData%Pd,3), UBOUND(OutData%Pd,3) - DO i2 = LBOUND(OutData%Pd,2), UBOUND(OutData%Pd,2) - DO i1 = LBOUND(OutData%Pd,1), UBOUND(OutData%Pd,1) - OutData%Pd(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 ! Qd not allocated - Int_Xferred = Int_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%Qd)) DEALLOCATE(OutData%Qd) - ALLOCATE(OutData%Qd(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%Qd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%Qd,4), UBOUND(OutData%Qd,4) - DO i3 = LBOUND(OutData%Qd,3), UBOUND(OutData%Qd,3) - DO i2 = LBOUND(OutData%Qd,2), UBOUND(OutData%Qd,2) - DO i1 = LBOUND(OutData%Qd,1), UBOUND(OutData%Qd,1) - OutData%Qd(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 ! Sd not allocated - Int_Xferred = Int_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%Sd)) DEALLOCATE(OutData%Sd) - ALLOCATE(OutData%Sd(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%Sd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%Sd,4), UBOUND(OutData%Sd,4) - DO i3 = LBOUND(OutData%Sd,3), UBOUND(OutData%Sd,3) - DO i2 = LBOUND(OutData%Sd,2), UBOUND(OutData%Sd,2) - DO i1 = LBOUND(OutData%Sd,1), UBOUND(OutData%Sd,1) - OutData%Sd(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 ! Xd not allocated - Int_Xferred = Int_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%Xd)) DEALLOCATE(OutData%Xd) - ALLOCATE(OutData%Xd(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%Xd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%Xd,4), UBOUND(OutData%Xd,4) - DO i3 = LBOUND(OutData%Xd,3), UBOUND(OutData%Xd,3) - DO i2 = LBOUND(OutData%Xd,2), UBOUND(OutData%Xd,2) - DO i1 = LBOUND(OutData%Xd,1), UBOUND(OutData%Xd,1) - OutData%Xd(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 ! Yd not allocated - Int_Xferred = Int_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%Yd)) DEALLOCATE(OutData%Yd) - ALLOCATE(OutData%Yd(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%Yd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%Yd,4), UBOUND(OutData%Yd,4) - DO i3 = LBOUND(OutData%Yd,3), UBOUND(OutData%Yd,3) - DO i2 = LBOUND(OutData%Yd,2), UBOUND(OutData%Yd,2) - DO i1 = LBOUND(OutData%Yd,1), UBOUND(OutData%Yd,1) - OutData%Yd(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - END SUBROUTINE BD_UnPackEqMotionQP - - SUBROUTINE BD_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(BD_MiscVarType), INTENT(INOUT) :: SrcMiscData - TYPE(BD_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) :: 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 = 'BD_CopyMisc' -! + ErrMsg = '' +end subroutine + +subroutine BD_PackDiscState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(BD_DiscreteStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'BD_PackDiscState' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%thetaP) + call RegPack(RF, InData%thetaPD) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine BD_UnPackDiscState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(BD_DiscreteStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'BD_UnPackDiscState' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%thetaP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%thetaPD); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine BD_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) + type(BD_ConstraintStateType), intent(in) :: SrcConstrStateData + type(BD_ConstraintStateType), intent(inout) :: DstConstrStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'BD_CopyConstrState' ErrStat = ErrID_None - ErrMsg = "" - CALL MeshCopy( SrcMiscData%u_DistrLoad_at_y, DstMiscData%u_DistrLoad_at_y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcMiscData%y_BldMotion_at_u, DstMiscData%y_BldMotion_at_u, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcMiscData%Map_u_DistrLoad_to_y, DstMiscData%Map_u_DistrLoad_to_y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcMiscData%Map_y_BldMotion_to_u, DstMiscData%Map_y_BldMotion_to_u, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstMiscData%Un_Sum = SrcMiscData%Un_Sum - CALL BD_Copyeqmotionqp( SrcMiscData%qp, DstMiscData%qp, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcMiscData%lin_A)) THEN - i1_l = LBOUND(SrcMiscData%lin_A,1) - i1_u = UBOUND(SrcMiscData%lin_A,1) - i2_l = LBOUND(SrcMiscData%lin_A,2) - i2_u = UBOUND(SrcMiscData%lin_A,2) - IF (.NOT. ALLOCATED(DstMiscData%lin_A)) THEN - ALLOCATE(DstMiscData%lin_A(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%lin_A.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%lin_A = SrcMiscData%lin_A -ENDIF -IF (ALLOCATED(SrcMiscData%lin_C)) THEN - i1_l = LBOUND(SrcMiscData%lin_C,1) - i1_u = UBOUND(SrcMiscData%lin_C,1) - i2_l = LBOUND(SrcMiscData%lin_C,2) - i2_u = UBOUND(SrcMiscData%lin_C,2) - IF (.NOT. ALLOCATED(DstMiscData%lin_C)) THEN - ALLOCATE(DstMiscData%lin_C(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%lin_C.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%lin_C = SrcMiscData%lin_C -ENDIF -IF (ALLOCATED(SrcMiscData%Nrrr)) THEN - i1_l = LBOUND(SrcMiscData%Nrrr,1) - i1_u = UBOUND(SrcMiscData%Nrrr,1) - i2_l = LBOUND(SrcMiscData%Nrrr,2) - i2_u = UBOUND(SrcMiscData%Nrrr,2) - i3_l = LBOUND(SrcMiscData%Nrrr,3) - i3_u = UBOUND(SrcMiscData%Nrrr,3) - IF (.NOT. ALLOCATED(DstMiscData%Nrrr)) THEN - ALLOCATE(DstMiscData%Nrrr(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Nrrr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%Nrrr = SrcMiscData%Nrrr -ENDIF -IF (ALLOCATED(SrcMiscData%elf)) THEN - i1_l = LBOUND(SrcMiscData%elf,1) - i1_u = UBOUND(SrcMiscData%elf,1) - i2_l = LBOUND(SrcMiscData%elf,2) - i2_u = UBOUND(SrcMiscData%elf,2) - IF (.NOT. ALLOCATED(DstMiscData%elf)) THEN - ALLOCATE(DstMiscData%elf(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%elf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%elf = SrcMiscData%elf -ENDIF -IF (ALLOCATED(SrcMiscData%EFint)) THEN - i1_l = LBOUND(SrcMiscData%EFint,1) - i1_u = UBOUND(SrcMiscData%EFint,1) - i2_l = LBOUND(SrcMiscData%EFint,2) - i2_u = UBOUND(SrcMiscData%EFint,2) - i3_l = LBOUND(SrcMiscData%EFint,3) - i3_u = UBOUND(SrcMiscData%EFint,3) - IF (.NOT. ALLOCATED(DstMiscData%EFint)) THEN - ALLOCATE(DstMiscData%EFint(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%EFint.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%EFint = SrcMiscData%EFint -ENDIF -IF (ALLOCATED(SrcMiscData%elk)) THEN - i1_l = LBOUND(SrcMiscData%elk,1) - i1_u = UBOUND(SrcMiscData%elk,1) - i2_l = LBOUND(SrcMiscData%elk,2) - i2_u = UBOUND(SrcMiscData%elk,2) - i3_l = LBOUND(SrcMiscData%elk,3) - i3_u = UBOUND(SrcMiscData%elk,3) - i4_l = LBOUND(SrcMiscData%elk,4) - i4_u = UBOUND(SrcMiscData%elk,4) - IF (.NOT. ALLOCATED(DstMiscData%elk)) THEN - ALLOCATE(DstMiscData%elk(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 DstMiscData%elk.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%elk = SrcMiscData%elk -ENDIF -IF (ALLOCATED(SrcMiscData%elg)) THEN - i1_l = LBOUND(SrcMiscData%elg,1) - i1_u = UBOUND(SrcMiscData%elg,1) - i2_l = LBOUND(SrcMiscData%elg,2) - i2_u = UBOUND(SrcMiscData%elg,2) - i3_l = LBOUND(SrcMiscData%elg,3) - i3_u = UBOUND(SrcMiscData%elg,3) - i4_l = LBOUND(SrcMiscData%elg,4) - i4_u = UBOUND(SrcMiscData%elg,4) - IF (.NOT. ALLOCATED(DstMiscData%elg)) THEN - ALLOCATE(DstMiscData%elg(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 DstMiscData%elg.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%elg = SrcMiscData%elg -ENDIF -IF (ALLOCATED(SrcMiscData%elm)) THEN - i1_l = LBOUND(SrcMiscData%elm,1) - i1_u = UBOUND(SrcMiscData%elm,1) - i2_l = LBOUND(SrcMiscData%elm,2) - i2_u = UBOUND(SrcMiscData%elm,2) - i3_l = LBOUND(SrcMiscData%elm,3) - i3_u = UBOUND(SrcMiscData%elm,3) - i4_l = LBOUND(SrcMiscData%elm,4) - i4_u = UBOUND(SrcMiscData%elm,4) - IF (.NOT. ALLOCATED(DstMiscData%elm)) THEN - ALLOCATE(DstMiscData%elm(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 DstMiscData%elm.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%elm = SrcMiscData%elm -ENDIF -IF (ALLOCATED(SrcMiscData%DistrLoad_QP)) THEN - i1_l = LBOUND(SrcMiscData%DistrLoad_QP,1) - i1_u = UBOUND(SrcMiscData%DistrLoad_QP,1) - i2_l = LBOUND(SrcMiscData%DistrLoad_QP,2) - i2_u = UBOUND(SrcMiscData%DistrLoad_QP,2) - i3_l = LBOUND(SrcMiscData%DistrLoad_QP,3) - i3_u = UBOUND(SrcMiscData%DistrLoad_QP,3) - IF (.NOT. ALLOCATED(DstMiscData%DistrLoad_QP)) THEN - ALLOCATE(DstMiscData%DistrLoad_QP(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%DistrLoad_QP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%DistrLoad_QP = SrcMiscData%DistrLoad_QP -ENDIF -IF (ALLOCATED(SrcMiscData%PointLoadLcl)) THEN - i1_l = LBOUND(SrcMiscData%PointLoadLcl,1) - i1_u = UBOUND(SrcMiscData%PointLoadLcl,1) - i2_l = LBOUND(SrcMiscData%PointLoadLcl,2) - i2_u = UBOUND(SrcMiscData%PointLoadLcl,2) - IF (.NOT. ALLOCATED(DstMiscData%PointLoadLcl)) THEN - ALLOCATE(DstMiscData%PointLoadLcl(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%PointLoadLcl.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%PointLoadLcl = SrcMiscData%PointLoadLcl -ENDIF -IF (ALLOCATED(SrcMiscData%StifK)) THEN - i1_l = LBOUND(SrcMiscData%StifK,1) - i1_u = UBOUND(SrcMiscData%StifK,1) - i2_l = LBOUND(SrcMiscData%StifK,2) - i2_u = UBOUND(SrcMiscData%StifK,2) - i3_l = LBOUND(SrcMiscData%StifK,3) - i3_u = UBOUND(SrcMiscData%StifK,3) - i4_l = LBOUND(SrcMiscData%StifK,4) - i4_u = UBOUND(SrcMiscData%StifK,4) - IF (.NOT. ALLOCATED(DstMiscData%StifK)) THEN - ALLOCATE(DstMiscData%StifK(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 DstMiscData%StifK.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%StifK = SrcMiscData%StifK -ENDIF -IF (ALLOCATED(SrcMiscData%MassM)) THEN - i1_l = LBOUND(SrcMiscData%MassM,1) - i1_u = UBOUND(SrcMiscData%MassM,1) - i2_l = LBOUND(SrcMiscData%MassM,2) - i2_u = UBOUND(SrcMiscData%MassM,2) - i3_l = LBOUND(SrcMiscData%MassM,3) - i3_u = UBOUND(SrcMiscData%MassM,3) - i4_l = LBOUND(SrcMiscData%MassM,4) - i4_u = UBOUND(SrcMiscData%MassM,4) - IF (.NOT. ALLOCATED(DstMiscData%MassM)) THEN - ALLOCATE(DstMiscData%MassM(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 DstMiscData%MassM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%MassM = SrcMiscData%MassM -ENDIF -IF (ALLOCATED(SrcMiscData%DampG)) THEN - i1_l = LBOUND(SrcMiscData%DampG,1) - i1_u = UBOUND(SrcMiscData%DampG,1) - i2_l = LBOUND(SrcMiscData%DampG,2) - i2_u = UBOUND(SrcMiscData%DampG,2) - i3_l = LBOUND(SrcMiscData%DampG,3) - i3_u = UBOUND(SrcMiscData%DampG,3) - i4_l = LBOUND(SrcMiscData%DampG,4) - i4_u = UBOUND(SrcMiscData%DampG,4) - IF (.NOT. ALLOCATED(DstMiscData%DampG)) THEN - ALLOCATE(DstMiscData%DampG(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 DstMiscData%DampG.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%DampG = SrcMiscData%DampG -ENDIF -IF (ALLOCATED(SrcMiscData%StifK_fd)) THEN - i1_l = LBOUND(SrcMiscData%StifK_fd,1) - i1_u = UBOUND(SrcMiscData%StifK_fd,1) - i2_l = LBOUND(SrcMiscData%StifK_fd,2) - i2_u = UBOUND(SrcMiscData%StifK_fd,2) - i3_l = LBOUND(SrcMiscData%StifK_fd,3) - i3_u = UBOUND(SrcMiscData%StifK_fd,3) - i4_l = LBOUND(SrcMiscData%StifK_fd,4) - i4_u = UBOUND(SrcMiscData%StifK_fd,4) - IF (.NOT. ALLOCATED(DstMiscData%StifK_fd)) THEN - ALLOCATE(DstMiscData%StifK_fd(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 DstMiscData%StifK_fd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%StifK_fd = SrcMiscData%StifK_fd -ENDIF -IF (ALLOCATED(SrcMiscData%MassM_fd)) THEN - i1_l = LBOUND(SrcMiscData%MassM_fd,1) - i1_u = UBOUND(SrcMiscData%MassM_fd,1) - i2_l = LBOUND(SrcMiscData%MassM_fd,2) - i2_u = UBOUND(SrcMiscData%MassM_fd,2) - i3_l = LBOUND(SrcMiscData%MassM_fd,3) - i3_u = UBOUND(SrcMiscData%MassM_fd,3) - i4_l = LBOUND(SrcMiscData%MassM_fd,4) - i4_u = UBOUND(SrcMiscData%MassM_fd,4) - IF (.NOT. ALLOCATED(DstMiscData%MassM_fd)) THEN - ALLOCATE(DstMiscData%MassM_fd(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 DstMiscData%MassM_fd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%MassM_fd = SrcMiscData%MassM_fd -ENDIF -IF (ALLOCATED(SrcMiscData%DampG_fd)) THEN - i1_l = LBOUND(SrcMiscData%DampG_fd,1) - i1_u = UBOUND(SrcMiscData%DampG_fd,1) - i2_l = LBOUND(SrcMiscData%DampG_fd,2) - i2_u = UBOUND(SrcMiscData%DampG_fd,2) - i3_l = LBOUND(SrcMiscData%DampG_fd,3) - i3_u = UBOUND(SrcMiscData%DampG_fd,3) - i4_l = LBOUND(SrcMiscData%DampG_fd,4) - i4_u = UBOUND(SrcMiscData%DampG_fd,4) - IF (.NOT. ALLOCATED(DstMiscData%DampG_fd)) THEN - ALLOCATE(DstMiscData%DampG_fd(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 DstMiscData%DampG_fd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%DampG_fd = SrcMiscData%DampG_fd -ENDIF -IF (ALLOCATED(SrcMiscData%RHS)) THEN - i1_l = LBOUND(SrcMiscData%RHS,1) - i1_u = UBOUND(SrcMiscData%RHS,1) - i2_l = LBOUND(SrcMiscData%RHS,2) - i2_u = UBOUND(SrcMiscData%RHS,2) - IF (.NOT. ALLOCATED(DstMiscData%RHS)) THEN - ALLOCATE(DstMiscData%RHS(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%RHS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%RHS = SrcMiscData%RHS -ENDIF -IF (ALLOCATED(SrcMiscData%RHS_p)) THEN - i1_l = LBOUND(SrcMiscData%RHS_p,1) - i1_u = UBOUND(SrcMiscData%RHS_p,1) - i2_l = LBOUND(SrcMiscData%RHS_p,2) - i2_u = UBOUND(SrcMiscData%RHS_p,2) - IF (.NOT. ALLOCATED(DstMiscData%RHS_p)) THEN - ALLOCATE(DstMiscData%RHS_p(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%RHS_p.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%RHS_p = SrcMiscData%RHS_p -ENDIF -IF (ALLOCATED(SrcMiscData%RHS_m)) THEN - i1_l = LBOUND(SrcMiscData%RHS_m,1) - i1_u = UBOUND(SrcMiscData%RHS_m,1) - i2_l = LBOUND(SrcMiscData%RHS_m,2) - i2_u = UBOUND(SrcMiscData%RHS_m,2) - IF (.NOT. ALLOCATED(DstMiscData%RHS_m)) THEN - ALLOCATE(DstMiscData%RHS_m(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%RHS_m.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%RHS_m = SrcMiscData%RHS_m -ENDIF -IF (ALLOCATED(SrcMiscData%BldInternalForceFE)) THEN - i1_l = LBOUND(SrcMiscData%BldInternalForceFE,1) - i1_u = UBOUND(SrcMiscData%BldInternalForceFE,1) - i2_l = LBOUND(SrcMiscData%BldInternalForceFE,2) - i2_u = UBOUND(SrcMiscData%BldInternalForceFE,2) - IF (.NOT. ALLOCATED(DstMiscData%BldInternalForceFE)) THEN - ALLOCATE(DstMiscData%BldInternalForceFE(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BldInternalForceFE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%BldInternalForceFE = SrcMiscData%BldInternalForceFE -ENDIF -IF (ALLOCATED(SrcMiscData%BldInternalForceQP)) THEN - i1_l = LBOUND(SrcMiscData%BldInternalForceQP,1) - i1_u = UBOUND(SrcMiscData%BldInternalForceQP,1) - i2_l = LBOUND(SrcMiscData%BldInternalForceQP,2) - i2_u = UBOUND(SrcMiscData%BldInternalForceQP,2) - IF (.NOT. ALLOCATED(DstMiscData%BldInternalForceQP)) THEN - ALLOCATE(DstMiscData%BldInternalForceQP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BldInternalForceQP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%BldInternalForceQP = SrcMiscData%BldInternalForceQP -ENDIF -IF (ALLOCATED(SrcMiscData%FirstNodeReactionLclForceMoment)) THEN - i1_l = LBOUND(SrcMiscData%FirstNodeReactionLclForceMoment,1) - i1_u = UBOUND(SrcMiscData%FirstNodeReactionLclForceMoment,1) - IF (.NOT. ALLOCATED(DstMiscData%FirstNodeReactionLclForceMoment)) THEN - ALLOCATE(DstMiscData%FirstNodeReactionLclForceMoment(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FirstNodeReactionLclForceMoment.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%FirstNodeReactionLclForceMoment = SrcMiscData%FirstNodeReactionLclForceMoment -ENDIF -IF (ALLOCATED(SrcMiscData%Solution)) THEN - i1_l = LBOUND(SrcMiscData%Solution,1) - i1_u = UBOUND(SrcMiscData%Solution,1) - i2_l = LBOUND(SrcMiscData%Solution,2) - i2_u = UBOUND(SrcMiscData%Solution,2) - IF (.NOT. ALLOCATED(DstMiscData%Solution)) THEN - ALLOCATE(DstMiscData%Solution(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Solution.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%Solution = SrcMiscData%Solution -ENDIF -IF (ALLOCATED(SrcMiscData%LP_StifK)) THEN - i1_l = LBOUND(SrcMiscData%LP_StifK,1) - i1_u = UBOUND(SrcMiscData%LP_StifK,1) - i2_l = LBOUND(SrcMiscData%LP_StifK,2) - i2_u = UBOUND(SrcMiscData%LP_StifK,2) - IF (.NOT. ALLOCATED(DstMiscData%LP_StifK)) THEN - ALLOCATE(DstMiscData%LP_StifK(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%LP_StifK.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%LP_StifK = SrcMiscData%LP_StifK -ENDIF -IF (ALLOCATED(SrcMiscData%LP_MassM)) THEN - i1_l = LBOUND(SrcMiscData%LP_MassM,1) - i1_u = UBOUND(SrcMiscData%LP_MassM,1) - i2_l = LBOUND(SrcMiscData%LP_MassM,2) - i2_u = UBOUND(SrcMiscData%LP_MassM,2) - IF (.NOT. ALLOCATED(DstMiscData%LP_MassM)) THEN - ALLOCATE(DstMiscData%LP_MassM(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%LP_MassM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%LP_MassM = SrcMiscData%LP_MassM -ENDIF -IF (ALLOCATED(SrcMiscData%LP_MassM_LU)) THEN - i1_l = LBOUND(SrcMiscData%LP_MassM_LU,1) - i1_u = UBOUND(SrcMiscData%LP_MassM_LU,1) - i2_l = LBOUND(SrcMiscData%LP_MassM_LU,2) - i2_u = UBOUND(SrcMiscData%LP_MassM_LU,2) - IF (.NOT. ALLOCATED(DstMiscData%LP_MassM_LU)) THEN - ALLOCATE(DstMiscData%LP_MassM_LU(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%LP_MassM_LU.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%LP_MassM_LU = SrcMiscData%LP_MassM_LU -ENDIF -IF (ALLOCATED(SrcMiscData%LP_RHS)) THEN - i1_l = LBOUND(SrcMiscData%LP_RHS,1) - i1_u = UBOUND(SrcMiscData%LP_RHS,1) - IF (.NOT. ALLOCATED(DstMiscData%LP_RHS)) THEN - ALLOCATE(DstMiscData%LP_RHS(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%LP_RHS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%LP_RHS = SrcMiscData%LP_RHS -ENDIF -IF (ALLOCATED(SrcMiscData%LP_StifK_LU)) THEN - i1_l = LBOUND(SrcMiscData%LP_StifK_LU,1) - i1_u = UBOUND(SrcMiscData%LP_StifK_LU,1) - i2_l = LBOUND(SrcMiscData%LP_StifK_LU,2) - i2_u = UBOUND(SrcMiscData%LP_StifK_LU,2) - IF (.NOT. ALLOCATED(DstMiscData%LP_StifK_LU)) THEN - ALLOCATE(DstMiscData%LP_StifK_LU(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%LP_StifK_LU.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%LP_StifK_LU = SrcMiscData%LP_StifK_LU -ENDIF -IF (ALLOCATED(SrcMiscData%LP_RHS_LU)) THEN - i1_l = LBOUND(SrcMiscData%LP_RHS_LU,1) - i1_u = UBOUND(SrcMiscData%LP_RHS_LU,1) - IF (.NOT. ALLOCATED(DstMiscData%LP_RHS_LU)) THEN - ALLOCATE(DstMiscData%LP_RHS_LU(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%LP_RHS_LU.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%LP_RHS_LU = SrcMiscData%LP_RHS_LU -ENDIF -IF (ALLOCATED(SrcMiscData%LP_indx)) THEN - i1_l = LBOUND(SrcMiscData%LP_indx,1) - i1_u = UBOUND(SrcMiscData%LP_indx,1) - IF (.NOT. ALLOCATED(DstMiscData%LP_indx)) THEN - ALLOCATE(DstMiscData%LP_indx(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%LP_indx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%LP_indx = SrcMiscData%LP_indx -ENDIF - CALL BD_CopyInput( SrcMiscData%u, DstMiscData%u, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL BD_CopyInput( SrcMiscData%u2, DstMiscData%u2, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE BD_CopyMisc - - SUBROUTINE BD_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(BD_MiscVarType), INTENT(INOUT) :: MiscData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BD_DestroyMisc' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL MeshDestroy( MiscData%u_DistrLoad_at_y, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( MiscData%y_BldMotion_at_u, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL NWTC_Library_Destroymeshmaptype( MiscData%Map_u_DistrLoad_to_y, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL NWTC_Library_Destroymeshmaptype( MiscData%Map_y_BldMotion_to_u, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL BD_Destroyeqmotionqp( MiscData%qp, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(MiscData%lin_A)) THEN - DEALLOCATE(MiscData%lin_A) -ENDIF -IF (ALLOCATED(MiscData%lin_C)) THEN - DEALLOCATE(MiscData%lin_C) -ENDIF -IF (ALLOCATED(MiscData%Nrrr)) THEN - DEALLOCATE(MiscData%Nrrr) -ENDIF -IF (ALLOCATED(MiscData%elf)) THEN - DEALLOCATE(MiscData%elf) -ENDIF -IF (ALLOCATED(MiscData%EFint)) THEN - DEALLOCATE(MiscData%EFint) -ENDIF -IF (ALLOCATED(MiscData%elk)) THEN - DEALLOCATE(MiscData%elk) -ENDIF -IF (ALLOCATED(MiscData%elg)) THEN - DEALLOCATE(MiscData%elg) -ENDIF -IF (ALLOCATED(MiscData%elm)) THEN - DEALLOCATE(MiscData%elm) -ENDIF -IF (ALLOCATED(MiscData%DistrLoad_QP)) THEN - DEALLOCATE(MiscData%DistrLoad_QP) -ENDIF -IF (ALLOCATED(MiscData%PointLoadLcl)) THEN - DEALLOCATE(MiscData%PointLoadLcl) -ENDIF -IF (ALLOCATED(MiscData%StifK)) THEN - DEALLOCATE(MiscData%StifK) -ENDIF -IF (ALLOCATED(MiscData%MassM)) THEN - DEALLOCATE(MiscData%MassM) -ENDIF -IF (ALLOCATED(MiscData%DampG)) THEN - DEALLOCATE(MiscData%DampG) -ENDIF -IF (ALLOCATED(MiscData%StifK_fd)) THEN - DEALLOCATE(MiscData%StifK_fd) -ENDIF -IF (ALLOCATED(MiscData%MassM_fd)) THEN - DEALLOCATE(MiscData%MassM_fd) -ENDIF -IF (ALLOCATED(MiscData%DampG_fd)) THEN - DEALLOCATE(MiscData%DampG_fd) -ENDIF -IF (ALLOCATED(MiscData%RHS)) THEN - DEALLOCATE(MiscData%RHS) -ENDIF -IF (ALLOCATED(MiscData%RHS_p)) THEN - DEALLOCATE(MiscData%RHS_p) -ENDIF -IF (ALLOCATED(MiscData%RHS_m)) THEN - DEALLOCATE(MiscData%RHS_m) -ENDIF -IF (ALLOCATED(MiscData%BldInternalForceFE)) THEN - DEALLOCATE(MiscData%BldInternalForceFE) -ENDIF -IF (ALLOCATED(MiscData%BldInternalForceQP)) THEN - DEALLOCATE(MiscData%BldInternalForceQP) -ENDIF -IF (ALLOCATED(MiscData%FirstNodeReactionLclForceMoment)) THEN - DEALLOCATE(MiscData%FirstNodeReactionLclForceMoment) -ENDIF -IF (ALLOCATED(MiscData%Solution)) THEN - DEALLOCATE(MiscData%Solution) -ENDIF -IF (ALLOCATED(MiscData%LP_StifK)) THEN - DEALLOCATE(MiscData%LP_StifK) -ENDIF -IF (ALLOCATED(MiscData%LP_MassM)) THEN - DEALLOCATE(MiscData%LP_MassM) -ENDIF -IF (ALLOCATED(MiscData%LP_MassM_LU)) THEN - DEALLOCATE(MiscData%LP_MassM_LU) -ENDIF -IF (ALLOCATED(MiscData%LP_RHS)) THEN - DEALLOCATE(MiscData%LP_RHS) -ENDIF -IF (ALLOCATED(MiscData%LP_StifK_LU)) THEN - DEALLOCATE(MiscData%LP_StifK_LU) -ENDIF -IF (ALLOCATED(MiscData%LP_RHS_LU)) THEN - DEALLOCATE(MiscData%LP_RHS_LU) -ENDIF -IF (ALLOCATED(MiscData%LP_indx)) THEN - DEALLOCATE(MiscData%LP_indx) -ENDIF - CALL BD_DestroyInput( MiscData%u, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL BD_DestroyInput( MiscData%u2, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE BD_DestroyMisc - - SUBROUTINE BD_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(BD_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 = 'BD_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 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! u_DistrLoad_at_y: size of buffers for each call to pack subtype - CALL MeshPack( InData%u_DistrLoad_at_y, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! u_DistrLoad_at_y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_DistrLoad_at_y - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_DistrLoad_at_y - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_DistrLoad_at_y - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! y_BldMotion_at_u: size of buffers for each call to pack subtype - CALL MeshPack( InData%y_BldMotion_at_u, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! y_BldMotion_at_u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y_BldMotion_at_u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y_BldMotion_at_u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y_BldMotion_at_u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! Map_u_DistrLoad_to_y: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%Map_u_DistrLoad_to_y, ErrStat2, ErrMsg2, .TRUE. ) ! Map_u_DistrLoad_to_y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Map_u_DistrLoad_to_y - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Map_u_DistrLoad_to_y - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Map_u_DistrLoad_to_y - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! Map_y_BldMotion_to_u: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%Map_y_BldMotion_to_u, ErrStat2, ErrMsg2, .TRUE. ) ! Map_y_BldMotion_to_u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Map_y_BldMotion_to_u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Map_y_BldMotion_to_u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Map_y_BldMotion_to_u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! Un_Sum - Int_BufSz = Int_BufSz + 3 ! qp: size of buffers for each call to pack subtype - CALL BD_Packeqmotionqp( Re_Buf, Db_Buf, Int_Buf, InData%qp, ErrStat2, ErrMsg2, .TRUE. ) ! qp - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! qp - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! qp - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! qp - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! lin_A allocated yes/no - IF ( ALLOCATED(InData%lin_A) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! lin_A upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%lin_A) ! lin_A - END IF - Int_BufSz = Int_BufSz + 1 ! lin_C allocated yes/no - IF ( ALLOCATED(InData%lin_C) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! lin_C upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%lin_C) ! lin_C - END IF - Int_BufSz = Int_BufSz + 1 ! Nrrr allocated yes/no - IF ( ALLOCATED(InData%Nrrr) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Nrrr upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Nrrr) ! Nrrr - END IF - Int_BufSz = Int_BufSz + 1 ! elf allocated yes/no - IF ( ALLOCATED(InData%elf) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! elf upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%elf) ! elf - END IF - Int_BufSz = Int_BufSz + 1 ! EFint allocated yes/no - IF ( ALLOCATED(InData%EFint) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! EFint upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%EFint) ! EFint - END IF - Int_BufSz = Int_BufSz + 1 ! elk allocated yes/no - IF ( ALLOCATED(InData%elk) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! elk upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%elk) ! elk - END IF - Int_BufSz = Int_BufSz + 1 ! elg allocated yes/no - IF ( ALLOCATED(InData%elg) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! elg upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%elg) ! elg - END IF - Int_BufSz = Int_BufSz + 1 ! elm allocated yes/no - IF ( ALLOCATED(InData%elm) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! elm upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%elm) ! elm - END IF - Int_BufSz = Int_BufSz + 1 ! DistrLoad_QP allocated yes/no - IF ( ALLOCATED(InData%DistrLoad_QP) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! DistrLoad_QP upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%DistrLoad_QP) ! DistrLoad_QP - END IF - Int_BufSz = Int_BufSz + 1 ! PointLoadLcl allocated yes/no - IF ( ALLOCATED(InData%PointLoadLcl) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PointLoadLcl upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%PointLoadLcl) ! PointLoadLcl - END IF - Int_BufSz = Int_BufSz + 1 ! StifK allocated yes/no - IF ( ALLOCATED(InData%StifK) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! StifK upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%StifK) ! StifK - END IF - Int_BufSz = Int_BufSz + 1 ! MassM allocated yes/no - IF ( ALLOCATED(InData%MassM) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! MassM upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%MassM) ! MassM - END IF - Int_BufSz = Int_BufSz + 1 ! DampG allocated yes/no - IF ( ALLOCATED(InData%DampG) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! DampG upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%DampG) ! DampG - END IF - Int_BufSz = Int_BufSz + 1 ! StifK_fd allocated yes/no - IF ( ALLOCATED(InData%StifK_fd) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! StifK_fd upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%StifK_fd) ! StifK_fd - END IF - Int_BufSz = Int_BufSz + 1 ! MassM_fd allocated yes/no - IF ( ALLOCATED(InData%MassM_fd) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! MassM_fd upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%MassM_fd) ! MassM_fd - END IF - Int_BufSz = Int_BufSz + 1 ! DampG_fd allocated yes/no - IF ( ALLOCATED(InData%DampG_fd) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! DampG_fd upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%DampG_fd) ! DampG_fd - END IF - Int_BufSz = Int_BufSz + 1 ! RHS allocated yes/no - IF ( ALLOCATED(InData%RHS) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! RHS upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%RHS) ! RHS - END IF - Int_BufSz = Int_BufSz + 1 ! RHS_p allocated yes/no - IF ( ALLOCATED(InData%RHS_p) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! RHS_p upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%RHS_p) ! RHS_p - END IF - Int_BufSz = Int_BufSz + 1 ! RHS_m allocated yes/no - IF ( ALLOCATED(InData%RHS_m) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! RHS_m upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%RHS_m) ! RHS_m - END IF - Int_BufSz = Int_BufSz + 1 ! BldInternalForceFE allocated yes/no - IF ( ALLOCATED(InData%BldInternalForceFE) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BldInternalForceFE upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%BldInternalForceFE) ! BldInternalForceFE - END IF - Int_BufSz = Int_BufSz + 1 ! BldInternalForceQP allocated yes/no - IF ( ALLOCATED(InData%BldInternalForceQP) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BldInternalForceQP upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%BldInternalForceQP) ! BldInternalForceQP - END IF - Int_BufSz = Int_BufSz + 1 ! FirstNodeReactionLclForceMoment allocated yes/no - IF ( ALLOCATED(InData%FirstNodeReactionLclForceMoment) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! FirstNodeReactionLclForceMoment upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%FirstNodeReactionLclForceMoment) ! FirstNodeReactionLclForceMoment - END IF - Int_BufSz = Int_BufSz + 1 ! Solution allocated yes/no - IF ( ALLOCATED(InData%Solution) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Solution upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Solution) ! Solution - END IF - Int_BufSz = Int_BufSz + 1 ! LP_StifK allocated yes/no - IF ( ALLOCATED(InData%LP_StifK) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! LP_StifK upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%LP_StifK) ! LP_StifK - END IF - Int_BufSz = Int_BufSz + 1 ! LP_MassM allocated yes/no - IF ( ALLOCATED(InData%LP_MassM) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! LP_MassM upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%LP_MassM) ! LP_MassM - END IF - Int_BufSz = Int_BufSz + 1 ! LP_MassM_LU allocated yes/no - IF ( ALLOCATED(InData%LP_MassM_LU) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! LP_MassM_LU upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%LP_MassM_LU) ! LP_MassM_LU - END IF - Int_BufSz = Int_BufSz + 1 ! LP_RHS allocated yes/no - IF ( ALLOCATED(InData%LP_RHS) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LP_RHS upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%LP_RHS) ! LP_RHS - END IF - Int_BufSz = Int_BufSz + 1 ! LP_StifK_LU allocated yes/no - IF ( ALLOCATED(InData%LP_StifK_LU) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! LP_StifK_LU upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%LP_StifK_LU) ! LP_StifK_LU - END IF - Int_BufSz = Int_BufSz + 1 ! LP_RHS_LU allocated yes/no - IF ( ALLOCATED(InData%LP_RHS_LU) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LP_RHS_LU upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%LP_RHS_LU) ! LP_RHS_LU - END IF - Int_BufSz = Int_BufSz + 1 ! LP_indx allocated yes/no - IF ( ALLOCATED(InData%LP_indx) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LP_indx upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%LP_indx) ! LP_indx - END IF - Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype - CALL BD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! u2: size of buffers for each call to pack subtype - CALL BD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u2, ErrStat2, ErrMsg2, .TRUE. ) ! u2 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u2 - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u2 - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u2 - 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%u_DistrLoad_at_y, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! u_DistrLoad_at_y - 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%y_BldMotion_at_u, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! y_BldMotion_at_u - 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 NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%Map_u_DistrLoad_to_y, ErrStat2, ErrMsg2, OnlySize ) ! Map_u_DistrLoad_to_y - 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 NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%Map_y_BldMotion_to_u, ErrStat2, ErrMsg2, OnlySize ) ! Map_y_BldMotion_to_u - 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%Un_Sum - Int_Xferred = Int_Xferred + 1 - CALL BD_Packeqmotionqp( Re_Buf, Db_Buf, Int_Buf, InData%qp, ErrStat2, ErrMsg2, OnlySize ) ! qp - 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%lin_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%lin_A,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%lin_A,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%lin_A,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%lin_A,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%lin_A,2), UBOUND(InData%lin_A,2) - DO i1 = LBOUND(InData%lin_A,1), UBOUND(InData%lin_A,1) - DbKiBuf(Db_Xferred) = InData%lin_A(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%lin_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%lin_C,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%lin_C,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%lin_C,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%lin_C,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%lin_C,2), UBOUND(InData%lin_C,2) - DO i1 = LBOUND(InData%lin_C,1), UBOUND(InData%lin_C,1) - DbKiBuf(Db_Xferred) = InData%lin_C(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Nrrr) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Nrrr,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Nrrr,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Nrrr,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Nrrr,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Nrrr,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Nrrr,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Nrrr,3), UBOUND(InData%Nrrr,3) - DO i2 = LBOUND(InData%Nrrr,2), UBOUND(InData%Nrrr,2) - DO i1 = LBOUND(InData%Nrrr,1), UBOUND(InData%Nrrr,1) - DbKiBuf(Db_Xferred) = InData%Nrrr(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%elf) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%elf,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%elf,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%elf,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%elf,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%elf,2), UBOUND(InData%elf,2) - DO i1 = LBOUND(InData%elf,1), UBOUND(InData%elf,1) - DbKiBuf(Db_Xferred) = InData%elf(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%EFint) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%EFint,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%EFint,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%EFint,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%EFint,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%EFint,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%EFint,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%EFint,3), UBOUND(InData%EFint,3) - DO i2 = LBOUND(InData%EFint,2), UBOUND(InData%EFint,2) - DO i1 = LBOUND(InData%EFint,1), UBOUND(InData%EFint,1) - DbKiBuf(Db_Xferred) = InData%EFint(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%elk) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%elk,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%elk,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%elk,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%elk,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%elk,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%elk,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%elk,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%elk,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%elk,4), UBOUND(InData%elk,4) - DO i3 = LBOUND(InData%elk,3), UBOUND(InData%elk,3) - DO i2 = LBOUND(InData%elk,2), UBOUND(InData%elk,2) - DO i1 = LBOUND(InData%elk,1), UBOUND(InData%elk,1) - DbKiBuf(Db_Xferred) = InData%elk(i1,i2,i3,i4) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%elg) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%elg,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%elg,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%elg,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%elg,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%elg,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%elg,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%elg,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%elg,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%elg,4), UBOUND(InData%elg,4) - DO i3 = LBOUND(InData%elg,3), UBOUND(InData%elg,3) - DO i2 = LBOUND(InData%elg,2), UBOUND(InData%elg,2) - DO i1 = LBOUND(InData%elg,1), UBOUND(InData%elg,1) - DbKiBuf(Db_Xferred) = InData%elg(i1,i2,i3,i4) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%elm) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%elm,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%elm,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%elm,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%elm,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%elm,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%elm,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%elm,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%elm,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%elm,4), UBOUND(InData%elm,4) - DO i3 = LBOUND(InData%elm,3), UBOUND(InData%elm,3) - DO i2 = LBOUND(InData%elm,2), UBOUND(InData%elm,2) - DO i1 = LBOUND(InData%elm,1), UBOUND(InData%elm,1) - DbKiBuf(Db_Xferred) = InData%elm(i1,i2,i3,i4) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%DistrLoad_QP) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DistrLoad_QP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DistrLoad_QP,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DistrLoad_QP,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DistrLoad_QP,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DistrLoad_QP,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DistrLoad_QP,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%DistrLoad_QP,3), UBOUND(InData%DistrLoad_QP,3) - DO i2 = LBOUND(InData%DistrLoad_QP,2), UBOUND(InData%DistrLoad_QP,2) - DO i1 = LBOUND(InData%DistrLoad_QP,1), UBOUND(InData%DistrLoad_QP,1) - DbKiBuf(Db_Xferred) = InData%DistrLoad_QP(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PointLoadLcl) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PointLoadLcl,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PointLoadLcl,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PointLoadLcl,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PointLoadLcl,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PointLoadLcl,2), UBOUND(InData%PointLoadLcl,2) - DO i1 = LBOUND(InData%PointLoadLcl,1), UBOUND(InData%PointLoadLcl,1) - DbKiBuf(Db_Xferred) = InData%PointLoadLcl(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%StifK) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StifK,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StifK,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StifK,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StifK,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StifK,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StifK,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StifK,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StifK,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%StifK,4), UBOUND(InData%StifK,4) - DO i3 = LBOUND(InData%StifK,3), UBOUND(InData%StifK,3) - DO i2 = LBOUND(InData%StifK,2), UBOUND(InData%StifK,2) - DO i1 = LBOUND(InData%StifK,1), UBOUND(InData%StifK,1) - DbKiBuf(Db_Xferred) = InData%StifK(i1,i2,i3,i4) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%MassM) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MassM,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MassM,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MassM,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MassM,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MassM,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MassM,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MassM,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MassM,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%MassM,4), UBOUND(InData%MassM,4) - DO i3 = LBOUND(InData%MassM,3), UBOUND(InData%MassM,3) - DO i2 = LBOUND(InData%MassM,2), UBOUND(InData%MassM,2) - DO i1 = LBOUND(InData%MassM,1), UBOUND(InData%MassM,1) - DbKiBuf(Db_Xferred) = InData%MassM(i1,i2,i3,i4) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%DampG) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DampG,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DampG,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DampG,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DampG,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DampG,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DampG,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DampG,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DampG,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%DampG,4), UBOUND(InData%DampG,4) - DO i3 = LBOUND(InData%DampG,3), UBOUND(InData%DampG,3) - DO i2 = LBOUND(InData%DampG,2), UBOUND(InData%DampG,2) - DO i1 = LBOUND(InData%DampG,1), UBOUND(InData%DampG,1) - DbKiBuf(Db_Xferred) = InData%DampG(i1,i2,i3,i4) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%StifK_fd) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StifK_fd,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StifK_fd,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StifK_fd,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StifK_fd,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StifK_fd,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StifK_fd,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StifK_fd,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StifK_fd,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%StifK_fd,4), UBOUND(InData%StifK_fd,4) - DO i3 = LBOUND(InData%StifK_fd,3), UBOUND(InData%StifK_fd,3) - DO i2 = LBOUND(InData%StifK_fd,2), UBOUND(InData%StifK_fd,2) - DO i1 = LBOUND(InData%StifK_fd,1), UBOUND(InData%StifK_fd,1) - DbKiBuf(Db_Xferred) = InData%StifK_fd(i1,i2,i3,i4) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%MassM_fd) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MassM_fd,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MassM_fd,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MassM_fd,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MassM_fd,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MassM_fd,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MassM_fd,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MassM_fd,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MassM_fd,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%MassM_fd,4), UBOUND(InData%MassM_fd,4) - DO i3 = LBOUND(InData%MassM_fd,3), UBOUND(InData%MassM_fd,3) - DO i2 = LBOUND(InData%MassM_fd,2), UBOUND(InData%MassM_fd,2) - DO i1 = LBOUND(InData%MassM_fd,1), UBOUND(InData%MassM_fd,1) - DbKiBuf(Db_Xferred) = InData%MassM_fd(i1,i2,i3,i4) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%DampG_fd) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DampG_fd,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DampG_fd,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DampG_fd,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DampG_fd,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DampG_fd,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DampG_fd,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DampG_fd,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DampG_fd,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%DampG_fd,4), UBOUND(InData%DampG_fd,4) - DO i3 = LBOUND(InData%DampG_fd,3), UBOUND(InData%DampG_fd,3) - DO i2 = LBOUND(InData%DampG_fd,2), UBOUND(InData%DampG_fd,2) - DO i1 = LBOUND(InData%DampG_fd,1), UBOUND(InData%DampG_fd,1) - DbKiBuf(Db_Xferred) = InData%DampG_fd(i1,i2,i3,i4) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%RHS) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RHS,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RHS,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RHS,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RHS,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%RHS,2), UBOUND(InData%RHS,2) - DO i1 = LBOUND(InData%RHS,1), UBOUND(InData%RHS,1) - DbKiBuf(Db_Xferred) = InData%RHS(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%RHS_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%RHS_p,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RHS_p,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RHS_p,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RHS_p,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%RHS_p,2), UBOUND(InData%RHS_p,2) - DO i1 = LBOUND(InData%RHS_p,1), UBOUND(InData%RHS_p,1) - DbKiBuf(Db_Xferred) = InData%RHS_p(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%RHS_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%RHS_m,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RHS_m,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RHS_m,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RHS_m,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%RHS_m,2), UBOUND(InData%RHS_m,2) - DO i1 = LBOUND(InData%RHS_m,1), UBOUND(InData%RHS_m,1) - DbKiBuf(Db_Xferred) = InData%RHS_m(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BldInternalForceFE) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BldInternalForceFE,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldInternalForceFE,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BldInternalForceFE,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldInternalForceFE,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%BldInternalForceFE,2), UBOUND(InData%BldInternalForceFE,2) - DO i1 = LBOUND(InData%BldInternalForceFE,1), UBOUND(InData%BldInternalForceFE,1) - DbKiBuf(Db_Xferred) = InData%BldInternalForceFE(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BldInternalForceQP) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BldInternalForceQP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldInternalForceQP,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BldInternalForceQP,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldInternalForceQP,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%BldInternalForceQP,2), UBOUND(InData%BldInternalForceQP,2) - DO i1 = LBOUND(InData%BldInternalForceQP,1), UBOUND(InData%BldInternalForceQP,1) - DbKiBuf(Db_Xferred) = InData%BldInternalForceQP(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%FirstNodeReactionLclForceMoment) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FirstNodeReactionLclForceMoment,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FirstNodeReactionLclForceMoment,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%FirstNodeReactionLclForceMoment,1), UBOUND(InData%FirstNodeReactionLclForceMoment,1) - DbKiBuf(Db_Xferred) = InData%FirstNodeReactionLclForceMoment(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Solution) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Solution,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Solution,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Solution,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Solution,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Solution,2), UBOUND(InData%Solution,2) - DO i1 = LBOUND(InData%Solution,1), UBOUND(InData%Solution,1) - DbKiBuf(Db_Xferred) = InData%Solution(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LP_StifK) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LP_StifK,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LP_StifK,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LP_StifK,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LP_StifK,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%LP_StifK,2), UBOUND(InData%LP_StifK,2) - DO i1 = LBOUND(InData%LP_StifK,1), UBOUND(InData%LP_StifK,1) - DbKiBuf(Db_Xferred) = InData%LP_StifK(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LP_MassM) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LP_MassM,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LP_MassM,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LP_MassM,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LP_MassM,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%LP_MassM,2), UBOUND(InData%LP_MassM,2) - DO i1 = LBOUND(InData%LP_MassM,1), UBOUND(InData%LP_MassM,1) - DbKiBuf(Db_Xferred) = InData%LP_MassM(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LP_MassM_LU) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LP_MassM_LU,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LP_MassM_LU,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LP_MassM_LU,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LP_MassM_LU,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%LP_MassM_LU,2), UBOUND(InData%LP_MassM_LU,2) - DO i1 = LBOUND(InData%LP_MassM_LU,1), UBOUND(InData%LP_MassM_LU,1) - DbKiBuf(Db_Xferred) = InData%LP_MassM_LU(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LP_RHS) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LP_RHS,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LP_RHS,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LP_RHS,1), UBOUND(InData%LP_RHS,1) - DbKiBuf(Db_Xferred) = InData%LP_RHS(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LP_StifK_LU) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LP_StifK_LU,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LP_StifK_LU,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LP_StifK_LU,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LP_StifK_LU,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%LP_StifK_LU,2), UBOUND(InData%LP_StifK_LU,2) - DO i1 = LBOUND(InData%LP_StifK_LU,1), UBOUND(InData%LP_StifK_LU,1) - DbKiBuf(Db_Xferred) = InData%LP_StifK_LU(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LP_RHS_LU) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LP_RHS_LU,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LP_RHS_LU,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LP_RHS_LU,1), UBOUND(InData%LP_RHS_LU,1) - DbKiBuf(Db_Xferred) = InData%LP_RHS_LU(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LP_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%LP_indx,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LP_indx,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LP_indx,1), UBOUND(InData%LP_indx,1) - IntKiBuf(Int_Xferred) = InData%LP_indx(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - CALL BD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u - 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 BD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u2, ErrStat2, ErrMsg2, OnlySize ) ! u2 - 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 BD_PackMisc - - SUBROUTINE BD_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(BD_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) :: 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 = 'BD_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 - 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%u_DistrLoad_at_y, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_DistrLoad_at_y - 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%y_BldMotion_at_u, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! y_BldMotion_at_u - 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 NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%Map_u_DistrLoad_to_y, ErrStat2, ErrMsg2 ) ! Map_u_DistrLoad_to_y - 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 NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%Map_y_BldMotion_to_u, ErrStat2, ErrMsg2 ) ! Map_y_BldMotion_to_u - 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%Un_Sum = IntKiBuf(Int_Xferred) - 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 BD_Unpackeqmotionqp( Re_Buf, Db_Buf, Int_Buf, OutData%qp, ErrStat2, ErrMsg2 ) ! qp - 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 ! lin_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 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%lin_A)) DEALLOCATE(OutData%lin_A) - ALLOCATE(OutData%lin_A(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%lin_A.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%lin_A,2), UBOUND(OutData%lin_A,2) - DO i1 = LBOUND(OutData%lin_A,1), UBOUND(OutData%lin_A,1) - OutData%lin_A(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! lin_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%lin_C)) DEALLOCATE(OutData%lin_C) - ALLOCATE(OutData%lin_C(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%lin_C.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%lin_C,2), UBOUND(OutData%lin_C,2) - DO i1 = LBOUND(OutData%lin_C,1), UBOUND(OutData%lin_C,1) - OutData%lin_C(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Nrrr not allocated - Int_Xferred = Int_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%Nrrr)) DEALLOCATE(OutData%Nrrr) - ALLOCATE(OutData%Nrrr(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%Nrrr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Nrrr,3), UBOUND(OutData%Nrrr,3) - DO i2 = LBOUND(OutData%Nrrr,2), UBOUND(OutData%Nrrr,2) - DO i1 = LBOUND(OutData%Nrrr,1), UBOUND(OutData%Nrrr,1) - OutData%Nrrr(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! elf not allocated - Int_Xferred = Int_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%elf)) DEALLOCATE(OutData%elf) - ALLOCATE(OutData%elf(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%elf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%elf,2), UBOUND(OutData%elf,2) - DO i1 = LBOUND(OutData%elf,1), UBOUND(OutData%elf,1) - OutData%elf(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! EFint not allocated - Int_Xferred = Int_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%EFint)) DEALLOCATE(OutData%EFint) - ALLOCATE(OutData%EFint(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%EFint.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%EFint,3), UBOUND(OutData%EFint,3) - DO i2 = LBOUND(OutData%EFint,2), UBOUND(OutData%EFint,2) - DO i1 = LBOUND(OutData%EFint,1), UBOUND(OutData%EFint,1) - OutData%EFint(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! elk not allocated - Int_Xferred = Int_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%elk)) DEALLOCATE(OutData%elk) - ALLOCATE(OutData%elk(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%elk.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%elk,4), UBOUND(OutData%elk,4) - DO i3 = LBOUND(OutData%elk,3), UBOUND(OutData%elk,3) - DO i2 = LBOUND(OutData%elk,2), UBOUND(OutData%elk,2) - DO i1 = LBOUND(OutData%elk,1), UBOUND(OutData%elk,1) - OutData%elk(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 ! elg not allocated - Int_Xferred = Int_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%elg)) DEALLOCATE(OutData%elg) - ALLOCATE(OutData%elg(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%elg.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%elg,4), UBOUND(OutData%elg,4) - DO i3 = LBOUND(OutData%elg,3), UBOUND(OutData%elg,3) - DO i2 = LBOUND(OutData%elg,2), UBOUND(OutData%elg,2) - DO i1 = LBOUND(OutData%elg,1), UBOUND(OutData%elg,1) - OutData%elg(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 ! elm not allocated - Int_Xferred = Int_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%elm)) DEALLOCATE(OutData%elm) - ALLOCATE(OutData%elm(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%elm.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%elm,4), UBOUND(OutData%elm,4) - DO i3 = LBOUND(OutData%elm,3), UBOUND(OutData%elm,3) - DO i2 = LBOUND(OutData%elm,2), UBOUND(OutData%elm,2) - DO i1 = LBOUND(OutData%elm,1), UBOUND(OutData%elm,1) - OutData%elm(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 ! DistrLoad_QP not allocated - Int_Xferred = Int_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%DistrLoad_QP)) DEALLOCATE(OutData%DistrLoad_QP) - ALLOCATE(OutData%DistrLoad_QP(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%DistrLoad_QP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%DistrLoad_QP,3), UBOUND(OutData%DistrLoad_QP,3) - DO i2 = LBOUND(OutData%DistrLoad_QP,2), UBOUND(OutData%DistrLoad_QP,2) - DO i1 = LBOUND(OutData%DistrLoad_QP,1), UBOUND(OutData%DistrLoad_QP,1) - OutData%DistrLoad_QP(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PointLoadLcl not allocated - Int_Xferred = Int_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%PointLoadLcl)) DEALLOCATE(OutData%PointLoadLcl) - ALLOCATE(OutData%PointLoadLcl(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PointLoadLcl.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PointLoadLcl,2), UBOUND(OutData%PointLoadLcl,2) - DO i1 = LBOUND(OutData%PointLoadLcl,1), UBOUND(OutData%PointLoadLcl,1) - OutData%PointLoadLcl(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StifK not allocated - Int_Xferred = Int_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%StifK)) DEALLOCATE(OutData%StifK) - ALLOCATE(OutData%StifK(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%StifK.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%StifK,4), UBOUND(OutData%StifK,4) - DO i3 = LBOUND(OutData%StifK,3), UBOUND(OutData%StifK,3) - DO i2 = LBOUND(OutData%StifK,2), UBOUND(OutData%StifK,2) - DO i1 = LBOUND(OutData%StifK,1), UBOUND(OutData%StifK,1) - OutData%StifK(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 ! MassM not allocated - Int_Xferred = Int_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%MassM)) DEALLOCATE(OutData%MassM) - ALLOCATE(OutData%MassM(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%MassM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%MassM,4), UBOUND(OutData%MassM,4) - DO i3 = LBOUND(OutData%MassM,3), UBOUND(OutData%MassM,3) - DO i2 = LBOUND(OutData%MassM,2), UBOUND(OutData%MassM,2) - DO i1 = LBOUND(OutData%MassM,1), UBOUND(OutData%MassM,1) - OutData%MassM(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 ! DampG not allocated - Int_Xferred = Int_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%DampG)) DEALLOCATE(OutData%DampG) - ALLOCATE(OutData%DampG(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%DampG.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%DampG,4), UBOUND(OutData%DampG,4) - DO i3 = LBOUND(OutData%DampG,3), UBOUND(OutData%DampG,3) - DO i2 = LBOUND(OutData%DampG,2), UBOUND(OutData%DampG,2) - DO i1 = LBOUND(OutData%DampG,1), UBOUND(OutData%DampG,1) - OutData%DampG(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 ! StifK_fd not allocated - Int_Xferred = Int_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%StifK_fd)) DEALLOCATE(OutData%StifK_fd) - ALLOCATE(OutData%StifK_fd(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%StifK_fd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%StifK_fd,4), UBOUND(OutData%StifK_fd,4) - DO i3 = LBOUND(OutData%StifK_fd,3), UBOUND(OutData%StifK_fd,3) - DO i2 = LBOUND(OutData%StifK_fd,2), UBOUND(OutData%StifK_fd,2) - DO i1 = LBOUND(OutData%StifK_fd,1), UBOUND(OutData%StifK_fd,1) - OutData%StifK_fd(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 ! MassM_fd not allocated - Int_Xferred = Int_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%MassM_fd)) DEALLOCATE(OutData%MassM_fd) - ALLOCATE(OutData%MassM_fd(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%MassM_fd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%MassM_fd,4), UBOUND(OutData%MassM_fd,4) - DO i3 = LBOUND(OutData%MassM_fd,3), UBOUND(OutData%MassM_fd,3) - DO i2 = LBOUND(OutData%MassM_fd,2), UBOUND(OutData%MassM_fd,2) - DO i1 = LBOUND(OutData%MassM_fd,1), UBOUND(OutData%MassM_fd,1) - OutData%MassM_fd(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 ! DampG_fd not allocated - Int_Xferred = Int_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%DampG_fd)) DEALLOCATE(OutData%DampG_fd) - ALLOCATE(OutData%DampG_fd(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%DampG_fd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%DampG_fd,4), UBOUND(OutData%DampG_fd,4) - DO i3 = LBOUND(OutData%DampG_fd,3), UBOUND(OutData%DampG_fd,3) - DO i2 = LBOUND(OutData%DampG_fd,2), UBOUND(OutData%DampG_fd,2) - DO i1 = LBOUND(OutData%DampG_fd,1), UBOUND(OutData%DampG_fd,1) - OutData%DampG_fd(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 ! RHS not allocated - Int_Xferred = Int_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%RHS)) DEALLOCATE(OutData%RHS) - ALLOCATE(OutData%RHS(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RHS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%RHS,2), UBOUND(OutData%RHS,2) - DO i1 = LBOUND(OutData%RHS,1), UBOUND(OutData%RHS,1) - OutData%RHS(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RHS_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%RHS_p)) DEALLOCATE(OutData%RHS_p) - ALLOCATE(OutData%RHS_p(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RHS_p.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%RHS_p,2), UBOUND(OutData%RHS_p,2) - DO i1 = LBOUND(OutData%RHS_p,1), UBOUND(OutData%RHS_p,1) - OutData%RHS_p(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RHS_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%RHS_m)) DEALLOCATE(OutData%RHS_m) - ALLOCATE(OutData%RHS_m(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RHS_m.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%RHS_m,2), UBOUND(OutData%RHS_m,2) - DO i1 = LBOUND(OutData%RHS_m,1), UBOUND(OutData%RHS_m,1) - OutData%RHS_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 ! BldInternalForceFE not allocated - Int_Xferred = Int_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%BldInternalForceFE)) DEALLOCATE(OutData%BldInternalForceFE) - ALLOCATE(OutData%BldInternalForceFE(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldInternalForceFE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%BldInternalForceFE,2), UBOUND(OutData%BldInternalForceFE,2) - DO i1 = LBOUND(OutData%BldInternalForceFE,1), UBOUND(OutData%BldInternalForceFE,1) - OutData%BldInternalForceFE(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldInternalForceQP not allocated - Int_Xferred = Int_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%BldInternalForceQP)) DEALLOCATE(OutData%BldInternalForceQP) - ALLOCATE(OutData%BldInternalForceQP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldInternalForceQP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%BldInternalForceQP,2), UBOUND(OutData%BldInternalForceQP,2) - DO i1 = LBOUND(OutData%BldInternalForceQP,1), UBOUND(OutData%BldInternalForceQP,1) - OutData%BldInternalForceQP(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FirstNodeReactionLclForceMoment not allocated - Int_Xferred = Int_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%FirstNodeReactionLclForceMoment)) DEALLOCATE(OutData%FirstNodeReactionLclForceMoment) - ALLOCATE(OutData%FirstNodeReactionLclForceMoment(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FirstNodeReactionLclForceMoment.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%FirstNodeReactionLclForceMoment,1), UBOUND(OutData%FirstNodeReactionLclForceMoment,1) - OutData%FirstNodeReactionLclForceMoment(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Solution not allocated - Int_Xferred = Int_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%Solution)) DEALLOCATE(OutData%Solution) - ALLOCATE(OutData%Solution(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Solution.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Solution,2), UBOUND(OutData%Solution,2) - DO i1 = LBOUND(OutData%Solution,1), UBOUND(OutData%Solution,1) - OutData%Solution(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LP_StifK not allocated - Int_Xferred = Int_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%LP_StifK)) DEALLOCATE(OutData%LP_StifK) - ALLOCATE(OutData%LP_StifK(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LP_StifK.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%LP_StifK,2), UBOUND(OutData%LP_StifK,2) - DO i1 = LBOUND(OutData%LP_StifK,1), UBOUND(OutData%LP_StifK,1) - OutData%LP_StifK(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LP_MassM not allocated - Int_Xferred = Int_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%LP_MassM)) DEALLOCATE(OutData%LP_MassM) - ALLOCATE(OutData%LP_MassM(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LP_MassM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%LP_MassM,2), UBOUND(OutData%LP_MassM,2) - DO i1 = LBOUND(OutData%LP_MassM,1), UBOUND(OutData%LP_MassM,1) - OutData%LP_MassM(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LP_MassM_LU not allocated - Int_Xferred = Int_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%LP_MassM_LU)) DEALLOCATE(OutData%LP_MassM_LU) - ALLOCATE(OutData%LP_MassM_LU(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LP_MassM_LU.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%LP_MassM_LU,2), UBOUND(OutData%LP_MassM_LU,2) - DO i1 = LBOUND(OutData%LP_MassM_LU,1), UBOUND(OutData%LP_MassM_LU,1) - OutData%LP_MassM_LU(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LP_RHS not allocated - Int_Xferred = Int_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%LP_RHS)) DEALLOCATE(OutData%LP_RHS) - ALLOCATE(OutData%LP_RHS(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LP_RHS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LP_RHS,1), UBOUND(OutData%LP_RHS,1) - OutData%LP_RHS(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LP_StifK_LU not allocated - Int_Xferred = Int_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%LP_StifK_LU)) DEALLOCATE(OutData%LP_StifK_LU) - ALLOCATE(OutData%LP_StifK_LU(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LP_StifK_LU.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%LP_StifK_LU,2), UBOUND(OutData%LP_StifK_LU,2) - DO i1 = LBOUND(OutData%LP_StifK_LU,1), UBOUND(OutData%LP_StifK_LU,1) - OutData%LP_StifK_LU(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LP_RHS_LU not allocated - Int_Xferred = Int_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%LP_RHS_LU)) DEALLOCATE(OutData%LP_RHS_LU) - ALLOCATE(OutData%LP_RHS_LU(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LP_RHS_LU.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LP_RHS_LU,1), UBOUND(OutData%LP_RHS_LU,1) - OutData%LP_RHS_LU(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LP_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 - IF (ALLOCATED(OutData%LP_indx)) DEALLOCATE(OutData%LP_indx) - ALLOCATE(OutData%LP_indx(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LP_indx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LP_indx,1), UBOUND(OutData%LP_indx,1) - OutData%LP_indx(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_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 BD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u - 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 BD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u2, ErrStat2, ErrMsg2 ) ! u2 - 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 BD_UnPackMisc - - - SUBROUTINE BD_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(BD_InputType), INTENT(INOUT) :: u(:) ! Input at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Inputs - TYPE(BD_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 + ErrMsg = '' + DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState +end subroutine + +subroutine BD_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) + type(BD_ConstraintStateType), intent(inout) :: ConstrStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'BD_DestroyConstrState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine BD_PackConstrState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(BD_ConstraintStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'BD_PackConstrState' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyConstrState) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine BD_UnPackConstrState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(BD_ConstraintStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'BD_UnPackConstrState' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyConstrState); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine BD_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) + type(BD_OtherStateType), intent(in) :: SrcOtherStateData + type(BD_OtherStateType), intent(inout) :: DstOtherStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'BD_CopyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcOtherStateData%acc)) then + LB(1:2) = lbound(SrcOtherStateData%acc) + UB(1:2) = ubound(SrcOtherStateData%acc) + if (.not. allocated(DstOtherStateData%acc)) then + allocate(DstOtherStateData%acc(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%acc.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOtherStateData%acc = SrcOtherStateData%acc + end if + if (allocated(SrcOtherStateData%xcc)) then + LB(1:2) = lbound(SrcOtherStateData%xcc) + UB(1:2) = ubound(SrcOtherStateData%xcc) + if (.not. allocated(DstOtherStateData%xcc)) then + allocate(DstOtherStateData%xcc(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%xcc.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOtherStateData%xcc = SrcOtherStateData%xcc + end if + DstOtherStateData%InitAcc = SrcOtherStateData%InitAcc + DstOtherStateData%RunQuasiStaticInit = SrcOtherStateData%RunQuasiStaticInit + DstOtherStateData%GlbPos = SrcOtherStateData%GlbPos + DstOtherStateData%GlbRot = SrcOtherStateData%GlbRot + DstOtherStateData%Glb_crv = SrcOtherStateData%Glb_crv +end subroutine + +subroutine BD_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) + type(BD_OtherStateType), intent(inout) :: OtherStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'BD_DestroyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OtherStateData%acc)) then + deallocate(OtherStateData%acc) + end if + if (allocated(OtherStateData%xcc)) then + deallocate(OtherStateData%xcc) + end if +end subroutine + +subroutine BD_PackOtherState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(BD_OtherStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'BD_PackOtherState' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%acc) + call RegPackAlloc(RF, InData%xcc) + call RegPack(RF, InData%InitAcc) + call RegPack(RF, InData%RunQuasiStaticInit) + call RegPack(RF, InData%GlbPos) + call RegPack(RF, InData%GlbRot) + call RegPack(RF, InData%Glb_crv) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine BD_UnPackOtherState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(BD_OtherStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'BD_UnPackOtherState' + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%acc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%xcc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%InitAcc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RunQuasiStaticInit); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GlbPos); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GlbRot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Glb_crv); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine BD_CopyqpParam(SrcqpParamData, DstqpParamData, CtrlCode, ErrStat, ErrMsg) + type(qpParam), intent(in) :: SrcqpParamData + type(qpParam), intent(inout) :: DstqpParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'BD_CopyqpParam' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcqpParamData%mmm)) then + LB(1:2) = lbound(SrcqpParamData%mmm) + UB(1:2) = ubound(SrcqpParamData%mmm) + if (.not. allocated(DstqpParamData%mmm)) then + allocate(DstqpParamData%mmm(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstqpParamData%mmm.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstqpParamData%mmm = SrcqpParamData%mmm + end if + if (allocated(SrcqpParamData%mEta)) then + LB(1:3) = lbound(SrcqpParamData%mEta) + UB(1:3) = ubound(SrcqpParamData%mEta) + if (.not. allocated(DstqpParamData%mEta)) then + allocate(DstqpParamData%mEta(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstqpParamData%mEta.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstqpParamData%mEta = SrcqpParamData%mEta + end if +end subroutine + +subroutine BD_DestroyqpParam(qpParamData, ErrStat, ErrMsg) + type(qpParam), intent(inout) :: qpParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'BD_DestroyqpParam' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(qpParamData%mmm)) then + deallocate(qpParamData%mmm) + end if + if (allocated(qpParamData%mEta)) then + deallocate(qpParamData%mEta) + end if +end subroutine + +subroutine BD_PackqpParam(RF, Indata) + type(RegFile), intent(inout) :: RF + type(qpParam), intent(in) :: InData + character(*), parameter :: RoutineName = 'BD_PackqpParam' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%mmm) + call RegPackAlloc(RF, InData%mEta) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine BD_UnPackqpParam(RF, OutData) + type(RegFile), intent(inout) :: RF + type(qpParam), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'BD_UnPackqpParam' + integer(B4Ki) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%mmm); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%mEta); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(BD_ParameterType), intent(in) :: SrcParamData + type(BD_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2, i3, i4 + integer(B4Ki) :: LB(4), UB(4) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'BD_CopyParam' + ErrStat = ErrID_None + ErrMsg = '' + DstParamData%dt = SrcParamData%dt + DstParamData%coef = SrcParamData%coef + DstParamData%rhoinf = SrcParamData%rhoinf + if (allocated(SrcParamData%uuN0)) then + LB(1:3) = lbound(SrcParamData%uuN0) + UB(1:3) = ubound(SrcParamData%uuN0) + if (.not. allocated(DstParamData%uuN0)) then + allocate(DstParamData%uuN0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%uuN0.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%uuN0 = SrcParamData%uuN0 + end if + if (allocated(SrcParamData%Stif0_QP)) then + LB(1:3) = lbound(SrcParamData%Stif0_QP) + UB(1:3) = ubound(SrcParamData%Stif0_QP) + if (.not. allocated(DstParamData%Stif0_QP)) then + allocate(DstParamData%Stif0_QP(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Stif0_QP.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Stif0_QP = SrcParamData%Stif0_QP + end if + if (allocated(SrcParamData%Mass0_QP)) then + LB(1:3) = lbound(SrcParamData%Mass0_QP) + UB(1:3) = ubound(SrcParamData%Mass0_QP) + if (.not. allocated(DstParamData%Mass0_QP)) then + allocate(DstParamData%Mass0_QP(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Mass0_QP.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Mass0_QP = SrcParamData%Mass0_QP + end if + DstParamData%gravity = SrcParamData%gravity + if (allocated(SrcParamData%segment_eta)) then + LB(1:1) = lbound(SrcParamData%segment_eta) + UB(1:1) = ubound(SrcParamData%segment_eta) + if (.not. allocated(DstParamData%segment_eta)) then + allocate(DstParamData%segment_eta(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%segment_eta.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%segment_eta = SrcParamData%segment_eta + end if + if (allocated(SrcParamData%member_eta)) then + LB(1:1) = lbound(SrcParamData%member_eta) + UB(1:1) = ubound(SrcParamData%member_eta) + if (.not. allocated(DstParamData%member_eta)) then + allocate(DstParamData%member_eta(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%member_eta.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%member_eta = SrcParamData%member_eta + end if + DstParamData%blade_length = SrcParamData%blade_length + DstParamData%blade_mass = SrcParamData%blade_mass + DstParamData%blade_CG = SrcParamData%blade_CG + DstParamData%blade_IN = SrcParamData%blade_IN + DstParamData%beta = SrcParamData%beta + DstParamData%tol = SrcParamData%tol + if (allocated(SrcParamData%QPtN)) then + LB(1:1) = lbound(SrcParamData%QPtN) + UB(1:1) = ubound(SrcParamData%QPtN) + if (.not. allocated(DstParamData%QPtN)) then + allocate(DstParamData%QPtN(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%QPtN.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%QPtN = SrcParamData%QPtN + end if + if (allocated(SrcParamData%QPtWeight)) then + LB(1:1) = lbound(SrcParamData%QPtWeight) + UB(1:1) = ubound(SrcParamData%QPtWeight) + if (.not. allocated(DstParamData%QPtWeight)) then + allocate(DstParamData%QPtWeight(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%QPtWeight.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%QPtWeight = SrcParamData%QPtWeight + end if + if (allocated(SrcParamData%Shp)) then + LB(1:2) = lbound(SrcParamData%Shp) + UB(1:2) = ubound(SrcParamData%Shp) + if (.not. allocated(DstParamData%Shp)) then + allocate(DstParamData%Shp(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Shp.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Shp = SrcParamData%Shp + end if + if (allocated(SrcParamData%ShpDer)) then + LB(1:2) = lbound(SrcParamData%ShpDer) + UB(1:2) = ubound(SrcParamData%ShpDer) + if (.not. allocated(DstParamData%ShpDer)) then + allocate(DstParamData%ShpDer(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ShpDer.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%ShpDer = SrcParamData%ShpDer + end if + if (allocated(SrcParamData%Jacobian)) then + LB(1:2) = lbound(SrcParamData%Jacobian) + UB(1:2) = ubound(SrcParamData%Jacobian) + if (.not. allocated(DstParamData%Jacobian)) then + allocate(DstParamData%Jacobian(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jacobian.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Jacobian = SrcParamData%Jacobian + end if + if (allocated(SrcParamData%uu0)) then + LB(1:3) = lbound(SrcParamData%uu0) + UB(1:3) = ubound(SrcParamData%uu0) + if (.not. allocated(DstParamData%uu0)) then + allocate(DstParamData%uu0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%uu0.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%uu0 = SrcParamData%uu0 + end if + if (allocated(SrcParamData%rrN0)) then + LB(1:3) = lbound(SrcParamData%rrN0) + UB(1:3) = ubound(SrcParamData%rrN0) + if (.not. allocated(DstParamData%rrN0)) then + allocate(DstParamData%rrN0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rrN0.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%rrN0 = SrcParamData%rrN0 + end if + if (allocated(SrcParamData%E10)) then + LB(1:3) = lbound(SrcParamData%E10) + UB(1:3) = ubound(SrcParamData%E10) + if (.not. allocated(DstParamData%E10)) then + allocate(DstParamData%E10(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%E10.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%E10 = SrcParamData%E10 + end if + DstParamData%nodes_per_elem = SrcParamData%nodes_per_elem + if (allocated(SrcParamData%node_elem_idx)) then + LB(1:2) = lbound(SrcParamData%node_elem_idx) + UB(1:2) = ubound(SrcParamData%node_elem_idx) + if (.not. allocated(DstParamData%node_elem_idx)) then + allocate(DstParamData%node_elem_idx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%node_elem_idx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%node_elem_idx = SrcParamData%node_elem_idx + end if + DstParamData%refine = SrcParamData%refine + DstParamData%dof_node = SrcParamData%dof_node + DstParamData%dof_elem = SrcParamData%dof_elem + DstParamData%rot_elem = SrcParamData%rot_elem + DstParamData%elem_total = SrcParamData%elem_total + DstParamData%node_total = SrcParamData%node_total + DstParamData%dof_total = SrcParamData%dof_total + DstParamData%nqp = SrcParamData%nqp + DstParamData%analysis_type = SrcParamData%analysis_type + DstParamData%damp_flag = SrcParamData%damp_flag + DstParamData%ld_retries = SrcParamData%ld_retries + DstParamData%niter = SrcParamData%niter + DstParamData%quadrature = SrcParamData%quadrature + DstParamData%n_fact = SrcParamData%n_fact + DstParamData%OutInputs = SrcParamData%OutInputs + DstParamData%NumOuts = SrcParamData%NumOuts + if (allocated(SrcParamData%OutParam)) then + LB(1:1) = lbound(SrcParamData%OutParam) + UB(1:1) = ubound(SrcParamData%OutParam) + if (.not. allocated(DstParamData%OutParam)) then + allocate(DstParamData%OutParam(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutParam.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyOutParmType(SrcParamData%OutParam(i1), DstParamData%OutParam(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + DstParamData%NNodeOuts = SrcParamData%NNodeOuts + DstParamData%OutNd = SrcParamData%OutNd + if (allocated(SrcParamData%NdIndx)) then + LB(1:1) = lbound(SrcParamData%NdIndx) + UB(1:1) = ubound(SrcParamData%NdIndx) + if (.not. allocated(DstParamData%NdIndx)) then + allocate(DstParamData%NdIndx(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%NdIndx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%NdIndx = SrcParamData%NdIndx + end if + if (allocated(SrcParamData%NdIndxInverse)) then + LB(1:1) = lbound(SrcParamData%NdIndxInverse) + UB(1:1) = ubound(SrcParamData%NdIndxInverse) + if (.not. allocated(DstParamData%NdIndxInverse)) then + allocate(DstParamData%NdIndxInverse(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%NdIndxInverse.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%NdIndxInverse = SrcParamData%NdIndxInverse + end if + if (allocated(SrcParamData%OutNd2NdElem)) then + LB(1:2) = lbound(SrcParamData%OutNd2NdElem) + UB(1:2) = ubound(SrcParamData%OutNd2NdElem) + if (.not. allocated(DstParamData%OutNd2NdElem)) then + allocate(DstParamData%OutNd2NdElem(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutNd2NdElem.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%OutNd2NdElem = SrcParamData%OutNd2NdElem + end if + DstParamData%OutFmt = SrcParamData%OutFmt + DstParamData%UsePitchAct = SrcParamData%UsePitchAct + DstParamData%pitchJ = SrcParamData%pitchJ + DstParamData%pitchK = SrcParamData%pitchK + DstParamData%pitchC = SrcParamData%pitchC + DstParamData%torqM = SrcParamData%torqM + call BD_CopyqpParam(SrcParamData%qp, DstParamData%qp, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstParamData%qp_indx_offset = SrcParamData%qp_indx_offset + DstParamData%BldMotionNodeLoc = SrcParamData%BldMotionNodeLoc + DstParamData%tngt_stf_fd = SrcParamData%tngt_stf_fd + DstParamData%tngt_stf_comp = SrcParamData%tngt_stf_comp + DstParamData%tngt_stf_pert = SrcParamData%tngt_stf_pert + DstParamData%tngt_stf_difftol = SrcParamData%tngt_stf_difftol + DstParamData%BldNd_NumOuts = SrcParamData%BldNd_NumOuts + DstParamData%BldNd_TotNumOuts = SrcParamData%BldNd_TotNumOuts + if (allocated(SrcParamData%BldNd_OutParam)) then + LB(1:1) = lbound(SrcParamData%BldNd_OutParam) + UB(1:1) = ubound(SrcParamData%BldNd_OutParam) + if (.not. allocated(DstParamData%BldNd_OutParam)) then + allocate(DstParamData%BldNd_OutParam(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BldNd_OutParam.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyOutParmType(SrcParamData%BldNd_OutParam(i1), DstParamData%BldNd_OutParam(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcParamData%BldNd_BlOutNd)) then + LB(1:1) = lbound(SrcParamData%BldNd_BlOutNd) + UB(1:1) = ubound(SrcParamData%BldNd_BlOutNd) + if (.not. allocated(DstParamData%BldNd_BlOutNd)) then + allocate(DstParamData%BldNd_BlOutNd(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BldNd_BlOutNd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%BldNd_BlOutNd = SrcParamData%BldNd_BlOutNd + end if + if (allocated(SrcParamData%QPtw_Shp_Shp_Jac)) then + LB(1:4) = lbound(SrcParamData%QPtw_Shp_Shp_Jac) + UB(1:4) = ubound(SrcParamData%QPtw_Shp_Shp_Jac) + if (.not. allocated(DstParamData%QPtw_Shp_Shp_Jac)) then + allocate(DstParamData%QPtw_Shp_Shp_Jac(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%QPtw_Shp_Shp_Jac.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%QPtw_Shp_Shp_Jac = SrcParamData%QPtw_Shp_Shp_Jac + end if + if (allocated(SrcParamData%QPtw_Shp_ShpDer)) then + LB(1:3) = lbound(SrcParamData%QPtw_Shp_ShpDer) + UB(1:3) = ubound(SrcParamData%QPtw_Shp_ShpDer) + if (.not. allocated(DstParamData%QPtw_Shp_ShpDer)) then + allocate(DstParamData%QPtw_Shp_ShpDer(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%QPtw_Shp_ShpDer.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%QPtw_Shp_ShpDer = SrcParamData%QPtw_Shp_ShpDer + end if + if (allocated(SrcParamData%QPtw_ShpDer_ShpDer_Jac)) then + LB(1:4) = lbound(SrcParamData%QPtw_ShpDer_ShpDer_Jac) + UB(1:4) = ubound(SrcParamData%QPtw_ShpDer_ShpDer_Jac) + if (.not. allocated(DstParamData%QPtw_ShpDer_ShpDer_Jac)) then + allocate(DstParamData%QPtw_ShpDer_ShpDer_Jac(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%QPtw_ShpDer_ShpDer_Jac.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%QPtw_ShpDer_ShpDer_Jac = SrcParamData%QPtw_ShpDer_ShpDer_Jac + end if + if (allocated(SrcParamData%QPtw_Shp_Jac)) then + LB(1:3) = lbound(SrcParamData%QPtw_Shp_Jac) + UB(1:3) = ubound(SrcParamData%QPtw_Shp_Jac) + if (.not. allocated(DstParamData%QPtw_Shp_Jac)) then + allocate(DstParamData%QPtw_Shp_Jac(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%QPtw_Shp_Jac.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%QPtw_Shp_Jac = SrcParamData%QPtw_Shp_Jac + end if + if (allocated(SrcParamData%QPtw_ShpDer)) then + LB(1:2) = lbound(SrcParamData%QPtw_ShpDer) + UB(1:2) = ubound(SrcParamData%QPtw_ShpDer) + if (.not. allocated(DstParamData%QPtw_ShpDer)) then + allocate(DstParamData%QPtw_ShpDer(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%QPtw_ShpDer.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%QPtw_ShpDer = SrcParamData%QPtw_ShpDer + end if + if (allocated(SrcParamData%FEweight)) then + LB(1:2) = lbound(SrcParamData%FEweight) + UB(1:2) = ubound(SrcParamData%FEweight) + if (.not. allocated(DstParamData%FEweight)) then + allocate(DstParamData%FEweight(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%FEweight.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%FEweight = SrcParamData%FEweight + end if + if (allocated(SrcParamData%Jac_u_indx)) then + LB(1:2) = lbound(SrcParamData%Jac_u_indx) + UB(1:2) = ubound(SrcParamData%Jac_u_indx) + if (.not. allocated(DstParamData%Jac_u_indx)) then + allocate(DstParamData%Jac_u_indx(LB(1):UB(1),LB(2):UB(2)), 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 + end if + if (allocated(SrcParamData%du)) then + LB(1:1) = lbound(SrcParamData%du) + UB(1:1) = ubound(SrcParamData%du) + if (.not. allocated(DstParamData%du)) then + allocate(DstParamData%du(LB(1):UB(1)), 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 + end if + DstParamData%dx = SrcParamData%dx + DstParamData%Jac_ny = SrcParamData%Jac_ny + DstParamData%Jac_nx = SrcParamData%Jac_nx + DstParamData%RotStates = SrcParamData%RotStates + DstParamData%RelStates = SrcParamData%RelStates + DstParamData%CompAeroMaps = SrcParamData%CompAeroMaps +end subroutine + +subroutine BD_DestroyParam(ParamData, ErrStat, ErrMsg) + type(BD_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2, i3, i4 + integer(B4Ki) :: LB(4), UB(4) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'BD_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ParamData%uuN0)) then + deallocate(ParamData%uuN0) + end if + if (allocated(ParamData%Stif0_QP)) then + deallocate(ParamData%Stif0_QP) + end if + if (allocated(ParamData%Mass0_QP)) then + deallocate(ParamData%Mass0_QP) + end if + if (allocated(ParamData%segment_eta)) then + deallocate(ParamData%segment_eta) + end if + if (allocated(ParamData%member_eta)) then + deallocate(ParamData%member_eta) + end if + if (allocated(ParamData%QPtN)) then + deallocate(ParamData%QPtN) + end if + if (allocated(ParamData%QPtWeight)) then + deallocate(ParamData%QPtWeight) + end if + if (allocated(ParamData%Shp)) then + deallocate(ParamData%Shp) + end if + if (allocated(ParamData%ShpDer)) then + deallocate(ParamData%ShpDer) + end if + if (allocated(ParamData%Jacobian)) then + deallocate(ParamData%Jacobian) + end if + if (allocated(ParamData%uu0)) then + deallocate(ParamData%uu0) + end if + if (allocated(ParamData%rrN0)) then + deallocate(ParamData%rrN0) + end if + if (allocated(ParamData%E10)) then + deallocate(ParamData%E10) + end if + if (allocated(ParamData%node_elem_idx)) then + deallocate(ParamData%node_elem_idx) + end if + if (allocated(ParamData%OutParam)) then + LB(1:1) = lbound(ParamData%OutParam) + UB(1:1) = ubound(ParamData%OutParam) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyOutParmType(ParamData%OutParam(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%OutParam) + end if + if (allocated(ParamData%NdIndx)) then + deallocate(ParamData%NdIndx) + end if + if (allocated(ParamData%NdIndxInverse)) then + deallocate(ParamData%NdIndxInverse) + end if + if (allocated(ParamData%OutNd2NdElem)) then + deallocate(ParamData%OutNd2NdElem) + end if + call BD_DestroyqpParam(ParamData%qp, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(ParamData%BldNd_OutParam)) then + LB(1:1) = lbound(ParamData%BldNd_OutParam) + UB(1:1) = ubound(ParamData%BldNd_OutParam) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyOutParmType(ParamData%BldNd_OutParam(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%BldNd_OutParam) + end if + if (allocated(ParamData%BldNd_BlOutNd)) then + deallocate(ParamData%BldNd_BlOutNd) + end if + if (allocated(ParamData%QPtw_Shp_Shp_Jac)) then + deallocate(ParamData%QPtw_Shp_Shp_Jac) + end if + if (allocated(ParamData%QPtw_Shp_ShpDer)) then + deallocate(ParamData%QPtw_Shp_ShpDer) + end if + if (allocated(ParamData%QPtw_ShpDer_ShpDer_Jac)) then + deallocate(ParamData%QPtw_ShpDer_ShpDer_Jac) + end if + if (allocated(ParamData%QPtw_Shp_Jac)) then + deallocate(ParamData%QPtw_Shp_Jac) + end if + if (allocated(ParamData%QPtw_ShpDer)) then + deallocate(ParamData%QPtw_ShpDer) + end if + if (allocated(ParamData%FEweight)) then + deallocate(ParamData%FEweight) + end if + if (allocated(ParamData%Jac_u_indx)) then + deallocate(ParamData%Jac_u_indx) + end if + if (allocated(ParamData%du)) then + deallocate(ParamData%du) + end if +end subroutine + +subroutine BD_PackParam(RF, Indata) + type(RegFile), intent(inout) :: RF + type(BD_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'BD_PackParam' + integer(B4Ki) :: i1, i2, i3, i4 + integer(B4Ki) :: LB(4), UB(4) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%dt) + call RegPack(RF, InData%coef) + call RegPack(RF, InData%rhoinf) + call RegPackAlloc(RF, InData%uuN0) + call RegPackAlloc(RF, InData%Stif0_QP) + call RegPackAlloc(RF, InData%Mass0_QP) + call RegPack(RF, InData%gravity) + call RegPackAlloc(RF, InData%segment_eta) + call RegPackAlloc(RF, InData%member_eta) + call RegPack(RF, InData%blade_length) + call RegPack(RF, InData%blade_mass) + call RegPack(RF, InData%blade_CG) + call RegPack(RF, InData%blade_IN) + call RegPack(RF, InData%beta) + call RegPack(RF, InData%tol) + call RegPackAlloc(RF, InData%QPtN) + call RegPackAlloc(RF, InData%QPtWeight) + call RegPackAlloc(RF, InData%Shp) + call RegPackAlloc(RF, InData%ShpDer) + call RegPackAlloc(RF, InData%Jacobian) + call RegPackAlloc(RF, InData%uu0) + call RegPackAlloc(RF, InData%rrN0) + call RegPackAlloc(RF, InData%E10) + call RegPack(RF, InData%nodes_per_elem) + call RegPackAlloc(RF, InData%node_elem_idx) + call RegPack(RF, InData%refine) + call RegPack(RF, InData%dof_node) + call RegPack(RF, InData%dof_elem) + call RegPack(RF, InData%rot_elem) + call RegPack(RF, InData%elem_total) + call RegPack(RF, InData%node_total) + call RegPack(RF, InData%dof_total) + call RegPack(RF, InData%nqp) + call RegPack(RF, InData%analysis_type) + call RegPack(RF, InData%damp_flag) + call RegPack(RF, InData%ld_retries) + call RegPack(RF, InData%niter) + call RegPack(RF, InData%quadrature) + call RegPack(RF, InData%n_fact) + call RegPack(RF, InData%OutInputs) + call RegPack(RF, InData%NumOuts) + call RegPack(RF, allocated(InData%OutParam)) + if (allocated(InData%OutParam)) then + call RegPackBounds(RF, 1, lbound(InData%OutParam), ubound(InData%OutParam)) + LB(1:1) = lbound(InData%OutParam) + UB(1:1) = ubound(InData%OutParam) + do i1 = LB(1), UB(1) + call NWTC_Library_PackOutParmType(RF, InData%OutParam(i1)) + end do + end if + call RegPack(RF, InData%NNodeOuts) + call RegPack(RF, InData%OutNd) + call RegPackAlloc(RF, InData%NdIndx) + call RegPackAlloc(RF, InData%NdIndxInverse) + call RegPackAlloc(RF, InData%OutNd2NdElem) + call RegPack(RF, InData%OutFmt) + call RegPack(RF, InData%UsePitchAct) + call RegPack(RF, InData%pitchJ) + call RegPack(RF, InData%pitchK) + call RegPack(RF, InData%pitchC) + call RegPack(RF, InData%torqM) + call BD_PackqpParam(RF, InData%qp) + call RegPack(RF, InData%qp_indx_offset) + call RegPack(RF, InData%BldMotionNodeLoc) + call RegPack(RF, InData%tngt_stf_fd) + call RegPack(RF, InData%tngt_stf_comp) + call RegPack(RF, InData%tngt_stf_pert) + call RegPack(RF, InData%tngt_stf_difftol) + call RegPack(RF, InData%BldNd_NumOuts) + call RegPack(RF, InData%BldNd_TotNumOuts) + call RegPack(RF, allocated(InData%BldNd_OutParam)) + if (allocated(InData%BldNd_OutParam)) then + call RegPackBounds(RF, 1, lbound(InData%BldNd_OutParam), ubound(InData%BldNd_OutParam)) + LB(1:1) = lbound(InData%BldNd_OutParam) + UB(1:1) = ubound(InData%BldNd_OutParam) + do i1 = LB(1), UB(1) + call NWTC_Library_PackOutParmType(RF, InData%BldNd_OutParam(i1)) + end do + end if + call RegPackAlloc(RF, InData%BldNd_BlOutNd) + call RegPackAlloc(RF, InData%QPtw_Shp_Shp_Jac) + call RegPackAlloc(RF, InData%QPtw_Shp_ShpDer) + call RegPackAlloc(RF, InData%QPtw_ShpDer_ShpDer_Jac) + call RegPackAlloc(RF, InData%QPtw_Shp_Jac) + call RegPackAlloc(RF, InData%QPtw_ShpDer) + call RegPackAlloc(RF, InData%FEweight) + call RegPackAlloc(RF, InData%Jac_u_indx) + call RegPackAlloc(RF, InData%du) + call RegPack(RF, InData%dx) + call RegPack(RF, InData%Jac_ny) + call RegPack(RF, InData%Jac_nx) + call RegPack(RF, InData%RotStates) + call RegPack(RF, InData%RelStates) + call RegPack(RF, InData%CompAeroMaps) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine BD_UnPackParam(RF, OutData) + type(RegFile), intent(inout) :: RF + type(BD_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'BD_UnPackParam' + integer(B4Ki) :: i1, i2, i3, i4 + integer(B4Ki) :: LB(4), UB(4) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%dt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%coef); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rhoinf); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%uuN0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Stif0_QP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Mass0_QP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%gravity); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%segment_eta); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%member_eta); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%blade_length); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%blade_mass); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%blade_CG); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%blade_IN); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%beta); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%tol); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%QPtN); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%QPtWeight); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Shp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ShpDer); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Jacobian); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%uu0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%rrN0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%E10); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nodes_per_elem); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%node_elem_idx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%refine); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%dof_node); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%dof_elem); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rot_elem); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%elem_total); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%node_total); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%dof_total); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nqp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%analysis_type); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%damp_flag); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ld_retries); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%niter); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%quadrature); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%n_fact); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutInputs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumOuts); if (RegCheckErr(RF, RoutineName)) return + if (allocated(OutData%OutParam)) deallocate(OutData%OutParam) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%OutParam(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackOutParmType(RF, OutData%OutParam(i1)) ! OutParam + end do + end if + call RegUnpack(RF, OutData%NNodeOuts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutNd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%NdIndx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%NdIndxInverse); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%OutNd2NdElem); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutFmt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UsePitchAct); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%pitchJ); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%pitchK); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%pitchC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%torqM); if (RegCheckErr(RF, RoutineName)) return + call BD_UnpackqpParam(RF, OutData%qp) ! qp + call RegUnpack(RF, OutData%qp_indx_offset); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BldMotionNodeLoc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%tngt_stf_fd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%tngt_stf_comp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%tngt_stf_pert); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%tngt_stf_difftol); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BldNd_NumOuts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BldNd_TotNumOuts); if (RegCheckErr(RF, RoutineName)) return + if (allocated(OutData%BldNd_OutParam)) deallocate(OutData%BldNd_OutParam) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%BldNd_OutParam(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldNd_OutParam.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackOutParmType(RF, OutData%BldNd_OutParam(i1)) ! BldNd_OutParam + end do + end if + call RegUnpackAlloc(RF, OutData%BldNd_BlOutNd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%QPtw_Shp_Shp_Jac); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%QPtw_Shp_ShpDer); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%QPtw_ShpDer_ShpDer_Jac); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%QPtw_Shp_Jac); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%QPtw_ShpDer); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%FEweight); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Jac_u_indx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%du); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%dx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Jac_ny); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Jac_nx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RotStates); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RelStates); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CompAeroMaps); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine BD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) + type(BD_InputType), intent(inout) :: SrcInputData + type(BD_InputType), intent(inout) :: DstInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'BD_CopyInput' + ErrStat = ErrID_None + ErrMsg = '' + call MeshCopy(SrcInputData%RootMotion, DstInputData%RootMotion, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcInputData%PointLoad, DstInputData%PointLoad, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcInputData%DistrLoad, DstInputData%DistrLoad, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcInputData%HubMotion, DstInputData%HubMotion, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine BD_DestroyInput(InputData, ErrStat, ErrMsg) + type(BD_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'BD_DestroyInput' + ErrStat = ErrID_None + ErrMsg = '' + call MeshDestroy( InputData%RootMotion, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( InputData%PointLoad, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( InputData%DistrLoad, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( InputData%HubMotion, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine BD_PackInput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(BD_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'BD_PackInput' + if (RF%ErrStat >= AbortErrLev) return + call MeshPack(RF, InData%RootMotion) + call MeshPack(RF, InData%PointLoad) + call MeshPack(RF, InData%DistrLoad) + call MeshPack(RF, InData%HubMotion) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine BD_UnPackInput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(BD_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'BD_UnPackInput' + if (RF%ErrStat /= ErrID_None) return + call MeshUnpack(RF, OutData%RootMotion) ! RootMotion + call MeshUnpack(RF, OutData%PointLoad) ! PointLoad + call MeshUnpack(RF, OutData%DistrLoad) ! DistrLoad + call MeshUnpack(RF, OutData%HubMotion) ! HubMotion +end subroutine + +subroutine BD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(BD_OutputType), intent(inout) :: SrcOutputData + type(BD_OutputType), intent(inout) :: DstOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'BD_CopyOutput' + ErrStat = ErrID_None + ErrMsg = '' + call MeshCopy(SrcOutputData%ReactionForce, DstOutputData%ReactionForce, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcOutputData%BldMotion, DstOutputData%BldMotion, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstOutputData%RootMxr = SrcOutputData%RootMxr + DstOutputData%RootMyr = SrcOutputData%RootMyr + if (allocated(SrcOutputData%WriteOutput)) then + LB(1:1) = lbound(SrcOutputData%WriteOutput) + UB(1:1) = ubound(SrcOutputData%WriteOutput) + if (.not. allocated(DstOutputData%WriteOutput)) then + allocate(DstOutputData%WriteOutput(LB(1):UB(1)), 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 + end if +end subroutine + +subroutine BD_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(BD_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'BD_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' + call MeshDestroy( OutputData%ReactionForce, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( OutputData%BldMotion, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(OutputData%WriteOutput)) then + deallocate(OutputData%WriteOutput) + end if +end subroutine + +subroutine BD_PackOutput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(BD_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'BD_PackOutput' + if (RF%ErrStat >= AbortErrLev) return + call MeshPack(RF, InData%ReactionForce) + call MeshPack(RF, InData%BldMotion) + call RegPack(RF, InData%RootMxr) + call RegPack(RF, InData%RootMyr) + call RegPackAlloc(RF, InData%WriteOutput) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine BD_UnPackOutput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(BD_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'BD_UnPackOutput' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call MeshUnpack(RF, OutData%ReactionForce) ! ReactionForce + call MeshUnpack(RF, OutData%BldMotion) ! BldMotion + call RegUnpack(RF, OutData%RootMxr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RootMyr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WriteOutput); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, ErrStat, ErrMsg) + type(EqMotionQP), intent(in) :: SrcEqMotionQPData + type(EqMotionQP), intent(inout) :: DstEqMotionQPData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(4), UB(4) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'BD_CopyEqMotionQP' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcEqMotionQPData%uuu)) then + LB(1:3) = lbound(SrcEqMotionQPData%uuu) + UB(1:3) = ubound(SrcEqMotionQPData%uuu) + if (.not. allocated(DstEqMotionQPData%uuu)) then + allocate(DstEqMotionQPData%uuu(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%uuu.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstEqMotionQPData%uuu = SrcEqMotionQPData%uuu + end if + if (allocated(SrcEqMotionQPData%uup)) then + LB(1:3) = lbound(SrcEqMotionQPData%uup) + UB(1:3) = ubound(SrcEqMotionQPData%uup) + if (.not. allocated(DstEqMotionQPData%uup)) then + allocate(DstEqMotionQPData%uup(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%uup.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstEqMotionQPData%uup = SrcEqMotionQPData%uup + end if + if (allocated(SrcEqMotionQPData%vvv)) then + LB(1:3) = lbound(SrcEqMotionQPData%vvv) + UB(1:3) = ubound(SrcEqMotionQPData%vvv) + if (.not. allocated(DstEqMotionQPData%vvv)) then + allocate(DstEqMotionQPData%vvv(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%vvv.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstEqMotionQPData%vvv = SrcEqMotionQPData%vvv + end if + if (allocated(SrcEqMotionQPData%vvp)) then + LB(1:3) = lbound(SrcEqMotionQPData%vvp) + UB(1:3) = ubound(SrcEqMotionQPData%vvp) + if (.not. allocated(DstEqMotionQPData%vvp)) then + allocate(DstEqMotionQPData%vvp(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%vvp.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstEqMotionQPData%vvp = SrcEqMotionQPData%vvp + end if + if (allocated(SrcEqMotionQPData%aaa)) then + LB(1:3) = lbound(SrcEqMotionQPData%aaa) + UB(1:3) = ubound(SrcEqMotionQPData%aaa) + if (.not. allocated(DstEqMotionQPData%aaa)) then + allocate(DstEqMotionQPData%aaa(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%aaa.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstEqMotionQPData%aaa = SrcEqMotionQPData%aaa + end if + if (allocated(SrcEqMotionQPData%RR0)) then + LB(1:4) = lbound(SrcEqMotionQPData%RR0) + UB(1:4) = ubound(SrcEqMotionQPData%RR0) + if (.not. allocated(DstEqMotionQPData%RR0)) then + allocate(DstEqMotionQPData%RR0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%RR0.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstEqMotionQPData%RR0 = SrcEqMotionQPData%RR0 + end if + if (allocated(SrcEqMotionQPData%kappa)) then + LB(1:3) = lbound(SrcEqMotionQPData%kappa) + UB(1:3) = ubound(SrcEqMotionQPData%kappa) + if (.not. allocated(DstEqMotionQPData%kappa)) then + allocate(DstEqMotionQPData%kappa(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%kappa.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstEqMotionQPData%kappa = SrcEqMotionQPData%kappa + end if + if (allocated(SrcEqMotionQPData%E1)) then + LB(1:3) = lbound(SrcEqMotionQPData%E1) + UB(1:3) = ubound(SrcEqMotionQPData%E1) + if (.not. allocated(DstEqMotionQPData%E1)) then + allocate(DstEqMotionQPData%E1(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%E1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstEqMotionQPData%E1 = SrcEqMotionQPData%E1 + end if + if (allocated(SrcEqMotionQPData%Stif)) then + LB(1:4) = lbound(SrcEqMotionQPData%Stif) + UB(1:4) = ubound(SrcEqMotionQPData%Stif) + if (.not. allocated(DstEqMotionQPData%Stif)) then + allocate(DstEqMotionQPData%Stif(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%Stif.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstEqMotionQPData%Stif = SrcEqMotionQPData%Stif + end if + if (allocated(SrcEqMotionQPData%Fb)) then + LB(1:3) = lbound(SrcEqMotionQPData%Fb) + UB(1:3) = ubound(SrcEqMotionQPData%Fb) + if (.not. allocated(DstEqMotionQPData%Fb)) then + allocate(DstEqMotionQPData%Fb(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%Fb.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstEqMotionQPData%Fb = SrcEqMotionQPData%Fb + end if + if (allocated(SrcEqMotionQPData%Fc)) then + LB(1:3) = lbound(SrcEqMotionQPData%Fc) + UB(1:3) = ubound(SrcEqMotionQPData%Fc) + if (.not. allocated(DstEqMotionQPData%Fc)) then + allocate(DstEqMotionQPData%Fc(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%Fc.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstEqMotionQPData%Fc = SrcEqMotionQPData%Fc + end if + if (allocated(SrcEqMotionQPData%Fd)) then + LB(1:3) = lbound(SrcEqMotionQPData%Fd) + UB(1:3) = ubound(SrcEqMotionQPData%Fd) + if (.not. allocated(DstEqMotionQPData%Fd)) then + allocate(DstEqMotionQPData%Fd(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%Fd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstEqMotionQPData%Fd = SrcEqMotionQPData%Fd + end if + if (allocated(SrcEqMotionQPData%Fg)) then + LB(1:3) = lbound(SrcEqMotionQPData%Fg) + UB(1:3) = ubound(SrcEqMotionQPData%Fg) + if (.not. allocated(DstEqMotionQPData%Fg)) then + allocate(DstEqMotionQPData%Fg(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%Fg.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstEqMotionQPData%Fg = SrcEqMotionQPData%Fg + end if + if (allocated(SrcEqMotionQPData%Fi)) then + LB(1:3) = lbound(SrcEqMotionQPData%Fi) + UB(1:3) = ubound(SrcEqMotionQPData%Fi) + if (.not. allocated(DstEqMotionQPData%Fi)) then + allocate(DstEqMotionQPData%Fi(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%Fi.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstEqMotionQPData%Fi = SrcEqMotionQPData%Fi + end if + if (allocated(SrcEqMotionQPData%Ftemp)) then + LB(1:3) = lbound(SrcEqMotionQPData%Ftemp) + UB(1:3) = ubound(SrcEqMotionQPData%Ftemp) + if (.not. allocated(DstEqMotionQPData%Ftemp)) then + allocate(DstEqMotionQPData%Ftemp(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%Ftemp.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstEqMotionQPData%Ftemp = SrcEqMotionQPData%Ftemp + end if + if (allocated(SrcEqMotionQPData%RR0mEta)) then + LB(1:3) = lbound(SrcEqMotionQPData%RR0mEta) + UB(1:3) = ubound(SrcEqMotionQPData%RR0mEta) + if (.not. allocated(DstEqMotionQPData%RR0mEta)) then + allocate(DstEqMotionQPData%RR0mEta(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%RR0mEta.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstEqMotionQPData%RR0mEta = SrcEqMotionQPData%RR0mEta + end if + if (allocated(SrcEqMotionQPData%rho)) then + LB(1:4) = lbound(SrcEqMotionQPData%rho) + UB(1:4) = ubound(SrcEqMotionQPData%rho) + if (.not. allocated(DstEqMotionQPData%rho)) then + allocate(DstEqMotionQPData%rho(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%rho.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstEqMotionQPData%rho = SrcEqMotionQPData%rho + end if + if (allocated(SrcEqMotionQPData%betaC)) then + LB(1:4) = lbound(SrcEqMotionQPData%betaC) + UB(1:4) = ubound(SrcEqMotionQPData%betaC) + if (.not. allocated(DstEqMotionQPData%betaC)) then + allocate(DstEqMotionQPData%betaC(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%betaC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstEqMotionQPData%betaC = SrcEqMotionQPData%betaC + end if + if (allocated(SrcEqMotionQPData%Gi)) then + LB(1:4) = lbound(SrcEqMotionQPData%Gi) + UB(1:4) = ubound(SrcEqMotionQPData%Gi) + if (.not. allocated(DstEqMotionQPData%Gi)) then + allocate(DstEqMotionQPData%Gi(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%Gi.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstEqMotionQPData%Gi = SrcEqMotionQPData%Gi + end if + if (allocated(SrcEqMotionQPData%Ki)) then + LB(1:4) = lbound(SrcEqMotionQPData%Ki) + UB(1:4) = ubound(SrcEqMotionQPData%Ki) + if (.not. allocated(DstEqMotionQPData%Ki)) then + allocate(DstEqMotionQPData%Ki(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%Ki.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstEqMotionQPData%Ki = SrcEqMotionQPData%Ki + end if + if (allocated(SrcEqMotionQPData%Mi)) then + LB(1:4) = lbound(SrcEqMotionQPData%Mi) + UB(1:4) = ubound(SrcEqMotionQPData%Mi) + if (.not. allocated(DstEqMotionQPData%Mi)) then + allocate(DstEqMotionQPData%Mi(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%Mi.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstEqMotionQPData%Mi = SrcEqMotionQPData%Mi + end if + if (allocated(SrcEqMotionQPData%Oe)) then + LB(1:4) = lbound(SrcEqMotionQPData%Oe) + UB(1:4) = ubound(SrcEqMotionQPData%Oe) + if (.not. allocated(DstEqMotionQPData%Oe)) then + allocate(DstEqMotionQPData%Oe(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%Oe.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstEqMotionQPData%Oe = SrcEqMotionQPData%Oe + end if + if (allocated(SrcEqMotionQPData%Pe)) then + LB(1:4) = lbound(SrcEqMotionQPData%Pe) + UB(1:4) = ubound(SrcEqMotionQPData%Pe) + if (.not. allocated(DstEqMotionQPData%Pe)) then + allocate(DstEqMotionQPData%Pe(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%Pe.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstEqMotionQPData%Pe = SrcEqMotionQPData%Pe + end if + if (allocated(SrcEqMotionQPData%Qe)) then + LB(1:4) = lbound(SrcEqMotionQPData%Qe) + UB(1:4) = ubound(SrcEqMotionQPData%Qe) + if (.not. allocated(DstEqMotionQPData%Qe)) then + allocate(DstEqMotionQPData%Qe(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%Qe.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstEqMotionQPData%Qe = SrcEqMotionQPData%Qe + end if + if (allocated(SrcEqMotionQPData%Gd)) then + LB(1:4) = lbound(SrcEqMotionQPData%Gd) + UB(1:4) = ubound(SrcEqMotionQPData%Gd) + if (.not. allocated(DstEqMotionQPData%Gd)) then + allocate(DstEqMotionQPData%Gd(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%Gd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstEqMotionQPData%Gd = SrcEqMotionQPData%Gd + end if + if (allocated(SrcEqMotionQPData%Od)) then + LB(1:4) = lbound(SrcEqMotionQPData%Od) + UB(1:4) = ubound(SrcEqMotionQPData%Od) + if (.not. allocated(DstEqMotionQPData%Od)) then + allocate(DstEqMotionQPData%Od(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%Od.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstEqMotionQPData%Od = SrcEqMotionQPData%Od + end if + if (allocated(SrcEqMotionQPData%Pd)) then + LB(1:4) = lbound(SrcEqMotionQPData%Pd) + UB(1:4) = ubound(SrcEqMotionQPData%Pd) + if (.not. allocated(DstEqMotionQPData%Pd)) then + allocate(DstEqMotionQPData%Pd(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%Pd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstEqMotionQPData%Pd = SrcEqMotionQPData%Pd + end if + if (allocated(SrcEqMotionQPData%Qd)) then + LB(1:4) = lbound(SrcEqMotionQPData%Qd) + UB(1:4) = ubound(SrcEqMotionQPData%Qd) + if (.not. allocated(DstEqMotionQPData%Qd)) then + allocate(DstEqMotionQPData%Qd(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%Qd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstEqMotionQPData%Qd = SrcEqMotionQPData%Qd + end if + if (allocated(SrcEqMotionQPData%Sd)) then + LB(1:4) = lbound(SrcEqMotionQPData%Sd) + UB(1:4) = ubound(SrcEqMotionQPData%Sd) + if (.not. allocated(DstEqMotionQPData%Sd)) then + allocate(DstEqMotionQPData%Sd(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%Sd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstEqMotionQPData%Sd = SrcEqMotionQPData%Sd + end if + if (allocated(SrcEqMotionQPData%Xd)) then + LB(1:4) = lbound(SrcEqMotionQPData%Xd) + UB(1:4) = ubound(SrcEqMotionQPData%Xd) + if (.not. allocated(DstEqMotionQPData%Xd)) then + allocate(DstEqMotionQPData%Xd(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%Xd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstEqMotionQPData%Xd = SrcEqMotionQPData%Xd + end if + if (allocated(SrcEqMotionQPData%Yd)) then + LB(1:4) = lbound(SrcEqMotionQPData%Yd) + UB(1:4) = ubound(SrcEqMotionQPData%Yd) + if (.not. allocated(DstEqMotionQPData%Yd)) then + allocate(DstEqMotionQPData%Yd(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%Yd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstEqMotionQPData%Yd = SrcEqMotionQPData%Yd + end if +end subroutine + +subroutine BD_DestroyEqMotionQP(EqMotionQPData, ErrStat, ErrMsg) + type(EqMotionQP), intent(inout) :: EqMotionQPData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'BD_DestroyEqMotionQP' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(EqMotionQPData%uuu)) then + deallocate(EqMotionQPData%uuu) + end if + if (allocated(EqMotionQPData%uup)) then + deallocate(EqMotionQPData%uup) + end if + if (allocated(EqMotionQPData%vvv)) then + deallocate(EqMotionQPData%vvv) + end if + if (allocated(EqMotionQPData%vvp)) then + deallocate(EqMotionQPData%vvp) + end if + if (allocated(EqMotionQPData%aaa)) then + deallocate(EqMotionQPData%aaa) + end if + if (allocated(EqMotionQPData%RR0)) then + deallocate(EqMotionQPData%RR0) + end if + if (allocated(EqMotionQPData%kappa)) then + deallocate(EqMotionQPData%kappa) + end if + if (allocated(EqMotionQPData%E1)) then + deallocate(EqMotionQPData%E1) + end if + if (allocated(EqMotionQPData%Stif)) then + deallocate(EqMotionQPData%Stif) + end if + if (allocated(EqMotionQPData%Fb)) then + deallocate(EqMotionQPData%Fb) + end if + if (allocated(EqMotionQPData%Fc)) then + deallocate(EqMotionQPData%Fc) + end if + if (allocated(EqMotionQPData%Fd)) then + deallocate(EqMotionQPData%Fd) + end if + if (allocated(EqMotionQPData%Fg)) then + deallocate(EqMotionQPData%Fg) + end if + if (allocated(EqMotionQPData%Fi)) then + deallocate(EqMotionQPData%Fi) + end if + if (allocated(EqMotionQPData%Ftemp)) then + deallocate(EqMotionQPData%Ftemp) + end if + if (allocated(EqMotionQPData%RR0mEta)) then + deallocate(EqMotionQPData%RR0mEta) + end if + if (allocated(EqMotionQPData%rho)) then + deallocate(EqMotionQPData%rho) + end if + if (allocated(EqMotionQPData%betaC)) then + deallocate(EqMotionQPData%betaC) + end if + if (allocated(EqMotionQPData%Gi)) then + deallocate(EqMotionQPData%Gi) + end if + if (allocated(EqMotionQPData%Ki)) then + deallocate(EqMotionQPData%Ki) + end if + if (allocated(EqMotionQPData%Mi)) then + deallocate(EqMotionQPData%Mi) + end if + if (allocated(EqMotionQPData%Oe)) then + deallocate(EqMotionQPData%Oe) + end if + if (allocated(EqMotionQPData%Pe)) then + deallocate(EqMotionQPData%Pe) + end if + if (allocated(EqMotionQPData%Qe)) then + deallocate(EqMotionQPData%Qe) + end if + if (allocated(EqMotionQPData%Gd)) then + deallocate(EqMotionQPData%Gd) + end if + if (allocated(EqMotionQPData%Od)) then + deallocate(EqMotionQPData%Od) + end if + if (allocated(EqMotionQPData%Pd)) then + deallocate(EqMotionQPData%Pd) + end if + if (allocated(EqMotionQPData%Qd)) then + deallocate(EqMotionQPData%Qd) + end if + if (allocated(EqMotionQPData%Sd)) then + deallocate(EqMotionQPData%Sd) + end if + if (allocated(EqMotionQPData%Xd)) then + deallocate(EqMotionQPData%Xd) + end if + if (allocated(EqMotionQPData%Yd)) then + deallocate(EqMotionQPData%Yd) + end if +end subroutine + +subroutine BD_PackEqMotionQP(RF, Indata) + type(RegFile), intent(inout) :: RF + type(EqMotionQP), intent(in) :: InData + character(*), parameter :: RoutineName = 'BD_PackEqMotionQP' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%uuu) + call RegPackAlloc(RF, InData%uup) + call RegPackAlloc(RF, InData%vvv) + call RegPackAlloc(RF, InData%vvp) + call RegPackAlloc(RF, InData%aaa) + call RegPackAlloc(RF, InData%RR0) + call RegPackAlloc(RF, InData%kappa) + call RegPackAlloc(RF, InData%E1) + call RegPackAlloc(RF, InData%Stif) + call RegPackAlloc(RF, InData%Fb) + call RegPackAlloc(RF, InData%Fc) + call RegPackAlloc(RF, InData%Fd) + call RegPackAlloc(RF, InData%Fg) + call RegPackAlloc(RF, InData%Fi) + call RegPackAlloc(RF, InData%Ftemp) + call RegPackAlloc(RF, InData%RR0mEta) + call RegPackAlloc(RF, InData%rho) + call RegPackAlloc(RF, InData%betaC) + call RegPackAlloc(RF, InData%Gi) + call RegPackAlloc(RF, InData%Ki) + call RegPackAlloc(RF, InData%Mi) + call RegPackAlloc(RF, InData%Oe) + call RegPackAlloc(RF, InData%Pe) + call RegPackAlloc(RF, InData%Qe) + call RegPackAlloc(RF, InData%Gd) + call RegPackAlloc(RF, InData%Od) + call RegPackAlloc(RF, InData%Pd) + call RegPackAlloc(RF, InData%Qd) + call RegPackAlloc(RF, InData%Sd) + call RegPackAlloc(RF, InData%Xd) + call RegPackAlloc(RF, InData%Yd) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine BD_UnPackEqMotionQP(RF, OutData) + type(RegFile), intent(inout) :: RF + type(EqMotionQP), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'BD_UnPackEqMotionQP' + integer(B4Ki) :: LB(4), UB(4) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%uuu); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%uup); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%vvv); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%vvp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%aaa); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%RR0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%kappa); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%E1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Stif); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Fb); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Fc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Fd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Fg); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Fi); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Ftemp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%RR0mEta); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%rho); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%betaC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Gi); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Ki); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Mi); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Oe); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Pe); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Qe); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Gd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Od); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Pd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Qd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Sd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Xd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Yd); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(BD_MiscVarType), intent(inout) :: SrcMiscData + type(BD_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(4), UB(4) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'BD_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + call MeshCopy(SrcMiscData%u_DistrLoad_at_y, DstMiscData%u_DistrLoad_at_y, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcMiscData%y_BldMotion_at_u, DstMiscData%y_BldMotion_at_u, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyMeshMapType(SrcMiscData%Map_u_DistrLoad_to_y, DstMiscData%Map_u_DistrLoad_to_y, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyMeshMapType(SrcMiscData%Map_y_BldMotion_to_u, DstMiscData%Map_y_BldMotion_to_u, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstMiscData%Un_Sum = SrcMiscData%Un_Sum + call BD_CopyEqMotionQP(SrcMiscData%qp, DstMiscData%qp, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcMiscData%lin_A)) then + LB(1:2) = lbound(SrcMiscData%lin_A) + UB(1:2) = ubound(SrcMiscData%lin_A) + if (.not. allocated(DstMiscData%lin_A)) then + allocate(DstMiscData%lin_A(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%lin_A.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%lin_A = SrcMiscData%lin_A + end if + if (allocated(SrcMiscData%lin_C)) then + LB(1:2) = lbound(SrcMiscData%lin_C) + UB(1:2) = ubound(SrcMiscData%lin_C) + if (.not. allocated(DstMiscData%lin_C)) then + allocate(DstMiscData%lin_C(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%lin_C.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%lin_C = SrcMiscData%lin_C + end if + if (allocated(SrcMiscData%Nrrr)) then + LB(1:3) = lbound(SrcMiscData%Nrrr) + UB(1:3) = ubound(SrcMiscData%Nrrr) + if (.not. allocated(DstMiscData%Nrrr)) then + allocate(DstMiscData%Nrrr(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Nrrr.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%Nrrr = SrcMiscData%Nrrr + end if + if (allocated(SrcMiscData%elf)) then + LB(1:2) = lbound(SrcMiscData%elf) + UB(1:2) = ubound(SrcMiscData%elf) + if (.not. allocated(DstMiscData%elf)) then + allocate(DstMiscData%elf(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%elf.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%elf = SrcMiscData%elf + end if + if (allocated(SrcMiscData%EFint)) then + LB(1:3) = lbound(SrcMiscData%EFint) + UB(1:3) = ubound(SrcMiscData%EFint) + if (.not. allocated(DstMiscData%EFint)) then + allocate(DstMiscData%EFint(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%EFint.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%EFint = SrcMiscData%EFint + end if + if (allocated(SrcMiscData%elk)) then + LB(1:4) = lbound(SrcMiscData%elk) + UB(1:4) = ubound(SrcMiscData%elk) + if (.not. allocated(DstMiscData%elk)) then + allocate(DstMiscData%elk(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%elk.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%elk = SrcMiscData%elk + end if + if (allocated(SrcMiscData%elg)) then + LB(1:4) = lbound(SrcMiscData%elg) + UB(1:4) = ubound(SrcMiscData%elg) + if (.not. allocated(DstMiscData%elg)) then + allocate(DstMiscData%elg(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%elg.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%elg = SrcMiscData%elg + end if + if (allocated(SrcMiscData%elm)) then + LB(1:4) = lbound(SrcMiscData%elm) + UB(1:4) = ubound(SrcMiscData%elm) + if (.not. allocated(DstMiscData%elm)) then + allocate(DstMiscData%elm(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%elm.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%elm = SrcMiscData%elm + end if + if (allocated(SrcMiscData%DistrLoad_QP)) then + LB(1:3) = lbound(SrcMiscData%DistrLoad_QP) + UB(1:3) = ubound(SrcMiscData%DistrLoad_QP) + if (.not. allocated(DstMiscData%DistrLoad_QP)) then + allocate(DstMiscData%DistrLoad_QP(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%DistrLoad_QP.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%DistrLoad_QP = SrcMiscData%DistrLoad_QP + end if + if (allocated(SrcMiscData%PointLoadLcl)) then + LB(1:2) = lbound(SrcMiscData%PointLoadLcl) + UB(1:2) = ubound(SrcMiscData%PointLoadLcl) + if (.not. allocated(DstMiscData%PointLoadLcl)) then + allocate(DstMiscData%PointLoadLcl(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%PointLoadLcl.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%PointLoadLcl = SrcMiscData%PointLoadLcl + end if + if (allocated(SrcMiscData%StifK)) then + LB(1:4) = lbound(SrcMiscData%StifK) + UB(1:4) = ubound(SrcMiscData%StifK) + if (.not. allocated(DstMiscData%StifK)) then + allocate(DstMiscData%StifK(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%StifK.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%StifK = SrcMiscData%StifK + end if + if (allocated(SrcMiscData%MassM)) then + LB(1:4) = lbound(SrcMiscData%MassM) + UB(1:4) = ubound(SrcMiscData%MassM) + if (.not. allocated(DstMiscData%MassM)) then + allocate(DstMiscData%MassM(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%MassM.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%MassM = SrcMiscData%MassM + end if + if (allocated(SrcMiscData%DampG)) then + LB(1:4) = lbound(SrcMiscData%DampG) + UB(1:4) = ubound(SrcMiscData%DampG) + if (.not. allocated(DstMiscData%DampG)) then + allocate(DstMiscData%DampG(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%DampG.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%DampG = SrcMiscData%DampG + end if + if (allocated(SrcMiscData%StifK_fd)) then + LB(1:4) = lbound(SrcMiscData%StifK_fd) + UB(1:4) = ubound(SrcMiscData%StifK_fd) + if (.not. allocated(DstMiscData%StifK_fd)) then + allocate(DstMiscData%StifK_fd(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%StifK_fd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%StifK_fd = SrcMiscData%StifK_fd + end if + if (allocated(SrcMiscData%MassM_fd)) then + LB(1:4) = lbound(SrcMiscData%MassM_fd) + UB(1:4) = ubound(SrcMiscData%MassM_fd) + if (.not. allocated(DstMiscData%MassM_fd)) then + allocate(DstMiscData%MassM_fd(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%MassM_fd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%MassM_fd = SrcMiscData%MassM_fd + end if + if (allocated(SrcMiscData%DampG_fd)) then + LB(1:4) = lbound(SrcMiscData%DampG_fd) + UB(1:4) = ubound(SrcMiscData%DampG_fd) + if (.not. allocated(DstMiscData%DampG_fd)) then + allocate(DstMiscData%DampG_fd(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%DampG_fd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%DampG_fd = SrcMiscData%DampG_fd + end if + if (allocated(SrcMiscData%RHS)) then + LB(1:2) = lbound(SrcMiscData%RHS) + UB(1:2) = ubound(SrcMiscData%RHS) + if (.not. allocated(DstMiscData%RHS)) then + allocate(DstMiscData%RHS(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%RHS.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%RHS = SrcMiscData%RHS + end if + if (allocated(SrcMiscData%RHS_p)) then + LB(1:2) = lbound(SrcMiscData%RHS_p) + UB(1:2) = ubound(SrcMiscData%RHS_p) + if (.not. allocated(DstMiscData%RHS_p)) then + allocate(DstMiscData%RHS_p(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%RHS_p.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%RHS_p = SrcMiscData%RHS_p + end if + if (allocated(SrcMiscData%RHS_m)) then + LB(1:2) = lbound(SrcMiscData%RHS_m) + UB(1:2) = ubound(SrcMiscData%RHS_m) + if (.not. allocated(DstMiscData%RHS_m)) then + allocate(DstMiscData%RHS_m(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%RHS_m.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%RHS_m = SrcMiscData%RHS_m + end if + if (allocated(SrcMiscData%BldInternalForceFE)) then + LB(1:2) = lbound(SrcMiscData%BldInternalForceFE) + UB(1:2) = ubound(SrcMiscData%BldInternalForceFE) + if (.not. allocated(DstMiscData%BldInternalForceFE)) then + allocate(DstMiscData%BldInternalForceFE(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BldInternalForceFE.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%BldInternalForceFE = SrcMiscData%BldInternalForceFE + end if + if (allocated(SrcMiscData%BldInternalForceQP)) then + LB(1:2) = lbound(SrcMiscData%BldInternalForceQP) + UB(1:2) = ubound(SrcMiscData%BldInternalForceQP) + if (.not. allocated(DstMiscData%BldInternalForceQP)) then + allocate(DstMiscData%BldInternalForceQP(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BldInternalForceQP.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%BldInternalForceQP = SrcMiscData%BldInternalForceQP + end if + if (allocated(SrcMiscData%FirstNodeReactionLclForceMoment)) then + LB(1:1) = lbound(SrcMiscData%FirstNodeReactionLclForceMoment) + UB(1:1) = ubound(SrcMiscData%FirstNodeReactionLclForceMoment) + if (.not. allocated(DstMiscData%FirstNodeReactionLclForceMoment)) then + allocate(DstMiscData%FirstNodeReactionLclForceMoment(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FirstNodeReactionLclForceMoment.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%FirstNodeReactionLclForceMoment = SrcMiscData%FirstNodeReactionLclForceMoment + end if + if (allocated(SrcMiscData%Solution)) then + LB(1:2) = lbound(SrcMiscData%Solution) + UB(1:2) = ubound(SrcMiscData%Solution) + if (.not. allocated(DstMiscData%Solution)) then + allocate(DstMiscData%Solution(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Solution.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%Solution = SrcMiscData%Solution + end if + if (allocated(SrcMiscData%LP_StifK)) then + LB(1:2) = lbound(SrcMiscData%LP_StifK) + UB(1:2) = ubound(SrcMiscData%LP_StifK) + if (.not. allocated(DstMiscData%LP_StifK)) then + allocate(DstMiscData%LP_StifK(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%LP_StifK.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%LP_StifK = SrcMiscData%LP_StifK + end if + if (allocated(SrcMiscData%LP_MassM)) then + LB(1:2) = lbound(SrcMiscData%LP_MassM) + UB(1:2) = ubound(SrcMiscData%LP_MassM) + if (.not. allocated(DstMiscData%LP_MassM)) then + allocate(DstMiscData%LP_MassM(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%LP_MassM.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%LP_MassM = SrcMiscData%LP_MassM + end if + if (allocated(SrcMiscData%LP_MassM_LU)) then + LB(1:2) = lbound(SrcMiscData%LP_MassM_LU) + UB(1:2) = ubound(SrcMiscData%LP_MassM_LU) + if (.not. allocated(DstMiscData%LP_MassM_LU)) then + allocate(DstMiscData%LP_MassM_LU(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%LP_MassM_LU.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%LP_MassM_LU = SrcMiscData%LP_MassM_LU + end if + if (allocated(SrcMiscData%LP_RHS)) then + LB(1:1) = lbound(SrcMiscData%LP_RHS) + UB(1:1) = ubound(SrcMiscData%LP_RHS) + if (.not. allocated(DstMiscData%LP_RHS)) then + allocate(DstMiscData%LP_RHS(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%LP_RHS.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%LP_RHS = SrcMiscData%LP_RHS + end if + if (allocated(SrcMiscData%LP_StifK_LU)) then + LB(1:2) = lbound(SrcMiscData%LP_StifK_LU) + UB(1:2) = ubound(SrcMiscData%LP_StifK_LU) + if (.not. allocated(DstMiscData%LP_StifK_LU)) then + allocate(DstMiscData%LP_StifK_LU(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%LP_StifK_LU.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%LP_StifK_LU = SrcMiscData%LP_StifK_LU + end if + if (allocated(SrcMiscData%LP_RHS_LU)) then + LB(1:1) = lbound(SrcMiscData%LP_RHS_LU) + UB(1:1) = ubound(SrcMiscData%LP_RHS_LU) + if (.not. allocated(DstMiscData%LP_RHS_LU)) then + allocate(DstMiscData%LP_RHS_LU(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%LP_RHS_LU.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%LP_RHS_LU = SrcMiscData%LP_RHS_LU + end if + if (allocated(SrcMiscData%LP_indx)) then + LB(1:1) = lbound(SrcMiscData%LP_indx) + UB(1:1) = ubound(SrcMiscData%LP_indx) + if (.not. allocated(DstMiscData%LP_indx)) then + allocate(DstMiscData%LP_indx(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%LP_indx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%LP_indx = SrcMiscData%LP_indx + end if + call BD_CopyInput(SrcMiscData%u, DstMiscData%u, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call BD_CopyInput(SrcMiscData%u2, DstMiscData%u2, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine BD_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(BD_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'BD_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' + call MeshDestroy( MiscData%u_DistrLoad_at_y, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( MiscData%y_BldMotion_at_u, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call NWTC_Library_DestroyMeshMapType(MiscData%Map_u_DistrLoad_to_y, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call NWTC_Library_DestroyMeshMapType(MiscData%Map_y_BldMotion_to_u, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call BD_DestroyEqMotionQP(MiscData%qp, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(MiscData%lin_A)) then + deallocate(MiscData%lin_A) + end if + if (allocated(MiscData%lin_C)) then + deallocate(MiscData%lin_C) + end if + if (allocated(MiscData%Nrrr)) then + deallocate(MiscData%Nrrr) + end if + if (allocated(MiscData%elf)) then + deallocate(MiscData%elf) + end if + if (allocated(MiscData%EFint)) then + deallocate(MiscData%EFint) + end if + if (allocated(MiscData%elk)) then + deallocate(MiscData%elk) + end if + if (allocated(MiscData%elg)) then + deallocate(MiscData%elg) + end if + if (allocated(MiscData%elm)) then + deallocate(MiscData%elm) + end if + if (allocated(MiscData%DistrLoad_QP)) then + deallocate(MiscData%DistrLoad_QP) + end if + if (allocated(MiscData%PointLoadLcl)) then + deallocate(MiscData%PointLoadLcl) + end if + if (allocated(MiscData%StifK)) then + deallocate(MiscData%StifK) + end if + if (allocated(MiscData%MassM)) then + deallocate(MiscData%MassM) + end if + if (allocated(MiscData%DampG)) then + deallocate(MiscData%DampG) + end if + if (allocated(MiscData%StifK_fd)) then + deallocate(MiscData%StifK_fd) + end if + if (allocated(MiscData%MassM_fd)) then + deallocate(MiscData%MassM_fd) + end if + if (allocated(MiscData%DampG_fd)) then + deallocate(MiscData%DampG_fd) + end if + if (allocated(MiscData%RHS)) then + deallocate(MiscData%RHS) + end if + if (allocated(MiscData%RHS_p)) then + deallocate(MiscData%RHS_p) + end if + if (allocated(MiscData%RHS_m)) then + deallocate(MiscData%RHS_m) + end if + if (allocated(MiscData%BldInternalForceFE)) then + deallocate(MiscData%BldInternalForceFE) + end if + if (allocated(MiscData%BldInternalForceQP)) then + deallocate(MiscData%BldInternalForceQP) + end if + if (allocated(MiscData%FirstNodeReactionLclForceMoment)) then + deallocate(MiscData%FirstNodeReactionLclForceMoment) + end if + if (allocated(MiscData%Solution)) then + deallocate(MiscData%Solution) + end if + if (allocated(MiscData%LP_StifK)) then + deallocate(MiscData%LP_StifK) + end if + if (allocated(MiscData%LP_MassM)) then + deallocate(MiscData%LP_MassM) + end if + if (allocated(MiscData%LP_MassM_LU)) then + deallocate(MiscData%LP_MassM_LU) + end if + if (allocated(MiscData%LP_RHS)) then + deallocate(MiscData%LP_RHS) + end if + if (allocated(MiscData%LP_StifK_LU)) then + deallocate(MiscData%LP_StifK_LU) + end if + if (allocated(MiscData%LP_RHS_LU)) then + deallocate(MiscData%LP_RHS_LU) + end if + if (allocated(MiscData%LP_indx)) then + deallocate(MiscData%LP_indx) + end if + call BD_DestroyInput(MiscData%u, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call BD_DestroyInput(MiscData%u2, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine BD_PackMisc(RF, Indata) + type(RegFile), intent(inout) :: RF + type(BD_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'BD_PackMisc' + if (RF%ErrStat >= AbortErrLev) return + call MeshPack(RF, InData%u_DistrLoad_at_y) + call MeshPack(RF, InData%y_BldMotion_at_u) + call NWTC_Library_PackMeshMapType(RF, InData%Map_u_DistrLoad_to_y) + call NWTC_Library_PackMeshMapType(RF, InData%Map_y_BldMotion_to_u) + call RegPack(RF, InData%Un_Sum) + call BD_PackEqMotionQP(RF, InData%qp) + call RegPackAlloc(RF, InData%lin_A) + call RegPackAlloc(RF, InData%lin_C) + call RegPackAlloc(RF, InData%Nrrr) + call RegPackAlloc(RF, InData%elf) + call RegPackAlloc(RF, InData%EFint) + call RegPackAlloc(RF, InData%elk) + call RegPackAlloc(RF, InData%elg) + call RegPackAlloc(RF, InData%elm) + call RegPackAlloc(RF, InData%DistrLoad_QP) + call RegPackAlloc(RF, InData%PointLoadLcl) + call RegPackAlloc(RF, InData%StifK) + call RegPackAlloc(RF, InData%MassM) + call RegPackAlloc(RF, InData%DampG) + call RegPackAlloc(RF, InData%StifK_fd) + call RegPackAlloc(RF, InData%MassM_fd) + call RegPackAlloc(RF, InData%DampG_fd) + call RegPackAlloc(RF, InData%RHS) + call RegPackAlloc(RF, InData%RHS_p) + call RegPackAlloc(RF, InData%RHS_m) + call RegPackAlloc(RF, InData%BldInternalForceFE) + call RegPackAlloc(RF, InData%BldInternalForceQP) + call RegPackAlloc(RF, InData%FirstNodeReactionLclForceMoment) + call RegPackAlloc(RF, InData%Solution) + call RegPackAlloc(RF, InData%LP_StifK) + call RegPackAlloc(RF, InData%LP_MassM) + call RegPackAlloc(RF, InData%LP_MassM_LU) + call RegPackAlloc(RF, InData%LP_RHS) + call RegPackAlloc(RF, InData%LP_StifK_LU) + call RegPackAlloc(RF, InData%LP_RHS_LU) + call RegPackAlloc(RF, InData%LP_indx) + call BD_PackInput(RF, InData%u) + call BD_PackInput(RF, InData%u2) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine BD_UnPackMisc(RF, OutData) + type(RegFile), intent(inout) :: RF + type(BD_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'BD_UnPackMisc' + integer(B4Ki) :: LB(4), UB(4) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call MeshUnpack(RF, OutData%u_DistrLoad_at_y) ! u_DistrLoad_at_y + call MeshUnpack(RF, OutData%y_BldMotion_at_u) ! y_BldMotion_at_u + call NWTC_Library_UnpackMeshMapType(RF, OutData%Map_u_DistrLoad_to_y) ! Map_u_DistrLoad_to_y + call NWTC_Library_UnpackMeshMapType(RF, OutData%Map_y_BldMotion_to_u) ! Map_y_BldMotion_to_u + call RegUnpack(RF, OutData%Un_Sum); if (RegCheckErr(RF, RoutineName)) return + call BD_UnpackEqMotionQP(RF, OutData%qp) ! qp + call RegUnpackAlloc(RF, OutData%lin_A); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%lin_C); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Nrrr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%elf); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%EFint); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%elk); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%elg); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%elm); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%DistrLoad_QP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PointLoadLcl); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%StifK); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%MassM); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%DampG); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%StifK_fd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%MassM_fd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%DampG_fd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%RHS); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%RHS_p); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%RHS_m); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BldInternalForceFE); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BldInternalForceQP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%FirstNodeReactionLclForceMoment); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Solution); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LP_StifK); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LP_MassM); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LP_MassM_LU); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LP_RHS); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LP_StifK_LU); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LP_RHS_LU); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LP_indx); if (RegCheckErr(RF, RoutineName)) return + call BD_UnpackInput(RF, OutData%u) ! u + call BD_UnpackInput(RF, OutData%u2) ! u2 +end subroutine + +subroutine BD_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(BD_InputType), intent(inout) :: u(:) ! Input at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Inputs + type(BD_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 = 'BD_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 BD_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL BD_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 BD_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 BD_Input_ExtrapInterp - - - SUBROUTINE BD_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'BD_Input_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(u)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(u)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(u) - 1 + select case (order) + case (0) + call BD_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call BD_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call BD_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(u) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE BD_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. @@ -12899,47 +3398,48 @@ SUBROUTINE BD_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) ! !.................................................................................................................................. - TYPE(BD_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 - TYPE(BD_InputType), INTENT(INOUT) :: u2 ! Input at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs - TYPE(BD_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 + TYPE(BD_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 + TYPE(BD_InputType), INTENT(INOUT) :: u2 ! Input at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs + TYPE(BD_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 = 'BD_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 + REAL(DbKi) :: t(2) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'BD_Input_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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%RootMotion, u2%RootMotion, tin, u_out%RootMotion, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp1(u1%PointLoad, u2%PointLoad, tin, u_out%PointLoad, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp1(u1%DistrLoad, u2%DistrLoad, tin, u_out%DistrLoad, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp1(u1%HubMotion, u2%HubMotion, tin, u_out%HubMotion, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - END SUBROUTINE BD_Input_ExtrapInterp1 - - - SUBROUTINE BD_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + CALL MeshExtrapInterp1(u1%RootMotion, u2%RootMotion, tin, u_out%RootMotion, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp1(u1%PointLoad, u2%PointLoad, tin, u_out%PointLoad, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp1(u1%DistrLoad, u2%DistrLoad, tin, u_out%DistrLoad, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp1(u1%HubMotion, u2%HubMotion, tin, u_out%HubMotion, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) +END SUBROUTINE + +SUBROUTINE BD_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. @@ -12953,107 +3453,108 @@ SUBROUTINE BD_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrM ! !.................................................................................................................................. - TYPE(BD_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 > t3 - TYPE(BD_InputType), INTENT(INOUT) :: u2 ! Input at t2 > t3 - TYPE(BD_InputType), INTENT(INOUT) :: u3 ! Input at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs - TYPE(BD_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 + TYPE(BD_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 > t3 + TYPE(BD_InputType), INTENT(INOUT) :: u2 ! Input at t2 > t3 + TYPE(BD_InputType), INTENT(INOUT) :: u3 ! Input at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs + TYPE(BD_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 = 'BD_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) - + 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) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'BD_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 + 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 + 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 + 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%RootMotion, u2%RootMotion, u3%RootMotion, tin, u_out%RootMotion, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp2(u1%PointLoad, u2%PointLoad, u3%PointLoad, tin, u_out%PointLoad, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp2(u1%DistrLoad, u2%DistrLoad, u3%DistrLoad, tin, u_out%DistrLoad, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp2(u1%HubMotion, u2%HubMotion, u3%HubMotion, tin, u_out%HubMotion, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - END SUBROUTINE BD_Input_ExtrapInterp2 - - - SUBROUTINE BD_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(BD_OutputType), INTENT(INOUT) :: y(:) ! Output at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Outputs - TYPE(BD_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 + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + CALL MeshExtrapInterp2(u1%RootMotion, u2%RootMotion, u3%RootMotion, tin, u_out%RootMotion, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp2(u1%PointLoad, u2%PointLoad, u3%PointLoad, tin, u_out%PointLoad, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp2(u1%DistrLoad, u2%DistrLoad, u3%DistrLoad, tin, u_out%DistrLoad, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp2(u1%HubMotion, u2%HubMotion, u3%HubMotion, tin, u_out%HubMotion, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) +END SUBROUTINE + +subroutine BD_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(BD_OutputType), intent(inout) :: y(:) ! Output at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Outputs + type(BD_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 = 'BD_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 BD_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL BD_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 BD_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 BD_Output_ExtrapInterp - - - SUBROUTINE BD_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'BD_Output_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(y)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(y)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(y) - 1 + select case (order) + case (0) + call BD_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call BD_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call BD_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(y) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE BD_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. @@ -13065,55 +3566,51 @@ SUBROUTINE BD_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ! !.................................................................................................................................. - TYPE(BD_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 - TYPE(BD_OutputType), INTENT(INOUT) :: y2 ! Output at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs - TYPE(BD_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 + TYPE(BD_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 + TYPE(BD_OutputType), INTENT(INOUT) :: y2 ! Output at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs + TYPE(BD_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 = 'BD_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 + REAL(DbKi) :: t(2) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'BD_Output_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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%ReactionForce, y2%ReactionForce, tin, y_out%ReactionForce, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp1(y1%BldMotion, y2%BldMotion, tin, y_out%BldMotion, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - b = -(y1%RootMxr - y2%RootMxr) - y_out%RootMxr = y1%RootMxr + b * ScaleFactor - b = -(y1%RootMyr - y2%RootMyr) - y_out%RootMyr = y1%RootMyr + b * ScaleFactor -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 BD_Output_ExtrapInterp1 - - - SUBROUTINE BD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + CALL MeshExtrapInterp1(y1%ReactionForce, y2%ReactionForce, tin, y_out%ReactionForce, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp1(y1%BldMotion, y2%BldMotion, tin, y_out%BldMotion, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + y_out%RootMxr = a1*y1%RootMxr + a2*y2%RootMxr + y_out%RootMyr = a1*y1%RootMyr + a2*y2%RootMyr + IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + END IF ! check if allocated +END SUBROUTINE + +SUBROUTINE BD_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. @@ -13127,64 +3624,56 @@ SUBROUTINE BD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Err ! !.................................................................................................................................. - TYPE(BD_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 > t3 - TYPE(BD_OutputType), INTENT(INOUT) :: y2 ! Output at t2 > t3 - TYPE(BD_OutputType), INTENT(INOUT) :: y3 ! Output at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs - TYPE(BD_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 + TYPE(BD_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 > t3 + TYPE(BD_OutputType), INTENT(INOUT) :: y2 ! Output at t2 > t3 + TYPE(BD_OutputType), INTENT(INOUT) :: y3 ! Output at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs + TYPE(BD_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 = 'BD_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) - + 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) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'BD_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 + 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 + 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 + 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%ReactionForce, y2%ReactionForce, y3%ReactionForce, tin, y_out%ReactionForce, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp2(y1%BldMotion, y2%BldMotion, y3%BldMotion, tin, y_out%BldMotion, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - b = (t(3)**2*(y1%RootMxr - y2%RootMxr) + t(2)**2*(-y1%RootMxr + y3%RootMxr))* scaleFactor - c = ( (t(2)-t(3))*y1%RootMxr + t(3)*y2%RootMxr - t(2)*y3%RootMxr ) * scaleFactor - y_out%RootMxr = y1%RootMxr + b + c * t_out - b = (t(3)**2*(y1%RootMyr - y2%RootMyr) + t(2)**2*(-y1%RootMyr + y3%RootMyr))* scaleFactor - c = ( (t(2)-t(3))*y1%RootMyr + t(3)*y2%RootMyr - t(2)*y3%RootMyr ) * scaleFactor - y_out%RootMyr = y1%RootMyr + b + c * t_out -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 BD_Output_ExtrapInterp2 - + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + CALL MeshExtrapInterp2(y1%ReactionForce, y2%ReactionForce, y3%ReactionForce, tin, y_out%ReactionForce, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp2(y1%BldMotion, y2%BldMotion, y3%BldMotion, tin, y_out%BldMotion, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + y_out%RootMxr = a1*y1%RootMxr + a2*y2%RootMxr + a3*y3%RootMxr + y_out%RootMyr = a1*y1%RootMyr + a2*y2%RootMyr + a3*y3%RootMyr + IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + a3*y3%WriteOutput + END IF ! check if allocated +END SUBROUTINE END MODULE BeamDyn_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/beamdyn/src/Driver_Beam.f90 b/modules/beamdyn/src/Driver_Beam.f90 index 85cadc904a..8b1d51d194 100644 --- a/modules/beamdyn/src/Driver_Beam.f90 +++ b/modules/beamdyn/src/Driver_Beam.f90 @@ -102,7 +102,8 @@ PROGRAM BeamDyn_Driver_Program BD_InitInput%RootName = TRIM(RootName)//'.BD' BD_InitInput%RootDisp = MATMUL(BD_InitInput%GlbPos(:),DvrData%RootRelInit) - BD_InitInput%GlbPos(:) BD_InitInput%DynamicSolve = DvrData%DynamicSolve ! QuasiStatic options handled within the BD code. - + BD_InitInput%CompAeroMaps = .false. + t_global = DvrData%t_initial n_t_final = ((DvrData%t_final - DvrData%t_initial) / dt_global ) diff --git a/modules/beamdyn/src/Registry_BeamDyn.txt b/modules/beamdyn/src/Registry_BeamDyn.txt index b4b97fef24..448cd81abe 100644 --- a/modules/beamdyn/src/Registry_BeamDyn.txt +++ b/modules/beamdyn/src/Registry_BeamDyn.txt @@ -34,6 +34,7 @@ typedef ^ InitInputType ReKi HubPos {3} - - "Initial typedef ^ InitInputType R8Ki HubRot {3}{3} - - "Initial Hub direction cosine matrix" typedef ^ InitInputType Logical Linearize - .FALSE. - "Flag that tells this module if the glue code wants to linearize." - typedef ^ InitInputType Logical DynamicSolve - .TRUE. - "Use dynamic solve option. Set to False for static solving (handled by glue code or driver code)." - +typedef ^ InitInputType LOGICAL CompAeroMaps - .FALSE. - "flag to determine if BeamDyn is computing aero maps (true) or running a normal simulation (false)" - # Define outputs that the initialization routine may need here: @@ -41,8 +42,6 @@ typedef ^ InitInputType Logical DynamicSolve - .TRUE. - "Use d 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 R8Ki kp_coordinate {:}{:} - - "Key point coordinates array" - -typedef ^ InitOutputType IntKi kp_total - - - "Total number of key points" - typedef ^ InitOutputType CHARACTER(LinChanLen) LinNames_y {:} - - "Names of the outputs used in linearization" - #typedef ^ InitOutputType CHARACTER(LinChanLen) LinNames_z {:} - - "Names of the constraint states used in linearization" - typedef ^ InitOutputType CHARACTER(LinChanLen) LinNames_x {:} - - "Names of the continuous states used in linearization" - @@ -250,6 +249,7 @@ typedef ^ ParameterType Integer Jac_ny - 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)" - typedef ^ ParameterType Logical RelStates - - - "Define states relative to root motion during linearization? (flag)" - +typedef ^ ParameterType LOGICAL CompAeroMaps - .FALSE. - "flag to determine if BeamDyn is computing aero maps (true) or running a normal simulation (false)" - # ..... Inputs @@ -286,14 +286,14 @@ typedef ^ EqMotionQP ^ aaa ::: - - "Translatio #This may not be needed at all. Would be useful only if we decide to use something other than the quadrature points for the output mesh. In that case, don't put it in m%qp%q #typedef ^ EqMotionQP ^ q ::: - - "Displacement and rotation for all quadrature points -- Calculated from x%q after solve. size 6 x p%nqp x p%elem_total" - -typedef ^ EqMotionQP ^ RR0 :::: - - "Rotation tensor at current QP \f$ \left(\underline{\underline{R}}\underline{\underline{R}}_0\right) \f$" - -typedef ^ EqMotionQP ^ kappa ::: - - "Curvature vector \f$ \underline{k} \f$ at current QP (note this is not \kappa, but a term in \kappa)" - -typedef ^ EqMotionQP ^ E1 ::: - - "\vec{e_1} = x_0^\prime + u^\prime (3) at current QP" - +typedef ^ EqMotionQP ^ RR0 :::: - - "Rotation tensor at current QP \\f$ \\left(\\underline{\\underline{R}}\\underline{\\underline{R}}_0\\right) \\f$" - +typedef ^ EqMotionQP ^ kappa ::: - - "Curvature vector \\f$ \\underline{k} \\f$ at current QP (note this is not \\kappa, but a term in \\kappa)" - +typedef ^ EqMotionQP ^ E1 ::: - - "\\vec{e_1} = x_0^\\prime + u^\\prime (3) at current QP" - typedef ^ EqMotionQP ^ Stif :::: - - "C/S stiffness matrix resolved in inertial frame at current QP. 6x6" - typedef ^ EqMotionQP ^ Fb ::: - - "Gyroscopic forces at current QP. 6" - -typedef ^ EqMotionQP ^ Fc ::: - - "Elastic force \f$ \underline{F}^c \f$ at current QP. 6" - -typedef ^ EqMotionQP ^ Fd ::: - - "Elastic force \f$ \underline{F}^d \f$ at current QP. 6" - +typedef ^ EqMotionQP ^ Fc ::: - - "Elastic force \\f$ \\underline{F}^c \\f$ at current QP. 6" - +typedef ^ EqMotionQP ^ Fd ::: - - "Elastic force \\f$ \\underline{F}^d \\f$ at current QP. 6" - typedef ^ EqMotionQP ^ Fg ::: - - "Gravity forces at current QP. 6" - typedef ^ EqMotionQP ^ Fi ::: - - "Inertial forces at current QP. 6" - typedef ^ EqMotionQP ^ Ftemp ::: - - "Sum of some of the forces at current QP. 6" - @@ -308,9 +308,9 @@ typedef ^ EqMotionQP ^ Ki :::: - - "Stiffness typedef ^ EqMotionQP ^ Mi :::: - - "Mass matrix for inertial force. 6x6" - # Elastic force terms -typedef ^ EqMotionQP ^ Oe :::: - - "\f$ \underline{\underline{\mathcal{O}}} \f$ from equation (19) of NREL CP-2C00-60759. 6x6" - -typedef ^ EqMotionQP ^ Pe :::: - - "\f$ \underline{\underline{\mathcal{P}}} \f$ from equation (20) of NREL CP-2C00-60759. 6x6" - -typedef ^ EqMotionQP ^ Qe :::: - - "\f$ \underline{\underline{\mathcal{Q}}} \f$ from equation (21) of NREL CP-2C00-60759. 6x6" - +typedef ^ EqMotionQP ^ Oe :::: - - "\\f$ \\underline{\\underline{\\mathcal{O}}} \\f$ from equation (19) of NREL CP-2C00-60759. 6x6" - +typedef ^ EqMotionQP ^ Pe :::: - - "\\f$ \\underline{\\underline{\\mathcal{P}}} \\f$ from equation (20) of NREL CP-2C00-60759. 6x6" - +typedef ^ EqMotionQP ^ Qe :::: - - "\\f$ \\underline{\\underline{\\mathcal{Q}}} \\f$ from equation (21) of NREL CP-2C00-60759. 6x6" - # Disspipative terms typedef ^ EqMotionQP ^ Gd :::: - - "Dissipative term for gyroscopic term. 6x6" - diff --git a/modules/beamdyn/tests/beamdyn_utest.F90 b/modules/beamdyn/tests/beamdyn_utest.F90 new file mode 100644 index 0000000000..f535668ad1 --- /dev/null +++ b/modules/beamdyn/tests/beamdyn_utest.F90 @@ -0,0 +1,48 @@ +program beamdyn_utest + use, intrinsic :: iso_fortran_env, only: error_unit + use testdrive, only: run_testsuite, new_testsuite, testsuite_type + + use test_BD_Crv, only: test_BD_Crv_suite + use test_BD_diffmtc, only: test_BD_diffmtc_suite + use test_BD_InitializeNodalLocations, only: test_BD_InitializeNodalLocations_suite + use test_BD_MemberEta, only: test_BD_MemberEta_suite + use test_BD_Misc, only: test_BD_Misc_suite + use test_BD_QuadraturePointData, only: test_BD_QuadraturePointData_suite + use test_BD_ShapeFuncs, only: test_BD_ShapeFuncs_suite + use test_BD_TrapezoidalPointWeight, only: test_BD_TrapezoidalPointWeight_suite + use NWTC_Num + + implicit none + integer :: stat, is + type(testsuite_type), allocatable :: testsuites(:) + character(len=*), parameter :: fmt = '("#", *(1x, a))' + + stat = 0 + + call SetConstants() + + testsuites = [ & + new_testsuite("Crv", test_BD_Crv_suite), & + new_testsuite("diffmtc", test_BD_diffmtc_suite), & + new_testsuite("InitializeNodalLocations", test_BD_InitializeNodalLocations_suite), & + new_testsuite("MemberEta", test_BD_MemberEta_suite), & + new_testsuite("Misc", test_BD_Misc_suite), & + new_testsuite("QuadraturePointData", test_BD_QuadraturePointData_suite), & + new_testsuite("ShapeFuncs", test_BD_ShapeFuncs_suite), & + new_testsuite("TrapezoidalPointWeight", test_BD_TrapezoidalPointWeight_suite) & + ] + + do is = 1, size(testsuites) + write (error_unit, fmt) "Testing:", testsuites(is)%name + call run_testsuite(testsuites(is)%collect, error_unit, stat) + end do + + if (stat > 0) then + write (error_unit, '(i0, 1x, a)') stat, "test(s) failed!" + error stop + end if + + write (error_unit, fmt) "All tests PASSED" + + end program + \ No newline at end of file diff --git a/modules/beamdyn/tests/test_BD_CheckRotMat.F90 b/modules/beamdyn/tests/test_BD_CheckRotMat.F90 deleted file mode 100644 index c1750fd298..0000000000 --- a/modules/beamdyn/tests/test_BD_CheckRotMat.F90 +++ /dev/null @@ -1,44 +0,0 @@ -@test -subroutine test_BD_CheckRotMat() - ! test branches - ! - known valid rotation matrix: pi about x-axis - ! - known invalid rotation matrix: halve the angle of the diagonal elements - - use pFUnit_mod - use BeamDyn_Subs - use NWTC_Num - use test_tools - - implicit none - - real(BDKi) :: n(3) - real(BDKi) :: angle - real(BDKi) :: testR(3,3) - integer(IntKi) :: ErrStat - character(ErrMsgLen) :: ErrMsg - character(1024) :: testname - - ! initialize NWTC_Num constants - call SetConstants() - - ! set the rotation axis and angle for all tests - n = (/ 1, 0, 0 /) ! x axis - angle = Pi - - - ! -------------------------------------------------------------------------- - testname = "known valid rotation matrix: pi about x-axis:" - testR = calcRotationMatrix(angle, n) - call BD_CheckRotMat(testR, ErrStat, ErrMsg) - @assertEqual(0, ErrStat, testname) - - - ! -------------------------------------------------------------------------- - testname = "known invalid rotation matrix: halve the angle of the diagonal elements:" - ! this should produce a fatal error (ErrStat = 4) - testR(:,2) = (/ testR(1,2), cos(real(Pi/2, BDKi)), testR(3,2) /) - testR(:,3) = (/ testR(1,2), testR(2,2), cos(real(Pi/2, BDKi)) /) - call BD_CheckRotMat(testR, ErrStat, ErrMsg) - @assertEqual(4, ErrStat, testname) - -end subroutine test_BD_CheckRotMat diff --git a/modules/beamdyn/tests/test_BD_ComputeIniNodalCrv.F90 b/modules/beamdyn/tests/test_BD_ComputeIniNodalCrv.F90 deleted file mode 100644 index a32f7a0b0b..0000000000 --- a/modules/beamdyn/tests/test_BD_ComputeIniNodalCrv.F90 +++ /dev/null @@ -1,83 +0,0 @@ -@test -subroutine test_BD_ComputeIniNodalCrv() - ! test branches - ! - simple rotation with known parameters: Pi on xaxis - ! - 0 rotation - ! - small rotation with baseline WM parameters calculated - - use pFUnit_mod - use BeamDyn_Subs - use NWTC_Num - use test_tools - - implicit none - - real(BDKi), dimension(3,3) :: r - real(BDKi), dimension(3) :: test_wmparams, baseline_wmparams - real(BDKi) :: angle, param, n(3) - character(1024) :: testname - real(BDKi) :: tolerance - integer(IntKi) :: ErrStat - character :: ErrMsg - - ! initialize NWTC_Num constants - call SetConstants() - - tolerance = 1e-14 - - ! -------------------------------------------------------------------------- - testname = "Tangent aligned with z-axis and 0 degree twist:" - n = (/ real(0.0, BDKi), real(0.0, BDKi), real(1.0, BDKi) /) ! tangent axis - angle = 0 - - ! Baseline Wiener-Milenkovic parameters - baseline_wmparams = (/ 0.0, 0.0, 0.0 /) - - call BD_ComputeIniNodalCrv(n, angle, test_wmparams, ErrStat, ErrMsg) - - @assertEqual(0.0_BDKi, ErrStat, tolerance, testname) - @assertEqual(baseline_wmparams, test_wmparams, tolerance, testname) - - ! -------------------------------------------------------------------------- - testname = "Tangent at 45 degree w.r.t. y-axis and 0 degree twist:" - n = (/ 1.0_BDKi/sqrt(2.0_BDKi), 0.0_BDKi, 1.0_BDKi/sqrt(2.0_BDKi) /) ! tangent axis - angle = 0.0_BDKi - - ! Baseline Wiener-Milenkovic parameters - param = 4*tan((Pi_D/4)/4) - baseline_wmparams = (/ real(0.0, BDKi), param, real(0.0, BDKi) /) - - call BD_ComputeIniNodalCrv(n, angle, test_wmparams, ErrStat, ErrMsg) - - @assertEqual(0.0_BDKi, ErrStat, tolerance, testname) - @assertEqual(baseline_wmparams, test_wmparams, tolerance, testname) - - ! -------------------------------------------------------------------------- - testname = "Tangent at -45 degree w.r.t. x-axis and 0 degree twist:" - n = (/ 0.0_BDKi, 1.0_BDKi/sqrt(2.0_BDKi), 1.0_BDKi/sqrt(2.0_BDKi) /) ! tangent axis - angle = 0.0_BDKi - - ! Baseline Wiener-Milenkovic parameters - param = 4.*tan((-Pi_D/4.)/4.) - baseline_wmparams = (/ param, real(0.0, BDKi), real(0.0, BDKi) /) - - call BD_ComputeIniNodalCrv(n, angle, test_wmparams, ErrStat, ErrMsg) - - @assertEqual(0.0_BDKi, ErrStat, tolerance, testname) - @assertEqual(baseline_wmparams, test_wmparams, tolerance, testname) - - ! -------------------------------------------------------------------------- - testname = "Tangent along z-axis with 45 degree twist:" - n = (/ real(0.0, BDKi), real(0.0, BDKi), 1.0_BDKi /) ! tangent axis - angle = 45.0_BDKi - - ! Baseline Wiener-Milenkovic parameters - param = 4.*tan((Pi_D/4.)/4.) - baseline_wmparams = (/ real(0.0, BDKi), real(0.0, BDKi), param /) - - call BD_ComputeIniNodalCrv(n, angle, test_wmparams, ErrStat, ErrMsg) - - @assertEqual(0.0_BDKi, ErrStat, tolerance, testname) - @assertEqual(baseline_wmparams, test_wmparams, tolerance, testname) - -end subroutine test_BD_ComputeIniNodalCrv diff --git a/modules/beamdyn/tests/test_BD_Crv.F90 b/modules/beamdyn/tests/test_BD_Crv.F90 new file mode 100644 index 0000000000..1cbd04cbfa --- /dev/null +++ b/modules/beamdyn/tests/test_BD_Crv.F90 @@ -0,0 +1,465 @@ +module test_BD_Crv + +use test_tools +use BeamDyn_Subs + +implicit none + +private +public :: test_BD_Crv_suite + +contains + +!> Collect all exported unit tests +subroutine test_BD_Crv_suite(testsuite) + type(unittest_type), allocatable, intent(out) :: testsuite(:) + testsuite = [ & + new_unittest("test_BD_CheckRotMat", test_BD_CheckRotMat), & + new_unittest("test_BD_ComputeIniNodalCrv", test_BD_ComputeIniNodalCrv), & + new_unittest("test_BD_CrvCompose", test_BD_CrvCompose), & + new_unittest("test_BD_CrvExtractCrv", test_BD_CrvExtractCrv), & + new_unittest("test_BD_CrvMatrixH", test_BD_CrvMatrixH), & + new_unittest("test_BD_CrvMatrixR", test_BD_CrvMatrixR) & + ] +end subroutine + +subroutine test_BD_CheckRotMat(error) + type(error_type), allocatable, intent(out) :: error + + ! test branches + ! - known valid rotation matrix: pi about x-axis + ! - known invalid rotation matrix: halve the angle of the diagonal elements + + real(BDKi) :: n(3) + real(BDKi) :: angle + real(BDKi) :: testR(3, 3) + integer(IntKi) :: ErrStat + character(ErrMsgLen) :: ErrMsg + character(1024) :: testname + + ! set the rotation axis and angle for all tests + n = [1, 0, 0] ! x axis + angle = Pi + + ! -------------------------------------------------------------------------- + testname = "known valid rotation matrix: pi about x-axis:" + testR = calcRotationMatrix(angle, n) + call BD_CheckRotMat(testR, ErrStat, ErrMsg) + call check(error, 0, ErrStat, testname); if (allocated(error)) return + + ! -------------------------------------------------------------------------- + testname = "known invalid rotation matrix: halve the angle of the diagonal elements:" + ! this should produce a fatal error (ErrStat = 4) + testR(:, 2) = [testR(1, 2), cos(real(Pi / 2, BDKi)), testR(3, 2)] + testR(:, 3) = [testR(1, 2), testR(2, 2), cos(real(Pi / 2, BDKi))] + call BD_CheckRotMat(testR, ErrStat, ErrMsg) + call check(error, 4, ErrStat, testname); if (allocated(error)) return + +end subroutine + +subroutine test_BD_ComputeIniNodalCrv(error) + type(error_type), allocatable, intent(out) :: error + + ! test branches + ! - simple rotation with known parameters: Pi on xaxis + ! - 0 rotation + ! - small rotation with baseline WM parameters calculated + + real(BDKi), dimension(3, 3) :: r + real(BDKi), dimension(3) :: test_wmparams, baseline_wmparams + real(BDKi) :: angle, param, n(3) + character(1024) :: testname + integer(IntKi) :: ErrStat + character :: ErrMsg + + ! -------------------------------------------------------------------------- + testname = "Tangent aligned with z-axis and 0 degree twist:" + n = [real(0.0, BDKi), real(0.0, BDKi), real(1.0, BDKi)] ! tangent axis + angle = 0 + + ! Baseline Wiener-Milenkovic parameters + baseline_wmparams = [0.0, 0.0, 0.0] + + call BD_ComputeIniNodalCrv(n, angle, test_wmparams, ErrStat, ErrMsg) + + call check(error, ErrID_None, ErrStat, testname); if (allocated(error)) return + call check_array(error, baseline_wmparams, test_wmparams, testname, tolerance); if (allocated(error)) return + + ! -------------------------------------------------------------------------- + testname = "Tangent at 45 degree w.r.t. y-axis and 0 degree twist:" + n = [1.0_BDKi / sqrt(2.0_BDKi), 0.0_BDKi, 1.0_BDKi / sqrt(2.0_BDKi)] ! tangent axis + angle = 0.0_BDKi + + ! Baseline Wiener-Milenkovic parameters + param = 4 * tan((Pi_D / 4) / 4) + baseline_wmparams = [real(0.0, BDKi), param, real(0.0, BDKi)] + + call BD_ComputeIniNodalCrv(n, angle, test_wmparams, ErrStat, ErrMsg) + + call check(error, ErrID_None, ErrStat, testname); if (allocated(error)) return + call check_array(error, baseline_wmparams, test_wmparams, testname, tolerance); if (allocated(error)) return + + ! -------------------------------------------------------------------------- + testname = "Tangent at -45 degree w.r.t. x-axis and 0 degree twist:" + n = [0.0_BDKi, 1.0_BDKi / sqrt(2.0_BDKi), 1.0_BDKi / sqrt(2.0_BDKi)] ! tangent axis + angle = 0.0_BDKi + + ! Baseline Wiener-Milenkovic parameters + param = 4.*tan((-Pi_D / 4.) / 4.) + baseline_wmparams = [param, real(0.0, BDKi), real(0.0, BDKi)] + + call BD_ComputeIniNodalCrv(n, angle, test_wmparams, ErrStat, ErrMsg) + + call check(error, ErrID_None, ErrStat, testname); if (allocated(error)) return + call check_array(error, baseline_wmparams, test_wmparams, testname, tolerance); if (allocated(error)) return + + ! -------------------------------------------------------------------------- + testname = "Tangent along z-axis with 45 degree twist:" + n = [real(0.0, BDKi), real(0.0, BDKi), 1.0_BDKi] ! tangent axis + angle = 45.0_BDKi + + ! Baseline Wiener-Milenkovic parameters + param = 4.*tan((Pi_D / 4.) / 4.) + baseline_wmparams = [real(0.0, BDKi), real(0.0, BDKi), param] + + call BD_ComputeIniNodalCrv(n, angle, test_wmparams, ErrStat, ErrMsg) + + call check(error, ErrID_None, ErrStat, testname); if (allocated(error)) return + call check_array(error, baseline_wmparams, test_wmparams, testname, tolerance); if (allocated(error)) return + +end subroutine + +subroutine test_BD_CrvCompose(error) + type(error_type), allocatable, intent(out) :: error + + ! test branches + ! - both rotation angles 0, no transpose of input rotations (flag = 0) + ! - delta2 > 0, no transpose of input rotations (flag = 0) + ! - delta2 < 0, no transpose of input rotations (flag = 0) + ! - flag = 1 + ! - flag = 2 + ! - flag = 3 + + ! input rotation axis and angle + real(BDKi), dimension(3) :: n1, n2 + real(BDKi) :: angle1, angle2 + + ! result rotations + real(BDKi), dimension(3, 3) :: testrotation, baselinerotation, r1, r2 + real(BDKi), dimension(3) :: composedparams + + ! other test settings + integer :: flag + character(1024) :: testname + + ! set the rotation axes for all tests + n1 = [1, 0, 0] ! x axis + n2 = [0, 0, 1] ! z axis + + ! -------------------------------------------------------------------------- + testname = "both rotation angles 0, no transpose of input rotations (flag = 0):" + angle1 = 0 ! 0 degrees + angle2 = 0 ! 0 degrees + flag = 0 + + ! both rotations should return an identity matrix + r1 = calcRotationMatrix(angle1, n1) + r2 = calcRotationMatrix(angle2, n2) + baselinerotation = matmul(r1, r2) + + call BD_CrvCompose(composedparams, 4 * tan(angle1 / 4) * n1, 4 * tan(angle2 / 4) * n2, flag) + call BD_CrvMatrixR(composedparams, testrotation) + + call check_array(error, baselinerotation, testrotation, testname, tolerance); if (allocated(error)) return + + ! -------------------------------------------------------------------------- + testname = "delta2 > 0, no transpose of input rotations (flag = 0):" + angle1 = PiBy2_D ! 90 degrees + angle2 = PiBy2_D ! 90 degrees + flag = 0 + + r1 = calcRotationMatrix(angle1, n1) + r2 = calcRotationMatrix(angle2, n2) + baselinerotation = matmul(r1, r2) + + call BD_CrvCompose(composedparams, 4 * tan(angle1 / 4) * n1, 4 * tan(angle2 / 4) * n2, flag) + call BD_CrvMatrixR(composedparams, testrotation) + + call check_array(error, baselinerotation, testrotation, testname, tolerance); if (allocated(error)) return + + ! -------------------------------------------------------------------------- + testname = "delta2 < 0, no transpose of input rotations (flag = 0):" + angle1 = PiBy2_D ! 90 degrees + angle2 = 1.5 * Pi ! 270 degrees + flag = 0 + + r1 = calcRotationMatrix(angle1, n1) + r2 = calcRotationMatrix(angle2, n2) + baselinerotation = matmul(r1, r2) + + call BD_CrvCompose(composedparams, 4 * tan(angle1 / 4) * n1, 4 * tan(angle2 / 4) * n2, flag) + call BD_CrvMatrixR(composedparams, testrotation) + + call check_array(error, baselinerotation, testrotation, testname, tolerance); if (allocated(error)) return + + ! -------------------------------------------------------------------------- + testname = "delta2 > 0, transpose of first rotation (flag = 1):" + angle1 = PiBy2_D ! 90 degrees + angle2 = PiBy2_D ! 90 degrees + flag = 1 + + r1 = calcRotationMatrix(-angle1, n1) + r2 = calcRotationMatrix(angle2, n2) + baselinerotation = matmul(r1, r2) + + call BD_CrvCompose(composedparams, 4 * tan(angle1 / 4) * n1, 4 * tan(angle2 / 4) * n2, flag) + call BD_CrvMatrixR(composedparams, testrotation) + + call check_array(error, baselinerotation, testrotation, testname, tolerance); if (allocated(error)) return + + ! -------------------------------------------------------------------------- + testname = "delta2 > 0, transpose of second rotation (flag = 2):" + angle1 = PiBy2_D ! 90 degrees + angle2 = PiBy2_D ! 90 degrees + flag = 2 + + r1 = calcRotationMatrix(angle1, n1) + r2 = calcRotationMatrix(-angle2, n2) + baselinerotation = matmul(r1, r2) + + call BD_CrvCompose(composedparams, 4 * tan(angle1 / 4) * n1, 4 * tan(angle2 / 4) * n2, flag) + call BD_CrvMatrixR(composedparams, testrotation) + + call check_array(error, baselinerotation, testrotation, testname, tolerance); if (allocated(error)) return + + ! -------------------------------------------------------------------------- + testname = "delta2 > 0, transpose of both rotations (flag = 3):" + angle1 = PiBy2_D ! 90 degrees + angle2 = PiBy2_D ! 90 degrees + flag = 3 + + r1 = calcRotationMatrix(-angle1, n1) + r2 = calcRotationMatrix(-angle2, n2) + baselinerotation = matmul(r1, r2) + + call BD_CrvCompose(composedparams, 4 * tan(angle1 / 4) * n1, 4 * tan(angle2 / 4) * n2, flag) + call BD_CrvMatrixR(composedparams, testrotation) + + call check_array(error, baselinerotation, testrotation, testname, tolerance); if (allocated(error)) return + +end subroutine + +subroutine test_BD_CrvExtractCrv(error) + type(error_type), allocatable, intent(out) :: error + + ! test branches + ! - simple rotation with known parameters: Pi on xaxis + ! - 0 rotation + ! - small rotation with baseline WM parameters calculated + + real(BDKi), dimension(3, 3) :: r + real(BDKi), dimension(3) :: test_wmparams, baseline_wmparams + real(BDKi) :: angle, n(3) + character(1024) :: testname + integer(IntKi) :: ErrStat + character :: ErrMsg + + ! set the rotation axis for all tests + n = [1, 0, 0] ! x axis + + ! -------------------------------------------------------------------------- + testname = "simple rotation with known parameters: Pi on xaxis:" + angle = Pi_D + + ! Wiener-Milenkovic parameters are <4.0, 0.0, 0.0> + baseline_wmparams = [4.0, 0.0, 0.0] + + r = RonXAxis(angle) + call BD_CrvExtractCrv(r, test_wmparams, ErrStat, ErrMsg) + + call check(error, ErrID_None, ErrStat, testname); if (allocated(error)) return + call check_array(error, baseline_wmparams, test_wmparams, testname, tolerance); if (allocated(error)) return + + ! -------------------------------------------------------------------------- + testname = "0 rotation:" + angle = 0 + + ! Wiener-Milenkovic parameters are <0.0, 0.0, 0.0> + baseline_wmparams = [0.0, 0.0, 0.0] + + r = RonXAxis(angle) + call BD_CrvExtractCrv(r, test_wmparams, ErrStat, ErrMsg) + + call check(error, ErrID_None, ErrStat, testname); if (allocated(error)) return + call check_array(error, baseline_wmparams, test_wmparams, testname, tolerance); if (allocated(error)) return + + ! -------------------------------------------------------------------------- + testname = "small rotation with baseline WM parameters calculated:" + angle = 0.1 * Pi_D + + ! Wiener-Milenkovic parameters are calculated; note tangent is asymptotic at +/- pi/2 + baseline_wmparams = 4 * tan(angle / 4) * n + + r = RonXAxis(angle) + call BD_CrvExtractCrv(r, test_wmparams, ErrStat, ErrMsg) + + call check(error, ErrID_None, ErrStat, testname); if (allocated(error)) return + call check_array(error, baseline_wmparams, test_wmparams, testname, tolerance); if (allocated(error)) return + +end subroutine + +subroutine test_BD_CrvMatrixH(error) + type(error_type), allocatable, intent(out) :: error + + ! test branches + ! - simple rotation with known parameters: Pi on xaxis + ! - 0 rotation + ! - small rotation with baseline WM parameters calculated + + ! TODO + ! invalid wm parameters (if thats a thing) + ! does the implemented WM formulation have any boundaries? + + real(BDKi), dimension(3, 3) :: testH, baselineH + real(BDKi), dimension(3) :: wmparams + real(BDKi) :: angle, n(3) + character(1024) :: testname + integer(IntKi) :: ErrStat + character :: ErrMsg + + ! set the rotation axis for all tests + n = [1., 0., 0.] ! x axis + + ! -------------------------------------------------------------------------- + testname = "simple rotation with known parameters: Pi on xaxis:" + angle = Pi_D + + ! Wiener-Milenkovic parameters are <4.0, 0.0, 0.0> + wmparams = [4.0, 0.0, 0.0] + + baselineH = H(wmparams) + + call BD_CrvMatrixH(wmparams, testH) + + call check_array(error, baselineH, testH, testname, tolerance); if (allocated(error)) return + + ! -------------------------------------------------------------------------- + testname = "0 rotation:" + angle = 0 + + ! Wiener-Milenkovic parameters are <0.0, 0.0, 0.0> + wmparams = [0.0, 0.0, 0.0] + + baselineH = H(wmparams) + + call BD_CrvMatrixH(wmparams, testH) + + call check_array(error, baselineH, testH, testname, tolerance); if (allocated(error)) return + + ! -------------------------------------------------------------------------- + testname = "small rotation with baseline WM parameters calculated:" + angle = 0.1 * Pi_D + + ! Wiener-Milenkovic parameters are calculated; note tangent is asymptotic at +/- pi/2 + wmparams = 4.*tan(angle / 4.) * n + + baselineH = H(wmparams) + + call BD_CrvMatrixH(wmparams, testH) + + call check_array(error, baselineH, testH, testname, tolerance); if (allocated(error)) return + +contains + function H(c) + real(BDKi) :: c0, c(3) + real(BDKi) :: H(3, 3) + + c0 = 2.0 - dot_product(c, c) / 8.0 + + H(1, :) = [c0 + c(1) * c(1) / 4., c(1) * c(2) / 4.-c(3), c(1) * c(3) / 4.+c(2)] + H(2, :) = [c(1) * c(2) / 4.+c(3), c0 + c(2) * c(2) / 4., c(2) * c(3) / 4.-c(1)] + H(3, :) = [c(1) * c(3) / 4.-c(2), c(2) * c(3) / 4.+c(1), c0 + c(3) * c(3) / 4.] + H = 2.*H / (4.-c0)**2 + + end function +end subroutine + +subroutine test_BD_CrvMatrixR(error) + type(error_type), allocatable, intent(out) :: error + + ! test branches + ! - simple rotation with known parameters: Pi on xaxis + ! - 0 rotation + ! - small rotation with baseline WM parameters calculated + + ! TODO + ! invalid wm parameters (if thats a thing) + ! does the implemented WM formulation have any boundaries? + + real(BDKi), dimension(3, 3) :: testR, baselineR + real(BDKi), dimension(3) :: wmparams + real(BDKi) :: angle, n(3) + character(1024) :: testname + integer(IntKi) :: ErrStat + character :: ErrMsg + + ! set the rotation axis for all tests + n = [1, 0, 0] ! x axis + + ! -------------------------------------------------------------------------- + testname = "simple rotation with known parameters: Pi on xaxis:" + angle = Pi_D + + baselineR = RonXAxis(angle) + + ! Wiener-Milenkovic parameters are <4.0, 0.0, 0.0> + wmparams = [4.0, 0.0, 0.0] + call BD_CrvMatrixR(wmparams, testR) + + call check_array(error, baselineR, testR, testname, tolerance); if (allocated(error)) return + + ! -------------------------------------------------------------------------- + testname = "0 rotation:" + angle = 0 + + baselineR = RonXAxis(angle) + + ! Wiener-Milenkovic parameters are <0.0, 0.0, 0.0> + wmparams = [0.0, 0.0, 0.0] + call BD_CrvMatrixR(wmparams, testR) + + call check_array(error, baselineR, testR, testname, tolerance); if (allocated(error)) return + + ! -------------------------------------------------------------------------- + testname = "small rotation with baseline WM parameters calculated:" + angle = 0.1 * Pi_D + + baselineR = RonXAxis(angle) + + ! Wiener-Milenkovic parameters are calculated; note tangent is asymptotic at +/- pi/2 + wmparams = 4 * tan(angle / 4) * n + call BD_CrvMatrixR(wmparams, testR) + + call check_array(error, baselineR, testR, testname, tolerance); if (allocated(error)) return + +end subroutine + +! this is actually an integration test not a unit test... +subroutine test_BD_ExtractRelativeRotation(error) + type(error_type), allocatable, intent(out) :: error + real(BDKi), dimension(3) :: rr + character(1024) :: testname + integer(IntKi) :: ErrStat + character :: ErrMsg + + type(BD_ParameterType) :: parametertype + type(BD_OtherStateType) :: otherstate + + testname = "static simple beam under gravity:" + otherstate = simpleOtherState() + parametertype = simpleParameterType(1, 16, 16, 0, 0) + call ExtractRelativeRotation(identity(), parametertype, otherstate, rr, ErrStat, ErrMsg) + call check_array(error, rr, [0.0_BDKi, 0.0_BDKi, 0.0_BDKi], testname, tolerance); if (allocated(error)) return +end subroutine + +end module diff --git a/modules/beamdyn/tests/test_BD_CrvCompose.F90 b/modules/beamdyn/tests/test_BD_CrvCompose.F90 deleted file mode 100644 index a376a6af82..0000000000 --- a/modules/beamdyn/tests/test_BD_CrvCompose.F90 +++ /dev/null @@ -1,137 +0,0 @@ -@test -subroutine test_BD_CrvCompose() - ! test branches - ! - both rotation angles 0, no transpose of input rotations (flag = 0) - ! - delta2 > 0, no transpose of input rotations (flag = 0) - ! - delta2 < 0, no transpose of input rotations (flag = 0) - ! - flag = 1 - ! - flag = 2 - ! - flag = 3 - - use pFUnit_mod - use BeamDyn_Subs - use NWTC_Num - use test_tools - - implicit none - - ! input rotation axis and angle - real(BDKi), dimension(3) :: n1, n2 - real(BDKi) :: angle1, angle2 - - ! result rotations - real(BDKi), dimension(3,3) :: testrotation, baselinerotation, r1, r2 - real(BDKi), dimension(3) :: composedparams - - ! other test settings - integer :: flag - character(1024) :: testname - real(BDKi) :: tolerance - - ! initialize NWTC_Num constants - call SetConstants() - - tolerance = 1e-14 - - ! set the rotation axes for all tests - n1 = (/ 1, 0, 0 /) ! x axis - n2 = (/ 0, 0, 1 /) ! z axis - - - ! -------------------------------------------------------------------------- - testname = "both rotation angles 0, no transpose of input rotations (flag = 0):" - angle1 = 0 ! 0 degrees - angle2 = 0 ! 0 degrees - flag = 0 - - ! both rotations should return an identity matrix - r1 = calcRotationMatrix(angle1, n1) - r2 = calcRotationMatrix(angle2, n2) - baselinerotation = matmul(r1,r2) - - call BD_CrvCompose(composedparams, 4*tan(angle1/4)*n1, 4*tan(angle2/4)*n2, flag) - call BD_CrvMatrixR(composedparams, testrotation) - - @assertEqual(baselinerotation, testrotation, tolerance, testname) - - - ! -------------------------------------------------------------------------- - testname = "delta2 > 0, no transpose of input rotations (flag = 0):" - angle1 = PiBy2_D ! 90 degrees - angle2 = PiBy2_D ! 90 degrees - flag = 0 - - r1 = calcRotationMatrix(angle1, n1) - r2 = calcRotationMatrix(angle2, n2) - baselinerotation = matmul(r1,r2) - - call BD_CrvCompose(composedparams, 4*tan(angle1/4)*n1, 4*tan(angle2/4)*n2, flag) - call BD_CrvMatrixR(composedparams, testrotation) - - @assertEqual(baselinerotation, testrotation, tolerance, testname) - - - ! -------------------------------------------------------------------------- - testname = "delta2 < 0, no transpose of input rotations (flag = 0):" - angle1 = PiBy2_D ! 90 degrees - angle2 = 1.5*Pi ! 270 degrees - flag = 0 - - r1 = calcRotationMatrix(angle1, n1) - r2 = calcRotationMatrix(angle2, n2) - baselinerotation = matmul(r1,r2) - - call BD_CrvCompose(composedparams, 4*tan(angle1/4)*n1, 4*tan(angle2/4)*n2, flag) - call BD_CrvMatrixR(composedparams, testrotation) - - @assertEqual(baselinerotation, testrotation, tolerance, testname) - - - ! -------------------------------------------------------------------------- - testname = "delta2 > 0, transpose of first rotation (flag = 1):" - angle1 = PiBy2_D ! 90 degrees - angle2 = PiBy2_D ! 90 degrees - flag = 1 - - r1 = calcRotationMatrix(-angle1, n1) - r2 = calcRotationMatrix(angle2, n2) - baselinerotation = matmul(r1,r2) - - call BD_CrvCompose(composedparams, 4*tan(angle1/4)*n1, 4*tan(angle2/4)*n2, flag) - call BD_CrvMatrixR(composedparams, testrotation) - - @assertEqual(baselinerotation, testrotation, tolerance, testname) - - - ! -------------------------------------------------------------------------- - testname = "delta2 > 0, transpose of second rotation (flag = 2):" - angle1 = PiBy2_D ! 90 degrees - angle2 = PiBy2_D ! 90 degrees - flag = 2 - - r1 = calcRotationMatrix(angle1, n1) - r2 = calcRotationMatrix(-angle2, n2) - baselinerotation = matmul(r1,r2) - - call BD_CrvCompose(composedparams, 4*tan(angle1/4)*n1, 4*tan(angle2/4)*n2, flag) - call BD_CrvMatrixR(composedparams, testrotation) - - @assertEqual(baselinerotation, testrotation, tolerance, testname) - - - ! -------------------------------------------------------------------------- - testname = "delta2 > 0, transpose of both rotations (flag = 3):" - angle1 = PiBy2_D ! 90 degrees - angle2 = PiBy2_D ! 90 degrees - flag = 3 - - r1 = calcRotationMatrix(-angle1, n1) - r2 = calcRotationMatrix(-angle2, n2) - baselinerotation = matmul(r1,r2) - - call BD_CrvCompose(composedparams, 4*tan(angle1/4)*n1, 4*tan(angle2/4)*n2, flag) - call BD_CrvMatrixR(composedparams, testrotation) - - @assertEqual(baselinerotation, testrotation, tolerance, testname) - -end subroutine diff --git a/modules/beamdyn/tests/test_BD_CrvExtractCrv.F90 b/modules/beamdyn/tests/test_BD_CrvExtractCrv.F90 deleted file mode 100644 index bd8143f18b..0000000000 --- a/modules/beamdyn/tests/test_BD_CrvExtractCrv.F90 +++ /dev/null @@ -1,73 +0,0 @@ -@test -subroutine test_BD_CrvExtractCrv() - ! test branches - ! - simple rotation with known parameters: Pi on xaxis - ! - 0 rotation - ! - small rotation with baseline WM parameters calculated - - use pFUnit_mod - use BeamDyn_Subs - use NWTC_Num - use test_tools - - implicit none - - real(BDKi), dimension(3,3) :: r - real(BDKi), dimension(3) :: test_wmparams, baseline_wmparams - real(BDKi) :: angle, n(3) - character(1024) :: testname - real(BDKi) :: tolerance - integer(IntKi) :: ErrStat - character :: ErrMsg - - ! initialize NWTC_Num constants - call SetConstants() - - tolerance = 1e-14 - - ! set the rotation axis for all tests - n = (/ 1, 0, 0 /) ! x axis - - - ! -------------------------------------------------------------------------- - testname = "simple rotation with known parameters: Pi on xaxis:" - angle = Pi_D - - ! Wiener-Milenkovic parameters are <4.0, 0.0, 0.0> - baseline_wmparams = (/ 4.0, 0.0, 0.0 /) - - r = RonXAxis(angle) - call BD_CrvExtractCrv(r, test_wmparams, ErrStat, ErrMsg) - - @assertEqual(0.0_BDKi, ErrStat, tolerance, testname) - @assertEqual(baseline_wmparams, test_wmparams, tolerance, testname) - - - ! -------------------------------------------------------------------------- - testname = "0 rotation:" - angle = 0 - - ! Wiener-Milenkovic parameters are <0.0, 0.0, 0.0> - baseline_wmparams = (/ 0.0, 0.0, 0.0 /) - - r = RonXAxis(angle) - call BD_CrvExtractCrv(r, test_wmparams, ErrStat, ErrMsg) - - @assertEqual(0.0_BDKi, ErrStat, tolerance, testname) - @assertEqual(baseline_wmparams, test_wmparams, tolerance, testname) - - - ! -------------------------------------------------------------------------- - testname = "small rotation with baseline WM parameters calculated:" - angle = 0.1*Pi_D - - ! Wiener-Milenkovic parameters are calculated; note tangent is asymptotic at +/- pi/2 - baseline_wmparams = 4*tan(angle/4)*n - - r = RonXAxis(angle) - call BD_CrvExtractCrv(r, test_wmparams, ErrStat, ErrMsg) - - @assertEqual(0.0_BDKi, ErrStat, tolerance, testname) - @assertEqual(baseline_wmparams, test_wmparams, tolerance, testname) - -end subroutine test_BD_CrvExtractCrv diff --git a/modules/beamdyn/tests/test_BD_CrvMatrixH.F90 b/modules/beamdyn/tests/test_BD_CrvMatrixH.F90 deleted file mode 100644 index b71381de57..0000000000 --- a/modules/beamdyn/tests/test_BD_CrvMatrixH.F90 +++ /dev/null @@ -1,90 +0,0 @@ -@test -subroutine test_BD_CrvMatrixH() - ! test branches - ! - simple rotation with known parameters: Pi on xaxis - ! - 0 rotation - ! - small rotation with baseline WM parameters calculated - - ! TODO - ! invalid wm parameters (if thats a thing) - ! does the implemented WM formulation have any boundaries? - - use pFUnit_mod - use BeamDyn_Subs - use NWTC_Num - use test_tools - - implicit none - - real(BDKi), dimension(3,3) :: testH, baselineH - real(BDKi), dimension(3) :: wmparams - real(BDKi) :: angle, n(3) - character(1024) :: testname - real(BDKi) :: tolerance - integer(IntKi) :: ErrStat - character :: ErrMsg - - ! initialize NWTC_Num constants - call SetConstants() - - tolerance = 1e-14 - - ! set the rotation axis for all tests - n = (/ 1., 0., 0. /) ! x axis - - - ! -------------------------------------------------------------------------- - testname = "simple rotation with known parameters: Pi on xaxis:" - angle = Pi_D - - ! Wiener-Milenkovic parameters are <4.0, 0.0, 0.0> - wmparams = (/ 4.0, 0.0, 0.0 /) - - baselineH = H(wmparams) - - call BD_CrvMatrixH(wmparams, testH) - - @assertEqual(baselineH, testH, tolerance, testname) - - - ! -------------------------------------------------------------------------- - testname = "0 rotation:" - angle = 0 - - ! Wiener-Milenkovic parameters are <0.0, 0.0, 0.0> - wmparams = (/ 0.0, 0.0, 0.0 /) - - baselineH = H(wmparams) - - call BD_CrvMatrixH(wmparams, testH) - - @assertEqual(baselineH, testH, tolerance, testname) - - - ! -------------------------------------------------------------------------- - testname = "small rotation with baseline WM parameters calculated:" - angle = 0.1*Pi_D - - ! Wiener-Milenkovic parameters are calculated; note tangent is asymptotic at +/- pi/2 - wmparams = 4.*tan(angle/4.)*n - - baselineH = H(wmparams) - - call BD_CrvMatrixH(wmparams, testH) - - @assertEqual(baselineH, testH, tolerance, testname) - - contains - function H(c) - real(BDKi) :: c0, c(3) - real(BDKi) :: H(3,3) - - c0 = 2.0 - dot_product(c,c) / 8.0 - - H(1,:) = (/ c0 + c(1)*c(1)/4., c(1)*c(2)/4. - c(3), c(1)*c(3)/4. + c(2) /) - H(2,:) = (/ c(1)*c(2)/4. + c(3), c0 + c(2)*c(2)/4., c(2)*c(3)/4. - c(1) /) - H(3,:) = (/ c(1)*c(3)/4. - c(2), c(2)*c(3)/4. + c(1), c0 + c(3)*c(3)/4. /) - H = 2.*H/(4.-c0)**2 - - end function -end subroutine diff --git a/modules/beamdyn/tests/test_BD_CrvMatrixR.F90 b/modules/beamdyn/tests/test_BD_CrvMatrixR.F90 deleted file mode 100644 index b2cf779122..0000000000 --- a/modules/beamdyn/tests/test_BD_CrvMatrixR.F90 +++ /dev/null @@ -1,74 +0,0 @@ -@test -subroutine test_BD_CrvMatrixR() - ! test branches - ! - simple rotation with known parameters: Pi on xaxis - ! - 0 rotation - ! - small rotation with baseline WM parameters calculated - - ! TODO - ! invalid wm parameters (if thats a thing) - ! does the implemented WM formulation have any boundaries? - - use pFUnit_mod - use BeamDyn_Subs - use NWTC_Num - use test_tools - - implicit none - - real(BDKi), dimension(3,3) :: testR, baselineR - real(BDKi), dimension(3) :: wmparams - real(BDKi) :: angle, n(3) - character(1024) :: testname - real(BDKi) :: tolerance - integer(IntKi) :: ErrStat - character :: ErrMsg - - ! initialize NWTC_Num constants - call SetConstants() - - tolerance = 1e-14 - - ! set the rotation axis for all tests - n = (/ 1, 0, 0 /) ! x axis - - - ! -------------------------------------------------------------------------- - testname = "simple rotation with known parameters: Pi on xaxis:" - angle = Pi_D - - baselineR = RonXAxis(angle) - - ! Wiener-Milenkovic parameters are <4.0, 0.0, 0.0> - wmparams = (/ 4.0, 0.0, 0.0 /) - call BD_CrvMatrixR(wmparams, testR) - - @assertEqual(baselineR, testR, tolerance, testname) - - - ! -------------------------------------------------------------------------- - testname = "0 rotation:" - angle = 0 - - baselineR = RonXAxis(angle) - - ! Wiener-Milenkovic parameters are <0.0, 0.0, 0.0> - wmparams = (/ 0.0, 0.0, 0.0 /) - call BD_CrvMatrixR(wmparams, testR) - - @assertEqual(baselineR, testR, tolerance, testname) - - - ! -------------------------------------------------------------------------- - testname = "small rotation with baseline WM parameters calculated:" - angle = 0.1*Pi_D - - baselineR = RonXAxis(angle) - - ! Wiener-Milenkovic parameters are calculated; note tangent is asymptotic at +/- pi/2 - wmparams = 4*tan(angle/4)*n - call BD_CrvMatrixR(wmparams, testR) - - @assertEqual(baselineR, testR, tolerance, testname) - -end subroutine test_BD_CrvMatrixR diff --git a/modules/beamdyn/tests/test_BD_DistrLoadCopy.F90 b/modules/beamdyn/tests/test_BD_DistrLoadCopy.F90 deleted file mode 100644 index 64f2970e4c..0000000000 --- a/modules/beamdyn/tests/test_BD_DistrLoadCopy.F90 +++ /dev/null @@ -1,46 +0,0 @@ -@test -subroutine test_BD_DistrLoadCopy() - ! branches to test - ! - the 2D array is correctly stored in the 3D array - - use pFUnit_mod - use BeamDyn - use NWTC_Num - use test_tools - - implicit none - - integer :: i, j - type(BD_ParameterType) :: parametertype - type(BD_InputType) :: inputtype - type(BD_MiscVarType) :: miscvartype - integer(IntKi) :: ErrStat - character :: ErrMsg - character(1024) :: testname - real(BDKi) :: tolerance - - ! initialize NWTC_Num constants - call SetConstants() - - tolerance = 1e-14 - - - ! -------------------------------------------------------------------------- - testname = "static simple beam under gravity:" - - ! build the parametertype, inputtype, and miscvartype - parametertype = simpleParameterType(1,16,16,0,1) - miscvartype = simpleMiscVarType(parametertype%nqp, parametertype%dof_node, parametertype%elem_total, parametertype%nodes_per_elem) - inputtype = simpleInputType(parametertype%nqp, parametertype%elem_total) - - call BD_DistrLoadCopy(parametertype, inputtype, miscvartype) - - do j = 1, parametertype%elem_total - do i = 1, parametertype%nqp - @assertEqual((/ 9*(j-1)+3*(i-1)+1, 9*(j-1)+3*(i-1)+2, 9*(j-1)+3*(i-1)+3 /), miscvartype%DistrLoad_QP(1:3,i,j)) - @assertEqual((/ -9*(j-1)-3*(i-1)-1, -9*(j-1)-3*(i-1)-2, -9*(j-1)-3*(i-1)-3 /), miscvartype%DistrLoad_QP(4:6,i,j)) - end do - end do - - call BD_DestroyParam(parametertype, ErrStat, ErrMsg) -end subroutine diff --git a/modules/beamdyn/tests/test_BD_GaussPointWeight.F90 b/modules/beamdyn/tests/test_BD_GaussPointWeight.F90 deleted file mode 100644 index 9464377b2a..0000000000 --- a/modules/beamdyn/tests/test_BD_GaussPointWeight.F90 +++ /dev/null @@ -1,123 +0,0 @@ -@test -subroutine test_BD_GaussPointWeight() - ! test branches - ! - p = 1, invalid value - ! - p = 2, boundaries only - ! - p = 5, odd number - ! - p = 6, even number - ! - p = 97, large, prime number - - use pFUnit_mod - use BeamDyn_Subs - use NWTC_Num - use test_tools - - implicit none - - integer :: p - real(BDKi), allocatable :: locations(:), weights(:) - real(BDKi), allocatable :: baselinelocations(:), baselineweights(:) - integer(IntKi) :: ErrStat - character :: ErrMsg - character(1024) :: testname - real(BDKi) :: tolerance - - ! initialize NWTC_Num constants - call SetConstants() - - tolerance = 1e-10 - - - ! the baseline solutions for this unit test can be calculated using the Gauss-Lobatto quadrature - ! the Python Numpy package provides this functionality with numpy.polynomial.legendre.leggauss. - ! the first array returned are locations and the second are the weights - ! >>> from numpy import polynomial - ! >>> polynomial.legendre.leggauss(2) - ! (array([-0.57735027, 0.57735027]), array([ 1., 1.])) - ! >>> polynomial.legendre.leggauss(5) - ! (array([-0.90617985, -0.53846931, 0. , 0.53846931, 0.90617985]), array([ 0.23692689, 0.47862867, 0.56888889, 0.47862867, 0.23692689])) - - - ! -------------------------------------------------------------------------- - testname = "p = 1, invalid value:" - p = 1 - call AllocAry(baselinelocations, p, "GLL baseline", ErrStat, ErrMsg) - call AllocAry(baselineweights, p, "GLL baseline", ErrStat, ErrMsg) - baselinelocations = (/ -0.57735026919, 0.57735026919 /) - baselineweights = (/ 1.0, 1.0/) - - call AllocAry(locations, p, "GLL nodes", ErrStat, ErrMsg) - call AllocAry(weights, p, "GLL weights", ErrStat, ErrMsg) - call BD_GaussPointWeight(p, locations, weights, ErrStat, ErrMsg) - - @assertEqual(4, ErrStat, testname) - - deallocate(baselinelocations) - deallocate(baselineweights) - deallocate(locations) - deallocate(weights) - - - ! -------------------------------------------------------------------------- - testname = "p = 2, boundaries only:" - p = 2 - call AllocAry(baselinelocations, p, "GLL baseline", ErrStat, ErrMsg) - call AllocAry(baselineweights, p, "GLL baseline", ErrStat, ErrMsg) - baselinelocations = (/ -0.57735026919, 0.57735026919 /) - baselineweights = (/ 1.0, 1.0/) - - call AllocAry(locations, p, "GLL nodes", ErrStat, ErrMsg) - call AllocAry(weights, p, "GLL weights", ErrStat, ErrMsg) - call BD_GaussPointWeight(p, locations, weights, ErrStat, ErrMsg) - - @assertEqual(baselinelocations, locations, tolerance, testname) - @assertEqual(baselineweights, weights, tolerance, testname) - - deallocate(baselinelocations) - deallocate(baselineweights) - deallocate(locations) - deallocate(weights) - - - ! -------------------------------------------------------------------------- - testname = "p = 5, odd number:" - p = 5 - call AllocAry(baselinelocations, p, "GLL baseline", ErrStat, ErrMsg) - call AllocAry(baselineweights, p, "GLL baseline", ErrStat, ErrMsg) - baselinelocations = (/ -0.906179845939, -0.538469310106, 0.0, 0.538469310106, 0.906179845939 /) - baselineweights = (/ 0.236926885056, 0.478628670499, 0.568888888889, 0.478628670499, 0.236926885056 /) - - call AllocAry(locations, p, "GLL nodes", ErrStat, ErrMsg) - call AllocAry(weights, p, "GLL weights", ErrStat, ErrMsg) - call BD_GaussPointWeight(p, locations, weights, ErrStat, ErrMsg) - - @assertEqual(baselinelocations, locations, tolerance, testname) - @assertEqual(baselineweights, weights, tolerance, testname) - - deallocate(baselinelocations) - deallocate(baselineweights) - deallocate(locations) - deallocate(weights) - - - ! -------------------------------------------------------------------------- - testname = "p = 6, even number:" - p = 6 - call AllocAry(baselinelocations, p, "GLL baseline", ErrStat, ErrMsg) - call AllocAry(baselineweights, p, "GLL baseline", ErrStat, ErrMsg) - baselinelocations = (/ -0.932469514203, -0.661209386466, -0.238619186083, 0.238619186083, 0.661209386466, 0.932469514203 /) - baselineweights = (/ 0.171324492379, 0.360761573048, 0.467913934573, 0.467913934573, 0.360761573048, 0.171324492379 /) - - call AllocAry(locations, p, "GLL nodes", ErrStat, ErrMsg) - call AllocAry(weights, p, "GLL weights", ErrStat, ErrMsg) - call BD_GaussPointWeight(p, locations, weights, ErrStat, ErrMsg) - - @assertEqual(baselinelocations, locations, tolerance, testname) - @assertEqual(baselineweights, weights, tolerance, testname) - - deallocate(baselinelocations) - deallocate(baselineweights) - deallocate(locations) - deallocate(weights) - -end subroutine diff --git a/modules/beamdyn/tests/test_BD_GenerateGLL.F90 b/modules/beamdyn/tests/test_BD_GenerateGLL.F90 deleted file mode 100644 index d71e758957..0000000000 --- a/modules/beamdyn/tests/test_BD_GenerateGLL.F90 +++ /dev/null @@ -1,117 +0,0 @@ -@test -subroutine test_BD_GenerateGLL() - ! test branches - ! - p = 2, boundaries only - ! - p = 5, odd number - ! - p = 6, even number - ! - p = 97, large, prime number - - use pFUnit_mod - use BeamDyn_Subs - use NWTC_Num - use test_tools - - implicit none - - integer :: p - real(BDKi), allocatable :: gll_nodes(:), baseline(:) - integer(IntKi) :: ErrStat - character :: ErrMsg - character(1024) :: testname - real(BDKi) :: tolerance - - ! initialize NWTC_Num constants - call SetConstants() - - tolerance = 1e-14 - - - ! the baseline solutions for this unit test can be calculated using the Gauss-Lobatto quadrature - ! this website provides the nodes and weights: - ! http://keisan.casio.com/exec/system/1280801905 - - - ! -------------------------------------------------------------------------- - testname = "p = 2, boundaries only:" - p = 2 - allocate(baseline(p)) - baseline = (/ -1.0, 1.0 /) - - call AllocAry(gll_nodes, p, "GLL points array", ErrStat, ErrMsg) - call BD_GenerateGLL(p, gll_nodes, ErrStat, ErrMsg) - - @assertEqual(baseline, gll_nodes, tolerance, testname) - - deallocate(baseline) - deallocate(gll_nodes) - - ! -------------------------------------------------------------------------- - testname = "p = 5, odd number:" - p = 5 - allocate(baseline(p)) - baseline = (/ -1.0, -0.6546536707079771437983, 0.0, 0.654653670707977143798, 1.0 /) - - call AllocAry(gll_nodes, p, "GLL points array", ErrStat, ErrMsg) - call BD_GenerateGLL(p, gll_nodes, ErrStat, ErrMsg) - - @assertEqual(baseline, gll_nodes, tolerance, testname) - - deallocate(baseline) - deallocate(gll_nodes) - - - ! -------------------------------------------------------------------------- - testname = "p = 6, even number:" - p = 6 - allocate(baseline(p)) - baseline = (/ -1.0, -0.765055323929464692851, -0.2852315164806450963142, 0.2852315164806450963142, 0.765055323929464692851, 1.0 /) - - call AllocAry(gll_nodes, p, "GLL points array", ErrStat, ErrMsg) - call BD_GenerateGLL(p, gll_nodes, ErrStat, ErrMsg) - - @assertEqual(baseline, gll_nodes, tolerance, testname) - - deallocate(baseline) - deallocate(gll_nodes) - - - ! -------------------------------------------------------------------------- - testname = "p = 97, large, prime number:" - p = 97 - allocate(baseline(p)) - baseline = (/ & - -1.0, -0.9992117675187679372925, -0.997358420211575308381, -0.994447829238317218534, & - -0.9904833045655763827779, -0.9854690874505481580336, -0.9794105031099910659294, -0.972313976393383949863, & - -0.964187029755659609253, -0.955038276712134050045, -0.944877413224633009627, -0.933715207638498109806, & - -0.921563489367936527388, -0.9084351364079280548151, -0.8943440617122115723236, -0.8793051984632038831786,& - -0.8633344842547974738284, -0.8464488442074511804343, -0.8286661730348553921423, -0.810005316081936147328, & - -0.7904860493547251817926, -0.7701290585635136140501, -0.748955917201652598455, -0.7269890636833281333, & - -0.704251777564599720681, -0.6807681548729427782946, -0.6565630825714660926978, -0.631662212184884059709, & - -0.6060919326152061877601, -0.579879342175961313997, -0.553052219874599625586, -0.5256389959735105979894,& - -0.4976687218608582506373, -0.4691710392631656985371, -0.440176148832277959663, -0.4107147781399945491769,& - -0.3808181491142908001982, -0.350517944951638397684, -0.3198462765404906463777, -0.2888356484315159109028,& - -0.257518924390642905356, -0.2259292925714235538959, -0.1941002303436225183436, -0.1620654688153067619161,& - -0.1298589570860333006308, -0.09751482626901823919031, -0.0650673533204149925476, -0.032550924714033997197, & - 0.0, 0.032550924714033997197, 0.0650673533204149925476, 0.0975148262690182391903,& - 0.1298589570860333006308, 0.1620654688153067619161, 0.194100230343622518344, 0.225929292571423553896, & - 0.257518924390642905356, 0.2888356484315159109028, 0.3198462765404906463777, 0.3505179449516383976839,& - 0.3808181491142908001982, 0.410714778139994549177, 0.4401761488322779596629, 0.4691710392631656985371,& - 0.4976687218608582506373, 0.5256389959735105979894, 0.5530522198745996255862, 0.579879342175961313997, & - 0.6060919326152061877601, 0.6316622121848840597089, 0.6565630825714660926978, 0.6807681548729427782946,& - 0.7042517775645997206813, 0.7269890636833281332999, 0.7489559172016525984547, 0.7701290585635136140501,& - 0.7904860493547251817926, 0.8100053160819361473279, 0.8286661730348553921423, 0.8464488442074511804343,& - 0.8633344842547974738284, 0.8793051984632038831786, 0.8943440617122115723236, 0.9084351364079280548151,& - 0.9215634893679365273879, 0.933715207638498109806, 0.9448774132246330096275, 0.955038276712134050045, & - 0.9641870297556596092534, 0.9723139763933839498625, 0.9794105031099910659294, 0.9854690874505481580336,& - 0.9904833045655763827779, 0.9944478292383172185338, 0.9973584202115753083808, 0.9992117675187679372925,& - 1.0 /) - - call AllocAry(gll_nodes, p, "GLL points array", ErrStat, ErrMsg) - call BD_GenerateGLL(p, gll_nodes, ErrStat, ErrMsg) - - @assertEqual(baseline, gll_nodes, tolerance, testname) - - deallocate(baseline) - deallocate(gll_nodes) - -end subroutine diff --git a/modules/beamdyn/tests/test_BD_GravityForce.F90 b/modules/beamdyn/tests/test_BD_GravityForce.F90 deleted file mode 100644 index 8b5aef8fcf..0000000000 --- a/modules/beamdyn/tests/test_BD_GravityForce.F90 +++ /dev/null @@ -1,46 +0,0 @@ -@test -subroutine test_BD_GravityForce() - - use pFUnit_mod - use BeamDyn - use NWTC_Num - use test_tools - - implicit none - - integer :: i, j - real(BDKi) :: gravity(3) - type(BD_ParameterType) :: parametertype - type(BD_MiscVarType) :: miscvartype - real(BDKi) :: baseline(6) - integer(IntKi) :: ErrStat - character :: ErrMsg - character(1024) :: testname - real(BDKi) :: tolerance - - ! initialize NWTC_Num constants - call SetConstants() - - tolerance = 1e-14 - - - ! -------------------------------------------------------------------------- - testname = "static simple beam under gravity:" - baseline(1:3) = getGravityInZ() - baseline(4:6) = (/ 0.0, 0.0, 0.0 /) - - ! allocate and build the custom types - parametertype = simpleParameterType(1,16,16,0,1) - miscvartype = simpleMiscVarType(parametertype%nqp, parametertype%dof_node, parametertype%elem_total, parametertype%nodes_per_elem) - - gravity = getGravityInZ() - - ! call the subroutine to test - call BD_GravityForce(1, parametertype, miscvartype, gravity) - - ! test the values - @assertEqual(baseline, miscvartype%qp%Fg(:,1,1), tolerance, testname) - - call BD_DestroyParam(parametertype, ErrStat, ErrMsg) - -end subroutine diff --git a/modules/beamdyn/tests/test_BD_InitShpDerJaco.F90 b/modules/beamdyn/tests/test_BD_InitShpDerJaco.F90 deleted file mode 100644 index 13e39f733b..0000000000 --- a/modules/beamdyn/tests/test_BD_InitShpDerJaco.F90 +++ /dev/null @@ -1,173 +0,0 @@ -module test_BD_InitShpDerJaco - - use pFUnit_mod - use BeamDyn - use NWTC_Num - use test_tools - - implicit none - - integer(IntKi) :: i, j, idx_qp, nelem - type(BD_ParameterType) :: p - real(BDKi), allocatable :: gll_nodes(:), inp_QPtWeight(:) - real(BDKi), allocatable :: baseline_QPtWeight(:), baseline_QPtN(:) - real(BDKi), allocatable :: baseline_Shp(:,:), baseline_ShpDer(:,:), baseline_jacobian(:,:), baseline_QPtw_ShpDer(:,:) - real(BDKi), allocatable :: baseline_QPtw_Shp_ShpDer(:,:,:), baseline_QPtw_Shp_Jac(:,:,:) - real(BDKi), allocatable :: baseline_QPtw_Shp_Shp_Jac(:,:,:,:), baseline_QPtw_ShpDer_ShpDer_Jac(:,:,:,:) - integer(IntKi) :: ErrStat - character :: ErrMsg - character(1024) :: testname - real(BDKi) :: tolerance - -contains - - @test - subroutine test_BD_InitShpDerJaco_5node() - ! branches to test - ! - 5 node, 1 element; undeformed - - ! initialize NWTC_Num constants - call SetConstants() - - tolerance = 1e-13 - - ! -------------------------------------------------------------------------- - testname = "5 node, 1 element, curved:" - - ! Let's use Gauss_Legendre Quadrature, which should be exact for intended polynomial test case - p = simpleparametertype(1,5,5,0,1) - - ! Allocate memory for baseline results - call AllocAry(baseline_Shp , p%nodes_per_elem, p%nqp, 'Reference Shp' , ErrStat, ErrMsg) - call AllocAry(baseline_ShpDer , p%nodes_per_elem, p%nqp, 'Reference ShpDer' , ErrStat, ErrMsg) - call AllocAry(baseline_Jacobian , p%nqp, p%elem_total, 'Reference Jacobian', ErrStat, ErrMsg) - call AllocAry(baseline_QPtN , p%nqp, 'Reference QPtN' , ErrStat, ErrMsg) - call AllocAry(baseline_QPtWeight, p%nqp, 'Reference QPtWeight', ErrStat, ErrMsg) - - ! Allocate memory for other relevant variables belonging to module p - call AllocAry(baseline_QPtw_Shp_Shp_Jac , p%nqp, p%nodes_per_elem, p%nodes_per_elem, p%elem_total, 'reference QPtw_Shp_Shp_Jac' , ErrStat, ErrMsg) - call AllocAry(baseline_QPtw_ShpDer_ShpDer_Jac, p%nqp, p%nodes_per_elem, p%nodes_per_elem, p%elem_total, 'reference baseline_QPtw_ShpDer_ShpDer_Jac', ErrStat, ErrMsg) - call AllocAry(baseline_QPtw_Shp_ShpDer , p%nqp, p%nodes_per_elem, p%nodes_per_elem , 'reference QPtw_Shp_ShpDer' , ErrStat, ErrMsg) - call AllocAry(baseline_QPtw_Shp_Jac , p%nqp, p%nodes_per_elem, p%elem_total , 'reference QPtw_Shp_Jac' , ErrStat, ErrMsg) - call AllocAry(baseline_QPtw_ShpDer , p%nqp, p%nodes_per_elem , 'reference QPtw_ShpDer' , ErrStat, ErrMsg) - - ! assign baseline results - ! baseline quadrature points and weights; this is 5-point Gauss-Legendre quadrature - - baseline_QPtN(1:p%nqp) = (/ -0.9061798459386640, -0.5384693101056831, 0. , 0.5384693101056831, 0.9061798459386640 /) - baseline_QPtWeight(1:p%nqp) = (/ 0.2369268850561891, 0.4786286704993665, 0.5688888888888889, 0.4786286704993665, 0.2369268850561891 /) - - ! assign baseline jacobian based; these values were calculated in separte mathematica script - baseline_jacobian(1:p%nqp,1) = (/ 0.6715870058501458, 1.509599209717604, 2.861380785564901, 4.097191592895223, 4.880926263217582 /) - - ! assign baseline shape functions based on example as described above - baseline_Shp(1,1:p%nqp) = (/ 0.5933706960199465, -0.10048256880508302, 0., 0.030144110771879763, -0.029205077492916114 /) - baseline_Shp(2,1:p%nqp) = (/ 0.516435198649618, 0.9313661019373962, 0., -0.09069490469997694, 0.08322282221996001 /) - baseline_Shp(3,1:p%nqp) = (/ -0.16382363939660807, 0.22966726079578503, 1., 0.22966726079578503, -0.16382363939660807 /) - baseline_Shp(4,1:p%nqp) = (/ 0.08322282221996001, -0.09069490469997694, 0., 0.9313661019373962, 0.516435198649618 /) - baseline_Shp(5,1:p%nqp) = (/ -0.029205077492916114, 0.030144110771879763, 0., -0.10048256880508302, 0.5933706960199465 /) - - ! assign baseline shape function derivatives based on example as described above - baseline_ShpDer(1,1:p%nqp) = (/ -3.705336453591454, -0.5287152679802739, 0.375, -0.24351802112960028, 0.14423640936799356 /) - baseline_ShpDer(2,1:p%nqp) = (/ 4.33282116876393, -1.0976579678283382, -1.3365845776954537, 0.7497385700132875, -0.42067623042767965 /) - baseline_ShpDer(3,1:p%nqp) = (/ -0.9039245362321631, 2.1325937846922898, 0., -2.1325937846922898, 0.9039245362321631 /) - baseline_ShpDer(4,1:p%nqp) = (/ 0.42067623042767965, -0.7497385700132875, 1.3365845776954537, 1.0976579678283382, -4.33282116876393 /) - baseline_ShpDer(5,1:p%nqp) = (/ -0.14423640936799356, 0.24351802112960028, -0.375, 0.5287152679802739, 3.705336453591454 /) - - ! uuN0 is of dimension (3 dof, nodes_per_elem, elem_total) - p%uuN0(1:3,1,1) = (/ 0.0, 0.0, 0.0 /) - p%uuN0(1:3,2,1) = (/ 0.16237631096713473, 0.17578464768961147, 0.1481911137890286 /) - p%uuN0(1:3,3,1) = (/ 0.25, 1., 1.1875 /) - p%uuN0(1:3,4,1) = (/ -0.30523345382427747, 2.4670724951675314, 2.953849702537502 /) - p%uuN0(1:3,5,1) = (/ -1., 3.5, 4. /) - - ! Using BD_GaussPointWeight; hoping it's tested! - call BD_GaussPointWeight(p%nqp, p%QPtN, p%QPtWeight, ErrStat, ErrMsg) - - @assertEqual(baseline_QPtN, p%QPtN , tolerance, testname) - @assertEqual(baseline_QPtWeight, p%QPtWeight, tolerance, testname) - - ! Allocate memory for GLL node positions in 1D parametric space - call AllocAry(gll_nodes, p%nodes_per_elem, "GLL points array", ErrStat, ErrMsg) - gll_nodes = (/ -1., -0.6546536707079771, 0., 0.6546536707079771, 1. /) - - ! call the test subroutine - call BD_InitShpDerJaco(gll_nodes, p) - - ! check the baseline shape functions and their derivatives - do idx_qp = 1, p%nqp - do j = 1, p%nodes_per_elem - @assertEqual(baseline_Shp(j,idx_qp) , p%Shp(j,idx_qp) , tolerance, testname) - @assertEqual(baseline_ShpDer(j,idx_qp), p%ShpDer(j,idx_qp), tolerance, testname) - end do - end do - - ! check the baseline jacobian - do nelem = 1, p%elem_total - do idx_qp = 1, p%nqp - @assertEqual(baseline_jacobian(idx_qp,nelem), p%jacobian(idx_qp,nelem), tolerance, testname) - end do - end do - - ! Test and assemble variables N*N^T*wt*Jacobian and dN*dN^T*wt/Jacobian - do nelem = 1, p%elem_total - do idx_qp = 1, p%nqp - do j = 1, p%nodes_per_elem - do i = 1, p%nodes_per_elem - ! Check the variable N*N^T*Jacobian - baseline_QPtw_Shp_Shp_Jac(idx_qp,i,j,nelem) = baseline_Shp(i,idx_qp)*baseline_Shp(j,idx_qp)*baseline_QPtWeight(idx_qp)*baseline_jacobian(idx_qp,nelem) - @assertEqual(baseline_QPtw_Shp_Shp_Jac(idx_qp,i,j,nelem), p%QPtw_Shp_Shp_Jac(idx_qp,i,j,nelem), tolerance, testname) - - ! Check the variable dN*dN^T*Jacobian - baseline_QPtw_ShpDer_ShpDer_Jac(idx_qp,i,j,nelem) = baseline_ShpDer(i,idx_qp)*baseline_ShpDer(j,idx_qp)*baseline_QPtWeight(idx_qp)/baseline_jacobian(idx_qp,nelem) - @assertEqual(baseline_QPtw_ShpDer_ShpDer_Jac(idx_qp,i,j,nelem), p%QPtw_ShpDer_ShpDer_Jac(idx_qp,i,j,nelem), tolerance, testname) - end do - end do - end do - end do - - ! Test and assemble variable N*dN^T*wt*Jacobian - do idx_qp = 1, p%nqp - do j = 1, p%nodes_per_elem - do i = 1, p%nodes_per_elem - baseline_QPtw_Shp_ShpDer(idx_qp,i,j) = baseline_Shp(i,idx_qp)*baseline_ShpDer(j,idx_qp)*baseline_QPtWeight(idx_qp) - @assertEqual(baseline_QPtw_Shp_ShpDer(idx_qp,i,j), p%QPtw_Shp_ShpDer(idx_qp,i,j), tolerance, testname) - end do - end do - end do - - ! Test and assemble variable N*wt*Jacobian - do nelem = 1, p%elem_total - do i = 1, p%nodes_per_elem - do idx_qp = 1, p%nqp - baseline_QPtw_Shp_Jac(idx_qp,i,nelem) = baseline_Shp(i,idx_qp)*baseline_QPtWeight(idx_qp)*baseline_Jacobian(idx_qp,nelem) - @assertEqual(baseline_QPtw_Shp_Jac(idx_qp,i,nelem), p%QPtw_Shp_Jac(idx_qp,i,nelem), tolerance, testname) - end do - end do - end do - - ! Test and assemble variable dN*wt. - do i = 1, p%nodes_per_elem - do idx_qp = 1, p%nqp - baseline_QPtw_ShpDer(idx_qp,i) = baseline_ShpDer(i,idx_qp)*baseline_QPtWeight(idx_qp) - @assertEqual(baseline_QPtw_ShpDer(idx_qp,i), p%QPtw_ShpDer(idx_qp,i), tolerance, testname) - end do - end do - - ! dealocate baseline variables - if (allocated(gll_nodes)) deallocate(gll_nodes) - deallocate(baseline_Shp) - deallocate(baseline_ShpDer) - deallocate(baseline_Jacobian) - deallocate(baseline_QPtN) - deallocate(baseline_QPtWeight) - deallocate(baseline_QPtw_Shp_Shp_Jac) - deallocate(baseline_QPtw_ShpDer_ShpDer_Jac) - deallocate(baseline_QPtw_Shp_ShpDer) - deallocate(baseline_QPtw_Shp_Jac) - deallocate(baseline_QPtw_ShpDer) - - call BD_DestroyParam(p, ErrStat, ErrMsg) - - end subroutine -end module diff --git a/modules/beamdyn/tests/test_BD_InitializeNodalLocations.F90 b/modules/beamdyn/tests/test_BD_InitializeNodalLocations.F90 new file mode 100644 index 0000000000..c23b0ae189 --- /dev/null +++ b/modules/beamdyn/tests/test_BD_InitializeNodalLocations.F90 @@ -0,0 +1,131 @@ +module test_BD_InitializeNodalLocations + + use test_tools +use BeamDyn + +implicit none + +private +public :: test_BD_InitializeNodalLocations_suite + +contains + +!> Collect all exported unit tests +subroutine test_BD_InitializeNodalLocations_suite(testsuite) + type(unittest_type), allocatable, intent(out) :: testsuite(:) + testsuite = [ & + new_unittest("test_BD_InitializeNodalLocations_np5_p6", test_BD_InitializeNodalLocations_np5_p6) & + ] +end subroutine + +subroutine test_BD_InitializeNodalLocations_np5_p6(error) + type(error_type), allocatable, intent(out) :: error + + ! test problem where reference line is defined by 1 member, 5 keypoints, + ! and we fit a 6th order LSFE + + type(BD_ParameterType) :: p + + integer(IntKi) :: i ! do loop + + integer(IntKi) :: member_total + integer(IntKi), allocatable :: kp_member(:) + real(BDKi), allocatable :: kp_coordinate(:, :) + + real(BDKi), allocatable :: baseline_uuN0(:, :, :) + real(BDKi), allocatable :: baseline_tangent(:, :, :) + real(BDKi), allocatable :: baseline_twist(:, :) + real(BDKi), allocatable :: gll(:) + + real(BDKi) :: cc(3) + + integer(IntKi) :: np ! number of points defining reference line + + integer(IntKi) :: ErrStat + character :: ErrMsg + character(1024) :: testname + real(BDKi), parameter :: tolerance = 1e-13 + + ! -------------------------------------------------------------------------- + testname = "test_InitializeNodalLocations_1m_kp5_p6" + + member_total = 1 + + np = 5 ! five points defining the reference line + p = simpleParameterType(1, 7, 3, 0, 1) !simpleParameterType(elem_total, nodes_per_elem, nqp, qp_indx_offset, refine) + + p%dof_node = 6 + + call AllocAry(kp_member, member_total, "kp_member", ErrStat, ErrMsg) + call AllocAry(gll, p%nodes_per_elem, "gll", ErrStat, ErrMsg) + call AllocAry(baseline_uuN0, p%dof_node, p%nodes_per_elem, p%elem_total, "baseline_uuN0", ErrStat, ErrMsg) + + call AllocAry(baseline_tangent, 3, p%nodes_per_elem, p%elem_total, "baseline_tangent", ErrStat, ErrMsg) + call AllocAry(baseline_twist, p%nodes_per_elem, p%elem_total, "baseline_twist", ErrStat, ErrMsg) + + ! remove the following once the routine moves to least squares + + call AllocAry(p%segment_eta, np - 1, 'segment length ratio array', ErrStat, ErrMsg) + + kp_member(1) = np ! one member defined by 5 points + + call AllocAry(kp_coordinate, kp_member(1), 4, "kp_coordinate", ErrStat, ErrMsg) + + kp_coordinate(1, :) = [0., 0., 0., 0.] + kp_coordinate(2, :) = [0.2421875, 0.3125, 1.25, 5.625] + kp_coordinate(3, :) = [0.375, 1., 2.5, 22.5] + kp_coordinate(4, :) = [0.1171875, 2.0625, 3.75, 50.625] + kp_coordinate(5, :) = [-1., 3.5, 5., 90.] + + gll(:) = [-1., -0.8302238962785669, -0.46884879347071423, 0., 0.46884879347071423, 0.8302238962785669, 1.] + + baseline_uuN0 = 0. + + ! following calculated in mathematica + baseline_uuN0(1:3, 1, 1) = [0., 0., 0.] + baseline_uuN0(1:3, 2, 1) = [0.0847841995263206, 0.06406196997648083, 0.4244402593035813] + baseline_uuN0(1:3, 3, 1) = [0.2556265283202704, 0.3443790047804582, 1.327878016323214] + baseline_uuN0(1:3, 4, 1) = [0.375, 1., 2.5] + baseline_uuN0(1:3, 5, 1) = [0.152564565773068, 1.985349781927959, 3.672121983676785] + baseline_uuN0(1:3, 6, 1) = [-0.4874656517463806, 2.969845606951464, 4.575559740696413] + baseline_uuN0(1:3, 7, 1) = [-1., 3.5, 5.] + + baseline_tangent(1:3, 1, 1) = [0.1951800145897074, 0.0975900072948519, 0.975900072948533] + baseline_tangent(1:3, 2, 1) = [0.1914764728687931, 0.1942130285347349, 0.962090463462295] + baseline_tangent(1:3, 3, 1) = [0.1549438849532919, 0.3815415434641369, 0.911272979477931] + baseline_tangent(1:3, 4, 1) = [0., 0.5734623443633284, 0.81923192051904] + baseline_tangent(1:3, 5, 1) = [-0.2957782328585355, 0.6690666276575518, 0.6818101529913093] + baseline_tangent(1:3, 6, 1) = [-0.5494018213496115, 0.6414840856724742, 0.535402471535834] + baseline_tangent(1:3, 7, 1) = [-0.6492344540642337, 0.6028605644882184, 0.4637388957601716] + + baseline_twist(1, 1) = 0. + baseline_twist(2, 1) = 0.6485383213836768 + baseline_twist(3, 1) = 6.347736094444107 + baseline_twist(4, 1) = 22.50000000000001 + baseline_twist(5, 1) = 48.54412750680838 + baseline_twist(6, 1) = 75.36868898645466 + baseline_twist(7, 1) = 90. + + ! here we're using the BD_ComputeIniNodalCrv to construct the rotation parameters; this is what is used in + ! BeamDyn; I do not want to rely on this routine and would rather calculate externally + do i = 1, 7 + call BD_ComputeIniNodalCrv(baseline_tangent(1:3, i, 1), baseline_twist(i, 1), cc, ErrStat, ErrMsg) + baseline_uuN0(4:6, i, 1) = cc + end do + + ! remove after reworking fit; dropping spline in favor of lease squares; p%SP_Coef is required in original spline fit implementation + !call ComputeSplineCoeffs(member_total, np, kp_member, kp_coordinate, p%SP_Coef, ErrStat, ErrMsg) + + call InitializeNodalLocations(member_total, kp_member, kp_coordinate, p, GLL, ErrStat, ErrMsg) + + !do i = 1, 7 + ! write(*,*) i, baseline_uuN0(4,i,1), baseline_uuN0(5,i,1), baseline_uuN0(6,i,1), p%uuN0(4,i,1), p%uuN0(5,i,1), p%uuN0(6,i,1) + !enddo + + call check_array(error, baseline_uuN0, p%uuN0, testname, tolerance); if (allocated(error)) return + + call BD_DestroyParam(p, ErrStat, ErrMsg) + +end subroutine + +end module diff --git a/modules/beamdyn/tests/test_BD_InputGlobalLocal.F90 b/modules/beamdyn/tests/test_BD_InputGlobalLocal.F90 deleted file mode 100644 index 94e56e330f..0000000000 --- a/modules/beamdyn/tests/test_BD_InputGlobalLocal.F90 +++ /dev/null @@ -1,104 +0,0 @@ -@test -subroutine test_BD_InputGlobalLocal() - ! branches to test - ! - a simple rotation does the rotation - - ! Check the following quanities are actually rotated - !! 1 Displacements -> u%RootMotion%TranslationDisp(:,1) - !! 2 Linear/Angular velocities -> u%RootMotion%TranslationVel(:,1), u%RootMotion%RotationVel(:,1) - !! 3 Linear/Angular accelerations -> u%RootMotion%TranslationAcc(:,1), u%RootMotion%RotationAcc(:,1) - !! 4 Point forces/moments -> u%PointLoad%Force(1:3,i), u%PointLoad%Moment(1:3,i) - !! 5 Distributed forces/moments -> u%DistrLoad%Force(1:3,i), u%DistrLoad%Moment(1:3,i) - - ! Verify the DCM is transposed - !! u%RootMotion%Orientation(:,:,1) - - use pFUnit_mod - use BeamDyn - use NWTC_Num - use test_tools - - implicit none - - integer :: i, totalnodes - type(BD_ParameterType) :: parametertype - type(BD_OtherStateType) :: otherstate - type(BD_InputType) :: inputtype - real(BDKi), dimension(3) :: vectorInit, vectorAfterRotation, rotationaxis - integer(IntKi) :: ErrStat - character :: ErrMsg - character(1024) :: testname - real(BDKi) :: tolerance - - ! initialize NWTC_Num constants - call SetConstants() - - - ! -------------------------------------------------------------------------- - testname = "test_BD_InputGlobalLocal:" - - tolerance = 1e-14 - totalnodes = 2 - vectorInit = (/ 0.0, 0.0, 1.0 /) - vectorAfterRotation = (/ 0.0, 0.0, -1.0 /) - rotationaxis = (/ 1.0, 0.0, 0.0 /) - - ! build the parameter type - parametertype%node_total = totalnodes - otherstate=simpleOtherState() - otherstate%GlbRot = calcRotationMatrix(real(Pi, BDKi), rotationaxis) - - ! build the inputs - call AllocAry(inputtype%RootMotion%TranslationDisp, 3, 1, 'TranslationDisp', ErrStat, ErrMsg) - call AllocAry(inputtype%RootMotion%TranslationVel, 3, 1, 'TranslationVel', ErrStat, ErrMsg) - call AllocAry(inputtype%RootMotion%RotationVel, 3, 1, 'RotationVel', ErrStat, ErrMsg) - call AllocAry(inputtype%RootMotion%TranslationAcc, 3, 1, 'TranslationAcc', ErrStat, ErrMsg) - call AllocAry(inputtype%RootMotion%RotationAcc, 3, 1, 'RotationAcc', ErrStat, ErrMsg) - inputtype%RootMotion%TranslationDisp(:,1) = vectorInit - inputtype%RootMotion%TranslationVel(:,1) = vectorInit - inputtype%RootMotion%RotationVel(:,1) = vectorInit - inputtype%RootMotion%TranslationAcc(:,1) = vectorInit - inputtype%RootMotion%RotationAcc(:,1) = vectorInit - - call AllocAry(inputtype%PointLoad%Force, 3, totalnodes, 'PointLoad%Force', ErrStat, ErrMsg) - call AllocAry(inputtype%PointLoad%Moment, 3, totalnodes, 'PointLoad%Moment', ErrStat, ErrMsg) - do i = 1, parametertype%node_total - inputtype%PointLoad%Force(1:3,i) = vectorInit - inputtype%PointLoad%Moment(1:3,i) = vectorInit - end do - - inputtype%DistrLoad%Nnodes = totalnodes - call AllocAry(inputtype%DistrLoad%Force, 3, totalnodes, 'DistrLoad%Force', ErrStat, ErrMsg) - call AllocAry(inputtype%DistrLoad%Moment, 3, totalnodes, 'DistrLoad%Moment', ErrStat, ErrMsg) - do i = 1, inputtype%DistrLoad%Nnodes - inputtype%DistrLoad%Force(1:3,i) = vectorInit - inputtype%DistrLoad%Moment(1:3,i) = vectorInit - end do - - call AllocAry(inputtype%RootMotion%Orientation, 3, 3, totalnodes, 'RootMotion%Orientation', ErrStat, ErrMsg) - inputtype%RootMotion%Orientation(:,:,1) = otherstate%GlbRot - - ! call the subroutine to test - call BD_InputGlobalLocal(parametertype, otherstate, inputtype) - - ! test the values - @assertEqual(vectorAfterRotation, real(inputtype%RootMotion%TranslationDisp(:,1), BDKi), tolerance, testname) - @assertEqual(vectorAfterRotation, real(inputtype%RootMotion%TranslationVel(:,1), BDKi), tolerance, testname) - @assertEqual(vectorAfterRotation, real(inputtype%RootMotion%RotationVel(:,1), BDKi), tolerance, testname) - @assertEqual(vectorAfterRotation, real(inputtype%RootMotion%TranslationAcc(:,1), BDKi), tolerance, testname) - @assertEqual(vectorAfterRotation, real(inputtype%RootMotion%RotationAcc(:,1), BDKi), tolerance, testname) - - do i = 1, parametertype%node_total - @assertEqual(vectorAfterRotation, real(inputtype%PointLoad%Force(1:3,i), BDKi), tolerance, testname) - @assertEqual(vectorAfterRotation, real(inputtype%PointLoad%Moment(1:3,i), BDKi), tolerance, testname) - end do - - inputtype%DistrLoad%Nnodes = totalnodes - do i = 1, inputtype%DistrLoad%Nnodes - @assertEqual(vectorAfterRotation, real(inputtype%DistrLoad%Force(1:3,i), BDKi), tolerance, testname) - @assertEqual(vectorAfterRotation, real(inputtype%DistrLoad%Moment(1:3,i), BDKi), tolerance, testname) - end do - - @assertEqual(transpose(otherstate%GlbRot), inputtype%RootMotion%Orientation(:,:,1), tolerance, testname) - -end subroutine diff --git a/modules/beamdyn/tests/test_BD_MemberEta.F90 b/modules/beamdyn/tests/test_BD_MemberEta.F90 index 08df56dbfd..208dc94001 100644 --- a/modules/beamdyn/tests/test_BD_MemberEta.F90 +++ b/modules/beamdyn/tests/test_BD_MemberEta.F90 @@ -1,87 +1,90 @@ module test_BD_MemberEta - - ! tests routine that calculates the length of the beam's reference line - ! also finds element boundaries in eta coordinates - - use pFUnit_mod - use BeamDyn - use NWTC_Num - use test_tools - - implicit none - - integer(IntKi) :: nqp - integer(IntKi) :: member_total - real(BDKi) :: total_length - real(BDKi), allocatable :: baseline_jac(:,:) - real(BDKi), allocatable :: baseline_QPtW(:) - real(BDKi), allocatable :: baseline_member_eta(:) - real(BDKi), allocatable :: test_member_eta(:) - real(BDKi) :: baseline_total_length - real(BDKi) :: test_total_length - integer(IntKi) :: ErrStat - character :: ErrMsg - character(1024) :: testname - real(BDKi) :: tolerance + +! tests routine that calculates the length of the beam's reference line +! also finds element boundaries in eta coordinates + +use BeamDyn +use NWTC_Num +use test_tools + +implicit none + +private +public :: test_BD_MemberEta_suite contains - @test - subroutine test_BD_MemberEta_5node() - - ! initialize NWTC_Num constants - call SetConstants() - - tolerance = 1e-14 - - ! -------------------------------------------------------------------------- - testname = "test_bd_member_eta_5node" - - ! this test problem is for a beam reference axis defined by 5 points - ! x = 0., 0.16237631096713473, 0.25, -0.30523345382427747, -1. - ! y = 0., 0.17578464768961147, 1., 2.4670724951675314, 3.5 - ! z = 0., 0.1481911137890286, 1.1875, 2.953849702537502, 4. - ! where the underlying forth-order polynomial is - ! fx[u_] = u - 2 u^3; - ! fy[u_] = u/2 + 3 u^2; - ! fz[u_] = 5 u^2 - u^4; - ! - ! exact (to mp) length is 5.627175237247959 - ! The Jacobian values below are calculate based on a 5-node Legendre Spectral Element - ! While we give baseline Jacobian here, we check "test_BD_InitShpDerJaco.F90" elsewhere - - nqp = 5 ! number of quadrature points - member_total = 1 ! 1 element - - call AllocAry(baseline_jac , nqp, member_total, 'Reference Jacobian', ErrStat, ErrMsg) - call AllocAry(baseline_QPtW, nqp, 'Reference QPtWeight', ErrStat, ErrMsg) - call AllocAry(baseline_member_eta, member_total, 'Reference member_eta', ErrStat, ErrMsg) - call AllocAry(test_member_eta, member_total, 'test member_eta', ErrStat, ErrMsg) - - ! 5-point Guass-Legendre quadrature; see https://pomax.github.io/bezierinfo/legendre-gauss.html - baseline_QPtW(1:nqp) = (/ 0.2369268850561891, 0.4786286704993665, 0.5688888888888889, 0.4786286704993665, 0.2369268850561891 /) - - ! assign baseline jacobian based; these values were calculated in separate mathematica script - baseline_jac(1:nqp,1) = (/ 0.6715870058501458, 1.509599209717604, 2.861380785564901, 4.097191592895223, 4.880926263217582 /) - - ! total length of beam calculated in mathematica; note that for this curved beam, GL quadrature is APPROXIMATE, but - ! converged rapidly; TR quadrature is not nearly as good; commented-out values are useful for understanding quadrature performance - ! for curved beams. - !baseline_total_length = 5.627175237247959 ! this is actual length based on mathematica - !baseline_total_length = 5.634413547964786 ! this is approximation with 9-point Trapezoidal quadrature; 0.13% error - !baseline_total_length = 5.627202424388781 ! this is approximation with 7-point gauss quadrature; 0.0005% error - baseline_total_length = 5.626918236484061 ! this is approximation with 5-point gauss quadrature; 0.005% error (tested here) - baseline_member_eta(1) = 1. ! just one element; so member_length / total_length = 1 - - call BD_MemberEta(member_total, baseline_QPtW, baseline_jac, test_member_eta, test_total_length) - - @assertEqual(baseline_total_length, test_total_length, tolerance, testname) - @assertEqual(baseline_member_eta, test_member_eta, tolerance, testname) - - deallocate(baseline_Jac) - deallocate(baseline_QPtW) - deallocate(baseline_member_eta) - deallocate(test_member_eta) - - end subroutine +!> Collect all exported unit tests +subroutine test_BD_MemberEta_suite(testsuite) + type(unittest_type), allocatable, intent(out) :: testsuite(:) + testsuite = [ & + new_unittest("test_BD_MemberEta_5node", test_BD_MemberEta_5node) & + ] + end subroutine + +subroutine test_BD_MemberEta_5node(error) + type(error_type), allocatable, intent(out) :: error + integer(IntKi) :: nqp + integer(IntKi) :: member_total + real(BDKi) :: total_length + real(BDKi), allocatable :: baseline_jac(:, :) + real(BDKi), allocatable :: baseline_QPtW(:) + real(BDKi), allocatable :: baseline_member_eta(:) + real(BDKi), allocatable :: test_member_eta(:) + real(BDKi) :: baseline_total_length + real(BDKi) :: test_total_length + integer(IntKi) :: ErrStat + character :: ErrMsg + character(1024) :: testname + + ! -------------------------------------------------------------------------- + testname = "test_bd_member_eta_5node" + + ! this test problem is for a beam reference axis defined by 5 points + ! x = 0., 0.16237631096713473, 0.25, -0.30523345382427747, -1. + ! y = 0., 0.17578464768961147, 1., 2.4670724951675314, 3.5 + ! z = 0., 0.1481911137890286, 1.1875, 2.953849702537502, 4. + ! where the underlying forth-order polynomial is + ! fx[u_] = u - 2 u^3; + ! fy[u_] = u/2 + 3 u^2; + ! fz[u_] = 5 u^2 - u^4; + ! + ! exact (to mp) length is 5.627175237247959 + ! The Jacobian values below are calculate based on a 5-node Legendre Spectral Element + ! While we give baseline Jacobian here, we check "test_BD_InitShpDerJaco.F90" elsewhere + + nqp = 5 ! number of quadrature points + member_total = 1 ! 1 element + + call AllocAry(baseline_jac, nqp, member_total, 'Reference Jacobian', ErrStat, ErrMsg) + call AllocAry(baseline_QPtW, nqp, 'Reference QPtWeight', ErrStat, ErrMsg) + call AllocAry(baseline_member_eta, member_total, 'Reference member_eta', ErrStat, ErrMsg) + call AllocAry(test_member_eta, member_total, 'test member_eta', ErrStat, ErrMsg) + + ! 5-point Guass-Legendre quadrature; see https://pomax.github.io/bezierinfo/legendre-gauss.html + baseline_QPtW(1:nqp) = [0.2369268850561891, 0.4786286704993665, 0.5688888888888889, 0.4786286704993665, 0.2369268850561891] + + ! assign baseline jacobian based; these values were calculated in separate mathematica script + baseline_jac(1:nqp, 1) = [0.6715870058501458, 1.509599209717604, 2.861380785564901, 4.097191592895223, 4.880926263217582] + + ! total length of beam calculated in mathematica; note that for this curved beam, GL quadrature is APPROXIMATE, but + ! converged rapidly; TR quadrature is not nearly as good; commented-out values are useful for understanding quadrature performance + ! for curved beams. + !baseline_total_length = 5.627175237247959 ! this is actual length based on mathematica + !baseline_total_length = 5.634413547964786 ! this is approximation with 9-point Trapezoidal quadrature; 0.13% error + !baseline_total_length = 5.627202424388781 ! this is approximation with 7-point gauss quadrature; 0.0005% error + baseline_total_length = 5.626918236484061 ! this is approximation with 5-point gauss quadrature; 0.005% error (tested here) + baseline_member_eta(1) = 1. ! just one element; so member_length / total_length = 1 + + call BD_MemberEta(member_total, baseline_QPtW, baseline_jac, test_member_eta, test_total_length) + + call check(error, baseline_total_length, test_total_length, testname, thr=tolerance); if (allocated(error)) return + call check_array(error, baseline_member_eta, test_member_eta, testname, tolerance); if (allocated(error)) return + + deallocate (baseline_Jac) + deallocate (baseline_QPtW) + deallocate (baseline_member_eta) + deallocate (test_member_eta) + +end subroutine end module diff --git a/modules/beamdyn/tests/test_BD_Misc.F90 b/modules/beamdyn/tests/test_BD_Misc.F90 new file mode 100644 index 0000000000..ac6b5b38f4 --- /dev/null +++ b/modules/beamdyn/tests/test_BD_Misc.F90 @@ -0,0 +1,219 @@ +module test_BD_Misc + +use test_tools +use BeamDyn_Subs +use BeamDyn + +implicit none + +private +public :: test_BD_Misc_suite + +contains + +!> Collect all exported unit tests +subroutine test_BD_Misc_suite(testsuite) + type(unittest_type), allocatable, intent(out) :: testsuite(:) + testsuite = [ & + new_unittest("test_BD_DistrLoadCopy", test_BD_DistrLoadCopy), & + new_unittest("test_BD_InputGlobalLocal", test_BD_InputGlobalLocal), & + new_unittest("test_BD_GravityForce", test_BD_GravityForce), & + new_unittest("test_BD_QPData_mEta_rho", test_BD_QPData_mEta_rho) & + ] +end subroutine + +subroutine test_BD_DistrLoadCopy(error) + type(error_type), allocatable, intent(out) :: error + + ! branches to test + ! - the 2D array is correctly stored in the 3D array + + integer :: i, j + type(BD_ParameterType) :: parametertype + type(BD_InputType) :: inputtype + type(BD_MiscVarType) :: miscvartype + integer(IntKi) :: ErrStat + character :: ErrMsg + character(1024) :: testname + + ! -------------------------------------------------------------------------- + testname = "static simple beam under gravity:" + + ! build the parametertype, inputtype, and miscvartype + parametertype = simpleParameterType(1, 16, 16, 0, 1) + miscvartype = simpleMiscVarType(parametertype%nqp, parametertype%dof_node, parametertype%elem_total, parametertype%nodes_per_elem) + inputtype = simpleInputType(parametertype%nqp, parametertype%elem_total) + + call BD_DistrLoadCopy(parametertype, inputtype, miscvartype) + + do j = 1, parametertype%elem_total + do i = 1, parametertype%nqp + call check_array(error, real([9 * (j - 1) + 3 * (i - 1) + 1, 9 * (j - 1) + 3 * (i - 1) + 2, 9 * (j - 1) + 3 * (i - 1) + 3], R8Ki), miscvartype%DistrLoad_QP(1:3, i, j)); if (allocated(error)) return + call check_array(error, real([-9 * (j - 1) - 3 * (i - 1) - 1, -9 * (j - 1) - 3 * (i - 1) - 2, -9 * (j - 1) - 3 * (i - 1) - 3], R8Ki), miscvartype%DistrLoad_QP(4:6, i, j)); if (allocated(error)) return + end do + end do + + call BD_DestroyParam(parametertype, ErrStat, ErrMsg) +end subroutine + +subroutine test_BD_InputGlobalLocal(error) + type(error_type), allocatable, intent(out) :: error + + ! branches to test + ! - a simple rotation does the rotation + + ! Check the following quanities are actually rotated + !! 1 Displacements -> u%RootMotion%TranslationDisp(:,1) + !! 2 Linear/Angular velocities -> u%RootMotion%TranslationVel(:,1), u%RootMotion%RotationVel(:,1) + !! 3 Linear/Angular accelerations -> u%RootMotion%TranslationAcc(:,1), u%RootMotion%RotationAcc(:,1) + !! 4 Point forces/moments -> u%PointLoad%Force(1:3,i), u%PointLoad%Moment(1:3,i) + !! 5 Distributed forces/moments -> u%DistrLoad%Force(1:3,i), u%DistrLoad%Moment(1:3,i) + + ! Verify the DCM is transposed + !! u%RootMotion%Orientation(:,:,1) + + integer :: i, totalnodes + type(BD_ParameterType) :: parametertype + type(BD_OtherStateType) :: otherstate + type(BD_InputType) :: inputtype + real(BDKi), dimension(3) :: vectorInit, vectorAfterRotation, rotationaxis + integer(IntKi) :: ErrStat + character :: ErrMsg + character(1024) :: testname + + ! -------------------------------------------------------------------------- + testname = "test_BD_InputGlobalLocal:" + + totalnodes = 2 + vectorInit = [0.0, 0.0, 1.0] + vectorAfterRotation = [0.0, 0.0, -1.0] + rotationaxis = [1.0, 0.0, 0.0] + + ! build the parameter type + parametertype%node_total = totalnodes + otherstate = simpleOtherState() + otherstate%GlbRot = calcRotationMatrix(real(Pi, BDKi), rotationaxis) + + ! build the inputs + call AllocAry(inputtype%RootMotion%TranslationDisp, 3, 1, 'TranslationDisp', ErrStat, ErrMsg) + call AllocAry(inputtype%RootMotion%TranslationVel, 3, 1, 'TranslationVel', ErrStat, ErrMsg) + call AllocAry(inputtype%RootMotion%RotationVel, 3, 1, 'RotationVel', ErrStat, ErrMsg) + call AllocAry(inputtype%RootMotion%TranslationAcc, 3, 1, 'TranslationAcc', ErrStat, ErrMsg) + call AllocAry(inputtype%RootMotion%RotationAcc, 3, 1, 'RotationAcc', ErrStat, ErrMsg) + inputtype%RootMotion%TranslationDisp(:, 1) = vectorInit + inputtype%RootMotion%TranslationVel(:, 1) = vectorInit + inputtype%RootMotion%RotationVel(:, 1) = vectorInit + inputtype%RootMotion%TranslationAcc(:, 1) = vectorInit + inputtype%RootMotion%RotationAcc(:, 1) = vectorInit + + call AllocAry(inputtype%PointLoad%Force, 3, totalnodes, 'PointLoad%Force', ErrStat, ErrMsg) + call AllocAry(inputtype%PointLoad%Moment, 3, totalnodes, 'PointLoad%Moment', ErrStat, ErrMsg) + do i = 1, parametertype%node_total + inputtype%PointLoad%Force(1:3, i) = vectorInit + inputtype%PointLoad%Moment(1:3, i) = vectorInit + end do + + inputtype%DistrLoad%Nnodes = totalnodes + call AllocAry(inputtype%DistrLoad%Force, 3, totalnodes, 'DistrLoad%Force', ErrStat, ErrMsg) + call AllocAry(inputtype%DistrLoad%Moment, 3, totalnodes, 'DistrLoad%Moment', ErrStat, ErrMsg) + do i = 1, inputtype%DistrLoad%Nnodes + inputtype%DistrLoad%Force(1:3, i) = vectorInit + inputtype%DistrLoad%Moment(1:3, i) = vectorInit + end do + + call AllocAry(inputtype%RootMotion%Orientation, 3, 3, totalnodes, 'RootMotion%Orientation', ErrStat, ErrMsg) + inputtype%RootMotion%Orientation(:, :, 1) = otherstate%GlbRot + + ! call the subroutine to test + call BD_InputGlobalLocal(parametertype, otherstate, inputtype) + + ! test the values + call check_array(error, vectorAfterRotation, real(inputtype%RootMotion%TranslationDisp(:, 1), BDKi), testname, tolerance); if (allocated(error)) return + call check_array(error, vectorAfterRotation, real(inputtype%RootMotion%TranslationVel(:, 1), BDKi), testname, tolerance); if (allocated(error)) return + call check_array(error, vectorAfterRotation, real(inputtype%RootMotion%RotationVel(:, 1), BDKi), testname, tolerance); if (allocated(error)) return + call check_array(error, vectorAfterRotation, real(inputtype%RootMotion%TranslationAcc(:, 1), BDKi), testname, tolerance); if (allocated(error)) return + call check_array(error, vectorAfterRotation, real(inputtype%RootMotion%RotationAcc(:, 1), BDKi), testname, tolerance); if (allocated(error)) return + + do i = 1, parametertype%node_total + call check_array(error, vectorAfterRotation, real(inputtype%PointLoad%Force(1:3, i), BDKi), testname, tolerance); if (allocated(error)) return + call check_array(error, vectorAfterRotation, real(inputtype%PointLoad%Moment(1:3, i), BDKi), testname, tolerance); if (allocated(error)) return + end do + + inputtype%DistrLoad%Nnodes = totalnodes + do i = 1, inputtype%DistrLoad%Nnodes + call check_array(error, vectorAfterRotation, real(inputtype%DistrLoad%Force(1:3, i), BDKi), testname, tolerance); if (allocated(error)) return + call check_array(error, vectorAfterRotation, real(inputtype%DistrLoad%Moment(1:3, i), BDKi), testname, tolerance); if (allocated(error)) return + end do + + call check_array(error, transpose(otherstate%GlbRot), inputtype%RootMotion%Orientation(:, :, 1), testname, tolerance); if (allocated(error)) return + +end subroutine + +subroutine test_BD_GravityForce(error) + type(error_type), allocatable, intent(out) :: error + integer :: i, j + real(BDKi) :: gravity(3) + type(BD_ParameterType) :: parametertype + type(BD_MiscVarType) :: miscvartype + real(BDKi) :: baseline(6) + integer(IntKi) :: ErrStat + character :: ErrMsg + character(1024) :: testname + + ! -------------------------------------------------------------------------- + testname = "static simple beam under gravity:" + baseline(1:3) = getGravityInZ() + baseline(4:6) = [0.0, 0.0, 0.0] + + ! allocate and build the custom types + parametertype = simpleParameterType(1, 16, 16, 0, 1) + miscvartype = simpleMiscVarType(parametertype%nqp, parametertype%dof_node, parametertype%elem_total, parametertype%nodes_per_elem) + + gravity = getGravityInZ() + + ! call the subroutine to test + call BD_GravityForce(1, parametertype, miscvartype, gravity) + + ! test the values + call check_array(error, baseline, miscvartype%qp%Fg(:, 1, 1), testname, tolerance); if (allocated(error)) return + + call BD_DestroyParam(parametertype, ErrStat, ErrMsg) + +end subroutine + +subroutine test_BD_QPData_mEta_rho(error) + type(error_type), allocatable, intent(out) :: error + integer :: i, j + type(BD_MiscVarType) :: miscvartype + type(BD_ParameterType) :: parametertype + real(BDKi) :: baselineRho(3, 3), baselineRR0mEta(3) + character(1024) :: testname + integer(IntKi) :: ErrStat + character :: ErrMsg + + ! -------------------------------------------------------------------------- + testname = "static simple beam under gravity:" + + baselineRho(1, :) = [1.0, 0.0, 0.0] + baselineRho(2, :) = [0.0, 1.0, 0.0] + baselineRho(3, :) = [0.0, 0.0, 2.0] + + baselineRR0mEta = [0.0, 0.0, 0.0] + + ! allocate and build the custom input types + parametertype = simpleParameterType(1, 16, 16, 0, 1) + miscvartype = simpleMiscVarType(parametertype%nqp, parametertype%dof_node, parametertype%elem_total, parametertype%nodes_per_elem) + + ! allocate the results + call BD_QPData_mEta_rho(parametertype, miscvartype) + + do j = 1, parametertype%elem_total + do i = 1, parametertype%nqp + call check_array(error, baselineRho, miscvartype%qp%rho(:, :, i, j), testname, tolerance); if (allocated(error)) return + call check_array(error, baselineRR0mEta, miscvartype%qp%RR0mEta(:, i, j), testname, tolerance); if (allocated(error)) return + end do + end do + call BD_DestroyParam(parametertype, ErrStat, ErrMsg) +end subroutine + +end module diff --git a/modules/beamdyn/tests/test_BD_QPData_mEta_rho.F90 b/modules/beamdyn/tests/test_BD_QPData_mEta_rho.F90 deleted file mode 100644 index 19a9cb5ab6..0000000000 --- a/modules/beamdyn/tests/test_BD_QPData_mEta_rho.F90 +++ /dev/null @@ -1,50 +0,0 @@ -@test -subroutine test_BD_QPData_mEta_rho() - - use pFUnit_mod - use BeamDyn - use NWTC_Num - use test_tools - - implicit none - - integer :: i, j - type(BD_MiscVarType) :: miscvartype - type(BD_ParameterType) :: parametertype - real(BDKi) :: baselineRho(3,3), baselineRR0mEta(3) - character(1024) :: testname - real(BDKi) :: tolerance - integer(IntKi) :: ErrStat - character :: ErrMsg - - - ! initialize NWTC_Num constants - call SetConstants() - - tolerance = 1e-14 - - - ! -------------------------------------------------------------------------- - testname = "static simple beam under gravity:" - - baselineRho(1,:) = (/ 1.0, 0.0, 0.0 /) - baselineRho(2,:) = (/ 0.0, 1.0, 0.0 /) - baselineRho(3,:) = (/ 0.0, 0.0, 2.0 /) - - baselineRR0mEta = (/ 0.0, 0.0, 0.0 /) - - ! allocate and build the custom input types - parametertype = simpleParameterType(1,16,16,0,1) - miscvartype = simpleMiscVarType(parametertype%nqp, parametertype%dof_node, parametertype%elem_total, parametertype%nodes_per_elem) - - ! allocate the results - call BD_QPData_mEta_rho(parametertype, miscvartype) - - do j=1, parametertype%elem_total - do i=1, parametertype%nqp - @assertEqual(baselineRho, miscvartype%qp%rho(:,:,i,j), tolerance, testname) - @assertEqual(baselineRR0mEta, miscvartype%qp%RR0mEta(:,i,j), tolerance, testname) - end do - end do - call BD_DestroyParam(parametertype, ErrStat, ErrMsg) -end subroutine diff --git a/modules/beamdyn/tests/test_BD_QuadraturePointData.F90 b/modules/beamdyn/tests/test_BD_QuadraturePointData.F90 index fcf4f75a4f..e55770824b 100644 --- a/modules/beamdyn/tests/test_BD_QuadraturePointData.F90 +++ b/modules/beamdyn/tests/test_BD_QuadraturePointData.F90 @@ -1,279 +1,268 @@ module test_BD_QuadraturePointData - ! Tests the following routines: - ! BD_QuadraturePointDataAt0 - ! BD_DisplacementQP - ! BD_RotationalInterpQP - ! BD_StifAtDeformedQP - ! - ! Assumes BD_InitShpDerJaco is tested elsewhere; but implicitly tests it here - - use pFUnit_mod - use BeamDyn - use NWTC_Num - use test_tools - - implicit none - - type(BD_ParameterType) :: p - type(BD_ContinuousStateType) :: x !< Continuous states at t - type(BD_MiscVarType) :: m !< misc/optimization variables - - integer(IntKi) :: idx_qp, idx_node, i, j - integer(IntKi) :: nodes_per_elem - integer(IntKi) :: elem_total - integer(IntKi) :: nelem - integer(IntKi) :: nqp - - real(BDKi), allocatable :: gll_nodes(:) - real(BDKi), allocatable :: baseline_uu0(:,:,:) - real(BDKi), allocatable :: baseline_rrN0(:,:,:) - real(BDKi), allocatable :: baseline_E10(:,:,:) - - real(BDKi), allocatable :: baseline_uuu(:,:,:) - real(BDKi), allocatable :: baseline_uup(:,:,:) - real(BDKi), allocatable :: baseline_E1(:,:,:) - - real(BDKi), allocatable :: baseline_kappa(:,:,:) - real(BDKi), allocatable :: baseline_Nrrr(:,:,:) - real(BDKi), allocatable :: baseline_RR0(:,:,:,:) - - real(BDKi), allocatable :: baseline_Stif(:,:,:,:) - - integer(IntKi) :: ErrStat - character :: ErrMsg - character(1024) :: testname - real(BDKi) :: tolerance +! Tests the following routines: +! BD_QuadraturePointDataAt0 +! BD_DisplacementQP +! BD_RotationalInterpQP +! BD_StifAtDeformedQP +! +! Assumes BD_InitShpDerJaco is tested elsewhere; but implicitly tests it here + +use BeamDyn +use NWTC_Num +use test_tools + +implicit none + +private +public :: test_BD_QuadraturePointData_suite contains - @test - subroutine test_BD_QuadraturePointData_5node() - ! branches to test - ! - 5 node, 1 element; deformed - ! - ! tests the initial values at nodes, and the interpolated values at a single quadrature point - ! test results were created with mathematica - ! - ! DETAILS ABOUT UNDERLYING MODEL - ! Reference-line definition on 0 <= t <= 1 - ! fx[t_] = t - 2. t^4; - ! fy[t_] = -2 t + 3. t^2; - ! fz[t_] = 5. t; - ! ft[t_] = 90. t^2; - ! Length of undeformed line: 5.82222272658737 - ! - ! Displacement, 0 <= t <= 1 - ! ux[t_] = t^2; - ! uy[t_] = t^3 - t^2; - ! uz[t_] = t^2 + 0.2 t^3; - ! ucrv1[t_] = 0.1 t^2; - ! ucrv2[t_] = 0.2 t; - ! ucrv3[t_] = 0.1 t^3; - ! - ! Length of deformed line: 6.75332330098143 - ! - ! For 5 nodes (p=4), nodes located at {-1., -0.654654, 0., 0.654654, 1.} - - ! initialize NWTC_Num constants - call SetConstants() - - tolerance = 1e-13 - - ! -------------------------------------------------------------------------- - testname = "5 node, 1 element, 1 qp, curved:" - - nodes_per_elem = 5 ! fourth-order polynomial representation - elem_total = 1 - nqp = 1 ! we are testing at a single, randomly chosen quadrature point - - p = simpleparametertype(elem_total,nodes_per_elem,nqp,0,1) - - call AllocAry(baseline_uu0 , p%dof_node, p%nqp, p%elem_total, 'baseline_uu0' , ErrStat, ErrMsg) - call AllocAry(baseline_E10 , p%dof_node/2, p%nqp, p%elem_total, 'baseline_E10' , ErrStat, ErrMsg) - call AllocAry(baseline_rrN0 , p%dof_node/2, p%nodes_per_elem, p%elem_total, 'baseline_rrN0' , ErrStat, ErrMsg) - - call AllocAry(baseline_uuu , p%dof_node, p%nqp, p%elem_total, 'baseline_uuu' , ErrStat, ErrMsg) - call AllocAry(baseline_uup , p%dof_node/2, p%nqp, p%elem_total, 'baseline_uup' , ErrStat, ErrMsg) - call AllocAry(baseline_E1 , p%dof_node/2, p%nodes_per_elem, p%elem_total, 'baseline_E1' , ErrStat, ErrMsg) - - call AllocAry(baseline_kappa, p%dof_node/2, p%nqp, p%elem_total, 'baseline_kappa' , ErrStat, ErrMsg) - call AllocAry(baseline_Nrrr , p%dof_node/2, p%nodes_per_elem, p%elem_total, 'baseline_Nrrr' , ErrStat, ErrMsg) - - call AllocAry(baseline_RR0 , 3, 3, p%nqp, p%elem_total, 'baseline_RR0' , ErrStat, ErrMsg) - - call AllocAry(baseline_Stif , 6, 6, p%nqp, p%elem_total, 'baseline_Stif' , ErrStat, ErrMsg) - - ! assign baseline results - - ! uuN0 is of dimension (6 dof, nodes_per_elem, elem_total) - ! The following comes directly from the fx,fy,fz,ft defined above evaluated at the nodes - p%uuN0(1:3,1,1) = (/ 0.0, 0.0, 0.0 /) - p%uuN0(4:6,1,1) = (/ 0.37396158360688636,0.1958165026139741,-0.03702949411114144 /) - - p%uuN0(1:3,2,1) = (/ 0.17089517433538276,-0.2558982639254171,0.8633658232300558 /) - p%uuN0(4:6,2,1) = (/ 0.19122693263749954,0.18476700337274984,0.028875646293600333 /) - - p%uuN0(1:3,3,1) = (/ 0.375,-0.24999999999999997,2.5 /) - p%uuN0(4:6,3,1) = (/ -0.19563492419200498,0.03891420591317169,0.3929953248730882 /) - - p%uuN0(1:3,4,1) = (/ -0.10967068453946444,0.3987554067825597,4.136634176769939 /) - p%uuN0(4:6,4,1) = (/ -0.7291347777813711,-0.3147268839962532,0.9114830702745595 /) - - p%uuN0(1:3,5,1) = (/ -1., 1., 5. /) - p%uuN0(4:6,5,1) = (/ -1.0730193445455083,-0.42803085368057275,1.292451050059679 /) - - - ! the following is uuN0(4:6) with rotation of first node removed - baseline_rrN0(1:3,1,1) = (/ 0., 0., 0. /) - baseline_rrN0(1:3,2,1) = (/ -0.18695562365337798,-0.0032641497706398077,0.048935661676787534 /) - baseline_rrN0(1:3,3,1) = (/ -0.6080640291857297,-0.08595023366039768,0.4027112581652146 /) - baseline_rrN0(1:3,4,1) = (/ -1.1980591841054526,-0.3478409509012645,0.9658032687192992 /) - baseline_rrN0(1:3,5,1) = (/ -1.5856082606694464,-0.3853274394272689,1.3714709059387975 /) - - ! We are just looking at one randomly selected point in the domain to test interpolation; can be expanded - p%QptN(1) = 0.3 - - ! Input baseline/reference quantities; uu0 and E10 are only for at quadrature points, so just 1 point here - ! uu0 is reference line evaluated at quadrature point - ! E10 is tangent evaluated at qudrature point - baseline_uu0(1:3,1,1) = (/ 0.29298750000000007,-0.03250000000000007,3.2499999999999996 /) - baseline_uu0(4:6,1,1) = (/ -0.419497643454797,-0.1153574679103733,0.610107968645409 /) - baseline_E10(1:3,1,1) = (/ -0.22332806017852783,0.3449485111415417,0.9116661133321399 /) - - ! Allocate memory for GLL node positions in 1D parametric space - call AllocAry(gll_nodes, nodes_per_elem, "GLL points array", ErrStat, ErrMsg) - gll_nodes = (/ -1., -0.6546536707079771, 0., 0.6546536707079771, 1. /) - - ! Build the shape functions and derivative of shape functions evaluated at QP points; this is tested elsewhere - call BD_InitShpDerJaco(gll_nodes, p) - - ! **** primary function being tested ***** - call BD_QuadraturePointDataAt0( p ) - - testname = "5 node, 1 element, 1 qp, curved: BD_DisplacementQPAt0: rrN0" - @assertEqual(baseline_rrN0(:,:,1), p%rrN0(:,:,1), tolerance, testname) - - ! Test uu0; only one quadrature point for now - testname = "5 node, 1 element, 1 qp, curved: BD_DisplacementQPAt0: uu0" - do idx_qp = 1, p%nqp - @assertEqual(baseline_uu0(:,idx_qp,1), p%uu0(:,idx_qp,1), tolerance, testname) - end do - - ! Test E10; only one quadrature point for now - testname = "5 node, 1 element, 1 qp, curved: BD_DisplacementQPAt0: E10" - do idx_qp = 1, p%nqp - @assertEqual(baseline_E10(:,idx_qp,1), p%E10(:,idx_qp,1), tolerance, testname) - end do - - ! Now test "displacement" components at quadrature points by testing the three subroutine calls - ! in BD_QuadraturePointData: BD_DisplacementQP, BD_RotationalInterpQP, BD_StifAtDeformedQP - - x = simpleContinuousStateType(nodes_per_elem, nodes_per_elem, elem_total) - m = simpleMiscVarType(nqp, p%dof_node, elem_total, nodes_per_elem) - - x%q(1:3,1) = (/ 0., 0., 0. /) - x%q(4:6,1) = (/ 0., 0., 0. /) - - x%q(1:3,2) = (/ 0.02981602178886858,-0.02466759494943021,0.030845707156756254 /) - x%q(4:6,2) = (/ 0.0029816021788868583,0.034534632929202294, 0.000514842683943837 /) - - x%q(1:3,3) = (/ 0.25,-0.125,0.275 /) - x%q(4:6,3) = (/ 0.025,0.1,0.0125 /) - - x%q(1:3,4) = (/ 0.6844696924968456,-0.11818954790771263,0.7977257214146722 /) - x%q(4:6,4) = (/ 0.06844696924968456,0.16546536707079773,0.0566280144589133/) - - x%q(1:3,5) = (/ 1.,0.,1.2 /) - x%q(4:6,5) = (/ 0.1,0.2,0.1 /) - - idx_qp = 1 - nelem = 1 - baseline_uuu(1:3,idx_qp,nelem) = (/ 0.42250000000000015,-0.14787500000000003,0.4774250000000001 /) - baseline_uuu(4:6,idx_qp,nelem) = (/ 0.042250000000000024,0.1300000000000001,0.02746250000000002 /) - baseline_uup(1:3,idx_qp,nelem) = (/ 0.23717727987485349,-0.005929431996871376,0.2834268494504499 /) - baseline_E1(1:3, idx_qp,nelem) = (/ 0.01384921969632566, 0.33901907914467033, 1.1950929627825897 /) - - call BD_DisplacementQP( nelem, p, x, m ) - - do idx_qp = 1, p%nqp - testname = "5 node, 1 element, 1 qp, curved: BD_DisplacementQP: uuu" - @assertEqual(baseline_uuu(1:3,idx_qp,1), m%qp%uuu(1:3,idx_qp,1), tolerance, testname) - testname = "5 node, 1 element, 1 qp, curved: BD_DisplacementQP: uup" - @assertEqual(baseline_uup(1:3,idx_qp,1), m%qp%uup(1:3,idx_qp,1), tolerance, testname) - testname = "5 node, 1 element, 1 qp, curved: BD_DisplacementQP: E1" - @assertEqual(baseline_E1(1:3,idx_qp,1), m%qp%E1(1:3,idx_qp,1), tolerance, testname) - end do - - ! because x%q(4:6,1)=(0.,0.,0.) we don't have to rotate xq to get Nrrrr - baseline_Nrrr(1:3,1,nelem) = x%q(4:6,1) - baseline_Nrrr(1:3,2,nelem) = x%q(4:6,2) - baseline_Nrrr(1:3,3,nelem) = x%q(4:6,3) - baseline_Nrrr(1:3,4,nelem) = x%q(4:6,4) - baseline_Nrrr(1:3,5,nelem) = x%q(4:6,5) - - baseline_kappa(1:3,1,1) = (/ 0.024664714695954715,0.036297077098213545,0.02229356260962948 /) - - baseline_RR0(1,1:3,1,nelem) = (/0.7967507798136657,-0.5939809735620473,-0.11124206898740374/) - baseline_RR0(2,1:3,1,nelem) = (/0.5966254150993577,0.7439195402109748,0.3010346022466711 /) - baseline_RR0(3,1:3,1,nelem) = (/-0.09605367730511442,-0.30621939967705303,0.9471026186942948 /) - - CALL BD_RotationalInterpQP( nelem, p, x, m ) - - testname = "5 node, 1 element, 1 qp, curved: BD_RotationalInterpQP: m%Nrrr(1:3)" - do idx_node = 1, nodes_per_elem - @assertEqual(baseline_Nrrr(1:3,idx_node,1), m%Nrrr(1:3,idx_node,1), tolerance, testname) - end do - - do idx_qp = 1, p%nqp - testname = "5 node, 1 element, 1 qp, curved: BD_RotationalInterpQP: m%qp%uuu(4:6)" - @assertEqual(baseline_uuu(4:6,idx_qp,1), m%qp%uuu(4:6,idx_qp,1), tolerance, testname) - testname = "5 node, 1 element, 1 qp, curved: BD_RotationalInterpQP: m%qp%kappa" - @assertEqual(baseline_kappa(1:3,idx_qp,1), m%qp%kappa(1:3,idx_qp,1), tolerance, testname) - testname = "5 node, 1 element, 1 qp, curved: BD_RotationalInterpQP: m%qp%RR0" - @assertEqual(baseline_RR0(1:3,1:3,idx_qp,1), m%qp%RR0(1:3,1:3,idx_qp,1), tolerance, testname) - end do - - idx_qp = 1 - nelem = 1 - do i = 1, 6 - do j = 1, 6 - p%Stif0_QP(i,j,idx_qp) = float(i*j)*10.+float(i)*10. ! rather randomly chosen way to fully populate p%Stif0_QP - enddo - enddo - ! the following should be the result from MATMUL(tempR6,MATMUL(p%Stif0_QP(1:6,1:6,temp_id2+idx_qp),TRANSPOSE(tempR6))) - baseline_Stif(1,1:6,idx_qp,nelem) = (/4.5918231909187375, -33.558422946165074, -19.41124878362651, 2.60126686515566, -69.25969416961556, -31.26026770547517 /) - baseline_Stif(2,1:6,idx_qp,nelem) = (/-18.923545538732206, 138.2989541247406, 79.99647091096304, -10.720184539884109, 285.4288856786646, 128.8279349796045 /) - baseline_Stif(3,1:6,idx_qp,nelem) = (/ -13.509458152867301, 98.7311774904666, 57.109222684340786, -7.65310518243836, 203.76676129761876, 91.96984745617996 /) - baseline_Stif(4,1:6,idx_qp,nelem) = (/ 2.852586665816869, -20.847560074045475, -12.058885358769254, 1.6159897420374438, -43.026325677681456, -19.419872917332995 /) - baseline_Stif(5,1:6,idx_qp,nelem) = (/-50.11731488891121, 366.27238899233606, 211.8634858589486, -28.39144827024861, 755.9328304872744, 341.18924335009 /) - baseline_Stif(6,1:6,idx_qp,nelem) = (/-23.86246662028767, 174.39407269994138, 100.87502434184734, -13.518082286573822, 359.9239499295936, 162.45117977068867 /) - - CALL BD_StifAtDeformedQP( nelem, p, m ) +!> Collect all exported unit tests +subroutine test_BD_QuadraturePointData_suite(testsuite) + type(unittest_type), allocatable, intent(out) :: testsuite(:) + testsuite = [new_unittest("test_BD_QuadraturePointData_5node", test_BD_QuadraturePointData_5node)] + end subroutine + +subroutine test_BD_QuadraturePointData_5node(error) + type(error_type), allocatable, intent(out) :: error - do idx_qp = 1, p%nqp - testname = "5 node, 1 element, 1 qp, curved: BD_StifAtDeformedQP: m%qp%Stif" - @assertEqual(baseline_Stif(1:6,1:6,idx_qp,1), m%qp%Stif(1:6,1:6,idx_qp,1), 10.*tolerance, testname) - end do - - ! dealocate baseline variables - if (allocated(gll_nodes)) deallocate(gll_nodes) - if (allocated(baseline_uu0)) deallocate(baseline_uu0) - if (allocated(baseline_E10)) deallocate(baseline_E10) - if (allocated(baseline_rrN0)) deallocate(baseline_rrN0) - if (allocated(baseline_rrN0)) deallocate(baseline_rrN0) - if (allocated(baseline_E10)) deallocate(baseline_E10) - if (allocated(baseline_uuu)) deallocate(baseline_uuu) - if (allocated(baseline_uup)) deallocate(baseline_uup) - if (allocated(baseline_E1)) deallocate(baseline_E1) - if (allocated(baseline_kappa)) deallocate(baseline_kappa) - if (allocated(baseline_Nrrr)) deallocate(baseline_Nrrr) - if (allocated(baseline_RR0)) deallocate(baseline_RR0) - if (allocated(baseline_Stif)) deallocate(baseline_Stif) - - call BD_DestroyParam( p, ErrStat, ErrMsg) - CALL BD_DestroyMisc( m, ErrStat, ErrMsg) - CALL BD_DestroyContState(x, ErrStat, ErrMsg) - - end subroutine + ! branches to test + ! - 5 node, 1 element; deformed + ! + ! tests the initial values at nodes, and the interpolated values at a single quadrature point + ! test results were created with mathematica + ! + ! DETAILS ABOUT UNDERLYING MODEL + ! Reference-line definition on 0 <= t <= 1 + ! fx[t_] = t - 2. t^4; + ! fy[t_] = -2 t + 3. t^2; + ! fz[t_] = 5. t; + ! ft[t_] = 90. t^2; + ! Length of undeformed line: 5.82222272658737 + ! + ! Displacement, 0 <= t <= 1 + ! ux[t_] = t^2; + ! uy[t_] = t^3 - t^2; + ! uz[t_] = t^2 + 0.2 t^3; + ! ucrv1[t_] = 0.1 t^2; + ! ucrv2[t_] = 0.2 t; + ! ucrv3[t_] = 0.1 t^3; + ! + ! Length of deformed line: 6.75332330098143 + ! + ! For 5 nodes (p=4), nodes located at {-1., -0.654654, 0., 0.654654, 1.} + + type(BD_ParameterType) :: p + type(BD_ContinuousStateType) :: x !< Continuous states at t + type(BD_MiscVarType) :: m !< misc/optimization variables + + integer(IntKi) :: idx_qp, idx_node, i, j + integer(IntKi) :: nodes_per_elem + integer(IntKi) :: elem_total + integer(IntKi) :: nelem + integer(IntKi) :: nqp + + real(BDKi), allocatable :: gll_nodes(:) + real(BDKi), allocatable :: baseline_uu0(:, :, :) + real(BDKi), allocatable :: baseline_rrN0(:, :, :) + real(BDKi), allocatable :: baseline_E10(:, :, :) + + real(BDKi), allocatable :: baseline_uuu(:, :, :) + real(BDKi), allocatable :: baseline_uup(:, :, :) + real(BDKi), allocatable :: baseline_E1(:, :, :) + + real(BDKi), allocatable :: baseline_kappa(:, :, :) + real(BDKi), allocatable :: baseline_Nrrr(:, :, :) + real(BDKi), allocatable :: baseline_RR0(:, :, :, :) + + real(BDKi), allocatable :: baseline_Stif(:, :, :, :) + + integer(IntKi) :: ErrStat + character :: ErrMsg + character(1024) :: testname + real(BDKi), parameter :: tolerance = 1e-13 + + ! -------------------------------------------------------------------------- + testname = "5 node, 1 element, 1 qp, curved:" + + nodes_per_elem = 5 ! fourth-order polynomial representation + elem_total = 1 + nqp = 1 ! we are testing at a single, randomly chosen quadrature point + + p = simpleparametertype(elem_total, nodes_per_elem, nqp, 0, 1) + + call AllocAry(baseline_uu0, p%dof_node, p%nqp, p%elem_total, 'baseline_uu0', ErrStat, ErrMsg) + call AllocAry(baseline_E10, p%dof_node / 2, p%nqp, p%elem_total, 'baseline_E10', ErrStat, ErrMsg) + call AllocAry(baseline_rrN0, p%dof_node / 2, p%nodes_per_elem, p%elem_total, 'baseline_rrN0', ErrStat, ErrMsg) + + call AllocAry(baseline_uuu, p%dof_node, p%nqp, p%elem_total, 'baseline_uuu', ErrStat, ErrMsg) + call AllocAry(baseline_uup, p%dof_node / 2, p%nqp, p%elem_total, 'baseline_uup', ErrStat, ErrMsg) + call AllocAry(baseline_E1, p%dof_node / 2, p%nodes_per_elem, p%elem_total, 'baseline_E1', ErrStat, ErrMsg) + + call AllocAry(baseline_kappa, p%dof_node / 2, p%nqp, p%elem_total, 'baseline_kappa', ErrStat, ErrMsg) + call AllocAry(baseline_Nrrr, p%dof_node / 2, p%nodes_per_elem, p%elem_total, 'baseline_Nrrr', ErrStat, ErrMsg) + + call AllocAry(baseline_RR0, 3, 3, p%nqp, p%elem_total, 'baseline_RR0', ErrStat, ErrMsg) + + call AllocAry(baseline_Stif, 6, 6, p%nqp, p%elem_total, 'baseline_Stif', ErrStat, ErrMsg) + + ! assign baseline results + + ! uuN0 is of dimension (6 dof, nodes_per_elem, elem_total) + ! The following comes directly from the fx,fy,fz,ft defined above evaluated at the nodes + p%uuN0(1:3, 1, 1) = [0.0, 0.0, 0.0] + p%uuN0(4:6, 1, 1) = [0.37396158360688636, 0.1958165026139741, -0.03702949411114144] + + p%uuN0(1:3, 2, 1) = [0.17089517433538276, -0.2558982639254171, 0.8633658232300558] + p%uuN0(4:6, 2, 1) = [0.19122693263749954, 0.18476700337274984, 0.028875646293600333] + + p%uuN0(1:3, 3, 1) = [0.375, -0.24999999999999997, 2.5] + p%uuN0(4:6, 3, 1) = [-0.19563492419200498, 0.03891420591317169, 0.3929953248730882] + + p%uuN0(1:3, 4, 1) = [-0.10967068453946444, 0.3987554067825597, 4.136634176769939] + p%uuN0(4:6, 4, 1) = [-0.7291347777813711, -0.3147268839962532, 0.9114830702745595] + + p%uuN0(1:3, 5, 1) = [-1., 1., 5.] + p%uuN0(4:6, 5, 1) = [-1.0730193445455083, -0.42803085368057275, 1.292451050059679] + + ! the following is uuN0(4:6) with rotation of first node removed + baseline_rrN0(1:3, 1, 1) = [0., 0., 0.] + baseline_rrN0(1:3, 2, 1) = [-0.18695562365337798, -0.0032641497706398077, 0.048935661676787534] + baseline_rrN0(1:3, 3, 1) = [-0.6080640291857297, -0.08595023366039768, 0.4027112581652146] + baseline_rrN0(1:3, 4, 1) = [-1.1980591841054526, -0.3478409509012645, 0.9658032687192992] + baseline_rrN0(1:3, 5, 1) = [-1.5856082606694464, -0.3853274394272689, 1.3714709059387975] + + ! We are just looking at one randomly selected point in the domain to test interpolation; can be expanded + p%QptN(1) = 0.3 + + ! Input baseline/reference quantities; uu0 and E10 are only for at quadrature points, so just 1 point here + ! uu0 is reference line evaluated at quadrature point + ! E10 is tangent evaluated at qudrature point + baseline_uu0(1:3, 1, 1) = [0.29298750000000007, -0.03250000000000007, 3.2499999999999996] + baseline_uu0(4:6, 1, 1) = [-0.419497643454797, -0.1153574679103733, 0.610107968645409] + baseline_E10(1:3, 1, 1) = [-0.22332806017852783, 0.3449485111415417, 0.9116661133321399] + + ! Allocate memory for GLL node positions in 1D parametric space + call AllocAry(gll_nodes, nodes_per_elem, "GLL points array", ErrStat, ErrMsg) + gll_nodes = [-1., -0.6546536707079771, 0., 0.6546536707079771, 1.] + + ! Build the shape functions and derivative of shape functions evaluated at QP points; this is tested elsewhere + call BD_InitShpDerJaco(gll_nodes, p) + + ! **** primary function being tested ***** + call BD_QuadraturePointDataAt0(p) + + testname = "5 node, 1 element, 1 qp, curved: BD_DisplacementQPAt0: rrN0" + call check_array(error, baseline_rrN0(:, :, 1), p%rrN0(:, :, 1), testname, tolerance); if (allocated(error)) return + + ! Test uu0; only one quadrature point for now + testname = "5 node, 1 element, 1 qp, curved: BD_DisplacementQPAt0: uu0" + do idx_qp = 1, p%nqp + call check_array(error, baseline_uu0(:, idx_qp, 1), p%uu0(:, idx_qp, 1), testname, tolerance); if (allocated(error)) return + end do + + ! Test E10; only one quadrature point for now + testname = "5 node, 1 element, 1 qp, curved: BD_DisplacementQPAt0: E10" + do idx_qp = 1, p%nqp + call check_array(error, baseline_E10(:, idx_qp, 1), p%E10(:, idx_qp, 1), testname, tolerance); if (allocated(error)) return + end do + + ! Now test "displacement" components at quadrature points by testing the three subroutine calls + ! in BD_QuadraturePointData: BD_DisplacementQP, BD_RotationalInterpQP, BD_StifAtDeformedQP + + x = simpleContinuousStateType(nodes_per_elem, nodes_per_elem, elem_total) + m = simpleMiscVarType(nqp, p%dof_node, elem_total, nodes_per_elem) + + x%q(1:3, 1) = [0., 0., 0.] + x%q(4:6, 1) = [0., 0., 0.] + + x%q(1:3, 2) = [0.02981602178886858, -0.02466759494943021, 0.030845707156756254] + x%q(4:6, 2) = [0.0029816021788868583, 0.034534632929202294, 0.000514842683943837] + + x%q(1:3, 3) = [0.25, -0.125, 0.275] + x%q(4:6, 3) = [0.025, 0.1, 0.0125] + + x%q(1:3, 4) = [0.6844696924968456, -0.11818954790771263, 0.7977257214146722] + x%q(4:6, 4) = [0.06844696924968456, 0.16546536707079773, 0.0566280144589133] + + x%q(1:3, 5) = [1., 0., 1.2] + x%q(4:6, 5) = [0.1, 0.2, 0.1] + + idx_qp = 1 + nelem = 1 + baseline_uuu(1:3, idx_qp, nelem) = [0.42250000000000015, -0.14787500000000003, 0.4774250000000001] + baseline_uuu(4:6, idx_qp, nelem) = [0.042250000000000024, 0.1300000000000001, 0.02746250000000002] + baseline_uup(1:3, idx_qp, nelem) = [0.23717727987485349, -0.005929431996871376, 0.2834268494504499] + baseline_E1(1:3, idx_qp, nelem) = [0.01384921969632566, 0.33901907914467033, 1.1950929627825897] + + call BD_DisplacementQP(nelem, p, x, m) + + do idx_qp = 1, p%nqp + testname = "5 node, 1 element, 1 qp, curved: BD_DisplacementQP: uuu" + call check_array(error, baseline_uuu(1:3, idx_qp, 1), m%qp%uuu(1:3, idx_qp, 1), testname, tolerance); if (allocated(error)) return + testname = "5 node, 1 element, 1 qp, curved: BD_DisplacementQP: uup" + call check_array(error, baseline_uup(1:3, idx_qp, 1), m%qp%uup(1:3, idx_qp, 1), testname, tolerance); if (allocated(error)) return + testname = "5 node, 1 element, 1 qp, curved: BD_DisplacementQP: E1" + call check_array(error, baseline_E1(1:3, idx_qp, 1), m%qp%E1(1:3, idx_qp, 1), testname, tolerance); if (allocated(error)) return + end do + + ! because x%q(4:6,1)=(0.,0.,0.) we don't have to rotate xq to get Nrrrr + baseline_Nrrr(1:3, 1, nelem) = x%q(4:6, 1) + baseline_Nrrr(1:3, 2, nelem) = x%q(4:6, 2) + baseline_Nrrr(1:3, 3, nelem) = x%q(4:6, 3) + baseline_Nrrr(1:3, 4, nelem) = x%q(4:6, 4) + baseline_Nrrr(1:3, 5, nelem) = x%q(4:6, 5) + + baseline_kappa(1:3, 1, 1) = [0.024664714695954715, 0.036297077098213545, 0.02229356260962948] + + baseline_RR0(1, 1:3, 1, nelem) = [0.7967507798136657, -0.5939809735620473, -0.11124206898740374] + baseline_RR0(2, 1:3, 1, nelem) = [0.5966254150993577, 0.7439195402109748, 0.3010346022466711] + baseline_RR0(3, 1:3, 1, nelem) = [-0.09605367730511442, -0.30621939967705303, 0.9471026186942948] + + call BD_RotationalInterpQP(nelem, p, x, m) + + testname = "5 node, 1 element, 1 qp, curved: BD_RotationalInterpQP: m%Nrrr(1:3)" + do idx_node = 1, nodes_per_elem + call check_array(error, baseline_Nrrr(1:3, idx_node, 1), m%Nrrr(1:3, idx_node, 1), testname, tolerance); if (allocated(error)) return + end do + + do idx_qp = 1, p%nqp + testname = "5 node, 1 element, 1 qp, curved: BD_RotationalInterpQP: m%qp%uuu(4:6)" + call check_array(error, baseline_uuu(4:6, idx_qp, 1), m%qp%uuu(4:6, idx_qp, 1), testname, tolerance); if (allocated(error)) return + testname = "5 node, 1 element, 1 qp, curved: BD_RotationalInterpQP: m%qp%kappa" + call check_array(error, baseline_kappa(1:3, idx_qp, 1), m%qp%kappa(1:3, idx_qp, 1), testname, tolerance); if (allocated(error)) return + testname = "5 node, 1 element, 1 qp, curved: BD_RotationalInterpQP: m%qp%RR0" + call check_array(error, baseline_RR0(1:3, 1:3, idx_qp, 1), m%qp%RR0(1:3, 1:3, idx_qp, 1), testname, tolerance); if (allocated(error)) return + end do + + idx_qp = 1 + nelem = 1 + do i = 1, 6 + do j = 1, 6 + p%Stif0_QP(i, j, idx_qp) = float(i * j) * 10.+float(i) * 10. ! rather randomly chosen way to fully populate p%Stif0_QP + end do + end do + ! the following should be the result from MATMUL(tempR6,MATMUL(p%Stif0_QP(1:6,1:6,temp_id2+idx_qp),TRANSPOSE(tempR6))) + baseline_Stif(1, 1:6, idx_qp, nelem) = [4.5918231909187375, -33.558422946165074, -19.41124878362651, 2.60126686515566, -69.25969416961556, -31.26026770547517] + baseline_Stif(2, 1:6, idx_qp, nelem) = [-18.923545538732206, 138.2989541247406, 79.99647091096304, -10.720184539884109, 285.4288856786646, 128.8279349796045] + baseline_Stif(3, 1:6, idx_qp, nelem) = [-13.509458152867301, 98.7311774904666, 57.109222684340786, -7.65310518243836, 203.76676129761876, 91.96984745617996] + baseline_Stif(4, 1:6, idx_qp, nelem) = [2.852586665816869, -20.847560074045475, -12.058885358769254, 1.6159897420374438, -43.026325677681456, -19.419872917332995] + baseline_Stif(5, 1:6, idx_qp, nelem) = [-50.11731488891121, 366.27238899233606, 211.8634858589486, -28.39144827024861, 755.9328304872744, 341.18924335009] + baseline_Stif(6, 1:6, idx_qp, nelem) = [-23.86246662028767, 174.39407269994138, 100.87502434184734, -13.518082286573822, 359.9239499295936, 162.45117977068867] + + call BD_StifAtDeformedQP(nelem, p, m) + + do idx_qp = 1, p%nqp + testname = "5 node, 1 element, 1 qp, curved: BD_StifAtDeformedQP: m%qp%Stif" + call check_array(error, baseline_Stif(1:6, 1:6, idx_qp, 1), m%qp%Stif(1:6, 1:6, idx_qp, 1), testname, 10.0_DbKi * tolerance); if (allocated(error)) return + end do + + call BD_DestroyParam(p, ErrStat, ErrMsg) + call BD_DestroyMisc(m, ErrStat, ErrMsg) + call BD_DestroyContState(x, ErrStat, ErrMsg) + +end subroutine + end module diff --git a/modules/beamdyn/tests/test_BD_ShapeFuncs.F90 b/modules/beamdyn/tests/test_BD_ShapeFuncs.F90 new file mode 100644 index 0000000000..0e56302615 --- /dev/null +++ b/modules/beamdyn/tests/test_BD_ShapeFuncs.F90 @@ -0,0 +1,375 @@ +module test_BD_ShapeFuncs + +use BeamDyn +use test_tools +use BeamDyn_Subs + +implicit none + +private +public :: test_BD_ShapeFuncs_suite + +contains + +!> Collect all exported unit tests +subroutine test_BD_ShapeFuncs_suite(testsuite) + type(unittest_type), allocatable, intent(out) :: testsuite(:) + testsuite = [ & + new_unittest("test_BD_GenerateGLL", test_BD_GenerateGLL), & + new_unittest("test_BD_GaussPointWeight", test_BD_GaussPointWeight), & + new_unittest("test_BD_InitShpDerJaco_5node", test_BD_InitShpDerJaco_5node) & + ] +end subroutine + +subroutine test_BD_GenerateGLL(error) + type(error_type), allocatable, intent(out) :: error + + ! test branches + ! - p = 2, boundaries only + ! - p = 5, odd number + ! - p = 6, even number + ! - p = 97, large, prime number + + integer :: p + real(BDKi), allocatable :: gll_nodes(:), baseline(:) + integer(IntKi) :: ErrStat + character :: ErrMsg + character(1024) :: testname + + ! the baseline solutions for this unit test can be calculated using the Gauss-Lobatto quadrature + ! this website provides the nodes and weights: + ! http://keisan.casio.com/exec/system/1280801905 + + + ! -------------------------------------------------------------------------- + testname = "p = 2, boundaries only:" + p = 2 + allocate(baseline(p)) + baseline = [ -1.0, 1.0 ] + + call AllocAry(gll_nodes, p, "GLL points array", ErrStat, ErrMsg) + call BD_GenerateGLL(p, gll_nodes, ErrStat, ErrMsg) + + call check_array(error, baseline, gll_nodes, testname, tolerance); if (allocated(error)) return + + deallocate(baseline) + deallocate(gll_nodes) + + ! -------------------------------------------------------------------------- + testname = "p = 5, odd number:" + p = 5 + allocate(baseline(p)) + baseline = [ -1.0, -0.6546536707079771437983, 0.0, 0.654653670707977143798, 1.0 ] + + call AllocAry(gll_nodes, p, "GLL points array", ErrStat, ErrMsg) + call BD_GenerateGLL(p, gll_nodes, ErrStat, ErrMsg) + + call check_array(error, baseline, gll_nodes, testname, tolerance); if (allocated(error)) return + + deallocate(baseline) + deallocate(gll_nodes) + + + ! -------------------------------------------------------------------------- + testname = "p = 6, even number:" + p = 6 + allocate(baseline(p)) + baseline = [ -1.0, -0.765055323929464692851, -0.2852315164806450963142, 0.2852315164806450963142, 0.765055323929464692851, 1.0 ] + + call AllocAry(gll_nodes, p, "GLL points array", ErrStat, ErrMsg) + call BD_GenerateGLL(p, gll_nodes, ErrStat, ErrMsg) + + call check_array(error, baseline, gll_nodes, testname, tolerance); if (allocated(error)) return + + deallocate(baseline) + deallocate(gll_nodes) + + + ! -------------------------------------------------------------------------- + testname = "p = 97, large, prime number:" + p = 97 + allocate(baseline(p)) + baseline = [ & + -1.0, -0.9992117675187679372925, -0.997358420211575308381, -0.994447829238317218534, & + -0.9904833045655763827779, -0.9854690874505481580336, -0.9794105031099910659294, -0.972313976393383949863, & + -0.964187029755659609253, -0.955038276712134050045, -0.944877413224633009627, -0.933715207638498109806, & + -0.921563489367936527388, -0.9084351364079280548151, -0.8943440617122115723236, -0.8793051984632038831786,& + -0.8633344842547974738284, -0.8464488442074511804343, -0.8286661730348553921423, -0.810005316081936147328, & + -0.7904860493547251817926, -0.7701290585635136140501, -0.748955917201652598455, -0.7269890636833281333, & + -0.704251777564599720681, -0.6807681548729427782946, -0.6565630825714660926978, -0.631662212184884059709, & + -0.6060919326152061877601, -0.579879342175961313997, -0.553052219874599625586, -0.5256389959735105979894,& + -0.4976687218608582506373, -0.4691710392631656985371, -0.440176148832277959663, -0.4107147781399945491769,& + -0.3808181491142908001982, -0.350517944951638397684, -0.3198462765404906463777, -0.2888356484315159109028,& + -0.257518924390642905356, -0.2259292925714235538959, -0.1941002303436225183436, -0.1620654688153067619161,& + -0.1298589570860333006308, -0.09751482626901823919031, -0.0650673533204149925476, -0.032550924714033997197, & + 0.0, 0.032550924714033997197, 0.0650673533204149925476, 0.0975148262690182391903,& + 0.1298589570860333006308, 0.1620654688153067619161, 0.194100230343622518344, 0.225929292571423553896, & + 0.257518924390642905356, 0.2888356484315159109028, 0.3198462765404906463777, 0.3505179449516383976839,& + 0.3808181491142908001982, 0.410714778139994549177, 0.4401761488322779596629, 0.4691710392631656985371,& + 0.4976687218608582506373, 0.5256389959735105979894, 0.5530522198745996255862, 0.579879342175961313997, & + 0.6060919326152061877601, 0.6316622121848840597089, 0.6565630825714660926978, 0.6807681548729427782946,& + 0.7042517775645997206813, 0.7269890636833281332999, 0.7489559172016525984547, 0.7701290585635136140501,& + 0.7904860493547251817926, 0.8100053160819361473279, 0.8286661730348553921423, 0.8464488442074511804343,& + 0.8633344842547974738284, 0.8793051984632038831786, 0.8943440617122115723236, 0.9084351364079280548151,& + 0.9215634893679365273879, 0.933715207638498109806, 0.9448774132246330096275, 0.955038276712134050045, & + 0.9641870297556596092534, 0.9723139763933839498625, 0.9794105031099910659294, 0.9854690874505481580336,& + 0.9904833045655763827779, 0.9944478292383172185338, 0.9973584202115753083808, 0.9992117675187679372925,& + 1.0 ] + + call AllocAry(gll_nodes, p, "GLL points array", ErrStat, ErrMsg) + call BD_GenerateGLL(p, gll_nodes, ErrStat, ErrMsg) + + call check_array(error, baseline, gll_nodes, testname, tolerance); if (allocated(error)) return + + deallocate(baseline) + deallocate(gll_nodes) + + end subroutine + +subroutine test_BD_GaussPointWeight(error) + type(error_type), allocatable, intent(out) :: error + + ! test branches + ! - p = 1, invalid value + ! - p = 2, boundaries only + ! - p = 5, odd number + ! - p = 6, even number + ! - p = 97, large, prime number + + integer :: p + real(BDKi), allocatable :: locations(:), weights(:) + real(BDKi), allocatable :: baselinelocations(:), baselineweights(:) + integer(IntKi) :: ErrStat + character :: ErrMsg + character(1024) :: testname + real(BDKi), parameter :: tolerance = 1e-10 + + ! the baseline solutions for this unit test can be calculated using the Gauss-Lobatto quadrature + ! the Python Numpy package provides this functionality with numpy.polynomial.legendre.leggauss. + ! the first array returned are locations and the second are the weights + ! >>> from numpy import polynomial + ! >>> polynomial.legendre.leggauss(2) + ! (array([-0.57735027, 0.57735027]), array([ 1., 1.])) + ! >>> polynomial.legendre.leggauss(5) + ! (array([-0.90617985, -0.53846931, 0. , 0.53846931, 0.90617985]), array([ 0.23692689, 0.47862867, 0.56888889, 0.47862867, 0.23692689])) + + ! -------------------------------------------------------------------------- + testname = "p = 1, invalid value:" + p = 1 + call AllocAry(baselinelocations, p, "GLL baseline", ErrStat, ErrMsg) + call AllocAry(baselineweights, p, "GLL baseline", ErrStat, ErrMsg) + baselinelocations = [-0.57735026919, 0.57735026919] + baselineweights = [1.0, 1.0] + + call AllocAry(locations, p, "GLL nodes", ErrStat, ErrMsg) + call AllocAry(weights, p, "GLL weights", ErrStat, ErrMsg) + call BD_GaussPointWeight(p, locations, weights, ErrStat, ErrMsg) + + call check(error, 4, ErrStat, testname); if (allocated(error)) return + + deallocate (baselinelocations) + deallocate (baselineweights) + deallocate (locations) + deallocate (weights) + + ! -------------------------------------------------------------------------- + testname = "p = 2, boundaries only:" + p = 2 + call AllocAry(baselinelocations, p, "GLL baseline", ErrStat, ErrMsg) + call AllocAry(baselineweights, p, "GLL baseline", ErrStat, ErrMsg) + baselinelocations = [-0.57735026919, 0.57735026919] + baselineweights = [1.0, 1.0] + + call AllocAry(locations, p, "GLL nodes", ErrStat, ErrMsg) + call AllocAry(weights, p, "GLL weights", ErrStat, ErrMsg) + call BD_GaussPointWeight(p, locations, weights, ErrStat, ErrMsg) + + call check_array(error, baselinelocations, locations, testname, tolerance); if (allocated(error)) return + call check_array(error, baselineweights, weights, testname, tolerance); if (allocated(error)) return + + deallocate (baselinelocations) + deallocate (baselineweights) + deallocate (locations) + deallocate (weights) + + ! -------------------------------------------------------------------------- + testname = "p = 5, odd number:" + p = 5 + call AllocAry(baselinelocations, p, "GLL baseline", ErrStat, ErrMsg) + call AllocAry(baselineweights, p, "GLL baseline", ErrStat, ErrMsg) + baselinelocations = [-0.906179845939, -0.538469310106, 0.0, 0.538469310106, 0.906179845939] + baselineweights = [0.236926885056, 0.478628670499, 0.568888888889, 0.478628670499, 0.236926885056] + + call AllocAry(locations, p, "GLL nodes", ErrStat, ErrMsg) + call AllocAry(weights, p, "GLL weights", ErrStat, ErrMsg) + call BD_GaussPointWeight(p, locations, weights, ErrStat, ErrMsg) + + call check_array(error, baselinelocations, locations, testname, tolerance); if (allocated(error)) return + call check_array(error, baselineweights, weights, testname, tolerance); if (allocated(error)) return + + deallocate (baselinelocations) + deallocate (baselineweights) + deallocate (locations) + deallocate (weights) + + ! -------------------------------------------------------------------------- + testname = "p = 6, even number:" + p = 6 + call AllocAry(baselinelocations, p, "GLL baseline", ErrStat, ErrMsg) + call AllocAry(baselineweights, p, "GLL baseline", ErrStat, ErrMsg) + baselinelocations = [-0.932469514203, -0.661209386466, -0.238619186083, 0.238619186083, 0.661209386466, 0.932469514203] + baselineweights = [0.171324492379, 0.360761573048, 0.467913934573, 0.467913934573, 0.360761573048, 0.171324492379] + + call AllocAry(locations, p, "GLL nodes", ErrStat, ErrMsg) + call AllocAry(weights, p, "GLL weights", ErrStat, ErrMsg) + call BD_GaussPointWeight(p, locations, weights, ErrStat, ErrMsg) + + call check_array(error, baselinelocations, locations, testname, tolerance); if (allocated(error)) return + call check_array(error, baselineweights, weights, testname, tolerance); if (allocated(error)) return + + deallocate (baselinelocations) + deallocate (baselineweights) + deallocate (locations) + deallocate (weights) + +end subroutine + +subroutine test_BD_InitShpDerJaco_5node(error) + type(error_type), allocatable, intent(out) :: error + + ! branches to test + ! - 5 node, 1 element; undeformed + + integer(IntKi) :: i, j, idx_qp, nelem + type(BD_ParameterType) :: p + real(BDKi), allocatable :: gll_nodes(:), inp_QPtWeight(:) + real(BDKi), allocatable :: baseline_QPtWeight(:), baseline_QPtN(:) + real(BDKi), allocatable :: baseline_Shp(:,:), baseline_ShpDer(:,:), baseline_jacobian(:,:), baseline_QPtw_ShpDer(:,:) + real(BDKi), allocatable :: baseline_QPtw_Shp_ShpDer(:,:,:), baseline_QPtw_Shp_Jac(:,:,:) + real(BDKi), allocatable :: baseline_QPtw_Shp_Shp_Jac(:,:,:,:), baseline_QPtw_ShpDer_ShpDer_Jac(:,:,:,:) + integer(IntKi) :: ErrStat + character :: ErrMsg + character(1024) :: testname + real(BDKi), parameter :: tolerance = 1e-13 + + ! -------------------------------------------------------------------------- + testname = "5 node, 1 element, curved:" + + ! Let's use Gauss_Legendre Quadrature, which should be exact for intended polynomial test case + p = simpleparametertype(1,5,5,0,1) + + ! Allocate memory for baseline results + call AllocAry(baseline_Shp , p%nodes_per_elem, p%nqp, 'Reference Shp' , ErrStat, ErrMsg) + call AllocAry(baseline_ShpDer , p%nodes_per_elem, p%nqp, 'Reference ShpDer' , ErrStat, ErrMsg) + call AllocAry(baseline_Jacobian , p%nqp, p%elem_total, 'Reference Jacobian', ErrStat, ErrMsg) + call AllocAry(baseline_QPtN , p%nqp, 'Reference QPtN' , ErrStat, ErrMsg) + call AllocAry(baseline_QPtWeight, p%nqp, 'Reference QPtWeight', ErrStat, ErrMsg) + + ! Allocate memory for other relevant variables belonging to module p + call AllocAry(baseline_QPtw_Shp_Shp_Jac , p%nqp, p%nodes_per_elem, p%nodes_per_elem, p%elem_total, 'reference QPtw_Shp_Shp_Jac' , ErrStat, ErrMsg) + call AllocAry(baseline_QPtw_ShpDer_ShpDer_Jac, p%nqp, p%nodes_per_elem, p%nodes_per_elem, p%elem_total, 'reference baseline_QPtw_ShpDer_ShpDer_Jac', ErrStat, ErrMsg) + call AllocAry(baseline_QPtw_Shp_ShpDer , p%nqp, p%nodes_per_elem, p%nodes_per_elem , 'reference QPtw_Shp_ShpDer' , ErrStat, ErrMsg) + call AllocAry(baseline_QPtw_Shp_Jac , p%nqp, p%nodes_per_elem, p%elem_total , 'reference QPtw_Shp_Jac' , ErrStat, ErrMsg) + call AllocAry(baseline_QPtw_ShpDer , p%nqp, p%nodes_per_elem , 'reference QPtw_ShpDer' , ErrStat, ErrMsg) + + ! assign baseline results + ! baseline quadrature points and weights; this is 5-point Gauss-Legendre quadrature + + baseline_QPtN(1:p%nqp) = [ -0.9061798459386640, -0.5384693101056831, 0. , 0.5384693101056831, 0.9061798459386640 ] + baseline_QPtWeight(1:p%nqp) = [ 0.2369268850561891, 0.4786286704993665, 0.5688888888888889, 0.4786286704993665, 0.2369268850561891 ] + + ! assign baseline jacobian based; these values were calculated in separte mathematica script + baseline_jacobian(1:p%nqp,1) = [ 0.6715870058501458, 1.509599209717604, 2.861380785564901, 4.097191592895223, 4.880926263217582 ] + + ! assign baseline shape functions based on example as described above + baseline_Shp(1,1:p%nqp) = [ 0.5933706960199465, -0.10048256880508302, 0., 0.030144110771879763, -0.029205077492916114 ] + baseline_Shp(2,1:p%nqp) = [ 0.516435198649618, 0.9313661019373962, 0., -0.09069490469997694, 0.08322282221996001 ] + baseline_Shp(3,1:p%nqp) = [ -0.16382363939660807, 0.22966726079578503, 1., 0.22966726079578503, -0.16382363939660807 ] + baseline_Shp(4,1:p%nqp) = [ 0.08322282221996001, -0.09069490469997694, 0., 0.9313661019373962, 0.516435198649618 ] + baseline_Shp(5,1:p%nqp) = [ -0.029205077492916114, 0.030144110771879763, 0., -0.10048256880508302, 0.5933706960199465 ] + + ! assign baseline shape function derivatives based on example as described above + baseline_ShpDer(1,1:p%nqp) = [ -3.705336453591454, -0.5287152679802739, 0.375, -0.24351802112960028, 0.14423640936799356 ] + baseline_ShpDer(2,1:p%nqp) = [ 4.33282116876393, -1.0976579678283382, -1.3365845776954537, 0.7497385700132875, -0.42067623042767965 ] + baseline_ShpDer(3,1:p%nqp) = [ -0.9039245362321631, 2.1325937846922898, 0., -2.1325937846922898, 0.9039245362321631 ] + baseline_ShpDer(4,1:p%nqp) = [ 0.42067623042767965, -0.7497385700132875, 1.3365845776954537, 1.0976579678283382, -4.33282116876393 ] + baseline_ShpDer(5,1:p%nqp) = [ -0.14423640936799356, 0.24351802112960028, -0.375, 0.5287152679802739, 3.705336453591454 ] + + ! uuN0 is of dimension (3 dof, nodes_per_elem, elem_total) + p%uuN0(1:3,1,1) = [ 0.0, 0.0, 0.0 ] + p%uuN0(1:3,2,1) = [ 0.16237631096713473, 0.17578464768961147, 0.1481911137890286 ] + p%uuN0(1:3,3,1) = [ 0.25, 1., 1.1875 ] + p%uuN0(1:3,4,1) = [ -0.30523345382427747, 2.4670724951675314, 2.953849702537502 ] + p%uuN0(1:3,5,1) = [ -1., 3.5, 4. ] + + ! Using BD_GaussPointWeight; hoping it's tested! + call BD_GaussPointWeight(p%nqp, p%QPtN, p%QPtWeight, ErrStat, ErrMsg) + + call check_array(error, baseline_QPtN, p%QPtN , testname, tolerance); if (allocated(error)) return + call check_array(error, baseline_QPtWeight, p%QPtWeight, testname, tolerance); if (allocated(error)) return + + ! Allocate memory for GLL node positions in 1D parametric space + call AllocAry(gll_nodes, p%nodes_per_elem, "GLL points array", ErrStat, ErrMsg) + gll_nodes = [ -1., -0.6546536707079771, 0., 0.6546536707079771, 1. ] + + ! call the test subroutine + call BD_InitShpDerJaco(gll_nodes, p) + + ! check the baseline shape functions and their derivatives + call check_array(error, baseline_Shp , p%Shp , testname, tolerance); if (allocated(error)) return + call check_array(error, baseline_ShpDer, p%ShpDer, testname, tolerance); if (allocated(error)) return + + ! check the baseline jacobian + call check_array(error, baseline_jacobian, p%jacobian, testname, tolerance); if (allocated(error)) return + + + ! Test and assemble variables N*N^T*wt*Jacobian and dN*dN^T*wt/Jacobian + do nelem = 1, p%elem_total + do idx_qp = 1, p%nqp + do j = 1, p%nodes_per_elem + do i = 1, p%nodes_per_elem + ! Check the variable N*N^T*Jacobian + baseline_QPtw_Shp_Shp_Jac(idx_qp,i,j,nelem) = baseline_Shp(i,idx_qp)*baseline_Shp(j,idx_qp)*baseline_QPtWeight(idx_qp)*baseline_jacobian(idx_qp,nelem) + + ! Check the variable dN*dN^T*Jacobian + baseline_QPtw_ShpDer_ShpDer_Jac(idx_qp,i,j,nelem) = baseline_ShpDer(i,idx_qp)*baseline_ShpDer(j,idx_qp)*baseline_QPtWeight(idx_qp)/baseline_jacobian(idx_qp,nelem) + end do + end do + end do + end do + call check_array(error, baseline_QPtw_Shp_Shp_Jac, p%QPtw_Shp_Shp_Jac, testname, tolerance); if (allocated(error)) return + call check_array(error, baseline_QPtw_ShpDer_ShpDer_Jac, p%QPtw_ShpDer_ShpDer_Jac, testname, tolerance); if (allocated(error)) return + + ! Test and assemble variable N*dN^T*wt*Jacobian + do idx_qp = 1, p%nqp + do j = 1, p%nodes_per_elem + do i = 1, p%nodes_per_elem + baseline_QPtw_Shp_ShpDer(idx_qp,i,j) = baseline_Shp(i,idx_qp)*baseline_ShpDer(j,idx_qp)*baseline_QPtWeight(idx_qp) + end do + end do + end do + call check_array(error, baseline_QPtw_Shp_ShpDer, p%QPtw_Shp_ShpDer, testname, tolerance); if (allocated(error)) return + + ! Test and assemble variable N*wt*Jacobian + do nelem = 1, p%elem_total + do i = 1, p%nodes_per_elem + do idx_qp = 1, p%nqp + baseline_QPtw_Shp_Jac(idx_qp,i,nelem) = baseline_Shp(i,idx_qp)*baseline_QPtWeight(idx_qp)*baseline_Jacobian(idx_qp,nelem) + end do + end do + end do + call check_array(error, baseline_QPtw_Shp_Jac, p%QPtw_Shp_Jac, testname, tolerance); if (allocated(error)) return + + ! Test and assemble variable dN*wt. + do i = 1, p%nodes_per_elem + do idx_qp = 1, p%nqp + baseline_QPtw_ShpDer(idx_qp,i) = baseline_ShpDer(i,idx_qp)*baseline_QPtWeight(idx_qp) + end do + end do + call check_array(error, baseline_QPtw_ShpDer, p%QPtw_ShpDer, testname, tolerance); if (allocated(error)) return + + call BD_DestroyParam(p, ErrStat, ErrMsg) + +end subroutine + +end module diff --git a/modules/beamdyn/tests/test_BD_TrapezoidalPointWeight.F90 b/modules/beamdyn/tests/test_BD_TrapezoidalPointWeight.F90 index 0ca075ad1a..c8398f5b82 100644 --- a/modules/beamdyn/tests/test_BD_TrapezoidalPointWeight.F90 +++ b/modules/beamdyn/tests/test_BD_TrapezoidalPointWeight.F90 @@ -1,113 +1,125 @@ module test_BD_TrapezoidalPointWeight - - use pFUnit_mod - use BeamDyn - use NWTC_Num - use test_tools - - implicit none - - type(BD_ParameterType) :: p - - integer(IntKi) :: nqp - integer(IntKi) :: refine - integer(IntKi) :: station_total - real(BDKi), allocatable :: station_eta(:) - real(BDKi), allocatable :: baseline_QPtN(:) - real(BDKi), allocatable :: baseline_QPtW(:) - - integer(IntKi) :: ErrStat - character :: ErrMsg - character(1024) :: testname - real(BDKi) :: tolerance + +use test_tools +use BeamDyn + +implicit none + +private +public :: test_BD_TrapezoidalPointWeight_suite contains - @test - subroutine test_BD_TrapezoidalPointWeight_2station() - - ! initialize NWTC_Num constants - call SetConstants() - - tolerance = 1e-14 - - ! -------------------------------------------------------------------------- - testname = "test_BD_TrapezoidalPointWeight_2station_8refine" +!> Collect all exported unit tests +subroutine test_BD_TrapezoidalPointWeight_suite(testsuite) + type(unittest_type), allocatable, intent(out) :: testsuite(:) + testsuite = [ & + new_unittest("test_BD_TrapezoidalPointWeight_2station", test_BD_TrapezoidalPointWeight_2station), & + new_unittest("test_BD_TrapezoidalPointWeight_3station", test_BD_TrapezoidalPointWeight_3station) & + ] +end subroutine + +subroutine test_BD_TrapezoidalPointWeight_2station(error) + type(error_type), allocatable, intent(out) :: error + + type(BD_ParameterType) :: p + + integer(IntKi) :: nqp + integer(IntKi) :: refine + integer(IntKi) :: station_total + real(BDKi), allocatable :: station_eta(:) + real(BDKi), allocatable :: baseline_QPtN(:) + real(BDKi), allocatable :: baseline_QPtW(:) + + integer(IntKi) :: ErrStat + character :: ErrMsg + character(1024) :: testname + + ! -------------------------------------------------------------------------- + testname = "test_BD_TrapezoidalPointWeight_2station_8refine" + + station_total = 2 + + call AllocAry(station_eta, station_total, "station_eta", ErrStat, ErrMsg) + + ! simple case where we have enpoints only; typical with constant cross sections + station_eta(1:station_total) = (/0., 1./) + + refine = 8 + + nqp = (station_total - 1) * refine + 1 + + p = simpleParameterType(1, 1, nqp, 0, refine) + + call AllocAry(baseline_QPtN, nqp, "baseline_QPtN", ErrStat, ErrMsg) + call AllocAry(baseline_QPtW, nqp, "baseline_QPtW", ErrStat, ErrMsg) + + baseline_QPtN(1:nqp) = (/-1., -0.75, -0.5, -0.25, 0., 0.25, 0.5, 0.75, 1./) + baseline_QPtW(1:nqp) = (/0.125, 0.25, 0.25, 0.25, 0.25, 0.25, 0.25, 0.25, 0.125/) + + call BD_TrapezoidalPointWeight(p, station_eta, station_total) + + call check_array(error, baseline_QPtN, p%QPtN, testname, thr=tolerance); if (allocated(error)) return + call check_array(error, baseline_QPtW, p%QPtWeight, testname, thr=tolerance); if (allocated(error)) return - station_total = 2 + deallocate (station_eta) + deallocate (baseline_QPtN) + deallocate (baseline_QPtW) - call AllocAry(station_eta, station_total, "station_eta", ErrStat, ErrMsg) + call BD_DestroyParam(p, ErrStat, ErrMsg) - ! simple case where we have enpoints only; typical with constant cross sections - station_eta(1:station_total) = (/0., 1./) +end subroutine - refine = 8 +subroutine test_BD_TrapezoidalPointWeight_3station(error) + type(error_type), allocatable, intent(out) :: error - nqp = (station_total - 1)*refine + 1 + type(BD_ParameterType) :: p - p=simpleParameterType(1,1,nqp,0,refine) + integer(IntKi) :: nqp + integer(IntKi) :: refine + integer(IntKi) :: station_total + real(BDKi), allocatable :: station_eta(:) + real(BDKi), allocatable :: baseline_QPtN(:) + real(BDKi), allocatable :: baseline_QPtW(:) - call AllocAry(baseline_QPtN, nqp, "baseline_QPtN", ErrStat, ErrMsg) - call AllocAry(baseline_QPtW, nqp, "baseline_QPtW", ErrStat, ErrMsg) - - baseline_QPtN(1:nqp) = (/ -1., -0.75, -0.5, -0.25, 0., 0.25, 0.5, 0.75, 1. /) - baseline_QPtW(1:nqp) = (/ 0.125, 0.25, 0.25, 0.25, 0.25, 0.25, 0.25, 0.25, 0.125 /) + integer(IntKi) :: ErrStat + character :: ErrMsg + character(1024) :: testname - call BD_TrapezoidalPointWeight(p, station_eta, station_total) - - @assertEqual(baseline_QPtN, p%QPtN, tolerance, testname) - @assertEqual(baseline_QPtW, p%QPtWeight, tolerance, testname) - - deallocate(station_eta) - deallocate(baseline_QPtN) - deallocate(baseline_QPtW) + ! -------------------------------------------------------------------------- + testname = "test_BD_TrapezoidalPointWeight_3station_2refine" - call BD_DestroyParam(p, ErrStat, ErrMsg) + ! provide three stations, unequally distributed + ! refine by factor of two - end subroutine + station_total = 3 - @test - subroutine test_BD_TrapezoidalPointWeight_3station() - - ! initialize NWTC_Num constants - call SetConstants() - - tolerance = 1e-14 - - ! -------------------------------------------------------------------------- - testname = "test_BD_TrapezoidalPointWeight_3station_2refine" + call AllocAry(station_eta, station_total, "station_eta", ErrStat, ErrMsg) - ! provide three stations, unequally distributed - ! refine by factor of two + station_eta(1:station_total) = (/0., 0.25, 1./) - station_total = 3 + refine = 2 - call AllocAry(station_eta, station_total, "station_eta", ErrStat, ErrMsg) + nqp = (station_total - 1) * refine + 1 - station_eta(1:station_total) = (/0., 0.25, 1./) + p = simpleParameterType(1, 1, nqp, 0, refine) - refine = 2 + call AllocAry(baseline_QPtN, nqp, "baseline_QPtN", ErrStat, ErrMsg) + call AllocAry(baseline_QPtW, nqp, "baseline_QPtW", ErrStat, ErrMsg) - nqp = (station_total - 1)*refine + 1 + baseline_QPtN(1:nqp) = (/-1., -0.75, -0.5, 0.25, 1./) + baseline_QPtW(1:nqp) = (/0.125, 0.25, 0.125 + 0.5 * 0.75, 0.75, 0.5 * 0.75/) - p=simpleParameterType(1,1,nqp,0,refine) + call BD_TrapezoidalPointWeight(p, station_eta, station_total) - call AllocAry(baseline_QPtN, nqp, "baseline_QPtN", ErrStat, ErrMsg) - call AllocAry(baseline_QPtW, nqp, "baseline_QPtW", ErrStat, ErrMsg) - - baseline_QPtN(1:nqp) = (/ -1., -0.75, -0.5, 0.25, 1. /) - baseline_QPtW(1:nqp) = (/ 0.125, 0.25, 0.125+0.5*0.75, 0.75, 0.5*0.75/) + call check_array(error, baseline_QPtN, p%QPtN, testname, thr=tolerance); if (allocated(error)) return + call check_array(error, baseline_QPtW, p%QPtWeight, testname, thr=tolerance); if (allocated(error)) return - call BD_TrapezoidalPointWeight(p, station_eta, station_total) - - @assertEqual(baseline_QPtN, p%QPtN, tolerance, testname) - @assertEqual(baseline_QPtW, p%QPtWeight, tolerance, testname) - - deallocate(station_eta) - deallocate(baseline_QPtN) - deallocate(baseline_QPtW) + deallocate (station_eta) + deallocate (baseline_QPtN) + deallocate (baseline_QPtW) - call BD_DestroyParam(p, ErrStat, ErrMsg) + call BD_DestroyParam(p, ErrStat, ErrMsg) - end subroutine +end subroutine end module diff --git a/modules/beamdyn/tests/test_BD_diffmtc.F90 b/modules/beamdyn/tests/test_BD_diffmtc.F90 index 6d3319d92e..fea488fe0a 100644 --- a/modules/beamdyn/tests/test_BD_diffmtc.F90 +++ b/modules/beamdyn/tests/test_BD_diffmtc.F90 @@ -1,163 +1,174 @@ module test_BD_diffmtc - use pFUnit_mod - use BeamDyn - use NWTC_Num - use test_tools +use BeamDyn +use NWTC_Num +use test_tools - implicit none +implicit none + +private +public :: test_BD_diffmtc_suite + +! mathematica code for calculating shape function values and derivative values +!ClearAll[p, \[Xi]j, xj, h, j, \[Xi], x, sol]; +!(* find p+1 GLL points *) +!p = 4; +!test[x_] = (1 - x^2) D[LegendreP[p, x], x]; +!\[Xi]j = Array[f, p + 1]; (* initialize list *) +!For[j = 0, j <= p, j++, +!sol = x /. FindRoot[test[x], {x, -Cos[(Pi (j))/p]}]; +! \[Xi]j[[j + 1]] = sol +!] +!h[\[Xi]_, xj_] = -(((1. - \[Xi]^2) D[ LegendreP[p, \[Xi]], \[Xi]])/( +!p (p + 1) LegendreP[p, xj] (\[Xi] - xj))); +!hd[\[Xi]_, xj_] = D[h[\[Xi], xj], \[Xi]] +!Plot[h[x, \[Xi]j[[1]]], {x, -1, 1}, PlotRange -> All] +!h[0.5, \[Xi]j[[2]]] + +contains + +!> Collect all exported unit tests +subroutine test_BD_diffmtc_suite(testsuite) + type(unittest_type), allocatable, intent(out) :: testsuite(:) + testsuite = [ & + new_unittest("test_BD_diffmtc_2node", test_BD_diffmtc_2node), & + new_unittest("test_BD_diffmtc_5node", test_BD_diffmtc_5node) & + ] + end subroutine + +subroutine test_BD_diffmtc_2node(error) + type(error_type), allocatable, intent(out) :: error + + ! branches to test + ! - 2 node, 1 element integer :: n, i type(BD_ParameterType) :: parametertype - real(BDKi), allocatable :: test_shape(:,:), test_shapederivative(:,:) - real(BDKi), allocatable :: baseline_shape(:,:), baseline_shapederivative(:,:) + real(BDKi), allocatable :: test_shape(:, :), test_shapederivative(:, :) + real(BDKi), allocatable :: baseline_shape(:, :), baseline_shapederivative(:, :) real(BDKi), allocatable :: gll_nodes(:) integer(IntKi) :: ErrStat character :: ErrMsg character(1024) :: testname - real(BDKi) :: tolerance - - ! mathematica code for calculating shape function values and derivative values - !ClearAll[p, \[Xi]j, xj, h, j, \[Xi], x, sol]; - !(* find p+1 GLL points *) - !p = 4; - !test[x_] = (1 - x^2) D[LegendreP[p, x], x]; - !\[Xi]j = Array[f, p + 1]; (* initialize list *) - !For[j = 0, j <= p, j++, - !sol = x /. FindRoot[test[x], {x, -Cos[(Pi (j))/p]}]; - ! \[Xi]j[[j + 1]] = sol - !] - !h[\[Xi]_, xj_] = -(((1. - \[Xi]^2) D[ LegendreP[p, \[Xi]], \[Xi]])/( - !p (p + 1) LegendreP[p, xj] (\[Xi] - xj))); - !hd[\[Xi]_, xj_] = D[h[\[Xi], xj], \[Xi]] - !Plot[h[x, \[Xi]j[[1]]], {x, -1, 1}, PlotRange -> All] - !h[0.5, \[Xi]j[[2]]] -contains + ! -------------------------------------------------------------------------- + testname = "2-node element: evaluate shape/shapederivative at nodes" + + ! the shape functions should be: + ! h1(-1) = 1, h1(+1) = 0 + ! h2(-1) = 0, h2(+1) = 1 + ! + ! this is satisfied by these linear equations + ! h1(s) = 0.5*(1-s) + ! h2(s) = 0.5*(1+s) + ! therefore, + ! h1 = 0.5 + ! + ! the expected result of BD_diffmtc is + ! Shp - the shape function evaluated at the GLL nodes + ! ShpDer - the shape function derivative evaluated at the GLL nodes + ! + ! shp(1,:) = 1.0, 0.0 + ! shp(2,:) = 0.0, 1.0 + ! shpder(1,:) = -0.5, -0.5 + ! shpder(2,:) = 0.5, 0.5 + + parametertype = simpleParameterType(1, 2, 2, 0, 1) + n = parametertype%nodes_per_elem - @test - subroutine test_BD_diffmtc_2node() - ! branches to test - ! - 2 node, 1 element - - ! initialize NWTC_Num constants - call SetConstants() - - tolerance = 1e-14 - - ! -------------------------------------------------------------------------- - testname = "2-node element: evaluate shape/shapederivative at nodes" - - ! the shape functions should be: - ! h1(-1) = 1, h1(+1) = 0 - ! h2(-1) = 0, h2(+1) = 1 - ! - ! this is satisfied by these linear equations - ! h1(s) = 0.5*(1-s) - ! h2(s) = 0.5*(1+s) - ! therefore, - ! h1` = -0.5 - ! h2` = 0.5 - ! - ! the expected result of BD_diffmtc is - ! Shp - the shape function evaluated at the GLL nodes - ! ShpDer - the shape function derivative evaluated at the GLL nodes - ! - ! shp(1,:) = 1.0, 0.0 - ! shp(2,:) = 0.0, 1.0 - ! shpder(1,:) = -0.5, -0.5 - ! shpder(2,:) = 0.5, 0.5 - - parametertype = simpleParameterType(1,2,2,0,1) - n = parametertype%nodes_per_elem - - call AllocAry(test_shape, parametertype%nodes_per_elem, parametertype%nqp, "test_shape", ErrStat, ErrMsg) - call AllocAry(test_shapederivative, parametertype%nodes_per_elem, parametertype%nqp, "test_shapederivative", ErrStat, ErrMsg) - - call AllocAry(parametertype%QPtN, parametertype%nodes_per_elem, 'QPtN', ErrStat, ErrMsg) - parametertype%QPtN = (/ -1.0, 1.0 /) - - call AllocAry(gll_nodes, n, "GLL points array", ErrStat, ErrMsg) - gll_nodes = (/ -1.0, 1.0 /) - - call BD_diffmtc(parametertype%nodes_per_elem, gll_nodes, parametertype%QPtN, parametertype%nqp, test_shape, test_shapederivative) - - call AllocAry(baseline_shape, parametertype%nodes_per_elem,parametertype%nqp, "baseline_shape", ErrStat, ErrMsg) - call AllocAry(baseline_shapederivative, parametertype%nodes_per_elem,parametertype%nqp, "baseline_shapederivative", ErrStat, ErrMsg) - baseline_shape(1,:) = (/ 1.0, 0.0 /) - baseline_shape(2,:) = (/ 0.0, 1.0 /) - baseline_shapederivative(1,:) = (/ -0.5, -0.5 /) - baseline_shapederivative(2,:) = (/ 0.5, 0.5 /) - - @assertEqual(baseline_shape, test_shape, tolerance, testname) - @assertEqual(baseline_shapederivative, test_shapederivative, tolerance, testname) - - deallocate(test_shape) - deallocate(test_shapederivative) - deallocate(gll_nodes) - deallocate(baseline_shape) - deallocate(baseline_shapederivative) - - call BD_DestroyParam(parametertype, ErrStat, ErrMsg) + call AllocAry(test_shape, parametertype%nodes_per_elem, parametertype%nqp, "test_shape", ErrStat, ErrMsg) + call AllocAry(test_shapederivative, parametertype%nodes_per_elem, parametertype%nqp, "test_shapederivative", ErrStat, ErrMsg) + + call AllocAry(parametertype%QPtN, parametertype%nodes_per_elem, 'QPtN', ErrStat, ErrMsg) + parametertype%QPtN = [-1.0, 1.0] + + call AllocAry(gll_nodes, n, "GLL points array", ErrStat, ErrMsg) + gll_nodes = [-1.0, 1.0] + + call BD_diffmtc(parametertype%nodes_per_elem, gll_nodes, parametertype%QPtN, parametertype%nqp, test_shape, test_shapederivative) + + call AllocAry(baseline_shape, parametertype%nodes_per_elem, parametertype%nqp, "baseline_shape", ErrStat, ErrMsg) + call AllocAry(baseline_shapederivative, parametertype%nodes_per_elem, parametertype%nqp, "baseline_shapederivative", ErrStat, ErrMsg) + baseline_shape(1, :) = [1.0, 0.0] + baseline_shape(2, :) = [0.0, 1.0] + baseline_shapederivative(1, :) = [-0.5, -0.5] + baseline_shapederivative(2, :) = [0.5, 0.5] + + call check_array(error, baseline_shape, test_shape, testname, tolerance); if (allocated(error)) return + call check_array(error, baseline_shapederivative, test_shapederivative, testname, tolerance); if (allocated(error)) return + + deallocate (test_shape) + deallocate (test_shapederivative) + deallocate (gll_nodes) + deallocate (baseline_shape) + deallocate (baseline_shapederivative) + + call BD_DestroyParam(parametertype, ErrStat, ErrMsg) + +end subroutine + +subroutine test_BD_diffmtc_5node(error) + type(error_type), allocatable, intent(out) :: error - end subroutine - - @test - subroutine test_BD_diffmtc_5node() - ! branches to test - ! - 5 node, 1 element - - ! initialize NWTC_Num constants - call SetConstants() - - tolerance = 1e-14 - - ! -------------------------------------------------------------------------- - testname = "5-node element: evaluate shape/shapederivative at nodes and at three non-node locations" - - parametertype = simpleParameterType(1,5,8,0,1) - !parametertype%nodes_per_elem = 5 - !parametertype%nqp = 8 ! testing the GLL nodes and three non-nodal locations (-0.8, 0.1, 0.4) - n = parametertype%nodes_per_elem - - call AllocAry(test_shape, parametertype%nodes_per_elem, parametertype%nqp, "test_shape", ErrStat, ErrMsg) - call AllocAry(test_shapederivative, parametertype%nodes_per_elem, parametertype%nqp, "test_shapederivative", ErrStat, ErrMsg) - - call AllocAry(parametertype%QPtN, parametertype%nodes_per_elem, 'QPtN', ErrStat, ErrMsg) - ! in following, first five points are the 4th-order GLL locations; last three points are randomly chosen off-node points - parametertype%QPtN = (/ -1.0, -0.6546536707079771, 0.0, 0.6546536707079771, 1.0, -0.8, 0.1, 0.4 /) - - call AllocAry(gll_nodes, n, "GLL points array", ErrStat, ErrMsg) - gll_nodes = (/ -1.0, -0.6546536707079771, 0.0, 0.6546536707079771, 1.0 /) - - call BD_diffmtc(parametertype%nodes_per_elem, gll_nodes, parametertype%QPtN, parametertype%nqp, test_shape, test_shapederivative) - - call AllocAry(baseline_shape, parametertype%nodes_per_elem, parametertype%nqp, "baseline_shape", ErrStat, ErrMsg) - call AllocAry(baseline_shapederivative, parametertype%nodes_per_elem, parametertype%nqp, "baseline_shapederivative", ErrStat, ErrMsg) - - ! baseline_shape and baseline_shapederivative were calculated in Mathematica for fourth order Legendre spectral FE - - baseline_shape(1,:) = (/ 1., 0., 0., 0., 0., 0.266400000000000, 0.0329625, 0.0564/) - baseline_shape(2,:) = (/ 0., 1., 0., 0., 0., 0.855336358376291, -0.1121093731918499, -0.1746924181056723/) - baseline_shape(3,:) = (/ 0., 0., 1., 0., 0., -0.1776000000000001, 0.9669, 0.5263999999999998/) - baseline_shape(4,:) = (/ 0., 0., 0., 1., 0., 0.0854636416237095, 0.1525343731918499, 0.7234924181056726/) - baseline_shape(5,:) = (/ 0., 0., 0., 0., 1., -0.0296000000000000, -0.0402875, -0.1316/) - baseline_shapederivative(1,:) = (/-5., -1.240990253030983,0.375,-0.2590097469690172,0.5,-2.497, 0.27725, -0.1210000000000001/) - baseline_shapederivative(2,:) = (/ 6.756502488724241,0.,-1.336584577695454,0.7637626158259736,-1.410164177942427,2.144324478146486,-0.896320373697923, 0.4156426862650312/) - baseline_shapederivative(3,:) = (/-2.666666666666667, 1.74574312188794,0.,-1.74574312188794,2.666666666666667,0.5546666666666656,-0.6573333333333338, -2.069333333333333/) - baseline_shapederivative(4,:) = (/ 1.410164177942427,-0.7637626158259736, 1.336584577695454,0.,-6.756502488724241,-0.31499114481315,1.696653707031257, 1.805690647068303/) - baseline_shapederivative(5,:) = (/-0.5, 0.2590097469690172,-0.375,1.240990253030983,5.,0.1129999999999999,-0.42025, -0.03099999999999978/) - - @assertEqual(baseline_shape, test_shape, tolerance, testname) - @assertEqual(baseline_shapederivative, test_shapederivative, tolerance, testname) - - deallocate(test_shape) - deallocate(test_shapederivative) - deallocate(gll_nodes) - deallocate(baseline_shape) - deallocate(baseline_shapederivative) - - call BD_DestroyParam(parametertype, ErrStat, ErrMsg) - - end subroutine + ! branches to test + ! - 5 node, 1 element + + integer :: n, i + type(BD_ParameterType) :: parametertype + real(BDKi), allocatable :: test_shape(:, :), test_shapederivative(:, :) + real(BDKi), allocatable :: baseline_shape(:, :), baseline_shapederivative(:, :) + real(BDKi), allocatable :: gll_nodes(:) + integer(IntKi) :: ErrStat + character :: ErrMsg + character(1024) :: testname + + ! -------------------------------------------------------------------------- + testname = "5-node element: evaluate shape/shapederivative at nodes and at three non-node locations" + + parametertype = simpleParameterType(1, 5, 8, 0, 1) + !parametertype%nodes_per_elem = 5 + !parametertype%nqp = 8 ! testing the GLL nodes and three non-nodal locations (-0.8, 0.1, 0.4) + n = parametertype%nodes_per_elem + + call AllocAry(test_shape, parametertype%nodes_per_elem, parametertype%nqp, "test_shape", ErrStat, ErrMsg) + call AllocAry(test_shapederivative, parametertype%nodes_per_elem, parametertype%nqp, "test_shapederivative", ErrStat, ErrMsg) + + call AllocAry(parametertype%QPtN, parametertype%nodes_per_elem, 'QPtN', ErrStat, ErrMsg) + ! in following, first five points are the 4th-order GLL locations; last three points are randomly chosen off-node points + parametertype%QPtN = [-1.0, -0.6546536707079771, 0.0, 0.6546536707079771, 1.0, -0.8, 0.1, 0.4] + + call AllocAry(gll_nodes, n, "GLL points array", ErrStat, ErrMsg) + gll_nodes = [-1.0, -0.6546536707079771, 0.0, 0.6546536707079771, 1.0] + + call BD_diffmtc(parametertype%nodes_per_elem, gll_nodes, parametertype%QPtN, parametertype%nqp, test_shape, test_shapederivative) + + call AllocAry(baseline_shape, parametertype%nodes_per_elem, parametertype%nqp, "baseline_shape", ErrStat, ErrMsg) + call AllocAry(baseline_shapederivative, parametertype%nodes_per_elem, parametertype%nqp, "baseline_shapederivative", ErrStat, ErrMsg) + + ! baseline_shape and baseline_shapederivative were calculated in Mathematica for fourth order Legendre spectral FE + + baseline_shape(1, :) = [1., 0., 0., 0., 0., 0.266400000000000, 0.0329625, 0.0564] + baseline_shape(2, :) = [0., 1., 0., 0., 0., 0.855336358376291, -0.1121093731918499, -0.1746924181056723] + baseline_shape(3, :) = [0., 0., 1., 0., 0., -0.1776000000000001, 0.9669, 0.5263999999999998] + baseline_shape(4, :) = [0., 0., 0., 1., 0., 0.0854636416237095, 0.1525343731918499, 0.7234924181056726] + baseline_shape(5, :) = [0., 0., 0., 0., 1., -0.0296000000000000, -0.0402875, -0.1316] + baseline_shapederivative(1, :) = [-5., -1.240990253030983, 0.375, -0.2590097469690172, 0.5, -2.497, 0.27725, -0.1210000000000001] + baseline_shapederivative(2, :) = [6.756502488724241, 0., -1.336584577695454, 0.7637626158259736, -1.410164177942427, 2.144324478146486, -0.896320373697923, 0.4156426862650312] + baseline_shapederivative(3, :) = [-2.666666666666667, 1.74574312188794, 0., -1.74574312188794, 2.666666666666667, 0.5546666666666656, -0.6573333333333338, -2.069333333333333] + baseline_shapederivative(4, :) = [1.410164177942427, -0.7637626158259736, 1.336584577695454, 0., -6.756502488724241, -0.31499114481315, 1.696653707031257, 1.805690647068303] + baseline_shapederivative(5, :) = [-0.5, 0.2590097469690172, -0.375, 1.240990253030983, 5., 0.1129999999999999, -0.42025, -0.03099999999999978] + + call check_array(error, baseline_shape, test_shape, testname, tolerance); if (allocated(error)) return + call check_array(error, baseline_shapederivative, test_shapederivative, testname, tolerance); if (allocated(error)) return + + deallocate (test_shape) + deallocate (test_shapederivative) + deallocate (gll_nodes) + deallocate (baseline_shape) + deallocate (baseline_shapederivative) + + call BD_DestroyParam(parametertype, ErrStat, ErrMsg) + +end subroutine + end module diff --git a/modules/beamdyn/tests/test_ExtractRelativeRotation.F90 b/modules/beamdyn/tests/test_ExtractRelativeRotation.F90 deleted file mode 100644 index 669d132e58..0000000000 --- a/modules/beamdyn/tests/test_ExtractRelativeRotation.F90 +++ /dev/null @@ -1,36 +0,0 @@ -@test -subroutine test_ExtractRelativeRotation() - ! this is actually an integration test not a unit test... - - use pFUnit_mod - use BeamDyn_Subs - use NWTC_Num - use test_tools - - implicit none - - real(BDKi), dimension(3) :: rr - character(1024) :: testname - real(BDKi) :: tolerance - integer(IntKi) :: ErrStat - character :: ErrMsg - - type(BD_ParameterType) :: parametertype - type(BD_OtherStateType) :: otherstate - - ! initialize NWTC_Num constants - call SetConstants() - - tolerance = 1e-14 - - - ! -------------------------------------------------------------------------- - testname = "static simple beam under gravity:" - - otherstate = simpleOtherState() - parametertype = simpleParameterType(1,16,16,0,0) - - call ExtractRelativeRotation(identity(), parametertype, otherstate, rr, ErrStat, ErrMsg) - - @assertEqual((/ 0.0, 0.0, 0.0 /), rr, tolerance, testname) -end subroutine diff --git a/modules/beamdyn/tests/test_InitializeNodalLocations.F90 b/modules/beamdyn/tests/test_InitializeNodalLocations.F90 deleted file mode 100644 index 9c488583c7..0000000000 --- a/modules/beamdyn/tests/test_InitializeNodalLocations.F90 +++ /dev/null @@ -1,134 +0,0 @@ -module test_InitializeNodalLocations - - use pFUnit_mod - use BeamDyn - use NWTC_Num - use test_tools - - implicit none - - type(BD_ParameterType) :: p - - integer(IntKi) :: i ! do loop - - integer(IntKi) :: member_total - integer(IntKi), allocatable :: kp_member(:) - real(BDKi), allocatable :: kp_coordinate(:,:) - - real(BDKi), allocatable :: baseline_uuN0(:,:,:) - real(BDKi), allocatable :: baseline_tangent(:,:,:) - real(BDKi), allocatable :: baseline_twist(:,:) - real(BDKi), allocatable :: gll(:) - - real(BDKi) :: cc(3) - - integer(IntKi) :: np ! number of points defining reference line - - integer(IntKi) :: ErrStat - character :: ErrMsg - character(1024) :: testname - real(BDKi) :: tolerance - -contains - - @test - subroutine test_InitializeNodalLocations_np5_p6() - - ! test problem where reference line is defined by 1 member, 5 keypoints, - ! and we fit a 6th order LSFE - - ! initialize NWTC_Num constants - call SetConstants() - - tolerance = 1e-13 - - ! -------------------------------------------------------------------------- - testname = "test_InitializeNodalLocations_1m_kp5_p6" - - member_total = 1 - - np = 5 ! five points defining the reference line - p=simpleParameterType(1,7,3,0,1) !simpleParameterType(elem_total, nodes_per_elem, nqp, qp_indx_offset, refine) - - p%dof_node = 6 - - call AllocAry(kp_member, member_total, "kp_member",ErrStat, ErrMsg) - call AllocAry(gll,p%nodes_per_elem, "gll",ErrStat, ErrMsg) - call AllocAry(baseline_uuN0, p%dof_node, p%nodes_per_elem, p%elem_total, "baseline_uuN0",ErrStat, ErrMsg) - - call AllocAry(baseline_tangent, 3, p%nodes_per_elem, p%elem_total, "baseline_tangent", ErrStat, ErrMsg) - call AllocAry(baseline_twist, p%nodes_per_elem, p%elem_total, "baseline_twist", ErrStat, ErrMsg) - - ! remove the following once the routine moves to least squares - - CALL AllocAry(p%segment_eta,np-1,'segment length ratio array',ErrStat,ErrMsg) - - kp_member(1) = np ! one member defined by 5 points - - call AllocAry(kp_coordinate, kp_member(1), 4, "kp_coordinate",ErrStat, ErrMsg) - - kp_coordinate(1,:) = (/ 0.,0.,0.,0. /) - kp_coordinate(2,:) = (/ 0.2421875,0.3125,1.25,5.625 /) - kp_coordinate(3,:) = (/ 0.375,1.,2.5,22.5/) - kp_coordinate(4,:) = (/ 0.1171875,2.0625,3.75, 50.625 /) - kp_coordinate(5,:) = (/ -1.,3.5,5., 90. /) - - gll(:) = (/ -1., -0.8302238962785669, -0.46884879347071423, 0., 0.46884879347071423, 0.8302238962785669, 1. /) - - baseline_uuN0 = 0. - - ! following calculated in mathematica - baseline_uuN0(1:3,1,1) = (/ 0.,0.,0. /) - baseline_uuN0(1:3,2,1) = (/ 0.0847841995263206,0.06406196997648083,0.4244402593035813 /) - baseline_uuN0(1:3,3,1) = (/ 0.2556265283202704,0.3443790047804582,1.327878016323214 /) - baseline_uuN0(1:3,4,1) = (/ 0.375,1.,2.5 /) - baseline_uuN0(1:3,5,1) = (/ 0.152564565773068,1.985349781927959,3.672121983676785 /) - baseline_uuN0(1:3,6,1) = (/ -0.4874656517463806,2.969845606951464,4.575559740696413 /) - baseline_uuN0(1:3,7,1) = (/ -1.,3.5,5. /) - - baseline_tangent(1:3,1,1) = (/ 0.1951800145897074,0.0975900072948519,0.975900072948533 /) - baseline_tangent(1:3,2,1) = (/ 0.1914764728687931,0.1942130285347349,0.962090463462295 /) - baseline_tangent(1:3,3,1) = (/ 0.1549438849532919,0.3815415434641369,0.911272979477931 /) - baseline_tangent(1:3,4,1) = (/ 0., 0.5734623443633284,0.81923192051904 /) - baseline_tangent(1:3,5,1) = (/ -0.2957782328585355,0.6690666276575518,0.6818101529913093 /) - baseline_tangent(1:3,6,1) = (/ -0.5494018213496115,0.6414840856724742,0.535402471535834 /) - baseline_tangent(1:3,7,1) = (/ -0.6492344540642337,0.6028605644882184,0.4637388957601716 /) - - baseline_twist(1,1) = 0. - baseline_twist(2,1) = 0.6485383213836768 - baseline_twist(3,1) = 6.347736094444107 - baseline_twist(4,1) = 22.50000000000001 - baseline_twist(5,1) = 48.54412750680838 - baseline_twist(6,1) = 75.36868898645466 - baseline_twist(7,1) = 90. - - ! here we're using the BD_ComputeIniNodalCrv to construct the rotation parameters; this is what is used in - ! BeamDyn; I do not want to rely on this routine and would rather calculate externally - do i = 1, 7 - CALL BD_ComputeIniNodalCrv(baseline_tangent(1:3,i,1), baseline_twist(i,1), cc, ErrStat, ErrMsg) - baseline_uuN0(4:6,i,1) = cc - enddo - - ! remove after reworking fit; dropping spline in favor of lease squares; p%SP_Coef is required in original spline fit implementation - !call ComputeSplineCoeffs(member_total, np, kp_member, kp_coordinate, p%SP_Coef, ErrStat, ErrMsg) - - call InitializeNodalLocations(member_total, kp_member, kp_coordinate, p, GLL, ErrStat,ErrMsg) - - !do i = 1, 7 - ! write(*,*) i, baseline_uuN0(4,i,1), baseline_uuN0(5,i,1), baseline_uuN0(6,i,1), p%uuN0(4,i,1), p%uuN0(5,i,1), p%uuN0(6,i,1) - !enddo - - @assertEqual(baseline_uuN0, p%uuN0, tolerance, testname) - - deallocate(kp_member) - deallocate(kp_coordinate) - deallocate(gll) - deallocate(baseline_uuN0) - deallocate(baseline_tangent) - deallocate(baseline_twist) - - call BD_DestroyParam(p, ErrStat, ErrMsg) - - end subroutine - -end module diff --git a/modules/beamdyn/tests/test_tools.F90 b/modules/beamdyn/tests/test_tools.F90 index 3dfa5e31c4..7030862c2d 100644 --- a/modules/beamdyn/tests/test_tools.F90 +++ b/modules/beamdyn/tests/test_tools.F90 @@ -1,285 +1,394 @@ module test_tools - + use BeamDyn_Types +use BeamDyn_Subs +use testdrive, only: new_unittest, unittest_type, error_type, check implicit none - -contains - - subroutine calcWMParameters(params, angle, n) - use BeamDyn_Subs - implicit none - - real(BDKi), intent( out), dimension(3) :: params - real(BDKi), intent(in ) :: angle - real(BDKi), intent(in ), dimension(3) :: n - - params = 4.0 * tan(angle/4.0) * n - end subroutine - - function calcRotationMatrix(angle, axis) - use BeamDyn_Subs - implicit none - - real(BDKi), dimension(3,3) :: calcRotationMatrix - real(BDKi), intent(in) :: angle - real(BDKi), intent(in), dimension(3) :: axis - real(BDKi), dimension(3,3) :: r - - r(1,:) = (/ cos(angle) + (1-cos(angle))*axis(1)**2, axis(1)*axis(2)*(1-cos(angle)) - axis(3)*sin(angle), axis(1)*axis(3)*(1-cos(angle)) + axis(2)*sin(angle) /) - r(2,:) = (/ axis(2)*axis(1)*(1-cos(angle)) + axis(3)*sin(angle), cos(angle) + (1-cos(angle))*axis(2)**2, axis(2)*axis(3)*(1-cos(angle)) - axis(1)*sin(angle) /) - r(3,:) = (/ axis(3)*axis(1)*(1-cos(angle)) - axis(2)*sin(angle), axis(3)*axis(2)*(1-cos(angle)) + axis(1)*sin(angle), cos(angle) + (1-cos(angle))*axis(3)**2 /) - - calcRotationMatrix = r - - end function - - function identity() - use BeamDyn_Subs - implicit none - - real(BDKi) :: identity(3,3) - - identity(1,:) = (/ 1.0, 0.0, 0.0 /) - identity(2,:) = (/ 0.0, 1.0, 0.0 /) - identity(3,:) = (/ 0.0, 0.0, 1.0 /) - end function - - function RonXAxis(angle) - use BeamDyn_Subs - implicit none - - real(BDKi) :: angle, r(3,3), RonXAxis(3,3) - - r(1,:) = (/ 1.0_BDKi, 0.0_BDKi, 0.0_BDKi /) - r(2,:) = (/ 0.0_BDKi, cos(angle), -sin(angle) /) - r(3,:) = (/ 0.0_BDKi, sin(angle), cos(angle) /) - RonXAxis = r - end function - - function getMassMatrix() - use BeamDyn_Subs - implicit none - - real(BDKi), dimension(6,6) :: getMassMatrix - getMassMatrix(1,:) = (/ 1.E0, 0.0, 0.0, 0.0, 0.0, -0.5 /) - getMassMatrix(2,:) = (/ 0.0, 1.E0, 0.0, 0.0, 0.0, 0.5 /) - getMassMatrix(3,:) = (/ 0.0, 0.0, 1.E0, 0.5, -0.5, 0.0 /) - getMassMatrix(4,:) = (/ 0.0, 0.0, 0.5, 1.E0, 0.0, 0.0 /) - getMassMatrix(5,:) = (/ 0.0, 0.0, -0.5, 0.0, 1.E0, 0.0 /) - getMassMatrix(6,:) = (/ -0.5, 0.5, 0.0, 0.0, 0.0, 2.E0 /) - end function - - function getStiffnessMatrix() - use BeamDyn_Subs - implicit none - - real(BDKi), dimension(6,6) :: getStiffnessMatrix - getStiffnessMatrix(1,:) = (/ 1.E4, 0.0, 0.0, 0.0, 0.0, 0.0 /) - getStiffnessMatrix(2,:) = (/ 0.0, 1.E4, 0.0, 0.0, 0.0, 0.0 /) - getStiffnessMatrix(3,:) = (/ 0.0, 0.0, 1.E4, 0.0, 0.0, 0.0 /) - getStiffnessMatrix(4,:) = (/ 0.0, 0.0, 0.0, 1.E2, 0.0, 0.0 /) - getStiffnessMatrix(5,:) = (/ 0.0, 0.0, 0.0, 0.0, 1.E2, 0.0 /) - getStiffnessMatrix(6,:) = (/ 0.0, 0.0, 0.0, 0.0, 0.0, 200.E0 /) - end function - - function getGravityInZ() - use BeamDyn_Subs - implicit none - - real(BDKi), dimension(3) :: getGravityInZ - getGravityInZ = (/ 0.0, 0.0, -9.806 /) - end function - - type(BD_OtherStateType) function simpleOtherState() result(otherstate) - ! fixed size arrays - otherstate%Glb_crv = (/ 0.0, 0.0, 0.0 /) - otherstate%GlbRot = identity() - end function - type(BD_ParameterType) function simpleParameterType(elem_total, nodes_per_elem, nqp, qp_indx_offset, refine) RESULT(p) - - integer, intent(in ) :: elem_total - integer, intent(in ) :: nodes_per_elem - integer, intent(in ) :: nqp - integer, intent(in ) :: qp_indx_offset - integer, intent(in ) :: refine - - integer :: i, j - integer :: ErrStat - character(1024) :: ErrMsg - - p%elem_total = elem_total - p%nodes_per_elem = nodes_per_elem - p%nqp = nqp - p%qp_indx_offset = qp_indx_offset - p%refine = refine - - p%dof_node = 6 - - ! allocate arrays - call AllocAry(p%qp%mmm, p%nqp, p%elem_total, 'qp_mmm', ErrStat, ErrMsg) - call AllocAry(p%qp%mEta, 3, p%nqp, p%elem_total, 'qp_RR0mEta', ErrStat, ErrMsg) - call AllocAry(p%Mass0_QP, 6, 6, p%nqp*p%elem_total, 'Mass0_QP', ErrStat, ErrMsg) ! if called, this allocated in InitializeMassStiffnessMatrices - call AllocAry(p%Stif0_QP, 6, 6, p%nqp*p%elem_total, 'Stif0_QP', ErrStat, ErrMsg) ! if called, this allocated in InitializeMassStiffnessMatrices - call AllocAry(p%QPtw_Shp_Shp_Jac, p%nqp, p%nodes_per_elem, p%nodes_per_elem, p%elem_total, 'QPtw_Shp_Shp_Jac', ErrStat, ErrMsg) - call AllocAry(p%QPtw_ShpDer_ShpDer_Jac, p%nqp, p%nodes_per_elem, p%nodes_per_elem, p%elem_total, 'QPtw_ShpDer_ShpDer_Jac', ErrStat, ErrMsg) - call AllocAry(p%QPtw_Shp_ShpDer, p%nqp, p%nodes_per_elem, p%nodes_per_elem, 'QPtw_Shp_ShpDer', ErrStat, ErrMsg) - call AllocAry(p%QPtw_Shp_Jac, p%nqp, p%nodes_per_elem, p%elem_total, 'QPtw_Shp_Jac', ErrStat, ErrMsg) - call AllocAry(p%Shp, p%nodes_per_elem, p%nqp, 'Shp', ErrStat, ErrMsg) - call AllocAry(p%ShpDer, p%nodes_per_elem, p%nqp, 'ShpDer', ErrStat, ErrMsg) - call AllocAry(p%QPtN, p%nqp, 'QPtN', ErrStat, ErrMsg) - call AllocAry(p%QPtWeight, p%nqp, 'QPtWeight', ErrStat, ErrMsg) - call AllocAry(p%QPtw_ShpDer, p%nqp, p%nodes_per_elem, 'QPtw_ShpDer', ErrStat, ErrMsg) - call AllocAry(p%Jacobian, p%nqp, p%elem_total, 'Jacobian', ErrStat, ErrMsg) - call AllocAry(p%uuN0, p%dof_node, p%nodes_per_elem, p%elem_total,'uuN0', ErrStat, ErrMsg) - - call AllocAry(p%uu0, p%dof_node, p%nqp, p%elem_total,'uu0', ErrStat, ErrMsg) - call AllocAry(p%E10, p%dof_node/2, p%nqp, p%elem_total,'E10', ErrStat, ErrMsg) - call AllocAry(p%rrN0, p%dof_node/2, p%nodes_per_elem, p%elem_total,'rrN0', ErrStat, ErrMsg) - - CALL AllocAry(p%node_elem_idx,p%elem_total,2,'start and end node numbers of elements in p%node_total sized arrays',ErrStat,ErrMsg) - - ! construct arrays - p%qp%mmm = 1.0 - - DO i=1,p%elem_total - p%node_elem_idx(i,1) = (i-1)*(p%nodes_per_elem-1) + 1 ! First node in element - p%node_elem_idx(i,2) = i *(p%nodes_per_elem-1) + 1 ! Last node in element - ENDDO - - do j=1, p%elem_total - do i=1, p%nqp - p%qp%mEta(:,i,j) = (/ 0.0, 0.0, 0.0 /) - p%Mass0_QP(:,:,(i-1)*p%elem_total+j) = getMassMatrix() + +interface check_array + module procedure check_array_R4_Rank1, check_array_R8_Rank1, & + check_array_R4_Rank2, check_array_R8_Rank2, & + check_array_R4_Rank3, check_array_R8_Rank3, & + check_array_R4_Rank4, check_array_R8_Rank4 +end interface + +real(DbKi), parameter :: tolerance = 1.0e-13_BDKi + +contains + +subroutine check_array_R4_Rank1(error, A1, A2, message, thr) + type(error_type), allocatable, intent(out) :: error + real(R4Ki), intent(in) :: A1(:), A2(:) + character(*), optional, intent(in) :: message + real(R4Ki), optional, intent(in) :: thr + integer(IntKi) :: i + do i = 1, size(A1) + call check(error, A1(i), A2(i), message=trim('A('//trim(Num2LStr(i))//') '//message), thr=thr) + if (allocated(error)) return + end do +end subroutine + +subroutine check_array_R8_Rank1(error, A1, A2, message, thr) + type(error_type), allocatable, intent(out) :: error + real(R8Ki), intent(in) :: A1(:), A2(:) + character(*), optional, intent(in) :: message + real(R8Ki), optional, intent(in) :: thr + integer(IntKi) :: i + do i = 1, size(A1) + call check(error, A1(i), A2(i), message=trim('A('//trim(Num2LStr(i))//') '//message), thr=thr) + if (allocated(error)) return + end do +end subroutine + +subroutine check_array_R4_Rank2(error, A1, A2, message, thr) + type(error_type), allocatable, intent(out) :: error + real(R4Ki), intent(in) :: A1(:, :), A2(:, :) + character(*), optional, intent(in) :: message + real(R4Ki), optional, intent(in) :: thr + integer(IntKi) :: i, j + do i = 1, size(A1, 1) + do j = 1, size(A1, 2) + call check(error, A1(i, j), A2(i, j), message=trim('A('//trim(Num2LStr(i))//','//trim(Num2LStr(j))//') '//message), thr=thr) + if (allocated(error)) return + end do + end do +end subroutine + +subroutine check_array_R8_Rank2(error, A1, A2, message, thr) + type(error_type), allocatable, intent(out) :: error + real(R8Ki), intent(in) :: A1(:, :), A2(:, :) + character(*), optional, intent(in) :: message + real(R8Ki), optional, intent(in) :: thr + integer(IntKi) :: i, j + do i = 1, size(A1, 1) + do j = 1, size(A1, 2) + call check(error, A1(i, j), A2(i, j), message=trim('A('//trim(Num2LStr(i))//','//trim(Num2LStr(j))//') '//message), thr=thr) + if (allocated(error)) return + end do + end do +end subroutine + +subroutine check_array_R4_Rank3(error, A1, A2, message, thr) + type(error_type), allocatable, intent(out) :: error + real(R4Ki), intent(in) :: A1(:, :, :), A2(:, :, :) + character(*), optional, intent(in) :: message + real(R4Ki), optional, intent(in) :: thr + integer(IntKi) :: i, j, k + do i = 1, size(A1, 1) + do j = 1, size(A1, 2) + do k = 1, size(A1, 3) + call check(error, A1(i, j, k), A2(i, j, k), & + message=trim('A('//trim(Num2LStr(i))//','//trim(Num2LStr(j))//','//trim(Num2LStr(k))//') '//message), thr=thr) + if (allocated(error)) return + end do + end do + end do +end subroutine + +subroutine check_array_R8_Rank3(error, A1, A2, message, thr) + type(error_type), allocatable, intent(out) :: error + real(R8Ki), intent(in) :: A1(:, :, :), A2(:, :, :) + character(*), optional, intent(in) :: message + real(R8Ki), optional, intent(in) :: thr + integer(IntKi) :: i, j, k + do i = 1, size(A1, 1) + do j = 1, size(A1, 2) + do k = 1, size(A1, 3) + call check(error, A1(i, j, k), A2(i, j, k), & + message=trim('A('//trim(Num2LStr(i))//','//trim(Num2LStr(j))//','//trim(Num2LStr(k))//') '//message), thr=thr) + if (allocated(error)) return + end do + end do + end do +end subroutine + +subroutine check_array_R4_Rank4(error, A1, A2, message, thr) + type(error_type), allocatable, intent(out) :: error + real(R4Ki), intent(in) :: A1(:, :, :, :), A2(:, :, :, :) + character(*), optional, intent(in) :: message + real(R4Ki), optional, intent(in) :: thr + integer(IntKi) :: i, j, k, m + do i = 1, size(A1, 1) + do j = 1, size(A1, 2) + do k = 1, size(A1, 3) + do m = 1, size(A1, 4) + call check(error, A1(i, j, k, m), A2(i, j, k, m), & + message=trim('A('//trim(Num2LStr(i))//','//trim(Num2LStr(j))//','//trim(Num2LStr(k))//','//trim(Num2LStr(m))//') '//message), thr=thr) + if (allocated(error)) return end do - end do - - end function - - type(BD_MiscVarType) function simpleMiscVarType(nqp, dof_node, elem_total, nodes_per_elem) RESULT(m) - - integer, intent(in) :: nqp, elem_total, dof_node, nodes_per_elem - integer :: i, j - integer :: ErrStat - character(1024) :: ErrMsg - - ! scalars - - ! fixed size arrays - - ! allocate arrays - call AllocAry(m%qp%Fg, 6, nqp, elem_total, 'qp_Fg', ErrStat, ErrMsg) - call AllocAry(m%qp%RR0, 3, 3, nqp, elem_total, 'qp_RR0', ErrStat, ErrMsg) - call AllocAry(m%qp%RR0mEta, 3, nqp, elem_total, 'qp_RR0mEta', ErrStat, ErrMsg) - call AllocAry(m%DistrLoad_QP, 6, nqp, elem_total, 'DistrLoad_QP', ErrStat, ErrMsg) - - call AllocAry(m%qp%uuu, dof_node, nqp, elem_total, 'm%qp%uuu displacement at quadrature point', ErrStat, ErrMsg) - call AllocAry(m%qp%uup, dof_node, nqp, elem_total, 'm%qp%uup displacement prime at quadrature point', ErrStat, ErrMsg) - - ! E1, kappa -- used in force calculations - CALL AllocAry(m%qp%E1, dof_node/2,nqp,elem_total, 'm%qp%E1 at quadrature point',ErrStat,ErrMsg) - CALL AllocAry(m%qp%kappa, dof_node/2,nqp,elem_total, 'm%qp%kappa at quadrature point',ErrStat,ErrMsg) - CALL AllocAry(m%qp%RR0, 3,3, nqp,elem_total, 'm%qp%RR0 at quadrature point',ErrStat,ErrMsg) - CALL AllocAry(m%qp%Stif, 6,6, nqp,elem_total, 'm%qp%Stif at quadrature point',ErrStat,ErrMsg) - - CALL AllocAry(m%qp%RR0mEta, dof_node/2, nqp, elem_total, 'm%qp%RRo times p%qp%mEta at quadrature point',ErrStat,ErrMsg) - call AllocAry(m%qp%rho, 3, 3, nqp, elem_total, 'qp_rho', ErrStat, ErrMsg) - CALL AllocAry(m%qp%betaC, 6,6, nqp,elem_total, 'm%qp%betaC at quadrature point',ErrStat,ErrMsg) - - CALL AllocAry(m%qp%Fc, dof_node, nqp, elem_total, 'm%qp%Fc at quadrature point',ErrStat,ErrMsg) - CALL AllocAry(m%qp%Fd, dof_node, nqp, elem_total, 'm%qp%Fd at quadrature point',ErrStat,ErrMsg) - - CALL AllocAry(m%Nrrr, dof_node/2, nodes_per_elem, elem_total,'Nrrr: rotation parameters relative to root', ErrStat,ErrMsg) - - ! construct arrays - do j=1, elem_total - do i=1, nqp - m%qp%RR0(:,:,i,j) = identity() - m%qp%RR0mEta(:,i,j) = (/ 0.0, 0.0, 0.0 /) + end do + end do + end do +end subroutine + +subroutine check_array_R8_Rank4(error, A1, A2, message, thr) + type(error_type), allocatable, intent(out) :: error + real(R8Ki), intent(in) :: A1(:, :, :, :), A2(:, :, :, :) + character(*), optional, intent(in) :: message + real(R8Ki), optional, intent(in) :: thr + integer(IntKi) :: i, j, k, m + do i = 1, size(A1, 1) + do j = 1, size(A1, 2) + do k = 1, size(A1, 3) + do m = 1, size(A1, 4) + call check(error, A1(i, j, k, m), A2(i, j, k, m), & + message=trim('A('//trim(Num2LStr(i))//','//trim(Num2LStr(j))//','//trim(Num2LStr(k))//','//trim(Num2LStr(m))//') '//message), thr=thr) + if (allocated(error)) return end do - end do - - end function - - type(BD_InputType) function simpleInputType(nqp, nelem) RESULT(i) - - integer, intent(in) :: nqp, nelem - integer :: j - integer :: ErrStat - character(1024) :: ErrMsg - - ! scalars - - ! fixed size arrays - - ! allocate arrays - call AllocAry(i%DistrLoad%Force, 3, nqp*nelem, 'DistrLoadForce', ErrStat, ErrMsg) - call AllocAry(i%DistrLoad%Moment, 3, nqp*nelem, 'DistrLoadMoment', ErrStat, ErrMsg) - - ! construct arrays - do j = 1, nqp*nelem - i%DistrLoad%Force(:,j) = (/ 3*(j-1)+1, 3*(j-1)+2, 3*(j-1)+3 /) - i%DistrLoad%Moment(:,j) = (/ -3*(j-1)-1, -3*(j-1)-2, -3*(j-1)-3 /) - end do - - end function - - type(BD_InputFile) function simpleInputFile() RESULT(i) - - integer :: j - integer :: ErrStat - character(1024) :: ErrMsg - - ! scalars - i%QuasiStaticInit = .false. ! - - - "QuasiStaticInit" - - i%member_total = 1 ! - - - "Total number of members" - - i%kp_total = 3 ! - - - "Total number of key point" - - i%order_elem = 15 ! - - - "Order of interpolation (basis) function" - - i%NRMax = 10 ! - - - "Max number of iterations in Newton Ralphson algorithm" - - i%quadrature = 1 ! - - - "Quadrature: 1: Gauss; 2: Trapezoidal" - - i%n_fact = 5 ! - - - "Factorization frequency" - - i%refine = 1 ! - - - "FE mesh refinement factor for trapezoidal quadrature" - - i%rhoinf = 0.0 ! - - - "Numerical damping parameter for generalized-alpha integrator" - - i%DTBeam = 2E-03 ! - - - "Time interval for BeamDyn calculations {or default} (s)" - - i%UsePitchAct = .FALSE. ! - - - "Whether to use a pitch actuator inside BeamDyn" (flag) - i%pitchJ = 0.0 ! - - - "Pitch actuator inertia" (kg-m^2) - i%pitchK = 0.0 ! - - - "Pitch actuator stiffness" (kg-m^2/s^2) - i%pitchC = 0.0 ! - - - "Pitch actuator damping" - (kg-m^2/s) - i%Echo = .TRUE. ! - - - "Echo" - i%NNodeOuts = 1 ! - - - "Number of node outputs [0 - 9]" - - i%OutNd = 1 ! {9} - - "Nodes whose values will be output" - - i%SumPrint = .TRUE. ! - - - "Print summary data to file? (.sum)" - - i%OutFmt = "ES16.8E2" ! - - - "Format specifier" - - - ! fixed size arrays - i%kp_member = (/ 3 /) !{:} - - "Number of key points in each member" - - i%OutList = (/ "TipTDxr, TipTDyr, TipTDzr", "TipRDxr, TipRDyr, TipRDzr" /) ! {:} - - "List of user-requested output channels" - - - ! allocate arrays - call AllocAry(i%kp_coordinate, 3, 4, 'kp_coordinate', ErrStat, ErrMsg) - - ! construct arrays - i%kp_coordinate(1,:) = (/ 0.000000, 0.000000, 0.0000, 0.00000 /) ! {:}{:} - - "Key point coordinates array" - - i%kp_coordinate(2,:) = (/ 0.000000, 0.000000, 5.0000, 0.00000 /) - i%kp_coordinate(3,:) = (/ 0.000000, 0.000000, 10.0000, 0.00000 /) - - end function - - type(BD_ContinuousStateType) function simpleContinuousStateType(node_total, nodes_per_elem, elem_total) RESULT(x) - - integer, intent(in) :: node_total,nodes_per_elem, elem_total - integer :: j - integer :: ErrStat - character(1024) :: ErrMsg - - ! scalars - - ! fixed size arrays - - ! allocate arrays - call AllocAry(x%q, 6, node_total, 'Displacement/Rotation Nodal DOF', ErrStat, ErrMsg) - call AllocAry(x%dqdt, 6, node_total, 'Velocity Nodal DOF', ErrStat, ErrMsg) - - end function - + end do + end do + end do +end subroutine + +subroutine calcWMParameters(params, angle, n) + real(BDKi), intent(out), dimension(3) :: params + real(BDKi), intent(in) :: angle + real(BDKi), intent(in), dimension(3) :: n + + params = 4.0 * tan(angle / 4.0) * n +end subroutine + +function calcRotationMatrix(angle, axis) + real(BDKi), dimension(3, 3) :: calcRotationMatrix + real(BDKi), intent(in) :: angle + real(BDKi), intent(in), dimension(3) :: axis + real(BDKi), dimension(3, 3) :: r + + r(1, :) = [cos(angle) + (1 - cos(angle)) * axis(1)**2, axis(1) * axis(2) * (1 - cos(angle)) - axis(3) * sin(angle), axis(1) * axis(3) * (1 - cos(angle)) + axis(2) * sin(angle)] + r(2, :) = [axis(2) * axis(1) * (1 - cos(angle)) + axis(3) * sin(angle), cos(angle) + (1 - cos(angle)) * axis(2)**2, axis(2) * axis(3) * (1 - cos(angle)) - axis(1) * sin(angle)] + r(3, :) = [axis(3) * axis(1) * (1 - cos(angle)) - axis(2) * sin(angle), axis(3) * axis(2) * (1 - cos(angle)) + axis(1) * sin(angle), cos(angle) + (1 - cos(angle)) * axis(3)**2] + + calcRotationMatrix = r + +end function + +function identity() + real(BDKi) :: identity(3, 3) + + identity(1, :) = [1.0, 0.0, 0.0] + identity(2, :) = [0.0, 1.0, 0.0] + identity(3, :) = [0.0, 0.0, 1.0] +end function + +function RonXAxis(angle) + real(BDKi) :: angle, r(3, 3), RonXAxis(3, 3) + + r(1, :) = [1.0_BDKi, 0.0_BDKi, 0.0_BDKi] + r(2, :) = [0.0_BDKi, cos(angle), -sin(angle)] + r(3, :) = [0.0_BDKi, sin(angle), cos(angle)] + RonXAxis = r +end function + +function getMassMatrix() + real(BDKi), dimension(6, 6) :: getMassMatrix + getMassMatrix(1, :) = [1.E0, 0.0, 0.0, 0.0, 0.0, -0.5] + getMassMatrix(2, :) = [0.0, 1.E0, 0.0, 0.0, 0.0, 0.5] + getMassMatrix(3, :) = [0.0, 0.0, 1.E0, 0.5, -0.5, 0.0] + getMassMatrix(4, :) = [0.0, 0.0, 0.5, 1.E0, 0.0, 0.0] + getMassMatrix(5, :) = [0.0, 0.0, -0.5, 0.0, 1.E0, 0.0] + getMassMatrix(6, :) = [-0.5, 0.5, 0.0, 0.0, 0.0, 2.E0] +end function + +function getStiffnessMatrix() + real(BDKi), dimension(6, 6) :: getStiffnessMatrix + getStiffnessMatrix(1, :) = [1.E4, 0.0, 0.0, 0.0, 0.0, 0.0] + getStiffnessMatrix(2, :) = [0.0, 1.E4, 0.0, 0.0, 0.0, 0.0] + getStiffnessMatrix(3, :) = [0.0, 0.0, 1.E4, 0.0, 0.0, 0.0] + getStiffnessMatrix(4, :) = [0.0, 0.0, 0.0, 1.E2, 0.0, 0.0] + getStiffnessMatrix(5, :) = [0.0, 0.0, 0.0, 0.0, 1.E2, 0.0] + getStiffnessMatrix(6, :) = [0.0, 0.0, 0.0, 0.0, 0.0, 200.E0] +end function + +function getGravityInZ() + real(BDKi), dimension(3) :: getGravityInZ + getGravityInZ = [0.0, 0.0, -9.806] +end function + +type(BD_OtherStateType) function simpleOtherState() result(otherstate) + ! fixed size arrays + otherstate%Glb_crv = [0.0, 0.0, 0.0] + otherstate%GlbRot = identity() +end function +type(BD_ParameterType) function simpleParameterType(elem_total, nodes_per_elem, nqp, qp_indx_offset, refine) result(p) + integer, intent(in) :: elem_total + integer, intent(in) :: nodes_per_elem + integer, intent(in) :: nqp + integer, intent(in) :: qp_indx_offset + integer, intent(in) :: refine + + integer :: i, j + integer :: ErrStat + character(1024) :: ErrMsg + + p%elem_total = elem_total + p%nodes_per_elem = nodes_per_elem + p%nqp = nqp + p%qp_indx_offset = qp_indx_offset + p%refine = refine + + p%dof_node = 6 + + ! allocate arrays + call AllocAry(p%qp%mmm, p%nqp, p%elem_total, 'qp_mmm', ErrStat, ErrMsg) + call AllocAry(p%qp%mEta, 3, p%nqp, p%elem_total, 'qp_RR0mEta', ErrStat, ErrMsg) + call AllocAry(p%Mass0_QP, 6, 6, p%nqp * p%elem_total, 'Mass0_QP', ErrStat, ErrMsg) ! if called, this allocated in InitializeMassStiffnessMatrices + call AllocAry(p%Stif0_QP, 6, 6, p%nqp * p%elem_total, 'Stif0_QP', ErrStat, ErrMsg) ! if called, this allocated in InitializeMassStiffnessMatrices + call AllocAry(p%QPtw_Shp_Shp_Jac, p%nqp, p%nodes_per_elem, p%nodes_per_elem, p%elem_total, 'QPtw_Shp_Shp_Jac', ErrStat, ErrMsg) + call AllocAry(p%QPtw_ShpDer_ShpDer_Jac, p%nqp, p%nodes_per_elem, p%nodes_per_elem, p%elem_total, 'QPtw_ShpDer_ShpDer_Jac', ErrStat, ErrMsg) + call AllocAry(p%QPtw_Shp_ShpDer, p%nqp, p%nodes_per_elem, p%nodes_per_elem, 'QPtw_Shp_ShpDer', ErrStat, ErrMsg) + call AllocAry(p%QPtw_Shp_Jac, p%nqp, p%nodes_per_elem, p%elem_total, 'QPtw_Shp_Jac', ErrStat, ErrMsg) + call AllocAry(p%Shp, p%nodes_per_elem, p%nqp, 'Shp', ErrStat, ErrMsg) + call AllocAry(p%ShpDer, p%nodes_per_elem, p%nqp, 'ShpDer', ErrStat, ErrMsg) + call AllocAry(p%QPtN, p%nqp, 'QPtN', ErrStat, ErrMsg) + call AllocAry(p%QPtWeight, p%nqp, 'QPtWeight', ErrStat, ErrMsg) + call AllocAry(p%QPtw_ShpDer, p%nqp, p%nodes_per_elem, 'QPtw_ShpDer', ErrStat, ErrMsg) + call AllocAry(p%Jacobian, p%nqp, p%elem_total, 'Jacobian', ErrStat, ErrMsg) + call AllocAry(p%uuN0, p%dof_node, p%nodes_per_elem, p%elem_total, 'uuN0', ErrStat, ErrMsg) + + call AllocAry(p%uu0, p%dof_node, p%nqp, p%elem_total, 'uu0', ErrStat, ErrMsg) + call AllocAry(p%E10, p%dof_node / 2, p%nqp, p%elem_total, 'E10', ErrStat, ErrMsg) + call AllocAry(p%rrN0, p%dof_node / 2, p%nodes_per_elem, p%elem_total, 'rrN0', ErrStat, ErrMsg) + + call AllocAry(p%node_elem_idx, p%elem_total, 2, 'start and end node numbers of elements in p%node_total sized arrays', ErrStat, ErrMsg) + + ! construct arrays + p%qp%mmm = 1.0 + + do i = 1, p%elem_total + p%node_elem_idx(i, 1) = (i - 1) * (p%nodes_per_elem - 1) + 1 ! First node in element + p%node_elem_idx(i, 2) = i * (p%nodes_per_elem - 1) + 1 ! Last node in element + end do + + do j = 1, p%elem_total + do i = 1, p%nqp + p%qp%mEta(:, i, j) = [0.0, 0.0, 0.0] + p%Mass0_QP(:, :, (i - 1) * p%elem_total + j) = getMassMatrix() + end do + end do + +end function + +type(BD_MiscVarType) function simpleMiscVarType(nqp, dof_node, elem_total, nodes_per_elem) result(m) + integer, intent(in) :: nqp, elem_total, dof_node, nodes_per_elem + integer :: i, j + integer :: ErrStat + character(1024) :: ErrMsg + + ! scalars + + ! fixed size arrays + + ! allocate arrays + call AllocAry(m%qp%Fg, 6, nqp, elem_total, 'qp_Fg', ErrStat, ErrMsg) + call AllocAry(m%qp%RR0, 3, 3, nqp, elem_total, 'qp_RR0', ErrStat, ErrMsg) + call AllocAry(m%qp%RR0mEta, 3, nqp, elem_total, 'qp_RR0mEta', ErrStat, ErrMsg) + call AllocAry(m%DistrLoad_QP, 6, nqp, elem_total, 'DistrLoad_QP', ErrStat, ErrMsg) + + call AllocAry(m%qp%uuu, dof_node, nqp, elem_total, 'm%qp%uuu displacement at quadrature point', ErrStat, ErrMsg) + call AllocAry(m%qp%uup, dof_node, nqp, elem_total, 'm%qp%uup displacement prime at quadrature point', ErrStat, ErrMsg) + + ! E1, kappa -- used in force calculations + call AllocAry(m%qp%E1, dof_node / 2, nqp, elem_total, 'm%qp%E1 at quadrature point', ErrStat, ErrMsg) + call AllocAry(m%qp%kappa, dof_node / 2, nqp, elem_total, 'm%qp%kappa at quadrature point', ErrStat, ErrMsg) + call AllocAry(m%qp%RR0, 3, 3, nqp, elem_total, 'm%qp%RR0 at quadrature point', ErrStat, ErrMsg) + call AllocAry(m%qp%Stif, 6, 6, nqp, elem_total, 'm%qp%Stif at quadrature point', ErrStat, ErrMsg) + + call AllocAry(m%qp%RR0mEta, dof_node / 2, nqp, elem_total, 'm%qp%RRo times p%qp%mEta at quadrature point', ErrStat, ErrMsg) + call AllocAry(m%qp%rho, 3, 3, nqp, elem_total, 'qp_rho', ErrStat, ErrMsg) + call AllocAry(m%qp%betaC, 6, 6, nqp, elem_total, 'm%qp%betaC at quadrature point', ErrStat, ErrMsg) + + call AllocAry(m%qp%Fc, dof_node, nqp, elem_total, 'm%qp%Fc at quadrature point', ErrStat, ErrMsg) + call AllocAry(m%qp%Fd, dof_node, nqp, elem_total, 'm%qp%Fd at quadrature point', ErrStat, ErrMsg) + + call AllocAry(m%Nrrr, dof_node / 2, nodes_per_elem, elem_total, 'Nrrr: rotation parameters relative to root', ErrStat, ErrMsg) + + ! construct arrays + do j = 1, elem_total + do i = 1, nqp + m%qp%RR0(:, :, i, j) = identity() + m%qp%RR0mEta(:, i, j) = [0.0, 0.0, 0.0] + end do + end do + +end function + +type(BD_InputType) function simpleInputType(nqp, nelem) result(i) + integer, intent(in) :: nqp, nelem + integer :: j + integer :: ErrStat + character(1024) :: ErrMsg + + ! scalars + + ! fixed size arrays + + ! allocate arrays + call AllocAry(i%DistrLoad%Force, 3, nqp * nelem, 'DistrLoadForce', ErrStat, ErrMsg) + call AllocAry(i%DistrLoad%Moment, 3, nqp * nelem, 'DistrLoadMoment', ErrStat, ErrMsg) + + ! construct arrays + do j = 1, nqp * nelem + i%DistrLoad%Force(:, j) = [3 * (j - 1) + 1, 3 * (j - 1) + 2, 3 * (j - 1) + 3] + i%DistrLoad%Moment(:, j) = [-3 * (j - 1) - 1, -3 * (j - 1) - 2, -3 * (j - 1) - 3] + end do + +end function + +type(BD_InputFile) function simpleInputFile() result(i) + integer :: j + integer :: ErrStat + character(1024) :: ErrMsg + + ! scalars + i%QuasiStaticInit = .false. ! - - - "QuasiStaticInit" - + i%member_total = 1 ! - - - "Total number of members" - + i%kp_total = 3 ! - - - "Total number of key point" - + i%order_elem = 15 ! - - - "Order of interpolation (basis) function" - + i%NRMax = 10 ! - - - "Max number of iterations in Newton Ralphson algorithm" - + i%quadrature = 1 ! - - - "Quadrature: 1: Gauss; 2: Trapezoidal" - + i%n_fact = 5 ! - - - "Factorization frequency" - + i%refine = 1 ! - - - "FE mesh refinement factor for trapezoidal quadrature" - + i%rhoinf = 0.0 ! - - - "Numerical damping parameter for generalized-alpha integrator" - + i%DTBeam = 2E-03 ! - - - "Time interval for BeamDyn calculations {or default} (s)" - + i%UsePitchAct = .false. ! - - - "Whether to use a pitch actuator inside BeamDyn" (flag) + i%pitchJ = 0.0 ! - - - "Pitch actuator inertia" (kg-m^2) + i%pitchK = 0.0 ! - - - "Pitch actuator stiffness" (kg-m^2/s^2) + i%pitchC = 0.0 ! - - - "Pitch actuator damping" - (kg-m^2/s) + i%Echo = .true. ! - - - "Echo" + i%NNodeOuts = 1 ! - - - "Number of node outputs [0 - 9]" - + i%OutNd = 1 ! {9} - - "Nodes whose values will be output" - + i%SumPrint = .true. ! - - - "Print summary data to file? (.sum)" - + i%OutFmt = "ES16.8E2" ! - - - "Format specifier" - + + ! fixed size arrays + i%kp_member = [3] !{:} - - "Number of key points in each member" - + i%OutList = ["TipTDxr, TipTDyr, TipTDzr", "TipRDxr, TipRDyr, TipRDzr"] ! {:} - - "List of user-requested output channels" - + + ! allocate arrays + call AllocAry(i%kp_coordinate, 3, 4, 'kp_coordinate', ErrStat, ErrMsg) + + ! construct arrays + i%kp_coordinate(1, :) = [0.000000, 0.000000, 0.0000, 0.00000] ! {:}{:} - - "Key point coordinates array" - + i%kp_coordinate(2, :) = [0.000000, 0.000000, 5.0000, 0.00000] + i%kp_coordinate(3, :) = [0.000000, 0.000000, 10.0000, 0.00000] + +end function + +type(BD_ContinuousStateType) function simpleContinuousStateType(node_total, nodes_per_elem, elem_total) result(x) + integer, intent(in) :: node_total, nodes_per_elem, elem_total + integer :: j + integer :: ErrStat + character(1024) :: ErrMsg + + ! scalars + + ! fixed size arrays + + ! allocate arrays + call AllocAry(x%q, 6, node_total, 'Displacement/Rotation Nodal DOF', ErrStat, ErrMsg) + call AllocAry(x%dqdt, 6, node_total, 'Velocity Nodal DOF', ErrStat, ErrMsg) + +end function + end module diff --git a/modules/elastodyn/CMakeLists.txt b/modules/elastodyn/CMakeLists.txt index ce0f1e51bc..0aebedfa67 100644 --- a/modules/elastodyn/CMakeLists.txt +++ b/modules/elastodyn/CMakeLists.txt @@ -18,7 +18,7 @@ if (GENERATE_TYPES) generate_f90_types(src/ElastoDyn_Registry.txt ${CMAKE_CURRENT_LIST_DIR}/src/ElastoDyn_Types.f90) endif() -add_library(elastodynlib +add_library(elastodynlib STATIC src/ElastoDyn.f90 src/ElastoDyn_IO.f90 src/ElastoDyn_AllBldNdOuts_IO.f90 diff --git a/modules/elastodyn/src/ED_UserSubs.f90 b/modules/elastodyn/src/ED_UserSubs.f90 index de368c02eb..42372a4288 100644 --- a/modules/elastodyn/src/ED_UserSubs.f90 +++ b/modules/elastodyn/src/ED_UserSubs.f90 @@ -101,6 +101,36 @@ SUBROUTINE UserTeet ( TeetDef, TeetRate, ZTime, DirRoot, TeetMom ) RETURN END SUBROUTINE UserTeet !======================================================================= +SUBROUTINE UserYawFrict ( ZTime, F, M, Mzz, Omg, OmgDot, DirRoot, YawFriMf ) + + ! This is a dummy routine for holding the place of a user-specified + ! Yaw Friction. Modify this code to create your own device. + + +USE Precision + + +IMPLICIT NONE + + + ! Passed Variables: +REAL(DbKi), INTENT(IN ) :: ZTime ! Current simulation time, sec. +REAL(ReKi), INTENT(IN ) :: F(3),M(3) ! Yaw bearing force and moment N and N*m +REAL(R8Ki), INTENT(IN ) :: Mzz ! External axial yaw bearing torque N*m +REAL(R8Ki), INTENT(IN ) :: Omg ! Yaw rotational speed, rad/s. +REAL(R8Ki), INTENT(IN ) :: OmgDot ! Yaw rotational acceleration, rad/s^2. + +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. + +REAL(ReKi), INTENT(OUT) :: YawFriMf ! Yaw friction moment, N*m. + + + +YawFriMf = 0.0 + +RETURN +END SUBROUTINE UserYawFrict +!======================================================================= SUBROUTINE UserTFrl ( TFrlDef, TFrlRate, ZTime, DirRoot, TFrlMom ) diff --git a/modules/elastodyn/src/ElastoDyn.f90 b/modules/elastodyn/src/ElastoDyn.f90 index 061dbb3c11..4bce771cd6 100644 --- a/modules/elastodyn/src/ElastoDyn.f90 +++ b/modules/elastodyn/src/ElastoDyn.f90 @@ -120,23 +120,25 @@ SUBROUTINE ED_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut ! Read the input file and validate the data !............................................................................................ p%BD4Blades = .NOT. InitInp%CompElast ! if we're not using ElastoDyn for the blades, use BeamDyn - p%UseAD14 = LEN_TRIM(InitInp%ADInputFile) > 0 ! if we're using AD14, we need to use the AD14 input files + p%RigidAero = InitInp%RigidAero ! If AeroDisk is used, set blades to all be rigid p%RootName = InitInp%RootName ! FAST already adds '.ED' to the root name - + p%CompAeroMaps = InitInp%CompAeroMaps p%Gravity = InitInp%Gravity - CALL ED_ReadInput( InitInp%InputFile, InitInp%ADInputFile, InputFileData, p%BD4Blades, Interval, p%RootName, ErrStat2, ErrMsg2 ) + CALL ED_ReadInput( InitInp%InputFile, InputFileData, p%BD4Blades, Interval, p%RootName, ErrStat2, ErrMsg2 ) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN - IF ( p%BD4Blades ) THEN - - ! Set DOFs to FALSE for whatever values you don't want on for BeamDyn + + IF ( p%BD4Blades .or. p%RigidAero ) THEN + ! Set DOFs to make rotor rigid InputFileData%FlapDOF1 = .FALSE. InputFileData%FlapDOF2 = .FALSE. InputFileData%EdgeDOF = .FALSE. - + ENDIF + + IF ( p%BD4Blades ) THEN ! Set other values not used for BeamDyn InputFileData%OoPDefl = 0.0_ReKi InputFileData%IPDefl = 0.0_ReKi @@ -145,9 +147,56 @@ SUBROUTINE ED_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut InputFileData%NBlGages = 0 InputFileData%BldGagNd = 0 InputFileData%BldNodes = 0 - END IF + IF (p%CompAeroMaps) THEN + InputFileData%DT = Interval + p%Gravity = 0.0_ReKi + + ! DEGREES OF FREEDOM + InputFileData%TeetDOF = .false. + InputFileData%DrTrDOF = .false. + InputFileData%GenDOF = .false. + InputFileData%YawDOF = .false. + InputFileData%TwFADOF1 = .false. + InputFileData%TwFADOF2 = .false. + InputFileData%TwSSDOF1 = .false. + InputFileData%TwSSDOF2 = .false. + InputFileData%PtfmSgDOF= .false. + InputFileData%PtfmSwDOF= .false. + InputFileData%PtfmHvDOF= .false. + InputFileData%PtfmRDOF = .false. + InputFileData%PtfmPDOF = .false. + InputFileData%PtfmYDOF = .false. + + ! INITIAL CONDITIONS + InputFileData%RotSpeed = InitInp%RotSpeed + InputFileData%OoPDefl = 0.0_ReKi + InputFileData%IPDefl = 0.0_ReKi + InputFileData%BlPitch(1) = 0.0_ReKi + InputFileData%BlPitch(2) = 0.0_ReKi + InputFileData%BlPitch(3) = 0.0_ReKi + InputFileData%TeetDefl = 0.0_ReKi + InputFileData%Azimuth = 0.0_ReKi + InputFileData%NacYaw = 0.0_ReKi + InputFileData%TTDspFA = 0.0_ReKi + InputFileData%TTDspSS = 0.0_ReKi + InputFileData%PtfmSurge = 0.0_ReKi + InputFileData%PtfmSway = 0.0_ReKi + InputFileData%PtfmHeave = 0.0_ReKi + InputFileData%PtfmRoll = 0.0_ReKi + InputFileData%PtfmPitch = 0.0_ReKi + InputFileData%PtfmYaw = 0.0_ReKi + + ! TURBINE CONFIGURATION + ! CHECK THAT precone is same for all blades??? + InputFileData%ShftTilt = 0.0_ReKi + + ! CHECK THAT BldFile is same for all blades??? + + InputFileData%TeetMod = 0 + + END IF CALL ED_ValidateInput( InputFileData, p%BD4Blades, InitInp%Linearize, InitInp%MHK, ErrStat2, ErrMsg2 ) CALL CheckError( ErrStat2, ErrMsg2 ) @@ -239,12 +288,14 @@ SUBROUTINE ED_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut InitOut%Ver = ED_Ver InitOut%NumBl = p%NumBl InitOut%BladeLength = p%TipRad - p%HubRad - InitOut%TowerHeight = p%TwrFlexL + InitOut%TowerFlexL = p%TwrFlexL InitOut%TowerBaseHeight = p%TowerBsHt ! Platform reference point wrt to global origin (0,0,0) InitOut%PlatformPos = x%QT(1:6) - CALL SmllRotTrans('initial platform rotation', x%QT(4), x%QT(5), x%QT(6), TransMat, '', ErrStat2, ErrMsg2) + ! CALL SmllRotTrans('initial platform rotation', x%QT(4), x%QT(5), x%QT(6), TransMat, '', ErrStat2, ErrMsg2) + TransMat = EulerConstructZYX((/x%QT(4),x%QT(5),x%QT(6)/)) + InitOut%PlatformPos(1) = InitOut%PlatformPos(1) - TransMat(3,1)*p%PtfmRefzt InitOut%PlatformPos(2) = InitOut%PlatformPos(2) - TransMat(3,2)*p%PtfmRefzt InitOut%PlatformPos(3) = InitOut%PlatformPos(3) - TransMat(3,3)*p%PtfmRefzt + p%PtfmRefzt @@ -257,6 +308,7 @@ SUBROUTINE ED_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut InitOut%HubRad = p%HubRad InitOut%RotSpeed = p%RotSpeed InitOut%isFixed_GenDOF = .not. InputFileData%GenDOF + InitOut%GearBox_index = DOF_GeAz ! for steady-state solver changing rotor speed if (.not. p%BD4Blades) then @@ -286,7 +338,7 @@ SUBROUTINE ED_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut ! set up data needed for linearization analysis !............................................................................................ - if (InitInp%Linearize) then + if (InitInp%Linearize .or. p%CompAeroMaps) then call ED_Init_Jacobian(p, u, y, InitOut, ErrStat2, ErrMsg2) call CheckError( ErrStat2, ErrMsg2 ) if (ErrStat >= AbortErrLev) return @@ -440,6 +492,8 @@ SUBROUTINE ED_UpdateStates( t, n, u, utimes, p, x, xd, z, OtherState, m, ErrStat ErrStat = ErrID_None ErrMsg = "" + ! Passing in u(1) as a dummy. ED_UpdateDiscState does not require input, u, only the continuous state, x. + CALL ED_UpdateDiscState( t, n, u(1), p, x, xd, z, OtherState, m, ErrStat, ErrMsg ) SELECT CASE ( p%method ) @@ -472,7 +526,6 @@ SUBROUTINE ED_UpdateStates( t, n, u, utimes, p, x, xd, z, OtherState, m, ErrStat IF ( ( x%QT(DOF_GeAz) + x%QT(DOF_DrTr) ) >= TwoPi_D ) x%QT(DOF_GeAz) = x%QT(DOF_GeAz) - TwoPi_D - END SUBROUTINE ED_UpdateStates !---------------------------------------------------------------------------------------------------------------------------------- !> Routine for computing outputs, used in both loose and tight coupling. @@ -548,6 +601,7 @@ SUBROUTINE ED_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) REAL(ReKi) :: MFHydro (NDims,p%TwrNodes) ! Total hydrodynamic + aerodynamic moment per unit length acting on a tower element (body F) at point T. REAL(ReKi) :: MomH0B (NDims,p%NumBl) ! Total moment at the hub (body H) / blade root (point S(0)) due to the blade. + REAL(ReKi) :: gAccE (NDims) ! Gravitational acceleration in the inertia frame (body E for earth) INTEGER(IntKi) :: I ! Generic index INTEGER(IntKi) :: J, J2 ! Loops through nodes / elements @@ -601,6 +655,8 @@ SUBROUTINE ED_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) ! associated with the accelerations one by one: !............................................................................................................................... + gAccE = -p%Gravity * m%CoordSys%z2 + AngAccEB = m%RtHS%AngAccEBt AngAccEH = m%RtHS%AngAccEHt AngAccEN = m%RtHS%AngAccENt @@ -614,9 +670,13 @@ SUBROUTINE ED_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) FrcT0Trb = m%RtHS%FrcT0Trbt ! was FZHydro = m%RtHS%FZHydrot - FZHydro = u%PlatformPtMesh%Force(DOF_Sg,1)*m%RtHS%PLinVelEZ(DOF_Sg,0,:) & - + u%PlatformPtMesh%Force(DOF_Sw,1)*m%RtHS%PLinVelEZ(DOF_Sw,0,:) & - + u%PlatformPtMesh%Force(DOF_Hv,1)*m%RtHS%PLinVelEZ(DOF_Hv,0,:) + ! FZHydro = u%PlatformPtMesh%Force(DOF_Sg,1)*m%RtHS%PLinVelEZ(DOF_Sg,0,:) & + ! + u%PlatformPtMesh%Force(DOF_Sw,1)*m%RtHS%PLinVelEZ(DOF_Sw,0,:) & + ! + u%PlatformPtMesh%Force(DOF_Hv,1)*m%RtHS%PLinVelEZ(DOF_Hv,0,:) + + FZHydro = u%PlatformPtMesh%Force(DOF_Sg,1)*m%CoordSys%z1 & + - u%PlatformPtMesh%Force(DOF_Sw,1)*m%CoordSys%z3 & + + u%PlatformPtMesh%Force(DOF_Hv,1)*m%CoordSys%z2 MomBNcRt = m%RtHS%MomBNcRtt MomLPRot = m%RtHS%MomLPRott @@ -625,9 +685,13 @@ SUBROUTINE ED_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) MomX0Trb = m%RtHS%MomX0Trbt ! was MXHydro = m%RtHS%MXHydrot - MXHydro = u%PlatformPtMesh%Moment(DOF_R-3,1)*m%RtHS%PAngVelEX(DOF_R ,0,:) & - + u%PlatformPtMesh%Moment(DOF_P-3,1)*m%RtHS%PAngVelEX(DOF_P ,0,:) & - + u%PlatformPtMesh%Moment(DOF_Y-3,1)*m%RtHS%PAngVelEX(DOF_Y ,0,:) + ! MXHydro = u%PlatformPtMesh%Moment(DOF_R-3,1)*m%RtHS%PAngVelEX(DOF_R ,0,:) & + ! + u%PlatformPtMesh%Moment(DOF_P-3,1)*m%RtHS%PAngVelEX(DOF_P ,0,:) & + ! + u%PlatformPtMesh%Moment(DOF_Y-3,1)*m%RtHS%PAngVelEX(DOF_Y ,0,:) + + MXHydro = u%PlatformPtMesh%Moment(DOF_R-3,1)*m%CoordSys%z1 & + - u%PlatformPtMesh%Moment(DOF_P-3,1)*m%CoordSys%z3 & + + u%PlatformPtMesh%Moment(DOF_Y-3,1)*m%CoordSys%z2 DO I = 1,p%DOFs%NActvDOF ! Loop through all active (enabled) DOFs AngAccEB = AngAccEB + m%RtHS%PAngVelEB (p%DOFs%SrtPS(I),0,:)*m%QD2T(p%DOFs%SrtPS(I)) @@ -757,10 +821,13 @@ SUBROUTINE ED_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) m%AllOuts( TipALxb(K) ) = DOT_PRODUCT( LinAccES(:,p%TipNode,K), m%CoordSys%n1(K,p%BldNodes,:) ) m%AllOuts( TipALyb(K) ) = DOT_PRODUCT( LinAccES(:,p%TipNode,K), m%CoordSys%n2(K,p%BldNodes,:) ) m%AllOuts( TipALzb(K) ) = DOT_PRODUCT( LinAccES(:,p%TipNode,K), m%CoordSys%n3(K,p%BldNodes,:) ) + m%AllOuts( TipALgxb(K) ) = DOT_PRODUCT( LinAccES(:,p%TipNode,K) - gAccE, m%CoordSys%n1(K,p%BldNodes,:) ) + m%AllOuts( TipALgyb(K) ) = DOT_PRODUCT( LinAccES(:,p%TipNode,K) - gAccE, m%CoordSys%n2(K,p%BldNodes,:) ) + m%AllOuts( TipALgzb(K) ) = DOT_PRODUCT( LinAccES(:,p%TipNode,K) - gAccE, m%CoordSys%n3(K,p%BldNodes,:) ) m%AllOuts( TipRDxb(K) ) = DOT_PRODUCT( m%RtHS%AngPosHM(:,K,p%TipNode), m%CoordSys%j1(K, :) )*R2D m%AllOuts( TipRDyb(K) ) = DOT_PRODUCT( m%RtHS%AngPosHM(:,K,p%TipNode), m%CoordSys%j2(K, :) )*R2D ! There is no sense computing AllOuts( TipRDzc(K) ) here since it is always zero for FAST simulation results. - IF ( p%MHK == 2 ) THEN + IF ( p%MHK == MHK_Floating ) THEN IF ( rOSTipzn < 0.0 ) THEN ! Tip of blade K is above the yaw bearing. m%AllOuts(TipClrnc(K) ) = SQRT( rOSTipxn*rOSTipxn + rOSTipyn*rOSTipyn + rOSTipzn*rOSTipzn ) ! Absolute distance from the tower top / yaw bearing to the tip of blade 1. ELSE ! Tip of blade K is below the yaw bearing. @@ -786,6 +853,10 @@ SUBROUTINE ED_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) m%AllOuts( SpnALyb(I,K) ) = DOT_PRODUCT( LinAccES(:,p%BldGagNd(I),K), m%CoordSys%n2(K,p%BldGagNd(I),:) ) m%AllOuts( SpnALzb(I,K) ) = DOT_PRODUCT( LinAccES(:,p%BldGagNd(I),K), m%CoordSys%n3(K,p%BldGagNd(I),:) ) + m%AllOuts( SpnALgxb(I,K) ) = DOT_PRODUCT( LinAccES(:,p%BldGagNd(I),K) - gAccE, m%CoordSys%n1(K,p%BldGagNd(I),:) ) + m%AllOuts( SpnALgyb(I,K) ) = DOT_PRODUCT( LinAccES(:,p%BldGagNd(I),K) - gAccE, m%CoordSys%n2(K,p%BldGagNd(I),:) ) + m%AllOuts( SpnALgzb(I,K) ) = DOT_PRODUCT( LinAccES(:,p%BldGagNd(I),K) - gAccE, m%CoordSys%n3(K,p%BldGagNd(I),:) ) + rSPS = m%RtHS%rS0S(:,K,p%BldGagNd(I)) - p%RNodes(p%BldGagNd(I))*m%CoordSys%j3(K,:) m%AllOuts( SpnTDxb(I,K) ) = DOT_PRODUCT( rSPS, m%CoordSys%j1(K,:) ) @@ -854,6 +925,9 @@ SUBROUTINE ED_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) m%AllOuts(NcIMUTAxs) = DOT_PRODUCT( LinAccEIMU, m%CoordSys%c1 ) m%AllOuts(NcIMUTAys) = -1.0*DOT_PRODUCT( LinAccEIMU, m%CoordSys%c3 ) m%AllOuts(NcIMUTAzs) = DOT_PRODUCT( LinAccEIMU, m%CoordSys%c2 ) + m%AllOuts(NcIMUTAgxs) = DOT_PRODUCT( LinAccEIMU-gAccE, m%CoordSys%c1 ) + m%AllOuts(NcIMUTAgys) = -1.0*DOT_PRODUCT( LinAccEIMU-gAccE, m%CoordSys%c3 ) + m%AllOuts(NcIMUTAgzs) = DOT_PRODUCT( LinAccEIMU-gAccE, m%CoordSys%c2 ) m%AllOuts(NcIMURVxs) = DOT_PRODUCT( m%RtHS%AngVelER , m%CoordSys%c1 )*R2D m%AllOuts(NcIMURVys) = -1.0*DOT_PRODUCT( m%RtHS%AngVelER , m%CoordSys%c3 )*R2D m%AllOuts(NcIMURVzs) = DOT_PRODUCT( m%RtHS%AngVelER , m%CoordSys%c2 )*R2D @@ -904,6 +978,9 @@ SUBROUTINE ED_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) m%AllOuts(YawBrTAxp) = DOT_PRODUCT( LinAccEO, m%CoordSys%b1 ) m%AllOuts(YawBrTAyp) = -DOT_PRODUCT( LinAccEO, m%CoordSys%b3 ) m%AllOuts(YawBrTAzp) = DOT_PRODUCT( LinAccEO, m%CoordSys%b2 ) + m%AllOuts(YawBrTAgxp) = DOT_PRODUCT( LinAccEO-gAccE, m%CoordSys%b1 ) + m%AllOuts(YawBrTAgyp) = -DOT_PRODUCT( LinAccEO-gAccE, m%CoordSys%b3 ) + m%AllOuts(YawBrTAgzp) = DOT_PRODUCT( LinAccEO-gAccE, m%CoordSys%b2 ) m%AllOuts(YawBrRDxt) = DOT_PRODUCT( m%RtHS%AngPosXB, m%CoordSys%a1 )*R2D m%AllOuts(YawBrRDyt) = -DOT_PRODUCT( m%RtHS%AngPosXB, m%CoordSys%a3 )*R2D ! There is no sense computing m%AllOuts(YawBrRDzt) here since it is always zero for FAST simulation results. @@ -923,6 +1000,10 @@ SUBROUTINE ED_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) m%AllOuts( TwHtALyt(I) ) = -1.0*DOT_PRODUCT( LinAccET(:,p%TwrGagNd(I)), m%CoordSys%t3(p%TwrGagNd(I),:) ) m%AllOuts( TwHtALzt(I) ) = DOT_PRODUCT( LinAccET(:,p%TwrGagNd(I)), m%CoordSys%t2(p%TwrGagNd(I),:) ) + m%AllOuts( TwHtALgxt(I) ) = DOT_PRODUCT( LinAccET(:,p%TwrGagNd(I)) - gAccE, m%CoordSys%t1(p%TwrGagNd(I),:) ) + m%AllOuts( TwHtALgyt(I) ) = -1.0*DOT_PRODUCT( LinAccET(:,p%TwrGagNd(I)) - gAccE, m%CoordSys%t3(p%TwrGagNd(I),:) ) + m%AllOuts( TwHtALgzt(I) ) = DOT_PRODUCT( LinAccET(:,p%TwrGagNd(I)) - gAccE, m%CoordSys%t2(p%TwrGagNd(I),:) ) + rTPT = m%RtHS%rT0T(:,p%TwrGagNd(I)) - p%HNodes(p%TwrGagNd(I))*m%CoordSys%a2(:) m%AllOuts( TwHtTDxt(I) ) = DOT_PRODUCT( rTPT, m%CoordSys%a1 ) @@ -938,9 +1019,13 @@ SUBROUTINE ED_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) m%AllOuts( TwHtTPyi(I) ) = -1.0*m%RtHS%rT(3,p%TwrGagNd(I)) m%AllOuts( TwHtTPzi(I) ) = m%RtHS%rT(2,p%TwrGagNd(I)) + p%PtfmRefzt - m%AllOuts( TwHtRPxi(I) ) = m%RtHS%AngPosEF(1,p%TwrGagNd(I))*R2D - m%AllOuts( TwHtRPyi(I) ) = -m%RtHS%AngPosEF(3,p%TwrGagNd(I))*R2D - m%AllOuts( TwHtRPzi(I) ) = m%RtHS%AngPosEF(2,p%TwrGagNd(I))*R2D + ! m%AllOuts( TwHtRPxi(I) ) = m%RtHS%AngPosEF(1,p%TwrGagNd(I))*R2D + ! m%AllOuts( TwHtRPyi(I) ) = -m%RtHS%AngPosEF(3,p%TwrGagNd(I))*R2D + ! m%AllOuts( TwHtRPzi(I) ) = m%RtHS%AngPosEF(2,p%TwrGagNd(I))*R2D + + m%AllOuts( TwHtRPxi(I) ) = m%RtHS%AngPosEF(1,p%TwrGagNd(I))*R2D ! <- AngPosEF is now simply the roll, pitch, and yaw angles (possibly large) of each tower section + m%AllOuts( TwHtRPyi(I) ) = m%RtHS%AngPosEF(2,p%TwrGagNd(I))*R2D + m%AllOuts( TwHtRPzi(I) ) = m%RtHS%AngPosEF(3,p%TwrGagNd(I))*R2D END DO !I @@ -961,24 +1046,36 @@ SUBROUTINE ED_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) m%AllOuts( PtfmTAxt) = DOT_PRODUCT( LinAccEZ, m%CoordSys%a1 ) m%AllOuts( PtfmTAyt) = -DOT_PRODUCT( LinAccEZ, m%CoordSys%a3 ) m%AllOuts( PtfmTAzt) = DOT_PRODUCT( LinAccEZ, m%CoordSys%a2 ) + m%AllOuts( PtfmTAgxt) = DOT_PRODUCT( LinAccEZ - gAccE, m%CoordSys%a1 ) + m%AllOuts( PtfmTAgyt) = -DOT_PRODUCT( LinAccEZ - gAccE, m%CoordSys%a3 ) + m%AllOuts( PtfmTAgzt) = DOT_PRODUCT( LinAccEZ - gAccE, m%CoordSys%a2 ) m%AllOuts( PtfmTAxi) = m%QD2T(DOF_Sg ) m%AllOuts( PtfmTAyi) = m%QD2T(DOF_Sw ) m%AllOuts( PtfmTAzi) = m%QD2T(DOF_Hv ) + m%AllOuts( PtfmTAgxi) = m%QD2T(DOF_Sg ) + m%AllOuts( PtfmTAgyi) = m%QD2T(DOF_Sw ) + m%AllOuts( PtfmTAgzi) = m%QD2T(DOF_Hv ) + p%Gravity m%AllOuts( PtfmRDxi) = x%QT (DOF_R )*R2D m%AllOuts( PtfmRDyi) = x%QT (DOF_P )*R2D m%AllOuts( PtfmRDzi) = x%QT (DOF_Y )*R2D m%AllOuts( PtfmRVxt) = DOT_PRODUCT( m%RtHS%AngVelEX, m%CoordSys%a1 )*R2D m%AllOuts( PtfmRVyt) = -DOT_PRODUCT( m%RtHS%AngVelEX, m%CoordSys%a3 )*R2D m%AllOuts( PtfmRVzt) = DOT_PRODUCT( m%RtHS%AngVelEX, m%CoordSys%a2 )*R2D - m%AllOuts( PtfmRVxi) = x%QDT (DOF_R )*R2D - m%AllOuts( PtfmRVyi) = x%QDT (DOF_P )*R2D - m%AllOuts( PtfmRVzi) = x%QDT (DOF_Y )*R2D + ! m%AllOuts( PtfmRVxi) = x%QDT (DOF_R )*R2D + ! m%AllOuts( PtfmRVyi) = x%QDT (DOF_P )*R2D + ! m%AllOuts( PtfmRVzi) = x%QDT (DOF_Y )*R2D + m%AllOuts( PtfmRVxi) = m%RtHS%AngVelEX(1)*R2D + m%AllOuts( PtfmRVyi) = -m%RtHS%AngVelEX(3)*R2D + m%AllOuts( PtfmRVzi) = m%RtHS%AngVelEX(2)*R2D m%AllOuts( PtfmRAxt) = DOT_PRODUCT( AngAccEX, m%CoordSys%a1 )*R2D m%AllOuts( PtfmRAyt) = -DOT_PRODUCT( AngAccEX, m%CoordSys%a3 )*R2D m%AllOuts( PtfmRAzt) = DOT_PRODUCT( AngAccEX, m%CoordSys%a2 )*R2D - m%AllOuts( PtfmRAxi) = m%QD2T(DOF_R )*R2D - m%AllOuts( PtfmRAyi) = m%QD2T(DOF_P )*R2D - m%AllOuts( PtfmRAzi) = m%QD2T(DOF_Y )*R2D + ! m%AllOuts( PtfmRAxi) = m%QD2T(DOF_R )*R2D + ! m%AllOuts( PtfmRAyi) = m%QD2T(DOF_P )*R2D + ! m%AllOuts( PtfmRAzi) = m%QD2T(DOF_Y )*R2D + m%AllOuts( PtfmRAxi) = AngAccEX(1)*R2D + m%AllOuts( PtfmRAyi) = -AngAccEX(3)*R2D + m%AllOuts( PtfmRAzi) = AngAccEX(2)*R2D @@ -1149,7 +1246,13 @@ SUBROUTINE ED_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) m%AllOuts( YawBrMzn) = DOT_PRODUCT( MomBNcRt, m%CoordSys%d2 ) m%AllOuts( YawBrMxp) = DOT_PRODUCT( MomBNcRt, m%CoordSys%b1 ) m%AllOuts( YawBrMyp) = -DOT_PRODUCT( MomBNcRt, m%CoordSys%b3 ) - + m%AllOuts(YawFriMom) = OtherState%Mfhat*0.001_ReKi !KBF add YawFricMom as an output based on HSSBrTq (kN-m) + m%AllOuts(YawFriMfp) = OtherState%YawFriMfp*0.001_ReKi + m%AllOuts(YawFriMz) = m%YawFriMz*0.001_ReKi + m%FrcONcRt = (/m%AllOuts( YawBrFxn),m%AllOuts( YawBrFyn),m%AllOuts( YawBrFzn)/) * 1000_ReKi + m%MomONcRt = (/m%AllOuts( YawBrMxn),m%AllOuts( YawBrMyn),m%AllOuts( YawBrMzn)/) * 1000_ReKi + m%AllOuts(OmegaYF) = OtherState%OmegaTn*R2D + m%AllOuts(dOmegaYF) = OtherState%OmegaDotTn*R2D ! Tower Base Loads: @@ -1354,49 +1457,28 @@ SUBROUTINE ED_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) if (j==0) then ! blade root NodeNum = p%BldNodes + 2 - if (p%UseAD14) j2 = 1 elseif (j==p%TipNode) then ! blade tip NodeNum = p%BldNodes + 1 - if (p%UseAD14) j2 = p%BldNodes else NodeNum = J end if - if (p%UseAD14) then - ! Translational Displacement (first calculate absolute position) - y%BladeLn2Mesh(K)%TranslationDisp(1,NodeNum) = m%RtHS%rS (1,K,J2) + m%RtHS%rSAerCen(1,J2,K) ! = the distance from the undeflected tower centerline to the current blade aerodynamic center in the xi ( z1) direction - y%BladeLn2Mesh(K)%TranslationDisp(2,NodeNum) = -1.*m%RtHS%rS (3,K,J2) - m%RtHS%rSAerCen(3,J2,K) ! = the distance from the undeflected tower centerline to the current blade aerodynamic center in the yi (-z3) direction - y%BladeLn2Mesh(K)%TranslationDisp(3,NodeNum) = m%RtHS%rS (2,K,J2) + m%RtHS%rSAerCen(2,J2,K) + p%PtfmRefzt ! = the distance from the nominal tower base position (i.e., the undeflected position of the tower base) to the current blade aerodynamic center in the zi ( z2) direction - - ! Orientation - y%BladeLn2Mesh(K)%Orientation(1,1,NodeNum) = m%CoordSys%te1(K,J2,1) - y%BladeLn2Mesh(K)%Orientation(2,1,NodeNum) = m%CoordSys%te2(K,J2,1) - y%BladeLn2Mesh(K)%Orientation(3,1,NodeNum) = m%CoordSys%te3(K,J2,1) - y%BladeLn2Mesh(K)%Orientation(1,2,NodeNum) = -1.*m%CoordSys%te1(K,J2,3) - y%BladeLn2Mesh(K)%Orientation(2,2,NodeNum) = -1.*m%CoordSys%te2(K,J2,3) - y%BladeLn2Mesh(K)%Orientation(3,2,NodeNum) = -1.*m%CoordSys%te3(K,J2,3) - y%BladeLn2Mesh(K)%Orientation(1,3,NodeNum) = m%CoordSys%te1(K,J2,2) - y%BladeLn2Mesh(K)%Orientation(2,3,NodeNum) = m%CoordSys%te2(K,J2,2) - y%BladeLn2Mesh(K)%Orientation(3,3,NodeNum) = m%CoordSys%te3(K,J2,2) - - else - ! Translational Displacement (first calculate absolute position) - y%BladeLn2Mesh(K)%TranslationDisp(1,NodeNum) = m%RtHS%rS (1,K,J2) ! = the distance from the undeflected tower centerline to the current blade node in the xi ( z1) direction - y%BladeLn2Mesh(K)%TranslationDisp(2,NodeNum) = -1.*m%RtHS%rS (3,K,J2) ! = the distance from the undeflected tower centerline to the current blade node in the yi (-z3) direction - y%BladeLn2Mesh(K)%TranslationDisp(3,NodeNum) = m%RtHS%rS (2,K,J2) + p%PtfmRefzt ! = the distance from the nominal tower base position (i.e., the undeflected position of the tower base) to the current blade node in the zi ( z2) direction - - ! Orientation - y%BladeLn2Mesh(K)%Orientation(1,1,NodeNum) = m%CoordSys%n1(K,J2,1) - y%BladeLn2Mesh(K)%Orientation(2,1,NodeNum) = m%CoordSys%n2(K,J2,1) - y%BladeLn2Mesh(K)%Orientation(3,1,NodeNum) = m%CoordSys%n3(K,J2,1) - y%BladeLn2Mesh(K)%Orientation(1,2,NodeNum) = -1.*m%CoordSys%n1(K,J2,3) - y%BladeLn2Mesh(K)%Orientation(2,2,NodeNum) = -1.*m%CoordSys%n2(K,J2,3) - y%BladeLn2Mesh(K)%Orientation(3,2,NodeNum) = -1.*m%CoordSys%n3(K,J2,3) - y%BladeLn2Mesh(K)%Orientation(1,3,NodeNum) = m%CoordSys%n1(K,J2,2) - y%BladeLn2Mesh(K)%Orientation(2,3,NodeNum) = m%CoordSys%n2(K,J2,2) - y%BladeLn2Mesh(K)%Orientation(3,3,NodeNum) = m%CoordSys%n3(K,J2,2) - end if + ! Translational Displacement (first calculate absolute position) + y%BladeLn2Mesh(K)%TranslationDisp(1,NodeNum) = m%RtHS%rS (1,K,J2) ! = the distance from the undeflected tower centerline to the current blade node in the xi ( z1) direction + y%BladeLn2Mesh(K)%TranslationDisp(2,NodeNum) = -1.*m%RtHS%rS (3,K,J2) ! = the distance from the undeflected tower centerline to the current blade node in the yi (-z3) direction + y%BladeLn2Mesh(K)%TranslationDisp(3,NodeNum) = m%RtHS%rS (2,K,J2) + p%PtfmRefzt ! = the distance from the nominal tower base position (i.e., the undeflected position of the tower base) to the current blade node in the zi ( z2) direction + + ! Orientation + y%BladeLn2Mesh(K)%Orientation(1,1,NodeNum) = m%CoordSys%n1(K,J2,1) + y%BladeLn2Mesh(K)%Orientation(2,1,NodeNum) = m%CoordSys%n2(K,J2,1) + y%BladeLn2Mesh(K)%Orientation(3,1,NodeNum) = m%CoordSys%n3(K,J2,1) + y%BladeLn2Mesh(K)%Orientation(1,2,NodeNum) = -1.*m%CoordSys%n1(K,J2,3) + y%BladeLn2Mesh(K)%Orientation(2,2,NodeNum) = -1.*m%CoordSys%n2(K,J2,3) + y%BladeLn2Mesh(K)%Orientation(3,2,NodeNum) = -1.*m%CoordSys%n3(K,J2,3) + y%BladeLn2Mesh(K)%Orientation(1,3,NodeNum) = m%CoordSys%n1(K,J2,2) + y%BladeLn2Mesh(K)%Orientation(2,3,NodeNum) = m%CoordSys%n2(K,J2,2) + y%BladeLn2Mesh(K)%Orientation(3,3,NodeNum) = m%CoordSys%n3(K,J2,2) ! Translational Displacement (get displacement, not absolute position): y%BladeLn2Mesh(K)%TranslationDisp(:,NodeNum) = y%BladeLn2Mesh(K)%TranslationDisp(:,NodeNum) - y%BladeLn2Mesh(K)%Position(:,NodeNum) @@ -1500,90 +1582,7 @@ SUBROUTINE ED_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) END DO - !........... - ! Hub (for AeroDyn v14): - !........... - - ! the hub position should use rQ instead of rP, but AeroDyn 14 treats - ! teeter deflections like blade deflections: - - y%HubPtMotion14%TranslationDisp(1,1) = m%RtHS%rP(1) - y%HubPtMotion14%TranslationDisp(2,1) = -1.*m%RtHS%rP(3) - y%HubPtMotion14%TranslationDisp(3,1) = m%RtHS%rP(2) + p%PtfmRefzt - - y%HubPtMotion14%TranslationDisp = y%HubPtMotion14%TranslationDisp - y%HubPtMotion14%Position - - ! Hub orientation should use the g instead of e system, but the current version - ! of AeroDyn calculates forces normal and tangential to the cone of rotation - - y%HubPtMotion14%Orientation(1,1,1) = m%CoordSys%e1(1) - y%HubPtMotion14%Orientation(2,1,1) = m%CoordSys%e2(1) - y%HubPtMotion14%Orientation(3,1,1) = m%CoordSys%e3(1) - y%HubPtMotion14%Orientation(1,2,1) = -1.*m%CoordSys%e1(3) - y%HubPtMotion14%Orientation(2,2,1) = -1.*m%CoordSys%e2(3) - y%HubPtMotion14%Orientation(3,2,1) = -1.*m%CoordSys%e3(3) - y%HubPtMotion14%Orientation(1,3,1) = m%CoordSys%e1(2) - y%HubPtMotion14%Orientation(2,3,1) = m%CoordSys%e2(2) - y%HubPtMotion14%Orientation(3,3,1) = m%CoordSys%e3(2) - - ! Note the hub rotational velocity should be AngVelEH instead AngVelEL, but AeroDyn (13.00.00) - ! treats teeter deflections like blade deflections: - - y%HubPtMotion14%RotationVel(1,1) = m%RtHS%AngVelEL(1) - y%HubPtMotion14%RotationVel(2,1) = -1.*m%RtHS%AngVelEL(3) - y%HubPtMotion14%RotationVel(3,1) = m%RtHS%AngVelEL(2) - - !........... - ! Blade roots (AeroDyn v14): - !........... - - ! Blade root orientations should use the j instead of i system, but the current version - ! of AeroDyn calculates forces normal and tangential to the cone of rotation - - DO K=1,p%NumBl - - y%BladeRootMotion14%Orientation(1,1,K) = m%CoordSys%i1(K,1) - y%BladeRootMotion14%Orientation(2,1,K) = m%CoordSys%i2(K,1) - y%BladeRootMotion14%Orientation(3,1,K) = m%CoordSys%i3(K,1) - y%BladeRootMotion14%Orientation(1,2,K) = -1.*m%CoordSys%i1(K,3) - y%BladeRootMotion14%Orientation(2,2,K) = -1.*m%CoordSys%i2(K,3) - y%BladeRootMotion14%Orientation(3,2,K) = -1.*m%CoordSys%i3(K,3) - y%BladeRootMotion14%Orientation(1,3,K) = m%CoordSys%i1(K,2) - y%BladeRootMotion14%Orientation(2,3,K) = m%CoordSys%i2(K,2) - y%BladeRootMotion14%Orientation(3,3,K) = m%CoordSys%i3(K,2) - - END DO - - - !........... - ! Rotor furl: - !........... - - ! Rotor furl position should be rP instead of rV, but AeroDyn needs this for the HubVDue2Yaw calculation: - - y%RotorFurlMotion14%TranslationDisp(1,1) = m%RtHS%rV(1) - y%RotorFurlMotion14%TranslationDisp(2,1) = -1.*m%RtHS%rV(3) - y%RotorFurlMotion14%TranslationDisp(3,1) = m%RtHS%rV(2) + p%PtfmRefzt - - y%RotorFurlMotion14%TranslationDisp = y%RotorFurlMotion14%TranslationDisp - y%RotorFurlMotion14%Position - - ! Rotor furl orientation (note the different order than hub and blade root!) - - y%RotorFurlMotion14%Orientation(1,1,1) = m%CoordSys%c1(1) - y%RotorFurlMotion14%Orientation(2,1,1) = -1.*m%CoordSys%c3(1) - y%RotorFurlMotion14%Orientation(3,1,1) = m%CoordSys%c2(1) - y%RotorFurlMotion14%Orientation(1,2,1) = -1.*m%CoordSys%c1(3) - y%RotorFurlMotion14%Orientation(2,2,1) = m%CoordSys%c3(3) - y%RotorFurlMotion14%Orientation(3,2,1) = -1.*m%CoordSys%c2(3) - y%RotorFurlMotion14%Orientation(1,3,1) = m%CoordSys%c1(2) - y%RotorFurlMotion14%Orientation(2,3,1) = -1.*m%CoordSys%c3(2) - y%RotorFurlMotion14%Orientation(3,3,1) = m%CoordSys%c2(2) - - ! rotaional velocity: - y%RotorFurlMotion14%RotationVel(1,1) = m%RtHS%AngVelER(1) - y%RotorFurlMotion14%RotationVel(2,1) = -1.*m%RtHS%AngVelER(3) - y%RotorFurlMotion14%RotationVel(3,1) = m%RtHS%AngVelER(2) - + !........... ! TailFin : !........... @@ -1652,21 +1651,7 @@ SUBROUTINE ED_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) y%NacelleMotion%TranslationAcc(3,1) = LinAccEO(2) - !........... - ! Tower : - !........... - - ! Tower base position should be rT(0) instead of rZ, but AeroDyn needs this for the HubVDue2Yaw calculation: - y%TowerBaseMotion14%TranslationDisp(1,1) = m%RtHS%rZ(1) - y%TowerBaseMotion14%TranslationDisp(2,1) = -1.*m%RtHS%rZ(3) - y%TowerBaseMotion14%TranslationDisp(3,1) = m%RtHS%rZ(2) + p%PtfmRefzt - - y%TowerBaseMotion14%TranslationDisp = y%TowerBaseMotion14%TranslationDisp - y%TowerBaseMotion14%Position - - y%TowerBaseMotion14%RotationVel(1,1) = m%RtHS%AngVelEX(1) - y%TowerBaseMotion14%RotationVel(2,1) = -1.*m%RtHS%AngVelEX(3) - y%TowerBaseMotion14%RotationVel(3,1) = m%RtHS%AngVelEX(2) - + !............................................................................................................................... ! Outputs required for HydroDyn !............................................................................................................................... @@ -1675,28 +1660,37 @@ SUBROUTINE ED_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) y%PlatformPtMesh%TranslationDisp(2,1) = x%QT(DOF_Sw) y%PlatformPtMesh%TranslationDisp(3,1) = x%QT(DOF_Hv) - y%PlatformPtMesh%RotationVel(1,1) = x%QDT(DOF_R ) - y%PlatformPtMesh%RotationVel(2,1) = x%QDT(DOF_P ) - y%PlatformPtMesh%RotationVel(3,1) = x%QDT(DOF_Y ) + ! y%PlatformPtMesh%RotationVel(1,1) = x%QDT(DOF_R ) + ! y%PlatformPtMesh%RotationVel(2,1) = x%QDT(DOF_P ) + ! y%PlatformPtMesh%RotationVel(3,1) = x%QDT(DOF_Y ) + + y%PlatformPtMesh%RotationVel(1,1) = m%RtHS%AngVelEX(1) + y%PlatformPtMesh%RotationVel(2,1) = -1.*m%RtHS%AngVelEX(3) + y%PlatformPtMesh%RotationVel(3,1) = m%RtHS%AngVelEX(2) y%PlatformPtMesh%TranslationVel(1,1) = x%QDT(DOF_Sg) y%PlatformPtMesh%TranslationVel(2,1) = x%QDT(DOF_Sw) y%PlatformPtMesh%TranslationVel(3,1) = x%QDT(DOF_Hv) + ! CALL SmllRotTrans( 'platform displacement (ED_CalcOutput)', x%QT(DOF_R ),x%QT(DOF_P ),x%QT(DOF_Y ), & + ! y%PlatformPtMesh%Orientation(:,:,1), errstat=ErrStat, errmsg=ErrMsg ) + ! IF (ErrStat /= ErrID_None) ErrMsg = TRIM(ErrMsg)//' (occurred at '//TRIM(Num2LStr(t))//' s)' + ! !IF (ErrStat >= AbortErrLev) RETURN - CALL SmllRotTrans( 'platform displacement (ED_CalcOutput)', x%QT(DOF_R ),x%QT(DOF_P ),x%QT(DOF_Y ), & - y%PlatformPtMesh%Orientation(:,:,1), errstat=ErrStat, errmsg=ErrMsg ) - IF (ErrStat /= ErrID_None) ErrMsg = TRIM(ErrMsg)//' (occurred at '//TRIM(Num2LStr(t))//' s)' - !IF (ErrStat >= AbortErrLev) RETURN + y%PlatformPtMesh%Orientation(:,:,1) = EulerConstructZYX((/x%QT(DOF_R ),x%QT(DOF_P ),x%QT(DOF_Y )/)) - y%PlatformPtMesh%RotationAcc(1,1) = m%QD2T(DOF_R ) - y%PlatformPtMesh%RotationAcc(2,1) = m%QD2T(DOF_P ) - y%PlatformPtMesh%RotationAcc(3,1) = m%QD2T(DOF_Y ) + ! y%PlatformPtMesh%RotationAcc(1,1) = m%QD2T(DOF_R ) + ! y%PlatformPtMesh%RotationAcc(2,1) = m%QD2T(DOF_P ) + ! y%PlatformPtMesh%RotationAcc(3,1) = m%QD2T(DOF_Y ) + + y%PlatformPtMesh%RotationAcc(1,1) = AngAccEX(1) + y%PlatformPtMesh%RotationAcc(2,1) = -1.*AngAccEX(3) + y%PlatformPtMesh%RotationAcc(3,1) = AngAccEX(2) y%PlatformPtMesh%TranslationAcc(1,1) = m%QD2T(DOF_Sg) y%PlatformPtMesh%TranslationAcc(2,1) = m%QD2T(DOF_Sw) y%PlatformPtMesh%TranslationAcc(3,1) = m%QD2T(DOF_Hv) - + !............................................................................................................................... ! Outputs required for external tower loads !............................................................................................................................... @@ -1881,6 +1875,8 @@ SUBROUTINE ED_CalcContStateDeriv( t, u, p, x, xd, z, OtherState, m, dxdt, ErrSta INTEGER(IntKi) :: ErrStat2 ! The error status code CHARACTER(ErrMsgLen) :: ErrMsg2 ! The error message, if an error occurred CHARACTER(*), PARAMETER :: RoutineName = 'ED_CalcContStateDeriv' + Real(R8Ki) :: YawFriMz ! External loading on yaw bearing not including inertial contributions + ! Initialize ErrStat @@ -1902,10 +1898,12 @@ SUBROUTINE ED_CalcContStateDeriv( t, u, p, x, xd, z, OtherState, m, dxdt, ErrSta IF (ErrStat >= AbortErrLev) RETURN CALL CalculatePositions( p, x, m%CoordSys, m%RtHS ) ! calculate positions - CALL CalculateAngularPosVelPAcc(p, x, m%CoordSys, m%RtHS ) ! calculate angular positions, velocities, and partial accelerations, including partial angular quantities + CALL CalculateAngularPosVelPAcc(p, x, m%CoordSys, m%RtHS, ErrStat2, ErrMsg2 ) ! calculate angular positions, velocities, and partial accelerations, including partial angular quantities CALL CalculateLinearVelPAcc( p, x, m%CoordSys, m%RtHS ) ! calculate linear velocities and partial accelerations CALL CalculateForcesMoments( p, x, m%CoordSys, u, m%RtHS ) ! calculate the forces and moments (requires AeroBladeForces and AeroBladeMoments) - + call setErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + END IF !..................................... @@ -1918,6 +1916,12 @@ SUBROUTINE ED_CalcContStateDeriv( t, u, p, x, xd, z, OtherState, m, dxdt, ErrSta CALL Teeter ( t, p, m%RtHS%TeetAng, m%RtHS%TeetAngVel, m%RtHS%TeetMom ) ! Compute moment from teeter springs and dampers, TeetMom; NOTE: TeetMom will be zero for a 3-blader since TeetAng = TeetAngVel = 0 CALL RFurling( t, p, x%QT(DOF_RFrl), x%QDT(DOF_RFrl), m%RtHS%RFrlMom ) ! Compute moment from rotor-furl springs and dampers, RFrlMom CALL TFurling( t, p, x%QT(DOF_TFrl), x%QDT(DOF_TFrl), m%RtHS%TFrlMom ) ! Compute moment from tail-furl springs and dampers, TFrlMom + ! Compute the yaw friction torque + YawFriMz=DOT_PRODUCT( m%RtHS%MomBNcRtt, m%CoordSys%d2 ) + u%YawMom + m%YawFriMz = YawFriMz + + CALL YawFriction( t, p, m%FrcONcRt, m%MomONcRt, YawFriMz, OtherState%OmegaTn, OtherState%OmegaDotTn, m%RtHS%YawFriMom ) !Compute yaw Friction #RRD + !bjj: note m%RtHS%GBoxEffFac needed in OtherState only to fix HSSBrTrq (and used in FillAugMat) m%RtHS%GBoxEffFac = p%GBoxEff**OtherState%SgnPrvLSTQ ! = GBoxEff if SgnPrvLSTQ = 1 OR 1/GBoxEff if SgnPrvLSTQ = -1 @@ -3269,7 +3273,7 @@ SUBROUTINE SetPrimaryParameters( InitInp, p, InputFileData, ErrStat, ErrMsg ) p%DT = InputFileData%DT p%OverHang = InputFileData%OverHang p%ShftGagL = InputFileData%ShftGagL - IF ( InitInp%MHK == 1 ) THEN + IF ( InitInp%MHK == MHK_FixedBottom ) THEN p%TowerHt = InputFileData%TowerHt - InitInp%WtrDpth p%TowerBsHt = InputFileData%TowerBsHt - InitInp%WtrDpth p%PtfmRefzt = InputFileData%PtfmRefzt - InitInp%WtrDpth @@ -3287,6 +3291,9 @@ SUBROUTINE SetPrimaryParameters( InitInp, p, InputFileData, ErrStat, ErrMsg ) p%PtfmRIner = InputFileData%PtfmRIner p%PtfmPIner = InputFileData%PtfmPIner p%PtfmYIner = InputFileData%PtfmYIner + p%PtfmXYIner = InputFileData%PtfmXYIner + p%PtfmYZIner = InputFileData%PtfmYZIner + p%PtfmXZIner = InputFileData%PtfmXZIner p%GBoxEff = InputFileData%GBoxEff p%GBRatio = InputFileData%GBRatio p%DTTorSpr = InputFileData%DTTorSpr @@ -3326,6 +3333,18 @@ SUBROUTINE SetPrimaryParameters( InitInp, p, InputFileData, ErrStat, ErrMsg ) p%TeetHSSp = 0.0 END IF + ! Yaw friction model inputs + p%YawFrctMod = InputFileData%YawFrctMod + p%M_CD = InputFileData%M_CD + p%M_FCD = InputFileData%M_FCD + p%M_MCD = InputFileData%M_MCD + p%M_CSmax = InputFileData%M_CSmax + p%M_FCSmax = InputFileData%M_FCSmax + p%M_MCSmax = InputFileData%M_MCSmax + p%sig_v = InputFileData%sig_v + p%sig_v2 = InputFileData%sig_v2 + p%OmgCut = InputFileData%OmgCut + CALL AllocAry( p%TipMass, p%NumBl, 'TipMass', ErrStat, ErrMsg ) IF ( ErrStat >= AbortErrLev ) RETURN @@ -3358,7 +3377,7 @@ SUBROUTINE SetPrimaryParameters( InitInp, p, InputFileData, ErrStat, ErrMsg ) p%BldFlexL = p%TipRad - p%HubRad ! Length of the flexible portion of the blade. if (p%BD4Blades) p%BldFlexL = 0.0_ReKi - IF ( InitInp%MHK == 1 ) THEN + IF ( InitInp%MHK == MHK_FixedBottom ) THEN p%rZYzt = InputFileData%PtfmCMzt - InitInp%WtrDpth - p%PtfmRefzt ELSE p%rZYzt = InputFileData%PtfmCMzt - p%PtfmRefzt @@ -3437,7 +3456,6 @@ SUBROUTINE SetPrimaryParameters( InitInp, p, InputFileData, ErrStat, ErrMsg ) !p%NcIMUyn = InputFileData%NcIMUyn !p%NcIMUzn = InputFileData%NcIMUzn - ! plus everything else from FAST_Initialize @@ -3689,6 +3707,10 @@ SUBROUTINE Init_MiscOtherStates( m, OtherState, p, x, InputFileData, ErrStat, Er OtherState%HSSBrTrqC = 0.0_ReKi OtherState%SgnPrvLSTQ = 1 OtherState%SgnLSTQ = 1 + OtherState%OmegaTn = 0.0_R8Ki + OtherState%OmegaDotTn = 0.0_R8Ki + OtherState%Mfhat = 0.0_ReKi + OtherState%YawFriMfp = 0.0_ReKi END SUBROUTINE Init_MiscOtherStates @@ -3706,404 +3728,512 @@ END SUBROUTINE Init_MiscOtherStates !! 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 25-Jan-2021 13:23:51. +!! This routine was generated by Write_ChckOutLst.m using the parameters listed in OutListParameters.xlsx. SUBROUTINE SetOutParam(OutList, p, ErrStat, ErrMsg ) !.................................................................................................................................. - + IMPLICIT NONE - + ! Passed variables - - CHARACTER(ChanLen), INTENT(IN) :: OutList(:) !< The list out user-requested outputs + + CHARACTER(ChanLen), INTENT(IN) :: OutList(:) !< The list of user-requested outputs TYPE(ED_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 - INTEGER :: startIndx ! Index for BeamDyn - - LOGICAL :: CheckOutListAgain ! Flag used to determine if output parameter starting with "M" is valid (or the negative of another parameter) + INTEGER :: startIndx ! Index for using BeamDyn for Blades 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(981) = (/ & ! This lists the names of the allowed parameters, which must be sorted alphabetically - "AZIMUTH ","BLDPITCH1","BLDPITCH2","BLDPITCH3","BLPITCH1 ","BLPITCH2 ","BLPITCH3 ","GENACCEL ", & - "GENSPEED ","HSSBRTQ ","HSSHFTA ","HSSHFTPWR","HSSHFTTQ ","HSSHFTV ","IPDEFL1 ","IPDEFL2 ", & - "IPDEFL3 ","LSSGAGA ","LSSGAGAXA","LSSGAGAXS","LSSGAGFXA","LSSGAGFXS","LSSGAGFYA","LSSGAGFYS", & - "LSSGAGFZA","LSSGAGFZS","LSSGAGMXA","LSSGAGMXS","LSSGAGMYA","LSSGAGMYS","LSSGAGMZA","LSSGAGMZS", & - "LSSGAGP ","LSSGAGPXA","LSSGAGPXS","LSSGAGV ","LSSGAGVXA","LSSGAGVXS","LSSHFTFXA","LSSHFTFXS", & - "LSSHFTFYA","LSSHFTFYS","LSSHFTFZA","LSSHFTFZS","LSSHFTMXA","LSSHFTMXS","LSSHFTPWR","LSSHFTTQ ", & - "LSSTIPA ","LSSTIPAXA","LSSTIPAXS","LSSTIPMYA","LSSTIPMYS","LSSTIPMZA","LSSTIPMZS","LSSTIPP ", & - "LSSTIPPXA","LSSTIPPXS","LSSTIPV ","LSSTIPVXA","LSSTIPVXS","NACYAW ","NACYAWA ","NACYAWP ", & - "NACYAWV ","NCIMURAXS","NCIMURAYS","NCIMURAZS","NCIMURVXS","NCIMURVYS","NCIMURVZS","NCIMUTAXS", & - "NCIMUTAYS","NCIMUTAZS","NCIMUTVXS","NCIMUTVYS","NCIMUTVZS","OOPDEFL1 ","OOPDEFL2 ","OOPDEFL3 ", & - "PTCHDEFL1","PTCHDEFL2","PTCHDEFL3","PTCHPMZB1","PTCHPMZB2","PTCHPMZB3","PTCHPMZC1","PTCHPMZC2", & - "PTCHPMZC3","PTFMHEAVE","PTFMPITCH","PTFMRAXI ","PTFMRAXT ","PTFMRAYI ","PTFMRAYT ","PTFMRAZI ", & - "PTFMRAZT ","PTFMRDXI ","PTFMRDYI ","PTFMRDZI ","PTFMROLL ","PTFMRVXI ","PTFMRVXT ","PTFMRVYI ", & - "PTFMRVYT ","PTFMRVZI ","PTFMRVZT ","PTFMSURGE","PTFMSWAY ","PTFMTAXI ","PTFMTAXT ","PTFMTAYI ", & - "PTFMTAYT ","PTFMTAZI ","PTFMTAZT ","PTFMTDXI ","PTFMTDXT ","PTFMTDYI ","PTFMTDYT ","PTFMTDZI ", & - "PTFMTDZT ","PTFMTVXI ","PTFMTVXT ","PTFMTVYI ","PTFMTVYT ","PTFMTVZI ","PTFMTVZT ","PTFMYAW ", & - "QD2_B1E1 ","QD2_B1F1 ","QD2_B1F2 ","QD2_B2E1 ","QD2_B2F1 ","QD2_B2F2 ","QD2_B3E1 ","QD2_B3F1 ", & - "QD2_B3F2 ","QD2_DRTR ","QD2_GEAZ ","QD2_HV ","QD2_P ","QD2_R ","QD2_RFRL ","QD2_SG ", & - "QD2_SW ","QD2_TEET ","QD2_TFA1 ","QD2_TFA2 ","QD2_TFRL ","QD2_TSS1 ","QD2_TSS2 ","QD2_Y ", & - "QD2_YAW ","QD_B1E1 ","QD_B1F1 ","QD_B1F2 ","QD_B2E1 ","QD_B2F1 ","QD_B2F2 ","QD_B3E1 ", & - "QD_B3F1 ","QD_B3F2 ","QD_DRTR ","QD_GEAZ ","QD_HV ","QD_P ","QD_R ","QD_RFRL ", & - "QD_SG ","QD_SW ","QD_TEET ","QD_TFA1 ","QD_TFA2 ","QD_TFRL ","QD_TSS1 ","QD_TSS2 ", & - "QD_Y ","QD_YAW ","Q_B1E1 ","Q_B1F1 ","Q_B1F2 ","Q_B2E1 ","Q_B2F1 ","Q_B2F2 ", & - "Q_B3E1 ","Q_B3F1 ","Q_B3F2 ","Q_DRTR ","Q_GEAZ ","Q_HV ","Q_P ","Q_R ", & - "Q_RFRL ","Q_SG ","Q_SW ","Q_TEET ","Q_TFA1 ","Q_TFA2 ","Q_TFRL ","Q_TSS1 ", & - "Q_TSS2 ","Q_Y ","Q_YAW ","RFRLBRM ","ROLLDEFL1","ROLLDEFL2","ROLLDEFL3","ROOTFXB1 ", & - "ROOTFXB2 ","ROOTFXB3 ","ROOTFXC1 ","ROOTFXC2 ","ROOTFXC3 ","ROOTFYB1 ","ROOTFYB2 ","ROOTFYB3 ", & - "ROOTFYC1 ","ROOTFYC2 ","ROOTFYC3 ","ROOTFZB1 ","ROOTFZB2 ","ROOTFZB3 ","ROOTFZC1 ","ROOTFZC2 ", & - "ROOTFZC3 ","ROOTMEDG1","ROOTMEDG2","ROOTMEDG3","ROOTMFLP1","ROOTMFLP2","ROOTMFLP3","ROOTMIP1 ", & - "ROOTMIP2 ","ROOTMIP3 ","ROOTMOOP1","ROOTMOOP2","ROOTMOOP3","ROOTMXB1 ","ROOTMXB2 ","ROOTMXB3 ", & - "ROOTMXC1 ","ROOTMXC2 ","ROOTMXC3 ","ROOTMYB1 ","ROOTMYB2 ","ROOTMYB3 ","ROOTMYC1 ","ROOTMYC2 ", & - "ROOTMYC3 ","ROOTMZB1 ","ROOTMZB2 ","ROOTMZB3 ","ROOTMZC1 ","ROOTMZC2 ","ROOTMZC3 ","ROTACCEL ", & - "ROTFURL ","ROTFURLA ","ROTFURLP ","ROTFURLV ","ROTPWR ","ROTSPEED ","ROTTEETA ","ROTTEETP ", & - "ROTTEETV ","ROTTHRUST","ROTTORQ ","SPN1ALXB1","SPN1ALXB2","SPN1ALXB3","SPN1ALYB1","SPN1ALYB2", & - "SPN1ALYB3","SPN1ALZB1","SPN1ALZB2","SPN1ALZB3","SPN1FLXB1","SPN1FLXB2","SPN1FLXB3","SPN1FLYB1", & - "SPN1FLYB2","SPN1FLYB3","SPN1FLZB1","SPN1FLZB2","SPN1FLZB3","SPN1MLXB1","SPN1MLXB2","SPN1MLXB3", & - "SPN1MLYB1","SPN1MLYB2","SPN1MLYB3","SPN1MLZB1","SPN1MLZB2","SPN1MLZB3","SPN1RDXB1","SPN1RDXB2", & - "SPN1RDXB3","SPN1RDYB1","SPN1RDYB2","SPN1RDYB3","SPN1RDZB1","SPN1RDZB2","SPN1RDZB3","SPN1TDXB1", & - "SPN1TDXB2","SPN1TDXB3","SPN1TDYB1","SPN1TDYB2","SPN1TDYB3","SPN1TDZB1","SPN1TDZB2","SPN1TDZB3", & - "SPN2ALXB1","SPN2ALXB2","SPN2ALXB3","SPN2ALYB1","SPN2ALYB2","SPN2ALYB3","SPN2ALZB1","SPN2ALZB2", & - "SPN2ALZB3","SPN2FLXB1","SPN2FLXB2","SPN2FLXB3","SPN2FLYB1","SPN2FLYB2","SPN2FLYB3","SPN2FLZB1", & - "SPN2FLZB2","SPN2FLZB3","SPN2MLXB1","SPN2MLXB2","SPN2MLXB3","SPN2MLYB1","SPN2MLYB2","SPN2MLYB3", & - "SPN2MLZB1","SPN2MLZB2","SPN2MLZB3","SPN2RDXB1","SPN2RDXB2","SPN2RDXB3","SPN2RDYB1","SPN2RDYB2", & - "SPN2RDYB3","SPN2RDZB1","SPN2RDZB2","SPN2RDZB3","SPN2TDXB1","SPN2TDXB2","SPN2TDXB3","SPN2TDYB1", & - "SPN2TDYB2","SPN2TDYB3","SPN2TDZB1","SPN2TDZB2","SPN2TDZB3","SPN3ALXB1","SPN3ALXB2","SPN3ALXB3", & - "SPN3ALYB1","SPN3ALYB2","SPN3ALYB3","SPN3ALZB1","SPN3ALZB2","SPN3ALZB3","SPN3FLXB1","SPN3FLXB2", & - "SPN3FLXB3","SPN3FLYB1","SPN3FLYB2","SPN3FLYB3","SPN3FLZB1","SPN3FLZB2","SPN3FLZB3","SPN3MLXB1", & - "SPN3MLXB2","SPN3MLXB3","SPN3MLYB1","SPN3MLYB2","SPN3MLYB3","SPN3MLZB1","SPN3MLZB2","SPN3MLZB3", & - "SPN3RDXB1","SPN3RDXB2","SPN3RDXB3","SPN3RDYB1","SPN3RDYB2","SPN3RDYB3","SPN3RDZB1","SPN3RDZB2", & - "SPN3RDZB3","SPN3TDXB1","SPN3TDXB2","SPN3TDXB3","SPN3TDYB1","SPN3TDYB2","SPN3TDYB3","SPN3TDZB1", & - "SPN3TDZB2","SPN3TDZB3","SPN4ALXB1","SPN4ALXB2","SPN4ALXB3","SPN4ALYB1","SPN4ALYB2","SPN4ALYB3", & - "SPN4ALZB1","SPN4ALZB2","SPN4ALZB3","SPN4FLXB1","SPN4FLXB2","SPN4FLXB3","SPN4FLYB1","SPN4FLYB2", & - "SPN4FLYB3","SPN4FLZB1","SPN4FLZB2","SPN4FLZB3","SPN4MLXB1","SPN4MLXB2","SPN4MLXB3","SPN4MLYB1", & - "SPN4MLYB2","SPN4MLYB3","SPN4MLZB1","SPN4MLZB2","SPN4MLZB3","SPN4RDXB1","SPN4RDXB2","SPN4RDXB3", & - "SPN4RDYB1","SPN4RDYB2","SPN4RDYB3","SPN4RDZB1","SPN4RDZB2","SPN4RDZB3","SPN4TDXB1","SPN4TDXB2", & - "SPN4TDXB3","SPN4TDYB1","SPN4TDYB2","SPN4TDYB3","SPN4TDZB1","SPN4TDZB2","SPN4TDZB3","SPN5ALXB1", & - "SPN5ALXB2","SPN5ALXB3","SPN5ALYB1","SPN5ALYB2","SPN5ALYB3","SPN5ALZB1","SPN5ALZB2","SPN5ALZB3", & - "SPN5FLXB1","SPN5FLXB2","SPN5FLXB3","SPN5FLYB1","SPN5FLYB2","SPN5FLYB3","SPN5FLZB1","SPN5FLZB2", & - "SPN5FLZB3","SPN5MLXB1","SPN5MLXB2","SPN5MLXB3","SPN5MLYB1","SPN5MLYB2","SPN5MLYB3","SPN5MLZB1", & - "SPN5MLZB2","SPN5MLZB3","SPN5RDXB1","SPN5RDXB2","SPN5RDXB3","SPN5RDYB1","SPN5RDYB2","SPN5RDYB3", & - "SPN5RDZB1","SPN5RDZB2","SPN5RDZB3","SPN5TDXB1","SPN5TDXB2","SPN5TDXB3","SPN5TDYB1","SPN5TDYB2", & - "SPN5TDYB3","SPN5TDZB1","SPN5TDZB2","SPN5TDZB3","SPN6ALXB1","SPN6ALXB2","SPN6ALXB3","SPN6ALYB1", & - "SPN6ALYB2","SPN6ALYB3","SPN6ALZB1","SPN6ALZB2","SPN6ALZB3","SPN6FLXB1","SPN6FLXB2","SPN6FLXB3", & - "SPN6FLYB1","SPN6FLYB2","SPN6FLYB3","SPN6FLZB1","SPN6FLZB2","SPN6FLZB3","SPN6MLXB1","SPN6MLXB2", & - "SPN6MLXB3","SPN6MLYB1","SPN6MLYB2","SPN6MLYB3","SPN6MLZB1","SPN6MLZB2","SPN6MLZB3","SPN6RDXB1", & - "SPN6RDXB2","SPN6RDXB3","SPN6RDYB1","SPN6RDYB2","SPN6RDYB3","SPN6RDZB1","SPN6RDZB2","SPN6RDZB3", & - "SPN6TDXB1","SPN6TDXB2","SPN6TDXB3","SPN6TDYB1","SPN6TDYB2","SPN6TDYB3","SPN6TDZB1","SPN6TDZB2", & - "SPN6TDZB3","SPN7ALXB1","SPN7ALXB2","SPN7ALXB3","SPN7ALYB1","SPN7ALYB2","SPN7ALYB3","SPN7ALZB1", & - "SPN7ALZB2","SPN7ALZB3","SPN7FLXB1","SPN7FLXB2","SPN7FLXB3","SPN7FLYB1","SPN7FLYB2","SPN7FLYB3", & - "SPN7FLZB1","SPN7FLZB2","SPN7FLZB3","SPN7MLXB1","SPN7MLXB2","SPN7MLXB3","SPN7MLYB1","SPN7MLYB2", & - "SPN7MLYB3","SPN7MLZB1","SPN7MLZB2","SPN7MLZB3","SPN7RDXB1","SPN7RDXB2","SPN7RDXB3","SPN7RDYB1", & - "SPN7RDYB2","SPN7RDYB3","SPN7RDZB1","SPN7RDZB2","SPN7RDZB3","SPN7TDXB1","SPN7TDXB2","SPN7TDXB3", & - "SPN7TDYB1","SPN7TDYB2","SPN7TDYB3","SPN7TDZB1","SPN7TDZB2","SPN7TDZB3","SPN8ALXB1","SPN8ALXB2", & - "SPN8ALXB3","SPN8ALYB1","SPN8ALYB2","SPN8ALYB3","SPN8ALZB1","SPN8ALZB2","SPN8ALZB3","SPN8FLXB1", & - "SPN8FLXB2","SPN8FLXB3","SPN8FLYB1","SPN8FLYB2","SPN8FLYB3","SPN8FLZB1","SPN8FLZB2","SPN8FLZB3", & - "SPN8MLXB1","SPN8MLXB2","SPN8MLXB3","SPN8MLYB1","SPN8MLYB2","SPN8MLYB3","SPN8MLZB1","SPN8MLZB2", & - "SPN8MLZB3","SPN8RDXB1","SPN8RDXB2","SPN8RDXB3","SPN8RDYB1","SPN8RDYB2","SPN8RDYB3","SPN8RDZB1", & - "SPN8RDZB2","SPN8RDZB3","SPN8TDXB1","SPN8TDXB2","SPN8TDXB3","SPN8TDYB1","SPN8TDYB2","SPN8TDYB3", & - "SPN8TDZB1","SPN8TDZB2","SPN8TDZB3","SPN9ALXB1","SPN9ALXB2","SPN9ALXB3","SPN9ALYB1","SPN9ALYB2", & - "SPN9ALYB3","SPN9ALZB1","SPN9ALZB2","SPN9ALZB3","SPN9FLXB1","SPN9FLXB2","SPN9FLXB3","SPN9FLYB1", & - "SPN9FLYB2","SPN9FLYB3","SPN9FLZB1","SPN9FLZB2","SPN9FLZB3","SPN9MLXB1","SPN9MLXB2","SPN9MLXB3", & - "SPN9MLYB1","SPN9MLYB2","SPN9MLYB3","SPN9MLZB1","SPN9MLZB2","SPN9MLZB3","SPN9RDXB1","SPN9RDXB2", & - "SPN9RDXB3","SPN9RDYB1","SPN9RDYB2","SPN9RDYB3","SPN9RDZB1","SPN9RDZB2","SPN9RDZB3","SPN9TDXB1", & - "SPN9TDXB2","SPN9TDXB3","SPN9TDYB1","SPN9TDYB2","SPN9TDYB3","SPN9TDZB1","SPN9TDZB2","SPN9TDZB3", & - "TAILFURL ","TAILFURLA","TAILFURLP","TAILFURLV","TEETAYA ","TEETDEFL ","TEETPYA ","TEETVYA ", & - "TFRLBRM ","TIP2TWR1 ","TIP2TWR2 ","TIP2TWR3 ","TIPALXB1 ","TIPALXB2 ","TIPALXB3 ","TIPALYB1 ", & - "TIPALYB2 ","TIPALYB3 ","TIPALZB1 ","TIPALZB2 ","TIPALZB3 ","TIPCLRNC1","TIPCLRNC2","TIPCLRNC3", & - "TIPDXB1 ","TIPDXB2 ","TIPDXB3 ","TIPDXC1 ","TIPDXC2 ","TIPDXC3 ","TIPDYB1 ","TIPDYB2 ", & - "TIPDYB3 ","TIPDYC1 ","TIPDYC2 ","TIPDYC3 ","TIPDZB1 ","TIPDZB2 ","TIPDZB3 ","TIPDZC1 ", & - "TIPDZC2 ","TIPDZC3 ","TIPRDXB1 ","TIPRDXB2 ","TIPRDXB3 ","TIPRDYB1 ","TIPRDYB2 ","TIPRDYB3 ", & - "TIPRDZB1 ","TIPRDZB2 ","TIPRDZB3 ","TIPRDZC1 ","TIPRDZC2 ","TIPRDZC3 ","TTDSPAX ","TTDSPFA ", & - "TTDSPPTCH","TTDSPROLL","TTDSPSS ","TTDSPTWST","TWHT1ALXT","TWHT1ALYT","TWHT1ALZT","TWHT1FLXT", & - "TWHT1FLYT","TWHT1FLZT","TWHT1MLXT","TWHT1MLYT","TWHT1MLZT","TWHT1RDXT","TWHT1RDYT","TWHT1RDZT", & - "TWHT1RPXI","TWHT1RPYI","TWHT1RPZI","TWHT1TDXT","TWHT1TDYT","TWHT1TDZT","TWHT1TPXI","TWHT1TPYI", & - "TWHT1TPZI","TWHT2ALXT","TWHT2ALYT","TWHT2ALZT","TWHT2FLXT","TWHT2FLYT","TWHT2FLZT","TWHT2MLXT", & - "TWHT2MLYT","TWHT2MLZT","TWHT2RDXT","TWHT2RDYT","TWHT2RDZT","TWHT2RPXI","TWHT2RPYI","TWHT2RPZI", & - "TWHT2TDXT","TWHT2TDYT","TWHT2TDZT","TWHT2TPXI","TWHT2TPYI","TWHT2TPZI","TWHT3ALXT","TWHT3ALYT", & - "TWHT3ALZT","TWHT3FLXT","TWHT3FLYT","TWHT3FLZT","TWHT3MLXT","TWHT3MLYT","TWHT3MLZT","TWHT3RDXT", & - "TWHT3RDYT","TWHT3RDZT","TWHT3RPXI","TWHT3RPYI","TWHT3RPZI","TWHT3TDXT","TWHT3TDYT","TWHT3TDZT", & - "TWHT3TPXI","TWHT3TPYI","TWHT3TPZI","TWHT4ALXT","TWHT4ALYT","TWHT4ALZT","TWHT4FLXT","TWHT4FLYT", & - "TWHT4FLZT","TWHT4MLXT","TWHT4MLYT","TWHT4MLZT","TWHT4RDXT","TWHT4RDYT","TWHT4RDZT","TWHT4RPXI", & - "TWHT4RPYI","TWHT4RPZI","TWHT4TDXT","TWHT4TDYT","TWHT4TDZT","TWHT4TPXI","TWHT4TPYI","TWHT4TPZI", & - "TWHT5ALXT","TWHT5ALYT","TWHT5ALZT","TWHT5FLXT","TWHT5FLYT","TWHT5FLZT","TWHT5MLXT","TWHT5MLYT", & - "TWHT5MLZT","TWHT5RDXT","TWHT5RDYT","TWHT5RDZT","TWHT5RPXI","TWHT5RPYI","TWHT5RPZI","TWHT5TDXT", & - "TWHT5TDYT","TWHT5TDZT","TWHT5TPXI","TWHT5TPYI","TWHT5TPZI","TWHT6ALXT","TWHT6ALYT","TWHT6ALZT", & - "TWHT6FLXT","TWHT6FLYT","TWHT6FLZT","TWHT6MLXT","TWHT6MLYT","TWHT6MLZT","TWHT6RDXT","TWHT6RDYT", & - "TWHT6RDZT","TWHT6RPXI","TWHT6RPYI","TWHT6RPZI","TWHT6TDXT","TWHT6TDYT","TWHT6TDZT","TWHT6TPXI", & - "TWHT6TPYI","TWHT6TPZI","TWHT7ALXT","TWHT7ALYT","TWHT7ALZT","TWHT7FLXT","TWHT7FLYT","TWHT7FLZT", & - "TWHT7MLXT","TWHT7MLYT","TWHT7MLZT","TWHT7RDXT","TWHT7RDYT","TWHT7RDZT","TWHT7RPXI","TWHT7RPYI", & - "TWHT7RPZI","TWHT7TDXT","TWHT7TDYT","TWHT7TDZT","TWHT7TPXI","TWHT7TPYI","TWHT7TPZI","TWHT8ALXT", & - "TWHT8ALYT","TWHT8ALZT","TWHT8FLXT","TWHT8FLYT","TWHT8FLZT","TWHT8MLXT","TWHT8MLYT","TWHT8MLZT", & - "TWHT8RDXT","TWHT8RDYT","TWHT8RDZT","TWHT8RPXI","TWHT8RPYI","TWHT8RPZI","TWHT8TDXT","TWHT8TDYT", & - "TWHT8TDZT","TWHT8TPXI","TWHT8TPYI","TWHT8TPZI","TWHT9ALXT","TWHT9ALYT","TWHT9ALZT","TWHT9FLXT", & - "TWHT9FLYT","TWHT9FLZT","TWHT9MLXT","TWHT9MLYT","TWHT9MLZT","TWHT9RDXT","TWHT9RDYT","TWHT9RDZT", & - "TWHT9RPXI","TWHT9RPYI","TWHT9RPZI","TWHT9TDXT","TWHT9TDYT","TWHT9TDZT","TWHT9TPXI","TWHT9TPYI", & - "TWHT9TPZI","TWRBSFXT ","TWRBSFYT ","TWRBSFZT ","TWRBSMXT ","TWRBSMYT ","TWRBSMZT ","TWRCLRNC1", & - "TWRCLRNC2","TWRCLRNC3","TWRTPTDXI","TWRTPTDYI","TWRTPTDZI","TWSTDEFL1","TWSTDEFL2","TWSTDEFL3", & - "YAWACCEL ","YAWAZN ","YAWAZP ","YAWBRFXN ","YAWBRFXP ","YAWBRFYN ","YAWBRFYP ","YAWBRFZN ", & - "YAWBRFZP ","YAWBRMXN ","YAWBRMXP ","YAWBRMYN ","YAWBRMYP ","YAWBRMZN ","YAWBRMZP ","YAWBRRAXP", & - "YAWBRRAYP","YAWBRRAZP","YAWBRRDXT","YAWBRRDYT","YAWBRRDZT","YAWBRRVXP","YAWBRRVYP","YAWBRRVZP", & - "YAWBRTAXP","YAWBRTAYP","YAWBRTAZP","YAWBRTDXI","YAWBRTDXP","YAWBRTDXT","YAWBRTDYI","YAWBRTDYP", & - "YAWBRTDYT","YAWBRTDZI","YAWBRTDZP","YAWBRTDZT","YAWBRTVXP","YAWBRTVYP","YAWBRTVZP","YAWPOS ", & - "YAWPZN ","YAWPZP ","YAWRATE ","YAWVZN ","YAWVZP "/) - INTEGER(IntKi), PARAMETER :: ParamIndxAry(981) = (/ & ! This lists the index into AllOuts(:) of the allowed parameters ValidParamAry(:) - LSSTipPxa , PtchPMzc1 , PtchPMzc2 , PtchPMzc3 , PtchPMzc1 , PtchPMzc2 , PtchPMzc3 , HSShftA , & - HSShftV , HSSBrTq , HSShftA , HSShftPwr , HSShftTq , HSShftV , TipDyc1 , TipDyc2 , & - TipDyc3 , LSSGagAxa , LSSGagAxa , LSSGagAxa , LSShftFxa , LSShftFxa , LSShftFya , LSShftFys , & - LSShftFza , LSShftFzs , LSShftMxa , LSShftMxa , LSSGagMya , LSSGagMys , LSSGagMza , LSSGagMzs , & - LSSGagPxa , LSSGagPxa , LSSGagPxa , LSSGagVxa , LSSGagVxa , LSSGagVxa , LSShftFxa , LSShftFxa , & - LSShftFya , LSShftFys , LSShftFza , LSShftFzs , LSShftMxa , LSShftMxa , RotPwr , LSShftMxa , & - LSSTipAxa , LSSTipAxa , LSSTipAxa , LSSTipMya , LSSTipMys , LSSTipMza , LSSTipMzs , LSSTipPxa , & - LSSTipPxa , LSSTipPxa , LSSTipVxa , LSSTipVxa , LSSTipVxa , YawPzn , YawAzn , YawPzn , & - YawVzn , NcIMURAxs , NcIMURAys , NcIMURAzs , NcIMURVxs , NcIMURVys , NcIMURVzs , NcIMUTAxs , & - NcIMUTAys , NcIMUTAzs , NcIMUTVxs , NcIMUTVys , NcIMUTVzs , TipDxc1 , TipDxc2 , TipDxc3 , & - TipRDyb1 , TipRDyb2 , TipRDyb3 , PtchPMzc1 , PtchPMzc2 , PtchPMzc3 , PtchPMzc1 , PtchPMzc2 , & - PtchPMzc3 , PtfmTDzi , PtfmRDyi , PtfmRAxi , PtfmRAxt , PtfmRAyi , PtfmRAyt , PtfmRAzi , & - PtfmRAzt , PtfmRDxi , PtfmRDyi , PtfmRDzi , PtfmRDxi , PtfmRVxi , PtfmRVxt , PtfmRVyi , & - PtfmRVyt , PtfmRVzi , PtfmRVzt , PtfmTDxi , PtfmTDyi , PtfmTAxi , PtfmTAxt , PtfmTAyi , & - PtfmTAyt , PtfmTAzi , PtfmTAzt , PtfmTDxi , PtfmTDxt , PtfmTDyi , PtfmTDyt , PtfmTDzi , & - PtfmTDzt , PtfmTVxi , PtfmTVxt , PtfmTVyi , PtfmTVyt , PtfmTVzi , PtfmTVzt , PtfmRDzi , & - QD2_B1E1 , QD2_B1F1 , QD2_B1F2 , QD2_B2E1 , QD2_B2F1 , QD2_B2F2 , QD2_B3E1 , QD2_B3F1 , & - QD2_B3F2 , QD2_DrTr , QD2_GeAz , QD2_Hv , QD2_P , QD2_R , QD2_RFrl , QD2_Sg , & - QD2_Sw , QD2_Teet , QD2_TFA1 , QD2_TFA2 , QD2_TFrl , QD2_TSS1 , QD2_TSS2 , QD2_Y , & - QD2_Yaw , QD_B1E1 , QD_B1F1 , QD_B1F2 , QD_B2E1 , QD_B2F1 , QD_B2F2 , QD_B3E1 , & - QD_B3F1 , QD_B3F2 , QD_DrTr , QD_GeAz , QD_Hv , QD_P , QD_R , QD_RFrl , & - QD_Sg , QD_Sw , QD_Teet , QD_TFA1 , QD_TFA2 , QD_TFrl , QD_TSS1 , QD_TSS2 , & - QD_Y , QD_Yaw , Q_B1E1 , Q_B1F1 , Q_B1F2 , Q_B2E1 , Q_B2F1 , Q_B2F2 , & - Q_B3E1 , Q_B3F1 , Q_B3F2 , Q_DrTr , Q_GeAz , Q_Hv , Q_P , Q_R , & - Q_RFrl , Q_Sg , Q_Sw , Q_Teet , Q_TFA1 , Q_TFA2 , Q_TFrl , Q_TSS1 , & - Q_TSS2 , Q_Y , Q_Yaw , RFrlBrM , TipRDxb1 , TipRDxb2 , TipRDxb3 , RootFxb1 , & - RootFxb2 , RootFxb3 , RootFxc1 , RootFxc2 , RootFxc3 , RootFyb1 , RootFyb2 , RootFyb3 , & - RootFyc1 , RootFyc2 , RootFyc3 , RootFzc1 , RootFzc2 , RootFzc3 , RootFzc1 , RootFzc2 , & - RootFzc3 , RootMxb1 , RootMxb2 , RootMxb3 , RootMyb1 , RootMyb2 , RootMyb3 , RootMxc1 , & - RootMxc2 , RootMxc3 , RootMyc1 , RootMyc2 , RootMyc3 , RootMxb1 , RootMxb2 , RootMxb3 , & - RootMxc1 , RootMxc2 , RootMxc3 , RootMyb1 , RootMyb2 , RootMyb3 , RootMyc1 , RootMyc2 , & - RootMyc3 , RootMzc1 , RootMzc2 , RootMzc3 , RootMzc1 , RootMzc2 , RootMzc3 , LSSTipAxa , & - RotFurlP , RotFurlA , RotFurlP , RotFurlV , RotPwr , LSSTipVxa , TeetAya , TeetPya , & - TeetVya , LSShftFxa , LSShftMxa , Spn1ALxb1 , Spn1ALxb2 , Spn1ALxb3 , Spn1ALyb1 , Spn1ALyb2 , & - Spn1ALyb3 , Spn1ALzb1 , Spn1ALzb2 , Spn1ALzb3 , Spn1FLxb1 , Spn1FLxb2 , Spn1FLxb3 , Spn1FLyb1 , & - Spn1FLyb2 , Spn1FLyb3 , Spn1FLzb1 , Spn1FLzb2 , Spn1FLzb3 , Spn1MLxb1 , Spn1MLxb2 , Spn1MLxb3 , & - Spn1MLyb1 , Spn1MLyb2 , Spn1MLyb3 , Spn1MLzb1 , Spn1MLzb2 , Spn1MLzb3 , Spn1RDxb1 , Spn1RDxb2 , & - Spn1RDxb3 , Spn1RDyb1 , Spn1RDyb2 , Spn1RDyb3 , Spn1RDzb1 , Spn1RDzb2 , Spn1RDzb3 , Spn1TDxb1 , & - Spn1TDxb2 , Spn1TDxb3 , Spn1TDyb1 , Spn1TDyb2 , Spn1TDyb3 , Spn1TDzb1 , Spn1TDzb2 , Spn1TDzb3 , & - Spn2ALxb1 , Spn2ALxb2 , Spn2ALxb3 , Spn2ALyb1 , Spn2ALyb2 , Spn2ALyb3 , Spn2ALzb1 , Spn2ALzb2 , & - Spn2ALzb3 , Spn2FLxb1 , Spn2FLxb2 , Spn2FLxb3 , Spn2FLyb1 , Spn2FLyb2 , Spn2FLyb3 , Spn2FLzb1 , & - Spn2FLzb2 , Spn2FLzb3 , Spn2MLxb1 , Spn2MLxb2 , Spn2MLxb3 , Spn2MLyb1 , Spn2MLyb2 , Spn2MLyb3 , & - Spn2MLzb1 , Spn2MLzb2 , Spn2MLzb3 , Spn2RDxb1 , Spn2RDxb2 , Spn2RDxb3 , Spn2RDyb1 , Spn2RDyb2 , & - Spn2RDyb3 , Spn2RDzb1 , Spn2RDzb2 , Spn2RDzb3 , Spn2TDxb1 , Spn2TDxb2 , Spn2TDxb3 , Spn2TDyb1 , & - Spn2TDyb2 , Spn2TDyb3 , Spn2TDzb1 , Spn2TDzb2 , Spn2TDzb3 , Spn3ALxb1 , Spn3ALxb2 , Spn3ALxb3 , & - Spn3ALyb1 , Spn3ALyb2 , Spn3ALyb3 , Spn3ALzb1 , Spn3ALzb2 , Spn3ALzb3 , Spn3FLxb1 , Spn3FLxb2 , & - Spn3FLxb3 , Spn3FLyb1 , Spn3FLyb2 , Spn3FLyb3 , Spn3FLzb1 , Spn3FLzb2 , Spn3FLzb3 , Spn3MLxb1 , & - Spn3MLxb2 , Spn3MLxb3 , Spn3MLyb1 , Spn3MLyb2 , Spn3MLyb3 , Spn3MLzb1 , Spn3MLzb2 , Spn3MLzb3 , & - Spn3RDxb1 , Spn3RDxb2 , Spn3RDxb3 , Spn3RDyb1 , Spn3RDyb2 , Spn3RDyb3 , Spn3RDzb1 , Spn3RDzb2 , & - Spn3RDzb3 , Spn3TDxb1 , Spn3TDxb2 , Spn3TDxb3 , Spn3TDyb1 , Spn3TDyb2 , Spn3TDyb3 , Spn3TDzb1 , & - Spn3TDzb2 , Spn3TDzb3 , Spn4ALxb1 , Spn4ALxb2 , Spn4ALxb3 , Spn4ALyb1 , Spn4ALyb2 , Spn4ALyb3 , & - Spn4ALzb1 , Spn4ALzb2 , Spn4ALzb3 , Spn4FLxb1 , Spn4FLxb2 , Spn4FLxb3 , Spn4FLyb1 , Spn4FLyb2 , & - Spn4FLyb3 , Spn4FLzb1 , Spn4FLzb2 , Spn4FLzb3 , Spn4MLxb1 , Spn4MLxb2 , Spn4MLxb3 , Spn4MLyb1 , & - Spn4MLyb2 , Spn4MLyb3 , Spn4MLzb1 , Spn4MLzb2 , Spn4MLzb3 , Spn4RDxb1 , Spn4RDxb2 , Spn4RDxb3 , & - Spn4RDyb1 , Spn4RDyb2 , Spn4RDyb3 , Spn4RDzb1 , Spn4RDzb2 , Spn4RDzb3 , Spn4TDxb1 , Spn4TDxb2 , & - Spn4TDxb3 , Spn4TDyb1 , Spn4TDyb2 , Spn4TDyb3 , Spn4TDzb1 , Spn4TDzb2 , Spn4TDzb3 , Spn5ALxb1 , & - Spn5ALxb2 , Spn5ALxb3 , Spn5ALyb1 , Spn5ALyb2 , Spn5ALyb3 , Spn5ALzb1 , Spn5ALzb2 , Spn5ALzb3 , & - Spn5FLxb1 , Spn5FLxb2 , Spn5FLxb3 , Spn5FLyb1 , Spn5FLyb2 , Spn5FLyb3 , Spn5FLzb1 , Spn5FLzb2 , & - Spn5FLzb3 , Spn5MLxb1 , Spn5MLxb2 , Spn5MLxb3 , Spn5MLyb1 , Spn5MLyb2 , Spn5MLyb3 , Spn5MLzb1 , & - Spn5MLzb2 , Spn5MLzb3 , Spn5RDxb1 , Spn5RDxb2 , Spn5RDxb3 , Spn5RDyb1 , Spn5RDyb2 , Spn5RDyb3 , & - Spn5RDzb1 , Spn5RDzb2 , Spn5RDzb3 , Spn5TDxb1 , Spn5TDxb2 , Spn5TDxb3 , Spn5TDyb1 , Spn5TDyb2 , & - Spn5TDyb3 , Spn5TDzb1 , Spn5TDzb2 , Spn5TDzb3 , Spn6ALxb1 , Spn6ALxb2 , Spn6ALxb3 , Spn6ALyb1 , & - Spn6ALyb2 , Spn6ALyb3 , Spn6ALzb1 , Spn6ALzb2 , Spn6ALzb3 , Spn6FLxb1 , Spn6FLxb2 , Spn6FLxb3 , & - Spn6FLyb1 , Spn6FLyb2 , Spn6FLyb3 , Spn6FLzb1 , Spn6FLzb2 , Spn6FLzb3 , Spn6MLxb1 , Spn6MLxb2 , & - Spn6MLxb3 , Spn6MLyb1 , Spn6MLyb2 , Spn6MLyb3 , Spn6MLzb1 , Spn6MLzb2 , Spn6MLzb3 , Spn6RDxb1 , & - Spn6RDxb2 , Spn6RDxb3 , Spn6RDyb1 , Spn6RDyb2 , Spn6RDyb3 , Spn6RDzb1 , Spn6RDzb2 , Spn6RDzb3 , & - Spn6TDxb1 , Spn6TDxb2 , Spn6TDxb3 , Spn6TDyb1 , Spn6TDyb2 , Spn6TDyb3 , Spn6TDzb1 , Spn6TDzb2 , & - Spn6TDzb3 , Spn7ALxb1 , Spn7ALxb2 , Spn7ALxb3 , Spn7ALyb1 , Spn7ALyb2 , Spn7ALyb3 , Spn7ALzb1 , & - Spn7ALzb2 , Spn7ALzb3 , Spn7FLxb1 , Spn7FLxb2 , Spn7FLxb3 , Spn7FLyb1 , Spn7FLyb2 , Spn7FLyb3 , & - Spn7FLzb1 , Spn7FLzb2 , Spn7FLzb3 , Spn7MLxb1 , Spn7MLxb2 , Spn7MLxb3 , Spn7MLyb1 , Spn7MLyb2 , & - Spn7MLyb3 , Spn7MLzb1 , Spn7MLzb2 , Spn7MLzb3 , Spn7RDxb1 , Spn7RDxb2 , Spn7RDxb3 , Spn7RDyb1 , & - Spn7RDyb2 , Spn7RDyb3 , Spn7RDzb1 , Spn7RDzb2 , Spn7RDzb3 , Spn7TDxb1 , Spn7TDxb2 , Spn7TDxb3 , & - Spn7TDyb1 , Spn7TDyb2 , Spn7TDyb3 , Spn7TDzb1 , Spn7TDzb2 , Spn7TDzb3 , Spn8ALxb1 , Spn8ALxb2 , & - Spn8ALxb3 , Spn8ALyb1 , Spn8ALyb2 , Spn8ALyb3 , Spn8ALzb1 , Spn8ALzb2 , Spn8ALzb3 , Spn8FLxb1 , & - Spn8FLxb2 , Spn8FLxb3 , Spn8FLyb1 , Spn8FLyb2 , Spn8FLyb3 , Spn8FLzb1 , Spn8FLzb2 , Spn8FLzb3 , & - Spn8MLxb1 , Spn8MLxb2 , Spn8MLxb3 , Spn8MLyb1 , Spn8MLyb2 , Spn8MLyb3 , Spn8MLzb1 , Spn8MLzb2 , & - Spn8MLzb3 , Spn8RDxb1 , Spn8RDxb2 , Spn8RDxb3 , Spn8RDyb1 , Spn8RDyb2 , Spn8RDyb3 , Spn8RDzb1 , & - Spn8RDzb2 , Spn8RDzb3 , Spn8TDxb1 , Spn8TDxb2 , Spn8TDxb3 , Spn8TDyb1 , Spn8TDyb2 , Spn8TDyb3 , & - Spn8TDzb1 , Spn8TDzb2 , Spn8TDzb3 , Spn9ALxb1 , Spn9ALxb2 , Spn9ALxb3 , Spn9ALyb1 , Spn9ALyb2 , & - Spn9ALyb3 , Spn9ALzb1 , Spn9ALzb2 , Spn9ALzb3 , Spn9FLxb1 , Spn9FLxb2 , Spn9FLxb3 , Spn9FLyb1 , & - Spn9FLyb2 , Spn9FLyb3 , Spn9FLzb1 , Spn9FLzb2 , Spn9FLzb3 , Spn9MLxb1 , Spn9MLxb2 , Spn9MLxb3 , & - Spn9MLyb1 , Spn9MLyb2 , Spn9MLyb3 , Spn9MLzb1 , Spn9MLzb2 , Spn9MLzb3 , Spn9RDxb1 , Spn9RDxb2 , & - Spn9RDxb3 , Spn9RDyb1 , Spn9RDyb2 , Spn9RDyb3 , Spn9RDzb1 , Spn9RDzb2 , Spn9RDzb3 , Spn9TDxb1 , & - Spn9TDxb2 , Spn9TDxb3 , Spn9TDyb1 , Spn9TDyb2 , Spn9TDyb3 , Spn9TDzb1 , Spn9TDzb2 , Spn9TDzb3 , & - TailFurlP , TailFurlA , TailFurlP , TailFurlV , TeetAya , TeetPya , TeetPya , TeetVya , & - TFrlBrM , TipClrnc1 , TipClrnc2 , TipClrnc3 , TipALxb1 , TipALxb2 , TipALxb3 , TipALyb1 , & - TipALyb2 , TipALyb3 , TipALzb1 , TipALzb2 , TipALzb3 , TipClrnc1 , TipClrnc2 , TipClrnc3 , & - TipDxb1 , TipDxb2 , TipDxb3 , TipDxc1 , TipDxc2 , TipDxc3 , TipDyb1 , TipDyb2 , & - TipDyb3 , TipDyc1 , TipDyc2 , TipDyc3 , TipDzc1 , TipDzc2 , TipDzc3 , TipDzc1 , & - TipDzc2 , TipDzc3 , TipRDxb1 , TipRDxb2 , TipRDxb3 , TipRDyb1 , TipRDyb2 , TipRDyb3 , & - TipRDzc1 , TipRDzc2 , TipRDzc3 , TipRDzc1 , TipRDzc2 , TipRDzc3 , YawBrTDzt , YawBrTDxt , & - YawBrRDyt , YawBrRDxt , YawBrTDyt , YawBrRDzt , TwHt1ALxt , TwHt1ALyt , TwHt1ALzt , TwHt1FLxt , & - TwHt1FLyt , TwHt1FLzt , TwHt1MLxt , TwHt1MLyt , TwHt1MLzt , TwHt1RDxt , TwHt1RDyt , TwHt1RDzt , & - TwHt1RPxi , TwHt1RPyi , TwHt1RPzi , TwHt1TDxt , TwHt1TDyt , TwHt1TDzt , TwHt1TPxi , TwHt1TPyi , & - TwHt1TPzi , TwHt2ALxt , TwHt2ALyt , TwHt2ALzt , TwHt2FLxt , TwHt2FLyt , TwHt2FLzt , TwHt2MLxt , & - TwHt2MLyt , TwHt2MLzt , TwHt2RDxt , TwHt2RDyt , TwHt2RDzt , TwHt2RPxi , TwHt2RPyi , TwHt2RPzi , & - TwHt2TDxt , TwHt2TDyt , TwHt2TDzt , TwHt2TPxi , TwHt2TPyi , TwHt2TPzi , TwHt3ALxt , TwHt3ALyt , & - TwHt3ALzt , TwHt3FLxt , TwHt3FLyt , TwHt3FLzt , TwHt3MLxt , TwHt3MLyt , TwHt3MLzt , TwHt3RDxt , & - TwHt3RDyt , TwHt3RDzt , TwHt3RPxi , TwHt3RPyi , TwHt3RPzi , TwHt3TDxt , TwHt3TDyt , TwHt3TDzt , & - TwHt3TPxi , TwHt3TPyi , TwHt3TPzi , TwHt4ALxt , TwHt4ALyt , TwHt4ALzt , TwHt4FLxt , TwHt4FLyt , & - TwHt4FLzt , TwHt4MLxt , TwHt4MLyt , TwHt4MLzt , TwHt4RDxt , TwHt4RDyt , TwHt4RDzt , TwHt4RPxi , & - TwHt4RPyi , TwHt4RPzi , TwHt4TDxt , TwHt4TDyt , TwHt4TDzt , TwHt4TPxi , TwHt4TPyi , TwHt4TPzi , & - TwHt5ALxt , TwHt5ALyt , TwHt5ALzt , TwHt5FLxt , TwHt5FLyt , TwHt5FLzt , TwHt5MLxt , TwHt5MLyt , & - TwHt5MLzt , TwHt5RDxt , TwHt5RDyt , TwHt5RDzt , TwHt5RPxi , TwHt5RPyi , TwHt5RPzi , TwHt5TDxt , & - TwHt5TDyt , TwHt5TDzt , TwHt5TPxi , TwHt5TPyi , TwHt5TPzi , TwHt6ALxt , TwHt6ALyt , TwHt6ALzt , & - TwHt6FLxt , TwHt6FLyt , TwHt6FLzt , TwHt6MLxt , TwHt6MLyt , TwHt6MLzt , TwHt6RDxt , TwHt6RDyt , & - TwHt6RDzt , TwHt6RPxi , TwHt6RPyi , TwHt6RPzi , TwHt6TDxt , TwHt6TDyt , TwHt6TDzt , TwHt6TPxi , & - TwHt6TPyi , TwHt6TPzi , TwHt7ALxt , TwHt7ALyt , TwHt7ALzt , TwHt7FLxt , TwHt7FLyt , TwHt7FLzt , & - TwHt7MLxt , TwHt7MLyt , TwHt7MLzt , TwHt7RDxt , TwHt7RDyt , TwHt7RDzt , TwHt7RPxi , TwHt7RPyi , & - TwHt7RPzi , TwHt7TDxt , TwHt7TDyt , TwHt7TDzt , TwHt7TPxi , TwHt7TPyi , TwHt7TPzi , TwHt8ALxt , & - TwHt8ALyt , TwHt8ALzt , TwHt8FLxt , TwHt8FLyt , TwHt8FLzt , TwHt8MLxt , TwHt8MLyt , TwHt8MLzt , & - TwHt8RDxt , TwHt8RDyt , TwHt8RDzt , TwHt8RPxi , TwHt8RPyi , TwHt8RPzi , TwHt8TDxt , TwHt8TDyt , & - TwHt8TDzt , TwHt8TPxi , TwHt8TPyi , TwHt8TPzi , TwHt9ALxt , TwHt9ALyt , TwHt9ALzt , TwHt9FLxt , & - TwHt9FLyt , TwHt9FLzt , TwHt9MLxt , TwHt9MLyt , TwHt9MLzt , TwHt9RDxt , TwHt9RDyt , TwHt9RDzt , & - TwHt9RPxi , TwHt9RPyi , TwHt9RPzi , TwHt9TDxt , TwHt9TDyt , TwHt9TDzt , TwHt9TPxi , TwHt9TPyi , & - TwHt9TPzi , TwrBsFxt , TwrBsFyt , TwrBsFzt , TwrBsMxt , TwrBsMyt , TwrBsMzt , TipClrnc1 , & - TipClrnc2 , TipClrnc3 , TwrTpTDxi , TwrTpTDyi , TwrTpTDzi , TipRDzc1 , TipRDzc2 , TipRDzc3 , & - YawAzn , YawAzn , YawAzn , YawBrFxn , YawBrFxp , YawBrFyn , YawBrFyp , YawBrFzn , & - YawBrFzn , YawBrMxn , YawBrMxp , YawBrMyn , YawBrMyp , YawBrMzn , YawBrMzn , YawBrRAxp , & - YawBrRAyp , YawBrRAzp , YawBrRDxt , YawBrRDyt , YawBrRDzt , YawBrRVxp , YawBrRVyp , YawBrRVzp , & - YawBrTAxp , YawBrTAyp , YawBrTAzp , TwrTpTDxi , YawBrTDxp , YawBrTDxt , TwrTpTDyi , YawBrTDyp , & - YawBrTDyt , TwrTpTDzi , YawBrTDzp , YawBrTDzt , YawBrTVxp , YawBrTVyp , YawBrTVzp , YawPzn , & - YawPzn , YawPzn , YawVzn , YawVzn , YawVzn /) - CHARACTER(ChanLen), PARAMETER :: ParamUnitsAry(981) = (/ & ! This lists the units corresponding to the allowed parameters - "(deg) ","(deg) ","(deg) ","(deg) ","(deg) ","(deg) ","(deg) ","(deg/s^2)", & - "(rpm) ","(kN-m) ","(deg/s^2)","(kW) ","(kN-m) ","(rpm) ","(m) ","(m) ", & - "(m) ","(deg/s^2)","(deg/s^2)","(deg/s^2)","(kN) ","(kN) ","(kN) ","(kN) ", & - "(kN) ","(kN) ","(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ", & - "(deg) ","(deg) ","(deg) ","(rpm) ","(rpm) ","(rpm) ","(kN) ","(kN) ", & - "(kN) ","(kN) ","(kN) ","(kN) ","(kN-m) ","(kN-m) ","(kW) ","(kN-m) ", & - "(deg/s^2)","(deg/s^2)","(deg/s^2)","(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ","(deg) ", & - "(deg) ","(deg) ","(rpm) ","(rpm) ","(rpm) ","(deg) ","(deg/s^2)","(deg) ", & - "(deg/s) ","(deg/s^2)","(deg/s^2)","(deg/s^2)","(deg/s) ","(deg/s) ","(deg/s) ","(m/s^2) ", & - "(m/s^2) ","(m/s^2) ","(m/s) ","(m/s) ","(m/s) ","(m) ","(m) ","(m) ", & - "(deg) ","(deg) ","(deg) ","(deg) ","(deg) ","(deg) ","(deg) ","(deg) ", & - "(deg) ","(m) ","(deg) ","(deg/s^2)","(deg/s^2)","(deg/s^2)","(deg/s^2)","(deg/s^2)", & - "(deg/s^2)","(deg) ","(deg) ","(deg) ","(deg) ","(deg/s) ","(deg/s) ","(deg/s) ", & - "(deg/s) ","(deg/s) ","(deg/s) ","(m) ","(m) ","(m/s^2) ","(m/s^2) ","(m/s^2) ", & - "(m/s^2) ","(m/s^2) ","(m/s^2) ","(m) ","(m) ","(m) ","(m) ","(m) ", & - "(m) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(deg) ", & - "(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ", & - "(m/s^2) ","(rad/s^2)","(rad/s^2)","(m/s^2) ","(rad/s^2)","(rad/s^2)","(rad/s^2)","(m/s^2) ", & - "(m/s^2) ","(rad/s^2)","(m/s^2) ","(m/s^2) ","(rad/s^2)","(m/s^2) ","(m/s^2) ","(rad/s^2)", & - "(rad/s^2)","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s) ","(rad/s) ","(rad/s) ","(m/s) ","(rad/s) ","(rad/s) ","(rad/s) ", & - "(m/s) ","(m/s) ","(rad/s) ","(m/s) ","(m/s) ","(rad/s) ","(m/s) ","(m/s) ", & - "(rad/s) ","(rad/s) ","(m) ","(m) ","(m) ","(m) ","(m) ","(m) ", & - "(m) ","(m) ","(m) ","(rad) ","(rad) ","(m) ","(rad) ","(rad) ", & - "(rad) ","(m) ","(m) ","(rad) ","(m) ","(m) ","(rad) ","(m) ", & - "(m) ","(rad) ","(rad) ","(kN-m) ","(deg) ","(deg) ","(deg) ","(kN) ", & - "(kN) ","(kN) ","(kN) ","(kN) ","(kN) ","(kN) ","(kN) ","(kN) ", & - "(kN) ","(kN) ","(kN) ","(kN) ","(kN) ","(kN) ","(kN) ","(kN) ", & - "(kN) ","(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ", & - "(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ", & - "(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ", & - "(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ","(deg/s^2)", & - "(deg) ","(deg/s^2)","(deg) ","(deg/s) ","(kW) ","(rpm) ","(deg/s^2)","(deg) ", & - "(deg/s) ","(kN) ","(kN-m) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ", & - "(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(kN) ","(kN) ","(kN) ","(kN) ", & - "(kN) ","(kN) ","(kN) ","(kN) ","(kN) ","(kN-m) ","(kN-m) ","(kN-m) ", & - "(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ","(deg) ","(deg) ", & - "(deg) ","(deg) ","(deg) ","(deg) ","(deg) ","(deg) ","(deg) ","(m) ", & - "(m) ","(m) ","(m) ","(m) ","(m) ","(m) ","(m) ","(m) ", & - "(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ", & - "(m/s^2) ","(kN) ","(kN) ","(kN) ","(kN) ","(kN) ","(kN) ","(kN) ", & - "(kN) ","(kN) ","(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ", & - "(kN-m) ","(kN-m) ","(kN-m) ","(deg) ","(deg) ","(deg) ","(deg) ","(deg) ", & - "(deg) ","(deg) ","(deg) ","(deg) ","(m) ","(m) ","(m) ","(m) ", & - "(m) ","(m) ","(m) ","(m) ","(m) ","(m/s^2) ","(m/s^2) ","(m/s^2) ", & - "(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(kN) ","(kN) ", & - "(kN) ","(kN) ","(kN) ","(kN) ","(kN) ","(kN) ","(kN) ","(kN-m) ", & - "(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ", & - "(deg) ","(deg) ","(deg) ","(deg) ","(deg) ","(deg) ","(deg) ","(deg) ", & - "(deg) ","(m) ","(m) ","(m) ","(m) ","(m) ","(m) ","(m) ", & - "(m) ","(m) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ", & - "(m/s^2) ","(m/s^2) ","(m/s^2) ","(kN) ","(kN) ","(kN) ","(kN) ","(kN) ", & - "(kN) ","(kN) ","(kN) ","(kN) ","(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ", & - "(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ","(deg) ","(deg) ","(deg) ", & - "(deg) ","(deg) ","(deg) ","(deg) ","(deg) ","(deg) ","(m) ","(m) ", & - "(m) ","(m) ","(m) ","(m) ","(m) ","(m) ","(m) ","(m/s^2) ", & - "(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ", & - "(kN) ","(kN) ","(kN) ","(kN) ","(kN) ","(kN) ","(kN) ","(kN) ", & - "(kN) ","(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ", & - "(kN-m) ","(kN-m) ","(deg) ","(deg) ","(deg) ","(deg) ","(deg) ","(deg) ", & - "(deg) ","(deg) ","(deg) ","(m) ","(m) ","(m) ","(m) ","(m) ", & - "(m) ","(m) ","(m) ","(m) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ", & - "(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(kN) ","(kN) ","(kN) ", & - "(kN) ","(kN) ","(kN) ","(kN) ","(kN) ","(kN) ","(kN-m) ","(kN-m) ", & - "(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ","(deg) ", & - "(deg) ","(deg) ","(deg) ","(deg) ","(deg) ","(deg) ","(deg) ","(deg) ", & - "(m) ","(m) ","(m) ","(m) ","(m) ","(m) ","(m) ","(m) ", & - "(m) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ", & - "(m/s^2) ","(m/s^2) ","(kN) ","(kN) ","(kN) ","(kN) ","(kN) ","(kN) ", & - "(kN) ","(kN) ","(kN) ","(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ", & - "(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ","(deg) ","(deg) ","(deg) ","(deg) ", & - "(deg) ","(deg) ","(deg) ","(deg) ","(deg) ","(m) ","(m) ","(m) ", & - "(m) ","(m) ","(m) ","(m) ","(m) ","(m) ","(m/s^2) ","(m/s^2) ", & - "(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(kN) ", & - "(kN) ","(kN) ","(kN) ","(kN) ","(kN) ","(kN) ","(kN) ","(kN) ", & - "(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ", & - "(kN-m) ","(deg) ","(deg) ","(deg) ","(deg) ","(deg) ","(deg) ","(deg) ", & - "(deg) ","(deg) ","(m) ","(m) ","(m) ","(m) ","(m) ","(m) ", & - "(m) ","(m) ","(m) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ", & - "(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(kN) ","(kN) ","(kN) ","(kN) ", & - "(kN) ","(kN) ","(kN) ","(kN) ","(kN) ","(kN-m) ","(kN-m) ","(kN-m) ", & - "(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ","(deg) ","(deg) ", & - "(deg) ","(deg) ","(deg) ","(deg) ","(deg) ","(deg) ","(deg) ","(m) ", & - "(m) ","(m) ","(m) ","(m) ","(m) ","(m) ","(m) ","(m) ", & - "(deg) ","(deg/s^2)","(deg) ","(deg/s) ","(deg/s^2)","(deg) ","(deg) ","(deg/s) ", & - "(kN-m) ","(m) ","(m) ","(m) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ", & - "(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m) ","(m) ","(m) ", & - "(m) ","(m) ","(m) ","(m) ","(m) ","(m) ","(m) ","(m) ", & - "(m) ","(m) ","(m) ","(m) ","(m) ","(m) ","(m) ","(m) ", & - "(m) ","(m) ","(deg) ","(deg) ","(deg) ","(deg) ","(deg) ","(deg) ", & - "(deg) ","(deg) ","(deg) ","(deg) ","(deg) ","(deg) ","(m) ","(m) ", & - "(deg) ","(deg) ","(m) ","(deg) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(kN) ", & - "(kN) ","(kN) ","(kN-m) ","(kN-m) ","(kN-m) ","(deg) ","(deg) ","(deg) ", & - "(deg) ","(deg) ","(deg) ","(m) ","(m) ","(m) ","(m) ","(m) ", & - "(m) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(kN) ","(kN) ","(kN) ","(kN-m) ", & - "(kN-m) ","(kN-m) ","(deg) ","(deg) ","(deg) ","(deg) ","(deg) ","(deg) ", & - "(m) ","(m) ","(m) ","(m) ","(m) ","(m) ","(m/s^2) ","(m/s^2) ", & - "(m/s^2) ","(kN) ","(kN) ","(kN) ","(kN-m) ","(kN-m) ","(kN-m) ","(deg) ", & - "(deg) ","(deg) ","(deg) ","(deg) ","(deg) ","(m) ","(m) ","(m) ", & - "(m) ","(m) ","(m) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(kN) ","(kN) ", & - "(kN) ","(kN-m) ","(kN-m) ","(kN-m) ","(deg) ","(deg) ","(deg) ","(deg) ", & - "(deg) ","(deg) ","(m) ","(m) ","(m) ","(m) ","(m) ","(m) ", & - "(m/s^2) ","(m/s^2) ","(m/s^2) ","(kN) ","(kN) ","(kN) ","(kN-m) ","(kN-m) ", & - "(kN-m) ","(deg) ","(deg) ","(deg) ","(deg) ","(deg) ","(deg) ","(m) ", & - "(m) ","(m) ","(m) ","(m) ","(m) ","(m/s^2) ","(m/s^2) ","(m/s^2) ", & - "(kN) ","(kN) ","(kN) ","(kN-m) ","(kN-m) ","(kN-m) ","(deg) ","(deg) ", & - "(deg) ","(deg) ","(deg) ","(deg) ","(m) ","(m) ","(m) ","(m) ", & - "(m) ","(m) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(kN) ","(kN) ","(kN) ", & - "(kN-m) ","(kN-m) ","(kN-m) ","(deg) ","(deg) ","(deg) ","(deg) ","(deg) ", & - "(deg) ","(m) ","(m) ","(m) ","(m) ","(m) ","(m) ","(m/s^2) ", & - "(m/s^2) ","(m/s^2) ","(kN) ","(kN) ","(kN) ","(kN-m) ","(kN-m) ","(kN-m) ", & - "(deg) ","(deg) ","(deg) ","(deg) ","(deg) ","(deg) ","(m) ","(m) ", & - "(m) ","(m) ","(m) ","(m) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(kN) ", & - "(kN) ","(kN) ","(kN-m) ","(kN-m) ","(kN-m) ","(deg) ","(deg) ","(deg) ", & - "(deg) ","(deg) ","(deg) ","(m) ","(m) ","(m) ","(m) ","(m) ", & - "(m) ","(kN) ","(kN) ","(kN) ","(kN-m) ","(kN-m) ","(kN-m) ","(m) ", & - "(m) ","(m) ","(m) ","(m) ","(m) ","(deg) ","(deg) ","(deg) ", & - "(deg/s^2)","(deg/s^2)","(deg/s^2)","(kN) ","(kN) ","(kN) ","(kN) ","(kN) ", & - "(kN) ","(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ","(deg/s^2)", & - "(deg/s^2)","(deg/s^2)","(deg) ","(deg) ","(deg) ","(deg/s) ","(deg/s) ","(deg/s) ", & - "(m/s^2) ","(m/s^2) ","(m/s^2) ","(m) ","(m) ","(m) ","(m) ","(m) ", & - "(m) ","(m) ","(m) ","(m) ","(m/s) ","(m/s) ","(m/s) ","(deg) ", & - "(deg) ","(deg) ","(deg/s) ","(deg/s) ","(deg/s) "/) + + CHARACTER(OutStrLenM1), PARAMETER :: ValidParamAry(1115) = (/ & ! This lists the names of the allowed parameters, which must be sorted alphabetically + "AZIMUTH ","BLDPITCH1 ","BLDPITCH2 ","BLDPITCH3 ","BLPITCH1 ","BLPITCH2 ","BLPITCH3 ", & + "DOMEGAYF ","GENACCEL ","GENSPEED ","HSSBRTQ ","HSSHFTA ","HSSHFTPWR ","HSSHFTTQ ", & + "HSSHFTV ","IPDEFL1 ","IPDEFL2 ","IPDEFL3 ","LSSGAGA ","LSSGAGAXA ","LSSGAGAXS ", & + "LSSGAGFXA ","LSSGAGFXS ","LSSGAGFYA ","LSSGAGFYS ","LSSGAGFZA ","LSSGAGFZS ","LSSGAGMXA ", & + "LSSGAGMXS ","LSSGAGMYA ","LSSGAGMYS ","LSSGAGMZA ","LSSGAGMZS ","LSSGAGP ","LSSGAGPXA ", & + "LSSGAGPXS ","LSSGAGV ","LSSGAGVXA ","LSSGAGVXS ","LSSHFTFXA ","LSSHFTFXS ","LSSHFTFYA ", & + "LSSHFTFYS ","LSSHFTFZA ","LSSHFTFZS ","LSSHFTMXA ","LSSHFTMXS ","LSSHFTPWR ","LSSHFTTQ ", & + "LSSTIPA ","LSSTIPAXA ","LSSTIPAXS ","LSSTIPMYA ","LSSTIPMYS ","LSSTIPMZA ","LSSTIPMZS ", & + "LSSTIPP ","LSSTIPPXA ","LSSTIPPXS ","LSSTIPV ","LSSTIPVXA ","LSSTIPVXS ","NACYAW ", & + "NACYAWA ","NACYAWP ","NACYAWV ","NCIMURAXS ","NCIMURAYS ","NCIMURAZS ","NCIMURVXS ", & + "NCIMURVYS ","NCIMURVZS ","NCIMUTAGXS","NCIMUTAGYS","NCIMUTAGZS","NCIMUTAXS ","NCIMUTAYS ", & + "NCIMUTAZS ","NCIMUTVXS ","NCIMUTVYS ","NCIMUTVZS ","OMEGAYF ","OOPDEFL1 ","OOPDEFL2 ", & + "OOPDEFL3 ","PTCHDEFL1 ","PTCHDEFL2 ","PTCHDEFL3 ","PTCHPMZB1 ","PTCHPMZB2 ","PTCHPMZB3 ", & + "PTCHPMZC1 ","PTCHPMZC2 ","PTCHPMZC3 ","PTFMHEAVE ","PTFMPITCH ","PTFMRAXI ","PTFMRAXT ", & + "PTFMRAYI ","PTFMRAYT ","PTFMRAZI ","PTFMRAZT ","PTFMRDXI ","PTFMRDYI ","PTFMRDZI ", & + "PTFMROLL ","PTFMRVXI ","PTFMRVXT ","PTFMRVYI ","PTFMRVYT ","PTFMRVZI ","PTFMRVZT ", & + "PTFMSURGE ","PTFMSWAY ","PTFMTAGXI ","PTFMTAGXT ","PTFMTAGYI ","PTFMTAGYT ","PTFMTAGZI ", & + "PTFMTAGZT ","PTFMTAXI ","PTFMTAXT ","PTFMTAYI ","PTFMTAYT ","PTFMTAZI ","PTFMTAZT ", & + "PTFMTDXI ","PTFMTDXT ","PTFMTDYI ","PTFMTDYT ","PTFMTDZI ","PTFMTDZT ","PTFMTVXI ", & + "PTFMTVXT ","PTFMTVYI ","PTFMTVYT ","PTFMTVZI ","PTFMTVZT ","PTFMYAW ","QD2_B1E1 ", & + "QD2_B1F1 ","QD2_B1F2 ","QD2_B2E1 ","QD2_B2F1 ","QD2_B2F2 ","QD2_B3E1 ","QD2_B3F1 ", & + "QD2_B3F2 ","QD2_DRTR ","QD2_GEAZ ","QD2_HV ","QD2_P ","QD2_R ","QD2_RFRL ", & + "QD2_SG ","QD2_SW ","QD2_TEET ","QD2_TFA1 ","QD2_TFA2 ","QD2_TFRL ","QD2_TSS1 ", & + "QD2_TSS2 ","QD2_Y ","QD2_YAW ","QD_B1E1 ","QD_B1F1 ","QD_B1F2 ","QD_B2E1 ", & + "QD_B2F1 ","QD_B2F2 ","QD_B3E1 ","QD_B3F1 ","QD_B3F2 ","QD_DRTR ","QD_GEAZ ", & + "QD_HV ","QD_P ","QD_R ","QD_RFRL ","QD_SG ","QD_SW ","QD_TEET ", & + "QD_TFA1 ","QD_TFA2 ","QD_TFRL ","QD_TSS1 ","QD_TSS2 ","QD_Y ","QD_YAW ", & + "Q_B1E1 ","Q_B1F1 ","Q_B1F2 ","Q_B2E1 ","Q_B2F1 ","Q_B2F2 ","Q_B3E1 ", & + "Q_B3F1 ","Q_B3F2 ","Q_DRTR ","Q_GEAZ ","Q_HV ","Q_P ","Q_R ", & + "Q_RFRL ","Q_SG ","Q_SW ","Q_TEET ","Q_TFA1 ","Q_TFA2 ","Q_TFRL ", & + "Q_TSS1 ","Q_TSS2 ","Q_Y ","Q_YAW ","RFRLBRM ","ROLLDEFL1 ","ROLLDEFL2 ", & + "ROLLDEFL3 ","ROOTFXB1 ","ROOTFXB2 ","ROOTFXB3 ","ROOTFXC1 ","ROOTFXC2 ","ROOTFXC3 ", & + "ROOTFYB1 ","ROOTFYB2 ","ROOTFYB3 ","ROOTFYC1 ","ROOTFYC2 ","ROOTFYC3 ","ROOTFZB1 ", & + "ROOTFZB2 ","ROOTFZB3 ","ROOTFZC1 ","ROOTFZC2 ","ROOTFZC3 ","ROOTMEDG1 ","ROOTMEDG2 ", & + "ROOTMEDG3 ","ROOTMFLP1 ","ROOTMFLP2 ","ROOTMFLP3 ","ROOTMIP1 ","ROOTMIP2 ","ROOTMIP3 ", & + "ROOTMOOP1 ","ROOTMOOP2 ","ROOTMOOP3 ","ROOTMXB1 ","ROOTMXB2 ","ROOTMXB3 ","ROOTMXC1 ", & + "ROOTMXC2 ","ROOTMXC3 ","ROOTMYB1 ","ROOTMYB2 ","ROOTMYB3 ","ROOTMYC1 ","ROOTMYC2 ", & + "ROOTMYC3 ","ROOTMZB1 ","ROOTMZB2 ","ROOTMZB3 ","ROOTMZC1 ","ROOTMZC2 ","ROOTMZC3 ", & + "ROTACCEL ","ROTFURL ","ROTFURLA ","ROTFURLP ","ROTFURLV ","ROTPWR ","ROTSPEED ", & + "ROTTEETA ","ROTTEETP ","ROTTEETV ","ROTTHRUST ","ROTTORQ ","SPN1ALGXB1","SPN1ALGXB2", & + "SPN1ALGXB3","SPN1ALGYB1","SPN1ALGYB2","SPN1ALGYB3","SPN1ALGZB1","SPN1ALGZB2","SPN1ALGZB3", & + "SPN1ALXB1 ","SPN1ALXB2 ","SPN1ALXB3 ","SPN1ALYB1 ","SPN1ALYB2 ","SPN1ALYB3 ","SPN1ALZB1 ", & + "SPN1ALZB2 ","SPN1ALZB3 ","SPN1FLXB1 ","SPN1FLXB2 ","SPN1FLXB3 ","SPN1FLYB1 ","SPN1FLYB2 ", & + "SPN1FLYB3 ","SPN1FLZB1 ","SPN1FLZB2 ","SPN1FLZB3 ","SPN1MLXB1 ","SPN1MLXB2 ","SPN1MLXB3 ", & + "SPN1MLYB1 ","SPN1MLYB2 ","SPN1MLYB3 ","SPN1MLZB1 ","SPN1MLZB2 ","SPN1MLZB3 ","SPN1RDXB1 ", & + "SPN1RDXB2 ","SPN1RDXB3 ","SPN1RDYB1 ","SPN1RDYB2 ","SPN1RDYB3 ","SPN1RDZB1 ","SPN1RDZB2 ", & + "SPN1RDZB3 ","SPN1TDXB1 ","SPN1TDXB2 ","SPN1TDXB3 ","SPN1TDYB1 ","SPN1TDYB2 ","SPN1TDYB3 ", & + "SPN1TDZB1 ","SPN1TDZB2 ","SPN1TDZB3 ","SPN2ALGXB1","SPN2ALGXB2","SPN2ALGXB3","SPN2ALGYB1", & + "SPN2ALGYB2","SPN2ALGYB3","SPN2ALGZB1","SPN2ALGZB2","SPN2ALGZB3","SPN2ALXB1 ","SPN2ALXB2 ", & + "SPN2ALXB3 ","SPN2ALYB1 ","SPN2ALYB2 ","SPN2ALYB3 ","SPN2ALZB1 ","SPN2ALZB2 ","SPN2ALZB3 ", & + "SPN2FLXB1 ","SPN2FLXB2 ","SPN2FLXB3 ","SPN2FLYB1 ","SPN2FLYB2 ","SPN2FLYB3 ","SPN2FLZB1 ", & + "SPN2FLZB2 ","SPN2FLZB3 ","SPN2MLXB1 ","SPN2MLXB2 ","SPN2MLXB3 ","SPN2MLYB1 ","SPN2MLYB2 ", & + "SPN2MLYB3 ","SPN2MLZB1 ","SPN2MLZB2 ","SPN2MLZB3 ","SPN2RDXB1 ","SPN2RDXB2 ","SPN2RDXB3 ", & + "SPN2RDYB1 ","SPN2RDYB2 ","SPN2RDYB3 ","SPN2RDZB1 ","SPN2RDZB2 ","SPN2RDZB3 ","SPN2TDXB1 ", & + "SPN2TDXB2 ","SPN2TDXB3 ","SPN2TDYB1 ","SPN2TDYB2 ","SPN2TDYB3 ","SPN2TDZB1 ","SPN2TDZB2 ", & + "SPN2TDZB3 ","SPN3ALGXB1","SPN3ALGXB2","SPN3ALGXB3","SPN3ALGYB1","SPN3ALGYB2","SPN3ALGYB3", & + "SPN3ALGZB1","SPN3ALGZB2","SPN3ALGZB3","SPN3ALXB1 ","SPN3ALXB2 ","SPN3ALXB3 ","SPN3ALYB1 ", & + "SPN3ALYB2 ","SPN3ALYB3 ","SPN3ALZB1 ","SPN3ALZB2 ","SPN3ALZB3 ","SPN3FLXB1 ","SPN3FLXB2 ", & + "SPN3FLXB3 ","SPN3FLYB1 ","SPN3FLYB2 ","SPN3FLYB3 ","SPN3FLZB1 ","SPN3FLZB2 ","SPN3FLZB3 ", & + "SPN3MLXB1 ","SPN3MLXB2 ","SPN3MLXB3 ","SPN3MLYB1 ","SPN3MLYB2 ","SPN3MLYB3 ","SPN3MLZB1 ", & + "SPN3MLZB2 ","SPN3MLZB3 ","SPN3RDXB1 ","SPN3RDXB2 ","SPN3RDXB3 ","SPN3RDYB1 ","SPN3RDYB2 ", & + "SPN3RDYB3 ","SPN3RDZB1 ","SPN3RDZB2 ","SPN3RDZB3 ","SPN3TDXB1 ","SPN3TDXB2 ","SPN3TDXB3 ", & + "SPN3TDYB1 ","SPN3TDYB2 ","SPN3TDYB3 ","SPN3TDZB1 ","SPN3TDZB2 ","SPN3TDZB3 ","SPN4ALGXB1", & + "SPN4ALGXB2","SPN4ALGXB3","SPN4ALGYB1","SPN4ALGYB2","SPN4ALGYB3","SPN4ALGZB1","SPN4ALGZB2", & + "SPN4ALGZB3","SPN4ALXB1 ","SPN4ALXB2 ","SPN4ALXB3 ","SPN4ALYB1 ","SPN4ALYB2 ","SPN4ALYB3 ", & + "SPN4ALZB1 ","SPN4ALZB2 ","SPN4ALZB3 ","SPN4FLXB1 ","SPN4FLXB2 ","SPN4FLXB3 ","SPN4FLYB1 ", & + "SPN4FLYB2 ","SPN4FLYB3 ","SPN4FLZB1 ","SPN4FLZB2 ","SPN4FLZB3 ","SPN4MLXB1 ","SPN4MLXB2 ", & + "SPN4MLXB3 ","SPN4MLYB1 ","SPN4MLYB2 ","SPN4MLYB3 ","SPN4MLZB1 ","SPN4MLZB2 ","SPN4MLZB3 ", & + "SPN4RDXB1 ","SPN4RDXB2 ","SPN4RDXB3 ","SPN4RDYB1 ","SPN4RDYB2 ","SPN4RDYB3 ","SPN4RDZB1 ", & + "SPN4RDZB2 ","SPN4RDZB3 ","SPN4TDXB1 ","SPN4TDXB2 ","SPN4TDXB3 ","SPN4TDYB1 ","SPN4TDYB2 ", & + "SPN4TDYB3 ","SPN4TDZB1 ","SPN4TDZB2 ","SPN4TDZB3 ","SPN5ALGXB1","SPN5ALGXB2","SPN5ALGXB3", & + "SPN5ALGYB1","SPN5ALGYB2","SPN5ALGYB3","SPN5ALGZB1","SPN5ALGZB2","SPN5ALGZB3","SPN5ALXB1 ", & + "SPN5ALXB2 ","SPN5ALXB3 ","SPN5ALYB1 ","SPN5ALYB2 ","SPN5ALYB3 ","SPN5ALZB1 ","SPN5ALZB2 ", & + "SPN5ALZB3 ","SPN5FLXB1 ","SPN5FLXB2 ","SPN5FLXB3 ","SPN5FLYB1 ","SPN5FLYB2 ","SPN5FLYB3 ", & + "SPN5FLZB1 ","SPN5FLZB2 ","SPN5FLZB3 ","SPN5MLXB1 ","SPN5MLXB2 ","SPN5MLXB3 ","SPN5MLYB1 ", & + "SPN5MLYB2 ","SPN5MLYB3 ","SPN5MLZB1 ","SPN5MLZB2 ","SPN5MLZB3 ","SPN5RDXB1 ","SPN5RDXB2 ", & + "SPN5RDXB3 ","SPN5RDYB1 ","SPN5RDYB2 ","SPN5RDYB3 ","SPN5RDZB1 ","SPN5RDZB2 ","SPN5RDZB3 ", & + "SPN5TDXB1 ","SPN5TDXB2 ","SPN5TDXB3 ","SPN5TDYB1 ","SPN5TDYB2 ","SPN5TDYB3 ","SPN5TDZB1 ", & + "SPN5TDZB2 ","SPN5TDZB3 ","SPN6ALGXB1","SPN6ALGXB2","SPN6ALGXB3","SPN6ALGYB1","SPN6ALGYB2", & + "SPN6ALGYB3","SPN6ALGZB1","SPN6ALGZB2","SPN6ALGZB3","SPN6ALXB1 ","SPN6ALXB2 ","SPN6ALXB3 ", & + "SPN6ALYB1 ","SPN6ALYB2 ","SPN6ALYB3 ","SPN6ALZB1 ","SPN6ALZB2 ","SPN6ALZB3 ","SPN6FLXB1 ", & + "SPN6FLXB2 ","SPN6FLXB3 ","SPN6FLYB1 ","SPN6FLYB2 ","SPN6FLYB3 ","SPN6FLZB1 ","SPN6FLZB2 ", & + "SPN6FLZB3 ","SPN6MLXB1 ","SPN6MLXB2 ","SPN6MLXB3 ","SPN6MLYB1 ","SPN6MLYB2 ","SPN6MLYB3 ", & + "SPN6MLZB1 ","SPN6MLZB2 ","SPN6MLZB3 ","SPN6RDXB1 ","SPN6RDXB2 ","SPN6RDXB3 ","SPN6RDYB1 ", & + "SPN6RDYB2 ","SPN6RDYB3 ","SPN6RDZB1 ","SPN6RDZB2 ","SPN6RDZB3 ","SPN6TDXB1 ","SPN6TDXB2 ", & + "SPN6TDXB3 ","SPN6TDYB1 ","SPN6TDYB2 ","SPN6TDYB3 ","SPN6TDZB1 ","SPN6TDZB2 ","SPN6TDZB3 ", & + "SPN7ALGXB1","SPN7ALGXB2","SPN7ALGXB3","SPN7ALGYB1","SPN7ALGYB2","SPN7ALGYB3","SPN7ALGZB1", & + "SPN7ALGZB2","SPN7ALGZB3","SPN7ALXB1 ","SPN7ALXB2 ","SPN7ALXB3 ","SPN7ALYB1 ","SPN7ALYB2 ", & + "SPN7ALYB3 ","SPN7ALZB1 ","SPN7ALZB2 ","SPN7ALZB3 ","SPN7FLXB1 ","SPN7FLXB2 ","SPN7FLXB3 ", & + "SPN7FLYB1 ","SPN7FLYB2 ","SPN7FLYB3 ","SPN7FLZB1 ","SPN7FLZB2 ","SPN7FLZB3 ","SPN7MLXB1 ", & + "SPN7MLXB2 ","SPN7MLXB3 ","SPN7MLYB1 ","SPN7MLYB2 ","SPN7MLYB3 ","SPN7MLZB1 ","SPN7MLZB2 ", & + "SPN7MLZB3 ","SPN7RDXB1 ","SPN7RDXB2 ","SPN7RDXB3 ","SPN7RDYB1 ","SPN7RDYB2 ","SPN7RDYB3 ", & + "SPN7RDZB1 ","SPN7RDZB2 ","SPN7RDZB3 ","SPN7TDXB1 ","SPN7TDXB2 ","SPN7TDXB3 ","SPN7TDYB1 ", & + "SPN7TDYB2 ","SPN7TDYB3 ","SPN7TDZB1 ","SPN7TDZB2 ","SPN7TDZB3 ","SPN8ALGXB1","SPN8ALGXB2", & + "SPN8ALGXB3","SPN8ALGYB1","SPN8ALGYB2","SPN8ALGYB3","SPN8ALGZB1","SPN8ALGZB2","SPN8ALGZB3", & + "SPN8ALXB1 ","SPN8ALXB2 ","SPN8ALXB3 ","SPN8ALYB1 ","SPN8ALYB2 ","SPN8ALYB3 ","SPN8ALZB1 ", & + "SPN8ALZB2 ","SPN8ALZB3 ","SPN8FLXB1 ","SPN8FLXB2 ","SPN8FLXB3 ","SPN8FLYB1 ","SPN8FLYB2 ", & + "SPN8FLYB3 ","SPN8FLZB1 ","SPN8FLZB2 ","SPN8FLZB3 ","SPN8MLXB1 ","SPN8MLXB2 ","SPN8MLXB3 ", & + "SPN8MLYB1 ","SPN8MLYB2 ","SPN8MLYB3 ","SPN8MLZB1 ","SPN8MLZB2 ","SPN8MLZB3 ","SPN8RDXB1 ", & + "SPN8RDXB2 ","SPN8RDXB3 ","SPN8RDYB1 ","SPN8RDYB2 ","SPN8RDYB3 ","SPN8RDZB1 ","SPN8RDZB2 ", & + "SPN8RDZB3 ","SPN8TDXB1 ","SPN8TDXB2 ","SPN8TDXB3 ","SPN8TDYB1 ","SPN8TDYB2 ","SPN8TDYB3 ", & + "SPN8TDZB1 ","SPN8TDZB2 ","SPN8TDZB3 ","SPN9ALGXB1","SPN9ALGXB2","SPN9ALGXB3","SPN9ALGYB1", & + "SPN9ALGYB2","SPN9ALGYB3","SPN9ALGZB1","SPN9ALGZB2","SPN9ALGZB3","SPN9ALXB1 ","SPN9ALXB2 ", & + "SPN9ALXB3 ","SPN9ALYB1 ","SPN9ALYB2 ","SPN9ALYB3 ","SPN9ALZB1 ","SPN9ALZB2 ","SPN9ALZB3 ", & + "SPN9FLXB1 ","SPN9FLXB2 ","SPN9FLXB3 ","SPN9FLYB1 ","SPN9FLYB2 ","SPN9FLYB3 ","SPN9FLZB1 ", & + "SPN9FLZB2 ","SPN9FLZB3 ","SPN9MLXB1 ","SPN9MLXB2 ","SPN9MLXB3 ","SPN9MLYB1 ","SPN9MLYB2 ", & + "SPN9MLYB3 ","SPN9MLZB1 ","SPN9MLZB2 ","SPN9MLZB3 ","SPN9RDXB1 ","SPN9RDXB2 ","SPN9RDXB3 ", & + "SPN9RDYB1 ","SPN9RDYB2 ","SPN9RDYB3 ","SPN9RDZB1 ","SPN9RDZB2 ","SPN9RDZB3 ","SPN9TDXB1 ", & + "SPN9TDXB2 ","SPN9TDXB3 ","SPN9TDYB1 ","SPN9TDYB2 ","SPN9TDYB3 ","SPN9TDZB1 ","SPN9TDZB2 ", & + "SPN9TDZB3 ","TAILFURL ","TAILFURLA ","TAILFURLP ","TAILFURLV ","TEETAYA ","TEETDEFL ", & + "TEETPYA ","TEETVYA ","TFRLBRM ","TIP2TWR1 ","TIP2TWR2 ","TIP2TWR3 ","TIPALGXB1 ", & + "TIPALGXB2 ","TIPALGXB3 ","TIPALGYB1 ","TIPALGYB2 ","TIPALGYB3 ","TIPALGZB1 ","TIPALGZB2 ", & + "TIPALGZB3 ","TIPALXB1 ","TIPALXB2 ","TIPALXB3 ","TIPALYB1 ","TIPALYB2 ","TIPALYB3 ", & + "TIPALZB1 ","TIPALZB2 ","TIPALZB3 ","TIPCLRNC1 ","TIPCLRNC2 ","TIPCLRNC3 ","TIPDXB1 ", & + "TIPDXB2 ","TIPDXB3 ","TIPDXC1 ","TIPDXC2 ","TIPDXC3 ","TIPDYB1 ","TIPDYB2 ", & + "TIPDYB3 ","TIPDYC1 ","TIPDYC2 ","TIPDYC3 ","TIPDZB1 ","TIPDZB2 ","TIPDZB3 ", & + "TIPDZC1 ","TIPDZC2 ","TIPDZC3 ","TIPRDXB1 ","TIPRDXB2 ","TIPRDXB3 ","TIPRDYB1 ", & + "TIPRDYB2 ","TIPRDYB3 ","TIPRDZB1 ","TIPRDZB2 ","TIPRDZB3 ","TIPRDZC1 ","TIPRDZC2 ", & + "TIPRDZC3 ","TTDSPAX ","TTDSPFA ","TTDSPPTCH ","TTDSPROLL ","TTDSPSS ","TTDSPTWST ", & + "TWHT1ALGXT","TWHT1ALGYT","TWHT1ALGZT","TWHT1ALXT ","TWHT1ALYT ","TWHT1ALZT ","TWHT1FLXT ", & + "TWHT1FLYT ","TWHT1FLZT ","TWHT1MLXT ","TWHT1MLYT ","TWHT1MLZT ","TWHT1RDXT ","TWHT1RDYT ", & + "TWHT1RDZT ","TWHT1RPXI ","TWHT1RPYI ","TWHT1RPZI ","TWHT1TDXT ","TWHT1TDYT ","TWHT1TDZT ", & + "TWHT1TPXI ","TWHT1TPYI ","TWHT1TPZI ","TWHT2ALGXT","TWHT2ALGYT","TWHT2ALGZT","TWHT2ALXT ", & + "TWHT2ALYT ","TWHT2ALZT ","TWHT2FLXT ","TWHT2FLYT ","TWHT2FLZT ","TWHT2MLXT ","TWHT2MLYT ", & + "TWHT2MLZT ","TWHT2RDXT ","TWHT2RDYT ","TWHT2RDZT ","TWHT2RPXI ","TWHT2RPYI ","TWHT2RPZI ", & + "TWHT2TDXT ","TWHT2TDYT ","TWHT2TDZT ","TWHT2TPXI ","TWHT2TPYI ","TWHT2TPZI ","TWHT3ALGXT", & + "TWHT3ALGYT","TWHT3ALGZT","TWHT3ALXT ","TWHT3ALYT ","TWHT3ALZT ","TWHT3FLXT ","TWHT3FLYT ", & + "TWHT3FLZT ","TWHT3MLXT ","TWHT3MLYT ","TWHT3MLZT ","TWHT3RDXT ","TWHT3RDYT ","TWHT3RDZT ", & + "TWHT3RPXI ","TWHT3RPYI ","TWHT3RPZI ","TWHT3TDXT ","TWHT3TDYT ","TWHT3TDZT ","TWHT3TPXI ", & + "TWHT3TPYI ","TWHT3TPZI ","TWHT4ALGXT","TWHT4ALGYT","TWHT4ALGZT","TWHT4ALXT ","TWHT4ALYT ", & + "TWHT4ALZT ","TWHT4FLXT ","TWHT4FLYT ","TWHT4FLZT ","TWHT4MLXT ","TWHT4MLYT ","TWHT4MLZT ", & + "TWHT4RDXT ","TWHT4RDYT ","TWHT4RDZT ","TWHT4RPXI ","TWHT4RPYI ","TWHT4RPZI ","TWHT4TDXT ", & + "TWHT4TDYT ","TWHT4TDZT ","TWHT4TPXI ","TWHT4TPYI ","TWHT4TPZI ","TWHT5ALGXT","TWHT5ALGYT", & + "TWHT5ALGZT","TWHT5ALXT ","TWHT5ALYT ","TWHT5ALZT ","TWHT5FLXT ","TWHT5FLYT ","TWHT5FLZT ", & + "TWHT5MLXT ","TWHT5MLYT ","TWHT5MLZT ","TWHT5RDXT ","TWHT5RDYT ","TWHT5RDZT ","TWHT5RPXI ", & + "TWHT5RPYI ","TWHT5RPZI ","TWHT5TDXT ","TWHT5TDYT ","TWHT5TDZT ","TWHT5TPXI ","TWHT5TPYI ", & + "TWHT5TPZI ","TWHT6ALGXT","TWHT6ALGYT","TWHT6ALGZT","TWHT6ALXT ","TWHT6ALYT ","TWHT6ALZT ", & + "TWHT6FLXT ","TWHT6FLYT ","TWHT6FLZT ","TWHT6MLXT ","TWHT6MLYT ","TWHT6MLZT ","TWHT6RDXT ", & + "TWHT6RDYT ","TWHT6RDZT ","TWHT6RPXI ","TWHT6RPYI ","TWHT6RPZI ","TWHT6TDXT ","TWHT6TDYT ", & + "TWHT6TDZT ","TWHT6TPXI ","TWHT6TPYI ","TWHT6TPZI ","TWHT7ALGXT","TWHT7ALGYT","TWHT7ALGZT", & + "TWHT7ALXT ","TWHT7ALYT ","TWHT7ALZT ","TWHT7FLXT ","TWHT7FLYT ","TWHT7FLZT ","TWHT7MLXT ", & + "TWHT7MLYT ","TWHT7MLZT ","TWHT7RDXT ","TWHT7RDYT ","TWHT7RDZT ","TWHT7RPXI ","TWHT7RPYI ", & + "TWHT7RPZI ","TWHT7TDXT ","TWHT7TDYT ","TWHT7TDZT ","TWHT7TPXI ","TWHT7TPYI ","TWHT7TPZI ", & + "TWHT8ALGXT","TWHT8ALGYT","TWHT8ALGZT","TWHT8ALXT ","TWHT8ALYT ","TWHT8ALZT ","TWHT8FLXT ", & + "TWHT8FLYT ","TWHT8FLZT ","TWHT8MLXT ","TWHT8MLYT ","TWHT8MLZT ","TWHT8RDXT ","TWHT8RDYT ", & + "TWHT8RDZT ","TWHT8RPXI ","TWHT8RPYI ","TWHT8RPZI ","TWHT8TDXT ","TWHT8TDYT ","TWHT8TDZT ", & + "TWHT8TPXI ","TWHT8TPYI ","TWHT8TPZI ","TWHT9ALGXT","TWHT9ALGYT","TWHT9ALGZT","TWHT9ALXT ", & + "TWHT9ALYT ","TWHT9ALZT ","TWHT9FLXT ","TWHT9FLYT ","TWHT9FLZT ","TWHT9MLXT ","TWHT9MLYT ", & + "TWHT9MLZT ","TWHT9RDXT ","TWHT9RDYT ","TWHT9RDZT ","TWHT9RPXI ","TWHT9RPYI ","TWHT9RPZI ", & + "TWHT9TDXT ","TWHT9TDYT ","TWHT9TDZT ","TWHT9TPXI ","TWHT9TPYI ","TWHT9TPZI ","TWRBSFXT ", & + "TWRBSFYT ","TWRBSFZT ","TWRBSMXT ","TWRBSMYT ","TWRBSMZT ","TWRCLRNC1 ","TWRCLRNC2 ", & + "TWRCLRNC3 ","TWRTPTDXI ","TWRTPTDYI ","TWRTPTDZI ","TWSTDEFL1 ","TWSTDEFL2 ","TWSTDEFL3 ", & + "YAWACCEL ","YAWAZN ","YAWAZP ","YAWBRFXN ","YAWBRFXP ","YAWBRFYN ","YAWBRFYP ", & + "YAWBRFZN ","YAWBRFZP ","YAWBRMXN ","YAWBRMXP ","YAWBRMYN ","YAWBRMYP ","YAWBRMZN ", & + "YAWBRMZP ","YAWBRRAXP ","YAWBRRAYP ","YAWBRRAZP ","YAWBRRDXT ","YAWBRRDYT ","YAWBRRDZT ", & + "YAWBRRVXP ","YAWBRRVYP ","YAWBRRVZP ","YAWBRTAGXP","YAWBRTAGYP","YAWBRTAGZP","YAWBRTAXP ", & + "YAWBRTAYP ","YAWBRTAZP ","YAWBRTDXI ","YAWBRTDXP ","YAWBRTDXT ","YAWBRTDYI ","YAWBRTDYP ", & + "YAWBRTDYT ","YAWBRTDZI ","YAWBRTDZP ","YAWBRTDZT ","YAWBRTVXP ","YAWBRTVYP ","YAWBRTVZP ", & + "YAWFRIMFP ","YAWFRIMOM ","YAWFRIMZ ","YAWPOS ","YAWPZN ","YAWPZP ","YAWRATE ", & + "YAWVZN ","YAWVZP "/) + INTEGER(IntKi), PARAMETER :: ParamIndxAry(1115) = (/ & ! This lists the index into AllOuts(:) of the allowed parameters ValidParamAry(:) + LSSTipPxa , PtchPMzc1 , PtchPMzc2 , PtchPMzc3 , PtchPMzc1 , PtchPMzc2 , PtchPMzc3 , & + dOmegaYF , HSShftA , HSShftV , HSSBrTq , HSShftA , HSShftPwr , HSShftTq , & + HSShftV , TipDyc1 , TipDyc2 , TipDyc3 , LSSGagAxa , LSSGagAxa , LSSGagAxa , & + LSShftFxa , LSShftFxa , LSShftFya , LSShftFys , LSShftFza , LSShftFzs , LSShftMxa , & + LSShftMxa , LSSGagMya , LSSGagMys , LSSGagMza , LSSGagMzs , LSSGagPxa , LSSGagPxa , & + LSSGagPxa , LSSGagVxa , LSSGagVxa , LSSGagVxa , LSShftFxa , LSShftFxa , LSShftFya , & + LSShftFys , LSShftFza , LSShftFzs , LSShftMxa , LSShftMxa , RotPwr , LSShftMxa , & + LSSTipAxa , LSSTipAxa , LSSTipAxa , LSSTipMya , LSSTipMys , LSSTipMza , LSSTipMzs , & + LSSTipPxa , LSSTipPxa , LSSTipPxa , LSSTipVxa , LSSTipVxa , LSSTipVxa , YawPzn , & + YawAzn , YawPzn , YawVzn , NcIMURAxs , NcIMURAys , NcIMURAzs , NcIMURVxs , & + NcIMURVys , NcIMURVzs , NcIMUTAgxs , NcIMUTAgys , NcIMUTAgzs , NcIMUTAxs , NcIMUTAys , & + NcIMUTAzs , NcIMUTVxs , NcIMUTVys , NcIMUTVzs , OmegaYF , TipDxc1 , TipDxc2 , & + TipDxc3 , TipRDyb1 , TipRDyb2 , TipRDyb3 , PtchPMzc1 , PtchPMzc2 , PtchPMzc3 , & + PtchPMzc1 , PtchPMzc2 , PtchPMzc3 , PtfmTDzi , PtfmRDyi , PtfmRAxi , PtfmRAxt , & + PtfmRAyi , PtfmRAyt , PtfmRAzi , PtfmRAzt , PtfmRDxi , PtfmRDyi , PtfmRDzi , & + PtfmRDxi , PtfmRVxi , PtfmRVxt , PtfmRVyi , PtfmRVyt , PtfmRVzi , PtfmRVzt , & + PtfmTDxi , PtfmTDyi , PtfmTAgxi , PtfmTAgxt , PtfmTAgyi , PtfmTAgyt , PtfmTAgzi , & + PtfmTAgzt , PtfmTAxi , PtfmTAxt , PtfmTAyi , PtfmTAyt , PtfmTAzi , PtfmTAzt , & + PtfmTDxi , PtfmTDxt , PtfmTDyi , PtfmTDyt , PtfmTDzi , PtfmTDzt , PtfmTVxi , & + PtfmTVxt , PtfmTVyi , PtfmTVyt , PtfmTVzi , PtfmTVzt , PtfmRDzi , QD2_B1E1 , & + QD2_B1F1 , QD2_B1F2 , QD2_B2E1 , QD2_B2F1 , QD2_B2F2 , QD2_B3E1 , QD2_B3F1 , & + QD2_B3F2 , QD2_DrTr , QD2_GeAz , QD2_Hv , QD2_P , QD2_R , QD2_RFrl , & + QD2_Sg , QD2_Sw , QD2_Teet , QD2_TFA1 , QD2_TFA2 , QD2_TFrl , QD2_TSS1 , & + QD2_TSS2 , QD2_Y , QD2_Yaw , QD_B1E1 , QD_B1F1 , QD_B1F2 , QD_B2E1 , & + QD_B2F1 , QD_B2F2 , QD_B3E1 , QD_B3F1 , QD_B3F2 , QD_DrTr , QD_GeAz , & + QD_Hv , QD_P , QD_R , QD_RFrl , QD_Sg , QD_Sw , QD_Teet , & + QD_TFA1 , QD_TFA2 , QD_TFrl , QD_TSS1 , QD_TSS2 , QD_Y , QD_Yaw , & + Q_B1E1 , Q_B1F1 , Q_B1F2 , Q_B2E1 , Q_B2F1 , Q_B2F2 , Q_B3E1 , & + Q_B3F1 , Q_B3F2 , Q_DrTr , Q_GeAz , Q_Hv , Q_P , Q_R , & + Q_RFrl , Q_Sg , Q_Sw , Q_Teet , Q_TFA1 , Q_TFA2 , Q_TFrl , & + Q_TSS1 , Q_TSS2 , Q_Y , Q_Yaw , RFrlBrM , TipRDxb1 , TipRDxb2 , & + TipRDxb3 , RootFxb1 , RootFxb2 , RootFxb3 , RootFxc1 , RootFxc2 , RootFxc3 , & + RootFyb1 , RootFyb2 , RootFyb3 , RootFyc1 , RootFyc2 , RootFyc3 , RootFzc1 , & + RootFzc2 , RootFzc3 , RootFzc1 , RootFzc2 , RootFzc3 , RootMxb1 , RootMxb2 , & + RootMxb3 , RootMyb1 , RootMyb2 , RootMyb3 , RootMxc1 , RootMxc2 , RootMxc3 , & + RootMyc1 , RootMyc2 , RootMyc3 , RootMxb1 , RootMxb2 , RootMxb3 , RootMxc1 , & + RootMxc2 , RootMxc3 , RootMyb1 , RootMyb2 , RootMyb3 , RootMyc1 , RootMyc2 , & + RootMyc3 , RootMzc1 , RootMzc2 , RootMzc3 , RootMzc1 , RootMzc2 , RootMzc3 , & + LSSTipAxa , RotFurlP , RotFurlA , RotFurlP , RotFurlV , RotPwr , LSSTipVxa , & + TeetAya , TeetPya , TeetVya , LSShftFxa , LSShftMxa , Spn1ALgxb1 , Spn1ALgxb2 , & + Spn1ALgxb3 , Spn1ALgyb1 , Spn1ALgyb2 , Spn1ALgyb3 , Spn1ALgzb1 , Spn1ALgzb2 , Spn1ALgzb3 , & + Spn1ALxb1 , Spn1ALxb2 , Spn1ALxb3 , Spn1ALyb1 , Spn1ALyb2 , Spn1ALyb3 , Spn1ALzb1 , & + Spn1ALzb2 , Spn1ALzb3 , Spn1FLxb1 , Spn1FLxb2 , Spn1FLxb3 , Spn1FLyb1 , Spn1FLyb2 , & + Spn1FLyb3 , Spn1FLzb1 , Spn1FLzb2 , Spn1FLzb3 , Spn1MLxb1 , Spn1MLxb2 , Spn1MLxb3 , & + Spn1MLyb1 , Spn1MLyb2 , Spn1MLyb3 , Spn1MLzb1 , Spn1MLzb2 , Spn1MLzb3 , Spn1RDxb1 , & + Spn1RDxb2 , Spn1RDxb3 , Spn1RDyb1 , Spn1RDyb2 , Spn1RDyb3 , Spn1RDzb1 , Spn1RDzb2 , & + Spn1RDzb3 , Spn1TDxb1 , Spn1TDxb2 , Spn1TDxb3 , Spn1TDyb1 , Spn1TDyb2 , Spn1TDyb3 , & + Spn1TDzb1 , Spn1TDzb2 , Spn1TDzb3 , Spn2ALgxb1 , Spn2ALgxb2 , Spn2ALgxb3 , Spn2ALgyb1 , & + Spn2ALgyb2 , Spn2ALgyb3 , Spn2ALgzb1 , Spn2ALgzb2 , Spn2ALgzb3 , Spn2ALxb1 , Spn2ALxb2 , & + Spn2ALxb3 , Spn2ALyb1 , Spn2ALyb2 , Spn2ALyb3 , Spn2ALzb1 , Spn2ALzb2 , Spn2ALzb3 , & + Spn2FLxb1 , Spn2FLxb2 , Spn2FLxb3 , Spn2FLyb1 , Spn2FLyb2 , Spn2FLyb3 , Spn2FLzb1 , & + Spn2FLzb2 , Spn2FLzb3 , Spn2MLxb1 , Spn2MLxb2 , Spn2MLxb3 , Spn2MLyb1 , Spn2MLyb2 , & + Spn2MLyb3 , Spn2MLzb1 , Spn2MLzb2 , Spn2MLzb3 , Spn2RDxb1 , Spn2RDxb2 , Spn2RDxb3 , & + Spn2RDyb1 , Spn2RDyb2 , Spn2RDyb3 , Spn2RDzb1 , Spn2RDzb2 , Spn2RDzb3 , Spn2TDxb1 , & + Spn2TDxb2 , Spn2TDxb3 , Spn2TDyb1 , Spn2TDyb2 , Spn2TDyb3 , Spn2TDzb1 , Spn2TDzb2 , & + Spn2TDzb3 , Spn3ALgxb1 , Spn3ALgxb2 , Spn3ALgxb3 , Spn3ALgyb1 , Spn3ALgyb2 , Spn3ALgyb3 , & + Spn3ALgzb1 , Spn3ALgzb2 , Spn3ALgzb3 , Spn3ALxb1 , Spn3ALxb2 , Spn3ALxb3 , Spn3ALyb1 , & + Spn3ALyb2 , Spn3ALyb3 , Spn3ALzb1 , Spn3ALzb2 , Spn3ALzb3 , Spn3FLxb1 , Spn3FLxb2 , & + Spn3FLxb3 , Spn3FLyb1 , Spn3FLyb2 , Spn3FLyb3 , Spn3FLzb1 , Spn3FLzb2 , Spn3FLzb3 , & + Spn3MLxb1 , Spn3MLxb2 , Spn3MLxb3 , Spn3MLyb1 , Spn3MLyb2 , Spn3MLyb3 , Spn3MLzb1 , & + Spn3MLzb2 , Spn3MLzb3 , Spn3RDxb1 , Spn3RDxb2 , Spn3RDxb3 , Spn3RDyb1 , Spn3RDyb2 , & + Spn3RDyb3 , Spn3RDzb1 , Spn3RDzb2 , Spn3RDzb3 , Spn3TDxb1 , Spn3TDxb2 , Spn3TDxb3 , & + Spn3TDyb1 , Spn3TDyb2 , Spn3TDyb3 , Spn3TDzb1 , Spn3TDzb2 , Spn3TDzb3 , Spn4ALgxb1 , & + Spn4ALgxb2 , Spn4ALgxb3 , Spn4ALgyb1 , Spn4ALgyb2 , Spn4ALgyb3 , Spn4ALgzb1 , Spn4ALgzb2 , & + Spn4ALgzb3 , Spn4ALxb1 , Spn4ALxb2 , Spn4ALxb3 , Spn4ALyb1 , Spn4ALyb2 , Spn4ALyb3 , & + Spn4ALzb1 , Spn4ALzb2 , Spn4ALzb3 , Spn4FLxb1 , Spn4FLxb2 , Spn4FLxb3 , Spn4FLyb1 , & + Spn4FLyb2 , Spn4FLyb3 , Spn4FLzb1 , Spn4FLzb2 , Spn4FLzb3 , Spn4MLxb1 , Spn4MLxb2 , & + Spn4MLxb3 , Spn4MLyb1 , Spn4MLyb2 , Spn4MLyb3 , Spn4MLzb1 , Spn4MLzb2 , Spn4MLzb3 , & + Spn4RDxb1 , Spn4RDxb2 , Spn4RDxb3 , Spn4RDyb1 , Spn4RDyb2 , Spn4RDyb3 , Spn4RDzb1 , & + Spn4RDzb2 , Spn4RDzb3 , Spn4TDxb1 , Spn4TDxb2 , Spn4TDxb3 , Spn4TDyb1 , Spn4TDyb2 , & + Spn4TDyb3 , Spn4TDzb1 , Spn4TDzb2 , Spn4TDzb3 , Spn5ALgxb1 , Spn5ALgxb2 , Spn5ALgxb3 , & + Spn5ALgyb1 , Spn5ALgyb2 , Spn5ALgyb3 , Spn5ALgzb1 , Spn5ALgzb2 , Spn5ALgzb3 , Spn5ALxb1 , & + Spn5ALxb2 , Spn5ALxb3 , Spn5ALyb1 , Spn5ALyb2 , Spn5ALyb3 , Spn5ALzb1 , Spn5ALzb2 , & + Spn5ALzb3 , Spn5FLxb1 , Spn5FLxb2 , Spn5FLxb3 , Spn5FLyb1 , Spn5FLyb2 , Spn5FLyb3 , & + Spn5FLzb1 , Spn5FLzb2 , Spn5FLzb3 , Spn5MLxb1 , Spn5MLxb2 , Spn5MLxb3 , Spn5MLyb1 , & + Spn5MLyb2 , Spn5MLyb3 , Spn5MLzb1 , Spn5MLzb2 , Spn5MLzb3 , Spn5RDxb1 , Spn5RDxb2 , & + Spn5RDxb3 , Spn5RDyb1 , Spn5RDyb2 , Spn5RDyb3 , Spn5RDzb1 , Spn5RDzb2 , Spn5RDzb3 , & + Spn5TDxb1 , Spn5TDxb2 , Spn5TDxb3 , Spn5TDyb1 , Spn5TDyb2 , Spn5TDyb3 , Spn5TDzb1 , & + Spn5TDzb2 , Spn5TDzb3 , Spn6ALgxb1 , Spn6ALgxb2 , Spn6ALgxb3 , Spn6ALgyb1 , Spn6ALgyb2 , & + Spn6ALgyb3 , Spn6ALgzb1 , Spn6ALgzb2 , Spn6ALgzb3 , Spn6ALxb1 , Spn6ALxb2 , Spn6ALxb3 , & + Spn6ALyb1 , Spn6ALyb2 , Spn6ALyb3 , Spn6ALzb1 , Spn6ALzb2 , Spn6ALzb3 , Spn6FLxb1 , & + Spn6FLxb2 , Spn6FLxb3 , Spn6FLyb1 , Spn6FLyb2 , Spn6FLyb3 , Spn6FLzb1 , Spn6FLzb2 , & + Spn6FLzb3 , Spn6MLxb1 , Spn6MLxb2 , Spn6MLxb3 , Spn6MLyb1 , Spn6MLyb2 , Spn6MLyb3 , & + Spn6MLzb1 , Spn6MLzb2 , Spn6MLzb3 , Spn6RDxb1 , Spn6RDxb2 , Spn6RDxb3 , Spn6RDyb1 , & + Spn6RDyb2 , Spn6RDyb3 , Spn6RDzb1 , Spn6RDzb2 , Spn6RDzb3 , Spn6TDxb1 , Spn6TDxb2 , & + Spn6TDxb3 , Spn6TDyb1 , Spn6TDyb2 , Spn6TDyb3 , Spn6TDzb1 , Spn6TDzb2 , Spn6TDzb3 , & + Spn7ALgxb1 , Spn7ALgxb2 , Spn7ALgxb3 , Spn7ALgyb1 , Spn7ALgyb2 , Spn7ALgyb3 , Spn7ALgzb1 , & + Spn7ALgzb2 , Spn7ALgzb3 , Spn7ALxb1 , Spn7ALxb2 , Spn7ALxb3 , Spn7ALyb1 , Spn7ALyb2 , & + Spn7ALyb3 , Spn7ALzb1 , Spn7ALzb2 , Spn7ALzb3 , Spn7FLxb1 , Spn7FLxb2 , Spn7FLxb3 , & + Spn7FLyb1 , Spn7FLyb2 , Spn7FLyb3 , Spn7FLzb1 , Spn7FLzb2 , Spn7FLzb3 , Spn7MLxb1 , & + Spn7MLxb2 , Spn7MLxb3 , Spn7MLyb1 , Spn7MLyb2 , Spn7MLyb3 , Spn7MLzb1 , Spn7MLzb2 , & + Spn7MLzb3 , Spn7RDxb1 , Spn7RDxb2 , Spn7RDxb3 , Spn7RDyb1 , Spn7RDyb2 , Spn7RDyb3 , & + Spn7RDzb1 , Spn7RDzb2 , Spn7RDzb3 , Spn7TDxb1 , Spn7TDxb2 , Spn7TDxb3 , Spn7TDyb1 , & + Spn7TDyb2 , Spn7TDyb3 , Spn7TDzb1 , Spn7TDzb2 , Spn7TDzb3 , Spn8ALgxb1 , Spn8ALgxb2 , & + Spn8ALgxb3 , Spn8ALgyb1 , Spn8ALgyb2 , Spn8ALgyb3 , Spn8ALgzb1 , Spn8ALgzb2 , Spn8ALgzb3 , & + Spn8ALxb1 , Spn8ALxb2 , Spn8ALxb3 , Spn8ALyb1 , Spn8ALyb2 , Spn8ALyb3 , Spn8ALzb1 , & + Spn8ALzb2 , Spn8ALzb3 , Spn8FLxb1 , Spn8FLxb2 , Spn8FLxb3 , Spn8FLyb1 , Spn8FLyb2 , & + Spn8FLyb3 , Spn8FLzb1 , Spn8FLzb2 , Spn8FLzb3 , Spn8MLxb1 , Spn8MLxb2 , Spn8MLxb3 , & + Spn8MLyb1 , Spn8MLyb2 , Spn8MLyb3 , Spn8MLzb1 , Spn8MLzb2 , Spn8MLzb3 , Spn8RDxb1 , & + Spn8RDxb2 , Spn8RDxb3 , Spn8RDyb1 , Spn8RDyb2 , Spn8RDyb3 , Spn8RDzb1 , Spn8RDzb2 , & + Spn8RDzb3 , Spn8TDxb1 , Spn8TDxb2 , Spn8TDxb3 , Spn8TDyb1 , Spn8TDyb2 , Spn8TDyb3 , & + Spn8TDzb1 , Spn8TDzb2 , Spn8TDzb3 , Spn9ALgxb1 , Spn9ALgxb2 , Spn9ALgxb3 , Spn9ALgyb1 , & + Spn9ALgyb2 , Spn9ALgyb3 , Spn9ALgzb1 , Spn9ALgzb2 , Spn9ALgzb3 , Spn9ALxb1 , Spn9ALxb2 , & + Spn9ALxb3 , Spn9ALyb1 , Spn9ALyb2 , Spn9ALyb3 , Spn9ALzb1 , Spn9ALzb2 , Spn9ALzb3 , & + Spn9FLxb1 , Spn9FLxb2 , Spn9FLxb3 , Spn9FLyb1 , Spn9FLyb2 , Spn9FLyb3 , Spn9FLzb1 , & + Spn9FLzb2 , Spn9FLzb3 , Spn9MLxb1 , Spn9MLxb2 , Spn9MLxb3 , Spn9MLyb1 , Spn9MLyb2 , & + Spn9MLyb3 , Spn9MLzb1 , Spn9MLzb2 , Spn9MLzb3 , Spn9RDxb1 , Spn9RDxb2 , Spn9RDxb3 , & + Spn9RDyb1 , Spn9RDyb2 , Spn9RDyb3 , Spn9RDzb1 , Spn9RDzb2 , Spn9RDzb3 , Spn9TDxb1 , & + Spn9TDxb2 , Spn9TDxb3 , Spn9TDyb1 , Spn9TDyb2 , Spn9TDyb3 , Spn9TDzb1 , Spn9TDzb2 , & + Spn9TDzb3 , TailFurlP , TailFurlA , TailFurlP , TailFurlV , TeetAya , TeetPya , & + TeetPya , TeetVya , TFrlBrM , TipClrnc1 , TipClrnc2 , TipClrnc3 , TipALgxb1 , & + TipALgxb2 , TipALgxb3 , TipALgyb1 , TipALgyb2 , TipALgyb3 , TipALgzb1 , TipALgzb2 , & + TipALgzb3 , TipALxb1 , TipALxb2 , TipALxb3 , TipALyb1 , TipALyb2 , TipALyb3 , & + TipALzb1 , TipALzb2 , TipALzb3 , TipClrnc1 , TipClrnc2 , TipClrnc3 , TipDxb1 , & + TipDxb2 , TipDxb3 , TipDxc1 , TipDxc2 , TipDxc3 , TipDyb1 , TipDyb2 , & + TipDyb3 , TipDyc1 , TipDyc2 , TipDyc3 , TipDzc1 , TipDzc2 , TipDzc3 , & + TipDzc1 , TipDzc2 , TipDzc3 , TipRDxb1 , TipRDxb2 , TipRDxb3 , TipRDyb1 , & + TipRDyb2 , TipRDyb3 , TipRDzc1 , TipRDzc2 , TipRDzc3 , TipRDzc1 , TipRDzc2 , & + TipRDzc3 , YawBrTDzt , YawBrTDxt , YawBrRDyt , YawBrRDxt , YawBrTDyt , YawBrRDzt , & + TwHt1ALgxt , TwHt1ALgyt , TwHt1ALgzt , TwHt1ALxt , TwHt1ALyt , TwHt1ALzt , TwHt1FLxt , & + TwHt1FLyt , TwHt1FLzt , TwHt1MLxt , TwHt1MLyt , TwHt1MLzt , TwHt1RDxt , TwHt1RDyt , & + TwHt1RDzt , TwHt1RPxi , TwHt1RPyi , TwHt1RPzi , TwHt1TDxt , TwHt1TDyt , TwHt1TDzt , & + TwHt1TPxi , TwHt1TPyi , TwHt1TPzi , TwHt2ALgxt , TwHt2ALgyt , TwHt2ALgzt , TwHt2ALxt , & + TwHt2ALyt , TwHt2ALzt , TwHt2FLxt , TwHt2FLyt , TwHt2FLzt , TwHt2MLxt , TwHt2MLyt , & + TwHt2MLzt , TwHt2RDxt , TwHt2RDyt , TwHt2RDzt , TwHt2RPxi , TwHt2RPyi , TwHt2RPzi , & + TwHt2TDxt , TwHt2TDyt , TwHt2TDzt , TwHt2TPxi , TwHt2TPyi , TwHt2TPzi , TwHt3ALgxt , & + TwHt3ALgyt , TwHt3ALgzt , TwHt3ALxt , TwHt3ALyt , TwHt3ALzt , TwHt3FLxt , TwHt3FLyt , & + TwHt3FLzt , TwHt3MLxt , TwHt3MLyt , TwHt3MLzt , TwHt3RDxt , TwHt3RDyt , TwHt3RDzt , & + TwHt3RPxi , TwHt3RPyi , TwHt3RPzi , TwHt3TDxt , TwHt3TDyt , TwHt3TDzt , TwHt3TPxi , & + TwHt3TPyi , TwHt3TPzi , TwHt4ALgxt , TwHt4ALgyt , TwHt4ALgzt , TwHt4ALxt , TwHt4ALyt , & + TwHt4ALzt , TwHt4FLxt , TwHt4FLyt , TwHt4FLzt , TwHt4MLxt , TwHt4MLyt , TwHt4MLzt , & + TwHt4RDxt , TwHt4RDyt , TwHt4RDzt , TwHt4RPxi , TwHt4RPyi , TwHt4RPzi , TwHt4TDxt , & + TwHt4TDyt , TwHt4TDzt , TwHt4TPxi , TwHt4TPyi , TwHt4TPzi , TwHt5ALgxt , TwHt5ALgyt , & + TwHt5ALgzt , TwHt5ALxt , TwHt5ALyt , TwHt5ALzt , TwHt5FLxt , TwHt5FLyt , TwHt5FLzt , & + TwHt5MLxt , TwHt5MLyt , TwHt5MLzt , TwHt5RDxt , TwHt5RDyt , TwHt5RDzt , TwHt5RPxi , & + TwHt5RPyi , TwHt5RPzi , TwHt5TDxt , TwHt5TDyt , TwHt5TDzt , TwHt5TPxi , TwHt5TPyi , & + TwHt5TPzi , TwHt6ALgxt , TwHt6ALgyt , TwHt6ALgzt , TwHt6ALxt , TwHt6ALyt , TwHt6ALzt , & + TwHt6FLxt , TwHt6FLyt , TwHt6FLzt , TwHt6MLxt , TwHt6MLyt , TwHt6MLzt , TwHt6RDxt , & + TwHt6RDyt , TwHt6RDzt , TwHt6RPxi , TwHt6RPyi , TwHt6RPzi , TwHt6TDxt , TwHt6TDyt , & + TwHt6TDzt , TwHt6TPxi , TwHt6TPyi , TwHt6TPzi , TwHt7ALgxt , TwHt7ALgyt , TwHt7ALgzt , & + TwHt7ALxt , TwHt7ALyt , TwHt7ALzt , TwHt7FLxt , TwHt7FLyt , TwHt7FLzt , TwHt7MLxt , & + TwHt7MLyt , TwHt7MLzt , TwHt7RDxt , TwHt7RDyt , TwHt7RDzt , TwHt7RPxi , TwHt7RPyi , & + TwHt7RPzi , TwHt7TDxt , TwHt7TDyt , TwHt7TDzt , TwHt7TPxi , TwHt7TPyi , TwHt7TPzi , & + TwHt8ALgxt , TwHt8ALgyt , TwHt8ALgzt , TwHt8ALxt , TwHt8ALyt , TwHt8ALzt , TwHt8FLxt , & + TwHt8FLyt , TwHt8FLzt , TwHt8MLxt , TwHt8MLyt , TwHt8MLzt , TwHt8RDxt , TwHt8RDyt , & + TwHt8RDzt , TwHt8RPxi , TwHt8RPyi , TwHt8RPzi , TwHt8TDxt , TwHt8TDyt , TwHt8TDzt , & + TwHt8TPxi , TwHt8TPyi , TwHt8TPzi , TwHt9ALgxt , TwHt9ALgyt , TwHt9ALgzt , TwHt9ALxt , & + TwHt9ALyt , TwHt9ALzt , TwHt9FLxt , TwHt9FLyt , TwHt9FLzt , TwHt9MLxt , TwHt9MLyt , & + TwHt9MLzt , TwHt9RDxt , TwHt9RDyt , TwHt9RDzt , TwHt9RPxi , TwHt9RPyi , TwHt9RPzi , & + TwHt9TDxt , TwHt9TDyt , TwHt9TDzt , TwHt9TPxi , TwHt9TPyi , TwHt9TPzi , TwrBsFxt , & + TwrBsFyt , TwrBsFzt , TwrBsMxt , TwrBsMyt , TwrBsMzt , TipClrnc1 , TipClrnc2 , & + TipClrnc3 , TwrTpTDxi , TwrTpTDyi , TwrTpTDzi , TipRDzc1 , TipRDzc2 , TipRDzc3 , & + YawAzn , YawAzn , YawAzn , YawBrFxn , YawBrFxp , YawBrFyn , YawBrFyp , & + YawBrFzn , YawBrFzn , YawBrMxn , YawBrMxp , YawBrMyn , YawBrMyp , YawBrMzn , & + YawBrMzn , YawBrRAxp , YawBrRAyp , YawBrRAzp , YawBrRDxt , YawBrRDyt , YawBrRDzt , & + YawBrRVxp , YawBrRVyp , YawBrRVzp , YawBrTAgxp , YawBrTAgyp , YawBrTAgzp , YawBrTAxp , & + YawBrTAyp , YawBrTAzp , TwrTpTDxi , YawBrTDxp , YawBrTDxt , TwrTpTDyi , YawBrTDyp , & + YawBrTDyt , TwrTpTDzi , YawBrTDzp , YawBrTDzt , YawBrTVxp , YawBrTVyp , YawBrTVzp , & + YawFriMfp , YawFriMom , YawFriMz , YawPzn , YawPzn , YawPzn , YawVzn , & + YawVzn , YawVzn /) + CHARACTER(ChanLen), PARAMETER :: ParamUnitsAry(1115) = (/ character(ChanLen) :: & ! This lists the units corresponding to the allowed parameters + "(deg) ","(deg) ","(deg) ","(deg) ","(deg) ","(deg) ","(deg) ", & + "(deg/s^2)","(deg/s^2)","(rpm) ","(kN-m) ","(deg/s^2)","(kW) ","(kN-m) ", & + "(rpm) ","(m) ","(m) ","(m) ","(deg/s^2)","(deg/s^2)","(deg/s^2)", & + "(kN) ","(kN) ","(kN) ","(kN) ","(kN) ","(kN) ","(kN-m) ", & + "(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ","(deg) ","(deg) ", & + "(deg) ","(rpm) ","(rpm) ","(rpm) ","(kN) ","(kN) ","(kN) ", & + "(kN) ","(kN) ","(kN) ","(kN-m) ","(kN-m) ","(kW) ","(kN-m) ", & + "(deg/s^2)","(deg/s^2)","(deg/s^2)","(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ", & + "(deg) ","(deg) ","(deg) ","(rpm) ","(rpm) ","(rpm) ","(deg) ", & + "(deg/s^2)","(deg) ","(deg/s) ","(deg/s^2)","(deg/s^2)","(deg/s^2)","(deg/s) ", & + "(deg/s) ","(deg/s) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ", & + "(m/s^2) ","(m/s) ","(m/s) ","(m/s) ","(deg/s) ","(m) ","(m) ", & + "(m) ","(deg) ","(deg) ","(deg) ","(deg) ","(deg) ","(deg) ", & + "(deg) ","(deg) ","(deg) ","(m) ","(deg) ","(deg/s^2)","(deg/s^2)", & + "(deg/s^2)","(deg/s^2)","(deg/s^2)","(deg/s^2)","(deg) ","(deg) ","(deg) ", & + "(deg) ","(deg/s) ","(deg/s) ","(deg/s) ","(deg/s) ","(deg/s) ","(deg/s) ", & + "(m) ","(m) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ", & + "(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ", & + "(m) ","(m) ","(m) ","(m) ","(m) ","(m) ","(m/s) ", & + "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(deg) ","(m/s^2) ", & + "(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ", & + "(m/s^2) ","(rad/s^2)","(rad/s^2)","(m/s^2) ","(rad/s^2)","(rad/s^2)","(rad/s^2)", & + "(m/s^2) ","(m/s^2) ","(rad/s^2)","(m/s^2) ","(m/s^2) ","(rad/s^2)","(m/s^2) ", & + "(m/s^2) ","(rad/s^2)","(rad/s^2)","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & + "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(rad/s) ","(rad/s) ", & + "(m/s) ","(rad/s) ","(rad/s) ","(rad/s) ","(m/s) ","(m/s) ","(rad/s) ", & + "(m/s) ","(m/s) ","(rad/s) ","(m/s) ","(m/s) ","(rad/s) ","(rad/s) ", & + "(m) ","(m) ","(m) ","(m) ","(m) ","(m) ","(m) ", & + "(m) ","(m) ","(rad) ","(rad) ","(m) ","(rad) ","(rad) ", & + "(rad) ","(m) ","(m) ","(rad) ","(m) ","(m) ","(rad) ", & + "(m) ","(m) ","(rad) ","(rad) ","(kN-m) ","(deg) ","(deg) ", & + "(deg) ","(kN) ","(kN) ","(kN) ","(kN) ","(kN) ","(kN) ", & + "(kN) ","(kN) ","(kN) ","(kN) ","(kN) ","(kN) ","(kN) ", & + "(kN) ","(kN) ","(kN) ","(kN) ","(kN) ","(kN-m) ","(kN-m) ", & + "(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ", & + "(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ", & + "(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ", & + "(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ", & + "(deg/s^2)","(deg) ","(deg/s^2)","(deg) ","(deg/s) ","(kW) ","(rpm) ", & + "(deg/s^2)","(deg) ","(deg/s) ","(kN) ","(kN-m) ","(m/s^2) ","(m/s^2) ", & + "(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ", & + "(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ", & + "(m/s^2) ","(m/s^2) ","(kN) ","(kN) ","(kN) ","(kN) ","(kN) ", & + "(kN) ","(kN) ","(kN) ","(kN) ","(kN-m) ","(kN-m) ","(kN-m) ", & + "(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ","(deg) ", & + "(deg) ","(deg) ","(deg) ","(deg) ","(deg) ","(deg) ","(deg) ", & + "(deg) ","(m) ","(m) ","(m) ","(m) ","(m) ","(m) ", & + "(m) ","(m) ","(m) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ", & + "(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ", & + "(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ", & + "(kN) ","(kN) ","(kN) ","(kN) ","(kN) ","(kN) ","(kN) ", & + "(kN) ","(kN) ","(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ", & + "(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ","(deg) ","(deg) ","(deg) ", & + "(deg) ","(deg) ","(deg) ","(deg) ","(deg) ","(deg) ","(m) ", & + "(m) ","(m) ","(m) ","(m) ","(m) ","(m) ","(m) ", & + "(m) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ", & + "(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ", & + "(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(kN) ","(kN) ", & + "(kN) ","(kN) ","(kN) ","(kN) ","(kN) ","(kN) ","(kN) ", & + "(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ", & + "(kN-m) ","(kN-m) ","(deg) ","(deg) ","(deg) ","(deg) ","(deg) ", & + "(deg) ","(deg) ","(deg) ","(deg) ","(m) ","(m) ","(m) ", & + "(m) ","(m) ","(m) ","(m) ","(m) ","(m) ","(m/s^2) ", & + "(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ", & + "(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ", & + "(m/s^2) ","(m/s^2) ","(m/s^2) ","(kN) ","(kN) ","(kN) ","(kN) ", & + "(kN) ","(kN) ","(kN) ","(kN) ","(kN) ","(kN-m) ","(kN-m) ", & + "(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ", & + "(deg) ","(deg) ","(deg) ","(deg) ","(deg) ","(deg) ","(deg) ", & + "(deg) ","(deg) ","(m) ","(m) ","(m) ","(m) ","(m) ", & + "(m) ","(m) ","(m) ","(m) ","(m/s^2) ","(m/s^2) ","(m/s^2) ", & + "(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ", & + "(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ", & + "(m/s^2) ","(kN) ","(kN) ","(kN) ","(kN) ","(kN) ","(kN) ", & + "(kN) ","(kN) ","(kN) ","(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ", & + "(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ","(deg) ","(deg) ", & + "(deg) ","(deg) ","(deg) ","(deg) ","(deg) ","(deg) ","(deg) ", & + "(m) ","(m) ","(m) ","(m) ","(m) ","(m) ","(m) ", & + "(m) ","(m) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ", & + "(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ", & + "(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(kN) ", & + "(kN) ","(kN) ","(kN) ","(kN) ","(kN) ","(kN) ","(kN) ", & + "(kN) ","(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ", & + "(kN-m) ","(kN-m) ","(kN-m) ","(deg) ","(deg) ","(deg) ","(deg) ", & + "(deg) ","(deg) ","(deg) ","(deg) ","(deg) ","(m) ","(m) ", & + "(m) ","(m) ","(m) ","(m) ","(m) ","(m) ","(m) ", & + "(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ", & + "(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ", & + "(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(kN) ","(kN) ","(kN) ", & + "(kN) ","(kN) ","(kN) ","(kN) ","(kN) ","(kN) ","(kN-m) ", & + "(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ", & + "(kN-m) ","(deg) ","(deg) ","(deg) ","(deg) ","(deg) ","(deg) ", & + "(deg) ","(deg) ","(deg) ","(m) ","(m) ","(m) ","(m) ", & + "(m) ","(m) ","(m) ","(m) ","(m) ","(m/s^2) ","(m/s^2) ", & + "(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ", & + "(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ", & + "(m/s^2) ","(m/s^2) ","(kN) ","(kN) ","(kN) ","(kN) ","(kN) ", & + "(kN) ","(kN) ","(kN) ","(kN) ","(kN-m) ","(kN-m) ","(kN-m) ", & + "(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ","(deg) ", & + "(deg) ","(deg) ","(deg) ","(deg) ","(deg) ","(deg) ","(deg) ", & + "(deg) ","(m) ","(m) ","(m) ","(m) ","(m) ","(m) ", & + "(m) ","(m) ","(m) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ", & + "(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ", & + "(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ", & + "(kN) ","(kN) ","(kN) ","(kN) ","(kN) ","(kN) ","(kN) ", & + "(kN) ","(kN) ","(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ", & + "(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ","(deg) ","(deg) ","(deg) ", & + "(deg) ","(deg) ","(deg) ","(deg) ","(deg) ","(deg) ","(m) ", & + "(m) ","(m) ","(m) ","(m) ","(m) ","(m) ","(m) ", & + "(m) ","(deg) ","(deg/s^2)","(deg) ","(deg/s) ","(deg/s^2)","(deg) ", & + "(deg) ","(deg/s) ","(kN-m) ","(m) ","(m) ","(m) ","(m/s^2) ", & + "(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ", & + "(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ", & + "(m/s^2) ","(m/s^2) ","(m/s^2) ","(m) ","(m) ","(m) ","(m) ", & + "(m) ","(m) ","(m) ","(m) ","(m) ","(m) ","(m) ", & + "(m) ","(m) ","(m) ","(m) ","(m) ","(m) ","(m) ", & + "(m) ","(m) ","(m) ","(deg) ","(deg) ","(deg) ","(deg) ", & + "(deg) ","(deg) ","(deg) ","(deg) ","(deg) ","(deg) ","(deg) ", & + "(deg) ","(m) ","(m) ","(deg) ","(deg) ","(m) ","(deg) ", & + "(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(kN) ", & + "(kN) ","(kN) ","(kN-m) ","(kN-m) ","(kN-m) ","(deg) ","(deg) ", & + "(deg) ","(deg) ","(deg) ","(deg) ","(m) ","(m) ","(m) ", & + "(m) ","(m) ","(m) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ", & + "(m/s^2) ","(m/s^2) ","(kN) ","(kN) ","(kN) ","(kN-m) ","(kN-m) ", & + "(kN-m) ","(deg) ","(deg) ","(deg) ","(deg) ","(deg) ","(deg) ", & + "(m) ","(m) ","(m) ","(m) ","(m) ","(m) ","(m/s^2) ", & + "(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(kN) ","(kN) ", & + "(kN) ","(kN-m) ","(kN-m) ","(kN-m) ","(deg) ","(deg) ","(deg) ", & + "(deg) ","(deg) ","(deg) ","(m) ","(m) ","(m) ","(m) ", & + "(m) ","(m) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ", & + "(m/s^2) ","(kN) ","(kN) ","(kN) ","(kN-m) ","(kN-m) ","(kN-m) ", & + "(deg) ","(deg) ","(deg) ","(deg) ","(deg) ","(deg) ","(m) ", & + "(m) ","(m) ","(m) ","(m) ","(m) ","(m/s^2) ","(m/s^2) ", & + "(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(kN) ","(kN) ","(kN) ", & + "(kN-m) ","(kN-m) ","(kN-m) ","(deg) ","(deg) ","(deg) ","(deg) ", & + "(deg) ","(deg) ","(m) ","(m) ","(m) ","(m) ","(m) ", & + "(m) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ", & + "(kN) ","(kN) ","(kN) ","(kN-m) ","(kN-m) ","(kN-m) ","(deg) ", & + "(deg) ","(deg) ","(deg) ","(deg) ","(deg) ","(m) ","(m) ", & + "(m) ","(m) ","(m) ","(m) ","(m/s^2) ","(m/s^2) ","(m/s^2) ", & + "(m/s^2) ","(m/s^2) ","(m/s^2) ","(kN) ","(kN) ","(kN) ","(kN-m) ", & + "(kN-m) ","(kN-m) ","(deg) ","(deg) ","(deg) ","(deg) ","(deg) ", & + "(deg) ","(m) ","(m) ","(m) ","(m) ","(m) ","(m) ", & + "(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(kN) ", & + "(kN) ","(kN) ","(kN-m) ","(kN-m) ","(kN-m) ","(deg) ","(deg) ", & + "(deg) ","(deg) ","(deg) ","(deg) ","(m) ","(m) ","(m) ", & + "(m) ","(m) ","(m) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ", & + "(m/s^2) ","(m/s^2) ","(kN) ","(kN) ","(kN) ","(kN-m) ","(kN-m) ", & + "(kN-m) ","(deg) ","(deg) ","(deg) ","(deg) ","(deg) ","(deg) ", & + "(m) ","(m) ","(m) ","(m) ","(m) ","(m) ","(kN) ", & + "(kN) ","(kN) ","(kN-m) ","(kN-m) ","(kN-m) ","(m) ","(m) ", & + "(m) ","(m) ","(m) ","(m) ","(deg) ","(deg) ","(deg) ", & + "(deg/s^2)","(deg/s^2)","(deg/s^2)","(kN) ","(kN) ","(kN) ","(kN) ", & + "(kN) ","(kN) ","(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ", & + "(kN-m) ","(deg/s^2)","(deg/s^2)","(deg/s^2)","(deg) ","(deg) ","(deg) ", & + "(deg/s) ","(deg/s) ","(deg/s) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ", & + "(m/s^2) ","(m/s^2) ","(m) ","(m) ","(m) ","(m) ","(m) ", & + "(m) ","(m) ","(m) ","(m) ","(m/s) ","(m/s) ","(m/s) ", & + "(kN-m) ","(kN-m) ","(kN-m) ","(deg) ","(deg) ","(deg) ","(deg/s) ", & + "(deg/s) ","(deg/s) "/) ! Initialize values @@ -4113,7 +4243,7 @@ SUBROUTINE SetOutParam(OutList, p, ErrStat, ErrMsg ) ! ..... Developer must add checking for invalid inputs here: ..... -if (p%BD4Blades) then +if (p%BD4Blades .or. p%RigidAero) then startIndx = 1 else startIndx = p%NumBl+1 @@ -4131,6 +4261,9 @@ SUBROUTINE SetOutParam(OutList, p, ErrStat, ErrMsg ) InvalidOutput( TipALxb( I) ) = .TRUE. InvalidOutput( TipALyb( I) ) = .TRUE. InvalidOutput( TipALzb( I) ) = .TRUE. + InvalidOutput( TipALgxb( I) ) = .TRUE. + InvalidOutput( TipALgyb( I) ) = .TRUE. + InvalidOutput( TipALgzb( I) ) = .TRUE. InvalidOutput( TipRDxb( I) ) = .TRUE. InvalidOutput( TipRDyb( I) ) = .TRUE. InvalidOutput( TipRDzc( I) ) = .TRUE. @@ -4155,6 +4288,10 @@ SUBROUTINE SetOutParam(OutList, p, ErrStat, ErrMsg ) InvalidOutput( SpnALyb(:,I) ) = .TRUE. InvalidOutput( SpnALzb(:,I) ) = .TRUE. + InvalidOutput( SpnALgxb(:,I) ) = .TRUE. + InvalidOutput( SpnALgyb(:,I) ) = .TRUE. + InvalidOutput( SpnALgzb(:,I) ) = .TRUE. + InvalidOutput( SpnTDxb(:,I) ) = .TRUE. InvalidOutput( SpnTDyb(:,I) ) = .TRUE. InvalidOutput( SpnTDzb(:,I) ) = .TRUE. @@ -4184,6 +4321,10 @@ SUBROUTINE SetOutParam(OutList, p, ErrStat, ErrMsg ) InvalidOutput( SpnALyb(J,I) ) = .TRUE. InvalidOutput( SpnALzb(J,I) ) = .TRUE. + InvalidOutput( SpnALgxb(J,I) ) = .TRUE. + InvalidOutput( SpnALgyb(J,I) ) = .TRUE. + InvalidOutput( SpnALgzb(J,I) ) = .TRUE. + InvalidOutput( SpnTDxb(J,I) ) = .TRUE. InvalidOutput( SpnTDyb(J,I) ) = .TRUE. InvalidOutput( SpnTDzb(J,I) ) = .TRUE. @@ -4215,6 +4356,10 @@ SUBROUTINE SetOutParam(OutList, p, ErrStat, ErrMsg ) InvalidOutput( TwHtALyt(J) ) = .TRUE. InvalidOutput( TwHtALzt(J) ) = .TRUE. + InvalidOutput( TwHtALgxt(J) ) = .TRUE. + InvalidOutput( TwHtALgyt(J) ) = .TRUE. + InvalidOutput( TwHtALgzt(J) ) = .TRUE. + InvalidOutput( TwHtTDxt(J) ) = .TRUE. InvalidOutput( TwHtTDyt(J) ) = .TRUE. InvalidOutput( TwHtTDzt(J) ) = .TRUE. @@ -4282,7 +4427,7 @@ SUBROUTINE SetOutParam(OutList, p, ErrStat, ErrMsg ) InvalidOutput(HSSBrTq) = p%method == Method_RK4 - IF ( p%BD4Blades ) THEN + IF ( p%BD4Blades .or. p%RigidAero ) THEN InvalidOutput( Q_B1E1) = .TRUE. InvalidOutput( Q_B1F1) = .TRUE. InvalidOutput( Q_B1F2) = .TRUE. @@ -4346,63 +4491,34 @@ SUBROUTINE SetOutParam(OutList, p, ErrStat, ErrMsg ) 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 + Indx = FindValidChannelIndx(OutList(I), ValidParamAry, p%OutParam(I)%SignM) 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)%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 = Time ! pick any valid channel (I just picked "Time" here because it's universal) + 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 !********************************************************************************************************************************** + !> This routine is used to compute rotor (blade and hub) properties: !! KBF(), KBE(), CBF(), CBE(), FreqBF(), FreqBE(), AxRedBld(), !! TwistedSF(), BldMass(), FirstMom(), SecondMom(), BldCG(), @@ -5864,14 +5980,28 @@ SUBROUTINE SetCoordSy( t, CoordSys, RtHSdat, BlPitch, p, x, ErrStat, ErrMsg ) ! Tower base / platform coordinate system: - CALL SmllRotTrans( 'platform displacement (ElastoDyn SetCoordSy)', x%QT(DOF_R), x%QT(DOF_Y), -x%QT(DOF_P), TransMat, TRIM(Num2LStr(t))//' s', ErrStat2, ErrMsg2 ) ! Get the transformation matrix, TransMat, from inertial frame to tower base / platform coordinate systems. - CALL CheckError( ErrStat2, ErrMsg2 ) - IF (ErrStat >= AbortErrLev) RETURN + ! CALL SmllRotTrans( 'platform displacement (ElastoDyn SetCoordSy)', x%QT(DOF_R), x%QT(DOF_Y), -x%QT(DOF_P), TransMat, TRIM(Num2LStr(t))//' s', ErrStat2, ErrMsg2 ) ! Get the transformation matrix, TransMat, from inertial frame to tower base / platform coordinate systems. + ! CALL CheckError( ErrStat2, ErrMsg2 ) + ! IF (ErrStat >= AbortErrLev) RETURN + + ! CoordSys%a1 = TransMat(1,1)*CoordSys%z1 + TransMat(1,2)*CoordSys%z2 + TransMat(1,3)*CoordSys%z3 ! Vector / direction a1 (= xt from the IEC coord. system). + ! CoordSys%a2 = TransMat(2,1)*CoordSys%z1 + TransMat(2,2)*CoordSys%z2 + TransMat(2,3)*CoordSys%z3 ! Vector / direction a2 (= zt from the IEC coord. system). + ! CoordSys%a3 = TransMat(3,1)*CoordSys%z1 + TransMat(3,2)*CoordSys%z2 + TransMat(3,3)*CoordSys%z3 ! Vector / direction a3 (= -yt from the IEC coord. system). - CoordSys%a1 = TransMat(1,1)*CoordSys%z1 + TransMat(1,2)*CoordSys%z2 + TransMat(1,3)*CoordSys%z3 ! Vector / direction a1 (= xt from the IEC coord. system). - CoordSys%a2 = TransMat(2,1)*CoordSys%z1 + TransMat(2,2)*CoordSys%z2 + TransMat(2,3)*CoordSys%z3 ! Vector / direction a2 (= zt from the IEC coord. system). - CoordSys%a3 = TransMat(3,1)*CoordSys%z1 + TransMat(3,2)*CoordSys%z2 + TransMat(3,3)*CoordSys%z3 ! Vector / direction a3 (= -yt from the IEC coord. system). + ! Platform orientation after yaw + CoordSys%alpha1 = cos(x%QT(DOF_Y))*CoordSys%z1 - sin(x%QT(DOF_Y))*CoordSys%z3 + CoordSys%alpha2 = CoordSys%z2 + CoordSys%alpha3 = sin(x%QT(DOF_Y))*CoordSys%z1 + cos(x%QT(DOF_Y))*CoordSys%z3 + ! Platform orientation after pitch + CoordSys%beta1 = cos(x%QT(DOF_P))*CoordSys%alpha1 - sin(x%QT(DOF_P))*CoordSys%alpha2 + CoordSys%beta2 = sin(x%QT(DOF_P))*CoordSys%alpha1 + cos(x%QT(DOF_P))*CoordSys%alpha2 + CoordSys%beta3 = CoordSys%alpha3 + + ! Platform orientation after roll + CoordSys%a1 = CoordSys%beta1 + CoordSys%a2 = cos(x%QT(DOF_R))*CoordSys%beta2 + sin(x%QT(DOF_R))*CoordSys%beta3 + CoordSys%a3 = -sin(x%QT(DOF_R))*CoordSys%beta2 + cos(x%QT(DOF_R))*CoordSys%beta3 DO J = 1,p%TwrNodes ! Loop through the tower nodes / elements @@ -6011,7 +6141,7 @@ SUBROUTINE SetCoordSy( t, CoordSys, RtHSdat, BlPitch, p, x, ErrStat, ErrMsg ) CoordSys%j2(K,:) = SinPitch*CoordSys%i1(K,:) + CosPitch*CoordSys%i2(K,:) ! j2(K,:) = vector / direction j2 for blade K (= ybK from the IEC coord. system). CoordSys%j3(K,:) = CoordSys%i3(K,:) ! j3(K,:) = vector / direction j3 for blade K (= zbK from the IEC coord. system). - +!FIXME: don't need 0 and TipNode without AD14 DO J = 0,p%TipNode ! Loop through the blade nodes / elements @@ -6042,8 +6172,7 @@ SUBROUTINE SetCoordSy( t, CoordSys, RtHSdat, BlPitch, p, x, ErrStat, ErrMsg ) CoordSys%n2(K,J,:) = TransMat(2,1)*Lj1 + TransMat(2,2)*Lj2 + TransMat(2,3)*Lj3 ! Vector / direction n2 for node J of blade K (= LybK from the IEC coord. system). CoordSys%n3(K,J,:) = TransMat(3,1)*Lj1 + TransMat(3,2)*Lj2 + TransMat(3,3)*Lj3 ! Vector / direction n3 for node J of blade K (= LzbK from the IEC coord. system). - ! skip these next CoordSys variables at the root and the tip; they are required only for AD14: - + if (j == 0 .or. j==p%TipNode) cycle @@ -6279,6 +6408,68 @@ SUBROUTINE Teeter( t, p, TeetDef, TeetRate, TeetMom ) RETURN END SUBROUTINE Teeter !---------------------------------------------------------------------------------------------------------------------------------- +!> This routine computes the Yaw Friction Torque due to yaw rate and acceleration. +SUBROUTINE YawFriction( t, p, F, M, Mzz, Omg, OmgDot, YawFriMf ) +!.................................................................................................................................. + + ! Passed Variables: + REAL(DbKi), INTENT(IN) :: t !< simulation time + TYPE(ED_ParameterType), INTENT(IN) :: p !< parameters from the structural dynamics module + REAL(ReKi), INTENT(IN ) :: F(3), M(3) !< Effective yaw bearing force and moment + REAL(R8Ki), INTENT(IN ) :: Mzz !< External yaw bearing torque + REAL(R8Ki), INTENT(IN ) :: Omg !< The yaw rate (rotational speed), x%QDT(DOF_Yaw). + REAL(R8Ki), INTENT(IN ) :: OmgDot !< The yaw acceleration (derivative of rotational speed), x%QD2T(DOF_Yaw). + REAL(ReKi), INTENT(OUT) :: YawFriMf !< The total friction torque (Coulomb + viscous). + + ! Local variables: + REAL(ReKi) :: temp, Fs, Mb, Mf_vis ! temp takes the value of Fz or -1. + + + SELECT CASE ( p%YawFrctMod ) + ! Yaw-friction model {0: none, 1: does not use F and M at yaw bearing, 2: does, 3: user defined model} (switch) + + CASE ( 0_IntKi ) ! None! + + YawFriMf = 0.0_ReKi + + CASE ( 1_IntKi, 2_IntKi ) ! 1 = F and M not used. 2 = F and M used + + temp = -1.0_ReKi ! In the case of YawFrctMod=1 + Fs = 0.0_ReKi + Mb = 0.0_ReKi + + IF (p%YawFrctMod .EQ. 2) THEN + temp = MIN(0.0_ReKi, F(3)) ! In the case of YawFrctMod=2 + Fs = SQRT(F(1)**2+F(2)**2) ! Effective shear force on yaw bearing + Mb = SQRT(M(1)**2+M(2)**2) ! Effective bending moment on yaw bearing + ENDIF + + IF (EqualRealNos( Omg, 0.0_R8Ki )) THEN + IF (EqualRealNos( OmgDot, 0.0_R8Ki )) THEN + YawFriMf = -MIN( real(p%M_CSmax,ReKi) * ABS(temp) + real(p%M_FCSmax,ReKi) * Fs + real(p%M_MCSmax,ReKi) * Mb, ABS(real(Mzz,ReKi)) ) * SIGN(1.0_ReKi, real(Mzz,ReKi)) + ELSE + YawFriMf = -MIN( real(p%M_CD, ReKi) * ABS(temp) + real(p%M_FCD, ReKi) * Fs + real(p%M_MCD, ReKi) * Mb, ABS(real(Mzz,ReKi)) ) * SIGN(1.0_ReKi, real(Mzz,ReKi)) + ENDIF + ELSE + ! Viscous friction + IF ( ABS(Omg) > p%OmgCut ) THEN ! Full quadratic viscous friction + Mf_vis = - real(p%sig_v,ReKi) * real(Omg,ReKi) - real(p%sig_v2,ReKi) * real(Omg,ReKi) * ABS(real(Omg,ReKi)) + ELSE ! Linearized viscous friction + Mf_vis = - ( real(p%sig_v,ReKi) + real(p%sig_v2,ReKi) * real(p%OmgCut,ReKi) ) * real(Omg,ReKi) + ENDIF + YawFriMf = ( real(p%M_CD,ReKi) * temp - real(p%M_FCD,ReKi) * Fs - real(p%M_MCD,ReKi) * Mb ) * sign(1.0_ReKi, real(Omg,ReKi)) & ! Coulomb friction + + Mf_vis + ENDIF + + CASE ( 3_IntKi ) ! User-defined YawFriMf model. >>>> NOT IMPLEMENTED YET + + CALL UserYawFrict ( t, F, M, Mzz, Omg, OmgDot, p%RootName, YawFriMf ) + + END SELECT + + RETURN +END SUBROUTINE YawFriction +!---------------------------------------------------------------------------------------------------------------------------------- !> This routine computes the tail-furl moment due to tail-furl deflection and rate. SUBROUTINE TFurling( t, p, TFrlDef, TFrlRate, TFrlMom ) ! Passed Variables: @@ -6505,7 +6696,7 @@ END SUBROUTINE CalculatePositions !---------------------------------------------------------------------------------------------------------------------------------- !> This routine is used to calculate the angular positions, velocities, and partial accelerations stored in other states that are used in !! both the CalcOutput and CalcContStateDeriv routines. -SUBROUTINE CalculateAngularPosVelPAcc( p, x, CoordSys, RtHSdat ) +SUBROUTINE CalculateAngularPosVelPAcc( p, x, CoordSys, RtHSdat, ErrStat, ErrMsg ) !.................................................................................................................................. ! Passed variables @@ -6514,6 +6705,9 @@ SUBROUTINE CalculateAngularPosVelPAcc( p, x, CoordSys, RtHSdat ) TYPE(ED_CoordSys), INTENT(IN ) :: CoordSys !< The coordinate systems that have been set for these states/time TYPE(ED_RtHndSide), INTENT(INOUT) :: RtHSdat !< data from the RtHndSid module (contains positions to be set) + INTEGER(IntKi), INTENT(OUT) :: ErrStat !< Error status + CHARACTER(*), INTENT(OUT) :: ErrMsg !< Error message + !Local variables REAL(ReKi) :: AngVelHM (3) ! Angular velocity of eleMent J of blade K (body M) in the hub (body H). @@ -6521,6 +6715,15 @@ SUBROUTINE CalculateAngularPosVelPAcc( p, x, CoordSys, RtHSdat ) REAL(ReKi) :: AngAccELt (3) ! Portion of the angular acceleration of the low-speed shaft (body L) in the inertia frame (body E for earth) associated with everything but the QD2T()'s. INTEGER(IntKi) :: J ! Counter for elements INTEGER(IntKi) :: K ! Counter for blades + REAL(R8Ki) :: PtfmOrientation (3,3) ! Orientation matrix for the platform (-). + REAL(R8Ki) :: TransMat (3,3) ! Orientation matrix for the platform (-). + REAL(R8Ki) :: ThetaFA ! Tower fore-aft tilt deflection angle. + REAL(R8Ki) :: ThetaSS ! Tower side-to-side tilt deflection angle. + + INTEGER(IntKi) :: ErrStat2 ! Temporary error status + CHARACTER(ErrMsgLen) :: ErrMsg2 ! Temporary error message + + CHARACTER(*), PARAMETER :: RoutineName = "CalculateAngularPosVelPAcc" !------------------------------------------------------------------------------------------------- ! Angular and partial angular velocities @@ -6530,15 +6733,19 @@ SUBROUTINE CalculateAngularPosVelPAcc( p, x, CoordSys, RtHSdat ) ! NOTE: PAngVelEN(I,D,:) = the Dth-derivative of the partial angular velocity of DOF I for body N in body E. RtHSdat%PAngVelEX( :,0,:) = 0.0 - RtHSdat%PAngVelEX(DOF_R ,0,:) = CoordSys%z1 - RtHSdat%PAngVelEX(DOF_P ,0,:) = -CoordSys%z3 + ! RtHSdat%PAngVelEX(DOF_R ,0,:) = CoordSys%z1 + ! RtHSdat%PAngVelEX(DOF_P ,0,:) = -CoordSys%z3 + ! RtHSdat%PAngVelEX(DOF_Y ,0,:) = CoordSys%z2 + RtHSdat%PAngVelEX(DOF_R ,0,:) = CoordSys%beta1 + RtHSdat%PAngVelEX(DOF_P ,0,:) = -CoordSys%alpha3 RtHSdat%PAngVelEX(DOF_Y ,0,:) = CoordSys%z2 RtHSdat%AngVelEX = x%QDT(DOF_R )*RtHSdat%PAngVelEX(DOF_R ,0,:) & + x%QDT(DOF_P )*RtHSdat%PAngVelEX(DOF_P ,0,:) & + x%QDT(DOF_Y )*RtHSdat%PAngVelEX(DOF_Y ,0,:) - RtHSdat%AngPosEX = x%QT (DOF_R )*RtHSdat%PAngVelEX(DOF_R ,0,:) & - + x%QT (DOF_P )*RtHSdat%PAngVelEX(DOF_P ,0,:) & - + x%QT (DOF_Y )*RtHSdat%PAngVelEX(DOF_Y ,0,:) + ! RtHSdat%AngPosEX = x%QT (DOF_R )*RtHSdat%PAngVelEX(DOF_R ,0,:) & ! <- LW: Doesn't work for large rotation. Impacts AngPosEF (TwHtRP*i output) + ! + x%QT (DOF_P )*RtHSdat%PAngVelEX(DOF_P ,0,:) & + ! + x%QT (DOF_Y )*RtHSdat%PAngVelEX(DOF_Y ,0,:) + PtfmOrientation = EulerConstructZYX((/x%QT(DOF_R),x%QT(DOF_P),x%QT(DOF_Y)/)) RtHSdat%PAngVelEB( :,0,:) = RtHSdat%PAngVelEX(:,0,:) RtHSdat%PAngVelEB(DOF_TFA1,0,:) = -p%TwrFASF(1,p%TTopNode,1)*CoordSys%a3 @@ -6591,7 +6798,10 @@ SUBROUTINE CalculateAngularPosVelPAcc( p, x, CoordSys, RtHSdat ) ! everything but the QD2T()'s: RtHSdat%PAngVelEX( :,1,:) = 0.0 - RtHSdat%AngAccEXt = 0.0 + RtHSdat%PAngVelEX(DOF_R ,1,:) = CROSS_PRODUCT( RtHSdat%AngVelEX, RtHSdat%PAngVelEX(DOF_R ,0,:) ) + RtHSdat%PAngVelEX(DOF_P ,1,:) = CROSS_PRODUCT( x%QDT(DOF_Y)*CoordSys%z2, RtHSdat%PAngVelEX(DOF_P ,0,:) ) + RtHSdat%AngAccEXt = x%QDT(DOF_R)*RtHSdat%PAngVelEX(DOF_R ,1,:) & + + x%QDT(DOF_P)*RtHSdat%PAngVelEX(DOF_P ,1,:) RtHSdat%PAngVelEB( :,1,:) = RtHSdat%PAngVelEX(:,1,:) RtHSdat%PAngVelEB(DOF_TFA1,1,:) = CROSS_PRODUCT( RtHSdat%AngVelEX, RtHSdat%PAngVelEB(DOF_TFA1,0,:) ) @@ -6713,7 +6923,17 @@ SUBROUTINE CalculateAngularPosVelPAcc( p, x, CoordSys, RtHSdat ) + x%QT (DOF_TSS1)*RtHSdat%PAngVelEF(J,DOF_TSS1,0,:) & + x%QT (DOF_TFA2)*RtHSdat%PAngVelEF(J,DOF_TFA2,0,:) & + x%QT (DOF_TSS2)*RtHSdat%PAngVelEF(J,DOF_TSS2,0,:) - RtHSdat%AngPosEF (:,J) = RtHSdat%AngPosEX + RtHSdat%AngPosXF(:,J) + + !RtHSdat%AngPosEF (:,J) = RtHSdat%AngPosEX + RtHSdat%AngPosXF(:,J) ! LW: This is no longer right with large Ptfm Rotation + ThetaSS = p%TwrSSSF(1,J,1)*x%QT(DOF_TSS1) + p%TwrSSSF(2,J,1)*x%QT(DOF_TSS2) + ThetaFA = -p%TwrFASF(1,J,1)*x%QT(DOF_TFA1) - p%TwrFASF(2,J,1)*x%QT(DOF_TFA2) + CALL SmllRotTrans('tower element rotation',ThetaSS,-ThetaFA,0.0_R8Ki,TransMat,'',ErrStat2,ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (ErrStat>=AbortErrLev) then + return + end if + RtHSdat%AngPosEF (:,J) = EulerExtractZYX(MatMul(TransMat,PtfmOrientation)) ! Extract tower element yaw, pitch, and roll angles from the combined platform and tower element rotation + RtHSdat%AngAccEFt(:,J) = RtHSdat%AngAccEXt + x%QDT(DOF_TFA1)*RtHSdat%PAngVelEF(J,DOF_TFA1,1,:) & + x%QDT(DOF_TSS1)*RtHSdat%PAngVelEF(J,DOF_TSS1,1,:) & + x%QDT(DOF_TFA2)*RtHSdat%PAngVelEF(J,DOF_TFA2,1,:) & @@ -6830,9 +7050,10 @@ SUBROUTINE CalculateLinearVelPAcc( p, x, CoordSys, RtHSdat ) TmpVec0 = CROSS_PRODUCT( RtHSdat%PAngVelEX(PX(I) ,0,:), RtHSdat%rZY ) TmpVec1 = CROSS_PRODUCT( RtHSdat%PAngVelEX(PX(I) ,0,:), EwXXrZY ) + TmpVec2 = CROSS_PRODUCT( RtHSdat%PAngVelEX(PX(I) ,1,:), RtHSdat%rZY ) RtHSdat%PLinVelEY(PX(I),0,:) = TmpVec0 + RtHSdat%PLinVelEY(PX(I) ,0,:) - RtHSdat%PLinVelEY(PX(I),1,:) = TmpVec1 + RtHSdat%PLinVelEY(PX(I) ,1,:) + RtHSdat%PLinVelEY(PX(I),1,:) = TmpVec1 + TmpVec2 + RtHSdat%PLinVelEY(PX(I) ,1,:) RtHSdat%LinAccEYt = RtHSdat%LinAccEYt + x%QDT(PX(I) )*RtHSdat%PLinVelEY(PX(I) ,1,:) @@ -6876,10 +7097,11 @@ SUBROUTINE CalculateLinearVelPAcc( p, x, CoordSys, RtHSdat ) DO I = 1,NPX ! Loop through all DOFs associated with the angular motion of the platform (body X) TmpVec0 = CROSS_PRODUCT( RtHSdat%PAngVelEX(PX(I) ,0,:), RtHSdat%rZO ) - TmpVec1 = CROSS_PRODUCT( RtHSdat%PAngVelEX(PX(I) ,0,:), EwXXrZO + LinVelXO ) + TmpVec1 = CROSS_PRODUCT( RtHSdat%PAngVelEX(PX(I) ,0,:), EwXXrZO + LinVelXO ) + TmpVec2 = CROSS_PRODUCT( RtHSdat%PAngVelEX(PX(I) ,1,:), RtHSdat%rZO ) RtHSdat%PLinVelEO(PX(I),0,:) = TmpVec0 + RtHSdat%PLinVelEO(PX(I) ,0,:) - RtHSdat%PLinVelEO(PX(I),1,:) = TmpVec1 + RtHSdat%PLinVelEO(PX(I) ,1,:) + RtHSdat%PLinVelEO(PX(I),1,:) = TmpVec1 + TmpVec2 + RtHSdat%PLinVelEO(PX(I) ,1,:) RtHSdat%LinVelEO = RtHSdat%LinVelEO + x%QDT(PX(I) )*RtHSdat%PLinVelEO(PX(I) ,0,:) RtHSdat%LinAccEOt = RtHSdat%LinAccEOt + x%QDT(PX(I) )*RtHSdat%PLinVelEO(PX(I) ,1,:) @@ -7172,11 +7394,12 @@ SUBROUTINE CalculateLinearVelPAcc( p, x, CoordSys, RtHSdat ) RtHSdat%LinVelET(:,J) = LinVelXT + RtHSdat%LinVelEZ DO I = 1,NPX ! Loop through all DOFs associated with the angular motion of the platform (body X) - TmpVec0 = CROSS_PRODUCT( RtHSdat%PAngVelEX(PX(I),0,:), RtHSdat%rZT(:,J) ) + TmpVec0 = CROSS_PRODUCT( RtHSdat%PAngVelEX(PX(I),0,:), RtHSdat%rZT(:,J) ) TmpVec1 = CROSS_PRODUCT( RtHSdat%PAngVelEX(PX(I),0,:), EwXXrZT + LinVelXT ) + TmpVec2 = CROSS_PRODUCT( RtHSdat%PAngVelEX(PX(I),1,:), RtHSdat%rZT(:,J) ) RtHSdat%PLinVelET(J,PX(I),0,:) = RtHSdat%PLinVelET(J,PX(I),0,:) + TmpVec0 - RtHSdat%PLinVelET(J,PX(I),1,:) = RtHSdat%PLinVelET(J,PX(I),1,:) + TmpVec1 + RtHSdat%PLinVelET(J,PX(I),1,:) = RtHSdat%PLinVelET(J,PX(I),1,:) + TmpVec1 + TmpVec2 RtHSdat%LinVelET( :, J) = RtHSdat%LinVelET( :, J) + x%QDT(PX(I))*RtHSdat%PLinVelET(J,PX(I),0,:) RtHSdat%LinAccETt(:, J) = RtHSdat%LinAccETt(:, J) + x%QDT(PX(I))*RtHSdat%PLinVelET(J,PX(I),1,:) @@ -7249,21 +7472,13 @@ SUBROUTINE CalculateForcesMoments( p, x, CoordSys, u, RtHSdat ) NodeNum = J ! we're ignoring the root and tip - if (p%UseAD14) then - RtHSdat%FSAero(:,K,J) = ( u%BladePtLoads(K)%Force(1,NodeNum) * CoordSys%te1(K,J,:) & - + u%BladePtLoads(K)%Force(2,NodeNum) * CoordSys%te2(K,J,:) ) / p%DRNodes(J) - - RtHSdat%MMAero(:,K,J) = CROSS_PRODUCT( RtHSdat%rSAerCen(:,J,K), RtHSdat%FSAero(:,K,J) )& - + u%BladePtLoads(K)%Moment(3,NodeNum)/p%DRNodes(J) * CoordSys%te3(K,J,:) - else - RtHSdat%FSAero(1,K,J) = u%BladePtLoads(K)%Force(1,NodeNum) / p%DRNodes(J) - RtHSdat%FSAero(2,K,J) = u%BladePtLoads(K)%Force(3,NodeNum) / p%DRNodes(J) - RtHSdat%FSAero(3,K,J) = -u%BladePtLoads(K)%Force(2,NodeNum) / p%DRNodes(J) + RtHSdat%FSAero(1,K,J) = u%BladePtLoads(K)%Force(1,NodeNum) / p%DRNodes(J) + RtHSdat%FSAero(2,K,J) = u%BladePtLoads(K)%Force(3,NodeNum) / p%DRNodes(J) + RtHSdat%FSAero(3,K,J) = -u%BladePtLoads(K)%Force(2,NodeNum) / p%DRNodes(J) - RtHSdat%MMAero(1,K,J) = u%BladePtLoads(K)%Moment(1,NodeNum) / p%DRNodes(J) - RtHSdat%MMAero(2,K,J) = u%BladePtLoads(K)%Moment(3,NodeNum) / p%DRNodes(J) - RtHSdat%MMAero(3,K,J) = -u%BladePtLoads(K)%Moment(2,NodeNum) / p%DRNodes(J) - end if + RtHSdat%MMAero(1,K,J) = u%BladePtLoads(K)%Moment(1,NodeNum) / p%DRNodes(J) + RtHSdat%MMAero(2,K,J) = u%BladePtLoads(K)%Moment(3,NodeNum) / p%DRNodes(J) + RtHSdat%MMAero(3,K,J) = -u%BladePtLoads(K)%Moment(2,NodeNum) / p%DRNodes(J) END DO !J @@ -7756,22 +7971,36 @@ SUBROUTINE CalculateForcesMoments( p, x, CoordSys, u, RtHSdat ) RtHSdat%PMXHydro = 0.0 DO I = 1,p%DOFs%NPYE ! Loop through all active (enabled) DOFs that contribute to the QD2T-related linear accelerations of the platform center of mass (point Y) - RtHSdat%PFZHydro(p%DOFs%PYE(I),:) = - u%PtfmAddedMass(DOF_Sg,p%DOFs%PYE(I))*RtHSdat%PLinVelEZ(DOF_Sg,0,:) & - - u%PtfmAddedMass(DOF_Sw,p%DOFs%PYE(I))*RtHSdat%PLinVelEZ(DOF_Sw,0,:) & - - u%PtfmAddedMass(DOF_Hv,p%DOFs%PYE(I))*RtHSdat%PLinVelEZ(DOF_Hv,0,:) - RtHSdat%PMXHydro(p%DOFs%PYE(I),:) = - u%PtfmAddedMass(DOF_R ,p%DOFs%PYE(I))*RtHSdat%PAngVelEX(DOF_R ,0,:) & - - u%PtfmAddedMass(DOF_P ,p%DOFs%PYE(I))*RtHSdat%PAngVelEX(DOF_P ,0,:) & - - u%PtfmAddedMass(DOF_Y ,p%DOFs%PYE(I))*RtHSdat%PAngVelEX(DOF_Y ,0,:) + ! RtHSdat%PFZHydro(p%DOFs%PYE(I),:) = - u%PtfmAddedMass(DOF_Sg,p%DOFs%PYE(I))*RtHSdat%PLinVelEZ(DOF_Sg,0,:) & + ! - u%PtfmAddedMass(DOF_Sw,p%DOFs%PYE(I))*RtHSdat%PLinVelEZ(DOF_Sw,0,:) & + ! - u%PtfmAddedMass(DOF_Hv,p%DOFs%PYE(I))*RtHSdat%PLinVelEZ(DOF_Hv,0,:) + ! RtHSdat%PMXHydro(p%DOFs%PYE(I),:) = - u%PtfmAddedMass(DOF_R ,p%DOFs%PYE(I))*RtHSdat%PAngVelEX(DOF_R ,0,:) & + ! - u%PtfmAddedMass(DOF_P ,p%DOFs%PYE(I))*RtHSdat%PAngVelEX(DOF_P ,0,:) & + ! - u%PtfmAddedMass(DOF_Y ,p%DOFs%PYE(I))*RtHSdat%PAngVelEX(DOF_Y ,0,:) + + RtHSdat%PFZHydro(p%DOFs%PYE(I),:) = - u%PtfmAddedMass(DOF_Sg,p%DOFs%PYE(I))*CoordSys%z1 & + + u%PtfmAddedMass(DOF_Sw,p%DOFs%PYE(I))*CoordSys%z3 & + - u%PtfmAddedMass(DOF_Hv,p%DOFs%PYE(I))*CoordSys%z2 + RtHSdat%PMXHydro(p%DOFs%PYE(I),:) = - u%PtfmAddedMass(DOF_R ,p%DOFs%PYE(I))*CoordSys%z1 & + + u%PtfmAddedMass(DOF_P ,p%DOFs%PYE(I))*CoordSys%z3 & + - u%PtfmAddedMass(DOF_Y ,p%DOFs%PYE(I))*CoordSys%z2 ENDDO ! I - All active (enabled) DOFs that contribute to the QD2T-related linear accelerations of the platform center of mass (point Y) - RtHSdat%FZHydrot = u%PlatformPtMesh%Force(DOF_Sg,1)*RtHSdat%PLinVelEZ(DOF_Sg,0,:) & - + u%PlatformPtMesh%Force(DOF_Sw,1)*RtHSdat%PLinVelEZ(DOF_Sw,0,:) & - + u%PlatformPtMesh%Force(DOF_Hv,1)*RtHSdat%PLinVelEZ(DOF_Hv,0,:) - RtHSdat%MXHydrot = u%PlatformPtMesh%Moment(DOF_R-3,1)*RtHSdat%PAngVelEX(DOF_R ,0,:) & - + u%PlatformPtMesh%Moment(DOF_P-3,1)*RtHSdat%PAngVelEX(DOF_P ,0,:) & - + u%PlatformPtMesh%Moment(DOF_Y-3,1)*RtHSdat%PAngVelEX(DOF_Y ,0,:) - + !RtHSdat%FZHydrot = u%PlatformPtMesh%Force(DOF_Sg,1)*RtHSdat%PLinVelEZ(DOF_Sg,0,:) & + ! + u%PlatformPtMesh%Force(DOF_Sw,1)*RtHSdat%PLinVelEZ(DOF_Sw,0,:) & + ! + u%PlatformPtMesh%Force(DOF_Hv,1)*RtHSdat%PLinVelEZ(DOF_Hv,0,:) + !RtHSdat%MXHydrot = u%PlatformPtMesh%Moment(DOF_R-3,1)*RtHSdat%PAngVelEX(DOF_R ,0,:) & + ! + u%PlatformPtMesh%Moment(DOF_P-3,1)*RtHSdat%PAngVelEX(DOF_P ,0,:) & + ! + u%PlatformPtMesh%Moment(DOF_Y-3,1)*RtHSdat%PAngVelEX(DOF_Y ,0,:) + + RtHSdat%FZHydrot = u%PlatformPtMesh%Force(DOF_Sg,1)*CoordSys%z1 & + - u%PlatformPtMesh%Force(DOF_Sw,1)*CoordSys%z3 & + + u%PlatformPtMesh%Force(DOF_Hv,1)*CoordSys%z2 + RtHSdat%MXHydrot = u%PlatformPtMesh%Moment(DOF_R-3,1)*CoordSys%z1 & + - u%PlatformPtMesh%Moment(DOF_P-3,1)*CoordSys%z3 & + + u%PlatformPtMesh%Moment(DOF_Y-3,1)*CoordSys%z2 + !..................................... ! PFrcZAll and PMomXAll ! (requires PFrcT0Trb, PMomX0Trb, PFZHydro, PMXHydro ) @@ -7798,7 +8027,13 @@ SUBROUTINE CalculateForcesMoments( p, x, CoordSys, u, RtHSdat ) RtHSdat%PMomXAll(:,p%DOFs%PYE(I)) = RtHSdat%PMomXAll(:,p%DOFs%PYE(I) ) + RtHSdat%PMXHydro(p%DOFs%PYE(I),:) + TmpVec2 & - p%PtfmRIner*CoordSys%a1*DOT_PRODUCT( CoordSys%a1, RtHSdat%PAngVelEX(p%DOFs%PYE(I),0,:) ) & - p%PtfmYIner*CoordSys%a2*DOT_PRODUCT( CoordSys%a2, RtHSdat%PAngVelEX(p%DOFs%PYE(I),0,:) ) & - - p%PtfmPIner*CoordSys%a3*DOT_PRODUCT( CoordSys%a3, RtHSdat%PAngVelEX(p%DOFs%PYE(I),0,:) ) + - p%PtfmPIner*CoordSys%a3*DOT_PRODUCT( CoordSys%a3, RtHSdat%PAngVelEX(p%DOFs%PYE(I),0,:) ) & + - p%PtfmXZIner*CoordSys%a1*DOT_PRODUCT( CoordSys%a2, RtHSdat%PAngVelEX(p%DOFs%PYE(I),0,:) ) & + + p%PtfmXYIner*CoordSys%a1*DOT_PRODUCT( CoordSys%a3, RtHSdat%PAngVelEX(p%DOFs%PYE(I),0,:) ) & + + p%PtfmYZIner*CoordSys%a2*DOT_PRODUCT( CoordSys%a3, RtHSdat%PAngVelEX(p%DOFs%PYE(I),0,:) ) & + - p%PtfmXZIner*CoordSys%a2*DOT_PRODUCT( CoordSys%a1, RtHSdat%PAngVelEX(p%DOFs%PYE(I),0,:) ) & + + p%PtfmXYIner*CoordSys%a3*DOT_PRODUCT( CoordSys%a1, RtHSdat%PAngVelEX(p%DOFs%PYE(I),0,:) ) & + + p%PtfmYZIner*CoordSys%a3*DOT_PRODUCT( CoordSys%a2, RtHSdat%PAngVelEX(p%DOFs%PYE(I),0,:) ) ENDDO ! I - All active (enabled) DOFs that contribute to the QD2T-related linear accelerations of the platform center of mass (point Y) @@ -7812,12 +8047,27 @@ SUBROUTINE CalculateForcesMoments( p, x, CoordSys, u, RtHSdat ) TmpVec3 = CROSS_PRODUCT( RtHSdat%rZT0 , RtHSdat%FrcT0Trbt ) ! The portion of MomXAllt associated with the FrcT0Trbt TmpVec = p%PtfmRIner*CoordSys%a1*DOT_PRODUCT( CoordSys%a1, RtHSdat%AngVelEX ) & ! = ( Platform inertia dyadic ) dot ( angular velocity of platform in the inertia frame ) + p%PtfmYIner*CoordSys%a2*DOT_PRODUCT( CoordSys%a2, RtHSdat%AngVelEX ) & - + p%PtfmPIner*CoordSys%a3*DOT_PRODUCT( CoordSys%a3, RtHSdat%AngVelEX ) + + p%PtfmPIner*CoordSys%a3*DOT_PRODUCT( CoordSys%a3, RtHSdat%AngVelEX ) & + + p%PtfmXZIner*CoordSys%a1*DOT_PRODUCT( CoordSys%a2, RtHSdat%AngVelEX ) & + - p%PtfmXYIner*CoordSys%a1*DOT_PRODUCT( CoordSys%a3, RtHSdat%AngVelEX ) & + - p%PtfmYZIner*CoordSys%a2*DOT_PRODUCT( CoordSys%a3, RtHSdat%AngVelEX ) & + + p%PtfmXZIner*CoordSys%a2*DOT_PRODUCT( CoordSys%a1, RtHSdat%AngVelEX ) & + - p%PtfmXYIner*CoordSys%a3*DOT_PRODUCT( CoordSys%a1, RtHSdat%AngVelEX ) & + - p%PtfmYZIner*CoordSys%a3*DOT_PRODUCT( CoordSys%a2, RtHSdat%AngVelEX ) + TmpVec4 = CROSS_PRODUCT( -RtHSdat%AngVelEX, TmpVec ) ! = ( -angular velocity of platform in the inertia frame ) cross ( TmpVec ) RtHSdat%FrcZAllt = RtHSdat%FrcT0Trbt + RtHSdat%FZHydrot + TmpVec1 - RtHSdat%MomXAllt = RtHSdat%MomX0Trbt + RtHSdat%MXHydrot + TmpVec2 + TmpVec3 + TmpVec4 - + RtHSdat%MomXAllt = RtHSdat%MomX0Trbt + RtHSdat%MXHydrot + TmpVec2 + TmpVec3 + TmpVec4 & + - p%PtfmRIner*CoordSys%a1*DOT_PRODUCT( CoordSys%a1, RtHSdat%AngAccEXt ) & + - p%PtfmYIner*CoordSys%a2*DOT_PRODUCT( CoordSys%a2, RtHSdat%AngAccEXt ) & + - p%PtfmPIner*CoordSys%a3*DOT_PRODUCT( CoordSys%a3, RtHSdat%AngAccEXt ) & + - p%PtfmXZIner*CoordSys%a1*DOT_PRODUCT( CoordSys%a2, RtHSdat%AngAccEXt ) & + + p%PtfmXYIner*CoordSys%a1*DOT_PRODUCT( CoordSys%a3, RtHSdat%AngAccEXt ) & + + p%PtfmYZIner*CoordSys%a2*DOT_PRODUCT( CoordSys%a3, RtHSdat%AngAccEXt ) & + - p%PtfmXZIner*CoordSys%a2*DOT_PRODUCT( CoordSys%a1, RtHSdat%AngAccEXt ) & + + p%PtfmXYIner*CoordSys%a3*DOT_PRODUCT( CoordSys%a1, RtHSdat%AngAccEXt ) & + + p%PtfmYZIner*CoordSys%a3*DOT_PRODUCT( CoordSys%a2, RtHSdat%AngAccEXt ) END SUBROUTINE CalculateForcesMoments !---------------------------------------------------------------------------------------------------------------------------------- @@ -8151,7 +8401,7 @@ SUBROUTINE FillAugMat( p, x, CoordSys, u, HSSBrTrq, RtHSdat, AugMat ) AugMat(p%DOFs%SrtPS(I),DOF_Yaw ) = -DOT_PRODUCT( RtHSdat%PAngVelEN(DOF_Yaw ,0,:), RtHSdat%PMomBNcRt(:,p%DOFs%SrtPS(I)) ) ! [C(q,t)]N + [C(q,t)]R + [C(q,t)]G + [C(q,t)]H + [C(q,t)]B + [C(q,t)]A ENDDO ! I - All active (enabled) DOFs on or below the diagonal AugMat(DOF_Yaw , p%NAug) = DOT_PRODUCT( RtHSdat%PAngVelEN(DOF_Yaw ,0,:), RtHSdat%MomBNcRtt ) & ! {-f(qd,q,t)}N + {-f(qd,q,t)}GravN + {-f(qd,q,t)}R + {-f(qd,q,t)}GravR + {-f(qd,q,t)}G + {-f(qd,q,t)}H + {-f(qd,q,t)}GravH + {-f(qd,q,t)}B + {-f(qd,q,t)}GravB + {-f(qd,q,t)}AeroB + {-f(qd,q,t)}A + {-f(qd,q,t)}GravA + {-f(qd,q,t)}AeroA - + u%YawMom ! + {-f(qd,q,t)}SpringYaw + {-f(qd,q,t)}DampYaw; NOTE: The neutral yaw rate, YawRateNeut, defaults to zero. It is only used for yaw control. + + u%YawMom + RtHSdat%YawFriMom ! + {-f(qd,q,t)}SpringYaw + {-f(qd,q,t)}DampYaw; NOTE: The neutral yaw rate, YawRateNeut, defaults to zero. It is only used for yaw control. ENDIF @@ -8318,53 +8568,38 @@ SUBROUTINE ED_AllocOutput( p, m, u, y, ErrStat, ErrMsg ) IF (ErrStat >= AbortErrLev) RETURN END DO - ! now add position/orientation of nodes for AD14 or AD15 - if (p%UseAD14) then ! position/orientation of nodes for AeroDyn v14 or v15 - - ! Use orientation at p%BldNodes for the extra node at the blade tip - CALL MeshPositionNode ( y%BladeLn2Mesh(K), p%BldNodes + 1, (/0.0_ReKi, 0.0_ReKi, p%BldFlexL /), ErrStat2, ErrMsg2, Orient=u%BladePtLoads(K)%RefOrientation(:,:,p%BldNodes) ) - CALL CheckError( ErrStat2, ErrMsg2 ) - IF (ErrStat >= AbortErrLev) RETURN + ! now add position/orientation of nodes for AD15 + ! position the nodes on the blade root and blade tip: + DO J = 0,p%TipNode,p%TipNode + if (j==0) then ! blade root + NodeNum = p%BldNodes + 2 + y%BladeLn2Mesh(K)%RefNode = NodeNum + elseif (j==p%TipNode) then ! blade tip + NodeNum = p%BldNodes + 1 + end if + + Orientation(1,1) = m%CoordSys%n1(K,J,1) + Orientation(2,1) = m%CoordSys%n2(K,J,1) + Orientation(3,1) = m%CoordSys%n3(K,J,1) + Orientation(1,2) = -1.*m%CoordSys%n1(K,J,3) + Orientation(2,2) = -1.*m%CoordSys%n2(K,J,3) + Orientation(3,2) = -1.*m%CoordSys%n3(K,J,3) + Orientation(1,3) = m%CoordSys%n1(K,J,2) + Orientation(2,3) = m%CoordSys%n2(K,J,2) + Orientation(3,3) = m%CoordSys%n3(K,J,2) + + ! Translational Displacement + position(1) = m%RtHS%rS (1,K,J) ! = the distance from the undeflected tower centerline to the current blade node in the xi ( z1) direction + position(2) = -1.*m%RtHS%rS (3,K,J) ! = the distance from the undeflected tower centerline to the current blade node in the yi (-z3) direction + position(3) = m%RtHS%rS (2,K,J) + p%PtfmRefzt ! = the distance from the nominal tower base position (i.e., the undeflected position of the tower base) to the current blade node in the zi ( z2) direction - ! Use orientation at node 1 for the blade root - CALL MeshPositionNode ( y%BladeLn2Mesh(K), p%BldNodes + 2, (/0.0_ReKi, 0.0_ReKi, 0.0_ReKi /), ErrStat2, ErrMsg2, Orient=u%BladePtLoads(K)%RefOrientation(:,:,1), ref=.true. ) + + CALL MeshPositionNode ( y%BladeLn2Mesh(K), NodeNum, position, ErrStat2, ErrMsg2, Orient=Orientation ) CALL CheckError( ErrStat2, ErrMsg2 ) IF (ErrStat >= AbortErrLev) RETURN - - else - - ! position the nodes on the blade root and blade tip: - DO J = 0,p%TipNode,p%TipNode - if (j==0) then ! blade root - NodeNum = p%BldNodes + 2 - y%BladeLn2Mesh(K)%RefNode = NodeNum - elseif (j==p%TipNode) then ! blade tip - NodeNum = p%BldNodes + 1 - end if - - Orientation(1,1) = m%CoordSys%n1(K,J,1) - Orientation(2,1) = m%CoordSys%n2(K,J,1) - Orientation(3,1) = m%CoordSys%n3(K,J,1) - Orientation(1,2) = -1.*m%CoordSys%n1(K,J,3) - Orientation(2,2) = -1.*m%CoordSys%n2(K,J,3) - Orientation(3,2) = -1.*m%CoordSys%n3(K,J,3) - Orientation(1,3) = m%CoordSys%n1(K,J,2) - Orientation(2,3) = m%CoordSys%n2(K,J,2) - Orientation(3,3) = m%CoordSys%n3(K,J,2) - - ! Translational Displacement - position(1) = m%RtHS%rS (1,K,J) ! = the distance from the undeflected tower centerline to the current blade node in the xi ( z1) direction - position(2) = -1.*m%RtHS%rS (3,K,J) ! = the distance from the undeflected tower centerline to the current blade node in the yi (-z3) direction - position(3) = m%RtHS%rS (2,K,J) + p%PtfmRefzt ! = the distance from the nominal tower base position (i.e., the undeflected position of the tower base) to the current blade node in the zi ( z2) direction - - - CALL MeshPositionNode ( y%BladeLn2Mesh(K), NodeNum, position, ErrStat2, ErrMsg2, Orient=Orientation ) - CALL CheckError( ErrStat2, ErrMsg2 ) - IF (ErrStat >= AbortErrLev) RETURN - - END DO ! nodes + + END DO ! nodes - end if ! position/orientation of nodes for AeroDyn v14 or v15 ! create elements: DO J = 2,p%TipNode !p%BldNodes + 1 @@ -8508,27 +8743,6 @@ SUBROUTINE ED_AllocOutput( p, m, u, y, ErrStat, ErrMsg ) CALL CheckError(ErrStat2,ErrMsg2) IF (ErrStat >= AbortErrLev) RETURN - ! -------------- pseudo-Hub (for AD v14) ----------------------------------- - CALL MeshCreate( BlankMesh = y%HubPtMotion14 & - ,IOS = COMPONENT_OUTPUT & - ,NNodes = 1 & - , TranslationDisp = .TRUE. & - , Orientation = .TRUE. & - , RotationVel = .TRUE. & - , ErrStat = ErrStat2 & - , ErrMess = ErrMsg2 ) - CALL CheckError(ErrStat2,ErrMsg2) - IF (ErrStat >= AbortErrLev) RETURN - - ! pseudo-Hub position and orientation (relative here as before, but should not be) - - CALL MeshPositionNode ( y%HubPtMotion14, 1, (/0.0_ReKi, 0.0_ReKi, p%HubHt /), ErrStat, ErrMsg ) !orientation is identity by default - CALL CheckError(ErrStat2,ErrMsg2) - IF (ErrStat >= AbortErrLev) RETURN - - CALL CommitPointMesh( y%HubPtMotion14 ) - IF (ErrStat >= AbortErrLev) RETURN - ! -------------- Blade Roots ----------------------------------- ALLOCATE( y%BladeRootMotion(p%NumBl), Stat=ErrStat2 ) @@ -8555,38 +8769,9 @@ SUBROUTINE ED_AllocOutput( p, m, u, y, ErrStat, ErrMsg ) END DO - CALL MeshCreate( BlankMesh = y%BladeRootMotion14 & - ,IOS = COMPONENT_OUTPUT & - ,NNodes = p%NumBl & - , Orientation = .TRUE. & - ,ErrStat = ErrStat2 & - ,ErrMess = ErrMsg2 ) - CALL CheckError(ErrStat2,ErrMsg2) - IF (ErrStat >= AbortErrLev) RETURN - DO K=1,p%NumBl - Orientation(1,1) = p%CosPreC(K) - Orientation(2,1) = 0.0_R8Ki - Orientation(3,1) = 1.0_R8Ki * p%SinPreC(K) - - Orientation(1,2) = 0.0_R8Ki - Orientation(2,2) = 1.0_R8Ki - Orientation(3,2) = 0.0_R8Ki - - Orientation(1,3) = -1.0_R8Ki * p%SinPreC(K) - Orientation(2,3) = 0.0_R8Ki - Orientation(3,3) = p%CosPreC(K) - - Position(1) = p%HubRad*p%SinPreC(K) - Position(2) = 0.0_ReKi - Position(3) = p%HubRad*p%CosPreC(K) - - CALL MeshPositionNode ( y%BladeRootMotion14, K, Position, & - ErrStat, ErrMsg, Orient=Orientation ) - CALL CheckError(ErrStat2,ErrMsg2) - IF (ErrStat >= AbortErrLev) RETURN - + position(1) = m%RtHS%rS (1,K,0) ! = the distance from the undeflected tower centerline to the current blade node in the xi ( z1) direction position(2) = -1.*m%RtHS%rS (3,K,0) ! = the distance from the undeflected tower centerline to the current blade node in the yi (-z3) direction @@ -8610,37 +8795,13 @@ SUBROUTINE ED_AllocOutput( p, m, u, y, ErrStat, ErrMsg ) END DO - CALL CommitPointMesh( y%BladeRootMotion14 ) - IF (ErrStat >= AbortErrLev) RETURN - DO k=1,p%NumBl CALL CommitPointMesh( y%BladeRootMotion(K) ) IF (ErrStat >= AbortErrLev) RETURN END DO - ! -------------- Rotor Furl ----------------------------------- - CALL MeshCreate( BlankMesh = y%RotorFurlMotion14 & - ,IOS = COMPONENT_OUTPUT & - ,NNodes = 1 & - , TranslationDisp = .TRUE. & - , Orientation = .TRUE. & - , RotationVel = .TRUE. & - ,ErrStat = ErrStat2 & - ,ErrMess = ErrMsg2 ) - CALL CheckError(ErrStat2,ErrMsg2) - IF (ErrStat >= AbortErrLev) RETURN - -!bjj: FIX THIS>>>> -!call wrscr(newline//'fix RotorFurlMotion initialization') - CALL MeshPositionNode ( y%RotorFurlMotion14, 1, (/0.0_ReKi, 0.0_ReKi, 0.0_ReKi /), ErrStat, ErrMsg ) !orientation is identity by default -!<<<<= AbortErrLev) RETURN - - CALL CommitPointMesh( y%RotorFurlMotion14 ) - IF (ErrStat >= AbortErrLev) RETURN - + ! -------------- Nacelle ----------------------------------- CALL MeshCopy ( SrcMesh = u%NacelleLoads & , DestMesh = y%NacelleMotion & @@ -8668,35 +8829,15 @@ SUBROUTINE ED_AllocOutput( p, m, u, y, ErrStat, ErrMsg ) , Orientation = .TRUE. & , TranslationVel = .TRUE. & , RotationVel = .TRUE. & - , TranslationAcc = .TRUE. & - , RotationAcc = .TRUE. & + , TranslationAcc = .FALSE. & + , RotationAcc = .FALSE. & , ErrStat = ErrStat2 & , ErrMess = ErrMsg2 ) call CheckError( ErrStat2, ErrMsg2 ) if (ErrStat >= AbortErrLev) RETURN - ! -------------- Tower Base----------------------------------- - CALL MeshCreate( BlankMesh = y%TowerBaseMotion14 & - ,IOS = COMPONENT_OUTPUT & - ,NNodes = 1 & - , TranslationDisp = .TRUE. & - , RotationVel = .TRUE. & - ,ErrStat = ErrStat2 & - ,ErrMess = ErrMsg2 ) - CALL CheckError(ErrStat2,ErrMsg2) - IF (ErrStat >= AbortErrLev) RETURN - -!bjj: FIX THIS>>>> -!call wrscr(newline//'fix TowerBaseMotion14 initialization') - CALL MeshPositionNode ( y%TowerBaseMotion14, 1, (/0.0_ReKi, 0.0_ReKi, 0.0_ReKi /), ErrStat, ErrMsg ) !orientation is identity by default -!<<<<= AbortErrLev) RETURN - - CALL CommitPointMesh( y%TowerBaseMotion14 ) - IF (ErrStat >= AbortErrLev) RETURN - + CONTAINS !............................................................................................................................... @@ -8847,62 +8988,34 @@ SUBROUTINE Init_u( u, p, x, InputFileData, m, ErrStat, ErrMsg ) ,ErrMess = ErrMsg2 ) if (Failed()) return - if (p%UseAD14) then - ! position the nodes on the blades: - DO J = 1,p%BldNodes - - NodeNum = J - - Orientation(1,1) = p%CAeroTwst(J) - Orientation(2,1) = p%SAeroTwst(J) - Orientation(3,1) = 0.0_ReKi - - Orientation(1,2) = -p%SAeroTwst(J) - Orientation(2,2) = p%CAeroTwst(J) - Orientation(3,2) = 0.0_ReKi - - Orientation(1,3) = 0.0_ReKi - Orientation(2,3) = 0.0_ReKi - Orientation(3,3) = 1.0_ReKi - - CALL MeshPositionNode ( u%BladePtLoads(K), NodeNum, (/0.0_ReKi, 0.0_ReKi, p%RNodes(J) /), ErrStat2, ErrMsg2, Orient=Orientation ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF - - END DO ! nodes - else - ! position the nodes on the blades: - DO J = 1,p%BldNodes - NodeNum = J + ! position the nodes on the blades: + DO J = 1,p%BldNodes + NodeNum = J - Orientation(1,1) = m%CoordSys%n1(K,J,1) - Orientation(2,1) = m%CoordSys%n2(K,J,1) - Orientation(3,1) = m%CoordSys%n3(K,J,1) - Orientation(1,2) = -1.*m%CoordSys%n1(K,J,3) - Orientation(2,2) = -1.*m%CoordSys%n2(K,J,3) - Orientation(3,2) = -1.*m%CoordSys%n3(K,J,3) - Orientation(1,3) = m%CoordSys%n1(K,J,2) - Orientation(2,3) = m%CoordSys%n2(K,J,2) - Orientation(3,3) = m%CoordSys%n3(K,J,2) - - ! Translational Displacement - position(1) = m%RtHS%rS (1,K,J) ! = the distance from the undeflected tower centerline to the current blade node in the xi ( z1) direction - position(2) = -1.*m%RtHS%rS (3,K,J) ! = the distance from the undeflected tower centerline to the current blade node in the yi (-z3) direction - position(3) = m%RtHS%rS (2,K,J) + p%PtfmRefzt ! = the distance from the nominal tower base position (i.e., the undeflected position of the tower base) to the current blade node in the zi ( z2) direction - - - CALL MeshPositionNode ( u%BladePtLoads(K), NodeNum, position, ErrStat2, ErrMsg2, Orient=Orientation ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF - - END DO ! nodes - end if ! position/orientation of nodes for AeroDyn v14 or v15 + Orientation(1,1) = m%CoordSys%n1(K,J,1) + Orientation(2,1) = m%CoordSys%n2(K,J,1) + Orientation(3,1) = m%CoordSys%n3(K,J,1) + Orientation(1,2) = -1.*m%CoordSys%n1(K,J,3) + Orientation(2,2) = -1.*m%CoordSys%n2(K,J,3) + Orientation(3,2) = -1.*m%CoordSys%n3(K,J,3) + Orientation(1,3) = m%CoordSys%n1(K,J,2) + Orientation(2,3) = m%CoordSys%n2(K,J,2) + Orientation(3,3) = m%CoordSys%n3(K,J,2) + + ! Translational Displacement + position(1) = m%RtHS%rS (1,K,J) ! = the distance from the undeflected tower centerline to the current blade node in the xi ( z1) direction + position(2) = -1.*m%RtHS%rS (3,K,J) ! = the distance from the undeflected tower centerline to the current blade node in the yi (-z3) direction + position(3) = m%RtHS%rS (2,K,J) + p%PtfmRefzt ! = the distance from the nominal tower base position (i.e., the undeflected position of the tower base) to the current blade node in the zi ( z2) direction + + + CALL MeshPositionNode ( u%BladePtLoads(K), NodeNum, position, ErrStat2, ErrMsg2, Orient=Orientation ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + IF (ErrStat >= AbortErrLev) THEN + CALL Cleanup() + RETURN + END IF + + END DO ! nodes ! create elements: DO J = 1,p%BldNodes !p%BldNodes + 1 @@ -8952,7 +9065,7 @@ SUBROUTINE Init_u( u, p, x, InputFileData, m, ErrStat, ErrMsg ) Orientation(1,3) = m%CoordSys%g1(2) Orientation(2,3) = m%CoordSys%g2(2) Orientation(3,3) = m%CoordSys%g3(2) - call CreatePointMesh(u%HubPtLoad, Position, Orientation, errStat2, errMsg2, hasMotion=.False., hasLoads=.True.) + call CreateInputPointMesh(u%HubPtLoad, Position, Orientation, errStat2, errMsg2, hasMotion=.False., hasLoads=.True.) if (Failed()) return @@ -8961,7 +9074,7 @@ SUBROUTINE Init_u( u, p, x, InputFileData, m, ErrStat, ErrMsg ) !....................................................... Position = (/0.0_ReKi, 0.0_ReKi, p%PtfmRefzt /) call Eye(Orientation, ErrStat2, errMsg2) - call CreatePointMesh(u%PlatformPtMesh, Position, Orientation, errStat2, errMsg2, hasMotion=.False., hasLoads=.True.) + call CreateInputPointMesh(u%PlatformPtMesh, Position, Orientation, errStat2, errMsg2, hasMotion=.False., hasLoads=.True.) if (Failed()) return !....................................................... @@ -8969,7 +9082,7 @@ SUBROUTINE Init_u( u, p, x, InputFileData, m, ErrStat, ErrMsg ) !....................................................... Position = (/0.0_ReKi, 0.0_ReKi, p%TowerHt /) call Eye(Orientation, ErrStat2, errMsg2) - call CreatePointMesh(u%NacelleLoads, Position, Orientation, errStat2, errMsg2, hasMotion=.False., hasLoads=.True.) + call CreateInputPointMesh(u%NacelleLoads, Position, Orientation, errStat2, errMsg2, hasMotion=.False., hasLoads=.True.) if (Failed()) return !....................................................... @@ -8987,7 +9100,7 @@ SUBROUTINE Init_u( u, p, x, InputFileData, m, ErrStat, ErrMsg ) Orientation(1,3) = m%CoordSys%tf1(2) Orientation(2,3) = m%CoordSys%tf2(2) Orientation(3,3) = m%CoordSys%tf3(2) - call CreatePointMesh(u%TFinCMLoads, Position, Orientation, errStat2, errMsg2, hasMotion=.False., hasLoads=.True.) + call CreateInputPointMesh(u%TFinCMLoads, Position, Orientation, errStat2, errMsg2, hasMotion=.False., hasLoads=.True.) if (Failed()) return @@ -9347,6 +9460,8 @@ SUBROUTINE ED_AB4( t, n, u, utimes, p, x, xd, z, OtherState, m, ErrStat, ErrMsg END IF OtherState%HSSBrTrq = OtherState%HSSBrTrqC OtherState%SgnPrvLSTQ = OtherState%SgnLSTQ(OtherState%IC(2)) + OtherState%OmegaTn = x%QDT(DOF_Yaw) !this is equal to x%QDT(DOF_Yaw) + OtherState%OmegaDotTn = m%QD2T(DOF_Yaw) !this is equal to m%QD2T(DOF_Yaw) CALL ED_CalcContStateDeriv( t, u_interp, p, x, xd, z, OtherState, m, xdot, ErrStat2, ErrMsg2 ) CALL CheckError(ErrStat2,ErrMsg2) @@ -9381,6 +9496,11 @@ SUBROUTINE ED_AB4( t, n, u, utimes, p, x, xd, z, OtherState, m, ErrStat, ErrMsg CALL FixHSSBrTq ( 'P', p, x, OtherState, m, ErrStat2, ErrMsg2 ) CALL CheckError(ErrStat2,ErrMsg2) IF ( ErrStat >= AbortErrLev ) RETURN + + CALL FixYawFric ( 'P', p, x, OtherState, m, ErrStat2, ErrMsg2 ) !KBF Make sure YawFric will not reverse nacelle direction x%qdt(dof_yaw) = OtherState%xdot(OtherState%IC(1))%qt(DOF_Yaw ) + CALL CheckError(ErrStat2,ErrMsg2) + IF ( ErrStat >= AbortErrLev ) RETURN + endif @@ -9540,8 +9660,13 @@ SUBROUTINE ED_ABM4( t, n, u, utimes, p, x, xd, z, OtherState, m, ErrStat, ErrMsg CALL FixHSSBrTq ( 'C', p, x, OtherState, m, ErrStat2, ErrMsg2 ) CALL CheckError(ErrStat2,ErrMsg2) IF ( ErrStat >= AbortErrLev ) RETURN - OtherState%SgnPrvLSTQ = SignLSSTrq(p, m) - OtherState%SgnLSTQ(OtherState%IC(1)) = OtherState%SgnPrvLSTQ + + CALL FixYawFric ( 'C', p, x, OtherState, m, ErrStat2, ErrMsg2 ) !KBF Make sure YawFric will not reverse nacelle direction x%qdt(dof_yaw) = OtherState%xdot(OtherState%IC(1))%qt(DOF_Yaw ) + CALL CheckError(ErrStat2,ErrMsg2) + IF ( ErrStat >= AbortErrLev ) RETURN + + OtherState%SgnPrvLSTQ = SignLSSTrq(p, m) + OtherState%SgnLSTQ(OtherState%IC(1)) = OtherState%SgnPrvLSTQ else @@ -10020,6 +10145,201 @@ SUBROUTINE FixHSSBrTq ( Integrator, p, x, OtherState, m, ErrStat, ErrMsg ) RETURN END SUBROUTINE FixHSSBrTq +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine is used to adjust the YawFricMom value for unphysicalities. +SUBROUTINE FixYawFric ( Integrator, p, x, OtherState, m, ErrStat, ErrMsg ) + + ! Passed variables: + + TYPE(ED_ParameterType), INTENT(IN ) :: p !< Parameters of the structural dynamics module + TYPE(ED_OtherStateType), INTENT(INOUT) :: OtherState !< Other states of the structural dynamics module + TYPE(ED_MiscVarType), INTENT(INOUT) :: m !< misc (optimization) variables + TYPE(ED_ContinuousStateType),INTENT(INOUT) :: x !< Continuous states of the structural dynamics module at n+1 + CHARACTER(1), INTENT(IN ) :: Integrator !< A string holding the current integrator being used. + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + + ! Local variables: + + REAL(ReKi) :: RqdFrcYaw ! The force term required to produce RqdQD2Yaw. + REAL(ReKi) :: RqdQD2Yaw ! The required QD2T(DOF_Yaw) to cause the yaw bearing to stop rotating. + + INTEGER :: I ! Loops through all DOFs. + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FixYawFric' + + + + ErrStat = ErrID_None + ErrMsg = "" + + IF ( .NOT. p%DOF_Flag(DOF_Yaw) .OR. EqualRealNos(m%RtHS%YawFriMom, 0.0_ReKi ) ) RETURN + + + ! The absolute magnitude of the yaw friction must have been too great + ! that the yaw speed sign was reversed. What should have happened + ! is that the yaw system should have stopped rotating. In other words, + ! QD(DOF_Yaw,IC(NMX)) should equal zero! Determining what + ! QD2T(DOF_Yaw) will make QD(DOF_Yaw,IC(NMX)) = 0, depends on + ! which integrator we are using. + + + SELECT CASE (Integrator) + + CASE ('C') ! Corrector + + ! Find the required QD2T(DOF_Yaw) to cause the yaw system to stop rotating (RqdQD2Yaw). + ! This is found by solving the corrector formula for QD2(DOF_Yaw,IC(NMX)) + ! when QD(DOF_Yaw,IC(NMX)) equals zero. + + RqdQD2Yaw = ( - OtherState%xdot(OtherState%IC(1))%qt(DOF_Yaw)/ p%DT24 & + - 19.0*OtherState%xdot(OtherState%IC(1))%qdt(DOF_Yaw) & + + 5.0*OtherState%xdot(OtherState%IC(2))%qdt(DOF_Yaw) & + - OtherState%xdot(OtherState%IC(3))%qdt(DOF_Yaw) ) / 9.0 + + CASE ('P') ! Predictor + + ! Find the required QD2T(DOF_Yaw) to cause the yaw system to stop rotating (RqdQD2Yaw). + ! This is found by solving the predictor formula for QD2(DOF_Yaw,IC(1)) + ! when QD(DOF_Yaw,IC(NMX)) equals zero. + + RqdQD2Yaw = ( - OtherState%xdot(OtherState%IC(1))%qt( DOF_Yaw) / p%DT24 & + + 59.0*OtherState%xdot(OtherState%IC(2))%qdt(DOF_Yaw) & + - 37.0*OtherState%xdot(OtherState%IC(3))%qdt(DOF_Yaw) & + + 9.0*OtherState%xdot(OtherState%IC(4))%qdt(DOF_Yaw) )/55.0 + + END SELECT + + + ! Rearrange the augmented matrix of equations of motion to account + ! for the known acceleration of the yaw DOF. To + ! do this, make the known inertia like an applied force to the + ! system. Then set force QD2T(DOF_Yaw) to equal the known + ! acceleration in the augmented matrix of equations of motion: + ! Here is how the new equations are derived. First partition the + ! augmented matrix as follows, where Qa are the unknown + ! accelerations, Qb are the known accelerations, Fa are the + ! known forces, and Fb are the unknown forces: + ! [Caa Cab]{Qa}={Fa} + ! [Cba Cbb]{Qb}={Fb} + ! By rearranging, the equations for the unknown and known + ! accelerations are as follows: + ! [Caa]{Qa}={Fa}-[Cab]{Qb} and [I]{Qb}={Qb} + ! Combining these two sets of equations into one set yields: + ! [Caa 0]{Qa}={{Fa}-[Cab]{Qb}} + ! [ 0 I]{Qb}={ {Qb}} + ! Once this equation is solved, the unknown force can be found from: + ! {Fb}=[Cba]{Qa}+[Cbb]{Qb} + + m%OgnlYawRow = m%AugMat(DOF_Yaw,:) ! copy this row before modifying the old matrix + + + DO I = 1,p%DOFs%NActvDOF ! Loop through all active (enabled) DOFs + + m%AugMat(p%DOFs%SrtPS(I), p%NAUG) = m%AugMat(p%DOFs%SrtPS(I),p%NAUG) & + - m%AugMat(p%DOFs%SrtPS(I),DOF_Yaw)*RqdQD2Yaw ! {{Fa}-[Cab]{Qb}} + m%AugMat(p%DOFs%SrtPS(I),DOF_Yaw) = 0.0 ! [0] + m%AugMat(DOF_Yaw, p%DOFs%SrtPS(I)) = 0.0 ! [0] + + ENDDO ! I - All active (enabled) DOFs + + m%AugMat(DOF_Yaw,DOF_Yaw) = 1.0 ! [I]{Qb}={Qb} + m%AugMat(DOF_Yaw, p%NAUG) = RqdQD2Yaw ! + + + ! Invert the matrix to solve for the new (updated) accelerations. Like in + ! CalcContStateDeriv(), the accelerations are returned by Gauss() in the first NActvDOF + ! elements of the solution vector, SolnVec(). These are transfered to the + ! proper index locations of the acceleration vector QD2T() using the + ! vector subscript array SrtPS(), after Gauss() has been called: + + ! Invert the matrix to solve for the accelerations. The accelerations are returned by Gauss() in the first NActvDOF elements + ! of the solution vector, SolnVec(). These are transfered to the proper index locations of the acceleration vector QD2T() + ! using the vector subscript array SrtPS(), after Gauss() has been called: + + m%AugMat_factor = m%AugMat( p%DOFs%SrtPS( 1:p%DOFs%NActvDOF ), p%DOFs%SrtPSNAUG(1:p%DOFs%NActvDOF) ) + m%SolnVec = m%AugMat( p%DOFs%SrtPS( 1:p%DOFs%NActvDOF ), p%DOFs%SrtPSNAUG(1+p%DOFs%NActvDOF) ) + + CALL LAPACK_getrf( M=p%DOFs%NActvDOF, N=p%DOFs%NActvDOF, A=m%AugMat_factor, IPIV=m%AugMat_pivot, ErrStat=ErrStat2, ErrMsg=ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF ( ErrStat >= AbortErrLev ) RETURN + + CALL LAPACK_getrs( TRANS='N',N=p%DOFs%NActvDOF, A=m%AugMat_factor,IPIV=m%AugMat_pivot, B=m%SolnVec, ErrStat=ErrStat2, ErrMsg=ErrMsg2) + + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + IF ( ErrStat >= AbortErrLev ) RETURN + + + ! Find the force required to produce RqdQD2Yaw from the equations of + ! motion using the new accelerations: + + RqdFrcYaw = 0.0 + DO I = 1,p%DOFs%NActvDOF ! Loop through all active (enabled) DOFs + ! bjj: use m%SolnVec(I) instead of m%QD2T(p%DOFs%SrtPS(I)) here; then update m%QD2T(p%DOFs%SrtPS(I)) + ! later if necessary + RqdFrcYaw = RqdFrcYaw + m%OgnlYawRow(p%DOFs%SrtPS(I))*m%SolnVec(I) ! {Fb}=[Cba]{Qa}+[Cbb]{Qb} (note that [Cba , Cbb] is the old row, and [Qa;Qb] is a single vector SolVec; %Note this is supposedly= YawFriMz+YawFriMf+DeltaM + ENDDO ! I - All active (enabled) DOFs + + ! Find the YawFriMfp necessary to bring about this force, i.e. to stop the yaw: + + OtherState%YawFriMfp = m%RtHs%YawFriMom - ( m%OgnlYawRow(p%NAUG) - RqdFrcYaw ) !This should return YawFriMf - (YawFriMz + YawFriMf - (YawFriMz + YawFriMf + deltaM)) = YawFriMf+DeltaM =YawFriMfp + + OtherState%Mfhat = ABS(OtherState%YawFriMfp) * SIGN(1.0_ReKi, real(m%RtHs%YawFriMom,ReKi)) !Mfhat should have same sign as YawFriMom (YawFriMf) + +!Now check if YawFriMfp is unphysical (i.e., it turned out aligned with omega), and then pick the minimum between YawFriMf and YawFriMfp + + IF ( ABS( OtherState%YawFriMfp ) > ABS( m%RtHs%YawFriMom )) THEN + + OtherState%Mfhat = m%RtHs%YawFriMom !OtherState%HSSBrTrqC = SIGN( u%HSSBrTrqC, x%QDT(DOF_GeAz) ) KBF CHECK THIS, does YawFriMfp need to be OtherState? + + ELSE + + ! overwrite QD2T with the new values + m%QD2T = 0.0 + DO I = 1,p%DOFs%NActvDOF ! Loop through all active (enabled) DOFs + m%QD2T(p%DOFs%SrtPS(I)) = m%SolnVec(I) + ENDDO ! I - All active (enabled) DOFs + + + ! Use the new accelerations to update the DOF values. Again, this + ! depends on the integrator type: + + SELECT CASE (Integrator) + + CASE ('C') ! Corrector + + ! Update QD and QD2 with the new accelerations using the corrector. + ! This will make QD(DOF_Yaw,IC(NMX)) equal to zero and adjust all + ! of the other QDs as necessary. + ! The Q's are unnaffected by this change. + + x%qdt = OtherState%xdot(OtherState%IC(1))%qt & ! qd at n + + p%DT24 * ( 9. * m%QD2T & ! the value we just changed + + 19. * OtherState%xdot(OtherState%IC(1))%qdt & + - 5. * OtherState%xdot(OtherState%IC(2))%qdt & + + 1. * OtherState%xdot(OtherState%IC(3))%qdt ) + + CASE ('P') ! Predictor + + ! Update QD and QD2 with the new accelerations using predictor. + + x%qdt = OtherState%xdot(OtherState%IC(1))%qt + & ! qd at n + p%DT24 * ( 55.*m%QD2T & ! the value we just changed + - 59.*OtherState%xdot(OtherState%IC(2))%qdt & + + 37.*OtherState%xdot(OtherState%IC(3))%qdt & + - 9.*OtherState%xdot(OtherState%IC(4))%qdt ) + + OtherState%xdot ( OtherState%IC(1) )%qdt = m%QD2T ! fix the history + + END SELECT + + ENDIF + + RETURN +END SUBROUTINE FixYawFric + !---------------------------------------------------------------------------------------------------------------------------------- !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ @@ -10091,7 +10411,7 @@ SUBROUTINE ED_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM ! allocate dYdu if necessary if (.not. allocated(dYdu)) then - call AllocAry(dYdu, p%Jac_ny, size(p%Jac_u_indx,1)+1, 'dYdu', ErrStat2, ErrMsg2) + call AllocAry(dYdu, p%Jac_ny, size(p%Jac_u_indx,1)+p%NumExtendedInputs, 'dYdu', ErrStat2, ErrMsg2) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) if (ErrStat>=AbortErrLev) then call cleanup() @@ -10099,57 +10419,62 @@ SUBROUTINE ED_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM end if end if - ! make a copy of outputs because we will need two for the central difference computations (with orientations) - call ED_CopyOutput( y, y_p, MESH_NEWCOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call ED_CopyOutput( y, y_m, MESH_NEWCOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if + if (p%CompAeroMaps) then + dYdu = 0.0_R8Ki + else + ! make a copy of outputs because we will need two for the central difference computations (with orientations) + call ED_CopyOutput( y, y_p, MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + call ED_CopyOutput( y, y_m, MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (ErrStat>=AbortErrLev) then + call cleanup() + return + end if - do i=1,size(p%Jac_u_indx,1) + do i=1,size(p%Jac_u_indx,1) - ! get u_op + delta u - call ED_CopyInput( u, u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - call ED_Perturb_u( p, i, 1, u_perturb, delta ) - - ! compute y at u_op + delta u - call ED_CalcOutput( t, u_perturb, p, x, xd, z, OtherState, y_p, m, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later + ! get u_op + delta u + call ED_CopyInput( u, u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later + call ED_Perturb_u( p, i, 1, u_perturb, delta ) + + ! compute y at u_op + delta u + call ED_CalcOutput( t, u_perturb, p, x, xd, z, OtherState, y_p, m, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - ! get u_op - delta u - call ED_CopyInput( u, u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - call ED_Perturb_u( p, i, -1, u_perturb, delta ) + ! get u_op - delta u + call ED_CopyInput( u, u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later + call ED_Perturb_u( p, i, -1, u_perturb, delta ) - ! compute y at u_op - delta u - call ED_CalcOutput( t, u_perturb, p, x, xd, z, OtherState, y_m, m, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later + ! compute y at u_op - delta u + call ED_CalcOutput( t, u_perturb, p, x, xd, z, OtherState, y_m, m, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - ! get central difference: - call Compute_dY( p, y_p, y_m, delta, dYdu(:,i) ) + ! get central difference: + call Compute_dY( p, y_p, y_m, delta, dYdu(:,i) ) - end do - - ! now do the extended input: sum the p%NumBl blade pitch columns - dYdu(:,size(p%Jac_u_indx,1)+1) = dYdu(:,size(p%Jac_u_indx,1)-p%NumBl-1) ! last NumBl+2 columns are: GenTrq, YawMom, and BlPitchCom - do i=2,p%NumBl - dYdu(:,size(p%Jac_u_indx,1)+1) = dYdu(:,size(p%Jac_u_indx,1)+1) + dYdu(:,size(p%Jac_u_indx,1)-p%NumBl-2+i) - end do + end do + ! now do the extended input: sum the p%NumBl blade pitch columns + if (p%NumExtendedInputs > 0) then + dYdu(:,size(p%Jac_u_indx,1)+1) = dYdu(:,size(p%Jac_u_indx,1)-p%NumBl-1) ! last NumBl+2 columns are: GenTrq, YawMom, and BlPitchCom + do i=2,p%NumBl + dYdu(:,size(p%Jac_u_indx,1)+1) = dYdu(:,size(p%Jac_u_indx,1)+1) + dYdu(:,size(p%Jac_u_indx,1)-p%NumBl-2+i) + end do + end if - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if - call ED_DestroyOutput( y_p, ErrStat2, ErrMsg2 ) ! we don't need this any more - call ED_DestroyOutput( y_m, ErrStat2, ErrMsg2 ) ! we don't need this any more + if (ErrStat>=AbortErrLev) then + call cleanup() + return + end if + call ED_DestroyOutput( y_p, ErrStat2, ErrMsg2 ) ! we don't need this any more + call ED_DestroyOutput( y_m, ErrStat2, ErrMsg2 ) ! we don't need this any more + end if !CompAeroMaps END IF @@ -10160,7 +10485,7 @@ SUBROUTINE ED_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM ! allocate dXdu if necessary if (.not. allocated(dXdu)) then - call AllocAry(dXdu, p%DOFs%NActvDOF * 2, size(p%Jac_u_indx,1)+1, 'dXdu', ErrStat2, ErrMsg2) + call AllocAry(dXdu, p%NActvDOF_Lin + p%NActvVelDOF_Lin, size(p%Jac_u_indx,1)+p%NumExtendedInputs, 'dXdu', ErrStat2, ErrMsg2) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) if (ErrStat>=AbortErrLev) then call cleanup() @@ -10192,31 +10517,25 @@ SUBROUTINE ED_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - ! get central difference: - ! we may have had an error allocating memory, so we'll check if (ErrStat>=AbortErrLev) then call cleanup() return - end if - - do j=1,p%DOFs%NActvDOF ! Loop through all active (enabled) DOFs - dXdu(j, i) = x_p%QT( p%DOFs%PS(j) ) - x_m%QT( p%DOFs%PS(j) ) - end do - do j=1,p%DOFs%NActvDOF ! Loop through all active (enabled) DOFs - dXdu(j+p%DOFs%NActvDOF, i) = x_p%QDT( p%DOFs%PS(j) ) - x_m%QDT( p%DOFs%PS(j) ) - end do - dXdu(:,i) = dXdu(:,i) / (2*delta) + end if + ! get central difference: + call Compute_dX( p, x_p, x_m, delta, dXdu(:,i) ) + end do ! now do the extended input: sum the p%NumBl blade pitch columns - dXdu(:,size(p%Jac_u_indx,1)+1) = dXdu(:,size(p%Jac_u_indx,1)-p%NumBl-1) ! last NumBl+2 columns are: GenTrq, YawMom, and BlPitchCom - do i=2,p%NumBl - dXdu(:,size(p%Jac_u_indx,1)+1) = dXdu(:,size(p%Jac_u_indx,1)+1) + dXdu(:,size(p%Jac_u_indx,1)-p%NumBl-2+i) - end do - + if (p%NumExtendedInputs > 0) then + dXdu(:,size(p%Jac_u_indx,1)+1) = dXdu(:,size(p%Jac_u_indx,1)-p%NumBl-1) ! last NumBl+2 columns are: GenTrq, YawMom, and BlPitchCom + do i=2,p%NumBl + dXdu(:,size(p%Jac_u_indx,1)+1) = dXdu(:,size(p%Jac_u_indx,1)+1) + dXdu(:,size(p%Jac_u_indx,1)-p%NumBl-2+i) + end do + end if call ED_DestroyContState( x_p, ErrStat2, ErrMsg2 ) ! we don't need this any more call ED_DestroyContState( x_m, ErrStat2, ErrMsg2 ) ! we don't need this any more @@ -10311,7 +10630,7 @@ SUBROUTINE ED_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ! allocate dYdx if necessary if (.not. allocated(dYdx)) then - call AllocAry(dYdx, p%Jac_ny, p%DOFs%NActvDOF*2, 'dYdx', ErrStat2, ErrMsg2) + call AllocAry(dYdx, p%Jac_ny, p%NActvDOF_Lin + p%NActvVelDOF_Lin, 'dYdx', ErrStat2, ErrMsg2) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) if (ErrStat>=AbortErrLev) then call cleanup() @@ -10330,7 +10649,7 @@ SUBROUTINE ED_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, end if - do i=1,p%DOFs%NActvDOF*2 + do i=1,p%NActvDOF_Lin + p%NActvVelDOF_Lin ! get x_op + delta x call ED_CopyContState( x, x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) @@ -10372,7 +10691,7 @@ SUBROUTINE ED_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ! allocate dXdx if necessary if (.not. allocated(dXdx)) then - call AllocAry(dXdx, p%DOFs%NActvDOF * 2, p%DOFs%NActvDOF * 2, 'dXdx', ErrStat2, ErrMsg2) + call AllocAry(dXdx, p%NActvDOF_Lin + p%NActvVelDOF_Lin, p%NActvDOF_Lin + p%NActvVelDOF_Lin, 'dXdx', ErrStat2, ErrMsg2) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) if (ErrStat>=AbortErrLev) then call cleanup() @@ -10380,7 +10699,7 @@ SUBROUTINE ED_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, end if end if - do i=1,p%DOFs%NActvDOF * 2 + do i=1,p%NActvDOF_Lin + p%NActvVelDOF_Lin ! get x_op + delta x call ED_CopyContState( x, x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) @@ -10402,22 +10721,17 @@ SUBROUTINE ED_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - ! get central difference: - ! we may have had an error allocating memory, so we'll check if (ErrStat>=AbortErrLev) then call cleanup() return - end if + end if - do j=1,p%DOFs%NActvDOF ! Loop through all active (enabled) DOFs - dXdx(j, i) = x_p%QT( p%DOFs%PS(j) ) - x_m%QT( p%DOFs%PS(j) ) - end do - do j=1,p%DOFs%NActvDOF ! Loop through all active (enabled) DOFs - dXdx(j+p%DOFs%NActvDOF, i) = x_p%QDT( p%DOFs%PS(j) ) - x_m%QDT( p%DOFs%PS(j) ) - end do - dXdx(:,i) = dXdx(:,i) / (2*delta) + ! get central difference: + + call Compute_dX( p, x_p, x_m, delta, dXdx(:,i) ) + end do call ED_DestroyContState( x_p, ErrStat2, ErrMsg2 ) ! we don't need this any more @@ -10607,6 +10921,7 @@ SUBROUTINE ED_Init_Jacobian_y( p, y, InitOut, ErrStat, ErrMsg) CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'ED_Init_Jacobian_y' LOGICAL :: Mask(FIELDMASK_SIZE) ! flags to determine if this field is part of the packing + LOGICAL :: BladeMask(FIELDMASK_SIZE) ! flags to determine if this field is part of the packing logical, allocatable :: AllOut(:) @@ -10616,25 +10931,38 @@ SUBROUTINE ED_Init_Jacobian_y( p, y, InitOut, ErrStat, ErrMsg) ! determine how many outputs there are in the Jacobians - p%Jac_ny = 0 - if (allocated(y%BladeLn2Mesh)) then - do i=1,p%NumBl - p%Jac_ny = p%Jac_ny + y%BladeLn2Mesh(i)%NNodes * 18 ! 3 TranslationDisp, Orientation, TranslationVel, RotationVel, TranslationAcc, and RotationAcc at each node on each blade - end do - end if + p%Jac_ny = 0 + BladeMask = .true. ! default is all the fields + if (p%CompAeroMaps) then + if (allocated(y%BladeLn2Mesh)) then + do i=1,p%NumBl_Lin + p%Jac_ny = p%Jac_ny + y%BladeLn2Mesh(i)%NNodes * 12 ! 3 TranslationDisp, Orientation, TranslationVel, and RotationVel at each node on each blade (skip accelerations) + end do + end if + BladeMask(MASKID_TRANSLATIONACC) = .false. + BladeMask(MASKID_ROTATIONACC) = .false. + else - p%Jac_ny = p%Jac_ny & - + y%PlatformPtMesh%NNodes * 18 & ! 3 TranslationDisp, Orientation, TranslationVel, RotationVel, TranslationAcc, and RotationAcc at each node - + y%TowerLn2Mesh%NNodes * 18 & ! 3 TranslationDisp, Orientation, TranslationVel, RotationVel, TranslationAcc, and RotationAcc at each node - + y%HubPtMotion%NNodes * 9 & ! 3 TranslationDisp, Orientation, and RotationVel at each node - + y%NacelleMotion%NNodes * 18 & ! 3 TranslationDisp, Orientation, TranslationVel, RotationVel, TranslationAcc, and RotationAcc at each node - + 3 & ! Yaw, YawRate, and HSS_Spd - + p%NumOuts + p%BldNd_TotNumOuts ! WriteOutput values - - do i=1,p%NumBl - p%Jac_ny = p%Jac_ny + y%BladeRootMotion(i)%NNodes * 18 ! 3 TranslationDisp, Orientation, TranslationVel, RotationVel, TranslationAcc, and RotationAcc at each (1) node on each blade - end do + if (allocated(y%BladeLn2Mesh)) then + do i=1,p%NumBl_Lin + p%Jac_ny = p%Jac_ny + y%BladeLn2Mesh(i)%NNodes * 18 ! 3 TranslationDisp, Orientation, TranslationVel, RotationVel, TranslationAcc, and RotationAcc at each node on each blade + end do + end if + + p%Jac_ny = p%Jac_ny & + + y%PlatformPtMesh%NNodes * 18 & ! 3 TranslationDisp, Orientation, TranslationVel, RotationVel, TranslationAcc, RotationAcc at each node + + y%TowerLn2Mesh%NNodes * 18 & ! 3 TranslationDisp, Orientation, TranslationVel, RotationVel, TranslationAcc, RotationAcc at each node + + y%HubPtMotion%NNodes * 9 & ! 3 TranslationDisp, Orientation, RotationVel at each node + + y%NacelleMotion%NNodes * 18 & ! 3 TranslationDisp, Orientation, TranslationVel, RotationVel, TranslationAcc, RotationAcc at each node + + y%TFinCMMotion%NNodes * 12 & ! 3 TranslationDisp, Orientation, TranslationVel, RotationVel at each node + + 3 & ! Yaw, YawRate, and HSS_Spd + + p%NumOuts + p%BldNd_TotNumOuts ! WriteOutput values + + do i=1,p%NumBl_Lin + p%Jac_ny = p%Jac_ny + y%BladeRootMotion(i)%NNodes * 18 ! 3 TranslationDisp, Orientation, TranslationVel, RotationVel, TranslationAcc, and RotationAcc at each (1) node on each blade + end do + end if !................. ! set linearization output names: @@ -10645,101 +10973,118 @@ SUBROUTINE ED_Init_Jacobian_y( p, y, InitOut, ErrStat, ErrMsg) InitOut%RotFrame_y = .false. ! note that meshes are in the global, not rotating frame - ! note that this Mask is for the y%HubPtMotion mesh ONLY. The others pack *all* of the motion fields - Mask = .false. - Mask(MASKID_TRANSLATIONDISP) = .true. - Mask(MASKID_ORIENTATION) = .true. - Mask(MASKID_ROTATIONVEL) = .true. index_next = 1 if (allocated(y%BladeLn2Mesh)) then index_last = index_next - do i=1,p%NumBl - call PackMotionMesh_Names(y%BladeLn2Mesh(i), 'Blade '//trim(num2lstr(i)), InitOut%LinNames_y, index_next) + p%Jac_y_idxStartList%Blade = index_next + do i=1,p%NumBl_Lin + call PackMotionMesh_Names(y%BladeLn2Mesh(i), 'Blade '//trim(num2lstr(i)), InitOut%LinNames_y, index_next, FieldMask=BladeMask) end do - !InitOut%RotFrame_y(index_last:index_next-1) = .true. ! values on the mesh are in global, not rotating frame end if - call PackMotionMesh_Names(y%PlatformPtMesh, 'Platform', InitOut%LinNames_y, index_next) - call PackMotionMesh_Names(y%TowerLn2Mesh, 'Tower', InitOut%LinNames_y, index_next) - call PackMotionMesh_Names(y%HubPtMotion, 'Hub', InitOut%LinNames_y, index_next, FieldMask=Mask) - index_last = index_next - do i=1,p%NumBl - call PackMotionMesh_Names(y%BladeRootMotion(i), 'Blade root '//trim(num2lstr(i)), InitOut%LinNames_y, index_next) - end do - !InitOut%RotFrame_y(index_last:index_next-1) = .true. ! values on the mesh are in global, not rotating frame - - call PackMotionMesh_Names(y%NacelleMotion, 'Nacelle', InitOut%LinNames_y, index_next) - InitOut%LinNames_y(index_next) = 'Yaw, rad'; index_next = index_next+1 - InitOut%LinNames_y(index_next) = 'YawRate, rad/s'; index_next = index_next+1 - InitOut%LinNames_y(index_next) = 'HSS_Spd, rad/s' + + if (.not. p%CompAeroMaps) then + p%Jac_y_idxStartList%Platform = index_next + call PackMotionMesh_Names(y%PlatformPtMesh, 'Platform', InitOut%LinNames_y, index_next) + p%Jac_y_idxStartList%Tower = index_next + call PackMotionMesh_Names(y%TowerLn2Mesh, 'Tower', InitOut%LinNames_y, index_next) + + ! note that this Mask is for the y%HubPtMotion mesh ONLY. The others pack *all* of the motion fields + Mask = .false. + Mask(MASKID_TRANSLATIONDISP) = .true. + Mask(MASKID_ORIENTATION) = .true. + Mask(MASKID_ROTATIONVEL) = .true. + + p%Jac_y_idxStartList%Hub = index_next + call PackMotionMesh_Names(y%HubPtMotion, 'Hub', InitOut%LinNames_y, index_next, FieldMask=Mask) + index_last = index_next + p%Jac_y_idxStartList%BladeRoot = index_next + do i=1,p%NumBl_Lin + call PackMotionMesh_Names(y%BladeRootMotion(i), 'Blade root '//trim(num2lstr(i)), InitOut%LinNames_y, index_next) + end do + + p%Jac_y_idxStartList%Nacelle = index_next + call PackMotionMesh_Names(y%NacelleMotion, 'Nacelle', InitOut%LinNames_y, index_next) + + Mask = .false. + Mask(MASKID_TRANSLATIONDISP) = .true. + Mask(MASKID_ORIENTATION) = .true. + Mask(MASKID_TRANSLATIONVEL) = .true. + Mask(MASKID_ROTATIONVEL) = .true. + p%Jac_y_idxStartList%TFin = index_next + call PackMotionMesh_Names(y%TFinCMMotion, 'TailFin', InitOut%LinNames_y, index_next, FieldMask=Mask) + + InitOut%LinNames_y(index_next) = 'Yaw, rad'; index_next = index_next+1 + InitOut%LinNames_y(index_next) = 'YawRate, rad/s'; index_next = index_next+1 + InitOut%LinNames_y(index_next) = 'HSS_Spd, rad/s' - do i=1,p%NumOuts + p%BldNd_TotNumOuts - InitOut%LinNames_y(i+index_next) = trim(InitOut%WriteOutputHdr(i))//', '//trim(InitOut%WriteOutputUnt(i)) !trim(p%OutParam(i)%Name)//', '//p%OutParam(i)%Units - end do + do i=1,p%NumOuts + p%BldNd_TotNumOuts + InitOut%LinNames_y(i+index_next) = trim(InitOut%WriteOutputHdr(i))//', '//trim(InitOut%WriteOutputUnt(i)) !trim(p%OutParam(i)%Name)//', '//p%OutParam(i)%Units + end do - !! check for AllOuts in rotating frame - allocate( AllOut(0:MaxOutPts), STAT=ErrStat2 ) ! allocate starting at zero to account for invalid output channels - if (ErrStat2 /=0 ) then - call SetErrStat(ErrID_Info, 'error allocating temporary space for AllOut',ErrStat,ErrMsg,RoutineName) - return; - end if + !! check for AllOuts in rotating frame + allocate( AllOut(0:MaxOutPts), STAT=ErrStat2 ) ! allocate starting at zero to account for invalid output channels + if (ErrStat2 /=0 ) then + call SetErrStat(ErrID_Info, 'error allocating temporary space for AllOut',ErrStat,ErrMsg,RoutineName) + return; + end if - AllOut = .false. - do k=1,3 - AllOut(TipDxc( k)) = .true. - AllOut(TipDyc( k)) = .true. - AllOut(TipDzc( k)) = .true. - AllOut(TipDxb( k)) = .true. - AllOut(TipDyb( k)) = .true. - AllOut(TipALxb( k)) = .true. - AllOut(TipALyb( k)) = .true. - AllOut(TipALzb( k)) = .true. - AllOut(TipRDxb( k)) = .true. - AllOut(TipRDyb( k)) = .true. - AllOut(TipRDzc( k)) = .true. - AllOut(TipClrnc(k)) = .true. - AllOut(PtchPMzc(k)) = .true. - AllOut(RootFxc( k)) = .true. - AllOut(RootFyc( k)) = .true. - AllOut(RootFzc( k)) = .true. - AllOut(RootFxb( k)) = .true. - AllOut(RootFyb( k)) = .true. - AllOut(RootMxc( k)) = .true. - AllOut(RootMyc( k)) = .true. - AllOut(RootMzc( k)) = .true. - AllOut(RootMxb( k)) = .true. - AllOut(RootMyb( k)) = .true. - - do j=1,9 - AllOut(SpnALxb( j,k)) = .true. - AllOut(SpnALyb( j,k)) = .true. - AllOut(SpnALzb( j,k)) = .true. - AllOut(SpnFLxb( j,k)) = .true. - AllOut(SpnFLyb( j,k)) = .true. - AllOut(SpnFLzb( j,k)) = .true. - AllOut(SpnMLxb( j,k)) = .true. - AllOut(SpnMLyb( j,k)) = .true. - AllOut(SpnMLzb( j,k)) = .true. - AllOut(SpnTDxb( j,k)) = .true. - AllOut(SpnTDyb( j,k)) = .true. - AllOut(SpnTDzb( j,k)) = .true. - AllOut(SpnRDxb( j,k)) = .true. - AllOut(SpnRDyb( j,k)) = .true. - AllOut(SpnRDzb( j,k)) = .true. + AllOut = .false. + do k=1,3 + AllOut(TipDxc( k)) = .true. + AllOut(TipDyc( k)) = .true. + AllOut(TipDzc( k)) = .true. + AllOut(TipDxb( k)) = .true. + AllOut(TipDyb( k)) = .true. + AllOut(TipALxb( k)) = .true. + AllOut(TipALyb( k)) = .true. + AllOut(TipALzb( k)) = .true. + AllOut(TipRDxb( k)) = .true. + AllOut(TipRDyb( k)) = .true. + AllOut(TipRDzc( k)) = .true. + AllOut(TipClrnc(k)) = .true. + AllOut(PtchPMzc(k)) = .true. + AllOut(RootFxc( k)) = .true. + AllOut(RootFyc( k)) = .true. + AllOut(RootFzc( k)) = .true. + AllOut(RootFxb( k)) = .true. + AllOut(RootFyb( k)) = .true. + AllOut(RootMxc( k)) = .true. + AllOut(RootMyc( k)) = .true. + AllOut(RootMzc( k)) = .true. + AllOut(RootMxb( k)) = .true. + AllOut(RootMyb( k)) = .true. + + do j=1,9 + AllOut(SpnALxb( j,k)) = .true. + AllOut(SpnALyb( j,k)) = .true. + AllOut(SpnALzb( j,k)) = .true. + AllOut(SpnFLxb( j,k)) = .true. + AllOut(SpnFLyb( j,k)) = .true. + AllOut(SpnFLzb( j,k)) = .true. + AllOut(SpnMLxb( j,k)) = .true. + AllOut(SpnMLyb( j,k)) = .true. + AllOut(SpnMLzb( j,k)) = .true. + AllOut(SpnTDxb( j,k)) = .true. + AllOut(SpnTDyb( j,k)) = .true. + AllOut(SpnTDzb( j,k)) = .true. + AllOut(SpnRDxb( j,k)) = .true. + AllOut(SpnRDyb( j,k)) = .true. + AllOut(SpnRDzb( j,k)) = .true. + end do end do - end do - do i=1,p%NumOuts - InitOut%RotFrame_y(i+index_next) = AllOut( p%OutParam(i)%Indx ) - end do + do i=1,p%NumOuts + InitOut%RotFrame_y(i+index_next) = AllOut( p%OutParam(i)%Indx ) + end do - do i=1, p%BldNd_TotNumOuts - InitOut%RotFrame_y(i+p%NumOuts+index_next) = .true. - end do - - deallocate(AllOut) + do i=1, p%BldNd_TotNumOuts + InitOut%RotFrame_y(i+p%NumOuts+index_next) = .true. + end do + deallocate(AllOut) + end if !.not. p%CompAeroMaps END SUBROUTINE ED_Init_Jacobian_y !---------------------------------------------------------------------------------------------------------------------------------- @@ -10757,17 +11102,26 @@ SUBROUTINE ED_Init_Jacobian_x( p, InitOut, ErrStat, ErrMsg) CHARACTER(*), PARAMETER :: RoutineName = 'ED_Init_Jacobian_x' ! local variables: - INTEGER(IntKi) :: i + INTEGER(IntKi) :: i, indx ErrStat = ErrID_None ErrMsg = "" + if (p%CompAeroMaps) then + p%NActvDOF_Lin = p%DOFs%NActvDOF / p%NumBl ! we have only blade DOFs, and we are going to use only 1 of the blades + p%NActvDOF_Stride = p%NumBl + p%NActvVelDOF_Lin = 0 ! we do NOT have velocity states + else + p%NActvDOF_Lin = p%DOFs%NActvDOF + p%NActvDOF_Stride = 1 + p%NActvVelDOF_Lin = p%NActvDOF_Lin ! we have velocity states + end if ! allocate space for the row/column names and for perturbation sizes - call allocAry(p%dx, p%NDof, 'p%dx', ErrStat2, ErrMsg2); call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AllocAry(InitOut%LinNames_x, p%DOFs%NActvDOF*2, 'LinNames_x', ErrStat2, ErrMsg2); CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AllocAry(InitOut%RotFrame_x, p%DOFs%NActvDOF*2, 'RotFrame_x', ErrStat2, ErrMsg2); CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AllocAry(InitOut%DerivOrder_x, p%DOFs%NActvDOF*2, 'DerivOrder_x', ErrStat2, ErrMsg2); CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call allocAry(p%dx, p%NDof, 'p%dx', ErrStat2, ErrMsg2); call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL AllocAry(InitOut%LinNames_x, p%NActvDOF_Lin + p%NActvVelDOF_Lin,'LinNames_x', ErrStat2, ErrMsg2); CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL AllocAry(InitOut%RotFrame_x, p%NActvDOF_Lin + p%NActvVelDOF_Lin,'RotFrame_x', ErrStat2, ErrMsg2); CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL AllocAry(InitOut%DerivOrder_x, p%NActvDOF_Lin + p%NActvVelDOF_Lin,'DerivOrder_x', ErrStat2, ErrMsg2); CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return ! All Elastodyn continuous states are max order = 2 @@ -10797,26 +11151,33 @@ SUBROUTINE ED_Init_Jacobian_x( p, InitOut, ErrStat, ErrMsg) p%dx(i) = max(p%dx(i), MinPerturb) end do - InitOut%RotFrame_x = .false. - do i=1,p%DOFs%NActvDOF - if ( p%DOFs%PS(i) >= DOF_BF(1,1) ) then - if ( p%NumBl == 2 ) then - InitOut%RotFrame_x(i) = p%DOFs%PS(i) < DOF_Teet - else - InitOut%RotFrame_x(i) = .true. ! = p%DOFs%PS(i) <= DOF_BF (MaxBl,NumBF) + if (p%CompAeroMaps) then + InitOut%RotFrame_x = .true. + else + InitOut%RotFrame_x = .false. + do i=1,p%DOFs%NActvDOF + if ( p%DOFs%PS(i) >= DOF_BF(1,1) ) then + if ( p%NumBl == 2 ) then + InitOut%RotFrame_x(i) = p%DOFs%PS(i) < DOF_Teet + else + InitOut%RotFrame_x(i) = .true. ! = p%DOFs%PS(i) <= DOF_BF (MaxBl,NumBF) + end if end if - end if - end do + end do + end if ! set linearization output names: - do i=1,p%DOFs%NActvDOF - InitOut%LinNames_x(i) = p%DOF_Desc( p%DOFs%PS(i) ) + indx = 0 + do i=1,p%DOFs%NActvDOF,p%NActvDOF_Stride + indx = indx + 1 + InitOut%LinNames_x(indx) = p%DOF_Desc( p%DOFs%PS(i) ) end do - do i=1,p%DOFs%NActvDOF - InitOut%LinNames_x(i+p%DOFs%NActvDOF) = 'First time derivative of '//trim(InitOut%LinNames_x(i))//'/s' - InitOut%RotFrame_x(i+p%DOFs%NActvDOF) = InitOut%RotFrame_x(i) - end do + + do i=1,p%NActvVelDOF_Lin + InitOut%LinNames_x(i+p%NActvDOF_Lin) = 'First time derivative of '//trim(InitOut%LinNames_x(i))//'/s' + InitOut%RotFrame_x(i+p%NActvDOF_Lin) = InitOut%RotFrame_x(i) + end do END SUBROUTINE ED_Init_Jacobian_x !---------------------------------------------------------------------------------------------------------------------------------- @@ -10841,10 +11202,15 @@ SUBROUTINE ED_Init_Jacobian( p, u, y, InitOut, ErrStat, ErrMsg) REAL(R8Ki) :: ScaleLength - ErrStat = ErrID_None ErrMsg = "" - + + if (p%CompAeroMaps) then + p%NumBl_Lin = 1 + else + p%NumBl_Lin = p%NumBl + end if + call ED_Init_Jacobian_y( p, y, InitOut, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -10857,18 +11223,24 @@ SUBROUTINE ED_Init_Jacobian( p, u, y, InitOut, ErrStat, ErrMsg) ! determine how many inputs there are in the Jacobians nu = 0; if (allocated(u%BladePtLoads)) then - do i=1,p%NumBl + do i=1,p%NumBl_Lin nu = nu + u%BladePtLoads(i)%NNodes * 6 ! 3 forces + 3 moments at each node on each blade end do end if - nu = nu & - + u%PlatformPtMesh%NNodes * 6 & ! 3 forces + 3 moments at each node - + u%TowerPtLoads%NNodes * 6 & ! 3 forces + 3 moments at each node - + u%HubPtLoad%NNodes * 6 & ! 3 forces + 3 moments at each node - + u%NacelleLoads%NNodes * 6 & ! 3 forces + 3 moments at each node - + p%NumBl & ! blade pitch command (BlPitchCom) - + 2 ! YawMom and GenTrq - + + if (p%CompAeroMaps) then + p%NumExtendedInputs = 0 + else + nu = nu & + + u%PlatformPtMesh%NNodes * 6 & ! 3 forces + 3 moments at each node + + u%TowerPtLoads%NNodes * 6 & ! 3 forces + 3 moments at each node + + u%HubPtLoad%NNodes * 6 & ! 3 forces + 3 moments at each node + + u%NacelleLoads%NNodes * 6 & ! 3 forces + 3 moments at each node + + u%TFinCMLoads%NNodes * 6 & ! 3 forces + 3 moments at each node + + p%NumBl & ! blade pitch command (BlPitchCom) + + 2 ! YawMom and GenTrq + p%NumExtendedInputs = 1 + end if ! note: all other inputs are ignored !.................... @@ -10889,13 +11261,14 @@ SUBROUTINE ED_Init_Jacobian( p, u, y, InitOut, ErrStat, ErrMsg) index = 1 if (allocated(u%BladePtLoads)) then + p%Jac_u_idxStartList%BladeLoad = index !Module/Mesh/Field: u%BladePtLoads(1)%Force = 1; !Module/Mesh/Field: u%BladePtLoads(1)%Moment = 2; !Module/Mesh/Field: u%BladePtLoads(2)%Force = 3; !Module/Mesh/Field: u%BladePtLoads(2)%Moment = 4; !Module/Mesh/Field: u%BladePtLoads(3)%Force = 5; !Module/Mesh/Field: u%BladePtLoads(3)%Moment = 6; - do k=1,p%NumBl + do k=1,p%NumBl_Lin do i_meshField = 1,2 do i=1,u%BladePtLoads(k)%NNodes @@ -10911,70 +11284,88 @@ SUBROUTINE ED_Init_Jacobian( p, u, y, InitOut, ErrStat, ErrMsg) end do !k end if + + if (.not. p%CompAeroMaps) then + p%Jac_u_idxStartList%PlatformLoad = index + do i_meshField = 7,8 + do i=1,u%PlatformPtMesh%NNodes + do j=1,3 + p%Jac_u_indx(index,1) = i_meshField !Module/Mesh/Field: u%PlatformPtMesh%Force = 7; u%PlatformPtMesh%Moment = 8; + p%Jac_u_indx(index,2) = j !index: j + p%Jac_u_indx(index,3) = i !Node: i + index = index + 1 + end do !j + end do !i + end do + + p%Jac_u_idxStartList%TowerLoad = index + do i_meshField = 9,10 + do i=1,u%TowerPtLoads%NNodes + do j=1,3 + p%Jac_u_indx(index,1) = i_meshField !Module/Mesh/Field: u%TowerPtLoads%Force = 9; u%TowerPtLoads%Moment = 10; + p%Jac_u_indx(index,2) = j !index: j + p%Jac_u_indx(index,3) = i !Node: i + index = index + 1 + end do !j + end do !i + end do + + p%Jac_u_idxStartList%HubLoad = index + do i_meshField = 11,12 + do i=1,u%HubPtLoad%NNodes + do j=1,3 + p%Jac_u_indx(index,1) = i_meshField !Module/Mesh/Field: u%HubPtLoad%Force = 11; u%HubPtLoad%Moment = 12; + p%Jac_u_indx(index,2) = j !index: j + p%Jac_u_indx(index,3) = i !Node: i + index = index + 1 + end do !j + end do !i + end do + + p%Jac_u_idxStartList%NacelleLoad = index + do i_meshField = 13,14 + do i=1,u%NacelleLoads%NNodes + do j=1,3 + p%Jac_u_indx(index,1) = i_meshField !Module/Mesh/Field: u%NacelleLoads%Force = 13; u%NacelleLoads%Moment = 14; + p%Jac_u_indx(index,2) = j !index: j + p%Jac_u_indx(index,3) = i !Node: i + index = index + 1 + end do !j + end do !i + end do + + p%Jac_u_idxStartList%TFinLoad = index + do i_meshField = 15,16 + do i=1,u%TFinCMLoads%NNodes + do j=1,3 + p%Jac_u_indx(index,1) = i_meshField !Module/Mesh/Field: u%TFinCMLoads%Force = 15; u%TFinCMLoads%Moment = 16; + p%Jac_u_indx(index,2) = j !index: j + p%Jac_u_indx(index,3) = i !Node: i + index = index + 1 + end do !j + end do !i + end do - !if MaxBl ever changes (i.e., MaxBl /=3), we need to modify this accordingly: - do i_meshField = 7,8 - do i=1,u%PlatformPtMesh%NNodes - do j=1,3 - p%Jac_u_indx(index,1) = i_meshField !Module/Mesh/Field: u%PlatformPtMesh%Force = 7; u%PlatformPtMesh%Moment = 8; - p%Jac_u_indx(index,2) = j !index: j - p%Jac_u_indx(index,3) = i !Node: i - index = index + 1 - end do !j - end do !i - end do + p%Jac_u_idxStartList%BlPitchCom = index + do i_meshField = 1,p%NumBl ! scalars + p%Jac_u_indx(index,1) = 17 !Module/Mesh/Field: u%BlPitchCom = 17; + p%Jac_u_indx(index,2) = 1 !index: n/a + p%Jac_u_indx(index,3) = i_meshField !Node: blade + index = index + 1 + end do - do i_meshField = 9,10 - do i=1,u%TowerPtLoads%NNodes - do j=1,3 - p%Jac_u_indx(index,1) = i_meshField !Module/Mesh/Field: u%TowerPtLoads%Force = 9; u%TowerPtLoads%Moment = 10; - p%Jac_u_indx(index,2) = j !index: j - p%Jac_u_indx(index,3) = i !Node: i - index = index + 1 - end do !j - end do !i - end do - - do i_meshField = 11,12 - do i=1,u%HubPtLoad%NNodes - do j=1,3 - p%Jac_u_indx(index,1) = i_meshField !Module/Mesh/Field: u%HubPtLoad%Force = 11; u%HubPtLoad%Moment = 12; - p%Jac_u_indx(index,2) = j !index: j - p%Jac_u_indx(index,3) = i !Node: i - index = index + 1 - end do !j - end do !i - end do - - do i_meshField = 13,14 - do i=1,u%NacelleLoads%NNodes - do j=1,3 - p%Jac_u_indx(index,1) = i_meshField !Module/Mesh/Field: u%NacelleLoads%Force = 13; u%NacelleLoads%Moment = 14; - p%Jac_u_indx(index,2) = j !index: j - p%Jac_u_indx(index,3) = i !Node: i - index = index + 1 - end do !j - end do !i - end do - - do i_meshField = 1,p%NumBl ! scalars - p%Jac_u_indx(index,1) = 15 !Module/Mesh/Field: u%BlPitchCom = 15; - p%Jac_u_indx(index,2) = 1 !index: n/a - p%Jac_u_indx(index,3) = i_meshField !Node: blade - index = index + 1 - end do - - do i_meshField = 16,17 ! scalars - p%Jac_u_indx(index,1) = i_meshField !Module/Mesh/Field: u%YawMom = 16; u%GenTrq = 17; - p%Jac_u_indx(index,2) = 1 !index: j - p%Jac_u_indx(index,3) = 1 !Node: i - index = index + 1 - end do + do i_meshField = 18,19 ! scalars + p%Jac_u_indx(index,1) = i_meshField !Module/Mesh/Field: u%YawMom = 18; u%GenTrq = 19; + p%Jac_u_indx(index,2) = 1 !index: j + p%Jac_u_indx(index,3) = 1 !Node: i + index = index + 1 + end do + end if ! .not. p%CompAeroMaps !................ ! input perturbations, du: !................ - call AllocAry(p%du, 17, 'p%du', ErrStat2, ErrMsg2) ! 17 = number of unique values in p%Jac_u_indx(:,1) + call AllocAry(p%du, 19, 'p%du', ErrStat2, ErrMsg2) ! 19 = number of unique values in p%Jac_u_indx(:,1) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return @@ -11000,9 +11391,11 @@ SUBROUTINE ED_Init_Jacobian( p, u, y, InitOut, ErrStat, ErrMsg) p%du(12) = MaxTorque / 100.0_R8Ki ! u%HubPtLoad%Moment = 12 p%du(13) = MaxThrust / 100.0_R8Ki ! u%NacelleLoads%Force = 13 p%du(14) = MaxTorque / 100.0_R8Ki ! u%NacelleLoads%Moment = 14 - p%du(15) = 2.0_R8Ki * D2R_D ! u%BlPitchCom = 15 - p%du(16) = MaxTorque / 100.0_R8Ki ! u%YawMom = 16 - p%du(17) = MaxTorque / (100.0_R8Ki*p%GBRatio) ! u%GenTrq = 17 + p%du(15) = MaxThrust / 100.0_R8Ki ! u%TFinCMLoads%Force = 15 + p%du(16) = MaxTorque / 100.0_R8Ki ! u%TFinCMLoads%Moment = 16 + p%du(17) = 2.0_R8Ki * D2R_D ! u%BlPitchCom = 17 + p%du(18) = MaxTorque / 100.0_R8Ki ! u%YawMom = 18 + p%du(19) = MaxTorque / (100.0_R8Ki*p%GBRatio) ! u%GenTrq = 19 !Set some limits in case perturbation is very small do i=1,size(p%du) @@ -11012,9 +11405,9 @@ SUBROUTINE ED_Init_Jacobian( p, u, y, InitOut, ErrStat, ErrMsg) !................ ! names of the columns, InitOut%LinNames_u: !................ - call AllocAry(InitOut%LinNames_u, nu+1, 'LinNames_u', ErrStat2, ErrMsg2); call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call AllocAry(InitOut%RotFrame_u, nu+1, 'RotFrame_u', ErrStat2, ErrMsg2); call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call AllocAry(InitOut%IsLoad_u, nu+1, 'IsLoad_u', ErrStat2, ErrMsg2); call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AllocAry(InitOut%LinNames_u, nu+p%NumExtendedInputs, 'LinNames_u', ErrStat2, ErrMsg2); call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AllocAry(InitOut%RotFrame_u, nu+p%NumExtendedInputs, 'RotFrame_u', ErrStat2, ErrMsg2); call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AllocAry(InitOut%IsLoad_u, nu+p%NumExtendedInputs, 'IsLoad_u', ErrStat2, ErrMsg2); call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return InitOut%IsLoad_u = .true. ! most of ED's inputs are loads; we will override the non-load inputs below. @@ -11022,27 +11415,30 @@ SUBROUTINE ED_Init_Jacobian( p, u, y, InitOut, ErrStat, ErrMsg) index = 1 if (allocated(u%BladePtLoads)) then index_last = index - do k=1,p%NumBl + do k=1,p%NumBl_Lin call PackLoadMesh_Names(u%BladePtLoads(k), 'Blade '//trim(num2lstr(k)), InitOut%LinNames_u, index) end do !InitOut%RotFrame_u(index_last:index-1) = .true. ! values on the mesh are in global, not rotating frame end if - call PackLoadMesh_Names(u%PlatformPtMesh, 'Platform', InitOut%LinNames_u, index) - call PackLoadMesh_Names(u%TowerPtLoads, 'Tower', InitOut%LinNames_u, index) - call PackLoadMesh_Names(u%HubPtLoad, 'Hub', InitOut%LinNames_u, index) - call PackLoadMesh_Names(u%NacelleLoads, 'Nacelle', InitOut%LinNames_u, index) + if (.not. p%CompAeroMaps) then + call PackLoadMesh_Names(u%PlatformPtMesh, 'Platform', InitOut%LinNames_u, index) + call PackLoadMesh_Names(u%TowerPtLoads, 'Tower', InitOut%LinNames_u, index) + call PackLoadMesh_Names(u%HubPtLoad, 'Hub', InitOut%LinNames_u, index) + call PackLoadMesh_Names(u%NacelleLoads, 'Nacelle', InitOut%LinNames_u, index) + call PackLoadMesh_Names(u%TFinCMLoads, 'Tailfin', InitOut%LinNames_u, index) - do k = 1,p%NumBl ! scalars - InitOut%LinNames_u(index) = 'Blade '//trim(num2lstr(k))//' pitch command, rad' - InitOut%IsLoad_u( index) = .false. - InitOut%RotFrame_u(index) = .true. - index = index + 1 - end do + do k = 1,p%NumBl ! scalars + InitOut%LinNames_u(index) = 'Blade '//trim(num2lstr(k))//' pitch command, rad' + InitOut%IsLoad_u( index) = .false. + InitOut%RotFrame_u(index) = .true. + index = index + 1 + end do - InitOut%LinNames_u(index) = 'Yaw moment, Nm' ; index = index + 1 - InitOut%LinNames_u(index) = 'Generator torque, Nm' ; index = index + 1 - InitOut%LinNames_u(index) = 'Extended input: collective blade-pitch command, rad' - InitOut%IsLoad_u( index) = .false. + InitOut%LinNames_u(index) = 'Yaw moment, Nm' ; index = index + 1 + InitOut%LinNames_u(index) = 'Generator torque, Nm' ; index = index + 1 + InitOut%LinNames_u(index) = 'Extended input: collective blade-pitch command, rad' + InitOut%IsLoad_u( index) = .false. + end if END SUBROUTINE ED_Init_Jacobian !---------------------------------------------------------------------------------------------------------------------------------- @@ -11070,45 +11466,57 @@ SUBROUTINE ED_Perturb_u( p, n, perturb_sign, u, du ) ! 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%BladePtLoads(1)%Force = 1 - u%BladePtLoads(1)%Force( fieldIndx,node) = u%BladePtLoads(1)%Force( fieldIndx,node) + du * perturb_sign - CASE ( 2) !Module/Mesh/Field: u%BladePtLoads(1)%Moment = 2 - u%BladePtLoads(1)%Moment(fieldIndx,node) = u%BladePtLoads(1)%Moment(fieldIndx,node) + du * perturb_sign - CASE ( 3) !Module/Mesh/Field: u%BladePtLoads(2)%Force = 3 - u%BladePtLoads(2)%Force( fieldIndx,node) = u%BladePtLoads(2)%Force( fieldIndx,node) + du * perturb_sign - CASE ( 4) !Module/Mesh/Field: u%BladePtLoads(2)%Moment = 4 - u%BladePtLoads(2)%Moment(fieldIndx,node) = u%BladePtLoads(2)%Moment(fieldIndx,node) + du * perturb_sign - CASE ( 5) !Module/Mesh/Field: u%BladePtLoads(2)%Force = 5 - u%BladePtLoads(3)%Force( fieldIndx,node) = u%BladePtLoads(3)%Force( fieldIndx,node) + du * perturb_sign - CASE ( 6) !Module/Mesh/Field: u%BladePtLoads(2)%Moment = 6 - u%BladePtLoads(3)%Moment(fieldIndx,node) = u%BladePtLoads(3)%Moment(fieldIndx,node) + du * perturb_sign - - CASE ( 7) !Module/Mesh/Field: u%PlatformPtMesh%Force = 7 - u%PlatformPtMesh%Force( fieldIndx,node) = u%PlatformPtMesh%Force( fieldIndx,node) + du * perturb_sign - CASE ( 8) !Module/Mesh/Field: u%PlatformPtMesh%Moment = 8 - u%PlatformPtMesh%Moment(fieldIndx,node) = u%PlatformPtMesh%Moment(fieldIndx,node) + du * perturb_sign + ! BladePtLoads + ! Module/Mesh/Field: u%BladePtLoads(1)%Force = 1 + ! Module/Mesh/Field: u%BladePtLoads(1)%Moment = 2 + ! Module/Mesh/Field: u%BladePtLoads(2)%Force = 3 + ! Module/Mesh/Field: u%BladePtLoads(2)%Moment = 4 + ! Module/Mesh/Field: u%BladePtLoads(3)%Force = 5 + ! Module/Mesh/Field: u%BladePtLoads(3)%Moment = 6 + CASE ( 1); u%BladePtLoads(1)%Force( fieldIndx,node) = u%BladePtLoads(1)%Force( fieldIndx,node) + du * perturb_sign + CASE ( 2); u%BladePtLoads(1)%Moment(fieldIndx,node) = u%BladePtLoads(1)%Moment(fieldIndx,node) + du * perturb_sign + CASE ( 3); u%BladePtLoads(2)%Force( fieldIndx,node) = u%BladePtLoads(2)%Force( fieldIndx,node) + du * perturb_sign + CASE ( 4); u%BladePtLoads(2)%Moment(fieldIndx,node) = u%BladePtLoads(2)%Moment(fieldIndx,node) + du * perturb_sign + CASE ( 5); u%BladePtLoads(3)%Force( fieldIndx,node) = u%BladePtLoads(3)%Force( fieldIndx,node) + du * perturb_sign + CASE ( 6); u%BladePtLoads(3)%Moment(fieldIndx,node) = u%BladePtLoads(3)%Moment(fieldIndx,node) + du * perturb_sign + + ! PlatformPtMesh + ! Module/Mesh/Field: u%PlatformPtMesh%Force = 7 + ! Module/Mesh/Field: u%PlatformPtMesh%Moment = 8 + CASE ( 7); u%PlatformPtMesh%Force( fieldIndx,node) = u%PlatformPtMesh%Force( fieldIndx,node) + du * perturb_sign + CASE ( 8); u%PlatformPtMesh%Moment(fieldIndx,node) = u%PlatformPtMesh%Moment(fieldIndx,node) + du * perturb_sign - CASE ( 9) !Module/Mesh/Field: u%TowerPtLoads%Force = 9 - u%TowerPtLoads%Force( fieldIndx,node) = u%TowerPtLoads%Force( fieldIndx,node) + du * perturb_sign - CASE (10) !Module/Mesh/Field: u%TowerPtLoads%Moment = 10 - u%TowerPtLoads%Moment(fieldIndx,node) = u%TowerPtLoads%Moment(fieldIndx,node) + du * perturb_sign - - CASE (11) !Module/Mesh/Field: u%HubPtLoad%Force = 11 - u%HubPtLoad%Force( fieldIndx,node) = u%HubPtLoad%Force( fieldIndx,node) + du * perturb_sign - CASE (12) !Module/Mesh/Field: u%HubPtLoad%Moment = 12 - u%HubPtLoad%Moment(fieldIndx,node) = u%HubPtLoad%Moment(fieldIndx,node) + du * perturb_sign - - CASE (13) !Module/Mesh/Field: u%NacelleLoads%Force = 13 - u%NacelleLoads%Force( fieldIndx,node) = u%NacelleLoads%Force( fieldIndx,node) + du * perturb_sign - CASE (14) !Module/Mesh/Field: u%NacelleLoads%Moment = 14 - u%NacelleLoads%Moment(fieldIndx,node) = u%NacelleLoads%Moment(fieldIndx,node) + du * perturb_sign - - CASE (15) !Module/Mesh/Field: u%BlPitchCom = 15 - u%BlPitchCom(node) = u%BlPitchCom(node) + du * perturb_sign - CASE (16) !Module/Mesh/Field: u%YawMom = 16 - u%YawMom = u%YawMom + du * perturb_sign - CASE (17) !Module/Mesh/Field: u%GenTrq = 17 - u%GenTrq = u%GenTrq + du * perturb_sign + ! TowerPtLoads + ! Module/Mesh/Field: u%TowerPtLoads%Force = 9 + ! Module/Mesh/Field: u%TowerPtLoads%Moment = 10 + CASE ( 9); u%TowerPtLoads%Force( fieldIndx,node) = u%TowerPtLoads%Force( fieldIndx,node) + du * perturb_sign + CASE (10); u%TowerPtLoads%Moment(fieldIndx,node) = u%TowerPtLoads%Moment(fieldIndx,node) + du * perturb_sign + + ! HubPtLoad + ! Module/Mesh/Field: u%HubPtLoad%Force = 11 + ! Module/Mesh/Field: u%HubPtLoad%Moment = 12 + CASE (11); u%HubPtLoad%Force( fieldIndx,node) = u%HubPtLoad%Force( fieldIndx,node) + du * perturb_sign + CASE (12); u%HubPtLoad%Moment(fieldIndx,node) = u%HubPtLoad%Moment(fieldIndx,node) + du * perturb_sign + + ! NacelleLoads + ! Module/Mesh/Field: u%NacelleLoads%Force = 13 + ! Module/Mesh/Field: u%NacelleLoads%Moment = 14 + CASE (13); u%NacelleLoads%Force( fieldIndx,node) = u%NacelleLoads%Force( fieldIndx,node) + du * perturb_sign + CASE (14); u%NacelleLoads%Moment(fieldIndx,node) = u%NacelleLoads%Moment(fieldIndx,node) + du * perturb_sign + + ! TFinCMLoads + ! Module/Mesh/Field: u%TFinCMLoads%Force = 15 + ! Module/Mesh/Field: u%TFinCMLoads%Moment = 16 + CASE (15); u%TFinCMLoads%Force( fieldIndx,node) = u%TFinCMLoads%Force( fieldIndx,node) + du * perturb_sign + CASE (16); u%TFinCMLoads%Moment(fieldIndx,node) = u%TFinCMLoads%Moment(fieldIndx,node) + du * perturb_sign + + ! Controller inputs + ! Module/Mesh/Field: u%BlPitchCom = 17 + ! Module/Mesh/Field: u%YawMom = 18 + ! Module/Mesh/Field: u%GenTrq = 19 + CASE (17); u%BlPitchCom(node) = u%BlPitchCom(node) + du * perturb_sign + CASE (18); u%YawMom = u%YawMom + du * perturb_sign + CASE (19); u%GenTrq = u%GenTrq + du * perturb_sign END SELECT @@ -11116,10 +11524,10 @@ END SUBROUTINE ED_Perturb_u !---------------------------------------------------------------------------------------------------------------------------------- !> This routine perturbs the nth element of the continuous state array. !! Do not change this without making sure subroutine elastodyn::ed_init_jacobian is consistant with this routine! -SUBROUTINE ED_Perturb_x( p, n, perturb_sign, x, dx ) +SUBROUTINE ED_Perturb_x( p, n_in, perturb_sign, x, dx ) TYPE(ED_ParameterType) , INTENT(IN ) :: p !< parameters - INTEGER( IntKi ) , INTENT(IN ) :: n !< number of array element to use + INTEGER( IntKi ) , INTENT(IN ) :: n_in !< 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(ED_ContinuousStateType) , INTENT(INOUT) :: x !< perturbed ED states REAL( R8Ki ) , INTENT( OUT) :: dx !< amount that specific state was perturbed @@ -11127,14 +11535,19 @@ SUBROUTINE ED_Perturb_x( p, n, perturb_sign, x, dx ) ! local variables integer(intKi) :: indx + integer(intKi) :: n + n = (n_in - 1) * p%NActvDOF_Stride + 1 if (n > p%DOFs%NActvDOF) then + indx = p%DOFs%PS(n-p%DOFs%NActvDOF) dx = p%dx( indx ) - x%QDT( indx ) = x%QDT( indx ) + dx * perturb_sign + x%QDT( indx ) = x%QDT( indx ) + dx * perturb_sign + else + indx = p%DOFs%PS(n) dx = p%dx( indx ) @@ -11159,40 +11572,88 @@ SUBROUTINE Compute_dY(p, y_p, y_m, delta, dY) LOGICAL :: Mask(FIELDMASK_SIZE) ! flags to determine if this field is part of the packing - Mask = .false. - Mask(MASKID_TRANSLATIONDISP) = .true. - Mask(MASKID_ORIENTATION) = .true. - Mask(MASKID_ROTATIONVEL) = .true. - - - indx_first = 1 + indx_first = 1 if (allocated(y_p%BladeLn2Mesh)) then - do k=1,p%NumBl - call PackMotionMesh_dY(y_p%BladeLn2Mesh(k), y_m%BladeLn2Mesh(k), dY, indx_first) - end do + Mask = .true. + if (p%CompAeroMaps) then + Mask(MASKID_TRANSLATIONACC) = .false. + Mask(MASKID_ROTATIONACC) = .false. + end if + + do k=1,p%NumBl_Lin + call PackMotionMesh_dY(y_p%BladeLn2Mesh(k), y_m%BladeLn2Mesh(k), dY, indx_first, FieldMask=Mask) + end do end if - call PackMotionMesh_dY(y_p%PlatformPtMesh, y_m%PlatformPtMesh, dY, indx_first, UseSmlAngle=.true.) - call PackMotionMesh_dY(y_p%TowerLn2Mesh, y_m%TowerLn2Mesh, dY, indx_first, UseSmlAngle=.true.) - call PackMotionMesh_dY(y_p%HubPtMotion, y_m%HubPtMotion, dY, indx_first, FieldMask=Mask) - do k=1,p%NumBl - call PackMotionMesh_dY(y_p%BladeRootMotion(k), y_m%BladeRootMotion(k), dY, indx_first) - end do - call PackMotionMesh_dY(y_p%NacelleMotion, y_m%NacelleMotion, dY, indx_first) + if (.not. p%CompAeroMaps) then + call PackMotionMesh_dY(y_p%PlatformPtMesh, y_m%PlatformPtMesh, dY, indx_first, UseSmlAngle=.false.) ! all fields + call PackMotionMesh_dY(y_p%TowerLn2Mesh, y_m%TowerLn2Mesh, dY, indx_first, UseSmlAngle=.false.) ! all fields + + Mask = .false. + Mask(MASKID_TRANSLATIONDISP) = .true. + Mask(MASKID_ORIENTATION) = .true. + Mask(MASKID_ROTATIONVEL) = .true. + call PackMotionMesh_dY(y_p%HubPtMotion, y_m%HubPtMotion, dY, indx_first, FieldMask=Mask) + + do k=1,p%NumBl_Lin + call PackMotionMesh_dY(y_p%BladeRootMotion(k), y_m%BladeRootMotion(k), dY, indx_first) + end do + call PackMotionMesh_dY(y_p%NacelleMotion, y_m%NacelleMotion, dY, indx_first) + + Mask = .false. + Mask(MASKID_TRANSLATIONDISP) = .true. + Mask(MASKID_ORIENTATION) = .true. + Mask(MASKID_TRANSLATIONVEL) = .true. + Mask(MASKID_ROTATIONVEL) = .true. + call PackMotionMesh_dY(y_p%TFinCMMotion, y_m%TFinCMMotion, dY, indx_first, FieldMask=Mask) - dY(indx_first) = y_p%Yaw - y_m%Yaw; indx_first = indx_first + 1 - dY(indx_first) = y_p%YawRate - y_m%YawRate; indx_first = indx_first + 1 - dY(indx_first) = y_p%HSS_Spd - y_m%HSS_Spd; indx_first = indx_first + 1 + dY(indx_first) = y_p%Yaw - y_m%Yaw; indx_first = indx_first + 1 + dY(indx_first) = y_p%YawRate - y_m%YawRate; indx_first = indx_first + 1 + dY(indx_first) = y_p%HSS_Spd - y_m%HSS_Spd; indx_first = indx_first + 1 - !indx_last = indx_first + p%NumOuts - 1 - do k=1,p%NumOuts + p%BldNd_TotNumOuts - dY(k+indx_first-1) = y_p%WriteOutput(k) - y_m%WriteOutput(k) - end do + !indx_last = indx_first + p%NumOuts - 1 + do k=1,p%NumOuts + p%BldNd_TotNumOuts + dY(k+indx_first-1) = y_p%WriteOutput(k) - y_m%WriteOutput(k) + end do + end if dY = dY / (2.0_R8Ki*delta) END SUBROUTINE Compute_dY !---------------------------------------------------------------------------------------------------------------------------------- +!> This routine uses values of two continuous state types to compute an array of differences. +!! Do not change this packing without making sure subroutine elastodyn::init_jacobian is consistant with this routine! +SUBROUTINE Compute_dX(p, x_p, x_m, delta, dX) + + TYPE(ED_ParameterType) , INTENT(IN ) :: p !< parameters + TYPE(ED_ContinuousStateType) , INTENT(IN ) :: x_p !< ED continuous states at \f$ u + \Delta_p u \f$ or \f$ x + \Delta_p x \f$ (p=plus) + TYPE(ED_ContinuousStateType) , INTENT(IN ) :: x_m !< ED 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 = \Delta u \f$ or \f$ delta = \Delta_p x \f$ + REAL(R8Ki) , INTENT(INOUT) :: dX(:) !< column of dXdu or dXdx: \f$ \frac{\partial Y}{\partial u_i} = \frac{y_p - y_m}{2 \, \Delta u}\f$ or \f$ \frac{\partial Y}{\partial x_i} = \frac{y_p - y_m}{2 \, \Delta x}\f$ + + ! local variables: + INTEGER(IntKi) :: i ! loop over blade nodes + INTEGER(IntKi) :: j ! loop over blades + INTEGER(IntKi) :: indx_first ! index indicating next value of dY to be filled + + indx_first = 0 + + if (p%NActvVelDOF_Lin > 0) then + do j=1,p%DOFs%NActvDOF, p%NActvDOF_Stride ! Loop through all active (enabled) DOFs for linearization + indx_first = indx_first + 1 + dX(indx_first) = x_p%QT( p%DOFs%PS(j) ) - x_m%QT( p%DOFs%PS(j) ) + end do + end if + + do j=1,p%DOFs%NActvDOF, p%NActvDOF_Stride ! Loop through all active (enabled) DOFs for linearization + indx_first = indx_first + 1 + dX(indx_first) = x_p%QDT( p%DOFs%PS(j) ) - x_m%QDT( p%DOFs%PS(j) ) + end do + + dX = dX / (2*delta) ! whole array operation + +END SUBROUTINE Compute_dX +!---------------------------------------------------------------------------------------------------------------------------------- !> Routine to pack the data structures representing the operating points into arrays for linearization. SUBROUTINE ED_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, y_op, x_op, dx_op, xd_op, z_op, NeedTrimOP ) @@ -11231,43 +11692,46 @@ SUBROUTINE ED_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, ErrStat = ErrID_None ErrMsg = '' - + !.................................. IF ( PRESENT( u_op ) ) THEN if (.not. allocated(u_op)) then - call AllocAry(u_op, size(p%Jac_u_indx,1)+1,'u_op',ErrStat2,ErrMsg2) ! +1 for extended input here + call AllocAry(u_op, size(p%Jac_u_indx,1)+p%NumExtendedInputs,'u_op',ErrStat2,ErrMsg2) ! +1 for extended input here call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) if (ErrStat>=AbortErrLev) return end if index = 1 if (allocated(u%BladePtLoads)) then - do k=1,p%NumBl + do k=1,p%NumBl_Lin call PackLoadMesh(u%BladePtLoads(k), u_op, index) end do end if - call PackLoadMesh(u%PlatformPtMesh, u_op, index) - call PackLoadMesh(u%TowerPtLoads, u_op, index) - call PackLoadMesh(u%HubPtLoad, u_op, index) - call PackLoadMesh(u%NacelleLoads, u_op, index) - - do k = 1,p%NumBl ! scalars - u_op(index) = u%BlPitchCom(k) - index = index + 1 - end do - u_op(index) = u%YawMom ; index = index + 1 - u_op(index) = u%GenTrq ; index = index + 1 - - ! extended input: - u_op(index) = u%BlPitchCom(1) - - do k = 2,p%NumBl - if (.not. EqualRealNos( u%BlPitchCom(1), u%BlPitchCom(k) ) ) then - call SetErrStat(ErrID_Info,"Operating point of collective pitch extended input is invalid because "// & - "the commanded blade pitch angles are not the same for each blade.", ErrStat, ErrMsg, RoutineName) - exit - end if - end do + if (.not. p%CompAeroMaps) then + call PackLoadMesh(u%PlatformPtMesh, u_op, index) + call PackLoadMesh(u%TowerPtLoads, u_op, index) + call PackLoadMesh(u%HubPtLoad, u_op, index) + call PackLoadMesh(u%NacelleLoads, u_op, index) + call PackLoadMesh(u%TFinCMLoads, u_op, index) + + do k = 1,p%NumBl_Lin ! scalars + u_op(index) = u%BlPitchCom(k) + index = index + 1 + end do + u_op(index) = u%YawMom ; index = index + 1 + u_op(index) = u%GenTrq ; index = index + 1 + + ! extended input: ! note this happens only if .not. p%CompAeroMaps, so p%NumExtendedInputs > 0 + u_op(index) = u%BlPitchCom(1) + + do k = 2,p%NumBl_Lin + if (.not. EqualRealNos( u%BlPitchCom(1), u%BlPitchCom(k) ) ) then + call SetErrStat(ErrID_Info,"Operating point of collective pitch extended input is invalid because "// & + "the commanded blade pitch angles are not the same for each blade.", ErrStat, ErrMsg, RoutineName) + exit + end if + end do + end if END IF @@ -11281,20 +11745,27 @@ SUBROUTINE ED_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, if (.not. allocated(y_op)) then ! our operating point includes DCM (orientation) matrices, not just small angles like the perturbation matrices do - ny = p%Jac_ny + y%PlatformPtMesh%NNodes * 6 & ! Jac_ny has 3 for Orientation, but we need 9 at each node + if (p%CompAeroMaps) then + ny = p%Jac_ny + else + ny = p%Jac_ny + y%PlatformPtMesh%NNodes * 6 & ! Jac_ny has 3 for Orientation, but we need 9 at each node + y%TowerLn2Mesh%NNodes * 6 & ! Jac_ny has 3 for Orientation, but we need 9 at each node + y%HubPtMotion%NNodes * 6 & ! Jac_ny has 3 for Orientation, but we need 9 at each node - + y%NacelleMotion%NNodes * 6 ! Jac_ny has 3 for Orientation, but we need 9 at each node - + + y%NacelleMotion%NNodes * 6 & ! Jac_ny has 3 for Orientation, but we need 9 at each node + + y%TFinCMMotion%NNodes * 6 ! Jac_ny has 3 for Orientation, but we need 9 at each node + + do k=1,p%NumBl_Lin + ny = ny + y%BladeRootMotion(k)%NNodes * 6 ! Jac_ny has 3 for Orientation, but we need 9 at each node on each blade + end do + + end if + if (allocated(y%BladeLn2Mesh)) then - do k=1,p%NumBl + do k=1,p%NumBl_Lin ny = ny + y%BladeLn2Mesh(k)%NNodes * 6 ! Jac_ny has 3 for Orientation, but we need 9 (at each node on each blade) end do end if - do k=1,p%NumBl - ny = ny + y%BladeRootMotion(k)%NNodes * 6 ! Jac_ny has 3 for Orientation, but we need 9 at each node on each blade - end do - + call AllocAry(y_op, ny,'y_op',ErrStat2,ErrMsg2) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) if (ErrStat>=AbortErrLev) return @@ -11303,33 +11774,52 @@ SUBROUTINE ED_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, if (ReturnTrimOP) y_op = 0.0_ReKi ! initialize in case we are returning packed orientations and don't fill the entire array - Mask = .false. - Mask(MASKID_TRANSLATIONDISP) = .true. - Mask(MASKID_ORIENTATION) = .true. - Mask(MASKID_ROTATIONVEL) = .true. - + if ( p%CompAeroMaps ) then + Mask = .false. + Mask(MASKID_TRANSLATIONDISP) = .true. + Mask(MASKID_ORIENTATION) = .true. + Mask(MASKID_TRANSLATIONVEL) = .true. + Mask(MASKID_ROTATIONVEL) = .true. + else + Mask = .true. + end if + index = 1 if (allocated(y%BladeLn2Mesh)) then - do k=1,p%NumBl - call PackMotionMesh(y%BladeLn2Mesh(k), y_op, index, TrimOP=ReturnTrimOP) + do k=1,p%NumBl_Lin + call PackMotionMesh(y%BladeLn2Mesh(k), y_op, index, FieldMask=Mask, TrimOP=ReturnTrimOP) end do end if - call PackMotionMesh(y%PlatformPtMesh, y_op, index, TrimOP=ReturnTrimOP) - call PackMotionMesh(y%TowerLn2Mesh, y_op, index, TrimOP=ReturnTrimOP) - call PackMotionMesh(y%HubPtMotion, y_op, index, FieldMask=Mask, TrimOP=ReturnTrimOP) - - do k=1,p%NumBl - call PackMotionMesh(y%BladeRootMotion(k), y_op, index, TrimOP=ReturnTrimOP) - end do - call PackMotionMesh(y%NacelleMotion, y_op, index, TrimOP=ReturnTrimOP) - - y_op(index) = y%Yaw ; index = index + 1 - y_op(index) = y%YawRate ; index = index + 1 - y_op(index) = y%HSS_Spd - - do i=1,p%NumOuts + p%BldNd_TotNumOuts - y_op(i+index) = y%WriteOutput(i) - end do + if (.not. p%CompAeroMaps) then + call PackMotionMesh(y%PlatformPtMesh, y_op, index, TrimOP=ReturnTrimOP) + call PackMotionMesh(y%TowerLn2Mesh, y_op, index, TrimOP=ReturnTrimOP) + + Mask = .false. + Mask(MASKID_TRANSLATIONDISP) = .true. + Mask(MASKID_ORIENTATION) = .true. + Mask(MASKID_ROTATIONVEL) = .true. + call PackMotionMesh(y%HubPtMotion, y_op, index, FieldMask=Mask, TrimOP=ReturnTrimOP) + + do k=1,p%NumBl_Lin + call PackMotionMesh(y%BladeRootMotion(k), y_op, index, TrimOP=ReturnTrimOP) + end do + call PackMotionMesh(y%NacelleMotion, y_op, index, TrimOP=ReturnTrimOP) + + Mask = .false. + Mask(MASKID_TRANSLATIONDISP) = .true. + Mask(MASKID_ORIENTATION) = .true. + Mask(MASKID_TRANSLATIONVEL) = .true. + Mask(MASKID_ROTATIONVEL) = .true. + call PackMotionMesh(y%TFinCMMotion, y_op, index, FieldMask=Mask, TrimOP=ReturnTrimOP) + + y_op(index) = y%Yaw ; index = index + 1 + y_op(index) = y%YawRate ; index = index + 1 + y_op(index) = y%HSS_Spd + + do i=1,p%NumOuts + p%BldNd_TotNumOuts + y_op(i+index) = y%WriteOutput(i) + end do + end if END IF @@ -11337,17 +11827,23 @@ SUBROUTINE ED_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, IF ( PRESENT( x_op ) ) THEN if (.not. allocated(x_op)) then - call AllocAry(x_op, p%DOFs%NActvDOF * 2,'x_op',ErrStat2,ErrMsg2) + call AllocAry(x_op, p%NActvDOF_Lin + p%NActvVelDOF_Lin,'x_op',ErrStat2,ErrMsg2) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) if (ErrStat>=AbortErrLev) return end if - do i=1,p%DOFs%NActvDOF ! Loop through all active (enabled) DOFs - x_op(i) = x%QT( p%DOFs%PS(i) ) + index = 0 + do i=1,p%DOFs%NActvDOF,p%NActvDOF_Stride ! Loop through all active (enabled) DOFs in the Jacobian + index = index + 1 + x_op(index) = x%QT( p%DOFs%PS(i) ) end do - do i=1,p%DOFs%NActvDOF ! Loop through all active (enabled) DOFs - x_op(i+p%DOFs%NActvDOF) = x%QDT( p%DOFs%PS(i) ) - end do + + if (p%NActvVelDOF_Lin > 0) then ! .not. p%CompAeroMaps + do i=1,p%DOFs%NActvDOF,p%NActvDOF_Stride ! Loop through all active (enabled) DOFs in the Jacobian + index = index + 1 + x_op(index) = x%QDT( p%DOFs%PS(i) ) + end do + end if END IF @@ -11355,7 +11851,7 @@ SUBROUTINE ED_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, IF ( PRESENT( dx_op ) ) THEN if (.not. allocated(dx_op)) then - call AllocAry(dx_op, p%DOFs%NActvDOF * 2,'dx_op',ErrStat2,ErrMsg2) + call AllocAry(dx_op, p%NActvDOF_Lin + p%NActvVelDOF_Lin,'dx_op',ErrStat2,ErrMsg2) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) if (ErrStat>=AbortErrLev) return end if @@ -11367,12 +11863,18 @@ SUBROUTINE ED_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, return end if - do i=1,p%DOFs%NActvDOF ! Loop through all active (enabled) DOFs - dx_op(i) = dx%QT( p%DOFs%PS(i) ) + index = 0 + if (p%NActvVelDOF_Lin > 0) then ! p%CompAeroMaps + do i=1,p%DOFs%NActvDOF,p%NActvDOF_Stride ! Loop through all active (enabled) DOFs in the Jacobian + index = index + 1 + dx_op(index) = dx%QT( p%DOFs%PS(i) ) + end do + end if + + do i=1,p%DOFs%NActvDOF,p%NActvDOF_Stride ! Loop through all active (enabled) DOFs in the Jacobian + index = index + 1 + dx_op(index) = dx%QDT( p%DOFs%PS(i) ) end do - do i=1,p%DOFs%NActvDOF ! Loop through all active (enabled) DOFs - dx_op(i+p%DOFs%NActvDOF) = dx%QDT( p%DOFs%PS(i) ) - end do call ED_DestroyContState( dx, ErrStat2, ErrMsg2) diff --git a/modules/elastodyn/src/ElastoDyn_AllBldNdOuts_IO.f90 b/modules/elastodyn/src/ElastoDyn_AllBldNdOuts_IO.f90 index adbbd13201..2bc7764364 100644 --- a/modules/elastodyn/src/ElastoDyn_AllBldNdOuts_IO.f90 +++ b/modules/elastodyn/src/ElastoDyn_AllBldNdOuts_IO.f90 @@ -482,9 +482,11 @@ SUBROUTINE AllBldNdOuts_SetParameters( p, InputFileData, ErrStat, ErrMsg ) ErrMsg = "" ! Check if the requested blades exist - IF ( (InputFileData%BldNd_BladesOut < 0_IntKi) .OR. (InputFileData%BldNd_BladesOut > p%NumBl) ) THEN - CALL SetErrStat( ErrID_Warn, " Number of blades to output data at all bladed nodes (BldNd_BladesOut) must be between 0 and "//TRIM(Num2LStr(p%NumBl))//".", ErrStat, ErrMsg, RoutineName) + IF ( (InputFileData%BldNd_BladesOut < 0_IntKi) ) THEN p%BldNd_BladesOut = 0_IntKi + ELSE IF ((InputFileData%BldNd_BladesOut > p%NumBl) ) THEN + CALL SetErrStat( ErrID_Warn, " Number of blades to output data at all blade nodes (BldNd_BladesOut) must be less than "//TRIM(Num2LStr(p%NumBl))//".", ErrStat, ErrMsg, RoutineName) + p%BldNd_BladesOut = p%NumBl ! NOTE: we are forgiving and plateau to numBlades ELSE p%BldNd_BladesOut = InputFileData%BldNd_BladesOut ENDIF @@ -503,6 +505,7 @@ SUBROUTINE AllBldNdOuts_SetParameters( p, InputFileData, ErrStat, ErrMsg ) ELSE p%BldNd_NumOuts = InputFileData%BldNd_NumOuts ENDIF + if (p%BldNd_BladesOut==0) p%BldNd_NumOuts = 0 ! Set the total number of outputs ( requested channel groups * number requested nodes * number requested blades ) p%BldNd_TotNumOuts = p%BldNodes*p%BldNd_BladesOut*p%BldNd_NumOuts !p%BldNd_NumOuts * size(p%BldNd_BlOutNd) * size(p%BldNd_BladesOut) diff --git a/modules/elastodyn/src/ElastoDyn_IO.f90 b/modules/elastodyn/src/ElastoDyn_IO.f90 index 6e793c5c02..7cadb7c7d9 100644 --- a/modules/elastodyn/src/ElastoDyn_IO.f90 +++ b/modules/elastodyn/src/ElastoDyn_IO.f90 @@ -101,7 +101,13 @@ MODULE ElastoDyn_Parameters ! 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 25-Jan-2021 13:23:51. +! This code was generated by "Write_ChckOutLst.m". +!MODULE ElastoDyn_IO_Params +! +! USE NWTC_Library +! USE ElastoDyn_Types +! +! IMPLICIT NONE ! Indices for computing output channels: @@ -111,1002 +117,1139 @@ MODULE ElastoDyn_Parameters ! Time: - INTEGER(IntKi), PARAMETER :: Time = 0 + INTEGER(IntKi), PARAMETER :: Time = 0 ! Blade 1 Tip Motions: - INTEGER(IntKi), PARAMETER :: TipDxc1 = 1 - INTEGER(IntKi), PARAMETER :: TipDyc1 = 2 - INTEGER(IntKi), PARAMETER :: TipDzc1 = 3 - INTEGER(IntKi), PARAMETER :: TipDxb1 = 4 - INTEGER(IntKi), PARAMETER :: TipDyb1 = 5 - INTEGER(IntKi), PARAMETER :: TipALxb1 = 6 - INTEGER(IntKi), PARAMETER :: TipALyb1 = 7 - INTEGER(IntKi), PARAMETER :: TipALzb1 = 8 - INTEGER(IntKi), PARAMETER :: TipRDxb1 = 9 - INTEGER(IntKi), PARAMETER :: TipRDyb1 = 10 - INTEGER(IntKi), PARAMETER :: TipRDzc1 = 11 - INTEGER(IntKi), PARAMETER :: TipClrnc1 = 12 + INTEGER(IntKi), PARAMETER :: TipDxc1 = 1 + INTEGER(IntKi), PARAMETER :: TipDyc1 = 2 + INTEGER(IntKi), PARAMETER :: TipDzc1 = 3 + INTEGER(IntKi), PARAMETER :: TipDxb1 = 4 + INTEGER(IntKi), PARAMETER :: TipDyb1 = 5 + INTEGER(IntKi), PARAMETER :: TipALxb1 = 6 + INTEGER(IntKi), PARAMETER :: TipALyb1 = 7 + INTEGER(IntKi), PARAMETER :: TipALzb1 = 8 + INTEGER(IntKi), PARAMETER :: TipALgxb1 = 9 + INTEGER(IntKi), PARAMETER :: TipALgyb1 = 10 + INTEGER(IntKi), PARAMETER :: TipALgzb1 = 11 + INTEGER(IntKi), PARAMETER :: TipRDxb1 = 12 + INTEGER(IntKi), PARAMETER :: TipRDyb1 = 13 + INTEGER(IntKi), PARAMETER :: TipRDzc1 = 14 + INTEGER(IntKi), PARAMETER :: TipClrnc1 = 15 ! Blade 2 Tip Motions: - INTEGER(IntKi), PARAMETER :: TipDxc2 = 13 - INTEGER(IntKi), PARAMETER :: TipDyc2 = 14 - INTEGER(IntKi), PARAMETER :: TipDzc2 = 15 - INTEGER(IntKi), PARAMETER :: TipDxb2 = 16 - INTEGER(IntKi), PARAMETER :: TipDyb2 = 17 - INTEGER(IntKi), PARAMETER :: TipALxb2 = 18 - INTEGER(IntKi), PARAMETER :: TipALyb2 = 19 - INTEGER(IntKi), PARAMETER :: TipALzb2 = 20 - INTEGER(IntKi), PARAMETER :: TipRDxb2 = 21 - INTEGER(IntKi), PARAMETER :: TipRDyb2 = 22 - INTEGER(IntKi), PARAMETER :: TipRDzc2 = 23 - INTEGER(IntKi), PARAMETER :: TipClrnc2 = 24 + INTEGER(IntKi), PARAMETER :: TipDxc2 = 16 + INTEGER(IntKi), PARAMETER :: TipDyc2 = 17 + INTEGER(IntKi), PARAMETER :: TipDzc2 = 18 + INTEGER(IntKi), PARAMETER :: TipDxb2 = 19 + INTEGER(IntKi), PARAMETER :: TipDyb2 = 20 + INTEGER(IntKi), PARAMETER :: TipALxb2 = 21 + INTEGER(IntKi), PARAMETER :: TipALyb2 = 22 + INTEGER(IntKi), PARAMETER :: TipALzb2 = 23 + INTEGER(IntKi), PARAMETER :: TipALgxb2 = 24 + INTEGER(IntKi), PARAMETER :: TipALgyb2 = 25 + INTEGER(IntKi), PARAMETER :: TipALgzb2 = 26 + INTEGER(IntKi), PARAMETER :: TipRDxb2 = 27 + INTEGER(IntKi), PARAMETER :: TipRDyb2 = 28 + INTEGER(IntKi), PARAMETER :: TipRDzc2 = 29 + INTEGER(IntKi), PARAMETER :: TipClrnc2 = 30 ! Blade 3 Tip Motions: - INTEGER(IntKi), PARAMETER :: TipDxc3 = 25 - INTEGER(IntKi), PARAMETER :: TipDyc3 = 26 - INTEGER(IntKi), PARAMETER :: TipDzc3 = 27 - INTEGER(IntKi), PARAMETER :: TipDxb3 = 28 - INTEGER(IntKi), PARAMETER :: TipDyb3 = 29 - INTEGER(IntKi), PARAMETER :: TipALxb3 = 30 - INTEGER(IntKi), PARAMETER :: TipALyb3 = 31 - INTEGER(IntKi), PARAMETER :: TipALzb3 = 32 - INTEGER(IntKi), PARAMETER :: TipRDxb3 = 33 - INTEGER(IntKi), PARAMETER :: TipRDyb3 = 34 - INTEGER(IntKi), PARAMETER :: TipRDzc3 = 35 - INTEGER(IntKi), PARAMETER :: TipClrnc3 = 36 + INTEGER(IntKi), PARAMETER :: TipDxc3 = 31 + INTEGER(IntKi), PARAMETER :: TipDyc3 = 32 + INTEGER(IntKi), PARAMETER :: TipDzc3 = 33 + INTEGER(IntKi), PARAMETER :: TipDxb3 = 34 + INTEGER(IntKi), PARAMETER :: TipDyb3 = 35 + INTEGER(IntKi), PARAMETER :: TipALxb3 = 36 + INTEGER(IntKi), PARAMETER :: TipALyb3 = 37 + INTEGER(IntKi), PARAMETER :: TipALzb3 = 38 + INTEGER(IntKi), PARAMETER :: TipALgxb3 = 39 + INTEGER(IntKi), PARAMETER :: TipALgyb3 = 40 + INTEGER(IntKi), PARAMETER :: TipALgzb3 = 41 + INTEGER(IntKi), PARAMETER :: TipRDxb3 = 42 + INTEGER(IntKi), PARAMETER :: TipRDyb3 = 43 + INTEGER(IntKi), PARAMETER :: TipRDzc3 = 44 + INTEGER(IntKi), PARAMETER :: TipClrnc3 = 45 ! Blade 1 Local Span Motions: - INTEGER(IntKi), PARAMETER :: Spn1ALxb1 = 37 - INTEGER(IntKi), PARAMETER :: Spn1ALyb1 = 38 - INTEGER(IntKi), PARAMETER :: Spn1ALzb1 = 39 - INTEGER(IntKi), PARAMETER :: Spn2ALxb1 = 40 - INTEGER(IntKi), PARAMETER :: Spn2ALyb1 = 41 - INTEGER(IntKi), PARAMETER :: Spn2ALzb1 = 42 - INTEGER(IntKi), PARAMETER :: Spn3ALxb1 = 43 - INTEGER(IntKi), PARAMETER :: Spn3ALyb1 = 44 - INTEGER(IntKi), PARAMETER :: Spn3ALzb1 = 45 - INTEGER(IntKi), PARAMETER :: Spn4ALxb1 = 46 - INTEGER(IntKi), PARAMETER :: Spn4ALyb1 = 47 - INTEGER(IntKi), PARAMETER :: Spn4ALzb1 = 48 - INTEGER(IntKi), PARAMETER :: Spn5ALxb1 = 49 - INTEGER(IntKi), PARAMETER :: Spn5ALyb1 = 50 - INTEGER(IntKi), PARAMETER :: Spn5ALzb1 = 51 - INTEGER(IntKi), PARAMETER :: Spn6ALxb1 = 52 - INTEGER(IntKi), PARAMETER :: Spn6ALyb1 = 53 - INTEGER(IntKi), PARAMETER :: Spn6ALzb1 = 54 - INTEGER(IntKi), PARAMETER :: Spn7ALxb1 = 55 - INTEGER(IntKi), PARAMETER :: Spn7ALyb1 = 56 - INTEGER(IntKi), PARAMETER :: Spn7ALzb1 = 57 - INTEGER(IntKi), PARAMETER :: Spn8ALxb1 = 58 - INTEGER(IntKi), PARAMETER :: Spn8ALyb1 = 59 - INTEGER(IntKi), PARAMETER :: Spn8ALzb1 = 60 - INTEGER(IntKi), PARAMETER :: Spn9ALxb1 = 61 - INTEGER(IntKi), PARAMETER :: Spn9ALyb1 = 62 - INTEGER(IntKi), PARAMETER :: Spn9ALzb1 = 63 - INTEGER(IntKi), PARAMETER :: Spn1TDxb1 = 64 - INTEGER(IntKi), PARAMETER :: Spn1TDyb1 = 65 - INTEGER(IntKi), PARAMETER :: Spn1TDzb1 = 66 - INTEGER(IntKi), PARAMETER :: Spn2TDxb1 = 67 - INTEGER(IntKi), PARAMETER :: Spn2TDyb1 = 68 - INTEGER(IntKi), PARAMETER :: Spn2TDzb1 = 69 - INTEGER(IntKi), PARAMETER :: Spn3TDxb1 = 70 - INTEGER(IntKi), PARAMETER :: Spn3TDyb1 = 71 - INTEGER(IntKi), PARAMETER :: Spn3TDzb1 = 72 - INTEGER(IntKi), PARAMETER :: Spn4TDxb1 = 73 - INTEGER(IntKi), PARAMETER :: Spn4TDyb1 = 74 - INTEGER(IntKi), PARAMETER :: Spn4TDzb1 = 75 - INTEGER(IntKi), PARAMETER :: Spn5TDxb1 = 76 - INTEGER(IntKi), PARAMETER :: Spn5TDyb1 = 77 - INTEGER(IntKi), PARAMETER :: Spn5TDzb1 = 78 - INTEGER(IntKi), PARAMETER :: Spn6TDxb1 = 79 - INTEGER(IntKi), PARAMETER :: Spn6TDyb1 = 80 - INTEGER(IntKi), PARAMETER :: Spn6TDzb1 = 81 - INTEGER(IntKi), PARAMETER :: Spn7TDxb1 = 82 - INTEGER(IntKi), PARAMETER :: Spn7TDyb1 = 83 - INTEGER(IntKi), PARAMETER :: Spn7TDzb1 = 84 - INTEGER(IntKi), PARAMETER :: Spn8TDxb1 = 85 - INTEGER(IntKi), PARAMETER :: Spn8TDyb1 = 86 - INTEGER(IntKi), PARAMETER :: Spn8TDzb1 = 87 - INTEGER(IntKi), PARAMETER :: Spn9TDxb1 = 88 - INTEGER(IntKi), PARAMETER :: Spn9TDyb1 = 89 - INTEGER(IntKi), PARAMETER :: Spn9TDzb1 = 90 - INTEGER(IntKi), PARAMETER :: Spn1RDxb1 = 91 - INTEGER(IntKi), PARAMETER :: Spn1RDyb1 = 92 - INTEGER(IntKi), PARAMETER :: Spn1RDzb1 = 93 - INTEGER(IntKi), PARAMETER :: Spn2RDxb1 = 94 - INTEGER(IntKi), PARAMETER :: Spn2RDyb1 = 95 - INTEGER(IntKi), PARAMETER :: Spn2RDzb1 = 96 - INTEGER(IntKi), PARAMETER :: Spn3RDxb1 = 97 - INTEGER(IntKi), PARAMETER :: Spn3RDyb1 = 98 - INTEGER(IntKi), PARAMETER :: Spn3RDzb1 = 99 - INTEGER(IntKi), PARAMETER :: Spn4RDxb1 = 100 - INTEGER(IntKi), PARAMETER :: Spn4RDyb1 = 101 - INTEGER(IntKi), PARAMETER :: Spn4RDzb1 = 102 - INTEGER(IntKi), PARAMETER :: Spn5RDxb1 = 103 - INTEGER(IntKi), PARAMETER :: Spn5RDyb1 = 104 - INTEGER(IntKi), PARAMETER :: Spn5RDzb1 = 105 - INTEGER(IntKi), PARAMETER :: Spn6RDxb1 = 106 - INTEGER(IntKi), PARAMETER :: Spn6RDyb1 = 107 - INTEGER(IntKi), PARAMETER :: Spn6RDzb1 = 108 - INTEGER(IntKi), PARAMETER :: Spn7RDxb1 = 109 - INTEGER(IntKi), PARAMETER :: Spn7RDyb1 = 110 - INTEGER(IntKi), PARAMETER :: Spn7RDzb1 = 111 - INTEGER(IntKi), PARAMETER :: Spn8RDxb1 = 112 - INTEGER(IntKi), PARAMETER :: Spn8RDyb1 = 113 - INTEGER(IntKi), PARAMETER :: Spn8RDzb1 = 114 - INTEGER(IntKi), PARAMETER :: Spn9RDxb1 = 115 - INTEGER(IntKi), PARAMETER :: Spn9RDyb1 = 116 - INTEGER(IntKi), PARAMETER :: Spn9RDzb1 = 117 + INTEGER(IntKi), PARAMETER :: Spn1ALxb1 = 46 + INTEGER(IntKi), PARAMETER :: Spn1ALyb1 = 47 + INTEGER(IntKi), PARAMETER :: Spn1ALzb1 = 48 + INTEGER(IntKi), PARAMETER :: Spn2ALxb1 = 49 + INTEGER(IntKi), PARAMETER :: Spn2ALyb1 = 50 + INTEGER(IntKi), PARAMETER :: Spn2ALzb1 = 51 + INTEGER(IntKi), PARAMETER :: Spn3ALxb1 = 52 + INTEGER(IntKi), PARAMETER :: Spn3ALyb1 = 53 + INTEGER(IntKi), PARAMETER :: Spn3ALzb1 = 54 + INTEGER(IntKi), PARAMETER :: Spn4ALxb1 = 55 + INTEGER(IntKi), PARAMETER :: Spn4ALyb1 = 56 + INTEGER(IntKi), PARAMETER :: Spn4ALzb1 = 57 + INTEGER(IntKi), PARAMETER :: Spn5ALxb1 = 58 + INTEGER(IntKi), PARAMETER :: Spn5ALyb1 = 59 + INTEGER(IntKi), PARAMETER :: Spn5ALzb1 = 60 + INTEGER(IntKi), PARAMETER :: Spn6ALxb1 = 61 + INTEGER(IntKi), PARAMETER :: Spn6ALyb1 = 62 + INTEGER(IntKi), PARAMETER :: Spn6ALzb1 = 63 + INTEGER(IntKi), PARAMETER :: Spn7ALxb1 = 64 + INTEGER(IntKi), PARAMETER :: Spn7ALyb1 = 65 + INTEGER(IntKi), PARAMETER :: Spn7ALzb1 = 66 + INTEGER(IntKi), PARAMETER :: Spn8ALxb1 = 67 + INTEGER(IntKi), PARAMETER :: Spn8ALyb1 = 68 + INTEGER(IntKi), PARAMETER :: Spn8ALzb1 = 69 + INTEGER(IntKi), PARAMETER :: Spn9ALxb1 = 70 + INTEGER(IntKi), PARAMETER :: Spn9ALyb1 = 71 + INTEGER(IntKi), PARAMETER :: Spn9ALzb1 = 72 + INTEGER(IntKi), PARAMETER :: Spn1ALgxb1 = 73 + INTEGER(IntKi), PARAMETER :: Spn1ALgyb1 = 74 + INTEGER(IntKi), PARAMETER :: Spn1ALgzb1 = 75 + INTEGER(IntKi), PARAMETER :: Spn2ALgxb1 = 76 + INTEGER(IntKi), PARAMETER :: Spn2ALgyb1 = 77 + INTEGER(IntKi), PARAMETER :: Spn2ALgzb1 = 78 + INTEGER(IntKi), PARAMETER :: Spn3ALgxb1 = 79 + INTEGER(IntKi), PARAMETER :: Spn3ALgyb1 = 80 + INTEGER(IntKi), PARAMETER :: Spn3ALgzb1 = 81 + INTEGER(IntKi), PARAMETER :: Spn4ALgxb1 = 82 + INTEGER(IntKi), PARAMETER :: Spn4ALgyb1 = 83 + INTEGER(IntKi), PARAMETER :: Spn4ALgzb1 = 84 + INTEGER(IntKi), PARAMETER :: Spn5ALgxb1 = 85 + INTEGER(IntKi), PARAMETER :: Spn5ALgyb1 = 86 + INTEGER(IntKi), PARAMETER :: Spn5ALgzb1 = 87 + INTEGER(IntKi), PARAMETER :: Spn6ALgxb1 = 88 + INTEGER(IntKi), PARAMETER :: Spn6ALgyb1 = 89 + INTEGER(IntKi), PARAMETER :: Spn6ALgzb1 = 90 + INTEGER(IntKi), PARAMETER :: Spn7ALgxb1 = 91 + INTEGER(IntKi), PARAMETER :: Spn7ALgyb1 = 92 + INTEGER(IntKi), PARAMETER :: Spn7ALgzb1 = 93 + INTEGER(IntKi), PARAMETER :: Spn8ALgxb1 = 94 + INTEGER(IntKi), PARAMETER :: Spn8ALgyb1 = 95 + INTEGER(IntKi), PARAMETER :: Spn8ALgzb1 = 96 + INTEGER(IntKi), PARAMETER :: Spn9ALgxb1 = 97 + INTEGER(IntKi), PARAMETER :: Spn9ALgyb1 = 98 + INTEGER(IntKi), PARAMETER :: Spn9ALgzb1 = 99 + INTEGER(IntKi), PARAMETER :: Spn1TDxb1 = 100 + INTEGER(IntKi), PARAMETER :: Spn1TDyb1 = 101 + INTEGER(IntKi), PARAMETER :: Spn1TDzb1 = 102 + INTEGER(IntKi), PARAMETER :: Spn2TDxb1 = 103 + INTEGER(IntKi), PARAMETER :: Spn2TDyb1 = 104 + INTEGER(IntKi), PARAMETER :: Spn2TDzb1 = 105 + INTEGER(IntKi), PARAMETER :: Spn3TDxb1 = 106 + INTEGER(IntKi), PARAMETER :: Spn3TDyb1 = 107 + INTEGER(IntKi), PARAMETER :: Spn3TDzb1 = 108 + INTEGER(IntKi), PARAMETER :: Spn4TDxb1 = 109 + INTEGER(IntKi), PARAMETER :: Spn4TDyb1 = 110 + INTEGER(IntKi), PARAMETER :: Spn4TDzb1 = 111 + INTEGER(IntKi), PARAMETER :: Spn5TDxb1 = 112 + INTEGER(IntKi), PARAMETER :: Spn5TDyb1 = 113 + INTEGER(IntKi), PARAMETER :: Spn5TDzb1 = 114 + INTEGER(IntKi), PARAMETER :: Spn6TDxb1 = 115 + INTEGER(IntKi), PARAMETER :: Spn6TDyb1 = 116 + INTEGER(IntKi), PARAMETER :: Spn6TDzb1 = 117 + INTEGER(IntKi), PARAMETER :: Spn7TDxb1 = 118 + INTEGER(IntKi), PARAMETER :: Spn7TDyb1 = 119 + INTEGER(IntKi), PARAMETER :: Spn7TDzb1 = 120 + INTEGER(IntKi), PARAMETER :: Spn8TDxb1 = 121 + INTEGER(IntKi), PARAMETER :: Spn8TDyb1 = 122 + INTEGER(IntKi), PARAMETER :: Spn8TDzb1 = 123 + INTEGER(IntKi), PARAMETER :: Spn9TDxb1 = 124 + INTEGER(IntKi), PARAMETER :: Spn9TDyb1 = 125 + INTEGER(IntKi), PARAMETER :: Spn9TDzb1 = 126 + INTEGER(IntKi), PARAMETER :: Spn1RDxb1 = 127 + INTEGER(IntKi), PARAMETER :: Spn1RDyb1 = 128 + INTEGER(IntKi), PARAMETER :: Spn1RDzb1 = 129 + INTEGER(IntKi), PARAMETER :: Spn2RDxb1 = 130 + INTEGER(IntKi), PARAMETER :: Spn2RDyb1 = 131 + INTEGER(IntKi), PARAMETER :: Spn2RDzb1 = 132 + INTEGER(IntKi), PARAMETER :: Spn3RDxb1 = 133 + INTEGER(IntKi), PARAMETER :: Spn3RDyb1 = 134 + INTEGER(IntKi), PARAMETER :: Spn3RDzb1 = 135 + INTEGER(IntKi), PARAMETER :: Spn4RDxb1 = 136 + INTEGER(IntKi), PARAMETER :: Spn4RDyb1 = 137 + INTEGER(IntKi), PARAMETER :: Spn4RDzb1 = 138 + INTEGER(IntKi), PARAMETER :: Spn5RDxb1 = 139 + INTEGER(IntKi), PARAMETER :: Spn5RDyb1 = 140 + INTEGER(IntKi), PARAMETER :: Spn5RDzb1 = 141 + INTEGER(IntKi), PARAMETER :: Spn6RDxb1 = 142 + INTEGER(IntKi), PARAMETER :: Spn6RDyb1 = 143 + INTEGER(IntKi), PARAMETER :: Spn6RDzb1 = 144 + INTEGER(IntKi), PARAMETER :: Spn7RDxb1 = 145 + INTEGER(IntKi), PARAMETER :: Spn7RDyb1 = 146 + INTEGER(IntKi), PARAMETER :: Spn7RDzb1 = 147 + INTEGER(IntKi), PARAMETER :: Spn8RDxb1 = 148 + INTEGER(IntKi), PARAMETER :: Spn8RDyb1 = 149 + INTEGER(IntKi), PARAMETER :: Spn8RDzb1 = 150 + INTEGER(IntKi), PARAMETER :: Spn9RDxb1 = 151 + INTEGER(IntKi), PARAMETER :: Spn9RDyb1 = 152 + INTEGER(IntKi), PARAMETER :: Spn9RDzb1 = 153 ! Blade 2 Local Span Motions: - INTEGER(IntKi), PARAMETER :: Spn1ALxb2 = 118 - INTEGER(IntKi), PARAMETER :: Spn1ALyb2 = 119 - INTEGER(IntKi), PARAMETER :: Spn1ALzb2 = 120 - INTEGER(IntKi), PARAMETER :: Spn2ALxb2 = 121 - INTEGER(IntKi), PARAMETER :: Spn2ALyb2 = 122 - INTEGER(IntKi), PARAMETER :: Spn2ALzb2 = 123 - INTEGER(IntKi), PARAMETER :: Spn3ALxb2 = 124 - INTEGER(IntKi), PARAMETER :: Spn3ALyb2 = 125 - INTEGER(IntKi), PARAMETER :: Spn3ALzb2 = 126 - INTEGER(IntKi), PARAMETER :: Spn4ALxb2 = 127 - INTEGER(IntKi), PARAMETER :: Spn4ALyb2 = 128 - INTEGER(IntKi), PARAMETER :: Spn4ALzb2 = 129 - INTEGER(IntKi), PARAMETER :: Spn5ALxb2 = 130 - INTEGER(IntKi), PARAMETER :: Spn5ALyb2 = 131 - INTEGER(IntKi), PARAMETER :: Spn5ALzb2 = 132 - INTEGER(IntKi), PARAMETER :: Spn6ALxb2 = 133 - INTEGER(IntKi), PARAMETER :: Spn6ALyb2 = 134 - INTEGER(IntKi), PARAMETER :: Spn6ALzb2 = 135 - INTEGER(IntKi), PARAMETER :: Spn7ALxb2 = 136 - INTEGER(IntKi), PARAMETER :: Spn7ALyb2 = 137 - INTEGER(IntKi), PARAMETER :: Spn7ALzb2 = 138 - INTEGER(IntKi), PARAMETER :: Spn8ALxb2 = 139 - INTEGER(IntKi), PARAMETER :: Spn8ALyb2 = 140 - INTEGER(IntKi), PARAMETER :: Spn8ALzb2 = 141 - INTEGER(IntKi), PARAMETER :: Spn9ALxb2 = 142 - INTEGER(IntKi), PARAMETER :: Spn9ALyb2 = 143 - INTEGER(IntKi), PARAMETER :: Spn9ALzb2 = 144 - INTEGER(IntKi), PARAMETER :: Spn1TDxb2 = 145 - INTEGER(IntKi), PARAMETER :: Spn1TDyb2 = 146 - INTEGER(IntKi), PARAMETER :: Spn1TDzb2 = 147 - INTEGER(IntKi), PARAMETER :: Spn2TDxb2 = 148 - INTEGER(IntKi), PARAMETER :: Spn2TDyb2 = 149 - INTEGER(IntKi), PARAMETER :: Spn2TDzb2 = 150 - INTEGER(IntKi), PARAMETER :: Spn3TDxb2 = 151 - INTEGER(IntKi), PARAMETER :: Spn3TDyb2 = 152 - INTEGER(IntKi), PARAMETER :: Spn3TDzb2 = 153 - INTEGER(IntKi), PARAMETER :: Spn4TDxb2 = 154 - INTEGER(IntKi), PARAMETER :: Spn4TDyb2 = 155 - INTEGER(IntKi), PARAMETER :: Spn4TDzb2 = 156 - INTEGER(IntKi), PARAMETER :: Spn5TDxb2 = 157 - INTEGER(IntKi), PARAMETER :: Spn5TDyb2 = 158 - INTEGER(IntKi), PARAMETER :: Spn5TDzb2 = 159 - INTEGER(IntKi), PARAMETER :: Spn6TDxb2 = 160 - INTEGER(IntKi), PARAMETER :: Spn6TDyb2 = 161 - INTEGER(IntKi), PARAMETER :: Spn6TDzb2 = 162 - INTEGER(IntKi), PARAMETER :: Spn7TDxb2 = 163 - INTEGER(IntKi), PARAMETER :: Spn7TDyb2 = 164 - INTEGER(IntKi), PARAMETER :: Spn7TDzb2 = 165 - INTEGER(IntKi), PARAMETER :: Spn8TDxb2 = 166 - INTEGER(IntKi), PARAMETER :: Spn8TDyb2 = 167 - INTEGER(IntKi), PARAMETER :: Spn8TDzb2 = 168 - INTEGER(IntKi), PARAMETER :: Spn9TDxb2 = 169 - INTEGER(IntKi), PARAMETER :: Spn9TDyb2 = 170 - INTEGER(IntKi), PARAMETER :: Spn9TDzb2 = 171 - INTEGER(IntKi), PARAMETER :: Spn1RDxb2 = 172 - INTEGER(IntKi), PARAMETER :: Spn1RDyb2 = 173 - INTEGER(IntKi), PARAMETER :: Spn1RDzb2 = 174 - INTEGER(IntKi), PARAMETER :: Spn2RDxb2 = 175 - INTEGER(IntKi), PARAMETER :: Spn2RDyb2 = 176 - INTEGER(IntKi), PARAMETER :: Spn2RDzb2 = 177 - INTEGER(IntKi), PARAMETER :: Spn3RDxb2 = 178 - INTEGER(IntKi), PARAMETER :: Spn3RDyb2 = 179 - INTEGER(IntKi), PARAMETER :: Spn3RDzb2 = 180 - INTEGER(IntKi), PARAMETER :: Spn4RDxb2 = 181 - INTEGER(IntKi), PARAMETER :: Spn4RDyb2 = 182 - INTEGER(IntKi), PARAMETER :: Spn4RDzb2 = 183 - INTEGER(IntKi), PARAMETER :: Spn5RDxb2 = 184 - INTEGER(IntKi), PARAMETER :: Spn5RDyb2 = 185 - INTEGER(IntKi), PARAMETER :: Spn5RDzb2 = 186 - INTEGER(IntKi), PARAMETER :: Spn6RDxb2 = 187 - INTEGER(IntKi), PARAMETER :: Spn6RDyb2 = 188 - INTEGER(IntKi), PARAMETER :: Spn6RDzb2 = 189 - INTEGER(IntKi), PARAMETER :: Spn7RDxb2 = 190 - INTEGER(IntKi), PARAMETER :: Spn7RDyb2 = 191 - INTEGER(IntKi), PARAMETER :: Spn7RDzb2 = 192 - INTEGER(IntKi), PARAMETER :: Spn8RDxb2 = 193 - INTEGER(IntKi), PARAMETER :: Spn8RDyb2 = 194 - INTEGER(IntKi), PARAMETER :: Spn8RDzb2 = 195 - INTEGER(IntKi), PARAMETER :: Spn9RDxb2 = 196 - INTEGER(IntKi), PARAMETER :: Spn9RDyb2 = 197 - INTEGER(IntKi), PARAMETER :: Spn9RDzb2 = 198 + INTEGER(IntKi), PARAMETER :: Spn1ALxb2 = 154 + INTEGER(IntKi), PARAMETER :: Spn1ALyb2 = 155 + INTEGER(IntKi), PARAMETER :: Spn1ALzb2 = 156 + INTEGER(IntKi), PARAMETER :: Spn2ALxb2 = 157 + INTEGER(IntKi), PARAMETER :: Spn2ALyb2 = 158 + INTEGER(IntKi), PARAMETER :: Spn2ALzb2 = 159 + INTEGER(IntKi), PARAMETER :: Spn3ALxb2 = 160 + INTEGER(IntKi), PARAMETER :: Spn3ALyb2 = 161 + INTEGER(IntKi), PARAMETER :: Spn3ALzb2 = 162 + INTEGER(IntKi), PARAMETER :: Spn4ALxb2 = 163 + INTEGER(IntKi), PARAMETER :: Spn4ALyb2 = 164 + INTEGER(IntKi), PARAMETER :: Spn4ALzb2 = 165 + INTEGER(IntKi), PARAMETER :: Spn5ALxb2 = 166 + INTEGER(IntKi), PARAMETER :: Spn5ALyb2 = 167 + INTEGER(IntKi), PARAMETER :: Spn5ALzb2 = 168 + INTEGER(IntKi), PARAMETER :: Spn6ALxb2 = 169 + INTEGER(IntKi), PARAMETER :: Spn6ALyb2 = 170 + INTEGER(IntKi), PARAMETER :: Spn6ALzb2 = 171 + INTEGER(IntKi), PARAMETER :: Spn7ALxb2 = 172 + INTEGER(IntKi), PARAMETER :: Spn7ALyb2 = 173 + INTEGER(IntKi), PARAMETER :: Spn7ALzb2 = 174 + INTEGER(IntKi), PARAMETER :: Spn8ALxb2 = 175 + INTEGER(IntKi), PARAMETER :: Spn8ALyb2 = 176 + INTEGER(IntKi), PARAMETER :: Spn8ALzb2 = 177 + INTEGER(IntKi), PARAMETER :: Spn9ALxb2 = 178 + INTEGER(IntKi), PARAMETER :: Spn9ALyb2 = 179 + INTEGER(IntKi), PARAMETER :: Spn9ALzb2 = 180 + INTEGER(IntKi), PARAMETER :: Spn1ALgxb2 = 181 + INTEGER(IntKi), PARAMETER :: Spn1ALgyb2 = 182 + INTEGER(IntKi), PARAMETER :: Spn1ALgzb2 = 183 + INTEGER(IntKi), PARAMETER :: Spn2ALgxb2 = 184 + INTEGER(IntKi), PARAMETER :: Spn2ALgyb2 = 185 + INTEGER(IntKi), PARAMETER :: Spn2ALgzb2 = 186 + INTEGER(IntKi), PARAMETER :: Spn3ALgxb2 = 187 + INTEGER(IntKi), PARAMETER :: Spn3ALgyb2 = 188 + INTEGER(IntKi), PARAMETER :: Spn3ALgzb2 = 189 + INTEGER(IntKi), PARAMETER :: Spn4ALgxb2 = 190 + INTEGER(IntKi), PARAMETER :: Spn4ALgyb2 = 191 + INTEGER(IntKi), PARAMETER :: Spn4ALgzb2 = 192 + INTEGER(IntKi), PARAMETER :: Spn5ALgxb2 = 193 + INTEGER(IntKi), PARAMETER :: Spn5ALgyb2 = 194 + INTEGER(IntKi), PARAMETER :: Spn5ALgzb2 = 195 + INTEGER(IntKi), PARAMETER :: Spn6ALgxb2 = 196 + INTEGER(IntKi), PARAMETER :: Spn6ALgyb2 = 197 + INTEGER(IntKi), PARAMETER :: Spn6ALgzb2 = 198 + INTEGER(IntKi), PARAMETER :: Spn7ALgxb2 = 199 + INTEGER(IntKi), PARAMETER :: Spn7ALgyb2 = 200 + INTEGER(IntKi), PARAMETER :: Spn7ALgzb2 = 201 + INTEGER(IntKi), PARAMETER :: Spn8ALgxb2 = 202 + INTEGER(IntKi), PARAMETER :: Spn8ALgyb2 = 203 + INTEGER(IntKi), PARAMETER :: Spn8ALgzb2 = 204 + INTEGER(IntKi), PARAMETER :: Spn9ALgxb2 = 205 + INTEGER(IntKi), PARAMETER :: Spn9ALgyb2 = 206 + INTEGER(IntKi), PARAMETER :: Spn9ALgzb2 = 207 + INTEGER(IntKi), PARAMETER :: Spn1TDxb2 = 208 + INTEGER(IntKi), PARAMETER :: Spn1TDyb2 = 209 + INTEGER(IntKi), PARAMETER :: Spn1TDzb2 = 210 + INTEGER(IntKi), PARAMETER :: Spn2TDxb2 = 211 + INTEGER(IntKi), PARAMETER :: Spn2TDyb2 = 212 + INTEGER(IntKi), PARAMETER :: Spn2TDzb2 = 213 + INTEGER(IntKi), PARAMETER :: Spn3TDxb2 = 214 + INTEGER(IntKi), PARAMETER :: Spn3TDyb2 = 215 + INTEGER(IntKi), PARAMETER :: Spn3TDzb2 = 216 + INTEGER(IntKi), PARAMETER :: Spn4TDxb2 = 217 + INTEGER(IntKi), PARAMETER :: Spn4TDyb2 = 218 + INTEGER(IntKi), PARAMETER :: Spn4TDzb2 = 219 + INTEGER(IntKi), PARAMETER :: Spn5TDxb2 = 220 + INTEGER(IntKi), PARAMETER :: Spn5TDyb2 = 221 + INTEGER(IntKi), PARAMETER :: Spn5TDzb2 = 222 + INTEGER(IntKi), PARAMETER :: Spn6TDxb2 = 223 + INTEGER(IntKi), PARAMETER :: Spn6TDyb2 = 224 + INTEGER(IntKi), PARAMETER :: Spn6TDzb2 = 225 + INTEGER(IntKi), PARAMETER :: Spn7TDxb2 = 226 + INTEGER(IntKi), PARAMETER :: Spn7TDyb2 = 227 + INTEGER(IntKi), PARAMETER :: Spn7TDzb2 = 228 + INTEGER(IntKi), PARAMETER :: Spn8TDxb2 = 229 + INTEGER(IntKi), PARAMETER :: Spn8TDyb2 = 230 + INTEGER(IntKi), PARAMETER :: Spn8TDzb2 = 231 + INTEGER(IntKi), PARAMETER :: Spn9TDxb2 = 232 + INTEGER(IntKi), PARAMETER :: Spn9TDyb2 = 233 + INTEGER(IntKi), PARAMETER :: Spn9TDzb2 = 234 + INTEGER(IntKi), PARAMETER :: Spn1RDxb2 = 235 + INTEGER(IntKi), PARAMETER :: Spn1RDyb2 = 236 + INTEGER(IntKi), PARAMETER :: Spn1RDzb2 = 237 + INTEGER(IntKi), PARAMETER :: Spn2RDxb2 = 238 + INTEGER(IntKi), PARAMETER :: Spn2RDyb2 = 239 + INTEGER(IntKi), PARAMETER :: Spn2RDzb2 = 240 + INTEGER(IntKi), PARAMETER :: Spn3RDxb2 = 241 + INTEGER(IntKi), PARAMETER :: Spn3RDyb2 = 242 + INTEGER(IntKi), PARAMETER :: Spn3RDzb2 = 243 + INTEGER(IntKi), PARAMETER :: Spn4RDxb2 = 244 + INTEGER(IntKi), PARAMETER :: Spn4RDyb2 = 245 + INTEGER(IntKi), PARAMETER :: Spn4RDzb2 = 246 + INTEGER(IntKi), PARAMETER :: Spn5RDxb2 = 247 + INTEGER(IntKi), PARAMETER :: Spn5RDyb2 = 248 + INTEGER(IntKi), PARAMETER :: Spn5RDzb2 = 249 + INTEGER(IntKi), PARAMETER :: Spn6RDxb2 = 250 + INTEGER(IntKi), PARAMETER :: Spn6RDyb2 = 251 + INTEGER(IntKi), PARAMETER :: Spn6RDzb2 = 252 + INTEGER(IntKi), PARAMETER :: Spn7RDxb2 = 253 + INTEGER(IntKi), PARAMETER :: Spn7RDyb2 = 254 + INTEGER(IntKi), PARAMETER :: Spn7RDzb2 = 255 + INTEGER(IntKi), PARAMETER :: Spn8RDxb2 = 256 + INTEGER(IntKi), PARAMETER :: Spn8RDyb2 = 257 + INTEGER(IntKi), PARAMETER :: Spn8RDzb2 = 258 + INTEGER(IntKi), PARAMETER :: Spn9RDxb2 = 259 + INTEGER(IntKi), PARAMETER :: Spn9RDyb2 = 260 + INTEGER(IntKi), PARAMETER :: Spn9RDzb2 = 261 ! Blade 3 Local Span Motions: - INTEGER(IntKi), PARAMETER :: Spn1ALxb3 = 199 - INTEGER(IntKi), PARAMETER :: Spn1ALyb3 = 200 - INTEGER(IntKi), PARAMETER :: Spn1ALzb3 = 201 - INTEGER(IntKi), PARAMETER :: Spn2ALxb3 = 202 - INTEGER(IntKi), PARAMETER :: Spn2ALyb3 = 203 - INTEGER(IntKi), PARAMETER :: Spn2ALzb3 = 204 - INTEGER(IntKi), PARAMETER :: Spn3ALxb3 = 205 - INTEGER(IntKi), PARAMETER :: Spn3ALyb3 = 206 - INTEGER(IntKi), PARAMETER :: Spn3ALzb3 = 207 - INTEGER(IntKi), PARAMETER :: Spn4ALxb3 = 208 - INTEGER(IntKi), PARAMETER :: Spn4ALyb3 = 209 - INTEGER(IntKi), PARAMETER :: Spn4ALzb3 = 210 - INTEGER(IntKi), PARAMETER :: Spn5ALxb3 = 211 - INTEGER(IntKi), PARAMETER :: Spn5ALyb3 = 212 - INTEGER(IntKi), PARAMETER :: Spn5ALzb3 = 213 - INTEGER(IntKi), PARAMETER :: Spn6ALxb3 = 214 - INTEGER(IntKi), PARAMETER :: Spn6ALyb3 = 215 - INTEGER(IntKi), PARAMETER :: Spn6ALzb3 = 216 - INTEGER(IntKi), PARAMETER :: Spn7ALxb3 = 217 - INTEGER(IntKi), PARAMETER :: Spn7ALyb3 = 218 - INTEGER(IntKi), PARAMETER :: Spn7ALzb3 = 219 - INTEGER(IntKi), PARAMETER :: Spn8ALxb3 = 220 - INTEGER(IntKi), PARAMETER :: Spn8ALyb3 = 221 - INTEGER(IntKi), PARAMETER :: Spn8ALzb3 = 222 - INTEGER(IntKi), PARAMETER :: Spn9ALxb3 = 223 - INTEGER(IntKi), PARAMETER :: Spn9ALyb3 = 224 - INTEGER(IntKi), PARAMETER :: Spn9ALzb3 = 225 - INTEGER(IntKi), PARAMETER :: Spn1TDxb3 = 226 - INTEGER(IntKi), PARAMETER :: Spn1TDyb3 = 227 - INTEGER(IntKi), PARAMETER :: Spn1TDzb3 = 228 - INTEGER(IntKi), PARAMETER :: Spn2TDxb3 = 229 - INTEGER(IntKi), PARAMETER :: Spn2TDyb3 = 230 - INTEGER(IntKi), PARAMETER :: Spn2TDzb3 = 231 - INTEGER(IntKi), PARAMETER :: Spn3TDxb3 = 232 - INTEGER(IntKi), PARAMETER :: Spn3TDyb3 = 233 - INTEGER(IntKi), PARAMETER :: Spn3TDzb3 = 234 - INTEGER(IntKi), PARAMETER :: Spn4TDxb3 = 235 - INTEGER(IntKi), PARAMETER :: Spn4TDyb3 = 236 - INTEGER(IntKi), PARAMETER :: Spn4TDzb3 = 237 - INTEGER(IntKi), PARAMETER :: Spn5TDxb3 = 238 - INTEGER(IntKi), PARAMETER :: Spn5TDyb3 = 239 - INTEGER(IntKi), PARAMETER :: Spn5TDzb3 = 240 - INTEGER(IntKi), PARAMETER :: Spn6TDxb3 = 241 - INTEGER(IntKi), PARAMETER :: Spn6TDyb3 = 242 - INTEGER(IntKi), PARAMETER :: Spn6TDzb3 = 243 - INTEGER(IntKi), PARAMETER :: Spn7TDxb3 = 244 - INTEGER(IntKi), PARAMETER :: Spn7TDyb3 = 245 - INTEGER(IntKi), PARAMETER :: Spn7TDzb3 = 246 - INTEGER(IntKi), PARAMETER :: Spn8TDxb3 = 247 - INTEGER(IntKi), PARAMETER :: Spn8TDyb3 = 248 - INTEGER(IntKi), PARAMETER :: Spn8TDzb3 = 249 - INTEGER(IntKi), PARAMETER :: Spn9TDxb3 = 250 - INTEGER(IntKi), PARAMETER :: Spn9TDyb3 = 251 - INTEGER(IntKi), PARAMETER :: Spn9TDzb3 = 252 - INTEGER(IntKi), PARAMETER :: Spn1RDxb3 = 253 - INTEGER(IntKi), PARAMETER :: Spn1RDyb3 = 254 - INTEGER(IntKi), PARAMETER :: Spn1RDzb3 = 255 - INTEGER(IntKi), PARAMETER :: Spn2RDxb3 = 256 - INTEGER(IntKi), PARAMETER :: Spn2RDyb3 = 257 - INTEGER(IntKi), PARAMETER :: Spn2RDzb3 = 258 - INTEGER(IntKi), PARAMETER :: Spn3RDxb3 = 259 - INTEGER(IntKi), PARAMETER :: Spn3RDyb3 = 260 - INTEGER(IntKi), PARAMETER :: Spn3RDzb3 = 261 - INTEGER(IntKi), PARAMETER :: Spn4RDxb3 = 262 - INTEGER(IntKi), PARAMETER :: Spn4RDyb3 = 263 - INTEGER(IntKi), PARAMETER :: Spn4RDzb3 = 264 - INTEGER(IntKi), PARAMETER :: Spn5RDxb3 = 265 - INTEGER(IntKi), PARAMETER :: Spn5RDyb3 = 266 - INTEGER(IntKi), PARAMETER :: Spn5RDzb3 = 267 - INTEGER(IntKi), PARAMETER :: Spn6RDxb3 = 268 - INTEGER(IntKi), PARAMETER :: Spn6RDyb3 = 269 - INTEGER(IntKi), PARAMETER :: Spn6RDzb3 = 270 - INTEGER(IntKi), PARAMETER :: Spn7RDxb3 = 271 - INTEGER(IntKi), PARAMETER :: Spn7RDyb3 = 272 - INTEGER(IntKi), PARAMETER :: Spn7RDzb3 = 273 - INTEGER(IntKi), PARAMETER :: Spn8RDxb3 = 274 - INTEGER(IntKi), PARAMETER :: Spn8RDyb3 = 275 - INTEGER(IntKi), PARAMETER :: Spn8RDzb3 = 276 - INTEGER(IntKi), PARAMETER :: Spn9RDxb3 = 277 - INTEGER(IntKi), PARAMETER :: Spn9RDyb3 = 278 - INTEGER(IntKi), PARAMETER :: Spn9RDzb3 = 279 + INTEGER(IntKi), PARAMETER :: Spn1ALxb3 = 262 + INTEGER(IntKi), PARAMETER :: Spn1ALyb3 = 263 + INTEGER(IntKi), PARAMETER :: Spn1ALzb3 = 264 + INTEGER(IntKi), PARAMETER :: Spn2ALxb3 = 265 + INTEGER(IntKi), PARAMETER :: Spn2ALyb3 = 266 + INTEGER(IntKi), PARAMETER :: Spn2ALzb3 = 267 + INTEGER(IntKi), PARAMETER :: Spn3ALxb3 = 268 + INTEGER(IntKi), PARAMETER :: Spn3ALyb3 = 269 + INTEGER(IntKi), PARAMETER :: Spn3ALzb3 = 270 + INTEGER(IntKi), PARAMETER :: Spn4ALxb3 = 271 + INTEGER(IntKi), PARAMETER :: Spn4ALyb3 = 272 + INTEGER(IntKi), PARAMETER :: Spn4ALzb3 = 273 + INTEGER(IntKi), PARAMETER :: Spn5ALxb3 = 274 + INTEGER(IntKi), PARAMETER :: Spn5ALyb3 = 275 + INTEGER(IntKi), PARAMETER :: Spn5ALzb3 = 276 + INTEGER(IntKi), PARAMETER :: Spn6ALxb3 = 277 + INTEGER(IntKi), PARAMETER :: Spn6ALyb3 = 278 + INTEGER(IntKi), PARAMETER :: Spn6ALzb3 = 279 + INTEGER(IntKi), PARAMETER :: Spn7ALxb3 = 280 + INTEGER(IntKi), PARAMETER :: Spn7ALyb3 = 281 + INTEGER(IntKi), PARAMETER :: Spn7ALzb3 = 282 + INTEGER(IntKi), PARAMETER :: Spn8ALxb3 = 283 + INTEGER(IntKi), PARAMETER :: Spn8ALyb3 = 284 + INTEGER(IntKi), PARAMETER :: Spn8ALzb3 = 285 + INTEGER(IntKi), PARAMETER :: Spn9ALxb3 = 286 + INTEGER(IntKi), PARAMETER :: Spn9ALyb3 = 287 + INTEGER(IntKi), PARAMETER :: Spn9ALzb3 = 288 + INTEGER(IntKi), PARAMETER :: Spn1ALgxb3 = 289 + INTEGER(IntKi), PARAMETER :: Spn1ALgyb3 = 290 + INTEGER(IntKi), PARAMETER :: Spn1ALgzb3 = 291 + INTEGER(IntKi), PARAMETER :: Spn2ALgxb3 = 292 + INTEGER(IntKi), PARAMETER :: Spn2ALgyb3 = 293 + INTEGER(IntKi), PARAMETER :: Spn2ALgzb3 = 294 + INTEGER(IntKi), PARAMETER :: Spn3ALgxb3 = 295 + INTEGER(IntKi), PARAMETER :: Spn3ALgyb3 = 296 + INTEGER(IntKi), PARAMETER :: Spn3ALgzb3 = 297 + INTEGER(IntKi), PARAMETER :: Spn4ALgxb3 = 298 + INTEGER(IntKi), PARAMETER :: Spn4ALgyb3 = 299 + INTEGER(IntKi), PARAMETER :: Spn4ALgzb3 = 300 + INTEGER(IntKi), PARAMETER :: Spn5ALgxb3 = 301 + INTEGER(IntKi), PARAMETER :: Spn5ALgyb3 = 302 + INTEGER(IntKi), PARAMETER :: Spn5ALgzb3 = 303 + INTEGER(IntKi), PARAMETER :: Spn6ALgxb3 = 304 + INTEGER(IntKi), PARAMETER :: Spn6ALgyb3 = 305 + INTEGER(IntKi), PARAMETER :: Spn6ALgzb3 = 306 + INTEGER(IntKi), PARAMETER :: Spn7ALgxb3 = 307 + INTEGER(IntKi), PARAMETER :: Spn7ALgyb3 = 308 + INTEGER(IntKi), PARAMETER :: Spn7ALgzb3 = 309 + INTEGER(IntKi), PARAMETER :: Spn8ALgxb3 = 310 + INTEGER(IntKi), PARAMETER :: Spn8ALgyb3 = 311 + INTEGER(IntKi), PARAMETER :: Spn8ALgzb3 = 312 + INTEGER(IntKi), PARAMETER :: Spn9ALgxb3 = 313 + INTEGER(IntKi), PARAMETER :: Spn9ALgyb3 = 314 + INTEGER(IntKi), PARAMETER :: Spn9ALgzb3 = 315 + INTEGER(IntKi), PARAMETER :: Spn1TDxb3 = 316 + INTEGER(IntKi), PARAMETER :: Spn1TDyb3 = 317 + INTEGER(IntKi), PARAMETER :: Spn1TDzb3 = 318 + INTEGER(IntKi), PARAMETER :: Spn2TDxb3 = 319 + INTEGER(IntKi), PARAMETER :: Spn2TDyb3 = 320 + INTEGER(IntKi), PARAMETER :: Spn2TDzb3 = 321 + INTEGER(IntKi), PARAMETER :: Spn3TDxb3 = 322 + INTEGER(IntKi), PARAMETER :: Spn3TDyb3 = 323 + INTEGER(IntKi), PARAMETER :: Spn3TDzb3 = 324 + INTEGER(IntKi), PARAMETER :: Spn4TDxb3 = 325 + INTEGER(IntKi), PARAMETER :: Spn4TDyb3 = 326 + INTEGER(IntKi), PARAMETER :: Spn4TDzb3 = 327 + INTEGER(IntKi), PARAMETER :: Spn5TDxb3 = 328 + INTEGER(IntKi), PARAMETER :: Spn5TDyb3 = 329 + INTEGER(IntKi), PARAMETER :: Spn5TDzb3 = 330 + INTEGER(IntKi), PARAMETER :: Spn6TDxb3 = 331 + INTEGER(IntKi), PARAMETER :: Spn6TDyb3 = 332 + INTEGER(IntKi), PARAMETER :: Spn6TDzb3 = 333 + INTEGER(IntKi), PARAMETER :: Spn7TDxb3 = 334 + INTEGER(IntKi), PARAMETER :: Spn7TDyb3 = 335 + INTEGER(IntKi), PARAMETER :: Spn7TDzb3 = 336 + INTEGER(IntKi), PARAMETER :: Spn8TDxb3 = 337 + INTEGER(IntKi), PARAMETER :: Spn8TDyb3 = 338 + INTEGER(IntKi), PARAMETER :: Spn8TDzb3 = 339 + INTEGER(IntKi), PARAMETER :: Spn9TDxb3 = 340 + INTEGER(IntKi), PARAMETER :: Spn9TDyb3 = 341 + INTEGER(IntKi), PARAMETER :: Spn9TDzb3 = 342 + INTEGER(IntKi), PARAMETER :: Spn1RDxb3 = 343 + INTEGER(IntKi), PARAMETER :: Spn1RDyb3 = 344 + INTEGER(IntKi), PARAMETER :: Spn1RDzb3 = 345 + INTEGER(IntKi), PARAMETER :: Spn2RDxb3 = 346 + INTEGER(IntKi), PARAMETER :: Spn2RDyb3 = 347 + INTEGER(IntKi), PARAMETER :: Spn2RDzb3 = 348 + INTEGER(IntKi), PARAMETER :: Spn3RDxb3 = 349 + INTEGER(IntKi), PARAMETER :: Spn3RDyb3 = 350 + INTEGER(IntKi), PARAMETER :: Spn3RDzb3 = 351 + INTEGER(IntKi), PARAMETER :: Spn4RDxb3 = 352 + INTEGER(IntKi), PARAMETER :: Spn4RDyb3 = 353 + INTEGER(IntKi), PARAMETER :: Spn4RDzb3 = 354 + INTEGER(IntKi), PARAMETER :: Spn5RDxb3 = 355 + INTEGER(IntKi), PARAMETER :: Spn5RDyb3 = 356 + INTEGER(IntKi), PARAMETER :: Spn5RDzb3 = 357 + INTEGER(IntKi), PARAMETER :: Spn6RDxb3 = 358 + INTEGER(IntKi), PARAMETER :: Spn6RDyb3 = 359 + INTEGER(IntKi), PARAMETER :: Spn6RDzb3 = 360 + INTEGER(IntKi), PARAMETER :: Spn7RDxb3 = 361 + INTEGER(IntKi), PARAMETER :: Spn7RDyb3 = 362 + INTEGER(IntKi), PARAMETER :: Spn7RDzb3 = 363 + INTEGER(IntKi), PARAMETER :: Spn8RDxb3 = 364 + INTEGER(IntKi), PARAMETER :: Spn8RDyb3 = 365 + INTEGER(IntKi), PARAMETER :: Spn8RDzb3 = 366 + INTEGER(IntKi), PARAMETER :: Spn9RDxb3 = 367 + INTEGER(IntKi), PARAMETER :: Spn9RDyb3 = 368 + INTEGER(IntKi), PARAMETER :: Spn9RDzb3 = 369 ! Blade Pitch Motions: - INTEGER(IntKi), PARAMETER :: PtchPMzc1 = 280 - INTEGER(IntKi), PARAMETER :: PtchPMzc2 = 281 - INTEGER(IntKi), PARAMETER :: PtchPMzc3 = 282 + INTEGER(IntKi), PARAMETER :: PtchPMzc1 = 370 + INTEGER(IntKi), PARAMETER :: PtchPMzc2 = 371 + INTEGER(IntKi), PARAMETER :: PtchPMzc3 = 372 ! Teeter Motions: - INTEGER(IntKi), PARAMETER :: TeetPya = 283 - INTEGER(IntKi), PARAMETER :: TeetVya = 284 - INTEGER(IntKi), PARAMETER :: TeetAya = 285 + INTEGER(IntKi), PARAMETER :: TeetPya = 373 + INTEGER(IntKi), PARAMETER :: TeetVya = 374 + INTEGER(IntKi), PARAMETER :: TeetAya = 375 ! Shaft Motions: - INTEGER(IntKi), PARAMETER :: LSSTipPxa = 286 - INTEGER(IntKi), PARAMETER :: LSSTipVxa = 287 - INTEGER(IntKi), PARAMETER :: LSSTipAxa = 288 - INTEGER(IntKi), PARAMETER :: LSSGagPxa = 289 - INTEGER(IntKi), PARAMETER :: LSSGagVxa = 290 - INTEGER(IntKi), PARAMETER :: LSSGagAxa = 291 - INTEGER(IntKi), PARAMETER :: HSShftV = 292 - INTEGER(IntKi), PARAMETER :: HSShftA = 293 + INTEGER(IntKi), PARAMETER :: LSSTipPxa = 376 + INTEGER(IntKi), PARAMETER :: LSSTipVxa = 377 + INTEGER(IntKi), PARAMETER :: LSSTipAxa = 378 + INTEGER(IntKi), PARAMETER :: LSSGagPxa = 379 + INTEGER(IntKi), PARAMETER :: LSSGagVxa = 380 + INTEGER(IntKi), PARAMETER :: LSSGagAxa = 381 + INTEGER(IntKi), PARAMETER :: HSShftV = 382 + INTEGER(IntKi), PARAMETER :: HSShftA = 383 ! Nacelle IMU Motions: - INTEGER(IntKi), PARAMETER :: NcIMUTVxs = 294 - INTEGER(IntKi), PARAMETER :: NcIMUTVys = 295 - INTEGER(IntKi), PARAMETER :: NcIMUTVzs = 296 - INTEGER(IntKi), PARAMETER :: NcIMUTAxs = 297 - INTEGER(IntKi), PARAMETER :: NcIMUTAys = 298 - INTEGER(IntKi), PARAMETER :: NcIMUTAzs = 299 - INTEGER(IntKi), PARAMETER :: NcIMURVxs = 300 - INTEGER(IntKi), PARAMETER :: NcIMURVys = 301 - INTEGER(IntKi), PARAMETER :: NcIMURVzs = 302 - INTEGER(IntKi), PARAMETER :: NcIMURAxs = 303 - INTEGER(IntKi), PARAMETER :: NcIMURAys = 304 - INTEGER(IntKi), PARAMETER :: NcIMURAzs = 305 + INTEGER(IntKi), PARAMETER :: NcIMUTVxs = 384 + INTEGER(IntKi), PARAMETER :: NcIMUTVys = 385 + INTEGER(IntKi), PARAMETER :: NcIMUTVzs = 386 + INTEGER(IntKi), PARAMETER :: NcIMUTAxs = 387 + INTEGER(IntKi), PARAMETER :: NcIMUTAys = 388 + INTEGER(IntKi), PARAMETER :: NcIMUTAzs = 389 + INTEGER(IntKi), PARAMETER :: NcIMUTAgxs = 390 + INTEGER(IntKi), PARAMETER :: NcIMUTAgys = 391 + INTEGER(IntKi), PARAMETER :: NcIMUTAgzs = 392 + INTEGER(IntKi), PARAMETER :: NcIMURVxs = 393 + INTEGER(IntKi), PARAMETER :: NcIMURVys = 394 + INTEGER(IntKi), PARAMETER :: NcIMURVzs = 395 + INTEGER(IntKi), PARAMETER :: NcIMURAxs = 396 + INTEGER(IntKi), PARAMETER :: NcIMURAys = 397 + INTEGER(IntKi), PARAMETER :: NcIMURAzs = 398 ! Rotor-Furl Motions: - INTEGER(IntKi), PARAMETER :: RotFurlP = 306 - INTEGER(IntKi), PARAMETER :: RotFurlV = 307 - INTEGER(IntKi), PARAMETER :: RotFurlA = 308 + INTEGER(IntKi), PARAMETER :: RotFurlP = 399 + INTEGER(IntKi), PARAMETER :: RotFurlV = 400 + INTEGER(IntKi), PARAMETER :: RotFurlA = 401 ! Tail-Furl Motions: - INTEGER(IntKi), PARAMETER :: TailFurlP = 309 - INTEGER(IntKi), PARAMETER :: TailFurlV = 310 - INTEGER(IntKi), PARAMETER :: TailFurlA = 311 + INTEGER(IntKi), PARAMETER :: TailFurlP = 402 + INTEGER(IntKi), PARAMETER :: TailFurlV = 403 + INTEGER(IntKi), PARAMETER :: TailFurlA = 404 ! Nacelle Yaw Motions: - INTEGER(IntKi), PARAMETER :: YawPzn = 312 - INTEGER(IntKi), PARAMETER :: YawVzn = 313 - INTEGER(IntKi), PARAMETER :: YawAzn = 314 + INTEGER(IntKi), PARAMETER :: YawPzn = 405 + INTEGER(IntKi), PARAMETER :: YawVzn = 406 + INTEGER(IntKi), PARAMETER :: YawAzn = 407 ! Tower-Top / Yaw Bearing Motions: - INTEGER(IntKi), PARAMETER :: TwrTpTDxi = 315 - INTEGER(IntKi), PARAMETER :: TwrTpTDyi = 316 - INTEGER(IntKi), PARAMETER :: TwrTpTDzi = 317 - INTEGER(IntKi), PARAMETER :: YawBrTDxp = 318 - INTEGER(IntKi), PARAMETER :: YawBrTDyp = 319 - INTEGER(IntKi), PARAMETER :: YawBrTDzp = 320 - INTEGER(IntKi), PARAMETER :: YawBrTDxt = 321 - INTEGER(IntKi), PARAMETER :: YawBrTDyt = 322 - INTEGER(IntKi), PARAMETER :: YawBrTDzt = 323 - INTEGER(IntKi), PARAMETER :: YawBrTVxp = 324 - INTEGER(IntKi), PARAMETER :: YawBrTVyp = 325 - INTEGER(IntKi), PARAMETER :: YawBrTVzp = 326 - INTEGER(IntKi), PARAMETER :: YawBrTAxp = 327 - INTEGER(IntKi), PARAMETER :: YawBrTAyp = 328 - INTEGER(IntKi), PARAMETER :: YawBrTAzp = 329 - INTEGER(IntKi), PARAMETER :: YawBrRDxt = 330 - INTEGER(IntKi), PARAMETER :: YawBrRDyt = 331 - INTEGER(IntKi), PARAMETER :: YawBrRDzt = 332 - INTEGER(IntKi), PARAMETER :: YawBrRVxp = 333 - INTEGER(IntKi), PARAMETER :: YawBrRVyp = 334 - INTEGER(IntKi), PARAMETER :: YawBrRVzp = 335 - INTEGER(IntKi), PARAMETER :: YawBrRAxp = 336 - INTEGER(IntKi), PARAMETER :: YawBrRAyp = 337 - INTEGER(IntKi), PARAMETER :: YawBrRAzp = 338 + INTEGER(IntKi), PARAMETER :: TwrTpTDxi = 408 + INTEGER(IntKi), PARAMETER :: TwrTpTDyi = 409 + INTEGER(IntKi), PARAMETER :: TwrTpTDzi = 410 + INTEGER(IntKi), PARAMETER :: YawBrTDxp = 411 + INTEGER(IntKi), PARAMETER :: YawBrTDyp = 412 + INTEGER(IntKi), PARAMETER :: YawBrTDzp = 413 + INTEGER(IntKi), PARAMETER :: YawBrTDxt = 414 + INTEGER(IntKi), PARAMETER :: YawBrTDyt = 415 + INTEGER(IntKi), PARAMETER :: YawBrTDzt = 416 + INTEGER(IntKi), PARAMETER :: YawBrTVxp = 417 + INTEGER(IntKi), PARAMETER :: YawBrTVyp = 418 + INTEGER(IntKi), PARAMETER :: YawBrTVzp = 419 + INTEGER(IntKi), PARAMETER :: YawBrTAxp = 420 + INTEGER(IntKi), PARAMETER :: YawBrTAyp = 421 + INTEGER(IntKi), PARAMETER :: YawBrTAzp = 422 + INTEGER(IntKi), PARAMETER :: YawBrTAgxp = 423 + INTEGER(IntKi), PARAMETER :: YawBrTAgyp = 424 + INTEGER(IntKi), PARAMETER :: YawBrTAgzp = 425 + INTEGER(IntKi), PARAMETER :: YawBrRDxt = 426 + INTEGER(IntKi), PARAMETER :: YawBrRDyt = 427 + INTEGER(IntKi), PARAMETER :: YawBrRDzt = 428 + INTEGER(IntKi), PARAMETER :: YawBrRVxp = 429 + INTEGER(IntKi), PARAMETER :: YawBrRVyp = 430 + INTEGER(IntKi), PARAMETER :: YawBrRVzp = 431 + INTEGER(IntKi), PARAMETER :: YawBrRAxp = 432 + INTEGER(IntKi), PARAMETER :: YawBrRAyp = 433 + INTEGER(IntKi), PARAMETER :: YawBrRAzp = 434 ! Local Tower Motions: - INTEGER(IntKi), PARAMETER :: TwHt1ALxt = 339 - INTEGER(IntKi), PARAMETER :: TwHt1ALyt = 340 - INTEGER(IntKi), PARAMETER :: TwHt1ALzt = 341 - INTEGER(IntKi), PARAMETER :: TwHt2ALxt = 342 - INTEGER(IntKi), PARAMETER :: TwHt2ALyt = 343 - INTEGER(IntKi), PARAMETER :: TwHt2ALzt = 344 - INTEGER(IntKi), PARAMETER :: TwHt3ALxt = 345 - INTEGER(IntKi), PARAMETER :: TwHt3ALyt = 346 - INTEGER(IntKi), PARAMETER :: TwHt3ALzt = 347 - INTEGER(IntKi), PARAMETER :: TwHt4ALxt = 348 - INTEGER(IntKi), PARAMETER :: TwHt4ALyt = 349 - INTEGER(IntKi), PARAMETER :: TwHt4ALzt = 350 - INTEGER(IntKi), PARAMETER :: TwHt5ALxt = 351 - INTEGER(IntKi), PARAMETER :: TwHt5ALyt = 352 - INTEGER(IntKi), PARAMETER :: TwHt5ALzt = 353 - INTEGER(IntKi), PARAMETER :: TwHt6ALxt = 354 - INTEGER(IntKi), PARAMETER :: TwHt6ALyt = 355 - INTEGER(IntKi), PARAMETER :: TwHt6ALzt = 356 - INTEGER(IntKi), PARAMETER :: TwHt7ALxt = 357 - INTEGER(IntKi), PARAMETER :: TwHt7ALyt = 358 - INTEGER(IntKi), PARAMETER :: TwHt7ALzt = 359 - INTEGER(IntKi), PARAMETER :: TwHt8ALxt = 360 - INTEGER(IntKi), PARAMETER :: TwHt8ALyt = 361 - INTEGER(IntKi), PARAMETER :: TwHt8ALzt = 362 - INTEGER(IntKi), PARAMETER :: TwHt9ALxt = 363 - INTEGER(IntKi), PARAMETER :: TwHt9ALyt = 364 - INTEGER(IntKi), PARAMETER :: TwHt9ALzt = 365 - INTEGER(IntKi), PARAMETER :: TwHt1TDxt = 366 - INTEGER(IntKi), PARAMETER :: TwHt1TDyt = 367 - INTEGER(IntKi), PARAMETER :: TwHt1TDzt = 368 - INTEGER(IntKi), PARAMETER :: TwHt2TDxt = 369 - INTEGER(IntKi), PARAMETER :: TwHt2TDyt = 370 - INTEGER(IntKi), PARAMETER :: TwHt2TDzt = 371 - INTEGER(IntKi), PARAMETER :: TwHt3TDxt = 372 - INTEGER(IntKi), PARAMETER :: TwHt3TDyt = 373 - INTEGER(IntKi), PARAMETER :: TwHt3TDzt = 374 - INTEGER(IntKi), PARAMETER :: TwHt4TDxt = 375 - INTEGER(IntKi), PARAMETER :: TwHt4TDyt = 376 - INTEGER(IntKi), PARAMETER :: TwHt4TDzt = 377 - INTEGER(IntKi), PARAMETER :: TwHt5TDxt = 378 - INTEGER(IntKi), PARAMETER :: TwHt5TDyt = 379 - INTEGER(IntKi), PARAMETER :: TwHt5TDzt = 380 - INTEGER(IntKi), PARAMETER :: TwHt6TDxt = 381 - INTEGER(IntKi), PARAMETER :: TwHt6TDyt = 382 - INTEGER(IntKi), PARAMETER :: TwHt6TDzt = 383 - INTEGER(IntKi), PARAMETER :: TwHt7TDxt = 384 - INTEGER(IntKi), PARAMETER :: TwHt7TDyt = 385 - INTEGER(IntKi), PARAMETER :: TwHt7TDzt = 386 - INTEGER(IntKi), PARAMETER :: TwHt8TDxt = 387 - INTEGER(IntKi), PARAMETER :: TwHt8TDyt = 388 - INTEGER(IntKi), PARAMETER :: TwHt8TDzt = 389 - INTEGER(IntKi), PARAMETER :: TwHt9TDxt = 390 - INTEGER(IntKi), PARAMETER :: TwHt9TDyt = 391 - INTEGER(IntKi), PARAMETER :: TwHt9TDzt = 392 - INTEGER(IntKi), PARAMETER :: TwHt1RDxt = 393 - INTEGER(IntKi), PARAMETER :: TwHt1RDyt = 394 - INTEGER(IntKi), PARAMETER :: TwHt1RDzt = 395 - INTEGER(IntKi), PARAMETER :: TwHt2RDxt = 396 - INTEGER(IntKi), PARAMETER :: TwHt2RDyt = 397 - INTEGER(IntKi), PARAMETER :: TwHt2RDzt = 398 - INTEGER(IntKi), PARAMETER :: TwHt3RDxt = 399 - INTEGER(IntKi), PARAMETER :: TwHt3RDyt = 400 - INTEGER(IntKi), PARAMETER :: TwHt3RDzt = 401 - INTEGER(IntKi), PARAMETER :: TwHt4RDxt = 402 - INTEGER(IntKi), PARAMETER :: TwHt4RDyt = 403 - INTEGER(IntKi), PARAMETER :: TwHt4RDzt = 404 - INTEGER(IntKi), PARAMETER :: TwHt5RDxt = 405 - INTEGER(IntKi), PARAMETER :: TwHt5RDyt = 406 - INTEGER(IntKi), PARAMETER :: TwHt5RDzt = 407 - INTEGER(IntKi), PARAMETER :: TwHt6RDxt = 408 - INTEGER(IntKi), PARAMETER :: TwHt6RDyt = 409 - INTEGER(IntKi), PARAMETER :: TwHt6RDzt = 410 - INTEGER(IntKi), PARAMETER :: TwHt7RDxt = 411 - INTEGER(IntKi), PARAMETER :: TwHt7RDyt = 412 - INTEGER(IntKi), PARAMETER :: TwHt7RDzt = 413 - INTEGER(IntKi), PARAMETER :: TwHt8RDxt = 414 - INTEGER(IntKi), PARAMETER :: TwHt8RDyt = 415 - INTEGER(IntKi), PARAMETER :: TwHt8RDzt = 416 - INTEGER(IntKi), PARAMETER :: TwHt9RDxt = 417 - INTEGER(IntKi), PARAMETER :: TwHt9RDyt = 418 - INTEGER(IntKi), PARAMETER :: TwHt9RDzt = 419 - INTEGER(IntKi), PARAMETER :: TwHt1TPxi = 420 - INTEGER(IntKi), PARAMETER :: TwHt1TPyi = 421 - INTEGER(IntKi), PARAMETER :: TwHt1TPzi = 422 - INTEGER(IntKi), PARAMETER :: TwHt2TPxi = 423 - INTEGER(IntKi), PARAMETER :: TwHt2TPyi = 424 - INTEGER(IntKi), PARAMETER :: TwHt2TPzi = 425 - INTEGER(IntKi), PARAMETER :: TwHt3TPxi = 426 - INTEGER(IntKi), PARAMETER :: TwHt3TPyi = 427 - INTEGER(IntKi), PARAMETER :: TwHt3TPzi = 428 - INTEGER(IntKi), PARAMETER :: TwHt4TPxi = 429 - INTEGER(IntKi), PARAMETER :: TwHt4TPyi = 430 - INTEGER(IntKi), PARAMETER :: TwHt4TPzi = 431 - INTEGER(IntKi), PARAMETER :: TwHt5TPxi = 432 - INTEGER(IntKi), PARAMETER :: TwHt5TPyi = 433 - INTEGER(IntKi), PARAMETER :: TwHt5TPzi = 434 - INTEGER(IntKi), PARAMETER :: TwHt6TPxi = 435 - INTEGER(IntKi), PARAMETER :: TwHt6TPyi = 436 - INTEGER(IntKi), PARAMETER :: TwHt6TPzi = 437 - INTEGER(IntKi), PARAMETER :: TwHt7TPxi = 438 - INTEGER(IntKi), PARAMETER :: TwHt7TPyi = 439 - INTEGER(IntKi), PARAMETER :: TwHt7TPzi = 440 - INTEGER(IntKi), PARAMETER :: TwHt8TPxi = 441 - INTEGER(IntKi), PARAMETER :: TwHt8TPyi = 442 - INTEGER(IntKi), PARAMETER :: TwHt8TPzi = 443 - INTEGER(IntKi), PARAMETER :: TwHt9TPxi = 444 - INTEGER(IntKi), PARAMETER :: TwHt9TPyi = 445 - INTEGER(IntKi), PARAMETER :: TwHt9TPzi = 446 - INTEGER(IntKi), PARAMETER :: TwHt1RPxi = 447 - INTEGER(IntKi), PARAMETER :: TwHt1RPyi = 448 - INTEGER(IntKi), PARAMETER :: TwHt1RPzi = 449 - INTEGER(IntKi), PARAMETER :: TwHt2RPxi = 450 - INTEGER(IntKi), PARAMETER :: TwHt2RPyi = 451 - INTEGER(IntKi), PARAMETER :: TwHt2RPzi = 452 - INTEGER(IntKi), PARAMETER :: TwHt3RPxi = 453 - INTEGER(IntKi), PARAMETER :: TwHt3RPyi = 454 - INTEGER(IntKi), PARAMETER :: TwHt3RPzi = 455 - INTEGER(IntKi), PARAMETER :: TwHt4RPxi = 456 - INTEGER(IntKi), PARAMETER :: TwHt4RPyi = 457 - INTEGER(IntKi), PARAMETER :: TwHt4RPzi = 458 - INTEGER(IntKi), PARAMETER :: TwHt5RPxi = 459 - INTEGER(IntKi), PARAMETER :: TwHt5RPyi = 460 - INTEGER(IntKi), PARAMETER :: TwHt5RPzi = 461 - INTEGER(IntKi), PARAMETER :: TwHt6RPxi = 462 - INTEGER(IntKi), PARAMETER :: TwHt6RPyi = 463 - INTEGER(IntKi), PARAMETER :: TwHt6RPzi = 464 - INTEGER(IntKi), PARAMETER :: TwHt7RPxi = 465 - INTEGER(IntKi), PARAMETER :: TwHt7RPyi = 466 - INTEGER(IntKi), PARAMETER :: TwHt7RPzi = 467 - INTEGER(IntKi), PARAMETER :: TwHt8RPxi = 468 - INTEGER(IntKi), PARAMETER :: TwHt8RPyi = 469 - INTEGER(IntKi), PARAMETER :: TwHt8RPzi = 470 - INTEGER(IntKi), PARAMETER :: TwHt9RPxi = 471 - INTEGER(IntKi), PARAMETER :: TwHt9RPyi = 472 - INTEGER(IntKi), PARAMETER :: TwHt9RPzi = 473 + INTEGER(IntKi), PARAMETER :: TwHt1ALxt = 435 + INTEGER(IntKi), PARAMETER :: TwHt1ALyt = 436 + INTEGER(IntKi), PARAMETER :: TwHt1ALzt = 437 + INTEGER(IntKi), PARAMETER :: TwHt2ALxt = 438 + INTEGER(IntKi), PARAMETER :: TwHt2ALyt = 439 + INTEGER(IntKi), PARAMETER :: TwHt2ALzt = 440 + INTEGER(IntKi), PARAMETER :: TwHt3ALxt = 441 + INTEGER(IntKi), PARAMETER :: TwHt3ALyt = 442 + INTEGER(IntKi), PARAMETER :: TwHt3ALzt = 443 + INTEGER(IntKi), PARAMETER :: TwHt4ALxt = 444 + INTEGER(IntKi), PARAMETER :: TwHt4ALyt = 445 + INTEGER(IntKi), PARAMETER :: TwHt4ALzt = 446 + INTEGER(IntKi), PARAMETER :: TwHt5ALxt = 447 + INTEGER(IntKi), PARAMETER :: TwHt5ALyt = 448 + INTEGER(IntKi), PARAMETER :: TwHt5ALzt = 449 + INTEGER(IntKi), PARAMETER :: TwHt6ALxt = 450 + INTEGER(IntKi), PARAMETER :: TwHt6ALyt = 451 + INTEGER(IntKi), PARAMETER :: TwHt6ALzt = 452 + INTEGER(IntKi), PARAMETER :: TwHt7ALxt = 453 + INTEGER(IntKi), PARAMETER :: TwHt7ALyt = 454 + INTEGER(IntKi), PARAMETER :: TwHt7ALzt = 455 + INTEGER(IntKi), PARAMETER :: TwHt8ALxt = 456 + INTEGER(IntKi), PARAMETER :: TwHt8ALyt = 457 + INTEGER(IntKi), PARAMETER :: TwHt8ALzt = 458 + INTEGER(IntKi), PARAMETER :: TwHt9ALxt = 459 + INTEGER(IntKi), PARAMETER :: TwHt9ALyt = 460 + INTEGER(IntKi), PARAMETER :: TwHt9ALzt = 461 + INTEGER(IntKi), PARAMETER :: TwHt1ALgxt = 462 + INTEGER(IntKi), PARAMETER :: TwHt1ALgyt = 463 + INTEGER(IntKi), PARAMETER :: TwHt1ALgzt = 464 + INTEGER(IntKi), PARAMETER :: TwHt2ALgxt = 465 + INTEGER(IntKi), PARAMETER :: TwHt2ALgyt = 466 + INTEGER(IntKi), PARAMETER :: TwHt2ALgzt = 467 + INTEGER(IntKi), PARAMETER :: TwHt3ALgxt = 468 + INTEGER(IntKi), PARAMETER :: TwHt3ALgyt = 469 + INTEGER(IntKi), PARAMETER :: TwHt3ALgzt = 470 + INTEGER(IntKi), PARAMETER :: TwHt4ALgxt = 471 + INTEGER(IntKi), PARAMETER :: TwHt4ALgyt = 472 + INTEGER(IntKi), PARAMETER :: TwHt4ALgzt = 473 + INTEGER(IntKi), PARAMETER :: TwHt5ALgxt = 474 + INTEGER(IntKi), PARAMETER :: TwHt5ALgyt = 475 + INTEGER(IntKi), PARAMETER :: TwHt5ALgzt = 476 + INTEGER(IntKi), PARAMETER :: TwHt6ALgxt = 477 + INTEGER(IntKi), PARAMETER :: TwHt6ALgyt = 478 + INTEGER(IntKi), PARAMETER :: TwHt6ALgzt = 479 + INTEGER(IntKi), PARAMETER :: TwHt7ALgxt = 480 + INTEGER(IntKi), PARAMETER :: TwHt7ALgyt = 481 + INTEGER(IntKi), PARAMETER :: TwHt7ALgzt = 482 + INTEGER(IntKi), PARAMETER :: TwHt8ALgxt = 483 + INTEGER(IntKi), PARAMETER :: TwHt8ALgyt = 484 + INTEGER(IntKi), PARAMETER :: TwHt8ALgzt = 485 + INTEGER(IntKi), PARAMETER :: TwHt9ALgxt = 486 + INTEGER(IntKi), PARAMETER :: TwHt9ALgyt = 487 + INTEGER(IntKi), PARAMETER :: TwHt9ALgzt = 488 + INTEGER(IntKi), PARAMETER :: TwHt1TDxt = 489 + INTEGER(IntKi), PARAMETER :: TwHt1TDyt = 490 + INTEGER(IntKi), PARAMETER :: TwHt1TDzt = 491 + INTEGER(IntKi), PARAMETER :: TwHt2TDxt = 492 + INTEGER(IntKi), PARAMETER :: TwHt2TDyt = 493 + INTEGER(IntKi), PARAMETER :: TwHt2TDzt = 494 + INTEGER(IntKi), PARAMETER :: TwHt3TDxt = 495 + INTEGER(IntKi), PARAMETER :: TwHt3TDyt = 496 + INTEGER(IntKi), PARAMETER :: TwHt3TDzt = 497 + INTEGER(IntKi), PARAMETER :: TwHt4TDxt = 498 + INTEGER(IntKi), PARAMETER :: TwHt4TDyt = 499 + INTEGER(IntKi), PARAMETER :: TwHt4TDzt = 500 + INTEGER(IntKi), PARAMETER :: TwHt5TDxt = 501 + INTEGER(IntKi), PARAMETER :: TwHt5TDyt = 502 + INTEGER(IntKi), PARAMETER :: TwHt5TDzt = 503 + INTEGER(IntKi), PARAMETER :: TwHt6TDxt = 504 + INTEGER(IntKi), PARAMETER :: TwHt6TDyt = 505 + INTEGER(IntKi), PARAMETER :: TwHt6TDzt = 506 + INTEGER(IntKi), PARAMETER :: TwHt7TDxt = 507 + INTEGER(IntKi), PARAMETER :: TwHt7TDyt = 508 + INTEGER(IntKi), PARAMETER :: TwHt7TDzt = 509 + INTEGER(IntKi), PARAMETER :: TwHt8TDxt = 510 + INTEGER(IntKi), PARAMETER :: TwHt8TDyt = 511 + INTEGER(IntKi), PARAMETER :: TwHt8TDzt = 512 + INTEGER(IntKi), PARAMETER :: TwHt9TDxt = 513 + INTEGER(IntKi), PARAMETER :: TwHt9TDyt = 514 + INTEGER(IntKi), PARAMETER :: TwHt9TDzt = 515 + INTEGER(IntKi), PARAMETER :: TwHt1RDxt = 516 + INTEGER(IntKi), PARAMETER :: TwHt1RDyt = 517 + INTEGER(IntKi), PARAMETER :: TwHt1RDzt = 518 + INTEGER(IntKi), PARAMETER :: TwHt2RDxt = 519 + INTEGER(IntKi), PARAMETER :: TwHt2RDyt = 520 + INTEGER(IntKi), PARAMETER :: TwHt2RDzt = 521 + INTEGER(IntKi), PARAMETER :: TwHt3RDxt = 522 + INTEGER(IntKi), PARAMETER :: TwHt3RDyt = 523 + INTEGER(IntKi), PARAMETER :: TwHt3RDzt = 524 + INTEGER(IntKi), PARAMETER :: TwHt4RDxt = 525 + INTEGER(IntKi), PARAMETER :: TwHt4RDyt = 526 + INTEGER(IntKi), PARAMETER :: TwHt4RDzt = 527 + INTEGER(IntKi), PARAMETER :: TwHt5RDxt = 528 + INTEGER(IntKi), PARAMETER :: TwHt5RDyt = 529 + INTEGER(IntKi), PARAMETER :: TwHt5RDzt = 530 + INTEGER(IntKi), PARAMETER :: TwHt6RDxt = 531 + INTEGER(IntKi), PARAMETER :: TwHt6RDyt = 532 + INTEGER(IntKi), PARAMETER :: TwHt6RDzt = 533 + INTEGER(IntKi), PARAMETER :: TwHt7RDxt = 534 + INTEGER(IntKi), PARAMETER :: TwHt7RDyt = 535 + INTEGER(IntKi), PARAMETER :: TwHt7RDzt = 536 + INTEGER(IntKi), PARAMETER :: TwHt8RDxt = 537 + INTEGER(IntKi), PARAMETER :: TwHt8RDyt = 538 + INTEGER(IntKi), PARAMETER :: TwHt8RDzt = 539 + INTEGER(IntKi), PARAMETER :: TwHt9RDxt = 540 + INTEGER(IntKi), PARAMETER :: TwHt9RDyt = 541 + INTEGER(IntKi), PARAMETER :: TwHt9RDzt = 542 + INTEGER(IntKi), PARAMETER :: TwHt1TPxi = 543 + INTEGER(IntKi), PARAMETER :: TwHt1TPyi = 544 + INTEGER(IntKi), PARAMETER :: TwHt1TPzi = 545 + INTEGER(IntKi), PARAMETER :: TwHt2TPxi = 546 + INTEGER(IntKi), PARAMETER :: TwHt2TPyi = 547 + INTEGER(IntKi), PARAMETER :: TwHt2TPzi = 548 + INTEGER(IntKi), PARAMETER :: TwHt3TPxi = 549 + INTEGER(IntKi), PARAMETER :: TwHt3TPyi = 550 + INTEGER(IntKi), PARAMETER :: TwHt3TPzi = 551 + INTEGER(IntKi), PARAMETER :: TwHt4TPxi = 552 + INTEGER(IntKi), PARAMETER :: TwHt4TPyi = 553 + INTEGER(IntKi), PARAMETER :: TwHt4TPzi = 554 + INTEGER(IntKi), PARAMETER :: TwHt5TPxi = 555 + INTEGER(IntKi), PARAMETER :: TwHt5TPyi = 556 + INTEGER(IntKi), PARAMETER :: TwHt5TPzi = 557 + INTEGER(IntKi), PARAMETER :: TwHt6TPxi = 558 + INTEGER(IntKi), PARAMETER :: TwHt6TPyi = 559 + INTEGER(IntKi), PARAMETER :: TwHt6TPzi = 560 + INTEGER(IntKi), PARAMETER :: TwHt7TPxi = 561 + INTEGER(IntKi), PARAMETER :: TwHt7TPyi = 562 + INTEGER(IntKi), PARAMETER :: TwHt7TPzi = 563 + INTEGER(IntKi), PARAMETER :: TwHt8TPxi = 564 + INTEGER(IntKi), PARAMETER :: TwHt8TPyi = 565 + INTEGER(IntKi), PARAMETER :: TwHt8TPzi = 566 + INTEGER(IntKi), PARAMETER :: TwHt9TPxi = 567 + INTEGER(IntKi), PARAMETER :: TwHt9TPyi = 568 + INTEGER(IntKi), PARAMETER :: TwHt9TPzi = 569 + INTEGER(IntKi), PARAMETER :: TwHt1RPxi = 570 + INTEGER(IntKi), PARAMETER :: TwHt1RPyi = 571 + INTEGER(IntKi), PARAMETER :: TwHt1RPzi = 572 + INTEGER(IntKi), PARAMETER :: TwHt2RPxi = 573 + INTEGER(IntKi), PARAMETER :: TwHt2RPyi = 574 + INTEGER(IntKi), PARAMETER :: TwHt2RPzi = 575 + INTEGER(IntKi), PARAMETER :: TwHt3RPxi = 576 + INTEGER(IntKi), PARAMETER :: TwHt3RPyi = 577 + INTEGER(IntKi), PARAMETER :: TwHt3RPzi = 578 + INTEGER(IntKi), PARAMETER :: TwHt4RPxi = 579 + INTEGER(IntKi), PARAMETER :: TwHt4RPyi = 580 + INTEGER(IntKi), PARAMETER :: TwHt4RPzi = 581 + INTEGER(IntKi), PARAMETER :: TwHt5RPxi = 582 + INTEGER(IntKi), PARAMETER :: TwHt5RPyi = 583 + INTEGER(IntKi), PARAMETER :: TwHt5RPzi = 584 + INTEGER(IntKi), PARAMETER :: TwHt6RPxi = 585 + INTEGER(IntKi), PARAMETER :: TwHt6RPyi = 586 + INTEGER(IntKi), PARAMETER :: TwHt6RPzi = 587 + INTEGER(IntKi), PARAMETER :: TwHt7RPxi = 588 + INTEGER(IntKi), PARAMETER :: TwHt7RPyi = 589 + INTEGER(IntKi), PARAMETER :: TwHt7RPzi = 590 + INTEGER(IntKi), PARAMETER :: TwHt8RPxi = 591 + INTEGER(IntKi), PARAMETER :: TwHt8RPyi = 592 + INTEGER(IntKi), PARAMETER :: TwHt8RPzi = 593 + INTEGER(IntKi), PARAMETER :: TwHt9RPxi = 594 + INTEGER(IntKi), PARAMETER :: TwHt9RPyi = 595 + INTEGER(IntKi), PARAMETER :: TwHt9RPzi = 596 ! Platform Motions: - INTEGER(IntKi), PARAMETER :: PtfmTDxt = 474 - INTEGER(IntKi), PARAMETER :: PtfmTDyt = 475 - INTEGER(IntKi), PARAMETER :: PtfmTDzt = 476 - INTEGER(IntKi), PARAMETER :: PtfmTDxi = 477 - INTEGER(IntKi), PARAMETER :: PtfmTDyi = 478 - INTEGER(IntKi), PARAMETER :: PtfmTDzi = 479 - INTEGER(IntKi), PARAMETER :: PtfmTVxt = 480 - INTEGER(IntKi), PARAMETER :: PtfmTVyt = 481 - INTEGER(IntKi), PARAMETER :: PtfmTVzt = 482 - INTEGER(IntKi), PARAMETER :: PtfmTVxi = 483 - INTEGER(IntKi), PARAMETER :: PtfmTVyi = 484 - INTEGER(IntKi), PARAMETER :: PtfmTVzi = 485 - INTEGER(IntKi), PARAMETER :: PtfmTAxt = 486 - INTEGER(IntKi), PARAMETER :: PtfmTAyt = 487 - INTEGER(IntKi), PARAMETER :: PtfmTAzt = 488 - INTEGER(IntKi), PARAMETER :: PtfmTAxi = 489 - INTEGER(IntKi), PARAMETER :: PtfmTAyi = 490 - INTEGER(IntKi), PARAMETER :: PtfmTAzi = 491 - INTEGER(IntKi), PARAMETER :: PtfmRDxi = 492 - INTEGER(IntKi), PARAMETER :: PtfmRDyi = 493 - INTEGER(IntKi), PARAMETER :: PtfmRDzi = 494 - INTEGER(IntKi), PARAMETER :: PtfmRVxt = 495 - INTEGER(IntKi), PARAMETER :: PtfmRVyt = 496 - INTEGER(IntKi), PARAMETER :: PtfmRVzt = 497 - INTEGER(IntKi), PARAMETER :: PtfmRVxi = 498 - INTEGER(IntKi), PARAMETER :: PtfmRVyi = 499 - INTEGER(IntKi), PARAMETER :: PtfmRVzi = 500 - INTEGER(IntKi), PARAMETER :: PtfmRAxt = 501 - INTEGER(IntKi), PARAMETER :: PtfmRAyt = 502 - INTEGER(IntKi), PARAMETER :: PtfmRAzt = 503 - INTEGER(IntKi), PARAMETER :: PtfmRAxi = 504 - INTEGER(IntKi), PARAMETER :: PtfmRAyi = 505 - INTEGER(IntKi), PARAMETER :: PtfmRAzi = 506 + INTEGER(IntKi), PARAMETER :: PtfmTDxt = 597 + INTEGER(IntKi), PARAMETER :: PtfmTDyt = 598 + INTEGER(IntKi), PARAMETER :: PtfmTDzt = 599 + INTEGER(IntKi), PARAMETER :: PtfmTDxi = 600 + INTEGER(IntKi), PARAMETER :: PtfmTDyi = 601 + INTEGER(IntKi), PARAMETER :: PtfmTDzi = 602 + INTEGER(IntKi), PARAMETER :: PtfmTVxt = 603 + INTEGER(IntKi), PARAMETER :: PtfmTVyt = 604 + INTEGER(IntKi), PARAMETER :: PtfmTVzt = 605 + INTEGER(IntKi), PARAMETER :: PtfmTVxi = 606 + INTEGER(IntKi), PARAMETER :: PtfmTVyi = 607 + INTEGER(IntKi), PARAMETER :: PtfmTVzi = 608 + INTEGER(IntKi), PARAMETER :: PtfmTAxt = 609 + INTEGER(IntKi), PARAMETER :: PtfmTAyt = 610 + INTEGER(IntKi), PARAMETER :: PtfmTAzt = 611 + INTEGER(IntKi), PARAMETER :: PtfmTAgxt = 612 + INTEGER(IntKi), PARAMETER :: PtfmTAgyt = 613 + INTEGER(IntKi), PARAMETER :: PtfmTAgzt = 614 + INTEGER(IntKi), PARAMETER :: PtfmTAxi = 615 + INTEGER(IntKi), PARAMETER :: PtfmTAyi = 616 + INTEGER(IntKi), PARAMETER :: PtfmTAzi = 617 + INTEGER(IntKi), PARAMETER :: PtfmTAgxi = 618 + INTEGER(IntKi), PARAMETER :: PtfmTAgyi = 619 + INTEGER(IntKi), PARAMETER :: PtfmTAgzi = 620 + INTEGER(IntKi), PARAMETER :: PtfmRDxi = 621 + INTEGER(IntKi), PARAMETER :: PtfmRDyi = 622 + INTEGER(IntKi), PARAMETER :: PtfmRDzi = 623 + INTEGER(IntKi), PARAMETER :: PtfmRVxt = 624 + INTEGER(IntKi), PARAMETER :: PtfmRVyt = 625 + INTEGER(IntKi), PARAMETER :: PtfmRVzt = 626 + INTEGER(IntKi), PARAMETER :: PtfmRVxi = 627 + INTEGER(IntKi), PARAMETER :: PtfmRVyi = 628 + INTEGER(IntKi), PARAMETER :: PtfmRVzi = 629 + INTEGER(IntKi), PARAMETER :: PtfmRAxt = 630 + INTEGER(IntKi), PARAMETER :: PtfmRAyt = 631 + INTEGER(IntKi), PARAMETER :: PtfmRAzt = 632 + INTEGER(IntKi), PARAMETER :: PtfmRAxi = 633 + INTEGER(IntKi), PARAMETER :: PtfmRAyi = 634 + INTEGER(IntKi), PARAMETER :: PtfmRAzi = 635 ! Blade 1 Root Loads: - INTEGER(IntKi), PARAMETER :: RootFxc1 = 507 - INTEGER(IntKi), PARAMETER :: RootFyc1 = 508 - INTEGER(IntKi), PARAMETER :: RootFzc1 = 509 - INTEGER(IntKi), PARAMETER :: RootFxb1 = 510 - INTEGER(IntKi), PARAMETER :: RootFyb1 = 511 - INTEGER(IntKi), PARAMETER :: RootMxc1 = 512 - INTEGER(IntKi), PARAMETER :: RootMyc1 = 513 - INTEGER(IntKi), PARAMETER :: RootMzc1 = 514 - INTEGER(IntKi), PARAMETER :: RootMxb1 = 515 - INTEGER(IntKi), PARAMETER :: RootMyb1 = 516 + INTEGER(IntKi), PARAMETER :: RootFxc1 = 636 + INTEGER(IntKi), PARAMETER :: RootFyc1 = 637 + INTEGER(IntKi), PARAMETER :: RootFzc1 = 638 + INTEGER(IntKi), PARAMETER :: RootFxb1 = 639 + INTEGER(IntKi), PARAMETER :: RootFyb1 = 640 + INTEGER(IntKi), PARAMETER :: RootMxc1 = 641 + INTEGER(IntKi), PARAMETER :: RootMyc1 = 642 + INTEGER(IntKi), PARAMETER :: RootMzc1 = 643 + INTEGER(IntKi), PARAMETER :: RootMxb1 = 644 + INTEGER(IntKi), PARAMETER :: RootMyb1 = 645 ! Blade 2 Root Loads: - INTEGER(IntKi), PARAMETER :: RootFxc2 = 517 - INTEGER(IntKi), PARAMETER :: RootFyc2 = 518 - INTEGER(IntKi), PARAMETER :: RootFzc2 = 519 - INTEGER(IntKi), PARAMETER :: RootFxb2 = 520 - INTEGER(IntKi), PARAMETER :: RootFyb2 = 521 - INTEGER(IntKi), PARAMETER :: RootMxc2 = 522 - INTEGER(IntKi), PARAMETER :: RootMyc2 = 523 - INTEGER(IntKi), PARAMETER :: RootMzc2 = 524 - INTEGER(IntKi), PARAMETER :: RootMxb2 = 525 - INTEGER(IntKi), PARAMETER :: RootMyb2 = 526 + INTEGER(IntKi), PARAMETER :: RootFxc2 = 646 + INTEGER(IntKi), PARAMETER :: RootFyc2 = 647 + INTEGER(IntKi), PARAMETER :: RootFzc2 = 648 + INTEGER(IntKi), PARAMETER :: RootFxb2 = 649 + INTEGER(IntKi), PARAMETER :: RootFyb2 = 650 + INTEGER(IntKi), PARAMETER :: RootMxc2 = 651 + INTEGER(IntKi), PARAMETER :: RootMyc2 = 652 + INTEGER(IntKi), PARAMETER :: RootMzc2 = 653 + INTEGER(IntKi), PARAMETER :: RootMxb2 = 654 + INTEGER(IntKi), PARAMETER :: RootMyb2 = 655 ! Blade 3 Root Loads: - INTEGER(IntKi), PARAMETER :: RootFxc3 = 527 - INTEGER(IntKi), PARAMETER :: RootFyc3 = 528 - INTEGER(IntKi), PARAMETER :: RootFzc3 = 529 - INTEGER(IntKi), PARAMETER :: RootFxb3 = 530 - INTEGER(IntKi), PARAMETER :: RootFyb3 = 531 - INTEGER(IntKi), PARAMETER :: RootMxc3 = 532 - INTEGER(IntKi), PARAMETER :: RootMyc3 = 533 - INTEGER(IntKi), PARAMETER :: RootMzc3 = 534 - INTEGER(IntKi), PARAMETER :: RootMxb3 = 535 - INTEGER(IntKi), PARAMETER :: RootMyb3 = 536 + INTEGER(IntKi), PARAMETER :: RootFxc3 = 656 + INTEGER(IntKi), PARAMETER :: RootFyc3 = 657 + INTEGER(IntKi), PARAMETER :: RootFzc3 = 658 + INTEGER(IntKi), PARAMETER :: RootFxb3 = 659 + INTEGER(IntKi), PARAMETER :: RootFyb3 = 660 + INTEGER(IntKi), PARAMETER :: RootMxc3 = 661 + INTEGER(IntKi), PARAMETER :: RootMyc3 = 662 + INTEGER(IntKi), PARAMETER :: RootMzc3 = 663 + INTEGER(IntKi), PARAMETER :: RootMxb3 = 664 + INTEGER(IntKi), PARAMETER :: RootMyb3 = 665 ! Blade 1 Local Span Loads: - INTEGER(IntKi), PARAMETER :: Spn1MLxb1 = 537 - INTEGER(IntKi), PARAMETER :: Spn1MLyb1 = 538 - INTEGER(IntKi), PARAMETER :: Spn1MLzb1 = 539 - INTEGER(IntKi), PARAMETER :: Spn2MLxb1 = 540 - INTEGER(IntKi), PARAMETER :: Spn2MLyb1 = 541 - INTEGER(IntKi), PARAMETER :: Spn2MLzb1 = 542 - INTEGER(IntKi), PARAMETER :: Spn3MLxb1 = 543 - INTEGER(IntKi), PARAMETER :: Spn3MLyb1 = 544 - INTEGER(IntKi), PARAMETER :: Spn3MLzb1 = 545 - INTEGER(IntKi), PARAMETER :: Spn4MLxb1 = 546 - INTEGER(IntKi), PARAMETER :: Spn4MLyb1 = 547 - INTEGER(IntKi), PARAMETER :: Spn4MLzb1 = 548 - INTEGER(IntKi), PARAMETER :: Spn5MLxb1 = 549 - INTEGER(IntKi), PARAMETER :: Spn5MLyb1 = 550 - INTEGER(IntKi), PARAMETER :: Spn5MLzb1 = 551 - INTEGER(IntKi), PARAMETER :: Spn6MLxb1 = 552 - INTEGER(IntKi), PARAMETER :: Spn6MLyb1 = 553 - INTEGER(IntKi), PARAMETER :: Spn6MLzb1 = 554 - INTEGER(IntKi), PARAMETER :: Spn7MLxb1 = 555 - INTEGER(IntKi), PARAMETER :: Spn7MLyb1 = 556 - INTEGER(IntKi), PARAMETER :: Spn7MLzb1 = 557 - INTEGER(IntKi), PARAMETER :: Spn8MLxb1 = 558 - INTEGER(IntKi), PARAMETER :: Spn8MLyb1 = 559 - INTEGER(IntKi), PARAMETER :: Spn8MLzb1 = 560 - INTEGER(IntKi), PARAMETER :: Spn9MLxb1 = 561 - INTEGER(IntKi), PARAMETER :: Spn9MLyb1 = 562 - INTEGER(IntKi), PARAMETER :: Spn9MLzb1 = 563 - INTEGER(IntKi), PARAMETER :: Spn1FLxb1 = 564 - INTEGER(IntKi), PARAMETER :: Spn1FLyb1 = 565 - INTEGER(IntKi), PARAMETER :: Spn1FLzb1 = 566 - INTEGER(IntKi), PARAMETER :: Spn2FLxb1 = 567 - INTEGER(IntKi), PARAMETER :: Spn2FLyb1 = 568 - INTEGER(IntKi), PARAMETER :: Spn2FLzb1 = 569 - INTEGER(IntKi), PARAMETER :: Spn3FLxb1 = 570 - INTEGER(IntKi), PARAMETER :: Spn3FLyb1 = 571 - INTEGER(IntKi), PARAMETER :: Spn3FLzb1 = 572 - INTEGER(IntKi), PARAMETER :: Spn4FLxb1 = 573 - INTEGER(IntKi), PARAMETER :: Spn4FLyb1 = 574 - INTEGER(IntKi), PARAMETER :: Spn4FLzb1 = 575 - INTEGER(IntKi), PARAMETER :: Spn5FLxb1 = 576 - INTEGER(IntKi), PARAMETER :: Spn5FLyb1 = 577 - INTEGER(IntKi), PARAMETER :: Spn5FLzb1 = 578 - INTEGER(IntKi), PARAMETER :: Spn6FLxb1 = 579 - INTEGER(IntKi), PARAMETER :: Spn6FLyb1 = 580 - INTEGER(IntKi), PARAMETER :: Spn6FLzb1 = 581 - INTEGER(IntKi), PARAMETER :: Spn7FLxb1 = 582 - INTEGER(IntKi), PARAMETER :: Spn7FLyb1 = 583 - INTEGER(IntKi), PARAMETER :: Spn7FLzb1 = 584 - INTEGER(IntKi), PARAMETER :: Spn8FLxb1 = 585 - INTEGER(IntKi), PARAMETER :: Spn8FLyb1 = 586 - INTEGER(IntKi), PARAMETER :: Spn8FLzb1 = 587 - INTEGER(IntKi), PARAMETER :: Spn9FLxb1 = 588 - INTEGER(IntKi), PARAMETER :: Spn9FLyb1 = 589 - INTEGER(IntKi), PARAMETER :: Spn9FLzb1 = 590 + INTEGER(IntKi), PARAMETER :: Spn1MLxb1 = 666 + INTEGER(IntKi), PARAMETER :: Spn1MLyb1 = 667 + INTEGER(IntKi), PARAMETER :: Spn1MLzb1 = 668 + INTEGER(IntKi), PARAMETER :: Spn2MLxb1 = 669 + INTEGER(IntKi), PARAMETER :: Spn2MLyb1 = 670 + INTEGER(IntKi), PARAMETER :: Spn2MLzb1 = 671 + INTEGER(IntKi), PARAMETER :: Spn3MLxb1 = 672 + INTEGER(IntKi), PARAMETER :: Spn3MLyb1 = 673 + INTEGER(IntKi), PARAMETER :: Spn3MLzb1 = 674 + INTEGER(IntKi), PARAMETER :: Spn4MLxb1 = 675 + INTEGER(IntKi), PARAMETER :: Spn4MLyb1 = 676 + INTEGER(IntKi), PARAMETER :: Spn4MLzb1 = 677 + INTEGER(IntKi), PARAMETER :: Spn5MLxb1 = 678 + INTEGER(IntKi), PARAMETER :: Spn5MLyb1 = 679 + INTEGER(IntKi), PARAMETER :: Spn5MLzb1 = 680 + INTEGER(IntKi), PARAMETER :: Spn6MLxb1 = 681 + INTEGER(IntKi), PARAMETER :: Spn6MLyb1 = 682 + INTEGER(IntKi), PARAMETER :: Spn6MLzb1 = 683 + INTEGER(IntKi), PARAMETER :: Spn7MLxb1 = 684 + INTEGER(IntKi), PARAMETER :: Spn7MLyb1 = 685 + INTEGER(IntKi), PARAMETER :: Spn7MLzb1 = 686 + INTEGER(IntKi), PARAMETER :: Spn8MLxb1 = 687 + INTEGER(IntKi), PARAMETER :: Spn8MLyb1 = 688 + INTEGER(IntKi), PARAMETER :: Spn8MLzb1 = 689 + INTEGER(IntKi), PARAMETER :: Spn9MLxb1 = 690 + INTEGER(IntKi), PARAMETER :: Spn9MLyb1 = 691 + INTEGER(IntKi), PARAMETER :: Spn9MLzb1 = 692 + INTEGER(IntKi), PARAMETER :: Spn1FLxb1 = 693 + INTEGER(IntKi), PARAMETER :: Spn1FLyb1 = 694 + INTEGER(IntKi), PARAMETER :: Spn1FLzb1 = 695 + INTEGER(IntKi), PARAMETER :: Spn2FLxb1 = 696 + INTEGER(IntKi), PARAMETER :: Spn2FLyb1 = 697 + INTEGER(IntKi), PARAMETER :: Spn2FLzb1 = 698 + INTEGER(IntKi), PARAMETER :: Spn3FLxb1 = 699 + INTEGER(IntKi), PARAMETER :: Spn3FLyb1 = 700 + INTEGER(IntKi), PARAMETER :: Spn3FLzb1 = 701 + INTEGER(IntKi), PARAMETER :: Spn4FLxb1 = 702 + INTEGER(IntKi), PARAMETER :: Spn4FLyb1 = 703 + INTEGER(IntKi), PARAMETER :: Spn4FLzb1 = 704 + INTEGER(IntKi), PARAMETER :: Spn5FLxb1 = 705 + INTEGER(IntKi), PARAMETER :: Spn5FLyb1 = 706 + INTEGER(IntKi), PARAMETER :: Spn5FLzb1 = 707 + INTEGER(IntKi), PARAMETER :: Spn6FLxb1 = 708 + INTEGER(IntKi), PARAMETER :: Spn6FLyb1 = 709 + INTEGER(IntKi), PARAMETER :: Spn6FLzb1 = 710 + INTEGER(IntKi), PARAMETER :: Spn7FLxb1 = 711 + INTEGER(IntKi), PARAMETER :: Spn7FLyb1 = 712 + INTEGER(IntKi), PARAMETER :: Spn7FLzb1 = 713 + INTEGER(IntKi), PARAMETER :: Spn8FLxb1 = 714 + INTEGER(IntKi), PARAMETER :: Spn8FLyb1 = 715 + INTEGER(IntKi), PARAMETER :: Spn8FLzb1 = 716 + INTEGER(IntKi), PARAMETER :: Spn9FLxb1 = 717 + INTEGER(IntKi), PARAMETER :: Spn9FLyb1 = 718 + INTEGER(IntKi), PARAMETER :: Spn9FLzb1 = 719 ! Blade 2 Local Span Loads: - INTEGER(IntKi), PARAMETER :: Spn1MLxb2 = 591 - INTEGER(IntKi), PARAMETER :: Spn1MLyb2 = 592 - INTEGER(IntKi), PARAMETER :: Spn1MLzb2 = 593 - INTEGER(IntKi), PARAMETER :: Spn2MLxb2 = 594 - INTEGER(IntKi), PARAMETER :: Spn2MLyb2 = 595 - INTEGER(IntKi), PARAMETER :: Spn2MLzb2 = 596 - INTEGER(IntKi), PARAMETER :: Spn3MLxb2 = 597 - INTEGER(IntKi), PARAMETER :: Spn3MLyb2 = 598 - INTEGER(IntKi), PARAMETER :: Spn3MLzb2 = 599 - INTEGER(IntKi), PARAMETER :: Spn4MLxb2 = 600 - INTEGER(IntKi), PARAMETER :: Spn4MLyb2 = 601 - INTEGER(IntKi), PARAMETER :: Spn4MLzb2 = 602 - INTEGER(IntKi), PARAMETER :: Spn5MLxb2 = 603 - INTEGER(IntKi), PARAMETER :: Spn5MLyb2 = 604 - INTEGER(IntKi), PARAMETER :: Spn5MLzb2 = 605 - INTEGER(IntKi), PARAMETER :: Spn6MLxb2 = 606 - INTEGER(IntKi), PARAMETER :: Spn6MLyb2 = 607 - INTEGER(IntKi), PARAMETER :: Spn6MLzb2 = 608 - INTEGER(IntKi), PARAMETER :: Spn7MLxb2 = 609 - INTEGER(IntKi), PARAMETER :: Spn7MLyb2 = 610 - INTEGER(IntKi), PARAMETER :: Spn7MLzb2 = 611 - INTEGER(IntKi), PARAMETER :: Spn8MLxb2 = 612 - INTEGER(IntKi), PARAMETER :: Spn8MLyb2 = 613 - INTEGER(IntKi), PARAMETER :: Spn8MLzb2 = 614 - INTEGER(IntKi), PARAMETER :: Spn9MLxb2 = 615 - INTEGER(IntKi), PARAMETER :: Spn9MLyb2 = 616 - INTEGER(IntKi), PARAMETER :: Spn9MLzb2 = 617 - INTEGER(IntKi), PARAMETER :: Spn1FLxb2 = 618 - INTEGER(IntKi), PARAMETER :: Spn1FLyb2 = 619 - INTEGER(IntKi), PARAMETER :: Spn1FLzb2 = 620 - INTEGER(IntKi), PARAMETER :: Spn2FLxb2 = 621 - INTEGER(IntKi), PARAMETER :: Spn2FLyb2 = 622 - INTEGER(IntKi), PARAMETER :: Spn2FLzb2 = 623 - INTEGER(IntKi), PARAMETER :: Spn3FLxb2 = 624 - INTEGER(IntKi), PARAMETER :: Spn3FLyb2 = 625 - INTEGER(IntKi), PARAMETER :: Spn3FLzb2 = 626 - INTEGER(IntKi), PARAMETER :: Spn4FLxb2 = 627 - INTEGER(IntKi), PARAMETER :: Spn4FLyb2 = 628 - INTEGER(IntKi), PARAMETER :: Spn4FLzb2 = 629 - INTEGER(IntKi), PARAMETER :: Spn5FLxb2 = 630 - INTEGER(IntKi), PARAMETER :: Spn5FLyb2 = 631 - INTEGER(IntKi), PARAMETER :: Spn5FLzb2 = 632 - INTEGER(IntKi), PARAMETER :: Spn6FLxb2 = 633 - INTEGER(IntKi), PARAMETER :: Spn6FLyb2 = 634 - INTEGER(IntKi), PARAMETER :: Spn6FLzb2 = 635 - INTEGER(IntKi), PARAMETER :: Spn7FLxb2 = 636 - INTEGER(IntKi), PARAMETER :: Spn7FLyb2 = 637 - INTEGER(IntKi), PARAMETER :: Spn7FLzb2 = 638 - INTEGER(IntKi), PARAMETER :: Spn8FLxb2 = 639 - INTEGER(IntKi), PARAMETER :: Spn8FLyb2 = 640 - INTEGER(IntKi), PARAMETER :: Spn8FLzb2 = 641 - INTEGER(IntKi), PARAMETER :: Spn9FLxb2 = 642 - INTEGER(IntKi), PARAMETER :: Spn9FLyb2 = 643 - INTEGER(IntKi), PARAMETER :: Spn9FLzb2 = 644 + INTEGER(IntKi), PARAMETER :: Spn1MLxb2 = 720 + INTEGER(IntKi), PARAMETER :: Spn1MLyb2 = 721 + INTEGER(IntKi), PARAMETER :: Spn1MLzb2 = 722 + INTEGER(IntKi), PARAMETER :: Spn2MLxb2 = 723 + INTEGER(IntKi), PARAMETER :: Spn2MLyb2 = 724 + INTEGER(IntKi), PARAMETER :: Spn2MLzb2 = 725 + INTEGER(IntKi), PARAMETER :: Spn3MLxb2 = 726 + INTEGER(IntKi), PARAMETER :: Spn3MLyb2 = 727 + INTEGER(IntKi), PARAMETER :: Spn3MLzb2 = 728 + INTEGER(IntKi), PARAMETER :: Spn4MLxb2 = 729 + INTEGER(IntKi), PARAMETER :: Spn4MLyb2 = 730 + INTEGER(IntKi), PARAMETER :: Spn4MLzb2 = 731 + INTEGER(IntKi), PARAMETER :: Spn5MLxb2 = 732 + INTEGER(IntKi), PARAMETER :: Spn5MLyb2 = 733 + INTEGER(IntKi), PARAMETER :: Spn5MLzb2 = 734 + INTEGER(IntKi), PARAMETER :: Spn6MLxb2 = 735 + INTEGER(IntKi), PARAMETER :: Spn6MLyb2 = 736 + INTEGER(IntKi), PARAMETER :: Spn6MLzb2 = 737 + INTEGER(IntKi), PARAMETER :: Spn7MLxb2 = 738 + INTEGER(IntKi), PARAMETER :: Spn7MLyb2 = 739 + INTEGER(IntKi), PARAMETER :: Spn7MLzb2 = 740 + INTEGER(IntKi), PARAMETER :: Spn8MLxb2 = 741 + INTEGER(IntKi), PARAMETER :: Spn8MLyb2 = 742 + INTEGER(IntKi), PARAMETER :: Spn8MLzb2 = 743 + INTEGER(IntKi), PARAMETER :: Spn9MLxb2 = 744 + INTEGER(IntKi), PARAMETER :: Spn9MLyb2 = 745 + INTEGER(IntKi), PARAMETER :: Spn9MLzb2 = 746 + INTEGER(IntKi), PARAMETER :: Spn1FLxb2 = 747 + INTEGER(IntKi), PARAMETER :: Spn1FLyb2 = 748 + INTEGER(IntKi), PARAMETER :: Spn1FLzb2 = 749 + INTEGER(IntKi), PARAMETER :: Spn2FLxb2 = 750 + INTEGER(IntKi), PARAMETER :: Spn2FLyb2 = 751 + INTEGER(IntKi), PARAMETER :: Spn2FLzb2 = 752 + INTEGER(IntKi), PARAMETER :: Spn3FLxb2 = 753 + INTEGER(IntKi), PARAMETER :: Spn3FLyb2 = 754 + INTEGER(IntKi), PARAMETER :: Spn3FLzb2 = 755 + INTEGER(IntKi), PARAMETER :: Spn4FLxb2 = 756 + INTEGER(IntKi), PARAMETER :: Spn4FLyb2 = 757 + INTEGER(IntKi), PARAMETER :: Spn4FLzb2 = 758 + INTEGER(IntKi), PARAMETER :: Spn5FLxb2 = 759 + INTEGER(IntKi), PARAMETER :: Spn5FLyb2 = 760 + INTEGER(IntKi), PARAMETER :: Spn5FLzb2 = 761 + INTEGER(IntKi), PARAMETER :: Spn6FLxb2 = 762 + INTEGER(IntKi), PARAMETER :: Spn6FLyb2 = 763 + INTEGER(IntKi), PARAMETER :: Spn6FLzb2 = 764 + INTEGER(IntKi), PARAMETER :: Spn7FLxb2 = 765 + INTEGER(IntKi), PARAMETER :: Spn7FLyb2 = 766 + INTEGER(IntKi), PARAMETER :: Spn7FLzb2 = 767 + INTEGER(IntKi), PARAMETER :: Spn8FLxb2 = 768 + INTEGER(IntKi), PARAMETER :: Spn8FLyb2 = 769 + INTEGER(IntKi), PARAMETER :: Spn8FLzb2 = 770 + INTEGER(IntKi), PARAMETER :: Spn9FLxb2 = 771 + INTEGER(IntKi), PARAMETER :: Spn9FLyb2 = 772 + INTEGER(IntKi), PARAMETER :: Spn9FLzb2 = 773 ! Blade 3 Local Span Loads: - INTEGER(IntKi), PARAMETER :: Spn1MLxb3 = 645 - INTEGER(IntKi), PARAMETER :: Spn1MLyb3 = 646 - INTEGER(IntKi), PARAMETER :: Spn1MLzb3 = 647 - INTEGER(IntKi), PARAMETER :: Spn2MLxb3 = 648 - INTEGER(IntKi), PARAMETER :: Spn2MLyb3 = 649 - INTEGER(IntKi), PARAMETER :: Spn2MLzb3 = 650 - INTEGER(IntKi), PARAMETER :: Spn3MLxb3 = 651 - INTEGER(IntKi), PARAMETER :: Spn3MLyb3 = 652 - INTEGER(IntKi), PARAMETER :: Spn3MLzb3 = 653 - INTEGER(IntKi), PARAMETER :: Spn4MLxb3 = 654 - INTEGER(IntKi), PARAMETER :: Spn4MLyb3 = 655 - INTEGER(IntKi), PARAMETER :: Spn4MLzb3 = 656 - INTEGER(IntKi), PARAMETER :: Spn5MLxb3 = 657 - INTEGER(IntKi), PARAMETER :: Spn5MLyb3 = 658 - INTEGER(IntKi), PARAMETER :: Spn5MLzb3 = 659 - INTEGER(IntKi), PARAMETER :: Spn6MLxb3 = 660 - INTEGER(IntKi), PARAMETER :: Spn6MLyb3 = 661 - INTEGER(IntKi), PARAMETER :: Spn6MLzb3 = 662 - INTEGER(IntKi), PARAMETER :: Spn7MLxb3 = 663 - INTEGER(IntKi), PARAMETER :: Spn7MLyb3 = 664 - INTEGER(IntKi), PARAMETER :: Spn7MLzb3 = 665 - INTEGER(IntKi), PARAMETER :: Spn8MLxb3 = 666 - INTEGER(IntKi), PARAMETER :: Spn8MLyb3 = 667 - INTEGER(IntKi), PARAMETER :: Spn8MLzb3 = 668 - INTEGER(IntKi), PARAMETER :: Spn9MLxb3 = 669 - INTEGER(IntKi), PARAMETER :: Spn9MLyb3 = 670 - INTEGER(IntKi), PARAMETER :: Spn9MLzb3 = 671 - INTEGER(IntKi), PARAMETER :: Spn1FLxb3 = 672 - INTEGER(IntKi), PARAMETER :: Spn1FLyb3 = 673 - INTEGER(IntKi), PARAMETER :: Spn1FLzb3 = 674 - INTEGER(IntKi), PARAMETER :: Spn2FLxb3 = 675 - INTEGER(IntKi), PARAMETER :: Spn2FLyb3 = 676 - INTEGER(IntKi), PARAMETER :: Spn2FLzb3 = 677 - INTEGER(IntKi), PARAMETER :: Spn3FLxb3 = 678 - INTEGER(IntKi), PARAMETER :: Spn3FLyb3 = 679 - INTEGER(IntKi), PARAMETER :: Spn3FLzb3 = 680 - INTEGER(IntKi), PARAMETER :: Spn4FLxb3 = 681 - INTEGER(IntKi), PARAMETER :: Spn4FLyb3 = 682 - INTEGER(IntKi), PARAMETER :: Spn4FLzb3 = 683 - INTEGER(IntKi), PARAMETER :: Spn5FLxb3 = 684 - INTEGER(IntKi), PARAMETER :: Spn5FLyb3 = 685 - INTEGER(IntKi), PARAMETER :: Spn5FLzb3 = 686 - INTEGER(IntKi), PARAMETER :: Spn6FLxb3 = 687 - INTEGER(IntKi), PARAMETER :: Spn6FLyb3 = 688 - INTEGER(IntKi), PARAMETER :: Spn6FLzb3 = 689 - INTEGER(IntKi), PARAMETER :: Spn7FLxb3 = 690 - INTEGER(IntKi), PARAMETER :: Spn7FLyb3 = 691 - INTEGER(IntKi), PARAMETER :: Spn7FLzb3 = 692 - INTEGER(IntKi), PARAMETER :: Spn8FLxb3 = 693 - INTEGER(IntKi), PARAMETER :: Spn8FLyb3 = 694 - INTEGER(IntKi), PARAMETER :: Spn8FLzb3 = 695 - INTEGER(IntKi), PARAMETER :: Spn9FLxb3 = 696 - INTEGER(IntKi), PARAMETER :: Spn9FLyb3 = 697 - INTEGER(IntKi), PARAMETER :: Spn9FLzb3 = 698 + INTEGER(IntKi), PARAMETER :: Spn1MLxb3 = 774 + INTEGER(IntKi), PARAMETER :: Spn1MLyb3 = 775 + INTEGER(IntKi), PARAMETER :: Spn1MLzb3 = 776 + INTEGER(IntKi), PARAMETER :: Spn2MLxb3 = 777 + INTEGER(IntKi), PARAMETER :: Spn2MLyb3 = 778 + INTEGER(IntKi), PARAMETER :: Spn2MLzb3 = 779 + INTEGER(IntKi), PARAMETER :: Spn3MLxb3 = 780 + INTEGER(IntKi), PARAMETER :: Spn3MLyb3 = 781 + INTEGER(IntKi), PARAMETER :: Spn3MLzb3 = 782 + INTEGER(IntKi), PARAMETER :: Spn4MLxb3 = 783 + INTEGER(IntKi), PARAMETER :: Spn4MLyb3 = 784 + INTEGER(IntKi), PARAMETER :: Spn4MLzb3 = 785 + INTEGER(IntKi), PARAMETER :: Spn5MLxb3 = 786 + INTEGER(IntKi), PARAMETER :: Spn5MLyb3 = 787 + INTEGER(IntKi), PARAMETER :: Spn5MLzb3 = 788 + INTEGER(IntKi), PARAMETER :: Spn6MLxb3 = 789 + INTEGER(IntKi), PARAMETER :: Spn6MLyb3 = 790 + INTEGER(IntKi), PARAMETER :: Spn6MLzb3 = 791 + INTEGER(IntKi), PARAMETER :: Spn7MLxb3 = 792 + INTEGER(IntKi), PARAMETER :: Spn7MLyb3 = 793 + INTEGER(IntKi), PARAMETER :: Spn7MLzb3 = 794 + INTEGER(IntKi), PARAMETER :: Spn8MLxb3 = 795 + INTEGER(IntKi), PARAMETER :: Spn8MLyb3 = 796 + INTEGER(IntKi), PARAMETER :: Spn8MLzb3 = 797 + INTEGER(IntKi), PARAMETER :: Spn9MLxb3 = 798 + INTEGER(IntKi), PARAMETER :: Spn9MLyb3 = 799 + INTEGER(IntKi), PARAMETER :: Spn9MLzb3 = 800 + INTEGER(IntKi), PARAMETER :: Spn1FLxb3 = 801 + INTEGER(IntKi), PARAMETER :: Spn1FLyb3 = 802 + INTEGER(IntKi), PARAMETER :: Spn1FLzb3 = 803 + INTEGER(IntKi), PARAMETER :: Spn2FLxb3 = 804 + INTEGER(IntKi), PARAMETER :: Spn2FLyb3 = 805 + INTEGER(IntKi), PARAMETER :: Spn2FLzb3 = 806 + INTEGER(IntKi), PARAMETER :: Spn3FLxb3 = 807 + INTEGER(IntKi), PARAMETER :: Spn3FLyb3 = 808 + INTEGER(IntKi), PARAMETER :: Spn3FLzb3 = 809 + INTEGER(IntKi), PARAMETER :: Spn4FLxb3 = 810 + INTEGER(IntKi), PARAMETER :: Spn4FLyb3 = 811 + INTEGER(IntKi), PARAMETER :: Spn4FLzb3 = 812 + INTEGER(IntKi), PARAMETER :: Spn5FLxb3 = 813 + INTEGER(IntKi), PARAMETER :: Spn5FLyb3 = 814 + INTEGER(IntKi), PARAMETER :: Spn5FLzb3 = 815 + INTEGER(IntKi), PARAMETER :: Spn6FLxb3 = 816 + INTEGER(IntKi), PARAMETER :: Spn6FLyb3 = 817 + INTEGER(IntKi), PARAMETER :: Spn6FLzb3 = 818 + INTEGER(IntKi), PARAMETER :: Spn7FLxb3 = 819 + INTEGER(IntKi), PARAMETER :: Spn7FLyb3 = 820 + INTEGER(IntKi), PARAMETER :: Spn7FLzb3 = 821 + INTEGER(IntKi), PARAMETER :: Spn8FLxb3 = 822 + INTEGER(IntKi), PARAMETER :: Spn8FLyb3 = 823 + INTEGER(IntKi), PARAMETER :: Spn8FLzb3 = 824 + INTEGER(IntKi), PARAMETER :: Spn9FLxb3 = 825 + INTEGER(IntKi), PARAMETER :: Spn9FLyb3 = 826 + INTEGER(IntKi), PARAMETER :: Spn9FLzb3 = 827 ! Hub and Rotor Loads: - INTEGER(IntKi), PARAMETER :: LSShftFxa = 699 - INTEGER(IntKi), PARAMETER :: LSShftFya = 700 - INTEGER(IntKi), PARAMETER :: LSShftFza = 701 - INTEGER(IntKi), PARAMETER :: LSShftFys = 702 - INTEGER(IntKi), PARAMETER :: LSShftFzs = 703 - INTEGER(IntKi), PARAMETER :: LSShftMxa = 704 - INTEGER(IntKi), PARAMETER :: LSSTipMya = 705 - INTEGER(IntKi), PARAMETER :: LSSTipMza = 706 - INTEGER(IntKi), PARAMETER :: LSSTipMys = 707 - INTEGER(IntKi), PARAMETER :: LSSTipMzs = 708 - INTEGER(IntKi), PARAMETER :: RotPwr = 709 + INTEGER(IntKi), PARAMETER :: LSShftFxa = 828 + INTEGER(IntKi), PARAMETER :: LSShftFya = 829 + INTEGER(IntKi), PARAMETER :: LSShftFza = 830 + INTEGER(IntKi), PARAMETER :: LSShftFys = 831 + INTEGER(IntKi), PARAMETER :: LSShftFzs = 832 + INTEGER(IntKi), PARAMETER :: LSShftMxa = 833 + INTEGER(IntKi), PARAMETER :: LSSTipMya = 834 + INTEGER(IntKi), PARAMETER :: LSSTipMza = 835 + INTEGER(IntKi), PARAMETER :: LSSTipMys = 836 + INTEGER(IntKi), PARAMETER :: LSSTipMzs = 837 + INTEGER(IntKi), PARAMETER :: RotPwr = 838 ! Shaft Strain Gage Loads: - INTEGER(IntKi), PARAMETER :: LSSGagMya = 710 - INTEGER(IntKi), PARAMETER :: LSSGagMza = 711 - INTEGER(IntKi), PARAMETER :: LSSGagMys = 712 - INTEGER(IntKi), PARAMETER :: LSSGagMzs = 713 + INTEGER(IntKi), PARAMETER :: LSSGagMya = 839 + INTEGER(IntKi), PARAMETER :: LSSGagMza = 840 + INTEGER(IntKi), PARAMETER :: LSSGagMys = 841 + INTEGER(IntKi), PARAMETER :: LSSGagMzs = 842 ! High-Speed Shaft Loads: - INTEGER(IntKi), PARAMETER :: HSShftTq = 714 - INTEGER(IntKi), PARAMETER :: HSSBrTq = 715 - INTEGER(IntKi), PARAMETER :: HSShftPwr = 716 + INTEGER(IntKi), PARAMETER :: HSShftTq = 843 + INTEGER(IntKi), PARAMETER :: HSSBrTq = 844 + INTEGER(IntKi), PARAMETER :: HSShftPwr = 845 ! Rotor-Furl Bearing Loads: - INTEGER(IntKi), PARAMETER :: RFrlBrM = 717 + INTEGER(IntKi), PARAMETER :: RFrlBrM = 846 ! Tail-Furl Bearing Loads: - INTEGER(IntKi), PARAMETER :: TFrlBrM = 718 + INTEGER(IntKi), PARAMETER :: TFrlBrM = 847 ! Tower-Top / Yaw Bearing Loads: - INTEGER(IntKi), PARAMETER :: YawBrFxn = 719 - INTEGER(IntKi), PARAMETER :: YawBrFyn = 720 - INTEGER(IntKi), PARAMETER :: YawBrFzn = 721 - INTEGER(IntKi), PARAMETER :: YawBrFxp = 722 - INTEGER(IntKi), PARAMETER :: YawBrFyp = 723 - INTEGER(IntKi), PARAMETER :: YawBrMxn = 724 - INTEGER(IntKi), PARAMETER :: YawBrMyn = 725 - INTEGER(IntKi), PARAMETER :: YawBrMzn = 726 - INTEGER(IntKi), PARAMETER :: YawBrMxp = 727 - INTEGER(IntKi), PARAMETER :: YawBrMyp = 728 + INTEGER(IntKi), PARAMETER :: YawBrFxn = 848 + INTEGER(IntKi), PARAMETER :: YawBrFyn = 849 + INTEGER(IntKi), PARAMETER :: YawBrFzn = 850 + INTEGER(IntKi), PARAMETER :: YawBrFxp = 851 + INTEGER(IntKi), PARAMETER :: YawBrFyp = 852 + INTEGER(IntKi), PARAMETER :: YawBrMxn = 853 + INTEGER(IntKi), PARAMETER :: YawBrMyn = 854 + INTEGER(IntKi), PARAMETER :: YawBrMzn = 855 + INTEGER(IntKi), PARAMETER :: YawBrMxp = 856 + INTEGER(IntKi), PARAMETER :: YawBrMyp = 857 + + + ! Yaw Friction: + + INTEGER(IntKi), PARAMETER :: YawFriMom = 858 + INTEGER(IntKi), PARAMETER :: YawFriMfp = 859 + INTEGER(IntKi), PARAMETER :: YawFriMz = 860 + INTEGER(IntKi), PARAMETER :: OmegaYF = 861 + INTEGER(IntKi), PARAMETER :: dOmegaYF = 862 ! Tower Base Loads: - INTEGER(IntKi), PARAMETER :: TwrBsFxt = 729 - INTEGER(IntKi), PARAMETER :: TwrBsFyt = 730 - INTEGER(IntKi), PARAMETER :: TwrBsFzt = 731 - INTEGER(IntKi), PARAMETER :: TwrBsMxt = 732 - INTEGER(IntKi), PARAMETER :: TwrBsMyt = 733 - INTEGER(IntKi), PARAMETER :: TwrBsMzt = 734 + INTEGER(IntKi), PARAMETER :: TwrBsFxt = 863 + INTEGER(IntKi), PARAMETER :: TwrBsFyt = 864 + INTEGER(IntKi), PARAMETER :: TwrBsFzt = 865 + INTEGER(IntKi), PARAMETER :: TwrBsMxt = 866 + INTEGER(IntKi), PARAMETER :: TwrBsMyt = 867 + INTEGER(IntKi), PARAMETER :: TwrBsMzt = 868 ! Local Tower Loads: - INTEGER(IntKi), PARAMETER :: TwHt1MLxt = 735 - INTEGER(IntKi), PARAMETER :: TwHt1MLyt = 736 - INTEGER(IntKi), PARAMETER :: TwHt1MLzt = 737 - INTEGER(IntKi), PARAMETER :: TwHt2MLxt = 738 - INTEGER(IntKi), PARAMETER :: TwHt2MLyt = 739 - INTEGER(IntKi), PARAMETER :: TwHt2MLzt = 740 - INTEGER(IntKi), PARAMETER :: TwHt3MLxt = 741 - INTEGER(IntKi), PARAMETER :: TwHt3MLyt = 742 - INTEGER(IntKi), PARAMETER :: TwHt3MLzt = 743 - INTEGER(IntKi), PARAMETER :: TwHt4MLxt = 744 - INTEGER(IntKi), PARAMETER :: TwHt4MLyt = 745 - INTEGER(IntKi), PARAMETER :: TwHt4MLzt = 746 - INTEGER(IntKi), PARAMETER :: TwHt5MLxt = 747 - INTEGER(IntKi), PARAMETER :: TwHt5MLyt = 748 - INTEGER(IntKi), PARAMETER :: TwHt5MLzt = 749 - INTEGER(IntKi), PARAMETER :: TwHt6MLxt = 750 - INTEGER(IntKi), PARAMETER :: TwHt6MLyt = 751 - INTEGER(IntKi), PARAMETER :: TwHt6MLzt = 752 - INTEGER(IntKi), PARAMETER :: TwHt7MLxt = 753 - INTEGER(IntKi), PARAMETER :: TwHt7MLyt = 754 - INTEGER(IntKi), PARAMETER :: TwHt7MLzt = 755 - INTEGER(IntKi), PARAMETER :: TwHt8MLxt = 756 - INTEGER(IntKi), PARAMETER :: TwHt8MLyt = 757 - INTEGER(IntKi), PARAMETER :: TwHt8MLzt = 758 - INTEGER(IntKi), PARAMETER :: TwHt9MLxt = 759 - INTEGER(IntKi), PARAMETER :: TwHt9MLyt = 760 - INTEGER(IntKi), PARAMETER :: TwHt9MLzt = 761 - INTEGER(IntKi), PARAMETER :: TwHt1FLxt = 762 - INTEGER(IntKi), PARAMETER :: TwHt1FLyt = 763 - INTEGER(IntKi), PARAMETER :: TwHt1FLzt = 764 - INTEGER(IntKi), PARAMETER :: TwHt2FLxt = 765 - INTEGER(IntKi), PARAMETER :: TwHt2FLyt = 766 - INTEGER(IntKi), PARAMETER :: TwHt2FLzt = 767 - INTEGER(IntKi), PARAMETER :: TwHt3FLxt = 768 - INTEGER(IntKi), PARAMETER :: TwHt3FLyt = 769 - INTEGER(IntKi), PARAMETER :: TwHt3FLzt = 770 - INTEGER(IntKi), PARAMETER :: TwHt4FLxt = 771 - INTEGER(IntKi), PARAMETER :: TwHt4FLyt = 772 - INTEGER(IntKi), PARAMETER :: TwHt4FLzt = 773 - INTEGER(IntKi), PARAMETER :: TwHt5FLxt = 774 - INTEGER(IntKi), PARAMETER :: TwHt5FLyt = 775 - INTEGER(IntKi), PARAMETER :: TwHt5FLzt = 776 - INTEGER(IntKi), PARAMETER :: TwHt6FLxt = 777 - INTEGER(IntKi), PARAMETER :: TwHt6FLyt = 778 - INTEGER(IntKi), PARAMETER :: TwHt6FLzt = 779 - INTEGER(IntKi), PARAMETER :: TwHt7FLxt = 780 - INTEGER(IntKi), PARAMETER :: TwHt7FLyt = 781 - INTEGER(IntKi), PARAMETER :: TwHt7FLzt = 782 - INTEGER(IntKi), PARAMETER :: TwHt8FLxt = 783 - INTEGER(IntKi), PARAMETER :: TwHt8FLyt = 784 - INTEGER(IntKi), PARAMETER :: TwHt8FLzt = 785 - INTEGER(IntKi), PARAMETER :: TwHt9FLxt = 786 - INTEGER(IntKi), PARAMETER :: TwHt9FLyt = 787 - INTEGER(IntKi), PARAMETER :: TwHt9FLzt = 788 + INTEGER(IntKi), PARAMETER :: TwHt1MLxt = 869 + INTEGER(IntKi), PARAMETER :: TwHt1MLyt = 870 + INTEGER(IntKi), PARAMETER :: TwHt1MLzt = 871 + INTEGER(IntKi), PARAMETER :: TwHt2MLxt = 872 + INTEGER(IntKi), PARAMETER :: TwHt2MLyt = 873 + INTEGER(IntKi), PARAMETER :: TwHt2MLzt = 874 + INTEGER(IntKi), PARAMETER :: TwHt3MLxt = 875 + INTEGER(IntKi), PARAMETER :: TwHt3MLyt = 876 + INTEGER(IntKi), PARAMETER :: TwHt3MLzt = 877 + INTEGER(IntKi), PARAMETER :: TwHt4MLxt = 878 + INTEGER(IntKi), PARAMETER :: TwHt4MLyt = 879 + INTEGER(IntKi), PARAMETER :: TwHt4MLzt = 880 + INTEGER(IntKi), PARAMETER :: TwHt5MLxt = 881 + INTEGER(IntKi), PARAMETER :: TwHt5MLyt = 882 + INTEGER(IntKi), PARAMETER :: TwHt5MLzt = 883 + INTEGER(IntKi), PARAMETER :: TwHt6MLxt = 884 + INTEGER(IntKi), PARAMETER :: TwHt6MLyt = 885 + INTEGER(IntKi), PARAMETER :: TwHt6MLzt = 886 + INTEGER(IntKi), PARAMETER :: TwHt7MLxt = 887 + INTEGER(IntKi), PARAMETER :: TwHt7MLyt = 888 + INTEGER(IntKi), PARAMETER :: TwHt7MLzt = 889 + INTEGER(IntKi), PARAMETER :: TwHt8MLxt = 890 + INTEGER(IntKi), PARAMETER :: TwHt8MLyt = 891 + INTEGER(IntKi), PARAMETER :: TwHt8MLzt = 892 + INTEGER(IntKi), PARAMETER :: TwHt9MLxt = 893 + INTEGER(IntKi), PARAMETER :: TwHt9MLyt = 894 + INTEGER(IntKi), PARAMETER :: TwHt9MLzt = 895 + INTEGER(IntKi), PARAMETER :: TwHt1FLxt = 896 + INTEGER(IntKi), PARAMETER :: TwHt1FLyt = 897 + INTEGER(IntKi), PARAMETER :: TwHt1FLzt = 898 + INTEGER(IntKi), PARAMETER :: TwHt2FLxt = 899 + INTEGER(IntKi), PARAMETER :: TwHt2FLyt = 900 + INTEGER(IntKi), PARAMETER :: TwHt2FLzt = 901 + INTEGER(IntKi), PARAMETER :: TwHt3FLxt = 902 + INTEGER(IntKi), PARAMETER :: TwHt3FLyt = 903 + INTEGER(IntKi), PARAMETER :: TwHt3FLzt = 904 + INTEGER(IntKi), PARAMETER :: TwHt4FLxt = 905 + INTEGER(IntKi), PARAMETER :: TwHt4FLyt = 906 + INTEGER(IntKi), PARAMETER :: TwHt4FLzt = 907 + INTEGER(IntKi), PARAMETER :: TwHt5FLxt = 908 + INTEGER(IntKi), PARAMETER :: TwHt5FLyt = 909 + INTEGER(IntKi), PARAMETER :: TwHt5FLzt = 910 + INTEGER(IntKi), PARAMETER :: TwHt6FLxt = 911 + INTEGER(IntKi), PARAMETER :: TwHt6FLyt = 912 + INTEGER(IntKi), PARAMETER :: TwHt6FLzt = 913 + INTEGER(IntKi), PARAMETER :: TwHt7FLxt = 914 + INTEGER(IntKi), PARAMETER :: TwHt7FLyt = 915 + INTEGER(IntKi), PARAMETER :: TwHt7FLzt = 916 + INTEGER(IntKi), PARAMETER :: TwHt8FLxt = 917 + INTEGER(IntKi), PARAMETER :: TwHt8FLyt = 918 + INTEGER(IntKi), PARAMETER :: TwHt8FLzt = 919 + INTEGER(IntKi), PARAMETER :: TwHt9FLxt = 920 + INTEGER(IntKi), PARAMETER :: TwHt9FLyt = 921 + INTEGER(IntKi), PARAMETER :: TwHt9FLzt = 922 ! Internal Degrees of Freedom: - INTEGER(IntKi), PARAMETER :: Q_B1E1 = 789 - INTEGER(IntKi), PARAMETER :: Q_B2E1 = 790 - INTEGER(IntKi), PARAMETER :: Q_B3E1 = 791 - INTEGER(IntKi), PARAMETER :: Q_B1F1 = 792 - INTEGER(IntKi), PARAMETER :: Q_B2F1 = 793 - INTEGER(IntKi), PARAMETER :: Q_B3F1 = 794 - INTEGER(IntKi), PARAMETER :: Q_B1F2 = 795 - INTEGER(IntKi), PARAMETER :: Q_B2F2 = 796 - INTEGER(IntKi), PARAMETER :: Q_B3F2 = 797 - INTEGER(IntKi), PARAMETER :: Q_Teet = 798 - INTEGER(IntKi), PARAMETER :: Q_DrTr = 799 - INTEGER(IntKi), PARAMETER :: Q_GeAz = 800 - INTEGER(IntKi), PARAMETER :: Q_RFrl = 801 - INTEGER(IntKi), PARAMETER :: Q_TFrl = 802 - INTEGER(IntKi), PARAMETER :: Q_Yaw = 803 - INTEGER(IntKi), PARAMETER :: Q_TFA1 = 804 - INTEGER(IntKi), PARAMETER :: Q_TSS1 = 805 - INTEGER(IntKi), PARAMETER :: Q_TFA2 = 806 - INTEGER(IntKi), PARAMETER :: Q_TSS2 = 807 - INTEGER(IntKi), PARAMETER :: Q_Sg = 808 - INTEGER(IntKi), PARAMETER :: Q_Sw = 809 - INTEGER(IntKi), PARAMETER :: Q_Hv = 810 - INTEGER(IntKi), PARAMETER :: Q_R = 811 - INTEGER(IntKi), PARAMETER :: Q_P = 812 - INTEGER(IntKi), PARAMETER :: Q_Y = 813 - INTEGER(IntKi), PARAMETER :: QD_B1E1 = 814 - INTEGER(IntKi), PARAMETER :: QD_B2E1 = 815 - INTEGER(IntKi), PARAMETER :: QD_B3E1 = 816 - INTEGER(IntKi), PARAMETER :: QD_B1F1 = 817 - INTEGER(IntKi), PARAMETER :: QD_B2F1 = 818 - INTEGER(IntKi), PARAMETER :: QD_B3F1 = 819 - INTEGER(IntKi), PARAMETER :: QD_B1F2 = 820 - INTEGER(IntKi), PARAMETER :: QD_B2F2 = 821 - INTEGER(IntKi), PARAMETER :: QD_B3F2 = 822 - INTEGER(IntKi), PARAMETER :: QD_Teet = 823 - INTEGER(IntKi), PARAMETER :: QD_DrTr = 824 - INTEGER(IntKi), PARAMETER :: QD_GeAz = 825 - INTEGER(IntKi), PARAMETER :: QD_RFrl = 826 - INTEGER(IntKi), PARAMETER :: QD_TFrl = 827 - INTEGER(IntKi), PARAMETER :: QD_Yaw = 828 - INTEGER(IntKi), PARAMETER :: QD_TFA1 = 829 - INTEGER(IntKi), PARAMETER :: QD_TSS1 = 830 - INTEGER(IntKi), PARAMETER :: QD_TFA2 = 831 - INTEGER(IntKi), PARAMETER :: QD_TSS2 = 832 - INTEGER(IntKi), PARAMETER :: QD_Sg = 833 - INTEGER(IntKi), PARAMETER :: QD_Sw = 834 - INTEGER(IntKi), PARAMETER :: QD_Hv = 835 - INTEGER(IntKi), PARAMETER :: QD_R = 836 - INTEGER(IntKi), PARAMETER :: QD_P = 837 - INTEGER(IntKi), PARAMETER :: QD_Y = 838 - INTEGER(IntKi), PARAMETER :: QD2_B1E1 = 839 - INTEGER(IntKi), PARAMETER :: QD2_B2E1 = 840 - INTEGER(IntKi), PARAMETER :: QD2_B3E1 = 841 - INTEGER(IntKi), PARAMETER :: QD2_B1F1 = 842 - INTEGER(IntKi), PARAMETER :: QD2_B2F1 = 843 - INTEGER(IntKi), PARAMETER :: QD2_B3F1 = 844 - INTEGER(IntKi), PARAMETER :: QD2_B1F2 = 845 - INTEGER(IntKi), PARAMETER :: QD2_B2F2 = 846 - INTEGER(IntKi), PARAMETER :: QD2_B3F2 = 847 - INTEGER(IntKi), PARAMETER :: QD2_Teet = 848 - INTEGER(IntKi), PARAMETER :: QD2_DrTr = 849 - INTEGER(IntKi), PARAMETER :: QD2_GeAz = 850 - INTEGER(IntKi), PARAMETER :: QD2_RFrl = 851 - INTEGER(IntKi), PARAMETER :: QD2_TFrl = 852 - INTEGER(IntKi), PARAMETER :: QD2_Yaw = 853 - INTEGER(IntKi), PARAMETER :: QD2_TFA1 = 854 - INTEGER(IntKi), PARAMETER :: QD2_TSS1 = 855 - INTEGER(IntKi), PARAMETER :: QD2_TFA2 = 856 - INTEGER(IntKi), PARAMETER :: QD2_TSS2 = 857 - INTEGER(IntKi), PARAMETER :: QD2_Sg = 858 - INTEGER(IntKi), PARAMETER :: QD2_Sw = 859 - INTEGER(IntKi), PARAMETER :: QD2_Hv = 860 - INTEGER(IntKi), PARAMETER :: QD2_R = 861 - INTEGER(IntKi), PARAMETER :: QD2_P = 862 - INTEGER(IntKi), PARAMETER :: QD2_Y = 863 + INTEGER(IntKi), PARAMETER :: Q_B1E1 = 923 + INTEGER(IntKi), PARAMETER :: Q_B2E1 = 924 + INTEGER(IntKi), PARAMETER :: Q_B3E1 = 925 + INTEGER(IntKi), PARAMETER :: Q_B1F1 = 926 + INTEGER(IntKi), PARAMETER :: Q_B2F1 = 927 + INTEGER(IntKi), PARAMETER :: Q_B3F1 = 928 + INTEGER(IntKi), PARAMETER :: Q_B1F2 = 929 + INTEGER(IntKi), PARAMETER :: Q_B2F2 = 930 + INTEGER(IntKi), PARAMETER :: Q_B3F2 = 931 + INTEGER(IntKi), PARAMETER :: Q_Teet = 932 + INTEGER(IntKi), PARAMETER :: Q_DrTr = 933 + INTEGER(IntKi), PARAMETER :: Q_GeAz = 934 + INTEGER(IntKi), PARAMETER :: Q_RFrl = 935 + INTEGER(IntKi), PARAMETER :: Q_TFrl = 936 + INTEGER(IntKi), PARAMETER :: Q_Yaw = 937 + INTEGER(IntKi), PARAMETER :: Q_TFA1 = 938 + INTEGER(IntKi), PARAMETER :: Q_TSS1 = 939 + INTEGER(IntKi), PARAMETER :: Q_TFA2 = 940 + INTEGER(IntKi), PARAMETER :: Q_TSS2 = 941 + INTEGER(IntKi), PARAMETER :: Q_Sg = 942 + INTEGER(IntKi), PARAMETER :: Q_Sw = 943 + INTEGER(IntKi), PARAMETER :: Q_Hv = 944 + INTEGER(IntKi), PARAMETER :: Q_R = 945 + INTEGER(IntKi), PARAMETER :: Q_P = 946 + INTEGER(IntKi), PARAMETER :: Q_Y = 947 + INTEGER(IntKi), PARAMETER :: QD_B1E1 = 948 + INTEGER(IntKi), PARAMETER :: QD_B2E1 = 949 + INTEGER(IntKi), PARAMETER :: QD_B3E1 = 950 + INTEGER(IntKi), PARAMETER :: QD_B1F1 = 951 + INTEGER(IntKi), PARAMETER :: QD_B2F1 = 952 + INTEGER(IntKi), PARAMETER :: QD_B3F1 = 953 + INTEGER(IntKi), PARAMETER :: QD_B1F2 = 954 + INTEGER(IntKi), PARAMETER :: QD_B2F2 = 955 + INTEGER(IntKi), PARAMETER :: QD_B3F2 = 956 + INTEGER(IntKi), PARAMETER :: QD_Teet = 957 + INTEGER(IntKi), PARAMETER :: QD_DrTr = 958 + INTEGER(IntKi), PARAMETER :: QD_GeAz = 959 + INTEGER(IntKi), PARAMETER :: QD_RFrl = 960 + INTEGER(IntKi), PARAMETER :: QD_TFrl = 961 + INTEGER(IntKi), PARAMETER :: QD_Yaw = 962 + INTEGER(IntKi), PARAMETER :: QD_TFA1 = 963 + INTEGER(IntKi), PARAMETER :: QD_TSS1 = 964 + INTEGER(IntKi), PARAMETER :: QD_TFA2 = 965 + INTEGER(IntKi), PARAMETER :: QD_TSS2 = 966 + INTEGER(IntKi), PARAMETER :: QD_Sg = 967 + INTEGER(IntKi), PARAMETER :: QD_Sw = 968 + INTEGER(IntKi), PARAMETER :: QD_Hv = 969 + INTEGER(IntKi), PARAMETER :: QD_R = 970 + INTEGER(IntKi), PARAMETER :: QD_P = 971 + INTEGER(IntKi), PARAMETER :: QD_Y = 972 + INTEGER(IntKi), PARAMETER :: QD2_B1E1 = 973 + INTEGER(IntKi), PARAMETER :: QD2_B2E1 = 974 + INTEGER(IntKi), PARAMETER :: QD2_B3E1 = 975 + INTEGER(IntKi), PARAMETER :: QD2_B1F1 = 976 + INTEGER(IntKi), PARAMETER :: QD2_B2F1 = 977 + INTEGER(IntKi), PARAMETER :: QD2_B3F1 = 978 + INTEGER(IntKi), PARAMETER :: QD2_B1F2 = 979 + INTEGER(IntKi), PARAMETER :: QD2_B2F2 = 980 + INTEGER(IntKi), PARAMETER :: QD2_B3F2 = 981 + INTEGER(IntKi), PARAMETER :: QD2_Teet = 982 + INTEGER(IntKi), PARAMETER :: QD2_DrTr = 983 + INTEGER(IntKi), PARAMETER :: QD2_GeAz = 984 + INTEGER(IntKi), PARAMETER :: QD2_RFrl = 985 + INTEGER(IntKi), PARAMETER :: QD2_TFrl = 986 + INTEGER(IntKi), PARAMETER :: QD2_Yaw = 987 + INTEGER(IntKi), PARAMETER :: QD2_TFA1 = 988 + INTEGER(IntKi), PARAMETER :: QD2_TSS1 = 989 + INTEGER(IntKi), PARAMETER :: QD2_TFA2 = 990 + INTEGER(IntKi), PARAMETER :: QD2_TSS2 = 991 + INTEGER(IntKi), PARAMETER :: QD2_Sg = 992 + INTEGER(IntKi), PARAMETER :: QD2_Sw = 993 + INTEGER(IntKi), PARAMETER :: QD2_Hv = 994 + INTEGER(IntKi), PARAMETER :: QD2_R = 995 + INTEGER(IntKi), PARAMETER :: QD2_P = 996 + INTEGER(IntKi), PARAMETER :: QD2_Y = 997 ! The maximum number of output channels which can be output by the code. - INTEGER(IntKi), PARAMETER :: MaxOutPts = 863 + INTEGER(IntKi), PARAMETER :: MaxOutPts = 997 -!End of code generated by Matlab script +!End of code generated by Matlab script Write_ChckOutLst ! =================================================================================================== - INTEGER, PARAMETER :: TipDxc( 3) = (/TipDxc1, TipDxc2, TipDxc3/) INTEGER, PARAMETER :: TipDyc( 3) = (/TipDyc1, TipDyc2, TipDyc3/) INTEGER, PARAMETER :: TipDzc( 3) = (/TipDzc1, TipDzc2, TipDzc3/) @@ -1115,6 +1258,9 @@ MODULE ElastoDyn_Parameters INTEGER, PARAMETER :: TipALxb(3) = (/TipALxb1, TipALxb2, TipALxb3/) INTEGER, PARAMETER :: TipALyb(3) = (/TipALyb1, TipALyb2, TipALyb3/) INTEGER, PARAMETER :: TipALzb(3) = (/TipALzb1, TipALzb2, TipALzb3/) +INTEGER, PARAMETER :: TipALgxb(3) = (/TipALgxb1, TipALgxb2, TipALgxb3/) +INTEGER, PARAMETER :: TipALgyb(3) = (/TipALgyb1, TipALgyb2, TipALgyb3/) +INTEGER, PARAMETER :: TipALgzb(3) = (/TipALgzb1, TipALgzb2, TipALgzb3/) INTEGER, PARAMETER :: TipRDxb(3) = (/TipRDxb1, TipRDxb2, TipRDxb3/) INTEGER, PARAMETER :: TipRDyb(3) = (/TipRDyb1, TipRDyb2, TipRDyb3/) INTEGER, PARAMETER :: TipRDzc(3) = (/TipRDzc1, TipRDzc2, TipRDzc3/) @@ -1148,6 +1294,22 @@ MODULE ElastoDyn_Parameters Spn1ALzb3,Spn2ALzb3,Spn3ALzb3,Spn4ALzb3,Spn5ALzb3,Spn6ALzb3,Spn7ALzb3,Spn8ALzb3,Spn9ALzb3 & /), (/9, 3/) ) +INTEGER, PARAMETER :: SpnALgxb(9, 3) = RESHAPE( (/ & + Spn1ALgxb1,Spn2ALgxb1,Spn3ALgxb1,Spn4ALgxb1,Spn5ALgxb1,Spn6ALgxb1,Spn7ALgxb1,Spn8ALgxb1,Spn9ALgxb1, & + Spn1ALgxb2,Spn2ALgxb2,Spn3ALgxb2,Spn4ALgxb2,Spn5ALgxb2,Spn6ALgxb2,Spn7ALgxb2,Spn8ALgxb2,Spn9ALgxb2, & + Spn1ALgxb3,Spn2ALgxb3,Spn3ALgxb3,Spn4ALgxb3,Spn5ALgxb3,Spn6ALgxb3,Spn7ALgxb3,Spn8ALgxb3,Spn9ALgxb3 & + /), (/9, 3/) ) +INTEGER, PARAMETER :: SpnALgyb(9, 3) = RESHAPE( (/ & + Spn1ALgyb1,Spn2ALgyb1,Spn3ALgyb1,Spn4ALgyb1,Spn5ALgyb1,Spn6ALgyb1,Spn7ALgyb1,Spn8ALgyb1,Spn9ALgyb1, & + Spn1ALgyb2,Spn2ALgyb2,Spn3ALgyb2,Spn4ALgyb2,Spn5ALgyb2,Spn6ALgyb2,Spn7ALgyb2,Spn8ALgyb2,Spn9ALgyb2, & + Spn1ALgyb3,Spn2ALgyb3,Spn3ALgyb3,Spn4ALgyb3,Spn5ALgyb3,Spn6ALgyb3,Spn7ALgyb3,Spn8ALgyb3,Spn9ALgyb3 & + /), (/9, 3/) ) +INTEGER, PARAMETER :: SpnALgzb(9, 3) = RESHAPE( (/ & + Spn1ALgzb1,Spn2ALgzb1,Spn3ALgzb1,Spn4ALgzb1,Spn5ALgzb1,Spn6ALgzb1,Spn7ALgzb1,Spn8ALgzb1,Spn9ALgzb1, & + Spn1ALgzb2,Spn2ALgzb2,Spn3ALgzb2,Spn4ALgzb2,Spn5ALgzb2,Spn6ALgzb2,Spn7ALgzb2,Spn8ALgzb2,Spn9ALgzb2, & + Spn1ALgzb3,Spn2ALgzb3,Spn3ALgzb3,Spn4ALgzb3,Spn5ALgzb3,Spn6ALgzb3,Spn7ALgzb3,Spn8ALgzb3,Spn9ALgzb3 & + /), (/9, 3/) ) + INTEGER, PARAMETER :: SpnFLxb(9,3) = RESHAPE( (/ & Spn1FLxb1,Spn2FLxb1,Spn3FLxb1,Spn4FLxb1,Spn5FLxb1,Spn6FLxb1,Spn7FLxb1,Spn8FLxb1,Spn9FLxb1, & Spn1FLxb2,Spn2FLxb2,Spn3FLxb2,Spn4FLxb2,Spn5FLxb2,Spn6FLxb2,Spn7FLxb2,Spn8FLxb2,Spn9FLxb2, & @@ -1220,6 +1382,13 @@ MODULE ElastoDyn_Parameters INTEGER, PARAMETER :: TwHtALzt(9) = (/ & TwHt1ALzt,TwHt2ALzt,TwHt3ALzt,TwHt4ALzt,TwHt5ALzt,TwHt6ALzt,TwHt7ALzt,TwHt8ALzt,TwHt9ALzt /) +INTEGER, PARAMETER :: TwHtALgxt(9) = (/ & + TwHt1ALgxt,TwHt2ALgxt,TwHt3ALgxt,TwHt4ALgxt,TwHt5ALgxt,TwHt6ALgxt,TwHt7ALgxt,TwHt8ALgxt,TwHt9ALgxt /) +INTEGER, PARAMETER :: TwHtALgyt(9) = (/ & + TwHt1ALgyt,TwHt2ALgyt,TwHt3ALgyt,TwHt4ALgyt,TwHt5ALgyt,TwHt6ALgyt,TwHt7ALgyt,TwHt8ALgyt,TwHt9ALgyt /) +INTEGER, PARAMETER :: TwHtALgzt(9) = (/ & + TwHt1ALgzt,TwHt2ALgzt,TwHt3ALgzt,TwHt4ALgzt,TwHt5ALgzt,TwHt6ALgzt,TwHt7ALgzt,TwHt8ALgzt,TwHt9ALgzt /) + INTEGER, PARAMETER :: TwHtMLxt(9) = (/ & TwHt1MLxt,TwHt2MLxt,TwHt3MLxt,TwHt4MLxt,TwHt5MLxt,TwHt6MLxt,TwHt7MLxt,TwHt8MLxt,TwHt9MLxt /) INTEGER, PARAMETER :: TwHtMLyt(9) = (/ & @@ -1276,14 +1445,13 @@ MODULE ElastoDyn_IO !---------------------------------------------------------------------------------------------------------------------------------- !> This subroutine reads the input file and stores all the data in the ED_InputFile structure. !! It does not perform data validation. -SUBROUTINE ED_ReadInput( InputFileName, MeshFile, InputFileData, BD4Blades, Default_DT, OutFileRoot, ErrStat, ErrMsg ) +SUBROUTINE ED_ReadInput( InputFileName, InputFileData, BD4Blades, Default_DT, OutFileRoot, ErrStat, ErrMsg ) !.................................................................................................................................. ! Passed variables REAL(DbKi), INTENT(IN) :: Default_DT !< The default DT (from glue code) CHARACTER(*), INTENT(IN) :: InputFileName !< Name of the input file - CHARACTER(*), INTENT(IN) :: MeshFile !< File that contains the blade mesh information (AeroDyn input file for now) -- later this info will be defined in one of the ED input files. CHARACTER(*), INTENT(IN) :: OutFileRoot !< The rootname of all the output files written by this routine. TYPE(ED_InputFile), INTENT(OUT) :: InputFileData !< Data stored in the module's input file @@ -1376,7 +1544,7 @@ SUBROUTINE ED_ReadInput( InputFileName, MeshFile, InputFileData, BD4Blades, Defa ! get the blade input-file data (from blade and mesh files) IF (.NOT. BD4Blades) THEN - CALL ReadBladeInputs ( BldFile, MeshFile, InputFileData, UnEcho, ErrStat2, ErrMsg2 ) + CALL ReadBladeInputs ( BldFile, InputFileData, UnEcho, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) if ( ErrStat >= AbortErrLev ) then call Cleanup() @@ -1463,14 +1631,13 @@ END SUBROUTINE ED_ValidateInput !---------------------------------------------------------------------------------------------------------------------------------- !> This routine reads the data from the blade and mesh inputs files. !! This routines assumes that InputFileData%NumBl has already been set. -SUBROUTINE ReadBladeInputs ( BldFile, MeshFile, InputFileData, UnEc, ErrStat, ErrMsg ) +SUBROUTINE ReadBladeInputs ( BldFile, InputFileData, UnEc, ErrStat, ErrMsg ) !.................................................................................................................................. ! Passed variables: TYPE(ED_InputFile), INTENT(INOUT) :: InputFileData !< Input file data Data for Blade K stored in the module's input file CHARACTER(*), INTENT(IN) :: BldFile(:) !< The array of file names containing blade information - CHARACTER(*), INTENT(IN) :: MeshFile !< The file names containing blade mesh information (for now, the aerodyn primary file) INTEGER(IntKi), INTENT(IN) :: UnEc !< I/O unit for echo file. If present and > 0, write to UnEc INTEGER(IntKi), INTENT(OUT) :: ErrStat !< The error ID @@ -1504,14 +1671,7 @@ SUBROUTINE ReadBladeInputs ( BldFile, MeshFile, InputFileData, UnEc, ErrStat, Er ! Get the blade discretization here: - IF ( len_trim(MeshFile) == 0 ) THEN - InputFileData%InpBlMesh(1)%BldNodes = InputFileData%BldNodes - ELSE - ! we will get the discretization from AeroDyn's input file - CALL ReadBladeMeshFileAD( InputFileData%InpBlMesh(1), MeshFile, UnEc, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - IF ( ErrStat >= AbortErrLev ) RETURN - END IF + InputFileData%InpBlMesh(1)%BldNodes = InputFileData%BldNodes ! Read the input file(s) for all of the blades: @@ -1551,481 +1711,205 @@ END SUBROUTINE ReadBladeInputs !---------------------------------------------------------------------------------------------------------------------------------- !> This routine reads a blade input file. SUBROUTINE ReadBladeFile ( BldFile, BladeKInputFileData, UnEc, ErrStat, ErrMsg ) -!.................................................................................................................................. - - ! Passed variables: - TYPE(BladeInputData), INTENT(INOUT) :: BladeKInputFileData !< Data for Blade K stored in the module's input file CHARACTER(*), INTENT(IN) :: BldFile !< Name of the blade input file data INTEGER(IntKi), INTENT(IN) :: UnEc !< I/O unit for echo file. If present and > 0, write to UnEc - INTEGER(IntKi), INTENT(OUT) :: ErrStat !< Error status CHARACTER(*), INTENT(OUT) :: ErrMsg !< Error message - - ! Local variables: - + ! Local variables: + integer(IntKi) :: CurLine !< current line in the input file + character(1024) :: TmpComment !< temporary comment line + TYPE(FileInfoType) :: InFileInfo !< The derived type for holding the full input file for parsing REAL(ReKi) :: AdjBlMs ! Factor to adjust blade mass density. REAL(ReKi) :: AdjEdSt ! Factor to adjust edge stiffness. REAL(ReKi) :: AdjFlSt ! Factor to adjust flap stiffness. - - REAL(ReKi) :: TmpRAry(17) ! Temporary variable to read table from file (up to 17 columns) - - INTEGER(IntKi) :: I ! A generic DO index. + REAL(ReKi) :: TmpRAry(6) ! Temporary variable to read table from file (up to 6 columns) + INTEGER(IntKi) :: i ! A generic DO index. INTEGER( IntKi ) :: UnIn ! Unit number for reading file - INTEGER( IntKi ) :: NInputCols ! Number of columns to be read from the file INTEGER(IntKi) :: ErrStat2 ! Temporary Error status CHARACTER(ErrMsgLen) :: ErrMsg2 ! Temporary Err msg CHARACTER(*), PARAMETER :: RoutineName='ReadBladeFile' ErrStat = ErrID_None ErrMsg = "" - - UnIn = -1 - !$OMP critical(filename) - CALL GetNewUnit( UnIn, ErrStat2, ErrMsg2 ) - IF (ErrStat2 < AbortErrLev) THEN - ! Open the input file for blade K. - CALL OpenFInpFile ( UnIn, BldFile, ErrStat2, ErrMsg2 ) - ENDIF - !$OMP end critical(filename) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) THEN - CALL Cleanup() - RETURN - END IF - - - ! -------------- HEADER ------------------------------------------------------- - ! Skip the header. - - CALL ReadCom ( UnIn, BldFile, 'unused blade file header line 1', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) THEN - CALL Cleanup() - RETURN - END IF - - CALL ReadCom ( UnIn, BldFile, 'unused blade file header line 2', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) THEN - CALL Cleanup() - RETURN - END IF + ! read the input file + call ProcessComFile( BldFile, InFileInfo, ErrStat2, ErrMsg2 ); if (Failed()) return; + ! Parse the input file + CurLine = 1 ! Start at first line + ! -------------- HEADER ------------------------------------------------------- + call ParseCom( InFileInfo, CurLine, TmpComment, ErrStat2, ErrMsg2, UnEc ); if (Failed()) return; + call ParseCom( InFileInfo, CurLine, TmpComment, ErrStat2, ErrMsg2, UnEc ); if (Failed()) return; ! -------------- BLADE PARAMETERS --------------------------------------------- + call ParseCom( InFileInfo, CurLine, TmpComment, ErrStat2, ErrMsg2, UnEc ); if (Failed()) return; - ! Skip the comment line. - - CALL ReadCom ( UnIn, BldFile, 'blade parameters', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) THEN - CALL Cleanup() - RETURN - END IF - - ! NBlInpSt - Number of blade input stations. - - CALL ReadVar ( UnIn, BldFile, BladeKInputFileData%NBlInpSt, 'NBlInpSt', 'Number of blade input stations', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) THEN - CALL Cleanup() - RETURN - END IF - + ! NBlInpSt - Number of blade input stations. + call ParseVar( InFileInfo, CurLine, 'NBlInpSt', BladeKInputFileData%NBlInpSt, ErrStat2, ErrMsg2, UnEc ); if (Failed()) return; - ! .......... Allocate the arrays based on this NBlInpSt input .......... + ! .......... Allocate the arrays based on this NBlInpSt input .......... CALL Alloc_BladeInputProperties( BladeKInputFileData, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) THEN - CALL Cleanup() - RETURN - END IF - - - - ! BldFlDmp - Blade structural damping ratios in flapwise direction. - - CALL ReadAryLines( UnIn, BldFile, BladeKInputFileData%BldFlDmp, SIZE(BladeKInputFileData%BldFlDmp), 'BldFlDmp', & - 'Blade structural damping ratios in flapwise direction', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) THEN - CALL Cleanup() - RETURN - END IF + ! BldFlDmp - Blade structural damping ratios in flapwise direction. Don't check name + do i=1,size(BladeKInputFileData%BldFlDmp) + call ParseVar( InFileInfo, CurLine, '', BladeKInputFileData%BldFlDmp(i), ErrStat2, ErrMsg2, UnEc ); if (Failed()) return; + enddo - - ! BldEdDmp - Blade structural damping ratios in edgewise direction. - - CALL ReadAryLines( UnIn, BldFile, BladeKInputFileData%BldEdDmp, SIZE(BladeKInputFileData%BldEdDmp), 'BldEdDmp', & - 'Blade structural damping ratios in edgewise direction', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) THEN - CALL Cleanup() - RETURN - END IF + ! BldEdDmp - Blade structural damping ratios in edgewise direction. Don't check name + do i=1,size(BladeKInputFileData%BldEdDmp) + call ParseVar( InFileInfo, CurLine, '', BladeKInputFileData%BldEdDmp(i), ErrStat2, ErrMsg2, UnEc ); if (Failed()) return; + enddo ! -------------- BLADE ADJUSTMENT FACTORS ------------------------------------- + call ParseCom( InFileInfo, CurLine, TmpComment, ErrStat2, ErrMsg2, UnEc ); if (Failed()) return; + ! FlStTunr(1) - Blade flapwise modal stiffness tuners. Don't check name + do i=1,size(BladeKInputFileData%FlStTunr) + call ParseVar( InFileInfo, CurLine, '', BladeKInputFileData%FlStTunr(i), ErrStat2, ErrMsg2, UnEc ); if (Failed()) return; + enddo - ! Skip the comment line. - - CALL ReadCom ( UnIn, BldFile, 'blade adjustment factors', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) THEN - CALL Cleanup() - RETURN - END IF - - - ! FlStTunr(1) - Blade flapwise modal stiffness tuners. - - CALL ReadAryLines ( UnIn, BldFile, BladeKInputFileData%FlStTunr, SIZE(BladeKInputFileData%FlStTunr), 'FlStTunr', & - 'Blade flapwise modal stiffness tuners', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) THEN - CALL Cleanup() - RETURN - END IF - - - - ! AdjBlMs - Factor to adjust blade mass density. - - CALL ReadVar ( UnIn, BldFile, AdjBlMs, 'AdjBlMs', 'Factor to adjust blade mass density', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) THEN - CALL Cleanup() - RETURN - END IF - - - ! AdjFlSt - Factor to adjust blade flap stiffness. - - CALL ReadVar ( UnIn, BldFile, AdjFlSt, 'AdjFlSt', 'Factor to adjust blade flap stiffness', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) THEN - CALL Cleanup() - RETURN - END IF - - - ! AdjEdSt - Factor to adjust blade edge stiffness. + ! AdjBlMs - Factor to adjust blade mass density. + call ParseVar( InFileInfo, CurLine, 'AdjBlMs', AdjBlMs, ErrStat2, ErrMsg2, UnEc ); if (Failed()) return; - CALL ReadVar ( UnIn, BldFile, AdjEdSt, 'AdjEdSt', 'Factor to adjust blade edge stiffness', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) THEN - CALL Cleanup() - RETURN - END IF + ! AdjFlSt - Factor to adjust blade flap stiffness. + call ParseVar( InFileInfo, CurLine, 'AdjFlSt', AdjFlSt, ErrStat2, ErrMsg2, UnEc ); if (Failed()) return; + ! AdjEdSt - Factor to adjust blade edge stiffness. + call ParseVar( InFileInfo, CurLine, 'AdjEdSt', AdjEdSt, ErrStat2, ErrMsg2, UnEc ); if (Failed()) return; - ! Check the locally-defined adjustment factors: AdjBlMs, AdjFlSt, AdjEdSt - - IF ( AdjBlMs <= 0.0_ReKi ) THEN - CALL SetErrStat( ErrID_Warn, 'AdjBlMs must be greater than zero.', ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) THEN - CALL Cleanup() - RETURN - END IF - END IF - - IF ( AdjFlSt <= 0.0_ReKi ) THEN - CALL SetErrStat( ErrID_Warn, 'AdjFlSt must be greater than zero.', ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) THEN - CALL Cleanup() - RETURN - END IF - END IF - - IF ( AdjEdSt <= 0.0_ReKi ) THEN - CALL SetErrStat( ErrID_Warn, 'AdjEdSt must be greater than zero.', ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) THEN - CALL Cleanup() - RETURN - END IF - END IF + call CheckAdjVars() ! Warnings only, so don't need to return ! -------------- DISTRIBUTED BLADE PROPERTIES --------------------------------- - - - ! Skip the comment lines. - - CALL ReadCom ( UnIn, BldFile, 'distributed blade parameters' , ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - CALL ReadCom ( UnIn, BldFile, 'distributed-blade-parameter names', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - CALL ReadCom ( UnIn, BldFile, 'distributed-blade-parameter units', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) THEN - CALL Cleanup() - RETURN - END IF - - - ! Read the table. - - NInputCols = 6 - - - DO I=1,BladeKInputFileData%NBlInpSt - - CALL ReadAry( UnIn, BldFile, TmpRAry, NInputCols, 'Line'//TRIM(Num2LStr(I)), 'Blade input station table', & - ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) THEN - CALL Cleanup() - RETURN - END IF - - BladeKInputFileData%BlFract( I) = TmpRAry(1) - BladeKInputFileData%PitchAx( I) = TmpRAry(2) - BladeKInputFileData%StrcTwst(I) = TmpRAry(3)*D2R ! Input in degrees; converted to radians here - BladeKInputFileData%BMassDen(I) = TmpRAry(4)*AdjBlMs ! Apply the correction factors to the elemental data. - BladeKInputFileData%FlpStff( I) = TmpRAry(5)*AdjFlSt ! Apply the correction factors to the elemental data. - BladeKInputFileData%EdgStff( I) = TmpRAry(6)*AdjEdSt ! Apply the correction factors to the elemental data. - - ENDDO ! I - - + ! Skip the comment lines. + call ParseCom( InFileInfo, CurLine, TmpComment, ErrStat2, ErrMsg2, UnEc ); if (Failed()) return; ! Separator + call ParseCom( InFileInfo, CurLine, TmpComment, ErrStat2, ErrMsg2, UnEc ); if (Failed()) return; ! Col Names + call ParseCom( InFileInfo, CurLine, TmpComment, ErrStat2, ErrMsg2, UnEc ); if (Failed()) return; ! Col Units + + ! The table may contain 6 columns if it includes PitchAxis (older format), otherwise it should only contain 5 columns + ! Attempt to read 6 columns: + call ParseAry( InFileInfo, CurLine, 'Blade input station table', TmpRAry, 6, ErrStat2, ErrMsg2) ! Don't write to echo + +!FIXME: remove the deprecated format at some point in the future!!! + ! 6 Columns -- deprecated format + if (ErrStat2 == ErrID_None) then ! contains PitchAxis input + CurLine = CurLine - 1 ! Backup one line to read entire table + call ParseTable6Col(ErrStat2, ErrMsg2); if (Failed()) return; + else ! no PitchAxis input + ! NOTE: don't backup a line as a failed ParesAry above won't increment the current line + call ParseTable5Col(ErrStat2, ErrMsg2); if (Failed()) return; + endif ! -------------- BLADE MODE SHAPES -------------------------------------------- + ! NOTE: there is no coefficient for mode 0, so starts at BldFl1Sh(2), hence using (i+1) + ! NOTE: it might be really annoying to make sure variable name is correct in the input file. In that case, set the variable name to '' so it is ignored. + call ParseCom( InFileInfo, CurLine, TmpComment, ErrStat2, ErrMsg2, UnEc ); if (Failed()) return; + ! BldFl1Sh - Blade-flap mode-1 shape coefficients. Don't check name + do i=1,size(BladeKInputFileData%BldFl1Sh) + call ParseVar( InFileInfo, CurLine, '', BladeKInputFileData%BldFl1Sh(i), ErrStat2, ErrMsg2, UnEc ); if (Failed()) return; + enddo - ! Skip the comment line. - - CALL ReadCom ( UnIn, BldFile, 'blade mode shapes', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) THEN - CALL Cleanup() - RETURN - END IF - - - ! BldFl1Sh - Blade-flap mode-1 shape coefficients. - CALL ReadAryLines ( UnIn, BldFile, BladeKInputFileData%BldFl1Sh, SIZE(BladeKInputFileData%BldFl1Sh), 'BldFl1Sh', & - 'Blade-flap mode-1 shape coefficients', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) THEN - CALL Cleanup() - RETURN - END IF - - - ! BldFl2Sh - Blade-flap mode-2 shape coefficients. - - CALL ReadAryLines ( UnIn, BldFile, BladeKInputFileData%BldFl2Sh, SIZE(BladeKInputFileData%BldFl2Sh), 'BldFl2Sh', & - 'Blade-flap mode-2 shape coefficients', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) THEN - CALL Cleanup() - RETURN - END IF - - - ! BldEdgSh - Blade-edge mode shape coefficients. - - CALL ReadAryLines ( UnIn, BldFile, BladeKInputFileData%BldEdgSh, SIZE(BladeKInputFileData%BldEdgSh), 'BldEdgSh', & - 'Blade-edge mode shape coefficients', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) THEN - CALL Cleanup() - RETURN - END IF + ! BldFl2Sh - Blade-flap mode-2 shape coefficients. Don't check name + do i=1,size(BladeKInputFileData%BldFl2Sh) + call ParseVar( InFileInfo, CurLine, '', BladeKInputFileData%BldFl2Sh(i), ErrStat2, ErrMsg2, UnEc ); if (Failed()) return; + enddo + ! BldEdgSh - Blade-edge mode shape coefficients. Don't check name + do i=1,size(BladeKInputFileData%BldEdgSh) + call ParseVar( InFileInfo, CurLine, '', BladeKInputFileData%BldEdgSh(i), ErrStat2, ErrMsg2, UnEc ); if (Failed()) return; + enddo ! -------------- END OF FILE -------------------------------------------- - - ! Close the blade file. - - call Cleanup() - RETURN + ! Verify that everything was read and stored correctly + !call PrintBladeFileContents() CONTAINS - - SUBROUTINE Cleanup() - IF (UnIn > 0) CLOSE( UnIn ) - END SUBROUTINE Cleanup - -END SUBROUTINE ReadBladeFile -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine reads in the AeroDyn v14.00.00 input file to get the -!! blade discretization used in the structural dynamics module. -SUBROUTINE ReadBladeMeshFileAD( BladeKInputFileMesh, MeshFile, UnEc, ErrStat, ErrMsg ) -!.................................................................................................................................. - - ! Passed variables - - TYPE(ED_BladeMeshInputData), INTENT(INOUT) :: BladeKInputFileMesh !< All the data in the ElastoDyn input file - CHARACTER(*), INTENT(IN) :: MeshFile !< Name of the AeroDyn input file data (for mesh) - - INTEGER(IntKi), INTENT(IN) :: UnEc !< I/O unit for echo file. If present and > 0, write to UnEc - INTEGER(IntKi), INTENT(OUT) :: ErrStat !< Error status - CHARACTER(*), INTENT(OUT) :: ErrMsg !< Error message - - ! Local variables: - INTEGER(IntKi), PARAMETER :: NInputCols = 4 ! Number of input columns to be read from the file - REAL(ReKi) :: TmpRAry(NInputCols) ! Temporary variable to read table from file - INTEGER(IntKi) :: I ! loop counter - INTEGER(IntKi) :: NumLin2Skp ! number of lines to read - INTEGER(IntKi) :: NumFoil ! number of airfoil lines to skip in the AD input file. - INTEGER(IntKi) :: UnIn ! Unit number for reading file - - INTEGER(IntKi) :: ErrStat2 ! Temporary Error status - CHARACTER(ErrMsgLen) :: ErrMsg2 ! Temporary Err msg - CHARACTER(*), PARAMETER :: RoutineName = 'ReadBladeMeshFileAD' - CHARACTER(1024) :: Line ! Temporary string. -! CHARACTER(1024) :: TmpStr(1) ! Temporary string. - - - - ! Get an available unit number for the file. - - !$OMP critical(filename) - CALL GetNewUnit( UnIn, ErrStat, ErrMsg ) - IF ( ErrStat < AbortErrLev ) THEN - ! Open the AeroDyn input file. - CALL OpenFInpFile ( UnIn, MeshFile, ErrStat2, ErrMsg2 ) - ENDIF - !$OMP end critical(filename) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) THEN - CALL Cleanup() - RETURN - END IF - - - ! Add a separator to the echo file if appropriate. - - IF ( UnEc > 0 ) WRITE (UnEc,'(//,A,/)') 'Mesh input data from (AeroDyn input) file "'//TRIM( MeshFile )//'":' - - - ! -------------- HEADER ------------------------------------------------------- - ! BJJ: This file is AeroDyn's input file. Until we decide on a format for the - ! structural dynamics input, we will get this information from AeroDyn like we - ! used to. - - DO I = 1,9 - CALL ReadCom ( UnIn, MeshFile, 'AeroDyn input (for structural dynamics mesh)', ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - IF ( ErrStat >= AbortErrLev ) THEN - CALL Cleanup() - RETURN - END IF - - ! See if the next line is "NEWTOWER". If it is, read 7 more lines. If not, read 5 more lines. - - CALL ReadVar( UnIn, MeshFile, Line, VarName='NewTowerModel?', VarDescr='Check for tower influence model', ErrStat=ErrStat2, ErrMsg=ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) THEN - CALL Cleanup() - RETURN - END IF - - ! Check if this is the "special string" to indicate the new tower influence model - - CALL Conv2UC( Line ) - IF ( INDEX(Line, "NEWTOWER" ) > 0 ) THEN - NumLin2Skp = 7 - ELSE - NumLin2Skp = 5 - END IF - - DO I = 1,NumLin2Skp - CALL ReadCom ( UnIn, MeshFile, 'AeroDyn input (for structural dynamics mesh)', ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) THEN - CALL Cleanup() - RETURN - END IF - END DO - - CALL ReadVar ( UnIn, MeshFile, NumFoil, 'NumFoil', & - 'Number of airfoil lines to skip in AeroDyn input (for structural dynamics mesh)', ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) THEN - CALL Cleanup() - RETURN - END IF - - DO I = 1,NumFoil - CALL ReadCom ( UnIn, MeshFile, 'AeroDyn input (for structural dynamics mesh)', ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) THEN - CALL Cleanup() - RETURN - END IF - END DO - - - ! -------------- Blade Mesh Data -------------------------------------------------- - - ! Read in the number of blade elements - CALL ReadVar( UnIn, MeshFile, BladeKInputFileMesh%BldNodes, 'BldNodes', 'Number of blade elements', ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) THEN - CALL Cleanup() - RETURN - END IF - - ! Allocate the arrays to store input - CALL Alloc_BladeMeshInputProperties( BladeKInputFileMesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) THEN - CALL Cleanup() - RETURN - END IF - - ! Read comment line for the element table - CALL ReadCom( UnIn, MeshFile, 'Blade element table headers', ErrStat2, ErrMsg2, UnEc) + logical function Failed() CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) THEN - CALL Cleanup() - RETURN - END IF - - DO I = 1, BladeKInputFileMesh%BldNodes - - CALL ReadAry( UnIn, MeshFile, TmpRAry, NInputCols, 'Blade element line'//TRIM(Num2LStr(I)), 'Blade element input table', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) THEN - CALL Cleanup() - RETURN - END IF - - BladeKInputFileMesh%RNodes( I) = TmpRAry(1) - BladeKInputFileMesh%AeroTwst(I) = TmpRAry(2)*D2R !Convert input file data (degrees) to radians - BladeKInputFileMesh%Chord( I) = TmpRAry(4) - - END DO - - !bjj: move this to a validation routine if we plan to keep AD14 stuff in ElastoDyn: - IF ( ANY( BladeKInputFileMesh%Chord < 0.0_ReKi ) ) THEN - call SetErrStat( ErrID_Fatal, 'Chord length must be larger than 0 meters.', ErrStat, ErrMsg, RoutineName ) - RETURN - END IF - - - ! Close the input file: - - CALL cleanup() - RETURN - - -CONTAINS - SUBROUTINE Cleanup() - CLOSE( UnIn ) - END SUBROUTINE Cleanup -END SUBROUTINE ReadBladeMeshFileAD + Failed = ErrStat >= AbortErrLev + end function Failed + subroutine CheckAdjVars() + IF ( AdjBlMs <= 0.0_ReKi ) call SetErrStat( ErrID_Warn, 'AdjBlMs must be greater than zero.', ErrStat, ErrMsg, RoutineName ) + IF ( AdjFlSt <= 0.0_ReKi ) call SetErrStat( ErrID_Warn, 'AdjFlSt must be greater than zero.', ErrStat, ErrMsg, RoutineName ) + IF ( AdjEdSt <= 0.0_ReKi ) call SetErrStat( ErrID_Warn, 'AdjEdSt must be greater than zero.', ErrStat, ErrMsg, RoutineName ) + end subroutine + subroutine ParseTable5Col(ErrStat3, ErrMsg3) + integer(IntKi), intent(out) :: ErrStat3 + character(ErrMsgLen), intent(out) :: ErrMsg3 + integer(IntKi), parameter :: NInputCols = 5 + do I=1,BladeKInputFileData%NBlInpSt + call ParseAry( InFileInfo, CurLine, 'Blade input station table', TmpRAry, NInputCols, ErrStat3, ErrMsg3, UnEc) + if (ErrStat3 >= AbortErrLev) return; + BladeKInputFileData%BlFract( I) = TmpRAry(1) + BladeKInputFileData%StrcTwst(I) = TmpRAry(2)*D2R ! Input in degrees; converted to radians here + BladeKInputFileData%BMassDen(I) = TmpRAry(3)*AdjBlMs ! Apply the correction factors to the elemental data. + BladeKInputFileData%FlpStff( I) = TmpRAry(4)*AdjFlSt ! Apply the correction factors to the elemental data. + BladeKInputFileData%EdgStff( I) = TmpRAry(5)*AdjEdSt ! Apply the correction factors to the elemental data. + enddo + end subroutine + subroutine ParseTable6Col(ErrStat3, ErrMsg3) + integer(IntKi), intent(out) :: ErrStat3 + character(ErrMsgLen), intent(out) :: ErrMsg3 + integer(IntKi), parameter :: NInputCols = 6 + do I=1,BladeKInputFileData%NBlInpSt + call ParseAry( InFileInfo, CurLine, 'Blade input station table', TmpRAry, NInputCols, ErrStat3, ErrMsg3, UnEc) + if (ErrStat3 >= AbortErrLev) return; + BladeKInputFileData%BlFract( I) = TmpRAry(1) + BladeKInputFileData%PitchAx( I) = TmpRAry(2) + BladeKInputFileData%StrcTwst(I) = TmpRAry(3)*D2R ! Input in degrees; converted to radians here + BladeKInputFileData%BMassDen(I) = TmpRAry(4)*AdjBlMs ! Apply the correction factors to the elemental data. + BladeKInputFileData%FlpStff( I) = TmpRAry(5)*AdjFlSt ! Apply the correction factors to the elemental data. + BladeKInputFileData%EdgStff( I) = TmpRAry(6)*AdjEdSt ! Apply the correction factors to the elemental data. + enddo + ! Set warning that this is a depricated format (grab filename corresponding to the main blade file in case the table is separate) + ErrStat3 = ErrID_Warn + ErrMsg3 = "The ElastoDyn Blade file, "//trim(InFileInfo%FileList(1))// & + ", DISTRIBUTED BLADE PROPERTIES table contains the PitchAxis column. This column is unused and will be removed in future releases" + end subroutine + !> write out the blade file contents to screen (use in debugging only) + subroutine PrintBladeFileContents() + integer(IntKi) :: j + character(1024):: TmpStr + call WrScr('========================================================') + call WrScr('Parsed contents of ED blade file:') + call WrScr(' NBlInpSt '//trim(Num2LStr(BladeKInputFileData%NBlInpSt))) + do j=1,size(BladeKInputFileData%BldFlDmp) + call WrScr(' BldFlDmp('//trim(Num2LStr(j))//') '//trim(Num2LStr(BladeKInputFileData%BldFlDmp(j)))) + enddo + do j=1,size(BladeKInputFileData%BldEdDmp) + call WrScr(' BldEdDmp('//trim(Num2LStr(j))//') '//trim(Num2LStr(BladeKInputFileData%BldEdDmp(j)))) + enddo + do j=1,size(BladeKInputFileData%FlStTunr) + call WrScr(' FlStTunr('//trim(Num2LStr(j))//') '//trim(Num2LStr(BladeKInputFileData%FlStTunr(j)))) + enddo + call WrScr(' AdjBlMs '//trim(Num2LStr(AdjBlMs))) + call WrScr(' AdjFlSt '//trim(Num2LStr(AdjFlSt))) + call WrScr(' AdjEdSt '//trim(Num2LStr(AdjEdSt))) + + do j=1,size(BladeKInputFileData%BldFl1Sh) + call WrScr(' BldFl1Sh('//trim(Num2LStr(j))//') '//trim(Num2LStr(BladeKInputFileData%BldFl1Sh(j)))) + enddo + do j=1,size(BladeKInputFileData%BldFl2Sh) + call WrScr(' BldFl2Sh('//trim(Num2LStr(j))//') '//trim(Num2LStr(BladeKInputFileData%BldFl2Sh(j)))) + enddo + do j=1,size(BladeKInputFileData%BldEdgSh) + call WrScr(' BldEdgSh('//trim(Num2LStr(j))//') '//trim(Num2LStr(BladeKInputFileData%BldEdgSh(j)))) + enddo + + call WrScr(' Blade table (after applied scalings)') + call WrScr(' BlFract StrcTwst BMassDen FlpStff EdgStff') + do j=1,BladeKInputFileData%NBlInpSt + write(TmpStr,'(A,5(3x,ES15.9))') ' ',BladeKInputFileData%BlFract( j),BladeKInputFileData%StrcTwst(j),BladeKInputFileData%BMassDen(j),BladeKInputFileData%FlpStff( j),BladeKInputFileData%EdgStff( j) + call WrScr(trim(TmpStr)) + enddo + call WrScr('========================================================') + end subroutine +END SUBROUTINE ReadBladeFile !---------------------------------------------------------------------------------------------------------------------------------- !> This routine reads the furling file input and converts units as appropriate. SUBROUTINE ReadFurlFile( FurlFile, InputFileData, UnEc, ErrStat, ErrMsg ) @@ -3248,6 +3132,30 @@ SUBROUTINE ReadPrimaryFile( InputFile, InputFileData, BldFile, FurlFile, TwrFile RETURN END IF + ! PtfmXYIner - Platform xy inertia about the platform CM (kg m^2): + CALL ReadVar( UnIn, InputFile, InputFileData%PtfmXYIner, "PtfmXYIner", "Platform xy inertia about the platform CM (kg m^2)", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + IF ( ErrStat >= AbortErrLev ) THEN + CALL Cleanup() + RETURN + END IF + + ! PtfmYZIner - Platform yz inertia about the platform CM (kg m^2): + CALL ReadVar( UnIn, InputFile, InputFileData%PtfmYZIner, "PtfmYZIner", "Platform yz inertia about the platform CM (kg m^2)", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + IF ( ErrStat >= AbortErrLev ) THEN + CALL Cleanup() + RETURN + END IF + + ! PtfmXZIner - Platform xz inertia about the platform CM (kg m^2): + CALL ReadVar( UnIn, InputFile, InputFileData%PtfmXZIner, "PtfmXZIner", "Platform xz inertia about the platform CM (kg m^2)", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + IF ( ErrStat >= AbortErrLev ) THEN + CALL Cleanup() + RETURN + END IF + !---------------------- BLADE --------------------------------------------------- CALL ReadCom( UnIn, InputFile, 'Section Header: Blade', ErrStat2, ErrMsg2, UnEc ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -3351,6 +3259,94 @@ SUBROUTINE ReadPrimaryFile( InputFile, InputFileData, BldFile, FurlFile, TwrFile RETURN END IF + !---------------------- YAW-FRICTION -------------------------------------------- + CALL ReadCom( UnIn, InputFile, 'Section Header: Yaw-Friction', ErrStat2, ErrMsg2, UnEc ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + IF ( ErrStat >= AbortErrLev ) THEN + CALL Cleanup() + RETURN + END IF + + ! YawFrctMod - Yaw-friction model switch (-): + CALL ReadVar( UnIn, InputFile, InputFileData%YawFrctMod, "YawFrctMod", "Yaw-friction model switch (-)", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + IF ( ErrStat >= AbortErrLev ) THEN + CALL Cleanup() + RETURN + END IF + + ! M_CSmax - Maximum Coulomb friction torque (N-m): + CALL ReadVar( UnIn, InputFile, InputFileData%M_CSmax, "M_CSmax", "Maximum Coulomb friction torque (N-m)", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + IF ( ErrStat >= AbortErrLev ) THEN + CALL Cleanup() + RETURN + END IF + + ! M_FCSmax - Maximum Coulomb friction torque proportional to yaw bearing shear force (N-m): + CALL ReadVar( UnIn, InputFile, InputFileData%M_FCSmax, "M_FCSmax", "Maximum Coulomb friction torque proportional to yaw bearing shear force (N-m)", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + IF ( ErrStat >= AbortErrLev ) THEN + CALL Cleanup() + RETURN + END IF + + ! M_MCSmax - Maximum Coulomb friction torque proportional to yaw bearing bending moment (N-m): + CALL ReadVar( UnIn, InputFile, InputFileData%M_MCSmax, "M_MCSmax", "Maximum Coulomb friction torque proportional to yaw bearing bending moment (N-m)", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + IF ( ErrStat >= AbortErrLev ) THEN + CALL Cleanup() + RETURN + END IF + + ! M_CD - Dynamic friction moment at null yaw rate (N-m): + CALL ReadVar( UnIn, InputFile, InputFileData%M_CD, "M_CD", "Dynamic friction moment at null yaw rate (N-m)", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + IF ( ErrStat >= AbortErrLev ) THEN + CALL Cleanup() + RETURN + END IF + + ! M_FCD - Dynamic friction moment at null yaw rate proportional to yaw bearing shear force (N-m): + CALL ReadVar( UnIn, InputFile, InputFileData%M_FCD, "M_FCD", "Dynamic friction moment at null yaw rate proportional to yaw bearing shear force (N-m)", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + IF ( ErrStat >= AbortErrLev ) THEN + CALL Cleanup() + RETURN + END IF + + ! M_MCD - Dynamic friction moment at null yaw rate proportional to yaw bearing bending moment (N-m): + CALL ReadVar( UnIn, InputFile, InputFileData%M_MCD, "M_MCD", "Dynamic friction moment at null yaw rate proportional to yaw bearing bending moment (N-m)", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + IF ( ErrStat >= AbortErrLev ) THEN + CALL Cleanup() + RETURN + END IF + + ! sig_v - Linear viscous friction coefficiant (N-m s/rad): + CALL ReadVar( UnIn, InputFile, InputFileData%sig_v, "sig_v", "Linear viscous friction coefficient (N-m/(rad/s))", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + IF ( ErrStat >= AbortErrLev ) THEN + CALL Cleanup() + RETURN + END IF + + ! sig_v2 - Quadratic viscous friction coefficiant (N-m (s/rad)^2): + CALL ReadVar( UnIn, InputFile, InputFileData%sig_v2, "sig_v2", "Quadratic viscous friction coefficient (N-m/(rad/s)^2)", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + IF ( ErrStat >= AbortErrLev ) THEN + CALL Cleanup() + RETURN + END IF + + ! OmgCut - Yaw angular velocity cutoff below which viscous friction is to be linearized (rad/s): + CALL ReadVar( UnIn, InputFile, InputFileData%OmgCut, "OmgCut", "Nacelle yaw angular velocity cutoff below which viscous friction is to be linearized (rad/s)", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + IF ( ErrStat >= AbortErrLev ) THEN + CALL Cleanup() + RETURN + END IF + !---------------------- DRIVETRAIN ---------------------------------------------- CALL ReadCom( UnIn, InputFile, 'Section Header: Drivetrain', ErrStat2, ErrMsg2, UnEc ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -3575,12 +3571,12 @@ SUBROUTINE ReadPrimaryFile( InputFile, InputFileData, BldFile, FurlFile, TwrFile !----------- OUTLIST ----------------------------------------------------------- ! In case there is something ill-formed in the additional nodal outputs section, we will simply ignore it and assume that this section does not exist. ErrMsg_NoAllBldNdOuts='Nodal outputs section of ElastoDyn input file not found or improperly formatted.' + InputFileData%BldNd_NumOuts = 0 ! initialize in case of error + InputFileData%BldNd_BladesOut = 0 ! initialize in case of error !----------- OUTLIST for BldNd ----------------------------------------------------------- CALL ReadCom( UnIn, InputFile, 'Section Header: OutList for Blade node channels', ErrStat2, ErrMsg2, UnEc ) IF ( ErrStat2 >= AbortErrLev ) THEN - InputFileData%BldNd_BladesOut = 0 - InputFileData%BldNd_NumOuts = 0 call wrscr( trim(ErrMsg_NoAllBldNdOuts) ) CALL Cleanup() RETURN @@ -3593,7 +3589,6 @@ SUBROUTINE ReadPrimaryFile( InputFile, InputFileData, BldFile, FurlFile, TwrFile CALL ReadVar( UnIn, InputFile, InputFileData%BldNd_BladesOut, 'BldNd_BladesOut', 'Which blades to output node data on.'//TRIM(Num2Lstr(I)), ErrStat2, ErrMsg2, UnEc ) IF ( ErrStat2 >= AbortErrLev ) THEN InputFileData%BldNd_BladesOut = 0 - InputFileData%BldNd_NumOuts = 0 call wrscr( trim(ErrMsg_NoAllBldNdOuts) ) CALL Cleanup() RETURN @@ -3604,8 +3599,6 @@ SUBROUTINE ReadPrimaryFile( InputFile, InputFileData, BldFile, FurlFile, TwrFile ! TODO: Parse this string into an array of nodes to output at (one idea is to set an array of boolean to T/F for which nodes to output). At present, we ignore it entirely. CALL ReadVar( UnIn, InputFile, InputFileData%BldNd_BlOutNd_Str, 'BldNd_BlOutNd_Str', 'Which nodes to output node data on.'//TRIM(Num2Lstr(I)), ErrStat2, ErrMsg2, UnEc ) IF ( ErrStat2 >= AbortErrLev ) THEN - InputFileData%BldNd_BladesOut = 0 - InputFileData%BldNd_NumOuts = 0 call wrscr( trim(ErrMsg_NoAllBldNdOuts) ) CALL Cleanup() RETURN @@ -3615,8 +3608,6 @@ SUBROUTINE ReadPrimaryFile( InputFile, InputFileData, BldFile, FurlFile, TwrFile ! Section header for outlist CALL ReadCom( UnIn, InputFile, 'Section Header: OutList', ErrStat2, ErrMsg2, UnEc ) IF ( ErrStat2 >= AbortErrLev ) THEN - InputFileData%BldNd_BladesOut = 0 - InputFileData%BldNd_NumOuts = 0 call wrscr( trim(ErrMsg_NoAllBldNdOuts) ) CALL Cleanup() RETURN @@ -3625,12 +3616,13 @@ SUBROUTINE ReadPrimaryFile( InputFile, InputFileData, BldFile, FurlFile, TwrFile ! OutList - List of user-requested output channels at each node(-): CALL ReadOutputList ( UnIn, InputFile, InputFileData%BldNd_OutList, InputFileData%BldNd_NumOuts, 'BldNd_OutList', "List of user-requested output channels", ErrStat2, ErrMsg2, UnEc ) ! Routine in NWTC Subroutine Library - IF ( ErrStat2 >= AbortErrLev ) THEN - InputFileData%BldNd_BladesOut = 0 + IF ( ErrStat2 >= AbortErrLev .and. InputFileData%BldNd_NumOuts < 1) THEN InputFileData%BldNd_NumOuts = 0 call wrscr( trim(ErrMsg_NoAllBldNdOuts) ) CALL Cleanup() RETURN + ELSE + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ENDIF !FIXME: this is a hack to fix a segfault. Better logic is really needed for the nodal outputs. @@ -4136,9 +4128,7 @@ SUBROUTINE ValidatePrimaryData( InputFileData, BD4Blades, Linearize, MHK, ErrSta REAL(ReKi) :: SmallAngleLimit_Rad ! Largest input angle considered "small" (check in input file), radians INTEGER(IntKi) :: I ! loop counter INTEGER(IntKi) :: K ! blade number - INTEGER(IntKi) :: FmtWidth ! width of the field returned by the specified OutFmt - INTEGER(IntKi) :: ErrStat2 ! Temporary error status - CHARACTER(ErrMsgLen) :: ErrMsg2 ! Temporary rror message + !!INTEGER(IntKi) :: FmtWidth ! width of the field returned by the specified OutFmt CHARACTER(*), PARAMETER :: RoutineName = 'ValidatePrimaryData' ! Initialize error status and angle limit defined locally (in correct units) @@ -4188,9 +4178,9 @@ SUBROUTINE ValidatePrimaryData( InputFileData, BD4Blades, Linearize, MHK, ErrSta IF ( InputFileData%YawBrMass < 0.0_ReKi) call SetErrStat(ErrID_Fatal,'YawBrMass must not be negative.',ErrStat,ErrMsg,RoutineName) IF ( InputFileData%NacMass < 0.0_ReKi) call SetErrStat(ErrID_Fatal,'NacMass must not be negative.',ErrStat,ErrMsg,RoutineName) IF ( InputFileData%HubMass < 0.0_ReKi) call SetErrStat(ErrID_Fatal,'HubMass must not be negative.',ErrStat,ErrMsg,RoutineName) - IF ( MHK /= 2 ) THEN + IF ( MHK /= MHK_Floating ) THEN IF ( InputFileData%Twr2Shft < 0.0_ReKi) call SetErrStat(ErrID_Fatal,'Twr2Shft must not be negative.',ErrStat,ErrMsg,RoutineName) - ELSEIF ( MHK == 2 ) THEN + ELSE IF ( InputFileData%Twr2Shft > 0.0_ReKi) call SetErrStat(ErrID_Fatal,'Twr2Shft must not be positive for a floating MHK turbine.',ErrStat,ErrMsg,RoutineName) ENDIF @@ -4203,9 +4193,9 @@ SUBROUTINE ValidatePrimaryData( InputFileData, BD4Blades, Linearize, MHK, ErrSta IF ( InputFileData%HubIner < 0.0_ReKi) call SetErrStat(ErrID_Fatal,'HubIner must not be negative.',ErrStat,ErrMsg,RoutineName) ! Check that TowerHt is in the range [0,inf): - IF ( MHK /= 2 ) THEN + IF ( MHK /= MHK_Floating ) THEN IF ( InputFileData%TowerHt <= 0.0_ReKi ) CALL SetErrStat( ErrID_Fatal, 'TowerHt must be greater than zero.',ErrStat,ErrMsg,RoutineName ) - ELSEIF ( MHK == 2 ) THEN + ELSE IF ( InputFileData%TowerHt >= 0.0_ReKi ) CALL SetErrStat( ErrID_Fatal, 'TowerHt must be less than zero for a floating MHK turbine.',ErrStat,ErrMsg,RoutineName ) ENDIF @@ -4217,7 +4207,7 @@ SUBROUTINE ValidatePrimaryData( InputFileData, BD4Blades, Linearize, MHK, ErrSta ! Check that the gearbox efficiency is valid: IF ( ( InputFileData%GBoxEff <= 0.0_ReKi ) .OR. ( InputFileData%GBoxEff > 1.0_ReKi ) ) THEN CALL SetErrStat( ErrID_Fatal, 'GBoxEff must be in the range (0,1] (i.e., (0,100] percent).',ErrStat,ErrMsg,RoutineName ) - ENDIF + ENDIF ! warn if 2nd modes are enabled without their corresponding 1st modes @@ -4246,7 +4236,7 @@ SUBROUTINE ValidatePrimaryData( InputFileData, BD4Blades, Linearize, MHK, ErrSta END IF ENDIF - IF ( MHK /= 2 ) THEN + IF ( MHK /= MHK_Floating ) THEN IF ( InputFileData%TowerBsHt >= InputFileData%TowerHt ) CALL SetErrStat( ErrID_Fatal, 'TowerBsHt must be less than TowerHt.',ErrStat,ErrMsg,RoutineName) @@ -4256,7 +4246,7 @@ SUBROUTINE ValidatePrimaryData( InputFileData, BD4Blades, Linearize, MHK, ErrSta IF ( InputFileData%PtfmRefzt > InputFileData%TowerBsHt ) & CALL SetErrStat( ErrID_Fatal, 'PtfmRefzt must not be greater than TowerBsHt.',ErrStat,ErrMsg,RoutineName) - ELSEIF ( MHK == 2 ) THEN + ELSE IF ( InputFileData%TowerBsHt <= InputFileData%TowerHt ) CALL SetErrStat( ErrID_Fatal, 'TowerBsHt must be greater than TowerHt for a floating MHK turbine.',ErrStat,ErrMsg,RoutineName) @@ -4266,15 +4256,15 @@ SUBROUTINE ValidatePrimaryData( InputFileData, BD4Blades, Linearize, MHK, ErrSta IF (InputFileData%HubRad >= InputFileData%TipRad ) & CALL SetErrStat( ErrID_Fatal, 'HubRad must be less than TipRad.',ErrStat,ErrMsg,RoutineName) - IF ( MHK /= 2 ) THEN + IF ( MHK /= MHK_Floating ) THEN IF ( InputFileData%TowerHt + InputFileData%Twr2Shft + InputFileData%OverHang*SIN(InputFileData%ShftTilt) & <= InputFileData%TipRad ) THEN CALL SetErrStat( ErrID_Fatal, 'TowerHt + Twr2Shft + OverHang*SIN(ShftTilt) must be greater than TipRad.',ErrStat,ErrMsg,RoutineName) END IF - ELSEIF ( MHK == 2 ) THEN + ELSE IF ( -InputFileData%TowerHt - InputFileData%Twr2Shft - InputFileData%OverHang*SIN(InputFileData%ShftTilt) & <= InputFileData%TipRad ) THEN - CALL SetErrStat( ErrID_Fatal, 'TowerHt + Twr2Shft + OverHang*SIN(ShftTilt) must be greater than TipRad.',ErrStat,ErrMsg,RoutineName) + CALL SetErrStat( ErrID_Fatal, '-TowerHt - Twr2Shft - OverHang*SIN(ShftTilt) must be greater than TipRad.',ErrStat,ErrMsg,RoutineName) END IF ENDIF END IF @@ -4333,22 +4323,21 @@ SUBROUTINE ValidatePrimaryData( InputFileData, BD4Blades, Linearize, MHK, ErrSta CALL SetErrStat(ErrID_Fatal,'ShftTilt must be between -pi/2 and pi/2 radians (i.e., in the range [-90, 90] degrees).',ErrStat,ErrMsg,RoutineName) END IF - ! Check for violations of the small-angle assumption (15-degree limit, using radians): - IF ( ABS( InputFileData%PtfmRoll ) > SmallAngleLimit_Rad ) THEN - CALL SetErrStat( ErrID_Fatal, 'PtfmRoll must be between -'//TRIM(Num2LStr(SmallAngleLimit_Rad))//' and ' & - //TRIM(Num2LStr(SmallAngleLimit_Rad))//' radians.',ErrStat,ErrMsg,RoutineName) - END IF + ! IF ( ABS( InputFileData%PtfmRoll ) > SmallAngleLimit_Rad ) THEN + ! CALL SetErrStat( ErrID_Fatal, 'PtfmRoll must be between -'//TRIM(Num2LStr(SmallAngleLimit_Rad))//' and ' & + ! //TRIM(Num2LStr(SmallAngleLimit_Rad))//' radians.',ErrStat,ErrMsg,RoutineName) + ! END IF - IF ( ABS( InputFileData%PtfmPitch ) > SmallAngleLimit_Rad ) THEN - CALL SetErrStat( ErrID_Fatal, 'PtfmPitch must be between -'//TRIM(Num2LStr(SmallAngleLimit_Rad))//' and ' & - //TRIM(Num2LStr(SmallAngleLimit_Rad))//' radians.',ErrStat,ErrMsg,RoutineName) - END IF + ! IF ( ABS( InputFileData%PtfmPitch ) > SmallAngleLimit_Rad ) THEN + ! CALL SetErrStat( ErrID_Fatal, 'PtfmPitch must be between -'//TRIM(Num2LStr(SmallAngleLimit_Rad))//' and ' & + ! //TRIM(Num2LStr(SmallAngleLimit_Rad))//' radians.',ErrStat,ErrMsg,RoutineName) + ! END IF - IF ( ABS( InputFileData%PtfmYaw ) > SmallAngleLimit_Rad ) THEN - CALL SetErrStat( ErrID_Fatal, 'PtfmYaw must be between -'//TRIM(Num2LStr(SmallAngleLimit_Rad))//' and ' & - //TRIM(Num2LStr(SmallAngleLimit_Rad))//' radians.',ErrStat,ErrMsg,RoutineName) - END IF + ! IF ( ABS( InputFileData%PtfmYaw ) > SmallAngleLimit_Rad ) THEN + ! CALL SetErrStat( ErrID_Fatal, 'PtfmYaw must be between -'//TRIM(Num2LStr(SmallAngleLimit_Rad))//' and ' & + ! //TRIM(Num2LStr(SmallAngleLimit_Rad))//' radians.',ErrStat,ErrMsg,RoutineName) + ! END IF ! Check the output parameters: IF ( InputFileData%DecFact < 1_IntKi ) CALL SetErrStat( ErrID_Fatal, 'DecFact must be greater than 0.',ErrStat,ErrMsg,RoutineName ) @@ -4385,6 +4374,25 @@ SUBROUTINE ValidatePrimaryData( InputFileData, BD4Blades, Linearize, MHK, ErrSta END IF + !Yaw-Friction User input checks + IF ( ( InputFileData%YawFrctMod /= 0_IntKi ) .AND. ( InputFileData%YawFrctMod /= 1_IntKi ) .AND. & + ( InputFileData%YawFrctMod /= 2_IntKi ) .AND. ( InputFileData%YawFrctMod /= 3_IntKi )) & + CALL SetErrStat( ErrID_Fatal, 'YawFrctMod must be 0, 1, 2, or 3',ErrStat,ErrMsg,RoutineName) + IF ( InputFileData%M_CD < 0_R8Ki ) CALL SetErrStat( ErrID_Fatal, 'M_CD must be greater than or equal to 0.', ErrStat,ErrMsg,RoutineName ) + IF ( InputFileData%M_FCD < 0_R8Ki ) CALL SetErrStat( ErrID_Fatal, 'M_FCD must be greater than or equal to 0.', ErrStat,ErrMsg,RoutineName ) + IF ( InputFileData%M_MCD < 0_R8Ki ) CALL SetErrStat( ErrID_Fatal, 'M_MCD must be greater than or equal to 0.', ErrStat,ErrMsg,RoutineName ) + IF ( InputFileData%M_CSmax < 0_R8Ki ) CALL SetErrStat( ErrID_Fatal, 'M_CSmax must be greater than or equal to 0.', ErrStat,ErrMsg,RoutineName ) + IF ( InputFileData%M_FCSmax < 0_R8Ki ) CALL SetErrStat( ErrID_Fatal, 'M_FCSmax must be greater than or equal to 0.',ErrStat,ErrMsg,RoutineName ) + IF ( InputFileData%M_MCSmax < 0_R8Ki ) CALL SetErrStat( ErrID_Fatal, 'M_MCSmax must be greater than or equal to 0.',ErrStat,ErrMsg,RoutineName ) + IF ( InputFileData%sig_v < 0_R8Ki ) CALL SetErrStat( ErrID_Fatal, 'sig_v must be greater than or equal to 0.', ErrStat,ErrMsg,RoutineName ) + IF ( InputFileData%sig_v2 < 0_R8Ki ) CALL SetErrStat( ErrID_Fatal, 'sig_v2 must be greater than or equal to 0.', ErrStat,ErrMsg,RoutineName ) + IF ( InputFileData%OmgCut < 0_R8Ki ) CALL SetErrStat( ErrID_Fatal, 'OmgCut must be greater than or equal to 0.', ErrStat,ErrMsg,RoutineName ) + + ! The static Coulomb friction coefficients must be greater than or equal to their dynamic counterparts. + IF ( InputFileData%M_CSmax < InputFileData%M_CD ) CALL SetErrStat( ErrID_Fatal, 'M_CSmax must be greater than or equal to M_CD.', ErrStat,ErrMsg,RoutineName ) + IF ( InputFileData%M_FCSmax < InputFileData%M_FCD ) CALL SetErrStat( ErrID_Fatal, 'M_FCSmax must be greater than or equal to M_FCD.',ErrStat,ErrMsg,RoutineName ) + IF ( InputFileData%M_MCSmax < InputFileData%M_MCD ) CALL SetErrStat( ErrID_Fatal, 'M_MCSmax must be greater than or equal to M_MCD.',ErrStat,ErrMsg,RoutineName ) + !bjj: since ED doesn't actually use OutFmt at this point, I'm going to remove this check and warning message !!!! ! Check that InputFileData%OutFmt is a valid format specifier and will fit over the column headings !!!!CALL ChkRealFmtStr( InputFileData%OutFmt, 'OutFmt', FmtWidth, ErrStat2, ErrMsg2 ) diff --git a/modules/elastodyn/src/ElastoDyn_Registry.txt b/modules/elastodyn/src/ElastoDyn_Registry.txt index d18ab670cd..2210e9b573 100644 --- a/modules/elastodyn/src/ElastoDyn_Registry.txt +++ b/modules/elastodyn/src/ElastoDyn_Registry.txt @@ -20,12 +20,14 @@ param ElastoDyn/ED - IntKi ED_NMX - 4 - "Used in updating predictor-corrector va # Define inputs that the initialization routine may need here: typedef ElastoDyn/ED 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 CHARACTER(1024) ADInputFile - - - "Name of the AeroDyn input file (in this verison, that is where we'll get the blade mesh info" - typedef ^ InitInputType LOGICAL CompElast - - - "flag to determine if ElastoDyn is computing blade loads (true) or BeamDyn is (false)" - +typedef ^ InitInputType LOGICAL RigidAero - - - "flag to determine if ElastoDyn if blades are rigid for aero -- when AeroDisk is used" - typedef ^ InitInputType CHARACTER(1024) RootName - - - "RootName for writing output files" typedef ^ InitInputType ReKi Gravity - - - "Gravitational acceleration" m/s^2 typedef ^ InitInputType IntKi MHK - - - "MHK turbine type switch" - typedef ^ InitInputType ReKi WtrDpth - - - "Water depth" m +typedef ^ InitInputType LOGICAL CompAeroMaps - .FALSE. - "flag to determine if ElastoDyn is computing aero maps (true) or running a normal simulation (false)" - +typedef ^ InitInputType ReKi RotSpeed - - - "Rotor speed used when ElastoDyn is computing aero maps" "rad/s" # Define outputs from the initialization routine here: typedef ^ InitOutputType CHARACTER(ChanLen) WriteOutputHdr {:} - - "Names of the output-to-file channels" - @@ -34,7 +36,7 @@ typedef ^ InitOutputType ProgDesc Ver - - - "This module's name, version, and da typedef ^ InitOutputType IntKi NumBl - - - "Number of blades on the turbine" - typedef ^ InitOutputType ReKi BlPitch {:} - - "Initial blade pitch angles" radians typedef ^ InitOutputType ReKi BladeLength - - - "Blade length (for AeroDyn)" meters -typedef ^ InitOutputType ReKi TowerHeight - - - "Tower Height" meters +typedef ^ InitOutputType ReKi TowerFlexL - - - "Tower Flexible Length" meters typedef ^ InitOutputType ReKi TowerBaseHeight - - - "Tower Base Height" meters typedef ^ InitOutputType ReKi HubHt - - - "Height of the hub" meters typedef ^ InitOutputType ReKi BldRNodes {:} - - "Radius to analysis nodes relative to hub ( 0 < RNodes(:) < BldFlexL )" @@ -55,6 +57,7 @@ typedef ^ InitOutputType LOGICAL RotFrame_x {:} - - "Flag that tells FAST/MBC3 i typedef ^ InitOutputType IntKi DerivOrder_x {:} - - "Integer that tells FAST/MBC3 the maximum derivative order of continuous states used in linearization" - 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 GearBox_index - - - "Index to gearbox rotation in state array (for steady-state calculations)" - # ..... Blade Input file data ........................................................................................................... typedef ElastoDyn/ED BladeInputData IntKi NBlInpSt - - - "Number of blade input stations" - @@ -150,6 +153,9 @@ typedef ^ ED_InputFile ReKi PtfmMass - - - "Platform mass" kg typedef ^ ED_InputFile ReKi PtfmRIner - - - "Platform inertia for roll tilt rotation about the platform CM" "kg m^2" typedef ^ ED_InputFile ReKi PtfmPIner - - - "Platform inertia for pitch tilt rotation about the platform CM" "kg m^2" typedef ^ ED_InputFile ReKi PtfmYIner - - - "Platform inertia for yaw rotation about the platform CM" "kg m^2" +typedef ^ ED_InputFile ReKi PtfmXYIner - - - "Platform xy inertia about the platform CM" "kg m^2" +typedef ^ ED_InputFile ReKi PtfmYZIner - - - "Platform yz inertia about the platform CM" "kg m^2" +typedef ^ ED_InputFile ReKi PtfmXZIner - - - "Platform xz inertia about the platform CM" "kg m^2" typedef ^ ED_InputFile ReKi BldNodes - - - "Number of blade nodes (per blade) used for analysis" - typedef ^ ED_InputFile ED_BladeMeshInputData InpBlMesh {:} - - "Input data for blade discretizations (could be on each blade)" "see BladeMeshInputData" typedef ^ ED_InputFile BladeInputData InpBl {:} - - "Input data for individual blades" "see BladeInputData type" @@ -161,6 +167,16 @@ typedef ^ ED_InputFile ReKi TeetSStP - - - "Rotor-teeter soft-stop position" rad typedef ^ ED_InputFile ReKi TeetHStP - - - "Rotor-teeter hard-stop position" radians typedef ^ ED_InputFile ReKi TeetSSSp - - - "Rotor-teeter soft-stop linear-spring constant" N-m/rad typedef ^ ED_InputFile ReKi TeetHSSp - - - "Rotor-teeter hard-stop linear-spring constant" N-m/rad +typedef ^ ED_InputFile IntKi YawFrctMod - - - "Identifier for YawFrctMod (0 [no friction], 1 [does not use Fz at bearing], 2 [does use Fz at bearing], or 3 [user defined model]" - +typedef ^ ED_InputFile R8Ki M_CD - - - "Dynamic friction moment at null yaw rate" N-m +typedef ^ ED_InputFile R8Ki M_FCD - - - "Dynamic friction moment at null yaw rate proportional to yaw bearing shear force" N-m +typedef ^ ED_InputFile R8Ki M_MCD - - - "Dynamic friction moment at null yaw rate proportional to yaw bearing bending moment" N-m +typedef ^ ED_InputFile R8Ki M_CSMAX - - - "Maximum Coulomb friction torque" N-m +typedef ^ ED_InputFile R8Ki M_FCSMAX - - - "Maximum Coulomb friction torque proportional to yaw bearing shear force" N-m +typedef ^ ED_InputFile R8Ki M_MCSMAX - - - "Maximum Coulomb friction torque proportional to yaw bearing bending moment" N-m +typedef ^ ED_InputFile R8Ki sig_v - - - "Linear viscous friction coefficient" N-m/(rad/s) +typedef ^ ED_InputFile R8Ki sig_v2 - - - "Quadratic viscous friction coefficient" N-m/(rad/s)^2 +typedef ^ ED_InputFile R8Ki OmgCut - - - "Nacelle yaw angular velocity cutoff below which viscous friction is to be linearized" rad/s typedef ^ ED_InputFile ReKi GBoxEff - - - "Gearbox efficiency" % typedef ^ ED_InputFile ReKi GBRatio - - - "Gearbox ratio" - typedef ^ ED_InputFile ReKi DTTorSpr - - - "Drivetrain torsional spring" N-m/rad @@ -252,6 +268,12 @@ typedef ^ ED_InputFile IntKi BldNd_BladesOut - - - "The blades to output (ED # ..... Internal data types: Coordinate Systems ................................................................................... # This type defines coordinate sytems used internally by FAST. The 3 components of each vector correspond to the z1, z2, and z3 components of the individual vectors. # NOTE: the orientations of most of these coordinate systems will change every time step. +typedef ^ ED_CoordSys R8Ki alpha1 3 - - "Vector / direction alpha1 after ptfm yaw rotation" - +typedef ^ ED_CoordSys R8Ki alpha2 3 - - "Vector / direction alpha2 after ptfm yaw rotation" - +typedef ^ ED_CoordSys R8Ki alpha3 3 - - "Vector / direction alpha3 after ptfm yaw rotation" - +typedef ^ ED_CoordSys R8Ki beta1 3 - - "Vector / direction beta1 after ptfm yaw and pitch rotation" - +typedef ^ ED_CoordSys R8Ki beta2 3 - - "Vector / direction beta2 after ptfm yaw and pitch rotation" - +typedef ^ ED_CoordSys R8Ki beta3 3 - - "Vector / direction beta3 after ptfm yaw and pitch rotation" - typedef ^ ED_CoordSys R8Ki a1 3 - - "Vector / direction a1 (= xt from the IEC coord. system)" - typedef ^ ED_CoordSys R8Ki a2 3 - - "Vector / direction a2 (= zt from the IEC coord. system)" - typedef ^ ED_CoordSys R8Ki a3 3 - - "Vector / direction a3 (= -yt from the IEC coord. system)" - @@ -489,6 +511,7 @@ typedef ^ ED_RtHndSide ReKi TFrlMom - - - "The total tail-furl spring and damper typedef ^ ED_RtHndSide ReKi RFrlMom - - - "The total rotor-furl spring and damper moment" typedef ^ ED_RtHndSide ReKi GBoxEffFac - - - "The factor used to apply the gearbox efficiency effects to the equation associated with the generator DOF" typedef ^ ED_RtHndSide ReKi rSAerCen {:}{:}{:} - - "aerodynamic pitching moment arm (i.e., the position vector from point S on the blade to the aerodynamic center of the element)" +typedef ^ ED_RtHndSide ReKi YawFriMom - - - "Yaw Friction Moment" kN-m # ..... States .................................................................................................................... # Define continuous (differentiable) states here: @@ -509,6 +532,10 @@ typedef ^ OtherStateType ReKi HSSBrTrq - - - "HSSBrTrq from update states; a hac typedef ^ OtherStateType ReKi HSSBrTrqC - - - "Commanded HSS brake torque (adjusted for sign)" N-m typedef ^ OtherStateType IntKi SgnPrvLSTQ - - - "The sign of the low-speed shaft torque from the previous call to RtHS(). This is calculated at the end of RtHS(). NOTE: The low-speed shaft torque is assumed to be positive at the beginning of the run!" - typedef ^ OtherStateType IntKi SgnLSTQ {ED_NMX} - - "history of sign of LSTQ" +typedef ^ OtherStateType ReKi Mfhat - - - "Final Yaw Friction Torque" N-m +typedef ^ OtherStateType ReKi YawFriMfp - - - "Yaw Friction Torque to bring yaw system to a stop at current time step" N-m +typedef ^ OtherStateType R8Ki OmegaTn - - - "Yaw rate at t_n used to calculate friction torque and yaw rate at t_n+1" rad/s +typedef ^ OtherStateType R8Ki OmegaDotTn - - - "Yaw acceleration at t_n used to calculate friction torque and yaw rate at t_n+1" rad/s^2 # ..... Misc Vars ................................................................................................................ typedef ^ MiscVarType ED_CoordSys CoordSys - - - "Coordinate systems in the FAST framework" - @@ -521,10 +548,29 @@ typedef ^ MiscVarType IntKi AugMat_pivot {:} - - "Pivot column for AugMat in LAP typedef ^ MiscVarType ReKi OgnlGeAzRo {:} - - "Original DOF_GeAz row in AugMat" - typedef ^ MiscVarType R8Ki QD2T {:} - - "Solution (acceleration) vector; the first time derivative of QDT" typedef ^ MiscVarType Logical IgnoreMod - - - "whether to ignore the modulo in ED outputs (necessary for linearization perturbations)" - +typedef ^ MiscVarType ReKi OgnlYawRow {:} - - "Original DOF_Yaw row in AugMat" - +typedef ^ MiscVarType ReKi FrcONcRt 3 - - "Force acting on yaw bearing including inertial contributions" N +typedef ^ MiscVarType ReKi MomONcRt 3 - - "Moment acting on yaw bearing including inertial contributions" N-m +typedef ^ MiscVarType ReKi YawFriMz - - - "External loading on yaw bearing not including inertial contributions" N-m # ..... Parameters ................................................................................................................ # Define parameters here: # Time step for integration of continuous states (if a fixed-step integrator is used) and update of discrete states: +typedef ^ Jac_u_idxStarts IntKi BladeLoad - 1 - "Index to first point in y jacobian for BladeLoad" - +typedef ^ Jac_u_idxStarts IntKi PlatformLoad - 1 - "Index to first point in y jacobian for PlatformLoad" - +typedef ^ Jac_u_idxStarts IntKi TowerLoad - 1 - "Index to first point in y jacobian for TowerLoad" - +typedef ^ Jac_u_idxStarts IntKi HubLoad - 1 - "Index to first point in y jacobian for HubLoad" - +typedef ^ Jac_u_idxStarts IntKi NacelleLoad - 1 - "Index to first point in y jacobian for NacelleLoad" - +typedef ^ Jac_u_idxStarts IntKi TFinLoad - 1 - "Index to first point in y jacobian for TFinLoad" - +typedef ^ Jac_u_idxStarts IntKi BlPitchCom - 1 - "Index to first point in y jacobian for BlPitchCom" - +typedef ^ Jac_y_idxStarts IntKi Blade - 1 - "Index to first point in u jacobian for Blade" - +typedef ^ Jac_y_idxStarts IntKi Platform - 1 - "Index to first point in u jacobian for Platform" - +typedef ^ Jac_y_idxStarts IntKi Tower - 1 - "Index to first point in u jacobian for Tower" - +typedef ^ Jac_y_idxStarts IntKi Hub - 1 - "Index to first point in u jacobian for Hub" - +typedef ^ Jac_y_idxStarts IntKi BladeRoot - 1 - "Index to first point in u jacobian for BladeRoot" - +typedef ^ Jac_y_idxStarts IntKi Nacelle - 1 - "Index to first point in u jacobian for Nacelle" - +typedef ^ Jac_y_idxStarts IntKi TFin - 1 - "Index to first point in u jacobian for TFin" - + typedef ^ ParameterType DbKi DT - - - "Time step for continuous state integration & discrete state update" seconds typedef ^ ParameterType DbKi DT24 - - - "=DT/24 (used in loose coupling)" seconds typedef ^ ParameterType IntKi BldNodes - - - "Number of blade nodes used in the analysis" - @@ -642,6 +688,9 @@ typedef ^ ParameterType ReKi PtfmMass - - - "Platform mass" typedef ^ ParameterType ReKi PtfmPIner - - - "Platform inertia for pitch tilt rotation about the platform CM." typedef ^ ParameterType ReKi PtfmRIner - - - "Platform inertia for roll tilt rotation about the platform CM." typedef ^ ParameterType ReKi PtfmYIner - - - "Platform inertia for yaw rotation about the platform CM." +typedef ^ ParameterType ReKi PtfmXYIner - - - "Platform xy inertia about the platform CM" "kg m^2" +typedef ^ ParameterType ReKi PtfmYZIner - - - "Platform yz inertia about the platform CM" "kg m^2" +typedef ^ ParameterType ReKi PtfmXZIner - - - "Platform xz inertia about the platform CM" "kg m^2" typedef ^ ParameterType ReKi RFrlMass - - - "Rotor-furl mass" typedef ^ ParameterType ReKi RotIner - - - "Inertia of rotor about its centerline" typedef ^ ParameterType ReKi RotMass - - - "Rotor mass (blades, tips, and hub)" @@ -736,7 +785,20 @@ typedef ^ ParameterType IntKi method - - - "Identifier for integration method (1 typedef ^ ParameterType ReKi PtfmCMxt - - - "Downwind distance from the ground level [onshore], MSL [offshore wind or floating MHK], or seabed [fixed MHK] to the platform CM" meters typedef ^ ParameterType ReKi PtfmCMyt - - - "Lateral distance from the ground level [onshore], MSL [offshore wind or floating MHK], or seabed [fixed MHK] to the platform CM" meters typedef ^ ParameterType LOGICAL BD4Blades - - - "flag to determine if BeamDyn is computing blade loads (true) or ElastoDyn is (false)" - -typedef ^ ParameterType LOGICAL UseAD14 - - - "flag to determine if AeroDyn14 is being used. Will remove this later when we've replaced AD14." - +typedef ^ ParameterType LOGICAL RigidAero - - - "flag to determine if ElastoDyn if blades are rigid for aero -- when AeroDisk is used" - +typedef ^ ParameterType IntKi YawFrctMod - - - "Identifier for YawFrctMod (0 [no friction], 1 [does not use Fz at bearing], or 2 [does use Fz at bearing]" - +typedef ^ ParameterType R8Ki M_CD - - - "Dynamic friction moment at null yaw rate" N-m +typedef ^ ParameterType R8Ki M_FCD - - - "Dynamic friction moment at null yaw rate proportional to yaw bearing shear force" N-m +typedef ^ ParameterType R8Ki M_MCD - - - "Dynamic friction moment at null yaw rate proportional to yaw bearing bending moment" N-m +typedef ^ ParameterType R8Ki M_CSMAX - - - "Maximum Coulomb friction torque" N-m +typedef ^ ParameterType R8Ki M_FCSMAX - - - "Maximum Coulomb friction torque proportional to yaw bearing shear force" N-m +typedef ^ ParameterType R8Ki M_MCSMAX - - - "Maximum Coulomb friction torque proportional to yaw bearing bending moment" N-m +typedef ^ ParameterType R8Ki sig_v - - - "Linear viscous friction coefficient" N-m/(rad/s) +typedef ^ ParameterType R8Ki sig_v2 - - - "Quadratic viscous friction coefficient" N-m/(rad/s)^2 +typedef ^ ParameterType R8Ki OmgCut - - - "Nacelle yaw angular velocity cutoff below which viscous friction is to be linearized" rad/s +#typedef ^ ParameterType R8Ki thr_omg - - - "Yaw rate stiction threshold" rad/s +#typedef ^ ParameterType R8Ki thr_omgdot - - - "Yaw acceleration stiction threshold" rad/s^2 + # .... ED_AllBlNds option ........................................................................................................ typedef ^ ParameterType IntKi BldNd_NumOuts - - - "Number of requested output channels per blade node (ED_AllBldNdOuts)" - typedef ^ ParameterType IntKi BldNd_TotNumOuts - - - "Total number of requested output channels of blade node information (BldNd_NumOuts * BldNd_BlOutNd * BldNd_BladesOut -- ED_AllBldNdOuts)" - @@ -744,10 +806,18 @@ typedef ^ ParameterType OutParmType BldNd_OutParam {:} - - "Names and unit #typedef ^ ParameterType IntKi BldNd_BlOutNd {:} - - "The blade nodes to actually output (ED_AllBldNdOuts)" - typedef ^ ParameterType IntKi BldNd_BladesOut - - - "The blades to output (ED_AllBldNdOuts)" - +typedef ^ ParameterType Jac_u_idxStarts Jac_u_idxStartList - - - "Starting indices for all Jac_u compenents" - +typedef ^ ParameterType Jac_y_idxStarts Jac_y_idxStartList - - - "Starting indices for all Jac_u compenents" - 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 {:} - - "vector that determines size of perturbation for x (continuous states)" typedef ^ ParameterType Integer Jac_ny - - - "number of outputs in jacobian matrix" - +typedef ^ ParameterType Logical CompAeroMaps - - - "number of outputs in jacobian matrix" - +typedef ^ ParameterType Integer NumExtendedInputs - - - "number of extended inputs for linearization" - +typedef ^ ParameterType Integer NumBl_Lin - - - "number of blades in the jacobian" - +typedef ^ ParameterType Integer NActvVelDOF_Lin - - - "number of velocity states in the jacobian" - +typedef ^ ParameterType Integer NActvDOF_Lin - - - "number of active DOFs to use in the jacobian" - +typedef ^ ParameterType Integer NActvDOF_Stride - - - "stride for active DOFs to use in the jacobian" - # ..... Inputs .................................................................................................................... # Define inputs that are contained on the mesh here: @@ -770,13 +840,9 @@ typedef ^ InputType ReKi HSSBrTrqC - - - "Commanded HSS brake torque" N-m typedef ^ OutputType MeshType BladeLn2Mesh {:} - - "A mesh on each blade, containing positions and orientations of the blade elements" typedef ^ OutputType MeshType PlatformPtMesh - - - "Platform reference point positions/orientations/velocities/accelerations" - typedef ^ OutputType MeshType TowerLn2Mesh - - - "Tower line2 mesh with positions/orientations/velocities/accelerations" - -typedef ^ OutputType MeshType HubPtMotion14 - - - "For AeroDyn v14: motions of the hub" typedef ^ OutputType MeshType HubPtMotion - - - "For AeroDyn and Lidar(InflowWind): motions of the hub" -typedef ^ OutputType MeshType BladeRootMotion14 - - - "For AeroDyn v14: motions of the blade roots" typedef ^ OutputType MeshType BladeRootMotion {:} - - "For AeroDyn/BeamDyn: motions at the blade roots" -typedef ^ OutputType MeshType RotorFurlMotion14 - - - "For AeroDyn14: motions of the rotor furl point." -typedef ^ OutputType MeshType NacelleMotion - - - "For AeroDyn14 & ServoDyn/TMD: motions of the nacelle." -typedef ^ OutputType MeshType TowerBaseMotion14 - - - "For AeroDyn 14: motions of the tower base" +typedef ^ OutputType MeshType NacelleMotion - - - "For AeroDyn & ServoDyn/TMD: motions of the nacelle." typedef ^ OutputType MeshType TFinCMMotion - - - "For AeroDyn: motions of the tail find CM point (point J)" # Define outputs that are not on this mesh here: diff --git a/modules/elastodyn/src/ElastoDyn_Types.f90 b/modules/elastodyn/src/ElastoDyn_Types.f90 index 6f19f87bdb..adc0c3f8c8 100644 --- a/modules/elastodyn/src/ElastoDyn_Types.f90 +++ b/modules/elastodyn/src/ElastoDyn_Types.f90 @@ -38,12 +38,14 @@ MODULE ElastoDyn_Types TYPE, PUBLIC :: ED_InitInputType CHARACTER(1024) :: InputFile !< Name of the input file [-] LOGICAL :: Linearize = .FALSE. !< Flag that tells this module if the glue code wants to linearize. [-] - CHARACTER(1024) :: ADInputFile !< Name of the AeroDyn input file (in this verison, that is where we'll get the blade mesh info [-] - LOGICAL :: CompElast !< flag to determine if ElastoDyn is computing blade loads (true) or BeamDyn is (false) [-] + LOGICAL :: CompElast = .false. !< flag to determine if ElastoDyn is computing blade loads (true) or BeamDyn is (false) [-] + LOGICAL :: RigidAero = .false. !< flag to determine if ElastoDyn if blades are rigid for aero -- when AeroDisk is used [-] CHARACTER(1024) :: RootName !< RootName for writing output files [-] - REAL(ReKi) :: Gravity !< Gravitational acceleration [m/s^2] - INTEGER(IntKi) :: MHK !< MHK turbine type switch [-] - REAL(ReKi) :: WtrDpth !< Water depth [m] + REAL(ReKi) :: Gravity = 0.0_ReKi !< Gravitational acceleration [m/s^2] + INTEGER(IntKi) :: MHK = 0_IntKi !< MHK turbine type switch [-] + REAL(ReKi) :: WtrDpth = 0.0_ReKi !< Water depth [m] + LOGICAL :: CompAeroMaps = .FALSE. !< flag to determine if ElastoDyn is computing aero maps (true) or running a normal simulation (false) [-] + REAL(ReKi) :: RotSpeed = 0.0_ReKi !< Rotor speed used when ElastoDyn is computing aero maps [rad/s] END TYPE ED_InitInputType ! ======================= ! ========= ED_InitOutputType ======= @@ -51,22 +53,22 @@ MODULE ElastoDyn_Types 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) :: NumBl !< Number of blades on the turbine [-] + INTEGER(IntKi) :: NumBl = 0_IntKi !< Number of blades on the turbine [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BlPitch !< Initial blade pitch angles [radians] - REAL(ReKi) :: BladeLength !< Blade length (for AeroDyn) [meters] - REAL(ReKi) :: TowerHeight !< Tower Height [meters] - REAL(ReKi) :: TowerBaseHeight !< Tower Base Height [meters] - REAL(ReKi) :: HubHt !< Height of the hub [meters] + REAL(ReKi) :: BladeLength = 0.0_ReKi !< Blade length (for AeroDyn) [meters] + REAL(ReKi) :: TowerFlexL = 0.0_ReKi !< Tower Flexible Length [meters] + REAL(ReKi) :: TowerBaseHeight = 0.0_ReKi !< Tower Base Height [meters] + REAL(ReKi) :: HubHt = 0.0_ReKi !< Height of the hub [meters] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BldRNodes !< Radius to analysis nodes relative to hub ( 0 < RNodes(:) < BldFlexL ) [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TwrHNodes !< Location of variable-spaced tower nodes (relative to the tower rigid base height [-] - REAL(ReKi) , DIMENSION(1:6) :: PlatformPos !< Initial platform position (6 DOFs) [-] - REAL(ReKi) , DIMENSION(1:3) :: TwrBaseRefPos !< initial position of the tower base (for SrvD) [m] - REAL(R8Ki) , DIMENSION(1:3) :: TwrBaseTransDisp !< initial displacement of the tower base (for SrvD) [m] - REAL(R8Ki) , DIMENSION(1:3,1:3) :: TwrBaseRefOrient !< reference orientation of the tower base (for SrvD) [-] - REAL(R8Ki) , DIMENSION(1:3,1:3) :: TwrBaseOrient !< initial orientation of the tower base (for SrvD) [-] - REAL(ReKi) :: HubRad !< Preconed hub radius (distance from the rotor apex to the blade root) [m] - REAL(ReKi) :: RotSpeed !< Initial or fixed rotor speed [rad/s] - LOGICAL :: isFixed_GenDOF !< whether the generator is fixed or free [-] + REAL(ReKi) , DIMENSION(1:6) :: PlatformPos = 0.0_ReKi !< Initial platform position (6 DOFs) [-] + REAL(ReKi) , DIMENSION(1:3) :: TwrBaseRefPos = 0.0_ReKi !< initial position of the tower base (for SrvD) [m] + REAL(R8Ki) , DIMENSION(1:3) :: TwrBaseTransDisp = 0.0_R8Ki !< initial displacement of the tower base (for SrvD) [m] + REAL(R8Ki) , DIMENSION(1:3,1:3) :: TwrBaseRefOrient = 0.0_R8Ki !< reference orientation of the tower base (for SrvD) [-] + REAL(R8Ki) , DIMENSION(1:3,1:3) :: TwrBaseOrient = 0.0_R8Ki !< initial orientation of the tower base (for SrvD) [-] + REAL(ReKi) :: HubRad = 0.0_ReKi !< Preconed hub radius (distance from the rotor apex to the blade root) [m] + REAL(ReKi) :: RotSpeed = 0.0_ReKi !< Initial or fixed rotor speed [rad/s] + LOGICAL :: isFixed_GenDOF = .false. !< whether the generator is fixed or free [-] 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 [-] @@ -75,20 +77,21 @@ MODULE ElastoDyn_Types INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: DerivOrder_x !< Integer that tells FAST/MBC3 the maximum derivative order of continuous states used in linearization [-] 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) :: GearBox_index = 0_IntKi !< Index to gearbox rotation in state array (for steady-state calculations) [-] END TYPE ED_InitOutputType ! ======================= ! ========= BladeInputData ======= TYPE, PUBLIC :: BladeInputData - INTEGER(IntKi) :: NBlInpSt !< Number of blade input stations [-] + INTEGER(IntKi) :: NBlInpSt = 0_IntKi !< Number of blade input stations [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BlFract !< Blade fractional radius for distributed input data [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: PitchAx !< Pitch axis for distributed input data [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: StrcTwst !< Structural twist for distributed input data [radians] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BMassDen !< Blade mass density for distributed input data [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: FlpStff !< Blade flap stiffness for distributed input data [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: EdgStff !< Blade edge stiffness for distributed input data [-] - REAL(ReKi) , DIMENSION(1:2) :: BldFlDmp !< Blade structural damping ratios in flapwise direction [-] - REAL(ReKi) , DIMENSION(1:1) :: BldEdDmp !< Blade structural damping ratios in edgewise direction [-] - REAL(ReKi) , DIMENSION(1:2) :: FlStTunr !< Blade flapwise modal stiffness tuners (input) [-] + REAL(ReKi) , DIMENSION(1:2) :: BldFlDmp = 0.0_ReKi !< Blade structural damping ratios in flapwise direction [-] + REAL(ReKi) , DIMENSION(1:1) :: BldEdDmp = 0.0_ReKi !< Blade structural damping ratios in edgewise direction [-] + REAL(ReKi) , DIMENSION(1:2) :: FlStTunr = 0.0_ReKi !< Blade flapwise modal stiffness tuners (input) [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BldFl1Sh !< Blade-flap-mode-1 shape coefficients [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BldFl2Sh !< Blade-flap-mode-2 shape coefficients [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BldEdgSh !< Blade-edge-mode shape coefficients [-] @@ -96,7 +99,7 @@ MODULE ElastoDyn_Types ! ======================= ! ========= ED_BladeMeshInputData ======= TYPE, PUBLIC :: ED_BladeMeshInputData - INTEGER(IntKi) :: BldNodes !< Number of blade nodes used for analysis [-] + INTEGER(IntKi) :: BldNodes = 0_IntKi !< Number of blade nodes used for analysis [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: RNodes !< Radius to analysis nodes relative to hub ( 0 < RNodes(:) < BldFlexL ) [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: AeroTwst !< Aerodynamic twist of the blade at the analysis nodes [radians] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Chord !< Chord of the blade at the analysis nodes [-] @@ -104,108 +107,121 @@ MODULE ElastoDyn_Types ! ======================= ! ========= ED_InputFile ======= TYPE, PUBLIC :: ED_InputFile - REAL(DbKi) :: DT !< Requested integration time for ElastoDyn [seconds] - LOGICAL :: FlapDOF1 !< First flapwise blade mode DOF [-] - LOGICAL :: FlapDOF2 !< Second flapwise blade mode DOF [-] - LOGICAL :: EdgeDOF !< Edgewise blade mode DOF [-] - LOGICAL :: TeetDOF !< Rotor-teeter DOF [-] - LOGICAL :: DrTrDOF !< Drivetrain rotational-flexibility DOF [-] - LOGICAL :: GenDOF !< Generator DOF [-] - LOGICAL :: YawDOF !< Nacelle-yaw DOF [-] - LOGICAL :: TwFADOF1 !< First tower fore-aft bending-mode DOF [-] - LOGICAL :: TwFADOF2 !< Second tower fore-aft bending-mode DOF [-] - LOGICAL :: TwSSDOF1 !< First tower side-to-side bending-mode DOF [-] - LOGICAL :: TwSSDOF2 !< Second tower side-to-side bending-mode DOF [-] - LOGICAL :: PtfmSgDOF !< Platform horizontal surge translation DOF [-] - LOGICAL :: PtfmSwDOF !< Platform horizontal sway translation DOF [-] - LOGICAL :: PtfmHvDOF !< Platform vertical heave translation DOF [-] - LOGICAL :: PtfmRDOF !< Platform roll tilt rotation DOF [-] - LOGICAL :: PtfmPDOF !< Platform pitch tilt rotation DOF [-] - LOGICAL :: PtfmYDOF !< Platform yaw rotation DOF [-] - REAL(ReKi) :: OoPDefl !< Initial out-of-plane blade-tip displacement [meters] - REAL(ReKi) :: IPDefl !< Initial in-plane blade-tip deflection [meters] + REAL(DbKi) :: DT = 0.0_R8Ki !< Requested integration time for ElastoDyn [seconds] + LOGICAL :: FlapDOF1 = .false. !< First flapwise blade mode DOF [-] + LOGICAL :: FlapDOF2 = .false. !< Second flapwise blade mode DOF [-] + LOGICAL :: EdgeDOF = .false. !< Edgewise blade mode DOF [-] + LOGICAL :: TeetDOF = .false. !< Rotor-teeter DOF [-] + LOGICAL :: DrTrDOF = .false. !< Drivetrain rotational-flexibility DOF [-] + LOGICAL :: GenDOF = .false. !< Generator DOF [-] + LOGICAL :: YawDOF = .false. !< Nacelle-yaw DOF [-] + LOGICAL :: TwFADOF1 = .false. !< First tower fore-aft bending-mode DOF [-] + LOGICAL :: TwFADOF2 = .false. !< Second tower fore-aft bending-mode DOF [-] + LOGICAL :: TwSSDOF1 = .false. !< First tower side-to-side bending-mode DOF [-] + LOGICAL :: TwSSDOF2 = .false. !< Second tower side-to-side bending-mode DOF [-] + LOGICAL :: PtfmSgDOF = .false. !< Platform horizontal surge translation DOF [-] + LOGICAL :: PtfmSwDOF = .false. !< Platform horizontal sway translation DOF [-] + LOGICAL :: PtfmHvDOF = .false. !< Platform vertical heave translation DOF [-] + LOGICAL :: PtfmRDOF = .false. !< Platform roll tilt rotation DOF [-] + LOGICAL :: PtfmPDOF = .false. !< Platform pitch tilt rotation DOF [-] + LOGICAL :: PtfmYDOF = .false. !< Platform yaw rotation DOF [-] + REAL(ReKi) :: OoPDefl = 0.0_ReKi !< Initial out-of-plane blade-tip displacement [meters] + REAL(ReKi) :: IPDefl = 0.0_ReKi !< Initial in-plane blade-tip deflection [meters] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BlPitch !< Initial blade pitch angles [radians] - REAL(ReKi) :: TeetDefl !< Initial teeter angle [radians] - REAL(R8Ki) :: Azimuth !< Initial azimuth angle for blade 1 [radians] - REAL(ReKi) :: RotSpeed !< Initial rotor speed [rad/s] - REAL(ReKi) :: NacYaw !< Initial nacelle-yaw angle [radians] - REAL(ReKi) :: TTDspFA !< Initial fore-aft tower-top displacement [meters] - REAL(ReKi) :: TTDspSS !< Initial side-to-side tower-top displacement [meters] - REAL(ReKi) :: PtfmSurge !< Initial horizontal surge translational displacement of platform [meters] - REAL(ReKi) :: PtfmSway !< Initial horizontal sway translational displacement of platform [meters] - REAL(ReKi) :: PtfmHeave !< Initial vertical heave translational displacement of platform [meters] - REAL(ReKi) :: PtfmRoll !< Initial roll tilt rotational displacement of platform [radians] - REAL(ReKi) :: PtfmPitch !< Initial pitch tilt rotational displacement of platform [radians] - REAL(ReKi) :: PtfmYaw !< Initial yaw rotational displacement of platform [radians] - INTEGER(IntKi) :: NumBl !< Number of blades [-] - REAL(ReKi) :: TipRad !< Preconed blade-tip radius (distance from the rotor apex to the blade tip) [meters] - REAL(ReKi) :: HubRad !< Preconed hub radius (distance from the rotor apex to the blade root) [meters] + REAL(ReKi) :: TeetDefl = 0.0_ReKi !< Initial teeter angle [radians] + REAL(R8Ki) :: Azimuth = 0.0_R8Ki !< Initial azimuth angle for blade 1 [radians] + REAL(ReKi) :: RotSpeed = 0.0_ReKi !< Initial rotor speed [rad/s] + REAL(ReKi) :: NacYaw = 0.0_ReKi !< Initial nacelle-yaw angle [radians] + REAL(ReKi) :: TTDspFA = 0.0_ReKi !< Initial fore-aft tower-top displacement [meters] + REAL(ReKi) :: TTDspSS = 0.0_ReKi !< Initial side-to-side tower-top displacement [meters] + REAL(ReKi) :: PtfmSurge = 0.0_ReKi !< Initial horizontal surge translational displacement of platform [meters] + REAL(ReKi) :: PtfmSway = 0.0_ReKi !< Initial horizontal sway translational displacement of platform [meters] + REAL(ReKi) :: PtfmHeave = 0.0_ReKi !< Initial vertical heave translational displacement of platform [meters] + REAL(ReKi) :: PtfmRoll = 0.0_ReKi !< Initial roll tilt rotational displacement of platform [radians] + REAL(ReKi) :: PtfmPitch = 0.0_ReKi !< Initial pitch tilt rotational displacement of platform [radians] + REAL(ReKi) :: PtfmYaw = 0.0_ReKi !< Initial yaw rotational displacement of platform [radians] + INTEGER(IntKi) :: NumBl = 0_IntKi !< Number of blades [-] + REAL(ReKi) :: TipRad = 0.0_ReKi !< Preconed blade-tip radius (distance from the rotor apex to the blade tip) [meters] + REAL(ReKi) :: HubRad = 0.0_ReKi !< Preconed hub radius (distance from the rotor apex to the blade root) [meters] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: PreCone !< Rotor precone angles [radians] - REAL(ReKi) :: HubCM !< Distance from rotor apex to hub mass [meters] - REAL(ReKi) :: UndSling !< Undersling length [meters] - REAL(ReKi) :: Delta3 !< Delta-3 angle for teetering rotors [radians] - REAL(R8Ki) :: AzimB1Up !< Azimuth value to use for I/O when blade 1 points up [radians] - REAL(ReKi) :: OverHang !< Distance from yaw axis to rotor apex or teeter pin [meters] - REAL(ReKi) :: ShftGagL !< Distance from hub or teeter pin to shaft strain gages [meters] - REAL(ReKi) :: ShftTilt !< Rotor shaft tilt angle [radians] - REAL(ReKi) :: NacCMxn !< Downwind distance from tower-top to nacelle CM [meters] - REAL(ReKi) :: NacCMyn !< Lateral distance from tower-top to nacelle CM [meters] - REAL(ReKi) :: NacCMzn !< Vertical distance from tower-top to nacelle CM [meters] - REAL(ReKi) :: NcIMUxn !< Downwind distance from the tower-top to the nacelle IMU [meters] - REAL(ReKi) :: NcIMUyn !< Lateral distance from the tower-top to the nacelle IMU [meters] - REAL(ReKi) :: NcIMUzn !< Vertical distance from the tower-top to the nacelle IMU [meters] - REAL(ReKi) :: Twr2Shft !< Vertical distance from the tower-top to the rotor shaft [meters] - REAL(ReKi) :: TowerHt !< Height of tower relative to ground level [onshore], MSL [offshore wind or floating MHK], or seabed [fixed MHK] [meters] - REAL(ReKi) :: TowerBsHt !< Height of tower base relative to ground level [onshore], MSL [offshore wind or floating MHK], or seabed [fixed MHK] [meters] - REAL(ReKi) :: PtfmCMxt !< Downwind distance from the ground level [onshore], MSL [offshore wind or floating MHK], or seabed [fixed MHK] to the platform CM [meters] - REAL(ReKi) :: PtfmCMyt !< Lateral distance from the ground level [onshore], MSL [offshore wind or floating MHK], or seabed [fixed MHK] to the platform CM [meters] - REAL(ReKi) :: PtfmCMzt !< Vertical distance from the ground level [onshore], MSL [offshore wind or floating MHK], or seabed [fixed MHK] to the platform CM [meters] - REAL(ReKi) :: PtfmRefzt !< Vertical distance from the ground level [onshore], MSL [offshore wind or floating MHK], or seabed [fixed MHK] to the platform reference point [meters] + REAL(ReKi) :: HubCM = 0.0_ReKi !< Distance from rotor apex to hub mass [meters] + REAL(ReKi) :: UndSling = 0.0_ReKi !< Undersling length [meters] + REAL(ReKi) :: Delta3 = 0.0_ReKi !< Delta-3 angle for teetering rotors [radians] + REAL(R8Ki) :: AzimB1Up = 0.0_R8Ki !< Azimuth value to use for I/O when blade 1 points up [radians] + REAL(ReKi) :: OverHang = 0.0_ReKi !< Distance from yaw axis to rotor apex or teeter pin [meters] + REAL(ReKi) :: ShftGagL = 0.0_ReKi !< Distance from hub or teeter pin to shaft strain gages [meters] + REAL(ReKi) :: ShftTilt = 0.0_ReKi !< Rotor shaft tilt angle [radians] + REAL(ReKi) :: NacCMxn = 0.0_ReKi !< Downwind distance from tower-top to nacelle CM [meters] + REAL(ReKi) :: NacCMyn = 0.0_ReKi !< Lateral distance from tower-top to nacelle CM [meters] + REAL(ReKi) :: NacCMzn = 0.0_ReKi !< Vertical distance from tower-top to nacelle CM [meters] + REAL(ReKi) :: NcIMUxn = 0.0_ReKi !< Downwind distance from the tower-top to the nacelle IMU [meters] + REAL(ReKi) :: NcIMUyn = 0.0_ReKi !< Lateral distance from the tower-top to the nacelle IMU [meters] + REAL(ReKi) :: NcIMUzn = 0.0_ReKi !< Vertical distance from the tower-top to the nacelle IMU [meters] + REAL(ReKi) :: Twr2Shft = 0.0_ReKi !< Vertical distance from the tower-top to the rotor shaft [meters] + REAL(ReKi) :: TowerHt = 0.0_ReKi !< Height of tower relative to ground level [onshore], MSL [offshore wind or floating MHK], or seabed [fixed MHK] [meters] + REAL(ReKi) :: TowerBsHt = 0.0_ReKi !< Height of tower base relative to ground level [onshore], MSL [offshore wind or floating MHK], or seabed [fixed MHK] [meters] + REAL(ReKi) :: PtfmCMxt = 0.0_ReKi !< Downwind distance from the ground level [onshore], MSL [offshore wind or floating MHK], or seabed [fixed MHK] to the platform CM [meters] + REAL(ReKi) :: PtfmCMyt = 0.0_ReKi !< Lateral distance from the ground level [onshore], MSL [offshore wind or floating MHK], or seabed [fixed MHK] to the platform CM [meters] + REAL(ReKi) :: PtfmCMzt = 0.0_ReKi !< Vertical distance from the ground level [onshore], MSL [offshore wind or floating MHK], or seabed [fixed MHK] to the platform CM [meters] + REAL(ReKi) :: PtfmRefzt = 0.0_ReKi !< Vertical distance from the ground level [onshore], MSL [offshore wind or floating MHK], or seabed [fixed MHK] to the platform reference point [meters] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TipMass !< Tip-brake masses [kg] - REAL(ReKi) :: HubMass !< Hub mass [kg] - REAL(ReKi) :: HubIner !< Hub inertia about teeter axis (2-blader) or rotor axis (3-blader) [kg m^2] - REAL(ReKi) :: GenIner !< Generator inertia about HSS [kg m^2] - REAL(ReKi) :: NacMass !< Nacelle mass [kg] - REAL(ReKi) :: NacYIner !< Nacelle yaw inertia [kg m^2] - REAL(ReKi) :: YawBrMass !< Yaw bearing mass [kg] - REAL(ReKi) :: PtfmMass !< Platform mass [kg] - REAL(ReKi) :: PtfmRIner !< Platform inertia for roll tilt rotation about the platform CM [kg m^2] - REAL(ReKi) :: PtfmPIner !< Platform inertia for pitch tilt rotation about the platform CM [kg m^2] - REAL(ReKi) :: PtfmYIner !< Platform inertia for yaw rotation about the platform CM [kg m^2] - REAL(ReKi) :: BldNodes !< Number of blade nodes (per blade) used for analysis [-] + REAL(ReKi) :: HubMass = 0.0_ReKi !< Hub mass [kg] + REAL(ReKi) :: HubIner = 0.0_ReKi !< Hub inertia about teeter axis (2-blader) or rotor axis (3-blader) [kg m^2] + REAL(ReKi) :: GenIner = 0.0_ReKi !< Generator inertia about HSS [kg m^2] + REAL(ReKi) :: NacMass = 0.0_ReKi !< Nacelle mass [kg] + REAL(ReKi) :: NacYIner = 0.0_ReKi !< Nacelle yaw inertia [kg m^2] + REAL(ReKi) :: YawBrMass = 0.0_ReKi !< Yaw bearing mass [kg] + REAL(ReKi) :: PtfmMass = 0.0_ReKi !< Platform mass [kg] + REAL(ReKi) :: PtfmRIner = 0.0_ReKi !< Platform inertia for roll tilt rotation about the platform CM [kg m^2] + REAL(ReKi) :: PtfmPIner = 0.0_ReKi !< Platform inertia for pitch tilt rotation about the platform CM [kg m^2] + REAL(ReKi) :: PtfmYIner = 0.0_ReKi !< Platform inertia for yaw rotation about the platform CM [kg m^2] + REAL(ReKi) :: PtfmXYIner = 0.0_ReKi !< Platform xy inertia about the platform CM [kg m^2] + REAL(ReKi) :: PtfmYZIner = 0.0_ReKi !< Platform yz inertia about the platform CM [kg m^2] + REAL(ReKi) :: PtfmXZIner = 0.0_ReKi !< Platform xz inertia about the platform CM [kg m^2] + REAL(ReKi) :: BldNodes = 0.0_ReKi !< Number of blade nodes (per blade) used for analysis [-] TYPE(ED_BladeMeshInputData) , DIMENSION(:), ALLOCATABLE :: InpBlMesh !< Input data for blade discretizations (could be on each blade) [see BladeMeshInputData] TYPE(BladeInputData) , DIMENSION(:), ALLOCATABLE :: InpBl !< Input data for individual blades [see BladeInputData type] - INTEGER(IntKi) :: TeetMod !< Rotor-teeter spring/damper model switch [-] - REAL(ReKi) :: TeetDmpP !< Rotor-teeter damper position [radians] - REAL(ReKi) :: TeetDmp !< Rotor-teeter damping constant [N-m/(rad/s)] - REAL(ReKi) :: TeetCDmp !< Rotor-teeter rate-independent Coulomb-damping [N-m] - REAL(ReKi) :: TeetSStP !< Rotor-teeter soft-stop position [radians] - REAL(ReKi) :: TeetHStP !< Rotor-teeter hard-stop position [radians] - REAL(ReKi) :: TeetSSSp !< Rotor-teeter soft-stop linear-spring constant [N-m/rad] - REAL(ReKi) :: TeetHSSp !< Rotor-teeter hard-stop linear-spring constant [N-m/rad] - REAL(ReKi) :: GBoxEff !< Gearbox efficiency [%] - REAL(ReKi) :: GBRatio !< Gearbox ratio [-] - REAL(ReKi) :: DTTorSpr !< Drivetrain torsional spring [N-m/rad] - REAL(ReKi) :: DTTorDmp !< Drivetrain torsional damper [N-m/(rad/s)] - LOGICAL :: Furling !< Use Additional Furling parameters? [-] - INTEGER(IntKi) :: TwrNodes !< Number of tower nodes used in the analysis [-] - 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 !< Flag to cause tab-delimited text output (delimited by space otherwise) [-] + INTEGER(IntKi) :: TeetMod = 0_IntKi !< Rotor-teeter spring/damper model switch [-] + REAL(ReKi) :: TeetDmpP = 0.0_ReKi !< Rotor-teeter damper position [radians] + REAL(ReKi) :: TeetDmp = 0.0_ReKi !< Rotor-teeter damping constant [N-m/(rad/s)] + REAL(ReKi) :: TeetCDmp = 0.0_ReKi !< Rotor-teeter rate-independent Coulomb-damping [N-m] + REAL(ReKi) :: TeetSStP = 0.0_ReKi !< Rotor-teeter soft-stop position [radians] + REAL(ReKi) :: TeetHStP = 0.0_ReKi !< Rotor-teeter hard-stop position [radians] + REAL(ReKi) :: TeetSSSp = 0.0_ReKi !< Rotor-teeter soft-stop linear-spring constant [N-m/rad] + REAL(ReKi) :: TeetHSSp = 0.0_ReKi !< Rotor-teeter hard-stop linear-spring constant [N-m/rad] + INTEGER(IntKi) :: YawFrctMod = 0_IntKi !< Identifier for YawFrctMod (0 [no friction], 1 [does not use Fz at bearing], 2 [does use Fz at bearing], or 3 [user defined model] [-] + REAL(R8Ki) :: M_CD = 0.0_R8Ki !< Dynamic friction moment at null yaw rate [N-m] + REAL(R8Ki) :: M_FCD = 0.0_R8Ki !< Dynamic friction moment at null yaw rate proportional to yaw bearing shear force [N-m] + REAL(R8Ki) :: M_MCD = 0.0_R8Ki !< Dynamic friction moment at null yaw rate proportional to yaw bearing bending moment [N-m] + REAL(R8Ki) :: M_CSMAX = 0.0_R8Ki !< Maximum Coulomb friction torque [N-m] + REAL(R8Ki) :: M_FCSMAX = 0.0_R8Ki !< Maximum Coulomb friction torque proportional to yaw bearing shear force [N-m] + REAL(R8Ki) :: M_MCSMAX = 0.0_R8Ki !< Maximum Coulomb friction torque proportional to yaw bearing bending moment [N-m] + REAL(R8Ki) :: sig_v = 0.0_R8Ki !< Linear viscous friction coefficient [N-m/(rad/s)] + REAL(R8Ki) :: sig_v2 = 0.0_R8Ki !< Quadratic viscous friction coefficient [N-m/(rad/s)^2] + REAL(R8Ki) :: OmgCut = 0.0_R8Ki !< Nacelle yaw angular velocity cutoff below which viscous friction is to be linearized [rad/s] + REAL(ReKi) :: GBoxEff = 0.0_ReKi !< Gearbox efficiency [%] + REAL(ReKi) :: GBRatio = 0.0_ReKi !< Gearbox ratio [-] + REAL(ReKi) :: DTTorSpr = 0.0_ReKi !< Drivetrain torsional spring [N-m/rad] + REAL(ReKi) :: DTTorDmp = 0.0_ReKi !< Drivetrain torsional damper [N-m/(rad/s)] + LOGICAL :: Furling = .false. !< Use Additional Furling parameters? [-] + INTEGER(IntKi) :: TwrNodes = 0_IntKi !< Number of tower nodes used in the analysis [-] + LOGICAL :: SumPrint = .false. !< Print summary data to .sum [-] + INTEGER(IntKi) :: OutFile = 0_IntKi !< 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 = .false. !< Flag to cause tab-delimited text output (delimited by space otherwise) [-] CHARACTER(20) :: OutFmt !< Format used for module's text tabular output (except time); resulting field should be 10 characters [-] - REAL(DbKi) :: Tstart !< Time to start module's tabular output [seconds] - INTEGER(IntKi) :: DecFact !< Decimation factor for module's tabular output (1=output every step) [-] - INTEGER(IntKi) :: NTwGages !< Number of tower strain gages [-] - INTEGER(IntKi) , DIMENSION(1:9) :: TwrGagNd !< Nodes closest to the tower strain gages [-] - INTEGER(IntKi) :: NBlGages !< Number of blade strain gages [-] - INTEGER(IntKi) , DIMENSION(1:9) :: BldGagNd !< Nodes closest to the blade strain gages [-] - INTEGER(IntKi) :: NumOuts !< Number of parameters in the output list (number of outputs requested) [-] + REAL(DbKi) :: Tstart = 0.0_R8Ki !< Time to start module's tabular output [seconds] + INTEGER(IntKi) :: DecFact = 0_IntKi !< Decimation factor for module's tabular output (1=output every step) [-] + INTEGER(IntKi) :: NTwGages = 0_IntKi !< Number of tower strain gages [-] + INTEGER(IntKi) , DIMENSION(1:9) :: TwrGagNd = 0_IntKi !< Nodes closest to the tower strain gages [-] + INTEGER(IntKi) :: NBlGages = 0_IntKi !< Number of blade strain gages [-] + INTEGER(IntKi) , DIMENSION(1:9) :: BldGagNd = 0_IntKi !< Nodes closest to the blade strain gages [-] + INTEGER(IntKi) :: NumOuts = 0_IntKi !< Number of parameters in the output list (number of outputs requested) [-] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: OutList !< List of user-requested output channels [-] - INTEGER(IntKi) :: NTwInpSt !< Number of tower input stations [-] - REAL(ReKi) , DIMENSION(1:2) :: TwrFADmp !< Tower fore-aft structural damping ratios [%] - REAL(ReKi) , DIMENSION(1:2) :: TwrSSDmp !< Tower side-to-side structural damping ratios [%] - REAL(ReKi) , DIMENSION(1:2) :: FAStTunr !< Tower fore-aft modal stiffness tuners [-] - REAL(ReKi) , DIMENSION(1:2) :: SSStTunr !< Tower side-to-side modal stiffness tuners [-] + INTEGER(IntKi) :: NTwInpSt = 0_IntKi !< Number of tower input stations [-] + REAL(ReKi) , DIMENSION(1:2) :: TwrFADmp = 0.0_ReKi !< Tower fore-aft structural damping ratios [%] + REAL(ReKi) , DIMENSION(1:2) :: TwrSSDmp = 0.0_ReKi !< Tower side-to-side structural damping ratios [%] + REAL(ReKi) , DIMENSION(1:2) :: FAStTunr = 0.0_ReKi !< Tower fore-aft modal stiffness tuners [-] + REAL(ReKi) , DIMENSION(1:2) :: SSStTunr = 0.0_ReKi !< Tower side-to-side modal stiffness tuners [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: HtFract !< Fractional height of the flexible portion of tower for a given input station [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TMassDen !< Tower mass density for a given input station [kg/m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TwFAStif !< Tower fore-aft stiffness for a given input station [Nm^2] @@ -214,78 +230,84 @@ MODULE ElastoDyn_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TwFAM2Sh !< Tower fore-aft mode-2 shape coefficients [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TwSSM1Sh !< Tower side-to-side mode-1 shape coefficients [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TwSSM2Sh !< Tower side-to-side mode-2 shape coefficients [-] - LOGICAL :: RFrlDOF !< Rotor-furl DOF [-] - LOGICAL :: TFrlDOF !< Tail-furl DOF [-] - REAL(ReKi) :: RotFurl !< Initial or fixed rotor-furl angle [radians] - REAL(ReKi) :: TailFurl !< Initial or fixed tail-furl angle [radians] - REAL(ReKi) :: Yaw2Shft !< Lateral distance from the yaw axis to the rotor shaft [meters] - REAL(ReKi) :: ShftSkew !< Rotor shaft skew angle [radians] - REAL(ReKi) , DIMENSION(1:3) :: RFrlCM_n !< Vector from tower-top to rotor-furl CM [meters] - REAL(ReKi) , DIMENSION(1:3) :: BoomCM_n !< Vector from tower-top to tail boom CM [meters] - REAL(ReKi) , DIMENSION(1:3) :: TFinCM_n !< Vector from tower-top to tail fin CM [meters] - REAL(ReKi) , DIMENSION(1:3) :: RFrlPnt_n !< Vector from tower-top to arbitrary point on rotor-furl axis [meters] - REAL(ReKi) :: RFrlSkew !< Rotor-furl axis skew angle [radians] - REAL(ReKi) :: RFrlTilt !< Rotor-furl axis tilt angle [radians] - REAL(ReKi) , DIMENSION(1:3) :: TFrlPnt_n !< Vector from tower-top to arbitrary point on tail-furl axis [meters] - REAL(ReKi) :: TFrlSkew !< Rotor-furl axis skew angle [radians] - REAL(ReKi) :: TFrlTilt !< Rotor-furl axis tilt angle [radians] - REAL(ReKi) :: RFrlMass !< Rotor-furl mass [kg] - REAL(ReKi) :: BoomMass !< Tail boom mass [kg] - REAL(ReKi) :: TFinMass !< Tail fin mass [kg] - REAL(ReKi) :: RFrlIner !< Rotor-furl inertia about rotor-furl axis [kg m^2] - REAL(ReKi) :: TFrlIner !< Tail boom inertia about tail-furl axis [kg m^2] - INTEGER(IntKi) :: RFrlMod !< Rotor-furl spring/damper model switch [-] - REAL(ReKi) :: RFrlSpr !< Rotor-furl spring constant [N-m/rad] - REAL(ReKi) :: RFrlDmp !< Rotor-furl damping constant [N-m/(rad/s)] - REAL(ReKi) :: RFrlUSSP !< Rotor-furl up-stop spring position [radians] - REAL(ReKi) :: RFrlDSSP !< Rotor-furl down-stop spring position [radians] - REAL(ReKi) :: RFrlUSSpr !< Rotor-furl up-stop spring constant [N-m/rad] - REAL(ReKi) :: RFrlDSSpr !< Rotor-furl down-stop spring constant [N-m/rad] - REAL(ReKi) :: RFrlUSDP !< Rotor-furl up-stop damper position [radians] - REAL(ReKi) :: RFrlDSDP !< Rotor-furl down-stop damper position [radians] - REAL(ReKi) :: RFrlUSDmp !< Rotor-furl up-stop damping constant [N-m/(rad/s)] - REAL(ReKi) :: RFrlDSDmp !< Rotor-furl down-stop damping constant [N-m/(rad/s)] - INTEGER(IntKi) :: TFrlMod !< Tail-furl spring/damper model switch [-] - REAL(ReKi) :: TFrlSpr !< Tail-furl spring constant [N-m/rad] - REAL(ReKi) :: TFrlDmp !< Tail-furl damping constant [N-m/(rad/s)] - REAL(ReKi) :: TFrlUSSP !< Tail-furl up-stop spring position [radians] - REAL(ReKi) :: TFrlDSSP !< Tail-furl down-stop spring position [radians] - REAL(ReKi) :: TFrlUSSpr !< Tail-furl up-stop spring constant [N-m/rad] - REAL(ReKi) :: TFrlDSSpr !< Tail-furl down-stop spring constant [N-m/rad] - REAL(ReKi) :: TFrlUSDP !< Tail-furl up-stop damper position [radians] - REAL(ReKi) :: TFrlDSDP !< Tail-furl down-stop damper position [radians] - REAL(ReKi) :: TFrlUSDmp !< Tail-furl up-stop damping constant [N-m/(rad/s)] - REAL(ReKi) :: TFrlDSDmp !< Tail-furl down-stop damping constant [N-m/(rad/s)] - INTEGER(IntKi) :: method !< Identifier for integration method (1 [RK4], 2 [AB4], or 3 [ABM4]) [-] - INTEGER(IntKi) :: BldNd_NumOuts !< Number of requested output channels per blade node (ED_AllBldNdOuts) [-] + LOGICAL :: RFrlDOF = .false. !< Rotor-furl DOF [-] + LOGICAL :: TFrlDOF = .false. !< Tail-furl DOF [-] + REAL(ReKi) :: RotFurl = 0.0_ReKi !< Initial or fixed rotor-furl angle [radians] + REAL(ReKi) :: TailFurl = 0.0_ReKi !< Initial or fixed tail-furl angle [radians] + REAL(ReKi) :: Yaw2Shft = 0.0_ReKi !< Lateral distance from the yaw axis to the rotor shaft [meters] + REAL(ReKi) :: ShftSkew = 0.0_ReKi !< Rotor shaft skew angle [radians] + REAL(ReKi) , DIMENSION(1:3) :: RFrlCM_n = 0.0_ReKi !< Vector from tower-top to rotor-furl CM [meters] + REAL(ReKi) , DIMENSION(1:3) :: BoomCM_n = 0.0_ReKi !< Vector from tower-top to tail boom CM [meters] + REAL(ReKi) , DIMENSION(1:3) :: TFinCM_n = 0.0_ReKi !< Vector from tower-top to tail fin CM [meters] + REAL(ReKi) , DIMENSION(1:3) :: RFrlPnt_n = 0.0_ReKi !< Vector from tower-top to arbitrary point on rotor-furl axis [meters] + REAL(ReKi) :: RFrlSkew = 0.0_ReKi !< Rotor-furl axis skew angle [radians] + REAL(ReKi) :: RFrlTilt = 0.0_ReKi !< Rotor-furl axis tilt angle [radians] + REAL(ReKi) , DIMENSION(1:3) :: TFrlPnt_n = 0.0_ReKi !< Vector from tower-top to arbitrary point on tail-furl axis [meters] + REAL(ReKi) :: TFrlSkew = 0.0_ReKi !< Rotor-furl axis skew angle [radians] + REAL(ReKi) :: TFrlTilt = 0.0_ReKi !< Rotor-furl axis tilt angle [radians] + REAL(ReKi) :: RFrlMass = 0.0_ReKi !< Rotor-furl mass [kg] + REAL(ReKi) :: BoomMass = 0.0_ReKi !< Tail boom mass [kg] + REAL(ReKi) :: TFinMass = 0.0_ReKi !< Tail fin mass [kg] + REAL(ReKi) :: RFrlIner = 0.0_ReKi !< Rotor-furl inertia about rotor-furl axis [kg m^2] + REAL(ReKi) :: TFrlIner = 0.0_ReKi !< Tail boom inertia about tail-furl axis [kg m^2] + INTEGER(IntKi) :: RFrlMod = 0_IntKi !< Rotor-furl spring/damper model switch [-] + REAL(ReKi) :: RFrlSpr = 0.0_ReKi !< Rotor-furl spring constant [N-m/rad] + REAL(ReKi) :: RFrlDmp = 0.0_ReKi !< Rotor-furl damping constant [N-m/(rad/s)] + REAL(ReKi) :: RFrlUSSP = 0.0_ReKi !< Rotor-furl up-stop spring position [radians] + REAL(ReKi) :: RFrlDSSP = 0.0_ReKi !< Rotor-furl down-stop spring position [radians] + REAL(ReKi) :: RFrlUSSpr = 0.0_ReKi !< Rotor-furl up-stop spring constant [N-m/rad] + REAL(ReKi) :: RFrlDSSpr = 0.0_ReKi !< Rotor-furl down-stop spring constant [N-m/rad] + REAL(ReKi) :: RFrlUSDP = 0.0_ReKi !< Rotor-furl up-stop damper position [radians] + REAL(ReKi) :: RFrlDSDP = 0.0_ReKi !< Rotor-furl down-stop damper position [radians] + REAL(ReKi) :: RFrlUSDmp = 0.0_ReKi !< Rotor-furl up-stop damping constant [N-m/(rad/s)] + REAL(ReKi) :: RFrlDSDmp = 0.0_ReKi !< Rotor-furl down-stop damping constant [N-m/(rad/s)] + INTEGER(IntKi) :: TFrlMod = 0_IntKi !< Tail-furl spring/damper model switch [-] + REAL(ReKi) :: TFrlSpr = 0.0_ReKi !< Tail-furl spring constant [N-m/rad] + REAL(ReKi) :: TFrlDmp = 0.0_ReKi !< Tail-furl damping constant [N-m/(rad/s)] + REAL(ReKi) :: TFrlUSSP = 0.0_ReKi !< Tail-furl up-stop spring position [radians] + REAL(ReKi) :: TFrlDSSP = 0.0_ReKi !< Tail-furl down-stop spring position [radians] + REAL(ReKi) :: TFrlUSSpr = 0.0_ReKi !< Tail-furl up-stop spring constant [N-m/rad] + REAL(ReKi) :: TFrlDSSpr = 0.0_ReKi !< Tail-furl down-stop spring constant [N-m/rad] + REAL(ReKi) :: TFrlUSDP = 0.0_ReKi !< Tail-furl up-stop damper position [radians] + REAL(ReKi) :: TFrlDSDP = 0.0_ReKi !< Tail-furl down-stop damper position [radians] + REAL(ReKi) :: TFrlUSDmp = 0.0_ReKi !< Tail-furl up-stop damping constant [N-m/(rad/s)] + REAL(ReKi) :: TFrlDSDmp = 0.0_ReKi !< Tail-furl down-stop damping constant [N-m/(rad/s)] + INTEGER(IntKi) :: method = 0_IntKi !< Identifier for integration method (1 [RK4], 2 [AB4], or 3 [ABM4]) [-] + INTEGER(IntKi) :: BldNd_NumOuts = 0_IntKi !< Number of requested output channels per blade node (ED_AllBldNdOuts) [-] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: BldNd_OutList !< List of user-requested output channels (ED_AllBldNdOuts) [-] CHARACTER(1024) :: BldNd_BlOutNd_Str !< String to parse for the blade nodes to actually output (ED_AllBldNdOuts) [-] - INTEGER(IntKi) :: BldNd_BladesOut !< The blades to output (ED_AllBldNdOuts) [-] + INTEGER(IntKi) :: BldNd_BladesOut = 0_IntKi !< The blades to output (ED_AllBldNdOuts) [-] END TYPE ED_InputFile ! ======================= ! ========= ED_CoordSys ======= TYPE, PUBLIC :: ED_CoordSys - REAL(R8Ki) , DIMENSION(1:3) :: a1 !< Vector / direction a1 (= xt from the IEC coord. system) [-] - REAL(R8Ki) , DIMENSION(1:3) :: a2 !< Vector / direction a2 (= zt from the IEC coord. system) [-] - REAL(R8Ki) , DIMENSION(1:3) :: a3 !< Vector / direction a3 (= -yt from the IEC coord. system) [-] - REAL(R8Ki) , DIMENSION(1:3) :: b1 !< Vector / direction b1 (= xp from the IEC coord. system) [-] - REAL(R8Ki) , DIMENSION(1:3) :: b2 !< Vector / direction b2 (= zp from the IEC coord. system) [-] - REAL(R8Ki) , DIMENSION(1:3) :: b3 !< Vector / direction b3 (= -yp from the IEC coord. system) [-] - REAL(R8Ki) , DIMENSION(1:3) :: c1 !< Vector / direction c1 (= xs from the IEC coord. system) [-] - REAL(R8Ki) , DIMENSION(1:3) :: c2 !< Vector / direction c2 (= zs from the IEC coord. system) [-] - REAL(R8Ki) , DIMENSION(1:3) :: c3 !< Vector / direction c3 (= -ys from the IEC coord. system) [-] - REAL(R8Ki) , DIMENSION(1:3) :: d1 !< Vector / direction d1 (= xn from the IEC coord. system) [-] - REAL(R8Ki) , DIMENSION(1:3) :: d2 !< Vector / direction d2 (= zn from the IEC coord. system) [-] - REAL(R8Ki) , DIMENSION(1:3) :: d3 !< Vector / direction d3 (= -yn from the IEC coord. system) [-] - REAL(R8Ki) , DIMENSION(1:3) :: e1 !< Vector / direction e1 (= xa from the IEC coord. system) [-] - REAL(R8Ki) , DIMENSION(1:3) :: e2 !< Vector / direction e2 (= ya from the IEC coord. system) [-] - REAL(R8Ki) , DIMENSION(1:3) :: e3 !< Vector / direction e3 (= za from the IEC coord. system) [-] - REAL(R8Ki) , DIMENSION(1:3) :: f1 !< Vector / direction f1 [-] - REAL(R8Ki) , DIMENSION(1:3) :: f2 !< Vector / direction f2 [-] - REAL(R8Ki) , DIMENSION(1:3) :: f3 !< Vector / direction f3 [-] - REAL(R8Ki) , DIMENSION(1:3) :: g1 !< Vector / direction g1 (= xh from the IEC coord. system) [-] - REAL(R8Ki) , DIMENSION(1:3) :: g2 !< Vector / direction g2 (= yh from the IEC coord. system) [-] - REAL(R8Ki) , DIMENSION(1:3) :: g3 !< Vector / direction g3 (= zh from the IEC coord. system) [-] + REAL(R8Ki) , DIMENSION(1:3) :: alpha1 = 0.0_R8Ki !< Vector / direction alpha1 after ptfm yaw rotation [-] + REAL(R8Ki) , DIMENSION(1:3) :: alpha2 = 0.0_R8Ki !< Vector / direction alpha2 after ptfm yaw rotation [-] + REAL(R8Ki) , DIMENSION(1:3) :: alpha3 = 0.0_R8Ki !< Vector / direction alpha3 after ptfm yaw rotation [-] + REAL(R8Ki) , DIMENSION(1:3) :: beta1 = 0.0_R8Ki !< Vector / direction beta1 after ptfm yaw and pitch rotation [-] + REAL(R8Ki) , DIMENSION(1:3) :: beta2 = 0.0_R8Ki !< Vector / direction beta2 after ptfm yaw and pitch rotation [-] + REAL(R8Ki) , DIMENSION(1:3) :: beta3 = 0.0_R8Ki !< Vector / direction beta3 after ptfm yaw and pitch rotation [-] + REAL(R8Ki) , DIMENSION(1:3) :: a1 = 0.0_R8Ki !< Vector / direction a1 (= xt from the IEC coord. system) [-] + REAL(R8Ki) , DIMENSION(1:3) :: a2 = 0.0_R8Ki !< Vector / direction a2 (= zt from the IEC coord. system) [-] + REAL(R8Ki) , DIMENSION(1:3) :: a3 = 0.0_R8Ki !< Vector / direction a3 (= -yt from the IEC coord. system) [-] + REAL(R8Ki) , DIMENSION(1:3) :: b1 = 0.0_R8Ki !< Vector / direction b1 (= xp from the IEC coord. system) [-] + REAL(R8Ki) , DIMENSION(1:3) :: b2 = 0.0_R8Ki !< Vector / direction b2 (= zp from the IEC coord. system) [-] + REAL(R8Ki) , DIMENSION(1:3) :: b3 = 0.0_R8Ki !< Vector / direction b3 (= -yp from the IEC coord. system) [-] + REAL(R8Ki) , DIMENSION(1:3) :: c1 = 0.0_R8Ki !< Vector / direction c1 (= xs from the IEC coord. system) [-] + REAL(R8Ki) , DIMENSION(1:3) :: c2 = 0.0_R8Ki !< Vector / direction c2 (= zs from the IEC coord. system) [-] + REAL(R8Ki) , DIMENSION(1:3) :: c3 = 0.0_R8Ki !< Vector / direction c3 (= -ys from the IEC coord. system) [-] + REAL(R8Ki) , DIMENSION(1:3) :: d1 = 0.0_R8Ki !< Vector / direction d1 (= xn from the IEC coord. system) [-] + REAL(R8Ki) , DIMENSION(1:3) :: d2 = 0.0_R8Ki !< Vector / direction d2 (= zn from the IEC coord. system) [-] + REAL(R8Ki) , DIMENSION(1:3) :: d3 = 0.0_R8Ki !< Vector / direction d3 (= -yn from the IEC coord. system) [-] + REAL(R8Ki) , DIMENSION(1:3) :: e1 = 0.0_R8Ki !< Vector / direction e1 (= xa from the IEC coord. system) [-] + REAL(R8Ki) , DIMENSION(1:3) :: e2 = 0.0_R8Ki !< Vector / direction e2 (= ya from the IEC coord. system) [-] + REAL(R8Ki) , DIMENSION(1:3) :: e3 = 0.0_R8Ki !< Vector / direction e3 (= za from the IEC coord. system) [-] + REAL(R8Ki) , DIMENSION(1:3) :: f1 = 0.0_R8Ki !< Vector / direction f1 [-] + REAL(R8Ki) , DIMENSION(1:3) :: f2 = 0.0_R8Ki !< Vector / direction f2 [-] + REAL(R8Ki) , DIMENSION(1:3) :: f3 = 0.0_R8Ki !< Vector / direction f3 [-] + REAL(R8Ki) , DIMENSION(1:3) :: g1 = 0.0_R8Ki !< Vector / direction g1 (= xh from the IEC coord. system) [-] + REAL(R8Ki) , DIMENSION(1:3) :: g2 = 0.0_R8Ki !< Vector / direction g2 (= yh from the IEC coord. system) [-] + REAL(R8Ki) , DIMENSION(1:3) :: g3 = 0.0_R8Ki !< Vector / direction g3 (= zh from the IEC coord. system) [-] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: i1 !< i1(K,:) = vector / direction i1 for blade K (= xcK from the IEC coord. system) [-] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: i2 !< i2(K,:) = vector / direction i2 for blade K (= ycK from the IEC coord. system) [-] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: i3 !< i3(K,:) = vector / direction i3 for blade K (= zcK from the IEC coord. system) [-] @@ -298,37 +320,37 @@ MODULE ElastoDyn_Types REAL(R8Ki) , DIMENSION(:,:,:), ALLOCATABLE :: n1 !< n1(K,J,:) = vector / direction n1 for node J of blade K (= LxbK from the IEC coord. system) [-] REAL(R8Ki) , DIMENSION(:,:,:), ALLOCATABLE :: n2 !< n2(K,J,:) = vector / direction n2 for node J of blade K (= LybK from the IEC coord. system) [-] REAL(R8Ki) , DIMENSION(:,:,:), ALLOCATABLE :: n3 !< n3(K,J,:) = vector / direction n3 for node J of blade K (= LzbK from the IEC coord. system) [-] - REAL(R8Ki) , DIMENSION(1:3) :: rf1 !< Vector / direction rf1 (rotor-furl coordinate system = d1 when rotor-furl angle = 0) [-] - REAL(R8Ki) , DIMENSION(1:3) :: rf2 !< Vector / direction rf2 (rotor-furl coordinate system = d2 when rotor-furl angle = 0) [-] - REAL(R8Ki) , DIMENSION(1:3) :: rf3 !< Vector / direction rf3 (rotor-furl coordinate system = d3 when rotor-furl angle = 0) [-] - REAL(R8Ki) , DIMENSION(1:3) :: rfa !< Vector / direction of the rotor-furl axis [-] + REAL(R8Ki) , DIMENSION(1:3) :: rf1 = 0.0_R8Ki !< Vector / direction rf1 (rotor-furl coordinate system = d1 when rotor-furl angle = 0) [-] + REAL(R8Ki) , DIMENSION(1:3) :: rf2 = 0.0_R8Ki !< Vector / direction rf2 (rotor-furl coordinate system = d2 when rotor-furl angle = 0) [-] + REAL(R8Ki) , DIMENSION(1:3) :: rf3 = 0.0_R8Ki !< Vector / direction rf3 (rotor-furl coordinate system = d3 when rotor-furl angle = 0) [-] + REAL(R8Ki) , DIMENSION(1:3) :: rfa = 0.0_R8Ki !< Vector / direction of the rotor-furl axis [-] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: t1 !< Vector / direction t1 for tower node J (= Lxt from the IEC coord. system) [-] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: t2 !< Vector / direction t2 for tower node J (= Lzt from the IEC coord. system) [-] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: t3 !< Vector / direction t3 for tower node J (= -Lyt from the IEC coord. system) [-] REAL(R8Ki) , DIMENSION(:,:,:), ALLOCATABLE :: te1 !< te1(K,J,:) = vector / direction te1 for node J of blade K (used to calc. noise) [-] REAL(R8Ki) , DIMENSION(:,:,:), ALLOCATABLE :: te2 !< te2(K,J,:) = vector / direction te2 for node J of blade K (used to calc. noise) [-] REAL(R8Ki) , DIMENSION(:,:,:), ALLOCATABLE :: te3 !< te3(K,J,:) = vector / direction te3 for node J of blade K (used to calc. noise) [-] - REAL(R8Ki) , DIMENSION(1:3) :: tf1 !< Vector / direction tf1 (tail-furl coordinate system = d1 when rotor-furl angle = 0) [-] - REAL(R8Ki) , DIMENSION(1:3) :: tf2 !< Vector / direction tf2 (tail-furl coordinate system = d2 when rotor-furl angle = 0) [-] - REAL(R8Ki) , DIMENSION(1:3) :: tf3 !< Vector / direction tf3 (tail-furl coordinate system = d3 when rotor-furl angle = 0) [-] - REAL(R8Ki) , DIMENSION(1:3) :: tfa !< Vector / direction of the tail-furl axis [-] - REAL(R8Ki) , DIMENSION(1:3) :: z1 !< Vector / direction z1 (= xi from the IEC coord. system) [-] - REAL(R8Ki) , DIMENSION(1:3) :: z2 !< Vector / direction z2 (= zi from the IEC coord. system) [-] - REAL(R8Ki) , DIMENSION(1:3) :: z3 !< Vector / direction z3 (= -yi from the IEC coord. system) [-] + REAL(R8Ki) , DIMENSION(1:3) :: tf1 = 0.0_R8Ki !< Vector / direction tf1 (tail-furl coordinate system = d1 when rotor-furl angle = 0) [-] + REAL(R8Ki) , DIMENSION(1:3) :: tf2 = 0.0_R8Ki !< Vector / direction tf2 (tail-furl coordinate system = d2 when rotor-furl angle = 0) [-] + REAL(R8Ki) , DIMENSION(1:3) :: tf3 = 0.0_R8Ki !< Vector / direction tf3 (tail-furl coordinate system = d3 when rotor-furl angle = 0) [-] + REAL(R8Ki) , DIMENSION(1:3) :: tfa = 0.0_R8Ki !< Vector / direction of the tail-furl axis [-] + REAL(R8Ki) , DIMENSION(1:3) :: z1 = 0.0_R8Ki !< Vector / direction z1 (= xi from the IEC coord. system) [-] + REAL(R8Ki) , DIMENSION(1:3) :: z2 = 0.0_R8Ki !< Vector / direction z2 (= zi from the IEC coord. system) [-] + REAL(R8Ki) , DIMENSION(1:3) :: z3 = 0.0_R8Ki !< Vector / direction z3 (= -yi from the IEC coord. system) [-] END TYPE ED_CoordSys ! ======================= ! ========= ED_ActiveDOFs ======= TYPE, PUBLIC :: ED_ActiveDOFs - INTEGER(IntKi) :: NActvDOF !< The number of active (enabled) DOFs in the model [-] - INTEGER(IntKi) :: NPCE !< Number of DOFs that contribute to the QD2T-related linear accelerations of the hub center of mass (point C) in the inertia frame, based on which DOFs are presently enabled [-] - INTEGER(IntKi) :: NPDE !< Number of DOFs that contribute to the QD2T-related linear accelerations of the center of mass of the structure that furls with the rotor (not including rotor) (point D) in the inertia frame, based on which DOFs are presently enabled [-] - INTEGER(IntKi) :: NPIE !< Number of DOFs that contribute to the QD2T-related linear accelerations of the tail boom center of mass (point I) in the inertia frame, based on which DOFs are presently enabled [-] - INTEGER(IntKi) :: NPTE !< Number of DOFs that contribute to the QD2T-related linear accelerations of the tower nodes (point T) in the inertia frame, based on which DOFs are presently enabled [-] - INTEGER(IntKi) :: NPTTE !< Number of tower DOFs that contribute to the QD2T-related linear accelerations of the tower nodes (point T) in the inertia frame, based on which DOFs are presently enabled [-] + INTEGER(IntKi) :: NActvDOF = 0_IntKi !< The number of active (enabled) DOFs in the model [-] + INTEGER(IntKi) :: NPCE = 0_IntKi !< Number of DOFs that contribute to the QD2T-related linear accelerations of the hub center of mass (point C) in the inertia frame, based on which DOFs are presently enabled [-] + INTEGER(IntKi) :: NPDE = 0_IntKi !< Number of DOFs that contribute to the QD2T-related linear accelerations of the center of mass of the structure that furls with the rotor (not including rotor) (point D) in the inertia frame, based on which DOFs are presently enabled [-] + INTEGER(IntKi) :: NPIE = 0_IntKi !< Number of DOFs that contribute to the QD2T-related linear accelerations of the tail boom center of mass (point I) in the inertia frame, based on which DOFs are presently enabled [-] + INTEGER(IntKi) :: NPTE = 0_IntKi !< Number of DOFs that contribute to the QD2T-related linear accelerations of the tower nodes (point T) in the inertia frame, based on which DOFs are presently enabled [-] + INTEGER(IntKi) :: NPTTE = 0_IntKi !< Number of tower DOFs that contribute to the QD2T-related linear accelerations of the tower nodes (point T) in the inertia frame, based on which DOFs are presently enabled [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: NPSBE !< Number of blade DOFs that contribute to the QD2T-related linear accelerations of the blade nodes (point S) in the inertia frame, based on which DOFs are presently enabled [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: NPSE !< Number of DOFs that contribute to the QD2T-related linear accelerations of the blade nodes (point S) in the inertia frame, based on which DOFs are presently enabled [-] - INTEGER(IntKi) :: NPUE !< Number of DOFs that contribute to the QD2T-related linear accelerations of the nacelle center of mass (point U) in the inertia frame, based on which DOFs are presently enabled [-] - INTEGER(IntKi) :: NPYE !< Number of DOFs that contribute to the QD2T-related linear accelerations of the platform center of mass (point Y) in the inertia frame, based on which DOFs are presently enabled [-] + INTEGER(IntKi) :: NPUE = 0_IntKi !< Number of DOFs that contribute to the QD2T-related linear accelerations of the nacelle center of mass (point U) in the inertia frame, based on which DOFs are presently enabled [-] + INTEGER(IntKi) :: NPYE = 0_IntKi !< Number of DOFs that contribute to the QD2T-related linear accelerations of the platform center of mass (point Y) in the inertia frame, based on which DOFs are presently enabled [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: PCE !< Array of DOF indices (pointers) that contribute to the QD2T-related linear accelerations of the hub center of mass (point C) in the inertia frame, based on which DOFs are presently enabled [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: PDE !< Array of DOF indices (pointers) that contribute to the QD2T-related linear accelerations of the center of mass of the structure that furls with the rotor (not including rotor) (point D) in the inertia frame, based on which DOFs are presently enabled [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: PIE !< Array of DOF indices (pointers) that contribute to the QD2T-related linear accelerations of the tail boom center of mass (point I) in the inertia frame, based on which DOFs are presently enabled [-] @@ -346,39 +368,39 @@ MODULE ElastoDyn_Types ! ======================= ! ========= ED_RtHndSide ======= TYPE, PUBLIC :: ED_RtHndSide - REAL(R8Ki) , DIMENSION(1:3) :: rO !< Position vector from inertial frame origin to tower-top / base plate (point O) [m] + REAL(R8Ki) , DIMENSION(1:3) :: rO = 0.0_R8Ki !< Position vector from inertial frame origin to tower-top / base plate (point O) [m] REAL(R8Ki) , DIMENSION(:,:,:), ALLOCATABLE :: rQS !< Position vector from the apex of rotation (point Q) to a point on a blade (point S) [m] REAL(R8Ki) , DIMENSION(:,:,:), ALLOCATABLE :: rS !< Position vector from inertial frame origin to a point on a blade (point S) [m] REAL(R8Ki) , DIMENSION(:,:,:), ALLOCATABLE :: rS0S !< Position vector from the blade root (point S(0)) to a point on a blade (point S) [m] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: rT !< Position vector from inertial frame origin to the current node (point T(HNodes(J)) [m] - REAL(R8Ki) , DIMENSION(1:3) :: rT0O !< Position vector from the tower base (point T(0)) to tower-top / base plate (point O) [m] + REAL(R8Ki) , DIMENSION(1:3) :: rT0O = 0.0_R8Ki !< Position vector from the tower base (point T(0)) to tower-top / base plate (point O) [m] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: rT0T !< Position vector from a height of TowerBsHt (base of flexible portion of tower) (point T(0)) to a point on the tower (point T) [m] - REAL(R8Ki) , DIMENSION(1:3) :: rZ !< Position vector from inertia frame origin to platform reference (point Z) [m] - REAL(R8Ki) , DIMENSION(1:3) :: rZO !< Position vector from platform reference (point Z) to tower-top / base plate (point O) [m] + REAL(R8Ki) , DIMENSION(1:3) :: rZ = 0.0_R8Ki !< Position vector from inertia frame origin to platform reference (point Z) [m] + REAL(R8Ki) , DIMENSION(1:3) :: rZO = 0.0_R8Ki !< Position vector from platform reference (point Z) to tower-top / base plate (point O) [m] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: rZT !< Position vector from platform reference (point Z) to a point on a tower (point T) [m] - REAL(R8Ki) , DIMENSION(1:3) :: rPQ !< Position vector from teeter pin (point P) to apex of rotation (point Q) [m] - REAL(R8Ki) , DIMENSION(1:3) :: rP !< Position vector from inertial frame origin to teeter pin (point P) [m] - REAL(R8Ki) , DIMENSION(1:3) :: rV !< Position vector from inertial frame origin to specified point on rotor-furl axis (point V) [m] - REAL(R8Ki) , DIMENSION(1:3) :: rJ !< Position vector from inertial frame origin to tail fin center of mass (point J) [m] - REAL(R8Ki) , DIMENSION(1:3) :: rZY !< Position vector from platform reference (point Z) to platform mass center (point Y) [m] - REAL(R8Ki) , DIMENSION(1:3) :: rOU !< Position vector from tower-top / base plate (point O) to nacelle center of mass (point U). [m] - REAL(R8Ki) , DIMENSION(1:3) :: rOV !< Position vector from tower-top / base plate (point O) to specified point on rotor-furl axis (point V) [m] - REAL(R8Ki) , DIMENSION(1:3) :: rVD !< Position vector from specified point on rotor-furl axis (point V) to center of mass of structure that furls with the rotor (not including rotor) (point D) [m] - REAL(R8Ki) , DIMENSION(1:3) :: rOW !< Position vector from tower-top / base plate (point O) to specified point on tail-furl axis (point W) [m] - REAL(R8Ki) , DIMENSION(1:3) :: rPC !< Position vector from teeter pin (point P) to hub center of mass (point C) [m] + REAL(R8Ki) , DIMENSION(1:3) :: rPQ = 0.0_R8Ki !< Position vector from teeter pin (point P) to apex of rotation (point Q) [m] + REAL(R8Ki) , DIMENSION(1:3) :: rP = 0.0_R8Ki !< Position vector from inertial frame origin to teeter pin (point P) [m] + REAL(R8Ki) , DIMENSION(1:3) :: rV = 0.0_R8Ki !< Position vector from inertial frame origin to specified point on rotor-furl axis (point V) [m] + REAL(R8Ki) , DIMENSION(1:3) :: rJ = 0.0_R8Ki !< Position vector from inertial frame origin to tail fin center of mass (point J) [m] + REAL(R8Ki) , DIMENSION(1:3) :: rZY = 0.0_R8Ki !< Position vector from platform reference (point Z) to platform mass center (point Y) [m] + REAL(R8Ki) , DIMENSION(1:3) :: rOU = 0.0_R8Ki !< Position vector from tower-top / base plate (point O) to nacelle center of mass (point U). [m] + REAL(R8Ki) , DIMENSION(1:3) :: rOV = 0.0_R8Ki !< Position vector from tower-top / base plate (point O) to specified point on rotor-furl axis (point V) [m] + REAL(R8Ki) , DIMENSION(1:3) :: rVD = 0.0_R8Ki !< Position vector from specified point on rotor-furl axis (point V) to center of mass of structure that furls with the rotor (not including rotor) (point D) [m] + REAL(R8Ki) , DIMENSION(1:3) :: rOW = 0.0_R8Ki !< Position vector from tower-top / base plate (point O) to specified point on tail-furl axis (point W) [m] + REAL(R8Ki) , DIMENSION(1:3) :: rPC = 0.0_R8Ki !< Position vector from teeter pin (point P) to hub center of mass (point C) [m] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: rPS0 !< Position vector from teeter pin (point P) to blade root (point S(0)) [m] - REAL(R8Ki) , DIMENSION(1:3) :: rQ !< Position vector from inertial frame origin to apex of rotation (point Q) [m] - REAL(R8Ki) , DIMENSION(1:3) :: rQC !< Position vector from apex of rotation (point Q) to hub center of mass (point C) [m] - REAL(R8Ki) , DIMENSION(1:3) :: rVIMU !< Position vector from specified point on rotor-furl axis (point V) to nacelle IMU (point IMU) [m] - REAL(R8Ki) , DIMENSION(1:3) :: rVP !< Position vector from specified point on rotor-furl axis (point V) to teeter pin (point P) [m] - REAL(R8Ki) , DIMENSION(1:3) :: rWI !< Position vector from specified point on tail-furl axis (point W) to tail boom center of mass (point I) [m] - REAL(R8Ki) , DIMENSION(1:3) :: rWJ !< Position vector from specified point on tail-furl axis (point W) to tail fin center of mass (point J) [m] - REAL(R8Ki) , DIMENSION(1:3) :: rZT0 !< Position vector from platform reference (point Z) to tower base (point T(0)) [m] + REAL(R8Ki) , DIMENSION(1:3) :: rQ = 0.0_R8Ki !< Position vector from inertial frame origin to apex of rotation (point Q) [m] + REAL(R8Ki) , DIMENSION(1:3) :: rQC = 0.0_R8Ki !< Position vector from apex of rotation (point Q) to hub center of mass (point C) [m] + REAL(R8Ki) , DIMENSION(1:3) :: rVIMU = 0.0_R8Ki !< Position vector from specified point on rotor-furl axis (point V) to nacelle IMU (point IMU) [m] + REAL(R8Ki) , DIMENSION(1:3) :: rVP = 0.0_R8Ki !< Position vector from specified point on rotor-furl axis (point V) to teeter pin (point P) [m] + REAL(R8Ki) , DIMENSION(1:3) :: rWI = 0.0_R8Ki !< Position vector from specified point on tail-furl axis (point W) to tail boom center of mass (point I) [m] + REAL(R8Ki) , DIMENSION(1:3) :: rWJ = 0.0_R8Ki !< Position vector from specified point on tail-furl axis (point W) to tail fin center of mass (point J) [m] + REAL(R8Ki) , DIMENSION(1:3) :: rZT0 = 0.0_R8Ki !< Position vector from platform reference (point Z) to tower base (point T(0)) [m] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: AngPosEF !< Angular position of the current point on the tower (body F) in the inertial frame (body E for earth) [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: AngPosXF !< Angular position of the current point on the tower (body F) in the platform (body X) [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: AngPosHM !< Angular position of eleMent J of blade K (body M) in the hub (body H) [-] - REAL(ReKi) , DIMENSION(1:3) :: AngPosXB !< Angular position of the base plate (body B) in the platform (body X) [-] - REAL(ReKi) , DIMENSION(1:3) :: AngPosEX !< Angular position of the platform (body X) in the inertial frame (body E for earth) [-] + REAL(ReKi) , DIMENSION(1:3) :: AngPosXB = 0.0_ReKi !< Angular position of the base plate (body B) in the platform (body X) [-] + REAL(ReKi) , DIMENSION(1:3) :: AngPosEX = 0.0_ReKi !< Angular position of the platform (body X) in the inertial frame (body E for earth) [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: PAngVelEA !< Partial angular velocity (and its 1st time derivative) of the tail (body A) in the inertia frame (body E for earth) [-] REAL(ReKi) , DIMENSION(:,:,:,:), ALLOCATABLE :: PAngVelEF !< Partial angular velocity (and its 1st time derivative) of tower element J (body F) in the inertia frame (body E for earth) [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: PAngVelEG !< Partial angular velocity (and its 1st time derivative) of the generator (body G) in the inertia frame (body E for earth) [-] @@ -387,37 +409,37 @@ MODULE ElastoDyn_Types REAL(ReKi) , DIMENSION(:,:,:,:,:), ALLOCATABLE :: PAngVelEM !< Partial angular velocity (and its 1st time derivative) of eleMent J of blade K (body M) in the inertia frame (body E for earth) [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: AngVelEM !< Angular velocity of of eleMent J of blade K (body M) in the inertia frame (body E for earth) [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: PAngVelEN !< Partial angular velocity (and its 1st time derivative) of the nacelle (body N) in the inertia frame (body E for earth) [-] - REAL(ReKi) , DIMENSION(1:3) :: AngVelEA !< Angular velocity of the tail (body A) in the inertia frame (body E for earth) [-] + REAL(ReKi) , DIMENSION(1:3) :: AngVelEA = 0.0_ReKi !< Angular velocity of the tail (body A) in the inertia frame (body E for earth) [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: PAngVelEB !< Partial angular velocity (and its 1st time derivative) of the base plate (body B) in the inertia frame (body E for earth) [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: PAngVelER !< Partial angular velocity (and its 1st time derivative) of the structure that furls with the rotor (not including rotor) (body R) in the inertia frame (body E for earth) [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: PAngVelEX !< Partial angular velocity (and its 1st time derivative) of the platform (body B) in the inertia frame (body E for earth) [-] - REAL(ReKi) , DIMENSION(1:3) :: AngVelEG !< Angular velocity of the generator (body G) in the inertia frame (body E for earth) [-] - REAL(ReKi) , DIMENSION(1:3) :: AngVelEH !< Angular velocity of the hub (body H) in the inertia frame (body E for earth) [-] - REAL(ReKi) , DIMENSION(1:3) :: AngVelEL !< Angular velocity of the low-speed shaft (body L) in the inertia frame (body E for earth) [-] - REAL(ReKi) , DIMENSION(1:3) :: AngVelEN !< Angular velocity of the nacelle (body N) in the inertia frame (body E for earth) [-] - REAL(ReKi) , DIMENSION(1:3) :: AngVelEB !< Angular velocity of the base plate (body B) in the inertia frame (body E for earth) [-] - REAL(ReKi) , DIMENSION(1:3) :: AngVelER !< Angular velocity of the structure that furls with the rotor (not including rotor) (body R) in the inertia frame (body E for earth) [-] - REAL(ReKi) , DIMENSION(1:3) :: AngVelEX !< Angular velocity of the platform (body X) in the inertia frame (body E for earth) [-] - REAL(R8Ki) :: TeetAngVel !< Angular velocity of the teeter motion [-] - REAL(ReKi) , DIMENSION(1:3) :: AngAccEBt !< Portion of the angular acceleration of the base plate (body B) in the inertia frame (body E for earth) associated with everything but the QD2T()s [-] - REAL(ReKi) , DIMENSION(1:3) :: AngAccERt !< Portion of the angular acceleration of the structure that furls with the rotor (not including rotor) (body R) in the inertia frame (body E for earth) associated with everything but the QD2T()s [-] - REAL(ReKi) , DIMENSION(1:3) :: AngAccEXt !< Portion of the angular acceleration of the platform (body X) in the inertia frame (body E for earth) associated with everything but the QD2T()s [-] + REAL(ReKi) , DIMENSION(1:3) :: AngVelEG = 0.0_ReKi !< Angular velocity of the generator (body G) in the inertia frame (body E for earth) [-] + REAL(ReKi) , DIMENSION(1:3) :: AngVelEH = 0.0_ReKi !< Angular velocity of the hub (body H) in the inertia frame (body E for earth) [-] + REAL(ReKi) , DIMENSION(1:3) :: AngVelEL = 0.0_ReKi !< Angular velocity of the low-speed shaft (body L) in the inertia frame (body E for earth) [-] + REAL(ReKi) , DIMENSION(1:3) :: AngVelEN = 0.0_ReKi !< Angular velocity of the nacelle (body N) in the inertia frame (body E for earth) [-] + REAL(ReKi) , DIMENSION(1:3) :: AngVelEB = 0.0_ReKi !< Angular velocity of the base plate (body B) in the inertia frame (body E for earth) [-] + REAL(ReKi) , DIMENSION(1:3) :: AngVelER = 0.0_ReKi !< Angular velocity of the structure that furls with the rotor (not including rotor) (body R) in the inertia frame (body E for earth) [-] + REAL(ReKi) , DIMENSION(1:3) :: AngVelEX = 0.0_ReKi !< Angular velocity of the platform (body X) in the inertia frame (body E for earth) [-] + REAL(R8Ki) :: TeetAngVel = 0.0_R8Ki !< Angular velocity of the teeter motion [-] + REAL(ReKi) , DIMENSION(1:3) :: AngAccEBt = 0.0_ReKi !< Portion of the angular acceleration of the base plate (body B) in the inertia frame (body E for earth) associated with everything but the QD2T()s [-] + REAL(ReKi) , DIMENSION(1:3) :: AngAccERt = 0.0_ReKi !< Portion of the angular acceleration of the structure that furls with the rotor (not including rotor) (body R) in the inertia frame (body E for earth) associated with everything but the QD2T()s [-] + REAL(ReKi) , DIMENSION(1:3) :: AngAccEXt = 0.0_ReKi !< Portion of the angular acceleration of the platform (body X) in the inertia frame (body E for earth) associated with everything but the QD2T()s [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: AngAccEFt !< Portion of the angular acceleration of tower element J (body F) in the inertia frame (body E for earth) associated with everything but the QD2T()s [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: AngVelEF !< Angular velocity of the current point on the tower (body F) in the inertia frame (body E for earth) [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: AngVelHM !< Angular velocity of the current point on the blade in the inertia frame [-] - REAL(ReKi) , DIMENSION(1:3) :: AngAccEAt !< Portion of the angular acceleration of the tail (body A) in the inertia frame (body E for earth) associated with everything but the QD2T()'s [-] - REAL(ReKi) , DIMENSION(1:3) :: AngAccEGt !< Portion of the angular acceleration of the generator (body G) in the inertia frame (body E for earth) associated with everything but the QD2T()'s [-] - REAL(ReKi) , DIMENSION(1:3) :: AngAccEHt !< Portion of the angular acceleration of the hub (body H) in the inertia frame (body E for earth) associated with everything but the QD2T()'s [-] + REAL(ReKi) , DIMENSION(1:3) :: AngAccEAt = 0.0_ReKi !< Portion of the angular acceleration of the tail (body A) in the inertia frame (body E for earth) associated with everything but the QD2T()'s [-] + REAL(ReKi) , DIMENSION(1:3) :: AngAccEGt = 0.0_ReKi !< Portion of the angular acceleration of the generator (body G) in the inertia frame (body E for earth) associated with everything but the QD2T()'s [-] + REAL(ReKi) , DIMENSION(1:3) :: AngAccEHt = 0.0_ReKi !< Portion of the angular acceleration of the hub (body H) in the inertia frame (body E for earth) associated with everything but the QD2T()'s [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: AngAccEKt !< Portion of the angular acceleration of the blade in the inertia frame associated with everything but the QD2T()'s [-] - REAL(ReKi) , DIMENSION(1:3) :: AngAccENt !< Portion of the angular acceleration of the nacelle (body N) in the inertia frame (body E for earth) associated with everything but the QD2T()'s [-] - REAL(ReKi) , DIMENSION(1:3) :: LinAccECt !< Portion of the linear acceleration of the hub center of mass (point C) in the inertia frame (body E for earth) associated with everything but the QD2T()'s [-] - REAL(ReKi) , DIMENSION(1:3) :: LinAccEDt !< Portion of the linear acceleration of the center of mass of the structure that furls with the rotor (not including rotor) (point D) in the inertia frame (body E for earth) associated with everything but the QD2T()'s [-] - REAL(ReKi) , DIMENSION(1:3) :: LinAccEIt !< Portion of the linear acceleration of the tail boom center of mass (point I) in the inertia frame (body E for earth) associated with everything but the QD2T()'s [-] - REAL(ReKi) , DIMENSION(1:3) :: LinAccEJt !< Portion of the linear acceleration of the tail fin center of mass (point J) in the inertia frame (body E for earth) associated with everything but the QD2T()'s [-] - REAL(ReKi) , DIMENSION(1:3) :: LinAccEUt !< Portion of the linear acceleration of the nacelle center of mass (point U) in the inertia frame (body E for earth) associated with everything but the QD2T()'s [-] - REAL(ReKi) , DIMENSION(1:3) :: LinAccEYt !< Portion of the linear acceleration of the platform center of mass (point Y) in the inertia frame (body E for earth) associated with everything but the QD2T()'s [-] + REAL(ReKi) , DIMENSION(1:3) :: AngAccENt = 0.0_ReKi !< Portion of the angular acceleration of the nacelle (body N) in the inertia frame (body E for earth) associated with everything but the QD2T()'s [-] + REAL(ReKi) , DIMENSION(1:3) :: LinAccECt = 0.0_ReKi !< Portion of the linear acceleration of the hub center of mass (point C) in the inertia frame (body E for earth) associated with everything but the QD2T()'s [-] + REAL(ReKi) , DIMENSION(1:3) :: LinAccEDt = 0.0_ReKi !< Portion of the linear acceleration of the center of mass of the structure that furls with the rotor (not including rotor) (point D) in the inertia frame (body E for earth) associated with everything but the QD2T()'s [-] + REAL(ReKi) , DIMENSION(1:3) :: LinAccEIt = 0.0_ReKi !< Portion of the linear acceleration of the tail boom center of mass (point I) in the inertia frame (body E for earth) associated with everything but the QD2T()'s [-] + REAL(ReKi) , DIMENSION(1:3) :: LinAccEJt = 0.0_ReKi !< Portion of the linear acceleration of the tail fin center of mass (point J) in the inertia frame (body E for earth) associated with everything but the QD2T()'s [-] + REAL(ReKi) , DIMENSION(1:3) :: LinAccEUt = 0.0_ReKi !< Portion of the linear acceleration of the nacelle center of mass (point U) in the inertia frame (body E for earth) associated with everything but the QD2T()'s [-] + REAL(ReKi) , DIMENSION(1:3) :: LinAccEYt = 0.0_ReKi !< Portion of the linear acceleration of the platform center of mass (point Y) in the inertia frame (body E for earth) associated with everything but the QD2T()'s [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: LinVelES !< Linear velocity of current point on the current blade (point S) in the inertia frame [-] - REAL(ReKi) , DIMENSION(1:3) :: LinVelEQ !< Linear velocity of of the apex of rotation (point Q) in the inertia frame (body E for earth) [-] + REAL(ReKi) , DIMENSION(1:3) :: LinVelEQ = 0.0_ReKi !< Linear velocity of of the apex of rotation (point Q) in the inertia frame (body E for earth) [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: LinVelET !< Linear velocity of current point on the tower (point T) in the inertia frame [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: LinVelESm2 !< The m2-component (closest to tip) of LinVelES [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: PLinVelEIMU !< Partial linear velocity (and its 1st time derivative) of the nacelle IMU (point IMU) in the inertia frame (body E for earth) [-] @@ -435,38 +457,38 @@ MODULE ElastoDyn_Types REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: PLinVelEV !< Partial linear velocity (and its 1st time derivative) of the selected point on the rotor-furl axis (point V) in the inertia frame (body E for earth) [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: PLinVelEW !< Partial linear velocity (and its 1st time derivative) of the selected point on the tail-furl axis (point W) in the inertia frame (body E for earth) [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: PLinVelEY !< Partial linear velocity (and its 1st time derivative) of the platform mass center (point Y) in the inertia frame (body E for earth) [-] - REAL(ReKi) , DIMENSION(1:3) :: LinAccEIMUt !< Portion of the linear acceleration of the nacelle IMU (point IMU) in the inertia frame (body E for earth) associated with everything but the QD2T()'s [-] - REAL(ReKi) , DIMENSION(1:3) :: LinAccEOt !< Portion of the linear acceleration of the base plate (point O) in the inertia frame (body E for earth) associated with everything but the QD2T()'s [-] + REAL(ReKi) , DIMENSION(1:3) :: LinAccEIMUt = 0.0_ReKi !< Portion of the linear acceleration of the nacelle IMU (point IMU) in the inertia frame (body E for earth) associated with everything but the QD2T()'s [-] + REAL(ReKi) , DIMENSION(1:3) :: LinAccEOt = 0.0_ReKi !< Portion of the linear acceleration of the base plate (point O) in the inertia frame (body E for earth) associated with everything but the QD2T()'s [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: LinAccESt !< Portion of the linear acceleration of a point on a blade (point S) in the inertia frame (body E for earth) associated with everything but the QD2T()'s [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: LinAccETt !< Portion of the linear acceleration of a point on the tower (point T) in the inertia frame (body E for earth) associated with everything but the QD2T()'s [-] - REAL(ReKi) , DIMENSION(1:3) :: LinAccEZt !< Portion of the linear acceleration of the platform reference (point Z) in the inertia frame (body E for earth) associated with everything but the QD2T()'s [-] - REAL(ReKi) , DIMENSION(1:3) :: LinVelEIMU !< Linear velocity of the nacelle IMU (point IMU) in the inertia frame [-] - REAL(ReKi) , DIMENSION(1:3) :: LinVelEZ !< Linear velocity of platform reference (point Z) in the inertia frame [-] - REAL(ReKi) , DIMENSION(1:3) :: LinVelEO !< Linear velocity of the base plate (point O) in the inertia frame (body E for earth) [-] - REAL(ReKi) , DIMENSION(1:3) :: LinVelEJ !< Linear velocity of the tail fin CM (point J) in the inertia frame (body E for earth) [-] - REAL(ReKi) , DIMENSION(1:3) :: FrcONcRtt !< Portion of the force at yaw bearing (point O) due to the nacelle, generator, and rotor associated with everything but the QD2T()'s [-] - REAL(ReKi) , DIMENSION(1:3) :: FrcPRott !< Portion of the force at the teeter pin (point P) due to the rotor associated with everything but the QD2T()'s [-] + REAL(ReKi) , DIMENSION(1:3) :: LinAccEZt = 0.0_ReKi !< Portion of the linear acceleration of the platform reference (point Z) in the inertia frame (body E for earth) associated with everything but the QD2T()'s [-] + REAL(ReKi) , DIMENSION(1:3) :: LinVelEIMU = 0.0_ReKi !< Linear velocity of the nacelle IMU (point IMU) in the inertia frame [-] + REAL(ReKi) , DIMENSION(1:3) :: LinVelEZ = 0.0_ReKi !< Linear velocity of platform reference (point Z) in the inertia frame [-] + REAL(ReKi) , DIMENSION(1:3) :: LinVelEO = 0.0_ReKi !< Linear velocity of the base plate (point O) in the inertia frame (body E for earth) [-] + REAL(ReKi) , DIMENSION(1:3) :: LinVelEJ = 0.0_ReKi !< Linear velocity of the tail fin CM (point J) in the inertia frame (body E for earth) [-] + REAL(ReKi) , DIMENSION(1:3) :: FrcONcRtt = 0.0_ReKi !< Portion of the force at yaw bearing (point O) due to the nacelle, generator, and rotor associated with everything but the QD2T()'s [-] + REAL(ReKi) , DIMENSION(1:3) :: FrcPRott = 0.0_ReKi !< Portion of the force at the teeter pin (point P) due to the rotor associated with everything but the QD2T()'s [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: FrcS0Bt !< Portion of the force at the blade root (point S(0)) due to the blade associated with everything but the QD2T()'s [-] - REAL(ReKi) , DIMENSION(1:3) :: FrcT0Trbt !< Portion of the force at tower base (point T(0)) due to the turbine associated with everything but the QD2T()'s [-] + REAL(ReKi) , DIMENSION(1:3) :: FrcT0Trbt = 0.0_ReKi !< Portion of the force at tower base (point T(0)) due to the turbine associated with everything but the QD2T()'s [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: FSAero !< The aerodynamic force per unit span acting on a blade at point S [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: FSTipDrag !< The aerodynamic force at a blade tip resulting from tip drag [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: FTHydrot !< Portion of the hydrodynamic force (& all other external forces, including aerodynamic) per unit length acting on the tower at point T associated with everything but the QD2T()'s [-] - REAL(ReKi) , DIMENSION(1:3) :: FZHydrot !< Portion of the platform hydrodynamic force at the platform reference (point Z) associated with everything but the QD2T()'s [-] + REAL(ReKi) , DIMENSION(1:3) :: FZHydrot = 0.0_ReKi !< Portion of the platform hydrodynamic force at the platform reference (point Z) associated with everything but the QD2T()'s [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: MFHydrot !< Portion of the hydrodynamic moment (and all other external moments, including aerodynamic) per unit length acting on a tower element (body F) at point T associated with everything but the QD2T()'s [-] - REAL(ReKi) , DIMENSION(1:3) :: MomBNcRtt !< Portion of the moment at the base plate (body B) / yaw bearing (point O) due to the nacelle, generator, and rotor associated with everything but the QD2T()'s [-] + REAL(ReKi) , DIMENSION(1:3) :: MomBNcRtt = 0.0_ReKi !< Portion of the moment at the base plate (body B) / yaw bearing (point O) due to the nacelle, generator, and rotor associated with everything but the QD2T()'s [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: MomH0Bt !< Portion of the moment at the hub (body H) / blade root (point S(0)) due to the blade associated with everything but the QD2T()'s [-] - REAL(ReKi) , DIMENSION(1:3) :: MomLPRott !< Portion of the moment at the teeter pin (point P) on the low-speed shaft (body L) due to the rotor associated with everything but the QD2T()'s [-] - REAL(ReKi) , DIMENSION(1:3) :: MomNGnRtt !< Portion of the moment at the nacelle (body N) / selected point on rotor-furl axis (point V) due the structure that furls with the rotor, generator, and rotor associated with everything but the QD2T()'s [-] - REAL(ReKi) , DIMENSION(1:3) :: MomNTailt !< Portion of the moment at the nacelle (body N) / selected point on tail-furl axis (point W) due the tail associated with everything but the QD2T()'s [-] - REAL(ReKi) , DIMENSION(1:3) :: MomX0Trbt !< Portion of the moment at the platform (body X) / tower base (point T(0)) due to the turbine associated with everything but the QD2T()'s [-] + REAL(ReKi) , DIMENSION(1:3) :: MomLPRott = 0.0_ReKi !< Portion of the moment at the teeter pin (point P) on the low-speed shaft (body L) due to the rotor associated with everything but the QD2T()'s [-] + REAL(ReKi) , DIMENSION(1:3) :: MomNGnRtt = 0.0_ReKi !< Portion of the moment at the nacelle (body N) / selected point on rotor-furl axis (point V) due the structure that furls with the rotor, generator, and rotor associated with everything but the QD2T()'s [-] + REAL(ReKi) , DIMENSION(1:3) :: MomNTailt = 0.0_ReKi !< Portion of the moment at the nacelle (body N) / selected point on tail-furl axis (point W) due the tail associated with everything but the QD2T()'s [-] + REAL(ReKi) , DIMENSION(1:3) :: MomX0Trbt = 0.0_ReKi !< Portion of the moment at the platform (body X) / tower base (point T(0)) due to the turbine associated with everything but the QD2T()'s [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: MMAero !< The aerodynamic moment per unit span acting on a blade at point S [-] - REAL(ReKi) , DIMENSION(1:3) :: MXHydrot !< Portion of the platform hydrodynamic moment acting at the platform (body X) / platform reference (point Z) associated with everything but the QD2T()'s [-] + REAL(ReKi) , DIMENSION(1:3) :: MXHydrot = 0.0_ReKi !< Portion of the platform hydrodynamic moment acting at the platform (body X) / platform reference (point Z) associated with everything but the QD2T()'s [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PFrcONcRt !< Partial force at the yaw bearing (point O) due to the nacelle, generator, and rotor [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PFrcPRot !< Partial force at the teeter pin (point P) due to the rotor [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: PFrcS0B !< Partial force at the blade root (point S(0)) due to the blade [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PFrcT0Trb !< Partial force at the tower base (point T(0)) due to the turbine [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: PFTHydro !< Partial hydrodynamic force per unit length acting on the tower at point T [-] - REAL(ReKi) , DIMENSION(1:6,1:3) :: PFZHydro !< Partial platform hydrodynamic force at the platform reference (point Z) [-] + REAL(ReKi) , DIMENSION(1:6,1:3) :: PFZHydro = 0.0_ReKi !< Partial platform hydrodynamic force at the platform reference (point Z) [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: PMFHydro !< Partial hydrodynamic moment per unit length acting on a tower element (body F) at point T [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PMomBNcRt !< Partial moment at the base plate (body B) / yaw bearing (point O) due the nacelle, generator, and rotor [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: PMomH0B !< Partial moment at the hub (body H) / blade root (point S(0)) due to the blade [-] @@ -474,21 +496,22 @@ MODULE ElastoDyn_Types REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PMomNGnRt !< Partial moment at the nacelle (body N) / selected point on rotor-furl axis (point V) due the structure that furls with the rotor, generator, and rotor [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PMomNTail !< Partial moment at the nacelle (body N) / selected point on tail-furl axis (point W) due the tail [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PMomX0Trb !< Partial moment at the platform (body X) / tower base (point T(0)) due to the turbine [-] - REAL(ReKi) , DIMENSION(1:6,1:3) :: PMXHydro !< Partial platform hydrodynamic moment at the platform (body X) / platform reference (point Z) [-] - REAL(R8Ki) :: TeetAng !< Current teeter angle = QT(DOF_Teet) for 2-blader or 0 for 3-blader (this is used in place of QT(DOF_Teet) throughout RtHS() [-] - REAL(ReKi) , DIMENSION(1:3) :: FrcVGnRtt !< Portion of the force at the rotor-furl axis (point V) due to the structure that furls with the rotor, generator, and rotor associated with everything but the QD2T()'s [-] - REAL(ReKi) , DIMENSION(1:3) :: FrcWTailt !< Portion of the force at the tail-furl axis (point W) due to the tail associated with everything but the QD2T()'s [-] - REAL(ReKi) , DIMENSION(1:3) :: FrcZAllt !< Portion of the force at platform reference (point Z) due to everything associated with everything but the QD2T()'s [-] - REAL(ReKi) , DIMENSION(1:3) :: MomXAllt !< Portion of the moment at the platform (body X) / platform reference (point Z) due to everything associated with everything but the QD2T()'s [-] + REAL(ReKi) , DIMENSION(1:6,1:3) :: PMXHydro = 0.0_ReKi !< Partial platform hydrodynamic moment at the platform (body X) / platform reference (point Z) [-] + REAL(R8Ki) :: TeetAng = 0.0_R8Ki !< Current teeter angle = QT(DOF_Teet) for 2-blader or 0 for 3-blader (this is used in place of QT(DOF_Teet) throughout RtHS() [-] + REAL(ReKi) , DIMENSION(1:3) :: FrcVGnRtt = 0.0_ReKi !< Portion of the force at the rotor-furl axis (point V) due to the structure that furls with the rotor, generator, and rotor associated with everything but the QD2T()'s [-] + REAL(ReKi) , DIMENSION(1:3) :: FrcWTailt = 0.0_ReKi !< Portion of the force at the tail-furl axis (point W) due to the tail associated with everything but the QD2T()'s [-] + REAL(ReKi) , DIMENSION(1:3) :: FrcZAllt = 0.0_ReKi !< Portion of the force at platform reference (point Z) due to everything associated with everything but the QD2T()'s [-] + REAL(ReKi) , DIMENSION(1:3) :: MomXAllt = 0.0_ReKi !< Portion of the moment at the platform (body X) / platform reference (point Z) due to everything associated with everything but the QD2T()'s [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PFrcVGnRt !< Partial force at the rotor-furl axis (point V) due to the structure that furls with the rotor, generator, and rotor [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PFrcWTail !< Partial force at the tail-furl axis (point W) due to the tail [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PFrcZAll !< Partial force at the platform reference (point Z) due to everything [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PMomXAll !< Partial moment at the platform (body X) / platform reference (point Z) due to the everything [-] - REAL(ReKi) :: TeetMom !< The total moment supplied by the stop, spring, and damper of the teeter mechanism [-] - REAL(ReKi) :: TFrlMom !< The total tail-furl spring and damper moment [-] - REAL(ReKi) :: RFrlMom !< The total rotor-furl spring and damper moment [-] - REAL(ReKi) :: GBoxEffFac !< The factor used to apply the gearbox efficiency effects to the equation associated with the generator DOF [-] + REAL(ReKi) :: TeetMom = 0.0_ReKi !< The total moment supplied by the stop, spring, and damper of the teeter mechanism [-] + REAL(ReKi) :: TFrlMom = 0.0_ReKi !< The total tail-furl spring and damper moment [-] + REAL(ReKi) :: RFrlMom = 0.0_ReKi !< The total rotor-furl spring and damper moment [-] + REAL(ReKi) :: GBoxEffFac = 0.0_ReKi !< The factor used to apply the gearbox efficiency effects to the equation associated with the generator DOF [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: rSAerCen !< aerodynamic pitching moment arm (i.e., the position vector from point S on the blade to the aerodynamic center of the element) [-] + REAL(ReKi) :: YawFriMom = 0.0_ReKi !< Yaw Friction Moment [kN-m] END TYPE ED_RtHndSide ! ======================= ! ========= ED_ContinuousStateType ======= @@ -499,23 +522,27 @@ MODULE ElastoDyn_Types ! ======================= ! ========= ED_DiscreteStateType ======= TYPE, PUBLIC :: ED_DiscreteStateType - REAL(ReKi) :: DummyDiscState !< Remove this variable if you have discrete states [-] + REAL(ReKi) :: DummyDiscState = 0.0_ReKi !< Remove this variable if you have discrete states [-] END TYPE ED_DiscreteStateType ! ======================= ! ========= ED_ConstraintStateType ======= TYPE, PUBLIC :: ED_ConstraintStateType - REAL(ReKi) :: DummyConstrState !< Remove this variable if you have constraint states [-] + REAL(ReKi) :: DummyConstrState = 0.0_ReKi !< Remove this variable if you have constraint states [-] END TYPE ED_ConstraintStateType ! ======================= ! ========= ED_OtherStateType ======= TYPE, PUBLIC :: ED_OtherStateType - INTEGER(IntKi) :: n !< tracks time step for which OtherState was updated [-] - TYPE(ED_ContinuousStateType) , DIMENSION(ED_NMX) :: xdot !< previous state deriv for multi-step [-] + INTEGER(IntKi) :: n = 0_IntKi !< tracks time step for which OtherState was updated [-] + TYPE(ED_ContinuousStateType) , DIMENSION(1:ED_NMX) :: xdot !< previous state deriv for multi-step [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: IC !< Array which stores pointers to predictor-corrector results [-] - REAL(ReKi) :: HSSBrTrq !< HSSBrTrq from update states; a hack to get this working with a single integrator [-] - REAL(ReKi) :: HSSBrTrqC !< Commanded HSS brake torque (adjusted for sign) [N-m] - INTEGER(IntKi) :: SgnPrvLSTQ !< The sign of the low-speed shaft torque from the previous call to RtHS(). This is calculated at the end of RtHS(). NOTE: The low-speed shaft torque is assumed to be positive at the beginning of the run! [-] - INTEGER(IntKi) , DIMENSION(ED_NMX) :: SgnLSTQ !< history of sign of LSTQ [-] + REAL(ReKi) :: HSSBrTrq = 0.0_ReKi !< HSSBrTrq from update states; a hack to get this working with a single integrator [-] + REAL(ReKi) :: HSSBrTrqC = 0.0_ReKi !< Commanded HSS brake torque (adjusted for sign) [N-m] + INTEGER(IntKi) :: SgnPrvLSTQ = 0_IntKi !< The sign of the low-speed shaft torque from the previous call to RtHS(). This is calculated at the end of RtHS(). NOTE: The low-speed shaft torque is assumed to be positive at the beginning of the run! [-] + INTEGER(IntKi) , DIMENSION(1:ED_NMX) :: SgnLSTQ = 0_IntKi !< history of sign of LSTQ [-] + REAL(ReKi) :: Mfhat = 0.0_ReKi !< Final Yaw Friction Torque [N-m] + REAL(ReKi) :: YawFriMfp = 0.0_ReKi !< Yaw Friction Torque to bring yaw system to a stop at current time step [N-m] + REAL(R8Ki) :: OmegaTn = 0.0_R8Ki !< Yaw rate at t_n used to calculate friction torque and yaw rate at t_n+1 [rad/s] + REAL(R8Ki) :: OmegaDotTn = 0.0_R8Ki !< Yaw acceleration at t_n used to calculate friction torque and yaw rate at t_n+1 [rad/s^2] END TYPE ED_OtherStateType ! ======================= ! ========= ED_MiscVarType ======= @@ -529,21 +556,47 @@ MODULE ElastoDyn_Types INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: AugMat_pivot !< Pivot column for AugMat in LAPACK factorization [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: OgnlGeAzRo !< Original DOF_GeAz row in AugMat [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: QD2T !< Solution (acceleration) vector; the first time derivative of QDT [-] - LOGICAL :: IgnoreMod !< whether to ignore the modulo in ED outputs (necessary for linearization perturbations) [-] + LOGICAL :: IgnoreMod = .false. !< whether to ignore the modulo in ED outputs (necessary for linearization perturbations) [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: OgnlYawRow !< Original DOF_Yaw row in AugMat [-] + REAL(ReKi) , DIMENSION(1:3) :: FrcONcRt = 0.0_ReKi !< Force acting on yaw bearing including inertial contributions [N] + REAL(ReKi) , DIMENSION(1:3) :: MomONcRt = 0.0_ReKi !< Moment acting on yaw bearing including inertial contributions [N-m] + REAL(ReKi) :: YawFriMz = 0.0_ReKi !< External loading on yaw bearing not including inertial contributions [N-m] END TYPE ED_MiscVarType ! ======================= +! ========= Jac_u_idxStarts ======= + TYPE, PUBLIC :: Jac_u_idxStarts + INTEGER(IntKi) :: BladeLoad = 1 !< Index to first point in y jacobian for BladeLoad [-] + INTEGER(IntKi) :: PlatformLoad = 1 !< Index to first point in y jacobian for PlatformLoad [-] + INTEGER(IntKi) :: TowerLoad = 1 !< Index to first point in y jacobian for TowerLoad [-] + INTEGER(IntKi) :: HubLoad = 1 !< Index to first point in y jacobian for HubLoad [-] + INTEGER(IntKi) :: NacelleLoad = 1 !< Index to first point in y jacobian for NacelleLoad [-] + INTEGER(IntKi) :: TFinLoad = 1 !< Index to first point in y jacobian for TFinLoad [-] + INTEGER(IntKi) :: BlPitchCom = 1 !< Index to first point in y jacobian for BlPitchCom [-] + END TYPE Jac_u_idxStarts +! ======================= +! ========= Jac_y_idxStarts ======= + TYPE, PUBLIC :: Jac_y_idxStarts + INTEGER(IntKi) :: Blade = 1 !< Index to first point in u jacobian for Blade [-] + INTEGER(IntKi) :: Platform = 1 !< Index to first point in u jacobian for Platform [-] + INTEGER(IntKi) :: Tower = 1 !< Index to first point in u jacobian for Tower [-] + INTEGER(IntKi) :: Hub = 1 !< Index to first point in u jacobian for Hub [-] + INTEGER(IntKi) :: BladeRoot = 1 !< Index to first point in u jacobian for BladeRoot [-] + INTEGER(IntKi) :: Nacelle = 1 !< Index to first point in u jacobian for Nacelle [-] + INTEGER(IntKi) :: TFin = 1 !< Index to first point in u jacobian for TFin [-] + END TYPE Jac_y_idxStarts +! ======================= ! ========= ED_ParameterType ======= TYPE, PUBLIC :: ED_ParameterType - REAL(DbKi) :: DT !< Time step for continuous state integration & discrete state update [seconds] - REAL(DbKi) :: DT24 !< =DT/24 (used in loose coupling) [seconds] - INTEGER(IntKi) :: BldNodes !< Number of blade nodes used in the analysis [-] - INTEGER(IntKi) :: TipNode !< Index of the additional node located at the blade tip = BldNodes + 1 [-] - INTEGER(IntKi) :: NDOF !< Number of total degrees of freedom (DOFs) [-] - REAL(R8Ki) :: TwoPiNB !< Two pi divided by the number of blades [radians] - INTEGER(IntKi) :: NAug !< Dimension of augmented solution matrix [-] - INTEGER(IntKi) :: NPH !< Number of DOFs that contribute to the angular velocity of the hub (body H) in the inertia frame [-] + REAL(DbKi) :: DT = 0.0_R8Ki !< Time step for continuous state integration & discrete state update [seconds] + REAL(DbKi) :: DT24 = 0.0_R8Ki !< =DT/24 (used in loose coupling) [seconds] + INTEGER(IntKi) :: BldNodes = 0_IntKi !< Number of blade nodes used in the analysis [-] + INTEGER(IntKi) :: TipNode = 0_IntKi !< Index of the additional node located at the blade tip = BldNodes + 1 [-] + INTEGER(IntKi) :: NDOF = 0_IntKi !< Number of total degrees of freedom (DOFs) [-] + REAL(R8Ki) :: TwoPiNB = 0.0_R8Ki !< Two pi divided by the number of blades [radians] + INTEGER(IntKi) :: NAug = 0_IntKi !< Dimension of augmented solution matrix [-] + INTEGER(IntKi) :: NPH = 0_IntKi !< Number of DOFs that contribute to the angular velocity of the hub (body H) in the inertia frame [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: PH !< Array of DOF indices (pointers) that contribute to the angular velocity of the hub (body H) in the inertia frame [-] - INTEGER(IntKi) :: NPM !< Number of DOFs that contribute to the angular velocity of the blade elements (body M) in the inertia frame [-] + INTEGER(IntKi) :: NPM = 0_IntKi !< Number of DOFs that contribute to the angular velocity of the blade elements (body M) in the inertia frame [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: PM !< Array of DOF indices (pointers) that contribute to the angular velocity of the blade elements (body M) in the inertia frame [-] LOGICAL , DIMENSION(:), ALLOCATABLE :: DOF_Flag !< Array which stores values of the feature flags for each DOF [-] CHARACTER(99) , DIMENSION(:), ALLOCATABLE :: DOF_Desc !< Array which stores descriptions of each DOF [-] @@ -554,122 +607,125 @@ MODULE ElastoDyn_Types INTEGER(IntKi) :: NTwGages = 0 !< Number of tower strain gages [-] 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 [-] - REAL(ReKi) :: AvgNrmTpRd !< Average tip radius normal to the shaft [meters] - REAL(R8Ki) :: AzimB1Up !< Azimuth value to use for I/O when blade 1 points up [radians] + REAL(ReKi) :: AvgNrmTpRd = 0.0_ReKi !< Average tip radius normal to the shaft [meters] + REAL(R8Ki) :: AzimB1Up = 0.0_R8Ki !< Azimuth value to use for I/O when blade 1 points up [radians] REAL(R8Ki) :: CosDel3 = 1.0 !< Cosine of the Delta-3 angle for teetering rotors [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: CosPreC !< Cosines of the precone angles [-] - REAL(R8Ki) :: CRFrlSkew !< Cosine of the rotor-furl axis skew angle [-] - REAL(R8Ki) :: CRFrlSkw2 !< Cosine-squared of the rotor-furl axis skew angle [-] - REAL(R8Ki) :: CRFrlTilt !< Cosine of the rotor-furl axis tilt angle [-] - REAL(R8Ki) :: CRFrlTlt2 !< Cosine-squared of the rotor-furl axis tilt angle [-] - REAL(R8Ki) :: CShftSkew !< Cosine of the shaft skew angle [-] - REAL(R8Ki) :: CShftTilt !< Cosine of the shaft tilt angle [-] - REAL(R8Ki) :: CSRFrlSkw !< Cosine*Sine of the rotor-furl axis skew angle [-] - REAL(R8Ki) :: CSRFrlTlt !< Cosine*Sine of the rotor-furl axis tilt angle [-] - REAL(R8Ki) :: CSTFrlSkw !< Cosine*Sine of the tail-furl axis skew angle [-] - REAL(R8Ki) :: CSTFrlTlt !< Cosine*Sine of the tail-furl axis tilt angle [-] - REAL(R8Ki) :: CTFrlSkew !< Cosine of the tail-furl axis skew angle [-] - REAL(R8Ki) :: CTFrlSkw2 !< Cosine-squared of the tail-furl axis skew angle [-] - REAL(R8Ki) :: CTFrlTilt !< Cosine of the tail-furl axis tilt angle [-] - REAL(R8Ki) :: CTFrlTlt2 !< Cosine-squared of the tail-furl axis tilt angle [-] - REAL(ReKi) :: HubHt !< Hub-height as computed using FAST inputs [= TowerHt + Twr2Shft + OverHang*SIN( ShftTilt ) ] (was FASTHH) [-] - REAL(ReKi) :: HubCM !< Distance from rotor apex to hub mass [-] - REAL(ReKi) :: HubRad !< Preconed hub radius [-] - REAL(ReKi) :: NacCMxn !< Downwind distance from tower-top to nacelle CM [-] - REAL(ReKi) :: NacCMyn !< Lateral distance from tower-top to nacelle CM [-] - REAL(ReKi) :: NacCMzn !< Vertical distance from tower-top to nacelle CM [-] - REAL(ReKi) :: OverHang !< Distance from yaw axis to rotor apex or teeter pin [-] - REAL(ReKi) :: ProjArea !< Swept area of the rotor projected onto the rotor plane (the plane normal to the low-speed shaft) [-] - REAL(ReKi) :: PtfmRefzt !< Vertical distance from the ground level [onshore], MSL [offshore wind or floating MHK], or seabed [fixed MHK] to the platform reference point [-] - REAL(ReKi) :: RefTwrHt !< Vertical distance between FAST's undisplaced tower height (variable TowerHt) and FAST's inertia frame reference point (variable PtfmRef); that is, RefTwrHt = TowerHt - PtfmRefzt [-] - REAL(ReKi) , DIMENSION(1:3) :: RFrlPnt_n !< Vector from tower-top to arbitrary point on rotor-furl axis [-] - REAL(ReKi) :: rVDxn !< xn-component of position vector Rvd [-] - REAL(ReKi) :: rVDyn !< yn-component of position vector rVD [-] - REAL(ReKi) :: rVDzn !< zn-component of position vector rVD [-] - REAL(ReKi) :: rVIMUxn !< xn-component of position vector rVIMU [-] - REAL(ReKi) :: rVIMUyn !< yn-component of position vector rVIMU [-] - REAL(ReKi) :: rVIMUzn !< zn-component of position vector rVIMU [-] - REAL(ReKi) :: rVPxn !< xn-component of position vector rVP [-] - REAL(ReKi) :: rVPyn !< yn-component of position vector rVP [-] - REAL(ReKi) :: rVPzn !< zn-component of position vector rVP [-] - REAL(ReKi) :: rWIxn !< xn-component of position vector rWI [-] - REAL(ReKi) :: rWIyn !< yn-component of position vector rWI [-] - REAL(ReKi) :: rWIzn !< zn-component of position vector rWI [-] - REAL(ReKi) :: rWJxn !< xn-component of position vector rWJ [-] - REAL(ReKi) :: rWJyn !< yn-component of position vector rWJ [-] - REAL(ReKi) :: rWJzn !< zn-component of position vector rWJ [-] - REAL(ReKi) :: rZT0zt !< zt-component of position vector rZT0 [-] - REAL(ReKi) :: rZYzt !< zt-component of position vector rZY [-] - REAL(R8Ki) :: SinDel3 !< Sine of the Delta-3 angle for teetering rotors [-] + REAL(R8Ki) :: CRFrlSkew = 0.0_R8Ki !< Cosine of the rotor-furl axis skew angle [-] + REAL(R8Ki) :: CRFrlSkw2 = 0.0_R8Ki !< Cosine-squared of the rotor-furl axis skew angle [-] + REAL(R8Ki) :: CRFrlTilt = 0.0_R8Ki !< Cosine of the rotor-furl axis tilt angle [-] + REAL(R8Ki) :: CRFrlTlt2 = 0.0_R8Ki !< Cosine-squared of the rotor-furl axis tilt angle [-] + REAL(R8Ki) :: CShftSkew = 0.0_R8Ki !< Cosine of the shaft skew angle [-] + REAL(R8Ki) :: CShftTilt = 0.0_R8Ki !< Cosine of the shaft tilt angle [-] + REAL(R8Ki) :: CSRFrlSkw = 0.0_R8Ki !< Cosine*Sine of the rotor-furl axis skew angle [-] + REAL(R8Ki) :: CSRFrlTlt = 0.0_R8Ki !< Cosine*Sine of the rotor-furl axis tilt angle [-] + REAL(R8Ki) :: CSTFrlSkw = 0.0_R8Ki !< Cosine*Sine of the tail-furl axis skew angle [-] + REAL(R8Ki) :: CSTFrlTlt = 0.0_R8Ki !< Cosine*Sine of the tail-furl axis tilt angle [-] + REAL(R8Ki) :: CTFrlSkew = 0.0_R8Ki !< Cosine of the tail-furl axis skew angle [-] + REAL(R8Ki) :: CTFrlSkw2 = 0.0_R8Ki !< Cosine-squared of the tail-furl axis skew angle [-] + REAL(R8Ki) :: CTFrlTilt = 0.0_R8Ki !< Cosine of the tail-furl axis tilt angle [-] + REAL(R8Ki) :: CTFrlTlt2 = 0.0_R8Ki !< Cosine-squared of the tail-furl axis tilt angle [-] + REAL(ReKi) :: HubHt = 0.0_ReKi !< Hub-height as computed using FAST inputs [= TowerHt + Twr2Shft + OverHang*SIN( ShftTilt ) ] (was FASTHH) [-] + REAL(ReKi) :: HubCM = 0.0_ReKi !< Distance from rotor apex to hub mass [-] + REAL(ReKi) :: HubRad = 0.0_ReKi !< Preconed hub radius [-] + REAL(ReKi) :: NacCMxn = 0.0_ReKi !< Downwind distance from tower-top to nacelle CM [-] + REAL(ReKi) :: NacCMyn = 0.0_ReKi !< Lateral distance from tower-top to nacelle CM [-] + REAL(ReKi) :: NacCMzn = 0.0_ReKi !< Vertical distance from tower-top to nacelle CM [-] + REAL(ReKi) :: OverHang = 0.0_ReKi !< Distance from yaw axis to rotor apex or teeter pin [-] + REAL(ReKi) :: ProjArea = 0.0_ReKi !< Swept area of the rotor projected onto the rotor plane (the plane normal to the low-speed shaft) [-] + REAL(ReKi) :: PtfmRefzt = 0.0_ReKi !< Vertical distance from the ground level [onshore], MSL [offshore wind or floating MHK], or seabed [fixed MHK] to the platform reference point [-] + REAL(ReKi) :: RefTwrHt = 0.0_ReKi !< Vertical distance between FAST's undisplaced tower height (variable TowerHt) and FAST's inertia frame reference point (variable PtfmRef); that is, RefTwrHt = TowerHt - PtfmRefzt [-] + REAL(ReKi) , DIMENSION(1:3) :: RFrlPnt_n = 0.0_ReKi !< Vector from tower-top to arbitrary point on rotor-furl axis [-] + REAL(ReKi) :: rVDxn = 0.0_ReKi !< xn-component of position vector Rvd [-] + REAL(ReKi) :: rVDyn = 0.0_ReKi !< yn-component of position vector rVD [-] + REAL(ReKi) :: rVDzn = 0.0_ReKi !< zn-component of position vector rVD [-] + REAL(ReKi) :: rVIMUxn = 0.0_ReKi !< xn-component of position vector rVIMU [-] + REAL(ReKi) :: rVIMUyn = 0.0_ReKi !< yn-component of position vector rVIMU [-] + REAL(ReKi) :: rVIMUzn = 0.0_ReKi !< zn-component of position vector rVIMU [-] + REAL(ReKi) :: rVPxn = 0.0_ReKi !< xn-component of position vector rVP [-] + REAL(ReKi) :: rVPyn = 0.0_ReKi !< yn-component of position vector rVP [-] + REAL(ReKi) :: rVPzn = 0.0_ReKi !< zn-component of position vector rVP [-] + REAL(ReKi) :: rWIxn = 0.0_ReKi !< xn-component of position vector rWI [-] + REAL(ReKi) :: rWIyn = 0.0_ReKi !< yn-component of position vector rWI [-] + REAL(ReKi) :: rWIzn = 0.0_ReKi !< zn-component of position vector rWI [-] + REAL(ReKi) :: rWJxn = 0.0_ReKi !< xn-component of position vector rWJ [-] + REAL(ReKi) :: rWJyn = 0.0_ReKi !< yn-component of position vector rWJ [-] + REAL(ReKi) :: rWJzn = 0.0_ReKi !< zn-component of position vector rWJ [-] + REAL(ReKi) :: rZT0zt = 0.0_ReKi !< zt-component of position vector rZT0 [-] + REAL(ReKi) :: rZYzt = 0.0_ReKi !< zt-component of position vector rZY [-] + REAL(R8Ki) :: SinDel3 = 0.0_R8Ki !< Sine of the Delta-3 angle for teetering rotors [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: SinPreC !< Sines of the precone angles [-] - REAL(R8Ki) :: SRFrlSkew !< Sine of the rotor-furl axis skew angle [-] - REAL(R8Ki) :: SRFrlSkw2 !< Sine-squared of the rotor-furl axis skew angle [-] - REAL(R8Ki) :: SRFrlTilt !< Sine of the rotor-furl axis tilt angle [-] - REAL(R8Ki) :: SRFrlTlt2 !< Sine-squared of the rotor-furl axis tilt angle [-] - REAL(R8Ki) :: SShftSkew !< Sine of the shaft skew angle [-] - REAL(R8Ki) :: SShftTilt !< Sine of the shaft tilt angle [-] - REAL(R8Ki) :: STFrlSkew !< Sine of the tail-furl axis skew angle [-] - REAL(R8Ki) :: STFrlSkw2 !< Sine-squared of the tail-furl axis skew angle [-] - REAL(R8Ki) :: STFrlTilt !< Sine of the tail-furl axis tilt angle [-] - REAL(R8Ki) :: STFrlTlt2 !< Sine-squared of the tail-furl axis tilt angle [-] - REAL(ReKi) , DIMENSION(1:3) :: TFrlPnt_n !< Vector from tower-top to arbitrary point on tail-furl axis [-] - REAL(ReKi) :: TipRad !< Preconed blade-tip radius [-] - REAL(ReKi) :: TowerHt !< Height of tower relative to ground level [onshore], MSL [offshore wind or floating MHK], or seabed [fixed MHK] [meters] - REAL(ReKi) :: TowerBsHt !< Height of tower base relative to ground level [onshore], MSL [offshore wind or floating MHK], or seabed [fixed MHK] [meters] - REAL(ReKi) :: UndSling !< Undersling length [-] - INTEGER(IntKi) :: NumBl !< Number of turbine blades [-] + REAL(R8Ki) :: SRFrlSkew = 0.0_R8Ki !< Sine of the rotor-furl axis skew angle [-] + REAL(R8Ki) :: SRFrlSkw2 = 0.0_R8Ki !< Sine-squared of the rotor-furl axis skew angle [-] + REAL(R8Ki) :: SRFrlTilt = 0.0_R8Ki !< Sine of the rotor-furl axis tilt angle [-] + REAL(R8Ki) :: SRFrlTlt2 = 0.0_R8Ki !< Sine-squared of the rotor-furl axis tilt angle [-] + REAL(R8Ki) :: SShftSkew = 0.0_R8Ki !< Sine of the shaft skew angle [-] + REAL(R8Ki) :: SShftTilt = 0.0_R8Ki !< Sine of the shaft tilt angle [-] + REAL(R8Ki) :: STFrlSkew = 0.0_R8Ki !< Sine of the tail-furl axis skew angle [-] + REAL(R8Ki) :: STFrlSkw2 = 0.0_R8Ki !< Sine-squared of the tail-furl axis skew angle [-] + REAL(R8Ki) :: STFrlTilt = 0.0_R8Ki !< Sine of the tail-furl axis tilt angle [-] + REAL(R8Ki) :: STFrlTlt2 = 0.0_R8Ki !< Sine-squared of the tail-furl axis tilt angle [-] + REAL(ReKi) , DIMENSION(1:3) :: TFrlPnt_n = 0.0_ReKi !< Vector from tower-top to arbitrary point on tail-furl axis [-] + REAL(ReKi) :: TipRad = 0.0_ReKi !< Preconed blade-tip radius [-] + REAL(ReKi) :: TowerHt = 0.0_ReKi !< Height of tower relative to ground level [onshore], MSL [offshore wind or floating MHK], or seabed [fixed MHK] [meters] + REAL(ReKi) :: TowerBsHt = 0.0_ReKi !< Height of tower base relative to ground level [onshore], MSL [offshore wind or floating MHK], or seabed [fixed MHK] [meters] + REAL(ReKi) :: UndSling = 0.0_ReKi !< Undersling length [-] + INTEGER(IntKi) :: NumBl = 0_IntKi !< Number of turbine blades [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: AxRedTFA !< The axial-reduction terms for the fore-aft tower mode shapes [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: AxRedTSS !< The axial-reduction terms for the side-to-side tower mode shapes [-] - REAL(ReKi) , DIMENSION(1:2,1:2) :: CTFA !< Generalized damping of tower in fore-aft direction [-] - REAL(ReKi) , DIMENSION(1:2,1:2) :: CTSS !< Generalized damping of tower in side-to-side direction [-] + REAL(ReKi) , DIMENSION(1:2,1:2) :: CTFA = 0.0_ReKi !< Generalized damping of tower in fore-aft direction [-] + REAL(ReKi) , DIMENSION(1:2,1:2) :: CTSS = 0.0_ReKi !< Generalized damping of tower in side-to-side direction [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: DHNodes !< Length of variable-length tower elements [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: HNodes !< Location of variable-spaced tower nodes (relative to the tower rigid base height [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: HNodesNorm !< Normalized location of variable-spaced tower nodes (relative to the tower rigid base height) (0 < HNodesNorm(:) < 1) [-] - REAL(ReKi) , DIMENSION(1:2,1:2) :: KTFA !< Generalized stiffness of tower in fore-aft direction [-] - REAL(ReKi) , DIMENSION(1:2,1:2) :: KTSS !< Generalized stiffness of tower in side-to-side direction [-] + REAL(ReKi) , DIMENSION(1:2,1:2) :: KTFA = 0.0_ReKi !< Generalized stiffness of tower in fore-aft direction [-] + REAL(ReKi) , DIMENSION(1:2,1:2) :: KTSS = 0.0_ReKi !< Generalized stiffness of tower in side-to-side direction [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: MassT !< Interpolated lineal mass density of tower [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: StiffTSS !< Interpolated side-side tower stiffness [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: TwrFASF !< Tower fore-aft shape functions [-] - REAL(ReKi) :: TwrFlexL !< Height / length of the flexible portion of the tower [-] + REAL(ReKi) :: TwrFlexL = 0.0_ReKi !< Height / length of the flexible portion of the tower [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: TwrSSSF !< Tower side-to-side shape functions [-] - INTEGER(IntKi) :: TTopNode !< Index of the additional node located at the tower-top = TwrNodes + 1 [-] - INTEGER(IntKi) :: TwrNodes !< Number of tower nodes used in the analysis [-] - INTEGER(IntKi) :: MHK !< MHK turbine type switch [-] + INTEGER(IntKi) :: TTopNode = 0_IntKi !< Index of the additional node located at the tower-top = TwrNodes + 1 [-] + INTEGER(IntKi) :: TwrNodes = 0_IntKi !< Number of tower nodes used in the analysis [-] + INTEGER(IntKi) :: MHK = 0_IntKi !< MHK turbine type switch [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: StiffTFA !< Interpolated fore-aft tower stiffness [-] - REAL(ReKi) :: AtfaIner !< Inertia of tail boom about the tail-furl axis whose origin is the tail boom center of mass [-] + REAL(ReKi) :: AtfaIner = 0.0_ReKi !< Inertia of tail boom about the tail-furl axis whose origin is the tail boom center of mass [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BldCG !< Blade center of mass wrt the blade root [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BldMass !< Blade masses [-] - REAL(ReKi) :: BoomMass !< Tail boom mass [-] + REAL(ReKi) :: BoomMass = 0.0_ReKi !< Tail boom mass [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: FirstMom !< First mass moment of inertia of blades wrt the root [-] - REAL(ReKi) :: GenIner !< Generator inertia about HSS [-] - REAL(ReKi) :: Hubg1Iner !< Inertia of hub about g1-axis (rotor centerline) [-] - REAL(ReKi) :: Hubg2Iner !< Inertia of hub about g2-axis (transverse to the cyclinder and passing through its c.g.) [-] - REAL(ReKi) :: HubMass !< Hub mass [-] - REAL(ReKi) :: Nacd2Iner !< Inertia of nacelle about the d2-axis whose origin is the nacelle center of mass [-] - REAL(ReKi) :: NacMass !< Nacelle mass [-] - REAL(ReKi) :: PtfmMass !< Platform mass [-] - REAL(ReKi) :: PtfmPIner !< Platform inertia for pitch tilt rotation about the platform CM. [-] - REAL(ReKi) :: PtfmRIner !< Platform inertia for roll tilt rotation about the platform CM. [-] - REAL(ReKi) :: PtfmYIner !< Platform inertia for yaw rotation about the platform CM. [-] - REAL(ReKi) :: RFrlMass !< Rotor-furl mass [-] - REAL(ReKi) :: RotIner !< Inertia of rotor about its centerline [-] - REAL(ReKi) :: RotMass !< Rotor mass (blades, tips, and hub) [-] - REAL(ReKi) :: RrfaIner !< Inertia of structure that furls with the rotor (not including rotor) about the rotor-furl axis whose origin is the center of mass of the structure that furls with the rotor (not including rotor) [-] + REAL(ReKi) :: GenIner = 0.0_ReKi !< Generator inertia about HSS [-] + REAL(ReKi) :: Hubg1Iner = 0.0_ReKi !< Inertia of hub about g1-axis (rotor centerline) [-] + REAL(ReKi) :: Hubg2Iner = 0.0_ReKi !< Inertia of hub about g2-axis (transverse to the cyclinder and passing through its c.g.) [-] + REAL(ReKi) :: HubMass = 0.0_ReKi !< Hub mass [-] + REAL(ReKi) :: Nacd2Iner = 0.0_ReKi !< Inertia of nacelle about the d2-axis whose origin is the nacelle center of mass [-] + REAL(ReKi) :: NacMass = 0.0_ReKi !< Nacelle mass [-] + REAL(ReKi) :: PtfmMass = 0.0_ReKi !< Platform mass [-] + REAL(ReKi) :: PtfmPIner = 0.0_ReKi !< Platform inertia for pitch tilt rotation about the platform CM. [-] + REAL(ReKi) :: PtfmRIner = 0.0_ReKi !< Platform inertia for roll tilt rotation about the platform CM. [-] + REAL(ReKi) :: PtfmYIner = 0.0_ReKi !< Platform inertia for yaw rotation about the platform CM. [-] + REAL(ReKi) :: PtfmXYIner = 0.0_ReKi !< Platform xy inertia about the platform CM [kg m^2] + REAL(ReKi) :: PtfmYZIner = 0.0_ReKi !< Platform yz inertia about the platform CM [kg m^2] + REAL(ReKi) :: PtfmXZIner = 0.0_ReKi !< Platform xz inertia about the platform CM [kg m^2] + REAL(ReKi) :: RFrlMass = 0.0_ReKi !< Rotor-furl mass [-] + REAL(ReKi) :: RotIner = 0.0_ReKi !< Inertia of rotor about its centerline [-] + REAL(ReKi) :: RotMass = 0.0_ReKi !< Rotor mass (blades, tips, and hub) [-] + REAL(ReKi) :: RrfaIner = 0.0_ReKi !< Inertia of structure that furls with the rotor (not including rotor) about the rotor-furl axis whose origin is the center of mass of the structure that furls with the rotor (not including rotor) [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: SecondMom !< Second mass moment of inertia of blades wrt the root [-] - REAL(ReKi) :: TFinMass !< Tail fin mass [-] - REAL(ReKi) :: TFrlIner !< Tail boom inertia about tail-furl axis [-] + REAL(ReKi) :: TFinMass = 0.0_ReKi !< Tail fin mass [-] + REAL(ReKi) :: TFrlIner = 0.0_ReKi !< Tail boom inertia about tail-furl axis [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TipMass !< Tip-brake masses [-] - REAL(ReKi) :: TurbMass !< Mass of turbine (tower + rotor + nacelle) [-] - REAL(ReKi) :: TwrMass !< Mass of tower [-] - REAL(ReKi) :: TwrTpMass !< Tower-top mass (rotor + nacelle) [-] - REAL(ReKi) :: YawBrMass !< Yaw bearing mass [-] - REAL(ReKi) :: Gravity !< Gravitational acceleration [m/s^2] + REAL(ReKi) :: TurbMass = 0.0_ReKi !< Mass of turbine (tower + rotor + nacelle) [-] + REAL(ReKi) :: TwrMass = 0.0_ReKi !< Mass of tower [-] + REAL(ReKi) :: TwrTpMass = 0.0_ReKi !< Tower-top mass (rotor + nacelle) [-] + REAL(ReKi) :: YawBrMass = 0.0_ReKi !< Yaw bearing mass [-] + REAL(ReKi) :: Gravity = 0.0_ReKi !< Gravitational acceleration [m/s^2] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PitchAxis !< Pitch axis for analysis nodes [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: AeroTwst !< Aerodynamic twist of the blade at the analysis nodes [-] REAL(ReKi) , DIMENSION(:,:,:,:), ALLOCATABLE :: AxRedBld !< The axial-reduction terms of the blade shape function [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BldEDamp !< Blade edgewise damping coefficients [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BldFDamp !< Blade flapwise damping coefficients [-] - REAL(ReKi) :: BldFlexL !< Flexible blade length [-] + REAL(ReKi) :: BldFlexL = 0.0_ReKi !< Flexible blade length [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: CAeroTwst !< Cosine of the aerodynamic twist of the blade at the analysis nodes [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: CBE !< Generalized edgewise damping of the blades [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: CBF !< Generalized flapwise damping of the blades [-] @@ -695,63 +751,81 @@ MODULE ElastoDyn_Types REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BldEdgSh !< Blade-edge-mode shape coefficients [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: FreqBE !< Blade edgewise natural frequencies (both w/ and w/o centrifugal stiffening) [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: FreqBF !< Blade flapwise natural frequencies (both w/ and w/o centrifugal stiffening) [-] - REAL(ReKi) , DIMENSION(1:2,1:2) :: FreqTFA !< Computed fore-aft tower natural frequencies [-] - REAL(ReKi) , DIMENSION(1:2,1:2) :: FreqTSS !< Computed side-to-side tower natural frequencies [-] - REAL(ReKi) :: TeetCDmp !< Rotor-teeter rate-independent Coulomb-damping [-] - REAL(ReKi) :: TeetDmp !< Rotor-teeter damping constant [-] - REAL(ReKi) :: TeetDmpP !< Rotor-teeter damper position [-] - REAL(ReKi) :: TeetHSSp !< Rotor-teeter hard-stop linear-spring constant [-] - REAL(ReKi) :: TeetHStP !< Rotor-teeter hard-stop position [-] - REAL(ReKi) :: TeetSSSp !< Rotor-teeter soft-stop linear-spring constant [-] - REAL(ReKi) :: TeetSStP !< Rotor-teeter soft-stop position [-] - INTEGER(IntKi) :: TeetMod !< Rotor-teeter spring/damper model switch [-] - REAL(ReKi) :: TFrlDmp !< Tail-furl damping constant [-] - REAL(ReKi) :: TFrlDSDmp !< Tail-furl down-stop damping constant [-] - REAL(ReKi) :: TFrlDSDP !< Tail-furl down-stop damper position [-] - REAL(ReKi) :: TFrlDSSP !< Tail-furl down-stop spring position [-] - REAL(ReKi) :: TFrlDSSpr !< Tail-furl down-stop spring constant [-] - REAL(ReKi) :: TFrlSpr !< Tail-furl spring constant [-] - REAL(ReKi) :: TFrlUSDmp !< Tail-furl up-stop damping constant [-] - REAL(ReKi) :: TFrlUSDP !< Tail-furl up-stop damper position [-] - REAL(ReKi) :: TFrlUSSP !< Tail-furl up-stop spring position [-] - REAL(ReKi) :: TFrlUSSpr !< Tail-furl up-stop spring constant [-] - INTEGER(IntKi) :: TFrlMod !< Tail-furl spring/damper model switch [-] - REAL(ReKi) :: RFrlDmp !< Rotor-furl damping constant [-] - REAL(ReKi) :: RFrlDSDmp !< Rotor-furl down-stop damping constant [-] - REAL(ReKi) :: RFrlDSDP !< Rotor-furl down-stop damper position [-] - REAL(ReKi) :: RFrlDSSP !< Rotor-furl down-stop spring position [-] - REAL(ReKi) :: RFrlDSSpr !< Rotor-furl down-stop spring constant [-] - REAL(ReKi) :: RFrlSpr !< Rotor-furl spring constant [-] - REAL(ReKi) :: RFrlUSDmp !< Rotor-furl up-stop damping constant [-] - REAL(ReKi) :: RFrlUSDP !< Rotor-furl up-stop damper position [-] - REAL(ReKi) :: RFrlUSSP !< Rotor-furl up-stop spring position [-] - REAL(ReKi) :: RFrlUSSpr !< Rotor-furl up-stop spring constant [-] - INTEGER(IntKi) :: RFrlMod !< Rotor-furl spring/damper model switch [-] - REAL(ReKi) :: ShftGagL !< Distance from hub or teeter pin to shaft strain gages [-] - INTEGER(IntKi) , DIMENSION(1:9) :: BldGagNd !< Nodes closest to the blade strain gages [-] - INTEGER(IntKi) , DIMENSION(1:9) :: TwrGagNd !< Nodes closest to the tower strain gages [-] - REAL(DbKi) :: TStart !< Time to begin tabular output [-] - REAL(ReKi) :: DTTorDmp !< Drivetrain torsional damper [-] - REAL(ReKi) :: DTTorSpr !< Drivetrain torsional spring [-] - REAL(ReKi) :: GBRatio !< Gearbox ratio [-] - REAL(ReKi) :: GBoxEff !< Gearbox efficiency [-] - REAL(ReKi) :: RotSpeed !< Initial or fixed rotor speed [rad/s] + REAL(ReKi) , DIMENSION(1:2,1:2) :: FreqTFA = 0.0_ReKi !< Computed fore-aft tower natural frequencies [-] + REAL(ReKi) , DIMENSION(1:2,1:2) :: FreqTSS = 0.0_ReKi !< Computed side-to-side tower natural frequencies [-] + REAL(ReKi) :: TeetCDmp = 0.0_ReKi !< Rotor-teeter rate-independent Coulomb-damping [-] + REAL(ReKi) :: TeetDmp = 0.0_ReKi !< Rotor-teeter damping constant [-] + REAL(ReKi) :: TeetDmpP = 0.0_ReKi !< Rotor-teeter damper position [-] + REAL(ReKi) :: TeetHSSp = 0.0_ReKi !< Rotor-teeter hard-stop linear-spring constant [-] + REAL(ReKi) :: TeetHStP = 0.0_ReKi !< Rotor-teeter hard-stop position [-] + REAL(ReKi) :: TeetSSSp = 0.0_ReKi !< Rotor-teeter soft-stop linear-spring constant [-] + REAL(ReKi) :: TeetSStP = 0.0_ReKi !< Rotor-teeter soft-stop position [-] + INTEGER(IntKi) :: TeetMod = 0_IntKi !< Rotor-teeter spring/damper model switch [-] + REAL(ReKi) :: TFrlDmp = 0.0_ReKi !< Tail-furl damping constant [-] + REAL(ReKi) :: TFrlDSDmp = 0.0_ReKi !< Tail-furl down-stop damping constant [-] + REAL(ReKi) :: TFrlDSDP = 0.0_ReKi !< Tail-furl down-stop damper position [-] + REAL(ReKi) :: TFrlDSSP = 0.0_ReKi !< Tail-furl down-stop spring position [-] + REAL(ReKi) :: TFrlDSSpr = 0.0_ReKi !< Tail-furl down-stop spring constant [-] + REAL(ReKi) :: TFrlSpr = 0.0_ReKi !< Tail-furl spring constant [-] + REAL(ReKi) :: TFrlUSDmp = 0.0_ReKi !< Tail-furl up-stop damping constant [-] + REAL(ReKi) :: TFrlUSDP = 0.0_ReKi !< Tail-furl up-stop damper position [-] + REAL(ReKi) :: TFrlUSSP = 0.0_ReKi !< Tail-furl up-stop spring position [-] + REAL(ReKi) :: TFrlUSSpr = 0.0_ReKi !< Tail-furl up-stop spring constant [-] + INTEGER(IntKi) :: TFrlMod = 0_IntKi !< Tail-furl spring/damper model switch [-] + REAL(ReKi) :: RFrlDmp = 0.0_ReKi !< Rotor-furl damping constant [-] + REAL(ReKi) :: RFrlDSDmp = 0.0_ReKi !< Rotor-furl down-stop damping constant [-] + REAL(ReKi) :: RFrlDSDP = 0.0_ReKi !< Rotor-furl down-stop damper position [-] + REAL(ReKi) :: RFrlDSSP = 0.0_ReKi !< Rotor-furl down-stop spring position [-] + REAL(ReKi) :: RFrlDSSpr = 0.0_ReKi !< Rotor-furl down-stop spring constant [-] + REAL(ReKi) :: RFrlSpr = 0.0_ReKi !< Rotor-furl spring constant [-] + REAL(ReKi) :: RFrlUSDmp = 0.0_ReKi !< Rotor-furl up-stop damping constant [-] + REAL(ReKi) :: RFrlUSDP = 0.0_ReKi !< Rotor-furl up-stop damper position [-] + REAL(ReKi) :: RFrlUSSP = 0.0_ReKi !< Rotor-furl up-stop spring position [-] + REAL(ReKi) :: RFrlUSSpr = 0.0_ReKi !< Rotor-furl up-stop spring constant [-] + INTEGER(IntKi) :: RFrlMod = 0_IntKi !< Rotor-furl spring/damper model switch [-] + REAL(ReKi) :: ShftGagL = 0.0_ReKi !< Distance from hub or teeter pin to shaft strain gages [-] + INTEGER(IntKi) , DIMENSION(1:9) :: BldGagNd = 0_IntKi !< Nodes closest to the blade strain gages [-] + INTEGER(IntKi) , DIMENSION(1:9) :: TwrGagNd = 0_IntKi !< Nodes closest to the tower strain gages [-] + REAL(DbKi) :: TStart = 0.0_R8Ki !< Time to begin tabular output [-] + REAL(ReKi) :: DTTorDmp = 0.0_ReKi !< Drivetrain torsional damper [-] + REAL(ReKi) :: DTTorSpr = 0.0_ReKi !< Drivetrain torsional spring [-] + REAL(ReKi) :: GBRatio = 0.0_ReKi !< Gearbox ratio [-] + REAL(ReKi) :: GBoxEff = 0.0_ReKi !< Gearbox efficiency [-] + REAL(ReKi) :: RotSpeed = 0.0_ReKi !< Initial or fixed rotor speed [rad/s] CHARACTER(1024) :: RootName !< RootName for writing output files [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BElmntMass !< Mass of the blade elements [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TElmntMass !< Mass of the tower elements [-] - INTEGER(IntKi) :: method !< Identifier for integration method (1 [RK4], 2 [AB4], or 3 [ABM4]) [-] - REAL(ReKi) :: PtfmCMxt !< Downwind distance from the ground level [onshore], MSL [offshore wind or floating MHK], or seabed [fixed MHK] to the platform CM [meters] - REAL(ReKi) :: PtfmCMyt !< Lateral distance from the ground level [onshore], MSL [offshore wind or floating MHK], or seabed [fixed MHK] to the platform CM [meters] - LOGICAL :: BD4Blades !< flag to determine if BeamDyn is computing blade loads (true) or ElastoDyn is (false) [-] - LOGICAL :: UseAD14 !< flag to determine if AeroDyn14 is being used. Will remove this later when we've replaced AD14. [-] - INTEGER(IntKi) :: BldNd_NumOuts !< Number of requested output channels per blade node (ED_AllBldNdOuts) [-] - INTEGER(IntKi) :: BldNd_TotNumOuts !< Total number of requested output channels of blade node information (BldNd_NumOuts * BldNd_BlOutNd * BldNd_BladesOut -- ED_AllBldNdOuts) [-] + INTEGER(IntKi) :: method = 0_IntKi !< Identifier for integration method (1 [RK4], 2 [AB4], or 3 [ABM4]) [-] + REAL(ReKi) :: PtfmCMxt = 0.0_ReKi !< Downwind distance from the ground level [onshore], MSL [offshore wind or floating MHK], or seabed [fixed MHK] to the platform CM [meters] + REAL(ReKi) :: PtfmCMyt = 0.0_ReKi !< Lateral distance from the ground level [onshore], MSL [offshore wind or floating MHK], or seabed [fixed MHK] to the platform CM [meters] + LOGICAL :: BD4Blades = .false. !< flag to determine if BeamDyn is computing blade loads (true) or ElastoDyn is (false) [-] + LOGICAL :: RigidAero = .false. !< flag to determine if ElastoDyn if blades are rigid for aero -- when AeroDisk is used [-] + INTEGER(IntKi) :: YawFrctMod = 0_IntKi !< Identifier for YawFrctMod (0 [no friction], 1 [does not use Fz at bearing], or 2 [does use Fz at bearing] [-] + REAL(R8Ki) :: M_CD = 0.0_R8Ki !< Dynamic friction moment at null yaw rate [N-m] + REAL(R8Ki) :: M_FCD = 0.0_R8Ki !< Dynamic friction moment at null yaw rate proportional to yaw bearing shear force [N-m] + REAL(R8Ki) :: M_MCD = 0.0_R8Ki !< Dynamic friction moment at null yaw rate proportional to yaw bearing bending moment [N-m] + REAL(R8Ki) :: M_CSMAX = 0.0_R8Ki !< Maximum Coulomb friction torque [N-m] + REAL(R8Ki) :: M_FCSMAX = 0.0_R8Ki !< Maximum Coulomb friction torque proportional to yaw bearing shear force [N-m] + REAL(R8Ki) :: M_MCSMAX = 0.0_R8Ki !< Maximum Coulomb friction torque proportional to yaw bearing bending moment [N-m] + REAL(R8Ki) :: sig_v = 0.0_R8Ki !< Linear viscous friction coefficient [N-m/(rad/s)] + REAL(R8Ki) :: sig_v2 = 0.0_R8Ki !< Quadratic viscous friction coefficient [N-m/(rad/s)^2] + REAL(R8Ki) :: OmgCut = 0.0_R8Ki !< Nacelle yaw angular velocity cutoff below which viscous friction is to be linearized [rad/s] + INTEGER(IntKi) :: BldNd_NumOuts = 0_IntKi !< Number of requested output channels per blade node (ED_AllBldNdOuts) [-] + INTEGER(IntKi) :: BldNd_TotNumOuts = 0_IntKi !< Total number of requested output channels of blade node information (BldNd_NumOuts * BldNd_BlOutNd * BldNd_BladesOut -- ED_AllBldNdOuts) [-] TYPE(OutParmType) , DIMENSION(:), ALLOCATABLE :: BldNd_OutParam !< Names and units (and other characteristics) of all requested output parameters [-] - INTEGER(IntKi) :: BldNd_BladesOut !< The blades to output (ED_AllBldNdOuts) [-] + INTEGER(IntKi) :: BldNd_BladesOut = 0_IntKi !< The blades to output (ED_AllBldNdOuts) [-] + TYPE(Jac_u_idxStarts) :: Jac_u_idxStartList !< Starting indices for all Jac_u compenents [-] + TYPE(Jac_y_idxStarts) :: Jac_y_idxStartList !< Starting indices for all Jac_u compenents [-] 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(:), ALLOCATABLE :: dx !< vector that determines size of perturbation for x (continuous states) [-] - INTEGER(IntKi) :: Jac_ny !< number of outputs in jacobian matrix [-] + INTEGER(IntKi) :: Jac_ny = 0_IntKi !< number of outputs in jacobian matrix [-] + LOGICAL :: CompAeroMaps = .false. !< number of outputs in jacobian matrix [-] + INTEGER(IntKi) :: NumExtendedInputs = 0_IntKi !< number of extended inputs for linearization [-] + INTEGER(IntKi) :: NumBl_Lin = 0_IntKi !< number of blades in the jacobian [-] + INTEGER(IntKi) :: NActvVelDOF_Lin = 0_IntKi !< number of velocity states in the jacobian [-] + INTEGER(IntKi) :: NActvDOF_Lin = 0_IntKi !< number of active DOFs to use in the jacobian [-] + INTEGER(IntKi) :: NActvDOF_Stride = 0_IntKi !< stride for active DOFs to use in the jacobian [-] END TYPE ED_ParameterType ! ======================= ! ========= ED_InputType ======= @@ -763,11 +837,11 @@ MODULE ElastoDyn_Types TYPE(MeshType) :: NacelleLoads !< From ServoDyn/TMD: loads on the nacelle. [-] TYPE(MeshType) :: TFinCMLoads !< Aerodynamic forces and moments at the tail-fin center of mass point (point J) [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: TwrAddedMass !< 6-by-6 added mass matrix of the tower elements, per unit length-bjj: place on a mesh [per unit length] - REAL(ReKi) , DIMENSION(1:6,1:6) :: PtfmAddedMass !< Platform added mass matrix [kg, kg-m, kg-m^2] + REAL(ReKi) , DIMENSION(1:6,1:6) :: PtfmAddedMass = 0.0_ReKi !< Platform added mass matrix [kg, kg-m, kg-m^2] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BlPitchCom !< Commanded blade pitch angles [radians] - 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) :: YawMom = 0.0_ReKi !< Torque transmitted through the yaw bearing [N-m] + REAL(ReKi) :: GenTrq = 0.0_ReKi !< Electrical generator torque [N-m] + REAL(ReKi) :: HSSBrTrqC = 0.0_ReKi !< Commanded HSS brake torque [N-m] END TYPE ED_InputType ! ======================= ! ========= ED_OutputType ======= @@ -775,22803 +849,6951 @@ MODULE ElastoDyn_Types TYPE(MeshType) , DIMENSION(:), ALLOCATABLE :: BladeLn2Mesh !< A mesh on each blade, containing positions and orientations of the blade elements [-] TYPE(MeshType) :: PlatformPtMesh !< Platform reference point positions/orientations/velocities/accelerations [-] TYPE(MeshType) :: TowerLn2Mesh !< Tower line2 mesh with positions/orientations/velocities/accelerations [-] - TYPE(MeshType) :: HubPtMotion14 !< For AeroDyn v14: motions of the hub [-] TYPE(MeshType) :: HubPtMotion !< For AeroDyn and Lidar(InflowWind): motions of the hub [-] - TYPE(MeshType) :: BladeRootMotion14 !< For AeroDyn v14: motions of the blade roots [-] TYPE(MeshType) , DIMENSION(:), ALLOCATABLE :: BladeRootMotion !< For AeroDyn/BeamDyn: motions at the blade roots [-] - TYPE(MeshType) :: RotorFurlMotion14 !< For AeroDyn14: motions of the rotor furl point. [-] - TYPE(MeshType) :: NacelleMotion !< For AeroDyn14 & ServoDyn/TMD: motions of the nacelle. [-] - TYPE(MeshType) :: TowerBaseMotion14 !< For AeroDyn 14: motions of the tower base [-] + TYPE(MeshType) :: NacelleMotion !< For AeroDyn & ServoDyn/TMD: motions of the nacelle. [-] TYPE(MeshType) :: TFinCMMotion !< For AeroDyn: motions of the tail find CM point (point J) [-] 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 :: 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) :: TwrAccel !< Tower acceleration for tower feedback control (user routine only) [m/s^2] - REAL(ReKi) :: YawAngle !< Yaw angle to be used for yaw error calculations [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) :: LSShftFxa !< Rotating low-speed shaft force x [N] - REAL(ReKi) :: LSShftFys !< Nonrotating low-speed shaft force y [N] - REAL(ReKi) :: LSShftFzs !< Nonrotating low-speed shaft force z [N] + REAL(ReKi) :: Yaw = 0.0_ReKi !< Current nacelle yaw [radians] + REAL(ReKi) :: YawRate = 0.0_ReKi !< Current nacelle yaw rate [rad/s] + REAL(ReKi) :: LSS_Spd = 0.0_ReKi !< Low-speed shaft (LSS) speed at entrance to gearbox [rad/s] + REAL(ReKi) :: HSS_Spd = 0.0_ReKi !< High-speed shaft (HSS) speed [rad/s] + REAL(ReKi) :: RotSpeed = 0.0_ReKi !< Rotor azimuth angular speed [rad/s] + REAL(ReKi) :: TwrAccel = 0.0_ReKi !< Tower acceleration for tower feedback control (user routine only) [m/s^2] + REAL(ReKi) :: YawAngle = 0.0_ReKi !< Yaw angle to be used for yaw error calculations [radians] + REAL(ReKi) , DIMENSION(1:3) :: RootMyc = 0.0_ReKi !< 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 = 0.0_ReKi !< Tower-top / yaw bearing fore-aft (translational) acceleration (absolute) [m/s^2] + REAL(ReKi) :: YawBrTAyp = 0.0_ReKi !< Tower-top / yaw bearing side-to-side (translational) acceleration (absolute) [m/s^2] + REAL(ReKi) :: LSSTipPxa = 0.0_ReKi !< Rotor azimuth angle (position) [radians] + REAL(ReKi) , DIMENSION(1:3) :: RootMxc = 0.0_ReKi !< In-plane moment (i.e., the moment caused by in-plane forces) at the blade root [N-m] + REAL(ReKi) :: LSSTipMxa = 0.0_ReKi !< 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 = 0.0_ReKi !< 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 = 0.0_ReKi !< 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 = 0.0_ReKi !< 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 = 0.0_ReKi !< 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 = 0.0_ReKi !< Rotating (with nacelle) tower-top / yaw bearing pitch moment [N-m] + REAL(ReKi) :: YawBrMzn = 0.0_ReKi !< Tower-top / yaw bearing yaw moment [N-m] + REAL(ReKi) :: NcIMURAxs = 0.0_ReKi !< Nacelle inertial measurement unit angular (rotational) acceleration (absolute) [rad/s^2] + REAL(ReKi) :: NcIMURAys = 0.0_ReKi !< Nacelle inertial measurement unit angular (rotational) acceleration (absolute) [rad/s^2] + REAL(ReKi) :: NcIMURAzs = 0.0_ReKi !< Nacelle inertial measurement unit angular (rotational) acceleration (absolute) [rad/s^2] + REAL(ReKi) :: RotPwr = 0.0_ReKi !< Rotor power (this is equivalent to the low-speed shaft power) [W] + REAL(ReKi) :: LSShftFxa = 0.0_ReKi !< Rotating low-speed shaft force x [N] + REAL(ReKi) :: LSShftFys = 0.0_ReKi !< Nonrotating low-speed shaft force y [N] + REAL(ReKi) :: LSShftFzs = 0.0_ReKi !< Nonrotating low-speed shaft force z [N] END TYPE ED_OutputType ! ======================= CONTAINS - SUBROUTINE ED_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ED_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(ED_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) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 - INTEGER(IntKi) :: i5, i5_l, i5_u ! bounds (upper/lower) for an array dimension 5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_CopyInitInput' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInitInputData%InputFile = SrcInitInputData%InputFile - DstInitInputData%Linearize = SrcInitInputData%Linearize - DstInitInputData%ADInputFile = SrcInitInputData%ADInputFile - DstInitInputData%CompElast = SrcInitInputData%CompElast - DstInitInputData%RootName = SrcInitInputData%RootName - DstInitInputData%Gravity = SrcInitInputData%Gravity - DstInitInputData%MHK = SrcInitInputData%MHK - DstInitInputData%WtrDpth = SrcInitInputData%WtrDpth - END SUBROUTINE ED_CopyInitInput - - SUBROUTINE ED_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(ED_InitInputType), INTENT(INOUT) :: InitInputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_DestroyInitInput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE ED_DestroyInitInput - - SUBROUTINE ED_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(ED_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 = 'ED_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*LEN(InData%ADInputFile) ! ADInputFile - Int_BufSz = Int_BufSz + 1 ! CompElast - Int_BufSz = Int_BufSz + 1*LEN(InData%RootName) ! RootName - Re_BufSz = Re_BufSz + 1 ! Gravity - Int_BufSz = Int_BufSz + 1 ! MHK - Re_BufSz = Re_BufSz + 1 ! WtrDpth - 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 - DO I = 1, LEN(InData%ADInputFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%ADInputFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = TRANSFER(InData%CompElast, IntKiBuf(1)) - 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 - ReKiBuf(Re_Xferred) = InData%Gravity - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%MHK - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WtrDpth - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE ED_PackInitInput - - SUBROUTINE ED_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(ED_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) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 - INTEGER(IntKi) :: i5, i5_l, i5_u ! bounds (upper/lower) for an array dimension 5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_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 - DO I = 1, LEN(OutData%ADInputFile) - OutData%ADInputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%CompElast = TRANSFER(IntKiBuf(Int_Xferred), OutData%CompElast) - 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 - OutData%Gravity = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MHK = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WtrDpth = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE ED_UnPackInitInput +subroutine ED_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) + type(ED_InitInputType), intent(in) :: SrcInitInputData + type(ED_InitInputType), intent(inout) :: DstInitInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'ED_CopyInitInput' + ErrStat = ErrID_None + ErrMsg = '' + DstInitInputData%InputFile = SrcInitInputData%InputFile + DstInitInputData%Linearize = SrcInitInputData%Linearize + DstInitInputData%CompElast = SrcInitInputData%CompElast + DstInitInputData%RigidAero = SrcInitInputData%RigidAero + DstInitInputData%RootName = SrcInitInputData%RootName + DstInitInputData%Gravity = SrcInitInputData%Gravity + DstInitInputData%MHK = SrcInitInputData%MHK + DstInitInputData%WtrDpth = SrcInitInputData%WtrDpth + DstInitInputData%CompAeroMaps = SrcInitInputData%CompAeroMaps + DstInitInputData%RotSpeed = SrcInitInputData%RotSpeed +end subroutine + +subroutine ED_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(ED_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'ED_DestroyInitInput' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine ED_PackInitInput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(ED_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ED_PackInitInput' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%InputFile) + call RegPack(RF, InData%Linearize) + call RegPack(RF, InData%CompElast) + call RegPack(RF, InData%RigidAero) + call RegPack(RF, InData%RootName) + call RegPack(RF, InData%Gravity) + call RegPack(RF, InData%MHK) + call RegPack(RF, InData%WtrDpth) + call RegPack(RF, InData%CompAeroMaps) + call RegPack(RF, InData%RotSpeed) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ED_UnPackInitInput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(ED_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ED_UnPackInitInput' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%InputFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Linearize); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CompElast); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RigidAero); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RootName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Gravity); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MHK); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WtrDpth); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CompAeroMaps); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RotSpeed); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ED_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) + type(ED_InitOutputType), intent(in) :: SrcInitOutputData + type(ED_InitOutputType), intent(inout) :: DstInitOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ED_CopyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcInitOutputData%WriteOutputHdr)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) + if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then + allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitOutputData%WriteOutputUnt)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) + if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then + allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), 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 + end if + call NWTC_Library_CopyProgDesc(SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstInitOutputData%NumBl = SrcInitOutputData%NumBl + if (allocated(SrcInitOutputData%BlPitch)) then + LB(1:1) = lbound(SrcInitOutputData%BlPitch) + UB(1:1) = ubound(SrcInitOutputData%BlPitch) + if (.not. allocated(DstInitOutputData%BlPitch)) then + allocate(DstInitOutputData%BlPitch(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%BlPitch.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%BlPitch = SrcInitOutputData%BlPitch + end if + DstInitOutputData%BladeLength = SrcInitOutputData%BladeLength + DstInitOutputData%TowerFlexL = SrcInitOutputData%TowerFlexL + DstInitOutputData%TowerBaseHeight = SrcInitOutputData%TowerBaseHeight + DstInitOutputData%HubHt = SrcInitOutputData%HubHt + if (allocated(SrcInitOutputData%BldRNodes)) then + LB(1:1) = lbound(SrcInitOutputData%BldRNodes) + UB(1:1) = ubound(SrcInitOutputData%BldRNodes) + if (.not. allocated(DstInitOutputData%BldRNodes)) then + allocate(DstInitOutputData%BldRNodes(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%BldRNodes.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%BldRNodes = SrcInitOutputData%BldRNodes + end if + if (allocated(SrcInitOutputData%TwrHNodes)) then + LB(1:1) = lbound(SrcInitOutputData%TwrHNodes) + UB(1:1) = ubound(SrcInitOutputData%TwrHNodes) + if (.not. allocated(DstInitOutputData%TwrHNodes)) then + allocate(DstInitOutputData%TwrHNodes(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%TwrHNodes.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%TwrHNodes = SrcInitOutputData%TwrHNodes + end if + DstInitOutputData%PlatformPos = SrcInitOutputData%PlatformPos + DstInitOutputData%TwrBaseRefPos = SrcInitOutputData%TwrBaseRefPos + DstInitOutputData%TwrBaseTransDisp = SrcInitOutputData%TwrBaseTransDisp + DstInitOutputData%TwrBaseRefOrient = SrcInitOutputData%TwrBaseRefOrient + DstInitOutputData%TwrBaseOrient = SrcInitOutputData%TwrBaseOrient + DstInitOutputData%HubRad = SrcInitOutputData%HubRad + DstInitOutputData%RotSpeed = SrcInitOutputData%RotSpeed + DstInitOutputData%isFixed_GenDOF = SrcInitOutputData%isFixed_GenDOF + if (allocated(SrcInitOutputData%LinNames_y)) then + LB(1:1) = lbound(SrcInitOutputData%LinNames_y) + UB(1:1) = ubound(SrcInitOutputData%LinNames_y) + if (.not. allocated(DstInitOutputData%LinNames_y)) then + allocate(DstInitOutputData%LinNames_y(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitOutputData%LinNames_x)) then + LB(1:1) = lbound(SrcInitOutputData%LinNames_x) + UB(1:1) = ubound(SrcInitOutputData%LinNames_x) + if (.not. allocated(DstInitOutputData%LinNames_x)) then + allocate(DstInitOutputData%LinNames_x(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitOutputData%LinNames_u)) then + LB(1:1) = lbound(SrcInitOutputData%LinNames_u) + UB(1:1) = ubound(SrcInitOutputData%LinNames_u) + if (.not. allocated(DstInitOutputData%LinNames_u)) then + allocate(DstInitOutputData%LinNames_u(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitOutputData%RotFrame_y)) then + LB(1:1) = lbound(SrcInitOutputData%RotFrame_y) + UB(1:1) = ubound(SrcInitOutputData%RotFrame_y) + if (.not. allocated(DstInitOutputData%RotFrame_y)) then + allocate(DstInitOutputData%RotFrame_y(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitOutputData%RotFrame_x)) then + LB(1:1) = lbound(SrcInitOutputData%RotFrame_x) + UB(1:1) = ubound(SrcInitOutputData%RotFrame_x) + if (.not. allocated(DstInitOutputData%RotFrame_x)) then + allocate(DstInitOutputData%RotFrame_x(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitOutputData%DerivOrder_x)) then + LB(1:1) = lbound(SrcInitOutputData%DerivOrder_x) + UB(1:1) = ubound(SrcInitOutputData%DerivOrder_x) + if (.not. allocated(DstInitOutputData%DerivOrder_x)) then + allocate(DstInitOutputData%DerivOrder_x(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitOutputData%RotFrame_u)) then + LB(1:1) = lbound(SrcInitOutputData%RotFrame_u) + UB(1:1) = ubound(SrcInitOutputData%RotFrame_u) + if (.not. allocated(DstInitOutputData%RotFrame_u)) then + allocate(DstInitOutputData%RotFrame_u(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitOutputData%IsLoad_u)) then + LB(1:1) = lbound(SrcInitOutputData%IsLoad_u) + UB(1:1) = ubound(SrcInitOutputData%IsLoad_u) + if (.not. allocated(DstInitOutputData%IsLoad_u)) then + allocate(DstInitOutputData%IsLoad_u(LB(1):UB(1)), 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 + end if + DstInitOutputData%GearBox_index = SrcInitOutputData%GearBox_index +end subroutine + +subroutine ED_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(ED_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ED_DestroyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InitOutputData%WriteOutputHdr)) then + deallocate(InitOutputData%WriteOutputHdr) + end if + if (allocated(InitOutputData%WriteOutputUnt)) then + deallocate(InitOutputData%WriteOutputUnt) + end if + call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(InitOutputData%BlPitch)) then + deallocate(InitOutputData%BlPitch) + end if + if (allocated(InitOutputData%BldRNodes)) then + deallocate(InitOutputData%BldRNodes) + end if + if (allocated(InitOutputData%TwrHNodes)) then + deallocate(InitOutputData%TwrHNodes) + end if + if (allocated(InitOutputData%LinNames_y)) then + deallocate(InitOutputData%LinNames_y) + end if + if (allocated(InitOutputData%LinNames_x)) then + deallocate(InitOutputData%LinNames_x) + end if + if (allocated(InitOutputData%LinNames_u)) then + deallocate(InitOutputData%LinNames_u) + end if + if (allocated(InitOutputData%RotFrame_y)) then + deallocate(InitOutputData%RotFrame_y) + end if + if (allocated(InitOutputData%RotFrame_x)) then + deallocate(InitOutputData%RotFrame_x) + end if + if (allocated(InitOutputData%DerivOrder_x)) then + deallocate(InitOutputData%DerivOrder_x) + end if + if (allocated(InitOutputData%RotFrame_u)) then + deallocate(InitOutputData%RotFrame_u) + end if + if (allocated(InitOutputData%IsLoad_u)) then + deallocate(InitOutputData%IsLoad_u) + end if +end subroutine + +subroutine ED_PackInitOutput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(ED_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ED_PackInitOutput' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%WriteOutputHdr) + call RegPackAlloc(RF, InData%WriteOutputUnt) + call NWTC_Library_PackProgDesc(RF, InData%Ver) + call RegPack(RF, InData%NumBl) + call RegPackAlloc(RF, InData%BlPitch) + call RegPack(RF, InData%BladeLength) + call RegPack(RF, InData%TowerFlexL) + call RegPack(RF, InData%TowerBaseHeight) + call RegPack(RF, InData%HubHt) + call RegPackAlloc(RF, InData%BldRNodes) + call RegPackAlloc(RF, InData%TwrHNodes) + call RegPack(RF, InData%PlatformPos) + call RegPack(RF, InData%TwrBaseRefPos) + call RegPack(RF, InData%TwrBaseTransDisp) + call RegPack(RF, InData%TwrBaseRefOrient) + call RegPack(RF, InData%TwrBaseOrient) + call RegPack(RF, InData%HubRad) + call RegPack(RF, InData%RotSpeed) + call RegPack(RF, InData%isFixed_GenDOF) + call RegPackAlloc(RF, InData%LinNames_y) + call RegPackAlloc(RF, InData%LinNames_x) + call RegPackAlloc(RF, InData%LinNames_u) + call RegPackAlloc(RF, InData%RotFrame_y) + call RegPackAlloc(RF, InData%RotFrame_x) + call RegPackAlloc(RF, InData%DerivOrder_x) + call RegPackAlloc(RF, InData%RotFrame_u) + call RegPackAlloc(RF, InData%IsLoad_u) + call RegPack(RF, InData%GearBox_index) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ED_UnPackInitOutput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(ED_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ED_UnPackInitOutput' + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%WriteOutputHdr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WriteOutputUnt); if (RegCheckErr(RF, RoutineName)) return + call NWTC_Library_UnpackProgDesc(RF, OutData%Ver) ! Ver + call RegUnpack(RF, OutData%NumBl); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BlPitch); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BladeLength); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TowerFlexL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TowerBaseHeight); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HubHt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BldRNodes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TwrHNodes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PlatformPos); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TwrBaseRefPos); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TwrBaseTransDisp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TwrBaseRefOrient); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TwrBaseOrient); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HubRad); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RotSpeed); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%isFixed_GenDOF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LinNames_y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LinNames_x); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LinNames_u); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%RotFrame_y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%RotFrame_x); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%DerivOrder_x); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%RotFrame_u); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%IsLoad_u); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GearBox_index); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ED_CopyBladeInputData(SrcBladeInputDataData, DstBladeInputDataData, CtrlCode, ErrStat, ErrMsg) + type(BladeInputData), intent(in) :: SrcBladeInputDataData + type(BladeInputData), intent(inout) :: DstBladeInputDataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'ED_CopyBladeInputData' + ErrStat = ErrID_None + ErrMsg = '' + DstBladeInputDataData%NBlInpSt = SrcBladeInputDataData%NBlInpSt + if (allocated(SrcBladeInputDataData%BlFract)) then + LB(1:1) = lbound(SrcBladeInputDataData%BlFract) + UB(1:1) = ubound(SrcBladeInputDataData%BlFract) + if (.not. allocated(DstBladeInputDataData%BlFract)) then + allocate(DstBladeInputDataData%BlFract(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladeInputDataData%BlFract.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladeInputDataData%BlFract = SrcBladeInputDataData%BlFract + end if + if (allocated(SrcBladeInputDataData%PitchAx)) then + LB(1:1) = lbound(SrcBladeInputDataData%PitchAx) + UB(1:1) = ubound(SrcBladeInputDataData%PitchAx) + if (.not. allocated(DstBladeInputDataData%PitchAx)) then + allocate(DstBladeInputDataData%PitchAx(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladeInputDataData%PitchAx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladeInputDataData%PitchAx = SrcBladeInputDataData%PitchAx + end if + if (allocated(SrcBladeInputDataData%StrcTwst)) then + LB(1:1) = lbound(SrcBladeInputDataData%StrcTwst) + UB(1:1) = ubound(SrcBladeInputDataData%StrcTwst) + if (.not. allocated(DstBladeInputDataData%StrcTwst)) then + allocate(DstBladeInputDataData%StrcTwst(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladeInputDataData%StrcTwst.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladeInputDataData%StrcTwst = SrcBladeInputDataData%StrcTwst + end if + if (allocated(SrcBladeInputDataData%BMassDen)) then + LB(1:1) = lbound(SrcBladeInputDataData%BMassDen) + UB(1:1) = ubound(SrcBladeInputDataData%BMassDen) + if (.not. allocated(DstBladeInputDataData%BMassDen)) then + allocate(DstBladeInputDataData%BMassDen(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladeInputDataData%BMassDen.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladeInputDataData%BMassDen = SrcBladeInputDataData%BMassDen + end if + if (allocated(SrcBladeInputDataData%FlpStff)) then + LB(1:1) = lbound(SrcBladeInputDataData%FlpStff) + UB(1:1) = ubound(SrcBladeInputDataData%FlpStff) + if (.not. allocated(DstBladeInputDataData%FlpStff)) then + allocate(DstBladeInputDataData%FlpStff(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladeInputDataData%FlpStff.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladeInputDataData%FlpStff = SrcBladeInputDataData%FlpStff + end if + if (allocated(SrcBladeInputDataData%EdgStff)) then + LB(1:1) = lbound(SrcBladeInputDataData%EdgStff) + UB(1:1) = ubound(SrcBladeInputDataData%EdgStff) + if (.not. allocated(DstBladeInputDataData%EdgStff)) then + allocate(DstBladeInputDataData%EdgStff(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladeInputDataData%EdgStff.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladeInputDataData%EdgStff = SrcBladeInputDataData%EdgStff + end if + DstBladeInputDataData%BldFlDmp = SrcBladeInputDataData%BldFlDmp + DstBladeInputDataData%BldEdDmp = SrcBladeInputDataData%BldEdDmp + DstBladeInputDataData%FlStTunr = SrcBladeInputDataData%FlStTunr + if (allocated(SrcBladeInputDataData%BldFl1Sh)) then + LB(1:1) = lbound(SrcBladeInputDataData%BldFl1Sh) + UB(1:1) = ubound(SrcBladeInputDataData%BldFl1Sh) + if (.not. allocated(DstBladeInputDataData%BldFl1Sh)) then + allocate(DstBladeInputDataData%BldFl1Sh(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladeInputDataData%BldFl1Sh.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladeInputDataData%BldFl1Sh = SrcBladeInputDataData%BldFl1Sh + end if + if (allocated(SrcBladeInputDataData%BldFl2Sh)) then + LB(1:1) = lbound(SrcBladeInputDataData%BldFl2Sh) + UB(1:1) = ubound(SrcBladeInputDataData%BldFl2Sh) + if (.not. allocated(DstBladeInputDataData%BldFl2Sh)) then + allocate(DstBladeInputDataData%BldFl2Sh(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladeInputDataData%BldFl2Sh.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladeInputDataData%BldFl2Sh = SrcBladeInputDataData%BldFl2Sh + end if + if (allocated(SrcBladeInputDataData%BldEdgSh)) then + LB(1:1) = lbound(SrcBladeInputDataData%BldEdgSh) + UB(1:1) = ubound(SrcBladeInputDataData%BldEdgSh) + if (.not. allocated(DstBladeInputDataData%BldEdgSh)) then + allocate(DstBladeInputDataData%BldEdgSh(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladeInputDataData%BldEdgSh.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladeInputDataData%BldEdgSh = SrcBladeInputDataData%BldEdgSh + end if +end subroutine + +subroutine ED_DestroyBladeInputData(BladeInputDataData, ErrStat, ErrMsg) + type(BladeInputData), intent(inout) :: BladeInputDataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'ED_DestroyBladeInputData' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(BladeInputDataData%BlFract)) then + deallocate(BladeInputDataData%BlFract) + end if + if (allocated(BladeInputDataData%PitchAx)) then + deallocate(BladeInputDataData%PitchAx) + end if + if (allocated(BladeInputDataData%StrcTwst)) then + deallocate(BladeInputDataData%StrcTwst) + end if + if (allocated(BladeInputDataData%BMassDen)) then + deallocate(BladeInputDataData%BMassDen) + end if + if (allocated(BladeInputDataData%FlpStff)) then + deallocate(BladeInputDataData%FlpStff) + end if + if (allocated(BladeInputDataData%EdgStff)) then + deallocate(BladeInputDataData%EdgStff) + end if + if (allocated(BladeInputDataData%BldFl1Sh)) then + deallocate(BladeInputDataData%BldFl1Sh) + end if + if (allocated(BladeInputDataData%BldFl2Sh)) then + deallocate(BladeInputDataData%BldFl2Sh) + end if + if (allocated(BladeInputDataData%BldEdgSh)) then + deallocate(BladeInputDataData%BldEdgSh) + end if +end subroutine + +subroutine ED_PackBladeInputData(RF, Indata) + type(RegFile), intent(inout) :: RF + type(BladeInputData), intent(in) :: InData + character(*), parameter :: RoutineName = 'ED_PackBladeInputData' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%NBlInpSt) + call RegPackAlloc(RF, InData%BlFract) + call RegPackAlloc(RF, InData%PitchAx) + call RegPackAlloc(RF, InData%StrcTwst) + call RegPackAlloc(RF, InData%BMassDen) + call RegPackAlloc(RF, InData%FlpStff) + call RegPackAlloc(RF, InData%EdgStff) + call RegPack(RF, InData%BldFlDmp) + call RegPack(RF, InData%BldEdDmp) + call RegPack(RF, InData%FlStTunr) + call RegPackAlloc(RF, InData%BldFl1Sh) + call RegPackAlloc(RF, InData%BldFl2Sh) + call RegPackAlloc(RF, InData%BldEdgSh) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ED_UnPackBladeInputData(RF, OutData) + type(RegFile), intent(inout) :: RF + type(BladeInputData), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ED_UnPackBladeInputData' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%NBlInpSt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BlFract); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PitchAx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%StrcTwst); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BMassDen); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%FlpStff); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%EdgStff); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BldFlDmp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BldEdDmp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FlStTunr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BldFl1Sh); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BldFl2Sh); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BldEdgSh); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ED_CopyBladeMeshInputData(SrcBladeMeshInputDataData, DstBladeMeshInputDataData, CtrlCode, ErrStat, ErrMsg) + type(ED_BladeMeshInputData), intent(in) :: SrcBladeMeshInputDataData + type(ED_BladeMeshInputData), intent(inout) :: DstBladeMeshInputDataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'ED_CopyBladeMeshInputData' + ErrStat = ErrID_None + ErrMsg = '' + DstBladeMeshInputDataData%BldNodes = SrcBladeMeshInputDataData%BldNodes + if (allocated(SrcBladeMeshInputDataData%RNodes)) then + LB(1:1) = lbound(SrcBladeMeshInputDataData%RNodes) + UB(1:1) = ubound(SrcBladeMeshInputDataData%RNodes) + if (.not. allocated(DstBladeMeshInputDataData%RNodes)) then + allocate(DstBladeMeshInputDataData%RNodes(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladeMeshInputDataData%RNodes.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladeMeshInputDataData%RNodes = SrcBladeMeshInputDataData%RNodes + end if + if (allocated(SrcBladeMeshInputDataData%AeroTwst)) then + LB(1:1) = lbound(SrcBladeMeshInputDataData%AeroTwst) + UB(1:1) = ubound(SrcBladeMeshInputDataData%AeroTwst) + if (.not. allocated(DstBladeMeshInputDataData%AeroTwst)) then + allocate(DstBladeMeshInputDataData%AeroTwst(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladeMeshInputDataData%AeroTwst.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladeMeshInputDataData%AeroTwst = SrcBladeMeshInputDataData%AeroTwst + end if + if (allocated(SrcBladeMeshInputDataData%Chord)) then + LB(1:1) = lbound(SrcBladeMeshInputDataData%Chord) + UB(1:1) = ubound(SrcBladeMeshInputDataData%Chord) + if (.not. allocated(DstBladeMeshInputDataData%Chord)) then + allocate(DstBladeMeshInputDataData%Chord(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladeMeshInputDataData%Chord.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladeMeshInputDataData%Chord = SrcBladeMeshInputDataData%Chord + end if +end subroutine + +subroutine ED_DestroyBladeMeshInputData(BladeMeshInputDataData, ErrStat, ErrMsg) + type(ED_BladeMeshInputData), intent(inout) :: BladeMeshInputDataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'ED_DestroyBladeMeshInputData' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(BladeMeshInputDataData%RNodes)) then + deallocate(BladeMeshInputDataData%RNodes) + end if + if (allocated(BladeMeshInputDataData%AeroTwst)) then + deallocate(BladeMeshInputDataData%AeroTwst) + end if + if (allocated(BladeMeshInputDataData%Chord)) then + deallocate(BladeMeshInputDataData%Chord) + end if +end subroutine + +subroutine ED_PackBladeMeshInputData(RF, Indata) + type(RegFile), intent(inout) :: RF + type(ED_BladeMeshInputData), intent(in) :: InData + character(*), parameter :: RoutineName = 'ED_PackBladeMeshInputData' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%BldNodes) + call RegPackAlloc(RF, InData%RNodes) + call RegPackAlloc(RF, InData%AeroTwst) + call RegPackAlloc(RF, InData%Chord) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ED_UnPackBladeMeshInputData(RF, OutData) + type(RegFile), intent(inout) :: RF + type(ED_BladeMeshInputData), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ED_UnPackBladeMeshInputData' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%BldNodes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%RNodes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AeroTwst); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Chord); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ED_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg) + type(ED_InputFile), intent(in) :: SrcInputFileData + type(ED_InputFile), intent(inout) :: DstInputFileData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ED_CopyInputFile' + ErrStat = ErrID_None + ErrMsg = '' + DstInputFileData%DT = SrcInputFileData%DT + DstInputFileData%FlapDOF1 = SrcInputFileData%FlapDOF1 + DstInputFileData%FlapDOF2 = SrcInputFileData%FlapDOF2 + DstInputFileData%EdgeDOF = SrcInputFileData%EdgeDOF + DstInputFileData%TeetDOF = SrcInputFileData%TeetDOF + DstInputFileData%DrTrDOF = SrcInputFileData%DrTrDOF + DstInputFileData%GenDOF = SrcInputFileData%GenDOF + DstInputFileData%YawDOF = SrcInputFileData%YawDOF + DstInputFileData%TwFADOF1 = SrcInputFileData%TwFADOF1 + DstInputFileData%TwFADOF2 = SrcInputFileData%TwFADOF2 + DstInputFileData%TwSSDOF1 = SrcInputFileData%TwSSDOF1 + DstInputFileData%TwSSDOF2 = SrcInputFileData%TwSSDOF2 + DstInputFileData%PtfmSgDOF = SrcInputFileData%PtfmSgDOF + DstInputFileData%PtfmSwDOF = SrcInputFileData%PtfmSwDOF + DstInputFileData%PtfmHvDOF = SrcInputFileData%PtfmHvDOF + DstInputFileData%PtfmRDOF = SrcInputFileData%PtfmRDOF + DstInputFileData%PtfmPDOF = SrcInputFileData%PtfmPDOF + DstInputFileData%PtfmYDOF = SrcInputFileData%PtfmYDOF + DstInputFileData%OoPDefl = SrcInputFileData%OoPDefl + DstInputFileData%IPDefl = SrcInputFileData%IPDefl + if (allocated(SrcInputFileData%BlPitch)) then + LB(1:1) = lbound(SrcInputFileData%BlPitch) + UB(1:1) = ubound(SrcInputFileData%BlPitch) + if (.not. allocated(DstInputFileData%BlPitch)) then + allocate(DstInputFileData%BlPitch(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%BlPitch.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%BlPitch = SrcInputFileData%BlPitch + end if + DstInputFileData%TeetDefl = SrcInputFileData%TeetDefl + DstInputFileData%Azimuth = SrcInputFileData%Azimuth + DstInputFileData%RotSpeed = SrcInputFileData%RotSpeed + DstInputFileData%NacYaw = SrcInputFileData%NacYaw + DstInputFileData%TTDspFA = SrcInputFileData%TTDspFA + DstInputFileData%TTDspSS = SrcInputFileData%TTDspSS + DstInputFileData%PtfmSurge = SrcInputFileData%PtfmSurge + DstInputFileData%PtfmSway = SrcInputFileData%PtfmSway + DstInputFileData%PtfmHeave = SrcInputFileData%PtfmHeave + DstInputFileData%PtfmRoll = SrcInputFileData%PtfmRoll + DstInputFileData%PtfmPitch = SrcInputFileData%PtfmPitch + DstInputFileData%PtfmYaw = SrcInputFileData%PtfmYaw + DstInputFileData%NumBl = SrcInputFileData%NumBl + DstInputFileData%TipRad = SrcInputFileData%TipRad + DstInputFileData%HubRad = SrcInputFileData%HubRad + if (allocated(SrcInputFileData%PreCone)) then + LB(1:1) = lbound(SrcInputFileData%PreCone) + UB(1:1) = ubound(SrcInputFileData%PreCone) + if (.not. allocated(DstInputFileData%PreCone)) then + allocate(DstInputFileData%PreCone(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%PreCone.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%PreCone = SrcInputFileData%PreCone + end if + DstInputFileData%HubCM = SrcInputFileData%HubCM + DstInputFileData%UndSling = SrcInputFileData%UndSling + DstInputFileData%Delta3 = SrcInputFileData%Delta3 + DstInputFileData%AzimB1Up = SrcInputFileData%AzimB1Up + DstInputFileData%OverHang = SrcInputFileData%OverHang + DstInputFileData%ShftGagL = SrcInputFileData%ShftGagL + DstInputFileData%ShftTilt = SrcInputFileData%ShftTilt + DstInputFileData%NacCMxn = SrcInputFileData%NacCMxn + DstInputFileData%NacCMyn = SrcInputFileData%NacCMyn + DstInputFileData%NacCMzn = SrcInputFileData%NacCMzn + DstInputFileData%NcIMUxn = SrcInputFileData%NcIMUxn + DstInputFileData%NcIMUyn = SrcInputFileData%NcIMUyn + DstInputFileData%NcIMUzn = SrcInputFileData%NcIMUzn + DstInputFileData%Twr2Shft = SrcInputFileData%Twr2Shft + DstInputFileData%TowerHt = SrcInputFileData%TowerHt + DstInputFileData%TowerBsHt = SrcInputFileData%TowerBsHt + DstInputFileData%PtfmCMxt = SrcInputFileData%PtfmCMxt + DstInputFileData%PtfmCMyt = SrcInputFileData%PtfmCMyt + DstInputFileData%PtfmCMzt = SrcInputFileData%PtfmCMzt + DstInputFileData%PtfmRefzt = SrcInputFileData%PtfmRefzt + if (allocated(SrcInputFileData%TipMass)) then + LB(1:1) = lbound(SrcInputFileData%TipMass) + UB(1:1) = ubound(SrcInputFileData%TipMass) + if (.not. allocated(DstInputFileData%TipMass)) then + allocate(DstInputFileData%TipMass(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%TipMass.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%TipMass = SrcInputFileData%TipMass + end if + DstInputFileData%HubMass = SrcInputFileData%HubMass + DstInputFileData%HubIner = SrcInputFileData%HubIner + DstInputFileData%GenIner = SrcInputFileData%GenIner + DstInputFileData%NacMass = SrcInputFileData%NacMass + DstInputFileData%NacYIner = SrcInputFileData%NacYIner + DstInputFileData%YawBrMass = SrcInputFileData%YawBrMass + DstInputFileData%PtfmMass = SrcInputFileData%PtfmMass + DstInputFileData%PtfmRIner = SrcInputFileData%PtfmRIner + DstInputFileData%PtfmPIner = SrcInputFileData%PtfmPIner + DstInputFileData%PtfmYIner = SrcInputFileData%PtfmYIner + DstInputFileData%PtfmXYIner = SrcInputFileData%PtfmXYIner + DstInputFileData%PtfmYZIner = SrcInputFileData%PtfmYZIner + DstInputFileData%PtfmXZIner = SrcInputFileData%PtfmXZIner + DstInputFileData%BldNodes = SrcInputFileData%BldNodes + if (allocated(SrcInputFileData%InpBlMesh)) then + LB(1:1) = lbound(SrcInputFileData%InpBlMesh) + UB(1:1) = ubound(SrcInputFileData%InpBlMesh) + if (.not. allocated(DstInputFileData%InpBlMesh)) then + allocate(DstInputFileData%InpBlMesh(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%InpBlMesh.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call ED_CopyBladeMeshInputData(SrcInputFileData%InpBlMesh(i1), DstInputFileData%InpBlMesh(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcInputFileData%InpBl)) then + LB(1:1) = lbound(SrcInputFileData%InpBl) + UB(1:1) = ubound(SrcInputFileData%InpBl) + if (.not. allocated(DstInputFileData%InpBl)) then + allocate(DstInputFileData%InpBl(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%InpBl.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call ED_CopyBladeInputData(SrcInputFileData%InpBl(i1), DstInputFileData%InpBl(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + DstInputFileData%TeetMod = SrcInputFileData%TeetMod + DstInputFileData%TeetDmpP = SrcInputFileData%TeetDmpP + DstInputFileData%TeetDmp = SrcInputFileData%TeetDmp + DstInputFileData%TeetCDmp = SrcInputFileData%TeetCDmp + DstInputFileData%TeetSStP = SrcInputFileData%TeetSStP + DstInputFileData%TeetHStP = SrcInputFileData%TeetHStP + DstInputFileData%TeetSSSp = SrcInputFileData%TeetSSSp + DstInputFileData%TeetHSSp = SrcInputFileData%TeetHSSp + DstInputFileData%YawFrctMod = SrcInputFileData%YawFrctMod + DstInputFileData%M_CD = SrcInputFileData%M_CD + DstInputFileData%M_FCD = SrcInputFileData%M_FCD + DstInputFileData%M_MCD = SrcInputFileData%M_MCD + DstInputFileData%M_CSMAX = SrcInputFileData%M_CSMAX + DstInputFileData%M_FCSMAX = SrcInputFileData%M_FCSMAX + DstInputFileData%M_MCSMAX = SrcInputFileData%M_MCSMAX + DstInputFileData%sig_v = SrcInputFileData%sig_v + DstInputFileData%sig_v2 = SrcInputFileData%sig_v2 + DstInputFileData%OmgCut = SrcInputFileData%OmgCut + DstInputFileData%GBoxEff = SrcInputFileData%GBoxEff + DstInputFileData%GBRatio = SrcInputFileData%GBRatio + DstInputFileData%DTTorSpr = SrcInputFileData%DTTorSpr + DstInputFileData%DTTorDmp = SrcInputFileData%DTTorDmp + DstInputFileData%Furling = SrcInputFileData%Furling + DstInputFileData%TwrNodes = SrcInputFileData%TwrNodes + DstInputFileData%SumPrint = SrcInputFileData%SumPrint + DstInputFileData%OutFile = SrcInputFileData%OutFile + DstInputFileData%TabDelim = SrcInputFileData%TabDelim + DstInputFileData%OutFmt = SrcInputFileData%OutFmt + DstInputFileData%Tstart = SrcInputFileData%Tstart + DstInputFileData%DecFact = SrcInputFileData%DecFact + DstInputFileData%NTwGages = SrcInputFileData%NTwGages + DstInputFileData%TwrGagNd = SrcInputFileData%TwrGagNd + DstInputFileData%NBlGages = SrcInputFileData%NBlGages + DstInputFileData%BldGagNd = SrcInputFileData%BldGagNd + DstInputFileData%NumOuts = SrcInputFileData%NumOuts + if (allocated(SrcInputFileData%OutList)) then + LB(1:1) = lbound(SrcInputFileData%OutList) + UB(1:1) = ubound(SrcInputFileData%OutList) + if (.not. allocated(DstInputFileData%OutList)) then + allocate(DstInputFileData%OutList(LB(1):UB(1)), 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 + end if + DstInputFileData%NTwInpSt = SrcInputFileData%NTwInpSt + DstInputFileData%TwrFADmp = SrcInputFileData%TwrFADmp + DstInputFileData%TwrSSDmp = SrcInputFileData%TwrSSDmp + DstInputFileData%FAStTunr = SrcInputFileData%FAStTunr + DstInputFileData%SSStTunr = SrcInputFileData%SSStTunr + if (allocated(SrcInputFileData%HtFract)) then + LB(1:1) = lbound(SrcInputFileData%HtFract) + UB(1:1) = ubound(SrcInputFileData%HtFract) + if (.not. allocated(DstInputFileData%HtFract)) then + allocate(DstInputFileData%HtFract(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%HtFract.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%HtFract = SrcInputFileData%HtFract + end if + if (allocated(SrcInputFileData%TMassDen)) then + LB(1:1) = lbound(SrcInputFileData%TMassDen) + UB(1:1) = ubound(SrcInputFileData%TMassDen) + if (.not. allocated(DstInputFileData%TMassDen)) then + allocate(DstInputFileData%TMassDen(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%TMassDen.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%TMassDen = SrcInputFileData%TMassDen + end if + if (allocated(SrcInputFileData%TwFAStif)) then + LB(1:1) = lbound(SrcInputFileData%TwFAStif) + UB(1:1) = ubound(SrcInputFileData%TwFAStif) + if (.not. allocated(DstInputFileData%TwFAStif)) then + allocate(DstInputFileData%TwFAStif(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%TwFAStif.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%TwFAStif = SrcInputFileData%TwFAStif + end if + if (allocated(SrcInputFileData%TwSSStif)) then + LB(1:1) = lbound(SrcInputFileData%TwSSStif) + UB(1:1) = ubound(SrcInputFileData%TwSSStif) + if (.not. allocated(DstInputFileData%TwSSStif)) then + allocate(DstInputFileData%TwSSStif(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%TwSSStif.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%TwSSStif = SrcInputFileData%TwSSStif + end if + if (allocated(SrcInputFileData%TwFAM1Sh)) then + LB(1:1) = lbound(SrcInputFileData%TwFAM1Sh) + UB(1:1) = ubound(SrcInputFileData%TwFAM1Sh) + if (.not. allocated(DstInputFileData%TwFAM1Sh)) then + allocate(DstInputFileData%TwFAM1Sh(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%TwFAM1Sh.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%TwFAM1Sh = SrcInputFileData%TwFAM1Sh + end if + if (allocated(SrcInputFileData%TwFAM2Sh)) then + LB(1:1) = lbound(SrcInputFileData%TwFAM2Sh) + UB(1:1) = ubound(SrcInputFileData%TwFAM2Sh) + if (.not. allocated(DstInputFileData%TwFAM2Sh)) then + allocate(DstInputFileData%TwFAM2Sh(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%TwFAM2Sh.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%TwFAM2Sh = SrcInputFileData%TwFAM2Sh + end if + if (allocated(SrcInputFileData%TwSSM1Sh)) then + LB(1:1) = lbound(SrcInputFileData%TwSSM1Sh) + UB(1:1) = ubound(SrcInputFileData%TwSSM1Sh) + if (.not. allocated(DstInputFileData%TwSSM1Sh)) then + allocate(DstInputFileData%TwSSM1Sh(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%TwSSM1Sh.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%TwSSM1Sh = SrcInputFileData%TwSSM1Sh + end if + if (allocated(SrcInputFileData%TwSSM2Sh)) then + LB(1:1) = lbound(SrcInputFileData%TwSSM2Sh) + UB(1:1) = ubound(SrcInputFileData%TwSSM2Sh) + if (.not. allocated(DstInputFileData%TwSSM2Sh)) then + allocate(DstInputFileData%TwSSM2Sh(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%TwSSM2Sh.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%TwSSM2Sh = SrcInputFileData%TwSSM2Sh + end if + DstInputFileData%RFrlDOF = SrcInputFileData%RFrlDOF + DstInputFileData%TFrlDOF = SrcInputFileData%TFrlDOF + DstInputFileData%RotFurl = SrcInputFileData%RotFurl + DstInputFileData%TailFurl = SrcInputFileData%TailFurl + DstInputFileData%Yaw2Shft = SrcInputFileData%Yaw2Shft + DstInputFileData%ShftSkew = SrcInputFileData%ShftSkew + DstInputFileData%RFrlCM_n = SrcInputFileData%RFrlCM_n + DstInputFileData%BoomCM_n = SrcInputFileData%BoomCM_n + DstInputFileData%TFinCM_n = SrcInputFileData%TFinCM_n + DstInputFileData%RFrlPnt_n = SrcInputFileData%RFrlPnt_n + DstInputFileData%RFrlSkew = SrcInputFileData%RFrlSkew + DstInputFileData%RFrlTilt = SrcInputFileData%RFrlTilt + DstInputFileData%TFrlPnt_n = SrcInputFileData%TFrlPnt_n + DstInputFileData%TFrlSkew = SrcInputFileData%TFrlSkew + DstInputFileData%TFrlTilt = SrcInputFileData%TFrlTilt + DstInputFileData%RFrlMass = SrcInputFileData%RFrlMass + DstInputFileData%BoomMass = SrcInputFileData%BoomMass + DstInputFileData%TFinMass = SrcInputFileData%TFinMass + DstInputFileData%RFrlIner = SrcInputFileData%RFrlIner + DstInputFileData%TFrlIner = SrcInputFileData%TFrlIner + DstInputFileData%RFrlMod = SrcInputFileData%RFrlMod + DstInputFileData%RFrlSpr = SrcInputFileData%RFrlSpr + DstInputFileData%RFrlDmp = SrcInputFileData%RFrlDmp + DstInputFileData%RFrlUSSP = SrcInputFileData%RFrlUSSP + DstInputFileData%RFrlDSSP = SrcInputFileData%RFrlDSSP + DstInputFileData%RFrlUSSpr = SrcInputFileData%RFrlUSSpr + DstInputFileData%RFrlDSSpr = SrcInputFileData%RFrlDSSpr + DstInputFileData%RFrlUSDP = SrcInputFileData%RFrlUSDP + DstInputFileData%RFrlDSDP = SrcInputFileData%RFrlDSDP + DstInputFileData%RFrlUSDmp = SrcInputFileData%RFrlUSDmp + DstInputFileData%RFrlDSDmp = SrcInputFileData%RFrlDSDmp + DstInputFileData%TFrlMod = SrcInputFileData%TFrlMod + DstInputFileData%TFrlSpr = SrcInputFileData%TFrlSpr + DstInputFileData%TFrlDmp = SrcInputFileData%TFrlDmp + DstInputFileData%TFrlUSSP = SrcInputFileData%TFrlUSSP + DstInputFileData%TFrlDSSP = SrcInputFileData%TFrlDSSP + DstInputFileData%TFrlUSSpr = SrcInputFileData%TFrlUSSpr + DstInputFileData%TFrlDSSpr = SrcInputFileData%TFrlDSSpr + DstInputFileData%TFrlUSDP = SrcInputFileData%TFrlUSDP + DstInputFileData%TFrlDSDP = SrcInputFileData%TFrlDSDP + DstInputFileData%TFrlUSDmp = SrcInputFileData%TFrlUSDmp + DstInputFileData%TFrlDSDmp = SrcInputFileData%TFrlDSDmp + DstInputFileData%method = SrcInputFileData%method + DstInputFileData%BldNd_NumOuts = SrcInputFileData%BldNd_NumOuts + if (allocated(SrcInputFileData%BldNd_OutList)) then + LB(1:1) = lbound(SrcInputFileData%BldNd_OutList) + UB(1:1) = ubound(SrcInputFileData%BldNd_OutList) + if (.not. allocated(DstInputFileData%BldNd_OutList)) then + allocate(DstInputFileData%BldNd_OutList(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%BldNd_OutList.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%BldNd_OutList = SrcInputFileData%BldNd_OutList + end if + DstInputFileData%BldNd_BlOutNd_Str = SrcInputFileData%BldNd_BlOutNd_Str + DstInputFileData%BldNd_BladesOut = SrcInputFileData%BldNd_BladesOut +end subroutine + +subroutine ED_DestroyInputFile(InputFileData, ErrStat, ErrMsg) + type(ED_InputFile), intent(inout) :: InputFileData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ED_DestroyInputFile' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InputFileData%BlPitch)) then + deallocate(InputFileData%BlPitch) + end if + if (allocated(InputFileData%PreCone)) then + deallocate(InputFileData%PreCone) + end if + if (allocated(InputFileData%TipMass)) then + deallocate(InputFileData%TipMass) + end if + if (allocated(InputFileData%InpBlMesh)) then + LB(1:1) = lbound(InputFileData%InpBlMesh) + UB(1:1) = ubound(InputFileData%InpBlMesh) + do i1 = LB(1), UB(1) + call ED_DestroyBladeMeshInputData(InputFileData%InpBlMesh(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InputFileData%InpBlMesh) + end if + if (allocated(InputFileData%InpBl)) then + LB(1:1) = lbound(InputFileData%InpBl) + UB(1:1) = ubound(InputFileData%InpBl) + do i1 = LB(1), UB(1) + call ED_DestroyBladeInputData(InputFileData%InpBl(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InputFileData%InpBl) + end if + if (allocated(InputFileData%OutList)) then + deallocate(InputFileData%OutList) + end if + if (allocated(InputFileData%HtFract)) then + deallocate(InputFileData%HtFract) + end if + if (allocated(InputFileData%TMassDen)) then + deallocate(InputFileData%TMassDen) + end if + if (allocated(InputFileData%TwFAStif)) then + deallocate(InputFileData%TwFAStif) + end if + if (allocated(InputFileData%TwSSStif)) then + deallocate(InputFileData%TwSSStif) + end if + if (allocated(InputFileData%TwFAM1Sh)) then + deallocate(InputFileData%TwFAM1Sh) + end if + if (allocated(InputFileData%TwFAM2Sh)) then + deallocate(InputFileData%TwFAM2Sh) + end if + if (allocated(InputFileData%TwSSM1Sh)) then + deallocate(InputFileData%TwSSM1Sh) + end if + if (allocated(InputFileData%TwSSM2Sh)) then + deallocate(InputFileData%TwSSM2Sh) + end if + if (allocated(InputFileData%BldNd_OutList)) then + deallocate(InputFileData%BldNd_OutList) + end if +end subroutine + +subroutine ED_PackInputFile(RF, Indata) + type(RegFile), intent(inout) :: RF + type(ED_InputFile), intent(in) :: InData + character(*), parameter :: RoutineName = 'ED_PackInputFile' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DT) + call RegPack(RF, InData%FlapDOF1) + call RegPack(RF, InData%FlapDOF2) + call RegPack(RF, InData%EdgeDOF) + call RegPack(RF, InData%TeetDOF) + call RegPack(RF, InData%DrTrDOF) + call RegPack(RF, InData%GenDOF) + call RegPack(RF, InData%YawDOF) + call RegPack(RF, InData%TwFADOF1) + call RegPack(RF, InData%TwFADOF2) + call RegPack(RF, InData%TwSSDOF1) + call RegPack(RF, InData%TwSSDOF2) + call RegPack(RF, InData%PtfmSgDOF) + call RegPack(RF, InData%PtfmSwDOF) + call RegPack(RF, InData%PtfmHvDOF) + call RegPack(RF, InData%PtfmRDOF) + call RegPack(RF, InData%PtfmPDOF) + call RegPack(RF, InData%PtfmYDOF) + call RegPack(RF, InData%OoPDefl) + call RegPack(RF, InData%IPDefl) + call RegPackAlloc(RF, InData%BlPitch) + call RegPack(RF, InData%TeetDefl) + call RegPack(RF, InData%Azimuth) + call RegPack(RF, InData%RotSpeed) + call RegPack(RF, InData%NacYaw) + call RegPack(RF, InData%TTDspFA) + call RegPack(RF, InData%TTDspSS) + call RegPack(RF, InData%PtfmSurge) + call RegPack(RF, InData%PtfmSway) + call RegPack(RF, InData%PtfmHeave) + call RegPack(RF, InData%PtfmRoll) + call RegPack(RF, InData%PtfmPitch) + call RegPack(RF, InData%PtfmYaw) + call RegPack(RF, InData%NumBl) + call RegPack(RF, InData%TipRad) + call RegPack(RF, InData%HubRad) + call RegPackAlloc(RF, InData%PreCone) + call RegPack(RF, InData%HubCM) + call RegPack(RF, InData%UndSling) + call RegPack(RF, InData%Delta3) + call RegPack(RF, InData%AzimB1Up) + call RegPack(RF, InData%OverHang) + call RegPack(RF, InData%ShftGagL) + call RegPack(RF, InData%ShftTilt) + call RegPack(RF, InData%NacCMxn) + call RegPack(RF, InData%NacCMyn) + call RegPack(RF, InData%NacCMzn) + call RegPack(RF, InData%NcIMUxn) + call RegPack(RF, InData%NcIMUyn) + call RegPack(RF, InData%NcIMUzn) + call RegPack(RF, InData%Twr2Shft) + call RegPack(RF, InData%TowerHt) + call RegPack(RF, InData%TowerBsHt) + call RegPack(RF, InData%PtfmCMxt) + call RegPack(RF, InData%PtfmCMyt) + call RegPack(RF, InData%PtfmCMzt) + call RegPack(RF, InData%PtfmRefzt) + call RegPackAlloc(RF, InData%TipMass) + call RegPack(RF, InData%HubMass) + call RegPack(RF, InData%HubIner) + call RegPack(RF, InData%GenIner) + call RegPack(RF, InData%NacMass) + call RegPack(RF, InData%NacYIner) + call RegPack(RF, InData%YawBrMass) + call RegPack(RF, InData%PtfmMass) + call RegPack(RF, InData%PtfmRIner) + call RegPack(RF, InData%PtfmPIner) + call RegPack(RF, InData%PtfmYIner) + call RegPack(RF, InData%PtfmXYIner) + call RegPack(RF, InData%PtfmYZIner) + call RegPack(RF, InData%PtfmXZIner) + call RegPack(RF, InData%BldNodes) + call RegPack(RF, allocated(InData%InpBlMesh)) + if (allocated(InData%InpBlMesh)) then + call RegPackBounds(RF, 1, lbound(InData%InpBlMesh), ubound(InData%InpBlMesh)) + LB(1:1) = lbound(InData%InpBlMesh) + UB(1:1) = ubound(InData%InpBlMesh) + do i1 = LB(1), UB(1) + call ED_PackBladeMeshInputData(RF, InData%InpBlMesh(i1)) + end do + end if + call RegPack(RF, allocated(InData%InpBl)) + if (allocated(InData%InpBl)) then + call RegPackBounds(RF, 1, lbound(InData%InpBl), ubound(InData%InpBl)) + LB(1:1) = lbound(InData%InpBl) + UB(1:1) = ubound(InData%InpBl) + do i1 = LB(1), UB(1) + call ED_PackBladeInputData(RF, InData%InpBl(i1)) + end do + end if + call RegPack(RF, InData%TeetMod) + call RegPack(RF, InData%TeetDmpP) + call RegPack(RF, InData%TeetDmp) + call RegPack(RF, InData%TeetCDmp) + call RegPack(RF, InData%TeetSStP) + call RegPack(RF, InData%TeetHStP) + call RegPack(RF, InData%TeetSSSp) + call RegPack(RF, InData%TeetHSSp) + call RegPack(RF, InData%YawFrctMod) + call RegPack(RF, InData%M_CD) + call RegPack(RF, InData%M_FCD) + call RegPack(RF, InData%M_MCD) + call RegPack(RF, InData%M_CSMAX) + call RegPack(RF, InData%M_FCSMAX) + call RegPack(RF, InData%M_MCSMAX) + call RegPack(RF, InData%sig_v) + call RegPack(RF, InData%sig_v2) + call RegPack(RF, InData%OmgCut) + call RegPack(RF, InData%GBoxEff) + call RegPack(RF, InData%GBRatio) + call RegPack(RF, InData%DTTorSpr) + call RegPack(RF, InData%DTTorDmp) + call RegPack(RF, InData%Furling) + call RegPack(RF, InData%TwrNodes) + call RegPack(RF, InData%SumPrint) + call RegPack(RF, InData%OutFile) + call RegPack(RF, InData%TabDelim) + call RegPack(RF, InData%OutFmt) + call RegPack(RF, InData%Tstart) + call RegPack(RF, InData%DecFact) + call RegPack(RF, InData%NTwGages) + call RegPack(RF, InData%TwrGagNd) + call RegPack(RF, InData%NBlGages) + call RegPack(RF, InData%BldGagNd) + call RegPack(RF, InData%NumOuts) + call RegPackAlloc(RF, InData%OutList) + call RegPack(RF, InData%NTwInpSt) + call RegPack(RF, InData%TwrFADmp) + call RegPack(RF, InData%TwrSSDmp) + call RegPack(RF, InData%FAStTunr) + call RegPack(RF, InData%SSStTunr) + call RegPackAlloc(RF, InData%HtFract) + call RegPackAlloc(RF, InData%TMassDen) + call RegPackAlloc(RF, InData%TwFAStif) + call RegPackAlloc(RF, InData%TwSSStif) + call RegPackAlloc(RF, InData%TwFAM1Sh) + call RegPackAlloc(RF, InData%TwFAM2Sh) + call RegPackAlloc(RF, InData%TwSSM1Sh) + call RegPackAlloc(RF, InData%TwSSM2Sh) + call RegPack(RF, InData%RFrlDOF) + call RegPack(RF, InData%TFrlDOF) + call RegPack(RF, InData%RotFurl) + call RegPack(RF, InData%TailFurl) + call RegPack(RF, InData%Yaw2Shft) + call RegPack(RF, InData%ShftSkew) + call RegPack(RF, InData%RFrlCM_n) + call RegPack(RF, InData%BoomCM_n) + call RegPack(RF, InData%TFinCM_n) + call RegPack(RF, InData%RFrlPnt_n) + call RegPack(RF, InData%RFrlSkew) + call RegPack(RF, InData%RFrlTilt) + call RegPack(RF, InData%TFrlPnt_n) + call RegPack(RF, InData%TFrlSkew) + call RegPack(RF, InData%TFrlTilt) + call RegPack(RF, InData%RFrlMass) + call RegPack(RF, InData%BoomMass) + call RegPack(RF, InData%TFinMass) + call RegPack(RF, InData%RFrlIner) + call RegPack(RF, InData%TFrlIner) + call RegPack(RF, InData%RFrlMod) + call RegPack(RF, InData%RFrlSpr) + call RegPack(RF, InData%RFrlDmp) + call RegPack(RF, InData%RFrlUSSP) + call RegPack(RF, InData%RFrlDSSP) + call RegPack(RF, InData%RFrlUSSpr) + call RegPack(RF, InData%RFrlDSSpr) + call RegPack(RF, InData%RFrlUSDP) + call RegPack(RF, InData%RFrlDSDP) + call RegPack(RF, InData%RFrlUSDmp) + call RegPack(RF, InData%RFrlDSDmp) + call RegPack(RF, InData%TFrlMod) + call RegPack(RF, InData%TFrlSpr) + call RegPack(RF, InData%TFrlDmp) + call RegPack(RF, InData%TFrlUSSP) + call RegPack(RF, InData%TFrlDSSP) + call RegPack(RF, InData%TFrlUSSpr) + call RegPack(RF, InData%TFrlDSSpr) + call RegPack(RF, InData%TFrlUSDP) + call RegPack(RF, InData%TFrlDSDP) + call RegPack(RF, InData%TFrlUSDmp) + call RegPack(RF, InData%TFrlDSDmp) + call RegPack(RF, InData%method) + call RegPack(RF, InData%BldNd_NumOuts) + call RegPackAlloc(RF, InData%BldNd_OutList) + call RegPack(RF, InData%BldNd_BlOutNd_Str) + call RegPack(RF, InData%BldNd_BladesOut) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ED_UnPackInputFile(RF, OutData) + type(RegFile), intent(inout) :: RF + type(ED_InputFile), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ED_UnPackInputFile' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FlapDOF1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FlapDOF2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%EdgeDOF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TeetDOF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DrTrDOF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GenDOF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawDOF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TwFADOF1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TwFADOF2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TwSSDOF1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TwSSDOF2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PtfmSgDOF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PtfmSwDOF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PtfmHvDOF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PtfmRDOF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PtfmPDOF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PtfmYDOF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OoPDefl); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%IPDefl); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BlPitch); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TeetDefl); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Azimuth); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RotSpeed); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NacYaw); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TTDspFA); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TTDspSS); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PtfmSurge); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PtfmSway); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PtfmHeave); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PtfmRoll); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PtfmPitch); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PtfmYaw); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumBl); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TipRad); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HubRad); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PreCone); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HubCM); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UndSling); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Delta3); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AzimB1Up); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OverHang); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ShftGagL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ShftTilt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NacCMxn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NacCMyn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NacCMzn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NcIMUxn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NcIMUyn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NcIMUzn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Twr2Shft); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TowerHt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TowerBsHt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PtfmCMxt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PtfmCMyt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PtfmCMzt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PtfmRefzt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TipMass); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HubMass); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HubIner); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GenIner); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NacMass); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NacYIner); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawBrMass); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PtfmMass); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PtfmRIner); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PtfmPIner); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PtfmYIner); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PtfmXYIner); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PtfmYZIner); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PtfmXZIner); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BldNodes); if (RegCheckErr(RF, RoutineName)) return + if (allocated(OutData%InpBlMesh)) deallocate(OutData%InpBlMesh) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%InpBlMesh(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InpBlMesh.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call ED_UnpackBladeMeshInputData(RF, OutData%InpBlMesh(i1)) ! InpBlMesh + end do + end if + if (allocated(OutData%InpBl)) deallocate(OutData%InpBl) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%InpBl(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InpBl.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call ED_UnpackBladeInputData(RF, OutData%InpBl(i1)) ! InpBl + end do + end if + call RegUnpack(RF, OutData%TeetMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TeetDmpP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TeetDmp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TeetCDmp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TeetSStP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TeetHStP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TeetSSSp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TeetHSSp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawFrctMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%M_CD); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%M_FCD); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%M_MCD); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%M_CSMAX); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%M_FCSMAX); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%M_MCSMAX); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%sig_v); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%sig_v2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OmgCut); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GBoxEff); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GBRatio); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DTTorSpr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DTTorDmp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Furling); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TwrNodes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SumPrint); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TabDelim); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutFmt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Tstart); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DecFact); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NTwGages); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TwrGagNd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NBlGages); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BldGagNd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumOuts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%OutList); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NTwInpSt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TwrFADmp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TwrSSDmp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FAStTunr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SSStTunr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%HtFract); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TMassDen); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TwFAStif); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TwSSStif); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TwFAM1Sh); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TwFAM2Sh); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TwSSM1Sh); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TwSSM2Sh); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RFrlDOF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFrlDOF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RotFurl); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TailFurl); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Yaw2Shft); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ShftSkew); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RFrlCM_n); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BoomCM_n); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFinCM_n); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RFrlPnt_n); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RFrlSkew); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RFrlTilt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFrlPnt_n); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFrlSkew); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFrlTilt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RFrlMass); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BoomMass); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFinMass); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RFrlIner); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFrlIner); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RFrlMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RFrlSpr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RFrlDmp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RFrlUSSP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RFrlDSSP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RFrlUSSpr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RFrlDSSpr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RFrlUSDP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RFrlDSDP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RFrlUSDmp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RFrlDSDmp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFrlMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFrlSpr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFrlDmp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFrlUSSP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFrlDSSP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFrlUSSpr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFrlDSSpr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFrlUSDP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFrlDSDP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFrlUSDmp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFrlDSDmp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%method); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BldNd_NumOuts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BldNd_OutList); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BldNd_BlOutNd_Str); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BldNd_BladesOut); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ED_CopyCoordSys(SrcCoordSysData, DstCoordSysData, CtrlCode, ErrStat, ErrMsg) + type(ED_CoordSys), intent(in) :: SrcCoordSysData + type(ED_CoordSys), intent(inout) :: DstCoordSysData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'ED_CopyCoordSys' + ErrStat = ErrID_None + ErrMsg = '' + DstCoordSysData%alpha1 = SrcCoordSysData%alpha1 + DstCoordSysData%alpha2 = SrcCoordSysData%alpha2 + DstCoordSysData%alpha3 = SrcCoordSysData%alpha3 + DstCoordSysData%beta1 = SrcCoordSysData%beta1 + DstCoordSysData%beta2 = SrcCoordSysData%beta2 + DstCoordSysData%beta3 = SrcCoordSysData%beta3 + DstCoordSysData%a1 = SrcCoordSysData%a1 + DstCoordSysData%a2 = SrcCoordSysData%a2 + DstCoordSysData%a3 = SrcCoordSysData%a3 + DstCoordSysData%b1 = SrcCoordSysData%b1 + DstCoordSysData%b2 = SrcCoordSysData%b2 + DstCoordSysData%b3 = SrcCoordSysData%b3 + DstCoordSysData%c1 = SrcCoordSysData%c1 + DstCoordSysData%c2 = SrcCoordSysData%c2 + DstCoordSysData%c3 = SrcCoordSysData%c3 + DstCoordSysData%d1 = SrcCoordSysData%d1 + DstCoordSysData%d2 = SrcCoordSysData%d2 + DstCoordSysData%d3 = SrcCoordSysData%d3 + DstCoordSysData%e1 = SrcCoordSysData%e1 + DstCoordSysData%e2 = SrcCoordSysData%e2 + DstCoordSysData%e3 = SrcCoordSysData%e3 + DstCoordSysData%f1 = SrcCoordSysData%f1 + DstCoordSysData%f2 = SrcCoordSysData%f2 + DstCoordSysData%f3 = SrcCoordSysData%f3 + DstCoordSysData%g1 = SrcCoordSysData%g1 + DstCoordSysData%g2 = SrcCoordSysData%g2 + DstCoordSysData%g3 = SrcCoordSysData%g3 + if (allocated(SrcCoordSysData%i1)) then + LB(1:2) = lbound(SrcCoordSysData%i1) + UB(1:2) = ubound(SrcCoordSysData%i1) + if (.not. allocated(DstCoordSysData%i1)) then + allocate(DstCoordSysData%i1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstCoordSysData%i1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstCoordSysData%i1 = SrcCoordSysData%i1 + end if + if (allocated(SrcCoordSysData%i2)) then + LB(1:2) = lbound(SrcCoordSysData%i2) + UB(1:2) = ubound(SrcCoordSysData%i2) + if (.not. allocated(DstCoordSysData%i2)) then + allocate(DstCoordSysData%i2(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstCoordSysData%i2.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstCoordSysData%i2 = SrcCoordSysData%i2 + end if + if (allocated(SrcCoordSysData%i3)) then + LB(1:2) = lbound(SrcCoordSysData%i3) + UB(1:2) = ubound(SrcCoordSysData%i3) + if (.not. allocated(DstCoordSysData%i3)) then + allocate(DstCoordSysData%i3(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstCoordSysData%i3.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstCoordSysData%i3 = SrcCoordSysData%i3 + end if + if (allocated(SrcCoordSysData%j1)) then + LB(1:2) = lbound(SrcCoordSysData%j1) + UB(1:2) = ubound(SrcCoordSysData%j1) + if (.not. allocated(DstCoordSysData%j1)) then + allocate(DstCoordSysData%j1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstCoordSysData%j1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstCoordSysData%j1 = SrcCoordSysData%j1 + end if + if (allocated(SrcCoordSysData%j2)) then + LB(1:2) = lbound(SrcCoordSysData%j2) + UB(1:2) = ubound(SrcCoordSysData%j2) + if (.not. allocated(DstCoordSysData%j2)) then + allocate(DstCoordSysData%j2(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstCoordSysData%j2.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstCoordSysData%j2 = SrcCoordSysData%j2 + end if + if (allocated(SrcCoordSysData%j3)) then + LB(1:2) = lbound(SrcCoordSysData%j3) + UB(1:2) = ubound(SrcCoordSysData%j3) + if (.not. allocated(DstCoordSysData%j3)) then + allocate(DstCoordSysData%j3(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstCoordSysData%j3.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstCoordSysData%j3 = SrcCoordSysData%j3 + end if + if (allocated(SrcCoordSysData%m1)) then + LB(1:3) = lbound(SrcCoordSysData%m1) + UB(1:3) = ubound(SrcCoordSysData%m1) + if (.not. allocated(DstCoordSysData%m1)) then + allocate(DstCoordSysData%m1(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstCoordSysData%m1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstCoordSysData%m1 = SrcCoordSysData%m1 + end if + if (allocated(SrcCoordSysData%m2)) then + LB(1:3) = lbound(SrcCoordSysData%m2) + UB(1:3) = ubound(SrcCoordSysData%m2) + if (.not. allocated(DstCoordSysData%m2)) then + allocate(DstCoordSysData%m2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstCoordSysData%m2.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstCoordSysData%m2 = SrcCoordSysData%m2 + end if + if (allocated(SrcCoordSysData%m3)) then + LB(1:3) = lbound(SrcCoordSysData%m3) + UB(1:3) = ubound(SrcCoordSysData%m3) + if (.not. allocated(DstCoordSysData%m3)) then + allocate(DstCoordSysData%m3(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstCoordSysData%m3.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstCoordSysData%m3 = SrcCoordSysData%m3 + end if + if (allocated(SrcCoordSysData%n1)) then + LB(1:3) = lbound(SrcCoordSysData%n1) + UB(1:3) = ubound(SrcCoordSysData%n1) + if (.not. allocated(DstCoordSysData%n1)) then + allocate(DstCoordSysData%n1(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstCoordSysData%n1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstCoordSysData%n1 = SrcCoordSysData%n1 + end if + if (allocated(SrcCoordSysData%n2)) then + LB(1:3) = lbound(SrcCoordSysData%n2) + UB(1:3) = ubound(SrcCoordSysData%n2) + if (.not. allocated(DstCoordSysData%n2)) then + allocate(DstCoordSysData%n2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstCoordSysData%n2.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstCoordSysData%n2 = SrcCoordSysData%n2 + end if + if (allocated(SrcCoordSysData%n3)) then + LB(1:3) = lbound(SrcCoordSysData%n3) + UB(1:3) = ubound(SrcCoordSysData%n3) + if (.not. allocated(DstCoordSysData%n3)) then + allocate(DstCoordSysData%n3(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstCoordSysData%n3.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstCoordSysData%n3 = SrcCoordSysData%n3 + end if + DstCoordSysData%rf1 = SrcCoordSysData%rf1 + DstCoordSysData%rf2 = SrcCoordSysData%rf2 + DstCoordSysData%rf3 = SrcCoordSysData%rf3 + DstCoordSysData%rfa = SrcCoordSysData%rfa + if (allocated(SrcCoordSysData%t1)) then + LB(1:2) = lbound(SrcCoordSysData%t1) + UB(1:2) = ubound(SrcCoordSysData%t1) + if (.not. allocated(DstCoordSysData%t1)) then + allocate(DstCoordSysData%t1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstCoordSysData%t1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstCoordSysData%t1 = SrcCoordSysData%t1 + end if + if (allocated(SrcCoordSysData%t2)) then + LB(1:2) = lbound(SrcCoordSysData%t2) + UB(1:2) = ubound(SrcCoordSysData%t2) + if (.not. allocated(DstCoordSysData%t2)) then + allocate(DstCoordSysData%t2(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstCoordSysData%t2.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstCoordSysData%t2 = SrcCoordSysData%t2 + end if + if (allocated(SrcCoordSysData%t3)) then + LB(1:2) = lbound(SrcCoordSysData%t3) + UB(1:2) = ubound(SrcCoordSysData%t3) + if (.not. allocated(DstCoordSysData%t3)) then + allocate(DstCoordSysData%t3(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstCoordSysData%t3.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstCoordSysData%t3 = SrcCoordSysData%t3 + end if + if (allocated(SrcCoordSysData%te1)) then + LB(1:3) = lbound(SrcCoordSysData%te1) + UB(1:3) = ubound(SrcCoordSysData%te1) + if (.not. allocated(DstCoordSysData%te1)) then + allocate(DstCoordSysData%te1(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstCoordSysData%te1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstCoordSysData%te1 = SrcCoordSysData%te1 + end if + if (allocated(SrcCoordSysData%te2)) then + LB(1:3) = lbound(SrcCoordSysData%te2) + UB(1:3) = ubound(SrcCoordSysData%te2) + if (.not. allocated(DstCoordSysData%te2)) then + allocate(DstCoordSysData%te2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstCoordSysData%te2.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstCoordSysData%te2 = SrcCoordSysData%te2 + end if + if (allocated(SrcCoordSysData%te3)) then + LB(1:3) = lbound(SrcCoordSysData%te3) + UB(1:3) = ubound(SrcCoordSysData%te3) + if (.not. allocated(DstCoordSysData%te3)) then + allocate(DstCoordSysData%te3(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstCoordSysData%te3.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstCoordSysData%te3 = SrcCoordSysData%te3 + end if + DstCoordSysData%tf1 = SrcCoordSysData%tf1 + DstCoordSysData%tf2 = SrcCoordSysData%tf2 + DstCoordSysData%tf3 = SrcCoordSysData%tf3 + DstCoordSysData%tfa = SrcCoordSysData%tfa + DstCoordSysData%z1 = SrcCoordSysData%z1 + DstCoordSysData%z2 = SrcCoordSysData%z2 + DstCoordSysData%z3 = SrcCoordSysData%z3 +end subroutine + +subroutine ED_DestroyCoordSys(CoordSysData, ErrStat, ErrMsg) + type(ED_CoordSys), intent(inout) :: CoordSysData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'ED_DestroyCoordSys' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(CoordSysData%i1)) then + deallocate(CoordSysData%i1) + end if + if (allocated(CoordSysData%i2)) then + deallocate(CoordSysData%i2) + end if + if (allocated(CoordSysData%i3)) then + deallocate(CoordSysData%i3) + end if + if (allocated(CoordSysData%j1)) then + deallocate(CoordSysData%j1) + end if + if (allocated(CoordSysData%j2)) then + deallocate(CoordSysData%j2) + end if + if (allocated(CoordSysData%j3)) then + deallocate(CoordSysData%j3) + end if + if (allocated(CoordSysData%m1)) then + deallocate(CoordSysData%m1) + end if + if (allocated(CoordSysData%m2)) then + deallocate(CoordSysData%m2) + end if + if (allocated(CoordSysData%m3)) then + deallocate(CoordSysData%m3) + end if + if (allocated(CoordSysData%n1)) then + deallocate(CoordSysData%n1) + end if + if (allocated(CoordSysData%n2)) then + deallocate(CoordSysData%n2) + end if + if (allocated(CoordSysData%n3)) then + deallocate(CoordSysData%n3) + end if + if (allocated(CoordSysData%t1)) then + deallocate(CoordSysData%t1) + end if + if (allocated(CoordSysData%t2)) then + deallocate(CoordSysData%t2) + end if + if (allocated(CoordSysData%t3)) then + deallocate(CoordSysData%t3) + end if + if (allocated(CoordSysData%te1)) then + deallocate(CoordSysData%te1) + end if + if (allocated(CoordSysData%te2)) then + deallocate(CoordSysData%te2) + end if + if (allocated(CoordSysData%te3)) then + deallocate(CoordSysData%te3) + end if +end subroutine + +subroutine ED_PackCoordSys(RF, Indata) + type(RegFile), intent(inout) :: RF + type(ED_CoordSys), intent(in) :: InData + character(*), parameter :: RoutineName = 'ED_PackCoordSys' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%alpha1) + call RegPack(RF, InData%alpha2) + call RegPack(RF, InData%alpha3) + call RegPack(RF, InData%beta1) + call RegPack(RF, InData%beta2) + call RegPack(RF, InData%beta3) + call RegPack(RF, InData%a1) + call RegPack(RF, InData%a2) + call RegPack(RF, InData%a3) + call RegPack(RF, InData%b1) + call RegPack(RF, InData%b2) + call RegPack(RF, InData%b3) + call RegPack(RF, InData%c1) + call RegPack(RF, InData%c2) + call RegPack(RF, InData%c3) + call RegPack(RF, InData%d1) + call RegPack(RF, InData%d2) + call RegPack(RF, InData%d3) + call RegPack(RF, InData%e1) + call RegPack(RF, InData%e2) + call RegPack(RF, InData%e3) + call RegPack(RF, InData%f1) + call RegPack(RF, InData%f2) + call RegPack(RF, InData%f3) + call RegPack(RF, InData%g1) + call RegPack(RF, InData%g2) + call RegPack(RF, InData%g3) + call RegPackAlloc(RF, InData%i1) + call RegPackAlloc(RF, InData%i2) + call RegPackAlloc(RF, InData%i3) + call RegPackAlloc(RF, InData%j1) + call RegPackAlloc(RF, InData%j2) + call RegPackAlloc(RF, InData%j3) + call RegPackAlloc(RF, InData%m1) + call RegPackAlloc(RF, InData%m2) + call RegPackAlloc(RF, InData%m3) + call RegPackAlloc(RF, InData%n1) + call RegPackAlloc(RF, InData%n2) + call RegPackAlloc(RF, InData%n3) + call RegPack(RF, InData%rf1) + call RegPack(RF, InData%rf2) + call RegPack(RF, InData%rf3) + call RegPack(RF, InData%rfa) + call RegPackAlloc(RF, InData%t1) + call RegPackAlloc(RF, InData%t2) + call RegPackAlloc(RF, InData%t3) + call RegPackAlloc(RF, InData%te1) + call RegPackAlloc(RF, InData%te2) + call RegPackAlloc(RF, InData%te3) + call RegPack(RF, InData%tf1) + call RegPack(RF, InData%tf2) + call RegPack(RF, InData%tf3) + call RegPack(RF, InData%tfa) + call RegPack(RF, InData%z1) + call RegPack(RF, InData%z2) + call RegPack(RF, InData%z3) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ED_UnPackCoordSys(RF, OutData) + type(RegFile), intent(inout) :: RF + type(ED_CoordSys), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ED_UnPackCoordSys' + integer(B4Ki) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%alpha1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%alpha2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%alpha3); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%beta1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%beta2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%beta3); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%a1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%a2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%a3); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%b1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%b2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%b3); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%c1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%c2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%c3); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%d1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%d2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%d3); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%e1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%e2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%e3); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%f1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%f2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%f3); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%g1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%g2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%g3); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%i1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%i2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%i3); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%j1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%j2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%j3); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%m1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%m2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%m3); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%n1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%n2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%n3); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rf1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rf2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rf3); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rfa); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%t1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%t2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%t3); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%te1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%te2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%te3); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%tf1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%tf2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%tf3); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%tfa); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%z1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%z2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%z3); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ED_CopyActiveDOFs(SrcActiveDOFsData, DstActiveDOFsData, CtrlCode, ErrStat, ErrMsg) + type(ED_ActiveDOFs), intent(in) :: SrcActiveDOFsData + type(ED_ActiveDOFs), intent(inout) :: DstActiveDOFsData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'ED_CopyActiveDOFs' + ErrStat = ErrID_None + ErrMsg = '' + DstActiveDOFsData%NActvDOF = SrcActiveDOFsData%NActvDOF + DstActiveDOFsData%NPCE = SrcActiveDOFsData%NPCE + DstActiveDOFsData%NPDE = SrcActiveDOFsData%NPDE + DstActiveDOFsData%NPIE = SrcActiveDOFsData%NPIE + DstActiveDOFsData%NPTE = SrcActiveDOFsData%NPTE + DstActiveDOFsData%NPTTE = SrcActiveDOFsData%NPTTE + if (allocated(SrcActiveDOFsData%NPSBE)) then + LB(1:1) = lbound(SrcActiveDOFsData%NPSBE) + UB(1:1) = ubound(SrcActiveDOFsData%NPSBE) + if (.not. allocated(DstActiveDOFsData%NPSBE)) then + allocate(DstActiveDOFsData%NPSBE(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstActiveDOFsData%NPSBE.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstActiveDOFsData%NPSBE = SrcActiveDOFsData%NPSBE + end if + if (allocated(SrcActiveDOFsData%NPSE)) then + LB(1:1) = lbound(SrcActiveDOFsData%NPSE) + UB(1:1) = ubound(SrcActiveDOFsData%NPSE) + if (.not. allocated(DstActiveDOFsData%NPSE)) then + allocate(DstActiveDOFsData%NPSE(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstActiveDOFsData%NPSE.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstActiveDOFsData%NPSE = SrcActiveDOFsData%NPSE + end if + DstActiveDOFsData%NPUE = SrcActiveDOFsData%NPUE + DstActiveDOFsData%NPYE = SrcActiveDOFsData%NPYE + if (allocated(SrcActiveDOFsData%PCE)) then + LB(1:1) = lbound(SrcActiveDOFsData%PCE) + UB(1:1) = ubound(SrcActiveDOFsData%PCE) + if (.not. allocated(DstActiveDOFsData%PCE)) then + allocate(DstActiveDOFsData%PCE(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstActiveDOFsData%PCE.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstActiveDOFsData%PCE = SrcActiveDOFsData%PCE + end if + if (allocated(SrcActiveDOFsData%PDE)) then + LB(1:1) = lbound(SrcActiveDOFsData%PDE) + UB(1:1) = ubound(SrcActiveDOFsData%PDE) + if (.not. allocated(DstActiveDOFsData%PDE)) then + allocate(DstActiveDOFsData%PDE(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstActiveDOFsData%PDE.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstActiveDOFsData%PDE = SrcActiveDOFsData%PDE + end if + if (allocated(SrcActiveDOFsData%PIE)) then + LB(1:1) = lbound(SrcActiveDOFsData%PIE) + UB(1:1) = ubound(SrcActiveDOFsData%PIE) + if (.not. allocated(DstActiveDOFsData%PIE)) then + allocate(DstActiveDOFsData%PIE(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstActiveDOFsData%PIE.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstActiveDOFsData%PIE = SrcActiveDOFsData%PIE + end if + if (allocated(SrcActiveDOFsData%PTE)) then + LB(1:1) = lbound(SrcActiveDOFsData%PTE) + UB(1:1) = ubound(SrcActiveDOFsData%PTE) + if (.not. allocated(DstActiveDOFsData%PTE)) then + allocate(DstActiveDOFsData%PTE(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstActiveDOFsData%PTE.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstActiveDOFsData%PTE = SrcActiveDOFsData%PTE + end if + if (allocated(SrcActiveDOFsData%PTTE)) then + LB(1:1) = lbound(SrcActiveDOFsData%PTTE) + UB(1:1) = ubound(SrcActiveDOFsData%PTTE) + if (.not. allocated(DstActiveDOFsData%PTTE)) then + allocate(DstActiveDOFsData%PTTE(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstActiveDOFsData%PTTE.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstActiveDOFsData%PTTE = SrcActiveDOFsData%PTTE + end if + if (allocated(SrcActiveDOFsData%PS)) then + LB(1:1) = lbound(SrcActiveDOFsData%PS) + UB(1:1) = ubound(SrcActiveDOFsData%PS) + if (.not. allocated(DstActiveDOFsData%PS)) then + allocate(DstActiveDOFsData%PS(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstActiveDOFsData%PS.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstActiveDOFsData%PS = SrcActiveDOFsData%PS + end if + if (allocated(SrcActiveDOFsData%PSBE)) then + LB(1:2) = lbound(SrcActiveDOFsData%PSBE) + UB(1:2) = ubound(SrcActiveDOFsData%PSBE) + if (.not. allocated(DstActiveDOFsData%PSBE)) then + allocate(DstActiveDOFsData%PSBE(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstActiveDOFsData%PSBE.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstActiveDOFsData%PSBE = SrcActiveDOFsData%PSBE + end if + if (allocated(SrcActiveDOFsData%PSE)) then + LB(1:2) = lbound(SrcActiveDOFsData%PSE) + UB(1:2) = ubound(SrcActiveDOFsData%PSE) + if (.not. allocated(DstActiveDOFsData%PSE)) then + allocate(DstActiveDOFsData%PSE(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstActiveDOFsData%PSE.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstActiveDOFsData%PSE = SrcActiveDOFsData%PSE + end if + if (allocated(SrcActiveDOFsData%PUE)) then + LB(1:1) = lbound(SrcActiveDOFsData%PUE) + UB(1:1) = ubound(SrcActiveDOFsData%PUE) + if (.not. allocated(DstActiveDOFsData%PUE)) then + allocate(DstActiveDOFsData%PUE(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstActiveDOFsData%PUE.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstActiveDOFsData%PUE = SrcActiveDOFsData%PUE + end if + if (allocated(SrcActiveDOFsData%PYE)) then + LB(1:1) = lbound(SrcActiveDOFsData%PYE) + UB(1:1) = ubound(SrcActiveDOFsData%PYE) + if (.not. allocated(DstActiveDOFsData%PYE)) then + allocate(DstActiveDOFsData%PYE(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstActiveDOFsData%PYE.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstActiveDOFsData%PYE = SrcActiveDOFsData%PYE + end if + if (allocated(SrcActiveDOFsData%SrtPS)) then + LB(1:1) = lbound(SrcActiveDOFsData%SrtPS) + UB(1:1) = ubound(SrcActiveDOFsData%SrtPS) + if (.not. allocated(DstActiveDOFsData%SrtPS)) then + allocate(DstActiveDOFsData%SrtPS(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstActiveDOFsData%SrtPS.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstActiveDOFsData%SrtPS = SrcActiveDOFsData%SrtPS + end if + if (allocated(SrcActiveDOFsData%SrtPSNAUG)) then + LB(1:1) = lbound(SrcActiveDOFsData%SrtPSNAUG) + UB(1:1) = ubound(SrcActiveDOFsData%SrtPSNAUG) + if (.not. allocated(DstActiveDOFsData%SrtPSNAUG)) then + allocate(DstActiveDOFsData%SrtPSNAUG(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstActiveDOFsData%SrtPSNAUG.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstActiveDOFsData%SrtPSNAUG = SrcActiveDOFsData%SrtPSNAUG + end if + if (allocated(SrcActiveDOFsData%Diag)) then + LB(1:1) = lbound(SrcActiveDOFsData%Diag) + UB(1:1) = ubound(SrcActiveDOFsData%Diag) + if (.not. allocated(DstActiveDOFsData%Diag)) then + allocate(DstActiveDOFsData%Diag(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstActiveDOFsData%Diag.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstActiveDOFsData%Diag = SrcActiveDOFsData%Diag + end if +end subroutine + +subroutine ED_DestroyActiveDOFs(ActiveDOFsData, ErrStat, ErrMsg) + type(ED_ActiveDOFs), intent(inout) :: ActiveDOFsData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'ED_DestroyActiveDOFs' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ActiveDOFsData%NPSBE)) then + deallocate(ActiveDOFsData%NPSBE) + end if + if (allocated(ActiveDOFsData%NPSE)) then + deallocate(ActiveDOFsData%NPSE) + end if + if (allocated(ActiveDOFsData%PCE)) then + deallocate(ActiveDOFsData%PCE) + end if + if (allocated(ActiveDOFsData%PDE)) then + deallocate(ActiveDOFsData%PDE) + end if + if (allocated(ActiveDOFsData%PIE)) then + deallocate(ActiveDOFsData%PIE) + end if + if (allocated(ActiveDOFsData%PTE)) then + deallocate(ActiveDOFsData%PTE) + end if + if (allocated(ActiveDOFsData%PTTE)) then + deallocate(ActiveDOFsData%PTTE) + end if + if (allocated(ActiveDOFsData%PS)) then + deallocate(ActiveDOFsData%PS) + end if + if (allocated(ActiveDOFsData%PSBE)) then + deallocate(ActiveDOFsData%PSBE) + end if + if (allocated(ActiveDOFsData%PSE)) then + deallocate(ActiveDOFsData%PSE) + end if + if (allocated(ActiveDOFsData%PUE)) then + deallocate(ActiveDOFsData%PUE) + end if + if (allocated(ActiveDOFsData%PYE)) then + deallocate(ActiveDOFsData%PYE) + end if + if (allocated(ActiveDOFsData%SrtPS)) then + deallocate(ActiveDOFsData%SrtPS) + end if + if (allocated(ActiveDOFsData%SrtPSNAUG)) then + deallocate(ActiveDOFsData%SrtPSNAUG) + end if + if (allocated(ActiveDOFsData%Diag)) then + deallocate(ActiveDOFsData%Diag) + end if +end subroutine + +subroutine ED_PackActiveDOFs(RF, Indata) + type(RegFile), intent(inout) :: RF + type(ED_ActiveDOFs), intent(in) :: InData + character(*), parameter :: RoutineName = 'ED_PackActiveDOFs' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%NActvDOF) + call RegPack(RF, InData%NPCE) + call RegPack(RF, InData%NPDE) + call RegPack(RF, InData%NPIE) + call RegPack(RF, InData%NPTE) + call RegPack(RF, InData%NPTTE) + call RegPackAlloc(RF, InData%NPSBE) + call RegPackAlloc(RF, InData%NPSE) + call RegPack(RF, InData%NPUE) + call RegPack(RF, InData%NPYE) + call RegPackAlloc(RF, InData%PCE) + call RegPackAlloc(RF, InData%PDE) + call RegPackAlloc(RF, InData%PIE) + call RegPackAlloc(RF, InData%PTE) + call RegPackAlloc(RF, InData%PTTE) + call RegPackAlloc(RF, InData%PS) + call RegPackAlloc(RF, InData%PSBE) + call RegPackAlloc(RF, InData%PSE) + call RegPackAlloc(RF, InData%PUE) + call RegPackAlloc(RF, InData%PYE) + call RegPackAlloc(RF, InData%SrtPS) + call RegPackAlloc(RF, InData%SrtPSNAUG) + call RegPackAlloc(RF, InData%Diag) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ED_UnPackActiveDOFs(RF, OutData) + type(RegFile), intent(inout) :: RF + type(ED_ActiveDOFs), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ED_UnPackActiveDOFs' + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%NActvDOF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NPCE); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NPDE); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NPIE); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NPTE); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NPTTE); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%NPSBE); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%NPSE); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NPUE); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NPYE); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PCE); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PDE); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PIE); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PTE); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PTTE); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PS); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PSBE); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PSE); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PUE); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PYE); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%SrtPS); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%SrtPSNAUG); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Diag); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrStat, ErrMsg) + type(ED_RtHndSide), intent(in) :: SrcRtHndSideData + type(ED_RtHndSide), intent(inout) :: DstRtHndSideData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(5), UB(5) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'ED_CopyRtHndSide' + ErrStat = ErrID_None + ErrMsg = '' + DstRtHndSideData%rO = SrcRtHndSideData%rO + if (allocated(SrcRtHndSideData%rQS)) then + LB(1:3) = lbound(SrcRtHndSideData%rQS) + UB(1:3) = ubound(SrcRtHndSideData%rQS) + if (.not. allocated(DstRtHndSideData%rQS)) then + allocate(DstRtHndSideData%rQS(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%rQS.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%rQS = SrcRtHndSideData%rQS + end if + if (allocated(SrcRtHndSideData%rS)) then + LB(1:3) = lbound(SrcRtHndSideData%rS) + UB(1:3) = ubound(SrcRtHndSideData%rS) + if (.not. allocated(DstRtHndSideData%rS)) then + allocate(DstRtHndSideData%rS(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%rS.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%rS = SrcRtHndSideData%rS + end if + if (allocated(SrcRtHndSideData%rS0S)) then + LB(1:3) = lbound(SrcRtHndSideData%rS0S) + UB(1:3) = ubound(SrcRtHndSideData%rS0S) + if (.not. allocated(DstRtHndSideData%rS0S)) then + allocate(DstRtHndSideData%rS0S(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%rS0S.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%rS0S = SrcRtHndSideData%rS0S + end if + if (allocated(SrcRtHndSideData%rT)) then + LB(1:2) = lbound(SrcRtHndSideData%rT) + UB(1:2) = ubound(SrcRtHndSideData%rT) + if (.not. allocated(DstRtHndSideData%rT)) then + allocate(DstRtHndSideData%rT(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%rT.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%rT = SrcRtHndSideData%rT + end if + DstRtHndSideData%rT0O = SrcRtHndSideData%rT0O + if (allocated(SrcRtHndSideData%rT0T)) then + LB(1:2) = lbound(SrcRtHndSideData%rT0T) + UB(1:2) = ubound(SrcRtHndSideData%rT0T) + if (.not. allocated(DstRtHndSideData%rT0T)) then + allocate(DstRtHndSideData%rT0T(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%rT0T.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%rT0T = SrcRtHndSideData%rT0T + end if + DstRtHndSideData%rZ = SrcRtHndSideData%rZ + DstRtHndSideData%rZO = SrcRtHndSideData%rZO + if (allocated(SrcRtHndSideData%rZT)) then + LB(1:2) = lbound(SrcRtHndSideData%rZT) + UB(1:2) = ubound(SrcRtHndSideData%rZT) + if (.not. allocated(DstRtHndSideData%rZT)) then + allocate(DstRtHndSideData%rZT(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%rZT.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%rZT = SrcRtHndSideData%rZT + end if + DstRtHndSideData%rPQ = SrcRtHndSideData%rPQ + DstRtHndSideData%rP = SrcRtHndSideData%rP + DstRtHndSideData%rV = SrcRtHndSideData%rV + DstRtHndSideData%rJ = SrcRtHndSideData%rJ + DstRtHndSideData%rZY = SrcRtHndSideData%rZY + DstRtHndSideData%rOU = SrcRtHndSideData%rOU + DstRtHndSideData%rOV = SrcRtHndSideData%rOV + DstRtHndSideData%rVD = SrcRtHndSideData%rVD + DstRtHndSideData%rOW = SrcRtHndSideData%rOW + DstRtHndSideData%rPC = SrcRtHndSideData%rPC + if (allocated(SrcRtHndSideData%rPS0)) then + LB(1:2) = lbound(SrcRtHndSideData%rPS0) + UB(1:2) = ubound(SrcRtHndSideData%rPS0) + if (.not. allocated(DstRtHndSideData%rPS0)) then + allocate(DstRtHndSideData%rPS0(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%rPS0.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%rPS0 = SrcRtHndSideData%rPS0 + end if + DstRtHndSideData%rQ = SrcRtHndSideData%rQ + DstRtHndSideData%rQC = SrcRtHndSideData%rQC + DstRtHndSideData%rVIMU = SrcRtHndSideData%rVIMU + DstRtHndSideData%rVP = SrcRtHndSideData%rVP + DstRtHndSideData%rWI = SrcRtHndSideData%rWI + DstRtHndSideData%rWJ = SrcRtHndSideData%rWJ + DstRtHndSideData%rZT0 = SrcRtHndSideData%rZT0 + if (allocated(SrcRtHndSideData%AngPosEF)) then + LB(1:2) = lbound(SrcRtHndSideData%AngPosEF) + UB(1:2) = ubound(SrcRtHndSideData%AngPosEF) + if (.not. allocated(DstRtHndSideData%AngPosEF)) then + allocate(DstRtHndSideData%AngPosEF(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%AngPosEF.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%AngPosEF = SrcRtHndSideData%AngPosEF + end if + if (allocated(SrcRtHndSideData%AngPosXF)) then + LB(1:2) = lbound(SrcRtHndSideData%AngPosXF) + UB(1:2) = ubound(SrcRtHndSideData%AngPosXF) + if (.not. allocated(DstRtHndSideData%AngPosXF)) then + allocate(DstRtHndSideData%AngPosXF(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%AngPosXF.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%AngPosXF = SrcRtHndSideData%AngPosXF + end if + if (allocated(SrcRtHndSideData%AngPosHM)) then + LB(1:3) = lbound(SrcRtHndSideData%AngPosHM) + UB(1:3) = ubound(SrcRtHndSideData%AngPosHM) + if (.not. allocated(DstRtHndSideData%AngPosHM)) then + allocate(DstRtHndSideData%AngPosHM(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%AngPosHM.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%AngPosHM = SrcRtHndSideData%AngPosHM + end if + DstRtHndSideData%AngPosXB = SrcRtHndSideData%AngPosXB + DstRtHndSideData%AngPosEX = SrcRtHndSideData%AngPosEX + if (allocated(SrcRtHndSideData%PAngVelEA)) then + LB(1:3) = lbound(SrcRtHndSideData%PAngVelEA) + UB(1:3) = ubound(SrcRtHndSideData%PAngVelEA) + if (.not. allocated(DstRtHndSideData%PAngVelEA)) then + allocate(DstRtHndSideData%PAngVelEA(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PAngVelEA.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PAngVelEA = SrcRtHndSideData%PAngVelEA + end if + if (allocated(SrcRtHndSideData%PAngVelEF)) then + LB(1:4) = lbound(SrcRtHndSideData%PAngVelEF) + UB(1:4) = ubound(SrcRtHndSideData%PAngVelEF) + if (.not. allocated(DstRtHndSideData%PAngVelEF)) then + allocate(DstRtHndSideData%PAngVelEF(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PAngVelEF.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PAngVelEF = SrcRtHndSideData%PAngVelEF + end if + if (allocated(SrcRtHndSideData%PAngVelEG)) then + LB(1:3) = lbound(SrcRtHndSideData%PAngVelEG) + UB(1:3) = ubound(SrcRtHndSideData%PAngVelEG) + if (.not. allocated(DstRtHndSideData%PAngVelEG)) then + allocate(DstRtHndSideData%PAngVelEG(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PAngVelEG.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PAngVelEG = SrcRtHndSideData%PAngVelEG + end if + if (allocated(SrcRtHndSideData%PAngVelEH)) then + LB(1:3) = lbound(SrcRtHndSideData%PAngVelEH) + UB(1:3) = ubound(SrcRtHndSideData%PAngVelEH) + if (.not. allocated(DstRtHndSideData%PAngVelEH)) then + allocate(DstRtHndSideData%PAngVelEH(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PAngVelEH.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PAngVelEH = SrcRtHndSideData%PAngVelEH + end if + if (allocated(SrcRtHndSideData%PAngVelEL)) then + LB(1:3) = lbound(SrcRtHndSideData%PAngVelEL) + UB(1:3) = ubound(SrcRtHndSideData%PAngVelEL) + if (.not. allocated(DstRtHndSideData%PAngVelEL)) then + allocate(DstRtHndSideData%PAngVelEL(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PAngVelEL.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PAngVelEL = SrcRtHndSideData%PAngVelEL + end if + if (allocated(SrcRtHndSideData%PAngVelEM)) then + LB(1:5) = lbound(SrcRtHndSideData%PAngVelEM) + UB(1:5) = ubound(SrcRtHndSideData%PAngVelEM) + if (.not. allocated(DstRtHndSideData%PAngVelEM)) then + allocate(DstRtHndSideData%PAngVelEM(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PAngVelEM.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PAngVelEM = SrcRtHndSideData%PAngVelEM + end if + if (allocated(SrcRtHndSideData%AngVelEM)) then + LB(1:3) = lbound(SrcRtHndSideData%AngVelEM) + UB(1:3) = ubound(SrcRtHndSideData%AngVelEM) + if (.not. allocated(DstRtHndSideData%AngVelEM)) then + allocate(DstRtHndSideData%AngVelEM(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%AngVelEM.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%AngVelEM = SrcRtHndSideData%AngVelEM + end if + if (allocated(SrcRtHndSideData%PAngVelEN)) then + LB(1:3) = lbound(SrcRtHndSideData%PAngVelEN) + UB(1:3) = ubound(SrcRtHndSideData%PAngVelEN) + if (.not. allocated(DstRtHndSideData%PAngVelEN)) then + allocate(DstRtHndSideData%PAngVelEN(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PAngVelEN.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PAngVelEN = SrcRtHndSideData%PAngVelEN + end if + DstRtHndSideData%AngVelEA = SrcRtHndSideData%AngVelEA + if (allocated(SrcRtHndSideData%PAngVelEB)) then + LB(1:3) = lbound(SrcRtHndSideData%PAngVelEB) + UB(1:3) = ubound(SrcRtHndSideData%PAngVelEB) + if (.not. allocated(DstRtHndSideData%PAngVelEB)) then + allocate(DstRtHndSideData%PAngVelEB(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PAngVelEB.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PAngVelEB = SrcRtHndSideData%PAngVelEB + end if + if (allocated(SrcRtHndSideData%PAngVelER)) then + LB(1:3) = lbound(SrcRtHndSideData%PAngVelER) + UB(1:3) = ubound(SrcRtHndSideData%PAngVelER) + if (.not. allocated(DstRtHndSideData%PAngVelER)) then + allocate(DstRtHndSideData%PAngVelER(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PAngVelER.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PAngVelER = SrcRtHndSideData%PAngVelER + end if + if (allocated(SrcRtHndSideData%PAngVelEX)) then + LB(1:3) = lbound(SrcRtHndSideData%PAngVelEX) + UB(1:3) = ubound(SrcRtHndSideData%PAngVelEX) + if (.not. allocated(DstRtHndSideData%PAngVelEX)) then + allocate(DstRtHndSideData%PAngVelEX(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PAngVelEX.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PAngVelEX = SrcRtHndSideData%PAngVelEX + end if + DstRtHndSideData%AngVelEG = SrcRtHndSideData%AngVelEG + DstRtHndSideData%AngVelEH = SrcRtHndSideData%AngVelEH + DstRtHndSideData%AngVelEL = SrcRtHndSideData%AngVelEL + DstRtHndSideData%AngVelEN = SrcRtHndSideData%AngVelEN + DstRtHndSideData%AngVelEB = SrcRtHndSideData%AngVelEB + DstRtHndSideData%AngVelER = SrcRtHndSideData%AngVelER + DstRtHndSideData%AngVelEX = SrcRtHndSideData%AngVelEX + DstRtHndSideData%TeetAngVel = SrcRtHndSideData%TeetAngVel + DstRtHndSideData%AngAccEBt = SrcRtHndSideData%AngAccEBt + DstRtHndSideData%AngAccERt = SrcRtHndSideData%AngAccERt + DstRtHndSideData%AngAccEXt = SrcRtHndSideData%AngAccEXt + if (allocated(SrcRtHndSideData%AngAccEFt)) then + LB(1:2) = lbound(SrcRtHndSideData%AngAccEFt) + UB(1:2) = ubound(SrcRtHndSideData%AngAccEFt) + if (.not. allocated(DstRtHndSideData%AngAccEFt)) then + allocate(DstRtHndSideData%AngAccEFt(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%AngAccEFt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%AngAccEFt = SrcRtHndSideData%AngAccEFt + end if + if (allocated(SrcRtHndSideData%AngVelEF)) then + LB(1:2) = lbound(SrcRtHndSideData%AngVelEF) + UB(1:2) = ubound(SrcRtHndSideData%AngVelEF) + if (.not. allocated(DstRtHndSideData%AngVelEF)) then + allocate(DstRtHndSideData%AngVelEF(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%AngVelEF.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%AngVelEF = SrcRtHndSideData%AngVelEF + end if + if (allocated(SrcRtHndSideData%AngVelHM)) then + LB(1:3) = lbound(SrcRtHndSideData%AngVelHM) + UB(1:3) = ubound(SrcRtHndSideData%AngVelHM) + if (.not. allocated(DstRtHndSideData%AngVelHM)) then + allocate(DstRtHndSideData%AngVelHM(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%AngVelHM.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%AngVelHM = SrcRtHndSideData%AngVelHM + end if + DstRtHndSideData%AngAccEAt = SrcRtHndSideData%AngAccEAt + DstRtHndSideData%AngAccEGt = SrcRtHndSideData%AngAccEGt + DstRtHndSideData%AngAccEHt = SrcRtHndSideData%AngAccEHt + if (allocated(SrcRtHndSideData%AngAccEKt)) then + LB(1:3) = lbound(SrcRtHndSideData%AngAccEKt) + UB(1:3) = ubound(SrcRtHndSideData%AngAccEKt) + if (.not. allocated(DstRtHndSideData%AngAccEKt)) then + allocate(DstRtHndSideData%AngAccEKt(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%AngAccEKt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%AngAccEKt = SrcRtHndSideData%AngAccEKt + end if + DstRtHndSideData%AngAccENt = SrcRtHndSideData%AngAccENt + DstRtHndSideData%LinAccECt = SrcRtHndSideData%LinAccECt + DstRtHndSideData%LinAccEDt = SrcRtHndSideData%LinAccEDt + DstRtHndSideData%LinAccEIt = SrcRtHndSideData%LinAccEIt + DstRtHndSideData%LinAccEJt = SrcRtHndSideData%LinAccEJt + DstRtHndSideData%LinAccEUt = SrcRtHndSideData%LinAccEUt + DstRtHndSideData%LinAccEYt = SrcRtHndSideData%LinAccEYt + if (allocated(SrcRtHndSideData%LinVelES)) then + LB(1:3) = lbound(SrcRtHndSideData%LinVelES) + UB(1:3) = ubound(SrcRtHndSideData%LinVelES) + if (.not. allocated(DstRtHndSideData%LinVelES)) then + allocate(DstRtHndSideData%LinVelES(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%LinVelES.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%LinVelES = SrcRtHndSideData%LinVelES + end if + DstRtHndSideData%LinVelEQ = SrcRtHndSideData%LinVelEQ + if (allocated(SrcRtHndSideData%LinVelET)) then + LB(1:2) = lbound(SrcRtHndSideData%LinVelET) + UB(1:2) = ubound(SrcRtHndSideData%LinVelET) + if (.not. allocated(DstRtHndSideData%LinVelET)) then + allocate(DstRtHndSideData%LinVelET(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%LinVelET.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%LinVelET = SrcRtHndSideData%LinVelET + end if + if (allocated(SrcRtHndSideData%LinVelESm2)) then + LB(1:1) = lbound(SrcRtHndSideData%LinVelESm2) + UB(1:1) = ubound(SrcRtHndSideData%LinVelESm2) + if (.not. allocated(DstRtHndSideData%LinVelESm2)) then + allocate(DstRtHndSideData%LinVelESm2(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%LinVelESm2.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%LinVelESm2 = SrcRtHndSideData%LinVelESm2 + end if + if (allocated(SrcRtHndSideData%PLinVelEIMU)) then + LB(1:3) = lbound(SrcRtHndSideData%PLinVelEIMU) + UB(1:3) = ubound(SrcRtHndSideData%PLinVelEIMU) + if (.not. allocated(DstRtHndSideData%PLinVelEIMU)) then + allocate(DstRtHndSideData%PLinVelEIMU(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PLinVelEIMU.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PLinVelEIMU = SrcRtHndSideData%PLinVelEIMU + end if + if (allocated(SrcRtHndSideData%PLinVelEO)) then + LB(1:3) = lbound(SrcRtHndSideData%PLinVelEO) + UB(1:3) = ubound(SrcRtHndSideData%PLinVelEO) + if (.not. allocated(DstRtHndSideData%PLinVelEO)) then + allocate(DstRtHndSideData%PLinVelEO(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PLinVelEO.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PLinVelEO = SrcRtHndSideData%PLinVelEO + end if + if (allocated(SrcRtHndSideData%PLinVelES)) then + LB(1:5) = lbound(SrcRtHndSideData%PLinVelES) + UB(1:5) = ubound(SrcRtHndSideData%PLinVelES) + if (.not. allocated(DstRtHndSideData%PLinVelES)) then + allocate(DstRtHndSideData%PLinVelES(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PLinVelES.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PLinVelES = SrcRtHndSideData%PLinVelES + end if + if (allocated(SrcRtHndSideData%PLinVelET)) then + LB(1:4) = lbound(SrcRtHndSideData%PLinVelET) + UB(1:4) = ubound(SrcRtHndSideData%PLinVelET) + if (.not. allocated(DstRtHndSideData%PLinVelET)) then + allocate(DstRtHndSideData%PLinVelET(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PLinVelET.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PLinVelET = SrcRtHndSideData%PLinVelET + end if + if (allocated(SrcRtHndSideData%PLinVelEZ)) then + LB(1:3) = lbound(SrcRtHndSideData%PLinVelEZ) + UB(1:3) = ubound(SrcRtHndSideData%PLinVelEZ) + if (.not. allocated(DstRtHndSideData%PLinVelEZ)) then + allocate(DstRtHndSideData%PLinVelEZ(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PLinVelEZ.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PLinVelEZ = SrcRtHndSideData%PLinVelEZ + end if + if (allocated(SrcRtHndSideData%PLinVelEC)) then + LB(1:3) = lbound(SrcRtHndSideData%PLinVelEC) + UB(1:3) = ubound(SrcRtHndSideData%PLinVelEC) + if (.not. allocated(DstRtHndSideData%PLinVelEC)) then + allocate(DstRtHndSideData%PLinVelEC(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PLinVelEC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PLinVelEC = SrcRtHndSideData%PLinVelEC + end if + if (allocated(SrcRtHndSideData%PLinVelED)) then + LB(1:3) = lbound(SrcRtHndSideData%PLinVelED) + UB(1:3) = ubound(SrcRtHndSideData%PLinVelED) + if (.not. allocated(DstRtHndSideData%PLinVelED)) then + allocate(DstRtHndSideData%PLinVelED(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PLinVelED.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PLinVelED = SrcRtHndSideData%PLinVelED + end if + if (allocated(SrcRtHndSideData%PLinVelEI)) then + LB(1:3) = lbound(SrcRtHndSideData%PLinVelEI) + UB(1:3) = ubound(SrcRtHndSideData%PLinVelEI) + if (.not. allocated(DstRtHndSideData%PLinVelEI)) then + allocate(DstRtHndSideData%PLinVelEI(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PLinVelEI.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PLinVelEI = SrcRtHndSideData%PLinVelEI + end if + if (allocated(SrcRtHndSideData%PLinVelEJ)) then + LB(1:3) = lbound(SrcRtHndSideData%PLinVelEJ) + UB(1:3) = ubound(SrcRtHndSideData%PLinVelEJ) + if (.not. allocated(DstRtHndSideData%PLinVelEJ)) then + allocate(DstRtHndSideData%PLinVelEJ(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PLinVelEJ.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PLinVelEJ = SrcRtHndSideData%PLinVelEJ + end if + if (allocated(SrcRtHndSideData%PLinVelEP)) then + LB(1:3) = lbound(SrcRtHndSideData%PLinVelEP) + UB(1:3) = ubound(SrcRtHndSideData%PLinVelEP) + if (.not. allocated(DstRtHndSideData%PLinVelEP)) then + allocate(DstRtHndSideData%PLinVelEP(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PLinVelEP.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PLinVelEP = SrcRtHndSideData%PLinVelEP + end if + if (allocated(SrcRtHndSideData%PLinVelEQ)) then + LB(1:3) = lbound(SrcRtHndSideData%PLinVelEQ) + UB(1:3) = ubound(SrcRtHndSideData%PLinVelEQ) + if (.not. allocated(DstRtHndSideData%PLinVelEQ)) then + allocate(DstRtHndSideData%PLinVelEQ(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PLinVelEQ.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PLinVelEQ = SrcRtHndSideData%PLinVelEQ + end if + if (allocated(SrcRtHndSideData%PLinVelEU)) then + LB(1:3) = lbound(SrcRtHndSideData%PLinVelEU) + UB(1:3) = ubound(SrcRtHndSideData%PLinVelEU) + if (.not. allocated(DstRtHndSideData%PLinVelEU)) then + allocate(DstRtHndSideData%PLinVelEU(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PLinVelEU.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PLinVelEU = SrcRtHndSideData%PLinVelEU + end if + if (allocated(SrcRtHndSideData%PLinVelEV)) then + LB(1:3) = lbound(SrcRtHndSideData%PLinVelEV) + UB(1:3) = ubound(SrcRtHndSideData%PLinVelEV) + if (.not. allocated(DstRtHndSideData%PLinVelEV)) then + allocate(DstRtHndSideData%PLinVelEV(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PLinVelEV.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PLinVelEV = SrcRtHndSideData%PLinVelEV + end if + if (allocated(SrcRtHndSideData%PLinVelEW)) then + LB(1:3) = lbound(SrcRtHndSideData%PLinVelEW) + UB(1:3) = ubound(SrcRtHndSideData%PLinVelEW) + if (.not. allocated(DstRtHndSideData%PLinVelEW)) then + allocate(DstRtHndSideData%PLinVelEW(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PLinVelEW.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PLinVelEW = SrcRtHndSideData%PLinVelEW + end if + if (allocated(SrcRtHndSideData%PLinVelEY)) then + LB(1:3) = lbound(SrcRtHndSideData%PLinVelEY) + UB(1:3) = ubound(SrcRtHndSideData%PLinVelEY) + if (.not. allocated(DstRtHndSideData%PLinVelEY)) then + allocate(DstRtHndSideData%PLinVelEY(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PLinVelEY.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PLinVelEY = SrcRtHndSideData%PLinVelEY + end if + DstRtHndSideData%LinAccEIMUt = SrcRtHndSideData%LinAccEIMUt + DstRtHndSideData%LinAccEOt = SrcRtHndSideData%LinAccEOt + if (allocated(SrcRtHndSideData%LinAccESt)) then + LB(1:3) = lbound(SrcRtHndSideData%LinAccESt) + UB(1:3) = ubound(SrcRtHndSideData%LinAccESt) + if (.not. allocated(DstRtHndSideData%LinAccESt)) then + allocate(DstRtHndSideData%LinAccESt(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%LinAccESt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%LinAccESt = SrcRtHndSideData%LinAccESt + end if + if (allocated(SrcRtHndSideData%LinAccETt)) then + LB(1:2) = lbound(SrcRtHndSideData%LinAccETt) + UB(1:2) = ubound(SrcRtHndSideData%LinAccETt) + if (.not. allocated(DstRtHndSideData%LinAccETt)) then + allocate(DstRtHndSideData%LinAccETt(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%LinAccETt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%LinAccETt = SrcRtHndSideData%LinAccETt + end if + DstRtHndSideData%LinAccEZt = SrcRtHndSideData%LinAccEZt + DstRtHndSideData%LinVelEIMU = SrcRtHndSideData%LinVelEIMU + DstRtHndSideData%LinVelEZ = SrcRtHndSideData%LinVelEZ + DstRtHndSideData%LinVelEO = SrcRtHndSideData%LinVelEO + DstRtHndSideData%LinVelEJ = SrcRtHndSideData%LinVelEJ + DstRtHndSideData%FrcONcRtt = SrcRtHndSideData%FrcONcRtt + DstRtHndSideData%FrcPRott = SrcRtHndSideData%FrcPRott + if (allocated(SrcRtHndSideData%FrcS0Bt)) then + LB(1:2) = lbound(SrcRtHndSideData%FrcS0Bt) + UB(1:2) = ubound(SrcRtHndSideData%FrcS0Bt) + if (.not. allocated(DstRtHndSideData%FrcS0Bt)) then + allocate(DstRtHndSideData%FrcS0Bt(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%FrcS0Bt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%FrcS0Bt = SrcRtHndSideData%FrcS0Bt + end if + DstRtHndSideData%FrcT0Trbt = SrcRtHndSideData%FrcT0Trbt + if (allocated(SrcRtHndSideData%FSAero)) then + LB(1:3) = lbound(SrcRtHndSideData%FSAero) + UB(1:3) = ubound(SrcRtHndSideData%FSAero) + if (.not. allocated(DstRtHndSideData%FSAero)) then + allocate(DstRtHndSideData%FSAero(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%FSAero.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%FSAero = SrcRtHndSideData%FSAero + end if + if (allocated(SrcRtHndSideData%FSTipDrag)) then + LB(1:2) = lbound(SrcRtHndSideData%FSTipDrag) + UB(1:2) = ubound(SrcRtHndSideData%FSTipDrag) + if (.not. allocated(DstRtHndSideData%FSTipDrag)) then + allocate(DstRtHndSideData%FSTipDrag(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%FSTipDrag.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%FSTipDrag = SrcRtHndSideData%FSTipDrag + end if + if (allocated(SrcRtHndSideData%FTHydrot)) then + LB(1:2) = lbound(SrcRtHndSideData%FTHydrot) + UB(1:2) = ubound(SrcRtHndSideData%FTHydrot) + if (.not. allocated(DstRtHndSideData%FTHydrot)) then + allocate(DstRtHndSideData%FTHydrot(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%FTHydrot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%FTHydrot = SrcRtHndSideData%FTHydrot + end if + DstRtHndSideData%FZHydrot = SrcRtHndSideData%FZHydrot + if (allocated(SrcRtHndSideData%MFHydrot)) then + LB(1:2) = lbound(SrcRtHndSideData%MFHydrot) + UB(1:2) = ubound(SrcRtHndSideData%MFHydrot) + if (.not. allocated(DstRtHndSideData%MFHydrot)) then + allocate(DstRtHndSideData%MFHydrot(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%MFHydrot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%MFHydrot = SrcRtHndSideData%MFHydrot + end if + DstRtHndSideData%MomBNcRtt = SrcRtHndSideData%MomBNcRtt + if (allocated(SrcRtHndSideData%MomH0Bt)) then + LB(1:2) = lbound(SrcRtHndSideData%MomH0Bt) + UB(1:2) = ubound(SrcRtHndSideData%MomH0Bt) + if (.not. allocated(DstRtHndSideData%MomH0Bt)) then + allocate(DstRtHndSideData%MomH0Bt(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%MomH0Bt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%MomH0Bt = SrcRtHndSideData%MomH0Bt + end if + DstRtHndSideData%MomLPRott = SrcRtHndSideData%MomLPRott + DstRtHndSideData%MomNGnRtt = SrcRtHndSideData%MomNGnRtt + DstRtHndSideData%MomNTailt = SrcRtHndSideData%MomNTailt + DstRtHndSideData%MomX0Trbt = SrcRtHndSideData%MomX0Trbt + if (allocated(SrcRtHndSideData%MMAero)) then + LB(1:3) = lbound(SrcRtHndSideData%MMAero) + UB(1:3) = ubound(SrcRtHndSideData%MMAero) + if (.not. allocated(DstRtHndSideData%MMAero)) then + allocate(DstRtHndSideData%MMAero(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%MMAero.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%MMAero = SrcRtHndSideData%MMAero + end if + DstRtHndSideData%MXHydrot = SrcRtHndSideData%MXHydrot + if (allocated(SrcRtHndSideData%PFrcONcRt)) then + LB(1:2) = lbound(SrcRtHndSideData%PFrcONcRt) + UB(1:2) = ubound(SrcRtHndSideData%PFrcONcRt) + if (.not. allocated(DstRtHndSideData%PFrcONcRt)) then + allocate(DstRtHndSideData%PFrcONcRt(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PFrcONcRt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PFrcONcRt = SrcRtHndSideData%PFrcONcRt + end if + if (allocated(SrcRtHndSideData%PFrcPRot)) then + LB(1:2) = lbound(SrcRtHndSideData%PFrcPRot) + UB(1:2) = ubound(SrcRtHndSideData%PFrcPRot) + if (.not. allocated(DstRtHndSideData%PFrcPRot)) then + allocate(DstRtHndSideData%PFrcPRot(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PFrcPRot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PFrcPRot = SrcRtHndSideData%PFrcPRot + end if + if (allocated(SrcRtHndSideData%PFrcS0B)) then + LB(1:3) = lbound(SrcRtHndSideData%PFrcS0B) + UB(1:3) = ubound(SrcRtHndSideData%PFrcS0B) + if (.not. allocated(DstRtHndSideData%PFrcS0B)) then + allocate(DstRtHndSideData%PFrcS0B(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PFrcS0B.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PFrcS0B = SrcRtHndSideData%PFrcS0B + end if + if (allocated(SrcRtHndSideData%PFrcT0Trb)) then + LB(1:2) = lbound(SrcRtHndSideData%PFrcT0Trb) + UB(1:2) = ubound(SrcRtHndSideData%PFrcT0Trb) + if (.not. allocated(DstRtHndSideData%PFrcT0Trb)) then + allocate(DstRtHndSideData%PFrcT0Trb(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PFrcT0Trb.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PFrcT0Trb = SrcRtHndSideData%PFrcT0Trb + end if + if (allocated(SrcRtHndSideData%PFTHydro)) then + LB(1:3) = lbound(SrcRtHndSideData%PFTHydro) + UB(1:3) = ubound(SrcRtHndSideData%PFTHydro) + if (.not. allocated(DstRtHndSideData%PFTHydro)) then + allocate(DstRtHndSideData%PFTHydro(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PFTHydro.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PFTHydro = SrcRtHndSideData%PFTHydro + end if + DstRtHndSideData%PFZHydro = SrcRtHndSideData%PFZHydro + if (allocated(SrcRtHndSideData%PMFHydro)) then + LB(1:3) = lbound(SrcRtHndSideData%PMFHydro) + UB(1:3) = ubound(SrcRtHndSideData%PMFHydro) + if (.not. allocated(DstRtHndSideData%PMFHydro)) then + allocate(DstRtHndSideData%PMFHydro(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PMFHydro.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PMFHydro = SrcRtHndSideData%PMFHydro + end if + if (allocated(SrcRtHndSideData%PMomBNcRt)) then + LB(1:2) = lbound(SrcRtHndSideData%PMomBNcRt) + UB(1:2) = ubound(SrcRtHndSideData%PMomBNcRt) + if (.not. allocated(DstRtHndSideData%PMomBNcRt)) then + allocate(DstRtHndSideData%PMomBNcRt(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PMomBNcRt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PMomBNcRt = SrcRtHndSideData%PMomBNcRt + end if + if (allocated(SrcRtHndSideData%PMomH0B)) then + LB(1:3) = lbound(SrcRtHndSideData%PMomH0B) + UB(1:3) = ubound(SrcRtHndSideData%PMomH0B) + if (.not. allocated(DstRtHndSideData%PMomH0B)) then + allocate(DstRtHndSideData%PMomH0B(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PMomH0B.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PMomH0B = SrcRtHndSideData%PMomH0B + end if + if (allocated(SrcRtHndSideData%PMomLPRot)) then + LB(1:2) = lbound(SrcRtHndSideData%PMomLPRot) + UB(1:2) = ubound(SrcRtHndSideData%PMomLPRot) + if (.not. allocated(DstRtHndSideData%PMomLPRot)) then + allocate(DstRtHndSideData%PMomLPRot(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PMomLPRot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PMomLPRot = SrcRtHndSideData%PMomLPRot + end if + if (allocated(SrcRtHndSideData%PMomNGnRt)) then + LB(1:2) = lbound(SrcRtHndSideData%PMomNGnRt) + UB(1:2) = ubound(SrcRtHndSideData%PMomNGnRt) + if (.not. allocated(DstRtHndSideData%PMomNGnRt)) then + allocate(DstRtHndSideData%PMomNGnRt(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PMomNGnRt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PMomNGnRt = SrcRtHndSideData%PMomNGnRt + end if + if (allocated(SrcRtHndSideData%PMomNTail)) then + LB(1:2) = lbound(SrcRtHndSideData%PMomNTail) + UB(1:2) = ubound(SrcRtHndSideData%PMomNTail) + if (.not. allocated(DstRtHndSideData%PMomNTail)) then + allocate(DstRtHndSideData%PMomNTail(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PMomNTail.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PMomNTail = SrcRtHndSideData%PMomNTail + end if + if (allocated(SrcRtHndSideData%PMomX0Trb)) then + LB(1:2) = lbound(SrcRtHndSideData%PMomX0Trb) + UB(1:2) = ubound(SrcRtHndSideData%PMomX0Trb) + if (.not. allocated(DstRtHndSideData%PMomX0Trb)) then + allocate(DstRtHndSideData%PMomX0Trb(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PMomX0Trb.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PMomX0Trb = SrcRtHndSideData%PMomX0Trb + end if + DstRtHndSideData%PMXHydro = SrcRtHndSideData%PMXHydro + DstRtHndSideData%TeetAng = SrcRtHndSideData%TeetAng + DstRtHndSideData%FrcVGnRtt = SrcRtHndSideData%FrcVGnRtt + DstRtHndSideData%FrcWTailt = SrcRtHndSideData%FrcWTailt + DstRtHndSideData%FrcZAllt = SrcRtHndSideData%FrcZAllt + DstRtHndSideData%MomXAllt = SrcRtHndSideData%MomXAllt + if (allocated(SrcRtHndSideData%PFrcVGnRt)) then + LB(1:2) = lbound(SrcRtHndSideData%PFrcVGnRt) + UB(1:2) = ubound(SrcRtHndSideData%PFrcVGnRt) + if (.not. allocated(DstRtHndSideData%PFrcVGnRt)) then + allocate(DstRtHndSideData%PFrcVGnRt(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PFrcVGnRt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PFrcVGnRt = SrcRtHndSideData%PFrcVGnRt + end if + if (allocated(SrcRtHndSideData%PFrcWTail)) then + LB(1:2) = lbound(SrcRtHndSideData%PFrcWTail) + UB(1:2) = ubound(SrcRtHndSideData%PFrcWTail) + if (.not. allocated(DstRtHndSideData%PFrcWTail)) then + allocate(DstRtHndSideData%PFrcWTail(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PFrcWTail.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PFrcWTail = SrcRtHndSideData%PFrcWTail + end if + if (allocated(SrcRtHndSideData%PFrcZAll)) then + LB(1:2) = lbound(SrcRtHndSideData%PFrcZAll) + UB(1:2) = ubound(SrcRtHndSideData%PFrcZAll) + if (.not. allocated(DstRtHndSideData%PFrcZAll)) then + allocate(DstRtHndSideData%PFrcZAll(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PFrcZAll.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PFrcZAll = SrcRtHndSideData%PFrcZAll + end if + if (allocated(SrcRtHndSideData%PMomXAll)) then + LB(1:2) = lbound(SrcRtHndSideData%PMomXAll) + UB(1:2) = ubound(SrcRtHndSideData%PMomXAll) + if (.not. allocated(DstRtHndSideData%PMomXAll)) then + allocate(DstRtHndSideData%PMomXAll(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PMomXAll.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PMomXAll = SrcRtHndSideData%PMomXAll + end if + DstRtHndSideData%TeetMom = SrcRtHndSideData%TeetMom + DstRtHndSideData%TFrlMom = SrcRtHndSideData%TFrlMom + DstRtHndSideData%RFrlMom = SrcRtHndSideData%RFrlMom + DstRtHndSideData%GBoxEffFac = SrcRtHndSideData%GBoxEffFac + if (allocated(SrcRtHndSideData%rSAerCen)) then + LB(1:3) = lbound(SrcRtHndSideData%rSAerCen) + UB(1:3) = ubound(SrcRtHndSideData%rSAerCen) + if (.not. allocated(DstRtHndSideData%rSAerCen)) then + allocate(DstRtHndSideData%rSAerCen(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%rSAerCen.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%rSAerCen = SrcRtHndSideData%rSAerCen + end if + DstRtHndSideData%YawFriMom = SrcRtHndSideData%YawFriMom +end subroutine + +subroutine ED_DestroyRtHndSide(RtHndSideData, ErrStat, ErrMsg) + type(ED_RtHndSide), intent(inout) :: RtHndSideData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'ED_DestroyRtHndSide' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(RtHndSideData%rQS)) then + deallocate(RtHndSideData%rQS) + end if + if (allocated(RtHndSideData%rS)) then + deallocate(RtHndSideData%rS) + end if + if (allocated(RtHndSideData%rS0S)) then + deallocate(RtHndSideData%rS0S) + end if + if (allocated(RtHndSideData%rT)) then + deallocate(RtHndSideData%rT) + end if + if (allocated(RtHndSideData%rT0T)) then + deallocate(RtHndSideData%rT0T) + end if + if (allocated(RtHndSideData%rZT)) then + deallocate(RtHndSideData%rZT) + end if + if (allocated(RtHndSideData%rPS0)) then + deallocate(RtHndSideData%rPS0) + end if + if (allocated(RtHndSideData%AngPosEF)) then + deallocate(RtHndSideData%AngPosEF) + end if + if (allocated(RtHndSideData%AngPosXF)) then + deallocate(RtHndSideData%AngPosXF) + end if + if (allocated(RtHndSideData%AngPosHM)) then + deallocate(RtHndSideData%AngPosHM) + end if + if (allocated(RtHndSideData%PAngVelEA)) then + deallocate(RtHndSideData%PAngVelEA) + end if + if (allocated(RtHndSideData%PAngVelEF)) then + deallocate(RtHndSideData%PAngVelEF) + end if + if (allocated(RtHndSideData%PAngVelEG)) then + deallocate(RtHndSideData%PAngVelEG) + end if + if (allocated(RtHndSideData%PAngVelEH)) then + deallocate(RtHndSideData%PAngVelEH) + end if + if (allocated(RtHndSideData%PAngVelEL)) then + deallocate(RtHndSideData%PAngVelEL) + end if + if (allocated(RtHndSideData%PAngVelEM)) then + deallocate(RtHndSideData%PAngVelEM) + end if + if (allocated(RtHndSideData%AngVelEM)) then + deallocate(RtHndSideData%AngVelEM) + end if + if (allocated(RtHndSideData%PAngVelEN)) then + deallocate(RtHndSideData%PAngVelEN) + end if + if (allocated(RtHndSideData%PAngVelEB)) then + deallocate(RtHndSideData%PAngVelEB) + end if + if (allocated(RtHndSideData%PAngVelER)) then + deallocate(RtHndSideData%PAngVelER) + end if + if (allocated(RtHndSideData%PAngVelEX)) then + deallocate(RtHndSideData%PAngVelEX) + end if + if (allocated(RtHndSideData%AngAccEFt)) then + deallocate(RtHndSideData%AngAccEFt) + end if + if (allocated(RtHndSideData%AngVelEF)) then + deallocate(RtHndSideData%AngVelEF) + end if + if (allocated(RtHndSideData%AngVelHM)) then + deallocate(RtHndSideData%AngVelHM) + end if + if (allocated(RtHndSideData%AngAccEKt)) then + deallocate(RtHndSideData%AngAccEKt) + end if + if (allocated(RtHndSideData%LinVelES)) then + deallocate(RtHndSideData%LinVelES) + end if + if (allocated(RtHndSideData%LinVelET)) then + deallocate(RtHndSideData%LinVelET) + end if + if (allocated(RtHndSideData%LinVelESm2)) then + deallocate(RtHndSideData%LinVelESm2) + end if + if (allocated(RtHndSideData%PLinVelEIMU)) then + deallocate(RtHndSideData%PLinVelEIMU) + end if + if (allocated(RtHndSideData%PLinVelEO)) then + deallocate(RtHndSideData%PLinVelEO) + end if + if (allocated(RtHndSideData%PLinVelES)) then + deallocate(RtHndSideData%PLinVelES) + end if + if (allocated(RtHndSideData%PLinVelET)) then + deallocate(RtHndSideData%PLinVelET) + end if + if (allocated(RtHndSideData%PLinVelEZ)) then + deallocate(RtHndSideData%PLinVelEZ) + end if + if (allocated(RtHndSideData%PLinVelEC)) then + deallocate(RtHndSideData%PLinVelEC) + end if + if (allocated(RtHndSideData%PLinVelED)) then + deallocate(RtHndSideData%PLinVelED) + end if + if (allocated(RtHndSideData%PLinVelEI)) then + deallocate(RtHndSideData%PLinVelEI) + end if + if (allocated(RtHndSideData%PLinVelEJ)) then + deallocate(RtHndSideData%PLinVelEJ) + end if + if (allocated(RtHndSideData%PLinVelEP)) then + deallocate(RtHndSideData%PLinVelEP) + end if + if (allocated(RtHndSideData%PLinVelEQ)) then + deallocate(RtHndSideData%PLinVelEQ) + end if + if (allocated(RtHndSideData%PLinVelEU)) then + deallocate(RtHndSideData%PLinVelEU) + end if + if (allocated(RtHndSideData%PLinVelEV)) then + deallocate(RtHndSideData%PLinVelEV) + end if + if (allocated(RtHndSideData%PLinVelEW)) then + deallocate(RtHndSideData%PLinVelEW) + end if + if (allocated(RtHndSideData%PLinVelEY)) then + deallocate(RtHndSideData%PLinVelEY) + end if + if (allocated(RtHndSideData%LinAccESt)) then + deallocate(RtHndSideData%LinAccESt) + end if + if (allocated(RtHndSideData%LinAccETt)) then + deallocate(RtHndSideData%LinAccETt) + end if + if (allocated(RtHndSideData%FrcS0Bt)) then + deallocate(RtHndSideData%FrcS0Bt) + end if + if (allocated(RtHndSideData%FSAero)) then + deallocate(RtHndSideData%FSAero) + end if + if (allocated(RtHndSideData%FSTipDrag)) then + deallocate(RtHndSideData%FSTipDrag) + end if + if (allocated(RtHndSideData%FTHydrot)) then + deallocate(RtHndSideData%FTHydrot) + end if + if (allocated(RtHndSideData%MFHydrot)) then + deallocate(RtHndSideData%MFHydrot) + end if + if (allocated(RtHndSideData%MomH0Bt)) then + deallocate(RtHndSideData%MomH0Bt) + end if + if (allocated(RtHndSideData%MMAero)) then + deallocate(RtHndSideData%MMAero) + end if + if (allocated(RtHndSideData%PFrcONcRt)) then + deallocate(RtHndSideData%PFrcONcRt) + end if + if (allocated(RtHndSideData%PFrcPRot)) then + deallocate(RtHndSideData%PFrcPRot) + end if + if (allocated(RtHndSideData%PFrcS0B)) then + deallocate(RtHndSideData%PFrcS0B) + end if + if (allocated(RtHndSideData%PFrcT0Trb)) then + deallocate(RtHndSideData%PFrcT0Trb) + end if + if (allocated(RtHndSideData%PFTHydro)) then + deallocate(RtHndSideData%PFTHydro) + end if + if (allocated(RtHndSideData%PMFHydro)) then + deallocate(RtHndSideData%PMFHydro) + end if + if (allocated(RtHndSideData%PMomBNcRt)) then + deallocate(RtHndSideData%PMomBNcRt) + end if + if (allocated(RtHndSideData%PMomH0B)) then + deallocate(RtHndSideData%PMomH0B) + end if + if (allocated(RtHndSideData%PMomLPRot)) then + deallocate(RtHndSideData%PMomLPRot) + end if + if (allocated(RtHndSideData%PMomNGnRt)) then + deallocate(RtHndSideData%PMomNGnRt) + end if + if (allocated(RtHndSideData%PMomNTail)) then + deallocate(RtHndSideData%PMomNTail) + end if + if (allocated(RtHndSideData%PMomX0Trb)) then + deallocate(RtHndSideData%PMomX0Trb) + end if + if (allocated(RtHndSideData%PFrcVGnRt)) then + deallocate(RtHndSideData%PFrcVGnRt) + end if + if (allocated(RtHndSideData%PFrcWTail)) then + deallocate(RtHndSideData%PFrcWTail) + end if + if (allocated(RtHndSideData%PFrcZAll)) then + deallocate(RtHndSideData%PFrcZAll) + end if + if (allocated(RtHndSideData%PMomXAll)) then + deallocate(RtHndSideData%PMomXAll) + end if + if (allocated(RtHndSideData%rSAerCen)) then + deallocate(RtHndSideData%rSAerCen) + end if +end subroutine + +subroutine ED_PackRtHndSide(RF, Indata) + type(RegFile), intent(inout) :: RF + type(ED_RtHndSide), intent(in) :: InData + character(*), parameter :: RoutineName = 'ED_PackRtHndSide' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%rO) + call RegPackAlloc(RF, InData%rQS) + call RegPackAlloc(RF, InData%rS) + call RegPackAlloc(RF, InData%rS0S) + call RegPackAlloc(RF, InData%rT) + call RegPack(RF, InData%rT0O) + call RegPackAlloc(RF, InData%rT0T) + call RegPack(RF, InData%rZ) + call RegPack(RF, InData%rZO) + call RegPackAlloc(RF, InData%rZT) + call RegPack(RF, InData%rPQ) + call RegPack(RF, InData%rP) + call RegPack(RF, InData%rV) + call RegPack(RF, InData%rJ) + call RegPack(RF, InData%rZY) + call RegPack(RF, InData%rOU) + call RegPack(RF, InData%rOV) + call RegPack(RF, InData%rVD) + call RegPack(RF, InData%rOW) + call RegPack(RF, InData%rPC) + call RegPackAlloc(RF, InData%rPS0) + call RegPack(RF, InData%rQ) + call RegPack(RF, InData%rQC) + call RegPack(RF, InData%rVIMU) + call RegPack(RF, InData%rVP) + call RegPack(RF, InData%rWI) + call RegPack(RF, InData%rWJ) + call RegPack(RF, InData%rZT0) + call RegPackAlloc(RF, InData%AngPosEF) + call RegPackAlloc(RF, InData%AngPosXF) + call RegPackAlloc(RF, InData%AngPosHM) + call RegPack(RF, InData%AngPosXB) + call RegPack(RF, InData%AngPosEX) + call RegPackAlloc(RF, InData%PAngVelEA) + call RegPackAlloc(RF, InData%PAngVelEF) + call RegPackAlloc(RF, InData%PAngVelEG) + call RegPackAlloc(RF, InData%PAngVelEH) + call RegPackAlloc(RF, InData%PAngVelEL) + call RegPackAlloc(RF, InData%PAngVelEM) + call RegPackAlloc(RF, InData%AngVelEM) + call RegPackAlloc(RF, InData%PAngVelEN) + call RegPack(RF, InData%AngVelEA) + call RegPackAlloc(RF, InData%PAngVelEB) + call RegPackAlloc(RF, InData%PAngVelER) + call RegPackAlloc(RF, InData%PAngVelEX) + call RegPack(RF, InData%AngVelEG) + call RegPack(RF, InData%AngVelEH) + call RegPack(RF, InData%AngVelEL) + call RegPack(RF, InData%AngVelEN) + call RegPack(RF, InData%AngVelEB) + call RegPack(RF, InData%AngVelER) + call RegPack(RF, InData%AngVelEX) + call RegPack(RF, InData%TeetAngVel) + call RegPack(RF, InData%AngAccEBt) + call RegPack(RF, InData%AngAccERt) + call RegPack(RF, InData%AngAccEXt) + call RegPackAlloc(RF, InData%AngAccEFt) + call RegPackAlloc(RF, InData%AngVelEF) + call RegPackAlloc(RF, InData%AngVelHM) + call RegPack(RF, InData%AngAccEAt) + call RegPack(RF, InData%AngAccEGt) + call RegPack(RF, InData%AngAccEHt) + call RegPackAlloc(RF, InData%AngAccEKt) + call RegPack(RF, InData%AngAccENt) + call RegPack(RF, InData%LinAccECt) + call RegPack(RF, InData%LinAccEDt) + call RegPack(RF, InData%LinAccEIt) + call RegPack(RF, InData%LinAccEJt) + call RegPack(RF, InData%LinAccEUt) + call RegPack(RF, InData%LinAccEYt) + call RegPackAlloc(RF, InData%LinVelES) + call RegPack(RF, InData%LinVelEQ) + call RegPackAlloc(RF, InData%LinVelET) + call RegPackAlloc(RF, InData%LinVelESm2) + call RegPackAlloc(RF, InData%PLinVelEIMU) + call RegPackAlloc(RF, InData%PLinVelEO) + call RegPackAlloc(RF, InData%PLinVelES) + call RegPackAlloc(RF, InData%PLinVelET) + call RegPackAlloc(RF, InData%PLinVelEZ) + call RegPackAlloc(RF, InData%PLinVelEC) + call RegPackAlloc(RF, InData%PLinVelED) + call RegPackAlloc(RF, InData%PLinVelEI) + call RegPackAlloc(RF, InData%PLinVelEJ) + call RegPackAlloc(RF, InData%PLinVelEP) + call RegPackAlloc(RF, InData%PLinVelEQ) + call RegPackAlloc(RF, InData%PLinVelEU) + call RegPackAlloc(RF, InData%PLinVelEV) + call RegPackAlloc(RF, InData%PLinVelEW) + call RegPackAlloc(RF, InData%PLinVelEY) + call RegPack(RF, InData%LinAccEIMUt) + call RegPack(RF, InData%LinAccEOt) + call RegPackAlloc(RF, InData%LinAccESt) + call RegPackAlloc(RF, InData%LinAccETt) + call RegPack(RF, InData%LinAccEZt) + call RegPack(RF, InData%LinVelEIMU) + call RegPack(RF, InData%LinVelEZ) + call RegPack(RF, InData%LinVelEO) + call RegPack(RF, InData%LinVelEJ) + call RegPack(RF, InData%FrcONcRtt) + call RegPack(RF, InData%FrcPRott) + call RegPackAlloc(RF, InData%FrcS0Bt) + call RegPack(RF, InData%FrcT0Trbt) + call RegPackAlloc(RF, InData%FSAero) + call RegPackAlloc(RF, InData%FSTipDrag) + call RegPackAlloc(RF, InData%FTHydrot) + call RegPack(RF, InData%FZHydrot) + call RegPackAlloc(RF, InData%MFHydrot) + call RegPack(RF, InData%MomBNcRtt) + call RegPackAlloc(RF, InData%MomH0Bt) + call RegPack(RF, InData%MomLPRott) + call RegPack(RF, InData%MomNGnRtt) + call RegPack(RF, InData%MomNTailt) + call RegPack(RF, InData%MomX0Trbt) + call RegPackAlloc(RF, InData%MMAero) + call RegPack(RF, InData%MXHydrot) + call RegPackAlloc(RF, InData%PFrcONcRt) + call RegPackAlloc(RF, InData%PFrcPRot) + call RegPackAlloc(RF, InData%PFrcS0B) + call RegPackAlloc(RF, InData%PFrcT0Trb) + call RegPackAlloc(RF, InData%PFTHydro) + call RegPack(RF, InData%PFZHydro) + call RegPackAlloc(RF, InData%PMFHydro) + call RegPackAlloc(RF, InData%PMomBNcRt) + call RegPackAlloc(RF, InData%PMomH0B) + call RegPackAlloc(RF, InData%PMomLPRot) + call RegPackAlloc(RF, InData%PMomNGnRt) + call RegPackAlloc(RF, InData%PMomNTail) + call RegPackAlloc(RF, InData%PMomX0Trb) + call RegPack(RF, InData%PMXHydro) + call RegPack(RF, InData%TeetAng) + call RegPack(RF, InData%FrcVGnRtt) + call RegPack(RF, InData%FrcWTailt) + call RegPack(RF, InData%FrcZAllt) + call RegPack(RF, InData%MomXAllt) + call RegPackAlloc(RF, InData%PFrcVGnRt) + call RegPackAlloc(RF, InData%PFrcWTail) + call RegPackAlloc(RF, InData%PFrcZAll) + call RegPackAlloc(RF, InData%PMomXAll) + call RegPack(RF, InData%TeetMom) + call RegPack(RF, InData%TFrlMom) + call RegPack(RF, InData%RFrlMom) + call RegPack(RF, InData%GBoxEffFac) + call RegPackAlloc(RF, InData%rSAerCen) + call RegPack(RF, InData%YawFriMom) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ED_UnPackRtHndSide(RF, OutData) + type(RegFile), intent(inout) :: RF + type(ED_RtHndSide), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ED_UnPackRtHndSide' + integer(B4Ki) :: LB(5), UB(5) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%rO); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%rQS); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%rS); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%rS0S); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%rT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rT0O); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%rT0T); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rZ); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rZO); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%rZT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rPQ); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rV); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rJ); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rZY); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rOU); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rOV); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rVD); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rOW); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rPC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%rPS0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rQ); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rQC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rVIMU); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rVP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rWI); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rWJ); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rZT0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AngPosEF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AngPosXF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AngPosHM); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AngPosXB); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AngPosEX); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PAngVelEA); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PAngVelEF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PAngVelEG); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PAngVelEH); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PAngVelEL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PAngVelEM); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AngVelEM); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PAngVelEN); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AngVelEA); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PAngVelEB); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PAngVelER); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PAngVelEX); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AngVelEG); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AngVelEH); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AngVelEL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AngVelEN); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AngVelEB); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AngVelER); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AngVelEX); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TeetAngVel); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AngAccEBt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AngAccERt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AngAccEXt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AngAccEFt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AngVelEF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AngVelHM); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AngAccEAt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AngAccEGt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AngAccEHt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AngAccEKt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AngAccENt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LinAccECt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LinAccEDt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LinAccEIt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LinAccEJt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LinAccEUt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LinAccEYt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LinVelES); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LinVelEQ); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LinVelET); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LinVelESm2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PLinVelEIMU); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PLinVelEO); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PLinVelES); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PLinVelET); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PLinVelEZ); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PLinVelEC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PLinVelED); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PLinVelEI); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PLinVelEJ); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PLinVelEP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PLinVelEQ); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PLinVelEU); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PLinVelEV); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PLinVelEW); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PLinVelEY); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LinAccEIMUt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LinAccEOt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LinAccESt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LinAccETt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LinAccEZt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LinVelEIMU); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LinVelEZ); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LinVelEO); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LinVelEJ); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FrcONcRtt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FrcPRott); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%FrcS0Bt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FrcT0Trbt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%FSAero); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%FSTipDrag); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%FTHydrot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FZHydrot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%MFHydrot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MomBNcRtt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%MomH0Bt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MomLPRott); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MomNGnRtt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MomNTailt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MomX0Trbt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%MMAero); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MXHydrot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PFrcONcRt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PFrcPRot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PFrcS0B); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PFrcT0Trb); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PFTHydro); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PFZHydro); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PMFHydro); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PMomBNcRt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PMomH0B); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PMomLPRot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PMomNGnRt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PMomNTail); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PMomX0Trb); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PMXHydro); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TeetAng); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FrcVGnRtt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FrcWTailt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FrcZAllt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MomXAllt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PFrcVGnRt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PFrcWTail); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PFrcZAll); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PMomXAll); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TeetMom); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFrlMom); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RFrlMom); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GBoxEffFac); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%rSAerCen); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawFriMom); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ED_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) + type(ED_ContinuousStateType), intent(in) :: SrcContStateData + type(ED_ContinuousStateType), intent(inout) :: DstContStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'ED_CopyContState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcContStateData%QT)) then + LB(1:1) = lbound(SrcContStateData%QT) + UB(1:1) = ubound(SrcContStateData%QT) + if (.not. allocated(DstContStateData%QT)) then + allocate(DstContStateData%QT(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%QT.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstContStateData%QT = SrcContStateData%QT + end if + if (allocated(SrcContStateData%QDT)) then + LB(1:1) = lbound(SrcContStateData%QDT) + UB(1:1) = ubound(SrcContStateData%QDT) + if (.not. allocated(DstContStateData%QDT)) then + allocate(DstContStateData%QDT(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%QDT.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstContStateData%QDT = SrcContStateData%QDT + end if +end subroutine + +subroutine ED_DestroyContState(ContStateData, ErrStat, ErrMsg) + type(ED_ContinuousStateType), intent(inout) :: ContStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'ED_DestroyContState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ContStateData%QT)) then + deallocate(ContStateData%QT) + end if + if (allocated(ContStateData%QDT)) then + deallocate(ContStateData%QDT) + end if +end subroutine + +subroutine ED_PackContState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(ED_ContinuousStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ED_PackContState' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%QT) + call RegPackAlloc(RF, InData%QDT) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ED_UnPackContState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(ED_ContinuousStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ED_UnPackContState' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%QT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%QDT); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ED_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) + type(ED_DiscreteStateType), intent(in) :: SrcDiscStateData + type(ED_DiscreteStateType), intent(inout) :: DstDiscStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'ED_CopyDiscState' + ErrStat = ErrID_None + ErrMsg = '' + DstDiscStateData%DummyDiscState = SrcDiscStateData%DummyDiscState +end subroutine + +subroutine ED_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) + type(ED_DiscreteStateType), intent(inout) :: DiscStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'ED_DestroyDiscState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine ED_PackDiscState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(ED_DiscreteStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ED_PackDiscState' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyDiscState) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ED_UnPackDiscState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(ED_DiscreteStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ED_UnPackDiscState' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyDiscState); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ED_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) + type(ED_ConstraintStateType), intent(in) :: SrcConstrStateData + type(ED_ConstraintStateType), intent(inout) :: DstConstrStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'ED_CopyConstrState' + ErrStat = ErrID_None + ErrMsg = '' + DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState +end subroutine + +subroutine ED_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) + type(ED_ConstraintStateType), intent(inout) :: ConstrStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'ED_DestroyConstrState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine ED_PackConstrState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(ED_ConstraintStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ED_PackConstrState' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyConstrState) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ED_UnPackConstrState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(ED_ConstraintStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ED_UnPackConstrState' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyConstrState); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ED_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) + type(ED_OtherStateType), intent(in) :: SrcOtherStateData + type(ED_OtherStateType), intent(inout) :: DstOtherStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ED_CopyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + DstOtherStateData%n = SrcOtherStateData%n + LB(1:1) = lbound(SrcOtherStateData%xdot) + UB(1:1) = ubound(SrcOtherStateData%xdot) + do i1 = LB(1), UB(1) + call ED_CopyContState(SrcOtherStateData%xdot(i1), DstOtherStateData%xdot(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + if (allocated(SrcOtherStateData%IC)) then + LB(1:1) = lbound(SrcOtherStateData%IC) + UB(1:1) = ubound(SrcOtherStateData%IC) + if (.not. allocated(DstOtherStateData%IC)) then + allocate(DstOtherStateData%IC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%IC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOtherStateData%IC = SrcOtherStateData%IC + end if + DstOtherStateData%HSSBrTrq = SrcOtherStateData%HSSBrTrq + DstOtherStateData%HSSBrTrqC = SrcOtherStateData%HSSBrTrqC + DstOtherStateData%SgnPrvLSTQ = SrcOtherStateData%SgnPrvLSTQ + DstOtherStateData%SgnLSTQ = SrcOtherStateData%SgnLSTQ + DstOtherStateData%Mfhat = SrcOtherStateData%Mfhat + DstOtherStateData%YawFriMfp = SrcOtherStateData%YawFriMfp + DstOtherStateData%OmegaTn = SrcOtherStateData%OmegaTn + DstOtherStateData%OmegaDotTn = SrcOtherStateData%OmegaDotTn +end subroutine + +subroutine ED_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) + type(ED_OtherStateType), intent(inout) :: OtherStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ED_DestroyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + LB(1:1) = lbound(OtherStateData%xdot) + UB(1:1) = ubound(OtherStateData%xdot) + do i1 = LB(1), UB(1) + call ED_DestroyContState(OtherStateData%xdot(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + if (allocated(OtherStateData%IC)) then + deallocate(OtherStateData%IC) + end if +end subroutine + +subroutine ED_PackOtherState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(ED_OtherStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ED_PackOtherState' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%n) + LB(1:1) = lbound(InData%xdot) + UB(1:1) = ubound(InData%xdot) + do i1 = LB(1), UB(1) + call ED_PackContState(RF, InData%xdot(i1)) + end do + call RegPackAlloc(RF, InData%IC) + call RegPack(RF, InData%HSSBrTrq) + call RegPack(RF, InData%HSSBrTrqC) + call RegPack(RF, InData%SgnPrvLSTQ) + call RegPack(RF, InData%SgnLSTQ) + call RegPack(RF, InData%Mfhat) + call RegPack(RF, InData%YawFriMfp) + call RegPack(RF, InData%OmegaTn) + call RegPack(RF, InData%OmegaDotTn) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ED_UnPackOtherState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(ED_OtherStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ED_UnPackOtherState' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%n); if (RegCheckErr(RF, RoutineName)) return + LB(1:1) = lbound(OutData%xdot) + UB(1:1) = ubound(OutData%xdot) + do i1 = LB(1), UB(1) + call ED_UnpackContState(RF, OutData%xdot(i1)) ! xdot + end do + call RegUnpackAlloc(RF, OutData%IC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HSSBrTrq); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HSSBrTrqC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SgnPrvLSTQ); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SgnLSTQ); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Mfhat); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawFriMfp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OmegaTn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OmegaDotTn); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ED_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(ED_MiscVarType), intent(in) :: SrcMiscData + type(ED_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ED_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + call ED_CopyCoordSys(SrcMiscData%CoordSys, DstMiscData%CoordSys, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call ED_CopyRtHndSide(SrcMiscData%RtHS, DstMiscData%RtHS, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcMiscData%AllOuts)) then + LB(1:1) = lbound(SrcMiscData%AllOuts) + UB(1:1) = ubound(SrcMiscData%AllOuts) + if (.not. allocated(DstMiscData%AllOuts)) then + allocate(DstMiscData%AllOuts(LB(1):UB(1)), 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 + end if + if (allocated(SrcMiscData%AugMat)) then + LB(1:2) = lbound(SrcMiscData%AugMat) + UB(1:2) = ubound(SrcMiscData%AugMat) + if (.not. allocated(DstMiscData%AugMat)) then + allocate(DstMiscData%AugMat(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%AugMat.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%AugMat = SrcMiscData%AugMat + end if + if (allocated(SrcMiscData%AugMat_factor)) then + LB(1:2) = lbound(SrcMiscData%AugMat_factor) + UB(1:2) = ubound(SrcMiscData%AugMat_factor) + if (.not. allocated(DstMiscData%AugMat_factor)) then + allocate(DstMiscData%AugMat_factor(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%AugMat_factor.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%AugMat_factor = SrcMiscData%AugMat_factor + end if + if (allocated(SrcMiscData%SolnVec)) then + LB(1:1) = lbound(SrcMiscData%SolnVec) + UB(1:1) = ubound(SrcMiscData%SolnVec) + if (.not. allocated(DstMiscData%SolnVec)) then + allocate(DstMiscData%SolnVec(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SolnVec.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%SolnVec = SrcMiscData%SolnVec + end if + if (allocated(SrcMiscData%AugMat_pivot)) then + LB(1:1) = lbound(SrcMiscData%AugMat_pivot) + UB(1:1) = ubound(SrcMiscData%AugMat_pivot) + if (.not. allocated(DstMiscData%AugMat_pivot)) then + allocate(DstMiscData%AugMat_pivot(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%AugMat_pivot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%AugMat_pivot = SrcMiscData%AugMat_pivot + end if + if (allocated(SrcMiscData%OgnlGeAzRo)) then + LB(1:1) = lbound(SrcMiscData%OgnlGeAzRo) + UB(1:1) = ubound(SrcMiscData%OgnlGeAzRo) + if (.not. allocated(DstMiscData%OgnlGeAzRo)) then + allocate(DstMiscData%OgnlGeAzRo(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%OgnlGeAzRo.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%OgnlGeAzRo = SrcMiscData%OgnlGeAzRo + end if + if (allocated(SrcMiscData%QD2T)) then + LB(1:1) = lbound(SrcMiscData%QD2T) + UB(1:1) = ubound(SrcMiscData%QD2T) + if (.not. allocated(DstMiscData%QD2T)) then + allocate(DstMiscData%QD2T(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%QD2T.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%QD2T = SrcMiscData%QD2T + end if + DstMiscData%IgnoreMod = SrcMiscData%IgnoreMod + if (allocated(SrcMiscData%OgnlYawRow)) then + LB(1:1) = lbound(SrcMiscData%OgnlYawRow) + UB(1:1) = ubound(SrcMiscData%OgnlYawRow) + if (.not. allocated(DstMiscData%OgnlYawRow)) then + allocate(DstMiscData%OgnlYawRow(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%OgnlYawRow.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%OgnlYawRow = SrcMiscData%OgnlYawRow + end if + DstMiscData%FrcONcRt = SrcMiscData%FrcONcRt + DstMiscData%MomONcRt = SrcMiscData%MomONcRt + DstMiscData%YawFriMz = SrcMiscData%YawFriMz +end subroutine + +subroutine ED_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(ED_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ED_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' + call ED_DestroyCoordSys(MiscData%CoordSys, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call ED_DestroyRtHndSide(MiscData%RtHS, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(MiscData%AllOuts)) then + deallocate(MiscData%AllOuts) + end if + if (allocated(MiscData%AugMat)) then + deallocate(MiscData%AugMat) + end if + if (allocated(MiscData%AugMat_factor)) then + deallocate(MiscData%AugMat_factor) + end if + if (allocated(MiscData%SolnVec)) then + deallocate(MiscData%SolnVec) + end if + if (allocated(MiscData%AugMat_pivot)) then + deallocate(MiscData%AugMat_pivot) + end if + if (allocated(MiscData%OgnlGeAzRo)) then + deallocate(MiscData%OgnlGeAzRo) + end if + if (allocated(MiscData%QD2T)) then + deallocate(MiscData%QD2T) + end if + if (allocated(MiscData%OgnlYawRow)) then + deallocate(MiscData%OgnlYawRow) + end if +end subroutine + +subroutine ED_PackMisc(RF, Indata) + type(RegFile), intent(inout) :: RF + type(ED_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ED_PackMisc' + if (RF%ErrStat >= AbortErrLev) return + call ED_PackCoordSys(RF, InData%CoordSys) + call ED_PackRtHndSide(RF, InData%RtHS) + call RegPackAlloc(RF, InData%AllOuts) + call RegPackAlloc(RF, InData%AugMat) + call RegPackAlloc(RF, InData%AugMat_factor) + call RegPackAlloc(RF, InData%SolnVec) + call RegPackAlloc(RF, InData%AugMat_pivot) + call RegPackAlloc(RF, InData%OgnlGeAzRo) + call RegPackAlloc(RF, InData%QD2T) + call RegPack(RF, InData%IgnoreMod) + call RegPackAlloc(RF, InData%OgnlYawRow) + call RegPack(RF, InData%FrcONcRt) + call RegPack(RF, InData%MomONcRt) + call RegPack(RF, InData%YawFriMz) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ED_UnPackMisc(RF, OutData) + type(RegFile), intent(inout) :: RF + type(ED_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ED_UnPackMisc' + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call ED_UnpackCoordSys(RF, OutData%CoordSys) ! CoordSys + call ED_UnpackRtHndSide(RF, OutData%RtHS) ! RtHS + call RegUnpackAlloc(RF, OutData%AllOuts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AugMat); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AugMat_factor); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%SolnVec); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AugMat_pivot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%OgnlGeAzRo); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%QD2T); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%IgnoreMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%OgnlYawRow); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FrcONcRt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MomONcRt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawFriMz); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ED_CopyJac_u_idxStarts(SrcJac_u_idxStartsData, DstJac_u_idxStartsData, CtrlCode, ErrStat, ErrMsg) + type(Jac_u_idxStarts), intent(in) :: SrcJac_u_idxStartsData + type(Jac_u_idxStarts), intent(inout) :: DstJac_u_idxStartsData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'ED_CopyJac_u_idxStarts' + ErrStat = ErrID_None + ErrMsg = '' + DstJac_u_idxStartsData%BladeLoad = SrcJac_u_idxStartsData%BladeLoad + DstJac_u_idxStartsData%PlatformLoad = SrcJac_u_idxStartsData%PlatformLoad + DstJac_u_idxStartsData%TowerLoad = SrcJac_u_idxStartsData%TowerLoad + DstJac_u_idxStartsData%HubLoad = SrcJac_u_idxStartsData%HubLoad + DstJac_u_idxStartsData%NacelleLoad = SrcJac_u_idxStartsData%NacelleLoad + DstJac_u_idxStartsData%TFinLoad = SrcJac_u_idxStartsData%TFinLoad + DstJac_u_idxStartsData%BlPitchCom = SrcJac_u_idxStartsData%BlPitchCom +end subroutine + +subroutine ED_DestroyJac_u_idxStarts(Jac_u_idxStartsData, ErrStat, ErrMsg) + type(Jac_u_idxStarts), intent(inout) :: Jac_u_idxStartsData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'ED_DestroyJac_u_idxStarts' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine ED_PackJac_u_idxStarts(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Jac_u_idxStarts), intent(in) :: InData + character(*), parameter :: RoutineName = 'ED_PackJac_u_idxStarts' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%BladeLoad) + call RegPack(RF, InData%PlatformLoad) + call RegPack(RF, InData%TowerLoad) + call RegPack(RF, InData%HubLoad) + call RegPack(RF, InData%NacelleLoad) + call RegPack(RF, InData%TFinLoad) + call RegPack(RF, InData%BlPitchCom) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ED_UnPackJac_u_idxStarts(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Jac_u_idxStarts), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ED_UnPackJac_u_idxStarts' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%BladeLoad); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PlatformLoad); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TowerLoad); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HubLoad); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NacelleLoad); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFinLoad); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BlPitchCom); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ED_CopyJac_y_idxStarts(SrcJac_y_idxStartsData, DstJac_y_idxStartsData, CtrlCode, ErrStat, ErrMsg) + type(Jac_y_idxStarts), intent(in) :: SrcJac_y_idxStartsData + type(Jac_y_idxStarts), intent(inout) :: DstJac_y_idxStartsData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'ED_CopyJac_y_idxStarts' + ErrStat = ErrID_None + ErrMsg = '' + DstJac_y_idxStartsData%Blade = SrcJac_y_idxStartsData%Blade + DstJac_y_idxStartsData%Platform = SrcJac_y_idxStartsData%Platform + DstJac_y_idxStartsData%Tower = SrcJac_y_idxStartsData%Tower + DstJac_y_idxStartsData%Hub = SrcJac_y_idxStartsData%Hub + DstJac_y_idxStartsData%BladeRoot = SrcJac_y_idxStartsData%BladeRoot + DstJac_y_idxStartsData%Nacelle = SrcJac_y_idxStartsData%Nacelle + DstJac_y_idxStartsData%TFin = SrcJac_y_idxStartsData%TFin +end subroutine + +subroutine ED_DestroyJac_y_idxStarts(Jac_y_idxStartsData, ErrStat, ErrMsg) + type(Jac_y_idxStarts), intent(inout) :: Jac_y_idxStartsData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'ED_DestroyJac_y_idxStarts' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine ED_PackJac_y_idxStarts(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Jac_y_idxStarts), intent(in) :: InData + character(*), parameter :: RoutineName = 'ED_PackJac_y_idxStarts' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%Blade) + call RegPack(RF, InData%Platform) + call RegPack(RF, InData%Tower) + call RegPack(RF, InData%Hub) + call RegPack(RF, InData%BladeRoot) + call RegPack(RF, InData%Nacelle) + call RegPack(RF, InData%TFin) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ED_UnPackJac_y_idxStarts(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Jac_y_idxStarts), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ED_UnPackJac_y_idxStarts' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%Blade); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Platform); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Tower); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Hub); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BladeRoot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Nacelle); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFin); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(ED_ParameterType), intent(in) :: SrcParamData + type(ED_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2, i3, i4, i5 + integer(B4Ki) :: LB(5), UB(5) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ED_CopyParam' + ErrStat = ErrID_None + ErrMsg = '' + DstParamData%DT = SrcParamData%DT + DstParamData%DT24 = SrcParamData%DT24 + DstParamData%BldNodes = SrcParamData%BldNodes + DstParamData%TipNode = SrcParamData%TipNode + DstParamData%NDOF = SrcParamData%NDOF + DstParamData%TwoPiNB = SrcParamData%TwoPiNB + DstParamData%NAug = SrcParamData%NAug + DstParamData%NPH = SrcParamData%NPH + if (allocated(SrcParamData%PH)) then + LB(1:1) = lbound(SrcParamData%PH) + UB(1:1) = ubound(SrcParamData%PH) + if (.not. allocated(DstParamData%PH)) then + allocate(DstParamData%PH(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%PH.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%PH = SrcParamData%PH + end if + DstParamData%NPM = SrcParamData%NPM + if (allocated(SrcParamData%PM)) then + LB(1:2) = lbound(SrcParamData%PM) + UB(1:2) = ubound(SrcParamData%PM) + if (.not. allocated(DstParamData%PM)) then + allocate(DstParamData%PM(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%PM.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%PM = SrcParamData%PM + end if + if (allocated(SrcParamData%DOF_Flag)) then + LB(1:1) = lbound(SrcParamData%DOF_Flag) + UB(1:1) = ubound(SrcParamData%DOF_Flag) + if (.not. allocated(DstParamData%DOF_Flag)) then + allocate(DstParamData%DOF_Flag(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%DOF_Flag.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%DOF_Flag = SrcParamData%DOF_Flag + end if + if (allocated(SrcParamData%DOF_Desc)) then + LB(1:1) = lbound(SrcParamData%DOF_Desc) + UB(1:1) = ubound(SrcParamData%DOF_Desc) + if (.not. allocated(DstParamData%DOF_Desc)) then + allocate(DstParamData%DOF_Desc(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%DOF_Desc.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%DOF_Desc = SrcParamData%DOF_Desc + end if + call ED_CopyActiveDOFs(SrcParamData%DOFs, DstParamData%DOFs, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstParamData%NumOuts = SrcParamData%NumOuts + DstParamData%OutFmt = SrcParamData%OutFmt + DstParamData%NBlGages = SrcParamData%NBlGages + DstParamData%NTwGages = SrcParamData%NTwGages + if (allocated(SrcParamData%OutParam)) then + LB(1:1) = lbound(SrcParamData%OutParam) + UB(1:1) = ubound(SrcParamData%OutParam) + if (.not. allocated(DstParamData%OutParam)) then + allocate(DstParamData%OutParam(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutParam.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyOutParmType(SrcParamData%OutParam(i1), DstParamData%OutParam(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + DstParamData%Delim = SrcParamData%Delim + DstParamData%AvgNrmTpRd = SrcParamData%AvgNrmTpRd + DstParamData%AzimB1Up = SrcParamData%AzimB1Up + DstParamData%CosDel3 = SrcParamData%CosDel3 + if (allocated(SrcParamData%CosPreC)) then + LB(1:1) = lbound(SrcParamData%CosPreC) + UB(1:1) = ubound(SrcParamData%CosPreC) + if (.not. allocated(DstParamData%CosPreC)) then + allocate(DstParamData%CosPreC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CosPreC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%CosPreC = SrcParamData%CosPreC + end if + DstParamData%CRFrlSkew = SrcParamData%CRFrlSkew + DstParamData%CRFrlSkw2 = SrcParamData%CRFrlSkw2 + DstParamData%CRFrlTilt = SrcParamData%CRFrlTilt + DstParamData%CRFrlTlt2 = SrcParamData%CRFrlTlt2 + DstParamData%CShftSkew = SrcParamData%CShftSkew + DstParamData%CShftTilt = SrcParamData%CShftTilt + DstParamData%CSRFrlSkw = SrcParamData%CSRFrlSkw + DstParamData%CSRFrlTlt = SrcParamData%CSRFrlTlt + DstParamData%CSTFrlSkw = SrcParamData%CSTFrlSkw + DstParamData%CSTFrlTlt = SrcParamData%CSTFrlTlt + DstParamData%CTFrlSkew = SrcParamData%CTFrlSkew + DstParamData%CTFrlSkw2 = SrcParamData%CTFrlSkw2 + DstParamData%CTFrlTilt = SrcParamData%CTFrlTilt + DstParamData%CTFrlTlt2 = SrcParamData%CTFrlTlt2 + DstParamData%HubHt = SrcParamData%HubHt + DstParamData%HubCM = SrcParamData%HubCM + DstParamData%HubRad = SrcParamData%HubRad + DstParamData%NacCMxn = SrcParamData%NacCMxn + DstParamData%NacCMyn = SrcParamData%NacCMyn + DstParamData%NacCMzn = SrcParamData%NacCMzn + DstParamData%OverHang = SrcParamData%OverHang + DstParamData%ProjArea = SrcParamData%ProjArea + DstParamData%PtfmRefzt = SrcParamData%PtfmRefzt + DstParamData%RefTwrHt = SrcParamData%RefTwrHt + DstParamData%RFrlPnt_n = SrcParamData%RFrlPnt_n + DstParamData%rVDxn = SrcParamData%rVDxn + DstParamData%rVDyn = SrcParamData%rVDyn + DstParamData%rVDzn = SrcParamData%rVDzn + DstParamData%rVIMUxn = SrcParamData%rVIMUxn + DstParamData%rVIMUyn = SrcParamData%rVIMUyn + DstParamData%rVIMUzn = SrcParamData%rVIMUzn + DstParamData%rVPxn = SrcParamData%rVPxn + DstParamData%rVPyn = SrcParamData%rVPyn + DstParamData%rVPzn = SrcParamData%rVPzn + DstParamData%rWIxn = SrcParamData%rWIxn + DstParamData%rWIyn = SrcParamData%rWIyn + DstParamData%rWIzn = SrcParamData%rWIzn + DstParamData%rWJxn = SrcParamData%rWJxn + DstParamData%rWJyn = SrcParamData%rWJyn + DstParamData%rWJzn = SrcParamData%rWJzn + DstParamData%rZT0zt = SrcParamData%rZT0zt + DstParamData%rZYzt = SrcParamData%rZYzt + DstParamData%SinDel3 = SrcParamData%SinDel3 + if (allocated(SrcParamData%SinPreC)) then + LB(1:1) = lbound(SrcParamData%SinPreC) + UB(1:1) = ubound(SrcParamData%SinPreC) + if (.not. allocated(DstParamData%SinPreC)) then + allocate(DstParamData%SinPreC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%SinPreC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%SinPreC = SrcParamData%SinPreC + end if + DstParamData%SRFrlSkew = SrcParamData%SRFrlSkew + DstParamData%SRFrlSkw2 = SrcParamData%SRFrlSkw2 + DstParamData%SRFrlTilt = SrcParamData%SRFrlTilt + DstParamData%SRFrlTlt2 = SrcParamData%SRFrlTlt2 + DstParamData%SShftSkew = SrcParamData%SShftSkew + DstParamData%SShftTilt = SrcParamData%SShftTilt + DstParamData%STFrlSkew = SrcParamData%STFrlSkew + DstParamData%STFrlSkw2 = SrcParamData%STFrlSkw2 + DstParamData%STFrlTilt = SrcParamData%STFrlTilt + DstParamData%STFrlTlt2 = SrcParamData%STFrlTlt2 + DstParamData%TFrlPnt_n = SrcParamData%TFrlPnt_n + DstParamData%TipRad = SrcParamData%TipRad + DstParamData%TowerHt = SrcParamData%TowerHt + DstParamData%TowerBsHt = SrcParamData%TowerBsHt + DstParamData%UndSling = SrcParamData%UndSling + DstParamData%NumBl = SrcParamData%NumBl + if (allocated(SrcParamData%AxRedTFA)) then + LB(1:3) = lbound(SrcParamData%AxRedTFA) + UB(1:3) = ubound(SrcParamData%AxRedTFA) + if (.not. allocated(DstParamData%AxRedTFA)) then + allocate(DstParamData%AxRedTFA(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AxRedTFA.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%AxRedTFA = SrcParamData%AxRedTFA + end if + if (allocated(SrcParamData%AxRedTSS)) then + LB(1:3) = lbound(SrcParamData%AxRedTSS) + UB(1:3) = ubound(SrcParamData%AxRedTSS) + if (.not. allocated(DstParamData%AxRedTSS)) then + allocate(DstParamData%AxRedTSS(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AxRedTSS.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%AxRedTSS = SrcParamData%AxRedTSS + end if + DstParamData%CTFA = SrcParamData%CTFA + DstParamData%CTSS = SrcParamData%CTSS + if (allocated(SrcParamData%DHNodes)) then + LB(1:1) = lbound(SrcParamData%DHNodes) + UB(1:1) = ubound(SrcParamData%DHNodes) + if (.not. allocated(DstParamData%DHNodes)) then + allocate(DstParamData%DHNodes(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%DHNodes.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%DHNodes = SrcParamData%DHNodes + end if + if (allocated(SrcParamData%HNodes)) then + LB(1:1) = lbound(SrcParamData%HNodes) + UB(1:1) = ubound(SrcParamData%HNodes) + if (.not. allocated(DstParamData%HNodes)) then + allocate(DstParamData%HNodes(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%HNodes.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%HNodes = SrcParamData%HNodes + end if + if (allocated(SrcParamData%HNodesNorm)) then + LB(1:1) = lbound(SrcParamData%HNodesNorm) + UB(1:1) = ubound(SrcParamData%HNodesNorm) + if (.not. allocated(DstParamData%HNodesNorm)) then + allocate(DstParamData%HNodesNorm(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%HNodesNorm.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%HNodesNorm = SrcParamData%HNodesNorm + end if + DstParamData%KTFA = SrcParamData%KTFA + DstParamData%KTSS = SrcParamData%KTSS + if (allocated(SrcParamData%MassT)) then + LB(1:1) = lbound(SrcParamData%MassT) + UB(1:1) = ubound(SrcParamData%MassT) + if (.not. allocated(DstParamData%MassT)) then + allocate(DstParamData%MassT(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%MassT.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%MassT = SrcParamData%MassT + end if + if (allocated(SrcParamData%StiffTSS)) then + LB(1:1) = lbound(SrcParamData%StiffTSS) + UB(1:1) = ubound(SrcParamData%StiffTSS) + if (.not. allocated(DstParamData%StiffTSS)) then + allocate(DstParamData%StiffTSS(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%StiffTSS.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%StiffTSS = SrcParamData%StiffTSS + end if + if (allocated(SrcParamData%TwrFASF)) then + LB(1:3) = lbound(SrcParamData%TwrFASF) + UB(1:3) = ubound(SrcParamData%TwrFASF) + if (.not. allocated(DstParamData%TwrFASF)) then + allocate(DstParamData%TwrFASF(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TwrFASF.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%TwrFASF = SrcParamData%TwrFASF + end if + DstParamData%TwrFlexL = SrcParamData%TwrFlexL + if (allocated(SrcParamData%TwrSSSF)) then + LB(1:3) = lbound(SrcParamData%TwrSSSF) + UB(1:3) = ubound(SrcParamData%TwrSSSF) + if (.not. allocated(DstParamData%TwrSSSF)) then + allocate(DstParamData%TwrSSSF(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TwrSSSF.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%TwrSSSF = SrcParamData%TwrSSSF + end if + DstParamData%TTopNode = SrcParamData%TTopNode + DstParamData%TwrNodes = SrcParamData%TwrNodes + DstParamData%MHK = SrcParamData%MHK + if (allocated(SrcParamData%StiffTFA)) then + LB(1:1) = lbound(SrcParamData%StiffTFA) + UB(1:1) = ubound(SrcParamData%StiffTFA) + if (.not. allocated(DstParamData%StiffTFA)) then + allocate(DstParamData%StiffTFA(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%StiffTFA.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%StiffTFA = SrcParamData%StiffTFA + end if + DstParamData%AtfaIner = SrcParamData%AtfaIner + if (allocated(SrcParamData%BldCG)) then + LB(1:1) = lbound(SrcParamData%BldCG) + UB(1:1) = ubound(SrcParamData%BldCG) + if (.not. allocated(DstParamData%BldCG)) then + allocate(DstParamData%BldCG(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BldCG.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%BldCG = SrcParamData%BldCG + end if + if (allocated(SrcParamData%BldMass)) then + LB(1:1) = lbound(SrcParamData%BldMass) + UB(1:1) = ubound(SrcParamData%BldMass) + if (.not. allocated(DstParamData%BldMass)) then + allocate(DstParamData%BldMass(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BldMass.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%BldMass = SrcParamData%BldMass + end if + DstParamData%BoomMass = SrcParamData%BoomMass + if (allocated(SrcParamData%FirstMom)) then + LB(1:1) = lbound(SrcParamData%FirstMom) + UB(1:1) = ubound(SrcParamData%FirstMom) + if (.not. allocated(DstParamData%FirstMom)) then + allocate(DstParamData%FirstMom(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%FirstMom.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%FirstMom = SrcParamData%FirstMom + end if + DstParamData%GenIner = SrcParamData%GenIner + DstParamData%Hubg1Iner = SrcParamData%Hubg1Iner + DstParamData%Hubg2Iner = SrcParamData%Hubg2Iner + DstParamData%HubMass = SrcParamData%HubMass + DstParamData%Nacd2Iner = SrcParamData%Nacd2Iner + DstParamData%NacMass = SrcParamData%NacMass + DstParamData%PtfmMass = SrcParamData%PtfmMass + DstParamData%PtfmPIner = SrcParamData%PtfmPIner + DstParamData%PtfmRIner = SrcParamData%PtfmRIner + DstParamData%PtfmYIner = SrcParamData%PtfmYIner + DstParamData%PtfmXYIner = SrcParamData%PtfmXYIner + DstParamData%PtfmYZIner = SrcParamData%PtfmYZIner + DstParamData%PtfmXZIner = SrcParamData%PtfmXZIner + DstParamData%RFrlMass = SrcParamData%RFrlMass + DstParamData%RotIner = SrcParamData%RotIner + DstParamData%RotMass = SrcParamData%RotMass + DstParamData%RrfaIner = SrcParamData%RrfaIner + if (allocated(SrcParamData%SecondMom)) then + LB(1:1) = lbound(SrcParamData%SecondMom) + UB(1:1) = ubound(SrcParamData%SecondMom) + if (.not. allocated(DstParamData%SecondMom)) then + allocate(DstParamData%SecondMom(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%SecondMom.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%SecondMom = SrcParamData%SecondMom + end if + DstParamData%TFinMass = SrcParamData%TFinMass + DstParamData%TFrlIner = SrcParamData%TFrlIner + if (allocated(SrcParamData%TipMass)) then + LB(1:1) = lbound(SrcParamData%TipMass) + UB(1:1) = ubound(SrcParamData%TipMass) + if (.not. allocated(DstParamData%TipMass)) then + allocate(DstParamData%TipMass(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TipMass.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%TipMass = SrcParamData%TipMass + end if + DstParamData%TurbMass = SrcParamData%TurbMass + DstParamData%TwrMass = SrcParamData%TwrMass + DstParamData%TwrTpMass = SrcParamData%TwrTpMass + DstParamData%YawBrMass = SrcParamData%YawBrMass + DstParamData%Gravity = SrcParamData%Gravity + if (allocated(SrcParamData%PitchAxis)) then + LB(1:2) = lbound(SrcParamData%PitchAxis) + UB(1:2) = ubound(SrcParamData%PitchAxis) + if (.not. allocated(DstParamData%PitchAxis)) then + allocate(DstParamData%PitchAxis(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%PitchAxis.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%PitchAxis = SrcParamData%PitchAxis + end if + if (allocated(SrcParamData%AeroTwst)) then + LB(1:1) = lbound(SrcParamData%AeroTwst) + UB(1:1) = ubound(SrcParamData%AeroTwst) + if (.not. allocated(DstParamData%AeroTwst)) then + allocate(DstParamData%AeroTwst(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AeroTwst.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%AeroTwst = SrcParamData%AeroTwst + end if + if (allocated(SrcParamData%AxRedBld)) then + LB(1:4) = lbound(SrcParamData%AxRedBld) + UB(1:4) = ubound(SrcParamData%AxRedBld) + if (.not. allocated(DstParamData%AxRedBld)) then + allocate(DstParamData%AxRedBld(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AxRedBld.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%AxRedBld = SrcParamData%AxRedBld + end if + if (allocated(SrcParamData%BldEDamp)) then + LB(1:2) = lbound(SrcParamData%BldEDamp) + UB(1:2) = ubound(SrcParamData%BldEDamp) + if (.not. allocated(DstParamData%BldEDamp)) then + allocate(DstParamData%BldEDamp(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BldEDamp.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%BldEDamp = SrcParamData%BldEDamp + end if + if (allocated(SrcParamData%BldFDamp)) then + LB(1:2) = lbound(SrcParamData%BldFDamp) + UB(1:2) = ubound(SrcParamData%BldFDamp) + if (.not. allocated(DstParamData%BldFDamp)) then + allocate(DstParamData%BldFDamp(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BldFDamp.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%BldFDamp = SrcParamData%BldFDamp + end if + DstParamData%BldFlexL = SrcParamData%BldFlexL + if (allocated(SrcParamData%CAeroTwst)) then + LB(1:1) = lbound(SrcParamData%CAeroTwst) + UB(1:1) = ubound(SrcParamData%CAeroTwst) + if (.not. allocated(DstParamData%CAeroTwst)) then + allocate(DstParamData%CAeroTwst(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CAeroTwst.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%CAeroTwst = SrcParamData%CAeroTwst + end if + if (allocated(SrcParamData%CBE)) then + LB(1:3) = lbound(SrcParamData%CBE) + UB(1:3) = ubound(SrcParamData%CBE) + if (.not. allocated(DstParamData%CBE)) then + allocate(DstParamData%CBE(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CBE.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%CBE = SrcParamData%CBE + end if + if (allocated(SrcParamData%CBF)) then + LB(1:3) = lbound(SrcParamData%CBF) + UB(1:3) = ubound(SrcParamData%CBF) + if (.not. allocated(DstParamData%CBF)) then + allocate(DstParamData%CBF(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CBF.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%CBF = SrcParamData%CBF + end if + if (allocated(SrcParamData%Chord)) then + LB(1:1) = lbound(SrcParamData%Chord) + UB(1:1) = ubound(SrcParamData%Chord) + if (.not. allocated(DstParamData%Chord)) then + allocate(DstParamData%Chord(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Chord.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Chord = SrcParamData%Chord + end if + if (allocated(SrcParamData%CThetaS)) then + LB(1:2) = lbound(SrcParamData%CThetaS) + UB(1:2) = ubound(SrcParamData%CThetaS) + if (.not. allocated(DstParamData%CThetaS)) then + allocate(DstParamData%CThetaS(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CThetaS.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%CThetaS = SrcParamData%CThetaS + end if + if (allocated(SrcParamData%DRNodes)) then + LB(1:1) = lbound(SrcParamData%DRNodes) + UB(1:1) = ubound(SrcParamData%DRNodes) + if (.not. allocated(DstParamData%DRNodes)) then + allocate(DstParamData%DRNodes(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%DRNodes.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%DRNodes = SrcParamData%DRNodes + end if + if (allocated(SrcParamData%FStTunr)) then + LB(1:2) = lbound(SrcParamData%FStTunr) + UB(1:2) = ubound(SrcParamData%FStTunr) + if (.not. allocated(DstParamData%FStTunr)) then + allocate(DstParamData%FStTunr(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%FStTunr.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%FStTunr = SrcParamData%FStTunr + end if + if (allocated(SrcParamData%KBE)) then + LB(1:3) = lbound(SrcParamData%KBE) + UB(1:3) = ubound(SrcParamData%KBE) + if (.not. allocated(DstParamData%KBE)) then + allocate(DstParamData%KBE(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%KBE.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%KBE = SrcParamData%KBE + end if + if (allocated(SrcParamData%KBF)) then + LB(1:3) = lbound(SrcParamData%KBF) + UB(1:3) = ubound(SrcParamData%KBF) + if (.not. allocated(DstParamData%KBF)) then + allocate(DstParamData%KBF(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%KBF.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%KBF = SrcParamData%KBF + end if + if (allocated(SrcParamData%MassB)) then + LB(1:2) = lbound(SrcParamData%MassB) + UB(1:2) = ubound(SrcParamData%MassB) + if (.not. allocated(DstParamData%MassB)) then + allocate(DstParamData%MassB(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%MassB.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%MassB = SrcParamData%MassB + end if + if (allocated(SrcParamData%RNodes)) then + LB(1:1) = lbound(SrcParamData%RNodes) + UB(1:1) = ubound(SrcParamData%RNodes) + if (.not. allocated(DstParamData%RNodes)) then + allocate(DstParamData%RNodes(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%RNodes.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%RNodes = SrcParamData%RNodes + end if + if (allocated(SrcParamData%RNodesNorm)) then + LB(1:1) = lbound(SrcParamData%RNodesNorm) + UB(1:1) = ubound(SrcParamData%RNodesNorm) + if (.not. allocated(DstParamData%RNodesNorm)) then + allocate(DstParamData%RNodesNorm(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%RNodesNorm.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%RNodesNorm = SrcParamData%RNodesNorm + end if + if (allocated(SrcParamData%rSAerCenn1)) then + LB(1:2) = lbound(SrcParamData%rSAerCenn1) + UB(1:2) = ubound(SrcParamData%rSAerCenn1) + if (.not. allocated(DstParamData%rSAerCenn1)) then + allocate(DstParamData%rSAerCenn1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rSAerCenn1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%rSAerCenn1 = SrcParamData%rSAerCenn1 + end if + if (allocated(SrcParamData%rSAerCenn2)) then + LB(1:2) = lbound(SrcParamData%rSAerCenn2) + UB(1:2) = ubound(SrcParamData%rSAerCenn2) + if (.not. allocated(DstParamData%rSAerCenn2)) then + allocate(DstParamData%rSAerCenn2(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rSAerCenn2.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%rSAerCenn2 = SrcParamData%rSAerCenn2 + end if + if (allocated(SrcParamData%SAeroTwst)) then + LB(1:1) = lbound(SrcParamData%SAeroTwst) + UB(1:1) = ubound(SrcParamData%SAeroTwst) + if (.not. allocated(DstParamData%SAeroTwst)) then + allocate(DstParamData%SAeroTwst(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%SAeroTwst.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%SAeroTwst = SrcParamData%SAeroTwst + end if + if (allocated(SrcParamData%StiffBE)) then + LB(1:2) = lbound(SrcParamData%StiffBE) + UB(1:2) = ubound(SrcParamData%StiffBE) + if (.not. allocated(DstParamData%StiffBE)) then + allocate(DstParamData%StiffBE(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%StiffBE.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%StiffBE = SrcParamData%StiffBE + end if + if (allocated(SrcParamData%StiffBF)) then + LB(1:2) = lbound(SrcParamData%StiffBF) + UB(1:2) = ubound(SrcParamData%StiffBF) + if (.not. allocated(DstParamData%StiffBF)) then + allocate(DstParamData%StiffBF(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%StiffBF.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%StiffBF = SrcParamData%StiffBF + end if + if (allocated(SrcParamData%SThetaS)) then + LB(1:2) = lbound(SrcParamData%SThetaS) + UB(1:2) = ubound(SrcParamData%SThetaS) + if (.not. allocated(DstParamData%SThetaS)) then + allocate(DstParamData%SThetaS(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%SThetaS.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%SThetaS = SrcParamData%SThetaS + end if + if (allocated(SrcParamData%ThetaS)) then + LB(1:2) = lbound(SrcParamData%ThetaS) + UB(1:2) = ubound(SrcParamData%ThetaS) + if (.not. allocated(DstParamData%ThetaS)) then + allocate(DstParamData%ThetaS(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ThetaS.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%ThetaS = SrcParamData%ThetaS + end if + if (allocated(SrcParamData%TwistedSF)) then + LB(1:5) = lbound(SrcParamData%TwistedSF) + UB(1:5) = ubound(SrcParamData%TwistedSF) + if (.not. allocated(DstParamData%TwistedSF)) then + allocate(DstParamData%TwistedSF(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TwistedSF.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%TwistedSF = SrcParamData%TwistedSF + end if + if (allocated(SrcParamData%BldFl1Sh)) then + LB(1:2) = lbound(SrcParamData%BldFl1Sh) + UB(1:2) = ubound(SrcParamData%BldFl1Sh) + if (.not. allocated(DstParamData%BldFl1Sh)) then + allocate(DstParamData%BldFl1Sh(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BldFl1Sh.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%BldFl1Sh = SrcParamData%BldFl1Sh + end if + if (allocated(SrcParamData%BldFl2Sh)) then + LB(1:2) = lbound(SrcParamData%BldFl2Sh) + UB(1:2) = ubound(SrcParamData%BldFl2Sh) + if (.not. allocated(DstParamData%BldFl2Sh)) then + allocate(DstParamData%BldFl2Sh(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BldFl2Sh.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%BldFl2Sh = SrcParamData%BldFl2Sh + end if + if (allocated(SrcParamData%BldEdgSh)) then + LB(1:2) = lbound(SrcParamData%BldEdgSh) + UB(1:2) = ubound(SrcParamData%BldEdgSh) + if (.not. allocated(DstParamData%BldEdgSh)) then + allocate(DstParamData%BldEdgSh(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BldEdgSh.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%BldEdgSh = SrcParamData%BldEdgSh + end if + if (allocated(SrcParamData%FreqBE)) then + LB(1:3) = lbound(SrcParamData%FreqBE) + UB(1:3) = ubound(SrcParamData%FreqBE) + if (.not. allocated(DstParamData%FreqBE)) then + allocate(DstParamData%FreqBE(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%FreqBE.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%FreqBE = SrcParamData%FreqBE + end if + if (allocated(SrcParamData%FreqBF)) then + LB(1:3) = lbound(SrcParamData%FreqBF) + UB(1:3) = ubound(SrcParamData%FreqBF) + if (.not. allocated(DstParamData%FreqBF)) then + allocate(DstParamData%FreqBF(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%FreqBF.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%FreqBF = SrcParamData%FreqBF + end if + DstParamData%FreqTFA = SrcParamData%FreqTFA + DstParamData%FreqTSS = SrcParamData%FreqTSS + DstParamData%TeetCDmp = SrcParamData%TeetCDmp + DstParamData%TeetDmp = SrcParamData%TeetDmp + DstParamData%TeetDmpP = SrcParamData%TeetDmpP + DstParamData%TeetHSSp = SrcParamData%TeetHSSp + DstParamData%TeetHStP = SrcParamData%TeetHStP + DstParamData%TeetSSSp = SrcParamData%TeetSSSp + DstParamData%TeetSStP = SrcParamData%TeetSStP + DstParamData%TeetMod = SrcParamData%TeetMod + DstParamData%TFrlDmp = SrcParamData%TFrlDmp + DstParamData%TFrlDSDmp = SrcParamData%TFrlDSDmp + DstParamData%TFrlDSDP = SrcParamData%TFrlDSDP + DstParamData%TFrlDSSP = SrcParamData%TFrlDSSP + DstParamData%TFrlDSSpr = SrcParamData%TFrlDSSpr + DstParamData%TFrlSpr = SrcParamData%TFrlSpr + DstParamData%TFrlUSDmp = SrcParamData%TFrlUSDmp + DstParamData%TFrlUSDP = SrcParamData%TFrlUSDP + DstParamData%TFrlUSSP = SrcParamData%TFrlUSSP + DstParamData%TFrlUSSpr = SrcParamData%TFrlUSSpr + DstParamData%TFrlMod = SrcParamData%TFrlMod + DstParamData%RFrlDmp = SrcParamData%RFrlDmp + DstParamData%RFrlDSDmp = SrcParamData%RFrlDSDmp + DstParamData%RFrlDSDP = SrcParamData%RFrlDSDP + DstParamData%RFrlDSSP = SrcParamData%RFrlDSSP + DstParamData%RFrlDSSpr = SrcParamData%RFrlDSSpr + DstParamData%RFrlSpr = SrcParamData%RFrlSpr + DstParamData%RFrlUSDmp = SrcParamData%RFrlUSDmp + DstParamData%RFrlUSDP = SrcParamData%RFrlUSDP + DstParamData%RFrlUSSP = SrcParamData%RFrlUSSP + DstParamData%RFrlUSSpr = SrcParamData%RFrlUSSpr + DstParamData%RFrlMod = SrcParamData%RFrlMod + DstParamData%ShftGagL = SrcParamData%ShftGagL + DstParamData%BldGagNd = SrcParamData%BldGagNd + DstParamData%TwrGagNd = SrcParamData%TwrGagNd + DstParamData%TStart = SrcParamData%TStart + DstParamData%DTTorDmp = SrcParamData%DTTorDmp + DstParamData%DTTorSpr = SrcParamData%DTTorSpr + DstParamData%GBRatio = SrcParamData%GBRatio + DstParamData%GBoxEff = SrcParamData%GBoxEff + DstParamData%RotSpeed = SrcParamData%RotSpeed + DstParamData%RootName = SrcParamData%RootName + if (allocated(SrcParamData%BElmntMass)) then + LB(1:2) = lbound(SrcParamData%BElmntMass) + UB(1:2) = ubound(SrcParamData%BElmntMass) + if (.not. allocated(DstParamData%BElmntMass)) then + allocate(DstParamData%BElmntMass(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BElmntMass.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%BElmntMass = SrcParamData%BElmntMass + end if + if (allocated(SrcParamData%TElmntMass)) then + LB(1:1) = lbound(SrcParamData%TElmntMass) + UB(1:1) = ubound(SrcParamData%TElmntMass) + if (.not. allocated(DstParamData%TElmntMass)) then + allocate(DstParamData%TElmntMass(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TElmntMass.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%TElmntMass = SrcParamData%TElmntMass + end if + DstParamData%method = SrcParamData%method + DstParamData%PtfmCMxt = SrcParamData%PtfmCMxt + DstParamData%PtfmCMyt = SrcParamData%PtfmCMyt + DstParamData%BD4Blades = SrcParamData%BD4Blades + DstParamData%RigidAero = SrcParamData%RigidAero + DstParamData%YawFrctMod = SrcParamData%YawFrctMod + DstParamData%M_CD = SrcParamData%M_CD + DstParamData%M_FCD = SrcParamData%M_FCD + DstParamData%M_MCD = SrcParamData%M_MCD + DstParamData%M_CSMAX = SrcParamData%M_CSMAX + DstParamData%M_FCSMAX = SrcParamData%M_FCSMAX + DstParamData%M_MCSMAX = SrcParamData%M_MCSMAX + DstParamData%sig_v = SrcParamData%sig_v + DstParamData%sig_v2 = SrcParamData%sig_v2 + DstParamData%OmgCut = SrcParamData%OmgCut + DstParamData%BldNd_NumOuts = SrcParamData%BldNd_NumOuts + DstParamData%BldNd_TotNumOuts = SrcParamData%BldNd_TotNumOuts + if (allocated(SrcParamData%BldNd_OutParam)) then + LB(1:1) = lbound(SrcParamData%BldNd_OutParam) + UB(1:1) = ubound(SrcParamData%BldNd_OutParam) + if (.not. allocated(DstParamData%BldNd_OutParam)) then + allocate(DstParamData%BldNd_OutParam(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BldNd_OutParam.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyOutParmType(SrcParamData%BldNd_OutParam(i1), DstParamData%BldNd_OutParam(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + DstParamData%BldNd_BladesOut = SrcParamData%BldNd_BladesOut + call ED_CopyJac_u_idxStarts(SrcParamData%Jac_u_idxStartList, DstParamData%Jac_u_idxStartList, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call ED_CopyJac_y_idxStarts(SrcParamData%Jac_y_idxStartList, DstParamData%Jac_y_idxStartList, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcParamData%Jac_u_indx)) then + LB(1:2) = lbound(SrcParamData%Jac_u_indx) + UB(1:2) = ubound(SrcParamData%Jac_u_indx) + if (.not. allocated(DstParamData%Jac_u_indx)) then + allocate(DstParamData%Jac_u_indx(LB(1):UB(1),LB(2):UB(2)), 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 + end if + if (allocated(SrcParamData%du)) then + LB(1:1) = lbound(SrcParamData%du) + UB(1:1) = ubound(SrcParamData%du) + if (.not. allocated(DstParamData%du)) then + allocate(DstParamData%du(LB(1):UB(1)), 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 + end if + if (allocated(SrcParamData%dx)) then + LB(1:1) = lbound(SrcParamData%dx) + UB(1:1) = ubound(SrcParamData%dx) + if (.not. allocated(DstParamData%dx)) then + allocate(DstParamData%dx(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%dx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%dx = SrcParamData%dx + end if + DstParamData%Jac_ny = SrcParamData%Jac_ny + DstParamData%CompAeroMaps = SrcParamData%CompAeroMaps + DstParamData%NumExtendedInputs = SrcParamData%NumExtendedInputs + DstParamData%NumBl_Lin = SrcParamData%NumBl_Lin + DstParamData%NActvVelDOF_Lin = SrcParamData%NActvVelDOF_Lin + DstParamData%NActvDOF_Lin = SrcParamData%NActvDOF_Lin + DstParamData%NActvDOF_Stride = SrcParamData%NActvDOF_Stride +end subroutine + +subroutine ED_DestroyParam(ParamData, ErrStat, ErrMsg) + type(ED_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2, i3, i4, i5 + integer(B4Ki) :: LB(5), UB(5) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ED_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ParamData%PH)) then + deallocate(ParamData%PH) + end if + if (allocated(ParamData%PM)) then + deallocate(ParamData%PM) + end if + if (allocated(ParamData%DOF_Flag)) then + deallocate(ParamData%DOF_Flag) + end if + if (allocated(ParamData%DOF_Desc)) then + deallocate(ParamData%DOF_Desc) + end if + call ED_DestroyActiveDOFs(ParamData%DOFs, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(ParamData%OutParam)) then + LB(1:1) = lbound(ParamData%OutParam) + UB(1:1) = ubound(ParamData%OutParam) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyOutParmType(ParamData%OutParam(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%OutParam) + end if + if (allocated(ParamData%CosPreC)) then + deallocate(ParamData%CosPreC) + end if + if (allocated(ParamData%SinPreC)) then + deallocate(ParamData%SinPreC) + end if + if (allocated(ParamData%AxRedTFA)) then + deallocate(ParamData%AxRedTFA) + end if + if (allocated(ParamData%AxRedTSS)) then + deallocate(ParamData%AxRedTSS) + end if + if (allocated(ParamData%DHNodes)) then + deallocate(ParamData%DHNodes) + end if + if (allocated(ParamData%HNodes)) then + deallocate(ParamData%HNodes) + end if + if (allocated(ParamData%HNodesNorm)) then + deallocate(ParamData%HNodesNorm) + end if + if (allocated(ParamData%MassT)) then + deallocate(ParamData%MassT) + end if + if (allocated(ParamData%StiffTSS)) then + deallocate(ParamData%StiffTSS) + end if + if (allocated(ParamData%TwrFASF)) then + deallocate(ParamData%TwrFASF) + end if + if (allocated(ParamData%TwrSSSF)) then + deallocate(ParamData%TwrSSSF) + end if + if (allocated(ParamData%StiffTFA)) then + deallocate(ParamData%StiffTFA) + end if + if (allocated(ParamData%BldCG)) then + deallocate(ParamData%BldCG) + end if + if (allocated(ParamData%BldMass)) then + deallocate(ParamData%BldMass) + end if + if (allocated(ParamData%FirstMom)) then + deallocate(ParamData%FirstMom) + end if + if (allocated(ParamData%SecondMom)) then + deallocate(ParamData%SecondMom) + end if + if (allocated(ParamData%TipMass)) then + deallocate(ParamData%TipMass) + end if + if (allocated(ParamData%PitchAxis)) then + deallocate(ParamData%PitchAxis) + end if + if (allocated(ParamData%AeroTwst)) then + deallocate(ParamData%AeroTwst) + end if + if (allocated(ParamData%AxRedBld)) then + deallocate(ParamData%AxRedBld) + end if + if (allocated(ParamData%BldEDamp)) then + deallocate(ParamData%BldEDamp) + end if + if (allocated(ParamData%BldFDamp)) then + deallocate(ParamData%BldFDamp) + end if + if (allocated(ParamData%CAeroTwst)) then + deallocate(ParamData%CAeroTwst) + end if + if (allocated(ParamData%CBE)) then + deallocate(ParamData%CBE) + end if + if (allocated(ParamData%CBF)) then + deallocate(ParamData%CBF) + end if + if (allocated(ParamData%Chord)) then + deallocate(ParamData%Chord) + end if + if (allocated(ParamData%CThetaS)) then + deallocate(ParamData%CThetaS) + end if + if (allocated(ParamData%DRNodes)) then + deallocate(ParamData%DRNodes) + end if + if (allocated(ParamData%FStTunr)) then + deallocate(ParamData%FStTunr) + end if + if (allocated(ParamData%KBE)) then + deallocate(ParamData%KBE) + end if + if (allocated(ParamData%KBF)) then + deallocate(ParamData%KBF) + end if + if (allocated(ParamData%MassB)) then + deallocate(ParamData%MassB) + end if + if (allocated(ParamData%RNodes)) then + deallocate(ParamData%RNodes) + end if + if (allocated(ParamData%RNodesNorm)) then + deallocate(ParamData%RNodesNorm) + end if + if (allocated(ParamData%rSAerCenn1)) then + deallocate(ParamData%rSAerCenn1) + end if + if (allocated(ParamData%rSAerCenn2)) then + deallocate(ParamData%rSAerCenn2) + end if + if (allocated(ParamData%SAeroTwst)) then + deallocate(ParamData%SAeroTwst) + end if + if (allocated(ParamData%StiffBE)) then + deallocate(ParamData%StiffBE) + end if + if (allocated(ParamData%StiffBF)) then + deallocate(ParamData%StiffBF) + end if + if (allocated(ParamData%SThetaS)) then + deallocate(ParamData%SThetaS) + end if + if (allocated(ParamData%ThetaS)) then + deallocate(ParamData%ThetaS) + end if + if (allocated(ParamData%TwistedSF)) then + deallocate(ParamData%TwistedSF) + end if + if (allocated(ParamData%BldFl1Sh)) then + deallocate(ParamData%BldFl1Sh) + end if + if (allocated(ParamData%BldFl2Sh)) then + deallocate(ParamData%BldFl2Sh) + end if + if (allocated(ParamData%BldEdgSh)) then + deallocate(ParamData%BldEdgSh) + end if + if (allocated(ParamData%FreqBE)) then + deallocate(ParamData%FreqBE) + end if + if (allocated(ParamData%FreqBF)) then + deallocate(ParamData%FreqBF) + end if + if (allocated(ParamData%BElmntMass)) then + deallocate(ParamData%BElmntMass) + end if + if (allocated(ParamData%TElmntMass)) then + deallocate(ParamData%TElmntMass) + end if + if (allocated(ParamData%BldNd_OutParam)) then + LB(1:1) = lbound(ParamData%BldNd_OutParam) + UB(1:1) = ubound(ParamData%BldNd_OutParam) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyOutParmType(ParamData%BldNd_OutParam(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%BldNd_OutParam) + end if + call ED_DestroyJac_u_idxStarts(ParamData%Jac_u_idxStartList, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call ED_DestroyJac_y_idxStarts(ParamData%Jac_y_idxStartList, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(ParamData%Jac_u_indx)) then + deallocate(ParamData%Jac_u_indx) + end if + if (allocated(ParamData%du)) then + deallocate(ParamData%du) + end if + if (allocated(ParamData%dx)) then + deallocate(ParamData%dx) + end if +end subroutine + +subroutine ED_PackParam(RF, Indata) + type(RegFile), intent(inout) :: RF + type(ED_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ED_PackParam' + integer(B4Ki) :: i1, i2, i3, i4, i5 + integer(B4Ki) :: LB(5), UB(5) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DT) + call RegPack(RF, InData%DT24) + call RegPack(RF, InData%BldNodes) + call RegPack(RF, InData%TipNode) + call RegPack(RF, InData%NDOF) + call RegPack(RF, InData%TwoPiNB) + call RegPack(RF, InData%NAug) + call RegPack(RF, InData%NPH) + call RegPackAlloc(RF, InData%PH) + call RegPack(RF, InData%NPM) + call RegPackAlloc(RF, InData%PM) + call RegPackAlloc(RF, InData%DOF_Flag) + call RegPackAlloc(RF, InData%DOF_Desc) + call ED_PackActiveDOFs(RF, InData%DOFs) + call RegPack(RF, InData%NumOuts) + call RegPack(RF, InData%OutFmt) + call RegPack(RF, InData%NBlGages) + call RegPack(RF, InData%NTwGages) + call RegPack(RF, allocated(InData%OutParam)) + if (allocated(InData%OutParam)) then + call RegPackBounds(RF, 1, lbound(InData%OutParam), ubound(InData%OutParam)) + LB(1:1) = lbound(InData%OutParam) + UB(1:1) = ubound(InData%OutParam) + do i1 = LB(1), UB(1) + call NWTC_Library_PackOutParmType(RF, InData%OutParam(i1)) + end do + end if + call RegPack(RF, InData%Delim) + call RegPack(RF, InData%AvgNrmTpRd) + call RegPack(RF, InData%AzimB1Up) + call RegPack(RF, InData%CosDel3) + call RegPackAlloc(RF, InData%CosPreC) + call RegPack(RF, InData%CRFrlSkew) + call RegPack(RF, InData%CRFrlSkw2) + call RegPack(RF, InData%CRFrlTilt) + call RegPack(RF, InData%CRFrlTlt2) + call RegPack(RF, InData%CShftSkew) + call RegPack(RF, InData%CShftTilt) + call RegPack(RF, InData%CSRFrlSkw) + call RegPack(RF, InData%CSRFrlTlt) + call RegPack(RF, InData%CSTFrlSkw) + call RegPack(RF, InData%CSTFrlTlt) + call RegPack(RF, InData%CTFrlSkew) + call RegPack(RF, InData%CTFrlSkw2) + call RegPack(RF, InData%CTFrlTilt) + call RegPack(RF, InData%CTFrlTlt2) + call RegPack(RF, InData%HubHt) + call RegPack(RF, InData%HubCM) + call RegPack(RF, InData%HubRad) + call RegPack(RF, InData%NacCMxn) + call RegPack(RF, InData%NacCMyn) + call RegPack(RF, InData%NacCMzn) + call RegPack(RF, InData%OverHang) + call RegPack(RF, InData%ProjArea) + call RegPack(RF, InData%PtfmRefzt) + call RegPack(RF, InData%RefTwrHt) + call RegPack(RF, InData%RFrlPnt_n) + call RegPack(RF, InData%rVDxn) + call RegPack(RF, InData%rVDyn) + call RegPack(RF, InData%rVDzn) + call RegPack(RF, InData%rVIMUxn) + call RegPack(RF, InData%rVIMUyn) + call RegPack(RF, InData%rVIMUzn) + call RegPack(RF, InData%rVPxn) + call RegPack(RF, InData%rVPyn) + call RegPack(RF, InData%rVPzn) + call RegPack(RF, InData%rWIxn) + call RegPack(RF, InData%rWIyn) + call RegPack(RF, InData%rWIzn) + call RegPack(RF, InData%rWJxn) + call RegPack(RF, InData%rWJyn) + call RegPack(RF, InData%rWJzn) + call RegPack(RF, InData%rZT0zt) + call RegPack(RF, InData%rZYzt) + call RegPack(RF, InData%SinDel3) + call RegPackAlloc(RF, InData%SinPreC) + call RegPack(RF, InData%SRFrlSkew) + call RegPack(RF, InData%SRFrlSkw2) + call RegPack(RF, InData%SRFrlTilt) + call RegPack(RF, InData%SRFrlTlt2) + call RegPack(RF, InData%SShftSkew) + call RegPack(RF, InData%SShftTilt) + call RegPack(RF, InData%STFrlSkew) + call RegPack(RF, InData%STFrlSkw2) + call RegPack(RF, InData%STFrlTilt) + call RegPack(RF, InData%STFrlTlt2) + call RegPack(RF, InData%TFrlPnt_n) + call RegPack(RF, InData%TipRad) + call RegPack(RF, InData%TowerHt) + call RegPack(RF, InData%TowerBsHt) + call RegPack(RF, InData%UndSling) + call RegPack(RF, InData%NumBl) + call RegPackAlloc(RF, InData%AxRedTFA) + call RegPackAlloc(RF, InData%AxRedTSS) + call RegPack(RF, InData%CTFA) + call RegPack(RF, InData%CTSS) + call RegPackAlloc(RF, InData%DHNodes) + call RegPackAlloc(RF, InData%HNodes) + call RegPackAlloc(RF, InData%HNodesNorm) + call RegPack(RF, InData%KTFA) + call RegPack(RF, InData%KTSS) + call RegPackAlloc(RF, InData%MassT) + call RegPackAlloc(RF, InData%StiffTSS) + call RegPackAlloc(RF, InData%TwrFASF) + call RegPack(RF, InData%TwrFlexL) + call RegPackAlloc(RF, InData%TwrSSSF) + call RegPack(RF, InData%TTopNode) + call RegPack(RF, InData%TwrNodes) + call RegPack(RF, InData%MHK) + call RegPackAlloc(RF, InData%StiffTFA) + call RegPack(RF, InData%AtfaIner) + call RegPackAlloc(RF, InData%BldCG) + call RegPackAlloc(RF, InData%BldMass) + call RegPack(RF, InData%BoomMass) + call RegPackAlloc(RF, InData%FirstMom) + call RegPack(RF, InData%GenIner) + call RegPack(RF, InData%Hubg1Iner) + call RegPack(RF, InData%Hubg2Iner) + call RegPack(RF, InData%HubMass) + call RegPack(RF, InData%Nacd2Iner) + call RegPack(RF, InData%NacMass) + call RegPack(RF, InData%PtfmMass) + call RegPack(RF, InData%PtfmPIner) + call RegPack(RF, InData%PtfmRIner) + call RegPack(RF, InData%PtfmYIner) + call RegPack(RF, InData%PtfmXYIner) + call RegPack(RF, InData%PtfmYZIner) + call RegPack(RF, InData%PtfmXZIner) + call RegPack(RF, InData%RFrlMass) + call RegPack(RF, InData%RotIner) + call RegPack(RF, InData%RotMass) + call RegPack(RF, InData%RrfaIner) + call RegPackAlloc(RF, InData%SecondMom) + call RegPack(RF, InData%TFinMass) + call RegPack(RF, InData%TFrlIner) + call RegPackAlloc(RF, InData%TipMass) + call RegPack(RF, InData%TurbMass) + call RegPack(RF, InData%TwrMass) + call RegPack(RF, InData%TwrTpMass) + call RegPack(RF, InData%YawBrMass) + call RegPack(RF, InData%Gravity) + call RegPackAlloc(RF, InData%PitchAxis) + call RegPackAlloc(RF, InData%AeroTwst) + call RegPackAlloc(RF, InData%AxRedBld) + call RegPackAlloc(RF, InData%BldEDamp) + call RegPackAlloc(RF, InData%BldFDamp) + call RegPack(RF, InData%BldFlexL) + call RegPackAlloc(RF, InData%CAeroTwst) + call RegPackAlloc(RF, InData%CBE) + call RegPackAlloc(RF, InData%CBF) + call RegPackAlloc(RF, InData%Chord) + call RegPackAlloc(RF, InData%CThetaS) + call RegPackAlloc(RF, InData%DRNodes) + call RegPackAlloc(RF, InData%FStTunr) + call RegPackAlloc(RF, InData%KBE) + call RegPackAlloc(RF, InData%KBF) + call RegPackAlloc(RF, InData%MassB) + call RegPackAlloc(RF, InData%RNodes) + call RegPackAlloc(RF, InData%RNodesNorm) + call RegPackAlloc(RF, InData%rSAerCenn1) + call RegPackAlloc(RF, InData%rSAerCenn2) + call RegPackAlloc(RF, InData%SAeroTwst) + call RegPackAlloc(RF, InData%StiffBE) + call RegPackAlloc(RF, InData%StiffBF) + call RegPackAlloc(RF, InData%SThetaS) + call RegPackAlloc(RF, InData%ThetaS) + call RegPackAlloc(RF, InData%TwistedSF) + call RegPackAlloc(RF, InData%BldFl1Sh) + call RegPackAlloc(RF, InData%BldFl2Sh) + call RegPackAlloc(RF, InData%BldEdgSh) + call RegPackAlloc(RF, InData%FreqBE) + call RegPackAlloc(RF, InData%FreqBF) + call RegPack(RF, InData%FreqTFA) + call RegPack(RF, InData%FreqTSS) + call RegPack(RF, InData%TeetCDmp) + call RegPack(RF, InData%TeetDmp) + call RegPack(RF, InData%TeetDmpP) + call RegPack(RF, InData%TeetHSSp) + call RegPack(RF, InData%TeetHStP) + call RegPack(RF, InData%TeetSSSp) + call RegPack(RF, InData%TeetSStP) + call RegPack(RF, InData%TeetMod) + call RegPack(RF, InData%TFrlDmp) + call RegPack(RF, InData%TFrlDSDmp) + call RegPack(RF, InData%TFrlDSDP) + call RegPack(RF, InData%TFrlDSSP) + call RegPack(RF, InData%TFrlDSSpr) + call RegPack(RF, InData%TFrlSpr) + call RegPack(RF, InData%TFrlUSDmp) + call RegPack(RF, InData%TFrlUSDP) + call RegPack(RF, InData%TFrlUSSP) + call RegPack(RF, InData%TFrlUSSpr) + call RegPack(RF, InData%TFrlMod) + call RegPack(RF, InData%RFrlDmp) + call RegPack(RF, InData%RFrlDSDmp) + call RegPack(RF, InData%RFrlDSDP) + call RegPack(RF, InData%RFrlDSSP) + call RegPack(RF, InData%RFrlDSSpr) + call RegPack(RF, InData%RFrlSpr) + call RegPack(RF, InData%RFrlUSDmp) + call RegPack(RF, InData%RFrlUSDP) + call RegPack(RF, InData%RFrlUSSP) + call RegPack(RF, InData%RFrlUSSpr) + call RegPack(RF, InData%RFrlMod) + call RegPack(RF, InData%ShftGagL) + call RegPack(RF, InData%BldGagNd) + call RegPack(RF, InData%TwrGagNd) + call RegPack(RF, InData%TStart) + call RegPack(RF, InData%DTTorDmp) + call RegPack(RF, InData%DTTorSpr) + call RegPack(RF, InData%GBRatio) + call RegPack(RF, InData%GBoxEff) + call RegPack(RF, InData%RotSpeed) + call RegPack(RF, InData%RootName) + call RegPackAlloc(RF, InData%BElmntMass) + call RegPackAlloc(RF, InData%TElmntMass) + call RegPack(RF, InData%method) + call RegPack(RF, InData%PtfmCMxt) + call RegPack(RF, InData%PtfmCMyt) + call RegPack(RF, InData%BD4Blades) + call RegPack(RF, InData%RigidAero) + call RegPack(RF, InData%YawFrctMod) + call RegPack(RF, InData%M_CD) + call RegPack(RF, InData%M_FCD) + call RegPack(RF, InData%M_MCD) + call RegPack(RF, InData%M_CSMAX) + call RegPack(RF, InData%M_FCSMAX) + call RegPack(RF, InData%M_MCSMAX) + call RegPack(RF, InData%sig_v) + call RegPack(RF, InData%sig_v2) + call RegPack(RF, InData%OmgCut) + call RegPack(RF, InData%BldNd_NumOuts) + call RegPack(RF, InData%BldNd_TotNumOuts) + call RegPack(RF, allocated(InData%BldNd_OutParam)) + if (allocated(InData%BldNd_OutParam)) then + call RegPackBounds(RF, 1, lbound(InData%BldNd_OutParam), ubound(InData%BldNd_OutParam)) + LB(1:1) = lbound(InData%BldNd_OutParam) + UB(1:1) = ubound(InData%BldNd_OutParam) + do i1 = LB(1), UB(1) + call NWTC_Library_PackOutParmType(RF, InData%BldNd_OutParam(i1)) + end do + end if + call RegPack(RF, InData%BldNd_BladesOut) + call ED_PackJac_u_idxStarts(RF, InData%Jac_u_idxStartList) + call ED_PackJac_y_idxStarts(RF, InData%Jac_y_idxStartList) + call RegPackAlloc(RF, InData%Jac_u_indx) + call RegPackAlloc(RF, InData%du) + call RegPackAlloc(RF, InData%dx) + call RegPack(RF, InData%Jac_ny) + call RegPack(RF, InData%CompAeroMaps) + call RegPack(RF, InData%NumExtendedInputs) + call RegPack(RF, InData%NumBl_Lin) + call RegPack(RF, InData%NActvVelDOF_Lin) + call RegPack(RF, InData%NActvDOF_Lin) + call RegPack(RF, InData%NActvDOF_Stride) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ED_UnPackParam(RF, OutData) + type(RegFile), intent(inout) :: RF + type(ED_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ED_UnPackParam' + integer(B4Ki) :: i1, i2, i3, i4, i5 + integer(B4Ki) :: LB(5), UB(5) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DT24); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BldNodes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TipNode); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NDOF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TwoPiNB); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NAug); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NPH); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PH); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NPM); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PM); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%DOF_Flag); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%DOF_Desc); if (RegCheckErr(RF, RoutineName)) return + call ED_UnpackActiveDOFs(RF, OutData%DOFs) ! DOFs + call RegUnpack(RF, OutData%NumOuts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutFmt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NBlGages); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NTwGages); if (RegCheckErr(RF, RoutineName)) return + if (allocated(OutData%OutParam)) deallocate(OutData%OutParam) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%OutParam(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackOutParmType(RF, OutData%OutParam(i1)) ! OutParam + end do + end if + call RegUnpack(RF, OutData%Delim); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AvgNrmTpRd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AzimB1Up); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CosDel3); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%CosPreC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CRFrlSkew); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CRFrlSkw2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CRFrlTilt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CRFrlTlt2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CShftSkew); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CShftTilt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CSRFrlSkw); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CSRFrlTlt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CSTFrlSkw); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CSTFrlTlt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CTFrlSkew); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CTFrlSkw2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CTFrlTilt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CTFrlTlt2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HubHt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HubCM); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HubRad); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NacCMxn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NacCMyn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NacCMzn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OverHang); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ProjArea); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PtfmRefzt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RefTwrHt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RFrlPnt_n); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rVDxn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rVDyn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rVDzn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rVIMUxn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rVIMUyn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rVIMUzn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rVPxn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rVPyn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rVPzn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rWIxn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rWIyn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rWIzn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rWJxn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rWJyn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rWJzn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rZT0zt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rZYzt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SinDel3); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%SinPreC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SRFrlSkew); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SRFrlSkw2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SRFrlTilt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SRFrlTlt2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SShftSkew); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SShftTilt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%STFrlSkew); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%STFrlSkw2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%STFrlTilt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%STFrlTlt2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFrlPnt_n); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TipRad); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TowerHt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TowerBsHt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UndSling); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumBl); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AxRedTFA); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AxRedTSS); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CTFA); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CTSS); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%DHNodes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%HNodes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%HNodesNorm); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%KTFA); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%KTSS); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%MassT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%StiffTSS); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TwrFASF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TwrFlexL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TwrSSSF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TTopNode); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TwrNodes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MHK); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%StiffTFA); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AtfaIner); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BldCG); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BldMass); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BoomMass); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%FirstMom); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GenIner); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Hubg1Iner); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Hubg2Iner); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HubMass); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Nacd2Iner); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NacMass); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PtfmMass); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PtfmPIner); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PtfmRIner); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PtfmYIner); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PtfmXYIner); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PtfmYZIner); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PtfmXZIner); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RFrlMass); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RotIner); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RotMass); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RrfaIner); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%SecondMom); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFinMass); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFrlIner); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TipMass); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TurbMass); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TwrMass); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TwrTpMass); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawBrMass); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Gravity); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PitchAxis); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AeroTwst); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AxRedBld); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BldEDamp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BldFDamp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BldFlexL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%CAeroTwst); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%CBE); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%CBF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Chord); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%CThetaS); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%DRNodes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%FStTunr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%KBE); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%KBF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%MassB); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%RNodes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%RNodesNorm); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%rSAerCenn1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%rSAerCenn2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%SAeroTwst); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%StiffBE); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%StiffBF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%SThetaS); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ThetaS); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TwistedSF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BldFl1Sh); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BldFl2Sh); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BldEdgSh); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%FreqBE); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%FreqBF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FreqTFA); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FreqTSS); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TeetCDmp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TeetDmp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TeetDmpP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TeetHSSp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TeetHStP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TeetSSSp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TeetSStP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TeetMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFrlDmp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFrlDSDmp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFrlDSDP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFrlDSSP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFrlDSSpr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFrlSpr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFrlUSDmp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFrlUSDP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFrlUSSP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFrlUSSpr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFrlMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RFrlDmp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RFrlDSDmp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RFrlDSDP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RFrlDSSP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RFrlDSSpr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RFrlSpr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RFrlUSDmp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RFrlUSDP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RFrlUSSP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RFrlUSSpr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RFrlMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ShftGagL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BldGagNd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TwrGagNd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TStart); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DTTorDmp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DTTorSpr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GBRatio); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GBoxEff); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RotSpeed); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RootName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BElmntMass); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TElmntMass); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%method); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PtfmCMxt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PtfmCMyt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BD4Blades); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RigidAero); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawFrctMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%M_CD); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%M_FCD); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%M_MCD); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%M_CSMAX); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%M_FCSMAX); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%M_MCSMAX); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%sig_v); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%sig_v2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OmgCut); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BldNd_NumOuts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BldNd_TotNumOuts); if (RegCheckErr(RF, RoutineName)) return + if (allocated(OutData%BldNd_OutParam)) deallocate(OutData%BldNd_OutParam) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%BldNd_OutParam(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldNd_OutParam.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackOutParmType(RF, OutData%BldNd_OutParam(i1)) ! BldNd_OutParam + end do + end if + call RegUnpack(RF, OutData%BldNd_BladesOut); if (RegCheckErr(RF, RoutineName)) return + call ED_UnpackJac_u_idxStarts(RF, OutData%Jac_u_idxStartList) ! Jac_u_idxStartList + call ED_UnpackJac_y_idxStarts(RF, OutData%Jac_y_idxStartList) ! Jac_y_idxStartList + call RegUnpackAlloc(RF, OutData%Jac_u_indx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%du); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Jac_ny); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CompAeroMaps); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumExtendedInputs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumBl_Lin); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NActvVelDOF_Lin); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NActvDOF_Lin); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NActvDOF_Stride); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ED_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) + type(ED_InputType), intent(inout) :: SrcInputData + type(ED_InputType), intent(inout) :: DstInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ED_CopyInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcInputData%BladePtLoads)) then + LB(1:1) = lbound(SrcInputData%BladePtLoads) + UB(1:1) = ubound(SrcInputData%BladePtLoads) + if (.not. allocated(DstInputData%BladePtLoads)) then + allocate(DstInputData%BladePtLoads(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%BladePtLoads.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MeshCopy(SrcInputData%BladePtLoads(i1), DstInputData%BladePtLoads(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call MeshCopy(SrcInputData%PlatformPtMesh, DstInputData%PlatformPtMesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcInputData%TowerPtLoads, DstInputData%TowerPtLoads, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcInputData%HubPtLoad, DstInputData%HubPtLoad, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcInputData%NacelleLoads, DstInputData%NacelleLoads, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcInputData%TFinCMLoads, DstInputData%TFinCMLoads, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcInputData%TwrAddedMass)) then + LB(1:3) = lbound(SrcInputData%TwrAddedMass) + UB(1:3) = ubound(SrcInputData%TwrAddedMass) + if (.not. allocated(DstInputData%TwrAddedMass)) then + allocate(DstInputData%TwrAddedMass(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%TwrAddedMass.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%TwrAddedMass = SrcInputData%TwrAddedMass + end if + DstInputData%PtfmAddedMass = SrcInputData%PtfmAddedMass + if (allocated(SrcInputData%BlPitchCom)) then + LB(1:1) = lbound(SrcInputData%BlPitchCom) + UB(1:1) = ubound(SrcInputData%BlPitchCom) + if (.not. allocated(DstInputData%BlPitchCom)) then + allocate(DstInputData%BlPitchCom(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%BlPitchCom.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%BlPitchCom = SrcInputData%BlPitchCom + end if + DstInputData%YawMom = SrcInputData%YawMom + DstInputData%GenTrq = SrcInputData%GenTrq + DstInputData%HSSBrTrqC = SrcInputData%HSSBrTrqC +end subroutine + +subroutine ED_DestroyInput(InputData, ErrStat, ErrMsg) + type(ED_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ED_DestroyInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InputData%BladePtLoads)) then + LB(1:1) = lbound(InputData%BladePtLoads) + UB(1:1) = ubound(InputData%BladePtLoads) + do i1 = LB(1), UB(1) + call MeshDestroy( InputData%BladePtLoads(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InputData%BladePtLoads) + end if + call MeshDestroy( InputData%PlatformPtMesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( InputData%TowerPtLoads, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( InputData%HubPtLoad, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( InputData%NacelleLoads, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( InputData%TFinCMLoads, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(InputData%TwrAddedMass)) then + deallocate(InputData%TwrAddedMass) + end if + if (allocated(InputData%BlPitchCom)) then + deallocate(InputData%BlPitchCom) + end if +end subroutine + +subroutine ED_PackInput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(ED_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ED_PackInput' + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%BladePtLoads)) + if (allocated(InData%BladePtLoads)) then + call RegPackBounds(RF, 1, lbound(InData%BladePtLoads), ubound(InData%BladePtLoads)) + LB(1:1) = lbound(InData%BladePtLoads) + UB(1:1) = ubound(InData%BladePtLoads) + do i1 = LB(1), UB(1) + call MeshPack(RF, InData%BladePtLoads(i1)) + end do + end if + call MeshPack(RF, InData%PlatformPtMesh) + call MeshPack(RF, InData%TowerPtLoads) + call MeshPack(RF, InData%HubPtLoad) + call MeshPack(RF, InData%NacelleLoads) + call MeshPack(RF, InData%TFinCMLoads) + call RegPackAlloc(RF, InData%TwrAddedMass) + call RegPack(RF, InData%PtfmAddedMass) + call RegPackAlloc(RF, InData%BlPitchCom) + call RegPack(RF, InData%YawMom) + call RegPack(RF, InData%GenTrq) + call RegPack(RF, InData%HSSBrTrqC) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ED_UnPackInput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(ED_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ED_UnPackInput' + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + if (allocated(OutData%BladePtLoads)) deallocate(OutData%BladePtLoads) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%BladePtLoads(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladePtLoads.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(RF, OutData%BladePtLoads(i1)) ! BladePtLoads + end do + end if + call MeshUnpack(RF, OutData%PlatformPtMesh) ! PlatformPtMesh + call MeshUnpack(RF, OutData%TowerPtLoads) ! TowerPtLoads + call MeshUnpack(RF, OutData%HubPtLoad) ! HubPtLoad + call MeshUnpack(RF, OutData%NacelleLoads) ! NacelleLoads + call MeshUnpack(RF, OutData%TFinCMLoads) ! TFinCMLoads + call RegUnpackAlloc(RF, OutData%TwrAddedMass); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PtfmAddedMass); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BlPitchCom); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawMom); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GenTrq); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HSSBrTrqC); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ED_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(ED_OutputType), intent(inout) :: SrcOutputData + type(ED_OutputType), intent(inout) :: DstOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ED_CopyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcOutputData%BladeLn2Mesh)) then + LB(1:1) = lbound(SrcOutputData%BladeLn2Mesh) + UB(1:1) = ubound(SrcOutputData%BladeLn2Mesh) + if (.not. allocated(DstOutputData%BladeLn2Mesh)) then + allocate(DstOutputData%BladeLn2Mesh(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%BladeLn2Mesh.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MeshCopy(SrcOutputData%BladeLn2Mesh(i1), DstOutputData%BladeLn2Mesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call MeshCopy(SrcOutputData%PlatformPtMesh, DstOutputData%PlatformPtMesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcOutputData%TowerLn2Mesh, DstOutputData%TowerLn2Mesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcOutputData%HubPtMotion, DstOutputData%HubPtMotion, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcOutputData%BladeRootMotion)) then + LB(1:1) = lbound(SrcOutputData%BladeRootMotion) + UB(1:1) = ubound(SrcOutputData%BladeRootMotion) + if (.not. allocated(DstOutputData%BladeRootMotion)) then + allocate(DstOutputData%BladeRootMotion(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%BladeRootMotion.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MeshCopy(SrcOutputData%BladeRootMotion(i1), DstOutputData%BladeRootMotion(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call MeshCopy(SrcOutputData%NacelleMotion, DstOutputData%NacelleMotion, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcOutputData%TFinCMMotion, DstOutputData%TFinCMMotion, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcOutputData%WriteOutput)) then + LB(1:1) = lbound(SrcOutputData%WriteOutput) + UB(1:1) = ubound(SrcOutputData%WriteOutput) + if (.not. allocated(DstOutputData%WriteOutput)) then + allocate(DstOutputData%WriteOutput(LB(1):UB(1)), 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 + end if + if (allocated(SrcOutputData%BlPitch)) then + LB(1:1) = lbound(SrcOutputData%BlPitch) + UB(1:1) = ubound(SrcOutputData%BlPitch) + if (.not. allocated(DstOutputData%BlPitch)) then + allocate(DstOutputData%BlPitch(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%BlPitch.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%BlPitch = SrcOutputData%BlPitch + end if + DstOutputData%Yaw = SrcOutputData%Yaw + DstOutputData%YawRate = SrcOutputData%YawRate + DstOutputData%LSS_Spd = SrcOutputData%LSS_Spd + DstOutputData%HSS_Spd = SrcOutputData%HSS_Spd + DstOutputData%RotSpeed = SrcOutputData%RotSpeed + DstOutputData%TwrAccel = SrcOutputData%TwrAccel + DstOutputData%YawAngle = SrcOutputData%YawAngle + DstOutputData%RootMyc = SrcOutputData%RootMyc + DstOutputData%YawBrTAxp = SrcOutputData%YawBrTAxp + DstOutputData%YawBrTAyp = SrcOutputData%YawBrTAyp + DstOutputData%LSSTipPxa = SrcOutputData%LSSTipPxa + DstOutputData%RootMxc = SrcOutputData%RootMxc + DstOutputData%LSSTipMxa = SrcOutputData%LSSTipMxa + DstOutputData%LSSTipMya = SrcOutputData%LSSTipMya + DstOutputData%LSSTipMza = SrcOutputData%LSSTipMza + DstOutputData%LSSTipMys = SrcOutputData%LSSTipMys + DstOutputData%LSSTipMzs = SrcOutputData%LSSTipMzs + DstOutputData%YawBrMyn = SrcOutputData%YawBrMyn + DstOutputData%YawBrMzn = SrcOutputData%YawBrMzn + DstOutputData%NcIMURAxs = SrcOutputData%NcIMURAxs + DstOutputData%NcIMURAys = SrcOutputData%NcIMURAys + DstOutputData%NcIMURAzs = SrcOutputData%NcIMURAzs + DstOutputData%RotPwr = SrcOutputData%RotPwr + DstOutputData%LSShftFxa = SrcOutputData%LSShftFxa + DstOutputData%LSShftFys = SrcOutputData%LSShftFys + DstOutputData%LSShftFzs = SrcOutputData%LSShftFzs +end subroutine + +subroutine ED_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(ED_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ED_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OutputData%BladeLn2Mesh)) then + LB(1:1) = lbound(OutputData%BladeLn2Mesh) + UB(1:1) = ubound(OutputData%BladeLn2Mesh) + do i1 = LB(1), UB(1) + call MeshDestroy( OutputData%BladeLn2Mesh(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(OutputData%BladeLn2Mesh) + end if + call MeshDestroy( OutputData%PlatformPtMesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( OutputData%TowerLn2Mesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( OutputData%HubPtMotion, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(OutputData%BladeRootMotion)) then + LB(1:1) = lbound(OutputData%BladeRootMotion) + UB(1:1) = ubound(OutputData%BladeRootMotion) + do i1 = LB(1), UB(1) + call MeshDestroy( OutputData%BladeRootMotion(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(OutputData%BladeRootMotion) + end if + call MeshDestroy( OutputData%NacelleMotion, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( OutputData%TFinCMMotion, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(OutputData%WriteOutput)) then + deallocate(OutputData%WriteOutput) + end if + if (allocated(OutputData%BlPitch)) then + deallocate(OutputData%BlPitch) + end if +end subroutine + +subroutine ED_PackOutput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(ED_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ED_PackOutput' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%BladeLn2Mesh)) + if (allocated(InData%BladeLn2Mesh)) then + call RegPackBounds(RF, 1, lbound(InData%BladeLn2Mesh), ubound(InData%BladeLn2Mesh)) + LB(1:1) = lbound(InData%BladeLn2Mesh) + UB(1:1) = ubound(InData%BladeLn2Mesh) + do i1 = LB(1), UB(1) + call MeshPack(RF, InData%BladeLn2Mesh(i1)) + end do + end if + call MeshPack(RF, InData%PlatformPtMesh) + call MeshPack(RF, InData%TowerLn2Mesh) + call MeshPack(RF, InData%HubPtMotion) + call RegPack(RF, allocated(InData%BladeRootMotion)) + if (allocated(InData%BladeRootMotion)) then + call RegPackBounds(RF, 1, lbound(InData%BladeRootMotion), ubound(InData%BladeRootMotion)) + LB(1:1) = lbound(InData%BladeRootMotion) + UB(1:1) = ubound(InData%BladeRootMotion) + do i1 = LB(1), UB(1) + call MeshPack(RF, InData%BladeRootMotion(i1)) + end do + end if + call MeshPack(RF, InData%NacelleMotion) + call MeshPack(RF, InData%TFinCMMotion) + call RegPackAlloc(RF, InData%WriteOutput) + call RegPackAlloc(RF, InData%BlPitch) + call RegPack(RF, InData%Yaw) + call RegPack(RF, InData%YawRate) + call RegPack(RF, InData%LSS_Spd) + call RegPack(RF, InData%HSS_Spd) + call RegPack(RF, InData%RotSpeed) + call RegPack(RF, InData%TwrAccel) + call RegPack(RF, InData%YawAngle) + call RegPack(RF, InData%RootMyc) + call RegPack(RF, InData%YawBrTAxp) + call RegPack(RF, InData%YawBrTAyp) + call RegPack(RF, InData%LSSTipPxa) + call RegPack(RF, InData%RootMxc) + call RegPack(RF, InData%LSSTipMxa) + call RegPack(RF, InData%LSSTipMya) + call RegPack(RF, InData%LSSTipMza) + call RegPack(RF, InData%LSSTipMys) + call RegPack(RF, InData%LSSTipMzs) + call RegPack(RF, InData%YawBrMyn) + call RegPack(RF, InData%YawBrMzn) + call RegPack(RF, InData%NcIMURAxs) + call RegPack(RF, InData%NcIMURAys) + call RegPack(RF, InData%NcIMURAzs) + call RegPack(RF, InData%RotPwr) + call RegPack(RF, InData%LSShftFxa) + call RegPack(RF, InData%LSShftFys) + call RegPack(RF, InData%LSShftFzs) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ED_UnPackOutput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(ED_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ED_UnPackOutput' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + if (allocated(OutData%BladeLn2Mesh)) deallocate(OutData%BladeLn2Mesh) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%BladeLn2Mesh(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeLn2Mesh.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(RF, OutData%BladeLn2Mesh(i1)) ! BladeLn2Mesh + end do + end if + call MeshUnpack(RF, OutData%PlatformPtMesh) ! PlatformPtMesh + call MeshUnpack(RF, OutData%TowerLn2Mesh) ! TowerLn2Mesh + call MeshUnpack(RF, OutData%HubPtMotion) ! HubPtMotion + if (allocated(OutData%BladeRootMotion)) deallocate(OutData%BladeRootMotion) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%BladeRootMotion(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeRootMotion.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(RF, OutData%BladeRootMotion(i1)) ! BladeRootMotion + end do + end if + call MeshUnpack(RF, OutData%NacelleMotion) ! NacelleMotion + call MeshUnpack(RF, OutData%TFinCMMotion) ! TFinCMMotion + call RegUnpackAlloc(RF, OutData%WriteOutput); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BlPitch); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Yaw); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawRate); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LSS_Spd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HSS_Spd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RotSpeed); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TwrAccel); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawAngle); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RootMyc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawBrTAxp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawBrTAyp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LSSTipPxa); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RootMxc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LSSTipMxa); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LSSTipMya); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LSSTipMza); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LSSTipMys); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LSSTipMzs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawBrMyn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawBrMzn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NcIMURAxs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NcIMURAys); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NcIMURAzs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RotPwr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LSShftFxa); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LSShftFys); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LSShftFzs); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ED_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(ED_InputType), intent(inout) :: u(:) ! Input at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Inputs + type(ED_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 = 'ED_Input_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(u)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(u)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(u) - 1 + select case (order) + case (0) + call ED_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call ED_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call ED_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(u) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE ED_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 +! +!.................................................................................................................................. - SUBROUTINE ED_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ED_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(ED_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) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_CopyInitOutput' -! + TYPE(ED_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 + TYPE(ED_InputType), INTENT(INOUT) :: u2 ! Input at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs + TYPE(ED_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 = 'ED_Input_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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 :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i03 ! dim3 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 counter variable for arrays + INTEGER :: i3 ! dim3 counter variable for arrays + ! Initialize ErrStat 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%NumBl = SrcInitOutputData%NumBl -IF (ALLOCATED(SrcInitOutputData%BlPitch)) THEN - i1_l = LBOUND(SrcInitOutputData%BlPitch,1) - i1_u = UBOUND(SrcInitOutputData%BlPitch,1) - IF (.NOT. ALLOCATED(DstInitOutputData%BlPitch)) THEN - ALLOCATE(DstInitOutputData%BlPitch(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%BlPitch.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%BlPitch = SrcInitOutputData%BlPitch -ENDIF - DstInitOutputData%BladeLength = SrcInitOutputData%BladeLength - DstInitOutputData%TowerHeight = SrcInitOutputData%TowerHeight - DstInitOutputData%TowerBaseHeight = SrcInitOutputData%TowerBaseHeight - DstInitOutputData%HubHt = SrcInitOutputData%HubHt -IF (ALLOCATED(SrcInitOutputData%BldRNodes)) THEN - i1_l = LBOUND(SrcInitOutputData%BldRNodes,1) - i1_u = UBOUND(SrcInitOutputData%BldRNodes,1) - IF (.NOT. ALLOCATED(DstInitOutputData%BldRNodes)) THEN - ALLOCATE(DstInitOutputData%BldRNodes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%BldRNodes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%BldRNodes = SrcInitOutputData%BldRNodes -ENDIF -IF (ALLOCATED(SrcInitOutputData%TwrHNodes)) THEN - i1_l = LBOUND(SrcInitOutputData%TwrHNodes,1) - i1_u = UBOUND(SrcInitOutputData%TwrHNodes,1) - IF (.NOT. ALLOCATED(DstInitOutputData%TwrHNodes)) THEN - ALLOCATE(DstInitOutputData%TwrHNodes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%TwrHNodes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%TwrHNodes = SrcInitOutputData%TwrHNodes -ENDIF - DstInitOutputData%PlatformPos = SrcInitOutputData%PlatformPos - DstInitOutputData%TwrBaseRefPos = SrcInitOutputData%TwrBaseRefPos - DstInitOutputData%TwrBaseTransDisp = SrcInitOutputData%TwrBaseTransDisp - DstInitOutputData%TwrBaseRefOrient = SrcInitOutputData%TwrBaseRefOrient - DstInitOutputData%TwrBaseOrient = SrcInitOutputData%TwrBaseOrient - DstInitOutputData%HubRad = SrcInitOutputData%HubRad - DstInitOutputData%RotSpeed = SrcInitOutputData%RotSpeed - DstInitOutputData%isFixed_GenDOF = SrcInitOutputData%isFixed_GenDOF -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) + 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 - 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%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 -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 ED_CopyInitOutput - - SUBROUTINE ED_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(ED_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_DestroyInitOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(InitOutputData%WriteOutputHdr)) THEN - DEALLOCATE(InitOutputData%WriteOutputHdr) -ENDIF -IF (ALLOCATED(InitOutputData%WriteOutputUnt)) THEN - DEALLOCATE(InitOutputData%WriteOutputUnt) -ENDIF - CALL NWTC_Library_Destroyprogdesc( InitOutputData%Ver, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(InitOutputData%BlPitch)) THEN - DEALLOCATE(InitOutputData%BlPitch) -ENDIF -IF (ALLOCATED(InitOutputData%BldRNodes)) THEN - DEALLOCATE(InitOutputData%BldRNodes) -ENDIF -IF (ALLOCATED(InitOutputData%TwrHNodes)) THEN - DEALLOCATE(InitOutputData%TwrHNodes) -ENDIF -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%DerivOrder_x)) THEN - DEALLOCATE(InitOutputData%DerivOrder_x) -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 ED_DestroyInitOutput - - SUBROUTINE ED_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(ED_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 = 'ED_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 ! NumBl - 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 ! BladeLength - Re_BufSz = Re_BufSz + 1 ! TowerHeight - Re_BufSz = Re_BufSz + 1 ! TowerBaseHeight - Re_BufSz = Re_BufSz + 1 ! HubHt - Int_BufSz = Int_BufSz + 1 ! BldRNodes allocated yes/no - IF ( ALLOCATED(InData%BldRNodes) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BldRNodes upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BldRNodes) ! BldRNodes - END IF - Int_BufSz = Int_BufSz + 1 ! TwrHNodes allocated yes/no - IF ( ALLOCATED(InData%TwrHNodes) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TwrHNodes upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TwrHNodes) ! TwrHNodes - END IF - Re_BufSz = Re_BufSz + SIZE(InData%PlatformPos) ! PlatformPos - Re_BufSz = Re_BufSz + SIZE(InData%TwrBaseRefPos) ! TwrBaseRefPos - Db_BufSz = Db_BufSz + SIZE(InData%TwrBaseTransDisp) ! TwrBaseTransDisp - Db_BufSz = Db_BufSz + SIZE(InData%TwrBaseRefOrient) ! TwrBaseRefOrient - Db_BufSz = Db_BufSz + SIZE(InData%TwrBaseOrient) ! TwrBaseOrient - Re_BufSz = Re_BufSz + 1 ! HubRad - Re_BufSz = Re_BufSz + 1 ! RotSpeed - Int_BufSz = Int_BufSz + 1 ! isFixed_GenDOF - 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 ! 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 - 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%NumBl - Int_Xferred = 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%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 - ReKiBuf(Re_Xferred) = InData%HubHt - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%BldRNodes) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BldRNodes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldRNodes,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BldRNodes,1), UBOUND(InData%BldRNodes,1) - ReKiBuf(Re_Xferred) = InData%BldRNodes(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TwrHNodes) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwrHNodes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrHNodes,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TwrHNodes,1), UBOUND(InData%TwrHNodes,1) - ReKiBuf(Re_Xferred) = InData%TwrHNodes(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - DO i1 = LBOUND(InData%PlatformPos,1), UBOUND(InData%PlatformPos,1) - ReKiBuf(Re_Xferred) = InData%PlatformPos(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%TwrBaseRefPos,1), UBOUND(InData%TwrBaseRefPos,1) - ReKiBuf(Re_Xferred) = InData%TwrBaseRefPos(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%TwrBaseTransDisp,1), UBOUND(InData%TwrBaseTransDisp,1) - DbKiBuf(Db_Xferred) = InData%TwrBaseTransDisp(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i2 = LBOUND(InData%TwrBaseRefOrient,2), UBOUND(InData%TwrBaseRefOrient,2) - DO i1 = LBOUND(InData%TwrBaseRefOrient,1), UBOUND(InData%TwrBaseRefOrient,1) - DbKiBuf(Db_Xferred) = InData%TwrBaseRefOrient(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - 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 - ReKiBuf(Re_Xferred) = InData%HubRad - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RotSpeed - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%isFixed_GenDOF, 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_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%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 - 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 ED_PackInitOutput - - SUBROUTINE ED_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(ED_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) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_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%NumBl = IntKiBuf(Int_Xferred) - Int_Xferred = 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%BladeLength = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TowerHeight = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TowerBaseHeight = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%HubHt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldRNodes not allocated - Int_Xferred = Int_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%BldRNodes)) DEALLOCATE(OutData%BldRNodes) - ALLOCATE(OutData%BldRNodes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldRNodes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BldRNodes,1), UBOUND(OutData%BldRNodes,1) - OutData%BldRNodes(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrHNodes not allocated - Int_Xferred = Int_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%TwrHNodes)) DEALLOCATE(OutData%TwrHNodes) - ALLOCATE(OutData%TwrHNodes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrHNodes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TwrHNodes,1), UBOUND(OutData%TwrHNodes,1) - OutData%TwrHNodes(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - 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%TwrBaseRefPos,1) - i1_u = UBOUND(OutData%TwrBaseRefPos,1) - DO i1 = LBOUND(OutData%TwrBaseRefPos,1), UBOUND(OutData%TwrBaseRefPos,1) - OutData%TwrBaseRefPos(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%TwrBaseTransDisp,1) - i1_u = UBOUND(OutData%TwrBaseTransDisp,1) - DO i1 = LBOUND(OutData%TwrBaseTransDisp,1), UBOUND(OutData%TwrBaseTransDisp,1) - OutData%TwrBaseTransDisp(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%TwrBaseRefOrient,1) - i1_u = UBOUND(OutData%TwrBaseRefOrient,1) - i2_l = LBOUND(OutData%TwrBaseRefOrient,2) - i2_u = UBOUND(OutData%TwrBaseRefOrient,2) - DO i2 = LBOUND(OutData%TwrBaseRefOrient,2), UBOUND(OutData%TwrBaseRefOrient,2) - DO i1 = LBOUND(OutData%TwrBaseRefOrient,1), UBOUND(OutData%TwrBaseRefOrient,1) - OutData%TwrBaseRefOrient(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - 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 - OutData%HubRad = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RotSpeed = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%isFixed_GenDOF = TRANSFER(IntKiBuf(Int_Xferred), OutData%isFixed_GenDOF) - 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_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 ! 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 - 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 ED_UnPackInitOutput + END IF + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + IF (ALLOCATED(u_out%BladePtLoads) .AND. ALLOCATED(u1%BladePtLoads)) THEN + do i1 = lbound(u_out%BladePtLoads,1),ubound(u_out%BladePtLoads,1) + CALL MeshExtrapInterp1(u1%BladePtLoads(i1), u2%BladePtLoads(i1), tin, u_out%BladePtLoads(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + CALL MeshExtrapInterp1(u1%PlatformPtMesh, u2%PlatformPtMesh, tin, u_out%PlatformPtMesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp1(u1%TowerPtLoads, u2%TowerPtLoads, tin, u_out%TowerPtLoads, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp1(u1%HubPtLoad, u2%HubPtLoad, tin, u_out%HubPtLoad, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp1(u1%NacelleLoads, u2%NacelleLoads, tin, u_out%NacelleLoads, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp1(u1%TFinCMLoads, u2%TFinCMLoads, tin, u_out%TFinCMLoads, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ALLOCATED(u_out%TwrAddedMass) .AND. ALLOCATED(u1%TwrAddedMass)) THEN + u_out%TwrAddedMass = a1*u1%TwrAddedMass + a2*u2%TwrAddedMass + END IF ! check if allocated + u_out%PtfmAddedMass = a1*u1%PtfmAddedMass + a2*u2%PtfmAddedMass + IF (ALLOCATED(u_out%BlPitchCom) .AND. ALLOCATED(u1%BlPitchCom)) THEN + do i1 = lbound(u_out%BlPitchCom,1),ubound(u_out%BlPitchCom,1) + CALL Angles_ExtrapInterp( u1%BlPitchCom(i1), u2%BlPitchCom(i1), tin, u_out%BlPitchCom(i1), tin_out ) + END DO + END IF ! check if allocated + u_out%YawMom = a1*u1%YawMom + a2*u2%YawMom + u_out%GenTrq = a1*u1%GenTrq + a2*u2%GenTrq + u_out%HSSBrTrqC = a1*u1%HSSBrTrqC + a2*u2%HSSBrTrqC +END SUBROUTINE + +SUBROUTINE ED_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 +! +!.................................................................................................................................. - SUBROUTINE ED_CopyBladeInputData( SrcBladeInputDataData, DstBladeInputDataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(BladeInputData), INTENT(IN) :: SrcBladeInputDataData - TYPE(BladeInputData), INTENT(INOUT) :: DstBladeInputDataData - 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 = 'ED_CopyBladeInputData' -! + TYPE(ED_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 > t3 + TYPE(ED_InputType), INTENT(INOUT) :: u2 ! Input at t2 > t3 + TYPE(ED_InputType), INTENT(INOUT) :: u3 ! Input at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs + TYPE(ED_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) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'ED_Input_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i03 ! dim3 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 counter variable for arrays + INTEGER :: i3 ! dim3 counter variable for arrays + ! Initialize ErrStat ErrStat = ErrID_None - ErrMsg = "" - DstBladeInputDataData%NBlInpSt = SrcBladeInputDataData%NBlInpSt -IF (ALLOCATED(SrcBladeInputDataData%BlFract)) THEN - i1_l = LBOUND(SrcBladeInputDataData%BlFract,1) - i1_u = UBOUND(SrcBladeInputDataData%BlFract,1) - IF (.NOT. ALLOCATED(DstBladeInputDataData%BlFract)) THEN - ALLOCATE(DstBladeInputDataData%BlFract(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladeInputDataData%BlFract.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladeInputDataData%BlFract = SrcBladeInputDataData%BlFract -ENDIF -IF (ALLOCATED(SrcBladeInputDataData%PitchAx)) THEN - i1_l = LBOUND(SrcBladeInputDataData%PitchAx,1) - i1_u = UBOUND(SrcBladeInputDataData%PitchAx,1) - IF (.NOT. ALLOCATED(DstBladeInputDataData%PitchAx)) THEN - ALLOCATE(DstBladeInputDataData%PitchAx(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladeInputDataData%PitchAx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladeInputDataData%PitchAx = SrcBladeInputDataData%PitchAx -ENDIF -IF (ALLOCATED(SrcBladeInputDataData%StrcTwst)) THEN - i1_l = LBOUND(SrcBladeInputDataData%StrcTwst,1) - i1_u = UBOUND(SrcBladeInputDataData%StrcTwst,1) - IF (.NOT. ALLOCATED(DstBladeInputDataData%StrcTwst)) THEN - ALLOCATE(DstBladeInputDataData%StrcTwst(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladeInputDataData%StrcTwst.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladeInputDataData%StrcTwst = SrcBladeInputDataData%StrcTwst -ENDIF -IF (ALLOCATED(SrcBladeInputDataData%BMassDen)) THEN - i1_l = LBOUND(SrcBladeInputDataData%BMassDen,1) - i1_u = UBOUND(SrcBladeInputDataData%BMassDen,1) - IF (.NOT. ALLOCATED(DstBladeInputDataData%BMassDen)) THEN - ALLOCATE(DstBladeInputDataData%BMassDen(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladeInputDataData%BMassDen.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladeInputDataData%BMassDen = SrcBladeInputDataData%BMassDen -ENDIF -IF (ALLOCATED(SrcBladeInputDataData%FlpStff)) THEN - i1_l = LBOUND(SrcBladeInputDataData%FlpStff,1) - i1_u = UBOUND(SrcBladeInputDataData%FlpStff,1) - IF (.NOT. ALLOCATED(DstBladeInputDataData%FlpStff)) THEN - ALLOCATE(DstBladeInputDataData%FlpStff(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladeInputDataData%FlpStff.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladeInputDataData%FlpStff = SrcBladeInputDataData%FlpStff -ENDIF -IF (ALLOCATED(SrcBladeInputDataData%EdgStff)) THEN - i1_l = LBOUND(SrcBladeInputDataData%EdgStff,1) - i1_u = UBOUND(SrcBladeInputDataData%EdgStff,1) - IF (.NOT. ALLOCATED(DstBladeInputDataData%EdgStff)) THEN - ALLOCATE(DstBladeInputDataData%EdgStff(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladeInputDataData%EdgStff.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladeInputDataData%EdgStff = SrcBladeInputDataData%EdgStff -ENDIF - DstBladeInputDataData%BldFlDmp = SrcBladeInputDataData%BldFlDmp - DstBladeInputDataData%BldEdDmp = SrcBladeInputDataData%BldEdDmp - DstBladeInputDataData%FlStTunr = SrcBladeInputDataData%FlStTunr -IF (ALLOCATED(SrcBladeInputDataData%BldFl1Sh)) THEN - i1_l = LBOUND(SrcBladeInputDataData%BldFl1Sh,1) - i1_u = UBOUND(SrcBladeInputDataData%BldFl1Sh,1) - IF (.NOT. ALLOCATED(DstBladeInputDataData%BldFl1Sh)) THEN - ALLOCATE(DstBladeInputDataData%BldFl1Sh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladeInputDataData%BldFl1Sh.', ErrStat, ErrMsg,RoutineName) + 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 - END IF - DstBladeInputDataData%BldFl1Sh = SrcBladeInputDataData%BldFl1Sh -ENDIF -IF (ALLOCATED(SrcBladeInputDataData%BldFl2Sh)) THEN - i1_l = LBOUND(SrcBladeInputDataData%BldFl2Sh,1) - i1_u = UBOUND(SrcBladeInputDataData%BldFl2Sh,1) - IF (.NOT. ALLOCATED(DstBladeInputDataData%BldFl2Sh)) THEN - ALLOCATE(DstBladeInputDataData%BldFl2Sh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladeInputDataData%BldFl2Sh.', ErrStat, ErrMsg,RoutineName) + 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 - END IF - END IF - DstBladeInputDataData%BldFl2Sh = SrcBladeInputDataData%BldFl2Sh -ENDIF -IF (ALLOCATED(SrcBladeInputDataData%BldEdgSh)) THEN - i1_l = LBOUND(SrcBladeInputDataData%BldEdgSh,1) - i1_u = UBOUND(SrcBladeInputDataData%BldEdgSh,1) - IF (.NOT. ALLOCATED(DstBladeInputDataData%BldEdgSh)) THEN - ALLOCATE(DstBladeInputDataData%BldEdgSh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladeInputDataData%BldEdgSh.', ErrStat, ErrMsg,RoutineName) + 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 - END IF - DstBladeInputDataData%BldEdgSh = SrcBladeInputDataData%BldEdgSh -ENDIF - END SUBROUTINE ED_CopyBladeInputData - - SUBROUTINE ED_DestroyBladeInputData( BladeInputDataData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(BladeInputData), INTENT(INOUT) :: BladeInputDataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_DestroyBladeInputData' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(BladeInputDataData%BlFract)) THEN - DEALLOCATE(BladeInputDataData%BlFract) -ENDIF -IF (ALLOCATED(BladeInputDataData%PitchAx)) THEN - DEALLOCATE(BladeInputDataData%PitchAx) -ENDIF -IF (ALLOCATED(BladeInputDataData%StrcTwst)) THEN - DEALLOCATE(BladeInputDataData%StrcTwst) -ENDIF -IF (ALLOCATED(BladeInputDataData%BMassDen)) THEN - DEALLOCATE(BladeInputDataData%BMassDen) -ENDIF -IF (ALLOCATED(BladeInputDataData%FlpStff)) THEN - DEALLOCATE(BladeInputDataData%FlpStff) -ENDIF -IF (ALLOCATED(BladeInputDataData%EdgStff)) THEN - DEALLOCATE(BladeInputDataData%EdgStff) -ENDIF -IF (ALLOCATED(BladeInputDataData%BldFl1Sh)) THEN - DEALLOCATE(BladeInputDataData%BldFl1Sh) -ENDIF -IF (ALLOCATED(BladeInputDataData%BldFl2Sh)) THEN - DEALLOCATE(BladeInputDataData%BldFl2Sh) -ENDIF -IF (ALLOCATED(BladeInputDataData%BldEdgSh)) THEN - DEALLOCATE(BladeInputDataData%BldEdgSh) -ENDIF - END SUBROUTINE ED_DestroyBladeInputData - - SUBROUTINE ED_PackBladeInputData( 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(BladeInputData), 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 = 'ED_PackBladeInputData' - ! 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 ! NBlInpSt - Int_BufSz = Int_BufSz + 1 ! BlFract allocated yes/no - IF ( ALLOCATED(InData%BlFract) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BlFract upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BlFract) ! BlFract - END IF - Int_BufSz = Int_BufSz + 1 ! PitchAx allocated yes/no - IF ( ALLOCATED(InData%PitchAx) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PitchAx upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PitchAx) ! PitchAx - END IF - Int_BufSz = Int_BufSz + 1 ! StrcTwst allocated yes/no - IF ( ALLOCATED(InData%StrcTwst) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! StrcTwst upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%StrcTwst) ! StrcTwst - END IF - Int_BufSz = Int_BufSz + 1 ! BMassDen allocated yes/no - IF ( ALLOCATED(InData%BMassDen) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BMassDen upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BMassDen) ! BMassDen - END IF - Int_BufSz = Int_BufSz + 1 ! FlpStff allocated yes/no - IF ( ALLOCATED(InData%FlpStff) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! FlpStff upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%FlpStff) ! FlpStff - END IF - Int_BufSz = Int_BufSz + 1 ! EdgStff allocated yes/no - IF ( ALLOCATED(InData%EdgStff) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! EdgStff upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%EdgStff) ! EdgStff - END IF - Re_BufSz = Re_BufSz + SIZE(InData%BldFlDmp) ! BldFlDmp - Re_BufSz = Re_BufSz + SIZE(InData%BldEdDmp) ! BldEdDmp - Re_BufSz = Re_BufSz + SIZE(InData%FlStTunr) ! FlStTunr - Int_BufSz = Int_BufSz + 1 ! BldFl1Sh allocated yes/no - IF ( ALLOCATED(InData%BldFl1Sh) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BldFl1Sh upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BldFl1Sh) ! BldFl1Sh - END IF - Int_BufSz = Int_BufSz + 1 ! BldFl2Sh allocated yes/no - IF ( ALLOCATED(InData%BldFl2Sh) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BldFl2Sh upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BldFl2Sh) ! BldFl2Sh - END IF - Int_BufSz = Int_BufSz + 1 ! BldEdgSh allocated yes/no - IF ( ALLOCATED(InData%BldEdgSh) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BldEdgSh upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BldEdgSh) ! BldEdgSh - 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%NBlInpSt - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%BlFract) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlFract,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlFract,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BlFract,1), UBOUND(InData%BlFract,1) - ReKiBuf(Re_Xferred) = InData%BlFract(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PitchAx) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PitchAx,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PitchAx,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PitchAx,1), UBOUND(InData%PitchAx,1) - ReKiBuf(Re_Xferred) = InData%PitchAx(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%StrcTwst) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StrcTwst,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StrcTwst,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%StrcTwst,1), UBOUND(InData%StrcTwst,1) - ReKiBuf(Re_Xferred) = InData%StrcTwst(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BMassDen) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BMassDen,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BMassDen,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BMassDen,1), UBOUND(InData%BMassDen,1) - ReKiBuf(Re_Xferred) = InData%BMassDen(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%FlpStff) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FlpStff,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FlpStff,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%FlpStff,1), UBOUND(InData%FlpStff,1) - ReKiBuf(Re_Xferred) = InData%FlpStff(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%EdgStff) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%EdgStff,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%EdgStff,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%EdgStff,1), UBOUND(InData%EdgStff,1) - ReKiBuf(Re_Xferred) = InData%EdgStff(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - DO i1 = LBOUND(InData%BldFlDmp,1), UBOUND(InData%BldFlDmp,1) - ReKiBuf(Re_Xferred) = InData%BldFlDmp(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%BldEdDmp,1), UBOUND(InData%BldEdDmp,1) - ReKiBuf(Re_Xferred) = InData%BldEdDmp(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%FlStTunr,1), UBOUND(InData%FlStTunr,1) - ReKiBuf(Re_Xferred) = InData%FlStTunr(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%BldFl1Sh) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BldFl1Sh,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldFl1Sh,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BldFl1Sh,1), UBOUND(InData%BldFl1Sh,1) - ReKiBuf(Re_Xferred) = InData%BldFl1Sh(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BldFl2Sh) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BldFl2Sh,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldFl2Sh,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BldFl2Sh,1), UBOUND(InData%BldFl2Sh,1) - ReKiBuf(Re_Xferred) = InData%BldFl2Sh(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BldEdgSh) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BldEdgSh,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldEdgSh,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BldEdgSh,1), UBOUND(InData%BldEdgSh,1) - ReKiBuf(Re_Xferred) = InData%BldEdgSh(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE ED_PackBladeInputData - - SUBROUTINE ED_UnPackBladeInputData( 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(BladeInputData), 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 = 'ED_UnPackBladeInputData' - ! 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%NBlInpSt = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlFract not allocated - Int_Xferred = Int_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%BlFract)) DEALLOCATE(OutData%BlFract) - ALLOCATE(OutData%BlFract(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlFract.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BlFract,1), UBOUND(OutData%BlFract,1) - OutData%BlFract(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PitchAx not allocated - Int_Xferred = Int_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%PitchAx)) DEALLOCATE(OutData%PitchAx) - ALLOCATE(OutData%PitchAx(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PitchAx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PitchAx,1), UBOUND(OutData%PitchAx,1) - OutData%PitchAx(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StrcTwst not allocated - Int_Xferred = Int_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%StrcTwst)) DEALLOCATE(OutData%StrcTwst) - ALLOCATE(OutData%StrcTwst(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StrcTwst.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%StrcTwst,1), UBOUND(OutData%StrcTwst,1) - OutData%StrcTwst(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BMassDen not allocated - Int_Xferred = Int_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%BMassDen)) DEALLOCATE(OutData%BMassDen) - ALLOCATE(OutData%BMassDen(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BMassDen.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BMassDen,1), UBOUND(OutData%BMassDen,1) - OutData%BMassDen(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FlpStff not allocated - Int_Xferred = Int_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%FlpStff)) DEALLOCATE(OutData%FlpStff) - ALLOCATE(OutData%FlpStff(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FlpStff.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%FlpStff,1), UBOUND(OutData%FlpStff,1) - OutData%FlpStff(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! EdgStff not allocated - Int_Xferred = Int_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%EdgStff)) DEALLOCATE(OutData%EdgStff) - ALLOCATE(OutData%EdgStff(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%EdgStff.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%EdgStff,1), UBOUND(OutData%EdgStff,1) - OutData%EdgStff(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - i1_l = LBOUND(OutData%BldFlDmp,1) - i1_u = UBOUND(OutData%BldFlDmp,1) - DO i1 = LBOUND(OutData%BldFlDmp,1), UBOUND(OutData%BldFlDmp,1) - OutData%BldFlDmp(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%BldEdDmp,1) - i1_u = UBOUND(OutData%BldEdDmp,1) - DO i1 = LBOUND(OutData%BldEdDmp,1), UBOUND(OutData%BldEdDmp,1) - OutData%BldEdDmp(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%FlStTunr,1) - i1_u = UBOUND(OutData%FlStTunr,1) - DO i1 = LBOUND(OutData%FlStTunr,1), UBOUND(OutData%FlStTunr,1) - OutData%FlStTunr(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldFl1Sh not allocated - Int_Xferred = Int_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%BldFl1Sh)) DEALLOCATE(OutData%BldFl1Sh) - ALLOCATE(OutData%BldFl1Sh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldFl1Sh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BldFl1Sh,1), UBOUND(OutData%BldFl1Sh,1) - OutData%BldFl1Sh(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldFl2Sh not allocated - Int_Xferred = Int_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%BldFl2Sh)) DEALLOCATE(OutData%BldFl2Sh) - ALLOCATE(OutData%BldFl2Sh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldFl2Sh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BldFl2Sh,1), UBOUND(OutData%BldFl2Sh,1) - OutData%BldFl2Sh(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldEdgSh not allocated - Int_Xferred = Int_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%BldEdgSh)) DEALLOCATE(OutData%BldEdgSh) - ALLOCATE(OutData%BldEdgSh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldEdgSh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BldEdgSh,1), UBOUND(OutData%BldEdgSh,1) - OutData%BldEdgSh(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE ED_UnPackBladeInputData + END IF + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + IF (ALLOCATED(u_out%BladePtLoads) .AND. ALLOCATED(u1%BladePtLoads)) THEN + do i1 = lbound(u_out%BladePtLoads,1),ubound(u_out%BladePtLoads,1) + CALL MeshExtrapInterp2(u1%BladePtLoads(i1), u2%BladePtLoads(i1), u3%BladePtLoads(i1), tin, u_out%BladePtLoads(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + CALL MeshExtrapInterp2(u1%PlatformPtMesh, u2%PlatformPtMesh, u3%PlatformPtMesh, tin, u_out%PlatformPtMesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp2(u1%TowerPtLoads, u2%TowerPtLoads, u3%TowerPtLoads, tin, u_out%TowerPtLoads, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp2(u1%HubPtLoad, u2%HubPtLoad, u3%HubPtLoad, tin, u_out%HubPtLoad, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp2(u1%NacelleLoads, u2%NacelleLoads, u3%NacelleLoads, tin, u_out%NacelleLoads, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp2(u1%TFinCMLoads, u2%TFinCMLoads, u3%TFinCMLoads, tin, u_out%TFinCMLoads, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ALLOCATED(u_out%TwrAddedMass) .AND. ALLOCATED(u1%TwrAddedMass)) THEN + u_out%TwrAddedMass = a1*u1%TwrAddedMass + a2*u2%TwrAddedMass + a3*u3%TwrAddedMass + END IF ! check if allocated + u_out%PtfmAddedMass = a1*u1%PtfmAddedMass + a2*u2%PtfmAddedMass + a3*u3%PtfmAddedMass + IF (ALLOCATED(u_out%BlPitchCom) .AND. ALLOCATED(u1%BlPitchCom)) THEN + do i1 = lbound(u_out%BlPitchCom,1),ubound(u_out%BlPitchCom,1) + CALL Angles_ExtrapInterp( u1%BlPitchCom(i1), u2%BlPitchCom(i1), u3%BlPitchCom(i1), tin, u_out%BlPitchCom(i1), tin_out ) + END DO + END IF ! check if allocated + u_out%YawMom = a1*u1%YawMom + a2*u2%YawMom + a3*u3%YawMom + u_out%GenTrq = a1*u1%GenTrq + a2*u2%GenTrq + a3*u3%GenTrq + u_out%HSSBrTrqC = a1*u1%HSSBrTrqC + a2*u2%HSSBrTrqC + a3*u3%HSSBrTrqC +END SUBROUTINE + +subroutine ED_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(ED_OutputType), intent(inout) :: y(:) ! Output at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Outputs + type(ED_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 = 'ED_Output_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(y)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(y)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(y) - 1 + select case (order) + case (0) + call ED_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call ED_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call ED_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(y) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE ED_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 +! +!.................................................................................................................................. - SUBROUTINE ED_CopyBladeMeshInputData( SrcBladeMeshInputDataData, DstBladeMeshInputDataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ED_BladeMeshInputData), INTENT(IN) :: SrcBladeMeshInputDataData - TYPE(ED_BladeMeshInputData), INTENT(INOUT) :: DstBladeMeshInputDataData - 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 = 'ED_CopyBladeMeshInputData' -! + TYPE(ED_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 + TYPE(ED_OutputType), INTENT(INOUT) :: y2 ! Output at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs + TYPE(ED_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 = 'ED_Output_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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 = "" - DstBladeMeshInputDataData%BldNodes = SrcBladeMeshInputDataData%BldNodes -IF (ALLOCATED(SrcBladeMeshInputDataData%RNodes)) THEN - i1_l = LBOUND(SrcBladeMeshInputDataData%RNodes,1) - i1_u = UBOUND(SrcBladeMeshInputDataData%RNodes,1) - IF (.NOT. ALLOCATED(DstBladeMeshInputDataData%RNodes)) THEN - ALLOCATE(DstBladeMeshInputDataData%RNodes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladeMeshInputDataData%RNodes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladeMeshInputDataData%RNodes = SrcBladeMeshInputDataData%RNodes -ENDIF -IF (ALLOCATED(SrcBladeMeshInputDataData%AeroTwst)) THEN - i1_l = LBOUND(SrcBladeMeshInputDataData%AeroTwst,1) - i1_u = UBOUND(SrcBladeMeshInputDataData%AeroTwst,1) - IF (.NOT. ALLOCATED(DstBladeMeshInputDataData%AeroTwst)) THEN - ALLOCATE(DstBladeMeshInputDataData%AeroTwst(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladeMeshInputDataData%AeroTwst.', ErrStat, ErrMsg,RoutineName) + 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 - END IF - DstBladeMeshInputDataData%AeroTwst = SrcBladeMeshInputDataData%AeroTwst -ENDIF -IF (ALLOCATED(SrcBladeMeshInputDataData%Chord)) THEN - i1_l = LBOUND(SrcBladeMeshInputDataData%Chord,1) - i1_u = UBOUND(SrcBladeMeshInputDataData%Chord,1) - IF (.NOT. ALLOCATED(DstBladeMeshInputDataData%Chord)) THEN - ALLOCATE(DstBladeMeshInputDataData%Chord(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladeMeshInputDataData%Chord.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladeMeshInputDataData%Chord = SrcBladeMeshInputDataData%Chord -ENDIF - END SUBROUTINE ED_CopyBladeMeshInputData - - SUBROUTINE ED_DestroyBladeMeshInputData( BladeMeshInputDataData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(ED_BladeMeshInputData), INTENT(INOUT) :: BladeMeshInputDataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_DestroyBladeMeshInputData' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(BladeMeshInputDataData%RNodes)) THEN - DEALLOCATE(BladeMeshInputDataData%RNodes) -ENDIF -IF (ALLOCATED(BladeMeshInputDataData%AeroTwst)) THEN - DEALLOCATE(BladeMeshInputDataData%AeroTwst) -ENDIF -IF (ALLOCATED(BladeMeshInputDataData%Chord)) THEN - DEALLOCATE(BladeMeshInputDataData%Chord) -ENDIF - END SUBROUTINE ED_DestroyBladeMeshInputData - - SUBROUTINE ED_PackBladeMeshInputData( 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(ED_BladeMeshInputData), 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 = 'ED_PackBladeMeshInputData' - ! 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 ! BldNodes - Int_BufSz = Int_BufSz + 1 ! RNodes allocated yes/no - IF ( ALLOCATED(InData%RNodes) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! RNodes upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%RNodes) ! RNodes - END IF - Int_BufSz = Int_BufSz + 1 ! AeroTwst allocated yes/no - IF ( ALLOCATED(InData%AeroTwst) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! AeroTwst upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AeroTwst) ! AeroTwst - END IF - Int_BufSz = Int_BufSz + 1 ! Chord allocated yes/no - IF ( ALLOCATED(InData%Chord) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Chord upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Chord) ! Chord - 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%BldNodes - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%RNodes) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RNodes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RNodes,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%RNodes,1), UBOUND(InData%RNodes,1) - ReKiBuf(Re_Xferred) = InData%RNodes(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AeroTwst) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AeroTwst,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AeroTwst,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%AeroTwst,1), UBOUND(InData%AeroTwst,1) - ReKiBuf(Re_Xferred) = InData%AeroTwst(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Chord) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Chord,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Chord,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Chord,1), UBOUND(InData%Chord,1) - ReKiBuf(Re_Xferred) = InData%Chord(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE ED_PackBladeMeshInputData - - SUBROUTINE ED_UnPackBladeMeshInputData( 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(ED_BladeMeshInputData), 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 = 'ED_UnPackBladeMeshInputData' - ! 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%BldNodes = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RNodes not allocated - Int_Xferred = Int_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%RNodes)) DEALLOCATE(OutData%RNodes) - ALLOCATE(OutData%RNodes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RNodes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%RNodes,1), UBOUND(OutData%RNodes,1) - OutData%RNodes(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AeroTwst not allocated - Int_Xferred = Int_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%AeroTwst)) DEALLOCATE(OutData%AeroTwst) - ALLOCATE(OutData%AeroTwst(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AeroTwst.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%AeroTwst,1), UBOUND(OutData%AeroTwst,1) - OutData%AeroTwst(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Chord not allocated - Int_Xferred = Int_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%Chord)) DEALLOCATE(OutData%Chord) - ALLOCATE(OutData%Chord(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Chord.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Chord,1), UBOUND(OutData%Chord,1) - OutData%Chord(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE ED_UnPackBladeMeshInputData + END IF + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + IF (ALLOCATED(y_out%BladeLn2Mesh) .AND. ALLOCATED(y1%BladeLn2Mesh)) THEN + do i1 = lbound(y_out%BladeLn2Mesh,1),ubound(y_out%BladeLn2Mesh,1) + CALL MeshExtrapInterp1(y1%BladeLn2Mesh(i1), y2%BladeLn2Mesh(i1), tin, y_out%BladeLn2Mesh(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + CALL MeshExtrapInterp1(y1%PlatformPtMesh, y2%PlatformPtMesh, tin, y_out%PlatformPtMesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp1(y1%TowerLn2Mesh, y2%TowerLn2Mesh, tin, y_out%TowerLn2Mesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp1(y1%HubPtMotion, y2%HubPtMotion, tin, y_out%HubPtMotion, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ALLOCATED(y_out%BladeRootMotion) .AND. ALLOCATED(y1%BladeRootMotion)) THEN + do i1 = lbound(y_out%BladeRootMotion,1),ubound(y_out%BladeRootMotion,1) + CALL MeshExtrapInterp1(y1%BladeRootMotion(i1), y2%BladeRootMotion(i1), tin, y_out%BladeRootMotion(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + CALL MeshExtrapInterp1(y1%NacelleMotion, y2%NacelleMotion, tin, y_out%NacelleMotion, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp1(y1%TFinCMMotion, y2%TFinCMMotion, tin, y_out%TFinCMMotion, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + END IF ! check if allocated + IF (ALLOCATED(y_out%BlPitch) .AND. ALLOCATED(y1%BlPitch)) THEN + do i1 = lbound(y_out%BlPitch,1),ubound(y_out%BlPitch,1) + CALL Angles_ExtrapInterp( y1%BlPitch(i1), y2%BlPitch(i1), tin, y_out%BlPitch(i1), tin_out ) + END DO + END IF ! check if allocated + CALL Angles_ExtrapInterp( y1%Yaw, y2%Yaw, tin, y_out%Yaw, tin_out ) + y_out%YawRate = a1*y1%YawRate + a2*y2%YawRate + y_out%LSS_Spd = a1*y1%LSS_Spd + a2*y2%LSS_Spd + y_out%HSS_Spd = a1*y1%HSS_Spd + a2*y2%HSS_Spd + y_out%RotSpeed = a1*y1%RotSpeed + a2*y2%RotSpeed + y_out%TwrAccel = a1*y1%TwrAccel + a2*y2%TwrAccel + CALL Angles_ExtrapInterp( y1%YawAngle, y2%YawAngle, tin, y_out%YawAngle, tin_out ) + y_out%RootMyc = a1*y1%RootMyc + a2*y2%RootMyc + y_out%YawBrTAxp = a1*y1%YawBrTAxp + a2*y2%YawBrTAxp + y_out%YawBrTAyp = a1*y1%YawBrTAyp + a2*y2%YawBrTAyp + CALL Angles_ExtrapInterp( y1%LSSTipPxa, y2%LSSTipPxa, tin, y_out%LSSTipPxa, tin_out ) + y_out%RootMxc = a1*y1%RootMxc + a2*y2%RootMxc + y_out%LSSTipMxa = a1*y1%LSSTipMxa + a2*y2%LSSTipMxa + y_out%LSSTipMya = a1*y1%LSSTipMya + a2*y2%LSSTipMya + y_out%LSSTipMza = a1*y1%LSSTipMza + a2*y2%LSSTipMza + y_out%LSSTipMys = a1*y1%LSSTipMys + a2*y2%LSSTipMys + y_out%LSSTipMzs = a1*y1%LSSTipMzs + a2*y2%LSSTipMzs + y_out%YawBrMyn = a1*y1%YawBrMyn + a2*y2%YawBrMyn + y_out%YawBrMzn = a1*y1%YawBrMzn + a2*y2%YawBrMzn + y_out%NcIMURAxs = a1*y1%NcIMURAxs + a2*y2%NcIMURAxs + y_out%NcIMURAys = a1*y1%NcIMURAys + a2*y2%NcIMURAys + y_out%NcIMURAzs = a1*y1%NcIMURAzs + a2*y2%NcIMURAzs + y_out%RotPwr = a1*y1%RotPwr + a2*y2%RotPwr + y_out%LSShftFxa = a1*y1%LSShftFxa + a2*y2%LSShftFxa + y_out%LSShftFys = a1*y1%LSShftFys + a2*y2%LSShftFys + y_out%LSShftFzs = a1*y1%LSShftFzs + a2*y2%LSShftFzs +END SUBROUTINE + +SUBROUTINE ED_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 +! +!.................................................................................................................................. - SUBROUTINE ED_CopyInputFile( SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ED_InputFile), INTENT(IN) :: SrcInputFileData - TYPE(ED_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 = 'ED_CopyInputFile' -! + TYPE(ED_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 > t3 + TYPE(ED_OutputType), INTENT(INOUT) :: y2 ! Output at t2 > t3 + TYPE(ED_OutputType), INTENT(INOUT) :: y3 ! Output at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs + TYPE(ED_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) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'ED_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 = "" - DstInputFileData%DT = SrcInputFileData%DT - DstInputFileData%FlapDOF1 = SrcInputFileData%FlapDOF1 - DstInputFileData%FlapDOF2 = SrcInputFileData%FlapDOF2 - DstInputFileData%EdgeDOF = SrcInputFileData%EdgeDOF - DstInputFileData%TeetDOF = SrcInputFileData%TeetDOF - DstInputFileData%DrTrDOF = SrcInputFileData%DrTrDOF - DstInputFileData%GenDOF = SrcInputFileData%GenDOF - DstInputFileData%YawDOF = SrcInputFileData%YawDOF - DstInputFileData%TwFADOF1 = SrcInputFileData%TwFADOF1 - DstInputFileData%TwFADOF2 = SrcInputFileData%TwFADOF2 - DstInputFileData%TwSSDOF1 = SrcInputFileData%TwSSDOF1 - DstInputFileData%TwSSDOF2 = SrcInputFileData%TwSSDOF2 - DstInputFileData%PtfmSgDOF = SrcInputFileData%PtfmSgDOF - DstInputFileData%PtfmSwDOF = SrcInputFileData%PtfmSwDOF - DstInputFileData%PtfmHvDOF = SrcInputFileData%PtfmHvDOF - DstInputFileData%PtfmRDOF = SrcInputFileData%PtfmRDOF - DstInputFileData%PtfmPDOF = SrcInputFileData%PtfmPDOF - DstInputFileData%PtfmYDOF = SrcInputFileData%PtfmYDOF - DstInputFileData%OoPDefl = SrcInputFileData%OoPDefl - DstInputFileData%IPDefl = SrcInputFileData%IPDefl -IF (ALLOCATED(SrcInputFileData%BlPitch)) THEN - i1_l = LBOUND(SrcInputFileData%BlPitch,1) - i1_u = UBOUND(SrcInputFileData%BlPitch,1) - IF (.NOT. ALLOCATED(DstInputFileData%BlPitch)) THEN - ALLOCATE(DstInputFileData%BlPitch(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%BlPitch.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%BlPitch = SrcInputFileData%BlPitch -ENDIF - DstInputFileData%TeetDefl = SrcInputFileData%TeetDefl - DstInputFileData%Azimuth = SrcInputFileData%Azimuth - DstInputFileData%RotSpeed = SrcInputFileData%RotSpeed - DstInputFileData%NacYaw = SrcInputFileData%NacYaw - DstInputFileData%TTDspFA = SrcInputFileData%TTDspFA - DstInputFileData%TTDspSS = SrcInputFileData%TTDspSS - DstInputFileData%PtfmSurge = SrcInputFileData%PtfmSurge - DstInputFileData%PtfmSway = SrcInputFileData%PtfmSway - DstInputFileData%PtfmHeave = SrcInputFileData%PtfmHeave - DstInputFileData%PtfmRoll = SrcInputFileData%PtfmRoll - DstInputFileData%PtfmPitch = SrcInputFileData%PtfmPitch - DstInputFileData%PtfmYaw = SrcInputFileData%PtfmYaw - DstInputFileData%NumBl = SrcInputFileData%NumBl - DstInputFileData%TipRad = SrcInputFileData%TipRad - DstInputFileData%HubRad = SrcInputFileData%HubRad -IF (ALLOCATED(SrcInputFileData%PreCone)) THEN - i1_l = LBOUND(SrcInputFileData%PreCone,1) - i1_u = UBOUND(SrcInputFileData%PreCone,1) - IF (.NOT. ALLOCATED(DstInputFileData%PreCone)) THEN - ALLOCATE(DstInputFileData%PreCone(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%PreCone.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%PreCone = SrcInputFileData%PreCone -ENDIF - DstInputFileData%HubCM = SrcInputFileData%HubCM - DstInputFileData%UndSling = SrcInputFileData%UndSling - DstInputFileData%Delta3 = SrcInputFileData%Delta3 - DstInputFileData%AzimB1Up = SrcInputFileData%AzimB1Up - DstInputFileData%OverHang = SrcInputFileData%OverHang - DstInputFileData%ShftGagL = SrcInputFileData%ShftGagL - DstInputFileData%ShftTilt = SrcInputFileData%ShftTilt - DstInputFileData%NacCMxn = SrcInputFileData%NacCMxn - DstInputFileData%NacCMyn = SrcInputFileData%NacCMyn - DstInputFileData%NacCMzn = SrcInputFileData%NacCMzn - DstInputFileData%NcIMUxn = SrcInputFileData%NcIMUxn - DstInputFileData%NcIMUyn = SrcInputFileData%NcIMUyn - DstInputFileData%NcIMUzn = SrcInputFileData%NcIMUzn - DstInputFileData%Twr2Shft = SrcInputFileData%Twr2Shft - DstInputFileData%TowerHt = SrcInputFileData%TowerHt - DstInputFileData%TowerBsHt = SrcInputFileData%TowerBsHt - DstInputFileData%PtfmCMxt = SrcInputFileData%PtfmCMxt - DstInputFileData%PtfmCMyt = SrcInputFileData%PtfmCMyt - DstInputFileData%PtfmCMzt = SrcInputFileData%PtfmCMzt - DstInputFileData%PtfmRefzt = SrcInputFileData%PtfmRefzt -IF (ALLOCATED(SrcInputFileData%TipMass)) THEN - i1_l = LBOUND(SrcInputFileData%TipMass,1) - i1_u = UBOUND(SrcInputFileData%TipMass,1) - IF (.NOT. ALLOCATED(DstInputFileData%TipMass)) THEN - ALLOCATE(DstInputFileData%TipMass(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%TipMass.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%TipMass = SrcInputFileData%TipMass -ENDIF - DstInputFileData%HubMass = SrcInputFileData%HubMass - DstInputFileData%HubIner = SrcInputFileData%HubIner - DstInputFileData%GenIner = SrcInputFileData%GenIner - DstInputFileData%NacMass = SrcInputFileData%NacMass - DstInputFileData%NacYIner = SrcInputFileData%NacYIner - DstInputFileData%YawBrMass = SrcInputFileData%YawBrMass - DstInputFileData%PtfmMass = SrcInputFileData%PtfmMass - DstInputFileData%PtfmRIner = SrcInputFileData%PtfmRIner - DstInputFileData%PtfmPIner = SrcInputFileData%PtfmPIner - DstInputFileData%PtfmYIner = SrcInputFileData%PtfmYIner - DstInputFileData%BldNodes = SrcInputFileData%BldNodes -IF (ALLOCATED(SrcInputFileData%InpBlMesh)) THEN - i1_l = LBOUND(SrcInputFileData%InpBlMesh,1) - i1_u = UBOUND(SrcInputFileData%InpBlMesh,1) - IF (.NOT. ALLOCATED(DstInputFileData%InpBlMesh)) THEN - ALLOCATE(DstInputFileData%InpBlMesh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%InpBlMesh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcInputFileData%InpBlMesh,1), UBOUND(SrcInputFileData%InpBlMesh,1) - CALL ED_Copyblademeshinputdata( SrcInputFileData%InpBlMesh(i1), DstInputFileData%InpBlMesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcInputFileData%InpBl)) THEN - i1_l = LBOUND(SrcInputFileData%InpBl,1) - i1_u = UBOUND(SrcInputFileData%InpBl,1) - IF (.NOT. ALLOCATED(DstInputFileData%InpBl)) THEN - ALLOCATE(DstInputFileData%InpBl(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%InpBl.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcInputFileData%InpBl,1), UBOUND(SrcInputFileData%InpBl,1) - CALL ED_Copybladeinputdata( SrcInputFileData%InpBl(i1), DstInputFileData%InpBl(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - DstInputFileData%TeetMod = SrcInputFileData%TeetMod - DstInputFileData%TeetDmpP = SrcInputFileData%TeetDmpP - DstInputFileData%TeetDmp = SrcInputFileData%TeetDmp - DstInputFileData%TeetCDmp = SrcInputFileData%TeetCDmp - DstInputFileData%TeetSStP = SrcInputFileData%TeetSStP - DstInputFileData%TeetHStP = SrcInputFileData%TeetHStP - DstInputFileData%TeetSSSp = SrcInputFileData%TeetSSSp - DstInputFileData%TeetHSSp = SrcInputFileData%TeetHSSp - DstInputFileData%GBoxEff = SrcInputFileData%GBoxEff - DstInputFileData%GBRatio = SrcInputFileData%GBRatio - DstInputFileData%DTTorSpr = SrcInputFileData%DTTorSpr - DstInputFileData%DTTorDmp = SrcInputFileData%DTTorDmp - DstInputFileData%Furling = SrcInputFileData%Furling - DstInputFileData%TwrNodes = SrcInputFileData%TwrNodes - DstInputFileData%SumPrint = SrcInputFileData%SumPrint - DstInputFileData%OutFile = SrcInputFileData%OutFile - DstInputFileData%TabDelim = SrcInputFileData%TabDelim - DstInputFileData%OutFmt = SrcInputFileData%OutFmt - DstInputFileData%Tstart = SrcInputFileData%Tstart - DstInputFileData%DecFact = SrcInputFileData%DecFact - DstInputFileData%NTwGages = SrcInputFileData%NTwGages - DstInputFileData%TwrGagNd = SrcInputFileData%TwrGagNd - DstInputFileData%NBlGages = SrcInputFileData%NBlGages - DstInputFileData%BldGagNd = SrcInputFileData%BldGagNd - 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%NTwInpSt = SrcInputFileData%NTwInpSt - DstInputFileData%TwrFADmp = SrcInputFileData%TwrFADmp - DstInputFileData%TwrSSDmp = SrcInputFileData%TwrSSDmp - DstInputFileData%FAStTunr = SrcInputFileData%FAStTunr - DstInputFileData%SSStTunr = SrcInputFileData%SSStTunr -IF (ALLOCATED(SrcInputFileData%HtFract)) THEN - i1_l = LBOUND(SrcInputFileData%HtFract,1) - i1_u = UBOUND(SrcInputFileData%HtFract,1) - IF (.NOT. ALLOCATED(DstInputFileData%HtFract)) THEN - ALLOCATE(DstInputFileData%HtFract(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%HtFract.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%HtFract = SrcInputFileData%HtFract -ENDIF -IF (ALLOCATED(SrcInputFileData%TMassDen)) THEN - i1_l = LBOUND(SrcInputFileData%TMassDen,1) - i1_u = UBOUND(SrcInputFileData%TMassDen,1) - IF (.NOT. ALLOCATED(DstInputFileData%TMassDen)) THEN - ALLOCATE(DstInputFileData%TMassDen(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%TMassDen.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%TMassDen = SrcInputFileData%TMassDen -ENDIF -IF (ALLOCATED(SrcInputFileData%TwFAStif)) THEN - i1_l = LBOUND(SrcInputFileData%TwFAStif,1) - i1_u = UBOUND(SrcInputFileData%TwFAStif,1) - IF (.NOT. ALLOCATED(DstInputFileData%TwFAStif)) THEN - ALLOCATE(DstInputFileData%TwFAStif(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%TwFAStif.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%TwFAStif = SrcInputFileData%TwFAStif -ENDIF -IF (ALLOCATED(SrcInputFileData%TwSSStif)) THEN - i1_l = LBOUND(SrcInputFileData%TwSSStif,1) - i1_u = UBOUND(SrcInputFileData%TwSSStif,1) - IF (.NOT. ALLOCATED(DstInputFileData%TwSSStif)) THEN - ALLOCATE(DstInputFileData%TwSSStif(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%TwSSStif.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%TwSSStif = SrcInputFileData%TwSSStif -ENDIF -IF (ALLOCATED(SrcInputFileData%TwFAM1Sh)) THEN - i1_l = LBOUND(SrcInputFileData%TwFAM1Sh,1) - i1_u = UBOUND(SrcInputFileData%TwFAM1Sh,1) - IF (.NOT. ALLOCATED(DstInputFileData%TwFAM1Sh)) THEN - ALLOCATE(DstInputFileData%TwFAM1Sh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%TwFAM1Sh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%TwFAM1Sh = SrcInputFileData%TwFAM1Sh -ENDIF -IF (ALLOCATED(SrcInputFileData%TwFAM2Sh)) THEN - i1_l = LBOUND(SrcInputFileData%TwFAM2Sh,1) - i1_u = UBOUND(SrcInputFileData%TwFAM2Sh,1) - IF (.NOT. ALLOCATED(DstInputFileData%TwFAM2Sh)) THEN - ALLOCATE(DstInputFileData%TwFAM2Sh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%TwFAM2Sh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%TwFAM2Sh = SrcInputFileData%TwFAM2Sh -ENDIF -IF (ALLOCATED(SrcInputFileData%TwSSM1Sh)) THEN - i1_l = LBOUND(SrcInputFileData%TwSSM1Sh,1) - i1_u = UBOUND(SrcInputFileData%TwSSM1Sh,1) - IF (.NOT. ALLOCATED(DstInputFileData%TwSSM1Sh)) THEN - ALLOCATE(DstInputFileData%TwSSM1Sh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%TwSSM1Sh.', ErrStat, ErrMsg,RoutineName) + 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 - END IF - DstInputFileData%TwSSM1Sh = SrcInputFileData%TwSSM1Sh -ENDIF -IF (ALLOCATED(SrcInputFileData%TwSSM2Sh)) THEN - i1_l = LBOUND(SrcInputFileData%TwSSM2Sh,1) - i1_u = UBOUND(SrcInputFileData%TwSSM2Sh,1) - IF (.NOT. ALLOCATED(DstInputFileData%TwSSM2Sh)) THEN - ALLOCATE(DstInputFileData%TwSSM2Sh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%TwSSM2Sh.', ErrStat, ErrMsg,RoutineName) + 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 - END IF - END IF - DstInputFileData%TwSSM2Sh = SrcInputFileData%TwSSM2Sh -ENDIF - DstInputFileData%RFrlDOF = SrcInputFileData%RFrlDOF - DstInputFileData%TFrlDOF = SrcInputFileData%TFrlDOF - DstInputFileData%RotFurl = SrcInputFileData%RotFurl - DstInputFileData%TailFurl = SrcInputFileData%TailFurl - DstInputFileData%Yaw2Shft = SrcInputFileData%Yaw2Shft - DstInputFileData%ShftSkew = SrcInputFileData%ShftSkew - DstInputFileData%RFrlCM_n = SrcInputFileData%RFrlCM_n - DstInputFileData%BoomCM_n = SrcInputFileData%BoomCM_n - DstInputFileData%TFinCM_n = SrcInputFileData%TFinCM_n - DstInputFileData%RFrlPnt_n = SrcInputFileData%RFrlPnt_n - DstInputFileData%RFrlSkew = SrcInputFileData%RFrlSkew - DstInputFileData%RFrlTilt = SrcInputFileData%RFrlTilt - DstInputFileData%TFrlPnt_n = SrcInputFileData%TFrlPnt_n - DstInputFileData%TFrlSkew = SrcInputFileData%TFrlSkew - DstInputFileData%TFrlTilt = SrcInputFileData%TFrlTilt - DstInputFileData%RFrlMass = SrcInputFileData%RFrlMass - DstInputFileData%BoomMass = SrcInputFileData%BoomMass - DstInputFileData%TFinMass = SrcInputFileData%TFinMass - DstInputFileData%RFrlIner = SrcInputFileData%RFrlIner - DstInputFileData%TFrlIner = SrcInputFileData%TFrlIner - DstInputFileData%RFrlMod = SrcInputFileData%RFrlMod - DstInputFileData%RFrlSpr = SrcInputFileData%RFrlSpr - DstInputFileData%RFrlDmp = SrcInputFileData%RFrlDmp - DstInputFileData%RFrlUSSP = SrcInputFileData%RFrlUSSP - DstInputFileData%RFrlDSSP = SrcInputFileData%RFrlDSSP - DstInputFileData%RFrlUSSpr = SrcInputFileData%RFrlUSSpr - DstInputFileData%RFrlDSSpr = SrcInputFileData%RFrlDSSpr - DstInputFileData%RFrlUSDP = SrcInputFileData%RFrlUSDP - DstInputFileData%RFrlDSDP = SrcInputFileData%RFrlDSDP - DstInputFileData%RFrlUSDmp = SrcInputFileData%RFrlUSDmp - DstInputFileData%RFrlDSDmp = SrcInputFileData%RFrlDSDmp - DstInputFileData%TFrlMod = SrcInputFileData%TFrlMod - DstInputFileData%TFrlSpr = SrcInputFileData%TFrlSpr - DstInputFileData%TFrlDmp = SrcInputFileData%TFrlDmp - DstInputFileData%TFrlUSSP = SrcInputFileData%TFrlUSSP - DstInputFileData%TFrlDSSP = SrcInputFileData%TFrlDSSP - DstInputFileData%TFrlUSSpr = SrcInputFileData%TFrlUSSpr - DstInputFileData%TFrlDSSpr = SrcInputFileData%TFrlDSSpr - DstInputFileData%TFrlUSDP = SrcInputFileData%TFrlUSDP - DstInputFileData%TFrlDSDP = SrcInputFileData%TFrlDSDP - DstInputFileData%TFrlUSDmp = SrcInputFileData%TFrlUSDmp - DstInputFileData%TFrlDSDmp = SrcInputFileData%TFrlDSDmp - DstInputFileData%method = SrcInputFileData%method - DstInputFileData%BldNd_NumOuts = SrcInputFileData%BldNd_NumOuts -IF (ALLOCATED(SrcInputFileData%BldNd_OutList)) THEN - i1_l = LBOUND(SrcInputFileData%BldNd_OutList,1) - i1_u = UBOUND(SrcInputFileData%BldNd_OutList,1) - IF (.NOT. ALLOCATED(DstInputFileData%BldNd_OutList)) THEN - ALLOCATE(DstInputFileData%BldNd_OutList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%BldNd_OutList.', ErrStat, ErrMsg,RoutineName) + 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 - END IF - DstInputFileData%BldNd_OutList = SrcInputFileData%BldNd_OutList -ENDIF - DstInputFileData%BldNd_BlOutNd_Str = SrcInputFileData%BldNd_BlOutNd_Str - DstInputFileData%BldNd_BladesOut = SrcInputFileData%BldNd_BladesOut - END SUBROUTINE ED_CopyInputFile - - SUBROUTINE ED_DestroyInputFile( InputFileData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(ED_InputFile), INTENT(INOUT) :: InputFileData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_DestroyInputFile' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(InputFileData%BlPitch)) THEN - DEALLOCATE(InputFileData%BlPitch) -ENDIF -IF (ALLOCATED(InputFileData%PreCone)) THEN - DEALLOCATE(InputFileData%PreCone) -ENDIF -IF (ALLOCATED(InputFileData%TipMass)) THEN - DEALLOCATE(InputFileData%TipMass) -ENDIF -IF (ALLOCATED(InputFileData%InpBlMesh)) THEN -DO i1 = LBOUND(InputFileData%InpBlMesh,1), UBOUND(InputFileData%InpBlMesh,1) - CALL ED_Destroyblademeshinputdata( InputFileData%InpBlMesh(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(InputFileData%InpBlMesh) -ENDIF -IF (ALLOCATED(InputFileData%InpBl)) THEN -DO i1 = LBOUND(InputFileData%InpBl,1), UBOUND(InputFileData%InpBl,1) - CALL ED_Destroybladeinputdata( InputFileData%InpBl(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(InputFileData%InpBl) -ENDIF -IF (ALLOCATED(InputFileData%OutList)) THEN - DEALLOCATE(InputFileData%OutList) -ENDIF -IF (ALLOCATED(InputFileData%HtFract)) THEN - DEALLOCATE(InputFileData%HtFract) -ENDIF -IF (ALLOCATED(InputFileData%TMassDen)) THEN - DEALLOCATE(InputFileData%TMassDen) -ENDIF -IF (ALLOCATED(InputFileData%TwFAStif)) THEN - DEALLOCATE(InputFileData%TwFAStif) -ENDIF -IF (ALLOCATED(InputFileData%TwSSStif)) THEN - DEALLOCATE(InputFileData%TwSSStif) -ENDIF -IF (ALLOCATED(InputFileData%TwFAM1Sh)) THEN - DEALLOCATE(InputFileData%TwFAM1Sh) -ENDIF -IF (ALLOCATED(InputFileData%TwFAM2Sh)) THEN - DEALLOCATE(InputFileData%TwFAM2Sh) -ENDIF -IF (ALLOCATED(InputFileData%TwSSM1Sh)) THEN - DEALLOCATE(InputFileData%TwSSM1Sh) -ENDIF -IF (ALLOCATED(InputFileData%TwSSM2Sh)) THEN - DEALLOCATE(InputFileData%TwSSM2Sh) -ENDIF -IF (ALLOCATED(InputFileData%BldNd_OutList)) THEN - DEALLOCATE(InputFileData%BldNd_OutList) -ENDIF - END SUBROUTINE ED_DestroyInputFile - - SUBROUTINE ED_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(ED_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 = 'ED_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 ! FlapDOF1 - Int_BufSz = Int_BufSz + 1 ! FlapDOF2 - Int_BufSz = Int_BufSz + 1 ! EdgeDOF - Int_BufSz = Int_BufSz + 1 ! TeetDOF - Int_BufSz = Int_BufSz + 1 ! DrTrDOF - Int_BufSz = Int_BufSz + 1 ! GenDOF - Int_BufSz = Int_BufSz + 1 ! YawDOF - Int_BufSz = Int_BufSz + 1 ! TwFADOF1 - Int_BufSz = Int_BufSz + 1 ! TwFADOF2 - Int_BufSz = Int_BufSz + 1 ! TwSSDOF1 - Int_BufSz = Int_BufSz + 1 ! TwSSDOF2 - Int_BufSz = Int_BufSz + 1 ! PtfmSgDOF - Int_BufSz = Int_BufSz + 1 ! PtfmSwDOF - Int_BufSz = Int_BufSz + 1 ! PtfmHvDOF - Int_BufSz = Int_BufSz + 1 ! PtfmRDOF - Int_BufSz = Int_BufSz + 1 ! PtfmPDOF - Int_BufSz = Int_BufSz + 1 ! PtfmYDOF - Re_BufSz = Re_BufSz + 1 ! OoPDefl - Re_BufSz = Re_BufSz + 1 ! IPDefl - 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 ! TeetDefl - Db_BufSz = Db_BufSz + 1 ! Azimuth - Re_BufSz = Re_BufSz + 1 ! RotSpeed - Re_BufSz = Re_BufSz + 1 ! NacYaw - Re_BufSz = Re_BufSz + 1 ! TTDspFA - Re_BufSz = Re_BufSz + 1 ! TTDspSS - Re_BufSz = Re_BufSz + 1 ! PtfmSurge - Re_BufSz = Re_BufSz + 1 ! PtfmSway - Re_BufSz = Re_BufSz + 1 ! PtfmHeave - Re_BufSz = Re_BufSz + 1 ! PtfmRoll - Re_BufSz = Re_BufSz + 1 ! PtfmPitch - Re_BufSz = Re_BufSz + 1 ! PtfmYaw - Int_BufSz = Int_BufSz + 1 ! NumBl - Re_BufSz = Re_BufSz + 1 ! TipRad - Re_BufSz = Re_BufSz + 1 ! HubRad - Int_BufSz = Int_BufSz + 1 ! PreCone allocated yes/no - IF ( ALLOCATED(InData%PreCone) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PreCone upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PreCone) ! PreCone - END IF - Re_BufSz = Re_BufSz + 1 ! HubCM - Re_BufSz = Re_BufSz + 1 ! UndSling - Re_BufSz = Re_BufSz + 1 ! Delta3 - Db_BufSz = Db_BufSz + 1 ! AzimB1Up - Re_BufSz = Re_BufSz + 1 ! OverHang - Re_BufSz = Re_BufSz + 1 ! ShftGagL - Re_BufSz = Re_BufSz + 1 ! ShftTilt - Re_BufSz = Re_BufSz + 1 ! NacCMxn - Re_BufSz = Re_BufSz + 1 ! NacCMyn - Re_BufSz = Re_BufSz + 1 ! NacCMzn - Re_BufSz = Re_BufSz + 1 ! NcIMUxn - Re_BufSz = Re_BufSz + 1 ! NcIMUyn - Re_BufSz = Re_BufSz + 1 ! NcIMUzn - Re_BufSz = Re_BufSz + 1 ! Twr2Shft - Re_BufSz = Re_BufSz + 1 ! TowerHt - Re_BufSz = Re_BufSz + 1 ! TowerBsHt - Re_BufSz = Re_BufSz + 1 ! PtfmCMxt - Re_BufSz = Re_BufSz + 1 ! PtfmCMyt - Re_BufSz = Re_BufSz + 1 ! PtfmCMzt - Re_BufSz = Re_BufSz + 1 ! PtfmRefzt - Int_BufSz = Int_BufSz + 1 ! TipMass allocated yes/no - IF ( ALLOCATED(InData%TipMass) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TipMass upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TipMass) ! TipMass - END IF - Re_BufSz = Re_BufSz + 1 ! HubMass - Re_BufSz = Re_BufSz + 1 ! HubIner - Re_BufSz = Re_BufSz + 1 ! GenIner - Re_BufSz = Re_BufSz + 1 ! NacMass - Re_BufSz = Re_BufSz + 1 ! NacYIner - Re_BufSz = Re_BufSz + 1 ! YawBrMass - Re_BufSz = Re_BufSz + 1 ! PtfmMass - Re_BufSz = Re_BufSz + 1 ! PtfmRIner - Re_BufSz = Re_BufSz + 1 ! PtfmPIner - Re_BufSz = Re_BufSz + 1 ! PtfmYIner - Re_BufSz = Re_BufSz + 1 ! BldNodes - Int_BufSz = Int_BufSz + 1 ! InpBlMesh allocated yes/no - IF ( ALLOCATED(InData%InpBlMesh) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! InpBlMesh upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%InpBlMesh,1), UBOUND(InData%InpBlMesh,1) - Int_BufSz = Int_BufSz + 3 ! InpBlMesh: size of buffers for each call to pack subtype - CALL ED_Packblademeshinputdata( Re_Buf, Db_Buf, Int_Buf, InData%InpBlMesh(i1), ErrStat2, ErrMsg2, .TRUE. ) ! InpBlMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! InpBlMesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! InpBlMesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! InpBlMesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! InpBl allocated yes/no - IF ( ALLOCATED(InData%InpBl) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! InpBl upper/lower bounds for each dimension - DO i1 = LBOUND(InData%InpBl,1), UBOUND(InData%InpBl,1) - Int_BufSz = Int_BufSz + 3 ! InpBl: size of buffers for each call to pack subtype - CALL ED_Packbladeinputdata( Re_Buf, Db_Buf, Int_Buf, InData%InpBl(i1), ErrStat2, ErrMsg2, .TRUE. ) ! InpBl - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! InpBl - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! InpBl - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! InpBl - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! TeetMod - Re_BufSz = Re_BufSz + 1 ! TeetDmpP - Re_BufSz = Re_BufSz + 1 ! TeetDmp - Re_BufSz = Re_BufSz + 1 ! TeetCDmp - Re_BufSz = Re_BufSz + 1 ! TeetSStP - Re_BufSz = Re_BufSz + 1 ! TeetHStP - Re_BufSz = Re_BufSz + 1 ! TeetSSSp - Re_BufSz = Re_BufSz + 1 ! TeetHSSp - Re_BufSz = Re_BufSz + 1 ! GBoxEff - Re_BufSz = Re_BufSz + 1 ! GBRatio - Re_BufSz = Re_BufSz + 1 ! DTTorSpr - Re_BufSz = Re_BufSz + 1 ! DTTorDmp - Int_BufSz = Int_BufSz + 1 ! Furling - Int_BufSz = Int_BufSz + 1 ! TwrNodes - 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 ! DecFact - Int_BufSz = Int_BufSz + 1 ! NTwGages - Int_BufSz = Int_BufSz + SIZE(InData%TwrGagNd) ! TwrGagNd - Int_BufSz = Int_BufSz + 1 ! NBlGages - Int_BufSz = Int_BufSz + SIZE(InData%BldGagNd) ! BldGagNd - 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 ! NTwInpSt - Re_BufSz = Re_BufSz + SIZE(InData%TwrFADmp) ! TwrFADmp - Re_BufSz = Re_BufSz + SIZE(InData%TwrSSDmp) ! TwrSSDmp - Re_BufSz = Re_BufSz + SIZE(InData%FAStTunr) ! FAStTunr - Re_BufSz = Re_BufSz + SIZE(InData%SSStTunr) ! SSStTunr - Int_BufSz = Int_BufSz + 1 ! HtFract allocated yes/no - IF ( ALLOCATED(InData%HtFract) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! HtFract upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%HtFract) ! HtFract - END IF - Int_BufSz = Int_BufSz + 1 ! TMassDen allocated yes/no - IF ( ALLOCATED(InData%TMassDen) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TMassDen upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TMassDen) ! TMassDen - END IF - Int_BufSz = Int_BufSz + 1 ! TwFAStif allocated yes/no - IF ( ALLOCATED(InData%TwFAStif) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TwFAStif upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TwFAStif) ! TwFAStif - END IF - Int_BufSz = Int_BufSz + 1 ! TwSSStif allocated yes/no - IF ( ALLOCATED(InData%TwSSStif) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TwSSStif upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TwSSStif) ! TwSSStif - END IF - Int_BufSz = Int_BufSz + 1 ! TwFAM1Sh allocated yes/no - IF ( ALLOCATED(InData%TwFAM1Sh) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TwFAM1Sh upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TwFAM1Sh) ! TwFAM1Sh - END IF - Int_BufSz = Int_BufSz + 1 ! TwFAM2Sh allocated yes/no - IF ( ALLOCATED(InData%TwFAM2Sh) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TwFAM2Sh upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TwFAM2Sh) ! TwFAM2Sh - END IF - Int_BufSz = Int_BufSz + 1 ! TwSSM1Sh allocated yes/no - IF ( ALLOCATED(InData%TwSSM1Sh) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TwSSM1Sh upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TwSSM1Sh) ! TwSSM1Sh - END IF - Int_BufSz = Int_BufSz + 1 ! TwSSM2Sh allocated yes/no - IF ( ALLOCATED(InData%TwSSM2Sh) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TwSSM2Sh upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TwSSM2Sh) ! TwSSM2Sh - END IF - Int_BufSz = Int_BufSz + 1 ! RFrlDOF - Int_BufSz = Int_BufSz + 1 ! TFrlDOF - Re_BufSz = Re_BufSz + 1 ! RotFurl - Re_BufSz = Re_BufSz + 1 ! TailFurl - Re_BufSz = Re_BufSz + 1 ! Yaw2Shft - Re_BufSz = Re_BufSz + 1 ! ShftSkew - Re_BufSz = Re_BufSz + SIZE(InData%RFrlCM_n) ! RFrlCM_n - Re_BufSz = Re_BufSz + SIZE(InData%BoomCM_n) ! BoomCM_n - Re_BufSz = Re_BufSz + SIZE(InData%TFinCM_n) ! TFinCM_n - Re_BufSz = Re_BufSz + SIZE(InData%RFrlPnt_n) ! RFrlPnt_n - Re_BufSz = Re_BufSz + 1 ! RFrlSkew - Re_BufSz = Re_BufSz + 1 ! RFrlTilt - Re_BufSz = Re_BufSz + SIZE(InData%TFrlPnt_n) ! TFrlPnt_n - Re_BufSz = Re_BufSz + 1 ! TFrlSkew - Re_BufSz = Re_BufSz + 1 ! TFrlTilt - Re_BufSz = Re_BufSz + 1 ! RFrlMass - Re_BufSz = Re_BufSz + 1 ! BoomMass - Re_BufSz = Re_BufSz + 1 ! TFinMass - Re_BufSz = Re_BufSz + 1 ! RFrlIner - Re_BufSz = Re_BufSz + 1 ! TFrlIner - Int_BufSz = Int_BufSz + 1 ! RFrlMod - Re_BufSz = Re_BufSz + 1 ! RFrlSpr - Re_BufSz = Re_BufSz + 1 ! RFrlDmp - Re_BufSz = Re_BufSz + 1 ! RFrlUSSP - Re_BufSz = Re_BufSz + 1 ! RFrlDSSP - Re_BufSz = Re_BufSz + 1 ! RFrlUSSpr - Re_BufSz = Re_BufSz + 1 ! RFrlDSSpr - Re_BufSz = Re_BufSz + 1 ! RFrlUSDP - Re_BufSz = Re_BufSz + 1 ! RFrlDSDP - Re_BufSz = Re_BufSz + 1 ! RFrlUSDmp - Re_BufSz = Re_BufSz + 1 ! RFrlDSDmp - Int_BufSz = Int_BufSz + 1 ! TFrlMod - Re_BufSz = Re_BufSz + 1 ! TFrlSpr - Re_BufSz = Re_BufSz + 1 ! TFrlDmp - Re_BufSz = Re_BufSz + 1 ! TFrlUSSP - Re_BufSz = Re_BufSz + 1 ! TFrlDSSP - Re_BufSz = Re_BufSz + 1 ! TFrlUSSpr - Re_BufSz = Re_BufSz + 1 ! TFrlDSSpr - Re_BufSz = Re_BufSz + 1 ! TFrlUSDP - Re_BufSz = Re_BufSz + 1 ! TFrlDSDP - Re_BufSz = Re_BufSz + 1 ! TFrlUSDmp - Re_BufSz = Re_BufSz + 1 ! TFrlDSDmp - Int_BufSz = Int_BufSz + 1 ! method - Int_BufSz = Int_BufSz + 1 ! BldNd_NumOuts - Int_BufSz = Int_BufSz + 1 ! BldNd_OutList allocated yes/no - IF ( ALLOCATED(InData%BldNd_OutList) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BldNd_OutList upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%BldNd_OutList)*LEN(InData%BldNd_OutList) ! BldNd_OutList - END IF - Int_BufSz = Int_BufSz + 1*LEN(InData%BldNd_BlOutNd_Str) ! BldNd_BlOutNd_Str - Int_BufSz = Int_BufSz + 1 ! BldNd_BladesOut - 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%FlapDOF1, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%FlapDOF2, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%EdgeDOF, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%TeetDOF, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%DrTrDOF, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%GenDOF, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%YawDOF, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%TwFADOF1, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%TwFADOF2, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%TwSSDOF1, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%TwSSDOF2, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%PtfmSgDOF, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%PtfmSwDOF, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%PtfmHvDOF, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%PtfmRDOF, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%PtfmPDOF, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%PtfmYDOF, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%OoPDefl - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%IPDefl - Re_Xferred = Re_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%TeetDefl - Re_Xferred = Re_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%Azimuth - Db_Xferred = Db_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RotSpeed - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%NacYaw - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TTDspFA - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TTDspSS - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PtfmSurge - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PtfmSway - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PtfmHeave - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PtfmRoll - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PtfmPitch - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PtfmYaw - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumBl - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TipRad - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%HubRad - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%PreCone) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PreCone,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PreCone,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PreCone,1), UBOUND(InData%PreCone,1) - ReKiBuf(Re_Xferred) = InData%PreCone(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%HubCM - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%UndSling - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Delta3 - Re_Xferred = Re_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%AzimB1Up - Db_Xferred = Db_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%OverHang - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%ShftGagL - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%ShftTilt - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%NacCMxn - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%NacCMyn - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%NacCMzn - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%NcIMUxn - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%NcIMUyn - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%NcIMUzn - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Twr2Shft - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TowerHt - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TowerBsHt - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PtfmCMxt - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PtfmCMyt - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PtfmCMzt - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PtfmRefzt - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%TipMass) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TipMass,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TipMass,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TipMass,1), UBOUND(InData%TipMass,1) - ReKiBuf(Re_Xferred) = InData%TipMass(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%HubMass - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%HubIner - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%GenIner - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%NacMass - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%NacYIner - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%YawBrMass - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PtfmMass - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PtfmRIner - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PtfmPIner - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PtfmYIner - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%BldNodes - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%InpBlMesh) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InpBlMesh,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InpBlMesh,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%InpBlMesh,1), UBOUND(InData%InpBlMesh,1) - CALL ED_Packblademeshinputdata( Re_Buf, Db_Buf, Int_Buf, InData%InpBlMesh(i1), ErrStat2, ErrMsg2, OnlySize ) ! InpBlMesh - 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%InpBl) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InpBl,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InpBl,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%InpBl,1), UBOUND(InData%InpBl,1) - CALL ED_Packbladeinputdata( Re_Buf, Db_Buf, Int_Buf, InData%InpBl(i1), ErrStat2, ErrMsg2, OnlySize ) ! InpBl - 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%TeetMod - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TeetDmpP - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TeetDmp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TeetCDmp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TeetSStP - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TeetHStP - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TeetSSSp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TeetHSSp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%GBoxEff - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%GBRatio - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%DTTorSpr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%DTTorDmp - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%Furling, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%TwrNodes - Int_Xferred = Int_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%DecFact - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NTwGages - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%TwrGagNd,1), UBOUND(InData%TwrGagNd,1) - IntKiBuf(Int_Xferred) = InData%TwrGagNd(i1) - Int_Xferred = Int_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%NBlGages - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%BldGagNd,1), UBOUND(InData%BldGagNd,1) - IntKiBuf(Int_Xferred) = InData%BldGagNd(i1) - Int_Xferred = Int_Xferred + 1 - END DO - 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 - IntKiBuf(Int_Xferred) = InData%NTwInpSt - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%TwrFADmp,1), UBOUND(InData%TwrFADmp,1) - ReKiBuf(Re_Xferred) = InData%TwrFADmp(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%TwrSSDmp,1), UBOUND(InData%TwrSSDmp,1) - ReKiBuf(Re_Xferred) = InData%TwrSSDmp(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%FAStTunr,1), UBOUND(InData%FAStTunr,1) - ReKiBuf(Re_Xferred) = InData%FAStTunr(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%SSStTunr,1), UBOUND(InData%SSStTunr,1) - ReKiBuf(Re_Xferred) = InData%SSStTunr(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%HtFract) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%HtFract,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%HtFract,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%HtFract,1), UBOUND(InData%HtFract,1) - ReKiBuf(Re_Xferred) = InData%HtFract(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TMassDen) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TMassDen,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TMassDen,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TMassDen,1), UBOUND(InData%TMassDen,1) - ReKiBuf(Re_Xferred) = InData%TMassDen(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TwFAStif) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwFAStif,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwFAStif,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TwFAStif,1), UBOUND(InData%TwFAStif,1) - ReKiBuf(Re_Xferred) = InData%TwFAStif(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TwSSStif) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwSSStif,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwSSStif,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TwSSStif,1), UBOUND(InData%TwSSStif,1) - ReKiBuf(Re_Xferred) = InData%TwSSStif(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TwFAM1Sh) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwFAM1Sh,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwFAM1Sh,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TwFAM1Sh,1), UBOUND(InData%TwFAM1Sh,1) - ReKiBuf(Re_Xferred) = InData%TwFAM1Sh(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TwFAM2Sh) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwFAM2Sh,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwFAM2Sh,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TwFAM2Sh,1), UBOUND(InData%TwFAM2Sh,1) - ReKiBuf(Re_Xferred) = InData%TwFAM2Sh(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TwSSM1Sh) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwSSM1Sh,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwSSM1Sh,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TwSSM1Sh,1), UBOUND(InData%TwSSM1Sh,1) - ReKiBuf(Re_Xferred) = InData%TwSSM1Sh(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TwSSM2Sh) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwSSM2Sh,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwSSM2Sh,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TwSSM2Sh,1), UBOUND(InData%TwSSM2Sh,1) - ReKiBuf(Re_Xferred) = InData%TwSSM2Sh(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = TRANSFER(InData%RFrlDOF, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%TFrlDOF, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RotFurl - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TailFurl - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Yaw2Shft - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%ShftSkew - Re_Xferred = Re_Xferred + 1 - DO i1 = LBOUND(InData%RFrlCM_n,1), UBOUND(InData%RFrlCM_n,1) - ReKiBuf(Re_Xferred) = InData%RFrlCM_n(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%BoomCM_n,1), UBOUND(InData%BoomCM_n,1) - ReKiBuf(Re_Xferred) = InData%BoomCM_n(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%TFinCM_n,1), UBOUND(InData%TFinCM_n,1) - ReKiBuf(Re_Xferred) = InData%TFinCM_n(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%RFrlPnt_n,1), UBOUND(InData%RFrlPnt_n,1) - ReKiBuf(Re_Xferred) = InData%RFrlPnt_n(i1) - Re_Xferred = Re_Xferred + 1 - END DO - ReKiBuf(Re_Xferred) = InData%RFrlSkew - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RFrlTilt - Re_Xferred = Re_Xferred + 1 - DO i1 = LBOUND(InData%TFrlPnt_n,1), UBOUND(InData%TFrlPnt_n,1) - ReKiBuf(Re_Xferred) = InData%TFrlPnt_n(i1) - Re_Xferred = Re_Xferred + 1 - END DO - ReKiBuf(Re_Xferred) = InData%TFrlSkew - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TFrlTilt - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RFrlMass - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%BoomMass - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TFinMass - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RFrlIner - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TFrlIner - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%RFrlMod - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RFrlSpr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RFrlDmp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RFrlUSSP - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RFrlDSSP - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RFrlUSSpr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RFrlDSSpr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RFrlUSDP - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RFrlDSDP - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RFrlUSDmp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RFrlDSDmp - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%TFrlMod - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TFrlSpr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TFrlDmp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TFrlUSSP - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TFrlDSSP - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TFrlUSSpr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TFrlDSSpr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TFrlUSDP - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TFrlDSDP - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TFrlUSDmp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TFrlDSDmp - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%method - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%BldNd_NumOuts - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%BldNd_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%BldNd_OutList,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldNd_OutList,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BldNd_OutList,1), UBOUND(InData%BldNd_OutList,1) - DO I = 1, LEN(InData%BldNd_OutList) - IntKiBuf(Int_Xferred) = ICHAR(InData%BldNd_OutList(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - DO I = 1, LEN(InData%BldNd_BlOutNd_Str) - IntKiBuf(Int_Xferred) = ICHAR(InData%BldNd_BlOutNd_Str(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = InData%BldNd_BladesOut - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE ED_PackInputFile - - SUBROUTINE ED_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(ED_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 = 'ED_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%FlapDOF1 = TRANSFER(IntKiBuf(Int_Xferred), OutData%FlapDOF1) - Int_Xferred = Int_Xferred + 1 - OutData%FlapDOF2 = TRANSFER(IntKiBuf(Int_Xferred), OutData%FlapDOF2) - Int_Xferred = Int_Xferred + 1 - OutData%EdgeDOF = TRANSFER(IntKiBuf(Int_Xferred), OutData%EdgeDOF) - Int_Xferred = Int_Xferred + 1 - OutData%TeetDOF = TRANSFER(IntKiBuf(Int_Xferred), OutData%TeetDOF) - Int_Xferred = Int_Xferred + 1 - OutData%DrTrDOF = TRANSFER(IntKiBuf(Int_Xferred), OutData%DrTrDOF) - Int_Xferred = Int_Xferred + 1 - OutData%GenDOF = TRANSFER(IntKiBuf(Int_Xferred), OutData%GenDOF) - Int_Xferred = Int_Xferred + 1 - OutData%YawDOF = TRANSFER(IntKiBuf(Int_Xferred), OutData%YawDOF) - Int_Xferred = Int_Xferred + 1 - OutData%TwFADOF1 = TRANSFER(IntKiBuf(Int_Xferred), OutData%TwFADOF1) - Int_Xferred = Int_Xferred + 1 - OutData%TwFADOF2 = TRANSFER(IntKiBuf(Int_Xferred), OutData%TwFADOF2) - Int_Xferred = Int_Xferred + 1 - OutData%TwSSDOF1 = TRANSFER(IntKiBuf(Int_Xferred), OutData%TwSSDOF1) - Int_Xferred = Int_Xferred + 1 - OutData%TwSSDOF2 = TRANSFER(IntKiBuf(Int_Xferred), OutData%TwSSDOF2) - Int_Xferred = Int_Xferred + 1 - OutData%PtfmSgDOF = TRANSFER(IntKiBuf(Int_Xferred), OutData%PtfmSgDOF) - Int_Xferred = Int_Xferred + 1 - OutData%PtfmSwDOF = TRANSFER(IntKiBuf(Int_Xferred), OutData%PtfmSwDOF) - Int_Xferred = Int_Xferred + 1 - OutData%PtfmHvDOF = TRANSFER(IntKiBuf(Int_Xferred), OutData%PtfmHvDOF) - Int_Xferred = Int_Xferred + 1 - OutData%PtfmRDOF = TRANSFER(IntKiBuf(Int_Xferred), OutData%PtfmRDOF) - Int_Xferred = Int_Xferred + 1 - OutData%PtfmPDOF = TRANSFER(IntKiBuf(Int_Xferred), OutData%PtfmPDOF) - Int_Xferred = Int_Xferred + 1 - OutData%PtfmYDOF = TRANSFER(IntKiBuf(Int_Xferred), OutData%PtfmYDOF) - Int_Xferred = Int_Xferred + 1 - OutData%OoPDefl = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%IPDefl = ReKiBuf(Re_Xferred) - Re_Xferred = Re_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%TeetDefl = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Azimuth = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%RotSpeed = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NacYaw = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TTDspFA = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TTDspSS = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmSurge = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmSway = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmHeave = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmRoll = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmPitch = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmYaw = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NumBl = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TipRad = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%HubRad = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PreCone not allocated - Int_Xferred = Int_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%PreCone)) DEALLOCATE(OutData%PreCone) - ALLOCATE(OutData%PreCone(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PreCone.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PreCone,1), UBOUND(OutData%PreCone,1) - OutData%PreCone(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%HubCM = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%UndSling = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Delta3 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%AzimB1Up = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%OverHang = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%ShftGagL = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%ShftTilt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NacCMxn = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NacCMyn = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NacCMzn = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NcIMUxn = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NcIMUyn = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NcIMUzn = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Twr2Shft = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TowerHt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TowerBsHt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmCMxt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmCMyt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmCMzt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmRefzt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TipMass not allocated - Int_Xferred = Int_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%TipMass)) DEALLOCATE(OutData%TipMass) - ALLOCATE(OutData%TipMass(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TipMass.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TipMass,1), UBOUND(OutData%TipMass,1) - OutData%TipMass(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%HubMass = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%HubIner = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%GenIner = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NacMass = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NacYIner = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%YawBrMass = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmMass = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmRIner = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmPIner = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmYIner = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%BldNodes = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InpBlMesh not allocated - Int_Xferred = Int_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%InpBlMesh)) DEALLOCATE(OutData%InpBlMesh) - ALLOCATE(OutData%InpBlMesh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InpBlMesh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%InpBlMesh,1), UBOUND(OutData%InpBlMesh,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 ED_Unpackblademeshinputdata( Re_Buf, Db_Buf, Int_Buf, OutData%InpBlMesh(i1), ErrStat2, ErrMsg2 ) ! InpBlMesh - 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 ! InpBl not allocated - Int_Xferred = Int_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%InpBl)) DEALLOCATE(OutData%InpBl) - ALLOCATE(OutData%InpBl(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InpBl.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%InpBl,1), UBOUND(OutData%InpBl,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 ED_Unpackbladeinputdata( Re_Buf, Db_Buf, Int_Buf, OutData%InpBl(i1), ErrStat2, ErrMsg2 ) ! InpBl - 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%TeetMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TeetDmpP = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TeetDmp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TeetCDmp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TeetSStP = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TeetHStP = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TeetSSSp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TeetHSSp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%GBoxEff = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%GBRatio = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%DTTorSpr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%DTTorDmp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Furling = TRANSFER(IntKiBuf(Int_Xferred), OutData%Furling) - Int_Xferred = Int_Xferred + 1 - OutData%TwrNodes = IntKiBuf(Int_Xferred) - Int_Xferred = Int_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%DecFact = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NTwGages = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%TwrGagNd,1) - i1_u = UBOUND(OutData%TwrGagNd,1) - DO i1 = LBOUND(OutData%TwrGagNd,1), UBOUND(OutData%TwrGagNd,1) - OutData%TwrGagNd(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - OutData%NBlGages = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%BldGagNd,1) - i1_u = UBOUND(OutData%BldGagNd,1) - DO i1 = LBOUND(OutData%BldGagNd,1), UBOUND(OutData%BldGagNd,1) - OutData%BldGagNd(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - 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 - OutData%NTwInpSt = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%TwrFADmp,1) - i1_u = UBOUND(OutData%TwrFADmp,1) - DO i1 = LBOUND(OutData%TwrFADmp,1), UBOUND(OutData%TwrFADmp,1) - OutData%TwrFADmp(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%TwrSSDmp,1) - i1_u = UBOUND(OutData%TwrSSDmp,1) - DO i1 = LBOUND(OutData%TwrSSDmp,1), UBOUND(OutData%TwrSSDmp,1) - OutData%TwrSSDmp(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%FAStTunr,1) - i1_u = UBOUND(OutData%FAStTunr,1) - DO i1 = LBOUND(OutData%FAStTunr,1), UBOUND(OutData%FAStTunr,1) - OutData%FAStTunr(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%SSStTunr,1) - i1_u = UBOUND(OutData%SSStTunr,1) - DO i1 = LBOUND(OutData%SSStTunr,1), UBOUND(OutData%SSStTunr,1) - OutData%SSStTunr(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! HtFract not allocated - Int_Xferred = Int_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%HtFract)) DEALLOCATE(OutData%HtFract) - ALLOCATE(OutData%HtFract(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%HtFract.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%HtFract,1), UBOUND(OutData%HtFract,1) - OutData%HtFract(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TMassDen not allocated - Int_Xferred = Int_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%TMassDen)) DEALLOCATE(OutData%TMassDen) - ALLOCATE(OutData%TMassDen(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TMassDen.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TMassDen,1), UBOUND(OutData%TMassDen,1) - OutData%TMassDen(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwFAStif not allocated - Int_Xferred = Int_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%TwFAStif)) DEALLOCATE(OutData%TwFAStif) - ALLOCATE(OutData%TwFAStif(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwFAStif.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TwFAStif,1), UBOUND(OutData%TwFAStif,1) - OutData%TwFAStif(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwSSStif not allocated - Int_Xferred = Int_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%TwSSStif)) DEALLOCATE(OutData%TwSSStif) - ALLOCATE(OutData%TwSSStif(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwSSStif.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TwSSStif,1), UBOUND(OutData%TwSSStif,1) - OutData%TwSSStif(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwFAM1Sh not allocated - Int_Xferred = Int_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%TwFAM1Sh)) DEALLOCATE(OutData%TwFAM1Sh) - ALLOCATE(OutData%TwFAM1Sh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwFAM1Sh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TwFAM1Sh,1), UBOUND(OutData%TwFAM1Sh,1) - OutData%TwFAM1Sh(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwFAM2Sh not allocated - Int_Xferred = Int_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%TwFAM2Sh)) DEALLOCATE(OutData%TwFAM2Sh) - ALLOCATE(OutData%TwFAM2Sh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwFAM2Sh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TwFAM2Sh,1), UBOUND(OutData%TwFAM2Sh,1) - OutData%TwFAM2Sh(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwSSM1Sh not allocated - Int_Xferred = Int_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%TwSSM1Sh)) DEALLOCATE(OutData%TwSSM1Sh) - ALLOCATE(OutData%TwSSM1Sh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwSSM1Sh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TwSSM1Sh,1), UBOUND(OutData%TwSSM1Sh,1) - OutData%TwSSM1Sh(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwSSM2Sh not allocated - Int_Xferred = Int_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%TwSSM2Sh)) DEALLOCATE(OutData%TwSSM2Sh) - ALLOCATE(OutData%TwSSM2Sh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwSSM2Sh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TwSSM2Sh,1), UBOUND(OutData%TwSSM2Sh,1) - OutData%TwSSM2Sh(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%RFrlDOF = TRANSFER(IntKiBuf(Int_Xferred), OutData%RFrlDOF) - Int_Xferred = Int_Xferred + 1 - OutData%TFrlDOF = TRANSFER(IntKiBuf(Int_Xferred), OutData%TFrlDOF) - Int_Xferred = Int_Xferred + 1 - OutData%RotFurl = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TailFurl = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Yaw2Shft = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%ShftSkew = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%RFrlCM_n,1) - i1_u = UBOUND(OutData%RFrlCM_n,1) - DO i1 = LBOUND(OutData%RFrlCM_n,1), UBOUND(OutData%RFrlCM_n,1) - OutData%RFrlCM_n(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%BoomCM_n,1) - i1_u = UBOUND(OutData%BoomCM_n,1) - DO i1 = LBOUND(OutData%BoomCM_n,1), UBOUND(OutData%BoomCM_n,1) - OutData%BoomCM_n(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%TFinCM_n,1) - i1_u = UBOUND(OutData%TFinCM_n,1) - DO i1 = LBOUND(OutData%TFinCM_n,1), UBOUND(OutData%TFinCM_n,1) - OutData%TFinCM_n(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%RFrlPnt_n,1) - i1_u = UBOUND(OutData%RFrlPnt_n,1) - DO i1 = LBOUND(OutData%RFrlPnt_n,1), UBOUND(OutData%RFrlPnt_n,1) - OutData%RFrlPnt_n(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%RFrlSkew = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlTilt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%TFrlPnt_n,1) - i1_u = UBOUND(OutData%TFrlPnt_n,1) - DO i1 = LBOUND(OutData%TFrlPnt_n,1), UBOUND(OutData%TFrlPnt_n,1) - OutData%TFrlPnt_n(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%TFrlSkew = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlTilt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlMass = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%BoomMass = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TFinMass = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlIner = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlIner = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%RFrlSpr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlDmp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlUSSP = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlDSSP = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlUSSpr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlDSSpr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlUSDP = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlDSDP = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlUSDmp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlDSDmp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TFrlSpr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlDmp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlUSSP = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlDSSP = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlUSSpr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlDSSpr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlUSDP = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlDSDP = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlUSDmp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlDSDmp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%method = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%BldNd_NumOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldNd_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%BldNd_OutList)) DEALLOCATE(OutData%BldNd_OutList) - ALLOCATE(OutData%BldNd_OutList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldNd_OutList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BldNd_OutList,1), UBOUND(OutData%BldNd_OutList,1) - DO I = 1, LEN(OutData%BldNd_OutList) - OutData%BldNd_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%BldNd_BlOutNd_Str) - OutData%BldNd_BlOutNd_Str(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%BldNd_BladesOut = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE ED_UnPackInputFile - - SUBROUTINE ED_CopyCoordSys( SrcCoordSysData, DstCoordSysData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ED_CoordSys), INTENT(IN) :: SrcCoordSysData - TYPE(ED_CoordSys), INTENT(INOUT) :: DstCoordSysData - 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 = 'ED_CopyCoordSys' -! - ErrStat = ErrID_None - ErrMsg = "" - DstCoordSysData%a1 = SrcCoordSysData%a1 - DstCoordSysData%a2 = SrcCoordSysData%a2 - DstCoordSysData%a3 = SrcCoordSysData%a3 - DstCoordSysData%b1 = SrcCoordSysData%b1 - DstCoordSysData%b2 = SrcCoordSysData%b2 - DstCoordSysData%b3 = SrcCoordSysData%b3 - DstCoordSysData%c1 = SrcCoordSysData%c1 - DstCoordSysData%c2 = SrcCoordSysData%c2 - DstCoordSysData%c3 = SrcCoordSysData%c3 - DstCoordSysData%d1 = SrcCoordSysData%d1 - DstCoordSysData%d2 = SrcCoordSysData%d2 - DstCoordSysData%d3 = SrcCoordSysData%d3 - DstCoordSysData%e1 = SrcCoordSysData%e1 - DstCoordSysData%e2 = SrcCoordSysData%e2 - DstCoordSysData%e3 = SrcCoordSysData%e3 - DstCoordSysData%f1 = SrcCoordSysData%f1 - DstCoordSysData%f2 = SrcCoordSysData%f2 - DstCoordSysData%f3 = SrcCoordSysData%f3 - DstCoordSysData%g1 = SrcCoordSysData%g1 - DstCoordSysData%g2 = SrcCoordSysData%g2 - DstCoordSysData%g3 = SrcCoordSysData%g3 -IF (ALLOCATED(SrcCoordSysData%i1)) THEN - i1_l = LBOUND(SrcCoordSysData%i1,1) - i1_u = UBOUND(SrcCoordSysData%i1,1) - i2_l = LBOUND(SrcCoordSysData%i1,2) - i2_u = UBOUND(SrcCoordSysData%i1,2) - IF (.NOT. ALLOCATED(DstCoordSysData%i1)) THEN - ALLOCATE(DstCoordSysData%i1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstCoordSysData%i1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstCoordSysData%i1 = SrcCoordSysData%i1 -ENDIF -IF (ALLOCATED(SrcCoordSysData%i2)) THEN - i1_l = LBOUND(SrcCoordSysData%i2,1) - i1_u = UBOUND(SrcCoordSysData%i2,1) - i2_l = LBOUND(SrcCoordSysData%i2,2) - i2_u = UBOUND(SrcCoordSysData%i2,2) - IF (.NOT. ALLOCATED(DstCoordSysData%i2)) THEN - ALLOCATE(DstCoordSysData%i2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstCoordSysData%i2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstCoordSysData%i2 = SrcCoordSysData%i2 -ENDIF -IF (ALLOCATED(SrcCoordSysData%i3)) THEN - i1_l = LBOUND(SrcCoordSysData%i3,1) - i1_u = UBOUND(SrcCoordSysData%i3,1) - i2_l = LBOUND(SrcCoordSysData%i3,2) - i2_u = UBOUND(SrcCoordSysData%i3,2) - IF (.NOT. ALLOCATED(DstCoordSysData%i3)) THEN - ALLOCATE(DstCoordSysData%i3(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstCoordSysData%i3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstCoordSysData%i3 = SrcCoordSysData%i3 -ENDIF -IF (ALLOCATED(SrcCoordSysData%j1)) THEN - i1_l = LBOUND(SrcCoordSysData%j1,1) - i1_u = UBOUND(SrcCoordSysData%j1,1) - i2_l = LBOUND(SrcCoordSysData%j1,2) - i2_u = UBOUND(SrcCoordSysData%j1,2) - IF (.NOT. ALLOCATED(DstCoordSysData%j1)) THEN - ALLOCATE(DstCoordSysData%j1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstCoordSysData%j1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstCoordSysData%j1 = SrcCoordSysData%j1 -ENDIF -IF (ALLOCATED(SrcCoordSysData%j2)) THEN - i1_l = LBOUND(SrcCoordSysData%j2,1) - i1_u = UBOUND(SrcCoordSysData%j2,1) - i2_l = LBOUND(SrcCoordSysData%j2,2) - i2_u = UBOUND(SrcCoordSysData%j2,2) - IF (.NOT. ALLOCATED(DstCoordSysData%j2)) THEN - ALLOCATE(DstCoordSysData%j2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstCoordSysData%j2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstCoordSysData%j2 = SrcCoordSysData%j2 -ENDIF -IF (ALLOCATED(SrcCoordSysData%j3)) THEN - i1_l = LBOUND(SrcCoordSysData%j3,1) - i1_u = UBOUND(SrcCoordSysData%j3,1) - i2_l = LBOUND(SrcCoordSysData%j3,2) - i2_u = UBOUND(SrcCoordSysData%j3,2) - IF (.NOT. ALLOCATED(DstCoordSysData%j3)) THEN - ALLOCATE(DstCoordSysData%j3(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstCoordSysData%j3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstCoordSysData%j3 = SrcCoordSysData%j3 -ENDIF -IF (ALLOCATED(SrcCoordSysData%m1)) THEN - i1_l = LBOUND(SrcCoordSysData%m1,1) - i1_u = UBOUND(SrcCoordSysData%m1,1) - i2_l = LBOUND(SrcCoordSysData%m1,2) - i2_u = UBOUND(SrcCoordSysData%m1,2) - i3_l = LBOUND(SrcCoordSysData%m1,3) - i3_u = UBOUND(SrcCoordSysData%m1,3) - IF (.NOT. ALLOCATED(DstCoordSysData%m1)) THEN - ALLOCATE(DstCoordSysData%m1(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstCoordSysData%m1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstCoordSysData%m1 = SrcCoordSysData%m1 -ENDIF -IF (ALLOCATED(SrcCoordSysData%m2)) THEN - i1_l = LBOUND(SrcCoordSysData%m2,1) - i1_u = UBOUND(SrcCoordSysData%m2,1) - i2_l = LBOUND(SrcCoordSysData%m2,2) - i2_u = UBOUND(SrcCoordSysData%m2,2) - i3_l = LBOUND(SrcCoordSysData%m2,3) - i3_u = UBOUND(SrcCoordSysData%m2,3) - IF (.NOT. ALLOCATED(DstCoordSysData%m2)) THEN - ALLOCATE(DstCoordSysData%m2(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstCoordSysData%m2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstCoordSysData%m2 = SrcCoordSysData%m2 -ENDIF -IF (ALLOCATED(SrcCoordSysData%m3)) THEN - i1_l = LBOUND(SrcCoordSysData%m3,1) - i1_u = UBOUND(SrcCoordSysData%m3,1) - i2_l = LBOUND(SrcCoordSysData%m3,2) - i2_u = UBOUND(SrcCoordSysData%m3,2) - i3_l = LBOUND(SrcCoordSysData%m3,3) - i3_u = UBOUND(SrcCoordSysData%m3,3) - IF (.NOT. ALLOCATED(DstCoordSysData%m3)) THEN - ALLOCATE(DstCoordSysData%m3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstCoordSysData%m3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstCoordSysData%m3 = SrcCoordSysData%m3 -ENDIF -IF (ALLOCATED(SrcCoordSysData%n1)) THEN - i1_l = LBOUND(SrcCoordSysData%n1,1) - i1_u = UBOUND(SrcCoordSysData%n1,1) - i2_l = LBOUND(SrcCoordSysData%n1,2) - i2_u = UBOUND(SrcCoordSysData%n1,2) - i3_l = LBOUND(SrcCoordSysData%n1,3) - i3_u = UBOUND(SrcCoordSysData%n1,3) - IF (.NOT. ALLOCATED(DstCoordSysData%n1)) THEN - ALLOCATE(DstCoordSysData%n1(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstCoordSysData%n1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstCoordSysData%n1 = SrcCoordSysData%n1 -ENDIF -IF (ALLOCATED(SrcCoordSysData%n2)) THEN - i1_l = LBOUND(SrcCoordSysData%n2,1) - i1_u = UBOUND(SrcCoordSysData%n2,1) - i2_l = LBOUND(SrcCoordSysData%n2,2) - i2_u = UBOUND(SrcCoordSysData%n2,2) - i3_l = LBOUND(SrcCoordSysData%n2,3) - i3_u = UBOUND(SrcCoordSysData%n2,3) - IF (.NOT. ALLOCATED(DstCoordSysData%n2)) THEN - ALLOCATE(DstCoordSysData%n2(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstCoordSysData%n2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstCoordSysData%n2 = SrcCoordSysData%n2 -ENDIF -IF (ALLOCATED(SrcCoordSysData%n3)) THEN - i1_l = LBOUND(SrcCoordSysData%n3,1) - i1_u = UBOUND(SrcCoordSysData%n3,1) - i2_l = LBOUND(SrcCoordSysData%n3,2) - i2_u = UBOUND(SrcCoordSysData%n3,2) - i3_l = LBOUND(SrcCoordSysData%n3,3) - i3_u = UBOUND(SrcCoordSysData%n3,3) - IF (.NOT. ALLOCATED(DstCoordSysData%n3)) THEN - ALLOCATE(DstCoordSysData%n3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstCoordSysData%n3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstCoordSysData%n3 = SrcCoordSysData%n3 -ENDIF - DstCoordSysData%rf1 = SrcCoordSysData%rf1 - DstCoordSysData%rf2 = SrcCoordSysData%rf2 - DstCoordSysData%rf3 = SrcCoordSysData%rf3 - DstCoordSysData%rfa = SrcCoordSysData%rfa -IF (ALLOCATED(SrcCoordSysData%t1)) THEN - i1_l = LBOUND(SrcCoordSysData%t1,1) - i1_u = UBOUND(SrcCoordSysData%t1,1) - i2_l = LBOUND(SrcCoordSysData%t1,2) - i2_u = UBOUND(SrcCoordSysData%t1,2) - IF (.NOT. ALLOCATED(DstCoordSysData%t1)) THEN - ALLOCATE(DstCoordSysData%t1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstCoordSysData%t1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstCoordSysData%t1 = SrcCoordSysData%t1 -ENDIF -IF (ALLOCATED(SrcCoordSysData%t2)) THEN - i1_l = LBOUND(SrcCoordSysData%t2,1) - i1_u = UBOUND(SrcCoordSysData%t2,1) - i2_l = LBOUND(SrcCoordSysData%t2,2) - i2_u = UBOUND(SrcCoordSysData%t2,2) - IF (.NOT. ALLOCATED(DstCoordSysData%t2)) THEN - ALLOCATE(DstCoordSysData%t2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstCoordSysData%t2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstCoordSysData%t2 = SrcCoordSysData%t2 -ENDIF -IF (ALLOCATED(SrcCoordSysData%t3)) THEN - i1_l = LBOUND(SrcCoordSysData%t3,1) - i1_u = UBOUND(SrcCoordSysData%t3,1) - i2_l = LBOUND(SrcCoordSysData%t3,2) - i2_u = UBOUND(SrcCoordSysData%t3,2) - IF (.NOT. ALLOCATED(DstCoordSysData%t3)) THEN - ALLOCATE(DstCoordSysData%t3(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstCoordSysData%t3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstCoordSysData%t3 = SrcCoordSysData%t3 -ENDIF -IF (ALLOCATED(SrcCoordSysData%te1)) THEN - i1_l = LBOUND(SrcCoordSysData%te1,1) - i1_u = UBOUND(SrcCoordSysData%te1,1) - i2_l = LBOUND(SrcCoordSysData%te1,2) - i2_u = UBOUND(SrcCoordSysData%te1,2) - i3_l = LBOUND(SrcCoordSysData%te1,3) - i3_u = UBOUND(SrcCoordSysData%te1,3) - IF (.NOT. ALLOCATED(DstCoordSysData%te1)) THEN - ALLOCATE(DstCoordSysData%te1(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstCoordSysData%te1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstCoordSysData%te1 = SrcCoordSysData%te1 -ENDIF -IF (ALLOCATED(SrcCoordSysData%te2)) THEN - i1_l = LBOUND(SrcCoordSysData%te2,1) - i1_u = UBOUND(SrcCoordSysData%te2,1) - i2_l = LBOUND(SrcCoordSysData%te2,2) - i2_u = UBOUND(SrcCoordSysData%te2,2) - i3_l = LBOUND(SrcCoordSysData%te2,3) - i3_u = UBOUND(SrcCoordSysData%te2,3) - IF (.NOT. ALLOCATED(DstCoordSysData%te2)) THEN - ALLOCATE(DstCoordSysData%te2(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstCoordSysData%te2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstCoordSysData%te2 = SrcCoordSysData%te2 -ENDIF -IF (ALLOCATED(SrcCoordSysData%te3)) THEN - i1_l = LBOUND(SrcCoordSysData%te3,1) - i1_u = UBOUND(SrcCoordSysData%te3,1) - i2_l = LBOUND(SrcCoordSysData%te3,2) - i2_u = UBOUND(SrcCoordSysData%te3,2) - i3_l = LBOUND(SrcCoordSysData%te3,3) - i3_u = UBOUND(SrcCoordSysData%te3,3) - IF (.NOT. ALLOCATED(DstCoordSysData%te3)) THEN - ALLOCATE(DstCoordSysData%te3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstCoordSysData%te3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstCoordSysData%te3 = SrcCoordSysData%te3 -ENDIF - DstCoordSysData%tf1 = SrcCoordSysData%tf1 - DstCoordSysData%tf2 = SrcCoordSysData%tf2 - DstCoordSysData%tf3 = SrcCoordSysData%tf3 - DstCoordSysData%tfa = SrcCoordSysData%tfa - DstCoordSysData%z1 = SrcCoordSysData%z1 - DstCoordSysData%z2 = SrcCoordSysData%z2 - DstCoordSysData%z3 = SrcCoordSysData%z3 - END SUBROUTINE ED_CopyCoordSys - - SUBROUTINE ED_DestroyCoordSys( CoordSysData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(ED_CoordSys), INTENT(INOUT) :: CoordSysData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_DestroyCoordSys' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(CoordSysData%i1)) THEN - DEALLOCATE(CoordSysData%i1) -ENDIF -IF (ALLOCATED(CoordSysData%i2)) THEN - DEALLOCATE(CoordSysData%i2) -ENDIF -IF (ALLOCATED(CoordSysData%i3)) THEN - DEALLOCATE(CoordSysData%i3) -ENDIF -IF (ALLOCATED(CoordSysData%j1)) THEN - DEALLOCATE(CoordSysData%j1) -ENDIF -IF (ALLOCATED(CoordSysData%j2)) THEN - DEALLOCATE(CoordSysData%j2) -ENDIF -IF (ALLOCATED(CoordSysData%j3)) THEN - DEALLOCATE(CoordSysData%j3) -ENDIF -IF (ALLOCATED(CoordSysData%m1)) THEN - DEALLOCATE(CoordSysData%m1) -ENDIF -IF (ALLOCATED(CoordSysData%m2)) THEN - DEALLOCATE(CoordSysData%m2) -ENDIF -IF (ALLOCATED(CoordSysData%m3)) THEN - DEALLOCATE(CoordSysData%m3) -ENDIF -IF (ALLOCATED(CoordSysData%n1)) THEN - DEALLOCATE(CoordSysData%n1) -ENDIF -IF (ALLOCATED(CoordSysData%n2)) THEN - DEALLOCATE(CoordSysData%n2) -ENDIF -IF (ALLOCATED(CoordSysData%n3)) THEN - DEALLOCATE(CoordSysData%n3) -ENDIF -IF (ALLOCATED(CoordSysData%t1)) THEN - DEALLOCATE(CoordSysData%t1) -ENDIF -IF (ALLOCATED(CoordSysData%t2)) THEN - DEALLOCATE(CoordSysData%t2) -ENDIF -IF (ALLOCATED(CoordSysData%t3)) THEN - DEALLOCATE(CoordSysData%t3) -ENDIF -IF (ALLOCATED(CoordSysData%te1)) THEN - DEALLOCATE(CoordSysData%te1) -ENDIF -IF (ALLOCATED(CoordSysData%te2)) THEN - DEALLOCATE(CoordSysData%te2) -ENDIF -IF (ALLOCATED(CoordSysData%te3)) THEN - DEALLOCATE(CoordSysData%te3) -ENDIF - END SUBROUTINE ED_DestroyCoordSys - - SUBROUTINE ED_PackCoordSys( 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(ED_CoordSys), 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 = 'ED_PackCoordSys' - ! 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 + SIZE(InData%a1) ! a1 - Db_BufSz = Db_BufSz + SIZE(InData%a2) ! a2 - Db_BufSz = Db_BufSz + SIZE(InData%a3) ! a3 - Db_BufSz = Db_BufSz + SIZE(InData%b1) ! b1 - Db_BufSz = Db_BufSz + SIZE(InData%b2) ! b2 - Db_BufSz = Db_BufSz + SIZE(InData%b3) ! b3 - Db_BufSz = Db_BufSz + SIZE(InData%c1) ! c1 - Db_BufSz = Db_BufSz + SIZE(InData%c2) ! c2 - Db_BufSz = Db_BufSz + SIZE(InData%c3) ! c3 - Db_BufSz = Db_BufSz + SIZE(InData%d1) ! d1 - Db_BufSz = Db_BufSz + SIZE(InData%d2) ! d2 - Db_BufSz = Db_BufSz + SIZE(InData%d3) ! d3 - Db_BufSz = Db_BufSz + SIZE(InData%e1) ! e1 - Db_BufSz = Db_BufSz + SIZE(InData%e2) ! e2 - Db_BufSz = Db_BufSz + SIZE(InData%e3) ! e3 - Db_BufSz = Db_BufSz + SIZE(InData%f1) ! f1 - Db_BufSz = Db_BufSz + SIZE(InData%f2) ! f2 - Db_BufSz = Db_BufSz + SIZE(InData%f3) ! f3 - Db_BufSz = Db_BufSz + SIZE(InData%g1) ! g1 - Db_BufSz = Db_BufSz + SIZE(InData%g2) ! g2 - Db_BufSz = Db_BufSz + SIZE(InData%g3) ! g3 - Int_BufSz = Int_BufSz + 1 ! i1 allocated yes/no - IF ( ALLOCATED(InData%i1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! i1 upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%i1) ! i1 - END IF - Int_BufSz = Int_BufSz + 1 ! i2 allocated yes/no - IF ( ALLOCATED(InData%i2) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! i2 upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%i2) ! i2 - END IF - Int_BufSz = Int_BufSz + 1 ! i3 allocated yes/no - IF ( ALLOCATED(InData%i3) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! i3 upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%i3) ! i3 - END IF - Int_BufSz = Int_BufSz + 1 ! j1 allocated yes/no - IF ( ALLOCATED(InData%j1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! j1 upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%j1) ! j1 - END IF - Int_BufSz = Int_BufSz + 1 ! j2 allocated yes/no - IF ( ALLOCATED(InData%j2) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! j2 upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%j2) ! j2 - END IF - Int_BufSz = Int_BufSz + 1 ! j3 allocated yes/no - IF ( ALLOCATED(InData%j3) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! j3 upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%j3) ! j3 - END IF - Int_BufSz = Int_BufSz + 1 ! m1 allocated yes/no - IF ( ALLOCATED(InData%m1) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! m1 upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%m1) ! m1 - END IF - Int_BufSz = Int_BufSz + 1 ! m2 allocated yes/no - IF ( ALLOCATED(InData%m2) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! m2 upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%m2) ! m2 - END IF - Int_BufSz = Int_BufSz + 1 ! m3 allocated yes/no - IF ( ALLOCATED(InData%m3) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! m3 upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%m3) ! m3 - END IF - Int_BufSz = Int_BufSz + 1 ! n1 allocated yes/no - IF ( ALLOCATED(InData%n1) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! n1 upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%n1) ! n1 - END IF - Int_BufSz = Int_BufSz + 1 ! n2 allocated yes/no - IF ( ALLOCATED(InData%n2) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! n2 upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%n2) ! n2 - END IF - Int_BufSz = Int_BufSz + 1 ! n3 allocated yes/no - IF ( ALLOCATED(InData%n3) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! n3 upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%n3) ! n3 - END IF - Db_BufSz = Db_BufSz + SIZE(InData%rf1) ! rf1 - Db_BufSz = Db_BufSz + SIZE(InData%rf2) ! rf2 - Db_BufSz = Db_BufSz + SIZE(InData%rf3) ! rf3 - Db_BufSz = Db_BufSz + SIZE(InData%rfa) ! rfa - Int_BufSz = Int_BufSz + 1 ! t1 allocated yes/no - IF ( ALLOCATED(InData%t1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! t1 upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%t1) ! t1 - END IF - Int_BufSz = Int_BufSz + 1 ! t2 allocated yes/no - IF ( ALLOCATED(InData%t2) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! t2 upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%t2) ! t2 - END IF - Int_BufSz = Int_BufSz + 1 ! t3 allocated yes/no - IF ( ALLOCATED(InData%t3) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! t3 upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%t3) ! t3 - END IF - Int_BufSz = Int_BufSz + 1 ! te1 allocated yes/no - IF ( ALLOCATED(InData%te1) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! te1 upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%te1) ! te1 - END IF - Int_BufSz = Int_BufSz + 1 ! te2 allocated yes/no - IF ( ALLOCATED(InData%te2) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! te2 upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%te2) ! te2 - END IF - Int_BufSz = Int_BufSz + 1 ! te3 allocated yes/no - IF ( ALLOCATED(InData%te3) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! te3 upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%te3) ! te3 - END IF - Db_BufSz = Db_BufSz + SIZE(InData%tf1) ! tf1 - Db_BufSz = Db_BufSz + SIZE(InData%tf2) ! tf2 - Db_BufSz = Db_BufSz + SIZE(InData%tf3) ! tf3 - Db_BufSz = Db_BufSz + SIZE(InData%tfa) ! tfa - Db_BufSz = Db_BufSz + SIZE(InData%z1) ! z1 - Db_BufSz = Db_BufSz + SIZE(InData%z2) ! z2 - Db_BufSz = Db_BufSz + SIZE(InData%z3) ! z3 - 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%a1,1), UBOUND(InData%a1,1) - DbKiBuf(Db_Xferred) = InData%a1(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%a2,1), UBOUND(InData%a2,1) - DbKiBuf(Db_Xferred) = InData%a2(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%a3,1), UBOUND(InData%a3,1) - DbKiBuf(Db_Xferred) = InData%a3(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%b1,1), UBOUND(InData%b1,1) - DbKiBuf(Db_Xferred) = InData%b1(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%b2,1), UBOUND(InData%b2,1) - DbKiBuf(Db_Xferred) = InData%b2(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%b3,1), UBOUND(InData%b3,1) - DbKiBuf(Db_Xferred) = InData%b3(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%c1,1), UBOUND(InData%c1,1) - DbKiBuf(Db_Xferred) = InData%c1(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%c2,1), UBOUND(InData%c2,1) - DbKiBuf(Db_Xferred) = InData%c2(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%c3,1), UBOUND(InData%c3,1) - DbKiBuf(Db_Xferred) = InData%c3(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%d1,1), UBOUND(InData%d1,1) - DbKiBuf(Db_Xferred) = InData%d1(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%d2,1), UBOUND(InData%d2,1) - DbKiBuf(Db_Xferred) = InData%d2(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%d3,1), UBOUND(InData%d3,1) - DbKiBuf(Db_Xferred) = InData%d3(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%e1,1), UBOUND(InData%e1,1) - DbKiBuf(Db_Xferred) = InData%e1(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%e2,1), UBOUND(InData%e2,1) - DbKiBuf(Db_Xferred) = InData%e2(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%e3,1), UBOUND(InData%e3,1) - DbKiBuf(Db_Xferred) = InData%e3(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%f1,1), UBOUND(InData%f1,1) - DbKiBuf(Db_Xferred) = InData%f1(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%f2,1), UBOUND(InData%f2,1) - DbKiBuf(Db_Xferred) = InData%f2(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%f3,1), UBOUND(InData%f3,1) - DbKiBuf(Db_Xferred) = InData%f3(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%g1,1), UBOUND(InData%g1,1) - DbKiBuf(Db_Xferred) = InData%g1(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%g2,1), UBOUND(InData%g2,1) - DbKiBuf(Db_Xferred) = InData%g2(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%g3,1), UBOUND(InData%g3,1) - DbKiBuf(Db_Xferred) = InData%g3(i1) - Db_Xferred = Db_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%i1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%i1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%i1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%i1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%i1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%i1,2), UBOUND(InData%i1,2) - DO i1 = LBOUND(InData%i1,1), UBOUND(InData%i1,1) - DbKiBuf(Db_Xferred) = InData%i1(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%i2) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%i2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%i2,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%i2,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%i2,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%i2,2), UBOUND(InData%i2,2) - DO i1 = LBOUND(InData%i2,1), UBOUND(InData%i2,1) - DbKiBuf(Db_Xferred) = InData%i2(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%i3) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%i3,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%i3,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%i3,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%i3,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%i3,2), UBOUND(InData%i3,2) - DO i1 = LBOUND(InData%i3,1), UBOUND(InData%i3,1) - DbKiBuf(Db_Xferred) = InData%i3(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%j1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%j1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%j1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%j1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%j1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%j1,2), UBOUND(InData%j1,2) - DO i1 = LBOUND(InData%j1,1), UBOUND(InData%j1,1) - DbKiBuf(Db_Xferred) = InData%j1(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%j2) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%j2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%j2,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%j2,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%j2,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%j2,2), UBOUND(InData%j2,2) - DO i1 = LBOUND(InData%j2,1), UBOUND(InData%j2,1) - DbKiBuf(Db_Xferred) = InData%j2(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%j3) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%j3,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%j3,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%j3,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%j3,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%j3,2), UBOUND(InData%j3,2) - DO i1 = LBOUND(InData%j3,1), UBOUND(InData%j3,1) - DbKiBuf(Db_Xferred) = InData%j3(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%m1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%m1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%m1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%m1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%m1,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%m1,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%m1,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%m1,3), UBOUND(InData%m1,3) - DO i2 = LBOUND(InData%m1,2), UBOUND(InData%m1,2) - DO i1 = LBOUND(InData%m1,1), UBOUND(InData%m1,1) - DbKiBuf(Db_Xferred) = InData%m1(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%m2) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%m2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%m2,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%m2,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%m2,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%m2,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%m2,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%m2,3), UBOUND(InData%m2,3) - DO i2 = LBOUND(InData%m2,2), UBOUND(InData%m2,2) - DO i1 = LBOUND(InData%m2,1), UBOUND(InData%m2,1) - DbKiBuf(Db_Xferred) = InData%m2(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%m3) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%m3,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%m3,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%m3,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%m3,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%m3,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%m3,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%m3,3), UBOUND(InData%m3,3) - DO i2 = LBOUND(InData%m3,2), UBOUND(InData%m3,2) - DO i1 = LBOUND(InData%m3,1), UBOUND(InData%m3,1) - DbKiBuf(Db_Xferred) = InData%m3(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%n1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%n1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%n1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%n1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%n1,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%n1,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%n1,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%n1,3), UBOUND(InData%n1,3) - DO i2 = LBOUND(InData%n1,2), UBOUND(InData%n1,2) - DO i1 = LBOUND(InData%n1,1), UBOUND(InData%n1,1) - DbKiBuf(Db_Xferred) = InData%n1(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%n2) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%n2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%n2,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%n2,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%n2,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%n2,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%n2,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%n2,3), UBOUND(InData%n2,3) - DO i2 = LBOUND(InData%n2,2), UBOUND(InData%n2,2) - DO i1 = LBOUND(InData%n2,1), UBOUND(InData%n2,1) - DbKiBuf(Db_Xferred) = InData%n2(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%n3) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%n3,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%n3,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%n3,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%n3,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%n3,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%n3,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%n3,3), UBOUND(InData%n3,3) - DO i2 = LBOUND(InData%n3,2), UBOUND(InData%n3,2) - DO i1 = LBOUND(InData%n3,1), UBOUND(InData%n3,1) - DbKiBuf(Db_Xferred) = InData%n3(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - DO i1 = LBOUND(InData%rf1,1), UBOUND(InData%rf1,1) - DbKiBuf(Db_Xferred) = InData%rf1(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%rf2,1), UBOUND(InData%rf2,1) - DbKiBuf(Db_Xferred) = InData%rf2(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%rf3,1), UBOUND(InData%rf3,1) - DbKiBuf(Db_Xferred) = InData%rf3(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%rfa,1), UBOUND(InData%rfa,1) - DbKiBuf(Db_Xferred) = InData%rfa(i1) - Db_Xferred = Db_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%t1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%t1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%t1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%t1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%t1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%t1,2), UBOUND(InData%t1,2) - DO i1 = LBOUND(InData%t1,1), UBOUND(InData%t1,1) - DbKiBuf(Db_Xferred) = InData%t1(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%t2) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%t2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%t2,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%t2,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%t2,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%t2,2), UBOUND(InData%t2,2) - DO i1 = LBOUND(InData%t2,1), UBOUND(InData%t2,1) - DbKiBuf(Db_Xferred) = InData%t2(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%t3) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%t3,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%t3,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%t3,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%t3,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%t3,2), UBOUND(InData%t3,2) - DO i1 = LBOUND(InData%t3,1), UBOUND(InData%t3,1) - DbKiBuf(Db_Xferred) = InData%t3(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%te1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%te1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%te1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%te1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%te1,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%te1,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%te1,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%te1,3), UBOUND(InData%te1,3) - DO i2 = LBOUND(InData%te1,2), UBOUND(InData%te1,2) - DO i1 = LBOUND(InData%te1,1), UBOUND(InData%te1,1) - DbKiBuf(Db_Xferred) = InData%te1(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%te2) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%te2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%te2,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%te2,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%te2,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%te2,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%te2,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%te2,3), UBOUND(InData%te2,3) - DO i2 = LBOUND(InData%te2,2), UBOUND(InData%te2,2) - DO i1 = LBOUND(InData%te2,1), UBOUND(InData%te2,1) - DbKiBuf(Db_Xferred) = InData%te2(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%te3) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%te3,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%te3,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%te3,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%te3,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%te3,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%te3,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%te3,3), UBOUND(InData%te3,3) - DO i2 = LBOUND(InData%te3,2), UBOUND(InData%te3,2) - DO i1 = LBOUND(InData%te3,1), UBOUND(InData%te3,1) - DbKiBuf(Db_Xferred) = InData%te3(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - DO i1 = LBOUND(InData%tf1,1), UBOUND(InData%tf1,1) - DbKiBuf(Db_Xferred) = InData%tf1(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%tf2,1), UBOUND(InData%tf2,1) - DbKiBuf(Db_Xferred) = InData%tf2(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%tf3,1), UBOUND(InData%tf3,1) - DbKiBuf(Db_Xferred) = InData%tf3(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%tfa,1), UBOUND(InData%tfa,1) - DbKiBuf(Db_Xferred) = InData%tfa(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%z1,1), UBOUND(InData%z1,1) - DbKiBuf(Db_Xferred) = InData%z1(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%z2,1), UBOUND(InData%z2,1) - DbKiBuf(Db_Xferred) = InData%z2(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%z3,1), UBOUND(InData%z3,1) - DbKiBuf(Db_Xferred) = InData%z3(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END SUBROUTINE ED_PackCoordSys - - SUBROUTINE ED_UnPackCoordSys( 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(ED_CoordSys), 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 = 'ED_UnPackCoordSys' - ! 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%a1,1) - i1_u = UBOUND(OutData%a1,1) - DO i1 = LBOUND(OutData%a1,1), UBOUND(OutData%a1,1) - OutData%a1(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%a2,1) - i1_u = UBOUND(OutData%a2,1) - DO i1 = LBOUND(OutData%a2,1), UBOUND(OutData%a2,1) - OutData%a2(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%a3,1) - i1_u = UBOUND(OutData%a3,1) - DO i1 = LBOUND(OutData%a3,1), UBOUND(OutData%a3,1) - OutData%a3(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%b1,1) - i1_u = UBOUND(OutData%b1,1) - DO i1 = LBOUND(OutData%b1,1), UBOUND(OutData%b1,1) - OutData%b1(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%b2,1) - i1_u = UBOUND(OutData%b2,1) - DO i1 = LBOUND(OutData%b2,1), UBOUND(OutData%b2,1) - OutData%b2(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%b3,1) - i1_u = UBOUND(OutData%b3,1) - DO i1 = LBOUND(OutData%b3,1), UBOUND(OutData%b3,1) - OutData%b3(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%c1,1) - i1_u = UBOUND(OutData%c1,1) - DO i1 = LBOUND(OutData%c1,1), UBOUND(OutData%c1,1) - OutData%c1(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%c2,1) - i1_u = UBOUND(OutData%c2,1) - DO i1 = LBOUND(OutData%c2,1), UBOUND(OutData%c2,1) - OutData%c2(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%c3,1) - i1_u = UBOUND(OutData%c3,1) - DO i1 = LBOUND(OutData%c3,1), UBOUND(OutData%c3,1) - OutData%c3(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%d1,1) - i1_u = UBOUND(OutData%d1,1) - DO i1 = LBOUND(OutData%d1,1), UBOUND(OutData%d1,1) - OutData%d1(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%d2,1) - i1_u = UBOUND(OutData%d2,1) - DO i1 = LBOUND(OutData%d2,1), UBOUND(OutData%d2,1) - OutData%d2(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%d3,1) - i1_u = UBOUND(OutData%d3,1) - DO i1 = LBOUND(OutData%d3,1), UBOUND(OutData%d3,1) - OutData%d3(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%e1,1) - i1_u = UBOUND(OutData%e1,1) - DO i1 = LBOUND(OutData%e1,1), UBOUND(OutData%e1,1) - OutData%e1(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%e2,1) - i1_u = UBOUND(OutData%e2,1) - DO i1 = LBOUND(OutData%e2,1), UBOUND(OutData%e2,1) - OutData%e2(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%e3,1) - i1_u = UBOUND(OutData%e3,1) - DO i1 = LBOUND(OutData%e3,1), UBOUND(OutData%e3,1) - OutData%e3(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%f1,1) - i1_u = UBOUND(OutData%f1,1) - DO i1 = LBOUND(OutData%f1,1), UBOUND(OutData%f1,1) - OutData%f1(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%f2,1) - i1_u = UBOUND(OutData%f2,1) - DO i1 = LBOUND(OutData%f2,1), UBOUND(OutData%f2,1) - OutData%f2(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%f3,1) - i1_u = UBOUND(OutData%f3,1) - DO i1 = LBOUND(OutData%f3,1), UBOUND(OutData%f3,1) - OutData%f3(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%g1,1) - i1_u = UBOUND(OutData%g1,1) - DO i1 = LBOUND(OutData%g1,1), UBOUND(OutData%g1,1) - OutData%g1(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%g2,1) - i1_u = UBOUND(OutData%g2,1) - DO i1 = LBOUND(OutData%g2,1), UBOUND(OutData%g2,1) - OutData%g2(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%g3,1) - i1_u = UBOUND(OutData%g3,1) - DO i1 = LBOUND(OutData%g3,1), UBOUND(OutData%g3,1) - OutData%g3(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! i1 not allocated - Int_Xferred = Int_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%i1)) DEALLOCATE(OutData%i1) - ALLOCATE(OutData%i1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%i1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%i1,2), UBOUND(OutData%i1,2) - DO i1 = LBOUND(OutData%i1,1), UBOUND(OutData%i1,1) - OutData%i1(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! i2 not allocated - Int_Xferred = Int_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%i2)) DEALLOCATE(OutData%i2) - ALLOCATE(OutData%i2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%i2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%i2,2), UBOUND(OutData%i2,2) - DO i1 = LBOUND(OutData%i2,1), UBOUND(OutData%i2,1) - OutData%i2(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! i3 not allocated - Int_Xferred = Int_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%i3)) DEALLOCATE(OutData%i3) - ALLOCATE(OutData%i3(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%i3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%i3,2), UBOUND(OutData%i3,2) - DO i1 = LBOUND(OutData%i3,1), UBOUND(OutData%i3,1) - OutData%i3(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! j1 not allocated - Int_Xferred = Int_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%j1)) DEALLOCATE(OutData%j1) - ALLOCATE(OutData%j1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%j1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%j1,2), UBOUND(OutData%j1,2) - DO i1 = LBOUND(OutData%j1,1), UBOUND(OutData%j1,1) - OutData%j1(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! j2 not allocated - Int_Xferred = Int_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%j2)) DEALLOCATE(OutData%j2) - ALLOCATE(OutData%j2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%j2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%j2,2), UBOUND(OutData%j2,2) - DO i1 = LBOUND(OutData%j2,1), UBOUND(OutData%j2,1) - OutData%j2(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! j3 not allocated - Int_Xferred = Int_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%j3)) DEALLOCATE(OutData%j3) - ALLOCATE(OutData%j3(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%j3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%j3,2), UBOUND(OutData%j3,2) - DO i1 = LBOUND(OutData%j3,1), UBOUND(OutData%j3,1) - OutData%j3(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! m1 not allocated - Int_Xferred = Int_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%m1)) DEALLOCATE(OutData%m1) - ALLOCATE(OutData%m1(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%m1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%m1,3), UBOUND(OutData%m1,3) - DO i2 = LBOUND(OutData%m1,2), UBOUND(OutData%m1,2) - DO i1 = LBOUND(OutData%m1,1), UBOUND(OutData%m1,1) - OutData%m1(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! m2 not allocated - Int_Xferred = Int_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%m2)) DEALLOCATE(OutData%m2) - ALLOCATE(OutData%m2(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%m2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%m2,3), UBOUND(OutData%m2,3) - DO i2 = LBOUND(OutData%m2,2), UBOUND(OutData%m2,2) - DO i1 = LBOUND(OutData%m2,1), UBOUND(OutData%m2,1) - OutData%m2(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! m3 not allocated - Int_Xferred = Int_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%m3)) DEALLOCATE(OutData%m3) - ALLOCATE(OutData%m3(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%m3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%m3,3), UBOUND(OutData%m3,3) - DO i2 = LBOUND(OutData%m3,2), UBOUND(OutData%m3,2) - DO i1 = LBOUND(OutData%m3,1), UBOUND(OutData%m3,1) - OutData%m3(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! n1 not allocated - Int_Xferred = Int_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%n1)) DEALLOCATE(OutData%n1) - ALLOCATE(OutData%n1(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%n1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%n1,3), UBOUND(OutData%n1,3) - DO i2 = LBOUND(OutData%n1,2), UBOUND(OutData%n1,2) - DO i1 = LBOUND(OutData%n1,1), UBOUND(OutData%n1,1) - OutData%n1(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! n2 not allocated - Int_Xferred = Int_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%n2)) DEALLOCATE(OutData%n2) - ALLOCATE(OutData%n2(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%n2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%n2,3), UBOUND(OutData%n2,3) - DO i2 = LBOUND(OutData%n2,2), UBOUND(OutData%n2,2) - DO i1 = LBOUND(OutData%n2,1), UBOUND(OutData%n2,1) - OutData%n2(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! n3 not allocated - Int_Xferred = Int_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%n3)) DEALLOCATE(OutData%n3) - ALLOCATE(OutData%n3(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%n3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%n3,3), UBOUND(OutData%n3,3) - DO i2 = LBOUND(OutData%n3,2), UBOUND(OutData%n3,2) - DO i1 = LBOUND(OutData%n3,1), UBOUND(OutData%n3,1) - OutData%n3(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - i1_l = LBOUND(OutData%rf1,1) - i1_u = UBOUND(OutData%rf1,1) - DO i1 = LBOUND(OutData%rf1,1), UBOUND(OutData%rf1,1) - OutData%rf1(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%rf2,1) - i1_u = UBOUND(OutData%rf2,1) - DO i1 = LBOUND(OutData%rf2,1), UBOUND(OutData%rf2,1) - OutData%rf2(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%rf3,1) - i1_u = UBOUND(OutData%rf3,1) - DO i1 = LBOUND(OutData%rf3,1), UBOUND(OutData%rf3,1) - OutData%rf3(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%rfa,1) - i1_u = UBOUND(OutData%rfa,1) - DO i1 = LBOUND(OutData%rfa,1), UBOUND(OutData%rfa,1) - OutData%rfa(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! t1 not allocated - Int_Xferred = Int_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%t1)) DEALLOCATE(OutData%t1) - ALLOCATE(OutData%t1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%t1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%t1,2), UBOUND(OutData%t1,2) - DO i1 = LBOUND(OutData%t1,1), UBOUND(OutData%t1,1) - OutData%t1(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! t2 not allocated - Int_Xferred = Int_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%t2)) DEALLOCATE(OutData%t2) - ALLOCATE(OutData%t2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%t2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%t2,2), UBOUND(OutData%t2,2) - DO i1 = LBOUND(OutData%t2,1), UBOUND(OutData%t2,1) - OutData%t2(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! t3 not allocated - Int_Xferred = Int_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%t3)) DEALLOCATE(OutData%t3) - ALLOCATE(OutData%t3(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%t3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%t3,2), UBOUND(OutData%t3,2) - DO i1 = LBOUND(OutData%t3,1), UBOUND(OutData%t3,1) - OutData%t3(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! te1 not allocated - Int_Xferred = Int_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%te1)) DEALLOCATE(OutData%te1) - ALLOCATE(OutData%te1(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%te1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%te1,3), UBOUND(OutData%te1,3) - DO i2 = LBOUND(OutData%te1,2), UBOUND(OutData%te1,2) - DO i1 = LBOUND(OutData%te1,1), UBOUND(OutData%te1,1) - OutData%te1(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! te2 not allocated - Int_Xferred = Int_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%te2)) DEALLOCATE(OutData%te2) - ALLOCATE(OutData%te2(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%te2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%te2,3), UBOUND(OutData%te2,3) - DO i2 = LBOUND(OutData%te2,2), UBOUND(OutData%te2,2) - DO i1 = LBOUND(OutData%te2,1), UBOUND(OutData%te2,1) - OutData%te2(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! te3 not allocated - Int_Xferred = Int_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%te3)) DEALLOCATE(OutData%te3) - ALLOCATE(OutData%te3(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%te3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%te3,3), UBOUND(OutData%te3,3) - DO i2 = LBOUND(OutData%te3,2), UBOUND(OutData%te3,2) - DO i1 = LBOUND(OutData%te3,1), UBOUND(OutData%te3,1) - OutData%te3(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - i1_l = LBOUND(OutData%tf1,1) - i1_u = UBOUND(OutData%tf1,1) - DO i1 = LBOUND(OutData%tf1,1), UBOUND(OutData%tf1,1) - OutData%tf1(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%tf2,1) - i1_u = UBOUND(OutData%tf2,1) - DO i1 = LBOUND(OutData%tf2,1), UBOUND(OutData%tf2,1) - OutData%tf2(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%tf3,1) - i1_u = UBOUND(OutData%tf3,1) - DO i1 = LBOUND(OutData%tf3,1), UBOUND(OutData%tf3,1) - OutData%tf3(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%tfa,1) - i1_u = UBOUND(OutData%tfa,1) - DO i1 = LBOUND(OutData%tfa,1), UBOUND(OutData%tfa,1) - OutData%tfa(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%z1,1) - i1_u = UBOUND(OutData%z1,1) - DO i1 = LBOUND(OutData%z1,1), UBOUND(OutData%z1,1) - OutData%z1(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%z2,1) - i1_u = UBOUND(OutData%z2,1) - DO i1 = LBOUND(OutData%z2,1), UBOUND(OutData%z2,1) - OutData%z2(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%z3,1) - i1_u = UBOUND(OutData%z3,1) - DO i1 = LBOUND(OutData%z3,1), UBOUND(OutData%z3,1) - OutData%z3(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END SUBROUTINE ED_UnPackCoordSys - - SUBROUTINE ED_CopyActiveDOFs( SrcActiveDOFsData, DstActiveDOFsData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ED_ActiveDOFs), INTENT(IN) :: SrcActiveDOFsData - TYPE(ED_ActiveDOFs), INTENT(INOUT) :: DstActiveDOFsData - 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 = 'ED_CopyActiveDOFs' -! - ErrStat = ErrID_None - ErrMsg = "" - DstActiveDOFsData%NActvDOF = SrcActiveDOFsData%NActvDOF - DstActiveDOFsData%NPCE = SrcActiveDOFsData%NPCE - DstActiveDOFsData%NPDE = SrcActiveDOFsData%NPDE - DstActiveDOFsData%NPIE = SrcActiveDOFsData%NPIE - DstActiveDOFsData%NPTE = SrcActiveDOFsData%NPTE - DstActiveDOFsData%NPTTE = SrcActiveDOFsData%NPTTE -IF (ALLOCATED(SrcActiveDOFsData%NPSBE)) THEN - i1_l = LBOUND(SrcActiveDOFsData%NPSBE,1) - i1_u = UBOUND(SrcActiveDOFsData%NPSBE,1) - IF (.NOT. ALLOCATED(DstActiveDOFsData%NPSBE)) THEN - ALLOCATE(DstActiveDOFsData%NPSBE(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstActiveDOFsData%NPSBE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstActiveDOFsData%NPSBE = SrcActiveDOFsData%NPSBE -ENDIF -IF (ALLOCATED(SrcActiveDOFsData%NPSE)) THEN - i1_l = LBOUND(SrcActiveDOFsData%NPSE,1) - i1_u = UBOUND(SrcActiveDOFsData%NPSE,1) - IF (.NOT. ALLOCATED(DstActiveDOFsData%NPSE)) THEN - ALLOCATE(DstActiveDOFsData%NPSE(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstActiveDOFsData%NPSE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstActiveDOFsData%NPSE = SrcActiveDOFsData%NPSE -ENDIF - DstActiveDOFsData%NPUE = SrcActiveDOFsData%NPUE - DstActiveDOFsData%NPYE = SrcActiveDOFsData%NPYE -IF (ALLOCATED(SrcActiveDOFsData%PCE)) THEN - i1_l = LBOUND(SrcActiveDOFsData%PCE,1) - i1_u = UBOUND(SrcActiveDOFsData%PCE,1) - IF (.NOT. ALLOCATED(DstActiveDOFsData%PCE)) THEN - ALLOCATE(DstActiveDOFsData%PCE(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstActiveDOFsData%PCE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstActiveDOFsData%PCE = SrcActiveDOFsData%PCE -ENDIF -IF (ALLOCATED(SrcActiveDOFsData%PDE)) THEN - i1_l = LBOUND(SrcActiveDOFsData%PDE,1) - i1_u = UBOUND(SrcActiveDOFsData%PDE,1) - IF (.NOT. ALLOCATED(DstActiveDOFsData%PDE)) THEN - ALLOCATE(DstActiveDOFsData%PDE(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstActiveDOFsData%PDE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstActiveDOFsData%PDE = SrcActiveDOFsData%PDE -ENDIF -IF (ALLOCATED(SrcActiveDOFsData%PIE)) THEN - i1_l = LBOUND(SrcActiveDOFsData%PIE,1) - i1_u = UBOUND(SrcActiveDOFsData%PIE,1) - IF (.NOT. ALLOCATED(DstActiveDOFsData%PIE)) THEN - ALLOCATE(DstActiveDOFsData%PIE(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstActiveDOFsData%PIE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstActiveDOFsData%PIE = SrcActiveDOFsData%PIE -ENDIF -IF (ALLOCATED(SrcActiveDOFsData%PTE)) THEN - i1_l = LBOUND(SrcActiveDOFsData%PTE,1) - i1_u = UBOUND(SrcActiveDOFsData%PTE,1) - IF (.NOT. ALLOCATED(DstActiveDOFsData%PTE)) THEN - ALLOCATE(DstActiveDOFsData%PTE(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstActiveDOFsData%PTE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstActiveDOFsData%PTE = SrcActiveDOFsData%PTE -ENDIF -IF (ALLOCATED(SrcActiveDOFsData%PTTE)) THEN - i1_l = LBOUND(SrcActiveDOFsData%PTTE,1) - i1_u = UBOUND(SrcActiveDOFsData%PTTE,1) - IF (.NOT. ALLOCATED(DstActiveDOFsData%PTTE)) THEN - ALLOCATE(DstActiveDOFsData%PTTE(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstActiveDOFsData%PTTE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstActiveDOFsData%PTTE = SrcActiveDOFsData%PTTE -ENDIF -IF (ALLOCATED(SrcActiveDOFsData%PS)) THEN - i1_l = LBOUND(SrcActiveDOFsData%PS,1) - i1_u = UBOUND(SrcActiveDOFsData%PS,1) - IF (.NOT. ALLOCATED(DstActiveDOFsData%PS)) THEN - ALLOCATE(DstActiveDOFsData%PS(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstActiveDOFsData%PS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstActiveDOFsData%PS = SrcActiveDOFsData%PS -ENDIF -IF (ALLOCATED(SrcActiveDOFsData%PSBE)) THEN - i1_l = LBOUND(SrcActiveDOFsData%PSBE,1) - i1_u = UBOUND(SrcActiveDOFsData%PSBE,1) - i2_l = LBOUND(SrcActiveDOFsData%PSBE,2) - i2_u = UBOUND(SrcActiveDOFsData%PSBE,2) - IF (.NOT. ALLOCATED(DstActiveDOFsData%PSBE)) THEN - ALLOCATE(DstActiveDOFsData%PSBE(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstActiveDOFsData%PSBE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstActiveDOFsData%PSBE = SrcActiveDOFsData%PSBE -ENDIF -IF (ALLOCATED(SrcActiveDOFsData%PSE)) THEN - i1_l = LBOUND(SrcActiveDOFsData%PSE,1) - i1_u = UBOUND(SrcActiveDOFsData%PSE,1) - i2_l = LBOUND(SrcActiveDOFsData%PSE,2) - i2_u = UBOUND(SrcActiveDOFsData%PSE,2) - IF (.NOT. ALLOCATED(DstActiveDOFsData%PSE)) THEN - ALLOCATE(DstActiveDOFsData%PSE(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstActiveDOFsData%PSE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstActiveDOFsData%PSE = SrcActiveDOFsData%PSE -ENDIF -IF (ALLOCATED(SrcActiveDOFsData%PUE)) THEN - i1_l = LBOUND(SrcActiveDOFsData%PUE,1) - i1_u = UBOUND(SrcActiveDOFsData%PUE,1) - IF (.NOT. ALLOCATED(DstActiveDOFsData%PUE)) THEN - ALLOCATE(DstActiveDOFsData%PUE(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstActiveDOFsData%PUE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstActiveDOFsData%PUE = SrcActiveDOFsData%PUE -ENDIF -IF (ALLOCATED(SrcActiveDOFsData%PYE)) THEN - i1_l = LBOUND(SrcActiveDOFsData%PYE,1) - i1_u = UBOUND(SrcActiveDOFsData%PYE,1) - IF (.NOT. ALLOCATED(DstActiveDOFsData%PYE)) THEN - ALLOCATE(DstActiveDOFsData%PYE(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstActiveDOFsData%PYE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstActiveDOFsData%PYE = SrcActiveDOFsData%PYE -ENDIF -IF (ALLOCATED(SrcActiveDOFsData%SrtPS)) THEN - i1_l = LBOUND(SrcActiveDOFsData%SrtPS,1) - i1_u = UBOUND(SrcActiveDOFsData%SrtPS,1) - IF (.NOT. ALLOCATED(DstActiveDOFsData%SrtPS)) THEN - ALLOCATE(DstActiveDOFsData%SrtPS(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstActiveDOFsData%SrtPS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstActiveDOFsData%SrtPS = SrcActiveDOFsData%SrtPS -ENDIF -IF (ALLOCATED(SrcActiveDOFsData%SrtPSNAUG)) THEN - i1_l = LBOUND(SrcActiveDOFsData%SrtPSNAUG,1) - i1_u = UBOUND(SrcActiveDOFsData%SrtPSNAUG,1) - IF (.NOT. ALLOCATED(DstActiveDOFsData%SrtPSNAUG)) THEN - ALLOCATE(DstActiveDOFsData%SrtPSNAUG(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstActiveDOFsData%SrtPSNAUG.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstActiveDOFsData%SrtPSNAUG = SrcActiveDOFsData%SrtPSNAUG -ENDIF -IF (ALLOCATED(SrcActiveDOFsData%Diag)) THEN - i1_l = LBOUND(SrcActiveDOFsData%Diag,1) - i1_u = UBOUND(SrcActiveDOFsData%Diag,1) - IF (.NOT. ALLOCATED(DstActiveDOFsData%Diag)) THEN - ALLOCATE(DstActiveDOFsData%Diag(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstActiveDOFsData%Diag.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstActiveDOFsData%Diag = SrcActiveDOFsData%Diag -ENDIF - END SUBROUTINE ED_CopyActiveDOFs - - SUBROUTINE ED_DestroyActiveDOFs( ActiveDOFsData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(ED_ActiveDOFs), INTENT(INOUT) :: ActiveDOFsData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_DestroyActiveDOFs' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(ActiveDOFsData%NPSBE)) THEN - DEALLOCATE(ActiveDOFsData%NPSBE) -ENDIF -IF (ALLOCATED(ActiveDOFsData%NPSE)) THEN - DEALLOCATE(ActiveDOFsData%NPSE) -ENDIF -IF (ALLOCATED(ActiveDOFsData%PCE)) THEN - DEALLOCATE(ActiveDOFsData%PCE) -ENDIF -IF (ALLOCATED(ActiveDOFsData%PDE)) THEN - DEALLOCATE(ActiveDOFsData%PDE) -ENDIF -IF (ALLOCATED(ActiveDOFsData%PIE)) THEN - DEALLOCATE(ActiveDOFsData%PIE) -ENDIF -IF (ALLOCATED(ActiveDOFsData%PTE)) THEN - DEALLOCATE(ActiveDOFsData%PTE) -ENDIF -IF (ALLOCATED(ActiveDOFsData%PTTE)) THEN - DEALLOCATE(ActiveDOFsData%PTTE) -ENDIF -IF (ALLOCATED(ActiveDOFsData%PS)) THEN - DEALLOCATE(ActiveDOFsData%PS) -ENDIF -IF (ALLOCATED(ActiveDOFsData%PSBE)) THEN - DEALLOCATE(ActiveDOFsData%PSBE) -ENDIF -IF (ALLOCATED(ActiveDOFsData%PSE)) THEN - DEALLOCATE(ActiveDOFsData%PSE) -ENDIF -IF (ALLOCATED(ActiveDOFsData%PUE)) THEN - DEALLOCATE(ActiveDOFsData%PUE) -ENDIF -IF (ALLOCATED(ActiveDOFsData%PYE)) THEN - DEALLOCATE(ActiveDOFsData%PYE) -ENDIF -IF (ALLOCATED(ActiveDOFsData%SrtPS)) THEN - DEALLOCATE(ActiveDOFsData%SrtPS) -ENDIF -IF (ALLOCATED(ActiveDOFsData%SrtPSNAUG)) THEN - DEALLOCATE(ActiveDOFsData%SrtPSNAUG) -ENDIF -IF (ALLOCATED(ActiveDOFsData%Diag)) THEN - DEALLOCATE(ActiveDOFsData%Diag) -ENDIF - END SUBROUTINE ED_DestroyActiveDOFs - - SUBROUTINE ED_PackActiveDOFs( 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(ED_ActiveDOFs), 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 = 'ED_PackActiveDOFs' - ! 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 ! NActvDOF - Int_BufSz = Int_BufSz + 1 ! NPCE - Int_BufSz = Int_BufSz + 1 ! NPDE - Int_BufSz = Int_BufSz + 1 ! NPIE - Int_BufSz = Int_BufSz + 1 ! NPTE - Int_BufSz = Int_BufSz + 1 ! NPTTE - Int_BufSz = Int_BufSz + 1 ! NPSBE allocated yes/no - IF ( ALLOCATED(InData%NPSBE) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! NPSBE upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%NPSBE) ! NPSBE - END IF - Int_BufSz = Int_BufSz + 1 ! NPSE allocated yes/no - IF ( ALLOCATED(InData%NPSE) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! NPSE upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%NPSE) ! NPSE - END IF - Int_BufSz = Int_BufSz + 1 ! NPUE - Int_BufSz = Int_BufSz + 1 ! NPYE - Int_BufSz = Int_BufSz + 1 ! PCE allocated yes/no - IF ( ALLOCATED(InData%PCE) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PCE upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%PCE) ! PCE - END IF - Int_BufSz = Int_BufSz + 1 ! PDE allocated yes/no - IF ( ALLOCATED(InData%PDE) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PDE upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%PDE) ! PDE - END IF - Int_BufSz = Int_BufSz + 1 ! PIE allocated yes/no - IF ( ALLOCATED(InData%PIE) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PIE upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%PIE) ! PIE - END IF - Int_BufSz = Int_BufSz + 1 ! PTE allocated yes/no - IF ( ALLOCATED(InData%PTE) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PTE upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%PTE) ! PTE - END IF - Int_BufSz = Int_BufSz + 1 ! PTTE allocated yes/no - IF ( ALLOCATED(InData%PTTE) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PTTE upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%PTTE) ! PTTE - END IF - Int_BufSz = Int_BufSz + 1 ! PS allocated yes/no - IF ( ALLOCATED(InData%PS) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PS upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%PS) ! PS - END IF - Int_BufSz = Int_BufSz + 1 ! PSBE allocated yes/no - IF ( ALLOCATED(InData%PSBE) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PSBE upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%PSBE) ! PSBE - END IF - Int_BufSz = Int_BufSz + 1 ! PSE allocated yes/no - IF ( ALLOCATED(InData%PSE) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PSE upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%PSE) ! PSE - END IF - Int_BufSz = Int_BufSz + 1 ! PUE allocated yes/no - IF ( ALLOCATED(InData%PUE) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PUE upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%PUE) ! PUE - END IF - Int_BufSz = Int_BufSz + 1 ! PYE allocated yes/no - IF ( ALLOCATED(InData%PYE) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PYE upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%PYE) ! PYE - END IF - Int_BufSz = Int_BufSz + 1 ! SrtPS allocated yes/no - IF ( ALLOCATED(InData%SrtPS) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! SrtPS upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%SrtPS) ! SrtPS - END IF - Int_BufSz = Int_BufSz + 1 ! SrtPSNAUG allocated yes/no - IF ( ALLOCATED(InData%SrtPSNAUG) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! SrtPSNAUG upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%SrtPSNAUG) ! SrtPSNAUG - END IF - Int_BufSz = Int_BufSz + 1 ! Diag allocated yes/no - IF ( ALLOCATED(InData%Diag) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Diag upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Diag) ! Diag - 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%NActvDOF - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NPCE - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NPDE - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NPIE - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NPTE - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NPTTE - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%NPSBE) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%NPSBE,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NPSBE,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%NPSBE,1), UBOUND(InData%NPSBE,1) - IntKiBuf(Int_Xferred) = InData%NPSBE(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%NPSE) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%NPSE,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NPSE,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%NPSE,1), UBOUND(InData%NPSE,1) - IntKiBuf(Int_Xferred) = InData%NPSE(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NPUE - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NPYE - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%PCE) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PCE,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PCE,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PCE,1), UBOUND(InData%PCE,1) - IntKiBuf(Int_Xferred) = InData%PCE(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PDE) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PDE,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PDE,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PDE,1), UBOUND(InData%PDE,1) - IntKiBuf(Int_Xferred) = InData%PDE(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PIE) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PIE,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PIE,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PIE,1), UBOUND(InData%PIE,1) - IntKiBuf(Int_Xferred) = InData%PIE(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PTE) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PTE,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PTE,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PTE,1), UBOUND(InData%PTE,1) - IntKiBuf(Int_Xferred) = InData%PTE(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PTTE) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PTTE,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PTTE,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PTTE,1), UBOUND(InData%PTTE,1) - IntKiBuf(Int_Xferred) = InData%PTTE(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PS) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PS,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PS,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PS,1), UBOUND(InData%PS,1) - IntKiBuf(Int_Xferred) = InData%PS(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PSBE) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PSBE,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PSBE,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PSBE,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PSBE,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PSBE,2), UBOUND(InData%PSBE,2) - DO i1 = LBOUND(InData%PSBE,1), UBOUND(InData%PSBE,1) - IntKiBuf(Int_Xferred) = InData%PSBE(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PSE) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PSE,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PSE,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PSE,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PSE,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PSE,2), UBOUND(InData%PSE,2) - DO i1 = LBOUND(InData%PSE,1), UBOUND(InData%PSE,1) - IntKiBuf(Int_Xferred) = InData%PSE(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PUE) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PUE,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PUE,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PUE,1), UBOUND(InData%PUE,1) - IntKiBuf(Int_Xferred) = InData%PUE(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PYE) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PYE,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PYE,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PYE,1), UBOUND(InData%PYE,1) - IntKiBuf(Int_Xferred) = InData%PYE(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%SrtPS) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SrtPS,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SrtPS,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%SrtPS,1), UBOUND(InData%SrtPS,1) - IntKiBuf(Int_Xferred) = InData%SrtPS(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%SrtPSNAUG) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SrtPSNAUG,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SrtPSNAUG,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%SrtPSNAUG,1), UBOUND(InData%SrtPSNAUG,1) - IntKiBuf(Int_Xferred) = InData%SrtPSNAUG(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Diag) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Diag,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Diag,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Diag,1), UBOUND(InData%Diag,1) - IntKiBuf(Int_Xferred) = InData%Diag(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - END SUBROUTINE ED_PackActiveDOFs - - SUBROUTINE ED_UnPackActiveDOFs( 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(ED_ActiveDOFs), 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 = 'ED_UnPackActiveDOFs' - ! 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%NActvDOF = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NPCE = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NPDE = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NPIE = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NPTE = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NPTTE = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NPSBE not allocated - Int_Xferred = Int_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%NPSBE)) DEALLOCATE(OutData%NPSBE) - ALLOCATE(OutData%NPSBE(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NPSBE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%NPSBE,1), UBOUND(OutData%NPSBE,1) - OutData%NPSBE(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NPSE not allocated - Int_Xferred = Int_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%NPSE)) DEALLOCATE(OutData%NPSE) - ALLOCATE(OutData%NPSE(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NPSE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%NPSE,1), UBOUND(OutData%NPSE,1) - OutData%NPSE(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - OutData%NPUE = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NPYE = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PCE not allocated - Int_Xferred = Int_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%PCE)) DEALLOCATE(OutData%PCE) - ALLOCATE(OutData%PCE(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PCE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PCE,1), UBOUND(OutData%PCE,1) - OutData%PCE(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PDE not allocated - Int_Xferred = Int_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%PDE)) DEALLOCATE(OutData%PDE) - ALLOCATE(OutData%PDE(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PDE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PDE,1), UBOUND(OutData%PDE,1) - OutData%PDE(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PIE not allocated - Int_Xferred = Int_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%PIE)) DEALLOCATE(OutData%PIE) - ALLOCATE(OutData%PIE(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PIE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PIE,1), UBOUND(OutData%PIE,1) - OutData%PIE(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PTE not allocated - Int_Xferred = Int_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%PTE)) DEALLOCATE(OutData%PTE) - ALLOCATE(OutData%PTE(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PTE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PTE,1), UBOUND(OutData%PTE,1) - OutData%PTE(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PTTE not allocated - Int_Xferred = Int_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%PTTE)) DEALLOCATE(OutData%PTTE) - ALLOCATE(OutData%PTTE(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PTTE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PTTE,1), UBOUND(OutData%PTTE,1) - OutData%PTTE(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PS not allocated - Int_Xferred = Int_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%PS)) DEALLOCATE(OutData%PS) - ALLOCATE(OutData%PS(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PS,1), UBOUND(OutData%PS,1) - OutData%PS(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PSBE not allocated - Int_Xferred = Int_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%PSBE)) DEALLOCATE(OutData%PSBE) - ALLOCATE(OutData%PSBE(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PSBE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PSBE,2), UBOUND(OutData%PSBE,2) - DO i1 = LBOUND(OutData%PSBE,1), UBOUND(OutData%PSBE,1) - OutData%PSBE(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PSE not allocated - Int_Xferred = Int_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%PSE)) DEALLOCATE(OutData%PSE) - ALLOCATE(OutData%PSE(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PSE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PSE,2), UBOUND(OutData%PSE,2) - DO i1 = LBOUND(OutData%PSE,1), UBOUND(OutData%PSE,1) - OutData%PSE(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PUE not allocated - Int_Xferred = Int_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%PUE)) DEALLOCATE(OutData%PUE) - ALLOCATE(OutData%PUE(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PUE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PUE,1), UBOUND(OutData%PUE,1) - OutData%PUE(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PYE not allocated - Int_Xferred = Int_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%PYE)) DEALLOCATE(OutData%PYE) - ALLOCATE(OutData%PYE(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PYE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PYE,1), UBOUND(OutData%PYE,1) - OutData%PYE(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SrtPS not allocated - Int_Xferred = Int_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%SrtPS)) DEALLOCATE(OutData%SrtPS) - ALLOCATE(OutData%SrtPS(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SrtPS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%SrtPS,1), UBOUND(OutData%SrtPS,1) - OutData%SrtPS(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SrtPSNAUG not allocated - Int_Xferred = Int_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%SrtPSNAUG)) DEALLOCATE(OutData%SrtPSNAUG) - ALLOCATE(OutData%SrtPSNAUG(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SrtPSNAUG.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%SrtPSNAUG,1), UBOUND(OutData%SrtPSNAUG,1) - OutData%SrtPSNAUG(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Diag not allocated - Int_Xferred = Int_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%Diag)) DEALLOCATE(OutData%Diag) - ALLOCATE(OutData%Diag(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Diag.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Diag,1), UBOUND(OutData%Diag,1) - OutData%Diag(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - END SUBROUTINE ED_UnPackActiveDOFs - - SUBROUTINE ED_CopyRtHndSide( SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ED_RtHndSide), INTENT(IN) :: SrcRtHndSideData - TYPE(ED_RtHndSide), INTENT(INOUT) :: DstRtHndSideData - 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) :: i5, i5_l, i5_u ! bounds (upper/lower) for an array dimension 5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_CopyRtHndSide' -! - ErrStat = ErrID_None - ErrMsg = "" - DstRtHndSideData%rO = SrcRtHndSideData%rO -IF (ALLOCATED(SrcRtHndSideData%rQS)) THEN - i1_l = LBOUND(SrcRtHndSideData%rQS,1) - i1_u = UBOUND(SrcRtHndSideData%rQS,1) - i2_l = LBOUND(SrcRtHndSideData%rQS,2) - i2_u = UBOUND(SrcRtHndSideData%rQS,2) - i3_l = LBOUND(SrcRtHndSideData%rQS,3) - i3_u = UBOUND(SrcRtHndSideData%rQS,3) - IF (.NOT. ALLOCATED(DstRtHndSideData%rQS)) THEN - ALLOCATE(DstRtHndSideData%rQS(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%rQS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%rQS = SrcRtHndSideData%rQS -ENDIF -IF (ALLOCATED(SrcRtHndSideData%rS)) THEN - i1_l = LBOUND(SrcRtHndSideData%rS,1) - i1_u = UBOUND(SrcRtHndSideData%rS,1) - i2_l = LBOUND(SrcRtHndSideData%rS,2) - i2_u = UBOUND(SrcRtHndSideData%rS,2) - i3_l = LBOUND(SrcRtHndSideData%rS,3) - i3_u = UBOUND(SrcRtHndSideData%rS,3) - IF (.NOT. ALLOCATED(DstRtHndSideData%rS)) THEN - ALLOCATE(DstRtHndSideData%rS(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%rS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%rS = SrcRtHndSideData%rS -ENDIF -IF (ALLOCATED(SrcRtHndSideData%rS0S)) THEN - i1_l = LBOUND(SrcRtHndSideData%rS0S,1) - i1_u = UBOUND(SrcRtHndSideData%rS0S,1) - i2_l = LBOUND(SrcRtHndSideData%rS0S,2) - i2_u = UBOUND(SrcRtHndSideData%rS0S,2) - i3_l = LBOUND(SrcRtHndSideData%rS0S,3) - i3_u = UBOUND(SrcRtHndSideData%rS0S,3) - IF (.NOT. ALLOCATED(DstRtHndSideData%rS0S)) THEN - ALLOCATE(DstRtHndSideData%rS0S(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%rS0S.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%rS0S = SrcRtHndSideData%rS0S -ENDIF -IF (ALLOCATED(SrcRtHndSideData%rT)) THEN - i1_l = LBOUND(SrcRtHndSideData%rT,1) - i1_u = UBOUND(SrcRtHndSideData%rT,1) - i2_l = LBOUND(SrcRtHndSideData%rT,2) - i2_u = UBOUND(SrcRtHndSideData%rT,2) - IF (.NOT. ALLOCATED(DstRtHndSideData%rT)) THEN - ALLOCATE(DstRtHndSideData%rT(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%rT.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%rT = SrcRtHndSideData%rT -ENDIF - DstRtHndSideData%rT0O = SrcRtHndSideData%rT0O -IF (ALLOCATED(SrcRtHndSideData%rT0T)) THEN - i1_l = LBOUND(SrcRtHndSideData%rT0T,1) - i1_u = UBOUND(SrcRtHndSideData%rT0T,1) - i2_l = LBOUND(SrcRtHndSideData%rT0T,2) - i2_u = UBOUND(SrcRtHndSideData%rT0T,2) - IF (.NOT. ALLOCATED(DstRtHndSideData%rT0T)) THEN - ALLOCATE(DstRtHndSideData%rT0T(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%rT0T.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%rT0T = SrcRtHndSideData%rT0T -ENDIF - DstRtHndSideData%rZ = SrcRtHndSideData%rZ - DstRtHndSideData%rZO = SrcRtHndSideData%rZO -IF (ALLOCATED(SrcRtHndSideData%rZT)) THEN - i1_l = LBOUND(SrcRtHndSideData%rZT,1) - i1_u = UBOUND(SrcRtHndSideData%rZT,1) - i2_l = LBOUND(SrcRtHndSideData%rZT,2) - i2_u = UBOUND(SrcRtHndSideData%rZT,2) - IF (.NOT. ALLOCATED(DstRtHndSideData%rZT)) THEN - ALLOCATE(DstRtHndSideData%rZT(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%rZT.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%rZT = SrcRtHndSideData%rZT -ENDIF - DstRtHndSideData%rPQ = SrcRtHndSideData%rPQ - DstRtHndSideData%rP = SrcRtHndSideData%rP - DstRtHndSideData%rV = SrcRtHndSideData%rV - DstRtHndSideData%rJ = SrcRtHndSideData%rJ - DstRtHndSideData%rZY = SrcRtHndSideData%rZY - DstRtHndSideData%rOU = SrcRtHndSideData%rOU - DstRtHndSideData%rOV = SrcRtHndSideData%rOV - DstRtHndSideData%rVD = SrcRtHndSideData%rVD - DstRtHndSideData%rOW = SrcRtHndSideData%rOW - DstRtHndSideData%rPC = SrcRtHndSideData%rPC -IF (ALLOCATED(SrcRtHndSideData%rPS0)) THEN - i1_l = LBOUND(SrcRtHndSideData%rPS0,1) - i1_u = UBOUND(SrcRtHndSideData%rPS0,1) - i2_l = LBOUND(SrcRtHndSideData%rPS0,2) - i2_u = UBOUND(SrcRtHndSideData%rPS0,2) - IF (.NOT. ALLOCATED(DstRtHndSideData%rPS0)) THEN - ALLOCATE(DstRtHndSideData%rPS0(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%rPS0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%rPS0 = SrcRtHndSideData%rPS0 -ENDIF - DstRtHndSideData%rQ = SrcRtHndSideData%rQ - DstRtHndSideData%rQC = SrcRtHndSideData%rQC - DstRtHndSideData%rVIMU = SrcRtHndSideData%rVIMU - DstRtHndSideData%rVP = SrcRtHndSideData%rVP - DstRtHndSideData%rWI = SrcRtHndSideData%rWI - DstRtHndSideData%rWJ = SrcRtHndSideData%rWJ - DstRtHndSideData%rZT0 = SrcRtHndSideData%rZT0 -IF (ALLOCATED(SrcRtHndSideData%AngPosEF)) THEN - i1_l = LBOUND(SrcRtHndSideData%AngPosEF,1) - i1_u = UBOUND(SrcRtHndSideData%AngPosEF,1) - i2_l = LBOUND(SrcRtHndSideData%AngPosEF,2) - i2_u = UBOUND(SrcRtHndSideData%AngPosEF,2) - IF (.NOT. ALLOCATED(DstRtHndSideData%AngPosEF)) THEN - ALLOCATE(DstRtHndSideData%AngPosEF(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%AngPosEF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%AngPosEF = SrcRtHndSideData%AngPosEF -ENDIF -IF (ALLOCATED(SrcRtHndSideData%AngPosXF)) THEN - i1_l = LBOUND(SrcRtHndSideData%AngPosXF,1) - i1_u = UBOUND(SrcRtHndSideData%AngPosXF,1) - i2_l = LBOUND(SrcRtHndSideData%AngPosXF,2) - i2_u = UBOUND(SrcRtHndSideData%AngPosXF,2) - IF (.NOT. ALLOCATED(DstRtHndSideData%AngPosXF)) THEN - ALLOCATE(DstRtHndSideData%AngPosXF(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%AngPosXF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%AngPosXF = SrcRtHndSideData%AngPosXF -ENDIF -IF (ALLOCATED(SrcRtHndSideData%AngPosHM)) THEN - i1_l = LBOUND(SrcRtHndSideData%AngPosHM,1) - i1_u = UBOUND(SrcRtHndSideData%AngPosHM,1) - i2_l = LBOUND(SrcRtHndSideData%AngPosHM,2) - i2_u = UBOUND(SrcRtHndSideData%AngPosHM,2) - i3_l = LBOUND(SrcRtHndSideData%AngPosHM,3) - i3_u = UBOUND(SrcRtHndSideData%AngPosHM,3) - IF (.NOT. ALLOCATED(DstRtHndSideData%AngPosHM)) THEN - ALLOCATE(DstRtHndSideData%AngPosHM(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%AngPosHM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%AngPosHM = SrcRtHndSideData%AngPosHM -ENDIF - DstRtHndSideData%AngPosXB = SrcRtHndSideData%AngPosXB - DstRtHndSideData%AngPosEX = SrcRtHndSideData%AngPosEX -IF (ALLOCATED(SrcRtHndSideData%PAngVelEA)) THEN - i1_l = LBOUND(SrcRtHndSideData%PAngVelEA,1) - i1_u = UBOUND(SrcRtHndSideData%PAngVelEA,1) - i2_l = LBOUND(SrcRtHndSideData%PAngVelEA,2) - i2_u = UBOUND(SrcRtHndSideData%PAngVelEA,2) - i3_l = LBOUND(SrcRtHndSideData%PAngVelEA,3) - i3_u = UBOUND(SrcRtHndSideData%PAngVelEA,3) - IF (.NOT. ALLOCATED(DstRtHndSideData%PAngVelEA)) THEN - ALLOCATE(DstRtHndSideData%PAngVelEA(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PAngVelEA.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PAngVelEA = SrcRtHndSideData%PAngVelEA -ENDIF -IF (ALLOCATED(SrcRtHndSideData%PAngVelEF)) THEN - i1_l = LBOUND(SrcRtHndSideData%PAngVelEF,1) - i1_u = UBOUND(SrcRtHndSideData%PAngVelEF,1) - i2_l = LBOUND(SrcRtHndSideData%PAngVelEF,2) - i2_u = UBOUND(SrcRtHndSideData%PAngVelEF,2) - i3_l = LBOUND(SrcRtHndSideData%PAngVelEF,3) - i3_u = UBOUND(SrcRtHndSideData%PAngVelEF,3) - i4_l = LBOUND(SrcRtHndSideData%PAngVelEF,4) - i4_u = UBOUND(SrcRtHndSideData%PAngVelEF,4) - IF (.NOT. ALLOCATED(DstRtHndSideData%PAngVelEF)) THEN - ALLOCATE(DstRtHndSideData%PAngVelEF(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 DstRtHndSideData%PAngVelEF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PAngVelEF = SrcRtHndSideData%PAngVelEF -ENDIF -IF (ALLOCATED(SrcRtHndSideData%PAngVelEG)) THEN - i1_l = LBOUND(SrcRtHndSideData%PAngVelEG,1) - i1_u = UBOUND(SrcRtHndSideData%PAngVelEG,1) - i2_l = LBOUND(SrcRtHndSideData%PAngVelEG,2) - i2_u = UBOUND(SrcRtHndSideData%PAngVelEG,2) - i3_l = LBOUND(SrcRtHndSideData%PAngVelEG,3) - i3_u = UBOUND(SrcRtHndSideData%PAngVelEG,3) - IF (.NOT. ALLOCATED(DstRtHndSideData%PAngVelEG)) THEN - ALLOCATE(DstRtHndSideData%PAngVelEG(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PAngVelEG.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PAngVelEG = SrcRtHndSideData%PAngVelEG -ENDIF -IF (ALLOCATED(SrcRtHndSideData%PAngVelEH)) THEN - i1_l = LBOUND(SrcRtHndSideData%PAngVelEH,1) - i1_u = UBOUND(SrcRtHndSideData%PAngVelEH,1) - i2_l = LBOUND(SrcRtHndSideData%PAngVelEH,2) - i2_u = UBOUND(SrcRtHndSideData%PAngVelEH,2) - i3_l = LBOUND(SrcRtHndSideData%PAngVelEH,3) - i3_u = UBOUND(SrcRtHndSideData%PAngVelEH,3) - IF (.NOT. ALLOCATED(DstRtHndSideData%PAngVelEH)) THEN - ALLOCATE(DstRtHndSideData%PAngVelEH(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PAngVelEH.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PAngVelEH = SrcRtHndSideData%PAngVelEH -ENDIF -IF (ALLOCATED(SrcRtHndSideData%PAngVelEL)) THEN - i1_l = LBOUND(SrcRtHndSideData%PAngVelEL,1) - i1_u = UBOUND(SrcRtHndSideData%PAngVelEL,1) - i2_l = LBOUND(SrcRtHndSideData%PAngVelEL,2) - i2_u = UBOUND(SrcRtHndSideData%PAngVelEL,2) - i3_l = LBOUND(SrcRtHndSideData%PAngVelEL,3) - i3_u = UBOUND(SrcRtHndSideData%PAngVelEL,3) - IF (.NOT. ALLOCATED(DstRtHndSideData%PAngVelEL)) THEN - ALLOCATE(DstRtHndSideData%PAngVelEL(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PAngVelEL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PAngVelEL = SrcRtHndSideData%PAngVelEL -ENDIF -IF (ALLOCATED(SrcRtHndSideData%PAngVelEM)) THEN - i1_l = LBOUND(SrcRtHndSideData%PAngVelEM,1) - i1_u = UBOUND(SrcRtHndSideData%PAngVelEM,1) - i2_l = LBOUND(SrcRtHndSideData%PAngVelEM,2) - i2_u = UBOUND(SrcRtHndSideData%PAngVelEM,2) - i3_l = LBOUND(SrcRtHndSideData%PAngVelEM,3) - i3_u = UBOUND(SrcRtHndSideData%PAngVelEM,3) - i4_l = LBOUND(SrcRtHndSideData%PAngVelEM,4) - i4_u = UBOUND(SrcRtHndSideData%PAngVelEM,4) - i5_l = LBOUND(SrcRtHndSideData%PAngVelEM,5) - i5_u = UBOUND(SrcRtHndSideData%PAngVelEM,5) - IF (.NOT. ALLOCATED(DstRtHndSideData%PAngVelEM)) THEN - ALLOCATE(DstRtHndSideData%PAngVelEM(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u,i5_l:i5_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PAngVelEM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PAngVelEM = SrcRtHndSideData%PAngVelEM -ENDIF -IF (ALLOCATED(SrcRtHndSideData%AngVelEM)) THEN - i1_l = LBOUND(SrcRtHndSideData%AngVelEM,1) - i1_u = UBOUND(SrcRtHndSideData%AngVelEM,1) - i2_l = LBOUND(SrcRtHndSideData%AngVelEM,2) - i2_u = UBOUND(SrcRtHndSideData%AngVelEM,2) - i3_l = LBOUND(SrcRtHndSideData%AngVelEM,3) - i3_u = UBOUND(SrcRtHndSideData%AngVelEM,3) - IF (.NOT. ALLOCATED(DstRtHndSideData%AngVelEM)) THEN - ALLOCATE(DstRtHndSideData%AngVelEM(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%AngVelEM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%AngVelEM = SrcRtHndSideData%AngVelEM -ENDIF -IF (ALLOCATED(SrcRtHndSideData%PAngVelEN)) THEN - i1_l = LBOUND(SrcRtHndSideData%PAngVelEN,1) - i1_u = UBOUND(SrcRtHndSideData%PAngVelEN,1) - i2_l = LBOUND(SrcRtHndSideData%PAngVelEN,2) - i2_u = UBOUND(SrcRtHndSideData%PAngVelEN,2) - i3_l = LBOUND(SrcRtHndSideData%PAngVelEN,3) - i3_u = UBOUND(SrcRtHndSideData%PAngVelEN,3) - IF (.NOT. ALLOCATED(DstRtHndSideData%PAngVelEN)) THEN - ALLOCATE(DstRtHndSideData%PAngVelEN(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PAngVelEN.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PAngVelEN = SrcRtHndSideData%PAngVelEN -ENDIF - DstRtHndSideData%AngVelEA = SrcRtHndSideData%AngVelEA -IF (ALLOCATED(SrcRtHndSideData%PAngVelEB)) THEN - i1_l = LBOUND(SrcRtHndSideData%PAngVelEB,1) - i1_u = UBOUND(SrcRtHndSideData%PAngVelEB,1) - i2_l = LBOUND(SrcRtHndSideData%PAngVelEB,2) - i2_u = UBOUND(SrcRtHndSideData%PAngVelEB,2) - i3_l = LBOUND(SrcRtHndSideData%PAngVelEB,3) - i3_u = UBOUND(SrcRtHndSideData%PAngVelEB,3) - IF (.NOT. ALLOCATED(DstRtHndSideData%PAngVelEB)) THEN - ALLOCATE(DstRtHndSideData%PAngVelEB(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PAngVelEB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PAngVelEB = SrcRtHndSideData%PAngVelEB -ENDIF -IF (ALLOCATED(SrcRtHndSideData%PAngVelER)) THEN - i1_l = LBOUND(SrcRtHndSideData%PAngVelER,1) - i1_u = UBOUND(SrcRtHndSideData%PAngVelER,1) - i2_l = LBOUND(SrcRtHndSideData%PAngVelER,2) - i2_u = UBOUND(SrcRtHndSideData%PAngVelER,2) - i3_l = LBOUND(SrcRtHndSideData%PAngVelER,3) - i3_u = UBOUND(SrcRtHndSideData%PAngVelER,3) - IF (.NOT. ALLOCATED(DstRtHndSideData%PAngVelER)) THEN - ALLOCATE(DstRtHndSideData%PAngVelER(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PAngVelER.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PAngVelER = SrcRtHndSideData%PAngVelER -ENDIF -IF (ALLOCATED(SrcRtHndSideData%PAngVelEX)) THEN - i1_l = LBOUND(SrcRtHndSideData%PAngVelEX,1) - i1_u = UBOUND(SrcRtHndSideData%PAngVelEX,1) - i2_l = LBOUND(SrcRtHndSideData%PAngVelEX,2) - i2_u = UBOUND(SrcRtHndSideData%PAngVelEX,2) - i3_l = LBOUND(SrcRtHndSideData%PAngVelEX,3) - i3_u = UBOUND(SrcRtHndSideData%PAngVelEX,3) - IF (.NOT. ALLOCATED(DstRtHndSideData%PAngVelEX)) THEN - ALLOCATE(DstRtHndSideData%PAngVelEX(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PAngVelEX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PAngVelEX = SrcRtHndSideData%PAngVelEX -ENDIF - DstRtHndSideData%AngVelEG = SrcRtHndSideData%AngVelEG - DstRtHndSideData%AngVelEH = SrcRtHndSideData%AngVelEH - DstRtHndSideData%AngVelEL = SrcRtHndSideData%AngVelEL - DstRtHndSideData%AngVelEN = SrcRtHndSideData%AngVelEN - DstRtHndSideData%AngVelEB = SrcRtHndSideData%AngVelEB - DstRtHndSideData%AngVelER = SrcRtHndSideData%AngVelER - DstRtHndSideData%AngVelEX = SrcRtHndSideData%AngVelEX - DstRtHndSideData%TeetAngVel = SrcRtHndSideData%TeetAngVel - DstRtHndSideData%AngAccEBt = SrcRtHndSideData%AngAccEBt - DstRtHndSideData%AngAccERt = SrcRtHndSideData%AngAccERt - DstRtHndSideData%AngAccEXt = SrcRtHndSideData%AngAccEXt -IF (ALLOCATED(SrcRtHndSideData%AngAccEFt)) THEN - i1_l = LBOUND(SrcRtHndSideData%AngAccEFt,1) - i1_u = UBOUND(SrcRtHndSideData%AngAccEFt,1) - i2_l = LBOUND(SrcRtHndSideData%AngAccEFt,2) - i2_u = UBOUND(SrcRtHndSideData%AngAccEFt,2) - IF (.NOT. ALLOCATED(DstRtHndSideData%AngAccEFt)) THEN - ALLOCATE(DstRtHndSideData%AngAccEFt(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%AngAccEFt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%AngAccEFt = SrcRtHndSideData%AngAccEFt -ENDIF -IF (ALLOCATED(SrcRtHndSideData%AngVelEF)) THEN - i1_l = LBOUND(SrcRtHndSideData%AngVelEF,1) - i1_u = UBOUND(SrcRtHndSideData%AngVelEF,1) - i2_l = LBOUND(SrcRtHndSideData%AngVelEF,2) - i2_u = UBOUND(SrcRtHndSideData%AngVelEF,2) - IF (.NOT. ALLOCATED(DstRtHndSideData%AngVelEF)) THEN - ALLOCATE(DstRtHndSideData%AngVelEF(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%AngVelEF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%AngVelEF = SrcRtHndSideData%AngVelEF -ENDIF -IF (ALLOCATED(SrcRtHndSideData%AngVelHM)) THEN - i1_l = LBOUND(SrcRtHndSideData%AngVelHM,1) - i1_u = UBOUND(SrcRtHndSideData%AngVelHM,1) - i2_l = LBOUND(SrcRtHndSideData%AngVelHM,2) - i2_u = UBOUND(SrcRtHndSideData%AngVelHM,2) - i3_l = LBOUND(SrcRtHndSideData%AngVelHM,3) - i3_u = UBOUND(SrcRtHndSideData%AngVelHM,3) - IF (.NOT. ALLOCATED(DstRtHndSideData%AngVelHM)) THEN - ALLOCATE(DstRtHndSideData%AngVelHM(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%AngVelHM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%AngVelHM = SrcRtHndSideData%AngVelHM -ENDIF - DstRtHndSideData%AngAccEAt = SrcRtHndSideData%AngAccEAt - DstRtHndSideData%AngAccEGt = SrcRtHndSideData%AngAccEGt - DstRtHndSideData%AngAccEHt = SrcRtHndSideData%AngAccEHt -IF (ALLOCATED(SrcRtHndSideData%AngAccEKt)) THEN - i1_l = LBOUND(SrcRtHndSideData%AngAccEKt,1) - i1_u = UBOUND(SrcRtHndSideData%AngAccEKt,1) - i2_l = LBOUND(SrcRtHndSideData%AngAccEKt,2) - i2_u = UBOUND(SrcRtHndSideData%AngAccEKt,2) - i3_l = LBOUND(SrcRtHndSideData%AngAccEKt,3) - i3_u = UBOUND(SrcRtHndSideData%AngAccEKt,3) - IF (.NOT. ALLOCATED(DstRtHndSideData%AngAccEKt)) THEN - ALLOCATE(DstRtHndSideData%AngAccEKt(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%AngAccEKt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%AngAccEKt = SrcRtHndSideData%AngAccEKt -ENDIF - DstRtHndSideData%AngAccENt = SrcRtHndSideData%AngAccENt - DstRtHndSideData%LinAccECt = SrcRtHndSideData%LinAccECt - DstRtHndSideData%LinAccEDt = SrcRtHndSideData%LinAccEDt - DstRtHndSideData%LinAccEIt = SrcRtHndSideData%LinAccEIt - DstRtHndSideData%LinAccEJt = SrcRtHndSideData%LinAccEJt - DstRtHndSideData%LinAccEUt = SrcRtHndSideData%LinAccEUt - DstRtHndSideData%LinAccEYt = SrcRtHndSideData%LinAccEYt -IF (ALLOCATED(SrcRtHndSideData%LinVelES)) THEN - i1_l = LBOUND(SrcRtHndSideData%LinVelES,1) - i1_u = UBOUND(SrcRtHndSideData%LinVelES,1) - i2_l = LBOUND(SrcRtHndSideData%LinVelES,2) - i2_u = UBOUND(SrcRtHndSideData%LinVelES,2) - i3_l = LBOUND(SrcRtHndSideData%LinVelES,3) - i3_u = UBOUND(SrcRtHndSideData%LinVelES,3) - IF (.NOT. ALLOCATED(DstRtHndSideData%LinVelES)) THEN - ALLOCATE(DstRtHndSideData%LinVelES(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%LinVelES.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%LinVelES = SrcRtHndSideData%LinVelES -ENDIF - DstRtHndSideData%LinVelEQ = SrcRtHndSideData%LinVelEQ -IF (ALLOCATED(SrcRtHndSideData%LinVelET)) THEN - i1_l = LBOUND(SrcRtHndSideData%LinVelET,1) - i1_u = UBOUND(SrcRtHndSideData%LinVelET,1) - i2_l = LBOUND(SrcRtHndSideData%LinVelET,2) - i2_u = UBOUND(SrcRtHndSideData%LinVelET,2) - IF (.NOT. ALLOCATED(DstRtHndSideData%LinVelET)) THEN - ALLOCATE(DstRtHndSideData%LinVelET(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%LinVelET.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%LinVelET = SrcRtHndSideData%LinVelET -ENDIF -IF (ALLOCATED(SrcRtHndSideData%LinVelESm2)) THEN - i1_l = LBOUND(SrcRtHndSideData%LinVelESm2,1) - i1_u = UBOUND(SrcRtHndSideData%LinVelESm2,1) - IF (.NOT. ALLOCATED(DstRtHndSideData%LinVelESm2)) THEN - ALLOCATE(DstRtHndSideData%LinVelESm2(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%LinVelESm2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%LinVelESm2 = SrcRtHndSideData%LinVelESm2 -ENDIF -IF (ALLOCATED(SrcRtHndSideData%PLinVelEIMU)) THEN - i1_l = LBOUND(SrcRtHndSideData%PLinVelEIMU,1) - i1_u = UBOUND(SrcRtHndSideData%PLinVelEIMU,1) - i2_l = LBOUND(SrcRtHndSideData%PLinVelEIMU,2) - i2_u = UBOUND(SrcRtHndSideData%PLinVelEIMU,2) - i3_l = LBOUND(SrcRtHndSideData%PLinVelEIMU,3) - i3_u = UBOUND(SrcRtHndSideData%PLinVelEIMU,3) - IF (.NOT. ALLOCATED(DstRtHndSideData%PLinVelEIMU)) THEN - ALLOCATE(DstRtHndSideData%PLinVelEIMU(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PLinVelEIMU.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PLinVelEIMU = SrcRtHndSideData%PLinVelEIMU -ENDIF -IF (ALLOCATED(SrcRtHndSideData%PLinVelEO)) THEN - i1_l = LBOUND(SrcRtHndSideData%PLinVelEO,1) - i1_u = UBOUND(SrcRtHndSideData%PLinVelEO,1) - i2_l = LBOUND(SrcRtHndSideData%PLinVelEO,2) - i2_u = UBOUND(SrcRtHndSideData%PLinVelEO,2) - i3_l = LBOUND(SrcRtHndSideData%PLinVelEO,3) - i3_u = UBOUND(SrcRtHndSideData%PLinVelEO,3) - IF (.NOT. ALLOCATED(DstRtHndSideData%PLinVelEO)) THEN - ALLOCATE(DstRtHndSideData%PLinVelEO(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PLinVelEO.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PLinVelEO = SrcRtHndSideData%PLinVelEO -ENDIF -IF (ALLOCATED(SrcRtHndSideData%PLinVelES)) THEN - i1_l = LBOUND(SrcRtHndSideData%PLinVelES,1) - i1_u = UBOUND(SrcRtHndSideData%PLinVelES,1) - i2_l = LBOUND(SrcRtHndSideData%PLinVelES,2) - i2_u = UBOUND(SrcRtHndSideData%PLinVelES,2) - i3_l = LBOUND(SrcRtHndSideData%PLinVelES,3) - i3_u = UBOUND(SrcRtHndSideData%PLinVelES,3) - i4_l = LBOUND(SrcRtHndSideData%PLinVelES,4) - i4_u = UBOUND(SrcRtHndSideData%PLinVelES,4) - i5_l = LBOUND(SrcRtHndSideData%PLinVelES,5) - i5_u = UBOUND(SrcRtHndSideData%PLinVelES,5) - IF (.NOT. ALLOCATED(DstRtHndSideData%PLinVelES)) THEN - ALLOCATE(DstRtHndSideData%PLinVelES(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u,i5_l:i5_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PLinVelES.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PLinVelES = SrcRtHndSideData%PLinVelES -ENDIF -IF (ALLOCATED(SrcRtHndSideData%PLinVelET)) THEN - i1_l = LBOUND(SrcRtHndSideData%PLinVelET,1) - i1_u = UBOUND(SrcRtHndSideData%PLinVelET,1) - i2_l = LBOUND(SrcRtHndSideData%PLinVelET,2) - i2_u = UBOUND(SrcRtHndSideData%PLinVelET,2) - i3_l = LBOUND(SrcRtHndSideData%PLinVelET,3) - i3_u = UBOUND(SrcRtHndSideData%PLinVelET,3) - i4_l = LBOUND(SrcRtHndSideData%PLinVelET,4) - i4_u = UBOUND(SrcRtHndSideData%PLinVelET,4) - IF (.NOT. ALLOCATED(DstRtHndSideData%PLinVelET)) THEN - ALLOCATE(DstRtHndSideData%PLinVelET(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 DstRtHndSideData%PLinVelET.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PLinVelET = SrcRtHndSideData%PLinVelET -ENDIF -IF (ALLOCATED(SrcRtHndSideData%PLinVelEZ)) THEN - i1_l = LBOUND(SrcRtHndSideData%PLinVelEZ,1) - i1_u = UBOUND(SrcRtHndSideData%PLinVelEZ,1) - i2_l = LBOUND(SrcRtHndSideData%PLinVelEZ,2) - i2_u = UBOUND(SrcRtHndSideData%PLinVelEZ,2) - i3_l = LBOUND(SrcRtHndSideData%PLinVelEZ,3) - i3_u = UBOUND(SrcRtHndSideData%PLinVelEZ,3) - IF (.NOT. ALLOCATED(DstRtHndSideData%PLinVelEZ)) THEN - ALLOCATE(DstRtHndSideData%PLinVelEZ(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PLinVelEZ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PLinVelEZ = SrcRtHndSideData%PLinVelEZ -ENDIF -IF (ALLOCATED(SrcRtHndSideData%PLinVelEC)) THEN - i1_l = LBOUND(SrcRtHndSideData%PLinVelEC,1) - i1_u = UBOUND(SrcRtHndSideData%PLinVelEC,1) - i2_l = LBOUND(SrcRtHndSideData%PLinVelEC,2) - i2_u = UBOUND(SrcRtHndSideData%PLinVelEC,2) - i3_l = LBOUND(SrcRtHndSideData%PLinVelEC,3) - i3_u = UBOUND(SrcRtHndSideData%PLinVelEC,3) - IF (.NOT. ALLOCATED(DstRtHndSideData%PLinVelEC)) THEN - ALLOCATE(DstRtHndSideData%PLinVelEC(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PLinVelEC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PLinVelEC = SrcRtHndSideData%PLinVelEC -ENDIF -IF (ALLOCATED(SrcRtHndSideData%PLinVelED)) THEN - i1_l = LBOUND(SrcRtHndSideData%PLinVelED,1) - i1_u = UBOUND(SrcRtHndSideData%PLinVelED,1) - i2_l = LBOUND(SrcRtHndSideData%PLinVelED,2) - i2_u = UBOUND(SrcRtHndSideData%PLinVelED,2) - i3_l = LBOUND(SrcRtHndSideData%PLinVelED,3) - i3_u = UBOUND(SrcRtHndSideData%PLinVelED,3) - IF (.NOT. ALLOCATED(DstRtHndSideData%PLinVelED)) THEN - ALLOCATE(DstRtHndSideData%PLinVelED(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PLinVelED.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PLinVelED = SrcRtHndSideData%PLinVelED -ENDIF -IF (ALLOCATED(SrcRtHndSideData%PLinVelEI)) THEN - i1_l = LBOUND(SrcRtHndSideData%PLinVelEI,1) - i1_u = UBOUND(SrcRtHndSideData%PLinVelEI,1) - i2_l = LBOUND(SrcRtHndSideData%PLinVelEI,2) - i2_u = UBOUND(SrcRtHndSideData%PLinVelEI,2) - i3_l = LBOUND(SrcRtHndSideData%PLinVelEI,3) - i3_u = UBOUND(SrcRtHndSideData%PLinVelEI,3) - IF (.NOT. ALLOCATED(DstRtHndSideData%PLinVelEI)) THEN - ALLOCATE(DstRtHndSideData%PLinVelEI(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PLinVelEI.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PLinVelEI = SrcRtHndSideData%PLinVelEI -ENDIF -IF (ALLOCATED(SrcRtHndSideData%PLinVelEJ)) THEN - i1_l = LBOUND(SrcRtHndSideData%PLinVelEJ,1) - i1_u = UBOUND(SrcRtHndSideData%PLinVelEJ,1) - i2_l = LBOUND(SrcRtHndSideData%PLinVelEJ,2) - i2_u = UBOUND(SrcRtHndSideData%PLinVelEJ,2) - i3_l = LBOUND(SrcRtHndSideData%PLinVelEJ,3) - i3_u = UBOUND(SrcRtHndSideData%PLinVelEJ,3) - IF (.NOT. ALLOCATED(DstRtHndSideData%PLinVelEJ)) THEN - ALLOCATE(DstRtHndSideData%PLinVelEJ(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PLinVelEJ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PLinVelEJ = SrcRtHndSideData%PLinVelEJ -ENDIF -IF (ALLOCATED(SrcRtHndSideData%PLinVelEP)) THEN - i1_l = LBOUND(SrcRtHndSideData%PLinVelEP,1) - i1_u = UBOUND(SrcRtHndSideData%PLinVelEP,1) - i2_l = LBOUND(SrcRtHndSideData%PLinVelEP,2) - i2_u = UBOUND(SrcRtHndSideData%PLinVelEP,2) - i3_l = LBOUND(SrcRtHndSideData%PLinVelEP,3) - i3_u = UBOUND(SrcRtHndSideData%PLinVelEP,3) - IF (.NOT. ALLOCATED(DstRtHndSideData%PLinVelEP)) THEN - ALLOCATE(DstRtHndSideData%PLinVelEP(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PLinVelEP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PLinVelEP = SrcRtHndSideData%PLinVelEP -ENDIF -IF (ALLOCATED(SrcRtHndSideData%PLinVelEQ)) THEN - i1_l = LBOUND(SrcRtHndSideData%PLinVelEQ,1) - i1_u = UBOUND(SrcRtHndSideData%PLinVelEQ,1) - i2_l = LBOUND(SrcRtHndSideData%PLinVelEQ,2) - i2_u = UBOUND(SrcRtHndSideData%PLinVelEQ,2) - i3_l = LBOUND(SrcRtHndSideData%PLinVelEQ,3) - i3_u = UBOUND(SrcRtHndSideData%PLinVelEQ,3) - IF (.NOT. ALLOCATED(DstRtHndSideData%PLinVelEQ)) THEN - ALLOCATE(DstRtHndSideData%PLinVelEQ(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PLinVelEQ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PLinVelEQ = SrcRtHndSideData%PLinVelEQ -ENDIF -IF (ALLOCATED(SrcRtHndSideData%PLinVelEU)) THEN - i1_l = LBOUND(SrcRtHndSideData%PLinVelEU,1) - i1_u = UBOUND(SrcRtHndSideData%PLinVelEU,1) - i2_l = LBOUND(SrcRtHndSideData%PLinVelEU,2) - i2_u = UBOUND(SrcRtHndSideData%PLinVelEU,2) - i3_l = LBOUND(SrcRtHndSideData%PLinVelEU,3) - i3_u = UBOUND(SrcRtHndSideData%PLinVelEU,3) - IF (.NOT. ALLOCATED(DstRtHndSideData%PLinVelEU)) THEN - ALLOCATE(DstRtHndSideData%PLinVelEU(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PLinVelEU.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PLinVelEU = SrcRtHndSideData%PLinVelEU -ENDIF -IF (ALLOCATED(SrcRtHndSideData%PLinVelEV)) THEN - i1_l = LBOUND(SrcRtHndSideData%PLinVelEV,1) - i1_u = UBOUND(SrcRtHndSideData%PLinVelEV,1) - i2_l = LBOUND(SrcRtHndSideData%PLinVelEV,2) - i2_u = UBOUND(SrcRtHndSideData%PLinVelEV,2) - i3_l = LBOUND(SrcRtHndSideData%PLinVelEV,3) - i3_u = UBOUND(SrcRtHndSideData%PLinVelEV,3) - IF (.NOT. ALLOCATED(DstRtHndSideData%PLinVelEV)) THEN - ALLOCATE(DstRtHndSideData%PLinVelEV(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PLinVelEV.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PLinVelEV = SrcRtHndSideData%PLinVelEV -ENDIF -IF (ALLOCATED(SrcRtHndSideData%PLinVelEW)) THEN - i1_l = LBOUND(SrcRtHndSideData%PLinVelEW,1) - i1_u = UBOUND(SrcRtHndSideData%PLinVelEW,1) - i2_l = LBOUND(SrcRtHndSideData%PLinVelEW,2) - i2_u = UBOUND(SrcRtHndSideData%PLinVelEW,2) - i3_l = LBOUND(SrcRtHndSideData%PLinVelEW,3) - i3_u = UBOUND(SrcRtHndSideData%PLinVelEW,3) - IF (.NOT. ALLOCATED(DstRtHndSideData%PLinVelEW)) THEN - ALLOCATE(DstRtHndSideData%PLinVelEW(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PLinVelEW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PLinVelEW = SrcRtHndSideData%PLinVelEW -ENDIF -IF (ALLOCATED(SrcRtHndSideData%PLinVelEY)) THEN - i1_l = LBOUND(SrcRtHndSideData%PLinVelEY,1) - i1_u = UBOUND(SrcRtHndSideData%PLinVelEY,1) - i2_l = LBOUND(SrcRtHndSideData%PLinVelEY,2) - i2_u = UBOUND(SrcRtHndSideData%PLinVelEY,2) - i3_l = LBOUND(SrcRtHndSideData%PLinVelEY,3) - i3_u = UBOUND(SrcRtHndSideData%PLinVelEY,3) - IF (.NOT. ALLOCATED(DstRtHndSideData%PLinVelEY)) THEN - ALLOCATE(DstRtHndSideData%PLinVelEY(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PLinVelEY.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PLinVelEY = SrcRtHndSideData%PLinVelEY -ENDIF - DstRtHndSideData%LinAccEIMUt = SrcRtHndSideData%LinAccEIMUt - DstRtHndSideData%LinAccEOt = SrcRtHndSideData%LinAccEOt -IF (ALLOCATED(SrcRtHndSideData%LinAccESt)) THEN - i1_l = LBOUND(SrcRtHndSideData%LinAccESt,1) - i1_u = UBOUND(SrcRtHndSideData%LinAccESt,1) - i2_l = LBOUND(SrcRtHndSideData%LinAccESt,2) - i2_u = UBOUND(SrcRtHndSideData%LinAccESt,2) - i3_l = LBOUND(SrcRtHndSideData%LinAccESt,3) - i3_u = UBOUND(SrcRtHndSideData%LinAccESt,3) - IF (.NOT. ALLOCATED(DstRtHndSideData%LinAccESt)) THEN - ALLOCATE(DstRtHndSideData%LinAccESt(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%LinAccESt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%LinAccESt = SrcRtHndSideData%LinAccESt -ENDIF -IF (ALLOCATED(SrcRtHndSideData%LinAccETt)) THEN - i1_l = LBOUND(SrcRtHndSideData%LinAccETt,1) - i1_u = UBOUND(SrcRtHndSideData%LinAccETt,1) - i2_l = LBOUND(SrcRtHndSideData%LinAccETt,2) - i2_u = UBOUND(SrcRtHndSideData%LinAccETt,2) - IF (.NOT. ALLOCATED(DstRtHndSideData%LinAccETt)) THEN - ALLOCATE(DstRtHndSideData%LinAccETt(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%LinAccETt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%LinAccETt = SrcRtHndSideData%LinAccETt -ENDIF - DstRtHndSideData%LinAccEZt = SrcRtHndSideData%LinAccEZt - DstRtHndSideData%LinVelEIMU = SrcRtHndSideData%LinVelEIMU - DstRtHndSideData%LinVelEZ = SrcRtHndSideData%LinVelEZ - DstRtHndSideData%LinVelEO = SrcRtHndSideData%LinVelEO - DstRtHndSideData%LinVelEJ = SrcRtHndSideData%LinVelEJ - DstRtHndSideData%FrcONcRtt = SrcRtHndSideData%FrcONcRtt - DstRtHndSideData%FrcPRott = SrcRtHndSideData%FrcPRott -IF (ALLOCATED(SrcRtHndSideData%FrcS0Bt)) THEN - i1_l = LBOUND(SrcRtHndSideData%FrcS0Bt,1) - i1_u = UBOUND(SrcRtHndSideData%FrcS0Bt,1) - i2_l = LBOUND(SrcRtHndSideData%FrcS0Bt,2) - i2_u = UBOUND(SrcRtHndSideData%FrcS0Bt,2) - IF (.NOT. ALLOCATED(DstRtHndSideData%FrcS0Bt)) THEN - ALLOCATE(DstRtHndSideData%FrcS0Bt(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%FrcS0Bt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%FrcS0Bt = SrcRtHndSideData%FrcS0Bt -ENDIF - DstRtHndSideData%FrcT0Trbt = SrcRtHndSideData%FrcT0Trbt -IF (ALLOCATED(SrcRtHndSideData%FSAero)) THEN - i1_l = LBOUND(SrcRtHndSideData%FSAero,1) - i1_u = UBOUND(SrcRtHndSideData%FSAero,1) - i2_l = LBOUND(SrcRtHndSideData%FSAero,2) - i2_u = UBOUND(SrcRtHndSideData%FSAero,2) - i3_l = LBOUND(SrcRtHndSideData%FSAero,3) - i3_u = UBOUND(SrcRtHndSideData%FSAero,3) - IF (.NOT. ALLOCATED(DstRtHndSideData%FSAero)) THEN - ALLOCATE(DstRtHndSideData%FSAero(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%FSAero.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%FSAero = SrcRtHndSideData%FSAero -ENDIF -IF (ALLOCATED(SrcRtHndSideData%FSTipDrag)) THEN - i1_l = LBOUND(SrcRtHndSideData%FSTipDrag,1) - i1_u = UBOUND(SrcRtHndSideData%FSTipDrag,1) - i2_l = LBOUND(SrcRtHndSideData%FSTipDrag,2) - i2_u = UBOUND(SrcRtHndSideData%FSTipDrag,2) - IF (.NOT. ALLOCATED(DstRtHndSideData%FSTipDrag)) THEN - ALLOCATE(DstRtHndSideData%FSTipDrag(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%FSTipDrag.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%FSTipDrag = SrcRtHndSideData%FSTipDrag -ENDIF -IF (ALLOCATED(SrcRtHndSideData%FTHydrot)) THEN - i1_l = LBOUND(SrcRtHndSideData%FTHydrot,1) - i1_u = UBOUND(SrcRtHndSideData%FTHydrot,1) - i2_l = LBOUND(SrcRtHndSideData%FTHydrot,2) - i2_u = UBOUND(SrcRtHndSideData%FTHydrot,2) - IF (.NOT. ALLOCATED(DstRtHndSideData%FTHydrot)) THEN - ALLOCATE(DstRtHndSideData%FTHydrot(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%FTHydrot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%FTHydrot = SrcRtHndSideData%FTHydrot -ENDIF - DstRtHndSideData%FZHydrot = SrcRtHndSideData%FZHydrot -IF (ALLOCATED(SrcRtHndSideData%MFHydrot)) THEN - i1_l = LBOUND(SrcRtHndSideData%MFHydrot,1) - i1_u = UBOUND(SrcRtHndSideData%MFHydrot,1) - i2_l = LBOUND(SrcRtHndSideData%MFHydrot,2) - i2_u = UBOUND(SrcRtHndSideData%MFHydrot,2) - IF (.NOT. ALLOCATED(DstRtHndSideData%MFHydrot)) THEN - ALLOCATE(DstRtHndSideData%MFHydrot(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%MFHydrot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%MFHydrot = SrcRtHndSideData%MFHydrot -ENDIF - DstRtHndSideData%MomBNcRtt = SrcRtHndSideData%MomBNcRtt -IF (ALLOCATED(SrcRtHndSideData%MomH0Bt)) THEN - i1_l = LBOUND(SrcRtHndSideData%MomH0Bt,1) - i1_u = UBOUND(SrcRtHndSideData%MomH0Bt,1) - i2_l = LBOUND(SrcRtHndSideData%MomH0Bt,2) - i2_u = UBOUND(SrcRtHndSideData%MomH0Bt,2) - IF (.NOT. ALLOCATED(DstRtHndSideData%MomH0Bt)) THEN - ALLOCATE(DstRtHndSideData%MomH0Bt(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%MomH0Bt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%MomH0Bt = SrcRtHndSideData%MomH0Bt -ENDIF - DstRtHndSideData%MomLPRott = SrcRtHndSideData%MomLPRott - DstRtHndSideData%MomNGnRtt = SrcRtHndSideData%MomNGnRtt - DstRtHndSideData%MomNTailt = SrcRtHndSideData%MomNTailt - DstRtHndSideData%MomX0Trbt = SrcRtHndSideData%MomX0Trbt -IF (ALLOCATED(SrcRtHndSideData%MMAero)) THEN - i1_l = LBOUND(SrcRtHndSideData%MMAero,1) - i1_u = UBOUND(SrcRtHndSideData%MMAero,1) - i2_l = LBOUND(SrcRtHndSideData%MMAero,2) - i2_u = UBOUND(SrcRtHndSideData%MMAero,2) - i3_l = LBOUND(SrcRtHndSideData%MMAero,3) - i3_u = UBOUND(SrcRtHndSideData%MMAero,3) - IF (.NOT. ALLOCATED(DstRtHndSideData%MMAero)) THEN - ALLOCATE(DstRtHndSideData%MMAero(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%MMAero.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%MMAero = SrcRtHndSideData%MMAero -ENDIF - DstRtHndSideData%MXHydrot = SrcRtHndSideData%MXHydrot -IF (ALLOCATED(SrcRtHndSideData%PFrcONcRt)) THEN - i1_l = LBOUND(SrcRtHndSideData%PFrcONcRt,1) - i1_u = UBOUND(SrcRtHndSideData%PFrcONcRt,1) - i2_l = LBOUND(SrcRtHndSideData%PFrcONcRt,2) - i2_u = UBOUND(SrcRtHndSideData%PFrcONcRt,2) - IF (.NOT. ALLOCATED(DstRtHndSideData%PFrcONcRt)) THEN - ALLOCATE(DstRtHndSideData%PFrcONcRt(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PFrcONcRt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PFrcONcRt = SrcRtHndSideData%PFrcONcRt -ENDIF -IF (ALLOCATED(SrcRtHndSideData%PFrcPRot)) THEN - i1_l = LBOUND(SrcRtHndSideData%PFrcPRot,1) - i1_u = UBOUND(SrcRtHndSideData%PFrcPRot,1) - i2_l = LBOUND(SrcRtHndSideData%PFrcPRot,2) - i2_u = UBOUND(SrcRtHndSideData%PFrcPRot,2) - IF (.NOT. ALLOCATED(DstRtHndSideData%PFrcPRot)) THEN - ALLOCATE(DstRtHndSideData%PFrcPRot(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PFrcPRot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PFrcPRot = SrcRtHndSideData%PFrcPRot -ENDIF -IF (ALLOCATED(SrcRtHndSideData%PFrcS0B)) THEN - i1_l = LBOUND(SrcRtHndSideData%PFrcS0B,1) - i1_u = UBOUND(SrcRtHndSideData%PFrcS0B,1) - i2_l = LBOUND(SrcRtHndSideData%PFrcS0B,2) - i2_u = UBOUND(SrcRtHndSideData%PFrcS0B,2) - i3_l = LBOUND(SrcRtHndSideData%PFrcS0B,3) - i3_u = UBOUND(SrcRtHndSideData%PFrcS0B,3) - IF (.NOT. ALLOCATED(DstRtHndSideData%PFrcS0B)) THEN - ALLOCATE(DstRtHndSideData%PFrcS0B(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PFrcS0B.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PFrcS0B = SrcRtHndSideData%PFrcS0B -ENDIF -IF (ALLOCATED(SrcRtHndSideData%PFrcT0Trb)) THEN - i1_l = LBOUND(SrcRtHndSideData%PFrcT0Trb,1) - i1_u = UBOUND(SrcRtHndSideData%PFrcT0Trb,1) - i2_l = LBOUND(SrcRtHndSideData%PFrcT0Trb,2) - i2_u = UBOUND(SrcRtHndSideData%PFrcT0Trb,2) - IF (.NOT. ALLOCATED(DstRtHndSideData%PFrcT0Trb)) THEN - ALLOCATE(DstRtHndSideData%PFrcT0Trb(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PFrcT0Trb.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PFrcT0Trb = SrcRtHndSideData%PFrcT0Trb -ENDIF -IF (ALLOCATED(SrcRtHndSideData%PFTHydro)) THEN - i1_l = LBOUND(SrcRtHndSideData%PFTHydro,1) - i1_u = UBOUND(SrcRtHndSideData%PFTHydro,1) - i2_l = LBOUND(SrcRtHndSideData%PFTHydro,2) - i2_u = UBOUND(SrcRtHndSideData%PFTHydro,2) - i3_l = LBOUND(SrcRtHndSideData%PFTHydro,3) - i3_u = UBOUND(SrcRtHndSideData%PFTHydro,3) - IF (.NOT. ALLOCATED(DstRtHndSideData%PFTHydro)) THEN - ALLOCATE(DstRtHndSideData%PFTHydro(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PFTHydro.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PFTHydro = SrcRtHndSideData%PFTHydro -ENDIF - DstRtHndSideData%PFZHydro = SrcRtHndSideData%PFZHydro -IF (ALLOCATED(SrcRtHndSideData%PMFHydro)) THEN - i1_l = LBOUND(SrcRtHndSideData%PMFHydro,1) - i1_u = UBOUND(SrcRtHndSideData%PMFHydro,1) - i2_l = LBOUND(SrcRtHndSideData%PMFHydro,2) - i2_u = UBOUND(SrcRtHndSideData%PMFHydro,2) - i3_l = LBOUND(SrcRtHndSideData%PMFHydro,3) - i3_u = UBOUND(SrcRtHndSideData%PMFHydro,3) - IF (.NOT. ALLOCATED(DstRtHndSideData%PMFHydro)) THEN - ALLOCATE(DstRtHndSideData%PMFHydro(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PMFHydro.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PMFHydro = SrcRtHndSideData%PMFHydro -ENDIF -IF (ALLOCATED(SrcRtHndSideData%PMomBNcRt)) THEN - i1_l = LBOUND(SrcRtHndSideData%PMomBNcRt,1) - i1_u = UBOUND(SrcRtHndSideData%PMomBNcRt,1) - i2_l = LBOUND(SrcRtHndSideData%PMomBNcRt,2) - i2_u = UBOUND(SrcRtHndSideData%PMomBNcRt,2) - IF (.NOT. ALLOCATED(DstRtHndSideData%PMomBNcRt)) THEN - ALLOCATE(DstRtHndSideData%PMomBNcRt(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PMomBNcRt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PMomBNcRt = SrcRtHndSideData%PMomBNcRt -ENDIF -IF (ALLOCATED(SrcRtHndSideData%PMomH0B)) THEN - i1_l = LBOUND(SrcRtHndSideData%PMomH0B,1) - i1_u = UBOUND(SrcRtHndSideData%PMomH0B,1) - i2_l = LBOUND(SrcRtHndSideData%PMomH0B,2) - i2_u = UBOUND(SrcRtHndSideData%PMomH0B,2) - i3_l = LBOUND(SrcRtHndSideData%PMomH0B,3) - i3_u = UBOUND(SrcRtHndSideData%PMomH0B,3) - IF (.NOT. ALLOCATED(DstRtHndSideData%PMomH0B)) THEN - ALLOCATE(DstRtHndSideData%PMomH0B(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PMomH0B.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PMomH0B = SrcRtHndSideData%PMomH0B -ENDIF -IF (ALLOCATED(SrcRtHndSideData%PMomLPRot)) THEN - i1_l = LBOUND(SrcRtHndSideData%PMomLPRot,1) - i1_u = UBOUND(SrcRtHndSideData%PMomLPRot,1) - i2_l = LBOUND(SrcRtHndSideData%PMomLPRot,2) - i2_u = UBOUND(SrcRtHndSideData%PMomLPRot,2) - IF (.NOT. ALLOCATED(DstRtHndSideData%PMomLPRot)) THEN - ALLOCATE(DstRtHndSideData%PMomLPRot(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PMomLPRot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PMomLPRot = SrcRtHndSideData%PMomLPRot -ENDIF -IF (ALLOCATED(SrcRtHndSideData%PMomNGnRt)) THEN - i1_l = LBOUND(SrcRtHndSideData%PMomNGnRt,1) - i1_u = UBOUND(SrcRtHndSideData%PMomNGnRt,1) - i2_l = LBOUND(SrcRtHndSideData%PMomNGnRt,2) - i2_u = UBOUND(SrcRtHndSideData%PMomNGnRt,2) - IF (.NOT. ALLOCATED(DstRtHndSideData%PMomNGnRt)) THEN - ALLOCATE(DstRtHndSideData%PMomNGnRt(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PMomNGnRt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PMomNGnRt = SrcRtHndSideData%PMomNGnRt -ENDIF -IF (ALLOCATED(SrcRtHndSideData%PMomNTail)) THEN - i1_l = LBOUND(SrcRtHndSideData%PMomNTail,1) - i1_u = UBOUND(SrcRtHndSideData%PMomNTail,1) - i2_l = LBOUND(SrcRtHndSideData%PMomNTail,2) - i2_u = UBOUND(SrcRtHndSideData%PMomNTail,2) - IF (.NOT. ALLOCATED(DstRtHndSideData%PMomNTail)) THEN - ALLOCATE(DstRtHndSideData%PMomNTail(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PMomNTail.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PMomNTail = SrcRtHndSideData%PMomNTail -ENDIF -IF (ALLOCATED(SrcRtHndSideData%PMomX0Trb)) THEN - i1_l = LBOUND(SrcRtHndSideData%PMomX0Trb,1) - i1_u = UBOUND(SrcRtHndSideData%PMomX0Trb,1) - i2_l = LBOUND(SrcRtHndSideData%PMomX0Trb,2) - i2_u = UBOUND(SrcRtHndSideData%PMomX0Trb,2) - IF (.NOT. ALLOCATED(DstRtHndSideData%PMomX0Trb)) THEN - ALLOCATE(DstRtHndSideData%PMomX0Trb(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PMomX0Trb.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PMomX0Trb = SrcRtHndSideData%PMomX0Trb -ENDIF - DstRtHndSideData%PMXHydro = SrcRtHndSideData%PMXHydro - DstRtHndSideData%TeetAng = SrcRtHndSideData%TeetAng - DstRtHndSideData%FrcVGnRtt = SrcRtHndSideData%FrcVGnRtt - DstRtHndSideData%FrcWTailt = SrcRtHndSideData%FrcWTailt - DstRtHndSideData%FrcZAllt = SrcRtHndSideData%FrcZAllt - DstRtHndSideData%MomXAllt = SrcRtHndSideData%MomXAllt -IF (ALLOCATED(SrcRtHndSideData%PFrcVGnRt)) THEN - i1_l = LBOUND(SrcRtHndSideData%PFrcVGnRt,1) - i1_u = UBOUND(SrcRtHndSideData%PFrcVGnRt,1) - i2_l = LBOUND(SrcRtHndSideData%PFrcVGnRt,2) - i2_u = UBOUND(SrcRtHndSideData%PFrcVGnRt,2) - IF (.NOT. ALLOCATED(DstRtHndSideData%PFrcVGnRt)) THEN - ALLOCATE(DstRtHndSideData%PFrcVGnRt(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PFrcVGnRt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PFrcVGnRt = SrcRtHndSideData%PFrcVGnRt -ENDIF -IF (ALLOCATED(SrcRtHndSideData%PFrcWTail)) THEN - i1_l = LBOUND(SrcRtHndSideData%PFrcWTail,1) - i1_u = UBOUND(SrcRtHndSideData%PFrcWTail,1) - i2_l = LBOUND(SrcRtHndSideData%PFrcWTail,2) - i2_u = UBOUND(SrcRtHndSideData%PFrcWTail,2) - IF (.NOT. ALLOCATED(DstRtHndSideData%PFrcWTail)) THEN - ALLOCATE(DstRtHndSideData%PFrcWTail(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PFrcWTail.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PFrcWTail = SrcRtHndSideData%PFrcWTail -ENDIF -IF (ALLOCATED(SrcRtHndSideData%PFrcZAll)) THEN - i1_l = LBOUND(SrcRtHndSideData%PFrcZAll,1) - i1_u = UBOUND(SrcRtHndSideData%PFrcZAll,1) - i2_l = LBOUND(SrcRtHndSideData%PFrcZAll,2) - i2_u = UBOUND(SrcRtHndSideData%PFrcZAll,2) - IF (.NOT. ALLOCATED(DstRtHndSideData%PFrcZAll)) THEN - ALLOCATE(DstRtHndSideData%PFrcZAll(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PFrcZAll.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PFrcZAll = SrcRtHndSideData%PFrcZAll -ENDIF -IF (ALLOCATED(SrcRtHndSideData%PMomXAll)) THEN - i1_l = LBOUND(SrcRtHndSideData%PMomXAll,1) - i1_u = UBOUND(SrcRtHndSideData%PMomXAll,1) - i2_l = LBOUND(SrcRtHndSideData%PMomXAll,2) - i2_u = UBOUND(SrcRtHndSideData%PMomXAll,2) - IF (.NOT. ALLOCATED(DstRtHndSideData%PMomXAll)) THEN - ALLOCATE(DstRtHndSideData%PMomXAll(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PMomXAll.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PMomXAll = SrcRtHndSideData%PMomXAll -ENDIF - DstRtHndSideData%TeetMom = SrcRtHndSideData%TeetMom - DstRtHndSideData%TFrlMom = SrcRtHndSideData%TFrlMom - DstRtHndSideData%RFrlMom = SrcRtHndSideData%RFrlMom - DstRtHndSideData%GBoxEffFac = SrcRtHndSideData%GBoxEffFac -IF (ALLOCATED(SrcRtHndSideData%rSAerCen)) THEN - i1_l = LBOUND(SrcRtHndSideData%rSAerCen,1) - i1_u = UBOUND(SrcRtHndSideData%rSAerCen,1) - i2_l = LBOUND(SrcRtHndSideData%rSAerCen,2) - i2_u = UBOUND(SrcRtHndSideData%rSAerCen,2) - i3_l = LBOUND(SrcRtHndSideData%rSAerCen,3) - i3_u = UBOUND(SrcRtHndSideData%rSAerCen,3) - IF (.NOT. ALLOCATED(DstRtHndSideData%rSAerCen)) THEN - ALLOCATE(DstRtHndSideData%rSAerCen(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%rSAerCen.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%rSAerCen = SrcRtHndSideData%rSAerCen -ENDIF - END SUBROUTINE ED_CopyRtHndSide - - SUBROUTINE ED_DestroyRtHndSide( RtHndSideData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(ED_RtHndSide), INTENT(INOUT) :: RtHndSideData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_DestroyRtHndSide' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(RtHndSideData%rQS)) THEN - DEALLOCATE(RtHndSideData%rQS) -ENDIF -IF (ALLOCATED(RtHndSideData%rS)) THEN - DEALLOCATE(RtHndSideData%rS) -ENDIF -IF (ALLOCATED(RtHndSideData%rS0S)) THEN - DEALLOCATE(RtHndSideData%rS0S) -ENDIF -IF (ALLOCATED(RtHndSideData%rT)) THEN - DEALLOCATE(RtHndSideData%rT) -ENDIF -IF (ALLOCATED(RtHndSideData%rT0T)) THEN - DEALLOCATE(RtHndSideData%rT0T) -ENDIF -IF (ALLOCATED(RtHndSideData%rZT)) THEN - DEALLOCATE(RtHndSideData%rZT) -ENDIF -IF (ALLOCATED(RtHndSideData%rPS0)) THEN - DEALLOCATE(RtHndSideData%rPS0) -ENDIF -IF (ALLOCATED(RtHndSideData%AngPosEF)) THEN - DEALLOCATE(RtHndSideData%AngPosEF) -ENDIF -IF (ALLOCATED(RtHndSideData%AngPosXF)) THEN - DEALLOCATE(RtHndSideData%AngPosXF) -ENDIF -IF (ALLOCATED(RtHndSideData%AngPosHM)) THEN - DEALLOCATE(RtHndSideData%AngPosHM) -ENDIF -IF (ALLOCATED(RtHndSideData%PAngVelEA)) THEN - DEALLOCATE(RtHndSideData%PAngVelEA) -ENDIF -IF (ALLOCATED(RtHndSideData%PAngVelEF)) THEN - DEALLOCATE(RtHndSideData%PAngVelEF) -ENDIF -IF (ALLOCATED(RtHndSideData%PAngVelEG)) THEN - DEALLOCATE(RtHndSideData%PAngVelEG) -ENDIF -IF (ALLOCATED(RtHndSideData%PAngVelEH)) THEN - DEALLOCATE(RtHndSideData%PAngVelEH) -ENDIF -IF (ALLOCATED(RtHndSideData%PAngVelEL)) THEN - DEALLOCATE(RtHndSideData%PAngVelEL) -ENDIF -IF (ALLOCATED(RtHndSideData%PAngVelEM)) THEN - DEALLOCATE(RtHndSideData%PAngVelEM) -ENDIF -IF (ALLOCATED(RtHndSideData%AngVelEM)) THEN - DEALLOCATE(RtHndSideData%AngVelEM) -ENDIF -IF (ALLOCATED(RtHndSideData%PAngVelEN)) THEN - DEALLOCATE(RtHndSideData%PAngVelEN) -ENDIF -IF (ALLOCATED(RtHndSideData%PAngVelEB)) THEN - DEALLOCATE(RtHndSideData%PAngVelEB) -ENDIF -IF (ALLOCATED(RtHndSideData%PAngVelER)) THEN - DEALLOCATE(RtHndSideData%PAngVelER) -ENDIF -IF (ALLOCATED(RtHndSideData%PAngVelEX)) THEN - DEALLOCATE(RtHndSideData%PAngVelEX) -ENDIF -IF (ALLOCATED(RtHndSideData%AngAccEFt)) THEN - DEALLOCATE(RtHndSideData%AngAccEFt) -ENDIF -IF (ALLOCATED(RtHndSideData%AngVelEF)) THEN - DEALLOCATE(RtHndSideData%AngVelEF) -ENDIF -IF (ALLOCATED(RtHndSideData%AngVelHM)) THEN - DEALLOCATE(RtHndSideData%AngVelHM) -ENDIF -IF (ALLOCATED(RtHndSideData%AngAccEKt)) THEN - DEALLOCATE(RtHndSideData%AngAccEKt) -ENDIF -IF (ALLOCATED(RtHndSideData%LinVelES)) THEN - DEALLOCATE(RtHndSideData%LinVelES) -ENDIF -IF (ALLOCATED(RtHndSideData%LinVelET)) THEN - DEALLOCATE(RtHndSideData%LinVelET) -ENDIF -IF (ALLOCATED(RtHndSideData%LinVelESm2)) THEN - DEALLOCATE(RtHndSideData%LinVelESm2) -ENDIF -IF (ALLOCATED(RtHndSideData%PLinVelEIMU)) THEN - DEALLOCATE(RtHndSideData%PLinVelEIMU) -ENDIF -IF (ALLOCATED(RtHndSideData%PLinVelEO)) THEN - DEALLOCATE(RtHndSideData%PLinVelEO) -ENDIF -IF (ALLOCATED(RtHndSideData%PLinVelES)) THEN - DEALLOCATE(RtHndSideData%PLinVelES) -ENDIF -IF (ALLOCATED(RtHndSideData%PLinVelET)) THEN - DEALLOCATE(RtHndSideData%PLinVelET) -ENDIF -IF (ALLOCATED(RtHndSideData%PLinVelEZ)) THEN - DEALLOCATE(RtHndSideData%PLinVelEZ) -ENDIF -IF (ALLOCATED(RtHndSideData%PLinVelEC)) THEN - DEALLOCATE(RtHndSideData%PLinVelEC) -ENDIF -IF (ALLOCATED(RtHndSideData%PLinVelED)) THEN - DEALLOCATE(RtHndSideData%PLinVelED) -ENDIF -IF (ALLOCATED(RtHndSideData%PLinVelEI)) THEN - DEALLOCATE(RtHndSideData%PLinVelEI) -ENDIF -IF (ALLOCATED(RtHndSideData%PLinVelEJ)) THEN - DEALLOCATE(RtHndSideData%PLinVelEJ) -ENDIF -IF (ALLOCATED(RtHndSideData%PLinVelEP)) THEN - DEALLOCATE(RtHndSideData%PLinVelEP) -ENDIF -IF (ALLOCATED(RtHndSideData%PLinVelEQ)) THEN - DEALLOCATE(RtHndSideData%PLinVelEQ) -ENDIF -IF (ALLOCATED(RtHndSideData%PLinVelEU)) THEN - DEALLOCATE(RtHndSideData%PLinVelEU) -ENDIF -IF (ALLOCATED(RtHndSideData%PLinVelEV)) THEN - DEALLOCATE(RtHndSideData%PLinVelEV) -ENDIF -IF (ALLOCATED(RtHndSideData%PLinVelEW)) THEN - DEALLOCATE(RtHndSideData%PLinVelEW) -ENDIF -IF (ALLOCATED(RtHndSideData%PLinVelEY)) THEN - DEALLOCATE(RtHndSideData%PLinVelEY) -ENDIF -IF (ALLOCATED(RtHndSideData%LinAccESt)) THEN - DEALLOCATE(RtHndSideData%LinAccESt) -ENDIF -IF (ALLOCATED(RtHndSideData%LinAccETt)) THEN - DEALLOCATE(RtHndSideData%LinAccETt) -ENDIF -IF (ALLOCATED(RtHndSideData%FrcS0Bt)) THEN - DEALLOCATE(RtHndSideData%FrcS0Bt) -ENDIF -IF (ALLOCATED(RtHndSideData%FSAero)) THEN - DEALLOCATE(RtHndSideData%FSAero) -ENDIF -IF (ALLOCATED(RtHndSideData%FSTipDrag)) THEN - DEALLOCATE(RtHndSideData%FSTipDrag) -ENDIF -IF (ALLOCATED(RtHndSideData%FTHydrot)) THEN - DEALLOCATE(RtHndSideData%FTHydrot) -ENDIF -IF (ALLOCATED(RtHndSideData%MFHydrot)) THEN - DEALLOCATE(RtHndSideData%MFHydrot) -ENDIF -IF (ALLOCATED(RtHndSideData%MomH0Bt)) THEN - DEALLOCATE(RtHndSideData%MomH0Bt) -ENDIF -IF (ALLOCATED(RtHndSideData%MMAero)) THEN - DEALLOCATE(RtHndSideData%MMAero) -ENDIF -IF (ALLOCATED(RtHndSideData%PFrcONcRt)) THEN - DEALLOCATE(RtHndSideData%PFrcONcRt) -ENDIF -IF (ALLOCATED(RtHndSideData%PFrcPRot)) THEN - DEALLOCATE(RtHndSideData%PFrcPRot) -ENDIF -IF (ALLOCATED(RtHndSideData%PFrcS0B)) THEN - DEALLOCATE(RtHndSideData%PFrcS0B) -ENDIF -IF (ALLOCATED(RtHndSideData%PFrcT0Trb)) THEN - DEALLOCATE(RtHndSideData%PFrcT0Trb) -ENDIF -IF (ALLOCATED(RtHndSideData%PFTHydro)) THEN - DEALLOCATE(RtHndSideData%PFTHydro) -ENDIF -IF (ALLOCATED(RtHndSideData%PMFHydro)) THEN - DEALLOCATE(RtHndSideData%PMFHydro) -ENDIF -IF (ALLOCATED(RtHndSideData%PMomBNcRt)) THEN - DEALLOCATE(RtHndSideData%PMomBNcRt) -ENDIF -IF (ALLOCATED(RtHndSideData%PMomH0B)) THEN - DEALLOCATE(RtHndSideData%PMomH0B) -ENDIF -IF (ALLOCATED(RtHndSideData%PMomLPRot)) THEN - DEALLOCATE(RtHndSideData%PMomLPRot) -ENDIF -IF (ALLOCATED(RtHndSideData%PMomNGnRt)) THEN - DEALLOCATE(RtHndSideData%PMomNGnRt) -ENDIF -IF (ALLOCATED(RtHndSideData%PMomNTail)) THEN - DEALLOCATE(RtHndSideData%PMomNTail) -ENDIF -IF (ALLOCATED(RtHndSideData%PMomX0Trb)) THEN - DEALLOCATE(RtHndSideData%PMomX0Trb) -ENDIF -IF (ALLOCATED(RtHndSideData%PFrcVGnRt)) THEN - DEALLOCATE(RtHndSideData%PFrcVGnRt) -ENDIF -IF (ALLOCATED(RtHndSideData%PFrcWTail)) THEN - DEALLOCATE(RtHndSideData%PFrcWTail) -ENDIF -IF (ALLOCATED(RtHndSideData%PFrcZAll)) THEN - DEALLOCATE(RtHndSideData%PFrcZAll) -ENDIF -IF (ALLOCATED(RtHndSideData%PMomXAll)) THEN - DEALLOCATE(RtHndSideData%PMomXAll) -ENDIF -IF (ALLOCATED(RtHndSideData%rSAerCen)) THEN - DEALLOCATE(RtHndSideData%rSAerCen) -ENDIF - END SUBROUTINE ED_DestroyRtHndSide - - SUBROUTINE ED_PackRtHndSide( 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(ED_RtHndSide), 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 = 'ED_PackRtHndSide' - ! 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 + SIZE(InData%rO) ! rO - Int_BufSz = Int_BufSz + 1 ! rQS allocated yes/no - IF ( ALLOCATED(InData%rQS) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! rQS upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%rQS) ! rQS - END IF - Int_BufSz = Int_BufSz + 1 ! rS allocated yes/no - IF ( ALLOCATED(InData%rS) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! rS upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%rS) ! rS - END IF - Int_BufSz = Int_BufSz + 1 ! rS0S allocated yes/no - IF ( ALLOCATED(InData%rS0S) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! rS0S upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%rS0S) ! rS0S - END IF - Int_BufSz = Int_BufSz + 1 ! rT allocated yes/no - IF ( ALLOCATED(InData%rT) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! rT upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%rT) ! rT - END IF - Db_BufSz = Db_BufSz + SIZE(InData%rT0O) ! rT0O - Int_BufSz = Int_BufSz + 1 ! rT0T allocated yes/no - IF ( ALLOCATED(InData%rT0T) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! rT0T upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%rT0T) ! rT0T - END IF - Db_BufSz = Db_BufSz + SIZE(InData%rZ) ! rZ - Db_BufSz = Db_BufSz + SIZE(InData%rZO) ! rZO - Int_BufSz = Int_BufSz + 1 ! rZT allocated yes/no - IF ( ALLOCATED(InData%rZT) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! rZT upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%rZT) ! rZT - END IF - Db_BufSz = Db_BufSz + SIZE(InData%rPQ) ! rPQ - Db_BufSz = Db_BufSz + SIZE(InData%rP) ! rP - Db_BufSz = Db_BufSz + SIZE(InData%rV) ! rV - Db_BufSz = Db_BufSz + SIZE(InData%rJ) ! rJ - Db_BufSz = Db_BufSz + SIZE(InData%rZY) ! rZY - Db_BufSz = Db_BufSz + SIZE(InData%rOU) ! rOU - Db_BufSz = Db_BufSz + SIZE(InData%rOV) ! rOV - Db_BufSz = Db_BufSz + SIZE(InData%rVD) ! rVD - Db_BufSz = Db_BufSz + SIZE(InData%rOW) ! rOW - Db_BufSz = Db_BufSz + SIZE(InData%rPC) ! rPC - Int_BufSz = Int_BufSz + 1 ! rPS0 allocated yes/no - IF ( ALLOCATED(InData%rPS0) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! rPS0 upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%rPS0) ! rPS0 - END IF - Db_BufSz = Db_BufSz + SIZE(InData%rQ) ! rQ - Db_BufSz = Db_BufSz + SIZE(InData%rQC) ! rQC - Db_BufSz = Db_BufSz + SIZE(InData%rVIMU) ! rVIMU - Db_BufSz = Db_BufSz + SIZE(InData%rVP) ! rVP - Db_BufSz = Db_BufSz + SIZE(InData%rWI) ! rWI - Db_BufSz = Db_BufSz + SIZE(InData%rWJ) ! rWJ - Db_BufSz = Db_BufSz + SIZE(InData%rZT0) ! rZT0 - Int_BufSz = Int_BufSz + 1 ! AngPosEF allocated yes/no - IF ( ALLOCATED(InData%AngPosEF) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! AngPosEF upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AngPosEF) ! AngPosEF - END IF - Int_BufSz = Int_BufSz + 1 ! AngPosXF allocated yes/no - IF ( ALLOCATED(InData%AngPosXF) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! AngPosXF upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AngPosXF) ! AngPosXF - END IF - Int_BufSz = Int_BufSz + 1 ! AngPosHM allocated yes/no - IF ( ALLOCATED(InData%AngPosHM) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! AngPosHM upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AngPosHM) ! AngPosHM - END IF - Re_BufSz = Re_BufSz + SIZE(InData%AngPosXB) ! AngPosXB - Re_BufSz = Re_BufSz + SIZE(InData%AngPosEX) ! AngPosEX - Int_BufSz = Int_BufSz + 1 ! PAngVelEA allocated yes/no - IF ( ALLOCATED(InData%PAngVelEA) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! PAngVelEA upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PAngVelEA) ! PAngVelEA - END IF - Int_BufSz = Int_BufSz + 1 ! PAngVelEF allocated yes/no - IF ( ALLOCATED(InData%PAngVelEF) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! PAngVelEF upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PAngVelEF) ! PAngVelEF - END IF - Int_BufSz = Int_BufSz + 1 ! PAngVelEG allocated yes/no - IF ( ALLOCATED(InData%PAngVelEG) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! PAngVelEG upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PAngVelEG) ! PAngVelEG - END IF - Int_BufSz = Int_BufSz + 1 ! PAngVelEH allocated yes/no - IF ( ALLOCATED(InData%PAngVelEH) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! PAngVelEH upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PAngVelEH) ! PAngVelEH - END IF - Int_BufSz = Int_BufSz + 1 ! PAngVelEL allocated yes/no - IF ( ALLOCATED(InData%PAngVelEL) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! PAngVelEL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PAngVelEL) ! PAngVelEL - END IF - Int_BufSz = Int_BufSz + 1 ! PAngVelEM allocated yes/no - IF ( ALLOCATED(InData%PAngVelEM) ) THEN - Int_BufSz = Int_BufSz + 2*5 ! PAngVelEM upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PAngVelEM) ! PAngVelEM - END IF - Int_BufSz = Int_BufSz + 1 ! AngVelEM allocated yes/no - IF ( ALLOCATED(InData%AngVelEM) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! AngVelEM upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AngVelEM) ! AngVelEM - END IF - Int_BufSz = Int_BufSz + 1 ! PAngVelEN allocated yes/no - IF ( ALLOCATED(InData%PAngVelEN) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! PAngVelEN upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PAngVelEN) ! PAngVelEN - END IF - Re_BufSz = Re_BufSz + SIZE(InData%AngVelEA) ! AngVelEA - Int_BufSz = Int_BufSz + 1 ! PAngVelEB allocated yes/no - IF ( ALLOCATED(InData%PAngVelEB) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! PAngVelEB upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PAngVelEB) ! PAngVelEB - END IF - Int_BufSz = Int_BufSz + 1 ! PAngVelER allocated yes/no - IF ( ALLOCATED(InData%PAngVelER) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! PAngVelER upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PAngVelER) ! PAngVelER - END IF - Int_BufSz = Int_BufSz + 1 ! PAngVelEX allocated yes/no - IF ( ALLOCATED(InData%PAngVelEX) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! PAngVelEX upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PAngVelEX) ! PAngVelEX - END IF - Re_BufSz = Re_BufSz + SIZE(InData%AngVelEG) ! AngVelEG - Re_BufSz = Re_BufSz + SIZE(InData%AngVelEH) ! AngVelEH - Re_BufSz = Re_BufSz + SIZE(InData%AngVelEL) ! AngVelEL - Re_BufSz = Re_BufSz + SIZE(InData%AngVelEN) ! AngVelEN - Re_BufSz = Re_BufSz + SIZE(InData%AngVelEB) ! AngVelEB - Re_BufSz = Re_BufSz + SIZE(InData%AngVelER) ! AngVelER - Re_BufSz = Re_BufSz + SIZE(InData%AngVelEX) ! AngVelEX - Db_BufSz = Db_BufSz + 1 ! TeetAngVel - Re_BufSz = Re_BufSz + SIZE(InData%AngAccEBt) ! AngAccEBt - Re_BufSz = Re_BufSz + SIZE(InData%AngAccERt) ! AngAccERt - Re_BufSz = Re_BufSz + SIZE(InData%AngAccEXt) ! AngAccEXt - Int_BufSz = Int_BufSz + 1 ! AngAccEFt allocated yes/no - IF ( ALLOCATED(InData%AngAccEFt) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! AngAccEFt upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AngAccEFt) ! AngAccEFt - END IF - Int_BufSz = Int_BufSz + 1 ! AngVelEF allocated yes/no - IF ( ALLOCATED(InData%AngVelEF) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! AngVelEF upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AngVelEF) ! AngVelEF - END IF - Int_BufSz = Int_BufSz + 1 ! AngVelHM allocated yes/no - IF ( ALLOCATED(InData%AngVelHM) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! AngVelHM upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AngVelHM) ! AngVelHM - END IF - Re_BufSz = Re_BufSz + SIZE(InData%AngAccEAt) ! AngAccEAt - Re_BufSz = Re_BufSz + SIZE(InData%AngAccEGt) ! AngAccEGt - Re_BufSz = Re_BufSz + SIZE(InData%AngAccEHt) ! AngAccEHt - Int_BufSz = Int_BufSz + 1 ! AngAccEKt allocated yes/no - IF ( ALLOCATED(InData%AngAccEKt) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! AngAccEKt upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AngAccEKt) ! AngAccEKt - END IF - Re_BufSz = Re_BufSz + SIZE(InData%AngAccENt) ! AngAccENt - Re_BufSz = Re_BufSz + SIZE(InData%LinAccECt) ! LinAccECt - Re_BufSz = Re_BufSz + SIZE(InData%LinAccEDt) ! LinAccEDt - Re_BufSz = Re_BufSz + SIZE(InData%LinAccEIt) ! LinAccEIt - Re_BufSz = Re_BufSz + SIZE(InData%LinAccEJt) ! LinAccEJt - Re_BufSz = Re_BufSz + SIZE(InData%LinAccEUt) ! LinAccEUt - Re_BufSz = Re_BufSz + SIZE(InData%LinAccEYt) ! LinAccEYt - Int_BufSz = Int_BufSz + 1 ! LinVelES allocated yes/no - IF ( ALLOCATED(InData%LinVelES) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! LinVelES upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%LinVelES) ! LinVelES - END IF - Re_BufSz = Re_BufSz + SIZE(InData%LinVelEQ) ! LinVelEQ - Int_BufSz = Int_BufSz + 1 ! LinVelET allocated yes/no - IF ( ALLOCATED(InData%LinVelET) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! LinVelET upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%LinVelET) ! LinVelET - END IF - Int_BufSz = Int_BufSz + 1 ! LinVelESm2 allocated yes/no - IF ( ALLOCATED(InData%LinVelESm2) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LinVelESm2 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%LinVelESm2) ! LinVelESm2 - END IF - Int_BufSz = Int_BufSz + 1 ! PLinVelEIMU allocated yes/no - IF ( ALLOCATED(InData%PLinVelEIMU) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! PLinVelEIMU upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PLinVelEIMU) ! PLinVelEIMU - END IF - Int_BufSz = Int_BufSz + 1 ! PLinVelEO allocated yes/no - IF ( ALLOCATED(InData%PLinVelEO) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! PLinVelEO upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PLinVelEO) ! PLinVelEO - END IF - Int_BufSz = Int_BufSz + 1 ! PLinVelES allocated yes/no - IF ( ALLOCATED(InData%PLinVelES) ) THEN - Int_BufSz = Int_BufSz + 2*5 ! PLinVelES upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PLinVelES) ! PLinVelES - END IF - Int_BufSz = Int_BufSz + 1 ! PLinVelET allocated yes/no - IF ( ALLOCATED(InData%PLinVelET) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! PLinVelET upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PLinVelET) ! PLinVelET - END IF - Int_BufSz = Int_BufSz + 1 ! PLinVelEZ allocated yes/no - IF ( ALLOCATED(InData%PLinVelEZ) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! PLinVelEZ upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PLinVelEZ) ! PLinVelEZ - END IF - Int_BufSz = Int_BufSz + 1 ! PLinVelEC allocated yes/no - IF ( ALLOCATED(InData%PLinVelEC) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! PLinVelEC upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PLinVelEC) ! PLinVelEC - END IF - Int_BufSz = Int_BufSz + 1 ! PLinVelED allocated yes/no - IF ( ALLOCATED(InData%PLinVelED) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! PLinVelED upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PLinVelED) ! PLinVelED - END IF - Int_BufSz = Int_BufSz + 1 ! PLinVelEI allocated yes/no - IF ( ALLOCATED(InData%PLinVelEI) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! PLinVelEI upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PLinVelEI) ! PLinVelEI - END IF - Int_BufSz = Int_BufSz + 1 ! PLinVelEJ allocated yes/no - IF ( ALLOCATED(InData%PLinVelEJ) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! PLinVelEJ upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PLinVelEJ) ! PLinVelEJ - END IF - Int_BufSz = Int_BufSz + 1 ! PLinVelEP allocated yes/no - IF ( ALLOCATED(InData%PLinVelEP) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! PLinVelEP upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PLinVelEP) ! PLinVelEP - END IF - Int_BufSz = Int_BufSz + 1 ! PLinVelEQ allocated yes/no - IF ( ALLOCATED(InData%PLinVelEQ) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! PLinVelEQ upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PLinVelEQ) ! PLinVelEQ - END IF - Int_BufSz = Int_BufSz + 1 ! PLinVelEU allocated yes/no - IF ( ALLOCATED(InData%PLinVelEU) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! PLinVelEU upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PLinVelEU) ! PLinVelEU - END IF - Int_BufSz = Int_BufSz + 1 ! PLinVelEV allocated yes/no - IF ( ALLOCATED(InData%PLinVelEV) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! PLinVelEV upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PLinVelEV) ! PLinVelEV - END IF - Int_BufSz = Int_BufSz + 1 ! PLinVelEW allocated yes/no - IF ( ALLOCATED(InData%PLinVelEW) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! PLinVelEW upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PLinVelEW) ! PLinVelEW - END IF - Int_BufSz = Int_BufSz + 1 ! PLinVelEY allocated yes/no - IF ( ALLOCATED(InData%PLinVelEY) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! PLinVelEY upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PLinVelEY) ! PLinVelEY - END IF - Re_BufSz = Re_BufSz + SIZE(InData%LinAccEIMUt) ! LinAccEIMUt - Re_BufSz = Re_BufSz + SIZE(InData%LinAccEOt) ! LinAccEOt - Int_BufSz = Int_BufSz + 1 ! LinAccESt allocated yes/no - IF ( ALLOCATED(InData%LinAccESt) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! LinAccESt upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%LinAccESt) ! LinAccESt - END IF - Int_BufSz = Int_BufSz + 1 ! LinAccETt allocated yes/no - IF ( ALLOCATED(InData%LinAccETt) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! LinAccETt upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%LinAccETt) ! LinAccETt - END IF - Re_BufSz = Re_BufSz + SIZE(InData%LinAccEZt) ! LinAccEZt - Re_BufSz = Re_BufSz + SIZE(InData%LinVelEIMU) ! LinVelEIMU - Re_BufSz = Re_BufSz + SIZE(InData%LinVelEZ) ! LinVelEZ - Re_BufSz = Re_BufSz + SIZE(InData%LinVelEO) ! LinVelEO - Re_BufSz = Re_BufSz + SIZE(InData%LinVelEJ) ! LinVelEJ - Re_BufSz = Re_BufSz + SIZE(InData%FrcONcRtt) ! FrcONcRtt - Re_BufSz = Re_BufSz + SIZE(InData%FrcPRott) ! FrcPRott - Int_BufSz = Int_BufSz + 1 ! FrcS0Bt allocated yes/no - IF ( ALLOCATED(InData%FrcS0Bt) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! FrcS0Bt upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%FrcS0Bt) ! FrcS0Bt - END IF - Re_BufSz = Re_BufSz + SIZE(InData%FrcT0Trbt) ! FrcT0Trbt - Int_BufSz = Int_BufSz + 1 ! FSAero allocated yes/no - IF ( ALLOCATED(InData%FSAero) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! FSAero upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%FSAero) ! FSAero - END IF - Int_BufSz = Int_BufSz + 1 ! FSTipDrag allocated yes/no - IF ( ALLOCATED(InData%FSTipDrag) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! FSTipDrag upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%FSTipDrag) ! FSTipDrag - END IF - Int_BufSz = Int_BufSz + 1 ! FTHydrot allocated yes/no - IF ( ALLOCATED(InData%FTHydrot) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! FTHydrot upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%FTHydrot) ! FTHydrot - END IF - Re_BufSz = Re_BufSz + SIZE(InData%FZHydrot) ! FZHydrot - Int_BufSz = Int_BufSz + 1 ! MFHydrot allocated yes/no - IF ( ALLOCATED(InData%MFHydrot) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! MFHydrot upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%MFHydrot) ! MFHydrot - END IF - Re_BufSz = Re_BufSz + SIZE(InData%MomBNcRtt) ! MomBNcRtt - Int_BufSz = Int_BufSz + 1 ! MomH0Bt allocated yes/no - IF ( ALLOCATED(InData%MomH0Bt) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! MomH0Bt upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%MomH0Bt) ! MomH0Bt - END IF - Re_BufSz = Re_BufSz + SIZE(InData%MomLPRott) ! MomLPRott - Re_BufSz = Re_BufSz + SIZE(InData%MomNGnRtt) ! MomNGnRtt - Re_BufSz = Re_BufSz + SIZE(InData%MomNTailt) ! MomNTailt - Re_BufSz = Re_BufSz + SIZE(InData%MomX0Trbt) ! MomX0Trbt - Int_BufSz = Int_BufSz + 1 ! MMAero allocated yes/no - IF ( ALLOCATED(InData%MMAero) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! MMAero upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%MMAero) ! MMAero - END IF - Re_BufSz = Re_BufSz + SIZE(InData%MXHydrot) ! MXHydrot - Int_BufSz = Int_BufSz + 1 ! PFrcONcRt allocated yes/no - IF ( ALLOCATED(InData%PFrcONcRt) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PFrcONcRt upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PFrcONcRt) ! PFrcONcRt - END IF - Int_BufSz = Int_BufSz + 1 ! PFrcPRot allocated yes/no - IF ( ALLOCATED(InData%PFrcPRot) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PFrcPRot upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PFrcPRot) ! PFrcPRot - END IF - Int_BufSz = Int_BufSz + 1 ! PFrcS0B allocated yes/no - IF ( ALLOCATED(InData%PFrcS0B) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! PFrcS0B upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PFrcS0B) ! PFrcS0B - END IF - Int_BufSz = Int_BufSz + 1 ! PFrcT0Trb allocated yes/no - IF ( ALLOCATED(InData%PFrcT0Trb) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PFrcT0Trb upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PFrcT0Trb) ! PFrcT0Trb - END IF - Int_BufSz = Int_BufSz + 1 ! PFTHydro allocated yes/no - IF ( ALLOCATED(InData%PFTHydro) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! PFTHydro upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PFTHydro) ! PFTHydro - END IF - Re_BufSz = Re_BufSz + SIZE(InData%PFZHydro) ! PFZHydro - Int_BufSz = Int_BufSz + 1 ! PMFHydro allocated yes/no - IF ( ALLOCATED(InData%PMFHydro) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! PMFHydro upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PMFHydro) ! PMFHydro - END IF - Int_BufSz = Int_BufSz + 1 ! PMomBNcRt allocated yes/no - IF ( ALLOCATED(InData%PMomBNcRt) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PMomBNcRt upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PMomBNcRt) ! PMomBNcRt - END IF - Int_BufSz = Int_BufSz + 1 ! PMomH0B allocated yes/no - IF ( ALLOCATED(InData%PMomH0B) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! PMomH0B upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PMomH0B) ! PMomH0B - END IF - Int_BufSz = Int_BufSz + 1 ! PMomLPRot allocated yes/no - IF ( ALLOCATED(InData%PMomLPRot) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PMomLPRot upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PMomLPRot) ! PMomLPRot - END IF - Int_BufSz = Int_BufSz + 1 ! PMomNGnRt allocated yes/no - IF ( ALLOCATED(InData%PMomNGnRt) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PMomNGnRt upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PMomNGnRt) ! PMomNGnRt - END IF - Int_BufSz = Int_BufSz + 1 ! PMomNTail allocated yes/no - IF ( ALLOCATED(InData%PMomNTail) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PMomNTail upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PMomNTail) ! PMomNTail - END IF - Int_BufSz = Int_BufSz + 1 ! PMomX0Trb allocated yes/no - IF ( ALLOCATED(InData%PMomX0Trb) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PMomX0Trb upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PMomX0Trb) ! PMomX0Trb - END IF - Re_BufSz = Re_BufSz + SIZE(InData%PMXHydro) ! PMXHydro - Db_BufSz = Db_BufSz + 1 ! TeetAng - Re_BufSz = Re_BufSz + SIZE(InData%FrcVGnRtt) ! FrcVGnRtt - Re_BufSz = Re_BufSz + SIZE(InData%FrcWTailt) ! FrcWTailt - Re_BufSz = Re_BufSz + SIZE(InData%FrcZAllt) ! FrcZAllt - Re_BufSz = Re_BufSz + SIZE(InData%MomXAllt) ! MomXAllt - Int_BufSz = Int_BufSz + 1 ! PFrcVGnRt allocated yes/no - IF ( ALLOCATED(InData%PFrcVGnRt) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PFrcVGnRt upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PFrcVGnRt) ! PFrcVGnRt - END IF - Int_BufSz = Int_BufSz + 1 ! PFrcWTail allocated yes/no - IF ( ALLOCATED(InData%PFrcWTail) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PFrcWTail upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PFrcWTail) ! PFrcWTail - END IF - Int_BufSz = Int_BufSz + 1 ! PFrcZAll allocated yes/no - IF ( ALLOCATED(InData%PFrcZAll) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PFrcZAll upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PFrcZAll) ! PFrcZAll - END IF - Int_BufSz = Int_BufSz + 1 ! PMomXAll allocated yes/no - IF ( ALLOCATED(InData%PMomXAll) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PMomXAll upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PMomXAll) ! PMomXAll - END IF - Re_BufSz = Re_BufSz + 1 ! TeetMom - Re_BufSz = Re_BufSz + 1 ! TFrlMom - Re_BufSz = Re_BufSz + 1 ! RFrlMom - Re_BufSz = Re_BufSz + 1 ! GBoxEffFac - Int_BufSz = Int_BufSz + 1 ! rSAerCen allocated yes/no - IF ( ALLOCATED(InData%rSAerCen) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! rSAerCen upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%rSAerCen) ! rSAerCen - 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 i1 = LBOUND(InData%rO,1), UBOUND(InData%rO,1) - DbKiBuf(Db_Xferred) = InData%rO(i1) - Db_Xferred = Db_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%rQS) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rQS,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rQS,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rQS,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rQS,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rQS,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rQS,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%rQS,3), UBOUND(InData%rQS,3) - DO i2 = LBOUND(InData%rQS,2), UBOUND(InData%rQS,2) - DO i1 = LBOUND(InData%rQS,1), UBOUND(InData%rQS,1) - DbKiBuf(Db_Xferred) = InData%rQS(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%rS) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rS,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rS,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rS,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rS,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rS,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rS,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%rS,3), UBOUND(InData%rS,3) - DO i2 = LBOUND(InData%rS,2), UBOUND(InData%rS,2) - DO i1 = LBOUND(InData%rS,1), UBOUND(InData%rS,1) - DbKiBuf(Db_Xferred) = InData%rS(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%rS0S) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rS0S,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rS0S,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rS0S,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rS0S,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rS0S,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rS0S,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%rS0S,3), UBOUND(InData%rS0S,3) - DO i2 = LBOUND(InData%rS0S,2), UBOUND(InData%rS0S,2) - DO i1 = LBOUND(InData%rS0S,1), UBOUND(InData%rS0S,1) - DbKiBuf(Db_Xferred) = InData%rS0S(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%rT) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rT,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rT,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rT,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rT,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%rT,2), UBOUND(InData%rT,2) - DO i1 = LBOUND(InData%rT,1), UBOUND(InData%rT,1) - DbKiBuf(Db_Xferred) = InData%rT(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - DO i1 = LBOUND(InData%rT0O,1), UBOUND(InData%rT0O,1) - DbKiBuf(Db_Xferred) = InData%rT0O(i1) - Db_Xferred = Db_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%rT0T) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rT0T,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rT0T,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rT0T,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rT0T,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%rT0T,2), UBOUND(InData%rT0T,2) - DO i1 = LBOUND(InData%rT0T,1), UBOUND(InData%rT0T,1) - DbKiBuf(Db_Xferred) = InData%rT0T(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - DO i1 = LBOUND(InData%rZ,1), UBOUND(InData%rZ,1) - DbKiBuf(Db_Xferred) = InData%rZ(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%rZO,1), UBOUND(InData%rZO,1) - DbKiBuf(Db_Xferred) = InData%rZO(i1) - Db_Xferred = Db_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%rZT) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rZT,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rZT,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rZT,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rZT,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%rZT,2), UBOUND(InData%rZT,2) - DO i1 = LBOUND(InData%rZT,1), UBOUND(InData%rZT,1) - DbKiBuf(Db_Xferred) = InData%rZT(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - DO i1 = LBOUND(InData%rPQ,1), UBOUND(InData%rPQ,1) - DbKiBuf(Db_Xferred) = InData%rPQ(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%rP,1), UBOUND(InData%rP,1) - DbKiBuf(Db_Xferred) = InData%rP(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%rV,1), UBOUND(InData%rV,1) - DbKiBuf(Db_Xferred) = InData%rV(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%rJ,1), UBOUND(InData%rJ,1) - DbKiBuf(Db_Xferred) = InData%rJ(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%rZY,1), UBOUND(InData%rZY,1) - DbKiBuf(Db_Xferred) = InData%rZY(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%rOU,1), UBOUND(InData%rOU,1) - DbKiBuf(Db_Xferred) = InData%rOU(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%rOV,1), UBOUND(InData%rOV,1) - DbKiBuf(Db_Xferred) = InData%rOV(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%rVD,1), UBOUND(InData%rVD,1) - DbKiBuf(Db_Xferred) = InData%rVD(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%rOW,1), UBOUND(InData%rOW,1) - DbKiBuf(Db_Xferred) = InData%rOW(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%rPC,1), UBOUND(InData%rPC,1) - DbKiBuf(Db_Xferred) = InData%rPC(i1) - Db_Xferred = Db_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%rPS0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rPS0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rPS0,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rPS0,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rPS0,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%rPS0,2), UBOUND(InData%rPS0,2) - DO i1 = LBOUND(InData%rPS0,1), UBOUND(InData%rPS0,1) - DbKiBuf(Db_Xferred) = InData%rPS0(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - DO i1 = LBOUND(InData%rQ,1), UBOUND(InData%rQ,1) - DbKiBuf(Db_Xferred) = InData%rQ(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%rQC,1), UBOUND(InData%rQC,1) - DbKiBuf(Db_Xferred) = InData%rQC(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%rVIMU,1), UBOUND(InData%rVIMU,1) - DbKiBuf(Db_Xferred) = InData%rVIMU(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%rVP,1), UBOUND(InData%rVP,1) - DbKiBuf(Db_Xferred) = InData%rVP(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%rWI,1), UBOUND(InData%rWI,1) - DbKiBuf(Db_Xferred) = InData%rWI(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%rWJ,1), UBOUND(InData%rWJ,1) - DbKiBuf(Db_Xferred) = InData%rWJ(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%rZT0,1), UBOUND(InData%rZT0,1) - DbKiBuf(Db_Xferred) = InData%rZT0(i1) - Db_Xferred = Db_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%AngPosEF) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AngPosEF,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AngPosEF,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AngPosEF,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AngPosEF,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%AngPosEF,2), UBOUND(InData%AngPosEF,2) - DO i1 = LBOUND(InData%AngPosEF,1), UBOUND(InData%AngPosEF,1) - ReKiBuf(Re_Xferred) = InData%AngPosEF(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AngPosXF) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AngPosXF,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AngPosXF,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AngPosXF,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AngPosXF,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%AngPosXF,2), UBOUND(InData%AngPosXF,2) - DO i1 = LBOUND(InData%AngPosXF,1), UBOUND(InData%AngPosXF,1) - ReKiBuf(Re_Xferred) = InData%AngPosXF(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AngPosHM) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AngPosHM,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AngPosHM,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AngPosHM,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AngPosHM,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AngPosHM,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AngPosHM,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%AngPosHM,3), UBOUND(InData%AngPosHM,3) - DO i2 = LBOUND(InData%AngPosHM,2), UBOUND(InData%AngPosHM,2) - DO i1 = LBOUND(InData%AngPosHM,1), UBOUND(InData%AngPosHM,1) - ReKiBuf(Re_Xferred) = InData%AngPosHM(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - DO i1 = LBOUND(InData%AngPosXB,1), UBOUND(InData%AngPosXB,1) - ReKiBuf(Re_Xferred) = InData%AngPosXB(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%AngPosEX,1), UBOUND(InData%AngPosEX,1) - ReKiBuf(Re_Xferred) = InData%AngPosEX(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%PAngVelEA) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PAngVelEA,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelEA,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PAngVelEA,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelEA,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PAngVelEA,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelEA,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%PAngVelEA,3), UBOUND(InData%PAngVelEA,3) - DO i2 = LBOUND(InData%PAngVelEA,2), UBOUND(InData%PAngVelEA,2) - DO i1 = LBOUND(InData%PAngVelEA,1), UBOUND(InData%PAngVelEA,1) - ReKiBuf(Re_Xferred) = InData%PAngVelEA(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PAngVelEF) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PAngVelEF,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelEF,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PAngVelEF,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelEF,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PAngVelEF,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelEF,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PAngVelEF,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelEF,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%PAngVelEF,4), UBOUND(InData%PAngVelEF,4) - DO i3 = LBOUND(InData%PAngVelEF,3), UBOUND(InData%PAngVelEF,3) - DO i2 = LBOUND(InData%PAngVelEF,2), UBOUND(InData%PAngVelEF,2) - DO i1 = LBOUND(InData%PAngVelEF,1), UBOUND(InData%PAngVelEF,1) - ReKiBuf(Re_Xferred) = InData%PAngVelEF(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PAngVelEG) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PAngVelEG,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelEG,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PAngVelEG,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelEG,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PAngVelEG,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelEG,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%PAngVelEG,3), UBOUND(InData%PAngVelEG,3) - DO i2 = LBOUND(InData%PAngVelEG,2), UBOUND(InData%PAngVelEG,2) - DO i1 = LBOUND(InData%PAngVelEG,1), UBOUND(InData%PAngVelEG,1) - ReKiBuf(Re_Xferred) = InData%PAngVelEG(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PAngVelEH) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PAngVelEH,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelEH,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PAngVelEH,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelEH,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PAngVelEH,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelEH,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%PAngVelEH,3), UBOUND(InData%PAngVelEH,3) - DO i2 = LBOUND(InData%PAngVelEH,2), UBOUND(InData%PAngVelEH,2) - DO i1 = LBOUND(InData%PAngVelEH,1), UBOUND(InData%PAngVelEH,1) - ReKiBuf(Re_Xferred) = InData%PAngVelEH(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PAngVelEL) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PAngVelEL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelEL,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PAngVelEL,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelEL,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PAngVelEL,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelEL,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%PAngVelEL,3), UBOUND(InData%PAngVelEL,3) - DO i2 = LBOUND(InData%PAngVelEL,2), UBOUND(InData%PAngVelEL,2) - DO i1 = LBOUND(InData%PAngVelEL,1), UBOUND(InData%PAngVelEL,1) - ReKiBuf(Re_Xferred) = InData%PAngVelEL(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PAngVelEM) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PAngVelEM,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelEM,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PAngVelEM,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelEM,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PAngVelEM,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelEM,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PAngVelEM,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelEM,4) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PAngVelEM,5) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelEM,5) - Int_Xferred = Int_Xferred + 2 - - DO i5 = LBOUND(InData%PAngVelEM,5), UBOUND(InData%PAngVelEM,5) - DO i4 = LBOUND(InData%PAngVelEM,4), UBOUND(InData%PAngVelEM,4) - DO i3 = LBOUND(InData%PAngVelEM,3), UBOUND(InData%PAngVelEM,3) - DO i2 = LBOUND(InData%PAngVelEM,2), UBOUND(InData%PAngVelEM,2) - DO i1 = LBOUND(InData%PAngVelEM,1), UBOUND(InData%PAngVelEM,1) - ReKiBuf(Re_Xferred) = InData%PAngVelEM(i1,i2,i3,i4,i5) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AngVelEM) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AngVelEM,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AngVelEM,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AngVelEM,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AngVelEM,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AngVelEM,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AngVelEM,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%AngVelEM,3), UBOUND(InData%AngVelEM,3) - DO i2 = LBOUND(InData%AngVelEM,2), UBOUND(InData%AngVelEM,2) - DO i1 = LBOUND(InData%AngVelEM,1), UBOUND(InData%AngVelEM,1) - ReKiBuf(Re_Xferred) = InData%AngVelEM(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PAngVelEN) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PAngVelEN,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelEN,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PAngVelEN,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelEN,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PAngVelEN,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelEN,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%PAngVelEN,3), UBOUND(InData%PAngVelEN,3) - DO i2 = LBOUND(InData%PAngVelEN,2), UBOUND(InData%PAngVelEN,2) - DO i1 = LBOUND(InData%PAngVelEN,1), UBOUND(InData%PAngVelEN,1) - ReKiBuf(Re_Xferred) = InData%PAngVelEN(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - DO i1 = LBOUND(InData%AngVelEA,1), UBOUND(InData%AngVelEA,1) - ReKiBuf(Re_Xferred) = InData%AngVelEA(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%PAngVelEB) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PAngVelEB,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelEB,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PAngVelEB,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelEB,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PAngVelEB,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelEB,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%PAngVelEB,3), UBOUND(InData%PAngVelEB,3) - DO i2 = LBOUND(InData%PAngVelEB,2), UBOUND(InData%PAngVelEB,2) - DO i1 = LBOUND(InData%PAngVelEB,1), UBOUND(InData%PAngVelEB,1) - ReKiBuf(Re_Xferred) = InData%PAngVelEB(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PAngVelER) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PAngVelER,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelER,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PAngVelER,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelER,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PAngVelER,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelER,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%PAngVelER,3), UBOUND(InData%PAngVelER,3) - DO i2 = LBOUND(InData%PAngVelER,2), UBOUND(InData%PAngVelER,2) - DO i1 = LBOUND(InData%PAngVelER,1), UBOUND(InData%PAngVelER,1) - ReKiBuf(Re_Xferred) = InData%PAngVelER(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PAngVelEX) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PAngVelEX,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelEX,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PAngVelEX,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelEX,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PAngVelEX,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelEX,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%PAngVelEX,3), UBOUND(InData%PAngVelEX,3) - DO i2 = LBOUND(InData%PAngVelEX,2), UBOUND(InData%PAngVelEX,2) - DO i1 = LBOUND(InData%PAngVelEX,1), UBOUND(InData%PAngVelEX,1) - ReKiBuf(Re_Xferred) = InData%PAngVelEX(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - DO i1 = LBOUND(InData%AngVelEG,1), UBOUND(InData%AngVelEG,1) - ReKiBuf(Re_Xferred) = InData%AngVelEG(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%AngVelEH,1), UBOUND(InData%AngVelEH,1) - ReKiBuf(Re_Xferred) = InData%AngVelEH(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%AngVelEL,1), UBOUND(InData%AngVelEL,1) - ReKiBuf(Re_Xferred) = InData%AngVelEL(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%AngVelEN,1), UBOUND(InData%AngVelEN,1) - ReKiBuf(Re_Xferred) = InData%AngVelEN(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%AngVelEB,1), UBOUND(InData%AngVelEB,1) - ReKiBuf(Re_Xferred) = InData%AngVelEB(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%AngVelER,1), UBOUND(InData%AngVelER,1) - ReKiBuf(Re_Xferred) = InData%AngVelER(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%AngVelEX,1), UBOUND(InData%AngVelEX,1) - ReKiBuf(Re_Xferred) = InData%AngVelEX(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DbKiBuf(Db_Xferred) = InData%TeetAngVel - Db_Xferred = Db_Xferred + 1 - DO i1 = LBOUND(InData%AngAccEBt,1), UBOUND(InData%AngAccEBt,1) - ReKiBuf(Re_Xferred) = InData%AngAccEBt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%AngAccERt,1), UBOUND(InData%AngAccERt,1) - ReKiBuf(Re_Xferred) = InData%AngAccERt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%AngAccEXt,1), UBOUND(InData%AngAccEXt,1) - ReKiBuf(Re_Xferred) = InData%AngAccEXt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%AngAccEFt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AngAccEFt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AngAccEFt,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AngAccEFt,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AngAccEFt,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%AngAccEFt,2), UBOUND(InData%AngAccEFt,2) - DO i1 = LBOUND(InData%AngAccEFt,1), UBOUND(InData%AngAccEFt,1) - ReKiBuf(Re_Xferred) = InData%AngAccEFt(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AngVelEF) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AngVelEF,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AngVelEF,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AngVelEF,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AngVelEF,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%AngVelEF,2), UBOUND(InData%AngVelEF,2) - DO i1 = LBOUND(InData%AngVelEF,1), UBOUND(InData%AngVelEF,1) - ReKiBuf(Re_Xferred) = InData%AngVelEF(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AngVelHM) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AngVelHM,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AngVelHM,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AngVelHM,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AngVelHM,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AngVelHM,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AngVelHM,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%AngVelHM,3), UBOUND(InData%AngVelHM,3) - DO i2 = LBOUND(InData%AngVelHM,2), UBOUND(InData%AngVelHM,2) - DO i1 = LBOUND(InData%AngVelHM,1), UBOUND(InData%AngVelHM,1) - ReKiBuf(Re_Xferred) = InData%AngVelHM(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - DO i1 = LBOUND(InData%AngAccEAt,1), UBOUND(InData%AngAccEAt,1) - ReKiBuf(Re_Xferred) = InData%AngAccEAt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%AngAccEGt,1), UBOUND(InData%AngAccEGt,1) - ReKiBuf(Re_Xferred) = InData%AngAccEGt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%AngAccEHt,1), UBOUND(InData%AngAccEHt,1) - ReKiBuf(Re_Xferred) = InData%AngAccEHt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%AngAccEKt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AngAccEKt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AngAccEKt,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AngAccEKt,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AngAccEKt,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AngAccEKt,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AngAccEKt,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%AngAccEKt,3), UBOUND(InData%AngAccEKt,3) - DO i2 = LBOUND(InData%AngAccEKt,2), UBOUND(InData%AngAccEKt,2) - DO i1 = LBOUND(InData%AngAccEKt,1), UBOUND(InData%AngAccEKt,1) - ReKiBuf(Re_Xferred) = InData%AngAccEKt(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - DO i1 = LBOUND(InData%AngAccENt,1), UBOUND(InData%AngAccENt,1) - ReKiBuf(Re_Xferred) = InData%AngAccENt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%LinAccECt,1), UBOUND(InData%LinAccECt,1) - ReKiBuf(Re_Xferred) = InData%LinAccECt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%LinAccEDt,1), UBOUND(InData%LinAccEDt,1) - ReKiBuf(Re_Xferred) = InData%LinAccEDt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%LinAccEIt,1), UBOUND(InData%LinAccEIt,1) - ReKiBuf(Re_Xferred) = InData%LinAccEIt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%LinAccEJt,1), UBOUND(InData%LinAccEJt,1) - ReKiBuf(Re_Xferred) = InData%LinAccEJt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%LinAccEUt,1), UBOUND(InData%LinAccEUt,1) - ReKiBuf(Re_Xferred) = InData%LinAccEUt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%LinAccEYt,1), UBOUND(InData%LinAccEYt,1) - ReKiBuf(Re_Xferred) = InData%LinAccEYt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%LinVelES) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LinVelES,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinVelES,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LinVelES,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinVelES,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LinVelES,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinVelES,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%LinVelES,3), UBOUND(InData%LinVelES,3) - DO i2 = LBOUND(InData%LinVelES,2), UBOUND(InData%LinVelES,2) - DO i1 = LBOUND(InData%LinVelES,1), UBOUND(InData%LinVelES,1) - ReKiBuf(Re_Xferred) = InData%LinVelES(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - DO i1 = LBOUND(InData%LinVelEQ,1), UBOUND(InData%LinVelEQ,1) - ReKiBuf(Re_Xferred) = InData%LinVelEQ(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%LinVelET) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LinVelET,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinVelET,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LinVelET,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinVelET,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%LinVelET,2), UBOUND(InData%LinVelET,2) - DO i1 = LBOUND(InData%LinVelET,1), UBOUND(InData%LinVelET,1) - ReKiBuf(Re_Xferred) = InData%LinVelET(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LinVelESm2) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LinVelESm2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinVelESm2,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LinVelESm2,1), UBOUND(InData%LinVelESm2,1) - ReKiBuf(Re_Xferred) = InData%LinVelESm2(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PLinVelEIMU) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelEIMU,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEIMU,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelEIMU,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEIMU,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelEIMU,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEIMU,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%PLinVelEIMU,3), UBOUND(InData%PLinVelEIMU,3) - DO i2 = LBOUND(InData%PLinVelEIMU,2), UBOUND(InData%PLinVelEIMU,2) - DO i1 = LBOUND(InData%PLinVelEIMU,1), UBOUND(InData%PLinVelEIMU,1) - ReKiBuf(Re_Xferred) = InData%PLinVelEIMU(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PLinVelEO) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelEO,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEO,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelEO,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEO,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelEO,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEO,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%PLinVelEO,3), UBOUND(InData%PLinVelEO,3) - DO i2 = LBOUND(InData%PLinVelEO,2), UBOUND(InData%PLinVelEO,2) - DO i1 = LBOUND(InData%PLinVelEO,1), UBOUND(InData%PLinVelEO,1) - ReKiBuf(Re_Xferred) = InData%PLinVelEO(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PLinVelES) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelES,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelES,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelES,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelES,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelES,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelES,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelES,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelES,4) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelES,5) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelES,5) - Int_Xferred = Int_Xferred + 2 - - DO i5 = LBOUND(InData%PLinVelES,5), UBOUND(InData%PLinVelES,5) - DO i4 = LBOUND(InData%PLinVelES,4), UBOUND(InData%PLinVelES,4) - DO i3 = LBOUND(InData%PLinVelES,3), UBOUND(InData%PLinVelES,3) - DO i2 = LBOUND(InData%PLinVelES,2), UBOUND(InData%PLinVelES,2) - DO i1 = LBOUND(InData%PLinVelES,1), UBOUND(InData%PLinVelES,1) - ReKiBuf(Re_Xferred) = InData%PLinVelES(i1,i2,i3,i4,i5) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PLinVelET) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelET,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelET,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelET,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelET,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelET,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelET,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelET,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelET,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%PLinVelET,4), UBOUND(InData%PLinVelET,4) - DO i3 = LBOUND(InData%PLinVelET,3), UBOUND(InData%PLinVelET,3) - DO i2 = LBOUND(InData%PLinVelET,2), UBOUND(InData%PLinVelET,2) - DO i1 = LBOUND(InData%PLinVelET,1), UBOUND(InData%PLinVelET,1) - ReKiBuf(Re_Xferred) = InData%PLinVelET(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PLinVelEZ) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelEZ,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEZ,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelEZ,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEZ,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelEZ,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEZ,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%PLinVelEZ,3), UBOUND(InData%PLinVelEZ,3) - DO i2 = LBOUND(InData%PLinVelEZ,2), UBOUND(InData%PLinVelEZ,2) - DO i1 = LBOUND(InData%PLinVelEZ,1), UBOUND(InData%PLinVelEZ,1) - ReKiBuf(Re_Xferred) = InData%PLinVelEZ(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PLinVelEC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelEC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEC,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelEC,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEC,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelEC,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEC,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%PLinVelEC,3), UBOUND(InData%PLinVelEC,3) - DO i2 = LBOUND(InData%PLinVelEC,2), UBOUND(InData%PLinVelEC,2) - DO i1 = LBOUND(InData%PLinVelEC,1), UBOUND(InData%PLinVelEC,1) - ReKiBuf(Re_Xferred) = InData%PLinVelEC(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PLinVelED) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelED,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelED,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelED,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelED,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelED,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelED,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%PLinVelED,3), UBOUND(InData%PLinVelED,3) - DO i2 = LBOUND(InData%PLinVelED,2), UBOUND(InData%PLinVelED,2) - DO i1 = LBOUND(InData%PLinVelED,1), UBOUND(InData%PLinVelED,1) - ReKiBuf(Re_Xferred) = InData%PLinVelED(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PLinVelEI) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelEI,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEI,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelEI,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEI,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelEI,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEI,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%PLinVelEI,3), UBOUND(InData%PLinVelEI,3) - DO i2 = LBOUND(InData%PLinVelEI,2), UBOUND(InData%PLinVelEI,2) - DO i1 = LBOUND(InData%PLinVelEI,1), UBOUND(InData%PLinVelEI,1) - ReKiBuf(Re_Xferred) = InData%PLinVelEI(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PLinVelEJ) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelEJ,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEJ,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelEJ,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEJ,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelEJ,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEJ,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%PLinVelEJ,3), UBOUND(InData%PLinVelEJ,3) - DO i2 = LBOUND(InData%PLinVelEJ,2), UBOUND(InData%PLinVelEJ,2) - DO i1 = LBOUND(InData%PLinVelEJ,1), UBOUND(InData%PLinVelEJ,1) - ReKiBuf(Re_Xferred) = InData%PLinVelEJ(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PLinVelEP) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelEP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEP,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelEP,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEP,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelEP,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEP,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%PLinVelEP,3), UBOUND(InData%PLinVelEP,3) - DO i2 = LBOUND(InData%PLinVelEP,2), UBOUND(InData%PLinVelEP,2) - DO i1 = LBOUND(InData%PLinVelEP,1), UBOUND(InData%PLinVelEP,1) - ReKiBuf(Re_Xferred) = InData%PLinVelEP(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PLinVelEQ) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelEQ,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEQ,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelEQ,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEQ,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelEQ,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEQ,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%PLinVelEQ,3), UBOUND(InData%PLinVelEQ,3) - DO i2 = LBOUND(InData%PLinVelEQ,2), UBOUND(InData%PLinVelEQ,2) - DO i1 = LBOUND(InData%PLinVelEQ,1), UBOUND(InData%PLinVelEQ,1) - ReKiBuf(Re_Xferred) = InData%PLinVelEQ(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PLinVelEU) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelEU,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEU,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelEU,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEU,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelEU,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEU,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%PLinVelEU,3), UBOUND(InData%PLinVelEU,3) - DO i2 = LBOUND(InData%PLinVelEU,2), UBOUND(InData%PLinVelEU,2) - DO i1 = LBOUND(InData%PLinVelEU,1), UBOUND(InData%PLinVelEU,1) - ReKiBuf(Re_Xferred) = InData%PLinVelEU(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PLinVelEV) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelEV,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEV,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelEV,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEV,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelEV,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEV,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%PLinVelEV,3), UBOUND(InData%PLinVelEV,3) - DO i2 = LBOUND(InData%PLinVelEV,2), UBOUND(InData%PLinVelEV,2) - DO i1 = LBOUND(InData%PLinVelEV,1), UBOUND(InData%PLinVelEV,1) - ReKiBuf(Re_Xferred) = InData%PLinVelEV(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PLinVelEW) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelEW,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEW,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelEW,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEW,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelEW,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEW,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%PLinVelEW,3), UBOUND(InData%PLinVelEW,3) - DO i2 = LBOUND(InData%PLinVelEW,2), UBOUND(InData%PLinVelEW,2) - DO i1 = LBOUND(InData%PLinVelEW,1), UBOUND(InData%PLinVelEW,1) - ReKiBuf(Re_Xferred) = InData%PLinVelEW(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PLinVelEY) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelEY,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEY,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelEY,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEY,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelEY,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEY,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%PLinVelEY,3), UBOUND(InData%PLinVelEY,3) - DO i2 = LBOUND(InData%PLinVelEY,2), UBOUND(InData%PLinVelEY,2) - DO i1 = LBOUND(InData%PLinVelEY,1), UBOUND(InData%PLinVelEY,1) - ReKiBuf(Re_Xferred) = InData%PLinVelEY(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - DO i1 = LBOUND(InData%LinAccEIMUt,1), UBOUND(InData%LinAccEIMUt,1) - ReKiBuf(Re_Xferred) = InData%LinAccEIMUt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%LinAccEOt,1), UBOUND(InData%LinAccEOt,1) - ReKiBuf(Re_Xferred) = InData%LinAccEOt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%LinAccESt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LinAccESt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinAccESt,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LinAccESt,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinAccESt,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LinAccESt,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinAccESt,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%LinAccESt,3), UBOUND(InData%LinAccESt,3) - DO i2 = LBOUND(InData%LinAccESt,2), UBOUND(InData%LinAccESt,2) - DO i1 = LBOUND(InData%LinAccESt,1), UBOUND(InData%LinAccESt,1) - ReKiBuf(Re_Xferred) = InData%LinAccESt(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LinAccETt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LinAccETt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinAccETt,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LinAccETt,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinAccETt,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%LinAccETt,2), UBOUND(InData%LinAccETt,2) - DO i1 = LBOUND(InData%LinAccETt,1), UBOUND(InData%LinAccETt,1) - ReKiBuf(Re_Xferred) = InData%LinAccETt(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - DO i1 = LBOUND(InData%LinAccEZt,1), UBOUND(InData%LinAccEZt,1) - ReKiBuf(Re_Xferred) = InData%LinAccEZt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%LinVelEIMU,1), UBOUND(InData%LinVelEIMU,1) - ReKiBuf(Re_Xferred) = InData%LinVelEIMU(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%LinVelEZ,1), UBOUND(InData%LinVelEZ,1) - ReKiBuf(Re_Xferred) = InData%LinVelEZ(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%LinVelEO,1), UBOUND(InData%LinVelEO,1) - ReKiBuf(Re_Xferred) = InData%LinVelEO(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%LinVelEJ,1), UBOUND(InData%LinVelEJ,1) - ReKiBuf(Re_Xferred) = InData%LinVelEJ(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%FrcONcRtt,1), UBOUND(InData%FrcONcRtt,1) - ReKiBuf(Re_Xferred) = InData%FrcONcRtt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%FrcPRott,1), UBOUND(InData%FrcPRott,1) - ReKiBuf(Re_Xferred) = InData%FrcPRott(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%FrcS0Bt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FrcS0Bt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FrcS0Bt,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FrcS0Bt,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FrcS0Bt,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%FrcS0Bt,2), UBOUND(InData%FrcS0Bt,2) - DO i1 = LBOUND(InData%FrcS0Bt,1), UBOUND(InData%FrcS0Bt,1) - ReKiBuf(Re_Xferred) = InData%FrcS0Bt(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - DO i1 = LBOUND(InData%FrcT0Trbt,1), UBOUND(InData%FrcT0Trbt,1) - ReKiBuf(Re_Xferred) = InData%FrcT0Trbt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%FSAero) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FSAero,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FSAero,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FSAero,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FSAero,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FSAero,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FSAero,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%FSAero,3), UBOUND(InData%FSAero,3) - DO i2 = LBOUND(InData%FSAero,2), UBOUND(InData%FSAero,2) - DO i1 = LBOUND(InData%FSAero,1), UBOUND(InData%FSAero,1) - ReKiBuf(Re_Xferred) = InData%FSAero(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%FSTipDrag) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FSTipDrag,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FSTipDrag,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FSTipDrag,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FSTipDrag,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%FSTipDrag,2), UBOUND(InData%FSTipDrag,2) - DO i1 = LBOUND(InData%FSTipDrag,1), UBOUND(InData%FSTipDrag,1) - ReKiBuf(Re_Xferred) = InData%FSTipDrag(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%FTHydrot) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FTHydrot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FTHydrot,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FTHydrot,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FTHydrot,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%FTHydrot,2), UBOUND(InData%FTHydrot,2) - DO i1 = LBOUND(InData%FTHydrot,1), UBOUND(InData%FTHydrot,1) - ReKiBuf(Re_Xferred) = InData%FTHydrot(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - DO i1 = LBOUND(InData%FZHydrot,1), UBOUND(InData%FZHydrot,1) - ReKiBuf(Re_Xferred) = InData%FZHydrot(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%MFHydrot) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MFHydrot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MFHydrot,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MFHydrot,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MFHydrot,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%MFHydrot,2), UBOUND(InData%MFHydrot,2) - DO i1 = LBOUND(InData%MFHydrot,1), UBOUND(InData%MFHydrot,1) - ReKiBuf(Re_Xferred) = InData%MFHydrot(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - DO i1 = LBOUND(InData%MomBNcRtt,1), UBOUND(InData%MomBNcRtt,1) - ReKiBuf(Re_Xferred) = InData%MomBNcRtt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%MomH0Bt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MomH0Bt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MomH0Bt,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MomH0Bt,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MomH0Bt,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%MomH0Bt,2), UBOUND(InData%MomH0Bt,2) - DO i1 = LBOUND(InData%MomH0Bt,1), UBOUND(InData%MomH0Bt,1) - ReKiBuf(Re_Xferred) = InData%MomH0Bt(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - DO i1 = LBOUND(InData%MomLPRott,1), UBOUND(InData%MomLPRott,1) - ReKiBuf(Re_Xferred) = InData%MomLPRott(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%MomNGnRtt,1), UBOUND(InData%MomNGnRtt,1) - ReKiBuf(Re_Xferred) = InData%MomNGnRtt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%MomNTailt,1), UBOUND(InData%MomNTailt,1) - ReKiBuf(Re_Xferred) = InData%MomNTailt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%MomX0Trbt,1), UBOUND(InData%MomX0Trbt,1) - ReKiBuf(Re_Xferred) = InData%MomX0Trbt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%MMAero) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MMAero,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MMAero,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MMAero,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MMAero,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MMAero,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MMAero,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%MMAero,3), UBOUND(InData%MMAero,3) - DO i2 = LBOUND(InData%MMAero,2), UBOUND(InData%MMAero,2) - DO i1 = LBOUND(InData%MMAero,1), UBOUND(InData%MMAero,1) - ReKiBuf(Re_Xferred) = InData%MMAero(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - DO i1 = LBOUND(InData%MXHydrot,1), UBOUND(InData%MXHydrot,1) - ReKiBuf(Re_Xferred) = InData%MXHydrot(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%PFrcONcRt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PFrcONcRt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PFrcONcRt,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PFrcONcRt,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PFrcONcRt,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PFrcONcRt,2), UBOUND(InData%PFrcONcRt,2) - DO i1 = LBOUND(InData%PFrcONcRt,1), UBOUND(InData%PFrcONcRt,1) - ReKiBuf(Re_Xferred) = InData%PFrcONcRt(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PFrcPRot) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PFrcPRot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PFrcPRot,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PFrcPRot,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PFrcPRot,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PFrcPRot,2), UBOUND(InData%PFrcPRot,2) - DO i1 = LBOUND(InData%PFrcPRot,1), UBOUND(InData%PFrcPRot,1) - ReKiBuf(Re_Xferred) = InData%PFrcPRot(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PFrcS0B) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PFrcS0B,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PFrcS0B,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PFrcS0B,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PFrcS0B,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PFrcS0B,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PFrcS0B,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%PFrcS0B,3), UBOUND(InData%PFrcS0B,3) - DO i2 = LBOUND(InData%PFrcS0B,2), UBOUND(InData%PFrcS0B,2) - DO i1 = LBOUND(InData%PFrcS0B,1), UBOUND(InData%PFrcS0B,1) - ReKiBuf(Re_Xferred) = InData%PFrcS0B(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PFrcT0Trb) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PFrcT0Trb,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PFrcT0Trb,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PFrcT0Trb,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PFrcT0Trb,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PFrcT0Trb,2), UBOUND(InData%PFrcT0Trb,2) - DO i1 = LBOUND(InData%PFrcT0Trb,1), UBOUND(InData%PFrcT0Trb,1) - ReKiBuf(Re_Xferred) = InData%PFrcT0Trb(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PFTHydro) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PFTHydro,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PFTHydro,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PFTHydro,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PFTHydro,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PFTHydro,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PFTHydro,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%PFTHydro,3), UBOUND(InData%PFTHydro,3) - DO i2 = LBOUND(InData%PFTHydro,2), UBOUND(InData%PFTHydro,2) - DO i1 = LBOUND(InData%PFTHydro,1), UBOUND(InData%PFTHydro,1) - ReKiBuf(Re_Xferred) = InData%PFTHydro(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - DO i2 = LBOUND(InData%PFZHydro,2), UBOUND(InData%PFZHydro,2) - DO i1 = LBOUND(InData%PFZHydro,1), UBOUND(InData%PFZHydro,1) - ReKiBuf(Re_Xferred) = InData%PFZHydro(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - IF ( .NOT. ALLOCATED(InData%PMFHydro) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PMFHydro,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PMFHydro,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PMFHydro,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PMFHydro,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PMFHydro,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PMFHydro,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%PMFHydro,3), UBOUND(InData%PMFHydro,3) - DO i2 = LBOUND(InData%PMFHydro,2), UBOUND(InData%PMFHydro,2) - DO i1 = LBOUND(InData%PMFHydro,1), UBOUND(InData%PMFHydro,1) - ReKiBuf(Re_Xferred) = InData%PMFHydro(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PMomBNcRt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PMomBNcRt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PMomBNcRt,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PMomBNcRt,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PMomBNcRt,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PMomBNcRt,2), UBOUND(InData%PMomBNcRt,2) - DO i1 = LBOUND(InData%PMomBNcRt,1), UBOUND(InData%PMomBNcRt,1) - ReKiBuf(Re_Xferred) = InData%PMomBNcRt(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PMomH0B) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PMomH0B,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PMomH0B,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PMomH0B,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PMomH0B,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PMomH0B,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PMomH0B,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%PMomH0B,3), UBOUND(InData%PMomH0B,3) - DO i2 = LBOUND(InData%PMomH0B,2), UBOUND(InData%PMomH0B,2) - DO i1 = LBOUND(InData%PMomH0B,1), UBOUND(InData%PMomH0B,1) - ReKiBuf(Re_Xferred) = InData%PMomH0B(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PMomLPRot) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PMomLPRot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PMomLPRot,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PMomLPRot,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PMomLPRot,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PMomLPRot,2), UBOUND(InData%PMomLPRot,2) - DO i1 = LBOUND(InData%PMomLPRot,1), UBOUND(InData%PMomLPRot,1) - ReKiBuf(Re_Xferred) = InData%PMomLPRot(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PMomNGnRt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PMomNGnRt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PMomNGnRt,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PMomNGnRt,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PMomNGnRt,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PMomNGnRt,2), UBOUND(InData%PMomNGnRt,2) - DO i1 = LBOUND(InData%PMomNGnRt,1), UBOUND(InData%PMomNGnRt,1) - ReKiBuf(Re_Xferred) = InData%PMomNGnRt(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PMomNTail) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PMomNTail,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PMomNTail,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PMomNTail,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PMomNTail,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PMomNTail,2), UBOUND(InData%PMomNTail,2) - DO i1 = LBOUND(InData%PMomNTail,1), UBOUND(InData%PMomNTail,1) - ReKiBuf(Re_Xferred) = InData%PMomNTail(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PMomX0Trb) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PMomX0Trb,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PMomX0Trb,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PMomX0Trb,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PMomX0Trb,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PMomX0Trb,2), UBOUND(InData%PMomX0Trb,2) - DO i1 = LBOUND(InData%PMomX0Trb,1), UBOUND(InData%PMomX0Trb,1) - ReKiBuf(Re_Xferred) = InData%PMomX0Trb(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - DO i2 = LBOUND(InData%PMXHydro,2), UBOUND(InData%PMXHydro,2) - DO i1 = LBOUND(InData%PMXHydro,1), UBOUND(InData%PMXHydro,1) - ReKiBuf(Re_Xferred) = InData%PMXHydro(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - DbKiBuf(Db_Xferred) = InData%TeetAng - Db_Xferred = Db_Xferred + 1 - DO i1 = LBOUND(InData%FrcVGnRtt,1), UBOUND(InData%FrcVGnRtt,1) - ReKiBuf(Re_Xferred) = InData%FrcVGnRtt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%FrcWTailt,1), UBOUND(InData%FrcWTailt,1) - ReKiBuf(Re_Xferred) = InData%FrcWTailt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%FrcZAllt,1), UBOUND(InData%FrcZAllt,1) - ReKiBuf(Re_Xferred) = InData%FrcZAllt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%MomXAllt,1), UBOUND(InData%MomXAllt,1) - ReKiBuf(Re_Xferred) = InData%MomXAllt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%PFrcVGnRt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PFrcVGnRt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PFrcVGnRt,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PFrcVGnRt,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PFrcVGnRt,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PFrcVGnRt,2), UBOUND(InData%PFrcVGnRt,2) - DO i1 = LBOUND(InData%PFrcVGnRt,1), UBOUND(InData%PFrcVGnRt,1) - ReKiBuf(Re_Xferred) = InData%PFrcVGnRt(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PFrcWTail) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PFrcWTail,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PFrcWTail,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PFrcWTail,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PFrcWTail,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PFrcWTail,2), UBOUND(InData%PFrcWTail,2) - DO i1 = LBOUND(InData%PFrcWTail,1), UBOUND(InData%PFrcWTail,1) - ReKiBuf(Re_Xferred) = InData%PFrcWTail(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PFrcZAll) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PFrcZAll,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PFrcZAll,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PFrcZAll,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PFrcZAll,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PFrcZAll,2), UBOUND(InData%PFrcZAll,2) - DO i1 = LBOUND(InData%PFrcZAll,1), UBOUND(InData%PFrcZAll,1) - ReKiBuf(Re_Xferred) = InData%PFrcZAll(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PMomXAll) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PMomXAll,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PMomXAll,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PMomXAll,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PMomXAll,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PMomXAll,2), UBOUND(InData%PMomXAll,2) - DO i1 = LBOUND(InData%PMomXAll,1), UBOUND(InData%PMomXAll,1) - ReKiBuf(Re_Xferred) = InData%PMomXAll(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - ReKiBuf(Re_Xferred) = InData%TeetMom - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TFrlMom - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RFrlMom - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%GBoxEffFac - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%rSAerCen) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rSAerCen,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rSAerCen,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rSAerCen,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rSAerCen,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rSAerCen,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rSAerCen,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%rSAerCen,3), UBOUND(InData%rSAerCen,3) - DO i2 = LBOUND(InData%rSAerCen,2), UBOUND(InData%rSAerCen,2) - DO i1 = LBOUND(InData%rSAerCen,1), UBOUND(InData%rSAerCen,1) - ReKiBuf(Re_Xferred) = InData%rSAerCen(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - END SUBROUTINE ED_PackRtHndSide - - SUBROUTINE ED_UnPackRtHndSide( 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(ED_RtHndSide), 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) :: i5, i5_l, i5_u ! bounds (upper/lower) for an array dimension 5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_UnPackRtHndSide' - ! 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%rO,1) - i1_u = UBOUND(OutData%rO,1) - DO i1 = LBOUND(OutData%rO,1), UBOUND(OutData%rO,1) - OutData%rO(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rQS not allocated - Int_Xferred = Int_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%rQS)) DEALLOCATE(OutData%rQS) - ALLOCATE(OutData%rQS(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%rQS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%rQS,3), UBOUND(OutData%rQS,3) - DO i2 = LBOUND(OutData%rQS,2), UBOUND(OutData%rQS,2) - DO i1 = LBOUND(OutData%rQS,1), UBOUND(OutData%rQS,1) - OutData%rQS(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rS not allocated - Int_Xferred = Int_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%rS)) DEALLOCATE(OutData%rS) - ALLOCATE(OutData%rS(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%rS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%rS,3), UBOUND(OutData%rS,3) - DO i2 = LBOUND(OutData%rS,2), UBOUND(OutData%rS,2) - DO i1 = LBOUND(OutData%rS,1), UBOUND(OutData%rS,1) - OutData%rS(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rS0S not allocated - Int_Xferred = Int_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%rS0S)) DEALLOCATE(OutData%rS0S) - ALLOCATE(OutData%rS0S(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%rS0S.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%rS0S,3), UBOUND(OutData%rS0S,3) - DO i2 = LBOUND(OutData%rS0S,2), UBOUND(OutData%rS0S,2) - DO i1 = LBOUND(OutData%rS0S,1), UBOUND(OutData%rS0S,1) - OutData%rS0S(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rT not allocated - Int_Xferred = Int_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%rT)) DEALLOCATE(OutData%rT) - ALLOCATE(OutData%rT(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rT.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%rT,2), UBOUND(OutData%rT,2) - DO i1 = LBOUND(OutData%rT,1), UBOUND(OutData%rT,1) - OutData%rT(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - i1_l = LBOUND(OutData%rT0O,1) - i1_u = UBOUND(OutData%rT0O,1) - DO i1 = LBOUND(OutData%rT0O,1), UBOUND(OutData%rT0O,1) - OutData%rT0O(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rT0T not allocated - Int_Xferred = Int_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%rT0T)) DEALLOCATE(OutData%rT0T) - ALLOCATE(OutData%rT0T(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rT0T.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%rT0T,2), UBOUND(OutData%rT0T,2) - DO i1 = LBOUND(OutData%rT0T,1), UBOUND(OutData%rT0T,1) - OutData%rT0T(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - i1_l = LBOUND(OutData%rZ,1) - i1_u = UBOUND(OutData%rZ,1) - DO i1 = LBOUND(OutData%rZ,1), UBOUND(OutData%rZ,1) - OutData%rZ(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%rZO,1) - i1_u = UBOUND(OutData%rZO,1) - DO i1 = LBOUND(OutData%rZO,1), UBOUND(OutData%rZO,1) - OutData%rZO(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rZT not allocated - Int_Xferred = Int_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%rZT)) DEALLOCATE(OutData%rZT) - ALLOCATE(OutData%rZT(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rZT.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%rZT,2), UBOUND(OutData%rZT,2) - DO i1 = LBOUND(OutData%rZT,1), UBOUND(OutData%rZT,1) - OutData%rZT(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - i1_l = LBOUND(OutData%rPQ,1) - i1_u = UBOUND(OutData%rPQ,1) - DO i1 = LBOUND(OutData%rPQ,1), UBOUND(OutData%rPQ,1) - OutData%rPQ(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%rP,1) - i1_u = UBOUND(OutData%rP,1) - DO i1 = LBOUND(OutData%rP,1), UBOUND(OutData%rP,1) - OutData%rP(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%rV,1) - i1_u = UBOUND(OutData%rV,1) - DO i1 = LBOUND(OutData%rV,1), UBOUND(OutData%rV,1) - OutData%rV(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%rJ,1) - i1_u = UBOUND(OutData%rJ,1) - DO i1 = LBOUND(OutData%rJ,1), UBOUND(OutData%rJ,1) - OutData%rJ(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%rZY,1) - i1_u = UBOUND(OutData%rZY,1) - DO i1 = LBOUND(OutData%rZY,1), UBOUND(OutData%rZY,1) - OutData%rZY(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%rOU,1) - i1_u = UBOUND(OutData%rOU,1) - DO i1 = LBOUND(OutData%rOU,1), UBOUND(OutData%rOU,1) - OutData%rOU(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%rOV,1) - i1_u = UBOUND(OutData%rOV,1) - DO i1 = LBOUND(OutData%rOV,1), UBOUND(OutData%rOV,1) - OutData%rOV(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%rVD,1) - i1_u = UBOUND(OutData%rVD,1) - DO i1 = LBOUND(OutData%rVD,1), UBOUND(OutData%rVD,1) - OutData%rVD(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%rOW,1) - i1_u = UBOUND(OutData%rOW,1) - DO i1 = LBOUND(OutData%rOW,1), UBOUND(OutData%rOW,1) - OutData%rOW(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%rPC,1) - i1_u = UBOUND(OutData%rPC,1) - DO i1 = LBOUND(OutData%rPC,1), UBOUND(OutData%rPC,1) - OutData%rPC(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rPS0 not allocated - Int_Xferred = Int_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%rPS0)) DEALLOCATE(OutData%rPS0) - ALLOCATE(OutData%rPS0(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rPS0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%rPS0,2), UBOUND(OutData%rPS0,2) - DO i1 = LBOUND(OutData%rPS0,1), UBOUND(OutData%rPS0,1) - OutData%rPS0(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - i1_l = LBOUND(OutData%rQ,1) - i1_u = UBOUND(OutData%rQ,1) - DO i1 = LBOUND(OutData%rQ,1), UBOUND(OutData%rQ,1) - OutData%rQ(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%rQC,1) - i1_u = UBOUND(OutData%rQC,1) - DO i1 = LBOUND(OutData%rQC,1), UBOUND(OutData%rQC,1) - OutData%rQC(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%rVIMU,1) - i1_u = UBOUND(OutData%rVIMU,1) - DO i1 = LBOUND(OutData%rVIMU,1), UBOUND(OutData%rVIMU,1) - OutData%rVIMU(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%rVP,1) - i1_u = UBOUND(OutData%rVP,1) - DO i1 = LBOUND(OutData%rVP,1), UBOUND(OutData%rVP,1) - OutData%rVP(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%rWI,1) - i1_u = UBOUND(OutData%rWI,1) - DO i1 = LBOUND(OutData%rWI,1), UBOUND(OutData%rWI,1) - OutData%rWI(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%rWJ,1) - i1_u = UBOUND(OutData%rWJ,1) - DO i1 = LBOUND(OutData%rWJ,1), UBOUND(OutData%rWJ,1) - OutData%rWJ(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%rZT0,1) - i1_u = UBOUND(OutData%rZT0,1) - DO i1 = LBOUND(OutData%rZT0,1), UBOUND(OutData%rZT0,1) - OutData%rZT0(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AngPosEF not allocated - Int_Xferred = Int_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%AngPosEF)) DEALLOCATE(OutData%AngPosEF) - ALLOCATE(OutData%AngPosEF(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AngPosEF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%AngPosEF,2), UBOUND(OutData%AngPosEF,2) - DO i1 = LBOUND(OutData%AngPosEF,1), UBOUND(OutData%AngPosEF,1) - OutData%AngPosEF(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AngPosXF not allocated - Int_Xferred = Int_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%AngPosXF)) DEALLOCATE(OutData%AngPosXF) - ALLOCATE(OutData%AngPosXF(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AngPosXF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%AngPosXF,2), UBOUND(OutData%AngPosXF,2) - DO i1 = LBOUND(OutData%AngPosXF,1), UBOUND(OutData%AngPosXF,1) - OutData%AngPosXF(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AngPosHM not allocated - Int_Xferred = Int_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%AngPosHM)) DEALLOCATE(OutData%AngPosHM) - ALLOCATE(OutData%AngPosHM(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%AngPosHM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%AngPosHM,3), UBOUND(OutData%AngPosHM,3) - DO i2 = LBOUND(OutData%AngPosHM,2), UBOUND(OutData%AngPosHM,2) - DO i1 = LBOUND(OutData%AngPosHM,1), UBOUND(OutData%AngPosHM,1) - OutData%AngPosHM(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - i1_l = LBOUND(OutData%AngPosXB,1) - i1_u = UBOUND(OutData%AngPosXB,1) - DO i1 = LBOUND(OutData%AngPosXB,1), UBOUND(OutData%AngPosXB,1) - OutData%AngPosXB(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%AngPosEX,1) - i1_u = UBOUND(OutData%AngPosEX,1) - DO i1 = LBOUND(OutData%AngPosEX,1), UBOUND(OutData%AngPosEX,1) - OutData%AngPosEX(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PAngVelEA not allocated - Int_Xferred = Int_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%PAngVelEA)) DEALLOCATE(OutData%PAngVelEA) - ALLOCATE(OutData%PAngVelEA(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%PAngVelEA.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%PAngVelEA,3), UBOUND(OutData%PAngVelEA,3) - DO i2 = LBOUND(OutData%PAngVelEA,2), UBOUND(OutData%PAngVelEA,2) - DO i1 = LBOUND(OutData%PAngVelEA,1), UBOUND(OutData%PAngVelEA,1) - OutData%PAngVelEA(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 ! PAngVelEF not allocated - Int_Xferred = Int_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%PAngVelEF)) DEALLOCATE(OutData%PAngVelEF) - ALLOCATE(OutData%PAngVelEF(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%PAngVelEF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%PAngVelEF,4), UBOUND(OutData%PAngVelEF,4) - DO i3 = LBOUND(OutData%PAngVelEF,3), UBOUND(OutData%PAngVelEF,3) - DO i2 = LBOUND(OutData%PAngVelEF,2), UBOUND(OutData%PAngVelEF,2) - DO i1 = LBOUND(OutData%PAngVelEF,1), UBOUND(OutData%PAngVelEF,1) - OutData%PAngVelEF(i1,i2,i3,i4) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PAngVelEG not allocated - Int_Xferred = Int_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%PAngVelEG)) DEALLOCATE(OutData%PAngVelEG) - ALLOCATE(OutData%PAngVelEG(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%PAngVelEG.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%PAngVelEG,3), UBOUND(OutData%PAngVelEG,3) - DO i2 = LBOUND(OutData%PAngVelEG,2), UBOUND(OutData%PAngVelEG,2) - DO i1 = LBOUND(OutData%PAngVelEG,1), UBOUND(OutData%PAngVelEG,1) - OutData%PAngVelEG(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 ! PAngVelEH not allocated - Int_Xferred = Int_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%PAngVelEH)) DEALLOCATE(OutData%PAngVelEH) - ALLOCATE(OutData%PAngVelEH(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%PAngVelEH.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%PAngVelEH,3), UBOUND(OutData%PAngVelEH,3) - DO i2 = LBOUND(OutData%PAngVelEH,2), UBOUND(OutData%PAngVelEH,2) - DO i1 = LBOUND(OutData%PAngVelEH,1), UBOUND(OutData%PAngVelEH,1) - OutData%PAngVelEH(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 ! PAngVelEL not allocated - Int_Xferred = Int_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%PAngVelEL)) DEALLOCATE(OutData%PAngVelEL) - ALLOCATE(OutData%PAngVelEL(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%PAngVelEL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%PAngVelEL,3), UBOUND(OutData%PAngVelEL,3) - DO i2 = LBOUND(OutData%PAngVelEL,2), UBOUND(OutData%PAngVelEL,2) - DO i1 = LBOUND(OutData%PAngVelEL,1), UBOUND(OutData%PAngVelEL,1) - OutData%PAngVelEL(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 ! PAngVelEM not allocated - Int_Xferred = Int_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 - i5_l = IntKiBuf( Int_Xferred ) - i5_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PAngVelEM)) DEALLOCATE(OutData%PAngVelEM) - ALLOCATE(OutData%PAngVelEM(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u,i5_l:i5_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PAngVelEM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i5 = LBOUND(OutData%PAngVelEM,5), UBOUND(OutData%PAngVelEM,5) - DO i4 = LBOUND(OutData%PAngVelEM,4), UBOUND(OutData%PAngVelEM,4) - DO i3 = LBOUND(OutData%PAngVelEM,3), UBOUND(OutData%PAngVelEM,3) - DO i2 = LBOUND(OutData%PAngVelEM,2), UBOUND(OutData%PAngVelEM,2) - DO i1 = LBOUND(OutData%PAngVelEM,1), UBOUND(OutData%PAngVelEM,1) - OutData%PAngVelEM(i1,i2,i3,i4,i5) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AngVelEM not allocated - Int_Xferred = Int_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%AngVelEM)) DEALLOCATE(OutData%AngVelEM) - ALLOCATE(OutData%AngVelEM(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%AngVelEM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%AngVelEM,3), UBOUND(OutData%AngVelEM,3) - DO i2 = LBOUND(OutData%AngVelEM,2), UBOUND(OutData%AngVelEM,2) - DO i1 = LBOUND(OutData%AngVelEM,1), UBOUND(OutData%AngVelEM,1) - OutData%AngVelEM(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 ! PAngVelEN not allocated - Int_Xferred = Int_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%PAngVelEN)) DEALLOCATE(OutData%PAngVelEN) - ALLOCATE(OutData%PAngVelEN(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%PAngVelEN.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%PAngVelEN,3), UBOUND(OutData%PAngVelEN,3) - DO i2 = LBOUND(OutData%PAngVelEN,2), UBOUND(OutData%PAngVelEN,2) - DO i1 = LBOUND(OutData%PAngVelEN,1), UBOUND(OutData%PAngVelEN,1) - OutData%PAngVelEN(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - i1_l = LBOUND(OutData%AngVelEA,1) - i1_u = UBOUND(OutData%AngVelEA,1) - DO i1 = LBOUND(OutData%AngVelEA,1), UBOUND(OutData%AngVelEA,1) - OutData%AngVelEA(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PAngVelEB not allocated - Int_Xferred = Int_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%PAngVelEB)) DEALLOCATE(OutData%PAngVelEB) - ALLOCATE(OutData%PAngVelEB(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%PAngVelEB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%PAngVelEB,3), UBOUND(OutData%PAngVelEB,3) - DO i2 = LBOUND(OutData%PAngVelEB,2), UBOUND(OutData%PAngVelEB,2) - DO i1 = LBOUND(OutData%PAngVelEB,1), UBOUND(OutData%PAngVelEB,1) - OutData%PAngVelEB(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 ! PAngVelER not allocated - Int_Xferred = Int_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%PAngVelER)) DEALLOCATE(OutData%PAngVelER) - ALLOCATE(OutData%PAngVelER(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%PAngVelER.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%PAngVelER,3), UBOUND(OutData%PAngVelER,3) - DO i2 = LBOUND(OutData%PAngVelER,2), UBOUND(OutData%PAngVelER,2) - DO i1 = LBOUND(OutData%PAngVelER,1), UBOUND(OutData%PAngVelER,1) - OutData%PAngVelER(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 ! PAngVelEX not allocated - Int_Xferred = Int_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%PAngVelEX)) DEALLOCATE(OutData%PAngVelEX) - ALLOCATE(OutData%PAngVelEX(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%PAngVelEX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%PAngVelEX,3), UBOUND(OutData%PAngVelEX,3) - DO i2 = LBOUND(OutData%PAngVelEX,2), UBOUND(OutData%PAngVelEX,2) - DO i1 = LBOUND(OutData%PAngVelEX,1), UBOUND(OutData%PAngVelEX,1) - OutData%PAngVelEX(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - i1_l = LBOUND(OutData%AngVelEG,1) - i1_u = UBOUND(OutData%AngVelEG,1) - DO i1 = LBOUND(OutData%AngVelEG,1), UBOUND(OutData%AngVelEG,1) - OutData%AngVelEG(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%AngVelEH,1) - i1_u = UBOUND(OutData%AngVelEH,1) - DO i1 = LBOUND(OutData%AngVelEH,1), UBOUND(OutData%AngVelEH,1) - OutData%AngVelEH(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%AngVelEL,1) - i1_u = UBOUND(OutData%AngVelEL,1) - DO i1 = LBOUND(OutData%AngVelEL,1), UBOUND(OutData%AngVelEL,1) - OutData%AngVelEL(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%AngVelEN,1) - i1_u = UBOUND(OutData%AngVelEN,1) - DO i1 = LBOUND(OutData%AngVelEN,1), UBOUND(OutData%AngVelEN,1) - OutData%AngVelEN(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%AngVelEB,1) - i1_u = UBOUND(OutData%AngVelEB,1) - DO i1 = LBOUND(OutData%AngVelEB,1), UBOUND(OutData%AngVelEB,1) - OutData%AngVelEB(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%AngVelER,1) - i1_u = UBOUND(OutData%AngVelER,1) - DO i1 = LBOUND(OutData%AngVelER,1), UBOUND(OutData%AngVelER,1) - OutData%AngVelER(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%AngVelEX,1) - i1_u = UBOUND(OutData%AngVelEX,1) - DO i1 = LBOUND(OutData%AngVelEX,1), UBOUND(OutData%AngVelEX,1) - OutData%AngVelEX(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%TeetAngVel = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - i1_l = LBOUND(OutData%AngAccEBt,1) - i1_u = UBOUND(OutData%AngAccEBt,1) - DO i1 = LBOUND(OutData%AngAccEBt,1), UBOUND(OutData%AngAccEBt,1) - OutData%AngAccEBt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%AngAccERt,1) - i1_u = UBOUND(OutData%AngAccERt,1) - DO i1 = LBOUND(OutData%AngAccERt,1), UBOUND(OutData%AngAccERt,1) - OutData%AngAccERt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%AngAccEXt,1) - i1_u = UBOUND(OutData%AngAccEXt,1) - DO i1 = LBOUND(OutData%AngAccEXt,1), UBOUND(OutData%AngAccEXt,1) - OutData%AngAccEXt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AngAccEFt not allocated - Int_Xferred = Int_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%AngAccEFt)) DEALLOCATE(OutData%AngAccEFt) - ALLOCATE(OutData%AngAccEFt(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AngAccEFt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%AngAccEFt,2), UBOUND(OutData%AngAccEFt,2) - DO i1 = LBOUND(OutData%AngAccEFt,1), UBOUND(OutData%AngAccEFt,1) - OutData%AngAccEFt(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AngVelEF not allocated - Int_Xferred = Int_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%AngVelEF)) DEALLOCATE(OutData%AngVelEF) - ALLOCATE(OutData%AngVelEF(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AngVelEF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%AngVelEF,2), UBOUND(OutData%AngVelEF,2) - DO i1 = LBOUND(OutData%AngVelEF,1), UBOUND(OutData%AngVelEF,1) - OutData%AngVelEF(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AngVelHM not allocated - Int_Xferred = Int_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%AngVelHM)) DEALLOCATE(OutData%AngVelHM) - ALLOCATE(OutData%AngVelHM(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%AngVelHM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%AngVelHM,3), UBOUND(OutData%AngVelHM,3) - DO i2 = LBOUND(OutData%AngVelHM,2), UBOUND(OutData%AngVelHM,2) - DO i1 = LBOUND(OutData%AngVelHM,1), UBOUND(OutData%AngVelHM,1) - OutData%AngVelHM(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - i1_l = LBOUND(OutData%AngAccEAt,1) - i1_u = UBOUND(OutData%AngAccEAt,1) - DO i1 = LBOUND(OutData%AngAccEAt,1), UBOUND(OutData%AngAccEAt,1) - OutData%AngAccEAt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%AngAccEGt,1) - i1_u = UBOUND(OutData%AngAccEGt,1) - DO i1 = LBOUND(OutData%AngAccEGt,1), UBOUND(OutData%AngAccEGt,1) - OutData%AngAccEGt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%AngAccEHt,1) - i1_u = UBOUND(OutData%AngAccEHt,1) - DO i1 = LBOUND(OutData%AngAccEHt,1), UBOUND(OutData%AngAccEHt,1) - OutData%AngAccEHt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AngAccEKt not allocated - Int_Xferred = Int_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%AngAccEKt)) DEALLOCATE(OutData%AngAccEKt) - ALLOCATE(OutData%AngAccEKt(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%AngAccEKt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%AngAccEKt,3), UBOUND(OutData%AngAccEKt,3) - DO i2 = LBOUND(OutData%AngAccEKt,2), UBOUND(OutData%AngAccEKt,2) - DO i1 = LBOUND(OutData%AngAccEKt,1), UBOUND(OutData%AngAccEKt,1) - OutData%AngAccEKt(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - i1_l = LBOUND(OutData%AngAccENt,1) - i1_u = UBOUND(OutData%AngAccENt,1) - DO i1 = LBOUND(OutData%AngAccENt,1), UBOUND(OutData%AngAccENt,1) - OutData%AngAccENt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%LinAccECt,1) - i1_u = UBOUND(OutData%LinAccECt,1) - DO i1 = LBOUND(OutData%LinAccECt,1), UBOUND(OutData%LinAccECt,1) - OutData%LinAccECt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%LinAccEDt,1) - i1_u = UBOUND(OutData%LinAccEDt,1) - DO i1 = LBOUND(OutData%LinAccEDt,1), UBOUND(OutData%LinAccEDt,1) - OutData%LinAccEDt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%LinAccEIt,1) - i1_u = UBOUND(OutData%LinAccEIt,1) - DO i1 = LBOUND(OutData%LinAccEIt,1), UBOUND(OutData%LinAccEIt,1) - OutData%LinAccEIt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%LinAccEJt,1) - i1_u = UBOUND(OutData%LinAccEJt,1) - DO i1 = LBOUND(OutData%LinAccEJt,1), UBOUND(OutData%LinAccEJt,1) - OutData%LinAccEJt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%LinAccEUt,1) - i1_u = UBOUND(OutData%LinAccEUt,1) - DO i1 = LBOUND(OutData%LinAccEUt,1), UBOUND(OutData%LinAccEUt,1) - OutData%LinAccEUt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%LinAccEYt,1) - i1_u = UBOUND(OutData%LinAccEYt,1) - DO i1 = LBOUND(OutData%LinAccEYt,1), UBOUND(OutData%LinAccEYt,1) - OutData%LinAccEYt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinVelES not allocated - Int_Xferred = Int_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%LinVelES)) DEALLOCATE(OutData%LinVelES) - ALLOCATE(OutData%LinVelES(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%LinVelES.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%LinVelES,3), UBOUND(OutData%LinVelES,3) - DO i2 = LBOUND(OutData%LinVelES,2), UBOUND(OutData%LinVelES,2) - DO i1 = LBOUND(OutData%LinVelES,1), UBOUND(OutData%LinVelES,1) - OutData%LinVelES(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - i1_l = LBOUND(OutData%LinVelEQ,1) - i1_u = UBOUND(OutData%LinVelEQ,1) - DO i1 = LBOUND(OutData%LinVelEQ,1), UBOUND(OutData%LinVelEQ,1) - OutData%LinVelEQ(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinVelET not allocated - Int_Xferred = Int_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%LinVelET)) DEALLOCATE(OutData%LinVelET) - ALLOCATE(OutData%LinVelET(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinVelET.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%LinVelET,2), UBOUND(OutData%LinVelET,2) - DO i1 = LBOUND(OutData%LinVelET,1), UBOUND(OutData%LinVelET,1) - OutData%LinVelET(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinVelESm2 not allocated - Int_Xferred = Int_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%LinVelESm2)) DEALLOCATE(OutData%LinVelESm2) - ALLOCATE(OutData%LinVelESm2(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinVelESm2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LinVelESm2,1), UBOUND(OutData%LinVelESm2,1) - OutData%LinVelESm2(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PLinVelEIMU not allocated - Int_Xferred = Int_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%PLinVelEIMU)) DEALLOCATE(OutData%PLinVelEIMU) - ALLOCATE(OutData%PLinVelEIMU(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%PLinVelEIMU.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%PLinVelEIMU,3), UBOUND(OutData%PLinVelEIMU,3) - DO i2 = LBOUND(OutData%PLinVelEIMU,2), UBOUND(OutData%PLinVelEIMU,2) - DO i1 = LBOUND(OutData%PLinVelEIMU,1), UBOUND(OutData%PLinVelEIMU,1) - OutData%PLinVelEIMU(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 ! PLinVelEO not allocated - Int_Xferred = Int_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%PLinVelEO)) DEALLOCATE(OutData%PLinVelEO) - ALLOCATE(OutData%PLinVelEO(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%PLinVelEO.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%PLinVelEO,3), UBOUND(OutData%PLinVelEO,3) - DO i2 = LBOUND(OutData%PLinVelEO,2), UBOUND(OutData%PLinVelEO,2) - DO i1 = LBOUND(OutData%PLinVelEO,1), UBOUND(OutData%PLinVelEO,1) - OutData%PLinVelEO(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 ! PLinVelES not allocated - Int_Xferred = Int_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 - i5_l = IntKiBuf( Int_Xferred ) - i5_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PLinVelES)) DEALLOCATE(OutData%PLinVelES) - ALLOCATE(OutData%PLinVelES(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u,i5_l:i5_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PLinVelES.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i5 = LBOUND(OutData%PLinVelES,5), UBOUND(OutData%PLinVelES,5) - DO i4 = LBOUND(OutData%PLinVelES,4), UBOUND(OutData%PLinVelES,4) - DO i3 = LBOUND(OutData%PLinVelES,3), UBOUND(OutData%PLinVelES,3) - DO i2 = LBOUND(OutData%PLinVelES,2), UBOUND(OutData%PLinVelES,2) - DO i1 = LBOUND(OutData%PLinVelES,1), UBOUND(OutData%PLinVelES,1) - OutData%PLinVelES(i1,i2,i3,i4,i5) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PLinVelET not allocated - Int_Xferred = Int_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%PLinVelET)) DEALLOCATE(OutData%PLinVelET) - ALLOCATE(OutData%PLinVelET(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%PLinVelET.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%PLinVelET,4), UBOUND(OutData%PLinVelET,4) - DO i3 = LBOUND(OutData%PLinVelET,3), UBOUND(OutData%PLinVelET,3) - DO i2 = LBOUND(OutData%PLinVelET,2), UBOUND(OutData%PLinVelET,2) - DO i1 = LBOUND(OutData%PLinVelET,1), UBOUND(OutData%PLinVelET,1) - OutData%PLinVelET(i1,i2,i3,i4) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PLinVelEZ not allocated - Int_Xferred = Int_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%PLinVelEZ)) DEALLOCATE(OutData%PLinVelEZ) - ALLOCATE(OutData%PLinVelEZ(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%PLinVelEZ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%PLinVelEZ,3), UBOUND(OutData%PLinVelEZ,3) - DO i2 = LBOUND(OutData%PLinVelEZ,2), UBOUND(OutData%PLinVelEZ,2) - DO i1 = LBOUND(OutData%PLinVelEZ,1), UBOUND(OutData%PLinVelEZ,1) - OutData%PLinVelEZ(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 ! PLinVelEC not allocated - Int_Xferred = Int_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%PLinVelEC)) DEALLOCATE(OutData%PLinVelEC) - ALLOCATE(OutData%PLinVelEC(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%PLinVelEC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%PLinVelEC,3), UBOUND(OutData%PLinVelEC,3) - DO i2 = LBOUND(OutData%PLinVelEC,2), UBOUND(OutData%PLinVelEC,2) - DO i1 = LBOUND(OutData%PLinVelEC,1), UBOUND(OutData%PLinVelEC,1) - OutData%PLinVelEC(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 ! PLinVelED not allocated - Int_Xferred = Int_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%PLinVelED)) DEALLOCATE(OutData%PLinVelED) - ALLOCATE(OutData%PLinVelED(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%PLinVelED.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%PLinVelED,3), UBOUND(OutData%PLinVelED,3) - DO i2 = LBOUND(OutData%PLinVelED,2), UBOUND(OutData%PLinVelED,2) - DO i1 = LBOUND(OutData%PLinVelED,1), UBOUND(OutData%PLinVelED,1) - OutData%PLinVelED(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 ! PLinVelEI not allocated - Int_Xferred = Int_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%PLinVelEI)) DEALLOCATE(OutData%PLinVelEI) - ALLOCATE(OutData%PLinVelEI(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%PLinVelEI.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%PLinVelEI,3), UBOUND(OutData%PLinVelEI,3) - DO i2 = LBOUND(OutData%PLinVelEI,2), UBOUND(OutData%PLinVelEI,2) - DO i1 = LBOUND(OutData%PLinVelEI,1), UBOUND(OutData%PLinVelEI,1) - OutData%PLinVelEI(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 ! PLinVelEJ not allocated - Int_Xferred = Int_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%PLinVelEJ)) DEALLOCATE(OutData%PLinVelEJ) - ALLOCATE(OutData%PLinVelEJ(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%PLinVelEJ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%PLinVelEJ,3), UBOUND(OutData%PLinVelEJ,3) - DO i2 = LBOUND(OutData%PLinVelEJ,2), UBOUND(OutData%PLinVelEJ,2) - DO i1 = LBOUND(OutData%PLinVelEJ,1), UBOUND(OutData%PLinVelEJ,1) - OutData%PLinVelEJ(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 ! PLinVelEP not allocated - Int_Xferred = Int_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%PLinVelEP)) DEALLOCATE(OutData%PLinVelEP) - ALLOCATE(OutData%PLinVelEP(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%PLinVelEP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%PLinVelEP,3), UBOUND(OutData%PLinVelEP,3) - DO i2 = LBOUND(OutData%PLinVelEP,2), UBOUND(OutData%PLinVelEP,2) - DO i1 = LBOUND(OutData%PLinVelEP,1), UBOUND(OutData%PLinVelEP,1) - OutData%PLinVelEP(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 ! PLinVelEQ not allocated - Int_Xferred = Int_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%PLinVelEQ)) DEALLOCATE(OutData%PLinVelEQ) - ALLOCATE(OutData%PLinVelEQ(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%PLinVelEQ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%PLinVelEQ,3), UBOUND(OutData%PLinVelEQ,3) - DO i2 = LBOUND(OutData%PLinVelEQ,2), UBOUND(OutData%PLinVelEQ,2) - DO i1 = LBOUND(OutData%PLinVelEQ,1), UBOUND(OutData%PLinVelEQ,1) - OutData%PLinVelEQ(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 ! PLinVelEU not allocated - Int_Xferred = Int_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%PLinVelEU)) DEALLOCATE(OutData%PLinVelEU) - ALLOCATE(OutData%PLinVelEU(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%PLinVelEU.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%PLinVelEU,3), UBOUND(OutData%PLinVelEU,3) - DO i2 = LBOUND(OutData%PLinVelEU,2), UBOUND(OutData%PLinVelEU,2) - DO i1 = LBOUND(OutData%PLinVelEU,1), UBOUND(OutData%PLinVelEU,1) - OutData%PLinVelEU(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 ! PLinVelEV not allocated - Int_Xferred = Int_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%PLinVelEV)) DEALLOCATE(OutData%PLinVelEV) - ALLOCATE(OutData%PLinVelEV(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%PLinVelEV.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%PLinVelEV,3), UBOUND(OutData%PLinVelEV,3) - DO i2 = LBOUND(OutData%PLinVelEV,2), UBOUND(OutData%PLinVelEV,2) - DO i1 = LBOUND(OutData%PLinVelEV,1), UBOUND(OutData%PLinVelEV,1) - OutData%PLinVelEV(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 ! PLinVelEW not allocated - Int_Xferred = Int_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%PLinVelEW)) DEALLOCATE(OutData%PLinVelEW) - ALLOCATE(OutData%PLinVelEW(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%PLinVelEW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%PLinVelEW,3), UBOUND(OutData%PLinVelEW,3) - DO i2 = LBOUND(OutData%PLinVelEW,2), UBOUND(OutData%PLinVelEW,2) - DO i1 = LBOUND(OutData%PLinVelEW,1), UBOUND(OutData%PLinVelEW,1) - OutData%PLinVelEW(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 ! PLinVelEY not allocated - Int_Xferred = Int_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%PLinVelEY)) DEALLOCATE(OutData%PLinVelEY) - ALLOCATE(OutData%PLinVelEY(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%PLinVelEY.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%PLinVelEY,3), UBOUND(OutData%PLinVelEY,3) - DO i2 = LBOUND(OutData%PLinVelEY,2), UBOUND(OutData%PLinVelEY,2) - DO i1 = LBOUND(OutData%PLinVelEY,1), UBOUND(OutData%PLinVelEY,1) - OutData%PLinVelEY(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - i1_l = LBOUND(OutData%LinAccEIMUt,1) - i1_u = UBOUND(OutData%LinAccEIMUt,1) - DO i1 = LBOUND(OutData%LinAccEIMUt,1), UBOUND(OutData%LinAccEIMUt,1) - OutData%LinAccEIMUt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%LinAccEOt,1) - i1_u = UBOUND(OutData%LinAccEOt,1) - DO i1 = LBOUND(OutData%LinAccEOt,1), UBOUND(OutData%LinAccEOt,1) - OutData%LinAccEOt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinAccESt not allocated - Int_Xferred = Int_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%LinAccESt)) DEALLOCATE(OutData%LinAccESt) - ALLOCATE(OutData%LinAccESt(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%LinAccESt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%LinAccESt,3), UBOUND(OutData%LinAccESt,3) - DO i2 = LBOUND(OutData%LinAccESt,2), UBOUND(OutData%LinAccESt,2) - DO i1 = LBOUND(OutData%LinAccESt,1), UBOUND(OutData%LinAccESt,1) - OutData%LinAccESt(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 ! LinAccETt not allocated - Int_Xferred = Int_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%LinAccETt)) DEALLOCATE(OutData%LinAccETt) - ALLOCATE(OutData%LinAccETt(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinAccETt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%LinAccETt,2), UBOUND(OutData%LinAccETt,2) - DO i1 = LBOUND(OutData%LinAccETt,1), UBOUND(OutData%LinAccETt,1) - OutData%LinAccETt(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - i1_l = LBOUND(OutData%LinAccEZt,1) - i1_u = UBOUND(OutData%LinAccEZt,1) - DO i1 = LBOUND(OutData%LinAccEZt,1), UBOUND(OutData%LinAccEZt,1) - OutData%LinAccEZt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%LinVelEIMU,1) - i1_u = UBOUND(OutData%LinVelEIMU,1) - DO i1 = LBOUND(OutData%LinVelEIMU,1), UBOUND(OutData%LinVelEIMU,1) - OutData%LinVelEIMU(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%LinVelEZ,1) - i1_u = UBOUND(OutData%LinVelEZ,1) - DO i1 = LBOUND(OutData%LinVelEZ,1), UBOUND(OutData%LinVelEZ,1) - OutData%LinVelEZ(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%LinVelEO,1) - i1_u = UBOUND(OutData%LinVelEO,1) - DO i1 = LBOUND(OutData%LinVelEO,1), UBOUND(OutData%LinVelEO,1) - OutData%LinVelEO(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%LinVelEJ,1) - i1_u = UBOUND(OutData%LinVelEJ,1) - DO i1 = LBOUND(OutData%LinVelEJ,1), UBOUND(OutData%LinVelEJ,1) - OutData%LinVelEJ(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%FrcONcRtt,1) - i1_u = UBOUND(OutData%FrcONcRtt,1) - DO i1 = LBOUND(OutData%FrcONcRtt,1), UBOUND(OutData%FrcONcRtt,1) - OutData%FrcONcRtt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%FrcPRott,1) - i1_u = UBOUND(OutData%FrcPRott,1) - DO i1 = LBOUND(OutData%FrcPRott,1), UBOUND(OutData%FrcPRott,1) - OutData%FrcPRott(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FrcS0Bt not allocated - Int_Xferred = Int_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%FrcS0Bt)) DEALLOCATE(OutData%FrcS0Bt) - ALLOCATE(OutData%FrcS0Bt(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FrcS0Bt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%FrcS0Bt,2), UBOUND(OutData%FrcS0Bt,2) - DO i1 = LBOUND(OutData%FrcS0Bt,1), UBOUND(OutData%FrcS0Bt,1) - OutData%FrcS0Bt(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - i1_l = LBOUND(OutData%FrcT0Trbt,1) - i1_u = UBOUND(OutData%FrcT0Trbt,1) - DO i1 = LBOUND(OutData%FrcT0Trbt,1), UBOUND(OutData%FrcT0Trbt,1) - OutData%FrcT0Trbt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FSAero not allocated - Int_Xferred = Int_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%FSAero)) DEALLOCATE(OutData%FSAero) - ALLOCATE(OutData%FSAero(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%FSAero.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%FSAero,3), UBOUND(OutData%FSAero,3) - DO i2 = LBOUND(OutData%FSAero,2), UBOUND(OutData%FSAero,2) - DO i1 = LBOUND(OutData%FSAero,1), UBOUND(OutData%FSAero,1) - OutData%FSAero(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 ! FSTipDrag not allocated - Int_Xferred = Int_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%FSTipDrag)) DEALLOCATE(OutData%FSTipDrag) - ALLOCATE(OutData%FSTipDrag(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FSTipDrag.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%FSTipDrag,2), UBOUND(OutData%FSTipDrag,2) - DO i1 = LBOUND(OutData%FSTipDrag,1), UBOUND(OutData%FSTipDrag,1) - OutData%FSTipDrag(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FTHydrot not allocated - Int_Xferred = Int_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%FTHydrot)) DEALLOCATE(OutData%FTHydrot) - ALLOCATE(OutData%FTHydrot(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FTHydrot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%FTHydrot,2), UBOUND(OutData%FTHydrot,2) - DO i1 = LBOUND(OutData%FTHydrot,1), UBOUND(OutData%FTHydrot,1) - OutData%FTHydrot(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - i1_l = LBOUND(OutData%FZHydrot,1) - i1_u = UBOUND(OutData%FZHydrot,1) - DO i1 = LBOUND(OutData%FZHydrot,1), UBOUND(OutData%FZHydrot,1) - OutData%FZHydrot(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MFHydrot not allocated - Int_Xferred = Int_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%MFHydrot)) DEALLOCATE(OutData%MFHydrot) - ALLOCATE(OutData%MFHydrot(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MFHydrot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%MFHydrot,2), UBOUND(OutData%MFHydrot,2) - DO i1 = LBOUND(OutData%MFHydrot,1), UBOUND(OutData%MFHydrot,1) - OutData%MFHydrot(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - i1_l = LBOUND(OutData%MomBNcRtt,1) - i1_u = UBOUND(OutData%MomBNcRtt,1) - DO i1 = LBOUND(OutData%MomBNcRtt,1), UBOUND(OutData%MomBNcRtt,1) - OutData%MomBNcRtt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MomH0Bt not allocated - Int_Xferred = Int_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%MomH0Bt)) DEALLOCATE(OutData%MomH0Bt) - ALLOCATE(OutData%MomH0Bt(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MomH0Bt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%MomH0Bt,2), UBOUND(OutData%MomH0Bt,2) - DO i1 = LBOUND(OutData%MomH0Bt,1), UBOUND(OutData%MomH0Bt,1) - OutData%MomH0Bt(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - i1_l = LBOUND(OutData%MomLPRott,1) - i1_u = UBOUND(OutData%MomLPRott,1) - DO i1 = LBOUND(OutData%MomLPRott,1), UBOUND(OutData%MomLPRott,1) - OutData%MomLPRott(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%MomNGnRtt,1) - i1_u = UBOUND(OutData%MomNGnRtt,1) - DO i1 = LBOUND(OutData%MomNGnRtt,1), UBOUND(OutData%MomNGnRtt,1) - OutData%MomNGnRtt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%MomNTailt,1) - i1_u = UBOUND(OutData%MomNTailt,1) - DO i1 = LBOUND(OutData%MomNTailt,1), UBOUND(OutData%MomNTailt,1) - OutData%MomNTailt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%MomX0Trbt,1) - i1_u = UBOUND(OutData%MomX0Trbt,1) - DO i1 = LBOUND(OutData%MomX0Trbt,1), UBOUND(OutData%MomX0Trbt,1) - OutData%MomX0Trbt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MMAero not allocated - Int_Xferred = Int_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%MMAero)) DEALLOCATE(OutData%MMAero) - ALLOCATE(OutData%MMAero(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%MMAero.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%MMAero,3), UBOUND(OutData%MMAero,3) - DO i2 = LBOUND(OutData%MMAero,2), UBOUND(OutData%MMAero,2) - DO i1 = LBOUND(OutData%MMAero,1), UBOUND(OutData%MMAero,1) - OutData%MMAero(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - i1_l = LBOUND(OutData%MXHydrot,1) - i1_u = UBOUND(OutData%MXHydrot,1) - DO i1 = LBOUND(OutData%MXHydrot,1), UBOUND(OutData%MXHydrot,1) - OutData%MXHydrot(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PFrcONcRt not allocated - Int_Xferred = Int_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%PFrcONcRt)) DEALLOCATE(OutData%PFrcONcRt) - ALLOCATE(OutData%PFrcONcRt(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PFrcONcRt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PFrcONcRt,2), UBOUND(OutData%PFrcONcRt,2) - DO i1 = LBOUND(OutData%PFrcONcRt,1), UBOUND(OutData%PFrcONcRt,1) - OutData%PFrcONcRt(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PFrcPRot not allocated - Int_Xferred = Int_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%PFrcPRot)) DEALLOCATE(OutData%PFrcPRot) - ALLOCATE(OutData%PFrcPRot(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PFrcPRot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PFrcPRot,2), UBOUND(OutData%PFrcPRot,2) - DO i1 = LBOUND(OutData%PFrcPRot,1), UBOUND(OutData%PFrcPRot,1) - OutData%PFrcPRot(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PFrcS0B not allocated - Int_Xferred = Int_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%PFrcS0B)) DEALLOCATE(OutData%PFrcS0B) - ALLOCATE(OutData%PFrcS0B(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%PFrcS0B.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%PFrcS0B,3), UBOUND(OutData%PFrcS0B,3) - DO i2 = LBOUND(OutData%PFrcS0B,2), UBOUND(OutData%PFrcS0B,2) - DO i1 = LBOUND(OutData%PFrcS0B,1), UBOUND(OutData%PFrcS0B,1) - OutData%PFrcS0B(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 ! PFrcT0Trb not allocated - Int_Xferred = Int_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%PFrcT0Trb)) DEALLOCATE(OutData%PFrcT0Trb) - ALLOCATE(OutData%PFrcT0Trb(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PFrcT0Trb.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PFrcT0Trb,2), UBOUND(OutData%PFrcT0Trb,2) - DO i1 = LBOUND(OutData%PFrcT0Trb,1), UBOUND(OutData%PFrcT0Trb,1) - OutData%PFrcT0Trb(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PFTHydro not allocated - Int_Xferred = Int_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%PFTHydro)) DEALLOCATE(OutData%PFTHydro) - ALLOCATE(OutData%PFTHydro(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%PFTHydro.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%PFTHydro,3), UBOUND(OutData%PFTHydro,3) - DO i2 = LBOUND(OutData%PFTHydro,2), UBOUND(OutData%PFTHydro,2) - DO i1 = LBOUND(OutData%PFTHydro,1), UBOUND(OutData%PFTHydro,1) - OutData%PFTHydro(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - i1_l = LBOUND(OutData%PFZHydro,1) - i1_u = UBOUND(OutData%PFZHydro,1) - i2_l = LBOUND(OutData%PFZHydro,2) - i2_u = UBOUND(OutData%PFZHydro,2) - DO i2 = LBOUND(OutData%PFZHydro,2), UBOUND(OutData%PFZHydro,2) - DO i1 = LBOUND(OutData%PFZHydro,1), UBOUND(OutData%PFZHydro,1) - OutData%PFZHydro(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PMFHydro not allocated - Int_Xferred = Int_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%PMFHydro)) DEALLOCATE(OutData%PMFHydro) - ALLOCATE(OutData%PMFHydro(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%PMFHydro.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%PMFHydro,3), UBOUND(OutData%PMFHydro,3) - DO i2 = LBOUND(OutData%PMFHydro,2), UBOUND(OutData%PMFHydro,2) - DO i1 = LBOUND(OutData%PMFHydro,1), UBOUND(OutData%PMFHydro,1) - OutData%PMFHydro(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 ! PMomBNcRt not allocated - Int_Xferred = Int_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%PMomBNcRt)) DEALLOCATE(OutData%PMomBNcRt) - ALLOCATE(OutData%PMomBNcRt(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PMomBNcRt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PMomBNcRt,2), UBOUND(OutData%PMomBNcRt,2) - DO i1 = LBOUND(OutData%PMomBNcRt,1), UBOUND(OutData%PMomBNcRt,1) - OutData%PMomBNcRt(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PMomH0B not allocated - Int_Xferred = Int_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%PMomH0B)) DEALLOCATE(OutData%PMomH0B) - ALLOCATE(OutData%PMomH0B(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%PMomH0B.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%PMomH0B,3), UBOUND(OutData%PMomH0B,3) - DO i2 = LBOUND(OutData%PMomH0B,2), UBOUND(OutData%PMomH0B,2) - DO i1 = LBOUND(OutData%PMomH0B,1), UBOUND(OutData%PMomH0B,1) - OutData%PMomH0B(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 ! PMomLPRot not allocated - Int_Xferred = Int_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%PMomLPRot)) DEALLOCATE(OutData%PMomLPRot) - ALLOCATE(OutData%PMomLPRot(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PMomLPRot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PMomLPRot,2), UBOUND(OutData%PMomLPRot,2) - DO i1 = LBOUND(OutData%PMomLPRot,1), UBOUND(OutData%PMomLPRot,1) - OutData%PMomLPRot(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PMomNGnRt not allocated - Int_Xferred = Int_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%PMomNGnRt)) DEALLOCATE(OutData%PMomNGnRt) - ALLOCATE(OutData%PMomNGnRt(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PMomNGnRt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PMomNGnRt,2), UBOUND(OutData%PMomNGnRt,2) - DO i1 = LBOUND(OutData%PMomNGnRt,1), UBOUND(OutData%PMomNGnRt,1) - OutData%PMomNGnRt(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PMomNTail not allocated - Int_Xferred = Int_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%PMomNTail)) DEALLOCATE(OutData%PMomNTail) - ALLOCATE(OutData%PMomNTail(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PMomNTail.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PMomNTail,2), UBOUND(OutData%PMomNTail,2) - DO i1 = LBOUND(OutData%PMomNTail,1), UBOUND(OutData%PMomNTail,1) - OutData%PMomNTail(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PMomX0Trb not allocated - Int_Xferred = Int_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%PMomX0Trb)) DEALLOCATE(OutData%PMomX0Trb) - ALLOCATE(OutData%PMomX0Trb(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PMomX0Trb.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PMomX0Trb,2), UBOUND(OutData%PMomX0Trb,2) - DO i1 = LBOUND(OutData%PMomX0Trb,1), UBOUND(OutData%PMomX0Trb,1) - OutData%PMomX0Trb(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - i1_l = LBOUND(OutData%PMXHydro,1) - i1_u = UBOUND(OutData%PMXHydro,1) - i2_l = LBOUND(OutData%PMXHydro,2) - i2_u = UBOUND(OutData%PMXHydro,2) - DO i2 = LBOUND(OutData%PMXHydro,2), UBOUND(OutData%PMXHydro,2) - DO i1 = LBOUND(OutData%PMXHydro,1), UBOUND(OutData%PMXHydro,1) - OutData%PMXHydro(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - OutData%TeetAng = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - i1_l = LBOUND(OutData%FrcVGnRtt,1) - i1_u = UBOUND(OutData%FrcVGnRtt,1) - DO i1 = LBOUND(OutData%FrcVGnRtt,1), UBOUND(OutData%FrcVGnRtt,1) - OutData%FrcVGnRtt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%FrcWTailt,1) - i1_u = UBOUND(OutData%FrcWTailt,1) - DO i1 = LBOUND(OutData%FrcWTailt,1), UBOUND(OutData%FrcWTailt,1) - OutData%FrcWTailt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%FrcZAllt,1) - i1_u = UBOUND(OutData%FrcZAllt,1) - DO i1 = LBOUND(OutData%FrcZAllt,1), UBOUND(OutData%FrcZAllt,1) - OutData%FrcZAllt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%MomXAllt,1) - i1_u = UBOUND(OutData%MomXAllt,1) - DO i1 = LBOUND(OutData%MomXAllt,1), UBOUND(OutData%MomXAllt,1) - OutData%MomXAllt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PFrcVGnRt not allocated - Int_Xferred = Int_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%PFrcVGnRt)) DEALLOCATE(OutData%PFrcVGnRt) - ALLOCATE(OutData%PFrcVGnRt(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PFrcVGnRt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PFrcVGnRt,2), UBOUND(OutData%PFrcVGnRt,2) - DO i1 = LBOUND(OutData%PFrcVGnRt,1), UBOUND(OutData%PFrcVGnRt,1) - OutData%PFrcVGnRt(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PFrcWTail not allocated - Int_Xferred = Int_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%PFrcWTail)) DEALLOCATE(OutData%PFrcWTail) - ALLOCATE(OutData%PFrcWTail(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PFrcWTail.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PFrcWTail,2), UBOUND(OutData%PFrcWTail,2) - DO i1 = LBOUND(OutData%PFrcWTail,1), UBOUND(OutData%PFrcWTail,1) - OutData%PFrcWTail(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PFrcZAll not allocated - Int_Xferred = Int_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%PFrcZAll)) DEALLOCATE(OutData%PFrcZAll) - ALLOCATE(OutData%PFrcZAll(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PFrcZAll.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PFrcZAll,2), UBOUND(OutData%PFrcZAll,2) - DO i1 = LBOUND(OutData%PFrcZAll,1), UBOUND(OutData%PFrcZAll,1) - OutData%PFrcZAll(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PMomXAll not allocated - Int_Xferred = Int_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%PMomXAll)) DEALLOCATE(OutData%PMomXAll) - ALLOCATE(OutData%PMomXAll(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PMomXAll.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PMomXAll,2), UBOUND(OutData%PMomXAll,2) - DO i1 = LBOUND(OutData%PMomXAll,1), UBOUND(OutData%PMomXAll,1) - OutData%PMomXAll(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%TeetMom = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlMom = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlMom = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%GBoxEffFac = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rSAerCen not allocated - Int_Xferred = Int_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%rSAerCen)) DEALLOCATE(OutData%rSAerCen) - ALLOCATE(OutData%rSAerCen(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%rSAerCen.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%rSAerCen,3), UBOUND(OutData%rSAerCen,3) - DO i2 = LBOUND(OutData%rSAerCen,2), UBOUND(OutData%rSAerCen,2) - DO i1 = LBOUND(OutData%rSAerCen,1), UBOUND(OutData%rSAerCen,1) - OutData%rSAerCen(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - END SUBROUTINE ED_UnPackRtHndSide - - SUBROUTINE ED_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ED_ContinuousStateType), INTENT(IN) :: SrcContStateData - TYPE(ED_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 = 'ED_CopyContState' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcContStateData%QT)) THEN - i1_l = LBOUND(SrcContStateData%QT,1) - i1_u = UBOUND(SrcContStateData%QT,1) - IF (.NOT. ALLOCATED(DstContStateData%QT)) THEN - ALLOCATE(DstContStateData%QT(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%QT.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstContStateData%QT = SrcContStateData%QT -ENDIF -IF (ALLOCATED(SrcContStateData%QDT)) THEN - i1_l = LBOUND(SrcContStateData%QDT,1) - i1_u = UBOUND(SrcContStateData%QDT,1) - IF (.NOT. ALLOCATED(DstContStateData%QDT)) THEN - ALLOCATE(DstContStateData%QDT(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%QDT.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstContStateData%QDT = SrcContStateData%QDT -ENDIF - END SUBROUTINE ED_CopyContState - - SUBROUTINE ED_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(ED_ContinuousStateType), INTENT(INOUT) :: ContStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_DestroyContState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(ContStateData%QT)) THEN - DEALLOCATE(ContStateData%QT) -ENDIF -IF (ALLOCATED(ContStateData%QDT)) THEN - DEALLOCATE(ContStateData%QDT) -ENDIF - END SUBROUTINE ED_DestroyContState - - SUBROUTINE ED_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(ED_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 = 'ED_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 ! QT allocated yes/no - IF ( ALLOCATED(InData%QT) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! QT upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%QT) ! QT - END IF - Int_BufSz = Int_BufSz + 1 ! QDT allocated yes/no - IF ( ALLOCATED(InData%QDT) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! QDT upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%QDT) ! QDT - 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%QT) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%QT,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%QT,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%QT,1), UBOUND(InData%QT,1) - DbKiBuf(Db_Xferred) = InData%QT(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%QDT) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%QDT,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%QDT,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%QDT,1), UBOUND(InData%QDT,1) - DbKiBuf(Db_Xferred) = InData%QDT(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE ED_PackContState - - SUBROUTINE ED_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(ED_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 = 'ED_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 ! QT not allocated - Int_Xferred = Int_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%QT)) DEALLOCATE(OutData%QT) - ALLOCATE(OutData%QT(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%QT.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%QT,1), UBOUND(OutData%QT,1) - OutData%QT(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! QDT not allocated - Int_Xferred = Int_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%QDT)) DEALLOCATE(OutData%QDT) - ALLOCATE(OutData%QDT(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%QDT.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%QDT,1), UBOUND(OutData%QDT,1) - OutData%QDT(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE ED_UnPackContState - - SUBROUTINE ED_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ED_DiscreteStateType), INTENT(IN) :: SrcDiscStateData - TYPE(ED_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 = 'ED_CopyDiscState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstDiscStateData%DummyDiscState = SrcDiscStateData%DummyDiscState - END SUBROUTINE ED_CopyDiscState - - SUBROUTINE ED_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(ED_DiscreteStateType), INTENT(INOUT) :: DiscStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_DestroyDiscState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE ED_DestroyDiscState - - SUBROUTINE ED_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(ED_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 = 'ED_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 ED_PackDiscState - - SUBROUTINE ED_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(ED_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 = 'ED_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 ED_UnPackDiscState - - SUBROUTINE ED_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ED_ConstraintStateType), INTENT(IN) :: SrcConstrStateData - TYPE(ED_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 = 'ED_CopyConstrState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState - END SUBROUTINE ED_CopyConstrState - - SUBROUTINE ED_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(ED_ConstraintStateType), INTENT(INOUT) :: ConstrStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_DestroyConstrState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE ED_DestroyConstrState - - SUBROUTINE ED_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(ED_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 = 'ED_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 ED_PackConstrState - - SUBROUTINE ED_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(ED_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 = 'ED_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 ED_UnPackConstrState - - SUBROUTINE ED_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ED_OtherStateType), INTENT(IN) :: SrcOtherStateData - TYPE(ED_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 = 'ED_CopyOtherState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstOtherStateData%n = SrcOtherStateData%n - DO i1 = LBOUND(SrcOtherStateData%xdot,1), UBOUND(SrcOtherStateData%xdot,1) - CALL ED_CopyContState( SrcOtherStateData%xdot(i1), DstOtherStateData%xdot(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -IF (ALLOCATED(SrcOtherStateData%IC)) THEN - i1_l = LBOUND(SrcOtherStateData%IC,1) - i1_u = UBOUND(SrcOtherStateData%IC,1) - IF (.NOT. ALLOCATED(DstOtherStateData%IC)) THEN - ALLOCATE(DstOtherStateData%IC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%IC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOtherStateData%IC = SrcOtherStateData%IC -ENDIF - DstOtherStateData%HSSBrTrq = SrcOtherStateData%HSSBrTrq - DstOtherStateData%HSSBrTrqC = SrcOtherStateData%HSSBrTrqC - DstOtherStateData%SgnPrvLSTQ = SrcOtherStateData%SgnPrvLSTQ - DstOtherStateData%SgnLSTQ = SrcOtherStateData%SgnLSTQ - END SUBROUTINE ED_CopyOtherState - - SUBROUTINE ED_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(ED_OtherStateType), INTENT(INOUT) :: OtherStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_DestroyOtherState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -DO i1 = LBOUND(OtherStateData%xdot,1), UBOUND(OtherStateData%xdot,1) - CALL ED_DestroyContState( OtherStateData%xdot(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -IF (ALLOCATED(OtherStateData%IC)) THEN - DEALLOCATE(OtherStateData%IC) -ENDIF - END SUBROUTINE ED_DestroyOtherState - - SUBROUTINE ED_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(ED_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 = 'ED_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 ! n - ! 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 ED_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 - Int_BufSz = Int_BufSz + 1 ! IC allocated yes/no - IF ( ALLOCATED(InData%IC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! IC upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%IC) ! IC - END IF - Re_BufSz = Re_BufSz + 1 ! HSSBrTrq - Re_BufSz = Re_BufSz + 1 ! HSSBrTrqC - Int_BufSz = Int_BufSz + 1 ! SgnPrvLSTQ - Int_BufSz = Int_BufSz + SIZE(InData%SgnLSTQ) ! SgnLSTQ - 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%n - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%xdot,1), UBOUND(InData%xdot,1) - CALL ED_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 - IF ( .NOT. ALLOCATED(InData%IC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%IC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%IC,1), UBOUND(InData%IC,1) - IntKiBuf(Int_Xferred) = InData%IC(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%HSSBrTrq - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%HSSBrTrqC - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%SgnPrvLSTQ - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%SgnLSTQ,1), UBOUND(InData%SgnLSTQ,1) - IntKiBuf(Int_Xferred) = InData%SgnLSTQ(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END SUBROUTINE ED_PackOtherState - - SUBROUTINE ED_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(ED_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 = 'ED_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%n = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%xdot,1) - i1_u = UBOUND(OutData%xdot,1) - 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 ED_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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IC not allocated - Int_Xferred = Int_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%IC)) DEALLOCATE(OutData%IC) - ALLOCATE(OutData%IC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%IC,1), UBOUND(OutData%IC,1) - OutData%IC(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - OutData%HSSBrTrq = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%HSSBrTrqC = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SgnPrvLSTQ = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%SgnLSTQ,1) - i1_u = UBOUND(OutData%SgnLSTQ,1) - DO i1 = LBOUND(OutData%SgnLSTQ,1), UBOUND(OutData%SgnLSTQ,1) - OutData%SgnLSTQ(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END SUBROUTINE ED_UnPackOtherState - - SUBROUTINE ED_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ED_MiscVarType), INTENT(IN) :: SrcMiscData - TYPE(ED_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 = 'ED_CopyMisc' -! - ErrStat = ErrID_None - ErrMsg = "" - CALL ED_Copycoordsys( SrcMiscData%CoordSys, DstMiscData%CoordSys, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL ED_Copyrthndside( SrcMiscData%RtHS, DstMiscData%RtHS, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -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 -IF (ALLOCATED(SrcMiscData%AugMat)) THEN - i1_l = LBOUND(SrcMiscData%AugMat,1) - i1_u = UBOUND(SrcMiscData%AugMat,1) - i2_l = LBOUND(SrcMiscData%AugMat,2) - i2_u = UBOUND(SrcMiscData%AugMat,2) - IF (.NOT. ALLOCATED(DstMiscData%AugMat)) THEN - ALLOCATE(DstMiscData%AugMat(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%AugMat.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%AugMat = SrcMiscData%AugMat -ENDIF -IF (ALLOCATED(SrcMiscData%AugMat_factor)) THEN - i1_l = LBOUND(SrcMiscData%AugMat_factor,1) - i1_u = UBOUND(SrcMiscData%AugMat_factor,1) - i2_l = LBOUND(SrcMiscData%AugMat_factor,2) - i2_u = UBOUND(SrcMiscData%AugMat_factor,2) - IF (.NOT. ALLOCATED(DstMiscData%AugMat_factor)) THEN - ALLOCATE(DstMiscData%AugMat_factor(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%AugMat_factor.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%AugMat_factor = SrcMiscData%AugMat_factor -ENDIF -IF (ALLOCATED(SrcMiscData%SolnVec)) THEN - i1_l = LBOUND(SrcMiscData%SolnVec,1) - i1_u = UBOUND(SrcMiscData%SolnVec,1) - IF (.NOT. ALLOCATED(DstMiscData%SolnVec)) THEN - ALLOCATE(DstMiscData%SolnVec(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SolnVec.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%SolnVec = SrcMiscData%SolnVec -ENDIF -IF (ALLOCATED(SrcMiscData%AugMat_pivot)) THEN - i1_l = LBOUND(SrcMiscData%AugMat_pivot,1) - i1_u = UBOUND(SrcMiscData%AugMat_pivot,1) - IF (.NOT. ALLOCATED(DstMiscData%AugMat_pivot)) THEN - ALLOCATE(DstMiscData%AugMat_pivot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%AugMat_pivot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%AugMat_pivot = SrcMiscData%AugMat_pivot -ENDIF -IF (ALLOCATED(SrcMiscData%OgnlGeAzRo)) THEN - i1_l = LBOUND(SrcMiscData%OgnlGeAzRo,1) - i1_u = UBOUND(SrcMiscData%OgnlGeAzRo,1) - IF (.NOT. ALLOCATED(DstMiscData%OgnlGeAzRo)) THEN - ALLOCATE(DstMiscData%OgnlGeAzRo(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%OgnlGeAzRo.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%OgnlGeAzRo = SrcMiscData%OgnlGeAzRo -ENDIF -IF (ALLOCATED(SrcMiscData%QD2T)) THEN - i1_l = LBOUND(SrcMiscData%QD2T,1) - i1_u = UBOUND(SrcMiscData%QD2T,1) - IF (.NOT. ALLOCATED(DstMiscData%QD2T)) THEN - ALLOCATE(DstMiscData%QD2T(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%QD2T.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%QD2T = SrcMiscData%QD2T -ENDIF - DstMiscData%IgnoreMod = SrcMiscData%IgnoreMod - END SUBROUTINE ED_CopyMisc - - SUBROUTINE ED_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(ED_MiscVarType), INTENT(INOUT) :: MiscData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_DestroyMisc' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL ED_Destroycoordsys( MiscData%CoordSys, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL ED_Destroyrthndside( MiscData%RtHS, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(MiscData%AllOuts)) THEN - DEALLOCATE(MiscData%AllOuts) -ENDIF -IF (ALLOCATED(MiscData%AugMat)) THEN - DEALLOCATE(MiscData%AugMat) -ENDIF -IF (ALLOCATED(MiscData%AugMat_factor)) THEN - DEALLOCATE(MiscData%AugMat_factor) -ENDIF -IF (ALLOCATED(MiscData%SolnVec)) THEN - DEALLOCATE(MiscData%SolnVec) -ENDIF -IF (ALLOCATED(MiscData%AugMat_pivot)) THEN - DEALLOCATE(MiscData%AugMat_pivot) -ENDIF -IF (ALLOCATED(MiscData%OgnlGeAzRo)) THEN - DEALLOCATE(MiscData%OgnlGeAzRo) -ENDIF -IF (ALLOCATED(MiscData%QD2T)) THEN - DEALLOCATE(MiscData%QD2T) -ENDIF - END SUBROUTINE ED_DestroyMisc - - SUBROUTINE ED_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(ED_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 = 'ED_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 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! CoordSys: size of buffers for each call to pack subtype - CALL ED_Packcoordsys( Re_Buf, Db_Buf, Int_Buf, InData%CoordSys, ErrStat2, ErrMsg2, .TRUE. ) ! CoordSys - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! CoordSys - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! CoordSys - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! CoordSys - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! RtHS: size of buffers for each call to pack subtype - CALL ED_Packrthndside( Re_Buf, Db_Buf, Int_Buf, InData%RtHS, ErrStat2, ErrMsg2, .TRUE. ) ! RtHS - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! RtHS - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! RtHS - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! RtHS - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - 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 - Int_BufSz = Int_BufSz + 1 ! AugMat allocated yes/no - IF ( ALLOCATED(InData%AugMat) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! AugMat upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%AugMat) ! AugMat - END IF - Int_BufSz = Int_BufSz + 1 ! AugMat_factor allocated yes/no - IF ( ALLOCATED(InData%AugMat_factor) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! AugMat_factor upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%AugMat_factor) ! AugMat_factor - END IF - Int_BufSz = Int_BufSz + 1 ! SolnVec allocated yes/no - IF ( ALLOCATED(InData%SolnVec) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! SolnVec upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%SolnVec) ! SolnVec - END IF - Int_BufSz = Int_BufSz + 1 ! AugMat_pivot allocated yes/no - IF ( ALLOCATED(InData%AugMat_pivot) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! AugMat_pivot upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%AugMat_pivot) ! AugMat_pivot - END IF - Int_BufSz = Int_BufSz + 1 ! OgnlGeAzRo allocated yes/no - IF ( ALLOCATED(InData%OgnlGeAzRo) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OgnlGeAzRo upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%OgnlGeAzRo) ! OgnlGeAzRo - END IF - Int_BufSz = Int_BufSz + 1 ! QD2T allocated yes/no - IF ( ALLOCATED(InData%QD2T) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! QD2T upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%QD2T) ! QD2T - END IF - Int_BufSz = Int_BufSz + 1 ! IgnoreMod - 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 ED_Packcoordsys( Re_Buf, Db_Buf, Int_Buf, InData%CoordSys, ErrStat2, ErrMsg2, OnlySize ) ! CoordSys - 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 ED_Packrthndside( Re_Buf, Db_Buf, Int_Buf, InData%RtHS, ErrStat2, ErrMsg2, OnlySize ) ! RtHS - 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%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 - IF ( .NOT. ALLOCATED(InData%AugMat) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AugMat,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AugMat,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AugMat,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AugMat,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%AugMat,2), UBOUND(InData%AugMat,2) - DO i1 = LBOUND(InData%AugMat,1), UBOUND(InData%AugMat,1) - DbKiBuf(Db_Xferred) = InData%AugMat(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AugMat_factor) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AugMat_factor,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AugMat_factor,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AugMat_factor,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AugMat_factor,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%AugMat_factor,2), UBOUND(InData%AugMat_factor,2) - DO i1 = LBOUND(InData%AugMat_factor,1), UBOUND(InData%AugMat_factor,1) - DbKiBuf(Db_Xferred) = InData%AugMat_factor(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%SolnVec) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SolnVec,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SolnVec,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%SolnVec,1), UBOUND(InData%SolnVec,1) - DbKiBuf(Db_Xferred) = InData%SolnVec(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AugMat_pivot) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AugMat_pivot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AugMat_pivot,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%AugMat_pivot,1), UBOUND(InData%AugMat_pivot,1) - IntKiBuf(Int_Xferred) = InData%AugMat_pivot(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%OgnlGeAzRo) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OgnlGeAzRo,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OgnlGeAzRo,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%OgnlGeAzRo,1), UBOUND(InData%OgnlGeAzRo,1) - ReKiBuf(Re_Xferred) = InData%OgnlGeAzRo(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%QD2T) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%QD2T,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%QD2T,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%QD2T,1), UBOUND(InData%QD2T,1) - DbKiBuf(Db_Xferred) = InData%QD2T(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = TRANSFER(InData%IgnoreMod, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE ED_PackMisc - - SUBROUTINE ED_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(ED_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 = 'ED_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 - 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 ED_Unpackcoordsys( Re_Buf, Db_Buf, Int_Buf, OutData%CoordSys, ErrStat2, ErrMsg2 ) ! CoordSys - 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 ED_Unpackrthndside( Re_Buf, Db_Buf, Int_Buf, OutData%RtHS, ErrStat2, ErrMsg2 ) ! RtHS - 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 ! 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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AugMat not allocated - Int_Xferred = Int_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%AugMat)) DEALLOCATE(OutData%AugMat) - ALLOCATE(OutData%AugMat(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AugMat.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%AugMat,2), UBOUND(OutData%AugMat,2) - DO i1 = LBOUND(OutData%AugMat,1), UBOUND(OutData%AugMat,1) - OutData%AugMat(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AugMat_factor not allocated - Int_Xferred = Int_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%AugMat_factor)) DEALLOCATE(OutData%AugMat_factor) - ALLOCATE(OutData%AugMat_factor(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AugMat_factor.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%AugMat_factor,2), UBOUND(OutData%AugMat_factor,2) - DO i1 = LBOUND(OutData%AugMat_factor,1), UBOUND(OutData%AugMat_factor,1) - OutData%AugMat_factor(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SolnVec not allocated - Int_Xferred = Int_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%SolnVec)) DEALLOCATE(OutData%SolnVec) - ALLOCATE(OutData%SolnVec(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SolnVec.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%SolnVec,1), UBOUND(OutData%SolnVec,1) - OutData%SolnVec(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AugMat_pivot not allocated - Int_Xferred = Int_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%AugMat_pivot)) DEALLOCATE(OutData%AugMat_pivot) - ALLOCATE(OutData%AugMat_pivot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AugMat_pivot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%AugMat_pivot,1), UBOUND(OutData%AugMat_pivot,1) - OutData%AugMat_pivot(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OgnlGeAzRo not allocated - Int_Xferred = Int_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%OgnlGeAzRo)) DEALLOCATE(OutData%OgnlGeAzRo) - ALLOCATE(OutData%OgnlGeAzRo(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OgnlGeAzRo.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%OgnlGeAzRo,1), UBOUND(OutData%OgnlGeAzRo,1) - OutData%OgnlGeAzRo(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! QD2T not allocated - Int_Xferred = Int_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%QD2T)) DEALLOCATE(OutData%QD2T) - ALLOCATE(OutData%QD2T(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%QD2T.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%QD2T,1), UBOUND(OutData%QD2T,1) - OutData%QD2T(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - OutData%IgnoreMod = TRANSFER(IntKiBuf(Int_Xferred), OutData%IgnoreMod) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE ED_UnPackMisc - - SUBROUTINE ED_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ED_ParameterType), INTENT(IN) :: SrcParamData - TYPE(ED_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) :: 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) :: i5, i5_l, i5_u ! bounds (upper/lower) for an array dimension 5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_CopyParam' -! - ErrStat = ErrID_None - ErrMsg = "" - DstParamData%DT = SrcParamData%DT - DstParamData%DT24 = SrcParamData%DT24 - DstParamData%BldNodes = SrcParamData%BldNodes - DstParamData%TipNode = SrcParamData%TipNode - DstParamData%NDOF = SrcParamData%NDOF - DstParamData%TwoPiNB = SrcParamData%TwoPiNB - DstParamData%NAug = SrcParamData%NAug - DstParamData%NPH = SrcParamData%NPH -IF (ALLOCATED(SrcParamData%PH)) THEN - i1_l = LBOUND(SrcParamData%PH,1) - i1_u = UBOUND(SrcParamData%PH,1) - IF (.NOT. ALLOCATED(DstParamData%PH)) THEN - ALLOCATE(DstParamData%PH(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%PH.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%PH = SrcParamData%PH -ENDIF - DstParamData%NPM = SrcParamData%NPM -IF (ALLOCATED(SrcParamData%PM)) THEN - i1_l = LBOUND(SrcParamData%PM,1) - i1_u = UBOUND(SrcParamData%PM,1) - i2_l = LBOUND(SrcParamData%PM,2) - i2_u = UBOUND(SrcParamData%PM,2) - IF (.NOT. ALLOCATED(DstParamData%PM)) THEN - ALLOCATE(DstParamData%PM(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%PM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%PM = SrcParamData%PM -ENDIF -IF (ALLOCATED(SrcParamData%DOF_Flag)) THEN - i1_l = LBOUND(SrcParamData%DOF_Flag,1) - i1_u = UBOUND(SrcParamData%DOF_Flag,1) - IF (.NOT. ALLOCATED(DstParamData%DOF_Flag)) THEN - ALLOCATE(DstParamData%DOF_Flag(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%DOF_Flag.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%DOF_Flag = SrcParamData%DOF_Flag -ENDIF -IF (ALLOCATED(SrcParamData%DOF_Desc)) THEN - i1_l = LBOUND(SrcParamData%DOF_Desc,1) - i1_u = UBOUND(SrcParamData%DOF_Desc,1) - IF (.NOT. ALLOCATED(DstParamData%DOF_Desc)) THEN - ALLOCATE(DstParamData%DOF_Desc(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%DOF_Desc.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%DOF_Desc = SrcParamData%DOF_Desc -ENDIF - CALL ED_Copyactivedofs( SrcParamData%DOFs, DstParamData%DOFs, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstParamData%NumOuts = SrcParamData%NumOuts - DstParamData%OutFmt = SrcParamData%OutFmt - DstParamData%NBlGages = SrcParamData%NBlGages - DstParamData%NTwGages = SrcParamData%NTwGages -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%AvgNrmTpRd = SrcParamData%AvgNrmTpRd - DstParamData%AzimB1Up = SrcParamData%AzimB1Up - DstParamData%CosDel3 = SrcParamData%CosDel3 -IF (ALLOCATED(SrcParamData%CosPreC)) THEN - i1_l = LBOUND(SrcParamData%CosPreC,1) - i1_u = UBOUND(SrcParamData%CosPreC,1) - IF (.NOT. ALLOCATED(DstParamData%CosPreC)) THEN - ALLOCATE(DstParamData%CosPreC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CosPreC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%CosPreC = SrcParamData%CosPreC -ENDIF - DstParamData%CRFrlSkew = SrcParamData%CRFrlSkew - DstParamData%CRFrlSkw2 = SrcParamData%CRFrlSkw2 - DstParamData%CRFrlTilt = SrcParamData%CRFrlTilt - DstParamData%CRFrlTlt2 = SrcParamData%CRFrlTlt2 - DstParamData%CShftSkew = SrcParamData%CShftSkew - DstParamData%CShftTilt = SrcParamData%CShftTilt - DstParamData%CSRFrlSkw = SrcParamData%CSRFrlSkw - DstParamData%CSRFrlTlt = SrcParamData%CSRFrlTlt - DstParamData%CSTFrlSkw = SrcParamData%CSTFrlSkw - DstParamData%CSTFrlTlt = SrcParamData%CSTFrlTlt - DstParamData%CTFrlSkew = SrcParamData%CTFrlSkew - DstParamData%CTFrlSkw2 = SrcParamData%CTFrlSkw2 - DstParamData%CTFrlTilt = SrcParamData%CTFrlTilt - DstParamData%CTFrlTlt2 = SrcParamData%CTFrlTlt2 - DstParamData%HubHt = SrcParamData%HubHt - DstParamData%HubCM = SrcParamData%HubCM - DstParamData%HubRad = SrcParamData%HubRad - DstParamData%NacCMxn = SrcParamData%NacCMxn - DstParamData%NacCMyn = SrcParamData%NacCMyn - DstParamData%NacCMzn = SrcParamData%NacCMzn - DstParamData%OverHang = SrcParamData%OverHang - DstParamData%ProjArea = SrcParamData%ProjArea - DstParamData%PtfmRefzt = SrcParamData%PtfmRefzt - DstParamData%RefTwrHt = SrcParamData%RefTwrHt - DstParamData%RFrlPnt_n = SrcParamData%RFrlPnt_n - DstParamData%rVDxn = SrcParamData%rVDxn - DstParamData%rVDyn = SrcParamData%rVDyn - DstParamData%rVDzn = SrcParamData%rVDzn - DstParamData%rVIMUxn = SrcParamData%rVIMUxn - DstParamData%rVIMUyn = SrcParamData%rVIMUyn - DstParamData%rVIMUzn = SrcParamData%rVIMUzn - DstParamData%rVPxn = SrcParamData%rVPxn - DstParamData%rVPyn = SrcParamData%rVPyn - DstParamData%rVPzn = SrcParamData%rVPzn - DstParamData%rWIxn = SrcParamData%rWIxn - DstParamData%rWIyn = SrcParamData%rWIyn - DstParamData%rWIzn = SrcParamData%rWIzn - DstParamData%rWJxn = SrcParamData%rWJxn - DstParamData%rWJyn = SrcParamData%rWJyn - DstParamData%rWJzn = SrcParamData%rWJzn - DstParamData%rZT0zt = SrcParamData%rZT0zt - DstParamData%rZYzt = SrcParamData%rZYzt - DstParamData%SinDel3 = SrcParamData%SinDel3 -IF (ALLOCATED(SrcParamData%SinPreC)) THEN - i1_l = LBOUND(SrcParamData%SinPreC,1) - i1_u = UBOUND(SrcParamData%SinPreC,1) - IF (.NOT. ALLOCATED(DstParamData%SinPreC)) THEN - ALLOCATE(DstParamData%SinPreC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%SinPreC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%SinPreC = SrcParamData%SinPreC -ENDIF - DstParamData%SRFrlSkew = SrcParamData%SRFrlSkew - DstParamData%SRFrlSkw2 = SrcParamData%SRFrlSkw2 - DstParamData%SRFrlTilt = SrcParamData%SRFrlTilt - DstParamData%SRFrlTlt2 = SrcParamData%SRFrlTlt2 - DstParamData%SShftSkew = SrcParamData%SShftSkew - DstParamData%SShftTilt = SrcParamData%SShftTilt - DstParamData%STFrlSkew = SrcParamData%STFrlSkew - DstParamData%STFrlSkw2 = SrcParamData%STFrlSkw2 - DstParamData%STFrlTilt = SrcParamData%STFrlTilt - DstParamData%STFrlTlt2 = SrcParamData%STFrlTlt2 - DstParamData%TFrlPnt_n = SrcParamData%TFrlPnt_n - DstParamData%TipRad = SrcParamData%TipRad - DstParamData%TowerHt = SrcParamData%TowerHt - DstParamData%TowerBsHt = SrcParamData%TowerBsHt - DstParamData%UndSling = SrcParamData%UndSling - DstParamData%NumBl = SrcParamData%NumBl -IF (ALLOCATED(SrcParamData%AxRedTFA)) THEN - i1_l = LBOUND(SrcParamData%AxRedTFA,1) - i1_u = UBOUND(SrcParamData%AxRedTFA,1) - i2_l = LBOUND(SrcParamData%AxRedTFA,2) - i2_u = UBOUND(SrcParamData%AxRedTFA,2) - i3_l = LBOUND(SrcParamData%AxRedTFA,3) - i3_u = UBOUND(SrcParamData%AxRedTFA,3) - IF (.NOT. ALLOCATED(DstParamData%AxRedTFA)) THEN - ALLOCATE(DstParamData%AxRedTFA(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AxRedTFA.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%AxRedTFA = SrcParamData%AxRedTFA -ENDIF -IF (ALLOCATED(SrcParamData%AxRedTSS)) THEN - i1_l = LBOUND(SrcParamData%AxRedTSS,1) - i1_u = UBOUND(SrcParamData%AxRedTSS,1) - i2_l = LBOUND(SrcParamData%AxRedTSS,2) - i2_u = UBOUND(SrcParamData%AxRedTSS,2) - i3_l = LBOUND(SrcParamData%AxRedTSS,3) - i3_u = UBOUND(SrcParamData%AxRedTSS,3) - IF (.NOT. ALLOCATED(DstParamData%AxRedTSS)) THEN - ALLOCATE(DstParamData%AxRedTSS(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AxRedTSS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%AxRedTSS = SrcParamData%AxRedTSS -ENDIF - DstParamData%CTFA = SrcParamData%CTFA - DstParamData%CTSS = SrcParamData%CTSS -IF (ALLOCATED(SrcParamData%DHNodes)) THEN - i1_l = LBOUND(SrcParamData%DHNodes,1) - i1_u = UBOUND(SrcParamData%DHNodes,1) - IF (.NOT. ALLOCATED(DstParamData%DHNodes)) THEN - ALLOCATE(DstParamData%DHNodes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%DHNodes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%DHNodes = SrcParamData%DHNodes -ENDIF -IF (ALLOCATED(SrcParamData%HNodes)) THEN - i1_l = LBOUND(SrcParamData%HNodes,1) - i1_u = UBOUND(SrcParamData%HNodes,1) - IF (.NOT. ALLOCATED(DstParamData%HNodes)) THEN - ALLOCATE(DstParamData%HNodes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%HNodes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%HNodes = SrcParamData%HNodes -ENDIF -IF (ALLOCATED(SrcParamData%HNodesNorm)) THEN - i1_l = LBOUND(SrcParamData%HNodesNorm,1) - i1_u = UBOUND(SrcParamData%HNodesNorm,1) - IF (.NOT. ALLOCATED(DstParamData%HNodesNorm)) THEN - ALLOCATE(DstParamData%HNodesNorm(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%HNodesNorm.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%HNodesNorm = SrcParamData%HNodesNorm -ENDIF - DstParamData%KTFA = SrcParamData%KTFA - DstParamData%KTSS = SrcParamData%KTSS -IF (ALLOCATED(SrcParamData%MassT)) THEN - i1_l = LBOUND(SrcParamData%MassT,1) - i1_u = UBOUND(SrcParamData%MassT,1) - IF (.NOT. ALLOCATED(DstParamData%MassT)) THEN - ALLOCATE(DstParamData%MassT(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%MassT.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%MassT = SrcParamData%MassT -ENDIF -IF (ALLOCATED(SrcParamData%StiffTSS)) THEN - i1_l = LBOUND(SrcParamData%StiffTSS,1) - i1_u = UBOUND(SrcParamData%StiffTSS,1) - IF (.NOT. ALLOCATED(DstParamData%StiffTSS)) THEN - ALLOCATE(DstParamData%StiffTSS(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%StiffTSS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%StiffTSS = SrcParamData%StiffTSS -ENDIF -IF (ALLOCATED(SrcParamData%TwrFASF)) THEN - i1_l = LBOUND(SrcParamData%TwrFASF,1) - i1_u = UBOUND(SrcParamData%TwrFASF,1) - i2_l = LBOUND(SrcParamData%TwrFASF,2) - i2_u = UBOUND(SrcParamData%TwrFASF,2) - i3_l = LBOUND(SrcParamData%TwrFASF,3) - i3_u = UBOUND(SrcParamData%TwrFASF,3) - IF (.NOT. ALLOCATED(DstParamData%TwrFASF)) THEN - ALLOCATE(DstParamData%TwrFASF(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TwrFASF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%TwrFASF = SrcParamData%TwrFASF -ENDIF - DstParamData%TwrFlexL = SrcParamData%TwrFlexL -IF (ALLOCATED(SrcParamData%TwrSSSF)) THEN - i1_l = LBOUND(SrcParamData%TwrSSSF,1) - i1_u = UBOUND(SrcParamData%TwrSSSF,1) - i2_l = LBOUND(SrcParamData%TwrSSSF,2) - i2_u = UBOUND(SrcParamData%TwrSSSF,2) - i3_l = LBOUND(SrcParamData%TwrSSSF,3) - i3_u = UBOUND(SrcParamData%TwrSSSF,3) - IF (.NOT. ALLOCATED(DstParamData%TwrSSSF)) THEN - ALLOCATE(DstParamData%TwrSSSF(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TwrSSSF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%TwrSSSF = SrcParamData%TwrSSSF -ENDIF - DstParamData%TTopNode = SrcParamData%TTopNode - DstParamData%TwrNodes = SrcParamData%TwrNodes - DstParamData%MHK = SrcParamData%MHK -IF (ALLOCATED(SrcParamData%StiffTFA)) THEN - i1_l = LBOUND(SrcParamData%StiffTFA,1) - i1_u = UBOUND(SrcParamData%StiffTFA,1) - IF (.NOT. ALLOCATED(DstParamData%StiffTFA)) THEN - ALLOCATE(DstParamData%StiffTFA(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%StiffTFA.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%StiffTFA = SrcParamData%StiffTFA -ENDIF - DstParamData%AtfaIner = SrcParamData%AtfaIner -IF (ALLOCATED(SrcParamData%BldCG)) THEN - i1_l = LBOUND(SrcParamData%BldCG,1) - i1_u = UBOUND(SrcParamData%BldCG,1) - IF (.NOT. ALLOCATED(DstParamData%BldCG)) THEN - ALLOCATE(DstParamData%BldCG(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BldCG.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%BldCG = SrcParamData%BldCG -ENDIF -IF (ALLOCATED(SrcParamData%BldMass)) THEN - i1_l = LBOUND(SrcParamData%BldMass,1) - i1_u = UBOUND(SrcParamData%BldMass,1) - IF (.NOT. ALLOCATED(DstParamData%BldMass)) THEN - ALLOCATE(DstParamData%BldMass(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BldMass.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%BldMass = SrcParamData%BldMass -ENDIF - DstParamData%BoomMass = SrcParamData%BoomMass -IF (ALLOCATED(SrcParamData%FirstMom)) THEN - i1_l = LBOUND(SrcParamData%FirstMom,1) - i1_u = UBOUND(SrcParamData%FirstMom,1) - IF (.NOT. ALLOCATED(DstParamData%FirstMom)) THEN - ALLOCATE(DstParamData%FirstMom(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%FirstMom.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%FirstMom = SrcParamData%FirstMom -ENDIF - DstParamData%GenIner = SrcParamData%GenIner - DstParamData%Hubg1Iner = SrcParamData%Hubg1Iner - DstParamData%Hubg2Iner = SrcParamData%Hubg2Iner - DstParamData%HubMass = SrcParamData%HubMass - DstParamData%Nacd2Iner = SrcParamData%Nacd2Iner - DstParamData%NacMass = SrcParamData%NacMass - DstParamData%PtfmMass = SrcParamData%PtfmMass - DstParamData%PtfmPIner = SrcParamData%PtfmPIner - DstParamData%PtfmRIner = SrcParamData%PtfmRIner - DstParamData%PtfmYIner = SrcParamData%PtfmYIner - DstParamData%RFrlMass = SrcParamData%RFrlMass - DstParamData%RotIner = SrcParamData%RotIner - DstParamData%RotMass = SrcParamData%RotMass - DstParamData%RrfaIner = SrcParamData%RrfaIner -IF (ALLOCATED(SrcParamData%SecondMom)) THEN - i1_l = LBOUND(SrcParamData%SecondMom,1) - i1_u = UBOUND(SrcParamData%SecondMom,1) - IF (.NOT. ALLOCATED(DstParamData%SecondMom)) THEN - ALLOCATE(DstParamData%SecondMom(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%SecondMom.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%SecondMom = SrcParamData%SecondMom -ENDIF - DstParamData%TFinMass = SrcParamData%TFinMass - DstParamData%TFrlIner = SrcParamData%TFrlIner -IF (ALLOCATED(SrcParamData%TipMass)) THEN - i1_l = LBOUND(SrcParamData%TipMass,1) - i1_u = UBOUND(SrcParamData%TipMass,1) - IF (.NOT. ALLOCATED(DstParamData%TipMass)) THEN - ALLOCATE(DstParamData%TipMass(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TipMass.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%TipMass = SrcParamData%TipMass -ENDIF - DstParamData%TurbMass = SrcParamData%TurbMass - DstParamData%TwrMass = SrcParamData%TwrMass - DstParamData%TwrTpMass = SrcParamData%TwrTpMass - DstParamData%YawBrMass = SrcParamData%YawBrMass - DstParamData%Gravity = SrcParamData%Gravity -IF (ALLOCATED(SrcParamData%PitchAxis)) THEN - i1_l = LBOUND(SrcParamData%PitchAxis,1) - i1_u = UBOUND(SrcParamData%PitchAxis,1) - i2_l = LBOUND(SrcParamData%PitchAxis,2) - i2_u = UBOUND(SrcParamData%PitchAxis,2) - IF (.NOT. ALLOCATED(DstParamData%PitchAxis)) THEN - ALLOCATE(DstParamData%PitchAxis(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%PitchAxis.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%PitchAxis = SrcParamData%PitchAxis -ENDIF -IF (ALLOCATED(SrcParamData%AeroTwst)) THEN - i1_l = LBOUND(SrcParamData%AeroTwst,1) - i1_u = UBOUND(SrcParamData%AeroTwst,1) - IF (.NOT. ALLOCATED(DstParamData%AeroTwst)) THEN - ALLOCATE(DstParamData%AeroTwst(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AeroTwst.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%AeroTwst = SrcParamData%AeroTwst -ENDIF -IF (ALLOCATED(SrcParamData%AxRedBld)) THEN - i1_l = LBOUND(SrcParamData%AxRedBld,1) - i1_u = UBOUND(SrcParamData%AxRedBld,1) - i2_l = LBOUND(SrcParamData%AxRedBld,2) - i2_u = UBOUND(SrcParamData%AxRedBld,2) - i3_l = LBOUND(SrcParamData%AxRedBld,3) - i3_u = UBOUND(SrcParamData%AxRedBld,3) - i4_l = LBOUND(SrcParamData%AxRedBld,4) - i4_u = UBOUND(SrcParamData%AxRedBld,4) - IF (.NOT. ALLOCATED(DstParamData%AxRedBld)) THEN - ALLOCATE(DstParamData%AxRedBld(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 DstParamData%AxRedBld.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%AxRedBld = SrcParamData%AxRedBld -ENDIF -IF (ALLOCATED(SrcParamData%BldEDamp)) THEN - i1_l = LBOUND(SrcParamData%BldEDamp,1) - i1_u = UBOUND(SrcParamData%BldEDamp,1) - i2_l = LBOUND(SrcParamData%BldEDamp,2) - i2_u = UBOUND(SrcParamData%BldEDamp,2) - IF (.NOT. ALLOCATED(DstParamData%BldEDamp)) THEN - ALLOCATE(DstParamData%BldEDamp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BldEDamp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%BldEDamp = SrcParamData%BldEDamp -ENDIF -IF (ALLOCATED(SrcParamData%BldFDamp)) THEN - i1_l = LBOUND(SrcParamData%BldFDamp,1) - i1_u = UBOUND(SrcParamData%BldFDamp,1) - i2_l = LBOUND(SrcParamData%BldFDamp,2) - i2_u = UBOUND(SrcParamData%BldFDamp,2) - IF (.NOT. ALLOCATED(DstParamData%BldFDamp)) THEN - ALLOCATE(DstParamData%BldFDamp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BldFDamp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%BldFDamp = SrcParamData%BldFDamp -ENDIF - DstParamData%BldFlexL = SrcParamData%BldFlexL -IF (ALLOCATED(SrcParamData%CAeroTwst)) THEN - i1_l = LBOUND(SrcParamData%CAeroTwst,1) - i1_u = UBOUND(SrcParamData%CAeroTwst,1) - IF (.NOT. ALLOCATED(DstParamData%CAeroTwst)) THEN - ALLOCATE(DstParamData%CAeroTwst(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CAeroTwst.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%CAeroTwst = SrcParamData%CAeroTwst -ENDIF -IF (ALLOCATED(SrcParamData%CBE)) THEN - i1_l = LBOUND(SrcParamData%CBE,1) - i1_u = UBOUND(SrcParamData%CBE,1) - i2_l = LBOUND(SrcParamData%CBE,2) - i2_u = UBOUND(SrcParamData%CBE,2) - i3_l = LBOUND(SrcParamData%CBE,3) - i3_u = UBOUND(SrcParamData%CBE,3) - IF (.NOT. ALLOCATED(DstParamData%CBE)) THEN - ALLOCATE(DstParamData%CBE(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CBE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%CBE = SrcParamData%CBE -ENDIF -IF (ALLOCATED(SrcParamData%CBF)) THEN - i1_l = LBOUND(SrcParamData%CBF,1) - i1_u = UBOUND(SrcParamData%CBF,1) - i2_l = LBOUND(SrcParamData%CBF,2) - i2_u = UBOUND(SrcParamData%CBF,2) - i3_l = LBOUND(SrcParamData%CBF,3) - i3_u = UBOUND(SrcParamData%CBF,3) - IF (.NOT. ALLOCATED(DstParamData%CBF)) THEN - ALLOCATE(DstParamData%CBF(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CBF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%CBF = SrcParamData%CBF -ENDIF -IF (ALLOCATED(SrcParamData%Chord)) THEN - i1_l = LBOUND(SrcParamData%Chord,1) - i1_u = UBOUND(SrcParamData%Chord,1) - IF (.NOT. ALLOCATED(DstParamData%Chord)) THEN - ALLOCATE(DstParamData%Chord(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Chord.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Chord = SrcParamData%Chord -ENDIF -IF (ALLOCATED(SrcParamData%CThetaS)) THEN - i1_l = LBOUND(SrcParamData%CThetaS,1) - i1_u = UBOUND(SrcParamData%CThetaS,1) - i2_l = LBOUND(SrcParamData%CThetaS,2) - i2_u = UBOUND(SrcParamData%CThetaS,2) - IF (.NOT. ALLOCATED(DstParamData%CThetaS)) THEN - ALLOCATE(DstParamData%CThetaS(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CThetaS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%CThetaS = SrcParamData%CThetaS -ENDIF -IF (ALLOCATED(SrcParamData%DRNodes)) THEN - i1_l = LBOUND(SrcParamData%DRNodes,1) - i1_u = UBOUND(SrcParamData%DRNodes,1) - IF (.NOT. ALLOCATED(DstParamData%DRNodes)) THEN - ALLOCATE(DstParamData%DRNodes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%DRNodes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%DRNodes = SrcParamData%DRNodes -ENDIF -IF (ALLOCATED(SrcParamData%FStTunr)) THEN - i1_l = LBOUND(SrcParamData%FStTunr,1) - i1_u = UBOUND(SrcParamData%FStTunr,1) - i2_l = LBOUND(SrcParamData%FStTunr,2) - i2_u = UBOUND(SrcParamData%FStTunr,2) - IF (.NOT. ALLOCATED(DstParamData%FStTunr)) THEN - ALLOCATE(DstParamData%FStTunr(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%FStTunr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%FStTunr = SrcParamData%FStTunr -ENDIF -IF (ALLOCATED(SrcParamData%KBE)) THEN - i1_l = LBOUND(SrcParamData%KBE,1) - i1_u = UBOUND(SrcParamData%KBE,1) - i2_l = LBOUND(SrcParamData%KBE,2) - i2_u = UBOUND(SrcParamData%KBE,2) - i3_l = LBOUND(SrcParamData%KBE,3) - i3_u = UBOUND(SrcParamData%KBE,3) - IF (.NOT. ALLOCATED(DstParamData%KBE)) THEN - ALLOCATE(DstParamData%KBE(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%KBE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%KBE = SrcParamData%KBE -ENDIF -IF (ALLOCATED(SrcParamData%KBF)) THEN - i1_l = LBOUND(SrcParamData%KBF,1) - i1_u = UBOUND(SrcParamData%KBF,1) - i2_l = LBOUND(SrcParamData%KBF,2) - i2_u = UBOUND(SrcParamData%KBF,2) - i3_l = LBOUND(SrcParamData%KBF,3) - i3_u = UBOUND(SrcParamData%KBF,3) - IF (.NOT. ALLOCATED(DstParamData%KBF)) THEN - ALLOCATE(DstParamData%KBF(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%KBF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%KBF = SrcParamData%KBF -ENDIF -IF (ALLOCATED(SrcParamData%MassB)) THEN - i1_l = LBOUND(SrcParamData%MassB,1) - i1_u = UBOUND(SrcParamData%MassB,1) - i2_l = LBOUND(SrcParamData%MassB,2) - i2_u = UBOUND(SrcParamData%MassB,2) - IF (.NOT. ALLOCATED(DstParamData%MassB)) THEN - ALLOCATE(DstParamData%MassB(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%MassB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%MassB = SrcParamData%MassB -ENDIF -IF (ALLOCATED(SrcParamData%RNodes)) THEN - i1_l = LBOUND(SrcParamData%RNodes,1) - i1_u = UBOUND(SrcParamData%RNodes,1) - IF (.NOT. ALLOCATED(DstParamData%RNodes)) THEN - ALLOCATE(DstParamData%RNodes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%RNodes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%RNodes = SrcParamData%RNodes -ENDIF -IF (ALLOCATED(SrcParamData%RNodesNorm)) THEN - i1_l = LBOUND(SrcParamData%RNodesNorm,1) - i1_u = UBOUND(SrcParamData%RNodesNorm,1) - IF (.NOT. ALLOCATED(DstParamData%RNodesNorm)) THEN - ALLOCATE(DstParamData%RNodesNorm(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%RNodesNorm.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%RNodesNorm = SrcParamData%RNodesNorm -ENDIF -IF (ALLOCATED(SrcParamData%rSAerCenn1)) THEN - i1_l = LBOUND(SrcParamData%rSAerCenn1,1) - i1_u = UBOUND(SrcParamData%rSAerCenn1,1) - i2_l = LBOUND(SrcParamData%rSAerCenn1,2) - i2_u = UBOUND(SrcParamData%rSAerCenn1,2) - IF (.NOT. ALLOCATED(DstParamData%rSAerCenn1)) THEN - ALLOCATE(DstParamData%rSAerCenn1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rSAerCenn1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%rSAerCenn1 = SrcParamData%rSAerCenn1 -ENDIF -IF (ALLOCATED(SrcParamData%rSAerCenn2)) THEN - i1_l = LBOUND(SrcParamData%rSAerCenn2,1) - i1_u = UBOUND(SrcParamData%rSAerCenn2,1) - i2_l = LBOUND(SrcParamData%rSAerCenn2,2) - i2_u = UBOUND(SrcParamData%rSAerCenn2,2) - IF (.NOT. ALLOCATED(DstParamData%rSAerCenn2)) THEN - ALLOCATE(DstParamData%rSAerCenn2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rSAerCenn2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%rSAerCenn2 = SrcParamData%rSAerCenn2 -ENDIF -IF (ALLOCATED(SrcParamData%SAeroTwst)) THEN - i1_l = LBOUND(SrcParamData%SAeroTwst,1) - i1_u = UBOUND(SrcParamData%SAeroTwst,1) - IF (.NOT. ALLOCATED(DstParamData%SAeroTwst)) THEN - ALLOCATE(DstParamData%SAeroTwst(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%SAeroTwst.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%SAeroTwst = SrcParamData%SAeroTwst -ENDIF -IF (ALLOCATED(SrcParamData%StiffBE)) THEN - i1_l = LBOUND(SrcParamData%StiffBE,1) - i1_u = UBOUND(SrcParamData%StiffBE,1) - i2_l = LBOUND(SrcParamData%StiffBE,2) - i2_u = UBOUND(SrcParamData%StiffBE,2) - IF (.NOT. ALLOCATED(DstParamData%StiffBE)) THEN - ALLOCATE(DstParamData%StiffBE(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%StiffBE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%StiffBE = SrcParamData%StiffBE -ENDIF -IF (ALLOCATED(SrcParamData%StiffBF)) THEN - i1_l = LBOUND(SrcParamData%StiffBF,1) - i1_u = UBOUND(SrcParamData%StiffBF,1) - i2_l = LBOUND(SrcParamData%StiffBF,2) - i2_u = UBOUND(SrcParamData%StiffBF,2) - IF (.NOT. ALLOCATED(DstParamData%StiffBF)) THEN - ALLOCATE(DstParamData%StiffBF(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%StiffBF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%StiffBF = SrcParamData%StiffBF -ENDIF -IF (ALLOCATED(SrcParamData%SThetaS)) THEN - i1_l = LBOUND(SrcParamData%SThetaS,1) - i1_u = UBOUND(SrcParamData%SThetaS,1) - i2_l = LBOUND(SrcParamData%SThetaS,2) - i2_u = UBOUND(SrcParamData%SThetaS,2) - IF (.NOT. ALLOCATED(DstParamData%SThetaS)) THEN - ALLOCATE(DstParamData%SThetaS(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%SThetaS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%SThetaS = SrcParamData%SThetaS -ENDIF -IF (ALLOCATED(SrcParamData%ThetaS)) THEN - i1_l = LBOUND(SrcParamData%ThetaS,1) - i1_u = UBOUND(SrcParamData%ThetaS,1) - i2_l = LBOUND(SrcParamData%ThetaS,2) - i2_u = UBOUND(SrcParamData%ThetaS,2) - IF (.NOT. ALLOCATED(DstParamData%ThetaS)) THEN - ALLOCATE(DstParamData%ThetaS(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ThetaS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%ThetaS = SrcParamData%ThetaS -ENDIF -IF (ALLOCATED(SrcParamData%TwistedSF)) THEN - i1_l = LBOUND(SrcParamData%TwistedSF,1) - i1_u = UBOUND(SrcParamData%TwistedSF,1) - i2_l = LBOUND(SrcParamData%TwistedSF,2) - i2_u = UBOUND(SrcParamData%TwistedSF,2) - i3_l = LBOUND(SrcParamData%TwistedSF,3) - i3_u = UBOUND(SrcParamData%TwistedSF,3) - i4_l = LBOUND(SrcParamData%TwistedSF,4) - i4_u = UBOUND(SrcParamData%TwistedSF,4) - i5_l = LBOUND(SrcParamData%TwistedSF,5) - i5_u = UBOUND(SrcParamData%TwistedSF,5) - IF (.NOT. ALLOCATED(DstParamData%TwistedSF)) THEN - ALLOCATE(DstParamData%TwistedSF(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u,i5_l:i5_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TwistedSF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%TwistedSF = SrcParamData%TwistedSF -ENDIF -IF (ALLOCATED(SrcParamData%BldFl1Sh)) THEN - i1_l = LBOUND(SrcParamData%BldFl1Sh,1) - i1_u = UBOUND(SrcParamData%BldFl1Sh,1) - i2_l = LBOUND(SrcParamData%BldFl1Sh,2) - i2_u = UBOUND(SrcParamData%BldFl1Sh,2) - IF (.NOT. ALLOCATED(DstParamData%BldFl1Sh)) THEN - ALLOCATE(DstParamData%BldFl1Sh(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BldFl1Sh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%BldFl1Sh = SrcParamData%BldFl1Sh -ENDIF -IF (ALLOCATED(SrcParamData%BldFl2Sh)) THEN - i1_l = LBOUND(SrcParamData%BldFl2Sh,1) - i1_u = UBOUND(SrcParamData%BldFl2Sh,1) - i2_l = LBOUND(SrcParamData%BldFl2Sh,2) - i2_u = UBOUND(SrcParamData%BldFl2Sh,2) - IF (.NOT. ALLOCATED(DstParamData%BldFl2Sh)) THEN - ALLOCATE(DstParamData%BldFl2Sh(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BldFl2Sh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%BldFl2Sh = SrcParamData%BldFl2Sh -ENDIF -IF (ALLOCATED(SrcParamData%BldEdgSh)) THEN - i1_l = LBOUND(SrcParamData%BldEdgSh,1) - i1_u = UBOUND(SrcParamData%BldEdgSh,1) - i2_l = LBOUND(SrcParamData%BldEdgSh,2) - i2_u = UBOUND(SrcParamData%BldEdgSh,2) - IF (.NOT. ALLOCATED(DstParamData%BldEdgSh)) THEN - ALLOCATE(DstParamData%BldEdgSh(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BldEdgSh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%BldEdgSh = SrcParamData%BldEdgSh -ENDIF -IF (ALLOCATED(SrcParamData%FreqBE)) THEN - i1_l = LBOUND(SrcParamData%FreqBE,1) - i1_u = UBOUND(SrcParamData%FreqBE,1) - i2_l = LBOUND(SrcParamData%FreqBE,2) - i2_u = UBOUND(SrcParamData%FreqBE,2) - i3_l = LBOUND(SrcParamData%FreqBE,3) - i3_u = UBOUND(SrcParamData%FreqBE,3) - IF (.NOT. ALLOCATED(DstParamData%FreqBE)) THEN - ALLOCATE(DstParamData%FreqBE(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%FreqBE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%FreqBE = SrcParamData%FreqBE -ENDIF -IF (ALLOCATED(SrcParamData%FreqBF)) THEN - i1_l = LBOUND(SrcParamData%FreqBF,1) - i1_u = UBOUND(SrcParamData%FreqBF,1) - i2_l = LBOUND(SrcParamData%FreqBF,2) - i2_u = UBOUND(SrcParamData%FreqBF,2) - i3_l = LBOUND(SrcParamData%FreqBF,3) - i3_u = UBOUND(SrcParamData%FreqBF,3) - IF (.NOT. ALLOCATED(DstParamData%FreqBF)) THEN - ALLOCATE(DstParamData%FreqBF(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%FreqBF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%FreqBF = SrcParamData%FreqBF -ENDIF - DstParamData%FreqTFA = SrcParamData%FreqTFA - DstParamData%FreqTSS = SrcParamData%FreqTSS - DstParamData%TeetCDmp = SrcParamData%TeetCDmp - DstParamData%TeetDmp = SrcParamData%TeetDmp - DstParamData%TeetDmpP = SrcParamData%TeetDmpP - DstParamData%TeetHSSp = SrcParamData%TeetHSSp - DstParamData%TeetHStP = SrcParamData%TeetHStP - DstParamData%TeetSSSp = SrcParamData%TeetSSSp - DstParamData%TeetSStP = SrcParamData%TeetSStP - DstParamData%TeetMod = SrcParamData%TeetMod - DstParamData%TFrlDmp = SrcParamData%TFrlDmp - DstParamData%TFrlDSDmp = SrcParamData%TFrlDSDmp - DstParamData%TFrlDSDP = SrcParamData%TFrlDSDP - DstParamData%TFrlDSSP = SrcParamData%TFrlDSSP - DstParamData%TFrlDSSpr = SrcParamData%TFrlDSSpr - DstParamData%TFrlSpr = SrcParamData%TFrlSpr - DstParamData%TFrlUSDmp = SrcParamData%TFrlUSDmp - DstParamData%TFrlUSDP = SrcParamData%TFrlUSDP - DstParamData%TFrlUSSP = SrcParamData%TFrlUSSP - DstParamData%TFrlUSSpr = SrcParamData%TFrlUSSpr - DstParamData%TFrlMod = SrcParamData%TFrlMod - DstParamData%RFrlDmp = SrcParamData%RFrlDmp - DstParamData%RFrlDSDmp = SrcParamData%RFrlDSDmp - DstParamData%RFrlDSDP = SrcParamData%RFrlDSDP - DstParamData%RFrlDSSP = SrcParamData%RFrlDSSP - DstParamData%RFrlDSSpr = SrcParamData%RFrlDSSpr - DstParamData%RFrlSpr = SrcParamData%RFrlSpr - DstParamData%RFrlUSDmp = SrcParamData%RFrlUSDmp - DstParamData%RFrlUSDP = SrcParamData%RFrlUSDP - DstParamData%RFrlUSSP = SrcParamData%RFrlUSSP - DstParamData%RFrlUSSpr = SrcParamData%RFrlUSSpr - DstParamData%RFrlMod = SrcParamData%RFrlMod - DstParamData%ShftGagL = SrcParamData%ShftGagL - DstParamData%BldGagNd = SrcParamData%BldGagNd - DstParamData%TwrGagNd = SrcParamData%TwrGagNd - DstParamData%TStart = SrcParamData%TStart - DstParamData%DTTorDmp = SrcParamData%DTTorDmp - DstParamData%DTTorSpr = SrcParamData%DTTorSpr - DstParamData%GBRatio = SrcParamData%GBRatio - DstParamData%GBoxEff = SrcParamData%GBoxEff - DstParamData%RotSpeed = SrcParamData%RotSpeed - DstParamData%RootName = SrcParamData%RootName -IF (ALLOCATED(SrcParamData%BElmntMass)) THEN - i1_l = LBOUND(SrcParamData%BElmntMass,1) - i1_u = UBOUND(SrcParamData%BElmntMass,1) - i2_l = LBOUND(SrcParamData%BElmntMass,2) - i2_u = UBOUND(SrcParamData%BElmntMass,2) - IF (.NOT. ALLOCATED(DstParamData%BElmntMass)) THEN - ALLOCATE(DstParamData%BElmntMass(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BElmntMass.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%BElmntMass = SrcParamData%BElmntMass -ENDIF -IF (ALLOCATED(SrcParamData%TElmntMass)) THEN - i1_l = LBOUND(SrcParamData%TElmntMass,1) - i1_u = UBOUND(SrcParamData%TElmntMass,1) - IF (.NOT. ALLOCATED(DstParamData%TElmntMass)) THEN - ALLOCATE(DstParamData%TElmntMass(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TElmntMass.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%TElmntMass = SrcParamData%TElmntMass -ENDIF - DstParamData%method = SrcParamData%method - DstParamData%PtfmCMxt = SrcParamData%PtfmCMxt - DstParamData%PtfmCMyt = SrcParamData%PtfmCMyt - DstParamData%BD4Blades = SrcParamData%BD4Blades - DstParamData%UseAD14 = SrcParamData%UseAD14 - DstParamData%BldNd_NumOuts = SrcParamData%BldNd_NumOuts - DstParamData%BldNd_TotNumOuts = SrcParamData%BldNd_TotNumOuts -IF (ALLOCATED(SrcParamData%BldNd_OutParam)) THEN - i1_l = LBOUND(SrcParamData%BldNd_OutParam,1) - i1_u = UBOUND(SrcParamData%BldNd_OutParam,1) - IF (.NOT. ALLOCATED(DstParamData%BldNd_OutParam)) THEN - ALLOCATE(DstParamData%BldNd_OutParam(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BldNd_OutParam.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcParamData%BldNd_OutParam,1), UBOUND(SrcParamData%BldNd_OutParam,1) - CALL NWTC_Library_Copyoutparmtype( SrcParamData%BldNd_OutParam(i1), DstParamData%BldNd_OutParam(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - DstParamData%BldNd_BladesOut = SrcParamData%BldNd_BladesOut -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 -IF (ALLOCATED(SrcParamData%dx)) THEN - i1_l = LBOUND(SrcParamData%dx,1) - i1_u = UBOUND(SrcParamData%dx,1) - IF (.NOT. ALLOCATED(DstParamData%dx)) THEN - ALLOCATE(DstParamData%dx(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%dx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%dx = SrcParamData%dx -ENDIF - DstParamData%Jac_ny = SrcParamData%Jac_ny - END SUBROUTINE ED_CopyParam - - SUBROUTINE ED_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(ED_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(ParamData%PH)) THEN - DEALLOCATE(ParamData%PH) -ENDIF -IF (ALLOCATED(ParamData%PM)) THEN - DEALLOCATE(ParamData%PM) -ENDIF -IF (ALLOCATED(ParamData%DOF_Flag)) THEN - DEALLOCATE(ParamData%DOF_Flag) -ENDIF -IF (ALLOCATED(ParamData%DOF_Desc)) THEN - DEALLOCATE(ParamData%DOF_Desc) -ENDIF - CALL ED_Destroyactivedofs( ParamData%DOFs, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(ParamData%OutParam)) THEN -DO i1 = LBOUND(ParamData%OutParam,1), UBOUND(ParamData%OutParam,1) - CALL NWTC_Library_Destroyoutparmtype( ParamData%OutParam(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ParamData%OutParam) -ENDIF -IF (ALLOCATED(ParamData%CosPreC)) THEN - DEALLOCATE(ParamData%CosPreC) -ENDIF -IF (ALLOCATED(ParamData%SinPreC)) THEN - DEALLOCATE(ParamData%SinPreC) -ENDIF -IF (ALLOCATED(ParamData%AxRedTFA)) THEN - DEALLOCATE(ParamData%AxRedTFA) -ENDIF -IF (ALLOCATED(ParamData%AxRedTSS)) THEN - DEALLOCATE(ParamData%AxRedTSS) -ENDIF -IF (ALLOCATED(ParamData%DHNodes)) THEN - DEALLOCATE(ParamData%DHNodes) -ENDIF -IF (ALLOCATED(ParamData%HNodes)) THEN - DEALLOCATE(ParamData%HNodes) -ENDIF -IF (ALLOCATED(ParamData%HNodesNorm)) THEN - DEALLOCATE(ParamData%HNodesNorm) -ENDIF -IF (ALLOCATED(ParamData%MassT)) THEN - DEALLOCATE(ParamData%MassT) -ENDIF -IF (ALLOCATED(ParamData%StiffTSS)) THEN - DEALLOCATE(ParamData%StiffTSS) -ENDIF -IF (ALLOCATED(ParamData%TwrFASF)) THEN - DEALLOCATE(ParamData%TwrFASF) -ENDIF -IF (ALLOCATED(ParamData%TwrSSSF)) THEN - DEALLOCATE(ParamData%TwrSSSF) -ENDIF -IF (ALLOCATED(ParamData%StiffTFA)) THEN - DEALLOCATE(ParamData%StiffTFA) -ENDIF -IF (ALLOCATED(ParamData%BldCG)) THEN - DEALLOCATE(ParamData%BldCG) -ENDIF -IF (ALLOCATED(ParamData%BldMass)) THEN - DEALLOCATE(ParamData%BldMass) -ENDIF -IF (ALLOCATED(ParamData%FirstMom)) THEN - DEALLOCATE(ParamData%FirstMom) -ENDIF -IF (ALLOCATED(ParamData%SecondMom)) THEN - DEALLOCATE(ParamData%SecondMom) -ENDIF -IF (ALLOCATED(ParamData%TipMass)) THEN - DEALLOCATE(ParamData%TipMass) -ENDIF -IF (ALLOCATED(ParamData%PitchAxis)) THEN - DEALLOCATE(ParamData%PitchAxis) -ENDIF -IF (ALLOCATED(ParamData%AeroTwst)) THEN - DEALLOCATE(ParamData%AeroTwst) -ENDIF -IF (ALLOCATED(ParamData%AxRedBld)) THEN - DEALLOCATE(ParamData%AxRedBld) -ENDIF -IF (ALLOCATED(ParamData%BldEDamp)) THEN - DEALLOCATE(ParamData%BldEDamp) -ENDIF -IF (ALLOCATED(ParamData%BldFDamp)) THEN - DEALLOCATE(ParamData%BldFDamp) -ENDIF -IF (ALLOCATED(ParamData%CAeroTwst)) THEN - DEALLOCATE(ParamData%CAeroTwst) -ENDIF -IF (ALLOCATED(ParamData%CBE)) THEN - DEALLOCATE(ParamData%CBE) -ENDIF -IF (ALLOCATED(ParamData%CBF)) THEN - DEALLOCATE(ParamData%CBF) -ENDIF -IF (ALLOCATED(ParamData%Chord)) THEN - DEALLOCATE(ParamData%Chord) -ENDIF -IF (ALLOCATED(ParamData%CThetaS)) THEN - DEALLOCATE(ParamData%CThetaS) -ENDIF -IF (ALLOCATED(ParamData%DRNodes)) THEN - DEALLOCATE(ParamData%DRNodes) -ENDIF -IF (ALLOCATED(ParamData%FStTunr)) THEN - DEALLOCATE(ParamData%FStTunr) -ENDIF -IF (ALLOCATED(ParamData%KBE)) THEN - DEALLOCATE(ParamData%KBE) -ENDIF -IF (ALLOCATED(ParamData%KBF)) THEN - DEALLOCATE(ParamData%KBF) -ENDIF -IF (ALLOCATED(ParamData%MassB)) THEN - DEALLOCATE(ParamData%MassB) -ENDIF -IF (ALLOCATED(ParamData%RNodes)) THEN - DEALLOCATE(ParamData%RNodes) -ENDIF -IF (ALLOCATED(ParamData%RNodesNorm)) THEN - DEALLOCATE(ParamData%RNodesNorm) -ENDIF -IF (ALLOCATED(ParamData%rSAerCenn1)) THEN - DEALLOCATE(ParamData%rSAerCenn1) -ENDIF -IF (ALLOCATED(ParamData%rSAerCenn2)) THEN - DEALLOCATE(ParamData%rSAerCenn2) -ENDIF -IF (ALLOCATED(ParamData%SAeroTwst)) THEN - DEALLOCATE(ParamData%SAeroTwst) -ENDIF -IF (ALLOCATED(ParamData%StiffBE)) THEN - DEALLOCATE(ParamData%StiffBE) -ENDIF -IF (ALLOCATED(ParamData%StiffBF)) THEN - DEALLOCATE(ParamData%StiffBF) -ENDIF -IF (ALLOCATED(ParamData%SThetaS)) THEN - DEALLOCATE(ParamData%SThetaS) -ENDIF -IF (ALLOCATED(ParamData%ThetaS)) THEN - DEALLOCATE(ParamData%ThetaS) -ENDIF -IF (ALLOCATED(ParamData%TwistedSF)) THEN - DEALLOCATE(ParamData%TwistedSF) -ENDIF -IF (ALLOCATED(ParamData%BldFl1Sh)) THEN - DEALLOCATE(ParamData%BldFl1Sh) -ENDIF -IF (ALLOCATED(ParamData%BldFl2Sh)) THEN - DEALLOCATE(ParamData%BldFl2Sh) -ENDIF -IF (ALLOCATED(ParamData%BldEdgSh)) THEN - DEALLOCATE(ParamData%BldEdgSh) -ENDIF -IF (ALLOCATED(ParamData%FreqBE)) THEN - DEALLOCATE(ParamData%FreqBE) -ENDIF -IF (ALLOCATED(ParamData%FreqBF)) THEN - DEALLOCATE(ParamData%FreqBF) -ENDIF -IF (ALLOCATED(ParamData%BElmntMass)) THEN - DEALLOCATE(ParamData%BElmntMass) -ENDIF -IF (ALLOCATED(ParamData%TElmntMass)) THEN - DEALLOCATE(ParamData%TElmntMass) -ENDIF -IF (ALLOCATED(ParamData%BldNd_OutParam)) THEN -DO i1 = LBOUND(ParamData%BldNd_OutParam,1), UBOUND(ParamData%BldNd_OutParam,1) - CALL NWTC_Library_Destroyoutparmtype( ParamData%BldNd_OutParam(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ParamData%BldNd_OutParam) -ENDIF -IF (ALLOCATED(ParamData%Jac_u_indx)) THEN - DEALLOCATE(ParamData%Jac_u_indx) -ENDIF -IF (ALLOCATED(ParamData%du)) THEN - DEALLOCATE(ParamData%du) -ENDIF -IF (ALLOCATED(ParamData%dx)) THEN - DEALLOCATE(ParamData%dx) -ENDIF - END SUBROUTINE ED_DestroyParam - - SUBROUTINE ED_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(ED_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 = 'ED_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 ! DT24 - Int_BufSz = Int_BufSz + 1 ! BldNodes - Int_BufSz = Int_BufSz + 1 ! TipNode - Int_BufSz = Int_BufSz + 1 ! NDOF - Db_BufSz = Db_BufSz + 1 ! TwoPiNB - Int_BufSz = Int_BufSz + 1 ! NAug - Int_BufSz = Int_BufSz + 1 ! NPH - Int_BufSz = Int_BufSz + 1 ! PH allocated yes/no - IF ( ALLOCATED(InData%PH) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PH upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%PH) ! PH - END IF - Int_BufSz = Int_BufSz + 1 ! NPM - Int_BufSz = Int_BufSz + 1 ! PM allocated yes/no - IF ( ALLOCATED(InData%PM) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PM upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%PM) ! PM - END IF - Int_BufSz = Int_BufSz + 1 ! DOF_Flag allocated yes/no - IF ( ALLOCATED(InData%DOF_Flag) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! DOF_Flag upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%DOF_Flag) ! DOF_Flag - END IF - Int_BufSz = Int_BufSz + 1 ! DOF_Desc allocated yes/no - IF ( ALLOCATED(InData%DOF_Desc) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! DOF_Desc upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%DOF_Desc)*LEN(InData%DOF_Desc) ! DOF_Desc - END IF - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! DOFs: size of buffers for each call to pack subtype - CALL ED_Packactivedofs( Re_Buf, Db_Buf, Int_Buf, InData%DOFs, ErrStat2, ErrMsg2, .TRUE. ) ! DOFs - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! DOFs - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! DOFs - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! DOFs - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! NumOuts - Int_BufSz = Int_BufSz + 1*LEN(InData%OutFmt) ! OutFmt - Int_BufSz = Int_BufSz + 1 ! NBlGages - Int_BufSz = Int_BufSz + 1 ! NTwGages - 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*LEN(InData%Delim) ! Delim - Re_BufSz = Re_BufSz + 1 ! AvgNrmTpRd - Db_BufSz = Db_BufSz + 1 ! AzimB1Up - Db_BufSz = Db_BufSz + 1 ! CosDel3 - Int_BufSz = Int_BufSz + 1 ! CosPreC allocated yes/no - IF ( ALLOCATED(InData%CosPreC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! CosPreC upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%CosPreC) ! CosPreC - END IF - Db_BufSz = Db_BufSz + 1 ! CRFrlSkew - Db_BufSz = Db_BufSz + 1 ! CRFrlSkw2 - Db_BufSz = Db_BufSz + 1 ! CRFrlTilt - Db_BufSz = Db_BufSz + 1 ! CRFrlTlt2 - Db_BufSz = Db_BufSz + 1 ! CShftSkew - Db_BufSz = Db_BufSz + 1 ! CShftTilt - Db_BufSz = Db_BufSz + 1 ! CSRFrlSkw - Db_BufSz = Db_BufSz + 1 ! CSRFrlTlt - Db_BufSz = Db_BufSz + 1 ! CSTFrlSkw - Db_BufSz = Db_BufSz + 1 ! CSTFrlTlt - Db_BufSz = Db_BufSz + 1 ! CTFrlSkew - Db_BufSz = Db_BufSz + 1 ! CTFrlSkw2 - Db_BufSz = Db_BufSz + 1 ! CTFrlTilt - Db_BufSz = Db_BufSz + 1 ! CTFrlTlt2 - Re_BufSz = Re_BufSz + 1 ! HubHt - Re_BufSz = Re_BufSz + 1 ! HubCM - Re_BufSz = Re_BufSz + 1 ! HubRad - Re_BufSz = Re_BufSz + 1 ! NacCMxn - Re_BufSz = Re_BufSz + 1 ! NacCMyn - Re_BufSz = Re_BufSz + 1 ! NacCMzn - Re_BufSz = Re_BufSz + 1 ! OverHang - Re_BufSz = Re_BufSz + 1 ! ProjArea - Re_BufSz = Re_BufSz + 1 ! PtfmRefzt - Re_BufSz = Re_BufSz + 1 ! RefTwrHt - Re_BufSz = Re_BufSz + SIZE(InData%RFrlPnt_n) ! RFrlPnt_n - Re_BufSz = Re_BufSz + 1 ! rVDxn - Re_BufSz = Re_BufSz + 1 ! rVDyn - Re_BufSz = Re_BufSz + 1 ! rVDzn - Re_BufSz = Re_BufSz + 1 ! rVIMUxn - Re_BufSz = Re_BufSz + 1 ! rVIMUyn - Re_BufSz = Re_BufSz + 1 ! rVIMUzn - Re_BufSz = Re_BufSz + 1 ! rVPxn - Re_BufSz = Re_BufSz + 1 ! rVPyn - Re_BufSz = Re_BufSz + 1 ! rVPzn - Re_BufSz = Re_BufSz + 1 ! rWIxn - Re_BufSz = Re_BufSz + 1 ! rWIyn - Re_BufSz = Re_BufSz + 1 ! rWIzn - Re_BufSz = Re_BufSz + 1 ! rWJxn - Re_BufSz = Re_BufSz + 1 ! rWJyn - Re_BufSz = Re_BufSz + 1 ! rWJzn - Re_BufSz = Re_BufSz + 1 ! rZT0zt - Re_BufSz = Re_BufSz + 1 ! rZYzt - Db_BufSz = Db_BufSz + 1 ! SinDel3 - Int_BufSz = Int_BufSz + 1 ! SinPreC allocated yes/no - IF ( ALLOCATED(InData%SinPreC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! SinPreC upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%SinPreC) ! SinPreC - END IF - Db_BufSz = Db_BufSz + 1 ! SRFrlSkew - Db_BufSz = Db_BufSz + 1 ! SRFrlSkw2 - Db_BufSz = Db_BufSz + 1 ! SRFrlTilt - Db_BufSz = Db_BufSz + 1 ! SRFrlTlt2 - Db_BufSz = Db_BufSz + 1 ! SShftSkew - Db_BufSz = Db_BufSz + 1 ! SShftTilt - Db_BufSz = Db_BufSz + 1 ! STFrlSkew - Db_BufSz = Db_BufSz + 1 ! STFrlSkw2 - Db_BufSz = Db_BufSz + 1 ! STFrlTilt - Db_BufSz = Db_BufSz + 1 ! STFrlTlt2 - Re_BufSz = Re_BufSz + SIZE(InData%TFrlPnt_n) ! TFrlPnt_n - Re_BufSz = Re_BufSz + 1 ! TipRad - Re_BufSz = Re_BufSz + 1 ! TowerHt - Re_BufSz = Re_BufSz + 1 ! TowerBsHt - Re_BufSz = Re_BufSz + 1 ! UndSling - Int_BufSz = Int_BufSz + 1 ! NumBl - Int_BufSz = Int_BufSz + 1 ! AxRedTFA allocated yes/no - IF ( ALLOCATED(InData%AxRedTFA) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! AxRedTFA upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AxRedTFA) ! AxRedTFA - END IF - Int_BufSz = Int_BufSz + 1 ! AxRedTSS allocated yes/no - IF ( ALLOCATED(InData%AxRedTSS) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! AxRedTSS upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AxRedTSS) ! AxRedTSS - END IF - Re_BufSz = Re_BufSz + SIZE(InData%CTFA) ! CTFA - Re_BufSz = Re_BufSz + SIZE(InData%CTSS) ! CTSS - Int_BufSz = Int_BufSz + 1 ! DHNodes allocated yes/no - IF ( ALLOCATED(InData%DHNodes) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! DHNodes upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%DHNodes) ! DHNodes - END IF - Int_BufSz = Int_BufSz + 1 ! HNodes allocated yes/no - IF ( ALLOCATED(InData%HNodes) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! HNodes upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%HNodes) ! HNodes - END IF - Int_BufSz = Int_BufSz + 1 ! HNodesNorm allocated yes/no - IF ( ALLOCATED(InData%HNodesNorm) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! HNodesNorm upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%HNodesNorm) ! HNodesNorm - END IF - Re_BufSz = Re_BufSz + SIZE(InData%KTFA) ! KTFA - Re_BufSz = Re_BufSz + SIZE(InData%KTSS) ! KTSS - Int_BufSz = Int_BufSz + 1 ! MassT allocated yes/no - IF ( ALLOCATED(InData%MassT) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! MassT upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%MassT) ! MassT - END IF - Int_BufSz = Int_BufSz + 1 ! StiffTSS allocated yes/no - IF ( ALLOCATED(InData%StiffTSS) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! StiffTSS upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%StiffTSS) ! StiffTSS - END IF - Int_BufSz = Int_BufSz + 1 ! TwrFASF allocated yes/no - IF ( ALLOCATED(InData%TwrFASF) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! TwrFASF upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TwrFASF) ! TwrFASF - END IF - Re_BufSz = Re_BufSz + 1 ! TwrFlexL - Int_BufSz = Int_BufSz + 1 ! TwrSSSF allocated yes/no - IF ( ALLOCATED(InData%TwrSSSF) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! TwrSSSF upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TwrSSSF) ! TwrSSSF - END IF - Int_BufSz = Int_BufSz + 1 ! TTopNode - Int_BufSz = Int_BufSz + 1 ! TwrNodes - Int_BufSz = Int_BufSz + 1 ! MHK - Int_BufSz = Int_BufSz + 1 ! StiffTFA allocated yes/no - IF ( ALLOCATED(InData%StiffTFA) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! StiffTFA upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%StiffTFA) ! StiffTFA - END IF - Re_BufSz = Re_BufSz + 1 ! AtfaIner - Int_BufSz = Int_BufSz + 1 ! BldCG allocated yes/no - IF ( ALLOCATED(InData%BldCG) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BldCG upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BldCG) ! BldCG - END IF - Int_BufSz = Int_BufSz + 1 ! BldMass allocated yes/no - IF ( ALLOCATED(InData%BldMass) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BldMass upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BldMass) ! BldMass - END IF - Re_BufSz = Re_BufSz + 1 ! BoomMass - Int_BufSz = Int_BufSz + 1 ! FirstMom allocated yes/no - IF ( ALLOCATED(InData%FirstMom) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! FirstMom upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%FirstMom) ! FirstMom - END IF - Re_BufSz = Re_BufSz + 1 ! GenIner - Re_BufSz = Re_BufSz + 1 ! Hubg1Iner - Re_BufSz = Re_BufSz + 1 ! Hubg2Iner - Re_BufSz = Re_BufSz + 1 ! HubMass - Re_BufSz = Re_BufSz + 1 ! Nacd2Iner - Re_BufSz = Re_BufSz + 1 ! NacMass - Re_BufSz = Re_BufSz + 1 ! PtfmMass - Re_BufSz = Re_BufSz + 1 ! PtfmPIner - Re_BufSz = Re_BufSz + 1 ! PtfmRIner - Re_BufSz = Re_BufSz + 1 ! PtfmYIner - Re_BufSz = Re_BufSz + 1 ! RFrlMass - Re_BufSz = Re_BufSz + 1 ! RotIner - Re_BufSz = Re_BufSz + 1 ! RotMass - Re_BufSz = Re_BufSz + 1 ! RrfaIner - Int_BufSz = Int_BufSz + 1 ! SecondMom allocated yes/no - IF ( ALLOCATED(InData%SecondMom) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! SecondMom upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%SecondMom) ! SecondMom - END IF - Re_BufSz = Re_BufSz + 1 ! TFinMass - Re_BufSz = Re_BufSz + 1 ! TFrlIner - Int_BufSz = Int_BufSz + 1 ! TipMass allocated yes/no - IF ( ALLOCATED(InData%TipMass) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TipMass upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TipMass) ! TipMass - END IF - Re_BufSz = Re_BufSz + 1 ! TurbMass - Re_BufSz = Re_BufSz + 1 ! TwrMass - Re_BufSz = Re_BufSz + 1 ! TwrTpMass - Re_BufSz = Re_BufSz + 1 ! YawBrMass - Re_BufSz = Re_BufSz + 1 ! Gravity - Int_BufSz = Int_BufSz + 1 ! PitchAxis allocated yes/no - IF ( ALLOCATED(InData%PitchAxis) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PitchAxis upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PitchAxis) ! PitchAxis - END IF - Int_BufSz = Int_BufSz + 1 ! AeroTwst allocated yes/no - IF ( ALLOCATED(InData%AeroTwst) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! AeroTwst upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AeroTwst) ! AeroTwst - END IF - Int_BufSz = Int_BufSz + 1 ! AxRedBld allocated yes/no - IF ( ALLOCATED(InData%AxRedBld) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! AxRedBld upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AxRedBld) ! AxRedBld - END IF - Int_BufSz = Int_BufSz + 1 ! BldEDamp allocated yes/no - IF ( ALLOCATED(InData%BldEDamp) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BldEDamp upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BldEDamp) ! BldEDamp - END IF - Int_BufSz = Int_BufSz + 1 ! BldFDamp allocated yes/no - IF ( ALLOCATED(InData%BldFDamp) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BldFDamp upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BldFDamp) ! BldFDamp - END IF - Re_BufSz = Re_BufSz + 1 ! BldFlexL - Int_BufSz = Int_BufSz + 1 ! CAeroTwst allocated yes/no - IF ( ALLOCATED(InData%CAeroTwst) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! CAeroTwst upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CAeroTwst) ! CAeroTwst - END IF - Int_BufSz = Int_BufSz + 1 ! CBE allocated yes/no - IF ( ALLOCATED(InData%CBE) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! CBE upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CBE) ! CBE - END IF - Int_BufSz = Int_BufSz + 1 ! CBF allocated yes/no - IF ( ALLOCATED(InData%CBF) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! CBF upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CBF) ! CBF - END IF - Int_BufSz = Int_BufSz + 1 ! Chord allocated yes/no - IF ( ALLOCATED(InData%Chord) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Chord upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Chord) ! Chord - END IF - Int_BufSz = Int_BufSz + 1 ! CThetaS allocated yes/no - IF ( ALLOCATED(InData%CThetaS) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! CThetaS upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%CThetaS) ! CThetaS - END IF - Int_BufSz = Int_BufSz + 1 ! DRNodes allocated yes/no - IF ( ALLOCATED(InData%DRNodes) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! DRNodes upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%DRNodes) ! DRNodes - END IF - Int_BufSz = Int_BufSz + 1 ! FStTunr allocated yes/no - IF ( ALLOCATED(InData%FStTunr) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! FStTunr upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%FStTunr) ! FStTunr - END IF - Int_BufSz = Int_BufSz + 1 ! KBE allocated yes/no - IF ( ALLOCATED(InData%KBE) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! KBE upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%KBE) ! KBE - END IF - Int_BufSz = Int_BufSz + 1 ! KBF allocated yes/no - IF ( ALLOCATED(InData%KBF) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! KBF upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%KBF) ! KBF - END IF - Int_BufSz = Int_BufSz + 1 ! MassB allocated yes/no - IF ( ALLOCATED(InData%MassB) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! MassB upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%MassB) ! MassB - END IF - Int_BufSz = Int_BufSz + 1 ! RNodes allocated yes/no - IF ( ALLOCATED(InData%RNodes) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! RNodes upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%RNodes) ! RNodes - END IF - Int_BufSz = Int_BufSz + 1 ! RNodesNorm allocated yes/no - IF ( ALLOCATED(InData%RNodesNorm) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! RNodesNorm upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%RNodesNorm) ! RNodesNorm - END IF - Int_BufSz = Int_BufSz + 1 ! rSAerCenn1 allocated yes/no - IF ( ALLOCATED(InData%rSAerCenn1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! rSAerCenn1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%rSAerCenn1) ! rSAerCenn1 - END IF - Int_BufSz = Int_BufSz + 1 ! rSAerCenn2 allocated yes/no - IF ( ALLOCATED(InData%rSAerCenn2) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! rSAerCenn2 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%rSAerCenn2) ! rSAerCenn2 - END IF - Int_BufSz = Int_BufSz + 1 ! SAeroTwst allocated yes/no - IF ( ALLOCATED(InData%SAeroTwst) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! SAeroTwst upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%SAeroTwst) ! SAeroTwst - END IF - Int_BufSz = Int_BufSz + 1 ! StiffBE allocated yes/no - IF ( ALLOCATED(InData%StiffBE) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! StiffBE upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%StiffBE) ! StiffBE - END IF - Int_BufSz = Int_BufSz + 1 ! StiffBF allocated yes/no - IF ( ALLOCATED(InData%StiffBF) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! StiffBF upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%StiffBF) ! StiffBF - END IF - Int_BufSz = Int_BufSz + 1 ! SThetaS allocated yes/no - IF ( ALLOCATED(InData%SThetaS) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! SThetaS upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%SThetaS) ! SThetaS - END IF - Int_BufSz = Int_BufSz + 1 ! ThetaS allocated yes/no - IF ( ALLOCATED(InData%ThetaS) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! ThetaS upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%ThetaS) ! ThetaS - END IF - Int_BufSz = Int_BufSz + 1 ! TwistedSF allocated yes/no - IF ( ALLOCATED(InData%TwistedSF) ) THEN - Int_BufSz = Int_BufSz + 2*5 ! TwistedSF upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TwistedSF) ! TwistedSF - END IF - Int_BufSz = Int_BufSz + 1 ! BldFl1Sh allocated yes/no - IF ( ALLOCATED(InData%BldFl1Sh) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BldFl1Sh upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BldFl1Sh) ! BldFl1Sh - END IF - Int_BufSz = Int_BufSz + 1 ! BldFl2Sh allocated yes/no - IF ( ALLOCATED(InData%BldFl2Sh) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BldFl2Sh upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BldFl2Sh) ! BldFl2Sh - END IF - Int_BufSz = Int_BufSz + 1 ! BldEdgSh allocated yes/no - IF ( ALLOCATED(InData%BldEdgSh) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BldEdgSh upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BldEdgSh) ! BldEdgSh - END IF - Int_BufSz = Int_BufSz + 1 ! FreqBE allocated yes/no - IF ( ALLOCATED(InData%FreqBE) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! FreqBE upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%FreqBE) ! FreqBE - END IF - Int_BufSz = Int_BufSz + 1 ! FreqBF allocated yes/no - IF ( ALLOCATED(InData%FreqBF) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! FreqBF upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%FreqBF) ! FreqBF - END IF - Re_BufSz = Re_BufSz + SIZE(InData%FreqTFA) ! FreqTFA - Re_BufSz = Re_BufSz + SIZE(InData%FreqTSS) ! FreqTSS - Re_BufSz = Re_BufSz + 1 ! TeetCDmp - Re_BufSz = Re_BufSz + 1 ! TeetDmp - Re_BufSz = Re_BufSz + 1 ! TeetDmpP - Re_BufSz = Re_BufSz + 1 ! TeetHSSp - Re_BufSz = Re_BufSz + 1 ! TeetHStP - Re_BufSz = Re_BufSz + 1 ! TeetSSSp - Re_BufSz = Re_BufSz + 1 ! TeetSStP - Int_BufSz = Int_BufSz + 1 ! TeetMod - Re_BufSz = Re_BufSz + 1 ! TFrlDmp - Re_BufSz = Re_BufSz + 1 ! TFrlDSDmp - Re_BufSz = Re_BufSz + 1 ! TFrlDSDP - Re_BufSz = Re_BufSz + 1 ! TFrlDSSP - Re_BufSz = Re_BufSz + 1 ! TFrlDSSpr - Re_BufSz = Re_BufSz + 1 ! TFrlSpr - Re_BufSz = Re_BufSz + 1 ! TFrlUSDmp - Re_BufSz = Re_BufSz + 1 ! TFrlUSDP - Re_BufSz = Re_BufSz + 1 ! TFrlUSSP - Re_BufSz = Re_BufSz + 1 ! TFrlUSSpr - Int_BufSz = Int_BufSz + 1 ! TFrlMod - Re_BufSz = Re_BufSz + 1 ! RFrlDmp - Re_BufSz = Re_BufSz + 1 ! RFrlDSDmp - Re_BufSz = Re_BufSz + 1 ! RFrlDSDP - Re_BufSz = Re_BufSz + 1 ! RFrlDSSP - Re_BufSz = Re_BufSz + 1 ! RFrlDSSpr - Re_BufSz = Re_BufSz + 1 ! RFrlSpr - Re_BufSz = Re_BufSz + 1 ! RFrlUSDmp - Re_BufSz = Re_BufSz + 1 ! RFrlUSDP - Re_BufSz = Re_BufSz + 1 ! RFrlUSSP - Re_BufSz = Re_BufSz + 1 ! RFrlUSSpr - Int_BufSz = Int_BufSz + 1 ! RFrlMod - Re_BufSz = Re_BufSz + 1 ! ShftGagL - Int_BufSz = Int_BufSz + SIZE(InData%BldGagNd) ! BldGagNd - Int_BufSz = Int_BufSz + SIZE(InData%TwrGagNd) ! TwrGagNd - Db_BufSz = Db_BufSz + 1 ! TStart - Re_BufSz = Re_BufSz + 1 ! DTTorDmp - Re_BufSz = Re_BufSz + 1 ! DTTorSpr - Re_BufSz = Re_BufSz + 1 ! GBRatio - Re_BufSz = Re_BufSz + 1 ! GBoxEff - Re_BufSz = Re_BufSz + 1 ! RotSpeed - Int_BufSz = Int_BufSz + 1*LEN(InData%RootName) ! RootName - Int_BufSz = Int_BufSz + 1 ! BElmntMass allocated yes/no - IF ( ALLOCATED(InData%BElmntMass) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BElmntMass upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BElmntMass) ! BElmntMass - END IF - Int_BufSz = Int_BufSz + 1 ! TElmntMass allocated yes/no - IF ( ALLOCATED(InData%TElmntMass) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TElmntMass upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TElmntMass) ! TElmntMass - END IF - Int_BufSz = Int_BufSz + 1 ! method - Re_BufSz = Re_BufSz + 1 ! PtfmCMxt - Re_BufSz = Re_BufSz + 1 ! PtfmCMyt - Int_BufSz = Int_BufSz + 1 ! BD4Blades - Int_BufSz = Int_BufSz + 1 ! UseAD14 - Int_BufSz = Int_BufSz + 1 ! BldNd_NumOuts - Int_BufSz = Int_BufSz + 1 ! BldNd_TotNumOuts - Int_BufSz = Int_BufSz + 1 ! BldNd_OutParam allocated yes/no - IF ( ALLOCATED(InData%BldNd_OutParam) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BldNd_OutParam upper/lower bounds for each dimension - DO i1 = LBOUND(InData%BldNd_OutParam,1), UBOUND(InData%BldNd_OutParam,1) - Int_BufSz = Int_BufSz + 3 ! BldNd_OutParam: size of buffers for each call to pack subtype - CALL NWTC_Library_Packoutparmtype( Re_Buf, Db_Buf, Int_Buf, InData%BldNd_OutParam(i1), ErrStat2, ErrMsg2, .TRUE. ) ! BldNd_OutParam - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BldNd_OutParam - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BldNd_OutParam - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BldNd_OutParam - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! BldNd_BladesOut - 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 - Int_BufSz = Int_BufSz + 1 ! dx allocated yes/no - IF ( ALLOCATED(InData%dx) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! dx upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%dx) ! dx - END IF - Int_BufSz = Int_BufSz + 1 ! Jac_ny - 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%DT24 - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%BldNodes - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%TipNode - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NDOF - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%TwoPiNB - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NAug - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NPH - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%PH) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PH,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PH,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PH,1), UBOUND(InData%PH,1) - IntKiBuf(Int_Xferred) = InData%PH(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NPM - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%PM) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PM,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PM,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PM,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PM,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PM,2), UBOUND(InData%PM,2) - DO i1 = LBOUND(InData%PM,1), UBOUND(InData%PM,1) - IntKiBuf(Int_Xferred) = InData%PM(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%DOF_Flag) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DOF_Flag,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DOF_Flag,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%DOF_Flag,1), UBOUND(InData%DOF_Flag,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%DOF_Flag(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%DOF_Desc) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DOF_Desc,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DOF_Desc,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%DOF_Desc,1), UBOUND(InData%DOF_Desc,1) - DO I = 1, LEN(InData%DOF_Desc) - IntKiBuf(Int_Xferred) = ICHAR(InData%DOF_Desc(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - CALL ED_Packactivedofs( Re_Buf, Db_Buf, Int_Buf, InData%DOFs, ErrStat2, ErrMsg2, OnlySize ) ! DOFs - 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%NumOuts - 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 - IntKiBuf(Int_Xferred) = InData%NBlGages - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NTwGages - 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 - DO I = 1, LEN(InData%Delim) - IntKiBuf(Int_Xferred) = ICHAR(InData%Delim(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - ReKiBuf(Re_Xferred) = InData%AvgNrmTpRd - Re_Xferred = Re_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%AzimB1Up - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%CosDel3 - Db_Xferred = Db_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%CosPreC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CosPreC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CosPreC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%CosPreC,1), UBOUND(InData%CosPreC,1) - DbKiBuf(Db_Xferred) = InData%CosPreC(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - DbKiBuf(Db_Xferred) = InData%CRFrlSkew - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%CRFrlSkw2 - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%CRFrlTilt - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%CRFrlTlt2 - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%CShftSkew - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%CShftTilt - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%CSRFrlSkw - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%CSRFrlTlt - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%CSTFrlSkw - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%CSTFrlTlt - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%CTFrlSkew - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%CTFrlSkw2 - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%CTFrlTilt - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%CTFrlTlt2 - Db_Xferred = Db_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%HubHt - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%HubCM - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%HubRad - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%NacCMxn - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%NacCMyn - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%NacCMzn - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%OverHang - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%ProjArea - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PtfmRefzt - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RefTwrHt - Re_Xferred = Re_Xferred + 1 - DO i1 = LBOUND(InData%RFrlPnt_n,1), UBOUND(InData%RFrlPnt_n,1) - ReKiBuf(Re_Xferred) = InData%RFrlPnt_n(i1) - Re_Xferred = Re_Xferred + 1 - END DO - ReKiBuf(Re_Xferred) = InData%rVDxn - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%rVDyn - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%rVDzn - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%rVIMUxn - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%rVIMUyn - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%rVIMUzn - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%rVPxn - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%rVPyn - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%rVPzn - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%rWIxn - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%rWIyn - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%rWIzn - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%rWJxn - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%rWJyn - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%rWJzn - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%rZT0zt - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%rZYzt - Re_Xferred = Re_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%SinDel3 - Db_Xferred = Db_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%SinPreC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SinPreC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SinPreC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%SinPreC,1), UBOUND(InData%SinPreC,1) - DbKiBuf(Db_Xferred) = InData%SinPreC(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - DbKiBuf(Db_Xferred) = InData%SRFrlSkew - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%SRFrlSkw2 - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%SRFrlTilt - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%SRFrlTlt2 - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%SShftSkew - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%SShftTilt - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%STFrlSkew - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%STFrlSkw2 - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%STFrlTilt - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%STFrlTlt2 - Db_Xferred = Db_Xferred + 1 - DO i1 = LBOUND(InData%TFrlPnt_n,1), UBOUND(InData%TFrlPnt_n,1) - ReKiBuf(Re_Xferred) = InData%TFrlPnt_n(i1) - Re_Xferred = Re_Xferred + 1 - END DO - ReKiBuf(Re_Xferred) = InData%TipRad - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TowerHt - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TowerBsHt - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%UndSling - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumBl - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%AxRedTFA) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AxRedTFA,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AxRedTFA,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AxRedTFA,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AxRedTFA,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AxRedTFA,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AxRedTFA,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%AxRedTFA,3), UBOUND(InData%AxRedTFA,3) - DO i2 = LBOUND(InData%AxRedTFA,2), UBOUND(InData%AxRedTFA,2) - DO i1 = LBOUND(InData%AxRedTFA,1), UBOUND(InData%AxRedTFA,1) - ReKiBuf(Re_Xferred) = InData%AxRedTFA(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AxRedTSS) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AxRedTSS,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AxRedTSS,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AxRedTSS,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AxRedTSS,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AxRedTSS,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AxRedTSS,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%AxRedTSS,3), UBOUND(InData%AxRedTSS,3) - DO i2 = LBOUND(InData%AxRedTSS,2), UBOUND(InData%AxRedTSS,2) - DO i1 = LBOUND(InData%AxRedTSS,1), UBOUND(InData%AxRedTSS,1) - ReKiBuf(Re_Xferred) = InData%AxRedTSS(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - DO i2 = LBOUND(InData%CTFA,2), UBOUND(InData%CTFA,2) - DO i1 = LBOUND(InData%CTFA,1), UBOUND(InData%CTFA,1) - ReKiBuf(Re_Xferred) = InData%CTFA(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - DO i2 = LBOUND(InData%CTSS,2), UBOUND(InData%CTSS,2) - DO i1 = LBOUND(InData%CTSS,1), UBOUND(InData%CTSS,1) - ReKiBuf(Re_Xferred) = InData%CTSS(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - IF ( .NOT. ALLOCATED(InData%DHNodes) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DHNodes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DHNodes,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%DHNodes,1), UBOUND(InData%DHNodes,1) - ReKiBuf(Re_Xferred) = InData%DHNodes(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%HNodes) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%HNodes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%HNodes,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%HNodes,1), UBOUND(InData%HNodes,1) - ReKiBuf(Re_Xferred) = InData%HNodes(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%HNodesNorm) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%HNodesNorm,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%HNodesNorm,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%HNodesNorm,1), UBOUND(InData%HNodesNorm,1) - ReKiBuf(Re_Xferred) = InData%HNodesNorm(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - DO i2 = LBOUND(InData%KTFA,2), UBOUND(InData%KTFA,2) - DO i1 = LBOUND(InData%KTFA,1), UBOUND(InData%KTFA,1) - ReKiBuf(Re_Xferred) = InData%KTFA(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - DO i2 = LBOUND(InData%KTSS,2), UBOUND(InData%KTSS,2) - DO i1 = LBOUND(InData%KTSS,1), UBOUND(InData%KTSS,1) - ReKiBuf(Re_Xferred) = InData%KTSS(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - IF ( .NOT. ALLOCATED(InData%MassT) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MassT,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MassT,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%MassT,1), UBOUND(InData%MassT,1) - ReKiBuf(Re_Xferred) = InData%MassT(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%StiffTSS) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StiffTSS,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StiffTSS,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%StiffTSS,1), UBOUND(InData%StiffTSS,1) - ReKiBuf(Re_Xferred) = InData%StiffTSS(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TwrFASF) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwrFASF,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrFASF,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwrFASF,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrFASF,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwrFASF,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrFASF,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%TwrFASF,3), UBOUND(InData%TwrFASF,3) - DO i2 = LBOUND(InData%TwrFASF,2), UBOUND(InData%TwrFASF,2) - DO i1 = LBOUND(InData%TwrFASF,1), UBOUND(InData%TwrFASF,1) - ReKiBuf(Re_Xferred) = InData%TwrFASF(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - ReKiBuf(Re_Xferred) = InData%TwrFlexL - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%TwrSSSF) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwrSSSF,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrSSSF,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwrSSSF,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrSSSF,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwrSSSF,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrSSSF,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%TwrSSSF,3), UBOUND(InData%TwrSSSF,3) - DO i2 = LBOUND(InData%TwrSSSF,2), UBOUND(InData%TwrSSSF,2) - DO i1 = LBOUND(InData%TwrSSSF,1), UBOUND(InData%TwrSSSF,1) - ReKiBuf(Re_Xferred) = InData%TwrSSSF(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%TTopNode - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%TwrNodes - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%MHK - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%StiffTFA) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StiffTFA,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StiffTFA,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%StiffTFA,1), UBOUND(InData%StiffTFA,1) - ReKiBuf(Re_Xferred) = InData%StiffTFA(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%AtfaIner - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%BldCG) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BldCG,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldCG,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BldCG,1), UBOUND(InData%BldCG,1) - ReKiBuf(Re_Xferred) = InData%BldCG(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BldMass) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BldMass,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldMass,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BldMass,1), UBOUND(InData%BldMass,1) - ReKiBuf(Re_Xferred) = InData%BldMass(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%BoomMass - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%FirstMom) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FirstMom,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FirstMom,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%FirstMom,1), UBOUND(InData%FirstMom,1) - ReKiBuf(Re_Xferred) = InData%FirstMom(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%GenIner - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Hubg1Iner - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Hubg2Iner - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%HubMass - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Nacd2Iner - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%NacMass - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PtfmMass - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PtfmPIner - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PtfmRIner - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PtfmYIner - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RFrlMass - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RotIner - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RotMass - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RrfaIner - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%SecondMom) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SecondMom,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SecondMom,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%SecondMom,1), UBOUND(InData%SecondMom,1) - ReKiBuf(Re_Xferred) = InData%SecondMom(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%TFinMass - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TFrlIner - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%TipMass) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TipMass,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TipMass,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TipMass,1), UBOUND(InData%TipMass,1) - ReKiBuf(Re_Xferred) = InData%TipMass(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%TurbMass - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TwrMass - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TwrTpMass - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%YawBrMass - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Gravity - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%PitchAxis) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PitchAxis,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PitchAxis,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PitchAxis,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PitchAxis,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PitchAxis,2), UBOUND(InData%PitchAxis,2) - DO i1 = LBOUND(InData%PitchAxis,1), UBOUND(InData%PitchAxis,1) - ReKiBuf(Re_Xferred) = InData%PitchAxis(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AeroTwst) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AeroTwst,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AeroTwst,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%AeroTwst,1), UBOUND(InData%AeroTwst,1) - ReKiBuf(Re_Xferred) = InData%AeroTwst(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AxRedBld) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AxRedBld,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AxRedBld,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AxRedBld,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AxRedBld,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AxRedBld,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AxRedBld,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AxRedBld,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AxRedBld,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%AxRedBld,4), UBOUND(InData%AxRedBld,4) - DO i3 = LBOUND(InData%AxRedBld,3), UBOUND(InData%AxRedBld,3) - DO i2 = LBOUND(InData%AxRedBld,2), UBOUND(InData%AxRedBld,2) - DO i1 = LBOUND(InData%AxRedBld,1), UBOUND(InData%AxRedBld,1) - ReKiBuf(Re_Xferred) = InData%AxRedBld(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BldEDamp) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BldEDamp,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldEDamp,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BldEDamp,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldEDamp,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%BldEDamp,2), UBOUND(InData%BldEDamp,2) - DO i1 = LBOUND(InData%BldEDamp,1), UBOUND(InData%BldEDamp,1) - ReKiBuf(Re_Xferred) = InData%BldEDamp(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BldFDamp) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BldFDamp,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldFDamp,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BldFDamp,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldFDamp,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%BldFDamp,2), UBOUND(InData%BldFDamp,2) - DO i1 = LBOUND(InData%BldFDamp,1), UBOUND(InData%BldFDamp,1) - ReKiBuf(Re_Xferred) = InData%BldFDamp(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - ReKiBuf(Re_Xferred) = InData%BldFlexL - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%CAeroTwst) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CAeroTwst,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CAeroTwst,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%CAeroTwst,1), UBOUND(InData%CAeroTwst,1) - ReKiBuf(Re_Xferred) = InData%CAeroTwst(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CBE) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CBE,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CBE,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CBE,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CBE,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CBE,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CBE,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%CBE,3), UBOUND(InData%CBE,3) - DO i2 = LBOUND(InData%CBE,2), UBOUND(InData%CBE,2) - DO i1 = LBOUND(InData%CBE,1), UBOUND(InData%CBE,1) - ReKiBuf(Re_Xferred) = InData%CBE(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CBF) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CBF,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CBF,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CBF,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CBF,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CBF,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CBF,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%CBF,3), UBOUND(InData%CBF,3) - DO i2 = LBOUND(InData%CBF,2), UBOUND(InData%CBF,2) - DO i1 = LBOUND(InData%CBF,1), UBOUND(InData%CBF,1) - ReKiBuf(Re_Xferred) = InData%CBF(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Chord) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Chord,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Chord,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Chord,1), UBOUND(InData%Chord,1) - ReKiBuf(Re_Xferred) = InData%Chord(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CThetaS) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CThetaS,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CThetaS,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CThetaS,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CThetaS,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%CThetaS,2), UBOUND(InData%CThetaS,2) - DO i1 = LBOUND(InData%CThetaS,1), UBOUND(InData%CThetaS,1) - DbKiBuf(Db_Xferred) = InData%CThetaS(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%DRNodes) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DRNodes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DRNodes,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%DRNodes,1), UBOUND(InData%DRNodes,1) - ReKiBuf(Re_Xferred) = InData%DRNodes(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%FStTunr) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FStTunr,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FStTunr,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FStTunr,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FStTunr,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%FStTunr,2), UBOUND(InData%FStTunr,2) - DO i1 = LBOUND(InData%FStTunr,1), UBOUND(InData%FStTunr,1) - ReKiBuf(Re_Xferred) = InData%FStTunr(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%KBE) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%KBE,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%KBE,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%KBE,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%KBE,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%KBE,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%KBE,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%KBE,3), UBOUND(InData%KBE,3) - DO i2 = LBOUND(InData%KBE,2), UBOUND(InData%KBE,2) - DO i1 = LBOUND(InData%KBE,1), UBOUND(InData%KBE,1) - ReKiBuf(Re_Xferred) = InData%KBE(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%KBF) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%KBF,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%KBF,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%KBF,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%KBF,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%KBF,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%KBF,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%KBF,3), UBOUND(InData%KBF,3) - DO i2 = LBOUND(InData%KBF,2), UBOUND(InData%KBF,2) - DO i1 = LBOUND(InData%KBF,1), UBOUND(InData%KBF,1) - ReKiBuf(Re_Xferred) = InData%KBF(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%MassB) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MassB,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MassB,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MassB,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MassB,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%MassB,2), UBOUND(InData%MassB,2) - DO i1 = LBOUND(InData%MassB,1), UBOUND(InData%MassB,1) - ReKiBuf(Re_Xferred) = InData%MassB(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%RNodes) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RNodes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RNodes,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%RNodes,1), UBOUND(InData%RNodes,1) - ReKiBuf(Re_Xferred) = InData%RNodes(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%RNodesNorm) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RNodesNorm,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RNodesNorm,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%RNodesNorm,1), UBOUND(InData%RNodesNorm,1) - ReKiBuf(Re_Xferred) = InData%RNodesNorm(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%rSAerCenn1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rSAerCenn1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rSAerCenn1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rSAerCenn1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rSAerCenn1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%rSAerCenn1,2), UBOUND(InData%rSAerCenn1,2) - DO i1 = LBOUND(InData%rSAerCenn1,1), UBOUND(InData%rSAerCenn1,1) - ReKiBuf(Re_Xferred) = InData%rSAerCenn1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%rSAerCenn2) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rSAerCenn2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rSAerCenn2,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rSAerCenn2,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rSAerCenn2,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%rSAerCenn2,2), UBOUND(InData%rSAerCenn2,2) - DO i1 = LBOUND(InData%rSAerCenn2,1), UBOUND(InData%rSAerCenn2,1) - ReKiBuf(Re_Xferred) = InData%rSAerCenn2(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%SAeroTwst) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SAeroTwst,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SAeroTwst,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%SAeroTwst,1), UBOUND(InData%SAeroTwst,1) - ReKiBuf(Re_Xferred) = InData%SAeroTwst(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%StiffBE) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StiffBE,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StiffBE,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StiffBE,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StiffBE,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%StiffBE,2), UBOUND(InData%StiffBE,2) - DO i1 = LBOUND(InData%StiffBE,1), UBOUND(InData%StiffBE,1) - ReKiBuf(Re_Xferred) = InData%StiffBE(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%StiffBF) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StiffBF,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StiffBF,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StiffBF,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StiffBF,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%StiffBF,2), UBOUND(InData%StiffBF,2) - DO i1 = LBOUND(InData%StiffBF,1), UBOUND(InData%StiffBF,1) - ReKiBuf(Re_Xferred) = InData%StiffBF(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%SThetaS) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SThetaS,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SThetaS,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SThetaS,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SThetaS,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%SThetaS,2), UBOUND(InData%SThetaS,2) - DO i1 = LBOUND(InData%SThetaS,1), UBOUND(InData%SThetaS,1) - DbKiBuf(Db_Xferred) = InData%SThetaS(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ThetaS) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ThetaS,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ThetaS,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ThetaS,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ThetaS,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%ThetaS,2), UBOUND(InData%ThetaS,2) - DO i1 = LBOUND(InData%ThetaS,1), UBOUND(InData%ThetaS,1) - ReKiBuf(Re_Xferred) = InData%ThetaS(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TwistedSF) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwistedSF,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwistedSF,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwistedSF,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwistedSF,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwistedSF,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwistedSF,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwistedSF,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwistedSF,4) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwistedSF,5) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwistedSF,5) - Int_Xferred = Int_Xferred + 2 - - DO i5 = LBOUND(InData%TwistedSF,5), UBOUND(InData%TwistedSF,5) - DO i4 = LBOUND(InData%TwistedSF,4), UBOUND(InData%TwistedSF,4) - DO i3 = LBOUND(InData%TwistedSF,3), UBOUND(InData%TwistedSF,3) - DO i2 = LBOUND(InData%TwistedSF,2), UBOUND(InData%TwistedSF,2) - DO i1 = LBOUND(InData%TwistedSF,1), UBOUND(InData%TwistedSF,1) - ReKiBuf(Re_Xferred) = InData%TwistedSF(i1,i2,i3,i4,i5) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BldFl1Sh) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BldFl1Sh,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldFl1Sh,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BldFl1Sh,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldFl1Sh,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%BldFl1Sh,2), UBOUND(InData%BldFl1Sh,2) - DO i1 = LBOUND(InData%BldFl1Sh,1), UBOUND(InData%BldFl1Sh,1) - ReKiBuf(Re_Xferred) = InData%BldFl1Sh(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BldFl2Sh) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BldFl2Sh,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldFl2Sh,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BldFl2Sh,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldFl2Sh,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%BldFl2Sh,2), UBOUND(InData%BldFl2Sh,2) - DO i1 = LBOUND(InData%BldFl2Sh,1), UBOUND(InData%BldFl2Sh,1) - ReKiBuf(Re_Xferred) = InData%BldFl2Sh(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BldEdgSh) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BldEdgSh,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldEdgSh,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BldEdgSh,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldEdgSh,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%BldEdgSh,2), UBOUND(InData%BldEdgSh,2) - DO i1 = LBOUND(InData%BldEdgSh,1), UBOUND(InData%BldEdgSh,1) - ReKiBuf(Re_Xferred) = InData%BldEdgSh(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%FreqBE) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FreqBE,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FreqBE,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FreqBE,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FreqBE,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FreqBE,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FreqBE,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%FreqBE,3), UBOUND(InData%FreqBE,3) - DO i2 = LBOUND(InData%FreqBE,2), UBOUND(InData%FreqBE,2) - DO i1 = LBOUND(InData%FreqBE,1), UBOUND(InData%FreqBE,1) - ReKiBuf(Re_Xferred) = InData%FreqBE(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%FreqBF) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FreqBF,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FreqBF,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FreqBF,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FreqBF,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FreqBF,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FreqBF,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%FreqBF,3), UBOUND(InData%FreqBF,3) - DO i2 = LBOUND(InData%FreqBF,2), UBOUND(InData%FreqBF,2) - DO i1 = LBOUND(InData%FreqBF,1), UBOUND(InData%FreqBF,1) - ReKiBuf(Re_Xferred) = InData%FreqBF(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - DO i2 = LBOUND(InData%FreqTFA,2), UBOUND(InData%FreqTFA,2) - DO i1 = LBOUND(InData%FreqTFA,1), UBOUND(InData%FreqTFA,1) - ReKiBuf(Re_Xferred) = InData%FreqTFA(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - DO i2 = LBOUND(InData%FreqTSS,2), UBOUND(InData%FreqTSS,2) - DO i1 = LBOUND(InData%FreqTSS,1), UBOUND(InData%FreqTSS,1) - ReKiBuf(Re_Xferred) = InData%FreqTSS(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - ReKiBuf(Re_Xferred) = InData%TeetCDmp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TeetDmp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TeetDmpP - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TeetHSSp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TeetHStP - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TeetSSSp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TeetSStP - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%TeetMod - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TFrlDmp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TFrlDSDmp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TFrlDSDP - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TFrlDSSP - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TFrlDSSpr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TFrlSpr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TFrlUSDmp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TFrlUSDP - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TFrlUSSP - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TFrlUSSpr - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%TFrlMod - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RFrlDmp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RFrlDSDmp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RFrlDSDP - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RFrlDSSP - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RFrlDSSpr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RFrlSpr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RFrlUSDmp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RFrlUSDP - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RFrlUSSP - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RFrlUSSpr - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%RFrlMod - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%ShftGagL - Re_Xferred = Re_Xferred + 1 - DO i1 = LBOUND(InData%BldGagNd,1), UBOUND(InData%BldGagNd,1) - IntKiBuf(Int_Xferred) = InData%BldGagNd(i1) - Int_Xferred = Int_Xferred + 1 - END DO - DO i1 = LBOUND(InData%TwrGagNd,1), UBOUND(InData%TwrGagNd,1) - IntKiBuf(Int_Xferred) = InData%TwrGagNd(i1) - Int_Xferred = Int_Xferred + 1 - END DO - DbKiBuf(Db_Xferred) = InData%TStart - Db_Xferred = Db_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%DTTorDmp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%DTTorSpr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%GBRatio - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%GBoxEff - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RotSpeed - Re_Xferred = Re_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%BElmntMass) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BElmntMass,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BElmntMass,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BElmntMass,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BElmntMass,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%BElmntMass,2), UBOUND(InData%BElmntMass,2) - DO i1 = LBOUND(InData%BElmntMass,1), UBOUND(InData%BElmntMass,1) - ReKiBuf(Re_Xferred) = InData%BElmntMass(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TElmntMass) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TElmntMass,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TElmntMass,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TElmntMass,1), UBOUND(InData%TElmntMass,1) - ReKiBuf(Re_Xferred) = InData%TElmntMass(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%method - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PtfmCMxt - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PtfmCMyt - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%BD4Blades, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%UseAD14, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%BldNd_NumOuts - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%BldNd_TotNumOuts - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%BldNd_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%BldNd_OutParam,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldNd_OutParam,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BldNd_OutParam,1), UBOUND(InData%BldNd_OutParam,1) - CALL NWTC_Library_Packoutparmtype( Re_Buf, Db_Buf, Int_Buf, InData%BldNd_OutParam(i1), ErrStat2, ErrMsg2, OnlySize ) ! BldNd_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) = InData%BldNd_BladesOut - 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 - IF ( .NOT. ALLOCATED(InData%dx) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%dx,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dx,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%dx,1), UBOUND(InData%dx,1) - DbKiBuf(Db_Xferred) = InData%dx(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%Jac_ny - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE ED_PackParam - - SUBROUTINE ED_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(ED_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) :: 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) :: i5, i5_l, i5_u ! bounds (upper/lower) for an array dimension 5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_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%DT24 = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%BldNodes = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TipNode = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NDOF = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TwoPiNB = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%NAug = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NPH = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PH not allocated - Int_Xferred = Int_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%PH)) DEALLOCATE(OutData%PH) - ALLOCATE(OutData%PH(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PH.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PH,1), UBOUND(OutData%PH,1) - OutData%PH(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - OutData%NPM = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PM not allocated - Int_Xferred = Int_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%PM)) DEALLOCATE(OutData%PM) - ALLOCATE(OutData%PM(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PM,2), UBOUND(OutData%PM,2) - DO i1 = LBOUND(OutData%PM,1), UBOUND(OutData%PM,1) - OutData%PM(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DOF_Flag not allocated - Int_Xferred = Int_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%DOF_Flag)) DEALLOCATE(OutData%DOF_Flag) - ALLOCATE(OutData%DOF_Flag(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DOF_Flag.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%DOF_Flag,1), UBOUND(OutData%DOF_Flag,1) - OutData%DOF_Flag(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%DOF_Flag(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DOF_Desc not allocated - Int_Xferred = Int_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%DOF_Desc)) DEALLOCATE(OutData%DOF_Desc) - ALLOCATE(OutData%DOF_Desc(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DOF_Desc.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%DOF_Desc,1), UBOUND(OutData%DOF_Desc,1) - DO I = 1, LEN(OutData%DOF_Desc) - OutData%DOF_Desc(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 ED_Unpackactivedofs( Re_Buf, Db_Buf, Int_Buf, OutData%DOFs, ErrStat2, ErrMsg2 ) ! DOFs - 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%NumOuts = IntKiBuf(Int_Xferred) - 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%NBlGages = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NTwGages = 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 - DO I = 1, LEN(OutData%Delim) - OutData%Delim(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%AvgNrmTpRd = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%AzimB1Up = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%CosDel3 = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CosPreC not allocated - Int_Xferred = Int_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%CosPreC)) DEALLOCATE(OutData%CosPreC) - ALLOCATE(OutData%CosPreC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CosPreC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%CosPreC,1), UBOUND(OutData%CosPreC,1) - OutData%CosPreC(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - OutData%CRFrlSkew = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%CRFrlSkw2 = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%CRFrlTilt = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%CRFrlTlt2 = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%CShftSkew = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%CShftTilt = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%CSRFrlSkw = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%CSRFrlTlt = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%CSTFrlSkw = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%CSTFrlTlt = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%CTFrlSkew = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%CTFrlSkw2 = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%CTFrlTilt = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%CTFrlTlt2 = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%HubHt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%HubCM = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%HubRad = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NacCMxn = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NacCMyn = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NacCMzn = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%OverHang = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%ProjArea = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmRefzt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RefTwrHt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%RFrlPnt_n,1) - i1_u = UBOUND(OutData%RFrlPnt_n,1) - DO i1 = LBOUND(OutData%RFrlPnt_n,1), UBOUND(OutData%RFrlPnt_n,1) - OutData%RFrlPnt_n(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%rVDxn = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%rVDyn = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%rVDzn = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%rVIMUxn = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%rVIMUyn = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%rVIMUzn = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%rVPxn = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%rVPyn = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%rVPzn = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%rWIxn = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%rWIyn = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%rWIzn = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%rWJxn = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%rWJyn = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%rWJzn = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%rZT0zt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%rZYzt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SinDel3 = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SinPreC not allocated - Int_Xferred = Int_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%SinPreC)) DEALLOCATE(OutData%SinPreC) - ALLOCATE(OutData%SinPreC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SinPreC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%SinPreC,1), UBOUND(OutData%SinPreC,1) - OutData%SinPreC(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - OutData%SRFrlSkew = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%SRFrlSkw2 = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%SRFrlTilt = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%SRFrlTlt2 = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%SShftSkew = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%SShftTilt = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%STFrlSkew = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%STFrlSkw2 = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%STFrlTilt = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%STFrlTlt2 = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - i1_l = LBOUND(OutData%TFrlPnt_n,1) - i1_u = UBOUND(OutData%TFrlPnt_n,1) - DO i1 = LBOUND(OutData%TFrlPnt_n,1), UBOUND(OutData%TFrlPnt_n,1) - OutData%TFrlPnt_n(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%TipRad = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TowerHt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TowerBsHt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%UndSling = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NumBl = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AxRedTFA not allocated - Int_Xferred = Int_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%AxRedTFA)) DEALLOCATE(OutData%AxRedTFA) - ALLOCATE(OutData%AxRedTFA(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%AxRedTFA.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%AxRedTFA,3), UBOUND(OutData%AxRedTFA,3) - DO i2 = LBOUND(OutData%AxRedTFA,2), UBOUND(OutData%AxRedTFA,2) - DO i1 = LBOUND(OutData%AxRedTFA,1), UBOUND(OutData%AxRedTFA,1) - OutData%AxRedTFA(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 ! AxRedTSS not allocated - Int_Xferred = Int_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%AxRedTSS)) DEALLOCATE(OutData%AxRedTSS) - ALLOCATE(OutData%AxRedTSS(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%AxRedTSS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%AxRedTSS,3), UBOUND(OutData%AxRedTSS,3) - DO i2 = LBOUND(OutData%AxRedTSS,2), UBOUND(OutData%AxRedTSS,2) - DO i1 = LBOUND(OutData%AxRedTSS,1), UBOUND(OutData%AxRedTSS,1) - OutData%AxRedTSS(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - i1_l = LBOUND(OutData%CTFA,1) - i1_u = UBOUND(OutData%CTFA,1) - i2_l = LBOUND(OutData%CTFA,2) - i2_u = UBOUND(OutData%CTFA,2) - DO i2 = LBOUND(OutData%CTFA,2), UBOUND(OutData%CTFA,2) - DO i1 = LBOUND(OutData%CTFA,1), UBOUND(OutData%CTFA,1) - OutData%CTFA(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%CTSS,1) - i1_u = UBOUND(OutData%CTSS,1) - i2_l = LBOUND(OutData%CTSS,2) - i2_u = UBOUND(OutData%CTSS,2) - DO i2 = LBOUND(OutData%CTSS,2), UBOUND(OutData%CTSS,2) - DO i1 = LBOUND(OutData%CTSS,1), UBOUND(OutData%CTSS,1) - OutData%CTSS(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DHNodes not allocated - Int_Xferred = Int_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%DHNodes)) DEALLOCATE(OutData%DHNodes) - ALLOCATE(OutData%DHNodes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DHNodes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%DHNodes,1), UBOUND(OutData%DHNodes,1) - OutData%DHNodes(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! HNodes not allocated - Int_Xferred = Int_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%HNodes)) DEALLOCATE(OutData%HNodes) - ALLOCATE(OutData%HNodes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%HNodes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%HNodes,1), UBOUND(OutData%HNodes,1) - OutData%HNodes(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! HNodesNorm not allocated - Int_Xferred = Int_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%HNodesNorm)) DEALLOCATE(OutData%HNodesNorm) - ALLOCATE(OutData%HNodesNorm(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%HNodesNorm.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%HNodesNorm,1), UBOUND(OutData%HNodesNorm,1) - OutData%HNodesNorm(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - i1_l = LBOUND(OutData%KTFA,1) - i1_u = UBOUND(OutData%KTFA,1) - i2_l = LBOUND(OutData%KTFA,2) - i2_u = UBOUND(OutData%KTFA,2) - DO i2 = LBOUND(OutData%KTFA,2), UBOUND(OutData%KTFA,2) - DO i1 = LBOUND(OutData%KTFA,1), UBOUND(OutData%KTFA,1) - OutData%KTFA(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%KTSS,1) - i1_u = UBOUND(OutData%KTSS,1) - i2_l = LBOUND(OutData%KTSS,2) - i2_u = UBOUND(OutData%KTSS,2) - DO i2 = LBOUND(OutData%KTSS,2), UBOUND(OutData%KTSS,2) - DO i1 = LBOUND(OutData%KTSS,1), UBOUND(OutData%KTSS,1) - OutData%KTSS(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MassT not allocated - Int_Xferred = Int_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%MassT)) DEALLOCATE(OutData%MassT) - ALLOCATE(OutData%MassT(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MassT.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%MassT,1), UBOUND(OutData%MassT,1) - OutData%MassT(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StiffTSS not allocated - Int_Xferred = Int_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%StiffTSS)) DEALLOCATE(OutData%StiffTSS) - ALLOCATE(OutData%StiffTSS(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StiffTSS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%StiffTSS,1), UBOUND(OutData%StiffTSS,1) - OutData%StiffTSS(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrFASF not allocated - Int_Xferred = Int_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%TwrFASF)) DEALLOCATE(OutData%TwrFASF) - ALLOCATE(OutData%TwrFASF(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%TwrFASF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%TwrFASF,3), UBOUND(OutData%TwrFASF,3) - DO i2 = LBOUND(OutData%TwrFASF,2), UBOUND(OutData%TwrFASF,2) - DO i1 = LBOUND(OutData%TwrFASF,1), UBOUND(OutData%TwrFASF,1) - OutData%TwrFASF(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - OutData%TwrFlexL = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrSSSF not allocated - Int_Xferred = Int_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%TwrSSSF)) DEALLOCATE(OutData%TwrSSSF) - ALLOCATE(OutData%TwrSSSF(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%TwrSSSF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%TwrSSSF,3), UBOUND(OutData%TwrSSSF,3) - DO i2 = LBOUND(OutData%TwrSSSF,2), UBOUND(OutData%TwrSSSF,2) - DO i1 = LBOUND(OutData%TwrSSSF,1), UBOUND(OutData%TwrSSSF,1) - OutData%TwrSSSF(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - OutData%TTopNode = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TwrNodes = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%MHK = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StiffTFA not allocated - Int_Xferred = Int_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%StiffTFA)) DEALLOCATE(OutData%StiffTFA) - ALLOCATE(OutData%StiffTFA(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StiffTFA.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%StiffTFA,1), UBOUND(OutData%StiffTFA,1) - OutData%StiffTFA(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%AtfaIner = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldCG not allocated - Int_Xferred = Int_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%BldCG)) DEALLOCATE(OutData%BldCG) - ALLOCATE(OutData%BldCG(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldCG.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BldCG,1), UBOUND(OutData%BldCG,1) - OutData%BldCG(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldMass not allocated - Int_Xferred = Int_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%BldMass)) DEALLOCATE(OutData%BldMass) - ALLOCATE(OutData%BldMass(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldMass.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BldMass,1), UBOUND(OutData%BldMass,1) - OutData%BldMass(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%BoomMass = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FirstMom not allocated - Int_Xferred = Int_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%FirstMom)) DEALLOCATE(OutData%FirstMom) - ALLOCATE(OutData%FirstMom(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FirstMom.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%FirstMom,1), UBOUND(OutData%FirstMom,1) - OutData%FirstMom(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%GenIner = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Hubg1Iner = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Hubg2Iner = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%HubMass = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Nacd2Iner = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NacMass = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmMass = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmPIner = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmRIner = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmYIner = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlMass = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RotIner = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RotMass = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RrfaIner = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SecondMom not allocated - Int_Xferred = Int_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%SecondMom)) DEALLOCATE(OutData%SecondMom) - ALLOCATE(OutData%SecondMom(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SecondMom.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%SecondMom,1), UBOUND(OutData%SecondMom,1) - OutData%SecondMom(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%TFinMass = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlIner = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TipMass not allocated - Int_Xferred = Int_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%TipMass)) DEALLOCATE(OutData%TipMass) - ALLOCATE(OutData%TipMass(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TipMass.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TipMass,1), UBOUND(OutData%TipMass,1) - OutData%TipMass(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%TurbMass = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TwrMass = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TwrTpMass = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%YawBrMass = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Gravity = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PitchAxis not allocated - Int_Xferred = Int_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%PitchAxis)) DEALLOCATE(OutData%PitchAxis) - ALLOCATE(OutData%PitchAxis(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PitchAxis.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PitchAxis,2), UBOUND(OutData%PitchAxis,2) - DO i1 = LBOUND(OutData%PitchAxis,1), UBOUND(OutData%PitchAxis,1) - OutData%PitchAxis(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AeroTwst not allocated - Int_Xferred = Int_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%AeroTwst)) DEALLOCATE(OutData%AeroTwst) - ALLOCATE(OutData%AeroTwst(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AeroTwst.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%AeroTwst,1), UBOUND(OutData%AeroTwst,1) - OutData%AeroTwst(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AxRedBld not allocated - Int_Xferred = Int_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%AxRedBld)) DEALLOCATE(OutData%AxRedBld) - ALLOCATE(OutData%AxRedBld(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%AxRedBld.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%AxRedBld,4), UBOUND(OutData%AxRedBld,4) - DO i3 = LBOUND(OutData%AxRedBld,3), UBOUND(OutData%AxRedBld,3) - DO i2 = LBOUND(OutData%AxRedBld,2), UBOUND(OutData%AxRedBld,2) - DO i1 = LBOUND(OutData%AxRedBld,1), UBOUND(OutData%AxRedBld,1) - OutData%AxRedBld(i1,i2,i3,i4) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldEDamp not allocated - Int_Xferred = Int_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%BldEDamp)) DEALLOCATE(OutData%BldEDamp) - ALLOCATE(OutData%BldEDamp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldEDamp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%BldEDamp,2), UBOUND(OutData%BldEDamp,2) - DO i1 = LBOUND(OutData%BldEDamp,1), UBOUND(OutData%BldEDamp,1) - OutData%BldEDamp(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldFDamp not allocated - Int_Xferred = Int_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%BldFDamp)) DEALLOCATE(OutData%BldFDamp) - ALLOCATE(OutData%BldFDamp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldFDamp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%BldFDamp,2), UBOUND(OutData%BldFDamp,2) - DO i1 = LBOUND(OutData%BldFDamp,1), UBOUND(OutData%BldFDamp,1) - OutData%BldFDamp(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%BldFlexL = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CAeroTwst not allocated - Int_Xferred = Int_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%CAeroTwst)) DEALLOCATE(OutData%CAeroTwst) - ALLOCATE(OutData%CAeroTwst(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CAeroTwst.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%CAeroTwst,1), UBOUND(OutData%CAeroTwst,1) - OutData%CAeroTwst(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CBE not allocated - Int_Xferred = Int_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%CBE)) DEALLOCATE(OutData%CBE) - ALLOCATE(OutData%CBE(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%CBE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%CBE,3), UBOUND(OutData%CBE,3) - DO i2 = LBOUND(OutData%CBE,2), UBOUND(OutData%CBE,2) - DO i1 = LBOUND(OutData%CBE,1), UBOUND(OutData%CBE,1) - OutData%CBE(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 ! CBF not allocated - Int_Xferred = Int_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%CBF)) DEALLOCATE(OutData%CBF) - ALLOCATE(OutData%CBF(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%CBF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%CBF,3), UBOUND(OutData%CBF,3) - DO i2 = LBOUND(OutData%CBF,2), UBOUND(OutData%CBF,2) - DO i1 = LBOUND(OutData%CBF,1), UBOUND(OutData%CBF,1) - OutData%CBF(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 ! Chord not allocated - Int_Xferred = Int_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%Chord)) DEALLOCATE(OutData%Chord) - ALLOCATE(OutData%Chord(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Chord.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Chord,1), UBOUND(OutData%Chord,1) - OutData%Chord(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CThetaS not allocated - Int_Xferred = Int_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%CThetaS)) DEALLOCATE(OutData%CThetaS) - ALLOCATE(OutData%CThetaS(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CThetaS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%CThetaS,2), UBOUND(OutData%CThetaS,2) - DO i1 = LBOUND(OutData%CThetaS,1), UBOUND(OutData%CThetaS,1) - OutData%CThetaS(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DRNodes not allocated - Int_Xferred = Int_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%DRNodes)) DEALLOCATE(OutData%DRNodes) - ALLOCATE(OutData%DRNodes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DRNodes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%DRNodes,1), UBOUND(OutData%DRNodes,1) - OutData%DRNodes(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FStTunr not allocated - Int_Xferred = Int_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%FStTunr)) DEALLOCATE(OutData%FStTunr) - ALLOCATE(OutData%FStTunr(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FStTunr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%FStTunr,2), UBOUND(OutData%FStTunr,2) - DO i1 = LBOUND(OutData%FStTunr,1), UBOUND(OutData%FStTunr,1) - OutData%FStTunr(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! KBE not allocated - Int_Xferred = Int_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%KBE)) DEALLOCATE(OutData%KBE) - ALLOCATE(OutData%KBE(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%KBE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%KBE,3), UBOUND(OutData%KBE,3) - DO i2 = LBOUND(OutData%KBE,2), UBOUND(OutData%KBE,2) - DO i1 = LBOUND(OutData%KBE,1), UBOUND(OutData%KBE,1) - OutData%KBE(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 ! KBF not allocated - Int_Xferred = Int_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%KBF)) DEALLOCATE(OutData%KBF) - ALLOCATE(OutData%KBF(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%KBF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%KBF,3), UBOUND(OutData%KBF,3) - DO i2 = LBOUND(OutData%KBF,2), UBOUND(OutData%KBF,2) - DO i1 = LBOUND(OutData%KBF,1), UBOUND(OutData%KBF,1) - OutData%KBF(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 ! MassB not allocated - Int_Xferred = Int_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%MassB)) DEALLOCATE(OutData%MassB) - ALLOCATE(OutData%MassB(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MassB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%MassB,2), UBOUND(OutData%MassB,2) - DO i1 = LBOUND(OutData%MassB,1), UBOUND(OutData%MassB,1) - OutData%MassB(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RNodes not allocated - Int_Xferred = Int_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%RNodes)) DEALLOCATE(OutData%RNodes) - ALLOCATE(OutData%RNodes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RNodes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%RNodes,1), UBOUND(OutData%RNodes,1) - OutData%RNodes(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RNodesNorm not allocated - Int_Xferred = Int_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%RNodesNorm)) DEALLOCATE(OutData%RNodesNorm) - ALLOCATE(OutData%RNodesNorm(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RNodesNorm.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%RNodesNorm,1), UBOUND(OutData%RNodesNorm,1) - OutData%RNodesNorm(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rSAerCenn1 not allocated - Int_Xferred = Int_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%rSAerCenn1)) DEALLOCATE(OutData%rSAerCenn1) - ALLOCATE(OutData%rSAerCenn1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rSAerCenn1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%rSAerCenn1,2), UBOUND(OutData%rSAerCenn1,2) - DO i1 = LBOUND(OutData%rSAerCenn1,1), UBOUND(OutData%rSAerCenn1,1) - OutData%rSAerCenn1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rSAerCenn2 not allocated - Int_Xferred = Int_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%rSAerCenn2)) DEALLOCATE(OutData%rSAerCenn2) - ALLOCATE(OutData%rSAerCenn2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rSAerCenn2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%rSAerCenn2,2), UBOUND(OutData%rSAerCenn2,2) - DO i1 = LBOUND(OutData%rSAerCenn2,1), UBOUND(OutData%rSAerCenn2,1) - OutData%rSAerCenn2(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SAeroTwst not allocated - Int_Xferred = Int_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%SAeroTwst)) DEALLOCATE(OutData%SAeroTwst) - ALLOCATE(OutData%SAeroTwst(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SAeroTwst.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%SAeroTwst,1), UBOUND(OutData%SAeroTwst,1) - OutData%SAeroTwst(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StiffBE not allocated - Int_Xferred = Int_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%StiffBE)) DEALLOCATE(OutData%StiffBE) - ALLOCATE(OutData%StiffBE(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StiffBE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%StiffBE,2), UBOUND(OutData%StiffBE,2) - DO i1 = LBOUND(OutData%StiffBE,1), UBOUND(OutData%StiffBE,1) - OutData%StiffBE(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StiffBF not allocated - Int_Xferred = Int_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%StiffBF)) DEALLOCATE(OutData%StiffBF) - ALLOCATE(OutData%StiffBF(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StiffBF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%StiffBF,2), UBOUND(OutData%StiffBF,2) - DO i1 = LBOUND(OutData%StiffBF,1), UBOUND(OutData%StiffBF,1) - OutData%StiffBF(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SThetaS not allocated - Int_Xferred = Int_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%SThetaS)) DEALLOCATE(OutData%SThetaS) - ALLOCATE(OutData%SThetaS(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SThetaS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%SThetaS,2), UBOUND(OutData%SThetaS,2) - DO i1 = LBOUND(OutData%SThetaS,1), UBOUND(OutData%SThetaS,1) - OutData%SThetaS(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ThetaS not allocated - Int_Xferred = Int_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%ThetaS)) DEALLOCATE(OutData%ThetaS) - ALLOCATE(OutData%ThetaS(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ThetaS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%ThetaS,2), UBOUND(OutData%ThetaS,2) - DO i1 = LBOUND(OutData%ThetaS,1), UBOUND(OutData%ThetaS,1) - OutData%ThetaS(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwistedSF not allocated - Int_Xferred = Int_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 - i5_l = IntKiBuf( Int_Xferred ) - i5_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%TwistedSF)) DEALLOCATE(OutData%TwistedSF) - ALLOCATE(OutData%TwistedSF(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u,i5_l:i5_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwistedSF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i5 = LBOUND(OutData%TwistedSF,5), UBOUND(OutData%TwistedSF,5) - DO i4 = LBOUND(OutData%TwistedSF,4), UBOUND(OutData%TwistedSF,4) - DO i3 = LBOUND(OutData%TwistedSF,3), UBOUND(OutData%TwistedSF,3) - DO i2 = LBOUND(OutData%TwistedSF,2), UBOUND(OutData%TwistedSF,2) - DO i1 = LBOUND(OutData%TwistedSF,1), UBOUND(OutData%TwistedSF,1) - OutData%TwistedSF(i1,i2,i3,i4,i5) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldFl1Sh not allocated - Int_Xferred = Int_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%BldFl1Sh)) DEALLOCATE(OutData%BldFl1Sh) - ALLOCATE(OutData%BldFl1Sh(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldFl1Sh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%BldFl1Sh,2), UBOUND(OutData%BldFl1Sh,2) - DO i1 = LBOUND(OutData%BldFl1Sh,1), UBOUND(OutData%BldFl1Sh,1) - OutData%BldFl1Sh(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldFl2Sh not allocated - Int_Xferred = Int_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%BldFl2Sh)) DEALLOCATE(OutData%BldFl2Sh) - ALLOCATE(OutData%BldFl2Sh(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldFl2Sh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%BldFl2Sh,2), UBOUND(OutData%BldFl2Sh,2) - DO i1 = LBOUND(OutData%BldFl2Sh,1), UBOUND(OutData%BldFl2Sh,1) - OutData%BldFl2Sh(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldEdgSh not allocated - Int_Xferred = Int_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%BldEdgSh)) DEALLOCATE(OutData%BldEdgSh) - ALLOCATE(OutData%BldEdgSh(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldEdgSh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%BldEdgSh,2), UBOUND(OutData%BldEdgSh,2) - DO i1 = LBOUND(OutData%BldEdgSh,1), UBOUND(OutData%BldEdgSh,1) - OutData%BldEdgSh(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FreqBE not allocated - Int_Xferred = Int_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%FreqBE)) DEALLOCATE(OutData%FreqBE) - ALLOCATE(OutData%FreqBE(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%FreqBE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%FreqBE,3), UBOUND(OutData%FreqBE,3) - DO i2 = LBOUND(OutData%FreqBE,2), UBOUND(OutData%FreqBE,2) - DO i1 = LBOUND(OutData%FreqBE,1), UBOUND(OutData%FreqBE,1) - OutData%FreqBE(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 ! FreqBF not allocated - Int_Xferred = Int_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%FreqBF)) DEALLOCATE(OutData%FreqBF) - ALLOCATE(OutData%FreqBF(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%FreqBF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%FreqBF,3), UBOUND(OutData%FreqBF,3) - DO i2 = LBOUND(OutData%FreqBF,2), UBOUND(OutData%FreqBF,2) - DO i1 = LBOUND(OutData%FreqBF,1), UBOUND(OutData%FreqBF,1) - OutData%FreqBF(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - i1_l = LBOUND(OutData%FreqTFA,1) - i1_u = UBOUND(OutData%FreqTFA,1) - i2_l = LBOUND(OutData%FreqTFA,2) - i2_u = UBOUND(OutData%FreqTFA,2) - DO i2 = LBOUND(OutData%FreqTFA,2), UBOUND(OutData%FreqTFA,2) - DO i1 = LBOUND(OutData%FreqTFA,1), UBOUND(OutData%FreqTFA,1) - OutData%FreqTFA(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%FreqTSS,1) - i1_u = UBOUND(OutData%FreqTSS,1) - i2_l = LBOUND(OutData%FreqTSS,2) - i2_u = UBOUND(OutData%FreqTSS,2) - DO i2 = LBOUND(OutData%FreqTSS,2), UBOUND(OutData%FreqTSS,2) - DO i1 = LBOUND(OutData%FreqTSS,1), UBOUND(OutData%FreqTSS,1) - OutData%FreqTSS(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - OutData%TeetCDmp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TeetDmp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TeetDmpP = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TeetHSSp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TeetHStP = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TeetSSSp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TeetSStP = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TeetMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TFrlDmp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlDSDmp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlDSDP = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlDSSP = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlDSSpr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlSpr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlUSDmp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlUSDP = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlUSSP = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlUSSpr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%RFrlDmp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlDSDmp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlDSDP = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlDSSP = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlDSSpr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlSpr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlUSDmp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlUSDP = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlUSSP = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlUSSpr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%ShftGagL = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%BldGagNd,1) - i1_u = UBOUND(OutData%BldGagNd,1) - DO i1 = LBOUND(OutData%BldGagNd,1), UBOUND(OutData%BldGagNd,1) - OutData%BldGagNd(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - i1_l = LBOUND(OutData%TwrGagNd,1) - i1_u = UBOUND(OutData%TwrGagNd,1) - DO i1 = LBOUND(OutData%TwrGagNd,1), UBOUND(OutData%TwrGagNd,1) - OutData%TwrGagNd(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - OutData%TStart = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%DTTorDmp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%DTTorSpr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%GBRatio = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%GBoxEff = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RotSpeed = ReKiBuf(Re_Xferred) - Re_Xferred = Re_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 ! BElmntMass not allocated - Int_Xferred = Int_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%BElmntMass)) DEALLOCATE(OutData%BElmntMass) - ALLOCATE(OutData%BElmntMass(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BElmntMass.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%BElmntMass,2), UBOUND(OutData%BElmntMass,2) - DO i1 = LBOUND(OutData%BElmntMass,1), UBOUND(OutData%BElmntMass,1) - OutData%BElmntMass(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TElmntMass not allocated - Int_Xferred = Int_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%TElmntMass)) DEALLOCATE(OutData%TElmntMass) - ALLOCATE(OutData%TElmntMass(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TElmntMass.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TElmntMass,1), UBOUND(OutData%TElmntMass,1) - OutData%TElmntMass(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%method = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%PtfmCMxt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmCMyt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%BD4Blades = TRANSFER(IntKiBuf(Int_Xferred), OutData%BD4Blades) - Int_Xferred = Int_Xferred + 1 - OutData%UseAD14 = TRANSFER(IntKiBuf(Int_Xferred), OutData%UseAD14) - Int_Xferred = Int_Xferred + 1 - OutData%BldNd_NumOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%BldNd_TotNumOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldNd_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%BldNd_OutParam)) DEALLOCATE(OutData%BldNd_OutParam) - ALLOCATE(OutData%BldNd_OutParam(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldNd_OutParam.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BldNd_OutParam,1), UBOUND(OutData%BldNd_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%BldNd_OutParam(i1), ErrStat2, ErrMsg2 ) ! BldNd_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%BldNd_BladesOut = 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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! dx not allocated - Int_Xferred = Int_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%dx)) DEALLOCATE(OutData%dx) - ALLOCATE(OutData%dx(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%dx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - 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 - END IF - OutData%Jac_ny = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE ED_UnPackParam - - SUBROUTINE ED_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ED_InputType), INTENT(INOUT) :: SrcInputData - TYPE(ED_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) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_CopyInput' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcInputData%BladePtLoads)) THEN - i1_l = LBOUND(SrcInputData%BladePtLoads,1) - i1_u = UBOUND(SrcInputData%BladePtLoads,1) - IF (.NOT. ALLOCATED(DstInputData%BladePtLoads)) THEN - ALLOCATE(DstInputData%BladePtLoads(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%BladePtLoads.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcInputData%BladePtLoads,1), UBOUND(SrcInputData%BladePtLoads,1) - CALL MeshCopy( SrcInputData%BladePtLoads(i1), DstInputData%BladePtLoads(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL MeshCopy( SrcInputData%PlatformPtMesh, DstInputData%PlatformPtMesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcInputData%TowerPtLoads, DstInputData%TowerPtLoads, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcInputData%HubPtLoad, DstInputData%HubPtLoad, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcInputData%NacelleLoads, DstInputData%NacelleLoads, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcInputData%TFinCMLoads, DstInputData%TFinCMLoads, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcInputData%TwrAddedMass)) THEN - i1_l = LBOUND(SrcInputData%TwrAddedMass,1) - i1_u = UBOUND(SrcInputData%TwrAddedMass,1) - i2_l = LBOUND(SrcInputData%TwrAddedMass,2) - i2_u = UBOUND(SrcInputData%TwrAddedMass,2) - i3_l = LBOUND(SrcInputData%TwrAddedMass,3) - i3_u = UBOUND(SrcInputData%TwrAddedMass,3) - IF (.NOT. ALLOCATED(DstInputData%TwrAddedMass)) THEN - ALLOCATE(DstInputData%TwrAddedMass(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%TwrAddedMass.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%TwrAddedMass = SrcInputData%TwrAddedMass -ENDIF - DstInputData%PtfmAddedMass = SrcInputData%PtfmAddedMass -IF (ALLOCATED(SrcInputData%BlPitchCom)) THEN - i1_l = LBOUND(SrcInputData%BlPitchCom,1) - i1_u = UBOUND(SrcInputData%BlPitchCom,1) - IF (.NOT. ALLOCATED(DstInputData%BlPitchCom)) THEN - ALLOCATE(DstInputData%BlPitchCom(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%BlPitchCom.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%BlPitchCom = SrcInputData%BlPitchCom -ENDIF - DstInputData%YawMom = SrcInputData%YawMom - DstInputData%GenTrq = SrcInputData%GenTrq - DstInputData%HSSBrTrqC = SrcInputData%HSSBrTrqC - END SUBROUTINE ED_CopyInput - - SUBROUTINE ED_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(ED_InputType), INTENT(INOUT) :: InputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_DestroyInput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(InputData%BladePtLoads)) THEN -DO i1 = LBOUND(InputData%BladePtLoads,1), UBOUND(InputData%BladePtLoads,1) - CALL MeshDestroy( InputData%BladePtLoads(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(InputData%BladePtLoads) -ENDIF - CALL MeshDestroy( InputData%PlatformPtMesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( InputData%TowerPtLoads, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( InputData%HubPtLoad, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( InputData%NacelleLoads, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( InputData%TFinCMLoads, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(InputData%TwrAddedMass)) THEN - DEALLOCATE(InputData%TwrAddedMass) -ENDIF -IF (ALLOCATED(InputData%BlPitchCom)) THEN - DEALLOCATE(InputData%BlPitchCom) -ENDIF - END SUBROUTINE ED_DestroyInput - - SUBROUTINE ED_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(ED_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 = 'ED_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 ! BladePtLoads allocated yes/no - IF ( ALLOCATED(InData%BladePtLoads) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BladePtLoads upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%BladePtLoads,1), UBOUND(InData%BladePtLoads,1) - Int_BufSz = Int_BufSz + 3 ! BladePtLoads: size of buffers for each call to pack subtype - CALL MeshPack( InData%BladePtLoads(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! BladePtLoads - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BladePtLoads - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BladePtLoads - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BladePtLoads - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! PlatformPtMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%PlatformPtMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! PlatformPtMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! PlatformPtMesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! PlatformPtMesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! PlatformPtMesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! TowerPtLoads: size of buffers for each call to pack subtype - CALL MeshPack( InData%TowerPtLoads, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! TowerPtLoads - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! TowerPtLoads - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! TowerPtLoads - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! TowerPtLoads - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! HubPtLoad: size of buffers for each call to pack subtype - CALL MeshPack( InData%HubPtLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! HubPtLoad - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! HubPtLoad - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! HubPtLoad - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! HubPtLoad - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! NacelleLoads: size of buffers for each call to pack subtype - CALL MeshPack( InData%NacelleLoads, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! NacelleLoads - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! NacelleLoads - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! NacelleLoads - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! NacelleLoads - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! TFinCMLoads: size of buffers for each call to pack subtype - CALL MeshPack( InData%TFinCMLoads, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! TFinCMLoads - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! TFinCMLoads - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! TFinCMLoads - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! TFinCMLoads - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! TwrAddedMass allocated yes/no - IF ( ALLOCATED(InData%TwrAddedMass) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! TwrAddedMass upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TwrAddedMass) ! TwrAddedMass - END IF - Re_BufSz = Re_BufSz + SIZE(InData%PtfmAddedMass) ! PtfmAddedMass - 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 - Re_BufSz = Re_BufSz + 1 ! YawMom - Re_BufSz = Re_BufSz + 1 ! GenTrq - Re_BufSz = Re_BufSz + 1 ! HSSBrTrqC - 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%BladePtLoads) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BladePtLoads,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BladePtLoads,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BladePtLoads,1), UBOUND(InData%BladePtLoads,1) - CALL MeshPack( InData%BladePtLoads(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! BladePtLoads - 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 - CALL MeshPack( InData%PlatformPtMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! PlatformPtMesh - 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%TowerPtLoads, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! TowerPtLoads - 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%HubPtLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! HubPtLoad - 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%NacelleLoads, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! NacelleLoads - 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%TFinCMLoads, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! TFinCMLoads - 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%TwrAddedMass) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwrAddedMass,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrAddedMass,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwrAddedMass,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrAddedMass,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwrAddedMass,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrAddedMass,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%TwrAddedMass,3), UBOUND(InData%TwrAddedMass,3) - DO i2 = LBOUND(InData%TwrAddedMass,2), UBOUND(InData%TwrAddedMass,2) - DO i1 = LBOUND(InData%TwrAddedMass,1), UBOUND(InData%TwrAddedMass,1) - ReKiBuf(Re_Xferred) = InData%TwrAddedMass(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - DO i2 = LBOUND(InData%PtfmAddedMass,2), UBOUND(InData%PtfmAddedMass,2) - DO i1 = LBOUND(InData%PtfmAddedMass,1), UBOUND(InData%PtfmAddedMass,1) - ReKiBuf(Re_Xferred) = InData%PtfmAddedMass(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - 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 - 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 - END SUBROUTINE ED_PackInput - - SUBROUTINE ED_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(ED_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) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_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 ! BladePtLoads not allocated - Int_Xferred = Int_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%BladePtLoads)) DEALLOCATE(OutData%BladePtLoads) - ALLOCATE(OutData%BladePtLoads(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladePtLoads.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BladePtLoads,1), UBOUND(OutData%BladePtLoads,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%BladePtLoads(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! BladePtLoads - 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 - 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%PlatformPtMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! PlatformPtMesh - 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%TowerPtLoads, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! TowerPtLoads - 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%HubPtLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! HubPtLoad - 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%NacelleLoads, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! NacelleLoads - 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%TFinCMLoads, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! TFinCMLoads - 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 ! TwrAddedMass not allocated - Int_Xferred = Int_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%TwrAddedMass)) DEALLOCATE(OutData%TwrAddedMass) - ALLOCATE(OutData%TwrAddedMass(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%TwrAddedMass.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%TwrAddedMass,3), UBOUND(OutData%TwrAddedMass,3) - DO i2 = LBOUND(OutData%TwrAddedMass,2), UBOUND(OutData%TwrAddedMass,2) - DO i1 = LBOUND(OutData%TwrAddedMass,1), UBOUND(OutData%TwrAddedMass,1) - OutData%TwrAddedMass(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - i1_l = LBOUND(OutData%PtfmAddedMass,1) - i1_u = UBOUND(OutData%PtfmAddedMass,1) - i2_l = LBOUND(OutData%PtfmAddedMass,2) - i2_u = UBOUND(OutData%PtfmAddedMass,2) - DO i2 = LBOUND(OutData%PtfmAddedMass,2), UBOUND(OutData%PtfmAddedMass,2) - DO i1 = LBOUND(OutData%PtfmAddedMass,1), UBOUND(OutData%PtfmAddedMass,1) - OutData%PtfmAddedMass(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - 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 - 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 - END SUBROUTINE ED_UnPackInput - - SUBROUTINE ED_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ED_OutputType), INTENT(INOUT) :: SrcOutputData - TYPE(ED_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 = 'ED_CopyOutput' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcOutputData%BladeLn2Mesh)) THEN - i1_l = LBOUND(SrcOutputData%BladeLn2Mesh,1) - i1_u = UBOUND(SrcOutputData%BladeLn2Mesh,1) - IF (.NOT. ALLOCATED(DstOutputData%BladeLn2Mesh)) THEN - ALLOCATE(DstOutputData%BladeLn2Mesh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%BladeLn2Mesh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcOutputData%BladeLn2Mesh,1), UBOUND(SrcOutputData%BladeLn2Mesh,1) - CALL MeshCopy( SrcOutputData%BladeLn2Mesh(i1), DstOutputData%BladeLn2Mesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL MeshCopy( SrcOutputData%PlatformPtMesh, DstOutputData%PlatformPtMesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcOutputData%TowerLn2Mesh, DstOutputData%TowerLn2Mesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcOutputData%HubPtMotion14, DstOutputData%HubPtMotion14, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcOutputData%HubPtMotion, DstOutputData%HubPtMotion, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcOutputData%BladeRootMotion14, DstOutputData%BladeRootMotion14, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcOutputData%BladeRootMotion)) THEN - i1_l = LBOUND(SrcOutputData%BladeRootMotion,1) - i1_u = UBOUND(SrcOutputData%BladeRootMotion,1) - IF (.NOT. ALLOCATED(DstOutputData%BladeRootMotion)) THEN - ALLOCATE(DstOutputData%BladeRootMotion(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%BladeRootMotion.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcOutputData%BladeRootMotion,1), UBOUND(SrcOutputData%BladeRootMotion,1) - CALL MeshCopy( SrcOutputData%BladeRootMotion(i1), DstOutputData%BladeRootMotion(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL MeshCopy( SrcOutputData%RotorFurlMotion14, DstOutputData%RotorFurlMotion14, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcOutputData%NacelleMotion, DstOutputData%NacelleMotion, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcOutputData%TowerBaseMotion14, DstOutputData%TowerBaseMotion14, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcOutputData%TFinCMMotion, DstOutputData%TFinCMMotion, 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 -IF (ALLOCATED(SrcOutputData%BlPitch)) THEN - i1_l = LBOUND(SrcOutputData%BlPitch,1) - i1_u = UBOUND(SrcOutputData%BlPitch,1) - IF (.NOT. ALLOCATED(DstOutputData%BlPitch)) THEN - ALLOCATE(DstOutputData%BlPitch(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%BlPitch.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%BlPitch = SrcOutputData%BlPitch -ENDIF - DstOutputData%Yaw = SrcOutputData%Yaw - DstOutputData%YawRate = SrcOutputData%YawRate - DstOutputData%LSS_Spd = SrcOutputData%LSS_Spd - DstOutputData%HSS_Spd = SrcOutputData%HSS_Spd - DstOutputData%RotSpeed = SrcOutputData%RotSpeed - DstOutputData%TwrAccel = SrcOutputData%TwrAccel - DstOutputData%YawAngle = SrcOutputData%YawAngle - DstOutputData%RootMyc = SrcOutputData%RootMyc - DstOutputData%YawBrTAxp = SrcOutputData%YawBrTAxp - DstOutputData%YawBrTAyp = SrcOutputData%YawBrTAyp - DstOutputData%LSSTipPxa = SrcOutputData%LSSTipPxa - DstOutputData%RootMxc = SrcOutputData%RootMxc - DstOutputData%LSSTipMxa = SrcOutputData%LSSTipMxa - DstOutputData%LSSTipMya = SrcOutputData%LSSTipMya - DstOutputData%LSSTipMza = SrcOutputData%LSSTipMza - DstOutputData%LSSTipMys = SrcOutputData%LSSTipMys - DstOutputData%LSSTipMzs = SrcOutputData%LSSTipMzs - DstOutputData%YawBrMyn = SrcOutputData%YawBrMyn - DstOutputData%YawBrMzn = SrcOutputData%YawBrMzn - DstOutputData%NcIMURAxs = SrcOutputData%NcIMURAxs - DstOutputData%NcIMURAys = SrcOutputData%NcIMURAys - DstOutputData%NcIMURAzs = SrcOutputData%NcIMURAzs - DstOutputData%RotPwr = SrcOutputData%RotPwr - DstOutputData%LSShftFxa = SrcOutputData%LSShftFxa - DstOutputData%LSShftFys = SrcOutputData%LSShftFys - DstOutputData%LSShftFzs = SrcOutputData%LSShftFzs - END SUBROUTINE ED_CopyOutput - - SUBROUTINE ED_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(ED_OutputType), INTENT(INOUT) :: OutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_DestroyOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(OutputData%BladeLn2Mesh)) THEN -DO i1 = LBOUND(OutputData%BladeLn2Mesh,1), UBOUND(OutputData%BladeLn2Mesh,1) - CALL MeshDestroy( OutputData%BladeLn2Mesh(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(OutputData%BladeLn2Mesh) -ENDIF - CALL MeshDestroy( OutputData%PlatformPtMesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( OutputData%TowerLn2Mesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( OutputData%HubPtMotion14, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( OutputData%HubPtMotion, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( OutputData%BladeRootMotion14, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(OutputData%BladeRootMotion)) THEN -DO i1 = LBOUND(OutputData%BladeRootMotion,1), UBOUND(OutputData%BladeRootMotion,1) - CALL MeshDestroy( OutputData%BladeRootMotion(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(OutputData%BladeRootMotion) -ENDIF - CALL MeshDestroy( OutputData%RotorFurlMotion14, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( OutputData%NacelleMotion, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( OutputData%TowerBaseMotion14, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( OutputData%TFinCMMotion, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(OutputData%WriteOutput)) THEN - DEALLOCATE(OutputData%WriteOutput) -ENDIF -IF (ALLOCATED(OutputData%BlPitch)) THEN - DEALLOCATE(OutputData%BlPitch) -ENDIF - END SUBROUTINE ED_DestroyOutput - - SUBROUTINE ED_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(ED_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 = 'ED_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 ! BladeLn2Mesh allocated yes/no - IF ( ALLOCATED(InData%BladeLn2Mesh) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BladeLn2Mesh upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%BladeLn2Mesh,1), UBOUND(InData%BladeLn2Mesh,1) - Int_BufSz = Int_BufSz + 3 ! BladeLn2Mesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%BladeLn2Mesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! BladeLn2Mesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BladeLn2Mesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BladeLn2Mesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BladeLn2Mesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! PlatformPtMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%PlatformPtMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! PlatformPtMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! PlatformPtMesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! PlatformPtMesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! PlatformPtMesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! TowerLn2Mesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%TowerLn2Mesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! TowerLn2Mesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! TowerLn2Mesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! TowerLn2Mesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! TowerLn2Mesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! HubPtMotion14: size of buffers for each call to pack subtype - CALL MeshPack( InData%HubPtMotion14, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! HubPtMotion14 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! HubPtMotion14 - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! HubPtMotion14 - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! HubPtMotion14 - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! HubPtMotion: size of buffers for each call to pack subtype - CALL MeshPack( InData%HubPtMotion, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! HubPtMotion - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! HubPtMotion - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! HubPtMotion - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! HubPtMotion - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! BladeRootMotion14: size of buffers for each call to pack subtype - CALL MeshPack( InData%BladeRootMotion14, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! BladeRootMotion14 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BladeRootMotion14 - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BladeRootMotion14 - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BladeRootMotion14 - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! BladeRootMotion allocated yes/no - IF ( ALLOCATED(InData%BladeRootMotion) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BladeRootMotion upper/lower bounds for each dimension - DO i1 = LBOUND(InData%BladeRootMotion,1), UBOUND(InData%BladeRootMotion,1) - Int_BufSz = Int_BufSz + 3 ! BladeRootMotion: size of buffers for each call to pack subtype - CALL MeshPack( InData%BladeRootMotion(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! BladeRootMotion - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BladeRootMotion - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BladeRootMotion - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BladeRootMotion - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! RotorFurlMotion14: size of buffers for each call to pack subtype - CALL MeshPack( InData%RotorFurlMotion14, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! RotorFurlMotion14 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! RotorFurlMotion14 - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! RotorFurlMotion14 - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! RotorFurlMotion14 - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! NacelleMotion: size of buffers for each call to pack subtype - CALL MeshPack( InData%NacelleMotion, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! NacelleMotion - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! NacelleMotion - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! NacelleMotion - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! NacelleMotion - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! TowerBaseMotion14: size of buffers for each call to pack subtype - CALL MeshPack( InData%TowerBaseMotion14, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! TowerBaseMotion14 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! TowerBaseMotion14 - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! TowerBaseMotion14 - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! TowerBaseMotion14 - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! TFinCMMotion: size of buffers for each call to pack subtype - CALL MeshPack( InData%TFinCMMotion, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! TFinCMMotion - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! TFinCMMotion - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! TFinCMMotion - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! TFinCMMotion - 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 - 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 ! TwrAccel - Re_BufSz = Re_BufSz + 1 ! YawAngle - 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 ! LSShftFxa - Re_BufSz = Re_BufSz + 1 ! LSShftFys - Re_BufSz = Re_BufSz + 1 ! LSShftFzs - 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%BladeLn2Mesh) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BladeLn2Mesh,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BladeLn2Mesh,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BladeLn2Mesh,1), UBOUND(InData%BladeLn2Mesh,1) - CALL MeshPack( InData%BladeLn2Mesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! BladeLn2Mesh - 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 - CALL MeshPack( InData%PlatformPtMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! PlatformPtMesh - 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%TowerLn2Mesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! TowerLn2Mesh - 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%HubPtMotion14, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! HubPtMotion14 - 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%HubPtMotion, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! HubPtMotion - 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%BladeRootMotion14, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! BladeRootMotion14 - 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%BladeRootMotion) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BladeRootMotion,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BladeRootMotion,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BladeRootMotion,1), UBOUND(InData%BladeRootMotion,1) - CALL MeshPack( InData%BladeRootMotion(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! BladeRootMotion - 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 - CALL MeshPack( InData%RotorFurlMotion14, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! RotorFurlMotion14 - 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%NacelleMotion, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! NacelleMotion - 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%TowerBaseMotion14, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! TowerBaseMotion14 - 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%TFinCMMotion, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! TFinCMMotion - 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 - 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%TwrAccel - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%YawAngle - 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%LSShftFxa - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%LSShftFys - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%LSShftFzs - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE ED_PackOutput - - SUBROUTINE ED_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(ED_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 = 'ED_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 ! BladeLn2Mesh not allocated - Int_Xferred = Int_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%BladeLn2Mesh)) DEALLOCATE(OutData%BladeLn2Mesh) - ALLOCATE(OutData%BladeLn2Mesh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeLn2Mesh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BladeLn2Mesh,1), UBOUND(OutData%BladeLn2Mesh,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%BladeLn2Mesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! BladeLn2Mesh - 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 - 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%PlatformPtMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! PlatformPtMesh - 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%TowerLn2Mesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! TowerLn2Mesh - 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%HubPtMotion14, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! HubPtMotion14 - 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%HubPtMotion, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! HubPtMotion - 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%BladeRootMotion14, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! BladeRootMotion14 - 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 ! BladeRootMotion not allocated - Int_Xferred = Int_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%BladeRootMotion)) DEALLOCATE(OutData%BladeRootMotion) - ALLOCATE(OutData%BladeRootMotion(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeRootMotion.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BladeRootMotion,1), UBOUND(OutData%BladeRootMotion,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%BladeRootMotion(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! BladeRootMotion - 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 - 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%RotorFurlMotion14, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! RotorFurlMotion14 - 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%NacelleMotion, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! NacelleMotion - 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%TowerBaseMotion14, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! TowerBaseMotion14 - 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%TFinCMMotion, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! TFinCMMotion - 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 - 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%TwrAccel = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%YawAngle = 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%LSShftFxa = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%LSShftFys = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%LSShftFzs = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE ED_UnPackOutput - - - SUBROUTINE ED_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(ED_InputType), INTENT(INOUT) :: u(:) ! Input at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Inputs - TYPE(ED_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 = 'ED_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 ED_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL ED_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 ED_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 ED_Input_ExtrapInterp - - - SUBROUTINE ED_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(ED_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 - TYPE(ED_InputType), INTENT(INOUT) :: u2 ! Input at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs - TYPE(ED_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 = 'ED_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 :: i02 ! dim2 level 0 counter variable for arrays of ddts - INTEGER :: i03 ! dim3 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - INTEGER :: i2 ! dim2 counter variable for arrays - INTEGER :: i3 ! dim3 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%BladePtLoads) .AND. ALLOCATED(u1%BladePtLoads)) THEN - DO i1 = LBOUND(u_out%BladePtLoads,1),UBOUND(u_out%BladePtLoads,1) - CALL MeshExtrapInterp1(u1%BladePtLoads(i1), u2%BladePtLoads(i1), tin, u_out%BladePtLoads(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated - CALL MeshExtrapInterp1(u1%PlatformPtMesh, u2%PlatformPtMesh, tin, u_out%PlatformPtMesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp1(u1%TowerPtLoads, u2%TowerPtLoads, tin, u_out%TowerPtLoads, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp1(u1%HubPtLoad, u2%HubPtLoad, tin, u_out%HubPtLoad, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp1(u1%NacelleLoads, u2%NacelleLoads, tin, u_out%NacelleLoads, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp1(u1%TFinCMLoads, u2%TFinCMLoads, tin, u_out%TFinCMLoads, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) -IF (ALLOCATED(u_out%TwrAddedMass) .AND. ALLOCATED(u1%TwrAddedMass)) THEN - DO i3 = LBOUND(u_out%TwrAddedMass,3),UBOUND(u_out%TwrAddedMass,3) - DO i2 = LBOUND(u_out%TwrAddedMass,2),UBOUND(u_out%TwrAddedMass,2) - DO i1 = LBOUND(u_out%TwrAddedMass,1),UBOUND(u_out%TwrAddedMass,1) - b = -(u1%TwrAddedMass(i1,i2,i3) - u2%TwrAddedMass(i1,i2,i3)) - u_out%TwrAddedMass(i1,i2,i3) = u1%TwrAddedMass(i1,i2,i3) + b * ScaleFactor - END DO - END DO - END DO -END IF ! check if allocated - DO i2 = LBOUND(u_out%PtfmAddedMass,2),UBOUND(u_out%PtfmAddedMass,2) - DO i1 = LBOUND(u_out%PtfmAddedMass,1),UBOUND(u_out%PtfmAddedMass,1) - b = -(u1%PtfmAddedMass(i1,i2) - u2%PtfmAddedMass(i1,i2)) - u_out%PtfmAddedMass(i1,i2) = u1%PtfmAddedMass(i1,i2) + b * ScaleFactor - END DO - END DO -IF (ALLOCATED(u_out%BlPitchCom) .AND. ALLOCATED(u1%BlPitchCom)) THEN - DO i1 = LBOUND(u_out%BlPitchCom,1),UBOUND(u_out%BlPitchCom,1) - CALL Angles_ExtrapInterp( u1%BlPitchCom(i1), u2%BlPitchCom(i1), tin, u_out%BlPitchCom(i1), tin_out ) - END DO -END IF ! check if allocated - b = -(u1%YawMom - u2%YawMom) - u_out%YawMom = u1%YawMom + b * ScaleFactor - b = -(u1%GenTrq - u2%GenTrq) - u_out%GenTrq = u1%GenTrq + b * ScaleFactor - b = -(u1%HSSBrTrqC - u2%HSSBrTrqC) - u_out%HSSBrTrqC = u1%HSSBrTrqC + b * ScaleFactor - END SUBROUTINE ED_Input_ExtrapInterp1 - - - SUBROUTINE ED_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(ED_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 > t3 - TYPE(ED_InputType), INTENT(INOUT) :: u2 ! Input at t2 > t3 - TYPE(ED_InputType), INTENT(INOUT) :: u3 ! Input at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs - TYPE(ED_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 = 'ED_Input_ExtrapInterp2' - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts - INTEGER :: i03 ! dim3 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - INTEGER :: i2 ! dim2 counter variable for arrays - INTEGER :: i3 ! dim3 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%BladePtLoads) .AND. ALLOCATED(u1%BladePtLoads)) THEN - DO i1 = LBOUND(u_out%BladePtLoads,1),UBOUND(u_out%BladePtLoads,1) - CALL MeshExtrapInterp2(u1%BladePtLoads(i1), u2%BladePtLoads(i1), u3%BladePtLoads(i1), tin, u_out%BladePtLoads(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated - CALL MeshExtrapInterp2(u1%PlatformPtMesh, u2%PlatformPtMesh, u3%PlatformPtMesh, tin, u_out%PlatformPtMesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp2(u1%TowerPtLoads, u2%TowerPtLoads, u3%TowerPtLoads, tin, u_out%TowerPtLoads, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp2(u1%HubPtLoad, u2%HubPtLoad, u3%HubPtLoad, tin, u_out%HubPtLoad, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp2(u1%NacelleLoads, u2%NacelleLoads, u3%NacelleLoads, tin, u_out%NacelleLoads, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp2(u1%TFinCMLoads, u2%TFinCMLoads, u3%TFinCMLoads, tin, u_out%TFinCMLoads, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) -IF (ALLOCATED(u_out%TwrAddedMass) .AND. ALLOCATED(u1%TwrAddedMass)) THEN - DO i3 = LBOUND(u_out%TwrAddedMass,3),UBOUND(u_out%TwrAddedMass,3) - DO i2 = LBOUND(u_out%TwrAddedMass,2),UBOUND(u_out%TwrAddedMass,2) - DO i1 = LBOUND(u_out%TwrAddedMass,1),UBOUND(u_out%TwrAddedMass,1) - b = (t(3)**2*(u1%TwrAddedMass(i1,i2,i3) - u2%TwrAddedMass(i1,i2,i3)) + t(2)**2*(-u1%TwrAddedMass(i1,i2,i3) + u3%TwrAddedMass(i1,i2,i3)))* scaleFactor - c = ( (t(2)-t(3))*u1%TwrAddedMass(i1,i2,i3) + t(3)*u2%TwrAddedMass(i1,i2,i3) - t(2)*u3%TwrAddedMass(i1,i2,i3) ) * scaleFactor - u_out%TwrAddedMass(i1,i2,i3) = u1%TwrAddedMass(i1,i2,i3) + b + c * t_out - END DO - END DO - END DO -END IF ! check if allocated - DO i2 = LBOUND(u_out%PtfmAddedMass,2),UBOUND(u_out%PtfmAddedMass,2) - DO i1 = LBOUND(u_out%PtfmAddedMass,1),UBOUND(u_out%PtfmAddedMass,1) - b = (t(3)**2*(u1%PtfmAddedMass(i1,i2) - u2%PtfmAddedMass(i1,i2)) + t(2)**2*(-u1%PtfmAddedMass(i1,i2) + u3%PtfmAddedMass(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*u1%PtfmAddedMass(i1,i2) + t(3)*u2%PtfmAddedMass(i1,i2) - t(2)*u3%PtfmAddedMass(i1,i2) ) * scaleFactor - u_out%PtfmAddedMass(i1,i2) = u1%PtfmAddedMass(i1,i2) + b + c * t_out - END DO - END DO -IF (ALLOCATED(u_out%BlPitchCom) .AND. ALLOCATED(u1%BlPitchCom)) THEN - DO i1 = LBOUND(u_out%BlPitchCom,1),UBOUND(u_out%BlPitchCom,1) - CALL Angles_ExtrapInterp( u1%BlPitchCom(i1), u2%BlPitchCom(i1), u3%BlPitchCom(i1), tin, u_out%BlPitchCom(i1), tin_out ) - END DO -END IF ! check if allocated - b = (t(3)**2*(u1%YawMom - u2%YawMom) + t(2)**2*(-u1%YawMom + u3%YawMom))* scaleFactor - c = ( (t(2)-t(3))*u1%YawMom + t(3)*u2%YawMom - t(2)*u3%YawMom ) * scaleFactor - u_out%YawMom = u1%YawMom + b + c * t_out - b = (t(3)**2*(u1%GenTrq - u2%GenTrq) + t(2)**2*(-u1%GenTrq + u3%GenTrq))* scaleFactor - c = ( (t(2)-t(3))*u1%GenTrq + t(3)*u2%GenTrq - t(2)*u3%GenTrq ) * scaleFactor - u_out%GenTrq = u1%GenTrq + b + c * t_out - b = (t(3)**2*(u1%HSSBrTrqC - u2%HSSBrTrqC) + t(2)**2*(-u1%HSSBrTrqC + u3%HSSBrTrqC))* scaleFactor - c = ( (t(2)-t(3))*u1%HSSBrTrqC + t(3)*u2%HSSBrTrqC - t(2)*u3%HSSBrTrqC ) * scaleFactor - u_out%HSSBrTrqC = u1%HSSBrTrqC + b + c * t_out - END SUBROUTINE ED_Input_ExtrapInterp2 - - - SUBROUTINE ED_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(ED_OutputType), INTENT(INOUT) :: y(:) ! Output at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Outputs - TYPE(ED_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 = 'ED_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 ED_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL ED_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 ED_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 ED_Output_ExtrapInterp - - - SUBROUTINE ED_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(ED_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 - TYPE(ED_OutputType), INTENT(INOUT) :: y2 ! Output at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs - TYPE(ED_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 = 'ED_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%BladeLn2Mesh) .AND. ALLOCATED(y1%BladeLn2Mesh)) THEN - DO i1 = LBOUND(y_out%BladeLn2Mesh,1),UBOUND(y_out%BladeLn2Mesh,1) - CALL MeshExtrapInterp1(y1%BladeLn2Mesh(i1), y2%BladeLn2Mesh(i1), tin, y_out%BladeLn2Mesh(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated - CALL MeshExtrapInterp1(y1%PlatformPtMesh, y2%PlatformPtMesh, tin, y_out%PlatformPtMesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp1(y1%TowerLn2Mesh, y2%TowerLn2Mesh, tin, y_out%TowerLn2Mesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp1(y1%HubPtMotion14, y2%HubPtMotion14, tin, y_out%HubPtMotion14, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp1(y1%HubPtMotion, y2%HubPtMotion, tin, y_out%HubPtMotion, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp1(y1%BladeRootMotion14, y2%BladeRootMotion14, tin, y_out%BladeRootMotion14, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) -IF (ALLOCATED(y_out%BladeRootMotion) .AND. ALLOCATED(y1%BladeRootMotion)) THEN - DO i1 = LBOUND(y_out%BladeRootMotion,1),UBOUND(y_out%BladeRootMotion,1) - CALL MeshExtrapInterp1(y1%BladeRootMotion(i1), y2%BladeRootMotion(i1), tin, y_out%BladeRootMotion(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated - CALL MeshExtrapInterp1(y1%RotorFurlMotion14, y2%RotorFurlMotion14, tin, y_out%RotorFurlMotion14, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp1(y1%NacelleMotion, y2%NacelleMotion, tin, y_out%NacelleMotion, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp1(y1%TowerBaseMotion14, y2%TowerBaseMotion14, tin, y_out%TowerBaseMotion14, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp1(y1%TFinCMMotion, y2%TFinCMMotion, tin, y_out%TFinCMMotion, 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 -IF (ALLOCATED(y_out%BlPitch) .AND. ALLOCATED(y1%BlPitch)) THEN - DO i1 = LBOUND(y_out%BlPitch,1),UBOUND(y_out%BlPitch,1) - CALL Angles_ExtrapInterp( y1%BlPitch(i1), y2%BlPitch(i1), tin, y_out%BlPitch(i1), tin_out ) - END DO -END IF ! check if allocated - CALL Angles_ExtrapInterp( y1%Yaw, y2%Yaw, tin, y_out%Yaw, tin_out ) - b = -(y1%YawRate - y2%YawRate) - y_out%YawRate = y1%YawRate + b * ScaleFactor - b = -(y1%LSS_Spd - y2%LSS_Spd) - y_out%LSS_Spd = y1%LSS_Spd + b * ScaleFactor - b = -(y1%HSS_Spd - y2%HSS_Spd) - y_out%HSS_Spd = y1%HSS_Spd + b * ScaleFactor - b = -(y1%RotSpeed - y2%RotSpeed) - y_out%RotSpeed = y1%RotSpeed + b * ScaleFactor - b = -(y1%TwrAccel - y2%TwrAccel) - y_out%TwrAccel = y1%TwrAccel + b * ScaleFactor - CALL Angles_ExtrapInterp( y1%YawAngle, y2%YawAngle, tin, y_out%YawAngle, tin_out ) - DO i1 = LBOUND(y_out%RootMyc,1),UBOUND(y_out%RootMyc,1) - b = -(y1%RootMyc(i1) - y2%RootMyc(i1)) - y_out%RootMyc(i1) = y1%RootMyc(i1) + b * ScaleFactor - END DO - b = -(y1%YawBrTAxp - y2%YawBrTAxp) - y_out%YawBrTAxp = y1%YawBrTAxp + b * ScaleFactor - b = -(y1%YawBrTAyp - y2%YawBrTAyp) - y_out%YawBrTAyp = y1%YawBrTAyp + b * ScaleFactor - CALL Angles_ExtrapInterp( y1%LSSTipPxa, y2%LSSTipPxa, tin, y_out%LSSTipPxa, tin_out ) - DO i1 = LBOUND(y_out%RootMxc,1),UBOUND(y_out%RootMxc,1) - b = -(y1%RootMxc(i1) - y2%RootMxc(i1)) - y_out%RootMxc(i1) = y1%RootMxc(i1) + b * ScaleFactor - END DO - b = -(y1%LSSTipMxa - y2%LSSTipMxa) - y_out%LSSTipMxa = y1%LSSTipMxa + b * ScaleFactor - b = -(y1%LSSTipMya - y2%LSSTipMya) - y_out%LSSTipMya = y1%LSSTipMya + b * ScaleFactor - b = -(y1%LSSTipMza - y2%LSSTipMza) - y_out%LSSTipMza = y1%LSSTipMza + b * ScaleFactor - b = -(y1%LSSTipMys - y2%LSSTipMys) - y_out%LSSTipMys = y1%LSSTipMys + b * ScaleFactor - b = -(y1%LSSTipMzs - y2%LSSTipMzs) - y_out%LSSTipMzs = y1%LSSTipMzs + b * ScaleFactor - b = -(y1%YawBrMyn - y2%YawBrMyn) - y_out%YawBrMyn = y1%YawBrMyn + b * ScaleFactor - b = -(y1%YawBrMzn - y2%YawBrMzn) - y_out%YawBrMzn = y1%YawBrMzn + b * ScaleFactor - b = -(y1%NcIMURAxs - y2%NcIMURAxs) - y_out%NcIMURAxs = y1%NcIMURAxs + b * ScaleFactor - b = -(y1%NcIMURAys - y2%NcIMURAys) - y_out%NcIMURAys = y1%NcIMURAys + b * ScaleFactor - b = -(y1%NcIMURAzs - y2%NcIMURAzs) - y_out%NcIMURAzs = y1%NcIMURAzs + b * ScaleFactor - b = -(y1%RotPwr - y2%RotPwr) - y_out%RotPwr = y1%RotPwr + b * ScaleFactor - b = -(y1%LSShftFxa - y2%LSShftFxa) - y_out%LSShftFxa = y1%LSShftFxa + b * ScaleFactor - b = -(y1%LSShftFys - y2%LSShftFys) - y_out%LSShftFys = y1%LSShftFys + b * ScaleFactor - b = -(y1%LSShftFzs - y2%LSShftFzs) - y_out%LSShftFzs = y1%LSShftFzs + b * ScaleFactor - END SUBROUTINE ED_Output_ExtrapInterp1 - - - SUBROUTINE ED_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(ED_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 > t3 - TYPE(ED_OutputType), INTENT(INOUT) :: y2 ! Output at t2 > t3 - TYPE(ED_OutputType), INTENT(INOUT) :: y3 ! Output at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs - TYPE(ED_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 = 'ED_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%BladeLn2Mesh) .AND. ALLOCATED(y1%BladeLn2Mesh)) THEN - DO i1 = LBOUND(y_out%BladeLn2Mesh,1),UBOUND(y_out%BladeLn2Mesh,1) - CALL MeshExtrapInterp2(y1%BladeLn2Mesh(i1), y2%BladeLn2Mesh(i1), y3%BladeLn2Mesh(i1), tin, y_out%BladeLn2Mesh(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated - CALL MeshExtrapInterp2(y1%PlatformPtMesh, y2%PlatformPtMesh, y3%PlatformPtMesh, tin, y_out%PlatformPtMesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp2(y1%TowerLn2Mesh, y2%TowerLn2Mesh, y3%TowerLn2Mesh, tin, y_out%TowerLn2Mesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp2(y1%HubPtMotion14, y2%HubPtMotion14, y3%HubPtMotion14, tin, y_out%HubPtMotion14, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp2(y1%HubPtMotion, y2%HubPtMotion, y3%HubPtMotion, tin, y_out%HubPtMotion, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp2(y1%BladeRootMotion14, y2%BladeRootMotion14, y3%BladeRootMotion14, tin, y_out%BladeRootMotion14, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) -IF (ALLOCATED(y_out%BladeRootMotion) .AND. ALLOCATED(y1%BladeRootMotion)) THEN - DO i1 = LBOUND(y_out%BladeRootMotion,1),UBOUND(y_out%BladeRootMotion,1) - CALL MeshExtrapInterp2(y1%BladeRootMotion(i1), y2%BladeRootMotion(i1), y3%BladeRootMotion(i1), tin, y_out%BladeRootMotion(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated - CALL MeshExtrapInterp2(y1%RotorFurlMotion14, y2%RotorFurlMotion14, y3%RotorFurlMotion14, tin, y_out%RotorFurlMotion14, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp2(y1%NacelleMotion, y2%NacelleMotion, y3%NacelleMotion, tin, y_out%NacelleMotion, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp2(y1%TowerBaseMotion14, y2%TowerBaseMotion14, y3%TowerBaseMotion14, tin, y_out%TowerBaseMotion14, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp2(y1%TFinCMMotion, y2%TFinCMMotion, y3%TFinCMMotion, tin, y_out%TFinCMMotion, 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 -IF (ALLOCATED(y_out%BlPitch) .AND. ALLOCATED(y1%BlPitch)) THEN - DO i1 = LBOUND(y_out%BlPitch,1),UBOUND(y_out%BlPitch,1) - CALL Angles_ExtrapInterp( y1%BlPitch(i1), y2%BlPitch(i1), y3%BlPitch(i1), tin, y_out%BlPitch(i1), tin_out ) - END DO -END IF ! check if allocated - CALL Angles_ExtrapInterp( y1%Yaw, y2%Yaw, y3%Yaw, tin, y_out%Yaw, tin_out ) - b = (t(3)**2*(y1%YawRate - y2%YawRate) + t(2)**2*(-y1%YawRate + y3%YawRate))* scaleFactor - c = ( (t(2)-t(3))*y1%YawRate + t(3)*y2%YawRate - t(2)*y3%YawRate ) * scaleFactor - y_out%YawRate = y1%YawRate + b + c * t_out - b = (t(3)**2*(y1%LSS_Spd - y2%LSS_Spd) + t(2)**2*(-y1%LSS_Spd + y3%LSS_Spd))* scaleFactor - c = ( (t(2)-t(3))*y1%LSS_Spd + t(3)*y2%LSS_Spd - t(2)*y3%LSS_Spd ) * scaleFactor - y_out%LSS_Spd = y1%LSS_Spd + b + c * t_out - b = (t(3)**2*(y1%HSS_Spd - y2%HSS_Spd) + t(2)**2*(-y1%HSS_Spd + y3%HSS_Spd))* scaleFactor - c = ( (t(2)-t(3))*y1%HSS_Spd + t(3)*y2%HSS_Spd - t(2)*y3%HSS_Spd ) * scaleFactor - y_out%HSS_Spd = y1%HSS_Spd + b + c * t_out - b = (t(3)**2*(y1%RotSpeed - y2%RotSpeed) + t(2)**2*(-y1%RotSpeed + y3%RotSpeed))* scaleFactor - c = ( (t(2)-t(3))*y1%RotSpeed + t(3)*y2%RotSpeed - t(2)*y3%RotSpeed ) * scaleFactor - y_out%RotSpeed = y1%RotSpeed + b + c * t_out - b = (t(3)**2*(y1%TwrAccel - y2%TwrAccel) + t(2)**2*(-y1%TwrAccel + y3%TwrAccel))* scaleFactor - c = ( (t(2)-t(3))*y1%TwrAccel + t(3)*y2%TwrAccel - t(2)*y3%TwrAccel ) * scaleFactor - y_out%TwrAccel = y1%TwrAccel + b + c * t_out - CALL Angles_ExtrapInterp( y1%YawAngle, y2%YawAngle, y3%YawAngle, tin, y_out%YawAngle, tin_out ) - DO i1 = LBOUND(y_out%RootMyc,1),UBOUND(y_out%RootMyc,1) - b = (t(3)**2*(y1%RootMyc(i1) - y2%RootMyc(i1)) + t(2)**2*(-y1%RootMyc(i1) + y3%RootMyc(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%RootMyc(i1) + t(3)*y2%RootMyc(i1) - t(2)*y3%RootMyc(i1) ) * scaleFactor - y_out%RootMyc(i1) = y1%RootMyc(i1) + b + c * t_out - END DO - b = (t(3)**2*(y1%YawBrTAxp - y2%YawBrTAxp) + t(2)**2*(-y1%YawBrTAxp + y3%YawBrTAxp))* scaleFactor - c = ( (t(2)-t(3))*y1%YawBrTAxp + t(3)*y2%YawBrTAxp - t(2)*y3%YawBrTAxp ) * scaleFactor - y_out%YawBrTAxp = y1%YawBrTAxp + b + c * t_out - b = (t(3)**2*(y1%YawBrTAyp - y2%YawBrTAyp) + t(2)**2*(-y1%YawBrTAyp + y3%YawBrTAyp))* scaleFactor - c = ( (t(2)-t(3))*y1%YawBrTAyp + t(3)*y2%YawBrTAyp - t(2)*y3%YawBrTAyp ) * scaleFactor - y_out%YawBrTAyp = y1%YawBrTAyp + b + c * t_out - CALL Angles_ExtrapInterp( y1%LSSTipPxa, y2%LSSTipPxa, y3%LSSTipPxa, tin, y_out%LSSTipPxa, tin_out ) - DO i1 = LBOUND(y_out%RootMxc,1),UBOUND(y_out%RootMxc,1) - b = (t(3)**2*(y1%RootMxc(i1) - y2%RootMxc(i1)) + t(2)**2*(-y1%RootMxc(i1) + y3%RootMxc(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%RootMxc(i1) + t(3)*y2%RootMxc(i1) - t(2)*y3%RootMxc(i1) ) * scaleFactor - y_out%RootMxc(i1) = y1%RootMxc(i1) + b + c * t_out - END DO - b = (t(3)**2*(y1%LSSTipMxa - y2%LSSTipMxa) + t(2)**2*(-y1%LSSTipMxa + y3%LSSTipMxa))* scaleFactor - c = ( (t(2)-t(3))*y1%LSSTipMxa + t(3)*y2%LSSTipMxa - t(2)*y3%LSSTipMxa ) * scaleFactor - y_out%LSSTipMxa = y1%LSSTipMxa + b + c * t_out - b = (t(3)**2*(y1%LSSTipMya - y2%LSSTipMya) + t(2)**2*(-y1%LSSTipMya + y3%LSSTipMya))* scaleFactor - c = ( (t(2)-t(3))*y1%LSSTipMya + t(3)*y2%LSSTipMya - t(2)*y3%LSSTipMya ) * scaleFactor - y_out%LSSTipMya = y1%LSSTipMya + b + c * t_out - b = (t(3)**2*(y1%LSSTipMza - y2%LSSTipMza) + t(2)**2*(-y1%LSSTipMza + y3%LSSTipMza))* scaleFactor - c = ( (t(2)-t(3))*y1%LSSTipMza + t(3)*y2%LSSTipMza - t(2)*y3%LSSTipMza ) * scaleFactor - y_out%LSSTipMza = y1%LSSTipMza + b + c * t_out - b = (t(3)**2*(y1%LSSTipMys - y2%LSSTipMys) + t(2)**2*(-y1%LSSTipMys + y3%LSSTipMys))* scaleFactor - c = ( (t(2)-t(3))*y1%LSSTipMys + t(3)*y2%LSSTipMys - t(2)*y3%LSSTipMys ) * scaleFactor - y_out%LSSTipMys = y1%LSSTipMys + b + c * t_out - b = (t(3)**2*(y1%LSSTipMzs - y2%LSSTipMzs) + t(2)**2*(-y1%LSSTipMzs + y3%LSSTipMzs))* scaleFactor - c = ( (t(2)-t(3))*y1%LSSTipMzs + t(3)*y2%LSSTipMzs - t(2)*y3%LSSTipMzs ) * scaleFactor - y_out%LSSTipMzs = y1%LSSTipMzs + b + c * t_out - b = (t(3)**2*(y1%YawBrMyn - y2%YawBrMyn) + t(2)**2*(-y1%YawBrMyn + y3%YawBrMyn))* scaleFactor - c = ( (t(2)-t(3))*y1%YawBrMyn + t(3)*y2%YawBrMyn - t(2)*y3%YawBrMyn ) * scaleFactor - y_out%YawBrMyn = y1%YawBrMyn + b + c * t_out - b = (t(3)**2*(y1%YawBrMzn - y2%YawBrMzn) + t(2)**2*(-y1%YawBrMzn + y3%YawBrMzn))* scaleFactor - c = ( (t(2)-t(3))*y1%YawBrMzn + t(3)*y2%YawBrMzn - t(2)*y3%YawBrMzn ) * scaleFactor - y_out%YawBrMzn = y1%YawBrMzn + b + c * t_out - b = (t(3)**2*(y1%NcIMURAxs - y2%NcIMURAxs) + t(2)**2*(-y1%NcIMURAxs + y3%NcIMURAxs))* scaleFactor - c = ( (t(2)-t(3))*y1%NcIMURAxs + t(3)*y2%NcIMURAxs - t(2)*y3%NcIMURAxs ) * scaleFactor - y_out%NcIMURAxs = y1%NcIMURAxs + b + c * t_out - b = (t(3)**2*(y1%NcIMURAys - y2%NcIMURAys) + t(2)**2*(-y1%NcIMURAys + y3%NcIMURAys))* scaleFactor - c = ( (t(2)-t(3))*y1%NcIMURAys + t(3)*y2%NcIMURAys - t(2)*y3%NcIMURAys ) * scaleFactor - y_out%NcIMURAys = y1%NcIMURAys + b + c * t_out - b = (t(3)**2*(y1%NcIMURAzs - y2%NcIMURAzs) + t(2)**2*(-y1%NcIMURAzs + y3%NcIMURAzs))* scaleFactor - c = ( (t(2)-t(3))*y1%NcIMURAzs + t(3)*y2%NcIMURAzs - t(2)*y3%NcIMURAzs ) * scaleFactor - y_out%NcIMURAzs = y1%NcIMURAzs + b + c * t_out - b = (t(3)**2*(y1%RotPwr - y2%RotPwr) + t(2)**2*(-y1%RotPwr + y3%RotPwr))* scaleFactor - c = ( (t(2)-t(3))*y1%RotPwr + t(3)*y2%RotPwr - t(2)*y3%RotPwr ) * scaleFactor - y_out%RotPwr = y1%RotPwr + b + c * t_out - b = (t(3)**2*(y1%LSShftFxa - y2%LSShftFxa) + t(2)**2*(-y1%LSShftFxa + y3%LSShftFxa))* scaleFactor - c = ( (t(2)-t(3))*y1%LSShftFxa + t(3)*y2%LSShftFxa - t(2)*y3%LSShftFxa ) * scaleFactor - y_out%LSShftFxa = y1%LSShftFxa + b + c * t_out - b = (t(3)**2*(y1%LSShftFys - y2%LSShftFys) + t(2)**2*(-y1%LSShftFys + y3%LSShftFys))* scaleFactor - c = ( (t(2)-t(3))*y1%LSShftFys + t(3)*y2%LSShftFys - t(2)*y3%LSShftFys ) * scaleFactor - y_out%LSShftFys = y1%LSShftFys + b + c * t_out - b = (t(3)**2*(y1%LSShftFzs - y2%LSShftFzs) + t(2)**2*(-y1%LSShftFzs + y3%LSShftFzs))* scaleFactor - c = ( (t(2)-t(3))*y1%LSShftFzs + t(3)*y2%LSShftFzs - t(2)*y3%LSShftFzs ) * scaleFactor - y_out%LSShftFzs = y1%LSShftFzs + b + c * t_out - END SUBROUTINE ED_Output_ExtrapInterp2 - + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + IF (ALLOCATED(y_out%BladeLn2Mesh) .AND. ALLOCATED(y1%BladeLn2Mesh)) THEN + do i1 = lbound(y_out%BladeLn2Mesh,1),ubound(y_out%BladeLn2Mesh,1) + CALL MeshExtrapInterp2(y1%BladeLn2Mesh(i1), y2%BladeLn2Mesh(i1), y3%BladeLn2Mesh(i1), tin, y_out%BladeLn2Mesh(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + CALL MeshExtrapInterp2(y1%PlatformPtMesh, y2%PlatformPtMesh, y3%PlatformPtMesh, tin, y_out%PlatformPtMesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp2(y1%TowerLn2Mesh, y2%TowerLn2Mesh, y3%TowerLn2Mesh, tin, y_out%TowerLn2Mesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp2(y1%HubPtMotion, y2%HubPtMotion, y3%HubPtMotion, tin, y_out%HubPtMotion, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ALLOCATED(y_out%BladeRootMotion) .AND. ALLOCATED(y1%BladeRootMotion)) THEN + do i1 = lbound(y_out%BladeRootMotion,1),ubound(y_out%BladeRootMotion,1) + CALL MeshExtrapInterp2(y1%BladeRootMotion(i1), y2%BladeRootMotion(i1), y3%BladeRootMotion(i1), tin, y_out%BladeRootMotion(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + CALL MeshExtrapInterp2(y1%NacelleMotion, y2%NacelleMotion, y3%NacelleMotion, tin, y_out%NacelleMotion, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp2(y1%TFinCMMotion, y2%TFinCMMotion, y3%TFinCMMotion, tin, y_out%TFinCMMotion, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + a3*y3%WriteOutput + END IF ! check if allocated + IF (ALLOCATED(y_out%BlPitch) .AND. ALLOCATED(y1%BlPitch)) THEN + do i1 = lbound(y_out%BlPitch,1),ubound(y_out%BlPitch,1) + CALL Angles_ExtrapInterp( y1%BlPitch(i1), y2%BlPitch(i1), y3%BlPitch(i1), tin, y_out%BlPitch(i1), tin_out ) + END DO + END IF ! check if allocated + CALL Angles_ExtrapInterp( y1%Yaw, y2%Yaw, y3%Yaw, tin, y_out%Yaw, tin_out ) + y_out%YawRate = a1*y1%YawRate + a2*y2%YawRate + a3*y3%YawRate + y_out%LSS_Spd = a1*y1%LSS_Spd + a2*y2%LSS_Spd + a3*y3%LSS_Spd + y_out%HSS_Spd = a1*y1%HSS_Spd + a2*y2%HSS_Spd + a3*y3%HSS_Spd + y_out%RotSpeed = a1*y1%RotSpeed + a2*y2%RotSpeed + a3*y3%RotSpeed + y_out%TwrAccel = a1*y1%TwrAccel + a2*y2%TwrAccel + a3*y3%TwrAccel + CALL Angles_ExtrapInterp( y1%YawAngle, y2%YawAngle, y3%YawAngle, tin, y_out%YawAngle, tin_out ) + y_out%RootMyc = a1*y1%RootMyc + a2*y2%RootMyc + a3*y3%RootMyc + y_out%YawBrTAxp = a1*y1%YawBrTAxp + a2*y2%YawBrTAxp + a3*y3%YawBrTAxp + y_out%YawBrTAyp = a1*y1%YawBrTAyp + a2*y2%YawBrTAyp + a3*y3%YawBrTAyp + CALL Angles_ExtrapInterp( y1%LSSTipPxa, y2%LSSTipPxa, y3%LSSTipPxa, tin, y_out%LSSTipPxa, tin_out ) + y_out%RootMxc = a1*y1%RootMxc + a2*y2%RootMxc + a3*y3%RootMxc + y_out%LSSTipMxa = a1*y1%LSSTipMxa + a2*y2%LSSTipMxa + a3*y3%LSSTipMxa + y_out%LSSTipMya = a1*y1%LSSTipMya + a2*y2%LSSTipMya + a3*y3%LSSTipMya + y_out%LSSTipMza = a1*y1%LSSTipMza + a2*y2%LSSTipMza + a3*y3%LSSTipMza + y_out%LSSTipMys = a1*y1%LSSTipMys + a2*y2%LSSTipMys + a3*y3%LSSTipMys + y_out%LSSTipMzs = a1*y1%LSSTipMzs + a2*y2%LSSTipMzs + a3*y3%LSSTipMzs + y_out%YawBrMyn = a1*y1%YawBrMyn + a2*y2%YawBrMyn + a3*y3%YawBrMyn + y_out%YawBrMzn = a1*y1%YawBrMzn + a2*y2%YawBrMzn + a3*y3%YawBrMzn + y_out%NcIMURAxs = a1*y1%NcIMURAxs + a2*y2%NcIMURAxs + a3*y3%NcIMURAxs + y_out%NcIMURAys = a1*y1%NcIMURAys + a2*y2%NcIMURAys + a3*y3%NcIMURAys + y_out%NcIMURAzs = a1*y1%NcIMURAzs + a2*y2%NcIMURAzs + a3*y3%NcIMURAzs + y_out%RotPwr = a1*y1%RotPwr + a2*y2%RotPwr + a3*y3%RotPwr + y_out%LSShftFxa = a1*y1%LSShftFxa + a2*y2%LSShftFxa + a3*y3%LSShftFxa + y_out%LSShftFys = a1*y1%LSShftFys + a2*y2%LSShftFys + a3*y3%LSShftFys + y_out%LSShftFzs = a1*y1%LSShftFzs + a2*y2%LSShftFzs + a3*y3%LSShftFzs +END SUBROUTINE END MODULE ElastoDyn_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/openfoam/CMakeLists.txt b/modules/externalinflow/CMakeLists.txt similarity index 61% rename from modules/openfoam/CMakeLists.txt rename to modules/externalinflow/CMakeLists.txt index 4e4cbd9885..9c2b756dd2 100644 --- a/modules/openfoam/CMakeLists.txt +++ b/modules/externalinflow/CMakeLists.txt @@ -15,24 +15,27 @@ # if (GENERATE_TYPES) - generate_f90_types(src/OpenFOAM_Registry.txt ${CMAKE_CURRENT_LIST_DIR}/src/OpenFOAM_Types.f90 -ccode) + generate_f90_types(src/ExternalInflow_Registry.txt ${CMAKE_CURRENT_LIST_DIR}/src/ExternalInflow_Types.f90 -ccode) endif() -add_library(foamtypeslib STATIC src/OpenFOAM_Types.f90) -target_link_libraries(foamtypeslib nwtclibs) +add_library(extinflowtypeslib STATIC + src/ExternalInflow_Types.f90 +) +target_link_libraries(extinflowtypeslib nwtclibs ifwlib) -add_library(foamfastlib STATIC src/OpenFOAM.f90) -target_link_libraries(foamfastlib openfast_prelib) -target_include_directories(foamfastlib PUBLIC +add_library(extinflowlib STATIC + src/ExternalInflow.f90 +) +target_link_libraries(extinflowlib openfast_prelib) +target_include_directories(extinflowlib PUBLIC $ ) -set_target_properties(foamfastlib PROPERTIES PUBLIC_HEADER src/OpenFOAM_Types.h) +set_target_properties(extinflowlib PROPERTIES PUBLIC_HEADER src/ExternalInflow_Types.h) -install(TARGETS foamtypeslib foamfastlib +install(TARGETS extinflowtypeslib extinflowlib EXPORT "${CMAKE_PROJECT_NAME}Libraries" RUNTIME DESTINATION bin - ARCHIVE DESTINATION lib LIBRARY DESTINATION lib + ARCHIVE DESTINATION lib PUBLIC_HEADER DESTINATION include ) - diff --git a/modules/externalinflow/README.md b/modules/externalinflow/README.md new file mode 100644 index 0000000000..0c79d6c7b7 --- /dev/null +++ b/modules/externalinflow/README.md @@ -0,0 +1,5 @@ +# ExternalInflow Module + +## Overview +This is a pseudo module used to couple OpenFAST with CFD codes (NALU-Wind, AMR-Wind, SOWFA); +it is considered part of the OpenFAST glue code. diff --git a/modules/openfoam/src/OpenFOAM.f90 b/modules/externalinflow/src/ExternalInflow.f90 similarity index 53% rename from modules/openfoam/src/OpenFOAM.f90 rename to modules/externalinflow/src/ExternalInflow.f90 index dfeae36985..6f0d1455ae 100644 --- a/modules/openfoam/src/OpenFOAM.f90 +++ b/modules/externalinflow/src/ExternalInflow.f90 @@ -2,7 +2,7 @@ ! LICENSING ! Copyright (C) 2015 National Renewable Energy Laboratory ! -! OpenFOAM module +! ExternalInflow module ! ! Licensed under the Apache License, Version 2.0 (the "License"); ! you may not use this file except in compliance with the License. @@ -17,40 +17,43 @@ ! limitations under the License. ! !********************************************************************************************************************************** -!> This is a pseudo module used to couple OpenFAST with OpenFOAM; it is used to interface to CFD codes including SOWFA, OpenFOAM, and AMR-Wind -MODULE OpenFOAM +!> This is a pseudo module used to couple OpenFAST with ExternalInflow; it is used to interface to CFD codes including SOWFA, ExternalInflow, and AMR-Wind +MODULE ExternalInflow USE FAST_Types + USE IfW_FlowField + USE InflowWind_IO IMPLICIT NONE PRIVATE - TYPE(ProgDesc), PARAMETER :: OpFM_Ver = ProgDesc( 'OpenFOAM Integration', '', '' ) + TYPE(ProgDesc), PARAMETER :: ExtInfw_Ver = ProgDesc( 'ExternalInflow Integration', '', '' ) ! ..... Public Subroutines ................................................................................................... - PUBLIC :: Init_OpFM ! Initialization routine - PUBLIC :: OpFM_SetInputs ! Glue-code routine to update inputs for OpenFOAM - PUBLIC :: OpFM_SetWriteOutput + PUBLIC :: Init_ExtInfw ! Initialization routine + PUBLIC :: ExtInfw_SetInputs ! Glue-code routine to update inputs for ExternalInflow + PUBLIC :: ExtInfw_SetWriteOutput + PUBLIC :: ExtInfw_UpdateFlowField CONTAINS !---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE Init_OpFM( InitInp, p_FAST, AirDens, u_AD, initOut_AD, y_AD, OpFM, InitOut, ErrStat, ErrMsg ) - TYPE(OpFM_InitInputType), INTENT(IN ) :: InitInp ! Input data for initialization routine +SUBROUTINE Init_ExtInfw( InitInp, p_FAST, AirDens, u_AD, initOut_AD, y_AD, ExtInfw, InitOut, ErrStat, ErrMsg ) + TYPE(ExtInfw_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(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(OpenFOAM_Data), INTENT(INOUT) :: OpFM ! data for the OpenFOAM integration module - TYPE(OpFM_InitOutputType), INTENT(INOUT) :: InitOut ! Output for initialization routine + TYPE(ExternalInflow_Data), INTENT(INOUT) :: ExtInfw ! data for the ExternalInflow integration module + TYPE(ExtInfw_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 - + Type(Points_InitInputType) :: Points_InitInput INTEGER(IntKi) :: ErrStat2 ! temporary Error status of the operation CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None - CHARACTER(*), PARAMETER :: RoutineName = 'Init_OpFM' + CHARACTER(*), PARAMETER :: RoutineName = 'Init_ExtInfw' ! Initialize variables @@ -58,12 +61,12 @@ SUBROUTINE Init_OpFM( InitInp, p_FAST, AirDens, u_AD, initOut_AD, y_AD, OpFM, In ErrMsg = "" ! number of blades - OpFM%p%NumBl = SIZE( u_AD%rotors(1)%BladeMotion, 1 ) + ExtInfw%p%NumBl = SIZE( u_AD%rotors(1)%BladeMotion, 1 ) - ! air density, required for normalizing values sent to OpenFOAM: - OpFM%p%AirDens = AirDens + ! air density, required for normalizing values sent to ExternalInflow: + ExtInfw%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) + CALL SetErrStat( ErrID_Fatal, 'Air density cannot be zero for ExternalInflow integration. Check that AeroDyn is used and that air density is set properly', ErrStat,ErrMsg,RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -72,18 +75,18 @@ SUBROUTINE Init_OpFM( InitInp, p_FAST, AirDens, u_AD, initOut_AD, y_AD, OpFM, In ! quick sanity checks. ! If the number of nodes requested from CFD (nNodesForceBlade) is more than 4x the number of AD15 blade nodes ! we expect a lot of innacuracies. The user should increase the number of nodes in AD15 - if (Opfm%p%nNodesForceBlade > 4 * u_AD%rotors(1)%BladeMotion(1)%NNodes) then - ErrMsg2=trim(Num2LStr(Opfm%p%nNodesForceBlade))//' blade points requested from CFD. AD15 only uses ' & + if (ExtInfw%p%nNodesForceBlade > 4 * u_AD%rotors(1)%BladeMotion(1)%NNodes) then + ErrMsg2=trim(Num2LStr(ExtInfw%p%nNodesForceBlade))//' blade points requested from CFD. AD15 only uses ' & //trim(Num2LStr(u_AD%rotors(1)%BladeMotion(k)%NNodes))//' mesh points. ' & //'Increase number of AD15 mesh points to at least 50% as many points as the CFD requested.' - call WrScr('OpFM Error: '//trim(ErrMsg2)) + call WrScr('ExtInfw Error: '//trim(ErrMsg2)) call SetErrStat(ErrID_Fatal, ErrMsg2, ErrStat, ErrMsg, RoutineName) return ! if the number of nodes requested from CFD (nNodesForceBlade) is more than double the number of nodes in AD15, issue a warning. - elseif (Opfm%p%nNodesForceBlade > 2 * u_AD%rotors(1)%BladeMotion(1)%NNodes) then - ErrMsg2=trim(Num2LStr(Opfm%p%nNodesForceBlade))//' blade points requested from CFD. AD15 only uses ' & + elseif (ExtInfw%p%nNodesForceBlade > 2 * u_AD%rotors(1)%BladeMotion(1)%NNodes) then + ErrMsg2=trim(Num2LStr(ExtInfw%p%nNodesForceBlade))//' blade points requested from CFD. AD15 only uses ' & //trim(Num2LStr(u_AD%rotors(1)%BladeMotion(k)%NNodes))//' mesh points. This may result in inacurate loads.' - call WrScr('OpFM WARNING: '//trim(ErrMsg2)) + call WrScr('ExtInfw WARNING: '//trim(ErrMsg2)) call SetErrStat(ErrID_Warn, ErrMsg2, ErrStat, ErrMsg, RoutineName) endif @@ -92,114 +95,114 @@ SUBROUTINE Init_OpFM( InitInp, p_FAST, AirDens, u_AD, initOut_AD, y_AD, OpFM, In !--------------------------- ! Hub node (always set) - OpFM%p%nNodesVel = 1 ! Hub is first point always + ExtInfw%p%nNodesVel = 1 ! Hub is first point always ! Blade nodes (always set) - DO k=1,OpFM%p%NumBl - OpFM%p%nNodesVel = OpFM%p%nNodesVel + u_AD%rotors(1)%BladeMotion(k)%NNodes + DO k=1,ExtInfw%p%NumBl + ExtInfw%p%nNodesVel = ExtInfw%p%nNodesVel + u_AD%rotors(1)%BladeMotion(k)%NNodes END DO ! Tower motion - OpFM%p%nNodesVel = OpFM%p%nNodesVel + u_AD%rotors(1)%TowerMotion%NNodes + ExtInfw%p%nNodesVel = ExtInfw%p%nNodesVel + u_AD%rotors(1)%TowerMotion%NNodes ! Nacelle motion if (u_AD%rotors(1)%HubMotion%NNodes > 0) then - OpFM%p%nNodesVel = OpFM%p%nNodesVel + u_AD%rotors(1)%HubMotion%NNodes + ExtInfw%p%nNodesVel = ExtInfw%p%nNodesVel + u_AD%rotors(1)%HubMotion%NNodes endif ! Tail fin nodes if (u_AD%rotors(1)%TFinMotion%NNodes > 0) then - OpFM%p%nNodesVel = OpFM%p%nNodesVel + u_AD%rotors(1)%TFinMotion%NNodes + ExtInfw%p%nNodesVel = ExtInfw%p%nNodesVel + u_AD%rotors(1)%TFinMotion%NNodes endif !--------------------------- ! number of force actuator points from CFD. !--------------------------- - Opfm%p%nNodesForceBlade = InitInp%NumActForcePtsBlade ! from extern CFD - OpFM%p%nNodesForceTower = InitInp%NumActForcePtsTower ! from extern CFD + ExtInfw%p%nNodesForceBlade = InitInp%NumActForcePtsBlade ! from extern CFD + ExtInfw%p%nNodesForceTower = InitInp%NumActForcePtsTower ! from extern CFD ! Hub + blades - OpFM%p%nNodesForce = 1 + OpFM%p%NumBl * Opfm%p%nNodesForceBlade ! +1 for hub - OpFM%p%BladeLength = InitInp%BladeLength + ExtInfw%p%nNodesForce = 1 + ExtInfw%p%NumBl * ExtInfw%p%nNodesForceBlade ! +1 for hub + ExtInfw%p%BladeLength = InitInp%BladeLength ! Tower motion - if ( (u_AD%rotors(1)%TowerMotion%NNodes > 0) .and. (OpFM%p%nNodesForceTower > 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 + OpFM%p%nNodesForceTower + if ( (u_AD%rotors(1)%TowerMotion%NNodes > 0) .and. (ExtInfw%p%nNodesForceTower > 0) ) then + ExtInfw%p%NMappings = ExtInfw%p%NumBl + 1 + ExtInfw%p%TowerHeight = InitInp%TowerHeight + ExtInfw%p%TowerBaseHeight = InitInp%TowerBaseHeight + ExtInfw%p%nNodesForce = ExtInfw%p%nNodesForce + ExtInfw%p%nNodesForceTower else - OpFM%p%NMappings = OpFM%p%NumBl + ExtInfw%p%NMappings = ExtInfw%p%NumBl end if ! FIXME: we are missing the nacelle and tail fin nodes. Add these sometime (may require changes in CFD) !............................................................................................ - ! Allocate arrays and define initial guesses for the OpenFOAM inputs here: + ! Allocate arrays and define initial guesses for the ExternalInflow inputs here: !............................................................................................ ! Motion points (from AD15) - CALL AllocPAry( OpFM%u%pxVel, OpFM%p%nNodesVel, 'pxVel', ErrStat2, ErrMsg2 ); if (Failed()) return; - CALL AllocPAry( OpFM%u%pyVel, OpFM%p%nNodesVel, 'pyVel', ErrStat2, ErrMsg2 ); if (Failed()) return; - CALL AllocPAry( OpFM%u%pzVel, OpFM%p%nNodesVel, 'pzVel', ErrStat2, ErrMsg2 ); if (Failed()) return; + CALL AllocPAry( ExtInfw%u%pxVel, ExtInfw%p%nNodesVel, 'pxVel', ErrStat2, ErrMsg2 ); if (Failed()) return; + CALL AllocPAry( ExtInfw%u%pyVel, ExtInfw%p%nNodesVel, 'pyVel', ErrStat2, ErrMsg2 ); if (Failed()) return; + CALL AllocPAry( ExtInfw%u%pzVel, ExtInfw%p%nNodesVel, 'pzVel', ErrStat2, ErrMsg2 ); if (Failed()) return; ! Force actuator points (large number set by CFD) - CALL AllocPAry( OpFM%u%pxForce, OpFM%p%nNodesForce, 'pxForce', ErrStat2, ErrMsg2 ); if (Failed()) return; - CALL AllocPAry( OpFM%u%pyForce, OpFM%p%nNodesForce, 'pyForce', ErrStat2, ErrMsg2 ); if (Failed()) return; - CALL AllocPAry( OpFM%u%pzForce, OpFM%p%nNodesForce, 'pzForce', ErrStat2, ErrMsg2 ); if (Failed()) return; - CALL AllocPAry( OpFM%u%xdotForce, OpFM%p%nNodesForce, 'xdotForce', ErrStat2, ErrMsg2 ); if (Failed()) return; - CALL AllocPAry( OpFM%u%ydotForce, OpFM%p%nNodesForce, 'ydotForce', ErrStat2, ErrMsg2 ); if (Failed()) return; - CALL AllocPAry( OpFM%u%zdotForce, OpFM%p%nNodesForce, 'zdotForce', ErrStat2, ErrMsg2 ); if (Failed()) return; - CALL AllocPAry( OpFM%u%pOrientation,3*3*OpFM%p%nNodesForce, 'pOrientation', ErrStat2, ErrMsg2 ); if (Failed()) return; - CALL AllocPAry( OpFM%u%fx, OpFM%p%nNodesForce, 'fx', ErrStat2, ErrMsg2 ); if (Failed()) return; - CALL AllocPAry( OpFM%u%fy, OpFM%p%nNodesForce, 'fy', ErrStat2, ErrMsg2 ); if (Failed()) return; - CALL AllocPAry( OpFM%u%fz, OpFM%p%nNodesForce, 'fz', ErrStat2, ErrMsg2 ); if (Failed()) return; - CALL AllocPAry( OpFM%u%momentx, OpFM%p%nNodesForce, 'momentx', ErrStat2, ErrMsg2 ); if (Failed()) return; - CALL AllocPAry( OpFM%u%momenty, OpFM%p%nNodesForce, 'momenty', ErrStat2, ErrMsg2 ); if (Failed()) return; - CALL AllocPAry( OpFM%u%momentz, OpFM%p%nNodesForce, 'momentz', ErrStat2, ErrMsg2 ); if (Failed()) return; - CALL AllocPAry( OpFM%u%forceNodesChord, OpFM%p%nNodesForce, 'forceNodesChord', ErrStat2, ErrMsg2 ); if (Failed()) return; + CALL AllocPAry( ExtInfw%u%pxForce, ExtInfw%p%nNodesForce, 'pxForce', ErrStat2, ErrMsg2 ); if (Failed()) return; + CALL AllocPAry( ExtInfw%u%pyForce, ExtInfw%p%nNodesForce, 'pyForce', ErrStat2, ErrMsg2 ); if (Failed()) return; + CALL AllocPAry( ExtInfw%u%pzForce, ExtInfw%p%nNodesForce, 'pzForce', ErrStat2, ErrMsg2 ); if (Failed()) return; + CALL AllocPAry( ExtInfw%u%xdotForce, ExtInfw%p%nNodesForce, 'xdotForce', ErrStat2, ErrMsg2 ); if (Failed()) return; + CALL AllocPAry( ExtInfw%u%ydotForce, ExtInfw%p%nNodesForce, 'ydotForce', ErrStat2, ErrMsg2 ); if (Failed()) return; + CALL AllocPAry( ExtInfw%u%zdotForce, ExtInfw%p%nNodesForce, 'zdotForce', ErrStat2, ErrMsg2 ); if (Failed()) return; + CALL AllocPAry( ExtInfw%u%pOrientation,3*3*ExtInfw%p%nNodesForce, 'pOrientation', ErrStat2, ErrMsg2 ); if (Failed()) return; + CALL AllocPAry( ExtInfw%u%fx, ExtInfw%p%nNodesForce, 'fx', ErrStat2, ErrMsg2 ); if (Failed()) return; + CALL AllocPAry( ExtInfw%u%fy, ExtInfw%p%nNodesForce, 'fy', ErrStat2, ErrMsg2 ); if (Failed()) return; + CALL AllocPAry( ExtInfw%u%fz, ExtInfw%p%nNodesForce, 'fz', ErrStat2, ErrMsg2 ); if (Failed()) return; + CALL AllocPAry( ExtInfw%u%momentx, ExtInfw%p%nNodesForce, 'momentx', ErrStat2, ErrMsg2 ); if (Failed()) return; + CALL AllocPAry( ExtInfw%u%momenty, ExtInfw%p%nNodesForce, 'momenty', ErrStat2, ErrMsg2 ); if (Failed()) return; + CALL AllocPAry( ExtInfw%u%momentz, ExtInfw%p%nNodesForce, 'momentz', ErrStat2, ErrMsg2 ); if (Failed()) return; + CALL AllocPAry( ExtInfw%u%forceNodesChord, ExtInfw%p%nNodesForce, 'forceNodesChord', ErrStat2, ErrMsg2 ); if (Failed()) return; ! make sure the C versions are synced with these arrays: ! Motion points (from AD15) - 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) ) + ExtInfw%u%c_obj%pxVel_Len = ExtInfw%p%nNodesVel; ExtInfw%u%c_obj%pxVel = C_LOC( ExtInfw%u%pxVel(1) ) + ExtInfw%u%c_obj%pyVel_Len = ExtInfw%p%nNodesVel; ExtInfw%u%c_obj%pyVel = C_LOC( ExtInfw%u%pyVel(1) ) + ExtInfw%u%c_obj%pzVel_Len = ExtInfw%p%nNodesVel; ExtInfw%u%c_obj%pzVel = C_LOC( ExtInfw%u%pzVel(1) ) ! Force actuator points (large number set by CFD) - 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) ) + ExtInfw%u%c_obj%pxForce_Len = ExtInfw%p%nNodesForce; ExtInfw%u%c_obj%pxForce = C_LOC( ExtInfw%u%pxForce(1) ) + ExtInfw%u%c_obj%pyForce_Len = ExtInfw%p%nNodesForce; ExtInfw%u%c_obj%pyForce = C_LOC( ExtInfw%u%pyForce(1) ) + ExtInfw%u%c_obj%pzForce_Len = ExtInfw%p%nNodesForce; ExtInfw%u%c_obj%pzForce = C_LOC( ExtInfw%u%pzForce(1) ) + ExtInfw%u%c_obj%xdotForce_Len = ExtInfw%p%nNodesForce; ExtInfw%u%c_obj%xdotForce = C_LOC( ExtInfw%u%xdotForce(1) ) + ExtInfw%u%c_obj%ydotForce_Len = ExtInfw%p%nNodesForce; ExtInfw%u%c_obj%ydotForce = C_LOC( ExtInfw%u%ydotForce(1) ) + ExtInfw%u%c_obj%zdotForce_Len = ExtInfw%p%nNodesForce; ExtInfw%u%c_obj%zdotForce = C_LOC( ExtInfw%u%zdotForce(1) ) + ExtInfw%u%c_obj%pOrientation_Len = ExtInfw%p%nNodesForce*3*3; ExtInfw%u%c_obj%pOrientation = C_LOC( ExtInfw%u%pOrientation(1) ) + ExtInfw%u%c_obj%fx_Len = ExtInfw%p%nNodesForce; ExtInfw%u%c_obj%fx = C_LOC( ExtInfw%u%fx(1) ) + ExtInfw%u%c_obj%fy_Len = ExtInfw%p%nNodesForce; ExtInfw%u%c_obj%fy = C_LOC( ExtInfw%u%fy(1) ) + ExtInfw%u%c_obj%fz_Len = ExtInfw%p%nNodesForce; ExtInfw%u%c_obj%fz = C_LOC( ExtInfw%u%fz(1) ) + ExtInfw%u%c_obj%momentx_Len = ExtInfw%p%nNodesForce; ExtInfw%u%c_obj%momentx = C_LOC( ExtInfw%u%momentx(1) ) + ExtInfw%u%c_obj%momenty_Len = ExtInfw%p%nNodesForce; ExtInfw%u%c_obj%momenty = C_LOC( ExtInfw%u%momenty(1) ) + ExtInfw%u%c_obj%momentz_Len = ExtInfw%p%nNodesForce; ExtInfw%u%c_obj%momentz = C_LOC( ExtInfw%u%momentz(1) ) + ExtInfw%u%c_obj%forceNodesChord_Len = ExtInfw%p%nNodesForce; ExtInfw%u%c_obj%forceNodesChord = C_LOC( ExtInfw%u%forceNodesChord(1) ) ! initialize the arrays: !----------------------- - OpFM%p%NodeClusterType = InitInp%NodeClusterType + ExtInfw%p%NodeClusterType = InitInp%NodeClusterType ! Create the blade and tower nodes in radial and tower height co-ordinates - call OpFM_CreateActForceBladeTowerNodes(initOut_AD, OpFM%p, OpFM%u, ErrStat2, ErrMsg2); if (Failed()) return; + call ExtInfw_CreateActForceBladeTowerNodes(initOut_AD, ExtInfw%p, ExtInfw%u, ErrStat2, ErrMsg2); if (Failed()) return; ! Interpolates the chord distribution to the force nodes - call OpFM_InterpolateForceNodesChord(initOut_AD, OpFM%p, OpFM%u, ErrStat2, ErrMsg2); if (Failed()) return; + call ExtInfw_InterpolateForceNodesChord(initOut_AD, ExtInfw%p, ExtInfw%u, ErrStat2, ErrMsg2); if (Failed()) return; ! create actuator point motion mesh - call OpFM_CreateActForceMotionsMesh( p_FAST, u_AD, InitInp, OpFM, ErrStat2, ErrMsg2); if (Failed()) return; + call ExtInfw_CreateActForceMotionsMesh( p_FAST, u_AD, InitInp, ExtInfw, ErrStat2, ErrMsg2); if (Failed()) return; !............................................................................................ ! 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). + ! to add ExternalInflow integrations in the rest fo the code). !............................................................................................ ! Allocate space for mapping data structures - 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); if (Failed2()) return; + ALLOCATE( ExtInfw%m%ActForceLoadsPoints(ExtInfw%p%NMappings), ExtInfw%m%Line2_to_Point_Loads(ExtInfw%p%NMappings), ExtInfw%m%Line2_to_Point_Motions(ExtInfw%p%NMappings),STAT=ErrStat2); if (Failed2()) return; - do k=1,OpFM%p%NMappings - call MeshCopy ( SrcMesh = OpFM%m%ActForceMotionsPoints(k) & - , DestMesh = OpFM%m%ActForceLoadsPoints(k) & + do k=1,ExtInfw%p%NMappings + call MeshCopy ( SrcMesh = ExtInfw%m%ActForceMotionsPoints(k) & + , DestMesh = ExtInfw%m%ActForceLoadsPoints(k) & , CtrlCode = MESH_SIBLING & , IOS = COMPONENT_OUTPUT & , Force = .true. & @@ -207,55 +210,72 @@ SUBROUTINE Init_OpFM( InitInp, p_FAST, AirDens, u_AD, initOut_AD, y_AD, OpFM, In , ErrStat = ErrStat2 & , ErrMess = ErrMsg2 ) if (Failed()) return; - OpFM%m%ActForceLoadsPoints(k)%RemapFlag = .true. + ExtInfw%m%ActForceLoadsPoints(k)%RemapFlag = .true. end do ! Mapping of meshes for blades - DO k=1,OpFM%p%NumBl - call MeshMapCreate( u_AD%rotors(1)%BladeMotion(k), OpFM%m%ActForceMotionsPoints(k), OpFM%m%Line2_to_Point_Motions(k), ErrStat2, ErrMsg2 ); if (Failed()) return; - call MeshMapCreate( y_AD%rotors(1)%BladeLoad(k), OpFM%m%ActForceLoadsPoints(k), OpFM%m%Line2_to_Point_Loads(k), ErrStat2, ErrMsg2 ); if (Failed()) return; + DO k=1,ExtInfw%p%NumBl + call MeshMapCreate( u_AD%rotors(1)%BladeMotion(k), ExtInfw%m%ActForceMotionsPoints(k), ExtInfw%m%Line2_to_Point_Motions(k), ErrStat2, ErrMsg2 ); if (Failed()) return; + call MeshMapCreate( y_AD%rotors(1)%BladeLoad(k), ExtInfw%m%ActForceLoadsPoints(k), ExtInfw%m%Line2_to_Point_Loads(k), ErrStat2, ErrMsg2 ); if (Failed()) return; END DO ! Mapping tower - do k=OpFM%p%NumBl+1,OpFM%p%NMappings - call MeshMapCreate( u_AD%rotors(1)%TowerMotion, OpFM%m%ActForceMotionsPoints(k), OpFM%m%Line2_to_Point_Motions(k), ErrStat2, ErrMsg2 ); if (Failed()) return; + do k=ExtInfw%p%NumBl+1,ExtInfw%p%NMappings + call MeshMapCreate( u_AD%rotors(1)%TowerMotion, ExtInfw%m%ActForceMotionsPoints(k), ExtInfw%m%Line2_to_Point_Motions(k), ErrStat2, ErrMsg2 ); if (Failed()) return; 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%ActForceLoadsPoints(k), OpFM%m%Line2_to_Point_Loads(k), ErrStat2, ErrMsg2 ); if (Failed()) return; + call MeshMapCreate( y_AD%rotors(1)%TowerLoad, ExtInfw%m%ActForceLoadsPoints(k), ExtInfw%m%Line2_to_Point_Loads(k), ErrStat2, ErrMsg2 ); if (Failed()) return; end if end do - call SetOpFMPositions(p_FAST, u_AD, OpFM, ErrStat2, ErrMsg2); if (Failed()) return; - OpFM%u%fx = 0.0_ReKi - OpFM%u%fy = 0.0_ReKi - OpFM%u%fz = 0.0_ReKi + call SetExtInfwPositions(p_FAST, u_AD, ExtInfw, ErrStat2, ErrMsg2); if (Failed()) return; + ExtInfw%u%fx = 0.0_ReKi + ExtInfw%u%fy = 0.0_ReKi + ExtInfw%u%fz = 0.0_ReKi !............................................................................................ ! Define system output initializations (set up mesh) here: !............................................................................................ - CALL AllocPAry( OpFM%y%u, OpFM%p%nNodesVel, 'u', ErrStat2, ErrMsg2 ); if (Failed()) return; - CALL AllocPAry( OpFM%y%v, OpFM%p%nNodesVel, 'v', ErrStat2, ErrMsg2 ); if (Failed()) return; - CALL AllocPAry( OpFM%y%w, OpFM%p%nNodesVel, 'w', ErrStat2, ErrMsg2 ); if (Failed()) return; + CALL AllocPAry( ExtInfw%y%u, ExtInfw%p%nNodesVel, 'u', ErrStat2, ErrMsg2 ); if (Failed()) return; + CALL AllocPAry( ExtInfw%y%v, ExtInfw%p%nNodesVel, 'v', ErrStat2, ErrMsg2 ); if (Failed()) return; + CALL AllocPAry( ExtInfw%y%w, ExtInfw%p%nNodesVel, 'w', ErrStat2, ErrMsg2 ); if (Failed()) 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) ) + ExtInfw%y%c_obj%u_Len = ExtInfw%p%nNodesVel; ExtInfw%y%c_obj%u = C_LOC( ExtInfw%y%u(1) ) + ExtInfw%y%c_obj%v_Len = ExtInfw%p%nNodesVel; ExtInfw%y%c_obj%v = C_LOC( ExtInfw%y%v(1) ) + ExtInfw%y%c_obj%w_Len = ExtInfw%p%nNodesVel; ExtInfw%y%c_obj%w = C_LOC( ExtInfw%y%w(1) ) + + !............................................................................................ + ! Initialize InflowWind FlowField + !............................................................................................ + if (associated(ExtInfw%m%FlowField)) deallocate(ExtInfw%m%FlowField) + allocate(ExtInfw%m%FlowField, stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat( ErrID_Fatal, 'Error allocating m%FlowField', ErrStat, ErrMsg, RoutineName ) + return + end if + ! Initialize flowfield points type + ExtInfw%m%FlowField%FieldType = Point_FieldType + Points_InitInput%NumWindPoints = ExtInfw%p%nNodesVel + call IfW_Points_Init(Points_InitInput, ExtInfw%m%FlowField%Points, ErrStat2, ErrMsg2); if (Failed()) return + + ! Set pointer to flow field in InitOut + InitOut%FlowField => ExtInfw%m%FlowField !............................................................................................ ! Define initialization-routine output (including writeOutput array) here: !............................................................................................ CALL AllocAry( InitOut%WriteOutputHdr, 3, 'WriteOutputHdr', ErrStat2, ErrMsg2 ); if (Failed()) return; CALL AllocAry( InitOut%WriteOutputUnt, 3, 'WriteOutputUnt', ErrStat2, ErrMsg2 ); if (Failed()) return; - CALL AllocAry( OpFM%y%WriteOutput, 3, 'WriteOutput', ErrStat2, ErrMsg2 ); if (Failed()) return; + CALL AllocAry( ExtInfw%y%WriteOutput, 3, 'WriteOutput', ErrStat2, ErrMsg2 ); if (Failed()) 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 + ExtInfw%y%WriteOutput = 0.0_ReKi - InitOut%Ver = OpFM_Ver + InitOut%Ver = ExtInfw_Ver RETURN contains @@ -271,41 +291,55 @@ logical function Failed2() Failed2 = .false. endif end function Failed2 -END SUBROUTINE Init_OpFM +END SUBROUTINE Init_ExtInfw +!---------------------------------------------------------------------------------------------------------------------------------- +SUBROUTINE ExtInfw_UpdateFlowField(p_FAST, ExtInfw, ErrStat, ErrMsg) + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST ! Parameters for the glue code + TYPE(ExternalInflow_Data), INTENT(INOUT) :: ExtInfw ! data for the ExternalInflow integration module + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + + ErrStat = ErrID_None + ErrMsg = "" + + ExtInfw%m%FlowField%Points%Vel(1,1:size(ExtInfw%y%u)) = ExtInfw%y%u + ExtInfw%m%FlowField%Points%Vel(2,1:size(ExtInfw%y%v)) = ExtInfw%y%v + ExtInfw%m%FlowField%Points%Vel(3,1:size(ExtInfw%y%w)) = ExtInfw%y%w +END SUBROUTINE ExtInfw_UpdateFlowField !---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE OpFM_SetInputs( p_FAST, u_AD, y_AD, y_SrvD, OpFM, ErrStat, ErrMsg ) - TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST ! Parameters for the glue code - 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(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 +SUBROUTINE ExtInfw_SetInputs( p_FAST, u_AD, y_AD, y_SrvD, ExtInfw, ErrStat, ErrMsg ) + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST ! Parameters for the glue code + 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(SrvD_OutputType), INTENT(IN ) :: y_SrvD ! The outputs of the ServoDyn module (control) + TYPE(ExternalInflow_Data), INTENT(INOUT) :: ExtInfw ! data for the ExternalInflow 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' + CHARACTER(*), PARAMETER :: RoutineName = 'ExtInfw_SetInputs' ErrStat = ErrID_None ErrMsg = "" ! set the positions - call SetOpFMPositions(p_FAST, u_AD, OpFM, ErrStat2, ErrMsg2) + call SetExtInfwPositions(p_FAST, u_AD, ExtInfw, ErrStat2, ErrMsg2) call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ! set the forces - call SetOpFMForces(p_FAST, u_AD, y_AD, OpFM, ErrStat2, ErrMsg2) + call SetExtInfwForces(p_FAST, u_AD, y_AD, ExtInfw, ErrStat2, ErrMsg2) call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) -END SUBROUTINE OpFM_SetInputs +END SUBROUTINE ExtInfw_SetInputs !---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE SetOpFMPositions(p_FAST, u_AD, OpFM, ErrStat, ErrMsg) - TYPE(OpenFOAM_Data), INTENT(INOUT) :: OpFM ! data for the OpenFOAM integration module - TYPE(AD_InputType), INTENT(IN) :: u_AD ! The input meshes (already calculated) from AeroDyn +SUBROUTINE SetExtInfwPositions(p_FAST, u_AD, ExtInfw, ErrStat, ErrMsg) + TYPE(ExternalInflow_Data), INTENT(INOUT) :: ExtInfw ! data for the ExternalInflow integration module + TYPE(AD_InputType), INTENT(IN ) :: u_AD ! The input meshes (already calculated) from AeroDyn TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST ! FAST parameter data INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None @@ -316,17 +350,25 @@ SUBROUTINE SetOpFMPositions(p_FAST, u_AD, OpFM, ErrStat, ErrMsg) INTEGER(IntKi) :: J ! Loops through nodes / elements. INTEGER(IntKi) :: K ! Loops through blades. INTEGER(IntKi) :: Node ! Node number for blade/node on mesh - CHARACTER(*), PARAMETER :: RoutineName = 'SetOpFMPositions' + CHARACTER(*), PARAMETER :: RoutineName = 'SetExtInfwPositions' ErrStat = ErrID_None ErrMsg = "" ! Do the Velocity (AeroDyn) nodes first !------------------------------------------------------------------------------------------------- - Node = 1 ! displaced hub position - OpFM%u%pxVel(Node) = u_AD%rotors(1)%HubMotion%Position(1,1) + u_AD%rotors(1)%HubMotion%TranslationDisp(1,1) - OpFM%u%pyVel(Node) = u_AD%rotors(1)%HubMotion%Position(2,1) + u_AD%rotors(1)%HubMotion%TranslationDisp(2,1) - OpFM%u%pzVel(Node) = u_AD%rotors(1)%HubMotion%Position(3,1) + u_AD%rotors(1)%HubMotion%TranslationDisp(3,1) + + ! Hub + Node = 1 + if (u_AD%rotors(1)%HubMotion%Committed) then + ExtInfw%u%pxVel(Node) = real(u_AD%rotors(1)%HubMotion%Position(1,1) + u_AD%rotors(1)%HubMotion%TranslationDisp(1,1), c_float) + ExtInfw%u%pyVel(Node) = real(u_AD%rotors(1)%HubMotion%Position(2,1) + u_AD%rotors(1)%HubMotion%TranslationDisp(2,1), c_float) + ExtInfw%u%pzVel(Node) = real(u_AD%rotors(1)%HubMotion%Position(3,1) + u_AD%rotors(1)%HubMotion%TranslationDisp(3,1), c_float) + else + ExtInfw%u%pxVel(Node) = 0.0_c_float + ExtInfw%u%pyVel(Node) = 0.0_c_float + ExtInfw%u%pzVel(Node) = 0.0_c_float + end if ! blade nodes @@ -334,84 +376,68 @@ SUBROUTINE SetOpFMPositions(p_FAST, u_AD, OpFM, ErrStat, ErrMsg) 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) - + ExtInfw%u%pxVel(Node) = real(u_AD%rotors(1)%BladeMotion(k)%TranslationDisp(1,j) + u_AD%rotors(1)%BladeMotion(k)%Position(1,j), c_float) + ExtInfw%u%pyVel(Node) = real(u_AD%rotors(1)%BladeMotion(k)%TranslationDisp(2,j) + u_AD%rotors(1)%BladeMotion(k)%Position(2,j), c_float) + ExtInfw%u%pzVel(Node) = real(u_AD%rotors(1)%BladeMotion(k)%TranslationDisp(3,j) + u_AD%rotors(1)%BladeMotion(k)%Position(3,j), c_float) 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 + if (ExtInfw%p%NMappings .gt. ExtInfw%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) + ExtInfw%u%pxVel(Node) = real(u_AD%rotors(1)%TowerMotion%TranslationDisp(1,J) + u_AD%rotors(1)%TowerMotion%Position(1,J), c_float) + ExtInfw%u%pyVel(Node) = real(u_AD%rotors(1)%TowerMotion%TranslationDisp(2,J) + u_AD%rotors(1)%TowerMotion%Position(2,J), c_float) + ExtInfw%u%pzVel(Node) = real(u_AD%rotors(1)%TowerMotion%TranslationDisp(3,J) + u_AD%rotors(1)%TowerMotion%Position(3,J), c_float) 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) = u_AD%rotors(1)%HubMotion%Orientation(1,1,1) - OpFM%u%pOrientation((Node-1)*9 + 2) = u_AD%rotors(1)%HubMotion%Orientation(2,1,1) - OpFM%u%pOrientation((Node-1)*9 + 3) = u_AD%rotors(1)%HubMotion%Orientation(3,1,1) - OpFM%u%pOrientation((Node-1)*9 + 4) = u_AD%rotors(1)%HubMotion%Orientation(1,2,1) - OpFM%u%pOrientation((Node-1)*9 + 5) = u_AD%rotors(1)%HubMotion%Orientation(2,2,1) - OpFM%u%pOrientation((Node-1)*9 + 6) = u_AD%rotors(1)%HubMotion%Orientation(3,2,1) - OpFM%u%pOrientation((Node-1)*9 + 7) = u_AD%rotors(1)%HubMotion%Orientation(1,3,1) - OpFM%u%pOrientation((Node-1)*9 + 8) = u_AD%rotors(1)%HubMotion%Orientation(2,3,1) - OpFM%u%pOrientation((Node-1)*9 + 9) = u_AD%rotors(1)%HubMotion%Orientation(3,3,1) - - - DO K = 1,OpFM%p%NumBl + + ! Hub + Node = 1 + if (u_AD%rotors(1)%HubMotion%Committed) then + ExtInfw%u%pxForce(Node) = ExtInfw%u%pxVel(Node) + ExtInfw%u%pyForce(Node) = ExtInfw%u%pyVel(Node) + ExtInfw%u%pzForce(Node) = ExtInfw%u%pzVel(Node) + ExtInfw%u%pOrientation((Node-1)*9+1:Node*9) = real(pack(u_AD%rotors(1)%HubMotion%Orientation(:,:,1),.true.),c_float) + else + ExtInfw%u%pxForce(Node) = 0.0_c_float + ExtInfw%u%pyForce(Node) = 0.0_c_float + ExtInfw%u%pzForce(Node) = 0.0_c_float + ExtInfw%u%pOrientation((Node-1)*9+1:Node*9) = real([1.0, 0.0, 0.0, 0.0, 1.0, 0.0, 0.0, 0.0, 1.0], c_float) + end if + + + DO K = 1,ExtInfw%p%NumBl ! mesh mapping from line2 mesh to point mesh - call Transfer_Line2_to_Point( u_AD%rotors(1)%BladeMotion(k), OpFM%m%ActForceMotionsPoints(k), OpFM%m%Line2_to_Point_Motions(k), ErrStat2, ErrMsg2 ); if (Failed()) return; + call Transfer_Line2_to_Point( u_AD%rotors(1)%BladeMotion(k), ExtInfw%m%ActForceMotionsPoints(k), ExtInfw%m%Line2_to_Point_Motions(k), ErrStat2, ErrMsg2 ); if (Failed()) return; - DO J = 1, OpFM%p%nNodesForceBlade + DO J = 1, ExtInfw%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) + ExtInfw%u%pxForce(Node) = real(ExtInfw%m%ActForceMotionsPoints(k)%Position(1,J) + ExtInfw%m%ActForceMotionsPoints(k)%TranslationDisp(1,J),c_float) + ExtInfw%u%pyForce(Node) = real(ExtInfw%m%ActForceMotionsPoints(k)%Position(2,J) + ExtInfw%m%ActForceMotionsPoints(k)%TranslationDisp(2,J),c_float) + ExtInfw%u%pzForce(Node) = real(ExtInfw%m%ActForceMotionsPoints(k)%Position(3,J) + ExtInfw%m%ActForceMotionsPoints(k)%TranslationDisp(3,J),c_float) + ExtInfw%u%xdotForce(Node) = real(ExtInfw%m%ActForceMotionsPoints(k)%TranslationVel(1,J),c_float) + ExtInfw%u%ydotForce(Node) = real(ExtInfw%m%ActForceMotionsPoints(k)%TranslationVel(2,J),c_float) + ExtInfw%u%zdotForce(Node) = real(ExtInfw%m%ActForceMotionsPoints(k)%TranslationVel(3,J),c_float) + ExtInfw%u%pOrientation((Node-1)*9_1:Node*9) = real(pack(ExtInfw%m%ActForceMotionsPoints(k)%Orientation(:,:,J),.true.),c_float) END DO END DO - if (OpFM%p%NMappings .gt. OpFM%p%NumBl) then - DO K = OpFM%p%NumBl+1,OpFM%p%NMappings - call Transfer_Line2_to_Point( u_AD%rotors(1)%TowerMotion, OpFM%m%ActForceMotionsPoints(k), OpFM%m%Line2_to_Point_Motions(k), ErrStat2, ErrMsg2 ); if (Failed()) return; + if (ExtInfw%p%NMappings .gt. ExtInfw%p%NumBl) then + DO K = ExtInfw%p%NumBl+1,ExtInfw%p%NMappings + call Transfer_Line2_to_Point( u_AD%rotors(1)%TowerMotion, ExtInfw%m%ActForceMotionsPoints(k), ExtInfw%m%Line2_to_Point_Motions(k), ErrStat2, ErrMsg2 ); if (Failed()) return; - DO J=1,OpFM%p%nNodesForceTower + DO J=1,ExtInfw%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) + ExtInfw%u%pxForce(Node) = real(ExtInfw%m%ActForceMotionsPoints(k)%Position(1,J) + ExtInfw%m%ActForceMotionsPoints(k)%TranslationDisp(1,J),c_float) + ExtInfw%u%pyForce(Node) = real(ExtInfw%m%ActForceMotionsPoints(k)%Position(2,J) + ExtInfw%m%ActForceMotionsPoints(k)%TranslationDisp(2,J),c_float) + ExtInfw%u%pzForce(Node) = real(ExtInfw%m%ActForceMotionsPoints(k)%Position(3,J) + ExtInfw%m%ActForceMotionsPoints(k)%TranslationDisp(3,J),c_float) + ExtInfw%u%pOrientation((Node-1)*9+1:Node*9) = real(pack(ExtInfw%m%ActForceMotionsPoints(k)%Orientation(:,:,J),.true.),c_float) END DO END DO endif @@ -421,13 +447,13 @@ logical function Failed() CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) Failed = ErrStat >= AbortErrLev end function Failed -END SUBROUTINE SetOpFMPositions +END SUBROUTINE SetExtInfwPositions !---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE SetOpFMForces(p_FAST, u_AD, y_AD, OpFM, ErrStat, ErrMsg) - TYPE(OpenFOAM_Data), INTENT(INOUT) :: OpFM ! data for the OpenFOAM integration module - 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 +SUBROUTINE SetExtInfwForces(p_FAST, u_AD, y_AD, ExtInfw, ErrStat, ErrMsg) + TYPE(ExternalInflow_Data), INTENT(INOUT) :: ExtInfw ! data for the ExternalInflow integration module + 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(FAST_ParameterType), INTENT(IN ) :: p_FAST ! FAST parameter data INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None @@ -441,16 +467,16 @@ SUBROUTINE SetOpFMForces(p_FAST, u_AD, y_AD, OpFM, ErrStat, ErrMsg) INTEGER(IntKi) :: ErrStat2 ! temporary Error status of the operation CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None - CHARACTER(*), PARAMETER :: RoutineName = 'SetOpFMForces' + CHARACTER(*), PARAMETER :: RoutineName = 'SetExtInfwForces' 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 + ExtInfw%u%fx(Node) = 0.0_ReKi + ExtInfw%u%fy(Node) = 0.0_ReKi + ExtInfw%u%fz(Node) = 0.0_ReKi !....................... ! blade nodes @@ -466,59 +492,59 @@ SUBROUTINE SetOpFMForces(p_FAST, u_AD, y_AD, OpFM, ErrStat, ErrMsg) write(actForcesFile,*) '#x, y, z, fx, fy, fz' #endif - DO K = 1,OpFM%p%NumBl + DO K = 1,ExtInfw%p%NumBl #ifdef DEBUG_OPENFOAM DO J = 1,u_AD%rotors(1)%BladeMotion(k)%NNodes - write(aerodynForcesFile,*) u_AD%rotors(1)%BladeMotion(k)%TranslationDisp(1,j) + u_AD%rotors(1)%BladeMotion(k)%Position(1,j), ', ', u_AD%rotors(1)%BladeMotion(k)%TranslationDisp(2,j) + u_AD%rotors(1)%BladeMotion(k)%Position(2,j), ', ', u_AD%rotors(1)%BladeMotion(k)%TranslationDisp(3,j) + u_AD%rotors(1)%BladeMotion(k)%Position(3,j), ', ', OpFM%y%u(1 + (k-1)*u_AD%rotors(1)%BladeMotion(k)%NNodes + j), ', ', OpFM%y%v(1 + (k-1)*u_AD%rotors(1)%BladeMotion(k)%NNodes + j), ', ', OpFM%y%w(1 + (k-1)*u_AD%rotors(1)%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) + write(aerodynForcesFile,*) u_AD%rotors(1)%BladeMotion(k)%TranslationDisp(1,j) + u_AD%rotors(1)%BladeMotion(k)%Position(1,j), ', ', u_AD%rotors(1)%BladeMotion(k)%TranslationDisp(2,j) + u_AD%rotors(1)%BladeMotion(k)%Position(2,j), ', ', u_AD%rotors(1)%BladeMotion(k)%TranslationDisp(3,j) + u_AD%rotors(1)%BladeMotion(k)%Position(3,j), ', ', ExtInfw%y%u(1 + (k-1)*u_AD%rotors(1)%BladeMotion(k)%NNodes + j), ', ', ExtInfw%y%v(1 + (k-1)*u_AD%rotors(1)%BladeMotion(k)%NNodes + j), ', ', ExtInfw%y%w(1 + (k-1)*u_AD%rotors(1)%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_Point( y_AD%rotors(1)%BladeLoad(k), OpFM%m%ActForceLoadsPoints(k), OpFM%m%Line2_to_Point_Loads(k), ErrStat2, ErrMsg2, u_AD%rotors(1)%BladeMotion(k), OpFM%m%ActForceMotionsPoints(k) ); if (Failed()) return; + call Transfer_Line2_to_Point( y_AD%rotors(1)%BladeLoad(k), ExtInfw%m%ActForceLoadsPoints(k), ExtInfw%m%Line2_to_Point_Loads(k), ErrStat2, ErrMsg2, u_AD%rotors(1)%BladeMotion(k), ExtInfw%m%ActForceMotionsPoints(k) ); if (Failed()) return; - DO J = 1, OpFM%p%nNodesForceBlade + DO J = 1, ExtInfw%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) + ExtInfw%u%fx(Node) = ExtInfw%m%ActForceLoadsPoints(k)%Force(1,j) + ExtInfw%u%fy(Node) = ExtInfw%m%ActForceLoadsPoints(k)%Force(2,j) + ExtInfw%u%fz(Node) = ExtInfw%m%ActForceLoadsPoints(k)%Force(3,j) + ExtInfw%u%momentx(Node) = ExtInfw%m%ActForceLoadsPoints(k)%Moment(1,j) + ExtInfw%u%momenty(Node) = ExtInfw%m%ActForceLoadsPoints(k)%Moment(2,j) + ExtInfw%u%momentz(Node) = ExtInfw%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), ', ' + write(actForcesFile,*) ExtInfw%u%pxForce(Node), ', ', ExtInfw%u%pyForce(Node), ', ', ExtInfw%u%pzForce(Node), ', ', ExtInfw%u%fx(Node), ', ', ExtInfw%u%fy(Node), ', ', ExtInfw%u%fz(Node), ', ' #endif END DO - END DO !K = 1,OpFM%p%NumBl + END DO !K = 1,ExtInfw%p%NumBl !....................... ! tower nodes !....................... - if (OpFM%p%NMappings .gt. OpFM%p%NumBl) then + if (ExtInfw%p%NMappings .gt. ExtInfw%p%NumBl) then ! mesh mapping from line2 mesh to point mesh - DO K = OpFM%p%NumBl+1,OpFM%p%NMappings + DO K = ExtInfw%p%NumBl+1,ExtInfw%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%rotors(1)%TowerMotion%TranslationDisp(3,j) + u_AD%rotors(1)%TowerMotion%Position(3,j), ', ', OpFM%y%u(1 + OpFM%p%NumBl*u_AD%rotors(1)%BladeMotion(k)%NNodes + j), ', ', OpFM%y%v(1 + OpFM%p%NumBl*u_AD%rotors(1)%BladeMotion(k)%NNodes + j), ', ', OpFM%y%w(1 + OpFM%p%NumBl*u_AD%rotors(1)%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) + 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%rotors(1)%TowerMotion%TranslationDisp(3,j) + u_AD%rotors(1)%TowerMotion%Position(3,j), ', ', ExtInfw%y%u(1 + ExtInfw%p%NumBl*u_AD%rotors(1)%BladeMotion(k)%NNodes + j), ', ', ExtInfw%y%v(1 + ExtInfw%p%NumBl*u_AD%rotors(1)%BladeMotion(k)%NNodes + j), ', ', ExtInfw%y%w(1 + ExtInfw%p%NumBl*u_AD%rotors(1)%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_Point( y_AD%rotors(1)%TowerLoad, OpFM%m%ActForceLoadsPoints(k), OpFM%m%Line2_to_Point_Loads(k), ErrStat2, ErrMsg2, u_AD%rotors(1)%TowerMotion, OpFM%m%ActForceMotionsPoints(k) ); if (Failed()) return; + call Transfer_Line2_to_Point( y_AD%rotors(1)%TowerLoad, ExtInfw%m%ActForceLoadsPoints(k), ExtInfw%m%Line2_to_Point_Loads(k), ErrStat2, ErrMsg2, u_AD%rotors(1)%TowerMotion, ExtInfw%m%ActForceMotionsPoints(k) ); if (Failed()) return; - DO J=1,OpFM%p%nNodesForceTower + DO J=1,ExtInfw%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) + ExtInfw%u%fx(Node) = ExtInfw%m%ActForceLoadsPoints(k)%Force(1,j) + ExtInfw%u%fy(Node) = ExtInfw%m%ActForceLoadsPoints(k)%Force(2,j) + ExtInfw%u%fz(Node) = ExtInfw%m%ActForceLoadsPoints(k)%Force(3,j) + ExtInfw%u%momentx(Node) = ExtInfw%m%ActForceLoadsPoints(k)%Moment(1,j) + ExtInfw%u%momenty(Node) = ExtInfw%m%ActForceLoadsPoints(k)%Moment(2,j) + ExtInfw%u%momentz(Node) = ExtInfw%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), ', ' + write(actForcesFile,*) ExtInfw%u%pxForce(Node), ', ', ExtInfw%u%pyForce(Node), ', ', ExtInfw%u%pzForce(Node), ', ', ExtInfw%u%fx(Node), ', ', ExtInfw%u%fy(Node), ', ', ExtInfw%u%fz(Node), ', ' #endif END DO @@ -535,32 +561,32 @@ logical function Failed() CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) Failed = ErrStat >= AbortErrLev end function Failed -END SUBROUTINE SetOpFMForces +END SUBROUTINE SetExtInfwForces !---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE OpFM_SetWriteOutput( OpFM ) - TYPE(OpenFOAM_Data), INTENT(INOUT) :: OpFM ! data for the OpenFOAM integration module +SUBROUTINE ExtInfw_SetWriteOutput( ExtInfw ) + TYPE(ExternalInflow_Data), INTENT(INOUT) :: ExtInfw ! data for the ExternalInflow 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) + IF ( ALLOCATED( ExtInfw%y%WriteOutput ) ) THEN + IF ( ASSOCIATED( ExtInfw%y%u ) ) then + ExtInfw%y%WriteOutput(1) = ExtInfw%y%u(1) + ExtInfw%y%WriteOutput(2) = ExtInfw%y%v(1) + ExtInfw%y%WriteOutput(3) = ExtInfw%y%w(1) END IF END IF -END SUBROUTINE OpFM_SetWriteOutput +END SUBROUTINE ExtInfw_SetWriteOutput !---------------------------------------------------------------------------------------------------------------------------------- !> Create the actuator line force point mesh -SUBROUTINE OpFM_CreateActForceMotionsMesh( p_FAST, u_AD, InitIn_OpFM, OpFM, ErrStat, ErrMsg ) - TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST ! Parameters for the glue code - TYPE(AD_InputType), INTENT(IN) :: u_AD ! The input meshes (already calculated) from AeroDyn - 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 +SUBROUTINE ExtInfw_CreateActForceMotionsMesh( p_FAST, u_AD, InitIn_ExtInfw, ExtInfw, ErrStat, ErrMsg ) + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST ! Parameters for the glue code + TYPE(AD_InputType), INTENT(IN ) :: u_AD ! The input meshes (already calculated) from AeroDyn + TYPE(ExtInfw_InitInputType), INTENT(IN ) :: InitIn_ExtInfw ! InitInp data for the ExternalInflow integration module + TYPE(ExternalInflow_Data), INTENT(INOUT) :: ExtInfw ! data for the ExternalInflow 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 [-] @@ -568,25 +594,25 @@ SUBROUTINE OpFM_CreateActForceMotionsMesh( p_FAST, u_AD, InitIn_OpFM, OpFM, ErrS INTEGER(IntKi) :: 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' + CHARACTER(*), PARAMETER :: RoutineName = 'ExtInfw_CreateActForceMotionsMesh' ! Initialize variables ErrStat = ErrID_None ErrMsg = "" ! Allocate space for mapping data structures - ALLOCATE(tmpActForceMotionsMesh(OpFM%p%NMappings) , STAT=ErrStat2); if (Failed2()) return; - ALLOCATE(OpFM%m%ActForceMotionsPoints(OpFM%p%NMappings), STAT=ErrStat2); if (Failed2()) return; + ALLOCATE(tmpActForceMotionsMesh(ExtInfw%p%NMappings) , STAT=ErrStat2); if (Failed2()) return; + ALLOCATE(ExtInfw%m%ActForceMotionsPoints(ExtInfw%p%NMappings), STAT=ErrStat2); if (Failed2()) return; ! create a temporary mesh with the correct orientation info (stored in Orientation). This is then stored as the RefOrientation on the real mesh. ! ADP: this is a clever method @gantech came up with to interpolate orientations from one mesh to a finer mesh. - CALL OpFM_CreateTmpActForceMotionsMesh( p_FAST, u_AD, OpFM%p, InitIn_OpFM, tmpActForceMotionsMesh, ErrStat2, ErrMsg2 ); if (Failed()) return; + CALL ExtInfw_CreateTmpActForceMotionsMesh( p_FAST, u_AD, ExtInfw%p, InitIn_ExtInfw, tmpActForceMotionsMesh, ErrStat2, ErrMsg2 ); if (Failed()) return; !------- ! Blades - DO k=1,OpFM%p%NumBl - call MeshCreate ( BlankMesh = OpFM%m%ActForceMotionsPoints(k) & + DO k=1,ExtInfw%p%NumBl + call MeshCreate ( BlankMesh = ExtInfw%m%ActForceMotionsPoints(k) & ,IOS = COMPONENT_INPUT & - ,nNodes = OpFM%p%nNodesForceBlade & + ,nNodes = ExtInfw%p%nNodesForceBlade & ,Orientation = .true. & ,TranslationDisp = .true. & ,TranslationVel = .true. & @@ -595,24 +621,24 @@ SUBROUTINE OpFM_CreateActForceMotionsMesh( p_FAST, u_AD, InitIn_OpFM, OpFM, ErrS ,ErrMess = ErrMsg2 & ) if (Failed()) return; - OpFM%m%ActForceMotionsPoints(k)%RemapFlag = .false. + ExtInfw%m%ActForceMotionsPoints(k)%RemapFlag = .false. - do j=1,OpFM%p%nNodesForceBlade + do j=1,ExtInfw%p%nNodesForceBlade ! Use the temp mesh Orientation info as the RefOrientation for this mesh. - call MeshPositionNode(OpFM%m%ActForceMotionsPoints(k), j, tmpActForceMotionsMesh(k)%position(:,j), errStat2, errMsg2, orient=tmpActForceMotionsMesh(k)%Orientation(:,:,j)); if (Failed()) return; - call MeshConstructElement(OpFM%m%ActForceMotionsPoints(k), ELEMENT_POINT, errStat2, errMsg2, p1=j ); if (Failed()) return; + call MeshPositionNode(ExtInfw%m%ActForceMotionsPoints(k), j, tmpActForceMotionsMesh(k)%position(:,j), errStat2, errMsg2, orient=tmpActForceMotionsMesh(k)%Orientation(:,:,j)); if (Failed()) return; + call MeshConstructElement(ExtInfw%m%ActForceMotionsPoints(k), ELEMENT_POINT, errStat2, errMsg2, p1=j ); if (Failed()) return; end do !j - call MeshCommit(OpFM%m%ActForceMotionsPoints(k), errStat2, errMsg2 ); if (Failed()) return; + call MeshCommit(ExtInfw%m%ActForceMotionsPoints(k), errStat2, errMsg2 ); if (Failed()) return; END DO !------ ! Tower - if (OpFM%p%NMappings .gt. OpFM%p%NumBl) then - DO k=OpFM%p%NumBl+1,OpFM%p%NMappings - call MeshCreate ( BlankMesh = OpFM%m%ActForceMotionsPoints(k) & + if (ExtInfw%p%NMappings .gt. ExtInfw%p%NumBl) then + DO k=ExtInfw%p%NumBl+1,ExtInfw%p%NMappings + call MeshCreate ( BlankMesh = ExtInfw%m%ActForceMotionsPoints(k) & ,IOS = COMPONENT_INPUT & - ,nNodes = OpFM%p%nNodesForceTower & + ,nNodes = ExtInfw%p%nNodesForceTower & ,Orientation = .true. & ,TranslationDisp = .true. & ,TranslationVel = .true. & @@ -621,13 +647,13 @@ SUBROUTINE OpFM_CreateActForceMotionsMesh( p_FAST, u_AD, InitIn_OpFM, OpFM, ErrS ,ErrMess = ErrMsg2 & ) if (Failed()) return; - OpFM%m%ActForceMotionsPoints(k)%RemapFlag = .false. + ExtInfw%m%ActForceMotionsPoints(k)%RemapFlag = .false. - do j=1,OpFM%p%nNodesForceTower - call MeshPositionNode(OpFM%m%ActForceMotionsPoints(k), j, tmpActForceMotionsMesh(k)%position(:,j), errStat2, errMsg2, orient=tmpActForceMotionsMesh(k)%Orientation(:,:,j)); if (Failed()) return; - call MeshConstructElement(OpFM%m%ActForceMotionsPoints(k), ELEMENT_POINT, errStat2, errMsg2, p1=j); if (Failed()) return; + do j=1,ExtInfw%p%nNodesForceTower + call MeshPositionNode(ExtInfw%m%ActForceMotionsPoints(k), j, tmpActForceMotionsMesh(k)%position(:,j), errStat2, errMsg2, orient=tmpActForceMotionsMesh(k)%Orientation(:,:,j)); if (Failed()) return; + call MeshConstructElement(ExtInfw%m%ActForceMotionsPoints(k), ELEMENT_POINT, errStat2, errMsg2, p1=j); if (Failed()) return; end do !j - call MeshCommit(OpFM%m%ActForceMotionsPoints(k), errStat2, errMsg2 ); if (Failed()) return; + call MeshCommit(ExtInfw%m%ActForceMotionsPoints(k), errStat2, errMsg2 ); if (Failed()) return; END DO endif @@ -643,7 +669,7 @@ end function Failed subroutine Cleanup() ! NOTE: don't trap errors here if (allocated(tmpActForceMotionsMesh)) then - do k=1,OpFM%p%NMappings + do k=1,ExtInfw%p%NMappings call MeshDestroy ( tmpActForceMotionsMesh(k), ErrStat2, ErrMsg2 ) end do deallocate(tmpActForceMotionsMesh) @@ -658,17 +684,17 @@ logical function Failed2() Failed2 = .false. endif end function Failed2 -END SUBROUTINE OpFM_CreateActForceMotionsMesh +END SUBROUTINE ExtInfw_CreateActForceMotionsMesh !---------------------------------------------------------------------------------------------------------------------------------- !> this routine is used to create a temporary mesh with the number of points requested by CFD using the AD15 blade definition. This !! mesh is then used as an intermediate to interpolate the AD15 orientations over using mesh mapping. This routine only exists to !! facilitate the orientation calculations. -SUBROUTINE OpFM_CreateTmpActForceMotionsMesh( p_FAST, u_AD, p_OpFM, InitIn_OpFM, tmpActForceMotions, ErrStat, ErrMsg ) +SUBROUTINE ExtInfw_CreateTmpActForceMotionsMesh( p_FAST, u_AD, p_ExtInfw, InitIn_ExtInfw, tmpActForceMotions, ErrStat, ErrMsg ) TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST ! Parameters for the glue code - TYPE(AD_InputType), INTENT(IN) :: u_AD ! The input meshes (already calculated) from AeroDyn - 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(AD_InputType), INTENT(IN ) :: u_AD ! The input meshes (already calculated) from AeroDyn + TYPE(ExtInfw_ParameterType), INTENT(IN ) :: p_ExtInfw ! data for the ExternalInflow integration module + TYPE(ExtInfw_InitInputType), INTENT(IN ) :: InitIn_ExtInfw ! InitInp data for the ExternalInflow 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 @@ -682,25 +708,25 @@ SUBROUTINE OpFM_CreateTmpActForceMotionsMesh( p_FAST, u_AD, p_OpFM, InitIn_OpFM, INTEGER(IntKi) :: 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' + CHARACTER(*), PARAMETER :: RoutineName = 'ExtInfw_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 (Failed2()) return; - CALL CreateTmpStructModelMesh(p_FAST, u_AD, p_OpFM, tmp_StructModelMesh, ErrStat2, ErrMsg2 ); if (Failed()) return; + ALLOCATE(tmp_StructModelMesh(p_ExtInfw%NMappings) , STAT=ErrStat2); if (Failed2()) return; + CALL CreateTmpStructModelMesh(p_FAST, u_AD, p_ExtInfw, tmp_StructModelMesh, ErrStat2, ErrMsg2 ); if (Failed()) return; ! Allocate space for mapping data structures - ALLOCATE( tmp_line2_to_point_Motions(p_OpFM%NMappings),STAT=ErrStat2); if (Failed2()) return; + ALLOCATE( tmp_line2_to_point_Motions(p_ExtInfw%NMappings),STAT=ErrStat2); if (Failed2()) return; ! Blade nodes - call AllocAry(forceNodePositions, 3, p_OpFM%nNodesForceBlade, "forceNodePositions", ErrStat2, ErrMsg2); if (Failed()) return; - DO k=1,p_OpFM%NumBl + call AllocAry(forceNodePositions, 3, p_ExtInfw%nNodesForceBlade, "forceNodePositions", ErrStat2, ErrMsg2); if (Failed()) return; + DO k=1,p_ExtInfw%NumBl call MeshCreate ( BlankMesh = tmpActForceMotions(k) & , IOS = COMPONENT_INPUT & - , nNodes = p_OpFM%nNodesForceBlade & + , nNodes = p_ExtInfw%nNodesForceBlade & , ErrStat = ErrStat2 & , ErrMess = ErrMsg2 & , force = .false. & @@ -710,8 +736,8 @@ SUBROUTINE OpFM_CreateTmpActForceMotionsMesh( p_FAST, u_AD, p_OpFM, InitIn_OpFM, if (Failed()) return; tmpActForceMotions(k)%RemapFlag = .false. - call CalcForceActuatorPositionsBlade(InitIn_OpFM, p_OpFM, tmp_StructModelMesh(k)%position, forceNodePositions, errStat2, errMsg2); if (Failed()) return; - do j=1,p_OpFM%nNodesForceBlade + call CalcForceActuatorPositionsBlade(InitIn_ExtInfw, p_ExtInfw, tmp_StructModelMesh(k)%position, forceNodePositions, errStat2, errMsg2); if (Failed()) return; + do j=1,p_ExtInfw%nNodesForceBlade call MeshPositionNode(tmpActForceMotions(k), j, forceNodePositions(:,j), errStat2, errMsg2); if (Failed()) return; call MeshConstructElement( tmpActForceMotions(k), ELEMENT_POINT, errStat2, errMsg2, p1=j ); if (Failed()) return; end do !j @@ -722,14 +748,14 @@ SUBROUTINE OpFM_CreateTmpActForceMotionsMesh( p_FAST, u_AD, p_OpFM, InitIn_OpFM, if (allocated(forceNodePositions)) deallocate(forceNodePositions) ! Free space ! Tower nodes - if (p_OpFM%NMappings .gt. p_OpFM%NumBl) then - call AllocAry(forceNodePositions, 3, p_OpFM%nNodesForceTower, "forceNodePositions", ErrStat2, ErrMsg2); if (Failed()) return; - DO k=p_OpFM%NumBl+1,p_OpFM%NMappings - call CalcForceActuatorPositionsTower(InitIn_OpFM, p_OpFM, tmp_StructModelMesh(k)%position, forceNodePositions, errStat2, errMsg2); if (Failed()) return; + if (p_ExtInfw%NMappings .gt. p_ExtInfw%NumBl) then + call AllocAry(forceNodePositions, 3, p_ExtInfw%nNodesForceTower, "forceNodePositions", ErrStat2, ErrMsg2); if (Failed()) return; + DO k=p_ExtInfw%NumBl+1,p_ExtInfw%NMappings + call CalcForceActuatorPositionsTower(InitIn_ExtInfw, p_ExtInfw, tmp_StructModelMesh(k)%position, forceNodePositions, errStat2, errMsg2); if (Failed()) return; call MeshCreate ( BlankMesh = tmpActForceMotions(k) & ,IOS = COMPONENT_INPUT & - ,nNodes = p_OpFM%nNodesForceTower & + ,nNodes = p_ExtInfw%nNodesForceTower & ,ErrStat = ErrStat2 & ,ErrMess = ErrMsg2 & ,force = .false. & @@ -739,7 +765,7 @@ SUBROUTINE OpFM_CreateTmpActForceMotionsMesh( p_FAST, u_AD, p_OpFM, InitIn_OpFM, if (Failed()) return; tmpActForceMotions(k)%RemapFlag = .false. - do j=1,p_OpFM%nNodesForceTower + do j=1,p_ExtInfw%nNodesForceTower call MeshPositionNode(tmpActForceMotions(k), j, forceNodePositions(:,j), errStat2, errMsg2); if (Failed()) return; call MeshConstructElement( tmpActForceMotions(k), ELEMENT_POINT, errStat2, errMsg2, p1=j ); if (Failed()) return; end do !j @@ -750,18 +776,18 @@ SUBROUTINE OpFM_CreateTmpActForceMotionsMesh( p_FAST, u_AD, p_OpFM, InitIn_OpFM, endif ! create the mapping data structures: - DO k=1,p_OpFM%NumBl + DO k=1,p_ExtInfw%NumBl call MeshMapCreate( tmp_StructModelMesh(k), tmpActForceMotions(k), tmp_line2_to_point_Motions(k), ErrStat2, ErrMsg2 ); if (Failed()) return; END DO - if (p_OpFM%NMappings .gt. p_OpFM%NumBl) then - DO k=p_OpFM%NumBl+1,p_OpFM%NMappings + if (p_ExtInfw%NMappings .gt. p_ExtInfw%NumBl) then + DO k=p_ExtInfw%NumBl+1,p_ExtInfw%NMappings call MeshMapCreate( tmp_StructModelMesh(k), tmpActForceMotions(k), tmp_line2_to_point_Motions(k), ErrStat2, ErrMsg2 ); if (Failed()) return; END DO endif ! Map the orientation - DO K = 1,p_OpFM%NMappings + DO K = 1,p_ExtInfw%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 ); if (Failed()) return; END DO @@ -779,7 +805,7 @@ end function Failed subroutine Cleanup() ! NOTE: don't trap errors here if (allocated(forceNodePositions)) deallocate(forceNodePositions) - DO k=1,p_OpFM%NMappings + DO k=1,p_ExtInfw%NMappings call MeshDestroy ( tmp_StructModelMesh(k), ErrStat2, ErrMsg2 ) call MeshMapDestroy ( tmp_line2_to_point_Motions(k), ErrStat2, ErrMsg2 ) end do @@ -795,15 +821,15 @@ logical function Failed2() Failed2 = .false. endif end function Failed2 -END SUBROUTINE OpFM_CreateTmpActForceMotionsMesh +END SUBROUTINE ExtInfw_CreateTmpActForceMotionsMesh !---------------------------------------------------------------------------------------------------------------------------------- !> A temporary mesh is a copy of the AD15 mesh with the RefOrientation set to identity, and Orientation set to the AD15 RefOrientation. !! This is used to map orientations over to a more refined mesh. -SUBROUTINE CreateTmpStructModelMesh(p_FAST, u_AD, p_OpFM, tmpBladeMesh, ErrStat, ErrMsg ) +SUBROUTINE CreateTmpStructModelMesh(p_FAST, u_AD, p_ExtInfw, tmpBladeMesh, ErrStat, ErrMsg ) TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST ! Parameters for the glue code TYPE(AD_InputType), INTENT(IN ) :: u_AD ! The inputs for AD15 - TYPE(OpFM_ParameterType), INTENT(IN ) :: p_OpFM ! Parameters of the OpenFOAM integration module + TYPE(ExtInfw_ParameterType), INTENT(IN ) :: p_ExtInfw ! Parameters of the ExternalInflow integration module TYPE(MeshType), INTENT(INOUT) :: tmpBladeMesh(:) ! 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 @@ -816,7 +842,7 @@ SUBROUTINE CreateTmpStructModelMesh(p_FAST, u_AD, p_OpFM, tmpBladeMesh, ErrStat, CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None CHARACTER(*), PARAMETER :: RoutineName = 'CreateTmpStructModelMesh' - DO K = 1,p_OpFM%NumBl + DO K = 1,p_ExtInfw%NumBl nNodes = u_AD%rotors(1)%BladeMotion(K)%nNodes CALL MeshCreate( BlankMesh = tmpBladeMesh(K) & , NNodes = nNodes & @@ -852,8 +878,8 @@ SUBROUTINE CreateTmpStructModelMesh(p_FAST, u_AD, p_OpFM, tmpBladeMesh, ErrStat, END DO END DO - if (p_OpFM%NMappings .gt. p_OpFM%NumBl) then - DO K = p_OpFM%NumBl+1, p_OpFM%NMappings + if (p_ExtInfw%NMappings .gt. p_ExtInfw%NumBl) then + DO K = p_ExtInfw%NumBl+1, p_ExtInfw%NMappings nNodes = u_AD%rotors(1)%TowerMotion%nNodes CALL MeshCreate( BlankMesh = tmpBladeMesh(K) & , NNodes = nNodes & @@ -898,13 +924,13 @@ end function Failed END SUBROUTINE CreateTmpStructModelMesh !---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE CalcForceActuatorPositionsBlade(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 ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None +SUBROUTINE CalcForceActuatorPositionsBlade(InitIn_ExtInfw, p_ExtInfw, structPositions, forceNodePositions, ErrStat, ErrMsg) + TYPE(ExtInfw_InitInputType), INTENT(IN ) :: InitIn_ExtInfw ! data for the ExternalInflow integration module + TYPE(ExtInfw_ParameterType), INTENT(IN ) :: p_ExtInfw ! data for the ExternalInflow integration module + REAL(ReKi), POINTER, INTENT(IN ) :: structPositions(:,:) ! structural model positions + REAL(ReKi), INTENT(INOUT) :: forceNodePositions(:,:) ! Array to store the newly created positions + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None !Local variables INTEGER(IntKi) :: nStructNodes ! Number of velocity nodes @@ -923,21 +949,21 @@ SUBROUTINE CalcForceActuatorPositionsBlade(InitIn_OpFM, p_OpFM, structPositions, call AllocAry(rStructNodes, nStructNodes, "rStructNodes", ErrStat2, ErrMsg2); if (Failed()) return; ! Store the distance of the structural model nodes from the root into an array (from AD15 blade defenition) - rStructNodes(:) = InitIn_OpFM%StructBldRnodes(:) + rStructNodes(:) = InitIn_ExtInfw%StructBldRnodes(:) ! Now calculate the positions of the force nodes based on interpolation ! NOTE: the InterpArray function from the NWTC Library could be used here instead. This interpolation will eventually be removed, so we won't update it here. forceNodePositions(:,1) = structPositions(:,1) - DO I=2,p_OpFM%nNodesForceBlade-1 ! Calculate the position of the force nodes + DO I=2,p_ExtInfw%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 + if ((rStructNodes(jLower) - p_ExtInfw%forceBldRnodes(I))*(rStructNodes(jLower+1) - p_ExtInfw%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 + rInterp = (p_ExtInfw%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) + forceNodePositions(:,p_ExtInfw%nNodesForceBlade) = structPositions(:,nStructNodes) if (allocated(rStructNodes)) deallocate(rStructNodes) @@ -951,13 +977,13 @@ end function Failed 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 +SUBROUTINE CalcForceActuatorPositionsTower(InitIn_ExtInfw, p_ExtInfw, structPositions, forceNodePositions, ErrStat, ErrMsg) + TYPE(ExtInfw_InitInputType), INTENT(IN ) :: InitIn_ExtInfw ! data for the ExternalInflow integration module + TYPE(ExtInfw_ParameterType), INTENT(IN ) :: p_ExtInfw ! data for the ExternalInflow integration module + REAL(ReKi), POINTER, INTENT(IN ) :: 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 @@ -976,22 +1002,22 @@ SUBROUTINE CalcForceActuatorPositionsTower(InitIn_OpFM, p_OpFM, structPositions, call AllocAry(hStructNodes, nStructNodes, "hStructNodes", ErrStat2, ErrMsg2); if (Failed()) return; ! Store the distance of the structural model nodes from the root into an array - hStructNodes(:) = InitIn_OpFM%StructTwrHnodes(:) - hStructNodes(nStructNodes) = p_OpFM%TowerHeight+p_OpFM%TowerBaseHeight + hStructNodes(:) = InitIn_ExtInfw%StructTwrHnodes(:) + hStructNodes(nStructNodes) = p_ExtInfw%TowerHeight+p_ExtInfw%TowerBaseHeight ! Now calculate the positions of the force nodes based on interpolation ! NOTE: the InterpArray function from the NWTC Library could be used here instead. This interpolation will eventually be removed, so we won't update it here. forceNodePositions(:,1) = structPositions(:,1) - DO I=2,p_OpFM%nNodesForceTower-1 ! Calculate the position of the force nodes + DO I=2,p_ExtInfw%nNodesForceTower-1 ! Calculate the position of the force nodes do jLower = 1, (nStructNodes - 1) - if ((hStructNodes(jLower) - (p_OpFM%forceTwrHnodes(I)+p_OpFM%TowerBaseHeight))*(hStructNodes(jLower+1) - (p_OpFM%forceTwrHnodes(I)+p_OpFM%TowerBaseHeight)) .le. 0) then + if ((hStructNodes(jLower) - (p_ExtInfw%forceTwrHnodes(I)+p_ExtInfw%TowerBaseHeight))*(hStructNodes(jLower+1) - (p_ExtInfw%forceTwrHnodes(I)+p_ExtInfw%TowerBaseHeight)) .le. 0) then exit endif enddo - hInterp = (p_OpFM%forceTwrHnodes(I)+p_OpFM%TowerBaseHeight - 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 + hInterp = (p_ExtInfw%forceTwrHnodes(I)+p_ExtInfw%TowerBaseHeight - 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) + forceNodePositions(:,p_ExtInfw%nNodesForceTower) = structPositions(:,nStructNodes) if (allocated(hStructNodes)) deallocate(hStructNodes) RETURN @@ -1005,12 +1031,12 @@ END SUBROUTINE CalcForceActuatorPositionsTower !-------------------------------------------------------------------------- !> Creates the blade and tower nodes in radial and tower height co-ordinates -SUBROUTINE OpFM_CreateActForceBladeTowerNodes(InitOut_AD, p_OpFM, u_OpFM, ErrStat, ErrMsg) - TYPE(AD_InitOutputType), INTENT(IN ) :: InitOut_AD ! InitOut data for the OpenFOAM integration module - TYPE(OpFM_ParameterType),INTENT(INOUT) :: p_OpFM ! Parameter data for the OpenFOAM integration module - TYPE(OpFM_InputType), INTENT(INOUT) :: u_OpFM ! Input data for the OpenFOAM integration module - INTEGER(IntKi) :: ErrStat ! Error status of the operation - CHARACTER(ErrMsgLen) :: ErrMsg ! Error message if ErrStat /= ErrID_None +SUBROUTINE ExtInfw_CreateActForceBladeTowerNodes(InitOut_AD, p_ExtInfw, u_ExtInfw, ErrStat, ErrMsg) + TYPE(AD_InitOutputType), INTENT(IN ) :: InitOut_AD ! InitOut data for the ExternalInflow integration module + TYPE(ExtInfw_ParameterType), INTENT(INOUT) :: p_ExtInfw ! Parameter data for the ExternalInflow integration module + TYPE(ExtInfw_InputType), INTENT(INOUT) :: u_ExtInfw ! Input data for the ExternalInflow integration module + INTEGER(IntKi) :: ErrStat ! Error status of the operation + CHARACTER(ErrMsgLen) :: ErrMsg ! Error message if ErrStat /= ErrID_None !Local variables REAL(ReKi), ALLOCATABLE :: cNonUniform(:) @@ -1026,7 +1052,7 @@ SUBROUTINE OpFM_CreateActForceBladeTowerNodes(InitOut_AD, p_OpFM, u_OpFM, ErrSta INTEGER(IntKI) :: i ! Loop variables INTEGER(IntKi) :: ErrStat2 ! temporary Error status of the operation CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None - CHARACTER(*), PARAMETER :: RoutineName = 'OpFM_CreateActForceBladeTowerNodes' + CHARACTER(*), PARAMETER :: RoutineName = 'ExtInfw_CreateActForceBladeTowerNodes' ErrStat = ErrID_None ErrMsg = "" @@ -1034,38 +1060,38 @@ SUBROUTINE OpFM_CreateActForceBladeTowerNodes(InitOut_AD, p_OpFM, u_OpFM, ErrSta ! Tower - if (p_OpFM%NMappings .gt. p_OpFM%NumBl) then - allocate(p_OpFM%forceTwrHnodes(p_OpFM%nNodesForceTower), stat=errStat2); if (Failed2()) return; + if (p_ExtInfw%NMappings .gt. p_ExtInfw%NumBl) then + allocate(p_ExtInfw%forceTwrHnodes(p_ExtInfw%nNodesForceTower), stat=errStat2); if (Failed2()) return; ! Compute uniform spacing. - dRforceNodes = p_OpFM%TowerHeight/(p_OpFM%nNodesForceTower-1) - do i=1,p_OpFM%nNodesForceTower-1 - p_OpFM%forceTwrHnodes(i) = (i-1)*dRforceNodes + dRforceNodes = p_ExtInfw%TowerHeight/(p_ExtInfw%nNodesForceTower-1) + do i=1,p_ExtInfw%nNodesForceTower-1 + p_ExtInfw%forceTwrHnodes(i) = (i-1)*dRforceNodes end do - p_OpFM%forceTwrHnodes(p_OpFM%nNodesForceTower) = p_OpFM%TowerHeight + p_ExtInfw%forceTwrHnodes(p_ExtInfw%nNodesForceTower) = p_ExtInfw%TowerHeight end if ! Blades - allocate(cNonUniform(p_OpFM%nNodesForceBlade),stat=errStat2) - allocate(sNonUniform(p_OpFM%nNodesForceBlade),stat=errStat2) - allocate(pNonUniform(p_OpFM%nNodesForceBlade),stat=errStat2) - allocate(pUniform(p_OpFM%nNodesForceBlade),stat=errStat2) - allocate(cByS(p_OpFM%nNodesForceBlade),stat=errStat2) - allocate(e(p_OpFM%nNodesForceBlade-1),stat=errStat2) - allocate(p_OpFM%forceBldRnodes(p_OpFM%nNodesForceBlade), stat=errStat2); if (Failed2()) return; + allocate(cNonUniform(p_ExtInfw%nNodesForceBlade),stat=errStat2) + allocate(sNonUniform(p_ExtInfw%nNodesForceBlade),stat=errStat2) + allocate(pNonUniform(p_ExtInfw%nNodesForceBlade),stat=errStat2) + allocate(pUniform(p_ExtInfw%nNodesForceBlade),stat=errStat2) + allocate(cByS(p_ExtInfw%nNodesForceBlade),stat=errStat2) + allocate(e(p_ExtInfw%nNodesForceBlade-1),stat=errStat2) + allocate(p_ExtInfw%forceBldRnodes(p_ExtInfw%nNodesForceBlade), stat=errStat2); if (Failed2()) return; ! Compute uniform spacing. - dRforceNodes = p_OpFM%BladeLength/(p_OpFM%nNodesForceBlade-1) - do i=1,p_OpFM%nNodesForceBlade-1 + dRforceNodes = p_ExtInfw%BladeLength/(p_ExtInfw%nNodesForceBlade-1) + do i=1,p_ExtInfw%nNodesForceBlade-1 pUniform(i) = (i-1)*dRforceNodes end do - pUniform(p_OpFM%nNodesForceBlade) = p_OpFM%BladeLength - p_OpFM%forceBldRnodes = pUniform + pUniform(p_ExtInfw%nNodesForceBlade) = p_ExtInfw%BladeLength + p_ExtInfw%forceBldRnodes = pUniform - if (p_OpFM%NodeClusterType .eq. 0) then + if (p_ExtInfw%NodeClusterType .eq. 0) then print*, "Using uniform blade force node clustering." - !do i = 1, p_OpFM%nNodesForceBlade + !do i = 1, p_ExtInfw%nNodesForceBlade ! print*, "r(",i,") = ", pUniform(i) !end do end if @@ -1081,15 +1107,15 @@ SUBROUTINE OpFM_CreateActForceBladeTowerNodes(InitOut_AD, p_OpFM, u_OpFM, ErrSta ! convergence check. We take the difference between a = c/ds between ! all neighboring points to see how different they are, and take the ! rms of that error as the convergence measure (eSum). - if (p_OpFM%NodeClusterType .eq. 1) then + if (p_ExtInfw%NodeClusterType .eq. 1) then ! For chord-based clustering (increase resolution in regions of decreased chord), an iterative solution to the grid spacing is used. ! The initial guess to the spacing is uniform spacing, so start with that. pNonUniform = pUniform ! Get the chord at the initial force points. - call OpFM_InterpolateForceNodesChord(initOut_AD, p_OpFM, u_OpFM, ErrStat2, ErrMsg2) - cNonUniform(1:p_OpFM%nNodesForceBlade) = u_OpFM%forceNodesChord(2:p_OpFM%nNodesForceBlade+1) + call ExtInfw_InterpolateForceNodesChord(initOut_AD, p_ExtInfw, u_ExtInfw, ErrStat2, ErrMsg2) + cNonUniform(1:p_ExtInfw%nNodesForceBlade) = u_ExtInfw%forceNodesChord(2:p_ExtInfw%nNodesForceBlade+1) ! Iterate on a chord-based non-uniform spacing. counter = 0 @@ -1101,25 +1127,25 @@ SUBROUTINE OpFM_CreateActForceBladeTowerNodes(InitOut_AD, p_OpFM, u_OpFM, ErrSta !set the non-uniform spacing to ds = (sum(ds^) / sum(c^)) * c^, where !the ^ denotes from the last iteration. To begin the iteration, we !use ds = uniform. - sNonUniform = (p_OpFM%BladeLength)*cNonUniform/(sum(cNonUniform(2:p_OpFM%nNodesForceBlade-1)) + 0.5*(cNonUniform(1)+cNonUniform(p_OpFM%nNodesForceBlade))) + sNonUniform = (p_ExtInfw%BladeLength)*cNonUniform/(sum(cNonUniform(2:p_ExtInfw%nNodesForceBlade-1)) + 0.5*(cNonUniform(1)+cNonUniform(p_ExtInfw%nNodesForceBlade))) ! set the new blade points based on the new ds. - do i = 2, p_OpFM%nNodesForceBlade + do i = 2, p_ExtInfw%nNodesForceBlade pNonUniform(i) = pNonUniform(i-1) + 0.5*(sNonUniform(i-1) + sNonUniform(i)) end do - pNonUniform(p_OpFM%nNodesForceBlade) = p_OpFM%BladeLength - p_OpFM%forceBldRnodes = pNonUniform + pNonUniform(p_ExtInfw%nNodesForceBlade) = p_ExtInfw%BladeLength + p_ExtInfw%forceBldRnodes = pNonUniform ! interpolate chord to the new points to get the updated chord values - call OpFM_InterpolateForceNodesChord(initOut_AD, p_OpFM, u_OpFM,ErrStat2, ErrMsg2) - cNonUniform(1:p_OpFM%nNodesForceBlade) = u_OpFM%forceNodesChord(2:p_OpFM%nNodesForceBlade+1) + call ExtInfw_InterpolateForceNodesChord(initOut_AD, p_ExtInfw, u_ExtInfw,ErrStat2, ErrMsg2) + cNonUniform(1:p_ExtInfw%nNodesForceBlade) = u_ExtInfw%forceNodesChord(2:p_ExtInfw%nNodesForceBlade+1) ! compute a = c/ds cByS = cNonUniform/sNonUniform ! check how a = c/s varies along the span and take its rms to check ! convergence. - e = cByS(2:p_OpFM%nNodesForceBlade) - cByS(1:p_OpFM%nNodesForceBlade-1) + e = cByS(2:p_ExtInfw%nNodesForceBlade) - cByS(1:p_ExtInfw%nNodesForceBlade-1) eSum = sqrt(sum(e*e)) ! increment the iteration counter @@ -1143,16 +1169,16 @@ logical function Failed2() Failed2 = .false. endif end function Failed2 -END SUBROUTINE OpFM_CreateActForceBladeTowerNodes +END SUBROUTINE ExtInfw_CreateActForceBladeTowerNodes !-------------------------------------------------------------------------- !> Interpolates the chord distribution to the force nodes -SUBROUTINE OpFM_InterpolateForceNodesChord(InitOut_AD, p_OpFM, u_OpFM, ErrStat, ErrMsg) - TYPE(AD_InitOutputType), INTENT(IN ) :: InitOut_AD ! InitOut data for the OpenFOAM integration module - TYPE(OpFM_ParameterType), INTENT(IN ) :: p_OpFM ! Parameter data for the OpenFOAM integration module - TYPE(OpFM_InputType), INTENT(INOUT) :: u_OpFM ! Input 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 +SUBROUTINE ExtInfw_InterpolateForceNodesChord(InitOut_AD, p_ExtInfw, u_ExtInfw, ErrStat, ErrMsg) + TYPE(AD_InitOutputType), INTENT(IN ) :: InitOut_AD ! InitOut data for the ExternalInflow integration module + TYPE(ExtInfw_ParameterType), INTENT(IN ) :: p_ExtInfw ! Parameter data for the ExternalInflow integration module + TYPE(ExtInfw_InputType), INTENT(INOUT) :: u_ExtInfw ! Input data for the ExternalInflow 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 @@ -1166,57 +1192,57 @@ SUBROUTINE OpFM_InterpolateForceNodesChord(InitOut_AD, p_OpFM, u_OpFM, ErrStat, ! 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 + u_ExtInfw%forceNodesChord(Node) = 0.0_ReKi ! The blades first - do k = 1, p_OpFM%NumBl + do k = 1, p_ExtInfw%NumBl ! Calculate the chord at the force nodes based on interpolation ! NOTE: the InterpArray function from the NWTC Library could be used here instead. This interpolation will eventually be removed, so we won't update it here. nNodesBladeProps = SIZE(InitOut_AD%rotors(1)%BladeProps(k)%BlChord) - DO I=1,p_OpFM%nNodesForceBlade + DO I=1,p_ExtInfw%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 + if ( (InitOut_AD%rotors(1)%BladeProps(k)%BlSpn(jLower) - p_ExtInfw%forceBldRnodes(I))*(InitOut_AD%rotors(1)%BladeProps(k)%BlSpn(jLower+1) - p_ExtInfw%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)) + rInterp = (p_ExtInfw%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_ExtInfw%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. + u_ExtInfw%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 - if (p_OpFM%NMappings .gt. p_OpFM%NumBl) then - do k = p_OpFM%NumBl+1,p_OpFM%NMappings + if (p_ExtInfw%NMappings .gt. p_ExtInfw%NumBl) then + do k = p_ExtInfw%NumBl+1,p_ExtInfw%NMappings nNodesTowerProps = SIZE(InitOut_AD%rotors(1)%TwrElev) ! Calculate the chord at the force nodes based on interpolation - do I=1,p_OpFM%nNodesForceTower + do I=1,p_ExtInfw%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 + if ( (InitOut_AD%rotors(1)%TwrElev(jLower) - p_ExtInfw%forceTwrHnodes(I)-p_ExtInfw%TowerBaseHeight)*(InitOut_AD%rotors(1)%TwrElev(jLower+1) - p_ExtInfw%forceTwrHnodes(I)-p_ExtInfw%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)) + rInterp = (p_ExtInfw%forceTwrHnodes(I)+p_ExtInfw%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_ExtInfw%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. + u_ExtInfw%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 endif -END SUBROUTINE OpFM_InterpolateForceNodesChord +END SUBROUTINE ExtInfw_InterpolateForceNodesChord -END MODULE OpenFOAM +END MODULE ExternalInflow !********************************************************************************************************************************** diff --git a/modules/externalinflow/src/ExternalInflow_Registry.txt b/modules/externalinflow/src/ExternalInflow_Registry.txt new file mode 100644 index 0000000000..346b559395 --- /dev/null +++ b/modules/externalinflow/src/ExternalInflow_Registry.txt @@ -0,0 +1,79 @@ +################################################################################################################################### +# Registry for ExternalInflow - 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 +include IfW_FlowField.txt + + + +# ..... ExternalInflow_InitInputType data ....................................................................................................... +typedef ExternalInflow/ExtInfw InitInputType IntKi NumActForcePtsBlade - - - "number of actuator line force points in blade -- from extern (used to linearly interpolate along AD15 blades)" - +typedef ^ ^ IntKi NumActForcePtsTower - - - "number of actuator line force points in tower -- from extern (used to linearly interpolate along AD15 tower)" - +typedef ^ ^ ReKi StructBldRNodes {:} - - "Radius to structural model analysis nodes relative to hub" +typedef ^ ^ ReKi StructTwrHNodes {:} - - "Location of tower nodes from AD15 (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 +typedef ^ ^ IntKi NodeClusterType - - - "Node clustering (0 - Uniform, 1 - Non-uniform clustered towards tip)" - + + + +# ..... ExternalInflow_InitOutputType data ....................................................................................................... +# Define outputs from the initialization routine here: +typedef ExternalInflow/ExtInfw 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 FlowFieldType *FlowField - - - "Pointer of flow field data type" - + +# ..... MiscVars ................................................................................................................ +typedef ExternalInflow/ExtInfw ExtInfw_MiscVarType MeshType ActForceMotionsPoints {:} - - "point mesh for transferring AeroDyn motions to ExternalInflow (includes hub+blades+nacelle+tower+tailfin)" - +typedef ExternalInflow/ExtInfw ExtInfw_MiscVarType MeshType ActForceLoadsPoints {:} - - "point mesh for transferring AeroDyn distributed loads to ExternalInflow (includes hub+blades+nacelle+tower+tailfin)" - +typedef ExternalInflow/ExtInfw ExtInfw_MiscVarType MeshMapType Line2_to_Point_Loads {:} - - "mapping data structure to convert line2 loads to point loads" - +typedef ExternalInflow/ExtInfw ExtInfw_MiscVarType MeshMapType Line2_to_Point_Motions {:} - - "mapping data structure to convert line2 loads to point motions" - +typedef ExternalInflow/ExtInfw ExtInfw_MiscVarType FlowFieldType &FlowField - - - "Flow field data type" - + + +# ..... Parameters ................................................................................................................ +typedef ExternalInflow/ExtInfw ParameterType ReKi AirDens - - - "Air density for normalization of loads sent to ExternalInflow" kg/m^3 +typedef ExternalInflow/ExtInfw ParameterType IntKi NumBl - - - "Number of blades" - +typedef ExternalInflow/ExtInfw ParameterType IntKi NMappings - - - "Number of mappings" - +typedef ExternalInflow/ExtInfw ParameterType IntKi NnodesVel - - - "number of velocity nodes on FAST v8-ExternalInflow interface" - +typedef ExternalInflow/ExtInfw ParameterType IntKi NnodesForce - - - "number of force nodes on FAST v8-ExternalInflow interface" - +typedef ExternalInflow/ExtInfw ParameterType IntKi NnodesForceBlade - - - "number of force nodes on FAST v8-ExternalInflow interface" - +typedef ExternalInflow/ExtInfw ParameterType IntKi NnodesForceTower - - - "number of force nodes on FAST v8-ExternalInflow interface" - +typedef ExternalInflow/ExtInfw ParameterType ReKi forceBldRnodes {:} - - "Radial location of force nodes" - +typedef ExternalInflow/ExtInfw ParameterType ReKi forceTwrHnodes {:} - - "Vertical location of force nodes" - +typedef ExternalInflow/ExtInfw ParameterType ReKi BladeLength - - - "Blade length (same for all blades)" "m" +typedef ExternalInflow/ExtInfw ParameterType ReKi TowerHeight - - - "Tower height" "m" +typedef ExternalInflow/ExtInfw ParameterType ReKi TowerBaseHeight - - - "Tower base height" "m" +typedef ExternalInflow/ExtInfw ParameterType IntKi NodeClusterType - - - "Node clustering (0 - Uniform, 1 - Non-uniform clustered towards tip)" - + +# ..... ExternalInflow_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" + +# ..... ExternalInflow_OutputType data ....................................................................................................... +typedef ^ 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/modules/externalinflow/src/ExternalInflow_Types.f90 b/modules/externalinflow/src/ExternalInflow_Types.f90 new file mode 100644 index 0000000000..934490c07a --- /dev/null +++ b/modules/externalinflow/src/ExternalInflow_Types.f90 @@ -0,0 +1,2732 @@ +!STARTOFREGISTRYGENERATEDFILE 'ExternalInflow_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 +!********************************************************************************************************************************* +! ExternalInflow_Types +!................................................................................................................................. +! This file is part of ExternalInflow. +! +! 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 ExternalInflow. 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 ExternalInflow_Types +!--------------------------------------------------------------------------------------------------------------------------------- +USE IfW_FlowField_Types +USE NWTC_Library +IMPLICIT NONE +! ========= ExtInfw_InitInputType_C ======= + TYPE, BIND(C) :: ExtInfw_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 + INTEGER(KIND=C_INT) :: NodeClusterType + END TYPE ExtInfw_InitInputType_C + TYPE, PUBLIC :: ExtInfw_InitInputType + TYPE( ExtInfw_InitInputType_C ) :: C_obj + INTEGER(IntKi) :: NumActForcePtsBlade = 0_IntKi !< number of actuator line force points in blade -- from extern (used to linearly interpolate along AD15 blades) [-] + INTEGER(IntKi) :: NumActForcePtsTower = 0_IntKi !< number of actuator line force points in tower -- from extern (used to linearly interpolate along AD15 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 tower nodes from AD15 (relative to the tower rigid base height) [-] + REAL(ReKi) :: BladeLength = 0.0_ReKi !< Blade length [meters] + REAL(ReKi) :: TowerHeight = 0.0_ReKi !< Tower Height [meters] + REAL(ReKi) :: TowerBaseHeight = 0.0_ReKi !< Tower Base Height [meters] + INTEGER(IntKi) :: NodeClusterType = 0_IntKi !< Node clustering (0 - Uniform, 1 - Non-uniform clustered towards tip) [-] + END TYPE ExtInfw_InitInputType +! ======================= +! ========= ExtInfw_InitOutputType_C ======= + TYPE, BIND(C) :: ExtInfw_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 ExtInfw_InitOutputType_C + TYPE, PUBLIC :: ExtInfw_InitOutputType + TYPE( ExtInfw_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 [-] + TYPE(FlowFieldType) , POINTER :: FlowField => NULL() !< Pointer of flow field data type [-] + END TYPE ExtInfw_InitOutputType +! ======================= +! ========= ExtInfw_MiscVarType_C ======= + TYPE, BIND(C) :: ExtInfw_MiscVarType_C + TYPE(C_PTR) :: object = C_NULL_PTR + END TYPE ExtInfw_MiscVarType_C + TYPE, PUBLIC :: ExtInfw_MiscVarType + TYPE( ExtInfw_MiscVarType_C ) :: C_obj + TYPE(MeshType) , DIMENSION(:), ALLOCATABLE :: ActForceMotionsPoints !< point mesh for transferring AeroDyn motions to ExternalInflow (includes hub+blades+nacelle+tower+tailfin) [-] + TYPE(MeshType) , DIMENSION(:), ALLOCATABLE :: ActForceLoadsPoints !< point mesh for transferring AeroDyn distributed loads to ExternalInflow (includes hub+blades+nacelle+tower+tailfin) [-] + 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 [-] + TYPE(FlowFieldType) , POINTER :: FlowField => NULL() !< Flow field data type [-] + END TYPE ExtInfw_MiscVarType +! ======================= +! ========= ExtInfw_ParameterType_C ======= + TYPE, BIND(C) :: ExtInfw_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 + INTEGER(KIND=C_INT) :: NodeClusterType + END TYPE ExtInfw_ParameterType_C + TYPE, PUBLIC :: ExtInfw_ParameterType + TYPE( ExtInfw_ParameterType_C ) :: C_obj + REAL(ReKi) :: AirDens = 0.0_ReKi !< Air density for normalization of loads sent to ExternalInflow [kg/m^3] + INTEGER(IntKi) :: NumBl = 0_IntKi !< Number of blades [-] + INTEGER(IntKi) :: NMappings = 0_IntKi !< Number of mappings [-] + INTEGER(IntKi) :: NnodesVel = 0_IntKi !< number of velocity nodes on FAST v8-ExternalInflow interface [-] + INTEGER(IntKi) :: NnodesForce = 0_IntKi !< number of force nodes on FAST v8-ExternalInflow interface [-] + INTEGER(IntKi) :: NnodesForceBlade = 0_IntKi !< number of force nodes on FAST v8-ExternalInflow interface [-] + INTEGER(IntKi) :: NnodesForceTower = 0_IntKi !< number of force nodes on FAST v8-ExternalInflow interface [-] + REAL(KIND=C_FLOAT) , DIMENSION(:), POINTER :: forceBldRnodes => NULL() !< Radial location of force nodes [-] + REAL(KIND=C_FLOAT) , DIMENSION(:), POINTER :: forceTwrHnodes => NULL() !< Vertical location of force nodes [-] + REAL(ReKi) :: BladeLength = 0.0_ReKi !< Blade length (same for all blades) [m] + REAL(ReKi) :: TowerHeight = 0.0_ReKi !< Tower height [m] + REAL(ReKi) :: TowerBaseHeight = 0.0_ReKi !< Tower base height [m] + INTEGER(IntKi) :: NodeClusterType = 0_IntKi !< Node clustering (0 - Uniform, 1 - Non-uniform clustered towards tip) [-] + END TYPE ExtInfw_ParameterType +! ======================= +! ========= ExtInfw_InputType_C ======= + TYPE, BIND(C) :: ExtInfw_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 ExtInfw_InputType_C + TYPE, PUBLIC :: ExtInfw_InputType + TYPE( ExtInfw_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 ExtInfw_InputType +! ======================= +! ========= ExtInfw_OutputType_C ======= + TYPE, BIND(C) :: ExtInfw_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 ExtInfw_OutputType_C + TYPE, PUBLIC :: ExtInfw_OutputType + TYPE( ExtInfw_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 ExtInfw_OutputType +! ======================= +CONTAINS + +subroutine ExtInfw_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) + type(ExtInfw_InitInputType), intent(in) :: SrcInitInputData + type(ExtInfw_InitInputType), intent(inout) :: DstInitInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'ExtInfw_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 + LB(1:1) = lbound(SrcInitInputData%StructBldRNodes) + UB(1:1) = ubound(SrcInitInputData%StructBldRNodes) + if (.not. associated(DstInitInputData%StructBldRNodes)) then + allocate(DstInitInputData%StructBldRNodes(LB(1):UB(1)), 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(LB(1))) + end if + DstInitInputData%StructBldRNodes = SrcInitInputData%StructBldRNodes + end if + if (associated(SrcInitInputData%StructTwrHNodes)) then + LB(1:1) = lbound(SrcInitInputData%StructTwrHNodes) + UB(1:1) = ubound(SrcInitInputData%StructTwrHNodes) + if (.not. associated(DstInitInputData%StructTwrHNodes)) then + allocate(DstInitInputData%StructTwrHNodes(LB(1):UB(1)), 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(LB(1))) + end if + DstInitInputData%StructTwrHNodes = SrcInitInputData%StructTwrHNodes + end if + 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 + DstInitInputData%NodeClusterType = SrcInitInputData%NodeClusterType + DstInitInputData%C_obj%NodeClusterType = SrcInitInputData%C_obj%NodeClusterType +end subroutine + +subroutine ExtInfw_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(ExtInfw_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'ExtInfw_DestroyInitInput' + 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 + end if + if (associated(InitInputData%StructTwrHNodes)) then + deallocate(InitInputData%StructTwrHNodes) + InitInputData%StructTwrHNodes => null() + InitInputData%C_obj%StructTwrHNodes = c_null_ptr + InitInputData%C_obj%StructTwrHNodes_Len = 0 + end if +end subroutine + +subroutine ExtInfw_PackInitInput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(ExtInfw_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ExtInfw_PackInitInput' + logical :: PtrInIndex + if (RF%ErrStat >= AbortErrLev) return + if (c_associated(InData%C_obj%object)) then + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + call RegPack(RF, InData%NumActForcePtsBlade) + call RegPack(RF, InData%NumActForcePtsTower) + call RegPackPtr(RF, InData%StructBldRNodes) + call RegPackPtr(RF, InData%StructTwrHNodes) + call RegPack(RF, InData%BladeLength) + call RegPack(RF, InData%TowerHeight) + call RegPack(RF, InData%TowerBaseHeight) + call RegPack(RF, InData%NodeClusterType) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ExtInfw_UnPackInitInput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(ExtInfw_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ExtInfw_UnPackInitInput' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(B8Ki) :: PtrIdx + type(c_ptr) :: Ptr + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%NumActForcePtsBlade); if (RegCheckErr(RF, RoutineName)) return + OutData%C_obj%NumActForcePtsBlade = OutData%NumActForcePtsBlade + call RegUnpack(RF, OutData%NumActForcePtsTower); if (RegCheckErr(RF, RoutineName)) return + OutData%C_obj%NumActForcePtsTower = OutData%NumActForcePtsTower + call RegUnpackPtr(RF, OutData%StructBldRNodes, LB, UB); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%StructBldRNodes)) then + OutData%C_obj%StructBldRNodes_Len = size(OutData%StructBldRNodes) + if (OutData%C_obj%StructBldRNodes_Len > 0) OutData%C_obj%StructBldRNodes = c_loc(OutData%StructBldRNodes(LB(1))) + end if + call RegUnpackPtr(RF, OutData%StructTwrHNodes, LB, UB); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%StructTwrHNodes)) then + OutData%C_obj%StructTwrHNodes_Len = size(OutData%StructTwrHNodes) + if (OutData%C_obj%StructTwrHNodes_Len > 0) OutData%C_obj%StructTwrHNodes = c_loc(OutData%StructTwrHNodes(LB(1))) + end if + call RegUnpack(RF, OutData%BladeLength); if (RegCheckErr(RF, RoutineName)) return + OutData%C_obj%BladeLength = OutData%BladeLength + call RegUnpack(RF, OutData%TowerHeight); if (RegCheckErr(RF, RoutineName)) return + OutData%C_obj%TowerHeight = OutData%TowerHeight + call RegUnpack(RF, OutData%TowerBaseHeight); if (RegCheckErr(RF, RoutineName)) return + OutData%C_obj%TowerBaseHeight = OutData%TowerBaseHeight + call RegUnpack(RF, OutData%NodeClusterType); if (RegCheckErr(RF, RoutineName)) return + OutData%C_obj%NodeClusterType = OutData%NodeClusterType +end subroutine + +SUBROUTINE ExtInfw_C2Fary_CopyInitInput(InitInputData, ErrStat, ErrMsg, SkipPointers) + TYPE(ExtInfw_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 + InitInputData%NodeClusterType = InitInputData%C_obj%NodeClusterType +END SUBROUTINE + +SUBROUTINE ExtInfw_F2C_CopyInitInput( InitInputData, ErrStat, ErrMsg, SkipPointers ) + TYPE(ExtInfw_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 + InitInputData%C_obj%NodeClusterType = InitInputData%NodeClusterType +END SUBROUTINE + +subroutine ExtInfw_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) + type(ExtInfw_InitOutputType), intent(in) :: SrcInitOutputData + type(ExtInfw_InitOutputType), intent(inout) :: DstInitOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ExtInfw_CopyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcInitOutputData%WriteOutputHdr)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) + if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then + allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitOutputData%WriteOutputUnt)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) + if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then + allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), 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 + end if + call NWTC_Library_CopyProgDesc(SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstInitOutputData%FlowField => SrcInitOutputData%FlowField +end subroutine + +subroutine ExtInfw_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(ExtInfw_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ExtInfw_DestroyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InitOutputData%WriteOutputHdr)) then + deallocate(InitOutputData%WriteOutputHdr) + end if + if (allocated(InitOutputData%WriteOutputUnt)) then + deallocate(InitOutputData%WriteOutputUnt) + end if + call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + nullify(InitOutputData%FlowField) +end subroutine + +subroutine ExtInfw_PackInitOutput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(ExtInfw_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ExtInfw_PackInitOutput' + logical :: PtrInIndex + if (RF%ErrStat >= AbortErrLev) return + if (c_associated(InData%C_obj%object)) then + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + call RegPackAlloc(RF, InData%WriteOutputHdr) + call RegPackAlloc(RF, InData%WriteOutputUnt) + call NWTC_Library_PackProgDesc(RF, InData%Ver) + call RegPack(RF, associated(InData%FlowField)) + if (associated(InData%FlowField)) then + call RegPackPointer(RF, c_loc(InData%FlowField), PtrInIndex) + if (.not. PtrInIndex) then + call IfW_FlowField_PackFlowFieldType(RF, InData%FlowField) + end if + end if + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ExtInfw_UnPackInitOutput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(ExtInfw_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ExtInfw_UnPackInitOutput' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(B8Ki) :: PtrIdx + type(c_ptr) :: Ptr + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%WriteOutputHdr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WriteOutputUnt); if (RegCheckErr(RF, RoutineName)) return + call NWTC_Library_UnpackProgDesc(RF, OutData%Ver) ! Ver + if (associated(OutData%FlowField)) deallocate(OutData%FlowField) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackPointer(RF, Ptr, PtrIdx); if (RegCheckErr(RF, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%FlowField) + else + allocate(OutData%FlowField,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FlowField.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + RF%Pointers(PtrIdx) = c_loc(OutData%FlowField) + call IfW_FlowField_UnpackFlowFieldType(RF, OutData%FlowField) ! FlowField + end if + else + OutData%FlowField => null() + end if +end subroutine + +SUBROUTINE ExtInfw_C2Fary_CopyInitOutput(InitOutputData, ErrStat, ErrMsg, SkipPointers) + TYPE(ExtInfw_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 + +SUBROUTINE ExtInfw_F2C_CopyInitOutput( InitOutputData, ErrStat, ErrMsg, SkipPointers ) + TYPE(ExtInfw_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 + +subroutine ExtInfw_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(ExtInfw_MiscVarType), intent(inout) :: SrcMiscData + type(ExtInfw_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ExtInfw_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcMiscData%ActForceMotionsPoints)) then + LB(1:1) = lbound(SrcMiscData%ActForceMotionsPoints) + UB(1:1) = ubound(SrcMiscData%ActForceMotionsPoints) + if (.not. allocated(DstMiscData%ActForceMotionsPoints)) then + allocate(DstMiscData%ActForceMotionsPoints(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%ActForceMotionsPoints.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MeshCopy(SrcMiscData%ActForceMotionsPoints(i1), DstMiscData%ActForceMotionsPoints(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcMiscData%ActForceLoadsPoints)) then + LB(1:1) = lbound(SrcMiscData%ActForceLoadsPoints) + UB(1:1) = ubound(SrcMiscData%ActForceLoadsPoints) + if (.not. allocated(DstMiscData%ActForceLoadsPoints)) then + allocate(DstMiscData%ActForceLoadsPoints(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%ActForceLoadsPoints.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MeshCopy(SrcMiscData%ActForceLoadsPoints(i1), DstMiscData%ActForceLoadsPoints(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcMiscData%Line2_to_Point_Loads)) then + LB(1:1) = lbound(SrcMiscData%Line2_to_Point_Loads) + UB(1:1) = ubound(SrcMiscData%Line2_to_Point_Loads) + if (.not. allocated(DstMiscData%Line2_to_Point_Loads)) then + allocate(DstMiscData%Line2_to_Point_Loads(LB(1):UB(1)), 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 = LB(1), UB(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 + end do + end if + if (allocated(SrcMiscData%Line2_to_Point_Motions)) then + LB(1:1) = lbound(SrcMiscData%Line2_to_Point_Motions) + UB(1:1) = ubound(SrcMiscData%Line2_to_Point_Motions) + if (.not. allocated(DstMiscData%Line2_to_Point_Motions)) then + allocate(DstMiscData%Line2_to_Point_Motions(LB(1):UB(1)), 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 = LB(1), UB(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 + end do + end if + if (associated(SrcMiscData%FlowField)) then + if (.not. associated(DstMiscData%FlowField)) then + allocate(DstMiscData%FlowField, stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FlowField.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + call IfW_FlowField_CopyFlowFieldType(SrcMiscData%FlowField, DstMiscData%FlowField, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end if +end subroutine + +subroutine ExtInfw_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(ExtInfw_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ExtInfw_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(MiscData%ActForceMotionsPoints)) then + LB(1:1) = lbound(MiscData%ActForceMotionsPoints) + UB(1:1) = ubound(MiscData%ActForceMotionsPoints) + do i1 = LB(1), UB(1) + call MeshDestroy( MiscData%ActForceMotionsPoints(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%ActForceMotionsPoints) + end if + if (allocated(MiscData%ActForceLoadsPoints)) then + LB(1:1) = lbound(MiscData%ActForceLoadsPoints) + UB(1:1) = ubound(MiscData%ActForceLoadsPoints) + do i1 = LB(1), UB(1) + call MeshDestroy( MiscData%ActForceLoadsPoints(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%ActForceLoadsPoints) + end if + if (allocated(MiscData%Line2_to_Point_Loads)) then + LB(1:1) = lbound(MiscData%Line2_to_Point_Loads) + UB(1:1) = ubound(MiscData%Line2_to_Point_Loads) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(MiscData%Line2_to_Point_Loads(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%Line2_to_Point_Loads) + end if + if (allocated(MiscData%Line2_to_Point_Motions)) then + LB(1:1) = lbound(MiscData%Line2_to_Point_Motions) + UB(1:1) = ubound(MiscData%Line2_to_Point_Motions) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(MiscData%Line2_to_Point_Motions(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%Line2_to_Point_Motions) + end if + if (associated(MiscData%FlowField)) then + call IfW_FlowField_DestroyFlowFieldType(MiscData%FlowField, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + deallocate(MiscData%FlowField) + MiscData%FlowField => null() + end if +end subroutine + +subroutine ExtInfw_PackMisc(RF, Indata) + type(RegFile), intent(inout) :: RF + type(ExtInfw_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ExtInfw_PackMisc' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + logical :: PtrInIndex + if (RF%ErrStat >= AbortErrLev) return + if (c_associated(InData%C_obj%object)) then + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + call RegPack(RF, allocated(InData%ActForceMotionsPoints)) + if (allocated(InData%ActForceMotionsPoints)) then + call RegPackBounds(RF, 1, lbound(InData%ActForceMotionsPoints), ubound(InData%ActForceMotionsPoints)) + LB(1:1) = lbound(InData%ActForceMotionsPoints) + UB(1:1) = ubound(InData%ActForceMotionsPoints) + do i1 = LB(1), UB(1) + call MeshPack(RF, InData%ActForceMotionsPoints(i1)) + end do + end if + call RegPack(RF, allocated(InData%ActForceLoadsPoints)) + if (allocated(InData%ActForceLoadsPoints)) then + call RegPackBounds(RF, 1, lbound(InData%ActForceLoadsPoints), ubound(InData%ActForceLoadsPoints)) + LB(1:1) = lbound(InData%ActForceLoadsPoints) + UB(1:1) = ubound(InData%ActForceLoadsPoints) + do i1 = LB(1), UB(1) + call MeshPack(RF, InData%ActForceLoadsPoints(i1)) + end do + end if + call RegPack(RF, allocated(InData%Line2_to_Point_Loads)) + if (allocated(InData%Line2_to_Point_Loads)) then + call RegPackBounds(RF, 1, lbound(InData%Line2_to_Point_Loads), ubound(InData%Line2_to_Point_Loads)) + LB(1:1) = lbound(InData%Line2_to_Point_Loads) + UB(1:1) = ubound(InData%Line2_to_Point_Loads) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(RF, InData%Line2_to_Point_Loads(i1)) + end do + end if + call RegPack(RF, allocated(InData%Line2_to_Point_Motions)) + if (allocated(InData%Line2_to_Point_Motions)) then + call RegPackBounds(RF, 1, lbound(InData%Line2_to_Point_Motions), ubound(InData%Line2_to_Point_Motions)) + LB(1:1) = lbound(InData%Line2_to_Point_Motions) + UB(1:1) = ubound(InData%Line2_to_Point_Motions) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(RF, InData%Line2_to_Point_Motions(i1)) + end do + end if + call RegPack(RF, associated(InData%FlowField)) + if (associated(InData%FlowField)) then + call RegPackPointer(RF, c_loc(InData%FlowField), PtrInIndex) + if (.not. PtrInIndex) then + call IfW_FlowField_PackFlowFieldType(RF, InData%FlowField) + end if + end if + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ExtInfw_UnPackMisc(RF, OutData) + type(RegFile), intent(inout) :: RF + type(ExtInfw_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ExtInfw_UnPackMisc' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(B8Ki) :: PtrIdx + type(c_ptr) :: Ptr + if (RF%ErrStat /= ErrID_None) return + if (allocated(OutData%ActForceMotionsPoints)) deallocate(OutData%ActForceMotionsPoints) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%ActForceMotionsPoints(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ActForceMotionsPoints.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(RF, OutData%ActForceMotionsPoints(i1)) ! ActForceMotionsPoints + end do + end if + if (allocated(OutData%ActForceLoadsPoints)) deallocate(OutData%ActForceLoadsPoints) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%ActForceLoadsPoints(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ActForceLoadsPoints.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(RF, OutData%ActForceLoadsPoints(i1)) ! ActForceLoadsPoints + end do + end if + if (allocated(OutData%Line2_to_Point_Loads)) deallocate(OutData%Line2_to_Point_Loads) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%Line2_to_Point_Loads(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Line2_to_Point_Loads.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(RF, OutData%Line2_to_Point_Loads(i1)) ! Line2_to_Point_Loads + end do + end if + if (allocated(OutData%Line2_to_Point_Motions)) deallocate(OutData%Line2_to_Point_Motions) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%Line2_to_Point_Motions(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Line2_to_Point_Motions.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(RF, OutData%Line2_to_Point_Motions(i1)) ! Line2_to_Point_Motions + end do + end if + if (associated(OutData%FlowField)) deallocate(OutData%FlowField) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackPointer(RF, Ptr, PtrIdx); if (RegCheckErr(RF, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%FlowField) + else + allocate(OutData%FlowField,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FlowField.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + RF%Pointers(PtrIdx) = c_loc(OutData%FlowField) + call IfW_FlowField_UnpackFlowFieldType(RF, OutData%FlowField) ! FlowField + end if + else + OutData%FlowField => null() + end if +end subroutine + +SUBROUTINE ExtInfw_C2Fary_CopyMisc(MiscData, ErrStat, ErrMsg, SkipPointers) + TYPE(ExtInfw_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 + +SUBROUTINE ExtInfw_F2C_CopyMisc( MiscData, ErrStat, ErrMsg, SkipPointers ) + TYPE(ExtInfw_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 + +subroutine ExtInfw_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(ExtInfw_ParameterType), intent(in) :: SrcParamData + type(ExtInfw_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'ExtInfw_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 + LB(1:1) = lbound(SrcParamData%forceBldRnodes) + UB(1:1) = ubound(SrcParamData%forceBldRnodes) + if (.not. associated(DstParamData%forceBldRnodes)) then + allocate(DstParamData%forceBldRnodes(LB(1):UB(1)), 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(LB(1))) + end if + DstParamData%forceBldRnodes = SrcParamData%forceBldRnodes + end if + if (associated(SrcParamData%forceTwrHnodes)) then + LB(1:1) = lbound(SrcParamData%forceTwrHnodes) + UB(1:1) = ubound(SrcParamData%forceTwrHnodes) + if (.not. associated(DstParamData%forceTwrHnodes)) then + allocate(DstParamData%forceTwrHnodes(LB(1):UB(1)), 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(LB(1))) + end if + DstParamData%forceTwrHnodes = SrcParamData%forceTwrHnodes + end if + 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 + DstParamData%NodeClusterType = SrcParamData%NodeClusterType + DstParamData%C_obj%NodeClusterType = SrcParamData%C_obj%NodeClusterType +end subroutine + +subroutine ExtInfw_DestroyParam(ParamData, ErrStat, ErrMsg) + type(ExtInfw_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'ExtInfw_DestroyParam' + 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 + end if + if (associated(ParamData%forceTwrHnodes)) then + deallocate(ParamData%forceTwrHnodes) + ParamData%forceTwrHnodes => null() + ParamData%C_obj%forceTwrHnodes = c_null_ptr + ParamData%C_obj%forceTwrHnodes_Len = 0 + end if +end subroutine + +subroutine ExtInfw_PackParam(RF, Indata) + type(RegFile), intent(inout) :: RF + type(ExtInfw_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ExtInfw_PackParam' + logical :: PtrInIndex + if (RF%ErrStat >= AbortErrLev) return + if (c_associated(InData%C_obj%object)) then + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + call RegPack(RF, InData%AirDens) + call RegPack(RF, InData%NumBl) + call RegPack(RF, InData%NMappings) + call RegPack(RF, InData%NnodesVel) + call RegPack(RF, InData%NnodesForce) + call RegPack(RF, InData%NnodesForceBlade) + call RegPack(RF, InData%NnodesForceTower) + call RegPackPtr(RF, InData%forceBldRnodes) + call RegPackPtr(RF, InData%forceTwrHnodes) + call RegPack(RF, InData%BladeLength) + call RegPack(RF, InData%TowerHeight) + call RegPack(RF, InData%TowerBaseHeight) + call RegPack(RF, InData%NodeClusterType) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ExtInfw_UnPackParam(RF, OutData) + type(RegFile), intent(inout) :: RF + type(ExtInfw_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ExtInfw_UnPackParam' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(B8Ki) :: PtrIdx + type(c_ptr) :: Ptr + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%AirDens); if (RegCheckErr(RF, RoutineName)) return + OutData%C_obj%AirDens = OutData%AirDens + call RegUnpack(RF, OutData%NumBl); if (RegCheckErr(RF, RoutineName)) return + OutData%C_obj%NumBl = OutData%NumBl + call RegUnpack(RF, OutData%NMappings); if (RegCheckErr(RF, RoutineName)) return + OutData%C_obj%NMappings = OutData%NMappings + call RegUnpack(RF, OutData%NnodesVel); if (RegCheckErr(RF, RoutineName)) return + OutData%C_obj%NnodesVel = OutData%NnodesVel + call RegUnpack(RF, OutData%NnodesForce); if (RegCheckErr(RF, RoutineName)) return + OutData%C_obj%NnodesForce = OutData%NnodesForce + call RegUnpack(RF, OutData%NnodesForceBlade); if (RegCheckErr(RF, RoutineName)) return + OutData%C_obj%NnodesForceBlade = OutData%NnodesForceBlade + call RegUnpack(RF, OutData%NnodesForceTower); if (RegCheckErr(RF, RoutineName)) return + OutData%C_obj%NnodesForceTower = OutData%NnodesForceTower + call RegUnpackPtr(RF, OutData%forceBldRnodes, LB, UB); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%forceBldRnodes)) then + OutData%C_obj%forceBldRnodes_Len = size(OutData%forceBldRnodes) + if (OutData%C_obj%forceBldRnodes_Len > 0) OutData%C_obj%forceBldRnodes = c_loc(OutData%forceBldRnodes(LB(1))) + end if + call RegUnpackPtr(RF, OutData%forceTwrHnodes, LB, UB); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%forceTwrHnodes)) then + OutData%C_obj%forceTwrHnodes_Len = size(OutData%forceTwrHnodes) + if (OutData%C_obj%forceTwrHnodes_Len > 0) OutData%C_obj%forceTwrHnodes = c_loc(OutData%forceTwrHnodes(LB(1))) + end if + call RegUnpack(RF, OutData%BladeLength); if (RegCheckErr(RF, RoutineName)) return + OutData%C_obj%BladeLength = OutData%BladeLength + call RegUnpack(RF, OutData%TowerHeight); if (RegCheckErr(RF, RoutineName)) return + OutData%C_obj%TowerHeight = OutData%TowerHeight + call RegUnpack(RF, OutData%TowerBaseHeight); if (RegCheckErr(RF, RoutineName)) return + OutData%C_obj%TowerBaseHeight = OutData%TowerBaseHeight + call RegUnpack(RF, OutData%NodeClusterType); if (RegCheckErr(RF, RoutineName)) return + OutData%C_obj%NodeClusterType = OutData%NodeClusterType +end subroutine + +SUBROUTINE ExtInfw_C2Fary_CopyParam(ParamData, ErrStat, ErrMsg, SkipPointers) + TYPE(ExtInfw_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 + ParamData%NodeClusterType = ParamData%C_obj%NodeClusterType +END SUBROUTINE + +SUBROUTINE ExtInfw_F2C_CopyParam( ParamData, ErrStat, ErrMsg, SkipPointers ) + TYPE(ExtInfw_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 + ParamData%C_obj%NodeClusterType = ParamData%NodeClusterType +END SUBROUTINE + +subroutine ExtInfw_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) + type(ExtInfw_InputType), intent(in) :: SrcInputData + type(ExtInfw_InputType), intent(inout) :: DstInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'ExtInfw_CopyInput' + ErrStat = ErrID_None + ErrMsg = '' + if (associated(SrcInputData%pxVel)) then + LB(1:1) = lbound(SrcInputData%pxVel) + UB(1:1) = ubound(SrcInputData%pxVel) + if (.not. associated(DstInputData%pxVel)) then + allocate(DstInputData%pxVel(LB(1):UB(1)), 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(LB(1))) + end if + DstInputData%pxVel = SrcInputData%pxVel + end if + if (associated(SrcInputData%pyVel)) then + LB(1:1) = lbound(SrcInputData%pyVel) + UB(1:1) = ubound(SrcInputData%pyVel) + if (.not. associated(DstInputData%pyVel)) then + allocate(DstInputData%pyVel(LB(1):UB(1)), 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(LB(1))) + end if + DstInputData%pyVel = SrcInputData%pyVel + end if + if (associated(SrcInputData%pzVel)) then + LB(1:1) = lbound(SrcInputData%pzVel) + UB(1:1) = ubound(SrcInputData%pzVel) + if (.not. associated(DstInputData%pzVel)) then + allocate(DstInputData%pzVel(LB(1):UB(1)), 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(LB(1))) + end if + DstInputData%pzVel = SrcInputData%pzVel + end if + if (associated(SrcInputData%pxForce)) then + LB(1:1) = lbound(SrcInputData%pxForce) + UB(1:1) = ubound(SrcInputData%pxForce) + if (.not. associated(DstInputData%pxForce)) then + allocate(DstInputData%pxForce(LB(1):UB(1)), 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(LB(1))) + end if + DstInputData%pxForce = SrcInputData%pxForce + end if + if (associated(SrcInputData%pyForce)) then + LB(1:1) = lbound(SrcInputData%pyForce) + UB(1:1) = ubound(SrcInputData%pyForce) + if (.not. associated(DstInputData%pyForce)) then + allocate(DstInputData%pyForce(LB(1):UB(1)), 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(LB(1))) + end if + DstInputData%pyForce = SrcInputData%pyForce + end if + if (associated(SrcInputData%pzForce)) then + LB(1:1) = lbound(SrcInputData%pzForce) + UB(1:1) = ubound(SrcInputData%pzForce) + if (.not. associated(DstInputData%pzForce)) then + allocate(DstInputData%pzForce(LB(1):UB(1)), 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(LB(1))) + end if + DstInputData%pzForce = SrcInputData%pzForce + end if + if (associated(SrcInputData%xdotForce)) then + LB(1:1) = lbound(SrcInputData%xdotForce) + UB(1:1) = ubound(SrcInputData%xdotForce) + if (.not. associated(DstInputData%xdotForce)) then + allocate(DstInputData%xdotForce(LB(1):UB(1)), 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(LB(1))) + end if + DstInputData%xdotForce = SrcInputData%xdotForce + end if + if (associated(SrcInputData%ydotForce)) then + LB(1:1) = lbound(SrcInputData%ydotForce) + UB(1:1) = ubound(SrcInputData%ydotForce) + if (.not. associated(DstInputData%ydotForce)) then + allocate(DstInputData%ydotForce(LB(1):UB(1)), 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(LB(1))) + end if + DstInputData%ydotForce = SrcInputData%ydotForce + end if + if (associated(SrcInputData%zdotForce)) then + LB(1:1) = lbound(SrcInputData%zdotForce) + UB(1:1) = ubound(SrcInputData%zdotForce) + if (.not. associated(DstInputData%zdotForce)) then + allocate(DstInputData%zdotForce(LB(1):UB(1)), 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(LB(1))) + end if + DstInputData%zdotForce = SrcInputData%zdotForce + end if + if (associated(SrcInputData%pOrientation)) then + LB(1:1) = lbound(SrcInputData%pOrientation) + UB(1:1) = ubound(SrcInputData%pOrientation) + if (.not. associated(DstInputData%pOrientation)) then + allocate(DstInputData%pOrientation(LB(1):UB(1)), 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(LB(1))) + end if + DstInputData%pOrientation = SrcInputData%pOrientation + end if + if (associated(SrcInputData%fx)) then + LB(1:1) = lbound(SrcInputData%fx) + UB(1:1) = ubound(SrcInputData%fx) + if (.not. associated(DstInputData%fx)) then + allocate(DstInputData%fx(LB(1):UB(1)), 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(LB(1))) + end if + DstInputData%fx = SrcInputData%fx + end if + if (associated(SrcInputData%fy)) then + LB(1:1) = lbound(SrcInputData%fy) + UB(1:1) = ubound(SrcInputData%fy) + if (.not. associated(DstInputData%fy)) then + allocate(DstInputData%fy(LB(1):UB(1)), 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(LB(1))) + end if + DstInputData%fy = SrcInputData%fy + end if + if (associated(SrcInputData%fz)) then + LB(1:1) = lbound(SrcInputData%fz) + UB(1:1) = ubound(SrcInputData%fz) + if (.not. associated(DstInputData%fz)) then + allocate(DstInputData%fz(LB(1):UB(1)), 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(LB(1))) + end if + DstInputData%fz = SrcInputData%fz + end if + if (associated(SrcInputData%momentx)) then + LB(1:1) = lbound(SrcInputData%momentx) + UB(1:1) = ubound(SrcInputData%momentx) + if (.not. associated(DstInputData%momentx)) then + allocate(DstInputData%momentx(LB(1):UB(1)), 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(LB(1))) + end if + DstInputData%momentx = SrcInputData%momentx + end if + if (associated(SrcInputData%momenty)) then + LB(1:1) = lbound(SrcInputData%momenty) + UB(1:1) = ubound(SrcInputData%momenty) + if (.not. associated(DstInputData%momenty)) then + allocate(DstInputData%momenty(LB(1):UB(1)), 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(LB(1))) + end if + DstInputData%momenty = SrcInputData%momenty + end if + if (associated(SrcInputData%momentz)) then + LB(1:1) = lbound(SrcInputData%momentz) + UB(1:1) = ubound(SrcInputData%momentz) + if (.not. associated(DstInputData%momentz)) then + allocate(DstInputData%momentz(LB(1):UB(1)), 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(LB(1))) + end if + DstInputData%momentz = SrcInputData%momentz + end if + if (associated(SrcInputData%forceNodesChord)) then + LB(1:1) = lbound(SrcInputData%forceNodesChord) + UB(1:1) = ubound(SrcInputData%forceNodesChord) + if (.not. associated(DstInputData%forceNodesChord)) then + allocate(DstInputData%forceNodesChord(LB(1):UB(1)), 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(LB(1))) + end if + DstInputData%forceNodesChord = SrcInputData%forceNodesChord + end if +end subroutine + +subroutine ExtInfw_DestroyInput(InputData, ErrStat, ErrMsg) + type(ExtInfw_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'ExtInfw_DestroyInput' + 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 + end if + if (associated(InputData%pyVel)) then + deallocate(InputData%pyVel) + InputData%pyVel => null() + InputData%C_obj%pyVel = c_null_ptr + InputData%C_obj%pyVel_Len = 0 + end if + if (associated(InputData%pzVel)) then + deallocate(InputData%pzVel) + InputData%pzVel => null() + InputData%C_obj%pzVel = c_null_ptr + InputData%C_obj%pzVel_Len = 0 + end if + if (associated(InputData%pxForce)) then + deallocate(InputData%pxForce) + InputData%pxForce => null() + InputData%C_obj%pxForce = c_null_ptr + InputData%C_obj%pxForce_Len = 0 + end if + if (associated(InputData%pyForce)) then + deallocate(InputData%pyForce) + InputData%pyForce => null() + InputData%C_obj%pyForce = c_null_ptr + InputData%C_obj%pyForce_Len = 0 + end if + if (associated(InputData%pzForce)) then + deallocate(InputData%pzForce) + InputData%pzForce => null() + InputData%C_obj%pzForce = c_null_ptr + InputData%C_obj%pzForce_Len = 0 + end if + if (associated(InputData%xdotForce)) then + deallocate(InputData%xdotForce) + InputData%xdotForce => null() + InputData%C_obj%xdotForce = c_null_ptr + InputData%C_obj%xdotForce_Len = 0 + end if + if (associated(InputData%ydotForce)) then + deallocate(InputData%ydotForce) + InputData%ydotForce => null() + InputData%C_obj%ydotForce = c_null_ptr + InputData%C_obj%ydotForce_Len = 0 + end if + if (associated(InputData%zdotForce)) then + deallocate(InputData%zdotForce) + InputData%zdotForce => null() + InputData%C_obj%zdotForce = c_null_ptr + InputData%C_obj%zdotForce_Len = 0 + end if + if (associated(InputData%pOrientation)) then + deallocate(InputData%pOrientation) + InputData%pOrientation => null() + InputData%C_obj%pOrientation = c_null_ptr + InputData%C_obj%pOrientation_Len = 0 + end if + if (associated(InputData%fx)) then + deallocate(InputData%fx) + InputData%fx => null() + InputData%C_obj%fx = c_null_ptr + InputData%C_obj%fx_Len = 0 + end if + if (associated(InputData%fy)) then + deallocate(InputData%fy) + InputData%fy => null() + InputData%C_obj%fy = c_null_ptr + InputData%C_obj%fy_Len = 0 + end if + if (associated(InputData%fz)) then + deallocate(InputData%fz) + InputData%fz => null() + InputData%C_obj%fz = c_null_ptr + InputData%C_obj%fz_Len = 0 + end if + if (associated(InputData%momentx)) then + deallocate(InputData%momentx) + InputData%momentx => null() + InputData%C_obj%momentx = c_null_ptr + InputData%C_obj%momentx_Len = 0 + end if + if (associated(InputData%momenty)) then + deallocate(InputData%momenty) + InputData%momenty => null() + InputData%C_obj%momenty = c_null_ptr + InputData%C_obj%momenty_Len = 0 + end if + if (associated(InputData%momentz)) then + deallocate(InputData%momentz) + InputData%momentz => null() + InputData%C_obj%momentz = c_null_ptr + InputData%C_obj%momentz_Len = 0 + end if + if (associated(InputData%forceNodesChord)) then + deallocate(InputData%forceNodesChord) + InputData%forceNodesChord => null() + InputData%C_obj%forceNodesChord = c_null_ptr + InputData%C_obj%forceNodesChord_Len = 0 + end if +end subroutine + +subroutine ExtInfw_PackInput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(ExtInfw_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ExtInfw_PackInput' + logical :: PtrInIndex + if (RF%ErrStat >= AbortErrLev) return + if (c_associated(InData%C_obj%object)) then + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + call RegPackPtr(RF, InData%pxVel) + call RegPackPtr(RF, InData%pyVel) + call RegPackPtr(RF, InData%pzVel) + call RegPackPtr(RF, InData%pxForce) + call RegPackPtr(RF, InData%pyForce) + call RegPackPtr(RF, InData%pzForce) + call RegPackPtr(RF, InData%xdotForce) + call RegPackPtr(RF, InData%ydotForce) + call RegPackPtr(RF, InData%zdotForce) + call RegPackPtr(RF, InData%pOrientation) + call RegPackPtr(RF, InData%fx) + call RegPackPtr(RF, InData%fy) + call RegPackPtr(RF, InData%fz) + call RegPackPtr(RF, InData%momentx) + call RegPackPtr(RF, InData%momenty) + call RegPackPtr(RF, InData%momentz) + call RegPackPtr(RF, InData%forceNodesChord) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ExtInfw_UnPackInput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(ExtInfw_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ExtInfw_UnPackInput' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(B8Ki) :: PtrIdx + type(c_ptr) :: Ptr + if (RF%ErrStat /= ErrID_None) return + call RegUnpackPtr(RF, OutData%pxVel, LB, UB); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%pxVel)) then + OutData%C_obj%pxVel_Len = size(OutData%pxVel) + if (OutData%C_obj%pxVel_Len > 0) OutData%C_obj%pxVel = c_loc(OutData%pxVel(LB(1))) + end if + call RegUnpackPtr(RF, OutData%pyVel, LB, UB); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%pyVel)) then + OutData%C_obj%pyVel_Len = size(OutData%pyVel) + if (OutData%C_obj%pyVel_Len > 0) OutData%C_obj%pyVel = c_loc(OutData%pyVel(LB(1))) + end if + call RegUnpackPtr(RF, OutData%pzVel, LB, UB); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%pzVel)) then + OutData%C_obj%pzVel_Len = size(OutData%pzVel) + if (OutData%C_obj%pzVel_Len > 0) OutData%C_obj%pzVel = c_loc(OutData%pzVel(LB(1))) + end if + call RegUnpackPtr(RF, OutData%pxForce, LB, UB); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%pxForce)) then + OutData%C_obj%pxForce_Len = size(OutData%pxForce) + if (OutData%C_obj%pxForce_Len > 0) OutData%C_obj%pxForce = c_loc(OutData%pxForce(LB(1))) + end if + call RegUnpackPtr(RF, OutData%pyForce, LB, UB); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%pyForce)) then + OutData%C_obj%pyForce_Len = size(OutData%pyForce) + if (OutData%C_obj%pyForce_Len > 0) OutData%C_obj%pyForce = c_loc(OutData%pyForce(LB(1))) + end if + call RegUnpackPtr(RF, OutData%pzForce, LB, UB); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%pzForce)) then + OutData%C_obj%pzForce_Len = size(OutData%pzForce) + if (OutData%C_obj%pzForce_Len > 0) OutData%C_obj%pzForce = c_loc(OutData%pzForce(LB(1))) + end if + call RegUnpackPtr(RF, OutData%xdotForce, LB, UB); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%xdotForce)) then + OutData%C_obj%xdotForce_Len = size(OutData%xdotForce) + if (OutData%C_obj%xdotForce_Len > 0) OutData%C_obj%xdotForce = c_loc(OutData%xdotForce(LB(1))) + end if + call RegUnpackPtr(RF, OutData%ydotForce, LB, UB); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%ydotForce)) then + OutData%C_obj%ydotForce_Len = size(OutData%ydotForce) + if (OutData%C_obj%ydotForce_Len > 0) OutData%C_obj%ydotForce = c_loc(OutData%ydotForce(LB(1))) + end if + call RegUnpackPtr(RF, OutData%zdotForce, LB, UB); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%zdotForce)) then + OutData%C_obj%zdotForce_Len = size(OutData%zdotForce) + if (OutData%C_obj%zdotForce_Len > 0) OutData%C_obj%zdotForce = c_loc(OutData%zdotForce(LB(1))) + end if + call RegUnpackPtr(RF, OutData%pOrientation, LB, UB); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%pOrientation)) then + OutData%C_obj%pOrientation_Len = size(OutData%pOrientation) + if (OutData%C_obj%pOrientation_Len > 0) OutData%C_obj%pOrientation = c_loc(OutData%pOrientation(LB(1))) + end if + call RegUnpackPtr(RF, OutData%fx, LB, UB); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%fx)) then + OutData%C_obj%fx_Len = size(OutData%fx) + if (OutData%C_obj%fx_Len > 0) OutData%C_obj%fx = c_loc(OutData%fx(LB(1))) + end if + call RegUnpackPtr(RF, OutData%fy, LB, UB); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%fy)) then + OutData%C_obj%fy_Len = size(OutData%fy) + if (OutData%C_obj%fy_Len > 0) OutData%C_obj%fy = c_loc(OutData%fy(LB(1))) + end if + call RegUnpackPtr(RF, OutData%fz, LB, UB); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%fz)) then + OutData%C_obj%fz_Len = size(OutData%fz) + if (OutData%C_obj%fz_Len > 0) OutData%C_obj%fz = c_loc(OutData%fz(LB(1))) + end if + call RegUnpackPtr(RF, OutData%momentx, LB, UB); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%momentx)) then + OutData%C_obj%momentx_Len = size(OutData%momentx) + if (OutData%C_obj%momentx_Len > 0) OutData%C_obj%momentx = c_loc(OutData%momentx(LB(1))) + end if + call RegUnpackPtr(RF, OutData%momenty, LB, UB); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%momenty)) then + OutData%C_obj%momenty_Len = size(OutData%momenty) + if (OutData%C_obj%momenty_Len > 0) OutData%C_obj%momenty = c_loc(OutData%momenty(LB(1))) + end if + call RegUnpackPtr(RF, OutData%momentz, LB, UB); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%momentz)) then + OutData%C_obj%momentz_Len = size(OutData%momentz) + if (OutData%C_obj%momentz_Len > 0) OutData%C_obj%momentz = c_loc(OutData%momentz(LB(1))) + end if + call RegUnpackPtr(RF, OutData%forceNodesChord, LB, UB); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%forceNodesChord)) then + OutData%C_obj%forceNodesChord_Len = size(OutData%forceNodesChord) + if (OutData%C_obj%forceNodesChord_Len > 0) OutData%C_obj%forceNodesChord = c_loc(OutData%forceNodesChord(LB(1))) + end if +end subroutine + +SUBROUTINE ExtInfw_C2Fary_CopyInput(InputData, ErrStat, ErrMsg, SkipPointers) + TYPE(ExtInfw_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 + +SUBROUTINE ExtInfw_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) + TYPE(ExtInfw_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 + +subroutine ExtInfw_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(ExtInfw_OutputType), intent(in) :: SrcOutputData + type(ExtInfw_OutputType), intent(inout) :: DstOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'ExtInfw_CopyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (associated(SrcOutputData%u)) then + LB(1:1) = lbound(SrcOutputData%u) + UB(1:1) = ubound(SrcOutputData%u) + if (.not. associated(DstOutputData%u)) then + allocate(DstOutputData%u(LB(1):UB(1)), 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(LB(1))) + end if + DstOutputData%u = SrcOutputData%u + end if + if (associated(SrcOutputData%v)) then + LB(1:1) = lbound(SrcOutputData%v) + UB(1:1) = ubound(SrcOutputData%v) + if (.not. associated(DstOutputData%v)) then + allocate(DstOutputData%v(LB(1):UB(1)), 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(LB(1))) + end if + DstOutputData%v = SrcOutputData%v + end if + if (associated(SrcOutputData%w)) then + LB(1:1) = lbound(SrcOutputData%w) + UB(1:1) = ubound(SrcOutputData%w) + if (.not. associated(DstOutputData%w)) then + allocate(DstOutputData%w(LB(1):UB(1)), 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(LB(1))) + end if + DstOutputData%w = SrcOutputData%w + end if + if (allocated(SrcOutputData%WriteOutput)) then + LB(1:1) = lbound(SrcOutputData%WriteOutput) + UB(1:1) = ubound(SrcOutputData%WriteOutput) + if (.not. allocated(DstOutputData%WriteOutput)) then + allocate(DstOutputData%WriteOutput(LB(1):UB(1)), 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 + end if +end subroutine + +subroutine ExtInfw_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(ExtInfw_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'ExtInfw_DestroyOutput' + 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 + end if + if (associated(OutputData%v)) then + deallocate(OutputData%v) + OutputData%v => null() + OutputData%C_obj%v = c_null_ptr + OutputData%C_obj%v_Len = 0 + end if + if (associated(OutputData%w)) then + deallocate(OutputData%w) + OutputData%w => null() + OutputData%C_obj%w = c_null_ptr + OutputData%C_obj%w_Len = 0 + end if + if (allocated(OutputData%WriteOutput)) then + deallocate(OutputData%WriteOutput) + end if +end subroutine + +subroutine ExtInfw_PackOutput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(ExtInfw_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ExtInfw_PackOutput' + logical :: PtrInIndex + if (RF%ErrStat >= AbortErrLev) return + if (c_associated(InData%C_obj%object)) then + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + call RegPackPtr(RF, InData%u) + call RegPackPtr(RF, InData%v) + call RegPackPtr(RF, InData%w) + call RegPackAlloc(RF, InData%WriteOutput) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ExtInfw_UnPackOutput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(ExtInfw_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ExtInfw_UnPackOutput' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(B8Ki) :: PtrIdx + type(c_ptr) :: Ptr + if (RF%ErrStat /= ErrID_None) return + call RegUnpackPtr(RF, OutData%u, LB, UB); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%u)) then + OutData%C_obj%u_Len = size(OutData%u) + if (OutData%C_obj%u_Len > 0) OutData%C_obj%u = c_loc(OutData%u(LB(1))) + end if + call RegUnpackPtr(RF, OutData%v, LB, UB); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%v)) then + OutData%C_obj%v_Len = size(OutData%v) + if (OutData%C_obj%v_Len > 0) OutData%C_obj%v = c_loc(OutData%v(LB(1))) + end if + call RegUnpackPtr(RF, OutData%w, LB, UB); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%w)) then + OutData%C_obj%w_Len = size(OutData%w) + if (OutData%C_obj%w_Len > 0) OutData%C_obj%w = c_loc(OutData%w(LB(1))) + end if + call RegUnpackAlloc(RF, OutData%WriteOutput); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +SUBROUTINE ExtInfw_C2Fary_CopyOutput(OutputData, ErrStat, ErrMsg, SkipPointers) + TYPE(ExtInfw_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 + +SUBROUTINE ExtInfw_F2C_CopyOutput( OutputData, ErrStat, ErrMsg, SkipPointers ) + TYPE(ExtInfw_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 + +subroutine ExtInfw_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(ExtInfw_InputType), intent(in) :: u(:) ! Input at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Inputs + type(ExtInfw_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 = 'ExtInfw_Input_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(u)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(u)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(u) - 1 + select case (order) + case (0) + call ExtInfw_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call ExtInfw_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call ExtInfw_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(u) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE ExtInfw_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(ExtInfw_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 + TYPE(ExtInfw_InputType), INTENT(IN) :: u2 ! Input at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs + TYPE(ExtInfw_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 = 'ExtInfw_Input_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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 + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + IF (ASSOCIATED(u_out%pxVel) .AND. ASSOCIATED(u1%pxVel)) THEN + u_out%pxVel = a1*u1%pxVel + a2*u2%pxVel + END IF ! check if allocated + IF (ASSOCIATED(u_out%pyVel) .AND. ASSOCIATED(u1%pyVel)) THEN + u_out%pyVel = a1*u1%pyVel + a2*u2%pyVel + END IF ! check if allocated + IF (ASSOCIATED(u_out%pzVel) .AND. ASSOCIATED(u1%pzVel)) THEN + u_out%pzVel = a1*u1%pzVel + a2*u2%pzVel + END IF ! check if allocated + IF (ASSOCIATED(u_out%pxForce) .AND. ASSOCIATED(u1%pxForce)) THEN + u_out%pxForce = a1*u1%pxForce + a2*u2%pxForce + END IF ! check if allocated + IF (ASSOCIATED(u_out%pyForce) .AND. ASSOCIATED(u1%pyForce)) THEN + u_out%pyForce = a1*u1%pyForce + a2*u2%pyForce + END IF ! check if allocated + IF (ASSOCIATED(u_out%pzForce) .AND. ASSOCIATED(u1%pzForce)) THEN + u_out%pzForce = a1*u1%pzForce + a2*u2%pzForce + END IF ! check if allocated + IF (ASSOCIATED(u_out%xdotForce) .AND. ASSOCIATED(u1%xdotForce)) THEN + u_out%xdotForce = a1*u1%xdotForce + a2*u2%xdotForce + END IF ! check if allocated + IF (ASSOCIATED(u_out%ydotForce) .AND. ASSOCIATED(u1%ydotForce)) THEN + u_out%ydotForce = a1*u1%ydotForce + a2*u2%ydotForce + END IF ! check if allocated + IF (ASSOCIATED(u_out%zdotForce) .AND. ASSOCIATED(u1%zdotForce)) THEN + u_out%zdotForce = a1*u1%zdotForce + a2*u2%zdotForce + END IF ! check if allocated + IF (ASSOCIATED(u_out%pOrientation) .AND. ASSOCIATED(u1%pOrientation)) THEN + u_out%pOrientation = a1*u1%pOrientation + a2*u2%pOrientation + END IF ! check if allocated + IF (ASSOCIATED(u_out%fx) .AND. ASSOCIATED(u1%fx)) THEN + u_out%fx = a1*u1%fx + a2*u2%fx + END IF ! check if allocated + IF (ASSOCIATED(u_out%fy) .AND. ASSOCIATED(u1%fy)) THEN + u_out%fy = a1*u1%fy + a2*u2%fy + END IF ! check if allocated + IF (ASSOCIATED(u_out%fz) .AND. ASSOCIATED(u1%fz)) THEN + u_out%fz = a1*u1%fz + a2*u2%fz + END IF ! check if allocated + IF (ASSOCIATED(u_out%momentx) .AND. ASSOCIATED(u1%momentx)) THEN + u_out%momentx = a1*u1%momentx + a2*u2%momentx + END IF ! check if allocated + IF (ASSOCIATED(u_out%momenty) .AND. ASSOCIATED(u1%momenty)) THEN + u_out%momenty = a1*u1%momenty + a2*u2%momenty + END IF ! check if allocated + IF (ASSOCIATED(u_out%momentz) .AND. ASSOCIATED(u1%momentz)) THEN + u_out%momentz = a1*u1%momentz + a2*u2%momentz + END IF ! check if allocated + IF (ASSOCIATED(u_out%forceNodesChord) .AND. ASSOCIATED(u1%forceNodesChord)) THEN + u_out%forceNodesChord = a1*u1%forceNodesChord + a2*u2%forceNodesChord + END IF ! check if allocated +END SUBROUTINE + +SUBROUTINE ExtInfw_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(ExtInfw_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 > t3 + TYPE(ExtInfw_InputType), INTENT(IN) :: u2 ! Input at t2 > t3 + TYPE(ExtInfw_InputType), INTENT(IN) :: u3 ! Input at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs + TYPE(ExtInfw_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) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'ExtInfw_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 + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + IF (ASSOCIATED(u_out%pxVel) .AND. ASSOCIATED(u1%pxVel)) THEN + u_out%pxVel = a1*u1%pxVel + a2*u2%pxVel + a3*u3%pxVel + END IF ! check if allocated + IF (ASSOCIATED(u_out%pyVel) .AND. ASSOCIATED(u1%pyVel)) THEN + u_out%pyVel = a1*u1%pyVel + a2*u2%pyVel + a3*u3%pyVel + END IF ! check if allocated + IF (ASSOCIATED(u_out%pzVel) .AND. ASSOCIATED(u1%pzVel)) THEN + u_out%pzVel = a1*u1%pzVel + a2*u2%pzVel + a3*u3%pzVel + END IF ! check if allocated + IF (ASSOCIATED(u_out%pxForce) .AND. ASSOCIATED(u1%pxForce)) THEN + u_out%pxForce = a1*u1%pxForce + a2*u2%pxForce + a3*u3%pxForce + END IF ! check if allocated + IF (ASSOCIATED(u_out%pyForce) .AND. ASSOCIATED(u1%pyForce)) THEN + u_out%pyForce = a1*u1%pyForce + a2*u2%pyForce + a3*u3%pyForce + END IF ! check if allocated + IF (ASSOCIATED(u_out%pzForce) .AND. ASSOCIATED(u1%pzForce)) THEN + u_out%pzForce = a1*u1%pzForce + a2*u2%pzForce + a3*u3%pzForce + END IF ! check if allocated + IF (ASSOCIATED(u_out%xdotForce) .AND. ASSOCIATED(u1%xdotForce)) THEN + u_out%xdotForce = a1*u1%xdotForce + a2*u2%xdotForce + a3*u3%xdotForce + END IF ! check if allocated + IF (ASSOCIATED(u_out%ydotForce) .AND. ASSOCIATED(u1%ydotForce)) THEN + u_out%ydotForce = a1*u1%ydotForce + a2*u2%ydotForce + a3*u3%ydotForce + END IF ! check if allocated + IF (ASSOCIATED(u_out%zdotForce) .AND. ASSOCIATED(u1%zdotForce)) THEN + u_out%zdotForce = a1*u1%zdotForce + a2*u2%zdotForce + a3*u3%zdotForce + END IF ! check if allocated + IF (ASSOCIATED(u_out%pOrientation) .AND. ASSOCIATED(u1%pOrientation)) THEN + u_out%pOrientation = a1*u1%pOrientation + a2*u2%pOrientation + a3*u3%pOrientation + END IF ! check if allocated + IF (ASSOCIATED(u_out%fx) .AND. ASSOCIATED(u1%fx)) THEN + u_out%fx = a1*u1%fx + a2*u2%fx + a3*u3%fx + END IF ! check if allocated + IF (ASSOCIATED(u_out%fy) .AND. ASSOCIATED(u1%fy)) THEN + u_out%fy = a1*u1%fy + a2*u2%fy + a3*u3%fy + END IF ! check if allocated + IF (ASSOCIATED(u_out%fz) .AND. ASSOCIATED(u1%fz)) THEN + u_out%fz = a1*u1%fz + a2*u2%fz + a3*u3%fz + END IF ! check if allocated + IF (ASSOCIATED(u_out%momentx) .AND. ASSOCIATED(u1%momentx)) THEN + u_out%momentx = a1*u1%momentx + a2*u2%momentx + a3*u3%momentx + END IF ! check if allocated + IF (ASSOCIATED(u_out%momenty) .AND. ASSOCIATED(u1%momenty)) THEN + u_out%momenty = a1*u1%momenty + a2*u2%momenty + a3*u3%momenty + END IF ! check if allocated + IF (ASSOCIATED(u_out%momentz) .AND. ASSOCIATED(u1%momentz)) THEN + u_out%momentz = a1*u1%momentz + a2*u2%momentz + a3*u3%momentz + END IF ! check if allocated + IF (ASSOCIATED(u_out%forceNodesChord) .AND. ASSOCIATED(u1%forceNodesChord)) THEN + u_out%forceNodesChord = a1*u1%forceNodesChord + a2*u2%forceNodesChord + a3*u3%forceNodesChord + END IF ! check if allocated +END SUBROUTINE + +subroutine ExtInfw_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(ExtInfw_OutputType), intent(in) :: y(:) ! Output at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Outputs + type(ExtInfw_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 = 'ExtInfw_Output_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(y)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(y)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(y) - 1 + select case (order) + case (0) + call ExtInfw_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call ExtInfw_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call ExtInfw_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(y) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE ExtInfw_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(ExtInfw_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 + TYPE(ExtInfw_OutputType), INTENT(IN) :: y2 ! Output at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs + TYPE(ExtInfw_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 = 'ExtInfw_Output_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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 + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + IF (ASSOCIATED(y_out%u) .AND. ASSOCIATED(y1%u)) THEN + y_out%u = a1*y1%u + a2*y2%u + END IF ! check if allocated + IF (ASSOCIATED(y_out%v) .AND. ASSOCIATED(y1%v)) THEN + y_out%v = a1*y1%v + a2*y2%v + END IF ! check if allocated + IF (ASSOCIATED(y_out%w) .AND. ASSOCIATED(y1%w)) THEN + y_out%w = a1*y1%w + a2*y2%w + END IF ! check if allocated + IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + END IF ! check if allocated +END SUBROUTINE + +SUBROUTINE ExtInfw_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(ExtInfw_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 > t3 + TYPE(ExtInfw_OutputType), INTENT(IN) :: y2 ! Output at t2 > t3 + TYPE(ExtInfw_OutputType), INTENT(IN) :: y3 ! Output at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs + TYPE(ExtInfw_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) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'ExtInfw_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 + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + IF (ASSOCIATED(y_out%u) .AND. ASSOCIATED(y1%u)) THEN + y_out%u = a1*y1%u + a2*y2%u + a3*y3%u + END IF ! check if allocated + IF (ASSOCIATED(y_out%v) .AND. ASSOCIATED(y1%v)) THEN + y_out%v = a1*y1%v + a2*y2%v + a3*y3%v + END IF ! check if allocated + IF (ASSOCIATED(y_out%w) .AND. ASSOCIATED(y1%w)) THEN + y_out%w = a1*y1%w + a2*y2%w + a3*y3%w + END IF ! check if allocated + IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + a3*y3%WriteOutput + END IF ! check if allocated +END SUBROUTINE +END MODULE ExternalInflow_Types +!ENDOFREGISTRYGENERATEDFILE diff --git a/modules/externalinflow/src/ExternalInflow_Types.h b/modules/externalinflow/src/ExternalInflow_Types.h new file mode 100644 index 0000000000..90bbbb5f09 --- /dev/null +++ b/modules/externalinflow/src/ExternalInflow_Types.h @@ -0,0 +1,100 @@ +//!STARTOFREGISTRYGENERATEDFILE 'ExternalInflow_Types.h' +//! +//! WARNING This file is generated automatically by the FAST registry. +//! Do not edit. Your changes to this file will be lost. +//! + +#ifndef _ExternalInflow_TYPES_H +#define _ExternalInflow_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 ExtInfw_InitInputType { + void *object; + int NumActForcePtsBlade; + int NumActForcePtsTower; + float *StructBldRNodes; int StructBldRNodes_Len; + float *StructTwrHNodes; int StructTwrHNodes_Len; + float BladeLength; + float TowerHeight; + float TowerBaseHeight; + int NodeClusterType; +} ExtInfw_InitInputType_t; + +typedef struct ExtInfw_InitOutputType { + void *object; + char *WriteOutputHdr; int WriteOutputHdr_Len; + char *WriteOutputUnt; int WriteOutputUnt_Len; +} ExtInfw_InitOutputType_t; + +typedef struct ExtInfw_MiscVarType { + void *object; +} ExtInfw_MiscVarType_t; + +typedef struct ExtInfw_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; + int NodeClusterType; +} ExtInfw_ParameterType_t; + +typedef struct ExtInfw_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; +} ExtInfw_InputType_t; + +typedef struct ExtInfw_OutputType { + void *object; + float *u; int u_Len; + float *v; int v_Len; + float *w; int w_Len; + float *WriteOutput; int WriteOutput_Len; +} ExtInfw_OutputType_t; + +typedef struct ExtInfw_UserData { + ExtInfw_InitInputType_t ExtInfw_InitInput; + ExtInfw_InitOutputType_t ExtInfw_InitOutput; + ExtInfw_MiscVarType_t ExtInfw_Misc; + ExtInfw_ParameterType_t ExtInfw_Param; + ExtInfw_InputType_t ExtInfw_Input; + ExtInfw_OutputType_t ExtInfw_Output; +} ExtInfw_t; + +#endif // _ExternalInflow_TYPES_H + +//!ENDOFREGISTRYGENERATEDFILE diff --git a/modules/aerodyn14/CMakeLists.txt b/modules/extloads/CMakeLists.txt similarity index 52% rename from modules/aerodyn14/CMakeLists.txt rename to modules/extloads/CMakeLists.txt index 5c67692e24..b649f69557 100644 --- a/modules/aerodyn14/CMakeLists.txt +++ b/modules/extloads/CMakeLists.txt @@ -15,33 +15,25 @@ # if (GENERATE_TYPES) - generate_f90_types(src/Registry-AD14.txt ${CMAKE_CURRENT_LIST_DIR}/src/AeroDyn14_Types.f90) - generate_f90_types(src/Registry-DWM.txt ${CMAKE_CURRENT_LIST_DIR}/src/DWM_Types.f90) + generate_f90_types(src/ExtLoadsDX_Registry.txt ${CMAKE_CURRENT_LIST_DIR}/src/ExtLoadsDX_Types.f90 -ccode) + generate_f90_types(src/ExtLoads_Registry.txt ${CMAKE_CURRENT_LIST_DIR}/src/ExtLoads_Types.f90) endif() -add_library(aerodyn14lib - src/AeroDyn14.f90 - src/AeroSubs.f90 - src/DWM.f90 - src/DWM_Wake_Sub_ver2.f90 - src/GenSubs.f90 - src/AeroDyn14_Types.f90 - src/DWM_Types.f90 +add_library(extloadslib STATIC + src/ExtLoads.f90 + src/ExtLoads_Types.f90 + src/ExtLoadsDX_Types.f90 ) -target_link_libraries(aerodyn14lib ifwlib nwtclibs) - -# set(DWM_SOURCES -# src/DWM_driver_wind_farm_mod.f90 -# src/DWM_driver_wind_farm_sub.f90 -# src/DWM_driver_wind_farm.f90 -# ) - -# add_executable(dwm_driver_wind_farm ${DWM_SOURCES}) -# target_link_libraries(dwm_driver_wind_farm aerodyn14lib versioninfolib) +target_include_directories(extloadslib PUBLIC + $ +) +target_link_libraries(extloadslib beamdynlib nwtclibs versioninfolib) +set_target_properties(extloadslib PROPERTIES PUBLIC_HEADER "src/ExtLoadsDX_Types.h") -install(TARGETS aerodyn14lib +install(TARGETS extloadslib EXPORT "${CMAKE_PROJECT_NAME}Libraries" RUNTIME DESTINATION bin LIBRARY DESTINATION lib ARCHIVE DESTINATION lib + PUBLIC_HEADER DESTINATION include ) diff --git a/modules/extloads/src/ExtLoads.f90 b/modules/extloads/src/ExtLoads.f90 new file mode 100644 index 0000000000..d92cba0389 --- /dev/null +++ b/modules/extloads/src/ExtLoads.f90 @@ -0,0 +1,919 @@ +!********************************************************************************************************************************** +! LICENSING +! Copyright (C) 2015-2016 National Renewable Energy Laboratory +! +! This file is part of ExtLoads. +! +! 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$ +!********************************************************************************************************************************** +!> ExtLoads is a time-domain loads module for horizontal-axis wind turbines. +module ExtLoads + + use NWTC_Library + use ExtLoads_Types + use InflowWind_IO_Types + use InflowWind_IO + + implicit none + + private + + ! ..... Public Subroutines ................................................................................................... + + public :: ExtLd_Init ! Initialization routine + public :: ExtLd_End ! Ending routine (includes clean up) + public :: ExtLd_UpdateStates ! Loose coupling routine for solving for constraint states, integrating + ! continuous states, and updating discrete states + public :: ExtLd_CalcOutput ! Routine for computing outputs + public :: ExtLd_ConvertOpDataForOpenFAST ! Routine to convert Output data for OpenFAST + public :: ExtLd_ConvertInpDataForExtProg ! Routine to convert Input data for external programs + +contains +!---------------------------------------------------------------------------------------------------------------------------------- +!> This subroutine sets the initialization output data structure, which contains data to be returned to the calling program (e.g., +!! FAST) +subroutine ExtLd_SetInitOut(p, InitOut, errStat, errMsg) + + type(ExtLd_InitOutputType), intent(inout) :: InitOut ! output data + type(ExtLd_ParameterType), intent(in ) :: p ! Parameters + integer(IntKi), intent( out) :: errStat ! Error status of the operation + character(*), intent( out) :: errMsg ! Error message if ErrStat /= ErrID_None + + + ! Local variables + integer(intKi) :: ErrStat2 ! temporary Error status + character(ErrMsgLen) :: ErrMsg2 ! temporary Error message + character(*), parameter :: RoutineName = 'ExtLd_SetInitOut' + + + + integer(IntKi) :: i, j, k, f + integer(IntKi) :: NumCoords +#ifdef DBG_OUTS + integer(IntKi) :: m + character(5) ::chanPrefix +#endif + ! Initialize variables for this routine + + errStat = ErrID_None + errMsg = "" + +end subroutine ExtLd_SetInitOut + +!---------------------------------------------------------------------------------------------------------------------------------- +!> 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 ExtLd_Init( InitInp, u, xd, p, y, m, interval, InitOut, ErrStat, ErrMsg ) +!.................................................................................................................................. + + type(ExtLd_InitInputType), intent(in ) :: InitInp !< Input data for initialization routine + type(ExtLd_InputType), intent( out) :: u !< An initial guess for the input; input mesh must be defined + type(ExtLd_DiscreteStateType), intent( out) :: xd !< An initial guess for the discrete states + type(ExtLd_OutputType), intent( out) :: y !< Initial system outputs (outputs are not calculated; + type(ExtLd_MiscVarType), intent( out) :: m !< Miscellaneous variables + type(ExtLd_ParameterType), intent( out) :: p !< Parameter variables + !! only the output mesh is initialized) + real(DbKi), intent(inout) :: interval !< Coupling interval in seconds: the rate that + !! (1) ExtLd_UpdateStates() is called in loose coupling & + !! (2) ExtLd_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(ExtLd_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 + type(Points_InitInputType) :: Points_InitInput + integer(IntKi) :: errStat2 ! temporary error status of the operation + character(ErrMsgLen) :: errMsg2 ! temporary error message + + character(*), parameter :: RoutineName = 'ExtLd_Init' + + + ! Initialize variables for this routine + + errStat = ErrID_None + errMsg = "" + + ! Initialize the NWTC Subroutine Library + + ! Set parameters here + p%NumBlds = InitInp%NumBlades + call AllocAry(p%NumBldNds, p%NumBlds, 'NumBldNds', ErrStat2,ErrMsg2) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + if (ErrStat >= AbortErrLev) return + p%NumBldNds(:) = InitInp%NumBldNodes(:) + p%nTotBldNds = sum(p%NumBldNds(:)) + p%NumTwrNds = InitInp%NumTwrNds + p%TwrAero = .true. + + p%az_blend_mean = InitInp%az_blend_mean + p%az_blend_delta = InitInp%az_blend_delta + + !............................................................................................ + ! Define and initialize inputs here + !............................................................................................ + + write(*,*) 'Initializing U ' + + call Init_u( u, p, InitInp, errStat2, errMsg2 ) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + if (ErrStat >= AbortErrLev) return + + + ! Initialize discrete states + m%az = 0.0 + m%phi_cfd = 0.0 + + write(*,*) 'Initializing y ' + + !............................................................................................ + ! Define outputs here + !............................................................................................ + call Init_y(y, u, m, p, errStat2, errMsg2) ! do this after input meshes have been initialized + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + if (ErrStat >= AbortErrLev) return + + + !............................................................................................ + ! Define initialization output here + !............................................................................................ + call ExtLd_SetInitOut(p, InitOut, errStat2, errMsg2) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + +contains + logical function Failed() + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + Failed = ErrStat >= AbortErrLev + end function Failed + +end subroutine ExtLd_Init +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine initializes ExtLoads meshes and output array variables for use during the simulation. +subroutine Init_y(y, u, m, p, errStat, errMsg) + type(ExtLd_OutputType), intent( out) :: y !< Module outputs + type(ExtLd_InputType), intent(inout) :: u !< Module inputs -- intent(out) because of mesh sibling copy + type(ExtLd_MiscVarType), intent(inout) :: m !< Module misc var + type(ExtLd_ParameterType), intent(in ) :: p !< Parameters + integer(IntKi), intent( out) :: errStat !< Error status of the operation + character(*), intent( out) :: errMsg !< Error message if ErrStat /= ErrID_None + + + ! Local variables + integer(intKi) :: k ! loop counter for blades + integer(intKi) :: ErrStat2 ! temporary Error status + character(ErrMsgLen) :: ErrMsg2 ! temporary Error message + character(*), parameter :: RoutineName = 'Init_y' + + ! Initialize variables for this routine + + errStat = ErrID_None + errMsg = "" + + if (p%TwrAero) then + + call MeshCopy ( SrcMesh = u%TowerMotion & + , DestMesh = y%TowerLoad & + , CtrlCode = MESH_SIBLING & + , IOS = COMPONENT_OUTPUT & + , force = .TRUE. & + , moment = .TRUE. & + , ErrStat = ErrStat2 & + , ErrMess = ErrMsg2 ) + + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + if (ErrStat >= AbortErrLev) RETURN + + call MeshCopy ( SrcMesh = u%TowerMotion & + , DestMesh = y%TowerLoadAD & + , CtrlCode = MESH_COUSIN & + , IOS = COMPONENT_OUTPUT & + , force = .TRUE. & + , moment = .TRUE. & + , ErrStat = ErrStat2 & + , ErrMess = ErrMsg2 ) + + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + if (ErrStat >= AbortErrLev) RETURN + + !call MeshCommit(y%TowerLoadAD, errStat2, errMsg2 ) + !call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) + + !y%TowerLoad%force = 0.0_ReKi ! shouldn't have to initialize this + !y%TowerLoad%moment= 0.0_ReKi ! shouldn't have to initialize this + else + y%TowerLoad%nnodes = 0 + y%TowerLoadAD%nnodes = 0 + end if + + allocate( y%BladeLoad(p%NumBlds), stat=ErrStat2 ) + if (errStat2 /= 0) then + call SetErrStat( ErrID_Fatal, 'Error allocating y%BladeLoad.', ErrStat, ErrMsg, RoutineName ) + return + end if + + allocate( y%BladeLoadAD(p%NumBlds), stat=ErrStat2 ) + if (errStat2 /= 0) then + call SetErrStat( ErrID_Fatal, 'Error allocating y%BladeLoad.', ErrStat, ErrMsg, RoutineName ) + return + end if + + do k = 1, p%NumBlds + + call MeshCopy ( SrcMesh = u%BladeMotion(k) & + , DestMesh = y%BladeLoad(k) & + , CtrlCode = MESH_SIBLING & + , IOS = COMPONENT_OUTPUT & + , force = .TRUE. & + , moment = .TRUE. & + , ErrStat = ErrStat2 & + , ErrMess = ErrMsg2 ) + + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + call MeshCopy ( SrcMesh = u%BladeMotion(k) & + , DestMesh = y%BladeLoadAD(k) & + , CtrlCode = MESH_COUSIN & + , IOS = COMPONENT_OUTPUT & + , force = .TRUE. & + , moment = .TRUE. & + , ErrStat = ErrStat2 & + , ErrMess = ErrMsg2 ) + + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + !call MeshCommit(y%BladeLoadAD(k), errStat2, errMsg2 ) + !call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) + + + end do + + CALL AllocPAry( y%DX_y%twrLd, p%NumTwrNds*6, 'twrLd', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AllocPAry( y%DX_y%bldLd, p%nTotBldNds*6, 'bldLd', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ! make sure the C versions are synced with these arrays + y%DX_y%c_obj%twrLd_Len = p%NumTwrNds*6; y%DX_y%c_obj%twrLd = C_LOC( y%DX_y%twrLd(1) ) + y%DX_y%c_obj%bldLd_Len = p%nTotBldNds*6; y%DX_y%c_obj%bldLd = C_LOC( y%DX_y%bldLd(1) ) + + call ExtLd_ConvertOpDataForOpenFAST(y, u, m, p, ErrStat2, ErrMsg2 ) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + +end subroutine Init_y +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine initializes ExtLoads meshes and input array variables for use during the simulation. +subroutine Init_u( u, p, InitInp, errStat, errMsg ) +!.................................................................................................................................. + + USE BeamDyn_IO, ONLY: BD_CrvExtractCrv + + type(ExtLd_InputType), intent( out) :: u !< Input data + type(ExtLd_ParameterType), intent(inout) :: p !< Parameters (inout so can update DX_p) + type(ExtLd_InitInputType), intent(in ) :: InitInp !< Input data for ExtLd initialization routine + integer(IntKi), intent( out) :: errStat !< Error status of the operation + character(*), intent( out) :: errMsg !< Error message if ErrStat /= ErrID_None + + + ! Local variables + real(reKi) :: position(3) ! node reference position + real(reKi) :: positionL(3) ! node local position + real(R8Ki) :: theta(3) ! Euler angles + real(R8Ki) :: orientation(3,3) ! node reference orientation + real(R8Ki) :: orientationL(3,3) ! node local orientation + + real(R8Ki) :: wm_crv(3) ! Wiener-Milenkovic parameters + integer(IntKi) :: j ! counter for nodes + integer(IntKi) :: jTot ! counter for blade nodes + integer(IntKi) :: k ! counter for blades + + integer(intKi) :: ErrStat2 ! temporary Error status + character(ErrMsgLen) :: ErrMsg2 ! temporary Error message + character(*), parameter :: RoutineName = 'Init_u' + + ! Initialize variables for this routine + + ErrStat = ErrID_None + ErrMsg = "" + + + u%az = 0.0 + ! Meshes for motion inputs (ElastoDyn and/or BeamDyn) + !................ + ! tower + !................ + if (p%NumTwrNds > 0) then + + call MeshCreate ( BlankMesh = u%TowerMotion & + ,IOS = COMPONENT_INPUT & + ,Nnodes = p%NumTwrNds & + ,ErrStat = ErrStat2 & + ,ErrMess = ErrMsg2 & + ,Orientation = .true. & + ,TranslationDisp = .true. & + ,TranslationVel = .true. & + ,RotationVel = .true. & + ) + call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) + + if (errStat >= AbortErrLev) return + + ! set node initial position/orientation + position = 0.0_ReKi + do j=1,p%NumTwrNds + position(:) = InitInp%TwrPos(:,j) + + call MeshPositionNode(u%TowerMotion, j, position, errStat2, errMsg2) ! orientation is identity by default + call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) + end do !j + + ! create point elements + do j=1,p%NumTwrNds + call MeshConstructElement( u%TowerMotion, ELEMENT_POINT, errStat2, errMsg2, p1=j ) + call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) + end do !j + + call MeshCommit(u%TowerMotion, errStat2, errMsg2 ) + call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) + + if (errStat >= AbortErrLev) return + + + u%TowerMotion%Orientation = u%TowerMotion%RefOrientation + u%TowerMotion%TranslationDisp = 0.0_R8Ki + u%TowerMotion%TranslationVel = 0.0_ReKi + u%TowerMotion%RotationVel = 0.0_ReKi + + end if ! we compute tower loads + + !................ + ! hub + !................ + + call MeshCreate ( BlankMesh = u%HubMotion & + ,IOS = COMPONENT_INPUT & + ,Nnodes = 1 & + ,ErrStat = ErrStat2 & + ,ErrMess = ErrMsg2 & + ,Orientation = .true. & + ,TranslationDisp = .true. & + ,TranslationVel = .true. & + ,RotationVel = .true. & + ) + call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) + + if (errStat >= AbortErrLev) return + + call MeshPositionNode(u%HubMotion, 1, InitInp%HubPos, errStat2, errMsg2, InitInp%HubOrient) + call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) + + call MeshConstructElement( u%HubMotion, ELEMENT_POINT, errStat2, errMsg2, p1=1 ) + call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) + + call MeshCommit(u%HubMotion, errStat2, errMsg2 ) + call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) + + if (errStat >= AbortErrLev) return + + + u%HubMotion%Orientation = u%HubMotion%RefOrientation + u%HubMotion%TranslationDisp = 0.0_R8Ki + u%HubMotion%TranslationVel = 0.0_R8Ki + u%HubMotion%RotationVel = 0.0_R8Ki + + !................ + ! nacelle + !................ + + call MeshCreate ( BlankMesh = u%NacelleMotion & + ,IOS = COMPONENT_INPUT & + ,Nnodes = 1 & + ,ErrStat = ErrStat2 & + ,ErrMess = ErrMsg2 & + ,Orientation = .true. & + ,TranslationDisp = .true. & + ,TranslationVel = .true. & + ,RotationVel = .true. & + ) + call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) + + if (errStat >= AbortErrLev) return + + call MeshPositionNode(u%NacelleMotion, 1, InitInp%NacellePos, errStat2, errMsg2, InitInp%NacelleOrient) + call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) + + call MeshConstructElement( u%NacelleMotion, ELEMENT_POINT, errStat2, errMsg2, p1=1 ) + call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) + + call MeshCommit(u%NacelleMotion, errStat2, errMsg2 ) + call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) + + if (errStat >= AbortErrLev) return + + + u%NacelleMotion%Orientation = u%NacelleMotion%RefOrientation + u%NacelleMotion%TranslationDisp = 0.0_R8Ki + u%NacelleMotion%TranslationVel = 0.0_R8Ki + u%NacelleMotion%RotationVel = 0.0_R8Ki + + !................ + ! blades + !................ + + allocate( u%BladeRootMotion(p%NumBlds), STAT = ErrStat2 ) + if (ErrStat2 /= 0) then + call SetErrStat( ErrID_Fatal, 'Error allocating u%BladeRootMotion array.', ErrStat, ErrMsg, RoutineName ) + return + end if + + allocate( u%BladeMotion(p%NumBlds), STAT = ErrStat2 ) + if (ErrStat2 /= 0) then + call SetErrStat( ErrID_Fatal, 'Error allocating u%BladeMotion array.', ErrStat, ErrMsg, RoutineName ) + return + end if + + do k=1,p%NumBlds + + call MeshCreate ( BlankMesh = u%BladeRootMotion(k) & + ,IOS = COMPONENT_INPUT & + ,Nnodes = 1 & + ,ErrStat = ErrStat2 & + ,ErrMess = ErrMsg2 & + ,Orientation = .true. & + ,TranslationDisp = .true. & + ,TranslationVel = .true. & + ,RotationVel = .true. & + ) + call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) + + if (errStat >= AbortErrLev) return + + call MeshPositionNode(u%BladeRootMotion(k), 1, InitInp%BldRootPos(:,k), errStat2, errMsg2, InitInp%BldRootOrient(:,:,k)) + call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) + + call MeshConstructElement( u%BladeRootMotion(k), ELEMENT_POINT, errStat2, errMsg2, p1=1 ) + call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) + + call MeshCommit(u%BladeRootMotion(k), errStat2, errMsg2 ) + call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) + + if (errStat >= AbortErrLev) return + + u%BladeRootMotion(k)%Orientation = u%BladeRootMotion(k)%RefOrientation + u%BladeRootMotion(k)%TranslationDisp = 0.0_R8Ki + u%BladeRootMotion(k)%TranslationVel = 0.0_R8Ki + u%BladeRootMotion(k)%RotationVel = 0.0_R8Ki + + call MeshCreate ( BlankMesh = u%BladeMotion(k) & + ,IOS = COMPONENT_INPUT & + ,Nnodes = InitInp%NumBldNodes(k) & + ,ErrStat = ErrStat2 & + ,ErrMess = ErrMsg2 & + ,Orientation = .true. & + ,TranslationDisp = .true. & + ,TranslationVel = .true. & + ,RotationVel = .true. & + ) + call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) + + if (errStat >= AbortErrLev) return + + + do j=1,InitInp%NumBldNodes(k) + + ! reference position of the jth node in the kth blade: + position(:) = InitInp%BldPos(:,j,k) + + ! reference orientation of the jth node in the kth blade + orientation(:,:) = InitInp%BldOrient(:,:,j,k) + + + call MeshPositionNode(u%BladeMotion(k), j, position, errStat2, errMsg2, orientation) + call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) + + end do ! j=blade nodes + + ! create point elements + do j=1,InitInp%NumBldNodes(k) + call MeshConstructElement( u%BladeMotion(k), ELEMENT_POINT, errStat2, errMsg2, p1=j ) + call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) + end do !j + + call MeshCommit(u%BladeMotion(k), errStat2, errMsg2 ) + call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) + + if (errStat >= AbortErrLev) return + + u%BladeMotion(k)%Orientation = u%BladeMotion(k)%RefOrientation + u%BladeMotion(k)%TranslationDisp = 0.0_R8Ki + u%BladeMotion(k)%TranslationVel = 0.0_R8Ki + u%BladeMotion(k)%RotationVel = 0.0_R8Ki + + end do !k=numBlades + + ! Set the parameters first + CALL AllocPAry( p%DX_p%nTowerNodes, 1, 'nTowerNodes', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + p%DX_p%c_obj%nTowerNodes_Len = 1; p%DX_p%c_obj%nTowerNodes = C_LOC( p%DX_p%nTowerNodes(1) ) + p%DX_p%nTowerNodes(1) = p%NumTwrNds + CALL AllocPAry( p%DX_p%nBlades, 1, 'nBlades', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + p%DX_p%c_obj%nBlades_Len = 1; p%DX_p%c_obj%nBlades = C_LOC( p%DX_p%nBlades(1) ) + p%DX_p%nBlades(1) = p%NumBlds + CALL AllocPAry( p%DX_p%nBladeNodes, p%NumBlds, 'nBladeNodes', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + p%DX_p%c_obj%nBladeNodes_Len = p%NumBlds; p%DX_p%c_obj%nBladeNodes = C_LOC( p%DX_p%nBladeNodes(1) ) + p%DX_p%nBladeNodes(:) = p%NumBldNds(:) + + ! Set the reference positions next + CALL AllocPAry( p%DX_p%twrRefPos, p%NumTwrNds*6, 'twrRefPos', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AllocPAry( p%DX_p%bldRefPos, p%nTotBldNds*6, 'bldRefPos', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AllocPAry( p%DX_p%hubRefPos, 6, 'hubRefPos', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AllocPAry( p%DX_p%nacRefPos, 6, 'nacRefPos', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AllocPAry (p%DX_p%bldRootRefPos, p%NumBlds*6, 'bldRootRefPos', ErrStat2, ErrMsg2); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ! make sure the C versions are synced with these arrays + p%DX_p%c_obj%twrRefPos_Len = p%NumTwrNds*6; p%DX_p%c_obj%twrRefPos = C_LOC( p%DX_p%twrRefPos(1) ) + p%DX_p%c_obj%bldRefPos_Len = p%nTotBldNds*6; p%DX_p%c_obj%bldRefPos = C_LOC( p%DX_p%bldRefPos(1) ) + p%DX_p%c_obj%hubRefPos_Len = 6; p%DX_p%c_obj%hubRefPos = C_LOC( p%DX_p%hubRefPos(1) ) + p%DX_p%c_obj%nacRefPos_Len = 6; p%DX_p%c_obj%nacRefPos = C_LOC( p%DX_p%nacRefPos(1) ) + p%DX_p%c_obj%bldRootRefPos_Len = p%NumBlds*6; p%DX_p%c_obj%bldRootRefPos = C_LOC( p%DX_p%bldRootRefPos(1) ) + + if (p%TwrAero) then + do j=1,p%NumTwrNds + call BD_CrvExtractCrv(u%TowerMotion%RefOrientation(:,:,j), wm_crv, ErrStat2, ErrMsg2) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + p%DX_p%twrRefPos((j-1)*6+1:(j-1)*6+3) = u%TowerMotion%Position(:,j) + p%DX_p%twrRefPos((j-1)*6+4:(j-1)*6+6) = wm_crv + end do + end if + + jTot = 1 + do k=1,p%NumBlds + do j=1,p%NumBldNds(k) + call BD_CrvExtractCrv(u%BladeMotion(k)%RefOrientation(:,:,j), wm_crv, ErrStat2, ErrMsg2) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + p%DX_p%bldRefPos((jTot-1)*6+1:(jTot-1)*6+3) = u%BladeMotion(k)%Position(:,j) + p%DX_p%bldRefPos((jTot-1)*6+4:(jTot-1)*6+6) = wm_crv + jTot = jTot+1 + end do + end do + + call BD_CrvExtractCrv(u%HubMotion%RefOrientation(:,:,1), wm_crv, ErrStat2, ErrMsg2) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + p%DX_p%hubRefPos(1:3) = u%HubMotion%Position(:,1) + p%DX_p%hubRefPos(4:6) = wm_crv + + call BD_CrvExtractCrv(u%NacelleMotion%RefOrientation(:,:,1), wm_crv, ErrStat2, ErrMsg2) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + p%DX_p%nacRefPos(1:3) = u%NacelleMotion%Position(:,1) + p%DX_p%nacRefPos(4:6) = wm_crv + + do k=1,p%NumBlds + call BD_CrvExtractCrv(u%BladeRootMotion(k)%RefOrientation(:,:,1), wm_crv, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + p%DX_p%bldRootRefPos((k-1)*6+1:(k-1)*6+3) = u%BladeRootMotion(k)%Position(:,1) + p%DX_p%bldRootRefPos((k-1)*6+4:(k-1)*6+6) = wm_crv + end do + + + ! Now the displacements + CALL AllocPAry( u%DX_u%twrDef, p%NumTwrNds*12, 'twrDef', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AllocPAry( u%DX_u%bldDef, p%nTotBldNds*12, 'bldDef', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AllocPAry( u%DX_u%hubDef, 12, 'hubDef', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AllocPAry( u%DX_u%nacDef, 12, 'nacDef', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AllocPAry( u%DX_u%bldRootDef, p%NumBlds*12, 'bldRootDef', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ! make sure the C versions are synced with these arrays + u%DX_u%c_obj%twrDef_Len = p%NumTwrNds*12; u%DX_u%c_obj%twrDef = C_LOC( u%DX_u%twrDef(1) ) + u%DX_u%c_obj%bldDef_Len = p%nTotBldNds*12; u%DX_u%c_obj%bldDef = C_LOC( u%DX_u%bldDef(1) ) + u%DX_u%c_obj%hubDef_Len = 12; u%DX_u%c_obj%hubDef = C_LOC( u%DX_u%hubDef(1) ) + u%DX_u%c_obj%nacDef_Len = 12; u%DX_u%c_obj%nacDef = C_LOC( u%DX_u%nacDef(1) ) + u%DX_u%c_obj%bldRootDef_Len = p%NumBlds*12; u%DX_u%c_obj%bldRootDef = C_LOC( u%DX_u%bldRootDef(1) ) + call ExtLd_ConvertInpDataForExtProg(u, p, ErrStat2, ErrMsg2 ) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL AllocPAry( p%DX_p%bldChord, p%nTotBldNds, 'bldChord', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AllocPAry( p%DX_p%bldRloc, p%nTotBldNds, 'bldRloc', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AllocPAry( p%DX_p%twrdia, p%NumTwrNds, 'twrDia', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AllocPAry( p%DX_p%twrHloc, p%NumTwrNds, 'twrHloc', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AllocPAry( u%DX_u%bldPitch, p%NumBlds, 'bldPitch', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ! make sure the C versions are synced with these arrays + p%DX_p%c_obj%bldChord_Len = p%nTotBldNds; p%DX_p%c_obj%bldChord = C_LOC( p%DX_p%bldChord(1) ) + p%DX_p%c_obj%bldRloc_Len = p%nTotBldNds; p%DX_p%c_obj%bldRloc = C_LOC( p%DX_p%bldRloc(1) ) + p%DX_p%c_obj%twrDia_Len = p%NumTwrNds; p%DX_p%c_obj%twrDia = C_LOC( p%DX_p%twrDia(1) ) + p%DX_p%c_obj%twrHloc_Len = p%NumTwrNds; p%DX_p%c_obj%twrHloc = C_LOC( p%DX_p%twrHloc(1) ) + u%DX_u%c_obj%bldPitch_Len = p%NumBlds; u%DX_u%c_obj%bldPitch = C_LOC( u%DX_u%bldPitch(1) ) + + jTot = 1 + do k=1,p%NumBlds + do j=1,p%NumBldNds(k) + p%DX_p%bldChord(jTot) = InitInp%bldChord(j,k) + p%DX_p%bldRloc(jTot) = InitInp%bldRloc(j,k) + jTot = jTot+1 + end do + end do + + do j=1,p%NumTwrNds + p%DX_p%twrDia(j) = InitInp%twrDia(j) + p%DX_p%twrHloc(j) = InitInp%twrHloc(j) + end do + +end subroutine Init_u +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine converts the displacement data in the meshes in the input into a simple array format that can be accessed by external programs +subroutine ExtLd_ConvertInpDataForExtProg(u, p, errStat, errMsg ) +!.................................................................................................................................. + USE BeamDyn_IO, ONLY: BD_CrvExtractCrv + + type(ExtLd_InputType), intent(inout) :: u !< Input data + type(ExtLd_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 + real(R8Ki) :: wm_crv(3) ! Wiener-Milenkovic parameters + integer(intKi) :: j ! counter for nodes + integer(intKi) :: jTot ! counter for nodes + integer(intKi) :: k ! counter for blades + real(reki) :: cref(3) + real(reki) :: xloc(3) + real(reki) :: yloc(3) + real(reki) :: zloc(3) + + integer(intKi) :: ErrStat2 ! temporary Error status + character(ErrMsgLen) :: ErrMsg2 ! temporary Error message + character(*), parameter :: RoutineName = 'ExtLd_ConvertInpDataForExtProg' + + ! Initialize variables for this routine + + ErrStat = ErrID_None + ErrMsg = "" + + if (p%TwrAero) then + do j=1,p%NumTwrNds + call BD_CrvExtractCrv(u%TowerMotion%Orientation(:,:,j), wm_crv, ErrStat2, ErrMsg2) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + u%DX_u%twrDef((j-1)*12+1:(j-1)*12+3) = u%TowerMotion%TranslationDisp(:,j) + u%DX_u%twrDef((j-1)*12+4:(j-1)*12+6) = u%TowerMotion%TranslationVel(:,j) + u%DX_u%twrDef((j-1)*12+7:(j-1)*12+9) = wm_crv + u%DX_u%twrDef((j-1)*12+10:(j-1)*12+12) = u%TowerMotion%RotationVel(:,j) + end do + end if + + jTot = 1 + do k=1,p%NumBlds + do j=1,p%NumBldNds(k) + call BD_CrvExtractCrv(u%BladeMotion(k)%Orientation(:,:,j), wm_crv, ErrStat2, ErrMsg2) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + u%DX_u%bldDef((jTot-1)*12+1:(jTot-1)*12+3) = u%BladeMotion(k)%TranslationDisp(:,j) + u%DX_u%bldDef((jTot-1)*12+4:(jTot-1)*12+6) = u%BladeMotion(k)%TranslationVel(:,j) + u%DX_u%bldDef((jTot-1)*12+7:(jTot-1)*12+9) = wm_crv + u%DX_u%bldDef((jTot-1)*12+10:(jTot-1)*12+12) = u%BladeMotion(k)%RotationVel(:,j) + jTot = jTot+1 + end do + end do + + call BD_CrvExtractCrv(u%HubMotion%Orientation(:,:,1), wm_crv, ErrStat2, ErrMsg2) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + u%DX_u%hubDef(1:3) = u%HubMotion%TranslationDisp(:,1) + u%DX_u%hubDef(4:6) = u%HubMotion%TranslationVel(:,1) + u%DX_u%hubDef(7:9) = wm_crv + u%DX_u%hubDef(10:12) = u%HubMotion%RotationVel(:,1) + + call BD_CrvExtractCrv(u%NacelleMotion%Orientation(:,:,1), wm_crv, ErrStat2, ErrMsg2) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + u%DX_u%nacDef(1:3) = u%NacelleMotion%TranslationDisp(:,1) + u%DX_u%nacDef(4:6) = u%NacelleMotion%TranslationVel(:,1) + u%DX_u%nacDef(7:9) = wm_crv + u%DX_u%nacDef(10:12) = u%NacelleMotion%RotationVel(:,1) + + do k=1,p%NumBlds + call BD_CrvExtractCrv(u%BladeRootMotion(k)%Orientation(:,:,1), wm_crv, ErrStat2, ErrMsg2) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + u%DX_u%bldRootDef( (k-1)*12+1:(k-1)*12+3 ) = u%BladeRootMotion(k)%TranslationDisp(:,1) + u%DX_u%bldRootDef( (k-1)*12+4:(k-1)*12+6 ) = u%BladeRootMotion(k)%TranslationVel(:,1) + u%DX_u%bldRootDef( (k-1)*12+7:(k-1)*12+9 ) = wm_crv + u%DX_u%bldRootDef( (k-1)*12+10:(k-1)*12+12 ) = u%BladeRootMotion(k)%RotationVel(:,1) + end do + +end subroutine ExtLd_ConvertInpDataForExtProg +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine converts the data in the simple array format in the output data type into OpenFAST mesh format +subroutine ExtLd_ConvertOpDataForOpenFAST(y, u, m, p, errStat, errMsg ) +!.................................................................................................................................. + + type(ExtLd_OutputType), intent(inout) :: y !< Ouput data + type(ExtLd_InputType), intent(in ) :: u !< Input data + type(ExtLd_MiscVarType), intent(inout) :: m !< Misc var + type(ExtLd_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) :: j ! counter for nodes + integer(intKi) :: jTot ! counter for nodes + integer(intKi) :: k ! counter for blades + real(ReKi) :: tmp_az, delta_az ! temporary variable for azimuth + + integer(intKi) :: ErrStat2 ! temporary Error status + character(ErrMsgLen) :: ErrMsg2 ! temporary Error message + character(*), parameter :: RoutineName = 'ExtLd_ConvertInpDataForExtProg' + + ! Initialize variables for this routine + + ErrStat = ErrID_None + ErrMsg = "" + + tmp_az = m%az + call Zero2TwoPi(tmp_az) + delta_az = u%az - tmp_az + if ( delta_az .lt. -1.0 ) then + m%az = m%az + delta_az + PI + else + m%az = m%az + delta_az + end if + if (m%az > (p%az_blend_mean - 0.5 * p%az_blend_delta)) then + m%phi_cfd = 0.5 * ( tanh( (m%az - p%az_blend_mean)/p%az_blend_delta ) + 1.0 ) + else + m%phi_cfd = 0.0 + end if + + if (p%TwrAero) then + do j=1,p%NumTwrNds + y%TowerLoad%Force(:,j) = m%phi_cfd * y%DX_y%twrLd((j-1)*6+1:(j-1)*6+3) + (1.0 - m%phi_cfd) * y%TowerLoadAD%Force(:,j) + y%TowerLoad%Moment(:,j) = m%phi_cfd * y%DX_y%twrLd((j-1)*6+4:(j-1)*6+6) + (1.0 - m%phi_cfd) * y%TowerLoadAD%Moment(:,j) + end do + end if + + jTot = 1 + do k=1,p%NumBlds + do j=1,p%NumBldNds(k) + y%BladeLoad(k)%Force(:,j) = m%phi_cfd * y%DX_y%bldLd((jTot-1)*6+1:(jTot-1)*6+3) + (1.0 - m%phi_cfd) * y%BladeLoadAD(k)%Force(:,j) + y%BladeLoad(k)%Moment(:,j) = m%phi_cfd * y%DX_y%bldLd((jTot-1)*6+4:(jTot-1)*6+6) + (1.0 - m%phi_cfd) * y%BladeLoadAD(k)%Moment(:,j) + jTot = jTot+1 + end do + end do + + +end subroutine ExtLd_ConvertOpDataForOpenFAST +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine is called at the end of the simulation. +subroutine ExtLd_End( u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) +!.................................................................................................................................. + + TYPE(ExtLd_InputType), INTENT(INOUT) :: u !< System inputs + TYPE(ExtLd_ParameterType), INTENT(INOUT) :: p !< Parameters + TYPE(ExtLd_ContinuousStateType), INTENT(INOUT) :: x !< Continuous states + TYPE(ExtLd_DiscreteStateType), INTENT(INOUT) :: xd !< Discrete states + TYPE(ExtLd_ConstraintStateType), INTENT(INOUT) :: z !< Constraint states + TYPE(ExtLd_OtherStateType), INTENT(INOUT) :: OtherState !< Other states + TYPE(ExtLd_OutputType), INTENT(INOUT) :: y !< System outputs + TYPE(ExtLd_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: + + +END SUBROUTINE ExtLd_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 ExtLd_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(ExtLd_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(ExtLd_ParameterType), intent(in ) :: p !< Parameters + type(ExtLd_ContinuousStateType), intent(inout) :: x !< Input: Continuous states at t; + !! Output: Continuous states at t + Interval + type(ExtLd_DiscreteStateType), intent(inout) :: xd !< Input: Discrete states at t; + !! Output: Discrete states at t + Interval + type(ExtLd_ConstraintStateType), intent(inout) :: z !< Input: Constraint states at t; + !! Output: Constraint states at t+dt + type(ExtLd_OtherStateType), intent(inout) :: OtherState !< Input: Other states at t; + !! Output: Other states at t+dt + type(ExtLd_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(ExtLd_InputType) :: uInterp ! Interpolated/Extrapolated input + integer(intKi) :: ErrStat2 ! temporary Error status + character(ErrMsgLen) :: ErrMsg2 ! temporary Error message + character(*), parameter :: RoutineName = 'ExtLd_UpdateStates' + + ErrStat = ErrID_None + ErrMsg = "" + + +end subroutine ExtLd_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 ExtLd_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 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. +!.................................................................................................................................. + + REAL(DbKi), INTENT(IN ) :: t !< Current simulation time in seconds + TYPE(ExtLd_InputType), INTENT(IN ) :: u !< Inputs at Time t + TYPE(ExtLd_ParameterType), INTENT(IN ) :: p !< Parameters + TYPE(ExtLd_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at t + TYPE(ExtLd_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at t + TYPE(ExtLd_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at t + TYPE(ExtLd_OtherStateType), INTENT(IN ) :: OtherState !< Other states at t + TYPE(ExtLd_OutputType), INTENT(INOUT) :: y !< Outputs computed at t (Input only so that mesh con- + !! nectivity information does not have to be recalculated) + type(ExtLd_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 ! m%BEMT_u(1) is at t; m%BEMT_u(2) is t+dt + integer(intKi) :: i + integer(intKi) :: j + + integer(intKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ExtLd_CalcOutput' + + ErrStat = ErrID_None + ErrMsg = "" + + end subroutine ExtLd_CalcOutput + + subroutine apply_wm(c, v, vrot, transpose) + + real(reki), intent(in) :: c(:) ! The Wiener-Milenkovic parameter + real(reki), intent(in) :: v(:) ! The vector to be rotated + real(reki), intent(inout) :: vrot(:) !Hold the rotated vector + real(reki), intent(in) :: transpose !Whether to transpose the rotation + + real(reki) :: magC, c0, nu, cosPhiO2 + real(reki) :: cCrossV(3) + real(reki) :: cCrosscCrossV(3) + + magC = c(1)*c(1) + c(2)*c(2) + c(3)*c(3) + c0 = 2.0-0.125*magC + nu = 2.0/(4.0-c0) + cosPhiO2 = 0.5*c0*nu + cCrossV(1) = c(2)*v(3) - c(3)*v(2) + cCrossV(2) = c(3)*v(1) - c(1)*v(3) + cCrossV(3) = c(1)*v(2) - c(2)*v(1) + + !write(*,*) ' c = ', c(1), ', ', c(2), ', ', c(3) + !write(*,*) ' cCrossV = ', cCrossV(1), ', ', cCrossV(2), ', ', cCrossV(3) + + cCrosscCrossV(1) = c(2)*cCrossV(3) - c(3)*cCrossV(2) + cCrosscCrossV(2) = c(3)*cCrossV(1) - c(1)*cCrossV(3) + cCrosscCrossV(3) = c(1)*cCrossV(2) - c(2)*cCrossV(1) + + vrot(1) = v(1) + transpose * nu * cosPhiO2 * cCrossV(1) + 0.5 * nu * nu * cCrosscCrossV(1) + vrot(2) = v(2) + transpose * nu * cosPhiO2 * cCrossV(2) + 0.5 * nu * nu * cCrosscCrossV(2) + vrot(3) = v(3) + transpose * nu * cosPhiO2 * cCrossV(3) + 0.5 * nu * nu * cCrosscCrossV(3) + + end subroutine apply_wm + +END MODULE ExtLoads diff --git a/modules/extloads/src/ExtLoadsDX_Registry.txt b/modules/extloads/src/ExtLoadsDX_Registry.txt new file mode 100644 index 0000000000..f7b87c44eb --- /dev/null +++ b/modules/extloads/src/ExtLoadsDX_Registry.txt @@ -0,0 +1,45 @@ +################################################################################################################################### +# Registry for ExternalLoadsDX in the FAST Modularization Framework +# This Registry file is used to create ExtLoadsDX_Types which contains data used in the ExtLoads module for data exchange with external drivers. +# 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. +################################################################################################################################### +# File last committed $Date$ +# (File) Revision #: $Rev$ +# URL: $HeadURL$ +################################################################################################################################### +# ...... Include files (definitions from NWTC Library) ............................................................................ +include Registry_NWTC_Library.txt + +# ..... Inputs .................................................................................................................... +# Define inputs that are contained on the mesh here: +typedef ExtLoadsDX/ExtLdDX InputType R8Ki twrDef {:} - - "Deformations on the tower - to send to external driver" +typedef ^ InputType R8Ki bldDef {:} - - "Deformations on all blades - to send to external driver" +typedef ^ InputType R8Ki hubDef {:} - - "Deformations on the hub - to send to external driver" +typedef ^ InputType R8Ki nacDef {:} - - "Deformations the nacelle - to send to external driver" +typedef ^ InputType R8Ki bldRootDef {:} - - "Deformations of the blade root nodes - to send to external driver" +typedef ^ InputType R8Ki bldPitch {:} - - "Pitch angle of blade" + +# ..... Parameters ................................................................................................................ +typedef ^ ParameterType IntKi nBlades {:} - - "Number of blades" +typedef ^ ParameterType IntKi nBladeNodes {:} - - "Number of blade nodes for each blade" - +typedef ^ ParameterType IntKi nTowerNodes {:} - - "Number of tower nodes for each blade" - +typedef ^ ParameterType R8Ki twrRefPos {:} - - "Reference position of the tower nodes - to send to external driver" +typedef ^ ParameterType R8Ki bldRefPos {:} - - "Reference position of the all blade nodes - to send to external driver" +typedef ^ ParameterType R8Ki hubRefPos {:} - - "Reference position of the tower nodes - to send to external driver" +typedef ^ ParameterType R8Ki nacRefPos {:} - - "Reference position of the all blade nodes - to send to external driver" +typedef ^ ParameterType R8Ki bldRootRefPos {:} - - "Reference position of the blade root nodes - to send to external driver" +typedef ^ ParameterType R8Ki bldChord {:} - - "Blade chord" m +typedef ^ ParameterType R8Ki bldRloc {:} - - "Radial location along the blade" m +typedef ^ ParameterType R8Ki twrDia {:} - - "Tower diameter" m +typedef ^ ParameterType R8Ki twrHloc {:} - - "Height location along the tower" m + +# ..... Outputs ................................................................................................................... +# Define outputs that are contained on the mesh here: +typedef ^ OutputType R8Ki twrLd {:} - - "Loads on the tower - Externally supplied" +typedef ^ OutputType R8Ki bldLd {:} - - "Loads on all blades - Externally supplied" diff --git a/modules/extloads/src/ExtLoadsDX_Types.f90 b/modules/extloads/src/ExtLoadsDX_Types.f90 new file mode 100644 index 0000000000..3d8434e68a --- /dev/null +++ b/modules/extloads/src/ExtLoadsDX_Types.f90 @@ -0,0 +1,1685 @@ +!STARTOFREGISTRYGENERATEDFILE 'ExtLoadsDX_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 +!********************************************************************************************************************************* +! ExtLoadsDX_Types +!................................................................................................................................. +! This file is part of ExtLoadsDX. +! +! 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 ExtLoadsDX. 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 ExtLoadsDX_Types +!--------------------------------------------------------------------------------------------------------------------------------- +USE NWTC_Library +IMPLICIT NONE +! ========= ExtLdDX_InputType_C ======= + TYPE, BIND(C) :: ExtLdDX_InputType_C + TYPE(C_PTR) :: object = C_NULL_PTR + TYPE(C_ptr) :: twrDef = C_NULL_PTR + INTEGER(C_int) :: twrDef_Len = 0 + TYPE(C_ptr) :: bldDef = C_NULL_PTR + INTEGER(C_int) :: bldDef_Len = 0 + TYPE(C_ptr) :: hubDef = C_NULL_PTR + INTEGER(C_int) :: hubDef_Len = 0 + TYPE(C_ptr) :: nacDef = C_NULL_PTR + INTEGER(C_int) :: nacDef_Len = 0 + TYPE(C_ptr) :: bldRootDef = C_NULL_PTR + INTEGER(C_int) :: bldRootDef_Len = 0 + TYPE(C_ptr) :: bldPitch = C_NULL_PTR + INTEGER(C_int) :: bldPitch_Len = 0 + END TYPE ExtLdDX_InputType_C + TYPE, PUBLIC :: ExtLdDX_InputType + TYPE( ExtLdDX_InputType_C ) :: C_obj + REAL(KIND=C_DOUBLE) , DIMENSION(:), POINTER :: twrDef => NULL() !< Deformations on the tower - to send to external driver [-] + REAL(KIND=C_DOUBLE) , DIMENSION(:), POINTER :: bldDef => NULL() !< Deformations on all blades - to send to external driver [-] + REAL(KIND=C_DOUBLE) , DIMENSION(:), POINTER :: hubDef => NULL() !< Deformations on the hub - to send to external driver [-] + REAL(KIND=C_DOUBLE) , DIMENSION(:), POINTER :: nacDef => NULL() !< Deformations the nacelle - to send to external driver [-] + REAL(KIND=C_DOUBLE) , DIMENSION(:), POINTER :: bldRootDef => NULL() !< Deformations of the blade root nodes - to send to external driver [-] + REAL(KIND=C_DOUBLE) , DIMENSION(:), POINTER :: bldPitch => NULL() !< Pitch angle of blade [-] + END TYPE ExtLdDX_InputType +! ======================= +! ========= ExtLdDX_ParameterType_C ======= + TYPE, BIND(C) :: ExtLdDX_ParameterType_C + TYPE(C_PTR) :: object = C_NULL_PTR + TYPE(C_ptr) :: nBlades = C_NULL_PTR + INTEGER(C_int) :: nBlades_Len = 0 + TYPE(C_ptr) :: nBladeNodes = C_NULL_PTR + INTEGER(C_int) :: nBladeNodes_Len = 0 + TYPE(C_ptr) :: nTowerNodes = C_NULL_PTR + INTEGER(C_int) :: nTowerNodes_Len = 0 + TYPE(C_ptr) :: twrRefPos = C_NULL_PTR + INTEGER(C_int) :: twrRefPos_Len = 0 + TYPE(C_ptr) :: bldRefPos = C_NULL_PTR + INTEGER(C_int) :: bldRefPos_Len = 0 + TYPE(C_ptr) :: hubRefPos = C_NULL_PTR + INTEGER(C_int) :: hubRefPos_Len = 0 + TYPE(C_ptr) :: nacRefPos = C_NULL_PTR + INTEGER(C_int) :: nacRefPos_Len = 0 + TYPE(C_ptr) :: bldRootRefPos = C_NULL_PTR + INTEGER(C_int) :: bldRootRefPos_Len = 0 + TYPE(C_ptr) :: bldChord = C_NULL_PTR + INTEGER(C_int) :: bldChord_Len = 0 + TYPE(C_ptr) :: bldRloc = C_NULL_PTR + INTEGER(C_int) :: bldRloc_Len = 0 + TYPE(C_ptr) :: twrDia = C_NULL_PTR + INTEGER(C_int) :: twrDia_Len = 0 + TYPE(C_ptr) :: twrHloc = C_NULL_PTR + INTEGER(C_int) :: twrHloc_Len = 0 + END TYPE ExtLdDX_ParameterType_C + TYPE, PUBLIC :: ExtLdDX_ParameterType + TYPE( ExtLdDX_ParameterType_C ) :: C_obj + INTEGER(KIND=C_INT) , DIMENSION(:), POINTER :: nBlades => NULL() !< Number of blades [-] + INTEGER(KIND=C_INT) , DIMENSION(:), POINTER :: nBladeNodes => NULL() !< Number of blade nodes for each blade [-] + INTEGER(KIND=C_INT) , DIMENSION(:), POINTER :: nTowerNodes => NULL() !< Number of tower nodes for each blade [-] + REAL(KIND=C_DOUBLE) , DIMENSION(:), POINTER :: twrRefPos => NULL() !< Reference position of the tower nodes - to send to external driver [-] + REAL(KIND=C_DOUBLE) , DIMENSION(:), POINTER :: bldRefPos => NULL() !< Reference position of the all blade nodes - to send to external driver [-] + REAL(KIND=C_DOUBLE) , DIMENSION(:), POINTER :: hubRefPos => NULL() !< Reference position of the tower nodes - to send to external driver [-] + REAL(KIND=C_DOUBLE) , DIMENSION(:), POINTER :: nacRefPos => NULL() !< Reference position of the all blade nodes - to send to external driver [-] + REAL(KIND=C_DOUBLE) , DIMENSION(:), POINTER :: bldRootRefPos => NULL() !< Reference position of the blade root nodes - to send to external driver [-] + REAL(KIND=C_DOUBLE) , DIMENSION(:), POINTER :: bldChord => NULL() !< Blade chord [m] + REAL(KIND=C_DOUBLE) , DIMENSION(:), POINTER :: bldRloc => NULL() !< Radial location along the blade [m] + REAL(KIND=C_DOUBLE) , DIMENSION(:), POINTER :: twrDia => NULL() !< Tower diameter [m] + REAL(KIND=C_DOUBLE) , DIMENSION(:), POINTER :: twrHloc => NULL() !< Height location along the tower [m] + END TYPE ExtLdDX_ParameterType +! ======================= +! ========= ExtLdDX_OutputType_C ======= + TYPE, BIND(C) :: ExtLdDX_OutputType_C + TYPE(C_PTR) :: object = C_NULL_PTR + TYPE(C_ptr) :: twrLd = C_NULL_PTR + INTEGER(C_int) :: twrLd_Len = 0 + TYPE(C_ptr) :: bldLd = C_NULL_PTR + INTEGER(C_int) :: bldLd_Len = 0 + END TYPE ExtLdDX_OutputType_C + TYPE, PUBLIC :: ExtLdDX_OutputType + TYPE( ExtLdDX_OutputType_C ) :: C_obj + REAL(KIND=C_DOUBLE) , DIMENSION(:), POINTER :: twrLd => NULL() !< Loads on the tower - Externally supplied [-] + REAL(KIND=C_DOUBLE) , DIMENSION(:), POINTER :: bldLd => NULL() !< Loads on all blades - Externally supplied [-] + END TYPE ExtLdDX_OutputType +! ======================= +CONTAINS + +subroutine ExtLdDX_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) + type(ExtLdDX_InputType), intent(in) :: SrcInputData + type(ExtLdDX_InputType), intent(inout) :: DstInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'ExtLdDX_CopyInput' + ErrStat = ErrID_None + ErrMsg = '' + if (associated(SrcInputData%twrDef)) then + LB(1:1) = lbound(SrcInputData%twrDef) + UB(1:1) = ubound(SrcInputData%twrDef) + if (.not. associated(DstInputData%twrDef)) then + allocate(DstInputData%twrDef(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%twrDef.', ErrStat, ErrMsg, RoutineName) + return + end if + DstInputData%C_obj%twrDef_Len = size(DstInputData%twrDef) + if (DstInputData%C_obj%twrDef_Len > 0) & + DstInputData%C_obj%twrDef = c_loc(DstInputData%twrDef(LB(1))) + end if + DstInputData%twrDef = SrcInputData%twrDef + end if + if (associated(SrcInputData%bldDef)) then + LB(1:1) = lbound(SrcInputData%bldDef) + UB(1:1) = ubound(SrcInputData%bldDef) + if (.not. associated(DstInputData%bldDef)) then + allocate(DstInputData%bldDef(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%bldDef.', ErrStat, ErrMsg, RoutineName) + return + end if + DstInputData%C_obj%bldDef_Len = size(DstInputData%bldDef) + if (DstInputData%C_obj%bldDef_Len > 0) & + DstInputData%C_obj%bldDef = c_loc(DstInputData%bldDef(LB(1))) + end if + DstInputData%bldDef = SrcInputData%bldDef + end if + if (associated(SrcInputData%hubDef)) then + LB(1:1) = lbound(SrcInputData%hubDef) + UB(1:1) = ubound(SrcInputData%hubDef) + if (.not. associated(DstInputData%hubDef)) then + allocate(DstInputData%hubDef(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%hubDef.', ErrStat, ErrMsg, RoutineName) + return + end if + DstInputData%C_obj%hubDef_Len = size(DstInputData%hubDef) + if (DstInputData%C_obj%hubDef_Len > 0) & + DstInputData%C_obj%hubDef = c_loc(DstInputData%hubDef(LB(1))) + end if + DstInputData%hubDef = SrcInputData%hubDef + end if + if (associated(SrcInputData%nacDef)) then + LB(1:1) = lbound(SrcInputData%nacDef) + UB(1:1) = ubound(SrcInputData%nacDef) + if (.not. associated(DstInputData%nacDef)) then + allocate(DstInputData%nacDef(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%nacDef.', ErrStat, ErrMsg, RoutineName) + return + end if + DstInputData%C_obj%nacDef_Len = size(DstInputData%nacDef) + if (DstInputData%C_obj%nacDef_Len > 0) & + DstInputData%C_obj%nacDef = c_loc(DstInputData%nacDef(LB(1))) + end if + DstInputData%nacDef = SrcInputData%nacDef + end if + if (associated(SrcInputData%bldRootDef)) then + LB(1:1) = lbound(SrcInputData%bldRootDef) + UB(1:1) = ubound(SrcInputData%bldRootDef) + if (.not. associated(DstInputData%bldRootDef)) then + allocate(DstInputData%bldRootDef(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%bldRootDef.', ErrStat, ErrMsg, RoutineName) + return + end if + DstInputData%C_obj%bldRootDef_Len = size(DstInputData%bldRootDef) + if (DstInputData%C_obj%bldRootDef_Len > 0) & + DstInputData%C_obj%bldRootDef = c_loc(DstInputData%bldRootDef(LB(1))) + end if + DstInputData%bldRootDef = SrcInputData%bldRootDef + end if + if (associated(SrcInputData%bldPitch)) then + LB(1:1) = lbound(SrcInputData%bldPitch) + UB(1:1) = ubound(SrcInputData%bldPitch) + if (.not. associated(DstInputData%bldPitch)) then + allocate(DstInputData%bldPitch(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%bldPitch.', ErrStat, ErrMsg, RoutineName) + return + end if + DstInputData%C_obj%bldPitch_Len = size(DstInputData%bldPitch) + if (DstInputData%C_obj%bldPitch_Len > 0) & + DstInputData%C_obj%bldPitch = c_loc(DstInputData%bldPitch(LB(1))) + end if + DstInputData%bldPitch = SrcInputData%bldPitch + end if +end subroutine + +subroutine ExtLdDX_DestroyInput(InputData, ErrStat, ErrMsg) + type(ExtLdDX_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'ExtLdDX_DestroyInput' + ErrStat = ErrID_None + ErrMsg = '' + if (associated(InputData%twrDef)) then + deallocate(InputData%twrDef) + InputData%twrDef => null() + InputData%C_obj%twrDef = c_null_ptr + InputData%C_obj%twrDef_Len = 0 + end if + if (associated(InputData%bldDef)) then + deallocate(InputData%bldDef) + InputData%bldDef => null() + InputData%C_obj%bldDef = c_null_ptr + InputData%C_obj%bldDef_Len = 0 + end if + if (associated(InputData%hubDef)) then + deallocate(InputData%hubDef) + InputData%hubDef => null() + InputData%C_obj%hubDef = c_null_ptr + InputData%C_obj%hubDef_Len = 0 + end if + if (associated(InputData%nacDef)) then + deallocate(InputData%nacDef) + InputData%nacDef => null() + InputData%C_obj%nacDef = c_null_ptr + InputData%C_obj%nacDef_Len = 0 + end if + if (associated(InputData%bldRootDef)) then + deallocate(InputData%bldRootDef) + InputData%bldRootDef => null() + InputData%C_obj%bldRootDef = c_null_ptr + InputData%C_obj%bldRootDef_Len = 0 + end if + if (associated(InputData%bldPitch)) then + deallocate(InputData%bldPitch) + InputData%bldPitch => null() + InputData%C_obj%bldPitch = c_null_ptr + InputData%C_obj%bldPitch_Len = 0 + end if +end subroutine + +subroutine ExtLdDX_PackInput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(ExtLdDX_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ExtLdDX_PackInput' + logical :: PtrInIndex + if (RF%ErrStat >= AbortErrLev) return + if (c_associated(InData%C_obj%object)) then + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + call RegPackPtr(RF, InData%twrDef) + call RegPackPtr(RF, InData%bldDef) + call RegPackPtr(RF, InData%hubDef) + call RegPackPtr(RF, InData%nacDef) + call RegPackPtr(RF, InData%bldRootDef) + call RegPackPtr(RF, InData%bldPitch) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ExtLdDX_UnPackInput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(ExtLdDX_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ExtLdDX_UnPackInput' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(B8Ki) :: PtrIdx + type(c_ptr) :: Ptr + if (RF%ErrStat /= ErrID_None) return + call RegUnpackPtr(RF, OutData%twrDef, LB, UB); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%twrDef)) then + OutData%C_obj%twrDef_Len = size(OutData%twrDef) + if (OutData%C_obj%twrDef_Len > 0) OutData%C_obj%twrDef = c_loc(OutData%twrDef(LB(1))) + end if + call RegUnpackPtr(RF, OutData%bldDef, LB, UB); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%bldDef)) then + OutData%C_obj%bldDef_Len = size(OutData%bldDef) + if (OutData%C_obj%bldDef_Len > 0) OutData%C_obj%bldDef = c_loc(OutData%bldDef(LB(1))) + end if + call RegUnpackPtr(RF, OutData%hubDef, LB, UB); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%hubDef)) then + OutData%C_obj%hubDef_Len = size(OutData%hubDef) + if (OutData%C_obj%hubDef_Len > 0) OutData%C_obj%hubDef = c_loc(OutData%hubDef(LB(1))) + end if + call RegUnpackPtr(RF, OutData%nacDef, LB, UB); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%nacDef)) then + OutData%C_obj%nacDef_Len = size(OutData%nacDef) + if (OutData%C_obj%nacDef_Len > 0) OutData%C_obj%nacDef = c_loc(OutData%nacDef(LB(1))) + end if + call RegUnpackPtr(RF, OutData%bldRootDef, LB, UB); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%bldRootDef)) then + OutData%C_obj%bldRootDef_Len = size(OutData%bldRootDef) + if (OutData%C_obj%bldRootDef_Len > 0) OutData%C_obj%bldRootDef = c_loc(OutData%bldRootDef(LB(1))) + end if + call RegUnpackPtr(RF, OutData%bldPitch, LB, UB); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%bldPitch)) then + OutData%C_obj%bldPitch_Len = size(OutData%bldPitch) + if (OutData%C_obj%bldPitch_Len > 0) OutData%C_obj%bldPitch = c_loc(OutData%bldPitch(LB(1))) + end if +end subroutine + +SUBROUTINE ExtLdDX_C2Fary_CopyInput(InputData, ErrStat, ErrMsg, SkipPointers) + TYPE(ExtLdDX_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 + + ! -- twrDef Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%twrDef ) ) THEN + NULLIFY( InputData%twrDef ) + ELSE + CALL C_F_POINTER(InputData%C_obj%twrDef, InputData%twrDef, [InputData%C_obj%twrDef_Len]) + END IF + END IF + + ! -- bldDef Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%bldDef ) ) THEN + NULLIFY( InputData%bldDef ) + ELSE + CALL C_F_POINTER(InputData%C_obj%bldDef, InputData%bldDef, [InputData%C_obj%bldDef_Len]) + END IF + END IF + + ! -- hubDef Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%hubDef ) ) THEN + NULLIFY( InputData%hubDef ) + ELSE + CALL C_F_POINTER(InputData%C_obj%hubDef, InputData%hubDef, [InputData%C_obj%hubDef_Len]) + END IF + END IF + + ! -- nacDef Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%nacDef ) ) THEN + NULLIFY( InputData%nacDef ) + ELSE + CALL C_F_POINTER(InputData%C_obj%nacDef, InputData%nacDef, [InputData%C_obj%nacDef_Len]) + END IF + END IF + + ! -- bldRootDef Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%bldRootDef ) ) THEN + NULLIFY( InputData%bldRootDef ) + ELSE + CALL C_F_POINTER(InputData%C_obj%bldRootDef, InputData%bldRootDef, [InputData%C_obj%bldRootDef_Len]) + END IF + END IF + + ! -- bldPitch Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%bldPitch ) ) THEN + NULLIFY( InputData%bldPitch ) + ELSE + CALL C_F_POINTER(InputData%C_obj%bldPitch, InputData%bldPitch, [InputData%C_obj%bldPitch_Len]) + END IF + END IF +END SUBROUTINE + +SUBROUTINE ExtLdDX_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) + TYPE(ExtLdDX_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 + + ! -- twrDef Input Data fields + IF (.NOT. SkipPointers_local ) THEN + IF (.NOT. ASSOCIATED(InputData%twrDef)) THEN + InputData%C_obj%twrDef_Len = 0 + InputData%C_obj%twrDef = C_NULL_PTR + ELSE + InputData%C_obj%twrDef_Len = SIZE(InputData%twrDef) + IF (InputData%C_obj%twrDef_Len > 0) & + InputData%C_obj%twrDef = C_LOC(InputData%twrDef(lbound(InputData%twrDef,1))) + END IF + END IF + + ! -- bldDef Input Data fields + IF (.NOT. SkipPointers_local ) THEN + IF (.NOT. ASSOCIATED(InputData%bldDef)) THEN + InputData%C_obj%bldDef_Len = 0 + InputData%C_obj%bldDef = C_NULL_PTR + ELSE + InputData%C_obj%bldDef_Len = SIZE(InputData%bldDef) + IF (InputData%C_obj%bldDef_Len > 0) & + InputData%C_obj%bldDef = C_LOC(InputData%bldDef(lbound(InputData%bldDef,1))) + END IF + END IF + + ! -- hubDef Input Data fields + IF (.NOT. SkipPointers_local ) THEN + IF (.NOT. ASSOCIATED(InputData%hubDef)) THEN + InputData%C_obj%hubDef_Len = 0 + InputData%C_obj%hubDef = C_NULL_PTR + ELSE + InputData%C_obj%hubDef_Len = SIZE(InputData%hubDef) + IF (InputData%C_obj%hubDef_Len > 0) & + InputData%C_obj%hubDef = C_LOC(InputData%hubDef(lbound(InputData%hubDef,1))) + END IF + END IF + + ! -- nacDef Input Data fields + IF (.NOT. SkipPointers_local ) THEN + IF (.NOT. ASSOCIATED(InputData%nacDef)) THEN + InputData%C_obj%nacDef_Len = 0 + InputData%C_obj%nacDef = C_NULL_PTR + ELSE + InputData%C_obj%nacDef_Len = SIZE(InputData%nacDef) + IF (InputData%C_obj%nacDef_Len > 0) & + InputData%C_obj%nacDef = C_LOC(InputData%nacDef(lbound(InputData%nacDef,1))) + END IF + END IF + + ! -- bldRootDef Input Data fields + IF (.NOT. SkipPointers_local ) THEN + IF (.NOT. ASSOCIATED(InputData%bldRootDef)) THEN + InputData%C_obj%bldRootDef_Len = 0 + InputData%C_obj%bldRootDef = C_NULL_PTR + ELSE + InputData%C_obj%bldRootDef_Len = SIZE(InputData%bldRootDef) + IF (InputData%C_obj%bldRootDef_Len > 0) & + InputData%C_obj%bldRootDef = C_LOC(InputData%bldRootDef(lbound(InputData%bldRootDef,1))) + END IF + END IF + + ! -- bldPitch Input Data fields + IF (.NOT. SkipPointers_local ) THEN + IF (.NOT. ASSOCIATED(InputData%bldPitch)) THEN + InputData%C_obj%bldPitch_Len = 0 + InputData%C_obj%bldPitch = C_NULL_PTR + ELSE + InputData%C_obj%bldPitch_Len = SIZE(InputData%bldPitch) + IF (InputData%C_obj%bldPitch_Len > 0) & + InputData%C_obj%bldPitch = C_LOC(InputData%bldPitch(lbound(InputData%bldPitch,1))) + END IF + END IF +END SUBROUTINE + +subroutine ExtLdDX_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(ExtLdDX_ParameterType), intent(in) :: SrcParamData + type(ExtLdDX_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'ExtLdDX_CopyParam' + ErrStat = ErrID_None + ErrMsg = '' + if (associated(SrcParamData%nBlades)) then + LB(1:1) = lbound(SrcParamData%nBlades) + UB(1:1) = ubound(SrcParamData%nBlades) + if (.not. associated(DstParamData%nBlades)) then + allocate(DstParamData%nBlades(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%nBlades.', ErrStat, ErrMsg, RoutineName) + return + end if + DstParamData%C_obj%nBlades_Len = size(DstParamData%nBlades) + if (DstParamData%C_obj%nBlades_Len > 0) & + DstParamData%C_obj%nBlades = c_loc(DstParamData%nBlades(LB(1))) + end if + DstParamData%nBlades = SrcParamData%nBlades + end if + if (associated(SrcParamData%nBladeNodes)) then + LB(1:1) = lbound(SrcParamData%nBladeNodes) + UB(1:1) = ubound(SrcParamData%nBladeNodes) + if (.not. associated(DstParamData%nBladeNodes)) then + allocate(DstParamData%nBladeNodes(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%nBladeNodes.', ErrStat, ErrMsg, RoutineName) + return + end if + DstParamData%C_obj%nBladeNodes_Len = size(DstParamData%nBladeNodes) + if (DstParamData%C_obj%nBladeNodes_Len > 0) & + DstParamData%C_obj%nBladeNodes = c_loc(DstParamData%nBladeNodes(LB(1))) + end if + DstParamData%nBladeNodes = SrcParamData%nBladeNodes + end if + if (associated(SrcParamData%nTowerNodes)) then + LB(1:1) = lbound(SrcParamData%nTowerNodes) + UB(1:1) = ubound(SrcParamData%nTowerNodes) + if (.not. associated(DstParamData%nTowerNodes)) then + allocate(DstParamData%nTowerNodes(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%nTowerNodes.', ErrStat, ErrMsg, RoutineName) + return + end if + DstParamData%C_obj%nTowerNodes_Len = size(DstParamData%nTowerNodes) + if (DstParamData%C_obj%nTowerNodes_Len > 0) & + DstParamData%C_obj%nTowerNodes = c_loc(DstParamData%nTowerNodes(LB(1))) + end if + DstParamData%nTowerNodes = SrcParamData%nTowerNodes + end if + if (associated(SrcParamData%twrRefPos)) then + LB(1:1) = lbound(SrcParamData%twrRefPos) + UB(1:1) = ubound(SrcParamData%twrRefPos) + if (.not. associated(DstParamData%twrRefPos)) then + allocate(DstParamData%twrRefPos(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%twrRefPos.', ErrStat, ErrMsg, RoutineName) + return + end if + DstParamData%C_obj%twrRefPos_Len = size(DstParamData%twrRefPos) + if (DstParamData%C_obj%twrRefPos_Len > 0) & + DstParamData%C_obj%twrRefPos = c_loc(DstParamData%twrRefPos(LB(1))) + end if + DstParamData%twrRefPos = SrcParamData%twrRefPos + end if + if (associated(SrcParamData%bldRefPos)) then + LB(1:1) = lbound(SrcParamData%bldRefPos) + UB(1:1) = ubound(SrcParamData%bldRefPos) + if (.not. associated(DstParamData%bldRefPos)) then + allocate(DstParamData%bldRefPos(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%bldRefPos.', ErrStat, ErrMsg, RoutineName) + return + end if + DstParamData%C_obj%bldRefPos_Len = size(DstParamData%bldRefPos) + if (DstParamData%C_obj%bldRefPos_Len > 0) & + DstParamData%C_obj%bldRefPos = c_loc(DstParamData%bldRefPos(LB(1))) + end if + DstParamData%bldRefPos = SrcParamData%bldRefPos + end if + if (associated(SrcParamData%hubRefPos)) then + LB(1:1) = lbound(SrcParamData%hubRefPos) + UB(1:1) = ubound(SrcParamData%hubRefPos) + if (.not. associated(DstParamData%hubRefPos)) then + allocate(DstParamData%hubRefPos(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%hubRefPos.', ErrStat, ErrMsg, RoutineName) + return + end if + DstParamData%C_obj%hubRefPos_Len = size(DstParamData%hubRefPos) + if (DstParamData%C_obj%hubRefPos_Len > 0) & + DstParamData%C_obj%hubRefPos = c_loc(DstParamData%hubRefPos(LB(1))) + end if + DstParamData%hubRefPos = SrcParamData%hubRefPos + end if + if (associated(SrcParamData%nacRefPos)) then + LB(1:1) = lbound(SrcParamData%nacRefPos) + UB(1:1) = ubound(SrcParamData%nacRefPos) + if (.not. associated(DstParamData%nacRefPos)) then + allocate(DstParamData%nacRefPos(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%nacRefPos.', ErrStat, ErrMsg, RoutineName) + return + end if + DstParamData%C_obj%nacRefPos_Len = size(DstParamData%nacRefPos) + if (DstParamData%C_obj%nacRefPos_Len > 0) & + DstParamData%C_obj%nacRefPos = c_loc(DstParamData%nacRefPos(LB(1))) + end if + DstParamData%nacRefPos = SrcParamData%nacRefPos + end if + if (associated(SrcParamData%bldRootRefPos)) then + LB(1:1) = lbound(SrcParamData%bldRootRefPos) + UB(1:1) = ubound(SrcParamData%bldRootRefPos) + if (.not. associated(DstParamData%bldRootRefPos)) then + allocate(DstParamData%bldRootRefPos(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%bldRootRefPos.', ErrStat, ErrMsg, RoutineName) + return + end if + DstParamData%C_obj%bldRootRefPos_Len = size(DstParamData%bldRootRefPos) + if (DstParamData%C_obj%bldRootRefPos_Len > 0) & + DstParamData%C_obj%bldRootRefPos = c_loc(DstParamData%bldRootRefPos(LB(1))) + end if + DstParamData%bldRootRefPos = SrcParamData%bldRootRefPos + end if + if (associated(SrcParamData%bldChord)) then + LB(1:1) = lbound(SrcParamData%bldChord) + UB(1:1) = ubound(SrcParamData%bldChord) + if (.not. associated(DstParamData%bldChord)) then + allocate(DstParamData%bldChord(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%bldChord.', ErrStat, ErrMsg, RoutineName) + return + end if + DstParamData%C_obj%bldChord_Len = size(DstParamData%bldChord) + if (DstParamData%C_obj%bldChord_Len > 0) & + DstParamData%C_obj%bldChord = c_loc(DstParamData%bldChord(LB(1))) + end if + DstParamData%bldChord = SrcParamData%bldChord + end if + if (associated(SrcParamData%bldRloc)) then + LB(1:1) = lbound(SrcParamData%bldRloc) + UB(1:1) = ubound(SrcParamData%bldRloc) + if (.not. associated(DstParamData%bldRloc)) then + allocate(DstParamData%bldRloc(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%bldRloc.', ErrStat, ErrMsg, RoutineName) + return + end if + DstParamData%C_obj%bldRloc_Len = size(DstParamData%bldRloc) + if (DstParamData%C_obj%bldRloc_Len > 0) & + DstParamData%C_obj%bldRloc = c_loc(DstParamData%bldRloc(LB(1))) + end if + DstParamData%bldRloc = SrcParamData%bldRloc + end if + if (associated(SrcParamData%twrDia)) then + LB(1:1) = lbound(SrcParamData%twrDia) + UB(1:1) = ubound(SrcParamData%twrDia) + if (.not. associated(DstParamData%twrDia)) then + allocate(DstParamData%twrDia(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%twrDia.', ErrStat, ErrMsg, RoutineName) + return + end if + DstParamData%C_obj%twrDia_Len = size(DstParamData%twrDia) + if (DstParamData%C_obj%twrDia_Len > 0) & + DstParamData%C_obj%twrDia = c_loc(DstParamData%twrDia(LB(1))) + end if + DstParamData%twrDia = SrcParamData%twrDia + end if + if (associated(SrcParamData%twrHloc)) then + LB(1:1) = lbound(SrcParamData%twrHloc) + UB(1:1) = ubound(SrcParamData%twrHloc) + if (.not. associated(DstParamData%twrHloc)) then + allocate(DstParamData%twrHloc(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%twrHloc.', ErrStat, ErrMsg, RoutineName) + return + end if + DstParamData%C_obj%twrHloc_Len = size(DstParamData%twrHloc) + if (DstParamData%C_obj%twrHloc_Len > 0) & + DstParamData%C_obj%twrHloc = c_loc(DstParamData%twrHloc(LB(1))) + end if + DstParamData%twrHloc = SrcParamData%twrHloc + end if +end subroutine + +subroutine ExtLdDX_DestroyParam(ParamData, ErrStat, ErrMsg) + type(ExtLdDX_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'ExtLdDX_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' + if (associated(ParamData%nBlades)) then + deallocate(ParamData%nBlades) + ParamData%nBlades => null() + ParamData%C_obj%nBlades = c_null_ptr + ParamData%C_obj%nBlades_Len = 0 + end if + if (associated(ParamData%nBladeNodes)) then + deallocate(ParamData%nBladeNodes) + ParamData%nBladeNodes => null() + ParamData%C_obj%nBladeNodes = c_null_ptr + ParamData%C_obj%nBladeNodes_Len = 0 + end if + if (associated(ParamData%nTowerNodes)) then + deallocate(ParamData%nTowerNodes) + ParamData%nTowerNodes => null() + ParamData%C_obj%nTowerNodes = c_null_ptr + ParamData%C_obj%nTowerNodes_Len = 0 + end if + if (associated(ParamData%twrRefPos)) then + deallocate(ParamData%twrRefPos) + ParamData%twrRefPos => null() + ParamData%C_obj%twrRefPos = c_null_ptr + ParamData%C_obj%twrRefPos_Len = 0 + end if + if (associated(ParamData%bldRefPos)) then + deallocate(ParamData%bldRefPos) + ParamData%bldRefPos => null() + ParamData%C_obj%bldRefPos = c_null_ptr + ParamData%C_obj%bldRefPos_Len = 0 + end if + if (associated(ParamData%hubRefPos)) then + deallocate(ParamData%hubRefPos) + ParamData%hubRefPos => null() + ParamData%C_obj%hubRefPos = c_null_ptr + ParamData%C_obj%hubRefPos_Len = 0 + end if + if (associated(ParamData%nacRefPos)) then + deallocate(ParamData%nacRefPos) + ParamData%nacRefPos => null() + ParamData%C_obj%nacRefPos = c_null_ptr + ParamData%C_obj%nacRefPos_Len = 0 + end if + if (associated(ParamData%bldRootRefPos)) then + deallocate(ParamData%bldRootRefPos) + ParamData%bldRootRefPos => null() + ParamData%C_obj%bldRootRefPos = c_null_ptr + ParamData%C_obj%bldRootRefPos_Len = 0 + end if + if (associated(ParamData%bldChord)) then + deallocate(ParamData%bldChord) + ParamData%bldChord => null() + ParamData%C_obj%bldChord = c_null_ptr + ParamData%C_obj%bldChord_Len = 0 + end if + if (associated(ParamData%bldRloc)) then + deallocate(ParamData%bldRloc) + ParamData%bldRloc => null() + ParamData%C_obj%bldRloc = c_null_ptr + ParamData%C_obj%bldRloc_Len = 0 + end if + if (associated(ParamData%twrDia)) then + deallocate(ParamData%twrDia) + ParamData%twrDia => null() + ParamData%C_obj%twrDia = c_null_ptr + ParamData%C_obj%twrDia_Len = 0 + end if + if (associated(ParamData%twrHloc)) then + deallocate(ParamData%twrHloc) + ParamData%twrHloc => null() + ParamData%C_obj%twrHloc = c_null_ptr + ParamData%C_obj%twrHloc_Len = 0 + end if +end subroutine + +subroutine ExtLdDX_PackParam(RF, Indata) + type(RegFile), intent(inout) :: RF + type(ExtLdDX_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ExtLdDX_PackParam' + logical :: PtrInIndex + if (RF%ErrStat >= AbortErrLev) return + if (c_associated(InData%C_obj%object)) then + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + call RegPackPtr(RF, InData%nBlades) + call RegPackPtr(RF, InData%nBladeNodes) + call RegPackPtr(RF, InData%nTowerNodes) + call RegPackPtr(RF, InData%twrRefPos) + call RegPackPtr(RF, InData%bldRefPos) + call RegPackPtr(RF, InData%hubRefPos) + call RegPackPtr(RF, InData%nacRefPos) + call RegPackPtr(RF, InData%bldRootRefPos) + call RegPackPtr(RF, InData%bldChord) + call RegPackPtr(RF, InData%bldRloc) + call RegPackPtr(RF, InData%twrDia) + call RegPackPtr(RF, InData%twrHloc) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ExtLdDX_UnPackParam(RF, OutData) + type(RegFile), intent(inout) :: RF + type(ExtLdDX_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ExtLdDX_UnPackParam' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(B8Ki) :: PtrIdx + type(c_ptr) :: Ptr + if (RF%ErrStat /= ErrID_None) return + call RegUnpackPtr(RF, OutData%nBlades, LB, UB); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%nBlades)) then + OutData%C_obj%nBlades_Len = size(OutData%nBlades) + if (OutData%C_obj%nBlades_Len > 0) OutData%C_obj%nBlades = c_loc(OutData%nBlades(LB(1))) + end if + call RegUnpackPtr(RF, OutData%nBladeNodes, LB, UB); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%nBladeNodes)) then + OutData%C_obj%nBladeNodes_Len = size(OutData%nBladeNodes) + if (OutData%C_obj%nBladeNodes_Len > 0) OutData%C_obj%nBladeNodes = c_loc(OutData%nBladeNodes(LB(1))) + end if + call RegUnpackPtr(RF, OutData%nTowerNodes, LB, UB); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%nTowerNodes)) then + OutData%C_obj%nTowerNodes_Len = size(OutData%nTowerNodes) + if (OutData%C_obj%nTowerNodes_Len > 0) OutData%C_obj%nTowerNodes = c_loc(OutData%nTowerNodes(LB(1))) + end if + call RegUnpackPtr(RF, OutData%twrRefPos, LB, UB); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%twrRefPos)) then + OutData%C_obj%twrRefPos_Len = size(OutData%twrRefPos) + if (OutData%C_obj%twrRefPos_Len > 0) OutData%C_obj%twrRefPos = c_loc(OutData%twrRefPos(LB(1))) + end if + call RegUnpackPtr(RF, OutData%bldRefPos, LB, UB); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%bldRefPos)) then + OutData%C_obj%bldRefPos_Len = size(OutData%bldRefPos) + if (OutData%C_obj%bldRefPos_Len > 0) OutData%C_obj%bldRefPos = c_loc(OutData%bldRefPos(LB(1))) + end if + call RegUnpackPtr(RF, OutData%hubRefPos, LB, UB); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%hubRefPos)) then + OutData%C_obj%hubRefPos_Len = size(OutData%hubRefPos) + if (OutData%C_obj%hubRefPos_Len > 0) OutData%C_obj%hubRefPos = c_loc(OutData%hubRefPos(LB(1))) + end if + call RegUnpackPtr(RF, OutData%nacRefPos, LB, UB); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%nacRefPos)) then + OutData%C_obj%nacRefPos_Len = size(OutData%nacRefPos) + if (OutData%C_obj%nacRefPos_Len > 0) OutData%C_obj%nacRefPos = c_loc(OutData%nacRefPos(LB(1))) + end if + call RegUnpackPtr(RF, OutData%bldRootRefPos, LB, UB); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%bldRootRefPos)) then + OutData%C_obj%bldRootRefPos_Len = size(OutData%bldRootRefPos) + if (OutData%C_obj%bldRootRefPos_Len > 0) OutData%C_obj%bldRootRefPos = c_loc(OutData%bldRootRefPos(LB(1))) + end if + call RegUnpackPtr(RF, OutData%bldChord, LB, UB); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%bldChord)) then + OutData%C_obj%bldChord_Len = size(OutData%bldChord) + if (OutData%C_obj%bldChord_Len > 0) OutData%C_obj%bldChord = c_loc(OutData%bldChord(LB(1))) + end if + call RegUnpackPtr(RF, OutData%bldRloc, LB, UB); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%bldRloc)) then + OutData%C_obj%bldRloc_Len = size(OutData%bldRloc) + if (OutData%C_obj%bldRloc_Len > 0) OutData%C_obj%bldRloc = c_loc(OutData%bldRloc(LB(1))) + end if + call RegUnpackPtr(RF, OutData%twrDia, LB, UB); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%twrDia)) then + OutData%C_obj%twrDia_Len = size(OutData%twrDia) + if (OutData%C_obj%twrDia_Len > 0) OutData%C_obj%twrDia = c_loc(OutData%twrDia(LB(1))) + end if + call RegUnpackPtr(RF, OutData%twrHloc, LB, UB); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%twrHloc)) then + OutData%C_obj%twrHloc_Len = size(OutData%twrHloc) + if (OutData%C_obj%twrHloc_Len > 0) OutData%C_obj%twrHloc = c_loc(OutData%twrHloc(LB(1))) + end if +end subroutine + +SUBROUTINE ExtLdDX_C2Fary_CopyParam(ParamData, ErrStat, ErrMsg, SkipPointers) + TYPE(ExtLdDX_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 + + ! -- nBlades Param Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( ParamData%C_obj%nBlades ) ) THEN + NULLIFY( ParamData%nBlades ) + ELSE + CALL C_F_POINTER(ParamData%C_obj%nBlades, ParamData%nBlades, [ParamData%C_obj%nBlades_Len]) + END IF + END IF + + ! -- nBladeNodes Param Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( ParamData%C_obj%nBladeNodes ) ) THEN + NULLIFY( ParamData%nBladeNodes ) + ELSE + CALL C_F_POINTER(ParamData%C_obj%nBladeNodes, ParamData%nBladeNodes, [ParamData%C_obj%nBladeNodes_Len]) + END IF + END IF + + ! -- nTowerNodes Param Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( ParamData%C_obj%nTowerNodes ) ) THEN + NULLIFY( ParamData%nTowerNodes ) + ELSE + CALL C_F_POINTER(ParamData%C_obj%nTowerNodes, ParamData%nTowerNodes, [ParamData%C_obj%nTowerNodes_Len]) + END IF + END IF + + ! -- twrRefPos Param Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( ParamData%C_obj%twrRefPos ) ) THEN + NULLIFY( ParamData%twrRefPos ) + ELSE + CALL C_F_POINTER(ParamData%C_obj%twrRefPos, ParamData%twrRefPos, [ParamData%C_obj%twrRefPos_Len]) + END IF + END IF + + ! -- bldRefPos Param Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( ParamData%C_obj%bldRefPos ) ) THEN + NULLIFY( ParamData%bldRefPos ) + ELSE + CALL C_F_POINTER(ParamData%C_obj%bldRefPos, ParamData%bldRefPos, [ParamData%C_obj%bldRefPos_Len]) + END IF + END IF + + ! -- hubRefPos Param Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( ParamData%C_obj%hubRefPos ) ) THEN + NULLIFY( ParamData%hubRefPos ) + ELSE + CALL C_F_POINTER(ParamData%C_obj%hubRefPos, ParamData%hubRefPos, [ParamData%C_obj%hubRefPos_Len]) + END IF + END IF + + ! -- nacRefPos Param Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( ParamData%C_obj%nacRefPos ) ) THEN + NULLIFY( ParamData%nacRefPos ) + ELSE + CALL C_F_POINTER(ParamData%C_obj%nacRefPos, ParamData%nacRefPos, [ParamData%C_obj%nacRefPos_Len]) + END IF + END IF + + ! -- bldRootRefPos Param Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( ParamData%C_obj%bldRootRefPos ) ) THEN + NULLIFY( ParamData%bldRootRefPos ) + ELSE + CALL C_F_POINTER(ParamData%C_obj%bldRootRefPos, ParamData%bldRootRefPos, [ParamData%C_obj%bldRootRefPos_Len]) + END IF + END IF + + ! -- bldChord Param Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( ParamData%C_obj%bldChord ) ) THEN + NULLIFY( ParamData%bldChord ) + ELSE + CALL C_F_POINTER(ParamData%C_obj%bldChord, ParamData%bldChord, [ParamData%C_obj%bldChord_Len]) + END IF + END IF + + ! -- bldRloc Param Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( ParamData%C_obj%bldRloc ) ) THEN + NULLIFY( ParamData%bldRloc ) + ELSE + CALL C_F_POINTER(ParamData%C_obj%bldRloc, ParamData%bldRloc, [ParamData%C_obj%bldRloc_Len]) + END IF + END IF + + ! -- twrDia Param Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( ParamData%C_obj%twrDia ) ) THEN + NULLIFY( ParamData%twrDia ) + ELSE + CALL C_F_POINTER(ParamData%C_obj%twrDia, ParamData%twrDia, [ParamData%C_obj%twrDia_Len]) + END IF + END IF + + ! -- twrHloc Param Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( ParamData%C_obj%twrHloc ) ) THEN + NULLIFY( ParamData%twrHloc ) + ELSE + CALL C_F_POINTER(ParamData%C_obj%twrHloc, ParamData%twrHloc, [ParamData%C_obj%twrHloc_Len]) + END IF + END IF +END SUBROUTINE + +SUBROUTINE ExtLdDX_F2C_CopyParam( ParamData, ErrStat, ErrMsg, SkipPointers ) + TYPE(ExtLdDX_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 + + ! -- nBlades Param Data fields + IF (.NOT. SkipPointers_local ) THEN + IF (.NOT. ASSOCIATED(ParamData%nBlades)) THEN + ParamData%C_obj%nBlades_Len = 0 + ParamData%C_obj%nBlades = C_NULL_PTR + ELSE + ParamData%C_obj%nBlades_Len = SIZE(ParamData%nBlades) + IF (ParamData%C_obj%nBlades_Len > 0) & + ParamData%C_obj%nBlades = C_LOC(ParamData%nBlades(lbound(ParamData%nBlades,1))) + END IF + END IF + + ! -- nBladeNodes Param Data fields + IF (.NOT. SkipPointers_local ) THEN + IF (.NOT. ASSOCIATED(ParamData%nBladeNodes)) THEN + ParamData%C_obj%nBladeNodes_Len = 0 + ParamData%C_obj%nBladeNodes = C_NULL_PTR + ELSE + ParamData%C_obj%nBladeNodes_Len = SIZE(ParamData%nBladeNodes) + IF (ParamData%C_obj%nBladeNodes_Len > 0) & + ParamData%C_obj%nBladeNodes = C_LOC(ParamData%nBladeNodes(lbound(ParamData%nBladeNodes,1))) + END IF + END IF + + ! -- nTowerNodes Param Data fields + IF (.NOT. SkipPointers_local ) THEN + IF (.NOT. ASSOCIATED(ParamData%nTowerNodes)) THEN + ParamData%C_obj%nTowerNodes_Len = 0 + ParamData%C_obj%nTowerNodes = C_NULL_PTR + ELSE + ParamData%C_obj%nTowerNodes_Len = SIZE(ParamData%nTowerNodes) + IF (ParamData%C_obj%nTowerNodes_Len > 0) & + ParamData%C_obj%nTowerNodes = C_LOC(ParamData%nTowerNodes(lbound(ParamData%nTowerNodes,1))) + END IF + END IF + + ! -- twrRefPos Param Data fields + IF (.NOT. SkipPointers_local ) THEN + IF (.NOT. ASSOCIATED(ParamData%twrRefPos)) THEN + ParamData%C_obj%twrRefPos_Len = 0 + ParamData%C_obj%twrRefPos = C_NULL_PTR + ELSE + ParamData%C_obj%twrRefPos_Len = SIZE(ParamData%twrRefPos) + IF (ParamData%C_obj%twrRefPos_Len > 0) & + ParamData%C_obj%twrRefPos = C_LOC(ParamData%twrRefPos(lbound(ParamData%twrRefPos,1))) + END IF + END IF + + ! -- bldRefPos Param Data fields + IF (.NOT. SkipPointers_local ) THEN + IF (.NOT. ASSOCIATED(ParamData%bldRefPos)) THEN + ParamData%C_obj%bldRefPos_Len = 0 + ParamData%C_obj%bldRefPos = C_NULL_PTR + ELSE + ParamData%C_obj%bldRefPos_Len = SIZE(ParamData%bldRefPos) + IF (ParamData%C_obj%bldRefPos_Len > 0) & + ParamData%C_obj%bldRefPos = C_LOC(ParamData%bldRefPos(lbound(ParamData%bldRefPos,1))) + END IF + END IF + + ! -- hubRefPos Param Data fields + IF (.NOT. SkipPointers_local ) THEN + IF (.NOT. ASSOCIATED(ParamData%hubRefPos)) THEN + ParamData%C_obj%hubRefPos_Len = 0 + ParamData%C_obj%hubRefPos = C_NULL_PTR + ELSE + ParamData%C_obj%hubRefPos_Len = SIZE(ParamData%hubRefPos) + IF (ParamData%C_obj%hubRefPos_Len > 0) & + ParamData%C_obj%hubRefPos = C_LOC(ParamData%hubRefPos(lbound(ParamData%hubRefPos,1))) + END IF + END IF + + ! -- nacRefPos Param Data fields + IF (.NOT. SkipPointers_local ) THEN + IF (.NOT. ASSOCIATED(ParamData%nacRefPos)) THEN + ParamData%C_obj%nacRefPos_Len = 0 + ParamData%C_obj%nacRefPos = C_NULL_PTR + ELSE + ParamData%C_obj%nacRefPos_Len = SIZE(ParamData%nacRefPos) + IF (ParamData%C_obj%nacRefPos_Len > 0) & + ParamData%C_obj%nacRefPos = C_LOC(ParamData%nacRefPos(lbound(ParamData%nacRefPos,1))) + END IF + END IF + + ! -- bldRootRefPos Param Data fields + IF (.NOT. SkipPointers_local ) THEN + IF (.NOT. ASSOCIATED(ParamData%bldRootRefPos)) THEN + ParamData%C_obj%bldRootRefPos_Len = 0 + ParamData%C_obj%bldRootRefPos = C_NULL_PTR + ELSE + ParamData%C_obj%bldRootRefPos_Len = SIZE(ParamData%bldRootRefPos) + IF (ParamData%C_obj%bldRootRefPos_Len > 0) & + ParamData%C_obj%bldRootRefPos = C_LOC(ParamData%bldRootRefPos(lbound(ParamData%bldRootRefPos,1))) + END IF + END IF + + ! -- bldChord Param Data fields + IF (.NOT. SkipPointers_local ) THEN + IF (.NOT. ASSOCIATED(ParamData%bldChord)) THEN + ParamData%C_obj%bldChord_Len = 0 + ParamData%C_obj%bldChord = C_NULL_PTR + ELSE + ParamData%C_obj%bldChord_Len = SIZE(ParamData%bldChord) + IF (ParamData%C_obj%bldChord_Len > 0) & + ParamData%C_obj%bldChord = C_LOC(ParamData%bldChord(lbound(ParamData%bldChord,1))) + END IF + END IF + + ! -- bldRloc Param Data fields + IF (.NOT. SkipPointers_local ) THEN + IF (.NOT. ASSOCIATED(ParamData%bldRloc)) THEN + ParamData%C_obj%bldRloc_Len = 0 + ParamData%C_obj%bldRloc = C_NULL_PTR + ELSE + ParamData%C_obj%bldRloc_Len = SIZE(ParamData%bldRloc) + IF (ParamData%C_obj%bldRloc_Len > 0) & + ParamData%C_obj%bldRloc = C_LOC(ParamData%bldRloc(lbound(ParamData%bldRloc,1))) + END IF + END IF + + ! -- twrDia Param Data fields + IF (.NOT. SkipPointers_local ) THEN + IF (.NOT. ASSOCIATED(ParamData%twrDia)) THEN + ParamData%C_obj%twrDia_Len = 0 + ParamData%C_obj%twrDia = C_NULL_PTR + ELSE + ParamData%C_obj%twrDia_Len = SIZE(ParamData%twrDia) + IF (ParamData%C_obj%twrDia_Len > 0) & + ParamData%C_obj%twrDia = C_LOC(ParamData%twrDia(lbound(ParamData%twrDia,1))) + END IF + END IF + + ! -- twrHloc Param Data fields + IF (.NOT. SkipPointers_local ) THEN + IF (.NOT. ASSOCIATED(ParamData%twrHloc)) THEN + ParamData%C_obj%twrHloc_Len = 0 + ParamData%C_obj%twrHloc = C_NULL_PTR + ELSE + ParamData%C_obj%twrHloc_Len = SIZE(ParamData%twrHloc) + IF (ParamData%C_obj%twrHloc_Len > 0) & + ParamData%C_obj%twrHloc = C_LOC(ParamData%twrHloc(lbound(ParamData%twrHloc,1))) + END IF + END IF +END SUBROUTINE + +subroutine ExtLdDX_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(ExtLdDX_OutputType), intent(in) :: SrcOutputData + type(ExtLdDX_OutputType), intent(inout) :: DstOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'ExtLdDX_CopyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (associated(SrcOutputData%twrLd)) then + LB(1:1) = lbound(SrcOutputData%twrLd) + UB(1:1) = ubound(SrcOutputData%twrLd) + if (.not. associated(DstOutputData%twrLd)) then + allocate(DstOutputData%twrLd(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%twrLd.', ErrStat, ErrMsg, RoutineName) + return + end if + DstOutputData%C_obj%twrLd_Len = size(DstOutputData%twrLd) + if (DstOutputData%C_obj%twrLd_Len > 0) & + DstOutputData%C_obj%twrLd = c_loc(DstOutputData%twrLd(LB(1))) + end if + DstOutputData%twrLd = SrcOutputData%twrLd + end if + if (associated(SrcOutputData%bldLd)) then + LB(1:1) = lbound(SrcOutputData%bldLd) + UB(1:1) = ubound(SrcOutputData%bldLd) + if (.not. associated(DstOutputData%bldLd)) then + allocate(DstOutputData%bldLd(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%bldLd.', ErrStat, ErrMsg, RoutineName) + return + end if + DstOutputData%C_obj%bldLd_Len = size(DstOutputData%bldLd) + if (DstOutputData%C_obj%bldLd_Len > 0) & + DstOutputData%C_obj%bldLd = c_loc(DstOutputData%bldLd(LB(1))) + end if + DstOutputData%bldLd = SrcOutputData%bldLd + end if +end subroutine + +subroutine ExtLdDX_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(ExtLdDX_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'ExtLdDX_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (associated(OutputData%twrLd)) then + deallocate(OutputData%twrLd) + OutputData%twrLd => null() + OutputData%C_obj%twrLd = c_null_ptr + OutputData%C_obj%twrLd_Len = 0 + end if + if (associated(OutputData%bldLd)) then + deallocate(OutputData%bldLd) + OutputData%bldLd => null() + OutputData%C_obj%bldLd = c_null_ptr + OutputData%C_obj%bldLd_Len = 0 + end if +end subroutine + +subroutine ExtLdDX_PackOutput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(ExtLdDX_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ExtLdDX_PackOutput' + logical :: PtrInIndex + if (RF%ErrStat >= AbortErrLev) return + if (c_associated(InData%C_obj%object)) then + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + call RegPackPtr(RF, InData%twrLd) + call RegPackPtr(RF, InData%bldLd) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ExtLdDX_UnPackOutput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(ExtLdDX_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ExtLdDX_UnPackOutput' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(B8Ki) :: PtrIdx + type(c_ptr) :: Ptr + if (RF%ErrStat /= ErrID_None) return + call RegUnpackPtr(RF, OutData%twrLd, LB, UB); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%twrLd)) then + OutData%C_obj%twrLd_Len = size(OutData%twrLd) + if (OutData%C_obj%twrLd_Len > 0) OutData%C_obj%twrLd = c_loc(OutData%twrLd(LB(1))) + end if + call RegUnpackPtr(RF, OutData%bldLd, LB, UB); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%bldLd)) then + OutData%C_obj%bldLd_Len = size(OutData%bldLd) + if (OutData%C_obj%bldLd_Len > 0) OutData%C_obj%bldLd = c_loc(OutData%bldLd(LB(1))) + end if +end subroutine + +SUBROUTINE ExtLdDX_C2Fary_CopyOutput(OutputData, ErrStat, ErrMsg, SkipPointers) + TYPE(ExtLdDX_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 + + ! -- twrLd Output Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OutputData%C_obj%twrLd ) ) THEN + NULLIFY( OutputData%twrLd ) + ELSE + CALL C_F_POINTER(OutputData%C_obj%twrLd, OutputData%twrLd, [OutputData%C_obj%twrLd_Len]) + END IF + END IF + + ! -- bldLd Output Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OutputData%C_obj%bldLd ) ) THEN + NULLIFY( OutputData%bldLd ) + ELSE + CALL C_F_POINTER(OutputData%C_obj%bldLd, OutputData%bldLd, [OutputData%C_obj%bldLd_Len]) + END IF + END IF +END SUBROUTINE + +SUBROUTINE ExtLdDX_F2C_CopyOutput( OutputData, ErrStat, ErrMsg, SkipPointers ) + TYPE(ExtLdDX_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 + + ! -- twrLd Output Data fields + IF (.NOT. SkipPointers_local ) THEN + IF (.NOT. ASSOCIATED(OutputData%twrLd)) THEN + OutputData%C_obj%twrLd_Len = 0 + OutputData%C_obj%twrLd = C_NULL_PTR + ELSE + OutputData%C_obj%twrLd_Len = SIZE(OutputData%twrLd) + IF (OutputData%C_obj%twrLd_Len > 0) & + OutputData%C_obj%twrLd = C_LOC(OutputData%twrLd(lbound(OutputData%twrLd,1))) + END IF + END IF + + ! -- bldLd Output Data fields + IF (.NOT. SkipPointers_local ) THEN + IF (.NOT. ASSOCIATED(OutputData%bldLd)) THEN + OutputData%C_obj%bldLd_Len = 0 + OutputData%C_obj%bldLd = C_NULL_PTR + ELSE + OutputData%C_obj%bldLd_Len = SIZE(OutputData%bldLd) + IF (OutputData%C_obj%bldLd_Len > 0) & + OutputData%C_obj%bldLd = C_LOC(OutputData%bldLd(lbound(OutputData%bldLd,1))) + END IF + END IF +END SUBROUTINE + +subroutine ExtLdDX_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(ExtLdDX_InputType), intent(in) :: u(:) ! Input at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Inputs + type(ExtLdDX_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 = 'ExtLdDX_Input_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(u)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(u)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(u) - 1 + select case (order) + case (0) + call ExtLdDX_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call ExtLdDX_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call ExtLdDX_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(u) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE ExtLdDX_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(ExtLdDX_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 + TYPE(ExtLdDX_InputType), INTENT(IN) :: u2 ! Input at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs + TYPE(ExtLdDX_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 = 'ExtLdDX_Input_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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 + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + IF (ASSOCIATED(u_out%twrDef) .AND. ASSOCIATED(u1%twrDef)) THEN + u_out%twrDef = a1*u1%twrDef + a2*u2%twrDef + END IF ! check if allocated + IF (ASSOCIATED(u_out%bldDef) .AND. ASSOCIATED(u1%bldDef)) THEN + u_out%bldDef = a1*u1%bldDef + a2*u2%bldDef + END IF ! check if allocated + IF (ASSOCIATED(u_out%hubDef) .AND. ASSOCIATED(u1%hubDef)) THEN + u_out%hubDef = a1*u1%hubDef + a2*u2%hubDef + END IF ! check if allocated + IF (ASSOCIATED(u_out%nacDef) .AND. ASSOCIATED(u1%nacDef)) THEN + u_out%nacDef = a1*u1%nacDef + a2*u2%nacDef + END IF ! check if allocated + IF (ASSOCIATED(u_out%bldRootDef) .AND. ASSOCIATED(u1%bldRootDef)) THEN + u_out%bldRootDef = a1*u1%bldRootDef + a2*u2%bldRootDef + END IF ! check if allocated + IF (ASSOCIATED(u_out%bldPitch) .AND. ASSOCIATED(u1%bldPitch)) THEN + u_out%bldPitch = a1*u1%bldPitch + a2*u2%bldPitch + END IF ! check if allocated +END SUBROUTINE + +SUBROUTINE ExtLdDX_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(ExtLdDX_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 > t3 + TYPE(ExtLdDX_InputType), INTENT(IN) :: u2 ! Input at t2 > t3 + TYPE(ExtLdDX_InputType), INTENT(IN) :: u3 ! Input at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs + TYPE(ExtLdDX_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) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'ExtLdDX_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 + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + IF (ASSOCIATED(u_out%twrDef) .AND. ASSOCIATED(u1%twrDef)) THEN + u_out%twrDef = a1*u1%twrDef + a2*u2%twrDef + a3*u3%twrDef + END IF ! check if allocated + IF (ASSOCIATED(u_out%bldDef) .AND. ASSOCIATED(u1%bldDef)) THEN + u_out%bldDef = a1*u1%bldDef + a2*u2%bldDef + a3*u3%bldDef + END IF ! check if allocated + IF (ASSOCIATED(u_out%hubDef) .AND. ASSOCIATED(u1%hubDef)) THEN + u_out%hubDef = a1*u1%hubDef + a2*u2%hubDef + a3*u3%hubDef + END IF ! check if allocated + IF (ASSOCIATED(u_out%nacDef) .AND. ASSOCIATED(u1%nacDef)) THEN + u_out%nacDef = a1*u1%nacDef + a2*u2%nacDef + a3*u3%nacDef + END IF ! check if allocated + IF (ASSOCIATED(u_out%bldRootDef) .AND. ASSOCIATED(u1%bldRootDef)) THEN + u_out%bldRootDef = a1*u1%bldRootDef + a2*u2%bldRootDef + a3*u3%bldRootDef + END IF ! check if allocated + IF (ASSOCIATED(u_out%bldPitch) .AND. ASSOCIATED(u1%bldPitch)) THEN + u_out%bldPitch = a1*u1%bldPitch + a2*u2%bldPitch + a3*u3%bldPitch + END IF ! check if allocated +END SUBROUTINE + +subroutine ExtLdDX_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(ExtLdDX_OutputType), intent(in) :: y(:) ! Output at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Outputs + type(ExtLdDX_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 = 'ExtLdDX_Output_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(y)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(y)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(y) - 1 + select case (order) + case (0) + call ExtLdDX_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call ExtLdDX_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call ExtLdDX_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(y) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE ExtLdDX_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(ExtLdDX_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 + TYPE(ExtLdDX_OutputType), INTENT(IN) :: y2 ! Output at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs + TYPE(ExtLdDX_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 = 'ExtLdDX_Output_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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 + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + IF (ASSOCIATED(y_out%twrLd) .AND. ASSOCIATED(y1%twrLd)) THEN + y_out%twrLd = a1*y1%twrLd + a2*y2%twrLd + END IF ! check if allocated + IF (ASSOCIATED(y_out%bldLd) .AND. ASSOCIATED(y1%bldLd)) THEN + y_out%bldLd = a1*y1%bldLd + a2*y2%bldLd + END IF ! check if allocated +END SUBROUTINE + +SUBROUTINE ExtLdDX_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(ExtLdDX_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 > t3 + TYPE(ExtLdDX_OutputType), INTENT(IN) :: y2 ! Output at t2 > t3 + TYPE(ExtLdDX_OutputType), INTENT(IN) :: y3 ! Output at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs + TYPE(ExtLdDX_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) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'ExtLdDX_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 + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + IF (ASSOCIATED(y_out%twrLd) .AND. ASSOCIATED(y1%twrLd)) THEN + y_out%twrLd = a1*y1%twrLd + a2*y2%twrLd + a3*y3%twrLd + END IF ! check if allocated + IF (ASSOCIATED(y_out%bldLd) .AND. ASSOCIATED(y1%bldLd)) THEN + y_out%bldLd = a1*y1%bldLd + a2*y2%bldLd + a3*y3%bldLd + END IF ! check if allocated +END SUBROUTINE +END MODULE ExtLoadsDX_Types +!ENDOFREGISTRYGENERATEDFILE diff --git a/modules/extloads/src/ExtLoadsDX_Types.h b/modules/extloads/src/ExtLoadsDX_Types.h new file mode 100644 index 0000000000..01cecc7fa4 --- /dev/null +++ b/modules/extloads/src/ExtLoadsDX_Types.h @@ -0,0 +1,61 @@ +//!STARTOFREGISTRYGENERATEDFILE 'ExtLoadsDX_Types.h' +//! +//! WARNING This file is generated automatically by the FAST registry. +//! Do not edit. Your changes to this file will be lost. +//! + +#ifndef _ExtLoadsDX_TYPES_H +#define _ExtLoadsDX_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 ExtLdDX_InputType { + void *object; + double *twrDef; int twrDef_Len; + double *bldDef; int bldDef_Len; + double *hubDef; int hubDef_Len; + double *nacDef; int nacDef_Len; + double *bldRootDef; int bldRootDef_Len; + double *bldPitch; int bldPitch_Len; +} ExtLdDX_InputType_t; + +typedef struct ExtLdDX_ParameterType { + void *object; + int *nBlades; int nBlades_Len; + int *nBladeNodes; int nBladeNodes_Len; + int *nTowerNodes; int nTowerNodes_Len; + double *twrRefPos; int twrRefPos_Len; + double *bldRefPos; int bldRefPos_Len; + double *hubRefPos; int hubRefPos_Len; + double *nacRefPos; int nacRefPos_Len; + double *bldRootRefPos; int bldRootRefPos_Len; + double *bldChord; int bldChord_Len; + double *bldRloc; int bldRloc_Len; + double *twrDia; int twrDia_Len; + double *twrHloc; int twrHloc_Len; +} ExtLdDX_ParameterType_t; + +typedef struct ExtLdDX_OutputType { + void *object; + double *twrLd; int twrLd_Len; + double *bldLd; int bldLd_Len; +} ExtLdDX_OutputType_t; + +typedef struct ExtLdDX_UserData { + ExtLdDX_InputType_t ExtLdDX_Input; + ExtLdDX_ParameterType_t ExtLdDX_Param; + ExtLdDX_OutputType_t ExtLdDX_Output; +} ExtLdDX_t; + +#endif // _ExtLoadsDX_TYPES_H + +//!ENDOFREGISTRYGENERATEDFILE diff --git a/modules/extloads/src/ExtLoads_Registry.txt b/modules/extloads/src/ExtLoads_Registry.txt new file mode 100644 index 0000000000..b287d01a90 --- /dev/null +++ b/modules/extloads/src/ExtLoads_Registry.txt @@ -0,0 +1,99 @@ +################################################################################################################################### +# Registry for ExternalLoads in the FAST Modularization Framework +# This Registry file is used to create ExtLoads_Types which contains data used in the ExtLoads module. +# 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. +################################################################################################################################### +# File last committed $Date$ +# (File) Revision #: $Rev$ +# URL: $HeadURL$ +################################################################################################################################### +# ...... Include files (definitions from NWTC Library) ............................................................................ +include Registry_NWTC_Library.txt +include IfW_FlowField.txt +usefrom ExtLoadsDX_Registry.txt + +# ..... Initialization data ....................................................................................................... +# Define inputs that the initialization routine may need here: +typedef ExtLoads/ExtLd InitInputType IntKi NumBlades - - - "Number of blades on the turbine" - +typedef ^ InitInputType IntKi NumBldNodes {:} - - "Number of blade nodes for each blade" - +typedef ^ InitInputType Logical TwrAero - .false. - "Flag that tells this module if the tower aero is on." - +typedef ^ InitInputType IntKi NumTwrNds - - - "Number of tower nodes for each blade" - +typedef ^ InitInputType ReKi HubPos {3} - - "X-Y-Z reference position of hub" m +typedef ^ InitInputType R8Ki HubOrient {3}{3} - - "DCM reference orientation of hub" - +typedef ^ InitInputType ReKi NacellePos {3} - - "X-Y-Z reference position of Nacelle" m +typedef ^ InitInputType R8Ki NacelleOrient {3}{3} - - "DCM reference orientation of Nacelle" - +typedef ^ InitInputType ReKi BldRootPos {:}{:} - - "X-Y-Z reference position of each blade root (3 x NumBlades)" m +typedef ^ InitInputType R8Ki BldRootOrient {:}{:}{:} - - "DCM reference orientation of blade root (3x3 x NumBlades )" - +typedef ^ InitInputType ReKi BldPos {:}{:}{:} - - "X-Y-Z reference position of each blade (3 x NumBladeNodesMax x NumBlades)" m +typedef ^ InitInputType R8Ki BldOrient {:}{:}{:}{:} - - "DCM reference orientation of blade (3x3 x NumBladeNodesMax x NumBlades )" - +typedef ^ InitInputType ReKi TwrPos {:}{:} - - "X-Y-Z reference position of tower (3 x NumTowerNodes)" m +typedef ^ InitInputType R8Ki TwrOrient {:}{:}{:} - - "DCM reference orientation of tower (3x3 x NumTowerNodes)" - +typedef ^ InitInputType ReKi az_blend_mean - - - "Mean azimuth at which to blend the external and aerodyn loads" - +typedef ^ InitInputType ReKi az_blend_delta - - - "The width of the tanh function over which to blend the external and aerodyn loads" - +typedef ^ InitInputType ReKi BldChord {:}{:} - - "Blade chord (NumBladeNodesMax x NumBlades)" m +typedef ^ InitInputType ReKi BldRloc {:}{:} - - "Radial location of each node along the blade" m +typedef ^ InitInputType ReKi TwrDia {:} - - "Tower diameter (NumTwrNodes)" m +typedef ^ InitInputType ReKi TwrHloc {:} - - "Height location of each node along the tower" m +typedef ^ InitInputType IntKi nNodesVel - - - "Number of nodes velocity data is needed from (for sizing array)" - + +# 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 ReKi AirDens - - - "Air density" kg/m^3 + +# ..... States .................................................................................................................... +# Define continuous (differentiable) states here: +typedef ^ ContinuousStateType ReKi blah - - - "Something" - + +# Define discrete (nondifferentiable) states here: +typedef ^ DiscreteStateType ReKi blah - - - "Something" - + +#Defin misc variables here +typedef ^ MiscVarType ReKi az - - - "Current azimuth" - +typedef ^ MiscVarType ReKi phi_cfd - - - "Blending ratio of load from external driver [0-1]" - +typedef ^ MiscVarType FlowFieldType &FlowField - - - "Flow field data type" - + +# Define constraint states here: +typedef ^ ConstraintStateType ReKi blah - - - "Something" - + +# Define "other" states here: +typedef ^ OtherStateType ReKi blah - - - "Something" - + +# Define misc/optimization variables (any data that are not considered actual states) here: + + +# ..... Parameters ................................................................................................................ +# Define parameters here: +typedef ^ ParameterType ExtLdDX_ParameterType DX_p - - - "Data to send to external driver" +typedef ^ ParameterType IntKi NumBlds - - - "Number of blades on the turbine" - +typedef ^ ParameterType IntKi NumBldNds {:} - - "Number of blade nodes for each blade" - +typedef ^ ParameterType IntKi nTotBldNds - - - "Total number of blade nodes" - +typedef ^ ParameterType Logical TwrAero - .FALSE. - "Flag that tells this module if the tower aero is on." - +typedef ^ ParameterType IntKi NumTwrNds - - - "Number of tower nodes" - +typedef ^ ParameterType ReKi az_blend_mean - - - "Mean azimuth at which to blend the external and aerodyn loads" - +typedef ^ ParameterType ReKi az_blend_delta - - - "The width of the tanh function over which to blend the external and aerodyn loads" - + +# ..... Inputs .................................................................................................................... +# Define inputs that are contained on the mesh here: +typedef ^ InputType ExtLdDX_InputType DX_u - - - "Data to send to external driver" +typedef ^ InputType ReKi az - - - "Azimuth of rotor" +typedef ^ InputType MeshType TowerMotion - - - "motion on the tower" - +typedef ^ InputType MeshType HubMotion - - - "motion on the hub" - +typedef ^ InputType MeshType NacelleMotion - - - "motion on the nacelle" - +typedef ^ InputType MeshType BladeRootMotion {:} - - "motion on each blade root" - +typedef ^ InputType MeshType BladeMotion {:} - - "motion on each blade" - + +# ..... Outputs ................................................................................................................... +# Define outputs that are contained on the mesh here: +typedef ^ OutputType ExtLdDX_OutputType DX_y - - - "Data to get from external driver" +typedef ^ OutputType MeshType TowerLoad - - - "loads on the tower" - +typedef ^ OutputType MeshType BladeLoad {:} - - "loads on each blade" - +typedef ^ OutputType MeshType TowerLoadAD - - - "loads on the tower from aerodyn" - +typedef ^ OutputType MeshType BladeLoadAD {:} - - "loads on each blade from aerodyn" - diff --git a/modules/extloads/src/ExtLoads_Types.f90 b/modules/extloads/src/ExtLoads_Types.f90 new file mode 100644 index 0000000000..bccf4a53a5 --- /dev/null +++ b/modules/extloads/src/ExtLoads_Types.f90 @@ -0,0 +1,1536 @@ +!STARTOFREGISTRYGENERATEDFILE 'ExtLoads_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 +!********************************************************************************************************************************* +! ExtLoads_Types +!................................................................................................................................. +! This file is part of ExtLoads. +! +! 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 ExtLoads. 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 ExtLoads_Types +!--------------------------------------------------------------------------------------------------------------------------------- +USE IfW_FlowField_Types +USE ExtLoadsDX_Types +USE NWTC_Library +IMPLICIT NONE +! ========= ExtLd_InitInputType ======= + TYPE, PUBLIC :: ExtLd_InitInputType + INTEGER(IntKi) :: NumBlades = 0_IntKi !< Number of blades on the turbine [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: NumBldNodes !< Number of blade nodes for each blade [-] + LOGICAL :: TwrAero = .false. !< Flag that tells this module if the tower aero is on. [-] + INTEGER(IntKi) :: NumTwrNds = 0_IntKi !< Number of tower nodes for each blade [-] + REAL(ReKi) , DIMENSION(1:3) :: HubPos = 0.0_ReKi !< X-Y-Z reference position of hub [m] + REAL(R8Ki) , DIMENSION(1:3,1:3) :: HubOrient = 0.0_R8Ki !< DCM reference orientation of hub [-] + REAL(ReKi) , DIMENSION(1:3) :: NacellePos = 0.0_ReKi !< X-Y-Z reference position of Nacelle [m] + REAL(R8Ki) , DIMENSION(1:3,1:3) :: NacelleOrient = 0.0_R8Ki !< DCM reference orientation of Nacelle [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BldRootPos !< X-Y-Z reference position of each blade root (3 x NumBlades) [m] + REAL(R8Ki) , DIMENSION(:,:,:), ALLOCATABLE :: BldRootOrient !< DCM reference orientation of blade root (3x3 x NumBlades ) [-] + REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: BldPos !< X-Y-Z reference position of each blade (3 x NumBladeNodesMax x NumBlades) [m] + REAL(R8Ki) , DIMENSION(:,:,:,:), ALLOCATABLE :: BldOrient !< DCM reference orientation of blade (3x3 x NumBladeNodesMax x NumBlades ) [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: TwrPos !< X-Y-Z reference position of tower (3 x NumTowerNodes) [m] + REAL(R8Ki) , DIMENSION(:,:,:), ALLOCATABLE :: TwrOrient !< DCM reference orientation of tower (3x3 x NumTowerNodes) [-] + REAL(ReKi) :: az_blend_mean = 0.0_ReKi !< Mean azimuth at which to blend the external and aerodyn loads [-] + REAL(ReKi) :: az_blend_delta = 0.0_ReKi !< The width of the tanh function over which to blend the external and aerodyn loads [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BldChord !< Blade chord (NumBladeNodesMax x NumBlades) [m] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BldRloc !< Radial location of each node along the blade [m] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TwrDia !< Tower diameter (NumTwrNodes) [m] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TwrHloc !< Height location of each node along the tower [m] + INTEGER(IntKi) :: nNodesVel = 0_IntKi !< Number of nodes velocity data is needed from (for sizing array) [-] + END TYPE ExtLd_InitInputType +! ======================= +! ========= ExtLd_InitOutputType ======= + TYPE, PUBLIC :: ExtLd_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 [-] + REAL(ReKi) :: AirDens = 0.0_ReKi !< Air density [kg/m^3] + END TYPE ExtLd_InitOutputType +! ======================= +! ========= ExtLd_ContinuousStateType ======= + TYPE, PUBLIC :: ExtLd_ContinuousStateType + REAL(ReKi) :: blah = 0.0_ReKi !< Something [-] + END TYPE ExtLd_ContinuousStateType +! ======================= +! ========= ExtLd_DiscreteStateType ======= + TYPE, PUBLIC :: ExtLd_DiscreteStateType + REAL(ReKi) :: blah = 0.0_ReKi !< Something [-] + END TYPE ExtLd_DiscreteStateType +! ======================= +! ========= ExtLd_MiscVarType ======= + TYPE, PUBLIC :: ExtLd_MiscVarType + REAL(ReKi) :: az = 0.0_ReKi !< Current azimuth [-] + REAL(ReKi) :: phi_cfd = 0.0_ReKi !< Blending ratio of load from external driver [0-1] [-] + TYPE(FlowFieldType) , POINTER :: FlowField => NULL() !< Flow field data type [-] + END TYPE ExtLd_MiscVarType +! ======================= +! ========= ExtLd_ConstraintStateType ======= + TYPE, PUBLIC :: ExtLd_ConstraintStateType + REAL(ReKi) :: blah = 0.0_ReKi !< Something [-] + END TYPE ExtLd_ConstraintStateType +! ======================= +! ========= ExtLd_OtherStateType ======= + TYPE, PUBLIC :: ExtLd_OtherStateType + REAL(ReKi) :: blah = 0.0_ReKi !< Something [-] + END TYPE ExtLd_OtherStateType +! ======================= +! ========= ExtLd_ParameterType ======= + TYPE, PUBLIC :: ExtLd_ParameterType + TYPE(ExtLdDX_ParameterType) :: DX_p !< Data to send to external driver [-] + INTEGER(IntKi) :: NumBlds = 0_IntKi !< Number of blades on the turbine [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: NumBldNds !< Number of blade nodes for each blade [-] + INTEGER(IntKi) :: nTotBldNds = 0_IntKi !< Total number of blade nodes [-] + LOGICAL :: TwrAero = .FALSE. !< Flag that tells this module if the tower aero is on. [-] + INTEGER(IntKi) :: NumTwrNds = 0_IntKi !< Number of tower nodes [-] + REAL(ReKi) :: az_blend_mean = 0.0_ReKi !< Mean azimuth at which to blend the external and aerodyn loads [-] + REAL(ReKi) :: az_blend_delta = 0.0_ReKi !< The width of the tanh function over which to blend the external and aerodyn loads [-] + END TYPE ExtLd_ParameterType +! ======================= +! ========= ExtLd_InputType ======= + TYPE, PUBLIC :: ExtLd_InputType + TYPE(ExtLdDX_InputType) :: DX_u !< Data to send to external driver [-] + REAL(ReKi) :: az = 0.0_ReKi !< Azimuth of rotor [-] + TYPE(MeshType) :: TowerMotion !< motion on the tower [-] + TYPE(MeshType) :: HubMotion !< motion on the hub [-] + TYPE(MeshType) :: NacelleMotion !< motion on the nacelle [-] + TYPE(MeshType) , DIMENSION(:), ALLOCATABLE :: BladeRootMotion !< motion on each blade root [-] + TYPE(MeshType) , DIMENSION(:), ALLOCATABLE :: BladeMotion !< motion on each blade [-] + END TYPE ExtLd_InputType +! ======================= +! ========= ExtLd_OutputType ======= + TYPE, PUBLIC :: ExtLd_OutputType + TYPE(ExtLdDX_OutputType) :: DX_y !< Data to get from external driver [-] + TYPE(MeshType) :: TowerLoad !< loads on the tower [-] + TYPE(MeshType) , DIMENSION(:), ALLOCATABLE :: BladeLoad !< loads on each blade [-] + TYPE(MeshType) :: TowerLoadAD !< loads on the tower from aerodyn [-] + TYPE(MeshType) , DIMENSION(:), ALLOCATABLE :: BladeLoadAD !< loads on each blade from aerodyn [-] + END TYPE ExtLd_OutputType +! ======================= +CONTAINS + +subroutine ExtLd_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) + type(ExtLd_InitInputType), intent(in) :: SrcInitInputData + type(ExtLd_InitInputType), intent(inout) :: DstInitInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(4), UB(4) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'ExtLd_CopyInitInput' + ErrStat = ErrID_None + ErrMsg = '' + DstInitInputData%NumBlades = SrcInitInputData%NumBlades + if (allocated(SrcInitInputData%NumBldNodes)) then + LB(1:1) = lbound(SrcInitInputData%NumBldNodes) + UB(1:1) = ubound(SrcInitInputData%NumBldNodes) + if (.not. allocated(DstInitInputData%NumBldNodes)) then + allocate(DstInitInputData%NumBldNodes(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%NumBldNodes.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%NumBldNodes = SrcInitInputData%NumBldNodes + end if + DstInitInputData%TwrAero = SrcInitInputData%TwrAero + DstInitInputData%NumTwrNds = SrcInitInputData%NumTwrNds + DstInitInputData%HubPos = SrcInitInputData%HubPos + DstInitInputData%HubOrient = SrcInitInputData%HubOrient + DstInitInputData%NacellePos = SrcInitInputData%NacellePos + DstInitInputData%NacelleOrient = SrcInitInputData%NacelleOrient + if (allocated(SrcInitInputData%BldRootPos)) then + LB(1:2) = lbound(SrcInitInputData%BldRootPos) + UB(1:2) = ubound(SrcInitInputData%BldRootPos) + if (.not. allocated(DstInitInputData%BldRootPos)) then + allocate(DstInitInputData%BldRootPos(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%BldRootPos.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%BldRootPos = SrcInitInputData%BldRootPos + end if + if (allocated(SrcInitInputData%BldRootOrient)) then + LB(1:3) = lbound(SrcInitInputData%BldRootOrient) + UB(1:3) = ubound(SrcInitInputData%BldRootOrient) + if (.not. allocated(DstInitInputData%BldRootOrient)) then + allocate(DstInitInputData%BldRootOrient(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%BldRootOrient.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%BldRootOrient = SrcInitInputData%BldRootOrient + end if + if (allocated(SrcInitInputData%BldPos)) then + LB(1:3) = lbound(SrcInitInputData%BldPos) + UB(1:3) = ubound(SrcInitInputData%BldPos) + if (.not. allocated(DstInitInputData%BldPos)) then + allocate(DstInitInputData%BldPos(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%BldPos.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%BldPos = SrcInitInputData%BldPos + end if + if (allocated(SrcInitInputData%BldOrient)) then + LB(1:4) = lbound(SrcInitInputData%BldOrient) + UB(1:4) = ubound(SrcInitInputData%BldOrient) + if (.not. allocated(DstInitInputData%BldOrient)) then + allocate(DstInitInputData%BldOrient(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%BldOrient.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%BldOrient = SrcInitInputData%BldOrient + end if + if (allocated(SrcInitInputData%TwrPos)) then + LB(1:2) = lbound(SrcInitInputData%TwrPos) + UB(1:2) = ubound(SrcInitInputData%TwrPos) + if (.not. allocated(DstInitInputData%TwrPos)) then + allocate(DstInitInputData%TwrPos(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%TwrPos.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%TwrPos = SrcInitInputData%TwrPos + end if + if (allocated(SrcInitInputData%TwrOrient)) then + LB(1:3) = lbound(SrcInitInputData%TwrOrient) + UB(1:3) = ubound(SrcInitInputData%TwrOrient) + if (.not. allocated(DstInitInputData%TwrOrient)) then + allocate(DstInitInputData%TwrOrient(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%TwrOrient.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%TwrOrient = SrcInitInputData%TwrOrient + end if + DstInitInputData%az_blend_mean = SrcInitInputData%az_blend_mean + DstInitInputData%az_blend_delta = SrcInitInputData%az_blend_delta + if (allocated(SrcInitInputData%BldChord)) then + LB(1:2) = lbound(SrcInitInputData%BldChord) + UB(1:2) = ubound(SrcInitInputData%BldChord) + if (.not. allocated(DstInitInputData%BldChord)) then + allocate(DstInitInputData%BldChord(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%BldChord.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%BldChord = SrcInitInputData%BldChord + end if + if (allocated(SrcInitInputData%BldRloc)) then + LB(1:2) = lbound(SrcInitInputData%BldRloc) + UB(1:2) = ubound(SrcInitInputData%BldRloc) + if (.not. allocated(DstInitInputData%BldRloc)) then + allocate(DstInitInputData%BldRloc(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%BldRloc.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%BldRloc = SrcInitInputData%BldRloc + end if + if (allocated(SrcInitInputData%TwrDia)) then + LB(1:1) = lbound(SrcInitInputData%TwrDia) + UB(1:1) = ubound(SrcInitInputData%TwrDia) + if (.not. allocated(DstInitInputData%TwrDia)) then + allocate(DstInitInputData%TwrDia(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%TwrDia.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%TwrDia = SrcInitInputData%TwrDia + end if + if (allocated(SrcInitInputData%TwrHloc)) then + LB(1:1) = lbound(SrcInitInputData%TwrHloc) + UB(1:1) = ubound(SrcInitInputData%TwrHloc) + if (.not. allocated(DstInitInputData%TwrHloc)) then + allocate(DstInitInputData%TwrHloc(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%TwrHloc.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%TwrHloc = SrcInitInputData%TwrHloc + end if + DstInitInputData%nNodesVel = SrcInitInputData%nNodesVel +end subroutine + +subroutine ExtLd_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(ExtLd_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'ExtLd_DestroyInitInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InitInputData%NumBldNodes)) then + deallocate(InitInputData%NumBldNodes) + end if + if (allocated(InitInputData%BldRootPos)) then + deallocate(InitInputData%BldRootPos) + end if + if (allocated(InitInputData%BldRootOrient)) then + deallocate(InitInputData%BldRootOrient) + end if + if (allocated(InitInputData%BldPos)) then + deallocate(InitInputData%BldPos) + end if + if (allocated(InitInputData%BldOrient)) then + deallocate(InitInputData%BldOrient) + end if + if (allocated(InitInputData%TwrPos)) then + deallocate(InitInputData%TwrPos) + end if + if (allocated(InitInputData%TwrOrient)) then + deallocate(InitInputData%TwrOrient) + end if + if (allocated(InitInputData%BldChord)) then + deallocate(InitInputData%BldChord) + end if + if (allocated(InitInputData%BldRloc)) then + deallocate(InitInputData%BldRloc) + end if + if (allocated(InitInputData%TwrDia)) then + deallocate(InitInputData%TwrDia) + end if + if (allocated(InitInputData%TwrHloc)) then + deallocate(InitInputData%TwrHloc) + end if +end subroutine + +subroutine ExtLd_PackInitInput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(ExtLd_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ExtLd_PackInitInput' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%NumBlades) + call RegPackAlloc(RF, InData%NumBldNodes) + call RegPack(RF, InData%TwrAero) + call RegPack(RF, InData%NumTwrNds) + call RegPack(RF, InData%HubPos) + call RegPack(RF, InData%HubOrient) + call RegPack(RF, InData%NacellePos) + call RegPack(RF, InData%NacelleOrient) + call RegPackAlloc(RF, InData%BldRootPos) + call RegPackAlloc(RF, InData%BldRootOrient) + call RegPackAlloc(RF, InData%BldPos) + call RegPackAlloc(RF, InData%BldOrient) + call RegPackAlloc(RF, InData%TwrPos) + call RegPackAlloc(RF, InData%TwrOrient) + call RegPack(RF, InData%az_blend_mean) + call RegPack(RF, InData%az_blend_delta) + call RegPackAlloc(RF, InData%BldChord) + call RegPackAlloc(RF, InData%BldRloc) + call RegPackAlloc(RF, InData%TwrDia) + call RegPackAlloc(RF, InData%TwrHloc) + call RegPack(RF, InData%nNodesVel) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ExtLd_UnPackInitInput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(ExtLd_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ExtLd_UnPackInitInput' + integer(B4Ki) :: LB(4), UB(4) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%NumBlades); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%NumBldNodes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TwrAero); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumTwrNds); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HubPos); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HubOrient); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NacellePos); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NacelleOrient); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BldRootPos); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BldRootOrient); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BldPos); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BldOrient); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TwrPos); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TwrOrient); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%az_blend_mean); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%az_blend_delta); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BldChord); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BldRloc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TwrDia); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TwrHloc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nNodesVel); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ExtLd_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) + type(ExtLd_InitOutputType), intent(in) :: SrcInitOutputData + type(ExtLd_InitOutputType), intent(inout) :: DstInitOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ExtLd_CopyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcInitOutputData%WriteOutputHdr)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) + if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then + allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitOutputData%WriteOutputUnt)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) + if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then + allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), 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 + end if + call NWTC_Library_CopyProgDesc(SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstInitOutputData%AirDens = SrcInitOutputData%AirDens +end subroutine + +subroutine ExtLd_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(ExtLd_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ExtLd_DestroyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InitOutputData%WriteOutputHdr)) then + deallocate(InitOutputData%WriteOutputHdr) + end if + if (allocated(InitOutputData%WriteOutputUnt)) then + deallocate(InitOutputData%WriteOutputUnt) + end if + call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine ExtLd_PackInitOutput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(ExtLd_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ExtLd_PackInitOutput' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%WriteOutputHdr) + call RegPackAlloc(RF, InData%WriteOutputUnt) + call NWTC_Library_PackProgDesc(RF, InData%Ver) + call RegPack(RF, InData%AirDens) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ExtLd_UnPackInitOutput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(ExtLd_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ExtLd_UnPackInitOutput' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%WriteOutputHdr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WriteOutputUnt); if (RegCheckErr(RF, RoutineName)) return + call NWTC_Library_UnpackProgDesc(RF, OutData%Ver) ! Ver + call RegUnpack(RF, OutData%AirDens); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ExtLd_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) + type(ExtLd_ContinuousStateType), intent(in) :: SrcContStateData + type(ExtLd_ContinuousStateType), intent(inout) :: DstContStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'ExtLd_CopyContState' + ErrStat = ErrID_None + ErrMsg = '' + DstContStateData%blah = SrcContStateData%blah +end subroutine + +subroutine ExtLd_DestroyContState(ContStateData, ErrStat, ErrMsg) + type(ExtLd_ContinuousStateType), intent(inout) :: ContStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'ExtLd_DestroyContState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine ExtLd_PackContState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(ExtLd_ContinuousStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ExtLd_PackContState' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%blah) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ExtLd_UnPackContState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(ExtLd_ContinuousStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ExtLd_UnPackContState' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%blah); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ExtLd_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) + type(ExtLd_DiscreteStateType), intent(in) :: SrcDiscStateData + type(ExtLd_DiscreteStateType), intent(inout) :: DstDiscStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'ExtLd_CopyDiscState' + ErrStat = ErrID_None + ErrMsg = '' + DstDiscStateData%blah = SrcDiscStateData%blah +end subroutine + +subroutine ExtLd_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) + type(ExtLd_DiscreteStateType), intent(inout) :: DiscStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'ExtLd_DestroyDiscState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine ExtLd_PackDiscState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(ExtLd_DiscreteStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ExtLd_PackDiscState' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%blah) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ExtLd_UnPackDiscState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(ExtLd_DiscreteStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ExtLd_UnPackDiscState' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%blah); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ExtLd_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(ExtLd_MiscVarType), intent(in) :: SrcMiscData + type(ExtLd_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(0), UB(0) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ExtLd_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + DstMiscData%az = SrcMiscData%az + DstMiscData%phi_cfd = SrcMiscData%phi_cfd + if (associated(SrcMiscData%FlowField)) then + if (.not. associated(DstMiscData%FlowField)) then + allocate(DstMiscData%FlowField, stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FlowField.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + call IfW_FlowField_CopyFlowFieldType(SrcMiscData%FlowField, DstMiscData%FlowField, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end if +end subroutine + +subroutine ExtLd_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(ExtLd_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ExtLd_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' + if (associated(MiscData%FlowField)) then + call IfW_FlowField_DestroyFlowFieldType(MiscData%FlowField, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + deallocate(MiscData%FlowField) + MiscData%FlowField => null() + end if +end subroutine + +subroutine ExtLd_PackMisc(RF, Indata) + type(RegFile), intent(inout) :: RF + type(ExtLd_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ExtLd_PackMisc' + logical :: PtrInIndex + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%az) + call RegPack(RF, InData%phi_cfd) + call RegPack(RF, associated(InData%FlowField)) + if (associated(InData%FlowField)) then + call RegPackPointer(RF, c_loc(InData%FlowField), PtrInIndex) + if (.not. PtrInIndex) then + call IfW_FlowField_PackFlowFieldType(RF, InData%FlowField) + end if + end if + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ExtLd_UnPackMisc(RF, OutData) + type(RegFile), intent(inout) :: RF + type(ExtLd_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ExtLd_UnPackMisc' + integer(B4Ki) :: LB(0), UB(0) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(B8Ki) :: PtrIdx + type(c_ptr) :: Ptr + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%az); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%phi_cfd); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%FlowField)) deallocate(OutData%FlowField) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackPointer(RF, Ptr, PtrIdx); if (RegCheckErr(RF, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%FlowField) + else + allocate(OutData%FlowField,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FlowField.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + RF%Pointers(PtrIdx) = c_loc(OutData%FlowField) + call IfW_FlowField_UnpackFlowFieldType(RF, OutData%FlowField) ! FlowField + end if + else + OutData%FlowField => null() + end if +end subroutine + +subroutine ExtLd_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) + type(ExtLd_ConstraintStateType), intent(in) :: SrcConstrStateData + type(ExtLd_ConstraintStateType), intent(inout) :: DstConstrStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'ExtLd_CopyConstrState' + ErrStat = ErrID_None + ErrMsg = '' + DstConstrStateData%blah = SrcConstrStateData%blah +end subroutine + +subroutine ExtLd_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) + type(ExtLd_ConstraintStateType), intent(inout) :: ConstrStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'ExtLd_DestroyConstrState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine ExtLd_PackConstrState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(ExtLd_ConstraintStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ExtLd_PackConstrState' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%blah) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ExtLd_UnPackConstrState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(ExtLd_ConstraintStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ExtLd_UnPackConstrState' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%blah); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ExtLd_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) + type(ExtLd_OtherStateType), intent(in) :: SrcOtherStateData + type(ExtLd_OtherStateType), intent(inout) :: DstOtherStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'ExtLd_CopyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + DstOtherStateData%blah = SrcOtherStateData%blah +end subroutine + +subroutine ExtLd_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) + type(ExtLd_OtherStateType), intent(inout) :: OtherStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'ExtLd_DestroyOtherState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine ExtLd_PackOtherState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(ExtLd_OtherStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ExtLd_PackOtherState' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%blah) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ExtLd_UnPackOtherState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(ExtLd_OtherStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ExtLd_UnPackOtherState' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%blah); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ExtLd_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(ExtLd_ParameterType), intent(in) :: SrcParamData + type(ExtLd_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ExtLd_CopyParam' + ErrStat = ErrID_None + ErrMsg = '' + call ExtLdDX_CopyParam(SrcParamData%DX_p, DstParamData%DX_p, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstParamData%NumBlds = SrcParamData%NumBlds + if (allocated(SrcParamData%NumBldNds)) then + LB(1:1) = lbound(SrcParamData%NumBldNds) + UB(1:1) = ubound(SrcParamData%NumBldNds) + if (.not. allocated(DstParamData%NumBldNds)) then + allocate(DstParamData%NumBldNds(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%NumBldNds.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%NumBldNds = SrcParamData%NumBldNds + end if + DstParamData%nTotBldNds = SrcParamData%nTotBldNds + DstParamData%TwrAero = SrcParamData%TwrAero + DstParamData%NumTwrNds = SrcParamData%NumTwrNds + DstParamData%az_blend_mean = SrcParamData%az_blend_mean + DstParamData%az_blend_delta = SrcParamData%az_blend_delta +end subroutine + +subroutine ExtLd_DestroyParam(ParamData, ErrStat, ErrMsg) + type(ExtLd_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ExtLd_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' + call ExtLdDX_DestroyParam(ParamData%DX_p, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(ParamData%NumBldNds)) then + deallocate(ParamData%NumBldNds) + end if +end subroutine + +subroutine ExtLd_PackParam(RF, Indata) + type(RegFile), intent(inout) :: RF + type(ExtLd_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ExtLd_PackParam' + if (RF%ErrStat >= AbortErrLev) return + call ExtLdDX_PackParam(RF, InData%DX_p) + call RegPack(RF, InData%NumBlds) + call RegPackAlloc(RF, InData%NumBldNds) + call RegPack(RF, InData%nTotBldNds) + call RegPack(RF, InData%TwrAero) + call RegPack(RF, InData%NumTwrNds) + call RegPack(RF, InData%az_blend_mean) + call RegPack(RF, InData%az_blend_delta) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ExtLd_UnPackParam(RF, OutData) + type(RegFile), intent(inout) :: RF + type(ExtLd_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ExtLd_UnPackParam' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call ExtLdDX_UnpackParam(RF, OutData%DX_p) ! DX_p + call RegUnpack(RF, OutData%NumBlds); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%NumBldNds); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nTotBldNds); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TwrAero); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumTwrNds); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%az_blend_mean); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%az_blend_delta); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ExtLd_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) + type(ExtLd_InputType), intent(inout) :: SrcInputData + type(ExtLd_InputType), intent(inout) :: DstInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ExtLd_CopyInput' + ErrStat = ErrID_None + ErrMsg = '' + call ExtLdDX_CopyInput(SrcInputData%DX_u, DstInputData%DX_u, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstInputData%az = SrcInputData%az + call MeshCopy(SrcInputData%TowerMotion, DstInputData%TowerMotion, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcInputData%HubMotion, DstInputData%HubMotion, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcInputData%NacelleMotion, DstInputData%NacelleMotion, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcInputData%BladeRootMotion)) then + LB(1:1) = lbound(SrcInputData%BladeRootMotion) + UB(1:1) = ubound(SrcInputData%BladeRootMotion) + if (.not. allocated(DstInputData%BladeRootMotion)) then + allocate(DstInputData%BladeRootMotion(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%BladeRootMotion.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MeshCopy(SrcInputData%BladeRootMotion(i1), DstInputData%BladeRootMotion(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcInputData%BladeMotion)) then + LB(1:1) = lbound(SrcInputData%BladeMotion) + UB(1:1) = ubound(SrcInputData%BladeMotion) + if (.not. allocated(DstInputData%BladeMotion)) then + allocate(DstInputData%BladeMotion(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%BladeMotion.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MeshCopy(SrcInputData%BladeMotion(i1), DstInputData%BladeMotion(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if +end subroutine + +subroutine ExtLd_DestroyInput(InputData, ErrStat, ErrMsg) + type(ExtLd_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ExtLd_DestroyInput' + ErrStat = ErrID_None + ErrMsg = '' + call ExtLdDX_DestroyInput(InputData%DX_u, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( InputData%TowerMotion, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( InputData%HubMotion, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( InputData%NacelleMotion, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(InputData%BladeRootMotion)) then + LB(1:1) = lbound(InputData%BladeRootMotion) + UB(1:1) = ubound(InputData%BladeRootMotion) + do i1 = LB(1), UB(1) + call MeshDestroy( InputData%BladeRootMotion(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InputData%BladeRootMotion) + end if + if (allocated(InputData%BladeMotion)) then + LB(1:1) = lbound(InputData%BladeMotion) + UB(1:1) = ubound(InputData%BladeMotion) + do i1 = LB(1), UB(1) + call MeshDestroy( InputData%BladeMotion(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InputData%BladeMotion) + end if +end subroutine + +subroutine ExtLd_PackInput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(ExtLd_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ExtLd_PackInput' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + if (RF%ErrStat >= AbortErrLev) return + call ExtLdDX_PackInput(RF, InData%DX_u) + call RegPack(RF, InData%az) + call MeshPack(RF, InData%TowerMotion) + call MeshPack(RF, InData%HubMotion) + call MeshPack(RF, InData%NacelleMotion) + call RegPack(RF, allocated(InData%BladeRootMotion)) + if (allocated(InData%BladeRootMotion)) then + call RegPackBounds(RF, 1, lbound(InData%BladeRootMotion), ubound(InData%BladeRootMotion)) + LB(1:1) = lbound(InData%BladeRootMotion) + UB(1:1) = ubound(InData%BladeRootMotion) + do i1 = LB(1), UB(1) + call MeshPack(RF, InData%BladeRootMotion(i1)) + end do + end if + call RegPack(RF, allocated(InData%BladeMotion)) + if (allocated(InData%BladeMotion)) then + call RegPackBounds(RF, 1, lbound(InData%BladeMotion), ubound(InData%BladeMotion)) + LB(1:1) = lbound(InData%BladeMotion) + UB(1:1) = ubound(InData%BladeMotion) + do i1 = LB(1), UB(1) + call MeshPack(RF, InData%BladeMotion(i1)) + end do + end if + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ExtLd_UnPackInput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(ExtLd_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ExtLd_UnPackInput' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call ExtLdDX_UnpackInput(RF, OutData%DX_u) ! DX_u + call RegUnpack(RF, OutData%az); if (RegCheckErr(RF, RoutineName)) return + call MeshUnpack(RF, OutData%TowerMotion) ! TowerMotion + call MeshUnpack(RF, OutData%HubMotion) ! HubMotion + call MeshUnpack(RF, OutData%NacelleMotion) ! NacelleMotion + if (allocated(OutData%BladeRootMotion)) deallocate(OutData%BladeRootMotion) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%BladeRootMotion(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeRootMotion.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(RF, OutData%BladeRootMotion(i1)) ! BladeRootMotion + end do + end if + if (allocated(OutData%BladeMotion)) deallocate(OutData%BladeMotion) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%BladeMotion(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeMotion.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(RF, OutData%BladeMotion(i1)) ! BladeMotion + end do + end if +end subroutine + +subroutine ExtLd_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(ExtLd_OutputType), intent(inout) :: SrcOutputData + type(ExtLd_OutputType), intent(inout) :: DstOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ExtLd_CopyOutput' + ErrStat = ErrID_None + ErrMsg = '' + call ExtLdDX_CopyOutput(SrcOutputData%DX_y, DstOutputData%DX_y, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcOutputData%TowerLoad, DstOutputData%TowerLoad, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcOutputData%BladeLoad)) then + LB(1:1) = lbound(SrcOutputData%BladeLoad) + UB(1:1) = ubound(SrcOutputData%BladeLoad) + if (.not. allocated(DstOutputData%BladeLoad)) then + allocate(DstOutputData%BladeLoad(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%BladeLoad.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MeshCopy(SrcOutputData%BladeLoad(i1), DstOutputData%BladeLoad(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call MeshCopy(SrcOutputData%TowerLoadAD, DstOutputData%TowerLoadAD, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcOutputData%BladeLoadAD)) then + LB(1:1) = lbound(SrcOutputData%BladeLoadAD) + UB(1:1) = ubound(SrcOutputData%BladeLoadAD) + if (.not. allocated(DstOutputData%BladeLoadAD)) then + allocate(DstOutputData%BladeLoadAD(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%BladeLoadAD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MeshCopy(SrcOutputData%BladeLoadAD(i1), DstOutputData%BladeLoadAD(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if +end subroutine + +subroutine ExtLd_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(ExtLd_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ExtLd_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' + call ExtLdDX_DestroyOutput(OutputData%DX_y, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( OutputData%TowerLoad, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(OutputData%BladeLoad)) then + LB(1:1) = lbound(OutputData%BladeLoad) + UB(1:1) = ubound(OutputData%BladeLoad) + do i1 = LB(1), UB(1) + call MeshDestroy( OutputData%BladeLoad(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(OutputData%BladeLoad) + end if + call MeshDestroy( OutputData%TowerLoadAD, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(OutputData%BladeLoadAD)) then + LB(1:1) = lbound(OutputData%BladeLoadAD) + UB(1:1) = ubound(OutputData%BladeLoadAD) + do i1 = LB(1), UB(1) + call MeshDestroy( OutputData%BladeLoadAD(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(OutputData%BladeLoadAD) + end if +end subroutine + +subroutine ExtLd_PackOutput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(ExtLd_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ExtLd_PackOutput' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + if (RF%ErrStat >= AbortErrLev) return + call ExtLdDX_PackOutput(RF, InData%DX_y) + call MeshPack(RF, InData%TowerLoad) + call RegPack(RF, allocated(InData%BladeLoad)) + if (allocated(InData%BladeLoad)) then + call RegPackBounds(RF, 1, lbound(InData%BladeLoad), ubound(InData%BladeLoad)) + LB(1:1) = lbound(InData%BladeLoad) + UB(1:1) = ubound(InData%BladeLoad) + do i1 = LB(1), UB(1) + call MeshPack(RF, InData%BladeLoad(i1)) + end do + end if + call MeshPack(RF, InData%TowerLoadAD) + call RegPack(RF, allocated(InData%BladeLoadAD)) + if (allocated(InData%BladeLoadAD)) then + call RegPackBounds(RF, 1, lbound(InData%BladeLoadAD), ubound(InData%BladeLoadAD)) + LB(1:1) = lbound(InData%BladeLoadAD) + UB(1:1) = ubound(InData%BladeLoadAD) + do i1 = LB(1), UB(1) + call MeshPack(RF, InData%BladeLoadAD(i1)) + end do + end if + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ExtLd_UnPackOutput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(ExtLd_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ExtLd_UnPackOutput' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call ExtLdDX_UnpackOutput(RF, OutData%DX_y) ! DX_y + call MeshUnpack(RF, OutData%TowerLoad) ! TowerLoad + if (allocated(OutData%BladeLoad)) deallocate(OutData%BladeLoad) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%BladeLoad(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeLoad.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(RF, OutData%BladeLoad(i1)) ! BladeLoad + end do + end if + call MeshUnpack(RF, OutData%TowerLoadAD) ! TowerLoadAD + if (allocated(OutData%BladeLoadAD)) deallocate(OutData%BladeLoadAD) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%BladeLoadAD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeLoadAD.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(RF, OutData%BladeLoadAD(i1)) ! BladeLoadAD + end do + end if +end subroutine + +subroutine ExtLd_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(ExtLd_InputType), intent(inout) :: u(:) ! Input at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Inputs + type(ExtLd_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 = 'ExtLd_Input_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(u)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(u)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(u) - 1 + select case (order) + case (0) + call ExtLd_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call ExtLd_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call ExtLd_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(u) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE ExtLd_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(ExtLd_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 + TYPE(ExtLd_InputType), INTENT(INOUT) :: u2 ! Input at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs + TYPE(ExtLd_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 = 'ExtLd_Input_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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 + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + CALL ExtLdDX_Input_ExtrapInterp1( u1%DX_u, u2%DX_u, tin, u_out%DX_u, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + u_out%az = a1*u1%az + a2*u2%az + CALL MeshExtrapInterp1(u1%TowerMotion, u2%TowerMotion, tin, u_out%TowerMotion, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp1(u1%HubMotion, u2%HubMotion, tin, u_out%HubMotion, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp1(u1%NacelleMotion, u2%NacelleMotion, tin, u_out%NacelleMotion, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ALLOCATED(u_out%BladeRootMotion) .AND. ALLOCATED(u1%BladeRootMotion)) THEN + do i1 = lbound(u_out%BladeRootMotion,1),ubound(u_out%BladeRootMotion,1) + CALL MeshExtrapInterp1(u1%BladeRootMotion(i1), u2%BladeRootMotion(i1), tin, u_out%BladeRootMotion(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + IF (ALLOCATED(u_out%BladeMotion) .AND. ALLOCATED(u1%BladeMotion)) THEN + do i1 = lbound(u_out%BladeMotion,1),ubound(u_out%BladeMotion,1) + CALL MeshExtrapInterp1(u1%BladeMotion(i1), u2%BladeMotion(i1), tin, u_out%BladeMotion(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated +END SUBROUTINE + +SUBROUTINE ExtLd_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(ExtLd_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 > t3 + TYPE(ExtLd_InputType), INTENT(INOUT) :: u2 ! Input at t2 > t3 + TYPE(ExtLd_InputType), INTENT(INOUT) :: u3 ! Input at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs + TYPE(ExtLd_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) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'ExtLd_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 + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + CALL ExtLdDX_Input_ExtrapInterp2( u1%DX_u, u2%DX_u, u3%DX_u, tin, u_out%DX_u, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + u_out%az = a1*u1%az + a2*u2%az + a3*u3%az + CALL MeshExtrapInterp2(u1%TowerMotion, u2%TowerMotion, u3%TowerMotion, tin, u_out%TowerMotion, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp2(u1%HubMotion, u2%HubMotion, u3%HubMotion, tin, u_out%HubMotion, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp2(u1%NacelleMotion, u2%NacelleMotion, u3%NacelleMotion, tin, u_out%NacelleMotion, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ALLOCATED(u_out%BladeRootMotion) .AND. ALLOCATED(u1%BladeRootMotion)) THEN + do i1 = lbound(u_out%BladeRootMotion,1),ubound(u_out%BladeRootMotion,1) + CALL MeshExtrapInterp2(u1%BladeRootMotion(i1), u2%BladeRootMotion(i1), u3%BladeRootMotion(i1), tin, u_out%BladeRootMotion(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + IF (ALLOCATED(u_out%BladeMotion) .AND. ALLOCATED(u1%BladeMotion)) THEN + do i1 = lbound(u_out%BladeMotion,1),ubound(u_out%BladeMotion,1) + CALL MeshExtrapInterp2(u1%BladeMotion(i1), u2%BladeMotion(i1), u3%BladeMotion(i1), tin, u_out%BladeMotion(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated +END SUBROUTINE + +subroutine ExtLd_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(ExtLd_OutputType), intent(inout) :: y(:) ! Output at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Outputs + type(ExtLd_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 = 'ExtLd_Output_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(y)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(y)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(y) - 1 + select case (order) + case (0) + call ExtLd_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call ExtLd_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call ExtLd_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(y) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE ExtLd_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(ExtLd_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 + TYPE(ExtLd_OutputType), INTENT(INOUT) :: y2 ! Output at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs + TYPE(ExtLd_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 = 'ExtLd_Output_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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 + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + CALL ExtLdDX_Output_ExtrapInterp1( y1%DX_y, y2%DX_y, tin, y_out%DX_y, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp1(y1%TowerLoad, y2%TowerLoad, tin, y_out%TowerLoad, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ALLOCATED(y_out%BladeLoad) .AND. ALLOCATED(y1%BladeLoad)) THEN + do i1 = lbound(y_out%BladeLoad,1),ubound(y_out%BladeLoad,1) + CALL MeshExtrapInterp1(y1%BladeLoad(i1), y2%BladeLoad(i1), tin, y_out%BladeLoad(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + CALL MeshExtrapInterp1(y1%TowerLoadAD, y2%TowerLoadAD, tin, y_out%TowerLoadAD, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ALLOCATED(y_out%BladeLoadAD) .AND. ALLOCATED(y1%BladeLoadAD)) THEN + do i1 = lbound(y_out%BladeLoadAD,1),ubound(y_out%BladeLoadAD,1) + CALL MeshExtrapInterp1(y1%BladeLoadAD(i1), y2%BladeLoadAD(i1), tin, y_out%BladeLoadAD(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated +END SUBROUTINE + +SUBROUTINE ExtLd_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(ExtLd_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 > t3 + TYPE(ExtLd_OutputType), INTENT(INOUT) :: y2 ! Output at t2 > t3 + TYPE(ExtLd_OutputType), INTENT(INOUT) :: y3 ! Output at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs + TYPE(ExtLd_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) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'ExtLd_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 + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + CALL ExtLdDX_Output_ExtrapInterp2( y1%DX_y, y2%DX_y, y3%DX_y, tin, y_out%DX_y, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp2(y1%TowerLoad, y2%TowerLoad, y3%TowerLoad, tin, y_out%TowerLoad, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ALLOCATED(y_out%BladeLoad) .AND. ALLOCATED(y1%BladeLoad)) THEN + do i1 = lbound(y_out%BladeLoad,1),ubound(y_out%BladeLoad,1) + CALL MeshExtrapInterp2(y1%BladeLoad(i1), y2%BladeLoad(i1), y3%BladeLoad(i1), tin, y_out%BladeLoad(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + CALL MeshExtrapInterp2(y1%TowerLoadAD, y2%TowerLoadAD, y3%TowerLoadAD, tin, y_out%TowerLoadAD, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ALLOCATED(y_out%BladeLoadAD) .AND. ALLOCATED(y1%BladeLoadAD)) THEN + do i1 = lbound(y_out%BladeLoadAD,1),ubound(y_out%BladeLoadAD,1) + CALL MeshExtrapInterp2(y1%BladeLoadAD(i1), y2%BladeLoadAD(i1), y3%BladeLoadAD(i1), tin, y_out%BladeLoadAD(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated +END SUBROUTINE +END MODULE ExtLoads_Types +!ENDOFREGISTRYGENERATEDFILE diff --git a/modules/extptfm/CMakeLists.txt b/modules/extptfm/CMakeLists.txt index 4eb338ffbc..a9f7fd0c3a 100644 --- a/modules/extptfm/CMakeLists.txt +++ b/modules/extptfm/CMakeLists.txt @@ -18,7 +18,7 @@ if (GENERATE_TYPES) generate_f90_types(src/ExtPtfm_MCKF_Registry.txt ${CMAKE_CURRENT_LIST_DIR}/src/ExtPtfm_MCKF_Types.f90) endif() -add_library(extptfm_mckflib +add_library(extptfm_mckflib STATIC src/ExtPtfm_MCKF.f90 src/ExtPtfm_MCKF_IO.f90 src/ExtPtfm_MCKF_Types.f90 diff --git a/modules/extptfm/src/ExtPtfm_MCKF_Types.f90 b/modules/extptfm/src/ExtPtfm_MCKF_Types.f90 index 68f463e0ff..40c63127cb 100644 --- a/modules/extptfm/src/ExtPtfm_MCKF_Types.f90 +++ b/modules/extptfm/src/ExtPtfm_MCKF_Types.f90 @@ -37,27 +37,27 @@ MODULE ExtPtfm_MCKF_Types TYPE, PUBLIC :: ExtPtfm_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. [-] - REAL(ReKi) :: PtfmRefzt !< Vertical distance from the ground level [onshore], MSL [offshore wind or floating MHK], or seabed [fixed MHK] to the platform reference point [meters] + REAL(ReKi) :: PtfmRefzt = 0.0_ReKi !< Vertical distance from the ground level [onshore], MSL [offshore wind or floating MHK], or seabed [fixed MHK] to the platform reference point [meters] CHARACTER(1024) :: RootName !< RootName for writing output files [-] END TYPE ExtPtfm_InitInputType ! ======================= ! ========= ExtPtfm_InputFile ======= TYPE, PUBLIC :: ExtPtfm_InputFile - REAL(DbKi) :: DT !< Requested integration time for ElastoDyn [seconds] - INTEGER(IntKi) :: IntMethod !< Integration Method (1=RK4, 2=AB4, 3=ABM4) [-] - INTEGER(IntKi) :: FileFormat !< File format switch [-] + REAL(DbKi) :: DT = 0.0_R8Ki !< Requested integration time for ElastoDyn [seconds] + INTEGER(IntKi) :: IntMethod = 0_IntKi !< Integration Method (1=RK4, 2=AB4, 3=ABM4) [-] + INTEGER(IntKi) :: FileFormat = 0_IntKi !< File format switch [-] CHARACTER(1024) :: RedFile !< File containing reduction inputs [-] CHARACTER(1024) :: RedFileCst !< File containing constant reduction inputs [-] - LOGICAL :: EquilStart !< Flag to determine the equilibrium positions of the CB modes at initialization (first call) [-] + LOGICAL :: EquilStart = .false. !< Flag to determine the equilibrium positions of the CB modes at initialization (first call) [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: ActiveCBDOF !< List of active CB DOF [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: InitPosList !< Initial positions of the CB DOFs [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: InitVelList !< Initial velocities of the CB DOFs [-] - 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 !< Flag to cause tab-delimited text output (delimited by space otherwise) [-] + LOGICAL :: SumPrint = .false. !< Print summary data to .sum [-] + INTEGER(IntKi) :: OutFile = 0_IntKi !< 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 = .false. !< Flag to cause tab-delimited text output (delimited by space otherwise) [-] CHARACTER(20) :: OutFmt !< Format used for module's text tabular output (except time); resulting field should be 10 characters [-] - REAL(DbKi) :: Tstart !< Time to start module's tabular output [seconds] - INTEGER(IntKi) :: NumOuts !< Number of parameters in the output list (number of outputs requested) [-] + REAL(DbKi) :: Tstart = 0.0_R8Ki !< Time to start module's tabular output [seconds] + INTEGER(IntKi) :: NumOuts = 0_IntKi !< Number of parameters in the output list (number of outputs requested) [-] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: OutList !< List of user-requested output channels [-] END TYPE ExtPtfm_InputFile ! ======================= @@ -84,27 +84,27 @@ MODULE ExtPtfm_MCKF_Types ! ======================= ! ========= ExtPtfm_DiscreteStateType ======= TYPE, PUBLIC :: ExtPtfm_DiscreteStateType - REAL(ReKi) :: DummyDiscState !< Remove this variable if you have discrete states [-] + REAL(ReKi) :: DummyDiscState = 0.0_ReKi !< Remove this variable if you have discrete states [-] END TYPE ExtPtfm_DiscreteStateType ! ======================= ! ========= ExtPtfm_ConstraintStateType ======= TYPE, PUBLIC :: ExtPtfm_ConstraintStateType - REAL(ReKi) :: DummyConstrState !< Remove this variable if you have constraint states [-] + REAL(ReKi) :: DummyConstrState = 0.0_ReKi !< Remove this variable if you have constraint states [-] END TYPE ExtPtfm_ConstraintStateType ! ======================= ! ========= ExtPtfm_OtherStateType ======= TYPE, PUBLIC :: ExtPtfm_OtherStateType TYPE(ExtPtfm_ContinuousStateType) , DIMENSION(:), ALLOCATABLE :: xdot !< Previous state derivs for m-step time integrator [-] - INTEGER(IntKi) :: n !< Tracks time step for which OtherState was updated last [-] + INTEGER(IntKi) :: n = 0_IntKi !< Tracks time step for which OtherState was updated last [-] END TYPE ExtPtfm_OtherStateType ! ======================= ! ========= ExtPtfm_MiscVarType ======= TYPE, PUBLIC :: ExtPtfm_MiscVarType REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: xFlat !< Flattened vector of states [-] - REAL(ReKi) , DIMENSION(1:18) :: uFlat !< Flattened vector of inputs [-] + REAL(ReKi) , DIMENSION(1:18) :: uFlat = 0.0_ReKi !< Flattened vector of inputs [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: F_at_t !< The 6 interface loads and Craig-Bampton loads at t (force and moment acting at the platform reference (no added-mass effects); positive forces are in the direction of motion). [N, N-m] - INTEGER(IntKi) :: Indx !< Index into times, to speed up interpolation [-] - LOGICAL :: EquilStart !< Flag to determine the equilibrium position of the CB DOF at initialization (first call) [-] + INTEGER(IntKi) :: Indx = 0_IntKi !< Index into times, to speed up interpolation [-] + LOGICAL :: EquilStart = .false. !< Flag to determine the equilibrium position of the CB DOF at initialization (first call) [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: AllOuts !< An array holding the value of all of the calculated (not only selected) output channels [see OutListParameters.xlsx spreadsheet] END TYPE ExtPtfm_MiscVarType ! ======================= @@ -131,13 +131,13 @@ MODULE ExtPtfm_MCKF_Types REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: C12 !< Matrix C12 [] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: C22 !< Matrix C22 [] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: C21 !< Matrix C21 [] - REAL(DbKi) :: EP_DeltaT !< Time step (for integration of continuous states) [seconds] - INTEGER(IntKi) :: nTimeSteps !< Number of values of Forces and times [-] - INTEGER(IntKi) :: nCB !< Number of CraigBampton modes active [-] - INTEGER(IntKi) :: nCBFull !< Totla number of CraigBampton modes given as input [-] - INTEGER(IntKi) :: nTot !< Total number of debrees of freedom (CB + interface) [-] - INTEGER(IntKi) :: NumOuts !< Number of values in WriteOutput [-] - INTEGER(IntKi) :: IntMethod !< Integration Method (1=RK4, 2=AB4, 3=ABM4) [-] + REAL(DbKi) :: EP_DeltaT = 0.0_R8Ki !< Time step (for integration of continuous states) [seconds] + INTEGER(IntKi) :: nTimeSteps = 0_IntKi !< Number of values of Forces and times [-] + INTEGER(IntKi) :: nCB = 0_IntKi !< Number of CraigBampton modes active [-] + INTEGER(IntKi) :: nCBFull = 0_IntKi !< Totla number of CraigBampton modes given as input [-] + INTEGER(IntKi) :: nTot = 0_IntKi !< Total number of debrees of freedom (CB + interface) [-] + INTEGER(IntKi) :: NumOuts = 0_IntKi !< Number of values in WriteOutput [-] + INTEGER(IntKi) :: IntMethod = 0_IntKi !< Integration Method (1=RK4, 2=AB4, 3=ABM4) [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: ActiveCBDOF !< List of active CB DOF [-] TYPE(OutParmType) , DIMENSION(:), ALLOCATABLE :: OutParam !< Names and units (and other characteristics) of all requested output parameters [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: OutParamLinIndx !< Index into WriteOutput for linearization analysis [-] @@ -155,4812 +155,1441 @@ MODULE ExtPtfm_MCKF_Types END TYPE ExtPtfm_OutputType ! ======================= CONTAINS - SUBROUTINE ExtPtfm_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ExtPtfm_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(ExtPtfm_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 = 'ExtPtfm_CopyInitInput' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInitInputData%InputFile = SrcInitInputData%InputFile - DstInitInputData%Linearize = SrcInitInputData%Linearize - DstInitInputData%PtfmRefzt = SrcInitInputData%PtfmRefzt - DstInitInputData%RootName = SrcInitInputData%RootName - END SUBROUTINE ExtPtfm_CopyInitInput - - SUBROUTINE ExtPtfm_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(ExtPtfm_InitInputType), INTENT(INOUT) :: InitInputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_DestroyInitInput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE ExtPtfm_DestroyInitInput - - SUBROUTINE ExtPtfm_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(ExtPtfm_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 = 'ExtPtfm_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 - Re_BufSz = Re_BufSz + 1 ! PtfmRefzt - Int_BufSz = Int_BufSz + 1*LEN(InData%RootName) ! RootName - 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 - ReKiBuf(Re_Xferred) = InData%PtfmRefzt - Re_Xferred = Re_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 - END SUBROUTINE ExtPtfm_PackInitInput - - SUBROUTINE ExtPtfm_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(ExtPtfm_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 = 'ExtPtfm_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%PtfmRefzt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END SUBROUTINE ExtPtfm_UnPackInitInput - SUBROUTINE ExtPtfm_CopyInputFile( SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ExtPtfm_InputFile), INTENT(IN) :: SrcInputFileData - TYPE(ExtPtfm_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 = 'ExtPtfm_CopyInputFile' -! +subroutine ExtPtfm_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) + type(ExtPtfm_InitInputType), intent(in) :: SrcInitInputData + type(ExtPtfm_InitInputType), intent(inout) :: DstInitInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'ExtPtfm_CopyInitInput' ErrStat = ErrID_None - ErrMsg = "" - DstInputFileData%DT = SrcInputFileData%DT - DstInputFileData%IntMethod = SrcInputFileData%IntMethod - DstInputFileData%FileFormat = SrcInputFileData%FileFormat - DstInputFileData%RedFile = SrcInputFileData%RedFile - DstInputFileData%RedFileCst = SrcInputFileData%RedFileCst - DstInputFileData%EquilStart = SrcInputFileData%EquilStart -IF (ALLOCATED(SrcInputFileData%ActiveCBDOF)) THEN - i1_l = LBOUND(SrcInputFileData%ActiveCBDOF,1) - i1_u = UBOUND(SrcInputFileData%ActiveCBDOF,1) - IF (.NOT. ALLOCATED(DstInputFileData%ActiveCBDOF)) THEN - ALLOCATE(DstInputFileData%ActiveCBDOF(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%ActiveCBDOF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%ActiveCBDOF = SrcInputFileData%ActiveCBDOF -ENDIF -IF (ALLOCATED(SrcInputFileData%InitPosList)) THEN - i1_l = LBOUND(SrcInputFileData%InitPosList,1) - i1_u = UBOUND(SrcInputFileData%InitPosList,1) - IF (.NOT. ALLOCATED(DstInputFileData%InitPosList)) THEN - ALLOCATE(DstInputFileData%InitPosList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%InitPosList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%InitPosList = SrcInputFileData%InitPosList -ENDIF -IF (ALLOCATED(SrcInputFileData%InitVelList)) THEN - i1_l = LBOUND(SrcInputFileData%InitVelList,1) - i1_u = UBOUND(SrcInputFileData%InitVelList,1) - IF (.NOT. ALLOCATED(DstInputFileData%InitVelList)) THEN - ALLOCATE(DstInputFileData%InitVelList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%InitVelList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%InitVelList = SrcInputFileData%InitVelList -ENDIF - 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 - END SUBROUTINE ExtPtfm_CopyInputFile - - SUBROUTINE ExtPtfm_DestroyInputFile( InputFileData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(ExtPtfm_InputFile), INTENT(INOUT) :: InputFileData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_DestroyInputFile' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(InputFileData%ActiveCBDOF)) THEN - DEALLOCATE(InputFileData%ActiveCBDOF) -ENDIF -IF (ALLOCATED(InputFileData%InitPosList)) THEN - DEALLOCATE(InputFileData%InitPosList) -ENDIF -IF (ALLOCATED(InputFileData%InitVelList)) THEN - DEALLOCATE(InputFileData%InitVelList) -ENDIF -IF (ALLOCATED(InputFileData%OutList)) THEN - DEALLOCATE(InputFileData%OutList) -ENDIF - END SUBROUTINE ExtPtfm_DestroyInputFile - - SUBROUTINE ExtPtfm_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(ExtPtfm_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 = 'ExtPtfm_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 ! IntMethod - Int_BufSz = Int_BufSz + 1 ! FileFormat - Int_BufSz = Int_BufSz + 1*LEN(InData%RedFile) ! RedFile - Int_BufSz = Int_BufSz + 1*LEN(InData%RedFileCst) ! RedFileCst - Int_BufSz = Int_BufSz + 1 ! EquilStart - Int_BufSz = Int_BufSz + 1 ! ActiveCBDOF allocated yes/no - IF ( ALLOCATED(InData%ActiveCBDOF) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ActiveCBDOF upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%ActiveCBDOF) ! ActiveCBDOF - END IF - Int_BufSz = Int_BufSz + 1 ! InitPosList allocated yes/no - IF ( ALLOCATED(InData%InitPosList) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! InitPosList upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%InitPosList) ! InitPosList - END IF - Int_BufSz = Int_BufSz + 1 ! InitVelList allocated yes/no - IF ( ALLOCATED(InData%InitVelList) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! InitVelList upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%InitVelList) ! InitVelList - END IF - 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 - 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) = InData%IntMethod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%FileFormat - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%RedFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%RedFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%RedFileCst) - IntKiBuf(Int_Xferred) = ICHAR(InData%RedFileCst(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = TRANSFER(InData%EquilStart, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%ActiveCBDOF) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ActiveCBDOF,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ActiveCBDOF,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ActiveCBDOF,1), UBOUND(InData%ActiveCBDOF,1) - IntKiBuf(Int_Xferred) = InData%ActiveCBDOF(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%InitPosList) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InitPosList,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InitPosList,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%InitPosList,1), UBOUND(InData%InitPosList,1) - ReKiBuf(Re_Xferred) = InData%InitPosList(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%InitVelList) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InitVelList,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InitVelList,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%InitVelList,1), UBOUND(InData%InitVelList,1) - ReKiBuf(Re_Xferred) = InData%InitVelList(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - 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 - END SUBROUTINE ExtPtfm_PackInputFile - - SUBROUTINE ExtPtfm_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(ExtPtfm_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 = 'ExtPtfm_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%IntMethod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%FileFormat = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%RedFile) - OutData%RedFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%RedFileCst) - OutData%RedFileCst(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%EquilStart = TRANSFER(IntKiBuf(Int_Xferred), OutData%EquilStart) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ActiveCBDOF not allocated - Int_Xferred = Int_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%ActiveCBDOF)) DEALLOCATE(OutData%ActiveCBDOF) - ALLOCATE(OutData%ActiveCBDOF(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ActiveCBDOF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ActiveCBDOF,1), UBOUND(OutData%ActiveCBDOF,1) - OutData%ActiveCBDOF(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InitPosList not allocated - Int_Xferred = Int_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%InitPosList)) DEALLOCATE(OutData%InitPosList) - ALLOCATE(OutData%InitPosList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InitPosList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%InitPosList,1), UBOUND(OutData%InitPosList,1) - OutData%InitPosList(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InitVelList not allocated - Int_Xferred = Int_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%InitVelList)) DEALLOCATE(OutData%InitVelList) - ALLOCATE(OutData%InitVelList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InitVelList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%InitVelList,1), UBOUND(OutData%InitVelList,1) - OutData%InitVelList(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - 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 - END SUBROUTINE ExtPtfm_UnPackInputFile - - SUBROUTINE ExtPtfm_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ExtPtfm_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(ExtPtfm_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 = 'ExtPtfm_CopyInitOutput' -! + ErrMsg = '' + DstInitInputData%InputFile = SrcInitInputData%InputFile + DstInitInputData%Linearize = SrcInitInputData%Linearize + DstInitInputData%PtfmRefzt = SrcInitInputData%PtfmRefzt + DstInitInputData%RootName = SrcInitInputData%RootName +end subroutine + +subroutine ExtPtfm_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(ExtPtfm_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'ExtPtfm_DestroyInitInput' 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 -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 ExtPtfm_CopyInitOutput - - SUBROUTINE ExtPtfm_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(ExtPtfm_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_DestroyInitOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL NWTC_Library_Destroyprogdesc( InitOutputData%Ver, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(InitOutputData%WriteOutputHdr)) THEN - DEALLOCATE(InitOutputData%WriteOutputHdr) -ENDIF -IF (ALLOCATED(InitOutputData%WriteOutputUnt)) THEN - DEALLOCATE(InitOutputData%WriteOutputUnt) -ENDIF -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 ExtPtfm_DestroyInitOutput - - SUBROUTINE ExtPtfm_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(ExtPtfm_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 = 'ExtPtfm_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 - 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 - - 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 - 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 ExtPtfm_PackInitOutput - - SUBROUTINE ExtPtfm_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(ExtPtfm_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 = 'ExtPtfm_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 - 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 ExtPtfm_UnPackInitOutput - - SUBROUTINE ExtPtfm_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ExtPtfm_ContinuousStateType), INTENT(IN) :: SrcContStateData - TYPE(ExtPtfm_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 = 'ExtPtfm_CopyContState' -! + ErrMsg = '' +end subroutine + +subroutine ExtPtfm_PackInitInput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(ExtPtfm_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ExtPtfm_PackInitInput' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%InputFile) + call RegPack(RF, InData%Linearize) + call RegPack(RF, InData%PtfmRefzt) + call RegPack(RF, InData%RootName) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ExtPtfm_UnPackInitInput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(ExtPtfm_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ExtPtfm_UnPackInitInput' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%InputFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Linearize); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PtfmRefzt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RootName); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ExtPtfm_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg) + type(ExtPtfm_InputFile), intent(in) :: SrcInputFileData + type(ExtPtfm_InputFile), intent(inout) :: DstInputFileData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'ExtPtfm_CopyInputFile' 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 ExtPtfm_CopyContState - - SUBROUTINE ExtPtfm_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(ExtPtfm_ContinuousStateType), INTENT(INOUT) :: ContStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_DestroyContState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(ContStateData%qm)) THEN - DEALLOCATE(ContStateData%qm) -ENDIF -IF (ALLOCATED(ContStateData%qmdot)) THEN - DEALLOCATE(ContStateData%qmdot) -ENDIF - END SUBROUTINE ExtPtfm_DestroyContState - - SUBROUTINE ExtPtfm_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(ExtPtfm_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 = 'ExtPtfm_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 - Re_BufSz = Re_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 - Re_BufSz = Re_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) - ReKiBuf(Re_Xferred) = InData%qm(i1) - Re_Xferred = Re_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) - ReKiBuf(Re_Xferred) = InData%qmdot(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE ExtPtfm_PackContState - - SUBROUTINE ExtPtfm_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(ExtPtfm_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 = 'ExtPtfm_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) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_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) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE ExtPtfm_UnPackContState - - SUBROUTINE ExtPtfm_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ExtPtfm_DiscreteStateType), INTENT(IN) :: SrcDiscStateData - TYPE(ExtPtfm_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 = 'ExtPtfm_CopyDiscState' -! + ErrMsg = '' + DstInputFileData%DT = SrcInputFileData%DT + DstInputFileData%IntMethod = SrcInputFileData%IntMethod + DstInputFileData%FileFormat = SrcInputFileData%FileFormat + DstInputFileData%RedFile = SrcInputFileData%RedFile + DstInputFileData%RedFileCst = SrcInputFileData%RedFileCst + DstInputFileData%EquilStart = SrcInputFileData%EquilStart + if (allocated(SrcInputFileData%ActiveCBDOF)) then + LB(1:1) = lbound(SrcInputFileData%ActiveCBDOF) + UB(1:1) = ubound(SrcInputFileData%ActiveCBDOF) + if (.not. allocated(DstInputFileData%ActiveCBDOF)) then + allocate(DstInputFileData%ActiveCBDOF(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%ActiveCBDOF.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%ActiveCBDOF = SrcInputFileData%ActiveCBDOF + end if + if (allocated(SrcInputFileData%InitPosList)) then + LB(1:1) = lbound(SrcInputFileData%InitPosList) + UB(1:1) = ubound(SrcInputFileData%InitPosList) + if (.not. allocated(DstInputFileData%InitPosList)) then + allocate(DstInputFileData%InitPosList(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%InitPosList.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%InitPosList = SrcInputFileData%InitPosList + end if + if (allocated(SrcInputFileData%InitVelList)) then + LB(1:1) = lbound(SrcInputFileData%InitVelList) + UB(1:1) = ubound(SrcInputFileData%InitVelList) + if (.not. allocated(DstInputFileData%InitVelList)) then + allocate(DstInputFileData%InitVelList(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%InitVelList.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%InitVelList = SrcInputFileData%InitVelList + end if + 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 + LB(1:1) = lbound(SrcInputFileData%OutList) + UB(1:1) = ubound(SrcInputFileData%OutList) + if (.not. allocated(DstInputFileData%OutList)) then + allocate(DstInputFileData%OutList(LB(1):UB(1)), 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 + end if +end subroutine + +subroutine ExtPtfm_DestroyInputFile(InputFileData, ErrStat, ErrMsg) + type(ExtPtfm_InputFile), intent(inout) :: InputFileData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'ExtPtfm_DestroyInputFile' ErrStat = ErrID_None - ErrMsg = "" - DstDiscStateData%DummyDiscState = SrcDiscStateData%DummyDiscState - END SUBROUTINE ExtPtfm_CopyDiscState - - SUBROUTINE ExtPtfm_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(ExtPtfm_DiscreteStateType), INTENT(INOUT) :: DiscStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_DestroyDiscState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE ExtPtfm_DestroyDiscState - - SUBROUTINE ExtPtfm_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(ExtPtfm_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 = 'ExtPtfm_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 ExtPtfm_PackDiscState - - SUBROUTINE ExtPtfm_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(ExtPtfm_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 = 'ExtPtfm_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 ExtPtfm_UnPackDiscState - - SUBROUTINE ExtPtfm_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ExtPtfm_ConstraintStateType), INTENT(IN) :: SrcConstrStateData - TYPE(ExtPtfm_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 = 'ExtPtfm_CopyConstrState' -! + ErrMsg = '' + if (allocated(InputFileData%ActiveCBDOF)) then + deallocate(InputFileData%ActiveCBDOF) + end if + if (allocated(InputFileData%InitPosList)) then + deallocate(InputFileData%InitPosList) + end if + if (allocated(InputFileData%InitVelList)) then + deallocate(InputFileData%InitVelList) + end if + if (allocated(InputFileData%OutList)) then + deallocate(InputFileData%OutList) + end if +end subroutine + +subroutine ExtPtfm_PackInputFile(RF, Indata) + type(RegFile), intent(inout) :: RF + type(ExtPtfm_InputFile), intent(in) :: InData + character(*), parameter :: RoutineName = 'ExtPtfm_PackInputFile' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DT) + call RegPack(RF, InData%IntMethod) + call RegPack(RF, InData%FileFormat) + call RegPack(RF, InData%RedFile) + call RegPack(RF, InData%RedFileCst) + call RegPack(RF, InData%EquilStart) + call RegPackAlloc(RF, InData%ActiveCBDOF) + call RegPackAlloc(RF, InData%InitPosList) + call RegPackAlloc(RF, InData%InitVelList) + call RegPack(RF, InData%SumPrint) + call RegPack(RF, InData%OutFile) + call RegPack(RF, InData%TabDelim) + call RegPack(RF, InData%OutFmt) + call RegPack(RF, InData%Tstart) + call RegPack(RF, InData%NumOuts) + call RegPackAlloc(RF, InData%OutList) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ExtPtfm_UnPackInputFile(RF, OutData) + type(RegFile), intent(inout) :: RF + type(ExtPtfm_InputFile), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ExtPtfm_UnPackInputFile' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%IntMethod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FileFormat); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RedFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RedFileCst); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%EquilStart); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ActiveCBDOF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%InitPosList); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%InitVelList); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SumPrint); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TabDelim); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutFmt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Tstart); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumOuts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%OutList); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ExtPtfm_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) + type(ExtPtfm_InitOutputType), intent(in) :: SrcInitOutputData + type(ExtPtfm_InitOutputType), intent(inout) :: DstInitOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ExtPtfm_CopyInitOutput' ErrStat = ErrID_None - ErrMsg = "" - DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState - END SUBROUTINE ExtPtfm_CopyConstrState - - SUBROUTINE ExtPtfm_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(ExtPtfm_ConstraintStateType), INTENT(INOUT) :: ConstrStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_DestroyConstrState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE ExtPtfm_DestroyConstrState - - SUBROUTINE ExtPtfm_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(ExtPtfm_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 = 'ExtPtfm_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 ExtPtfm_PackConstrState - - SUBROUTINE ExtPtfm_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(ExtPtfm_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 = 'ExtPtfm_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 ExtPtfm_UnPackConstrState - - SUBROUTINE ExtPtfm_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ExtPtfm_OtherStateType), INTENT(IN) :: SrcOtherStateData - TYPE(ExtPtfm_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 = 'ExtPtfm_CopyOtherState' -! + 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 + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) + if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then + allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitOutputData%WriteOutputUnt)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) + if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then + allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitOutputData%LinNames_y)) then + LB(1:1) = lbound(SrcInitOutputData%LinNames_y) + UB(1:1) = ubound(SrcInitOutputData%LinNames_y) + if (.not. allocated(DstInitOutputData%LinNames_y)) then + allocate(DstInitOutputData%LinNames_y(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitOutputData%LinNames_x)) then + LB(1:1) = lbound(SrcInitOutputData%LinNames_x) + UB(1:1) = ubound(SrcInitOutputData%LinNames_x) + if (.not. allocated(DstInitOutputData%LinNames_x)) then + allocate(DstInitOutputData%LinNames_x(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitOutputData%LinNames_u)) then + LB(1:1) = lbound(SrcInitOutputData%LinNames_u) + UB(1:1) = ubound(SrcInitOutputData%LinNames_u) + if (.not. allocated(DstInitOutputData%LinNames_u)) then + allocate(DstInitOutputData%LinNames_u(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitOutputData%RotFrame_y)) then + LB(1:1) = lbound(SrcInitOutputData%RotFrame_y) + UB(1:1) = ubound(SrcInitOutputData%RotFrame_y) + if (.not. allocated(DstInitOutputData%RotFrame_y)) then + allocate(DstInitOutputData%RotFrame_y(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitOutputData%RotFrame_x)) then + LB(1:1) = lbound(SrcInitOutputData%RotFrame_x) + UB(1:1) = ubound(SrcInitOutputData%RotFrame_x) + if (.not. allocated(DstInitOutputData%RotFrame_x)) then + allocate(DstInitOutputData%RotFrame_x(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitOutputData%RotFrame_u)) then + LB(1:1) = lbound(SrcInitOutputData%RotFrame_u) + UB(1:1) = ubound(SrcInitOutputData%RotFrame_u) + if (.not. allocated(DstInitOutputData%RotFrame_u)) then + allocate(DstInitOutputData%RotFrame_u(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitOutputData%IsLoad_u)) then + LB(1:1) = lbound(SrcInitOutputData%IsLoad_u) + UB(1:1) = ubound(SrcInitOutputData%IsLoad_u) + if (.not. allocated(DstInitOutputData%IsLoad_u)) then + allocate(DstInitOutputData%IsLoad_u(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitOutputData%DerivOrder_x)) then + LB(1:1) = lbound(SrcInitOutputData%DerivOrder_x) + UB(1:1) = ubound(SrcInitOutputData%DerivOrder_x) + if (.not. allocated(DstInitOutputData%DerivOrder_x)) then + allocate(DstInitOutputData%DerivOrder_x(LB(1):UB(1)), 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 + end if +end subroutine + +subroutine ExtPtfm_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(ExtPtfm_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ExtPtfm_DestroyInitOutput' 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 ExtPtfm_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 ExtPtfm_CopyOtherState - - SUBROUTINE ExtPtfm_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(ExtPtfm_OtherStateType), INTENT(INOUT) :: OtherStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_DestroyOtherState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(OtherStateData%xdot)) THEN -DO i1 = LBOUND(OtherStateData%xdot,1), UBOUND(OtherStateData%xdot,1) - CALL ExtPtfm_DestroyContState( OtherStateData%xdot(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(OtherStateData%xdot) -ENDIF - END SUBROUTINE ExtPtfm_DestroyOtherState - - SUBROUTINE ExtPtfm_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(ExtPtfm_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 = 'ExtPtfm_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 ExtPtfm_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 ExtPtfm_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 ExtPtfm_PackOtherState - - SUBROUTINE ExtPtfm_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(ExtPtfm_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 = 'ExtPtfm_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 ExtPtfm_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 ExtPtfm_UnPackOtherState - - SUBROUTINE ExtPtfm_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ExtPtfm_MiscVarType), INTENT(IN) :: SrcMiscData - TYPE(ExtPtfm_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 = 'ExtPtfm_CopyMisc' -! + ErrMsg = '' + call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(InitOutputData%WriteOutputHdr)) then + deallocate(InitOutputData%WriteOutputHdr) + end if + if (allocated(InitOutputData%WriteOutputUnt)) then + deallocate(InitOutputData%WriteOutputUnt) + end if + if (allocated(InitOutputData%LinNames_y)) then + deallocate(InitOutputData%LinNames_y) + end if + if (allocated(InitOutputData%LinNames_x)) then + deallocate(InitOutputData%LinNames_x) + end if + if (allocated(InitOutputData%LinNames_u)) then + deallocate(InitOutputData%LinNames_u) + end if + if (allocated(InitOutputData%RotFrame_y)) then + deallocate(InitOutputData%RotFrame_y) + end if + if (allocated(InitOutputData%RotFrame_x)) then + deallocate(InitOutputData%RotFrame_x) + end if + if (allocated(InitOutputData%RotFrame_u)) then + deallocate(InitOutputData%RotFrame_u) + end if + if (allocated(InitOutputData%IsLoad_u)) then + deallocate(InitOutputData%IsLoad_u) + end if + if (allocated(InitOutputData%DerivOrder_x)) then + deallocate(InitOutputData%DerivOrder_x) + end if +end subroutine + +subroutine ExtPtfm_PackInitOutput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(ExtPtfm_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ExtPtfm_PackInitOutput' + if (RF%ErrStat >= AbortErrLev) return + call NWTC_Library_PackProgDesc(RF, InData%Ver) + call RegPackAlloc(RF, InData%WriteOutputHdr) + call RegPackAlloc(RF, InData%WriteOutputUnt) + call RegPackAlloc(RF, InData%LinNames_y) + call RegPackAlloc(RF, InData%LinNames_x) + call RegPackAlloc(RF, InData%LinNames_u) + call RegPackAlloc(RF, InData%RotFrame_y) + call RegPackAlloc(RF, InData%RotFrame_x) + call RegPackAlloc(RF, InData%RotFrame_u) + call RegPackAlloc(RF, InData%IsLoad_u) + call RegPackAlloc(RF, InData%DerivOrder_x) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ExtPtfm_UnPackInitOutput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(ExtPtfm_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ExtPtfm_UnPackInitOutput' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call NWTC_Library_UnpackProgDesc(RF, OutData%Ver) ! Ver + call RegUnpackAlloc(RF, OutData%WriteOutputHdr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WriteOutputUnt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LinNames_y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LinNames_x); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LinNames_u); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%RotFrame_y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%RotFrame_x); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%RotFrame_u); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%IsLoad_u); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%DerivOrder_x); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ExtPtfm_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) + type(ExtPtfm_ContinuousStateType), intent(in) :: SrcContStateData + type(ExtPtfm_ContinuousStateType), intent(inout) :: DstContStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'ExtPtfm_CopyContState' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcMiscData%xFlat)) THEN - i1_l = LBOUND(SrcMiscData%xFlat,1) - i1_u = UBOUND(SrcMiscData%xFlat,1) - IF (.NOT. ALLOCATED(DstMiscData%xFlat)) THEN - ALLOCATE(DstMiscData%xFlat(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%xFlat.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%xFlat = SrcMiscData%xFlat -ENDIF - DstMiscData%uFlat = SrcMiscData%uFlat -IF (ALLOCATED(SrcMiscData%F_at_t)) THEN - i1_l = LBOUND(SrcMiscData%F_at_t,1) - i1_u = UBOUND(SrcMiscData%F_at_t,1) - IF (.NOT. ALLOCATED(DstMiscData%F_at_t)) THEN - ALLOCATE(DstMiscData%F_at_t(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_at_t.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%F_at_t = SrcMiscData%F_at_t -ENDIF - DstMiscData%Indx = SrcMiscData%Indx - DstMiscData%EquilStart = SrcMiscData%EquilStart -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 - END SUBROUTINE ExtPtfm_CopyMisc - - SUBROUTINE ExtPtfm_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(ExtPtfm_MiscVarType), INTENT(INOUT) :: MiscData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_DestroyMisc' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(MiscData%xFlat)) THEN - DEALLOCATE(MiscData%xFlat) -ENDIF -IF (ALLOCATED(MiscData%F_at_t)) THEN - DEALLOCATE(MiscData%F_at_t) -ENDIF -IF (ALLOCATED(MiscData%AllOuts)) THEN - DEALLOCATE(MiscData%AllOuts) -ENDIF - END SUBROUTINE ExtPtfm_DestroyMisc - - SUBROUTINE ExtPtfm_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(ExtPtfm_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 = 'ExtPtfm_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 ! xFlat allocated yes/no - IF ( ALLOCATED(InData%xFlat) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! xFlat upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%xFlat) ! xFlat - END IF - Re_BufSz = Re_BufSz + SIZE(InData%uFlat) ! uFlat - Int_BufSz = Int_BufSz + 1 ! F_at_t allocated yes/no - IF ( ALLOCATED(InData%F_at_t) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! F_at_t upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_at_t) ! F_at_t - END IF - Int_BufSz = Int_BufSz + 1 ! Indx - Int_BufSz = Int_BufSz + 1 ! EquilStart - 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 - 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%xFlat) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%xFlat,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xFlat,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%xFlat,1), UBOUND(InData%xFlat,1) - ReKiBuf(Re_Xferred) = InData%xFlat(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - DO i1 = LBOUND(InData%uFlat,1), UBOUND(InData%uFlat,1) - ReKiBuf(Re_Xferred) = InData%uFlat(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%F_at_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%F_at_t,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_at_t,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%F_at_t,1), UBOUND(InData%F_at_t,1) - ReKiBuf(Re_Xferred) = InData%F_at_t(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%Indx - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%EquilStart, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - 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 - END SUBROUTINE ExtPtfm_PackMisc - - SUBROUTINE ExtPtfm_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(ExtPtfm_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 = 'ExtPtfm_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 ! xFlat not allocated - Int_Xferred = Int_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%xFlat)) DEALLOCATE(OutData%xFlat) - ALLOCATE(OutData%xFlat(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xFlat.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%xFlat,1), UBOUND(OutData%xFlat,1) - OutData%xFlat(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - i1_l = LBOUND(OutData%uFlat,1) - i1_u = UBOUND(OutData%uFlat,1) - DO i1 = LBOUND(OutData%uFlat,1), UBOUND(OutData%uFlat,1) - OutData%uFlat(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_at_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 - IF (ALLOCATED(OutData%F_at_t)) DEALLOCATE(OutData%F_at_t) - ALLOCATE(OutData%F_at_t(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_at_t.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%F_at_t,1), UBOUND(OutData%F_at_t,1) - OutData%F_at_t(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%Indx = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%EquilStart = TRANSFER(IntKiBuf(Int_Xferred), OutData%EquilStart) - Int_Xferred = Int_Xferred + 1 - 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 - END SUBROUTINE ExtPtfm_UnPackMisc - - SUBROUTINE ExtPtfm_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ExtPtfm_ParameterType), INTENT(IN) :: SrcParamData - TYPE(ExtPtfm_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 = 'ExtPtfm_CopyParam' -! + ErrMsg = '' + if (allocated(SrcContStateData%qm)) then + LB(1:1) = lbound(SrcContStateData%qm) + UB(1:1) = ubound(SrcContStateData%qm) + if (.not. allocated(DstContStateData%qm)) then + allocate(DstContStateData%qm(LB(1):UB(1)), 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 + end if + if (allocated(SrcContStateData%qmdot)) then + LB(1:1) = lbound(SrcContStateData%qmdot) + UB(1:1) = ubound(SrcContStateData%qmdot) + if (.not. allocated(DstContStateData%qmdot)) then + allocate(DstContStateData%qmdot(LB(1):UB(1)), 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 + end if +end subroutine + +subroutine ExtPtfm_DestroyContState(ContStateData, ErrStat, ErrMsg) + type(ExtPtfm_ContinuousStateType), intent(inout) :: ContStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'ExtPtfm_DestroyContState' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcParamData%Mass)) THEN - i1_l = LBOUND(SrcParamData%Mass,1) - i1_u = UBOUND(SrcParamData%Mass,1) - i2_l = LBOUND(SrcParamData%Mass,2) - i2_u = UBOUND(SrcParamData%Mass,2) - IF (.NOT. ALLOCATED(DstParamData%Mass)) THEN - ALLOCATE(DstParamData%Mass(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Mass.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Mass = SrcParamData%Mass -ENDIF -IF (ALLOCATED(SrcParamData%Damp)) THEN - i1_l = LBOUND(SrcParamData%Damp,1) - i1_u = UBOUND(SrcParamData%Damp,1) - i2_l = LBOUND(SrcParamData%Damp,2) - i2_u = UBOUND(SrcParamData%Damp,2) - IF (.NOT. ALLOCATED(DstParamData%Damp)) THEN - ALLOCATE(DstParamData%Damp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Damp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Damp = SrcParamData%Damp -ENDIF -IF (ALLOCATED(SrcParamData%Stff)) THEN - i1_l = LBOUND(SrcParamData%Stff,1) - i1_u = UBOUND(SrcParamData%Stff,1) - i2_l = LBOUND(SrcParamData%Stff,2) - i2_u = UBOUND(SrcParamData%Stff,2) - IF (.NOT. ALLOCATED(DstParamData%Stff)) THEN - ALLOCATE(DstParamData%Stff(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Stff.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Stff = SrcParamData%Stff -ENDIF -IF (ALLOCATED(SrcParamData%Forces)) THEN - i1_l = LBOUND(SrcParamData%Forces,1) - i1_u = UBOUND(SrcParamData%Forces,1) - i2_l = LBOUND(SrcParamData%Forces,2) - i2_u = UBOUND(SrcParamData%Forces,2) - IF (.NOT. ALLOCATED(DstParamData%Forces)) THEN - ALLOCATE(DstParamData%Forces(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Forces.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Forces = SrcParamData%Forces -ENDIF -IF (ALLOCATED(SrcParamData%times)) THEN - i1_l = LBOUND(SrcParamData%times,1) - i1_u = UBOUND(SrcParamData%times,1) - IF (.NOT. ALLOCATED(DstParamData%times)) THEN - ALLOCATE(DstParamData%times(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%times.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%times = SrcParamData%times -ENDIF -IF (ALLOCATED(SrcParamData%AMat)) THEN - i1_l = LBOUND(SrcParamData%AMat,1) - i1_u = UBOUND(SrcParamData%AMat,1) - i2_l = LBOUND(SrcParamData%AMat,2) - i2_u = UBOUND(SrcParamData%AMat,2) - IF (.NOT. ALLOCATED(DstParamData%AMat)) THEN - ALLOCATE(DstParamData%AMat(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AMat.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%AMat = SrcParamData%AMat -ENDIF -IF (ALLOCATED(SrcParamData%BMat)) THEN - i1_l = LBOUND(SrcParamData%BMat,1) - i1_u = UBOUND(SrcParamData%BMat,1) - i2_l = LBOUND(SrcParamData%BMat,2) - i2_u = UBOUND(SrcParamData%BMat,2) - IF (.NOT. ALLOCATED(DstParamData%BMat)) THEN - ALLOCATE(DstParamData%BMat(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BMat.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%BMat = SrcParamData%BMat -ENDIF -IF (ALLOCATED(SrcParamData%CMat)) THEN - i1_l = LBOUND(SrcParamData%CMat,1) - i1_u = UBOUND(SrcParamData%CMat,1) - i2_l = LBOUND(SrcParamData%CMat,2) - i2_u = UBOUND(SrcParamData%CMat,2) - IF (.NOT. ALLOCATED(DstParamData%CMat)) THEN - ALLOCATE(DstParamData%CMat(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CMat.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%CMat = SrcParamData%CMat -ENDIF -IF (ALLOCATED(SrcParamData%DMat)) THEN - i1_l = LBOUND(SrcParamData%DMat,1) - i1_u = UBOUND(SrcParamData%DMat,1) - i2_l = LBOUND(SrcParamData%DMat,2) - i2_u = UBOUND(SrcParamData%DMat,2) - IF (.NOT. ALLOCATED(DstParamData%DMat)) THEN - ALLOCATE(DstParamData%DMat(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%DMat.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%DMat = SrcParamData%DMat -ENDIF -IF (ALLOCATED(SrcParamData%FX)) THEN - i1_l = LBOUND(SrcParamData%FX,1) - i1_u = UBOUND(SrcParamData%FX,1) - IF (.NOT. ALLOCATED(DstParamData%FX)) THEN - ALLOCATE(DstParamData%FX(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%FX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%FX = SrcParamData%FX -ENDIF -IF (ALLOCATED(SrcParamData%FY)) THEN - i1_l = LBOUND(SrcParamData%FY,1) - i1_u = UBOUND(SrcParamData%FY,1) - IF (.NOT. ALLOCATED(DstParamData%FY)) THEN - ALLOCATE(DstParamData%FY(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%FY.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%FY = SrcParamData%FY -ENDIF -IF (ALLOCATED(SrcParamData%M11)) THEN - i1_l = LBOUND(SrcParamData%M11,1) - i1_u = UBOUND(SrcParamData%M11,1) - i2_l = LBOUND(SrcParamData%M11,2) - i2_u = UBOUND(SrcParamData%M11,2) - IF (.NOT. ALLOCATED(DstParamData%M11)) THEN - ALLOCATE(DstParamData%M11(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%M11.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%M11 = SrcParamData%M11 -ENDIF -IF (ALLOCATED(SrcParamData%M12)) THEN - i1_l = LBOUND(SrcParamData%M12,1) - i1_u = UBOUND(SrcParamData%M12,1) - i2_l = LBOUND(SrcParamData%M12,2) - i2_u = UBOUND(SrcParamData%M12,2) - IF (.NOT. ALLOCATED(DstParamData%M12)) THEN - ALLOCATE(DstParamData%M12(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%M12.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%M12 = SrcParamData%M12 -ENDIF -IF (ALLOCATED(SrcParamData%M22)) THEN - i1_l = LBOUND(SrcParamData%M22,1) - i1_u = UBOUND(SrcParamData%M22,1) - i2_l = LBOUND(SrcParamData%M22,2) - i2_u = UBOUND(SrcParamData%M22,2) - IF (.NOT. ALLOCATED(DstParamData%M22)) THEN - ALLOCATE(DstParamData%M22(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%M22.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%M22 = SrcParamData%M22 -ENDIF -IF (ALLOCATED(SrcParamData%M21)) THEN - i1_l = LBOUND(SrcParamData%M21,1) - i1_u = UBOUND(SrcParamData%M21,1) - i2_l = LBOUND(SrcParamData%M21,2) - i2_u = UBOUND(SrcParamData%M21,2) - IF (.NOT. ALLOCATED(DstParamData%M21)) THEN - ALLOCATE(DstParamData%M21(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%M21.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%M21 = SrcParamData%M21 -ENDIF -IF (ALLOCATED(SrcParamData%K11)) THEN - i1_l = LBOUND(SrcParamData%K11,1) - i1_u = UBOUND(SrcParamData%K11,1) - i2_l = LBOUND(SrcParamData%K11,2) - i2_u = UBOUND(SrcParamData%K11,2) - IF (.NOT. ALLOCATED(DstParamData%K11)) THEN - ALLOCATE(DstParamData%K11(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%K11.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%K11 = SrcParamData%K11 -ENDIF -IF (ALLOCATED(SrcParamData%K22)) THEN - i1_l = LBOUND(SrcParamData%K22,1) - i1_u = UBOUND(SrcParamData%K22,1) - i2_l = LBOUND(SrcParamData%K22,2) - i2_u = UBOUND(SrcParamData%K22,2) - IF (.NOT. ALLOCATED(DstParamData%K22)) THEN - ALLOCATE(DstParamData%K22(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%K22.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%K22 = SrcParamData%K22 -ENDIF -IF (ALLOCATED(SrcParamData%C11)) THEN - i1_l = LBOUND(SrcParamData%C11,1) - i1_u = UBOUND(SrcParamData%C11,1) - i2_l = LBOUND(SrcParamData%C11,2) - i2_u = UBOUND(SrcParamData%C11,2) - IF (.NOT. ALLOCATED(DstParamData%C11)) THEN - ALLOCATE(DstParamData%C11(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%C11.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%C11 = SrcParamData%C11 -ENDIF -IF (ALLOCATED(SrcParamData%C12)) THEN - i1_l = LBOUND(SrcParamData%C12,1) - i1_u = UBOUND(SrcParamData%C12,1) - i2_l = LBOUND(SrcParamData%C12,2) - i2_u = UBOUND(SrcParamData%C12,2) - IF (.NOT. ALLOCATED(DstParamData%C12)) THEN - ALLOCATE(DstParamData%C12(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%C12.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%C12 = SrcParamData%C12 -ENDIF -IF (ALLOCATED(SrcParamData%C22)) THEN - i1_l = LBOUND(SrcParamData%C22,1) - i1_u = UBOUND(SrcParamData%C22,1) - i2_l = LBOUND(SrcParamData%C22,2) - i2_u = UBOUND(SrcParamData%C22,2) - IF (.NOT. ALLOCATED(DstParamData%C22)) THEN - ALLOCATE(DstParamData%C22(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%C22.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%C22 = SrcParamData%C22 -ENDIF -IF (ALLOCATED(SrcParamData%C21)) THEN - i1_l = LBOUND(SrcParamData%C21,1) - i1_u = UBOUND(SrcParamData%C21,1) - i2_l = LBOUND(SrcParamData%C21,2) - i2_u = UBOUND(SrcParamData%C21,2) - IF (.NOT. ALLOCATED(DstParamData%C21)) THEN - ALLOCATE(DstParamData%C21(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%C21.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%C21 = SrcParamData%C21 -ENDIF - DstParamData%EP_DeltaT = SrcParamData%EP_DeltaT - DstParamData%nTimeSteps = SrcParamData%nTimeSteps - DstParamData%nCB = SrcParamData%nCB - DstParamData%nCBFull = SrcParamData%nCBFull - DstParamData%nTot = SrcParamData%nTot - DstParamData%NumOuts = SrcParamData%NumOuts - DstParamData%IntMethod = SrcParamData%IntMethod -IF (ALLOCATED(SrcParamData%ActiveCBDOF)) THEN - i1_l = LBOUND(SrcParamData%ActiveCBDOF,1) - i1_u = UBOUND(SrcParamData%ActiveCBDOF,1) - IF (.NOT. ALLOCATED(DstParamData%ActiveCBDOF)) THEN - ALLOCATE(DstParamData%ActiveCBDOF(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ActiveCBDOF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%ActiveCBDOF = SrcParamData%ActiveCBDOF -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 -IF (ALLOCATED(SrcParamData%OutParamLinIndx)) THEN - i1_l = LBOUND(SrcParamData%OutParamLinIndx,1) - i1_u = UBOUND(SrcParamData%OutParamLinIndx,1) - i2_l = LBOUND(SrcParamData%OutParamLinIndx,2) - i2_u = UBOUND(SrcParamData%OutParamLinIndx,2) - IF (.NOT. ALLOCATED(DstParamData%OutParamLinIndx)) THEN - ALLOCATE(DstParamData%OutParamLinIndx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutParamLinIndx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%OutParamLinIndx = SrcParamData%OutParamLinIndx -ENDIF - END SUBROUTINE ExtPtfm_CopyParam - - SUBROUTINE ExtPtfm_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(ExtPtfm_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(ParamData%Mass)) THEN - DEALLOCATE(ParamData%Mass) -ENDIF -IF (ALLOCATED(ParamData%Damp)) THEN - DEALLOCATE(ParamData%Damp) -ENDIF -IF (ALLOCATED(ParamData%Stff)) THEN - DEALLOCATE(ParamData%Stff) -ENDIF -IF (ALLOCATED(ParamData%Forces)) THEN - DEALLOCATE(ParamData%Forces) -ENDIF -IF (ALLOCATED(ParamData%times)) THEN - DEALLOCATE(ParamData%times) -ENDIF -IF (ALLOCATED(ParamData%AMat)) THEN - DEALLOCATE(ParamData%AMat) -ENDIF -IF (ALLOCATED(ParamData%BMat)) THEN - DEALLOCATE(ParamData%BMat) -ENDIF -IF (ALLOCATED(ParamData%CMat)) THEN - DEALLOCATE(ParamData%CMat) -ENDIF -IF (ALLOCATED(ParamData%DMat)) THEN - DEALLOCATE(ParamData%DMat) -ENDIF -IF (ALLOCATED(ParamData%FX)) THEN - DEALLOCATE(ParamData%FX) -ENDIF -IF (ALLOCATED(ParamData%FY)) THEN - DEALLOCATE(ParamData%FY) -ENDIF -IF (ALLOCATED(ParamData%M11)) THEN - DEALLOCATE(ParamData%M11) -ENDIF -IF (ALLOCATED(ParamData%M12)) THEN - DEALLOCATE(ParamData%M12) -ENDIF -IF (ALLOCATED(ParamData%M22)) THEN - DEALLOCATE(ParamData%M22) -ENDIF -IF (ALLOCATED(ParamData%M21)) THEN - DEALLOCATE(ParamData%M21) -ENDIF -IF (ALLOCATED(ParamData%K11)) THEN - DEALLOCATE(ParamData%K11) -ENDIF -IF (ALLOCATED(ParamData%K22)) THEN - DEALLOCATE(ParamData%K22) -ENDIF -IF (ALLOCATED(ParamData%C11)) THEN - DEALLOCATE(ParamData%C11) -ENDIF -IF (ALLOCATED(ParamData%C12)) THEN - DEALLOCATE(ParamData%C12) -ENDIF -IF (ALLOCATED(ParamData%C22)) THEN - DEALLOCATE(ParamData%C22) -ENDIF -IF (ALLOCATED(ParamData%C21)) THEN - DEALLOCATE(ParamData%C21) -ENDIF -IF (ALLOCATED(ParamData%ActiveCBDOF)) THEN - DEALLOCATE(ParamData%ActiveCBDOF) -ENDIF -IF (ALLOCATED(ParamData%OutParam)) THEN -DO i1 = LBOUND(ParamData%OutParam,1), UBOUND(ParamData%OutParam,1) - CALL NWTC_Library_Destroyoutparmtype( ParamData%OutParam(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ParamData%OutParam) -ENDIF -IF (ALLOCATED(ParamData%OutParamLinIndx)) THEN - DEALLOCATE(ParamData%OutParamLinIndx) -ENDIF - END SUBROUTINE ExtPtfm_DestroyParam - - SUBROUTINE ExtPtfm_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(ExtPtfm_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 = 'ExtPtfm_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 ! Mass allocated yes/no - IF ( ALLOCATED(InData%Mass) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Mass upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Mass) ! Mass - END IF - Int_BufSz = Int_BufSz + 1 ! Damp allocated yes/no - IF ( ALLOCATED(InData%Damp) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Damp upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Damp) ! Damp - END IF - Int_BufSz = Int_BufSz + 1 ! Stff allocated yes/no - IF ( ALLOCATED(InData%Stff) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Stff upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Stff) ! Stff - END IF - Int_BufSz = Int_BufSz + 1 ! Forces allocated yes/no - IF ( ALLOCATED(InData%Forces) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Forces upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Forces) ! Forces - END IF - Int_BufSz = Int_BufSz + 1 ! times allocated yes/no - IF ( ALLOCATED(InData%times) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! times upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%times) ! times - END IF - Int_BufSz = Int_BufSz + 1 ! AMat allocated yes/no - IF ( ALLOCATED(InData%AMat) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! AMat upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AMat) ! AMat - END IF - Int_BufSz = Int_BufSz + 1 ! BMat allocated yes/no - IF ( ALLOCATED(InData%BMat) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BMat upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BMat) ! BMat - END IF - Int_BufSz = Int_BufSz + 1 ! CMat allocated yes/no - IF ( ALLOCATED(InData%CMat) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! CMat upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CMat) ! CMat - END IF - Int_BufSz = Int_BufSz + 1 ! DMat allocated yes/no - IF ( ALLOCATED(InData%DMat) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! DMat upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%DMat) ! DMat - END IF - Int_BufSz = Int_BufSz + 1 ! FX allocated yes/no - IF ( ALLOCATED(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 ( ALLOCATED(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 ! M11 allocated yes/no - IF ( ALLOCATED(InData%M11) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! M11 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%M11) ! M11 - END IF - Int_BufSz = Int_BufSz + 1 ! M12 allocated yes/no - IF ( ALLOCATED(InData%M12) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! M12 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%M12) ! M12 - END IF - Int_BufSz = Int_BufSz + 1 ! M22 allocated yes/no - IF ( ALLOCATED(InData%M22) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! M22 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%M22) ! M22 - END IF - Int_BufSz = Int_BufSz + 1 ! M21 allocated yes/no - IF ( ALLOCATED(InData%M21) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! M21 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%M21) ! M21 - END IF - Int_BufSz = Int_BufSz + 1 ! K11 allocated yes/no - IF ( ALLOCATED(InData%K11) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! K11 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%K11) ! K11 - END IF - Int_BufSz = Int_BufSz + 1 ! K22 allocated yes/no - IF ( ALLOCATED(InData%K22) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! K22 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%K22) ! K22 - END IF - Int_BufSz = Int_BufSz + 1 ! C11 allocated yes/no - IF ( ALLOCATED(InData%C11) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! C11 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%C11) ! C11 - END IF - Int_BufSz = Int_BufSz + 1 ! C12 allocated yes/no - IF ( ALLOCATED(InData%C12) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! C12 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%C12) ! C12 - END IF - Int_BufSz = Int_BufSz + 1 ! C22 allocated yes/no - IF ( ALLOCATED(InData%C22) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! C22 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%C22) ! C22 - END IF - Int_BufSz = Int_BufSz + 1 ! C21 allocated yes/no - IF ( ALLOCATED(InData%C21) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! C21 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%C21) ! C21 - END IF - Db_BufSz = Db_BufSz + 1 ! EP_DeltaT - Int_BufSz = Int_BufSz + 1 ! nTimeSteps - Int_BufSz = Int_BufSz + 1 ! nCB - Int_BufSz = Int_BufSz + 1 ! nCBFull - Int_BufSz = Int_BufSz + 1 ! nTot - Int_BufSz = Int_BufSz + 1 ! NumOuts - Int_BufSz = Int_BufSz + 1 ! IntMethod - Int_BufSz = Int_BufSz + 1 ! ActiveCBDOF allocated yes/no - IF ( ALLOCATED(InData%ActiveCBDOF) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ActiveCBDOF upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%ActiveCBDOF) ! ActiveCBDOF - 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 - ! 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 ! OutParamLinIndx allocated yes/no - IF ( ALLOCATED(InData%OutParamLinIndx) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! OutParamLinIndx upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%OutParamLinIndx) ! OutParamLinIndx - 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%Mass) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Mass,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Mass,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Mass,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Mass,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Mass,2), UBOUND(InData%Mass,2) - DO i1 = LBOUND(InData%Mass,1), UBOUND(InData%Mass,1) - ReKiBuf(Re_Xferred) = InData%Mass(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Damp) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Damp,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Damp,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Damp,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Damp,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Damp,2), UBOUND(InData%Damp,2) - DO i1 = LBOUND(InData%Damp,1), UBOUND(InData%Damp,1) - ReKiBuf(Re_Xferred) = InData%Damp(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Stff) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Stff,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Stff,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Stff,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Stff,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Stff,2), UBOUND(InData%Stff,2) - DO i1 = LBOUND(InData%Stff,1), UBOUND(InData%Stff,1) - ReKiBuf(Re_Xferred) = InData%Stff(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Forces) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Forces,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Forces,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Forces,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Forces,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Forces,2), UBOUND(InData%Forces,2) - DO i1 = LBOUND(InData%Forces,1), UBOUND(InData%Forces,1) - ReKiBuf(Re_Xferred) = InData%Forces(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%times) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%times,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%times,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%times,1), UBOUND(InData%times,1) - ReKiBuf(Re_Xferred) = InData%times(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AMat) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AMat,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AMat,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AMat,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AMat,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%AMat,2), UBOUND(InData%AMat,2) - DO i1 = LBOUND(InData%AMat,1), UBOUND(InData%AMat,1) - ReKiBuf(Re_Xferred) = InData%AMat(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BMat) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BMat,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BMat,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BMat,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BMat,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%BMat,2), UBOUND(InData%BMat,2) - DO i1 = LBOUND(InData%BMat,1), UBOUND(InData%BMat,1) - ReKiBuf(Re_Xferred) = InData%BMat(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CMat) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CMat,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CMat,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CMat,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CMat,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%CMat,2), UBOUND(InData%CMat,2) - DO i1 = LBOUND(InData%CMat,1), UBOUND(InData%CMat,1) - ReKiBuf(Re_Xferred) = InData%CMat(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%DMat) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DMat,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DMat,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DMat,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DMat,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%DMat,2), UBOUND(InData%DMat,2) - DO i1 = LBOUND(InData%DMat,1), UBOUND(InData%DMat,1) - ReKiBuf(Re_Xferred) = InData%DMat(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(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. ALLOCATED(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. ALLOCATED(InData%M11) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%M11,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%M11,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%M11,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%M11,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%M11,2), UBOUND(InData%M11,2) - DO i1 = LBOUND(InData%M11,1), UBOUND(InData%M11,1) - ReKiBuf(Re_Xferred) = InData%M11(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%M12) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%M12,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%M12,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%M12,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%M12,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%M12,2), UBOUND(InData%M12,2) - DO i1 = LBOUND(InData%M12,1), UBOUND(InData%M12,1) - ReKiBuf(Re_Xferred) = InData%M12(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%M22) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%M22,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%M22,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%M22,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%M22,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%M22,2), UBOUND(InData%M22,2) - DO i1 = LBOUND(InData%M22,1), UBOUND(InData%M22,1) - ReKiBuf(Re_Xferred) = InData%M22(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%M21) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%M21,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%M21,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%M21,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%M21,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%M21,2), UBOUND(InData%M21,2) - DO i1 = LBOUND(InData%M21,1), UBOUND(InData%M21,1) - ReKiBuf(Re_Xferred) = InData%M21(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%K11) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%K11,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%K11,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%K11,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%K11,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%K11,2), UBOUND(InData%K11,2) - DO i1 = LBOUND(InData%K11,1), UBOUND(InData%K11,1) - ReKiBuf(Re_Xferred) = InData%K11(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%K22) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%K22,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%K22,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%K22,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%K22,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%K22,2), UBOUND(InData%K22,2) - DO i1 = LBOUND(InData%K22,1), UBOUND(InData%K22,1) - ReKiBuf(Re_Xferred) = InData%K22(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%C11) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%C11,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C11,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%C11,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C11,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%C11,2), UBOUND(InData%C11,2) - DO i1 = LBOUND(InData%C11,1), UBOUND(InData%C11,1) - ReKiBuf(Re_Xferred) = InData%C11(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%C12) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%C12,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C12,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%C12,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C12,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%C12,2), UBOUND(InData%C12,2) - DO i1 = LBOUND(InData%C12,1), UBOUND(InData%C12,1) - ReKiBuf(Re_Xferred) = InData%C12(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%C22) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%C22,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C22,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%C22,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C22,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%C22,2), UBOUND(InData%C22,2) - DO i1 = LBOUND(InData%C22,1), UBOUND(InData%C22,1) - ReKiBuf(Re_Xferred) = InData%C22(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%C21) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%C21,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C21,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%C21,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C21,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%C21,2), UBOUND(InData%C21,2) - DO i1 = LBOUND(InData%C21,1), UBOUND(InData%C21,1) - ReKiBuf(Re_Xferred) = InData%C21(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - DbKiBuf(Db_Xferred) = InData%EP_DeltaT - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nTimeSteps - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nCB - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nCBFull - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nTot - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%IntMethod - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%ActiveCBDOF) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ActiveCBDOF,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ActiveCBDOF,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ActiveCBDOF,1), UBOUND(InData%ActiveCBDOF,1) - IntKiBuf(Int_Xferred) = InData%ActiveCBDOF(i1) - Int_Xferred = Int_Xferred + 1 - 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 - IF ( .NOT. ALLOCATED(InData%OutParamLinIndx) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OutParamLinIndx,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutParamLinIndx,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OutParamLinIndx,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutParamLinIndx,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%OutParamLinIndx,2), UBOUND(InData%OutParamLinIndx,2) - DO i1 = LBOUND(InData%OutParamLinIndx,1), UBOUND(InData%OutParamLinIndx,1) - IntKiBuf(Int_Xferred) = InData%OutParamLinIndx(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE ExtPtfm_PackParam - - SUBROUTINE ExtPtfm_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(ExtPtfm_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 = 'ExtPtfm_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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Mass not allocated - Int_Xferred = Int_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%Mass)) DEALLOCATE(OutData%Mass) - ALLOCATE(OutData%Mass(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Mass.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Mass,2), UBOUND(OutData%Mass,2) - DO i1 = LBOUND(OutData%Mass,1), UBOUND(OutData%Mass,1) - OutData%Mass(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Damp not allocated - Int_Xferred = Int_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%Damp)) DEALLOCATE(OutData%Damp) - ALLOCATE(OutData%Damp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Damp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Damp,2), UBOUND(OutData%Damp,2) - DO i1 = LBOUND(OutData%Damp,1), UBOUND(OutData%Damp,1) - OutData%Damp(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Stff not allocated - Int_Xferred = Int_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%Stff)) DEALLOCATE(OutData%Stff) - ALLOCATE(OutData%Stff(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Stff.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Stff,2), UBOUND(OutData%Stff,2) - DO i1 = LBOUND(OutData%Stff,1), UBOUND(OutData%Stff,1) - OutData%Stff(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Forces not allocated - Int_Xferred = Int_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%Forces)) DEALLOCATE(OutData%Forces) - ALLOCATE(OutData%Forces(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Forces.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Forces,2), UBOUND(OutData%Forces,2) - DO i1 = LBOUND(OutData%Forces,1), UBOUND(OutData%Forces,1) - OutData%Forces(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! times not allocated - Int_Xferred = Int_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%times)) DEALLOCATE(OutData%times) - ALLOCATE(OutData%times(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%times.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%times,1), UBOUND(OutData%times,1) - OutData%times(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AMat not allocated - Int_Xferred = Int_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%AMat)) DEALLOCATE(OutData%AMat) - ALLOCATE(OutData%AMat(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AMat.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%AMat,2), UBOUND(OutData%AMat,2) - DO i1 = LBOUND(OutData%AMat,1), UBOUND(OutData%AMat,1) - OutData%AMat(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BMat not allocated - Int_Xferred = Int_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%BMat)) DEALLOCATE(OutData%BMat) - ALLOCATE(OutData%BMat(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BMat.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%BMat,2), UBOUND(OutData%BMat,2) - DO i1 = LBOUND(OutData%BMat,1), UBOUND(OutData%BMat,1) - OutData%BMat(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CMat not allocated - Int_Xferred = Int_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%CMat)) DEALLOCATE(OutData%CMat) - ALLOCATE(OutData%CMat(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CMat.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%CMat,2), UBOUND(OutData%CMat,2) - DO i1 = LBOUND(OutData%CMat,1), UBOUND(OutData%CMat,1) - OutData%CMat(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DMat not allocated - Int_Xferred = Int_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%DMat)) DEALLOCATE(OutData%DMat) - ALLOCATE(OutData%DMat(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DMat.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%DMat,2), UBOUND(OutData%DMat,2) - DO i1 = LBOUND(OutData%DMat,1), UBOUND(OutData%DMat,1) - OutData%DMat(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - 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 (ALLOCATED(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 - DO i1 = LBOUND(OutData%FX,1), UBOUND(OutData%FX,1) - OutData%FX(i1) = ReKiBuf(Re_Xferred) - 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 (ALLOCATED(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 - DO i1 = LBOUND(OutData%FY,1), UBOUND(OutData%FY,1) - OutData%FY(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! M11 not allocated - Int_Xferred = Int_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%M11)) DEALLOCATE(OutData%M11) - ALLOCATE(OutData%M11(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%M11.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%M11,2), UBOUND(OutData%M11,2) - DO i1 = LBOUND(OutData%M11,1), UBOUND(OutData%M11,1) - OutData%M11(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! M12 not allocated - Int_Xferred = Int_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%M12)) DEALLOCATE(OutData%M12) - ALLOCATE(OutData%M12(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%M12.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%M12,2), UBOUND(OutData%M12,2) - DO i1 = LBOUND(OutData%M12,1), UBOUND(OutData%M12,1) - OutData%M12(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! M22 not allocated - Int_Xferred = Int_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%M22)) DEALLOCATE(OutData%M22) - ALLOCATE(OutData%M22(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%M22.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%M22,2), UBOUND(OutData%M22,2) - DO i1 = LBOUND(OutData%M22,1), UBOUND(OutData%M22,1) - OutData%M22(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! M21 not allocated - Int_Xferred = Int_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%M21)) DEALLOCATE(OutData%M21) - ALLOCATE(OutData%M21(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%M21.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%M21,2), UBOUND(OutData%M21,2) - DO i1 = LBOUND(OutData%M21,1), UBOUND(OutData%M21,1) - OutData%M21(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! K11 not allocated - Int_Xferred = Int_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%K11)) DEALLOCATE(OutData%K11) - ALLOCATE(OutData%K11(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%K11.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%K11,2), UBOUND(OutData%K11,2) - DO i1 = LBOUND(OutData%K11,1), UBOUND(OutData%K11,1) - OutData%K11(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! K22 not allocated - Int_Xferred = Int_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%K22)) DEALLOCATE(OutData%K22) - ALLOCATE(OutData%K22(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%K22.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%K22,2), UBOUND(OutData%K22,2) - DO i1 = LBOUND(OutData%K22,1), UBOUND(OutData%K22,1) - OutData%K22(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! C11 not allocated - Int_Xferred = Int_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%C11)) DEALLOCATE(OutData%C11) - ALLOCATE(OutData%C11(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%C11.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%C11,2), UBOUND(OutData%C11,2) - DO i1 = LBOUND(OutData%C11,1), UBOUND(OutData%C11,1) - OutData%C11(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! C12 not allocated - Int_Xferred = Int_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%C12)) DEALLOCATE(OutData%C12) - ALLOCATE(OutData%C12(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%C12.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%C12,2), UBOUND(OutData%C12,2) - DO i1 = LBOUND(OutData%C12,1), UBOUND(OutData%C12,1) - OutData%C12(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! C22 not allocated - Int_Xferred = Int_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%C22)) DEALLOCATE(OutData%C22) - ALLOCATE(OutData%C22(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%C22.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%C22,2), UBOUND(OutData%C22,2) - DO i1 = LBOUND(OutData%C22,1), UBOUND(OutData%C22,1) - OutData%C22(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! C21 not allocated - Int_Xferred = Int_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%C21)) DEALLOCATE(OutData%C21) - ALLOCATE(OutData%C21(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%C21.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%C21,2), UBOUND(OutData%C21,2) - DO i1 = LBOUND(OutData%C21,1), UBOUND(OutData%C21,1) - OutData%C21(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%EP_DeltaT = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%nTimeSteps = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nCB = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nCBFull = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nTot = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%IntMethod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ActiveCBDOF not allocated - Int_Xferred = Int_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%ActiveCBDOF)) DEALLOCATE(OutData%ActiveCBDOF) - ALLOCATE(OutData%ActiveCBDOF(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ActiveCBDOF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ActiveCBDOF,1), UBOUND(OutData%ActiveCBDOF,1) - OutData%ActiveCBDOF(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - 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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutParamLinIndx not allocated - Int_Xferred = Int_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%OutParamLinIndx)) DEALLOCATE(OutData%OutParamLinIndx) - ALLOCATE(OutData%OutParamLinIndx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParamLinIndx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%OutParamLinIndx,2), UBOUND(OutData%OutParamLinIndx,2) - DO i1 = LBOUND(OutData%OutParamLinIndx,1), UBOUND(OutData%OutParamLinIndx,1) - OutData%OutParamLinIndx(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE ExtPtfm_UnPackParam - - SUBROUTINE ExtPtfm_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ExtPtfm_InputType), INTENT(INOUT) :: SrcInputData - TYPE(ExtPtfm_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 = 'ExtPtfm_CopyInput' -! + ErrMsg = '' + if (allocated(ContStateData%qm)) then + deallocate(ContStateData%qm) + end if + if (allocated(ContStateData%qmdot)) then + deallocate(ContStateData%qmdot) + end if +end subroutine + +subroutine ExtPtfm_PackContState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(ExtPtfm_ContinuousStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ExtPtfm_PackContState' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%qm) + call RegPackAlloc(RF, InData%qmdot) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ExtPtfm_UnPackContState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(ExtPtfm_ContinuousStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ExtPtfm_UnPackContState' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%qm); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%qmdot); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ExtPtfm_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) + type(ExtPtfm_DiscreteStateType), intent(in) :: SrcDiscStateData + type(ExtPtfm_DiscreteStateType), intent(inout) :: DstDiscStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'ExtPtfm_CopyDiscState' 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 ExtPtfm_CopyInput - - SUBROUTINE ExtPtfm_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(ExtPtfm_InputType), INTENT(INOUT) :: InputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_DestroyInput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL MeshDestroy( InputData%PtfmMesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE ExtPtfm_DestroyInput - - SUBROUTINE ExtPtfm_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(ExtPtfm_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 = 'ExtPtfm_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 ExtPtfm_PackInput - - SUBROUTINE ExtPtfm_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(ExtPtfm_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 = 'ExtPtfm_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 ExtPtfm_UnPackInput - - SUBROUTINE ExtPtfm_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ExtPtfm_OutputType), INTENT(INOUT) :: SrcOutputData - TYPE(ExtPtfm_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 = 'ExtPtfm_CopyOutput' -! + ErrMsg = '' + DstDiscStateData%DummyDiscState = SrcDiscStateData%DummyDiscState +end subroutine + +subroutine ExtPtfm_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) + type(ExtPtfm_DiscreteStateType), intent(inout) :: DiscStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'ExtPtfm_DestroyDiscState' 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 ExtPtfm_CopyOutput - - SUBROUTINE ExtPtfm_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(ExtPtfm_OutputType), INTENT(INOUT) :: OutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_DestroyOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL MeshDestroy( OutputData%PtfmMesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(OutputData%WriteOutput)) THEN - DEALLOCATE(OutputData%WriteOutput) -ENDIF - END SUBROUTINE ExtPtfm_DestroyOutput - - SUBROUTINE ExtPtfm_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(ExtPtfm_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 = 'ExtPtfm_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 ExtPtfm_PackOutput - - SUBROUTINE ExtPtfm_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(ExtPtfm_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 = 'ExtPtfm_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 ExtPtfm_UnPackOutput - - - SUBROUTINE ExtPtfm_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(ExtPtfm_InputType), INTENT(INOUT) :: u(:) ! Input at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Inputs - TYPE(ExtPtfm_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 + ErrMsg = '' +end subroutine + +subroutine ExtPtfm_PackDiscState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(ExtPtfm_DiscreteStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ExtPtfm_PackDiscState' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyDiscState) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ExtPtfm_UnPackDiscState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(ExtPtfm_DiscreteStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ExtPtfm_UnPackDiscState' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyDiscState); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ExtPtfm_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) + type(ExtPtfm_ConstraintStateType), intent(in) :: SrcConstrStateData + type(ExtPtfm_ConstraintStateType), intent(inout) :: DstConstrStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'ExtPtfm_CopyConstrState' + ErrStat = ErrID_None + ErrMsg = '' + DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState +end subroutine + +subroutine ExtPtfm_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) + type(ExtPtfm_ConstraintStateType), intent(inout) :: ConstrStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'ExtPtfm_DestroyConstrState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine ExtPtfm_PackConstrState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(ExtPtfm_ConstraintStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ExtPtfm_PackConstrState' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyConstrState) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ExtPtfm_UnPackConstrState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(ExtPtfm_ConstraintStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ExtPtfm_UnPackConstrState' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyConstrState); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ExtPtfm_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) + type(ExtPtfm_OtherStateType), intent(in) :: SrcOtherStateData + type(ExtPtfm_OtherStateType), intent(inout) :: DstOtherStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ExtPtfm_CopyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcOtherStateData%xdot)) then + LB(1:1) = lbound(SrcOtherStateData%xdot) + UB(1:1) = ubound(SrcOtherStateData%xdot) + if (.not. allocated(DstOtherStateData%xdot)) then + allocate(DstOtherStateData%xdot(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%xdot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call ExtPtfm_CopyContState(SrcOtherStateData%xdot(i1), DstOtherStateData%xdot(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + DstOtherStateData%n = SrcOtherStateData%n +end subroutine + +subroutine ExtPtfm_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) + type(ExtPtfm_OtherStateType), intent(inout) :: OtherStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ExtPtfm_DestroyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OtherStateData%xdot)) then + LB(1:1) = lbound(OtherStateData%xdot) + UB(1:1) = ubound(OtherStateData%xdot) + do i1 = LB(1), UB(1) + call ExtPtfm_DestroyContState(OtherStateData%xdot(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(OtherStateData%xdot) + end if +end subroutine + +subroutine ExtPtfm_PackOtherState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(ExtPtfm_OtherStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ExtPtfm_PackOtherState' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%xdot)) + if (allocated(InData%xdot)) then + call RegPackBounds(RF, 1, lbound(InData%xdot), ubound(InData%xdot)) + LB(1:1) = lbound(InData%xdot) + UB(1:1) = ubound(InData%xdot) + do i1 = LB(1), UB(1) + call ExtPtfm_PackContState(RF, InData%xdot(i1)) + end do + end if + call RegPack(RF, InData%n) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ExtPtfm_UnPackOtherState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(ExtPtfm_OtherStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ExtPtfm_UnPackOtherState' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + if (allocated(OutData%xdot)) deallocate(OutData%xdot) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%xdot(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xdot.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call ExtPtfm_UnpackContState(RF, OutData%xdot(i1)) ! xdot + end do + end if + call RegUnpack(RF, OutData%n); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ExtPtfm_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(ExtPtfm_MiscVarType), intent(in) :: SrcMiscData + type(ExtPtfm_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'ExtPtfm_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcMiscData%xFlat)) then + LB(1:1) = lbound(SrcMiscData%xFlat) + UB(1:1) = ubound(SrcMiscData%xFlat) + if (.not. allocated(DstMiscData%xFlat)) then + allocate(DstMiscData%xFlat(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%xFlat.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%xFlat = SrcMiscData%xFlat + end if + DstMiscData%uFlat = SrcMiscData%uFlat + if (allocated(SrcMiscData%F_at_t)) then + LB(1:1) = lbound(SrcMiscData%F_at_t) + UB(1:1) = ubound(SrcMiscData%F_at_t) + if (.not. allocated(DstMiscData%F_at_t)) then + allocate(DstMiscData%F_at_t(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_at_t.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%F_at_t = SrcMiscData%F_at_t + end if + DstMiscData%Indx = SrcMiscData%Indx + DstMiscData%EquilStart = SrcMiscData%EquilStart + if (allocated(SrcMiscData%AllOuts)) then + LB(1:1) = lbound(SrcMiscData%AllOuts) + UB(1:1) = ubound(SrcMiscData%AllOuts) + if (.not. allocated(DstMiscData%AllOuts)) then + allocate(DstMiscData%AllOuts(LB(1):UB(1)), 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 + end if +end subroutine + +subroutine ExtPtfm_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(ExtPtfm_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'ExtPtfm_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(MiscData%xFlat)) then + deallocate(MiscData%xFlat) + end if + if (allocated(MiscData%F_at_t)) then + deallocate(MiscData%F_at_t) + end if + if (allocated(MiscData%AllOuts)) then + deallocate(MiscData%AllOuts) + end if +end subroutine + +subroutine ExtPtfm_PackMisc(RF, Indata) + type(RegFile), intent(inout) :: RF + type(ExtPtfm_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ExtPtfm_PackMisc' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%xFlat) + call RegPack(RF, InData%uFlat) + call RegPackAlloc(RF, InData%F_at_t) + call RegPack(RF, InData%Indx) + call RegPack(RF, InData%EquilStart) + call RegPackAlloc(RF, InData%AllOuts) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ExtPtfm_UnPackMisc(RF, OutData) + type(RegFile), intent(inout) :: RF + type(ExtPtfm_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ExtPtfm_UnPackMisc' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%xFlat); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%uFlat); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%F_at_t); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Indx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%EquilStart); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AllOuts); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ExtPtfm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(ExtPtfm_ParameterType), intent(in) :: SrcParamData + type(ExtPtfm_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ExtPtfm_CopyParam' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcParamData%Mass)) then + LB(1:2) = lbound(SrcParamData%Mass) + UB(1:2) = ubound(SrcParamData%Mass) + if (.not. allocated(DstParamData%Mass)) then + allocate(DstParamData%Mass(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Mass.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Mass = SrcParamData%Mass + end if + if (allocated(SrcParamData%Damp)) then + LB(1:2) = lbound(SrcParamData%Damp) + UB(1:2) = ubound(SrcParamData%Damp) + if (.not. allocated(DstParamData%Damp)) then + allocate(DstParamData%Damp(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Damp.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Damp = SrcParamData%Damp + end if + if (allocated(SrcParamData%Stff)) then + LB(1:2) = lbound(SrcParamData%Stff) + UB(1:2) = ubound(SrcParamData%Stff) + if (.not. allocated(DstParamData%Stff)) then + allocate(DstParamData%Stff(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Stff.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Stff = SrcParamData%Stff + end if + if (allocated(SrcParamData%Forces)) then + LB(1:2) = lbound(SrcParamData%Forces) + UB(1:2) = ubound(SrcParamData%Forces) + if (.not. allocated(DstParamData%Forces)) then + allocate(DstParamData%Forces(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Forces.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Forces = SrcParamData%Forces + end if + if (allocated(SrcParamData%times)) then + LB(1:1) = lbound(SrcParamData%times) + UB(1:1) = ubound(SrcParamData%times) + if (.not. allocated(DstParamData%times)) then + allocate(DstParamData%times(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%times.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%times = SrcParamData%times + end if + if (allocated(SrcParamData%AMat)) then + LB(1:2) = lbound(SrcParamData%AMat) + UB(1:2) = ubound(SrcParamData%AMat) + if (.not. allocated(DstParamData%AMat)) then + allocate(DstParamData%AMat(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AMat.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%AMat = SrcParamData%AMat + end if + if (allocated(SrcParamData%BMat)) then + LB(1:2) = lbound(SrcParamData%BMat) + UB(1:2) = ubound(SrcParamData%BMat) + if (.not. allocated(DstParamData%BMat)) then + allocate(DstParamData%BMat(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BMat.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%BMat = SrcParamData%BMat + end if + if (allocated(SrcParamData%CMat)) then + LB(1:2) = lbound(SrcParamData%CMat) + UB(1:2) = ubound(SrcParamData%CMat) + if (.not. allocated(DstParamData%CMat)) then + allocate(DstParamData%CMat(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CMat.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%CMat = SrcParamData%CMat + end if + if (allocated(SrcParamData%DMat)) then + LB(1:2) = lbound(SrcParamData%DMat) + UB(1:2) = ubound(SrcParamData%DMat) + if (.not. allocated(DstParamData%DMat)) then + allocate(DstParamData%DMat(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%DMat.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%DMat = SrcParamData%DMat + end if + if (allocated(SrcParamData%FX)) then + LB(1:1) = lbound(SrcParamData%FX) + UB(1:1) = ubound(SrcParamData%FX) + if (.not. allocated(DstParamData%FX)) then + allocate(DstParamData%FX(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%FX.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%FX = SrcParamData%FX + end if + if (allocated(SrcParamData%FY)) then + LB(1:1) = lbound(SrcParamData%FY) + UB(1:1) = ubound(SrcParamData%FY) + if (.not. allocated(DstParamData%FY)) then + allocate(DstParamData%FY(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%FY.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%FY = SrcParamData%FY + end if + if (allocated(SrcParamData%M11)) then + LB(1:2) = lbound(SrcParamData%M11) + UB(1:2) = ubound(SrcParamData%M11) + if (.not. allocated(DstParamData%M11)) then + allocate(DstParamData%M11(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%M11.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%M11 = SrcParamData%M11 + end if + if (allocated(SrcParamData%M12)) then + LB(1:2) = lbound(SrcParamData%M12) + UB(1:2) = ubound(SrcParamData%M12) + if (.not. allocated(DstParamData%M12)) then + allocate(DstParamData%M12(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%M12.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%M12 = SrcParamData%M12 + end if + if (allocated(SrcParamData%M22)) then + LB(1:2) = lbound(SrcParamData%M22) + UB(1:2) = ubound(SrcParamData%M22) + if (.not. allocated(DstParamData%M22)) then + allocate(DstParamData%M22(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%M22.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%M22 = SrcParamData%M22 + end if + if (allocated(SrcParamData%M21)) then + LB(1:2) = lbound(SrcParamData%M21) + UB(1:2) = ubound(SrcParamData%M21) + if (.not. allocated(DstParamData%M21)) then + allocate(DstParamData%M21(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%M21.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%M21 = SrcParamData%M21 + end if + if (allocated(SrcParamData%K11)) then + LB(1:2) = lbound(SrcParamData%K11) + UB(1:2) = ubound(SrcParamData%K11) + if (.not. allocated(DstParamData%K11)) then + allocate(DstParamData%K11(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%K11.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%K11 = SrcParamData%K11 + end if + if (allocated(SrcParamData%K22)) then + LB(1:2) = lbound(SrcParamData%K22) + UB(1:2) = ubound(SrcParamData%K22) + if (.not. allocated(DstParamData%K22)) then + allocate(DstParamData%K22(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%K22.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%K22 = SrcParamData%K22 + end if + if (allocated(SrcParamData%C11)) then + LB(1:2) = lbound(SrcParamData%C11) + UB(1:2) = ubound(SrcParamData%C11) + if (.not. allocated(DstParamData%C11)) then + allocate(DstParamData%C11(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%C11.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%C11 = SrcParamData%C11 + end if + if (allocated(SrcParamData%C12)) then + LB(1:2) = lbound(SrcParamData%C12) + UB(1:2) = ubound(SrcParamData%C12) + if (.not. allocated(DstParamData%C12)) then + allocate(DstParamData%C12(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%C12.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%C12 = SrcParamData%C12 + end if + if (allocated(SrcParamData%C22)) then + LB(1:2) = lbound(SrcParamData%C22) + UB(1:2) = ubound(SrcParamData%C22) + if (.not. allocated(DstParamData%C22)) then + allocate(DstParamData%C22(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%C22.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%C22 = SrcParamData%C22 + end if + if (allocated(SrcParamData%C21)) then + LB(1:2) = lbound(SrcParamData%C21) + UB(1:2) = ubound(SrcParamData%C21) + if (.not. allocated(DstParamData%C21)) then + allocate(DstParamData%C21(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%C21.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%C21 = SrcParamData%C21 + end if + DstParamData%EP_DeltaT = SrcParamData%EP_DeltaT + DstParamData%nTimeSteps = SrcParamData%nTimeSteps + DstParamData%nCB = SrcParamData%nCB + DstParamData%nCBFull = SrcParamData%nCBFull + DstParamData%nTot = SrcParamData%nTot + DstParamData%NumOuts = SrcParamData%NumOuts + DstParamData%IntMethod = SrcParamData%IntMethod + if (allocated(SrcParamData%ActiveCBDOF)) then + LB(1:1) = lbound(SrcParamData%ActiveCBDOF) + UB(1:1) = ubound(SrcParamData%ActiveCBDOF) + if (.not. allocated(DstParamData%ActiveCBDOF)) then + allocate(DstParamData%ActiveCBDOF(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ActiveCBDOF.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%ActiveCBDOF = SrcParamData%ActiveCBDOF + end if + if (allocated(SrcParamData%OutParam)) then + LB(1:1) = lbound(SrcParamData%OutParam) + UB(1:1) = ubound(SrcParamData%OutParam) + if (.not. allocated(DstParamData%OutParam)) then + allocate(DstParamData%OutParam(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutParam.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyOutParmType(SrcParamData%OutParam(i1), DstParamData%OutParam(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcParamData%OutParamLinIndx)) then + LB(1:2) = lbound(SrcParamData%OutParamLinIndx) + UB(1:2) = ubound(SrcParamData%OutParamLinIndx) + if (.not. allocated(DstParamData%OutParamLinIndx)) then + allocate(DstParamData%OutParamLinIndx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutParamLinIndx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%OutParamLinIndx = SrcParamData%OutParamLinIndx + end if +end subroutine + +subroutine ExtPtfm_DestroyParam(ParamData, ErrStat, ErrMsg) + type(ExtPtfm_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ExtPtfm_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ParamData%Mass)) then + deallocate(ParamData%Mass) + end if + if (allocated(ParamData%Damp)) then + deallocate(ParamData%Damp) + end if + if (allocated(ParamData%Stff)) then + deallocate(ParamData%Stff) + end if + if (allocated(ParamData%Forces)) then + deallocate(ParamData%Forces) + end if + if (allocated(ParamData%times)) then + deallocate(ParamData%times) + end if + if (allocated(ParamData%AMat)) then + deallocate(ParamData%AMat) + end if + if (allocated(ParamData%BMat)) then + deallocate(ParamData%BMat) + end if + if (allocated(ParamData%CMat)) then + deallocate(ParamData%CMat) + end if + if (allocated(ParamData%DMat)) then + deallocate(ParamData%DMat) + end if + if (allocated(ParamData%FX)) then + deallocate(ParamData%FX) + end if + if (allocated(ParamData%FY)) then + deallocate(ParamData%FY) + end if + if (allocated(ParamData%M11)) then + deallocate(ParamData%M11) + end if + if (allocated(ParamData%M12)) then + deallocate(ParamData%M12) + end if + if (allocated(ParamData%M22)) then + deallocate(ParamData%M22) + end if + if (allocated(ParamData%M21)) then + deallocate(ParamData%M21) + end if + if (allocated(ParamData%K11)) then + deallocate(ParamData%K11) + end if + if (allocated(ParamData%K22)) then + deallocate(ParamData%K22) + end if + if (allocated(ParamData%C11)) then + deallocate(ParamData%C11) + end if + if (allocated(ParamData%C12)) then + deallocate(ParamData%C12) + end if + if (allocated(ParamData%C22)) then + deallocate(ParamData%C22) + end if + if (allocated(ParamData%C21)) then + deallocate(ParamData%C21) + end if + if (allocated(ParamData%ActiveCBDOF)) then + deallocate(ParamData%ActiveCBDOF) + end if + if (allocated(ParamData%OutParam)) then + LB(1:1) = lbound(ParamData%OutParam) + UB(1:1) = ubound(ParamData%OutParam) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyOutParmType(ParamData%OutParam(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%OutParam) + end if + if (allocated(ParamData%OutParamLinIndx)) then + deallocate(ParamData%OutParamLinIndx) + end if +end subroutine + +subroutine ExtPtfm_PackParam(RF, Indata) + type(RegFile), intent(inout) :: RF + type(ExtPtfm_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ExtPtfm_PackParam' + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%Mass) + call RegPackAlloc(RF, InData%Damp) + call RegPackAlloc(RF, InData%Stff) + call RegPackAlloc(RF, InData%Forces) + call RegPackAlloc(RF, InData%times) + call RegPackAlloc(RF, InData%AMat) + call RegPackAlloc(RF, InData%BMat) + call RegPackAlloc(RF, InData%CMat) + call RegPackAlloc(RF, InData%DMat) + call RegPackAlloc(RF, InData%FX) + call RegPackAlloc(RF, InData%FY) + call RegPackAlloc(RF, InData%M11) + call RegPackAlloc(RF, InData%M12) + call RegPackAlloc(RF, InData%M22) + call RegPackAlloc(RF, InData%M21) + call RegPackAlloc(RF, InData%K11) + call RegPackAlloc(RF, InData%K22) + call RegPackAlloc(RF, InData%C11) + call RegPackAlloc(RF, InData%C12) + call RegPackAlloc(RF, InData%C22) + call RegPackAlloc(RF, InData%C21) + call RegPack(RF, InData%EP_DeltaT) + call RegPack(RF, InData%nTimeSteps) + call RegPack(RF, InData%nCB) + call RegPack(RF, InData%nCBFull) + call RegPack(RF, InData%nTot) + call RegPack(RF, InData%NumOuts) + call RegPack(RF, InData%IntMethod) + call RegPackAlloc(RF, InData%ActiveCBDOF) + call RegPack(RF, allocated(InData%OutParam)) + if (allocated(InData%OutParam)) then + call RegPackBounds(RF, 1, lbound(InData%OutParam), ubound(InData%OutParam)) + LB(1:1) = lbound(InData%OutParam) + UB(1:1) = ubound(InData%OutParam) + do i1 = LB(1), UB(1) + call NWTC_Library_PackOutParmType(RF, InData%OutParam(i1)) + end do + end if + call RegPackAlloc(RF, InData%OutParamLinIndx) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ExtPtfm_UnPackParam(RF, OutData) + type(RegFile), intent(inout) :: RF + type(ExtPtfm_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ExtPtfm_UnPackParam' + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%Mass); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Damp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Stff); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Forces); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%times); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AMat); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BMat); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%CMat); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%DMat); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%FX); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%FY); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%M11); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%M12); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%M22); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%M21); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%K11); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%K22); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%C11); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%C12); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%C22); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%C21); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%EP_DeltaT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nTimeSteps); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nCB); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nCBFull); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nTot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumOuts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%IntMethod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ActiveCBDOF); if (RegCheckErr(RF, RoutineName)) return + if (allocated(OutData%OutParam)) deallocate(OutData%OutParam) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%OutParam(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackOutParmType(RF, OutData%OutParam(i1)) ! OutParam + end do + end if + call RegUnpackAlloc(RF, OutData%OutParamLinIndx); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ExtPtfm_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) + type(ExtPtfm_InputType), intent(inout) :: SrcInputData + type(ExtPtfm_InputType), intent(inout) :: DstInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ExtPtfm_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 + +subroutine ExtPtfm_DestroyInput(InputData, ErrStat, ErrMsg) + type(ExtPtfm_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ExtPtfm_DestroyInput' + ErrStat = ErrID_None + ErrMsg = '' + call MeshDestroy( InputData%PtfmMesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine ExtPtfm_PackInput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(ExtPtfm_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ExtPtfm_PackInput' + if (RF%ErrStat >= AbortErrLev) return + call MeshPack(RF, InData%PtfmMesh) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ExtPtfm_UnPackInput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(ExtPtfm_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ExtPtfm_UnPackInput' + if (RF%ErrStat /= ErrID_None) return + call MeshUnpack(RF, OutData%PtfmMesh) ! PtfmMesh +end subroutine + +subroutine ExtPtfm_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(ExtPtfm_OutputType), intent(inout) :: SrcOutputData + type(ExtPtfm_OutputType), intent(inout) :: DstOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ExtPtfm_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 + LB(1:1) = lbound(SrcOutputData%WriteOutput) + UB(1:1) = ubound(SrcOutputData%WriteOutput) + if (.not. allocated(DstOutputData%WriteOutput)) then + allocate(DstOutputData%WriteOutput(LB(1):UB(1)), 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 + end if +end subroutine + +subroutine ExtPtfm_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(ExtPtfm_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ExtPtfm_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' + call MeshDestroy( OutputData%PtfmMesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(OutputData%WriteOutput)) then + deallocate(OutputData%WriteOutput) + end if +end subroutine + +subroutine ExtPtfm_PackOutput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(ExtPtfm_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ExtPtfm_PackOutput' + if (RF%ErrStat >= AbortErrLev) return + call MeshPack(RF, InData%PtfmMesh) + call RegPackAlloc(RF, InData%WriteOutput) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ExtPtfm_UnPackOutput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(ExtPtfm_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ExtPtfm_UnPackOutput' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call MeshUnpack(RF, OutData%PtfmMesh) ! PtfmMesh + call RegUnpackAlloc(RF, OutData%WriteOutput); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ExtPtfm_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(ExtPtfm_InputType), intent(inout) :: u(:) ! Input at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Inputs + type(ExtPtfm_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 = 'ExtPtfm_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 ExtPtfm_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL ExtPtfm_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 ExtPtfm_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 ExtPtfm_Input_ExtrapInterp - - - SUBROUTINE ExtPtfm_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'ExtPtfm_Input_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(u)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(u)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(u) - 1 + select case (order) + case (0) + call ExtPtfm_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call ExtPtfm_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call ExtPtfm_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(u) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE ExtPtfm_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. @@ -4972,41 +1601,42 @@ SUBROUTINE ExtPtfm_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, Err ! !.................................................................................................................................. - TYPE(ExtPtfm_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 - TYPE(ExtPtfm_InputType), INTENT(INOUT) :: u2 ! Input at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs - TYPE(ExtPtfm_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 + TYPE(ExtPtfm_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 + TYPE(ExtPtfm_InputType), INTENT(INOUT) :: u2 ! Input at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs + TYPE(ExtPtfm_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 = 'ExtPtfm_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 + REAL(DbKi) :: t(2) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_Input_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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 ExtPtfm_Input_ExtrapInterp1 - - - SUBROUTINE ExtPtfm_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = 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 + +SUBROUTINE ExtPtfm_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. @@ -5020,101 +1650,102 @@ SUBROUTINE ExtPtfm_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ! !.................................................................................................................................. - TYPE(ExtPtfm_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 > t3 - TYPE(ExtPtfm_InputType), INTENT(INOUT) :: u2 ! Input at t2 > t3 - TYPE(ExtPtfm_InputType), INTENT(INOUT) :: u3 ! Input at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs - TYPE(ExtPtfm_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 + TYPE(ExtPtfm_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 > t3 + TYPE(ExtPtfm_InputType), INTENT(INOUT) :: u2 ! Input at t2 > t3 + TYPE(ExtPtfm_InputType), INTENT(INOUT) :: u3 ! Input at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs + TYPE(ExtPtfm_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 = 'ExtPtfm_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) - + 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) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_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 + 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 + 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 + 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 ExtPtfm_Input_ExtrapInterp2 - - - SUBROUTINE ExtPtfm_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(ExtPtfm_OutputType), INTENT(INOUT) :: y(:) ! Output at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Outputs - TYPE(ExtPtfm_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 + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + 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 + +subroutine ExtPtfm_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(ExtPtfm_OutputType), intent(inout) :: y(:) ! Output at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Outputs + type(ExtPtfm_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 = 'ExtPtfm_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 ExtPtfm_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL ExtPtfm_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 ExtPtfm_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 ExtPtfm_Output_ExtrapInterp - - - SUBROUTINE ExtPtfm_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'ExtPtfm_Output_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(y)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(y)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(y) - 1 + select case (order) + case (0) + call ExtPtfm_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call ExtPtfm_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call ExtPtfm_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(y) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE ExtPtfm_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. @@ -5126,49 +1757,47 @@ SUBROUTINE ExtPtfm_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, Er ! !.................................................................................................................................. - TYPE(ExtPtfm_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 - TYPE(ExtPtfm_OutputType), INTENT(INOUT) :: y2 ! Output at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs - TYPE(ExtPtfm_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 + TYPE(ExtPtfm_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 + TYPE(ExtPtfm_OutputType), INTENT(INOUT) :: y2 ! Output at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs + TYPE(ExtPtfm_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 = 'ExtPtfm_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 + REAL(DbKi) :: t(2) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_Output_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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 ExtPtfm_Output_ExtrapInterp1 - - - SUBROUTINE ExtPtfm_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = 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 + y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + END IF ! check if allocated +END SUBROUTINE + +SUBROUTINE ExtPtfm_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. @@ -5182,56 +1811,52 @@ SUBROUTINE ExtPtfm_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat ! !.................................................................................................................................. - TYPE(ExtPtfm_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 > t3 - TYPE(ExtPtfm_OutputType), INTENT(INOUT) :: y2 ! Output at t2 > t3 - TYPE(ExtPtfm_OutputType), INTENT(INOUT) :: y3 ! Output at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs - TYPE(ExtPtfm_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 + TYPE(ExtPtfm_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 > t3 + TYPE(ExtPtfm_OutputType), INTENT(INOUT) :: y2 ! Output at t2 > t3 + TYPE(ExtPtfm_OutputType), INTENT(INOUT) :: y3 ! Output at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs + TYPE(ExtPtfm_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 = 'ExtPtfm_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) - + 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) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_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 + 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 + 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 + 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 ExtPtfm_Output_ExtrapInterp2 - + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + 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 + y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + a3*y3%WriteOutput + END IF ! check if allocated +END SUBROUTINE END MODULE ExtPtfm_MCKF_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/feamooring/CMakeLists.txt b/modules/feamooring/CMakeLists.txt index 20a01aca85..9ff91c38c9 100644 --- a/modules/feamooring/CMakeLists.txt +++ b/modules/feamooring/CMakeLists.txt @@ -18,7 +18,7 @@ if (GENERATE_TYPES) generate_f90_types(src/FEAM_Registry.txt ${CMAKE_CURRENT_LIST_DIR}/src/FEAMooring_Types.f90) endif() -add_library(feamlib +add_library(feamlib STATIC src/FEAM.f90 src/FEAMooring_Types.f90 ) diff --git a/modules/feamooring/src/FEAMooring_Types.f90 b/modules/feamooring/src/FEAMooring_Types.f90 index 46cb3bec12..986f9ea0ab 100644 --- a/modules/feamooring/src/FEAMooring_Types.f90 +++ b/modules/feamooring/src/FEAMooring_Types.f90 @@ -35,7 +35,7 @@ MODULE FEAMooring_Types IMPLICIT NONE ! ========= FEAM_InputFile ======= TYPE, PUBLIC :: FEAM_InputFile - REAL(DbKi) :: DT !< Communication interval for mooring dynamics [s] + REAL(DbKi) :: DT = 0.0_R8Ki !< Communication interval for mooring dynamics [s] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: LineCI !< Mooring line inertia coefficient [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: LineCD !< Mooring line drag coefficient [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: LEAStiff !< Mooring line axial stiffness [-] @@ -53,18 +53,18 @@ MODULE FEAMooring_Types REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: GSL !< Linear spring stiffness at fairlead [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: GSR !< Rotational spring stiffness at fairlead [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: GE !< Reference tangent vector at fairlead [-] - INTEGER(IntKi) :: NumLines !< Number of lines [-] - INTEGER(IntKi) :: NumElems !< Number of elements [-] - REAL(ReKi) :: Eps !< Tolerance for static iteration [-] - REAL(ReKi) :: Gravity !< Gravity [-] - REAL(ReKi) :: WtrDens !< Water density [-] - INTEGER(IntKi) :: MaxIter !< Maximum number of iteration step for static analysis [-] - LOGICAL :: SumPrint !< Print summary data to .fsm? [-] - 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? [-] + INTEGER(IntKi) :: NumLines = 0_IntKi !< Number of lines [-] + INTEGER(IntKi) :: NumElems = 0_IntKi !< Number of elements [-] + REAL(ReKi) :: Eps = 0.0_ReKi !< Tolerance for static iteration [-] + REAL(ReKi) :: Gravity = 0.0_ReKi !< Gravity [-] + REAL(ReKi) :: WtrDens = 0.0_ReKi !< Water density [-] + INTEGER(IntKi) :: MaxIter = 0_IntKi !< Maximum number of iteration step for static analysis [-] + LOGICAL :: SumPrint = .false. !< Print summary data to .fsm? [-] + INTEGER(IntKi) :: OutFile = 0_IntKi !< 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 = .false. !< 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) [-] + REAL(DbKi) :: Tstart = 0.0_R8Ki !< Time to start module's tabular output [s] + INTEGER(IntKi) :: NumOuts = 0_IntKi !< Number of parameters in the output list (number of outputs requested) [-] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: OutList !< List of user-requested output channels [-] END TYPE FEAM_InputFile ! ======================= @@ -72,13 +72,13 @@ MODULE FEAMooring_Types TYPE, PUBLIC :: FEAM_InitInputType CHARACTER(1024) :: InputFile !< Name of the input file [-] CHARACTER(1024) :: RootName !< RootName for writing output files [-] - REAL(ReKi) , DIMENSION(1:6) :: PtfmInit !< Platform Initial Position [-] - INTEGER(IntKi) :: NStepWave !< [-] + REAL(ReKi) , DIMENSION(1:6) :: PtfmInit = 0.0_ReKi !< Platform Initial Position [-] + INTEGER(IntKi) :: NStepWave = 0_IntKi !< [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: WaveAcc0 !< [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: WaveTime !< [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: WaveVel0 !< [-] - REAL(ReKi) :: Gravity !< Gravity [-] - REAL(ReKi) :: WtrDens !< Water density [-] + REAL(ReKi) :: Gravity = 0.0_ReKi !< Gravity [-] + REAL(ReKi) :: WtrDens = 0.0_ReKi !< Water density [-] END TYPE FEAM_InitInputType ! ======================= ! ========= FEAM_InitOutputType ======= @@ -102,48 +102,48 @@ MODULE FEAMooring_Types ! ======================= ! ========= FEAM_DiscreteStateType ======= TYPE, PUBLIC :: FEAM_DiscreteStateType - REAL(ReKi) :: DummyDiscState !< Remove this variable if you have discrete states [-] + REAL(ReKi) :: DummyDiscState = 0.0_ReKi !< Remove this variable if you have discrete states [-] END TYPE FEAM_DiscreteStateType ! ======================= ! ========= FEAM_ConstraintStateType ======= TYPE, PUBLIC :: FEAM_ConstraintStateType - REAL(ReKi) , DIMENSION(1:3) :: TSN !< Lagrangian multiplier [-] - REAL(ReKi) , DIMENSION(1:3) :: TZER !< Lagrangian multiplier [-] + REAL(ReKi) , DIMENSION(1:3) :: TSN = 0.0_ReKi !< Lagrangian multiplier [-] + REAL(ReKi) , DIMENSION(1:3) :: TZER = 0.0_ReKi !< Lagrangian multiplier [-] END TYPE FEAM_ConstraintStateType ! ======================= ! ========= FEAM_OtherStateType ======= TYPE, PUBLIC :: FEAM_OtherStateType REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: GLU0 !< Global matrix U0 (previous state) [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: GLDDU !< Global matrix DDU (accleration) -- other state [-] - LOGICAL :: BottomTouch !< Bottom touch flag [-] + LOGICAL :: BottomTouch = .false. !< Bottom touch flag [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: GFORC0 !< Old element force matrix [-] REAL(ReKi) , DIMENSION(:,:,:,:), ALLOCATABLE :: GMASS0 !< Old element mass matrix [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: FAST_FPA !< Fairlead position - inputs from previous time step (we should replace this with a call to extrap-interp) [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: FAST_RP !< Fairlead tangent - part of output computation that was calculated in UpdateStates [-] - INTEGER(IntKi) :: INCR !< FEAM step [-] - REAL(ReKi) , DIMENSION(1:15) :: RSDF !< Line residue force - modifies values from previous call to FEAM_Solve [-] - REAL(ReKi) , DIMENSION(1:15) :: FORC0 !< - [Local old element force matrix] - REAL(ReKi) , DIMENSION(1:15,1:15) :: EMAS0 !< Local old element mass matrix [-] + INTEGER(IntKi) :: INCR = 0_IntKi !< FEAM step [-] + REAL(ReKi) , DIMENSION(1:15) :: RSDF = 0.0_ReKi !< Line residue force - modifies values from previous call to FEAM_Solve [-] + REAL(ReKi) , DIMENSION(1:15) :: FORC0 = 0.0_ReKi !< - [Local old element force matrix] + REAL(ReKi) , DIMENSION(1:15,1:15) :: EMAS0 = 0.0_ReKi !< Local old element mass matrix [-] END TYPE FEAM_OtherStateType ! ======================= ! ========= FEAM_MiscVarType ======= TYPE, PUBLIC :: FEAM_MiscVarType REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: GLF !< Global forcing matrix [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: GLK !< Global stiffness matrix [-] - REAL(ReKi) , DIMENSION(1:15,1:15) :: EMASS !< Line element mass [-] - REAL(ReKi) , DIMENSION(1:15,1:15) :: ESTIF !< Line element stiffness [-] + REAL(ReKi) , DIMENSION(1:15,1:15) :: EMASS = 0.0_ReKi !< Line element mass [-] + REAL(ReKi) , DIMENSION(1:15,1:15) :: ESTIF = 0.0_ReKi !< Line element stiffness [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: FAST_FP !< Fairlead position at t+dt [-] - REAL(ReKi) , DIMENSION(1:15) :: FORCE !< Line external force [-] - REAL(ReKi) , DIMENSION(1:3) :: FP !< Fairlead position - used in Couple routine [-] - REAL(ReKi) , DIMENSION(1:3,1:4) :: U !< Local matrix U [-] - REAL(ReKi) , DIMENSION(1:3,1:4) :: U0 !< Local matrix U0 [-] - REAL(ReKi) , DIMENSION(1:3,1:4) :: DU !< Local matrix DU [-] - REAL(ReKi) , DIMENSION(1:3,1:4) :: DDU !< Local matrix DDU [-] - REAL(ReKi) , DIMENSION(1:3) :: R !< POSITION VECTOR OF NODE OF ROD ELEMENT [-] - REAL(ReKi) , DIMENSION(1:3) :: RP !< DR/DS AT R (TANGENT - NEED NOT BE UNIT VECTOR) [-] - REAL(ReKi) , DIMENSION(1:6) :: RHSR !< RIGHT HAND SIDE CONTRIBUTION TO 6 DEGREES OF FREEDOM OF ROD NODE [-] - REAL(ReKi) , DIMENSION(1:3) :: SLIN !< LINEAR SPRING CONSTANT - portion of p%GSL [(UNITS OF FORCE/LENGTH)] - REAL(ReKi) , DIMENSION(1:6,1:6) :: STIFR !< STIFFNESS COEFFICIENTS FOR 6 DEGREES OF FREEDOM OF ROD NODE (X,DX/DS,Y,DY/DS,Z,DZ/DS) [-] + REAL(ReKi) , DIMENSION(1:15) :: FORCE = 0.0_ReKi !< Line external force [-] + REAL(ReKi) , DIMENSION(1:3) :: FP = 0.0_ReKi !< Fairlead position - used in Couple routine [-] + REAL(ReKi) , DIMENSION(1:3,1:4) :: U = 0.0_ReKi !< Local matrix U [-] + REAL(ReKi) , DIMENSION(1:3,1:4) :: U0 = 0.0_ReKi !< Local matrix U0 [-] + REAL(ReKi) , DIMENSION(1:3,1:4) :: DU = 0.0_ReKi !< Local matrix DU [-] + REAL(ReKi) , DIMENSION(1:3,1:4) :: DDU = 0.0_ReKi !< Local matrix DDU [-] + REAL(ReKi) , DIMENSION(1:3) :: R = 0.0_ReKi !< POSITION VECTOR OF NODE OF ROD ELEMENT [-] + REAL(ReKi) , DIMENSION(1:3) :: RP = 0.0_ReKi !< DR/DS AT R (TANGENT - NEED NOT BE UNIT VECTOR) [-] + REAL(ReKi) , DIMENSION(1:6) :: RHSR = 0.0_ReKi !< RIGHT HAND SIDE CONTRIBUTION TO 6 DEGREES OF FREEDOM OF ROD NODE [-] + REAL(ReKi) , DIMENSION(1:3) :: SLIN = 0.0_ReKi !< LINEAR SPRING CONSTANT - portion of p%GSL [(UNITS OF FORCE/LENGTH)] + REAL(ReKi) , DIMENSION(1:6,1:6) :: STIFR = 0.0_ReKi !< STIFFNESS COEFFICIENTS FOR 6 DEGREES OF FREEDOM OF ROD NODE (X,DX/DS,Y,DY/DS,Z,DZ/DS) [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: FAIR_ANG !< Fairlead angle [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: FAIR_T !< Fairlead tension [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: ANCH_ANG !< Anchor angle [-] @@ -151,24 +151,24 @@ MODULE FEAMooring_Types REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: Line_Coordinate !< Mooring line coordinate [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: Line_Tangent !< Mooring line tangent vector [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: F_Lines !< Mooring restoring force [-] - INTEGER(IntKi) :: LastIndWave !< FEAM step [-] + INTEGER(IntKi) :: LastIndWave = 0_IntKi !< FEAM step [-] END TYPE FEAM_MiscVarType ! ======================= ! ========= FEAM_ParameterType ======= TYPE, PUBLIC :: FEAM_ParameterType - REAL(DbKi) :: DT !< Time step for continuous state integration & discrete state update [seconds] - REAL(ReKi) , DIMENSION(1:3) :: GRAV !< Gravity [-] - REAL(ReKi) :: Eps !< Tolerance for static iteration [-] - REAL(ReKi) :: Gravity !< Gravity [-] - REAL(ReKi) :: WtrDens !< Water density [-] - INTEGER(IntKi) :: MaxIter !< Maximum number of iteration step for static analysis [-] - INTEGER(IntKi) :: NHBD !< Bandwidth = (NBAND+1)/2 [-] - INTEGER(IntKi) :: NDIM !< Dimension = 3 [-] + REAL(DbKi) :: DT = 0.0_R8Ki !< Time step for continuous state integration & discrete state update [seconds] + REAL(ReKi) , DIMENSION(1:3) :: GRAV = 0.0_ReKi !< Gravity [-] + REAL(ReKi) :: Eps = 0.0_ReKi !< Tolerance for static iteration [-] + REAL(ReKi) :: Gravity = 0.0_ReKi !< Gravity [-] + REAL(ReKi) :: WtrDens = 0.0_ReKi !< Water density [-] + INTEGER(IntKi) :: MaxIter = 0_IntKi !< Maximum number of iteration step for static analysis [-] + INTEGER(IntKi) :: NHBD = 0_IntKi !< Bandwidth = (NBAND+1)/2 [-] + INTEGER(IntKi) :: NDIM = 0_IntKi !< Dimension = 3 [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: NEQ !< Number of equation [-] - INTEGER(IntKi) :: NBAND !< Bandwidth [-] - INTEGER(IntKi) :: NumLines !< Number of lines [-] - INTEGER(IntKi) :: NumElems !< Number of elements [-] - INTEGER(IntKi) :: NumNodes !< Number of nodes [-] + INTEGER(IntKi) :: NBAND = 0_IntKi !< Bandwidth [-] + INTEGER(IntKi) :: NumLines = 0_IntKi !< Number of lines [-] + INTEGER(IntKi) :: NumElems = 0_IntKi !< Number of elements [-] + INTEGER(IntKi) :: NumNodes = 0_IntKi !< Number of nodes [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: GSL !< Linear spring stiffness at fairlead [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: GP !< Fairlead position [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Elength !< Element length [-] @@ -183,26 +183,26 @@ MODULE FEAMooring_Types REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: WaveAcc0 !< [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: WaveTime !< [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: WaveVel0 !< [-] - INTEGER(IntKi) :: NStepWave !< Number of wave steps [-] - REAL(ReKi) , DIMENSION(1:6,1:4) :: SHAP !< Shape function [-] - REAL(ReKi) , DIMENSION(1:6,1:4) :: SHAPS !< Shape function [-] - REAL(ReKi) , DIMENSION(1:6) :: GAUSSW !< Shape function [-] - INTEGER(IntKi) :: NGAUSS !< 6 POINT GAUSSIAN QUADRATURE INTEGRATION [-] - REAL(ReKi) , DIMENSION(1:10,1:4) :: SHAPT !< Shape function [-] - REAL(ReKi) , DIMENSION(1:10,1:4) :: SHAPTS !< Shape function [-] - INTEGER(IntKi) :: NTRAP !< 10 TRANPEZOIDE INTEGRATION point [-] - REAL(ReKi) , DIMENSION(1:4,1:4) :: SBEND !< Internal [-] - REAL(ReKi) , DIMENSION(1:3,1:4,1:4) :: STEN !< Internal [-] - REAL(ReKi) , DIMENSION(1:4,1:4) :: RMASS !< Internal [-] - REAL(ReKi) , DIMENSION(1:4,1:4,1:4,1:4) :: RADDM !< Internal [-] - REAL(ReKi) , DIMENSION(1:3,1:3) :: PMPN !< Internal [-] - REAL(ReKi) , DIMENSION(1:4) :: AM !< Internal [-] - REAL(ReKi) , DIMENSION(1:3) :: PM !< Internal [-] - INTEGER(IntKi) , DIMENSION(1:3,1:4) :: IDOF !< Internal [-] - INTEGER(IntKi) , DIMENSION(1:3) :: JDOF !< Internal [-] - REAL(ReKi) , DIMENSION(1:3,1:3,1:4) :: PPA !< Internal [-] - REAL(ReKi) :: PtfmRefzt !< Platform reference [-] - INTEGER(IntKi) :: NumOuts !< Number of parameters in the output list (number of outputs requested) [-] + INTEGER(IntKi) :: NStepWave = 0_IntKi !< Number of wave steps [-] + REAL(ReKi) , DIMENSION(1:6,1:4) :: SHAP = 0.0_ReKi !< Shape function [-] + REAL(ReKi) , DIMENSION(1:6,1:4) :: SHAPS = 0.0_ReKi !< Shape function [-] + REAL(ReKi) , DIMENSION(1:6) :: GAUSSW = 0.0_ReKi !< Shape function [-] + INTEGER(IntKi) :: NGAUSS = 0_IntKi !< 6 POINT GAUSSIAN QUADRATURE INTEGRATION [-] + REAL(ReKi) , DIMENSION(1:10,1:4) :: SHAPT = 0.0_ReKi !< Shape function [-] + REAL(ReKi) , DIMENSION(1:10,1:4) :: SHAPTS = 0.0_ReKi !< Shape function [-] + INTEGER(IntKi) :: NTRAP = 0_IntKi !< 10 TRANPEZOIDE INTEGRATION point [-] + REAL(ReKi) , DIMENSION(1:4,1:4) :: SBEND = 0.0_ReKi !< Internal [-] + REAL(ReKi) , DIMENSION(1:3,1:4,1:4) :: STEN = 0.0_ReKi !< Internal [-] + REAL(ReKi) , DIMENSION(1:4,1:4) :: RMASS = 0.0_ReKi !< Internal [-] + REAL(ReKi) , DIMENSION(1:4,1:4,1:4,1:4) :: RADDM = 0.0_ReKi !< Internal [-] + REAL(ReKi) , DIMENSION(1:3,1:3) :: PMPN = 0.0_ReKi !< Internal [-] + REAL(ReKi) , DIMENSION(1:4) :: AM = 0.0_ReKi !< Internal [-] + REAL(ReKi) , DIMENSION(1:3) :: PM = 0.0_ReKi !< Internal [-] + INTEGER(IntKi) , DIMENSION(1:3,1:4) :: IDOF = 0_IntKi !< Internal [-] + INTEGER(IntKi) , DIMENSION(1:3) :: JDOF = 0_IntKi !< Internal [-] + REAL(ReKi) , DIMENSION(1:3,1:3,1:4) :: PPA = 0.0_ReKi !< Internal [-] + REAL(ReKi) :: PtfmRefzt = 0.0_ReKi !< Platform reference [-] + INTEGER(IntKi) :: NumOuts = 0_IntKi !< Number of parameters in the output list (number of outputs requested) [-] 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 [-] @@ -224,6922 +224,1916 @@ MODULE FEAMooring_Types END TYPE FEAM_OutputType ! ======================= CONTAINS - SUBROUTINE FEAM_CopyInputFile( SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FEAM_InputFile), INTENT(IN) :: SrcInputFileData - TYPE(FEAM_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) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_CopyInputFile' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInputFileData%DT = SrcInputFileData%DT -IF (ALLOCATED(SrcInputFileData%LineCI)) THEN - i1_l = LBOUND(SrcInputFileData%LineCI,1) - i1_u = UBOUND(SrcInputFileData%LineCI,1) - IF (.NOT. ALLOCATED(DstInputFileData%LineCI)) THEN - ALLOCATE(DstInputFileData%LineCI(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%LineCI.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%LineCI = SrcInputFileData%LineCI -ENDIF -IF (ALLOCATED(SrcInputFileData%LineCD)) THEN - i1_l = LBOUND(SrcInputFileData%LineCD,1) - i1_u = UBOUND(SrcInputFileData%LineCD,1) - IF (.NOT. ALLOCATED(DstInputFileData%LineCD)) THEN - ALLOCATE(DstInputFileData%LineCD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%LineCD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%LineCD = SrcInputFileData%LineCD -ENDIF -IF (ALLOCATED(SrcInputFileData%LEAStiff)) THEN - i1_l = LBOUND(SrcInputFileData%LEAStiff,1) - i1_u = UBOUND(SrcInputFileData%LEAStiff,1) - IF (.NOT. ALLOCATED(DstInputFileData%LEAStiff)) THEN - ALLOCATE(DstInputFileData%LEAStiff(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%LEAStiff.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%LEAStiff = SrcInputFileData%LEAStiff -ENDIF -IF (ALLOCATED(SrcInputFileData%LMassDen)) THEN - i1_l = LBOUND(SrcInputFileData%LMassDen,1) - i1_u = UBOUND(SrcInputFileData%LMassDen,1) - IF (.NOT. ALLOCATED(DstInputFileData%LMassDen)) THEN - ALLOCATE(DstInputFileData%LMassDen(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%LMassDen.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%LMassDen = SrcInputFileData%LMassDen -ENDIF -IF (ALLOCATED(SrcInputFileData%LDMassDen)) THEN - i1_l = LBOUND(SrcInputFileData%LDMassDen,1) - i1_u = UBOUND(SrcInputFileData%LDMassDen,1) - IF (.NOT. ALLOCATED(DstInputFileData%LDMassDen)) THEN - ALLOCATE(DstInputFileData%LDMassDen(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%LDMassDen.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%LDMassDen = SrcInputFileData%LDMassDen -ENDIF -IF (ALLOCATED(SrcInputFileData%BottmStiff)) THEN - i1_l = LBOUND(SrcInputFileData%BottmStiff,1) - i1_u = UBOUND(SrcInputFileData%BottmStiff,1) - IF (.NOT. ALLOCATED(DstInputFileData%BottmStiff)) THEN - ALLOCATE(DstInputFileData%BottmStiff(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%BottmStiff.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%BottmStiff = SrcInputFileData%BottmStiff -ENDIF -IF (ALLOCATED(SrcInputFileData%LRadAnch)) THEN - i1_l = LBOUND(SrcInputFileData%LRadAnch,1) - i1_u = UBOUND(SrcInputFileData%LRadAnch,1) - IF (.NOT. ALLOCATED(DstInputFileData%LRadAnch)) THEN - ALLOCATE(DstInputFileData%LRadAnch(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%LRadAnch.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%LRadAnch = SrcInputFileData%LRadAnch -ENDIF -IF (ALLOCATED(SrcInputFileData%LAngAnch)) THEN - i1_l = LBOUND(SrcInputFileData%LAngAnch,1) - i1_u = UBOUND(SrcInputFileData%LAngAnch,1) - IF (.NOT. ALLOCATED(DstInputFileData%LAngAnch)) THEN - ALLOCATE(DstInputFileData%LAngAnch(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%LAngAnch.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%LAngAnch = SrcInputFileData%LAngAnch -ENDIF -IF (ALLOCATED(SrcInputFileData%LDpthAnch)) THEN - i1_l = LBOUND(SrcInputFileData%LDpthAnch,1) - i1_u = UBOUND(SrcInputFileData%LDpthAnch,1) - IF (.NOT. ALLOCATED(DstInputFileData%LDpthAnch)) THEN - ALLOCATE(DstInputFileData%LDpthAnch(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%LDpthAnch.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%LDpthAnch = SrcInputFileData%LDpthAnch -ENDIF -IF (ALLOCATED(SrcInputFileData%LRadFair)) THEN - i1_l = LBOUND(SrcInputFileData%LRadFair,1) - i1_u = UBOUND(SrcInputFileData%LRadFair,1) - IF (.NOT. ALLOCATED(DstInputFileData%LRadFair)) THEN - ALLOCATE(DstInputFileData%LRadFair(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%LRadFair.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%LRadFair = SrcInputFileData%LRadFair -ENDIF -IF (ALLOCATED(SrcInputFileData%LAngFair)) THEN - i1_l = LBOUND(SrcInputFileData%LAngFair,1) - i1_u = UBOUND(SrcInputFileData%LAngFair,1) - IF (.NOT. ALLOCATED(DstInputFileData%LAngFair)) THEN - ALLOCATE(DstInputFileData%LAngFair(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%LAngFair.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%LAngFair = SrcInputFileData%LAngFair -ENDIF -IF (ALLOCATED(SrcInputFileData%LDrftFair)) THEN - i1_l = LBOUND(SrcInputFileData%LDrftFair,1) - i1_u = UBOUND(SrcInputFileData%LDrftFair,1) - IF (.NOT. ALLOCATED(DstInputFileData%LDrftFair)) THEN - ALLOCATE(DstInputFileData%LDrftFair(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%LDrftFair.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%LDrftFair = SrcInputFileData%LDrftFair -ENDIF -IF (ALLOCATED(SrcInputFileData%LUnstrLen)) THEN - i1_l = LBOUND(SrcInputFileData%LUnstrLen,1) - i1_u = UBOUND(SrcInputFileData%LUnstrLen,1) - IF (.NOT. ALLOCATED(DstInputFileData%LUnstrLen)) THEN - ALLOCATE(DstInputFileData%LUnstrLen(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%LUnstrLen.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%LUnstrLen = SrcInputFileData%LUnstrLen -ENDIF -IF (ALLOCATED(SrcInputFileData%Tension)) THEN - i1_l = LBOUND(SrcInputFileData%Tension,1) - i1_u = UBOUND(SrcInputFileData%Tension,1) - IF (.NOT. ALLOCATED(DstInputFileData%Tension)) THEN - ALLOCATE(DstInputFileData%Tension(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%Tension.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%Tension = SrcInputFileData%Tension -ENDIF -IF (ALLOCATED(SrcInputFileData%GSL)) THEN - i1_l = LBOUND(SrcInputFileData%GSL,1) - i1_u = UBOUND(SrcInputFileData%GSL,1) - i2_l = LBOUND(SrcInputFileData%GSL,2) - i2_u = UBOUND(SrcInputFileData%GSL,2) - i3_l = LBOUND(SrcInputFileData%GSL,3) - i3_u = UBOUND(SrcInputFileData%GSL,3) - IF (.NOT. ALLOCATED(DstInputFileData%GSL)) THEN - ALLOCATE(DstInputFileData%GSL(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%GSL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%GSL = SrcInputFileData%GSL -ENDIF -IF (ALLOCATED(SrcInputFileData%GSR)) THEN - i1_l = LBOUND(SrcInputFileData%GSR,1) - i1_u = UBOUND(SrcInputFileData%GSR,1) - i2_l = LBOUND(SrcInputFileData%GSR,2) - i2_u = UBOUND(SrcInputFileData%GSR,2) - IF (.NOT. ALLOCATED(DstInputFileData%GSR)) THEN - ALLOCATE(DstInputFileData%GSR(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%GSR.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%GSR = SrcInputFileData%GSR -ENDIF -IF (ALLOCATED(SrcInputFileData%GE)) THEN - i1_l = LBOUND(SrcInputFileData%GE,1) - i1_u = UBOUND(SrcInputFileData%GE,1) - i2_l = LBOUND(SrcInputFileData%GE,2) - i2_u = UBOUND(SrcInputFileData%GE,2) - i3_l = LBOUND(SrcInputFileData%GE,3) - i3_u = UBOUND(SrcInputFileData%GE,3) - IF (.NOT. ALLOCATED(DstInputFileData%GE)) THEN - ALLOCATE(DstInputFileData%GE(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%GE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%GE = SrcInputFileData%GE -ENDIF - DstInputFileData%NumLines = SrcInputFileData%NumLines - DstInputFileData%NumElems = SrcInputFileData%NumElems - DstInputFileData%Eps = SrcInputFileData%Eps - DstInputFileData%Gravity = SrcInputFileData%Gravity - DstInputFileData%WtrDens = SrcInputFileData%WtrDens - DstInputFileData%MaxIter = SrcInputFileData%MaxIter - 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 - END SUBROUTINE FEAM_CopyInputFile - - SUBROUTINE FEAM_DestroyInputFile( InputFileData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(FEAM_InputFile), INTENT(INOUT) :: InputFileData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_DestroyInputFile' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(InputFileData%LineCI)) THEN - DEALLOCATE(InputFileData%LineCI) -ENDIF -IF (ALLOCATED(InputFileData%LineCD)) THEN - DEALLOCATE(InputFileData%LineCD) -ENDIF -IF (ALLOCATED(InputFileData%LEAStiff)) THEN - DEALLOCATE(InputFileData%LEAStiff) -ENDIF -IF (ALLOCATED(InputFileData%LMassDen)) THEN - DEALLOCATE(InputFileData%LMassDen) -ENDIF -IF (ALLOCATED(InputFileData%LDMassDen)) THEN - DEALLOCATE(InputFileData%LDMassDen) -ENDIF -IF (ALLOCATED(InputFileData%BottmStiff)) THEN - DEALLOCATE(InputFileData%BottmStiff) -ENDIF -IF (ALLOCATED(InputFileData%LRadAnch)) THEN - DEALLOCATE(InputFileData%LRadAnch) -ENDIF -IF (ALLOCATED(InputFileData%LAngAnch)) THEN - DEALLOCATE(InputFileData%LAngAnch) -ENDIF -IF (ALLOCATED(InputFileData%LDpthAnch)) THEN - DEALLOCATE(InputFileData%LDpthAnch) -ENDIF -IF (ALLOCATED(InputFileData%LRadFair)) THEN - DEALLOCATE(InputFileData%LRadFair) -ENDIF -IF (ALLOCATED(InputFileData%LAngFair)) THEN - DEALLOCATE(InputFileData%LAngFair) -ENDIF -IF (ALLOCATED(InputFileData%LDrftFair)) THEN - DEALLOCATE(InputFileData%LDrftFair) -ENDIF -IF (ALLOCATED(InputFileData%LUnstrLen)) THEN - DEALLOCATE(InputFileData%LUnstrLen) -ENDIF -IF (ALLOCATED(InputFileData%Tension)) THEN - DEALLOCATE(InputFileData%Tension) -ENDIF -IF (ALLOCATED(InputFileData%GSL)) THEN - DEALLOCATE(InputFileData%GSL) -ENDIF -IF (ALLOCATED(InputFileData%GSR)) THEN - DEALLOCATE(InputFileData%GSR) -ENDIF -IF (ALLOCATED(InputFileData%GE)) THEN - DEALLOCATE(InputFileData%GE) -ENDIF -IF (ALLOCATED(InputFileData%OutList)) THEN - DEALLOCATE(InputFileData%OutList) -ENDIF - END SUBROUTINE FEAM_DestroyInputFile - - SUBROUTINE FEAM_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(FEAM_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 = 'FEAM_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 ! LineCI allocated yes/no - IF ( ALLOCATED(InData%LineCI) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LineCI upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%LineCI) ! LineCI - END IF - Int_BufSz = Int_BufSz + 1 ! LineCD allocated yes/no - IF ( ALLOCATED(InData%LineCD) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LineCD upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%LineCD) ! LineCD - END IF - Int_BufSz = Int_BufSz + 1 ! LEAStiff allocated yes/no - IF ( ALLOCATED(InData%LEAStiff) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LEAStiff upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%LEAStiff) ! LEAStiff - END IF - Int_BufSz = Int_BufSz + 1 ! LMassDen allocated yes/no - IF ( ALLOCATED(InData%LMassDen) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LMassDen upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%LMassDen) ! LMassDen - END IF - Int_BufSz = Int_BufSz + 1 ! LDMassDen allocated yes/no - IF ( ALLOCATED(InData%LDMassDen) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LDMassDen upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%LDMassDen) ! LDMassDen - END IF - Int_BufSz = Int_BufSz + 1 ! BottmStiff allocated yes/no - IF ( ALLOCATED(InData%BottmStiff) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BottmStiff upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BottmStiff) ! BottmStiff - END IF - Int_BufSz = Int_BufSz + 1 ! LRadAnch allocated yes/no - IF ( ALLOCATED(InData%LRadAnch) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LRadAnch upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%LRadAnch) ! LRadAnch - END IF - Int_BufSz = Int_BufSz + 1 ! LAngAnch allocated yes/no - IF ( ALLOCATED(InData%LAngAnch) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LAngAnch upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%LAngAnch) ! LAngAnch - END IF - Int_BufSz = Int_BufSz + 1 ! LDpthAnch allocated yes/no - IF ( ALLOCATED(InData%LDpthAnch) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LDpthAnch upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%LDpthAnch) ! LDpthAnch - END IF - Int_BufSz = Int_BufSz + 1 ! LRadFair allocated yes/no - IF ( ALLOCATED(InData%LRadFair) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LRadFair upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%LRadFair) ! LRadFair - END IF - Int_BufSz = Int_BufSz + 1 ! LAngFair allocated yes/no - IF ( ALLOCATED(InData%LAngFair) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LAngFair upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%LAngFair) ! LAngFair - END IF - Int_BufSz = Int_BufSz + 1 ! LDrftFair allocated yes/no - IF ( ALLOCATED(InData%LDrftFair) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LDrftFair upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%LDrftFair) ! LDrftFair - END IF - Int_BufSz = Int_BufSz + 1 ! LUnstrLen allocated yes/no - IF ( ALLOCATED(InData%LUnstrLen) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LUnstrLen upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%LUnstrLen) ! LUnstrLen - END IF - Int_BufSz = Int_BufSz + 1 ! Tension allocated yes/no - IF ( ALLOCATED(InData%Tension) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Tension upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Tension) ! Tension - END IF - Int_BufSz = Int_BufSz + 1 ! GSL allocated yes/no - IF ( ALLOCATED(InData%GSL) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! GSL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%GSL) ! GSL - END IF - Int_BufSz = Int_BufSz + 1 ! GSR allocated yes/no - IF ( ALLOCATED(InData%GSR) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! GSR upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%GSR) ! GSR - END IF - Int_BufSz = Int_BufSz + 1 ! GE allocated yes/no - IF ( ALLOCATED(InData%GE) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! GE upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%GE) ! GE - END IF - Int_BufSz = Int_BufSz + 1 ! NumLines - Int_BufSz = Int_BufSz + 1 ! NumElems - Re_BufSz = Re_BufSz + 1 ! Eps - Re_BufSz = Re_BufSz + 1 ! Gravity - Re_BufSz = Re_BufSz + 1 ! WtrDens - Int_BufSz = Int_BufSz + 1 ! MaxIter - 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 - 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 - IF ( .NOT. ALLOCATED(InData%LineCI) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LineCI,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LineCI,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LineCI,1), UBOUND(InData%LineCI,1) - ReKiBuf(Re_Xferred) = InData%LineCI(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LineCD) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LineCD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LineCD,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LineCD,1), UBOUND(InData%LineCD,1) - ReKiBuf(Re_Xferred) = InData%LineCD(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LEAStiff) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LEAStiff,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LEAStiff,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LEAStiff,1), UBOUND(InData%LEAStiff,1) - ReKiBuf(Re_Xferred) = InData%LEAStiff(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LMassDen) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LMassDen,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LMassDen,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LMassDen,1), UBOUND(InData%LMassDen,1) - ReKiBuf(Re_Xferred) = InData%LMassDen(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LDMassDen) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LDMassDen,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LDMassDen,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LDMassDen,1), UBOUND(InData%LDMassDen,1) - ReKiBuf(Re_Xferred) = InData%LDMassDen(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BottmStiff) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BottmStiff,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BottmStiff,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BottmStiff,1), UBOUND(InData%BottmStiff,1) - ReKiBuf(Re_Xferred) = InData%BottmStiff(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LRadAnch) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LRadAnch,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LRadAnch,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LRadAnch,1), UBOUND(InData%LRadAnch,1) - ReKiBuf(Re_Xferred) = InData%LRadAnch(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LAngAnch) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LAngAnch,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LAngAnch,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LAngAnch,1), UBOUND(InData%LAngAnch,1) - ReKiBuf(Re_Xferred) = InData%LAngAnch(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LDpthAnch) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LDpthAnch,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LDpthAnch,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LDpthAnch,1), UBOUND(InData%LDpthAnch,1) - ReKiBuf(Re_Xferred) = InData%LDpthAnch(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LRadFair) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LRadFair,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LRadFair,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LRadFair,1), UBOUND(InData%LRadFair,1) - ReKiBuf(Re_Xferred) = InData%LRadFair(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LAngFair) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LAngFair,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LAngFair,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LAngFair,1), UBOUND(InData%LAngFair,1) - ReKiBuf(Re_Xferred) = InData%LAngFair(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LDrftFair) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LDrftFair,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LDrftFair,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LDrftFair,1), UBOUND(InData%LDrftFair,1) - ReKiBuf(Re_Xferred) = InData%LDrftFair(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LUnstrLen) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LUnstrLen,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LUnstrLen,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LUnstrLen,1), UBOUND(InData%LUnstrLen,1) - ReKiBuf(Re_Xferred) = InData%LUnstrLen(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Tension) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Tension,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Tension,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Tension,1), UBOUND(InData%Tension,1) - ReKiBuf(Re_Xferred) = InData%Tension(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%GSL) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%GSL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GSL,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%GSL,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GSL,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%GSL,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GSL,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%GSL,3), UBOUND(InData%GSL,3) - DO i2 = LBOUND(InData%GSL,2), UBOUND(InData%GSL,2) - DO i1 = LBOUND(InData%GSL,1), UBOUND(InData%GSL,1) - ReKiBuf(Re_Xferred) = InData%GSL(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%GSR) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%GSR,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GSR,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%GSR,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GSR,2) - Int_Xferred = Int_Xferred + 2 - DO i2 = LBOUND(InData%GSR,2), UBOUND(InData%GSR,2) - DO i1 = LBOUND(InData%GSR,1), UBOUND(InData%GSR,1) - ReKiBuf(Re_Xferred) = InData%GSR(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%GE) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%GE,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GE,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%GE,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GE,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%GE,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GE,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%GE,3), UBOUND(InData%GE,3) - DO i2 = LBOUND(InData%GE,2), UBOUND(InData%GE,2) - DO i1 = LBOUND(InData%GE,1), UBOUND(InData%GE,1) - ReKiBuf(Re_Xferred) = InData%GE(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NumLines - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumElems - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Eps - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Gravity - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WtrDens - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%MaxIter - Int_Xferred = Int_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 - END SUBROUTINE FEAM_PackInputFile - - SUBROUTINE FEAM_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(FEAM_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) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LineCI not allocated - Int_Xferred = Int_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%LineCI)) DEALLOCATE(OutData%LineCI) - ALLOCATE(OutData%LineCI(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LineCI.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LineCI,1), UBOUND(OutData%LineCI,1) - OutData%LineCI(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LineCD not allocated - Int_Xferred = Int_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%LineCD)) DEALLOCATE(OutData%LineCD) - ALLOCATE(OutData%LineCD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LineCD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LineCD,1), UBOUND(OutData%LineCD,1) - OutData%LineCD(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LEAStiff not allocated - Int_Xferred = Int_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%LEAStiff)) DEALLOCATE(OutData%LEAStiff) - ALLOCATE(OutData%LEAStiff(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LEAStiff.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LEAStiff,1), UBOUND(OutData%LEAStiff,1) - OutData%LEAStiff(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LMassDen not allocated - Int_Xferred = Int_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%LMassDen)) DEALLOCATE(OutData%LMassDen) - ALLOCATE(OutData%LMassDen(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LMassDen.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LMassDen,1), UBOUND(OutData%LMassDen,1) - OutData%LMassDen(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LDMassDen not allocated - Int_Xferred = Int_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%LDMassDen)) DEALLOCATE(OutData%LDMassDen) - ALLOCATE(OutData%LDMassDen(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LDMassDen.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LDMassDen,1), UBOUND(OutData%LDMassDen,1) - OutData%LDMassDen(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BottmStiff not allocated - Int_Xferred = Int_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%BottmStiff)) DEALLOCATE(OutData%BottmStiff) - ALLOCATE(OutData%BottmStiff(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BottmStiff.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BottmStiff,1), UBOUND(OutData%BottmStiff,1) - OutData%BottmStiff(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LRadAnch not allocated - Int_Xferred = Int_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%LRadAnch)) DEALLOCATE(OutData%LRadAnch) - ALLOCATE(OutData%LRadAnch(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LRadAnch.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LRadAnch,1), UBOUND(OutData%LRadAnch,1) - OutData%LRadAnch(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LAngAnch not allocated - Int_Xferred = Int_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%LAngAnch)) DEALLOCATE(OutData%LAngAnch) - ALLOCATE(OutData%LAngAnch(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LAngAnch.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LAngAnch,1), UBOUND(OutData%LAngAnch,1) - OutData%LAngAnch(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LDpthAnch not allocated - Int_Xferred = Int_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%LDpthAnch)) DEALLOCATE(OutData%LDpthAnch) - ALLOCATE(OutData%LDpthAnch(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LDpthAnch.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LDpthAnch,1), UBOUND(OutData%LDpthAnch,1) - OutData%LDpthAnch(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LRadFair not allocated - Int_Xferred = Int_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%LRadFair)) DEALLOCATE(OutData%LRadFair) - ALLOCATE(OutData%LRadFair(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LRadFair.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LRadFair,1), UBOUND(OutData%LRadFair,1) - OutData%LRadFair(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LAngFair not allocated - Int_Xferred = Int_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%LAngFair)) DEALLOCATE(OutData%LAngFair) - ALLOCATE(OutData%LAngFair(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LAngFair.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LAngFair,1), UBOUND(OutData%LAngFair,1) - OutData%LAngFair(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LDrftFair not allocated - Int_Xferred = Int_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%LDrftFair)) DEALLOCATE(OutData%LDrftFair) - ALLOCATE(OutData%LDrftFair(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LDrftFair.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LDrftFair,1), UBOUND(OutData%LDrftFair,1) - OutData%LDrftFair(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LUnstrLen not allocated - Int_Xferred = Int_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%LUnstrLen)) DEALLOCATE(OutData%LUnstrLen) - ALLOCATE(OutData%LUnstrLen(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LUnstrLen.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LUnstrLen,1), UBOUND(OutData%LUnstrLen,1) - OutData%LUnstrLen(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Tension not allocated - Int_Xferred = Int_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%Tension)) DEALLOCATE(OutData%Tension) - ALLOCATE(OutData%Tension(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Tension.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Tension,1), UBOUND(OutData%Tension,1) - OutData%Tension(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! GSL not allocated - Int_Xferred = Int_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%GSL)) DEALLOCATE(OutData%GSL) - ALLOCATE(OutData%GSL(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%GSL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%GSL,3), UBOUND(OutData%GSL,3) - DO i2 = LBOUND(OutData%GSL,2), UBOUND(OutData%GSL,2) - DO i1 = LBOUND(OutData%GSL,1), UBOUND(OutData%GSL,1) - OutData%GSL(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 ! GSR not allocated - Int_Xferred = Int_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%GSR)) DEALLOCATE(OutData%GSR) - ALLOCATE(OutData%GSR(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%GSR.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%GSR,2), UBOUND(OutData%GSR,2) - DO i1 = LBOUND(OutData%GSR,1), UBOUND(OutData%GSR,1) - OutData%GSR(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! GE not allocated - Int_Xferred = Int_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%GE)) DEALLOCATE(OutData%GE) - ALLOCATE(OutData%GE(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%GE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%GE,3), UBOUND(OutData%GE,3) - DO i2 = LBOUND(OutData%GE,2), UBOUND(OutData%GE,2) - DO i1 = LBOUND(OutData%GE,1), UBOUND(OutData%GE,1) - OutData%GE(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - OutData%NumLines = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumElems = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%Eps = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Gravity = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%WtrDens = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MaxIter = IntKiBuf(Int_Xferred) - Int_Xferred = Int_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 - END SUBROUTINE FEAM_UnPackInputFile - - SUBROUTINE FEAM_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FEAM_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(FEAM_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 = 'FEAM_CopyInitInput' -! +subroutine FEAM_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg) + type(FEAM_InputFile), intent(in) :: SrcInputFileData + type(FEAM_InputFile), intent(inout) :: DstInputFileData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'FEAM_CopyInputFile' ErrStat = ErrID_None - ErrMsg = "" - DstInitInputData%InputFile = SrcInitInputData%InputFile - DstInitInputData%RootName = SrcInitInputData%RootName - DstInitInputData%PtfmInit = SrcInitInputData%PtfmInit - DstInitInputData%NStepWave = SrcInitInputData%NStepWave -IF (ALLOCATED(SrcInitInputData%WaveAcc0)) THEN - i1_l = LBOUND(SrcInitInputData%WaveAcc0,1) - i1_u = UBOUND(SrcInitInputData%WaveAcc0,1) - i2_l = LBOUND(SrcInitInputData%WaveAcc0,2) - i2_u = UBOUND(SrcInitInputData%WaveAcc0,2) - i3_l = LBOUND(SrcInitInputData%WaveAcc0,3) - i3_u = UBOUND(SrcInitInputData%WaveAcc0,3) - IF (.NOT. ALLOCATED(DstInitInputData%WaveAcc0)) THEN - ALLOCATE(DstInitInputData%WaveAcc0(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%WaveAcc0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%WaveAcc0 = SrcInitInputData%WaveAcc0 -ENDIF -IF (ALLOCATED(SrcInitInputData%WaveTime)) THEN - i1_l = LBOUND(SrcInitInputData%WaveTime,1) - i1_u = UBOUND(SrcInitInputData%WaveTime,1) - IF (.NOT. ALLOCATED(DstInitInputData%WaveTime)) THEN - ALLOCATE(DstInitInputData%WaveTime(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveTime.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%WaveTime = SrcInitInputData%WaveTime -ENDIF -IF (ALLOCATED(SrcInitInputData%WaveVel0)) THEN - i1_l = LBOUND(SrcInitInputData%WaveVel0,1) - i1_u = UBOUND(SrcInitInputData%WaveVel0,1) - i2_l = LBOUND(SrcInitInputData%WaveVel0,2) - i2_u = UBOUND(SrcInitInputData%WaveVel0,2) - i3_l = LBOUND(SrcInitInputData%WaveVel0,3) - i3_u = UBOUND(SrcInitInputData%WaveVel0,3) - IF (.NOT. ALLOCATED(DstInitInputData%WaveVel0)) THEN - ALLOCATE(DstInitInputData%WaveVel0(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%WaveVel0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%WaveVel0 = SrcInitInputData%WaveVel0 -ENDIF - DstInitInputData%Gravity = SrcInitInputData%Gravity - DstInitInputData%WtrDens = SrcInitInputData%WtrDens - END SUBROUTINE FEAM_CopyInitInput - - SUBROUTINE FEAM_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(FEAM_InitInputType), INTENT(INOUT) :: InitInputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_DestroyInitInput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(InitInputData%WaveAcc0)) THEN - DEALLOCATE(InitInputData%WaveAcc0) -ENDIF -IF (ALLOCATED(InitInputData%WaveTime)) THEN - DEALLOCATE(InitInputData%WaveTime) -ENDIF -IF (ALLOCATED(InitInputData%WaveVel0)) THEN - DEALLOCATE(InitInputData%WaveVel0) -ENDIF - END SUBROUTINE FEAM_DestroyInitInput - - SUBROUTINE FEAM_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(FEAM_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 = 'FEAM_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%PtfmInit) ! PtfmInit - Int_BufSz = Int_BufSz + 1 ! NStepWave - Int_BufSz = Int_BufSz + 1 ! WaveAcc0 allocated yes/no - IF ( ALLOCATED(InData%WaveAcc0) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! WaveAcc0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveAcc0) ! WaveAcc0 - END IF - Int_BufSz = Int_BufSz + 1 ! WaveTime allocated yes/no - IF ( ALLOCATED(InData%WaveTime) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WaveTime upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveTime) ! WaveTime - END IF - Int_BufSz = Int_BufSz + 1 ! WaveVel0 allocated yes/no - IF ( ALLOCATED(InData%WaveVel0) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! WaveVel0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveVel0) ! WaveVel0 - END IF - Re_BufSz = Re_BufSz + 1 ! Gravity - Re_BufSz = Re_BufSz + 1 ! WtrDens - 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%PtfmInit,1), UBOUND(InData%PtfmInit,1) - ReKiBuf(Re_Xferred) = InData%PtfmInit(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%NStepWave - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%WaveAcc0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc0,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc0,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc0,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc0,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc0,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%WaveAcc0,3), UBOUND(InData%WaveAcc0,3) - DO i2 = LBOUND(InData%WaveAcc0,2), UBOUND(InData%WaveAcc0,2) - DO i1 = LBOUND(InData%WaveAcc0,1), UBOUND(InData%WaveAcc0,1) - ReKiBuf(Re_Xferred) = InData%WaveAcc0(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveTime) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveTime,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveTime,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WaveTime,1), UBOUND(InData%WaveTime,1) - ReKiBuf(Re_Xferred) = InData%WaveTime(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveVel0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel0,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel0,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel0,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel0,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel0,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%WaveVel0,3), UBOUND(InData%WaveVel0,3) - DO i2 = LBOUND(InData%WaveVel0,2), UBOUND(InData%WaveVel0,2) - DO i1 = LBOUND(InData%WaveVel0,1), UBOUND(InData%WaveVel0,1) - ReKiBuf(Re_Xferred) = InData%WaveVel0(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - ReKiBuf(Re_Xferred) = InData%Gravity - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WtrDens - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE FEAM_PackInitInput - - SUBROUTINE FEAM_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(FEAM_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 = 'FEAM_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%PtfmInit,1) - i1_u = UBOUND(OutData%PtfmInit,1) - DO i1 = LBOUND(OutData%PtfmInit,1), UBOUND(OutData%PtfmInit,1) - OutData%PtfmInit(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%NStepWave = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveAcc0 not allocated - Int_Xferred = Int_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%WaveAcc0)) DEALLOCATE(OutData%WaveAcc0) - ALLOCATE(OutData%WaveAcc0(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%WaveAcc0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%WaveAcc0,3), UBOUND(OutData%WaveAcc0,3) - DO i2 = LBOUND(OutData%WaveAcc0,2), UBOUND(OutData%WaveAcc0,2) - DO i1 = LBOUND(OutData%WaveAcc0,1), UBOUND(OutData%WaveAcc0,1) - OutData%WaveAcc0(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 ! WaveTime not allocated - Int_Xferred = Int_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%WaveTime)) DEALLOCATE(OutData%WaveTime) - ALLOCATE(OutData%WaveTime(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveTime.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WaveTime,1), UBOUND(OutData%WaveTime,1) - OutData%WaveTime(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveVel0 not allocated - Int_Xferred = Int_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%WaveVel0)) DEALLOCATE(OutData%WaveVel0) - ALLOCATE(OutData%WaveVel0(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%WaveVel0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%WaveVel0,3), UBOUND(OutData%WaveVel0,3) - DO i2 = LBOUND(OutData%WaveVel0,2), UBOUND(OutData%WaveVel0,2) - DO i1 = LBOUND(OutData%WaveVel0,1), UBOUND(OutData%WaveVel0,1) - OutData%WaveVel0(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - OutData%Gravity = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%WtrDens = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE FEAM_UnPackInitInput - - SUBROUTINE FEAM_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FEAM_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(FEAM_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 = 'FEAM_CopyInitOutput' -! + ErrMsg = '' + DstInputFileData%DT = SrcInputFileData%DT + if (allocated(SrcInputFileData%LineCI)) then + LB(1:1) = lbound(SrcInputFileData%LineCI) + UB(1:1) = ubound(SrcInputFileData%LineCI) + if (.not. allocated(DstInputFileData%LineCI)) then + allocate(DstInputFileData%LineCI(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%LineCI.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%LineCI = SrcInputFileData%LineCI + end if + if (allocated(SrcInputFileData%LineCD)) then + LB(1:1) = lbound(SrcInputFileData%LineCD) + UB(1:1) = ubound(SrcInputFileData%LineCD) + if (.not. allocated(DstInputFileData%LineCD)) then + allocate(DstInputFileData%LineCD(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%LineCD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%LineCD = SrcInputFileData%LineCD + end if + if (allocated(SrcInputFileData%LEAStiff)) then + LB(1:1) = lbound(SrcInputFileData%LEAStiff) + UB(1:1) = ubound(SrcInputFileData%LEAStiff) + if (.not. allocated(DstInputFileData%LEAStiff)) then + allocate(DstInputFileData%LEAStiff(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%LEAStiff.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%LEAStiff = SrcInputFileData%LEAStiff + end if + if (allocated(SrcInputFileData%LMassDen)) then + LB(1:1) = lbound(SrcInputFileData%LMassDen) + UB(1:1) = ubound(SrcInputFileData%LMassDen) + if (.not. allocated(DstInputFileData%LMassDen)) then + allocate(DstInputFileData%LMassDen(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%LMassDen.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%LMassDen = SrcInputFileData%LMassDen + end if + if (allocated(SrcInputFileData%LDMassDen)) then + LB(1:1) = lbound(SrcInputFileData%LDMassDen) + UB(1:1) = ubound(SrcInputFileData%LDMassDen) + if (.not. allocated(DstInputFileData%LDMassDen)) then + allocate(DstInputFileData%LDMassDen(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%LDMassDen.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%LDMassDen = SrcInputFileData%LDMassDen + end if + if (allocated(SrcInputFileData%BottmStiff)) then + LB(1:1) = lbound(SrcInputFileData%BottmStiff) + UB(1:1) = ubound(SrcInputFileData%BottmStiff) + if (.not. allocated(DstInputFileData%BottmStiff)) then + allocate(DstInputFileData%BottmStiff(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%BottmStiff.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%BottmStiff = SrcInputFileData%BottmStiff + end if + if (allocated(SrcInputFileData%LRadAnch)) then + LB(1:1) = lbound(SrcInputFileData%LRadAnch) + UB(1:1) = ubound(SrcInputFileData%LRadAnch) + if (.not. allocated(DstInputFileData%LRadAnch)) then + allocate(DstInputFileData%LRadAnch(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%LRadAnch.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%LRadAnch = SrcInputFileData%LRadAnch + end if + if (allocated(SrcInputFileData%LAngAnch)) then + LB(1:1) = lbound(SrcInputFileData%LAngAnch) + UB(1:1) = ubound(SrcInputFileData%LAngAnch) + if (.not. allocated(DstInputFileData%LAngAnch)) then + allocate(DstInputFileData%LAngAnch(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%LAngAnch.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%LAngAnch = SrcInputFileData%LAngAnch + end if + if (allocated(SrcInputFileData%LDpthAnch)) then + LB(1:1) = lbound(SrcInputFileData%LDpthAnch) + UB(1:1) = ubound(SrcInputFileData%LDpthAnch) + if (.not. allocated(DstInputFileData%LDpthAnch)) then + allocate(DstInputFileData%LDpthAnch(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%LDpthAnch.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%LDpthAnch = SrcInputFileData%LDpthAnch + end if + if (allocated(SrcInputFileData%LRadFair)) then + LB(1:1) = lbound(SrcInputFileData%LRadFair) + UB(1:1) = ubound(SrcInputFileData%LRadFair) + if (.not. allocated(DstInputFileData%LRadFair)) then + allocate(DstInputFileData%LRadFair(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%LRadFair.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%LRadFair = SrcInputFileData%LRadFair + end if + if (allocated(SrcInputFileData%LAngFair)) then + LB(1:1) = lbound(SrcInputFileData%LAngFair) + UB(1:1) = ubound(SrcInputFileData%LAngFair) + if (.not. allocated(DstInputFileData%LAngFair)) then + allocate(DstInputFileData%LAngFair(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%LAngFair.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%LAngFair = SrcInputFileData%LAngFair + end if + if (allocated(SrcInputFileData%LDrftFair)) then + LB(1:1) = lbound(SrcInputFileData%LDrftFair) + UB(1:1) = ubound(SrcInputFileData%LDrftFair) + if (.not. allocated(DstInputFileData%LDrftFair)) then + allocate(DstInputFileData%LDrftFair(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%LDrftFair.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%LDrftFair = SrcInputFileData%LDrftFair + end if + if (allocated(SrcInputFileData%LUnstrLen)) then + LB(1:1) = lbound(SrcInputFileData%LUnstrLen) + UB(1:1) = ubound(SrcInputFileData%LUnstrLen) + if (.not. allocated(DstInputFileData%LUnstrLen)) then + allocate(DstInputFileData%LUnstrLen(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%LUnstrLen.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%LUnstrLen = SrcInputFileData%LUnstrLen + end if + if (allocated(SrcInputFileData%Tension)) then + LB(1:1) = lbound(SrcInputFileData%Tension) + UB(1:1) = ubound(SrcInputFileData%Tension) + if (.not. allocated(DstInputFileData%Tension)) then + allocate(DstInputFileData%Tension(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%Tension.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%Tension = SrcInputFileData%Tension + end if + if (allocated(SrcInputFileData%GSL)) then + LB(1:3) = lbound(SrcInputFileData%GSL) + UB(1:3) = ubound(SrcInputFileData%GSL) + if (.not. allocated(DstInputFileData%GSL)) then + allocate(DstInputFileData%GSL(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%GSL.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%GSL = SrcInputFileData%GSL + end if + if (allocated(SrcInputFileData%GSR)) then + LB(1:2) = lbound(SrcInputFileData%GSR) + UB(1:2) = ubound(SrcInputFileData%GSR) + if (.not. allocated(DstInputFileData%GSR)) then + allocate(DstInputFileData%GSR(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%GSR.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%GSR = SrcInputFileData%GSR + end if + if (allocated(SrcInputFileData%GE)) then + LB(1:3) = lbound(SrcInputFileData%GE) + UB(1:3) = ubound(SrcInputFileData%GE) + if (.not. allocated(DstInputFileData%GE)) then + allocate(DstInputFileData%GE(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%GE.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%GE = SrcInputFileData%GE + end if + DstInputFileData%NumLines = SrcInputFileData%NumLines + DstInputFileData%NumElems = SrcInputFileData%NumElems + DstInputFileData%Eps = SrcInputFileData%Eps + DstInputFileData%Gravity = SrcInputFileData%Gravity + DstInputFileData%WtrDens = SrcInputFileData%WtrDens + DstInputFileData%MaxIter = SrcInputFileData%MaxIter + 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 + LB(1:1) = lbound(SrcInputFileData%OutList) + UB(1:1) = ubound(SrcInputFileData%OutList) + if (.not. allocated(DstInputFileData%OutList)) then + allocate(DstInputFileData%OutList(LB(1):UB(1)), 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 + end if +end subroutine + +subroutine FEAM_DestroyInputFile(InputFileData, ErrStat, ErrMsg) + type(FEAM_InputFile), intent(inout) :: InputFileData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FEAM_DestroyInputFile' 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%LAnchxi)) THEN - i1_l = LBOUND(SrcInitOutputData%LAnchxi,1) - i1_u = UBOUND(SrcInitOutputData%LAnchxi,1) - IF (.NOT. ALLOCATED(DstInitOutputData%LAnchxi)) THEN - ALLOCATE(DstInitOutputData%LAnchxi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LAnchxi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%LAnchxi = SrcInitOutputData%LAnchxi -ENDIF -IF (ALLOCATED(SrcInitOutputData%LAnchyi)) THEN - i1_l = LBOUND(SrcInitOutputData%LAnchyi,1) - i1_u = UBOUND(SrcInitOutputData%LAnchyi,1) - IF (.NOT. ALLOCATED(DstInitOutputData%LAnchyi)) THEN - ALLOCATE(DstInitOutputData%LAnchyi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LAnchyi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%LAnchyi = SrcInitOutputData%LAnchyi -ENDIF -IF (ALLOCATED(SrcInitOutputData%LAnchzi)) THEN - i1_l = LBOUND(SrcInitOutputData%LAnchzi,1) - i1_u = UBOUND(SrcInitOutputData%LAnchzi,1) - IF (.NOT. ALLOCATED(DstInitOutputData%LAnchzi)) THEN - ALLOCATE(DstInitOutputData%LAnchzi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LAnchzi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%LAnchzi = SrcInitOutputData%LAnchzi -ENDIF -IF (ALLOCATED(SrcInitOutputData%LFairxt)) THEN - i1_l = LBOUND(SrcInitOutputData%LFairxt,1) - i1_u = UBOUND(SrcInitOutputData%LFairxt,1) - IF (.NOT. ALLOCATED(DstInitOutputData%LFairxt)) THEN - ALLOCATE(DstInitOutputData%LFairxt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LFairxt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%LFairxt = SrcInitOutputData%LFairxt -ENDIF -IF (ALLOCATED(SrcInitOutputData%LFairyt)) THEN - i1_l = LBOUND(SrcInitOutputData%LFairyt,1) - i1_u = UBOUND(SrcInitOutputData%LFairyt,1) - IF (.NOT. ALLOCATED(DstInitOutputData%LFairyt)) THEN - ALLOCATE(DstInitOutputData%LFairyt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LFairyt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%LFairyt = SrcInitOutputData%LFairyt -ENDIF -IF (ALLOCATED(SrcInitOutputData%LFairzt)) THEN - i1_l = LBOUND(SrcInitOutputData%LFairzt,1) - i1_u = UBOUND(SrcInitOutputData%LFairzt,1) - IF (.NOT. ALLOCATED(DstInitOutputData%LFairzt)) THEN - ALLOCATE(DstInitOutputData%LFairzt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LFairzt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%LFairzt = SrcInitOutputData%LFairzt -ENDIF - END SUBROUTINE FEAM_CopyInitOutput - - SUBROUTINE FEAM_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(FEAM_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_DestroyInitOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(InitOutputData%WriteOutputHdr)) THEN - DEALLOCATE(InitOutputData%WriteOutputHdr) -ENDIF -IF (ALLOCATED(InitOutputData%WriteOutputUnt)) THEN - DEALLOCATE(InitOutputData%WriteOutputUnt) -ENDIF - CALL NWTC_Library_Destroyprogdesc( InitOutputData%Ver, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(InitOutputData%LAnchxi)) THEN - DEALLOCATE(InitOutputData%LAnchxi) -ENDIF -IF (ALLOCATED(InitOutputData%LAnchyi)) THEN - DEALLOCATE(InitOutputData%LAnchyi) -ENDIF -IF (ALLOCATED(InitOutputData%LAnchzi)) THEN - DEALLOCATE(InitOutputData%LAnchzi) -ENDIF -IF (ALLOCATED(InitOutputData%LFairxt)) THEN - DEALLOCATE(InitOutputData%LFairxt) -ENDIF -IF (ALLOCATED(InitOutputData%LFairyt)) THEN - DEALLOCATE(InitOutputData%LFairyt) -ENDIF -IF (ALLOCATED(InitOutputData%LFairzt)) THEN - DEALLOCATE(InitOutputData%LFairzt) -ENDIF - END SUBROUTINE FEAM_DestroyInitOutput - - SUBROUTINE FEAM_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(FEAM_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 = 'FEAM_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 ! LAnchxi allocated yes/no - IF ( ALLOCATED(InData%LAnchxi) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LAnchxi upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%LAnchxi) ! LAnchxi - END IF - Int_BufSz = Int_BufSz + 1 ! LAnchyi allocated yes/no - IF ( ALLOCATED(InData%LAnchyi) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LAnchyi upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%LAnchyi) ! LAnchyi - END IF - Int_BufSz = Int_BufSz + 1 ! LAnchzi allocated yes/no - IF ( ALLOCATED(InData%LAnchzi) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LAnchzi upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%LAnchzi) ! LAnchzi - END IF - Int_BufSz = Int_BufSz + 1 ! LFairxt allocated yes/no - IF ( ALLOCATED(InData%LFairxt) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LFairxt upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%LFairxt) ! LFairxt - END IF - Int_BufSz = Int_BufSz + 1 ! LFairyt allocated yes/no - IF ( ALLOCATED(InData%LFairyt) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LFairyt upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%LFairyt) ! LFairyt - END IF - Int_BufSz = Int_BufSz + 1 ! LFairzt allocated yes/no - IF ( ALLOCATED(InData%LFairzt) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LFairzt upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%LFairzt) ! LFairzt - 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%LAnchxi) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LAnchxi,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LAnchxi,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LAnchxi,1), UBOUND(InData%LAnchxi,1) - ReKiBuf(Re_Xferred) = InData%LAnchxi(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LAnchyi) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LAnchyi,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LAnchyi,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LAnchyi,1), UBOUND(InData%LAnchyi,1) - ReKiBuf(Re_Xferred) = InData%LAnchyi(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LAnchzi) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LAnchzi,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LAnchzi,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LAnchzi,1), UBOUND(InData%LAnchzi,1) - ReKiBuf(Re_Xferred) = InData%LAnchzi(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LFairxt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LFairxt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LFairxt,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LFairxt,1), UBOUND(InData%LFairxt,1) - ReKiBuf(Re_Xferred) = InData%LFairxt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LFairyt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LFairyt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LFairyt,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LFairyt,1), UBOUND(InData%LFairyt,1) - ReKiBuf(Re_Xferred) = InData%LFairyt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LFairzt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LFairzt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LFairzt,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LFairzt,1), UBOUND(InData%LFairzt,1) - ReKiBuf(Re_Xferred) = InData%LFairzt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE FEAM_PackInitOutput - - SUBROUTINE FEAM_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(FEAM_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 = 'FEAM_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 ! LAnchxi not allocated - Int_Xferred = Int_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%LAnchxi)) DEALLOCATE(OutData%LAnchxi) - ALLOCATE(OutData%LAnchxi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LAnchxi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LAnchxi,1), UBOUND(OutData%LAnchxi,1) - OutData%LAnchxi(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LAnchyi not allocated - Int_Xferred = Int_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%LAnchyi)) DEALLOCATE(OutData%LAnchyi) - ALLOCATE(OutData%LAnchyi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LAnchyi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LAnchyi,1), UBOUND(OutData%LAnchyi,1) - OutData%LAnchyi(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LAnchzi not allocated - Int_Xferred = Int_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%LAnchzi)) DEALLOCATE(OutData%LAnchzi) - ALLOCATE(OutData%LAnchzi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LAnchzi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LAnchzi,1), UBOUND(OutData%LAnchzi,1) - OutData%LAnchzi(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LFairxt not allocated - Int_Xferred = Int_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%LFairxt)) DEALLOCATE(OutData%LFairxt) - ALLOCATE(OutData%LFairxt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LFairxt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LFairxt,1), UBOUND(OutData%LFairxt,1) - OutData%LFairxt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LFairyt not allocated - Int_Xferred = Int_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%LFairyt)) DEALLOCATE(OutData%LFairyt) - ALLOCATE(OutData%LFairyt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LFairyt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LFairyt,1), UBOUND(OutData%LFairyt,1) - OutData%LFairyt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LFairzt not allocated - Int_Xferred = Int_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%LFairzt)) DEALLOCATE(OutData%LFairzt) - ALLOCATE(OutData%LFairzt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LFairzt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LFairzt,1), UBOUND(OutData%LFairzt,1) - OutData%LFairzt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE FEAM_UnPackInitOutput - - SUBROUTINE FEAM_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FEAM_ContinuousStateType), INTENT(IN) :: SrcContStateData - TYPE(FEAM_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 = 'FEAM_CopyContState' -! + ErrMsg = '' + if (allocated(InputFileData%LineCI)) then + deallocate(InputFileData%LineCI) + end if + if (allocated(InputFileData%LineCD)) then + deallocate(InputFileData%LineCD) + end if + if (allocated(InputFileData%LEAStiff)) then + deallocate(InputFileData%LEAStiff) + end if + if (allocated(InputFileData%LMassDen)) then + deallocate(InputFileData%LMassDen) + end if + if (allocated(InputFileData%LDMassDen)) then + deallocate(InputFileData%LDMassDen) + end if + if (allocated(InputFileData%BottmStiff)) then + deallocate(InputFileData%BottmStiff) + end if + if (allocated(InputFileData%LRadAnch)) then + deallocate(InputFileData%LRadAnch) + end if + if (allocated(InputFileData%LAngAnch)) then + deallocate(InputFileData%LAngAnch) + end if + if (allocated(InputFileData%LDpthAnch)) then + deallocate(InputFileData%LDpthAnch) + end if + if (allocated(InputFileData%LRadFair)) then + deallocate(InputFileData%LRadFair) + end if + if (allocated(InputFileData%LAngFair)) then + deallocate(InputFileData%LAngFair) + end if + if (allocated(InputFileData%LDrftFair)) then + deallocate(InputFileData%LDrftFair) + end if + if (allocated(InputFileData%LUnstrLen)) then + deallocate(InputFileData%LUnstrLen) + end if + if (allocated(InputFileData%Tension)) then + deallocate(InputFileData%Tension) + end if + if (allocated(InputFileData%GSL)) then + deallocate(InputFileData%GSL) + end if + if (allocated(InputFileData%GSR)) then + deallocate(InputFileData%GSR) + end if + if (allocated(InputFileData%GE)) then + deallocate(InputFileData%GE) + end if + if (allocated(InputFileData%OutList)) then + deallocate(InputFileData%OutList) + end if +end subroutine + +subroutine FEAM_PackInputFile(RF, Indata) + type(RegFile), intent(inout) :: RF + type(FEAM_InputFile), intent(in) :: InData + character(*), parameter :: RoutineName = 'FEAM_PackInputFile' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DT) + call RegPackAlloc(RF, InData%LineCI) + call RegPackAlloc(RF, InData%LineCD) + call RegPackAlloc(RF, InData%LEAStiff) + call RegPackAlloc(RF, InData%LMassDen) + call RegPackAlloc(RF, InData%LDMassDen) + call RegPackAlloc(RF, InData%BottmStiff) + call RegPackAlloc(RF, InData%LRadAnch) + call RegPackAlloc(RF, InData%LAngAnch) + call RegPackAlloc(RF, InData%LDpthAnch) + call RegPackAlloc(RF, InData%LRadFair) + call RegPackAlloc(RF, InData%LAngFair) + call RegPackAlloc(RF, InData%LDrftFair) + call RegPackAlloc(RF, InData%LUnstrLen) + call RegPackAlloc(RF, InData%Tension) + call RegPackAlloc(RF, InData%GSL) + call RegPackAlloc(RF, InData%GSR) + call RegPackAlloc(RF, InData%GE) + call RegPack(RF, InData%NumLines) + call RegPack(RF, InData%NumElems) + call RegPack(RF, InData%Eps) + call RegPack(RF, InData%Gravity) + call RegPack(RF, InData%WtrDens) + call RegPack(RF, InData%MaxIter) + call RegPack(RF, InData%SumPrint) + call RegPack(RF, InData%OutFile) + call RegPack(RF, InData%TabDelim) + call RegPack(RF, InData%OutFmt) + call RegPack(RF, InData%Tstart) + call RegPack(RF, InData%NumOuts) + call RegPackAlloc(RF, InData%OutList) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FEAM_UnPackInputFile(RF, OutData) + type(RegFile), intent(inout) :: RF + type(FEAM_InputFile), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FEAM_UnPackInputFile' + integer(B4Ki) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LineCI); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LineCD); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LEAStiff); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LMassDen); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LDMassDen); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BottmStiff); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LRadAnch); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LAngAnch); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LDpthAnch); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LRadFair); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LAngFair); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LDrftFair); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LUnstrLen); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Tension); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%GSL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%GSR); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%GE); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumLines); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumElems); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Eps); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Gravity); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WtrDens); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MaxIter); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SumPrint); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TabDelim); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutFmt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Tstart); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumOuts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%OutList); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FEAM_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) + type(FEAM_InitInputType), intent(in) :: SrcInitInputData + type(FEAM_InitInputType), intent(inout) :: DstInitInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'FEAM_CopyInitInput' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcContStateData%GLU)) THEN - i1_l = LBOUND(SrcContStateData%GLU,1) - i1_u = UBOUND(SrcContStateData%GLU,1) - i2_l = LBOUND(SrcContStateData%GLU,2) - i2_u = UBOUND(SrcContStateData%GLU,2) - IF (.NOT. ALLOCATED(DstContStateData%GLU)) THEN - ALLOCATE(DstContStateData%GLU(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%GLU.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstContStateData%GLU = SrcContStateData%GLU -ENDIF -IF (ALLOCATED(SrcContStateData%GLDU)) THEN - i1_l = LBOUND(SrcContStateData%GLDU,1) - i1_u = UBOUND(SrcContStateData%GLDU,1) - i2_l = LBOUND(SrcContStateData%GLDU,2) - i2_u = UBOUND(SrcContStateData%GLDU,2) - IF (.NOT. ALLOCATED(DstContStateData%GLDU)) THEN - ALLOCATE(DstContStateData%GLDU(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%GLDU.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstContStateData%GLDU = SrcContStateData%GLDU -ENDIF - END SUBROUTINE FEAM_CopyContState - - SUBROUTINE FEAM_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(FEAM_ContinuousStateType), INTENT(INOUT) :: ContStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_DestroyContState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(ContStateData%GLU)) THEN - DEALLOCATE(ContStateData%GLU) -ENDIF -IF (ALLOCATED(ContStateData%GLDU)) THEN - DEALLOCATE(ContStateData%GLDU) -ENDIF - END SUBROUTINE FEAM_DestroyContState - - SUBROUTINE FEAM_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(FEAM_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 = 'FEAM_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 ! GLU allocated yes/no - IF ( ALLOCATED(InData%GLU) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! GLU upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%GLU) ! GLU - END IF - Int_BufSz = Int_BufSz + 1 ! GLDU allocated yes/no - IF ( ALLOCATED(InData%GLDU) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! GLDU upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%GLDU) ! GLDU - 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%GLU) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%GLU,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GLU,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%GLU,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GLU,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%GLU,2), UBOUND(InData%GLU,2) - DO i1 = LBOUND(InData%GLU,1), UBOUND(InData%GLU,1) - ReKiBuf(Re_Xferred) = InData%GLU(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%GLDU) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%GLDU,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GLDU,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%GLDU,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GLDU,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%GLDU,2), UBOUND(InData%GLDU,2) - DO i1 = LBOUND(InData%GLDU,1), UBOUND(InData%GLDU,1) - ReKiBuf(Re_Xferred) = InData%GLDU(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE FEAM_PackContState - - SUBROUTINE FEAM_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(FEAM_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 = 'FEAM_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 ! GLU not allocated - Int_Xferred = Int_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%GLU)) DEALLOCATE(OutData%GLU) - ALLOCATE(OutData%GLU(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%GLU.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%GLU,2), UBOUND(OutData%GLU,2) - DO i1 = LBOUND(OutData%GLU,1), UBOUND(OutData%GLU,1) - OutData%GLU(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! GLDU not allocated - Int_Xferred = Int_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%GLDU)) DEALLOCATE(OutData%GLDU) - ALLOCATE(OutData%GLDU(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%GLDU.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%GLDU,2), UBOUND(OutData%GLDU,2) - DO i1 = LBOUND(OutData%GLDU,1), UBOUND(OutData%GLDU,1) - OutData%GLDU(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE FEAM_UnPackContState - - SUBROUTINE FEAM_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FEAM_DiscreteStateType), INTENT(IN) :: SrcDiscStateData - TYPE(FEAM_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 = 'FEAM_CopyDiscState' -! + ErrMsg = '' + DstInitInputData%InputFile = SrcInitInputData%InputFile + DstInitInputData%RootName = SrcInitInputData%RootName + DstInitInputData%PtfmInit = SrcInitInputData%PtfmInit + DstInitInputData%NStepWave = SrcInitInputData%NStepWave + if (allocated(SrcInitInputData%WaveAcc0)) then + LB(1:3) = lbound(SrcInitInputData%WaveAcc0) + UB(1:3) = ubound(SrcInitInputData%WaveAcc0) + if (.not. allocated(DstInitInputData%WaveAcc0)) then + allocate(DstInitInputData%WaveAcc0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveAcc0.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%WaveAcc0 = SrcInitInputData%WaveAcc0 + end if + if (allocated(SrcInitInputData%WaveTime)) then + LB(1:1) = lbound(SrcInitInputData%WaveTime) + UB(1:1) = ubound(SrcInitInputData%WaveTime) + if (.not. allocated(DstInitInputData%WaveTime)) then + allocate(DstInitInputData%WaveTime(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveTime.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%WaveTime = SrcInitInputData%WaveTime + end if + if (allocated(SrcInitInputData%WaveVel0)) then + LB(1:3) = lbound(SrcInitInputData%WaveVel0) + UB(1:3) = ubound(SrcInitInputData%WaveVel0) + if (.not. allocated(DstInitInputData%WaveVel0)) then + allocate(DstInitInputData%WaveVel0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveVel0.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%WaveVel0 = SrcInitInputData%WaveVel0 + end if + DstInitInputData%Gravity = SrcInitInputData%Gravity + DstInitInputData%WtrDens = SrcInitInputData%WtrDens +end subroutine + +subroutine FEAM_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(FEAM_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FEAM_DestroyInitInput' ErrStat = ErrID_None - ErrMsg = "" - DstDiscStateData%DummyDiscState = SrcDiscStateData%DummyDiscState - END SUBROUTINE FEAM_CopyDiscState - - SUBROUTINE FEAM_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(FEAM_DiscreteStateType), INTENT(INOUT) :: DiscStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_DestroyDiscState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE FEAM_DestroyDiscState - - SUBROUTINE FEAM_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(FEAM_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 = 'FEAM_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 FEAM_PackDiscState - - SUBROUTINE FEAM_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(FEAM_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 = 'FEAM_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 FEAM_UnPackDiscState - - SUBROUTINE FEAM_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FEAM_ConstraintStateType), INTENT(IN) :: SrcConstrStateData - TYPE(FEAM_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 = 'FEAM_CopyConstrState' -! + ErrMsg = '' + if (allocated(InitInputData%WaveAcc0)) then + deallocate(InitInputData%WaveAcc0) + end if + if (allocated(InitInputData%WaveTime)) then + deallocate(InitInputData%WaveTime) + end if + if (allocated(InitInputData%WaveVel0)) then + deallocate(InitInputData%WaveVel0) + end if +end subroutine + +subroutine FEAM_PackInitInput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(FEAM_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FEAM_PackInitInput' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%InputFile) + call RegPack(RF, InData%RootName) + call RegPack(RF, InData%PtfmInit) + call RegPack(RF, InData%NStepWave) + call RegPackAlloc(RF, InData%WaveAcc0) + call RegPackAlloc(RF, InData%WaveTime) + call RegPackAlloc(RF, InData%WaveVel0) + call RegPack(RF, InData%Gravity) + call RegPack(RF, InData%WtrDens) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FEAM_UnPackInitInput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(FEAM_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FEAM_UnPackInitInput' + integer(B4Ki) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%InputFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RootName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PtfmInit); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NStepWave); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WaveAcc0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WaveTime); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WaveVel0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Gravity); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WtrDens); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FEAM_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) + type(FEAM_InitOutputType), intent(in) :: SrcInitOutputData + type(FEAM_InitOutputType), intent(inout) :: DstInitOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FEAM_CopyInitOutput' ErrStat = ErrID_None - ErrMsg = "" - DstConstrStateData%TSN = SrcConstrStateData%TSN - DstConstrStateData%TZER = SrcConstrStateData%TZER - END SUBROUTINE FEAM_CopyConstrState - - SUBROUTINE FEAM_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(FEAM_ConstraintStateType), INTENT(INOUT) :: ConstrStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_DestroyConstrState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE FEAM_DestroyConstrState - - SUBROUTINE FEAM_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(FEAM_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 = 'FEAM_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 + SIZE(InData%TSN) ! TSN - Re_BufSz = Re_BufSz + SIZE(InData%TZER) ! TZER - 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%TSN,1), UBOUND(InData%TSN,1) - ReKiBuf(Re_Xferred) = InData%TSN(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%TZER,1), UBOUND(InData%TZER,1) - ReKiBuf(Re_Xferred) = InData%TZER(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END SUBROUTINE FEAM_PackConstrState - - SUBROUTINE FEAM_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(FEAM_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 = 'FEAM_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 - i1_l = LBOUND(OutData%TSN,1) - i1_u = UBOUND(OutData%TSN,1) - DO i1 = LBOUND(OutData%TSN,1), UBOUND(OutData%TSN,1) - OutData%TSN(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%TZER,1) - i1_u = UBOUND(OutData%TZER,1) - DO i1 = LBOUND(OutData%TZER,1), UBOUND(OutData%TZER,1) - OutData%TZER(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END SUBROUTINE FEAM_UnPackConstrState - - SUBROUTINE FEAM_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FEAM_OtherStateType), INTENT(IN) :: SrcOtherStateData - TYPE(FEAM_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) :: 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 = 'FEAM_CopyOtherState' -! + ErrMsg = '' + if (allocated(SrcInitOutputData%WriteOutputHdr)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) + if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then + allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitOutputData%WriteOutputUnt)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) + if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then + allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), 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 + end if + 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%LAnchxi)) then + LB(1:1) = lbound(SrcInitOutputData%LAnchxi) + UB(1:1) = ubound(SrcInitOutputData%LAnchxi) + if (.not. allocated(DstInitOutputData%LAnchxi)) then + allocate(DstInitOutputData%LAnchxi(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LAnchxi.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%LAnchxi = SrcInitOutputData%LAnchxi + end if + if (allocated(SrcInitOutputData%LAnchyi)) then + LB(1:1) = lbound(SrcInitOutputData%LAnchyi) + UB(1:1) = ubound(SrcInitOutputData%LAnchyi) + if (.not. allocated(DstInitOutputData%LAnchyi)) then + allocate(DstInitOutputData%LAnchyi(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LAnchyi.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%LAnchyi = SrcInitOutputData%LAnchyi + end if + if (allocated(SrcInitOutputData%LAnchzi)) then + LB(1:1) = lbound(SrcInitOutputData%LAnchzi) + UB(1:1) = ubound(SrcInitOutputData%LAnchzi) + if (.not. allocated(DstInitOutputData%LAnchzi)) then + allocate(DstInitOutputData%LAnchzi(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LAnchzi.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%LAnchzi = SrcInitOutputData%LAnchzi + end if + if (allocated(SrcInitOutputData%LFairxt)) then + LB(1:1) = lbound(SrcInitOutputData%LFairxt) + UB(1:1) = ubound(SrcInitOutputData%LFairxt) + if (.not. allocated(DstInitOutputData%LFairxt)) then + allocate(DstInitOutputData%LFairxt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LFairxt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%LFairxt = SrcInitOutputData%LFairxt + end if + if (allocated(SrcInitOutputData%LFairyt)) then + LB(1:1) = lbound(SrcInitOutputData%LFairyt) + UB(1:1) = ubound(SrcInitOutputData%LFairyt) + if (.not. allocated(DstInitOutputData%LFairyt)) then + allocate(DstInitOutputData%LFairyt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LFairyt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%LFairyt = SrcInitOutputData%LFairyt + end if + if (allocated(SrcInitOutputData%LFairzt)) then + LB(1:1) = lbound(SrcInitOutputData%LFairzt) + UB(1:1) = ubound(SrcInitOutputData%LFairzt) + if (.not. allocated(DstInitOutputData%LFairzt)) then + allocate(DstInitOutputData%LFairzt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LFairzt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%LFairzt = SrcInitOutputData%LFairzt + end if +end subroutine + +subroutine FEAM_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(FEAM_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FEAM_DestroyInitOutput' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcOtherStateData%GLU0)) THEN - i1_l = LBOUND(SrcOtherStateData%GLU0,1) - i1_u = UBOUND(SrcOtherStateData%GLU0,1) - i2_l = LBOUND(SrcOtherStateData%GLU0,2) - i2_u = UBOUND(SrcOtherStateData%GLU0,2) - IF (.NOT. ALLOCATED(DstOtherStateData%GLU0)) THEN - ALLOCATE(DstOtherStateData%GLU0(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%GLU0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOtherStateData%GLU0 = SrcOtherStateData%GLU0 -ENDIF -IF (ALLOCATED(SrcOtherStateData%GLDDU)) THEN - i1_l = LBOUND(SrcOtherStateData%GLDDU,1) - i1_u = UBOUND(SrcOtherStateData%GLDDU,1) - i2_l = LBOUND(SrcOtherStateData%GLDDU,2) - i2_u = UBOUND(SrcOtherStateData%GLDDU,2) - IF (.NOT. ALLOCATED(DstOtherStateData%GLDDU)) THEN - ALLOCATE(DstOtherStateData%GLDDU(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%GLDDU.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOtherStateData%GLDDU = SrcOtherStateData%GLDDU -ENDIF - DstOtherStateData%BottomTouch = SrcOtherStateData%BottomTouch -IF (ALLOCATED(SrcOtherStateData%GFORC0)) THEN - i1_l = LBOUND(SrcOtherStateData%GFORC0,1) - i1_u = UBOUND(SrcOtherStateData%GFORC0,1) - i2_l = LBOUND(SrcOtherStateData%GFORC0,2) - i2_u = UBOUND(SrcOtherStateData%GFORC0,2) - i3_l = LBOUND(SrcOtherStateData%GFORC0,3) - i3_u = UBOUND(SrcOtherStateData%GFORC0,3) - IF (.NOT. ALLOCATED(DstOtherStateData%GFORC0)) THEN - ALLOCATE(DstOtherStateData%GFORC0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%GFORC0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOtherStateData%GFORC0 = SrcOtherStateData%GFORC0 -ENDIF -IF (ALLOCATED(SrcOtherStateData%GMASS0)) THEN - i1_l = LBOUND(SrcOtherStateData%GMASS0,1) - i1_u = UBOUND(SrcOtherStateData%GMASS0,1) - i2_l = LBOUND(SrcOtherStateData%GMASS0,2) - i2_u = UBOUND(SrcOtherStateData%GMASS0,2) - i3_l = LBOUND(SrcOtherStateData%GMASS0,3) - i3_u = UBOUND(SrcOtherStateData%GMASS0,3) - i4_l = LBOUND(SrcOtherStateData%GMASS0,4) - i4_u = UBOUND(SrcOtherStateData%GMASS0,4) - IF (.NOT. ALLOCATED(DstOtherStateData%GMASS0)) THEN - ALLOCATE(DstOtherStateData%GMASS0(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 DstOtherStateData%GMASS0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOtherStateData%GMASS0 = SrcOtherStateData%GMASS0 -ENDIF -IF (ALLOCATED(SrcOtherStateData%FAST_FPA)) THEN - i1_l = LBOUND(SrcOtherStateData%FAST_FPA,1) - i1_u = UBOUND(SrcOtherStateData%FAST_FPA,1) - i2_l = LBOUND(SrcOtherStateData%FAST_FPA,2) - i2_u = UBOUND(SrcOtherStateData%FAST_FPA,2) - IF (.NOT. ALLOCATED(DstOtherStateData%FAST_FPA)) THEN - ALLOCATE(DstOtherStateData%FAST_FPA(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%FAST_FPA.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOtherStateData%FAST_FPA = SrcOtherStateData%FAST_FPA -ENDIF -IF (ALLOCATED(SrcOtherStateData%FAST_RP)) THEN - i1_l = LBOUND(SrcOtherStateData%FAST_RP,1) - i1_u = UBOUND(SrcOtherStateData%FAST_RP,1) - i2_l = LBOUND(SrcOtherStateData%FAST_RP,2) - i2_u = UBOUND(SrcOtherStateData%FAST_RP,2) - IF (.NOT. ALLOCATED(DstOtherStateData%FAST_RP)) THEN - ALLOCATE(DstOtherStateData%FAST_RP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%FAST_RP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOtherStateData%FAST_RP = SrcOtherStateData%FAST_RP -ENDIF - DstOtherStateData%INCR = SrcOtherStateData%INCR - DstOtherStateData%RSDF = SrcOtherStateData%RSDF - DstOtherStateData%FORC0 = SrcOtherStateData%FORC0 - DstOtherStateData%EMAS0 = SrcOtherStateData%EMAS0 - END SUBROUTINE FEAM_CopyOtherState - - SUBROUTINE FEAM_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(FEAM_OtherStateType), INTENT(INOUT) :: OtherStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_DestroyOtherState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(OtherStateData%GLU0)) THEN - DEALLOCATE(OtherStateData%GLU0) -ENDIF -IF (ALLOCATED(OtherStateData%GLDDU)) THEN - DEALLOCATE(OtherStateData%GLDDU) -ENDIF -IF (ALLOCATED(OtherStateData%GFORC0)) THEN - DEALLOCATE(OtherStateData%GFORC0) -ENDIF -IF (ALLOCATED(OtherStateData%GMASS0)) THEN - DEALLOCATE(OtherStateData%GMASS0) -ENDIF -IF (ALLOCATED(OtherStateData%FAST_FPA)) THEN - DEALLOCATE(OtherStateData%FAST_FPA) -ENDIF -IF (ALLOCATED(OtherStateData%FAST_RP)) THEN - DEALLOCATE(OtherStateData%FAST_RP) -ENDIF - END SUBROUTINE FEAM_DestroyOtherState - - SUBROUTINE FEAM_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(FEAM_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 = 'FEAM_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 ! GLU0 allocated yes/no - IF ( ALLOCATED(InData%GLU0) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! GLU0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%GLU0) ! GLU0 - END IF - Int_BufSz = Int_BufSz + 1 ! GLDDU allocated yes/no - IF ( ALLOCATED(InData%GLDDU) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! GLDDU upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%GLDDU) ! GLDDU - END IF - Int_BufSz = Int_BufSz + 1 ! BottomTouch - Int_BufSz = Int_BufSz + 1 ! GFORC0 allocated yes/no - IF ( ALLOCATED(InData%GFORC0) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! GFORC0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%GFORC0) ! GFORC0 - END IF - Int_BufSz = Int_BufSz + 1 ! GMASS0 allocated yes/no - IF ( ALLOCATED(InData%GMASS0) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! GMASS0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%GMASS0) ! GMASS0 - END IF - Int_BufSz = Int_BufSz + 1 ! FAST_FPA allocated yes/no - IF ( ALLOCATED(InData%FAST_FPA) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! FAST_FPA upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%FAST_FPA) ! FAST_FPA - END IF - Int_BufSz = Int_BufSz + 1 ! FAST_RP allocated yes/no - IF ( ALLOCATED(InData%FAST_RP) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! FAST_RP upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%FAST_RP) ! FAST_RP - END IF - Int_BufSz = Int_BufSz + 1 ! INCR - Re_BufSz = Re_BufSz + SIZE(InData%RSDF) ! RSDF - Re_BufSz = Re_BufSz + SIZE(InData%FORC0) ! FORC0 - Re_BufSz = Re_BufSz + SIZE(InData%EMAS0) ! EMAS0 - 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%GLU0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%GLU0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GLU0,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%GLU0,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GLU0,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%GLU0,2), UBOUND(InData%GLU0,2) - DO i1 = LBOUND(InData%GLU0,1), UBOUND(InData%GLU0,1) - ReKiBuf(Re_Xferred) = InData%GLU0(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%GLDDU) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%GLDDU,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GLDDU,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%GLDDU,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GLDDU,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%GLDDU,2), UBOUND(InData%GLDDU,2) - DO i1 = LBOUND(InData%GLDDU,1), UBOUND(InData%GLDDU,1) - ReKiBuf(Re_Xferred) = InData%GLDDU(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = TRANSFER(InData%BottomTouch, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%GFORC0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%GFORC0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GFORC0,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%GFORC0,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GFORC0,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%GFORC0,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GFORC0,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%GFORC0,3), UBOUND(InData%GFORC0,3) - DO i2 = LBOUND(InData%GFORC0,2), UBOUND(InData%GFORC0,2) - DO i1 = LBOUND(InData%GFORC0,1), UBOUND(InData%GFORC0,1) - ReKiBuf(Re_Xferred) = InData%GFORC0(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%GMASS0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%GMASS0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GMASS0,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%GMASS0,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GMASS0,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%GMASS0,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GMASS0,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%GMASS0,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GMASS0,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%GMASS0,4), UBOUND(InData%GMASS0,4) - DO i3 = LBOUND(InData%GMASS0,3), UBOUND(InData%GMASS0,3) - DO i2 = LBOUND(InData%GMASS0,2), UBOUND(InData%GMASS0,2) - DO i1 = LBOUND(InData%GMASS0,1), UBOUND(InData%GMASS0,1) - ReKiBuf(Re_Xferred) = InData%GMASS0(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%FAST_FPA) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FAST_FPA,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FAST_FPA,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FAST_FPA,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FAST_FPA,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%FAST_FPA,2), UBOUND(InData%FAST_FPA,2) - DO i1 = LBOUND(InData%FAST_FPA,1), UBOUND(InData%FAST_FPA,1) - ReKiBuf(Re_Xferred) = InData%FAST_FPA(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%FAST_RP) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FAST_RP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FAST_RP,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FAST_RP,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FAST_RP,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%FAST_RP,2), UBOUND(InData%FAST_RP,2) - DO i1 = LBOUND(InData%FAST_RP,1), UBOUND(InData%FAST_RP,1) - ReKiBuf(Re_Xferred) = InData%FAST_RP(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%INCR - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%RSDF,1), UBOUND(InData%RSDF,1) - ReKiBuf(Re_Xferred) = InData%RSDF(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%FORC0,1), UBOUND(InData%FORC0,1) - ReKiBuf(Re_Xferred) = InData%FORC0(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i2 = LBOUND(InData%EMAS0,2), UBOUND(InData%EMAS0,2) - DO i1 = LBOUND(InData%EMAS0,1), UBOUND(InData%EMAS0,1) - ReKiBuf(Re_Xferred) = InData%EMAS0(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END SUBROUTINE FEAM_PackOtherState - - SUBROUTINE FEAM_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(FEAM_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) :: 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 = 'FEAM_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 ! GLU0 not allocated - Int_Xferred = Int_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%GLU0)) DEALLOCATE(OutData%GLU0) - ALLOCATE(OutData%GLU0(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%GLU0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%GLU0,2), UBOUND(OutData%GLU0,2) - DO i1 = LBOUND(OutData%GLU0,1), UBOUND(OutData%GLU0,1) - OutData%GLU0(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! GLDDU not allocated - Int_Xferred = Int_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%GLDDU)) DEALLOCATE(OutData%GLDDU) - ALLOCATE(OutData%GLDDU(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%GLDDU.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%GLDDU,2), UBOUND(OutData%GLDDU,2) - DO i1 = LBOUND(OutData%GLDDU,1), UBOUND(OutData%GLDDU,1) - OutData%GLDDU(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%BottomTouch = TRANSFER(IntKiBuf(Int_Xferred), OutData%BottomTouch) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! GFORC0 not allocated - Int_Xferred = Int_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%GFORC0)) DEALLOCATE(OutData%GFORC0) - ALLOCATE(OutData%GFORC0(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%GFORC0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%GFORC0,3), UBOUND(OutData%GFORC0,3) - DO i2 = LBOUND(OutData%GFORC0,2), UBOUND(OutData%GFORC0,2) - DO i1 = LBOUND(OutData%GFORC0,1), UBOUND(OutData%GFORC0,1) - OutData%GFORC0(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 ! GMASS0 not allocated - Int_Xferred = Int_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%GMASS0)) DEALLOCATE(OutData%GMASS0) - ALLOCATE(OutData%GMASS0(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%GMASS0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%GMASS0,4), UBOUND(OutData%GMASS0,4) - DO i3 = LBOUND(OutData%GMASS0,3), UBOUND(OutData%GMASS0,3) - DO i2 = LBOUND(OutData%GMASS0,2), UBOUND(OutData%GMASS0,2) - DO i1 = LBOUND(OutData%GMASS0,1), UBOUND(OutData%GMASS0,1) - OutData%GMASS0(i1,i2,i3,i4) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FAST_FPA not allocated - Int_Xferred = Int_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%FAST_FPA)) DEALLOCATE(OutData%FAST_FPA) - ALLOCATE(OutData%FAST_FPA(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FAST_FPA.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%FAST_FPA,2), UBOUND(OutData%FAST_FPA,2) - DO i1 = LBOUND(OutData%FAST_FPA,1), UBOUND(OutData%FAST_FPA,1) - OutData%FAST_FPA(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FAST_RP not allocated - Int_Xferred = Int_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%FAST_RP)) DEALLOCATE(OutData%FAST_RP) - ALLOCATE(OutData%FAST_RP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FAST_RP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%FAST_RP,2), UBOUND(OutData%FAST_RP,2) - DO i1 = LBOUND(OutData%FAST_RP,1), UBOUND(OutData%FAST_RP,1) - OutData%FAST_RP(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%INCR = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%RSDF,1) - i1_u = UBOUND(OutData%RSDF,1) - DO i1 = LBOUND(OutData%RSDF,1), UBOUND(OutData%RSDF,1) - OutData%RSDF(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%FORC0,1) - i1_u = UBOUND(OutData%FORC0,1) - DO i1 = LBOUND(OutData%FORC0,1), UBOUND(OutData%FORC0,1) - OutData%FORC0(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%EMAS0,1) - i1_u = UBOUND(OutData%EMAS0,1) - i2_l = LBOUND(OutData%EMAS0,2) - i2_u = UBOUND(OutData%EMAS0,2) - DO i2 = LBOUND(OutData%EMAS0,2), UBOUND(OutData%EMAS0,2) - DO i1 = LBOUND(OutData%EMAS0,1), UBOUND(OutData%EMAS0,1) - OutData%EMAS0(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END SUBROUTINE FEAM_UnPackOtherState - - SUBROUTINE FEAM_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FEAM_MiscVarType), INTENT(IN) :: SrcMiscData - TYPE(FEAM_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) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_CopyMisc' -! + ErrMsg = '' + if (allocated(InitOutputData%WriteOutputHdr)) then + deallocate(InitOutputData%WriteOutputHdr) + end if + if (allocated(InitOutputData%WriteOutputUnt)) then + deallocate(InitOutputData%WriteOutputUnt) + end if + call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(InitOutputData%LAnchxi)) then + deallocate(InitOutputData%LAnchxi) + end if + if (allocated(InitOutputData%LAnchyi)) then + deallocate(InitOutputData%LAnchyi) + end if + if (allocated(InitOutputData%LAnchzi)) then + deallocate(InitOutputData%LAnchzi) + end if + if (allocated(InitOutputData%LFairxt)) then + deallocate(InitOutputData%LFairxt) + end if + if (allocated(InitOutputData%LFairyt)) then + deallocate(InitOutputData%LFairyt) + end if + if (allocated(InitOutputData%LFairzt)) then + deallocate(InitOutputData%LFairzt) + end if +end subroutine + +subroutine FEAM_PackInitOutput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(FEAM_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FEAM_PackInitOutput' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%WriteOutputHdr) + call RegPackAlloc(RF, InData%WriteOutputUnt) + call NWTC_Library_PackProgDesc(RF, InData%Ver) + call RegPackAlloc(RF, InData%LAnchxi) + call RegPackAlloc(RF, InData%LAnchyi) + call RegPackAlloc(RF, InData%LAnchzi) + call RegPackAlloc(RF, InData%LFairxt) + call RegPackAlloc(RF, InData%LFairyt) + call RegPackAlloc(RF, InData%LFairzt) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FEAM_UnPackInitOutput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(FEAM_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FEAM_UnPackInitOutput' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%WriteOutputHdr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WriteOutputUnt); if (RegCheckErr(RF, RoutineName)) return + call NWTC_Library_UnpackProgDesc(RF, OutData%Ver) ! Ver + call RegUnpackAlloc(RF, OutData%LAnchxi); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LAnchyi); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LAnchzi); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LFairxt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LFairyt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LFairzt); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FEAM_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) + type(FEAM_ContinuousStateType), intent(in) :: SrcContStateData + type(FEAM_ContinuousStateType), intent(inout) :: DstContStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'FEAM_CopyContState' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcMiscData%GLF)) THEN - i1_l = LBOUND(SrcMiscData%GLF,1) - i1_u = UBOUND(SrcMiscData%GLF,1) - i2_l = LBOUND(SrcMiscData%GLF,2) - i2_u = UBOUND(SrcMiscData%GLF,2) - IF (.NOT. ALLOCATED(DstMiscData%GLF)) THEN - ALLOCATE(DstMiscData%GLF(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%GLF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%GLF = SrcMiscData%GLF -ENDIF -IF (ALLOCATED(SrcMiscData%GLK)) THEN - i1_l = LBOUND(SrcMiscData%GLK,1) - i1_u = UBOUND(SrcMiscData%GLK,1) - i2_l = LBOUND(SrcMiscData%GLK,2) - i2_u = UBOUND(SrcMiscData%GLK,2) - i3_l = LBOUND(SrcMiscData%GLK,3) - i3_u = UBOUND(SrcMiscData%GLK,3) - IF (.NOT. ALLOCATED(DstMiscData%GLK)) THEN - ALLOCATE(DstMiscData%GLK(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%GLK.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%GLK = SrcMiscData%GLK -ENDIF - DstMiscData%EMASS = SrcMiscData%EMASS - DstMiscData%ESTIF = SrcMiscData%ESTIF -IF (ALLOCATED(SrcMiscData%FAST_FP)) THEN - i1_l = LBOUND(SrcMiscData%FAST_FP,1) - i1_u = UBOUND(SrcMiscData%FAST_FP,1) - i2_l = LBOUND(SrcMiscData%FAST_FP,2) - i2_u = UBOUND(SrcMiscData%FAST_FP,2) - IF (.NOT. ALLOCATED(DstMiscData%FAST_FP)) THEN - ALLOCATE(DstMiscData%FAST_FP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FAST_FP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%FAST_FP = SrcMiscData%FAST_FP -ENDIF - DstMiscData%FORCE = SrcMiscData%FORCE - DstMiscData%FP = SrcMiscData%FP - DstMiscData%U = SrcMiscData%U - DstMiscData%U0 = SrcMiscData%U0 - DstMiscData%DU = SrcMiscData%DU - DstMiscData%DDU = SrcMiscData%DDU - DstMiscData%R = SrcMiscData%R - DstMiscData%RP = SrcMiscData%RP - DstMiscData%RHSR = SrcMiscData%RHSR - DstMiscData%SLIN = SrcMiscData%SLIN - DstMiscData%STIFR = SrcMiscData%STIFR -IF (ALLOCATED(SrcMiscData%FAIR_ANG)) THEN - i1_l = LBOUND(SrcMiscData%FAIR_ANG,1) - i1_u = UBOUND(SrcMiscData%FAIR_ANG,1) - i2_l = LBOUND(SrcMiscData%FAIR_ANG,2) - i2_u = UBOUND(SrcMiscData%FAIR_ANG,2) - IF (.NOT. ALLOCATED(DstMiscData%FAIR_ANG)) THEN - ALLOCATE(DstMiscData%FAIR_ANG(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FAIR_ANG.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%FAIR_ANG = SrcMiscData%FAIR_ANG -ENDIF -IF (ALLOCATED(SrcMiscData%FAIR_T)) THEN - i1_l = LBOUND(SrcMiscData%FAIR_T,1) - i1_u = UBOUND(SrcMiscData%FAIR_T,1) - IF (.NOT. ALLOCATED(DstMiscData%FAIR_T)) THEN - ALLOCATE(DstMiscData%FAIR_T(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FAIR_T.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%FAIR_T = SrcMiscData%FAIR_T -ENDIF -IF (ALLOCATED(SrcMiscData%ANCH_ANG)) THEN - i1_l = LBOUND(SrcMiscData%ANCH_ANG,1) - i1_u = UBOUND(SrcMiscData%ANCH_ANG,1) - i2_l = LBOUND(SrcMiscData%ANCH_ANG,2) - i2_u = UBOUND(SrcMiscData%ANCH_ANG,2) - IF (.NOT. ALLOCATED(DstMiscData%ANCH_ANG)) THEN - ALLOCATE(DstMiscData%ANCH_ANG(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%ANCH_ANG.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%ANCH_ANG = SrcMiscData%ANCH_ANG -ENDIF -IF (ALLOCATED(SrcMiscData%ANCH_T)) THEN - i1_l = LBOUND(SrcMiscData%ANCH_T,1) - i1_u = UBOUND(SrcMiscData%ANCH_T,1) - IF (.NOT. ALLOCATED(DstMiscData%ANCH_T)) THEN - ALLOCATE(DstMiscData%ANCH_T(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%ANCH_T.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%ANCH_T = SrcMiscData%ANCH_T -ENDIF -IF (ALLOCATED(SrcMiscData%Line_Coordinate)) THEN - i1_l = LBOUND(SrcMiscData%Line_Coordinate,1) - i1_u = UBOUND(SrcMiscData%Line_Coordinate,1) - i2_l = LBOUND(SrcMiscData%Line_Coordinate,2) - i2_u = UBOUND(SrcMiscData%Line_Coordinate,2) - i3_l = LBOUND(SrcMiscData%Line_Coordinate,3) - i3_u = UBOUND(SrcMiscData%Line_Coordinate,3) - IF (.NOT. ALLOCATED(DstMiscData%Line_Coordinate)) THEN - ALLOCATE(DstMiscData%Line_Coordinate(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Line_Coordinate.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%Line_Coordinate = SrcMiscData%Line_Coordinate -ENDIF -IF (ALLOCATED(SrcMiscData%Line_Tangent)) THEN - i1_l = LBOUND(SrcMiscData%Line_Tangent,1) - i1_u = UBOUND(SrcMiscData%Line_Tangent,1) - i2_l = LBOUND(SrcMiscData%Line_Tangent,2) - i2_u = UBOUND(SrcMiscData%Line_Tangent,2) - i3_l = LBOUND(SrcMiscData%Line_Tangent,3) - i3_u = UBOUND(SrcMiscData%Line_Tangent,3) - IF (.NOT. ALLOCATED(DstMiscData%Line_Tangent)) THEN - ALLOCATE(DstMiscData%Line_Tangent(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Line_Tangent.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%Line_Tangent = SrcMiscData%Line_Tangent -ENDIF -IF (ALLOCATED(SrcMiscData%F_Lines)) THEN - i1_l = LBOUND(SrcMiscData%F_Lines,1) - i1_u = UBOUND(SrcMiscData%F_Lines,1) - i2_l = LBOUND(SrcMiscData%F_Lines,2) - i2_u = UBOUND(SrcMiscData%F_Lines,2) - IF (.NOT. ALLOCATED(DstMiscData%F_Lines)) THEN - ALLOCATE(DstMiscData%F_Lines(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_Lines.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%F_Lines = SrcMiscData%F_Lines -ENDIF - DstMiscData%LastIndWave = SrcMiscData%LastIndWave - END SUBROUTINE FEAM_CopyMisc - - SUBROUTINE FEAM_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(FEAM_MiscVarType), INTENT(INOUT) :: MiscData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_DestroyMisc' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(MiscData%GLF)) THEN - DEALLOCATE(MiscData%GLF) -ENDIF -IF (ALLOCATED(MiscData%GLK)) THEN - DEALLOCATE(MiscData%GLK) -ENDIF -IF (ALLOCATED(MiscData%FAST_FP)) THEN - DEALLOCATE(MiscData%FAST_FP) -ENDIF -IF (ALLOCATED(MiscData%FAIR_ANG)) THEN - DEALLOCATE(MiscData%FAIR_ANG) -ENDIF -IF (ALLOCATED(MiscData%FAIR_T)) THEN - DEALLOCATE(MiscData%FAIR_T) -ENDIF -IF (ALLOCATED(MiscData%ANCH_ANG)) THEN - DEALLOCATE(MiscData%ANCH_ANG) -ENDIF -IF (ALLOCATED(MiscData%ANCH_T)) THEN - DEALLOCATE(MiscData%ANCH_T) -ENDIF -IF (ALLOCATED(MiscData%Line_Coordinate)) THEN - DEALLOCATE(MiscData%Line_Coordinate) -ENDIF -IF (ALLOCATED(MiscData%Line_Tangent)) THEN - DEALLOCATE(MiscData%Line_Tangent) -ENDIF -IF (ALLOCATED(MiscData%F_Lines)) THEN - DEALLOCATE(MiscData%F_Lines) -ENDIF - END SUBROUTINE FEAM_DestroyMisc - - SUBROUTINE FEAM_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(FEAM_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 = 'FEAM_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 ! GLF allocated yes/no - IF ( ALLOCATED(InData%GLF) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! GLF upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%GLF) ! GLF - END IF - Int_BufSz = Int_BufSz + 1 ! GLK allocated yes/no - IF ( ALLOCATED(InData%GLK) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! GLK upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%GLK) ! GLK - END IF - Re_BufSz = Re_BufSz + SIZE(InData%EMASS) ! EMASS - Re_BufSz = Re_BufSz + SIZE(InData%ESTIF) ! ESTIF - Int_BufSz = Int_BufSz + 1 ! FAST_FP allocated yes/no - IF ( ALLOCATED(InData%FAST_FP) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! FAST_FP upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%FAST_FP) ! FAST_FP - END IF - Re_BufSz = Re_BufSz + SIZE(InData%FORCE) ! FORCE - Re_BufSz = Re_BufSz + SIZE(InData%FP) ! FP - Re_BufSz = Re_BufSz + SIZE(InData%U) ! U - Re_BufSz = Re_BufSz + SIZE(InData%U0) ! U0 - Re_BufSz = Re_BufSz + SIZE(InData%DU) ! DU - Re_BufSz = Re_BufSz + SIZE(InData%DDU) ! DDU - Re_BufSz = Re_BufSz + SIZE(InData%R) ! R - Re_BufSz = Re_BufSz + SIZE(InData%RP) ! RP - Re_BufSz = Re_BufSz + SIZE(InData%RHSR) ! RHSR - Re_BufSz = Re_BufSz + SIZE(InData%SLIN) ! SLIN - Re_BufSz = Re_BufSz + SIZE(InData%STIFR) ! STIFR - Int_BufSz = Int_BufSz + 1 ! FAIR_ANG allocated yes/no - IF ( ALLOCATED(InData%FAIR_ANG) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! FAIR_ANG upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%FAIR_ANG) ! FAIR_ANG - END IF - Int_BufSz = Int_BufSz + 1 ! FAIR_T allocated yes/no - IF ( ALLOCATED(InData%FAIR_T) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! FAIR_T upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%FAIR_T) ! FAIR_T - END IF - Int_BufSz = Int_BufSz + 1 ! ANCH_ANG allocated yes/no - IF ( ALLOCATED(InData%ANCH_ANG) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! ANCH_ANG upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%ANCH_ANG) ! ANCH_ANG - END IF - Int_BufSz = Int_BufSz + 1 ! ANCH_T allocated yes/no - IF ( ALLOCATED(InData%ANCH_T) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ANCH_T upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%ANCH_T) ! ANCH_T - END IF - Int_BufSz = Int_BufSz + 1 ! Line_Coordinate allocated yes/no - IF ( ALLOCATED(InData%Line_Coordinate) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Line_Coordinate upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Line_Coordinate) ! Line_Coordinate - END IF - Int_BufSz = Int_BufSz + 1 ! Line_Tangent allocated yes/no - IF ( ALLOCATED(InData%Line_Tangent) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Line_Tangent upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Line_Tangent) ! Line_Tangent - END IF - Int_BufSz = Int_BufSz + 1 ! F_Lines allocated yes/no - IF ( ALLOCATED(InData%F_Lines) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! F_Lines upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_Lines) ! F_Lines - END IF - Int_BufSz = Int_BufSz + 1 ! LastIndWave - 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%GLF) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%GLF,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GLF,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%GLF,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GLF,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%GLF,2), UBOUND(InData%GLF,2) - DO i1 = LBOUND(InData%GLF,1), UBOUND(InData%GLF,1) - ReKiBuf(Re_Xferred) = InData%GLF(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%GLK) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%GLK,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GLK,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%GLK,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GLK,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%GLK,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GLK,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%GLK,3), UBOUND(InData%GLK,3) - DO i2 = LBOUND(InData%GLK,2), UBOUND(InData%GLK,2) - DO i1 = LBOUND(InData%GLK,1), UBOUND(InData%GLK,1) - ReKiBuf(Re_Xferred) = InData%GLK(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - DO i2 = LBOUND(InData%EMASS,2), UBOUND(InData%EMASS,2) - DO i1 = LBOUND(InData%EMASS,1), UBOUND(InData%EMASS,1) - ReKiBuf(Re_Xferred) = InData%EMASS(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - DO i2 = LBOUND(InData%ESTIF,2), UBOUND(InData%ESTIF,2) - DO i1 = LBOUND(InData%ESTIF,1), UBOUND(InData%ESTIF,1) - ReKiBuf(Re_Xferred) = InData%ESTIF(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - IF ( .NOT. ALLOCATED(InData%FAST_FP) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FAST_FP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FAST_FP,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FAST_FP,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FAST_FP,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%FAST_FP,2), UBOUND(InData%FAST_FP,2) - DO i1 = LBOUND(InData%FAST_FP,1), UBOUND(InData%FAST_FP,1) - ReKiBuf(Re_Xferred) = InData%FAST_FP(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - DO i1 = LBOUND(InData%FORCE,1), UBOUND(InData%FORCE,1) - ReKiBuf(Re_Xferred) = InData%FORCE(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%FP,1), UBOUND(InData%FP,1) - ReKiBuf(Re_Xferred) = InData%FP(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i2 = LBOUND(InData%U,2), UBOUND(InData%U,2) - DO i1 = LBOUND(InData%U,1), UBOUND(InData%U,1) - ReKiBuf(Re_Xferred) = InData%U(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - DO i2 = LBOUND(InData%U0,2), UBOUND(InData%U0,2) - DO i1 = LBOUND(InData%U0,1), UBOUND(InData%U0,1) - ReKiBuf(Re_Xferred) = InData%U0(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - DO i2 = LBOUND(InData%DU,2), UBOUND(InData%DU,2) - DO i1 = LBOUND(InData%DU,1), UBOUND(InData%DU,1) - ReKiBuf(Re_Xferred) = InData%DU(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - DO i2 = LBOUND(InData%DDU,2), UBOUND(InData%DDU,2) - DO i1 = LBOUND(InData%DDU,1), UBOUND(InData%DDU,1) - ReKiBuf(Re_Xferred) = InData%DDU(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - DO i1 = LBOUND(InData%R,1), UBOUND(InData%R,1) - ReKiBuf(Re_Xferred) = InData%R(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%RP,1), UBOUND(InData%RP,1) - ReKiBuf(Re_Xferred) = InData%RP(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%RHSR,1), UBOUND(InData%RHSR,1) - ReKiBuf(Re_Xferred) = InData%RHSR(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%SLIN,1), UBOUND(InData%SLIN,1) - ReKiBuf(Re_Xferred) = InData%SLIN(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i2 = LBOUND(InData%STIFR,2), UBOUND(InData%STIFR,2) - DO i1 = LBOUND(InData%STIFR,1), UBOUND(InData%STIFR,1) - ReKiBuf(Re_Xferred) = InData%STIFR(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - IF ( .NOT. ALLOCATED(InData%FAIR_ANG) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FAIR_ANG,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FAIR_ANG,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FAIR_ANG,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FAIR_ANG,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%FAIR_ANG,2), UBOUND(InData%FAIR_ANG,2) - DO i1 = LBOUND(InData%FAIR_ANG,1), UBOUND(InData%FAIR_ANG,1) - ReKiBuf(Re_Xferred) = InData%FAIR_ANG(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%FAIR_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%FAIR_T,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FAIR_T,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%FAIR_T,1), UBOUND(InData%FAIR_T,1) - ReKiBuf(Re_Xferred) = InData%FAIR_T(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ANCH_ANG) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ANCH_ANG,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ANCH_ANG,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ANCH_ANG,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ANCH_ANG,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%ANCH_ANG,2), UBOUND(InData%ANCH_ANG,2) - DO i1 = LBOUND(InData%ANCH_ANG,1), UBOUND(InData%ANCH_ANG,1) - ReKiBuf(Re_Xferred) = InData%ANCH_ANG(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ANCH_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%ANCH_T,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ANCH_T,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ANCH_T,1), UBOUND(InData%ANCH_T,1) - ReKiBuf(Re_Xferred) = InData%ANCH_T(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Line_Coordinate) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Line_Coordinate,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Line_Coordinate,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Line_Coordinate,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Line_Coordinate,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Line_Coordinate,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Line_Coordinate,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Line_Coordinate,3), UBOUND(InData%Line_Coordinate,3) - DO i2 = LBOUND(InData%Line_Coordinate,2), UBOUND(InData%Line_Coordinate,2) - DO i1 = LBOUND(InData%Line_Coordinate,1), UBOUND(InData%Line_Coordinate,1) - ReKiBuf(Re_Xferred) = InData%Line_Coordinate(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Line_Tangent) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Line_Tangent,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Line_Tangent,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Line_Tangent,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Line_Tangent,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Line_Tangent,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Line_Tangent,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Line_Tangent,3), UBOUND(InData%Line_Tangent,3) - DO i2 = LBOUND(InData%Line_Tangent,2), UBOUND(InData%Line_Tangent,2) - DO i1 = LBOUND(InData%Line_Tangent,1), UBOUND(InData%Line_Tangent,1) - ReKiBuf(Re_Xferred) = InData%Line_Tangent(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%F_Lines) ) THEN - 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_Lines,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_Lines,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_Lines,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_Lines,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%F_Lines,2), UBOUND(InData%F_Lines,2) - DO i1 = LBOUND(InData%F_Lines,1), UBOUND(InData%F_Lines,1) - ReKiBuf(Re_Xferred) = InData%F_Lines(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%LastIndWave - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE FEAM_PackMisc - - SUBROUTINE FEAM_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(FEAM_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) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_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 ! GLF not allocated - Int_Xferred = Int_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%GLF)) DEALLOCATE(OutData%GLF) - ALLOCATE(OutData%GLF(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%GLF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%GLF,2), UBOUND(OutData%GLF,2) - DO i1 = LBOUND(OutData%GLF,1), UBOUND(OutData%GLF,1) - OutData%GLF(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! GLK not allocated - Int_Xferred = Int_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%GLK)) DEALLOCATE(OutData%GLK) - ALLOCATE(OutData%GLK(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%GLK.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%GLK,3), UBOUND(OutData%GLK,3) - DO i2 = LBOUND(OutData%GLK,2), UBOUND(OutData%GLK,2) - DO i1 = LBOUND(OutData%GLK,1), UBOUND(OutData%GLK,1) - OutData%GLK(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - i1_l = LBOUND(OutData%EMASS,1) - i1_u = UBOUND(OutData%EMASS,1) - i2_l = LBOUND(OutData%EMASS,2) - i2_u = UBOUND(OutData%EMASS,2) - DO i2 = LBOUND(OutData%EMASS,2), UBOUND(OutData%EMASS,2) - DO i1 = LBOUND(OutData%EMASS,1), UBOUND(OutData%EMASS,1) - OutData%EMASS(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%ESTIF,1) - i1_u = UBOUND(OutData%ESTIF,1) - i2_l = LBOUND(OutData%ESTIF,2) - i2_u = UBOUND(OutData%ESTIF,2) - DO i2 = LBOUND(OutData%ESTIF,2), UBOUND(OutData%ESTIF,2) - DO i1 = LBOUND(OutData%ESTIF,1), UBOUND(OutData%ESTIF,1) - OutData%ESTIF(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FAST_FP not allocated - Int_Xferred = Int_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%FAST_FP)) DEALLOCATE(OutData%FAST_FP) - ALLOCATE(OutData%FAST_FP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FAST_FP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%FAST_FP,2), UBOUND(OutData%FAST_FP,2) - DO i1 = LBOUND(OutData%FAST_FP,1), UBOUND(OutData%FAST_FP,1) - OutData%FAST_FP(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - i1_l = LBOUND(OutData%FORCE,1) - i1_u = UBOUND(OutData%FORCE,1) - DO i1 = LBOUND(OutData%FORCE,1), UBOUND(OutData%FORCE,1) - OutData%FORCE(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%FP,1) - i1_u = UBOUND(OutData%FP,1) - DO i1 = LBOUND(OutData%FP,1), UBOUND(OutData%FP,1) - OutData%FP(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%U,1) - i1_u = UBOUND(OutData%U,1) - i2_l = LBOUND(OutData%U,2) - i2_u = UBOUND(OutData%U,2) - DO i2 = LBOUND(OutData%U,2), UBOUND(OutData%U,2) - DO i1 = LBOUND(OutData%U,1), UBOUND(OutData%U,1) - OutData%U(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%U0,1) - i1_u = UBOUND(OutData%U0,1) - i2_l = LBOUND(OutData%U0,2) - i2_u = UBOUND(OutData%U0,2) - DO i2 = LBOUND(OutData%U0,2), UBOUND(OutData%U0,2) - DO i1 = LBOUND(OutData%U0,1), UBOUND(OutData%U0,1) - OutData%U0(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%DU,1) - i1_u = UBOUND(OutData%DU,1) - i2_l = LBOUND(OutData%DU,2) - i2_u = UBOUND(OutData%DU,2) - DO i2 = LBOUND(OutData%DU,2), UBOUND(OutData%DU,2) - DO i1 = LBOUND(OutData%DU,1), UBOUND(OutData%DU,1) - OutData%DU(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%DDU,1) - i1_u = UBOUND(OutData%DDU,1) - i2_l = LBOUND(OutData%DDU,2) - i2_u = UBOUND(OutData%DDU,2) - DO i2 = LBOUND(OutData%DDU,2), UBOUND(OutData%DDU,2) - DO i1 = LBOUND(OutData%DDU,1), UBOUND(OutData%DDU,1) - OutData%DDU(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%R,1) - i1_u = UBOUND(OutData%R,1) - DO i1 = LBOUND(OutData%R,1), UBOUND(OutData%R,1) - OutData%R(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%RP,1) - i1_u = UBOUND(OutData%RP,1) - DO i1 = LBOUND(OutData%RP,1), UBOUND(OutData%RP,1) - OutData%RP(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%RHSR,1) - i1_u = UBOUND(OutData%RHSR,1) - DO i1 = LBOUND(OutData%RHSR,1), UBOUND(OutData%RHSR,1) - OutData%RHSR(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%SLIN,1) - i1_u = UBOUND(OutData%SLIN,1) - DO i1 = LBOUND(OutData%SLIN,1), UBOUND(OutData%SLIN,1) - OutData%SLIN(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%STIFR,1) - i1_u = UBOUND(OutData%STIFR,1) - i2_l = LBOUND(OutData%STIFR,2) - i2_u = UBOUND(OutData%STIFR,2) - DO i2 = LBOUND(OutData%STIFR,2), UBOUND(OutData%STIFR,2) - DO i1 = LBOUND(OutData%STIFR,1), UBOUND(OutData%STIFR,1) - OutData%STIFR(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FAIR_ANG not allocated - Int_Xferred = Int_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%FAIR_ANG)) DEALLOCATE(OutData%FAIR_ANG) - ALLOCATE(OutData%FAIR_ANG(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FAIR_ANG.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%FAIR_ANG,2), UBOUND(OutData%FAIR_ANG,2) - DO i1 = LBOUND(OutData%FAIR_ANG,1), UBOUND(OutData%FAIR_ANG,1) - OutData%FAIR_ANG(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FAIR_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 - IF (ALLOCATED(OutData%FAIR_T)) DEALLOCATE(OutData%FAIR_T) - ALLOCATE(OutData%FAIR_T(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FAIR_T.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%FAIR_T,1), UBOUND(OutData%FAIR_T,1) - OutData%FAIR_T(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ANCH_ANG not allocated - Int_Xferred = Int_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%ANCH_ANG)) DEALLOCATE(OutData%ANCH_ANG) - ALLOCATE(OutData%ANCH_ANG(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ANCH_ANG.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%ANCH_ANG,2), UBOUND(OutData%ANCH_ANG,2) - DO i1 = LBOUND(OutData%ANCH_ANG,1), UBOUND(OutData%ANCH_ANG,1) - OutData%ANCH_ANG(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ANCH_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 - IF (ALLOCATED(OutData%ANCH_T)) DEALLOCATE(OutData%ANCH_T) - ALLOCATE(OutData%ANCH_T(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ANCH_T.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ANCH_T,1), UBOUND(OutData%ANCH_T,1) - OutData%ANCH_T(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Line_Coordinate not allocated - Int_Xferred = Int_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%Line_Coordinate)) DEALLOCATE(OutData%Line_Coordinate) - ALLOCATE(OutData%Line_Coordinate(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%Line_Coordinate.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Line_Coordinate,3), UBOUND(OutData%Line_Coordinate,3) - DO i2 = LBOUND(OutData%Line_Coordinate,2), UBOUND(OutData%Line_Coordinate,2) - DO i1 = LBOUND(OutData%Line_Coordinate,1), UBOUND(OutData%Line_Coordinate,1) - OutData%Line_Coordinate(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 ! Line_Tangent not allocated - Int_Xferred = Int_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%Line_Tangent)) DEALLOCATE(OutData%Line_Tangent) - ALLOCATE(OutData%Line_Tangent(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%Line_Tangent.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Line_Tangent,3), UBOUND(OutData%Line_Tangent,3) - DO i2 = LBOUND(OutData%Line_Tangent,2), UBOUND(OutData%Line_Tangent,2) - DO i1 = LBOUND(OutData%Line_Tangent,1), UBOUND(OutData%Line_Tangent,1) - OutData%Line_Tangent(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 ! F_Lines not allocated - Int_Xferred = Int_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_Lines)) DEALLOCATE(OutData%F_Lines) - ALLOCATE(OutData%F_Lines(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_Lines.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%F_Lines,2), UBOUND(OutData%F_Lines,2) - DO i1 = LBOUND(OutData%F_Lines,1), UBOUND(OutData%F_Lines,1) - OutData%F_Lines(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%LastIndWave = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE FEAM_UnPackMisc - - SUBROUTINE FEAM_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FEAM_ParameterType), INTENT(IN) :: SrcParamData - TYPE(FEAM_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) :: 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 = 'FEAM_CopyParam' -! + ErrMsg = '' + if (allocated(SrcContStateData%GLU)) then + LB(1:2) = lbound(SrcContStateData%GLU) + UB(1:2) = ubound(SrcContStateData%GLU) + if (.not. allocated(DstContStateData%GLU)) then + allocate(DstContStateData%GLU(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%GLU.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstContStateData%GLU = SrcContStateData%GLU + end if + if (allocated(SrcContStateData%GLDU)) then + LB(1:2) = lbound(SrcContStateData%GLDU) + UB(1:2) = ubound(SrcContStateData%GLDU) + if (.not. allocated(DstContStateData%GLDU)) then + allocate(DstContStateData%GLDU(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%GLDU.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstContStateData%GLDU = SrcContStateData%GLDU + end if +end subroutine + +subroutine FEAM_DestroyContState(ContStateData, ErrStat, ErrMsg) + type(FEAM_ContinuousStateType), intent(inout) :: ContStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FEAM_DestroyContState' ErrStat = ErrID_None - ErrMsg = "" - DstParamData%DT = SrcParamData%DT - DstParamData%GRAV = SrcParamData%GRAV - DstParamData%Eps = SrcParamData%Eps - DstParamData%Gravity = SrcParamData%Gravity - DstParamData%WtrDens = SrcParamData%WtrDens - DstParamData%MaxIter = SrcParamData%MaxIter - DstParamData%NHBD = SrcParamData%NHBD - DstParamData%NDIM = SrcParamData%NDIM -IF (ALLOCATED(SrcParamData%NEQ)) THEN - i1_l = LBOUND(SrcParamData%NEQ,1) - i1_u = UBOUND(SrcParamData%NEQ,1) - IF (.NOT. ALLOCATED(DstParamData%NEQ)) THEN - ALLOCATE(DstParamData%NEQ(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%NEQ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%NEQ = SrcParamData%NEQ -ENDIF - DstParamData%NBAND = SrcParamData%NBAND - DstParamData%NumLines = SrcParamData%NumLines - DstParamData%NumElems = SrcParamData%NumElems - DstParamData%NumNodes = SrcParamData%NumNodes -IF (ALLOCATED(SrcParamData%GSL)) THEN - i1_l = LBOUND(SrcParamData%GSL,1) - i1_u = UBOUND(SrcParamData%GSL,1) - i2_l = LBOUND(SrcParamData%GSL,2) - i2_u = UBOUND(SrcParamData%GSL,2) - i3_l = LBOUND(SrcParamData%GSL,3) - i3_u = UBOUND(SrcParamData%GSL,3) - IF (.NOT. ALLOCATED(DstParamData%GSL)) THEN - ALLOCATE(DstParamData%GSL(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%GSL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%GSL = SrcParamData%GSL -ENDIF -IF (ALLOCATED(SrcParamData%GP)) THEN - i1_l = LBOUND(SrcParamData%GP,1) - i1_u = UBOUND(SrcParamData%GP,1) - i2_l = LBOUND(SrcParamData%GP,2) - i2_u = UBOUND(SrcParamData%GP,2) - IF (.NOT. ALLOCATED(DstParamData%GP)) THEN - ALLOCATE(DstParamData%GP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%GP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%GP = SrcParamData%GP -ENDIF -IF (ALLOCATED(SrcParamData%Elength)) THEN - i1_l = LBOUND(SrcParamData%Elength,1) - i1_u = UBOUND(SrcParamData%Elength,1) - IF (.NOT. ALLOCATED(DstParamData%Elength)) THEN - ALLOCATE(DstParamData%Elength(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Elength.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Elength = SrcParamData%Elength -ENDIF -IF (ALLOCATED(SrcParamData%BottmElev)) THEN - i1_l = LBOUND(SrcParamData%BottmElev,1) - i1_u = UBOUND(SrcParamData%BottmElev,1) - IF (.NOT. ALLOCATED(DstParamData%BottmElev)) THEN - ALLOCATE(DstParamData%BottmElev(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BottmElev.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%BottmElev = SrcParamData%BottmElev -ENDIF -IF (ALLOCATED(SrcParamData%BottmStiff)) THEN - i1_l = LBOUND(SrcParamData%BottmStiff,1) - i1_u = UBOUND(SrcParamData%BottmStiff,1) - IF (.NOT. ALLOCATED(DstParamData%BottmStiff)) THEN - ALLOCATE(DstParamData%BottmStiff(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BottmStiff.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%BottmStiff = SrcParamData%BottmStiff -ENDIF -IF (ALLOCATED(SrcParamData%LMassDen)) THEN - i1_l = LBOUND(SrcParamData%LMassDen,1) - i1_u = UBOUND(SrcParamData%LMassDen,1) - IF (.NOT. ALLOCATED(DstParamData%LMassDen)) THEN - ALLOCATE(DstParamData%LMassDen(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%LMassDen.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%LMassDen = SrcParamData%LMassDen -ENDIF -IF (ALLOCATED(SrcParamData%LDMassDen)) THEN - i1_l = LBOUND(SrcParamData%LDMassDen,1) - i1_u = UBOUND(SrcParamData%LDMassDen,1) - IF (.NOT. ALLOCATED(DstParamData%LDMassDen)) THEN - ALLOCATE(DstParamData%LDMassDen(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%LDMassDen.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%LDMassDen = SrcParamData%LDMassDen -ENDIF -IF (ALLOCATED(SrcParamData%LEAStiff)) THEN - i1_l = LBOUND(SrcParamData%LEAStiff,1) - i1_u = UBOUND(SrcParamData%LEAStiff,1) - IF (.NOT. ALLOCATED(DstParamData%LEAStiff)) THEN - ALLOCATE(DstParamData%LEAStiff(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%LEAStiff.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%LEAStiff = SrcParamData%LEAStiff -ENDIF -IF (ALLOCATED(SrcParamData%LineCI)) THEN - i1_l = LBOUND(SrcParamData%LineCI,1) - i1_u = UBOUND(SrcParamData%LineCI,1) - IF (.NOT. ALLOCATED(DstParamData%LineCI)) THEN - ALLOCATE(DstParamData%LineCI(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%LineCI.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%LineCI = SrcParamData%LineCI -ENDIF -IF (ALLOCATED(SrcParamData%LineCD)) THEN - i1_l = LBOUND(SrcParamData%LineCD,1) - i1_u = UBOUND(SrcParamData%LineCD,1) - IF (.NOT. ALLOCATED(DstParamData%LineCD)) THEN - ALLOCATE(DstParamData%LineCD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%LineCD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%LineCD = SrcParamData%LineCD -ENDIF -IF (ALLOCATED(SrcParamData%Bvp)) THEN - i1_l = LBOUND(SrcParamData%Bvp,1) - i1_u = UBOUND(SrcParamData%Bvp,1) - i2_l = LBOUND(SrcParamData%Bvp,2) - i2_u = UBOUND(SrcParamData%Bvp,2) - IF (.NOT. ALLOCATED(DstParamData%Bvp)) THEN - ALLOCATE(DstParamData%Bvp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Bvp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Bvp = SrcParamData%Bvp -ENDIF -IF (ALLOCATED(SrcParamData%WaveAcc0)) THEN - i1_l = LBOUND(SrcParamData%WaveAcc0,1) - i1_u = UBOUND(SrcParamData%WaveAcc0,1) - i2_l = LBOUND(SrcParamData%WaveAcc0,2) - i2_u = UBOUND(SrcParamData%WaveAcc0,2) - i3_l = LBOUND(SrcParamData%WaveAcc0,3) - i3_u = UBOUND(SrcParamData%WaveAcc0,3) - IF (.NOT. ALLOCATED(DstParamData%WaveAcc0)) THEN - ALLOCATE(DstParamData%WaveAcc0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WaveAcc0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%WaveAcc0 = SrcParamData%WaveAcc0 -ENDIF -IF (ALLOCATED(SrcParamData%WaveTime)) THEN - i1_l = LBOUND(SrcParamData%WaveTime,1) - i1_u = UBOUND(SrcParamData%WaveTime,1) - IF (.NOT. ALLOCATED(DstParamData%WaveTime)) THEN - ALLOCATE(DstParamData%WaveTime(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WaveTime.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%WaveTime = SrcParamData%WaveTime -ENDIF -IF (ALLOCATED(SrcParamData%WaveVel0)) THEN - i1_l = LBOUND(SrcParamData%WaveVel0,1) - i1_u = UBOUND(SrcParamData%WaveVel0,1) - i2_l = LBOUND(SrcParamData%WaveVel0,2) - i2_u = UBOUND(SrcParamData%WaveVel0,2) - i3_l = LBOUND(SrcParamData%WaveVel0,3) - i3_u = UBOUND(SrcParamData%WaveVel0,3) - IF (.NOT. ALLOCATED(DstParamData%WaveVel0)) THEN - ALLOCATE(DstParamData%WaveVel0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WaveVel0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%WaveVel0 = SrcParamData%WaveVel0 -ENDIF - DstParamData%NStepWave = SrcParamData%NStepWave - DstParamData%SHAP = SrcParamData%SHAP - DstParamData%SHAPS = SrcParamData%SHAPS - DstParamData%GAUSSW = SrcParamData%GAUSSW - DstParamData%NGAUSS = SrcParamData%NGAUSS - DstParamData%SHAPT = SrcParamData%SHAPT - DstParamData%SHAPTS = SrcParamData%SHAPTS - DstParamData%NTRAP = SrcParamData%NTRAP - DstParamData%SBEND = SrcParamData%SBEND - DstParamData%STEN = SrcParamData%STEN - DstParamData%RMASS = SrcParamData%RMASS - DstParamData%RADDM = SrcParamData%RADDM - DstParamData%PMPN = SrcParamData%PMPN - DstParamData%AM = SrcParamData%AM - DstParamData%PM = SrcParamData%PM - DstParamData%IDOF = SrcParamData%IDOF - DstParamData%JDOF = SrcParamData%JDOF - DstParamData%PPA = SrcParamData%PPA - DstParamData%PtfmRefzt = SrcParamData%PtfmRefzt - DstParamData%NumOuts = SrcParamData%NumOuts - 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 -IF (ALLOCATED(SrcParamData%GLUZR)) THEN - i1_l = LBOUND(SrcParamData%GLUZR,1) - i1_u = UBOUND(SrcParamData%GLUZR,1) - i2_l = LBOUND(SrcParamData%GLUZR,2) - i2_u = UBOUND(SrcParamData%GLUZR,2) - i3_l = LBOUND(SrcParamData%GLUZR,3) - i3_u = UBOUND(SrcParamData%GLUZR,3) - IF (.NOT. ALLOCATED(DstParamData%GLUZR)) THEN - ALLOCATE(DstParamData%GLUZR(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%GLUZR.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%GLUZR = SrcParamData%GLUZR -ENDIF -IF (ALLOCATED(SrcParamData%GTZER)) THEN - i1_l = LBOUND(SrcParamData%GTZER,1) - i1_u = UBOUND(SrcParamData%GTZER,1) - i2_l = LBOUND(SrcParamData%GTZER,2) - i2_u = UBOUND(SrcParamData%GTZER,2) - IF (.NOT. ALLOCATED(DstParamData%GTZER)) THEN - ALLOCATE(DstParamData%GTZER(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%GTZER.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%GTZER = SrcParamData%GTZER -ENDIF - END SUBROUTINE FEAM_CopyParam - - SUBROUTINE FEAM_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(FEAM_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(ParamData%NEQ)) THEN - DEALLOCATE(ParamData%NEQ) -ENDIF -IF (ALLOCATED(ParamData%GSL)) THEN - DEALLOCATE(ParamData%GSL) -ENDIF -IF (ALLOCATED(ParamData%GP)) THEN - DEALLOCATE(ParamData%GP) -ENDIF -IF (ALLOCATED(ParamData%Elength)) THEN - DEALLOCATE(ParamData%Elength) -ENDIF -IF (ALLOCATED(ParamData%BottmElev)) THEN - DEALLOCATE(ParamData%BottmElev) -ENDIF -IF (ALLOCATED(ParamData%BottmStiff)) THEN - DEALLOCATE(ParamData%BottmStiff) -ENDIF -IF (ALLOCATED(ParamData%LMassDen)) THEN - DEALLOCATE(ParamData%LMassDen) -ENDIF -IF (ALLOCATED(ParamData%LDMassDen)) THEN - DEALLOCATE(ParamData%LDMassDen) -ENDIF -IF (ALLOCATED(ParamData%LEAStiff)) THEN - DEALLOCATE(ParamData%LEAStiff) -ENDIF -IF (ALLOCATED(ParamData%LineCI)) THEN - DEALLOCATE(ParamData%LineCI) -ENDIF -IF (ALLOCATED(ParamData%LineCD)) THEN - DEALLOCATE(ParamData%LineCD) -ENDIF -IF (ALLOCATED(ParamData%Bvp)) THEN - DEALLOCATE(ParamData%Bvp) -ENDIF -IF (ALLOCATED(ParamData%WaveAcc0)) THEN - DEALLOCATE(ParamData%WaveAcc0) -ENDIF -IF (ALLOCATED(ParamData%WaveTime)) THEN - DEALLOCATE(ParamData%WaveTime) -ENDIF -IF (ALLOCATED(ParamData%WaveVel0)) THEN - DEALLOCATE(ParamData%WaveVel0) -ENDIF -IF (ALLOCATED(ParamData%OutParam)) THEN -DO i1 = LBOUND(ParamData%OutParam,1), UBOUND(ParamData%OutParam,1) - CALL NWTC_Library_Destroyoutparmtype( ParamData%OutParam(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ParamData%OutParam) -ENDIF -IF (ALLOCATED(ParamData%GLUZR)) THEN - DEALLOCATE(ParamData%GLUZR) -ENDIF -IF (ALLOCATED(ParamData%GTZER)) THEN - DEALLOCATE(ParamData%GTZER) -ENDIF - END SUBROUTINE FEAM_DestroyParam - - SUBROUTINE FEAM_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(FEAM_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 = 'FEAM_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 - Re_BufSz = Re_BufSz + SIZE(InData%GRAV) ! GRAV - Re_BufSz = Re_BufSz + 1 ! Eps - Re_BufSz = Re_BufSz + 1 ! Gravity - Re_BufSz = Re_BufSz + 1 ! WtrDens - Int_BufSz = Int_BufSz + 1 ! MaxIter - Int_BufSz = Int_BufSz + 1 ! NHBD - Int_BufSz = Int_BufSz + 1 ! NDIM - Int_BufSz = Int_BufSz + 1 ! NEQ allocated yes/no - IF ( ALLOCATED(InData%NEQ) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! NEQ upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%NEQ) ! NEQ - END IF - Int_BufSz = Int_BufSz + 1 ! NBAND - Int_BufSz = Int_BufSz + 1 ! NumLines - Int_BufSz = Int_BufSz + 1 ! NumElems - Int_BufSz = Int_BufSz + 1 ! NumNodes - Int_BufSz = Int_BufSz + 1 ! GSL allocated yes/no - IF ( ALLOCATED(InData%GSL) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! GSL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%GSL) ! GSL - END IF - Int_BufSz = Int_BufSz + 1 ! GP allocated yes/no - IF ( ALLOCATED(InData%GP) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! GP upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%GP) ! GP - END IF - Int_BufSz = Int_BufSz + 1 ! Elength allocated yes/no - IF ( ALLOCATED(InData%Elength) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Elength upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Elength) ! Elength - END IF - Int_BufSz = Int_BufSz + 1 ! BottmElev allocated yes/no - IF ( ALLOCATED(InData%BottmElev) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BottmElev upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BottmElev) ! BottmElev - END IF - Int_BufSz = Int_BufSz + 1 ! BottmStiff allocated yes/no - IF ( ALLOCATED(InData%BottmStiff) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BottmStiff upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BottmStiff) ! BottmStiff - END IF - Int_BufSz = Int_BufSz + 1 ! LMassDen allocated yes/no - IF ( ALLOCATED(InData%LMassDen) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LMassDen upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%LMassDen) ! LMassDen - END IF - Int_BufSz = Int_BufSz + 1 ! LDMassDen allocated yes/no - IF ( ALLOCATED(InData%LDMassDen) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LDMassDen upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%LDMassDen) ! LDMassDen - END IF - Int_BufSz = Int_BufSz + 1 ! LEAStiff allocated yes/no - IF ( ALLOCATED(InData%LEAStiff) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LEAStiff upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%LEAStiff) ! LEAStiff - END IF - Int_BufSz = Int_BufSz + 1 ! LineCI allocated yes/no - IF ( ALLOCATED(InData%LineCI) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LineCI upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%LineCI) ! LineCI - END IF - Int_BufSz = Int_BufSz + 1 ! LineCD allocated yes/no - IF ( ALLOCATED(InData%LineCD) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LineCD upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%LineCD) ! LineCD - END IF - Int_BufSz = Int_BufSz + 1 ! Bvp allocated yes/no - IF ( ALLOCATED(InData%Bvp) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Bvp upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Bvp) ! Bvp - END IF - Int_BufSz = Int_BufSz + 1 ! WaveAcc0 allocated yes/no - IF ( ALLOCATED(InData%WaveAcc0) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! WaveAcc0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveAcc0) ! WaveAcc0 - END IF - Int_BufSz = Int_BufSz + 1 ! WaveTime allocated yes/no - IF ( ALLOCATED(InData%WaveTime) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WaveTime upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveTime) ! WaveTime - END IF - Int_BufSz = Int_BufSz + 1 ! WaveVel0 allocated yes/no - IF ( ALLOCATED(InData%WaveVel0) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! WaveVel0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveVel0) ! WaveVel0 - END IF - Int_BufSz = Int_BufSz + 1 ! NStepWave - Re_BufSz = Re_BufSz + SIZE(InData%SHAP) ! SHAP - Re_BufSz = Re_BufSz + SIZE(InData%SHAPS) ! SHAPS - Re_BufSz = Re_BufSz + SIZE(InData%GAUSSW) ! GAUSSW - Int_BufSz = Int_BufSz + 1 ! NGAUSS - Re_BufSz = Re_BufSz + SIZE(InData%SHAPT) ! SHAPT - Re_BufSz = Re_BufSz + SIZE(InData%SHAPTS) ! SHAPTS - Int_BufSz = Int_BufSz + 1 ! NTRAP - Re_BufSz = Re_BufSz + SIZE(InData%SBEND) ! SBEND - Re_BufSz = Re_BufSz + SIZE(InData%STEN) ! STEN - Re_BufSz = Re_BufSz + SIZE(InData%RMASS) ! RMASS - Re_BufSz = Re_BufSz + SIZE(InData%RADDM) ! RADDM - Re_BufSz = Re_BufSz + SIZE(InData%PMPN) ! PMPN - Re_BufSz = Re_BufSz + SIZE(InData%AM) ! AM - Re_BufSz = Re_BufSz + SIZE(InData%PM) ! PM - Int_BufSz = Int_BufSz + SIZE(InData%IDOF) ! IDOF - Int_BufSz = Int_BufSz + SIZE(InData%JDOF) ! JDOF - Re_BufSz = Re_BufSz + SIZE(InData%PPA) ! PPA - Re_BufSz = Re_BufSz + 1 ! PtfmRefzt - Int_BufSz = Int_BufSz + 1 ! NumOuts - 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 ! GLUZR allocated yes/no - IF ( ALLOCATED(InData%GLUZR) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! GLUZR upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%GLUZR) ! GLUZR - END IF - Int_BufSz = Int_BufSz + 1 ! GTZER allocated yes/no - IF ( ALLOCATED(InData%GTZER) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! GTZER upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%GTZER) ! GTZER - 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 i1 = LBOUND(InData%GRAV,1), UBOUND(InData%GRAV,1) - ReKiBuf(Re_Xferred) = InData%GRAV(i1) - Re_Xferred = Re_Xferred + 1 - END DO - ReKiBuf(Re_Xferred) = InData%Eps - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Gravity - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WtrDens - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%MaxIter - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NHBD - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NDIM - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%NEQ) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%NEQ,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NEQ,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%NEQ,1), UBOUND(InData%NEQ,1) - IntKiBuf(Int_Xferred) = InData%NEQ(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NBAND - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumLines - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumElems - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumNodes - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%GSL) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%GSL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GSL,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%GSL,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GSL,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%GSL,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GSL,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%GSL,3), UBOUND(InData%GSL,3) - DO i2 = LBOUND(InData%GSL,2), UBOUND(InData%GSL,2) - DO i1 = LBOUND(InData%GSL,1), UBOUND(InData%GSL,1) - ReKiBuf(Re_Xferred) = InData%GSL(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%GP) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%GP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GP,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%GP,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GP,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%GP,2), UBOUND(InData%GP,2) - DO i1 = LBOUND(InData%GP,1), UBOUND(InData%GP,1) - ReKiBuf(Re_Xferred) = InData%GP(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Elength) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Elength,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Elength,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Elength,1), UBOUND(InData%Elength,1) - ReKiBuf(Re_Xferred) = InData%Elength(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BottmElev) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BottmElev,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BottmElev,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BottmElev,1), UBOUND(InData%BottmElev,1) - ReKiBuf(Re_Xferred) = InData%BottmElev(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BottmStiff) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BottmStiff,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BottmStiff,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BottmStiff,1), UBOUND(InData%BottmStiff,1) - ReKiBuf(Re_Xferred) = InData%BottmStiff(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LMassDen) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LMassDen,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LMassDen,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LMassDen,1), UBOUND(InData%LMassDen,1) - ReKiBuf(Re_Xferred) = InData%LMassDen(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LDMassDen) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LDMassDen,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LDMassDen,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LDMassDen,1), UBOUND(InData%LDMassDen,1) - ReKiBuf(Re_Xferred) = InData%LDMassDen(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LEAStiff) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LEAStiff,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LEAStiff,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LEAStiff,1), UBOUND(InData%LEAStiff,1) - ReKiBuf(Re_Xferred) = InData%LEAStiff(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LineCI) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LineCI,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LineCI,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LineCI,1), UBOUND(InData%LineCI,1) - ReKiBuf(Re_Xferred) = InData%LineCI(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LineCD) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LineCD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LineCD,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LineCD,1), UBOUND(InData%LineCD,1) - ReKiBuf(Re_Xferred) = InData%LineCD(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Bvp) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Bvp,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Bvp,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Bvp,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Bvp,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Bvp,2), UBOUND(InData%Bvp,2) - DO i1 = LBOUND(InData%Bvp,1), UBOUND(InData%Bvp,1) - ReKiBuf(Re_Xferred) = InData%Bvp(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveAcc0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc0,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc0,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc0,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc0,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc0,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%WaveAcc0,3), UBOUND(InData%WaveAcc0,3) - DO i2 = LBOUND(InData%WaveAcc0,2), UBOUND(InData%WaveAcc0,2) - DO i1 = LBOUND(InData%WaveAcc0,1), UBOUND(InData%WaveAcc0,1) - ReKiBuf(Re_Xferred) = InData%WaveAcc0(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveTime) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveTime,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveTime,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WaveTime,1), UBOUND(InData%WaveTime,1) - ReKiBuf(Re_Xferred) = InData%WaveTime(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveVel0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel0,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel0,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel0,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel0,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel0,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%WaveVel0,3), UBOUND(InData%WaveVel0,3) - DO i2 = LBOUND(InData%WaveVel0,2), UBOUND(InData%WaveVel0,2) - DO i1 = LBOUND(InData%WaveVel0,1), UBOUND(InData%WaveVel0,1) - ReKiBuf(Re_Xferred) = InData%WaveVel0(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NStepWave - Int_Xferred = Int_Xferred + 1 - DO i2 = LBOUND(InData%SHAP,2), UBOUND(InData%SHAP,2) - DO i1 = LBOUND(InData%SHAP,1), UBOUND(InData%SHAP,1) - ReKiBuf(Re_Xferred) = InData%SHAP(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - DO i2 = LBOUND(InData%SHAPS,2), UBOUND(InData%SHAPS,2) - DO i1 = LBOUND(InData%SHAPS,1), UBOUND(InData%SHAPS,1) - ReKiBuf(Re_Xferred) = InData%SHAPS(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - DO i1 = LBOUND(InData%GAUSSW,1), UBOUND(InData%GAUSSW,1) - ReKiBuf(Re_Xferred) = InData%GAUSSW(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%NGAUSS - Int_Xferred = Int_Xferred + 1 - DO i2 = LBOUND(InData%SHAPT,2), UBOUND(InData%SHAPT,2) - DO i1 = LBOUND(InData%SHAPT,1), UBOUND(InData%SHAPT,1) - ReKiBuf(Re_Xferred) = InData%SHAPT(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - DO i2 = LBOUND(InData%SHAPTS,2), UBOUND(InData%SHAPTS,2) - DO i1 = LBOUND(InData%SHAPTS,1), UBOUND(InData%SHAPTS,1) - ReKiBuf(Re_Xferred) = InData%SHAPTS(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - IntKiBuf(Int_Xferred) = InData%NTRAP - Int_Xferred = Int_Xferred + 1 - DO i2 = LBOUND(InData%SBEND,2), UBOUND(InData%SBEND,2) - DO i1 = LBOUND(InData%SBEND,1), UBOUND(InData%SBEND,1) - ReKiBuf(Re_Xferred) = InData%SBEND(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - DO i3 = LBOUND(InData%STEN,3), UBOUND(InData%STEN,3) - DO i2 = LBOUND(InData%STEN,2), UBOUND(InData%STEN,2) - DO i1 = LBOUND(InData%STEN,1), UBOUND(InData%STEN,1) - ReKiBuf(Re_Xferred) = InData%STEN(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - DO i2 = LBOUND(InData%RMASS,2), UBOUND(InData%RMASS,2) - DO i1 = LBOUND(InData%RMASS,1), UBOUND(InData%RMASS,1) - ReKiBuf(Re_Xferred) = InData%RMASS(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - DO i4 = LBOUND(InData%RADDM,4), UBOUND(InData%RADDM,4) - DO i3 = LBOUND(InData%RADDM,3), UBOUND(InData%RADDM,3) - DO i2 = LBOUND(InData%RADDM,2), UBOUND(InData%RADDM,2) - DO i1 = LBOUND(InData%RADDM,1), UBOUND(InData%RADDM,1) - ReKiBuf(Re_Xferred) = InData%RADDM(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - DO i2 = LBOUND(InData%PMPN,2), UBOUND(InData%PMPN,2) - DO i1 = LBOUND(InData%PMPN,1), UBOUND(InData%PMPN,1) - ReKiBuf(Re_Xferred) = InData%PMPN(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - DO i1 = LBOUND(InData%AM,1), UBOUND(InData%AM,1) - ReKiBuf(Re_Xferred) = InData%AM(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%PM,1), UBOUND(InData%PM,1) - ReKiBuf(Re_Xferred) = InData%PM(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i2 = LBOUND(InData%IDOF,2), UBOUND(InData%IDOF,2) - DO i1 = LBOUND(InData%IDOF,1), UBOUND(InData%IDOF,1) - IntKiBuf(Int_Xferred) = InData%IDOF(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - DO i1 = LBOUND(InData%JDOF,1), UBOUND(InData%JDOF,1) - IntKiBuf(Int_Xferred) = InData%JDOF(i1) - Int_Xferred = Int_Xferred + 1 - END DO - DO i3 = LBOUND(InData%PPA,3), UBOUND(InData%PPA,3) - DO i2 = LBOUND(InData%PPA,2), UBOUND(InData%PPA,2) - DO i1 = LBOUND(InData%PPA,1), UBOUND(InData%PPA,1) - ReKiBuf(Re_Xferred) = InData%PPA(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - ReKiBuf(Re_Xferred) = InData%PtfmRefzt - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumOuts - 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 - IF ( .NOT. ALLOCATED(InData%GLUZR) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%GLUZR,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GLUZR,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%GLUZR,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GLUZR,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%GLUZR,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GLUZR,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%GLUZR,3), UBOUND(InData%GLUZR,3) - DO i2 = LBOUND(InData%GLUZR,2), UBOUND(InData%GLUZR,2) - DO i1 = LBOUND(InData%GLUZR,1), UBOUND(InData%GLUZR,1) - ReKiBuf(Re_Xferred) = InData%GLUZR(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%GTZER) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%GTZER,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GTZER,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%GTZER,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GTZER,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%GTZER,2), UBOUND(InData%GTZER,2) - DO i1 = LBOUND(InData%GTZER,1), UBOUND(InData%GTZER,1) - ReKiBuf(Re_Xferred) = InData%GTZER(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE FEAM_PackParam - - SUBROUTINE FEAM_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(FEAM_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) :: 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 = 'FEAM_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 - i1_l = LBOUND(OutData%GRAV,1) - i1_u = UBOUND(OutData%GRAV,1) - DO i1 = LBOUND(OutData%GRAV,1), UBOUND(OutData%GRAV,1) - OutData%GRAV(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%Eps = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Gravity = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%WtrDens = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MaxIter = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NHBD = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NDIM = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NEQ not allocated - Int_Xferred = Int_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%NEQ)) DEALLOCATE(OutData%NEQ) - ALLOCATE(OutData%NEQ(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NEQ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%NEQ,1), UBOUND(OutData%NEQ,1) - OutData%NEQ(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - OutData%NBAND = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumLines = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumElems = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumNodes = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! GSL not allocated - Int_Xferred = Int_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%GSL)) DEALLOCATE(OutData%GSL) - ALLOCATE(OutData%GSL(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%GSL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%GSL,3), UBOUND(OutData%GSL,3) - DO i2 = LBOUND(OutData%GSL,2), UBOUND(OutData%GSL,2) - DO i1 = LBOUND(OutData%GSL,1), UBOUND(OutData%GSL,1) - OutData%GSL(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 ! GP not allocated - Int_Xferred = Int_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%GP)) DEALLOCATE(OutData%GP) - ALLOCATE(OutData%GP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%GP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%GP,2), UBOUND(OutData%GP,2) - DO i1 = LBOUND(OutData%GP,1), UBOUND(OutData%GP,1) - OutData%GP(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Elength not allocated - Int_Xferred = Int_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%Elength)) DEALLOCATE(OutData%Elength) - ALLOCATE(OutData%Elength(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Elength.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Elength,1), UBOUND(OutData%Elength,1) - OutData%Elength(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BottmElev not allocated - Int_Xferred = Int_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%BottmElev)) DEALLOCATE(OutData%BottmElev) - ALLOCATE(OutData%BottmElev(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BottmElev.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BottmElev,1), UBOUND(OutData%BottmElev,1) - OutData%BottmElev(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BottmStiff not allocated - Int_Xferred = Int_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%BottmStiff)) DEALLOCATE(OutData%BottmStiff) - ALLOCATE(OutData%BottmStiff(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BottmStiff.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BottmStiff,1), UBOUND(OutData%BottmStiff,1) - OutData%BottmStiff(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LMassDen not allocated - Int_Xferred = Int_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%LMassDen)) DEALLOCATE(OutData%LMassDen) - ALLOCATE(OutData%LMassDen(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LMassDen.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LMassDen,1), UBOUND(OutData%LMassDen,1) - OutData%LMassDen(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LDMassDen not allocated - Int_Xferred = Int_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%LDMassDen)) DEALLOCATE(OutData%LDMassDen) - ALLOCATE(OutData%LDMassDen(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LDMassDen.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LDMassDen,1), UBOUND(OutData%LDMassDen,1) - OutData%LDMassDen(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LEAStiff not allocated - Int_Xferred = Int_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%LEAStiff)) DEALLOCATE(OutData%LEAStiff) - ALLOCATE(OutData%LEAStiff(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LEAStiff.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LEAStiff,1), UBOUND(OutData%LEAStiff,1) - OutData%LEAStiff(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LineCI not allocated - Int_Xferred = Int_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%LineCI)) DEALLOCATE(OutData%LineCI) - ALLOCATE(OutData%LineCI(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LineCI.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LineCI,1), UBOUND(OutData%LineCI,1) - OutData%LineCI(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LineCD not allocated - Int_Xferred = Int_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%LineCD)) DEALLOCATE(OutData%LineCD) - ALLOCATE(OutData%LineCD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LineCD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LineCD,1), UBOUND(OutData%LineCD,1) - OutData%LineCD(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Bvp not allocated - Int_Xferred = Int_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%Bvp)) DEALLOCATE(OutData%Bvp) - ALLOCATE(OutData%Bvp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Bvp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Bvp,2), UBOUND(OutData%Bvp,2) - DO i1 = LBOUND(OutData%Bvp,1), UBOUND(OutData%Bvp,1) - OutData%Bvp(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveAcc0 not allocated - Int_Xferred = Int_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%WaveAcc0)) DEALLOCATE(OutData%WaveAcc0) - ALLOCATE(OutData%WaveAcc0(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%WaveAcc0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%WaveAcc0,3), UBOUND(OutData%WaveAcc0,3) - DO i2 = LBOUND(OutData%WaveAcc0,2), UBOUND(OutData%WaveAcc0,2) - DO i1 = LBOUND(OutData%WaveAcc0,1), UBOUND(OutData%WaveAcc0,1) - OutData%WaveAcc0(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 ! WaveTime not allocated - Int_Xferred = Int_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%WaveTime)) DEALLOCATE(OutData%WaveTime) - ALLOCATE(OutData%WaveTime(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveTime.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WaveTime,1), UBOUND(OutData%WaveTime,1) - OutData%WaveTime(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveVel0 not allocated - Int_Xferred = Int_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%WaveVel0)) DEALLOCATE(OutData%WaveVel0) - ALLOCATE(OutData%WaveVel0(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%WaveVel0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%WaveVel0,3), UBOUND(OutData%WaveVel0,3) - DO i2 = LBOUND(OutData%WaveVel0,2), UBOUND(OutData%WaveVel0,2) - DO i1 = LBOUND(OutData%WaveVel0,1), UBOUND(OutData%WaveVel0,1) - OutData%WaveVel0(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - OutData%NStepWave = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%SHAP,1) - i1_u = UBOUND(OutData%SHAP,1) - i2_l = LBOUND(OutData%SHAP,2) - i2_u = UBOUND(OutData%SHAP,2) - DO i2 = LBOUND(OutData%SHAP,2), UBOUND(OutData%SHAP,2) - DO i1 = LBOUND(OutData%SHAP,1), UBOUND(OutData%SHAP,1) - OutData%SHAP(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%SHAPS,1) - i1_u = UBOUND(OutData%SHAPS,1) - i2_l = LBOUND(OutData%SHAPS,2) - i2_u = UBOUND(OutData%SHAPS,2) - DO i2 = LBOUND(OutData%SHAPS,2), UBOUND(OutData%SHAPS,2) - DO i1 = LBOUND(OutData%SHAPS,1), UBOUND(OutData%SHAPS,1) - OutData%SHAPS(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%GAUSSW,1) - i1_u = UBOUND(OutData%GAUSSW,1) - DO i1 = LBOUND(OutData%GAUSSW,1), UBOUND(OutData%GAUSSW,1) - OutData%GAUSSW(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%NGAUSS = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%SHAPT,1) - i1_u = UBOUND(OutData%SHAPT,1) - i2_l = LBOUND(OutData%SHAPT,2) - i2_u = UBOUND(OutData%SHAPT,2) - DO i2 = LBOUND(OutData%SHAPT,2), UBOUND(OutData%SHAPT,2) - DO i1 = LBOUND(OutData%SHAPT,1), UBOUND(OutData%SHAPT,1) - OutData%SHAPT(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%SHAPTS,1) - i1_u = UBOUND(OutData%SHAPTS,1) - i2_l = LBOUND(OutData%SHAPTS,2) - i2_u = UBOUND(OutData%SHAPTS,2) - DO i2 = LBOUND(OutData%SHAPTS,2), UBOUND(OutData%SHAPTS,2) - DO i1 = LBOUND(OutData%SHAPTS,1), UBOUND(OutData%SHAPTS,1) - OutData%SHAPTS(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - OutData%NTRAP = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%SBEND,1) - i1_u = UBOUND(OutData%SBEND,1) - i2_l = LBOUND(OutData%SBEND,2) - i2_u = UBOUND(OutData%SBEND,2) - DO i2 = LBOUND(OutData%SBEND,2), UBOUND(OutData%SBEND,2) - DO i1 = LBOUND(OutData%SBEND,1), UBOUND(OutData%SBEND,1) - OutData%SBEND(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%STEN,1) - i1_u = UBOUND(OutData%STEN,1) - i2_l = LBOUND(OutData%STEN,2) - i2_u = UBOUND(OutData%STEN,2) - i3_l = LBOUND(OutData%STEN,3) - i3_u = UBOUND(OutData%STEN,3) - DO i3 = LBOUND(OutData%STEN,3), UBOUND(OutData%STEN,3) - DO i2 = LBOUND(OutData%STEN,2), UBOUND(OutData%STEN,2) - DO i1 = LBOUND(OutData%STEN,1), UBOUND(OutData%STEN,1) - OutData%STEN(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - i1_l = LBOUND(OutData%RMASS,1) - i1_u = UBOUND(OutData%RMASS,1) - i2_l = LBOUND(OutData%RMASS,2) - i2_u = UBOUND(OutData%RMASS,2) - DO i2 = LBOUND(OutData%RMASS,2), UBOUND(OutData%RMASS,2) - DO i1 = LBOUND(OutData%RMASS,1), UBOUND(OutData%RMASS,1) - OutData%RMASS(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%RADDM,1) - i1_u = UBOUND(OutData%RADDM,1) - i2_l = LBOUND(OutData%RADDM,2) - i2_u = UBOUND(OutData%RADDM,2) - i3_l = LBOUND(OutData%RADDM,3) - i3_u = UBOUND(OutData%RADDM,3) - i4_l = LBOUND(OutData%RADDM,4) - i4_u = UBOUND(OutData%RADDM,4) - DO i4 = LBOUND(OutData%RADDM,4), UBOUND(OutData%RADDM,4) - DO i3 = LBOUND(OutData%RADDM,3), UBOUND(OutData%RADDM,3) - DO i2 = LBOUND(OutData%RADDM,2), UBOUND(OutData%RADDM,2) - DO i1 = LBOUND(OutData%RADDM,1), UBOUND(OutData%RADDM,1) - OutData%RADDM(i1,i2,i3,i4) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - i1_l = LBOUND(OutData%PMPN,1) - i1_u = UBOUND(OutData%PMPN,1) - i2_l = LBOUND(OutData%PMPN,2) - i2_u = UBOUND(OutData%PMPN,2) - DO i2 = LBOUND(OutData%PMPN,2), UBOUND(OutData%PMPN,2) - DO i1 = LBOUND(OutData%PMPN,1), UBOUND(OutData%PMPN,1) - OutData%PMPN(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%AM,1) - i1_u = UBOUND(OutData%AM,1) - DO i1 = LBOUND(OutData%AM,1), UBOUND(OutData%AM,1) - OutData%AM(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%PM,1) - i1_u = UBOUND(OutData%PM,1) - DO i1 = LBOUND(OutData%PM,1), UBOUND(OutData%PM,1) - OutData%PM(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%IDOF,1) - i1_u = UBOUND(OutData%IDOF,1) - i2_l = LBOUND(OutData%IDOF,2) - i2_u = UBOUND(OutData%IDOF,2) - DO i2 = LBOUND(OutData%IDOF,2), UBOUND(OutData%IDOF,2) - DO i1 = LBOUND(OutData%IDOF,1), UBOUND(OutData%IDOF,1) - OutData%IDOF(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%JDOF,1) - i1_u = UBOUND(OutData%JDOF,1) - DO i1 = LBOUND(OutData%JDOF,1), UBOUND(OutData%JDOF,1) - OutData%JDOF(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - i1_l = LBOUND(OutData%PPA,1) - i1_u = UBOUND(OutData%PPA,1) - i2_l = LBOUND(OutData%PPA,2) - i2_u = UBOUND(OutData%PPA,2) - i3_l = LBOUND(OutData%PPA,3) - i3_u = UBOUND(OutData%PPA,3) - DO i3 = LBOUND(OutData%PPA,3), UBOUND(OutData%PPA,3) - DO i2 = LBOUND(OutData%PPA,2), UBOUND(OutData%PPA,2) - DO i1 = LBOUND(OutData%PPA,1), UBOUND(OutData%PPA,1) - OutData%PPA(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - OutData%PtfmRefzt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NumOuts = 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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! GLUZR not allocated - Int_Xferred = Int_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%GLUZR)) DEALLOCATE(OutData%GLUZR) - ALLOCATE(OutData%GLUZR(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%GLUZR.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%GLUZR,3), UBOUND(OutData%GLUZR,3) - DO i2 = LBOUND(OutData%GLUZR,2), UBOUND(OutData%GLUZR,2) - DO i1 = LBOUND(OutData%GLUZR,1), UBOUND(OutData%GLUZR,1) - OutData%GLUZR(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 ! GTZER not allocated - Int_Xferred = Int_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%GTZER)) DEALLOCATE(OutData%GTZER) - ALLOCATE(OutData%GTZER(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%GTZER.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%GTZER,2), UBOUND(OutData%GTZER,2) - DO i1 = LBOUND(OutData%GTZER,1), UBOUND(OutData%GTZER,1) - OutData%GTZER(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE FEAM_UnPackParam - - SUBROUTINE FEAM_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FEAM_InputType), INTENT(INOUT) :: SrcInputData - TYPE(FEAM_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 = 'FEAM_CopyInput' -! + ErrMsg = '' + if (allocated(ContStateData%GLU)) then + deallocate(ContStateData%GLU) + end if + if (allocated(ContStateData%GLDU)) then + deallocate(ContStateData%GLDU) + end if +end subroutine + +subroutine FEAM_PackContState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(FEAM_ContinuousStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FEAM_PackContState' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%GLU) + call RegPackAlloc(RF, InData%GLDU) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FEAM_UnPackContState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(FEAM_ContinuousStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FEAM_UnPackContState' + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%GLU); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%GLDU); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FEAM_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) + type(FEAM_DiscreteStateType), intent(in) :: SrcDiscStateData + type(FEAM_DiscreteStateType), intent(inout) :: DstDiscStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FEAM_CopyDiscState' ErrStat = ErrID_None - ErrMsg = "" - CALL MeshCopy( SrcInputData%HydroForceLineMesh, DstInputData%HydroForceLineMesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcInputData%PtFairleadDisplacement, DstInputData%PtFairleadDisplacement, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE FEAM_CopyInput - - SUBROUTINE FEAM_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(FEAM_InputType), INTENT(INOUT) :: InputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_DestroyInput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL MeshDestroy( InputData%HydroForceLineMesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( InputData%PtFairleadDisplacement, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE FEAM_DestroyInput - - SUBROUTINE FEAM_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(FEAM_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 = 'FEAM_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 ! HydroForceLineMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%HydroForceLineMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! HydroForceLineMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! HydroForceLineMesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! HydroForceLineMesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! HydroForceLineMesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! PtFairleadDisplacement: size of buffers for each call to pack subtype - CALL MeshPack( InData%PtFairleadDisplacement, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! PtFairleadDisplacement - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! PtFairleadDisplacement - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! PtFairleadDisplacement - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! PtFairleadDisplacement - 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%HydroForceLineMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! HydroForceLineMesh - 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%PtFairleadDisplacement, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! PtFairleadDisplacement - 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 FEAM_PackInput - - SUBROUTINE FEAM_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(FEAM_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 = 'FEAM_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%HydroForceLineMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! HydroForceLineMesh - 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%PtFairleadDisplacement, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! PtFairleadDisplacement - 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 FEAM_UnPackInput - - SUBROUTINE FEAM_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FEAM_OutputType), INTENT(INOUT) :: SrcOutputData - TYPE(FEAM_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 = 'FEAM_CopyOutput' -! + ErrMsg = '' + DstDiscStateData%DummyDiscState = SrcDiscStateData%DummyDiscState +end subroutine + +subroutine FEAM_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) + type(FEAM_DiscreteStateType), intent(inout) :: DiscStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FEAM_DestroyDiscState' 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 - CALL MeshCopy( SrcOutputData%PtFairleadLoad, DstOutputData%PtFairleadLoad, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcOutputData%LineMeshPosition, DstOutputData%LineMeshPosition, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE FEAM_CopyOutput - - SUBROUTINE FEAM_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(FEAM_OutputType), INTENT(INOUT) :: OutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_DestroyOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(OutputData%WriteOutput)) THEN - DEALLOCATE(OutputData%WriteOutput) -ENDIF - CALL MeshDestroy( OutputData%PtFairleadLoad, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( OutputData%LineMeshPosition, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE FEAM_DestroyOutput - - SUBROUTINE FEAM_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(FEAM_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 = 'FEAM_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 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! PtFairleadLoad: size of buffers for each call to pack subtype - CALL MeshPack( InData%PtFairleadLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! PtFairleadLoad - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! PtFairleadLoad - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! PtFairleadLoad - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! PtFairleadLoad - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! LineMeshPosition: size of buffers for each call to pack subtype - CALL MeshPack( InData%LineMeshPosition, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! LineMeshPosition - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! LineMeshPosition - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! LineMeshPosition - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! LineMeshPosition - 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%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 - CALL MeshPack( InData%PtFairleadLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! PtFairleadLoad - 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%LineMeshPosition, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! LineMeshPosition - 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 FEAM_PackOutput - - SUBROUTINE FEAM_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(FEAM_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 = 'FEAM_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 - 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%PtFairleadLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! PtFairleadLoad - 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%LineMeshPosition, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! LineMeshPosition - 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 FEAM_UnPackOutput - - - SUBROUTINE FEAM_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(FEAM_InputType), INTENT(INOUT) :: u(:) ! Input at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Inputs - TYPE(FEAM_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 + ErrMsg = '' +end subroutine + +subroutine FEAM_PackDiscState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(FEAM_DiscreteStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FEAM_PackDiscState' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyDiscState) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FEAM_UnPackDiscState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(FEAM_DiscreteStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FEAM_UnPackDiscState' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyDiscState); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FEAM_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) + type(FEAM_ConstraintStateType), intent(in) :: SrcConstrStateData + type(FEAM_ConstraintStateType), intent(inout) :: DstConstrStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FEAM_CopyConstrState' + ErrStat = ErrID_None + ErrMsg = '' + DstConstrStateData%TSN = SrcConstrStateData%TSN + DstConstrStateData%TZER = SrcConstrStateData%TZER +end subroutine + +subroutine FEAM_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) + type(FEAM_ConstraintStateType), intent(inout) :: ConstrStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FEAM_DestroyConstrState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine FEAM_PackConstrState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(FEAM_ConstraintStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FEAM_PackConstrState' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%TSN) + call RegPack(RF, InData%TZER) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FEAM_UnPackConstrState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(FEAM_ConstraintStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FEAM_UnPackConstrState' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%TSN); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TZER); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FEAM_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) + type(FEAM_OtherStateType), intent(in) :: SrcOtherStateData + type(FEAM_OtherStateType), intent(inout) :: DstOtherStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(4), UB(4) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'FEAM_CopyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcOtherStateData%GLU0)) then + LB(1:2) = lbound(SrcOtherStateData%GLU0) + UB(1:2) = ubound(SrcOtherStateData%GLU0) + if (.not. allocated(DstOtherStateData%GLU0)) then + allocate(DstOtherStateData%GLU0(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%GLU0.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOtherStateData%GLU0 = SrcOtherStateData%GLU0 + end if + if (allocated(SrcOtherStateData%GLDDU)) then + LB(1:2) = lbound(SrcOtherStateData%GLDDU) + UB(1:2) = ubound(SrcOtherStateData%GLDDU) + if (.not. allocated(DstOtherStateData%GLDDU)) then + allocate(DstOtherStateData%GLDDU(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%GLDDU.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOtherStateData%GLDDU = SrcOtherStateData%GLDDU + end if + DstOtherStateData%BottomTouch = SrcOtherStateData%BottomTouch + if (allocated(SrcOtherStateData%GFORC0)) then + LB(1:3) = lbound(SrcOtherStateData%GFORC0) + UB(1:3) = ubound(SrcOtherStateData%GFORC0) + if (.not. allocated(DstOtherStateData%GFORC0)) then + allocate(DstOtherStateData%GFORC0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%GFORC0.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOtherStateData%GFORC0 = SrcOtherStateData%GFORC0 + end if + if (allocated(SrcOtherStateData%GMASS0)) then + LB(1:4) = lbound(SrcOtherStateData%GMASS0) + UB(1:4) = ubound(SrcOtherStateData%GMASS0) + if (.not. allocated(DstOtherStateData%GMASS0)) then + allocate(DstOtherStateData%GMASS0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%GMASS0.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOtherStateData%GMASS0 = SrcOtherStateData%GMASS0 + end if + if (allocated(SrcOtherStateData%FAST_FPA)) then + LB(1:2) = lbound(SrcOtherStateData%FAST_FPA) + UB(1:2) = ubound(SrcOtherStateData%FAST_FPA) + if (.not. allocated(DstOtherStateData%FAST_FPA)) then + allocate(DstOtherStateData%FAST_FPA(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%FAST_FPA.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOtherStateData%FAST_FPA = SrcOtherStateData%FAST_FPA + end if + if (allocated(SrcOtherStateData%FAST_RP)) then + LB(1:2) = lbound(SrcOtherStateData%FAST_RP) + UB(1:2) = ubound(SrcOtherStateData%FAST_RP) + if (.not. allocated(DstOtherStateData%FAST_RP)) then + allocate(DstOtherStateData%FAST_RP(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%FAST_RP.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOtherStateData%FAST_RP = SrcOtherStateData%FAST_RP + end if + DstOtherStateData%INCR = SrcOtherStateData%INCR + DstOtherStateData%RSDF = SrcOtherStateData%RSDF + DstOtherStateData%FORC0 = SrcOtherStateData%FORC0 + DstOtherStateData%EMAS0 = SrcOtherStateData%EMAS0 +end subroutine + +subroutine FEAM_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) + type(FEAM_OtherStateType), intent(inout) :: OtherStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FEAM_DestroyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OtherStateData%GLU0)) then + deallocate(OtherStateData%GLU0) + end if + if (allocated(OtherStateData%GLDDU)) then + deallocate(OtherStateData%GLDDU) + end if + if (allocated(OtherStateData%GFORC0)) then + deallocate(OtherStateData%GFORC0) + end if + if (allocated(OtherStateData%GMASS0)) then + deallocate(OtherStateData%GMASS0) + end if + if (allocated(OtherStateData%FAST_FPA)) then + deallocate(OtherStateData%FAST_FPA) + end if + if (allocated(OtherStateData%FAST_RP)) then + deallocate(OtherStateData%FAST_RP) + end if +end subroutine + +subroutine FEAM_PackOtherState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(FEAM_OtherStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FEAM_PackOtherState' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%GLU0) + call RegPackAlloc(RF, InData%GLDDU) + call RegPack(RF, InData%BottomTouch) + call RegPackAlloc(RF, InData%GFORC0) + call RegPackAlloc(RF, InData%GMASS0) + call RegPackAlloc(RF, InData%FAST_FPA) + call RegPackAlloc(RF, InData%FAST_RP) + call RegPack(RF, InData%INCR) + call RegPack(RF, InData%RSDF) + call RegPack(RF, InData%FORC0) + call RegPack(RF, InData%EMAS0) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FEAM_UnPackOtherState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(FEAM_OtherStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FEAM_UnPackOtherState' + integer(B4Ki) :: LB(4), UB(4) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%GLU0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%GLDDU); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BottomTouch); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%GFORC0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%GMASS0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%FAST_FPA); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%FAST_RP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%INCR); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RSDF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FORC0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%EMAS0); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FEAM_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(FEAM_MiscVarType), intent(in) :: SrcMiscData + type(FEAM_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'FEAM_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcMiscData%GLF)) then + LB(1:2) = lbound(SrcMiscData%GLF) + UB(1:2) = ubound(SrcMiscData%GLF) + if (.not. allocated(DstMiscData%GLF)) then + allocate(DstMiscData%GLF(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%GLF.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%GLF = SrcMiscData%GLF + end if + if (allocated(SrcMiscData%GLK)) then + LB(1:3) = lbound(SrcMiscData%GLK) + UB(1:3) = ubound(SrcMiscData%GLK) + if (.not. allocated(DstMiscData%GLK)) then + allocate(DstMiscData%GLK(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%GLK.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%GLK = SrcMiscData%GLK + end if + DstMiscData%EMASS = SrcMiscData%EMASS + DstMiscData%ESTIF = SrcMiscData%ESTIF + if (allocated(SrcMiscData%FAST_FP)) then + LB(1:2) = lbound(SrcMiscData%FAST_FP) + UB(1:2) = ubound(SrcMiscData%FAST_FP) + if (.not. allocated(DstMiscData%FAST_FP)) then + allocate(DstMiscData%FAST_FP(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FAST_FP.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%FAST_FP = SrcMiscData%FAST_FP + end if + DstMiscData%FORCE = SrcMiscData%FORCE + DstMiscData%FP = SrcMiscData%FP + DstMiscData%U = SrcMiscData%U + DstMiscData%U0 = SrcMiscData%U0 + DstMiscData%DU = SrcMiscData%DU + DstMiscData%DDU = SrcMiscData%DDU + DstMiscData%R = SrcMiscData%R + DstMiscData%RP = SrcMiscData%RP + DstMiscData%RHSR = SrcMiscData%RHSR + DstMiscData%SLIN = SrcMiscData%SLIN + DstMiscData%STIFR = SrcMiscData%STIFR + if (allocated(SrcMiscData%FAIR_ANG)) then + LB(1:2) = lbound(SrcMiscData%FAIR_ANG) + UB(1:2) = ubound(SrcMiscData%FAIR_ANG) + if (.not. allocated(DstMiscData%FAIR_ANG)) then + allocate(DstMiscData%FAIR_ANG(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FAIR_ANG.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%FAIR_ANG = SrcMiscData%FAIR_ANG + end if + if (allocated(SrcMiscData%FAIR_T)) then + LB(1:1) = lbound(SrcMiscData%FAIR_T) + UB(1:1) = ubound(SrcMiscData%FAIR_T) + if (.not. allocated(DstMiscData%FAIR_T)) then + allocate(DstMiscData%FAIR_T(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FAIR_T.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%FAIR_T = SrcMiscData%FAIR_T + end if + if (allocated(SrcMiscData%ANCH_ANG)) then + LB(1:2) = lbound(SrcMiscData%ANCH_ANG) + UB(1:2) = ubound(SrcMiscData%ANCH_ANG) + if (.not. allocated(DstMiscData%ANCH_ANG)) then + allocate(DstMiscData%ANCH_ANG(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%ANCH_ANG.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%ANCH_ANG = SrcMiscData%ANCH_ANG + end if + if (allocated(SrcMiscData%ANCH_T)) then + LB(1:1) = lbound(SrcMiscData%ANCH_T) + UB(1:1) = ubound(SrcMiscData%ANCH_T) + if (.not. allocated(DstMiscData%ANCH_T)) then + allocate(DstMiscData%ANCH_T(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%ANCH_T.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%ANCH_T = SrcMiscData%ANCH_T + end if + if (allocated(SrcMiscData%Line_Coordinate)) then + LB(1:3) = lbound(SrcMiscData%Line_Coordinate) + UB(1:3) = ubound(SrcMiscData%Line_Coordinate) + if (.not. allocated(DstMiscData%Line_Coordinate)) then + allocate(DstMiscData%Line_Coordinate(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Line_Coordinate.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%Line_Coordinate = SrcMiscData%Line_Coordinate + end if + if (allocated(SrcMiscData%Line_Tangent)) then + LB(1:3) = lbound(SrcMiscData%Line_Tangent) + UB(1:3) = ubound(SrcMiscData%Line_Tangent) + if (.not. allocated(DstMiscData%Line_Tangent)) then + allocate(DstMiscData%Line_Tangent(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Line_Tangent.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%Line_Tangent = SrcMiscData%Line_Tangent + end if + if (allocated(SrcMiscData%F_Lines)) then + LB(1:2) = lbound(SrcMiscData%F_Lines) + UB(1:2) = ubound(SrcMiscData%F_Lines) + if (.not. allocated(DstMiscData%F_Lines)) then + allocate(DstMiscData%F_Lines(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_Lines.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%F_Lines = SrcMiscData%F_Lines + end if + DstMiscData%LastIndWave = SrcMiscData%LastIndWave +end subroutine + +subroutine FEAM_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(FEAM_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FEAM_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(MiscData%GLF)) then + deallocate(MiscData%GLF) + end if + if (allocated(MiscData%GLK)) then + deallocate(MiscData%GLK) + end if + if (allocated(MiscData%FAST_FP)) then + deallocate(MiscData%FAST_FP) + end if + if (allocated(MiscData%FAIR_ANG)) then + deallocate(MiscData%FAIR_ANG) + end if + if (allocated(MiscData%FAIR_T)) then + deallocate(MiscData%FAIR_T) + end if + if (allocated(MiscData%ANCH_ANG)) then + deallocate(MiscData%ANCH_ANG) + end if + if (allocated(MiscData%ANCH_T)) then + deallocate(MiscData%ANCH_T) + end if + if (allocated(MiscData%Line_Coordinate)) then + deallocate(MiscData%Line_Coordinate) + end if + if (allocated(MiscData%Line_Tangent)) then + deallocate(MiscData%Line_Tangent) + end if + if (allocated(MiscData%F_Lines)) then + deallocate(MiscData%F_Lines) + end if +end subroutine + +subroutine FEAM_PackMisc(RF, Indata) + type(RegFile), intent(inout) :: RF + type(FEAM_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FEAM_PackMisc' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%GLF) + call RegPackAlloc(RF, InData%GLK) + call RegPack(RF, InData%EMASS) + call RegPack(RF, InData%ESTIF) + call RegPackAlloc(RF, InData%FAST_FP) + call RegPack(RF, InData%FORCE) + call RegPack(RF, InData%FP) + call RegPack(RF, InData%U) + call RegPack(RF, InData%U0) + call RegPack(RF, InData%DU) + call RegPack(RF, InData%DDU) + call RegPack(RF, InData%R) + call RegPack(RF, InData%RP) + call RegPack(RF, InData%RHSR) + call RegPack(RF, InData%SLIN) + call RegPack(RF, InData%STIFR) + call RegPackAlloc(RF, InData%FAIR_ANG) + call RegPackAlloc(RF, InData%FAIR_T) + call RegPackAlloc(RF, InData%ANCH_ANG) + call RegPackAlloc(RF, InData%ANCH_T) + call RegPackAlloc(RF, InData%Line_Coordinate) + call RegPackAlloc(RF, InData%Line_Tangent) + call RegPackAlloc(RF, InData%F_Lines) + call RegPack(RF, InData%LastIndWave) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FEAM_UnPackMisc(RF, OutData) + type(RegFile), intent(inout) :: RF + type(FEAM_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FEAM_UnPackMisc' + integer(B4Ki) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%GLF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%GLK); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%EMASS); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ESTIF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%FAST_FP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FORCE); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%U); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%U0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DU); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DDU); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%R); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RHSR); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SLIN); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%STIFR); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%FAIR_ANG); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%FAIR_T); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ANCH_ANG); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ANCH_T); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Line_Coordinate); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Line_Tangent); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%F_Lines); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LastIndWave); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FEAM_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(FEAM_ParameterType), intent(in) :: SrcParamData + type(FEAM_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2, i3, i4 + integer(B4Ki) :: LB(4), UB(4) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FEAM_CopyParam' + ErrStat = ErrID_None + ErrMsg = '' + DstParamData%DT = SrcParamData%DT + DstParamData%GRAV = SrcParamData%GRAV + DstParamData%Eps = SrcParamData%Eps + DstParamData%Gravity = SrcParamData%Gravity + DstParamData%WtrDens = SrcParamData%WtrDens + DstParamData%MaxIter = SrcParamData%MaxIter + DstParamData%NHBD = SrcParamData%NHBD + DstParamData%NDIM = SrcParamData%NDIM + if (allocated(SrcParamData%NEQ)) then + LB(1:1) = lbound(SrcParamData%NEQ) + UB(1:1) = ubound(SrcParamData%NEQ) + if (.not. allocated(DstParamData%NEQ)) then + allocate(DstParamData%NEQ(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%NEQ.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%NEQ = SrcParamData%NEQ + end if + DstParamData%NBAND = SrcParamData%NBAND + DstParamData%NumLines = SrcParamData%NumLines + DstParamData%NumElems = SrcParamData%NumElems + DstParamData%NumNodes = SrcParamData%NumNodes + if (allocated(SrcParamData%GSL)) then + LB(1:3) = lbound(SrcParamData%GSL) + UB(1:3) = ubound(SrcParamData%GSL) + if (.not. allocated(DstParamData%GSL)) then + allocate(DstParamData%GSL(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%GSL.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%GSL = SrcParamData%GSL + end if + if (allocated(SrcParamData%GP)) then + LB(1:2) = lbound(SrcParamData%GP) + UB(1:2) = ubound(SrcParamData%GP) + if (.not. allocated(DstParamData%GP)) then + allocate(DstParamData%GP(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%GP.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%GP = SrcParamData%GP + end if + if (allocated(SrcParamData%Elength)) then + LB(1:1) = lbound(SrcParamData%Elength) + UB(1:1) = ubound(SrcParamData%Elength) + if (.not. allocated(DstParamData%Elength)) then + allocate(DstParamData%Elength(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Elength.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Elength = SrcParamData%Elength + end if + if (allocated(SrcParamData%BottmElev)) then + LB(1:1) = lbound(SrcParamData%BottmElev) + UB(1:1) = ubound(SrcParamData%BottmElev) + if (.not. allocated(DstParamData%BottmElev)) then + allocate(DstParamData%BottmElev(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BottmElev.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%BottmElev = SrcParamData%BottmElev + end if + if (allocated(SrcParamData%BottmStiff)) then + LB(1:1) = lbound(SrcParamData%BottmStiff) + UB(1:1) = ubound(SrcParamData%BottmStiff) + if (.not. allocated(DstParamData%BottmStiff)) then + allocate(DstParamData%BottmStiff(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BottmStiff.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%BottmStiff = SrcParamData%BottmStiff + end if + if (allocated(SrcParamData%LMassDen)) then + LB(1:1) = lbound(SrcParamData%LMassDen) + UB(1:1) = ubound(SrcParamData%LMassDen) + if (.not. allocated(DstParamData%LMassDen)) then + allocate(DstParamData%LMassDen(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%LMassDen.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%LMassDen = SrcParamData%LMassDen + end if + if (allocated(SrcParamData%LDMassDen)) then + LB(1:1) = lbound(SrcParamData%LDMassDen) + UB(1:1) = ubound(SrcParamData%LDMassDen) + if (.not. allocated(DstParamData%LDMassDen)) then + allocate(DstParamData%LDMassDen(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%LDMassDen.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%LDMassDen = SrcParamData%LDMassDen + end if + if (allocated(SrcParamData%LEAStiff)) then + LB(1:1) = lbound(SrcParamData%LEAStiff) + UB(1:1) = ubound(SrcParamData%LEAStiff) + if (.not. allocated(DstParamData%LEAStiff)) then + allocate(DstParamData%LEAStiff(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%LEAStiff.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%LEAStiff = SrcParamData%LEAStiff + end if + if (allocated(SrcParamData%LineCI)) then + LB(1:1) = lbound(SrcParamData%LineCI) + UB(1:1) = ubound(SrcParamData%LineCI) + if (.not. allocated(DstParamData%LineCI)) then + allocate(DstParamData%LineCI(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%LineCI.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%LineCI = SrcParamData%LineCI + end if + if (allocated(SrcParamData%LineCD)) then + LB(1:1) = lbound(SrcParamData%LineCD) + UB(1:1) = ubound(SrcParamData%LineCD) + if (.not. allocated(DstParamData%LineCD)) then + allocate(DstParamData%LineCD(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%LineCD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%LineCD = SrcParamData%LineCD + end if + if (allocated(SrcParamData%Bvp)) then + LB(1:2) = lbound(SrcParamData%Bvp) + UB(1:2) = ubound(SrcParamData%Bvp) + if (.not. allocated(DstParamData%Bvp)) then + allocate(DstParamData%Bvp(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Bvp.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Bvp = SrcParamData%Bvp + end if + if (allocated(SrcParamData%WaveAcc0)) then + LB(1:3) = lbound(SrcParamData%WaveAcc0) + UB(1:3) = ubound(SrcParamData%WaveAcc0) + if (.not. allocated(DstParamData%WaveAcc0)) then + allocate(DstParamData%WaveAcc0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WaveAcc0.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%WaveAcc0 = SrcParamData%WaveAcc0 + end if + if (allocated(SrcParamData%WaveTime)) then + LB(1:1) = lbound(SrcParamData%WaveTime) + UB(1:1) = ubound(SrcParamData%WaveTime) + if (.not. allocated(DstParamData%WaveTime)) then + allocate(DstParamData%WaveTime(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WaveTime.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%WaveTime = SrcParamData%WaveTime + end if + if (allocated(SrcParamData%WaveVel0)) then + LB(1:3) = lbound(SrcParamData%WaveVel0) + UB(1:3) = ubound(SrcParamData%WaveVel0) + if (.not. allocated(DstParamData%WaveVel0)) then + allocate(DstParamData%WaveVel0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WaveVel0.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%WaveVel0 = SrcParamData%WaveVel0 + end if + DstParamData%NStepWave = SrcParamData%NStepWave + DstParamData%SHAP = SrcParamData%SHAP + DstParamData%SHAPS = SrcParamData%SHAPS + DstParamData%GAUSSW = SrcParamData%GAUSSW + DstParamData%NGAUSS = SrcParamData%NGAUSS + DstParamData%SHAPT = SrcParamData%SHAPT + DstParamData%SHAPTS = SrcParamData%SHAPTS + DstParamData%NTRAP = SrcParamData%NTRAP + DstParamData%SBEND = SrcParamData%SBEND + DstParamData%STEN = SrcParamData%STEN + DstParamData%RMASS = SrcParamData%RMASS + DstParamData%RADDM = SrcParamData%RADDM + DstParamData%PMPN = SrcParamData%PMPN + DstParamData%AM = SrcParamData%AM + DstParamData%PM = SrcParamData%PM + DstParamData%IDOF = SrcParamData%IDOF + DstParamData%JDOF = SrcParamData%JDOF + DstParamData%PPA = SrcParamData%PPA + DstParamData%PtfmRefzt = SrcParamData%PtfmRefzt + DstParamData%NumOuts = SrcParamData%NumOuts + DstParamData%RootName = SrcParamData%RootName + if (allocated(SrcParamData%OutParam)) then + LB(1:1) = lbound(SrcParamData%OutParam) + UB(1:1) = ubound(SrcParamData%OutParam) + if (.not. allocated(DstParamData%OutParam)) then + allocate(DstParamData%OutParam(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutParam.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyOutParmType(SrcParamData%OutParam(i1), DstParamData%OutParam(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + DstParamData%Delim = SrcParamData%Delim + if (allocated(SrcParamData%GLUZR)) then + LB(1:3) = lbound(SrcParamData%GLUZR) + UB(1:3) = ubound(SrcParamData%GLUZR) + if (.not. allocated(DstParamData%GLUZR)) then + allocate(DstParamData%GLUZR(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%GLUZR.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%GLUZR = SrcParamData%GLUZR + end if + if (allocated(SrcParamData%GTZER)) then + LB(1:2) = lbound(SrcParamData%GTZER) + UB(1:2) = ubound(SrcParamData%GTZER) + if (.not. allocated(DstParamData%GTZER)) then + allocate(DstParamData%GTZER(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%GTZER.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%GTZER = SrcParamData%GTZER + end if +end subroutine + +subroutine FEAM_DestroyParam(ParamData, ErrStat, ErrMsg) + type(FEAM_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2, i3, i4 + integer(B4Ki) :: LB(4), UB(4) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FEAM_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ParamData%NEQ)) then + deallocate(ParamData%NEQ) + end if + if (allocated(ParamData%GSL)) then + deallocate(ParamData%GSL) + end if + if (allocated(ParamData%GP)) then + deallocate(ParamData%GP) + end if + if (allocated(ParamData%Elength)) then + deallocate(ParamData%Elength) + end if + if (allocated(ParamData%BottmElev)) then + deallocate(ParamData%BottmElev) + end if + if (allocated(ParamData%BottmStiff)) then + deallocate(ParamData%BottmStiff) + end if + if (allocated(ParamData%LMassDen)) then + deallocate(ParamData%LMassDen) + end if + if (allocated(ParamData%LDMassDen)) then + deallocate(ParamData%LDMassDen) + end if + if (allocated(ParamData%LEAStiff)) then + deallocate(ParamData%LEAStiff) + end if + if (allocated(ParamData%LineCI)) then + deallocate(ParamData%LineCI) + end if + if (allocated(ParamData%LineCD)) then + deallocate(ParamData%LineCD) + end if + if (allocated(ParamData%Bvp)) then + deallocate(ParamData%Bvp) + end if + if (allocated(ParamData%WaveAcc0)) then + deallocate(ParamData%WaveAcc0) + end if + if (allocated(ParamData%WaveTime)) then + deallocate(ParamData%WaveTime) + end if + if (allocated(ParamData%WaveVel0)) then + deallocate(ParamData%WaveVel0) + end if + if (allocated(ParamData%OutParam)) then + LB(1:1) = lbound(ParamData%OutParam) + UB(1:1) = ubound(ParamData%OutParam) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyOutParmType(ParamData%OutParam(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%OutParam) + end if + if (allocated(ParamData%GLUZR)) then + deallocate(ParamData%GLUZR) + end if + if (allocated(ParamData%GTZER)) then + deallocate(ParamData%GTZER) + end if +end subroutine + +subroutine FEAM_PackParam(RF, Indata) + type(RegFile), intent(inout) :: RF + type(FEAM_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FEAM_PackParam' + integer(B4Ki) :: i1, i2, i3, i4 + integer(B4Ki) :: LB(4), UB(4) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DT) + call RegPack(RF, InData%GRAV) + call RegPack(RF, InData%Eps) + call RegPack(RF, InData%Gravity) + call RegPack(RF, InData%WtrDens) + call RegPack(RF, InData%MaxIter) + call RegPack(RF, InData%NHBD) + call RegPack(RF, InData%NDIM) + call RegPackAlloc(RF, InData%NEQ) + call RegPack(RF, InData%NBAND) + call RegPack(RF, InData%NumLines) + call RegPack(RF, InData%NumElems) + call RegPack(RF, InData%NumNodes) + call RegPackAlloc(RF, InData%GSL) + call RegPackAlloc(RF, InData%GP) + call RegPackAlloc(RF, InData%Elength) + call RegPackAlloc(RF, InData%BottmElev) + call RegPackAlloc(RF, InData%BottmStiff) + call RegPackAlloc(RF, InData%LMassDen) + call RegPackAlloc(RF, InData%LDMassDen) + call RegPackAlloc(RF, InData%LEAStiff) + call RegPackAlloc(RF, InData%LineCI) + call RegPackAlloc(RF, InData%LineCD) + call RegPackAlloc(RF, InData%Bvp) + call RegPackAlloc(RF, InData%WaveAcc0) + call RegPackAlloc(RF, InData%WaveTime) + call RegPackAlloc(RF, InData%WaveVel0) + call RegPack(RF, InData%NStepWave) + call RegPack(RF, InData%SHAP) + call RegPack(RF, InData%SHAPS) + call RegPack(RF, InData%GAUSSW) + call RegPack(RF, InData%NGAUSS) + call RegPack(RF, InData%SHAPT) + call RegPack(RF, InData%SHAPTS) + call RegPack(RF, InData%NTRAP) + call RegPack(RF, InData%SBEND) + call RegPack(RF, InData%STEN) + call RegPack(RF, InData%RMASS) + call RegPack(RF, InData%RADDM) + call RegPack(RF, InData%PMPN) + call RegPack(RF, InData%AM) + call RegPack(RF, InData%PM) + call RegPack(RF, InData%IDOF) + call RegPack(RF, InData%JDOF) + call RegPack(RF, InData%PPA) + call RegPack(RF, InData%PtfmRefzt) + call RegPack(RF, InData%NumOuts) + call RegPack(RF, InData%RootName) + call RegPack(RF, allocated(InData%OutParam)) + if (allocated(InData%OutParam)) then + call RegPackBounds(RF, 1, lbound(InData%OutParam), ubound(InData%OutParam)) + LB(1:1) = lbound(InData%OutParam) + UB(1:1) = ubound(InData%OutParam) + do i1 = LB(1), UB(1) + call NWTC_Library_PackOutParmType(RF, InData%OutParam(i1)) + end do + end if + call RegPack(RF, InData%Delim) + call RegPackAlloc(RF, InData%GLUZR) + call RegPackAlloc(RF, InData%GTZER) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FEAM_UnPackParam(RF, OutData) + type(RegFile), intent(inout) :: RF + type(FEAM_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FEAM_UnPackParam' + integer(B4Ki) :: i1, i2, i3, i4 + integer(B4Ki) :: LB(4), UB(4) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GRAV); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Eps); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Gravity); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WtrDens); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MaxIter); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NHBD); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NDIM); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%NEQ); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NBAND); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumLines); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumElems); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumNodes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%GSL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%GP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Elength); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BottmElev); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BottmStiff); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LMassDen); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LDMassDen); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LEAStiff); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LineCI); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LineCD); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Bvp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WaveAcc0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WaveTime); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WaveVel0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NStepWave); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SHAP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SHAPS); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GAUSSW); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NGAUSS); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SHAPT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SHAPTS); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NTRAP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SBEND); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%STEN); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RMASS); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RADDM); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PMPN); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AM); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PM); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%IDOF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%JDOF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PPA); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PtfmRefzt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumOuts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RootName); if (RegCheckErr(RF, RoutineName)) return + if (allocated(OutData%OutParam)) deallocate(OutData%OutParam) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%OutParam(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackOutParmType(RF, OutData%OutParam(i1)) ! OutParam + end do + end if + call RegUnpack(RF, OutData%Delim); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%GLUZR); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%GTZER); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FEAM_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) + type(FEAM_InputType), intent(inout) :: SrcInputData + type(FEAM_InputType), intent(inout) :: DstInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FEAM_CopyInput' + ErrStat = ErrID_None + ErrMsg = '' + call MeshCopy(SrcInputData%HydroForceLineMesh, DstInputData%HydroForceLineMesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcInputData%PtFairleadDisplacement, DstInputData%PtFairleadDisplacement, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine FEAM_DestroyInput(InputData, ErrStat, ErrMsg) + type(FEAM_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FEAM_DestroyInput' + ErrStat = ErrID_None + ErrMsg = '' + call MeshDestroy( InputData%HydroForceLineMesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( InputData%PtFairleadDisplacement, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine FEAM_PackInput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(FEAM_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FEAM_PackInput' + if (RF%ErrStat >= AbortErrLev) return + call MeshPack(RF, InData%HydroForceLineMesh) + call MeshPack(RF, InData%PtFairleadDisplacement) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FEAM_UnPackInput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(FEAM_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FEAM_UnPackInput' + if (RF%ErrStat /= ErrID_None) return + call MeshUnpack(RF, OutData%HydroForceLineMesh) ! HydroForceLineMesh + call MeshUnpack(RF, OutData%PtFairleadDisplacement) ! PtFairleadDisplacement +end subroutine + +subroutine FEAM_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(FEAM_OutputType), intent(inout) :: SrcOutputData + type(FEAM_OutputType), intent(inout) :: DstOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FEAM_CopyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcOutputData%WriteOutput)) then + LB(1:1) = lbound(SrcOutputData%WriteOutput) + UB(1:1) = ubound(SrcOutputData%WriteOutput) + if (.not. allocated(DstOutputData%WriteOutput)) then + allocate(DstOutputData%WriteOutput(LB(1):UB(1)), 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 + end if + call MeshCopy(SrcOutputData%PtFairleadLoad, DstOutputData%PtFairleadLoad, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcOutputData%LineMeshPosition, DstOutputData%LineMeshPosition, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine FEAM_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(FEAM_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FEAM_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OutputData%WriteOutput)) then + deallocate(OutputData%WriteOutput) + end if + call MeshDestroy( OutputData%PtFairleadLoad, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( OutputData%LineMeshPosition, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine FEAM_PackOutput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(FEAM_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FEAM_PackOutput' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%WriteOutput) + call MeshPack(RF, InData%PtFairleadLoad) + call MeshPack(RF, InData%LineMeshPosition) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FEAM_UnPackOutput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(FEAM_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FEAM_UnPackOutput' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%WriteOutput); if (RegCheckErr(RF, RoutineName)) return + call MeshUnpack(RF, OutData%PtFairleadLoad) ! PtFairleadLoad + call MeshUnpack(RF, OutData%LineMeshPosition) ! LineMeshPosition +end subroutine + +subroutine FEAM_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(FEAM_InputType), intent(inout) :: u(:) ! Input at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Inputs + type(FEAM_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 = 'FEAM_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 FEAM_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL FEAM_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 FEAM_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 FEAM_Input_ExtrapInterp - - - SUBROUTINE FEAM_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'FEAM_Input_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(u)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(u)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(u) - 1 + select case (order) + case (0) + call FEAM_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call FEAM_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call FEAM_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(u) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE FEAM_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. @@ -7151,43 +2145,44 @@ SUBROUTINE FEAM_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ! !.................................................................................................................................. - TYPE(FEAM_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 - TYPE(FEAM_InputType), INTENT(INOUT) :: u2 ! Input at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs - TYPE(FEAM_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 + TYPE(FEAM_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 + TYPE(FEAM_InputType), INTENT(INOUT) :: u2 ! Input at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs + TYPE(FEAM_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 = 'FEAM_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 + REAL(DbKi) :: t(2) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_Input_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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%HydroForceLineMesh, u2%HydroForceLineMesh, tin, u_out%HydroForceLineMesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp1(u1%PtFairleadDisplacement, u2%PtFairleadDisplacement, tin, u_out%PtFairleadDisplacement, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - END SUBROUTINE FEAM_Input_ExtrapInterp1 - - - SUBROUTINE FEAM_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + CALL MeshExtrapInterp1(u1%HydroForceLineMesh, u2%HydroForceLineMesh, tin, u_out%HydroForceLineMesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp1(u1%PtFairleadDisplacement, u2%PtFairleadDisplacement, tin, u_out%PtFairleadDisplacement, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) +END SUBROUTINE + +SUBROUTINE FEAM_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. @@ -7201,103 +2196,104 @@ SUBROUTINE FEAM_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Er ! !.................................................................................................................................. - TYPE(FEAM_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 > t3 - TYPE(FEAM_InputType), INTENT(INOUT) :: u2 ! Input at t2 > t3 - TYPE(FEAM_InputType), INTENT(INOUT) :: u3 ! Input at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs - TYPE(FEAM_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 + TYPE(FEAM_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 > t3 + TYPE(FEAM_InputType), INTENT(INOUT) :: u2 ! Input at t2 > t3 + TYPE(FEAM_InputType), INTENT(INOUT) :: u3 ! Input at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs + TYPE(FEAM_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 = 'FEAM_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) - + 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) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_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 + 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 + 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 + 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%HydroForceLineMesh, u2%HydroForceLineMesh, u3%HydroForceLineMesh, tin, u_out%HydroForceLineMesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp2(u1%PtFairleadDisplacement, u2%PtFairleadDisplacement, u3%PtFairleadDisplacement, tin, u_out%PtFairleadDisplacement, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - END SUBROUTINE FEAM_Input_ExtrapInterp2 - - - SUBROUTINE FEAM_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(FEAM_OutputType), INTENT(INOUT) :: y(:) ! Output at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Outputs - TYPE(FEAM_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 + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + CALL MeshExtrapInterp2(u1%HydroForceLineMesh, u2%HydroForceLineMesh, u3%HydroForceLineMesh, tin, u_out%HydroForceLineMesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp2(u1%PtFairleadDisplacement, u2%PtFairleadDisplacement, u3%PtFairleadDisplacement, tin, u_out%PtFairleadDisplacement, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) +END SUBROUTINE + +subroutine FEAM_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(FEAM_OutputType), intent(inout) :: y(:) ! Output at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Outputs + type(FEAM_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 = 'FEAM_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 FEAM_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL FEAM_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 FEAM_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 FEAM_Output_ExtrapInterp - - - SUBROUTINE FEAM_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'FEAM_Output_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(y)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(y)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(y) - 1 + select case (order) + case (0) + call FEAM_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call FEAM_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call FEAM_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(y) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE FEAM_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. @@ -7309,51 +2305,49 @@ SUBROUTINE FEAM_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMs ! !.................................................................................................................................. - TYPE(FEAM_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 - TYPE(FEAM_OutputType), INTENT(INOUT) :: y2 ! Output at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs - TYPE(FEAM_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 + TYPE(FEAM_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 + TYPE(FEAM_OutputType), INTENT(INOUT) :: y2 ! Output at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs + TYPE(FEAM_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 = 'FEAM_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 + REAL(DbKi) :: t(2) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_Output_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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 - CALL MeshExtrapInterp1(y1%PtFairleadLoad, y2%PtFairleadLoad, tin, y_out%PtFairleadLoad, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp1(y1%LineMeshPosition, y2%LineMeshPosition, tin, y_out%LineMeshPosition, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - END SUBROUTINE FEAM_Output_ExtrapInterp1 - - - SUBROUTINE FEAM_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + END IF ! check if allocated + CALL MeshExtrapInterp1(y1%PtFairleadLoad, y2%PtFairleadLoad, tin, y_out%PtFairleadLoad, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp1(y1%LineMeshPosition, y2%LineMeshPosition, tin, y_out%LineMeshPosition, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) +END SUBROUTINE + +SUBROUTINE FEAM_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. @@ -7367,58 +2361,54 @@ SUBROUTINE FEAM_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, E ! !.................................................................................................................................. - TYPE(FEAM_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 > t3 - TYPE(FEAM_OutputType), INTENT(INOUT) :: y2 ! Output at t2 > t3 - TYPE(FEAM_OutputType), INTENT(INOUT) :: y3 ! Output at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs - TYPE(FEAM_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 + TYPE(FEAM_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 > t3 + TYPE(FEAM_OutputType), INTENT(INOUT) :: y2 ! Output at t2 > t3 + TYPE(FEAM_OutputType), INTENT(INOUT) :: y3 ! Output at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs + TYPE(FEAM_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 = 'FEAM_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) - + 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) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_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 + 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 + 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 + 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 - CALL MeshExtrapInterp2(y1%PtFairleadLoad, y2%PtFairleadLoad, y3%PtFairleadLoad, tin, y_out%PtFairleadLoad, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp2(y1%LineMeshPosition, y2%LineMeshPosition, y3%LineMeshPosition, tin, y_out%LineMeshPosition, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - END SUBROUTINE FEAM_Output_ExtrapInterp2 - + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + a3*y3%WriteOutput + END IF ! check if allocated + CALL MeshExtrapInterp2(y1%PtFairleadLoad, y2%PtFairleadLoad, y3%PtFairleadLoad, tin, y_out%PtFairleadLoad, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp2(y1%LineMeshPosition, y2%LineMeshPosition, y3%LineMeshPosition, tin, y_out%LineMeshPosition, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) +END SUBROUTINE END MODULE FEAMooring_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/hydrodyn/CMakeLists.txt b/modules/hydrodyn/CMakeLists.txt index 07e0319ec3..3cee15f647 100644 --- a/modules/hydrodyn/CMakeLists.txt +++ b/modules/hydrodyn/CMakeLists.txt @@ -16,20 +16,16 @@ if (GENERATE_TYPES) generate_f90_types(src/Conv_Radiation.txt ${CMAKE_CURRENT_LIST_DIR}/src/Conv_Radiation_Types.f90) - generate_f90_types(src/Current.txt ${CMAKE_CURRENT_LIST_DIR}/src/Current_Types.f90) generate_f90_types(src/HydroDyn.txt ${CMAKE_CURRENT_LIST_DIR}/src/HydroDyn_Types.f90) generate_f90_types(src/Morison.txt ${CMAKE_CURRENT_LIST_DIR}/src/Morison_Types.f90) generate_f90_types(src/SS_Radiation.txt ${CMAKE_CURRENT_LIST_DIR}/src/SS_Radiation_Types.f90) generate_f90_types(src/SS_Excitation.txt ${CMAKE_CURRENT_LIST_DIR}/src/SS_Excitation_Types.f90) generate_f90_types(src/WAMIT.txt ${CMAKE_CURRENT_LIST_DIR}/src/WAMIT_Types.f90) generate_f90_types(src/WAMIT2.txt ${CMAKE_CURRENT_LIST_DIR}/src/WAMIT2_Types.f90) - generate_f90_types(src/Waves.txt ${CMAKE_CURRENT_LIST_DIR}/src/Waves_Types.f90) - generate_f90_types(src/Waves2.txt ${CMAKE_CURRENT_LIST_DIR}/src/Waves2_Types.f90) endif() -add_library(hydrodynlib +add_library(hydrodynlib STATIC src/Conv_Radiation.f90 - src/Current.f90 src/HydroDyn.f90 src/HydroDyn_Input.f90 src/HydroDyn_Output.f90 @@ -37,46 +33,44 @@ add_library(hydrodynlib src/Morison_Output.f90 src/SS_Radiation.f90 src/SS_Excitation.f90 - src/UserWaves.f90 src/WAMIT.f90 src/WAMIT2.f90 src/WAMIT_Interp.f90 - src/Waves.f90 - src/Waves2.f90 - src/Waves2_Output.f90 src/Conv_Radiation_Types.f90 - src/Current_Types.f90 src/HydroDyn_Types.f90 src/Morison_Types.f90 src/SS_Radiation_Types.f90 src/SS_Excitation_Types.f90 src/WAMIT_Types.f90 src/WAMIT2_Types.f90 - src/Waves_Types.f90 - src/Waves2_Types.f90 + src/YawOffset.f90 ) -target_link_libraries(hydrodynlib nwtclibs) +target_link_libraries(hydrodynlib seastlib nwtclibs) + +# HydroDyn Driver Subs Library +add_library(hydrodyn_driver_subs STATIC + src/HydroDyn_DriverSubs.f90 +) +target_link_libraries(hydrodyn_driver_subs hydrodynlib) # Driver add_executable(hydrodyn_driver src/HydroDyn_DriverCode.f90 ) -target_link_libraries(hydrodyn_driver hydrodynlib versioninfolib) +target_link_libraries(hydrodyn_driver hydrodyn_driver_subs versioninfolib) # C-bindings interface library add_library(hydrodyn_c_binding SHARED src/HydroDyn_C_Binding.f90 ) -target_link_libraries(hydrodyn_c_binding hydrodynlib versioninfolib) +target_link_libraries(hydrodyn_c_binding hydrodynlib seastlib versioninfolib) if(APPLE OR UNIX) target_compile_definitions(hydrodyn_c_binding PRIVATE IMPLICIT_DLLEXPORT) endif() -#add_executable(ss_radiation -# src/SS_Radiation_DriverCode.f90) -#target_link_libraries(ss_radiation hydrodynlib nwtclibs) -install(TARGETS hydrodynlib hydrodyn_driver hydrodyn_c_binding + +install(TARGETS hydrodynlib hydrodyn_driver hydrodyn_driver_subs hydrodyn_c_binding EXPORT "${CMAKE_PROJECT_NAME}Libraries" RUNTIME DESTINATION bin LIBRARY DESTINATION lib diff --git a/modules/hydrodyn/python-lib/hydrodyn_library.py b/modules/hydrodyn/python-lib/hydrodyn_library.py index f9abfff7b2..3cf6847bfa 100644 --- a/modules/hydrodyn/python-lib/hydrodyn_library.py +++ b/modules/hydrodyn/python-lib/hydrodyn_library.py @@ -162,8 +162,10 @@ def __init__(self, library_path): def _initialize_routines(self): self.HydroDyn_C_Init.argtypes = [ POINTER(c_char), # OutRootName - POINTER(c_char_p), # input file string - POINTER(c_int), # input file string length + POINTER(c_char_p), # SeaState input file string + POINTER(c_int), # SeaState input file string length + POINTER(c_char_p), # HydroDyn input file string + POINTER(c_int), # HydroDyn input file string length POINTER(c_float), # gravity POINTER(c_float), # defWtrDens POINTER(c_float), # defWtrDpth @@ -216,14 +218,17 @@ def _initialize_routines(self): self.HydroDyn_C_End.restype = c_int # hydrodyn_init ------------------------------------------------------------------------------------------------------------ - def hydrodyn_init(self, input_string_array): + def hydrodyn_init(self, seast_input_string_array, hd_input_string_array): # nodePositions -- N x 6 array -- position info as [x1,y1,z1,Rx1,Ry1,Rz1] # Primary input file will be passed as a single string joined by # C_NULL_CHAR. - input_string = '\x00'.join(input_string_array) - input_string = input_string.encode('utf-8') - input_string_length = len(input_string) + seast_input_string = '\x00'.join(seast_input_string_array) + seast_input_string = seast_input_string.encode('utf-8') + seast_input_string_length = len(seast_input_string) + hd_input_string = '\x00'.join(hd_input_string_array) + hd_input_string = hd_input_string.encode('utf-8') + hd_input_string_length = len(hd_input_string) self._numChannels_c = c_int(0) @@ -264,8 +269,10 @@ def hydrodyn_init(self, input_string_array): # call HydroDyn_C_Init self.HydroDyn_C_Init( _outRootName_c, # IN: rootname for HD file writing - c_char_p(input_string), # IN: input file string - byref(c_int(input_string_length)), # IN: input file string length + c_char_p(seast_input_string), # IN: SeaState input file string + byref(c_int(seast_input_string_length)),# IN: SeaState input file string length + c_char_p(hd_input_string), # IN: HydroDyn input file string + byref(c_int(hd_input_string_length)), # IN: HydroDyn input file string length byref(c_float(self.gravity)), # IN: gravity byref(c_float(self.defWtrDens)), # IN: default water density byref(c_float(self.defWtrDpth)), # IN: default water depth diff --git a/modules/hydrodyn/src/Conv_Radiation.f90 b/modules/hydrodyn/src/Conv_Radiation.f90 index 7d54b37e24..59842ddd2c 100644 --- a/modules/hydrodyn/src/Conv_Radiation.f90 +++ b/modules/hydrodyn/src/Conv_Radiation.f90 @@ -1,5 +1,5 @@ !********************************************************************************************************************************** -! The Conv_Radiation and Conv_Radiation_Types modules make up a template for creating user-defined calculations in the FAST Modularization +! The Conv_Radiation and Conv_Radiation_Types modules make up a template for creating user-defined calculations in the FAST Modularization ! Framework. Conv_Radiations_Types will be auto-generated based on a description of the variables for the module. ! ! "Conv_Radiation" should be replaced with the name of your module. Example: HydroDyn @@ -21,114 +21,102 @@ ! 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 Conv_Radiation - USE Conv_Radiation_Types + USE Conv_Radiation_Types USE NWTC_Library USE NWTC_FFTPACK - + IMPLICIT NONE - + PRIVATE - + REAL(DbKi), PARAMETER, PRIVATE :: OnePlusEps = 1.0 + EPSILON(OnePlusEps) !< The number slighty greater than unity in the precision of DbKi. TYPE(ProgDesc), PARAMETER :: Conv_Rdtn_ProgDesc = ProgDesc( 'Conv_Radiation', '', '' ) - + ! ..... Public Subroutines ................................................................................................... PUBLIC :: Conv_Rdtn_Init ! Initialization routine PUBLIC :: Conv_Rdtn_End ! Ending routine (includes clean up) - - PUBLIC :: Conv_Rdtn_UpdateStates ! Loose coupling routine for solving for constraint states, integrating + + PUBLIC :: Conv_Rdtn_UpdateStates ! Loose coupling routine for solving for constraint states, integrating ! continuous states, and updating discrete states PUBLIC :: Conv_Rdtn_CalcOutput ! Routine for computing outputs - + PUBLIC :: Conv_Rdtn_CalcConstrStateResidual ! Tight coupling routine for returning the constraint state residual PUBLIC :: Conv_Rdtn_CalcContStateDeriv ! Tight coupling routine for computing derivatives of continuous states PUBLIC :: Conv_Rdtn_UpdateDiscState ! Tight coupling routine for updating discrete states - - + + CONTAINS !---------------------------------------------------------------------------------------------------------------------------------- -!> This routine is called at the start of the simulation to perform initialization steps. +!> 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 Conv_Rdtn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut, ErrStat, ErrMsg ) +SUBROUTINE Conv_Rdtn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, InitOut, ErrStat, ErrMsg ) !.................................................................................................................................. TYPE(Conv_Rdtn_InitInputType), INTENT(IN ) :: InitInp !< Input data for initialization routine TYPE(Conv_Rdtn_InputType), INTENT( OUT) :: u !< An initial guess for the input; input mesh must be defined - TYPE(Conv_Rdtn_ParameterType), INTENT( OUT) :: p !< Parameters + TYPE(Conv_Rdtn_ParameterType), INTENT( OUT) :: p !< Parameters TYPE(Conv_Rdtn_ContinuousStateType), INTENT( OUT) :: x !< Initial continuous states TYPE(Conv_Rdtn_DiscreteStateType), INTENT( OUT) :: xd !< Initial discrete states TYPE(Conv_Rdtn_ConstraintStateType), INTENT( OUT) :: z !< Initial guess of the constraint states - TYPE(Conv_Rdtn_OtherStateType), INTENT( OUT) :: OtherState !< Initial other states - TYPE(Conv_Rdtn_OutputType), INTENT( OUT) :: y !< Initial system outputs (outputs are not calculated; + TYPE(Conv_Rdtn_OtherStateType), INTENT( OUT) :: OtherState !< Initial other states + TYPE(Conv_Rdtn_OutputType), INTENT( OUT) :: y !< Initial system outputs (outputs are not calculated; !! only the output mesh is initialized) - TYPE(Conv_Rdtn_MiscVarType), INTENT( OUT) :: m !< Initial misc/optimization variables - REAL(DbKi), INTENT(INOUT) :: Interval !< Coupling interval in seconds: the rate that - !! (1) Conv_Rdtn_UpdateStates() is called in loose coupling & - !! (2) Conv_Rdtn_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(Conv_Rdtn_MiscVarType), INTENT( OUT) :: m !< Initial misc/optimization variables TYPE(Conv_Rdtn_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 - - REAL(SiKi) :: Omega ! Wave frequency (rad/s) - REAL(DbKi) :: Krnl_Fact ! Factor used to scale the magnitude of the RdtnKnrl as required by the discrete time (co)sine transform (-) + + REAL(SiKi) :: Omega ! Wave frequency (rad/s) + REAL(DbKi) :: Krnl_Fact ! Factor used to scale the magnitude of the RdtnKnrl as required by the discrete time (co)sine transform (-) REAL(DbKi) :: RdtnTMax ! Analysis time for wave radiation kernel calculations (sec), may be different from Init_Data%RdtnTMax REAL(ReKi) :: RdtnDOmega ! Frequency step for wave radiation kernel calculations (rad/s) REAL(ReKi) :: RdtnOmegaMax ! Maximum frequency used in the (co)sine transform to fine the radiation impulse response functions (rad/s) REAL(DbKi), ALLOCATABLE :: RdtnTime (:) ! Simulation times at which the instantaneous values of the wave radiation kernel are determined (sec) LOGICAL :: RdtnFrmAM ! Determine the wave radiation kernel from the frequency-dependent hydrodynamic added mass matrix? (.TRUE = yes, .FALSE. = determine the wave radiation kernel from the frequency-dependent hydrodynamic damping matrix) !JASON: SHOULD YOU MAKE THIS AN INPUT???<--JASON: IT IS NOT WISE TO COMPUTE THE RADIATION KERNEL FROM THE FREQUENCY-DEPENDENT ADDED MASS MATRIX, UNLESS A CORRECTION IS APPLIED. THIS IS DESCRIBED IN THE WAMIT USER'S GUIDE!!!! INTEGER :: NStepRdtn2 ! ( NStepRdtn-1 )/2 - INTEGER :: Indx ! Cycles through the upper-triangular portion (diagonal and above) of the frequency-dependent hydrodynamic added mass and damping matrices from the radiation problem INTEGER :: I ! Generic index INTEGER :: J ! Generic index INTEGER :: K ! Generic index INTEGER :: LastInd ! Index into the arrays saved from the last call as a starting point for this call - + TYPE(FFT_DataType) :: FFT_Data ! the instance of the FFT module we're using ! Error handling CHARACTER(1024) :: ErrMsg2 ! Temporary error message for calls INTEGER(IntKi) :: ErrStat2 ! Temporary error status for calls - + ! Initialize ErrStat - - ErrStat = ErrID_None - ErrMsg = "" - + + ErrStat = ErrID_None + ErrMsg = "" + ! For now, this is the only model we have implemented - RdtnFrmAM = .FALSE. - - ! Initialize the NWTC Subroutine Library - - CALL NWTC_Init( ) + RdtnFrmAM = .FALSE. - ! If HighFreq is greater than ! RdtnOmegaMax, Abort because RdtnDT must be reduced in order to have ! sufficient accuracy in the computation of the radiation impulse response ! functions: - p%NBody = InitInp%NBody - p%RdtnDT = InitInp%RdtnDT - RdtnOmegaMax = Pi / InitInp%RdtnDT - + p%NBody = InitInp%NBody + p%RdtnDT = InitInp%RdtnDT ! this is also Interval + RdtnOmegaMax = Pi / InitInp%RdtnDT + IF ( InitInp%HighFreq > RdtnOmegaMax ) THEN ! .TRUE. if the highest frequency component (not counting infinity) in the WAMIT file is greater than RdtnOmegaMax ErrMsg = ' Based on the frequency range found in "'//TRIM(InitInp%WAMITFile)//'.1",' // & ' RdtnDT must be set smaller than '//TRIM(Num2LStr( Pi/InitInp%HighFreq ))//' sec'// & @@ -136,13 +124,13 @@ SUBROUTINE Conv_Rdtn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, ErrStat = ErrID_Fatal RETURN END IF - + call AllocAry( u%Velocity, 6*p%NBody, "u%Velocity" , ErrStat2, ErrMsg2 ); call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'Conv_Rdtn_Init' ) - call AllocAry( y%F_Rdtn , 6*p%NBody, "y%F_Rdtn" , ErrStat2, ErrMsg2 ); call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'Conv_Rdtn_Init' ) + call AllocAry( y%F_Rdtn , 6*p%NBody, "y%F_Rdtn" , ErrStat2, ErrMsg2 ); call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'Conv_Rdtn_Init' ) + + u%Velocity = 0.0 !this is an initial guess; + - u%Velocity = 0.0 !this is an initial guess; - - ! Perform some initialization computations including calculating the total ! number of frequency components = total number of time steps in the wave, ! radiation kernel, calculating the frequency step, and ALLOCATing the @@ -158,9 +146,9 @@ SUBROUTINE Conv_Rdtn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, ! = Pi/RdtnTMax p%NStepRdtn = CEILING ( InitInp%RdtnTMax/p%RdtnDT ) ! Set NStepRdtn to an odd integer - + IF ( MOD(p%NStepRdtn,2) == 0 ) p%NStepRdtn = p%NStepRdtn + 1 ! larger or equal to RdtnTMax/RdtnDT. - + NStepRdtn2 = MAX( ( p%NStepRdtn-1 )/2, 1 ) ! Make sure that NStepRdtn-1 is an even product of small factors (PSF) that is greater p%NStepRdtn = 2*PSF ( NStepRdtn2, 9 ) + 1 ! or equal to RdtnTMax/RdtnDT to ensure that the (co)sine transform is efficient. @@ -200,7 +188,7 @@ SUBROUTINE Conv_Rdtn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, LastInd = 1 IF ( RdtnFrmAM ) THEN ! .TRUE. if we will determine the wave radiation kernel from the frequency-dependent hydrodynamic added mass matrix - + ! Calculate the factor needed by the discrete sine transform in the ! calculation of the wave radiation kernel: @@ -248,13 +236,13 @@ SUBROUTINE Conv_Rdtn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, ! the wave radiation kernel: CALL InitSINT ( p%NStepRdtn, FFT_Data, .TRUE., ErrStat ) - + IF ( ErrStat /= ErrID_None ) THEN ErrMsg = 'Error Initializating Sine Transforms' ErrStat = ErrID_Fatal RETURN END IF - + DO J = 1,6*p%NBody ! Loop through all rows of RdtnKrnl DO K = 1,6*p%NBody ! Loop through all columns of RdtnKrnl above and including the diagonal CALL ApplySINT( p%RdtnKrnl(:,J,K), FFT_Data, ErrStat ) @@ -344,41 +332,19 @@ SUBROUTINE Conv_Rdtn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, END IF - - ! IF ( InitInp%UnSum > 0 ) THEN - ! - ! ! Write the header for this section - ! WRITE( InitInp%UnSum, '(//)' ) - ! WRITE( InitInp%UnSum, '(A)' ) 'Radiation memory effect kernel' - ! WRITE( InitInp%UnSum, '(//)' ) - ! WRITE( InitInp%UnSum, '(1X,A10,2X,A10,21(2X,A16))' ) ' n ' , ' t ', ' K11 ', ' K12 ', ' K13 ', ' K14 ', ' K15 ', ' K16 ', ' K22 ', ' K23 ', ' K24 ', ' K25 ', ' K26 ', ' K33 ', ' K34 ', ' K35 ', 'K36 ', ' K44 ', ' K45 ', ' K46 ', ' K55 ', ' K56 ', ' K66 ' - ! WRITE( InitInp%UnSum, '(1X,A10,2X,A10,21(2X,A16))' ) ' (-) ' , ' (s) ', ' (kg/s^2) ', ' (kg/s^2) ', ' (kg/s^2) ', ' (kgm/s^2) ', ' (kgm/s^2) ', ' (kgm/s^2) ', ' (kg/s^2) ', ' (kg/s^2) ', ' (kgm/s^2) ', ' (kgm/s^2) ', ' (kgm/s^2) ', ' (kg/s^2) ', ' (kgm/s^2) ', ' (kgm/s^2) ', ' (kgm/s^2) ', '(kgm^2/s^2)', '(kgm^2/s^2)', '(kgm^2/s^2)', '(kgm^2/s^2)', '(kgm^2/s^2)', '(kgm^2/s^2)' - ! - ! ! Write the data - ! DO I = 0,p%NStepRdtn-1 - ! - ! WRITE( InitInp%UnSum, '(1X,I10,2X,E12.5,21(2X,ES16.5))' ) I, I*p%RdtnDT, p%RdtnKrnl(I,1,1), p%RdtnKrnl(I,1,2), p%RdtnKrnl(I,1,3), p%RdtnKrnl(I,1,4), p%RdtnKrnl(I,1,5), p%RdtnKrnl(I,1,6), p%RdtnKrnl(I,2,2), p%RdtnKrnl(I,2,3), p%RdtnKrnl(I,2,4), p%RdtnKrnl(I,2,5), p%RdtnKrnl(I,2,6), p%RdtnKrnl(I,3,3), p%RdtnKrnl(I,3,4), p%RdtnKrnl(I,3,5), p%RdtnKrnl(I,3,6), p%RdtnKrnl(I,4,4), p%RdtnKrnl(I,4,5), p%RdtnKrnl(I,4,6), p%RdtnKrnl(I,5,5), p%RdtnKrnl(I,5,6), p%RdtnKrnl(I,6,6) - ! - ! END DO - ! - !END IF - - + + IF ( ALLOCATED( RdtnTime ) ) DEALLOCATE( RdtnTime ) - ! 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%RdtnDT m%LastIndRdtn = 0 OtherState%IndRdtn = 0 - - ! bjj: these initializations don't matter, but I don't like seeing the compilation warning in IVF: + + ! bjj: these initializations don't matter, but I don't like seeing the compilation warning in Intel Fortran: x%DummyContState = 0.0 z%DummyConstrState = 0.0 - y%F_Rdtn = 0.0 - InitOut%DummyInitOut = 0 + y%F_Rdtn = 0.0 + InitOut%DummyInitOut = 0 END SUBROUTINE Conv_Rdtn_Init !---------------------------------------------------------------------------------------------------------------------------------- @@ -387,56 +353,56 @@ SUBROUTINE Conv_Rdtn_End( u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) !.................................................................................................................................. TYPE(Conv_Rdtn_InputType), INTENT(INOUT) :: u !< System inputs - TYPE(Conv_Rdtn_ParameterType), INTENT(INOUT) :: p !< Parameters + TYPE(Conv_Rdtn_ParameterType), INTENT(INOUT) :: p !< Parameters TYPE(Conv_Rdtn_ContinuousStateType), INTENT(INOUT) :: x !< Continuous states TYPE(Conv_Rdtn_DiscreteStateType), INTENT(INOUT) :: xd !< Discrete states TYPE(Conv_Rdtn_ConstraintStateType), INTENT(INOUT) :: z !< Constraint states - TYPE(Conv_Rdtn_OtherStateType), INTENT(INOUT) :: OtherState !< Other/optimization states + TYPE(Conv_Rdtn_OtherStateType), INTENT(INOUT) :: OtherState !< Other/optimization states TYPE(Conv_Rdtn_OutputType), INTENT(INOUT) :: y !< System outputs - TYPE(Conv_Rdtn_MiscVarType), INTENT(INOUT) :: m !< Initial misc/optimization variables + TYPE(Conv_Rdtn_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 ! Initialize ErrStat - - ErrStat = ErrID_None - ErrMsg = "" - - + + ErrStat = ErrID_None + ErrMsg = "" + + ! Place any last minute operations or calculations here: - ! Close files here: - - + ! Close files here: + + ! Destroy the input data: - + CALL Conv_Rdtn_DestroyInput( u, ErrStat, ErrMsg ) ! Destroy the parameter data: - + CALL Conv_Rdtn_DestroyParam( p, ErrStat, ErrMsg ) ! Destroy the state data: - + CALL Conv_Rdtn_DestroyContState( x, ErrStat, ErrMsg ) CALL Conv_Rdtn_DestroyDiscState( xd, ErrStat, ErrMsg ) CALL Conv_Rdtn_DestroyConstrState( z, ErrStat, ErrMsg ) CALL Conv_Rdtn_DestroyOtherState( OtherState, ErrStat, ErrMsg ) - + CALL Conv_Rdtn_DestroyMisc( m, ErrStat, ErrMsg ) ! Destroy the output data: - + CALL Conv_Rdtn_DestroyOutput( y, ErrStat, ErrMsg ) - + END SUBROUTINE Conv_Rdtn_End @@ -459,63 +425,63 @@ SUBROUTINE Conv_Rdtn_UpdateStates( t, n, Inputs, InputTimes, p, x, xd, z, OtherS !! Output: Constraint states at t + Interval TYPE(Conv_Rdtn_OtherStateType), INTENT(INOUT) :: OtherState !< Input: Other states at t; !! Output: Other states at t + Interval - TYPE(Conv_Rdtn_MiscVarType), INTENT(INOUT) :: m !< Initial misc/optimization variables + TYPE(Conv_Rdtn_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 - + TYPE(Conv_Rdtn_InputType) :: u !< Instantaneous inputs INTEGER(IntKi) :: ErrStat2 !< Error status of the operation (secondary error) CHARACTER(ErrMsgLen) :: ErrMsg2 !< Error message if ErrStat2 /= ErrID_None character(*), parameter :: RoutineName = 'Conv_Rdtn_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: call Conv_Rdtn_CopyInput( Inputs(1), u, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - - CALL Conv_Rdtn_Input_ExtrapInterp( Inputs, InputTimes, u, t, ErrStat2, ErrMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + + CALL Conv_Rdtn_Input_ExtrapInterp( Inputs, InputTimes, u, t, ErrStat2, ErrMsg2 ) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) IF ( ErrStat >= AbortErrLev ) RETURN - - + + ! Update discrete states: ! Note that xd [discrete state] is changed in Conv_Rdtn_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 Conv_Rdtn_UpdateDiscState( t, n, u, p, x, xd, z, OtherState, m, ErrStat2, ErrMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ! Integrate (update) continuous states (x) here: !x = function of dxdt and x ! Destroy local variables before returning - + CALL Conv_Rdtn_DestroyInput( u, ErrStat2, ErrMsg2) - - + + END SUBROUTINE Conv_Rdtn_UpdateStates !---------------------------------------------------------------------------------------------------------------------------------- !> Routine for computing outputs, used in both loose and tight coupling. -SUBROUTINE Conv_Rdtn_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) +SUBROUTINE Conv_Rdtn_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) !.................................................................................................................................. - + REAL(DbKi), INTENT(IN ) :: Time !< Current simulation time in seconds TYPE(Conv_Rdtn_InputType), INTENT(IN ) :: u !< Inputs at Time TYPE(Conv_Rdtn_ParameterType), INTENT(IN ) :: p !< Parameters @@ -525,29 +491,29 @@ SUBROUTINE Conv_Rdtn_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, ErrStat TYPE(Conv_Rdtn_OtherStateType), INTENT(IN ) :: OtherState !< Other states at Time TYPE(Conv_Rdtn_OutputType), INTENT(INOUT) :: y !< Outputs computed at Time (Input only so that mesh con- !! nectivity information does not have to be recalculated) - TYPE(Conv_Rdtn_MiscVarType), INTENT(INOUT) :: m !< Initial misc/optimization variables + TYPE(Conv_Rdtn_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 - + ! REAL(ReKi) :: F_Rdtn (6) REAL(ReKi) :: F_RdtnDT (6*p%NBody) ! The portion of the total load contribution from wave radiation damping associated with the convolution integral proportional to ( RdtnDT - RdtnRmndr ) (N, N-m) - + INTEGER :: I ! Generic index INTEGER :: J ! Generic index INTEGER :: K ! Generic index - + INTEGER(IntKi) :: MaxInd ! Initialize ErrStat - - ErrStat = ErrID_None - ErrMsg = "" - - + + ErrStat = ErrID_None + ErrMsg = "" + + ! Perform numerical convolution to determine the load contribution from wave ! radiation damping: - + MaxInd = MIN(p%NStepRdtn-1,OtherState%IndRdtn) ! Note: xd%IndRdtn index is from the previous time-step since this state was for the previous time-step - + DO I = 1,6*p%NBody ! Loop through all wave radiation damping forces and moments F_RdtnDT (I) = 0.0 @@ -559,7 +525,7 @@ SUBROUTINE Conv_Rdtn_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, ErrStat - 0.5_SiKi * p%RdtnKrnl(0,I,J)*xd%XDHistory(MaxInd,J) DO K = 1, MaxInd-1 ! Loop through all remaining NStepRdtn-2 time steps in the radiation Kernel (less than NStepRdtn time steps are used when ZTime < RdtnTmax) F_RdtnDT(I) = F_RdtnDT(I) - p%RdtnKrnl(MaxInd-K,I,J)*xd%XDHistory(K,J) - END DO + END DO !DO K = MAX(0,xd%IndRdtn-p%NStepRdtn ),xd%IndRdtn-1 ! Loop through all NStepRdtn time steps in the radiation Kernel (less than NStepRdtn time steps are used when ZTime < RdtnTmax) ! F_RdtnDT (I) = F_RdtnDT (I) - p%RdtnKrnl(xd%IndRdtn-1-K,I,J)*xd%XDHistory(MOD(K,p%NStepRdtn1),J) !END DO ! K - All NStepRdtn time steps in the radiation Kernel (less than NStepRdtn time steps are used when ZTime < RdtnTmax) @@ -574,69 +540,68 @@ SUBROUTINE Conv_Rdtn_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, ErrStat END DO ! I - All wave radiation damping forces and moments - y%F_Rdtn = p%RdtnDT*F_RdtnDT !F_Rdtn + y%F_Rdtn = p%RdtnDT*F_RdtnDT !F_Rdtn END SUBROUTINE Conv_Rdtn_CalcOutput !---------------------------------------------------------------------------------------------------------------------------------- !> Tight coupling routine for computing derivatives of continuous states. -SUBROUTINE Conv_Rdtn_CalcContStateDeriv( Time, u, p, x, xd, z, OtherState, m, dxdt, ErrStat, ErrMsg ) +SUBROUTINE Conv_Rdtn_CalcContStateDeriv( Time, u, p, x, xd, z, OtherState, m, dxdt, ErrStat, ErrMsg ) !.................................................................................................................................. - + REAL(DbKi), INTENT(IN ) :: Time ! Current simulation time in seconds - TYPE(Conv_Rdtn_InputType), INTENT(IN ) :: u ! Inputs at Time - TYPE(Conv_Rdtn_ParameterType), INTENT(IN ) :: p ! Parameters + TYPE(Conv_Rdtn_InputType), INTENT(IN ) :: u ! Inputs at Time + TYPE(Conv_Rdtn_ParameterType), INTENT(IN ) :: p ! Parameters TYPE(Conv_Rdtn_ContinuousStateType), INTENT(IN ) :: x ! Continuous states at Time TYPE(Conv_Rdtn_DiscreteStateType), INTENT(IN ) :: xd ! Discrete states at Time TYPE(Conv_Rdtn_ConstraintStateType), INTENT(IN ) :: z ! Constraint states at Time - TYPE(Conv_Rdtn_OtherStateType), INTENT(IN ) :: OtherState ! Other states at Time - TYPE(Conv_Rdtn_MiscVarType), INTENT(INOUT) :: m ! Initial misc/optimization variables + TYPE(Conv_Rdtn_OtherStateType), INTENT(IN ) :: OtherState ! Other states at Time + TYPE(Conv_Rdtn_MiscVarType), INTENT(INOUT) :: m ! Initial misc/optimization variables TYPE(Conv_Rdtn_ContinuousStateType), INTENT( OUT) :: dxdt ! Continuous state derivatives at Time - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + 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 = "" - - + + ErrStat = ErrID_None + ErrMsg = "" + + ! Compute the first time derivatives of the continuous states here: - + dxdt%DummyContState = 0.0 - + END SUBROUTINE Conv_Rdtn_CalcContStateDeriv !---------------------------------------------------------------------------------------------------------------------------------- !> Tight coupling routine for updating discrete states. -SUBROUTINE Conv_Rdtn_UpdateDiscState( Time, n, u, p, x, xd, z, OtherState, m, ErrStat, ErrMsg ) +SUBROUTINE Conv_Rdtn_UpdateDiscState( Time, n, u, p, x, xd, z, OtherState, m, ErrStat, ErrMsg ) !.................................................................................................................................. - - REAL(DbKi), INTENT(IN ) :: Time !< Current simulation time in seconds + + REAL(DbKi), INTENT(IN ) :: Time !< Current simulation time in seconds INTEGER(IntKi), INTENT(IN ) :: n !< Current step of the simulation: t = n*Interval - TYPE(Conv_Rdtn_InputType), INTENT(IN ) :: u !< Inputs at Time - TYPE(Conv_Rdtn_ParameterType), INTENT(IN ) :: p !< Parameters + TYPE(Conv_Rdtn_InputType), INTENT(IN ) :: u !< Inputs at Time + TYPE(Conv_Rdtn_ParameterType), INTENT(IN ) :: p !< Parameters TYPE(Conv_Rdtn_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at Time - TYPE(Conv_Rdtn_DiscreteStateType), INTENT(INOUT) :: xd !< Input: Discrete states at Time; + TYPE(Conv_Rdtn_DiscreteStateType), INTENT(INOUT) :: xd !< Input: Discrete states at Time; !! Output: Discrete states at Time + Interval TYPE(Conv_Rdtn_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at Time TYPE(Conv_Rdtn_OtherStateType), INTENT(INOUT) :: OtherState !< Other states at Time (output: other states at Time + Interval) !! THIS (intent out) BREAKS THE FRAMEWORK (but we don't care at this level) - TYPE(Conv_Rdtn_MiscVarType), INTENT(INOUT) :: m !< Initial misc/optimization variables + TYPE(Conv_Rdtn_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 - REAL(ReKi) :: IncrmntUD ! Incremental change in UD over a single radiation time step (m/s, rad/s) REAL(ReKi) :: RdtnRmndr ! Fractional amount of the p%RdtnDT timestep INTEGER(IntKi) :: J ! Generic index INTEGER(IntKi) :: K ! Generic index - + ! Initialize ErrStat - - ErrStat = ErrID_None - ErrMsg = "" + + ErrStat = ErrID_None + ErrMsg = "" ! Find the index xd%IndRdtn, where RdtnTime(IndRdtn) is the largest value in @@ -651,7 +616,7 @@ SUBROUTINE Conv_Rdtn_UpdateDiscState( Time, n, u, p, x, xd, z, OtherState, m, Er ! This subroutine can only be called at integer multiples of p%RdtnDT, if RdtnRmdr > 0, then this requirement has been violated! IF (RdtnRmndr > EPSILON(0.0_ReKi) ) THEN - ErrStat = ErrID_FATAL + ErrStat = ErrID_FATAL ErrMsg = "Conv_Rdtn_UpdateDiscState() must be called at integer multiples of the radiation timestep." RETURN END IF @@ -667,14 +632,13 @@ SUBROUTINE Conv_Rdtn_UpdateDiscState( Time, n, u, p, x, xd, z, OtherState, m, Er ! with the newest values: ! NOTE: When IndRdtn > LastIndRdtn, IndRdtn will equal LastIndRdtn + 1 if DT <= RdtnDT; ! When IndRdtn > LastIndRdtn, IndRdtn will be greater than LastIndRdtn + 1 if DT > RdtnDT. - !BJJ: this needs a better check so that it is ALWAYS done (MATLAB/Simulink could possibly avoid this step by starting at Time>0, OR there may be some numerical issues where this is NOT EXACTLY zero) - - IF ( OtherState%IndRdtn < (p%NStepRdtn) ) THEN + + IF ( OtherState%IndRdtn < (p%NStepRdtn) ) THEN DO J = 1,6*p%NBody ! Loop through all platform DOFs xd%XDHistory(OtherState%IndRdtn,J) = u%Velocity(J) ! XDHistory was allocated as a zero-based array! END DO ! J - All platform DOFs ELSE - + ! Shift the stored history by one index DO K = 0,p%NStepRdtn-2 DO J = 1,6*p%NBody ! Loop through all DOFs @@ -689,35 +653,35 @@ SUBROUTINE Conv_Rdtn_UpdateDiscState( Time, n, u, p, x, xd, z, OtherState, m, Er END SUBROUTINE Conv_Rdtn_UpdateDiscState !---------------------------------------------------------------------------------------------------------------------------------- !> Tight coupling routine for solving for the residual of the constraint state equations. -SUBROUTINE Conv_Rdtn_CalcConstrStateResidual( Time, u, p, x, xd, z, OtherState, m, z_residual, ErrStat, ErrMsg ) +SUBROUTINE Conv_Rdtn_CalcConstrStateResidual( Time, u, p, x, xd, z, OtherState, m, z_residual, ErrStat, ErrMsg ) !.................................................................................................................................. - - REAL(DbKi), INTENT(IN ) :: Time !< Current simulation time in seconds - TYPE(Conv_Rdtn_InputType), INTENT(IN ) :: u !< Inputs at Time - TYPE(Conv_Rdtn_ParameterType), INTENT(IN ) :: p !< Parameters + + REAL(DbKi), INTENT(IN ) :: Time !< Current simulation time in seconds + TYPE(Conv_Rdtn_InputType), INTENT(IN ) :: u !< Inputs at Time + TYPE(Conv_Rdtn_ParameterType), INTENT(IN ) :: p !< Parameters TYPE(Conv_Rdtn_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at Time TYPE(Conv_Rdtn_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at Time TYPE(Conv_Rdtn_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at Time (possibly a guess) TYPE(Conv_Rdtn_OtherStateType), INTENT(INOUT) :: OtherState !< Other states at Time - TYPE(Conv_Rdtn_MiscVarType), INTENT(INOUT) :: m !< Initial misc/optimization variables - TYPE(Conv_Rdtn_ConstraintStateType), INTENT( OUT) :: z_residual !< Residual of the constraint state equations using - !! the input values described above + TYPE(Conv_Rdtn_MiscVarType), INTENT(INOUT) :: m !< Initial misc/optimization variables + TYPE(Conv_Rdtn_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 - + ! Initialize ErrStat - - ErrStat = ErrID_None - ErrMsg = "" - - + + ErrStat = ErrID_None + ErrMsg = "" + + ! Solve for the constraint states here: - + z_residual%DummyConstrState = 0 END SUBROUTINE Conv_Rdtn_CalcConstrStateResidual !---------------------------------------------------------------------------------------------------------------------------------- - + END MODULE Conv_Radiation !********************************************************************************************************************************** diff --git a/modules/hydrodyn/src/Conv_Radiation.txt b/modules/hydrodyn/src/Conv_Radiation.txt index e421042b54..711c028559 100644 --- a/modules/hydrodyn/src/Conv_Radiation.txt +++ b/modules/hydrodyn/src/Conv_Radiation.txt @@ -28,7 +28,6 @@ typedef ^ ^ SiKi typedef ^ ^ SiKi HdroDmpng {:}{:}{:} - - "" - typedef ^ ^ INTEGER NInpFreq - - - "" - typedef ^ ^ DbKi RdtnTMax - - - "" - -typedef ^ ^ INTEGER UnSum - - - "" - # # # Define outputs from the initialization routine here: diff --git a/modules/hydrodyn/src/Conv_Radiation_Types.f90 b/modules/hydrodyn/src/Conv_Radiation_Types.f90 index 4c69b4d103..4104c950b5 100644 --- a/modules/hydrodyn/src/Conv_Radiation_Types.f90 +++ b/modules/hydrodyn/src/Conv_Radiation_Types.f90 @@ -35,58 +35,57 @@ MODULE Conv_Radiation_Types IMPLICIT NONE ! ========= Conv_Rdtn_InitInputType ======= TYPE, PUBLIC :: Conv_Rdtn_InitInputType - REAL(DbKi) :: RdtnDT !< [-] + REAL(DbKi) :: RdtnDT = 0.0_R8Ki !< [-] CHARACTER(80) :: RdtnDTChr - INTEGER(IntKi) :: NBody !< [>=1; only used when PotMod=1. If NBodyMod=1, the WAMIT data contains a vector of size 6*NBody x 1 and matrices of size 6*NBody x 6*NBody; if NBodyMod>1, there are NBody sets of WAMIT data each with a vector of size 6 x 1 and matrices of size 6 x 6] [-] - REAL(ReKi) :: HighFreq !< [-] + INTEGER(IntKi) :: NBody = 0_IntKi !< [>=1; only used when PotMod=1. If NBodyMod=1, the WAMIT data contains a vector of size 6*NBody x 1 and matrices of size 6*NBody x 6*NBody; if NBodyMod>1, there are NBody sets of WAMIT data each with a vector of size 6 x 1 and matrices of size 6 x 6] [-] + REAL(ReKi) :: HighFreq = 0.0_ReKi !< [-] CHARACTER(1024) :: WAMITFile !< [-] REAL(SiKi) , DIMENSION(:,:,:), ALLOCATABLE :: HdroAddMs !< [-] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: HdroFreq !< [-] REAL(SiKi) , DIMENSION(:,:,:), ALLOCATABLE :: HdroDmpng !< [-] - INTEGER(IntKi) :: NInpFreq !< [-] - REAL(DbKi) :: RdtnTMax !< [-] - INTEGER(IntKi) :: UnSum !< [-] + INTEGER(IntKi) :: NInpFreq = 0_IntKi !< [-] + REAL(DbKi) :: RdtnTMax = 0.0_R8Ki !< [-] END TYPE Conv_Rdtn_InitInputType ! ======================= ! ========= Conv_Rdtn_InitOutputType ======= TYPE, PUBLIC :: Conv_Rdtn_InitOutputType - INTEGER(IntKi) :: DummyInitOut !< [-] + INTEGER(IntKi) :: DummyInitOut = 0_IntKi !< [-] END TYPE Conv_Rdtn_InitOutputType ! ======================= ! ========= Conv_Rdtn_ContinuousStateType ======= TYPE, PUBLIC :: Conv_Rdtn_ContinuousStateType - REAL(SiKi) :: DummyContState !< Remove this variable if you have continuous states [-] + REAL(SiKi) :: DummyContState = 0.0_R4Ki !< Remove this variable if you have continuous states [-] END TYPE Conv_Rdtn_ContinuousStateType ! ======================= ! ========= Conv_Rdtn_DiscreteStateType ======= TYPE, PUBLIC :: Conv_Rdtn_DiscreteStateType REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: XDHistory !< [-] - REAL(DbKi) :: LastTime !< [-] + REAL(DbKi) :: LastTime = 0.0_R8Ki !< [-] END TYPE Conv_Rdtn_DiscreteStateType ! ======================= ! ========= Conv_Rdtn_ConstraintStateType ======= TYPE, PUBLIC :: Conv_Rdtn_ConstraintStateType - REAL(SiKi) :: DummyConstrState !< Remove this variable if you have constraint states [-] + REAL(SiKi) :: DummyConstrState = 0.0_R4Ki !< Remove this variable if you have constraint states [-] END TYPE Conv_Rdtn_ConstraintStateType ! ======================= ! ========= Conv_Rdtn_OtherStateType ======= TYPE, PUBLIC :: Conv_Rdtn_OtherStateType - INTEGER(IntKi) :: IndRdtn !< [-] + INTEGER(IntKi) :: IndRdtn = 0_IntKi !< [-] END TYPE Conv_Rdtn_OtherStateType ! ======================= ! ========= Conv_Rdtn_MiscVarType ======= TYPE, PUBLIC :: Conv_Rdtn_MiscVarType - INTEGER(IntKi) :: LastIndRdtn !< [-] + INTEGER(IntKi) :: LastIndRdtn = 0_IntKi !< [-] END TYPE Conv_Rdtn_MiscVarType ! ======================= ! ========= Conv_Rdtn_ParameterType ======= TYPE, PUBLIC :: Conv_Rdtn_ParameterType - REAL(DbKi) :: DT !< Time step for continuous state integration & discrete state update [seconds] - REAL(DbKi) :: RdtnDT !< [-] - INTEGER(IntKi) :: NBody !< [>=1; only used when PotMod=1. If NBodyMod=1, the WAMIT data contains a vector of size 6*NBody x 1 and matrices of size 6*NBody x 6*NBody; if NBodyMod>1, there are NBody sets of WAMIT data each with a vector of size 6 x 1 and matrices of size 6 x 6] [-] + REAL(DbKi) :: DT = 0.0_R8Ki !< Time step for continuous state integration & discrete state update [seconds] + REAL(DbKi) :: RdtnDT = 0.0_R8Ki !< [-] + INTEGER(IntKi) :: NBody = 0_IntKi !< [>=1; only used when PotMod=1. If NBodyMod=1, the WAMIT data contains a vector of size 6*NBody x 1 and matrices of size 6*NBody x 6*NBody; if NBodyMod>1, there are NBody sets of WAMIT data each with a vector of size 6 x 1 and matrices of size 6 x 6] [-] REAL(SiKi) , DIMENSION(:,:,:), ALLOCATABLE :: RdtnKrnl !< [-] - INTEGER(IntKi) :: NStepRdtn !< [-] - INTEGER(IntKi) :: NStepRdtn1 !< [-] + INTEGER(IntKi) :: NStepRdtn = 0_IntKi !< [-] + INTEGER(IntKi) :: NStepRdtn1 = 0_IntKi !< [-] END TYPE Conv_Rdtn_ParameterType ! ======================= ! ========= Conv_Rdtn_InputType ======= @@ -100,1966 +99,608 @@ MODULE Conv_Radiation_Types END TYPE Conv_Rdtn_OutputType ! ======================= CONTAINS - SUBROUTINE Conv_Rdtn_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Conv_Rdtn_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(Conv_Rdtn_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 = 'Conv_Rdtn_CopyInitInput' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInitInputData%RdtnDT = SrcInitInputData%RdtnDT - DstInitInputData%RdtnDTChr = SrcInitInputData%RdtnDTChr - DstInitInputData%NBody = SrcInitInputData%NBody - DstInitInputData%HighFreq = SrcInitInputData%HighFreq - DstInitInputData%WAMITFile = SrcInitInputData%WAMITFile -IF (ALLOCATED(SrcInitInputData%HdroAddMs)) THEN - i1_l = LBOUND(SrcInitInputData%HdroAddMs,1) - i1_u = UBOUND(SrcInitInputData%HdroAddMs,1) - i2_l = LBOUND(SrcInitInputData%HdroAddMs,2) - i2_u = UBOUND(SrcInitInputData%HdroAddMs,2) - i3_l = LBOUND(SrcInitInputData%HdroAddMs,3) - i3_u = UBOUND(SrcInitInputData%HdroAddMs,3) - IF (.NOT. ALLOCATED(DstInitInputData%HdroAddMs)) THEN - ALLOCATE(DstInitInputData%HdroAddMs(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%HdroAddMs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%HdroAddMs = SrcInitInputData%HdroAddMs -ENDIF -IF (ALLOCATED(SrcInitInputData%HdroFreq)) THEN - i1_l = LBOUND(SrcInitInputData%HdroFreq,1) - i1_u = UBOUND(SrcInitInputData%HdroFreq,1) - IF (.NOT. ALLOCATED(DstInitInputData%HdroFreq)) THEN - ALLOCATE(DstInitInputData%HdroFreq(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%HdroFreq.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%HdroFreq = SrcInitInputData%HdroFreq -ENDIF -IF (ALLOCATED(SrcInitInputData%HdroDmpng)) THEN - i1_l = LBOUND(SrcInitInputData%HdroDmpng,1) - i1_u = UBOUND(SrcInitInputData%HdroDmpng,1) - i2_l = LBOUND(SrcInitInputData%HdroDmpng,2) - i2_u = UBOUND(SrcInitInputData%HdroDmpng,2) - i3_l = LBOUND(SrcInitInputData%HdroDmpng,3) - i3_u = UBOUND(SrcInitInputData%HdroDmpng,3) - IF (.NOT. ALLOCATED(DstInitInputData%HdroDmpng)) THEN - ALLOCATE(DstInitInputData%HdroDmpng(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%HdroDmpng.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%HdroDmpng = SrcInitInputData%HdroDmpng -ENDIF - DstInitInputData%NInpFreq = SrcInitInputData%NInpFreq - DstInitInputData%RdtnTMax = SrcInitInputData%RdtnTMax - DstInitInputData%UnSum = SrcInitInputData%UnSum - END SUBROUTINE Conv_Rdtn_CopyInitInput - - SUBROUTINE Conv_Rdtn_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(Conv_Rdtn_InitInputType), INTENT(INOUT) :: InitInputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_DestroyInitInput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(InitInputData%HdroAddMs)) THEN - DEALLOCATE(InitInputData%HdroAddMs) -ENDIF -IF (ALLOCATED(InitInputData%HdroFreq)) THEN - DEALLOCATE(InitInputData%HdroFreq) -ENDIF -IF (ALLOCATED(InitInputData%HdroDmpng)) THEN - DEALLOCATE(InitInputData%HdroDmpng) -ENDIF - END SUBROUTINE Conv_Rdtn_DestroyInitInput - - SUBROUTINE Conv_Rdtn_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(Conv_Rdtn_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 = 'Conv_Rdtn_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 - Db_BufSz = Db_BufSz + 1 ! RdtnDT - Int_BufSz = Int_BufSz + 1*LEN(InData%RdtnDTChr) ! RdtnDTChr - Int_BufSz = Int_BufSz + 1 ! NBody - Re_BufSz = Re_BufSz + 1 ! HighFreq - Int_BufSz = Int_BufSz + 1*LEN(InData%WAMITFile) ! WAMITFile - Int_BufSz = Int_BufSz + 1 ! HdroAddMs allocated yes/no - IF ( ALLOCATED(InData%HdroAddMs) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! HdroAddMs upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%HdroAddMs) ! HdroAddMs - END IF - Int_BufSz = Int_BufSz + 1 ! HdroFreq allocated yes/no - IF ( ALLOCATED(InData%HdroFreq) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! HdroFreq upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%HdroFreq) ! HdroFreq - END IF - Int_BufSz = Int_BufSz + 1 ! HdroDmpng allocated yes/no - IF ( ALLOCATED(InData%HdroDmpng) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! HdroDmpng upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%HdroDmpng) ! HdroDmpng - END IF - Int_BufSz = Int_BufSz + 1 ! NInpFreq - Db_BufSz = Db_BufSz + 1 ! RdtnTMax - Int_BufSz = Int_BufSz + 1 ! UnSum - 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%RdtnDT - Db_Xferred = Db_Xferred + 1 - DO I = 1, LEN(InData%RdtnDTChr) - IntKiBuf(Int_Xferred) = ICHAR(InData%RdtnDTChr(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = InData%NBody - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%HighFreq - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(InData%WAMITFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%WAMITFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IF ( .NOT. ALLOCATED(InData%HdroAddMs) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%HdroAddMs,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%HdroAddMs,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%HdroAddMs,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%HdroAddMs,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%HdroAddMs,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%HdroAddMs,3) - Int_Xferred = Int_Xferred + 2 - DO i3 = LBOUND(InData%HdroAddMs,3), UBOUND(InData%HdroAddMs,3) - DO i2 = LBOUND(InData%HdroAddMs,2), UBOUND(InData%HdroAddMs,2) - DO i1 = LBOUND(InData%HdroAddMs,1), UBOUND(InData%HdroAddMs,1) - ReKiBuf(Re_Xferred) = InData%HdroAddMs(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%HdroFreq) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%HdroFreq,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%HdroFreq,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%HdroFreq,1), UBOUND(InData%HdroFreq,1) - ReKiBuf(Re_Xferred) = InData%HdroFreq(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%HdroDmpng) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%HdroDmpng,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%HdroDmpng,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%HdroDmpng,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%HdroDmpng,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%HdroDmpng,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%HdroDmpng,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%HdroDmpng,3), UBOUND(InData%HdroDmpng,3) - DO i2 = LBOUND(InData%HdroDmpng,2), UBOUND(InData%HdroDmpng,2) - DO i1 = LBOUND(InData%HdroDmpng,1), UBOUND(InData%HdroDmpng,1) - ReKiBuf(Re_Xferred) = InData%HdroDmpng(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NInpFreq - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%RdtnTMax - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%UnSum - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Conv_Rdtn_PackInitInput - - SUBROUTINE Conv_Rdtn_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(Conv_Rdtn_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 = 'Conv_Rdtn_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%RdtnDT = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - DO I = 1, LEN(OutData%RdtnDTChr) - OutData%RdtnDTChr(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%NBody = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%HighFreq = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(OutData%WAMITFile) - OutData%WAMITFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! HdroAddMs not allocated - Int_Xferred = Int_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%HdroAddMs)) DEALLOCATE(OutData%HdroAddMs) - ALLOCATE(OutData%HdroAddMs(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%HdroAddMs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%HdroAddMs,3), UBOUND(OutData%HdroAddMs,3) - DO i2 = LBOUND(OutData%HdroAddMs,2), UBOUND(OutData%HdroAddMs,2) - DO i1 = LBOUND(OutData%HdroAddMs,1), UBOUND(OutData%HdroAddMs,1) - OutData%HdroAddMs(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! HdroFreq not allocated - Int_Xferred = Int_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%HdroFreq)) DEALLOCATE(OutData%HdroFreq) - ALLOCATE(OutData%HdroFreq(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%HdroFreq.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%HdroFreq,1), UBOUND(OutData%HdroFreq,1) - OutData%HdroFreq(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! HdroDmpng not allocated - Int_Xferred = Int_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%HdroDmpng)) DEALLOCATE(OutData%HdroDmpng) - ALLOCATE(OutData%HdroDmpng(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%HdroDmpng.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%HdroDmpng,3), UBOUND(OutData%HdroDmpng,3) - DO i2 = LBOUND(OutData%HdroDmpng,2), UBOUND(OutData%HdroDmpng,2) - DO i1 = LBOUND(OutData%HdroDmpng,1), UBOUND(OutData%HdroDmpng,1) - OutData%HdroDmpng(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - OutData%NInpFreq = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%RdtnTMax = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%UnSum = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Conv_Rdtn_UnPackInitInput - - SUBROUTINE Conv_Rdtn_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Conv_Rdtn_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(Conv_Rdtn_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 = 'Conv_Rdtn_CopyInitOutput' -! +subroutine Conv_Rdtn_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) + type(Conv_Rdtn_InitInputType), intent(in) :: SrcInitInputData + type(Conv_Rdtn_InitInputType), intent(inout) :: DstInitInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'Conv_Rdtn_CopyInitInput' ErrStat = ErrID_None - ErrMsg = "" - DstInitOutputData%DummyInitOut = SrcInitOutputData%DummyInitOut - END SUBROUTINE Conv_Rdtn_CopyInitOutput - - SUBROUTINE Conv_Rdtn_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(Conv_Rdtn_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_DestroyInitOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE Conv_Rdtn_DestroyInitOutput - - SUBROUTINE Conv_Rdtn_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(Conv_Rdtn_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 = 'Conv_Rdtn_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 ! 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 - - IntKiBuf(Int_Xferred) = InData%DummyInitOut - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Conv_Rdtn_PackInitOutput - - SUBROUTINE Conv_Rdtn_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(Conv_Rdtn_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 = 'Conv_Rdtn_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 = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Conv_Rdtn_UnPackInitOutput - - SUBROUTINE Conv_Rdtn_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Conv_Rdtn_ContinuousStateType), INTENT(IN) :: SrcContStateData - TYPE(Conv_Rdtn_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 = 'Conv_Rdtn_CopyContState' -! + ErrMsg = '' + DstInitInputData%RdtnDT = SrcInitInputData%RdtnDT + DstInitInputData%RdtnDTChr = SrcInitInputData%RdtnDTChr + DstInitInputData%NBody = SrcInitInputData%NBody + DstInitInputData%HighFreq = SrcInitInputData%HighFreq + DstInitInputData%WAMITFile = SrcInitInputData%WAMITFile + if (allocated(SrcInitInputData%HdroAddMs)) then + LB(1:3) = lbound(SrcInitInputData%HdroAddMs) + UB(1:3) = ubound(SrcInitInputData%HdroAddMs) + if (.not. allocated(DstInitInputData%HdroAddMs)) then + allocate(DstInitInputData%HdroAddMs(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%HdroAddMs.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%HdroAddMs = SrcInitInputData%HdroAddMs + end if + if (allocated(SrcInitInputData%HdroFreq)) then + LB(1:1) = lbound(SrcInitInputData%HdroFreq) + UB(1:1) = ubound(SrcInitInputData%HdroFreq) + if (.not. allocated(DstInitInputData%HdroFreq)) then + allocate(DstInitInputData%HdroFreq(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%HdroFreq.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%HdroFreq = SrcInitInputData%HdroFreq + end if + if (allocated(SrcInitInputData%HdroDmpng)) then + LB(1:3) = lbound(SrcInitInputData%HdroDmpng) + UB(1:3) = ubound(SrcInitInputData%HdroDmpng) + if (.not. allocated(DstInitInputData%HdroDmpng)) then + allocate(DstInitInputData%HdroDmpng(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%HdroDmpng.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%HdroDmpng = SrcInitInputData%HdroDmpng + end if + DstInitInputData%NInpFreq = SrcInitInputData%NInpFreq + DstInitInputData%RdtnTMax = SrcInitInputData%RdtnTMax +end subroutine + +subroutine Conv_Rdtn_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(Conv_Rdtn_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Conv_Rdtn_DestroyInitInput' ErrStat = ErrID_None - ErrMsg = "" - DstContStateData%DummyContState = SrcContStateData%DummyContState - END SUBROUTINE Conv_Rdtn_CopyContState - - SUBROUTINE Conv_Rdtn_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(Conv_Rdtn_ContinuousStateType), INTENT(INOUT) :: ContStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_DestroyContState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE Conv_Rdtn_DestroyContState - - SUBROUTINE Conv_Rdtn_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(Conv_Rdtn_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 = 'Conv_Rdtn_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 Conv_Rdtn_PackContState - - SUBROUTINE Conv_Rdtn_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(Conv_Rdtn_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 = 'Conv_Rdtn_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 = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Conv_Rdtn_UnPackContState - - SUBROUTINE Conv_Rdtn_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Conv_Rdtn_DiscreteStateType), INTENT(IN) :: SrcDiscStateData - TYPE(Conv_Rdtn_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 = 'Conv_Rdtn_CopyDiscState' -! + ErrMsg = '' + if (allocated(InitInputData%HdroAddMs)) then + deallocate(InitInputData%HdroAddMs) + end if + if (allocated(InitInputData%HdroFreq)) then + deallocate(InitInputData%HdroFreq) + end if + if (allocated(InitInputData%HdroDmpng)) then + deallocate(InitInputData%HdroDmpng) + end if +end subroutine + +subroutine Conv_Rdtn_PackInitInput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Conv_Rdtn_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Conv_Rdtn_PackInitInput' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%RdtnDT) + call RegPack(RF, InData%RdtnDTChr) + call RegPack(RF, InData%NBody) + call RegPack(RF, InData%HighFreq) + call RegPack(RF, InData%WAMITFile) + call RegPackAlloc(RF, InData%HdroAddMs) + call RegPackAlloc(RF, InData%HdroFreq) + call RegPackAlloc(RF, InData%HdroDmpng) + call RegPack(RF, InData%NInpFreq) + call RegPack(RF, InData%RdtnTMax) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Conv_Rdtn_UnPackInitInput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Conv_Rdtn_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Conv_Rdtn_UnPackInitInput' + integer(B4Ki) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%RdtnDT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RdtnDTChr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NBody); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HighFreq); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WAMITFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%HdroAddMs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%HdroFreq); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%HdroDmpng); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NInpFreq); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RdtnTMax); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Conv_Rdtn_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) + type(Conv_Rdtn_InitOutputType), intent(in) :: SrcInitOutputData + type(Conv_Rdtn_InitOutputType), intent(inout) :: DstInitOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Conv_Rdtn_CopyInitOutput' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcDiscStateData%XDHistory)) THEN - i1_l = LBOUND(SrcDiscStateData%XDHistory,1) - i1_u = UBOUND(SrcDiscStateData%XDHistory,1) - i2_l = LBOUND(SrcDiscStateData%XDHistory,2) - i2_u = UBOUND(SrcDiscStateData%XDHistory,2) - IF (.NOT. ALLOCATED(DstDiscStateData%XDHistory)) THEN - ALLOCATE(DstDiscStateData%XDHistory(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%XDHistory.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%XDHistory = SrcDiscStateData%XDHistory -ENDIF - DstDiscStateData%LastTime = SrcDiscStateData%LastTime - END SUBROUTINE Conv_Rdtn_CopyDiscState - - SUBROUTINE Conv_Rdtn_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(Conv_Rdtn_DiscreteStateType), INTENT(INOUT) :: DiscStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_DestroyDiscState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(DiscStateData%XDHistory)) THEN - DEALLOCATE(DiscStateData%XDHistory) -ENDIF - END SUBROUTINE Conv_Rdtn_DestroyDiscState - - SUBROUTINE Conv_Rdtn_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(Conv_Rdtn_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 = 'Conv_Rdtn_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 ! XDHistory allocated yes/no - IF ( ALLOCATED(InData%XDHistory) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! XDHistory upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%XDHistory) ! XDHistory - END IF - Db_BufSz = Db_BufSz + 1 ! LastTime - 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%XDHistory) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%XDHistory,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%XDHistory,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%XDHistory,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%XDHistory,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%XDHistory,2), UBOUND(InData%XDHistory,2) - DO i1 = LBOUND(InData%XDHistory,1), UBOUND(InData%XDHistory,1) - ReKiBuf(Re_Xferred) = InData%XDHistory(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - DbKiBuf(Db_Xferred) = InData%LastTime - Db_Xferred = Db_Xferred + 1 - END SUBROUTINE Conv_Rdtn_PackDiscState - - SUBROUTINE Conv_Rdtn_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(Conv_Rdtn_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 = 'Conv_Rdtn_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 ! XDHistory not allocated - Int_Xferred = Int_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%XDHistory)) DEALLOCATE(OutData%XDHistory) - ALLOCATE(OutData%XDHistory(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%XDHistory.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%XDHistory,2), UBOUND(OutData%XDHistory,2) - DO i1 = LBOUND(OutData%XDHistory,1), UBOUND(OutData%XDHistory,1) - OutData%XDHistory(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%LastTime = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END SUBROUTINE Conv_Rdtn_UnPackDiscState - - SUBROUTINE Conv_Rdtn_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Conv_Rdtn_ConstraintStateType), INTENT(IN) :: SrcConstrStateData - TYPE(Conv_Rdtn_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 = 'Conv_Rdtn_CopyConstrState' -! + ErrMsg = '' + DstInitOutputData%DummyInitOut = SrcInitOutputData%DummyInitOut +end subroutine + +subroutine Conv_Rdtn_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(Conv_Rdtn_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Conv_Rdtn_DestroyInitOutput' ErrStat = ErrID_None - ErrMsg = "" - DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState - END SUBROUTINE Conv_Rdtn_CopyConstrState - - SUBROUTINE Conv_Rdtn_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(Conv_Rdtn_ConstraintStateType), INTENT(INOUT) :: ConstrStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_DestroyConstrState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE Conv_Rdtn_DestroyConstrState - - SUBROUTINE Conv_Rdtn_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(Conv_Rdtn_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 = 'Conv_Rdtn_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 Conv_Rdtn_PackConstrState - - SUBROUTINE Conv_Rdtn_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(Conv_Rdtn_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 = 'Conv_Rdtn_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 = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Conv_Rdtn_UnPackConstrState - - SUBROUTINE Conv_Rdtn_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Conv_Rdtn_OtherStateType), INTENT(IN) :: SrcOtherStateData - TYPE(Conv_Rdtn_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 = 'Conv_Rdtn_CopyOtherState' -! + ErrMsg = '' +end subroutine + +subroutine Conv_Rdtn_PackInitOutput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Conv_Rdtn_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Conv_Rdtn_PackInitOutput' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyInitOut) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Conv_Rdtn_UnPackInitOutput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Conv_Rdtn_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Conv_Rdtn_UnPackInitOutput' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyInitOut); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Conv_Rdtn_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) + type(Conv_Rdtn_ContinuousStateType), intent(in) :: SrcContStateData + type(Conv_Rdtn_ContinuousStateType), intent(inout) :: DstContStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Conv_Rdtn_CopyContState' ErrStat = ErrID_None - ErrMsg = "" - DstOtherStateData%IndRdtn = SrcOtherStateData%IndRdtn - END SUBROUTINE Conv_Rdtn_CopyOtherState - - SUBROUTINE Conv_Rdtn_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(Conv_Rdtn_OtherStateType), INTENT(INOUT) :: OtherStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_DestroyOtherState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE Conv_Rdtn_DestroyOtherState - - SUBROUTINE Conv_Rdtn_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(Conv_Rdtn_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 = 'Conv_Rdtn_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 ! IndRdtn - 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%IndRdtn - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Conv_Rdtn_PackOtherState - - SUBROUTINE Conv_Rdtn_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(Conv_Rdtn_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 = 'Conv_Rdtn_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%IndRdtn = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Conv_Rdtn_UnPackOtherState - - SUBROUTINE Conv_Rdtn_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Conv_Rdtn_MiscVarType), INTENT(IN) :: SrcMiscData - TYPE(Conv_Rdtn_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 = 'Conv_Rdtn_CopyMisc' -! + ErrMsg = '' + DstContStateData%DummyContState = SrcContStateData%DummyContState +end subroutine + +subroutine Conv_Rdtn_DestroyContState(ContStateData, ErrStat, ErrMsg) + type(Conv_Rdtn_ContinuousStateType), intent(inout) :: ContStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Conv_Rdtn_DestroyContState' ErrStat = ErrID_None - ErrMsg = "" - DstMiscData%LastIndRdtn = SrcMiscData%LastIndRdtn - END SUBROUTINE Conv_Rdtn_CopyMisc - - SUBROUTINE Conv_Rdtn_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(Conv_Rdtn_MiscVarType), INTENT(INOUT) :: MiscData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_DestroyMisc' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE Conv_Rdtn_DestroyMisc - - SUBROUTINE Conv_Rdtn_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(Conv_Rdtn_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 = 'Conv_Rdtn_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 ! LastIndRdtn - 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%LastIndRdtn - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Conv_Rdtn_PackMisc - - SUBROUTINE Conv_Rdtn_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(Conv_Rdtn_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 = 'Conv_Rdtn_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%LastIndRdtn = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Conv_Rdtn_UnPackMisc - - SUBROUTINE Conv_Rdtn_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Conv_Rdtn_ParameterType), INTENT(IN) :: SrcParamData - TYPE(Conv_Rdtn_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) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_CopyParam' -! + ErrMsg = '' +end subroutine + +subroutine Conv_Rdtn_PackContState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Conv_Rdtn_ContinuousStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Conv_Rdtn_PackContState' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyContState) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Conv_Rdtn_UnPackContState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Conv_Rdtn_ContinuousStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Conv_Rdtn_UnPackContState' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyContState); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Conv_Rdtn_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) + type(Conv_Rdtn_DiscreteStateType), intent(in) :: SrcDiscStateData + type(Conv_Rdtn_DiscreteStateType), intent(inout) :: DstDiscStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'Conv_Rdtn_CopyDiscState' ErrStat = ErrID_None - ErrMsg = "" - DstParamData%DT = SrcParamData%DT - DstParamData%RdtnDT = SrcParamData%RdtnDT - DstParamData%NBody = SrcParamData%NBody -IF (ALLOCATED(SrcParamData%RdtnKrnl)) THEN - i1_l = LBOUND(SrcParamData%RdtnKrnl,1) - i1_u = UBOUND(SrcParamData%RdtnKrnl,1) - i2_l = LBOUND(SrcParamData%RdtnKrnl,2) - i2_u = UBOUND(SrcParamData%RdtnKrnl,2) - i3_l = LBOUND(SrcParamData%RdtnKrnl,3) - i3_u = UBOUND(SrcParamData%RdtnKrnl,3) - IF (.NOT. ALLOCATED(DstParamData%RdtnKrnl)) THEN - ALLOCATE(DstParamData%RdtnKrnl(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%RdtnKrnl.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%RdtnKrnl = SrcParamData%RdtnKrnl -ENDIF - DstParamData%NStepRdtn = SrcParamData%NStepRdtn - DstParamData%NStepRdtn1 = SrcParamData%NStepRdtn1 - END SUBROUTINE Conv_Rdtn_CopyParam - - SUBROUTINE Conv_Rdtn_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(Conv_Rdtn_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(ParamData%RdtnKrnl)) THEN - DEALLOCATE(ParamData%RdtnKrnl) -ENDIF - END SUBROUTINE Conv_Rdtn_DestroyParam - - SUBROUTINE Conv_Rdtn_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(Conv_Rdtn_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 = 'Conv_Rdtn_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 ! RdtnDT - Int_BufSz = Int_BufSz + 1 ! NBody - Int_BufSz = Int_BufSz + 1 ! RdtnKrnl allocated yes/no - IF ( ALLOCATED(InData%RdtnKrnl) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! RdtnKrnl upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%RdtnKrnl) ! RdtnKrnl - END IF - Int_BufSz = Int_BufSz + 1 ! NStepRdtn - Int_BufSz = Int_BufSz + 1 ! NStepRdtn1 - 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%RdtnDT - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NBody - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%RdtnKrnl) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RdtnKrnl,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RdtnKrnl,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RdtnKrnl,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RdtnKrnl,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RdtnKrnl,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RdtnKrnl,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%RdtnKrnl,3), UBOUND(InData%RdtnKrnl,3) - DO i2 = LBOUND(InData%RdtnKrnl,2), UBOUND(InData%RdtnKrnl,2) - DO i1 = LBOUND(InData%RdtnKrnl,1), UBOUND(InData%RdtnKrnl,1) - ReKiBuf(Re_Xferred) = InData%RdtnKrnl(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NStepRdtn - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NStepRdtn1 - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Conv_Rdtn_PackParam - - SUBROUTINE Conv_Rdtn_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(Conv_Rdtn_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) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_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%RdtnDT = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%NBody = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RdtnKrnl not allocated - Int_Xferred = Int_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%RdtnKrnl)) DEALLOCATE(OutData%RdtnKrnl) - ALLOCATE(OutData%RdtnKrnl(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%RdtnKrnl.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%RdtnKrnl,3), UBOUND(OutData%RdtnKrnl,3) - DO i2 = LBOUND(OutData%RdtnKrnl,2), UBOUND(OutData%RdtnKrnl,2) - DO i1 = LBOUND(OutData%RdtnKrnl,1), UBOUND(OutData%RdtnKrnl,1) - OutData%RdtnKrnl(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - OutData%NStepRdtn = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NStepRdtn1 = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Conv_Rdtn_UnPackParam - - SUBROUTINE Conv_Rdtn_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Conv_Rdtn_InputType), INTENT(IN) :: SrcInputData - TYPE(Conv_Rdtn_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 = 'Conv_Rdtn_CopyInput' -! + ErrMsg = '' + if (allocated(SrcDiscStateData%XDHistory)) then + LB(1:2) = lbound(SrcDiscStateData%XDHistory) + UB(1:2) = ubound(SrcDiscStateData%XDHistory) + if (.not. allocated(DstDiscStateData%XDHistory)) then + allocate(DstDiscStateData%XDHistory(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%XDHistory.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%XDHistory = SrcDiscStateData%XDHistory + end if + DstDiscStateData%LastTime = SrcDiscStateData%LastTime +end subroutine + +subroutine Conv_Rdtn_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) + type(Conv_Rdtn_DiscreteStateType), intent(inout) :: DiscStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Conv_Rdtn_DestroyDiscState' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcInputData%Velocity)) THEN - i1_l = LBOUND(SrcInputData%Velocity,1) - i1_u = UBOUND(SrcInputData%Velocity,1) - IF (.NOT. ALLOCATED(DstInputData%Velocity)) THEN - ALLOCATE(DstInputData%Velocity(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%Velocity.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%Velocity = SrcInputData%Velocity -ENDIF - END SUBROUTINE Conv_Rdtn_CopyInput - - SUBROUTINE Conv_Rdtn_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(Conv_Rdtn_InputType), INTENT(INOUT) :: InputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_DestroyInput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(InputData%Velocity)) THEN - DEALLOCATE(InputData%Velocity) -ENDIF - END SUBROUTINE Conv_Rdtn_DestroyInput - - SUBROUTINE Conv_Rdtn_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(Conv_Rdtn_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 = 'Conv_Rdtn_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 ! Velocity allocated yes/no - IF ( ALLOCATED(InData%Velocity) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Velocity upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Velocity) ! Velocity - 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%Velocity) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Velocity,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Velocity,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Velocity,1), UBOUND(InData%Velocity,1) - ReKiBuf(Re_Xferred) = InData%Velocity(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE Conv_Rdtn_PackInput - - SUBROUTINE Conv_Rdtn_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(Conv_Rdtn_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 = 'Conv_Rdtn_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 ! Velocity not allocated - Int_Xferred = Int_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%Velocity)) DEALLOCATE(OutData%Velocity) - ALLOCATE(OutData%Velocity(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Velocity.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Velocity,1), UBOUND(OutData%Velocity,1) - OutData%Velocity(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE Conv_Rdtn_UnPackInput - - SUBROUTINE Conv_Rdtn_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Conv_Rdtn_OutputType), INTENT(IN) :: SrcOutputData - TYPE(Conv_Rdtn_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 = 'Conv_Rdtn_CopyOutput' -! + ErrMsg = '' + if (allocated(DiscStateData%XDHistory)) then + deallocate(DiscStateData%XDHistory) + end if +end subroutine + +subroutine Conv_Rdtn_PackDiscState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Conv_Rdtn_DiscreteStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Conv_Rdtn_PackDiscState' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%XDHistory) + call RegPack(RF, InData%LastTime) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Conv_Rdtn_UnPackDiscState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Conv_Rdtn_DiscreteStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Conv_Rdtn_UnPackDiscState' + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%XDHistory); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LastTime); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Conv_Rdtn_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) + type(Conv_Rdtn_ConstraintStateType), intent(in) :: SrcConstrStateData + type(Conv_Rdtn_ConstraintStateType), intent(inout) :: DstConstrStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Conv_Rdtn_CopyConstrState' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcOutputData%F_Rdtn)) THEN - i1_l = LBOUND(SrcOutputData%F_Rdtn,1) - i1_u = UBOUND(SrcOutputData%F_Rdtn,1) - IF (.NOT. ALLOCATED(DstOutputData%F_Rdtn)) THEN - ALLOCATE(DstOutputData%F_Rdtn(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%F_Rdtn.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%F_Rdtn = SrcOutputData%F_Rdtn -ENDIF - END SUBROUTINE Conv_Rdtn_CopyOutput - - SUBROUTINE Conv_Rdtn_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(Conv_Rdtn_OutputType), INTENT(INOUT) :: OutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_DestroyOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(OutputData%F_Rdtn)) THEN - DEALLOCATE(OutputData%F_Rdtn) -ENDIF - END SUBROUTINE Conv_Rdtn_DestroyOutput - - SUBROUTINE Conv_Rdtn_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(Conv_Rdtn_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 = 'Conv_Rdtn_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 ! F_Rdtn allocated yes/no - IF ( ALLOCATED(InData%F_Rdtn) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! F_Rdtn upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_Rdtn) ! F_Rdtn - 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%F_Rdtn) ) THEN - 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_Rdtn,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_Rdtn,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%F_Rdtn,1), UBOUND(InData%F_Rdtn,1) - ReKiBuf(Re_Xferred) = InData%F_Rdtn(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE Conv_Rdtn_PackOutput - - SUBROUTINE Conv_Rdtn_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(Conv_Rdtn_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 = 'Conv_Rdtn_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 ! F_Rdtn not allocated - Int_Xferred = Int_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_Rdtn)) DEALLOCATE(OutData%F_Rdtn) - ALLOCATE(OutData%F_Rdtn(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_Rdtn.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%F_Rdtn,1), UBOUND(OutData%F_Rdtn,1) - OutData%F_Rdtn(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE Conv_Rdtn_UnPackOutput - - - SUBROUTINE Conv_Rdtn_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(Conv_Rdtn_InputType), INTENT(IN) :: u(:) ! Input at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Inputs - TYPE(Conv_Rdtn_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 + ErrMsg = '' + DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState +end subroutine + +subroutine Conv_Rdtn_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) + type(Conv_Rdtn_ConstraintStateType), intent(inout) :: ConstrStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Conv_Rdtn_DestroyConstrState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine Conv_Rdtn_PackConstrState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Conv_Rdtn_ConstraintStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Conv_Rdtn_PackConstrState' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyConstrState) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Conv_Rdtn_UnPackConstrState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Conv_Rdtn_ConstraintStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Conv_Rdtn_UnPackConstrState' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyConstrState); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Conv_Rdtn_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) + type(Conv_Rdtn_OtherStateType), intent(in) :: SrcOtherStateData + type(Conv_Rdtn_OtherStateType), intent(inout) :: DstOtherStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Conv_Rdtn_CopyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + DstOtherStateData%IndRdtn = SrcOtherStateData%IndRdtn +end subroutine + +subroutine Conv_Rdtn_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) + type(Conv_Rdtn_OtherStateType), intent(inout) :: OtherStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Conv_Rdtn_DestroyOtherState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine Conv_Rdtn_PackOtherState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Conv_Rdtn_OtherStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Conv_Rdtn_PackOtherState' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%IndRdtn) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Conv_Rdtn_UnPackOtherState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Conv_Rdtn_OtherStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Conv_Rdtn_UnPackOtherState' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%IndRdtn); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Conv_Rdtn_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(Conv_Rdtn_MiscVarType), intent(in) :: SrcMiscData + type(Conv_Rdtn_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Conv_Rdtn_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + DstMiscData%LastIndRdtn = SrcMiscData%LastIndRdtn +end subroutine + +subroutine Conv_Rdtn_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(Conv_Rdtn_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Conv_Rdtn_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine Conv_Rdtn_PackMisc(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Conv_Rdtn_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Conv_Rdtn_PackMisc' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%LastIndRdtn) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Conv_Rdtn_UnPackMisc(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Conv_Rdtn_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Conv_Rdtn_UnPackMisc' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%LastIndRdtn); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Conv_Rdtn_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(Conv_Rdtn_ParameterType), intent(in) :: SrcParamData + type(Conv_Rdtn_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'Conv_Rdtn_CopyParam' + ErrStat = ErrID_None + ErrMsg = '' + DstParamData%DT = SrcParamData%DT + DstParamData%RdtnDT = SrcParamData%RdtnDT + DstParamData%NBody = SrcParamData%NBody + if (allocated(SrcParamData%RdtnKrnl)) then + LB(1:3) = lbound(SrcParamData%RdtnKrnl) + UB(1:3) = ubound(SrcParamData%RdtnKrnl) + if (.not. allocated(DstParamData%RdtnKrnl)) then + allocate(DstParamData%RdtnKrnl(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%RdtnKrnl.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%RdtnKrnl = SrcParamData%RdtnKrnl + end if + DstParamData%NStepRdtn = SrcParamData%NStepRdtn + DstParamData%NStepRdtn1 = SrcParamData%NStepRdtn1 +end subroutine + +subroutine Conv_Rdtn_DestroyParam(ParamData, ErrStat, ErrMsg) + type(Conv_Rdtn_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Conv_Rdtn_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ParamData%RdtnKrnl)) then + deallocate(ParamData%RdtnKrnl) + end if +end subroutine + +subroutine Conv_Rdtn_PackParam(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Conv_Rdtn_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Conv_Rdtn_PackParam' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DT) + call RegPack(RF, InData%RdtnDT) + call RegPack(RF, InData%NBody) + call RegPackAlloc(RF, InData%RdtnKrnl) + call RegPack(RF, InData%NStepRdtn) + call RegPack(RF, InData%NStepRdtn1) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Conv_Rdtn_UnPackParam(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Conv_Rdtn_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Conv_Rdtn_UnPackParam' + integer(B4Ki) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RdtnDT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NBody); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%RdtnKrnl); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NStepRdtn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NStepRdtn1); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Conv_Rdtn_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) + type(Conv_Rdtn_InputType), intent(in) :: SrcInputData + type(Conv_Rdtn_InputType), intent(inout) :: DstInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'Conv_Rdtn_CopyInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcInputData%Velocity)) then + LB(1:1) = lbound(SrcInputData%Velocity) + UB(1:1) = ubound(SrcInputData%Velocity) + if (.not. allocated(DstInputData%Velocity)) then + allocate(DstInputData%Velocity(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%Velocity.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%Velocity = SrcInputData%Velocity + end if +end subroutine + +subroutine Conv_Rdtn_DestroyInput(InputData, ErrStat, ErrMsg) + type(Conv_Rdtn_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Conv_Rdtn_DestroyInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InputData%Velocity)) then + deallocate(InputData%Velocity) + end if +end subroutine + +subroutine Conv_Rdtn_PackInput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Conv_Rdtn_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Conv_Rdtn_PackInput' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%Velocity) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Conv_Rdtn_UnPackInput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Conv_Rdtn_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Conv_Rdtn_UnPackInput' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%Velocity); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Conv_Rdtn_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(Conv_Rdtn_OutputType), intent(in) :: SrcOutputData + type(Conv_Rdtn_OutputType), intent(inout) :: DstOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'Conv_Rdtn_CopyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcOutputData%F_Rdtn)) then + LB(1:1) = lbound(SrcOutputData%F_Rdtn) + UB(1:1) = ubound(SrcOutputData%F_Rdtn) + if (.not. allocated(DstOutputData%F_Rdtn)) then + allocate(DstOutputData%F_Rdtn(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%F_Rdtn.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%F_Rdtn = SrcOutputData%F_Rdtn + end if +end subroutine + +subroutine Conv_Rdtn_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(Conv_Rdtn_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Conv_Rdtn_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OutputData%F_Rdtn)) then + deallocate(OutputData%F_Rdtn) + end if +end subroutine + +subroutine Conv_Rdtn_PackOutput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Conv_Rdtn_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Conv_Rdtn_PackOutput' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%F_Rdtn) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Conv_Rdtn_UnPackOutput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Conv_Rdtn_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Conv_Rdtn_UnPackOutput' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%F_Rdtn); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Conv_Rdtn_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(Conv_Rdtn_InputType), intent(in) :: u(:) ! Input at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Inputs + type(Conv_Rdtn_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 = 'Conv_Rdtn_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 Conv_Rdtn_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL Conv_Rdtn_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 Conv_Rdtn_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 Conv_Rdtn_Input_ExtrapInterp - - - SUBROUTINE Conv_Rdtn_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'Conv_Rdtn_Input_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(u)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(u)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(u) - 1 + select case (order) + case (0) + call Conv_Rdtn_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call Conv_Rdtn_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call Conv_Rdtn_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(u) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE Conv_Rdtn_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. @@ -2071,47 +712,45 @@ SUBROUTINE Conv_Rdtn_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, E ! !.................................................................................................................................. - TYPE(Conv_Rdtn_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 - TYPE(Conv_Rdtn_InputType), INTENT(IN) :: u2 ! Input at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs - TYPE(Conv_Rdtn_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 + TYPE(Conv_Rdtn_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 + TYPE(Conv_Rdtn_InputType), INTENT(IN) :: u2 ! Input at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs + TYPE(Conv_Rdtn_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 = 'Conv_Rdtn_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 + REAL(DbKi) :: t(2) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_Input_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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%Velocity) .AND. ALLOCATED(u1%Velocity)) THEN - DO i1 = LBOUND(u_out%Velocity,1),UBOUND(u_out%Velocity,1) - b = -(u1%Velocity(i1) - u2%Velocity(i1)) - u_out%Velocity(i1) = u1%Velocity(i1) + b * ScaleFactor - END DO -END IF ! check if allocated - END SUBROUTINE Conv_Rdtn_Input_ExtrapInterp1 - - - SUBROUTINE Conv_Rdtn_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + IF (ALLOCATED(u_out%Velocity) .AND. ALLOCATED(u1%Velocity)) THEN + u_out%Velocity = a1*u1%Velocity + a2*u2%Velocity + END IF ! check if allocated +END SUBROUTINE + +SUBROUTINE Conv_Rdtn_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. @@ -2125,108 +764,105 @@ SUBROUTINE Conv_Rdtn_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrSta ! !.................................................................................................................................. - TYPE(Conv_Rdtn_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 > t3 - TYPE(Conv_Rdtn_InputType), INTENT(IN) :: u2 ! Input at t2 > t3 - TYPE(Conv_Rdtn_InputType), INTENT(IN) :: u3 ! Input at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs - TYPE(Conv_Rdtn_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 + TYPE(Conv_Rdtn_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 > t3 + TYPE(Conv_Rdtn_InputType), INTENT(IN) :: u2 ! Input at t2 > t3 + TYPE(Conv_Rdtn_InputType), INTENT(IN) :: u3 ! Input at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs + TYPE(Conv_Rdtn_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 = 'Conv_Rdtn_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) - + 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) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_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 + 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 + 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 + 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%Velocity) .AND. ALLOCATED(u1%Velocity)) THEN - DO i1 = LBOUND(u_out%Velocity,1),UBOUND(u_out%Velocity,1) - b = (t(3)**2*(u1%Velocity(i1) - u2%Velocity(i1)) + t(2)**2*(-u1%Velocity(i1) + u3%Velocity(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%Velocity(i1) + t(3)*u2%Velocity(i1) - t(2)*u3%Velocity(i1) ) * scaleFactor - u_out%Velocity(i1) = u1%Velocity(i1) + b + c * t_out - END DO -END IF ! check if allocated - END SUBROUTINE Conv_Rdtn_Input_ExtrapInterp2 - - - SUBROUTINE Conv_Rdtn_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(Conv_Rdtn_OutputType), INTENT(IN) :: y(:) ! Output at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Outputs - TYPE(Conv_Rdtn_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 + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + IF (ALLOCATED(u_out%Velocity) .AND. ALLOCATED(u1%Velocity)) THEN + u_out%Velocity = a1*u1%Velocity + a2*u2%Velocity + a3*u3%Velocity + END IF ! check if allocated +END SUBROUTINE + +subroutine Conv_Rdtn_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(Conv_Rdtn_OutputType), intent(in) :: y(:) ! Output at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Outputs + type(Conv_Rdtn_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 = 'Conv_Rdtn_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 Conv_Rdtn_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL Conv_Rdtn_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 Conv_Rdtn_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 Conv_Rdtn_Output_ExtrapInterp - - - SUBROUTINE Conv_Rdtn_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'Conv_Rdtn_Output_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(y)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(y)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(y) - 1 + select case (order) + case (0) + call Conv_Rdtn_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call Conv_Rdtn_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call Conv_Rdtn_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(y) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE Conv_Rdtn_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. @@ -2238,47 +874,45 @@ SUBROUTINE Conv_Rdtn_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ! !.................................................................................................................................. - TYPE(Conv_Rdtn_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 - TYPE(Conv_Rdtn_OutputType), INTENT(IN) :: y2 ! Output at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs - TYPE(Conv_Rdtn_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 + TYPE(Conv_Rdtn_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 + TYPE(Conv_Rdtn_OutputType), INTENT(IN) :: y2 ! Output at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs + TYPE(Conv_Rdtn_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 = 'Conv_Rdtn_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 + REAL(DbKi) :: t(2) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_Output_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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%F_Rdtn) .AND. ALLOCATED(y1%F_Rdtn)) THEN - DO i1 = LBOUND(y_out%F_Rdtn,1),UBOUND(y_out%F_Rdtn,1) - b = -(y1%F_Rdtn(i1) - y2%F_Rdtn(i1)) - y_out%F_Rdtn(i1) = y1%F_Rdtn(i1) + b * ScaleFactor - END DO -END IF ! check if allocated - END SUBROUTINE Conv_Rdtn_Output_ExtrapInterp1 - - - SUBROUTINE Conv_Rdtn_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + IF (ALLOCATED(y_out%F_Rdtn) .AND. ALLOCATED(y1%F_Rdtn)) THEN + y_out%F_Rdtn = a1*y1%F_Rdtn + a2*y2%F_Rdtn + END IF ! check if allocated +END SUBROUTINE + +SUBROUTINE Conv_Rdtn_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. @@ -2292,54 +926,50 @@ SUBROUTINE Conv_Rdtn_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrSt ! !.................................................................................................................................. - TYPE(Conv_Rdtn_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 > t3 - TYPE(Conv_Rdtn_OutputType), INTENT(IN) :: y2 ! Output at t2 > t3 - TYPE(Conv_Rdtn_OutputType), INTENT(IN) :: y3 ! Output at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs - TYPE(Conv_Rdtn_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 + TYPE(Conv_Rdtn_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 > t3 + TYPE(Conv_Rdtn_OutputType), INTENT(IN) :: y2 ! Output at t2 > t3 + TYPE(Conv_Rdtn_OutputType), INTENT(IN) :: y3 ! Output at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs + TYPE(Conv_Rdtn_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 = 'Conv_Rdtn_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) - + 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) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_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 + 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 + 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 + 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%F_Rdtn) .AND. ALLOCATED(y1%F_Rdtn)) THEN - DO i1 = LBOUND(y_out%F_Rdtn,1),UBOUND(y_out%F_Rdtn,1) - b = (t(3)**2*(y1%F_Rdtn(i1) - y2%F_Rdtn(i1)) + t(2)**2*(-y1%F_Rdtn(i1) + y3%F_Rdtn(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%F_Rdtn(i1) + t(3)*y2%F_Rdtn(i1) - t(2)*y3%F_Rdtn(i1) ) * scaleFactor - y_out%F_Rdtn(i1) = y1%F_Rdtn(i1) + b + c * t_out - END DO -END IF ! check if allocated - END SUBROUTINE Conv_Rdtn_Output_ExtrapInterp2 - + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + IF (ALLOCATED(y_out%F_Rdtn) .AND. ALLOCATED(y1%F_Rdtn)) THEN + y_out%F_Rdtn = a1*y1%F_Rdtn + a2*y2%F_Rdtn + a3*y3%F_Rdtn + END IF ! check if allocated +END SUBROUTINE END MODULE Conv_Radiation_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/hydrodyn/src/Current_Types.f90 b/modules/hydrodyn/src/Current_Types.f90 deleted file mode 100644 index a768b5d0b3..0000000000 --- a/modules/hydrodyn/src/Current_Types.f90 +++ /dev/null @@ -1,2026 +0,0 @@ -!STARTOFREGISTRYGENERATEDFILE 'Current_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 -!********************************************************************************************************************************* -! Current_Types -!................................................................................................................................. -! This file is part of Current. -! -! 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 Current. 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 Current_Types -!--------------------------------------------------------------------------------------------------------------------------------- -USE NWTC_Library -IMPLICIT NONE -! ========= Current_InitInputType ======= - TYPE, PUBLIC :: Current_InitInputType - REAL(SiKi) :: CurrSSV0 !< [-] - CHARACTER(80) :: CurrSSDirChr !< [-] - REAL(SiKi) :: CurrSSDir !< [-] - REAL(SiKi) :: CurrNSRef !< [-] - REAL(SiKi) :: CurrNSV0 !< [-] - REAL(SiKi) :: CurrNSDir !< [-] - REAL(SiKi) :: CurrDIV !< [-] - REAL(SiKi) :: CurrDIDir !< [-] - INTEGER(IntKi) :: CurrMod !< [-] - REAL(SiKi) :: WtrDpth !< [-] - REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: MorisonNodezi !< [-] - INTEGER(IntKi) :: NMorisonNodes !< [-] - CHARACTER(1024) :: DirRoot !< [-] - END TYPE Current_InitInputType -! ======================= -! ========= Current_InitOutputType ======= - TYPE, PUBLIC :: Current_InitOutputType - REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: CurrVxi !< [-] - REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: CurrVyi !< [-] - REAL(SiKi) :: PCurrVxiPz0 !< [-] - REAL(SiKi) :: PCurrVyiPz0 !< [-] - END TYPE Current_InitOutputType -! ======================= -! ========= Current_ContinuousStateType ======= - TYPE, PUBLIC :: Current_ContinuousStateType - REAL(SiKi) :: DummyContState !< Remove this variable if you have continuous states [-] - END TYPE Current_ContinuousStateType -! ======================= -! ========= Current_DiscreteStateType ======= - TYPE, PUBLIC :: Current_DiscreteStateType - REAL(SiKi) :: DummyDiscState !< Remove this variable if you have discrete states [-] - END TYPE Current_DiscreteStateType -! ======================= -! ========= Current_ConstraintStateType ======= - TYPE, PUBLIC :: Current_ConstraintStateType - REAL(SiKi) :: DummyConstrState !< Remove this variable if you have constraint states [-] - END TYPE Current_ConstraintStateType -! ======================= -! ========= Current_OtherStateType ======= - TYPE, PUBLIC :: Current_OtherStateType - INTEGER(IntKi) :: DummyOtherState !< Remove this variable if you have other states [-] - END TYPE Current_OtherStateType -! ======================= -! ========= Current_MiscVarType ======= - TYPE, PUBLIC :: Current_MiscVarType - REAL(ReKi) :: DummyMiscVar !< Remove this variable if you have misc/optimization variables [-] - END TYPE Current_MiscVarType -! ======================= -! ========= Current_ParameterType ======= - TYPE, PUBLIC :: Current_ParameterType - REAL(DbKi) :: DT !< Time step for continuous state integration and discrete state update [seconds] - END TYPE Current_ParameterType -! ======================= -! ========= Current_InputType ======= - TYPE, PUBLIC :: Current_InputType - REAL(SiKi) :: DummyInput !< Remove this variable if you have input data [-] - END TYPE Current_InputType -! ======================= -! ========= Current_OutputType ======= - TYPE, PUBLIC :: Current_OutputType - REAL(SiKi) :: DummyOutput !< Remove this variable if you have output data [-] - END TYPE Current_OutputType -! ======================= -CONTAINS - SUBROUTINE Current_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Current_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(Current_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 = 'Current_CopyInitInput' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInitInputData%CurrSSV0 = SrcInitInputData%CurrSSV0 - DstInitInputData%CurrSSDirChr = SrcInitInputData%CurrSSDirChr - DstInitInputData%CurrSSDir = SrcInitInputData%CurrSSDir - DstInitInputData%CurrNSRef = SrcInitInputData%CurrNSRef - DstInitInputData%CurrNSV0 = SrcInitInputData%CurrNSV0 - DstInitInputData%CurrNSDir = SrcInitInputData%CurrNSDir - DstInitInputData%CurrDIV = SrcInitInputData%CurrDIV - DstInitInputData%CurrDIDir = SrcInitInputData%CurrDIDir - DstInitInputData%CurrMod = SrcInitInputData%CurrMod - DstInitInputData%WtrDpth = SrcInitInputData%WtrDpth -IF (ALLOCATED(SrcInitInputData%MorisonNodezi)) THEN - i1_l = LBOUND(SrcInitInputData%MorisonNodezi,1) - i1_u = UBOUND(SrcInitInputData%MorisonNodezi,1) - IF (.NOT. ALLOCATED(DstInitInputData%MorisonNodezi)) THEN - ALLOCATE(DstInitInputData%MorisonNodezi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%MorisonNodezi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%MorisonNodezi = SrcInitInputData%MorisonNodezi -ENDIF - DstInitInputData%NMorisonNodes = SrcInitInputData%NMorisonNodes - DstInitInputData%DirRoot = SrcInitInputData%DirRoot - END SUBROUTINE Current_CopyInitInput - - SUBROUTINE Current_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(Current_InitInputType), INTENT(INOUT) :: InitInputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Current_DestroyInitInput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(InitInputData%MorisonNodezi)) THEN - DEALLOCATE(InitInputData%MorisonNodezi) -ENDIF - END SUBROUTINE Current_DestroyInitInput - - SUBROUTINE Current_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(Current_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 = 'Current_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 - Re_BufSz = Re_BufSz + 1 ! CurrSSV0 - Int_BufSz = Int_BufSz + 1*LEN(InData%CurrSSDirChr) ! CurrSSDirChr - Re_BufSz = Re_BufSz + 1 ! CurrSSDir - Re_BufSz = Re_BufSz + 1 ! CurrNSRef - Re_BufSz = Re_BufSz + 1 ! CurrNSV0 - Re_BufSz = Re_BufSz + 1 ! CurrNSDir - Re_BufSz = Re_BufSz + 1 ! CurrDIV - Re_BufSz = Re_BufSz + 1 ! CurrDIDir - Int_BufSz = Int_BufSz + 1 ! CurrMod - Re_BufSz = Re_BufSz + 1 ! WtrDpth - Int_BufSz = Int_BufSz + 1 ! MorisonNodezi allocated yes/no - IF ( ALLOCATED(InData%MorisonNodezi) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! MorisonNodezi upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%MorisonNodezi) ! MorisonNodezi - END IF - Int_BufSz = Int_BufSz + 1 ! NMorisonNodes - 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 - - ReKiBuf(Re_Xferred) = InData%CurrSSV0 - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(InData%CurrSSDirChr) - IntKiBuf(Int_Xferred) = ICHAR(InData%CurrSSDirChr(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - ReKiBuf(Re_Xferred) = InData%CurrSSDir - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%CurrNSRef - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%CurrNSV0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%CurrNSDir - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%CurrDIV - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%CurrDIDir - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%CurrMod - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WtrDpth - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%MorisonNodezi) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MorisonNodezi,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MorisonNodezi,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%MorisonNodezi,1), UBOUND(InData%MorisonNodezi,1) - ReKiBuf(Re_Xferred) = InData%MorisonNodezi(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NMorisonNodes - Int_Xferred = Int_Xferred + 1 - 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 Current_PackInitInput - - SUBROUTINE Current_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(Current_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 = 'Current_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%CurrSSV0 = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(OutData%CurrSSDirChr) - OutData%CurrSSDirChr(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%CurrSSDir = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%CurrNSRef = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%CurrNSV0 = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%CurrNSDir = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%CurrDIV = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%CurrDIDir = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%CurrMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WtrDpth = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MorisonNodezi not allocated - Int_Xferred = Int_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%MorisonNodezi)) DEALLOCATE(OutData%MorisonNodezi) - ALLOCATE(OutData%MorisonNodezi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MorisonNodezi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%MorisonNodezi,1), UBOUND(OutData%MorisonNodezi,1) - OutData%MorisonNodezi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%NMorisonNodes = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%DirRoot) - OutData%DirRoot(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END SUBROUTINE Current_UnPackInitInput - - SUBROUTINE Current_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Current_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(Current_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 = 'Current_CopyInitOutput' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcInitOutputData%CurrVxi)) THEN - i1_l = LBOUND(SrcInitOutputData%CurrVxi,1) - i1_u = UBOUND(SrcInitOutputData%CurrVxi,1) - IF (.NOT. ALLOCATED(DstInitOutputData%CurrVxi)) THEN - ALLOCATE(DstInitOutputData%CurrVxi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%CurrVxi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%CurrVxi = SrcInitOutputData%CurrVxi -ENDIF -IF (ALLOCATED(SrcInitOutputData%CurrVyi)) THEN - i1_l = LBOUND(SrcInitOutputData%CurrVyi,1) - i1_u = UBOUND(SrcInitOutputData%CurrVyi,1) - IF (.NOT. ALLOCATED(DstInitOutputData%CurrVyi)) THEN - ALLOCATE(DstInitOutputData%CurrVyi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%CurrVyi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%CurrVyi = SrcInitOutputData%CurrVyi -ENDIF - DstInitOutputData%PCurrVxiPz0 = SrcInitOutputData%PCurrVxiPz0 - DstInitOutputData%PCurrVyiPz0 = SrcInitOutputData%PCurrVyiPz0 - END SUBROUTINE Current_CopyInitOutput - - SUBROUTINE Current_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(Current_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Current_DestroyInitOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(InitOutputData%CurrVxi)) THEN - DEALLOCATE(InitOutputData%CurrVxi) -ENDIF -IF (ALLOCATED(InitOutputData%CurrVyi)) THEN - DEALLOCATE(InitOutputData%CurrVyi) -ENDIF - END SUBROUTINE Current_DestroyInitOutput - - SUBROUTINE Current_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(Current_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 = 'Current_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 ! CurrVxi allocated yes/no - IF ( ALLOCATED(InData%CurrVxi) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! CurrVxi upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CurrVxi) ! CurrVxi - END IF - Int_BufSz = Int_BufSz + 1 ! CurrVyi allocated yes/no - IF ( ALLOCATED(InData%CurrVyi) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! CurrVyi upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CurrVyi) ! CurrVyi - END IF - Re_BufSz = Re_BufSz + 1 ! PCurrVxiPz0 - Re_BufSz = Re_BufSz + 1 ! PCurrVyiPz0 - 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%CurrVxi) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CurrVxi,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CurrVxi,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%CurrVxi,1), UBOUND(InData%CurrVxi,1) - ReKiBuf(Re_Xferred) = InData%CurrVxi(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CurrVyi) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CurrVyi,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CurrVyi,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%CurrVyi,1), UBOUND(InData%CurrVyi,1) - ReKiBuf(Re_Xferred) = InData%CurrVyi(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%PCurrVxiPz0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PCurrVyiPz0 - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Current_PackInitOutput - - SUBROUTINE Current_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(Current_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 = 'Current_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 ! CurrVxi not allocated - Int_Xferred = Int_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%CurrVxi)) DEALLOCATE(OutData%CurrVxi) - ALLOCATE(OutData%CurrVxi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CurrVxi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%CurrVxi,1), UBOUND(OutData%CurrVxi,1) - OutData%CurrVxi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CurrVyi not allocated - Int_Xferred = Int_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%CurrVyi)) DEALLOCATE(OutData%CurrVyi) - ALLOCATE(OutData%CurrVyi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CurrVyi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%CurrVyi,1), UBOUND(OutData%CurrVyi,1) - OutData%CurrVyi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%PCurrVxiPz0 = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%PCurrVyiPz0 = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Current_UnPackInitOutput - - SUBROUTINE Current_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Current_ContinuousStateType), INTENT(IN) :: SrcContStateData - TYPE(Current_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 = 'Current_CopyContState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstContStateData%DummyContState = SrcContStateData%DummyContState - END SUBROUTINE Current_CopyContState - - SUBROUTINE Current_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(Current_ContinuousStateType), INTENT(INOUT) :: ContStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Current_DestroyContState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE Current_DestroyContState - - SUBROUTINE Current_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(Current_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 = 'Current_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 Current_PackContState - - SUBROUTINE Current_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(Current_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 = 'Current_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 = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Current_UnPackContState - - SUBROUTINE Current_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Current_DiscreteStateType), INTENT(IN) :: SrcDiscStateData - TYPE(Current_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 = 'Current_CopyDiscState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstDiscStateData%DummyDiscState = SrcDiscStateData%DummyDiscState - END SUBROUTINE Current_CopyDiscState - - SUBROUTINE Current_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(Current_DiscreteStateType), INTENT(INOUT) :: DiscStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Current_DestroyDiscState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE Current_DestroyDiscState - - SUBROUTINE Current_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(Current_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 = 'Current_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 Current_PackDiscState - - SUBROUTINE Current_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(Current_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 = 'Current_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 = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Current_UnPackDiscState - - SUBROUTINE Current_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Current_ConstraintStateType), INTENT(IN) :: SrcConstrStateData - TYPE(Current_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 = 'Current_CopyConstrState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState - END SUBROUTINE Current_CopyConstrState - - SUBROUTINE Current_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(Current_ConstraintStateType), INTENT(INOUT) :: ConstrStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Current_DestroyConstrState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE Current_DestroyConstrState - - SUBROUTINE Current_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(Current_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 = 'Current_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 Current_PackConstrState - - SUBROUTINE Current_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(Current_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 = 'Current_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 = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Current_UnPackConstrState - - SUBROUTINE Current_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Current_OtherStateType), INTENT(IN) :: SrcOtherStateData - TYPE(Current_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 = 'Current_CopyOtherState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstOtherStateData%DummyOtherState = SrcOtherStateData%DummyOtherState - END SUBROUTINE Current_CopyOtherState - - SUBROUTINE Current_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(Current_OtherStateType), INTENT(INOUT) :: OtherStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Current_DestroyOtherState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE Current_DestroyOtherState - - SUBROUTINE Current_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(Current_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 = 'Current_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) = InData%DummyOtherState - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Current_PackOtherState - - SUBROUTINE Current_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(Current_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 = 'Current_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 Current_UnPackOtherState - - SUBROUTINE Current_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Current_MiscVarType), INTENT(IN) :: SrcMiscData - TYPE(Current_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 = 'Current_CopyMisc' -! - ErrStat = ErrID_None - ErrMsg = "" - DstMiscData%DummyMiscVar = SrcMiscData%DummyMiscVar - END SUBROUTINE Current_CopyMisc - - SUBROUTINE Current_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(Current_MiscVarType), INTENT(INOUT) :: MiscData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Current_DestroyMisc' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE Current_DestroyMisc - - SUBROUTINE Current_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(Current_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 = 'Current_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) = InData%DummyMiscVar - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Current_PackMisc - - SUBROUTINE Current_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(Current_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 = 'Current_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 Current_UnPackMisc - - SUBROUTINE Current_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Current_ParameterType), INTENT(IN) :: SrcParamData - TYPE(Current_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 = 'Current_CopyParam' -! - ErrStat = ErrID_None - ErrMsg = "" - DstParamData%DT = SrcParamData%DT - END SUBROUTINE Current_CopyParam - - SUBROUTINE Current_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(Current_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Current_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE Current_DestroyParam - - SUBROUTINE Current_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(Current_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 = 'Current_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) = InData%DT - Db_Xferred = Db_Xferred + 1 - END SUBROUTINE Current_PackParam - - SUBROUTINE Current_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(Current_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 = 'Current_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 Current_UnPackParam - - SUBROUTINE Current_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Current_InputType), INTENT(IN) :: SrcInputData - TYPE(Current_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 = 'Current_CopyInput' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInputData%DummyInput = SrcInputData%DummyInput - END SUBROUTINE Current_CopyInput - - SUBROUTINE Current_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(Current_InputType), INTENT(INOUT) :: InputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Current_DestroyInput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE Current_DestroyInput - - SUBROUTINE Current_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(Current_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 = 'Current_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) = InData%DummyInput - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Current_PackInput - - SUBROUTINE Current_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(Current_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 = 'Current_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 = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Current_UnPackInput - - SUBROUTINE Current_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Current_OutputType), INTENT(IN) :: SrcOutputData - TYPE(Current_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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Current_CopyOutput' -! - ErrStat = ErrID_None - ErrMsg = "" - DstOutputData%DummyOutput = SrcOutputData%DummyOutput - END SUBROUTINE Current_CopyOutput - - SUBROUTINE Current_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(Current_OutputType), INTENT(INOUT) :: OutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Current_DestroyOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE Current_DestroyOutput - - SUBROUTINE Current_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(Current_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 = 'Current_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 - 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%DummyOutput - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Current_PackOutput - - SUBROUTINE Current_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(Current_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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Current_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 = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Current_UnPackOutput - - - SUBROUTINE Current_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(Current_InputType), INTENT(IN) :: u(:) ! Input at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Inputs - TYPE(Current_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 = 'Current_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 Current_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL Current_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 Current_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 Current_Input_ExtrapInterp - - - SUBROUTINE Current_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(Current_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 - TYPE(Current_InputType), INTENT(IN) :: u2 ! Input at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs - TYPE(Current_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 = 'Current_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) - b = -(u1%DummyInput - u2%DummyInput) - u_out%DummyInput = u1%DummyInput + b * ScaleFactor - END SUBROUTINE Current_Input_ExtrapInterp1 - - - SUBROUTINE Current_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(Current_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 > t3 - TYPE(Current_InputType), INTENT(IN) :: u2 ! Input at t2 > t3 - TYPE(Current_InputType), INTENT(IN) :: u3 ! Input at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs - TYPE(Current_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 = 'Current_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))) - b = (t(3)**2*(u1%DummyInput - u2%DummyInput) + t(2)**2*(-u1%DummyInput + u3%DummyInput))* scaleFactor - c = ( (t(2)-t(3))*u1%DummyInput + t(3)*u2%DummyInput - t(2)*u3%DummyInput ) * scaleFactor - u_out%DummyInput = u1%DummyInput + b + c * t_out - END SUBROUTINE Current_Input_ExtrapInterp2 - - - SUBROUTINE Current_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(Current_OutputType), INTENT(IN) :: y(:) ! Output at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Outputs - TYPE(Current_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 = 'Current_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 Current_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL Current_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 Current_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 Current_Output_ExtrapInterp - - - SUBROUTINE Current_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(Current_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 - TYPE(Current_OutputType), INTENT(IN) :: y2 ! Output at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs - TYPE(Current_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 = 'Current_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 - ! 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) - b = -(y1%DummyOutput - y2%DummyOutput) - y_out%DummyOutput = y1%DummyOutput + b * ScaleFactor - END SUBROUTINE Current_Output_ExtrapInterp1 - - - SUBROUTINE Current_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(Current_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 > t3 - TYPE(Current_OutputType), INTENT(IN) :: y2 ! Output at t2 > t3 - TYPE(Current_OutputType), INTENT(IN) :: y3 ! Output at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs - TYPE(Current_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 = 'Current_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 - - ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) - b = (t(3)**2*(y1%DummyOutput - y2%DummyOutput) + t(2)**2*(-y1%DummyOutput + y3%DummyOutput))* scaleFactor - c = ( (t(2)-t(3))*y1%DummyOutput + t(3)*y2%DummyOutput - t(2)*y3%DummyOutput ) * scaleFactor - y_out%DummyOutput = y1%DummyOutput + b + c * t_out - END SUBROUTINE Current_Output_ExtrapInterp2 - -END MODULE Current_Types -!ENDOFREGISTRYGENERATEDFILE diff --git a/modules/hydrodyn/src/HydroDyn.f90 b/modules/hydrodyn/src/HydroDyn.f90 index 65c012d0a9..eb668763be 100644 --- a/modules/hydrodyn/src/HydroDyn.f90 +++ b/modules/hydrodyn/src/HydroDyn.f90 @@ -30,10 +30,11 @@ MODULE HydroDyn use Morison USE WAMIT USE WAMIT2 + USE SeaState USE HydroDyn_Input USE HydroDyn_Output - USE Current - USE Waves2 + USE YawOffset + #ifdef USE_FIT USE FIT_MODULES USE FIT_Types @@ -76,148 +77,6 @@ MODULE HydroDyn CONTAINS -SUBROUTINE WvStretch_Init(WaveStMod, WtrDpth, NStepWave, NNodes, & - NWaveElev, WaveElev, WaveKinzi, WaveTime, & - WaveVel0, WaveAcc0, WaveDynP0, & - WavePVel0, WavePAcc0, WavePDynP0, & - WaveVel , WaveAcc , WaveDynP , & - nodeInWater, ErrStat, ErrMsg ) - - - INTEGER, INTENT(IN ) :: WaveStMod - REAL(SiKi), INTENT(IN ) :: WtrDpth - INTEGER, INTENT(IN ) :: NStepWave - INTEGER, INTENT(IN ) :: NNodes - INTEGER, INTENT(IN ) :: NWaveElev - REAL(SiKi), INTENT(IN ) :: WaveElev(0:,:) - REAL(SiKi), INTENT(IN ) :: WaveKinzi(:) - REAL(SiKi), INTENT(IN ) :: WaveTime(0:) - REAL(SiKi), INTENT(IN ) :: WaveVel0(0:,:,:) !< Wave velocity in Global coordinate system at Z = 0. Each point in this array has a corresponding entry (same index #) in the WaveVel array - REAL(SiKi), INTENT(IN ) :: WaveAcc0(0:,:,:) - REAL(SiKi), INTENT(IN ) :: WaveDynP0(0:,:) - REAL(SiKi), INTENT(IN ) :: WavePVel0(0:,:,:) !< Wave velocity in Global coordinate system at Z = 0. Each point in this array has a corresponding entry (same index #) in the WaveVel array - REAL(SiKi), INTENT(IN ) :: WavePAcc0(0:,:,:) - REAL(SiKi), INTENT(IN ) :: WavePDynP0(0:,:) - REAL(SiKi), INTENT(INOUT) :: WaveVel(0:,:,:) - REAL(SiKi), INTENT(INOUT) :: WaveAcc(0:,:,:) - REAL(SiKi), INTENT(INOUT) :: WaveDynP(0:,:) - INTEGER(IntKi), INTENT(INOUT) :: nodeInWater(0:,:) - 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 !< Local loop counters - REAL(SiKi) :: wavekinzloc ,WavePVel0loc - - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - - - DO I = 0,NStepWave-1 ! Loop through all time steps - - DO J = 1,NNodes - - SELECT CASE ( WaveStMod ) ! Which model are we using to extrapolate the incident wave kinematics to the instantaneous free surface? - - CASE ( 0 ) ! None = no stretching. - ! Since we have no stretching, the wave kinematics between the seabed and - ! the mean sea level are left unchanged; below the seabed or above the - ! mean sea level, the wave kinematics are zero: - IF ( ( WaveKinzi(J) < -WtrDpth ) .OR. ( WaveKinzi(J) > 0.0 ) ) THEN ! .TRUE. if the elevation of the point defined by WaveKinzi(J) lies below the seabed or above mean sea level (exclusive) - - WaveDynP (I,J ) = 0.0 - WaveVel (I,J,:) = 0.0 - WaveAcc (I,J,:) = 0.0 - nodeInWater(I,J ) = 0 - ELSE - nodeInWater(I,J ) = 1 - END IF - CASE ( 1 ) ! Vertical stretching. - - - ! Vertical stretching says that the wave kinematics above the mean sea level - ! equal the wave kinematics at the mean sea level. The wave kinematics - ! below the mean sea level are left unchanged: - IF ( ( WaveKinzi(J) < -WtrDpth ) .OR. ( WaveKinzi(J) > WaveElev(I,J) ) ) THEN ! .TRUE. if the elevation of the point defined by WaveKinzi(J) lies below the seabed or above the instantaneous wave elevation (exclusive) - - WaveDynP (I,J ) = 0.0 - WaveVel (I,J,:) = 0.0 - WaveAcc (I,J,:) = 0.0 - nodeInWater(I,J ) = 0 - ELSE - nodeInWater(I,J ) = 1 - IF ( WaveKinzi(J) >= 0.0_ReKi ) THEN - ! Set the wave kinematics to the kinematics at mean sea level for locations above MSL, but below the wave elevation. - WaveDynP (I,J ) = WaveDynP0 (I,J ) - WaveVel (I,J,:) = WaveVel0 (I,J,:) - WaveAcc (I,J,:) = WaveAcc0 (I,J,:) - END IF - ! Otherwise, do nothing because the kinematics have already be set correctly via the various Waves modules - END IF - - - - - CASE ( 2 ) ! Extrapolation stretching. - - - ! Extrapolation stretching uses a linear Taylor expansion of the wave - ! kinematics (and their partial derivatives with respect to z) at the mean - ! sea level to find the wave kinematics above the mean sea level. The - ! wave kinematics below the mean sea level are left unchanged: - - - IF ( ( WaveKinzi(J) < -WtrDpth ) .OR. ( WaveKinzi(J) > WaveElev(I,J) ) ) THEN ! .TRUE. if the elevation of the point defined by WaveKinzi(J) lies below the seabed or above the instantaneous wave elevation (exclusive) - - WaveDynP (I,J ) = 0.0 - WaveVel (I,J,:) = 0.0 - WaveAcc (I,J,:) = 0.0 - nodeInWater(I,J ) = 0 - ELSE - nodeInWater(I,J ) = 1 - wavekinzloc = WaveKinzi(J) - WavePVel0loc = WavePVel0 (I,J,1) - IF ( WaveKinzi(J) >= 0.0_ReKi ) THEN - ! Set the wave kinematics to the kinematics at mean sea level for locations above MSL, but below the wave elevation. - WaveDynP (I,J ) = WaveDynP0 (I,J ) + WaveKinzi(J)*WavePDynP0 (I,J ) - WaveVel (I,J,:) = WaveVel0 (I,J,:) + WaveKinzi(J)*WavePVel0 (I,J,:) - WaveAcc (I,J,:) = WaveAcc0 (I,J,:) + WaveKinzi(J)*WavePAcc0 (I,J,:) - END IF - ! Otherwise, do nothing because the kinematics have already be set correctly via the various Waves modules - END IF - - - CASE ( 3 ) ! Wheeler stretching. - - - ! Wheeler stretching says that wave kinematics calculated using Airy theory - ! at the mean sea level should actually be applied at the instantaneous - ! free surface and that Airy wave kinematics computed at locations between - ! the seabed and the mean sea level should be shifted vertically to new - ! locations in proportion to their elevation above the seabed. - ! - ! Computing the wave kinematics with Wheeler stretching requires that first - ! say that the wave kinematics we computed at the elevations defined by - ! the WaveKinzi0Prime(:) array are actual applied at the elevations found - ! by stretching the elevations in the WaveKinzi0Prime(:) array using the - ! instantaneous wave elevation--these new elevations are stored in the - ! WaveKinzi0St(:) array. Next, we interpolate the wave kinematics - ! computed without stretching to the desired elevations (defined in the - ! WaveKinzi(:) array) using the WaveKinzi0St(:) array: - - - ENDSELECT - END DO ! J - All points where the incident wave kinematics will be computed - END DO ! I - All time steps - - ! Set the ending timestep to the same as the first timestep - WaveDynP (NStepWave,: ) = WaveDynP (0,: ) - WaveVel (NStepWave,:,:) = WaveVel (0,:,:) - WaveAcc (NStepWave,:,:) = WaveAcc (0,:,:) - -END SUBROUTINE WvStretch_Init - !---------------------------------------------------------------------------------------------------------------------------------- !> 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. @@ -225,7 +84,7 @@ END SUBROUTINE WvStretch_Init SUBROUTINE HydroDyn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut, ErrStat, ErrMsg ) !.................................................................................................................................. - TYPE(HydroDyn_InitInputType), INTENT(IN ) :: InitInp !< Input data for initialization routine. + TYPE(HydroDyn_InitInputType), INTENT(INOUT) :: InitInp !< Input data for initialization routine. [INOUT because of a move_alloc() statement] TYPE(HydroDyn_InputType), INTENT( OUT) :: u !< An initial guess for the input; input mesh must be defined TYPE(HydroDyn_ParameterType), INTENT( OUT) :: p !< Parameters TYPE(HydroDyn_ContinuousStateType), INTENT( OUT) :: x !< Initial continuous states @@ -251,35 +110,12 @@ SUBROUTINE HydroDyn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, I CHARACTER(1024) :: SummaryName ! name of the HydroDyn summary file TYPE(HydroDyn_InputFile) :: InputFileData !< Data from input file TYPE(FileInfoType) :: InFileInfo !< The derived type for holding the full input file for parsing -- we may pass this in the future - TYPE(Waves_InitOutputType) :: Waves_InitOut ! Initialization Outputs from the Waves module initialization -! TYPE(Waves2_InitOutputType) :: Waves2_InitOut ! Initialization Outputs from the Waves2 module initialization - TYPE(Current_InitOutputType) :: Current_InitOut ! Initialization Outputs from the Current module initialization ! LOGICAL :: hasWAMITOuts ! Are there any WAMIT-related outputs ! LOGICAL :: hasMorisonOuts ! Are there any Morison-related outputs ! INTEGER :: numHydroOuts ! total number of WAMIT and Morison outputs INTEGER :: I, J, k, iBody ! Generic counters - REAL(SiKi) :: WaveNmbr ! Wavenumber of the current frequency component (1/meter) ! These are dummy variables to satisfy the framework, but are not used - TYPE(Waves_InputType) :: Waves_u ! Waves module initial guess for the input; the input mesh is not defined because it is not used by the waves module - TYPE(Waves_ParameterType) :: Waves_p ! Waves module parameters - TYPE(Waves_ContinuousStateType) :: Waves_x ! Waves module initial continuous states - TYPE(Waves_DiscreteStateType) :: Waves_xd ! Waves module discrete states - TYPE(Waves_ConstraintStateType) :: Waves_z ! Waves module initial guess of the constraint states - TYPE(Waves_OtherStateType) :: WavesOtherState ! Waves module other states - TYPE(Waves_MiscVarType) :: Waves_m ! Waves module misc/optimization data - TYPE(Waves_OutputType) :: Waves_y ! Waves module outputs - - - TYPE(Current_InputType) :: Current_u ! Current module initial guess for the input; the input mesh is not defined because it is not used by the Current module - TYPE(Current_ParameterType) :: Current_p ! Current module parameters - TYPE(Current_ContinuousStateType) :: Current_x ! Current module initial continuous states - TYPE(Current_DiscreteStateType) :: Current_xd ! Current module discrete states - TYPE(Current_ConstraintStateType) :: Current_z ! Current module initial guess of the constraint states - TYPE(Current_OtherStateType) :: CurrentOtherState ! Current module other states - TYPE(Current_OutputType) :: Current_y ! Current module outputs - TYPE(Current_MiscVarType) :: Current_m ! Current module misc/optimization data - #ifdef USE_FIT ! FIT - related data @@ -294,46 +130,20 @@ SUBROUTINE HydroDyn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, I TYPE(FIT_InitOutputType) :: FIT_InitOut ! Initialization Outputs from the FIT module initialization #endif - Real(ReKi) :: Np - Real(ReKi) :: dftreal - Real(ReKi) :: dftimag ! WAMIT Mesh real(R8Ki) :: theta(3), orientation(3,3) - ! Wave Stretching Data - REAL(SiKi), ALLOCATABLE :: tmpWaveKinzi(: ) - INTEGER :: tmpNWaveElev - REAL(SiKi), ALLOCATABLE :: tmpWaveElevxi(: ) - REAL(SiKi), ALLOCATABLE :: tmpWaveElevyi(: ) - REAL(SiKi), ALLOCATABLE :: tmpWaveElevXY(:,: ) - REAL(SiKi), ALLOCATABLE :: WaveElevSt (:,: ) - REAL(SiKi), ALLOCATABLE :: WaveVel0 (:,:,:) - REAL(SiKi), ALLOCATABLE :: WaveAcc0 (:,:,:) - REAL(SiKi), ALLOCATABLE :: WaveDynP0 (:,: ) - REAL(SiKi), ALLOCATABLE :: WaveVel2S0 (:,:,:) - REAL(SiKi), ALLOCATABLE :: WaveAcc2S0 (:,:,:) - REAL(SiKi), ALLOCATABLE :: WaveDynP2S0 (:,: ) - REAL(SiKi), ALLOCATABLE :: WaveVel2D0 (:,:,:) - REAL(SiKi), ALLOCATABLE :: WaveAcc2D0 (:,:,:) - REAL(SiKi), ALLOCATABLE :: WaveDynP2D0 (:,: ) - - INTEGER(IntKi) :: ErrStat2 ! local error status CHARACTER(ErrMsgLen) :: ErrMsg2 ! local error message CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_Init' - ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" - p%UnOutFile = -1 !bjj: this was being written to the screen when I had an error in my HD input file, so I'm going to initialize here. - -#ifdef BETA_BUILD - CALL DispBetaNotice( "This is a beta version of HydroDyn and is for testing purposes only."//NewLine//"This version includes user waves, WaveMod=6 and the ability to write example user waves." ) -#endif + p%UnOutFile = -1 ! Initialize the NWTC Subroutine Library @@ -367,13 +177,25 @@ SUBROUTINE HydroDyn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, I ! Parse all HydroDyn-related input and populate the InputFileData structure - CALL HydroDyn_ParseInput( InitInp%InputFile, InitInp%OutRootName, InitInp%defWtrDens, InitInp%defWtrDpth, InitInp%defMSL2SWL, InFileInfo, InputFileData, ErrStat2, ErrMsg2 ) + CALL HydroDyn_ParseInput( InitInp%InputFile, InitInp%OutRootName, InFileInfo, InputFileData, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) IF ( ErrStat >= AbortErrLev ) THEN CALL CleanUp() RETURN END IF + + p%WaveField => InitInp%WaveField + p%PtfmYMod = InputFileData%PtfmYMod + InputFileData%Morison%WaveField => InitInp%WaveField + InputFileData%WAMIT%WaveField => InitInp%WaveField + InputFileData%WAMIT2%WaveField => InitInp%WaveField + + InputFileData%Morison%PtfmYMod = InputFileData%PtfmYMod + InputFileData%WAMIT%PtfmYMod = InputFileData%PtfmYMod + InputFileData%WAMIT%PtfmRefY = InputFileData%PtfmRefY + InputFileData%WAMIT2%PtfmYMod = InputFileData%PtfmYMod + InputFileData%WAMIT2%PtfmRefY = InputFileData%PtfmRefY ! Verify all the necessary initialization data. Do this at the HydroDynInput module-level ! because the HydroDynInput module is also responsible for parsing all this @@ -399,7 +221,7 @@ SUBROUTINE HydroDyn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, I ELSE IF (Initlocal%PotMod == 2) THEN ! This is the FIT potential flow model and the time step needs to be >= the driver timestep, and and integer multiple if larger ! We example WaveDT for this timestep size because FIT is tied to WaveDT - IF ( ( .NOT. EqualRealNos(mod(real(Initlocal%Waves%WaveDT,ReKi), real(Interval,ReKi)) , 0.0_ReKi) ) .OR. Initlocal%Waves%WaveDT <= 0.0_DbKi ) THEn + IF ( ( .NOT. EqualRealNos(mod(real(Initlocal%WaveDT,ReKi), real(Interval,ReKi)) , 0.0_ReKi) ) .OR. Initlocal%WaveDT <= 0.0_DbKi ) THEn CALL SetErrStat(ErrID_Fatal,'The value of WaveDT is not greater than zero and an integer multiple of the glue code timestep.',ErrStat,ErrMsg,RoutineName) IF ( ErrStat >= AbortErrLev ) THEN CALL CleanUp() @@ -416,12 +238,23 @@ SUBROUTINE HydroDyn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, I p%DT = Interval END IF + ! Low-pass filter constant for PtfmRefY + p%CYawFilt = exp(-TwoPi*Interval*InputFileData%PtfmYCutoff) + ! Allocate and initialize discrete states for the filtered PRP yaw position + ALLOCATE ( xd%PtfmRefY(1:3) , STAT=ErrStat2 ) + IF ( ErrStat2 /= 0 ) THEN + CALL SetErrStat( ErrID_Fatal, 'Error allocating memory for the PtfmRefY array.', ErrStat, ErrMsg, RoutineName) + CALL Cleanup() + RETURN + END IF + xd%PtfmRefY = InputFileData%PtfmRefY + ! Open a summary of the HydroDyn Initialization. Note: OutRootName must be set by the caller because there may not be an input file to obtain this rootname from. IF ( InputFileData%HDSum ) THEN - SummaryName = TRIM(InitInp%OutRootName)//'.HD.sum' - CALL HDOut_OpenSum( InputFileData%UnSum, SummaryName, HydroDyn_ProgDesc, ErrStat2, ErrMsg2 ) !this must be called before the Waves_Init() routine so that the appropriate wave data can be written to the summary file + SummaryName = TRIM(InitInp%OutRootName)//'.sum' + CALL HDOut_OpenSum( InputFileData%UnSum, SummaryName, HydroDyn_ProgDesc, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) IF ( ErrStat >= AbortErrLev ) THEN CALL CleanUp() @@ -441,435 +274,28 @@ SUBROUTINE HydroDyn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, I p%AddBQuad = InputFileData%AddBQuad - ! Set summary unit number in Waves, Radiation, and Morison initialization input data - InputFileData%Waves%UnSum = InputFileData%UnSum - InputFileData%WAMIT%Conv_Rdtn%UnSum = InputFileData%UnSum - InputFileData%Morison%UnSum = InputFileData%UnSum + ! Set summary unit number in Morison initialization input data + InputFileData%Morison%UnSum = InputFileData%UnSum - ! distribute wave field and turbine location variables as needed to submodule initInputs - InputFileData%Waves%WaveFieldMod = InitInp%WaveFieldMod - InputFileData%Waves%PtfmLocationX = InitInp%PtfmLocationX - InputFileData%Waves%PtfmLocationY = InitInp%PtfmLocationY - ! Were visualization meshes requested? p%VisMeshes = InitInp%VisMeshes ! Now call each sub-module's *_Init subroutine ! to fully initialize each sub-module based on the necessary initialization data - - - ! Initialize Current module - - CALL Current_Init(InputFileData%Current, Current_u, Current_p, Current_x, Current_xd, Current_z, CurrentOtherState, & - Current_y, Current_m, Interval, Current_InitOut, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp() - RETURN - END IF - - ! Verify that Current_Init() did not request a different Interval! - - IF ( p%DT /= Interval ) THEN - CALL SetErrStat(ErrID_Fatal,'Current Module attempted to change timestep interval, but this is not allowed. Current Module must use the HydroDyn Interval.',ErrStat,ErrMsg,RoutineName) - CALL CleanUp() - RETURN - END IF - - - ! Move initialization output data from Current module into the initialization input data for the Waves module - - IF (ALLOCATED(Current_InitOut%CurrVxi)) CALL Move_Alloc( Current_InitOut%CurrVxi, InputFileData%Waves%CurrVxi ) - IF (ALLOCATED(Current_InitOut%CurrVyi)) CALL Move_Alloc( Current_InitOut%CurrVyi, InputFileData%Waves%CurrVyi ) - - InputFileData%Waves%PCurrVxiPz0 = Current_InitOut%PCurrVxiPz0 - InputFileData%Waves%PCurrVyiPz0 = Current_InitOut%PCurrVyiPz0 - - - ! Copy the WaveElevXY data in from the HydroDyn InitInp - - IF (ALLOCATED(InitInp%WaveElevXY)) THEN - call AllocAry(tmpWaveElevXY,size(InitInp%WaveElevXY,DIM=1),size(InitInp%WaveElevXY,DIM=2),'tmpWaveElevXY',ErrStat2,ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp() - RETURN - END IF - tmpWaveElevXY = InitInp%WaveElevXY - CALL MOVE_ALLOC(tmpWaveElevXY, InputFileData%Waves%WaveElevXY) ! move this back for waves2 later - ENDIF - - - ! Initialize Waves module - -!========================================================================== -! Initialize Wave Stretching data for 1st Order Waves -!========================================================================== - IF (InputFileData%Waves%WaveStMod > 0) THEN - ! Allocate the temporary storage array for the WvKinxi - ALLOCATE ( tmpWaveKinzi(InputFileData%Waves%NWaveKin), STAT = ErrStat2 ) - IF ( ErrStat2 /= 0 ) THEN - CALL SetErrStat( ErrID_Fatal,'Error allocating space for tmpWaveKinzi array.', ErrStat, ErrMsg, RoutineName) - CALL CleanUp() - RETURN - END IF - - - - tmpWaveKinzi = InputFileData%Waves%WaveKinzi - InputFileData%Waves%WaveKinzi = 0.0_ReKi ! Force all zi coordinates to 0.0 for this version of the Waves initialization - - - ! We will use the user-requested wave elevation arrays to compute the wave elevations for stretching at ALL node locations. - ! We are going to store the user-requested wave elevation output locations so that we can restore them after we done. - IF (InputFileData%Waves%NWaveElev > 0) THEN - tmpNWaveElev = InputFileData%Waves%NWaveElev - CALL MOVE_ALLOC( InputFileData%Waves%WaveElevxi, tmpWaveElevxi ) ! (from, to) - CALL MOVE_ALLOC( InputFileData%Waves%WaveElevyi, tmpWaveElevyi ) - END IF - - - ALLOCATE ( InputFileData%Waves%WaveElevxi(InputFileData%Waves%NWaveKin), STAT = ErrStat2 ) - IF ( ErrStat2 /= 0 ) THEN - CALL SetErrStat( ErrID_Fatal,'Error allocating space for tmpWaveKinzi array.', ErrStat, ErrMsg, RoutineName) - CALL CleanUp() - RETURN - END IF - ALLOCATE ( InputFileData%Waves%WaveElevyi(InputFileData%Waves%NWaveKin), STAT = ErrStat2 ) - IF ( ErrStat2 /= 0 ) THEN - CALL SetErrStat( ErrID_Fatal,'Error allocating space for tmpWaveKinzi array.', ErrStat, ErrMsg, RoutineName) - CALL CleanUp() - RETURN - END IF - - InputFileData%Waves%NWaveElev = InputFileData%Waves%NWaveKin - InputFileData%Waves%WaveElevxi = InputFileData%Waves%WaveKinxi - InputFileData%Waves%WaveElevyi = InputFileData%Waves%WaveKinyi - - - CALL Waves_Init(InputFileData%Waves, Waves_u, Waves_p, Waves_x, Waves_xd, Waves_z, WavesOtherState, & - Waves_y, Waves_m, Interval, Waves_InitOut, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp() - RETURN - END IF - - ! Store the wave elevations coming out of the Waves_Init for use in the stretching calculations - ALLOCATE ( WaveElevSt(0:Waves_InitOut%NStepWave,InputFileData%Waves%NWaveKin), STAT = ErrStat2 ) - IF ( ErrStat2 /= 0 ) THEN - CALL SetErrStat( ErrID_Fatal,'Error allocating space for WaveElevSt array.', ErrStat, ErrMsg, RoutineName) - CALL CleanUp() - RETURN - END IF - WaveElevSt = Waves_InitOut%WaveElev - - - ! We need to reset the wave elevation arrays - DEALLOCATE(InputFileData%Waves%WaveElevxi) - DEALLOCATE(InputFileData%Waves%WaveElevyi) - InputFileData%Waves%NWaveElev = tmpNWaveElev - - IF (InputFileData%Waves%NWaveElev > 0) THEN - CALL MOVE_ALLOC( tmpWaveElevxi, InputFileData%Waves%WaveElevxi ) ! (from, to) - CALL MOVE_ALLOC( tmpWaveElevyi, InputFileData%Waves%WaveElevyi ) - END IF - - ALLOCATE ( WaveDynP0 (0:Waves_InitOut%NStepWave,InputFileData%Waves%NWaveKin ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveDynP0.', ErrStat, ErrMsg, RoutineName) - - ALLOCATE ( WaveVel0 (0:Waves_InitOut%NStepWave,InputFileData%Waves%NWaveKin,3), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveVel0.', ErrStat, ErrMsg, RoutineName) - - ALLOCATE ( WaveAcc0 (0:Waves_InitOut%NStepWave,InputFileData%Waves%NWaveKin,3), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAcc0.', ErrStat, ErrMsg, RoutineName) - - - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp() - RETURN - END IF - - ! Copy the init output arrays into the MSL versions - WaveDynP0 = Waves_InitOut%WaveDynP - WaveAcc0 = Waves_InitOut%WaveAcc - WaveVel0 = Waves_InitOut%WaveVel - - - InputFileData%Waves%WaveKinzi = tmpWaveKinzi - - ! Deallocate data which will be allocated again within the Waves_Init routine - DEALLOCATE( Waves_InitOut%WaveDynP ) - DEALLOCATE( Waves_InitOut%WaveAcc ) - DEALLOCATE( Waves_InitOut%WaveVel ) - DEALLOCATE( Waves_InitOut%PWaveDynP0 ) - DEALLOCATE( Waves_InitOut%PWaveAcc0 ) - DEALLOCATE( Waves_InitOut%PWaveVel0 ) - DEALLOCATE( Waves_InitOut%WaveElevC0) - DEALLOCATE( Waves_InitOut%WaveDirArr) - DEALLOCATE( Waves_InitOut%WaveElev ) - DEALLOCATE( Waves_InitOut%WaveTime ) - DEALLOCATE( Waves_InitOut%NodeInWater ) - END IF -!========================================================================== - - CALL Waves_Init(InputFileData%Waves, Waves_u, Waves_p, Waves_x, Waves_xd, Waves_z, WavesOtherState, & - Waves_y, Waves_m, Interval, Waves_InitOut, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp() - RETURN - END IF - - - ! Verify that Waves_Init() did not request a different Interval! - - IF ( p%DT /= Interval ) THEN - CALL SetErrStat(ErrID_Fatal,'Waves Module attempted to change timestep interval, but this is not allowed. Waves Module must use the HydroDyn Interval.',ErrStat,ErrMsg,RoutineName) - CALL CleanUp() - RETURN - END IF - - ! Copy the wave elevation time series corresponding to WaveElevXY to the output. - - IF (ALLOCATED(Waves_InitOut%WaveElevSeries)) CALL MOVE_ALLOC( Waves_InitOut%WaveElevSeries, InitOut%WaveElevSeries ) - IF (ALLOCATED(InputFileData%Waves%WaveElevXY)) CALL MOVE_ALLOC(InputFileData%Waves%WaveElevXY, tmpWaveElevXY) ! move this back for waves2 later - - - ! Copy Waves initialization output into the initialization input type for the WAMIT module - p%NWaveElev = InputFileData%Waves%NWaveElev - p%NStepWave = Waves_InitOut%NStepWave - - CALL MOVE_ALLOC( Waves_InitOut%WaveTime, p%WaveTime ) - CALL MOVE_ALLOC( Waves_InitOut%WaveElev, p%WaveElev1 ) ! allocate p%WaveElev1, set p%WaveElev1 = Waves_InitOut%WaveElev, and deallocate Waves_InitOut%WaveElev - - ! Copy the first order wave elevation information to p%WaveElev1 so that we can output the total, first, and second order wave elevation separately - ALLOCATE ( p%WaveElev (0:p%NStepWave, p%NWaveElev ) , STAT=ErrStat2 ) - IF ( ErrStat2 /= 0 ) THEN - CALL SetErrStat(ErrID_Fatal,'Error allocating memory for the WaveElev array.',ErrStat,ErrMsg,RoutineName) - CALL CleanUp() - RETURN - END IF - p%WaveElev = p%WaveElev1 - - - - m%LastIndWave = 1 - - - IF ( InputFileData%Waves%WaveMod /= 6 ) THEN - - !---------------------------------- - ! Initialize Waves2 module - !---------------------------------- - - - IF (InputFileData%Waves2%WvDiffQTFF .OR. InputFileData%Waves2%WvSumQTFF ) THEN - ! Set a few things from the Waves module output - InputFileData%Waves2%NStepWave = Waves_InitOut%NStepWave - InputFileData%Waves2%NStepWave2 = Waves_InitOut%NStepWave2 - InputFileData%Waves2%WaveDOmega = Waves_InitOut%WaveDOmega - - ! Copy the WaveElevXY data in from the HydroDyn InputFileData - IF (ALLOCATED(tmpWaveElevXY)) CALL MOVE_ALLOC(tmpWaveElevXY, InputFileData%Waves2%WaveElevXY) - - ! Temporarily move arrays to init input for Waves2 (save some space) - CALL MOVE_ALLOC(p%WaveTime, InputFileData%Waves2%WaveTime) - CALL MOVE_ALLOC(Waves_InitOut%WaveElevC0, InputFileData%Waves2%WaveElevC0) - CALL MOVE_ALLOC(Waves_InitOut%WaveDirArr, InputFileData%Waves2%WaveDirArr) - -!========================================================================== -! Initialize Wave Stretching data for 2nd Order Waves -!========================================================================== - IF (InputFileData%Waves%WaveStMod > 0) THEN - ! Set the wave kinematics zi locations to zero to generate kinematics at MSL - InputFileData%Waves2%WaveKinzi = 0 - - ! We will use the user-requested wave elevation arrays to compute the wave elevations for stretching at ALL node locations. - ! We are going to store the user-requested wave elevation output locations so that we can restore them after we done. - IF (InputFileData%Waves2%NWaveElev > 0) THEN - tmpNWaveElev = InputFileData%Waves2%NWaveElev - CALL MOVE_ALLOC( InputFileData%Waves2%WaveElevxi, tmpWaveElevxi ) ! (from, to) - CALL MOVE_ALLOC( InputFileData%Waves2%WaveElevyi, tmpWaveElevyi ) - END IF - - - ALLOCATE ( InputFileData%Waves2%WaveElevxi(InputFileData%Waves2%NWaveKin), STAT = ErrStat2 ) - IF ( ErrStat2 /= 0 ) THEN - CALL SetErrStat( ErrID_Fatal,'Error allocating space for WaveElevxi array.', ErrStat, ErrMsg, RoutineName) - CALL CleanUp() - RETURN - END IF - ALLOCATE ( InputFileData%Waves2%WaveElevyi(InputFileData%Waves2%NWaveKin), STAT = ErrStat2 ) - IF ( ErrStat2 /= 0 ) THEN - CALL SetErrStat( ErrID_Fatal,'Error allocating space for WaveElevyi array.', ErrStat, ErrMsg, RoutineName) - CALL CleanUp() - RETURN - END IF - - InputFileData%Waves2%NWaveElev = InputFileData%Waves2%NWaveKin - InputFileData%Waves2%WaveElevxi = InputFileData%Waves2%WaveKinxi - InputFileData%Waves2%WaveElevyi = InputFileData%Waves2%WaveKinyi - - CALL Waves2_Init(InputFileData%Waves2, m%u_Waves2, p%Waves2, x%Waves2, xd%Waves2, z%Waves2, OtherState%Waves2, & - y%Waves2, m%Waves2, Interval, InitOut%Waves2, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp() - RETURN - END IF - - - ! Store the wave elevations coming out of the Waves_Init for use in the stretching calculations - WaveElevSt = WaveElevSt + p%Waves2%WaveElev2 - - ! We need to reset the wave elevation arrays - DEALLOCATE(InputFileData%Waves2%WaveElevxi) - DEALLOCATE(InputFileData%Waves2%WaveElevyi) - InputFileData%Waves2%NWaveElev = tmpNWaveElev - - IF (InputFileData%Waves2%NWaveElev > 0) THEN - CALL MOVE_ALLOC( tmpWaveElevxi, InputFileData%Waves2%WaveElevxi ) ! (from, to) - CALL MOVE_ALLOC( tmpWaveElevyi, InputFileData%Waves2%WaveElevyi ) - END IF - - - ALLOCATE ( WaveDynP2D0 (0:Waves_InitOut%NStepWave,InputFileData%Waves%NWaveKin ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveDynP2D0.', ErrStat, ErrMsg, RoutineName) - - ALLOCATE ( WaveVel2D0 (0:Waves_InitOut%NStepWave,InputFileData%Waves%NWaveKin,3), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveVel2D0.', ErrStat, ErrMsg, RoutineName) - - ALLOCATE ( WaveAcc2D0 (0:Waves_InitOut%NStepWave,InputFileData%Waves%NWaveKin,3), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAcc2D0.', ErrStat, ErrMsg, RoutineName) - - ALLOCATE ( WaveDynP2S0 (0:Waves_InitOut%NStepWave,InputFileData%Waves%NWaveKin ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveDynP2S0.', ErrStat, ErrMsg, RoutineName) - - ALLOCATE ( WaveVel2S0 (0:Waves_InitOut%NStepWave,InputFileData%Waves%NWaveKin,3), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveVel2S0.', ErrStat, ErrMsg, RoutineName) - - ALLOCATE ( WaveAcc2S0 (0:Waves_InitOut%NStepWave,InputFileData%Waves%NWaveKin,3), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAcc2S0.', ErrStat, ErrMsg, RoutineName) - - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp() - RETURN - END IF - - ! Copy the init output arrays into the MSL versions - WaveDynP2D0 = InitOut%Waves2%WaveDynP2D - WaveAcc2D0 = InitOut%Waves2%WaveAcc2D - WaveVel2D0 = InitOut%Waves2%WaveVel2D - WaveDynP2S0 = InitOut%Waves2%WaveDynP2S - WaveAcc2S0 = InitOut%Waves2%WaveAcc2S - WaveVel2S0 = InitOut%Waves2%WaveVel2S - - ! Reset the wave kinematics zi locations - InputFileData%Waves2%WaveKinzi = InputFileData%Waves%WaveKinzi - - ! Deallocate arrays which will be re-allocated in the next call to Waves2_Init - DEALLOCATE ( p%Waves2%WaveElev2 ) - DEALLOCATE ( InitOut%Waves2%WaveVel2D ) - DEALLOCATE ( InitOut%Waves2%WaveAcc2D ) - DEALLOCATE ( InitOut%Waves2%WaveDynP2D ) - DEALLOCATE ( InitOut%Waves2%WaveVel2S ) - DEALLOCATE ( InitOut%Waves2%WaveAcc2S ) - DEALLOCATE ( InitOut%Waves2%WaveDynP2S ) - - END IF -!========================================================================== - - - - - - -!FIXME: why is this called again? I'm either not remembering something, or I don't undestand the wave stretching above. -- ADP - CALL Waves2_Init(InputFileData%Waves2, m%u_Waves2, p%Waves2, x%Waves2, xd%Waves2, z%Waves2, OtherState%Waves2, & - y%Waves2, m%Waves2, Interval, InitOut%Waves2, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp() - RETURN - END IF - - ! move arrays back - CALL MOVE_ALLOC(InputFileData%Waves2%WaveTime, p%WaveTime) - CALL MOVE_ALLOC(InputFileData%Waves2%WaveElevC0, Waves_InitOut%WaveElevC0) - CALL MOVE_ALLOC(InputFileData%Waves2%WaveDirArr, Waves_InitOut%WaveDirArr) - - ! Verify that Waves2_Init() did not request a different Interval! - - IF ( p%DT /= Interval ) THEN - CALL SetErrStat(ErrID_Fatal,'Waves2 Module attempted to change timestep interval, but this is not allowed. '// & - ' Waves2 Module must use the HydroDyn Interval.',ErrStat,ErrMsg,RoutineName) - CALL CleanUp() - RETURN - END IF - - - ! If we calculated the wave elevation series data (for visualization purposes), add the second order corrections to the first order. - IF (ALLOCATED(InputFileData%Waves2%WaveElevXY)) THEN - ! Make sure the sizes of the two resulting arrays are identical... - IF ( SIZE(InitOut%WaveElevSeries,DIM=1) /= SIZE(InitOut%Waves2%WaveElevSeries2,DIM=1) .OR. & - SIZE(InitOut%WaveElevSeries,DIM=2) /= SIZE(InitOut%Waves2%WaveElevSeries2,DIM=2)) THEN - CALL SetErrStat(ErrID_Fatal,' WaveElevSeries arrays for first and second order wave elevations are of different sizes.',ErrStat,ErrMsg,RoutineName) - CALL CleanUp() - RETURN - ELSE - DO J=1,SIZE(InitOut%WaveElevSeries,DIM=2) - DO I = 0,p%NStepWave - InitOut%WaveElevSeries(I,J) = InitOut%Waves2%WaveElevSeries2(I,J) + InitOut%WaveElevSeries(I,J) - ENDDO - ENDDO - ENDIF - ENDIF - - ! If we calculated wave elevations, it is now stored in p%WaveElev. So we need to add the corrections. - IF (p%Waves2%NWaveElev > 0 ) THEN - ! Make sure the sizes of the two resulting arrays are identical... - IF ( SIZE(p%WaveElev,DIM=1) /= SIZE(p%Waves2%WaveElev2,DIM=1) .OR. & - SIZE(p%WaveElev,DIM=2) /= SIZE(p%Waves2%WaveElev2,DIM=2)) THEN - CALL SetErrStat(ErrID_Fatal,' WaveElev(NWaveElev) arrays for first and second order wave elevations are of different sizes.',ErrStat,ErrMsg,RoutineName) - CALL CleanUp() - RETURN - ELSE - DO J=1,SIZE(p%Waves2%WaveElev2,DIM=2) - DO I = 0,p%NStepWave - p%WaveElev(I,J) = p%Waves2%WaveElev2(I,J) + p%WaveElev(I,J) - ENDDO - ENDDO - CALL MOVE_ALLOC(p%Waves2%WaveElev2,p%WaveElev2) - ENDIF - ENDIF - - ! The acceleration, velocity, and dynamic pressures will get added to the parts passed to the morrison module later... - - ELSE - ! these need to be set to zero since we don't have a UseWaves2 flag: - p%Waves2%NWaveElev = 0 - p%Waves2%WvDiffQTFF = .FALSE. - p%Waves2%WvSumQTFF = .FALSE. - p%Waves2%NumOuts = 0 - - ENDIF ! InputFileData%Waves2%WvDiffQTFF .OR. InputFileData%Waves2%WvSumQTFF - - - ! Is there a WAMIT body? IF ( InputFileData%PotMod == 1 ) THEN + InputFileData%WAMIT%WaveField => InitInp%WaveField + p%nWAMITObj = InputFileData%nWAMITObj ! All the data for the various WAMIT bodies are stored in a single WAMIT file p%vecMultiplier = InputFileData%vecMultiplier ! Multiply all vectors and matrices row/column lengths by NBody InputFileData%WAMIT%NBodyMod = InputFileData%NBodyMod InputFileData%WAMIT%Gravity = InitInp%Gravity - InputFileData%WAMIT%WtrDpth = InputFileData%Morison%WtrDpth ! The data in InputFileData%Morison%WtrDpth was directly placed there when we parsed the HydroDyn input file + InputFileData%WAMIT%PlatformPos = InitInp%PlatformPos ! Initial platform/HD origin position p%NBody = InputFileData%NBody p%NBodyMod = InputFileData%NBodyMod - call AllocAry( m%F_PtfmAdd, 6*InputFileData%NBody, "m%F_PtfmAdd", ErrStat2, ErrMsg2 ); call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) call AllocAry( m%F_Waves , 6*InputFileData%NBody, "m%F_Waves" , ErrStat2, ErrMsg2 ); call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -892,7 +318,6 @@ SUBROUTINE HydroDyn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, I allocate( y%WAMIT( 1), stat = ErrStat2 ); if (ErrStat2 /=0) call SetErrStat( ErrID_Fatal, 'Failed to allocate array y%WAMIT.', ErrStat, ErrMsg, RoutineName ) allocate( m%WAMIT( 1), stat = ErrStat2 ); if (ErrStat2 /=0) call SetErrStat( ErrID_Fatal, 'Failed to allocate array m%WAMIT.', ErrStat, ErrMsg, RoutineName ) allocate( m%u_WAMIT( 1), stat = ErrStat2 ); if (ErrStat2 /=0) call SetErrStat( ErrID_Fatal, 'Failed to allocate array m%u_WAMIT.', ErrStat, ErrMsg, RoutineName ) - allocate( InitOut%WAMIT( 1), stat = ErrStat2 ); if (ErrStat2 /=0) call SetErrStat( ErrID_Fatal, 'Failed to allocate array InitOut%WAMIT.', ErrStat, ErrMsg, RoutineName ) InputFileData%WAMIT%PtfmVol0 = InputFileData%PtfmVol0 InputFileData%WAMIT%WAMITULEN = InputFileData%WAMITULEN(1) @@ -920,7 +345,6 @@ SUBROUTINE HydroDyn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, I allocate( y%WAMIT( InputFileData%NBody), stat = ErrStat2 ); if (ErrStat2 /=0) call SetErrStat( ErrID_Fatal, 'Failed to allocate array y%WAMIT.', ErrStat, ErrMsg, RoutineName ) allocate( m%WAMIT( InputFileData%NBody), stat = ErrStat2 ); if (ErrStat2 /=0) call SetErrStat( ErrID_Fatal, 'Failed to allocate array m%WAMIT.', ErrStat, ErrMsg, RoutineName ) allocate( m%u_WAMIT( InputFileData%NBody), stat = ErrStat2 ); if (ErrStat2 /=0) call SetErrStat( ErrID_Fatal, 'Failed to allocate array m%u_WAMIT.', ErrStat, ErrMsg, RoutineName ) - allocate( InitOut%WAMIT( InputFileData%NBody), stat = ErrStat2 ); if (ErrStat2 /=0) call SetErrStat( ErrID_Fatal, 'Failed to allocate array InitOut%WAMIT.', ErrStat, ErrMsg, RoutineName ) InputFileData%WAMIT%PtfmVol0 (1) = InputFileData%PtfmVol0 (1) InputFileData%WAMIT%WAMITULEN = InputFileData%WAMITULEN (1) InputFileData%WAMIT%PtfmRefxt (1) = InputFileData%PtfmRefxt (1) @@ -937,26 +361,9 @@ SUBROUTINE HydroDyn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, I return end if - ! Copy Waves initialization output into the initialization input type for the WAMIT module - - InputFileData%WAMIT%RhoXg = Waves_InitOut%RhoXg - InputFileData%WAMIT%NStepWave = Waves_InitOut%NStepWave - InputFileData%WAMIT%NStepWave2 = Waves_InitOut%NStepWave2 - InputFileData%WAMIT%WaveDirMin = Waves_InitOut%WaveDirMin - InputFileData%WAMIT%WaveDirMax = Waves_InitOut%WaveDirMax - InputFileData%WAMIT%WaveDOmega = Waves_InitOut%WaveDOmega - - ! Init inputs for the SS_Excitation model (set this just in case it will be used) - InputFileData%WAMIT%WaveDir = Waves_InitOut%WaveDir - CALL MOVE_ALLOC(Waves_InitOut%WaveElev0, InputFileData%WAMIT%WaveElev0) - - ! Temporarily move arrays to init input for WAMIT (save some space) - CALL MOVE_ALLOC(p%WaveTime, InputFileData%WAMIT%WaveTime) - CALL MOVE_ALLOC(Waves_InitOut%WaveElevC0, InputFileData%WAMIT%WaveElevC0) - CALL MOVE_ALLOC(Waves_InitOut%WaveDirArr, InputFileData%WAMIT%WaveDirArr) - + CALL WAMIT_Init(InputFileData%WAMIT, m%u_WAMIT(1), p%WAMIT(1), x%WAMIT(1), xd%WAMIT(1), z%WAMIT, OtherState%WAMIT(1), & - y%WAMIT(1), m%WAMIT(1), Interval, InitOut%WAMIT(1), ErrStat2, ErrMsg2 ) + y%WAMIT(1), m%WAMIT(1), Interval, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) IF ( ErrStat >= AbortErrLev ) THEN CALL CleanUp() @@ -980,7 +387,7 @@ SUBROUTINE HydroDyn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, I InputFileData%WAMIT%PtfmCOByt (1) = InputFileData%PtfmCOByt (i) CALL WAMIT_Init(InputFileData%WAMIT, m%u_WAMIT(i), p%WAMIT(i), x%WAMIT(i), xd%WAMIT(i), z%WAMIT, OtherState%WAMIT(i), & - y%WAMIT(i), m%WAMIT(i), Interval, InitOut%WAMIT(i), ErrStat2, ErrMsg2 ) + y%WAMIT(i), m%WAMIT(i), Interval, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) IF ( ErrStat >= AbortErrLev ) THEN CALL CleanUp() @@ -1001,25 +408,10 @@ SUBROUTINE HydroDyn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, I WRITE( InputFileData%UnSum, '(A81)' ) 'Buoyancy loads from members modelled with WAMIT, summed about ( 0.0, 0.0, 0.0 )' WRITE( InputFileData%UnSum, '(18x,6(2X,A20))' ) ' BuoyFxi ', ' BuoyFyi ', ' BuoyFzi ', ' BuoyMxi ', ' BuoyMyi ', ' BuoyMzi ' WRITE( InputFileData%UnSum, '(18x,6(2X,A20))' ) ' (N) ', ' (N) ', ' (N) ', ' (N-m) ', ' (N-m) ', ' (N-m) ' - WRITE( InputFileData%UnSum, '(A18,6(2X,ES20.6))') ' External: ',0.0,0.0,InputFileData%WAMIT%RhoXg*InputFileData%PtfmVol0(iBody),InputFileData%WAMIT%RhoXg*InputFileData%PtfmVol0(iBody)*InputFileData%PtfmCOByt(iBody), -InputFileData%WAMIT%RhoXg*InputFileData%PtfmVol0(iBody)*InputFileData%PtfmCOBxt(iBody), 0.0 ! and the moment about Y due to the COB being offset from the WAMIT reference point + WRITE( InputFileData%UnSum, '(A18,6(2X,ES20.6))') ' External: ',0.0,0.0,p%WaveField%RhoXg*InputFileData%PtfmVol0(iBody),p%WaveField%RhoXg*InputFileData%PtfmVol0(iBody)*InputFileData%PtfmCOByt(iBody), -p%WaveField%RhoXg*InputFileData%PtfmVol0(iBody)*InputFileData%PtfmCOBxt(iBody), 0.0 ! and the moment about Y due to the COB being offset from the WAMIT reference point end do END IF - - - ! Verify that WAMIT_Init() did not request a different Interval! - - IF ( p%DT /= Interval ) THEN - CALL SetErrStat(ErrID_Fatal,'WAMIT Module attempted to change timestep interval, but this is not allowed. WAMIT Module must use the HydroDyn Interval.',ErrStat,ErrMsg,RoutineName) - CALL CleanUp() - RETURN - END IF - - ! move arrays back - CALL MOVE_ALLOC(InputFileData%WAMIT%WaveTime, p%WaveTime ) - CALL MOVE_ALLOC(InputFileData%WAMIT%WaveElevC0, Waves_InitOut%WaveElevC0) - CALL MOVE_ALLOC(InputFileData%WAMIT%WaveDirArr, Waves_InitOut%WaveDirArr) - !----------------------------------------- ! Initialize the WAMIT2 Calculations @@ -1031,20 +423,8 @@ SUBROUTINE HydroDyn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, I ! Flag required for indicating when to try using arrays that are allocated p%WAMIT2used = .TRUE. - ! Temporarily move arrays to init input for WAMIT2 (save some space) - CALL MOVE_ALLOC(p%WaveTime, InputFileData%WAMIT2%WaveTime) - CALL MOVE_ALLOC(Waves_InitOut%WaveElevC0, InputFileData%WAMIT2%WaveElevC0) - CALL MOVE_ALLOC(Waves_InitOut%WaveDirArr, InputFileData%WAMIT2%WaveDirArr) - ! Copy Waves initialization output into the initialization input type for the WAMIT module - InputFileData%WAMIT2%RhoXg = Waves_InitOut%RhoXg - InputFileData%WAMIT2%NStepWave = Waves_InitOut%NStepWave - InputFileData%WAMIT2%NStepWave2 = Waves_InitOut%NStepWave2 - InputFileData%WAMIT2%WaveDirMin = Waves_InitOut%WaveDirMin - InputFileData%WAMIT2%WaveDirMax = Waves_InitOut%WaveDirMax - InputFileData%WAMIT2%WaveDOmega = Waves_InitOut%WaveDOmega InputFileData%WAMIT2%Gravity = InitInp%Gravity - InputFileData%WAMIT2%WtrDpth = InputFileData%Morison%WtrDpth ! The data in InputFileData%Morison%WtrDpth was directly placed there when we parsed the HydroDyn input file ! Set values for all NBodyMods InputFileData%WAMIT2%NBodyMod = InputFileData%NBodyMod ! There are restrictions in WAMIT2 on which files may be used for MnDriftF or NewmanAppF for BodyMod > 1 @@ -1060,13 +440,8 @@ SUBROUTINE HydroDyn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, I call AllocAry( InputFileData%WAMIT2%PtfmRefzt , InputFileData%NBody, "PtfmRefzt" , ErrStat2, ErrMsg2 ); call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) call AllocAry( InputFileData%WAMIT2%PtfmRefztRot, InputFileData%NBody, "PtfmRefztRot", ErrStat2, ErrMsg2 ); call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) allocate( p%WAMIT2( 1), stat = ErrStat2 ); if (ErrStat2 /=0) call SetErrStat( ErrID_Fatal, 'Failed to allocate array p%WAMIT2.', ErrStat, ErrMsg, RoutineName ) - allocate( x%WAMIT2( 1), stat = ErrStat2 ); if (ErrStat2 /=0) call SetErrStat( ErrID_Fatal, 'Failed to allocate array x%WAMIT2.', ErrStat, ErrMsg, RoutineName ) - allocate( xd%WAMIT2( 1), stat = ErrStat2 ); if (ErrStat2 /=0) call SetErrStat( ErrID_Fatal, 'Failed to allocate array xd%WAMIT2.', ErrStat, ErrMsg, RoutineName ) - allocate( OtherState%WAMIT2(1), stat = ErrStat2 ); if (ErrStat2 /=0) call SetErrStat( ErrID_Fatal, 'Failed to allocate array OtherState%WAMIT2.', ErrStat, ErrMsg, RoutineName ) allocate( y%WAMIT2( 1), stat = ErrStat2 ); if (ErrStat2 /=0) call SetErrStat( ErrID_Fatal, 'Failed to allocate array y%WAMIT2.', ErrStat, ErrMsg, RoutineName ) allocate( m%WAMIT2( 1), stat = ErrStat2 ); if (ErrStat2 /=0) call SetErrStat( ErrID_Fatal, 'Failed to allocate array m%WAMIT2.', ErrStat, ErrMsg, RoutineName ) - allocate( m%u_WAMIT2( 1), stat = ErrStat2 ); if (ErrStat2 /=0) call SetErrStat( ErrID_Fatal, 'Failed to allocate array m%u_WAMIT2.', ErrStat, ErrMsg, RoutineName ) - allocate( InitOut%WAMIT2( 1), stat = ErrStat2 ); if (ErrStat2 /=0) call SetErrStat( ErrID_Fatal, 'Failed to allocate array InitOut%WAMIT2.', ErrStat, ErrMsg, RoutineName ) InputFileData%WAMIT2%PtfmRefxt = InputFileData%PtfmRefxt InputFileData%WAMIT2%PtfmRefyt = InputFileData%PtfmRefyt InputFileData%WAMIT2%PtfmRefzt = InputFileData%PtfmRefzt @@ -1081,13 +456,8 @@ SUBROUTINE HydroDyn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, I call AllocAry( InputFileData%WAMIT2%PtfmRefzt , 1, "PtfmRefzt" , ErrStat2, ErrMsg2 ); call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) call AllocAry( InputFileData%WAMIT2%PtfmRefztRot, 1, "PtfmRefztRot", ErrStat2, ErrMsg2 ); call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) allocate( p%WAMIT2( InputFileData%NBody), stat = ErrStat2 ); if (ErrStat2 /=0) call SetErrStat( ErrID_Fatal, 'Failed to allocate array p%WAMIT2.', ErrStat, ErrMsg, RoutineName ) - allocate( x%WAMIT2( InputFileData%NBody), stat = ErrStat2 ); if (ErrStat2 /=0) call SetErrStat( ErrID_Fatal, 'Failed to allocate array x%WAMIT2.', ErrStat, ErrMsg, RoutineName ) - allocate( xd%WAMIT2( InputFileData%NBody), stat = ErrStat2 ); if (ErrStat2 /=0) call SetErrStat( ErrID_Fatal, 'Failed to allocate array xd%WAMIT2.', ErrStat, ErrMsg, RoutineName ) - allocate( OtherState%WAMIT2(InputFileData%NBody), stat = ErrStat2 ); if (ErrStat2 /=0) call SetErrStat( ErrID_Fatal, 'Failed to allocate array OtherState%WAMIT2.', ErrStat, ErrMsg, RoutineName ) allocate( y%WAMIT2( InputFileData%NBody), stat = ErrStat2 ); if (ErrStat2 /=0) call SetErrStat( ErrID_Fatal, 'Failed to allocate array y%WAMIT2.', ErrStat, ErrMsg, RoutineName ) allocate( m%WAMIT2( InputFileData%NBody), stat = ErrStat2 ); if (ErrStat2 /=0) call SetErrStat( ErrID_Fatal, 'Failed to allocate array m%WAMIT2.', ErrStat, ErrMsg, RoutineName ) - allocate( m%u_WAMIT2( InputFileData%NBody), stat = ErrStat2 ); if (ErrStat2 /=0) call SetErrStat( ErrID_Fatal, 'Failed to allocate array m%u_WAMIT2.', ErrStat, ErrMsg, RoutineName ) - allocate( InitOut%WAMIT2( InputFileData%NBody), stat = ErrStat2 ); if (ErrStat2 /=0) call SetErrStat( ErrID_Fatal, 'Failed to allocate array InitOut%WAMIT2.', ErrStat, ErrMsg, RoutineName ) InputFileData%WAMIT2%PtfmRefxt (1) = InputFileData%PtfmRefxt (1) InputFileData%WAMIT2%PtfmRefyt (1) = InputFileData%PtfmRefyt (1) InputFileData%WAMIT2%PtfmRefzt (1) = InputFileData%PtfmRefzt (1) @@ -1100,8 +470,7 @@ SUBROUTINE HydroDyn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, I return end if - CALL WAMIT2_Init(InputFileData%WAMIT2, m%u_WAMIT2(1), p%WAMIT2(1), x%WAMIT2(1), xd%WAMIT2(1), z%WAMIT2, OtherState%WAMIT2(1), & - y%WAMIT2(1), m%WAMIT2(1), Interval, InitOut%WAMIT2(1), ErrStat2, ErrMsg2 ) + CALL WAMIT2_Init(InputFileData%WAMIT2, p%WAMIT2(1), y%WAMIT2(1), m%WAMIT2(1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) IF ( ErrStat >= AbortErrLev ) THEN CALL CleanUp() @@ -1117,8 +486,7 @@ SUBROUTINE HydroDyn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, I InputFileData%WAMIT2%PtfmRefzt (1) = InputFileData%PtfmRefzt (i) InputFileData%WAMIT2%PtfmRefztRot(1) = InputFileData%PtfmRefztRot(i) - CALL WAMIT2_Init(InputFileData%WAMIT2, m%u_WAMIT2(i), p%WAMIT2(i), x%WAMIT2(i), xd%WAMIT2(i), z%WAMIT2, OtherState%WAMIT2(i), & - y%WAMIT2(i), m%WAMIT2(i), Interval, InitOut%WAMIT2(i), ErrStat2, ErrMsg2 ) + CALL WAMIT2_Init(InputFileData%WAMIT2, p%WAMIT2(i), y%WAMIT2(i), m%WAMIT2(i), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) IF ( ErrStat >= AbortErrLev ) THEN CALL CleanUp() @@ -1127,21 +495,6 @@ SUBROUTINE HydroDyn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, I end do - ! move arrays back - CALL MOVE_ALLOC(InputFileData%WAMIT2%WaveTime, p%WaveTime ) - CALL MOVE_ALLOC(InputFileData%WAMIT2%WaveElevC0, Waves_InitOut%WaveElevC0) - CALL MOVE_ALLOC(InputFileData%WAMIT2%WaveDirArr, Waves_InitOut%WaveDirArr) - - - ! Verify that WAMIT2_Init() did not request a different Interval! - - IF ( p%DT /= Interval ) THEN - CALL SetErrStat(ErrID_Fatal,'WAMIT2 Module attempted to change timestep interval, but this is not allowed. '// & - 'WAMIT2 Module must use the HydroDyn Interval.',ErrStat,ErrMsg,RoutineName) - CALL CleanUp() - RETURN - END IF - ELSE ! Flag used in output handling to indicate when to ignore WAMIT2 outputs. p%WAMIT2used = .FALSE. @@ -1159,14 +512,14 @@ SUBROUTINE HydroDyn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, I ! General FITInitData%InputFile = InputFileData%PotFile FITInitData%Gravity = InputFileData%Gravity - FITInitData%Rho = InputFileData%Waves%WtrDens + FITInitData%Rho = p%WaveField%WtrDens FITInitData%time_end = InitInp%TMax - FITInitData%dtime = InputFileData%Waves%WaveDT ! Set the FIT module's timestep equal to the WaveDT timestep, this was checked earlier to make sure it is an integer muliple of the glue-code timestep! + FITInitData%dtime = InitInp%WaveDT ! Set the FIT module's timestep equal to the WaveDT timestep, this was checked earlier to make sure it is an integer muliple of the glue-code timestep! ! Waves ! Need to pre-process the incoming wave data to be compatible with FIT - FITInitData%N_omega = Waves_InitOut%NStepWave2 - FITInitData%Wave_angle = Waves_InitOut%WaveDir + FITInitData%N_omega = p%WaveField%NStepWave2 + FITInitData%Wave_angle = p%WaveField%WaveDir ! allocate waves data arrays for FIT CALL AllocAry( FITInitData%Wave_amp, FITInitData%N_omega, "Wave_amp", ErrStat2, ErrMsg2 ) @@ -1182,15 +535,15 @@ SUBROUTINE HydroDyn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, I RETURN END IF - ! Populate wave arrays - Np = 2*(Waves_InitOut%WaveDOmega + 1) - DO I = 1 , Waves_InitOut%NStepWave2 + ! Populate wave arrays (Need to double chech this part. It doesn't look right!) + Np = 2*(p%WaveField%WaveDOmega + 1) + DO I = 1 , p%WaveField%NStepWave2 - dftreal = Waves_InitOut%WaveElevC0( 1,ABS(I ) ) - dftimag = Waves_InitOut%WaveElevC0( 2, ABS(I ) )*SIGN(1,I) + dftreal = p%WaveField%WaveElevC0( 1, ABS(I ) ) + dftimag = p%WaveField%WaveElevC0( 2, ABS(I ) )*SIGN(1,I) FITInitData%Wave_amp (I) = sqrt( dftreal**2 + dftimag**2 ) * 2.0 / Np - FITInitData%Wave_omega (I) = I*Waves_InitOut%WaveDOmega - FITInitData%Wave_number(I) = I*Waves_InitOut%WaveDOmega**2. / InputFileData%Gravity + FITInitData%Wave_omega (I) = I*p%WaveField%WaveDOmega + FITInitData%Wave_number(I) = I*p%WaveField%WaveDOmega**2. / InputFileData%Gravity FITInitData%Wave_phase (I) = atan2( dftimag, dftreal ) END DO @@ -1206,172 +559,9 @@ SUBROUTINE HydroDyn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, I END IF - - END IF ! Check for WaveMod = 6 - - - ! Are there Morison elements? - + ! Are there Morison elements? IF ( InputFileData%Morison%NMembers > 0 ) THEN - - - ! Copy Waves initialization output into the initialization input type for the Morison module - - InputFileData%Morison%NStepWave = Waves_InitOut%NStepWave - - - ! Temporarily move array to init input for Morison (save some space) - CALL MOVE_ALLOC( p%WaveTime, InputFileData%Morison%WaveTime ) - - ! Permanently move these wave values to Morison init input (and note they are potentially modified by 2nd order stuff before being sent to Morison) - CALL MOVE_ALLOC( Waves_InitOut%WaveAcc, InputFileData%Morison%WaveAcc ) - CALL MOVE_ALLOC( Waves_InitOut%WaveDynP, InputFileData%Morison%WaveDynP ) - CALL MOVE_ALLOC( Waves_InitOut%WaveVel, InputFileData%Morison%WaveVel ) - CALL MOVE_ALLOC( Waves_InitOut%nodeInWater,InputFileData%Morison%nodeInWater ) ! moved to Morison%p%nodeInWater in the init routine - - - ! If we did some second order wave kinematics corrections to the acceleration, velocity or - ! dynamic pressure using the Waves2 module, then we need to add these to the values that we - ! will be passing into the Morrison module. - - ! Difference frequency results - IF ( p%Waves2%WvDiffQTFF ) THEN - - ! Dynamic pressure -- difference frequency terms - IF ( SIZE(InputFileData%Morison%WaveDynP,DIM=1) /= SIZE(InitOut%Waves2%WaveDynP2D,DIM=1) .OR. & - SIZE(InputFileData%Morison%WaveDynP,DIM=2) /= SIZE(InitOut%Waves2%WaveDynP2D,DIM=2)) THEN - CALL SetErrStat(ErrID_Fatal, & - ' WaveDynP arrays for first and second order wave elevations are of different sizes. '//NewLine// & - 'Morrison: '// TRIM(Num2LStr(SIZE(InputFileData%Morison%WaveDynP,DIM=1)))//'x'// & - TRIM(Num2LStr(SIZE(InputFileData%Morison%WaveDynP,DIM=2)))//NewLine// & - 'Waves2: '// TRIM(Num2LStr(SIZE(InitOut%Waves2%WaveDynP2D,DIM=1)))//'x'// & - TRIM(Num2LStr(SIZE(InitOut%Waves2%WaveDynP2D,DIM=2))), & - ErrStat,ErrMsg,RoutineName) - CALL CleanUp() - RETURN - ELSE - InputFileData%Morison%WaveDynP = InputFileData%Morison%WaveDynP + InitOut%Waves2%WaveDynP2D - IF (InputFileData%Waves%WaveStMod > 0 ) WaveDynP0 = WaveDynP0 + WaveDynP2D0 - ENDIF - - ! Particle velocity -- difference frequency terms - IF ( SIZE(InputFileData%Morison%WaveVel,DIM=1) /= SIZE(InitOut%Waves2%WaveVel2D,DIM=1) .OR. & - SIZE(InputFileData%Morison%WaveVel,DIM=2) /= SIZE(InitOut%Waves2%WaveVel2D,DIM=2) .OR. & - SIZE(InputFileData%Morison%WaveVel,DIM=3) /= SIZE(InitOut%Waves2%WaveVel2D,DIM=3)) THEN - CALL SetErrStat(ErrID_Fatal, & - ' WaveVel arrays for first and second order wave elevations are of different sizes.',ErrStat,ErrMsg,RoutineName) - CALL CleanUp() - RETURN - ELSE - InputFileData%Morison%WaveVel = InputFileData%Morison%WaveVel + InitOut%Waves2%WaveVel2D - IF (InputFileData%Waves%WaveStMod > 0 ) WaveVel0 = WaveVel0 + WaveVel2D0 - ENDIF - - - ! Particle acceleration -- difference frequency terms - IF ( SIZE(InputFileData%Morison%WaveAcc,DIM=1) /= SIZE(InitOut%Waves2%WaveAcc2D,DIM=1) .OR. & - SIZE(InputFileData%Morison%WaveAcc,DIM=2) /= SIZE(InitOut%Waves2%WaveAcc2D,DIM=2) .OR. & - SIZE(InputFileData%Morison%WaveAcc,DIM=3) /= SIZE(InitOut%Waves2%WaveAcc2D,DIM=3)) THEN - CALL SetErrStat(ErrID_Fatal, & - ' WaveAcc arrays for first and second order wave elevations are of different sizes.',ErrStat,ErrMsg,RoutineName) - CALL CleanUp() - RETURN - ELSE - InputFileData%Morison%WaveAcc = InputFileData%Morison%WaveAcc + InitOut%Waves2%WaveAcc2D - IF (InputFileData%Waves%WaveStMod > 0 ) WaveAcc0 = WaveAcc0 + WaveAcc2D0 - ENDIF - - ENDIF ! second order wave kinematics difference frequency results - - ! Sum frequency results - IF ( p%Waves2%WvSumQTFF ) THEN - - ! Dynamic pressure -- sum frequency terms - IF ( SIZE(InputFileData%Morison%WaveDynP,DIM=1) /= SIZE(InitOut%Waves2%WaveDynP2S,DIM=1) .OR. & - SIZE(InputFileData%Morison%WaveDynP,DIM=2) /= SIZE(InitOut%Waves2%WaveDynP2S,DIM=2)) THEN - CALL SetErrStat(ErrID_Fatal, & - ' WaveDynP arrays for first and second order wave elevations are of different sizes. '//NewLine// & - 'Morrison: '// TRIM(Num2LStr(SIZE(InputFileData%Morison%WaveDynP,DIM=1)))//'x'// & - TRIM(Num2LStr(SIZE(InputFileData%Morison%WaveDynP,DIM=2)))//NewLine// & - 'Waves2: '// TRIM(Num2LStr(SIZE(InitOut%Waves2%WaveDynP2D,DIM=1)))//'x'// & - TRIM(Num2LStr(SIZE(InitOut%Waves2%WaveDynP2D,DIM=2))), & - ErrStat,ErrMsg,RoutineName) - CALL CleanUp() - RETURN - ELSE - InputFileData%Morison%WaveDynP = InputFileData%Morison%WaveDynP + InitOut%Waves2%WaveDynP2S - IF (InputFileData%Waves%WaveStMod > 0 ) WaveDynP0 = WaveDynP0 + WaveDynP2S0 - ENDIF - - ! Particle velocity -- sum frequency terms - IF ( SIZE(InputFileData%Morison%WaveVel,DIM=1) /= SIZE(InitOut%Waves2%WaveVel2S,DIM=1) .OR. & - SIZE(InputFileData%Morison%WaveVel,DIM=2) /= SIZE(InitOut%Waves2%WaveVel2S,DIM=2) .OR. & - SIZE(InputFileData%Morison%WaveVel,DIM=3) /= SIZE(InitOut%Waves2%WaveVel2S,DIM=3)) THEN - CALL SetErrStat(ErrID_Fatal, & - ' WaveVel arrays for first and second order wave elevations are of different sizes.',ErrStat,ErrMsg,RoutineName) - CALL CleanUp() - RETURN - ELSE - InputFileData%Morison%WaveVel = InputFileData%Morison%WaveVel + InitOut%Waves2%WaveVel2S - IF (InputFileData%Waves%WaveStMod > 0 ) WaveVel0 = WaveVel0 + WaveVel2S0 - ENDIF - - ! Particle velocity -- sum frequency terms - IF ( SIZE(InputFileData%Morison%WaveAcc,DIM=1) /= SIZE(InitOut%Waves2%WaveAcc2S,DIM=1) .OR. & - SIZE(InputFileData%Morison%WaveAcc,DIM=2) /= SIZE(InitOut%Waves2%WaveAcc2S,DIM=2) .OR. & - SIZE(InputFileData%Morison%WaveAcc,DIM=3) /= SIZE(InitOut%Waves2%WaveAcc2S,DIM=3)) THEN - CALL SetErrStat(ErrID_Fatal, & - ' WaveAcc arrays for first and second order wave elevations are of different sizes.',ErrStat,ErrMsg,RoutineName) - CALL CleanUp() - RETURN - ELSE - InputFileData%Morison%WaveAcc = InputFileData%Morison%WaveAcc + InitOut%Waves2%WaveAcc2S - IF (InputFileData%Waves%WaveStMod > 0 ) WaveAcc0 = WaveAcc0 + WaveAcc2S0 - ENDIF - - ENDIF ! second order wave kinematics sum frequency results - -!============================================================================== - ! TODO: 1/29/2016 GJH - ! This is where we need to perform Wave Stretching, now that the wave kinematics have been combined. - ! We will call a new subroutine to perform this work. - ! As an input, this code needs the kinematics at the (X,Y,0) location which in a Z-line above/below all the nodes where kinematics are computed. - ! This code will alter the kinematics for stretching AND alter the nodeInWater array based on the combined wave elevation information - IF (InputFileData%Waves%WaveStMod > 0 ) THEN - call WvStretch_Init( InputFileData%Waves%WaveStMod, InputFileData%Waves%WtrDpth, InputFileData%Morison%NStepWave, InputFileData%Morison%NNodes, & - p%NWaveElev, WaveElevSt, InputFileData%Waves%WaveKinzi, InputFileData%Morison%WaveTime, & - WaveVel0, WaveAcc0, WaveDynP0, & - Waves_InitOut%PWaveVel0, Waves_InitOut%PWaveAcc0, Waves_InitOut%PWaveDynP0, & - InputFileData%Morison%WaveVel, InputFileData%Morison%WaveAcc, InputFileData%Morison%WaveDynP, & - InputFileData%Morison%nodeInWater, ErrStat, ErrMsg ) - DEALLOCATE(WaveElevSt) - DEALLOCATE(WaveVel0) - DEALLOCATE(WaveAcc0) - DEALLOCATE(WaveDynP0) - END IF -!============================================================================== - ! In this version, this can only be TRUE if the precomiler flag WRITE_WV_KIN set and WaveMod not equal to 5 or 6 and WvKinFile is a valid string - IF ( ( InputFileData%Waves%WaveMod == 5 .OR. InputFileData%Waves%WaveMod == 6 ) .AND. InputFileData%Echo ) THEN - call HDOut_WriteWvKinFiles( TRIM(InputFileData%Waves%WvKinFile)//'_ech', HydroDyn_ProgDesc, InputFileData%Morison%NStepWave, InputFileData%Morison%NNodes, & - p%NWaveElev, InputFileData%Morison%nodeInWater, p%WaveElev, InputFileData%Waves%WaveKinzi, InputFileData%Morison%WaveTime, & - InputFileData%Morison%WaveVel, InputFileData%Morison%WaveAcc, InputFileData%Morison%WaveDynP, & - ErrStat, ErrMsg ) - ELSE IF (InputFileData%Waves%WriteWvKin ) THEN - call HDOut_WriteWvKinFiles( TRIM(InputFileData%Waves%WvKinFile), HydroDyn_ProgDesc, InputFileData%Morison%NStepWave, InputFileData%Morison%NNodes, & - p%NWaveElev, InputFileData%Morison%nodeInWater, p%WaveElev, InputFileData%Waves%WaveKinzi, InputFileData%Morison%WaveTime, & - InputFileData%Morison%WaveVel, InputFileData%Morison%WaveAcc, InputFileData%Morison%WaveDynP, & - ErrStat, ErrMsg ) - END IF - - - ! Check the output switch to see if Morison is needing to send outputs back to HydroDyn via the WriteOutput array - - IF ( InputFileData%OutSwtch > 0 ) THEN - InputFileData%Morison%OutSwtch = 2 ! only HydroDyn or the Driver code will write outputs to the file, that's why we are forcing this to 2. - ELSE - InputFileData%Morison%OutSwtch = 0 - END IF - + ! Were visualization meshes requested? InputFileData%Morison%VisMeshes = p%VisMeshes @@ -1384,62 +574,13 @@ SUBROUTINE HydroDyn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, I RETURN END IF - ! move array back - CALL MOVE_ALLOC( InputFileData%Morison%WaveTime, p%WaveTime ) - - - IF ( u%Morison%Mesh%Committed ) THEN - ! we need the translation displacement mesh for loads transfer: - CALL MeshCopy ( SrcMesh = u%Morison%Mesh & - , DestMesh = m%MrsnMesh_position & - , CtrlCode = MESH_NEWCOPY & - , IOS = COMPONENT_INPUT & - , TranslationDisp = .TRUE. & - , ErrStat = ErrStat2 & - , ErrMess = ErrMsg2 ) ! automatically sets DestMesh%RemapFlag = .TRUE. - - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'HydroDyn_Init:m%MrsnMesh_position') - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp() - RETURN - END IF - m%MrsnMesh_position%TranslationDisp = 0.0 ! bjj: this is actually initialized in the ModMesh module, but I'll do it here anyway. - - END IF - - ! Verify that Morison_Init() did not request a different Interval! - - IF ( p%DT /= Interval ) THEN - CALL SetErrStat(ErrID_Fatal,'Morison Module attempted to change timestep interval, but this is not allowed. Morison Module must use the HydroDyn Interval.',ErrStat,ErrMsg,RoutineName) - CALL CleanUp() - RETURN - END IF - - END IF ! ( InputFileData%Morison%NMembers > 0 ) + END IF ! Has Morison elements !=============================================== p%PotMod = InputFileData%Potmod IF ( InputFileData%UnSum > 0 ) THEN - IF (InputFileData%Waves%WaveMod /= 0 .AND. InputFileData%Waves%WaveMod /= 6) THEN - ! Write the header for this section - WRITE( InputFileData%UnSum, '(//)' ) - WRITE( InputFileData%UnSum, '(1X,A15)' ) 'Wave Kinematics' - WRITE( InputFileData%UnSum, '(/)' ) - WRITE( InputFileData%UnSum, '(1X,A10,2X,A14,2X,A14,2X,A14,2X,A19,2X,A19)' ) & - ' m ', ' k ', ' Omega[m] ', ' Direction ', 'REAL(DFT{WaveElev})','IMAG(DFT{WaveElev})' - WRITE( InputFileData%UnSum, '(1X,A10,2X,A14,2X,A14,2X,A14,2X,A19,2X,A19)' ) & - ' (-) ', ' (1/m) ', ' (rad/s) ', ' (deg) ', ' (m) ',' (m) ' - - ! Write the data - DO I = -1*Waves_InitOut%NStepWave2+1,Waves_InitOut%NStepWave2 - WaveNmbr = WaveNumber ( I*Waves_InitOut%WaveDOmega, InitInp%Gravity, InputFileData%Waves%WtrDpth ) - WRITE( InputFileData%UnSum, '(1X,I10,2X,ES14.5,2X,ES14.5,2X,ES14.5,2X,ES14.5,7X,ES14.5)' ) I, WaveNmbr, I*Waves_InitOut%WaveDOmega, & - Waves_InitOut%WaveDirArr(ABS(I)), Waves_InitOut%WaveElevC0( 1,ABS(I ) ) , Waves_InitOut%WaveElevC0( 2, ABS(I ) )*SIGN(1,I) - END DO - END IF - - + IF ( InputFileData%PotMod == 1 .AND. InputFileData%WAMIT%RdtnMod == 1) THEN ! Write the header for this section: Note: When NBodyMod = 1 the kernel is now 6*NBody by 6*Nbody in size, ! and we have NBody 6 by 6 kernels for NBodyMod=2 or 3 @@ -1515,15 +656,6 @@ SUBROUTINE HydroDyn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, I !========================================== - ! Deallocate any remaining Waves Output data - IF(ALLOCATED( Waves_InitOut%WaveElevC0 )) DEALLOCATE( Waves_InitOut%WaveElevC0 ) - IF(ALLOCATED( Waves_InitOut%WaveAcc )) DEALLOCATE( Waves_InitOut%WaveAcc ) - IF(ALLOCATED( Waves_InitOut%WaveDynP )) DEALLOCATE( Waves_InitOut%WaveDynP ) - IF(ALLOCATED( Waves_InitOut%WaveTime )) DEALLOCATE( Waves_InitOut%WaveTime ) - IF(ALLOCATED( Waves_InitOut%WaveVel )) DEALLOCATE( Waves_InitOut%WaveVel ) - IF(ALLOCATED( Waves_InitOut%WaveElevC0 )) DEALLOCATE( Waves_InitOut%WaveElevC0 ) - !IF(ALLOCATED( InputFileData%WAMIT%WaveElevC0 )) DEALLOCATE( InputFileData%WAMIT%WaveElevC0) - ! Close the summary file IF ( InputFileData%HDSum ) THEN CALL HDOut_CloseSum( InputFileData%UnSum, ErrStat2, ErrMsg2 ) @@ -1675,15 +807,14 @@ SUBROUTINE HydroDyn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, I END IF m%AllHdroOrigin%RemapFlag = .TRUE. - ! Create the Output file if requested + ! Set some more parameters p%OutSwtch = InputFileData%OutSwtch p%Delim = '' - !p%Morison%Delim = p%Delim ! Need to set this from within Morison to follow framework - !p%WAMIT%Delim = p%Delim ! Need to set this from within Morison to follow framework p%OutFmt = InputFileData%OutFmt p%OutSFmt = InputFileData%OutSFmt p%NumOuts = InputFileData%NumOuts - + + CALL HDOUT_Init( HydroDyn_ProgDesc, InitInp%OutRootName, InputFileData, y, p, m, InitOut, ErrStat2, ErrMsg2 ); CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) IF ( ErrStat >= AbortErrLev ) THEN CALL CleanUp() @@ -1705,17 +836,7 @@ SUBROUTINE HydroDyn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, I ! Define initialization-routine output here: InitOut%Ver = HydroDyn_ProgDesc - ! These three come directly from processing the inputs, and so will exist even if not using Morison elements: - InitOut%WtrDens = InputFileData%Morison%WtrDens - InitOut%WtrDpth = InputFileData%Morison%WtrDpth - InitOut%MSL2SWL = InputFileData%Morison%MSL2SWL - p%WtrDpth = InitOut%WtrDpth - - IF ( InitInp%hasIce ) THEN - IF ((InputFileData%Waves%WaveMod /= 0) .OR. (InputFileData%Current%CurrMod /= 0) ) THEN - CALL SetErrStat(ErrID_Fatal,'Waves and Current must be turned off in HydroDyn when ice loading is computed. Set WaveMod=0 and CurrMod=0.',ErrStat,ErrMsg,RoutineName) - END IF - END IF + !............................................................................................ ! Initialize Jacobian: @@ -1736,48 +857,12 @@ SUBROUTINE HydroDyn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, I CONTAINS !................................ SUBROUTINE CleanUp() - - CALL HydroDyn_DestroyInputFile( InputFileData, ErrStat2, ErrMsg2 );CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - CALL NWTC_Library_DestroyFileInfoType(InFileInfo,ErrStat2, ErrMsg2 );CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - CALL Waves_DestroyInitOutput( Waves_InitOut, ErrStat2, ErrMsg2 );CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - CALL Current_DestroyInitOutput( Current_InitOut, ErrStat2, ErrMsg2 );CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - - ! These are dummy variables to satisfy the framework, but are not used again: - - CALL Waves_DestroyInput( Waves_u, ErrStat2, ErrMsg2 );CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - CALL Waves_DestroyParam( Waves_p, ErrStat2, ErrMsg2 );CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - CALL Waves_DestroyContState( Waves_x, ErrStat2, ErrMsg2 );CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - CALL Waves_DestroyDiscState( Waves_xd, ErrStat2, ErrMsg2 );CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - CALL Waves_DestroyConstrState( Waves_z, ErrStat2, ErrMsg2 );CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - CALL Waves_DestroyOtherState( WavesOtherState, ErrStat2, ErrMsg2 );CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - CALL Waves_DestroyOutput( Waves_y, ErrStat2, ErrMsg2 );CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - - CALL Current_DestroyInput( Current_u, ErrStat2, ErrMsg2 );CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - CALL Current_DestroyParam( Current_p, ErrStat2, ErrMsg2 );CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - CALL Current_DestroyContState( Current_x, ErrStat2, ErrMsg2 );CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - CALL Current_DestroyDiscState( Current_xd, ErrStat2, ErrMsg2 );CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - CALL Current_DestroyConstrState( Current_z, ErrStat2, ErrMsg2 );CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - CALL Current_DestroyOtherState( CurrentOtherState, ErrStat2, ErrMsg2 );CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - CALL Current_DestroyOutput( Current_y, ErrStat2, ErrMsg2 );CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - CALL Current_DestroyMisc( Current_m, ErrStat2, ErrMsg2 );CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - if (allocated(tmpWaveKinzi )) deallocate(tmpWaveKinzi ) - if (allocated(tmpWaveElevxi)) deallocate(tmpWaveElevxi) - if (allocated(tmpWaveElevyi)) deallocate(tmpWaveElevyi) - if (allocated(tmpWaveElevXY)) deallocate(tmpWaveElevXY) - if (allocated(WaveElevSt )) deallocate(WaveElevSt ) - if (allocated(WaveVel0 )) deallocate(WaveVel0 ) - if (allocated(WaveAcc0 )) deallocate(WaveAcc0 ) - if (allocated(WaveDynP0 )) deallocate(WaveDynP0 ) - if (allocated(WaveVel2S0 )) deallocate(WaveVel2S0 ) - if (allocated(WaveAcc2S0 )) deallocate(WaveAcc2S0 ) - if (allocated(WaveDynP2S0 )) deallocate(WaveDynP2S0 ) - if (allocated(WaveVel2D0 )) deallocate(WaveVel2D0 ) - if (allocated(WaveAcc2D0 )) deallocate(WaveAcc2D0 ) - if (allocated(WaveDynP2D0 )) deallocate(WaveDynP2D0 ) + ! Use DEALLOCATEpointers = .false. + ! NOTE: All of the pointer data originated in SeaState, and SeaState is responsible for deallocating the data + ! all other modules are responsible for nullifying their versions of the pointers when they are done with the data + + CALL HydroDyn_DestroyInputFile( InputFileData, ErrStat2, ErrMsg2 ); CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + CALL NWTC_Library_DestroyFileInfoType(InFileInfo,ErrStat2, ErrMsg2 ); CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) END SUBROUTINE CleanUp !................................ @@ -1795,10 +880,10 @@ SUBROUTINE HydroDyn_End( u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) TYPE(HydroDyn_ConstraintStateType), INTENT(INOUT) :: z !< Constraint states TYPE(HydroDyn_OtherStateType), INTENT(INOUT) :: OtherState !< Other/optimization states TYPE(HydroDyn_OutputType), INTENT(INOUT) :: y !< System outputs - TYPE(HydroDyn_MiscVarType), INTENT(INOUT) :: m !< Initial misc/optimization variables + TYPE(HydroDyn_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) :: ErrStat2 ! local error status CHARACTER(ErrMsgLen) :: ErrMsg2 ! local error message @@ -1808,10 +893,12 @@ SUBROUTINE HydroDyn_End( u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) ErrStat = ErrID_None ErrMsg = "" + - ! Write the HydroDyn-level output file data if the user requested module-level output + ! Write the HydroDyn-level output file data FROM THE LAST COMPLETED TIME STEP if the user requested module-level output ! and the current time has advanced since the last stored time step. + IF ( p%OutSwtch == 1 .OR. p%OutSwtch == 3) THEN CALL HDOut_WriteOutputs( m%LastOutTime, y, p, m%Decimate, ErrStat2, ErrMsg2 ) call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -1831,11 +918,12 @@ SUBROUTINE HydroDyn_End( u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) ! Destroy the state data: (ignore errors) + CALL HydroDyn_DestroyContState( x, ErrStat2, ErrMsg2 ) CALL HydroDyn_DestroyDiscState( xd, ErrStat2, ErrMsg2 ) CALL HydroDyn_DestroyConstrState( z, ErrStat2, ErrMsg2 ) CALL HydroDyn_DestroyOtherState( OtherState, ErrStat2, ErrMsg2 ) - + ! Destroy misc variables: (ignore errors) CALL HydroDyn_DestroyMisc( m, ErrStat2, ErrMsg2 ) @@ -1869,16 +957,17 @@ SUBROUTINE HydroDyn_UpdateStates( t, n, Inputs, InputTimes, p, x, xd, z, OtherSt CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None ! Local variables - INTEGER :: I, iWAMIT, iBody ! Generic loop counters -! TYPE(HydroDyn_ContinuousStateType) :: dxdt ! Continuous state derivatives at t - TYPE(HydroDyn_DiscreteStateType) :: xd_t ! Discrete states at t (copy) - TYPE(HydroDyn_ConstraintStateType) :: z_Residual ! Residual of the constraint state functions (Z) - TYPE(HydroDyn_InputType) :: u ! Instantaneous inputs + INTEGER :: I, iWAMIT ! Generic loop counters INTEGER(IntKi) :: ErrStat2 ! Error status of the operation (secondary error) CHARACTER(ErrMsgLen) :: ErrMsg2 ! Error message if ErrStat2 /= ErrID_None INTEGER :: nTime ! number of inputs + REAL(R8Ki) :: PRPRotation(3) + TYPE(WAMIT_InputType), ALLOCATABLE :: Inputs_WAMIT(:) + TYPE(Morison_InputType), ALLOCATABLE :: Inputs_Morison(:) + TYPE(Morison_InputType) :: u_Morison + TYPE(HydroDyn_InputType) :: u CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_UpdateStates' ! Create dummy variables required by framework but which are not used by the module @@ -1889,84 +978,146 @@ SUBROUTINE HydroDyn_UpdateStates( t, n, Inputs, InputTimes, p, x, xd, z, OtherSt TYPE(FIT_ContinuousStateType) :: FIT_x ! Input: Continuous states at t; #endif - REAL(ReKi) :: rotdisp(3) ! Initialize variables ErrStat = ErrID_None ! no error has occurred ErrMsg = "" + nTime = size(Inputs) + + ! Update PtfmRefY + IF (p%PtfmYMod .EQ. 1) THEN + ! Inefficient. Only need to interp PRPMesh below. Fix later. + CALL HydroDyn_CopyInput(Inputs(1), u, MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL HydroDyn_Input_ExtrapInterp(Inputs, InputTimes, u, t, ErrStat2, ErrMsg2) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + PRPRotation = EulerExtractZYX(u%PRPMesh%Orientation(:,:,1)) + ! Yaw angle from EulerExtractZYX might not be continous in time and can contain jumps of TwoPi + ! Adjust past xd%PtfmRefY to follow. + IF ( ABS(PRPRotation(3)-xd%PtfmRefY(1)) > ABS(PRPRotation(3)-(xd%PtfmRefY(1)-TwoPi)) ) THEN + xd%PtfmRefY = xd%PtfmRefY - TwoPi + ELSE IF ( ABS(PRPRotation(3)-xd%PtfmRefY(1)) > ABS(PRPRotation(3)-(xd%PtfmRefY(1)+TwoPi)) ) THEN + xd%PtfmRefY = xd%PtfmRefY + TwoPi + END IF + ! Update PtfmRefY states + xd%PtfmRefY(3) = xd%PtfmRefY(2) + xd%PtfmRefY(2) = xd%PtfmRefY(1) + xd%PtfmRefY(1) = p%CYawFilt * xd%PtfmRefY(1) + (1.0-p%CYawFilt) * PRPRotation(3) + CALL HydroDyn_DestroyInput(u, ErrStat2, ErrMsg2) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END IF + + IF (INPUTS(1)%Morison%Mesh%Committed) THEN - + ALLOCATE( Inputs_Morison(nTime), STAT = ErrStat2 ) + IF (ErrStat2 /=0) THEN + CALL SetErrStat( ErrID_Fatal, 'Failed to allocate array Inputs_Morison.', ErrStat, ErrMsg, RoutineName ) + RETURN + END IF - ! Return without doing any work if the we are not using a potential flow model - IF ( p%PotMod == 0 ) RETURN - - ! Return without doing any work if the input mesh is not initialized (NOT USING WAMIT) - !IF ( .NOT. Inputs(1)%WAMIT%Mesh%Initialized ) RETURN - - nTime = size(Inputs) - - - ! Allocate array of WAMIT inputs + DO i=1,nTime + CALL Morison_CopyInput(Inputs(i)%Morison, Inputs_Morison(i), MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ! Inputs_Morison(i)%PtfmRefY = Inputs(i)%PtfmRefY + Inputs_Morison(i)%PtfmRefY = xd%PtfmRefY(i) + END DO + CALL Morison_CopyInput(Inputs(1)%Morison, u_Morison, MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ! u_Morison%PtfmRefY = Inputs(1)%PtfmRefY + u_Morison%PtfmRefY = xd%PtfmRefY(1) + + CALL Morison_Input_ExtrapInterp(Inputs_Morison, InputTimes, u_Morison, t, ErrStat2, ErrMsg2) ! get inputs at time t + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + IF (ErrStat < AbortErrLev) THEN + ! Update the discrete states of Morison - The state of the high-pass velocity filter + CALL Morison_UpdateDiscState( t, u_Morison, p%Morison, x%Morison, xd%Morison, & + z%Morison, OtherState%Morison, m%Morison, ErrStat2, ErrMsg2 ) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END IF + + call Morison_DestroyInput(u_Morison, ErrStat2, ErrMsg2) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) -!FIXME: Error handling appears to be broken here - - IF ( p%PotMod == 1 ) THEN - - ALLOCATE( Inputs_WAMIT(nTime), STAT = ErrStat2 ) - IF (ErrStat2 /=0) THEN - CALL SetErrStat( ErrID_Fatal, 'Failed to allocate array Inputs_WAMIT.', ErrStat, ErrMsg, RoutineName ) - RETURN + do i=1,size(Inputs_Morison) + call Morison_DestroyInput(Inputs_Morison(i), ErrStat2, ErrMsg2) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + end do + deallocate(Inputs_Morison) + END IF + + ! Return without doing any work if the we are not using a potential flow model + IF ( p%PotMod == 0 ) THEN + RETURN + ELSEIF ( p%PotMod == 1 ) THEN + + ALLOCATE( Inputs_WAMIT(nTime), STAT = ErrStat2 ) + IF (ErrStat2 /=0) THEN + CALL SetErrStat( ErrID_Fatal, 'Failed to allocate array Inputs_WAMIT.', ErrStat, ErrMsg, RoutineName ) + RETURN + END IF - if ( p%NBodyMod == 1 .or. p%NBody == 1 ) then - ! For this NBodyMod or NBody=1, there is only one WAMIT object, so copy the necessary inputs and then call WAMIT_UpdateStates - do I=1,nTime - ! Copy the inputs from the HD mesh into the WAMIT mesh - call MeshCopy( Inputs(I)%WAMITMesh, Inputs_WAMIT(I)%Mesh, MESH_NEWCOPY, ErrStat2, ErrMsg2 ); call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - end do + if ( p%NBodyMod == 1 .or. p%NBody == 1 ) then + ! For this NBodyMod or NBody=1, there is only one WAMIT object, so copy the necessary inputs and then call WAMIT_UpdateStates + do I=1,nTime + ! Copy the inputs from the HD mesh into the WAMIT mesh + call MeshCopy( Inputs(I)%WAMITMesh, Inputs_WAMIT(I)%Mesh, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ! Inputs_WAMIT(I)%PtfmRefY = Inputs(I)%PtfmRefY + Inputs_WAMIT(I)%PtfmRefY = xd%PtfmRefY(I) + end do - if (ErrStat < AbortErrLev) then ! if there was an error copying the input meshes, we'll skip this step and then cleanup the temporary input meshes - ! Update the WAMIT module states + if (ErrStat < AbortErrLev) then ! if there was an error copying the input meshes, we'll skip this step and then cleanup the temporary input meshes + ! Update the WAMIT module states - call WAMIT_UpdateStates( t, n, Inputs_WAMIT, InputTimes, p%WAMIT(1), x%WAMIT(1), xd%WAMIT(1), z%WAMIT, OtherState%WAMIT(1), m%WAMIT(1), ErrStat2, ErrMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + call WAMIT_UpdateStates( t, n, Inputs_WAMIT, InputTimes, p%WAMIT(1), x%WAMIT(1), xd%WAMIT(1), z%WAMIT, OtherState%WAMIT(1), m%WAMIT(1), ErrStat2, ErrMsg2 ) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - end if + end if - else + else - ! We have multiple WAMIT objects + ! We have multiple WAMIT objects - ! Loop over number of inputs and copy them into an array of WAMIT inputs - do iWAMIT = 1, p%nWAMITObj + ! Loop over number of inputs and copy them into an array of WAMIT inputs + do iWAMIT = 1, p%nWAMITObj - do I=1,nTime - ! We need to create to valid mesh data structures in our Inputs_WAMIT(I)%Mesh using the miscvar version as a template, but the actually data will be generated below - call MeshCopy( m%u_WAMIT(iWAMIT)%Mesh, Inputs_WAMIT(I)%Mesh, MESH_NEWCOPY, ErrStat2, ErrMsg2 ); call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ! We need to copy the iWAMIT-th node data from the Inputs(I)%WAMITMesh onto the 1st node of the Inputs_WAMIT(I)%Mesh - Inputs_WAMIT(I)%Mesh%TranslationDisp(:,1) = Inputs(I)%WAMITMesh%TranslationDisp(:,iWAMIT) - Inputs_WAMIT(I)%Mesh%Orientation (:,:,1)= Inputs(I)%WAMITMesh%Orientation (:,:,iWAMIT) - Inputs_WAMIT(I)%Mesh%TranslationVel (:,1) = Inputs(I)%WAMITMesh%TranslationVel (:,iWAMIT) - Inputs_WAMIT(I)%Mesh%RotationVel (:,1) = Inputs(I)%WAMITMesh%RotationVel (:,iWAMIT) - Inputs_WAMIT(I)%Mesh%TranslationAcc (:,1) = Inputs(I)%WAMITMesh%TranslationAcc (:,iWAMIT) - Inputs_WAMIT(I)%Mesh%RotationAcc (:,1) = Inputs(I)%WAMITMesh%RotationAcc (:,iWAMIT) - end do - - ! UpdateStates for the iWAMIT-th body - call WAMIT_UpdateStates( t, n, Inputs_WAMIT, InputTimes, p%WAMIT(iWAMIT), x%WAMIT(iWAMIT), xd%WAMIT(iWAMIT), z%WAMIT, OtherState%WAMIT(iWAMIT), m%WAMIT(iWAMIT), ErrStat2, ErrMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + do I=1,nTime + ! We need to create to valid mesh data structures in our Inputs_WAMIT(I)%Mesh using the miscvar version as a template, but the actually data will be generated below + call MeshCopy( m%u_WAMIT(iWAMIT)%Mesh, Inputs_WAMIT(I)%Mesh, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ! Inputs_WAMIT(I)%PtfmRefY = Inputs(I)%PtfmRefY + Inputs_WAMIT(I)%PtfmRefY = xd%PtfmRefY(I) + end do if (ErrStat > AbortErrLev) exit - end do + do I=1,nTime + ! We need to copy the iWAMIT-th node data from the Inputs(I)%WAMITMesh onto the 1st node of the Inputs_WAMIT(I)%Mesh + Inputs_WAMIT(I)%Mesh%TranslationDisp(:,1) = Inputs(I)%WAMITMesh%TranslationDisp(:,iWAMIT) + Inputs_WAMIT(I)%Mesh%Orientation (:,:,1)= Inputs(I)%WAMITMesh%Orientation (:,:,iWAMIT) + Inputs_WAMIT(I)%Mesh%TranslationVel (:,1) = Inputs(I)%WAMITMesh%TranslationVel (:,iWAMIT) + Inputs_WAMIT(I)%Mesh%RotationVel (:,1) = Inputs(I)%WAMITMesh%RotationVel (:,iWAMIT) + Inputs_WAMIT(I)%Mesh%TranslationAcc (:,1) = Inputs(I)%WAMITMesh%TranslationAcc (:,iWAMIT) + Inputs_WAMIT(I)%Mesh%RotationAcc (:,1) = Inputs(I)%WAMITMesh%RotationAcc (:,iWAMIT) + end do + + ! UpdateStates for the iWAMIT-th body + call WAMIT_UpdateStates( t, n, Inputs_WAMIT, InputTimes, p%WAMIT(iWAMIT), x%WAMIT(iWAMIT), xd%WAMIT(iWAMIT), z%WAMIT, OtherState%WAMIT(iWAMIT), m%WAMIT(iWAMIT), ErrStat2, ErrMsg2 ) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + if (ErrStat > AbortErrLev) exit + + end do - end if + end if - ! deallocate temporary inputs - do I=1,nTime - call WAMIT_DestroyInput( Inputs_WAMIT(I), ErrStat2, ErrMsg2 ); call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - end do + ! deallocate temporary inputs + do I=1,nTime + call WAMIT_DestroyInput( Inputs_WAMIT(I), ErrStat2, ErrMsg2 ) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + end do - deallocate(Inputs_WAMIT) + deallocate(Inputs_WAMIT) #ifdef USE_FIT ELSE IF ( p%PotMod == 2 ) THEN ! FIT @@ -2013,6 +1164,28 @@ SUBROUTINE HydroDyn_UpdateStates( t, n, Inputs, InputTimes, p, x, xd, z, OtherSt END IF + !CALL Cleanup() + +contains + subroutine Cleanup() + + if (allocated(Inputs_Morison)) then + do i=1,size(Inputs_Morison) + call Morison_DestroyInput(Inputs_Morison(i), ErrStat2, ErrMsg2) + end do + deallocate(Inputs_Morison) + end if + call Morison_DestroyInput(u_Morison, ErrStat2, ErrMsg2) + + + if (allocated(Inputs_WAMIT)) then + do i=1,size(Inputs_WAMIT) + call Wamit_DestroyInput(Inputs_WAMIT(i), ErrStat2, ErrMsg2) + end do + deallocate(Inputs_WAMIT) + end if + + end subroutine Cleanup END SUBROUTINE HydroDyn_UpdateStates @@ -2029,7 +1202,7 @@ SUBROUTINE HydroDyn_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, ErrStat, TYPE(HydroDyn_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at Time TYPE(HydroDyn_OtherStateType), INTENT(IN ) :: OtherState !< Other states at Time TYPE(HydroDyn_OutputType), INTENT(INOUT) :: y !< Outputs computed at Time (Input only so that mesh con- - !! nectivity information does not have to be recalculated) + !! nectivity information does not have to be recalculated) + for previous WriteOutput results TYPE(HydroDyn_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 @@ -2044,59 +1217,91 @@ SUBROUTINE HydroDyn_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, ErrStat, TYPE(FIT_ConstraintStateType) :: FIT_z ! Initial guess of the constraint states TYPE(FIT_InputType) :: Inputs_FIT #endif - REAL(ReKi) :: WaveElev (p%NWaveElev) ! Instantaneous total elevation of incident waves at each of the NWaveElev points where the incident wave elevations can be output (meters) - REAL(ReKi) :: WaveElev1(p%NWaveElev) ! Instantaneous first order elevation of incident waves at each of the NWaveElev points where the incident wave elevations can be output (meters) - REAL(ReKi) :: WaveElev2(p%NWaveElev) ! Instantaneous first order elevation of incident waves at each of the NWaveElev points where the incident wave elevations can be output (meters) - + REAL(ReKi) :: q(6*p%NBody), qdot(6*p%NBody), qdotsq(6*p%NBody), qdotdot(6*p%NBody) REAL(ReKi) :: rotdisp(3) ! small angle rotational displacements - REAL(ReKi) :: AllOuts(MaxHDOutputs) - integer(IntKi) :: iBody, indxStart, indxEnd, iWAMIT ! Counters - + integer(IntKi) :: iBody, indxStart, indxEnd ! Counters + REAL(ReKi), ALLOCATABLE :: RRg2b(:,:), RRb2g(:,:) + REAL(ReKi) :: PtfmRefY + REAL(R8Ki) :: PRPRotation(3) + + CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_CalcOutput' + REAL(ReKi), PARAMETER :: LrgAngle = 0.261799387799149 ! Threshold for platform roll and pitch rotation (15 deg). This is consistent with the ElastoDyn check. + LOGICAL, SAVE :: FrstWarn_LrgY = .TRUE. + ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" - WaveElev1 = 0.0_ReKi - WaveElev2 = 0.0_ReKi ! In case we don't use 2nd order waves - + - ! Compute outputs here: - + ! Write the Hydrodyn-level output file data FROM THE LAST COMPLETED TIME STEP if the user requested module-level output + ! and the current time has advanced since the last stored time step. Note that this must be done before filling y%WriteOutput + ! so that we don't get recent results. Also note that this may give strange results in the .HD.out files of linearization simulations. + IF ( (p%OutSwtch == 1 .OR. p%OutSwtch == 3) .AND. ( Time > m%LastOutTime ) ) THEN + CALL HDOut_WriteOutputs( m%LastOutTime, y, p, m%Decimate, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END IF + m%LastOutTime = Time ! time associated with the next values of y%WriteOutput + + ! Compute the filtered platform reference yaw position here - both WAMIT and Morison modules need this + PRPRotation = EulerExtractZYX(u%PRPMesh%Orientation(:,:,1)) + IF (p%PtfmYMod .EQ. 0_IntKi) THEN + PtfmRefY = xd%PtfmRefY(1) + ELSE IF (p%PtfmYMod .EQ. 1_IntKi) THEN + IF ( ABS(PRPRotation(3)-xd%PtfmRefY(1)) > ABS(PRPRotation(3)-(xd%PtfmRefY(1)-TwoPi)) ) THEN + PtfmRefY = p%CYawFilt * (xd%PtfmRefY(1) - TwoPi) + (1.0-p%CYawFilt) * PRPRotation(3) + ELSE IF ( ABS(PRPRotation(3)-xd%PtfmRefY(1)) > ABS(PRPRotation(3)-(xd%PtfmRefY(1)+TwoPi)) ) THEN + PtfmRefY = p%CYawFilt * (xd%PtfmRefY(1) + TwoPi) + (1.0-p%CYawFilt) * PRPRotation(3) + ELSE + PtfmRefY = p%CYawFilt * xd%PtfmRefY(1) + (1.0-p%CYawFilt) * PRPRotation(3) + END IF + END IF + IF ( (ABS( WrapToPi(PRPRotation(3)-PtfmRefY) ) > LrgAngle) .AND. FrstWarn_LrgY ) THEN + ErrStat2 = ErrID_Severe + ErrMsg2 = 'Yaw angle at PRP relative to the reference yaw position (PtfmRefY) violated the small angle assumption. The solution might be inaccurate. Consider using PtfmYMod=1 and adjust PtfmYCutoff. Simulation continuing, but future warnings will be suppressed.' + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + FrstWarn_LrgY = .FALSE. + END IF + !------------------------------------------------------------------- ! Additional stiffness, damping forces. These need to be placed on a point mesh which is located at the WAMIT reference point (WRP). ! This mesh will need to get mapped by the glue code for use by either ElastoDyn or SubDyn. !------------------------------------------------------------------- - ! Deal with any output from the Waves2 module.... - IF (p%Waves2%WvDiffQTFF .OR. p%Waves2%WvSumQTFF ) THEN - - ! Waves2_CalcOutput is called only so that the wave elevations can be output (if requested). - CALL Waves2_CalcOutput( Time, m%u_Waves2, p%Waves2, x%Waves2, xd%Waves2, & - z%Waves2, OtherState%Waves2, y%Waves2, m%Waves2, ErrStat2, ErrMsg2 ) - - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'HydroDyn_CalcOutput' ) - END IF if ( p%PotMod == 1 ) then + ! Transformation matrices between global and PRP frame + ALLOCATE(RRb2g(6*p%NBody,6*p%NBody),STAT=ErrStat2) + ALLOCATE(RRg2b(6*p%NBody,6*p%NBody),STAT=ErrStat2) + RRg2b(:,:) = 0.0_ReKi do iBody = 1, p%NBody ! Determine the rotational angles from the direction-cosine matrix - rotdisp = GetSmllRotAngs ( u%WAMITMesh%Orientation(:,:,iBody), ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'HydroDyn_CalcOutput' ) + ! rotdisp = GetRotAngs ( u%PtfmRefY, u%WAMITMesh%Orientation(:,:,iBody), ErrStat2, ErrMsg2 ) + ! CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + rotdisp = EulerExtractZYX(u%WAMITMesh%Orientation(:,:,iBody)) indxStart = (iBody-1)*6+1 indxEnd = indxStart+5 q (indxStart:indxEnd) = reshape((/real(u%WAMITMesh%TranslationDisp(:,iBody),ReKi),rotdisp(:)/),(/6/)) qdot (indxStart:indxEnd) = reshape((/u%WAMITMesh%TranslationVel(:,iBody),u%WAMITMesh%RotationVel(:,iBody)/),(/6/)) - qdotsq (indxStart:indxEnd) = abs(qdot(indxStart:indxEnd))*qdot(indxStart:indxEnd) qdotdot(indxStart:indxEnd) = reshape((/u%WAMITMesh%TranslationAcc(:,iBody),u%WAMITMesh%RotationAcc(:,iBody)/),(/6/)) + RRg2b(indxStart:(indxStart+2),indxStart:(indxStart+2)) = u%WAMITMesh%Orientation(:,:,iBody) + RRg2b((indxEnd-2):indxEnd,(indxEnd-2):indxEnd) = u%WAMITMesh%Orientation(:,:,iBody) + ! qdotsq is only used to compute the quadratic damping load, so convert to body frame here + qdotsq (indxStart:indxEnd) = matmul(RRg2b(indxStart:indxEnd,indxStart:indxEnd),qdot(indxStart:indxEnd)) + qdotsq (indxStart:indxEnd) = abs( qdotsq (indxStart:indxEnd) ) * qdotsq (indxStart:indxEnd) end do + RRb2g = transpose(RRg2b) + !FIXME: Error handling appears to be broken here. if ( p%NBodyMod == 1 ) then ! Compute the load contirbution from user-supplied added stiffness and damping - m%F_PtfmAdd = p%AddF0(:,1) - matmul(p%AddCLin(:,:,1), q) - matmul(p%AddBLin(:,:,1), qdot) - matmul(p%AddBQuad(:,:,1), qdotsq) + m%F_PtfmAdd = p%AddF0(:,1) - matmul(p%AddCLin(:,:,1), q) & + - matmul( matmul(RRb2g,p%AddBLin(:,:,1) ), matmul(RRg2b,qdot) ) & + - matmul( matmul(RRb2g,p%AddBQuad(:,:,1)), qdotsq) ! Note: qdotsq is already in body frame, see above do iBody = 1, p%NBody indxStart = (iBody-1)*6+1 indxEnd = indxStart+5 @@ -2110,7 +1315,10 @@ SUBROUTINE HydroDyn_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, ErrStat, indxStart = (iBody-1)*6+1 indxEnd = indxStart+5 - m%F_PtfmAdd(indxStart:indxEnd) = p%AddF0(:,iBody) - matmul(p%AddCLin(:,:,iBody), q(indxStart:indxEnd)) - matmul(p%AddBLin(:,:,iBody), qdot(indxStart:indxEnd)) - matmul(p%AddBQuad(:,:,iBody), qdotsq(indxStart:indxEnd)) + m%F_PtfmAdd(indxStart:indxEnd) = p%AddF0(:,iBody) - matmul(p%AddCLin(:,:,iBody), q(indxStart:indxEnd)) & + - matmul( matmul(RRb2g(indxStart:indxEnd,indxStart:indxEnd),p%AddBLin(:,:,iBody)), & + matmul(RRg2b(indxStart:indxEnd,indxStart:indxEnd),qdot(indxStart:indxEnd)) ) & + - matmul( matmul(RRb2g(indxStart:indxEnd,indxStart:indxEnd),p%AddBQuad(:,:,iBody)), qdotsq(indxStart:indxEnd)) ! Attach to the output point mesh y%WAMITMesh%Force (:,iBody) = m%F_PtfmAdd(indxStart:indxStart+2) @@ -2127,12 +1335,14 @@ SUBROUTINE HydroDyn_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, ErrStat, if ( p%NBodyMod == 1 .or. p%NBody == 1 ) then ! Copy the inputs from the HD mesh into the WAMIT mesh call MeshCopy( u%WAMITMesh, m%u_WAMIT(1)%Mesh, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'HydroDyn_CalcOutput' ) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) if ( ErrStat >= AbortErrLev ) return - - call WAMIT_CalcOutput( Time, p%WaveTime, m%u_WAMIT(1), p%WAMIT(1), x%WAMIT(1), xd%WAMIT(1), & + + ! m%u_WAMIT(1)%PtfmRefY = u%PtfmRefY + m%u_WAMIT(1)%PtfmRefY = PtfmRefY + call WAMIT_CalcOutput( Time, m%u_WAMIT(1), p%WAMIT(1), x%WAMIT(1), xd%WAMIT(1), & z%WAMIT, OtherState%WAMIT(1), y%WAMIT(1), m%WAMIT(1), ErrStat2, ErrMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'HydroDyn_CalcOutput' ) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) do iBody=1,p%NBody y%WAMITMesh%Force (:,iBody) = y%WAMITMesh%Force (:,iBody) + y%WAMIT(1)%Mesh%Force (:,iBody) y%WAMITMesh%Moment(:,iBody) = y%WAMITMesh%Moment(:,iBody) + y%WAMIT(1)%Mesh%Moment(:,iBody) @@ -2151,9 +1361,10 @@ SUBROUTINE HydroDyn_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, ErrStat, m%u_WAMIT(iBody)%Mesh%TranslationAcc (:,1) = u%WAMITMesh%TranslationAcc (:,iBody) m%u_WAMIT(iBody)%Mesh%RotationAcc (:,1) = u%WAMITMesh%RotationAcc (:,iBody) - call WAMIT_CalcOutput( Time, p%WaveTime, m%u_WAMIT(iBody), p%WAMIT(iBody), x%WAMIT(iBody), xd%WAMIT(iBody), & + m%u_WAMIT(iBody)%PtfmRefY = PtfmRefY + call WAMIT_CalcOutput( Time, m%u_WAMIT(iBody), p%WAMIT(iBody), x%WAMIT(iBody), xd%WAMIT(iBody), & z%WAMIT, OtherState%WAMIT(iBody), y%WAMIT(iBody), m%WAMIT(iBody), ErrStat2, ErrMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'HydroDyn_CalcOutput' ) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) y%WAMITMesh%Force (:,iBody) = y%WAMITMesh%Force (:,iBody) + y%WAMIT(iBody)%Mesh%Force (:,1) y%WAMITMesh%Moment(:,iBody) = y%WAMITMesh%Moment(:,iBody) + y%WAMIT(iBody)%Mesh%Moment(:,1) @@ -2172,13 +1383,8 @@ SUBROUTINE HydroDyn_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, ErrStat, if (p%WAMIT2used) then if ( p%NBodyMod == 1 .or. p%NBody == 1 ) then - ! Copy the inputs from the HD mesh into the WAMIT mesh - call MeshCopy( u%WAMITMesh, m%u_WAMIT2(1)%Mesh, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'HydroDyn_CalcOutput' ) - if ( ErrStat >= AbortErrLev ) return - call WAMIT2_CalcOutput( Time, p%WaveTime, m%u_WAMIT2(1), p%WAMIT2(1), x%WAMIT2(1), xd%WAMIT2(1), & - z%WAMIT2, OtherState%WAMIT2(1), y%WAMIT2(1), m%WAMIT2(1), ErrStat2, ErrMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'HydroDyn_CalcOutput' ) + call WAMIT2_CalcOutput( Time, PtfmRefY, p%WaveField, p%WAMIT2(1), y%WAMIT2(1), m%WAMIT2(1), ErrStat2, ErrMsg2 ) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) do iBody=1,p%NBody y%WAMITMesh%Force (:,iBody) = y%WAMITMesh%Force (:,iBody) + y%WAMIT2(1)%Mesh%Force (:,iBody) y%WAMITMesh%Moment(:,iBody) = y%WAMITMesh%Moment(:,iBody) + y%WAMIT2(1)%Mesh%Moment(:,iBody) @@ -2188,17 +1394,8 @@ SUBROUTINE HydroDyn_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, ErrStat, else do iBody=1,p%NBody - ! We need to copy the iWAMIT2-th node data from the Inputs(I)%WAMIT2Mesh onto the 1st node of the Inputs_WAMIT2(I)%Mesh - m%u_WAMIT2(iBody)%Mesh%TranslationDisp(:,1) = u%WAMITMesh%TranslationDisp(:,iBody) - m%u_WAMIT2(iBody)%Mesh%Orientation (:,:,1)= u%WAMITMesh%Orientation (:,:,iBody) - m%u_WAMIT2(iBody)%Mesh%TranslationVel (:,1) = u%WAMITMesh%TranslationVel (:,iBody) - m%u_WAMIT2(iBody)%Mesh%RotationVel (:,1) = u%WAMITMesh%RotationVel (:,iBody) - m%u_WAMIT2(iBody)%Mesh%TranslationAcc (:,1) = u%WAMITMesh%TranslationAcc (:,iBody) - m%u_WAMIT2(iBody)%Mesh%RotationAcc (:,1) = u%WAMITMesh%RotationAcc (:,iBody) - - call WAMIT2_CalcOutput( Time, p%WaveTime, m%u_WAMIT2(iBody), p%WAMIT2(iBody), x%WAMIT2(iBody), xd%WAMIT2(iBody), & - z%WAMIT2, OtherState%WAMIT2(iBody), y%WAMIT2(iBody), m%WAMIT2(iBody), ErrStat2, ErrMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'HydroDyn_CalcOutput' ) + call WAMIT2_CalcOutput( Time, PtfmRefY, p%WaveField, p%WAMIT2(iBody), y%WAMIT2(iBody), m%WAMIT2(iBody), ErrStat2, ErrMsg2 ) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) y%WAMITMesh%Force (:,iBody) = y%WAMITMesh%Force (:,iBody) + y%WAMIT2(iBody)%Mesh%Force (:,1) y%WAMITMesh%Moment(:,iBody) = y%WAMITMesh%Moment(:,iBody) + y%WAMIT2(iBody)%Mesh%Moment(:,1) @@ -2229,79 +1426,34 @@ SUBROUTINE HydroDyn_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, ErrStat, IF ( u%Morison%Mesh%Committed ) THEN ! Make sure we are using Morison / there is a valid mesh + u%Morison%PtfmRefY = PtfmRefY CALL Morison_CalcOutput( Time, u%Morison, p%Morison, x%Morison, xd%Morison, & z%Morison, OtherState%Morison, y%Morison, m%Morison, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'HydroDyn_CalcOutput' ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END IF - - + ! Integrate all the mesh loads onto the platfrom reference Point (PRP) at (0,0,0) - m%F_Hydro = CalcLoadsAtWRP( y, u, m%AllHdroOrigin, u%PRPMesh, m%MrsnMesh_position, m%HD_MeshMap, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'HydroDyn_CalcOutput' ) - - - ! Compute the wave elevations at the requested output locations for this time. Note that p%WaveElev has the second order added to it already. - - ! Second order wave elevation, if calculated (This array is split out for speed because of the if) - if (allocated(p%WaveElev2)) then - DO I=1,p%NWaveElev - WaveElev2(I) = InterpWrappedStpReal ( REAL(Time, SiKi), p%WaveTime(:), p%WaveElev2(:,I), & - m%LastIndWave, p%NStepWave + 1 ) - END DO - endif + m%F_Hydro = CalcLoadsAtWRP( y, u, m%AllHdroOrigin, m%HD_MeshMap, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - DO I=1,p%NWaveElev - WaveElev1(I) = InterpWrappedStpReal ( REAL(Time, SiKi), p%WaveTime(:), p%WaveElev1(:,I), & - m%LastIndWave, p%NStepWave + 1 ) - WaveElev(I) = InterpWrappedStpReal ( REAL(Time, SiKi), p%WaveTime(:), p%WaveElev(:,I), & - m%LastIndWave, p%NStepWave + 1 ) + ! Map calculated results into the first p%NumOuts values of the y%WriteOutput Array + CALL HDOut_MapOutputs( p, y, m%WAMIT, m%WAMIT2, m%F_PtfmAdd, m%F_Waves, m%F_Hydro, u%PRPMesh, PtfmRefY, q, qdot, qdotdot, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - - - - - ! Write the HydroDyn-level output file data if the user requested module-level output - ! and the current time has advanced since the last stored time step. - - IF ( (p%OutSwtch == 1 .OR. p%OutSwtch == 3) .AND. ( Time > m%LastOutTime ) ) THEN - CALL HDOut_WriteOutputs( m%LastOutTime, y, p, m%Decimate, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'HydroDyn_CalcOutput' ) - END IF - - - ! Map calculated results into the AllOuts Array - CALL HDOut_MapOutputs( Time, p, y, m%WAMIT, m%WAMIT2, p%NWaveElev, WaveElev, WaveElev1, WaveElev2, m%F_PtfmAdd, m%F_Waves, m%F_Hydro, u%PRPMesh, q, qdot, qdotdot, AllOuts, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'HydroDyn_CalcOutput' ) - - DO I = 1,p%NumOuts - y%WriteOutput(I) = p%OutParam(I)%SignM * AllOuts( p%OutParam(I)%Indx ) - END DO - ! Aggregate the sub-module outputs - - IF ( p%OutSwtch > 0) THEN - - J = p%NumOuts + 1 - - IF (ALLOCATED( p%Waves2%OutParam ) .AND. p%Waves2%NumOuts > 0) THEN - DO I=1, p%Waves2%NumOuts - y%WriteOutput(J) = y%Waves2%WriteOutput(I) - J = J + 1 - END DO - END IF - - IF (ALLOCATED( p%Morison%OutParam ) .AND. p%Morison%NumOuts > 0) THEN - DO I=1, p%Morison%NumOuts - y%WriteOutput(J) = y%Morison%WriteOutput(I) - J = J + 1 - END DO - END IF - + IF (p%Morison%NumOuts > 0) THEN + J = p%NumOuts + 1 + DO I=1, p%Morison%NumOuts + y%WriteOutput(J) = y%Morison%WriteOutput(I) + J = J + 1 + END DO END IF m%LastOutTime = Time + IF (ALLOCATED(RRb2g)) DEALLOCATE(RRb2g) + IF (ALLOCATED(RRg2b)) DEALLOCATE(RRg2b) + END SUBROUTINE HydroDyn_CalcOutput @@ -2402,13 +1554,11 @@ END SUBROUTINE HydroDyn_CalcConstrStateResidual !---------------------------------------------------------------------------------------------------------------------------------- -function CalcLoadsAtWRP( y, u, AllHdroOrigin, PRP_Position, MrsnMesh_Position, MeshMapData, ErrStat, ErrMsg ) +function CalcLoadsAtWRP( y, u, AllHdroOrigin, MeshMapData, ErrStat, ErrMsg ) type(HydroDyn_OutputType), intent(inout) :: y ! Hydrodyn outputs type(HydroDyn_InputType), intent(in ) :: u ! Hydrodyn inputs type(MeshType), intent(inout) :: AllHdroOrigin ! This is the mesh which data is mapped onto. We pass it in to avoid allocating it at each call - type(MeshType), intent(inout) :: PRP_Position ! These are the kinematics associated the PRP at (0,0,0). We pass it in to avoid allocating it at each call - type(MeshType), intent(in ) :: MrsnMesh_Position ! These are the kinematics associated with the Morison loads mesh. We pass it in to avoid allocating it at each call type(HD_ModuleMapType), intent(inout) :: MeshMapData ! Mesh mapping data structures integer(IntKi), intent( out) :: ErrStat ! Error status of the operation character(*), intent( out) :: ErrMsg ! Error message if ErrStat /= ErrID_None @@ -2423,7 +1573,7 @@ function CalcLoadsAtWRP( y, u, AllHdroOrigin, PRP_Position, MrsnMesh_Position, if ( y%WAMITMesh%Committed ) then ! Just transfer the loads because the meshes are at the same location (0,0,0) - call Transfer_Point_to_Point( y%WAMITMesh, AllHdroOrigin, MeshMapData%W_P_2_PRP_P, ErrStat2, ErrMsg2, u%WAMITMesh, PRP_Position ) + call Transfer_Point_to_Point( y%WAMITMesh, AllHdroOrigin, MeshMapData%W_P_2_PRP_P, ErrStat2, ErrMsg2, u%WAMITMesh, u%PRPMesh ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'CalcLoadsAtWRP') if (ErrStat >= AbortErrLev) return @@ -2435,7 +1585,7 @@ function CalcLoadsAtWRP( y, u, AllHdroOrigin, PRP_Position, MrsnMesh_Position, if ( y%Morison%Mesh%Committed ) then - call Transfer_Point_to_Point( y%Morison%Mesh, AllHdroOrigin, MeshMapData%M_P_2_PRP_P, ErrStat2, ErrMsg2, u%Morison%Mesh, PRP_Position ) + call Transfer_Point_to_Point( y%Morison%Mesh, AllHdroOrigin, MeshMapData%M_P_2_PRP_P, ErrStat2, ErrMsg2, u%Morison%Mesh, u%PRPMesh ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'CalcLoadsAtWRP') if (ErrStat >= AbortErrLev) return @@ -2486,7 +1636,8 @@ SUBROUTINE HD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM TYPE(HydroDyn_ContinuousStateType) :: x_m TYPE(HydroDyn_InputType) :: u_perturb REAL(R8Ki) :: delta ! delta change in input or state - INTEGER(IntKi) :: i, j, k, startingI, startingJ, bOffset, offsetI, offsetJ, n_du_plus1 + INTEGER(IntKi) :: i, j, k, startingI, startingJ, bOffset, offsetI, n_du_extend, n_du_norm + integer(IntKi), parameter :: nu_extended = 4 ! 4 total extended inputs: WaveElev0 from SeaSt, HWindSpeed / PLexp / PropagationDir from IfW (turbulent sea current) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -2498,7 +1649,8 @@ SUBROUTINE HD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM ErrStat = ErrID_None ErrMsg = '' - n_du_plus1 = size(p%Jac_u_indx,1)+1 + n_du_norm = size(p%Jac_u_indx,1) + n_du_extend = n_du_norm + nu_extended ! make a copy of the inputs to perturb call HydroDyn_CopyInput( u, u_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2) @@ -2516,7 +1668,7 @@ SUBROUTINE HD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM ! allocate dYdu if necessary if (.not. allocated(dYdu)) then - call AllocAry(dYdu, p%Jac_ny, n_du_plus1, 'dYdu', ErrStat2, ErrMsg2) + call AllocAry(dYdu, p%Jac_ny, n_du_extend, 'dYdu', ErrStat2, ErrMsg2) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) if (ErrStat>=AbortErrLev) then call cleanup() @@ -2534,7 +1686,7 @@ SUBROUTINE HD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM return end if - do i=1,size(p%Jac_u_indx,1) + do i=1,size(p%Jac_u_indx,1) ! NOTE: extended inputs are not included in p%Jac_u_indx ! get u_op + delta u call HydroDyn_CopyInput( u, u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) @@ -2561,8 +1713,14 @@ SUBROUTINE HD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM end do - ! p%WaveElev0 column - dYdu(:,n_du_plus1) = 0 + + !------------------- + ! extended inputs + ! WaveElev0 column -- from SeaState + dYdu(:,n_du_norm+1) = 0.0_ReKi + + ! HWindSpeed / PLexp / PropagationDir -- from Ifw/FlowField for turbulent sea current + dYdu(:,n_du_norm+2:n_du_norm+4) = 0.0_ReKi if (ErrStat>=AbortErrLev) then @@ -2585,7 +1743,7 @@ SUBROUTINE HD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM ! allocate dXdu if necessary if (.not. allocated(dXdu)) then - call AllocAry(dXdu, p%totalStates, n_du_plus1, 'dXdu', ErrStat2, ErrMsg2) + call AllocAry(dXdu, p%totalStates, n_du_extend, 'dXdu', ErrStat2, ErrMsg2) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) if (ErrStat>=AbortErrLev) then call cleanup() @@ -2598,13 +1756,13 @@ SUBROUTINE HD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM do j = 1,p%nWAMITObj do i = 1,p%WAMIT(j)%SS_Exctn%numStates - dXdu(offsetI+i,n_du_plus1) = p%WAMIT(j)%SS_Exctn%B(i) ! B is numStates by 1 + dXdu(offsetI+i,n_du_extend) = p%WAMIT(j)%SS_Exctn%B(i) ! B is numStates by 1 end do offsetI = offsetI + p%WAMIT(j)%SS_Exctn%numStates end do startingI = p%totalStates - p%totalRdtnStates - startingJ = n_du_plus1 - 1 - 18 - 4*3*p%NBody ! subtract 1 for WaveElev0, then 6*3 for PRPMesh and then 4*3*NBody to place us at the beginning of the velocity inputs + startingJ = n_du_norm - 18 - 4*3*p%NBody ! subtract 6*3 for PRPMesh and then 4*3*NBody to place us at the beginning of the velocity inputs ! B is numStates by 6*NBody where NBody =1 if NBodyMod=2 or 3, but could be >1 for NBodyMod=1 if ( p%NBodyMod == 1 ) then ! Example for NBodyMod=1 and NBody = 2, @@ -3042,12 +2200,10 @@ SUBROUTINE HD_Init_Jacobian_y( p, y, InitOut, ErrStat, ErrMsg) CHARACTER(*) , INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None ! local variables: - INTEGER(IntKi) :: i,j,k, index_last, index_next + INTEGER(IntKi) :: i,index_last, index_next INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'HD_Init_Jacobian_y' - LOGICAL :: Mask(FIELDMASK_SIZE) ! flags to determine if this field is part of the packing - logical, allocatable :: AllOut(:) @@ -3220,9 +2376,9 @@ SUBROUTINE HD_Init_Jacobian( p, u, y, InitOut, ErrStat, ErrMsg) CHARACTER(*), PARAMETER :: RoutineName = 'HD_Init_Jacobian' ! local variables: - INTEGER(IntKi) :: i, j, k, index, index_last, nu, i_meshField, m, meshFieldCount - REAL(R8Ki) :: MaxThrust, MaxTorque, perturb_t, perturb - REAL(R8Ki) :: ScaleLength + INTEGER(IntKi) :: i, j, index, nu, i_meshField, m, meshFieldCount + integer(IntKi), parameter :: nu_extended = 4 ! 4 total extended inputs: WaveElev0 from SeaSt, HWindSpeed / PLexp / PropagationDir from IfW (turbulent sea current) + REAL(R8Ki) :: perturb_t, perturb LOGICAL :: FieldMask(FIELDMASK_SIZE) ! flags to determine if this field is part of the packing @@ -3250,7 +2406,8 @@ SUBROUTINE HD_Init_Jacobian( p, u, y, InitOut, ErrStat, ErrMsg) nu = nu + u%PRPMesh%NNodes * 18 ! 3 TranslationDisp, Orientation, TranslationVel, RotationVel, TranslationAcc, and RotationAcc at each node - ! DO NOT Add the extended input WaveElev0 when computing the size of p%Jac_u_indx + ! DO NOT Add the extended inputs WaveElev0, HWindSpeed / PLexp / PropagationDir when computing the size of p%Jac_u_indx +!FIXME: extended inputs will need to be added later to get HWindSpeed / PLexp / PropagationDir from sea currents from IfW/FlowField in ! note: all other inputs are ignored @@ -3343,7 +2500,7 @@ SUBROUTINE HD_Init_Jacobian( p, u, y, InitOut, ErrStat, ErrMsg) if (ErrStat >= AbortErrLev) return - perturb_t = 0.02_ReKi*D2R * max(p%WtrDpth,1.0_ReKi) ! translation input scaling + perturb_t = 0.02_ReKi*D2R * max(p%WaveField%EffWtrDpth,1.0_ReKi) ! translation input scaling perturb = 2*D2R ! rotational input scaling index = 0 @@ -3377,11 +2534,11 @@ SUBROUTINE HD_Init_Jacobian( p, u, y, InitOut, ErrStat, ErrMsg) !................ ! names of the columns, InitOut%LinNames_u: !................ - call AllocAry(InitOut%LinNames_u, nu+1, 'LinNames_u', ErrStat2, ErrMsg2); call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AllocAry(InitOut%LinNames_u, nu+nu_extended, 'LinNames_u', ErrStat2, ErrMsg2); call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ! We do not need RotFrame_u for this module and the glue code with handle the fact that we did not allocate the array and hence set all values to false at the glue-code level - !call AllocAry(InitOut%RotFrame_u, nu+1, 'RotFrame_u', ErrStat2, ErrMsg2); call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + !call AllocAry(InitOut%RotFrame_u, nu+nu_extended, 'RotFrame_u', ErrStat2, ErrMsg2); call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call AllocAry(InitOut%IsLoad_u, nu+1, 'IsLoad_u', ErrStat2, ErrMsg2); call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AllocAry(InitOut%IsLoad_u, nu+nu_extended, 'IsLoad_u', ErrStat2, ErrMsg2); call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return InitOut%IsLoad_u = .false. ! HD's inputs are NOT loads @@ -3418,9 +2575,13 @@ SUBROUTINE HD_Init_Jacobian( p, u, y, InitOut, ErrStat, ErrMsg) FieldMask(MASKID_TRANSLATIONACC) = .true. FieldMask(MASKID_ROTATIONACC) = .true. call PackMotionMesh_Names(u%PRPMesh, 'Platform-RefPt', InitOut%LinNames_u, index, FieldMask=FieldMask) - - InitOut%LinNames_u(index) = 'Extended input: wave elevation at platform ref point, m' - + + ! Extended inputs + InitOut%LinNames_u(index) = 'Extended input: wave elevation at platform ref point, m'; index=index+1 + InitOut%LinNames_u(index) = 'Extended input: horizontal current speed (steady/uniform wind), m/s'; index=index+1 + InitOut%LinNames_u(index) = 'Extended input: vertical power-law shear exponent, -'; index=index+1 + InitOut%LinNames_u(index) = 'Extended input: propagation direction, rad'; index=index+1 + END SUBROUTINE HD_Init_Jacobian !---------------------------------------------------------------------------------------------------------------------------------- !> This routine perturbs the nth element of the u array (and mesh/field it corresponds to) @@ -3452,7 +2613,7 @@ SUBROUTINE HD_Perturb_u( p, n, perturb_sign, u, du ) CASE ( 1) !Module/Mesh/Field: u%Morison%Mesh%TranslationDisp = 1 u%Morison%Mesh%TranslationDisp (fieldIndx,node) = u%Morison%Mesh%TranslationDisp (fieldIndx,node) + du * perturb_sign CASE ( 2) !Module/Mesh/Field: u%Morison%Mesh%Orientation = 2 - CALL PerturbOrientationMatrix( u%Morison%Mesh%Orientation(:,:,node), du * perturb_sign, fieldIndx, UseSmlAngle=.true. ) + CALL PerturbOrientationMatrix( u%Morison%Mesh%Orientation(:,:,node), du * perturb_sign, fieldIndx, UseSmlAngle=.false. ) CASE ( 3) !Module/Mesh/Field: u%Morison%Mesh%TranslationVel = 3 u%Morison%Mesh%TranslationVel( fieldIndx,node) = u%Morison%Mesh%TranslationVel( fieldIndx,node) + du * perturb_sign CASE ( 4) !Module/Mesh/Field: u%Morison%Mesh%RotationVel = 4 @@ -3467,7 +2628,7 @@ SUBROUTINE HD_Perturb_u( p, n, perturb_sign, u, du ) CASE ( 7) !Module/Mesh/Field: u%WAMITMesh%TranslationDisp = 7 u%WAMITMesh%TranslationDisp (fieldIndx,node) = u%WAMITMesh%TranslationDisp (fieldIndx,node) + du * perturb_sign CASE ( 8) !Module/Mesh/Field: u%WAMITMesh%Orientation = 8 - CALL PerturbOrientationMatrix( u%WAMITMesh%Orientation(:,:,node), du * perturb_sign, fieldIndx, UseSmlAngle=.true. ) + CALL PerturbOrientationMatrix( u%WAMITMesh%Orientation(:,:,node), du * perturb_sign, fieldIndx, UseSmlAngle=.false. ) CASE ( 9) !Module/Mesh/Field: u%WAMITMesh%TranslationVel = 9 u%WAMITMesh%TranslationVel( fieldIndx,node) = u%WAMITMesh%TranslationVel( fieldIndx,node) + du * perturb_sign CASE (10) !Module/Mesh/Field: u%WAMITMesh%RotationVel = 10 @@ -3481,7 +2642,7 @@ SUBROUTINE HD_Perturb_u( p, n, perturb_sign, u, du ) CASE (13) !Module/Mesh/Field: u%PRPMesh%TranslationDisp = 13 u%PRPMesh%TranslationDisp (fieldIndx,node) = u%PRPMesh%TranslationDisp (fieldIndx,node) + du * perturb_sign CASE (14) !Module/Mesh/Field: u%PRPMesh%Orientation = 14 - CALL PerturbOrientationMatrix( u%PRPMesh%Orientation(:,:,node), du * perturb_sign, fieldIndx, UseSmlAngle=.true. ) + CALL PerturbOrientationMatrix( u%PRPMesh%Orientation(:,:,node), du * perturb_sign, fieldIndx, UseSmlAngle=.false. ) CASE (15) !Module/Mesh/Field: u%PRPMesh%TranslationVel = 15 u%PRPMesh%TranslationVel( fieldIndx,node) = u%PRPMesh%TranslationVel( fieldIndx,node) + du * perturb_sign CASE (16) !Module/Mesh/Field: u%PRPMesh%RotationVel = 16 @@ -3496,7 +2657,7 @@ SUBROUTINE HD_Perturb_u( p, n, perturb_sign, u, du ) CASE ( 7) !Module/Mesh/Field: u%PRPMesh%TranslationDisp = 7 u%PRPMesh%TranslationDisp (fieldIndx,node) = u%PRPMesh%TranslationDisp (fieldIndx,node) + du * perturb_sign CASE ( 8) !Module/Mesh/Field: u%PRPMesh%Orientation = 8 - CALL PerturbOrientationMatrix( u%PRPMesh%Orientation(:,:,node), du * perturb_sign, fieldIndx, UseSmlAngle=.true. ) + CALL PerturbOrientationMatrix( u%PRPMesh%Orientation(:,:,node), du * perturb_sign, fieldIndx, UseSmlAngle=.false. ) CASE ( 9) !Module/Mesh/Field: u%PRPMesh%TranslationVel = 9 u%PRPMesh%TranslationVel( fieldIndx,node) = u%PRPMesh%TranslationVel( fieldIndx,node) + du * perturb_sign CASE (10) !Module/Mesh/Field: u%PRPMesh%RotationVel = 10 @@ -3512,7 +2673,7 @@ SUBROUTINE HD_Perturb_u( p, n, perturb_sign, u, du ) CASE (1) !Module/Mesh/Field: u%WAMITMesh%TranslationDisp = 1 u%WAMITMesh%TranslationDisp (fieldIndx,node) = u%WAMITMesh%TranslationDisp (fieldIndx,node) + du * perturb_sign CASE (2) !Module/Mesh/Field: u%WAMITMesh%Orientation = 2 - CALL PerturbOrientationMatrix( u%WAMITMesh%Orientation(:,:,node), du * perturb_sign, fieldIndx, UseSmlAngle=.true. ) + CALL PerturbOrientationMatrix( u%WAMITMesh%Orientation(:,:,node), du * perturb_sign, fieldIndx, UseSmlAngle=.false. ) CASE (3) !Module/Mesh/Field: u%WAMITMesh%TranslationVel = 3 u%WAMITMesh%TranslationVel( fieldIndx,node) = u%WAMITMesh%TranslationVel( fieldIndx,node) + du * perturb_sign CASE (4) !Module/Mesh/Field: u%WAMITMesh%RotationVel = 4 @@ -3526,7 +2687,7 @@ SUBROUTINE HD_Perturb_u( p, n, perturb_sign, u, du ) CASE ( 7) !Module/Mesh/Field: u%PRPMesh%TranslationDisp = 7 u%PRPMesh%TranslationDisp (fieldIndx,node) = u%PRPMesh%TranslationDisp (fieldIndx,node) + du * perturb_sign CASE ( 8) !Module/Mesh/Field: u%PRPMesh%Orientation = 8 - CALL PerturbOrientationMatrix( u%PRPMesh%Orientation(:,:,node), du * perturb_sign, fieldIndx, UseSmlAngle=.true. ) + CALL PerturbOrientationMatrix( u%PRPMesh%Orientation(:,:,node), du * perturb_sign, fieldIndx, UseSmlAngle=.false. ) CASE ( 9) !Module/Mesh/Field: u%PRPMesh%TranslationVel = 9 u%PRPMesh%TranslationVel( fieldIndx,node) = u%PRPMesh%TranslationVel( fieldIndx,node) + du * perturb_sign CASE (10) !Module/Mesh/Field: u%PRPMesh%RotationVel = 10 @@ -3541,7 +2702,7 @@ SUBROUTINE HD_Perturb_u( p, n, perturb_sign, u, du ) CASE ( 1) !Module/Mesh/Field: u%PRPMesh%TranslationDisp = 1 u%PRPMesh%TranslationDisp (fieldIndx,node) = u%PRPMesh%TranslationDisp (fieldIndx,node) + du * perturb_sign CASE ( 2) !Module/Mesh/Field: u%PRPMesh%Orientation = 2 - CALL PerturbOrientationMatrix( u%PRPMesh%Orientation(:,:,node), du * perturb_sign, fieldIndx, UseSmlAngle=.true. ) + CALL PerturbOrientationMatrix( u%PRPMesh%Orientation(:,:,node), du * perturb_sign, fieldIndx, UseSmlAngle=.false. ) CASE ( 3) !Module/Mesh/Field: u%PRPMesh%TranslationVel = 3 u%PRPMesh%TranslationVel( fieldIndx,node) = u%PRPMesh%TranslationVel( fieldIndx,node) + du * perturb_sign CASE ( 4) !Module/Mesh/Field: u%PRPMesh%RotationVel = 4 @@ -3552,7 +2713,27 @@ SUBROUTINE HD_Perturb_u( p, n, perturb_sign, u, du ) u%PRPMesh%RotationAcc(fieldIndx,node) = u%PRPMesh%RotationAcc(fieldIndx,node) + du * perturb_sign END SELECT end if - + +!FIXME: when SeaState superposition with IfW/FlowField for current is enabled, we must also add in the perturbations of those extended inputs (HWindSpeed/PLexp/PropagationDir) +! Some revisions needed at that time: +! - expand p%Jac_u_indx to include the extended inputs (currently ignores them) +! - copy what was done in AD15 for perturbing these extended inputs (may require extensive modifications to data management) +! Until then, we should add a warning that linearization with IfW/FlowField currents in HD is not allowed for MHK turbines (no warning at present). +! +! Example code chunk from AD15. May be superceded by new linearization system later +! ! Extended inputs +! ! Module/Mesh/Field: HWindSpeed = 37 +! ! Module/Mesh/Field: PLexp = 38 +! ! Module/Mesh/Field: PropagationDir = 39 +! case(37,38,39) +! FlowField_du = 0.0_R8Ki +! select case( p%Jac_u_indx(n,1) ) +! case (37); FlowField_du(1) = du *perturb_sign +! case (38); FlowField_du(2) = du *perturb_sign +! case (39); FlowField_du(3) = du *perturb_sign +! end select +! call IfW_UniformWind_Perturb(FlowField_perturb, FlowField_du) +! call AD_CalcWind_Rotor(t, u_perturb, FlowField_perturb, p, RotInflow_perturb, StartNode, ErrStat, ErrMsg) END SUBROUTINE HD_Perturb_u !---------------------------------------------------------------------------------------------------------------------------------- !> This routine perturbs the nth element of the continuous state array. @@ -3613,7 +2794,6 @@ SUBROUTINE Compute_dY(p, y_p, y_m, delta, dY) ! local variables: integer(IntKi) :: indx_first ! index indicating next value of dY to be filled - logical :: Mask(FIELDMASK_SIZE) ! flags to determine if this field is part of the packing integer(IntKi) :: k @@ -3661,8 +2841,8 @@ SUBROUTINE HD_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, - INTEGER(IntKi) :: i, j, k, index, nu - INTEGER(IntKi) :: ny + INTEGER(IntKi) :: i, j, index, nu + integer(IntKi), parameter :: nu_extended = 4 ! 4 total extended inputs: WaveElev0 from SeaSt, HWindSpeed / PLexp / PropagationDir from IfW (turbulent sea current) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'HD_GetOP' @@ -3691,7 +2871,7 @@ SUBROUTINE HD_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, end if nu = nu + u%PRPMesh%NNodes * 6 ! p%Jac_u_indx has 3 for Orientation, but we need 9 at each node - nu = nu + 1 ! Extended input + nu = nu + nu_extended ! Extended input call AllocAry(u_op, nu,'u_op',ErrStat2,ErrMsg2) ! call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) @@ -3718,10 +2898,27 @@ SUBROUTINE HD_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, call PackMotionMesh(u%PRPMesh, u_op, index, FieldMask=Mask) - ! extended input: - u_op(index) = 0.0_R8Ki !u%WaveElev0 - - + ! extended inputs: + u_op(index) = 0.0_R8Ki; index=index+1 ! WaveElev0 -- linearization not allowed for non-zero + u_op(index) = 0.0_R8Ki; index=index+1 ! HWindSpeed + u_op(index) = 0.0_R8Ki; index=index+1 ! PLexp + u_op(index) = 0.0_R8Ki; index=index+1 ! PropagationDir + +!FIXME: when sea current from IfW/FlowField is enabled, this code must be updated and enabled +! !------------------------------ +! ! Extended inputs -- Linearization is only possible with Steady or Uniform Wind, so take advantage of that here +! ! Module/Mesh/Field: HWindSpeed = 37 +! ! Module/Mesh/Field: PLexp = 38 +! ! Module/Mesh/Field: PropagationDir = 39 +! call IfW_UniformWind_GetOP(p_AD%FlowField%Uniform, t, .false. , OP_out) +! ! HWindSpeed +! u_op(index) = OP_out(1); index = index + 1 +! ! PLexp +! u_op(index) = OP_out(2); index = index + 1 +! ! PropagationDir (include AngleH in calculation if any) +! u_op(index) = OP_out(3) + p_AD%FlowField%PropagationDir; index = index + 1 + + END IF !.................................. diff --git a/modules/hydrodyn/src/HydroDyn.txt b/modules/hydrodyn/src/HydroDyn.txt index 45a63e0c65..44d3a48264 100644 --- a/modules/hydrodyn/src/HydroDyn.txt +++ b/modules/hydrodyn/src/HydroDyn.txt @@ -14,19 +14,16 @@ # ...... Include files (definitions from NWTC Library) ............................................................................ # make sure that the file name does not have any trailing white spaces! include Registry_NWTC_Library.txt -usefrom Current.txt -usefrom Waves.txt -usefrom Waves2.txt usefrom Conv_Radiation.txt usefrom SS_Radiation.txt usefrom SS_Excitation.txt usefrom WAMIT.txt usefrom WAMIT2.txt usefrom Morison.txt -#usefrom FIT.txt +usefrom SeaSt_WaveField.txt -param HydroDyn/HydroDyn unused INTEGER MaxHDOutputs - 537 - "The maximum number of output channels supported by this module" - -param HydroDyn/HydroDyn unused INTEGER MaxUserOutputs - 4583 - " Total possible number of output channels: Waves2 = 18 + SS_Excitation = 7 + SS_Radiation = 7 + Morison= 4032 + HydroDyn=519 = 4583" - +param HydroDyn/HydroDyn unused INTEGER MaxHDOutputs - 510 - "The maximum number of output channels supported by this module" - +param HydroDyn/HydroDyn unused INTEGER MaxUserOutputs - 5150 - " Total possible number of output channels: SS_Excitation = 7 + SS_Radiation = 7 + Morison= 4626 + HydroDyn=510 = 5150" - ######################### # ..... Input file data ........................................................................................................... @@ -37,9 +34,6 @@ typedef ^ ^ ReKi typedef ^ ^ ReKi AddCLin {:}{:}{:} - - "Additional stiffness matrix" - typedef ^ ^ ReKi AddBLin {:}{:}{:} - - "Additional linear damping matrix" - typedef ^ ^ ReKi AddBQuad {:}{:}{:} - - "Additional quadratic damping (drag) matrix" - -typedef ^ ^ Waves_InitInputType Waves - - - "Initialization data for Waves module" - -typedef ^ ^ Waves2_InitInputType Waves2 - - - "Initialization data for Waves module" - -typedef ^ ^ Current_InitInputType Current - - - "Initialization data for Current module" - typedef ^ ^ CHARACTER(1024) PotFile {:} - - "The name of the root potential flow file (without extension for WAMIT, complete name for FIT)" - typedef ^ ^ INTEGER nWAMITObj - - - "number of WAMIT input files. If NBodyMod = 1 then nPotFiles will be 1 even if NBody > 1" - typedef ^ ^ INTEGER vecMultiplier - - - "multiplier for the WAMIT vectors and matrices. If NBodyMod=1 then this = NBody, else 1" - @@ -69,113 +63,78 @@ typedef ^ ^ LOGICAL typedef ^ ^ INTEGER UnSum - - - "File unit for the HydroDyn summary file [-1 = no summary file]" - typedef ^ ^ CHARACTER(20) OutFmt - - - "Output format for numerical results" - typedef ^ ^ CHARACTER(20) OutSFmt - - - "Output format for header strings" - - - - +typedef ^ ^ INTEGER PtfmYMod - - - "Large yaw model" - +typedef ^ ^ ReKi PtfmRefY - - - "Initial reference yaw offset" (rad) +typedef ^ ^ ReKi PtfmYCutoff - - - "Low-pass cutoff frequency for filtering the platform yaw motion to obtain the reference yaw offset" (Hz) +# typedef HydroDyn/HydroDyn InitInputType CHARACTER(1024) InputFile - - - "Supplied by Driver: full path and filename for the HydroDyn module" - typedef ^ ^ LOGICAL UseInputFile - .TRUE. - "Supplied by Driver: .TRUE. if using a input file, .FALSE. if all inputs are being passed in by the caller" - typedef ^ ^ FileInfoType PassedFileData - - - "If we don't use the input file, pass everything through this" - typedef ^ ^ CHARACTER(1024) OutRootName - - - "Supplied by Driver: The name of the root file (without extension) including the full path" - -typedef ^ ^ Logical Linearize - .FALSE. - "Flag that tells this module if the glue code wants to linearize." - +typedef ^ ^ Logical Linearize - .FALSE. - "Flag that tells this module if the glue code wants to linearize." - typedef ^ ^ ReKi Gravity - - - "Supplied by Driver: Gravitational acceleration" "(m/s^2)" -typedef ^ ^ ReKi defWtrDens - - - "Default water density from the driver; may be overwritten " "(kg/m^3)" -typedef ^ ^ ReKi defWtrDpth - - - "Default water depth from the driver; may be overwritten " "m" -typedef ^ ^ ReKi defMSL2SWL - - - "Default mean sea level to still water level from the driver; may be overwritten" "m" typedef ^ ^ DbKi TMax - - - "Supplied by Driver: The total simulation time" "(sec)" -typedef ^ ^ LOGICAL HasIce - - - "Supplied by Driver: Whether this simulation has ice loading (flag)" - -typedef ^ ^ SiKi WaveElevXY {:}{:} - - "Supplied by Driver: X-Y locations for WaveElevation output (for visualization). First dimension is the X (1) and Y (2) coordinate. Second dimension is the point number." "m,-" -typedef ^ ^ INTEGER WaveFieldMod - - - "Wave field handling (-) (switch) 0: use individual HydroDyn inputs without adjustment, 1: adjust wave phases based on turbine offsets from farm origin" - -typedef ^ ^ ReKi PtfmLocationX - - - "Supplied by Driver: X coordinate of platform location in the wave field" "m" -typedef ^ ^ ReKi PtfmLocationY - - - "Supplied by Driver: Y coordinate of platform location in the wave field" "m" typedef ^ ^ logical VisMeshes - .false. - "Output visualization meshes" - +typedef ^ ^ LOGICAL InvalidWithSSExctn - - - "Whether SeaState configuration is invalid with HydroDyn's state-space excitation (ExctnMod=2)" (-) +typedef ^ ^ SeaSt_WaveFieldType *WaveField - - - "Pointer to SeaState wave field" - +typedef ^ ^ ReKi PlatformPos {6} - - "Initial platform position (6 DOFs)" # # # Define outputs from the initialization routine here: # -typedef ^ InitOutputType WAMIT_InitOutputType WAMIT {:} - - "Initialization output from the WAMIT module" - -typedef ^ InitOutputType WAMIT2_InitOutputType WAMIT2 {:} - - "Initialization output from the WAMIT2 module" - -typedef ^ InitOutputType Waves2_InitOutputType Waves2 - - - "Initialization output from the Waves2 module" - -typedef ^ ^ Morison_InitOutputType Morison - - - "Initialization output from the Morison module" - -typedef ^ ^ CHARACTER(ChanLen) WriteOutputHdr {:} - - "The is the list of all HD-related output channel header strings (includes all sub-module channels)" - +typedef ^ InitOutputType Morison_InitOutputType Morison - - - "Initialization output from the Morison module" - +typedef ^ InitOutputType CHARACTER(ChanLen) WriteOutputHdr {:} - - "The is the list of all HD-related output channel header strings (includes all sub-module channels)" - typedef ^ ^ CHARACTER(ChanLen) WriteOutputUnt {:} - - "The is the list of all HD-related output channel unit strings (includes all sub-module channels)" - -typedef ^ ^ SiKi WaveElevSeries {:}{:} - - "Wave elevation time-series at each of the points given by WaveElevXY. First dimension is the timestep. Second dimension is XY point number corresponding to second dimension of WaveElevXY." (m) typedef ^ ^ ProgDesc Ver - - - "Version of HydroDyn" -typedef ^ ^ ReKi WtrDens - - - "Water density" (kg/m^3) -typedef ^ ^ ReKi WtrDpth - - - "Water depth" (m) -typedef ^ ^ ReKi MSL2SWL - - - "Offset between still-water level and mean sea level" (m) typedef ^ ^ CHARACTER(LinChanLen) LinNames_y {:} - - "Names of the outputs used in linearization" - typedef ^ ^ CHARACTER(LinChanLen) LinNames_x {:} - - "Names of the continuous states used in linearization" - typedef ^ ^ CHARACTER(LinChanLen) LinNames_u {:} - - "Names of the inputs used in linearization" - typedef ^ InitOutputType INTEGER DerivOrder_x {:} - - "Integer that tells FAST/MBC3 the maximum derivative order of continuous states used in linearization" - typedef ^ ^ LOGICAL IsLoad_u {:} - - "Flag that tells FAST if the inputs used in linearization are loads (for preconditioning matrix)" - - -typedef ^ ^ ReKi WaveVel {:}{:}{:} - - "output for now just to pass to MoorDyn" - -typedef ^ ^ ReKi WaveAcc {:}{:}{:} - - "output for now just to pass to MoorDyn" - -typedef ^ ^ ReKi WaveDynP {:}{:} - - "output for now just to pass to MoorDyn" - -typedef ^ ^ ReKi WaveElev {:}{:} - - "output for now just to pass to MoorDyn" - -typedef ^ ^ ReKi WaveTime {:} - - "output for now just to pass to MoorDyn" - - - # ..... HD_ModuleMapType .................................................................................................................... typedef ^ HD_ModuleMapType MeshMapType uW_P_2_PRP_P - - - "Mesh mapping data: WAMIT body kinematics to PRP node at (0,0,0)" - typedef ^ HD_ModuleMapType MeshMapType W_P_2_PRP_P - - - "Mesh mapping data: WAMIT loads to PRP node at (0,0,0)" - typedef ^ HD_ModuleMapType MeshMapType M_P_2_PRP_P - - - "Mesh mapping data: lumped Morison loads to PRP node at (0,0,0)" - - # # # ..... States .................................................................................................................... # Define continuous (differentiable) states here: # typedef ^ ContinuousStateType WAMIT_ContinuousStateType WAMIT {:} - - "continuous states from the wamit module" - -typedef ^ ContinuousStateType WAMIT2_ContinuousStateType WAMIT2 {:} - - "continuous states from the wamit2 module" - -typedef ^ ContinuousStateType Waves2_ContinuousStateType Waves2 - - - "continuous states from the waves2 module" - typedef ^ ContinuousStateType Morison_ContinuousStateType Morison - - - "continuous states from the Morison module" - # # # Define discrete (nondifferentiable) states here: # typedef ^ DiscreteStateType WAMIT_DiscreteStateType WAMIT {:} - - "discrete states from the wamit module" - -typedef ^ DiscreteStateType WAMIT2_DiscreteStateType WAMIT2 {:} - - "discrete states from the wamit2 module" - -#typedef ^ DiscreteStateType FIT_DiscreteStateType FIT - - - "discrete states from the FIT module" - -typedef ^ DiscreteStateType Waves2_DiscreteStateType Waves2 - - - "discrete states from the waves2 module" - typedef ^ DiscreteStateType Morison_DiscreteStateType Morison - - - "discrete states from the Morison module" - +typedef ^ DiscreteStateType ReKi PtfmRefY {:} - - "Reference yaw position of the PRP relative to the inertial frame - Current step and two previous steps" (radians) # # # Define constraint states here: # typedef ^ ConstraintStateType WAMIT_ConstraintStateType WAMIT - - - "constraint states from WAMIT (may be empty)" - -typedef ^ ConstraintStateType WAMIT2_ConstraintStateType WAMIT2 - - - "constraint states from WAMIT2 (may be empty)" - -typedef ^ ConstraintStateType Waves2_ConstraintStateType Waves2 - - - "constraint states from the waves2 module" - typedef ^ ConstraintStateType Morison_ConstraintStateType Morison - - - "constraint states from the Morison module" - # # # Define any other states here: # typedef ^ OtherStateType WAMIT_OtherStateType WAMIT {:} - - "OtherState information from the WAMIT module" - -typedef ^ OtherStateType WAMIT2_OtherStateType WAMIT2 {:} - - "OtherState information from the WAMIT2 module" - -#typedef ^ OtherStateType FIT_OtherStateType FIT - - - "OtherState information from the FIT module" - -typedef ^ OtherStateType Waves2_OtherStateType Waves2 - - - "OtherState information from the Waves2 module" - typedef ^ ^ Morison_OtherStateType Morison - - - "OtherState information from the Morison module" - - # ..... 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 MeshType AllHdroOrigin - - - "An intermediate mesh used to transfer hydrodynamic loads from the various HD-related meshes to the AllHdroOrigin mesh" - -typedef ^ ^ MeshType MrsnMesh_position - - - "A motions mesh which has all translational displacements set to zero. Used in the transfer of hydrodynamic loads from the various HD-related meshes to the AllHdroOrigin mesh" - typedef ^ ^ HD_ModuleMapType HD_MeshMap - - - typedef ^ ^ INTEGER Decimate - - - "The output decimation counter" - typedef ^ ^ DbKi LastOutTime - - - "Last time step which was written to the output file (sec)" - -typedef ^ ^ INTEGER LastIndWave - - - "The last index used in the wave kinematics arrays, used to optimize interpolation" - typedef ^ ^ ReKi F_PtfmAdd {:} - - "The total forces and moments due to additional pre-load, stiffness, and damping" - typedef ^ ^ ReKi F_Hydro {6} - - "The total hydrodynamic forces and moments integrated about the (0,0,0) platform reference point" - typedef ^ ^ ReKi F_Waves {:} - - "The total waves forces on a WAMIT body calculated by first and second order methods (WAMIT and WAMIT2 modules)" - typedef ^ ^ WAMIT_MiscVarType WAMIT {:} - - "misc var information from the WAMIT module" - typedef ^ ^ WAMIT2_MiscVarType WAMIT2 {:} - - "misc var information from the WAMIT2 module" - -typedef ^ ^ Waves2_MiscVarType Waves2 - - - "misc var information from the Waves2 module" - typedef ^ ^ Morison_MiscVarType Morison - - - "misc var information from the Morison module" - typedef ^ ^ WAMIT_InputType u_WAMIT {:} - - "WAMIT module inputs" - -typedef ^ ^ WAMIT2_InputType u_WAMIT2 {:} - - "WAMIT2 module inputs" - -typedef ^ ^ Waves2_InputType u_Waves2 - - - "Waves2 module inputs" - # ..... Parameters ................................................................................................................ # Define parameters here: # Time step for integration of continuous states (if a fixed-step integrator is used) and update of discrete states: @@ -185,8 +144,6 @@ typedef ^ ^ INTEGER typedef ^ ^ WAMIT_ParameterType WAMIT {:} - - "Parameter data for the WAMIT module" - typedef ^ ^ WAMIT2_ParameterType WAMIT2 {:} - - "Parameter data for the WAMIT2 module" - typedef ^ ^ LOGICAL WAMIT2used - .FALSE. - "Indicates when WAMIT2 is used. Shortcuts some calculations" - -#typedef ^ ^ FIT_ParameterType FIT - - - "Parameter data for the FIT module" - -typedef ^ ^ Waves2_ParameterType Waves2 - - - "Parameter data for the Waves2 module" - typedef ^ ^ Morison_ParameterType Morison - - - "Parameter data for the Morison module" - typedef ^ ^ INTEGER PotMod - - - "1 if using WAMIT model, 0 if no potential flow model, or 2 if FIT model" - typedef ^ ^ INTEGER NBody - - - "[>=1; only used when PotMod=1. If NBodyMod=1, the WAMIT data contains a vector of size 6*NBody x 1 and matrices of size 6*NBody x 6*NBody; if NBodyMod>1, there are NBody sets of WAMIT data each with a vector of size 6 x 1 and matrices of size 6 x 6]" - @@ -194,13 +151,6 @@ typedef ^ ^ INTEGER typedef ^ ^ INTEGER totalStates - - - "Number of excitation and radiation states for all WAMIT bodies" - typedef ^ ^ INTEGER totalExctnStates - - - "Number of excitation states for all WAMIT bodies" - typedef ^ ^ INTEGER totalRdtnStates - - - "Number of radiation states for all WAMIT bodies" - -typedef ^ ^ SiKi WaveTime {:} - - "Array of time samples, (sec)" - -typedef ^ ^ INTEGER NStepWave - - - "Number of data points in the wave kinematics arrays" - -typedef ^ ^ INTEGER NWaveElev - - - "Number of wave elevation outputs" - -typedef ^ ^ SiKi WaveElev {:}{:} - - "Total wave elevation" - -typedef ^ ^ SiKi WaveElev1 {:}{:} - - "First order wave elevation" - -typedef ^ ^ SiKi WaveElev2 {:}{:} - - "Second order wave elevation" - -typedef ^ ^ ReKi WtrDpth - - - "Water depth" (m) typedef ^ ^ ReKi AddF0 {:}{:} - - "Additional pre-load forces and moments (N,N,N,N-m,N-m,N-m)" - typedef ^ ^ ReKi AddCLin {:}{:}{:} - - "Additional stiffness matrix" - typedef ^ ^ ReKi AddBLin {:}{:}{:} - - "Additional linear damping matrix" - @@ -215,11 +165,14 @@ typedef ^ ^ CHARACTER(2 typedef ^ ^ CHARACTER(ChanLen) Delim - - - "Delimiter string for outputs, defaults to tab-delimiters" - typedef ^ ^ INTEGER UnOutFile - - - "File unit for the HydroDyn outputs" - typedef ^ ^ INTEGER OutDec - - - "Write every OutDec time steps" - -typedef ^ ^ Integer Jac_u_indx {:}{:} - - "matrix to help fill/pack the u vector in computing the jacobian" - -typedef ^ ^ R8Ki du {:} - - "vector that determines size of perturbation for u (inputs)" - -typedef ^ ^ R8Ki dx {:} - - "vector that determines size of perturbation for x (continuous states)" - -typedef ^ ^ Integer Jac_ny - - - "number of outputs in jacobian matrix" - +typedef ^ ^ Integer Jac_u_indx {:}{:} - - "matrix to help fill/pack the u vector in computing the jacobian" - +typedef ^ ^ R8Ki du {:} - - "vector that determines size of perturbation for u (inputs)" - +typedef ^ ^ R8Ki dx {:} - - "vector that determines size of perturbation for x (continuous states)" - +typedef ^ ^ Integer Jac_ny - - - "number of outputs in jacobian matrix" - typedef ^ ^ logical VisMeshes - .false. - "Output visualization meshes" - +typedef ^ ^ SeaSt_WaveFieldType *WaveField - - - "Pointer to SeaState wave field" - +typedef ^ ^ INTEGER PtfmYMod - - - "Large yaw model" - +typedef ^ ^ ReKi CYawFilt - - - "Low-pass filter constant for reference platform yaw position PtfmRefY" - # # # ..... Inputs .................................................................................................................... @@ -234,7 +187,6 @@ typedef ^ InputType MeshType # Define outputs that are contained on the mesh here: typedef ^ OutputType WAMIT_OutputType WAMIT {:} - - "WAMIT module outputs" - typedef ^ OutputType WAMIT2_OutputType WAMIT2 {:} - - "WAMIT2 module outputs" - -typedef ^ OutputType Waves2_OutputType Waves2 - - - "Waves2 module outputs" - typedef ^ ^ Morison_OutputType Morison - - - "Morison module outputs" - typedef ^ OutputType MeshType WAMITMesh - - - "Point Loads at the WAMIT reference point(s) in the inertial frame" - typedef ^ ^ ReKi WriteOutput {:} - - "Outputs to be written to the output file(s)" - diff --git a/modules/hydrodyn/src/HydroDyn_C_Binding.f90 b/modules/hydrodyn/src/HydroDyn_C_Binding.f90 index 532b7fc44b..644df17433 100644 --- a/modules/hydrodyn/src/HydroDyn_C_Binding.f90 +++ b/modules/hydrodyn/src/HydroDyn_C_Binding.f90 @@ -20,6 +20,8 @@ MODULE HydroDyn_C_BINDING USE ISO_C_BINDING + USE SeaState + USE SeaState_Types USE HydroDyn USE HydroDyn_Types USE NWTC_Library @@ -42,7 +44,7 @@ MODULE HydroDyn_C_BINDING !------------------------------------------------------------------------------------ ! Version info for display - type(ProgDesc), parameter :: version = ProgDesc( 'HydroDyn library', '', '' ) + type(ProgDesc), parameter :: version = ProgDesc( 'HydroDyn+SeaState library', '', '' ) !------------------------------------------------------------------------------------ ! Potential issues @@ -70,16 +72,40 @@ MODULE HydroDyn_C_BINDING integer(IntKi) :: InterpOrder !------------------------------ ! Primary HD derived data types - type(HydroDyn_InputType), allocatable :: u(:) !< Inputs at T, T-dt, T-2*dt (history kept for updating states) - type(HydroDyn_InitInputType) :: InitInp !< Initialization data - type(HydroDyn_InitOutputType) :: InitOutData !< Initial output data -- Names, units, and version info. - type(HydroDyn_ParameterType) :: p !< Parameters - type(HydroDyn_ContinuousStateType) :: x(0:2) !< continuous states at Time t and t+dt (predicted) - type(HydroDyn_DiscreteStateType) :: xd(0:2) !< discrete states at Time t and t+dt (predicted) - type(HydroDyn_ConstraintStateType) :: z(0:2) !< Constraint states at Time t and t+dt (predicted) - type(HydroDyn_OtherStateType) :: OtherStates(0:2) !< Initial other/optimization states - type(HydroDyn_OutputType) :: y !< Initial output (outputs are not calculated; only the output mesh is initialized) - type(HydroDyn_MiscVarType) :: m !< Misc variables for optimization (not copied in glue code) + type :: HD_data + type(HydroDyn_InputType), allocatable :: u(:) !< Inputs at T, T-dt, T-2*dt (history kept for updating states) + type(HydroDyn_InitInputType) :: InitInp !< Initialization data + type(HydroDyn_InitOutputType) :: InitOutData !< Initial output data -- Names, units, and version info. + type(HydroDyn_ParameterType) :: p !< Parameters + type(HydroDyn_ContinuousStateType) :: x(0:2) !< continuous states at Time t and t+dt (predicted) + type(HydroDyn_DiscreteStateType) :: xd(0:2) !< discrete states at Time t and t+dt (predicted) + type(HydroDyn_ConstraintStateType) :: z(0:2) !< Constraint states at Time t and t+dt (predicted) + type(HydroDyn_OtherStateType) :: OtherStates(0:2) !< Initial other/optimization states + type(HydroDyn_OutputType) :: y !< Initial output (outputs are not calculated; only the output mesh is initialized) + type(HydroDyn_MiscVarType) :: m !< Misc variables for optimization (not copied in glue code) + logical :: Initialized = .FALSE. + end type HD_data + + type(HD_data) :: HD + + ! Primary SeaState derived data types + ! NOTE: SeaSt does not contain states, so only using single instance of states. + type :: SeaSt_data + type(SeaSt_InputType) :: u !< Inputs at T -- since no states, only need single + type(SeaSt_InitInputType) :: InitInp !< Initialization data + type(SeaSt_InitOutputType) :: InitOutData !< Initial output data -- Names, units, and version info. + type(SeaSt_ParameterType) :: p !< Parameters + type(SeaSt_ContinuousStateType) :: x !< continuous states -- contains no data + type(SeaSt_DiscreteStateType) :: xd !< discrete states -- contains no data + type(SeaSt_ConstraintStateType) :: z !< Constraint states -- contains no data + type(SeaSt_OtherStateType) :: OtherStates !< Initial other/optimization states + type(SeaSt_OutputType) :: y !< Initial output (outputs are not calculated; only the output mesh is initialized) + type(SeaSt_MiscVarType) :: m !< Misc variables for optimization (not copied in glue code) + logical :: Initialized = .FALSE. + end type SeaSt_data + + type(SeaSt_data) :: SeaSt + !------------------------------ ! Time tracking ! When we are performing a correction step, time information of previous @@ -174,7 +200,9 @@ end subroutine SetErr !=============================================================================================================== !--------------------------------------------- HydroDyn Init---------------------------------------------------- !=============================================================================================================== -SUBROUTINE HydroDyn_C_Init( OutRootName_C, InputFileString_C, InputFileStringLength_C, & +SUBROUTINE HydroDyn_C_Init( OutRootName_C, & + SeaSt_InputFileString_C, SeaSt_InputFileStringLength_C, & + HD_InputFileString_C, HD_InputFileStringLength_C, & Gravity_C, defWtrDens_C, defWtrDpth_C, defMSL2SWL_C, & PtfmRefPtPositionX_C, PtfmRefPtPositionY_C, & NumNodePts_C, InitNodePositions_C, & @@ -189,8 +217,10 @@ SUBROUTINE HydroDyn_C_Init( OutRootName_C, InputFileString_C, InputFileStringLen #endif character(kind=c_char), intent(in ) :: OutRootName_C(IntfStrLen) !< Root name to use for echo files and other - type(c_ptr), intent(in ) :: InputFileString_C !< Input file as a single string with lines deliniated by C_NULL_CHAR - integer(c_int), intent(in ) :: InputFileStringLength_C !< lenght of the input file string + type(c_ptr), intent(in ) :: SeaSt_InputFileString_C !< SeaSt input file as a single string with lines deliniated by C_NULL_CHAR + integer(c_int), intent(in ) :: SeaSt_InputFileStringLength_C !< SeaSt length of the input file string + type(c_ptr), intent(in ) :: HD_InputFileString_C !< HD input file as a single string with lines deliniated by C_NULL_CHAR + integer(c_int), intent(in ) :: HD_InputFileStringLength_C !< HD length of the input file string real(c_float), intent(in ) :: Gravity_C !< Gravitational constant (set by calling code) real(c_float), intent(in ) :: defWtrDens_C !< Default value for water density (may be overridden by input file) real(c_float), intent(in ) :: defWtrDpth_C !< Default value for water density (may be overridden by input file) @@ -213,16 +243,17 @@ SUBROUTINE HydroDyn_C_Init( OutRootName_C, InputFileString_C, InputFileStringLen character(kind=c_char), intent( out) :: ErrMsg_C(ErrMsgLen_C) !< Error message (C_NULL_CHAR terminated) ! Local Variables - character(IntfStrLen) :: OutRootName !< Root name to use for echo files and other - character(kind=C_char, len=InputFileStringLength_C), pointer :: InputFileString !< Input file as a single string with NULL chracter separating lines - - real(DbKi) :: TimeInterval !< timestep for HD - integer(IntKi) :: ErrStat !< aggregated error message - character(ErrMsgLen) :: ErrMsg !< aggregated error message - integer(IntKi) :: ErrStat2 !< temporary error status from a call - character(ErrMsgLen) :: ErrMsg2 !< temporary error message from a call - integer(IntKi) :: i,j,k !< generic counters - character(*), parameter :: RoutineName = 'HydroDyn_C_Init' !< for error handling + character(IntfStrLen) :: OutRootName !< Root name to use for echo files and other + character(kind=C_char, len=SeaSt_InputFileStringLength_C), pointer :: SeaSt_InputFileString !< Input file as a single string with NULL chracter separating lines + character(kind=C_char, len=HD_InputFileStringLength_C), pointer :: HD_InputFileString !< Input file as a single string with NULL chracter separating lines + + real(DbKi) :: TimeInterval !< timestep for HD + integer(IntKi) :: ErrStat !< aggregated error message + character(ErrMsgLen) :: ErrMsg !< aggregated error message + integer(IntKi) :: ErrStat2 !< temporary error status from a call + character(ErrMsgLen) :: ErrMsg2 !< temporary error message from a call + integer(IntKi) :: i,j,k !< generic counters + character(*), parameter :: RoutineName = 'HydroDyn_C_Init' !< for error handling ! Initialize error handling ErrStat = ErrID_None @@ -240,43 +271,15 @@ SUBROUTINE HydroDyn_C_Init( OutRootName_C, InputFileString_C, InputFileStringLen if (Failed()) return endif - ! Get fortran pointer to C_NULL_CHAR deliniated input file as a string - call C_F_pointer(InputFileString_C, InputFileString) - - ! Get the data to pass to HD_Init - call InitFileInfo(InputFileString, InitInp%PassedFileData, ErrStat2, ErrMsg2); if (Failed()) return - - ! For diagnostic purposes, the following can be used to display the contents - ! of the InFileInfo data structure. - ! CU is the screen -- system dependent. - !call Print_FileInfo_Struct( CU, InitInp%PassedFileData ) - ! Set other inputs for calling HydroDyn_Init - InitInp%InputFile = "passed_hd_file" ! dummy - InitInp%UseInputFile = .FALSE. ! this probably should be passed in - InitInp%HasIce = .FALSE. ! Always keep at false unless interfacing to ice modules - ! Linearization - ! for now, set linearization to false. Pass this in later when interface supports it - ! Note: we may want to linearize at T=0 for added mass effects, but that might be - ! special case - InitInp%Linearize = .FALSE. - - ! RootName -- for output of echo or other files - OutRootName = TRANSFER( OutRootName_C, OutRootName ) - i = INDEX(OutRootName,C_NULL_CHAR) - 1 ! if this has a c null character at the end... - if ( i > 0 ) OutRootName = OutRootName(1:I) ! remove it - InitInp%OutRootName = trim(OutRootName) - - ! Values passed in - InitInp%Gravity = REAL(Gravity_C, ReKi) - InitInp%defWtrDens = REAL(defWtrDens_C, ReKi) - InitInp%defWtrDpth = REAL(defWtrDpth_C, ReKi) - InitInp%defMSL2SWL = REAL(defMSL2SWL_C, ReKi) + !-------------------------------------------------------------------------------------------------------------------------------- + ! Initialize wrapper variables + !-------------------------------------------------------------------------------------------------------------------------------- + ! Simulation time TimeInterval = REAL(DT_C, DbKi) dT_Global = TimeInterval ! Assume this DT is constant for all simulation N_Global = 0_IntKi ! Assume we are on timestep 0 at start t_initial = REAL(T_Initial_C, DbKi) - InitInp%TMax = REAL(TMax_C, DbKi) ! Number of bodies and initial positions ! - NumNodePts is the number of interface Mesh points we are expecting on the python @@ -294,31 +297,15 @@ SUBROUTINE HydroDyn_C_Init( OutRootName_C, InputFileString_C, InputFileStringLen call AllocAry( tmpNodeFrc, 6, NumNodePts, "tmpNodeFrc", ErrStat2, ErrMsg2 ); if (Failed()) return tmpNodePos(1:6,1:NumNodePts) = reshape( real(InitNodePositions_C(1:6*NumNodePts),ReKi), (/6,NumNodePts/) ) - ! Platform reference position - ! The HD model uses this for building the moddel. This is only specified as an (X,Y) - ! position (no Z). - InitInp%PtfmLocationX = REAL(PtfmRefPtPositionX_C, ReKi) - InitInp%PtfmLocationY = REAL(PtfmRefPtPositionY_C, ReKi) - - - ! Wave eleveation output - ! Wave elevations can be exported for a set of points (grid or any other layout). - ! This feature is used only in the driver codes for exporting for visualization - ! and could be added to this inteface. - ! Skipping this for now. Maybe add later. - !InitInp%WaveElevXY - - !---------------------------------------------------- - ! Allocate input array u and corresponding InputTimes - !---------------------------------------------------- - ! These inputs are used in the time stepping algorithm within HD_UpdateStates + ! Allocate input array u and corresponding InputTimes for SeaState and HD + ! These inputs are used in the time stepping algorithm within HD%UpdateStates ! For quadratic interpolation (InterpOrder==2), 3 timesteps are used. For ! linear (InterOrder==1), 2 timesteps (the HD code can handle either). ! u(1) inputs at t ! u(2) inputs at t - dt ! u(3) inputs at t - 2*dt ! quadratic only - allocate(u(InterpOrder+1), STAT=ErrStat2) + allocate(HD%u(InterpOrder+1), STAT=ErrStat2) if (ErrStat2 /= 0) then ErrStat2 = ErrID_Fatal ErrMsg2 = "Could not allocate inuput" @@ -327,28 +314,122 @@ SUBROUTINE HydroDyn_C_Init( OutRootName_C, InputFileString_C, InputFileStringLen call AllocAry( InputTimes, InterpOrder+1, "InputTimes", ErrStat2, ErrMsg2 ); if (Failed()) return + + !-------------------------------------------------------------------------------------------------------------------------------- + ! SeaState initialize + !-------------------------------------------------------------------------------------------------------------------------------- + + ! Get fortran pointer to C_NULL_CHAR deliniated input file as a string + call C_F_pointer(SeaSt_InputFileString_C, SeaSt_InputFileString) + + ! Get the data to pass to SeaSt%Init + call InitFileInfo(SeaSt_InputFileString, SeaSt%InitInp%PassedFileData, ErrStat2, ErrMsg2); if (Failed()) return + + ! For diagnostic purposes, the following can be used to display the contents + ! of the InFileInfo data structure. + ! CU is the screen -- system dependent. + !call Print_FileInfo_Struct( CU, SeaSt%InitInp%PassedFileData ) + + ! Set other inputs for calling SeaState_Init + SeaSt%InitInp%hasIce = .FALSE. ! Always keep at false unless interfacing to ice modules + SeaSt%InitInp%InputFile = "passed_SeaSt_file" ! dummy + SeaSt%InitInp%UseInputFile = .FALSE. ! this probably should be passed in + ! Linearization + ! for now, set linearization to false. Pass this in later when interface supports it + ! Note: we may want to linearize at T=0 for added mass effects, but that might be + ! special case + HD%InitInp%Linearize = .FALSE. + + ! RootName -- for output of echo or other files + OutRootName = TRANSFER( OutRootName_C, OutRootName ) + i = INDEX(OutRootName,C_NULL_CHAR) - 1 ! if this has a c null character at the end... + if ( i > 0 ) OutRootName = OutRootName(1:I) ! remove it + SeaSt%InitInp%OutRootName = trim(OutRootName)//".SEA" + + ! Values passed in + SeaSt%InitInp%Gravity = REAL(Gravity_C, ReKi) + SeaSt%InitInp%defWtrDens = REAL(defWtrDens_C, ReKi) ! use values from SeaState + SeaSt%InitInp%defWtrDpth = REAL(defWtrDpth_C, ReKi) ! use values from SeaState + SeaSt%InitInp%defMSL2SWL = REAL(defMSL2SWL_C, ReKi) ! use values from SeaState + SeaSt%InitInp%TMax = REAL(TMax_C, DbKi) + + ! Platform reference position + ! This is only specified as an (X,Y) position (no Z). + SeaSt%InitInp%PtfmLocationX = REAL(PtfmRefPtPositionX_C, ReKi) + SeaSt%InitInp%PtfmLocationY = REAL(PtfmRefPtPositionY_C, ReKi) + + + ! Wave elevation output + ! Wave elevations can be exported for a set of points (grid or any other layout). + ! This feature is used only in the driver codes for exporting for visualization + ! and could be added to this inteface. + ! Skipping this for now. Maybe add later. + !SeaSt%InitInp%WaveElevXY + + call SeaSt_Init( SeaSt%InitInp, SeaSt%u, SeaSt%p, SeaSt%x, SeaSt%xd, SeaSt%z, SeaSt%OtherStates, SeaSt%y, SeaSt%m, TimeInterval, SeaSt%InitOutData, ErrStat, ErrMsg ) + if (Failed()) return + SeaSt%Initialized = .true. + + + + !-------------------------------------------------------------------------------------------------------------------------------- + ! HydroDyn initialize + !-------------------------------------------------------------------------------------------------------------------------------- + + ! Get fortran pointer to C_NULL_CHAR deliniated input file as a string + call C_F_pointer(HD_InputFileString_C, HD_InputFileString) + + ! Get the data to pass to HD%Init + call InitFileInfo(HD_InputFileString, HD%InitInp%PassedFileData, ErrStat2, ErrMsg2); if (Failed()) return + + ! For diagnostic purposes, the following can be used to display the contents + ! of the InFileInfo data structure. + ! CU is the screen -- system dependent. + !call Print_FileInfo_Struct( CU, HD%InitInp%PassedFileData ) + + ! Set other inputs for calling HydroDyn_Init + HD%InitInp%InputFile = "passed_hd_file" ! dummy + HD%InitInp%UseInputFile = .FALSE. ! this probably should be passed in + ! Linearization + ! for now, set linearization to false. Pass this in later when interface supports it + ! Note: we may want to linearize at T=0 for added mass effects, but that might be + ! special case + HD%InitInp%Linearize = .FALSE. + + ! RootName -- for output of echo or other files + OutRootName = TRANSFER( OutRootName_C, OutRootName ) + i = INDEX(OutRootName,C_NULL_CHAR) - 1 ! if this has a c null character at the end... + if ( i > 0 ) OutRootName = OutRootName(1:I) ! remove it + HD%InitInp%OutRootName = trim(OutRootName)//".HD" + + ! Values passed in + HD%InitInp%Gravity = REAL(Gravity_C, ReKi) + HD%InitInp%TMax = REAL(TMax_C, DbKi) + + ! Transfer data from SeaState + ! Need to set up other module's InitInput data here because we will also need to clean up SeaState data and would rather not defer that cleanup + HD%InitInp%InvalidWithSSExctn = SeaSt%InitOutData%InvalidWithSSExctn + + HD%InitInp%WaveField => SeaSt%InitOutData%WaveField ! can be set regardless of association(); if not associated, HD shouldn't work + + + !------------------------------------------------------------- ! Call the main subroutine HydroDyn_Init - ! TimeInterval and InitInp are passed into HD_Init, all the rest are set by HD_Init + ! TimeInterval and HD%InitInp are passed into HD%Init, all the rest are set by HD%Init ! ! NOTE: Pass u(1) only (this is empty and will be set inside Init). We will copy ! this to u(2) and u(3) afterwards - call HydroDyn_Init( InitInp, u(1), p, x(STATE_CURR), xd(STATE_CURR), z(STATE_CURR), OtherStates(STATE_CURR), y, m, TimeInterval, InitOutData, ErrStat2, ErrMsg2 ) + call HydroDyn_Init( HD%InitInp, HD%u(1), HD%p, HD%x(STATE_CURR), HD%xd(STATE_CURR), HD%z(STATE_CURR), HD%OtherStates(STATE_CURR), HD%y, HD%m, TimeInterval, HD%InitOutData, ErrStat2, ErrMsg2 ) if (Failed()) return + HD%Initialized = .true. !------------------------------------------------------------- ! Sanity checks - !------------------------------------------------------------- call CheckDepth(ErrStat2,ErrMsg2); if (Failed()) return call CheckNodes(ErrStat2,ErrMsg2); if (Failed()) return - !------------------------------------------------------------- - ! Set the interface meshes for motion inputs and loads output - !------------------------------------------------------------- - call SetMotionLoadsInterfaceMeshes(ErrStat2,ErrMsg2); if (Failed()) return - - !------------------------------------------------------------- ! Setup other prior timesteps ! We fill InputTimes with negative times, but the Input values are identical for each of those times; this allows @@ -357,7 +438,7 @@ SUBROUTINE HydroDyn_C_Init( OutRootName_C, InputFileString_C, InputFileStringLen ! order = SIZE(Input) !------------------------------------------------------------- do i=2,InterpOrder+1 - call HydroDyn_CopyInput (u(1), u(i), MESH_NEWCOPY, Errstat2, ErrMsg2) + call HydroDyn_CopyInput (HD%u(1), HD%u(i), MESH_NEWCOPY, Errstat2, ErrMsg2) if (Failed()) return enddo do i = 1, InterpOrder + 1 @@ -368,40 +449,46 @@ SUBROUTINE HydroDyn_C_Init( OutRootName_C, InputFileString_C, InputFileStringLen !------------------------------------------------------------- ! Initial setup of other pieces of x,xd,z,OtherStates - !------------------------------------------------------------- - CALL HydroDyn_CopyContState ( x( STATE_CURR), x( STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return - CALL HydroDyn_CopyDiscState ( xd( STATE_CURR), xd( STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return - CALL HydroDyn_CopyConstrState( z( STATE_CURR), z( STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return - CALL HydroDyn_CopyOtherState ( OtherStates(STATE_CURR), OtherStates(STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return + CALL HydroDyn_CopyContState ( HD%x( STATE_CURR), HD%x( STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return + CALL HydroDyn_CopyDiscState ( HD%xd( STATE_CURR), HD%xd( STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return + CALL HydroDyn_CopyConstrState( HD%z( STATE_CURR), HD%z( STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return + CALL HydroDyn_CopyOtherState ( HD%OtherStates(STATE_CURR), HD%OtherStates(STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return !------------------------------------------------------------- ! Setup the previous timestep copies of states - !------------------------------------------------------------- - CALL HydroDyn_CopyContState ( x( STATE_CURR), x( STATE_LAST), MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return - CALL HydroDyn_CopyDiscState ( xd( STATE_CURR), xd( STATE_LAST), MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return - CALL HydroDyn_CopyConstrState( z( STATE_CURR), z( STATE_LAST), MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return - CALL HydroDyn_CopyOtherState ( OtherStates(STATE_CURR), OtherStates(STATE_LAST), MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return + CALL HydroDyn_CopyContState ( HD%x( STATE_CURR), HD%x( STATE_LAST), MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return + CALL HydroDyn_CopyDiscState ( HD%xd( STATE_CURR), HD%xd( STATE_LAST), MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return + CALL HydroDyn_CopyConstrState( HD%z( STATE_CURR), HD%z( STATE_LAST), MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return + CALL HydroDyn_CopyOtherState ( HD%OtherStates(STATE_CURR), HD%OtherStates(STATE_LAST), MESH_NEWCOPY, Errstat2, ErrMsg2); if (Failed()) return -!TODO -! Is there any other InitOutData should be returned -! Any additional warnings or error handling necessary - !------------------------------------------------- - ! Set output channel information for driver code - !------------------------------------------------- + !-------------------------------------------------------------------------------------------------------------------------------- + ! Set the interface meshes and outputs + !-------------------------------------------------------------------------------------------------------------------------------- + call SetMotionLoadsInterfaceMeshes(ErrStat2,ErrMsg2); if (Failed()) return + + !------------------------------------------------------------- + ! Set output channel information for driver code ! Number of channels - NumChannels_C = size(InitOutData%WriteOutputHdr) + NumChannels_C = size(SeaSt%InitOutData%WriteOutputHdr) + size(HD%InitOutData%WriteOutputHdr) ! transfer the output channel names and units to c_char arrays for returning ! Upgrade idea: use C_NULL_CHAR as delimiters. Requires rework of Python ! side of code. k=1 - do i=1,NumChannels_C + do i=1,size(SeaSt%InitOutData%WriteOutputHdr) do j=1,ChanLen ! max length of channel name. Same for units - OutputChannelNames_C(k)=InitOutData%WriteOutputHdr(i)(j:j) - OutputChannelUnits_C(k)=InitOutData%WriteOutputUnt(i)(j:j) + OutputChannelNames_C(k)=SeaSt%InitOutData%WriteOutputHdr(i)(j:j) + OutputChannelUnits_C(k)=SeaSt%InitOutData%WriteOutputUnt(i)(j:j) + k=k+1 + enddo + enddo + do i=1,size(HD%InitOutData%WriteOutputHdr) + do j=1,ChanLen ! max length of channel name. Same for units + OutputChannelNames_C(k)=HD%InitOutData%WriteOutputHdr(i)(j:j) + OutputChannelUnits_C(k)=HD%InitOutData%WriteOutputUnt(i)(j:j) k=k+1 enddo enddo @@ -460,7 +547,7 @@ subroutine SetMotionLoadsInterfaceMeshes(ErrStat3,ErrMsg3) ! initial position and orientation of node InitPos = tmpNodePos(1:3,iNode) theta = real(tmpNodePos(4:6,iNode),DbKi) ! convert ReKi to DbKi to avoid roundoff - CALL SmllRotTrans( 'InputRotation', theta(1), theta(2), theta(3), Orient, 'Orient', ErrStat, ErrMsg ) + Orient = EulerConstructZYX(theta) call MeshPositionNode( HD_MotionMesh , & iNode , & InitPos , & ! position @@ -526,24 +613,24 @@ subroutine SetMotionLoadsInterfaceMeshes(ErrStat3,ErrMsg3) !------------------------------------------------------------- ! Set the mapping meshes ! PRP - principle reference point - call MeshMapCreate( HD_MotionMesh, u(1)%PRPMesh, Map_Motion_2_HD_PRP_P, ErrStat3, ErrMsg3 ) + call MeshMapCreate( HD_MotionMesh, HD%u(1)%PRPMesh, Map_Motion_2_HD_PRP_P, ErrStat3, ErrMsg3 ) if (ErrStat3 >= AbortErrLev) return ! WAMIT - floating bodies using potential flow - if ( u(1)%WAMITMesh%Committed ) then ! input motions - call MeshMapCreate( HD_MotionMesh, u(1)%WAMITMesh, Map_Motion_2_HD_WB_P, ErrStat3, ErrMsg3 ) + if ( HD%u(1)%WAMITMesh%Committed ) then ! input motions + call MeshMapCreate( HD_MotionMesh, HD%u(1)%WAMITMesh, Map_Motion_2_HD_WB_P, ErrStat3, ErrMsg3 ) if (ErrStat3 >= AbortErrLev) return endif - if ( y%WAMITMesh%Committed ) then ! output loads - call MeshMapCreate( y%WAMITMesh, HD_LoadMesh, Map_HD_WB_P_2_Load, ErrStat3, ErrMsg3 ) + if ( HD%y%WAMITMesh%Committed ) then ! output loads + call MeshMapCreate( HD%y%WAMITMesh, HD_LoadMesh, Map_HD_WB_P_2_Load, ErrStat3, ErrMsg3 ) if (ErrStat3 >= AbortErrLev) return endif ! Morison - nodes for strip theory - if ( u(1)%Morison%Mesh%Committed ) then ! input motions - call MeshMapCreate( HD_MotionMesh, u(1)%Morison%Mesh, Map_Motion_2_HD_Mo_P, ErrStat3, ErrMsg3 ) + if ( HD%u(1)%Morison%Mesh%Committed ) then ! input motions + call MeshMapCreate( HD_MotionMesh, HD%u(1)%Morison%Mesh, Map_Motion_2_HD_Mo_P, ErrStat3, ErrMsg3 ) if (ErrStat3 >= AbortErrLev) return endif - if ( y%Morison%Mesh%Committed ) then ! output loads - call MeshMapCreate( y%Morison%Mesh, HD_LoadMesh, Map_HD_Mo_P_2_Load, ErrStat3, ErrMsg3 ) + if ( HD%y%Morison%Mesh%Committed ) then ! output loads + call MeshMapCreate( HD%y%Morison%Mesh, HD_LoadMesh, Map_HD_Mo_P_2_Load, ErrStat3, ErrMsg3 ) if (ErrStat3 >= AbortErrLev) return endif @@ -560,18 +647,18 @@ subroutine CheckNodes(ErrStat3,ErrMsg3) ErrStat3 = ErrID_None ErrMsg3 = "" if ( NumNodePts > 1 ) then - if ( u(1)%Morison%Mesh%Committed .and. u(1)%WAMITMesh%Committed ) then - if ( (u(1)%Morison%Mesh%Nnodes + u(1)%WAMITMesh%Nnodes) < NumNodePts ) then + if ( HD%u(1)%Morison%Mesh%Committed .and. HD%u(1)%WAMITMesh%Committed ) then + if ( (HD%u(1)%Morison%Mesh%Nnodes + HD%u(1)%WAMITMesh%Nnodes) < NumNodePts ) then ErrStat3 = ErrID_Fatal ErrMsg3 = "More nodes passed into library than exist in HydroDyn model" endif - elseif ( u(1)%Morison%Mesh%Committed ) then ! No WAMIT - if ( u(1)%Morison%Mesh%Nnodes < NumNodePts ) then + elseif ( HD%u(1)%Morison%Mesh%Committed ) then ! No WAMIT + if ( HD%u(1)%Morison%Mesh%Nnodes < NumNodePts ) then ErrStat3 = ErrID_Fatal ErrMsg3 = "More nodes passed into library than exist in HydroDyn model Morison mesh" endif - elseif ( u(1)%WAMITMesh%Committed ) then ! No Morison - if ( u(1)%WAMITMesh%Nnodes < NumNodePts ) then + elseif ( HD%u(1)%WAMITMesh%Committed ) then ! No Morison + if ( HD%u(1)%WAMITMesh%Nnodes < NumNodePts ) then ErrStat3 = ErrID_Fatal ErrMsg3 = "More nodes passed into library than exist in HydroDyn model WAMIT mesh" endif @@ -591,15 +678,15 @@ subroutine CheckDepth(ErrStat3,ErrMsg3) real(ReKi) :: tmpZpos !< temporary z-position ErrStat3 = ErrID_None ErrMsg3 = "" - tmpZpos=-0.001_ReKi*abs(p%WtrDpth) ! Initial comparison value close to surface - if ( NumNodePts == 1 .and. u(1)%Morison%Mesh%Committed ) then - do i=1,u(1)%Morison%Mesh%Nnodes + tmpZpos=-0.001_ReKi*abs(HD%p%WaveField%EffWtrDpth) ! Initial comparison value close to surface + if ( NumNodePts == 1 .and. HD%u(1)%Morison%Mesh%Committed ) then + do i=1,HD%u(1)%Morison%Mesh%Nnodes ! Find lowest Morison node - if (u(1)%Morison%Mesh%Position(3,i) < tmpZpos) then - tmpZpos = u(1)%Morison%Mesh%Position(3,i) + if (HD%u(1)%Morison%Mesh%Position(3,i) < tmpZpos) then + tmpZpos = HD%u(1)%Morison%Mesh%Position(3,i) endif enddo - if (tmpZpos < -abs(p%WtrDpth)*0.9_ReKi) then ! within 10% of the seafloor + if (tmpZpos < -abs(HD%p%WaveField%EffWtrDpth)*0.9_ReKi) then ! within 10% of the seafloor ErrStat3 = ErrID_Severe ErrMsg3 = "Inconsistent model"//NewLine//" -- Single library input node for simulating rigid floating structure."// & NewLine//" -- Lowest Morison node is is in lowest 10% of water depth indicating fixed bottom structure from HydroDyn."// & @@ -628,13 +715,13 @@ SUBROUTINE HydroDyn_C_CalcOutput(Time_C, NumNodePts_C, NodePos_C, NodeVel_C, Nod real(c_float), intent(in ) :: NodeVel_C( 6*NumNodePts_C ) !< A 6xNumNodePts_C array [Vx,Vy,Vz,RVx,RVy,RVz] -- velocities (global) real(c_float), intent(in ) :: NodeAcc_C( 6*NumNodePts_C ) !< A 6xNumNodePts_C array [Ax,Ay,Az,RAx,RAy,RAz] -- accelerations (global) real(c_float), intent( out) :: NodeFrc_C( 6*NumNodePts_C ) !< A 6xNumNodePts_C array [Fx,Fy,Fz,Mx,My,Mz] -- forces and moments (global) - real(c_float), intent( out) :: OutputChannelValues_C(p%NumOuts) + real(c_float), intent( out) :: OutputChannelValues_C(SeaSt%p%NumOuts+HD%p%NumOuts) integer(c_int), intent( out) :: ErrStat_C character(kind=c_char), intent( out) :: ErrMsg_C(ErrMsgLen_C) ! Local variables real(DbKi) :: Time - integer(IntKi) :: iNode + integer(IntKi) :: iNode,i,k integer(IntKi) :: ErrStat !< aggregated error status character(ErrMsgLen) :: ErrMsg !< aggregated error message integer(IntKi) :: ErrStat2 !< temporary error status from a call @@ -662,19 +749,18 @@ SUBROUTINE HydroDyn_C_CalcOutput(Time_C, NumNodePts_C, NodePos_C, NodeVel_C, Nod ! Transfer motions to input meshes - call Set_MotionMesh( ErrStat2, ErrMsg2 ) ! update motion mesh with input motion arrays - if (Failed()) return - call HD_SetInputMotion( u(1), ErrStat2, ErrMsg2 ) ! transfer input motion mesh to u(1) meshes + call Set_MotionMesh() ! update motion mesh with input motion arrays + call HD_SetInputMotion( HD%u(1), ErrStat2, ErrMsg2 ) ! transfer input motion mesh to u(1) meshes if (Failed()) return ! Call the main subroutine HydroDyn_CalcOutput to get the resulting forces and moments at time T - CALL HydroDyn_CalcOutput( Time, u(1), p, x(STATE_CURR), xd(STATE_CURR), z(STATE_CURR), OtherStates(STATE_CURR), y, m, ErrStat2, ErrMsg2 ) + CALL HydroDyn_CalcOutput( Time, HD%u(1), HD%p, HD%x(STATE_CURR), HD%xd(STATE_CURR), HD%z(STATE_CURR), HD%OtherStates(STATE_CURR), HD%y, HD%m, ErrStat2, ErrMsg2 ) if (Failed()) return ! Transfer resulting load meshes to intermediate mesh - call HD_TransferLoads( u(1), y, ErrStat2, ErrMsg2 ) + call HD_TransferLoads( HD%u(1), HD%y, ErrStat2, ErrMsg2 ) if (Failed()) return @@ -683,8 +769,20 @@ SUBROUTINE HydroDyn_C_CalcOutput(Time_C, NumNodePts_C, NodePos_C, NodeVel_C, Nod ! Reshape for return NodeFrc_C(1:6*NumNodePts) = reshape( real(tmpNodeFrc(1:6,1:NumNodePts), c_float), (/6*NumNodePts/) ) + + ! call SeaState to get outputs of WaveElev, etc + call SeaSt_CalcOutput( Time, SeaSt%u, SeaSt%p, SeaSt%x, SeaSt%xd, SeaSt%z, SeaSt%OtherStates, SeaSt%y, SeaSt%m, ErrStat2, ErrMsg2 ) + ! Get the output channel info out of y - OutputChannelValues_C = REAL(y%WriteOutput, C_FLOAT) + k=1 + do i=1,size(SeaSt%y%WriteOutput) + OutputChannelValues_C(k) = REAL(SeaSt%y%WriteOutput(i), C_FLOAT) + k=k+1 + enddo + do i=1,size(HD%y%WriteOutput) + OutputChannelValues_C(k) = REAL(HD%y%WriteOutput(i), C_FLOAT) + k=k+1 + enddo ! Set error status call SetErr(ErrStat,ErrMsg,ErrStat_C,ErrMsg_C) @@ -746,7 +844,7 @@ SUBROUTINE HydroDyn_C_UpdateStates( Time_C, TimeNext_C, NumNodePts_C, NodePos_C, !------------------------------------------------------- ! Check the time for current timestep and next timestep !------------------------------------------------------- - ! These inputs are used in the time stepping algorithm within HD_UpdateStates + ! These inputs are used in the time stepping algorithm within HD%UpdateStates ! For quadratic interpolation (InterpOrder==2), 3 timesteps are used. For ! linear (InterOrder==1), 2 timesteps (the HD code can handle either). ! u(1) inputs at t + dt ! Next timestep @@ -781,17 +879,17 @@ SUBROUTINE HydroDyn_C_UpdateStates( Time_C, TimeNext_C, NumNodePts_C, NodePos_C, ! Step back to previous state because we are doing a correction step ! -- repeating the T -> T+dt update with new inputs at T+dt ! -- the STATE_CURR contains states at T+dt from the previous call, so revert those - CALL HydroDyn_CopyContState (x( STATE_LAST), x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return - CALL HydroDyn_CopyDiscState (xd( STATE_LAST), xd( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return - CALL HydroDyn_CopyConstrState (z( STATE_LAST), z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return - CALL HydroDyn_CopyOtherState (OtherStates(STATE_LAST), OtherStates(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return + CALL HydroDyn_CopyContState (HD%x( STATE_LAST), HD%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return + CALL HydroDyn_CopyDiscState (HD%xd( STATE_LAST), HD%xd( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return + CALL HydroDyn_CopyConstrState (HD%z( STATE_LAST), HD%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return + CALL HydroDyn_CopyOtherState (HD%OtherStates(STATE_LAST), HD%OtherStates(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return else ! Cycle inputs back one timestep since we are moving forward in time. if (InterpOrder>1) then ! quadratic, so keep the old time - call HydroDyn_CopyInput( u(INPUT_CURR), u(INPUT_LAST), MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return + call HydroDyn_CopyInput( HD%u(INPUT_CURR), HD%u(INPUT_LAST), MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return endif ! Move inputs from previous t+dt (now t) to t - call HydroDyn_CopyInput( u(INPUT_PRED), u(INPUT_CURR), MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return + call HydroDyn_CopyInput( HD%u(INPUT_PRED), HD%u(INPUT_CURR), MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return endif !------------------------------------------------------- @@ -803,23 +901,22 @@ SUBROUTINE HydroDyn_C_UpdateStates( Time_C, TimeNext_C, NumNodePts_C, NodePos_C, tmpNodeAcc(1:6,1:NumNodePts) = reshape( real(NodeAcc_C(1:6*NumNodePts),ReKi), (/6,NumNodePts/) ) ! Transfer motions to input meshes - call Set_MotionMesh( ErrStat2, ErrMsg2 ) ! update motion mesh with input motion arrays - if (Failed()) return - call HD_SetInputMotion( u(INPUT_PRED), ErrStat2, ErrMsg2 ) ! transfer input motion mesh to u(1) meshes + call Set_MotionMesh() ! update motion mesh with input motion arrays + call HD_SetInputMotion( HD%u(INPUT_PRED), ErrStat2, ErrMsg2 ) ! transfer input motion mesh to u(1) meshes if (Failed()) return ! Set copy the current state over to the predicted state for sending to UpdateStates ! -- The STATE_PREDicted will get updated in the call. ! -- The UpdateStates routine expects this to contain states at T at the start of the call (history not passed in) - CALL HydroDyn_CopyContState (x( STATE_CURR), x( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return - CALL HydroDyn_CopyDiscState (xd( STATE_CURR), xd( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return - CALL HydroDyn_CopyConstrState (z( STATE_CURR), z( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return - CALL HydroDyn_CopyOtherState (OtherStates(STATE_CURR), OtherStates(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return + CALL HydroDyn_CopyContState (HD%x( STATE_CURR), HD%x( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return + CALL HydroDyn_CopyDiscState (HD%xd( STATE_CURR), HD%xd( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return + CALL HydroDyn_CopyConstrState (HD%z( STATE_CURR), HD%z( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return + CALL HydroDyn_CopyOtherState (HD%OtherStates(STATE_CURR), HD%OtherStates(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return ! Call the main subroutine HydroDyn_UpdateStates to get the velocities - CALL HydroDyn_UpdateStates( InputTimes(INPUT_CURR), N_Global, u, InputTimes, p, x(STATE_PRED), xd(STATE_PRED), z(STATE_PRED), OtherStates(STATE_PRED), m, ErrStat2, ErrMsg2 ) + CALL HydroDyn_UpdateStates( InputTimes(INPUT_CURR), N_Global, HD%u, InputTimes, HD%p, HD%x(STATE_PRED), HD%xd(STATE_PRED), HD%z(STATE_PRED), HD%OtherStates(STATE_PRED), HD%m, ErrStat2, ErrMsg2 ) if (Failed()) return @@ -829,16 +926,16 @@ SUBROUTINE HydroDyn_C_UpdateStates( Time_C, TimeNext_C, NumNodePts_C, NodePos_C, ! move current state at T to previous state at T-dt ! -- STATE_LAST now contains info at time T ! -- this allows repeating the T --> T+dt update - CALL HydroDyn_CopyContState (x( STATE_CURR), x( STATE_LAST), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return - CALL HydroDyn_CopyDiscState (xd( STATE_CURR), xd( STATE_LAST), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return - CALL HydroDyn_CopyConstrState (z( STATE_CURR), z( STATE_LAST), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return - CALL HydroDyn_CopyOtherState (OtherStates(STATE_CURR), OtherStates(STATE_LAST), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return + CALL HydroDyn_CopyContState (HD%x( STATE_CURR), HD%x( STATE_LAST), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return + CALL HydroDyn_CopyDiscState (HD%xd( STATE_CURR), HD%xd( STATE_LAST), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return + CALL HydroDyn_CopyConstrState (HD%z( STATE_CURR), HD%z( STATE_LAST), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return + CALL HydroDyn_CopyOtherState (HD%OtherStates(STATE_CURR), HD%OtherStates(STATE_LAST), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return ! Update the predicted state as the new current state ! -- we have now advanced from T to T+dt. This allows calling with CalcOuput to get the outputs at T+dt - CALL HydroDyn_CopyContState (x( STATE_PRED), x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return - CALL HydroDyn_CopyDiscState (xd( STATE_PRED), xd( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return - CALL HydroDyn_CopyConstrState (z( STATE_PRED), z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return - CALL HydroDyn_CopyOtherState (OtherStates(STATE_PRED), OtherStates(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return + CALL HydroDyn_CopyContState (HD%x( STATE_PRED), HD%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return + CALL HydroDyn_CopyDiscState (HD%xd( STATE_PRED), HD%xd( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return + CALL HydroDyn_CopyConstrState (HD%z( STATE_PRED), HD%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return + CALL HydroDyn_CopyOtherState (HD%OtherStates(STATE_PRED), HD%OtherStates(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return @@ -887,10 +984,10 @@ SUBROUTINE HydroDyn_C_End(ErrStat_C,ErrMsg_C) BIND (C, NAME='HydroDyn_C_End') ! Call the main subroutine HydroDyn_End ! If u is not allocated, then we didn't get far at all in initialization, - ! or HD_C_End got called before Init. We don't want a segfault, so check + ! or HD%C_End got called before Init. We don't want a segfault, so check ! for allocation. - if (allocated(u)) then - call HydroDyn_End( u(1), p, x(STATE_CURR), xd(STATE_CURR), z(STATE_CURR), OtherStates(STATE_CURR), y, m, ErrStat2, ErrMsg2 ) + if (allocated(HD%u)) then + call HydroDyn_End( HD%u(1), HD%p, HD%x(STATE_CURR), HD%xd(STATE_CURR), HD%z(STATE_CURR), HD%OtherStates(STATE_CURR), HD%y, HD%m, ErrStat2, ErrMsg2 ) call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) endif @@ -898,27 +995,38 @@ SUBROUTINE HydroDyn_C_End(ErrStat_C,ErrMsg_C) BIND (C, NAME='HydroDyn_C_End') ! logic is required here (this isn't necessary in the fortran driver ! or in openfast, but may be when this code is called from C, Python, ! or some other code using the c-bindings. - if (allocated(u)) then - do i=2,size(u) - call HydroDyn_DestroyInput( u(i), ErrStat2, ErrMsg2 ) + if (allocated(HD%u)) then + do i=2,size(HD%u) + call HydroDyn_DestroyInput( HD%u(i), ErrStat2, ErrMsg2 ) call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) enddo - if (allocated(u)) deallocate(u) + if (allocated(HD%u)) deallocate(HD%u) endif ! Destroy any other copies of states (rerun on (STATE_CURR) is ok) - call HydroDyn_DestroyContState( x( STATE_LAST), ErrStat2, ErrMsg2 ); call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - call HydroDyn_DestroyDiscState( xd( STATE_LAST), ErrStat2, ErrMsg2 ); call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - call HydroDyn_DestroyConstrState( z( STATE_LAST), ErrStat2, ErrMsg2 ); call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - call HydroDyn_DestroyOtherState( OtherStates(STATE_LAST), ErrStat2, ErrMsg2 ); call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - call HydroDyn_DestroyContState( x( STATE_CURR), ErrStat2, ErrMsg2 ); call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - call HydroDyn_DestroyDiscState( xd( STATE_CURR), ErrStat2, ErrMsg2 ); call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - call HydroDyn_DestroyConstrState( z( STATE_CURR), ErrStat2, ErrMsg2 ); call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - call HydroDyn_DestroyOtherState( OtherStates(STATE_CURR), ErrStat2, ErrMsg2 ); call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - call HydroDyn_DestroyContState( x( STATE_PRED), ErrStat2, ErrMsg2 ); call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - call HydroDyn_DestroyDiscState( xd( STATE_PRED), ErrStat2, ErrMsg2 ); call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - call HydroDyn_DestroyConstrState( z( STATE_PRED), ErrStat2, ErrMsg2 ); call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - call HydroDyn_DestroyOtherState( OtherStates(STATE_PRED), ErrStat2, ErrMsg2 ); call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + call HydroDyn_DestroyContState( HD%x( STATE_LAST), ErrStat2, ErrMsg2 ); call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + call HydroDyn_DestroyDiscState( HD%xd( STATE_LAST), ErrStat2, ErrMsg2 ); call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + call HydroDyn_DestroyConstrState( HD%z( STATE_LAST), ErrStat2, ErrMsg2 ); call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + call HydroDyn_DestroyOtherState( HD%OtherStates(STATE_LAST), ErrStat2, ErrMsg2 ); call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + call HydroDyn_DestroyContState( HD%x( STATE_CURR), ErrStat2, ErrMsg2 ); call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + call HydroDyn_DestroyDiscState( HD%xd( STATE_CURR), ErrStat2, ErrMsg2 ); call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + call HydroDyn_DestroyConstrState( HD%z( STATE_CURR), ErrStat2, ErrMsg2 ); call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + call HydroDyn_DestroyOtherState( HD%OtherStates(STATE_CURR), ErrStat2, ErrMsg2 ); call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + call HydroDyn_DestroyContState( HD%x( STATE_PRED), ErrStat2, ErrMsg2 ); call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + call HydroDyn_DestroyDiscState( HD%xd( STATE_PRED), ErrStat2, ErrMsg2 ); call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + call HydroDyn_DestroyConstrState( HD%z( STATE_PRED), ErrStat2, ErrMsg2 ); call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + call HydroDyn_DestroyOtherState( HD%OtherStates(STATE_PRED), ErrStat2, ErrMsg2 ); call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + + ! Call the main subroutine SeaSt_End + call SeaSt_End( SeaSt%u, SeaSt%p, SeaSt%x, SeaSt%xd, SeaSt%z, SeaSt%OtherStates, SeaSt%y, SeaSt%m, ErrStat2, ErrMsg2 ) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ! Destroy any other copies of states (rerun on (STATE_CURR) is ok) + call SeaSt_DestroyContState( SeaSt%x , ErrStat2, ErrMsg2 ); call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + call SeaSt_DestroyDiscState( SeaSt%xd , ErrStat2, ErrMsg2 ); call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + call SeaSt_DestroyConstrState( SeaSt%z , ErrStat2, ErrMsg2 ); call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + call SeaSt_DestroyOtherState( SeaSt%OtherStates, ErrStat2, ErrMsg2 ); call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ! if deallocate other items now @@ -952,16 +1060,14 @@ END SUBROUTINE HydroDyn_C_End !> This routine is operating on module level data, hence few inputs -subroutine Set_MotionMesh(ErrStat3, ErrMsg3) - integer(IntKi), intent( out) :: ErrStat3 - character(ErrMsgLen), intent( out) :: ErrMsg3 +subroutine Set_MotionMesh() integer(IntKi) :: iNode real(R8Ki) :: theta(3) real(R8Ki) :: Orient(3,3) ! Set mesh corresponding to input motions do iNode=1,NumNodePts theta = real(tmpNodePos(4:6,iNode),DbKi) ! convert ReKi to DbKi to avoid roundoff - CALL SmllRotTrans( 'InputRotation', theta(1), theta(2), theta(3), Orient, 'Orient', ErrStat3, ErrMsg3 ) + Orient = EulerConstructZYX(theta) HD_MotionMesh%TranslationDisp(1:3,iNode) = tmpNodePos(1:3,iNode) - HD_MotionMesh%Position(1:3,iNode) ! relative displacement only HD_MotionMesh%Orientation(1:3,1:3,iNode) = Orient HD_MotionMesh%TranslationVel( 1:3,iNode) = tmpNodeVel(1:3,iNode) @@ -973,21 +1079,21 @@ end subroutine Set_MotionMesh !> Map the motion of the intermediate input mesh over to the input meshes !! This routine is operating on module level data, hence few inputs -subroutine HD_SetInputMotion( u_local, ErrStat3, ErrMsg3 ) - type(HydroDyn_InputType), intent(inout) :: u_local ! Only one input (probably at T) +subroutine HD_SetInputMotion( HD_u_local, ErrStat3, ErrMsg3 ) + type(HydroDyn_InputType), intent(inout) :: HD_u_local ! Only one input (probably at T) integer(IntKi), intent( out) :: ErrStat3 character(ErrMsgLen), intent( out) :: ErrMsg3 ! Principle reference point - CALL Transfer_Point_to_Point( HD_MotionMesh, u_local%PRPMesh, Map_Motion_2_HD_PRP_P, ErrStat3, ErrMsg3 ) + CALL Transfer_Point_to_Point( HD_MotionMesh, HD_u_local%PRPMesh, Map_Motion_2_HD_PRP_P, ErrStat3, ErrMsg3 ) if (ErrStat3 >= AbortErrLev) return ! WAMIT mesh - if ( u_local%WAMITMesh%Committed ) then - call Transfer_Point_to_Point( HD_MotionMesh, u_local%WAMITMesh, Map_Motion_2_HD_WB_P, ErrStat3, ErrMsg3 ) + if ( HD_u_local%WAMITMesh%Committed ) then + call Transfer_Point_to_Point( HD_MotionMesh, HD_u_local%WAMITMesh, Map_Motion_2_HD_WB_P, ErrStat3, ErrMsg3 ) if (ErrStat3 >= AbortErrLev) return endif ! Morison mesh - if ( u_local%Morison%Mesh%Committed ) then - call Transfer_Point_to_Point( HD_MotionMesh, u_local%Morison%Mesh, Map_Motion_2_HD_Mo_P, ErrStat3, ErrMsg3 ) + if ( HD_u_local%Morison%Mesh%Committed ) then + call Transfer_Point_to_Point( HD_MotionMesh, HD_u_local%Morison%Mesh, Map_Motion_2_HD_Mo_P, ErrStat3, ErrMsg3 ) if (ErrStat3 >= AbortErrLev) return endif end subroutine HD_SetInputMotion @@ -998,9 +1104,9 @@ end subroutine HD_SetInputMotion !! temporary mesh -- prevents accidental overwrite of WAMIT loads on HD_LoadMesh !! with the mapping of the Morison loads. !! This routine is operating on module level data, hence few inputs -subroutine HD_TransferLoads( u_local, y_local, ErrStat3, ErrMsg3 ) - type(HydroDyn_InputType), intent(in ) :: u_local ! Only one input (probably at T) - type(HydroDyn_OutputType), intent(in ) :: y_local ! Only one input (probably at T) +subroutine HD_TransferLoads( HD_u_local, HD_y_local, ErrStat3, ErrMsg3 ) + type(HydroDyn_InputType), intent(in ) :: HD_u_local ! Only one input (probably at T) + type(HydroDyn_OutputType), intent(in ) :: HD_y_local ! Only one input (probably at T) integer(IntKi), intent( out) :: ErrStat3 character(ErrMsgLen), intent( out) :: ErrMsg3 @@ -1008,19 +1114,19 @@ subroutine HD_TransferLoads( u_local, y_local, ErrStat3, ErrMsg3 ) HD_LoadMesh%Moment = 0.0_ReKi ! WAMIT mesh - if ( y_local%WAMITMesh%Committed ) then + if ( HD_y_local%WAMITMesh%Committed ) then HD_LoadMesh_tmp%Force = 0.0_ReKi HD_LoadMesh_tmp%Moment = 0.0_ReKi - call Transfer_Point_to_Point( y_local%WAMITMesh, HD_LoadMesh_tmp, Map_HD_WB_P_2_Load, ErrStat3, ErrMsg3, u_local%WAMITMesh, HD_MotionMesh ) + call Transfer_Point_to_Point( HD_y_local%WAMITMesh, HD_LoadMesh_tmp, Map_HD_WB_P_2_Load, ErrStat3, ErrMsg3, HD_u_local%WAMITMesh, HD_MotionMesh ) if (ErrStat3 >= AbortErrLev) return HD_LoadMesh%Force = HD_LoadMesh%Force + HD_LoadMesh_tmp%Force HD_LoadMesh%Moment = HD_LoadMesh%Moment + HD_LoadMesh_tmp%Moment endif ! Morison mesh - if ( y_local%Morison%Mesh%Committed ) then + if ( HD_y_local%Morison%Mesh%Committed ) then HD_LoadMesh_tmp%Force = 0.0_ReKi HD_LoadMesh_tmp%Moment = 0.0_ReKi - call Transfer_Point_to_Point( y_local%Morison%Mesh, HD_LoadMesh_tmp, Map_HD_Mo_P_2_Load, ErrStat3, ErrMsg3, u_local%Morison%Mesh, HD_MotionMesh ) + call Transfer_Point_to_Point( HD_y_local%Morison%Mesh, HD_LoadMesh_tmp, Map_HD_Mo_P_2_Load, ErrStat3, ErrMsg3, HD_u_local%Morison%Mesh, HD_MotionMesh ) if (ErrStat3 >= AbortErrLev) return HD_LoadMesh%Force = HD_LoadMesh%Force + HD_LoadMesh_tmp%Force HD_LoadMesh%Moment = HD_LoadMesh%Moment + HD_LoadMesh_tmp%Moment diff --git a/modules/hydrodyn/src/HydroDyn_DriverCode.f90 b/modules/hydrodyn/src/HydroDyn_DriverCode.f90 index 926e58e35e..4c2ccf61bb 100644 --- a/modules/hydrodyn/src/HydroDyn_DriverCode.f90 +++ b/modules/hydrodyn/src/HydroDyn_DriverCode.f90 @@ -22,120 +22,79 @@ PROGRAM HydroDynDriver - USE NWTC_Library - USE HydroDyn - USE HydroDyn_Types - USE HydroDyn_Output - USE ModMesh_Types - USE VersionInfo + USE HydroDynDriverSubs IMPLICIT NONE - - TYPE HD_Drvr_InitInput - LOGICAL :: Echo - REAL(ReKi) :: Gravity - REAL(ReKi) :: WtrDens - REAL(ReKi) :: WtrDpth - REAL(ReKi) :: MSL2SWL - CHARACTER(1024) :: HDInputFile - CHARACTER(1024) :: OutRootName - LOGICAL :: Linearize - INTEGER :: NSteps - REAL(DbKi) :: TimeInterval - INTEGER :: PRPInputsMod - CHARACTER(1024) :: PRPInputsFile - REAL(ReKi) :: uPRPInSteady(6) - REAL(ReKi) :: uDotPRPInSteady(6) - REAL(ReKi) :: uDotDotPRPInSteady(6) - LOGICAL :: WaveElevSeriesFlag !< Should we put together a wave elevation series and save it to file? - REAL(ReKi) :: WaveElevdX !< Spacing in the X direction for wave elevation series (m) - REAL(ReKi) :: WaveElevdY !< Spacing in the Y direction for the wave elevation series (m) - INTEGER(IntKi) :: WaveElevNX !< Number of points in the X direction for the wave elevation series (-) - INTEGER(IntKi) :: WaveElevNY !< Number of points in the X direction for the wave elevation series (-) - END TYPE HD_Drvr_InitInput - -! ----------------------------------------------------------------------------------- -! NOTE: this module and the ModMesh.f90 modules must use the Fortran compiler flag: -! /fpp because of they both have preprocessor statements -! ----------------------------------------------------------------------------------- - - INTEGER(IntKi), PARAMETER :: NumInp = 1 ! Number of inputs sent to HydroDyn_UpdateStates + INTEGER(IntKi), PARAMETER :: NumInp = 1 ! Number of inputs sent to HydroDyn_UpdateStates ! Program variables - REAL(DbKi) :: Time ! Variable for storing time, in seconds + REAL(DbKi) :: Time ! Variable for storing time, in seconds - REAL(DbKi) :: InputTime(NumInp) ! Variable for storing time associated with inputs, in seconds - REAL(DbKi) :: Interval ! HD module requested time interval - INTEGER(B1Ki), ALLOCATABLE :: SaveAry(:) ! Array to store packed data structure + REAL(DbKi) :: InputTime(NumInp) ! Variable for storing time associated with inputs, in seconds + REAL(DbKi) :: Interval ! HD module requested time interval - TYPE(HydroDyn_InitInputType) :: InitInData ! Input data for initialization - TYPE(HydroDyn_InitOutputType) :: InitOutData ! Output data from initialization + type(SeaSt_InitInputType) :: InitInData_SeaSt ! Input data for initialization + type(SeaSt_InitOutputType) :: InitOutData_SeaSt ! Output data from initialization - TYPE(HydroDyn_ContinuousStateType) :: x ! Continuous states - TYPE(HydroDyn_ContinuousStateType) :: x_new ! Continuous states at updated time - TYPE(HydroDyn_DiscreteStateType) :: xd ! Discrete states - TYPE(HydroDyn_DiscreteStateType) :: xd_new ! Discrete states at updated time - TYPE(HydroDyn_ConstraintStateType) :: z ! Constraint states - TYPE(HydroDyn_ConstraintStateType) :: z_residual ! Residual of the constraint state equations (Z) - TYPE(HydroDyn_OtherStateType) :: OtherState ! Other states - TYPE(HydroDyn_MiscVarType) :: m ! Misc/optimization variables + type(SeaSt_ContinuousStateType) :: x_SeaSt ! Continuous states + type(SeaSt_DiscreteStateType) :: xd_SeaSt ! Discrete states + type(SeaSt_ConstraintStateType) :: z_SeaSt ! Constraint states + type(SeaSt_OtherStateType) :: OtherState_SeaSt ! Other states + type(SeaSt_MiscVarType) :: m_SeaSt ! Misc/optimization variables - TYPE(HydroDyn_ParameterType) :: p ! Parameters - !TYPE(HydroDyn_InputType) :: u ! System inputs [OLD STYLE] - TYPE(HydroDyn_InputType) :: u(NumInp) ! System inputs - TYPE(HydroDyn_OutputType) :: y ! System outputs + type(SeaSt_ParameterType) :: p_SeaSt ! Parameters + type(SeaSt_InputType) :: u_SeaSt(NumInp) ! System inputs + type(SeaSt_OutputType) :: y_SeaSt ! System outputs - TYPE(HydroDyn_ContinuousStateType) :: dxdt ! First time derivatives of the continuous states - - INTEGER(IntKi) :: UnPRPInp ! PRP Inputs file identifier - INTEGER(IntKi) :: UnMorisonInp ! Morison Inputs file identifier - INTEGER(IntKi) :: UnHD_Out ! Output file identifier - REAL(ReKi), ALLOCATABLE :: PRPin(:,:) ! Variable for storing time, forces, and body velocities, in m/s or rad/s for PRP - REAL(ReKi), ALLOCATABLE :: Morisonin(:,:) ! Variable for storing time, forces, and body velocities, in m/s or rad/s for Morison elements - - INTEGER(IntKi) :: NBody ! Number of WAMIT bodies to work with if prescribing kinematics on each body (PRPInputsMod<0) - INTEGER(IntKi) :: I ! Generic loop counter - INTEGER(IntKi) :: J ! Generic loop counter + TYPE(HydroDyn_InitInputType) :: InitInData_HD ! Input data for initialization + TYPE(HydroDyn_InitOutputType) :: InitOutData_HD ! Output data from initialization + + TYPE(HydroDyn_ContinuousStateType) :: x ! Continuous states + TYPE(HydroDyn_ContinuousStateType) :: x_new ! Continuous states at updated time + TYPE(HydroDyn_DiscreteStateType) :: xd ! Discrete states + TYPE(HydroDyn_DiscreteStateType) :: xd_new ! Discrete states at updated time + TYPE(HydroDyn_ConstraintStateType) :: z ! Constraint states + TYPE(HydroDyn_OtherStateType) :: OtherState ! Other states + TYPE(HydroDyn_MiscVarType) :: m ! Misc/optimization variables + + TYPE(HydroDyn_ParameterType) :: p ! Parameters + TYPE(HydroDyn_InputType) :: u(NumInp) ! System inputs + TYPE(HydroDyn_OutputType) :: y ! System outputs + INTEGER(IntKi) :: n ! Loop counter (for time step) - INTEGER(IntKi) :: ErrStat,ErrStat2 ! Status of error message - CHARACTER(1024) :: ErrMsg,ErrMsg2 ! Error message if ErrStat /= ErrID_None - REAL(ReKi) :: dcm (3,3) ! The resulting transformation matrix from X to x, (-). + INTEGER(IntKi) :: ErrStat ! Status of error message + CHARACTER(ErrMsgLen) :: ErrMsg ! Error message if ErrStat /= ErrID_None + REAL(R8Ki) :: dcm (3,3) ! The resulting transformation matrix from X to x, (-). 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(HD_Drvr_InitInput) :: drvrInitInp ! Initialization data for the driver program + TYPE(HD_Drvr_Data) :: drvrData ! Data for the driver program (from an input file) + TYPE(HD_Drvr_MappingData) :: mappingData ! data for mesh mappings in the driver - integer :: StrtTime (8) ! Start time of simulation (including intialization) - integer :: SimStrtTime (8) ! Start time of simulation (after initialization) - real(ReKi) :: PrevClockTime ! Clock time at start of simulation in seconds - real(ReKi) :: UsrTime1 ! User CPU time for simulation initialization - real(ReKi) :: UsrTime2 ! User CPU time for simulation (without intialization) - real(DbKi) :: TiLstPrn ! The simulation time of the last print - real(DbKi) :: t_global ! Current simulation time (for global/FAST simulation) - real(DbKi) :: SttsTime ! Amount of time between screen status messages (sec) - integer :: n_SttsTime ! Number of time steps between screen status messages (-) + integer :: StrtTime (8) ! Start time of simulation (including intialization) + integer :: SimStrtTime (8) ! Start time of simulation (after initialization) + real(ReKi) :: PrevClockTime ! Clock time at start of simulation in seconds + real(ReKi) :: UsrTime1 ! User CPU time for simulation initialization + real(ReKi) :: UsrTime2 ! User CPU time for simulation (without intialization) + real(DbKi) :: TiLstPrn ! The simulation time of the last print + integer :: n_SttsTime ! Number of time steps between screen status messages (-) - type(MeshType) :: RefPtMesh ! 1-node Point mesh located at (0,0,0) in global system where all PRP-related driver inputs are set - type(MeshMapType) :: HD_Ref_2_WB_P ! Mesh mapping between Reference pt mesh and WAMIT body(ies) mesh - type(MeshMapType) :: HD_Ref_2_M_P ! Mesh mapping between Reference pt mesh and Morison mesh - real(R8Ki) :: theta(3) ! mesh creation helper data + integer :: i ! Loop counter + logical :: SeaState_Initialized, HydroDyn_Initialized ! For testing - LOGICAL :: DoTight = .FALSE. REAL(DbKi) :: maxAngle ! For debugging, see what the largest rotational angle input is for the simulation - CHARACTER(10) :: AngleMsg ! For debugging, a string version of the largest rotation input - INTEGER :: UnMeshDebug - CHARACTER(50) :: MeshDebugFile - - CHARACTER(20) :: FlagArg ! Flag argument from command line - CHARACTER(200) :: git_commit ! String containing the current git commit hash - TYPE(ProgDesc), PARAMETER :: version = ProgDesc( 'HydroDyn Driver', '', '' ) ! The version number of this program. + CHARACTER(20) :: FlagArg ! Flag argument from command line ! Variables Init - Time = -99999 + Time = -99999 ! initialize to negative number for error messages + ErrStat = ErrID_None + ErrMsg = "" + SeaState_Initialized = .false. + HydroDyn_Initialized = .false. !............................................................................................................................... ! Routines called in initialization @@ -164,1012 +123,333 @@ PROGRAM HydroDynDriver drvrFilename = '' CALL CheckArgs( drvrFilename, Flag=FlagArg ) IF ( LEN( TRIM(FlagArg) ) > 0 ) CALL NormStop() - - ! Display the copyright notice and compile info: - CALL DispCopyrightLicense( version%Name ) - CALL DispCompileRuntimeInfo( version%Name ) - ! Parse the driver input file and run the simulation based on that file - CALL ReadDriverInputFile( drvrFilename, drvrInitInp, ErrStat, ErrMsg ) - IF ( ErrStat /= 0 ) THEN - CALL WrScr( ErrMsg ) - STOP - END IF - InitInData%Gravity = drvrInitInp%Gravity - InitInData%defWtrDens = drvrInitInp%WtrDens - InitInData%defWtrDpth = drvrInitInp%WtrDpth - InitInData%defMSL2SWL = drvrInitInp%MSL2SWL - InitInData%UseInputFile = .TRUE. - InitInData%InputFile = drvrInitInp%HDInputFile - InitInData%OutRootName = drvrInitInp%OutRootName - InitInData%TMax = drvrInitInp%NSteps * drvrInitInp%TimeInterval - InitInData%Linearize = drvrInitInp%Linearize - + ! 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) - SttsTime = 1.0 ! seconds - - ! figure out how many time steps we should go before writing screen output: - n_SttsTime = MAX( 1, NINT( SttsTime / drvrInitInp%TimeInterval ) ) ! this may not be the final TimeInterval, though!!! GJH 8/14/14 - - !BJJ: added this for IceFloe/IceDyn - InitInData%hasIce = .FALSE. - -!------------------------------------------------------------------------------------- -! Begin Simulation Setup -!------------------------------------------------------------------------------------- - - IF ( drvrInitInp%PRPInputsMod == 2 ) THEN - - ! Open the PRP inputs data file - CALL GetNewUnit( UnPRPInp ) - CALL OpenFInpFile ( UnPRPInp, drvrInitInp%PRPInputsFile, ErrStat, ErrMsg ) - IF (ErrStat >=AbortErrLev) THEN - call WrScr( ErrMsg ) - STOP - ENDIF - - - ALLOCATE ( PRPin(drvrInitInp%NSteps, 19), STAT = ErrStat ) - IF ( ErrStat /= ErrID_None ) THEN - ErrMsg = ' Error allocating space for PRPin array.' - CALL WrScr( ErrMsg ) - CLOSE( UnPRPInp ) - STOP - END IF - - DO n = 1,drvrInitInp%NSteps - READ (UnPRPInp,*,IOSTAT=ErrStat) (PRPin (n,J), J=1,19) - - IF ( ErrStat /= 0 ) THEN - ErrMsg = ' Error reading the PRP input time-series file. ' - CALL WrScr( ErrMsg ) - STOP - END IF - END DO - - ! Close the inputs file - CLOSE ( UnPRPInp ) - END IF + ! Display the copyright notice and compile info: + CALL DispCopyrightLicense( version%Name ) + CALL DispCompileRuntimeInfo( version%Name ) - ! multi-body kinematics driver option (time, PRP DOFs 1-6, body1 DOFs 1-6, body2 DOFs 1-6...) - IF ( drvrInitInp%PRPInputsMod < 0 ) THEN - - NBODY = -drvrInitInp%PRPInputsMod - ! Open the WAMIT inputs data file - CALL GetNewUnit( UnPRPInp ) - CALL OpenFInpFile ( UnPRPInp, drvrInitInp%PRPInputsFile, ErrStat, ErrMsg ) - IF (ErrStat >=AbortErrLev) THEN - call WrScr( ErrMsg ) - STOP - ENDIF - - - ALLOCATE ( PRPin(drvrInitInp%NSteps, 7+6*NBODY), STAT = ErrStat ) - IF ( ErrStat /= ErrID_None ) THEN - ErrMsg = ' Error allocating space for PRPin array.' - CALL WrScr( ErrMsg ) - CLOSE( UnPRPInp ) - STOP - END IF - - PRINT *, 'NBody is '//trim(Num2LStr(NBody))//' and planning to read in '//trim(Num2LStr(7+6*NBODY))//' columns from the input file' + + ! Parse the driver input file and run the simulation based on that file + CALL ReadDriverInputFile( drvrFilename, drvrData, ErrStat, ErrMsg ) + CALL CheckError() - DO n = 1,drvrInitInp%NSteps - READ (UnPRPInp,*,IOSTAT=ErrStat) (PRPin (n,J), J=1,7+6*NBODY) - - IF ( ErrStat /= 0 ) THEN - ErrMsg = ' Error reading the WAMIT input time-series file (for multiple bodies). ' - CALL WrScr( ErrMsg ) - STOP - END IF - END DO + ! Read the PRPInputsFile: + CALL ReadPRPInputsFile( drvrData, ErrStat, ErrMsg ) + CALL CheckError() - ! Close the inputs file - CLOSE ( UnPRPInp ) - ELSE - NBody = 0 - END IF - - + drvrData%OutData%NumOuts = 0 + drvrData%OutData%n_Out = 0 + drvrData%TMax = (drvrData%NSteps-1) * drvrData%TimeInterval ! Starting time is always t = 0.0 - ! Setup the arrays for the wave elevation timeseries if requested by the driver input file - IF ( drvrInitInp%WaveElevSeriesFlag ) THEN - ALLOCATE ( InitInData%WaveElevXY(2,drvrInitInp%WaveElevNX*drvrInitInp%WaveElevNY), STAT=ErrStat ) - IF ( ErrStat >= ErrID_Fatal ) THEN - CALL HydroDyn_End( u(1), p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) - IF ( ErrStat /= ErrID_None ) THEN - CALL WrScr( ErrMsg ) - END IF - STOP - END IF + ! figure out how many time steps we should go before writing screen output (roughly once per second): + n_SttsTime = MAX( 1, NINT( 1.0_DbKi / drvrData%TimeInterval ) ) ! this may not be the final TimeInterval, though!!! GJH 8/14/14 - ! Set the values - n = 0 ! Dummy counter we are using to get the current point number - DO I = 0,drvrInitInp%WaveElevNX-1 - DO J = 0, drvrInitInp%WaveElevNY-1 - n = n+1 - ! X dimension - InitInData%WaveElevXY(1,n) = drvrInitInp%WaveElevDX*(I - 0.5*(drvrInitInp%WaveElevNX-1)) - ! Y dimension - InitInData%WaveElevXY(2,n) = drvrInitInp%WaveElevDY*(J - 0.5*(drvrInitInp%WaveElevNY-1)) - ENDDO - ENDDO - ENDIF + IF ( drvrData%PRPInputsMod < 0 ) THEN + if (drvrData%NSteps < 3) then + ErrStat = ErrID_Fatal + ErrMsg = 'Interpolation requires at least 3 data points in PRPInputsFile when PRPInputsMod < 0.' + CALL CheckError() + end if + END IF +!------------------------------------------------------------------------------------- +! Begin Simulation Setup +!------------------------------------------------------------------------------------- + + ! Initialize the SeaState module + InitInData_SeaSt%hasIce = .FALSE. + InitInData_SeaSt%Gravity = drvrData%Gravity + InitInData_SeaSt%defWtrDens = drvrData%WtrDens + InitInData_SeaSt%defWtrDpth = drvrData%WtrDpth + InitInData_SeaSt%defMSL2SWL = drvrData%MSL2SWL + InitInData_SeaSt%UseInputFile = .TRUE. + InitInData_SeaSt%InputFile = drvrData%SeaStateInputFile + InitInData_SeaSt%OutRootName = trim(drvrData%OutRootName)//'.SEA' + InitInData_SeaSt%TMax = drvrData%TMax + InitInData_SeaSt%Linearize = drvrData%Linearize + + ! Initialize the HydroDyn module + Interval = drvrData%TimeInterval + + call SeaSt_Init( InitInData_SeaSt, u_SeaSt(1), p_SeaSt, x_SeaSt, xd_SeaSt, z_SeaSt, OtherState_SeaSt, y_SeaSt, m_SeaSt, Interval, InitOutData_SeaSt, ErrStat, ErrMsg ) + SeaState_Initialized = .true. + CALL CheckError() + + if ( Interval /= drvrData%TimeInterval) then + ErrMsg = 'The SeaState Module attempted to change timestep interval, but this is not allowed. The SeaState Module must use the Driver Interval.' + ErrStat = ErrID_Fatal + call HD_DvrEnd() + end if + + ! Set HD Init Inputs based on SeaStates Init Outputs + call SetHD_InitInputs() ! Initialize the module - Interval = drvrInitInp%TimeInterval - CALL HydroDyn_Init( InitInData, u(1), p, x, xd, z, OtherState, y, m, Interval, InitOutData, ErrStat, ErrMsg ) - if (errStat >= AbortErrLev) then - ! Clean up and exit - call HD_DvrCleanup() - end if + Interval = drvrData%TimeInterval + CALL HydroDyn_Init( InitInData_HD, u(1), p, x, xd, z, OtherState, y, m, Interval, InitOutData_HD, ErrStat, ErrMsg ) + HydroDyn_Initialized = .true. + CALL CheckError() - IF ( Interval /= drvrInitInp%TimeInterval) THEN - CALL WrScr('The HydroDyn Module attempted to change timestep interval, but this is not allowed. The HydroDyn Module must use the Driver Interval.') - call HD_DvrCleanup() - + IF ( Interval /= drvrData%TimeInterval) THEN + ErrMsg = ' The HydroDyn Module attempted to change timestep interval, but this is not allowed. The HydroDyn Module must use the Driver Interval.' + ErrStat = ErrID_Fatal + call HD_DvrEnd() END IF - ! Write the gridded wave elevation data to a file - - IF ( drvrInitInp%WaveElevSeriesFlag ) CALL WaveElevGrid_Output (drvrInitInp, InitInData, InitOutData, p, ErrStat, ErrMsg) - if (errStat >= AbortErrLev) then - ! Clean up and exit - call HD_DvrCleanup() - end if + ! Initialization to concatenate all module data into a single output file + CALL InitOutputFile(InitOutData_HD, InitOutData_SeaSt, drvrData, ErrStat, ErrMsg ); CALL CheckError() - ! Destroy initialization data - - CALL HydroDyn_DestroyInitInput( InitInData, ErrStat, ErrMsg ) - CALL HydroDyn_DestroyInitOutput( InitOutData, ErrStat, ErrMsg ) + ! Destroy InitInput and InitOutput data (and nullify pointers to SeaState data) + CALL SeaSt_DestroyInitInput( InitInData_SeaSt, ErrStat, ErrMsg ); CALL CheckError() + CALL SeaSt_DestroyInitOutput( InitOutData_SeaSt, ErrStat, ErrMsg ); CALL CheckError() + CALL HydroDyn_DestroyInitInput( InitInData_HD, ErrStat, ErrMsg ); CALL CheckError() + CALL HydroDyn_DestroyInitOutput( InitOutData_HD, ErrStat, ErrMsg ); CALL CheckError() + - ! Create Mesh mappings if ( u(1)%WAMITMesh%Initialized ) then ! Create mesh mappings between (0,0,0) reference point mesh and the WAMIT body(ies) mesh [ 1 node per body ] - CALL MeshMapCreate( u(1)%PRPMesh, u(1)%WAMITMesh, HD_Ref_2_WB_P, ErrStat2, ErrMsg2 ); CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'HydroDynDriver') - if (errStat >= AbortErrLev) then - ! Clean up and exit - call HD_DvrCleanup() - end if + CALL MeshMapCreate( u(1)%PRPMesh, u(1)%WAMITMesh, mappingData%HD_Ref_2_WB_P, ErrStat, ErrMsg ); CALL CheckError() endif if ( u(1)%Morison%Mesh%Initialized ) then ! Create mesh mappings between (0,0,0) reference point mesh and the Morison mesh - CALL MeshMapCreate( u(1)%PRPMesh, u(1)%Morison%Mesh, HD_Ref_2_M_P, ErrStat2, ErrMsg2 ); CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'HydroDynDriver') - if (errStat >= AbortErrLev) then - ! Clean up and exit - call HD_DvrCleanup() - end if + CALL MeshMapCreate( u(1)%PRPMesh, u(1)%Morison%Mesh, mappingData%HD_Ref_2_M_P, ErrStat, ErrMsg ); CALL CheckError() endif - - - ! Set any steady-state inputs, once before the time-stepping loop - - IF (( drvrInitInp%PRPInputsMod /= 2 ) .AND. ( drvrInitInp%PRPInputsMod >= 0 )) THEN - - u(1)%PRPMesh%TranslationDisp(:,1) = drvrInitInp%uPRPInSteady(1:3) + ! validate data from HD + IF ( drvrData%PRPInputsMod < 0 ) THEN + if (drvrData%NBody /= u(1)%WAMITMesh%NNodes) then + ErrStat = ErrID_Fatal + ErrMsg = 'PRPInputsFile must contain data for '//trim(num2lstr(u(1)%WAMITMesh%NNodes))//' WAMIT nodes as well as PRPmesh when PRPInputsMod < 0.' + CALL CheckError() + end if + END IF - ! Compute direction cosine matrix from the rotation angles - CALL SmllRotTrans( 'InputRotation', REAL(drvrInitInp%uPRPInSteady(4), ReKi), REAL(drvrInitInp%uPRPInSteady(5), ReKi), REAL(drvrInitInp%uPRPInSteady(6), ReKi), dcm, 'Junk', ErrStat, ErrMsg ) - u(1)%PRPMesh%Orientation(:,:,1) = dcm + ! Set initial inputs at t = 0 + IF (( drvrData%PRPInputsMod /= 2 ) .AND. ( drvrData%PRPInputsMod >= 0 )) THEN + ! Set any steady-state inputs, once before the time-stepping loop (these don't change, so we don't need to update them in the time-marching simulation) + CALL SetHDInputs_Constant(u(1), mappingData, drvrData, ErrStat, ErrMsg); CALL CheckError() + ELSE + CALL SetHDInputs(0.0_R8Ki, n, u(1), mappingData, drvrData, ErrStat, ErrMsg); CALL CheckError() + END IF - u(1)%PRPMesh%TranslationVel(:,1) = drvrInitInp%uDotPRPInSteady(1:3) - u(1)%PRPMesh%RotationVel(:,1) = drvrInitInp%uDotPRPInSteady(4:6) - u(1)%PRPMesh%TranslationAcc(:,1) = drvrInitInp%uDotDotPRPInSteady(1:3) - u(1)%PRPMesh%RotationAcc(:,1) = drvrInitInp%uDotDotPRPInSteady(4:6) - - IF ( u(1)%WAMITMesh%Initialized ) THEN - - ! Map PRP kinematics to the WAMIT mesh with 1 to NBody nodes - CALL Transfer_Point_to_Point( u(1)%PRPMesh, u(1)%WAMITMesh, HD_Ref_2_WB_P, ErrStat2, ErrMsg2 ); CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'HydroDynDriver') - if (errStat >= AbortErrLev) then - ! Clean up and exit - call HD_DvrCleanup() - end if - - END IF ! u(1)%WAMITMesh%Initialized - - if ( u(1)%Morison%Mesh%Initialized ) then - - ! Map PRP kinematics to the Morison mesh - CALL Transfer_Point_to_Point( u(1)%PRPMesh, u(1)%Morison%Mesh, HD_Ref_2_M_P, ErrStat2, ErrMsg2 ); CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'HydroDynDriver') - if (errStat >= AbortErrLev) then - ! Clean up and exit - call HD_DvrCleanup() - end if - end if ! u(1)%Morison%Mesh%Initialized + !............................................................................................................................... + ! --- Linearization + !............................................................................................................................... + if (drvrData%Linearize) then + ! --- Creating useful EDRPtMesh + + call Eye(dcm, ErrStat, ErrMsg ); CALL CheckError() + call CreateInputPointMesh(mappingData%EDRPt_Loads, (/0.0_ReKi, 0.0_ReKi, drvrData%PtfmRefzt/), dcm, HasMotion=.false., HasLoads=.true., ErrStat=ErrStat, ErrMsg=ErrMsg ); CALL CheckError() + call CreateInputPointMesh(mappingData%EDRPt_Motion, (/0.0_ReKi, 0.0_ReKi, drvrData%PtfmRefzt/), dcm, HasMotion=.true., HasLoads=.false., ErrStat=ErrStat, ErrMsg=ErrMsg ); CALL CheckError() + call CreateInputPointMesh(mappingData%ZZZPtMeshMotion, (/0.0_ReKi, 0.0_ReKi, 0.0_ReKi /), dcm, HasMotion=.true., HasLoads=.false., ErrStat=ErrStat, ErrMsg=ErrMsg ); CALL CheckError() + call CreateInputPointMesh(mappingData%ZZZPtMeshLoads , (/0.0_ReKi, 0.0_ReKi, 0.0_ReKi /), dcm, HasMotion=.false., HasLoads=.true., ErrStat=ErrStat, ErrMsg=ErrMsg ); CALL CheckError() + + CALL MeshMapCreate( u(1)%PRPMesh, mappingData%EDRPt_Motion, mappingData%HD_Ref_2_ED_Ref, ErrStat, ErrMsg ); CALL CheckError() + CALL MeshMapCreate( mappingData%EDRPt_Motion, u(1)%PRPMesh, mappingData%ED_Ref_2_HD_Ref, ErrStat, ErrMsg ); CALL CheckError() - END IF + CALL MeshMapCreate( m%AllHdroOrigin, mappingData%EDRPt_Loads, mappingData%HD_RefLoads_2_ED_Ref, ErrStat, ErrMsg ); CALL CheckError() + CALL MeshMapCreate( m%AllHdroOrigin, mappingData%ZZZPtMeshLoads, mappingData%HD_RefLoads_2_ZZZLoads,ErrStat, ErrMsg ); CALL CheckError() + + endif - !............................................................................................................................... ! Routines called in loose coupling -- the glue code may implement this in various ways !............................................................................................................................... Time = 0.0 - CALL SimStatus_FirstTime( TiLstPrn, PrevClockTime, SimStrtTime, UsrTime2, time, InitInData%TMax ) + CALL SimStatus_FirstTime( TiLstPrn, PrevClockTime, SimStrtTime, UsrTime2, Time, drvrData%TMax ) ! loop through time steps maxAngle = 0.0 - - DO n = 1, drvrInitInp%NSteps + mappingData%Ind = 1 ! initialize - Time = (n-1) * drvrInitInp%TimeInterval - InputTime(1) = Time + DO n = 1, drvrData%NSteps - ! Modify u (likely from the outputs of another module or a set of test conditions) here: - - ! PRPInputsMod 2: Reads time series of positions, velocities, and accelerations for the platform reference point - IF ( drvrInitInp%PRPInputsMod == 2 ) THEN - - u(1)%PRPMesh%TranslationDisp(:,1) = PRPin(n,2:4) + Time = (n-1) * drvrData%TimeInterval + InputTime(1) = Time - ! Compute direction cosine matrix from the rotation angles - - IF ( abs(PRPin(n,5)) > maxAngle ) maxAngle = abs(PRPin(n,5)) - IF ( abs(PRPin(n,6)) > maxAngle ) maxAngle = abs(PRPin(n,6)) - IF ( abs(PRPin(n,7)) > maxAngle ) maxAngle = abs(PRPin(n,7)) - - CALL SmllRotTrans( 'InputRotation', REAL(PRPin(n,5),ReKi), REAL(PRPin(n,6),ReKi), REAL(PRPin(n,7),ReKi), dcm, 'Junk', ErrStat, ErrMsg ) - u(1)%PRPMesh%Orientation(:,:,1) = dcm - u(1)%PRPMesh%TranslationVel(:,1) = PRPin(n,8:10) - u(1)%PRPMesh%RotationVel(:,1) = PRPin(n,11:13) - u(1)%PRPMesh%TranslationAcc(:,1) = PRPin(n,14:16) - u(1)%PRPMesh%RotationAcc(:,1) = PRPin(n,17:19) - - IF ( u(1)%WAMITMesh%Initialized ) THEN - ! Map kinematics to the WAMIT mesh with 1 to NBody nodes - CALL Transfer_Point_to_Point( u(1)%PRPMesh, u(1)%WAMITMesh, HD_Ref_2_WB_P, ErrStat2, ErrMsg2 ); CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'HydroDynDriver') - if (errStat >= AbortErrLev) then - ! Clean up and exit - call HD_DvrCleanup() - end if - END IF + IF (( drvrData%PRPInputsMod == 2 ) .OR. ( drvrData%PRPInputsMod < 0 )) THEN + ! Modify u (likely from the outputs of another module or a set of test conditions) here: + call SetHDInputs(Time, n, u(1), mappingData, drvrData, ErrStat, ErrMsg); CALL CheckError() + ! SeaState has no inputs, so no need to set them. + END IF + + if (n==1 .and. drvrData%Linearize) then + ! we set u(1)%PRPMesh motions, so we should assume that EDRP changed similarly: + call Transfer_Point_to_Point( u(1)%PRPMesh, mappingData%EDRPt_Motion, mappingData%HD_Ref_2_ED_Ref, ErrStat, ErrMsg); CALL CheckError() - IF ( u(1)%Morison%Mesh%Initialized ) THEN - ! Map kinematics to the WAMIT mesh with 1 to NBody nodes - CALL Transfer_Point_to_Point( u(1)%PRPMesh, u(1)%Morison%Mesh, HD_Ref_2_M_P, ErrStat2, ErrMsg2 ); CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'HydroDynDriver') - if (errStat >= AbortErrLev) then - ! Clean up and exit - call HD_DvrCleanup() - end if - END IF - - end if + !call MeshPrintInfo ( 21, mappingData%EDRPt_Motion) + !call MeshPrintInfo ( 22, u(1)%PRPMesh) - !@mhall: new kinematics input for moving bodies individually - ! PRPInputsMod < 0: Reads time series of positions for each body individually, and uses finite differences to also get velocities and accelerations. - ! The number of bodies is the negative of PRPInputsMod. - IF ( drvrInitInp%PRPInputsMod < 0 ) THEN - - ! platform reference point (PRP), and body 1-NBody displacements - u(1)%PRPMesh%TranslationDisp(:,1) = PRPin(n,2:4) - DO I=1,NBody - u(1)%WAMITMesh%TranslationDisp(:,I) = PRPin(n, 6*I+2:6*I+4) - END DO - - ! PRP and body 1-NBody orientations (skipping the maxAngle stuff) - CALL SmllRotTrans( 'InputRotation', REAL(PRPin(n,5),ReKi), REAL(PRPin(n,6),ReKi), REAL(PRPin(n,7),ReKi), dcm, 'PRP orientation', ErrStat, ErrMsg ) - u(1)%PRPMesh%Orientation(:,:,1) = dcm - DO I=1, NBody - CALL SmllRotTrans( 'InputRotation', REAL(PRPin(n,6*I+5),ReKi), REAL(PRPin(n,6*I+6),ReKi), REAL(PRPin(n,6*I+7),ReKi), dcm, 'body orientation', ErrStat, ErrMsg ) - u(1)%PRPMesh%Orientation(:,:,1) = dcm - END DO - - ! use finite differences for velocities and accelerations - IF (n == 1) THEN ! use forward differences for first time step - - u(1)%PRPMesh%TranslationVel(:,1) = (PRPin(n+1, 2:4) - PRPin(n , 2:4))/drvrInitInp%TimeInterval - u(1)%PRPMesh%RotationVel( :,1) = (PRPin(n+1, 5:7) - PRPin(n , 5:7))/drvrInitInp%TimeInterval - u(1)%PRPMesh%TranslationAcc(:,1) = (PRPin(n+2, 2:4) - 2*PRPin(n+1, 2:4) + PRPin(n, 2:4))/(drvrInitInp%TimeInterval*drvrInitInp%TimeInterval) - u(1)%PRPMesh%RotationAcc( :,1) = (PRPin(n+2, 5:7) - 2*PRPin(n+1, 5:7) + PRPin(n, 5:7))/(drvrInitInp%TimeInterval*drvrInitInp%TimeInterval) - - DO I=1,NBody - u(1)%WAMITMesh%TranslationVel(:,I) = (PRPin(n+1, 6*I+2:6*I+4) - PRPin(n , 6*I+2:6*I+4))/drvrInitInp%TimeInterval - u(1)%WAMITMesh%RotationVel( :,I) = (PRPin(n+1, 6*I+5:6*I+7) - PRPin(n , 6*I+5:6*I+7))/drvrInitInp%TimeInterval - u(1)%WAMITMesh%TranslationAcc(:,I) = (PRPin(n+2, 6*I+2:6*I+4) - 2*PRPin(n+1, 6*I+2:6*I+4) + PRPin(n, 6*I+2:6*I+4))/(drvrInitInp%TimeInterval*drvrInitInp%TimeInterval) - u(1)%WAMITMesh%RotationAcc( :,I) = (PRPin(n+2, 6*I+5:6*I+7) - 2*PRPin(n+1, 6*I+5:6*I+7) + PRPin(n, 6*I+5:6*I+7))/(drvrInitInp%TimeInterval*drvrInitInp%TimeInterval) - END DO - - ELSE IF (n == drvrInitInp%NSteps) THEN ! use backward differences for last time step - - u(1)%PRPMesh%TranslationVel(:,1) = (PRPin(n, 2:4) - PRPin(n-1, 2:4))/drvrInitInp%TimeInterval - u(1)%PRPMesh%RotationVel( :,1) = (PRPin(n, 5:7) - PRPin(n-1, 5:7))/drvrInitInp%TimeInterval - u(1)%PRPMesh%TranslationAcc(:,1) = (PRPin(n, 2:4) - 2*PRPin(n-1, 2:4) + PRPin(n-2, 2:4))/(drvrInitInp%TimeInterval*drvrInitInp%TimeInterval) - u(1)%PRPMesh%RotationAcc( :,1) = (PRPin(n, 5:7) - 2*PRPin(n-1, 5:7) + PRPin(n-2, 5:7))/(drvrInitInp%TimeInterval*drvrInitInp%TimeInterval) - - DO I=1,NBody - u(1)%WAMITMesh%TranslationVel(:,I) = (PRPin(n, 6*I+2:6*I+4) - PRPin(n-1, 6*I+2:6*I+4))/drvrInitInp%TimeInterval - u(1)%WAMITMesh%RotationVel( :,I) = (PRPin(n, 6*I+5:6*I+7) - PRPin(n-1, 6*I+5:6*I+7))/drvrInitInp%TimeInterval - u(1)%WAMITMesh%TranslationAcc(:,I) = (PRPin(n, 6*I+2:6*I+4) - 2*PRPin(n-1, 6*I+2:6*I+4) + PRPin(n-2, 6*I+2:6*I+4))/(drvrInitInp%TimeInterval*drvrInitInp%TimeInterval) - u(1)%WAMITMesh%RotationAcc( :,I) = (PRPin(n, 6*I+5:6*I+7) - 2*PRPin(n-1, 6*I+5:6*I+7) + PRPin(n-2, 6*I+5:6*I+7))/(drvrInitInp%TimeInterval*drvrInitInp%TimeInterval) - END DO - - ELSE ! otherwise use central differences for intermediate time steps - - u(1)%PRPMesh%TranslationVel(:,1) = (PRPin(n+1, 2:4) - PRPin(n-1, 2:4))*0.5/drvrInitInp%TimeInterval - u(1)%PRPMesh%RotationVel( :,1) = (PRPin(n+1, 5:7) - PRPin(n-1, 5:7))*0.5/drvrInitInp%TimeInterval - u(1)%PRPMesh%TranslationAcc(:,1) = (PRPin(n+1, 2:4) - 2*PRPin(n, 2:4) + PRPin(n-1, 2:4))/(drvrInitInp%TimeInterval*drvrInitInp%TimeInterval) - u(1)%PRPMesh%RotationAcc( :,1) = (PRPin(n+1, 5:7) - 2*PRPin(n, 5:7) + PRPin(n-1, 5:7))/(drvrInitInp%TimeInterval*drvrInitInp%TimeInterval) - - DO I=1,NBody - u(1)%WAMITMesh%TranslationVel(:,I) = (PRPin(n+1, 6*I+2:6*I+4) - PRPin(n-1, 6*I+2:6*I+4))*0.5/drvrInitInp%TimeInterval - u(1)%WAMITMesh%RotationVel( :,I) = (PRPin(n+1, 6*I+5:6*I+7) - PRPin(n-1, 6*I+5:6*I+7))*0.5/drvrInitInp%TimeInterval - u(1)%WAMITMesh%TranslationAcc(:,I) = (PRPin(n+1, 6*I+2:6*I+4) - 2*PRPin(n, 6*I+2:6*I+4) + PRPin(n-1, 6*I+2:6*I+4))/(drvrInitInp%TimeInterval*drvrInitInp%TimeInterval) - u(1)%WAMITMesh%RotationAcc( :,I) = (PRPin(n+1, 6*I+5:6*I+7) - 2*PRPin(n, 6*I+5:6*I+7) + PRPin(n-1, 6*I+5:6*I+7))/(drvrInitInp%TimeInterval*drvrInitInp%TimeInterval) - END DO - - END IF - - IF ( u(1)%Morison%Mesh%Initialized ) THEN - ! Map kinematics to the WAMIT mesh with 1 to NBody nodes - CALL Transfer_Point_to_Point( u(1)%PRPMesh, u(1)%Morison%Mesh, HD_Ref_2_M_P, ErrStat2, ErrMsg2 ); CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'HydroDynDriver') - if (errStat >= AbortErrLev) then - ! Clean up and exit - call HD_DvrCleanup() - end if - END IF - - END IF - !@mhall: end of addition - + call Linearization(Time, u(1), p, x, xd, z, OtherState, y, m, .true., mappingData, ErrStat, ErrMsg); CALL CheckError() + call Linearization(Time, u(1), p, x, xd, z, OtherState, y, m, .false., mappingData, ErrStat, ErrMsg); CALL CheckError() + end if - ! Calculate outputs at n - CALL HydroDyn_CalcOutput( Time, u(1), p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) - if (errStat >= AbortErrLev) then - ! Clean up and exit - call HD_DvrCleanup() - end if - + call SeaSt_CalcOutput( Time, u_SeaSt(1), p_SeaSt, x_SeaSt, xd_SeaSt, z_SeaSt, OtherState_SeaSt, y_SeaSt, m_SeaSt, ErrStat, ErrMsg ); CALL CheckError() + CALL HydroDyn_CalcOutput( Time, u(1), p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ); CALL CheckError() + + ! Write output to a file which is managed by the driver program and not the individual modules + CALL FillOutputFile(Time, y_SeaSt, y, drvrData, ErrStat, ErrMsg); CALL CheckError() + ! Get state variables at next step: INPUT at step n, OUTPUT at step n + 1 - CALL HydroDyn_UpdateStates( Time, n, u, InputTime, p, x, xd, z, OtherState, m, ErrStat, ErrMsg ) - if (errStat >= AbortErrLev) then - ! Clean up and exit - call HD_DvrCleanup() - end if + CALL HydroDyn_UpdateStates( Time, n, u, InputTime, p, x, xd, z, OtherState, m, ErrStat, ErrMsg ); CALL CheckError() - IF ( MOD( n + 1, n_SttsTime ) == 0 ) THEN - - CALL SimStatus( TiLstPrn, PrevClockTime, time, InitInData%TMax ) - + CALL SimStatus( TiLstPrn, PrevClockTime, time, drvrData%TMax ) ENDIF - ! Write output to a file which is managed by the driver program and not the individual modules - ! TODO - END DO - - -! For now, finish here. -call HD_DvrCleanup() - - - - CONTAINS - - -!==================================================================================================== -SUBROUTINE CleanupEchoFile( EchoFlag, UnEcho) -! The routine cleans up the module echo file and resets the NWTC_Library, reattaching it to -! any existing echo information -!---------------------------------------------------------------------------------------------------- - LOGICAL, INTENT( IN ) :: EchoFlag ! local version of echo flag - INTEGER, INTENT( IN ) :: UnEcho ! echo unit number - - - ! Close this module's echo file - - IF ( EchoFlag ) THEN - CLOSE(UnEcho) - END IF - - - -END SUBROUTINE CleanupEchoFile - -subroutine HD_DvrCleanup() - - ! Local variables - character(len(errMsg)) :: errMsg2 ! temporary Error message if ErrStat /= ErrID_None - integer(IntKi) :: errStat2 ! temporary Error status of the operation - - - errStat2 = ErrID_None - errMsg2 = "" - - - - call HydroDyn_DestroyInitInput( InitInData, errStat2, errMsg2 ) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, 'HD_DvrCleanup' ) - call HydroDyn_DestroyDiscState( xd_new, errStat2, errMsg2 ) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, 'HD_DvrCleanup' ) - call HydroDyn_DestroyContState( x_new, errStat2, errMsg2 ) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, 'HD_DvrCleanup' ) - call HydroDyn_End( u(1), p, x, xd, z, OtherState, y, m, errStat2, errMsg2 ) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, 'HD_DvrCleanup' ) - - if ( ErrStat /= ErrID_None ) then !This assumes PRESENT(ErrID) is also .TRUE. : - CALL WrScr(NewLine//NewLine//'Error status and messages after execution:'//NewLine//' ErrStat: '// & - TRIM(Num2LStr(ErrStat))//NewLine//' ErrMsg returned: '//TRIM(ErrMsg)//NewLine) - if ( time < 0.0 ) then - ErrMsg = 'at initialization' - else if ( time > InitInData%TMax ) then - ErrMsg = 'after computing the solution' - else - ErrMsg = 'at simulation time '//trim(Num2LStr(time))//' of '//trim(Num2LStr(InitInData%TMax))//' seconds' - end if - - - CALL ProgAbort( 'HydroDyn encountered an error '//trim(errMsg)//'.'//NewLine//' Simulation error level: '& - //trim(GetErrStr(errStat)), TrapErrors=.FALSE., TimeWait=3._ReKi ) ! wait 3 seconds (in case they double-clicked and got an error) - end if - - ! Print *, time - call RunTimes( StrtTime, REAL(UsrTime1,ReKi), SimStrtTime, REAL(UsrTime2,ReKi), time ) - call NormStop() - -end subroutine HD_DvrCleanup - - -SUBROUTINE ReadDriverInputFile( inputFile, InitInp, ErrStat, ErrMsg ) - - CHARACTER(1024), INTENT( IN ) :: inputFile - TYPE(HD_Drvr_InitInput), INTENT( OUT ) :: InitInp - 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 integer for counting - INTEGER :: J ! generic integer for counting - CHARACTER( 2) :: strI ! string version of the loop counter - - INTEGER :: UnIn ! Unit number for the input file - INTEGER :: UnEchoLocal ! The local unit number for this module's echo file - CHARACTER(1024) :: EchoFile ! Name of HydroDyn 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 HydroDyn input file - - REAL(ReKi) :: TmpRealVar2(2) !< Temporary real array size 2 - INTEGER(IntKi) :: TmpIntVar2(2) !< Temporary integer array size 2 - - - - ! 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(inputFile) - - CALL GetNewUnit( UnIn ) - CALL OpenFInpFile ( UnIn, FileName, ErrStat, ErrMsg ) - IF (ErrStat >=AbortErrLev) THEN - call WrScr( ErrMsg ) - STOP - ENDIF - - - CALL WrScr( 'Opening HydroDyn Driver input file: '//FileName ) - - - !------------------------------------------------------------------------------------------------- - ! File header - !------------------------------------------------------------------------------------------------- - - CALL ReadCom( UnIn, FileName, 'HydroDyn Driver input file header line 1', ErrStat, ErrMsg ) - - IF ( ErrStat /= ErrID_None ) THEN - ErrStat = ErrID_Fatal - CLOSE( UnIn ) - RETURN - END IF + ! For now, finish here. + call HD_DvrEnd() +CONTAINS +!---------------------------------------------------------------------------------------------------------------------------------- +subroutine SetHD_InitInputs() - CALL ReadCom( UnIn, FileName, 'HydroDyn Driver input file header line 2', ErrStat, ErrMsg ) + InitInData_HD%Gravity = drvrData%Gravity + InitInData_HD%UseInputFile = .TRUE. + InitInData_HD%InputFile = drvrData%HDInputFile + InitInData_HD%OutRootName = trim(drvrData%OutRootName)//'.HD' + InitInData_HD%TMax = drvrData%TMax + InitInData_HD%Linearize = drvrData%Linearize - IF ( ErrStat /= ErrID_None ) THEN - ErrStat = ErrID_Fatal - CLOSE( UnIn ) - RETURN - END IF + ! Data from InitOutData_SeaSt: + InitInData_HD%InvalidWithSSExctn = InitOutData_SeaSt%InvalidWithSSExctn - - ! Echo Input Files. - - CALL ReadVar ( UnIn, FileName, InitInp%Echo, 'Echo', 'Echo Input', ErrStat, ErrMsg ) + InitInData_HD%WaveField => InitOutData_SeaSt%WaveField - IF ( ErrStat /= ErrID_None ) THEN - ErrStat = ErrID_Fatal - CLOSE( UnIn ) - RETURN + IF (( drvrData%PRPInputsMod /= 2 ) .AND. ( drvrData%PRPInputsMod >= 0 )) THEN + InitInData_HD%PlatformPos = drvrData%uPRPInSteady + ELSE + InitInData_HD%PlatformPos = drvrData%PRPin(1,1:6) END IF - - - ! 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 ( InitInp%Echo ) THEN - - EchoFile = TRIM(FileName)//'.ech' - CALL GetNewUnit( UnEchoLocal ) - CALL OpenEcho ( UnEchoLocal, EchoFile, ErrStat, ErrMsg ) - IF ( ErrStat /= ErrID_None ) THEN - !ErrMsg = ' Failed to open Echo file.' - ErrStat = ErrID_Fatal - CLOSE( UnIn ) - RETURN - END IF - - REWIND(UnIn) - - CALL ReadCom( UnIn, FileName, 'HydroDyn Driver input file header line 1', ErrStat, ErrMsg, UnEchoLocal ) - - IF ( ErrStat /= ErrID_None ) THEN - ErrMsg = ' Failed to read HydroDyn Driver input file header line 1.' - ErrStat = ErrID_Fatal - CALL CleanupEchoFile( InitInp%Echo, UnEchoLocal ) - CLOSE( UnIn ) - RETURN - END IF - - CALL ReadCom( UnIn, FileName, 'HydroDyn Driver input file header line 2', ErrStat, ErrMsg, UnEchoLocal ) - - IF ( ErrStat /= ErrID_None ) THEN - ErrMsg = ' Failed to read HydroDyn Driver input file header line 2.' - ErrStat = ErrID_Fatal - CALL CleanupEchoFile( InitInp%Echo, UnEchoLocal ) - CLOSE( UnIn ) - RETURN - END IF +end subroutine SetHD_InitInputs +!---------------------------------------------------------------------------------------------------------------------------------- +subroutine CheckError() + IF ( ErrStat /= ErrID_None) THEN - ! Echo Input Files. Note this line is prevented from being echoed by the ReadVar routine. - - CALL ReadVar ( UnIn, FileName, InitInp%Echo, 'Echo', 'Echo the input file data', ErrStat, ErrMsg, UnEchoLocal ) - !WRITE (UnEchoLocal,Frmt ) InitInp%Echo, 'Echo', 'Echo input file' - IF ( ErrStat /= ErrID_None ) THEN - ErrMsg = ' Failed to read Echo parameter.' - ErrStat = ErrID_Fatal - CALL CleanupEchoFile( InitInp%Echo, UnEchoLocal ) - CLOSE( UnIn ) - RETURN + IF ( ErrStat >= AbortErrLev ) THEN + CALL HD_DvrEnd() END IF + CALL WrScr( NewLine//TRIM(ErrMsg)//NewLine ) + ErrStat = ErrID_None END IF - !------------------------------------------------------------------------------------------------- - ! Environmental conditions section - !------------------------------------------------------------------------------------------------- - ! Header - - CALL ReadCom( UnIn, FileName, 'Environmental conditions header', ErrStat, ErrMsg, UnEchoLocal ) +end subroutine CheckError +!---------------------------------------------------------------------------------------------------------------------------------- +subroutine HD_DvrEnd() - IF ( ErrStat /= ErrID_None ) THEN - ErrMsg = ' Failed to read Comment line.' - ErrStat = ErrID_Fatal - CALL CleanupEchoFile( InitInp%Echo, UnEchoLocal ) - CLOSE( UnIn ) - RETURN - END IF - - - ! Gravity - Gravity. - - CALL ReadVar ( UnIn, FileName, InitInp%Gravity, 'Gravity', 'Gravity', ErrStat, ErrMsg, UnEchoLocal ) - - IF ( ErrStat /= ErrID_None ) THEN - ErrMsg = ' Failed to read Gravity parameter.' - ErrStat = ErrID_Fatal - CALL CleanupEchoFile( InitInp%Echo, UnEchoLocal ) - CLOSE( UnIn ) - RETURN - END IF - - ! WtrDens - Water density. - - CALL ReadVar ( UnIn, FileName, InitInp%WtrDens, 'WtrDens', 'Water density', ErrStat, ErrMsg, UnEchoLocal ) - - IF ( ErrStat /= ErrID_None ) THEN - ErrMsg = ' Failed to read WtrDens parameter.' - ErrStat = ErrID_Fatal - CALL CleanupEchoFile( InitInp%Echo, UnEchoLocal ) - CLOSE( UnIn ) - RETURN - END IF - - ! WtrDpth - Water depth. - - CALL ReadVar ( UnIn, FileName, InitInp%WtrDpth, 'WtrDpth', 'Water depth', ErrStat, ErrMsg, UnEchoLocal ) - - IF ( ErrStat /= ErrID_None ) THEN - ErrMsg = ' Failed to read WtrDpth parameter.' - ErrStat = ErrID_Fatal - CALL CleanupEchoFile( InitInp%Echo, UnEchoLocal ) - CLOSE( UnIn ) - RETURN - END IF - - ! MSL2SWL - Offset between still-water level and mean sea level. - - CALL ReadVar ( UnIn, FileName, InitInp%MSL2SWL, 'MSL2SWL', 'Offset between still-water level and mean sea level', ErrStat, ErrMsg, UnEchoLocal ) - - IF ( ErrStat /= ErrID_None ) THEN - ErrMsg = ' Failed to read MSL2SWL parameter.' - ErrStat = ErrID_Fatal - CALL CleanupEchoFile( InitInp%Echo, UnEchoLocal ) - CLOSE( UnIn ) - RETURN - END IF + ! Local variables + character(*), parameter :: RoutineName = 'HD_DvrEnd' + INTEGER(IntKi) :: ErrStat2 ! Status of error message + CHARACTER(ErrMsgLen) :: ErrMsg2 ! Error message if ErrStat /= ErrID_None - !------------------------------------------------------------------------------------------------- - ! HYDRODYN section - !------------------------------------------------------------------------------------------------- - - ! Header + call WriteOutputFile(drvrData, ErrStat2, ErrMsg2) + call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - CALL ReadCom( UnIn, FileName, 'HYDRODYN header', ErrStat, ErrMsg, UnEchoLocal ) - - IF ( ErrStat /= ErrID_None ) THEN - ErrMsg = ' Failed to read Comment line.' - ErrStat = ErrID_Fatal - CALL CleanupEchoFile( InitInp%Echo, UnEchoLocal ) - CLOSE( UnIn ) - RETURN - END IF - - - ! HDInputFile + if (drvrData%OutData%unOutFile > 0) CLOSE(drvrData%OutData%unOutFile) - CALL ReadVar ( UnIn, FileName, InitInp%HDInputFile, 'HDInputFile', & - 'HydroDyn input filename', ErrStat, ErrMsg, UnEchoLocal ) - - IF ( ErrStat /= ErrID_None ) THEN - ErrMsg = ' Failed to read HDInputFile parameter.' - ErrStat = ErrID_Fatal - CALL CleanupEchoFile( InitInp%Echo, UnEchoLocal ) - CLOSE( UnIn ) - RETURN - END IF - - - ! OutRootName - - CALL ReadVar ( UnIn, FileName, InitInp%OutRootName, 'OutRootName', & - 'HydroDyn output root filename', ErrStat, ErrMsg, UnEchoLocal ) - - IF ( ErrStat /= ErrID_None ) THEN - ErrMsg = ' Failed to read OutRootName parameter.' - ErrStat = ErrID_Fatal - CALL CleanupEchoFile( InitInp%Echo, UnEchoLocal ) - CLOSE( UnIn ) - RETURN - END IF - - ! Linearize - - CALL ReadVar ( UnIn, FileName, InitInp%Linearize, 'Linearize', & - 'Linearize parameter', ErrStat, ErrMsg, UnEchoLocal ) - - IF ( ErrStat /= ErrID_None ) THEN - ErrMsg = ' Failed to read Linearize parameter.' - ErrStat = ErrID_Fatal - CALL CleanupEchoFile( InitInp%Echo, UnEchoLocal ) - CLOSE( UnIn ) - RETURN - END IF - - ! NSteps - - CALL ReadVar ( UnIn, FileName, InitInp%NSteps, 'NSteps', & - 'Number of time steps in the HydroDyn simulation', ErrStat, ErrMsg, UnEchoLocal ) - - IF ( ErrStat /= ErrID_None ) THEN - ErrMsg = ' Failed to read NSteps parameter.' - ErrStat = ErrID_Fatal - CALL CleanupEchoFile( InitInp%Echo, UnEchoLocal ) - CLOSE( UnIn ) - RETURN - END IF - - - ! TimeInterval - - CALL ReadVar ( UnIn, FileName, InitInp%TimeInterval, 'TimeInterval', & - 'Time interval for any HydroDyn inputs', ErrStat, ErrMsg, UnEchoLocal ) - - IF ( ErrStat /= ErrID_None ) THEN - ErrMsg = ' Failed to read TimeInterval parameter.' - ErrStat = ErrID_Fatal - CALL CleanupEchoFile( InitInp%Echo, UnEchoLocal ) - CLOSE( UnIn ) - RETURN - END IF - - - !------------------------------------------------------------------------------------------------- - ! PRP INPUTS section - !------------------------------------------------------------------------------------------------- - - ! Header + if (SeaState_Initialized) then + call SeaSt_End( u_SeaSt(1), p_SeaSt, x_SeaSt, xd_SeaSt, z_SeaSt, OtherState_SeaSt, y_SeaSt, m_SeaSt, errStat2, errMsg2 ) + call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) + end if - CALL ReadCom( UnIn, FileName, 'PRP INPUTS header', ErrStat, ErrMsg, UnEchoLocal ) - - IF ( ErrStat /= ErrID_None ) THEN - ErrMsg = ' Failed to read Comment line.' - ErrStat = ErrID_Fatal - CALL CleanupEchoFile( InitInp%Echo, UnEchoLocal ) - CLOSE( UnIn ) - RETURN - END IF - - - - ! PRPInputsMod - - CALL ReadVar ( UnIn, FileName, InitInp%PRPInputsMod, 'PRPInputsMod', & - 'Model for the PRP (principal reference point) inputs', ErrStat, ErrMsg, UnEchoLocal ) - - IF ( ErrStat /= ErrID_None ) THEN - ErrMsg = ' Failed to read PRPInputsMod parameter.' - ErrStat = ErrID_Fatal - CALL CleanupEchoFile( InitInp%Echo, UnEchoLocal ) - CLOSE( UnIn ) - RETURN - END IF - - - ! PRPInputsFile - - CALL ReadVar ( UnIn, FileName, InitInp%PRPInputsFile, 'PRPInputsFile', & - 'Filename for the PRP HydroDyn inputs', ErrStat, ErrMsg, UnEchoLocal ) - - IF ( ErrStat /= ErrID_None ) THEN - ErrMsg = ' Failed to read PRPInputsFile parameter.' - ErrStat = ErrID_Fatal - CALL CleanupEchoFile( InitInp%Echo, UnEchoLocal ) - CLOSE( UnIn ) - RETURN - END IF - - - !------------------------------------------------------------------------------------------------- - ! PRP STEADY STATE INPUTS section - !------------------------------------------------------------------------------------------------- - - ! Header + if (HydroDyn_Initialized) then + call HydroDyn_End( u(1), p, x, xd, z, OtherState, y, m, errStat2, errMsg2 ) + call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) + end if + + ! Destroy Initialization data + CALL SeaSt_DestroyInitOutput( InitOutData_SeaSt, ErrStat2, ErrMsg2 ) + call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) + CALL SeaSt_DestroyInitInput( InitInData_SeaSt, ErrStat2, ErrMsg2 ) + call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) + CALL HydroDyn_DestroyInitInput( InitInData_HD, ErrStat2, ErrMsg2 ) + call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) + CALL HydroDyn_DestroyInitOutput( InitOutData_HD, ErrStat2, ErrMsg2 ) + call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) + + ! Destroy copies of HD data + call HydroDyn_DestroyDiscState( xd_new, errStat2, errMsg2 ) + call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - CALL ReadCom( UnIn, FileName, 'PRP STEADY STATE INPUTS header', ErrStat, ErrMsg, UnEchoLocal ) - - IF ( ErrStat /= ErrID_None ) THEN - ErrMsg = ' Failed to read Comment line.' - ErrStat = ErrID_Fatal - CALL CleanupEchoFile( InitInp%Echo, UnEchoLocal ) - CLOSE( UnIn ) - RETURN - END IF - - - - ! uPRPInSteady + call HydroDyn_DestroyContState( x_new, errStat2, errMsg2 ) + call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - CALL ReadAry ( UnIn, FileName, InitInp%uPRPInSteady, 6, 'uPRPInSteady', & - 'PRP Steady-state displacements and rotations.', ErrStat, ErrMsg, UnEchoLocal) - - IF ( ErrStat /= ErrID_None ) THEN - ErrMsg = ' Failed to read uPRPInSteady parameter.' - ErrStat = ErrID_Fatal - CALL CleanupEchoFile( InitInp%Echo, UnEchoLocal ) - CLOSE( UnIn ) - RETURN - END IF - - - ! uDotPRPInSteady - CALL ReadAry ( UnIn, FileName, InitInp%uDotPRPInSteady, 6, 'uDotPRPInSteady', & - 'PRP Steady-state translational and rotational velocities.', ErrStat, ErrMsg, UnEchoLocal) - - IF ( ErrStat /= ErrID_None ) THEN - ErrMsg = ' Failed to read uDotPRPInSteady parameter.' - ErrStat = ErrID_Fatal - CALL CleanupEchoFile( InitInp%Echo, UnEchoLocal ) - CLOSE( UnIn ) - RETURN - END IF - - - ! uDotDotPRPInSteady + ! Destroy other data + IF (ALLOCATED(drvrData%PRPin)) DEALLOCATE(drvrData%PRPin) + IF (ALLOCATED(drvrData%PRPinTime)) DEALLOCATE(drvrData%PRPinTime) + + IF (ALLOCATED(drvrData%OutData%WriteOutputHdr)) DEALLOCATE(drvrData%OutData%WriteOutputHdr) + IF (ALLOCATED(drvrData%OutData%WriteOutputUnt)) DEALLOCATE(drvrData%OutData%WriteOutputUnt) + IF (ALLOCATED(drvrData%OutData%Storage )) DEALLOCATE(drvrData%OutData%Storage ) + + ! Destroy mappings + CALL MeshMapDestroy( mappingData%HD_Ref_2_WB_P, ErrStat2, ErrMsg2 ) + call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) + CALL MeshMapDestroy( mappingData%HD_Ref_2_M_P, ErrStat2, ErrMsg2 ) + call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - CALL ReadAry ( UnIn, FileName, InitInp%uDotDotPRPInSteady, 6, 'uDotDotPRPInSteady', & - 'PRP Steady-state translational and rotational accelerations.', ErrStat, ErrMsg, UnEchoLocal) - - IF ( ErrStat /= ErrID_None ) THEN - ErrMsg = ' Failed to read uDotDotPRPInSteady parameter.' - ErrStat = ErrID_Fatal - CALL CleanupEchoFile( InitInp%Echo, UnEchoLocal ) - CLOSE( UnIn ) - RETURN - END IF - - IF ( InitInp%PRPInputsMod /= 1 ) THEN - InitInp%uPRPInSteady = 0.0 - InitInp%uDotPRPInSteady = 0.0 - InitInp%uDotDotPRPInSteady = 0.0 - END IF - - - !------------------------------------------------------------------------------------------------- - !> ### Waves elevation series section - !------------------------------------------------------------------------------------------------- - - !> Header - -CALL ReadCom( UnIn, FileName, 'Waves multipoint elevation output header', ErrStat, ErrMsg, UnEchoLocal ) - - IF ( ErrStat /= ErrID_None ) THEN - ErrMsg = ' Failed to read Comment line.' - ErrStat = ErrID_Fatal - CALL CleanupEchoFile( InitInp%Echo, UnEchoLocal ) - CLOSE( UnIn ) - RETURN - END IF - - !> WaveElevSeriesFlag -- are we doing multipoint wave elevation output? - CALL ReadVar ( UnIn, FileName, InitInp%WaveElevSeriesFlag, 'WaveElevSeriesFlag', 'WaveElevSeriesFlag', ErrStat, ErrMsg ) - IF ( ErrStat /= ErrID_None ) THEN - ErrMsg = ' Failed to read WaveElevSeries parameter.' - ErrStat = ErrID_Fatal - CLOSE( UnIn ) - RETURN - END IF - - - !> WaveElevDX and WaveElevNY -- point spacing (m) - CALL ReadAry ( UnIn, FileName, TmpRealVar2, 2, 'WaveElevDX WaveElevDY', & - 'WaveElevSeries spacing -- WaveElevDX WaveElevDY', ErrStat, ErrMsg, UnEchoLocal) - - IF ( ErrStat /= ErrID_None ) THEN - CALL SetErrStat( ErrID_Fatal,'Failed to read WaveElevDX and WaveElevDY parameters.',ErrStat,ErrMsg,'ReadDriverInputFile') - CALL CleanupEchoFile( InitInp%Echo, UnEchoLocal ) - CLOSE( UnIn ) - RETURN - END IF - - InitInp%WaveElevDX = TmpRealVar2(1) - InitInp%WaveElevDY = TmpRealVar2(2) - - - - !> WaveElevNX and WaveElevNY -- point spacing (m) - CALL ReadAry ( UnIn, FileName, TmpIntVar2, 2, 'WaveElevNX WaveElevNY', & - 'WaveElevSeries points -- WaveElevNX WaveElevNY', ErrStat, ErrMsg, UnEchoLocal) - - IF ( ErrStat /= ErrID_None ) THEN - CALL SetErrStat( ErrID_Fatal,' Failed to read WaveElevNX and WaveElevNY parameters.',ErrStat,ErrMsg,'ReadDriverInputFile') - CALL CleanupEchoFile( InitInp%Echo, UnEchoLocal ) - CLOSE( UnIn ) - RETURN - END IF - - - IF (MOD(TmpIntVar2(1),2) == 0) THEN - TmpIntVar2(1) = TmpIntVar2(1)+1 - CALL SetErrStat( ErrID_Warn, "Changing WaveElevNX to an odd number ("//TRIM(Num2LStr(TmpIntVar2(1)))// & - ") so that there is a point at the origin.",ErrStat,ErrMsg,'ReadDriverInputFile' ) - ENDIF - IF (MOD(TmpIntVar2(2),2) == 0) THEN - TmpIntVar2(2) = TmpIntVar2(2)+1 - CALL SetErrStat( ErrID_Warn, "Changing WaveElevNX to an odd number ("//TRIM(Num2LStr(TmpIntVar2(2)))// & - ") so that there is a point at the origin.",ErrStat,ErrMsg,'ReadDriverInputFile' ) - ENDIF - InitInp%WaveElevNX = TmpIntVar2(1) - InitInp%WaveElevNY = TmpIntVar2(2) - - - !> if the flag was false, set the spacing and number of points to 0 - IF ( .NOT. InitInp%WaveElevSeriesFlag ) THEN - InitInp%WaveElevDX = 0.0_ReKi - InitInp%WaveElevDY = 0.0_ReKi - InitInp%WaveElevNX = 0_IntKi - InitInp%WaveElevNY = 0_IntKi - ENDIF - - - + CALL MeshDestroy( mappingData%EDRPt_Motion, ErrStat2, ErrMsg2 ) + call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) + CALL MeshDestroy( mappingData%EDRPt_Loads, ErrStat2, ErrMsg2 ) + call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) + CALL MeshDestroy( mappingData%ZZZPtMeshMotion, ErrStat2, ErrMsg2 ) + call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) + CALL MeshDestroy( mappingData%ZZZPtMeshLoads, ErrStat2, ErrMsg2 ) + call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) + + CALL MeshMapDestroy( mappingData%ED_Ref_2_HD_Ref, ErrStat2, ErrMsg2 ) + call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) + CALL MeshMapDestroy( mappingData%HD_Ref_2_ED_Ref, ErrStat2, ErrMsg2 ) + call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) + CALL MeshMapDestroy( mappingData%HD_RefLoads_2_ED_Ref, ErrStat2, ErrMsg2 ) + call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) + CALL MeshMapDestroy( mappingData%HD_RefLoads_2_ZZZLoads, ErrStat2, ErrMsg2 ) + call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) + + if ( ErrStat /= ErrID_None ) then + CALL WrScr(NewLine//NewLine//'Error status after execution:'//TRIM(Num2LStr(ErrStat))//NewLine//TRIM(ErrMsg)//NewLine) + + if (ErrStat >= AbortErrLev) then + if ( time < 0.0 ) then + ErrMsg = 'at initialization' + else if ( time > drvrData%TMax ) then + ErrMsg = 'after computing the solution' + else + ErrMsg = 'at simulation time '//trim(Num2LStr(time))//' of '//trim(Num2LStr(drvrData%TMax))//' seconds' + end if + + CALL ProgAbort( 'HydroDyn Driver encountered an error '//trim(errMsg)//'.'// & + NewLine//' Simulation error level: '//trim(GetErrStr(errStat)), TrapErrors=.FALSE., TimeWait=3._ReKi ) ! wait 3 seconds (in case they double-clicked and got an error) + end if + end if - CALL CleanupEchoFile( InitInp%Echo, UnEchoLocal ) - CLOSE( UnIn ) + + ! Print *, time + call RunTimes( StrtTime, REAL(UsrTime1,ReKi), SimStrtTime, REAL(UsrTime2,ReKi), time ) + call NormStop() -END SUBROUTINE ReadDriverInputFile - -SUBROUTINE WaveElevGrid_Output (drvrInitInp, HDynInitInp, HDynInitOut, HDyn_p, ErrStat, ErrMsg) - - TYPE(HD_drvr_InitInput), INTENT( IN ) :: drvrInitInp - TYPE(HydroDyn_InitInputType), INTENT( IN ) :: HDynInitInp - TYPE(HydroDyn_InitOutputType), INTENT( IN ) :: HDynInitOut ! Output data from initialization - TYPE(HydroDyn_ParameterType), INTENT( IN ) :: HDyn_p ! Output data from initialization - INTEGER, 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(1024) :: ErrMsgTmp !< Temporary variable for the error message - - INTEGER(IntKi) :: WaveElevFileUn !< Number for the output file for the wave elevation series - CHARACTER(1024) :: WaveElevFileName !< Name for the output file for the wave elevation series - CHARACTER(128) :: WaveElevFmt !< Format specifier for the output file for wave elevation series - - - WaveElevFmt = "(F14.7,3x,F14.7,3x,F14.7)" - - ErrMsg = "" - ErrStat = ErrID_None - ErrMsgTmp = "" - ErrStatTmp = ErrID_None - - - ! If we calculated the wave elevation at a set of coordinates for use with making movies, put it into an output file - WaveElevFileName = TRIM(drvrInitInp%OutRootName)//".WaveElev.out" - CALL GetNewUnit( WaveElevFileUn ) - - CALL OpenFOutFile( WaveElevFileUn, WaveElevFileName, ErrStat, ErrMsg ) - IF ( ErrStat /= ErrID_None) THEN - IF ( ErrStat >= AbortErrLev ) RETURN - END IF - - ! Write some useful header information -! WRITE (WaveElevFileUn,'(A)', IOSTAT=ErrStatTmp ) '## This file was generated by '//TRIM(GetNVD(HDyn_Drv_ProgDesc))// & -! ' on '//CurDate()//' at '//CurTime()//'.' - WRITE (WaveElevFileUn,'(A)', IOSTAT=ErrStatTmp ) '## This file was generated on '//CurDate()//' at '//CurTime()//'.' - WRITE (WaveElevFileUn,'(A)', IOSTAT=ErrStatTmp ) '## This file contains the wave elevations at a series of points '// & - 'through the entire timeseries.' - WRITE (WaveElevFileUn,'(A)', IOSTAT=ErrStatTmp ) '## It is arranged as blocks of X,Y,Elevation at each timestep' - WRITE (WaveElevFileUn,'(A)', IOSTAT=ErrStatTmp ) '## Each block is separated by two blank lines for use in gnuplot' - WRITE (WaveElevFileUn,'(A)', IOSTAT=ErrStatTmp ) '# ' - WRITE (WaveElevFileUn,'(A)', IOSTAT=ErrStatTmp ) '# WaveTMax = '//TRIM(Num2LStr(HDyn_p%WaveTime(HDyn_P%NStepWave))) - WRITE (WaveElevFileUn,'(A)', IOSTAT=ErrStatTmp ) '# NStepWave = '//TRIM(Num2LStr(HDyn_p%NStepWave)) - WRITE (WaveElevFileUn,'(A)', IOSTAT=ErrStatTmp ) '# GridXPoints = '//TRIM(Num2LStr(drvrInitInp%WaveElevNX)) - WRITE (WaveElevFileUn,'(A)', IOSTAT=ErrStatTmp ) '# GridYPoints = '//TRIM(Num2LStr(drvrInitInp%WaveElevNY)) - WRITE (WaveElevFileUn,'(A)', IOSTAT=ErrStatTmp ) '# GridDX = '//TRIM(Num2LStr(drvrInitInp%WaveElevDX)) - WRITE (WaveElevFileUn,'(A)', IOSTAT=ErrStatTmp ) '# GridDY = '//TRIM(Num2LStr(drvrInitInp%WaveElevDY)) - WRITE (WaveElevFileUn,'(A)', IOSTAT=ErrStatTmp ) '# MaxWaveElev = '//TRIM(Num2LStr(MAXVAL(HDynInitOut%WaveElevSeries))) - WRITE (WaveElevFileUn,'(A)', IOSTAT=ErrStatTmp ) '# MinWaveElev = '//TRIM(Num2LStr(MINVAL(HDynInitOut%WaveElevSeries))) - WRITE (WaveElevFileUn,'(A)', IOSTAT=ErrStatTmp ) '# ' - - ! Timestep looping - DO I = 0,HDyn_p%NStepWave - WRITE (WaveElevFileUn,'(A)', IOSTAT=ErrStatTmp ) NewLine - WRITE (WaveElevFileUn,'(A)', IOSTAT=ErrStatTmp ) '# Time: '//TRIM(Num2LStr(HDyn_p%WaveTime(I))) - ! Now output the X,Y, Elev info for this timestep - DO J=1,SIZE(HDynInitInp%WaveElevXY,DIM=2) - WRITE (WaveElevFileUn,WaveElevFmt, IOSTAT=ErrStatTmp ) HDynInitInp%WaveElevXY(1,J),& - HDynInitInp%WaveElevXY(2,J),HDynInitOut%WaveElevSeries(I,J) - ENDDO - - ENDDO - - ! Done. Close the file - CLOSE (WaveElevFileUn) - -END SUBROUTINE WaveElevGrid_Output - +end subroutine HD_DvrEnd !---------------------------------------------------------------------------------------------------------------------------------- + END PROGRAM HydroDynDriver diff --git a/modules/hydrodyn/src/HydroDyn_DriverSubs.f90 b/modules/hydrodyn/src/HydroDyn_DriverSubs.f90 new file mode 100644 index 0000000000..0a2a5bb773 --- /dev/null +++ b/modules/hydrodyn/src/HydroDyn_DriverSubs.f90 @@ -0,0 +1,1322 @@ +!********************************************************************************************************************************** +! HydroDyn_DriverSubs +!.................................................................................................................................. +! LICENSING +! Copyright (C) 2022 Envision Energy USA LTD +! +! This file is part of HydroDyn. +! +! 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 HydroDynDriverSubs + + USE NWTC_Library + use SeaState + use SeaState_Types + USE HydroDyn + USE HydroDyn_Types + USE HydroDyn_Output + USE ModMesh_Types + USE VersionInfo + USE YawOffset + + IMPLICIT NONE + + TYPE HD_Drvr_MappingData + Integer(IntKi) :: Ind ! index for interpolation + type(MeshMapType) :: HD_Ref_2_WB_P ! Mesh mapping between HD Reference pt mesh and WAMIT body(ies) mesh + type(MeshMapType) :: HD_Ref_2_M_P ! Mesh mapping between HD Reference pt mesh and Morison mesh + + ! For 6x6 linearization + type(MeshType) :: EDRPt_Loads ! 1-node Point mesh located at (0,0,zRef) in global system where ElastoDyn Reference point is + type(MeshType) :: EDRPt_Motion ! 1-node Point mesh located at (0,0,zRef) in global system where ElastoDyn Reference point is + type(MeshType) :: ZZZPtMeshMotion ! 1-node Point mesh located at (0,0,0) in global system and never moving + type(MeshType) :: ZZZPtMeshLoads ! 1-node Point mesh located at (0,0,0) in global system and never moving + type(MeshMapType) :: ED_Ref_2_HD_Ref ! Mesh mapping between ED Reference pt mesh and HD PRP mesh + type(MeshMapType) :: HD_Ref_2_ED_Ref ! Mesh mapping between HD Reference pt mesh and ED ref poing mesh + type(MeshMapType) :: HD_RefLoads_2_ED_Ref ! Mesh mapping between HDHdroOrigin pt mesh and ED ref point mesh for loads + type(MeshMapType) :: HD_RefLoads_2_ZZZLoads ! Mesh mapping between HDHdroOrigin pt mesh and ZZZPtMesh + + END TYPE HD_Drvr_MappingData + + TYPE HD_Drvr_OutputFile + INTEGER :: NumOuts + INTEGER :: NumOutsMods(2) + CHARACTER(ChanLen), ALLOCATABLE :: WriteOutputHdr(:) + CHARACTER(ChanLen), ALLOCATABLE :: WriteOutputUnt(:) + REAL(ReKi), ALLOCATABLE :: Storage(:,:) + CHARACTER(500) :: FileDescLines(3) + INTEGER :: unOutFile = -1 + CHARACTER(20) :: OutFmt + CHARACTER(20) :: OutFmt_t + INTEGER :: n_Out = 0 + REAL(DbKi) :: TimeData(2) + END TYPE HD_Drvr_OutputFile + + TYPE HD_Drvr_Data + LOGICAL :: Echo + REAL(ReKi) :: Gravity + REAL(ReKi) :: WtrDens + REAL(ReKi) :: WtrDpth + REAL(ReKi) :: MSL2SWL + CHARACTER(1024) :: HDInputFile + CHARACTER(1024) :: SeaStateInputFile + CHARACTER(1024) :: OutRootName + LOGICAL :: Linearize + LOGICAL :: WrTxtOutFile = .true. + LOGICAL :: WrBinOutFile = .false. + INTEGER :: NSteps + REAL(DbKi) :: TimeInterval + REAL(DbKi) :: TMax + INTEGER :: PRPInputsMod + REAL(ReKi) :: PtfmRefzt + CHARACTER(1024) :: PRPInputsFile + REAL(R8Ki) :: uPRPInSteady(6) + REAL(R8Ki) :: uDotPRPInSteady(6) + REAL(R8Ki) :: uDotDotPRPInSteady(6) + REAL(R8Ki), ALLOCATABLE :: PRPin(:,:) ! Variable for storing time, forces, and body velocities, in m/s or rad/s for PRP + REAL(R8Ki), ALLOCATABLE :: PRPinTime(:) ! Variable for storing time, forces, and body velocities, in m/s or rad/s for PRP + INTEGER(IntKi) :: NBody ! Number of WAMIT bodies to work with if prescribing kinematics on each body (PRPInputsMod<0) + TYPE(HD_Drvr_OutputFile) :: OutData + character(500) :: FTitle ! description from 2nd line of driver file + + REAL(R8Ki) :: PRPHdg + REAL(ReKi) :: CYawFilt + + END TYPE HD_Drvr_Data + +! ----------------------------------------------------------------------------------- +! NOTE: this module and the ModMesh.f90 modules must use the Fortran compiler flag: +! /fpp because of they both have preprocessor statements +! ----------------------------------------------------------------------------------- + TYPE(ProgDesc), PARAMETER :: version = ProgDesc( 'HydroDyn Driver', '', '' ) ! The version number of this program. + character(*), parameter :: Delim = Tab + +CONTAINS + +SUBROUTINE ReadDriverInputFile( FileName, drvrData, ErrStat, ErrMsg ) + + CHARACTER(*), INTENT( IN ) :: FileName + TYPE(HD_Drvr_Data), INTENT( INOUT ) :: drvrData + 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 :: UnIn ! Unit number for the input file + INTEGER :: UnEchoLocal ! The local unit number for this module's echo file + CHARACTER(1024) :: EchoFile ! Name of HydroDyn echo file + CHARACTER(1024) :: PriPath ! Temporary storage for relative path name + + integer(IntKi) :: errStat2 ! temporary error status of the operation + character(ErrMsgLen) :: errMsg2 ! temporary error message + character(*), parameter :: RoutineName = 'ReadDriverInputFile' + + + ! Initialize the echo file unit to -1 which is the default to prevent echoing, we will alter this based on user input + UnEchoLocal = -1 + ErrStat = ErrID_None + ErrMsg = "" + + CALL GetNewUnit( UnIn ) + CALL OpenFInpFile ( UnIn, FileName, ErrStat2, ErrMsg2 ) + if (Failed()) return + + + CALL WrScr( 'Opening HydroDyn Driver input file: '//trim(FileName) ) + call GetPath( TRIM(FileName), PriPath ) ! store path name in case any of the file names are relative to the primary input file + + + !------------------------------------------------------------------------------------------------- + ! File header + !------------------------------------------------------------------------------------------------- + + CALL ReadCom( UnIn, FileName, 'HydroDyn Driver input file header line 1', ErrStat2, ErrMsg2 ) + if (Failed()) return + + + CALL ReadStr( UnIn, FileName, drvrData%FTitle, 'FTitle', 'HydroDyn Driver input file header line 2', ErrStat2, ErrMsg2 ) + if (Failed()) return + + + ! Echo Input Files. + CALL ReadVar ( UnIn, FileName, drvrData%Echo, 'Echo', 'Echo Input', ErrStat2, ErrMsg2 ) + if (Failed()) return + + + ! 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 ( drvrData%Echo ) THEN + + EchoFile = TRIM(FileName)//'.ech' + CALL GetNewUnit( UnEchoLocal ) + CALL OpenEcho ( UnEchoLocal, EchoFile, ErrStat2, ErrMsg2 ) + if (Failed()) return + + + REWIND(UnIn) + + CALL ReadCom( UnIn, FileName, 'HydroDyn Driver input file header line 1', ErrStat2, ErrMsg2, UnEchoLocal ) + if (Failed()) return + + CALL ReadCom( UnIn, FileName, 'HydroDyn Driver input file header line 2', ErrStat2, ErrMsg2, UnEchoLocal ) + if (Failed()) return + + ! Echo Input Files. Note this line is prevented from being echoed by the ReadVar routine. + CALL ReadVar ( UnIn, FileName, drvrData%Echo, 'Echo', 'Echo the input file data', ErrStat2, ErrMsg2, UnEchoLocal ) + if (Failed()) return + + + END IF + !------------------------------------------------------------------------------------------------- + ! Environmental conditions section + !------------------------------------------------------------------------------------------------- + + ! Header + CALL ReadCom( UnIn, FileName, 'Environmental conditions header', ErrStat2, ErrMsg2, UnEchoLocal ) + if (Failed()) return + + ! Gravity - Gravity. + CALL ReadVar ( UnIn, FileName, drvrData%Gravity, 'Gravity', 'Gravity', ErrStat2, ErrMsg2, UnEchoLocal ) + if (Failed()) return + + ! WtrDens - Water density. + CALL ReadVar ( UnIn, FileName, drvrData%WtrDens, 'WtrDens', 'Water density', ErrStat2, ErrMsg2, UnEchoLocal ) + if (Failed()) return + + ! WtrDpth - Water depth. + CALL ReadVar ( UnIn, FileName, drvrData%WtrDpth, 'WtrDpth', 'Water depth', ErrStat2, ErrMsg2, UnEchoLocal ) + if (Failed()) return + + ! MSL2SWL - Offset between still-water level and mean sea level. + CALL ReadVar ( UnIn, FileName, drvrData%MSL2SWL, 'MSL2SWL', 'Offset between still-water level and mean sea level', ErrStat2, ErrMsg2, UnEchoLocal ) + if (Failed()) return + + !------------------------------------------------------------------------------------------------- + ! HYDRODYN section + !------------------------------------------------------------------------------------------------- + + ! Header + CALL ReadCom( UnIn, FileName, 'HYDRODYN header', ErrStat2, ErrMsg2, UnEchoLocal ) + if (Failed()) return + + ! HDInputFile + CALL ReadVar ( UnIn, FileName, drvrData%HDInputFile, 'HDInputFile', 'HydroDyn input filename', ErrStat2, ErrMsg2, UnEchoLocal ) + if (Failed()) return + IF ( PathIsRelative( drvrData%HDInputFile ) ) drvrData%HDInputFile = TRIM(PriPath)//TRIM(drvrData%HDInputFile) + + ! SeaStInputFile + CALL ReadVar ( UnIn, FileName, drvrData%SeaStateInputFile, 'SeaStateInputFile', 'SeaState input filename', ErrStat2, ErrMsg2, UnEchoLocal ) + if (Failed()) return + IF ( PathIsRelative( drvrData%SeaStateInputFile ) ) drvrData%SeaStateInputFile = TRIM(PriPath)//TRIM(drvrData%SeaStateInputFile) + + ! OutRootName + CALL ReadVar ( UnIn, FileName, drvrData%OutRootName, 'OutRootName', 'HydroDyn output root filename', ErrStat2, ErrMsg2, UnEchoLocal ) + if (Failed()) return + IF ( PathIsRelative( drvrData%OutRootName ) ) drvrData%OutRootName = TRIM(PriPath)//TRIM(drvrData%OutRootName) + + ! Linearize + CALL ReadVar ( UnIn, FileName, drvrData%Linearize, 'Linearize', 'Linearize parameter', ErrStat2, ErrMsg2, UnEchoLocal ) + if (Failed()) return + + ! NSteps + CALL ReadVar ( UnIn, FileName, drvrData%NSteps, 'NSteps', 'Number of time steps in the HydroDyn simulation', ErrStat2, ErrMsg2, UnEchoLocal ) + if (Failed()) return + + ! TimeInterval + CALL ReadVar ( UnIn, FileName, drvrData%TimeInterval, 'TimeInterval', 'Time interval for any HydroDyn inputs', ErrStat2, ErrMsg2, UnEchoLocal ) + if (Failed()) return + + + !------------------------------------------------------------------------------------------------- + ! PRP INPUTS section + !------------------------------------------------------------------------------------------------- + + ! Header + CALL ReadCom( UnIn, FileName, 'PRP INPUTS header', ErrStat2, ErrMsg2, UnEchoLocal ) + if (Failed()) return + + ! PRPInputsMod + CALL ReadVar ( UnIn, FileName, drvrData%PRPInputsMod, 'PRPInputsMod', 'Model for the PRP (principal reference point) inputs', ErrStat2, ErrMsg2, UnEchoLocal ) + if (Failed()) return + + ! PtfmRefzt + CALL ReadVar ( UnIn, FileName, drvrData%PtfmRefzt, 'PtfmRefzt', 'Vertical distance from the ground level to the platform reference point', ErrStat, ErrMsg, UnEchoLocal ) + if (Failed()) return + + ! PRPInputsFile + CALL ReadVar ( UnIn, FileName, drvrData%PRPInputsFile, 'PRPInputsFile', 'Filename for the PRP HydroDyn inputs', ErrStat2, ErrMsg2, UnEchoLocal ) + if (Failed()) return + IF ( PathIsRelative( drvrData%PRPInputsFile ) ) drvrData%PRPInputsFile = TRIM(PriPath)//TRIM(drvrData%PRPInputsFile) + + + !------------------------------------------------------------------------------------------------- + ! PRP STEADY STATE INPUTS section + !------------------------------------------------------------------------------------------------- + + ! Header + CALL ReadCom( UnIn, FileName, 'PRP STEADY STATE INPUTS header', ErrStat2, ErrMsg2, UnEchoLocal ) + if (Failed()) return + + ! uPRPInSteady + CALL ReadAry ( UnIn, FileName, drvrData%uPRPInSteady, 6, 'uPRPInSteady', 'PRP Steady-state displacements and rotations.', ErrStat2, ErrMsg2, UnEchoLocal) + if (Failed()) return + + ! uDotPRPInSteady + CALL ReadAry ( UnIn, FileName, drvrData%uDotPRPInSteady, 6, 'uDotPRPInSteady', 'PRP Steady-state translational and rotational velocities.', ErrStat2, ErrMsg2, UnEchoLocal) + if (Failed()) return + + ! uDotDotPRPInSteady + CALL ReadAry ( UnIn, FileName, drvrData%uDotDotPRPInSteady, 6, 'uDotDotPRPInSteady', 'PRP Steady-state translational and rotational accelerations.', ErrStat2, ErrMsg2, UnEchoLocal) + if (Failed()) return + + IF ( drvrData%PRPInputsMod /= 1 ) THEN + drvrData%uPRPInSteady = 0.0 + drvrData%uDotPRPInSteady = 0.0 + drvrData%uDotDotPRPInSteady = 0.0 + END IF + + drvrData%WrTxtOutFile = .true. + drvrData%WrBinOutFile = .false. + + CALL cleanup() + +CONTAINS + + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + if (Failed) call Cleanup() + + end function Failed + + subroutine Cleanup() + CLOSE( UnIn ) + IF ( UnEchoLocal > 0 ) CLOSE( UnEchoLocal ) + end subroutine Cleanup + +END SUBROUTINE ReadDriverInputFile +!---------------------------------------------------------------------------------------------------------------------------------- +SUBROUTINE ReadPRPInputsFile( drvrData, ErrStat, ErrMsg ) + + TYPE(HD_Drvr_Data), INTENT( INOUT ) :: drvrData + 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 :: UnIn ! Unit number for the input file + INTEGER :: UnEchoLocal ! The local unit number for this module's echo file +! CHARACTER(1024) :: EchoFile ! Name of HydroDyn echo file + + integer(IntKi) :: n, sizeAry + integer(IntKi) :: errStat2 ! temporary error status of the operation + character(ErrMsgLen) :: errMsg2 ! temporary error message + character(*), parameter :: RoutineName = 'ReadDriverInputFile' + real(ReKi), allocatable :: TmpAry(:) + integer(IntKi) :: NumDataLines, numHeaderLines + + ! Initialize the echo file unit to -1 which is the default to prevent echoing, we will alter this based on user input + UnEchoLocal = -1 + UnIn = -1 + + ErrStat = ErrID_None + ErrMsg = "" + + drvrData%NBody= 0 + + IF ( drvrData%PRPInputsMod == 2 ) THEN + sizeAry = 19 + ELSEIF ( drvrData%PRPInputsMod < 0 ) THEN + ! multi-body kinematics driver option (time, PRP DOFs 1-6, body1 DOFs 1-6, body2 DOFs 1-6...) + + drvrData%NBody = -drvrData%PRPInputsMod + sizeAry = 7 + 6*drvrData%NBody + + call WrScr( 'NBody is '//trim(Num2LStr(drvrData%NBody))//' and planning to read in '//trim(Num2LStr(sizeAry))//' columns from the input file' ) + + ELSE + + RETURN + + END IF + + ! Open the (PRP or WAMIT) inputs data file + CALL GetNewUnit( UnIn ) + CALL OpenFInpFile ( UnIn, trim(drvrData%PRPInputsFile), ErrStat2, ErrMsg2 ) + if (Failed()) return + + ! Determine how many lines of data (how many time steps) are in the PRP input file + CALL GetFileLength(UnIn, trim(drvrData%PRPInputsFile), sizeAry, NumDataLines, NumHeaderLines, ErrStat2, ErrMsg2) + if (Failed()) return + CALL AllocAry(TmpAry, sizeAry, 'TmpAry', ErrStat2, ErrMsg2) + if (Failed()) return + CALL AllocAry(drvrData%PRPin, NumDataLines, sizeAry-1, 'PRPin', ErrStat2, ErrMsg2) + if (Failed()) return + CALL AllocAry(drvrData%PRPinTime, NumDataLines, 'PRPinTime', ErrStat2, ErrMsg2) + if (Failed()) return + + !seems like it would be more efficient to switch the indices on drvrData%PRPin + DO n = 1,NumDataLines + CALL ReadAry ( UnIn, drvrData%PRPInputsFile, TmpAry, sizeAry, 'Line', 'drvrData%PRPin', ErrStat2, ErrMsg2, UnEchoLocal ) + drvrData%PRPin(n,:) = TmpAry(2:sizeAry) + drvrData%PRPinTime(n) = TmpAry(1) + if (Failed()) return + END DO + + 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() + IF ( ALLOCATED(TmpAry) ) DEALLOCATE(TmpAry) + IF ( UnIn > 0 ) CLOSE( UnIn ) + IF ( UnEchoLocal > 0 ) CLOSE( UnEchoLocal ) + end subroutine Cleanup + + SUBROUTINE GetFileLength(UnitDataFile, Filename, NumDataColumns, NumDataLines, NumHeaderLines, ErrStat, ErrMsg) + + IMPLICIT NONE + + ! Passed variables + INTEGER(IntKi), INTENT(IN ) :: UnitDataFile !< Unit number of the file we are looking at. + CHARACTER(*), INTENT(IN ) :: Filename !< 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. + 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(MaxFileInfoLineLen*4) :: TextLine !< One line of text read from the file + INTEGER(IntKi) :: LineLen !< The length of the line read in + CHARACTER(MaxFileInfoLineLen) :: StrRead !< String containing the first word read in + REAL(SiKi) :: RealRead !< Returns value of the number (if there was one), or NaN (as set by NWTC_Num) if there wasn't + CHARACTER(24) :: Words(20) !< Array of words we extract from a line. We shouldn't have more than 20. + INTEGER(IntKi) :: i !< simple integer counter + 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 + CHARACTER(*), PARAMETER :: RoutineName = 'GetFileLength' + + ! 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, SIZE(Words), NumWords ) + + !> Now cycle through the first 'NumWords' of non-empty values stored in 'Words'. Words should contain + !! everything that is on the line. The subroutine ReadRealNumberFromString will set a flag 'IsRealNum' + !! when the value in Words(i) can be read as a real(SiKi). '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. + END IF + END DO + + !> 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(FileName)// & + ' when real numbers were expected. There may be a problem with the file.', ErrStat, ErrMsg, RoutineName) + IF ( ErrStat >= AbortErrLev ) THEN + RETURN + END IF + ELSE + NumHeaderLines = NumHeaderLines + 1 + END IF + 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 data file: '//TRIM(Filename)//'.'// & + ' 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 + END IF + END IF + END IF + END IF + END DO + REWIND( UnitDataFile ) + END SUBROUTINE GetFileLength + + SUBROUTINE ReadRealNumberFromString(StringToParse, ValueRead, StrRead, IsRealNum, ErrStat, ErrMsg, IOErrStat) + + CHARACTER(*), INTENT(IN ) :: StringToParse !< The string we were handed. + REAL(SiKi), 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(ErrMsg)//NewLine + ErrSTat = ErrID_Severe + END IF + + RETURN + END SUBROUTINE ReadRealNumberFromString + +END SUBROUTINE ReadPRPInputsFile +!---------------------------------------------------------------------------------------------------------------------------------- +SUBROUTINE InitOutputFile(InitOutData_HD, InitOutData_SeaSt, drvrData, ErrStat, ErrMsg) + + TYPE(HydroDyn_InitOutputType), INTENT(IN) :: InitOutData_HD ! Output data from initialization + TYPE(SeaSt_InitOutputType), INTENT(IN) :: InitOutData_SeaSt ! Output data from initialization + TYPE(HD_Drvr_Data), INTENT( INOUT ) :: drvrData + INTEGER, INTENT( OUT ) :: ErrStat ! returns a non-zero value when an error occurs + CHARACTER(*), INTENT( OUT ) :: ErrMsg ! Error message if ErrStat /= ErrID_None + + integer(IntKi) :: FmtWidth, TChanLen + integer(IntKi) :: i, Indx + integer(IntKi) :: errStat2 ! temporary error status of the operation + character(ErrMsgLen) :: errMsg2 ! temporary error message + character(*), parameter :: RoutineName = 'InitOutputFile' + + ErrStat = ErrID_None + ErrMsg = "" + + drvrData%OutData%n_Out = 0 + drvrData%OutData%OutFmt = "ES15.6E2" + CALL ChkRealFmtStr( drvrData%OutData%OutFmt, 'OutFmt', FmtWidth, ErrStat2, ErrMsg2 ) + !IF ( drvrData%WrTxtOutFile .and. FmtWidth < MinChanLen ) CALL SetErrStat( ErrID_Warn, 'OutFmt produces a column width of '// & + ! TRIM(Num2LStr(FmtWidth))//'), which may be too small.', ErrStat, ErrMsg, RoutineName ) + + if (drvrData%TMax < 1.0_DbKi) then ! log10(0) gives floating point divide-by-zero error + TChanLen = MinChanLen + else + TChanLen = max( MinChanLen, int(log10(drvrData%TMax))+7 ) + end if + drvrData%OutData%OutFmt_t = 'F'//trim(num2lstr( TChanLen ))//'.4' ! 'F10.4' + + + + drvrData%OutData%NumOutsMods = 0 + if (Allocated(InitOutData_SeaSt%WriteOutputHdr)) drvrData%OutData%NumOutsMods(1) = size(InitOutData_SeaSt%WriteOutputHdr) + if (Allocated(InitOutData_HD%WriteOutputHdr )) drvrData%OutData%NumOutsMods(2) = size(InitOutData_HD%WriteOutputHdr) + drvrData%OutData%NumOuts = sum(drvrData%OutData%NumOutsMods) + 1 ! add 1 for time channel + + call AllocAry(drvrData%OutData%WriteOutputHdr, drvrData%OutData%NumOuts, ' DriverWriteOutputHdr', ErrStat2, ErrMsg2); call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AllocAry(drvrData%OutData%WriteOutputUnt, drvrData%OutData%NumOuts, ' DriverWriteOutputUnt', ErrStat2, ErrMsg2); call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AllocAry(drvrData%OutData%Storage, drvrData%OutData%NumOuts-1, drvrData%NSteps, ' DriverWriteOutputStorage', ErrStat2, ErrMsg2); call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + IF (ErrStat >= AbortErrLev) RETURN + + ! Fill concatenated WriteOuput header and unit arrays: + drvrData%OutData%WriteOutputHdr(1) = 'Time' + drvrData%OutData%WriteOutputUnt(1) = '(s)' + Indx = 1 + do i=1,drvrData%OutData%NumOutsMods(1) + Indx = Indx + 1 + drvrData%OutData%WriteOutputHdr(Indx) = InitOutData_SeaSt%WriteOutputHdr(i) + drvrData%OutData%WriteOutputUnt(Indx) = InitOutData_SeaSt%WriteOutputUnt(i) + end do + + do i=1,drvrData%OutData%NumOutsMods(2) + Indx = Indx + 1 + drvrData%OutData%WriteOutputHdr(Indx) = InitOutData_HD%WriteOutputHdr(i) + drvrData%OutData%WriteOutputUnt(Indx) = InitOutData_HD%WriteOutputUnt(i) + end do + + ! get lines for output file: + drvrData%OutData%FileDescLines(1) = 'Predictions were generated on '//CurDate()//' at '//CurTime()//' using '//TRIM(GetVersion(version)) + drvrData%OutData%FileDescLines(2) = 'linked with ' //' '//TRIM(GetNVD(NWTC_Ver )) ! we'll get the rest of the linked modules in the section below + drvrData%OutData%FileDescLines(3) = 'Description from the driver input file: '//TRIM(drvrData%FTitle) + + + IF (drvrData%WrTxtOutFile) THEN + + call GetNewUnit(drvrData%OutData%unOutFile, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if ( ErrStat >= AbortErrLev ) then + drvrData%OutData%unOutFile = -1 + return + end if + + call OpenFOutFile ( drvrData%OutData%unOutFile, trim(drvrData%OutRootName)//'.out', ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if ( ErrStat >= AbortErrLev ) then + drvrData%OutData%unOutFile = -1 + return + end if + + ! Add some file information: + + WRITE (drvrData%OutData%unOutFile,'(/,A)') TRIM( drvrData%OutData%FileDescLines(1) ) + WRITE (drvrData%OutData%unOutFile,'(1X,A)') TRIM( drvrData%OutData%FileDescLines(2) ) + WRITE (drvrData%OutData%unOutFile,'()' ) !print a blank line + WRITE (drvrData%OutData%unOutFile,'(A)' ) TRIM( drvrData%OutData%FileDescLines(3) ) + WRITE (drvrData%OutData%unOutFile,'()' ) !print a blank line + + + !...................................................... + ! Write the names of the output parameters on one line: + !...................................................... + CALL WrFileNR ( drvrData%OutData%unOutFile, trim(drvrData%OutData%WriteOutputHdr(1)) ) + DO I=2,drvrData%OutData%NumOuts + CALL WrFileNR ( drvrData%OutData%unOutFile, Delim//trim(drvrData%OutData%WriteOutputHdr(I)) ) + ENDDO ! I + + WRITE (drvrData%OutData%unOutFile,'()') + + !...................................................... + ! Write the units of the output parameters on one line: + !...................................................... + CALL WrFileNR ( drvrData%OutData%unOutFile, trim(drvrData%OutData%WriteOutputUnt(1)) ) + DO I=2,drvrData%OutData%NumOuts + CALL WrFileNR ( drvrData%OutData%unOutFile, Delim//trim(drvrData%OutData%WriteOutputUnt(I)) ) + ENDDO ! I + + WRITE (drvrData%OutData%unOutFile,'()') + + END IF + + IF (drvrData%WrBinOutFile) THEN + drvrData%OutData%TimeData(1) = 0.0_DbKi ! This is the first output time, which we will set later + drvrData%OutData%TimeData(2) = drvrData%TimeInterval ! This is the (constant) time between subsequent writes to the output file + END IF + + +END SUBROUTINE InitOutputFile +!---------------------------------------------------------------------------------------------------------------------------------- +SUBROUTINE FillOutputFile(time, y_SeaSt, y_HD, drvrData, ErrStat, ErrMsg) + REAL(DbKi), INTENT( IN ) :: time + TYPE(SeaSt_OutputType), INTENT( IN ) :: y_SeaSt ! SeaState outputs + TYPE(HydroDyn_OutputType), INTENT( IN ) :: y_HD ! HydroDyn outputs + TYPE(HD_Drvr_Data), INTENT( INOUT ) :: drvrData + INTEGER, INTENT( OUT ) :: ErrStat ! returns a non-zero value when an error occurs + CHARACTER(*), INTENT( OUT ) :: ErrMsg ! Error message if ErrStat /= ErrID_None + + character(60) :: TmpStr + integer(IntKi) :: i, Indx + integer(IntKi) :: errStat2 ! temporary error status of the operation + character(ErrMsgLen) :: errMsg2 ! temporary error message + character(*), parameter :: RoutineName = 'FillOutputFile' + + ErrStat = ErrID_None + ErrMsg = "" + + IF ( drvrData%OutData%n_Out < drvrData%NSteps ) THEN + drvrData%OutData%n_Out = drvrData%OutData%n_Out + 1 + ELSE IF (drvrData%WrBinOutFile) THEN + ErrStat = ErrID_Warn + ErrMsg = 'Not all data could be written to the binary output file.' + END IF + + ! Fill data array with concatenated writeOutput data: + Indx = 0 + do i=1,drvrData%OutData%NumOutsMods(1) + Indx = Indx + 1 + drvrData%OutData%Storage(Indx, drvrData%OutData%n_Out) = y_SeaSt%WriteOutput(i) + end do + do i=1,drvrData%OutData%NumOutsMods(2) + Indx = Indx + 1 + drvrData%OutData%Storage(Indx, drvrData%OutData%n_Out) = y_HD%WriteOutput(i) + end do + + + IF (drvrData%WrTxtOutFile) THEN + ! Write one line of tabular output: + + ! time + WRITE( TmpStr, '('//trim(drvrData%OutData%OutFmt_t)//')' ) time + CALL WrFileNR( drvrData%OutData%unOutFile, trim(TmpStr) ) + + ! write the individual module output (convert to SiKi if necessary, so that we don't need to print so many digits in the exponent) + CALL WrNumAryFileNR ( drvrData%OutData%unOutFile, REAL(drvrData%OutData%Storage(:,drvrData%OutData%n_Out),SiKi), '"'//Delim//'"'//drvrData%OutData%OutFmt, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + ! write a new line (advance to the next line) + WRITE (drvrData%OutData%unOutFile,'()') + END IF + + + IF (drvrData%WrBinOutFile) THEN + ! store time data + IF ( drvrData%OutData%n_Out == 1_IntKi ) THEN + drvrData%OutData%TimeData(drvrData%OutData%n_Out) = time ! First time in the output file + END IF + END IF + + +END SUBROUTINE FillOutputFile +!---------------------------------------------------------------------------------------------------------------------------------- +SUBROUTINE WriteOutputFile(drvrData, ErrStat, ErrMsg) + TYPE(HD_Drvr_Data), INTENT( IN ) :: drvrData + INTEGER, INTENT( OUT ) :: ErrStat ! returns a non-zero value when an error occurs + CHARACTER(*), INTENT( OUT ) :: ErrMsg ! Error message if ErrStat /= ErrID_None + + ErrStat = ErrID_None + ErrMsg = "" + + IF (drvrData%WrTxtOutFile) THEN + IF (drvrData%OutData%unOutFile > 0) CLOSE(drvrData%OutData%unOutFile) + END IF + + IF (drvrData%WrBinOutFile .AND. drvrData%OutData%n_Out > 0) THEN + + CALL WrBinFAST(TRIM(drvrData%OutRootName)//'.outb', FileFmtID_ChanLen_In, TRIM(drvrData%OutData%FileDescLines(1))//' '//TRIM(drvrData%OutData%FileDescLines(2))//'; '//TRIM(drvrData%OutData%FileDescLines(3)), & + drvrData%OutData%WriteOutputHdr, drvrData%OutData%WriteOutputUnt, drvrData%OutData%TimeData, drvrData%OutData%Storage(:,1:drvrData%OutData%n_Out), ErrStat, ErrMsg) + + END IF + + +END SUBROUTINE WriteOutputFile +!---------------------------------------------------------------------------------------------------------------------------------- +SUBROUTINE SetHDInputs_Constant(u_HD, mappingData, drvrData, ErrStat, ErrMsg) + TYPE(HydroDyn_InputType), INTENT( INOUT ) :: u_HD ! HydroDyn inputs + TYPE(HD_Drvr_MappingData), INTENT( INOUT ) :: mappingData + TYPE(HD_Drvr_Data), INTENT( IN ) :: drvrData + + INTEGER, INTENT( OUT ) :: ErrStat ! returns a non-zero value when an error occurs + 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 + character(*), parameter :: RoutineName = 'SetHDInputs_Constant' + + ErrStat = ErrID_None + ErrMsg = "" + + IF (( drvrData%PRPInputsMod /= 2 ) .AND. ( drvrData%PRPInputsMod >= 0 )) THEN + + u_HD%PRPMesh%TranslationDisp(:,1) = drvrData%uPRPInSteady(1:3) + + ! Compute direction cosine matrix from the rotation angles + u_HD%PRPMesh%Orientation(:,:,1) = EulerConstructZYX(drvrData%uPRPInSteady(4:6)) + + ! Translation - No transformation needed + u_HD%PRPMesh%TranslationVel(:,1) = drvrData%uDotPRPInSteady(1:3) + u_HD%PRPMesh%TranslationAcc(:,1) = drvrData%uDotDotPRPInSteady(1:3) + ! Rotation - Compute angular velocity and acceleration from the rotation angles and time derivatives + call EulerDerivativeToAngVelAcc(drvrData%uPRPInSteady(4:6),& + REAL(drvrData%uDotPRPInSteady(4:6),ReKi),& + REAL(drvrData%uDotDotPRPInSteady(4:6),ReKi),& + u_HD%PRPMesh%RotationVel(:,1),& + u_HD%PRPMesh%RotationAcc(:,1)) + + CALL PRP_TransferToMotionInputs(u_HD, mappingData, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + END IF + +END SUBROUTINE SetHDInputs_Constant +!---------------------------------------------------------------------------------------------------------------------------------- +SUBROUTINE SetHDInputs(time, n, u_HD, mappingData, drvrData, ErrStat, ErrMsg) + REAL(DbKi), INTENT( IN ) :: time + INTEGER(IntKi), INTENT( IN ) :: n + TYPE(HydroDyn_InputType), INTENT( INOUT ) :: u_HD ! HydroDyn inputs + TYPE(HD_Drvr_MappingData), INTENT( INOUT ) :: mappingData + TYPE(HD_Drvr_Data), INTENT( IN ) :: drvrData + + INTEGER, INTENT( OUT ) :: ErrStat ! returns a non-zero value when an error occurs + CHARACTER(*), INTENT( OUT ) :: ErrMsg ! Error message if ErrStat /= ErrID_None + + REAL(ReKi) :: tmp(3),tmp2(3) + + integer(IntKi) :: errStat2 ! temporary error status of the operation + character(ErrMsgLen) :: errMsg2 ! temporary error message + character(*), parameter :: RoutineName = 'SetHDInputs' + real(R8Ki) :: yInterp(size(drvrData%PRPin,2)) + integer(intKi) :: indxHigh, indxMid, indxLow + integer(intKi) :: i + + ErrStat = ErrID_None + ErrMsg = "" + + ! PRPInputsMod 2: Reads time series of positions, velocities, and accelerations for the platform reference point + IF ( drvrData%PRPInputsMod == 2 ) THEN + call InterpStpMat( time, drvrData%PRPinTime, drvrData%PRPin, mappingData%Ind, size(drvrData%PRPinTime), yInterp ) + + u_HD%PRPMesh%TranslationDisp(:,1) = yInterp(1:3) + + ! Compute direction cosine matrix from the rotation angles + +! maxAngle = max( maxAngle, abs(yInterp(4:6)) ) + + ! Obtain the orientation matrix for the small rotation part from the reference yaw orientation + u_HD%PRPMesh%Orientation(:,:,1) = EulerConstructZYX(yInterp(4:6)) + + ! Translation - No transformation needed + u_HD%PRPMesh%TranslationVel(:,1) = yInterp( 7: 9) + u_HD%PRPMesh%TranslationAcc(:,1) = yInterp(13:15) + ! Rotation - Compute angular velocity and acceleration from the rotation angles and time derivatives + call EulerDerivativeToAngVelAcc(yInterp(4:6),& + REAL(yInterp(10:12),ReKi),& + REAL(yInterp(16:18),ReKi),& + u_HD%PRPMesh%RotationVel(:,1),& + u_HD%PRPMesh%RotationAcc(:,1)) + + CALL PRP_TransferToMotionInputs(u_HD, mappingData, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + ELSEIF ( drvrData%PRPInputsMod < 0 ) THEN + + !@mhall: new kinematics input for moving bodies individually + ! PRPInputsMod < 0: Reads time series of positions for each body individually, and uses finite differences to also get velocities and accelerations. + ! The number of bodies is the negative of PRPInputsMod. + + i = min(n,drvrData%NSteps) + if (n <= drvrData%NSteps .and. .not. EqualRealNos( time, drvrData%PRPinTime(i) ) ) then + call SetErrStat(ErrID_Fatal, 'time does not match PRP input file data', ErrStat, ErrMsg, RoutineName) + return + end if + + ! platform reference point (PRP), and body 1-NBody displacements + u_HD%PRPMesh%TranslationDisp(:,1) = drvrData%PRPin(n,1:3) + DO I=1,drvrData%NBody + u_HD%WAMITMesh%TranslationDisp(:,I) = drvrData%PRPin(n, 6*I+1:6*I+3) + END DO + + ! PRP and body 1-NBody orientations (skipping the maxAngle stuff) + u_HD%PRPMesh%Orientation(:,:,1) = EulerConstructZYX(drvrData%PRPin(n,4:6)) + + DO I=1, drvrData%NBody + u_HD%WAMITMesh%Orientation(:,:,I) = EulerConstructZYX(drvrData%PRPin(n,(6*I+4):(6*I+6))) + END DO + + ! use finite differences for velocities and accelerations + IF (n == 1) THEN ! use forward differences for first time step + indxHigh = n+2 + indxMid = n+1 + indxLow = n + + u_HD%PRPMesh%TranslationVel(:,1) = (drvrData%PRPin(indxMid , 1:3) - drvrData%PRPin(indxLow , 1:3))/drvrData%TimeInterval + u_HD%PRPMesh%RotationVel( :,1) = (drvrData%PRPin(indxMid , 4:6) - drvrData%PRPin(indxLow , 4:6))/drvrData%TimeInterval + + DO I=1,drvrData%NBody + u_HD%WAMITMesh%TranslationVel(:,I) = (drvrData%PRPin(indxMid, 6*I+1:6*I+3) - drvrData%PRPin(indxLow, 6*I+1:6*I+3))/drvrData%TimeInterval + u_HD%WAMITMesh%RotationVel( :,I) = (drvrData%PRPin(indxMid, 6*I+4:6*I+6) - drvrData%PRPin(indxLow, 6*I+4:6*I+6))/drvrData%TimeInterval + END DO + + ELSE IF (n >= drvrData%NSteps) THEN ! use backward differences for last time step + indxHigh = n + indxMid = n-1 + indxLow = n-2 + + u_HD%PRPMesh%TranslationVel(:,1) = (drvrData%PRPin(indxHigh, 1:3) - drvrData%PRPin(indxMid, 1:3))/drvrData%TimeInterval + u_HD%PRPMesh%RotationVel( :,1) = (drvrData%PRPin(indxHigh, 4:6) - drvrData%PRPin(indxMid, 4:6))/drvrData%TimeInterval + + DO I=1,drvrData%NBody + u_HD%WAMITMesh%TranslationVel(:,I) = (drvrData%PRPin(indxHigh, 6*I+1:6*I+3) - drvrData%PRPin(indxMid, 6*I+1:6*I+3))/drvrData%TimeInterval + u_HD%WAMITMesh%RotationVel( :,I) = (drvrData%PRPin(indxHigh, 6*I+4:6*I+6) - drvrData%PRPin(indxMid, 6*I+4:6*I+6))/drvrData%TimeInterval + END DO + + ELSE ! otherwise use central differences for intermediate time steps + indxHigh = n+1 + indxMid = n + indxLow = n -1 + + u_HD%PRPMesh%TranslationVel(:,1) = (drvrData%PRPin(indxHigh, 1:3) - drvrData%PRPin(indxLow, 1:3))*0.5/drvrData%TimeInterval + u_HD%PRPMesh%RotationVel( :,1) = (drvrData%PRPin(indxHigh, 4:6) - drvrData%PRPin(indxLow, 4:6))*0.5/drvrData%TimeInterval + + DO I=1,drvrData%NBody + u_HD%WAMITMesh%TranslationVel(:,I) = (drvrData%PRPin(indxHigh, 6*I+1:6*I+3) - drvrData%PRPin(indxLow, 6*I+1:6*I+3))*0.5/drvrData%TimeInterval + u_HD%WAMITMesh%RotationVel( :,I) = (drvrData%PRPin(indxHigh, 6*I+4:6*I+6) - drvrData%PRPin(indxLow, 6*I+4:6*I+6))*0.5/drvrData%TimeInterval + END DO + + END IF + + ! TO DO: Missing the first and last step below! + ! calculate accelerations based on displacements: + u_HD%PRPMesh%TranslationAcc(:,1) = (drvrData%PRPin(indxHigh, 1:3) - 2*drvrData%PRPin(indxMid, 1:3) + drvrData%PRPin(indxLow, 1:3)) /(drvrData%TimeInterval**2) + u_HD%PRPMesh%RotationAcc( :,1) = (drvrData%PRPin(indxHigh, 4:6) - 2*drvrData%PRPin(indxMid, 4:6) + drvrData%PRPin(indxLow, 4:6)) /(drvrData%TimeInterval**2) + + DO I=1,drvrData%NBody + u_HD%WAMITMesh%TranslationAcc(:,I) = (drvrData%PRPin(indxHigh, 6*I+1:6*I+3) - 2*drvrData%PRPin(indxMid, 6*I+1:6*I+3) + drvrData%PRPin(indxLow, 6*I+1:6*I+3))/(drvrData%TimeInterval**2) + u_HD%WAMITMesh%RotationAcc( :,I) = (drvrData%PRPin(indxHigh, 6*I+4:6*I+6) - 2*drvrData%PRPin(indxMid, 6*I+4:6*I+6) + drvrData%PRPin(indxLow, 6*I+4:6*I+6))/(drvrData%TimeInterval**2) + END DO + + ! Rotation - Compute angular velocity and acceleration from the rotation angles and time derivatives + call EulerDerivativeToAngVelAcc(drvrData%PRPin(n,4:6),& + u_HD%PRPMesh%RotationVel(:,1),& + u_HD%PRPMesh%RotationAcc(:,1),& + tmp,tmp2) + u_HD%PRPMesh%RotationVel(:,1) = tmp + u_HD%PRPMesh%RotationAcc(:,1) = tmp2 + + DO I=1,drvrData%NBody + call EulerDerivativeToAngVelAcc(drvrData%PRPin(n,(6*I+4):(6*I+6)),& + u_HD%WAMITMesh%RotationVel(:,I),& + u_HD%WAMITMesh%RotationAcc(:,I),& + tmp,tmp2) + u_HD%WAMITMesh%RotationVel(:,I) = tmp + u_HD%WAMITMesh%RotationAcc(:,I) = tmp2 + + END DO + + ! half of the PRP_TransferToMotionInputs routine: + IF ( u_HD%Morison%Mesh%Initialized ) THEN + ! Map kinematics to the WAMIT mesh with 1 to NBody nodes + CALL Transfer_Point_to_Point( u_HD%PRPMesh, u_HD%Morison%Mesh, mappingData%HD_Ref_2_M_P, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + END IF + + ELSE + ! constant inputs are not recalculated at each time step. Instead this is called at initialization + ! CALL SetHDInputs_Constant() + END IF + +END SUBROUTINE +!---------------------------------------------------------------------------------------------------------------------------------- +!> Compute Rigid body loads at the PRP, after a perturbation of the PRP +SUBROUTINE PRP_CalcOutput(t, u, p, x, xd, z, OtherState, y, m, EDRPtMotion, Loads, mappingData, ErrStat, ErrMsg) + TYPE(MeshType) , INTENT(INOUT) :: EDRPtMotion !< + REAL(DbKi), INTENT(IN ) :: t !< Current simulation time in seconds + TYPE(HydroDyn_InputType), INTENT(INOUT) :: u !< Inputs at Time (note that this is intent out because we're copying the u%WAMITMesh into m%u_wamit%mesh) + TYPE(HydroDyn_ParameterType), INTENT(IN ) :: p !< Parameters + TYPE(HydroDyn_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at Time + TYPE(HydroDyn_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at Time + TYPE(HydroDyn_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at Time + TYPE(HydroDyn_OtherStateType), INTENT(IN ) :: OtherState !< Other states at Time + TYPE(HydroDyn_OutputType), INTENT(INOUT) :: y !< Outputs computed at Time (Input only so that mesh con- + !! nectivity information does not have to be recalculated) + TYPE(HydroDyn_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 + + Real(ReKi) , INTENT(OUT) :: Loads(18) !< Loads at PRP and EDRP + TYPE(HD_Drvr_MappingData), INTENT(INOUT) :: mappingData + + INTEGER(IntKi) :: ErrStat2 ! Status of error message + CHARACTER(ErrMsgLen) :: ErrMsg2 ! Error message if ErrStat /= ErrID_None + CHARACTER(*), PARAMETER :: RoutineName = 'PRP_CalcOutput' + + ErrStat = ErrID_None + ErrMsg = "" + + call HydroDyn_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + ! Integrate all the mesh loads onto the platfrom reference Point (PRP) at (0,0,0) + Loads(1:6) = m%F_Hydro ! NOTE this is mapped to PRP using m%AllHdroOrigin + + ! --- Transfer loads from HydroOrigin to EDRPLoads + call Transfer_Point_to_Point( m%AllHdroOrigin, mappingData%EDRPt_Loads, mappingData%HD_RefLoads_2_ED_Ref, ErrStat2, ErrMsg2, u%PRPMesh, EDRPtMotion ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + Loads(7:9) = mappingData%EDRPt_Loads%Force(:,1) + Loads(10:12) = mappingData%EDRPt_Loads%Moment(:,1) + + ! --- Transfer loads from HydroOrigin to (0,0,0) + call Transfer_Point_to_Point( m%AllHdroOrigin, mappingData%ZZZPtMeshLoads, mappingData%HD_RefLoads_2_ZZZLoads, ErrStat2, ErrMsg2, u%PRPMesh, mappingData%ZZZPtMeshMotion ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + Loads(13:15) = mappingData%ZZZPtMeshLoads%Force(:,1) + Loads(16:18) = mappingData%ZZZPtMeshLoads%Moment(:,1) + + !print*,'LoadsPRP',Loads(1:6) + !print*,'LoadsEDP',Loads(7:12) + !print*,'Loads000',Loads(13:18) + +END SUBROUTINE PRP_CalcOutput +!---------------------------------------------------------------------------------------------------------------------------------- +!> Pertub the "PRP" inputs and trigger the rigid body motion on the other HydroDyn meshes +SUBROUTINE PRP_Perturb_u( n, perturb_sign, p, u, EDRPMotion, du, Motion_HDRP, mappingData, ErrStat, ErrMsg) + 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(HydroDyn_ParameterType), INTENT(IN ) :: p !< Parameters + TYPE(HydroDyn_InputType), target , INTENT(INOUT) :: u !< perturbed HD inputs + TYPE(MeshType) , target , INTENT(INOUT) :: EDRPMotion !< + REAL( R8Ki ) , INTENT( OUT) :: du !< amount that specific input was perturbed + logical , INTENT(IN ) :: Motion_HDRP !< If True, perturb the PRP otherwise perturb the EDRP for motion + TYPE(HD_Drvr_MappingData), INTENT(INOUT) :: mappingData + integer(IntKi) , intent( out) :: errStat ! Status of error message + character(*) , intent( out) :: errMsg ! Error message if ErrStat /= ErrID_None + + type(MeshType), pointer :: pointMesh !Alias + + ! local variables + integer :: fieldType ! 1=TranslationDisp, 2=Orientation, 3=TranslationVel etc. 6 + integer :: fieldIndx + integer :: fieldIndx6 + integer , parameter :: node =1 + Real(R8Ki) perturb_t, perturb +! REAL(R8Ki) :: dcm (3,3) ! The resulting transformation matrix from X to x, (-). +! Real(R8Ki) :: theta(3) + INTEGER(IntKi) :: ErrStat2 ! Status of error message + CHARACTER(ErrMsgLen) :: ErrMsg2 ! Error message if ErrStat /= ErrID_None + character(*), parameter :: RoutineName = 'PRP_Perturb_u' + + ErrStat = ErrID_None + ErrMsg = "" + + ! From "n" to: field type, axis, variable + fieldType = int((n-1)/3)+1 ! 1=TranslationDisp, 2=Orientation, 3=TranslationVel etc. 6 + fieldIndx = mod(n-1,3)+1 ! 1=x, 2=y 3=z (axis) + fieldIndx6= mod(n-1,6)+1 ! 1=x, 2=y 3=z 4=theta_x, 5=theta_y 6=theta_z (variable) + + ! Perturbation amplitude + perturb_t = 0.02_ReKi*D2R * max(p%WaveField%EffWtrDpth,1.0_ReKi) ! translation input scaling + perturb = 2*D2R ! rotational input scaling + !perturb_t = 1.0 + !perturb = 0.1 + if (fieldIndx6<=3) then + du = perturb_t ! TranslationDisp,TranslationVel, TranslationAcc + elseif (fieldIndx<=6) then !rotational fields + du = perturb ! Orientation, RotationVel, RotationAcc + else + call SetErrStat(ErrID_Fatal, 'Wrong field index', ErrStat, ErrMsg, RoutineName) + return + endif + + if (Motion_HDRP) then + pointMesh => u%PRPMesh + else + pointMesh => EDRPMotion + endif + + ! --- Perturbing the point mesh + !print*,'' + !print*,'Perturb',n, perturb_sign + SELECT CASE(fieldType) + CASE ( 1) !Module/Mesh/Field: u%PRPMesh%TranslationDisp = 1 + pointMesh%TranslationDisp (fieldIndx,node) = pointMesh%TranslationDisp (fieldIndx,node) + du * perturb_sign + CASE ( 2) !Module/Mesh/Field: u%PRPMesh%Orientation = 2 + CALL PerturbOrientationMatrix( pointMesh%Orientation(:,:,node), du * perturb_sign, fieldIndx, UseSmlAngle=.false. ) + CASE ( 3) !Module/Mesh/Field: u%PRPMesh%TranslationVel = 3 + pointMesh%TranslationVel( fieldIndx,node) = pointMesh%TranslationVel( fieldIndx,node) + du * perturb_sign + CASE ( 4) !Module/Mesh/Field: u%PRPMesh%RotationVel = 4 + pointMesh%RotationVel (fieldIndx,node) = pointMesh%RotationVel (fieldIndx,node) + du * perturb_sign + CASE ( 5) !Module/Mesh/Field: u%PRPMesh%TranslationAcc = 5 + pointMesh%TranslationAcc( fieldIndx,node) = pointMesh%TranslationAcc( fieldIndx,node) + du * perturb_sign + CASE ( 6) !Module/Mesh/Field: u%PRPMesh%RotationAcc = 6 + pointMesh%RotationAcc(fieldIndx,node) = pointMesh%RotationAcc(fieldIndx,node) + du * perturb_sign + CASE default + call SetErrStat(ErrID_Fatal, 'Wrong fieldType', ErrStat, ErrMsg, RoutineName) + END SELECT + + ! --- Trigger ED->PRP or PRP->ED + if (Motion_HDRP) then + ! PRP->ED + call Transfer_Point_to_Point( u%PRPMesh, EDRPMotion, mappingData%HD_Ref_2_ED_Ref, ErrStat2, ErrMsg2 ); + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + else + ! ED->PRP + call Transfer_Point_to_Point( EDRPMotion, u%PRPMesh, mappingData%ED_Ref_2_HD_Ref, ErrStat2, ErrMsg2 ); + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + !print*,'-------------------------------------------- EDRP -------------------------------------' + !call MeshPrintInfo (CU, EDRPMotion) + !print*,'' + !print*,'-------------------------------------------- PRP -------------------------------------' + !call MeshPrintInfo (CU, u%PRPMesh) + endif + + CALL PRP_TransferToMotionInputs(u, mappingData, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + +END SUBROUTINE PRP_Perturb_u +!---------------------------------------------------------------------------------------------------------------------------------- +SUBROUTINE PRP_TransferToMotionInputs(u, mappingData, ErrStat, ErrMsg) + TYPE(HydroDyn_InputType), target , INTENT(INOUT) :: u !< perturbed HD inputs + TYPE(HD_Drvr_MappingData), INTENT(INOUT) :: mappingData + integer(IntKi) , intent( out) :: errStat ! Status of error message + character(*) , intent( out) :: errMsg ! Error message if ErrStat /= ErrID_None + + ! local variables + INTEGER(IntKi) :: ErrStat2 ! Status of error message + CHARACTER(ErrMsgLen) :: ErrMsg2 ! Error message if ErrStat /= ErrID_None + character(*), parameter :: RoutineName = 'PRP_TransferToMotionInputs' + + ErrStat = ErrID_None + ErrMsg = "" + + + ! Map PRP kinematics to the WAMIT mesh with 1 to NBody nodes + IF ( u%WAMITMesh%Initialized ) THEN + CALL Transfer_Point_to_Point( u%PRPMesh, u%WAMITMesh, mappingData%HD_Ref_2_WB_P, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + END IF + + ! Map PRP kinematics to the Morison mesh + if ( u%Morison%Mesh%Initialized ) then + CALL Transfer_Point_to_Point( u%PRPMesh, u%Morison%Mesh, mappingData%HD_Ref_2_M_P, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end if + +END SUBROUTINE PRP_TransferToMotionInputs +!---------------------------------------------------------------------------------------------------------------------------------- +!> Calculate the partial derivative of the output functions (Y) with respect to the inputs (u) +SUBROUTINE PRP_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, dYdu, Motion_HDRP, mappingData, ErrStat, ErrMsg) + REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point + TYPE(HydroDyn_InputType), INTENT(INOUT) :: u !< Inputs at Time (note that this is intent out because we're copying the u%WAMITMesh into m%u_wamit%mesh) + TYPE(HydroDyn_ParameterType), INTENT(IN ) :: p !< Parameters + TYPE(HydroDyn_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at Time + TYPE(HydroDyn_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at Time + TYPE(HydroDyn_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at Time + TYPE(HydroDyn_OtherStateType), INTENT(IN ) :: OtherState !< Other states at Time + TYPE(HydroDyn_OutputType), INTENT(INOUT) :: y !< Outputs computed at Time (Input only so that mesh con- + !! nectivity information does not have to be recalculated) + TYPE(HydroDyn_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 + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdu(:,:) !< Partial derivatives of output functions (Y) with respect + logical, INTENT(IN ) :: Motion_HDRP !< If True, perturb the PRP otherwise perturb the EDRP for motion + TYPE(HD_Drvr_MappingData), INTENT(INOUT) :: mappingData + + ! local variables + TYPE(HydroDyn_OutputType) :: y_tmp + TYPE(HydroDyn_InputType) :: u_perturb + TYPE(MeshType) :: EDRPtMotion_perturb + Real(ReKi) :: Loads_p(18) + Real(ReKi) :: Loads_m(18) + REAL(R8Ki) :: delta ! delta change in input or state + integer(IntKi) :: i + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'PRP_JacobianPInput' + + ErrStat = ErrID_None + ErrMsg = '' + + ! allocate dYdu if necessary + if (.not. allocated(dYdu)) then + call AllocAry(dYdu, size(Loads_p), 18, 'dYdu', ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2, ErrStat,ErrMsg,RoutineName) + if (ErrStat >= AbortErrLev) return + + dYdu=0.0_ReKi + endif + + ! make a copy of the inputs to perturb + call HydroDyn_CopyInput( u, u_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2, ErrStat,ErrMsg,RoutineName) + call MeshCopy(mappingData%EDRPt_Motion, EDRPtMotion_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2, ErrStat,ErrMsg,RoutineName) + + ! make a copy of outputs because we will need two for the central difference computations (with orientations) + call HydroDyn_CopyOutput( y, y_tmp, MESH_NEWCOPY, ErrStat2, ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2, ErrStat,ErrMsg,RoutineName) + + if (ErrStat >= AbortErrLev) then + call cleanup() + return + end if + + do i=1,size(dYdu,2) + ! get u_op + delta u + call HydroDyn_CopyInput( u, u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2, ErrStat,ErrMsg,RoutineName) + call MeshCopy(mappingData%EDRPt_Motion, EDRPtMotion_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2, ErrStat,ErrMsg,RoutineName) + call PRP_Perturb_u(i, 1, p, u_perturb, EDRPtMotion_perturb, delta, Motion_HDRP, mappingData, ErrStat2, ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2, ErrStat,ErrMsg,RoutineName) + ! compute y at u_op + delta u + call PRP_CalcOutput( t, u_perturb, p, x, xd, z, OtherState, y_tmp, m, EDRPtMotion_perturb, Loads_p, mappingData, ErrStat2, ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2, ErrStat,ErrMsg,RoutineName) + + ! get u_op - delta u + call HydroDyn_CopyInput( u, u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2, ErrStat,ErrMsg,RoutineName) + call MeshCopy(mappingData%EDRPt_Motion, EDRPtMotion_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2, ErrStat,ErrMsg,RoutineName) + call PRP_Perturb_u( i, -1, p, u_perturb, EDRPtMotion_perturb, delta , Motion_HDRP, mappingData, ErrStat2, ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2, ErrStat,ErrMsg,RoutineName) + ! compute y at u_op - delta u + call PRP_CalcOutput( t, u_perturb, p, x, xd, z, OtherState, y_tmp, m, EDRPtMotion_perturb, Loads_m, mappingData, ErrStat2, ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2, ErrStat,ErrMsg,RoutineName) + + ! get central difference: + dYdu(:,i) = (Loads_p-Loads_m) / (2.0_R8Ki*delta) + end do + + call cleanup() + +contains + subroutine cleanup() + call HydroDyn_DestroyOutput( y_tmp, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2, ErrStat,ErrMsg,RoutineName) + call HydroDyn_DestroyInput ( u_perturb, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2, ErrStat,ErrMsg,RoutineName) + call MeshDestroy( EDRPtMotion_perturb, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2, ErrStat,ErrMsg,RoutineName) + end subroutine cleanup + +END SUBROUTINE PRP_JacobianPInput +!---------------------------------------------------------------------------------------------------------------------------------- +! --- Rigid body Linearization at t=0 +!---------------------------------------------------------------------------------------------------------------------------------- +SUBROUTINE Linearization(t, u, p, x, xd, z, OtherState, y, m, Motion_HDRP, mappingData, ErrStat, ErrMsg) + REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point + TYPE(HydroDyn_InputType), INTENT(INOUT) :: u !< Inputs at Time (note that this is intent out because we're copying the u%WAMITMesh into m%u_wamit%mesh) + TYPE(HydroDyn_ParameterType), INTENT(IN ) :: p !< Parameters + TYPE(HydroDyn_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at Time + TYPE(HydroDyn_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at Time + TYPE(HydroDyn_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at Time + TYPE(HydroDyn_OtherStateType), INTENT(IN ) :: OtherState !< Other states at Time + TYPE(HydroDyn_OutputType), INTENT(INOUT) :: y !< Outputs computed at Time (Input only so that mesh con- + !! nectivity information does not have to be recalculated) + TYPE(HydroDyn_MiscVarType), INTENT(INOUT) :: m !< Initial misc/optimization variables + logical , INTENT(IN ) :: Motion_HDRP !< If True, perturb the PRP otherwise perturb the EDRP for motion + TYPE(HD_Drvr_MappingData), INTENT(INOUT) :: mappingData + integer(IntKi) , intent( out) :: errStat ! Status of error message + character(*) , intent( out) :: errMsg ! Error message if ErrStat /= ErrID_None + + real(R8Ki), allocatable, dimension(:,:) :: dYdu + integer :: i,j + character(40) :: sMotion + CHARACTER(13) :: sTime + character(*), parameter :: Fmt = 'F18.5' + + + ErrStat = ErrID_None + ErrMsg = "" + + !print*,'>>>> Linearize', drvrData%PtfmRefzt + if (Motion_HDRP) then + sMotion ='motions at PRP' + else + sMotion ='motions at EDRP' + endif + + WRITE (sTime,'(F13.6)') t + + CALL WrScr( '') + CALL WrScr( 'Performing rigid-body linearization at t='//sTime//' s with '//trim(sMotion) ) + call PRP_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, dYdu, Motion_HDRP, mappingData, ErrStat, ErrMsg) + if (ErrStat >= AbortErrLev) then + call cleanup() + return + end if + + + do i=1,size(dYdu,1) + do j=1,size(dYdu,2) + if(abs(dYdu(i,j))<1e-5) then + dYdu(i,j)=0.0_ReKi + endif + enddo + enddo + + ! for some reason, printing to CU skips printing the first letter of the matrix name, so I added a blank before the matrix name: + CALL WrScr( '---------------------------------------------------------------------------------------') + call WrMatrix( dYdu( 1: 6, 1: 6), CU, Fmt, ' K (Loads at PRP, '//trim(sMotion)//')' ) ! HD F_Hydro loads; translation and rotation displacement + call WrMatrix( dYdu( 7:12, 1: 6), CU, Fmt, ' K (Loads at EDRP, '//trim(sMotion)//')' ) ! HD AllHdroOrigin loads transferred to EDRP; translation and rotation displacement + call WrMatrix( dYdu(13:18, 1: 6), CU, Fmt, ' K (Loads at 0,0,0, fixed, '//trim(sMotion)//')' ) ! HD AllHdroOrigin loads transferred to fixed 0,0,0 point; translation and rotation displacement + call WrMatrix( dYdu( 1: 6, 7:12), CU, Fmt, ' C' ) ! HD F_Hydro loads; translation and rotation velocity + call WrMatrix( dYdu( 1: 6, 13:18), CU, Fmt, ' M' ) ! HD F_Hydro loads; translation and rotation acceleration + CALL WrScr( '') + + call cleanup() + +contains + subroutine cleanup() + if (allocated(dYdu)) deallocate(dYdu) + end subroutine cleanup + +END SUBROUTINE LINEARIZATION + +SUBROUTINE EulerDerivativeToAngVelAcc(u,udot,uddot,AngVel,AngAcc) + REAL(DbKi), INTENT( IN ) :: u(3) ! Tait-Bryan angles following the ZYX convention + REAL(ReKi), INTENT( IN ) :: udot(3) ! First time derivatives of the Tait-Bryan angles + REAL(ReKi), INTENT( IN ) :: uddot(3) ! Second time derivatives of the Tait-Bryan angles + REAL(ReKi), INTENT( OUT ) :: AngVel(3) ! Angular velocity in the earth-fixed frame of reference + REAL(ReKi), INTENT( OUT ) :: AngAcc(3) ! Angular acceleration in the earth-fixed frame of reference + REAL(DbKi) :: R, P, Y + REAL(DbKi) :: cR, sR, cP, sP, cY, sY + REAL(DbKi) :: A(3,3) + REAL(ReKi) :: Rdot, Pdot, Ydot + + R = u(1) + P = u(2) + Y = u(3) + Rdot = udot(1) + Pdot = udot(2) + Ydot = udot(3) + cR = cos(R) + sR = sin(R) + cP = cos(P) + sP = sin(P) + cY = cos(Y) + sY = sin(Y) + A(1,:) = (/cP*cY, -sY, 0.0_DbKi/) + A(2,:) = (/cP*sY, cY, 0.0_DbKi/) + A(3,:) = (/ -sP, 0.0_DbKi, 1.0_DbKi/) + AngVel = matmul(A,udot) + AngAcc(1) = -Rdot*(Pdot*sP*cY+Ydot*cP*sY)-Pdot*Ydot*cY + AngAcc(2) = -Rdot*(Pdot*sP*sY-Ydot*cP*cY)-Pdot*Ydot*sY + AngAcc(3) = -Rdot*Pdot*cP + AngAcc = AngAcc + matmul(A,uddot) +END SUBROUTINE EulerDerivativeToAngVelAcc + +!---------------------------------------------------------------------------------------------------------------------------------- +END MODULE HydroDynDriverSubs + diff --git a/modules/hydrodyn/src/HydroDyn_Input.f90 b/modules/hydrodyn/src/HydroDyn_Input.f90 index 8c5cd4dab5..98d97dea82 100644 --- a/modules/hydrodyn/src/HydroDyn_Input.f90 +++ b/modules/hydrodyn/src/HydroDyn_Input.f90 @@ -24,113 +24,15 @@ MODULE HydroDyn_Input USE NWTC_Library USE HydroDyn_Types USE HydroDyn_Output - USE Waves - USE Waves2_Output + USE SeaState USE Morison USE Morison_Output USE NWTC_RandomNumber IMPLICIT NONE - PRIVATE :: CheckMeshOutput - CONTAINS -!==================================================================================================== -FUNCTION CheckMeshOutput( output, numMemberOut, MOutLst, numJointOut ) -! The routine -!---------------------------------------------------------------------------------------------------- -! - CHARACTER(ChanLen), INTENT ( IN ) :: output - INTEGER, INTENT ( IN ) :: numMemberOut - TYPE(Morison_MOutput), INTENT ( IN ) :: MOutLst(:) - INTEGER, INTENT ( IN ) :: numJointOut - !INTEGER, INTENT ( OUT ) :: ErrStat ! returns a non-zero value when an error occurs - !CHARACTER(*), INTENT ( OUT ) :: ErrMsg ! Error message if ErrStat /= ErrID_None - - LOGICAL :: CheckMeshOutput - - INTEGER :: ErrStat - CHARACTER(ChanLen) :: outputTmp - INTEGER :: indx1, indx2 - CHARACTER(4) :: testStr - outputTmp = TRIM(output) - - testStr = outputTmp(1:4) - CALL Conv2UC( testStr ) - - ! Reverse the sign (+/-) of the output channel if the user prefixed the - ! channel name with a '-', '_', 'm', or 'M' character indicating "minus". - - IF ( INDEX( '-_', outputTmp(1:1) ) > 0 ) THEN - - ! ex, '-TipDxc1' causes the sign of TipDxc1 to be switched. - outputTmp = outputTmp(2:) - testStr = outputTmp(1:4) - CALL Conv2UC( testStr ) - - ELSE IF ( INDEX( 'mM', outputTmp(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) - - IF ( ( INDEX( 'mM', outputTmp(2:2) ) > 0 ) .OR. ( INDEX( 'jJ', outputTmp(2:2) ) > 0 ) ) THEN - outputTmp = outputTmp(2:) - - END IF - - ELSE IF ( INDEX( 'jJ', outputTmp(1:1) ) == 0 .AND. ( testStr /= 'WAVE' ) ) THEN - ! Invalid output label because the label does not start: -M,-m,-J,-j,_M,_m,_J,_j,MM,mM,Mm,mm,MJ,mJ,Mj,mj, j,J,m,M - CheckMeshOutput = .FALSE. - RETURN - END IF - - IF (( INDEX( 'mM', outputTmp(1:1) ) > 0 ) .OR. ( INDEX( 'jJ', outputTmp(1:1) ) > 0 )) THEN - ! Read the second character, it should be a number from 1 to 9 - - READ( outputTmp(2:2), '(i1)', IOSTAT = ErrStat) indx1 - IF ( ErrStat /=0 ) THEN - ! Not a numerical digit!!! - CheckMeshOutput = .FALSE. - RETURN - END IF - - ! Examine members - IF ( INDEX( 'mM', outputTmp(1:1) ) > 0 ) THEN - IF ( indx1 > numMemberOut ) THEN - CheckMeshOutput = .FALSE. - RETURN - END IF - ! Now make sure the next letter is n or N and then look for the second index - IF ( INDEX( 'nN', outputTmp(3:3) ) == 0 ) THEN - ! Invalid member label - CheckMeshOutput = .FALSE. - RETURN - END IF - READ( outputTmp(4:4), '(i1)', IOSTAT = ErrStat) indx2 - IF ( indx2 > MOutLst(indx1)%NOutLoc ) THEN - CheckMeshOutput = .FALSE. - RETURN - END IF - - - END IF - - IF ( INDEX( 'jJ', outputTmp(1:1) ) > 0 ) THEN - IF ( indx1 > numJointOut ) THEN - CheckMeshOutput = .FALSE. - RETURN - END IF - END IF - ELSE - ! This should be a wave elevation channel - READ( outputTmp(5:5), '(i1)', IOSTAT = ErrStat) indx1 - IF ( ErrStat /=0 ) THEN - ! Not a numerical digit!!! - CheckMeshOutput = .FALSE. - RETURN - END IF - END IF - - CheckMeshOutput = .TRUE. -END FUNCTION CheckMeshOutput !==================================================================================================== SUBROUTINE PrintBadChannelWarning(NUserOutputs, UserOutputs , foundMask, ErrStat, ErrMsg ) @@ -160,7 +62,7 @@ END SUBROUTINE PrintBadChannelWarning !==================================================================================================== -SUBROUTINE HydroDyn_ParseInput( InputFileName, OutRootName, defWtrDens, defWtrDpth, defMSL2SWL, FileInfo_In, InputFileData, ErrStat, ErrMsg ) +SUBROUTINE HydroDyn_ParseInput( InputFileName, OutRootName, FileInfo_In, InputFileData, ErrStat, ErrMsg ) ! This public subroutine reads the input required for HydroDyn from the file whose name is an ! input parameter. !---------------------------------------------------------------------------------------------------- @@ -168,9 +70,6 @@ SUBROUTINE HydroDyn_ParseInput( InputFileName, OutRootName, defWtrDens, defWtrDp ! Passed variables CHARACTER(*), intent(in ) :: InputFileName !< The name of the input file, for putting in echo file. CHARACTER(*), intent(in ) :: OutRootName !< The rootname of the echo file, possibly opened in this routine - real(ReKi), intent(in ) :: defWtrDens !< default value for water density - real(ReKi), intent(in ) :: defWtrDpth !< default value for water depth - real(ReKi), intent(in ) :: defMSL2SWL !< default value for mean sea level to still water level TYPE(FileInfoType), INTENT(IN ) :: FileInfo_In !< The derived type for holding the file information TYPE(HydroDyn_InputFile), INTENT(INOUT) :: InputFileData ! the hydrodyn input file data INTEGER, INTENT( OUT) :: ErrStat ! returns a non-zero value when an error occurs @@ -181,16 +80,16 @@ SUBROUTINE HydroDyn_ParseInput( InputFileName, OutRootName, defWtrDens, defWtrDp CHARACTER( 2) :: strI ! string version of the loop counter INTEGER :: UnEc ! The local unit number for this module's echo file CHARACTER(1024) :: EchoFile ! Name of HydroDyn echo file - CHARACTER(1024) :: Line ! String to temporarially hold value of read line + CHARACTER(MaxFileInfoLineLen) :: Line ! String to temporarially hold value of read line real(ReKi), ALLOCATABLE :: tmpVec1(:), tmpVec2(:) ! Temporary arrays for WAMIT data integer(IntKi) :: startIndx, endIndx ! indices into working arrays INTEGER, ALLOCATABLE :: tmpArray(:) ! Temporary array storage of the joint output list REAL(ReKi), ALLOCATABLE :: tmpReArray(:) ! Temporary array storage of the joint output list - CHARACTER(1) :: Line1 ! The first character of an input line INTEGER(IntKi) :: CurLine !< Current entry in FileInfo_In%Lines array INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_ParaseInput' + ! Initialize local data UnEc = -1 @@ -208,7 +107,7 @@ SUBROUTINE HydroDyn_ParseInput( InputFileName, OutRootName, defWtrDens, defWtrDp if (Failed()) return; if ( InputFileData%Echo ) then - EchoFile = TRIM(OutRootName)//'.HD.ech' + EchoFile = TRIM(OutRootName)//'.ech' CALL OpenEcho ( UnEc, TRIM(EchoFile), ErrStat2, ErrMsg2 ) if (Failed()) return; WRITE(UnEc, '(A)') 'Echo file for AeroDyn 15 primary input file: '//trim(InputFileName) @@ -221,262 +120,47 @@ SUBROUTINE HydroDyn_ParseInput( InputFileName, OutRootName, defWtrDens, defWtrDp if (Failed()) return endif - - !------------------------------------------------------------------------------------------------- - ! Environmental conditions section - !------------------------------------------------------------------------------------------------- - if ( InputFileData%Echo ) WRITE(UnEc, '(A)') trim(FileInfo_In%Lines(CurLine)) ! Write section break to echo - CurLine = CurLine + 1 - - ! WtrDens - Water density. - CALL ParseVarWDefault ( FileInfo_In, CurLine, 'WtrDens', InputFileData%Waves%WtrDens, real(defWtrDens,SiKi), ErrStat2, ErrMsg2, UnEc ) - if (Failed()) return; - - ! WtrDpth - Water depth - CALL ParseVarWDefault ( FileInfo_In, CurLine, 'WtrDpth', InputFileData%Morison%WtrDpth, defWtrDpth, ErrStat2, ErrMsg2, UnEc ) - if (Failed()) return; - - ! MSL2SWL - CALL ParseVarWDefault ( FileInfo_In, CurLine, 'MSL2SWL', InputFileData%Morison%MSL2SWL, defMSL2SWL, ErrStat2, ErrMsg2, UnEc ) - if (Failed()) return; - - !------------------------------------------------------------------------------------------------- - ! Data section for waves + ! Data section for floating platform !------------------------------------------------------------------------------------------------- if ( InputFileData%Echo ) WRITE(UnEc, '(A)') trim(FileInfo_In%Lines(CurLine)) ! Write section break to echo CurLine = CurLine + 1 - ! WaveMod - Wave kinematics model switch. - call ParseVar( FileInfo_In, CurLine, 'WaveMod', InputFileData%Waves%WaveModChr, ErrStat2, ErrMsg2, UnEc ) - if (Failed()) return; - - CALL Conv2UC( InputFileData%Waves%WaveModChr ) ! Convert Line to upper case. - - InputFileData%Waves%WavePhase = 0.0 - InputFileData%Waves%WaveNDAmp = .FALSE. - - - ! WaveStMod - Model switch for stretching incident wave kinematics to instantaneous free surface. - call ParseVar( FileInfo_In, CurLine, 'WaveStMod', InputFileData%Waves%WaveStMod, ErrStat2, ErrMsg2, UnEc ) - if (Failed()) return; - - ! WaveTMax - Analysis time for incident wave calculations. - call ParseVar( FileInfo_In, CurLine, 'WaveTMax', InputFileData%Waves%WaveTMax, ErrStat2, ErrMsg2, UnEc ) - if (Failed()) return; - - ! WaveDT - Time step for incident wave calculations - call ParseVar( FileInfo_In, CurLine, 'WaveDT', InputFileData%Waves%WaveDT, ErrStat2, ErrMsg2, UnEc ) - if (Failed()) return; - - ! WaveHs - Significant wave height - call ParseVar( FileInfo_In, CurLine, 'WaveHs', InputFileData%Waves%WaveHs, ErrStat2, ErrMsg2, UnEc ) - if (Failed()) return; - - ! WaveTp - Peak spectral period. - call ParseVar( FileInfo_In, CurLine, 'WaveTp', InputFileData%Waves%WaveTp, ErrStat2, ErrMsg2, UnEc ) - if (Failed()) return; - - ! WavePkShp - Peak shape parameter. - call ParseVar( FileInfo_In, CurLine, 'WavePkShp', InputFileData%Waves%WavePkShpChr, ErrStat2, ErrMsg2, UnEc ) - if (Failed()) return; - - ! WvLowCOff - Low Cut-off frequency or lower frequency limit of the wave spectrum beyond which the wave spectrum is zeroed (rad/s). - call ParseVar( FileInfo_In, CurLine, 'WvLowCOff', InputFileData%Waves%WvLowCOff, ErrStat2, ErrMsg2, UnEc ) - if (Failed()) return; - - ! WvHiCOff - High Cut-off frequency or upper frequency limit of the wave spectrum beyond which the wave spectrum is zeroed (rad/s). - call ParseVar( FileInfo_In, CurLine, 'WvHiCOff', InputFileData%Waves%WvHiCOff, ErrStat2, ErrMsg2, UnEc ) - if (Failed()) return; - - ! WaveDir - Mean wave heading direction. - call ParseVar( FileInfo_In, CurLine, 'WaveDir', InputFileData%Waves%WaveDir, ErrStat2, ErrMsg2, UnEc ) - if (Failed()) return; - - ! WaveDirMod - Directional spreading function {0: None, 1: COS2S} (-) [Used only if WaveMod=2] - call ParseVar( FileInfo_In, CurLine, 'WaveDirMod', InputFileData%Waves%WaveDirMod, ErrStat2, ErrMsg2, UnEc ) - if (Failed()) return; - - ! WaveDirSpread - Spreading coefficient [only used if WaveMod=2 and WaveDirMod=1] - call ParseVar( FileInfo_In, CurLine, 'WaveDirSpread', InputFileData%Waves%WaveDirSpread, ErrStat2, ErrMsg2, UnEc ) - if (Failed()) return; - - ! WaveNDir - The number of wave directions to calculate [must be odd; only used if WaveDirMod=1] - call ParseVar( FileInfo_In, CurLine, 'WaveNDir', InputFileData%Waves%WaveNDir, ErrStat2, ErrMsg2, UnEc ) - if (Failed()) return; - - ! WaveDirRange - Full range of the wave directions from WaveDir - WaveDirRange/2 to WaveDir + WaveDirRange/2 (only used if WaveMod=2 and WaveDirMod=1) - call ParseVar( FileInfo_In, CurLine, 'WaveDirRange', InputFileData%Waves%WaveDirRange, ErrStat2, ErrMsg2, UnEc ) - if (Failed()) return; - - ! Negative values should be treated as positive. - InputFileData%Waves%WaveDirRange = ABS( InputFileData%Waves%WaveDirRange ) - - - ! WaveSeed(1) - call ParseVar( FileInfo_In, CurLine, 'WaveSeed(1)', InputFileData%Waves%WaveSeed(1), ErrStat2, ErrMsg2, UnEc ) - if (Failed()) return; - InputFileData%Waves%RNG%RandSeed(1) = InputFileData%Waves%WaveSeed(1) - - !WaveSeed(2) - call ParseVar( FileInfo_In, CurLine, 'WaveSeed(2)', Line, ErrStat2, ErrMsg2, UnEc ) ! Read into a string and then parse - if (Failed()) return; - - 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 - ErrStat2 = ErrID_Fatal - ErrMsg2 = ' WaveSeed(2): Invalid RNG type.' - if (Failed()) return; - ENDIF - -!FIXME: there is something a little strange here. RandSeed(2) is an integer, but what if we get an error on the next read? - READ (Line,*,IOSTAT=ErrStat2) InputFileData%Waves%WaveSeed(2) - InputFileData%Waves%RNG%RandSeed(2) = InputFileData%Waves%WaveSeed(2) - - IF (ErrStat2 == 0) THEN ! the user entered a number - InputFileData%Waves%RNG%RNG_type = "NORMAL" - InputFileData%Waves%RNG%pRNG = pRNG_INTRINSIC - - ELSE - - InputFileData%Waves%RNG%RNG_type = ADJUSTL( Line ) - CALL Conv2UC( InputFileData%Waves%RNG%RNG_type ) - - IF ( InputFileData%Waves%RNG%RNG_type == "RANLUX") THEN - InputFileData%Waves%RNG%pRNG = pRNG_RANLUX - ELSE - ErrStat2 = ErrID_Fatal - ErrMsg2 = ' WaveSeed(2): Invalid alternative random number generator.' - if (Failed()) return; - ENDIF - - ENDIF - - - ! WaveNDAmp - Flag for normally distributed amplitudes. - call ParseVar( FileInfo_In, CurLine, 'WaveNDAmp', InputFileData%Waves%WaveNDAmp, ErrStat2, ErrMsg2, UnEc ) - if (Failed()) return; - - ! WvKinFile - call ParseVar( FileInfo_In, CurLine, 'WvKinFile', InputFileData%Waves%WvKinFile, ErrStat2, ErrMsg2, UnEc, IsPath=.true. ) + ! PotMod - State indicating potential flow model used in the simulation. 0=none, 1=WAMIT, 2=FIT + call ParseVar( FileInfo_In, CurLine, 'PotMod', InputFileData%PotMod, ErrStat2, ErrMsg2, UnEc ) if (Failed()) return; - ! NWaveElev - call ParseVar( FileInfo_In, CurLine, 'NWaveElev', InputFileData%Waves%NWaveElev, ErrStat2, ErrMsg2, UnEc ) + ! ExctnMod - Wave Excitation model {0: None, 1: DFT, 2: state-space} (switch) + ! [STATE-SPACE REQUIRES *.ssexctn INPUT FILE] + call ParseVar( FileInfo_In, CurLine, 'ExctnMod', InputFileData%WAMIT%ExctnMod, ErrStat2, ErrMsg2, UnEc ) if (Failed()) return; - ! This check is needed here instead of being located in HydroDynInput_ProcessInputData() because - ! we need to allocate arrays. If _GetInput() was skipped, then these array would already have - ! been allocated and populated. - - IF ( InputFileData%Waves%NWaveElev < 0 .OR. InputFileData%Waves%NWaveElev > 9 ) THEN - ErrStat2 = ErrID_Fatal - ErrMsg2 = 'NWaveElev must be greater than or equal to zero and less than 10.' + ! ExctnDisp - Use body displacements to compute Wave Excitations {0: use undisplaced position, 1: use displaced position, 2: use low-pass filtered displaced position) [only used when PotMod=1 and ExctnMod>0]} (switch) + call ParseVar( FileInfo_In, CurLine, 'ExctnDisp', InputFileData%WAMIT%ExctnDisp, ErrStat2, ErrMsg2, UnEc ) if (Failed()) return; - END IF - - ! allocate space for the output location arrays: - CALL AllocAry( InputFileData%Waves%WaveElevxi, InputFileData%Waves%NWaveElev, 'WaveElevxi' , ErrStat2, ErrMsg2); if (Failed()) return; - CALL AllocAry( InputFileData%Waves%WaveElevyi, InputFileData%Waves%NWaveElev, 'WaveElevyi' , ErrStat2, ErrMsg2); if (Failed()) return; - ! WaveElevxi - call ParseAry ( FileInfo_In, CurLine, 'WaveElevxi.', InputFileData%Waves%WaveElevxi, InputFileData%Waves%NWaveElev, ErrStat2, ErrMsg2, UnEc ) - if (Failed()) return; - - ! WaveElevyi - call ParseAry ( FileInfo_In, CurLine, 'WaveElevyi.', InputFileData%Waves%WaveElevyi, InputFileData%Waves%NWaveElev, ErrStat2, ErrMsg2, UnEc ) - if (Failed()) return; - - - !------------------------------------------------------------------------------------------------- - ! Data section for 2nd Order Waves - !------------------------------------------------------------------------------------------------- - if ( InputFileData%Echo ) WRITE(UnEc, '(A)') trim(FileInfo_In%Lines(CurLine)) ! Write section break to echo - CurLine = CurLine + 1 - - ! WvDiffQTFF - Second order waves -- difference forces - call ParseVar( FileInfo_In, CurLine, 'WvDiffQTF', InputFileData%Waves2%WvDiffQTFF, ErrStat2, ErrMsg2, UnEc ) - if (Failed()) return; - - ! WvSumQTFF - Second order waves -- sum forces - call ParseVar( FileInfo_In, CurLine, 'WvSumQTF', InputFileData%Waves2%WvSumQTFF, ErrStat2, ErrMsg2, UnEc ) - if (Failed()) return; - - ! WvLowCOffD -- Minimum frequency used in the difference methods (rad/s) [Only used if DiffQTF /= 0] - call ParseVar( FileInfo_In, CurLine, 'WvLowCOffD', InputFileData%Waves2%WvLowCOffD, ErrStat2, ErrMsg2, UnEc ) - if (Failed()) return; - - ! WvHiCOffD -- Maximum frequency used in the difference methods (rad/s) [Only used if DiffQTF /= 0] - call ParseVar( FileInfo_In, CurLine, 'WvHiCOffD', InputFileData%Waves2%WvHiCOffD, ErrStat2, ErrMsg2, UnEc ) - if (Failed()) return; - - ! WvLowCOffS -- Minimum frequency used in the sum-QTF (rad/s) [Only used if SumQTF /= 0] - call ParseVar( FileInfo_In, CurLine, 'WvLowCOffS', InputFileData%Waves2%WvLowCOffS, ErrStat2, ErrMsg2, UnEc ) - if (Failed()) return; - - ! WvHiCOffS -- Maximum frequency used in the sum-QTF (rad/s) [Only used if SumQTF /= 0] - call ParseVar( FileInfo_In, CurLine, 'WvHiCOffS', InputFileData%Waves2%WvHiCOffS, ErrStat2, ErrMsg2, UnEc ) - if (Failed()) return; - - - !------------------------------------------------------------------------------------------------- - ! Data section for current - !------------------------------------------------------------------------------------------------- - if ( InputFileData%Echo ) WRITE(UnEc, '(A)') trim(FileInfo_In%Lines(CurLine)) ! Write section break to echo - CurLine = CurLine + 1 - - ! CurrMod - Current profile model switch - call ParseVar( FileInfo_In, CurLine, 'CurrMod', InputFileData%Current%CurrMod, ErrStat2, ErrMsg2, UnEc ) - if (Failed()) return; - - ! CurrSSV0 - Sub-surface current velocity at still water level - call ParseVar( FileInfo_In, CurLine, 'CurrSSV0', InputFileData%Current%CurrSSV0, ErrStat2, ErrMsg2, UnEc ) - if (Failed()) return; - - - ! CurrSSDirChr - Sub-surface current heading direction - call ParseVar( FileInfo_In, CurLine, 'CurrSSDir', InputFileData%Current%CurrSSDirChr, ErrStat2, ErrMsg2, UnEc ) - if (Failed()) return; - - CALL Conv2UC( InputFileData%Current%CurrSSDirChr ) ! Convert Line to upper case. - - - ! CurrNSRef - Near-surface current reference depth. - call ParseVar( FileInfo_In, CurLine, 'CurrNSRef', InputFileData%Current%CurrNSRef, ErrStat2, ErrMsg2, UnEc ) - if (Failed()) return; - - ! CurrNSV0 - Near-surface current velocity at still water level. - call ParseVar( FileInfo_In, CurLine, 'CurrNSV0', InputFileData%Current%CurrNSV0, ErrStat2, ErrMsg2, UnEc ) - if (Failed()) return; - - ! CurrNSDir - Near-surface current heading direction. - call ParseVar( FileInfo_In, CurLine, 'CurrNSDir', InputFileData%Current%CurrNSDir, ErrStat2, ErrMsg2, UnEc ) - if (Failed()) return; - - ! CurrDIV - Depth-independent current velocity. - call ParseVar( FileInfo_In, CurLine, 'CurrDIV', InputFileData%Current%CurrDIV, ErrStat2, ErrMsg2, UnEc ) - if (Failed()) return; - - ! CurrDIDir - Depth-independent current heading direction. - call ParseVar( FileInfo_In, CurLine, 'CurrDIDir', InputFileData%Current%CurrDIDir, ErrStat2, ErrMsg2, UnEc ) + ! ExctnCutOff - Cutoff (corner) frequency of the low-pass time-filtered displaced position (Hz) [>0.0] [used only when PotMod=1, ExctnMod>0, and ExctnDisp=2]) + ! [STATE-SPACE REQUIRES *.ssexctn INPUT FILE] + call ParseVar( FileInfo_In, CurLine, 'ExctnCutOff', InputFileData%WAMIT%ExctnCutOff, ErrStat2, ErrMsg2, UnEc ) if (Failed()) return; + ! PtfmYMod - Model for large platform yaw offset {0: Static reference yaw offset based on PtfmRefY, 1: dynamic reference yaw offset based on low-pass filtering the PRP yaw motion with cutoff frequency PtfmYCutOff} (switch) + call ParseVar( FileInfo_In, CurLine, 'PtfmYMod', InputFileData%PtfmYMod, ErrStat2, ErrMsg2, UnEc ) + if (Failed()) return - !------------------------------------------------------------------------------------------------- - ! Data section for floating platform - !------------------------------------------------------------------------------------------------- - if ( InputFileData%Echo ) WRITE(UnEc, '(A)') trim(FileInfo_In%Lines(CurLine)) ! Write section break to echo - CurLine = CurLine + 1 + ! PtfmRefY - Constant or initial platform reference yaw offset (deg) + call ParseVar( FileInfo_In, CurLine, 'PtfmRefY', InputFileData%PtfmRefY, ErrStat2, ErrMsg2, UnEc ) + if (Failed()) return + InputFileData%PtfmRefY = InputFileData%PtfmRefY * D2R - ! PotMod - State indicating potential flow model used in the simulation. 0=none, 1=WAMIT, 2=FIT - call ParseVar( FileInfo_In, CurLine, 'PotMod', InputFileData%PotMod, ErrStat2, ErrMsg2, UnEc ) - if (Failed()) return; + ! PtfmYCutOff - Cutoff frequency for the low-pass filtering of PRP yaw motion when PtfmYMod=1 [unused when PtfmYMod=0] (Hz) + call ParseVar( FileInfo_In, CurLine, 'PtfmYCutOff', InputFileData%PtfmYCutOff, ErrStat2, ErrMsg2, UnEc ) + if (Failed()) return - ! ExctnMod - Wave Excitation model {0: None, 1: DFT, 2: state-space} (switch) - ! [STATE-SPACE REQUIRES *.ssexctn INPUT FILE] - call ParseVar( FileInfo_In, CurLine, 'ExctnMod', InputFileData%WAMIT%ExctnMod, ErrStat2, ErrMsg2, UnEc ) + ! NExctnHdg - Number of PRP headings/yaw offset evenly distributed in the range of [-180, 180) deg to precompute [used only when PtfmYMod = 1] + call ParseVar( FileInfo_In, CurLine, 'NExctnHdg', InputFileData%WAMIT%NExctnHdg, ErrStat2, ErrMsg2, UnEc ) if (Failed()) return; + InputFileData%WAMIT2%NExctnHdg = InputFileData%WAMIT%NExctnHdg ! RdtnMod - Radiation memory-effect model {1: convolution, 2: state-space} (switch) ! [STATE-SPACE REQUIRES *.ss INPUT FILE] @@ -562,16 +246,6 @@ SUBROUTINE HydroDyn_ParseInput( InputFileName, OutRootName, defWtrDens, defWtrDp if (Failed()) return; -!bjj: should we add this? -!test for numerical stability -! IF ( FP_InitData%RdtnDT <= FP_InitData%RdtnTMax*EPSILON(FP_InitData%RdtnDT) ) THEN ! Test RdtnDT and RdtnTMax to ensure numerical stability -- HINT: see the use of OnePlusEps." -! ErrStat = ErrID_Fatal -! ErrMsg2 = ' RdtnDT must be greater than '//TRIM ( Num2LStr( RdtnTMax*EPSILON(RdtnDT) ) )//' seconds.' -! if (Failed()) return; -! END IF - - - !------------------------------------------------------------------------------------------------- ! Data section for 2nd order WAMIT forces !------------------------------------------------------------------------------------------------- @@ -665,6 +339,19 @@ SUBROUTINE HydroDyn_ParseInput( InputFileName, OutRootName, defWtrDens, defWtrDp end do END DO + !------------------------------------------------------------------------------------------------- + ! Strip Theory Section + !------------------------------------------------------------------------------------------------- + if ( InputFileData%Echo ) WRITE(UnEc, '(A)') trim(FileInfo_In%Lines(CurLine)) ! Write section break to echo + CurLine = CurLine + 1 + + ! WaveDisp - Method of computing Wave Kinematics {0: use undisplaced position, 1: use displaced position) } (switch) + call ParseVar( FileInfo_In, CurLine, 'WaveDisp', InputFileData%Morison%WaveDisp, ErrStat2, ErrMsg2, UnEc ) + if (Failed()) return; + + ! AMMod - Method of computing distributed added-mass force. {0: nodes below SWL when undisplaced. 1: Up to the free surface} (switch) + call ParseVar( FileInfo_In, CurLine, 'AMMod', InputFileData%Morison%AMMod, ErrStat2, ErrMsg2, UnEc ) + if (Failed()) return; !------------------------------------------------------------------------------------------------- ! Axial Coefficients Section @@ -683,7 +370,7 @@ SUBROUTINE HydroDyn_ParseInput( InputFileName, OutRootName, defWtrDens, defWtrDp CurLine = CurLine + 1 IF ( InputFileData%Morison%NAxCoefs > 0 ) THEN - CALL AllocAry( tmpReArray, 4, 'temporary array for AxialCoefs', ErrStat2, ErrMsg2 ) + CALL AllocAry( tmpReArray, 7, 'temporary array for AxialCoefs', ErrStat2, ErrMsg2 ) if (Failed()) return; ! Allocate memory for Axial Coef-related arrays @@ -695,13 +382,26 @@ SUBROUTINE HydroDyn_ParseInput( InputFileName, OutRootName, defWtrDens, defWtrDp END IF DO I = 1,InputFileData%Morison%NAxCoefs - ! read the table entries AxCoefID CdAx CaAx in the HydroDyn input file + ! read the table entries AxCoefID, AxCd, AxCa, AxCp, AxFdMod, AxVnCOff, AxFDLoFSc in the HydroDyn input file + ! Try reading in 7 entries first call ParseAry( FileInfo_In, CurLine, ' axial coefficients line '//trim( Int2LStr(I)), tmpReArray, size(tmpReArray), ErrStat2, ErrMsg2, UnEc ) - if (Failed()) return; + if ( ErrStat2 /= ErrID_None ) then ! Try reading in 5 entries + tmpReArray(6) = -1.0 ! AxVnCoff + tmpReArray(7) = 1.0 ! AxFDLoFSc + call ParseAry( FileInfo_In, CurLine, ' axial coefficients line '//trim( Int2LStr(I)), tmpReArray(1:5), 5, ErrStat2, ErrMsg2, UnEc ) + if ( ErrStat2 /= ErrID_None ) then ! Try reading in 4 entries + tmpReArray(5) = 0.0 ! AxFdMod + call ParseAry( FileInfo_In, CurLine, ' axial coefficients line '//trim( Int2LStr(I)), tmpReArray(1:4), 4, ErrStat2, ErrMsg2, UnEc ) + if (Failed()) return; + end if + end if InputFileData%Morison%AxialCoefs(I)%AxCoefID = NINT(tmpReArray(1)) InputFileData%Morison%AxialCoefs(I)%AxCd = tmpReArray(2) InputFileData%Morison%AxialCoefs(I)%AxCa = tmpReArray(3) InputFileData%Morison%AxialCoefs(I)%AxCp = tmpReArray(4) + InputFileData%Morison%AxialCoefs(I)%AxFDMod = NINT(tmpReArray(5)) + InputFileData%Morison%AxialCoefs(I)%AxVnCOff = tmpReArray(6) + InputFileData%Morison%AxialCoefs(I)%AxFDLoFSc = tmpReArray(7) END DO if (allocated(tmpReArray)) deallocate(tmpReArray) @@ -805,10 +505,14 @@ SUBROUTINE HydroDyn_ParseInput( InputFileName, OutRootName, defWtrDens, defWtrDp if ( InputFileData%Echo ) WRITE(UnEc, '(A)') 'Simple hydrodynamic coefficients table header line 2: '//NewLine//trim(FileInfo_In%Lines(CurLine)) CurLine = CurLine + 1 - CALL AllocAry( tmpReArray, 12, 'temporary array for Simple hydrodynamic coefficients', ErrStat2, ErrMsg2 ) - if (Failed()) return; - call ParseAry( FileInfo_In, CurLine, 'Simple hydrodynamic coefficients table row '//trim( Int2LStr(I)), tmpReArray, size(tmpReArray), ErrStat2, ErrMsg2, UnEc ) - if (Failed()) return; + + CALL AllocAry( tmpReArray, 14, 'temporary array for Simple hydrodynamic coefficients', ErrStat2, ErrMsg2 ) + if (Failed()) return + ! call ParseAry( FileInfo_In, CurLine, 'Simple hydrodynamic coefficients table row '//trim( Int2LStr(I)), tmpReArray, size(tmpReArray), ErrStat2, ErrMsg2, UnEc ) + ! if (Failed()) return; + CALL ParseRAryWKywrd( FileInfo_In, CurLine, 'Simple hydrodynamic coefficients table row '//trim( Int2LStr(1_IntKi)), tmpReArray, size(tmpReArray), & + 'MCF', 1.0_ReKi, (/5,6/), InputFileData%Morison%SimplMCF, ErrStat2, ErrMsg2, UnEc ) + if (Failed()) return InputFileData%Morison%SimplCd = tmpReArray( 1) InputFileData%Morison%SimplCdMG = tmpReArray( 2) @@ -822,10 +526,11 @@ SUBROUTINE HydroDyn_ParseInput( InputFileName, OutRootName, defWtrDens, defWtrDp InputFileData%Morison%SimplAxCaMG = tmpReArray(10) InputFileData%Morison%SimplAxCp = tmpReArray(11) InputFileData%Morison%SimplAxCpMG = tmpReArray(12) + InputFileData%Morison%SimplCb = tmpReArray(13) + InputFileData%Morison%SimplCbMG = tmpReArray(14) if (allocated(tmpReArray)) deallocate(tmpReArray) - !------------------------------------------------------------------------------------------------- ! Depth-based Hydrodynamic Coefficients Section !------------------------------------------------------------------------------------------------- @@ -844,7 +549,7 @@ SUBROUTINE HydroDyn_ParseInput( InputFileName, OutRootName, defWtrDens, defWtrDp IF ( InputFileData%Morison%NCoefDpth > 0 ) THEN - CALL AllocAry( tmpReArray, 13, 'temporary array for CoefDpths', ErrStat2, ErrMsg2 ) + CALL AllocAry( tmpReArray, 15, 'temporary array for CoefDpths', ErrStat2, ErrMsg2 ) if (Failed()) return; ! Allocate memory for depth-based coefficient arrays @@ -856,8 +561,12 @@ SUBROUTINE HydroDyn_ParseInput( InputFileName, OutRootName, defWtrDens, defWtrDp END IF DO I = 1,InputFileData%Morison%NCoefDpth - call ParseAry( FileInfo_In, CurLine, ' CoefDpths coefficients table row '//trim( Int2LStr(I)), tmpReArray, size(tmpReArray), ErrStat2, ErrMsg2, UnEc ) - if (Failed()) return; + ! call ParseAry( FileInfo_In, CurLine, ' CoefDpths coefficients table row '//trim( Int2LStr(I)), tmpReArray, size(tmpReArray), ErrStat2, ErrMsg2, UnEc ) + ! if (Failed()) return; + CALL ParseRAryWKywrd( FileInfo_In, CurLine, ' CoefDpths coefficients table row '//trim( Int2LStr(I)), tmpReArray, size(tmpReArray), & + 'MCF', 1.0_ReKi, (/6,7/), InputFileData%Morison%CoefDpths(I)%DpthMCF, ErrStat2, ErrMsg2, UnEc ) + if (Failed()) return + InputFileData%Morison%CoefDpths(I)%Dpth = tmpReArray( 1) InputFileData%Morison%CoefDpths(I)%DpthCd = tmpReArray( 2) @@ -872,6 +581,16 @@ SUBROUTINE HydroDyn_ParseInput( InputFileName, OutRootName, defWtrDens, defWtrDp InputFileData%Morison%CoefDpths(I)%DpthAxCaMG = tmpReArray(11) InputFileData%Morison%CoefDpths(I)%DpthAxCp = tmpReArray(12) InputFileData%Morison%CoefDpths(I)%DpthAxCpMG = tmpReArray(13) + InputFileData%Morison%CoefDpths(I)%DpthCb = tmpReArray(14) + InputFileData%Morison%CoefDpths(I)%DpthCbMG = tmpReArray(15) + END DO + + DO I = 2,InputFileData%Morison%NCoefDpth + IF (InputFileData%Morison%CoefDpths(I)%DpthMCF .NEQV. InputFileData%Morison%CoefDpths(1)%DpthMCF) THEN + ErrStat2 = ErrID_Fatal + ErrMsg2 = 'In the depth-based hydrodynamic coefficients, MCF is specified for some depth but not others.' + if (Failed()) RETURN + END IF END DO if (allocated(tmpReArray)) deallocate(tmpReArray) @@ -896,7 +615,7 @@ SUBROUTINE HydroDyn_ParseInput( InputFileName, OutRootName, defWtrDens, defWtrDp IF ( InputFileData%Morison%NCoefMembers > 0 ) THEN - CALL AllocAry( tmpReArray, 25, 'temporary array for CoefMembers', ErrStat2, ErrMsg2 ) + CALL AllocAry( tmpReArray, 29, 'temporary array for CoefMembers', ErrStat2, ErrMsg2 ) if (Failed()) return; ! Allocate memory for Member-based coefficient arrays @@ -908,8 +627,12 @@ SUBROUTINE HydroDyn_ParseInput( InputFileName, OutRootName, defWtrDens, defWtrDp END IF DO I = 1,InputFileData%Morison%NCoefMembers - call ParseAry( FileInfo_In, CurLine, 'Member-based hydrodynamic coefficients table row '//trim( Int2LStr(I)), tmpReArray, size(tmpReArray), ErrStat2, ErrMsg2, UnEc ) - if (Failed()) return; + !call ParseAry( FileInfo_In, CurLine, 'Member-based hydrodynamic coefficients table row '//trim( Int2LStr(I)), tmpReArray, size(tmpReArray), ErrStat2, ErrMsg2, UnEc ) + ! if (Failed()) return; + + CALL ParseRAryWKywrd( FileInfo_In, CurLine, 'Member-based hydrodynamic coefficients table row '//trim( Int2LStr(I)), tmpReArray, size(tmpReArray), & + 'MCF', 1.0_ReKi, (/10,11,12,13/), InputFileData%Morison%CoefMembers(I)%MemberMCF, ErrStat2, ErrMsg2, UnEc ) + if (Failed()) return InputFileData%Morison%CoefMembers(I)%MemberID = NINT(tmpReArray( 1)) InputFileData%Morison%CoefMembers(I)%MemberCd1 = tmpReArray( 2) @@ -936,6 +659,10 @@ SUBROUTINE HydroDyn_ParseInput( InputFileName, OutRootName, defWtrDens, defWtrDp InputFileData%Morison%CoefMembers(I)%MemberAxCp2 = tmpReArray(23) InputFileData%Morison%CoefMembers(I)%MemberAxCpMG1 = tmpReArray(24) InputFileData%Morison%CoefMembers(I)%MemberAxCpMG2 = tmpReArray(25) + InputFileData%Morison%CoefMembers(I)%MemberCb1 = tmpReArray(26) + InputFileData%Morison%CoefMembers(I)%MemberCb2 = tmpReArray(27) + InputFileData%Morison%CoefMembers(I)%MemberCbMG1 = tmpReArray(28) + InputFileData%Morison%CoefMembers(I)%MemberCbMG2 = tmpReArray(29) END DO if (allocated(tmpReArray)) deallocate(tmpReArray) @@ -974,7 +701,8 @@ SUBROUTINE HydroDyn_ParseInput( InputFileName, OutRootName, defWtrDens, defWtrDp READ(Line,*,IOSTAT=ErrStat2) InputFileData%Morison%InpMembers(I)%MemberID, InputFileData%Morison%InpMembers(I)%MJointID1, & InputFileData%Morison%InpMembers(I)%MJointID2, InputFileData%Morison%InpMembers(I)%MPropSetID1, & InputFileData%Morison%InpMembers(I)%MPropSetID2, InputFileData%Morison%InpMembers(I)%MDivSize, & - InputFileData%Morison%InpMembers(I)%MCoefMod, InputFileData%Morison%InpMembers(I)%PropPot + InputFileData%Morison%InpMembers(I)%MCoefMod, InputFileData%Morison%InpMembers(I)%MHstLMod, & + InputFileData%Morison%InpMembers(I)%PropPot IF ( ErrStat2 /= 0 ) THEN ErrStat2 = ErrID_Fatal ErrMsg2 = 'Error reading members table row '//trim( Int2LStr(I))//', line ' & @@ -1275,680 +1003,183 @@ SUBROUTINE HydroDyn_ParseInput( InputFileName, OutRootName, defWtrDens, defWtrDp 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(tmpArray )) DEALLOCATE(tmpArray ) - IF (ALLOCATED(tmpReArray)) DEALLOCATE(tmpReArray) - IF (ALLOCATED(tmpVec1 )) DEALLOCATE(tmpVec1 ) - IF (ALLOCATED(tmpVec2 )) DEALLOCATE(tmpVec2 ) - ! Cleanup the Echo file and global variables - if (UnEc > 0) close ( UnEc ) - END SUBROUTINE Cleanup -END SUBROUTINE HydroDyn_ParseInput - - - - - -!==================================================================================================== -SUBROUTINE HydroDynInput_ProcessInitData( InitInp, Interval, InputFileData, ErrStat, ErrMsg ) -! This private subroutine verifies the input required for HydroDyn is correctly specified. -!---------------------------------------------------------------------------------------------------- - - - ! Passed variables - - TYPE(HydroDyn_InitInputType), INTENT( IN ) :: InitInp ! the hydrodyn data - REAL(DbKi), INTENT( IN ) :: Interval ! The DT supplied by the glue code/driver - TYPE(HydroDyn_InputFile), INTENT( INOUT ) :: InputFileData ! the hydrodyn input file data - INTEGER, INTENT( OUT ) :: ErrStat ! returns a non-zero value when an error occurs - CHARACTER(*), INTENT( OUT ) :: ErrMsg ! Error message if ErrStat /= ErrID_None - - INTEGER :: I ! Generic loop counter index - INTEGER :: J ! Generic loop counter index - INTEGER :: K ! Generic loop counter index - INTEGER :: Itemp ! @mhall: additional temporary index - CHARACTER(1024) :: TmpPath ! Temporary storage for relative path name - LOGICAL :: FoundID ! Boolean flag indicating whether an ID from one tables is found in one of the other input table - REAL(ReKi) :: MinDepth ! The minimum depth entry in the Depth-based Hydrodynamic coefficents table - REAL(ReKi) :: MaxDepth ! The maximum depth entry in the Depth-based Hydrodynamic coefficents table - REAL(ReKi) :: z1 - REAL(ReKi) :: z2 - REAL(ReKi) :: MinMembrDpth - REAL(ReKi) :: MaxMembrDpth -! CHARACTER(ChanLen), ALLOCATABLE :: tmpOutLst(:) ! - CHARACTER(3) :: TmpExtension ! Temporary variable for holding the file extension for 10d, 11d, 12d, 10s, 11s, 12s WAMIT files - LOGICAL :: TmpFileExist ! Temporary variable in checking the existance of an input file. - LOGICAL :: JointUsed - REAL(ReKi) :: l - REAL(ReKi) :: lvec(3) - LOGICAL, ALLOCATABLE :: foundMask(:) - INTEGER :: WaveModIn - INTEGER(IntKi) :: ErrStat2, IOS - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'HydroDynInput_ProcessInitData' - ! Initialize ErrStat - - ErrStat = ErrID_None - ErrStat2 = ErrID_None - ErrMsg = "" - ErrMsg2 = "" + SUBROUTINE ParseRAryWKywrd( FileInfo, LineNum, AryName, Ary, AryLen, Kywrd, KywrdVal, KywrdEntry, HasKywrd, ErrStat, ErrMsg, UnEc ) + + ! Arguments declarations. + INTEGER, INTENT(IN) :: AryLen !< The length of the array to parse. + TYPE (FileInfoType), INTENT(IN) :: FileInfo !< The derived type for holding the file information. + INTEGER(IntKi), INTENT(INOUT) :: LineNum !< The number of the line to parse. + CHARACTER(*), INTENT(IN) :: AryName !< The array name we are trying to fill. + REAL(ReKi), INTENT(OUT) :: Ary(AryLen) !< The array to receive the input values. + CHARACTER(*), INTENT(IN) :: Kywrd !< The keyword to look for + REAL(ReKi), INTENT(IN) :: KywrdVal !< Value to be used when the keyword is encountered + INTEGER(IntKi), INTENT(IN) :: KywrdEntry(:) !< Entries where the provided keyword is allowed + LOGICAL, INTENT(OUT) :: HasKywrd !< T/F to indicate whether keyword is present + INTEGER(IntKi), INTENT(OUT) :: ErrStat !< The error status. + CHARACTER(*), INTENT(OUT) :: ErrMsg !< The error message, if ErrStat /= 0. + INTEGER, INTENT(IN), OPTIONAL :: UnEc !< I/O unit for echo file. If present and > 0, write to UnEc. + + ! Local declarations. + INTEGER(IntKi) :: i,j ! Local counter. + CHARACTER(25), ALLOCATABLE :: tmpChrArray(:) ! Temporary character array storage - - !------------------------------------------------------------------------- - ! Check environmental conditions - !------------------------------------------------------------------------- - - - ! WtrDens - Water density. - - IF ( InputFileData%Waves%WtrDens < 0.0 ) THEN - CALL SetErrStat( ErrID_Fatal,'WtrDens must not be negative.',ErrStat,ErrMsg,RoutineName) - RETURN - END IF - - - ! WtrDpth - Water depth - - ! First adjust water depth based on MSL2SWL values - InputFileData%Morison%WtrDpth = InputFileData%Morison%WtrDpth + InputFileData%Morison%MSL2SWL - - IF ( InputFileData%Morison%WtrDpth <= 0.0 ) THEN - CALL SetErrStat( ErrID_Fatal,'WtrDpth must be greater than zero.',ErrStat,ErrMsg,RoutineName) - RETURN - END IF - - - ! MSL2SWL - Mean sea level to still water level - - IF ( InputFileData%PotMod == 1 .AND. .NOT. EqualRealNos(InputFileData%Morison%MSL2SWL, 0.0_ReKi) ) THEN - CALL SetErrStat( ErrID_Fatal,'MSL2SWL must be 0 when PotMod = 1 (WAMIT).',ErrStat,ErrMsg,RoutineName) - RETURN - END IF - - - ! WaveMod - Wave kinematics model switch. - - IF ( LEN_TRIM(InputFileData%Waves%WaveModChr) > 1 ) THEN - - IF ( InputFileData%Waves%WaveModChr(1:2) == '1P' ) THEN ! The user wants to specify the phase in place of a random phase - - READ (InputFileData%Waves%WaveModChr(3:),*,IOSTAT=IOS ) InputFileData%Waves%WavePhase - CALL CheckIOS ( IOS, "", 'WavePhase', NumType, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF ( ErrStat >= AbortErrLev ) RETURN - - WaveModIn = 1 - InputFileData%Waves%WaveMod = 10 ! Internally define WaveMod = 10 to mean regular waves with a specified (nonrandom) phase - InputFileData%Waves%WavePhase = InputFileData%Waves%WavePhase*D2R ! Convert the phase from degrees to radians - - ELSE ! The user must have specified WaveMod incorrectly. - CALL SetErrStat( ErrID_Fatal,'WaveMod incorrectly specified',ErrStat,ErrMsg,RoutineName) - RETURN - END IF - - ELSE - ! The line below only works for 1 digit reads - READ( InputFileData%Waves%WaveModChr, *, IOSTAT=IOS ) InputFileData%Waves%WaveMod - CALL CheckIOS ( IOS, "", 'WaveMod', NumType, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF ( ErrStat >= AbortErrLev ) RETURN - - WaveModIn = InputFileData%Waves%WaveMod - - END IF ! LEN_TRIM(InputFileData%Waves%WaveModChr) - - IF ( (WaveModIn == 6) .AND. .NOT. EqualRealNos(InputFileData%Morison%MSL2SWL, 0.0_ReKi) ) THEN - CALL SetErrStat( ErrID_Fatal,'MSL2SWL must be 0 when WaveMod = 6.',ErrStat,ErrMsg,RoutineName) - RETURN - END IF - - - IF ( WaveModIn < 0 .OR. WaveModIn > 6 ) THEN - IF ( InputFileData%PotMod == 1 ) THEN - CALL SetErrStat( ErrID_Fatal,'WaveMod must be 0, 1, 1P#, 2, 3, 4, 5, or 6.',ErrStat,ErrMsg,RoutineName) - RETURN -!ADP: This seems like a strange test on ErrStat... - ELSE IF ( ErrStat /= ErrID_None .OR. WaveModIn /= 5) THEN - CALL SetErrStat( ErrID_Fatal,'WaveMod must be 0, 1, 1P#, 2, 3, 4, or 5.',ErrStat,ErrMsg,RoutineName) - RETURN - END IF - END IF - - ! Linearization Checks - ! LIN-TODO: - !errors if: - !if ( & - ! (WaveModIn /= 0) .or. & - ! (InputFileData%Waves2%WvDiffQTFF /= .false.) .or. & - ! (InputFileData%Waves2%WvSumQTFF /= .false.) .or. & - ! (InputFileData%PotMod /= 0 .or. InputFileData%PotMod /=1) .or. & - ! (InputFileData%WAMIT%ExctnMod /=0 .or. InputFileData%WAMIT%ExctnMod /=2) .or. & - ! (InputFileData%WAMIT%RdtnMod /=0 .or. InputFileData%WAMIT%RdtnMod /=2) .or. & - ! (InputFileData%WAMIT2%MnDrift /=0) .or. & - ! (InputFileData%WAMIT2%NewmanApp /= 0) .or. & - ! (InputFileData%WAMIT2%SumQTF /= 0 ) ) then - ! - !end if - - - ! WaveStMod - Model switch for stretching incident wave kinematics to instantaneous free surface. - - ! TODO: We are only implementing WaveStMod = 0 (No stretching) at this point in time. 1 Mar 2013 GJH - - IF ( InputFileData%Waves%WaveStMod /= 0 ) THEN - CALL SetErrStat( ErrID_Fatal,'WaveStMod must be 0. Future versions of HydroDyn will once again support other wave stretching models.',ErrStat,ErrMsg,RoutineName) - RETURN - END IF - - IF ( InputFileData%Waves%WaveMod /= 6 .AND. InputFileData%Morison%NMembers > 0 .AND. InputFileData%Waves%WaveMod > 0 ) THEN - - IF ( ( InputFileData%Waves%WaveStMod /= 0 ) .AND. ( InputFileData%Waves%WaveStMod /= 1 ) .AND. & - ( InputFileData%Waves%WaveStMod /= 2 ) ) THEN ! (TODO: future version will support 3) .AND. ( InputFileData%Waves%WaveStMod /= 3 ) ) THEN - ErrMsg = ' WaveStMod must be 0, 1, or 2.' !, or 3.' - ErrStat = ErrID_Fatal - - RETURN - END IF - - !IF ( ( InputFileData%Waves%WaveStMod /= 3 ) .AND. ( InputFileData%Waves%WaveMod == 5 ) ) THEN - ! ErrMsg = ' WaveStMod must be set to 3 when WaveMod is set to 5.' - ! ErrStat = ErrID_Fatal - ! - ! RETURN - !END IF - - - - ELSE !don't use this one - - ! NOTE: Do not read in WaveStMod for floating platforms since it is - ! inconsistent to use stretching (which is a nonlinear correction) for - ! the viscous drag term in Morison's equation while not accounting for - ! stretching in the diffraction and radiation problems (according to - ! Paul Sclavounos, there are such corrections). Instead, the viscous - ! drag term from Morison's equation is computed by integrating up to - ! the MSL, regardless of the instantaneous free surface elevation. - - InputFileData%Waves%WaveStMod = 0 - - END IF - - - ! WaveTMax - Analysis time for incident wave calculations. - - IF ( InputFileData%Waves%WaveMod == 0 ) THEN ! .TRUE if we DO NOT HAVE have incident waves. - - ! TODO: Issue warning if WaveTMax was not already 0.0 in this case. - IF ( .NOT. EqualRealNos(InputFileData%Waves%WaveTMax, 0.0_DbKi) ) THEN - CALL WrScr( ' Setting WaveTMax to 0.0 since WaveMod = 0' ) - InputFileData%Waves%WaveTMax = 0.0 - END IF - IF ( .NOT. EqualRealNos(InputFileData%Waves%WaveDir, 0.0_SiKi) ) THEN - CALL WrScr( ' Setting WaveDir to 0.0 since WaveMod = 0' ) - InputFileData%Waves%WaveDir = 0.0 - END IF - ELSEIF ( InputFileData%Waves%WaveMod == 5 ) THEN ! User wave elevation file reading in - IF (InitInp%TMax > InputFileData%Waves%WaveTMax ) THEN - CALL SetErrstat( ErrID_Fatal, ' WaveTMax must be larger than the simulation time for user wave elevations (WaveMod == 5).',ErrStat,ErrMsg,RoutineName) - RETURN - END IF - ELSE - IF (InitInp%TMax > InputFileData%Waves%WaveTMax ) THEN - CALL WrScr( ' WaveTMax is less then the simulation time. Wave data will repeat every WaveTMax seconds.') - END IF - END IF - - - ! WaveDT - Time step for incident wave calculations - - IF ( InputFileData%Waves%WaveMod > 0 ) THEN ! .TRUE if we have incident waves. - - IF ( InputFileData%Waves%WaveDT <= 0.0 ) THEN - CALL SetErrStat( ErrID_Fatal,'WaveDT must be greater than zero.',ErrStat,ErrMsg,RoutineName) - RETURN - END IF - - IF ( (InputFileData%Waves%WaveMod == 6) .AND. (.NOT. EqualRealNos(InputFileData%Waves%WaveDT, Interval)) ) THEN - CALL SetErrStat( ErrID_Fatal,'WaveDT must equal the simulation DT value when WaveMod = 6.',ErrStat,ErrMsg,RoutineName) - RETURN - END IF - ELSE - - InputFileData%Waves%WaveDT = 0.0 - - END IF - - - ! WaveHs - Significant wave height - - IF ( ( InputFileData%Waves%WaveMod /= 0 ) .AND. ( InputFileData%Waves%WaveMod /= 4 ) .AND. ( InputFileData%Waves%WaveMod /= 5 ) ) THEN ! .TRUE. (when WaveMod = 1, 2, 3, or 10) if we have plane progressive (regular), JONSWAP/Pierson-Moskowitz spectrum (irregular) waves, or white-noise waves, but not user-defined or GH Bladed wave data. - - IF ( InputFileData%Waves%WaveHs <= 0.0 ) THEN - CALL SetErrStat( ErrID_Fatal,'WaveHs must be greater than zero.',ErrStat,ErrMsg,RoutineName) - RETURN - END IF - - ELSE - - InputFileData%Waves%WaveHs = 0.0 - - END IF - - - ! WaveTp - Peak spectral period. - ! We commented out the if else block due to a bug when WaveMod == 3, and then WaveTp is hence set to 0.0. See line 1092 of Waves.f90 (as of 11/24/2014) GJH - !IF ( ( InputFileData%Waves%WaveMod == 1 ) .OR. ( InputFileData%Waves%WaveMod == 2 ) .OR. ( InputFileData%Waves%WaveMod == 10 ) ) THEN ! .TRUE. (when WaveMod = 1, 2, or 10) if we have plane progressive (regular), JONSWAP/Pierson-Moskowitz spectrum (irregular) waves. - - IF ( InputFileData%Waves%WaveTp <= 0.0 ) THEN - CALL SetErrStat( ErrID_Fatal,'WaveTp must be greater than zero.',ErrStat,ErrMsg,RoutineName) - RETURN - END IF - - ! ELSE - - ! InputFileData%Waves%WaveTp = 0.0 - - ! END IF - - - ! WavePkShp - Peak shape parameter. - - CALL Conv2UC( InputFileData%Waves%WavePkShpChr ) ! Convert Line to upper case. - - IF ( InputFileData%Waves%WaveMod == 2 ) THEN ! .TRUE if we have JONSWAP/Pierson-Moskowitz spectrum (irregular) waves, but not GH Bladed wave data. - - IF ( TRIM(InputFileData%Waves%WavePkShpChr) == 'DEFAULT' ) THEN ! .TRUE. when one wants to use the default value of the peak shape parameter, conditioned on significant wave height and peak spectral period. - - InputFileData%Waves%WavePkShp = WavePkShpDefault ( InputFileData%Waves%WaveHs, InputFileData%Waves%WaveTp ) - - ELSE ! The input must have been specified numerically. - - READ (InputFileData%Waves%WavePkShpChr,*,IOSTAT=IOS) InputFileData%Waves%WavePkShp - CALL CheckIOS ( IOS, "", 'WavePkShp', NumType, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2,ErrStat,ErrMsg,RoutineName) - IF ( ErrStat >= AbortErrLev ) RETURN - - IF ( ( InputFileData%Waves%WavePkShp < 1.0 ) .OR. ( InputFileData%Waves%WavePkShp > 7.0 ) ) THEN - CALL SetErrStat( ErrID_Fatal,'WavePkShp must be greater than or equal to 1 and less than or equal to 7.',ErrStat,ErrMsg,RoutineName) + CHARACTER(*), PARAMETER :: RoutineName = 'ParseRAryWKywrd' + + hasKywrd = .FALSE. + ErrStat = ErrID_None + ErrMsg = "" + + CALL AllocAry( tmpChrArray, AryLen, 'temporary array for ParseRAryWKywrd', ErrStat, ErrMsg ) + IF (ErrStat /= 0) THEN + ErrStat = ErrID_Fatal + ErrMsg = 'Error allocating temporary array for ParseRAryWKywrd ' // ' when parsing ' // AryName RETURN END IF - - END IF - - ELSE - - InputFileData%Waves%WavePkShp = 1.0 - - END IF - - - ! WvLowCOff and WvHiCOff - Wave Cut-off frequency - - IF ( InputFileData%Waves%WvLowCOff < 0 ) THEN - CALL SetErrStat( ErrID_Fatal,'WvLowCOff must be greater than or equal to zero.',ErrStat,ErrMsg,RoutineName) - RETURN - END IF - - ! Threshold upper cut-off based on sampling rate - IF ( EqualRealNos(InputFileData%Waves%WaveDT, 0.0_DbKi) ) THEN - InputFileData%Waves%WvHiCOff = 10000.0; ! This is not going to be used because WaveDT is zero. - ELSE - InputFileData%Waves%WvHiCOff = MIN( REAL( Pi/InputFileData%Waves%WaveDT,SiKi), InputFileData%Waves%WvHiCOff ) - END IF - - !TODO Issue warning if we changed WvHiCOff GJH 7/24/13 - - IF ( InputFileData%Waves%WvLowCOff >= InputFileData%Waves%WvHiCOff ) THEN - CALL SetErrSTat( ErrID_Fatal,'WvLowCOff must be less than WvHiCOff.',ErrStat,ErrMsg,RoutineName) - RETURN - END IF - - - ! Copy over the first order frequency limits to the WAMIT2 module which needs them. - InputFileData%WAMIT2%WvLowCOff = InputFileData%Waves%WvLowCOff - InputFileData%WAMIT2%WvHiCOff = InputFileData%Waves%WvHiCOff - - - ! WaveDir - Wave heading direction. - - IF ( ( InputFileData%Waves%WaveMod > 0 ) .AND. ( InputFileData%Waves%WaveMod /= 6 ) ) THEN ! .TRUE if we have incident waves, but not user input wave data. - - IF ( ( InputFileData%Waves%WaveDir <= -180.0 ) .OR. ( InputFileData%Waves%WaveDir > 180.0 ) ) THEN - CALL SetErrStat( ErrID_Fatal,'WaveDir must be greater than -180 and less than or equal to 180.',ErrStat,ErrMsg,RoutineName) - RETURN - END IF - - ELSE - - InputFileData%Waves%WaveDir = 0.0 - - END IF - - - ! Multi-directional waves - - ! Check the WaveDirMod value - IF ( InputFileData%Waves%WaveDirMod < 0 .OR. InputFileData%Waves%WaveDirMod > 1 ) THEN - CALL SetErrStat( ErrID_Fatal,'WaveDirMod must be either 0 (No spreading) or 1 (COS2S spreading function)',ErrStat,ErrMsg,RoutineName) - RETURN - END IF - - ! Check if we are doing multidirectional waves or not. - ! We can only use multi directional waves on WaveMod=2,3,4 - InputFileData%Waves%WaveMultiDir = .FALSE. ! Set flag to false to start - IF ( InputFileData%Waves%WaveMod >= 2 .AND. InputFileData%Waves%WaveMod <= 4 .AND. InputFileData%Waves%WaveDirMod == 1 ) THEN - InputFileData%Waves%WaveMultiDir = .TRUE. - ELSEIF ( (InputFileData%Waves%WaveMod < 2 .OR. InputFileData%Waves%WaveMod >4) .AND. InputFileData%Waves%WaveDirMod == 1 ) THEN - CALL SetErrStat( ErrID_Warn,'WaveDirMod unused unless WaveMod == 2, 3, or 4. Ignoring WaveDirMod.',ErrStat,ErrMsg,RoutineName) - ENDIF - - - ! Check to see if the for some reason the wave direction spreading range is set to zero. If it is, - ! we don't have any spreading, so we will turn off the multidirectional waves. - IF ( InputFileData%Waves%WaveMultiDir .AND. EqualRealNos( InputFileData%Waves%WaveDirRange, 0.0_SiKi ) ) THEN - CALL SetErrStat( ErrID_Warn,' WaveDirRange set to zero, so multidirectional waves are turned off.',ErrStat,ErrMsg,RoutineName) - InputFileData%Waves%WaveMultiDir = .FALSE. - ENDIF - - - - ! We check the following only if we set WaveMultiDir to true, otherwise ignore them and set them to zero - IF ( InputFileData%Waves%WaveMultiDir ) THEN - - ! Check WaveDirSpread - IF ( InputFileData%Waves%WaveDirSpread <= 0.0 ) THEN - - CALL SetErrStat( ErrID_Fatal,'WaveDirSpread cannot negative or zero.',ErrStat,ErrMsg,RoutineName) - RETURN - - ENDIF - - - ! Check that the number of wave directions is a positive odd number. - ! -> If it is less than 0, error out. - ! -> If it is even, we will increment it by 1. - IF ( InputFileData%Waves%WaveNDir <= 0_IntKi ) THEN - CALL SetErrStat( ErrID_Fatal,' WaveNDir must be an odd number greater than 0.',ErrStat,ErrMsg,RoutineName) - RETURN - ENDIF - - ! Check that the value for WaveNDir is odd - IF ( MODULO( InputFileData%Waves%WaveNDir, 2_IntKi) == 0_IntKi ) THEN - InputFileData%Waves%WaveNDir = InputFileData%Waves%WaveNDir + 1 - CALL SetErrStat( ErrID_Warn,'WaveNDir must be odd. Changing the value to '//Num2LStr(InputFileData%Waves%WaveNDir),ErrStat,ErrMsg,RoutineName) - ENDIF - - ! Now check that the WaveDirRange is less than 360 degrees (not sure why we would want that) - IF ( InputFileData%Waves%WaveDirRange > 360.0_ReKi ) THEN - CALL SetErrStat( ErrID_Fatal,' WaveDirRange should be less than a full circle.',ErrStat,ErrMsg,RoutineName) - ENDIF - - ELSE ! Set everything to zero if we aren't going to use it - - InputFileData%Waves%WaveNDir = 1 ! Only one direction set -- this shouldn't get used later anyhow - InputFileData%Waves%WaveDirRange = PiBy2 ! This is so that the constant C=1 in the COS2S function (it shouldn't get called, but in case it does) - InputFileData%Waves%WaveDirSpread = 0.0 - - END IF - - - ! WaveSeed(1), !WaveSeed(2) - - IF ( .NOT. ( ( InputFileData%Waves%WaveMod > 0 ) .AND. ( InputFileData%Waves%WaveMod /= 5 ) .AND. ( InputFileData%Waves%WaveMod /= 10 ) ) ) THEN !.TRUE. for plane progressive (regular) with random phase or irregular wave - - DO I = 1,2 - - InputFileData%Waves%WaveSeed(I) = 0 - - END DO !I - - END IF - - - ! WvKinFile - - IF ( InputFileData%Waves%WaveMod == 5 .OR. InputFileData%Waves%WaveMod == 6 ) THEN ! .TRUE if we are to read user-supplied wave elevation or wave kinematics file(s). - - IF ( LEN_TRIM( InputFileData%Waves%WvKinFile ) == 0 ) THEN - CALL SetErrStat( ErrID_Fatal,'WvKinFile must not be an empty string.',ErrStat,ErrMsg,RoutineName) - RETURN - END IF - - IF ( PathIsRelative( InputFileData%Waves%WvKinFile ) ) THEN - CALL GetPath( TRIM(InitInp%InputFile), TmpPath ) - InputFileData%Waves%WvKinFile = TRIM(TmpPath)//TRIM(InputFileData%Waves%WvKinFile) - END IF - InputFileData%Waves%WriteWvKin = .FALSE. - ELSE !don't use this one -#ifdef WRITE_WV_KIN - IF ( LEN_TRIM( InputFileData%Waves%WvKinFile ) == 0 ) THEN - InputFileData%Waves%WriteWvKin = .FALSE. - ELSE - InputFileData%Waves%WriteWvKin = .TRUE. - IF ( PathIsRelative( InputFileData%Waves%WvKinFile ) ) THEN - CALL GetPath( TRIM(InputFileData%InputFile), TmpPath ) - InputFileData%Waves%WvKinFile = TRIM(TmpPath)//TRIM(InputFileData%Waves%WvKinFile) - END IF - END IF - -#else - InputFileData%Waves%WvKinFile = "" - InputFileData%Waves%WriteWvKin = .FALSE. -#endif - END IF - - - ! NWaveElev - - IF ( InputFileData%Waves%NWaveElev < 0 ) THEN - - CALL SetErrStat( ErrID_Fatal,'NWaveElev must not be negative.',ErrStat,ErrMsg,RoutineName) - RETURN - - END IF - - - - !------------------------------------------------------------------------- - ! Check 2nd Order Waves section - !------------------------------------------------------------------------- - - - ! Difference frequency cutoffs - - ! WvLowCOffD and WvHiCOffD - Wave Cut-off frequency - IF ( InputFileData%Waves2%WvLowCOffD < 0 ) THEN - CALL SetErrStat( ErrID_Fatal,'WvLowCOffD must be greater than or equal to zero.',ErrStat,ErrMsg,RoutineName) - RETURN - END IF - - ! Check that the order given makes sense. - IF ( InputFileData%Waves2%WvLowCOffD >= InputFileData%Waves2%WvHiCOffD ) THEN - CALL SetErrStat( ErrID_Fatal,'WvLowCOffD must be less than WvHiCOffD.',ErrStat,ErrMsg,RoutineName) - RETURN - END IF - - - ! Sum frequency cutoffs - - ! WvLowCOffS and WvHiCOffD - Wave Cut-off frequency - IF ( InputFileData%Waves2%WvLowCOffS < 0 ) THEN - CALL SetErrStat( ErrID_Fatal,'WvLowCOffS must be greater than or equal to zero.',ErrStat,ErrMsg,RoutineName) - RETURN - END IF - - ! Check that the order given makes sense. - IF ( InputFileData%Waves2%WvLowCOffS >= InputFileData%Waves2%WvHiCOffS ) THEN - CALL SetErrStat( ErrID_Fatal,'WvLowCOffS must be less than WvHiCOffS.',ErrStat,ErrMsg,RoutineName) - RETURN - END IF - - - ! Copy over the 2nd order limits to the WAMIT2 module which needs them. - InputFileData%WAMIT2%WvLowCOffD = InputFileData%Waves2%WvLowCOffD - InputFileData%WAMIT2%WvHiCOffD = InputFileData%Waves2%WvHiCOffD - InputFileData%WAMIT2%WvLowCOffS = InputFileData%Waves2%WvLowCOffS - InputFileData%WAMIT2%WvHiCOffS = InputFileData%Waves2%WvHiCOffS - - - - !------------------------------------------------------------------------- - ! Check Current section - !------------------------------------------------------------------------- - - - ! CurrMod - Current profile model switch - - IF ( ( InputFileData%Current%CurrMod /= 0 ) .AND. ( InputFileData%Current%CurrMod /= 1 ) .AND. ( InputFileData%Current%CurrMod /= 2 ) ) THEN - CALL SetErrStat( ErrID_Fatal,'CurrMod must be 0, 1, or 2.',ErrStat,ErrMsg,RoutineName) - RETURN - END IF - - IF ( ( InputFileData%Current%CurrMod /= 0 ) .AND. ( InputFileData%Waves%WaveMod == 6 ) ) THEN - CALL SetErrStat( ErrID_Fatal,'CurrMod must be set to 0 when WaveMod is set to 6: user-input wave data.',ErrStat,ErrMsg,RoutineName) - RETURN - END IF - - - ! CurrSSV0 - Sub-surface current velocity at still water level - - IF ( InputFileData%Current%CurrMod == 1 ) THEN ! .TRUE if we have standard current. - - IF ( InputFileData%Current%CurrSSV0 < 0.0 ) THEN - CALL SetErrStat( ErrID_Fatal,'CurrSSV0 must not be less than zero.',ErrStat,ErrMsg,RoutineName) - RETURN - END IF - - ELSE - - InputFileData%Current%CurrSSV0 = 0.0 - - END IF - - - ! CurrSSDirChr - Sub-surface current heading direction - - IF ( InputFileData%Current%CurrMod == 1 ) THEN ! .TRUE if we have standard current. - - - IF ( TRIM(InputFileData%Current%CurrSSDirChr) == 'DEFAULT' ) THEN ! .TRUE. when one wants to use the default value of codirectionality between sub-surface current and incident wave propogation heading directions. - - IF ( InputFileData%Waves%WaveMod == 0 ) THEN - CALL SetErrStat( ErrID_Fatal,'CurrSSDir must not be set to ''DEFAULT'' when WaveMod is set to 0.',ErrStat,ErrMsg,RoutineName) + CALL ParseAry( FileInfo, LineNum, AryName, tmpChrArray, size(tmpChrArray), ErrStat, ErrMsg, UnEc ) + IF (ErrStat /= 0) THEN + ErrStat = ErrID_Fatal + ErrMsg = 'Error parsing ' // AryName RETURN END IF - - InputFileData%Current%CurrSSDir = InputFileData%Waves%WaveDir - - ELSE ! The input must have been specified numerically. - - READ (InputFileData%Current%CurrSSDirChr,*,IOSTAT=IOS) InputFileData%Current%CurrSSDir - CALL CheckIOS ( IOS, "", 'CurrSSDir', NumType, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2,ErrStat,ErrMsg,RoutineName) - IF ( ErrStat >= AbortErrLev ) RETURN - - IF ( ( InputFileData%Current%CurrSSDir <= -180.0 ) .OR. ( InputFileData%Current%CurrSSDir > 180.0 ) ) THEN - CALL SetErrStat( ErrID_Fatal,'CurrSSDir must be greater than -180 and less than or equal to 180.',ErrStat,ErrMsg,RoutineName) - RETURN + + DO j = 1,size(KywrdEntry) + i = KywrdEntry(j) + IF ( TRIM(tmpChrArray(i)) == Kywrd ) THEN + hasKywrd = .TRUE. END IF - - END IF - - - ELSE - - InputFileData%Current%CurrSSDir = 0.0 - - END IF - - - ! CurrNSRef - Near-surface current reference depth. - - IF ( InputFileData%Current%CurrMod == 1 ) THEN ! .TRUE if we have standard current. - - IF ( InputFileData%Current%CurrNSRef <= 0.0 ) THEN - CALL SetErrStat( ErrID_Fatal,'CurrNSRef must be greater than zero.',ErrStat,ErrMsg,RoutineName) - RETURN - END IF - - ELSE - - InputFileData%Current%CurrNSRef = 0.0 - - END IF - - - - ! CurrNSV0 - Near-surface current velocity at still water level. - - IF ( InputFileData%Current%CurrMod == 1 ) THEN ! .TRUE if we have standard current. - - IF ( InputFileData%Current%CurrNSV0 < 0.0 ) THEN - CALL SetErrStat( ErrID_Fatal,'CurrNSV0 must not be less than zero.',ErrStat,ErrMsg,RoutineName) - RETURN + END DO + + IF ( hasKywrd ) THEN + DO j = 1,size(KywrdEntry) + i = KywrdEntry(j) + IF ( TRIM(tmpChrArray(i)) == Kywrd ) THEN + tmpChrArray(i) = Num2Lstr(KywrdVal) + ELSE + ErrStat = ErrID_Fatal + ErrMsg = 'When parsing ' // AryName // ', ' // kywrd // ' is used at some but not all relevant places.' + RETURN + END IF + END DO END IF + + DO i=1,AryLen + READ(tmpChrArray(i),*,IOSTAT=ErrStat) Ary(i) + IF (ErrStat /= 0) THEN + ErrStat = ErrID_Fatal + ErrMsg = 'When parsing ' // AryName // ', nonnumerical entry is encountered where numerical entry is expected.' + RETURN; + END IF + END DO + + IF (ALLOCATED(tmpChrArray)) DEALLOCATE(tmpChrArray) + + END SUBROUTINE ParseRAryWKywrd + + + !.............................. + logical function Failed() + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + Failed = ErrStat >= AbortErrLev + if (Failed) call Cleanup() + end function Failed + SUBROUTINE Cleanup() + IF (ALLOCATED(tmpArray )) DEALLOCATE(tmpArray ) + IF (ALLOCATED(tmpReArray)) DEALLOCATE(tmpReArray) + IF (ALLOCATED(tmpVec1 )) DEALLOCATE(tmpVec1 ) + IF (ALLOCATED(tmpVec2 )) DEALLOCATE(tmpVec2 ) + ! Cleanup the Echo file and global variables + if (UnEc > 0) close ( UnEc ) + END SUBROUTINE Cleanup +END SUBROUTINE HydroDyn_ParseInput - ELSE - - InputFileData%Current%CurrNSV0 = 0.0 - END IF + - ! CurrNSDir - Near-surface current heading direction. +!==================================================================================================== +SUBROUTINE HydroDynInput_ProcessInitData( InitInp, Interval, InputFileData, ErrStat, ErrMsg ) +! This private subroutine verifies the input required for HydroDyn is correctly specified. +!---------------------------------------------------------------------------------------------------- - IF ( InputFileData%Current%CurrMod == 1 ) THEN ! .TRUE if we have standard current. - IF ( ( InputFileData%Current%CurrNSDir <= -180.0 ) .OR. ( InputFileData%Current%CurrNSDir > 180.0 ) ) THEN - CALL SetErrStat( ErrID_Fatal,'CurrNSDir must be greater than -180 and less than or equal to 180.',ErrStat,ErrMsg,RoutineName) - RETURN - END IF + ! Passed variables - ELSE + TYPE(HydroDyn_InitInputType), INTENT( IN ) :: InitInp ! the hydrodyn data + REAL(DbKi), INTENT( IN ) :: Interval ! The DT supplied by the glue code/driver + TYPE(HydroDyn_InputFile), INTENT( INOUT ) :: InputFileData ! the hydrodyn input file data + INTEGER, INTENT( OUT ) :: ErrStat ! returns a non-zero value when an error occurs + CHARACTER(*), INTENT( OUT ) :: ErrMsg ! Error message if ErrStat /= ErrID_None - InputFileData%Current%CurrNSDir = 0.0 + INTEGER :: I ! Generic loop counter index + INTEGER :: J ! Generic loop counter index + INTEGER :: K ! Generic loop counter index + CHARACTER(1024) :: TmpPath ! Temporary storage for relative path name + LOGICAL :: FoundID ! Boolean flag indicating whether an ID from one tables is found in one of the other input table + REAL(ReKi) :: MinDepth ! The minimum depth entry in the Depth-based Hydrodynamic coefficents table + REAL(ReKi) :: MaxDepth ! The maximum depth entry in the Depth-based Hydrodynamic coefficents table + REAL(ReKi) :: z1 + REAL(ReKi) :: z2 + REAL(ReKi) :: MinMembrDpth + REAL(ReKi) :: MaxMembrDpth +! CHARACTER(ChanLen), ALLOCATABLE :: tmpOutLst(:) ! + CHARACTER(3) :: TmpExtension ! Temporary variable for holding the file extension for 10d, 11d, 12d, 10s, 11s, 12s WAMIT files + LOGICAL :: TmpFileExist ! Temporary variable in checking the existance of an input file. + LOGICAL :: JointUsed + REAL(ReKi) :: l + REAL(ReKi) :: lvec(3) + LOGICAL, ALLOCATABLE :: foundMask(:) + + INTEGER(IntKi) :: ErrStat2, IOS + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'HydroDynInput_ProcessInitData' + ! Initialize ErrStat + + ErrStat = ErrID_None + ErrStat2 = ErrID_None + ErrMsg = "" + ErrMsg2 = "" + + + !------------------------------------------------------------------------- + ! Check environmental conditions + !------------------------------------------------------------------------- + if (.not. associated(InitInp%WaveField)) then + call SetErrStat( ErrID_Fatal,' No SeaState information available.',ErrStat,ErrMsg,RoutineName) + return + endif + + if (InitInp%WaveField%NStepWave == 0) then + call SetErrStat( ErrID_Fatal,' No SeaState information available.',ErrStat,ErrMsg,RoutineName) + return + endif + ! MSL2SWL - Mean sea level to still water level + IF ( InputFileData%PotMod == 1 .AND. .NOT. EqualRealNos(InitInp%WaveField%MSL2SWL, 0.0_ReKi) ) THEN + CALL SetErrStat( ErrID_Fatal,'SeaState MSL2SWL must be 0 when PotMod = 1 (WAMIT).',ErrStat,ErrMsg,RoutineName) + RETURN END IF + - - ! CurrDIV - Depth-independent current velocity. - - IF ( InputFileData%Current%CurrMod == 1 ) THEN ! .TRUE if we have standard current. - - IF ( InputFileData%Current%CurrDIV < 0.0 ) THEN - CALL SetErrStat( ErrID_Fatal,'CurrDIV must not be less than zero.',ErrStat,ErrMsg,RoutineName) + ! WaveMod - Wave kinematics model switch. + IF ( InputFileData%PotMod > 0 .and. InitInp%WaveField%WaveMod == WaveMod_ExtFull ) THEN + CALL SetErrStat( ErrID_Fatal,'WaveMod cannot be 6 when PotMod is not 0.',ErrStat,ErrMsg,RoutineName) RETURN - END IF - - ELSE - - InputFileData%Current%CurrDIV = 0.0 - END IF - - ! CurrDIDir - Depth-independent current heading direction. - - IF ( InputFileData%Current%CurrMod == 1 ) THEN ! .TRUE if we have standard current. - - IF ( ( InputFileData%Current%CurrDIDir <= -180.0 ) .OR. ( InputFileData%Current%CurrDIDir > 180.0 ) ) THEN - CALL SetErrStat( ErrID_Fatal,'CurrDIDir must be greater than -180 and less than or equal to 180.',ErrStat,ErrMsg,RoutineName) - RETURN - END IF - - ELSE - - InputFileData%Current%CurrDIDir = 0.0 - - END IF + ! Linearization Checks + ! LIN-TODO: + !errors if: + !if ( & + ! (InputFileData%PotMod /= 0 .or. InputFileData%PotMod /=1) .or. & + ! (InputFileData%WAMIT%ExctnMod /=0 .or. InputFileData%WAMIT%ExctnMod /=2) .or. & + ! (InputFileData%WAMIT%RdtnMod /=0 .or. InputFileData%WAMIT%RdtnMod /=2) .or. & + ! (InputFileData%WAMIT2%MnDrift /=0) .or. & + ! (InputFileData%WAMIT2%NewmanApp /= 0) .or. & + ! (InputFileData%WAMIT2%SumQTF /= 0 ) ) then + ! + !end if ! PotFile - Root name of potential flow files @@ -1969,17 +1200,16 @@ SUBROUTINE HydroDynInput_ProcessInitData( InitInp, Interval, InputFileData, ErrS end do !TODO: Move this to where the WAMIT modules are initialized - InputFileData%WAMIT%WAMITFile = InputFileData%PotFile(1) - InputFileData%WAMIT2%WAMITFile = InputFileData%PotFile(1) + InputFileData%WAMIT%WAMITFile = InputFileData%PotFile(1) + InputFileData%WAMIT2%WAMITFile = InputFileData%PotFile(1) - ! Set the flag for multidirectional waves for WAMIT2 module. It needs to know since the Newman approximation - ! can only use uni-directional waves. - InputFileData%WAMIT2%WaveMultiDir = InputFileData%Waves%WaveMultiDir - ELSE InputFileData%PotFile = "" InputFileData%WAMIT%WAMITFile = "" - InputFileData%WAMIT2%WAMITFile = "" + InputFileData%WAMIT2%WAMITFile = "" + ! These can be set to zero because they are only used if PotMod = 1 + InputFileData%WAMIT%ExctnMod = 0 + InputFileData%WAMIT%RdtnMod = 0 END IF ! Set the WAMIT file name on the Convolution module @@ -2002,8 +1232,17 @@ SUBROUTINE HydroDynInput_ProcessInitData( InitInp, Interval, InputFileData, ErrS InputFileData%WAMIT2%WAMITULEN = 1.0 END IF - - + + ! ExctnDisp - Method of computing Wave Excitation + if ( InputFileData%PotMod /= 1 .or. InputFileData%WAMIT%ExctnMod == 0 .or. InitInp%WaveField%WaveMod == WaveMod_None) then + InputFileData%WAMIT%ExctnDisp = 0 !Force ExctnDisp = 0, so that the Grid of Wave Excitation forces is not computed (saves time and memory) + end if + + ! ExctnCutOff + if ( InputFileData%PotMod == 1 .and. InputFileData%WAMIT%ExctnMod > 0 .and. InputFileData%WAMIT%ExctnDisp == 2 .and. InputFileData%WAMIT%ExctnCutOff <= 0.0 ) then + CALL SetErrStat( ErrID_Fatal,'ExctnCutOff must be greater than zero.',ErrStat,ErrMsg,RoutineName) + end if + ! PtfmVol0 - Displaced volume of water when the platform is in its undisplaced position IF ( InputFileData%PotMod == 1 ) THEN @@ -2182,29 +1421,6 @@ SUBROUTINE HydroDynInput_ProcessInitData( InitInp, Interval, InputFileData, ErrS END IF - ! Check that the min / max diff frequencies make sense if using any DiffQTF method - IF ( InputFileData%WAMIT2%DiffQTF /= 0 .OR. InputFileData%WAMIT2%MnDrift /= 0 .OR. InputFileData%WAMIT2%NewmanApp /=0 ) THEN - IF ( ( InputFileData%WAMIT2%WvHiCOffD < InputFileData%WAMIT2%WvLowCOffD ) .OR. ( InputFileData%WAMIT2%WvLowCOffD < 0.0 ) ) THEN - CALL SetErrStat( ErrID_Fatal,'WvHiCOffD must be larger than WvLowCOffD. Both must be positive.',ErrStat,ErrMsg,RoutineName) - RETURN - END IF - ELSE ! set to zero since we don't need them - InputFileData%WAMIT2%WvLowCOffD = 0.0 - InputFileData%WAMIT2%WvHiCOffD = 0.0 - END IF - - - ! Check that the min / max diff frequencies make sense if using SumQTF - IF ( InputFileData%WAMIT2%SumQTF /= 0 ) THEN - IF ( ( InputFileData%WAMIT2%WvHiCOffS < InputFileData%WAMIT2%WvLowCOffS ) .OR. ( InputFileData%WAMIT2%WvLowCOffS < 0.0 ) ) THEN - CALL SetErrStat( ErrID_Fatal,'WvHiCOffS must be larger than WvLowCOffS. Both must be positive.',ErrStat,ErrMsg,RoutineName) - RETURN - END IF - ELSE ! set to zero since we don't need them - InputFileData%WAMIT2%WvLowCOffS = 0.0 - InputFileData%WAMIT2%WvHiCOffS = 0.0 - END IF - ! now that it has been established that the input parameters for second order are good, we check to make sure that the WAMIT files actually exist. ! Check MnDrift file @@ -2266,20 +1482,8 @@ SUBROUTINE HydroDynInput_ProcessInitData( InitInp, Interval, InputFileData, ErrS !.................. if ( (InputFileData%WAMIT%ExctnMod == 2) ) then - if ( InputFileData%Waves%WaveMod == 6 ) then - call SetErrStat( ErrID_Fatal, 'Externally generated full wave-kinematics time series cannot be used with state-space wave excitations. Set WaveMod 0, 1, 1P#, 2, 3, 4, or 5.', ErrStat, ErrMsg, RoutineName ) - end if - - if ( InputFileData%Waves%WaveDirMod /= 0 ) then - call SetErrStat( ErrID_Fatal, 'Directional spreading cannot be used with state-space wave excitations. Set WaveDirMod=0.', ErrStat, ErrMsg, RoutineName ) - end if - - if ( InputFileData%Waves2%WvDiffQTFF ) then - call SetErrStat( ErrID_Fatal, 'Cannot use full difference-frequency 2nd-order wave kinematics with state-space wave excitations. Set WvDiffQTF=FALSE.', ErrStat, ErrMsg, RoutineName ) - end if - - if ( InputFileData%Waves2%WvSumQTFF ) then - call SetErrStat( ErrID_Fatal, 'Cannot use full summation-frequency 2nd-order wave kinematics with state-space wave excitations. Set WvSumQTF=FALSE.', ErrStat, ErrMsg, RoutineName ) + if ( InitInp%InvalidWithSSExctn ) then + call SetErrStat( ErrID_Fatal, 'Given SeaState conditions cannot be used with state-space wave excitations. In SeaState, WaveMod cannot be 6; WaveDirMod must be 0; WvDiffQTF must be FALSE; and WvSumQTF must be FALSE. Or in HydroDyn set ExctnMod to 0 or 1.', ErrStat, ErrMsg, RoutineName ) end if if ( InputFileData%PotMod /= 1 ) then @@ -2309,22 +1513,6 @@ SUBROUTINE HydroDynInput_ProcessInitData( InitInp, Interval, InputFileData, ErrS !.................. if (InitInp%Linearize) then - if ( InputFileData%Waves%WaveMod /= 0 ) then - call SetErrStat( ErrID_Fatal, 'Still water conditions must be used for linearization. Set WaveMod=0.', ErrStat, ErrMsg, RoutineName ) - end if - - if ( InputFileData%Waves%WaveDirMod /= 0 ) then - call SetErrStat( ErrID_Fatal, 'No directional spreading must be used for linearization. Set WaveDirMod=0.', ErrStat, ErrMsg, RoutineName ) - end if - - if ( InputFileData%Waves2%WvDiffQTFF ) then - call SetErrStat( ErrID_Fatal, 'Cannot use full difference-frequency 2nd-order wave kinematics for linearization. Set WvDiffQTF=FALSE.', ErrStat, ErrMsg, RoutineName ) - end if - - if ( InputFileData%Waves2%WvSumQTFF ) then - call SetErrStat( ErrID_Fatal, 'Cannot use full summation-frequency 2nd-order wave kinematics for linearization. Set WvSumQTF=FALSE.', ErrStat, ErrMsg, RoutineName ) - end if - if ( InputFileData%PotMod > 1 ) then call SetErrStat( ErrID_Fatal, 'Potential-flow model cannot be set to FIT for linearization. Set PotMod= 0 or 1.', ErrStat, ErrMsg, RoutineName ) end if @@ -2354,10 +1542,20 @@ SUBROUTINE HydroDynInput_ProcessInitData( InitInp, Interval, InputFileData, ErrS end if end if - - + !------------------------------------------------------------------------------------------------- + ! Strip Theory Options Section + !------------------------------------------------------------------------------------------------- + IF ( InputFileData%Morison%WaveDisp /= 0 .AND. InputFileData%Morison%WaveDisp /= 1) THEN + CALL SetErrStat( ErrID_Fatal,'WaveDisp must be 0 or 1',ErrStat,ErrMsg,RoutineName) + RETURN + END IF + IF ( InputFileData%Morison%AMMod /= 0 .AND. InputFileData%Morison%AMMod /= 1) THEN + CALL SetErrStat( ErrID_Fatal,'AMMod must be 0 or 1',ErrStat,ErrMsg,RoutineName) + RETURN + END IF + !------------------------------------------------------------------------------------------------- ! Member Joints Section @@ -2381,13 +1579,25 @@ SUBROUTINE HydroDynInput_ProcessInitData( InitInp, Interval, InputFileData, ErrS DO I = 1,InputFileData%Morison%NAxCoefs IF ( InputFileData%Morison%AxialCoefs(I)%AxCd < 0 ) THEN - CALL SetErrStat( ErrID_Fatal,'AxCd must be greater or equal to zero.',ErrStat,ErrMsg,RoutineName) + CALL SetErrStat( ErrID_Fatal,'AxCd must be greater than or equal to zero.',ErrStat,ErrMsg,RoutineName) RETURN END IF IF ( InputFileData%Morison%AxialCoefs(I)%AxCa < 0 ) THEN - CALL SetErrStat( ErrID_Fatal,'AxCa must be greater or equal to zero.',ErrStat,ErrMsg,RoutineName) + CALL SetErrStat( ErrID_Fatal,'AxCa must be greater than or equal to zero.',ErrStat,ErrMsg,RoutineName) RETURN END IF + IF ( InputFileData%Morison%AxialCoefs(I)%AxCp < 0 ) THEN + CALL SetErrStat( ErrID_Fatal,'AxCp must be greater than or equal to zero.',ErrStat,ErrMsg,RoutineName) + RETURN + END IF + IF ( InputFileData%Morison%AxialCoefs(I)%AxFDMod /= 0_IntKi .AND. InputFileData%Morison%AxialCoefs(I)%AxFDMod /= 1_IntKi ) THEN + CALL SetErrStat( ErrID_Fatal,'AxFDMod must be 0 or 1.',ErrStat,ErrMsg,RoutineName) + RETURN + END IF + IF ( InputFileData%Morison%AxialCoefs(I)%AxFDLoFSc < 0_ReKi .OR. InputFileData%Morison%AxialCoefs(I)%AxFDLoFSc > 1_ReKi ) THEN + CALL SetErrStat( ErrID_Fatal,'AxFDLoFSc must be between 0 and 1 inclusive.',ErrStat,ErrMsg,RoutineName) + RETURN + END IF ! Make sure that the current AxCoefID is not used elsewhere in the table. DO J = I+1,InputFileData%Morison%NAxCoefs @@ -2545,6 +1755,14 @@ SUBROUTINE HydroDynInput_ProcessInitData( InitInp, Interval, InputFileData, ErrS CALL SetErrStat( ErrID_Fatal,'SimplAxCaMG must be greater or equal to zero.',ErrStat,ErrMsg,RoutineName) RETURN END IF + IF ( InputFileData%Morison%SimplCb < 0 ) THEN + CALL SetErrStat( ErrID_Fatal,'SimplCb must be greater or equal to zero.',ErrStat,ErrMsg,RoutineName) + RETURN + END IF + IF ( InputFileData%Morison%SimplCbMG < 0 ) THEN + CALL SetErrStat( ErrID_Fatal,'SimplCbMG must be greater or equal to zero.',ErrStat,ErrMsg,RoutineName) + RETURN + END IF !TODO: Do we need a test for AxCp !------------------------------------------------------------------------------------------------- @@ -2622,6 +1840,14 @@ SUBROUTINE HydroDynInput_ProcessInitData( InitInp, Interval, InputFileData, ErrS CALL SetErrStat( ErrID_Fatal,'In the Depth-based hydrodynamic coefficients table, DpthAxCpMG must be greater or equal to zero.',ErrStat,ErrMsg,RoutineName) RETURN END IF + IF ( InputFileData%Morison%CoefDpths(I)%DpthCb < 0 ) THEN + CALL SetErrStat( ErrID_Fatal,'In the Depth-based hydrodynamic coefficients table, DpthCb must be greater or equal to zero.',ErrStat,ErrMsg,RoutineName) + RETURN + END IF + IF ( InputFileData%Morison%CoefDpths(I)%DpthCbMG < 0 ) THEN + CALL SetErrStat( ErrID_Fatal,'In the Depth-based hydrodynamic coefficients table, DpthCbMG must be greater or equal to zero.',ErrStat,ErrMsg,RoutineName) + RETURN + END IF END DO ! TODO: Sort the table based on depth so that a linear interpolation can be easily performed between entries. @@ -2685,19 +1911,35 @@ SUBROUTINE HydroDynInput_ProcessInitData( InitInp, Interval, InputFileData, ErrS RETURN END IF IF ( InputFileData%Morison%CoefMembers(I)%MemberAxCa1 < 0 ) THEN - CALL SetErrStat( ErrID_Fatal,'In the member-based hydrodynamic coefficients table, MemberCa1 must be greater or equal to zero.',ErrStat,ErrMsg,RoutineName) + CALL SetErrStat( ErrID_Fatal,'In the member-based hydrodynamic coefficients table, MemberAxCa1 must be greater or equal to zero.',ErrStat,ErrMsg,RoutineName) RETURN END IF IF ( InputFileData%Morison%CoefMembers(I)%MemberAxCa2 < 0 ) THEN - CALL SetErrStat( ErrID_Fatal,'In the member-based hydrodynamic coefficients table, MemberCa2 must be greater or equal to zero.',ErrStat,ErrMsg,RoutineName) + CALL SetErrStat( ErrID_Fatal,'In the member-based hydrodynamic coefficients table, MemberAxCa2 must be greater or equal to zero.',ErrStat,ErrMsg,RoutineName) RETURN END IF IF ( InputFileData%Morison%CoefMembers(I)%MemberAxCaMG1 < 0 ) THEN - CALL SetErrStat( ErrID_Fatal,'In the member-based hydrodynamic coefficients table, MemberCaMG1 must be greater or equal to zero.',ErrStat,ErrMsg,RoutineName) + CALL SetErrStat( ErrID_Fatal,'In the member-based hydrodynamic coefficients table, MemberAxCaMG1 must be greater or equal to zero.',ErrStat,ErrMsg,RoutineName) RETURN END IF IF ( InputFileData%Morison%CoefMembers(I)%MemberAxCaMG2 < 0 ) THEN - CALL SetErrStat( ErrID_Fatal,'In the member-based hydrodynamic coefficients table, MemberCaMG2 must be greater or equal to zero.',ErrStat,ErrMsg,RoutineName) + CALL SetErrStat( ErrID_Fatal,'In the member-based hydrodynamic coefficients table, MemberAxCaMG2 must be greater or equal to zero.',ErrStat,ErrMsg,RoutineName) + RETURN + END IF + IF ( InputFileData%Morison%CoefMembers(I)%MemberCb1 < 0 ) THEN + CALL SetErrStat( ErrID_Fatal,'In the member-based hydrodynamic coefficients table, MemberCb1 must be greater or equal to zero.',ErrStat,ErrMsg,RoutineName) + RETURN + END IF + IF ( InputFileData%Morison%CoefMembers(I)%MemberCb2 < 0 ) THEN + CALL SetErrStat( ErrID_Fatal,'In the member-based hydrodynamic coefficients table, MemberCb2 must be greater or equal to zero.',ErrStat,ErrMsg,RoutineName) + RETURN + END IF + IF ( InputFileData%Morison%CoefMembers(I)%MemberCbMG1 < 0 ) THEN + CALL SetErrStat( ErrID_Fatal,'In the member-based hydrodynamic coefficients table, MemberCbMG1 must be greater or equal to zero.',ErrStat,ErrMsg,RoutineName) + RETURN + END IF + IF ( InputFileData%Morison%CoefMembers(I)%MemberCbMG2 < 0 ) THEN + CALL SetErrStat( ErrID_Fatal,'In the member-based hydrodynamic coefficients table, MemberCbMG2 must be greater or equal to zero.',ErrStat,ErrMsg,RoutineName) RETURN END IF END DO @@ -2844,12 +2086,16 @@ SUBROUTINE HydroDynInput_ProcessInitData( InitInp, Interval, InputFileData, ErrS END IF END IF + IF ( InputFileData%Morison%InpMembers(I)%MHstLMod /= 0 .AND. InputFileData%Morison%InpMembers(I)%MHstLMod /= 1 .AND. InputFileData%Morison%InpMembers(I)%MHstLMod /= 2 ) THEN + CALL SetErrStat( ErrID_Fatal,'MHstLMod must be 1 for column-type hydrostatic load calculation or 2 for ship-like calculation.',ErrStat,ErrMsg,RoutineName) + RETURN + END IF + IF ( InputFileData%Morison%InpMembers(I)%PropPot .AND. InputFileData%PotMod == 0 ) THEN CALL SetErrStat( ErrID_Fatal,'A member cannot have PropPot set to TRUE if PotMod = 0 in the FLOATING PLATFORM section.',ErrStat,ErrMsg,RoutineName) RETURN END IF - END DO @@ -2911,7 +2157,7 @@ SUBROUTINE HydroDynInput_ProcessInitData( InitInp, Interval, InputFileData, ErrS CALL SetErrStat(ErrStat2, ErrMsg2,ErrStat,ErrMsg,RoutineName) IF ( ErrStat >= AbortErrLev ) RETURN ELSE - InputFileData%Morison%FilledGroups(I)%FillDens = InputFileData%Waves%WtrDens + InputFileData%Morison%FilledGroups(I)%FillDens = InitInp%WaveField%WtrDens END IF END DO @@ -2933,7 +2179,7 @@ SUBROUTINE HydroDynInput_ProcessInitData( InitInp, Interval, InputFileData, ErrS InputFileData%Morison%MGTop = -999999.0 InputFileData%Morison%MGBottom = 999999.0 - + DO I = 1,InputFileData%Morison%NMGDepths ! Store the boundaries of the marine growth zone IF ( InputFileData%Morison%MGDepths(I)%MGDpth > InputFileData%Morison%MGTop ) THEN @@ -2968,6 +2214,35 @@ SUBROUTINE HydroDynInput_ProcessInitData( InitInp, Interval, InputFileData, ErrS END IF + !------------------------------------------------------------------------------------------------- + ! Large yaw offset + !------------------------------------------------------------------------------------------------- + if (InputFileData%PtfmYMod /= 0 .AND. InputFileData%PtfmYMod /= 1) then + call SetErrStat( ErrID_Fatal,'PtfmYMod must be 0 (static platform reference yaw offset) or 1 (dynamic platform reference yaw offset).',ErrStat,ErrMsg,RoutineName) + return + end if + IF ( InputFileData%PtfmYMod .EQ. 1_IntKi ) THEN + if ( InputFileData%PtfmYCutOff <= 0.0_ReKi ) then + CALL SetErrStat( ErrID_Fatal, 'PtfmYCutOff must be greater than 0 Hz.',ErrStat,ErrMsg,RoutineName) + end if + if ( InputFileData%Morison%WaveDisp == 0 .AND. InputFileData%Morison%NMembers > 0 ) then + call SetErrStat( ErrID_Fatal,'Dynamic reference yaw offset (PtfmYMod=1) cannot be used with WaveDisp=0. Set WaveDisp=1.',ErrStat,ErrMsg,RoutineName) + return + end if + if ( InputFileData%PotMod > 0 .AND. InputFileData%WAMIT%ExctnMod == 2 ) then + call SetErrStat( ErrID_Fatal,'Dynamic reference yaw offset (PtfmYMod=1) cannot be used with state-space wave excitations. Set ExctnMod=0 or 1.', ErrStat, ErrMsg, RoutineName ) + return + end if + if ( InputFileData%PotMod > 0 .AND. InputFileData%WAMIT%NExctnHdg < 2 ) then + call SetErrStat( ErrID_Fatal, 'NExctnHdg must be greater than or equal to 2.', ErrStat, ErrMsg, RoutineName ) + return + end if + if ( InputFileData%WAMIT2%SumQTFF .OR. InputFileData%WAMIT2%DiffQTFF ) then + call SetErrStat( ErrID_Fatal, 'Dynamic reference yaw offset (PtfmYMod=1) cannot be used with full sum-frequency or difference-frequency QTFs. Set SumQTF and DiffQTF to 0.', ErrStat, ErrMsg, RoutineName ) + return + end if + END IF + !------------------------------------------------------------------------------------------------- ! Member Output List Section !------------------------------------------------------------------------------------------------- @@ -3086,31 +2361,22 @@ SUBROUTINE HydroDynInput_ProcessInitData( InitInp, Interval, InputFileData, ErrS RETURN END IF foundMask = .FALSE. - ! Extract Waves2 list - InputFileData%Waves2%NumOuts = GetWaves2Channels ( InputFileData%NUserOutputs, InputFileData%UserOutputs, InputFileData%Waves2%OutList, foundMask, ErrStat2, ErrMsg2 ); CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - -! ! Extract WAMIT2 list -! InputFileData%WAMIT2%NumOuts = GetWAMIT2Channels ( InputFileData%NUserOutputs, InputFileData%UserOutputs, InputFileData%WAMIT2%OutList, foundMask, ErrStat2, ErrMsg2 ); CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) -! + ! Extract Morison list - !foundMask = .FALSE. InputFileData%Morison%NumOuts = GetMorisonChannels ( InputFileData%NUserOutputs, InputFileData%UserOutputs, InputFileData%Morison%OutList, foundMask, ErrStat2, ErrMsg2 ); CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! Attach remaining items to the HydroDyn list - !foundMask = .FALSE. - call Allocary(InputFileData%OutList, InputFileData%NUserOutputs, "InputFileData%OutList", ErrStat2, ErrMsg2 ); CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - InputFileData%NumOuts = HDOut_GetChannels ( InputFileData%NUserOutputs, InputFileData%UserOutputs, InputFileData%OutList , foundMask, ErrStat2, ErrMsg2 ); CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + InputFileData%NumOuts = HDOut_GetChannels ( InputFileData%NUserOutputs, InputFileData%UserOutputs, InputFileData%OutList, foundMask, ErrStat2, ErrMsg2 ); CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + CALL PrintBadChannelWarning(InputFileData%NUserOutputs, InputFileData%UserOutputs , foundMask, ErrStat2, ErrMsg2 ); CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) IF (ErrStat >= AbortErrLev ) RETURN DEALLOCATE(foundMask) - ELSE ! Set number of outputs to zero InputFileData%NumOuts = 0 - InputFileData%Waves2%NumOuts = 0 InputFileData%Morison%NumOuts = 0 ! Allocate outlist with zero length @@ -3120,145 +2386,24 @@ SUBROUTINE HydroDynInput_ProcessInitData( InitInp, Interval, InputFileData, ErrS END IF ! Now that we have the sub-lists organized, lets do some additional validation. - - - - !---------------------------------------------------------- - ! Mesh-related Output List - !---------------------------------------------------------- - - IF ( InputFileData%Morison%NumOuts > 0 ) THEN - - ! Create an output list for validated outputs - ALLOCATE ( InputFileData%Morison%ValidOutList(InputFileData%Morison%NumOuts), STAT = ErrStat2 ) - IF ( ErrStat2 /= 0 ) THEN - CALL SetErrStat( ErrID_Fatal,'Error allocating valid output list array.',ErrStat,ErrMsg,RoutineName) - RETURN - END IF - - DO I =1, InputFileData%Morison%NumOuts - - InputFileData%Morison%ValidOutList(I) = CheckMeshOutput( InputFileData%Morison%OutList(I), InputFileData%Morison%NMOutputs, InputFileData%Morison%MOutLst, InputFileData%Morison%NJOutputs ) - - END DO - - END IF - - !---------------------------------------------------------- ! Populate data in sub-types from parent or other module types !---------------------------------------------------------- - ! Current - ! For wave kinematic calculations, the effective water depth is the user input water depth (positive valued) + MSL2SWL (positive when SWL is above MSL). - InputFileData%Current%WtrDpth = InputFileData%Morison%WtrDpth ! already adjusted for the MSL2SWL. - - - ! Waves - InputFileData%Waves%Gravity = InitInp%Gravity - InputFileData%Waves%UnSum = InputFileData%UnSum - ! For wave kinematic calculations, the effective water depth is the user input water depth (positive valued) + MSL2SWL (positive when SWL is above MSL). - InputFileData%Waves%WtrDpth = InputFileData%Morison%WtrDpth ! already adjusted for the MSL2SWL. - - ! Waves2 - IF (InputFileData%Waves2%WvDiffQTFF .OR. InputFileData%Waves2%WvSumQTFF ) THEN - InputFileData%Waves2%WtrDens = InputFileData%Waves%WtrDens - InputFileData%Waves2%Gravity = InitInp%Gravity - InputFileData%Waves2%UnSum = InputFileData%UnSum - InputFileData%Waves2%WtrDpth = InputFileData%Waves%WtrDpth - InputFileData%Waves2%WaveStMod = InputFileData%Waves%WaveStMod - InputFileData%Waves2%NWaveElev = InputFileData%Waves%NWaveElev - CALL AllocAry( InputFileData%Waves2%WaveElevxi, InputFileData%Waves2%NWaveElev, 'WaveElevxi' , ErrStat2, ErrMsg2) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'HydroDynInput_GetInput' ) - CALL AllocAry( InputFileData%Waves2%WaveElevyi, InputFileData%Waves2%NWaveElev, 'WaveElevyi' , ErrStat2, ErrMsg2) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'HydroDynInput_GetInput' ) - IF ( ErrStat >= AbortErrLev ) RETURN - InputFileData%Waves2%WaveElevxi = InputFileData%Waves%WaveElevxi - InputFileData%Waves2%WaveElevyi = InputFileData%Waves%WaveElevyi - ENDIF - ! WAMIT - InputFileData%WAMIT%WtrDens = InputFileData%Waves%WtrDens - InputFileData%WAMIT%WaveMod = InputFileData%Waves%WaveMod - InputFileData%WAMIT%OutAll = InputFileData%OutAll InputFileData%WAMIT%HasWAMIT = InputFileData%PotMod == 1 ! WAMIT2 - InputFileData%WAMIT2%WtrDens = InputFileData%Waves%WtrDens - InputFileData%WAMIT2%WaveMod = InputFileData%Waves%WaveMod InputFileData%WAMIT2%HasWAMIT = InputFileData%PotMod == 1 ! Morison InputFileData%Morison%UnSum = InputFileData%UnSum InputFileData%Morison%Gravity = InitInp%Gravity - InputFileData%Morison%WtrDens = InputFileData%Waves%WtrDens - InputFileData%Morison%OutAll = InputFileData%OutAll ! Process the input geometry and generate the simulation mesh representation - call Morison_GenerateSimulationNodes( InputFileData%Morison%MSL2SWL, InputFileData%Morison%NJoints, InputFileData%Morison%InpJoints, InputFileData%Morison%NMembers, InputFileData%Morison%InpMembers, InputFileData%Morison%NNodes, InputFileData%Morison%Nodes, errStat2, errMsg2 ) + call Morison_GenerateSimulationNodes( InitInp%WaveField%MSL2SWL, InputFileData%Morison%NJoints, InputFileData%Morison%InpJoints, InputFileData%Morison%NMembers, InputFileData%Morison%InpMembers, InputFileData%Morison%NNodes, InputFileData%Morison%Nodes, errStat2, errMsg2 ) !CALL Morison_ProcessMorisonGeometry( InputFileData%Morison, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'HydroDynInput_GetInput' ) IF ( ErrStat >= AbortErrLev ) RETURN - ! Set the number and global Z locations for the X and Y components of the current velocities - InputFileData%Current%NMorisonNodes = InputFileData%Morison%NNodes - - ALLOCATE ( InputFileData%Current%MorisonNodezi(InputFileData%Morison%NNodes), STAT = ErrStat2 ) - IF ( ErrStat2 /= ErrID_None ) THEN - CALL SetErrStat( ErrID_Fatal,'Error allocating space for MorisonNodezi array.',ErrStat,ErrMsg,RoutineName) - RETURN - END IF - - - - ! Establish the number and locations where the wave kinematics will be computed - InputFileData%Waves%NWaveKin = InputFileData%Morison%NNodes ! Number of points where the incident wave kinematics will be computed (-) - ALLOCATE ( InputFileData%Waves%WaveKinxi(InputFileData%Waves%NWaveKin), STAT = ErrStat2 ) - IF ( ErrStat2 /= ErrID_None ) THEN - CALL SetErrStat( ErrID_Fatal,'Error allocating space for WaveKinxi array.',ErrStat,ErrMsg,RoutineName) - - RETURN - END IF - ALLOCATE ( InputFileData%Waves%WaveKinyi(InputFileData%Waves%NWaveKin), STAT = ErrStat2 ) - IF ( ErrStat2 /= ErrID_None ) THEN - CALL SetErrStat( ErrID_Fatal,'Error allocating space for WaveKinyi array.',ErrStat,ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE ( InputFileData%Waves%WaveKinzi(InputFileData%Waves%NWaveKin), STAT = ErrStat2 ) - IF ( ErrStat2 /= ErrID_None ) THEN - CALL SetErrStat( ErrID_Fatal,'Error allocating space for WaveKinzi array.',ErrStat,ErrMsg,RoutineName) - RETURN - END IF - DO I=1,InputFileData%Morison%NNodes - InputFileData%Waves%WaveKinxi(I) = InputFileData%Morison%Nodes(I)%Position(1) ! xi-coordinates for points where the incident wave kinematics will be computed; - InputFileData%Waves%WaveKinyi(I) = InputFileData%Morison%Nodes(I)%Position(2) ! yi-coordinates for points where the incident wave kinematics will be computed; - InputFileData%Waves%WaveKinzi(I) = InputFileData%Morison%Nodes(I)%Position(3) ! zi-coordinates for points where the incident wave kinematics will be computed; - InputFileData%Current%MorisonNodezi(I) = InputFileData%Waves%WaveKinzi(I) - END DO - - ! If we are using the Waves module, the node information must be copied over. - InputFileData%Waves2%NWaveKin = InputFileData%Waves%NWaveKin ! Number of points where the incident wave kinematics will be computed (-) - IF ( InputFileData%Waves2%WvDiffQTFF .OR. InputFileData%Waves2%WvSumQTFF ) THEN - ALLOCATE ( InputFileData%Waves2%WaveKinxi(InputFileData%Waves2%NWaveKin), STAT = ErrStat2 ) - IF ( ErrStat2 /= ErrID_None ) THEN - CALL SetErrStat( ErrID_Fatal,'Error allocating space for WaveKinxi array for Waves2 module.',ErrStat,ErrMsg,RoutineName) - - RETURN - END IF - ALLOCATE ( InputFileData%Waves2%WaveKinyi(InputFileData%Waves2%NWaveKin), STAT = ErrStat2 ) - IF ( ErrStat2 /= ErrID_None ) THEN - CALL SetErrStat( ErrID_Fatal,'Error allocating space for WaveKinyi array for Waves2 module.',ErrStat,ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE ( InputFileData%Waves2%WaveKinzi(InputFileData%Waves2%NWaveKin), STAT = ErrStat2 ) - IF ( ErrStat2 /= ErrID_None ) THEN - CALL SetErrStat( ErrID_Fatal,'Error allocating space for WaveKinzi array for Waves2 module.',ErrStat,ErrMsg,RoutineName) - RETURN - END IF - - InputFileData%Waves2%WaveKinxi = InputFileData%Waves%WaveKinxi - InputFileData%Waves2%WaveKinyi = InputFileData%Waves%WaveKinyi - InputFileData%Waves2%WaveKinzi = InputFileData%Waves%WaveKinzi - - ENDIF END SUBROUTINE HydroDynInput_ProcessInitData diff --git a/modules/hydrodyn/src/HydroDyn_Output.f90 b/modules/hydrodyn/src/HydroDyn_Output.f90 index 39addf3406..113e7048bf 100644 --- a/modules/hydrodyn/src/HydroDyn_Output.f90 +++ b/modules/hydrodyn/src/HydroDyn_Output.f90 @@ -25,6 +25,7 @@ MODULE HydroDyn_Output USE HydroDyn_Types !USE HydroDyn_Output_Types USE Waves + USE YawOffset IMPLICIT NONE PRIVATE @@ -572,46 +573,12 @@ MODULE HydroDyn_Output INTEGER(IntKi), PARAMETER :: B9WvsM2zi = 510 - ! Wave Elevations: - - INTEGER(IntKi), PARAMETER :: Wave1Elev = 511 - INTEGER(IntKi), PARAMETER :: Wave2Elev = 512 - INTEGER(IntKi), PARAMETER :: Wave3Elev = 513 - INTEGER(IntKi), PARAMETER :: Wave4Elev = 514 - INTEGER(IntKi), PARAMETER :: Wave5Elev = 515 - INTEGER(IntKi), PARAMETER :: Wave6Elev = 516 - INTEGER(IntKi), PARAMETER :: Wave7Elev = 517 - INTEGER(IntKi), PARAMETER :: Wave8Elev = 518 - INTEGER(IntKi), PARAMETER :: Wave9Elev = 519 - INTEGER(IntKi), PARAMETER :: Wave1Elv1 = 520 - INTEGER(IntKi), PARAMETER :: Wave2Elv1 = 521 - INTEGER(IntKi), PARAMETER :: Wave3Elv1 = 522 - INTEGER(IntKi), PARAMETER :: Wave4Elv1 = 523 - INTEGER(IntKi), PARAMETER :: Wave5Elv1 = 524 - INTEGER(IntKi), PARAMETER :: Wave6Elv1 = 525 - INTEGER(IntKi), PARAMETER :: Wave7Elv1 = 526 - INTEGER(IntKi), PARAMETER :: Wave8Elv1 = 527 - INTEGER(IntKi), PARAMETER :: Wave9Elv1 = 528 - INTEGER(IntKi), PARAMETER :: Wave1Elv2 = 529 - INTEGER(IntKi), PARAMETER :: Wave2Elv2 = 530 - INTEGER(IntKi), PARAMETER :: Wave3Elv2 = 531 - INTEGER(IntKi), PARAMETER :: Wave4Elv2 = 532 - INTEGER(IntKi), PARAMETER :: Wave5Elv2 = 533 - INTEGER(IntKi), PARAMETER :: Wave6Elv2 = 534 - INTEGER(IntKi), PARAMETER :: Wave7Elv2 = 535 - INTEGER(IntKi), PARAMETER :: Wave8Elv2 = 536 - INTEGER(IntKi), PARAMETER :: Wave9Elv2 = 537 - - ! The maximum number of output channels which can be output by the code. - INTEGER(IntKi), PARAMETER :: MaxOutPts = 537 + INTEGER(IntKi), PARAMETER, PUBLIC :: MaxOutPts = 510 !End of code generated by Matlab script Write_ChckOutLst ! =================================================================================================== - REAL(ReKi) :: AllOuts(MaxHDOutputs) ! Array of all possible outputs - - INTEGER, PARAMETER :: FHydro(6) = (/HydroFxi,HydroFyi,HydroFzi,HydroMxi,HydroMyi,HydroMzi/) @@ -682,17 +649,13 @@ MODULE HydroDyn_Output B1RAzi,B2RAzi,B3RAzi,B4RAzi,B5RAzi,B6RAzi,B7RAzi,B8RAzi,B9RAzi/), & (/9,6/))) - INTEGER, PARAMETER :: WaveElevi(9) = (/Wave1Elev,Wave2Elev,Wave3Elev,Wave4Elev,Wave5Elev,Wave6Elev,Wave7Elev,Wave8Elev,Wave9Elev/) - INTEGER, PARAMETER :: WaveElevi1(9) = (/Wave1Elv1,Wave2Elv1,Wave3Elv1,Wave4Elv1,Wave5Elv1,Wave6Elv1,Wave7Elv1,Wave8Elv1,Wave9Elv1/) - INTEGER, PARAMETER :: WaveElevi2(9) = (/Wave1Elv2,Wave2Elv2,Wave3Elv2,Wave4Elv2,Wave5Elv2,Wave6Elv2,Wave7Elv2,Wave8Elv2,Wave9Elv2/) - INTEGER, PARAMETER :: PRPMotions(6) = (/PRPSurge,PRPSway,PRPHeave,PRPRoll,PRPPitch,PRPYaw/) INTEGER, PARAMETER :: PRPVel(6) = (/PRPTVxi, PRPTVyi,PRPTVzi, PRPRVxi,PRPRVyi, PRPRVzi/) INTEGER, PARAMETER :: PRPAcc(6) = (/PRPTAxi, PRPTAyi,PRPTAzi, PRPRAxi,PRPRAyi, PRPRAzi/) - CHARACTER(OutStrLenM1), PARAMETER :: ValidParamAry(537) = (/ & ! This lists the names of the allowed parameters, which must be sorted alphabetically + CHARACTER(OutStrLenM1), PARAMETER :: ValidParamAry(510) = (/ & ! This lists the names of the allowed parameters, which must be sorted alphabetically "B1ADDFXI ","B1ADDFYI ","B1ADDFZI ","B1ADDMXI ","B1ADDMYI ","B1ADDMZI ","B1HDSFXI ","B1HDSFYI ", & "B1HDSFZI ","B1HDSMXI ","B1HDSMYI ","B1HDSMZI ","B1HEAVE ","B1PITCH ","B1RAXI ","B1RAYI ", & "B1RAZI ","B1RDTFXI ","B1RDTFYI ","B1RDTFZI ","B1RDTMXI ","B1RDTMYI ","B1RDTMZI ","B1ROLL ", & @@ -756,150 +719,7 @@ MODULE HydroDyn_Output "B9WVSM2YI","B9WVSM2ZI","B9WVSMXI ","B9WVSMYI ","B9WVSMZI ","B9YAW ","HYDROFXI ","HYDROFYI ", & "HYDROFZI ","HYDROMXI ","HYDROMYI ","HYDROMZI ","PRPHEAVE ","PRPPITCH ","PRPRAXI ","PRPRAYI ", & "PRPRAZI ","PRPROLL ","PRPRVXI ","PRPRVYI ","PRPRVZI ","PRPSURGE ","PRPSWAY ","PRPTAXI ", & - "PRPTAYI ","PRPTAZI ","PRPTVXI ","PRPTVYI ","PRPTVZI ","PRPYAW ","WAVE1ELEV","WAVE1ELV1", & - "WAVE1ELV2","WAVE2ELEV","WAVE2ELV1","WAVE2ELV2","WAVE3ELEV","WAVE3ELV1","WAVE3ELV2","WAVE4ELEV", & - "WAVE4ELV1","WAVE4ELV2","WAVE5ELEV","WAVE5ELV1","WAVE5ELV2","WAVE6ELEV","WAVE6ELV1","WAVE6ELV2", & - "WAVE7ELEV","WAVE7ELV1","WAVE7ELV2","WAVE8ELEV","WAVE8ELV1","WAVE8ELV2","WAVE9ELEV","WAVE9ELV1", & - "WAVE9ELV2"/) - INTEGER(IntKi), PARAMETER :: ParamIndxAry(537) = (/ & ! This lists the index into AllOuts(:) of the allowed parameters ValidParamAry(:) - B1AddFxi , B1AddFyi , B1AddFzi , B1AddMxi , B1AddMyi , B1AddMzi , B1HdSFxi , B1HdSFyi , & - B1HdSFzi , B1HdSMxi , B1HdSMyi , B1HdSMzi , B1Heave , B1Pitch , B1RAxi , B1RAyi , & - B1RAzi , B1RdtFxi , B1RdtFyi , B1RdtFzi , B1RdtMxi , B1RdtMyi , B1RdtMzi , B1Roll , & - B1RVxi , B1RVyi , B1RVzi , B1Surge , B1Sway , B1TAxi , B1TAyi , B1TAzi , & - B1TVxi , B1TVyi , B1TVzi , B1WvsF1xi , B1WvsF1yi , B1WvsF1zi , B1WvsF2xi , B1WvsF2yi , & - B1WvsF2zi , B1WvsFxi , B1WvsFyi , B1WvsFzi , B1WvsM1xi , B1WvsM1yi , B1WvsM1zi , B1WvsM2xi , & - B1WvsM2yi , B1WvsM2zi , B1WvsMxi , B1WvsMyi , B1WvsMzi , B1Yaw , B2AddFxi , B2AddFyi , & - B2AddFzi , B2AddMxi , B2AddMyi , B2AddMzi , B2HdSFxi , B2HdSFyi , B2HdSFzi , B2HdSMxi , & - B2HdSMyi , B2HdSMzi , B2Heave , B2Pitch , B2RAxi , B2RAyi , B2RAzi , B2RdtFxi , & - B2RdtFyi , B2RdtFzi , B2RdtMxi , B2RdtMyi , B2RdtMzi , B2Roll , B2RVxi , B2RVyi , & - B2RVzi , B2Surge , B2Sway , B2TAxi , B2TAyi , B2TAzi , B2TVxi , B2TVyi , & - B2TVzi , B2WvsF1xi , B2WvsF1yi , B2WvsF1zi , B2WvsF2xi , B2WvsF2yi , B2WvsF2zi , B2WvsFxi , & - B2WvsFyi , B2WvsFzi , B2WvsM1xi , B2WvsM1yi , B2WvsM1zi , B2WvsM2xi , B2WvsM2yi , B2WvsM2zi , & - B2WvsMxi , B2WvsMyi , B2WvsMzi , B2Yaw , B3AddFxi , B3AddFyi , B3AddFzi , B3AddMxi , & - B3AddMyi , B3AddMzi , B3HdSFxi , B3HdSFyi , B3HdSFzi , B3HdSMxi , B3HdSMyi , B3HdSMzi , & - B3Heave , B3Pitch , B3RAxi , B3RAyi , B3RAzi , B3RdtFxi , B3RdtFyi , B3RdtFzi , & - B3RdtMxi , B3RdtMyi , B3RdtMzi , B3Roll , B3RVxi , B3RVyi , B3RVzi , B3Surge , & - B3Sway , B3TAxi , B3TAyi , B3TAzi , B3TVxi , B3TVyi , B3TVzi , B3WvsF1xi , & - B3WvsF1yi , B3WvsF1zi , B3WvsF2xi , B3WvsF2yi , B3WvsF2zi , B3WvsFxi , B3WvsFyi , B3WvsFzi , & - B3WvsM1xi , B3WvsM1yi , B3WvsM1zi , B3WvsM2xi , B3WvsM2yi , B3WvsM2zi , B3WvsMxi , B3WvsMyi , & - B3WvsMzi , B3Yaw , B4AddFxi , B4AddFyi , B4AddFzi , B4AddMxi , B4AddMyi , B4AddMzi , & - B4HdSFxi , B4HdSFyi , B4HdSFzi , B4HdSMxi , B4HdSMyi , B4HdSMzi , B4Heave , B4Pitch , & - B4RAxi , B4RAyi , B4RAzi , B4RdtFxi , B4RdtFyi , B4RdtFzi , B4RdtMxi , B4RdtMyi , & - B4RdtMzi , B4Roll , B4RVxi , B4RVyi , B4RVzi , B4Surge , B4Sway , B4TAxi , & - B4TAyi , B4TAzi , B4TVxi , B4TVyi , B4TVzi , B4WvsF1xi , B4WvsF1yi , B4WvsF1zi , & - B4WvsF2xi , B4WvsF2yi , B4WvsF2zi , B4WvsFxi , B4WvsFyi , B4WvsFzi , B4WvsM1xi , B4WvsM1yi , & - B4WvsM1zi , B4WvsM2xi , B4WvsM2yi , B4WvsM2zi , B4WvsMxi , B4WvsMyi , B4WvsMzi , B4Yaw , & - B5AddFxi , B5AddFyi , B5AddFzi , B5AddMxi , B5AddMyi , B5AddMzi , B5HdSFxi , B5HdSFyi , & - B5HdSFzi , B5HdSMxi , B5HdSMyi , B5HdSMzi , B5Heave , B5Pitch , B5RAxi , B5RAyi , & - B5RAzi , B5RdtFxi , B5RdtFyi , B5RdtFzi , B5RdtMxi , B5RdtMyi , B5RdtMzi , B5Roll , & - B5RVxi , B5RVyi , B5RVzi , B5Surge , B5Sway , B5TAxi , B5TAyi , B5TAzi , & - B5TVxi , B5TVyi , B5TVzi , B5WvsF1xi , B5WvsF1yi , B5WvsF1zi , B5WvsF2xi , B5WvsF2yi , & - B5WvsF2zi , B5WvsFxi , B5WvsFyi , B5WvsFzi , B5WvsM1xi , B5WvsM1yi , B5WvsM1zi , B5WvsM2xi , & - B5WvsM2yi , B5WvsM2zi , B5WvsMxi , B5WvsMyi , B5WvsMzi , B5Yaw , B6AddFxi , B6AddFyi , & - B6AddFzi , B6AddMxi , B6AddMyi , B6AddMzi , B6HdSFxi , B6HdSFyi , B6HdSFzi , B6HdSMxi , & - B6HdSMyi , B6HdSMzi , B6Heave , B6Pitch , B6RAxi , B6RAyi , B6RAzi , B6RdtFxi , & - B6RdtFyi , B6RdtFzi , B6RdtMxi , B6RdtMyi , B6RdtMzi , B6Roll , B6RVxi , B6RVyi , & - B6RVzi , B6Surge , B6Sway , B6TAxi , B6TAyi , B6TAzi , B6TVxi , B6TVyi , & - B6TVzi , B6WvsF1xi , B6WvsF1yi , B6WvsF1zi , B6WvsF2xi , B6WvsF2yi , B6WvsF2zi , B6WvsFxi , & - B6WvsFyi , B6WvsFzi , B6WvsM1xi , B6WvsM1yi , B6WvsM1zi , B6WvsM2xi , B6WvsM2yi , B6WvsM2zi , & - B6WvsMxi , B6WvsMyi , B6WvsMzi , B6Yaw , B7AddFxi , B7AddFyi , B7AddFzi , B7AddMxi , & - B7AddMyi , B7AddMzi , B7HdSFxi , B7HdSFyi , B7HdSFzi , B7HdSMxi , B7HdSMyi , B7HdSMzi , & - B7Heave , B7Pitch , B7RAxi , B7RAyi , B7RAzi , B7RdtFxi , B7RdtFyi , B7RdtFzi , & - B7RdtMxi , B7RdtMyi , B7RdtMzi , B7Roll , B7RVxi , B7RVyi , B7RVzi , B7Surge , & - B7Sway , B7TAxi , B7TAyi , B7TAzi , B7TVxi , B7TVyi , B7TVzi , B7WvsF1xi , & - B7WvsF1yi , B7WvsF1zi , B7WvsF2xi , B7WvsF2yi , B7WvsF2zi , B7WvsFxi , B7WvsFyi , B7WvsFzi , & - B7WvsM1xi , B7WvsM1yi , B7WvsM1zi , B7WvsM2xi , B7WvsM2yi , B7WvsM2zi , B7WvsMxi , B7WvsMyi , & - B7WvsMzi , B7Yaw , B8AddFxi , B8AddFyi , B8AddFzi , B8AddMxi , B8AddMyi , B8AddMzi , & - B8HdSFxi , B8HdSFyi , B8HdSFzi , B8HdSMxi , B8HdSMyi , B8HdSMzi , B8Heave , B8Pitch , & - B8RAxi , B8RAyi , B8RAzi , B8RdtFxi , B8RdtFyi , B8RdtFzi , B8RdtMxi , B8RdtMyi , & - B8RdtMzi , B8Roll , B8RVxi , B8RVyi , B8RVzi , B8Surge , B8Sway , B8TAxi , & - B8TAyi , B8TAzi , B8TVxi , B8TVyi , B8TVzi , B8WvsF1xi , B8WvsF1yi , B8WvsF1zi , & - B8WvsF2xi , B8WvsF2yi , B8WvsF2zi , B8WvsFxi , B8WvsFyi , B8WvsFzi , B8WvsM1xi , B8WvsM1yi , & - B8WvsM1zi , B8WvsM2xi , B8WvsM2yi , B8WvsM2zi , B8WvsMxi , B8WvsMyi , B8WvsMzi , B8Yaw , & - B9AddFxi , B9AddFyi , B9AddFzi , B9AddMxi , B9AddMyi , B9AddMzi , B9HdSFxi , B9HdSFyi , & - B9HdSFzi , B9HdSMxi , B9HdSMyi , B9HdSMzi , B9Heave , B9Pitch , B9RAxi , B9RAyi , & - B9RAzi , B9RdtFxi , B9RdtFyi , B9RdtFzi , B9RdtMxi , B9RdtMyi , B9RdtMzi , B9Roll , & - B9RVxi , B9RVyi , B9RVzi , B9Surge , B9Sway , B9TAxi , B9TAyi , B9TAzi , & - B9TVxi , B9TVyi , B9TVzi , B9WvsF1xi , B9WvsF1yi , B9WvsF1zi , B9WvsF2xi , B9WvsF2yi , & - B9WvsF2zi , B9WvsFxi , B9WvsFyi , B9WvsFzi , B9WvsM1xi , B9WvsM1yi , B9WvsM1zi , B9WvsM2xi , & - B9WvsM2yi , B9WvsM2zi , B9WvsMxi , B9WvsMyi , B9WvsMzi , B9Yaw , HydroFxi , HydroFyi , & - HydroFzi , HydroMxi , HydroMyi , HydroMzi , PRPHeave , PRPPitch , PRPRAxi , PRPRAyi , & - PRPRAzi , PRPRoll , PRPRVxi , PRPRVyi , PRPRVzi , PRPSurge , PRPSway , PRPTAxi , & - PRPTAyi , PRPTAzi , PRPTVxi , PRPTVyi , PRPTVzi , PRPYaw , Wave1Elev , Wave1Elv1 , & - Wave1Elv2 , Wave2Elev , Wave2Elv1 , Wave2Elv2 , Wave3Elev , Wave3Elv1 , Wave3Elv2 , Wave4Elev , & - Wave4Elv1 , Wave4Elv2 , Wave5Elev , Wave5Elv1 , Wave5Elv2 , Wave6Elev , Wave6Elv1 , Wave6Elv2 , & - Wave7Elev , Wave7Elv1 , Wave7Elv2 , Wave8Elev , Wave8Elv1 , Wave8Elv2 , Wave9Elev , Wave9Elv1 , & - Wave9Elv2 /) - CHARACTER(ChanLen), PARAMETER :: ParamUnitsAry(537) = (/ & ! This lists the units corresponding to the allowed parameters - "(N) ","(N) ","(N) ","(N-m) ","(N-m) ","(N-m) ","(N) ","(N) ", & - "(N) ","(N-m) ","(N-m) ","(N-m) ","(m) ","(rad) ","(rad/s^2)","(rad/s^2)", & - "(rad/s^2)","(N) ","(N) ","(N) ","(N-m) ","(N-m) ","(N-m) ","(rad) ", & - "(rad/s) ","(rad/s) ","(rad/s) ","(m) ","(m) ","(m/s^2) ","(m/s^2) ","(m/s^2) ", & - "(m/s) ","(m/s) ","(m/s) ","(N) ","(N) ","(N) ","(N) ","(N) ", & - "(N) ","(N) ","(N) ","(N) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ", & - "(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ","(rad) ","(N) ","(N) ", & - "(N) ","(N-m) ","(N-m) ","(N-m) ","(N) ","(N) ","(N) ","(N-m) ", & - "(N-m) ","(N-m) ","(m) ","(rad) ","(rad/s^2)","(rad/s^2)","(rad/s^2)","(N) ", & - "(N) ","(N) ","(N-m) ","(N-m) ","(N-m) ","(rad) ","(rad/s) ","(rad/s) ", & - "(rad/s) ","(m) ","(m) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s) ","(m/s) ", & - "(m/s) ","(N) ","(N) ","(N) ","(N) ","(N) ","(N) ","(N) ", & - "(N) ","(N) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ", & - "(N-m) ","(N-m) ","(N-m) ","(rad) ","(N) ","(N) ","(N) ","(N-m) ", & - "(N-m) ","(N-m) ","(N) ","(N) ","(N) ","(N-m) ","(N-m) ","(N-m) ", & - "(m) ","(rad) ","(rad/s^2)","(rad/s^2)","(rad/s^2)","(N) ","(N) ","(N) ", & - "(N-m) ","(N-m) ","(N-m) ","(rad) ","(rad/s) ","(rad/s) ","(rad/s) ","(m) ", & - "(m) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s) ","(m/s) ","(m/s) ","(N) ", & - "(N) ","(N) ","(N) ","(N) ","(N) ","(N) ","(N) ","(N) ", & - "(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ", & - "(N-m) ","(rad) ","(N) ","(N) ","(N) ","(N-m) ","(N-m) ","(N-m) ", & - "(N) ","(N) ","(N) ","(N-m) ","(N-m) ","(N-m) ","(m) ","(rad) ", & - "(rad/s^2)","(rad/s^2)","(rad/s^2)","(N) ","(N) ","(N) ","(N-m) ","(N-m) ", & - "(N-m) ","(rad) ","(rad/s) ","(rad/s) ","(rad/s) ","(m) ","(m) ","(m/s^2) ", & - "(m/s^2) ","(m/s^2) ","(m/s) ","(m/s) ","(m/s) ","(N) ","(N) ","(N) ", & - "(N) ","(N) ","(N) ","(N) ","(N) ","(N) ","(N-m) ","(N-m) ", & - "(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ","(rad) ", & - "(N) ","(N) ","(N) ","(N-m) ","(N-m) ","(N-m) ","(N) ","(N) ", & - "(N) ","(N-m) ","(N-m) ","(N-m) ","(m) ","(rad) ","(rad/s^2)","(rad/s^2)", & - "(rad/s^2)","(N) ","(N) ","(N) ","(N-m) ","(N-m) ","(N-m) ","(rad) ", & - "(rad/s) ","(rad/s) ","(rad/s) ","(m) ","(m) ","(m/s^2) ","(m/s^2) ","(m/s^2) ", & - "(m/s) ","(m/s) ","(m/s) ","(N) ","(N) ","(N) ","(N) ","(N) ", & - "(N) ","(N) ","(N) ","(N) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ", & - "(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ","(rad) ","(N) ","(N) ", & - "(N) ","(N-m) ","(N-m) ","(N-m) ","(N) ","(N) ","(N) ","(N-m) ", & - "(N-m) ","(N-m) ","(m) ","(rad) ","(rad/s^2)","(rad/s^2)","(rad/s^2)","(N) ", & - "(N) ","(N) ","(N-m) ","(N-m) ","(N-m) ","(rad) ","(rad/s) ","(rad/s) ", & - "(rad/s) ","(m) ","(m) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s) ","(m/s) ", & - "(m/s) ","(N) ","(N) ","(N) ","(N) ","(N) ","(N) ","(N) ", & - "(N) ","(N) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ", & - "(N-m) ","(N-m) ","(N-m) ","(rad) ","(N) ","(N) ","(N) ","(N-m) ", & - "(N-m) ","(N-m) ","(N) ","(N) ","(N) ","(N-m) ","(N-m) ","(N-m) ", & - "(m) ","(rad) ","(rad/s^2)","(rad/s^2)","(rad/s^2)","(N) ","(N) ","(N) ", & - "(N-m) ","(N-m) ","(N-m) ","(rad) ","(rad/s) ","(rad/s) ","(rad/s) ","(m) ", & - "(m) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s) ","(m/s) ","(m/s) ","(N) ", & - "(N) ","(N) ","(N) ","(N) ","(N) ","(N) ","(N) ","(N) ", & - "(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ", & - "(N-m) ","(rad) ","(N) ","(N) ","(N) ","(N-m) ","(N-m) ","(N-m) ", & - "(N) ","(N) ","(N) ","(N-m) ","(N-m) ","(N-m) ","(m) ","(rad) ", & - "(rad/s^2)","(rad/s^2)","(rad/s^2)","(N) ","(N) ","(N) ","(N-m) ","(N-m) ", & - "(N-m) ","(rad) ","(rad/s) ","(rad/s) ","(rad/s) ","(m) ","(m) ","(m/s^2) ", & - "(m/s^2) ","(m/s^2) ","(m/s) ","(m/s) ","(m/s) ","(N) ","(N) ","(N) ", & - "(N) ","(N) ","(N) ","(N) ","(N) ","(N) ","(N-m) ","(N-m) ", & - "(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ","(rad) ", & - "(N) ","(N) ","(N) ","(N-m) ","(N-m) ","(N-m) ","(N) ","(N) ", & - "(N) ","(N-m) ","(N-m) ","(N-m) ","(m) ","(rad) ","(rad/s^2)","(rad/s^2)", & - "(rad/s^2)","(N) ","(N) ","(N) ","(N-m) ","(N-m) ","(N-m) ","(rad) ", & - "(rad/s) ","(rad/s) ","(rad/s) ","(m) ","(m) ","(m/s^2) ","(m/s^2) ","(m/s^2) ", & - "(m/s) ","(m/s) ","(m/s) ","(N) ","(N) ","(N) ","(N) ","(N) ", & - "(N) ","(N) ","(N) ","(N) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ", & - "(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ","(rad) ","(N) ","(N) ", & - "(N) ","(N-m) ","(N-m) ","(N-m) ","(m) ","(rad) ","(rad/s^2)","(rad/s^2)", & - "(rad/s^2)","(rad) ","(rad/s) ","(rad/s) ","(rad/s) ","(m) ","(m) ","(m/s^2) ", & - "(m/s^2) ","(m/s^2) ","(m/s) ","(m/s) ","(m/s) ","(rad) ","(m) ","(m) ", & - "(m) ","(m) ","(m) ","(m) ","(m) ","(m) ","(m) ","(m) ", & - "(m) ","(m) ","(m) ","(m) ","(m) ","(m) ","(m) ","(m) ", & - "(m) ","(m) ","(m) ","(m) ","(m) ","(m) ","(m) ","(m) ", & - "(m) "/) - + "PRPTAYI ","PRPTAZI ","PRPTVXI ","PRPTVYI ","PRPTVZI ","PRPYAW "/) ! ..... Public Subroutines ................................................................................................... PUBLIC :: HDOut_CloseSum @@ -910,7 +730,6 @@ MODULE HydroDyn_Output PUBLIC :: HDOut_CloseOutput PUBLIC :: HDOut_GetChannels PUBLIC :: HDOUT_Init - PUBLIC :: HDOut_WriteWvKinFiles CONTAINS @@ -978,10 +797,8 @@ SUBROUTINE HDOut_OpenSum( UnSum, SummaryName, HD_Prog, ErrStat, ErrMsg ) ErrStat = ErrID_None ErrMsg = "" - !$OMP critical(fileopen) CALL GetNewUnit( UnSum ) - CALL OpenFOutFile ( UnSum, SummaryName, ErrStat, ErrMsg ) !$OMP end critical(fileopen) IF (ErrStat >=AbortErrLev) RETURN @@ -994,163 +811,33 @@ SUBROUTINE HDOut_OpenSum( UnSum, SummaryName, HD_Prog, ErrStat, ErrMsg ) END SUBROUTINE HDOut_OpenSum -!==================================================================================================== -SUBROUTINE HDOut_WriteWvKinFiles( Rootname, HD_Prog, NStepWave, NNodes, NWaveElev, nodeInWater, WaveElev, WaveKinzi, & - WaveTime, WaveVel, WaveAcc, WaveDynP, ErrStat, ErrMsg ) - ! Passed variables - CHARACTER(*), INTENT( IN ) :: Rootname ! filename including full path, minus any file extension. - TYPE(ProgDesc), INTENT( IN ) :: HD_Prog ! the name/version/date of the hydrodynamics program - INTEGER, INTENT( IN ) :: NStepWave ! Number of time steps for the wave kinematics arrays - INTEGER, INTENT( IN ) :: NNodes ! Number of simulation nodes for the wave kinematics arrays - INTEGER, INTENT( IN ) :: NWaveElev ! Number of locations where wave elevations were requested - INTEGER, INTENT( IN ) :: nodeInWater(0:,: ) ! - REAL(SiKi), INTENT( IN ) :: WaveElev (0:,: ) ! Instantaneous wave elevations at requested locations - REAL(SiKi), INTENT( IN ) :: WaveKinzi(: ) ! The z-location of all the nodes - REAL(SiKi), INTENT( IN ) :: WaveTime (0: ) ! The time values for the wave kinematics (time) - REAL(SiKi), INTENT( IN ) :: WaveVel (0:,:,:) ! The wave velocities (time,node,component) - REAL(SiKi), INTENT( IN ) :: WaveAcc (0:,:,:) ! The wave accelerations (time,node,component) - REAL(SiKi), INTENT( IN ) :: WaveDynP(0:,:) ! The wave dynamic pressure (time,node) - 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 :: UnWv ! file unit for writing the various wave kinematics files - CHARACTER(1024) :: WvName ! complete filename for one of the output files - CHARACTER(5) :: extension(7) - INTEGER :: i, j, iFile - CHARACTER(64) :: Frmt, Sfrmt - CHARACTER(ChanLen) :: Delim - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - - extension = (/'.Vxi ','.Vyi ','.Vzi ','.Axi ','.Ayi ','.Azi ','.DynP'/) - Delim = '' - !Frmt = '('//TRIM(Int2LStr(NNodes))//'(:,A,ES11.4e2))' - Frmt = '(:,A,ES11.4e2)' - Sfrmt = '(:,A,A11)' - - - - DO iFile = 1,7 - - !$OMP critical(fileopen) - CALL GetNewUnit( UnWv ) - - WvName = Rootname // TRIM(extension(iFile)) - CALL OpenFOutFile ( UnWv, WvName, ErrStat, ErrMsg ) - !$OMP end critical(fileopen) - IF (ErrStat >=AbortErrLev) RETURN - - - - ! Write the summary file header - ! WRITE (UnWv,'(/,A/)', IOSTAT=ErrStat) 'This wave kinematics file was generated by '//TRIM( HD_Prog%Name )//& - WRITE (UnWv,'(A)', IOSTAT=ErrStat) 'This wave kinematics file was generated by '//TRIM( HD_Prog%Name )//& - ' '//TRIM( HD_Prog%Ver )//' on '//CurDate()//' at '//CurTime()//'.' - - - DO i= 0,NStepWave-1 - DO j = 1, NNodes - IF ( nodeInWater(i,j) == 0 ) THEN - WRITE(UnWv,Sfrmt,ADVANCE='no') Delim, '##########' - ELSE - - SELECT CASE (iFile) - CASE (1) - WRITE(UnWv,Frmt,ADVANCE='no') Delim, WaveVel (i,j,1) - CASE (2) - WRITE(UnWv,Frmt,ADVANCE='no') Delim, WaveVel (i,j,2) - CASE (3) - WRITE(UnWv,Frmt,ADVANCE='no') Delim, WaveVel (i,j,3) - CASE (4) - WRITE(UnWv,Frmt,ADVANCE='no') Delim, WaveAcc (i,j,1) - CASE (5) - WRITE(UnWv,Frmt,ADVANCE='no') Delim, WaveAcc (i,j,2) - CASE (6) - WRITE(UnWv,Frmt,ADVANCE='no') Delim, WaveAcc (i,j,3) - CASE (7) - WRITE(UnWv,Frmt,ADVANCE='no') Delim, WaveDynP(i,j ) - END SELECT - END IF - END DO - WRITE (UnWv,'()', IOSTAT=ErrStat) ! write the line return - END DO - - CLOSE( UnWv, IOSTAT=ErrStat ) - IF (ErrStat /= 0) THEN - ErrStat = ErrID_Fatal - ErrMsg = 'Problem closing wave kinematics file' - RETURN - END IF - END DO - - IF ( NWaveElev > 0 ) THEN - - !$OMP critical(fileopen) - CALL GetNewUnit( UnWv ) - - WvName = Rootname // '.Elev' - CALL OpenFOutFile ( UnWv, WvName, ErrStat, ErrMsg ) - !$OMP end critical(fileopen) - IF (ErrStat >=AbortErrLev) RETURN - - - - ! Write the summary file header - WRITE (UnWv,'(A)', IOSTAT=ErrStat) 'This wave kinematics file was generated by '//TRIM( HD_Prog%Name )//& - ' '//TRIM( HD_Prog%Ver )//' on '//CurDate()//' at '//CurTime()//'.' - - - DO i= 0,NStepWave-1 - - Frmt = '('//TRIM(Int2LStr(NWaveElev))//'(:,A,ES11.4e2))' - WRITE(UnWv,Frmt) ( Delim, WaveElev(i,j) , j=1,NWaveElev ) - - END DO - - CLOSE( UnWv, IOSTAT=ErrStat ) - IF (ErrStat /= 0) THEN - ErrStat = ErrID_Fatal - ErrMsg = 'Problem closing wave elevations file' - RETURN - END IF - - END IF - - -END SUBROUTINE HDOut_WriteWvKinFiles !==================================================================================================== -SUBROUTINE HDOut_MapOutputs( CurrentTime, p, y, m_WAMIT, m_WAMIT2, NWaveElev, WaveElev, WaveElev1, WaveElev2, F_Add, F_Waves, F_Hydro, PRPmesh, q, qdot, qdotdot, AllOuts, ErrStat, ErrMsg ) +SUBROUTINE HDOut_MapOutputs( p, y, m_WAMIT, m_WAMIT2, F_Add, F_Waves, F_Hydro, PRPmesh, PtfmRefY, q, qdot, qdotdot, ErrStat, ErrMsg ) ! This subroutine writes the data stored in the y variable to the correct indexed postions in WriteOutput ! This is called by HydroDyn_CalcOutput() at each time step. !---------------------------------------------------------------------------------------------------- - REAL(DbKi), INTENT( IN ) :: CurrentTime ! Current simulation time in seconds TYPE(HydroDyn_ParameterType), INTENT( IN ) :: p ! HydroDyn's parameter data TYPE(HydroDyn_OutputType), INTENT( INOUT ) :: y ! HydroDyn's output data type(WAMIT_MiscVarType), ALLOCATABLE, intent( in ) :: m_WAMIT(:) ! WAMIT object's MiscVar data type(WAMIT2_MiscVarType), ALLOCATABLE, intent( in ) :: m_WAMIT2(:) ! WAMIT2 object's MiscVar data - INTEGER, INTENT( IN ) :: NWaveElev ! Number of wave elevation locations to output - REAL(ReKi), INTENT( IN ) :: WaveElev(:) ! Instantaneous total elevation of incident waves at each of the NWaveElev points where the incident wave elevations can be output (meters) - REAL(ReKi), INTENT( IN ) :: WaveElev1(:) ! Instantaneous first order elevation of incident waves at each of the NWaveElev points where the incident wave elevations can be output (meters) - REAL(ReKi), INTENT( IN ) :: WaveElev2(:) ! Instantaneous second order elevation of incident waves at each of the NWaveElev points where the incident wave elevations can be output (meters) REAL(ReKi), ALLOCATABLE, INTENT( IN ) :: F_Add(:) REAL(ReKi), ALLOCATABLE, INTENT( IN ) :: F_Waves(:) REAL(ReKi), INTENT( IN ) :: F_Hydro(:) ! All hydrodynamic loads integrated at (0,0,0) in the global coordinate system type(MeshType), INTENT( IN ) :: PRPmesh ! the PRP mesh -- for motions output + REAL(ReKi), INTENT( IN ) :: PtfmRefY ! the PRP reference yaw offset REAL(ReKi), INTENT( IN ) :: q(:) ! WAMIT body translations and rotations REAL(ReKi), INTENT( IN ) :: qdot(:) ! WAMIT body translational and rotational velocities REAL(ReKi), INTENT( IN ) :: qdotdot(:) ! WAMIT body translational and rotational accelerations - REAL(ReKi), INTENT( OUT ) :: AllOuts(MaxHDOutputs) INTEGER(IntKi), INTENT( OUT ) :: ErrStat ! Error status of the operation CHARACTER(*), INTENT( OUT ) :: ErrMsg ! Error message if ErrStat /= ErrID_None - INTEGER :: I, iBody, startIndx, endIndx - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - real(ReKi) :: rotdisp(3) + INTEGER :: i, iBody, startIndx, endIndx + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + real(ReKi) :: rotdisp(3) + REAL(ReKi) :: AllOuts(MaxOutPts) ErrStat = ErrID_None ErrMsg = "" @@ -1158,8 +845,9 @@ SUBROUTINE HDOut_MapOutputs( CurrentTime, p, y, m_WAMIT, m_WAMIT2, NWaveElev, Wa ! Initialize all unused channels to zero (in case they don't get set, but are still requested) AllOuts = 0.0_ReKi - rotdisp = GetSmllRotAngs ( PRPMesh%Orientation(:,:,1), ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'HDOut_MapOutputs' ) + ! rotdisp = GetRotAngs ( PtfmRefY, PRPMesh%Orientation(:,:,1), ErrStat2, ErrMsg2 ) + ! CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'HDOut_MapOutputs' ) + rotdisp = EulerExtractZYX(PRPMesh%Orientation(:,:,1)) AllOuts(PRPMotions) = reshape((/real(PRPMesh%TranslationDisp(:,1),ReKi),rotdisp(:)/),(/6/)) AllOuts(PRPVel) = reshape((/PRPMesh%TranslationVel(:,1),PRPMesh%RotationVel(:,1)/),(/6/)) AllOuts(PRPAcc) = reshape((/PRPMesh%TranslationAcc(:,1),PRPMesh%RotationAcc(:,1)/),(/6/)) @@ -1204,14 +892,12 @@ SUBROUTINE HDOut_MapOutputs( CurrentTime, p, y, m_WAMIT, m_WAMIT2, NWaveElev, Wa AllOuts(FHydro ) = F_Hydro - DO I=1,NWaveElev - AllOuts(WaveElevi(I)) = WaveElev(I) - AllOuts(WaveElevi1(I))= WaveElev1(I) - AllOuts(WaveElevi2(I))= WaveElev2(I) + + DO I = 1,p%NumOuts + y%WriteOutput(I) = p%OutParam(I)%SignM * AllOuts( p%OutParam(I)%Indx ) END DO - END SUBROUTINE HDOut_MapOutputs !==================================================================================================== @@ -1234,19 +920,19 @@ SUBROUTINE HDOut_WriteOutputs( Time, y, p, Decimate, ErrStat, ErrMsg ) integer(IntKi) :: ErrStat2 ! character(ErrMsgLen) :: ErrMsg2 + ErrStat = ErrID_None + ErrMsg = '' + IF (p%UnOutFile < 0 ) RETURN ! Initialize ErrStat and determine if it makes any sense to write output !TODO: We should not have this check here, once per timestep! This should be resolved during initialization. GJH 7/7/2014 IF ( ( (.NOT. ALLOCATED( p%OutParam )) .AND. (.NOT. ALLOCATED( p%WAMIT ) ) .AND. (.NOT. ALLOCATED( p%WAMIT2 ) )& - .AND. (.NOT. ALLOCATED( p%Waves2%OutParam ) ) .AND. ( .NOT. ALLOCATED( p%Morison%OutParam ) ) ) ) THEN + .AND. ( .NOT. ALLOCATED( p%Morison%OutParam ) ) ) ) THEN ErrStat = ErrID_Warn ErrMsg = ' Cannot write output to file because there are not a valid output list.' RETURN - ELSE - ErrStat = ErrID_None - ErrMsg = '' END IF @@ -1292,7 +978,7 @@ SUBROUTINE HDOUT_Init( HydroDyn_ProgDesc, OutRootName, InputFileData, y, p, m, ! Passed variables TYPE(ProgDesc), INTENT( IN ) :: HydroDyn_ProgDesc ! - CHARACTER(1024), INTENT( IN ) :: OutRootName ! The name of the output file + CHARACTER(*), INTENT( IN ) :: OutRootName ! The name of the output file TYPE(HydroDyn_InputFile ), INTENT( IN ) :: InputFileData ! data needed to initialize the output module TYPE(HydroDyn_OutputType), INTENT( INOUT ) :: y ! This module's internal data TYPE(HydroDyn_ParameterType), INTENT( INOUT ) :: p @@ -1304,13 +990,7 @@ SUBROUTINE HDOUT_Init( HydroDyn_ProgDesc, OutRootName, InputFileData, y, p, m, ! Local variables INTEGER :: I ! Generic loop counter INTEGER :: J ! Generic loop counter - INTEGER :: iWAMIT ! loop counter over WAMIT objects -! INTEGER :: Indx ! Counts the current index into the WaveKinNd array -! CHARACTER(1024) :: OutFileName ! The name of the output file including the full path. -! CHARACTER(200) :: Frmt ! a string to hold a format statement - LOGICAL :: hasWAMITOuts ! Are there any WAMIT-related outputs LOGICAL :: hasWAMIT2Outs ! Are there any WAMIT-related outputs - LOGICAL :: hasWaves2Outs ! Are there any WAMIT-related outputs LOGICAL :: hasMorisonOuts ! Are there any Morison-related outputs @@ -1324,41 +1004,26 @@ SUBROUTINE HDOUT_Init( HydroDyn_ProgDesc, OutRootName, InputFileData, y, p, m, ErrStat = ErrID_None ErrMsg = "" - - ! Sanity check that we didn't have an issue during the programing of this module. The auto - ! generated outlist at the top of this file sets the MaxOutPts value, but HD does not use - ! that value, but rather has the maximum outputs hard coded in the HD registry file. This - ! next test will hopefully help the developer catch any issues. - if ( MaxOutPts /= MaxHDOutputs ) then - call SetErrStat(ErrID_Fatal, ' HD outputs: the number of outputs given by the Write_ChckOutList.m '// & - 'script using the xlsx file does not match the number of outputs given by the HydroDyn.txt registry '// & - 'file.', ErrStat, ErrMsg, 'HDOUT_Init') - return - endif - !------------------------------------------------------------------------------------------------- ! Check that the variables in OutList are valid !------------------------------------------------------------------------------------------------- - - CALL HDOUT_ChkOutLst( InputFileData%OutList(1:p%NumOuts), y, p, ErrStat, ErrMsg ) - IF ( ErrStat >= AbortErrLev ) RETURN + if (allocated(InputFileData%OutList)) then + CALL SetOutParam(InputFileData%OutList, p, ErrStat, ErrMsg ) + IF ( ErrStat >= AbortErrLev ) RETURN + end if ! Aggregate the sub-module initialization outputs for the glue code hasWAMIT2Outs = .FALSE. - hasWaves2Outs = .FALSE. hasMorisonOuts = .FALSE. p%NumTotalOuts = p%NumOuts m%LastOutTime = 0.0_DbKi m%Decimate = 0 p%OutDec = 1 !TODO: Remove this once the parameter has been added to the HD input file GJH 7/8/2014 - IF (ALLOCATED( p%Waves2%OutParam ) .AND. p%Waves2%NumOuts > 0) THEN - hasWaves2Outs = .TRUE. - p%NumTotalOuts = p%NumTotalOuts + p%Waves2%NumOuts - END IF + IF (ALLOCATED( p%Morison%OutParam ) .AND. p%Morison%NumOuts > 0) THEN hasMorisonOuts = .TRUE. p%NumTotalOuts = p%NumTotalOuts + p%Morison%NumOuts @@ -1399,15 +1064,7 @@ SUBROUTINE HDOUT_Init( HydroDyn_ProgDesc, OutRootName, InputFileData, y, p, m, J = p%NumOuts + 1 - - IF ( hasWaves2Outs ) THEN - DO I=1, p%Waves2%NumOuts - InitOut%WriteOutputHdr(J) = InitOut%Waves2%WriteOutputHdr(I) - InitOut%WriteOutputUnt(J) = InitOut%Waves2%WriteOutputUnt(I) - J = J + 1 - END DO - END IF - + IF ( hasMorisonOuts ) THEN DO I=1, p%Morison%NumOuts InitOut%WriteOutputHdr(J) = InitOut%Morison%WriteOutputHdr(I) @@ -1438,7 +1095,7 @@ SUBROUTINE HDOut_OpenOutput( HydroDyn_ProgDesc, OutRootName, p, InitOut, ErrSta ! Passed variables TYPE(ProgDesc) , INTENT( IN ) :: HydroDyn_ProgDesc - CHARACTER(1024), INTENT( IN ) :: OutRootName ! Root name for the output file + CHARACTER(*), INTENT( IN ) :: OutRootName ! Root name for the output file TYPE(HydroDyn_ParameterType), INTENT( INOUT ) :: p TYPE(HydroDyn_InitOutPutType ),INTENT( IN ) :: InitOut ! INTEGER, INTENT( OUT ) :: ErrStat ! a non-zero value indicates an error occurred @@ -1446,8 +1103,6 @@ SUBROUTINE HDOut_OpenOutput( HydroDyn_ProgDesc, OutRootName, p, InitOut, ErrSta ! Local variables INTEGER :: I ! Generic loop counter - INTEGER :: iWAMIT ! loop counter for WAMIT Objects -! INTEGER :: Indx ! Counts the current index into the WaveKinNd array CHARACTER(1024) :: OutFileName ! The name of the output file including the full path. CHARACTER(200) :: Frmt ! a string to hold a format statement @@ -1464,14 +1119,13 @@ SUBROUTINE HDOut_OpenOutput( HydroDyn_ProgDesc, OutRootName, p, InitOut, ErrSta !------------------------------------------------------------------------------------------------- p%UnOutFile = -1 IF ( (ALLOCATED( p%OutParam ) .AND. p%NumOuts > 0 ) .OR. & - (ALLOCATED( p%Waves2%OutParam ) .AND. p%Waves2%NumOuts > 0 ) .OR. & (ALLOCATED( p%Morison%OutParam ) .AND. p%Morison%NumOuts > 0 ) ) THEN ! Output has been requested so let's open an output file ! Open the file for output - OutFileName = TRIM(OutRootName)//'.HD.out' + OutFileName = TRIM(OutRootName)//'.out' + !$OMP critical(fileopen) CALL GetNewUnit( p%UnOutFile ) - CALL OpenFOutFile ( p%UnOutFile, OutFileName, ErrStat, ErrMsg ) !$OMP end critical(fileopen) IF (ErrStat >=AbortErrLev) RETURN @@ -1496,11 +1150,6 @@ SUBROUTINE HDOut_OpenOutput( HydroDyn_ProgDesc, OutRootName, p, InitOut, ErrSta WRITE(p%UnOutFile,Frmt,ADVANCE='no') ( p%Delim, TRIM( InitOut%WriteOutputHdr(I) ), I=1,p%NumOuts ) END IF - IF (ALLOCATED( p%Waves2%OutParam ) .AND. p%Waves2%NumOuts > 0) THEN - Frmt = '('//TRIM(Int2LStr(p%Waves2%NumOuts))//'(:,A,'//TRIM( p%OutSFmt )//'))' - WRITE(p%UnOutFile,Frmt,ADVANCE='no') ( p%Delim, TRIM( InitOut%Waves2%WriteOutputHdr(I) ), I=1,p%Waves2%NumOuts ) - END IF - IF (ALLOCATED( p%Morison%OutParam ) .AND. p%Morison%NumOuts > 0) THEN Frmt = '('//TRIM(Int2LStr(p%Morison%NumOuts))//'(:,A,'//TRIM( p%OutSFmt )//'))' WRITE(p%UnOutFile,Frmt,ADVANCE='no') ( p%Delim, TRIM( InitOut%Morison%WriteOutputHdr(I) ), I=1,p%Morison%NumOuts ) @@ -1520,11 +1169,6 @@ SUBROUTINE HDOut_OpenOutput( HydroDyn_ProgDesc, OutRootName, p, InitOut, ErrSta Frmt = '('//TRIM(Int2LStr(p%NumOuts))//'(:,A,'//TRIM( p%OutSFmt )//'))' WRITE(p%UnOutFile,Frmt,ADVANCE='no') ( p%Delim, TRIM( InitOut%WriteOutputUnt(I) ), I=1,p%NumOuts ) END IF - - IF (ALLOCATED( p%Waves2%OutParam ) .AND. p%Waves2%NumOuts > 0) THEN - Frmt = '('//TRIM(Int2LStr(p%Waves2%NumOuts))//'(:,A,'//TRIM( p%OutSFmt )//'))' - WRITE(p%UnOutFile,Frmt,ADVANCE='no') ( p%Delim, TRIM( InitOut%Waves2%WriteOutputUnt(I) ), I=1,p%Waves2%NumOuts ) - END IF IF (ALLOCATED( p%Morison%OutParam ) .AND. p%Morison%NumOuts > 0) THEN Frmt = '('//TRIM(Int2LStr(p%Morison%NumOuts))//'(:,A,'//TRIM( p%OutSFmt )//'))' @@ -1552,208 +1196,287 @@ FUNCTION HDOut_GetChannels ( NUserOutputs, UserOutputs, OutList, foundMask, !---------------------------------------------------------------------------------------------------- INTEGER, INTENT( IN ) :: NUserOutputs ! Number of user-specified output channels CHARACTER(ChanLen), INTENT( IN ) :: UserOutputs (:) ! An array holding the names of the requested output channels. - CHARACTER(ChanLen), INTENT( OUT ) :: OutList (:) ! An array holding the names of the matched WAMIT output channels. + CHARACTER(ChanLen),ALLOCATABLE,INTENT( OUT ) :: OutList (:) ! An array holding the names of the matched HD output channels. LOGICAL, INTENT( INOUT ) :: foundMask (:) ! A mask indicating whether a user requested channel belongs to a module's output channels. INTEGER, INTENT( OUT ) :: ErrStat ! a non-zero value indicates an error occurred CHARACTER(*), INTENT( OUT ) :: ErrMsg ! Error message if ErrStat /= ErrID_None - INTEGER HDOut_GetChannels ! The number of channels found in this module + INTEGER :: HDOut_GetChannels ! The number of channels found in this module ! Local variables. - INTEGER :: I ! Generic loop-counting index. + INTEGER :: I, J ! Generic loop-counting index. INTEGER :: count ! Generic loop-counting index. INTEGER :: INDX ! Index for valid arrays + INTEGER :: newFoundMask (NUserOutputs) ! A mask indicating whether a user requested channel belongs to a module's output channels - 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. - LOGICAL :: CheckOutListAgain - LOGICAL :: newFoundMask (NUserOutputs) ! A mask indicating whether a user requested channel belongs to a module's output channels. ! Initialize ErrStat - - ErrStat = ErrID_None + ErrStat = ErrID_None ErrMsg = "" - HDOut_GetChannels = 0 - newFoundMask = .FALSE. + HDOut_GetChannels = 0 + newFoundMask = 0 - DO I = 1,NUserOutputs + DO I = 1,NUserOutputs IF (.NOT. foundMask(I) ) THEN - OutListTmp = UserOutputs(I) - - CheckOutListAgain = .FALSE. - - ! Reverse the sign (+/-) of the output channel if the user prefixed the - ! channel name with a '-', '_', 'm', or 'M' character indicating "minus". - - - - IF ( INDEX( '-_', OutListTmp(1:1) ) > 0 ) THEN - - 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. - - END IF - - CALL Conv2UC( OutListTmp ) ! Convert OutListTmp to upper case - - - Indx = IndexCharAry( OutListTmp(1:OutStrLenM1), ValidParamAry ) - - IF ( CheckOutListAgain .AND. Indx < 1 ) THEN ! Let's assume that "M" really meant "minus" and then test again - ! 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 - newFoundMask(I) = .TRUE. - foundMask(I) = .TRUE. - HDOut_GetChannels = HDOut_GetChannels + 1 - - !ELSE - ! foundMask(I) = .FALSE. + Indx = FindValidChannelIndx(UserOutputs(I), ValidParamAry) + + IF ( Indx > 0 ) THEN + foundMask(I) = .TRUE. + newFoundMask(I) = newFoundMask(I) + 1 + HDOut_GetChannels = HDOut_GetChannels + 1 + END IF END IF - END IF -END DO + END DO + + CALL AllocAry(OutList, HDOut_GetChannels, 'HydroDyn OutList', ErrStat, ErrMsg) -IF ( HDOut_GetChannels > 0 ) THEN + IF ( HDOut_GetChannels > 0 .and. ErrStat < AbortErrLev) THEN + count = 1 - count = 1 + DO I = 1,NUserOutputs + DO J = 1,newFoundMask(I) ! in case an output is listed more than once + OutList(count) = UserOutputs(I) + count = count + 1 + END DO + END DO - IF ( ErrStat /= 0 ) THEN - ErrMsg = ' Error allocating memory for the OutList array in the GetHydroDynChannels function.' - ErrStat = ErrID_Fatal - RETURN END IF - DO I = 1,NUserOutputs - IF ( newFoundMask(I) ) THEN - - OutList(count) = UserOutputs(I) - count = count + 1 - END IF - - END DO - -END IF - END FUNCTION HDOut_GetChannels -!==================================================================================================== -SUBROUTINE HDOut_ChkOutLst( OutList, y, 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 that the HydroDyn module must be initialized prior to calling this function (if it -! is being used) so that it can correctly determine if the Lines outputs are valid. -!---------------------------------------------------------------------------------------------------- - - - +!********************************************************************************************************************************** +! 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 07-Sep-2022 16:14:57. +SUBROUTINE SetOutParam(OutList, p, ErrStat, ErrMsg ) +!SUBROUTINE HDOut_ChkOutLst( OutList, p, ErrStat, ErrMsg ) +!.................................................................................................................................. + + IMPLICIT NONE + ! Passed variables - - TYPE(HydroDyn_OutputType), INTENT( INOUT ) :: y ! This module's internal data - TYPE(HydroDyn_ParameterType), INTENT( INOUT ) :: p ! parameter data for this instance of the HD module -! INTEGER, INTENT(IN ) :: NumMemberNodes(*) ! the number of nodes on each of the first 9 members - 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 ! Generic loop-counting index. -! INTEGER :: J ! 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. - LOGICAL :: InvalidOutput(MaxHDOutputs) ! This array determines if the output channel is valid for this configuration - LOGICAL :: CheckOutListAgain - - !------------------------------------------------------------------------------------------------- - ! 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=ErrStat ) - IF ( ErrStat /= 0_IntKi ) THEN - ErrStat = ErrID_Fatal - ErrMsg = "Error allocating memory for the HydroDyn OutParam array." - RETURN - ELSE - ErrStat = ErrID_None - ErrMsg = "" - ENDIF + CHARACTER(ChanLen), INTENT(IN) :: OutList(:) !< The list out user-requested outputs + TYPE(HydroDyn_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 - InvalidOutput = .FALSE. + ! 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 :: InvalidOutput(0:MaxOutPts) ! This array determines if the output channel is valid for this configuration + CHARACTER(*), PARAMETER :: RoutineName = "SetOutParam" + INTEGER(IntKi), PARAMETER :: ParamIndxAry(510) = (/ & ! This lists the index into AllOuts(:) of the allowed parameters ValidParamAry(:) + B1AddFxi , B1AddFyi , B1AddFzi , B1AddMxi , B1AddMyi , B1AddMzi , B1HdSFxi , B1HdSFyi , & + B1HdSFzi , B1HdSMxi , B1HdSMyi , B1HdSMzi , B1Heave , B1Pitch , B1RAxi , B1RAyi , & + B1RAzi , B1RdtFxi , B1RdtFyi , B1RdtFzi , B1RdtMxi , B1RdtMyi , B1RdtMzi , B1Roll , & + B1RVxi , B1RVyi , B1RVzi , B1Surge , B1Sway , B1TAxi , B1TAyi , B1TAzi , & + B1TVxi , B1TVyi , B1TVzi , B1WvsF1xi , B1WvsF1yi , B1WvsF1zi , B1WvsF2xi , B1WvsF2yi , & + B1WvsF2zi , B1WvsFxi , B1WvsFyi , B1WvsFzi , B1WvsM1xi , B1WvsM1yi , B1WvsM1zi , B1WvsM2xi , & + B1WvsM2yi , B1WvsM2zi , B1WvsMxi , B1WvsMyi , B1WvsMzi , B1Yaw , B2AddFxi , B2AddFyi , & + B2AddFzi , B2AddMxi , B2AddMyi , B2AddMzi , B2HdSFxi , B2HdSFyi , B2HdSFzi , B2HdSMxi , & + B2HdSMyi , B2HdSMzi , B2Heave , B2Pitch , B2RAxi , B2RAyi , B2RAzi , B2RdtFxi , & + B2RdtFyi , B2RdtFzi , B2RdtMxi , B2RdtMyi , B2RdtMzi , B2Roll , B2RVxi , B2RVyi , & + B2RVzi , B2Surge , B2Sway , B2TAxi , B2TAyi , B2TAzi , B2TVxi , B2TVyi , & + B2TVzi , B2WvsF1xi , B2WvsF1yi , B2WvsF1zi , B2WvsF2xi , B2WvsF2yi , B2WvsF2zi , B2WvsFxi , & + B2WvsFyi , B2WvsFzi , B2WvsM1xi , B2WvsM1yi , B2WvsM1zi , B2WvsM2xi , B2WvsM2yi , B2WvsM2zi , & + B2WvsMxi , B2WvsMyi , B2WvsMzi , B2Yaw , B3AddFxi , B3AddFyi , B3AddFzi , B3AddMxi , & + B3AddMyi , B3AddMzi , B3HdSFxi , B3HdSFyi , B3HdSFzi , B3HdSMxi , B3HdSMyi , B3HdSMzi , & + B3Heave , B3Pitch , B3RAxi , B3RAyi , B3RAzi , B3RdtFxi , B3RdtFyi , B3RdtFzi , & + B3RdtMxi , B3RdtMyi , B3RdtMzi , B3Roll , B3RVxi , B3RVyi , B3RVzi , B3Surge , & + B3Sway , B3TAxi , B3TAyi , B3TAzi , B3TVxi , B3TVyi , B3TVzi , B3WvsF1xi , & + B3WvsF1yi , B3WvsF1zi , B3WvsF2xi , B3WvsF2yi , B3WvsF2zi , B3WvsFxi , B3WvsFyi , B3WvsFzi , & + B3WvsM1xi , B3WvsM1yi , B3WvsM1zi , B3WvsM2xi , B3WvsM2yi , B3WvsM2zi , B3WvsMxi , B3WvsMyi , & + B3WvsMzi , B3Yaw , B4AddFxi , B4AddFyi , B4AddFzi , B4AddMxi , B4AddMyi , B4AddMzi , & + B4HdSFxi , B4HdSFyi , B4HdSFzi , B4HdSMxi , B4HdSMyi , B4HdSMzi , B4Heave , B4Pitch , & + B4RAxi , B4RAyi , B4RAzi , B4RdtFxi , B4RdtFyi , B4RdtFzi , B4RdtMxi , B4RdtMyi , & + B4RdtMzi , B4Roll , B4RVxi , B4RVyi , B4RVzi , B4Surge , B4Sway , B4TAxi , & + B4TAyi , B4TAzi , B4TVxi , B4TVyi , B4TVzi , B4WvsF1xi , B4WvsF1yi , B4WvsF1zi , & + B4WvsF2xi , B4WvsF2yi , B4WvsF2zi , B4WvsFxi , B4WvsFyi , B4WvsFzi , B4WvsM1xi , B4WvsM1yi , & + B4WvsM1zi , B4WvsM2xi , B4WvsM2yi , B4WvsM2zi , B4WvsMxi , B4WvsMyi , B4WvsMzi , B4Yaw , & + B5AddFxi , B5AddFyi , B5AddFzi , B5AddMxi , B5AddMyi , B5AddMzi , B5HdSFxi , B5HdSFyi , & + B5HdSFzi , B5HdSMxi , B5HdSMyi , B5HdSMzi , B5Heave , B5Pitch , B5RAxi , B5RAyi , & + B5RAzi , B5RdtFxi , B5RdtFyi , B5RdtFzi , B5RdtMxi , B5RdtMyi , B5RdtMzi , B5Roll , & + B5RVxi , B5RVyi , B5RVzi , B5Surge , B5Sway , B5TAxi , B5TAyi , B5TAzi , & + B5TVxi , B5TVyi , B5TVzi , B5WvsF1xi , B5WvsF1yi , B5WvsF1zi , B5WvsF2xi , B5WvsF2yi , & + B5WvsF2zi , B5WvsFxi , B5WvsFyi , B5WvsFzi , B5WvsM1xi , B5WvsM1yi , B5WvsM1zi , B5WvsM2xi , & + B5WvsM2yi , B5WvsM2zi , B5WvsMxi , B5WvsMyi , B5WvsMzi , B5Yaw , B6AddFxi , B6AddFyi , & + B6AddFzi , B6AddMxi , B6AddMyi , B6AddMzi , B6HdSFxi , B6HdSFyi , B6HdSFzi , B6HdSMxi , & + B6HdSMyi , B6HdSMzi , B6Heave , B6Pitch , B6RAxi , B6RAyi , B6RAzi , B6RdtFxi , & + B6RdtFyi , B6RdtFzi , B6RdtMxi , B6RdtMyi , B6RdtMzi , B6Roll , B6RVxi , B6RVyi , & + B6RVzi , B6Surge , B6Sway , B6TAxi , B6TAyi , B6TAzi , B6TVxi , B6TVyi , & + B6TVzi , B6WvsF1xi , B6WvsF1yi , B6WvsF1zi , B6WvsF2xi , B6WvsF2yi , B6WvsF2zi , B6WvsFxi , & + B6WvsFyi , B6WvsFzi , B6WvsM1xi , B6WvsM1yi , B6WvsM1zi , B6WvsM2xi , B6WvsM2yi , B6WvsM2zi , & + B6WvsMxi , B6WvsMyi , B6WvsMzi , B6Yaw , B7AddFxi , B7AddFyi , B7AddFzi , B7AddMxi , & + B7AddMyi , B7AddMzi , B7HdSFxi , B7HdSFyi , B7HdSFzi , B7HdSMxi , B7HdSMyi , B7HdSMzi , & + B7Heave , B7Pitch , B7RAxi , B7RAyi , B7RAzi , B7RdtFxi , B7RdtFyi , B7RdtFzi , & + B7RdtMxi , B7RdtMyi , B7RdtMzi , B7Roll , B7RVxi , B7RVyi , B7RVzi , B7Surge , & + B7Sway , B7TAxi , B7TAyi , B7TAzi , B7TVxi , B7TVyi , B7TVzi , B7WvsF1xi , & + B7WvsF1yi , B7WvsF1zi , B7WvsF2xi , B7WvsF2yi , B7WvsF2zi , B7WvsFxi , B7WvsFyi , B7WvsFzi , & + B7WvsM1xi , B7WvsM1yi , B7WvsM1zi , B7WvsM2xi , B7WvsM2yi , B7WvsM2zi , B7WvsMxi , B7WvsMyi , & + B7WvsMzi , B7Yaw , B8AddFxi , B8AddFyi , B8AddFzi , B8AddMxi , B8AddMyi , B8AddMzi , & + B8HdSFxi , B8HdSFyi , B8HdSFzi , B8HdSMxi , B8HdSMyi , B8HdSMzi , B8Heave , B8Pitch , & + B8RAxi , B8RAyi , B8RAzi , B8RdtFxi , B8RdtFyi , B8RdtFzi , B8RdtMxi , B8RdtMyi , & + B8RdtMzi , B8Roll , B8RVxi , B8RVyi , B8RVzi , B8Surge , B8Sway , B8TAxi , & + B8TAyi , B8TAzi , B8TVxi , B8TVyi , B8TVzi , B8WvsF1xi , B8WvsF1yi , B8WvsF1zi , & + B8WvsF2xi , B8WvsF2yi , B8WvsF2zi , B8WvsFxi , B8WvsFyi , B8WvsFzi , B8WvsM1xi , B8WvsM1yi , & + B8WvsM1zi , B8WvsM2xi , B8WvsM2yi , B8WvsM2zi , B8WvsMxi , B8WvsMyi , B8WvsMzi , B8Yaw , & + B9AddFxi , B9AddFyi , B9AddFzi , B9AddMxi , B9AddMyi , B9AddMzi , B9HdSFxi , B9HdSFyi , & + B9HdSFzi , B9HdSMxi , B9HdSMyi , B9HdSMzi , B9Heave , B9Pitch , B9RAxi , B9RAyi , & + B9RAzi , B9RdtFxi , B9RdtFyi , B9RdtFzi , B9RdtMxi , B9RdtMyi , B9RdtMzi , B9Roll , & + B9RVxi , B9RVyi , B9RVzi , B9Surge , B9Sway , B9TAxi , B9TAyi , B9TAzi , & + B9TVxi , B9TVyi , B9TVzi , B9WvsF1xi , B9WvsF1yi , B9WvsF1zi , B9WvsF2xi , B9WvsF2yi , & + B9WvsF2zi , B9WvsFxi , B9WvsFyi , B9WvsFzi , B9WvsM1xi , B9WvsM1yi , B9WvsM1zi , B9WvsM2xi , & + B9WvsM2yi , B9WvsM2zi , B9WvsMxi , B9WvsMyi , B9WvsMzi , B9Yaw , HydroFxi , HydroFyi , & + HydroFzi , HydroMxi , HydroMyi , HydroMzi , PRPHeave , PRPPitch , PRPRAxi , PRPRAyi , & + PRPRAzi , PRPRoll , PRPRVxi , PRPRVyi , PRPRVzi , PRPSurge , PRPSway , PRPTAxi , & + PRPTAyi , PRPTAzi , PRPTVxi , PRPTVyi , PRPTVzi , PRPYaw /) + CHARACTER(ChanLen), PARAMETER :: ParamUnitsAry(510) = (/ character(ChanLen) :: & ! This lists the units corresponding to the allowed parameters + "(N) ","(N) ","(N) ","(N-m) ","(N-m) ","(N-m) ","(N) ","(N) ", & + "(N) ","(N-m) ","(N-m) ","(N-m) ","(m) ","(rad) ","(rad/s^2)","(rad/s^2)", & + "(rad/s^2)","(N) ","(N) ","(N) ","(N-m) ","(N-m) ","(N-m) ","(rad) ", & + "(rad/s) ","(rad/s) ","(rad/s) ","(m) ","(m) ","(m/s^2) ","(m/s^2) ","(m/s^2) ", & + "(m/s) ","(m/s) ","(m/s) ","(N) ","(N) ","(N) ","(N) ","(N) ", & + "(N) ","(N) ","(N) ","(N) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ", & + "(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ","(rad) ","(N) ","(N) ", & + "(N) ","(N-m) ","(N-m) ","(N-m) ","(N) ","(N) ","(N) ","(N-m) ", & + "(N-m) ","(N-m) ","(m) ","(rad) ","(rad/s^2)","(rad/s^2)","(rad/s^2)","(N) ", & + "(N) ","(N) ","(N-m) ","(N-m) ","(N-m) ","(rad) ","(rad/s) ","(rad/s) ", & + "(rad/s) ","(m) ","(m) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s) ","(m/s) ", & + "(m/s) ","(N) ","(N) ","(N) ","(N) ","(N) ","(N) ","(N) ", & + "(N) ","(N) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ", & + "(N-m) ","(N-m) ","(N-m) ","(rad) ","(N) ","(N) ","(N) ","(N-m) ", & + "(N-m) ","(N-m) ","(N) ","(N) ","(N) ","(N-m) ","(N-m) ","(N-m) ", & + "(m) ","(rad) ","(rad/s^2)","(rad/s^2)","(rad/s^2)","(N) ","(N) ","(N) ", & + "(N-m) ","(N-m) ","(N-m) ","(rad) ","(rad/s) ","(rad/s) ","(rad/s) ","(m) ", & + "(m) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s) ","(m/s) ","(m/s) ","(N) ", & + "(N) ","(N) ","(N) ","(N) ","(N) ","(N) ","(N) ","(N) ", & + "(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ", & + "(N-m) ","(rad) ","(N) ","(N) ","(N) ","(N-m) ","(N-m) ","(N-m) ", & + "(N) ","(N) ","(N) ","(N-m) ","(N-m) ","(N-m) ","(m) ","(rad) ", & + "(rad/s^2)","(rad/s^2)","(rad/s^2)","(N) ","(N) ","(N) ","(N-m) ","(N-m) ", & + "(N-m) ","(rad) ","(rad/s) ","(rad/s) ","(rad/s) ","(m) ","(m) ","(m/s^2) ", & + "(m/s^2) ","(m/s^2) ","(m/s) ","(m/s) ","(m/s) ","(N) ","(N) ","(N) ", & + "(N) ","(N) ","(N) ","(N) ","(N) ","(N) ","(N-m) ","(N-m) ", & + "(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ","(rad) ", & + "(N) ","(N) ","(N) ","(N-m) ","(N-m) ","(N-m) ","(N) ","(N) ", & + "(N) ","(N-m) ","(N-m) ","(N-m) ","(m) ","(rad) ","(rad/s^2)","(rad/s^2)", & + "(rad/s^2)","(N) ","(N) ","(N) ","(N-m) ","(N-m) ","(N-m) ","(rad) ", & + "(rad/s) ","(rad/s) ","(rad/s) ","(m) ","(m) ","(m/s^2) ","(m/s^2) ","(m/s^2) ", & + "(m/s) ","(m/s) ","(m/s) ","(N) ","(N) ","(N) ","(N) ","(N) ", & + "(N) ","(N) ","(N) ","(N) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ", & + "(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ","(rad) ","(N) ","(N) ", & + "(N) ","(N-m) ","(N-m) ","(N-m) ","(N) ","(N) ","(N) ","(N-m) ", & + "(N-m) ","(N-m) ","(m) ","(rad) ","(rad/s^2)","(rad/s^2)","(rad/s^2)","(N) ", & + "(N) ","(N) ","(N-m) ","(N-m) ","(N-m) ","(rad) ","(rad/s) ","(rad/s) ", & + "(rad/s) ","(m) ","(m) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s) ","(m/s) ", & + "(m/s) ","(N) ","(N) ","(N) ","(N) ","(N) ","(N) ","(N) ", & + "(N) ","(N) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ", & + "(N-m) ","(N-m) ","(N-m) ","(rad) ","(N) ","(N) ","(N) ","(N-m) ", & + "(N-m) ","(N-m) ","(N) ","(N) ","(N) ","(N-m) ","(N-m) ","(N-m) ", & + "(m) ","(rad) ","(rad/s^2)","(rad/s^2)","(rad/s^2)","(N) ","(N) ","(N) ", & + "(N-m) ","(N-m) ","(N-m) ","(rad) ","(rad/s) ","(rad/s) ","(rad/s) ","(m) ", & + "(m) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s) ","(m/s) ","(m/s) ","(N) ", & + "(N) ","(N) ","(N) ","(N) ","(N) ","(N) ","(N) ","(N) ", & + "(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ", & + "(N-m) ","(rad) ","(N) ","(N) ","(N) ","(N-m) ","(N-m) ","(N-m) ", & + "(N) ","(N) ","(N) ","(N-m) ","(N-m) ","(N-m) ","(m) ","(rad) ", & + "(rad/s^2)","(rad/s^2)","(rad/s^2)","(N) ","(N) ","(N) ","(N-m) ","(N-m) ", & + "(N-m) ","(rad) ","(rad/s) ","(rad/s) ","(rad/s) ","(m) ","(m) ","(m/s^2) ", & + "(m/s^2) ","(m/s^2) ","(m/s) ","(m/s) ","(m/s) ","(N) ","(N) ","(N) ", & + "(N) ","(N) ","(N) ","(N) ","(N) ","(N) ","(N-m) ","(N-m) ", & + "(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ","(rad) ", & + "(N) ","(N) ","(N) ","(N-m) ","(N-m) ","(N-m) ","(N) ","(N) ", & + "(N) ","(N-m) ","(N-m) ","(N-m) ","(m) ","(rad) ","(rad/s^2)","(rad/s^2)", & + "(rad/s^2)","(N) ","(N) ","(N) ","(N-m) ","(N-m) ","(N-m) ","(rad) ", & + "(rad/s) ","(rad/s) ","(rad/s) ","(m) ","(m) ","(m/s^2) ","(m/s^2) ","(m/s^2) ", & + "(m/s) ","(m/s) ","(m/s) ","(N) ","(N) ","(N) ","(N) ","(N) ", & + "(N) ","(N) ","(N) ","(N) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ", & + "(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ","(rad) ","(N) ","(N) ", & + "(N) ","(N-m) ","(N-m) ","(N-m) ","(m) ","(rad) ","(rad/s^2)","(rad/s^2)", & + "(rad/s^2)","(rad) ","(rad/s) ","(rad/s) ","(rad/s) ","(m) ","(m) ","(m/s^2) ", & + "(m/s^2) ","(m/s^2) ","(m/s) ","(m/s) ","(m/s) ","(rad) "/) - ! 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 + ! Initialize values + ErrStat = ErrID_None + ErrMsg = "" + InvalidOutput = .FALSE. - 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". +! ..... Developer must add checking for invalid inputs here: ..... +! ................. End of validity checking ................. - 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 + !------------------------------------------------------------------------------------------------- + ! 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. + !------------------------------------------------------------------------------------------------- - CALL Conv2UC( OutListTmp ) ! Convert OutListTmp to upper case + ALLOCATE ( p%OutParam(0:p%NumOuts) , STAT=ErrStat2 ) + IF ( ErrStat2 /= 0_IntKi ) THEN + CALL SetErrStat( ErrID_Fatal,"Error allocating memory for the HydroDyn OutParam array.", ErrStat, ErrMsg, RoutineName ) + RETURN + ENDIF + ! Set index, name, and units for the time output channel: - Indx = IndexCharAry( OutListTmp(1:OutStrLenM1), ValidParamAry ) + 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 - ! If it started with an "M" (CheckOutListAgain) we didn't find the value in our list (Indx < 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. - 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:) + DO I = 1,p%NumOuts - Indx = IndexCharAry( OutListTmp(1:OutStrLenM1), ValidParamAry ) - END IF + p%OutParam(I)%Name = OutList(I) + Indx = FindValidChannelIndx(OutList(I), ValidParamAry, p%OutParam(I)%SignM) 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)%Indx = 1 ! 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 = 1 ! pick any valid channel + p%OutParam(I)%Indx = 1 ! 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 - ErrStat = ErrID_Warn - ErrMsg = p%OutParam(I)%Name//" is not an available output channel. "//TRIM(ErrMsg) + CALL SetErrStat(ErrID_Warn, TRIM(p%OutParam(I)%Name)//" is not an available output channel.",ErrStat,ErrMsg,RoutineName) END IF END DO RETURN -END SUBROUTINE HDOut_ChkOutLst - +END SUBROUTINE SetOutParam +!---------------------------------------------------------------------------------------------------------------------------------- +!End of code generated by Matlab script +!********************************************************************************************************************************** !==================================================================================================== SUBROUTINE HDOut_CloseOutput ( p, ErrStat, ErrMsg ) diff --git a/modules/hydrodyn/src/HydroDyn_Types.f90 b/modules/hydrodyn/src/HydroDyn_Types.f90 index f0bbf9b23a..7d928a77b2 100644 --- a/modules/hydrodyn/src/HydroDyn_Types.f90 +++ b/modules/hydrodyn/src/HydroDyn_Types.f90 @@ -31,32 +31,30 @@ !! unpack routines associated with each defined data type. This code is automatically generated by the FAST Registry. MODULE HydroDyn_Types !--------------------------------------------------------------------------------------------------------------------------------- -USE Current_Types -USE Waves2_Types +USE Conv_Radiation_Types +USE SS_Radiation_Types +USE SS_Excitation_Types USE WAMIT_Types USE WAMIT2_Types USE Morison_Types USE NWTC_Library IMPLICIT NONE - INTEGER(IntKi), PUBLIC, PARAMETER :: MaxHDOutputs = 537 ! The maximum number of output channels supported by this module [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: MaxUserOutputs = 4583 ! Total possible number of output channels: Waves2 = 18 + SS_Excitation = 7 + SS_Radiation = 7 + Morison= 4032 + HydroDyn=519 = 4583 [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: MaxHDOutputs = 510 ! The maximum number of output channels supported by this module [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: MaxUserOutputs = 5150 ! Total possible number of output channels: SS_Excitation = 7 + SS_Radiation = 7 + Morison= 4626 + HydroDyn=510 = 5150 [-] ! ========= HydroDyn_InputFile ======= TYPE, PUBLIC :: HydroDyn_InputFile - LOGICAL :: EchoFlag !< Echo the input file [-] + LOGICAL :: EchoFlag = .false. !< Echo the input file [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: AddF0 !< Additional pre-load forces and moments (N,N,N,N-m,N-m,N-m) [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: AddCLin !< Additional stiffness matrix [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: AddBLin !< Additional linear damping matrix [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: AddBQuad !< Additional quadratic damping (drag) matrix [-] - TYPE(Waves_InitInputType) :: Waves !< Initialization data for Waves module [-] - TYPE(Waves2_InitInputType) :: Waves2 !< Initialization data for Waves module [-] - TYPE(Current_InitInputType) :: Current !< Initialization data for Current module [-] CHARACTER(1024) , DIMENSION(:), ALLOCATABLE :: PotFile !< The name of the root potential flow file (without extension for WAMIT, complete name for FIT) [-] - INTEGER(IntKi) :: nWAMITObj !< number of WAMIT input files. If NBodyMod = 1 then nPotFiles will be 1 even if NBody > 1 [-] - INTEGER(IntKi) :: vecMultiplier !< multiplier for the WAMIT vectors and matrices. If NBodyMod=1 then this = NBody, else 1 [-] - INTEGER(IntKi) :: NBody !< [>=1; only used when PotMod=1. If NBodyMod=1, the WAMIT data contains a vector of size 6*NBody x 1 and matrices of size 6*NBody x 6*NBody; if NBodyMod>1, there are NBody sets of WAMIT data each with a vector of size 6 x 1 and matrices of size 6 x 6] [-] - INTEGER(IntKi) :: NBodyMod !< Body coupling model {1: include coupling terms between each body and NBody in HydroDyn equals NBODY in WAMIT, 2: neglect coupling terms between each body and NBODY=1 with XBODY=0 in WAMIT, 3: Neglect coupling terms between each body and NBODY=1 with XBODY=/0 in WAMIT} (switch) [only used when PotMod=1] [-] + INTEGER(IntKi) :: nWAMITObj = 0_IntKi !< number of WAMIT input files. If NBodyMod = 1 then nPotFiles will be 1 even if NBody > 1 [-] + INTEGER(IntKi) :: vecMultiplier = 0_IntKi !< multiplier for the WAMIT vectors and matrices. If NBodyMod=1 then this = NBody, else 1 [-] + INTEGER(IntKi) :: NBody = 0_IntKi !< [>=1; only used when PotMod=1. If NBodyMod=1, the WAMIT data contains a vector of size 6*NBody x 1 and matrices of size 6*NBody x 6*NBody; if NBodyMod>1, there are NBody sets of WAMIT data each with a vector of size 6 x 1 and matrices of size 6 x 6] [-] + INTEGER(IntKi) :: NBodyMod = 0_IntKi !< Body coupling model {1: include coupling terms between each body and NBody in HydroDyn equals NBODY in WAMIT, 2: neglect coupling terms between each body and NBODY=1 with XBODY=0 in WAMIT, 3: Neglect coupling terms between each body and NBODY=1 with XBODY=/0 in WAMIT} (switch) [only used when PotMod=1] [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: PtfmVol0 !< [-] - LOGICAL :: HasWAMIT !< .TRUE. if using WAMIT model, .FALSE. otherwise [-] + LOGICAL :: HasWAMIT = .false. !< .TRUE. if using WAMIT model, .FALSE. otherwise [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: WAMITULEN !< [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: PtfmRefxt !< The xt offset of the body reference point(s) from (0,0,0) [1 to NBody; only used when PotMod=1; must be 0.0 if NBodyMod=2 ] [(m)] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: PtfmRefyt !< The yt offset of the body reference point(s) from (0,0,0) [1 to NBody; only used when PotMod=1; must be 0.0 if NBodyMod=2 ] [(m)] @@ -67,18 +65,21 @@ MODULE HydroDyn_Types TYPE(WAMIT_InitInputType) :: WAMIT !< Initialization data for WAMIT module [-] TYPE(WAMIT2_InitInputType) :: WAMIT2 !< Initialization data for WAMIT2 module [-] TYPE(Morison_InitInputType) :: Morison !< Initialization data for Morison module [-] - LOGICAL :: Echo !< Echo the input files to a file with the same name as the input but with a .echo extension [T/F] [-] - INTEGER(IntKi) :: PotMod !< 1 if using WAMIT model, 0 if no potential flow model, or 2 if FIT model [-] - INTEGER(IntKi) :: NUserOutputs !< Number of Hydrodyn-level requested output channels [-] + LOGICAL :: Echo = .false. !< Echo the input files to a file with the same name as the input but with a .echo extension [T/F] [-] + INTEGER(IntKi) :: PotMod = 0_IntKi !< 1 if using WAMIT model, 0 if no potential flow model, or 2 if FIT model [-] + INTEGER(IntKi) :: NUserOutputs = 0_IntKi !< Number of Hydrodyn-level requested output channels [-] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: UserOutputs !< This should really be dimensioned with MaxOutPts [-] - INTEGER(IntKi) :: OutSwtch !< Output requested channels to: [1=Hydrodyn.out 2=GlueCode.out 3=both files] [-] - LOGICAL :: OutAll !< Output all user-specified member and joint loads (only at each member end, not interior locations) [T/F] [-] - INTEGER(IntKi) :: NumOuts !< The number of outputs for this module as requested in the input file [-] + INTEGER(IntKi) :: OutSwtch = 0_IntKi !< Output requested channels to: [1=Hydrodyn.out 2=GlueCode.out 3=both files] [-] + LOGICAL :: OutAll = .false. !< Output all user-specified member and joint loads (only at each member end, not interior locations) [T/F] [-] + INTEGER(IntKi) :: NumOuts = 0_IntKi !< The number of outputs for this module as requested in the input file [-] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: OutList !< The user-requested output channel labels for this modules. This should really be dimensioned with MaxOutPts [-] - LOGICAL :: HDSum !< Generate a HydroDyn summary file [T/F] [-] - INTEGER(IntKi) :: UnSum !< File unit for the HydroDyn summary file [-1 = no summary file] [-] + LOGICAL :: HDSum = .false. !< Generate a HydroDyn summary file [T/F] [-] + INTEGER(IntKi) :: UnSum = 0_IntKi !< File unit for the HydroDyn summary file [-1 = no summary file] [-] CHARACTER(20) :: OutFmt !< Output format for numerical results [-] CHARACTER(20) :: OutSFmt !< Output format for header strings [-] + INTEGER(IntKi) :: PtfmYMod = 0_IntKi !< Large yaw model [-] + REAL(ReKi) :: PtfmRefY = 0.0_ReKi !< Initial reference yaw offset [(rad)] + REAL(ReKi) :: PtfmYCutoff = 0.0_ReKi !< Low-pass cutoff frequency for filtering the platform yaw motion to obtain the reference yaw offset [(Hz)] END TYPE HydroDyn_InputFile ! ======================= ! ========= HydroDyn_InitInputType ======= @@ -88,42 +89,25 @@ MODULE HydroDyn_Types TYPE(FileInfoType) :: PassedFileData !< If we don't use the input file, pass everything through this [-] CHARACTER(1024) :: OutRootName !< Supplied by Driver: The name of the root file (without extension) including the full path [-] LOGICAL :: Linearize = .FALSE. !< Flag that tells this module if the glue code wants to linearize. [-] - REAL(ReKi) :: Gravity !< Supplied by Driver: Gravitational acceleration [(m/s^2)] - REAL(ReKi) :: defWtrDens !< Default water density from the driver; may be overwritten [(kg/m^3)] - REAL(ReKi) :: defWtrDpth !< Default water depth from the driver; may be overwritten [m] - REAL(ReKi) :: defMSL2SWL !< Default mean sea level to still water level from the driver; may be overwritten [m] - REAL(DbKi) :: TMax !< Supplied by Driver: The total simulation time [(sec)] - LOGICAL :: HasIce !< Supplied by Driver: Whether this simulation has ice loading (flag) [-] - REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: WaveElevXY !< Supplied by Driver: X-Y locations for WaveElevation output (for visualization). First dimension is the X (1) and Y (2) coordinate. Second dimension is the point number. [m,-] - INTEGER(IntKi) :: WaveFieldMod !< Wave field handling (-) (switch) 0: use individual HydroDyn inputs without adjustment, 1: adjust wave phases based on turbine offsets from farm origin [-] - REAL(ReKi) :: PtfmLocationX !< Supplied by Driver: X coordinate of platform location in the wave field [m] - REAL(ReKi) :: PtfmLocationY !< Supplied by Driver: Y coordinate of platform location in the wave field [m] + REAL(ReKi) :: Gravity = 0.0_ReKi !< Supplied by Driver: Gravitational acceleration [(m/s^2)] + REAL(DbKi) :: TMax = 0.0_R8Ki !< Supplied by Driver: The total simulation time [(sec)] LOGICAL :: VisMeshes = .false. !< Output visualization meshes [-] + LOGICAL :: InvalidWithSSExctn = .false. !< Whether SeaState configuration is invalid with HydroDyn's state-space excitation (ExctnMod=2) [(-)] + TYPE(SeaSt_WaveFieldType) , POINTER :: WaveField => NULL() !< Pointer to SeaState wave field [-] + REAL(ReKi) , DIMENSION(1:6) :: PlatformPos = 0.0_ReKi !< Initial platform position (6 DOFs) [-] END TYPE HydroDyn_InitInputType ! ======================= ! ========= HydroDyn_InitOutputType ======= TYPE, PUBLIC :: HydroDyn_InitOutputType - TYPE(WAMIT_InitOutputType) , DIMENSION(:), ALLOCATABLE :: WAMIT !< Initialization output from the WAMIT module [-] - TYPE(WAMIT2_InitOutputType) , DIMENSION(:), ALLOCATABLE :: WAMIT2 !< Initialization output from the WAMIT2 module [-] - TYPE(Waves2_InitOutputType) :: Waves2 !< Initialization output from the Waves2 module [-] TYPE(Morison_InitOutputType) :: Morison !< Initialization output from the Morison module [-] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputHdr !< The is the list of all HD-related output channel header strings (includes all sub-module channels) [-] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputUnt !< The is the list of all HD-related output channel unit strings (includes all sub-module channels) [-] - REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: WaveElevSeries !< Wave elevation time-series at each of the points given by WaveElevXY. First dimension is the timestep. Second dimension is XY point number corresponding to second dimension of WaveElevXY. [(m)] TYPE(ProgDesc) :: Ver !< Version of HydroDyn [-] - REAL(ReKi) :: WtrDens !< Water density [(kg/m^3)] - REAL(ReKi) :: WtrDpth !< Water depth [(m)] - REAL(ReKi) :: MSL2SWL !< Offset between still-water level and mean sea level [(m)] 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 [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: DerivOrder_x !< Integer that tells FAST/MBC3 the maximum derivative order of continuous states used in linearization [-] LOGICAL , DIMENSION(:), ALLOCATABLE :: IsLoad_u !< Flag that tells FAST if the inputs used in linearization are loads (for preconditioning matrix) [-] - REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: WaveVel !< output for now just to pass to MoorDyn [-] - REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: WaveAcc !< output for now just to pass to MoorDyn [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: WaveDynP !< output for now just to pass to MoorDyn [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: WaveElev !< output for now just to pass to MoorDyn [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: WaveTime !< output for now just to pass to MoorDyn [-] END TYPE HydroDyn_InitOutputType ! ======================= ! ========= HD_ModuleMapType ======= @@ -136,96 +120,79 @@ MODULE HydroDyn_Types ! ========= HydroDyn_ContinuousStateType ======= TYPE, PUBLIC :: HydroDyn_ContinuousStateType TYPE(WAMIT_ContinuousStateType) , DIMENSION(:), ALLOCATABLE :: WAMIT !< continuous states from the wamit module [-] - TYPE(WAMIT2_ContinuousStateType) , DIMENSION(:), ALLOCATABLE :: WAMIT2 !< continuous states from the wamit2 module [-] - TYPE(Waves2_ContinuousStateType) :: Waves2 !< continuous states from the waves2 module [-] TYPE(Morison_ContinuousStateType) :: Morison !< continuous states from the Morison module [-] END TYPE HydroDyn_ContinuousStateType ! ======================= ! ========= HydroDyn_DiscreteStateType ======= TYPE, PUBLIC :: HydroDyn_DiscreteStateType TYPE(WAMIT_DiscreteStateType) , DIMENSION(:), ALLOCATABLE :: WAMIT !< discrete states from the wamit module [-] - TYPE(WAMIT2_DiscreteStateType) , DIMENSION(:), ALLOCATABLE :: WAMIT2 !< discrete states from the wamit2 module [-] - TYPE(Waves2_DiscreteStateType) :: Waves2 !< discrete states from the waves2 module [-] TYPE(Morison_DiscreteStateType) :: Morison !< discrete states from the Morison module [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: PtfmRefY !< Reference yaw position of the PRP relative to the inertial frame - Current step and two previous steps [(radians)] END TYPE HydroDyn_DiscreteStateType ! ======================= ! ========= HydroDyn_ConstraintStateType ======= TYPE, PUBLIC :: HydroDyn_ConstraintStateType TYPE(WAMIT_ConstraintStateType) :: WAMIT !< constraint states from WAMIT (may be empty) [-] - TYPE(WAMIT2_ConstraintStateType) :: WAMIT2 !< constraint states from WAMIT2 (may be empty) [-] - TYPE(Waves2_ConstraintStateType) :: Waves2 !< constraint states from the waves2 module [-] TYPE(Morison_ConstraintStateType) :: Morison !< constraint states from the Morison module [-] END TYPE HydroDyn_ConstraintStateType ! ======================= ! ========= HydroDyn_OtherStateType ======= TYPE, PUBLIC :: HydroDyn_OtherStateType TYPE(WAMIT_OtherStateType) , DIMENSION(:), ALLOCATABLE :: WAMIT !< OtherState information from the WAMIT module [-] - TYPE(WAMIT2_OtherStateType) , DIMENSION(:), ALLOCATABLE :: WAMIT2 !< OtherState information from the WAMIT2 module [-] - TYPE(Waves2_OtherStateType) :: Waves2 !< OtherState information from the Waves2 module [-] TYPE(Morison_OtherStateType) :: Morison !< OtherState information from the Morison module [-] END TYPE HydroDyn_OtherStateType ! ======================= ! ========= HydroDyn_MiscVarType ======= TYPE, PUBLIC :: HydroDyn_MiscVarType TYPE(MeshType) :: AllHdroOrigin !< An intermediate mesh used to transfer hydrodynamic loads from the various HD-related meshes to the AllHdroOrigin mesh [-] - TYPE(MeshType) :: MrsnMesh_position !< A motions mesh which has all translational displacements set to zero. Used in the transfer of hydrodynamic loads from the various HD-related meshes to the AllHdroOrigin mesh [-] TYPE(HD_ModuleMapType) :: HD_MeshMap - INTEGER(IntKi) :: Decimate !< The output decimation counter [-] - REAL(DbKi) :: LastOutTime !< Last time step which was written to the output file (sec) [-] - INTEGER(IntKi) :: LastIndWave !< The last index used in the wave kinematics arrays, used to optimize interpolation [-] + INTEGER(IntKi) :: Decimate = 0_IntKi !< The output decimation counter [-] + REAL(DbKi) :: LastOutTime = 0.0_R8Ki !< Last time step which was written to the output file (sec) [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: F_PtfmAdd !< The total forces and moments due to additional pre-load, stiffness, and damping [-] - REAL(ReKi) , DIMENSION(1:6) :: F_Hydro !< The total hydrodynamic forces and moments integrated about the (0,0,0) platform reference point [-] + REAL(ReKi) , DIMENSION(1:6) :: F_Hydro = 0.0_ReKi !< The total hydrodynamic forces and moments integrated about the (0,0,0) platform reference point [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: F_Waves !< The total waves forces on a WAMIT body calculated by first and second order methods (WAMIT and WAMIT2 modules) [-] TYPE(WAMIT_MiscVarType) , DIMENSION(:), ALLOCATABLE :: WAMIT !< misc var information from the WAMIT module [-] TYPE(WAMIT2_MiscVarType) , DIMENSION(:), ALLOCATABLE :: WAMIT2 !< misc var information from the WAMIT2 module [-] - TYPE(Waves2_MiscVarType) :: Waves2 !< misc var information from the Waves2 module [-] TYPE(Morison_MiscVarType) :: Morison !< misc var information from the Morison module [-] TYPE(WAMIT_InputType) , DIMENSION(:), ALLOCATABLE :: u_WAMIT !< WAMIT module inputs [-] - TYPE(WAMIT2_InputType) , DIMENSION(:), ALLOCATABLE :: u_WAMIT2 !< WAMIT2 module inputs [-] - TYPE(Waves2_InputType) :: u_Waves2 !< Waves2 module inputs [-] END TYPE HydroDyn_MiscVarType ! ======================= ! ========= HydroDyn_ParameterType ======= TYPE, PUBLIC :: HydroDyn_ParameterType - INTEGER(IntKi) :: nWAMITObj !< number of WAMIT input files and matrices. If NBodyMod = 1 then nPotFiles will be 1 even if NBody > 1 [-] - INTEGER(IntKi) :: vecMultiplier !< multiplier for the WAMIT vectors and matrices. If NBodyMod=1 then this = NBody, else 1 [-] + INTEGER(IntKi) :: nWAMITObj = 0_IntKi !< number of WAMIT input files and matrices. If NBodyMod = 1 then nPotFiles will be 1 even if NBody > 1 [-] + INTEGER(IntKi) :: vecMultiplier = 0_IntKi !< multiplier for the WAMIT vectors and matrices. If NBodyMod=1 then this = NBody, else 1 [-] TYPE(WAMIT_ParameterType) , DIMENSION(:), ALLOCATABLE :: WAMIT !< Parameter data for the WAMIT module [-] TYPE(WAMIT2_ParameterType) , DIMENSION(:), ALLOCATABLE :: WAMIT2 !< Parameter data for the WAMIT2 module [-] LOGICAL :: WAMIT2used = .FALSE. !< Indicates when WAMIT2 is used. Shortcuts some calculations [-] - TYPE(Waves2_ParameterType) :: Waves2 !< Parameter data for the Waves2 module [-] TYPE(Morison_ParameterType) :: Morison !< Parameter data for the Morison module [-] - INTEGER(IntKi) :: PotMod !< 1 if using WAMIT model, 0 if no potential flow model, or 2 if FIT model [-] - INTEGER(IntKi) :: NBody !< [>=1; only used when PotMod=1. If NBodyMod=1, the WAMIT data contains a vector of size 6*NBody x 1 and matrices of size 6*NBody x 6*NBody; if NBodyMod>1, there are NBody sets of WAMIT data each with a vector of size 6 x 1 and matrices of size 6 x 6] [-] - INTEGER(IntKi) :: NBodyMod !< Body coupling model {1: include coupling terms between each body and NBody in HydroDyn equals NBODY in WAMIT, 2: neglect coupling terms between each body and NBODY=1 with XBODY=0 in WAMIT, 3: Neglect coupling terms between each body and NBODY=1 with XBODY=/0 in WAMIT} (switch) [only used when PotMod=1] [-] - INTEGER(IntKi) :: totalStates !< Number of excitation and radiation states for all WAMIT bodies [-] - INTEGER(IntKi) :: totalExctnStates !< Number of excitation states for all WAMIT bodies [-] - INTEGER(IntKi) :: totalRdtnStates !< Number of radiation states for all WAMIT bodies [-] - REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveTime !< Array of time samples, (sec) [-] - INTEGER(IntKi) :: NStepWave !< Number of data points in the wave kinematics arrays [-] - INTEGER(IntKi) :: NWaveElev !< Number of wave elevation outputs [-] - REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: WaveElev !< Total wave elevation [-] - REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: WaveElev1 !< First order wave elevation [-] - REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: WaveElev2 !< Second order wave elevation [-] - REAL(ReKi) :: WtrDpth !< Water depth [(m)] + INTEGER(IntKi) :: PotMod = 0_IntKi !< 1 if using WAMIT model, 0 if no potential flow model, or 2 if FIT model [-] + INTEGER(IntKi) :: NBody = 0_IntKi !< [>=1; only used when PotMod=1. If NBodyMod=1, the WAMIT data contains a vector of size 6*NBody x 1 and matrices of size 6*NBody x 6*NBody; if NBodyMod>1, there are NBody sets of WAMIT data each with a vector of size 6 x 1 and matrices of size 6 x 6] [-] + INTEGER(IntKi) :: NBodyMod = 0_IntKi !< Body coupling model {1: include coupling terms between each body and NBody in HydroDyn equals NBODY in WAMIT, 2: neglect coupling terms between each body and NBODY=1 with XBODY=0 in WAMIT, 3: Neglect coupling terms between each body and NBODY=1 with XBODY=/0 in WAMIT} (switch) [only used when PotMod=1] [-] + INTEGER(IntKi) :: totalStates = 0_IntKi !< Number of excitation and radiation states for all WAMIT bodies [-] + INTEGER(IntKi) :: totalExctnStates = 0_IntKi !< Number of excitation states for all WAMIT bodies [-] + INTEGER(IntKi) :: totalRdtnStates = 0_IntKi !< Number of radiation states for all WAMIT bodies [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: AddF0 !< Additional pre-load forces and moments (N,N,N,N-m,N-m,N-m) [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: AddCLin !< Additional stiffness matrix [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: AddBLin !< Additional linear damping matrix [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: AddBQuad !< Additional quadratic damping (drag) matrix [-] - REAL(DbKi) :: DT !< Time step in seconds for integration of continuous states (if a fixed-step integrator is used) and update of discrete states [-] + REAL(DbKi) :: DT = 0.0_R8Ki !< Time step in seconds for integration of continuous states (if a fixed-step integrator is used) and update of discrete states [-] TYPE(OutParmType) , DIMENSION(:), ALLOCATABLE :: OutParam !< [-] - INTEGER(IntKi) :: NumOuts !< Number of HydroDyn module-level outputs (not the total number including sub-modules [-] - INTEGER(IntKi) :: NumTotalOuts !< Number of all requested outputs including sub-modules [-] - INTEGER(IntKi) :: OutSwtch !< Output requested channels to: [1=Hydrodyn.out 2=GlueCode.out 3=both files] [-] + INTEGER(IntKi) :: NumOuts = 0_IntKi !< Number of HydroDyn module-level outputs (not the total number including sub-modules [-] + INTEGER(IntKi) :: NumTotalOuts = 0_IntKi !< Number of all requested outputs including sub-modules [-] + INTEGER(IntKi) :: OutSwtch = 0_IntKi !< Output requested channels to: [1=Hydrodyn.out 2=GlueCode.out 3=both files] [-] CHARACTER(20) :: OutFmt !< Output format for numerical results [-] CHARACTER(20) :: OutSFmt !< Output format for header strings [-] CHARACTER(ChanLen) :: Delim !< Delimiter string for outputs, defaults to tab-delimiters [-] - INTEGER(IntKi) :: UnOutFile !< File unit for the HydroDyn outputs [-] - INTEGER(IntKi) :: OutDec !< Write every OutDec time steps [-] + INTEGER(IntKi) :: UnOutFile = 0_IntKi !< File unit for the HydroDyn outputs [-] + INTEGER(IntKi) :: OutDec = 0_IntKi !< Write every OutDec time steps [-] 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(:), ALLOCATABLE :: dx !< vector that determines size of perturbation for x (continuous states) [-] - INTEGER(IntKi) :: Jac_ny !< number of outputs in jacobian matrix [-] + INTEGER(IntKi) :: Jac_ny = 0_IntKi !< number of outputs in jacobian matrix [-] LOGICAL :: VisMeshes = .false. !< Output visualization meshes [-] + TYPE(SeaSt_WaveFieldType) , POINTER :: WaveField => NULL() !< Pointer to SeaState wave field [-] + INTEGER(IntKi) :: PtfmYMod = 0_IntKi !< Large yaw model [-] + REAL(ReKi) :: CYawFilt = 0.0_ReKi !< Low-pass filter constant for reference platform yaw position PtfmRefY [-] END TYPE HydroDyn_ParameterType ! ======================= ! ========= HydroDyn_InputType ======= @@ -239,10460 +206,2064 @@ MODULE HydroDyn_Types TYPE, PUBLIC :: HydroDyn_OutputType TYPE(WAMIT_OutputType) , DIMENSION(:), ALLOCATABLE :: WAMIT !< WAMIT module outputs [-] TYPE(WAMIT2_OutputType) , DIMENSION(:), ALLOCATABLE :: WAMIT2 !< WAMIT2 module outputs [-] - TYPE(Waves2_OutputType) :: Waves2 !< Waves2 module outputs [-] TYPE(Morison_OutputType) :: Morison !< Morison module outputs [-] TYPE(MeshType) :: WAMITMesh !< Point Loads at the WAMIT reference point(s) in the inertial frame [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: WriteOutput !< Outputs to be written to the output file(s) [-] END TYPE HydroDyn_OutputType ! ======================= CONTAINS - SUBROUTINE HydroDyn_CopyInputFile( SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg ) - TYPE(HydroDyn_InputFile), INTENT(IN) :: SrcInputFileData - TYPE(HydroDyn_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 = 'HydroDyn_CopyInputFile' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInputFileData%EchoFlag = SrcInputFileData%EchoFlag -IF (ALLOCATED(SrcInputFileData%AddF0)) THEN - i1_l = LBOUND(SrcInputFileData%AddF0,1) - i1_u = UBOUND(SrcInputFileData%AddF0,1) - i2_l = LBOUND(SrcInputFileData%AddF0,2) - i2_u = UBOUND(SrcInputFileData%AddF0,2) - IF (.NOT. ALLOCATED(DstInputFileData%AddF0)) THEN - ALLOCATE(DstInputFileData%AddF0(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%AddF0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%AddF0 = SrcInputFileData%AddF0 -ENDIF -IF (ALLOCATED(SrcInputFileData%AddCLin)) THEN - i1_l = LBOUND(SrcInputFileData%AddCLin,1) - i1_u = UBOUND(SrcInputFileData%AddCLin,1) - i2_l = LBOUND(SrcInputFileData%AddCLin,2) - i2_u = UBOUND(SrcInputFileData%AddCLin,2) - i3_l = LBOUND(SrcInputFileData%AddCLin,3) - i3_u = UBOUND(SrcInputFileData%AddCLin,3) - IF (.NOT. ALLOCATED(DstInputFileData%AddCLin)) THEN - ALLOCATE(DstInputFileData%AddCLin(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%AddCLin.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%AddCLin = SrcInputFileData%AddCLin -ENDIF -IF (ALLOCATED(SrcInputFileData%AddBLin)) THEN - i1_l = LBOUND(SrcInputFileData%AddBLin,1) - i1_u = UBOUND(SrcInputFileData%AddBLin,1) - i2_l = LBOUND(SrcInputFileData%AddBLin,2) - i2_u = UBOUND(SrcInputFileData%AddBLin,2) - i3_l = LBOUND(SrcInputFileData%AddBLin,3) - i3_u = UBOUND(SrcInputFileData%AddBLin,3) - IF (.NOT. ALLOCATED(DstInputFileData%AddBLin)) THEN - ALLOCATE(DstInputFileData%AddBLin(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%AddBLin.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%AddBLin = SrcInputFileData%AddBLin -ENDIF -IF (ALLOCATED(SrcInputFileData%AddBQuad)) THEN - i1_l = LBOUND(SrcInputFileData%AddBQuad,1) - i1_u = UBOUND(SrcInputFileData%AddBQuad,1) - i2_l = LBOUND(SrcInputFileData%AddBQuad,2) - i2_u = UBOUND(SrcInputFileData%AddBQuad,2) - i3_l = LBOUND(SrcInputFileData%AddBQuad,3) - i3_u = UBOUND(SrcInputFileData%AddBQuad,3) - IF (.NOT. ALLOCATED(DstInputFileData%AddBQuad)) THEN - ALLOCATE(DstInputFileData%AddBQuad(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%AddBQuad.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%AddBQuad = SrcInputFileData%AddBQuad -ENDIF - CALL Waves_CopyInitInput( SrcInputFileData%Waves, DstInputFileData%Waves, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL Waves2_CopyInitInput( SrcInputFileData%Waves2, DstInputFileData%Waves2, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL Current_CopyInitInput( SrcInputFileData%Current, DstInputFileData%Current, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcInputFileData%PotFile)) THEN - i1_l = LBOUND(SrcInputFileData%PotFile,1) - i1_u = UBOUND(SrcInputFileData%PotFile,1) - IF (.NOT. ALLOCATED(DstInputFileData%PotFile)) THEN - ALLOCATE(DstInputFileData%PotFile(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%PotFile.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%PotFile = SrcInputFileData%PotFile -ENDIF - DstInputFileData%nWAMITObj = SrcInputFileData%nWAMITObj - DstInputFileData%vecMultiplier = SrcInputFileData%vecMultiplier - DstInputFileData%NBody = SrcInputFileData%NBody - DstInputFileData%NBodyMod = SrcInputFileData%NBodyMod -IF (ALLOCATED(SrcInputFileData%PtfmVol0)) THEN - i1_l = LBOUND(SrcInputFileData%PtfmVol0,1) - i1_u = UBOUND(SrcInputFileData%PtfmVol0,1) - IF (.NOT. ALLOCATED(DstInputFileData%PtfmVol0)) THEN - ALLOCATE(DstInputFileData%PtfmVol0(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%PtfmVol0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%PtfmVol0 = SrcInputFileData%PtfmVol0 -ENDIF - DstInputFileData%HasWAMIT = SrcInputFileData%HasWAMIT -IF (ALLOCATED(SrcInputFileData%WAMITULEN)) THEN - i1_l = LBOUND(SrcInputFileData%WAMITULEN,1) - i1_u = UBOUND(SrcInputFileData%WAMITULEN,1) - IF (.NOT. ALLOCATED(DstInputFileData%WAMITULEN)) THEN - ALLOCATE(DstInputFileData%WAMITULEN(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%WAMITULEN.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%WAMITULEN = SrcInputFileData%WAMITULEN -ENDIF -IF (ALLOCATED(SrcInputFileData%PtfmRefxt)) THEN - i1_l = LBOUND(SrcInputFileData%PtfmRefxt,1) - i1_u = UBOUND(SrcInputFileData%PtfmRefxt,1) - IF (.NOT. ALLOCATED(DstInputFileData%PtfmRefxt)) THEN - ALLOCATE(DstInputFileData%PtfmRefxt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%PtfmRefxt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%PtfmRefxt = SrcInputFileData%PtfmRefxt -ENDIF -IF (ALLOCATED(SrcInputFileData%PtfmRefyt)) THEN - i1_l = LBOUND(SrcInputFileData%PtfmRefyt,1) - i1_u = UBOUND(SrcInputFileData%PtfmRefyt,1) - IF (.NOT. ALLOCATED(DstInputFileData%PtfmRefyt)) THEN - ALLOCATE(DstInputFileData%PtfmRefyt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%PtfmRefyt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%PtfmRefyt = SrcInputFileData%PtfmRefyt -ENDIF -IF (ALLOCATED(SrcInputFileData%PtfmRefzt)) THEN - i1_l = LBOUND(SrcInputFileData%PtfmRefzt,1) - i1_u = UBOUND(SrcInputFileData%PtfmRefzt,1) - IF (.NOT. ALLOCATED(DstInputFileData%PtfmRefzt)) THEN - ALLOCATE(DstInputFileData%PtfmRefzt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%PtfmRefzt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%PtfmRefzt = SrcInputFileData%PtfmRefzt -ENDIF -IF (ALLOCATED(SrcInputFileData%PtfmRefztRot)) THEN - i1_l = LBOUND(SrcInputFileData%PtfmRefztRot,1) - i1_u = UBOUND(SrcInputFileData%PtfmRefztRot,1) - IF (.NOT. ALLOCATED(DstInputFileData%PtfmRefztRot)) THEN - ALLOCATE(DstInputFileData%PtfmRefztRot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%PtfmRefztRot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%PtfmRefztRot = SrcInputFileData%PtfmRefztRot -ENDIF -IF (ALLOCATED(SrcInputFileData%PtfmCOBxt)) THEN - i1_l = LBOUND(SrcInputFileData%PtfmCOBxt,1) - i1_u = UBOUND(SrcInputFileData%PtfmCOBxt,1) - IF (.NOT. ALLOCATED(DstInputFileData%PtfmCOBxt)) THEN - ALLOCATE(DstInputFileData%PtfmCOBxt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%PtfmCOBxt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%PtfmCOBxt = SrcInputFileData%PtfmCOBxt -ENDIF -IF (ALLOCATED(SrcInputFileData%PtfmCOByt)) THEN - i1_l = LBOUND(SrcInputFileData%PtfmCOByt,1) - i1_u = UBOUND(SrcInputFileData%PtfmCOByt,1) - IF (.NOT. ALLOCATED(DstInputFileData%PtfmCOByt)) THEN - ALLOCATE(DstInputFileData%PtfmCOByt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%PtfmCOByt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%PtfmCOByt = SrcInputFileData%PtfmCOByt -ENDIF - CALL WAMIT_CopyInitInput( SrcInputFileData%WAMIT, DstInputFileData%WAMIT, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL WAMIT2_CopyInitInput( SrcInputFileData%WAMIT2, DstInputFileData%WAMIT2, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL Morison_CopyInitInput( SrcInputFileData%Morison, DstInputFileData%Morison, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstInputFileData%Echo = SrcInputFileData%Echo - DstInputFileData%PotMod = SrcInputFileData%PotMod - DstInputFileData%NUserOutputs = SrcInputFileData%NUserOutputs -IF (ALLOCATED(SrcInputFileData%UserOutputs)) THEN - i1_l = LBOUND(SrcInputFileData%UserOutputs,1) - i1_u = UBOUND(SrcInputFileData%UserOutputs,1) - IF (.NOT. ALLOCATED(DstInputFileData%UserOutputs)) THEN - ALLOCATE(DstInputFileData%UserOutputs(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%UserOutputs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%UserOutputs = SrcInputFileData%UserOutputs -ENDIF - DstInputFileData%OutSwtch = SrcInputFileData%OutSwtch - DstInputFileData%OutAll = SrcInputFileData%OutAll - 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%HDSum = SrcInputFileData%HDSum - DstInputFileData%UnSum = SrcInputFileData%UnSum - DstInputFileData%OutFmt = SrcInputFileData%OutFmt - DstInputFileData%OutSFmt = SrcInputFileData%OutSFmt - END SUBROUTINE HydroDyn_CopyInputFile - - SUBROUTINE HydroDyn_DestroyInputFile( InputFileData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(HydroDyn_InputFile), INTENT(INOUT) :: InputFileData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_DestroyInputFile' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(InputFileData%AddF0)) THEN - DEALLOCATE(InputFileData%AddF0) -ENDIF -IF (ALLOCATED(InputFileData%AddCLin)) THEN - DEALLOCATE(InputFileData%AddCLin) -ENDIF -IF (ALLOCATED(InputFileData%AddBLin)) THEN - DEALLOCATE(InputFileData%AddBLin) -ENDIF -IF (ALLOCATED(InputFileData%AddBQuad)) THEN - DEALLOCATE(InputFileData%AddBQuad) -ENDIF - CALL Waves_DestroyInitInput( InputFileData%Waves, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL Waves2_DestroyInitInput( InputFileData%Waves2, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL Current_DestroyInitInput( InputFileData%Current, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(InputFileData%PotFile)) THEN - DEALLOCATE(InputFileData%PotFile) -ENDIF -IF (ALLOCATED(InputFileData%PtfmVol0)) THEN - DEALLOCATE(InputFileData%PtfmVol0) -ENDIF -IF (ALLOCATED(InputFileData%WAMITULEN)) THEN - DEALLOCATE(InputFileData%WAMITULEN) -ENDIF -IF (ALLOCATED(InputFileData%PtfmRefxt)) THEN - DEALLOCATE(InputFileData%PtfmRefxt) -ENDIF -IF (ALLOCATED(InputFileData%PtfmRefyt)) THEN - DEALLOCATE(InputFileData%PtfmRefyt) -ENDIF -IF (ALLOCATED(InputFileData%PtfmRefzt)) THEN - DEALLOCATE(InputFileData%PtfmRefzt) -ENDIF -IF (ALLOCATED(InputFileData%PtfmRefztRot)) THEN - DEALLOCATE(InputFileData%PtfmRefztRot) -ENDIF -IF (ALLOCATED(InputFileData%PtfmCOBxt)) THEN - DEALLOCATE(InputFileData%PtfmCOBxt) -ENDIF -IF (ALLOCATED(InputFileData%PtfmCOByt)) THEN - DEALLOCATE(InputFileData%PtfmCOByt) -ENDIF - CALL WAMIT_DestroyInitInput( InputFileData%WAMIT, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL WAMIT2_DestroyInitInput( InputFileData%WAMIT2, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL Morison_DestroyInitInput( InputFileData%Morison, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(InputFileData%UserOutputs)) THEN - DEALLOCATE(InputFileData%UserOutputs) -ENDIF -IF (ALLOCATED(InputFileData%OutList)) THEN - DEALLOCATE(InputFileData%OutList) -ENDIF - END SUBROUTINE HydroDyn_DestroyInputFile - - SUBROUTINE HydroDyn_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(HydroDyn_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 = 'HydroDyn_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 ! EchoFlag - Int_BufSz = Int_BufSz + 1 ! AddF0 allocated yes/no - IF ( ALLOCATED(InData%AddF0) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! AddF0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AddF0) ! AddF0 - END IF - Int_BufSz = Int_BufSz + 1 ! AddCLin allocated yes/no - IF ( ALLOCATED(InData%AddCLin) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! AddCLin upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AddCLin) ! AddCLin - END IF - Int_BufSz = Int_BufSz + 1 ! AddBLin allocated yes/no - IF ( ALLOCATED(InData%AddBLin) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! AddBLin upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AddBLin) ! AddBLin - END IF - Int_BufSz = Int_BufSz + 1 ! AddBQuad allocated yes/no - IF ( ALLOCATED(InData%AddBQuad) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! AddBQuad upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AddBQuad) ! AddBQuad - END IF - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! Waves: size of buffers for each call to pack subtype - CALL Waves_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%Waves, ErrStat2, ErrMsg2, .TRUE. ) ! Waves - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Waves - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Waves - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Waves - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! Waves2: size of buffers for each call to pack subtype - CALL Waves2_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%Waves2, ErrStat2, ErrMsg2, .TRUE. ) ! Waves2 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Waves2 - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Waves2 - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Waves2 - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! Current: size of buffers for each call to pack subtype - CALL Current_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%Current, ErrStat2, ErrMsg2, .TRUE. ) ! Current - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Current - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Current - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Current - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! PotFile allocated yes/no - IF ( ALLOCATED(InData%PotFile) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PotFile upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%PotFile)*LEN(InData%PotFile) ! PotFile - END IF - Int_BufSz = Int_BufSz + 1 ! nWAMITObj - Int_BufSz = Int_BufSz + 1 ! vecMultiplier - Int_BufSz = Int_BufSz + 1 ! NBody - Int_BufSz = Int_BufSz + 1 ! NBodyMod - Int_BufSz = Int_BufSz + 1 ! PtfmVol0 allocated yes/no - IF ( ALLOCATED(InData%PtfmVol0) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PtfmVol0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PtfmVol0) ! PtfmVol0 - END IF - Int_BufSz = Int_BufSz + 1 ! HasWAMIT - Int_BufSz = Int_BufSz + 1 ! WAMITULEN allocated yes/no - IF ( ALLOCATED(InData%WAMITULEN) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WAMITULEN upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WAMITULEN) ! WAMITULEN - END IF - Int_BufSz = Int_BufSz + 1 ! PtfmRefxt allocated yes/no - IF ( ALLOCATED(InData%PtfmRefxt) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PtfmRefxt upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PtfmRefxt) ! PtfmRefxt - END IF - Int_BufSz = Int_BufSz + 1 ! PtfmRefyt allocated yes/no - IF ( ALLOCATED(InData%PtfmRefyt) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PtfmRefyt upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PtfmRefyt) ! PtfmRefyt - END IF - Int_BufSz = Int_BufSz + 1 ! PtfmRefzt allocated yes/no - IF ( ALLOCATED(InData%PtfmRefzt) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PtfmRefzt upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PtfmRefzt) ! PtfmRefzt - END IF - Int_BufSz = Int_BufSz + 1 ! PtfmRefztRot allocated yes/no - IF ( ALLOCATED(InData%PtfmRefztRot) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PtfmRefztRot upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%PtfmRefztRot) ! PtfmRefztRot - END IF - Int_BufSz = Int_BufSz + 1 ! PtfmCOBxt allocated yes/no - IF ( ALLOCATED(InData%PtfmCOBxt) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PtfmCOBxt upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PtfmCOBxt) ! PtfmCOBxt - END IF - Int_BufSz = Int_BufSz + 1 ! PtfmCOByt allocated yes/no - IF ( ALLOCATED(InData%PtfmCOByt) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PtfmCOByt upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PtfmCOByt) ! PtfmCOByt - END IF - Int_BufSz = Int_BufSz + 3 ! WAMIT: size of buffers for each call to pack subtype - CALL WAMIT_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%WAMIT, ErrStat2, ErrMsg2, .TRUE. ) ! WAMIT - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! WAMIT - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! WAMIT - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! WAMIT - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! WAMIT2: size of buffers for each call to pack subtype - CALL WAMIT2_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%WAMIT2, ErrStat2, ErrMsg2, .TRUE. ) ! WAMIT2 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! WAMIT2 - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! WAMIT2 - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! WAMIT2 - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! Morison: size of buffers for each call to pack subtype - CALL Morison_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%Morison, ErrStat2, ErrMsg2, .TRUE. ) ! Morison - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Morison - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Morison - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Morison - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! Echo - Int_BufSz = Int_BufSz + 1 ! PotMod - Int_BufSz = Int_BufSz + 1 ! NUserOutputs - Int_BufSz = Int_BufSz + 1 ! UserOutputs allocated yes/no - IF ( ALLOCATED(InData%UserOutputs) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! UserOutputs upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%UserOutputs)*LEN(InData%UserOutputs) ! UserOutputs - END IF - Int_BufSz = Int_BufSz + 1 ! OutSwtch - Int_BufSz = Int_BufSz + 1 ! OutAll - 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 ! HDSum - Int_BufSz = Int_BufSz + 1 ! UnSum - Int_BufSz = Int_BufSz + 1*LEN(InData%OutFmt) ! OutFmt - Int_BufSz = Int_BufSz + 1*LEN(InData%OutSFmt) ! OutSFmt - 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%EchoFlag, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%AddF0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AddF0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AddF0,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AddF0,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AddF0,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%AddF0,2), UBOUND(InData%AddF0,2) - DO i1 = LBOUND(InData%AddF0,1), UBOUND(InData%AddF0,1) - ReKiBuf(Re_Xferred) = InData%AddF0(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AddCLin) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AddCLin,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AddCLin,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AddCLin,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AddCLin,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AddCLin,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AddCLin,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%AddCLin,3), UBOUND(InData%AddCLin,3) - DO i2 = LBOUND(InData%AddCLin,2), UBOUND(InData%AddCLin,2) - DO i1 = LBOUND(InData%AddCLin,1), UBOUND(InData%AddCLin,1) - ReKiBuf(Re_Xferred) = InData%AddCLin(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AddBLin) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AddBLin,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AddBLin,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AddBLin,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AddBLin,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AddBLin,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AddBLin,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%AddBLin,3), UBOUND(InData%AddBLin,3) - DO i2 = LBOUND(InData%AddBLin,2), UBOUND(InData%AddBLin,2) - DO i1 = LBOUND(InData%AddBLin,1), UBOUND(InData%AddBLin,1) - ReKiBuf(Re_Xferred) = InData%AddBLin(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AddBQuad) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AddBQuad,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AddBQuad,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AddBQuad,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AddBQuad,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AddBQuad,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AddBQuad,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%AddBQuad,3), UBOUND(InData%AddBQuad,3) - DO i2 = LBOUND(InData%AddBQuad,2), UBOUND(InData%AddBQuad,2) - DO i1 = LBOUND(InData%AddBQuad,1), UBOUND(InData%AddBQuad,1) - ReKiBuf(Re_Xferred) = InData%AddBQuad(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - CALL Waves_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%Waves, ErrStat2, ErrMsg2, OnlySize ) ! Waves - 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 Waves2_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%Waves2, ErrStat2, ErrMsg2, OnlySize ) ! Waves2 - 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 Current_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%Current, ErrStat2, ErrMsg2, OnlySize ) ! Current - 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%PotFile) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PotFile,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PotFile,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PotFile,1), UBOUND(InData%PotFile,1) - DO I = 1, LEN(InData%PotFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%PotFile(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IntKiBuf(Int_Xferred) = InData%nWAMITObj - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%vecMultiplier - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NBody - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NBodyMod - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%PtfmVol0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PtfmVol0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PtfmVol0,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PtfmVol0,1), UBOUND(InData%PtfmVol0,1) - ReKiBuf(Re_Xferred) = InData%PtfmVol0(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = TRANSFER(InData%HasWAMIT, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%WAMITULEN) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WAMITULEN,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WAMITULEN,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WAMITULEN,1), UBOUND(InData%WAMITULEN,1) - ReKiBuf(Re_Xferred) = InData%WAMITULEN(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PtfmRefxt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PtfmRefxt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PtfmRefxt,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PtfmRefxt,1), UBOUND(InData%PtfmRefxt,1) - ReKiBuf(Re_Xferred) = InData%PtfmRefxt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PtfmRefyt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PtfmRefyt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PtfmRefyt,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PtfmRefyt,1), UBOUND(InData%PtfmRefyt,1) - ReKiBuf(Re_Xferred) = InData%PtfmRefyt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PtfmRefzt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PtfmRefzt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PtfmRefzt,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PtfmRefzt,1), UBOUND(InData%PtfmRefzt,1) - ReKiBuf(Re_Xferred) = InData%PtfmRefzt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PtfmRefztRot) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PtfmRefztRot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PtfmRefztRot,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PtfmRefztRot,1), UBOUND(InData%PtfmRefztRot,1) - DbKiBuf(Db_Xferred) = InData%PtfmRefztRot(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PtfmCOBxt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PtfmCOBxt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PtfmCOBxt,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PtfmCOBxt,1), UBOUND(InData%PtfmCOBxt,1) - ReKiBuf(Re_Xferred) = InData%PtfmCOBxt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PtfmCOByt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PtfmCOByt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PtfmCOByt,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PtfmCOByt,1), UBOUND(InData%PtfmCOByt,1) - ReKiBuf(Re_Xferred) = InData%PtfmCOByt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - CALL WAMIT_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%WAMIT, ErrStat2, ErrMsg2, OnlySize ) ! WAMIT - 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 WAMIT2_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%WAMIT2, ErrStat2, ErrMsg2, OnlySize ) ! WAMIT2 - 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 Morison_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%Morison, ErrStat2, ErrMsg2, OnlySize ) ! Morison - 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%Echo, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%PotMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NUserOutputs - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%UserOutputs) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%UserOutputs,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UserOutputs,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%UserOutputs,1), UBOUND(InData%UserOutputs,1) - DO I = 1, LEN(InData%UserOutputs) - IntKiBuf(Int_Xferred) = ICHAR(InData%UserOutputs(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IntKiBuf(Int_Xferred) = InData%OutSwtch - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%OutAll, IntKiBuf(1)) - Int_Xferred = Int_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 - IntKiBuf(Int_Xferred) = TRANSFER(InData%HDSum, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%UnSum - 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 - DO I = 1, LEN(InData%OutSFmt) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutSFmt(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END SUBROUTINE HydroDyn_PackInputFile - - SUBROUTINE HydroDyn_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(HydroDyn_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 = 'HydroDyn_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%EchoFlag = TRANSFER(IntKiBuf(Int_Xferred), OutData%EchoFlag) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AddF0 not allocated - Int_Xferred = Int_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%AddF0)) DEALLOCATE(OutData%AddF0) - ALLOCATE(OutData%AddF0(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AddF0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%AddF0,2), UBOUND(OutData%AddF0,2) - DO i1 = LBOUND(OutData%AddF0,1), UBOUND(OutData%AddF0,1) - OutData%AddF0(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AddCLin not allocated - Int_Xferred = Int_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%AddCLin)) DEALLOCATE(OutData%AddCLin) - ALLOCATE(OutData%AddCLin(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%AddCLin.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%AddCLin,3), UBOUND(OutData%AddCLin,3) - DO i2 = LBOUND(OutData%AddCLin,2), UBOUND(OutData%AddCLin,2) - DO i1 = LBOUND(OutData%AddCLin,1), UBOUND(OutData%AddCLin,1) - OutData%AddCLin(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 ! AddBLin not allocated - Int_Xferred = Int_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%AddBLin)) DEALLOCATE(OutData%AddBLin) - ALLOCATE(OutData%AddBLin(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%AddBLin.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%AddBLin,3), UBOUND(OutData%AddBLin,3) - DO i2 = LBOUND(OutData%AddBLin,2), UBOUND(OutData%AddBLin,2) - DO i1 = LBOUND(OutData%AddBLin,1), UBOUND(OutData%AddBLin,1) - OutData%AddBLin(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 ! AddBQuad not allocated - Int_Xferred = Int_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%AddBQuad)) DEALLOCATE(OutData%AddBQuad) - ALLOCATE(OutData%AddBQuad(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%AddBQuad.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%AddBQuad,3), UBOUND(OutData%AddBQuad,3) - DO i2 = LBOUND(OutData%AddBQuad,2), UBOUND(OutData%AddBQuad,2) - DO i1 = LBOUND(OutData%AddBQuad,1), UBOUND(OutData%AddBQuad,1) - OutData%AddBQuad(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 Waves_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%Waves, ErrStat2, ErrMsg2 ) ! Waves - 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 Waves2_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%Waves2, ErrStat2, ErrMsg2 ) ! Waves2 - 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 Current_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%Current, ErrStat2, ErrMsg2 ) ! Current - 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 ! PotFile not allocated - Int_Xferred = Int_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%PotFile)) DEALLOCATE(OutData%PotFile) - ALLOCATE(OutData%PotFile(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PotFile.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PotFile,1), UBOUND(OutData%PotFile,1) - DO I = 1, LEN(OutData%PotFile) - OutData%PotFile(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - OutData%nWAMITObj = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%vecMultiplier = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NBody = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NBodyMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PtfmVol0 not allocated - Int_Xferred = Int_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%PtfmVol0)) DEALLOCATE(OutData%PtfmVol0) - ALLOCATE(OutData%PtfmVol0(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmVol0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PtfmVol0,1), UBOUND(OutData%PtfmVol0,1) - OutData%PtfmVol0(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%HasWAMIT = TRANSFER(IntKiBuf(Int_Xferred), OutData%HasWAMIT) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WAMITULEN not allocated - Int_Xferred = Int_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%WAMITULEN)) DEALLOCATE(OutData%WAMITULEN) - ALLOCATE(OutData%WAMITULEN(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WAMITULEN.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WAMITULEN,1), UBOUND(OutData%WAMITULEN,1) - OutData%WAMITULEN(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PtfmRefxt not allocated - Int_Xferred = Int_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%PtfmRefxt)) DEALLOCATE(OutData%PtfmRefxt) - ALLOCATE(OutData%PtfmRefxt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmRefxt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PtfmRefxt,1), UBOUND(OutData%PtfmRefxt,1) - OutData%PtfmRefxt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PtfmRefyt not allocated - Int_Xferred = Int_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%PtfmRefyt)) DEALLOCATE(OutData%PtfmRefyt) - ALLOCATE(OutData%PtfmRefyt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmRefyt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PtfmRefyt,1), UBOUND(OutData%PtfmRefyt,1) - OutData%PtfmRefyt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PtfmRefzt not allocated - Int_Xferred = Int_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%PtfmRefzt)) DEALLOCATE(OutData%PtfmRefzt) - ALLOCATE(OutData%PtfmRefzt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmRefzt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PtfmRefzt,1), UBOUND(OutData%PtfmRefzt,1) - OutData%PtfmRefzt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PtfmRefztRot not allocated - Int_Xferred = Int_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%PtfmRefztRot)) DEALLOCATE(OutData%PtfmRefztRot) - ALLOCATE(OutData%PtfmRefztRot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmRefztRot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PtfmRefztRot,1), UBOUND(OutData%PtfmRefztRot,1) - OutData%PtfmRefztRot(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PtfmCOBxt not allocated - Int_Xferred = Int_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%PtfmCOBxt)) DEALLOCATE(OutData%PtfmCOBxt) - ALLOCATE(OutData%PtfmCOBxt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmCOBxt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PtfmCOBxt,1), UBOUND(OutData%PtfmCOBxt,1) - OutData%PtfmCOBxt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PtfmCOByt not allocated - Int_Xferred = Int_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%PtfmCOByt)) DEALLOCATE(OutData%PtfmCOByt) - ALLOCATE(OutData%PtfmCOByt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmCOByt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PtfmCOByt,1), UBOUND(OutData%PtfmCOByt,1) - OutData%PtfmCOByt(i1) = ReKiBuf(Re_Xferred) - 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 WAMIT_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%WAMIT, ErrStat2, ErrMsg2 ) ! WAMIT - 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 WAMIT2_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%WAMIT2, ErrStat2, ErrMsg2 ) ! WAMIT2 - 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 Morison_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%Morison, ErrStat2, ErrMsg2 ) ! Morison - 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%Echo = TRANSFER(IntKiBuf(Int_Xferred), OutData%Echo) - Int_Xferred = Int_Xferred + 1 - OutData%PotMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NUserOutputs = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! UserOutputs not allocated - Int_Xferred = Int_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%UserOutputs)) DEALLOCATE(OutData%UserOutputs) - ALLOCATE(OutData%UserOutputs(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%UserOutputs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%UserOutputs,1), UBOUND(OutData%UserOutputs,1) - DO I = 1, LEN(OutData%UserOutputs) - OutData%UserOutputs(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - OutData%OutSwtch = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%OutAll = TRANSFER(IntKiBuf(Int_Xferred), OutData%OutAll) - Int_Xferred = Int_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 - OutData%HDSum = TRANSFER(IntKiBuf(Int_Xferred), OutData%HDSum) - Int_Xferred = Int_Xferred + 1 - OutData%UnSum = IntKiBuf(Int_Xferred) - 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 - DO I = 1, LEN(OutData%OutSFmt) - OutData%OutSFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END SUBROUTINE HydroDyn_UnPackInputFile - - SUBROUTINE HydroDyn_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(HydroDyn_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(HydroDyn_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 = 'HydroDyn_CopyInitInput' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInitInputData%InputFile = SrcInitInputData%InputFile - DstInitInputData%UseInputFile = SrcInitInputData%UseInputFile - CALL NWTC_Library_Copyfileinfotype( SrcInitInputData%PassedFileData, DstInitInputData%PassedFileData, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstInitInputData%OutRootName = SrcInitInputData%OutRootName - DstInitInputData%Linearize = SrcInitInputData%Linearize - DstInitInputData%Gravity = SrcInitInputData%Gravity - DstInitInputData%defWtrDens = SrcInitInputData%defWtrDens - DstInitInputData%defWtrDpth = SrcInitInputData%defWtrDpth - DstInitInputData%defMSL2SWL = SrcInitInputData%defMSL2SWL - DstInitInputData%TMax = SrcInitInputData%TMax - DstInitInputData%HasIce = SrcInitInputData%HasIce -IF (ALLOCATED(SrcInitInputData%WaveElevXY)) THEN - i1_l = LBOUND(SrcInitInputData%WaveElevXY,1) - i1_u = UBOUND(SrcInitInputData%WaveElevXY,1) - i2_l = LBOUND(SrcInitInputData%WaveElevXY,2) - i2_u = UBOUND(SrcInitInputData%WaveElevXY,2) - IF (.NOT. ALLOCATED(DstInitInputData%WaveElevXY)) THEN - ALLOCATE(DstInitInputData%WaveElevXY(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveElevXY.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%WaveElevXY = SrcInitInputData%WaveElevXY -ENDIF - DstInitInputData%WaveFieldMod = SrcInitInputData%WaveFieldMod - DstInitInputData%PtfmLocationX = SrcInitInputData%PtfmLocationX - DstInitInputData%PtfmLocationY = SrcInitInputData%PtfmLocationY - DstInitInputData%VisMeshes = SrcInitInputData%VisMeshes - END SUBROUTINE HydroDyn_CopyInitInput - - SUBROUTINE HydroDyn_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(HydroDyn_InitInputType), INTENT(INOUT) :: InitInputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_DestroyInitInput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL NWTC_Library_Destroyfileinfotype( InitInputData%PassedFileData, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(InitInputData%WaveElevXY)) THEN - DEALLOCATE(InitInputData%WaveElevXY) -ENDIF - END SUBROUTINE HydroDyn_DestroyInitInput - - SUBROUTINE HydroDyn_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(HydroDyn_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 = 'HydroDyn_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 ! UseInputFile - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! PassedFileData: size of buffers for each call to pack subtype - CALL NWTC_Library_Packfileinfotype( Re_Buf, Db_Buf, Int_Buf, InData%PassedFileData, ErrStat2, ErrMsg2, .TRUE. ) ! PassedFileData - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! PassedFileData - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! PassedFileData - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! PassedFileData - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1*LEN(InData%OutRootName) ! OutRootName - Int_BufSz = Int_BufSz + 1 ! Linearize - Re_BufSz = Re_BufSz + 1 ! Gravity - Re_BufSz = Re_BufSz + 1 ! defWtrDens - Re_BufSz = Re_BufSz + 1 ! defWtrDpth - Re_BufSz = Re_BufSz + 1 ! defMSL2SWL - Db_BufSz = Db_BufSz + 1 ! TMax - Int_BufSz = Int_BufSz + 1 ! HasIce - Int_BufSz = Int_BufSz + 1 ! WaveElevXY allocated yes/no - IF ( ALLOCATED(InData%WaveElevXY) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! WaveElevXY upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveElevXY) ! WaveElevXY - END IF - Int_BufSz = Int_BufSz + 1 ! WaveFieldMod - Re_BufSz = Re_BufSz + 1 ! PtfmLocationX - Re_BufSz = Re_BufSz + 1 ! PtfmLocationY - Int_BufSz = Int_BufSz + 1 ! VisMeshes - 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%UseInputFile, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - CALL NWTC_Library_Packfileinfotype( Re_Buf, Db_Buf, Int_Buf, InData%PassedFileData, ErrStat2, ErrMsg2, OnlySize ) ! PassedFileData - 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%OutRootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutRootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = TRANSFER(InData%Linearize, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Gravity - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%defWtrDens - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%defWtrDpth - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%defMSL2SWL - Re_Xferred = Re_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%TMax - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%HasIce, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%WaveElevXY) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevXY,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevXY,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevXY,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevXY,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%WaveElevXY,2), UBOUND(InData%WaveElevXY,2) - DO i1 = LBOUND(InData%WaveElevXY,1), UBOUND(InData%WaveElevXY,1) - ReKiBuf(Re_Xferred) = InData%WaveElevXY(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%WaveFieldMod - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PtfmLocationX - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PtfmLocationY - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%VisMeshes, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE HydroDyn_PackInitInput - - SUBROUTINE HydroDyn_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(HydroDyn_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 = 'HydroDyn_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%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%PassedFileData, ErrStat2, ErrMsg2 ) ! PassedFileData - 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%OutRootName) - OutData%OutRootName(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%Gravity = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%defWtrDens = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%defWtrDpth = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%defMSL2SWL = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TMax = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%HasIce = TRANSFER(IntKiBuf(Int_Xferred), OutData%HasIce) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElevXY not allocated - Int_Xferred = Int_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%WaveElevXY)) DEALLOCATE(OutData%WaveElevXY) - ALLOCATE(OutData%WaveElevXY(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevXY.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%WaveElevXY,2), UBOUND(OutData%WaveElevXY,2) - DO i1 = LBOUND(OutData%WaveElevXY,1), UBOUND(OutData%WaveElevXY,1) - OutData%WaveElevXY(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%WaveFieldMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%PtfmLocationX = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmLocationY = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%VisMeshes = TRANSFER(IntKiBuf(Int_Xferred), OutData%VisMeshes) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE HydroDyn_UnPackInitInput - - SUBROUTINE HydroDyn_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(HydroDyn_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(HydroDyn_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) :: 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 = 'HydroDyn_CopyInitOutput' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcInitOutputData%WAMIT)) THEN - i1_l = LBOUND(SrcInitOutputData%WAMIT,1) - i1_u = UBOUND(SrcInitOutputData%WAMIT,1) - IF (.NOT. ALLOCATED(DstInitOutputData%WAMIT)) THEN - ALLOCATE(DstInitOutputData%WAMIT(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WAMIT.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcInitOutputData%WAMIT,1), UBOUND(SrcInitOutputData%WAMIT,1) - CALL WAMIT_CopyInitOutput( SrcInitOutputData%WAMIT(i1), DstInitOutputData%WAMIT(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcInitOutputData%WAMIT2)) THEN - i1_l = LBOUND(SrcInitOutputData%WAMIT2,1) - i1_u = UBOUND(SrcInitOutputData%WAMIT2,1) - IF (.NOT. ALLOCATED(DstInitOutputData%WAMIT2)) THEN - ALLOCATE(DstInitOutputData%WAMIT2(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WAMIT2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcInitOutputData%WAMIT2,1), UBOUND(SrcInitOutputData%WAMIT2,1) - CALL WAMIT2_CopyInitOutput( SrcInitOutputData%WAMIT2(i1), DstInitOutputData%WAMIT2(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL Waves2_CopyInitOutput( SrcInitOutputData%Waves2, DstInitOutputData%Waves2, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL Morison_CopyInitOutput( SrcInitOutputData%Morison, DstInitOutputData%Morison, 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 -IF (ALLOCATED(SrcInitOutputData%WaveElevSeries)) THEN - i1_l = LBOUND(SrcInitOutputData%WaveElevSeries,1) - i1_u = UBOUND(SrcInitOutputData%WaveElevSeries,1) - i2_l = LBOUND(SrcInitOutputData%WaveElevSeries,2) - i2_u = UBOUND(SrcInitOutputData%WaveElevSeries,2) - IF (.NOT. ALLOCATED(DstInitOutputData%WaveElevSeries)) THEN - ALLOCATE(DstInitOutputData%WaveElevSeries(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveElevSeries.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WaveElevSeries = SrcInitOutputData%WaveElevSeries -ENDIF - CALL NWTC_Library_Copyprogdesc( SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstInitOutputData%WtrDens = SrcInitOutputData%WtrDens - DstInitOutputData%WtrDpth = SrcInitOutputData%WtrDpth - DstInitOutputData%MSL2SWL = SrcInitOutputData%MSL2SWL -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%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 -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%WaveVel)) THEN - i1_l = LBOUND(SrcInitOutputData%WaveVel,1) - i1_u = UBOUND(SrcInitOutputData%WaveVel,1) - i2_l = LBOUND(SrcInitOutputData%WaveVel,2) - i2_u = UBOUND(SrcInitOutputData%WaveVel,2) - i3_l = LBOUND(SrcInitOutputData%WaveVel,3) - i3_u = UBOUND(SrcInitOutputData%WaveVel,3) - IF (.NOT. ALLOCATED(DstInitOutputData%WaveVel)) THEN - ALLOCATE(DstInitOutputData%WaveVel(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveVel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WaveVel = SrcInitOutputData%WaveVel -ENDIF -IF (ALLOCATED(SrcInitOutputData%WaveAcc)) THEN - i1_l = LBOUND(SrcInitOutputData%WaveAcc,1) - i1_u = UBOUND(SrcInitOutputData%WaveAcc,1) - i2_l = LBOUND(SrcInitOutputData%WaveAcc,2) - i2_u = UBOUND(SrcInitOutputData%WaveAcc,2) - i3_l = LBOUND(SrcInitOutputData%WaveAcc,3) - i3_u = UBOUND(SrcInitOutputData%WaveAcc,3) - IF (.NOT. ALLOCATED(DstInitOutputData%WaveAcc)) THEN - ALLOCATE(DstInitOutputData%WaveAcc(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveAcc.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WaveAcc = SrcInitOutputData%WaveAcc -ENDIF -IF (ALLOCATED(SrcInitOutputData%WaveDynP)) THEN - i1_l = LBOUND(SrcInitOutputData%WaveDynP,1) - i1_u = UBOUND(SrcInitOutputData%WaveDynP,1) - i2_l = LBOUND(SrcInitOutputData%WaveDynP,2) - i2_u = UBOUND(SrcInitOutputData%WaveDynP,2) - IF (.NOT. ALLOCATED(DstInitOutputData%WaveDynP)) THEN - ALLOCATE(DstInitOutputData%WaveDynP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveDynP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WaveDynP = SrcInitOutputData%WaveDynP -ENDIF -IF (ALLOCATED(SrcInitOutputData%WaveElev)) THEN - i1_l = LBOUND(SrcInitOutputData%WaveElev,1) - i1_u = UBOUND(SrcInitOutputData%WaveElev,1) - i2_l = LBOUND(SrcInitOutputData%WaveElev,2) - i2_u = UBOUND(SrcInitOutputData%WaveElev,2) - IF (.NOT. ALLOCATED(DstInitOutputData%WaveElev)) THEN - ALLOCATE(DstInitOutputData%WaveElev(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveElev.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WaveElev = SrcInitOutputData%WaveElev -ENDIF -IF (ALLOCATED(SrcInitOutputData%WaveTime)) THEN - i1_l = LBOUND(SrcInitOutputData%WaveTime,1) - i1_u = UBOUND(SrcInitOutputData%WaveTime,1) - IF (.NOT. ALLOCATED(DstInitOutputData%WaveTime)) THEN - ALLOCATE(DstInitOutputData%WaveTime(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveTime.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WaveTime = SrcInitOutputData%WaveTime -ENDIF - END SUBROUTINE HydroDyn_CopyInitOutput - - SUBROUTINE HydroDyn_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(HydroDyn_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_DestroyInitOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(InitOutputData%WAMIT)) THEN -DO i1 = LBOUND(InitOutputData%WAMIT,1), UBOUND(InitOutputData%WAMIT,1) - CALL WAMIT_DestroyInitOutput( InitOutputData%WAMIT(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(InitOutputData%WAMIT) -ENDIF -IF (ALLOCATED(InitOutputData%WAMIT2)) THEN -DO i1 = LBOUND(InitOutputData%WAMIT2,1), UBOUND(InitOutputData%WAMIT2,1) - CALL WAMIT2_DestroyInitOutput( InitOutputData%WAMIT2(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(InitOutputData%WAMIT2) -ENDIF - CALL Waves2_DestroyInitOutput( InitOutputData%Waves2, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL Morison_DestroyInitOutput( InitOutputData%Morison, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(InitOutputData%WriteOutputHdr)) THEN - DEALLOCATE(InitOutputData%WriteOutputHdr) -ENDIF -IF (ALLOCATED(InitOutputData%WriteOutputUnt)) THEN - DEALLOCATE(InitOutputData%WriteOutputUnt) -ENDIF -IF (ALLOCATED(InitOutputData%WaveElevSeries)) THEN - DEALLOCATE(InitOutputData%WaveElevSeries) -ENDIF - CALL NWTC_Library_Destroyprogdesc( InitOutputData%Ver, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -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%DerivOrder_x)) THEN - DEALLOCATE(InitOutputData%DerivOrder_x) -ENDIF -IF (ALLOCATED(InitOutputData%IsLoad_u)) THEN - DEALLOCATE(InitOutputData%IsLoad_u) -ENDIF -IF (ALLOCATED(InitOutputData%WaveVel)) THEN - DEALLOCATE(InitOutputData%WaveVel) -ENDIF -IF (ALLOCATED(InitOutputData%WaveAcc)) THEN - DEALLOCATE(InitOutputData%WaveAcc) -ENDIF -IF (ALLOCATED(InitOutputData%WaveDynP)) THEN - DEALLOCATE(InitOutputData%WaveDynP) -ENDIF -IF (ALLOCATED(InitOutputData%WaveElev)) THEN - DEALLOCATE(InitOutputData%WaveElev) -ENDIF -IF (ALLOCATED(InitOutputData%WaveTime)) THEN - DEALLOCATE(InitOutputData%WaveTime) -ENDIF - END SUBROUTINE HydroDyn_DestroyInitOutput - - SUBROUTINE HydroDyn_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(HydroDyn_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 = 'HydroDyn_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 ! WAMIT allocated yes/no - IF ( ALLOCATED(InData%WAMIT) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WAMIT upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%WAMIT,1), UBOUND(InData%WAMIT,1) - Int_BufSz = Int_BufSz + 3 ! WAMIT: size of buffers for each call to pack subtype - CALL WAMIT_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%WAMIT(i1), ErrStat2, ErrMsg2, .TRUE. ) ! WAMIT - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! WAMIT - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! WAMIT - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! WAMIT - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! WAMIT2 allocated yes/no - IF ( ALLOCATED(InData%WAMIT2) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WAMIT2 upper/lower bounds for each dimension - DO i1 = LBOUND(InData%WAMIT2,1), UBOUND(InData%WAMIT2,1) - Int_BufSz = Int_BufSz + 3 ! WAMIT2: size of buffers for each call to pack subtype - CALL WAMIT2_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%WAMIT2(i1), ErrStat2, ErrMsg2, .TRUE. ) ! WAMIT2 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! WAMIT2 - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! WAMIT2 - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! WAMIT2 - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! Waves2: size of buffers for each call to pack subtype - CALL Waves2_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%Waves2, ErrStat2, ErrMsg2, .TRUE. ) ! Waves2 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Waves2 - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Waves2 - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Waves2 - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! Morison: size of buffers for each call to pack subtype - CALL Morison_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%Morison, ErrStat2, ErrMsg2, .TRUE. ) ! Morison - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Morison - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Morison - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Morison - 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 - Int_BufSz = Int_BufSz + 1 ! WaveElevSeries allocated yes/no - IF ( ALLOCATED(InData%WaveElevSeries) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! WaveElevSeries upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveElevSeries) ! WaveElevSeries - END IF - 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 - Re_BufSz = Re_BufSz + 1 ! WtrDens - Re_BufSz = Re_BufSz + 1 ! WtrDpth - Re_BufSz = Re_BufSz + 1 ! MSL2SWL - 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 ! 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 - 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 ! WaveVel allocated yes/no - IF ( ALLOCATED(InData%WaveVel) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! WaveVel upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveVel) ! WaveVel - END IF - Int_BufSz = Int_BufSz + 1 ! WaveAcc allocated yes/no - IF ( ALLOCATED(InData%WaveAcc) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! WaveAcc upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveAcc) ! WaveAcc - END IF - Int_BufSz = Int_BufSz + 1 ! WaveDynP allocated yes/no - IF ( ALLOCATED(InData%WaveDynP) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! WaveDynP upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveDynP) ! WaveDynP - END IF - Int_BufSz = Int_BufSz + 1 ! WaveElev allocated yes/no - IF ( ALLOCATED(InData%WaveElev) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! WaveElev upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveElev) ! WaveElev - END IF - Int_BufSz = Int_BufSz + 1 ! WaveTime allocated yes/no - IF ( ALLOCATED(InData%WaveTime) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WaveTime upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveTime) ! WaveTime - 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%WAMIT) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WAMIT,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WAMIT,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WAMIT,1), UBOUND(InData%WAMIT,1) - CALL WAMIT_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%WAMIT(i1), ErrStat2, ErrMsg2, OnlySize ) ! WAMIT - 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%WAMIT2) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WAMIT2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WAMIT2,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WAMIT2,1), UBOUND(InData%WAMIT2,1) - CALL WAMIT2_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%WAMIT2(i1), ErrStat2, ErrMsg2, OnlySize ) ! WAMIT2 - 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 - CALL Waves2_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%Waves2, ErrStat2, ErrMsg2, OnlySize ) ! Waves2 - 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 Morison_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%Morison, ErrStat2, ErrMsg2, OnlySize ) ! Morison - 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 - IF ( .NOT. ALLOCATED(InData%WaveElevSeries) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevSeries,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevSeries,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevSeries,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevSeries,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%WaveElevSeries,2), UBOUND(InData%WaveElevSeries,2) - DO i1 = LBOUND(InData%WaveElevSeries,1), UBOUND(InData%WaveElevSeries,1) - ReKiBuf(Re_Xferred) = InData%WaveElevSeries(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - 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 - ReKiBuf(Re_Xferred) = InData%WtrDens - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WtrDpth - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MSL2SWL - Re_Xferred = Re_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_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%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 - 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%WaveVel) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%WaveVel,3), UBOUND(InData%WaveVel,3) - DO i2 = LBOUND(InData%WaveVel,2), UBOUND(InData%WaveVel,2) - DO i1 = LBOUND(InData%WaveVel,1), UBOUND(InData%WaveVel,1) - ReKiBuf(Re_Xferred) = InData%WaveVel(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveAcc) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%WaveAcc,3), UBOUND(InData%WaveAcc,3) - DO i2 = LBOUND(InData%WaveAcc,2), UBOUND(InData%WaveAcc,2) - DO i1 = LBOUND(InData%WaveAcc,1), UBOUND(InData%WaveAcc,1) - ReKiBuf(Re_Xferred) = InData%WaveAcc(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveDynP) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveDynP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDynP,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveDynP,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDynP,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%WaveDynP,2), UBOUND(InData%WaveDynP,2) - DO i1 = LBOUND(InData%WaveDynP,1), UBOUND(InData%WaveDynP,1) - ReKiBuf(Re_Xferred) = InData%WaveDynP(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveElev) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%WaveElev,2), UBOUND(InData%WaveElev,2) - DO i1 = LBOUND(InData%WaveElev,1), UBOUND(InData%WaveElev,1) - ReKiBuf(Re_Xferred) = InData%WaveElev(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveTime) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveTime,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveTime,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WaveTime,1), UBOUND(InData%WaveTime,1) - ReKiBuf(Re_Xferred) = InData%WaveTime(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE HydroDyn_PackInitOutput - - SUBROUTINE HydroDyn_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(HydroDyn_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) :: 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 = 'HydroDyn_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 ! WAMIT not allocated - Int_Xferred = Int_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%WAMIT)) DEALLOCATE(OutData%WAMIT) - ALLOCATE(OutData%WAMIT(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WAMIT.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WAMIT,1), UBOUND(OutData%WAMIT,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 WAMIT_UnpackInitOutput( Re_Buf, Db_Buf, Int_Buf, OutData%WAMIT(i1), ErrStat2, ErrMsg2 ) ! WAMIT - 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 ! WAMIT2 not allocated - Int_Xferred = Int_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%WAMIT2)) DEALLOCATE(OutData%WAMIT2) - ALLOCATE(OutData%WAMIT2(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WAMIT2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WAMIT2,1), UBOUND(OutData%WAMIT2,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 WAMIT2_UnpackInitOutput( Re_Buf, Db_Buf, Int_Buf, OutData%WAMIT2(i1), ErrStat2, ErrMsg2 ) ! WAMIT2 - 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 - 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 Waves2_UnpackInitOutput( Re_Buf, Db_Buf, Int_Buf, OutData%Waves2, ErrStat2, ErrMsg2 ) ! Waves2 - 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 Morison_UnpackInitOutput( Re_Buf, Db_Buf, Int_Buf, OutData%Morison, ErrStat2, ErrMsg2 ) ! Morison - 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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElevSeries not allocated - Int_Xferred = Int_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%WaveElevSeries)) DEALLOCATE(OutData%WaveElevSeries) - ALLOCATE(OutData%WaveElevSeries(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevSeries.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%WaveElevSeries,2), UBOUND(OutData%WaveElevSeries,2) - DO i1 = LBOUND(OutData%WaveElevSeries,1), UBOUND(OutData%WaveElevSeries,1) - OutData%WaveElevSeries(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - 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 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%WtrDens = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%WtrDpth = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MSL2SWL = ReKiBuf(Re_Xferred) - Re_Xferred = Re_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_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 ! 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 - 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 ! WaveVel not allocated - Int_Xferred = Int_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%WaveVel)) DEALLOCATE(OutData%WaveVel) - ALLOCATE(OutData%WaveVel(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%WaveVel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%WaveVel,3), UBOUND(OutData%WaveVel,3) - DO i2 = LBOUND(OutData%WaveVel,2), UBOUND(OutData%WaveVel,2) - DO i1 = LBOUND(OutData%WaveVel,1), UBOUND(OutData%WaveVel,1) - OutData%WaveVel(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 ! WaveAcc not allocated - Int_Xferred = Int_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%WaveAcc)) DEALLOCATE(OutData%WaveAcc) - ALLOCATE(OutData%WaveAcc(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%WaveAcc.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%WaveAcc,3), UBOUND(OutData%WaveAcc,3) - DO i2 = LBOUND(OutData%WaveAcc,2), UBOUND(OutData%WaveAcc,2) - DO i1 = LBOUND(OutData%WaveAcc,1), UBOUND(OutData%WaveAcc,1) - OutData%WaveAcc(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 ! WaveDynP not allocated - Int_Xferred = Int_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%WaveDynP)) DEALLOCATE(OutData%WaveDynP) - ALLOCATE(OutData%WaveDynP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDynP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%WaveDynP,2), UBOUND(OutData%WaveDynP,2) - DO i1 = LBOUND(OutData%WaveDynP,1), UBOUND(OutData%WaveDynP,1) - OutData%WaveDynP(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElev not allocated - Int_Xferred = Int_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%WaveElev)) DEALLOCATE(OutData%WaveElev) - ALLOCATE(OutData%WaveElev(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%WaveElev,2), UBOUND(OutData%WaveElev,2) - DO i1 = LBOUND(OutData%WaveElev,1), UBOUND(OutData%WaveElev,1) - OutData%WaveElev(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveTime not allocated - Int_Xferred = Int_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%WaveTime)) DEALLOCATE(OutData%WaveTime) - ALLOCATE(OutData%WaveTime(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveTime.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WaveTime,1), UBOUND(OutData%WaveTime,1) - OutData%WaveTime(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE HydroDyn_UnPackInitOutput - - SUBROUTINE HydroDyn_CopyHD_ModuleMapType( SrcHD_ModuleMapTypeData, DstHD_ModuleMapTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(HD_ModuleMapType), INTENT(INOUT) :: SrcHD_ModuleMapTypeData - TYPE(HD_ModuleMapType), INTENT(INOUT) :: DstHD_ModuleMapTypeData - 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 = 'HydroDyn_CopyHD_ModuleMapType' -! - ErrStat = ErrID_None - ErrMsg = "" - CALL NWTC_Library_Copymeshmaptype( SrcHD_ModuleMapTypeData%uW_P_2_PRP_P, DstHD_ModuleMapTypeData%uW_P_2_PRP_P, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcHD_ModuleMapTypeData%W_P_2_PRP_P, DstHD_ModuleMapTypeData%W_P_2_PRP_P, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcHD_ModuleMapTypeData%M_P_2_PRP_P, DstHD_ModuleMapTypeData%M_P_2_PRP_P, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE HydroDyn_CopyHD_ModuleMapType - - SUBROUTINE HydroDyn_DestroyHD_ModuleMapType( HD_ModuleMapTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(HD_ModuleMapType), INTENT(INOUT) :: HD_ModuleMapTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_DestroyHD_ModuleMapType' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL NWTC_Library_Destroymeshmaptype( HD_ModuleMapTypeData%uW_P_2_PRP_P, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL NWTC_Library_Destroymeshmaptype( HD_ModuleMapTypeData%W_P_2_PRP_P, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL NWTC_Library_Destroymeshmaptype( HD_ModuleMapTypeData%M_P_2_PRP_P, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE HydroDyn_DestroyHD_ModuleMapType - - SUBROUTINE HydroDyn_PackHD_ModuleMapType( 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(HD_ModuleMapType), 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 = 'HydroDyn_PackHD_ModuleMapType' - ! 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 ! uW_P_2_PRP_P: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%uW_P_2_PRP_P, ErrStat2, ErrMsg2, .TRUE. ) ! uW_P_2_PRP_P - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! uW_P_2_PRP_P - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! uW_P_2_PRP_P - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! uW_P_2_PRP_P - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! W_P_2_PRP_P: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%W_P_2_PRP_P, ErrStat2, ErrMsg2, .TRUE. ) ! W_P_2_PRP_P - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! W_P_2_PRP_P - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! W_P_2_PRP_P - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! W_P_2_PRP_P - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! M_P_2_PRP_P: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%M_P_2_PRP_P, ErrStat2, ErrMsg2, .TRUE. ) ! M_P_2_PRP_P - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! M_P_2_PRP_P - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! M_P_2_PRP_P - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! M_P_2_PRP_P - 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 NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%uW_P_2_PRP_P, ErrStat2, ErrMsg2, OnlySize ) ! uW_P_2_PRP_P - 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 NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%W_P_2_PRP_P, ErrStat2, ErrMsg2, OnlySize ) ! W_P_2_PRP_P - 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 NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%M_P_2_PRP_P, ErrStat2, ErrMsg2, OnlySize ) ! M_P_2_PRP_P - 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 HydroDyn_PackHD_ModuleMapType - - SUBROUTINE HydroDyn_UnPackHD_ModuleMapType( 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(HD_ModuleMapType), 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 = 'HydroDyn_UnPackHD_ModuleMapType' - ! 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_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%uW_P_2_PRP_P, ErrStat2, ErrMsg2 ) ! uW_P_2_PRP_P - 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 NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%W_P_2_PRP_P, ErrStat2, ErrMsg2 ) ! W_P_2_PRP_P - 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 NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%M_P_2_PRP_P, ErrStat2, ErrMsg2 ) ! M_P_2_PRP_P - 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 HydroDyn_UnPackHD_ModuleMapType - - SUBROUTINE HydroDyn_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(HydroDyn_ContinuousStateType), INTENT(IN) :: SrcContStateData - TYPE(HydroDyn_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 = 'HydroDyn_CopyContState' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcContStateData%WAMIT)) THEN - i1_l = LBOUND(SrcContStateData%WAMIT,1) - i1_u = UBOUND(SrcContStateData%WAMIT,1) - IF (.NOT. ALLOCATED(DstContStateData%WAMIT)) THEN - ALLOCATE(DstContStateData%WAMIT(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%WAMIT.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcContStateData%WAMIT,1), UBOUND(SrcContStateData%WAMIT,1) - CALL WAMIT_CopyContState( SrcContStateData%WAMIT(i1), DstContStateData%WAMIT(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcContStateData%WAMIT2)) THEN - i1_l = LBOUND(SrcContStateData%WAMIT2,1) - i1_u = UBOUND(SrcContStateData%WAMIT2,1) - IF (.NOT. ALLOCATED(DstContStateData%WAMIT2)) THEN - ALLOCATE(DstContStateData%WAMIT2(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%WAMIT2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcContStateData%WAMIT2,1), UBOUND(SrcContStateData%WAMIT2,1) - CALL WAMIT2_CopyContState( SrcContStateData%WAMIT2(i1), DstContStateData%WAMIT2(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL Waves2_CopyContState( SrcContStateData%Waves2, DstContStateData%Waves2, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL Morison_CopyContState( SrcContStateData%Morison, DstContStateData%Morison, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE HydroDyn_CopyContState - - SUBROUTINE HydroDyn_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(HydroDyn_ContinuousStateType), INTENT(INOUT) :: ContStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_DestroyContState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(ContStateData%WAMIT)) THEN -DO i1 = LBOUND(ContStateData%WAMIT,1), UBOUND(ContStateData%WAMIT,1) - CALL WAMIT_DestroyContState( ContStateData%WAMIT(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ContStateData%WAMIT) -ENDIF -IF (ALLOCATED(ContStateData%WAMIT2)) THEN -DO i1 = LBOUND(ContStateData%WAMIT2,1), UBOUND(ContStateData%WAMIT2,1) - CALL WAMIT2_DestroyContState( ContStateData%WAMIT2(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ContStateData%WAMIT2) -ENDIF - CALL Waves2_DestroyContState( ContStateData%Waves2, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL Morison_DestroyContState( ContStateData%Morison, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE HydroDyn_DestroyContState - - SUBROUTINE HydroDyn_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(HydroDyn_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 = 'HydroDyn_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 ! WAMIT allocated yes/no - IF ( ALLOCATED(InData%WAMIT) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WAMIT upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%WAMIT,1), UBOUND(InData%WAMIT,1) - Int_BufSz = Int_BufSz + 3 ! WAMIT: size of buffers for each call to pack subtype - CALL WAMIT_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%WAMIT(i1), ErrStat2, ErrMsg2, .TRUE. ) ! WAMIT - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! WAMIT - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! WAMIT - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! WAMIT - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! WAMIT2 allocated yes/no - IF ( ALLOCATED(InData%WAMIT2) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WAMIT2 upper/lower bounds for each dimension - DO i1 = LBOUND(InData%WAMIT2,1), UBOUND(InData%WAMIT2,1) - Int_BufSz = Int_BufSz + 3 ! WAMIT2: size of buffers for each call to pack subtype - CALL WAMIT2_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%WAMIT2(i1), ErrStat2, ErrMsg2, .TRUE. ) ! WAMIT2 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! WAMIT2 - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! WAMIT2 - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! WAMIT2 - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! Waves2: size of buffers for each call to pack subtype - CALL Waves2_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%Waves2, ErrStat2, ErrMsg2, .TRUE. ) ! Waves2 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Waves2 - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Waves2 - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Waves2 - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! Morison: size of buffers for each call to pack subtype - CALL Morison_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%Morison, ErrStat2, ErrMsg2, .TRUE. ) ! Morison - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Morison - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Morison - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Morison - 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%WAMIT) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WAMIT,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WAMIT,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WAMIT,1), UBOUND(InData%WAMIT,1) - CALL WAMIT_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%WAMIT(i1), ErrStat2, ErrMsg2, OnlySize ) ! WAMIT - 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%WAMIT2) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WAMIT2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WAMIT2,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WAMIT2,1), UBOUND(InData%WAMIT2,1) - CALL WAMIT2_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%WAMIT2(i1), ErrStat2, ErrMsg2, OnlySize ) ! WAMIT2 - 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 - CALL Waves2_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%Waves2, ErrStat2, ErrMsg2, OnlySize ) ! Waves2 - 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 Morison_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%Morison, ErrStat2, ErrMsg2, OnlySize ) ! Morison - 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 HydroDyn_PackContState - - SUBROUTINE HydroDyn_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(HydroDyn_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 = 'HydroDyn_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 ! WAMIT not allocated - Int_Xferred = Int_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%WAMIT)) DEALLOCATE(OutData%WAMIT) - ALLOCATE(OutData%WAMIT(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WAMIT.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WAMIT,1), UBOUND(OutData%WAMIT,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 WAMIT_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%WAMIT(i1), ErrStat2, ErrMsg2 ) ! WAMIT - 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 ! WAMIT2 not allocated - Int_Xferred = Int_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%WAMIT2)) DEALLOCATE(OutData%WAMIT2) - ALLOCATE(OutData%WAMIT2(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WAMIT2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WAMIT2,1), UBOUND(OutData%WAMIT2,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 WAMIT2_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%WAMIT2(i1), ErrStat2, ErrMsg2 ) ! WAMIT2 - 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 - 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 Waves2_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%Waves2, ErrStat2, ErrMsg2 ) ! Waves2 - 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 Morison_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%Morison, ErrStat2, ErrMsg2 ) ! Morison - 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 HydroDyn_UnPackContState - - SUBROUTINE HydroDyn_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(HydroDyn_DiscreteStateType), INTENT(IN) :: SrcDiscStateData - TYPE(HydroDyn_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 = 'HydroDyn_CopyDiscState' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcDiscStateData%WAMIT)) THEN - i1_l = LBOUND(SrcDiscStateData%WAMIT,1) - i1_u = UBOUND(SrcDiscStateData%WAMIT,1) - IF (.NOT. ALLOCATED(DstDiscStateData%WAMIT)) THEN - ALLOCATE(DstDiscStateData%WAMIT(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%WAMIT.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcDiscStateData%WAMIT,1), UBOUND(SrcDiscStateData%WAMIT,1) - CALL WAMIT_CopyDiscState( SrcDiscStateData%WAMIT(i1), DstDiscStateData%WAMIT(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcDiscStateData%WAMIT2)) THEN - i1_l = LBOUND(SrcDiscStateData%WAMIT2,1) - i1_u = UBOUND(SrcDiscStateData%WAMIT2,1) - IF (.NOT. ALLOCATED(DstDiscStateData%WAMIT2)) THEN - ALLOCATE(DstDiscStateData%WAMIT2(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%WAMIT2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcDiscStateData%WAMIT2,1), UBOUND(SrcDiscStateData%WAMIT2,1) - CALL WAMIT2_CopyDiscState( SrcDiscStateData%WAMIT2(i1), DstDiscStateData%WAMIT2(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL Waves2_CopyDiscState( SrcDiscStateData%Waves2, DstDiscStateData%Waves2, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL Morison_CopyDiscState( SrcDiscStateData%Morison, DstDiscStateData%Morison, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE HydroDyn_CopyDiscState - - SUBROUTINE HydroDyn_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(HydroDyn_DiscreteStateType), INTENT(INOUT) :: DiscStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_DestroyDiscState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(DiscStateData%WAMIT)) THEN -DO i1 = LBOUND(DiscStateData%WAMIT,1), UBOUND(DiscStateData%WAMIT,1) - CALL WAMIT_DestroyDiscState( DiscStateData%WAMIT(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(DiscStateData%WAMIT) -ENDIF -IF (ALLOCATED(DiscStateData%WAMIT2)) THEN -DO i1 = LBOUND(DiscStateData%WAMIT2,1), UBOUND(DiscStateData%WAMIT2,1) - CALL WAMIT2_DestroyDiscState( DiscStateData%WAMIT2(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(DiscStateData%WAMIT2) -ENDIF - CALL Waves2_DestroyDiscState( DiscStateData%Waves2, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL Morison_DestroyDiscState( DiscStateData%Morison, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE HydroDyn_DestroyDiscState - - SUBROUTINE HydroDyn_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(HydroDyn_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 = 'HydroDyn_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 ! WAMIT allocated yes/no - IF ( ALLOCATED(InData%WAMIT) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WAMIT upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%WAMIT,1), UBOUND(InData%WAMIT,1) - Int_BufSz = Int_BufSz + 3 ! WAMIT: size of buffers for each call to pack subtype - CALL WAMIT_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%WAMIT(i1), ErrStat2, ErrMsg2, .TRUE. ) ! WAMIT - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! WAMIT - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! WAMIT - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! WAMIT - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! WAMIT2 allocated yes/no - IF ( ALLOCATED(InData%WAMIT2) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WAMIT2 upper/lower bounds for each dimension - DO i1 = LBOUND(InData%WAMIT2,1), UBOUND(InData%WAMIT2,1) - Int_BufSz = Int_BufSz + 3 ! WAMIT2: size of buffers for each call to pack subtype - CALL WAMIT2_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%WAMIT2(i1), ErrStat2, ErrMsg2, .TRUE. ) ! WAMIT2 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! WAMIT2 - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! WAMIT2 - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! WAMIT2 - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! Waves2: size of buffers for each call to pack subtype - CALL Waves2_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%Waves2, ErrStat2, ErrMsg2, .TRUE. ) ! Waves2 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Waves2 - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Waves2 - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Waves2 - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! Morison: size of buffers for each call to pack subtype - CALL Morison_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%Morison, ErrStat2, ErrMsg2, .TRUE. ) ! Morison - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Morison - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Morison - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Morison - 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%WAMIT) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WAMIT,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WAMIT,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WAMIT,1), UBOUND(InData%WAMIT,1) - CALL WAMIT_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%WAMIT(i1), ErrStat2, ErrMsg2, OnlySize ) ! WAMIT - 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%WAMIT2) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WAMIT2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WAMIT2,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WAMIT2,1), UBOUND(InData%WAMIT2,1) - CALL WAMIT2_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%WAMIT2(i1), ErrStat2, ErrMsg2, OnlySize ) ! WAMIT2 - 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 - CALL Waves2_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%Waves2, ErrStat2, ErrMsg2, OnlySize ) ! Waves2 - 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 Morison_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%Morison, ErrStat2, ErrMsg2, OnlySize ) ! Morison - 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 HydroDyn_PackDiscState - - SUBROUTINE HydroDyn_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(HydroDyn_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 = 'HydroDyn_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 ! WAMIT not allocated - Int_Xferred = Int_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%WAMIT)) DEALLOCATE(OutData%WAMIT) - ALLOCATE(OutData%WAMIT(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WAMIT.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WAMIT,1), UBOUND(OutData%WAMIT,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 WAMIT_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%WAMIT(i1), ErrStat2, ErrMsg2 ) ! WAMIT - 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 ! WAMIT2 not allocated - Int_Xferred = Int_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%WAMIT2)) DEALLOCATE(OutData%WAMIT2) - ALLOCATE(OutData%WAMIT2(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WAMIT2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WAMIT2,1), UBOUND(OutData%WAMIT2,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 WAMIT2_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%WAMIT2(i1), ErrStat2, ErrMsg2 ) ! WAMIT2 - 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 - 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 Waves2_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%Waves2, ErrStat2, ErrMsg2 ) ! Waves2 - 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 Morison_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%Morison, ErrStat2, ErrMsg2 ) ! Morison - 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 HydroDyn_UnPackDiscState - - SUBROUTINE HydroDyn_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(HydroDyn_ConstraintStateType), INTENT(IN) :: SrcConstrStateData - TYPE(HydroDyn_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 = 'HydroDyn_CopyConstrState' -! - ErrStat = ErrID_None - ErrMsg = "" - CALL WAMIT_CopyConstrState( SrcConstrStateData%WAMIT, DstConstrStateData%WAMIT, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL WAMIT2_CopyConstrState( SrcConstrStateData%WAMIT2, DstConstrStateData%WAMIT2, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL Waves2_CopyConstrState( SrcConstrStateData%Waves2, DstConstrStateData%Waves2, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL Morison_CopyConstrState( SrcConstrStateData%Morison, DstConstrStateData%Morison, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE HydroDyn_CopyConstrState - - SUBROUTINE HydroDyn_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(HydroDyn_ConstraintStateType), INTENT(INOUT) :: ConstrStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_DestroyConstrState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL WAMIT_DestroyConstrState( ConstrStateData%WAMIT, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL WAMIT2_DestroyConstrState( ConstrStateData%WAMIT2, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL Waves2_DestroyConstrState( ConstrStateData%Waves2, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL Morison_DestroyConstrState( ConstrStateData%Morison, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE HydroDyn_DestroyConstrState - - SUBROUTINE HydroDyn_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(HydroDyn_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 = 'HydroDyn_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 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! WAMIT: size of buffers for each call to pack subtype - CALL WAMIT_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%WAMIT, ErrStat2, ErrMsg2, .TRUE. ) ! WAMIT - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! WAMIT - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! WAMIT - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! WAMIT - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! WAMIT2: size of buffers for each call to pack subtype - CALL WAMIT2_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%WAMIT2, ErrStat2, ErrMsg2, .TRUE. ) ! WAMIT2 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! WAMIT2 - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! WAMIT2 - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! WAMIT2 - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! Waves2: size of buffers for each call to pack subtype - CALL Waves2_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%Waves2, ErrStat2, ErrMsg2, .TRUE. ) ! Waves2 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Waves2 - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Waves2 - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Waves2 - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! Morison: size of buffers for each call to pack subtype - CALL Morison_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%Morison, ErrStat2, ErrMsg2, .TRUE. ) ! Morison - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Morison - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Morison - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Morison - 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 WAMIT_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%WAMIT, ErrStat2, ErrMsg2, OnlySize ) ! WAMIT - 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 WAMIT2_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%WAMIT2, ErrStat2, ErrMsg2, OnlySize ) ! WAMIT2 - 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 Waves2_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%Waves2, ErrStat2, ErrMsg2, OnlySize ) ! Waves2 - 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 Morison_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%Morison, ErrStat2, ErrMsg2, OnlySize ) ! Morison - 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 HydroDyn_PackConstrState - - SUBROUTINE HydroDyn_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(HydroDyn_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 = 'HydroDyn_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 - 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 WAMIT_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%WAMIT, ErrStat2, ErrMsg2 ) ! WAMIT - 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 WAMIT2_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%WAMIT2, ErrStat2, ErrMsg2 ) ! WAMIT2 - 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 Waves2_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%Waves2, ErrStat2, ErrMsg2 ) ! Waves2 - 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 Morison_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%Morison, ErrStat2, ErrMsg2 ) ! Morison - 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 HydroDyn_UnPackConstrState - - SUBROUTINE HydroDyn_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(HydroDyn_OtherStateType), INTENT(IN) :: SrcOtherStateData - TYPE(HydroDyn_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 = 'HydroDyn_CopyOtherState' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcOtherStateData%WAMIT)) THEN - i1_l = LBOUND(SrcOtherStateData%WAMIT,1) - i1_u = UBOUND(SrcOtherStateData%WAMIT,1) - IF (.NOT. ALLOCATED(DstOtherStateData%WAMIT)) THEN - ALLOCATE(DstOtherStateData%WAMIT(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%WAMIT.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcOtherStateData%WAMIT,1), UBOUND(SrcOtherStateData%WAMIT,1) - CALL WAMIT_CopyOtherState( SrcOtherStateData%WAMIT(i1), DstOtherStateData%WAMIT(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcOtherStateData%WAMIT2)) THEN - i1_l = LBOUND(SrcOtherStateData%WAMIT2,1) - i1_u = UBOUND(SrcOtherStateData%WAMIT2,1) - IF (.NOT. ALLOCATED(DstOtherStateData%WAMIT2)) THEN - ALLOCATE(DstOtherStateData%WAMIT2(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%WAMIT2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcOtherStateData%WAMIT2,1), UBOUND(SrcOtherStateData%WAMIT2,1) - CALL WAMIT2_CopyOtherState( SrcOtherStateData%WAMIT2(i1), DstOtherStateData%WAMIT2(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL Waves2_CopyOtherState( SrcOtherStateData%Waves2, DstOtherStateData%Waves2, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL Morison_CopyOtherState( SrcOtherStateData%Morison, DstOtherStateData%Morison, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE HydroDyn_CopyOtherState - - SUBROUTINE HydroDyn_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(HydroDyn_OtherStateType), INTENT(INOUT) :: OtherStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_DestroyOtherState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(OtherStateData%WAMIT)) THEN -DO i1 = LBOUND(OtherStateData%WAMIT,1), UBOUND(OtherStateData%WAMIT,1) - CALL WAMIT_DestroyOtherState( OtherStateData%WAMIT(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(OtherStateData%WAMIT) -ENDIF -IF (ALLOCATED(OtherStateData%WAMIT2)) THEN -DO i1 = LBOUND(OtherStateData%WAMIT2,1), UBOUND(OtherStateData%WAMIT2,1) - CALL WAMIT2_DestroyOtherState( OtherStateData%WAMIT2(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(OtherStateData%WAMIT2) -ENDIF - CALL Waves2_DestroyOtherState( OtherStateData%Waves2, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL Morison_DestroyOtherState( OtherStateData%Morison, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE HydroDyn_DestroyOtherState - - SUBROUTINE HydroDyn_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(HydroDyn_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 = 'HydroDyn_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 ! WAMIT allocated yes/no - IF ( ALLOCATED(InData%WAMIT) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WAMIT upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%WAMIT,1), UBOUND(InData%WAMIT,1) - Int_BufSz = Int_BufSz + 3 ! WAMIT: size of buffers for each call to pack subtype - CALL WAMIT_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%WAMIT(i1), ErrStat2, ErrMsg2, .TRUE. ) ! WAMIT - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! WAMIT - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! WAMIT - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! WAMIT - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! WAMIT2 allocated yes/no - IF ( ALLOCATED(InData%WAMIT2) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WAMIT2 upper/lower bounds for each dimension - DO i1 = LBOUND(InData%WAMIT2,1), UBOUND(InData%WAMIT2,1) - Int_BufSz = Int_BufSz + 3 ! WAMIT2: size of buffers for each call to pack subtype - CALL WAMIT2_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%WAMIT2(i1), ErrStat2, ErrMsg2, .TRUE. ) ! WAMIT2 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! WAMIT2 - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! WAMIT2 - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! WAMIT2 - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! Waves2: size of buffers for each call to pack subtype - CALL Waves2_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%Waves2, ErrStat2, ErrMsg2, .TRUE. ) ! Waves2 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Waves2 - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Waves2 - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Waves2 - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! Morison: size of buffers for each call to pack subtype - CALL Morison_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%Morison, ErrStat2, ErrMsg2, .TRUE. ) ! Morison - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Morison - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Morison - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Morison - 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%WAMIT) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WAMIT,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WAMIT,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WAMIT,1), UBOUND(InData%WAMIT,1) - CALL WAMIT_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%WAMIT(i1), ErrStat2, ErrMsg2, OnlySize ) ! WAMIT - 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%WAMIT2) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WAMIT2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WAMIT2,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WAMIT2,1), UBOUND(InData%WAMIT2,1) - CALL WAMIT2_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%WAMIT2(i1), ErrStat2, ErrMsg2, OnlySize ) ! WAMIT2 - 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 - CALL Waves2_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%Waves2, ErrStat2, ErrMsg2, OnlySize ) ! Waves2 - 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 Morison_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%Morison, ErrStat2, ErrMsg2, OnlySize ) ! Morison - 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 HydroDyn_PackOtherState - - SUBROUTINE HydroDyn_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(HydroDyn_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 = 'HydroDyn_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 ! WAMIT not allocated - Int_Xferred = Int_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%WAMIT)) DEALLOCATE(OutData%WAMIT) - ALLOCATE(OutData%WAMIT(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WAMIT.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WAMIT,1), UBOUND(OutData%WAMIT,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 WAMIT_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%WAMIT(i1), ErrStat2, ErrMsg2 ) ! WAMIT - 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 ! WAMIT2 not allocated - Int_Xferred = Int_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%WAMIT2)) DEALLOCATE(OutData%WAMIT2) - ALLOCATE(OutData%WAMIT2(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WAMIT2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WAMIT2,1), UBOUND(OutData%WAMIT2,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 WAMIT2_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%WAMIT2(i1), ErrStat2, ErrMsg2 ) ! WAMIT2 - 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 - 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 Waves2_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%Waves2, ErrStat2, ErrMsg2 ) ! Waves2 - 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 Morison_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%Morison, ErrStat2, ErrMsg2 ) ! Morison - 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 HydroDyn_UnPackOtherState - - SUBROUTINE HydroDyn_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(HydroDyn_MiscVarType), INTENT(INOUT) :: SrcMiscData - TYPE(HydroDyn_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 = 'HydroDyn_CopyMisc' -! - ErrStat = ErrID_None - ErrMsg = "" - CALL MeshCopy( SrcMiscData%AllHdroOrigin, DstMiscData%AllHdroOrigin, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcMiscData%MrsnMesh_position, DstMiscData%MrsnMesh_position, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL HydroDyn_Copyhd_modulemaptype( SrcMiscData%HD_MeshMap, DstMiscData%HD_MeshMap, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstMiscData%Decimate = SrcMiscData%Decimate - DstMiscData%LastOutTime = SrcMiscData%LastOutTime - DstMiscData%LastIndWave = SrcMiscData%LastIndWave -IF (ALLOCATED(SrcMiscData%F_PtfmAdd)) THEN - i1_l = LBOUND(SrcMiscData%F_PtfmAdd,1) - i1_u = UBOUND(SrcMiscData%F_PtfmAdd,1) - IF (.NOT. ALLOCATED(DstMiscData%F_PtfmAdd)) THEN - ALLOCATE(DstMiscData%F_PtfmAdd(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_PtfmAdd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%F_PtfmAdd = SrcMiscData%F_PtfmAdd -ENDIF - DstMiscData%F_Hydro = SrcMiscData%F_Hydro -IF (ALLOCATED(SrcMiscData%F_Waves)) THEN - i1_l = LBOUND(SrcMiscData%F_Waves,1) - i1_u = UBOUND(SrcMiscData%F_Waves,1) - IF (.NOT. ALLOCATED(DstMiscData%F_Waves)) THEN - ALLOCATE(DstMiscData%F_Waves(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_Waves.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%F_Waves = SrcMiscData%F_Waves -ENDIF -IF (ALLOCATED(SrcMiscData%WAMIT)) THEN - i1_l = LBOUND(SrcMiscData%WAMIT,1) - i1_u = UBOUND(SrcMiscData%WAMIT,1) - IF (.NOT. ALLOCATED(DstMiscData%WAMIT)) THEN - ALLOCATE(DstMiscData%WAMIT(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%WAMIT.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%WAMIT,1), UBOUND(SrcMiscData%WAMIT,1) - CALL WAMIT_CopyMisc( SrcMiscData%WAMIT(i1), DstMiscData%WAMIT(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcMiscData%WAMIT2)) THEN - i1_l = LBOUND(SrcMiscData%WAMIT2,1) - i1_u = UBOUND(SrcMiscData%WAMIT2,1) - IF (.NOT. ALLOCATED(DstMiscData%WAMIT2)) THEN - ALLOCATE(DstMiscData%WAMIT2(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%WAMIT2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%WAMIT2,1), UBOUND(SrcMiscData%WAMIT2,1) - CALL WAMIT2_CopyMisc( SrcMiscData%WAMIT2(i1), DstMiscData%WAMIT2(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL Waves2_CopyMisc( SrcMiscData%Waves2, DstMiscData%Waves2, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL Morison_CopyMisc( SrcMiscData%Morison, DstMiscData%Morison, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcMiscData%u_WAMIT)) THEN - i1_l = LBOUND(SrcMiscData%u_WAMIT,1) - i1_u = UBOUND(SrcMiscData%u_WAMIT,1) - IF (.NOT. ALLOCATED(DstMiscData%u_WAMIT)) THEN - ALLOCATE(DstMiscData%u_WAMIT(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%u_WAMIT.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%u_WAMIT,1), UBOUND(SrcMiscData%u_WAMIT,1) - CALL WAMIT_CopyInput( SrcMiscData%u_WAMIT(i1), DstMiscData%u_WAMIT(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcMiscData%u_WAMIT2)) THEN - i1_l = LBOUND(SrcMiscData%u_WAMIT2,1) - i1_u = UBOUND(SrcMiscData%u_WAMIT2,1) - IF (.NOT. ALLOCATED(DstMiscData%u_WAMIT2)) THEN - ALLOCATE(DstMiscData%u_WAMIT2(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%u_WAMIT2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%u_WAMIT2,1), UBOUND(SrcMiscData%u_WAMIT2,1) - CALL WAMIT2_CopyInput( SrcMiscData%u_WAMIT2(i1), DstMiscData%u_WAMIT2(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL Waves2_CopyInput( SrcMiscData%u_Waves2, DstMiscData%u_Waves2, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE HydroDyn_CopyMisc - - SUBROUTINE HydroDyn_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(HydroDyn_MiscVarType), INTENT(INOUT) :: MiscData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_DestroyMisc' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL MeshDestroy( MiscData%AllHdroOrigin, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( MiscData%MrsnMesh_position, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL HydroDyn_Destroyhd_modulemaptype( MiscData%HD_MeshMap, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(MiscData%F_PtfmAdd)) THEN - DEALLOCATE(MiscData%F_PtfmAdd) -ENDIF -IF (ALLOCATED(MiscData%F_Waves)) THEN - DEALLOCATE(MiscData%F_Waves) -ENDIF -IF (ALLOCATED(MiscData%WAMIT)) THEN -DO i1 = LBOUND(MiscData%WAMIT,1), UBOUND(MiscData%WAMIT,1) - CALL WAMIT_DestroyMisc( MiscData%WAMIT(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MiscData%WAMIT) -ENDIF -IF (ALLOCATED(MiscData%WAMIT2)) THEN -DO i1 = LBOUND(MiscData%WAMIT2,1), UBOUND(MiscData%WAMIT2,1) - CALL WAMIT2_DestroyMisc( MiscData%WAMIT2(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MiscData%WAMIT2) -ENDIF - CALL Waves2_DestroyMisc( MiscData%Waves2, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL Morison_DestroyMisc( MiscData%Morison, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(MiscData%u_WAMIT)) THEN -DO i1 = LBOUND(MiscData%u_WAMIT,1), UBOUND(MiscData%u_WAMIT,1) - CALL WAMIT_DestroyInput( MiscData%u_WAMIT(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MiscData%u_WAMIT) -ENDIF -IF (ALLOCATED(MiscData%u_WAMIT2)) THEN -DO i1 = LBOUND(MiscData%u_WAMIT2,1), UBOUND(MiscData%u_WAMIT2,1) - CALL WAMIT2_DestroyInput( MiscData%u_WAMIT2(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MiscData%u_WAMIT2) -ENDIF - CALL Waves2_DestroyInput( MiscData%u_Waves2, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE HydroDyn_DestroyMisc - - SUBROUTINE HydroDyn_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(HydroDyn_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 = 'HydroDyn_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 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! AllHdroOrigin: size of buffers for each call to pack subtype - CALL MeshPack( InData%AllHdroOrigin, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! AllHdroOrigin - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! AllHdroOrigin - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! AllHdroOrigin - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! AllHdroOrigin - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! MrsnMesh_position: size of buffers for each call to pack subtype - CALL MeshPack( InData%MrsnMesh_position, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! MrsnMesh_position - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! MrsnMesh_position - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! MrsnMesh_position - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! MrsnMesh_position - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! HD_MeshMap: size of buffers for each call to pack subtype - CALL HydroDyn_Packhd_modulemaptype( Re_Buf, Db_Buf, Int_Buf, InData%HD_MeshMap, ErrStat2, ErrMsg2, .TRUE. ) ! HD_MeshMap - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! HD_MeshMap - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! HD_MeshMap - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! HD_MeshMap - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! Decimate - Db_BufSz = Db_BufSz + 1 ! LastOutTime - Int_BufSz = Int_BufSz + 1 ! LastIndWave - Int_BufSz = Int_BufSz + 1 ! F_PtfmAdd allocated yes/no - IF ( ALLOCATED(InData%F_PtfmAdd) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! F_PtfmAdd upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_PtfmAdd) ! F_PtfmAdd - END IF - Re_BufSz = Re_BufSz + SIZE(InData%F_Hydro) ! F_Hydro - Int_BufSz = Int_BufSz + 1 ! F_Waves allocated yes/no - IF ( ALLOCATED(InData%F_Waves) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! F_Waves upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_Waves) ! F_Waves - END IF - Int_BufSz = Int_BufSz + 1 ! WAMIT allocated yes/no - IF ( ALLOCATED(InData%WAMIT) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WAMIT upper/lower bounds for each dimension - DO i1 = LBOUND(InData%WAMIT,1), UBOUND(InData%WAMIT,1) - Int_BufSz = Int_BufSz + 3 ! WAMIT: size of buffers for each call to pack subtype - CALL WAMIT_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%WAMIT(i1), ErrStat2, ErrMsg2, .TRUE. ) ! WAMIT - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! WAMIT - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! WAMIT - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! WAMIT - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! WAMIT2 allocated yes/no - IF ( ALLOCATED(InData%WAMIT2) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WAMIT2 upper/lower bounds for each dimension - DO i1 = LBOUND(InData%WAMIT2,1), UBOUND(InData%WAMIT2,1) - Int_BufSz = Int_BufSz + 3 ! WAMIT2: size of buffers for each call to pack subtype - CALL WAMIT2_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%WAMIT2(i1), ErrStat2, ErrMsg2, .TRUE. ) ! WAMIT2 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! WAMIT2 - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! WAMIT2 - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! WAMIT2 - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! Waves2: size of buffers for each call to pack subtype - CALL Waves2_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%Waves2, ErrStat2, ErrMsg2, .TRUE. ) ! Waves2 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Waves2 - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Waves2 - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Waves2 - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! Morison: size of buffers for each call to pack subtype - CALL Morison_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%Morison, ErrStat2, ErrMsg2, .TRUE. ) ! Morison - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Morison - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Morison - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Morison - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! u_WAMIT allocated yes/no - IF ( ALLOCATED(InData%u_WAMIT) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! u_WAMIT upper/lower bounds for each dimension - DO i1 = LBOUND(InData%u_WAMIT,1), UBOUND(InData%u_WAMIT,1) - Int_BufSz = Int_BufSz + 3 ! u_WAMIT: size of buffers for each call to pack subtype - CALL WAMIT_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_WAMIT(i1), ErrStat2, ErrMsg2, .TRUE. ) ! u_WAMIT - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_WAMIT - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_WAMIT - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_WAMIT - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! u_WAMIT2 allocated yes/no - IF ( ALLOCATED(InData%u_WAMIT2) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! u_WAMIT2 upper/lower bounds for each dimension - DO i1 = LBOUND(InData%u_WAMIT2,1), UBOUND(InData%u_WAMIT2,1) - Int_BufSz = Int_BufSz + 3 ! u_WAMIT2: size of buffers for each call to pack subtype - CALL WAMIT2_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_WAMIT2(i1), ErrStat2, ErrMsg2, .TRUE. ) ! u_WAMIT2 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_WAMIT2 - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_WAMIT2 - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_WAMIT2 - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! u_Waves2: size of buffers for each call to pack subtype - CALL Waves2_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_Waves2, ErrStat2, ErrMsg2, .TRUE. ) ! u_Waves2 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_Waves2 - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_Waves2 - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_Waves2 - 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%AllHdroOrigin, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! AllHdroOrigin - 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%MrsnMesh_position, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! MrsnMesh_position - 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 HydroDyn_Packhd_modulemaptype( Re_Buf, Db_Buf, Int_Buf, InData%HD_MeshMap, ErrStat2, ErrMsg2, OnlySize ) ! HD_MeshMap - 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%Decimate - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%LastOutTime - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%LastIndWave - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%F_PtfmAdd) ) THEN - 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_PtfmAdd,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_PtfmAdd,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%F_PtfmAdd,1), UBOUND(InData%F_PtfmAdd,1) - ReKiBuf(Re_Xferred) = InData%F_PtfmAdd(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - DO i1 = LBOUND(InData%F_Hydro,1), UBOUND(InData%F_Hydro,1) - ReKiBuf(Re_Xferred) = InData%F_Hydro(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%F_Waves) ) THEN - 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_Waves,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_Waves,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%F_Waves,1), UBOUND(InData%F_Waves,1) - ReKiBuf(Re_Xferred) = InData%F_Waves(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WAMIT) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WAMIT,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WAMIT,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WAMIT,1), UBOUND(InData%WAMIT,1) - CALL WAMIT_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%WAMIT(i1), ErrStat2, ErrMsg2, OnlySize ) ! WAMIT - 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%WAMIT2) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WAMIT2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WAMIT2,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WAMIT2,1), UBOUND(InData%WAMIT2,1) - CALL WAMIT2_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%WAMIT2(i1), ErrStat2, ErrMsg2, OnlySize ) ! WAMIT2 - 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 - CALL Waves2_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%Waves2, ErrStat2, ErrMsg2, OnlySize ) ! Waves2 - 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 Morison_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%Morison, ErrStat2, ErrMsg2, OnlySize ) ! Morison - 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%u_WAMIT) ) THEN - 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_WAMIT,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_WAMIT,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%u_WAMIT,1), UBOUND(InData%u_WAMIT,1) - CALL WAMIT_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_WAMIT(i1), ErrStat2, ErrMsg2, OnlySize ) ! u_WAMIT - 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%u_WAMIT2) ) THEN - 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_WAMIT2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_WAMIT2,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%u_WAMIT2,1), UBOUND(InData%u_WAMIT2,1) - CALL WAMIT2_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_WAMIT2(i1), ErrStat2, ErrMsg2, OnlySize ) ! u_WAMIT2 - 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 - CALL Waves2_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_Waves2, ErrStat2, ErrMsg2, OnlySize ) ! u_Waves2 - 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 HydroDyn_PackMisc - - SUBROUTINE HydroDyn_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(HydroDyn_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 = 'HydroDyn_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 - 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%AllHdroOrigin, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! AllHdroOrigin - 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%MrsnMesh_position, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! MrsnMesh_position - 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 HydroDyn_Unpackhd_modulemaptype( Re_Buf, Db_Buf, Int_Buf, OutData%HD_MeshMap, ErrStat2, ErrMsg2 ) ! HD_MeshMap - 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%Decimate = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%LastOutTime = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%LastIndWave = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_PtfmAdd not allocated - Int_Xferred = Int_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_PtfmAdd)) DEALLOCATE(OutData%F_PtfmAdd) - ALLOCATE(OutData%F_PtfmAdd(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_PtfmAdd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%F_PtfmAdd,1), UBOUND(OutData%F_PtfmAdd,1) - OutData%F_PtfmAdd(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - i1_l = LBOUND(OutData%F_Hydro,1) - i1_u = UBOUND(OutData%F_Hydro,1) - DO i1 = LBOUND(OutData%F_Hydro,1), UBOUND(OutData%F_Hydro,1) - OutData%F_Hydro(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_Waves not allocated - Int_Xferred = Int_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_Waves)) DEALLOCATE(OutData%F_Waves) - ALLOCATE(OutData%F_Waves(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_Waves.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%F_Waves,1), UBOUND(OutData%F_Waves,1) - OutData%F_Waves(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WAMIT not allocated - Int_Xferred = Int_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%WAMIT)) DEALLOCATE(OutData%WAMIT) - ALLOCATE(OutData%WAMIT(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WAMIT.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WAMIT,1), UBOUND(OutData%WAMIT,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 WAMIT_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%WAMIT(i1), ErrStat2, ErrMsg2 ) ! WAMIT - 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 ! WAMIT2 not allocated - Int_Xferred = Int_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%WAMIT2)) DEALLOCATE(OutData%WAMIT2) - ALLOCATE(OutData%WAMIT2(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WAMIT2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WAMIT2,1), UBOUND(OutData%WAMIT2,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 WAMIT2_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%WAMIT2(i1), ErrStat2, ErrMsg2 ) ! WAMIT2 - 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 - 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 Waves2_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%Waves2, ErrStat2, ErrMsg2 ) ! Waves2 - 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 Morison_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%Morison, ErrStat2, ErrMsg2 ) ! Morison - 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 ! u_WAMIT not allocated - Int_Xferred = Int_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_WAMIT)) DEALLOCATE(OutData%u_WAMIT) - ALLOCATE(OutData%u_WAMIT(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_WAMIT.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%u_WAMIT,1), UBOUND(OutData%u_WAMIT,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 WAMIT_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u_WAMIT(i1), ErrStat2, ErrMsg2 ) ! u_WAMIT - 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 ! u_WAMIT2 not allocated - Int_Xferred = Int_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_WAMIT2)) DEALLOCATE(OutData%u_WAMIT2) - ALLOCATE(OutData%u_WAMIT2(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_WAMIT2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%u_WAMIT2,1), UBOUND(OutData%u_WAMIT2,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 WAMIT2_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u_WAMIT2(i1), ErrStat2, ErrMsg2 ) ! u_WAMIT2 - 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 - 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 Waves2_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u_Waves2, ErrStat2, ErrMsg2 ) ! u_Waves2 - 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 HydroDyn_UnPackMisc - - SUBROUTINE HydroDyn_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(HydroDyn_ParameterType), INTENT(IN) :: SrcParamData - TYPE(HydroDyn_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) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_CopyParam' -! +subroutine HydroDyn_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg) + type(HydroDyn_InputFile), intent(in) :: SrcInputFileData + type(HydroDyn_InputFile), intent(inout) :: DstInputFileData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'HydroDyn_CopyInputFile' ErrStat = ErrID_None - ErrMsg = "" - DstParamData%nWAMITObj = SrcParamData%nWAMITObj - DstParamData%vecMultiplier = SrcParamData%vecMultiplier -IF (ALLOCATED(SrcParamData%WAMIT)) THEN - i1_l = LBOUND(SrcParamData%WAMIT,1) - i1_u = UBOUND(SrcParamData%WAMIT,1) - IF (.NOT. ALLOCATED(DstParamData%WAMIT)) THEN - ALLOCATE(DstParamData%WAMIT(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WAMIT.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcParamData%WAMIT,1), UBOUND(SrcParamData%WAMIT,1) - CALL WAMIT_CopyParam( SrcParamData%WAMIT(i1), DstParamData%WAMIT(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcParamData%WAMIT2)) THEN - i1_l = LBOUND(SrcParamData%WAMIT2,1) - i1_u = UBOUND(SrcParamData%WAMIT2,1) - IF (.NOT. ALLOCATED(DstParamData%WAMIT2)) THEN - ALLOCATE(DstParamData%WAMIT2(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WAMIT2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcParamData%WAMIT2,1), UBOUND(SrcParamData%WAMIT2,1) - CALL WAMIT2_CopyParam( SrcParamData%WAMIT2(i1), DstParamData%WAMIT2(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - DstParamData%WAMIT2used = SrcParamData%WAMIT2used - CALL Waves2_CopyParam( SrcParamData%Waves2, DstParamData%Waves2, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL Morison_CopyParam( SrcParamData%Morison, DstParamData%Morison, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstParamData%PotMod = SrcParamData%PotMod - DstParamData%NBody = SrcParamData%NBody - DstParamData%NBodyMod = SrcParamData%NBodyMod - DstParamData%totalStates = SrcParamData%totalStates - DstParamData%totalExctnStates = SrcParamData%totalExctnStates - DstParamData%totalRdtnStates = SrcParamData%totalRdtnStates -IF (ALLOCATED(SrcParamData%WaveTime)) THEN - i1_l = LBOUND(SrcParamData%WaveTime,1) - i1_u = UBOUND(SrcParamData%WaveTime,1) - IF (.NOT. ALLOCATED(DstParamData%WaveTime)) THEN - ALLOCATE(DstParamData%WaveTime(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WaveTime.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%WaveTime = SrcParamData%WaveTime -ENDIF - DstParamData%NStepWave = SrcParamData%NStepWave - DstParamData%NWaveElev = SrcParamData%NWaveElev -IF (ALLOCATED(SrcParamData%WaveElev)) THEN - i1_l = LBOUND(SrcParamData%WaveElev,1) - i1_u = UBOUND(SrcParamData%WaveElev,1) - i2_l = LBOUND(SrcParamData%WaveElev,2) - i2_u = UBOUND(SrcParamData%WaveElev,2) - IF (.NOT. ALLOCATED(DstParamData%WaveElev)) THEN - ALLOCATE(DstParamData%WaveElev(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WaveElev.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%WaveElev = SrcParamData%WaveElev -ENDIF -IF (ALLOCATED(SrcParamData%WaveElev1)) THEN - i1_l = LBOUND(SrcParamData%WaveElev1,1) - i1_u = UBOUND(SrcParamData%WaveElev1,1) - i2_l = LBOUND(SrcParamData%WaveElev1,2) - i2_u = UBOUND(SrcParamData%WaveElev1,2) - IF (.NOT. ALLOCATED(DstParamData%WaveElev1)) THEN - ALLOCATE(DstParamData%WaveElev1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WaveElev1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%WaveElev1 = SrcParamData%WaveElev1 -ENDIF -IF (ALLOCATED(SrcParamData%WaveElev2)) THEN - i1_l = LBOUND(SrcParamData%WaveElev2,1) - i1_u = UBOUND(SrcParamData%WaveElev2,1) - i2_l = LBOUND(SrcParamData%WaveElev2,2) - i2_u = UBOUND(SrcParamData%WaveElev2,2) - IF (.NOT. ALLOCATED(DstParamData%WaveElev2)) THEN - ALLOCATE(DstParamData%WaveElev2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WaveElev2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%WaveElev2 = SrcParamData%WaveElev2 -ENDIF - DstParamData%WtrDpth = SrcParamData%WtrDpth -IF (ALLOCATED(SrcParamData%AddF0)) THEN - i1_l = LBOUND(SrcParamData%AddF0,1) - i1_u = UBOUND(SrcParamData%AddF0,1) - i2_l = LBOUND(SrcParamData%AddF0,2) - i2_u = UBOUND(SrcParamData%AddF0,2) - IF (.NOT. ALLOCATED(DstParamData%AddF0)) THEN - ALLOCATE(DstParamData%AddF0(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AddF0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%AddF0 = SrcParamData%AddF0 -ENDIF -IF (ALLOCATED(SrcParamData%AddCLin)) THEN - i1_l = LBOUND(SrcParamData%AddCLin,1) - i1_u = UBOUND(SrcParamData%AddCLin,1) - i2_l = LBOUND(SrcParamData%AddCLin,2) - i2_u = UBOUND(SrcParamData%AddCLin,2) - i3_l = LBOUND(SrcParamData%AddCLin,3) - i3_u = UBOUND(SrcParamData%AddCLin,3) - IF (.NOT. ALLOCATED(DstParamData%AddCLin)) THEN - ALLOCATE(DstParamData%AddCLin(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AddCLin.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%AddCLin = SrcParamData%AddCLin -ENDIF -IF (ALLOCATED(SrcParamData%AddBLin)) THEN - i1_l = LBOUND(SrcParamData%AddBLin,1) - i1_u = UBOUND(SrcParamData%AddBLin,1) - i2_l = LBOUND(SrcParamData%AddBLin,2) - i2_u = UBOUND(SrcParamData%AddBLin,2) - i3_l = LBOUND(SrcParamData%AddBLin,3) - i3_u = UBOUND(SrcParamData%AddBLin,3) - IF (.NOT. ALLOCATED(DstParamData%AddBLin)) THEN - ALLOCATE(DstParamData%AddBLin(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AddBLin.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%AddBLin = SrcParamData%AddBLin -ENDIF -IF (ALLOCATED(SrcParamData%AddBQuad)) THEN - i1_l = LBOUND(SrcParamData%AddBQuad,1) - i1_u = UBOUND(SrcParamData%AddBQuad,1) - i2_l = LBOUND(SrcParamData%AddBQuad,2) - i2_u = UBOUND(SrcParamData%AddBQuad,2) - i3_l = LBOUND(SrcParamData%AddBQuad,3) - i3_u = UBOUND(SrcParamData%AddBQuad,3) - IF (.NOT. ALLOCATED(DstParamData%AddBQuad)) THEN - ALLOCATE(DstParamData%AddBQuad(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AddBQuad.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%AddBQuad = SrcParamData%AddBQuad -ENDIF - DstParamData%DT = SrcParamData%DT -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%NumOuts = SrcParamData%NumOuts - DstParamData%NumTotalOuts = SrcParamData%NumTotalOuts - DstParamData%OutSwtch = SrcParamData%OutSwtch - DstParamData%OutFmt = SrcParamData%OutFmt - DstParamData%OutSFmt = SrcParamData%OutSFmt - DstParamData%Delim = SrcParamData%Delim - DstParamData%UnOutFile = SrcParamData%UnOutFile - 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 -IF (ALLOCATED(SrcParamData%dx)) THEN - i1_l = LBOUND(SrcParamData%dx,1) - i1_u = UBOUND(SrcParamData%dx,1) - IF (.NOT. ALLOCATED(DstParamData%dx)) THEN - ALLOCATE(DstParamData%dx(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%dx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%dx = SrcParamData%dx -ENDIF - DstParamData%Jac_ny = SrcParamData%Jac_ny - DstParamData%VisMeshes = SrcParamData%VisMeshes - END SUBROUTINE HydroDyn_CopyParam - - SUBROUTINE HydroDyn_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(HydroDyn_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(ParamData%WAMIT)) THEN -DO i1 = LBOUND(ParamData%WAMIT,1), UBOUND(ParamData%WAMIT,1) - CALL WAMIT_DestroyParam( ParamData%WAMIT(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ParamData%WAMIT) -ENDIF -IF (ALLOCATED(ParamData%WAMIT2)) THEN -DO i1 = LBOUND(ParamData%WAMIT2,1), UBOUND(ParamData%WAMIT2,1) - CALL WAMIT2_DestroyParam( ParamData%WAMIT2(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ParamData%WAMIT2) -ENDIF - CALL Waves2_DestroyParam( ParamData%Waves2, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL Morison_DestroyParam( ParamData%Morison, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(ParamData%WaveTime)) THEN - DEALLOCATE(ParamData%WaveTime) -ENDIF -IF (ALLOCATED(ParamData%WaveElev)) THEN - DEALLOCATE(ParamData%WaveElev) -ENDIF -IF (ALLOCATED(ParamData%WaveElev1)) THEN - DEALLOCATE(ParamData%WaveElev1) -ENDIF -IF (ALLOCATED(ParamData%WaveElev2)) THEN - DEALLOCATE(ParamData%WaveElev2) -ENDIF -IF (ALLOCATED(ParamData%AddF0)) THEN - DEALLOCATE(ParamData%AddF0) -ENDIF -IF (ALLOCATED(ParamData%AddCLin)) THEN - DEALLOCATE(ParamData%AddCLin) -ENDIF -IF (ALLOCATED(ParamData%AddBLin)) THEN - DEALLOCATE(ParamData%AddBLin) -ENDIF -IF (ALLOCATED(ParamData%AddBQuad)) THEN - DEALLOCATE(ParamData%AddBQuad) -ENDIF -IF (ALLOCATED(ParamData%OutParam)) THEN -DO i1 = LBOUND(ParamData%OutParam,1), UBOUND(ParamData%OutParam,1) - CALL NWTC_Library_Destroyoutparmtype( ParamData%OutParam(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -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 -IF (ALLOCATED(ParamData%dx)) THEN - DEALLOCATE(ParamData%dx) -ENDIF - END SUBROUTINE HydroDyn_DestroyParam - - SUBROUTINE HydroDyn_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(HydroDyn_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 = 'HydroDyn_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 ! nWAMITObj - Int_BufSz = Int_BufSz + 1 ! vecMultiplier - Int_BufSz = Int_BufSz + 1 ! WAMIT allocated yes/no - IF ( ALLOCATED(InData%WAMIT) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WAMIT upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%WAMIT,1), UBOUND(InData%WAMIT,1) - Int_BufSz = Int_BufSz + 3 ! WAMIT: size of buffers for each call to pack subtype - CALL WAMIT_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%WAMIT(i1), ErrStat2, ErrMsg2, .TRUE. ) ! WAMIT - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! WAMIT - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! WAMIT - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! WAMIT - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! WAMIT2 allocated yes/no - IF ( ALLOCATED(InData%WAMIT2) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WAMIT2 upper/lower bounds for each dimension - DO i1 = LBOUND(InData%WAMIT2,1), UBOUND(InData%WAMIT2,1) - Int_BufSz = Int_BufSz + 3 ! WAMIT2: size of buffers for each call to pack subtype - CALL WAMIT2_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%WAMIT2(i1), ErrStat2, ErrMsg2, .TRUE. ) ! WAMIT2 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! WAMIT2 - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! WAMIT2 - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! WAMIT2 - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! WAMIT2used - Int_BufSz = Int_BufSz + 3 ! Waves2: size of buffers for each call to pack subtype - CALL Waves2_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%Waves2, ErrStat2, ErrMsg2, .TRUE. ) ! Waves2 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Waves2 - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Waves2 - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Waves2 - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! Morison: size of buffers for each call to pack subtype - CALL Morison_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%Morison, ErrStat2, ErrMsg2, .TRUE. ) ! Morison - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Morison - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Morison - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Morison - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! PotMod - Int_BufSz = Int_BufSz + 1 ! NBody - Int_BufSz = Int_BufSz + 1 ! NBodyMod - Int_BufSz = Int_BufSz + 1 ! totalStates - Int_BufSz = Int_BufSz + 1 ! totalExctnStates - Int_BufSz = Int_BufSz + 1 ! totalRdtnStates - Int_BufSz = Int_BufSz + 1 ! WaveTime allocated yes/no - IF ( ALLOCATED(InData%WaveTime) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WaveTime upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveTime) ! WaveTime - END IF - Int_BufSz = Int_BufSz + 1 ! NStepWave - Int_BufSz = Int_BufSz + 1 ! NWaveElev - Int_BufSz = Int_BufSz + 1 ! WaveElev allocated yes/no - IF ( ALLOCATED(InData%WaveElev) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! WaveElev upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveElev) ! WaveElev - END IF - Int_BufSz = Int_BufSz + 1 ! WaveElev1 allocated yes/no - IF ( ALLOCATED(InData%WaveElev1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! WaveElev1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveElev1) ! WaveElev1 - END IF - Int_BufSz = Int_BufSz + 1 ! WaveElev2 allocated yes/no - IF ( ALLOCATED(InData%WaveElev2) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! WaveElev2 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveElev2) ! WaveElev2 - END IF - Re_BufSz = Re_BufSz + 1 ! WtrDpth - Int_BufSz = Int_BufSz + 1 ! AddF0 allocated yes/no - IF ( ALLOCATED(InData%AddF0) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! AddF0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AddF0) ! AddF0 - END IF - Int_BufSz = Int_BufSz + 1 ! AddCLin allocated yes/no - IF ( ALLOCATED(InData%AddCLin) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! AddCLin upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AddCLin) ! AddCLin - END IF - Int_BufSz = Int_BufSz + 1 ! AddBLin allocated yes/no - IF ( ALLOCATED(InData%AddBLin) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! AddBLin upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AddBLin) ! AddBLin - END IF - Int_BufSz = Int_BufSz + 1 ! AddBQuad allocated yes/no - IF ( ALLOCATED(InData%AddBQuad) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! AddBQuad upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AddBQuad) ! AddBQuad - END IF - Db_BufSz = Db_BufSz + 1 ! DT - 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 ! NumOuts - Int_BufSz = Int_BufSz + 1 ! NumTotalOuts - Int_BufSz = Int_BufSz + 1 ! OutSwtch - Int_BufSz = Int_BufSz + 1*LEN(InData%OutFmt) ! OutFmt - Int_BufSz = Int_BufSz + 1*LEN(InData%OutSFmt) ! OutSFmt - Int_BufSz = Int_BufSz + 1*LEN(InData%Delim) ! Delim - Int_BufSz = Int_BufSz + 1 ! UnOutFile - 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 - Int_BufSz = Int_BufSz + 1 ! dx allocated yes/no - IF ( ALLOCATED(InData%dx) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! dx upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%dx) ! dx - END IF - Int_BufSz = Int_BufSz + 1 ! Jac_ny - Int_BufSz = Int_BufSz + 1 ! VisMeshes - 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%nWAMITObj - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%vecMultiplier - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%WAMIT) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WAMIT,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WAMIT,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WAMIT,1), UBOUND(InData%WAMIT,1) - CALL WAMIT_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%WAMIT(i1), ErrStat2, ErrMsg2, OnlySize ) ! WAMIT - 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%WAMIT2) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WAMIT2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WAMIT2,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WAMIT2,1), UBOUND(InData%WAMIT2,1) - CALL WAMIT2_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%WAMIT2(i1), ErrStat2, ErrMsg2, OnlySize ) ! WAMIT2 - 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%WAMIT2used, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - CALL Waves2_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%Waves2, ErrStat2, ErrMsg2, OnlySize ) ! Waves2 - 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 Morison_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%Morison, ErrStat2, ErrMsg2, OnlySize ) ! Morison - 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%PotMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NBody - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NBodyMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%totalStates - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%totalExctnStates - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%totalRdtnStates - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%WaveTime) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveTime,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveTime,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WaveTime,1), UBOUND(InData%WaveTime,1) - ReKiBuf(Re_Xferred) = InData%WaveTime(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NStepWave - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NWaveElev - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%WaveElev) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%WaveElev,2), UBOUND(InData%WaveElev,2) - DO i1 = LBOUND(InData%WaveElev,1), UBOUND(InData%WaveElev,1) - ReKiBuf(Re_Xferred) = InData%WaveElev(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveElev1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%WaveElev1,2), UBOUND(InData%WaveElev1,2) - DO i1 = LBOUND(InData%WaveElev1,1), UBOUND(InData%WaveElev1,1) - ReKiBuf(Re_Xferred) = InData%WaveElev1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveElev2) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev2,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev2,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev2,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%WaveElev2,2), UBOUND(InData%WaveElev2,2) - DO i1 = LBOUND(InData%WaveElev2,1), UBOUND(InData%WaveElev2,1) - ReKiBuf(Re_Xferred) = InData%WaveElev2(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - ReKiBuf(Re_Xferred) = InData%WtrDpth - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%AddF0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AddF0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AddF0,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AddF0,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AddF0,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%AddF0,2), UBOUND(InData%AddF0,2) - DO i1 = LBOUND(InData%AddF0,1), UBOUND(InData%AddF0,1) - ReKiBuf(Re_Xferred) = InData%AddF0(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AddCLin) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AddCLin,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AddCLin,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AddCLin,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AddCLin,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AddCLin,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AddCLin,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%AddCLin,3), UBOUND(InData%AddCLin,3) - DO i2 = LBOUND(InData%AddCLin,2), UBOUND(InData%AddCLin,2) - DO i1 = LBOUND(InData%AddCLin,1), UBOUND(InData%AddCLin,1) - ReKiBuf(Re_Xferred) = InData%AddCLin(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AddBLin) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AddBLin,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AddBLin,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AddBLin,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AddBLin,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AddBLin,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AddBLin,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%AddBLin,3), UBOUND(InData%AddBLin,3) - DO i2 = LBOUND(InData%AddBLin,2), UBOUND(InData%AddBLin,2) - DO i1 = LBOUND(InData%AddBLin,1), UBOUND(InData%AddBLin,1) - ReKiBuf(Re_Xferred) = InData%AddBLin(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AddBQuad) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AddBQuad,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AddBQuad,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AddBQuad,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AddBQuad,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AddBQuad,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AddBQuad,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%AddBQuad,3), UBOUND(InData%AddBQuad,3) - DO i2 = LBOUND(InData%AddBQuad,2), UBOUND(InData%AddBQuad,2) - DO i1 = LBOUND(InData%AddBQuad,1), UBOUND(InData%AddBQuad,1) - ReKiBuf(Re_Xferred) = InData%AddBQuad(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - DbKiBuf(Db_Xferred) = InData%DT - Db_Xferred = Db_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 - IntKiBuf(Int_Xferred) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumTotalOuts - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%OutSwtch - 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 - DO I = 1, LEN(InData%OutSFmt) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutSFmt(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - 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) = InData%UnOutFile - 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 - IF ( .NOT. ALLOCATED(InData%dx) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%dx,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dx,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%dx,1), UBOUND(InData%dx,1) - DbKiBuf(Db_Xferred) = InData%dx(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%Jac_ny - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%VisMeshes, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE HydroDyn_PackParam - - SUBROUTINE HydroDyn_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(HydroDyn_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) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_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%nWAMITObj = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%vecMultiplier = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WAMIT not allocated - Int_Xferred = Int_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%WAMIT)) DEALLOCATE(OutData%WAMIT) - ALLOCATE(OutData%WAMIT(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WAMIT.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WAMIT,1), UBOUND(OutData%WAMIT,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 WAMIT_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%WAMIT(i1), ErrStat2, ErrMsg2 ) ! WAMIT - 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 ! WAMIT2 not allocated - Int_Xferred = Int_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%WAMIT2)) DEALLOCATE(OutData%WAMIT2) - ALLOCATE(OutData%WAMIT2(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WAMIT2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WAMIT2,1), UBOUND(OutData%WAMIT2,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 WAMIT2_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%WAMIT2(i1), ErrStat2, ErrMsg2 ) ! WAMIT2 - 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%WAMIT2used = TRANSFER(IntKiBuf(Int_Xferred), OutData%WAMIT2used) - 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 Waves2_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%Waves2, ErrStat2, ErrMsg2 ) ! Waves2 - 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 Morison_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%Morison, ErrStat2, ErrMsg2 ) ! Morison - 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%PotMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NBody = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NBodyMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%totalStates = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%totalExctnStates = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%totalRdtnStates = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveTime not allocated - Int_Xferred = Int_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%WaveTime)) DEALLOCATE(OutData%WaveTime) - ALLOCATE(OutData%WaveTime(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveTime.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WaveTime,1), UBOUND(OutData%WaveTime,1) - OutData%WaveTime(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%NStepWave = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NWaveElev = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElev not allocated - Int_Xferred = Int_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%WaveElev)) DEALLOCATE(OutData%WaveElev) - ALLOCATE(OutData%WaveElev(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%WaveElev,2), UBOUND(OutData%WaveElev,2) - DO i1 = LBOUND(OutData%WaveElev,1), UBOUND(OutData%WaveElev,1) - OutData%WaveElev(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElev1 not allocated - Int_Xferred = Int_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%WaveElev1)) DEALLOCATE(OutData%WaveElev1) - ALLOCATE(OutData%WaveElev1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%WaveElev1,2), UBOUND(OutData%WaveElev1,2) - DO i1 = LBOUND(OutData%WaveElev1,1), UBOUND(OutData%WaveElev1,1) - OutData%WaveElev1(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElev2 not allocated - Int_Xferred = Int_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%WaveElev2)) DEALLOCATE(OutData%WaveElev2) - ALLOCATE(OutData%WaveElev2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%WaveElev2,2), UBOUND(OutData%WaveElev2,2) - DO i1 = LBOUND(OutData%WaveElev2,1), UBOUND(OutData%WaveElev2,1) - OutData%WaveElev2(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%WtrDpth = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AddF0 not allocated - Int_Xferred = Int_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%AddF0)) DEALLOCATE(OutData%AddF0) - ALLOCATE(OutData%AddF0(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AddF0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%AddF0,2), UBOUND(OutData%AddF0,2) - DO i1 = LBOUND(OutData%AddF0,1), UBOUND(OutData%AddF0,1) - OutData%AddF0(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AddCLin not allocated - Int_Xferred = Int_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%AddCLin)) DEALLOCATE(OutData%AddCLin) - ALLOCATE(OutData%AddCLin(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%AddCLin.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%AddCLin,3), UBOUND(OutData%AddCLin,3) - DO i2 = LBOUND(OutData%AddCLin,2), UBOUND(OutData%AddCLin,2) - DO i1 = LBOUND(OutData%AddCLin,1), UBOUND(OutData%AddCLin,1) - OutData%AddCLin(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 ! AddBLin not allocated - Int_Xferred = Int_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%AddBLin)) DEALLOCATE(OutData%AddBLin) - ALLOCATE(OutData%AddBLin(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%AddBLin.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%AddBLin,3), UBOUND(OutData%AddBLin,3) - DO i2 = LBOUND(OutData%AddBLin,2), UBOUND(OutData%AddBLin,2) - DO i1 = LBOUND(OutData%AddBLin,1), UBOUND(OutData%AddBLin,1) - OutData%AddBLin(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 ! AddBQuad not allocated - Int_Xferred = Int_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%AddBQuad)) DEALLOCATE(OutData%AddBQuad) - ALLOCATE(OutData%AddBQuad(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%AddBQuad.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%AddBQuad,3), UBOUND(OutData%AddBQuad,3) - DO i2 = LBOUND(OutData%AddBQuad,2), UBOUND(OutData%AddBQuad,2) - DO i1 = LBOUND(OutData%AddBQuad,1), UBOUND(OutData%AddBQuad,1) - OutData%AddBQuad(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - OutData%DT = DbKiBuf(Db_Xferred) - Db_Xferred = Db_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 - OutData%NumOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumTotalOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%OutSwtch = IntKiBuf(Int_Xferred) - 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 - DO I = 1, LEN(OutData%OutSFmt) - OutData%OutSFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%Delim) - OutData%Delim(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%UnOutFile = 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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! dx not allocated - Int_Xferred = Int_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%dx)) DEALLOCATE(OutData%dx) - ALLOCATE(OutData%dx(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%dx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - 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 - END IF - OutData%Jac_ny = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%VisMeshes = TRANSFER(IntKiBuf(Int_Xferred), OutData%VisMeshes) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE HydroDyn_UnPackParam - - SUBROUTINE HydroDyn_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(HydroDyn_InputType), INTENT(INOUT) :: SrcInputData - TYPE(HydroDyn_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 = 'HydroDyn_CopyInput' -! + ErrMsg = '' + DstInputFileData%EchoFlag = SrcInputFileData%EchoFlag + if (allocated(SrcInputFileData%AddF0)) then + LB(1:2) = lbound(SrcInputFileData%AddF0) + UB(1:2) = ubound(SrcInputFileData%AddF0) + if (.not. allocated(DstInputFileData%AddF0)) then + allocate(DstInputFileData%AddF0(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%AddF0.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%AddF0 = SrcInputFileData%AddF0 + end if + if (allocated(SrcInputFileData%AddCLin)) then + LB(1:3) = lbound(SrcInputFileData%AddCLin) + UB(1:3) = ubound(SrcInputFileData%AddCLin) + if (.not. allocated(DstInputFileData%AddCLin)) then + allocate(DstInputFileData%AddCLin(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%AddCLin.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%AddCLin = SrcInputFileData%AddCLin + end if + if (allocated(SrcInputFileData%AddBLin)) then + LB(1:3) = lbound(SrcInputFileData%AddBLin) + UB(1:3) = ubound(SrcInputFileData%AddBLin) + if (.not. allocated(DstInputFileData%AddBLin)) then + allocate(DstInputFileData%AddBLin(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%AddBLin.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%AddBLin = SrcInputFileData%AddBLin + end if + if (allocated(SrcInputFileData%AddBQuad)) then + LB(1:3) = lbound(SrcInputFileData%AddBQuad) + UB(1:3) = ubound(SrcInputFileData%AddBQuad) + if (.not. allocated(DstInputFileData%AddBQuad)) then + allocate(DstInputFileData%AddBQuad(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%AddBQuad.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%AddBQuad = SrcInputFileData%AddBQuad + end if + if (allocated(SrcInputFileData%PotFile)) then + LB(1:1) = lbound(SrcInputFileData%PotFile) + UB(1:1) = ubound(SrcInputFileData%PotFile) + if (.not. allocated(DstInputFileData%PotFile)) then + allocate(DstInputFileData%PotFile(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%PotFile.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%PotFile = SrcInputFileData%PotFile + end if + DstInputFileData%nWAMITObj = SrcInputFileData%nWAMITObj + DstInputFileData%vecMultiplier = SrcInputFileData%vecMultiplier + DstInputFileData%NBody = SrcInputFileData%NBody + DstInputFileData%NBodyMod = SrcInputFileData%NBodyMod + if (allocated(SrcInputFileData%PtfmVol0)) then + LB(1:1) = lbound(SrcInputFileData%PtfmVol0) + UB(1:1) = ubound(SrcInputFileData%PtfmVol0) + if (.not. allocated(DstInputFileData%PtfmVol0)) then + allocate(DstInputFileData%PtfmVol0(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%PtfmVol0.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%PtfmVol0 = SrcInputFileData%PtfmVol0 + end if + DstInputFileData%HasWAMIT = SrcInputFileData%HasWAMIT + if (allocated(SrcInputFileData%WAMITULEN)) then + LB(1:1) = lbound(SrcInputFileData%WAMITULEN) + UB(1:1) = ubound(SrcInputFileData%WAMITULEN) + if (.not. allocated(DstInputFileData%WAMITULEN)) then + allocate(DstInputFileData%WAMITULEN(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%WAMITULEN.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%WAMITULEN = SrcInputFileData%WAMITULEN + end if + if (allocated(SrcInputFileData%PtfmRefxt)) then + LB(1:1) = lbound(SrcInputFileData%PtfmRefxt) + UB(1:1) = ubound(SrcInputFileData%PtfmRefxt) + if (.not. allocated(DstInputFileData%PtfmRefxt)) then + allocate(DstInputFileData%PtfmRefxt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%PtfmRefxt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%PtfmRefxt = SrcInputFileData%PtfmRefxt + end if + if (allocated(SrcInputFileData%PtfmRefyt)) then + LB(1:1) = lbound(SrcInputFileData%PtfmRefyt) + UB(1:1) = ubound(SrcInputFileData%PtfmRefyt) + if (.not. allocated(DstInputFileData%PtfmRefyt)) then + allocate(DstInputFileData%PtfmRefyt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%PtfmRefyt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%PtfmRefyt = SrcInputFileData%PtfmRefyt + end if + if (allocated(SrcInputFileData%PtfmRefzt)) then + LB(1:1) = lbound(SrcInputFileData%PtfmRefzt) + UB(1:1) = ubound(SrcInputFileData%PtfmRefzt) + if (.not. allocated(DstInputFileData%PtfmRefzt)) then + allocate(DstInputFileData%PtfmRefzt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%PtfmRefzt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%PtfmRefzt = SrcInputFileData%PtfmRefzt + end if + if (allocated(SrcInputFileData%PtfmRefztRot)) then + LB(1:1) = lbound(SrcInputFileData%PtfmRefztRot) + UB(1:1) = ubound(SrcInputFileData%PtfmRefztRot) + if (.not. allocated(DstInputFileData%PtfmRefztRot)) then + allocate(DstInputFileData%PtfmRefztRot(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%PtfmRefztRot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%PtfmRefztRot = SrcInputFileData%PtfmRefztRot + end if + if (allocated(SrcInputFileData%PtfmCOBxt)) then + LB(1:1) = lbound(SrcInputFileData%PtfmCOBxt) + UB(1:1) = ubound(SrcInputFileData%PtfmCOBxt) + if (.not. allocated(DstInputFileData%PtfmCOBxt)) then + allocate(DstInputFileData%PtfmCOBxt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%PtfmCOBxt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%PtfmCOBxt = SrcInputFileData%PtfmCOBxt + end if + if (allocated(SrcInputFileData%PtfmCOByt)) then + LB(1:1) = lbound(SrcInputFileData%PtfmCOByt) + UB(1:1) = ubound(SrcInputFileData%PtfmCOByt) + if (.not. allocated(DstInputFileData%PtfmCOByt)) then + allocate(DstInputFileData%PtfmCOByt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%PtfmCOByt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%PtfmCOByt = SrcInputFileData%PtfmCOByt + end if + call WAMIT_CopyInitInput(SrcInputFileData%WAMIT, DstInputFileData%WAMIT, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call WAMIT2_CopyInitInput(SrcInputFileData%WAMIT2, DstInputFileData%WAMIT2, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call Morison_CopyInitInput(SrcInputFileData%Morison, DstInputFileData%Morison, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstInputFileData%Echo = SrcInputFileData%Echo + DstInputFileData%PotMod = SrcInputFileData%PotMod + DstInputFileData%NUserOutputs = SrcInputFileData%NUserOutputs + if (allocated(SrcInputFileData%UserOutputs)) then + LB(1:1) = lbound(SrcInputFileData%UserOutputs) + UB(1:1) = ubound(SrcInputFileData%UserOutputs) + if (.not. allocated(DstInputFileData%UserOutputs)) then + allocate(DstInputFileData%UserOutputs(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%UserOutputs.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%UserOutputs = SrcInputFileData%UserOutputs + end if + DstInputFileData%OutSwtch = SrcInputFileData%OutSwtch + DstInputFileData%OutAll = SrcInputFileData%OutAll + DstInputFileData%NumOuts = SrcInputFileData%NumOuts + if (allocated(SrcInputFileData%OutList)) then + LB(1:1) = lbound(SrcInputFileData%OutList) + UB(1:1) = ubound(SrcInputFileData%OutList) + if (.not. allocated(DstInputFileData%OutList)) then + allocate(DstInputFileData%OutList(LB(1):UB(1)), 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 + end if + DstInputFileData%HDSum = SrcInputFileData%HDSum + DstInputFileData%UnSum = SrcInputFileData%UnSum + DstInputFileData%OutFmt = SrcInputFileData%OutFmt + DstInputFileData%OutSFmt = SrcInputFileData%OutSFmt + DstInputFileData%PtfmYMod = SrcInputFileData%PtfmYMod + DstInputFileData%PtfmRefY = SrcInputFileData%PtfmRefY + DstInputFileData%PtfmYCutoff = SrcInputFileData%PtfmYCutoff +end subroutine + +subroutine HydroDyn_DestroyInputFile(InputFileData, ErrStat, ErrMsg) + type(HydroDyn_InputFile), intent(inout) :: InputFileData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'HydroDyn_DestroyInputFile' ErrStat = ErrID_None - ErrMsg = "" - CALL Morison_CopyInput( SrcInputData%Morison, DstInputData%Morison, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcInputData%WAMITMesh, DstInputData%WAMITMesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcInputData%PRPMesh, DstInputData%PRPMesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE HydroDyn_CopyInput - - SUBROUTINE HydroDyn_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(HydroDyn_InputType), INTENT(INOUT) :: InputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_DestroyInput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL Morison_DestroyInput( InputData%Morison, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( InputData%WAMITMesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( InputData%PRPMesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE HydroDyn_DestroyInput - - SUBROUTINE HydroDyn_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(HydroDyn_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 = 'HydroDyn_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 ! Morison: size of buffers for each call to pack subtype - CALL Morison_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Morison, ErrStat2, ErrMsg2, .TRUE. ) ! Morison - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Morison - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Morison - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Morison - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! WAMITMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%WAMITMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! WAMITMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! WAMITMesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! WAMITMesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! WAMITMesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! PRPMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%PRPMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! PRPMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! PRPMesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! PRPMesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! PRPMesh - 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 Morison_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Morison, ErrStat2, ErrMsg2, OnlySize ) ! Morison - 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%WAMITMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! WAMITMesh - 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%PRPMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! PRPMesh - 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 HydroDyn_PackInput - - SUBROUTINE HydroDyn_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(HydroDyn_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 = 'HydroDyn_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 Morison_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Morison, ErrStat2, ErrMsg2 ) ! Morison - 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%WAMITMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! WAMITMesh - 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%PRPMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! PRPMesh - 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 HydroDyn_UnPackInput - - SUBROUTINE HydroDyn_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(HydroDyn_OutputType), INTENT(INOUT) :: SrcOutputData - TYPE(HydroDyn_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 = 'HydroDyn_CopyOutput' -! + ErrMsg = '' + if (allocated(InputFileData%AddF0)) then + deallocate(InputFileData%AddF0) + end if + if (allocated(InputFileData%AddCLin)) then + deallocate(InputFileData%AddCLin) + end if + if (allocated(InputFileData%AddBLin)) then + deallocate(InputFileData%AddBLin) + end if + if (allocated(InputFileData%AddBQuad)) then + deallocate(InputFileData%AddBQuad) + end if + if (allocated(InputFileData%PotFile)) then + deallocate(InputFileData%PotFile) + end if + if (allocated(InputFileData%PtfmVol0)) then + deallocate(InputFileData%PtfmVol0) + end if + if (allocated(InputFileData%WAMITULEN)) then + deallocate(InputFileData%WAMITULEN) + end if + if (allocated(InputFileData%PtfmRefxt)) then + deallocate(InputFileData%PtfmRefxt) + end if + if (allocated(InputFileData%PtfmRefyt)) then + deallocate(InputFileData%PtfmRefyt) + end if + if (allocated(InputFileData%PtfmRefzt)) then + deallocate(InputFileData%PtfmRefzt) + end if + if (allocated(InputFileData%PtfmRefztRot)) then + deallocate(InputFileData%PtfmRefztRot) + end if + if (allocated(InputFileData%PtfmCOBxt)) then + deallocate(InputFileData%PtfmCOBxt) + end if + if (allocated(InputFileData%PtfmCOByt)) then + deallocate(InputFileData%PtfmCOByt) + end if + call WAMIT_DestroyInitInput(InputFileData%WAMIT, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call WAMIT2_DestroyInitInput(InputFileData%WAMIT2, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call Morison_DestroyInitInput(InputFileData%Morison, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(InputFileData%UserOutputs)) then + deallocate(InputFileData%UserOutputs) + end if + if (allocated(InputFileData%OutList)) then + deallocate(InputFileData%OutList) + end if +end subroutine + +subroutine HydroDyn_PackInputFile(RF, Indata) + type(RegFile), intent(inout) :: RF + type(HydroDyn_InputFile), intent(in) :: InData + character(*), parameter :: RoutineName = 'HydroDyn_PackInputFile' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%EchoFlag) + call RegPackAlloc(RF, InData%AddF0) + call RegPackAlloc(RF, InData%AddCLin) + call RegPackAlloc(RF, InData%AddBLin) + call RegPackAlloc(RF, InData%AddBQuad) + call RegPackAlloc(RF, InData%PotFile) + call RegPack(RF, InData%nWAMITObj) + call RegPack(RF, InData%vecMultiplier) + call RegPack(RF, InData%NBody) + call RegPack(RF, InData%NBodyMod) + call RegPackAlloc(RF, InData%PtfmVol0) + call RegPack(RF, InData%HasWAMIT) + call RegPackAlloc(RF, InData%WAMITULEN) + call RegPackAlloc(RF, InData%PtfmRefxt) + call RegPackAlloc(RF, InData%PtfmRefyt) + call RegPackAlloc(RF, InData%PtfmRefzt) + call RegPackAlloc(RF, InData%PtfmRefztRot) + call RegPackAlloc(RF, InData%PtfmCOBxt) + call RegPackAlloc(RF, InData%PtfmCOByt) + call WAMIT_PackInitInput(RF, InData%WAMIT) + call WAMIT2_PackInitInput(RF, InData%WAMIT2) + call Morison_PackInitInput(RF, InData%Morison) + call RegPack(RF, InData%Echo) + call RegPack(RF, InData%PotMod) + call RegPack(RF, InData%NUserOutputs) + call RegPackAlloc(RF, InData%UserOutputs) + call RegPack(RF, InData%OutSwtch) + call RegPack(RF, InData%OutAll) + call RegPack(RF, InData%NumOuts) + call RegPackAlloc(RF, InData%OutList) + call RegPack(RF, InData%HDSum) + call RegPack(RF, InData%UnSum) + call RegPack(RF, InData%OutFmt) + call RegPack(RF, InData%OutSFmt) + call RegPack(RF, InData%PtfmYMod) + call RegPack(RF, InData%PtfmRefY) + call RegPack(RF, InData%PtfmYCutoff) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine HydroDyn_UnPackInputFile(RF, OutData) + type(RegFile), intent(inout) :: RF + type(HydroDyn_InputFile), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'HydroDyn_UnPackInputFile' + integer(B4Ki) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%EchoFlag); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AddF0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AddCLin); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AddBLin); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AddBQuad); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PotFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nWAMITObj); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%vecMultiplier); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NBody); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NBodyMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PtfmVol0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HasWAMIT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WAMITULEN); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PtfmRefxt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PtfmRefyt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PtfmRefzt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PtfmRefztRot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PtfmCOBxt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PtfmCOByt); if (RegCheckErr(RF, RoutineName)) return + call WAMIT_UnpackInitInput(RF, OutData%WAMIT) ! WAMIT + call WAMIT2_UnpackInitInput(RF, OutData%WAMIT2) ! WAMIT2 + call Morison_UnpackInitInput(RF, OutData%Morison) ! Morison + call RegUnpack(RF, OutData%Echo); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PotMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NUserOutputs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%UserOutputs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutSwtch); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutAll); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumOuts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%OutList); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HDSum); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UnSum); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutFmt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutSFmt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PtfmYMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PtfmRefY); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PtfmYCutoff); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine HydroDyn_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) + type(HydroDyn_InitInputType), intent(in) :: SrcInitInputData + type(HydroDyn_InitInputType), intent(inout) :: DstInitInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'HydroDyn_CopyInitInput' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcOutputData%WAMIT)) THEN - i1_l = LBOUND(SrcOutputData%WAMIT,1) - i1_u = UBOUND(SrcOutputData%WAMIT,1) - IF (.NOT. ALLOCATED(DstOutputData%WAMIT)) THEN - ALLOCATE(DstOutputData%WAMIT(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WAMIT.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcOutputData%WAMIT,1), UBOUND(SrcOutputData%WAMIT,1) - CALL WAMIT_CopyOutput( SrcOutputData%WAMIT(i1), DstOutputData%WAMIT(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcOutputData%WAMIT2)) THEN - i1_l = LBOUND(SrcOutputData%WAMIT2,1) - i1_u = UBOUND(SrcOutputData%WAMIT2,1) - IF (.NOT. ALLOCATED(DstOutputData%WAMIT2)) THEN - ALLOCATE(DstOutputData%WAMIT2(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WAMIT2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcOutputData%WAMIT2,1), UBOUND(SrcOutputData%WAMIT2,1) - CALL WAMIT2_CopyOutput( SrcOutputData%WAMIT2(i1), DstOutputData%WAMIT2(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL Waves2_CopyOutput( SrcOutputData%Waves2, DstOutputData%Waves2, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL Morison_CopyOutput( SrcOutputData%Morison, DstOutputData%Morison, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcOutputData%WAMITMesh, DstOutputData%WAMITMesh, 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 HydroDyn_CopyOutput - - SUBROUTINE HydroDyn_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(HydroDyn_OutputType), INTENT(INOUT) :: OutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_DestroyOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(OutputData%WAMIT)) THEN -DO i1 = LBOUND(OutputData%WAMIT,1), UBOUND(OutputData%WAMIT,1) - CALL WAMIT_DestroyOutput( OutputData%WAMIT(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(OutputData%WAMIT) -ENDIF -IF (ALLOCATED(OutputData%WAMIT2)) THEN -DO i1 = LBOUND(OutputData%WAMIT2,1), UBOUND(OutputData%WAMIT2,1) - CALL WAMIT2_DestroyOutput( OutputData%WAMIT2(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(OutputData%WAMIT2) -ENDIF - CALL Waves2_DestroyOutput( OutputData%Waves2, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL Morison_DestroyOutput( OutputData%Morison, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( OutputData%WAMITMesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(OutputData%WriteOutput)) THEN - DEALLOCATE(OutputData%WriteOutput) -ENDIF - END SUBROUTINE HydroDyn_DestroyOutput - - SUBROUTINE HydroDyn_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(HydroDyn_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 = 'HydroDyn_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 ! WAMIT allocated yes/no - IF ( ALLOCATED(InData%WAMIT) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WAMIT upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%WAMIT,1), UBOUND(InData%WAMIT,1) - Int_BufSz = Int_BufSz + 3 ! WAMIT: size of buffers for each call to pack subtype - CALL WAMIT_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%WAMIT(i1), ErrStat2, ErrMsg2, .TRUE. ) ! WAMIT - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! WAMIT - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! WAMIT - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! WAMIT - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! WAMIT2 allocated yes/no - IF ( ALLOCATED(InData%WAMIT2) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WAMIT2 upper/lower bounds for each dimension - DO i1 = LBOUND(InData%WAMIT2,1), UBOUND(InData%WAMIT2,1) - Int_BufSz = Int_BufSz + 3 ! WAMIT2: size of buffers for each call to pack subtype - CALL WAMIT2_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%WAMIT2(i1), ErrStat2, ErrMsg2, .TRUE. ) ! WAMIT2 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! WAMIT2 - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! WAMIT2 - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! WAMIT2 - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! Waves2: size of buffers for each call to pack subtype - CALL Waves2_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Waves2, ErrStat2, ErrMsg2, .TRUE. ) ! Waves2 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Waves2 - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Waves2 - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Waves2 - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! Morison: size of buffers for each call to pack subtype - CALL Morison_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Morison, ErrStat2, ErrMsg2, .TRUE. ) ! Morison - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Morison - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Morison - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Morison - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! WAMITMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%WAMITMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! WAMITMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! WAMITMesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! WAMITMesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! WAMITMesh - 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 - - IF ( .NOT. ALLOCATED(InData%WAMIT) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WAMIT,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WAMIT,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WAMIT,1), UBOUND(InData%WAMIT,1) - CALL WAMIT_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%WAMIT(i1), ErrStat2, ErrMsg2, OnlySize ) ! WAMIT - 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%WAMIT2) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WAMIT2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WAMIT2,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WAMIT2,1), UBOUND(InData%WAMIT2,1) - CALL WAMIT2_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%WAMIT2(i1), ErrStat2, ErrMsg2, OnlySize ) ! WAMIT2 - 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 - CALL Waves2_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Waves2, ErrStat2, ErrMsg2, OnlySize ) ! Waves2 - 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 Morison_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Morison, ErrStat2, ErrMsg2, OnlySize ) ! Morison - 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%WAMITMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! WAMITMesh - 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 HydroDyn_PackOutput - - SUBROUTINE HydroDyn_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(HydroDyn_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 = 'HydroDyn_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 ! WAMIT not allocated - Int_Xferred = Int_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%WAMIT)) DEALLOCATE(OutData%WAMIT) - ALLOCATE(OutData%WAMIT(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WAMIT.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WAMIT,1), UBOUND(OutData%WAMIT,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 WAMIT_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%WAMIT(i1), ErrStat2, ErrMsg2 ) ! WAMIT - 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 ! WAMIT2 not allocated - Int_Xferred = Int_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%WAMIT2)) DEALLOCATE(OutData%WAMIT2) - ALLOCATE(OutData%WAMIT2(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WAMIT2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WAMIT2,1), UBOUND(OutData%WAMIT2,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 WAMIT2_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%WAMIT2(i1), ErrStat2, ErrMsg2 ) ! WAMIT2 - 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 - 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 Waves2_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%Waves2, ErrStat2, ErrMsg2 ) ! Waves2 - 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 Morison_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%Morison, ErrStat2, ErrMsg2 ) ! Morison - 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%WAMITMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! WAMITMesh - 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 HydroDyn_UnPackOutput - - - SUBROUTINE HydroDyn_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(HydroDyn_InputType), INTENT(INOUT) :: u(:) ! Input at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Inputs - TYPE(HydroDyn_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 + ErrMsg = '' + DstInitInputData%InputFile = SrcInitInputData%InputFile + DstInitInputData%UseInputFile = SrcInitInputData%UseInputFile + call NWTC_Library_CopyFileInfoType(SrcInitInputData%PassedFileData, DstInitInputData%PassedFileData, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstInitInputData%OutRootName = SrcInitInputData%OutRootName + DstInitInputData%Linearize = SrcInitInputData%Linearize + DstInitInputData%Gravity = SrcInitInputData%Gravity + DstInitInputData%TMax = SrcInitInputData%TMax + DstInitInputData%VisMeshes = SrcInitInputData%VisMeshes + DstInitInputData%InvalidWithSSExctn = SrcInitInputData%InvalidWithSSExctn + DstInitInputData%WaveField => SrcInitInputData%WaveField + DstInitInputData%PlatformPos = SrcInitInputData%PlatformPos +end subroutine + +subroutine HydroDyn_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(HydroDyn_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'HydroDyn_DestroyInitInput' + ErrStat = ErrID_None + ErrMsg = '' + call NWTC_Library_DestroyFileInfoType(InitInputData%PassedFileData, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + nullify(InitInputData%WaveField) +end subroutine + +subroutine HydroDyn_PackInitInput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(HydroDyn_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'HydroDyn_PackInitInput' + logical :: PtrInIndex + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%InputFile) + call RegPack(RF, InData%UseInputFile) + call NWTC_Library_PackFileInfoType(RF, InData%PassedFileData) + call RegPack(RF, InData%OutRootName) + call RegPack(RF, InData%Linearize) + call RegPack(RF, InData%Gravity) + call RegPack(RF, InData%TMax) + call RegPack(RF, InData%VisMeshes) + call RegPack(RF, InData%InvalidWithSSExctn) + call RegPack(RF, associated(InData%WaveField)) + if (associated(InData%WaveField)) then + call RegPackPointer(RF, c_loc(InData%WaveField), PtrInIndex) + if (.not. PtrInIndex) then + call SeaSt_WaveField_PackSeaSt_WaveFieldType(RF, InData%WaveField) + end if + end if + call RegPack(RF, InData%PlatformPos) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine HydroDyn_UnPackInitInput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(HydroDyn_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'HydroDyn_UnPackInitInput' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(B8Ki) :: PtrIdx + type(c_ptr) :: Ptr + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%InputFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UseInputFile); if (RegCheckErr(RF, RoutineName)) return + call NWTC_Library_UnpackFileInfoType(RF, OutData%PassedFileData) ! PassedFileData + call RegUnpack(RF, OutData%OutRootName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Linearize); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Gravity); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TMax); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VisMeshes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%InvalidWithSSExctn); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%WaveField)) deallocate(OutData%WaveField) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackPointer(RF, Ptr, PtrIdx); if (RegCheckErr(RF, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveField) + else + allocate(OutData%WaveField,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveField.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + RF%Pointers(PtrIdx) = c_loc(OutData%WaveField) + call SeaSt_WaveField_UnpackSeaSt_WaveFieldType(RF, OutData%WaveField) ! WaveField + end if + else + OutData%WaveField => null() + end if + call RegUnpack(RF, OutData%PlatformPos); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine HydroDyn_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) + type(HydroDyn_InitOutputType), intent(in) :: SrcInitOutputData + type(HydroDyn_InitOutputType), intent(inout) :: DstInitOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'HydroDyn_CopyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + call Morison_CopyInitOutput(SrcInitOutputData%Morison, DstInitOutputData%Morison, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcInitOutputData%WriteOutputHdr)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) + if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then + allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitOutputData%WriteOutputUnt)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) + if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then + allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), 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 + end if + 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 + LB(1:1) = lbound(SrcInitOutputData%LinNames_y) + UB(1:1) = ubound(SrcInitOutputData%LinNames_y) + if (.not. allocated(DstInitOutputData%LinNames_y)) then + allocate(DstInitOutputData%LinNames_y(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitOutputData%LinNames_x)) then + LB(1:1) = lbound(SrcInitOutputData%LinNames_x) + UB(1:1) = ubound(SrcInitOutputData%LinNames_x) + if (.not. allocated(DstInitOutputData%LinNames_x)) then + allocate(DstInitOutputData%LinNames_x(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitOutputData%LinNames_u)) then + LB(1:1) = lbound(SrcInitOutputData%LinNames_u) + UB(1:1) = ubound(SrcInitOutputData%LinNames_u) + if (.not. allocated(DstInitOutputData%LinNames_u)) then + allocate(DstInitOutputData%LinNames_u(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitOutputData%DerivOrder_x)) then + LB(1:1) = lbound(SrcInitOutputData%DerivOrder_x) + UB(1:1) = ubound(SrcInitOutputData%DerivOrder_x) + if (.not. allocated(DstInitOutputData%DerivOrder_x)) then + allocate(DstInitOutputData%DerivOrder_x(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitOutputData%IsLoad_u)) then + LB(1:1) = lbound(SrcInitOutputData%IsLoad_u) + UB(1:1) = ubound(SrcInitOutputData%IsLoad_u) + if (.not. allocated(DstInitOutputData%IsLoad_u)) then + allocate(DstInitOutputData%IsLoad_u(LB(1):UB(1)), 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 + end if +end subroutine + +subroutine HydroDyn_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(HydroDyn_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'HydroDyn_DestroyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + call Morison_DestroyInitOutput(InitOutputData%Morison, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(InitOutputData%WriteOutputHdr)) then + deallocate(InitOutputData%WriteOutputHdr) + end if + if (allocated(InitOutputData%WriteOutputUnt)) then + deallocate(InitOutputData%WriteOutputUnt) + end if + call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(InitOutputData%LinNames_y)) then + deallocate(InitOutputData%LinNames_y) + end if + if (allocated(InitOutputData%LinNames_x)) then + deallocate(InitOutputData%LinNames_x) + end if + if (allocated(InitOutputData%LinNames_u)) then + deallocate(InitOutputData%LinNames_u) + end if + if (allocated(InitOutputData%DerivOrder_x)) then + deallocate(InitOutputData%DerivOrder_x) + end if + if (allocated(InitOutputData%IsLoad_u)) then + deallocate(InitOutputData%IsLoad_u) + end if +end subroutine + +subroutine HydroDyn_PackInitOutput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(HydroDyn_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'HydroDyn_PackInitOutput' + if (RF%ErrStat >= AbortErrLev) return + call Morison_PackInitOutput(RF, InData%Morison) + call RegPackAlloc(RF, InData%WriteOutputHdr) + call RegPackAlloc(RF, InData%WriteOutputUnt) + call NWTC_Library_PackProgDesc(RF, InData%Ver) + call RegPackAlloc(RF, InData%LinNames_y) + call RegPackAlloc(RF, InData%LinNames_x) + call RegPackAlloc(RF, InData%LinNames_u) + call RegPackAlloc(RF, InData%DerivOrder_x) + call RegPackAlloc(RF, InData%IsLoad_u) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine HydroDyn_UnPackInitOutput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(HydroDyn_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'HydroDyn_UnPackInitOutput' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call Morison_UnpackInitOutput(RF, OutData%Morison) ! Morison + call RegUnpackAlloc(RF, OutData%WriteOutputHdr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WriteOutputUnt); if (RegCheckErr(RF, RoutineName)) return + call NWTC_Library_UnpackProgDesc(RF, OutData%Ver) ! Ver + call RegUnpackAlloc(RF, OutData%LinNames_y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LinNames_x); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LinNames_u); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%DerivOrder_x); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%IsLoad_u); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine HydroDyn_CopyHD_ModuleMapType(SrcHD_ModuleMapTypeData, DstHD_ModuleMapTypeData, CtrlCode, ErrStat, ErrMsg) + type(HD_ModuleMapType), intent(inout) :: SrcHD_ModuleMapTypeData + type(HD_ModuleMapType), intent(inout) :: DstHD_ModuleMapTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'HydroDyn_CopyHD_ModuleMapType' + ErrStat = ErrID_None + ErrMsg = '' + call NWTC_Library_CopyMeshMapType(SrcHD_ModuleMapTypeData%uW_P_2_PRP_P, DstHD_ModuleMapTypeData%uW_P_2_PRP_P, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyMeshMapType(SrcHD_ModuleMapTypeData%W_P_2_PRP_P, DstHD_ModuleMapTypeData%W_P_2_PRP_P, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyMeshMapType(SrcHD_ModuleMapTypeData%M_P_2_PRP_P, DstHD_ModuleMapTypeData%M_P_2_PRP_P, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine HydroDyn_DestroyHD_ModuleMapType(HD_ModuleMapTypeData, ErrStat, ErrMsg) + type(HD_ModuleMapType), intent(inout) :: HD_ModuleMapTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'HydroDyn_DestroyHD_ModuleMapType' + ErrStat = ErrID_None + ErrMsg = '' + call NWTC_Library_DestroyMeshMapType(HD_ModuleMapTypeData%uW_P_2_PRP_P, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call NWTC_Library_DestroyMeshMapType(HD_ModuleMapTypeData%W_P_2_PRP_P, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call NWTC_Library_DestroyMeshMapType(HD_ModuleMapTypeData%M_P_2_PRP_P, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine HydroDyn_PackHD_ModuleMapType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(HD_ModuleMapType), intent(in) :: InData + character(*), parameter :: RoutineName = 'HydroDyn_PackHD_ModuleMapType' + if (RF%ErrStat >= AbortErrLev) return + call NWTC_Library_PackMeshMapType(RF, InData%uW_P_2_PRP_P) + call NWTC_Library_PackMeshMapType(RF, InData%W_P_2_PRP_P) + call NWTC_Library_PackMeshMapType(RF, InData%M_P_2_PRP_P) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine HydroDyn_UnPackHD_ModuleMapType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(HD_ModuleMapType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'HydroDyn_UnPackHD_ModuleMapType' + if (RF%ErrStat /= ErrID_None) return + call NWTC_Library_UnpackMeshMapType(RF, OutData%uW_P_2_PRP_P) ! uW_P_2_PRP_P + call NWTC_Library_UnpackMeshMapType(RF, OutData%W_P_2_PRP_P) ! W_P_2_PRP_P + call NWTC_Library_UnpackMeshMapType(RF, OutData%M_P_2_PRP_P) ! M_P_2_PRP_P +end subroutine + +subroutine HydroDyn_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) + type(HydroDyn_ContinuousStateType), intent(in) :: SrcContStateData + type(HydroDyn_ContinuousStateType), intent(inout) :: DstContStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'HydroDyn_CopyContState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcContStateData%WAMIT)) then + LB(1:1) = lbound(SrcContStateData%WAMIT) + UB(1:1) = ubound(SrcContStateData%WAMIT) + if (.not. allocated(DstContStateData%WAMIT)) then + allocate(DstContStateData%WAMIT(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%WAMIT.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call WAMIT_CopyContState(SrcContStateData%WAMIT(i1), DstContStateData%WAMIT(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call Morison_CopyContState(SrcContStateData%Morison, DstContStateData%Morison, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine HydroDyn_DestroyContState(ContStateData, ErrStat, ErrMsg) + type(HydroDyn_ContinuousStateType), intent(inout) :: ContStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'HydroDyn_DestroyContState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ContStateData%WAMIT)) then + LB(1:1) = lbound(ContStateData%WAMIT) + UB(1:1) = ubound(ContStateData%WAMIT) + do i1 = LB(1), UB(1) + call WAMIT_DestroyContState(ContStateData%WAMIT(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ContStateData%WAMIT) + end if + call Morison_DestroyContState(ContStateData%Morison, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine HydroDyn_PackContState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(HydroDyn_ContinuousStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'HydroDyn_PackContState' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%WAMIT)) + if (allocated(InData%WAMIT)) then + call RegPackBounds(RF, 1, lbound(InData%WAMIT), ubound(InData%WAMIT)) + LB(1:1) = lbound(InData%WAMIT) + UB(1:1) = ubound(InData%WAMIT) + do i1 = LB(1), UB(1) + call WAMIT_PackContState(RF, InData%WAMIT(i1)) + end do + end if + call Morison_PackContState(RF, InData%Morison) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine HydroDyn_UnPackContState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(HydroDyn_ContinuousStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'HydroDyn_UnPackContState' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + if (allocated(OutData%WAMIT)) deallocate(OutData%WAMIT) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%WAMIT(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WAMIT.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call WAMIT_UnpackContState(RF, OutData%WAMIT(i1)) ! WAMIT + end do + end if + call Morison_UnpackContState(RF, OutData%Morison) ! Morison +end subroutine + +subroutine HydroDyn_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) + type(HydroDyn_DiscreteStateType), intent(in) :: SrcDiscStateData + type(HydroDyn_DiscreteStateType), intent(inout) :: DstDiscStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'HydroDyn_CopyDiscState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcDiscStateData%WAMIT)) then + LB(1:1) = lbound(SrcDiscStateData%WAMIT) + UB(1:1) = ubound(SrcDiscStateData%WAMIT) + if (.not. allocated(DstDiscStateData%WAMIT)) then + allocate(DstDiscStateData%WAMIT(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%WAMIT.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call WAMIT_CopyDiscState(SrcDiscStateData%WAMIT(i1), DstDiscStateData%WAMIT(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call Morison_CopyDiscState(SrcDiscStateData%Morison, DstDiscStateData%Morison, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcDiscStateData%PtfmRefY)) then + LB(1:1) = lbound(SrcDiscStateData%PtfmRefY) + UB(1:1) = ubound(SrcDiscStateData%PtfmRefY) + if (.not. allocated(DstDiscStateData%PtfmRefY)) then + allocate(DstDiscStateData%PtfmRefY(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%PtfmRefY.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%PtfmRefY = SrcDiscStateData%PtfmRefY + end if +end subroutine + +subroutine HydroDyn_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) + type(HydroDyn_DiscreteStateType), intent(inout) :: DiscStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'HydroDyn_DestroyDiscState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(DiscStateData%WAMIT)) then + LB(1:1) = lbound(DiscStateData%WAMIT) + UB(1:1) = ubound(DiscStateData%WAMIT) + do i1 = LB(1), UB(1) + call WAMIT_DestroyDiscState(DiscStateData%WAMIT(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(DiscStateData%WAMIT) + end if + call Morison_DestroyDiscState(DiscStateData%Morison, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(DiscStateData%PtfmRefY)) then + deallocate(DiscStateData%PtfmRefY) + end if +end subroutine + +subroutine HydroDyn_PackDiscState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(HydroDyn_DiscreteStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'HydroDyn_PackDiscState' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%WAMIT)) + if (allocated(InData%WAMIT)) then + call RegPackBounds(RF, 1, lbound(InData%WAMIT), ubound(InData%WAMIT)) + LB(1:1) = lbound(InData%WAMIT) + UB(1:1) = ubound(InData%WAMIT) + do i1 = LB(1), UB(1) + call WAMIT_PackDiscState(RF, InData%WAMIT(i1)) + end do + end if + call Morison_PackDiscState(RF, InData%Morison) + call RegPackAlloc(RF, InData%PtfmRefY) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine HydroDyn_UnPackDiscState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(HydroDyn_DiscreteStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'HydroDyn_UnPackDiscState' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + if (allocated(OutData%WAMIT)) deallocate(OutData%WAMIT) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%WAMIT(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WAMIT.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call WAMIT_UnpackDiscState(RF, OutData%WAMIT(i1)) ! WAMIT + end do + end if + call Morison_UnpackDiscState(RF, OutData%Morison) ! Morison + call RegUnpackAlloc(RF, OutData%PtfmRefY); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine HydroDyn_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) + type(HydroDyn_ConstraintStateType), intent(in) :: SrcConstrStateData + type(HydroDyn_ConstraintStateType), intent(inout) :: DstConstrStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'HydroDyn_CopyConstrState' + ErrStat = ErrID_None + ErrMsg = '' + call WAMIT_CopyConstrState(SrcConstrStateData%WAMIT, DstConstrStateData%WAMIT, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call Morison_CopyConstrState(SrcConstrStateData%Morison, DstConstrStateData%Morison, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine HydroDyn_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) + type(HydroDyn_ConstraintStateType), intent(inout) :: ConstrStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'HydroDyn_DestroyConstrState' + ErrStat = ErrID_None + ErrMsg = '' + call WAMIT_DestroyConstrState(ConstrStateData%WAMIT, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call Morison_DestroyConstrState(ConstrStateData%Morison, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine HydroDyn_PackConstrState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(HydroDyn_ConstraintStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'HydroDyn_PackConstrState' + if (RF%ErrStat >= AbortErrLev) return + call WAMIT_PackConstrState(RF, InData%WAMIT) + call Morison_PackConstrState(RF, InData%Morison) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine HydroDyn_UnPackConstrState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(HydroDyn_ConstraintStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'HydroDyn_UnPackConstrState' + if (RF%ErrStat /= ErrID_None) return + call WAMIT_UnpackConstrState(RF, OutData%WAMIT) ! WAMIT + call Morison_UnpackConstrState(RF, OutData%Morison) ! Morison +end subroutine + +subroutine HydroDyn_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) + type(HydroDyn_OtherStateType), intent(in) :: SrcOtherStateData + type(HydroDyn_OtherStateType), intent(inout) :: DstOtherStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'HydroDyn_CopyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcOtherStateData%WAMIT)) then + LB(1:1) = lbound(SrcOtherStateData%WAMIT) + UB(1:1) = ubound(SrcOtherStateData%WAMIT) + if (.not. allocated(DstOtherStateData%WAMIT)) then + allocate(DstOtherStateData%WAMIT(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%WAMIT.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call WAMIT_CopyOtherState(SrcOtherStateData%WAMIT(i1), DstOtherStateData%WAMIT(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call Morison_CopyOtherState(SrcOtherStateData%Morison, DstOtherStateData%Morison, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine HydroDyn_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) + type(HydroDyn_OtherStateType), intent(inout) :: OtherStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'HydroDyn_DestroyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OtherStateData%WAMIT)) then + LB(1:1) = lbound(OtherStateData%WAMIT) + UB(1:1) = ubound(OtherStateData%WAMIT) + do i1 = LB(1), UB(1) + call WAMIT_DestroyOtherState(OtherStateData%WAMIT(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(OtherStateData%WAMIT) + end if + call Morison_DestroyOtherState(OtherStateData%Morison, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine HydroDyn_PackOtherState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(HydroDyn_OtherStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'HydroDyn_PackOtherState' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%WAMIT)) + if (allocated(InData%WAMIT)) then + call RegPackBounds(RF, 1, lbound(InData%WAMIT), ubound(InData%WAMIT)) + LB(1:1) = lbound(InData%WAMIT) + UB(1:1) = ubound(InData%WAMIT) + do i1 = LB(1), UB(1) + call WAMIT_PackOtherState(RF, InData%WAMIT(i1)) + end do + end if + call Morison_PackOtherState(RF, InData%Morison) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine HydroDyn_UnPackOtherState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(HydroDyn_OtherStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'HydroDyn_UnPackOtherState' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + if (allocated(OutData%WAMIT)) deallocate(OutData%WAMIT) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%WAMIT(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WAMIT.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call WAMIT_UnpackOtherState(RF, OutData%WAMIT(i1)) ! WAMIT + end do + end if + call Morison_UnpackOtherState(RF, OutData%Morison) ! Morison +end subroutine + +subroutine HydroDyn_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(HydroDyn_MiscVarType), intent(inout) :: SrcMiscData + type(HydroDyn_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'HydroDyn_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + call MeshCopy(SrcMiscData%AllHdroOrigin, DstMiscData%AllHdroOrigin, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call HydroDyn_CopyHD_ModuleMapType(SrcMiscData%HD_MeshMap, DstMiscData%HD_MeshMap, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstMiscData%Decimate = SrcMiscData%Decimate + DstMiscData%LastOutTime = SrcMiscData%LastOutTime + if (allocated(SrcMiscData%F_PtfmAdd)) then + LB(1:1) = lbound(SrcMiscData%F_PtfmAdd) + UB(1:1) = ubound(SrcMiscData%F_PtfmAdd) + if (.not. allocated(DstMiscData%F_PtfmAdd)) then + allocate(DstMiscData%F_PtfmAdd(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_PtfmAdd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%F_PtfmAdd = SrcMiscData%F_PtfmAdd + end if + DstMiscData%F_Hydro = SrcMiscData%F_Hydro + if (allocated(SrcMiscData%F_Waves)) then + LB(1:1) = lbound(SrcMiscData%F_Waves) + UB(1:1) = ubound(SrcMiscData%F_Waves) + if (.not. allocated(DstMiscData%F_Waves)) then + allocate(DstMiscData%F_Waves(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_Waves.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%F_Waves = SrcMiscData%F_Waves + end if + if (allocated(SrcMiscData%WAMIT)) then + LB(1:1) = lbound(SrcMiscData%WAMIT) + UB(1:1) = ubound(SrcMiscData%WAMIT) + if (.not. allocated(DstMiscData%WAMIT)) then + allocate(DstMiscData%WAMIT(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%WAMIT.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call WAMIT_CopyMisc(SrcMiscData%WAMIT(i1), DstMiscData%WAMIT(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcMiscData%WAMIT2)) then + LB(1:1) = lbound(SrcMiscData%WAMIT2) + UB(1:1) = ubound(SrcMiscData%WAMIT2) + if (.not. allocated(DstMiscData%WAMIT2)) then + allocate(DstMiscData%WAMIT2(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%WAMIT2.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call WAMIT2_CopyMisc(SrcMiscData%WAMIT2(i1), DstMiscData%WAMIT2(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call Morison_CopyMisc(SrcMiscData%Morison, DstMiscData%Morison, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcMiscData%u_WAMIT)) then + LB(1:1) = lbound(SrcMiscData%u_WAMIT) + UB(1:1) = ubound(SrcMiscData%u_WAMIT) + if (.not. allocated(DstMiscData%u_WAMIT)) then + allocate(DstMiscData%u_WAMIT(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%u_WAMIT.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call WAMIT_CopyInput(SrcMiscData%u_WAMIT(i1), DstMiscData%u_WAMIT(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if +end subroutine + +subroutine HydroDyn_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(HydroDyn_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'HydroDyn_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' + call MeshDestroy( MiscData%AllHdroOrigin, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call HydroDyn_DestroyHD_ModuleMapType(MiscData%HD_MeshMap, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(MiscData%F_PtfmAdd)) then + deallocate(MiscData%F_PtfmAdd) + end if + if (allocated(MiscData%F_Waves)) then + deallocate(MiscData%F_Waves) + end if + if (allocated(MiscData%WAMIT)) then + LB(1:1) = lbound(MiscData%WAMIT) + UB(1:1) = ubound(MiscData%WAMIT) + do i1 = LB(1), UB(1) + call WAMIT_DestroyMisc(MiscData%WAMIT(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%WAMIT) + end if + if (allocated(MiscData%WAMIT2)) then + LB(1:1) = lbound(MiscData%WAMIT2) + UB(1:1) = ubound(MiscData%WAMIT2) + do i1 = LB(1), UB(1) + call WAMIT2_DestroyMisc(MiscData%WAMIT2(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%WAMIT2) + end if + call Morison_DestroyMisc(MiscData%Morison, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(MiscData%u_WAMIT)) then + LB(1:1) = lbound(MiscData%u_WAMIT) + UB(1:1) = ubound(MiscData%u_WAMIT) + do i1 = LB(1), UB(1) + call WAMIT_DestroyInput(MiscData%u_WAMIT(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%u_WAMIT) + end if +end subroutine + +subroutine HydroDyn_PackMisc(RF, Indata) + type(RegFile), intent(inout) :: RF + type(HydroDyn_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'HydroDyn_PackMisc' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + if (RF%ErrStat >= AbortErrLev) return + call MeshPack(RF, InData%AllHdroOrigin) + call HydroDyn_PackHD_ModuleMapType(RF, InData%HD_MeshMap) + call RegPack(RF, InData%Decimate) + call RegPack(RF, InData%LastOutTime) + call RegPackAlloc(RF, InData%F_PtfmAdd) + call RegPack(RF, InData%F_Hydro) + call RegPackAlloc(RF, InData%F_Waves) + call RegPack(RF, allocated(InData%WAMIT)) + if (allocated(InData%WAMIT)) then + call RegPackBounds(RF, 1, lbound(InData%WAMIT), ubound(InData%WAMIT)) + LB(1:1) = lbound(InData%WAMIT) + UB(1:1) = ubound(InData%WAMIT) + do i1 = LB(1), UB(1) + call WAMIT_PackMisc(RF, InData%WAMIT(i1)) + end do + end if + call RegPack(RF, allocated(InData%WAMIT2)) + if (allocated(InData%WAMIT2)) then + call RegPackBounds(RF, 1, lbound(InData%WAMIT2), ubound(InData%WAMIT2)) + LB(1:1) = lbound(InData%WAMIT2) + UB(1:1) = ubound(InData%WAMIT2) + do i1 = LB(1), UB(1) + call WAMIT2_PackMisc(RF, InData%WAMIT2(i1)) + end do + end if + call Morison_PackMisc(RF, InData%Morison) + call RegPack(RF, allocated(InData%u_WAMIT)) + if (allocated(InData%u_WAMIT)) then + call RegPackBounds(RF, 1, lbound(InData%u_WAMIT), ubound(InData%u_WAMIT)) + LB(1:1) = lbound(InData%u_WAMIT) + UB(1:1) = ubound(InData%u_WAMIT) + do i1 = LB(1), UB(1) + call WAMIT_PackInput(RF, InData%u_WAMIT(i1)) + end do + end if + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine HydroDyn_UnPackMisc(RF, OutData) + type(RegFile), intent(inout) :: RF + type(HydroDyn_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'HydroDyn_UnPackMisc' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call MeshUnpack(RF, OutData%AllHdroOrigin) ! AllHdroOrigin + call HydroDyn_UnpackHD_ModuleMapType(RF, OutData%HD_MeshMap) ! HD_MeshMap + call RegUnpack(RF, OutData%Decimate); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LastOutTime); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%F_PtfmAdd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%F_Hydro); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%F_Waves); if (RegCheckErr(RF, RoutineName)) return + if (allocated(OutData%WAMIT)) deallocate(OutData%WAMIT) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%WAMIT(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WAMIT.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call WAMIT_UnpackMisc(RF, OutData%WAMIT(i1)) ! WAMIT + end do + end if + if (allocated(OutData%WAMIT2)) deallocate(OutData%WAMIT2) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%WAMIT2(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WAMIT2.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call WAMIT2_UnpackMisc(RF, OutData%WAMIT2(i1)) ! WAMIT2 + end do + end if + call Morison_UnpackMisc(RF, OutData%Morison) ! Morison + if (allocated(OutData%u_WAMIT)) deallocate(OutData%u_WAMIT) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%u_WAMIT(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_WAMIT.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call WAMIT_UnpackInput(RF, OutData%u_WAMIT(i1)) ! u_WAMIT + end do + end if +end subroutine + +subroutine HydroDyn_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(HydroDyn_ParameterType), intent(in) :: SrcParamData + type(HydroDyn_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'HydroDyn_CopyParam' + ErrStat = ErrID_None + ErrMsg = '' + DstParamData%nWAMITObj = SrcParamData%nWAMITObj + DstParamData%vecMultiplier = SrcParamData%vecMultiplier + if (allocated(SrcParamData%WAMIT)) then + LB(1:1) = lbound(SrcParamData%WAMIT) + UB(1:1) = ubound(SrcParamData%WAMIT) + if (.not. allocated(DstParamData%WAMIT)) then + allocate(DstParamData%WAMIT(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WAMIT.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call WAMIT_CopyParam(SrcParamData%WAMIT(i1), DstParamData%WAMIT(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcParamData%WAMIT2)) then + LB(1:1) = lbound(SrcParamData%WAMIT2) + UB(1:1) = ubound(SrcParamData%WAMIT2) + if (.not. allocated(DstParamData%WAMIT2)) then + allocate(DstParamData%WAMIT2(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WAMIT2.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call WAMIT2_CopyParam(SrcParamData%WAMIT2(i1), DstParamData%WAMIT2(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + DstParamData%WAMIT2used = SrcParamData%WAMIT2used + call Morison_CopyParam(SrcParamData%Morison, DstParamData%Morison, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstParamData%PotMod = SrcParamData%PotMod + DstParamData%NBody = SrcParamData%NBody + DstParamData%NBodyMod = SrcParamData%NBodyMod + DstParamData%totalStates = SrcParamData%totalStates + DstParamData%totalExctnStates = SrcParamData%totalExctnStates + DstParamData%totalRdtnStates = SrcParamData%totalRdtnStates + if (allocated(SrcParamData%AddF0)) then + LB(1:2) = lbound(SrcParamData%AddF0) + UB(1:2) = ubound(SrcParamData%AddF0) + if (.not. allocated(DstParamData%AddF0)) then + allocate(DstParamData%AddF0(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AddF0.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%AddF0 = SrcParamData%AddF0 + end if + if (allocated(SrcParamData%AddCLin)) then + LB(1:3) = lbound(SrcParamData%AddCLin) + UB(1:3) = ubound(SrcParamData%AddCLin) + if (.not. allocated(DstParamData%AddCLin)) then + allocate(DstParamData%AddCLin(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AddCLin.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%AddCLin = SrcParamData%AddCLin + end if + if (allocated(SrcParamData%AddBLin)) then + LB(1:3) = lbound(SrcParamData%AddBLin) + UB(1:3) = ubound(SrcParamData%AddBLin) + if (.not. allocated(DstParamData%AddBLin)) then + allocate(DstParamData%AddBLin(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AddBLin.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%AddBLin = SrcParamData%AddBLin + end if + if (allocated(SrcParamData%AddBQuad)) then + LB(1:3) = lbound(SrcParamData%AddBQuad) + UB(1:3) = ubound(SrcParamData%AddBQuad) + if (.not. allocated(DstParamData%AddBQuad)) then + allocate(DstParamData%AddBQuad(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AddBQuad.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%AddBQuad = SrcParamData%AddBQuad + end if + DstParamData%DT = SrcParamData%DT + if (allocated(SrcParamData%OutParam)) then + LB(1:1) = lbound(SrcParamData%OutParam) + UB(1:1) = ubound(SrcParamData%OutParam) + if (.not. allocated(DstParamData%OutParam)) then + allocate(DstParamData%OutParam(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutParam.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyOutParmType(SrcParamData%OutParam(i1), DstParamData%OutParam(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + DstParamData%NumOuts = SrcParamData%NumOuts + DstParamData%NumTotalOuts = SrcParamData%NumTotalOuts + DstParamData%OutSwtch = SrcParamData%OutSwtch + DstParamData%OutFmt = SrcParamData%OutFmt + DstParamData%OutSFmt = SrcParamData%OutSFmt + DstParamData%Delim = SrcParamData%Delim + DstParamData%UnOutFile = SrcParamData%UnOutFile + DstParamData%OutDec = SrcParamData%OutDec + if (allocated(SrcParamData%Jac_u_indx)) then + LB(1:2) = lbound(SrcParamData%Jac_u_indx) + UB(1:2) = ubound(SrcParamData%Jac_u_indx) + if (.not. allocated(DstParamData%Jac_u_indx)) then + allocate(DstParamData%Jac_u_indx(LB(1):UB(1),LB(2):UB(2)), 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 + end if + if (allocated(SrcParamData%du)) then + LB(1:1) = lbound(SrcParamData%du) + UB(1:1) = ubound(SrcParamData%du) + if (.not. allocated(DstParamData%du)) then + allocate(DstParamData%du(LB(1):UB(1)), 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 + end if + if (allocated(SrcParamData%dx)) then + LB(1:1) = lbound(SrcParamData%dx) + UB(1:1) = ubound(SrcParamData%dx) + if (.not. allocated(DstParamData%dx)) then + allocate(DstParamData%dx(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%dx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%dx = SrcParamData%dx + end if + DstParamData%Jac_ny = SrcParamData%Jac_ny + DstParamData%VisMeshes = SrcParamData%VisMeshes + DstParamData%WaveField => SrcParamData%WaveField + DstParamData%PtfmYMod = SrcParamData%PtfmYMod + DstParamData%CYawFilt = SrcParamData%CYawFilt +end subroutine + +subroutine HydroDyn_DestroyParam(ParamData, ErrStat, ErrMsg) + type(HydroDyn_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'HydroDyn_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ParamData%WAMIT)) then + LB(1:1) = lbound(ParamData%WAMIT) + UB(1:1) = ubound(ParamData%WAMIT) + do i1 = LB(1), UB(1) + call WAMIT_DestroyParam(ParamData%WAMIT(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%WAMIT) + end if + if (allocated(ParamData%WAMIT2)) then + LB(1:1) = lbound(ParamData%WAMIT2) + UB(1:1) = ubound(ParamData%WAMIT2) + do i1 = LB(1), UB(1) + call WAMIT2_DestroyParam(ParamData%WAMIT2(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%WAMIT2) + end if + call Morison_DestroyParam(ParamData%Morison, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(ParamData%AddF0)) then + deallocate(ParamData%AddF0) + end if + if (allocated(ParamData%AddCLin)) then + deallocate(ParamData%AddCLin) + end if + if (allocated(ParamData%AddBLin)) then + deallocate(ParamData%AddBLin) + end if + if (allocated(ParamData%AddBQuad)) then + deallocate(ParamData%AddBQuad) + end if + if (allocated(ParamData%OutParam)) then + LB(1:1) = lbound(ParamData%OutParam) + UB(1:1) = ubound(ParamData%OutParam) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyOutParmType(ParamData%OutParam(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%OutParam) + end if + if (allocated(ParamData%Jac_u_indx)) then + deallocate(ParamData%Jac_u_indx) + end if + if (allocated(ParamData%du)) then + deallocate(ParamData%du) + end if + if (allocated(ParamData%dx)) then + deallocate(ParamData%dx) + end if + nullify(ParamData%WaveField) +end subroutine + +subroutine HydroDyn_PackParam(RF, Indata) + type(RegFile), intent(inout) :: RF + type(HydroDyn_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'HydroDyn_PackParam' + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) + logical :: PtrInIndex + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%nWAMITObj) + call RegPack(RF, InData%vecMultiplier) + call RegPack(RF, allocated(InData%WAMIT)) + if (allocated(InData%WAMIT)) then + call RegPackBounds(RF, 1, lbound(InData%WAMIT), ubound(InData%WAMIT)) + LB(1:1) = lbound(InData%WAMIT) + UB(1:1) = ubound(InData%WAMIT) + do i1 = LB(1), UB(1) + call WAMIT_PackParam(RF, InData%WAMIT(i1)) + end do + end if + call RegPack(RF, allocated(InData%WAMIT2)) + if (allocated(InData%WAMIT2)) then + call RegPackBounds(RF, 1, lbound(InData%WAMIT2), ubound(InData%WAMIT2)) + LB(1:1) = lbound(InData%WAMIT2) + UB(1:1) = ubound(InData%WAMIT2) + do i1 = LB(1), UB(1) + call WAMIT2_PackParam(RF, InData%WAMIT2(i1)) + end do + end if + call RegPack(RF, InData%WAMIT2used) + call Morison_PackParam(RF, InData%Morison) + call RegPack(RF, InData%PotMod) + call RegPack(RF, InData%NBody) + call RegPack(RF, InData%NBodyMod) + call RegPack(RF, InData%totalStates) + call RegPack(RF, InData%totalExctnStates) + call RegPack(RF, InData%totalRdtnStates) + call RegPackAlloc(RF, InData%AddF0) + call RegPackAlloc(RF, InData%AddCLin) + call RegPackAlloc(RF, InData%AddBLin) + call RegPackAlloc(RF, InData%AddBQuad) + call RegPack(RF, InData%DT) + call RegPack(RF, allocated(InData%OutParam)) + if (allocated(InData%OutParam)) then + call RegPackBounds(RF, 1, lbound(InData%OutParam), ubound(InData%OutParam)) + LB(1:1) = lbound(InData%OutParam) + UB(1:1) = ubound(InData%OutParam) + do i1 = LB(1), UB(1) + call NWTC_Library_PackOutParmType(RF, InData%OutParam(i1)) + end do + end if + call RegPack(RF, InData%NumOuts) + call RegPack(RF, InData%NumTotalOuts) + call RegPack(RF, InData%OutSwtch) + call RegPack(RF, InData%OutFmt) + call RegPack(RF, InData%OutSFmt) + call RegPack(RF, InData%Delim) + call RegPack(RF, InData%UnOutFile) + call RegPack(RF, InData%OutDec) + call RegPackAlloc(RF, InData%Jac_u_indx) + call RegPackAlloc(RF, InData%du) + call RegPackAlloc(RF, InData%dx) + call RegPack(RF, InData%Jac_ny) + call RegPack(RF, InData%VisMeshes) + call RegPack(RF, associated(InData%WaveField)) + if (associated(InData%WaveField)) then + call RegPackPointer(RF, c_loc(InData%WaveField), PtrInIndex) + if (.not. PtrInIndex) then + call SeaSt_WaveField_PackSeaSt_WaveFieldType(RF, InData%WaveField) + end if + end if + call RegPack(RF, InData%PtfmYMod) + call RegPack(RF, InData%CYawFilt) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine HydroDyn_UnPackParam(RF, OutData) + type(RegFile), intent(inout) :: RF + type(HydroDyn_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'HydroDyn_UnPackParam' + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(B8Ki) :: PtrIdx + type(c_ptr) :: Ptr + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%nWAMITObj); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%vecMultiplier); if (RegCheckErr(RF, RoutineName)) return + if (allocated(OutData%WAMIT)) deallocate(OutData%WAMIT) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%WAMIT(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WAMIT.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call WAMIT_UnpackParam(RF, OutData%WAMIT(i1)) ! WAMIT + end do + end if + if (allocated(OutData%WAMIT2)) deallocate(OutData%WAMIT2) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%WAMIT2(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WAMIT2.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call WAMIT2_UnpackParam(RF, OutData%WAMIT2(i1)) ! WAMIT2 + end do + end if + call RegUnpack(RF, OutData%WAMIT2used); if (RegCheckErr(RF, RoutineName)) return + call Morison_UnpackParam(RF, OutData%Morison) ! Morison + call RegUnpack(RF, OutData%PotMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NBody); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NBodyMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%totalStates); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%totalExctnStates); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%totalRdtnStates); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AddF0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AddCLin); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AddBLin); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AddBQuad); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DT); if (RegCheckErr(RF, RoutineName)) return + if (allocated(OutData%OutParam)) deallocate(OutData%OutParam) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%OutParam(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackOutParmType(RF, OutData%OutParam(i1)) ! OutParam + end do + end if + call RegUnpack(RF, OutData%NumOuts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumTotalOuts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutSwtch); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutFmt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutSFmt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Delim); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UnOutFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutDec); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Jac_u_indx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%du); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Jac_ny); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VisMeshes); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%WaveField)) deallocate(OutData%WaveField) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackPointer(RF, Ptr, PtrIdx); if (RegCheckErr(RF, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveField) + else + allocate(OutData%WaveField,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveField.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + RF%Pointers(PtrIdx) = c_loc(OutData%WaveField) + call SeaSt_WaveField_UnpackSeaSt_WaveFieldType(RF, OutData%WaveField) ! WaveField + end if + else + OutData%WaveField => null() + end if + call RegUnpack(RF, OutData%PtfmYMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CYawFilt); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine HydroDyn_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) + type(HydroDyn_InputType), intent(inout) :: SrcInputData + type(HydroDyn_InputType), intent(inout) :: DstInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'HydroDyn_CopyInput' + ErrStat = ErrID_None + ErrMsg = '' + call Morison_CopyInput(SrcInputData%Morison, DstInputData%Morison, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcInputData%WAMITMesh, DstInputData%WAMITMesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcInputData%PRPMesh, DstInputData%PRPMesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine HydroDyn_DestroyInput(InputData, ErrStat, ErrMsg) + type(HydroDyn_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'HydroDyn_DestroyInput' + ErrStat = ErrID_None + ErrMsg = '' + call Morison_DestroyInput(InputData%Morison, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( InputData%WAMITMesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( InputData%PRPMesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine HydroDyn_PackInput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(HydroDyn_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'HydroDyn_PackInput' + if (RF%ErrStat >= AbortErrLev) return + call Morison_PackInput(RF, InData%Morison) + call MeshPack(RF, InData%WAMITMesh) + call MeshPack(RF, InData%PRPMesh) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine HydroDyn_UnPackInput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(HydroDyn_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'HydroDyn_UnPackInput' + if (RF%ErrStat /= ErrID_None) return + call Morison_UnpackInput(RF, OutData%Morison) ! Morison + call MeshUnpack(RF, OutData%WAMITMesh) ! WAMITMesh + call MeshUnpack(RF, OutData%PRPMesh) ! PRPMesh +end subroutine + +subroutine HydroDyn_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(HydroDyn_OutputType), intent(inout) :: SrcOutputData + type(HydroDyn_OutputType), intent(inout) :: DstOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'HydroDyn_CopyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcOutputData%WAMIT)) then + LB(1:1) = lbound(SrcOutputData%WAMIT) + UB(1:1) = ubound(SrcOutputData%WAMIT) + if (.not. allocated(DstOutputData%WAMIT)) then + allocate(DstOutputData%WAMIT(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WAMIT.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call WAMIT_CopyOutput(SrcOutputData%WAMIT(i1), DstOutputData%WAMIT(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcOutputData%WAMIT2)) then + LB(1:1) = lbound(SrcOutputData%WAMIT2) + UB(1:1) = ubound(SrcOutputData%WAMIT2) + if (.not. allocated(DstOutputData%WAMIT2)) then + allocate(DstOutputData%WAMIT2(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WAMIT2.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call WAMIT2_CopyOutput(SrcOutputData%WAMIT2(i1), DstOutputData%WAMIT2(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call Morison_CopyOutput(SrcOutputData%Morison, DstOutputData%Morison, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcOutputData%WAMITMesh, DstOutputData%WAMITMesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcOutputData%WriteOutput)) then + LB(1:1) = lbound(SrcOutputData%WriteOutput) + UB(1:1) = ubound(SrcOutputData%WriteOutput) + if (.not. allocated(DstOutputData%WriteOutput)) then + allocate(DstOutputData%WriteOutput(LB(1):UB(1)), 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 + end if +end subroutine + +subroutine HydroDyn_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(HydroDyn_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'HydroDyn_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OutputData%WAMIT)) then + LB(1:1) = lbound(OutputData%WAMIT) + UB(1:1) = ubound(OutputData%WAMIT) + do i1 = LB(1), UB(1) + call WAMIT_DestroyOutput(OutputData%WAMIT(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(OutputData%WAMIT) + end if + if (allocated(OutputData%WAMIT2)) then + LB(1:1) = lbound(OutputData%WAMIT2) + UB(1:1) = ubound(OutputData%WAMIT2) + do i1 = LB(1), UB(1) + call WAMIT2_DestroyOutput(OutputData%WAMIT2(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(OutputData%WAMIT2) + end if + call Morison_DestroyOutput(OutputData%Morison, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( OutputData%WAMITMesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(OutputData%WriteOutput)) then + deallocate(OutputData%WriteOutput) + end if +end subroutine + +subroutine HydroDyn_PackOutput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(HydroDyn_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'HydroDyn_PackOutput' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%WAMIT)) + if (allocated(InData%WAMIT)) then + call RegPackBounds(RF, 1, lbound(InData%WAMIT), ubound(InData%WAMIT)) + LB(1:1) = lbound(InData%WAMIT) + UB(1:1) = ubound(InData%WAMIT) + do i1 = LB(1), UB(1) + call WAMIT_PackOutput(RF, InData%WAMIT(i1)) + end do + end if + call RegPack(RF, allocated(InData%WAMIT2)) + if (allocated(InData%WAMIT2)) then + call RegPackBounds(RF, 1, lbound(InData%WAMIT2), ubound(InData%WAMIT2)) + LB(1:1) = lbound(InData%WAMIT2) + UB(1:1) = ubound(InData%WAMIT2) + do i1 = LB(1), UB(1) + call WAMIT2_PackOutput(RF, InData%WAMIT2(i1)) + end do + end if + call Morison_PackOutput(RF, InData%Morison) + call MeshPack(RF, InData%WAMITMesh) + call RegPackAlloc(RF, InData%WriteOutput) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine HydroDyn_UnPackOutput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(HydroDyn_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'HydroDyn_UnPackOutput' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + if (allocated(OutData%WAMIT)) deallocate(OutData%WAMIT) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%WAMIT(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WAMIT.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call WAMIT_UnpackOutput(RF, OutData%WAMIT(i1)) ! WAMIT + end do + end if + if (allocated(OutData%WAMIT2)) deallocate(OutData%WAMIT2) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%WAMIT2(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WAMIT2.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call WAMIT2_UnpackOutput(RF, OutData%WAMIT2(i1)) ! WAMIT2 + end do + end if + call Morison_UnpackOutput(RF, OutData%Morison) ! Morison + call MeshUnpack(RF, OutData%WAMITMesh) ! WAMITMesh + call RegUnpackAlloc(RF, OutData%WriteOutput); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine HydroDyn_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(HydroDyn_InputType), intent(inout) :: u(:) ! Input at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Inputs + type(HydroDyn_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 = 'HydroDyn_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 HydroDyn_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL HydroDyn_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 HydroDyn_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 HydroDyn_Input_ExtrapInterp - - - SUBROUTINE HydroDyn_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'HydroDyn_Input_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(u)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(u)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(u) - 1 + select case (order) + case (0) + call HydroDyn_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call HydroDyn_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call HydroDyn_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(u) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE HydroDyn_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. @@ -10704,45 +2275,46 @@ SUBROUTINE HydroDyn_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, Er ! !.................................................................................................................................. - TYPE(HydroDyn_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 - TYPE(HydroDyn_InputType), INTENT(INOUT) :: u2 ! Input at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs - TYPE(HydroDyn_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 + TYPE(HydroDyn_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 + TYPE(HydroDyn_InputType), INTENT(INOUT) :: u2 ! Input at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs + TYPE(HydroDyn_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 = 'HydroDyn_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 + REAL(DbKi) :: t(2) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_Input_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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 Morison_Input_ExtrapInterp1( u1%Morison, u2%Morison, tin, u_out%Morison, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp1(u1%WAMITMesh, u2%WAMITMesh, tin, u_out%WAMITMesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp1(u1%PRPMesh, u2%PRPMesh, tin, u_out%PRPMesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - END SUBROUTINE HydroDyn_Input_ExtrapInterp1 - - - SUBROUTINE HydroDyn_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + CALL Morison_Input_ExtrapInterp1( u1%Morison, u2%Morison, tin, u_out%Morison, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp1(u1%WAMITMesh, u2%WAMITMesh, tin, u_out%WAMITMesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp1(u1%PRPMesh, u2%PRPMesh, tin, u_out%PRPMesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) +END SUBROUTINE + +SUBROUTINE HydroDyn_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. @@ -10756,105 +2328,106 @@ SUBROUTINE HydroDyn_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat ! !.................................................................................................................................. - TYPE(HydroDyn_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 > t3 - TYPE(HydroDyn_InputType), INTENT(INOUT) :: u2 ! Input at t2 > t3 - TYPE(HydroDyn_InputType), INTENT(INOUT) :: u3 ! Input at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs - TYPE(HydroDyn_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 + TYPE(HydroDyn_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 > t3 + TYPE(HydroDyn_InputType), INTENT(INOUT) :: u2 ! Input at t2 > t3 + TYPE(HydroDyn_InputType), INTENT(INOUT) :: u3 ! Input at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs + TYPE(HydroDyn_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 = 'HydroDyn_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) - + 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) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_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 + 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 + 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 + 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 Morison_Input_ExtrapInterp2( u1%Morison, u2%Morison, u3%Morison, tin, u_out%Morison, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp2(u1%WAMITMesh, u2%WAMITMesh, u3%WAMITMesh, tin, u_out%WAMITMesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp2(u1%PRPMesh, u2%PRPMesh, u3%PRPMesh, tin, u_out%PRPMesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - END SUBROUTINE HydroDyn_Input_ExtrapInterp2 - - - SUBROUTINE HydroDyn_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(HydroDyn_OutputType), INTENT(INOUT) :: y(:) ! Output at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Outputs - TYPE(HydroDyn_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 + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + CALL Morison_Input_ExtrapInterp2( u1%Morison, u2%Morison, u3%Morison, tin, u_out%Morison, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp2(u1%WAMITMesh, u2%WAMITMesh, u3%WAMITMesh, tin, u_out%WAMITMesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp2(u1%PRPMesh, u2%PRPMesh, u3%PRPMesh, tin, u_out%PRPMesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) +END SUBROUTINE + +subroutine HydroDyn_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(HydroDyn_OutputType), intent(inout) :: y(:) ! Output at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Outputs + type(HydroDyn_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 = 'HydroDyn_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 HydroDyn_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL HydroDyn_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 HydroDyn_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 HydroDyn_Output_ExtrapInterp - - - SUBROUTINE HydroDyn_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'HydroDyn_Output_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(y)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(y)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(y) - 1 + select case (order) + case (0) + call HydroDyn_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call HydroDyn_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call HydroDyn_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(y) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE HydroDyn_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. @@ -10866,65 +2439,61 @@ SUBROUTINE HydroDyn_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, E ! !.................................................................................................................................. - TYPE(HydroDyn_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 - TYPE(HydroDyn_OutputType), INTENT(INOUT) :: y2 ! Output at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs - TYPE(HydroDyn_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 + TYPE(HydroDyn_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 + TYPE(HydroDyn_OutputType), INTENT(INOUT) :: y2 ! Output at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs + TYPE(HydroDyn_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 = 'HydroDyn_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 + REAL(DbKi) :: t(2) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_Output_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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%WAMIT) .AND. ALLOCATED(y1%WAMIT)) THEN - DO i1 = LBOUND(y_out%WAMIT,1),UBOUND(y_out%WAMIT,1) - CALL WAMIT_Output_ExtrapInterp1( y1%WAMIT(i1), y2%WAMIT(i1), tin, y_out%WAMIT(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated -IF (ALLOCATED(y_out%WAMIT2) .AND. ALLOCATED(y1%WAMIT2)) THEN - DO i1 = LBOUND(y_out%WAMIT2,1),UBOUND(y_out%WAMIT2,1) - CALL WAMIT2_Output_ExtrapInterp1( y1%WAMIT2(i1), y2%WAMIT2(i1), tin, y_out%WAMIT2(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated - CALL Waves2_Output_ExtrapInterp1( y1%Waves2, y2%Waves2, tin, y_out%Waves2, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL Morison_Output_ExtrapInterp1( y1%Morison, y2%Morison, tin, y_out%Morison, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp1(y1%WAMITMesh, y2%WAMITMesh, tin, y_out%WAMITMesh, 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 HydroDyn_Output_ExtrapInterp1 - - - SUBROUTINE HydroDyn_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + IF (ALLOCATED(y_out%WAMIT) .AND. ALLOCATED(y1%WAMIT)) THEN + do i1 = lbound(y_out%WAMIT,1),ubound(y_out%WAMIT,1) + CALL WAMIT_Output_ExtrapInterp1( y1%WAMIT(i1), y2%WAMIT(i1), tin, y_out%WAMIT(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + IF (ALLOCATED(y_out%WAMIT2) .AND. ALLOCATED(y1%WAMIT2)) THEN + do i1 = lbound(y_out%WAMIT2,1),ubound(y_out%WAMIT2,1) + CALL WAMIT2_Output_ExtrapInterp1( y1%WAMIT2(i1), y2%WAMIT2(i1), tin, y_out%WAMIT2(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + CALL Morison_Output_ExtrapInterp1( y1%Morison, y2%Morison, tin, y_out%Morison, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp1(y1%WAMITMesh, y2%WAMITMesh, tin, y_out%WAMITMesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + END IF ! check if allocated +END SUBROUTINE + +SUBROUTINE HydroDyn_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. @@ -10938,72 +2507,66 @@ SUBROUTINE HydroDyn_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrSta ! !.................................................................................................................................. - TYPE(HydroDyn_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 > t3 - TYPE(HydroDyn_OutputType), INTENT(INOUT) :: y2 ! Output at t2 > t3 - TYPE(HydroDyn_OutputType), INTENT(INOUT) :: y3 ! Output at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs - TYPE(HydroDyn_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 + TYPE(HydroDyn_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 > t3 + TYPE(HydroDyn_OutputType), INTENT(INOUT) :: y2 ! Output at t2 > t3 + TYPE(HydroDyn_OutputType), INTENT(INOUT) :: y3 ! Output at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs + TYPE(HydroDyn_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 = 'HydroDyn_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) - + 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) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_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 + 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 + 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 + 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%WAMIT) .AND. ALLOCATED(y1%WAMIT)) THEN - DO i1 = LBOUND(y_out%WAMIT,1),UBOUND(y_out%WAMIT,1) - CALL WAMIT_Output_ExtrapInterp2( y1%WAMIT(i1), y2%WAMIT(i1), y3%WAMIT(i1), tin, y_out%WAMIT(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated -IF (ALLOCATED(y_out%WAMIT2) .AND. ALLOCATED(y1%WAMIT2)) THEN - DO i1 = LBOUND(y_out%WAMIT2,1),UBOUND(y_out%WAMIT2,1) - CALL WAMIT2_Output_ExtrapInterp2( y1%WAMIT2(i1), y2%WAMIT2(i1), y3%WAMIT2(i1), tin, y_out%WAMIT2(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated - CALL Waves2_Output_ExtrapInterp2( y1%Waves2, y2%Waves2, y3%Waves2, tin, y_out%Waves2, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL Morison_Output_ExtrapInterp2( y1%Morison, y2%Morison, y3%Morison, tin, y_out%Morison, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp2(y1%WAMITMesh, y2%WAMITMesh, y3%WAMITMesh, tin, y_out%WAMITMesh, 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 HydroDyn_Output_ExtrapInterp2 - + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + IF (ALLOCATED(y_out%WAMIT) .AND. ALLOCATED(y1%WAMIT)) THEN + do i1 = lbound(y_out%WAMIT,1),ubound(y_out%WAMIT,1) + CALL WAMIT_Output_ExtrapInterp2( y1%WAMIT(i1), y2%WAMIT(i1), y3%WAMIT(i1), tin, y_out%WAMIT(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + IF (ALLOCATED(y_out%WAMIT2) .AND. ALLOCATED(y1%WAMIT2)) THEN + do i1 = lbound(y_out%WAMIT2,1),ubound(y_out%WAMIT2,1) + CALL WAMIT2_Output_ExtrapInterp2( y1%WAMIT2(i1), y2%WAMIT2(i1), y3%WAMIT2(i1), tin, y_out%WAMIT2(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + CALL Morison_Output_ExtrapInterp2( y1%Morison, y2%Morison, y3%Morison, tin, y_out%Morison, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp2(y1%WAMITMesh, y2%WAMITMesh, y3%WAMITMesh, tin, y_out%WAMITMesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + a3*y3%WriteOutput + END IF ! check if allocated +END SUBROUTINE END MODULE HydroDyn_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/hydrodyn/src/Morison.f90 b/modules/hydrodyn/src/Morison.f90 index 71fe162c9b..2926f82e6b 100644 --- a/modules/hydrodyn/src/Morison.f90 +++ b/modules/hydrodyn/src/Morison.f90 @@ -23,8 +23,10 @@ MODULE Morison USE Waves USE Morison_Types USE Morison_Output + USE SeaSt_WaveField ! USE HydroDyn_Output_Types USE NWTC_Library + USE YawOffset IMPLICIT NONE @@ -38,20 +40,11 @@ MODULE Morison PUBLIC:: Morison_GenerateSimulationNodes PUBLIC :: Morison_Init ! Initialization routine - PUBLIC :: Morison_End ! Ending routine (includes clean up) - - PUBLIC :: Morison_UpdateStates ! Loose coupling routine for solving for constraint states, integrating - ! continuous states, and updating discrete states PUBLIC :: Morison_CalcOutput ! Routine for computing outputs - - PUBLIC :: Morison_CalcConstrStateResidual ! Tight coupling routine for returning the constraint state residual - PUBLIC :: Morison_CalcContStateDeriv ! Tight coupling routine for computing derivatives of continuous states - PUBLIC :: Morison_UpdateDiscState ! Tight coupling routine for updating discrete states - - + PUBLIC :: Morison_UpdateDiscState ! Routine for updating discrete states CONTAINS - +!---------------------------------------------------------------------------------------------------------------------------------- SUBROUTINE Morison_DirCosMtrx( pos0, pos1, DirCos ) ! Compute the direction cosine matrix given two points along the axis of a cylinder @@ -345,13 +338,13 @@ FUNCTION InterpWrappedStpLogical( XValIn, XAry, YAry, Ind, AryLen ) RETURN END FUNCTION InterpWrappedStpLogical ! ( XVal, XAry, YAry, Ind, AryLen ) - +!---------------------------------------------------------------------------------------------------------------------------------- subroutine GetOrientationAngles(p1, p2, phi, sinPhi, cosPhi, tanPhi, sinBeta, cosBeta, k_hat, errStat, errMsg) real(ReKi), intent(in ) :: p1(3),p2(3) real(ReKi), intent( out) :: phi, sinPhi, cosPhi, tanPhi, sinBeta, cosBeta, k_hat(3) integer, intent( out) :: errStat ! returns a non-zero value when an error occurs character(*), intent( out) :: errMsg ! Error message if errStat /= ErrID_None - + character(*), parameter :: RoutineName = 'GetOrientationAngles' real(ReKi) :: vec(3), vecLen, vecLen2D, beta @@ -366,7 +359,8 @@ subroutine GetOrientationAngles(p1, p2, phi, sinPhi, cosPhi, tanPhi, sinBeta, co vecLen = SQRT(Dot_Product(vec,vec)) vecLen2D = SQRT(vec(1)**2+vec(2)**2) if ( vecLen < 0.000001 ) then - call SeterrStat(ErrID_Fatal, 'An element of the Morison structure has co-located endpoints! This should never occur. Please review your model.', errStat, errMsg, 'Morison_CalcOutput' ) + call SeterrStat(ErrID_Fatal, 'An element of the Morison structure has co-located endpoints! This should never occur. Please review your model.', errStat, errMsg, RoutineName ) + return else k_hat = vec / vecLen phi = atan2(vecLen2D, vec(3)) ! incline angle @@ -383,8 +377,7 @@ subroutine GetOrientationAngles(p1, p2, phi, sinPhi, cosPhi, tanPhi, sinBeta, co cosBeta = cos(beta) end subroutine GetOrientationAngles - - +!---------------------------------------------------------------------------------------------------------------------------------- !function to return conical taper geometry calculations (volume and center of volume) SUBROUTINE TaperCalc(R1, R2, H, taperV, h_c) REAL(ReKi), INTENT ( IN ) :: R1 @@ -409,8 +402,7 @@ SUBROUTINE TaperCalc(R1, R2, H, taperV, h_c) end if END SUBROUTINE TaperCalc - - +!---------------------------------------------------------------------------------------------------------------------------------- SUBROUTINE CylInertia(R1, R2, H, rho, Il, Ir) REAL(ReKi), INTENT ( IN ) :: R1 REAL(ReKi), INTENT ( IN ) :: R2 @@ -438,9 +430,7 @@ SUBROUTINE CylInertia(R1, R2, H, rho, Il, Ir) END IF END SUBROUTINE CylInertia - - - +!---------------------------------------------------------------------------------------------------------------------------------- SUBROUTINE MarineGrowthPartSegment(R1, R2, Rmg1, Rmg2, L, rho, Vinner, Vouter, m_mg, h_c, Ilmg, Irmg) REAL(ReKi), INTENT ( IN ) :: R1 @@ -490,8 +480,7 @@ SUBROUTINE MarineGrowthPartSegment(R1, R2, Rmg1, Rmg2, L, rho, Vinner, Vouter, Irmg = Irouter - Irinner END SUBROUTINE MarineGrowthPartSegment - - +!---------------------------------------------------------------------------------------------------------------------------------- SUBROUTINE FloodedBallastPartSegment(R1, R2, L, rho, V, m, h_c, Il, Ir) REAL(ReKi), INTENT ( IN ) :: R1 ! interior radius of element at node point @@ -513,16 +502,11 @@ SUBROUTINE FloodedBallastPartSegment(R1, R2, L, rho, V, m, h_c, Il, Ir) call CylInertia(R1, R2, L, rho, Il, Ir) ! inertias for filled section END SUBROUTINE FloodedBallastPartSegment - - -SUBROUTINE WriteSummaryFile( UnSum, g, MSL2SWL, WtrDpth, numJoints, numNodes, nodes, numMembers, members, & - NOutputs, OutParam, NMOutputs, MOutLst, NJOutputs, JOutLst, uMesh, yMesh, & - p, m, errStat, errMsg ) +!---------------------------------------------------------------------------------------------------------------------------------- +SUBROUTINE WriteSummaryFile( UnSum, numJoints, numNodes, nodes, numMembers, members, & + NOutputs, OutParam, MOutLst, JOutLst, uMesh, yMesh, p, m, errStat, errMsg ) INTEGER, INTENT ( IN ) :: UnSum - REAL(ReKi), INTENT ( IN ) :: g ! gravity - REAL(ReKi), INTENT ( IN ) :: MSL2SWL - REAL(ReKi), INTENT ( IN ) :: WtrDpth INTEGER, INTENT ( IN ) :: numJoints INTEGER, INTENT ( IN ) :: numNodes TYPE(Morison_NodeType), ALLOCATABLE, INTENT ( IN ) :: nodes(:) @@ -530,9 +514,7 @@ SUBROUTINE WriteSummaryFile( UnSum, g, MSL2SWL, WtrDpth, numJoints, numNodes, no TYPE(Morison_MemberType), ALLOCATABLE, INTENT ( IN ) :: members(:) INTEGER, INTENT ( IN ) :: NOutputs TYPE(OutParmType), ALLOCATABLE, INTENT ( IN ) :: OutParam(:) - INTEGER, INTENT ( IN ) :: NMOutputs TYPE(Morison_MOutput), ALLOCATABLE, INTENT ( IN ) :: MOutLst(:) - INTEGER, INTENT ( IN ) :: NJOutputs TYPE(Morison_JOutput), ALLOCATABLE, INTENT ( IN ) :: JOutLst(:) TYPE(MeshType), INTENT ( INOUT ) :: uMesh TYPE(MeshType), INTENT ( INOUT ) :: yMesh @@ -542,43 +524,46 @@ SUBROUTINE WriteSummaryFile( UnSum, g, MSL2SWL, WtrDpth, numJoints, numNodes, no CHARACTER(*), INTENT ( OUT ) :: errMsg ! Error message if errStat /= ErrID_None INTEGER :: I, J, II - REAL(ReKi) :: l ! length of an element LOGICAL :: filledFlag ! flag indicating if element is filled/flooded - CHARACTER(2) :: strFmt - CHARACTER(ChanLen) :: strNodeType ! string indicating type of node: End, Interior, Super REAL(ReKi) :: ident(3,3) ! identity matrix REAL(ReKi) :: ExtBuoyancy(6) ! sum of all external buoyancy forces lumped at (0,0,0) REAL(ReKi) :: IntBuoyancy(6) ! sum of all internal buoyancy forces lumped at (0,0,0) REAL(ReKi) :: MG_Wt(6) ! weight of the marine growth as applied to (0,0,0) TYPE(MeshType) :: WRP_Mesh ! mesh representing the WAMIT reference point (0,0,0) TYPE(MeshType) :: WRP_Mesh_position ! mesh representing the WAMIT reference point (0,0,0) (with no displaced position) - TYPE(MeshMapType) :: M_L_2_P ! Map Morison Line2 to WRP_Mesh point TYPE(MeshMapType) :: M_P_2_P ! Map Morison Point to WRP_Mesh point - REAL(ReKi) :: elementVol ! displaced volume of an element REAL(ReKi) :: totalDisplVol ! total displaced volume of the structure REAL(ReKi) :: totalVol ! total volume of structure REAL(ReKi) :: MGvolume ! volume of the marine growth material REAL(ReKi) :: totalMGVol ! REAL(ReKi) :: totalFillVol ! - REAL(ReKi) :: elemCentroid(3) ! location of the element centroid REAL(ReKi) :: COB(3) ! center of buoyancy location in global coordinates - INTEGER :: m1, m2 ! Indices of the markers which surround the requested output location + INTEGER :: m1 ! Indices of the markers which surround the requested output location REAL(ReKi) :: s ! The linear interpolation factor for the requested location REAL(ReKi) :: outloc(3) ! Position of the requested member output real(ReKi) :: pos(3), pos2(3) ! Position of a node or joint in the MSL inertial system INTEGER :: mbrIndx, nodeIndx, c, N CHARACTER(ChanLen) :: tmpName - REAL(ReKi) :: totalFillMass, mass_fill, fillVol, memberVol - REAL(ReKi) :: totalMGMass, mass_MG + REAL(ReKi) :: totalFillMass, mass_fill, memberVol + REAL(ReKi) :: totalMGMass TYPE(Morison_NodeType) :: node1, node2 real(ReKi) :: ptLoad(6) logical :: fillFlag type(Morison_MemberType) :: mem - REAL(ReKi) :: Cd1, Cd2, Ca1, Ca2, Cp1, Cp2, AxCd1, AxCd2, AxCa1, AxCa2, AxCp1, AxCp2, JAxCd1, JAxCd2, JAxCa1, JAxCa2, JAxCp1, JAxCp2 ! tmp coefs + REAL(ReKi) :: Cd1, Cd2, Ca1, Ca2, Cp1, Cp2, AxCd1, AxCd2, AxCa1, AxCa2, AxCp1, AxCp2, Cb1, Cb2, JAxCd1, JAxCd2, JAxCa1, JAxCa2, JAxCp1, JAxCp2 ! tmp coefs real(ReKi) :: F_B(6, numNodes), F_BF(6, numNodes), F_WMG(6, numNodes) + + INTEGER :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'WriteSummaryFile' + ! Initialize data errStat = ErrID_None errMsg = "" + + IF ( UnSum <= 0 ) RETURN ! can't write to the file (no summary file requested) + + ExtBuoyancy = 0.0 totalFillMass = 0.0 totalDisplVol = 0.0 @@ -594,28 +579,23 @@ SUBROUTINE WriteSummaryFile( UnSum, g, MSL2SWL, WtrDpth, numJoints, numNodes, no ! Create identity matrix CALL EYE(ident,errStat,errMsg) - IF ( UnSum > 0 ) THEN - do j = 1, numMembers - - mem = members(j) - totalVol = totalVol + mem%Vouter - totalMGVol = totalMGVol + mem%Vouter - mem%Vinner - totalDisplVol = totalDisplVol + mem%Vsubmerged - totalFillVol = totalFillVol + mem%Vballast - - ! IF ( node2%Position(3) <= MSL2SWL .AND. node1%Position(3) >= -WtrDpth) totalDisplVol = totalDisplVol + elementVol - - - do i = 1, mem%NElements - totalMGMass = totalMGMass + mem%m_mg_l(i) - totalMGMass = totalMGMass + mem%m_mg_u(i) - end do - do i = 1, mem%NElements+1 - F_B (:,mem%NodeIndx(i)) = F_B (:,mem%NodeIndx(i)) + m%memberLoads(j)%F_B (:,i) - F_BF (:,mem%NodeIndx(i)) = F_BF (:,mem%NodeIndx(i)) + m%memberLoads(j)%F_BF (:,i) - F_WMG(:,mem%NodeIndx(i)) = F_WMG(:,mem%NodeIndx(i)) + m%memberLoads(j)%F_WMG(:,i) - end do + do j = 1, numMembers + mem = members(j) + totalVol = totalVol + mem%Vouter + totalMGVol = totalMGVol + mem%Vouter - mem%Vinner + totalDisplVol = totalDisplVol + mem%Vsubmerged + totalFillVol = totalFillVol + mem%Vballast + + do i = 1, mem%NElements + totalMGMass = totalMGMass + mem%m_mg_l(i) + totalMGMass = totalMGMass + mem%m_mg_u(i) end do + do i = 1, mem%NElements+1 + F_B (:,mem%NodeIndx(i)) = F_B (:,mem%NodeIndx(i)) + m%memberLoads(j)%F_B (:,i) + F_BF (:,mem%NodeIndx(i)) = F_BF (:,mem%NodeIndx(i)) + m%memberLoads(j)%F_BF (:,i) + F_WMG(:,mem%NodeIndx(i)) = F_WMG(:,mem%NodeIndx(i)) + m%memberLoads(j)%F_WMG(:,i) + end do + end do WRITE( UnSum, '(//)' ) @@ -634,35 +614,42 @@ SUBROUTINE WriteSummaryFile( UnSum, g, MSL2SWL, WtrDpth, numJoints, numNodes, no CALL MeshCreate( BlankMesh = WRP_Mesh & ,IOS = COMPONENT_INPUT & ,Nnodes = 1 & - ,errStat = errStat & - ,ErrMess = errMsg & + ,errStat = errStat2 & + ,ErrMess = errMsg2 & ,Force = .TRUE. & ,Moment = .TRUE. & ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ! Create the node on the mesh CALL MeshPositionNode (WRP_Mesh & , 1 & , (/0.0_ReKi, 0.0_ReKi, 0.0_ReKi/) & - , errStat & - , errMsg & + , errStat2 & + , errMsg2 & ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF ( errStat /= 0 ) RETURN + IF ( errStat >= AbortErrLev ) then + call cleanup() + RETURN + end if ! Create the mesh element CALL MeshConstructElement ( WRP_Mesh & , ELEMENT_POINT & - , errStat & - , errMsg & + , errStat2 & + , errMsg2 & , 1 & ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL MeshCommit ( WRP_Mesh & - , errStat & - , errMsg ) + , errStat2 & + , errMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF ( errStat /= ErrID_None ) RETURN ! we need the translation displacement mesh for loads transfer: CALL MeshCopy ( SrcMesh = WRP_Mesh & @@ -670,10 +657,15 @@ SUBROUTINE WriteSummaryFile( UnSum, g, MSL2SWL, WtrDpth, numJoints, numNodes, no , CtrlCode = MESH_SIBLING & , IOS = COMPONENT_INPUT & , TranslationDisp = .TRUE. & - , errStat = errStat & - , ErrMess = errMsg ) ! automatically sets DestMesh%RemapFlag = .TRUE. - - IF ( errStat /= ErrID_None ) RETURN + , errStat = errStat2 & + , ErrMess = errMsg2 ) ! automatically sets DestMesh%RemapFlag = .TRUE. + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + IF ( errStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + WRP_Mesh_position%TranslationDisp = 0.0 ! bjj: this is actually initialized in the ModMesh module, but I'll do it here anyway. WRP_Mesh%RemapFlag = .TRUE. @@ -688,7 +680,7 @@ SUBROUTINE WriteSummaryFile( UnSum, g, MSL2SWL, WtrDpth, numJoints, numNodes, no DO J = 1, yMesh%Nnodes - if ( yMesh%Position(3,J) <= MSL2SWL ) then ! need to check relative to MSL2SWL offset because the Mesh Positons are relative to MSL + if ( yMesh%Position(3,J) <= p%WaveField%MSL2SWL ) then ! need to check relative to MSL2SWL offset because the Mesh Positons are relative to MSL if (J <= numJoints) then ptLoad = F_B(:,J) + m%F_B_end(:,J) @@ -706,10 +698,14 @@ SUBROUTINE WriteSummaryFile( UnSum, g, MSL2SWL, WtrDpth, numJoints, numNodes, no ! Transfer the loads from the distributed mesh to the (0,0,0) point mesh - CALL MeshMapCreate ( yMesh, WRP_Mesh, M_P_2_P, errStat, errMsg ) - !CALL CheckError( errStat, 'Message from MeshMapCreate HD_M_L_2_ED_P: '//NewLine//errMsg ) - CALL Transfer_Point_to_Point( yMesh, WRP_Mesh, M_P_2_P, errStat, errMsg, uMesh, WRP_Mesh_position ) + CALL MeshMapCreate ( yMesh, WRP_Mesh, M_P_2_P, errStat2, errMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF ( errStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + CALL Transfer_Point_to_Point( yMesh, WRP_Mesh, M_P_2_P, errStat2, errMsg2, uMesh, WRP_Mesh_position ); call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ExtBuoyancy(1:3) = WRP_Mesh%Force (:,1) ExtBuoyancy(4:6) = WRP_Mesh%Moment(:,1) @@ -739,7 +735,7 @@ SUBROUTINE WriteSummaryFile( UnSum, g, MSL2SWL, WtrDpth, numJoints, numNodes, no END DO ! DO J IntBuoyancy = 0.0 - CALL Transfer_Point_to_Point( yMesh, WRP_Mesh, M_P_2_P, errStat, errMsg, uMesh, WRP_Mesh_position ) + CALL Transfer_Point_to_Point( yMesh, WRP_Mesh, M_P_2_P, errStat2, errMsg2, uMesh, WRP_Mesh_position ); call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IntBuoyancy(1:3) = WRP_Mesh%Force(:,1) IntBuoyancy(4:6) = WRP_Mesh%Moment(:,1) @@ -767,12 +763,10 @@ SUBROUTINE WriteSummaryFile( UnSum, g, MSL2SWL, WtrDpth, numJoints, numNodes, no END DO ! DO J MG_Wt = 0.0 - CALL Transfer_Point_to_Point( yMesh, WRP_Mesh, M_P_2_P, errStat, errMsg, uMesh, WRP_Mesh_position ) + CALL Transfer_Point_to_Point( yMesh, WRP_Mesh, M_P_2_P, errStat2, errMsg2, uMesh, WRP_Mesh_position ); call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) MG_Wt(1:3) = WRP_Mesh%Force(:,1) MG_Wt(4:6) = WRP_Mesh%Moment(:,1) ! - CALL MeshMapDestroy( M_P_2_P, errStat, errMsg ); IF ( errStat /= ErrID_None ) CALL WrScr(TRIM(errMsg)) - WRITE( UnSum, '(//)' ) WRITE( UnSum, '(A36)' ) 'Weight loads about ( 0.0, 0.0, 0.0 )' @@ -782,22 +776,20 @@ SUBROUTINE WriteSummaryFile( UnSum, g, MSL2SWL, WtrDpth, numJoints, numNodes, no WRITE( UnSum, '(A18,6(2X,ES20.6))') 'Marine Growth: ', MG_Wt(1), MG_Wt(2), MG_Wt(3), MG_Wt(4), MG_Wt(5), MG_Wt(6) - CALL MeshDestroy(WRP_Mesh, errStat, errMsg ); IF ( errStat /= ErrID_None ) CALL WrScr(TRIM(errMsg)) - CALL MeshDestroy(WRP_Mesh_position, errStat, errMsg ); IF ( errStat /= ErrID_None ) CALL WrScr(TRIM(errMsg)) ! ! ! Write the header for this section WRITE( UnSum, '(//)' ) WRITE( UnSum, '(A14,I4,A44)' ) 'Nodes (first [',numJoints,'] are joints, remainder are internal nodes)' WRITE( UnSum, '(/)' ) - WRITE( UnSum, '(1X,A5,20(2X,A10))' ) ' i ', ' MbrIndx ', ' Nxi ', ' Nyi ', ' Nzi ', ' R ', ' t ', ' tMG ', ' MGDens ', ' PropPot ', 'FilledFlag', 'FilledMass', ' Cd ', ' Ca ', ' Cp ', ' AxCd ', ' AxCa ', ' AxCp ', ' JAxCd ', ' JAxCa ', ' JAxCp ' - WRITE( UnSum, '(1X,A5,20(2X,A10))' ) ' (-) ', ' (-) ', ' (m) ', ' (m) ', ' (m) ', ' (m) ', ' (m) ', ' (m) ', ' (kg/m^3) ', ' (-) ', ' (-) ', ' (kg) ', ' (-) ', ' (-) ', ' (-) ', ' (-) ', ' (-) ', ' (-) ', ' (-) ', ' (-) ', ' (-) ' + WRITE( UnSum, '(1X,A5,21(2X,A10))' ) ' i ', ' MbrIndx ', ' Nxi ', ' Nyi ', ' Nzi ', ' R ', ' t ', ' tMG ', ' MGDens ', ' PropPot ', 'FilledFlag', 'FilledMass', ' Cd ', ' Ca ', ' Cp ', ' Cb ', ' AxCd ', ' AxCa ', ' AxCp ', ' JAxCd ', ' JAxCa ', ' JAxCp ' + WRITE( UnSum, '(1X,A5,21(2X,A10))' ) ' (-) ', ' (-) ', ' (m) ', ' (m) ', ' (m) ', ' (m) ', ' (m) ', ' (m) ', ' (kg/m^3) ', ' (-) ', ' (-) ', ' (kg) ', ' (-) ', ' (-) ', ' (-) ', ' (-) ', ' (-) ', ' (-) ', ' (-) ', ' (-) ', ' (-) ', ' (-) ' ! Write the node data do I = 1,numJoints ! need to add MSL2SWL offset from this because the Positons are relative to SWL, but we should report them relative to MSL here pos = nodes(i)%Position - pos(3) = pos(3) + MSL2SWL - write( UnSum, '(1X,I5,(2X,A10),3(2X,F10.4),2(2X,A10),2(2X,ES10.3),9(2X,A10),3(2X,ES10.3))' ) i,' - ', pos, ' - ', ' - ', nodes(i)%tMG, nodes(i)%MGdensity, ' - ', ' - ', ' - ', ' - ', ' - ', ' - ', ' - ', ' - ', ' - ', nodes(i)%JAxCd, nodes(i)%JAxCa, nodes(i)%JAxCp + pos(3) = pos(3) + p%WaveField%MSL2SWL + write( UnSum, '(1X,I5,(2X,A10),3(2X,F10.4),2(2X,A10),2(2X,ES10.3),10(2X,A10),3(2X,ES10.3))' ) i,' - ', pos, ' - ', ' - ', nodes(i)%tMG, nodes(i)%MGdensity, ' - ', ' - ', ' - ', ' - ', ' - ', ' - ', ' - ', ' - ', ' - ', ' - ', nodes(i)%JAxCd, nodes(i)%JAxCa, nodes(i)%JAxCp end do c = numJoints do j= 1, numMembers @@ -810,13 +802,13 @@ SUBROUTINE WriteSummaryFile( UnSum, g, MSL2SWL, WtrDpth, numJoints, numNodes, no end if ! need to add MSL2SWL offset from this because the Positons are relative to SWL, but we should report them relative to MSL here pos = nodes(c)%Position - pos(3) = pos(3) + MSL2SWL + pos(3) = pos(3) + p%WaveField%MSL2SWL if (members(j)%flipped) then II=members(j)%NElements+2-I else II=I endif - write( UnSum, '(1X,I5,(2X,I10),3(2X,F10.4),4(2X,ES10.3),2(6X,L6),7(2X,ES10.3),3(7x,A5))' ) c, members(j)%MemberID, pos, members(j)%R(ii), members(j)%R(ii)-members(j)%Rin(ii), members(j)%tMG(ii), members(j)%MGdensity(ii), members(j)%PropPot, fillFlag, members(j)%m_fb_u(ii)+members(j)%m_fb_l(ii), members(j)%Cd(ii), members(j)%Ca(ii), members(j)%Cp(ii), members(j)%AxCd(ii), members(j)%AxCa(ii), members(j)%AxCp(ii), ' - ', ' - ', ' - ' + write( UnSum, '(1X,I5,(2X,I10),3(2X,F10.4),4(2X,ES10.3),2(6X,L6),8(2X,ES10.3),3(7x,A5))' ) c, members(j)%MemberID, pos, members(j)%R(ii), members(j)%R(ii)-members(j)%Rin(ii), members(j)%tMG(ii), members(j)%MGdensity(ii), members(j)%PropPot, fillFlag, members(j)%m_fb_u(ii)+members(j)%m_fb_l(ii), members(j)%Cd(ii), members(j)%Ca(ii), members(j)%Cp(ii), members(j)%Cb(ii), members(j)%AxCd(ii), members(j)%AxCa(ii), members(j)%AxCp(ii), ' - ', ' - ', ' - ' end do end do @@ -824,8 +816,8 @@ SUBROUTINE WriteSummaryFile( UnSum, g, MSL2SWL, WtrDpth, numJoints, numNodes, no write( UnSum, '(//)' ) write( UnSum, '(A8)' ) 'Members' write( UnSum, '(/)' ) - write( UnSum, '(1X,A8,2X,A6,2X,A6,31(2X,A12))' ) 'MemberID', 'joint1','joint2',' Length ', ' NElem ', ' Volume ', ' MGVolume ', ' R1 ', ' t1 ', ' R2 ', ' t2 ', ' PropPot ', 'FilledFlag', 'FillDensity', ' FillFSLoc ', ' FillMass ', ' Cd1 ', ' Ca1 ', ' Cp1 ', ' AxCd1 ', ' AxCa1 ', ' AxCp1 ', ' JAxCd1 ', ' JAxCa1 ', ' JAxCp1 ', ' Cd2 ', ' Ca2 ', ' Cp2 ', ' AxCd2 ', ' AxCa2 ', ' AxCp2 ', ' JAxCd2 ', ' JAxCa2 ', ' JAxCp2 ' - write( UnSum, '(1X,A8,2X,A6,2X,A6,31(2X,A12))' ) ' (-) ', ' (-) ',' (-) ',' (m) ', ' (-) ', ' (m^3) ', ' (m^3) ', ' (m) ', ' (m) ', ' (m) ', ' (m) ', ' (-) ', ' (-) ', ' (kg/m^3) ', ' (-) ', ' (kg) ', ' (-) ', ' (-) ', ' (-) ', ' (-) ', ' (-) ', ' (-) ', ' (-) ', ' (-) ', ' (-) ', ' (-) ', ' (-) ', ' (-) ', ' (-) ', ' (-) ', ' (-) ', ' (-) ', ' (-) ', ' (-) ' + write( UnSum, '(1X,A8,2X,A6,2X,A6,33(2X,A12))' ) 'MemberID', 'joint1','joint2',' Length ', ' NElem ', ' Volume ', ' MGVolume ', ' R1 ', ' t1 ', ' R2 ', ' t2 ', ' PropPot ', 'FilledFlag', 'FillDensity', ' FillFSLoc ', ' FillMass ', ' Cd1 ', ' Ca1 ', ' Cp1 ', ' Cb1 ', ' AxCd1 ', ' AxCa1 ', ' AxCp1 ', ' JAxCd1 ', ' JAxCa1 ', ' JAxCp1 ', ' Cd2 ', ' Ca2 ', ' Cp2 ', ' Cb2 ', ' AxCd2 ', ' AxCa2 ', ' AxCp2 ', ' JAxCd2 ', ' JAxCa2 ', ' JAxCp2 ' + write( UnSum, '(1X,A8,2X,A6,2X,A6,33(2X,A12))' ) ' (-) ', ' (-) ',' (-) ',' (m) ', ' (-) ', ' (m^3) ', ' (m^3) ', ' (m) ', ' (m) ', ' (m) ', ' (m) ', ' (-) ', ' (-) ', ' (kg/m^3) ', ' (-) ', ' (kg) ', ' (-) ', ' (-) ', ' (-) ', ' (-) ', ' (-) ', ' (-) ', ' (-) ', ' (-) ', ' (-) ', ' (-) ', ' (-) ', ' (-) ', ' (-) ', ' (-) ', ' (-) ', ' (-) ', ' (-) ', ' (-) ', ' (-) ', ' (-) ' @@ -861,6 +853,8 @@ SUBROUTINE WriteSummaryFile( UnSum, g, MSL2SWL, WtrDpth, numJoints, numNodes, no AxCa2 = members(i)%AxCa(N+1) AxCp1 = members(i)%AxCp(1) AxCp2 = members(i)%AxCp(N+1) + Cb1 = members(i)%Cb(1) + Cb2 = members(i)%Cb(N+1) JAxCd1 = nodes(members(i)%NodeIndx(1 ))%JAxCd JAxCd2 = nodes(members(i)%NodeIndx(1+N))%JAxCd @@ -870,13 +864,13 @@ SUBROUTINE WriteSummaryFile( UnSum, g, MSL2SWL, WtrDpth, numJoints, numNodes, no JAxCp2 = nodes(members(i)%NodeIndx(1+N))%JAxCp - write( UnSum, '(1X,I8,2X,I6,2X,I6,2X,ES12.5,2X,I12, 6(2X,ES12.5),2(2X,L12),21(2X,ES12.5))' ) members(i)%MemberID, & + write( UnSum, '(1X,I8,2X,I6,2X,I6,2X,ES12.5,2X,I12, 6(2X,ES12.5),2(2X,L12),23(2X,ES12.5))' ) members(i)%MemberID, & members(i)%NodeIndx(1), members(i)%NodeIndx(N+1), members(i)%RefLength, N, & memberVol, MGvolume, members(i)%Rmg(1), members(i)%Rmg(1)-members(i)%Rin(1), & members(i)%Rmg(N+1), members(i)%Rmg(N+1)-members(i)%Rin(N+1), & members(i)%PropPot, filledFlag, members(i)%FillDens, members(i)%FillFSLoc, & - mass_fill, Cd1, Ca1, Cp1, AxCd1, AxCa1, AxCp1, JAxCd1, JAxCa1, JAxCp1, & - Cd2, Ca2, Cp2, AxCd2, AxCa2, AxCp2, JAxCd2, JAxCa2, JAxCp2 + mass_fill, Cd1, Ca1, Cp1, Cb1, AxCd1, AxCa1, AxCp1, JAxCd1, JAxCa1, JAxCp1, & + Cd2, Ca2, Cp2, Cb2, AxCd2, AxCa2, AxCp2, JAxCd2, JAxCa2, JAxCp2 end do ! i = 1,numMembers @@ -908,9 +902,9 @@ SUBROUTINE WriteSummaryFile( UnSum, g, MSL2SWL, WtrDpth, numJoints, numNodes, no node2 = nodes(mem%NodeIndx(mem%NElements+1)) ! need to add MSL2SWL offset from this because the Positons are relative to SWL, but we should report them relative to MSL here pos = node1%Position - pos(3) = pos(3) + MSL2SWL + pos(3) = pos(3) + p%WaveField%MSL2SWL pos2 = node2%Position - pos2(3) = pos2(3) + MSL2SWL + pos2(3) = pos2(3) + p%WaveField%MSL2SWL outLoc = pos*(1-s) + pos2*s WRITE( UnSum, '(1X,A10,3(2x,F10.4),2x,I10,7(2x,F10.4))' ) OutParam(I)%Name, outLoc, MOutLst(mbrIndx)%MemberID, pos,pos2, s END IF @@ -936,7 +930,7 @@ SUBROUTINE WriteSummaryFile( UnSum, g, MSL2SWL, WtrDpth, numJoints, numNodes, no m1 = JOutLst(nodeIndx)%JointIDIndx ! need to add MSL2SWL offset from this because the Positons are relative to SWL, but we should report them relative to MSL here pos = nodes(m1)%Position - pos(3) = pos(3) + MSL2SWL + pos(3) = pos(3) + p%WaveField%MSL2SWL WRITE( UnSum, '(1X,A10,3(2x,F10.4),2x,I10)' ) OutParam(I)%Name, pos, JOutLst(nodeIndx)%JointID END IF @@ -945,13 +939,22 @@ SUBROUTINE WriteSummaryFile( UnSum, g, MSL2SWL, WtrDpth, numJoints, numNodes, no END DO - END IF - + call cleanup() + +contains +!................................... + subroutine cleanup() + call MeshDestroy(WRP_Mesh, ErrStat2, ErrMsg2) + call MeshDestroy(WRP_Mesh_position, ErrStat2, ErrMsg2) + call MeshMapDestroy(M_P_2_P, ErrStat2, ErrMsg2) + + call Morison_DestroyNodeType(node1, ErrStat2, ErrMsg2) + call Morison_DestroyNodeType(node2, ErrStat2, ErrMsg2) + call Morison_DestroyMemberType(mem, ErrStat2, ErrMsg2) + end subroutine cleanup END SUBROUTINE WriteSummaryFile - - - +!---------------------------------------------------------------------------------------------------------------------------------- subroutine Morison_GenerateSimulationNodes( MSL2SWL, numJoints, inpJoints, numMembers, inpMembers, numNodes, nodes, errStat, errMsg ) ! This subdivides a Morison member according to its maximum desired ! element length (MDivSize), allocating the member's arrays, and @@ -989,7 +992,7 @@ subroutine Morison_GenerateSimulationNodes( MSL2SWL, numJoints, inpJoints, numMe j1 = inpMembers(I)%MJointID1Indx j2 = inpMembers(I)%MJointID2Indx call GetDistance(inpJoints(j1)%Position, inpJoints(j2)%Position, memLength) - if ( EqualRealNos(memLength, 0.0_ReKi) )then + if ( EqualRealNos(memLength, 0.0_ReKi) ) then errMsg = ' Input file member with ID: '//trim(num2lstr(inpMembers(i)%MemberID))//' must have length greater than zero.' errStat = ErrID_Fatal return @@ -1004,8 +1007,8 @@ subroutine Morison_GenerateSimulationNodes( MSL2SWL, numJoints, inpJoints, numMe end do ! Allocate nodes array - allocate ( nodes(maxNodes), STAT = errStat ) - if ( errStat /= 0 ) then + allocate ( nodes(maxNodes), STAT = errStat2 ) + if ( errStat2 /= 0 ) then errMsg = ' Error allocating space for Nodes array for Morison Module.' errStat = ErrID_Fatal return @@ -1047,7 +1050,7 @@ end subroutine Morison_GenerateSimulationNodes !==================================================================================================== -SUBROUTINE SetDepthBasedCoefs( z, tMG, NCoefDpth, CoefDpths, Cd, Ca, Cp, AxCd, AxCa, AxCp ) +SUBROUTINE SetDepthBasedCoefs( z, tMG, NCoefDpth, CoefDpths, Cd, Ca, Cp, AxCd, AxCa, AxCp, Cb ) REAL(ReKi), INTENT (IN ) :: z ! Z location relative to MSL inertial system REAL(ReKi), INTENT (IN ) :: tMG @@ -1059,6 +1062,7 @@ SUBROUTINE SetDepthBasedCoefs( z, tMG, NCoefDpth, CoefDpths, Cd, Ca, Cp, AxCd, A REAL(ReKi), INTENT ( OUT) :: AxCd REAL(ReKi), INTENT ( OUT) :: AxCa REAL(ReKi), INTENT ( OUT) :: AxCp + REAL(ReKi), INTENT ( OUT) :: Cb INTEGER :: I, indx1, indx2 REAL(ReKi) :: dd, s @@ -1102,13 +1106,15 @@ SUBROUTINE SetDepthBasedCoefs( z, tMG, NCoefDpth, CoefDpths, Cd, Ca, Cp, AxCd, A AxCd = CoefDpths(indx1)%DpthAxCdMG*(1-s) + CoefDpths(indx2)%DpthAxCdMG*s AxCa = CoefDpths(indx1)%DpthAxCaMG*(1-s) + CoefDpths(indx2)%DpthAxCaMG*s AxCp = CoefDpths(indx1)%DpthAxCpMG*(1-s) + CoefDpths(indx2)%DpthAxCpMG*s + Cb = CoefDpths(indx1)%DpthCbMG*(1-s) + CoefDpths(indx2)%DpthCbMG*s else Cd = CoefDpths(indx1)%DpthCd*(1-s) + CoefDpths(indx2)%DpthCd*s Ca = CoefDpths(indx1)%DpthCa*(1-s) + CoefDpths(indx2)%DpthCa*s Cp = CoefDpths(indx1)%DpthCp*(1-s) + CoefDpths(indx2)%DpthCp*s - AxCd = CoefDpths(indx1)%DpthCd*(1-s) + CoefDpths(indx2)%DpthAxCd*s - AxCa = CoefDpths(indx1)%DpthCa*(1-s) + CoefDpths(indx2)%DpthAxCa*s - AxCp = CoefDpths(indx1)%DpthCp*(1-s) + CoefDpths(indx2)%DpthAxCp*s + AxCd = CoefDpths(indx1)%DpthAxCd*(1-s) + CoefDpths(indx2)%DpthAxCd*s + AxCa = CoefDpths(indx1)%DpthAxCa*(1-s) + CoefDpths(indx2)%DpthAxCa*s + AxCp = CoefDpths(indx1)%DpthAxCp*(1-s) + CoefDpths(indx2)%DpthAxCp*s + Cb = CoefDpths(indx1)%DpthCb*(1-s) + CoefDpths(indx2)%DpthCb*s end if @@ -1117,11 +1123,10 @@ END SUBROUTINE SetDepthBasedCoefs !==================================================================================================== -!SUBROUTINE SetExternalHydroCoefs SUBROUTINE SetExternalHydroCoefs( MSL2SWL, MCoefMod, MmbrCoefIDIndx, SimplCd, SimplCdMG, SimplCa, SimplCaMG, SimplCp, & - SimplCpMG, SimplAxCd, SimplAxCdMG, SimplAxCa, SimplAxCaMG, SimplAxCp, SimplAxCpMG, CoefMembers, & - NCoefDpth, CoefDpths, numNodes, nodes, member ) -! This private subroutine generates the Cd, Ca, Cp, CdMG, CaMG and CpMG coefs for the member based on + SimplCpMG, SimplAxCd, SimplAxCdMG, SimplAxCa, SimplAxCaMG, SimplAxCp, SimplAxCpMG, SimplCb, SimplCbMG, SimplMCF, CoefMembers, & + NCoefDpth, CoefDpths, nodes, member ) +! This private subroutine generates the Cd, Ca, Cp, Cb, CdMG, CaMG, CpMG, and CbMG coefs for the member based on ! the input data. !---------------------------------------------------------------------------------------------------- real(ReKi), intent(in ) :: MSL2SWL @@ -1139,16 +1144,17 @@ SUBROUTINE SetExternalHydroCoefs( MSL2SWL, MCoefMod, MmbrCoefIDIndx, SimplCd, S real(ReKi), intent(in ) :: SimplAxCaMG real(ReKi), intent(in ) :: SimplAxCp real(ReKi), intent(in ) :: SimplAxCpMG + real(ReKi), intent(in ) :: SimplCb + real(ReKi), intent(in ) :: SimplCbMG + logical, intent(in ) :: SimplMCF type(Morison_CoefMembers), allocatable, intent(in ) :: CoefMembers(:) integer(IntKi), intent(in ) :: NCoefDpth type(Morison_CoefDpths), allocatable, intent(in ) :: CoefDpths(:) - integer(IntKi), intent(in ) :: numNodes type(Morison_NodeType), allocatable, intent(in ) :: nodes(:) type(Morison_MemberType), intent(inout) :: member - type(Morison_NodeType) :: node, node1, node2 - integer(IntKi) :: i, j - real(ReKi) :: s, Cd, CdMG, Ca, CaMG, Cp, CpMG, AxCa, AxCp, AxCaMG, AxCpMG + integer(IntKi) :: i + real(ReKi) :: s select case ( MCoefMod ) @@ -1160,7 +1166,8 @@ SUBROUTINE SetExternalHydroCoefs( MSL2SWL, MCoefMod, MmbrCoefIDIndx, SimplCd, S member%Cp (i) = SimplCpMG member%AxCd (i) = SimplAxCdMG member%AxCa (i) = SimplAxCaMG - member%AxCp (i) = SimplAxCpMG + member%AxCp (i) = SimplAxCpMG + member%Cb (i) = SimplCbMG else member%Cd (i) = SimplCd member%Ca (i) = SimplCa @@ -1168,40 +1175,44 @@ SUBROUTINE SetExternalHydroCoefs( MSL2SWL, MCoefMod, MmbrCoefIDIndx, SimplCd, S member%AxCd (i) = SimplAxCd member%AxCa (i) = SimplAxCa member%AxCp (i) = SimplAxCp + member%Cb (i) = SimplCb end if end do - + member%PropMCF = SimplMCF CASE (2) ! Depth-based model: coefficients are set using depth-based table data do i = 1, member%NElements + 1 CALL SetDepthBasedCoefs( nodes(member%NodeIndx(i))%Position(3)+MSL2SWL, member%tMG(i), NCoefDpth, CoefDpths, member%Cd(i), member%Ca(i), & - member%Cp(i), member%AxCd(i), member%AxCa(i), member%AxCp(i) ) + member%Cp(i), member%AxCd(i), member%AxCa(i), member%AxCp(i), member%Cb(i) ) end do - + member%PropMCF = CoefDpths(1)%DpthMCF CASE (3) ! Member-based model: coefficients set using member-specific coefficient tables do i = 1, member%NElements + 1 ! Pull member end-node data from the tables and then linearly interpolate it onto the interior member nodes s = (real(i,ReKi)-1.0) / real(member%NElements,ReKi) if ( member%tMG(i) > 0.0_ReKi ) then - member%Cd (i) = CoefMembers(MmbrCoefIDIndx)%MemberCdMG1*(1-s) + CoefMembers(MmbrCoefIDIndx)%MemberCdMG2*s - member%Ca (i) = CoefMembers(MmbrCoefIDIndx)%MemberCaMG1*(1-s) + CoefMembers(MmbrCoefIDIndx)%MemberCaMG2*s - member%Cp (i) = CoefMembers(MmbrCoefIDIndx)%MemberCpMG1*(1-s) + CoefMembers(MmbrCoefIDIndx)%MemberCpMG2*s + member%Cd (i) = CoefMembers(MmbrCoefIDIndx)%MemberCdMG1 *(1-s) + CoefMembers(MmbrCoefIDIndx)%MemberCdMG2 *s + member%Ca (i) = CoefMembers(MmbrCoefIDIndx)%MemberCaMG1 *(1-s) + CoefMembers(MmbrCoefIDIndx)%MemberCaMG2 *s + member%Cp (i) = CoefMembers(MmbrCoefIDIndx)%MemberCpMG1 *(1-s) + CoefMembers(MmbrCoefIDIndx)%MemberCpMG2 *s + member%Cb (i) = CoefMembers(MmbrCoefIDIndx)%MemberCbMG1 *(1-s) + CoefMembers(MmbrCoefIDIndx)%MemberCbMG2 *s member%AxCd (i) = CoefMembers(MmbrCoefIDIndx)%MemberAxCaMG1*(1-s) + CoefMembers(MmbrCoefIDIndx)%MemberAxCdMG2*s member%AxCa (i) = CoefMembers(MmbrCoefIDIndx)%MemberAxCaMG1*(1-s) + CoefMembers(MmbrCoefIDIndx)%MemberAxCaMG2*s member%AxCp (i) = CoefMembers(MmbrCoefIDIndx)%MemberAxCpMG1*(1-s) + CoefMembers(MmbrCoefIDIndx)%MemberAxCpMG2*s else - member%Cd (i) = CoefMembers(MmbrCoefIDIndx)%MemberCd1 *(1-s) + CoefMembers(MmbrCoefIDIndx)%MemberCd2 *s - member%Ca (i) = CoefMembers(MmbrCoefIDIndx)%MemberCa1 *(1-s) + CoefMembers(MmbrCoefIDIndx)%MemberCa2 *s - member%Cp (i) = CoefMembers(MmbrCoefIDIndx)%MemberCp1 *(1-s) + CoefMembers(MmbrCoefIDIndx)%MemberCp2 *s + member%Cd (i) = CoefMembers(MmbrCoefIDIndx)%MemberCd1 *(1-s) + CoefMembers(MmbrCoefIDIndx)%MemberCd2 *s + member%Ca (i) = CoefMembers(MmbrCoefIDIndx)%MemberCa1 *(1-s) + CoefMembers(MmbrCoefIDIndx)%MemberCa2 *s + member%Cp (i) = CoefMembers(MmbrCoefIDIndx)%MemberCp1 *(1-s) + CoefMembers(MmbrCoefIDIndx)%MemberCp2 *s + member%Cb (i) = CoefMembers(MmbrCoefIDIndx)%MemberCb1 *(1-s) + CoefMembers(MmbrCoefIDIndx)%MemberCb2 *s member%AxCd (i) = CoefMembers(MmbrCoefIDIndx)%MemberAxCd1 *(1-s) + CoefMembers(MmbrCoefIDIndx)%MemberAxCd2 *s member%AxCa (i) = CoefMembers(MmbrCoefIDIndx)%MemberAxCa1 *(1-s) + CoefMembers(MmbrCoefIDIndx)%MemberAxCa2 *s member%AxCp (i) = CoefMembers(MmbrCoefIDIndx)%MemberAxCp1 *(1-s) + CoefMembers(MmbrCoefIDIndx)%MemberAxCp2 *s end if end do + member%propMCF = CoefMembers(MmbrCoefIDIndx)%MemberMCF end select end subroutine SetExternalHydroCoefs - +!---------------------------------------------------------------------------------------------------------------------------------- SUBROUTINE SetNodeMG( numMGDepths, MGDepths, node, MSL2SWL, tMG, MGdensity ) ! sets the margine growth thickness of a single node (previously all nodes) INTEGER, INTENT( IN ) :: numMGDepths @@ -1211,7 +1222,7 @@ SUBROUTINE SetNodeMG( numMGDepths, MGDepths, node, MSL2SWL, tMG, MGdensity ) real(ReKi), intent( inout ) :: tMG real(ReKi), intent( inout ) :: MGdensity - INTEGER :: I, J + INTEGER :: J REAL(ReKi) :: z INTEGER :: indx1, indx2 REAL(ReKi) :: dd, s @@ -1258,8 +1269,7 @@ SUBROUTINE SetNodeMG( numMGDepths, MGDepths, node, MSL2SWL, tMG, MGdensity ) END SUBROUTINE SetNodeMG - - +!---------------------------------------------------------------------------------------------------------------------------------- subroutine AllocateMemberDataArrays( member, memberLoads, errStat, errMsg ) type(Morison_MemberType), intent (inout) :: member type(Morison_MemberLoads), intent (inout) :: memberLoads @@ -1274,6 +1284,7 @@ subroutine AllocateMemberDataArrays( member, memberLoads, errStat, errMsg ) errMSg = '' call AllocAry(member%NodeIndx , member%NElements+1, 'member%NodeIndx' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) call AllocAry(member%dRdl_mg , member%NElements, 'member%dRdl_mg' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) + call AllocAry(member%dRdl_mg_b , member%NElements, 'member%dRdl_mg_b' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) call AllocAry(member%dRdl_in , member%NElements, 'member%dRdl_in' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) call AllocAry(member%floodstatus , member%NElements, 'member%floodstatus' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) call AllocAry(member%alpha , member%NElements, 'member%alpha' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) @@ -1300,6 +1311,7 @@ subroutine AllocateMemberDataArrays( member, memberLoads, errStat, errMsg ) call AllocAry(member%CM0_fb , member%NElements, 'member%CM0_fb ', errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) call AllocAry(member%R , member%NElements+1, 'member%R ', errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) call AllocAry(member%RMG , member%NElements+1, 'member%RMG ', errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) + call AllocAry(member%RMGB , member%NElements+1, 'member%RMGB ', errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) call AllocAry(member%Rin , member%NElements+1, 'member%Rin ', errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) call AllocAry(member%tMG , member%NElements+1, 'member%tMG ', errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) call AllocAry(member%MGdensity , member%NElements+1, 'member%MGdensity ', errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) @@ -1309,6 +1321,7 @@ subroutine AllocateMemberDataArrays( member, memberLoads, errStat, errMsg ) call AllocAry(member%AxCd , member%NElements+1, 'member%AxCd ', errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) call AllocAry(member%AxCa , member%NElements+1, 'member%AxCa ', errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) call AllocAry(member%AxCp , member%NElements+1, 'member%AxCp ', errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) + call AllocAry(member%Cb , member%NElements+1, 'member%Cb ', errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) call AllocAry( memberLoads%F_D , 6, member%NElements+1, 'memberLoads%F_D' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) call AllocAry( memberLoads%F_A , 6, member%NElements+1, 'memberLoads%F_A' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) call AllocAry( memberLoads%F_B , 6, member%NElements+1, 'memberLoads%F_B' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) @@ -1317,10 +1330,13 @@ subroutine AllocateMemberDataArrays( member, memberLoads, errStat, errMsg ) call AllocAry( memberLoads%F_If , 6, member%NElements+1, 'memberLoads%F_If' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) call AllocAry( memberLoads%F_WMG , 6, member%NElements+1, 'memberLoads%F_WMG' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) call AllocAry( memberLoads%F_IMG , 6, member%NElements+1, 'memberLoads%F_IMG' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) + + if (ErrStat >= AbortErrLev) return ! Initialize everything to zero member%NodeIndx = 0.0_ReKi member%dRdl_mg = 0.0_ReKi + member%dRdl_mg_b = 0.0_ReKi member%dRdl_in = 0.0_ReKi member%floodstatus = 0.0_ReKi member%alpha = 0.0_ReKi @@ -1347,6 +1363,7 @@ subroutine AllocateMemberDataArrays( member, memberLoads, errStat, errMsg ) member%CM0_fb = 0.0_ReKi member%R = 0.0_ReKi member%RMG = 0.0_ReKi + member%RMGB = 0.0_ReKi member%Rin = 0.0_ReKi member%tMG = 0.0_ReKi member%MGdensity = 0.0_ReKi @@ -1356,6 +1373,7 @@ subroutine AllocateMemberDataArrays( member, memberLoads, errStat, errMsg ) member%AxCd = 0.0_ReKi member%AxCa = 0.0_ReKi member%AxCp = 0.0_ReKi + member%Cb = 0.0_ReKi memberLoads%F_D = 0.0_ReKi memberLoads%F_A = 0.0_ReKi memberLoads%F_B = 0.0_ReKi @@ -1366,18 +1384,14 @@ subroutine AllocateMemberDataArrays( member, memberLoads, errStat, errMsg ) memberLoads%F_IMG = 0.0_ReKi end subroutine AllocateMemberDataArrays - -subroutine FlipMemberNodeData( member, nodes, doSwap, errStat, errMsg ) +!---------------------------------------------------------------------------------------------------------------------------------- +subroutine FlipMemberNodeData( member, nodes, doSwap) type(Morison_MemberType), intent (inout) :: member type(Morison_NodeType), intent (in ) :: nodes(:) logical, intent ( out) :: doSwap - integer(IntKi), intent ( out) :: errStat ! returns a non-zero value when an error occurs - character(*), intent ( out) :: errMsg ! Error message if errStat /= ErrID_None integer(IntKi) :: i, j1, j2, numMemNodes, indx - errStat = ErrID_None - errMSg = '' doSwap = .FALSE. numMemNodes = member%NElements + 1 @@ -1411,9 +1425,8 @@ subroutine FlipMemberNodeData( member, nodes, doSwap, errStat, errMsg ) end if end subroutine FlipMemberNodeData - -subroutine SetMemberProperties( MSL2SWL, gravity, member, MCoefMod, MmbrCoefIDIndx, MmbrFilledIDIndx, propSet1, propSet2, InitInp, errStat, errMsg ) - real(ReKi), intent (in ) :: MSL2SWL +!---------------------------------------------------------------------------------------------------------------------------------- +subroutine SetMemberProperties( gravity, member, MCoefMod, MmbrCoefIDIndx, MmbrFilledIDIndx, propSet1, propSet2, InitInp, errStat, errMsg ) real(ReKi), intent (in ) :: gravity type(Morison_MemberType), intent (inout) :: member integer(IntKi), intent (in ) :: MCoefMod @@ -1426,9 +1439,8 @@ subroutine SetMemberProperties( MSL2SWL, gravity, member, MCoefMod, MmbrCoefIDIn character(*), intent ( out) :: errMsg ! Error message if errStat /= ErrID_None integer(IntKi) :: N, i - real(ReKi) :: WtrDepth,s, dl - type(Morison_NodeType) :: node1, node2 - real(ReKi) :: vec(3), vecLen + real(ReKi) :: s, dl + real(ReKi) :: vec(3) real(ReKi) :: memLength real(ReKi) :: Za real(ReKi) :: Zb @@ -1447,7 +1459,6 @@ subroutine SetMemberProperties( MSL2SWL, gravity, member, MCoefMod, MmbrCoefIDIn errStat = ErrID_None errMSg = '' - WtrDepth = InitInp%WtrDpth N = member%NElements dl = member%dl @@ -1462,7 +1473,7 @@ subroutine SetMemberProperties( MSL2SWL, gravity, member, MCoefMod, MmbrCoefIDIn member%kkt = matmul(transpose(tk),tk) call Eye(Imat,errStat,errMsg) member%Ak = Imat - member%kkt - phi = acos(vec(3)/memLength) ! incline angle + phi = acos( max(-1.0_ReKi, min(1.0_ReKi, vec(3)/memLength) ) ) ! incline angle sinPhi = sin(phi) cosPhi = cos(phi) member%cosPhi_ref = cosPhi @@ -1470,7 +1481,7 @@ subroutine SetMemberProperties( MSL2SWL, gravity, member, MCoefMod, MmbrCoefIDIn ! These are all per node and not done here, yet do i = 1, member%NElements+1 - call SetNodeMG( InitInp%NMGDepths, InitInp%MGDepths, InitInp%Nodes(member%NodeIndx(i)), InitInp%MSL2SWL, member%tMG(i), member%MGDensity(i) ) + call SetNodeMG( InitInp%NMGDepths, InitInp%MGDepths, InitInp%Nodes(member%NodeIndx(i)), InitInp%WaveField%MSL2SWL, member%tMG(i), member%MGDensity(i) ) end do member%R( 1) = propSet1%PropD / 2.0 @@ -1486,19 +1497,52 @@ subroutine SetMemberProperties( MSL2SWL, gravity, member, MCoefMod, MmbrCoefIDIn member%RMG(i) = member%R(i) + member%tMG(i) end do - call SetExternalHydroCoefs( MSL2SWL, MCoefMod, MmbrCoefIDIndx, InitInp%SimplCd, InitInp%SimplCdMG, InitInp%SimplCa, InitInp%SimplCaMG, InitInp%SimplCp, & - InitInp%SimplCpMG, InitInp%SimplAxCd, InitInp%SimplAxCdMG, InitInp%SimplAxCa, InitInp%SimplAxCaMG, InitInp%SimplAxCp, InitInp%SimplAxCpMG, InitInp%CoefMembers, & - InitInp%NCoefDpth, InitInp%CoefDpths, InitInp%NNodes, InitInp%Nodes, member ) + call SetExternalHydroCoefs( InitInp%WaveField%MSL2SWL, MCoefMod, MmbrCoefIDIndx, InitInp%SimplCd, InitInp%SimplCdMG, InitInp%SimplCa, InitInp%SimplCaMG, InitInp%SimplCp, & + InitInp%SimplCpMG, InitInp%SimplAxCd, InitInp%SimplAxCdMG, InitInp%SimplAxCa, InitInp%SimplAxCaMG, InitInp%SimplAxCp, InitInp%SimplAxCpMG, & + InitInp%SimplCb, InitInp%SimplCbMG, InitInp%SimplMCF, & + InitInp%CoefMembers, InitInp%NCoefDpth, InitInp%CoefDpths, InitInp%Nodes, member ) + ! calculate member radius with marine growth scaled by sqrt(Cb) for buoyancy/hydrostatic load calculation + do i = 1, member%NElements+1 + member%RMGB(i) = member%RMG(i) * SQRT(member%Cb(i)) + end do + ! calculate reference incline angle and heading, and related trig values. Note: members are straight to start Za = InitInp%Nodes(member%NodeIndx(1 ))%Position(3) Zb = InitInp%Nodes(member%NodeIndx(N+1))%Position(3) + ! Check if members with the MacCamy-Fuchs diffraction model and not modeled by potential flow satisfy the necessary criteria. + IF ( member%PropMCF .AND. ( .NOT. member%PropPot )) THEN + ! Check if surface piercing + IF ( Za*Zb > 0 ) THEN ! Two end joints of the member on the same side of the SWL + CALL SetErrStat(ErrID_Fatal, 'MacCamy-Fuchs members must be surface piercing. This is not true for Member ID '//trim(num2lstr(member%MemberID)), errStat, errMsg, 'SetMemberProperties' ) + RETURN + END IF + ! Check inclination + If ( ABS(phi) .GE. 0.174533 ) THEN ! If inclination from vertical is greater than 10 deg + CALL SetErrStat(ErrID_Fatal, 'MacCamy-Fuchs members must be within 10 degrees from vertical. This is not true for Member ID '//trim(num2lstr(member%MemberID)), errStat, errMsg, 'SetMemberProperties' ) + RETURN + END IF + ! Check radius + DO i = 1, member%NElements+1 + IF ( (member%RMG(i) .GT. 1.1_ReKi*REAL(0.5_SiKi*InitInp%WaveField%MCFD)) .OR. (member%RMG(i) .LT. 0.9_ReKi*REAL(0.5_SiKi*InitInp%WaveField%MCFD)) ) THEN + ! Error because MacCamy-Fuchs members must have a diameter within +/-10% of MCFD specified in seastate. + CALL SetErrStat(ErrID_Fatal, 'MacCamy-Fuchs members must have a diameter within +/-10% of MCFD specified in the SeaState input file. This is not true for Member ID '//trim(num2lstr(member%MemberID)), errStat, errMsg, 'SetMemberProperties' ) + RETURN + END IF + END DO + ! Check draft-to-radius ratio + IF ( (-InitInp%Nodes(member%NodeIndx(1))%Position(3)) < 0.5_SiKi*InitInp%WaveField%MCFD ) THEN + CALL SetErrStat(ErrID_Fatal, 'Initial draft of MacCamy-Fuchs members should be at least as large as their radius. This is not true for Member ID '//trim(num2lstr(member%MemberID)), errStat, errMsg, 'SetMemberProperties' ) + RETURN + END IF + END IF + ! find fill location of member (previously in SetElementFillProps) member%MmbrFilledIDIndx = MmbrFilledIDIndx ! Set this to the parameter version of this member data if ( MmbrFilledIDIndx > 0 ) then member%FillDens = InitInp%FilledGroups(MmbrFilledIDIndx)%FillDens - member%FillFSLoc = InitInp%FilledGroups(MmbrFilledIDIndx)%FillFSLoc - InitInp%MSL2SWL + member%FillFSLoc = InitInp%FilledGroups(MmbrFilledIDIndx)%FillFSLoc - InitInp%WaveField%MSL2SWL if (member%FillFSLoc >= Zb) then member%z_overfill = member%FillFSLoc - Zb member%l_fill = member%RefLength @@ -1510,7 +1554,7 @@ subroutine SetMemberProperties( MSL2SWL, gravity, member, MCoefMod, MmbrCoefIDIn member%l_fill = 0.0_ReKi else member%z_overfill =0 - if ( Zb <= -InitInp%WtrDpth ) then + if ( Zb <= -InitInp%WaveField%EffWtrDpth ) then member%memfloodstatus = 0 ! member fully buried in seabed member%l_fill = 0 else @@ -1530,14 +1574,15 @@ subroutine SetMemberProperties( MSL2SWL, gravity, member, MCoefMod, MmbrCoefIDIn ! Check the member does not exhibit any of the following conditions if (.not. member%PropPot) then - if ( abs(Zb) < abs(member%Rmg(N+1)*sinPhi) ) then - call SetErrStat(ErrID_Fatal, 'The upper end-plate of a member must not cross the water plane. This is not true for Member ID '//trim(num2lstr(member%MemberID)), errStat, errMsg, 'SetMemberProperties' ) - end if - if ( abs(Za) < abs(member%Rmg(1)*sinPhi) ) then - call SetErrStat(ErrID_Fatal, 'The lower end-plate of a member must not cross the water plane. This is not true for Member ID '//trim(num2lstr(member%MemberID)), errStat, errMsg, 'SetMemberProperties' ) + if (member%MHstLMod == 1) then + if ( abs(Zb) < abs(member%Rmg(N+1)*sinPhi) ) then + call SetErrStat(ErrID_Fatal, 'The upper end-plate of a member must not cross the water plane. This is not true for Member ID '//trim(num2lstr(member%MemberID)), errStat, errMsg, 'SetMemberProperties' ) + end if + if ( abs(Za) < abs(member%Rmg(1)*sinPhi) ) then + call SetErrStat(ErrID_Fatal, 'The lower end-plate of a member must not cross the water plane. This is not true for Member ID '//trim(num2lstr(member%MemberID)), errStat, errMsg, 'SetMemberProperties' ) + end if end if - - if ( ( Za < -WtrDepth .and. Zb >= -WtrDepth ) .and. ( phi > 10.0*d2r .or. abs((member%RMG(N+1) - member%RMG(i))/member%RefLength)>0.1 ) ) then + if ( ( Za < -InitInp%WaveField%EffWtrDpth .and. Zb >= -InitInp%WaveField%EffWtrDpth ) .and. ( phi > 10.0*d2r .or. abs((member%RMG(N+1) - member%RMG(1))/member%RefLength)>0.1 ) ) then call SetErrStat(ErrID_Fatal, 'A member which crosses the seabed must not be inclined more than 10 degrees from vertical or have a taper larger than 0.1. This is not true for Member ID '//trim(num2lstr(member%MemberID)), errStat, errMsg, 'SetMemberProperties' ) end if @@ -1548,20 +1593,20 @@ subroutine SetMemberProperties( MSL2SWL, gravity, member, MCoefMod, MmbrCoefIDIn member%h_floor = 0.0_ReKi member%i_floor = member%NElements+1 ! Default to entire member is below the seabed member%doEndBuoyancy = .false. - if (Za < -WtrDepth) then + if (Za < -InitInp%WaveField%EffWtrDpth) then do i= 2, member%NElements+1 Za = InitInp%Nodes(member%NodeIndx(i))%Position(3) - if (Za > -WtrDepth) then ! find the lowest node above the seabed + if (Za > -InitInp%WaveField%EffWtrDpth) then ! find the lowest node above the seabed if (cosPhi < 0.173648178 ) then ! phi > 80 degrees and member is seabed crossing call SetErrStat(ErrID_Fatal, 'A seabed crossing member must have an inclination angle of <= 80 degrees from vertical. This is not true for Member ID '//trim(num2lstr(member%MemberID)), errStat, errMsg, 'SetMemberProperties' ) end if - member%h_floor = (-WtrDepth-Za)/cosPhi ! get the distance from the node to the seabed along the member axis (negative value) + member%h_floor = (-InitInp%WaveField%EffWtrDpth-Za)/cosPhi ! get the distance from the node to the seabed along the member axis (negative value) member%i_floor = i-1 ! record the number of the element that pierces the seabed member%doEndBuoyancy = .true. exit - else if ( EqualRealNos(Za, -WtrDepth ) ) then + else if ( EqualRealNos(Za, -InitInp%WaveField%EffWtrDpth ) ) then member%doEndBuoyancy = .true. end if end do @@ -1574,11 +1619,12 @@ subroutine SetMemberProperties( MSL2SWL, gravity, member, MCoefMod, MmbrCoefIDIn ! calculate element-level values do i = 1, member%NElements - member%dRdl_mg(i) = (member%RMG(i+1) - member%RMG(i))/dl - member%dRdl_in(i) = (member%Rin(i+1) - member%Rin(i))/dl + member%dRdl_mg( i) = (member%RMG( i+1) - member%RMG( i))/dl + member%dRdl_in( i) = (member%Rin( i+1) - member%Rin( i))/dl + member%dRdl_mg_b(i) = (member%RMGB(i+1) - member%RMGB(i))/dl - member%alpha( i) = GetAlpha(member%RMG(i), member%RMG(i+1)) - member%alpha_fb(i) = GetAlpha(member%Rin(i), member%Rin(i+1)) + member%alpha( i) = GetAlpha(member%RMGB(i), member%RMGB(i+1)) ! Only used to distribute external buoyancy load to nodes + member%alpha_fb(i) = GetAlpha(member%Rin( i), member%Rin( i+1)) end do @@ -1639,7 +1685,7 @@ subroutine SetMemberProperties( MSL2SWL, gravity, member, MCoefMod, MmbrCoefIDIn Lmid = member%FillFSLoc - Za Rmidin = member%Rin(i)+(Lmid/(Zb-Za))*(member%Rin(i+1)-member%Rin(i)) ! radius of member interior at middle of segment, where division occurs CALL FloodedBallastPartSegment(member%Rin(i ), Rmidin, Lmid, member%FillDens, Vballast_l, member%m_fb_l(i), member%h_cfb_l(i), member%I_lfb_l(i), member%I_rfb_l(i)) ! get precomputed quantities for lower half-segment - CALL FloodedBallastPartSegment(member%Rin(i+1), Rmidin, -Lmid, 0.0, Vballast_u, member%m_fb_u(i), member%h_cfb_u(i), member%I_lfb_u(i), member%I_rfb_u(i)) ! get precomputed quantities for upper half-segment + CALL FloodedBallastPartSegment(member%Rin(i+1), Rmidin, -Lmid, 0.0_ReKi, Vballast_u, member%m_fb_u(i), member%h_cfb_u(i), member%I_lfb_u(i), member%I_rfb_u(i)) ! get precomputed quantities for upper half-segment else if (i == member%i_floor) then ! Hopefully we don't have a partially filled element crossing the seabed. @@ -1665,18 +1711,18 @@ subroutine SetMemberProperties( MSL2SWL, gravity, member, MCoefMod, MmbrCoefIDIn ! Determine volumes to add to Non-WAMIT modeled members, etc. if (.not. member%PropPot) then - if (Zb < -WtrDepth) then + if (Zb < -InitInp%WaveField%EffWtrDpth) then ! fully buried element, do not add these volume contributions to totals - else if (0.0 > Zb) then + else if (0.0 >= Zb) then ! Bug fix per OpenFAST issue #844 GJH 2/3/2022 ! fully submerged elements. ! NOTE: For an element which is fractionaly in the seabed, the entire element volume is added to totals member%Vinner = member%Vinner + Vinner_l + Vinner_u member%Vouter = member%Vouter + Vouter_l + Vouter_u member%Vsubmerged = member%Vsubmerged + Vouter_l + Vouter_u - else if ((0.0 > Za) .AND. (0.0 <= Zb)) then - if (i == 1) then - call SetErrStat(ErrID_Fatal, 'The lowest element of a member must not cross the free surface. This is true for MemberID '//trim(num2lstr(member%MemberID)), errStat, errMsg, 'SetMemberProperties') - end if + else if ((0.0 > Za) .AND. (0.0 < Zb)) then ! Bug fix per OpenFAST issue #844 GJH 2/3/2022 + ! if (i == 1) then + ! call SetErrStat(ErrID_Fatal, 'The lowest element of a member must not cross the free surface. This is true for MemberID '//trim(num2lstr(member%MemberID)), errStat, errMsg, 'SetMemberProperties') + ! end if ! partially submerged element member%Vinner = member%Vinner + Vinner_l + Vinner_u @@ -1698,7 +1744,7 @@ subroutine SetMemberProperties( MSL2SWL, gravity, member, MCoefMod, MmbrCoefIDIn li = dl*(i-1) ! fully buried element - if (Zb < -WtrDepth) then + if (Zb < -InitInp%WaveField%EffWtrDpth) then member%floodstatus(i) = 0 ! fully filled elements @@ -1762,7 +1808,7 @@ subroutine SetMemberProperties( MSL2SWL, gravity, member, MCoefMod, MmbrCoefIDIn end subroutine SetMemberProperties - +!---------------------------------------------------------------------------------------------------------------------------------- subroutine SetupMembers( InitInp, p, m, errStat, errMsg ) type(Morison_InitInputType), intent (inout) :: InitInp type(Morison_ParameterType), intent (inout) :: p @@ -1781,15 +1827,15 @@ subroutine SetupMembers( InitInp, p, m, errStat, errMsg ) ! allocate and copy in the InpMembers array p%NMembers = InitInp%NMembers - ALLOCATE ( p%Members(p%NMembers), STAT = errStat ) - IF ( errStat /= ErrID_None ) THEN + ALLOCATE ( p%Members(p%NMembers), STAT = errStat2 ) + IF ( errStat2 /= 0 ) THEN errMsg = ' Error allocating space for the members array.' errStat = ErrID_Fatal RETURN END IF - ALLOCATE ( m%MemberLoads(p%NMembers), STAT = errStat ) - IF ( errStat /= ErrID_None ) THEN + ALLOCATE ( m%MemberLoads(p%NMembers), STAT = errStat2 ) + IF ( errStat2 /= 0 ) THEN errMsg = ' Error allocating space for the memberLoads array.' errStat = ErrID_Fatal RETURN @@ -1801,13 +1847,17 @@ subroutine SetupMembers( InitInp, p, m, errStat, errMsg ) p%Members(i)%dl = InitInp%InpMembers(i)%dl p%Members(i)%NElements = InitInp%InpMembers(i)%NElements p%Members(i)%PropPot = InitInp%InpMembers(i)%PropPot + p%Members(i)%MHstLMod = InitInp%InpMembers(i)%MHstLMod + ! p%Members(i)%MCF = InitInp%InpMembers(i)%MCF - call AllocateMemberDataArrays(p%Members(i), m%MemberLoads(i), errStat2, errMsg2) ; call SetErrStat(errStat2, errMsg2, errStat, errMsg, 'SetupMembers') + call AllocateMemberDataArrays(p%Members(i), m%MemberLoads(i), errStat2, errMsg2) + call SetErrStat(errStat2, errMsg2, errStat, errMsg, 'SetupMembers') + if (ErrStat >= AbortErrLev) return p%Members(i)%NodeIndx = InitInp%InpMembers(i)%NodeIndx ! now that the parameter version is allocated, copy the data from the InitInp version ! only reorder the nodes if the end nodes do not follow the necessary coordinate ordering rules - call FlipMemberNodeData(p%Members(i), InitInp%nodes, doSwap, errStat2, errMsg2) ; call SetErrStat(errStat2, errMsg2, errStat, errMsg, 'SetupMembers') + call FlipMemberNodeData(p%Members(i), InitInp%nodes, doSwap) if (doSwap) then prop2Indx = InitInp%InpMembers(I)%MPropSetID1Indx prop1Indx = InitInp%InpMembers(I)%MPropSetID2Indx @@ -1816,7 +1866,9 @@ subroutine SetupMembers( InitInp, p, m, errStat, errMsg ) prop2Indx = InitInp%InpMembers(I)%MPropSetID2Indx end if ! Now populate the various member data arrays using the HydroDyn input file data - call SetMemberProperties( InitInp%MSL2SWL, InitInp%Gravity, p%Members(i), InitInp%InpMembers(i)%MCoefMod, InitInp%InpMembers(i)%MmbrCoefIDIndx, InitInp%InpMembers(i)%MmbrFilledIDIndx, InitInp%MPropSets(prop1Indx), InitInp%MPropSets(prop2Indx), InitInp, errStat2, errMsg2 ) ; call SetErrStat(errStat2, errMsg2, errStat, errMsg, 'SetupMembers') + call SetMemberProperties( InitInp%Gravity, p%Members(i), InitInp%InpMembers(i)%MCoefMod, InitInp%InpMembers(i)%MmbrCoefIDIndx, InitInp%InpMembers(i)%MmbrFilledIDIndx, InitInp%MPropSets(prop1Indx), InitInp%MPropSets(prop2Indx), InitInp, errStat2, errMsg2 ) + call SetErrStat(errStat2, errMsg2, errStat, errMsg, 'SetupMembers') + if (ErrStat >= AbortErrLev) return end do end subroutine SetupMembers @@ -1838,7 +1890,7 @@ SUBROUTINE Morison_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, In TYPE(Morison_OutputType), INTENT( OUT) :: y !< Initial system outputs (outputs are not calculated; !! only the output mesh is initialized) TYPE(Morison_MiscVarType), INTENT( OUT) :: m !< Initial misc/optimization variables - REAL(DbKi), INTENT(INOUT) :: Interval !< Coupling interval in seconds: the rate that + REAL(DbKi), INTENT(IN ) :: Interval !< Coupling interval in seconds: the rate that !! (1) Morison_UpdateStates() is called in loose coupling & !! (2) Morison_UpdateDiscState() is called in tight coupling. !! Input is the suggested time from the glue code; @@ -1847,103 +1899,97 @@ SUBROUTINE Morison_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, In TYPE(Morison_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 + + character(*), parameter :: RoutineName = 'Morison_Init' - TYPE(Morison_MemberType) :: member ! the current member - type(Morison_MemberInputType) :: inpMember ! current input file-based member - INTEGER :: N, i, j, count - REAL(ReKi) :: dl - REAL(ReKi) :: vec(3),v2D(3,1), pos(3) - REAL(ReKi) :: phi ! member tilt angle - REAL(ReKi) :: beta ! member tilt heading - REAL(ReKi) :: cosPhi - REAL(ReKi) :: sinPhi - REAL(ReKi) :: tanPhi - REAL(ReKi) :: sinBeta - REAL(ReKi) :: cosBeta - REAL(ReKi) :: Za - REAL(ReKi) :: Zb - real(ReKi) :: memLength ! reference member length - real(ReKi) :: An(3), An_drag(3), Vn(3), I_n(3), Z0, sgn, Amag, Amag_drag, Vmag, Imag, Ir_MG_end, Il_MG_end, R_I(3,3), IRl_mat(3,3), tMG, MGdens, F_I(3), F_DP(3), af(3), VnDotAf - integer(IntKi) :: MemberEndIndx, ncommon - INTEGER, ALLOCATABLE :: commonNodeLst(:) - LOGICAL, ALLOCATABLE :: usedJointList(:) - integer(IntKi) :: errStat2 ! returns a non-zero value when an error occurs + TYPE(Morison_MemberType) :: member ! the current member + INTEGER :: i, j + REAL(ReKi) :: v2D(3,1), pos(3) + real(ReKi) :: An(3), An_drag(3), Vn(3), I_n(3), sgn, Amag, Amag_drag, Vmag, Imag, Ir_MG_end, Il_MG_end, R_I(3,3), IRl_mat(3,3), tMG, MGdens + integer(IntKi) :: MemberEndIndx + INTEGER, ALLOCATABLE :: commonNodeLst(:) + LOGICAL, ALLOCATABLE :: usedJointList(:) + integer(IntKi) :: errStat2 ! returns a non-zero value when an error occurs CHARACTER(errMsgLen) :: errMsg2 ! Error message if errStat2 /= ErrID_None - - - ! Initialize errStat + + ! Initialize errStat errStat = ErrID_None errMsg = "" - - - - ! Initialize the NWTC Subroutine Library - CALL NWTC_Init( ) - - ! Define parameters here: + + ! Define parameters here: p%DT = Interval - p%WtrDens = InitInp%WtrDens - p%WtrDpth = InitInp%WtrDpth p%Gravity = InitInp%Gravity p%NNodes = InitInp%NNodes p%NJoints = InitInp%NJoints - p%NStepWave = InitInp%NStepWave p%NumOuts = InitInp%NumOuts p%NMOutputs = InitInp%NMOutputs ! Number of members to output [ >=0 and <10] - p%OutSwtch = InitInp%OutSwtch - p%MSL2SWL = InitInp%MSL2SWL + p%WaveDisp = InitInp%WaveDisp + p%AMMod = InitInp%AMMod p%VisMeshes = InitInp%VisMeshes ! visualization mesh for morison elements + p%PtfmYMod = InitInp%PtfmYMod + + ! Pointer to SeaState WaveField + p%WaveField => InitInp%WaveField - ALLOCATE ( p%MOutLst(p%NMOutputs), STAT = errStat ) - IF ( errStat /= ErrID_None ) THEN - errMsg = ' Error allocating space for MOutLst array.' - errStat = ErrID_Fatal + ! Only compute added-mass force up to the free surface if wave stretching is enabled + IF ( p%WaveField%WaveStMod .EQ. 0_IntKi ) THEN + ! Setting AMMod to zero just in case. Probably redundant. + p%AMMod = 0_IntKi + END IF + + + ALLOCATE ( p%MOutLst(p%NMOutputs), STAT = errStat2 ) + IF ( errStat2 /= 0 ) THEN + call SetErrStat(ErrID_Fatal,'Error allocating space for MOutLst array.', ErrStat, ErrMsg, RoutineName) RETURN END IF - IF (ALLOCATED(InitInp%MOutLst) ) & - p%MOutLst = InitInp%MOutLst ! Member output data + IF (ALLOCATED(InitInp%MOutLst) ) then + do i=1,size(InitInp%MOutLst) + call Morison_CopyMOutput( InitInp%MOutLst(i), p%MOutLst(i), MESH_NEWCOPY, ErrStat2, ErrMsg2 ) ! Member output data + call SetErrStat( errStat2, errMsg2, errStat, errMsg, 'Morison_Init' ) + end do + end if p%NJOutputs = InitInp%NJOutputs ! Number of joints to output [ >=0 and <10] - ALLOCATE ( p%JOutLst(p%NJOutputs), STAT = errStat ) - IF ( errStat /= ErrID_None ) THEN - errMsg = ' Error allocating space for JOutLst array.' - errStat = ErrID_Fatal + ALLOCATE ( p%JOutLst(p%NJOutputs), STAT = errStat2 ) + IF ( errStat2 /= 0 ) THEN + call SetErrStat(ErrID_Fatal,'Error allocating space for JOutLst array.', ErrStat, ErrMsg, RoutineName) RETURN END IF IF (ALLOCATED(InitInp%JOutLst) ) & p%JOutLst = InitInp%JOutLst ! Joint output data ! ----------------------- set up the members ----------------------- - call SetupMembers( InitInp, p, m, errStat2, errMsg2 ) ; call SetErrStat( errStat2, errMsg2, errStat, errMsg, 'Morison_Init' ) + call SetupMembers( InitInp, p, m, errStat2, errMsg2 ) + call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) if ( errStat >= AbortErrLev ) return !------------------------ set up joint (or joint-node) properties -- do i = 1, InitInp%NJoints InitInp%Nodes(i)%JAxCd = InitInp%AxialCoefs(InitInp%InpJoints(i)%JointAxIDIndx)%AxCd InitInp%Nodes(i)%JAxCa = InitInp%AxialCoefs(InitInp%InpJoints(i)%JointAxIDIndx)%AxCa - InitInp%Nodes(i)%JAxCp = InitInp%AxialCoefs(InitInp%InpJoints(i)%JointAxIDIndx)%AxCp - InitInp%Nodes(i)%JAxCd = InitInp%AxialCoefs(InitInp%InpJoints(i)%JointAxIDIndx)%AxCd - InitInp%Nodes(i)%JAxCa = InitInp%AxialCoefs(InitInp%InpJoints(i)%JointAxIDIndx)%AxCa - InitInp%Nodes(i)%JAxCp = InitInp%AxialCoefs(InitInp%InpJoints(i)%JointAxIDIndx)%AxCp + InitInp%Nodes(i)%JAxCp = InitInp%AxialCoefs(InitInp%InpJoints(i)%JointAxIDIndx)%AxCp + InitInp%Nodes(i)%JAxFDMod = InitInp%AxialCoefs(InitInp%InpJoints(i)%JointAxIDIndx)%AxFDMod + InitInp%Nodes(i)%JAxVnCOff = InitInp%AxialCoefs(InitInp%InpJoints(i)%JointAxIDIndx)%AxVnCOff + InitInp%Nodes(i)%JAxFDLoFSc = InitInp%AxialCoefs(InitInp%InpJoints(i)%JointAxIDIndx)%AxFDLoFSc + ! Redundant work (these are already assigned to the member data arrays, ! but is needed on the joint data because we report the tMG, and MGDensity at each Joint node in the Summary File - call SetNodeMG( InitInp%NMGDepths, InitInp%MGDepths, InitInp%Nodes(i), InitInp%MSL2SWL, InitInp%Nodes(i)%tMG, InitInp%Nodes(i)%MGDensity ) + call SetNodeMG( InitInp%NMGDepths, InitInp%MGDepths, InitInp%Nodes(i), p%WaveField%MSL2SWL, InitInp%Nodes(i)%tMG, InitInp%Nodes(i)%MGDensity ) end do - ! allocate and copy in node-based load and hydrodynamic arrays - call AllocateNodeLoadVariables(InitInp, p, m, p%NNodes, errStat, errMsg ) - call MOVE_ALLOC( InitInp%nodeInWater, p%nodeInWater ) - - + ! allocate and copy in node-based load and hydrodynamic arrays + call AllocateNodeLoadVariables(InitInp, p, m, p%NNodes, errStat2, errMsg2 ) + call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) + if ( errStat >= AbortErrLev ) return - ! Create the input and output meshes associated with loads at the nodes - + ! Create the input and output meshes associated with loads at the nodes CALL MeshCreate( BlankMesh = u%Mesh & ,IOS = COMPONENT_INPUT & ,Nnodes = p%NNodes & ,errStat = errStat & - ,ErrMess = errMsg & + ,ErrMess = errMsg2 & ,TranslationDisp = .TRUE. & ,Orientation = .TRUE. & ,TranslationVel = .TRUE. & @@ -1951,7 +1997,8 @@ SUBROUTINE Morison_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, In ,TranslationAcc = .TRUE. & ,RotationAcc = .TRUE. ) - IF ( errStat >= AbortErrLev ) RETURN + call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) + if ( errStat >= AbortErrLev ) return !TODO: Do we still need this for visualization? How is it used? GJH 3/26/2020 Actually need a line mesh to properly visualize the members !CALL AllocAry( Morison_Rad, numDistribMarkers, 'Morison_Rad', errStat, errMsg) @@ -1961,15 +2008,16 @@ SUBROUTINE Morison_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, In DO I=1,p%NNodes ! This needs to change so that the Position is relative to MSL NOT SWL: pos = InitInp%Nodes(I)%Position - pos(3) = pos(3) + InitInp%MSL2SWL + pos(3) = pos(3) + p%WaveField%MSL2SWL ! Create the node on the mesh CALL MeshPositionNode (u%Mesh & , i & , pos & ! this info comes from HydroDyn input file and the subroutine: Morison_GenerateSimulationNodes - , errStat & - , errMsg & + , errStat2 & + , errMsg2 & ) !, transpose(p%Nodes(I)%R_LToG) ) - IF ( errStat /= 0 ) RETURN + call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) + if ( errStat >= AbortErrLev ) return !TODO: Do we still need this for visualization? How is it used? GJH 3/26/2020 Actually need a line mesh to properly visualize the members ! Morison_Rad(count) = p%Nodes(I)%R ! set this for FAST visualization @@ -1980,20 +2028,23 @@ SUBROUTINE Morison_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, In CALL MeshConstructElement (u%Mesh & , ELEMENT_POINT & - , errStat & - , errMsg & + , errStat2 & + , errMsg2 & , i & ) + call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) + if ( errStat >= AbortErrLev ) return + END DO CALL MeshCommit ( u%Mesh & - , errStat & - , errMsg ) + , errStat2 & + , errMsg2 ) - IF ( errStat /= 0 ) THEN - RETURN - END IF + call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) + if ( errStat >= AbortErrLev ) return + ! Initialize the inputs DO I=1,u%Mesh%Nnodes @@ -2011,39 +2062,43 @@ SUBROUTINE Morison_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, In ,DestMesh = y%Mesh & ,CtrlCode = MESH_SIBLING & ,IOS = COMPONENT_OUTPUT & - ,errStat = errStat & - ,ErrMess = errMsg & + ,errStat = errStat2 & + ,ErrMess = errMsg2 & ,Force = .TRUE. & ,Moment = .TRUE. ) + call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) + if ( errStat >= AbortErrLev ) return u%Mesh%RemapFlag = .TRUE. y%Mesh%RemapFlag = .TRUE. ! Define initial system states here: x%DummyContState = 0 - xd%DummyDiscState = 0 + !xd%DummyDiscState = 0 + ALLOCATE ( xd%V_rel_n_FiltStat(p%NJoints), STAT = ErrStat ) + IF ( ErrStat /= ErrID_None ) THEN + ErrMsg = ' Error allocating space for V_rel_n_FiltStat array.' + ErrStat = ErrID_Fatal + RETURN + END IF + xd%V_rel_n_FiltStat = 0.0_ReKi + z%DummyConstrState = 0 OtherState%DummyOtherState = 0 - m%LastIndWave = 1 - - ! IF ( p%OutSwtch > 0 ) THEN @mhall: I think the below need to be allocated in all cases - ! allocate and initialize joint-specific arrays - ALLOCATE ( commonNodeLst(10), STAT = errStat ) - IF ( errStat /= ErrID_None ) THEN - errMsg = ' Error allocating space for the commonNodeLst array.' - errStat = ErrID_Fatal + ALLOCATE ( commonNodeLst(10), STAT = errStat2 ) + IF ( errStat2 /= 0 ) THEN + call SetErrStat(ErrID_Fatal,'Error allocating space for commonNodeLst array.', ErrStat, ErrMsg, RoutineName) RETURN END IF commonNodeLst = -1 - ALLOCATE ( usedJointList(p%NJoints), STAT = errStat ) - IF ( errStat /= ErrID_None ) THEN - errMsg = ' Error allocating space for the UsedJointList array.' - errStat = ErrID_Fatal + ALLOCATE ( usedJointList(p%NJoints), STAT = errStat2 ) + IF ( errStat2 /= 0 ) THEN + call SetErrStat(ErrID_Fatal,'Error allocating space for UsedJointList array.', ErrStat, ErrMsg, RoutineName) RETURN END IF usedJointList = .FALSE. @@ -2064,7 +2119,7 @@ SUBROUTINE Morison_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, In tMG = -999.0 An_drag = 0.0 - IF ( InitInp%InpJoints(i)%Position(3) >= -p%WtrDpth ) THEN + IF ( InitInp%InpJoints(i)%Position(3) >= -InitInp%WaveField%WtrDpth ) THEN ! loop through each member attached to the joint, getting the radius of its appropriate end DO J = 1, InitInp%InpJoints(I)%NConnections @@ -2120,7 +2175,7 @@ SUBROUTINE Morison_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, In IF (EqualRealNos(Amag_drag, 0.0_ReKi)) THEN p%DragConst_End(i) = 0.0 ELSE - p%DragConst_End(i) = InitInp%Nodes(i)%JAxCd*p%WtrDens / ( 4.0_ReKi * Amag_drag ) + p%DragConst_End(i) = InitInp%Nodes(i)%JAxCd*p%WaveField%WtrDens / ( 4.0_ReKi * Amag_drag ) END IF ! magnitudes of normal-weighted values Amag = sqrt(Amag) @@ -2130,7 +2185,7 @@ SUBROUTINE Morison_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, In ! Constant part of the external hydrodynamic added mass term if ( Vmag > 0.0 ) then v2D(:,1) = Vn - p%AM_End(:,:,i) = (InitInp%Nodes(I)%JAxCa*InitInp%WtrDens/ Vmag)*matmul(v2D, transpose(v2D)) + p%AM_End(:,:,i) = (InitInp%Nodes(I)%JAxCa*p%WaveField%WtrDens/ Vmag)*matmul(v2D, transpose(v2D)) end if ! Constant part of the external hydrodynamic dynamic pressure force @@ -2157,8 +2212,17 @@ SUBROUTINE Morison_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, In p%I_MG_End(:,:,i) = MatMul( MatMul(R_I, Irl_mat), Transpose(R_I) ) ! final moment of inertia matrix for node - END IF ! InitInp%InpJoints(i)%Position(3) >= -p%WtrDpth + END IF ! InitInp%InpJoints(i)%Position(3) >= -WtrDpth + p%DragMod_End (i) = InitInp%Nodes(i)%JAxFDMod + IF ( InitInp%Nodes(i)%JAxVnCOff .LE. 0.0_ReKi) THEN + p%VRelNFiltConst(i) = 1.0_ReKi + p%DragLoFSc_End (i) = 1.0_ReKi + ELSE + p%VRelNFiltConst(i) = exp(-2.0*Pi*InitInp%Nodes(i)%JAxVnCOff * p%DT) + p%DragLoFSc_End (i) = InitInp%Nodes(i)%JAxFDLoFSc + END IF + END DO ! looping through nodes that are joints, i ! Define initial guess for the system inputs here: @@ -2166,20 +2230,10 @@ SUBROUTINE Morison_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, In ! Define system output initializations (set up mesh) here: ! Define initialization-routine output here: - ! Initialize the outputs - IF ( p%OutSwtch > 0) then !@mhall: moved this "if" to after allocations - - CALL MrsnOUT_Init( InitInp, y, p, InitOut, errStat, errMsg ) - IF ( errStat > AbortErrLev ) RETURN - - ! Determine if we need to perform output file handling - - IF ( p%OutSwtch == 1 .OR. p%OutSwtch == 3 ) THEN - CALL MrsnOUT_OpenOutput( Morison_ProgDesc%Name, TRIM(InitInp%OutRootName)//'.HD', p, InitOut, errStat, errMsg ) - IF ( errStat > AbortErrLev ) RETURN - END IF - - END IF + ! Initialize the outputs + CALL MrsnOUT_Init( InitInp, y, p, InitOut, errStat2, errMsg2 ) + call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) + if ( errStat >= AbortErrLev ) return ! visualization Line2 mesh if (p%VisMeshes) then @@ -2191,14 +2245,15 @@ SUBROUTINE Morison_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, In ! Then we can use the computed load components in the Summary File ! NOTE: Morison module has no states, otherwise we could no do this. GJH - call Morison_CalcOutput(0.0_DbKi, u, p, x, xd, z, OtherState, y, m, errStat, errMsg ) - IF ( errStat > AbortErrLev ) RETURN + call Morison_CalcOutput(0.0_DbKi, u, p, x, xd, z, OtherState, y, m, errStat2, errMsg2 ) + call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) + if ( errStat >= AbortErrLev ) return - ! Write Summary information now that everything has been initialized. - CALL WriteSummaryFile( InitInp%UnSum, InitInp%Gravity, InitInp%MSL2SWL, InitInp%WtrDpth, InitInp%NJoints, InitInp%NNodes, InitInp%Nodes, p%NMembers, p%Members, & - p%NumOuts, p%OutParam, p%NMOutputs, p%MOutLst, p%NJOutputs, p%JOutLst, u%Mesh, y%Mesh, & - p, m, errStat, errMsg ) - IF ( errStat > AbortErrLev ) RETURN + ! Write Summary information to *HydroDyn* summary file now that everything has been initialized. + CALL WriteSummaryFile( InitInp%UnSum, InitInp%NJoints, InitInp%NNodes, InitInp%Nodes, p%NMembers, p%Members, & + p%NumOuts, p%OutParam, p%MOutLst, p%JOutLst, u%Mesh, y%Mesh, p, m, errStat2, errMsg2 ) + call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) + if ( errStat >= AbortErrLev ) return !Contains: ! SUBROUTINE CleanUpInitOnErr @@ -2206,6 +2261,9 @@ SUBROUTINE Morison_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, In ! END SUBROUTINE END SUBROUTINE Morison_Init + + +!---------------------------------------------------------------------------------------------------------------------------------- subroutine VisMeshSetup(u,p,y,m,InitOut,ErrStat,ErrMsg) type(Morison_InputType), intent(inout) :: u type(Morison_ParameterType), intent(in ) :: p @@ -2259,7 +2317,7 @@ subroutine VisMeshSetup(u,p,y,m,InitOut,ErrStat,ErrMsg) Pos1=u%Mesh%Position(:,p%Members(iMem)%NodeIndx(1)) ! start node position of member Pos2=u%Mesh%Position(:,p%Members(iMem)%NodeIndx(size(p%Members(iMem)%NodeIndx))) ! end node position of member Theta(1) = 0.0_R8Ki ! roll (assumed since insufficient info) - Theta(2) = acos(real((Pos2(3)-Pos1(3))/norm2(Pos2-Pos1),R8Ki)) ! pitch + Theta(2) = acos(real((Pos2(3)-Pos1(3))/TwoNorm(Pos2-Pos1),R8Ki)) ! pitch Theta(3) = atan2(real(Pos2(2)-Pos1(2),R8Ki),real(Pos2(1)-Pos1(1),R8Ki)) ! yaw MemberOrient=EulerConstructZYX(Theta) ! yaw-pitch-roll sequence @@ -2348,22 +2406,22 @@ SUBROUTINE RodrigMat(a, R, errStat, errMsg) END SUBROUTINE RodrigMat - +!---------------------------------------------------------------------------------------------------------------------------------- FUNCTION GetAlpha(R1,R2) ! calculates relative center of volume location for a (tapered) cylindrical element real(ReKi) :: GetAlpha REAL(ReKi), INTENT ( IN ) :: R1 ! interior radius of element at node point REAL(ReKi), INTENT ( IN ) :: R2 ! interior radius of other end of part-element - if ( EqualRealNos(R1, 0.0_ReKi) .AND. EqualRealNos(R2, 0.0_ReKi) ) then ! if undefined, return 0 - GetAlpha = 0.0_ReKi - else + IF ( EqualRealNos(R1, R2) ) THEN ! Also cover the case where R1=R2=0 + GetAlpha = 0.5 + ELSE GetAlpha = (R1*R1 + 2.0*R1*R2 + 3.0*R2*R2)/4.0/(R1*R1 + R1*R2 + R2*R2) - end if + END IF END FUNCTION GetAlpha - +!---------------------------------------------------------------------------------------------------------------------------------- SUBROUTINE AllocateNodeLoadVariables(InitInp, p, m, NNodes, errStat, errMsg ) TYPE(Morison_InitInputType), INTENT(IN ) :: InitInp ! Initialization inputs TYPE(Morison_ParameterType), INTENT(INOUT) :: p ! parameter variables @@ -2371,281 +2429,70 @@ SUBROUTINE AllocateNodeLoadVariables(InitInp, p, m, NNodes, errStat, errMsg ) INTEGER(IntKi), INTENT(IN ) :: NNodes ! number of nodes in node list INTEGER(IntKi), INTENT( OUT) :: errStat ! Error status of the operation CHARACTER(*), INTENT( OUT) :: errMsg ! Error message if errStat /= ErrID_None - integer(IntKi) :: errStat2 ! returns a non-zero value when an error occurs - CHARACTER(errMsgLen) :: errMsg2 ! Error message if errStat2 /= ErrID_None - character(*), parameter :: routineName = 'AllocateNodeLoadVariables' + integer(IntKi) :: errStat2 ! Returns a non-zero value when an error occurs + CHARACTER(errMsgLen) :: errMsg2 ! Error message if errStat2 /= ErrID_None + character(*), parameter :: routineName = 'AllocateNodeLoadVariables' - ! Initialize errStat - + ! Initialize errStat errStat = ErrID_None errMsg = "" - - call AllocAry( m%nodeInWater , NNodes , 'm%nodeInWater' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) - call AllocAry( m%vrel , 3, NNodes , 'm%vrel' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) - !call AllocAry( m%F_D , 6, NNodes , 'm%F_D' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) - !call AllocAry( m%F_A , 6, NNodes , 'm%F_A' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) - !call AllocAry( m%F_B , 6, NNodes , 'm%F_B' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) - !call AllocAry( m%F_BF , 6, NNodes , 'm%F_BF' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) - !call AllocAry( m%F_I , 6, NNodes , 'm%F_I' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) - !call AllocAry( m%F_If , 6, NNodes , 'm%F_If' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) - !call AllocAry( m%F_WMG , 6, NNodes , 'm%F_WMG' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) - !call AllocAry( m%F_IMG , 6, NNodes , 'm%F_IMG' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) - call AllocAry( m%FV , 3, NNodes , 'm%FV' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) - call AllocAry( m%FA , 3, NNodes , 'm%FA' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) - call AllocAry( m%FDynP , NNodes , 'm%FDynP' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) - call AllocAry( p%An_End , 3, p%NJoints, 'p%An_End' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) - call AllocAry( p%DragConst_End, p%NJoints, 'p%DragConst_End', errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) - call AllocAry( m%F_I_End , 3, p%NJoints, 'm%F_I_End' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) - call AllocAry( m%F_BF_End , 6, p%NJoints, 'm%F_BF_End' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) - call AllocAry( m%F_A_End , 3, p%NJoints, 'm%F_A_End' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) - call AllocAry( m%F_D_End , 3, p%NJoints, 'm%F_D_End' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) - call AllocAry( m%F_B_End , 6, p%NJoints, 'm%F_B_End' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) - call AllocAry( m%F_IMG_End , 6, p%NJoints, 'm%F_IMG_End' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) - call AllocAry( p%I_MG_End , 3, 3, p%NJoints, 'p%I_MG_End' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) - call AllocAry( p%F_WMG_End , 3, p%NJoints, 'p%F_WMG_End' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) - call AllocAry( p%Mass_MG_End , p%NJoints, 'p%Mass_MG_End' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) - call AllocAry( p%AM_End , 3, 3, p%NJoints, 'p%AM_End' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) - call AllocAry( p%DP_Const_End , 3, p%NJoints, 'p%DP_Const_End' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) - if (errStat == ErrID_Fatal) return - - m%nodeInWater = 0 - m%vrel = 0.0_ReKi - !m%F_D = 0.0_ReKi - !m%F_A = 0.0_ReKi - !m%F_B = 0.0 - !m%F_BF = 0.0 - !m%F_I = 0.0 - !m%F_If = 0.0 - !m%F_WMG = 0.0 - !m%F_IMG = 0.0 - m%FV = 0.0_ReKi - m%FA = 0.0_ReKi - m%FDynP = 0.0_ReKi - p%An_End = 0.0 - p%DragConst_End = 0.0 - m%F_I_End = 0.0 - m%F_BF_End = 0.0 - m%F_A_End = 0.0 - m%F_D_End = 0.0 - m%F_B_End = 0.0 - m%F_IMG_End = 0.0 - p%DP_Const_End = 0.0 - p%I_MG_End = 0.0 - p%Mass_MG_End = 0.0 - p%F_WMG_End = 0.0 - p%AM_End = 0.0 - - allocate( p%WaveVel(0:p%NStepWave, p%NNodes, 3), STAT = errStat ) - IF ( errStat /= ErrID_None ) THEN - errMsg = ' Error allocating space for wave velocities array.' - errStat = ErrID_Fatal - RETURN - END IF - p%WaveVel = InitInp%WaveVel - - allocate( p%WaveAcc(0:p%NStepWave, p%NNodes, 3), STAT = errStat ) - IF ( errStat /= ErrID_None ) THEN - errMsg = ' Error allocating space for wave accelerations array.' - errStat = ErrID_Fatal - RETURN - END IF - p%WaveAcc = InitInp%WaveAcc - - allocate( p%WaveDynP(0:p%NStepWave, p%NNodes), STAT = errStat ) - IF ( errStat /= ErrID_None ) THEN - errMsg = ' Error allocating space for wave dynamic pressure array.' - errStat = ErrID_Fatal - RETURN - END IF - p%WaveDynP = InitInp%WaveDynP - - allocate( p%WaveTime(0:p%NStepWave), STAT = errStat ) - IF ( errStat /= ErrID_None ) THEN - errMsg = ' Error allocating space for wave time array.' - errStat = ErrID_Fatal - RETURN - END IF - p%WaveTime = InitInp%WaveTime + call AllocAry( m%DispNodePosHdn, 3, NNodes , 'm%DispNodePosHdn', errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) + call AllocAry( m%DispNodePosHst, 3, NNodes , 'm%DispNodePosHst', errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) + call AllocAry( m%nodeInWater , NNodes , 'm%nodeInWater' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) + call AllocAry( m%vrel , 3, NNodes , 'm%vrel' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) + call AllocAry( m%FV , 3, NNodes , 'm%FV' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) + call AllocAry( m%FA , 3, NNodes , 'm%FA' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) + call AllocAry( m%FAMCF , 3, NNodes , 'm%FAMCF' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) + call AllocAry( m%FDynP , NNodes , 'm%FDynP' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) + call AllocAry( m%WaveElev , NNodes , 'm%WaveElev' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) + call AllocAry( m%WaveElev1 , NNodes , 'm%WaveElev1' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) + call AllocAry( m%WaveElev2 , NNodes , 'm%WaveElev2' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) + call AllocAry( p%An_End , 3, p%NJoints, 'p%An_End' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) + call AllocAry( p%DragConst_End, p%NJoints, 'p%DragConst_End' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) + call AllocAry( m%F_I_End , 3, p%NJoints, 'm%F_I_End' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) + call AllocAry( m%F_BF_End , 6, p%NJoints, 'm%F_BF_End' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) + call AllocAry( m%F_A_End , 3, p%NJoints, 'm%F_A_End' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) + call AllocAry( m%F_D_End , 3, p%NJoints, 'm%F_D_End' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) + call AllocAry( m%F_B_End , 6, p%NJoints, 'm%F_B_End' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) + call AllocAry( m%F_IMG_End , 6, p%NJoints, 'm%F_IMG_End' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) + call AllocAry( p%I_MG_End , 3, 3, p%NJoints, 'p%I_MG_End' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) + call AllocAry( p%F_WMG_End , 3, p%NJoints, 'p%F_WMG_End' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) + call AllocAry( p%Mass_MG_End , p%NJoints, 'p%Mass_MG_End' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) + call AllocAry( p%AM_End , 3, 3, p%NJoints, 'p%AM_End' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) + call AllocAry( p%DP_Const_End , 3, p%NJoints, 'p%DP_Const_End' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) + call AllocAry( m%V_rel_n , p%NJoints, 'm%V_rel_n' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) + call AllocAry( m%V_rel_n_HiPass , p%NJoints, 'm%V_rel_n_HiPass', errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) + call AllocAry( p%DragMod_End , p%NJoints, 'p%DragMod_End' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) + call AllocAry( p%DragLoFSc_End , p%NJoints, 'p%DragLoFSc_End' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) + call AllocAry( p%VRelNFiltConst , p%NJoints, 'p%VRelNFiltConst', errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) + + if (errStat >= AbortErrLev) return + + m%DispNodePosHdn = 0.0_ReKi + m%DispNodePosHst = 0.0_ReKi + m%nodeInWater = 0 + m%vrel = 0.0_ReKi + m%FV = 0.0_ReKi + m%FA = 0.0_ReKi + m%FDynP = 0.0_ReKi + p%An_End = 0.0 + p%DragConst_End = 0.0 + m%F_I_End = 0.0 + m%F_BF_End = 0.0 + m%F_A_End = 0.0 + m%F_D_End = 0.0 + m%F_B_End = 0.0 + m%F_IMG_End = 0.0 + p%DP_Const_End = 0.0 + p%I_MG_End = 0.0 + p%Mass_MG_End = 0.0 + p%F_WMG_End = 0.0 + p%AM_End = 0.0 + m%V_rel_n = 0.0_ReKi + m%V_rel_n_HiPass = 0.0_ReKi END SUBROUTINE AllocateNodeLoadVariables - - - -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine is called at the end of the simulation. -SUBROUTINE Morison_End( u, p, x, xd, z, OtherState, y, m, errStat, errMsg ) -!.................................................................................................................................. - - TYPE(Morison_InputType), INTENT(INOUT) :: u !< System inputs - TYPE(Morison_ParameterType), INTENT(INOUT) :: p !< Parameters - TYPE(Morison_ContinuousStateType), INTENT(INOUT) :: x !< Continuous states - TYPE(Morison_DiscreteStateType), INTENT(INOUT) :: xd !< Discrete states - TYPE(Morison_ConstraintStateType), INTENT(INOUT) :: z !< Constraint states - TYPE(Morison_OtherStateType), INTENT(INOUT) :: OtherState !< Other states - TYPE(Morison_OutputType), INTENT(INOUT) :: y !< System outputs - TYPE(Morison_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables - INTEGER(IntKi), INTENT( OUT) :: errStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: errMsg !< Error message if errStat /= ErrID_None - - - - ! Initialize errStat - - errStat = ErrID_None - errMsg = "" - - - ! Place any last minute operations or calculations here: - - - ! Close files here: - - - - ! Destroy the input data: - - CALL Morison_DestroyInput( u, errStat, errMsg ) - - - ! Determine if we need to close the output file - - IF ( p%OutSwtch == 1 .OR. p%OutSwtch == 3 ) THEN - CALL MrsnOut_CloseOutput( p, errStat, errMsg ) - END IF - - ! Destroy the parameter data: - - - CALL Morison_DestroyParam( p, errStat, errMsg ) - - - ! Destroy the state data: - - CALL Morison_DestroyContState( x, errStat, errMsg ) - CALL Morison_DestroyDiscState( xd, errStat, errMsg ) - CALL Morison_DestroyConstrState( z, errStat, errMsg ) - CALL Morison_DestroyOtherState( OtherState, errStat, errMsg ) - - CALL Morison_DestroyMisc( m, errStat, errMsg ) - - ! Destroy the output data: - - CALL Morison_DestroyOutput( y, errStat, errMsg ) - - - - -END SUBROUTINE Morison_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 Morison_UpdateStates( Time, u, p, x, xd, z, OtherState, m, errStat, errMsg ) -!.................................................................................................................................. - - REAL(DbKi), INTENT(IN ) :: Time !< Current simulation time in seconds - TYPE(Morison_InputType), INTENT(IN ) :: u !< Inputs at Time - TYPE(Morison_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(Morison_ContinuousStateType), INTENT(INOUT) :: x !< Input: Continuous states at Time; - !! Output: Continuous states at Time + Interval - TYPE(Morison_DiscreteStateType), INTENT(INOUT) :: xd !< Input: Discrete states at Time; - !! Output: Discrete states at Time + Interval - TYPE(Morison_ConstraintStateType), INTENT(INOUT) :: z !< Input: Constraint states at Time; - !! Output: Constraint states at Time + Interval - TYPE(Morison_OtherStateType), INTENT(INOUT) :: OtherState !< Input: Other states at Time; - !! Output: Other states at Time + Interval - TYPE(Morison_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables - INTEGER(IntKi), INTENT( OUT) :: errStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: errMsg !< Error message if errStat /= ErrID_None - - ! Local variables - - 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 = "" - - - - - -END SUBROUTINE Morison_UpdateStates -!> This routine is similar to InterpWrappedStpReal, except it returns only the slope for the interpolation. -!! By returning the slope based on Time, we don't have to calculate this for every variable (Yary) we want to interpolate. -!! NOTE: p%WaveTime (and most arrays here) start with index of 0 instead of 1, so we will subtract 1 from "normal" interpolation -!! schemes. -FUNCTION GetInterpolationSlope(Time, p, m, IntWrapIndx) RESULT( InterpSlope ) - REAL(DbKi), INTENT(IN ) :: Time !< Current simulation time in seconds - TYPE(Morison_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(Morison_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables - INTEGER, OPTIONAL, INTENT( OUT) :: IntWrapIndx - - REAL(SiKi) :: Time_SiKi - REAL(SiKi) :: TimeMod - REAL(ReKi) :: InterpSlope - - Time_SiKi = REAL(Time, SiKi) - TimeMod = MOD(Time_SiKi, p%WaveTime(p%NStepWave)) !p%WaveTime starts at index 0, so it has p%NStepWave+1 elements - IF ( TimeMod <= p%WaveTime(1) ) THEN !second element - m%LastIndWave = 0 - END IF - - IF ( TimeMod <= p%WaveTime(0) ) THEN - m%LastIndWave = 0 - InterpSlope = 0.0_ReKi ! returns values at m%LastIndWave - IF(PRESENT(IntWrapIndx)) IntWrapIndx = 0 - ELSE IF ( TimeMod >= p%WaveTime(p%NStepWave) ) THEN - m%LastIndWave = p%NStepWave-1 - InterpSlope = 1.0_ReKi ! returns values at p%NStepWave - IF(PRESENT(IntWrapIndx)) IntWrapIndx = p%NStepWave - ELSE - m%LastIndWave = MAX( MIN( m%LastIndWave, p%NStepWave-1 ), 0 ) - - DO - - IF ( TimeMod < p%WaveTime(m%LastIndWave) ) THEN - - m%LastIndWave = m%LastIndWave - 1 - - ELSE IF ( TimeMod >= p%WaveTime(m%LastIndWave+1) ) THEN - - m%LastIndWave = m%LastIndWave + 1 - - ELSE - IF(PRESENT(IntWrapIndx)) IntWrapIndx = m%LastIndWave - - InterpSlope = ( TimeMod - p%WaveTime(m%LastIndWave) )/( p%WaveTime(m%LastIndWave+1) - p%WaveTime(m%LastIndWave) ) - RETURN ! stop checking DO loop - END IF - - END DO - - END IF - -END FUNCTION GetInterpolationSlope -!> Use in conjunction with GetInterpolationSlope, to replace InterpWrappedStpReal here. -FUNCTION InterpolateWithSlope(InterpSlope, Ind, YAry) - REAL(ReKi), INTENT(IN) :: InterpSlope - INTEGER(IntKi), INTENT(IN ) :: Ind !< Misc/optimization variables - REAL(SiKi), INTENT(IN) :: YAry(0:) - REAL(ReKi) :: InterpolateWithSlope - - InterpolateWithSlope = ( YAry(Ind+1) - YAry(Ind) )*InterpSlope + YAry(Ind) - -END FUNCTION InterpolateWithSlope -!> Use in conjunction with GetInterpolationSlope, to replace InterpWrappedStpReal here. -FUNCTION InterpolateWithSlopeR(InterpSlope, Ind, YAry) - REAL(ReKi), INTENT(IN) :: InterpSlope - INTEGER(IntKi), INTENT(IN ) :: Ind !< Misc/optimization variables - REAL(ReKi), INTENT(IN) :: YAry(0:) - REAL(ReKi) :: InterpolateWithSlopeR - - InterpolateWithSlopeR = ( YAry(Ind+1) - YAry(Ind) )*InterpSlope + YAry(Ind) - -END FUNCTION InterpolateWithSlopeR !---------------------------------------------------------------------------------------------------------------------------------- !> Routine for computing outputs, used in both loose and tight coupling. SUBROUTINE Morison_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, errStat, errMsg ) @@ -2664,183 +2511,198 @@ SUBROUTINE Morison_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, errStat, INTEGER(IntKi), INTENT( OUT) :: errStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: errMsg !< Error message if errStat /= ErrID_None - ! Local variables - + ! 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 = 'Morison_CalcOutput' - REAL(ReKi) :: F_DP(6), kvec(3), v(3), vf(3), vrel(3), vmag - INTEGER :: I, J, K, nodeIndx, IntWrapIndx - REAL(ReKi) :: AllOuts(MaxMrsnOutputs) - REAL(ReKi) :: qdotdot(6) ,qdotdot2(3) ! The structural acceleration of a mesh node - !REAL(ReKi) :: accel_fluid(6) ! Acceleration of fluid at the mesh node - REAL(ReKi) :: dragFactor ! The lumped drag factor - REAL(ReKi) :: AnProd ! Dot product of the directional area of the joint - REAL(ReKi) :: C(3,3) - REAL(ReKi) :: sgn - REAL(ReKi) :: D_AM_M(6,6) - REAL(ReKi) :: nodeInWater - REAL(ReKi) :: D_dragConst ! The distributed drag factor - REAL(ReKi) :: InterpolationSlope - - + REAL(ReKi) :: vmag, vmagf + INTEGER :: I, J + REAL(ReKi) :: qdotdot(6) ! The structural acceleration of a mesh node TYPE(Morison_MemberType) :: mem ! the current member INTEGER :: N ! Number of elements within a given member REAL(ReKi) :: dl ! Element length within a given member, m REAL(ReKi) :: vec(3) ! Vector pointing from a member's 1st node to its last node REAL(ReKi) :: phi, phi1, phi2 ! member tilt angle - REAL(ReKi) :: beta ! member tilt heading - real(ReKi) :: vecLen ! distance between member end nodes (joints) [this should never be zero but we test for it just in case] REAL(ReKi) :: cosPhi, cosPhi1, cosPhi2 REAL(ReKi) :: sinPhi, sinPhi1, sinPhi2 REAL(ReKi) :: tanPhi REAL(ReKi) :: sinBeta, sinBeta1, sinBeta2 REAL(ReKi) :: cosBeta, cosBeta1, cosBeta2 - real(ReKi) :: CMatrix(3,3), CTrans(3,3) ! Direction cosine matrix for element, and its transpose + REAL(ReKi) :: CMatrix(3,3), CTrans(3,3) ! Direction cosine matrix for element, and its transpose REAL(ReKi) :: z1 REAL(ReKi) :: z2 REAL(ReKi) :: r1 REAL(ReKi) :: r2 - real(ReKi) :: p1(3), p2(3) + REAL(ReKi) :: r1b + REAL(ReKi) :: r2b + REAL(ReKi) :: rMidb REAL(ReKi) :: dRdl_mg ! shorthand for taper including marine growth of element i - REAL(ReKi) :: Rmid - REAL(ReKi) :: RmidMG - REAL(ReKi) :: Rmidin - REAL(ReKi) :: Lmid - real(ReKi) :: g ! gravity constant - REAL(ReKi) :: h0 ! distances along cylinder centerline from point 1 to the waterplane - real(ReKi) :: k_hat(3), k_hat1(3), k_hat2(3) ! Elemental unit vector pointing from 1st node to 2nd node of the element - REAL(ReKi) :: rh ! radius of cylinder at point where its centerline crosses the waterplane - REAL(ReKi) :: l1 ! distance from cone end to bottom node - REAL(ReKi) :: Vs ! segment submerged volume - REAL(ReKi) :: a0 ! waterplane ellipse shape - REAL(ReKi) :: b0 - REAL(ReKi) :: cr ! centroid of segment submerged volume relative to its lower node - REAL(ReKi) :: cl - REAL(ReKi) :: cx - REAL(ReKi) :: cz - REAL(ReKi) :: pwr ! exponent for buoyancy node distribution smoothing - REAL(ReKi) :: alpha ! final load distribution factor for element - REAL(ReKi) :: Fb !buoyant force + REAL(ReKi) :: dRdl_mg_b ! shorthand for taper including marine growth of element i with radius scaling by sqrt(Cb) + REAL(ReKi) :: RMGFSInt ! Member radius with marine growth at the intersection with the instantaneous free surface + REAL(ReKi) :: g ! gravity constant + REAL(ReKi) :: k_hat(3), k_hat1(3), k_hat2(3) ! Elemental unit vector pointing from 1st node to 2nd node of the element + REAL(ReKi) :: n_hat(3) REAL(ReKi) :: Fr !radial component of buoyant force REAL(ReKi) :: Fl !axial component of buoyant force REAL(ReKi) :: Moment !moment induced about the center of the cylinder's bottom face - REAL(ReKi) :: BuoyF(3) ! buoyancy force vector aligned with an element - REAL(ReKi) :: BuoyM(3) ! buoyancy moment vector aligned with an element - integer(IntKi) :: im ! counter - real(ReKi) :: a_s1(3) - real(ReKi) :: alpha_s1(3) - real(ReKi) :: omega_s1(3) - real(ReKi) :: a_s2(3) - real(ReKi) :: alpha_s2(3) - real(ReKi) :: omega_s2(3) - real(ReKi) :: pos1(3), pos2(3) - real(ReKi) :: Imat(3,3) - real(ReKi) :: iArm(3), iTerm(3), Ioffset, h_c, dRdl_p, dRdl_pp, f_hydro(3), Am(3,3), lstar, deltal - real(ReKi) :: C_1, C_2, a0b0, z1d, z2d, h - real(ReKi) :: F_WMG(6), F_IMG(6), F_If(6), F_A(6), F_I(6), F_D(6), F_B1(6), F_B2(6) - - ! Initialize errStat - + INTEGER(IntKi) :: im ! counter + REAL(ReKi) :: a_s1(3) + REAL(ReKi) :: alpha_s1(3) + REAL(ReKi) :: omega_s1(3) + REAL(ReKi) :: a_s2(3) + REAL(ReKi) :: alpha_s2(3) + REAL(ReKi) :: omega_s2(3) + REAL(ReKi) :: pos1(3), pos2(3) + REAL(ReKi) :: Imat(3,3) + REAL(ReKi) :: iArm(3), iTerm(3), Ioffset, h_c, dRdl_p, dRdl_pp, f_hydro(3), Am(3,3), lstar, deltal, deltalLeft, deltalRight + REAL(ReKi) :: h, h_c_AM, deltal_AM + REAL(ReKi) :: F_WMG(6), F_IMG(6), F_If(6), F_B0(6), F_B1(6), F_B2(6), F_B_End(6) + REAL(ReKi) :: AM_End(3,3), An_End(3), DP_Const_End(3), I_MG_End(3,3) + + ! Local variables needed for wave stretching and load smoothing/redistribution + INTEGER(IntKi) :: FSElem + REAL(ReKi) :: SubRatio + REAL(ReKi) :: Zeta1 + REAL(ReKi) :: Zeta2 + REAL(ReKi) :: FSInt(3) + REAL(ReKi) :: F_D0(3) + REAL(ReKi) :: F_A0(3) + REAL(ReKi) :: F_I0(3) + REAL(ReKi) :: F_0(3) + REAL(ReKi) :: F_DS(3) + REAL(ReKi) :: F_AS(3) + REAL(ReKi) :: F_IS(3) + REAL(ReKi) :: F_S(3) + REAL(ReKi) :: f_redist + REAL(ReKi) :: Df_hydro(3) + REAL(ReKi) :: DM_hydro(3) + REAL(ReKi) :: Df_hydro_lumped(6) + REAL(ReKi) :: FVFSInt(3) + REAL(ReKi) :: FAFSInt(3) + REAL(ReKi) :: FDynPFSInt + REAL(ReKi) :: vrelFSInt(3) + REAL(ReKi) :: FAMCFFSInt(3) + INTEGER(IntKi) :: MemSubStat, NumFSX + REAL(DbKi) :: theta1, theta2 + REAL(ReKi) :: y_hat(3), z_hat(3), posMid(3), zetaMid, FSPt(3) + INTEGER(IntKi) :: secStat + INTEGER(IntKi) :: nodeInWater + REAL(SiKi) :: WaveElev1, WaveElev2, WaveElev, FDynP, FV(3), FA(3), FAMCF(3) + LOGICAL :: Is1stElement + + ! Initialize errStat errStat = ErrID_None errMsg = "" Imat = 0.0_ReKi g = p%Gravity - InterpolationSlope = GetInterpolationSlope(Time, p, m, IntWrapIndx) - !=============================================================================================== - ! Calculate the fluid kinematics at all mesh nodes and store for use in the equations below - - do j = 1, p%NNodes - m%nodeInWater(j) = REAL( p%nodeInWater(IntWrapIndx,j), ReKi ) - - ! Determine the dynamic pressure at the node - m%FDynP(j) = InterpolateWithSlope(InterpolationSlope, m%LastIndWave, p%WaveDynP(:,j)) - do i=1,3 - ! Determine the fluid acceleration and velocity and relative structural velocity at the node - m%FA(i,j) = InterpolateWithSlope(InterpolationSlope, m%LastIndWave, p%WaveAcc(:,j,i)) - - m%FV(i,j) = InterpolateWithSlope(InterpolationSlope, m%LastIndWave, p%WaveVel(:,j,i)) - m%vrel(i,j) = m%FV(i,j) - u%Mesh%TranslationVel(i,j) - end do - end do + ! Get displaced positions of the hydrodynamic nodes + CALL GetDisplacedNodePosition( .FALSE., m%DispNodePosHdn ) ! For hydrodynamic loads; depends on WaveDisp and WaveStMod + CALL GetDisplacedNodePosition( .TRUE. , m%DispNodePosHst ) ! For hydrostatic loads; always use actual displaced position + !=============================================================================================== + ! Calculate the fluid kinematics at all mesh nodes and store for use in the equations below + CALL WaveField_GetWaveKin( p%WaveField, m%WaveField_m, Time, m%DispNodePosHdn, .FALSE., m%nodeInWater, m%WaveElev1, m%WaveElev2, m%WaveElev, m%FDynP, m%FV, m%FA, m%FAMCF, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ! Compute fluid velocity relative to the structure + DO j = 1, p%NNodes + m%vrel(:,j) = ( m%FV(:,j) - u%Mesh%TranslationVel(:,j) ) * m%nodeInWater(j) + END DO + ! ============================================================================================== ! Calculate instantaneous loads on each member except for the hydrodynamic loads on member ends. ! This covers aspects of the load calculations previously in CreateDistributedMesh. ! Zero out previous time-steps loads (these are loads which are computed at the member-level and summed onto a node, ! so they need to be zeroed out before the summations happen) - !m%F_WMG = 0.0_ReKi - !m%F_IMG = 0.0_ReKi - m%F_BF_End= 0.0_ReKi - !m%F_If = 0.0_ReKi - !m%F_D = 0.0_ReKi - !m%F_A = 0.0_ReKi - !m%F_I = 0.0_ReKi - !m%F_B = 0.0_ReKi - !m%F_BF = 0.0_ReKi - m%F_B_End = 0.0_ReKi + m%F_BF_End = 0.0_ReKi + m%F_B_End = 0.0_ReKi y%Mesh%Force = 0.0_ReKi y%Mesh%Moment = 0.0_ReKi ! Loop through each member DO im = 1, p%NMembers - N = p%Members(im)%NElements - mem = p%Members(im) !@mhall: does this have much overhead? + N = p%Members(im)%NElements + mem = p%Members(im) + call YawMember(mem, u%PtfmRefY, ErrStat2, ErrMsg2) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) !zero member loads - m%memberLoads(im)%F_B = 0.0_ReKi - m%memberLoads(im)%F_BF = 0.0_ReKi - m%memberLoads(im)%F_D = 0.0_ReKi - m%memberLoads(im)%F_A = 0.0_ReKi - m%memberLoads(im)%F_I = 0.0_ReKi + m%memberLoads(im)%F_B = 0.0_ReKi + m%memberLoads(im)%F_BF = 0.0_ReKi + m%memberLoads(im)%F_D = 0.0_ReKi + m%memberLoads(im)%F_A = 0.0_ReKi + m%memberLoads(im)%F_I = 0.0_ReKi m%memberLoads(im)%F_WMG = 0.0_ReKi m%memberLoads(im)%F_IMG = 0.0_ReKi - m%memberLoads(im)%F_If = 0.0_ReKi - - DO i =1,N ! loop through member elements - - ! calculate isntantaneous incline angle and heading, and related trig values - ! the first and last NodeIndx values point to the corresponding Joint nodes idices which are at the start of the Mesh - - pos1 = u%Mesh%TranslationDisp(:, mem%NodeIndx(i)) + u%Mesh%Position(:, mem%NodeIndx(i)) - pos1(3) = pos1(3) - p%MSL2SWL - pos2 = u%Mesh%TranslationDisp(:, mem%NodeIndx(i+1)) + u%Mesh%Position(:, mem%NodeIndx(i+1)) - pos2(3) = pos2(3) - p%MSL2SWL + m%memberLoads(im)%F_If = 0.0_ReKi + + ! Determine member submergence status + IF ( p%WaveField%WaveStMod .EQ. 0_IntKi ) THEN ! No wave stretching - Only need to check the two ends + IF ( m%nodeInWater(mem%NodeIndx(1)) .NE. m%nodeInWater(mem%NodeIndx(N+1)) ) THEN + MemSubStat = 1_IntKi ! Member centerline crosses the SWL once + ELSE IF ( m%nodeInWater(mem%NodeIndx(1)) .EQ. 0_IntKi ) THEN + MemSubStat = 3_IntKi ! Member centerline completely above water + ELSE + MemSubStat = 0_IntKi ! Member centerline fully submerged + END IF + ELSE IF ( p%WaveField%WaveStMod > 0_IntKi ) THEN ! Has wave stretching - Need to check every node + NumFSX = 0_IntKi ! Number of free-surface crossing + DO i = 1, N ! loop through member elements + IF ( m%nodeInWater(mem%NodeIndx(i)) .NE. m%nodeInWater(mem%NodeIndx(i+1)) ) THEN + NumFSX = NumFSX + 1 + END IF + END DO + IF (NumFSX .EQ. 1_IntKi) THEN + MemSubStat = 1_IntKi ! Member centerline crosses the free surface once + ELSE IF (NumFSX .GT. 1_IntKi) THEN + MemSubStat = 2_IntKi ! Member centerline crosses the free surface multiple time + ELSE ! Member centerline does not cross the free surface + IF ( m%nodeInWater(mem%NodeIndx(1)) .EQ. 0_IntKi ) THEN + MemSubStat = 3_IntKi ! Member centerline completely above water + ELSE + MemSubStat = 0_IntKi ! Member centerline completely submerged + END IF + END IF + END IF - call GetOrientationAngles( pos1, pos2, phi, sinPhi, cosPhi, tanPhi, sinBeta, cosBeta, k_hat, errStat2, errMsg2 ) - call Morison_DirCosMtrx( pos1, pos2, CMatrix ) - CTrans = transpose(CMatrix) - ! save some commonly used variables - dl = mem%dl - z1 = pos1(3) ! get node z locations from input mesh - z2 = pos2(3) - r1 = mem%RMG(i ) ! outer radius element nodes including marine growth - r2 = mem%RMG(i+1) - dRdl_mg = mem%dRdl_mg(i) ! Taper of element including marine growth - a_s1 = u%Mesh%TranslationAcc(:, mem%NodeIndx(i )) - alpha_s1= u%Mesh%RotationAcc (:, mem%NodeIndx(i )) - omega_s1= u%Mesh%RotationVel (:, mem%NodeIndx(i )) - a_s2 = u%Mesh%TranslationAcc(:, mem%NodeIndx(i+1)) - alpha_s2= u%Mesh%RotationAcc (:, mem%NodeIndx(i+1)) - omega_s2= u%Mesh%RotationVel (:, mem%NodeIndx(i+1)) - - if ( .not. mem%PropPot ) then ! Member is NOT modeled with Potential Flow Theory + !---------------- Marine growth and Buoyancy: Sides: Only if member not modeled with potential flow theory ---------------- + IF ( .NOT. mem%PropPot ) THEN ! Member is NOT modeled with Potential Flow Theory + DO i = max(mem%i_floor,1), N ! loop through member elements that are not completely buried in the seabed - ! should i_floor theshold be applied to below calculations to avoid wasting time on computing zero-valued things? <<<<< - ! should lumped half-element coefficients get combined at initialization? <<< + ! calculate instantaneous incline angle and heading, and related trig values + ! the first and last NodeIndx values point to the corresponding Joint nodes indices which are at the start of the Mesh + pos1 = m%DispNodePosHst(:, mem%NodeIndx(i )) + pos2 = m%DispNodePosHst(:, mem%NodeIndx(i+1)) + + call GetOrientationAngles( pos1, pos2, phi, sinPhi, cosPhi, tanPhi, sinBeta, cosBeta, k_hat, errStat2, errMsg2 ) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + call Morison_DirCosMtrx( pos1, pos2, CMatrix ) + CTrans = transpose(CMatrix) + ! save some commonly used variables + dl = mem%dl + z1 = pos1(3) ! get node z locations from input mesh + z2 = pos2(3) + r1 = mem%RMG(i ) ! outer radius at element nodes including marine growth + r2 = mem%RMG(i+1) + r1b = mem%RMGB(i ) ! outer radius at element nodes including marine growth scaled by sqrt(Cb) + r2b = mem%RMGB(i+1) + dRdl_mg = mem%dRdl_mg(i) ! Taper of element including marine growth + dRdl_mg_b = mem%dRdl_mg_b(i) ! Taper of element including marine growth with radius scaling by sqrt(Cb) + a_s1 = u%Mesh%TranslationAcc(:, mem%NodeIndx(i )) + alpha_s1 = u%Mesh%RotationAcc (:, mem%NodeIndx(i )) + omega_s1 = u%Mesh%RotationVel (:, mem%NodeIndx(i )) + a_s2 = u%Mesh%TranslationAcc(:, mem%NodeIndx(i+1)) + alpha_s2 = u%Mesh%RotationAcc (:, mem%NodeIndx(i+1)) + omega_s2 = u%Mesh%RotationVel (:, mem%NodeIndx(i+1)) ! ------------------ marine growth: Sides: Section 4.1.2 -------------------- F_WMG = 0.0_ReKi ! lower node - !m%F_WMG(3, mem%NodeIndx(i )) = m%F_WMG(3, mem%NodeIndx(i )) - mem%m_mg_l(i)*g ! weight force : Note: this is a constant - !m%F_WMG(4, mem%NodeIndx(i )) = m%F_WMG(4, mem%NodeIndx(i )) - mem%m_mg_l(i)*g * mem%h_cmg_l(i)* sinPhi * sinBeta! weight force - !m%F_WMG(5, mem%NodeIndx(i )) = m%F_WMG(5, mem%NodeIndx(i )) + mem%m_mg_l(i)*g * mem%h_cmg_l(i)* sinPhi * cosBeta! weight force - F_WMG(3) = - mem%m_mg_l(i)*g ! weight force : Note: this is a constant F_WMG(4) = - mem%m_mg_l(i)*g * mem%h_cmg_l(i)* sinPhi * sinBeta! weight force F_WMG(5) = mem%m_mg_l(i)*g * mem%h_cmg_l(i)* sinPhi * cosBeta! weight force @@ -2849,9 +2711,6 @@ SUBROUTINE Morison_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, errStat, y%Mesh%Moment(:,mem%NodeIndx(i)) = y%Mesh%Moment(:,mem%NodeIndx(i)) + F_WMG(4:6) ! upper node - !m%F_WMG(3, mem%NodeIndx(i+1)) = m%F_WMG(3, mem%NodeIndx(i+1)) - mem%m_mg_u(i)*g ! weight force : Note: this is a constant - !m%F_WMG(4, mem%NodeIndx(i+1)) = m%F_WMG(4, mem%NodeIndx(i+1)) - mem%m_mg_u(i)*g * mem%h_cmg_u(i)* sinPhi * sinBeta! weight force - !m%F_WMG(5, mem%NodeIndx(i+1)) = m%F_WMG(5, mem%NodeIndx(i+1)) + mem%m_mg_u(i)*g * mem%h_cmg_u(i)* sinPhi * cosBeta! weight force F_WMG(3) = - mem%m_mg_u(i)*g ! weight force : Note: this is a constant F_WMG(4) = - mem%m_mg_u(i)*g * mem%h_cmg_u(i)* sinPhi * sinBeta! weight force F_WMG(5) = mem%m_mg_u(i)*g * mem%h_cmg_u(i)* sinPhi * cosBeta! weight force @@ -2861,17 +2720,13 @@ SUBROUTINE Morison_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, errStat, ! lower node Ioffset = mem%h_cmg_l(i)*mem%h_cmg_l(i)*mem%m_mg_l(i) + Imat = 0.0_ReKi Imat(1,1) = mem%I_rmg_l(i) - Ioffset Imat(2,2) = mem%I_rmg_l(i) - Ioffset - Imat(3,3) = mem%I_lmg_l(i) - Ioffset + Imat(3,3) = mem%I_lmg_l(i) Imat = matmul(matmul(CMatrix, Imat), CTrans) iArm = mem%h_cmg_l(i) * k_hat iTerm = ( -a_s1 - cross_product(omega_s1, cross_product(omega_s1,iArm )) - cross_product(alpha_s1,iArm) ) * mem%m_mg_l(i) - !m%F_IMG(1:3, mem%NodeIndx(i )) = m%F_IMG(1:3, mem%NodeIndx(i )) + iTerm - !m%F_IMG(4:6, mem%NodeIndx(i )) = m%F_IMG(4:6, mem%NodeIndx(i )) & - ! - cross_product(a_s1 * mem%m_mg_l(i), mem%h_cmg_l(i) * k_hat) & - ! + matmul(Imat, alpha_s1) & - ! - cross_product(omega_s1,matmul(Imat,omega_s1)) F_IMG(1:3) = iTerm F_IMG(4:6) = - cross_product(a_s1 * mem%m_mg_l(i), mem%h_cmg_l(i) * k_hat) + matmul(Imat, alpha_s1) & - cross_product(omega_s1,matmul(Imat,omega_s1)) @@ -2881,17 +2736,13 @@ SUBROUTINE Morison_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, errStat, ! upper node Ioffset = mem%h_cmg_u(i)*mem%h_cmg_u(i)*mem%m_mg_u(i) + Imat = 0.0_ReKi Imat(1,1) = mem%I_rmg_u(i) - Ioffset Imat(2,2) = mem%I_rmg_u(i) - Ioffset - Imat(3,3) = mem%I_lmg_u(i) - Ioffset + Imat(3,3) = mem%I_lmg_u(i) Imat = matmul(matmul(CMatrix, Imat), CTrans) iArm = mem%h_cmg_u(i) * k_hat iTerm = ( -a_s2 - cross_product(omega_s2, cross_product(omega_s2,iArm )) - cross_product(alpha_s2,iArm) ) * mem%m_mg_u(i) - !m%F_IMG(1:3, mem%NodeIndx(i+1)) = m%F_IMG(1:3, mem%NodeIndx(i+1)) + iTerm - !m%F_IMG(4:6, mem%NodeIndx(i+1)) = m%F_IMG(4:6, mem%NodeIndx(i+1)) & - ! - cross_product(a_s2 * mem%m_mg_u(i), mem%h_cmg_u(i) * k_hat) & - ! + matmul(Imat, alpha_s2) & - ! - cross_product(omega_s2,matmul(Imat,omega_s2)) F_IMG(1:3) = iTerm F_IMG(4:6) = - cross_product(a_s2 * mem%m_mg_u(i), mem%h_cmg_u(i) * k_hat) + matmul(Imat, alpha_s2) & - cross_product(omega_s2,matmul(Imat,omega_s2)) @@ -2900,152 +2751,97 @@ SUBROUTINE Morison_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, errStat, y%Mesh%Moment(:,mem%NodeIndx(i+1)) = y%Mesh%Moment(:,mem%NodeIndx(i+1)) + F_IMG(4:6) ! ------------------- buoyancy loads: sides: Sections 3.1 and 3.2 ------------------------ - -!TODO: What about elements which are buried in the seabed? This doesn't seem to be tested for - if (z1 < 0) then ! if segment is at least partially submerged ... - - - if (z1*z2 <= 0) then ! special calculation if the slice is partially submerged - - ! Check that this is not the 1st element of the member - if ( i == 1 ) then - call SeterrStat(ErrID_Fatal, 'The lowest element of a Morison member has become partially submerged! This is not allowed. Please review your model and create a discretization such that even with displacements, the lowest element of a member does not become partially submerged.', errStat, errMsg, 'Morison_CalcOutput' ) - return - end if - - h0 = -z1/cosPhi ! distances along element centerline from point 1 to the waterplane - - - if (abs(dRdl_mg) < 0.0001) then ! untapered cylinder case - - Vs = Pi*r1*r1*h0 ! volume of total submerged portion - if ( EqualRealNos(Vs, 0.0_ReKi) ) then - cx = 0.0_ReKi ! Avoid singularity, but continue to provide the correct solution - else - cr = 0.25*r1*r1*tanPhi/h0 - cl = 0.5*h0 + 0.125*r1*r1*tanPhi*tanPhi/h0 - cx = cr*cosPhi + cl*sinPhi - end if - - !alpha0 = 0.5*h0/dl ! force distribution between end nodes - - else ! inclined tapered cylinder case (note I've renamed r0 to rh here!!) - !=================== - !Per plan equations - ! NOTE: Variable changes of Plan vs Code - !--------------------------------------------------- - ! V Vs - ! a_h a0 - ! b_h b0 - ! x_c cx - ! h h0 - ! r1 r_MG,i - ! r_c cr - ! h_c cl - ! NOTE: a0 and b0 always appear as a0b0, never separately. - rh = r1 + h0*dRdl_mg ! radius of element at point where its centerline crosses the waterplane - C_1 = 1.0_ReKi - dRdl_mg**2 * tanPhi**2 - ! waterplane ellipse shape - b0 = rh/sqrt(C_1) - a0 = rh/((C_1)*cosPhi) ! simplified from what's in ConicalCalcs.ipynb - a0b0 = a0*b0 - C_2 = a0b0*rh*cosPhi - r1**3 - cl = -(-0.75*a0b0*rh**2*cosPhi + 0.75*r1**4*C_1 + r1*C_1*C_2) / (dRdl_mg*C_1*C_2) - cr = (0.75*a0b0*dRdl_mg*rh**2*sinPhi)/(C_1*C_2) - cx = cr*cosPhi + cl*sinPhi - Vs = pi*(a0b0*rh*cosPhi - r1**3)/(3.0*dRdl_mg) - - ! End per plan equations - !=================== - - !rh = r1 + h0*dRdl_mg ! radius of element at point where its centerline crosses the waterplane - !l1 = r1/dRdl_mg ! distance from cone end to bottom node - ! - !! waterplane ellipse shape - !b0 = rh/sqrt(1 - dRdl_mg**2 * tanPhi**2) - !a0 = rh/((1 - dRdl_mg**2*tanPhi**2)*cosPhi) ! simplified from what's in ConicalCalcs.ipynb - ! - !! segment submerged volume - !!Vs = pi*(a0*b0*rh*cosPhi - l1**3*dRdl_mg**3)/(3*dRdl_mg) !Original code - !Vs = pi*(a0*b0*rh*cosPhi - r1**3)/(3*dRdl_mg) !Plan doc - ! - !! centroid of segment submerged volume (relative to bottom node) - !cx = -0.25*(3*a0*b0*rh*rh*(dRdl_mg**2 + 1)*cosPhi + 3.0*l1**4*dRdl_mg**4*(dRdl_mg**2*tanPhi**2 - 1) + 4*l1*dRdl_mg*(dRdl_mg**2*tanPhi**2 - 1)*(a0*b0*rh*cosPhi - 1.0*l1**3*dRdl_mg**3))*sin(phi)/(dRdl_mg*(dRdl_mg**2*tanPhi**2 - 1)*(a0*b0*rh*cosPhi - l1**3*dRdl_mg**3)) - - !alpha0 = (r1*r1 + 2*r1*r2 + 3*r2**2)/4/(r1*r1 + r1*r2 + r2**2) ! this can be precomputed - - end if - - pwr = 3 - alpha = (1.0-mem%alpha(i))*z1**pwr/(-mem%alpha(i)*z2**pwr + (1.0-mem%alpha(i))*z1**pwr) - - Fb = Vs*p%WtrDens*g !buoyant force - Fr = -Fb*sinPhi !radial component of buoyant force - Fl = Fb*cosPhi !axial component of buoyant force - Moment = -Fb*cx !This was matt's code !moment induced about the center of the cylinder's bottom face - - ! calculate (imaginary) bottom plate forces/moment to subtract from displacement-based values - Fl = Fl + p%WtrDens*g*z1* Pi *r1*r1 - Moment = Moment + p%WtrDens*g* sinPhi * Pi/4.0*r1**4 - - - ! reduce taper-based moment to remove (not double count) radial force distribution to each node - Moment = Moment + Fr*(1.0_ReKi-alpha)*dl - !call DistributeElementLoads(Fl, Fr, Moment, sinPhi, cosPhi, sinBeta, cosBeta, alpha, m%F_B(:, mem%NodeIndx(i)), m%F_B(:, mem%NodeIndx(i-1))) - call DistributeElementLoads(Fl, Fr, Moment, sinPhi, cosPhi, sinBeta, cosBeta, alpha, F_B1, F_B2) - m%memberLoads(im)%F_B(:, i) = m%memberLoads(im)%F_B(:, i) + F_B1 ! alpha - m%memberLoads(im)%F_B(:, i-1) = m%memberLoads(im)%F_B(:, i-1) + F_B2 ! 1-alpha - y%Mesh%Force (:,mem%NodeIndx(i )) = y%Mesh%Force (:,mem%NodeIndx(i )) + F_B1(1:3) - y%Mesh%Moment(:,mem%NodeIndx(i )) = y%Mesh%Moment(:,mem%NodeIndx(i )) + F_B1(4:6) - y%Mesh%Force (:,mem%NodeIndx(i-1)) = y%Mesh%Force (:,mem%NodeIndx(i-1)) + F_B2(1:3) - y%Mesh%Moment(:,mem%NodeIndx(i-1)) = y%Mesh%Moment(:,mem%NodeIndx(i-1)) + F_B2(4:6) - else ! normal, fully submerged case - - Fl = -2.0*Pi*dRdl_mg*p%WtrDens*g*dl*( z1*r1 + 0.5*(z1*dRdl_mg + r1*cosPhi)*dl + 1.0/3.0*(dRdl_mg*cosPhi*dl*dl) ) ! from CylinderCalculationsR1.ipynb - - Fr = -Pi*p%WtrDens*g*dl*(r1*r1 + dRdl_mg*r1*dl + (dRdl_mg**2*dl**2)/3.0)*sinPhi ! from CylinderCalculationsR1.ipynb - Moment = -Pi*dl*g*p%WtrDens*(3.0*dl**3*dRdl_mg**4 + 3.0*dl**3*dRdl_mg**2 + 12.0*dl**2*dRdl_mg**3*r1 + 8.0*dl**2*dRdl_mg*r1 + 18.0*dl*dRdl_mg**2*r1*r1 + 6.0*dl*r1*r1 + 12.0*dRdl_mg*r1**3)*sinPhi/12.0 ! latest from CylinderCalculationsR1.ipynb - - ! precomputed as mem%alpha(i) ... alpha0 = (r1*r1 + 2*r1*r2 + 3*r2**2)/4/(r1*r1 + r1*r2 + r2**2) - !TODO: Review the below alpha eqn, GJH - z1d = -min(0.0_ReKi,z1) - z2d = -min(0.0_ReKi,z2) - - pwr = 3 - alpha = mem%alpha(i)*z2d**pwr/(mem%alpha(i)*z2d**pwr+(1-mem%alpha(i))*z1d**pwr) - - - ! reduce moment to remove (not double count) radial force distribution to each node - Moment = Moment - Fr*alpha*dl - ! TODO: Should the order be, i, i+1 GJH - !call DistributeElementLoads(Fl, Fr, Moment, sinPhi, cosPhi, sinBeta, cosBeta, alpha, m%F_B(:, mem%NodeIndx(i+1)), m%F_B(:, mem%NodeIndx(i))) - call DistributeElementLoads(Fl, Fr, Moment, sinPhi, cosPhi, sinBeta, cosBeta, alpha, F_B1, F_B2) - m%memberLoads(im)%F_B(:,i+1) = m%memberLoads(im)%F_B(:,i+1) + F_B1 ! alpha - m%memberLoads(im)%F_B(:, i) = m%memberLoads(im)%F_B(:, i) + F_B2 ! 1-alpha - y%Mesh%Force (:,mem%NodeIndx(i )) = y%Mesh%Force (:,mem%NodeIndx(i )) + F_B2(1:3) - y%Mesh%Moment(:,mem%NodeIndx(i )) = y%Mesh%Moment(:,mem%NodeIndx(i )) + F_B2(4:6) - y%Mesh%Force (:,mem%NodeIndx(i+1)) = y%Mesh%Force (:,mem%NodeIndx(i+1)) + F_B1(1:3) - y%Mesh%Moment(:,mem%NodeIndx(i+1)) = y%Mesh%Moment(:,mem%NodeIndx(i+1)) + F_B1(4:6) - end if ! submergence cases - - end if ! element at least partially submerged + IF (mem%MHstLMod == 1) THEN + IF ( p%WaveField%WaveStMod > 0_IntKi ) THEN ! If wave stretching is enabled, compute buoyancy up to free surface + CALL GetTotalWaveElev( Time, pos1, Zeta1, ErrStat2, ErrMsg2 ) + CALL GetTotalWaveElev( Time, pos2, Zeta2, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ELSE ! Without wave stretching, compute buoyancy based on SWL + Zeta1 = 0.0_ReKi + Zeta2 = 0.0_ReKi + END IF + Is1stElement = ( i .EQ. 1) + CALL getElementHstLds_Mod1( Time, pos1, pos2, Zeta1, Zeta2, k_hat, r1b, r2b, dl, mem%alpha(i), Is1stElement, F_B0, F_B1, F_B2, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ! Add nodal loads to mesh + IF ( .NOT. Is1stElement ) THEN + m%memberLoads(im)%F_B(:, i-1) = m%memberLoads(im)%F_B(:, i-1) + F_B0 + y%Mesh%Force (:,mem%NodeIndx(i-1)) = y%Mesh%Force (:,mem%NodeIndx(i-1)) + F_B0(1:3) + y%Mesh%Moment(:,mem%NodeIndx(i-1)) = y%Mesh%Moment(:,mem%NodeIndx(i-1)) + F_B0(4:6) + END IF + m%memberLoads(im)%F_B(:, i ) = m%memberLoads(im)%F_B(:, i ) + F_B1 + m%memberLoads(im)%F_B(:, i+1) = m%memberLoads(im)%F_B(:, i+1) + F_B2 + y%Mesh%Force (:,mem%NodeIndx(i )) = y%Mesh%Force (:,mem%NodeIndx(i )) + F_B1(1:3) + y%Mesh%Moment(:,mem%NodeIndx(i )) = y%Mesh%Moment(:,mem%NodeIndx(i )) + F_B1(4:6) + y%Mesh%Force (:,mem%NodeIndx(i+1)) = y%Mesh%Force (:,mem%NodeIndx(i+1)) + F_B2(1:3) + y%Mesh%Moment(:,mem%NodeIndx(i+1)) = y%Mesh%Moment(:,mem%NodeIndx(i+1)) + F_B2(4:6) + ELSE IF (mem%MHstLMod == 2) THEN ! Alternative hydrostatic load calculation + ! Get free surface elevation and normal at the element midpoint (both assumed constant over the element) + posMid = 0.5 * (pos1+pos2) + rMidb = 0.5 * (r1b +r2b ) + IF (p%WaveField%WaveStMod > 0) THEN + CALL GetTotalWaveElev( Time, posMid, ZetaMid, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL GetFreeSurfaceNormal( Time, posMid, rMidb, n_hat, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + FSPt = (/posMid(1),posMid(2),ZetaMid/) ! Reference point on the free surface + ELSE + FSPt = (/posMid(1),posMid(2),0.0_ReKi/) + n_hat = (/0.0,0.0,1.0/) + END IF + CALL GetSectionUnitVectors( k_hat, y_hat, z_hat ) + CALL getElementHstLds_Mod2( pos1, pos2, FSPt, k_hat, y_hat, z_hat, n_hat, r1b, r2b, dl, F_B1, F_B2, ErrStat2, ErrMsg2) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ! Add nodal loads to mesh + m%memberLoads(im)%F_B(:,i ) = m%memberLoads(im)%F_B(:,i ) + F_B1 + m%memberLoads(im)%F_B(:,i+1) = m%memberLoads(im)%F_B(:,i+1) + F_B2 + y%Mesh%Force (:,mem%NodeIndx(i )) = y%Mesh%Force (:,mem%NodeIndx(i )) + F_B1(1:3) + y%Mesh%Moment(:,mem%NodeIndx(i )) = y%Mesh%Moment(:,mem%NodeIndx(i )) + F_B1(4:6) + y%Mesh%Force (:,mem%NodeIndx(i+1)) = y%Mesh%Force (:,mem%NodeIndx(i+1)) + F_B2(1:3) + y%Mesh%Moment(:,mem%NodeIndx(i+1)) = y%Mesh%Moment(:,mem%NodeIndx(i+1)) + F_B2(4:6) + END IF ! MHstLMod + END DO ! i = max(mem%i_floor,1), N ! loop through member elements that are not fully buried in the seabed + END IF ! NOT Modeled with Potential flow theory + + ! --------------------------- flooded ballast: sides: Always compute regardless of PropPot setting ------------------------------ + DO i = max(mem%i_floor,1), N ! loop through member elements that are not completely buried in the seabed - end if ! NOT Modeled with Potential flow theory - - ! ------------------ flooded ballast inertia: sides: Section 6.1.1 : Always compute regardless of PropPot setting --------------------- + ! calculate instantaneous incline angle and heading, and related trig values + ! the first and last NodeIndx values point to the corresponding Joint nodes indices which are at the start of the Mesh + pos1 = m%DispNodePosHst(:,mem%NodeIndx(i )) + pos2 = m%DispNodePosHst(:,mem%NodeIndx(i+1)) + call GetOrientationAngles( pos1, pos2, phi, sinPhi, cosPhi, tanPhi, sinBeta, cosBeta, k_hat, errStat2, errMsg2 ) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + call Morison_DirCosMtrx( pos1, pos2, CMatrix ) + CTrans = transpose(CMatrix) + ! save some commonly used variables + dl = mem%dl + z1 = pos1(3) ! get node z locations from input mesh + z2 = pos2(3) + r1 = mem%RMG(i ) ! outer radius at element nodes including marine growth + r2 = mem%RMG(i+1) + r1b = mem%RMGB(i ) ! outer radius at element nodes including marine growth scaled by sqrt(Cb) + r2b = mem%RMGB(i+1) + dRdl_mg = mem%dRdl_mg(i) ! Taper of element including marine growth + dRdl_mg_b = mem%dRdl_mg_b(i) ! Taper of element including marine growth with radius scaling by sqrt(Cb) + a_s1 = u%Mesh%TranslationAcc(:, mem%NodeIndx(i )) + alpha_s1 = u%Mesh%RotationAcc (:, mem%NodeIndx(i )) + omega_s1 = u%Mesh%RotationVel (:, mem%NodeIndx(i )) + a_s2 = u%Mesh%TranslationAcc(:, mem%NodeIndx(i+1)) + alpha_s2 = u%Mesh%RotationAcc (:, mem%NodeIndx(i+1)) + omega_s2 = u%Mesh%RotationVel (:, mem%NodeIndx(i+1)) + + ! ------------------ flooded ballast inertia: sides: Section 6.1.1 : Always compute regardless of PropPot setting --------------------- ! lower node Ioffset = mem%h_cfb_l(i)*mem%h_cfb_l(i)*mem%m_fb_l(i) + Imat = 0.0_ReKi Imat(1,1) = mem%I_rfb_l(i) - Ioffset Imat(2,2) = mem%I_rfb_l(i) - Ioffset - Imat(3,3) = mem%I_lfb_l(i) - Ioffset + Imat(3,3) = mem%I_lfb_l(i) + Imat = matmul(matmul(CMatrix, Imat), CTrans) iArm = mem%h_cfb_l(i) * k_hat iTerm = ( -a_s1 - cross_product(omega_s1, cross_product(omega_s1,iArm )) - cross_product(alpha_s1,iArm) ) * mem%m_fb_l(i) - !m%F_If(1:3, mem%NodeIndx(i )) = m%F_If(1:3, mem%NodeIndx(i )) + iTerm - !m%F_If(4:6, mem%NodeIndx(i )) = m%F_If(4:6, mem%NodeIndx(i )) & - ! - cross_product(a_s1 * mem%m_fb_l(i), mem%h_cfb_l(i) * k_hat) & - ! + matmul(Imat, alpha_s1) & - ! - cross_product(omega_s1,matmul(Imat,omega_s1)) F_If(1:3) = iTerm F_If(4:6) = - cross_product(a_s1 * mem%m_fb_l(i), mem%h_cfb_l(i) * k_hat) + matmul(Imat, alpha_s1) & - cross_product(omega_s1,matmul(Imat,omega_s1)) @@ -3053,18 +2849,15 @@ SUBROUTINE Morison_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, errStat, y%Mesh%Force (:,mem%NodeIndx(i)) = y%Mesh%Force (:,mem%NodeIndx(i)) + F_If(1:3) y%Mesh%Moment(:,mem%NodeIndx(i)) = y%Mesh%Moment(:,mem%NodeIndx(i)) + F_If(4:6) - ! upper node + ! upper node Ioffset = mem%h_cfb_u(i)*mem%h_cfb_u(i)*mem%m_fb_u(i) + Imat = 0.0_ReKi Imat(1,1) = mem%I_rfb_u(i) - Ioffset Imat(2,2) = mem%I_rfb_u(i) - Ioffset - Imat(3,3) = mem%I_lfb_u(i) - Ioffset + Imat(3,3) = mem%I_lfb_u(i) + Imat = matmul(matmul(CMatrix, Imat), CTrans) iArm = mem%h_cfb_u(i) * k_hat iTerm = ( -a_s2 - cross_product(omega_s2, cross_product(omega_s2,iArm )) - cross_product(alpha_s2,iArm) ) * mem%m_fb_u(i) - !m%F_If(1:3, mem%NodeIndx(i+1)) = m%F_If(1:3, mem%NodeIndx(i+1)) + iTerm - !m%F_If(4:6, mem%NodeIndx(i+1)) = m%F_If(4:6, mem%NodeIndx(i+1)) & - ! - cross_product(a_s2 * mem%m_fb_u(i), mem%h_cfb_u(i) * k_hat) & - ! + matmul(Imat, alpha_s2) & - ! - cross_product(omega_s2,matmul(Imat,omega_s2)) F_If(1:3) = iTerm F_If(4:6) = - cross_product(a_s2 * mem%m_fb_u(i), mem%h_cfb_u(i) * k_hat) + matmul(Imat, alpha_s2) & - cross_product(omega_s2,matmul(Imat,omega_s2)) @@ -3092,12 +2885,10 @@ SUBROUTINE Morison_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, errStat, ( lstar*mem%Rin(i) + 0.5*(lstar*mem%dRdl_in(i) + mem%Rin(i) )*dl + mem%dRdl_in(i)*dl**2/3.0 )*cosphi ) ! forces and moment in tilted coordinates about node i - !Fl = mem%Cfl_fb(i)*cosPhi Fr = mem%Cfr_fb(i)*sinPhi Moment = mem%CM0_fb(i)*sinPhi - Fr*mem%alpha_fb_star(i)*dl ! calculate full vector and distribute to nodes - !call DistributeElementLoads(Fl, Fr, Moment, sinPhi, cosPhi, sinBeta, cosBeta, (1-mem%alpha_fb_star(i)), m%F_BF(:, mem%NodeIndx(i)), m%F_BF(:, mem%NodeIndx(i+1))) call DistributeElementLoads(Fl, Fr, Moment, sinPhi, cosPhi, sinBeta, cosBeta, (1-mem%alpha_fb_star(i)), F_B1, F_B2) m%memberLoads(im)%F_BF(:, i) = m%memberLoads(im)%F_BF(:, i) + F_B2 ! 1-alpha m%memberLoads(im)%F_BF(:, i+1) = m%memberLoads(im)%F_BF(:, i+1) + F_B1 ! alpha @@ -3115,7 +2906,6 @@ SUBROUTINE Morison_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, errStat, Moment = mem%CM0_fb(i)*sinPhi + Fr*(1 - mem%alpha_fb_star(i))*dl ! calculate full vector and distribute to nodes - !call DistributeElementLoads(Fl, Fr, Moment, sinPhi, cosPhi, sinBeta, cosBeta, mem%alpha_fb_star(i), m%F_BF(:, mem%NodeIndx(i)), m%F_BF(:, mem%NodeIndx(i-1))) call DistributeElementLoads(Fl, Fr, Moment, sinPhi, cosPhi, sinBeta, cosBeta, mem%alpha_fb_star(i), F_B1, F_B2) m%memberLoads(im)%F_BF(:, i) = m%memberLoads(im)%F_BF(:, i) + F_B1 ! alpha m%memberLoads(im)%F_BF(:, i-1) = m%memberLoads(im)%F_BF(:, i-1) + F_B2 ! 1- alpha @@ -3127,140 +2917,443 @@ SUBROUTINE Morison_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, errStat, ! no load for unflooded element or element fully below seabed end if - + + END DO ! i = max(mem%i_floor,1), N ! loop through member elements that are not fully buried in the seabed + + !-----------------------------------------------------------------------------------------------------! + ! External Hydrodynamic Side Loads - Start ! + !-----------------------------------------------------------------------------------------------------! + IF ( p%WaveField%WaveStMod > 0 .AND. MemSubStat == 1 .AND. (m%NodeInWater(mem%NodeIndx(N+1)).EQ.0_IntKi) ) THEN + !----------------------------Apply load smoothing----------------------------! + ! only when: + ! 1. wave stretching is enabled + ! 2. member centerline crosses the free surface exactly once + ! 3. the last node is out of water, which implies the first node is in water + + FSElem = -1 ! Initialize the No. of the partially wetted element as -1 + + DO i = mem%i_floor+1,N ! loop through member nodes starting from the first node above seabed, but skip the last node which should not be submerged anyways + + ! Get positions of node i and i+1 + pos1 = m%DispNodePosHdn(:,mem%NodeIndx(i )) + pos2 = m%DispNodePosHdn(:,mem%NodeIndx(i+1)) + ! Free surface elevation above or below node i and i+1 + Zeta1 = m%WaveElev(mem%NodeIndx(i)) + Zeta2 = m%WaveElev(mem%NodeIndx(i+1)) + + ! Compute deltal and h_c + IF ( i == 1 ) THEN ! First node + deltal = mem%dl/2.0_ReKi + h_c = mem%dl/4.0_ReKi + ELSE IF ( i == mem%i_floor + 1 ) THEN ! This node is the upper node of an element which crosses the seabed + ! Superceded by i==1 above if mem%i_floor = 0 + deltal = mem%dl/2.0_ReKi - mem%h_floor + h_c = 0.5_ReKi*(mem%dl/2.0_ReKi + mem%h_floor) + ELSE + ! This node is an interior node. Note: Element crossing the free surface will be handled at the end in conjunction with wave stretching + deltal = mem%dl + h_c = 0.0_ReKi + END IF ! Note: No need to consider i==N+1 because we do not allow the top node to become submerged. The loop also does not reach N+1. + + IF ( pos1(3) <= Zeta1 .AND. pos2(3) > Zeta2 ) THEN ! element is partially wetted + ! Record the number of the partially wetted element + FSElem = i + ! Calculate submergence ratio + SubRatio = ( Zeta1-pos1(3) ) / ( (Zeta1-pos1(3)) - (Zeta2-pos2(3)) ) + ! Calculate the position of the intersection between the free surface and the element + FSInt = SubRatio * (pos2-pos1) + pos1 + END IF - - END DO ! i =1,N ! loop through member elements - + ! Compute the slope of member radius + IF (i == 1) THEN + dRdl_p = abs(mem%dRdl_mg(i)) + dRdl_pp = mem%dRdl_mg(i) + ELSE IF ( i > 1 .AND. i < (N+1)) THEN + dRdl_p = 0.5*( abs(mem%dRdl_mg(i-1)) + abs(mem%dRdl_mg(i)) ) + dRdl_pp = 0.5*( mem%dRdl_mg(i-1) + mem%dRdl_mg(i) ) + ELSE + dRdl_p = abs(mem%dRdl_mg(N)) + dRdl_pp = mem%dRdl_mg(N) + END IF - ! External Hydrodynamic Side Loads - ! NOTE: All geometry-related calculations are based on the undisplaced configuration of the structure - - DO i =1,N+1 ! loop through member nodes - ! We need to subtract the MSL2SWL offset to place this in the SWL reference system - z1 = u%Mesh%Position(3, mem%NodeIndx(i)) - p%MSL2SWL - if ( i > mem%i_floor .and. z1 <= 0.0 ) then ! node is above (or at? TODO: check) seabed and below or at free-surface) - ! TODO: Note that for computational efficiency, we could precompute h_c and deltal for each element when we are NOT using wave stretching - ! We would still need to test at time marching for nodes just below the free surface because that uses the current locations not the reference locations - ! see table in Section 7.1.1 - if ( i == 1 ) then - deltal = mem%dl/2.0_ReKi - h_c = mem%dl/4.0_ReKi - elseif (i == N+1) then - deltal = mem%dl/2.0_ReKi - h_c = -mem%dl/4.0_ReKi - elseif ( mem%i_floor+1 == i ) then ! This node is the upper node of an element which crosses the seabed - deltal = mem%dl/2.0_ReKi - mem%h_floor ! TODO: h_floor is negative valued, should we be subrtracting it from dl/2? GJH - h_c = 0.5_ReKi*(mem%dl/2.0_ReKi + mem%h_floor) - else - ! We need to subtract the MSL2SWL offset to place this in the SWL reference system - pos1 = u%Mesh%Position(:, mem%NodeIndx(i)) - pos1(3) = pos1(3) - p%MSL2SWL - pos2 = u%Mesh%Position(:, mem%NodeIndx(i+1)) - pos2(3) = pos2(3) - p%MSL2SWL - if (pos1(3) <= 0.0 .and. 0.0 < pos2(3) ) then ! This node is just below the free surface !TODO: Needs to be augmented for wave stretching - ! We need to subtract the MSL2SWL offset to place this in the SWL reference system - !TODO: Fix this one - pos1 = u%Mesh%Position(:, mem%NodeIndx(i)) ! use reference position for following equation - pos1(3) = pos1(3) - p%MSL2SWL - h = ( -pos1(3) ) / mem%cosPhi_ref !TODO: Needs to be augmented for wave stretching - deltal = mem%dl/2.0 + h - h_c = 0.5*(h-mem%dl/2.0) - else - ! This node is a fully submerged interior node - deltal = mem%dl - h_c = 0.0_ReKi - end if - - end if - - if (i == 1) then - dRdl_p = abs(mem%dRdl_mg(i)) - dRdl_pp = mem%dRdl_mg(i) - elseif ( i > 1 .and. i < (N+1)) then - dRdl_p = 0.5*( abs(mem%dRdl_mg(i-1)) + abs(mem%dRdl_mg(i)) ) - dRdl_pp = 0.5*( mem%dRdl_mg(i-1) + mem%dRdl_mg(i) ) - else - dRdl_p = abs(mem%dRdl_mg(N)) - dRdl_pp = mem%dRdl_mg(N) - end if - - ! ------------------- hydrodynamic drag loads: sides: Section 7.1.2 ------------------------ - vec = matmul( mem%Ak,m%vrel(:,mem%NodeIndx(i)) ) - f_hydro = mem%Cd(i)*p%WtrDens*mem%RMG(i)*TwoNorm(vec)*vec + & - 0.5*mem%AxCd(i)*p%WtrDens*pi*mem%RMG(i)*dRdl_p * abs(dot_product( mem%k, m%vrel(:,mem%NodeIndx(i)) )) * matmul( mem%kkt, m%vrel(:,mem%NodeIndx(i)) ) -! call LumpDistrHydroLoads( f_hydro, mem%k, deltal, h_c, m%F_D(:, mem%NodeIndx(i)) ) - call LumpDistrHydroLoads( f_hydro, mem%k, deltal, h_c, m%memberLoads(im)%F_D(:, i) ) - y%Mesh%Force (:,mem%NodeIndx(i)) = y%Mesh%Force (:,mem%NodeIndx(i)) + m%memberLoads(im)%F_D(1:3, i) - y%Mesh%Moment(:,mem%NodeIndx(i)) = y%Mesh%Moment(:,mem%NodeIndx(i)) + m%memberLoads(im)%F_D(4:6, i) - - if ( .not. mem%PropPot ) then - ! ------------------- hydrodynamic added mass loads: sides: Section 7.1.3 ------------------------ - Am = mem%Ca(i)*p%WtrDens*pi*mem%RMG(i)*mem%RMG(i)*mem%Ak + 2.0*mem%AxCa(i)*p%WtrDens*pi*mem%RMG(i)*mem%RMG(i)*dRdl_p*mem%kkt - f_hydro = -matmul( Am, u%Mesh%TranslationAcc(:,mem%NodeIndx(i)) ) - !call LumpDistrHydroLoads( f_hydro, mem%k, deltal, h_c, m%F_A(:, mem%NodeIndx(i)) ) - call LumpDistrHydroLoads( f_hydro, mem%k, deltal, h_c, m%memberLoads(im)%F_A(:, i) ) - y%Mesh%Force (:,mem%NodeIndx(i)) = y%Mesh%Force (:,mem%NodeIndx(i)) + m%memberLoads(im)%F_A(1:3, i) - y%Mesh%Moment(:,mem%NodeIndx(i)) = y%Mesh%Moment(:,mem%NodeIndx(i)) + m%memberLoads(im)%F_A(4:6, i) + !-------------------- hydrodynamic drag loads: sides: Section 7.1.2 ------------------------! + vec = matmul( mem%Ak,m%vrel(:,mem%NodeIndx(i)) ) + f_hydro = mem%Cd(i)*p%WaveField%WtrDens*mem%RMG(i)*TwoNorm(vec)*vec + & + 0.5*mem%AxCd(i)*p%WaveField%WtrDens*pi*mem%RMG(i)*dRdl_p * abs(dot_product( mem%k, m%vrel(:,mem%NodeIndx(i)) )) * matmul( mem%kkt, m%vrel(:,mem%NodeIndx(i)) ) + CALL LumpDistrHydroLoads( f_hydro, mem%k, deltal, h_c, m%memberLoads(im)%F_D(:, i) ) + y%Mesh%Force (:,mem%NodeIndx(i)) = y%Mesh%Force (:,mem%NodeIndx(i)) + m%memberLoads(im)%F_D(1:3, i) + y%Mesh%Moment(:,mem%NodeIndx(i)) = y%Mesh%Moment(:,mem%NodeIndx(i)) + m%memberLoads(im)%F_D(4:6, i) + IF (i == FSElem) THEN ! Save the distributed load at the first node below the free surface + F_D0 = f_hydro + END IF + + IF ( .NOT. mem%PropPot ) THEN + !-------------------- hydrodynamic added mass loads: sides: Section 7.1.3 ------------------------! + Am = mem%Ca(i)*p%WaveField%WtrDens*pi*mem%RMG(i)*mem%RMG(i)*mem%Ak + 2.0*mem%AxCa(i)*p%WaveField%WtrDens*pi*mem%RMG(i)*mem%RMG(i)*dRdl_p*mem%kkt + f_hydro = -matmul( Am, u%Mesh%TranslationAcc(:,mem%NodeIndx(i)) ) + + IF ( p%AMMod .EQ. 0_IntKi ) THEN ! Compute added-mass force up to the SWL + z1 = u%Mesh%Position(3, mem%NodeIndx(i)) - p%WaveField%MSL2SWL ! Undisplaced z-position of the current node + IF ( z1 > 0.0_ReKi ) THEN ! Node is above SWL undisplaced; zero added-mass force + f_hydro = 0.0_ReKi + CALL LumpDistrHydroLoads( f_hydro, mem%k, deltal, h_c, m%memberLoads(im)%F_A(:, i) ) + ELSE + ! Need to compute deltal_AM and h_c_AM based on the formulation without wave stretching. + z2 = u%Mesh%Position(3, mem%NodeIndx(i+1)) - p%WaveField%MSL2SWL ! Undisplaced z-position of the next node + IF ( z2 > 0.0_ReKi ) THEN ! Element i crosses the SWL + h = -z1 / mem%cosPhi_ref ! Length of Element i between SWL and node i, h>=0 + deltal_AM = mem%dl/2.0 + h + h_c_AM = 0.5*(h-mem%dl/2.0) + ELSE + deltal_AM = deltal; + h_c_AM = h_c + END IF + ! Note: Do not overwrite deltal and h_c here. Still need them for the fluid inertia and drag forces. + CALL LumpDistrHydroLoads( f_hydro, mem%k, deltal_AM, h_c_AM, m%memberLoads(im)%F_A(:, i) ) + END IF + ELSE ! Compute added-mass force up to the instantaneous free surface + f_hydro = f_hydro * m%nodeInWater(mem%NodeIndx(i)) ! Zero the force if node above free surface + CALL LumpDistrHydroLoads( f_hydro, mem%k, deltal, h_c, m%memberLoads(im)%F_A(:, i) ) + IF (i == FSElem) THEN ! Save the distributed load at the first node below the free surface + F_A0 = f_hydro + END IF + END IF ! AMMod 0 or 1 + y%Mesh%Force (:,mem%NodeIndx(i)) = y%Mesh%Force (:,mem%NodeIndx(i)) + m%memberLoads(im)%F_A(1:3, i) + y%Mesh%Moment(:,mem%NodeIndx(i)) = y%Mesh%Moment(:,mem%NodeIndx(i)) + m%memberLoads(im)%F_A(4:6, i) + + !--------------------- hydrodynamic inertia loads: sides: Section 7.1.4 --------------------------! + IF (mem%PropMCF) THEN + f_hydro= p%WaveField%WtrDens*pi*mem%RMG(i)*mem%RMG(i) * matmul( mem%Ak, m%FAMCF(:,mem%NodeIndx(i)) ) + & + 2.0*mem%AxCa(i)*p%WaveField%WtrDens*pi*mem%RMG(i)*mem%RMG(i)*dRdl_p * matmul( mem%kkt, m%FA(:,mem%NodeIndx(i)) ) + & + 2.0*m%FDynP(mem%NodeIndx(i))*mem%AxCp(i)*pi*mem%RMG(i)*dRdl_pp*mem%k + ELSE + f_hydro=(mem%Ca(i)+mem%Cp(i))*p%WaveField%WtrDens*pi*mem%RMG(i)*mem%RMG(i) * matmul( mem%Ak, m%FA(:,mem%NodeIndx(i)) ) + & + 2.0*mem%AxCa(i) *p%WaveField%WtrDens*pi*mem%RMG(i)*mem%RMG(i)*dRdl_p * matmul( mem%kkt, m%FA(:,mem%NodeIndx(i)) ) + & + 2.0*m%FDynP(mem%NodeIndx(i))*mem%AxCp(i)*pi*mem%RMG(i)*dRdl_pp*mem%k + END IF + + CALL LumpDistrHydroLoads( f_hydro, mem%k, deltal, h_c, m%memberLoads(im)%F_I(:, i) ) + y%Mesh%Force (:,mem%NodeIndx(i)) = y%Mesh%Force (:,mem%NodeIndx(i)) + m%memberLoads(im)%F_I(1:3, i) + y%Mesh%Moment(:,mem%NodeIndx(i)) = y%Mesh%Moment(:,mem%NodeIndx(i)) + m%memberLoads(im)%F_I(4:6, i) + IF (i == FSElem) THEN ! Save the distributed load at the first node below the free surface + F_I0 = f_hydro + END IF + END IF + + END DO ! i =1,N+1 ! loop through member nodes + + !----------------------------------------------------------------------------------------------------! + ! Compute the distributed loads at the point of intersection between the member and the free surface ! + !----------------------------------------------------------------------------------------------------! + ! Get wave kinematics at the free-surface intersection. Set forceNodeInWater=.TRUE. to guarantee the free-surface intersection is in water. + CALL WaveField_GetNodeWaveKin( p%WaveField, m%WaveField_m, Time, FSInt, .TRUE., nodeInWater, WaveElev1, WaveElev2, WaveElev, FDynP, FV, FA, FAMCF, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + FDynPFSInt = REAL(FDynP,ReKi) + FVFSInt = REAL(FV, ReKi) + FAFSInt = REAL(FA, ReKi) + IF ( mem%PropMCF .AND. ( .NOT. mem%PropPot ) ) THEN + FAMCFFSInt = REAL(FAMCF,ReKi) + END IF + + ! Viscous drag: + ! Compute relative velocity at the free surface intersection. + ! Linear interpolation between the two nodes of the element is used to estimate velocity of the structure + vrelFSInt = FVFSInt - ( & + SubRatio * u%Mesh%TranslationVel(:,mem%NodeIndx(FSElem+1)) + & + (1.0-SubRatio) * u%Mesh%TranslationVel(:,mem%NodeIndx(FSElem )) & + ) + dRdl_p = abs(mem%dRdl_mg(FSElem)) + RMGFSInt = SubRatio * mem%RMG(FSElem+1) + (1.0-SubRatio) * mem%RMG(FSElem) + + vec = matmul( mem%Ak,vrelFSInt ) + F_DS = mem%Cd(FSElem)*p%WaveField%WtrDens*RMGFSInt*TwoNorm(vec)*vec + & + 0.5*mem%AxCd(FSElem)*p%WaveField%WtrDens*pi*RMGFSInt*dRdl_p * & + abs(dot_product( mem%k, vrelFSInt )) * matmul( mem%kkt, vrelFSInt ) + + ! Hydrodynamic added mass and inertia loads + IF ( .NOT. mem%PropPot ) THEN + + ! ------------------- hydrodynamic added mass loads: sides: Section 7.1.3 ------------------------ + IF (p%AMMod > 0_IntKi) THEN + Am = mem%Ca(FSElem)*p%WaveField%WtrDens*pi*RMGFSInt*RMGFSInt*mem%Ak + & + 2.0*mem%AxCa(FSElem)*p%WaveField%WtrDens*pi*RMGFSInt*RMGFSInt*dRdl_p*mem%kkt + F_AS = -matmul( Am, & + SubRatio * u%Mesh%TranslationAcc(:,mem%NodeIndx(FSElem+1)) + & + (1.0-SubRatio) * u%Mesh%TranslationAcc(:,mem%NodeIndx(FSElem )) ) + END IF - ! ------------------- hydrodynamic inertia loads: sides: Section 7.1.4 ------------------------ - f_hydro=(mem%Ca(i)+mem%Cp(i))*p%WtrDens*pi*mem%RMG(i)*mem%RMG(i) * matmul( mem%Ak, m%FA(:,mem%NodeIndx(i)) ) + & - 2.0*mem%AxCa(i)*p%WtrDens*pi*mem%RMG(i)*mem%RMG(i)*dRdl_p * matmul( mem%kkt, m%FA(:,mem%NodeIndx(i)) ) + & - 2.0*m%FDynP(mem%NodeIndx(i))*mem%AxCp(i)*pi*mem%RMG(i)*dRdl_pp*mem%k - !call LumpDistrHydroLoads( f_hydro, mem%k, deltal, h_c, m%F_I(:, mem%NodeIndx(i)) ) - call LumpDistrHydroLoads( f_hydro, mem%k, deltal, h_c, m%memberLoads(im)%F_I(:, i) ) - y%Mesh%Force (:,mem%NodeIndx(i)) = y%Mesh%Force (:,mem%NodeIndx(i)) + m%memberLoads(im)%F_I(1:3, i) - y%Mesh%Moment(:,mem%NodeIndx(i)) = y%Mesh%Moment(:,mem%NodeIndx(i)) + m%memberLoads(im)%F_I(4:6, i) - end if - end if ! ( i > mem%i_floor .and. Zi <= 0.0 ) + ! ------------------- hydrodynamic inertia loads: sides: Section 7.1.4 ------------------------ + IF ( mem%PropMCF) THEN + F_IS= p%WaveField%WtrDens*pi*RMGFSInt*RMGFSInt * matmul( mem%Ak, FAMCFFSInt ) + & + 2.0*mem%AxCa(FSElem)*p%WaveField%WtrDens*pi*RMGFSInt*RMGFSInt*dRdl_p * matmul( mem%kkt, FAFSInt ) + & + 2.0*mem%AxCp(FSElem) *pi*RMGFSInt *dRdl_pp * FDynPFSInt*mem%k + ELSE + F_IS=(mem%Ca(FSElem)+mem%Cp(FSElem))*p%WaveField%WtrDens*pi*RMGFSInt*RMGFSInt * matmul( mem%Ak, FAFSInt ) + & + 2.0*mem%AxCa(FSElem)*p%WaveField%WtrDens*pi*RMGFSInt*RMGFSInt*dRdl_p * matmul( mem%kkt, FAFSInt ) + & + 2.0*mem%AxCp(FSElem) *pi*RMGFSInt *dRdl_pp * FDynPFSInt*mem%k + END IF + END IF + + !----------------------------------------------------------------------------------------------------! + ! Perform the load redistribution for smooth time series ! + !----------------------------------------------------------------------------------------------------! + ! Evaluate the load redistribution function + f_redist = 0.0_ReKi + IF (FSElem > 1_IntKi) THEN ! At least one fully submerged element + f_redist = 2.0_ReKi * SubRatio**3 - 3.5_ReKi * SubRatio**2 + SubRatio + 0.5_ReKi + END IF + + ! deltal = mem%dl and h_c = 0 should always be used here by design. Moment correction will be applied separately + deltal = mem%dl + h_c = 0.0_ReKi + + ! Viscous drag + ! Apply load redistribution to the first node below the free surface + Df_hydro = ((SubRatio-1.0_ReKi)/(2.0_ReKi)-f_redist)*F_D0 + SubRatio/2.0_ReKi*F_DS + CALL LumpDistrHydroLoads( Df_hydro, mem%k, deltal, h_c, Df_hydro_lumped) + m%memberLoads(im)%F_D(:, FSElem) = m%memberLoads(im)%F_D(:, FSElem) + Df_hydro_lumped + y%Mesh%Force (:,mem%NodeIndx(FSElem)) = y%Mesh%Force (:,mem%NodeIndx(FSElem)) + Df_hydro_lumped(1:3) + y%Mesh%Moment(:,mem%NodeIndx(FSElem)) = y%Mesh%Moment(:,mem%NodeIndx(FSElem)) + Df_hydro_lumped(4:6) + + ! Apply load redistribution to the second node below the free surface + IF (FSElem > 1_IntKi) THEN ! Note: Only need to modify the loads on the second node below the free surface when there is at least one fully submerged element. + Df_hydro = f_redist * F_D0 + CALL LumpDistrHydroLoads( Df_hydro, mem%k, deltal, h_c, Df_hydro_lumped) + m%memberLoads(im)%F_D(:, FSElem-1) = m%memberLoads(im)%F_D(:, FSElem-1) + Df_hydro_lumped + y%Mesh%Force (:,mem%NodeIndx(FSElem-1)) = y%Mesh%Force (:,mem%NodeIndx(FSElem-1)) + Df_hydro_lumped(1:3) + y%Mesh%Moment(:,mem%NodeIndx(FSElem-1)) = y%Mesh%Moment(:,mem%NodeIndx(FSElem-1)) + Df_hydro_lumped(4:6) + END IF + + ! Hydrodynamic added mass and inertia loads + IF ( .NOT. mem%PropPot ) THEN + + IF ( p%AMMod > 0_IntKi ) THEN + !-------------------- hydrodynamic added mass loads: sides: Section 7.1.3 ------------------------! + ! Apply load redistribution to the first node below the free surface + Df_hydro = ((SubRatio-1.0_ReKi)/(2.0_ReKi)-f_redist)*F_A0 + SubRatio/2.0_ReKi*F_AS + CALL LumpDistrHydroLoads( Df_hydro, mem%k, deltal, h_c, Df_hydro_lumped) + m%memberLoads(im)%F_A(:, FSElem) = m%memberLoads(im)%F_A(:, FSElem) + Df_hydro_lumped + y%Mesh%Force (:,mem%NodeIndx(FSElem)) = y%Mesh%Force (:,mem%NodeIndx(FSElem)) + Df_hydro_lumped(1:3) + y%Mesh%Moment(:,mem%NodeIndx(FSElem)) = y%Mesh%Moment(:,mem%NodeIndx(FSElem)) + Df_hydro_lumped(4:6) + + ! Apply load redistribution to the second node below the free surface + IF (FSElem > 1_IntKi) THEN + Df_hydro = f_redist * F_A0 + CALL LumpDistrHydroLoads( Df_hydro, mem%k, deltal, h_c, Df_hydro_lumped) + m%memberLoads(im)%F_A(:, FSElem-1) = m%memberLoads(im)%F_A(:, FSElem-1) + Df_hydro_lumped + y%Mesh%Force (:,mem%NodeIndx(FSElem-1)) = y%Mesh%Force (:,mem%NodeIndx(FSElem-1)) + Df_hydro_lumped(1:3) + y%Mesh%Moment(:,mem%NodeIndx(FSElem-1)) = y%Mesh%Moment(:,mem%NodeIndx(FSElem-1)) + Df_hydro_lumped(4:6) + END IF + END IF + + !-------------------- hydrodynamic inertia loads: sides: Section 7.1.4 --------------------------! + ! Apply load redistribution to the first node below the free surface + Df_hydro = ((SubRatio-1.0_ReKi)/(2.0_ReKi)-f_redist)*F_I0 + SubRatio/2.0_ReKi*F_IS + CALL LumpDistrHydroLoads( Df_hydro, mem%k, deltal, h_c, Df_hydro_lumped) + m%memberLoads(im)%F_I(:, FSElem) = m%memberLoads(im)%F_I(:, FSElem) + Df_hydro_lumped + y%Mesh%Force (:,mem%NodeIndx(FSElem)) = y%Mesh%Force (:,mem%NodeIndx(FSElem)) + Df_hydro_lumped(1:3) + y%Mesh%Moment(:,mem%NodeIndx(FSElem)) = y%Mesh%Moment(:,mem%NodeIndx(FSElem)) + Df_hydro_lumped(4:6) + + ! Apply load redistribution to the second node below the free surface + IF (FSElem > 1_IntKi) THEN + Df_hydro = f_redist * F_I0 + CALL LumpDistrHydroLoads( Df_hydro, mem%k, deltal, h_c, Df_hydro_lumped) + m%memberLoads(im)%F_I(:, FSElem-1) = m%memberLoads(im)%F_I(:, FSElem-1) + Df_hydro_lumped + y%Mesh%Force (:,mem%NodeIndx(FSElem-1)) = y%Mesh%Force (:,mem%NodeIndx(FSElem-1)) + Df_hydro_lumped(1:3) + y%Mesh%Moment(:,mem%NodeIndx(FSElem-1)) = y%Mesh%Moment(:,mem%NodeIndx(FSElem-1)) + Df_hydro_lumped(4:6) + END IF + END IF + + !----------------------------------------------------------------------------------------------------! + ! Perform moment correction to compensate for load redistribution ! + !----------------------------------------------------------------------------------------------------! + ! Moment correction to the first and second nodes below the free surface + F_S = F_DS + F_0 = F_D0 + IF ( .NOT. mem%PropPot) THEN + F_S = F_S + F_IS + F_0 = F_0 + F_I0 + IF ( p%AMMod > 0_IntKi) THEN + F_S = F_S + F_AS + F_0 = F_0 + F_A0 + END IF + END IF + ! First node below the free surface + DM_hydro = 0.5_ReKi * SubRatio**2 * deltal * cross_product(mem%k, F_S) + y%Mesh%Moment(:,mem%NodeIndx(FSElem)) = y%Mesh%Moment(:,mem%NodeIndx(FSElem)) + DM_hydro * deltal + ! Second node below the free surface + IF (FSElem > 1_IntKi) THEN + DM_hydro = f_redist * deltal * cross_product(mem%k, F_0) + y%Mesh%Moment(:,mem%NodeIndx(FSElem-1)) = y%Mesh%Moment(:,mem%NodeIndx(FSElem-1)) + DM_hydro * deltal + END IF + + ELSE IF ( MemSubStat .NE. 3_IntKi) THEN ! Skip members with centerline completely out of water + !----------------------------No load smoothing----------------------------! + DO i = mem%i_floor+1,N+1 ! loop through member nodes starting from the first node above seabed + z1 = m%DispNodePosHdn(3, mem%NodeIndx(i)) + !---------------------------------------------Compute deltal and h_c------------------------------------------! + ! Cannot make any assumption about WaveStMod and member orientation + IF ( m%NodeInWater(mem%NodeIndx(i)) .EQ. 0_IntKi ) THEN ! Node is out of water + deltal = 0.0_ReKi + h_c = 0.0_ReKi + ELSE ! Node in water + ! Look to the "left" toward node 1 + IF ( i == 1 ) THEN ! First node. Note: Having i == 1 also implies mem%i_floor = 0. + deltalLeft = 0.0_ReKi + ELSE IF ( i == mem%i_floor+1 ) THEN ! First node above seabed. + ! Note: This part is superceded by i==1 above when mem%i_floor = 0. + ! This is the correct behavior. + deltalLeft = -mem%h_floor + ELSE ! Regular internal node + IF ( m%NodeInWater(mem%NodeIndx(i-1)) .EQ. 1_IntKi ) THEN ! Node to the left is submerged + deltalLeft = 0.5_ReKi * mem%dl + ELSE ! Element i-1 crosses the free surface + z2 = m%DispNodePosHdn(3, mem%NodeIndx(i-1)) + IF ( p%WaveField%WaveStMod > 0_IntKi ) THEN ! Wave stretching enabled + zeta1 = m%WaveElev(mem%NodeIndx(i )) + zeta2 = m%WaveElev(mem%NodeIndx(i-1)) + ELSE + zeta1 = 0.0_ReKi + zeta2 = 0.0_ReKi + END IF + SubRatio = (zeta1-z1)/((zeta1-z1)-(zeta2-z2)) + deltalLeft = SubRatio * mem%dl ! Portion of element i-1 in water + END IF + END IF + ! Look to the "right" toward node N+1 + IF ( i == N+1 ) THEN ! Last node + deltalRight = 0.0_ReKi + ELSE ! Regular internal node + IF ( m%NodeInWater(mem%NodeIndx(i+1)) .EQ. 1_IntKi ) THEN ! Node to the right is submerged + deltalRight = 0.5_ReKi * mem%dl + ELSE ! Element i crosses the free surface + z2 = m%DispNodePosHdn(3, mem%NodeIndx(i+1)) + IF ( p%WaveField%WaveStMod > 0_IntKi ) THEN ! Wave stretching enabled + zeta1 = m%WaveElev(mem%NodeIndx(i )) + zeta2 = m%WaveElev(mem%NodeIndx(i+1)) + ELSE + zeta1 = 0.0_ReKi + zeta2 = 0.0_ReKi + END IF + SubRatio = (zeta1-z1)/((zeta1-z1)-(zeta2-z2)) + deltalRight = SubRatio * mem%dl ! Portion of element i in water + END IF + END IF + ! Combine left and right contributions + deltal = deltalRight + deltalLeft + h_c = 0.5_ReKi * ( deltalRight - deltalLeft ) + END IF + + ! Compute the slope of the member radius + IF (i == 1) THEN + dRdl_p = abs(mem%dRdl_mg(i)) + dRdl_pp = mem%dRdl_mg(i) + ELSE IF ( i > 1 .AND. i < (N+1)) THEN + dRdl_p = 0.5*( abs(mem%dRdl_mg(i-1)) + abs(mem%dRdl_mg(i)) ) + dRdl_pp = 0.5*( mem%dRdl_mg(i-1) + mem%dRdl_mg(i) ) + ELSE + dRdl_p = abs(mem%dRdl_mg(N)) + dRdl_pp = mem%dRdl_mg(N) + END IF - END DO ! i =1,N+1 ! loop through member nodes - - - ! Any end plate loads that are modeled on a per-member basis - + !--------------------- hydrodynamic drag loads: sides: Section 7.1.2 --------------------------------! + vec = matmul( mem%Ak,m%vrel(:,mem%NodeIndx(i)) ) + f_hydro = mem%Cd(i)*p%WaveField%WtrDens*mem%RMG(i)*TwoNorm(vec)*vec + & + 0.5*mem%AxCd(i)*p%WaveField%WtrDens*pi*mem%RMG(i)*dRdl_p * abs(dot_product( mem%k, m%vrel(:,mem%NodeIndx(i)) )) * matmul( mem%kkt, m%vrel(:,mem%NodeIndx(i)) ) + CALL LumpDistrHydroLoads( f_hydro, mem%k, deltal, h_c, m%memberLoads(im)%F_D(:, i) ) + y%Mesh%Force (:,mem%NodeIndx(i)) = y%Mesh%Force (:,mem%NodeIndx(i)) + m%memberLoads(im)%F_D(1:3, i) + y%Mesh%Moment(:,mem%NodeIndx(i)) = y%Mesh%Moment(:,mem%NodeIndx(i)) + m%memberLoads(im)%F_D(4:6, i) + + IF ( .NOT. mem%PropPot ) THEN + !-------------------- hydrodynamic added mass loads: sides: Section 7.1.3 ------------------------! + Am = mem%Ca(i)*p%WaveField%WtrDens*pi*mem%RMG(i)*mem%RMG(i)*mem%Ak + 2.0*mem%AxCa(i)*p%WaveField%WtrDens*pi*mem%RMG(i)*mem%RMG(i)*dRdl_p*mem%kkt + f_hydro = -matmul( Am, u%Mesh%TranslationAcc(:,mem%NodeIndx(i)) ) + IF ( p%AMMod .EQ. 0_IntKi ) THEN ! Always compute added-mass force on nodes below SWL when undisplaced + z1 = u%Mesh%Position(3, mem%NodeIndx(i)) - p%WaveField%MSL2SWL ! Undisplaced z-position of the current node + IF ( z1 > 0.0_ReKi ) THEN ! Node is above SWL when undisplaced; zero added-mass force + f_hydro = 0.0_ReKi + CALL LumpDistrHydroLoads( f_hydro, mem%k, deltal, h_c, m%memberLoads(im)%F_A(:, i) ) + ELSE ! Node at or below SWL when undisplaced + IF ( i == 1 ) THEN + deltalLeft = 0.0_ReKi + ELSE IF ( i == mem%i_floor+1 ) THEN + deltalLeft = -mem%h_floor + ELSE + deltalLeft = 0.5_ReKi * mem%dl + END IF + IF ( i == N+1 ) THEN + deltalRight = 0.0_ReKi + ELSE + z2 = u%Mesh%Position(3, mem%NodeIndx(i+1)) - p%WaveField%MSL2SWL + IF ( z2 > 0.0_ReKi ) THEN ! Element i crosses the SWL + deltalRight = -z1 / mem%cosPhi_ref + ELSE + deltalRight = 0.5_ReKi * mem%dl + END IF + END IF + deltal_AM = deltalRight + deltalLeft + h_c_AM = 0.5_ReKi * ( deltalRight - deltalLeft ) + CALL LumpDistrHydroLoads( f_hydro, mem%k, deltal_AM, h_c_AM, m%memberLoads(im)%F_A(:, i) ) + END IF + ELSE ! Compute added-mass force on the instantaneous wetted section of the member + f_hydro = f_hydro * m%nodeInWater(mem%NodeIndx(i)) ! Zero the force if node above free surface + CALL LumpDistrHydroLoads( f_hydro, mem%k, deltal, h_c, m%memberLoads(im)%F_A(:, i) ) + END IF ! AMMod 0 or 1 + y%Mesh%Force (:,mem%NodeIndx(i)) = y%Mesh%Force (:,mem%NodeIndx(i)) + m%memberLoads(im)%F_A(1:3, i) + y%Mesh%Moment(:,mem%NodeIndx(i)) = y%Mesh%Moment(:,mem%NodeIndx(i)) + m%memberLoads(im)%F_A(4:6, i) + + !-------------------- hydrodynamic inertia loads: sides: Section 7.1.4 ---------------------------! + IF ( mem%PropMCF ) THEN + f_hydro= p%WaveField%WtrDens*pi*mem%RMG(i)*mem%RMG(i) * matmul( mem%Ak, m%FAMCF(:,mem%NodeIndx(i)) ) + & + 2.0*mem%AxCa(i)*p%WaveField%WtrDens*pi*mem%RMG(i)*mem%RMG(i)*dRdl_p * matmul( mem%kkt, m%FA(:,mem%NodeIndx(i)) ) + & + 2.0*m%FDynP(mem%NodeIndx(i))*mem%AxCp(i)*pi*mem%RMG(i)*dRdl_pp*mem%k + ELSE + f_hydro=(mem%Ca(i)+mem%Cp(i))*p%WaveField%WtrDens*pi*mem%RMG(i)*mem%RMG(i) * matmul( mem%Ak, m%FA(:,mem%NodeIndx(i)) ) + & + 2.0*mem%AxCa(i) *p%WaveField%WtrDens*pi*mem%RMG(i)*mem%RMG(i)*dRdl_p * matmul( mem%kkt, m%FA(:,mem%NodeIndx(i)) ) + & + 2.0*m%FDynP(mem%NodeIndx(i))*mem%AxCp(i)*pi*mem%RMG(i)*dRdl_pp*mem%k + END IF + CALL LumpDistrHydroLoads( f_hydro, mem%k, deltal, h_c, m%memberLoads(im)%F_I(:, i) ) + y%Mesh%Force (:,mem%NodeIndx(i)) = y%Mesh%Force (:,mem%NodeIndx(i)) + m%memberLoads(im)%F_I(1:3, i) + y%Mesh%Moment(:,mem%NodeIndx(i)) = y%Mesh%Moment(:,mem%NodeIndx(i)) + m%memberLoads(im)%F_I(4:6, i) + END IF + + END DO ! i = 1,N+1 ! loop through member nodes + + END IF ! Check if the member is surface piercing + !-----------------------------------------------------------------------------------------------------! + ! External Hydrodynamic Side Loads - End ! + !-----------------------------------------------------------------------------------------------------! + + !-----------------------------------------------------------------------------------------------------! + ! Any end plate loads that are modeled on a per-member basis: F_B and F_BF ! + !-----------------------------------------------------------------------------------------------------! ! reassign convenience variables to correspond to member ends ! We need to subtract the MSL2SWL offset to place this in the SWL reference system - pos1 = u%Mesh%TranslationDisp(:, mem%NodeIndx(1)) + u%Mesh%Position(:, mem%NodeIndx(1)) - pos1(3) = pos1(3) - p%MSL2SWL - pos2 = u%Mesh%TranslationDisp(:, mem%NodeIndx(2)) + u%Mesh%Position(:, mem%NodeIndx(2)) - pos2(3) = pos2(3) - p%MSL2SWL - z1 = pos1(3) - + pos1 = m%DispNodePosHst(:,mem%NodeIndx(1)) + pos2 = m%DispNodePosHst(:,mem%NodeIndx(2)) call GetOrientationAngles( pos1, pos2, phi1, sinPhi1, cosPhi1, tanPhi, sinBeta1, cosBeta1, k_hat1, errStat2, errMsg2 ) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) if ( N == 1 ) then ! Only one element in member - sinPhi2 = sinPhi1 - cosPhi2 = cosPhi1 - sinBeta2 = sinBeta1 - cosBeta2 = cosBeta1 + sinPhi2 = sinPhi1 + cosPhi2 = cosPhi1 + sinBeta2 = sinBeta1 + cosBeta2 = cosBeta1 + k_hat2 = k_hat1 else ! We need to subtract the MSL2SWL offset to place this in the SWL reference system - pos1 = u%Mesh%TranslationDisp(:, mem%NodeIndx(N)) + u%Mesh%Position(:, mem%NodeIndx(N)) - pos1(3) = pos1(3) - p%MSL2SWL - pos2 = u%Mesh%TranslationDisp(:, mem%NodeIndx(N+1)) + u%Mesh%Position(:, mem%NodeIndx(N+1)) - pos2(3) = pos2(3) - p%MSL2SWL + pos1 = m%DispNodePosHst(:, mem%NodeIndx(N )) + pos2 = m%DispNodePosHst(:, mem%NodeIndx(N+1)) call GetOrientationAngles( pos1, pos2, phi2, sinPhi2, cosPhi2, tanPhi, sinBeta2, cosBeta2, k_hat2, errStat2, errMsg2 ) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) end if - ! We need to subtract the MSL2SWL offset to place this in the SWL reference system - pos2 = u%Mesh%TranslationDisp(:, mem%NodeIndx(N+1)) + u%Mesh%Position(:, mem%NodeIndx(N+1)) - pos2(3) = pos2(3) - p%MSL2SWL - z2 = pos2(3) - - ! Check the member does not exhibit any of the following conditions - if (.not. mem%PropPot) then - if ( abs(z2) < abs(mem%Rmg(N+1)*sinPhi2) ) then - call SetErrStat(ErrID_Fatal, 'The upper end-plate of a member must not cross the water plane. This is not true for Member ID '//trim(num2lstr(mem%MemberID)), errStat, errMsg, 'Morison_CalcOutput' ) - end if - if ( abs(z1) < abs(mem%Rmg(1)*sinPhi1) ) then - call SetErrStat(ErrID_Fatal, 'The lower end-plate of a member must not cross the water plane. This is not true for Member ID '//trim(num2lstr(mem%MemberID)), errStat, errMsg, 'Morison_CalcOutput' ) - end if - end if - -! TODO: Do the equations below still work if z1 > z2 ? - !TODO, should not have to test seabed crossing in time-marching loop - + ! z-coordinates of the two ends of the member + z1 = m%DispNodePosHst(3,mem%NodeIndx( 1)) + z2 = m%DispNodePosHst(3,mem%NodeIndx(N+1)) + !----------------------------------- filled buoyancy loads: starts -----------------------------------! + !TODO: Do the equations below still work if z1 > z2 ? + !TODO: Should not have to test seabed crossing in time-marching loop if ( mem%i_floor == 0 ) then ! both ends are above seabed !--- Water ballast buoyancy --- ! if member is fully flooded @@ -3295,155 +3388,813 @@ SUBROUTINE Morison_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, errStat, ! no loads because both end nodes are below seabed end if - ! --- no inertia loads from water ballast modeled on ends + !------------------------------------ filled buoyancy loads: ends ------------------------------------! - ! --- external buoyancy loads: ends --- + ! --- no inertia loads from water ballast modeled on ends - if ( .not. mem%PropPot ) then - ! We need to subtract the MSL2SWL offset to place this in the SWL reference system - pos1 = u%Mesh%TranslationDisp(:, mem%NodeIndx(1)) + u%Mesh%Position(:, mem%NodeIndx(1)) - pos1(3) = pos1(3) - p%MSL2SWL - pos2 = u%Mesh%TranslationDisp(:, mem%NodeIndx(N+1)) + u%Mesh%Position(:, mem%NodeIndx(N+1)) - pos2(3) = pos2(3) - p%MSL2SWL - z1 = pos1(3) - z2 = pos2(3) + !---------------------------------- external buoyancy loads: starts ----------------------------------! + if ( (.not. mem%PropPot) .AND. (mem%MHstLMod /= 0) ) then + ! Get positions and scaled radii of member end nodes + pos1 = m%DispNodePosHst(:,mem%NodeIndx( 1)) + pos2 = m%DispNodePosHst(:,mem%NodeIndx(N+1)) + r1 = mem%RMGB( 1) + r2 = mem%RMGB(N+1) if (mem%i_floor == 0) then ! both ends above or at seabed - if (z2<= 0.0_ReKi) then - ! Compute loads on both ends - Fl = -p%WtrDens * g * pi *mem%RMG(1)**2*z1 - Moment = -p%WtrDens * g * pi *0.25*mem%RMG(1)**4*sinPhi - call AddEndLoad(Fl, Moment, sinPhi1, cosPhi1, sinBeta1, cosBeta1, m%F_B_End(:, mem%NodeIndx(1))) - Fl = p%WtrDens * g * pi *mem%RMG(N+1)**2*z2 - Moment = p%WtrDens * g * pi *0.25*mem%RMG(N+1)**4*sinPhi - call AddEndLoad(Fl, Moment, sinPhi2, cosPhi2, sinBeta2, cosBeta2, m%F_B_End(:, mem%NodeIndx(N+1))) - elseif ( z1< 0.0_ReKi ) then - ! Compute loads only on lower end - Fl = -p%WtrDens * g * pi *mem%RMG(1)**2*z1 - Moment = -p%WtrDens * g * pi *0.25*mem%RMG(1)**4*sinPhi - call AddEndLoad(Fl, Moment, sinPhi1, cosPhi1, sinBeta1, cosBeta1, m%F_B_End(:, mem%NodeIndx(1))) - else - ! Entire member is above the still water line - end if - - ! elseif ( (mem%i_floor < mem%NElements) .and. (z2<= 0.0_ReKi) ) then ! The member crosses the seabed line so only the upper end could have bouyancy effects, if at or below free surface - elseif ( (mem%doEndBuoyancy) .and. (z2<= 0.0_ReKi) ) then ! The member crosses the seabed line so only the upper end could have bouyancy effects, if at or below free surface - ! Only compute the buoyancy contribution from the upper end - Fl = p%WtrDens * g * pi *mem%RMG(N+1)**2*z2 - Moment = p%WtrDens * g * pi *0.25*mem%RMG(N+1)**4*sinPhi - call AddEndLoad(Fl, Moment, sinPhi2, cosPhi2, sinBeta2, cosBeta2, m%F_B_End(:, mem%NodeIndx(N+1))) - else - ! entire member is buried below the seabed + ! Compute loads on the end plate of node 1 + IF (p%WaveField%WaveStMod > 0) THEN + CALL GetTotalWaveElev( Time, pos1, Zeta1, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL GetFreeSurfaceNormal( Time, pos1, r1, n_hat, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + FSPt = (/pos1(1),pos1(2),Zeta1/) ! Reference point on the free surface + ELSE + FSPt = (/pos1(1),pos1(2),0.0_ReKi/) + n_hat = (/0.0,0.0,1.0/) + END IF + CALL GetSectionUnitVectors( k_hat1, y_hat, z_hat ) + CALL GetSectionFreeSurfaceIntersects( REAL(pos1,DbKi), REAL(FSPt,DbKi), k_hat1, y_hat, z_hat, n_hat, REAL(r1,DbKi), theta1, theta2, secStat) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL GetEndPlateHstLds(pos1, k_hat1, y_hat, z_hat, r1, theta1, theta2, F_B_End) + m%F_B_End(:, mem%NodeIndx( 1)) = m%F_B_End(:, mem%NodeIndx( 1)) + F_B_End + IF (mem%MHstLMod == 1) THEN ! Check for partially wetted end plates + IF ( .NOT.( EqualRealNos((theta2-theta1),0.0_DbKi) .OR. EqualRealNos((theta2-theta1),2.0_DbKi*PI_D) ) ) THEN + CALL SetErrStat(ErrID_Warn, 'End plate is partially wetted with MHstLMod = 1. The buoyancy load and distribution potentially have large error. This has happened to the first node of Member ID ' //trim(num2lstr(mem%MemberID)), errStat, errMsg, RoutineName ) + END IF + END IF + ! Compute loads on the end plate of node N+1 + IF (p%WaveField%WaveStMod > 0) THEN + CALL GetTotalWaveElev( Time, pos2, Zeta2, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL GetFreeSurfaceNormal( Time, pos2, r2, n_hat, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + FSPt = (/pos2(1),pos2(2),Zeta2/) ! Reference point on the free surface + ELSE + FSPt = (/pos2(1),pos2(2),0.0_ReKi/) + n_hat = (/0.0,0.0,1.0/) + END IF + CALL GetSectionUnitVectors( k_hat2, y_hat, z_hat ) + CALL GetSectionFreeSurfaceIntersects( REAL(pos2,DbKi), REAL(FSPt,DbKi), k_hat2, y_hat, z_hat, n_hat, REAL(r2,DbKi), theta1, theta2, secStat) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL GetEndPlateHstLds(pos2, k_hat2, y_hat, z_hat, r2, theta1, theta2, F_B_End) + m%F_B_End(:, mem%NodeIndx(N+1)) = m%F_B_End(:, mem%NodeIndx(N+1)) - F_B_End + IF (mem%MHstLMod == 1) THEN ! Check for partially wetted end plates + IF ( .NOT.( EqualRealNos((theta2-theta1),0.0_DbKi) .OR. EqualRealNos((theta2-theta1),2.0_DbKi*PI_D) ) ) THEN + CALL SetErrStat(ErrID_Warn, 'End plate is partially wetted with MHstLMod = 1. The buoyancy load and distribution potentially have large error. This has happened to the last node of Member ID ' //trim(num2lstr(mem%MemberID)), errStat, errMsg, RoutineName ) + END IF + END IF + elseif ( mem%doEndBuoyancy ) then ! The member crosses the seabed line so only the upper end potentially have hydrostatic load + ! Only compute the loads on the end plate of node N+1 + IF (p%WaveField%WaveStMod > 0) THEN + CALL GetTotalWaveElev( Time, pos2, Zeta2, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL GetFreeSurfaceNormal( Time, pos2, r2, n_hat, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + FSPt = (/pos2(1),pos2(2),Zeta2/) ! Reference point on the free surface + ELSE + FSPt = (/pos2(1),pos2(2),0.0_ReKi/) + n_hat = (/0.0,0.0,1.0/) + END IF + CALL GetSectionUnitVectors( k_hat2, y_hat, z_hat ) + CALL GetSectionFreeSurfaceIntersects( REAL(pos2,DbKi), REAL(FSPt,DbKi), k_hat2, y_hat, z_hat, n_hat, REAL(r2,DbKi), theta1, theta2, secStat) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL GetEndPlateHstLds(pos2, k_hat2, y_hat, z_hat, r2, theta1, theta2, F_B_End) + m%F_B_End(:, mem%NodeIndx(N+1)) = m%F_B_End(:, mem%NodeIndx(N+1)) - F_B_End + IF (mem%MHstLMod == 1) THEN ! Check for partially wetted end plates + IF ( .NOT.( EqualRealNos((theta2-theta1),0.0_DbKi) .OR. EqualRealNos((theta2-theta1),2.0_DbKi*PI_D) ) ) THEN + CALL SetErrStat(ErrID_Warn, 'End plate is partially wetted with MHstLMod = 1. The buoyancy load and distribution potentially have large error. This has happened to the last node of Member ID ' //trim(num2lstr(mem%MemberID)), errStat, errMsg, RoutineName ) + END IF + END IF + ! else + ! entire member is buried below the seabed end if end if ! PropPot - + !----------------------------------- external buoyancy loads: ends -----------------------------------! + end do ! im - looping through members + + !---------------------------------------------------------------------------------------------------------------! + ! External Hydrodynamic Joint Loads - Start ! + ! F_D_End, F_I_End, F_A_End, F_IMG_End ! + !---------------------------------------------------------------------------------------------------------------! + ! NOTE: All wave kinematics have already been zeroed out above the SWL or instantaneous wave height (for WaveStMod > 0), + ! so loads derived from the kinematics will be correct without the use of a nodeInWater value, but other loads need to be + ! multiplied by nodeInWater to zero them out above the SWL or instantaneous wave height. + !TODO: Where's F_WMF_End computed? + + DO J = 1, p%NJoints + ! Obtain the node index because WaveVel, WaveAcc, and WaveDynP are defined in the node indexing scheme, not the markers (No longer relevant?) + ! The first NJoints nodes are all the joints with the rest being the internal nodes. See Morison_GenerateSimulationNodes. + + ! NOTE: + ! The PropPot values are only for members, and when the p%AM_End, p%DP_Const_End, p%Mass_MG_End, and p%I_MG_End are computed at init, + ! contributions to these values are added only if the member connecting to the joint is NOT modeled with potential flow theory + ! However, the p%An_End term used data from ALL members attached to a node, regardless of the PropPot setting, because the drag force is alway on. + ! Therefore, no need to check PropPot here. - !do j = 1, p%NNodes - ! ! Sum side load components onto output mesh - ! DO i=1,6 - ! IF (i < 4 ) THEN - ! y%Mesh%Force(I,J) = m%F_D(I,J) + m%F_A(I,J) + m%F_I(I,J) + m%F_B(I,J) + m%F_BF(I,J) + m%F_If(i,j) + m%F_WMG(i,j) + m%F_IMG(i,j) - ! ELSE - ! y%Mesh%Moment(I-3,J) = m%F_D(I,J) + m%F_A(I,J) + m%F_I(I,J) + m%F_B(I,J) + m%F_BF(I,J) + m%F_If(i,j) + m%F_WMG(i,j) + m%F_IMG(i,j) - ! END IF - ! END DO ! - !end do - - - ! --- Hydrodynamic drag loads: joints + ! Effect of wave stretching already baked into m%FDynP, m%FA, and m%vrel. No additional modification needed. - ! NOTE: All wave kinematics have already been zeroed out above the SWL or instantaneous wave height (for WaveStMod > 0), so loads derived from the kinematics will be correct - ! without the use of a nodeInWater value, but other loads need to be multiplied by nodeInWater to zero them out above the SWL or instantaneous wave height. + ! Joint yaw offset + call YawJoint(J,u%PtfmRefY,AM_End,An_End,DP_Const_End,I_MG_End,ErrStat2,ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - DO J = 1, p%NJoints - - ! Obtain the node index because WaveVel, WaveAcc, and WaveDynP are defined in the node indexing scheme, not the markers - - - ! Compute the dot product of the relative velocity vector with the directional Area of the Joint - vmag = m%nodeInWater(j) * ( m%vrel(1,j)*p%An_End(1,J) + m%vrel(2,j)*p%An_End(2,J) + m%vrel(3,j)*p%An_End(3,J) ) - - !NOTE: The PropPot values are only for members, and when the p%AM_End, p%DP_Const_End, p%Mass_MG_End, and p%I_MG_End are computed at init, - ! contributions to these values are added only if the member connecting to the joint is NOT modeled with potential flow theory - ! However, the p%An_End term used data from ALL members attached to a node, regardless of the PropPot setting. - - ! Lumped added mass loads - qdotdot = reshape((/u%Mesh%TranslationAcc(:,J),u%Mesh%RotationAcc(:,J)/),(/6/)) - m%F_A_End(:,J) = m%nodeInWater(j) * matmul( p%AM_End(:,:,J) , ( - qdotdot(1:3)) ) + ! Lumped added mass loads + qdotdot = reshape((/u%Mesh%TranslationAcc(:,J),u%Mesh%RotationAcc(:,J)/),(/6/)) + m%F_A_End(:,J) = m%nodeInWater(j) * matmul( AM_End, ( - qdotdot(1:3)) ) - ! TODO: The original code did not multiply by nodeInWater, but should we? GJH - m%F_I_End(:,J) = (p%DP_Const_End(:,j) * m%FDynP(j) + matmul(p%AM_End(:,:,j),m%FA(:,j))) + ! TODO: The original code did not multiply by nodeInWater, but should we? GJH + ! Should be ok because m%FDynP and m%FA are both zeroed above the SWL (when WaveStMod=0) or the instantaneous free surface (when WaveStMod>0) + m%F_I_End(:,J) = (DP_Const_End * m%FDynP(j) + matmul(AM_End,m%FA(:,j))) - ! Marine growth inertia: ends: Section 4.2.2 - m%F_IMG_End(1:3,j) = -m%nodeInWater(j) * p%Mass_MG_End(j)*qdotdot(1:3) - m%F_IMG_End(4:6,j) = -m%nodeInWater(j) * (matmul(p%I_MG_End(:,:,j),qdotdot(4:6)) - cross_product(u%Mesh%RotationVel(:,J),matmul(p%I_MG_End(:,:,j),u%Mesh%RotationVel(:,J)))) + ! Marine growth inertia: ends: Section 4.2.2 + ! With wave stretching, m%nodeInWater is based on the instantaneous free surface and the current body position if (WaveDisp/=0). + ! This should still be ok because with wave stretching, we do not allow joints to come out of water if initially submerged or + ! enter water if initially out of water. This is enforced when computing the side loads above. + m%F_IMG_End(1:3,j) = -m%nodeInWater(j) * p%Mass_MG_End(j)*qdotdot(1:3) + m%F_IMG_End(4:6,j) = -m%nodeInWater(j) * (matmul(I_MG_End,qdotdot(4:6)) - cross_product(u%Mesh%RotationVel(:,J),matmul(I_MG_End,u%Mesh%RotationVel(:,J)))) + + ! Compute the dot product of the relative velocity vector with the directional Area of the Joint + ! m%nodeInWater(j) is probably not necessary because m%vrel is zeroed when the node is out of water + vmag = m%nodeInWater(j) * ( m%vrel(1,j)*An_End(1) + m%vrel(2,j)*An_End(2) + m%vrel(3,j)*An_End(3) ) + ! High-pass filtering + vmagf = p%VRelNFiltConst(J) * (vmag + xd%v_rel_n_FiltStat(J)) + + ! Record most up-to-date vmagf and vmag at join J + m%v_rel_n(j) = vmag + m%v_rel_n_HiPass(j) = vmagf - DO I=1,6 - - ! We are now combining the dynamic pressure term into the inertia term - - - IF (I < 4 ) THEN - - - m%F_D_End(i,j) = p%An_End(i,j)*p%DragConst_End(j)*abs(vmag)*vmag ! Note: vmag is zero if node is not in the water - y%Mesh%Force(i,j) = y%Mesh%Force(i,j) + m%F_D_End(i,j) + m%F_I_End(i,j) + p%F_WMG_End(i,j) + m%F_B_End(i,j) + m%F_BF_End(i,j) + m%F_A_End(i,j) + m%F_IMG_End(i,j) - ELSE - y%Mesh%Moment(i-3,j) = y%Mesh%Moment(i-3,j) + m%F_B_End(i,j) + m%F_BF_End(i,j) + m%F_IMG_End(i,j) + ! Evaluate drag force and combine all per-joint loads + DO I=1,6 + IF (I < 4 ) THEN ! Three force components + IF ( p%DragMod_End(J) .EQ. 0_IntKi ) THEN + ! Note: vmag is zero if node is not in the water + m%F_D_End(i,j) = (1.0_ReKi - p%DragLoFSc_End(j)) * An_End(i) * p%DragConst_End(j) * abs(vmagf)*vmagf & + + p%DragLoFSc_End(j) * An_End(i) * p%DragConst_End(j) * abs(vmag )*vmag + ELSE IF (p%DragMod_End(J) .EQ. 1_IntKi) THEN + ! Note: vmag is zero if node is not in the water + m%F_D_End(i,j) = (1.0_ReKi - p%DragLoFSc_End(j)) * An_End(i) * p%DragConst_End(j) * abs(vmagf)*max(vmagf,0.0_ReKi) & + + p%DragLoFSc_End(j) * An_End(i) * p%DragConst_End(j) * abs(vmag) *max(vmag, 0.0_ReKi) + m%F_D_End(i,j) = 2.0_ReKi * m%F_D_End(i,j) END IF - END DO ! I=1,6 - ENDDO ! J = 1, p%NJoints - - ! OutSwtch determines whether or not to actually output results via the WriteOutput array - ! 1 = Morison will generate an output file of its own. 2 = the caller will handle the outputs, but - ! Morison needs to provide them. 3 = Both 1 and 2, 0 = No one needs the Morison outputs provided - ! via the WriteOutput array. + + y%Mesh%Force(i,j) = y%Mesh%Force(i,j) + m%F_D_End(i,j) + m%F_I_End(i,j) + p%F_WMG_End(i,j) + m%F_B_End(i,j) + m%F_BF_End(i,j) + m%F_A_End(i,j) + m%F_IMG_End(i,j) + ELSE ! Three moment components + y%Mesh%Moment(i-3,j) = y%Mesh%Moment(i-3,j) + m%F_B_End(i,j) + m%F_BF_End(i,j) + m%F_IMG_End(i,j) + END IF + END DO ! I=1,6 - IF ( p%OutSwtch > 0 ) THEN - - ! Map calculated results into the AllOuts Array - CALL MrsnOut_MapOutputs(Time, y, p, u, m, AllOuts, errStat, errMsg) - - - ! Put the output data in the WriteOutput array + END DO ! J = 1, p%NJoints - DO I = 1,p%NumOuts + !---------------------------------------------------------------------------------------------------------------! + ! External Hydrodynamic Joint Loads - End ! + !---------------------------------------------------------------------------------------------------------------! + ! Map calculated results into the y%WriteOutput Array + CALL MrsnOut_MapOutputs(y, p, u, m) + + + ! map the motion to the visulization mesh + if (p%VisMeshes) then + !FIXME: error handling is incorrect here (overwrites all previous errors/warnings) + call Transfer_Point_to_Line2( u%Mesh, y%VisMesh, m%VisMeshMap, ErrStat, ErrMsg ) + endif + + + CONTAINS + + SUBROUTINE GetDisplacedNodePosition( forceDisplaced, pos ) + LOGICAL, INTENT( IN ) :: forceDisplaced ! Set to true to return the exact displaced position no matter WaveDisp or WaveStMod + REAL(ReKi), INTENT( OUT ) :: pos(:,:) ! Displaced node positions + REAL(ReKi) :: Orient(3,3) + + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + + ! Undisplaced node position + pos = u%Mesh%Position + pos(3,:) = pos(3,:) - p%WaveField%MSL2SWL ! Z position measured from the SWL + IF ( (p%WaveDisp /= 0) .OR. forceDisplaced ) THEN + ! Use displaced X and Y position + pos(1,:) = pos(1,:) + u%Mesh%TranslationDisp(1,:) + pos(2,:) = pos(2,:) + u%Mesh%TranslationDisp(2,:) + IF ( (p%WaveField%WaveStMod > 0) .OR. forceDisplaced ) THEN + ! Use displaced Z position only when wave stretching is enabled + pos(3,:) = pos(3,:) + u%Mesh%TranslationDisp(3,:) + END IF + ELSE ! p%WaveDisp=0 implies PtfmYMod=0 + ! Rotate the structure based on PtfmRefY (constant) + call GetPtfmRefYOrient(u%PtfmRefY, Orient, ErrStat2, ErrMsg2) + pos = matmul(transpose(Orient),pos) + END IF + + END SUBROUTINE GetDisplacedNodePosition + + SUBROUTINE GetTotalWaveElev( Time, pos, Zeta, ErrStat, ErrMsg ) + REAL(DbKi), INTENT( IN ) :: Time + REAL(ReKi), INTENT( IN ) :: pos(*) ! Position at which free-surface elevation is to be calculated. Third entry ignored if present. + REAL(ReKi), INTENT( OUT ) :: Zeta ! Total free-surface elevation with first- and second-order contribution (if present) + INTEGER(IntKi), INTENT( OUT ) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT ) :: ErrMsg ! Error message if errStat /= ErrID_None + CHARACTER(*), PARAMETER :: RoutineName = 'GetTotalWaveElev' + INTEGER(IntKi) :: errStat2 + CHARACTER(ErrMsgLen) :: errMsg2 + ErrStat = ErrID_None + ErrMsg = "" + + Zeta = WaveField_GetNodeTotalWaveElev( p%WaveField, m%WaveField_m, Time, pos, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + END SUBROUTINE GetTotalWaveElev + + SUBROUTINE GetFreeSurfaceNormal( Time, pos, r, n, ErrStat, ErrMsg) + REAL(DbKi), INTENT( In ) :: Time + REAL(ReKi), INTENT( In ) :: pos(*) ! Position at which free-surface normal is to be calculated. Third entry ignored if present. + REAL(ReKi), INTENT( In ) :: r ! Distance for central differencing + REAL(ReKi), INTENT( OUT ) :: n(3) ! Free-surface normal vector + INTEGER(IntKi), INTENT( OUT ) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT ) :: ErrMsg ! Error message if errStat /= ErrID_None + CHARACTER(*), PARAMETER :: RoutineName = 'GetFreeSurfaceNormal' + INTEGER(IntKi) :: errStat2 + CHARACTER(ErrMsgLen) :: errMsg2 + ErrStat = ErrID_None + ErrMsg = "" + + CALL WaveField_GetNodeWaveNormal( p%WaveField, m%WaveField_m, Time, pos, r, n, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + END SUBROUTINE GetFreeSurfaceNormal + + SUBROUTINE GetSectionUnitVectors( k, y, z ) + REAL(ReKi), INTENT( In ) :: k(3) ! Member axial unit vector + REAL(ReKi), INTENT( OUT ) :: y(3) ! Horizontal unit vector perpendicular to k + REAL(ReKi), INTENT( OUT ) :: z(3) ! Unit vector perpendicular to k and y with positive vertical component + IF ( ABS(k(3)) > 0.999999_ReKi ) THEN ! k is effectively vertical + y = (/0.0,1.0,0.0/) + ELSE + y = (/-k(2),k(1),0.0_ReKi/) + y = y / SQRT(Dot_Product(y,y)) + ENDIF + z = cross_product(k,y) + IF ( z(3) < 0.0 ) THEN ! Flip y and z so z points upward + y = -y; + z = -z; + END IF + END SUBROUTINE GetSectionUnitVectors + + SUBROUTINE GetSectionFreeSurfaceIntersects( pos0, FSPt, k_hat, y_hat, z_hat, n_hat, R, theta1, theta2, secStat) + REAL(DbKi), INTENT( In ) :: pos0(3) + REAL(DbKi), INTENT( In ) :: FSPt(3) + REAL(ReKi), INTENT( In ) :: k_hat(3) + REAL(ReKi), INTENT( In ) :: y_hat(3) + REAL(ReKi), INTENT( In ) :: z_hat(3) + REAL(ReKi), INTENT( In ) :: n_hat(3) + REAL(DbKi), INTENT( In ) :: R + REAL(DbKi), INTENT( OUT ) :: theta1 + REAL(DbKi), INTENT( OUT ) :: theta2 + INTEGER(IntKi), INTENT( OUT ) :: secStat + REAL(DbKi) :: a, b, c, d, d2 + REAL(DbKi) :: alpha, beta + REAL(DbKi) :: tmp + CHARACTER(*), PARAMETER :: RoutineName = 'GetSectionFreeSurfaceIntersects' + + a = R * dot_product(y_hat,n_hat) + b = R * dot_product(z_hat,n_hat) + c = dot_product(FSPt-pos0,n_hat) + d2 = a*a+b*b + IF ( d2 >= c*c ) THEN ! Has intersection + d = SQRT(d2) + IF (b>=0.0) THEN + alpha = ACOS(a/d) + ELSE + alpha = -ACOS(a/d) + END IF + beta = ACOS(c/d) + theta1 = alpha - beta + theta2 = alpha + beta + IF ( dot_product( (cos(theta2)-cos(theta1))*z_hat-(sin(theta2)-sin(theta1))*y_hat, n_hat) < 0.0 ) THEN + tmp = theta1 + theta1 = theta2 + theta2 = tmp + 2.0*PI_D + END IF + secStat = 1; + ELSE IF (c > 0.0) THEN ! Section is fully submerged + theta1 = -1.5*PI_D + theta2 = 0.5*PI_D + secStat = 2; + ELSE ! Section is completely dry + theta1 = -0.5*PI_D + theta2 = -0.5*PI_D + secStat = 0; + END IF + + END SUBROUTINE GetSectionFreeSurfaceIntersects + + SUBROUTINE GetSectionHstLds( origin, pos0, k_hat, y_hat, z_hat, R, dRdl, theta1, theta2, dFdl) + + REAL(DbKi), INTENT( IN ) :: origin(3) + REAL(DbKi), INTENT( IN ) :: pos0(3) + REAL(DbKi), INTENT( IN ) :: k_hat(3) + REAL(DbKi), INTENT( IN ) :: y_hat(3) + REAL(DbKi), INTENT( IN ) :: z_hat(3) + REAL(DbKi), INTENT( IN ) :: R + REAL(DbKi), INTENT( IN ) :: dRdl + REAL(DbKi), INTENT( IN ) :: theta1 + REAL(DbKi), INTENT( IN ) :: theta2 + REAL(DbKi), INTENT( OUT ) :: dFdl(6) + REAL(DbKi) :: C0, C1, C2 + REAL(DbKi) :: Z0, dTheta, sinTheta1, sinTheta2, cosTheta1, cosTheta2, cosPhi + + Z0 = pos0(3) + dTheta = theta2 - theta1 + sinTheta1 = SIN(theta1) + sinTheta2 = SIN(theta2) + cosTheta1 = COS(theta1) + cosTheta2 = COS(theta2) + cosPhi = SQRT(k_hat(1)**2+k_hat(2)**2) + + C0 = Z0*dTheta + R*cosPhi*(cosTheta1 -cosTheta2) + C1 = Z0*(sinTheta2-sinTheta1) + 0.5*R*cosPhi*(cosTheta2**2-cosTheta1**2) + C2 = Z0*(cosTheta1-cosTheta2) + 0.5*R*cosPhi*(dTheta-sinTheta2*cosTheta2+sinTheta1*cosTheta1) + + dFdl(1:3) = -R *dRdl*C0*k_hat + R*C1*y_hat + R*C2*z_hat + dFdl(4:6) = -R**2*dRdl*C2*y_hat + R**2*dRdl*C1*z_hat + CROSS_PRODUCT((pos0-origin),dFdl(1:3)) + dFdl = dFdl * p%WaveField%WtrDens * g + + END SUBROUTINE GetSectionHstLds + + SUBROUTINE getElementHstLds_Mod2( pos1In, pos2In, FSPtIn, k_hatIn, y_hatIn, z_hatIn, n_hatIn, r1In, r2In, dlIn, F_B1, F_B2, ErrStat, ErrMsg ) + + REAL(ReKi), INTENT( IN ) :: pos1In(3) + REAL(ReKi), INTENT( IN ) :: pos2In(3) + REAL(ReKi), INTENT( IN ) :: FSPtIn(3) + REAL(ReKi), INTENT( IN ) :: k_hatIn(3) + REAL(ReKi), INTENT( IN ) :: y_hatIn(3) + REAL(ReKi), INTENT( IN ) :: z_hatIn(3) + REAL(ReKi), INTENT( IN ) :: n_hatIn(3) + REAL(ReKi), INTENT( IN ) :: r1In + REAL(ReKi), INTENT( IN ) :: r2In + REAL(ReKi), INTENT( IN ) :: dlIn + REAL(ReKi), INTENT( OUT ) :: F_B1(6) + REAL(ReKi), INTENT( OUT ) :: F_B2(6) + INTEGER(IntKi), INTENT( OUT ) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT ) :: ErrMsg ! Error message if errStat /= ErrID_None + REAL(DbKi) :: theta1, theta2 + REAL(DbKi) :: dFdl1(6), dFdlMid(6), dFdl2(6), F_B(6) + REAL(DbKi) :: i, dl, r1, r2, rMid, dRdl, posMid(3), pos1(3), pos2(3), FSPt(3), k_hat(3), y_hat(3), z_hat(3), n_hat(3) + INTEGER(IntKi) :: secStat1, secStatMid, secStat2 + CHARACTER(*), PARAMETER :: routineName = "getElementHstLds_Mod2" + INTEGER(IntKi) :: errStat2 + CHARACTER(ErrMsgLen) :: errMsg2 + ErrStat = ErrID_None + ErrMsg = "" + + pos1 = REAL(pos1In,DbKi) + pos2 = REAL(pos2In,DbKi) + r1 = REAL(r1In,DbKi) + r2 = REAL(r2In,DbKi) + dl = REAL(dlIn,DbKi) + dRdl = (r2-r1)/dl + rMid = 0.5*( r1+ r2) + posMid = 0.5*(pos1In+pos2In) + FSPt = REAL(FSPtIn,DbKi) + k_hat = REAL(k_hatIn,DbKi) + y_hat = REAL(y_hatIn,DbKi) + z_hat = REAL(z_hatIn,DbKi) + n_hat = REAL(n_hatIn,DbKi) + + ! Avoid sections coincident with the SWL + IF ( ABS(k_hat(3)) > 0.999999_ReKi ) THEN ! Vertical member + IF ( EqualRealNos( pos1(3), 0.0_DbKi ) ) THEN + pos1(3) = pos1(3) - 1.0E-6 * dl + END IF + IF ( EqualRealNos( pos2(3), 0.0_DbKi ) ) THEN + pos2(3) = pos2(3) - 1.0E-6 * dl + END IF + IF ( EqualRealNos( posMid(3), 0.0_DbKi ) ) THEN + posMid(3) = posMid(3) - 1.0E-6 * dl + END IF + END IF + + ! Section load at node 1 + CALL GetSectionFreeSurfaceIntersects( pos1, FSPt, REAL(k_hat,ReKi), REAL(y_hat,ReKi), REAL(z_hat,ReKi), REAL(n_hat,ReKi), r1, theta1, theta2, secStat1) + CALL GetSectionHstLds( pos1, pos1, k_hat, y_hat, z_hat, r1, dRdl, theta1, theta2, dFdl1) + + ! Section load at midpoint + CALL GetSectionFreeSurfaceIntersects( posMid, FSPt, REAL(k_hat,ReKi), REAL(y_hat,ReKi), REAL(z_hat,ReKi), REAL(n_hat,ReKi), rMid, theta1, theta2, secStatMid) + CALL GetSectionHstLds( pos1, posMid, k_hat, y_hat, z_hat, rMid, dRdl, theta1, theta2, dFdlMid) + + ! Section load at node 2 + CALL GetSectionFreeSurfaceIntersects( pos2, FSPt, REAL(k_hat,ReKi), REAL(y_hat,ReKi), REAL(z_hat,ReKi), REAL(n_hat,ReKi), r2, theta1, theta2, secStat2) + CALL GetSectionHstLds( pos1, pos2, k_hat, y_hat, z_hat, r2, dRdl, theta1, theta2, dFdl2) + + ! Adaptively refine the load integration over the element + CALL RefineElementHstLds(pos1,pos1,posMid,pos2,FSPt,r1,rMid,r2,dl,dRdl,secStat1,secStatMid,secStat2,k_hat,y_hat,z_hat,n_hat,dFdl1,dFdlMid,dFdl2,1,F_B,ErrStat2,ErrMsg2) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ! Distribute the hydrostatic load to the two end nodes + F_B1(1:3) = 0.5 * F_B(1:3) + F_B2(1:3) = 0.5 * F_B(1:3) + F_B(4:6) = F_B(4:6) - CROSS_PRODUCT(k_hat*dl,F_B2(1:3)) + F_B1(4:6) = 0.5 * F_B(4:6) + F_B2(4:6) = 0.5 * F_B(4:6) + + END SUBROUTINE getElementHstLds_Mod2 + + RECURSIVE SUBROUTINE RefineElementHstLds( origin, pos1, posMid, pos2, FSPt, r1, rMid, r2, dl, dRdl,secStat1,secStatMid,secStat2, k_hat, y_hat, z_hat, n_hat, dFdl1, dFdlMid, dFdl2, recurLvl, F_B_5pt, ErrStat, ErrMsg) + + REAL(DbKi), INTENT( IN ) :: origin(3) + REAL(DbKi), INTENT( IN ) :: pos1(3) + REAL(DbKi), INTENT( IN ) :: posMid(3) + REAL(DbKi), INTENT( IN ) :: pos2(3) + REAL(DbKi), INTENT( IN ) :: FSPt(3) + REAL(DbKi), INTENT( IN ) :: r1 + REAL(DbKi), INTENT( IN ) :: rMid + REAL(DbKi), INTENT( IN ) :: r2 + REAL(DbKi), INTENT( IN ) :: dl + REAL(DbKi), INTENT( IN ) :: dRdl + INTEGER(IntKi), INTENT( IN ) :: secStat1 + INTEGER(IntKi), INTENT( IN ) :: secStatMid + INTEGER(IntKi), INTENT( IN ) :: secStat2 + REAL(DbKi), INTENT( IN ) :: k_hat(3) + REAL(DbKi), INTENT( IN ) :: y_hat(3) + REAL(DbKi), INTENT( IN ) :: z_hat(3) + REAL(DbKi), INTENT( IN ) :: n_hat(3) + REAL(DbKi), INTENT( IN ) :: dFdl1(6) + REAL(DbKi), INTENT( IN ) :: dFdlMid(6) + REAL(DbKi), INTENT( IN ) :: dFdl2(6) + INTEGER(IntKi), INTENT( IN ) :: recurLvl + REAL(DbKi), INTENT( OUT ) :: F_B_5pt(6) + INTEGER(IntKi), INTENT( OUT ) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT ) :: ErrMsg ! Error message if errStat /= ErrID_None + + REAL(DbKi) :: theta1,theta2 + REAL(DbKi) :: posMidL(3), posMidR(3) + REAL(DbKi) :: rMidL, rMidR + REAL(DbKi) :: dFdlMidL(6), dFdlMidR(6), F_B_3pt(6) + REAL(DbKi) :: error(6), tmp(6) + LOGICAL :: refine, tolMet + INTEGER(IntKi) :: i + INTEGER(IntKi) :: secStatMidL, secStatMidR + REAL(DbKi), PARAMETER :: RelTol = 1.0E-6 + REAL(DbKi), PARAMETER :: AbsTol = 1.0E-8 + INTEGER(IntKi), PARAMETER :: maxRecurLvl = 50 + CHARACTER(*), PARAMETER :: RoutineName = "RefineElementHstLds" + + ErrStat = ErrID_None + ErrMsg = "" + + posMidL = 0.5*(pos1+posMid) + posMidR = 0.5*(posMid+pos2) + rMidL = 0.5*(r1+rMid) + rMidR = 0.5*(rMid+r2) + + ! Avoid sections coincident with the SWL + IF ( ABS(k_hat(3)) > 0.999999_ReKi ) THEN ! Vertical member + IF ( EqualRealNos( posMidL(3), 0.0_DbKi ) ) THEN + posMidL(3) = posMidL(3) - 1.0E-6 * dl + END IF + IF ( EqualRealNos( posMidR(3), 0.0_DbKi ) ) THEN + posMidR(3) = posMidR(3) - 1.0E-6 * dl + END IF + END IF + + ! Total hydrostatic load on the element (Simpsons Rule) + F_B_3pt = (dFdl1 + 4.0*dFdlMid + dFdl2) * dl/6.0 - y%WriteOutput(I) = p%OutParam(I)%SignM * AllOuts( p%OutParam(I)%Indx ) + ! Mid point of left section + CALL GetSectionFreeSurfaceIntersects( posMidL, FSPt, REAL(k_hat,ReKi), REAL(y_hat,ReKi), REAL(z_hat,ReKi), REAL(n_hat,ReKi), rMidL, theta1, theta2, secStatMidL) + CALL GetSectionHstLds( origin, posMidL, k_hat, y_hat, z_hat, rMidL, dRdl, theta1, theta2, dFdlMidL) + + ! Mid point of right section + CALL GetSectionFreeSurfaceIntersects( posMidR, FSPt, REAL(k_hat,ReKi), REAL(y_hat,ReKi), REAL(z_hat,ReKi), REAL(n_hat,ReKi), rMidR, theta1, theta2, secStatMidR) + CALL GetSectionHstLds( origin, posMidR, k_hat, y_hat, z_hat, rMidR, dRdl, theta1, theta2, dFdlMidR) - END DO + F_B_5pt = (dFdl1 + 4.0*dFdlMidL + 2.0*dFdlMid + 4.0*dFdlMidR + dFdl2) * dl/12.0 + + error = ABS(F_B_3pt - F_B_5pt) + tolMet = .TRUE. + DO i = 1,6 + IF ( error(i) > MAX(RelTol*ABS(F_B_5pt(i)),AbsTol) ) THEN + tolMet = .FALSE. + END IF + END DO + refine = .NOT. tolMet + IF (ABS(secStat1-secStat2)>1) THEN ! (Sub)element bounds the waterplane + refine = .TRUE. ! Keep refining irrespective of tolMet to avoid premature termination + END IF + IF ( recurLvl > maxRecurLvl ) THEN + refine = .FALSE. + IF (.NOT. tolMet) THEN + CALL SetErrStat(ErrID_Warn, 'Tolerance for element hydrostatic load not met after the maximum allowed level of recursion is reached. Consider reducing MDivSize.', ErrStat, ErrMsg, RoutineName ) + ! ELSE + ! Free surface is likely normal to the element. + END IF + END IF + + IF (refine) THEN ! Recursively refine the load integration if tolerance not met + CALL RefineElementHstLds(origin,pos1,posMidL,posMid,FSPt,r1,rMidL,rMid,0.5*dl,dRdl,secStat1,secStatMidL,secStatMid,k_hat,y_hat,z_hat,n_hat,dFdl1,dFdlMidL,dFdlMid, recurLvl+1, tmp, ErrStat, ErrMsg) + CALL RefineElementHstLds(origin,posMid,posMidR,pos2,FSPt,rMid,rMidR,r2,0.5*dl,dRdl,secStatMid,secStatMidR,secStat2,k_hat,y_hat,z_hat,n_hat,dFdlMid,dFdlMidR,dFdl2, recurLvl+1, F_B_5pt, ErrStat, ErrMsg) + F_B_5pt = F_B_5pt + tmp + END IF + + END SUBROUTINE RefineElementHstLds + + SUBROUTINE GetEndPlateHstLds(pos0, k_hat, y_hat, z_hat, R, theta1, theta2, F) + + REAL(ReKi), INTENT( IN ) :: pos0(3) + REAL(ReKi), INTENT( IN ) :: k_hat(3) + REAL(ReKi), INTENT( IN ) :: y_hat(3) + REAL(ReKi), INTENT( IN ) :: z_hat(3) + REAL(ReKi), INTENT( IN ) :: R + REAL(DbKi), INTENT( IN ) :: theta1 + REAL(DbKi), INTENT( IN ) :: theta2 + REAL(ReKi), INTENT( OUT ) :: F(6) + REAL(DbKi) :: C0, C1, C2, a, b, tmp1, tmp2, tmp3 + REAL(DbKi) :: Z0, cosPhi, dTheta + REAL(DbKi) :: y1, y2 + REAL(DbKi) :: z1, z2, z1_2, z2_2, z1_3, z2_3, z1_4, z2_4 + REAL(DbKi) :: dy, dy_3, dz, dz_2, dz_3, dz_4, sz + REAL(DbKi) :: R_2, R_4 + REAL(DbKi) :: Fk, My, Mz + + Z0 = pos0(3) + cosPhi = SQRT(k_hat(1)**2+k_hat(2)**2) + dTheta = theta2-theta1 + y1 = R*COS(theta1) + z1 = R*SIN(theta1) + y2 = R*COS(theta2) + z2 = R*SIN(theta2) + z1_2 = z1*z1 + z1_3 = z1*z1_2 + z1_4 = z1*z1_3 + z2_2 = z2*z2 + z2_3 = z2*z2_2 + z2_4 = z2*z2_3 + R_2 = R*R + R_4 = R_2*R_2 + dy = y2-y1 + sz = z1+z2 + dy_3 = y2*y2*y2-y1*y1*y1 + dz_2 = z2_2-z1_2 + dz_3 = z2_3-z1_3 + dz_4 = z2_4-z1_4 + tmp1 = y1*z2-y2*z1 + tmp2 = z1_2+z1*z2+z2_2 + + ! End plate force in the k_hat direction + Fk = -0.5*Z0*(R_2*dTheta-tmp1) + cosPhi/6.0*( 2.0*dy_3 - z1*z2*dy - z1_2*(y2+2.0*y1) + z2_2*(y1+2.0*y2) ) + F(1:3) = p%WaveField%WtrDens * g * Fk * k_hat + + ! End plate moment in the y_hat and z_hat direction + My = Z0/6.0*( 2.0*dy_3 + 2.0*dy*tmp2 + 3.0*tmp1*sz ) & ! y_hat component + + cosPhi/24.0*( -3.0*R_4*dTheta + 3.0*y1*z1*(2.0*z1_2-R_2) - 3.0*y2*z2*(2.0*z2_2-R_2) & + + 6.0*dy*sz*(z1_2+z2_2) + 8.0*tmp1*tmp2 ) + IF (EqualRealNos(z1, z2)) THEN ! z_hat component (Nonzero only when z1 /= z2) + Mz = 0.0 + ELSE + dz = z2-z1 + a = dy/dz + b = tmp1/dz + tmp1 = a*a+1.0 + tmp2 = a*b + tmp3 = b*b-R_2 + Mz = -Z0/ 6.0*( tmp1*dz_3 + 3.0*tmp2*dz_2 + 3.0*tmp3*dz ) & + -cosPhi/24.0*(3.0*tmp1*dz_4 + 8.0*tmp2*dz_3 + 6.0*tmp3*dz_2) + END IF + F(4:6) = p%WaveField%WtrDens * g * (My*y_hat + Mz*z_hat) + + END SUBROUTINE GetEndPlateHstLds + + SUBROUTINE getElementHstLds_Mod1( Time, pos1, pos2, Zeta1, Zeta2, k_hat, r1, r2, dl, alphaIn, Is1stElement, F_B0, F_B1, F_B2, ErrStat, ErrMsg ) + + REAL(DbKi), INTENT( IN ) :: Time + REAL(ReKi), INTENT( IN ) :: pos1(3) + REAL(ReKi), INTENT( IN ) :: pos2(3) + REAL(ReKi), INTENT( IN ) :: Zeta1 + REAL(ReKi), INTENT( IN ) :: Zeta2 + REAL(ReKi), INTENT( IN ) :: k_hat(3) + REAL(ReKi), INTENT( IN ) :: r1 + REAL(ReKi), INTENT( IN ) :: r2 + REAL(ReKi), INTENT( IN ) :: dl + REAL(ReKi), INTENT( IN ) :: alphaIn + LOGICAL, INTENT( IN ) :: Is1stElement + REAL(ReKi), INTENT( OUT ) :: F_B0(6) ! Lumped load at the first node of the last element + REAL(ReKi), INTENT( OUT ) :: F_B1(6) ! Lumped load at the first node of the current element + REAL(ReKi), INTENT( OUT ) :: F_B2(6) ! Lumped load at the second node of the current element + INTEGER(IntKi), INTENT( OUT ) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT ) :: ErrMsg ! Error message if errStat /= ErrID_None + REAL(ReKi) :: alpha, dRdl, SubRatio + REAL(ReKi) :: Vs, Vrc, Vhc + REAL(ReKi) :: h0, rh, a0, b0, a0b0, s0, C_1, C_2, Z0 + REAL(ReKi) :: sinGamma, cosGamma, tanGamma + REAL(ReKi) :: FbVec(3), MbVec(3), FSInt(3), n_hat(3), t_hat(3), s_hat(3), r_hat(3) + INTEGER(IntKi) :: errStat2 + CHARACTER(ErrMsgLen) :: errMsg2 + INTEGER(IntKi), PARAMETER :: pwr = 3 ! Exponent for buoyancy node distribution smoothing + CHARACTER(*), PARAMETER :: RoutineName = "getElementHstLds_Mod1" + + F_B0 = 0.0_ReKi + F_B1 = 0.0_ReKi + F_B2 = 0.0_ReKi + + dRdl = (r2 - r1)/dl + + IF ( (z1 < Zeta1) .AND. (z2 < Zeta2) ) THEN ! If element is fully submerged + ! Compute the waterplane shape, the submerged volume, and it's geometric center + ! No need to consider tapered and non-tapered elements separately + Vs = Pi*dl *(r1**2 + r1*r2 + r2**2 ) / 3.0_ReKi ! volume of total submerged portion + Vhc = Pi*dl**2*(r1**2 + 2.0*r1*r2 + 3.0*r2**2 ) / 12.0_ReKi ! Submerged Volume * h_c + + ! Hydrostatic force on element + FbVec = (/0.0_ReKi,0.0_ReKi,Vs/) - Pi*( r2*r2*z2 - r1*r1*z1) *k_hat + FbVec = p%WaveField%WtrDens * g * FbVec + + ! Hydrostatic moment on element about the lower node + MbVec = (Vhc+0.25*Pi*(r2**4-r1**4)) * Cross_Product(k_hat,(/0.0_ReKi,0.0_ReKi,1.0_ReKi/)) + MbVec = p%WaveField%WtrDens * g * MbVec + + ! Distribute element load to nodes + alpha = alphaIn*(z2-Zeta2)**pwr/(alphaIn*(z2-Zeta2)**pwr+(1.0_ReKi-alphaIn)*(z1-Zeta1)**pwr) + + ! Hydrostatic force + F_B1(1:3) = (1-alpha) * FbVec + F_B2(1:3) = alpha * FbVec + ! Hydrostatic moment correction followed by redistribution + MbVec = MbVec - Cross_Product( k_hat*dl, F_B2(1:3)) + F_B1(4:6) = (1-alpha) * MbVec + F_B2(4:6) = alpha * MbVec - ! Generate output into the output file - - IF ( p%OutSwtch == 1 .OR. p%OutSwtch == 3 ) THEN - CALL MrsnOut_WriteOutputs( p%UnOutFile, Time, y, p, errStat, errMsg ) + ELSE IF ( (z1 < Zeta1) .AND. (z2 >= Zeta2) ) THEN ! Element is partially submerged + ! Submergence ratio + SubRatio = ( Zeta1-pos1(3) ) / ( (Zeta1-pos1(3)) - (Zeta2-pos2(3)) ) + ! The position of the intersection between the free surface and the element + FSInt = SubRatio * (pos2-pos1) + pos1 + ! Distances along element centerline from point 1 to the waterplane + h0 = SubRatio * dl + ! Scaled radius of element at point where its centerline crosses the waterplane + rh = r1 + h0*dRdl + ! Estimate the free-surface normal at the free-surface intersection, n_hat + IF ( p%WaveField%WaveStMod > 0_IntKi ) THEN ! If wave stretching is enabled, compute free surface normal + CALL GetFreeSurfaceNormal( Time, FSInt, rh, n_hat, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ELSE ! Without wave stretching, use the normal of the SWL + n_hat = (/0.0_ReKi,0.0_ReKi,1.0_ReKi/) + END IF + ! Get other relevant unit vectors, t_hat, r_hat, and s_hat + t_hat = Cross_Product(k_hat,n_hat) + sinGamma = SQRT(Dot_Product(t_hat,t_hat)) + cosGamma = Dot_Product(k_hat,n_hat) + tanGamma = sinGamma/cosGamma + IF (sinGamma < 0.0001) THEN ! Free surface normal is aligned with the element + ! Arbitrary choice for t_hat as long as it is perpendicular to k_hat + IF ( k_hat(3) < 0.999999_ReKi ) THEN + t_hat = (/-k_hat(2),k_hat(1),0.0_ReKi/) + t_hat = t_hat / SQRT(Dot_Product(t_hat,t_hat)) + ELSE ! k_hat is close to vertical (0,0,1) + t_hat = (/1.0_ReKi,0.0_ReKi,0.0_ReKi/); + END IF + ELSE + t_hat = t_hat / sinGamma + END IF + s_hat = Cross_Product(t_hat,n_hat) + r_hat = Cross_Product(t_hat,k_hat) + + ! Compute the waterplane shape, the submerged volume, and it's geometric center + IF (abs(dRdl) < 0.0001) THEN ! non-tapered member + + IF (cosGamma < 0.0001) THEN + CALL SetErrStat(ErrID_Fatal, 'Element cannot be parallel to the free surface. This has happened for Member ID '//trim(num2lstr(mem%MemberID)), errStat, errMsg, RoutineName ) + END IF + + a0 = r1/cosGamma ! Semi major axis of waterplane + b0 = r1 ! Semi minor axis of waterplane + a0b0 = a0*b0 + s0 = 0.0_ReKi ! Distance from the center of the waterplane to the element centerline + Vs = Pi*r1**2*h0 ! volume of total submerged portion + Vrc = -0.25*Pi*r1**4*tanGamma ! Submerged Volume * r_c + Vhc = 0.125*Pi*r1**2* (4.0*h0**2 + r1**2 * tanGamma**2) ! Submerged Volume * h_c + + ELSE ! tapered member + C_1 = 1.0_ReKi - dRdl**2 * tanGamma**2 + IF (C_1 < 0.0001) THEN ! The free surface is nearly tangent to the element wall + CALL SetErrStat(ErrID_Fatal, 'Element cannot be parallel to the free surface. This has happened for Member ID '//trim(num2lstr(mem%MemberID)), errStat, errMsg, RoutineName ) + END IF + + a0 = rh/(C_1*cosGamma) ! Semi major axis of waterplane + b0 = rh/sqrt(C_1) ! Semi minor axis of waterplane + a0b0 = a0*b0 + C_2 = a0b0*rh*cosGamma - r1**3 + s0 = -rh*dRdl*tanGamma/C_1/cosGamma ! Distance from the center of the waterplane to the element centerline + Vs = Pi*C_2/(3.0*dRdl) ! volume of total submerged portion + Vrc = -0.25*Pi * a0b0*rh**2*sinGamma/C_1 ! Submerged Volume * r_c + Vhc = 0.25*Pi * (a0b0*rh**2*cosGamma/C_1 - r1**4 - 4.0_ReKi/3.0_ReKi*r1*C_2 ) /dRdl**2 ! Submerged Volume * h_c + + END IF + + ! z-coordinate of the center of the waterplane in the global earth-fixed system + Z0 = z1+h0*k_hat(3)+s0*s_hat(3) + + ! Hydrostatic force on element + FbVec = (/0.0_ReKi,0.0_ReKi,Vs/) - Pi*a0b0*Z0*n_hat + Pi*r1**2*z1*k_hat + FbVec = p%WaveField%WtrDens * g * FbVec + + ! Hydrostatic moment on element about the lower node + MbVec = Cross_Product( Vrc*r_hat+Vhc*k_hat, (/0.0_ReKi,0.0_ReKi,1.0_ReKi/) ) & + + 0.25*Pi*a0b0* ( ( s_hat(3)*a0*a0 + 4.0*(s0-h0*sinGamma)*Z0 )*t_hat - t_hat(3)*b0*b0*s_hat ) & + - 0.25*Pi*r1**4*( r_hat(3) *t_hat - t_hat(3) * r_hat ) + MbVec = p%WaveField%WtrDens * g * MbVec + + IF ( Is1stElement ) THEN ! This is the 1st element of the member + ! Assign the element load to the lower (1st) node of the member + F_B1(1:3) = FbVec + F_B1(4:6) = MbVec + ELSE ! This is not the 1st element of the member + ! Distribute element load to nodes + alpha = (1.0-alphaIn)*(z1-Zeta1)**pwr / ( -alphaIn*(z2-Zeta2)**pwr + (1.0-alphaIn)*(z1-Zeta1)**pwr ) + ! Hydrostatic force + F_B0(1:3) = (1-alpha) * FbVec + F_B1(1:3) = alpha * FbVec + ! Hydrostatic moment correction followed by redistribution + MbVec = MbVec - Cross_Product( -k_hat*dl, F_B0(1:3)) + F_B0(4:6) = (1-alpha) * MbVec + F_B1(4:6) = alpha * MbVec END IF END IF + END SUBROUTINE getElementHstLds_Mod1 + SUBROUTINE YawMember(member, PtfmRefY, ErrStat, ErrMsg) + Type(Morison_MemberType), intent(inout) :: member + Real(ReKi), intent(in ) :: PtfmRefY + Integer(IntKi), intent( out) :: ErrStat + Character(*), intent( out) :: ErrMsg - ! map the motion to the visulization mesh - if (p%VisMeshes) then - !FIXME: error handling is incorrect here (overwrites all previous errors/warnings) - call Transfer_Point_to_Line2( u%Mesh, y%VisMesh, m%VisMeshMap, ErrStat, ErrMsg ) - endif + Real(ReKi) :: k(3) + Real(ReKi) :: kkt(3,3) + Real(ReKi) :: Ak(3,3) + Integer(IntKi) :: ErrStat2 + Character(ErrMsgLen) :: ErrMsg2 + Character(*), parameter :: RoutineName = 'YawMember' -END SUBROUTINE Morison_CalcOutput + ErrStat = ErrID_None + ErrMsg = '' + call hiFrameTransform(h2i,PtfmRefY,member%k,k,ErrStat2,ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + member%k = k + + call hiFrameTransform(h2i,PtfmRefY,member%kkt,kkt,ErrStat2,ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + member%kkt = kkt + + call hiFrameTransform(h2i,PtfmRefY,member%Ak,Ak,ErrStat2,ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + member%Ak = Ak + + END SUBROUTINE YawMember + + SUBROUTINE YawJoint(JointNo,PtfmRefY,AM_End,An_End,DP_Const_End,I_MG_End,ErrStat,ErrMsg) + Integer(IntKi), intent(in ) :: JointNo + Real(ReKi), intent(in ) :: PtfmRefY + Real(ReKi), intent( out) :: AM_End(3,3) + Real(ReKi), intent( out) :: An_End(3) + Real(ReKi), intent( out) :: DP_Const_End(3) + Real(ReKi), intent( out) :: I_MG_End(3,3) + Integer(IntKi), intent( out) :: ErrStat + Character(*), intent( out) :: ErrMsg + + Integer(IntKi) :: ErrStat2 + Character(ErrMsgLen) :: ErrMsg2 + + Character(*), parameter :: RoutineName = 'YawJoint' + + ErrStat = ErrID_None + ErrMsg = '' + + call hiFrameTransform(h2i,PtfmRefY,p%AM_End(:,:,jointNo),AM_End,ErrStat2,ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + call hiFrameTransform(h2i,PtfmRefY,p%An_End(:,jointNo),An_End,ErrStat2,ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + call hiFrameTransform(h2i,PtfmRefY,p%DP_Const_End(:,jointNo),DP_Const_End,ErrStat2,ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + call hiFrameTransform(h2i,PtfmRefY,p%I_MG_End(:,:,jointNo),I_MG_End,ErrStat2,ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + END SUBROUTINE YawJoint + + +END SUBROUTINE Morison_CalcOutput +!---------------------------------------------------------------------------------------------------------------------------------- subroutine LumpDistrHydroLoads( f_hydro, k_hat, dl, h_c, lumpedLoad ) real(ReKi), intent(in ) :: f_hydro(3) real(ReKi), intent(in ) :: k_hat(3) real(ReKi), intent(in ) :: dl real(ReKi), intent(in ) :: h_c real(ReKi), intent(inout) :: lumpedLoad(6) - !lumpedLoad(1:3) = lumpedLoad(1:3) + f_hydro*dl - !lumpedLoad(4:6) = lumpedLoad(4:6) + cross_product(k_hat*h_c, f_hydro)*dl lumpedLoad(1:3) = f_hydro*dl lumpedLoad(4:6) = cross_product(k_hat*h_c, f_hydro)*dl end subroutine LumpDistrHydroLoads - +!---------------------------------------------------------------------------------------------------------------------------------- ! Takes loads on node i in element tilted frame and converts to 6DOF loads at node i and adjacent node SUBROUTINE DistributeElementLoads(Fl, Fr, M, sinPhi, cosPhi, SinBeta, cosBeta, alpha, F1, F2) @@ -3458,53 +4209,23 @@ SUBROUTINE DistributeElementLoads(Fl, Fr, M, sinPhi, cosPhi, SinBeta, cosBeta, a REAL(ReKi), INTENT ( OUT ) :: F1(6) ! (N, Nm) force/moment vector for node i REAL(ReKi), INTENT ( OUT ) :: F2(6) ! (N, Nm) force/moment vector for the other node (whether i+1, or i-1) - - - !F1(1) = F1(1) + cosBeta*(Fl*sinPhi + Fr*cosPhi)*alpha - !F1(2) = F1(2) - sinBeta*(Fl*sinPhi + Fr*cosPhi)*alpha - !F1(3) = F1(3) + (Fl*cosPhi - Fr*sinPhi)*alpha - !F1(4) = F1(4) + sinBeta * M *alpha - !F1(5) = F1(5) + cosBeta * M *alpha - !!F1(6) = F1(6) + 0.0 - ! - !F2(1) = F2(1) + cosBeta*(Fl*sinPhi + Fr*cosPhi)*(1-alpha) - !F2(2) = F2(2) - sinBeta*(Fl*sinPhi + Fr*cosPhi)*(1-alpha) - !F2(3) = F2(3) + (Fl*cosPhi - Fr*sinPhi)*(1-alpha) - !F2(4) = F2(4) + sinBeta * M *(1-alpha) - !F2(5) = F2(5) + cosBeta * M *(1-alpha) - !!F2(6) = F2(6) + 0.0 F1(1) = cosBeta*(Fl*sinPhi + Fr*cosPhi)*alpha F1(2) = sinBeta*(Fl*sinPhi + Fr*cosPhi)*alpha - F1(3) = (Fl*cosPhi - Fr*sinPhi)*alpha - F1(4) = -sinBeta * M *alpha + F1(3) = (Fl*cosPhi - Fr*sinPhi)*alpha + F1(4) = -sinBeta * M *alpha F1(5) = cosBeta * M *alpha F1(6) = 0.0 F2(1) = cosBeta*(Fl*sinPhi + Fr*cosPhi)*(1-alpha) F2(2) = sinBeta*(Fl*sinPhi + Fr*cosPhi)*(1-alpha) F2(3) = (Fl*cosPhi - Fr*sinPhi)*(1-alpha) - F2(4) = -sinBeta * M *(1-alpha) + F2(4) = -sinBeta * M *(1-alpha) F2(5) = cosBeta * M *(1-alpha) - F2(6) = 0.0 - - !F1(1) = cosBeta*(-Fl*sinPhi + Fr*cosPhi)*alpha - !F1(2) = sinBeta*(-Fl*sinPhi + Fr*cosPhi)*alpha - !F1(3) = (Fl*cosPhi + Fr*sinPhi)*alpha - !F1(4) = -sinBeta * M *alpha - !F1(5) = cosBeta * M *alpha - !F1(6) = 0.0 - ! - !F2(1) = cosBeta*(-Fl*sinPhi + Fr*cosPhi)*(1-alpha) - !F2(2) = sinBeta*(-Fl*sinPhi + Fr*cosPhi)*(1-alpha) - !F2(3) = (Fl*cosPhi + Fr*sinPhi)*(1-alpha) - !F2(4) = -sinBeta * M *(1-alpha) - !F2(5) = cosBeta * M *(1-alpha) - !F2(6) = 0.0 - + F2(6) = 0.0 + END SUBROUTINE DistributeElementLoads - - +!---------------------------------------------------------------------------------------------------------------------------------- ! Takes loads on end node i and converts to 6DOF loads, adding to the nodes existing loads SUBROUTINE AddEndLoad(Fl, M, sinPhi, cosPhi, SinBeta, cosBeta, Fi) @@ -3525,96 +4246,73 @@ SUBROUTINE AddEndLoad(Fl, M, sinPhi, cosPhi, SinBeta, cosBeta, Fi) END SUBROUTINE AddEndLoad -!---------------------------------------------------------------------------------------------------------------------------------- -!> Tight coupling routine for computing derivatives of continuous states -SUBROUTINE Morison_CalcContStateDeriv( Time, u, p, x, xd, z, OtherState, m, dxdt, errStat, errMsg ) -!.................................................................................................................................. - - REAL(DbKi), INTENT(IN ) :: Time !< Current simulation time in seconds - TYPE(Morison_InputType), INTENT(IN ) :: u !< Inputs at Time - TYPE(Morison_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(Morison_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at Time - TYPE(Morison_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at Time - TYPE(Morison_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at Time - TYPE(Morison_OtherStateType), INTENT(IN ) :: OtherState !< Other states at Time - TYPE(Morison_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables - TYPE(Morison_ContinuousStateType), INTENT( OUT) :: dxdt !< Continuous state derivatives at Time - 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 - - -END SUBROUTINE Morison_CalcContStateDeriv !---------------------------------------------------------------------------------------------------------------------------------- !> Tight coupling routine for updating discrete states SUBROUTINE Morison_UpdateDiscState( Time, u, p, x, xd, z, OtherState, m, errStat, errMsg ) !.................................................................................................................................. - REAL(DbKi), INTENT(IN ) :: Time !< Current simulation time in seconds - TYPE(Morison_InputType), INTENT(IN ) :: u !< Inputs at Time - TYPE(Morison_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(Morison_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at Time - TYPE(Morison_DiscreteStateType), INTENT(INOUT) :: xd !< Input: Discrete states at Time; - !! Output: Discrete states at Time + Interval - TYPE(Morison_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at Time - TYPE(Morison_OtherStateType), INTENT(IN ) :: OtherState !< Other states at Time - TYPE(Morison_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables - INTEGER(IntKi), INTENT( OUT) :: errStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: errMsg !< Error message if errStat /= ErrID_None + REAL(DbKi), INTENT(IN ) :: Time !< Current simulation time in seconds + TYPE(Morison_InputType), INTENT(IN ) :: u !< Inputs at Time + TYPE(Morison_ParameterType), INTENT(IN ) :: p !< Parameters + TYPE(Morison_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at Time + TYPE(Morison_DiscreteStateType), INTENT(INOUT) :: xd !< Input: Discrete states at Time; + !< Output: Discrete states at Time + Interval + TYPE(Morison_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at Time + TYPE(Morison_OtherStateType), INTENT(IN ) :: OtherState !< Other states at Time + TYPE(Morison_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables + INTEGER(IntKi), INTENT( OUT) :: errStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: errMsg !< Error message if errStat /= ErrID_None + INTEGER(IntKi) :: J + INTEGER(IntKi) :: nodeInWater + REAL(ReKi) :: pos(3), vrel(3), FV(3), vmag, vmagf, An_End(3) + REAL(SiKi) :: FVTmp(3) + INTEGER(IntKi) :: errStat2 + CHARACTER(ErrMsgLen) :: errMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Morison_UpdateDiscState' + + ! Initialize errStat + errStat = ErrID_None + errMsg = "" - - ! Initialize errStat - - errStat = ErrID_None - errMsg = "" - - - ! Update discrete states here: - - ! StateData%DiscState = + ! Update state of the relative normal velocity high-pass filter at each joint + DO J = 1, p%NJoints -END SUBROUTINE Morison_UpdateDiscState -!---------------------------------------------------------------------------------------------------------------------------------- -!> Tight coupling routine for solving for the residual of the constraint state equations -SUBROUTINE Morison_CalcConstrStateResidual( Time, u, p, x, xd, z, OtherState, m, z_residual, errStat, errMsg ) -!.................................................................................................................................. - - REAL(DbKi), INTENT(IN ) :: Time !< Current simulation time in seconds - TYPE(Morison_InputType), INTENT(IN ) :: u !< Inputs at Time - TYPE(Morison_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(Morison_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at Time - TYPE(Morison_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at Time - TYPE(Morison_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at Time - TYPE(Morison_OtherStateType), INTENT(IN ) :: OtherState !< Other states at Time - TYPE(Morison_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables - TYPE(Morison_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 + ! Get joint position + IF (p%WaveDisp == 0 ) THEN + ! use the initial X,Y location + pos(1) = u%Mesh%Position(1,J) + pos(2) = u%Mesh%Position(2,J) + ELSE + ! Use current X,Y location + pos(1) = u%Mesh%TranslationDisp(1,J) + u%Mesh%Position(1,J) + pos(2) = u%Mesh%TranslationDisp(2,J) + u%Mesh%Position(2,J) + END IF + IF (p%WaveField%WaveStMod > 0 .AND. p%WaveDisp /= 0) THEN ! Wave stretching enabled + pos(3) = u%Mesh%Position(3,J) + u%Mesh%TranslationDisp(3,J) - p%WaveField%MSL2SWL ! Use the current Z location. + ELSE ! Wave stretching disabled + pos(3) = u%Mesh%Position(3,J) - p%WaveField%MSL2SWL ! We are intentionally using the undisplaced Z position of the node. + END IF - - ! Initialize errStat - - errStat = ErrID_None - errMsg = "" - - - ! Solve for the constraint states here: - - z_residual%DummyConstrState = 0.0_ReKi + ! Get fluid velocity at the joint + CALL WaveField_GetNodeWaveVel( p%WaveField, m%WaveField_m, Time, pos, .FALSE., nodeInWater, FVTmp, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + FV = REAL(FVTmp, ReKi) + vrel = ( FV - u%Mesh%TranslationVel(:,J) ) * nodeInWater + + ! Transform An_End based on reference yaw offset + call hiFrameTransform(h2i,u%PtfmRefY,p%An_End(:,j),An_End,ErrStat2,ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + ! Compute the dot product of the relative velocity vector with the directional Area of the Joint + vmag = vrel(1)*An_End(1) + vrel(2)*An_End(2) + vrel(3)*An_End(3) + ! High-pass filtering + vmagf = p%VRelNFiltConst(J) * (vmag + xd%V_rel_n_FiltStat(J)) + ! Update relative normal velocity filter state for joint J + xd%V_rel_n_FiltStat(J) = vmagf-vmag -END SUBROUTINE Morison_CalcConstrStateResidual + END DO ! J = 1, p%NJoints + +END SUBROUTINE Morison_UpdateDiscState !---------------------------------------------------------------------------------------------------------------------------------- - END MODULE Morison !********************************************************************************************************************************** diff --git a/modules/hydrodyn/src/Morison.txt b/modules/hydrodyn/src/Morison.txt index c59db0b043..5276e6dfa3 100644 --- a/modules/hydrodyn/src/Morison.txt +++ b/modules/hydrodyn/src/Morison.txt @@ -13,16 +13,16 @@ # ...... Include files (definitions from NWTC Library) ............................................................................ # make sure that the file name does not have any trailing white spaces! include Registry_NWTC_Library.txt +usefrom SeaSt_WaveField.txt # # -param Morison/Morison unused INTEGER MaxMrsnOutputs - 4599 - "Total number of possible Morison module output channels" - -typedef ^ Morison_JointType INTEGER JointID - - - "User-specified integer ID for the given joint" - +typedef Morison/Morison Morison_JointType INTEGER JointID - - - "User-specified integer ID for the given joint" - typedef ^ ^ ReKi Position {3} - - "Undisplaced location of the joint in the platform coordinate system" m typedef ^ ^ INTEGER JointAxID - - - "Axial ID (found in the user-supplied Axial Coefficients Table) for this joint: used to determine axial coefs" - typedef ^ ^ INTEGER JointAxIDIndx - - - "The index into the Axial Coefs arrays corresponding to the above Axial ID" - typedef ^ ^ INTEGER JointOvrlp - - - "Joint overlap code [Unused" - typedef ^ ^ INTEGER NConnections - - - "Number of members connecting to this joint" - -typedef ^ ^ INTEGER ConnectionList {10} - - "List of Members connected to this joint. The member index is what is stored, not the Member ID" - +typedef ^ ^ INTEGER ConnectionList {50} - - "List of Members connected to this joint. The member index is what is stored, not the Member ID" - typedef ^ Morison_MemberPropType INTEGER PropSetID - - - "User-specified integer ID for this group of properties" - typedef ^ ^ ReKi PropD - - - "Diameter" m typedef ^ ^ ReKi PropThck - - - "Wall thickness" m @@ -44,10 +44,16 @@ typedef ^ ^ ReKi typedef ^ ^ ReKi DpthAxCaMG - - - "Depth-based Axial Ca for marine growth" - typedef ^ ^ ReKi DpthAxCp - - - "Depth-based Axial Cp" - typedef ^ ^ ReKi DpthAxCpMG - - - "Depth-based Axial Cp for marine growth" - +typedef ^ ^ ReKi DpthCb - - - "Simple model hydrostatic/buoyancy load coefficient" - +typedef ^ ^ ReKi DpthCbMg - - - "Simple model hydrostatic/buoyancy load coefficient for marine growth" - +typedef ^ ^ LOGICAL DpthMCF - - - "Flag T/F for whether the member is modeled with the MacCamy-Fuchs diffraction model" - typedef ^ Morison_AxialCoefType INTEGER AxCoefID - - - "User-supplied integer ID for this set of Axial coefs" - typedef ^ ^ ReKi AxCd - - - "Axial Cd" - typedef ^ ^ ReKi AxCa - - - "Axial Ca" - typedef ^ ^ ReKi AxCp - - - "Axial Cp" - +typedef ^ ^ ReKi AxVnCOff - - - "High-pass cut-off frequency for normal velocity when computing axial drag force" - +typedef ^ ^ ReKi AxFDLoFSc - - - "Scaling factor for low frequency axial drag force" - +typedef ^ ^ IntKi AxFDMod - - - "Switch for the axial drag formulation {0: original formulation, 1: Away from member only}" - # typedef ^ Morison_MemberInputType INTEGER MemberID - - - "User-supplied integer ID for this member" - typedef ^ ^ INTEGER NodeIndx {:} - - "Index of each of the member's nodes in the master node list" - @@ -61,9 +67,11 @@ typedef ^ ^ INTEGER typedef ^ ^ INTEGER MPropSetID2Indx - - - "Index into the Property table for the end of this member" - typedef ^ ^ ReKi MDivSize - - - "User-specified desired member discretization size for the final element" m typedef ^ ^ INTEGER MCoefMod - - - "Which coef. model is being used for this member [1=simple, 2=depth-based, 3=member-based]" - +typedef ^ ^ INTEGER MHstLMod - - - "Which hydrostatic model is being used for this member [1=column-type, 2=ship-type]" - typedef ^ ^ INTEGER MmbrCoefIDIndx - - - "Index into the appropriate coefs table for this member's properties" - typedef ^ ^ INTEGER MmbrFilledIDIndx - - - "Index into the filled group table if this is a filled member" - typedef ^ ^ LOGICAL PropPot - - - "Flag T/F for whether the member is modeled with potential flow theory" - +typedef ^ ^ LOGICAL PropMCF - - - "Flag T/F for whether the member is modeled with the MacCamy-Fuchs diffraction model" - typedef ^ ^ INTEGER NElements - - - "number of elements in this member" - typedef ^ ^ ReKi RefLength - - - "the reference total length for this member" m typedef ^ ^ ReKi dl - - - "the reference element length for this member (may be less than MDivSize to achieve uniform element lengths)" m @@ -73,10 +81,13 @@ typedef ^ ^ ReKi typedef ^ ^ INTEGER JointOvrlp - - - "" - typedef ^ ^ INTEGER JointAxIDIndx - - - "" - typedef ^ ^ INTEGER NConnections - - - "Number of elements connecting to this node" - -typedef ^ ^ INTEGER ConnectionList {10} - - "Indices of all the members connected to this node (positive if end 1, negative if end 2)" - +typedef ^ ^ INTEGER ConnectionList {50} - - "Indices of all the members connected to this node (positive if end 1, negative if end 2)" - typedef ^ ^ ReKi JAxCd - - - "Nodal lumped (joint) axial Cd" - typedef ^ ^ ReKi JAxCa - - - "Nodal lumped (joint) axial Cp" - typedef ^ ^ ReKi JAxCp - - - "Nodal lumped (joint) axial Ca" - +typedef ^ ^ ReKi JAxVnCOff - - - "High-pass cut-off frequency for normal velocity when computing axial drag force" - +typedef ^ ^ ReKi JAxFDLoFSc - - - "Scaling factor for low frequency axial drag force" - +typedef ^ ^ IntKi JAxFDMod - - - "Switch for the axial drag formulation {0: original formulation, 1: Away from member only}" - typedef ^ ^ ReKi FillDensity - - - "Fill fluid density" kg/m^3 typedef ^ ^ ReKi tMG - - - "Nodal thickness with marine growth " m typedef ^ ^ ReKi MGdensity - - - "Nodal density of marine growth" kg/m^3 @@ -84,18 +95,20 @@ typedef ^ ^ ReKi typedef ^ Morison_MemberType INTEGER NodeIndx {:} - - "Index of each of the member's nodes in the master node list" - typedef ^ ^ INTEGER MemberID - - - "User-supplied integer ID for this member" - typedef ^ ^ INTEGER NElements - - - "number of elements in this member" - -typedef ^ ^ ReKi RefLength - - - "the reference total length for this member" m -typedef ^ ^ ReKi cosPhi_ref - - - "the reference cosine of the inclination angle of the member" - +typedef ^ ^ ReKi RefLength - - - "the reference total length for this member" m +typedef ^ ^ ReKi cosPhi_ref - - - "the reference cosine of the inclination angle of the member" - typedef ^ ^ ReKi dl - - - "the reference element length for this member (may be less than MDivSize to achieve uniform element lengths)" m typedef ^ ^ ReKi k {3} - - "unit vector of the member's orientation (may be changed to per-element once additional flexibility is accounted for in HydroDyn)" m typedef ^ ^ ReKi kkt {3}{3} - - "matrix of matmul(k_hat, transpose(k_hat)" - typedef ^ ^ ReKi Ak {3}{3} - - "matrix of I - kkt" - typedef ^ ^ ReKi R {:} - - "outer member radius at each node" m typedef ^ ^ ReKi RMG {:} - - "radius at each node including marine growth" m +typedef ^ ^ ReKi RMGB {:} - - "radius at each node including marine growth scaled by sqrt(Cb)" m typedef ^ ^ ReKi Rin {:} - - "inner member radius at node, equivalent to radius of water ballast at this node if filled" m typedef ^ ^ ReKi tMG {:} - - "Nodal thickness with marine growth (of member at node location)" m typedef ^ ^ ReKi MGdensity {:} - - "Nodal density of marine growth" kg/m^3 typedef ^ ^ ReKi dRdl_mg {:} - - "taper dr/dl of outer surface including marine growth of each element" - +typedef ^ ^ ReKi dRdl_mg_b {:} - - "taper dr/dl of outer surface including marine growth of each element with scaling of sqrt(Cb)" - typedef ^ ^ ReKi dRdl_in {:} - - "taper dr/dl of interior surface of each element" - typedef ^ ^ ReKi Vinner - - - "Member volume without marine growth" m^3 typedef ^ ^ ReKi Vouter - - - "Member volume including marine growth" m^3 @@ -118,6 +131,7 @@ typedef ^ ^ ReKi typedef ^ ^ ReKi AxCd {:} - - "Member axial Cd at each node" - typedef ^ ^ ReKi AxCa {:} - - "Member axial Ca at each node" - typedef ^ ^ ReKi AxCp {:} - - "Member axial Cp at each node" - +typedef ^ ^ ReKi Cb {:} - - "Member Cb at each node" - typedef ^ ^ ReKi m_fb_l {:} - - "mass of flooded ballast in lower portion of each element" kg typedef ^ ^ ReKi m_fb_u {:} - - "mass of flooded ballast in upper portion of each element" kg typedef ^ ^ ReKi h_cfb_l {:} - - "distance to flooded ballast centroid from node point in lower portion of each element" m @@ -142,9 +156,11 @@ typedef ^ ^ ReKi typedef ^ ^ INTEGER MCoefMod - - - "Coefs model for member: 1 = simple, 2 =depth, 3 = member-based " - typedef ^ ^ INTEGER MmbrCoefIDIndx - - - "If MCoefMod=3, then this is the index for the member's coefs in the master Member Coefs Table" - typedef ^ ^ INTEGER MmbrFilledIDIndx - - - "If this member is part of a fill group, this is the index into the master fill group table, if not = -1" - +typedef ^ ^ INTEGER MHstLMod - - - "Hydrostatic model for member [1=column-type, 2=ship-type]" - typedef ^ ^ ReKi FillFSLoc - - - "Z-location of the filled free-surface" m typedef ^ ^ ReKi FillDens - - - "Filled fluid density" kg/m^3 typedef ^ ^ LOGICAL PropPot - - - "Is this element/member modeled with potential flow theory T/F" - +typedef ^ ^ LOGICAL PropMCF - - - "Flag T/F for whether the member is modeled with the MacCamy-Fuchs diffraction model" - typedef ^ ^ LOGICAL Flipped - - - "Was the member flipped in a reordering event? Need to know this to get the correct normal vector to the ends" - # typedef ^ Morison_MemberLoads ReKi F_D {:}{:} - - "Member-based (side-effects) Nodal viscous drag loads at time t" - @@ -184,18 +200,23 @@ typedef ^ ^ ReKi typedef ^ ^ ReKi MemberAxCp2 - - - "Member-based coefs, see above descriptions for meanings (1 = start, 2=end)" - typedef ^ ^ ReKi MemberAxCpMG1 - - - "Member-based coefs, see above descriptions for meanings (1 = start, 2=end)" - typedef ^ ^ ReKi MemberAxCpMG2 - - - "Member-based coefs, see above descriptions for meanings (1 = start, 2=end)" - +typedef ^ ^ ReKi MemberCb1 - - - "Member-based coefs, see above descriptions for meanings (1 = start, 2=end)" - +typedef ^ ^ ReKi MemberCb2 - - - "Member-based coefs, see above descriptions for meanings (1 = start, 2=end)" - +typedef ^ ^ ReKi MemberCbMG1 - - - "Member-based coefs, see above descriptions for meanings (1 = start, 2=end)" - +typedef ^ ^ ReKi MemberCbMG2 - - - "Member-based coefs, see above descriptions for meanings (1 = start, 2=end)" - +typedef ^ ^ LOGICAL MemberMCF - - - "Flag T/F for whether the member is modeled with the MacCamy-Fuchs diffraction model" - typedef ^ Morison_MGDepthsType ReKi MGDpth - - - "Marine growth depth location for these properties" m typedef ^ ^ ReKi MGThck - - - "Marine growth thickness" m typedef ^ ^ ReKi MGDens - - - "Marine growth density" kg/m^3 typedef ^ Morison_MOutput INTEGER MemberID - - - "Member ID for requested output" - -typedef ^ ^ INTEGER NOutLoc - - - "The number of requested output locations" - -typedef ^ ^ ReKi NodeLocs {:} - - "Normalized locations along user-specified member for the outputs" - -typedef ^ ^ INTEGER MemberIDIndx - - - "Index for member in the master list" - -typedef ^ ^ INTEGER MeshIndx1 {:} - - "Index of node in Mesh for the start of the member element" - -typedef ^ ^ INTEGER MeshIndx2 {:} - - "Index of node in Mesh for the end of the member element" - -typedef ^ ^ INTEGER MemberIndx1 {:} - - "Index of Member nodes for the start of the member element" - -typedef ^ ^ INTEGER MemberIndx2 {:} - - "Index of Member nodes for the end of the member element" - -typedef ^ ^ ReKi s {:} - - "Linear interpolation factor between node1 and node2 for the output location" - +typedef ^ Morison_MOutput INTEGER NOutLoc - - - "The number of requested output locations" - +typedef ^ Morison_MOutput ReKi NodeLocs {:} - - "Normalized locations along user-specified member for the outputs" - +typedef ^ Morison_MOutput INTEGER MemberIDIndx - - - "Index for member in the master list" - +typedef ^ Morison_MOutput INTEGER MeshIndx1 {:} - - "Index of node in Mesh for the start of the member element" - +typedef ^ Morison_MOutput INTEGER MeshIndx2 {:} - - "Index of node in Mesh for the end of the member element" - +typedef ^ Morison_MOutput INTEGER MemberIndx1 {:} - - "Index of Member nodes for the start of the member element" - +typedef ^ Morison_MOutput INTEGER MemberIndx2 {:} - - "Index of Member nodes for the end of the member element" - +typedef ^ Morison_MOutput ReKi s {:} - - "Linear interpolation factor between node1 and node2 for the output location" - typedef ^ Morison_JOutput INTEGER JointID - - - "Joint ID for the requested output" - typedef ^ ^ INTEGER JointIDIndx - - - "Joint index in the master list" - # ..... Initialization data ....................................................................................................... @@ -203,9 +224,8 @@ typedef ^ ^ INTEGER # e.g., the name of the input file, the file root name,etc. # typedef ^ InitInputType ReKi Gravity - - - "Gravity (scalar, positive-valued)" m/s^2 -typedef ^ ^ ReKi WtrDens - - - "Water density" kg/m^3 -typedef ^ ^ ReKi WtrDpth - - - "Water depth (positive-valued)" m -typedef ^ ^ ReKi MSL2SWL - - - "Mean Sea Level to Still Water Level offset" m +typedef ^ ^ INTEGER WaveDisp - - - "Method of computing Wave Kinematics. (0: use undisplaced position, 1: use displaced position, 2: use low-pass filtered displaced position) " - +typedef ^ ^ INTEGER AMMod - - - "Method of computing distributed added-mass force. (0: Only and always on nodes below SWL at the undisplaced position. 1: Up to the instantaneous free surface) [overwrite to 0 when WaveMod = 0 or 6 or when WaveStMod = 0 in SeaState]" - typedef ^ ^ INTEGER NJoints - - - "Number of user-specified joints" - typedef ^ ^ INTEGER NNodes - - - "Total number of nodes in the final software model" - typedef ^ ^ Morison_JointType InpJoints {:} - - "Array of user-specified joints" - @@ -226,11 +246,14 @@ typedef ^ ^ ReKi typedef ^ ^ ReKi SimplAxCaMG - - - "Simple model Axial Ca for marine growth" - typedef ^ ^ ReKi SimplAxCp - - - "Simple model Axial Cp" - typedef ^ ^ ReKi SimplAxCpMG - - - "Simple model Axial Cp for marine growth" - -typedef ^ ^ INTEGER NCoefDpth - - - "" - +typedef ^ ^ ReKi SimplCb - - - "Simple model hydrostatic/buoyancy load coefficient" - +typedef ^ ^ ReKi SimplCbMg - - - "Simple model hydrostatic/buoyancy load coefficient for marine growth" - +typedef ^ ^ LOGICAL SimplMCF - - - "Flag T/F for whether the member is modeled with the MacCamy-Fuchs diffraction model" - +typedef ^ ^ INTEGER NCoefDpth - - - "" - typedef ^ ^ Morison_CoefDpths CoefDpths {:} - - "" - typedef ^ ^ INTEGER NCoefMembers - - - "" - typedef ^ ^ Morison_CoefMembers CoefMembers {:} - - "" - -typedef ^ ^ INTEGER NMembers - - - "Number of user-specified members in the input file" - +typedef ^ ^ INTEGER NMembers - - - "Number of user-specified members in the input file" - typedef ^ ^ Morison_MemberInputType InpMembers {:} - - "Array of user-specified members" - typedef ^ ^ INTEGER NFillGroups - - - "" - typedef ^ ^ Morison_FilledGroupType FilledGroups {:} - - "" - @@ -242,26 +265,16 @@ typedef ^ ^ INTEGER typedef ^ ^ Morison_MOutput MOutLst {:} - - "" - typedef ^ ^ INTEGER NJOutputs - - - "" - typedef ^ ^ Morison_JOutput JOutLst {:} - - "" - -typedef ^ ^ CHARACTER(ChanLen) OutList {4032} - - "This list size needs to be the maximum # of possible outputs because of the use of ReadAry()" - -typedef ^ ^ LOGICAL ValidOutList {:} - - "" - +typedef ^ ^ CHARACTER(ChanLen) OutList {:} - - "This list size needs to be the maximum # of possible outputs because of the use of ReadAry(). Use MaxMrsnOutputs" - typedef ^ ^ INTEGER NumOuts - - - "" - -typedef ^ ^ INTEGER OutSwtch - - - "" - -typedef ^ ^ LOGICAL OutAll - - - "" - -typedef ^ ^ CHARACTER(1024) OutRootName - - - "" - -typedef ^ ^ INTEGER UnOutFile - - - "" - typedef ^ ^ INTEGER UnSum - - - "" - -typedef ^ ^ INTEGER NStepWave - - - "" - -typedef ^ ^ SiKi WaveAcc {:}{:}{:} - - "" - -typedef ^ ^ SiKi WaveTime {:} - - "" - -typedef ^ ^ SiKi WaveDynP {:}{:} - - "" - -typedef ^ ^ SiKi WaveVel {:}{:}{:} - - "" - -typedef ^ ^ INTEGER nodeInWater {:}{:} - - "Logical flag indicating if the node at the given time step is in the water, and hence needs to have hydrodynamic forces calculated" - -typedef ^ ^ logical VisMeshes - .false. - "Output visualization meshes" - +typedef ^ ^ SeaSt_WaveFieldType *WaveField - - - "Pointer to SeaState wave field" - +typedef ^ ^ logical VisMeshes - .false. - "Output visualization meshes" - +typedef ^ ^ INTEGER PtfmYMod - - - "Large yaw model" - # # # Define outputs from the initialization routine here: # -#typedef ^ InitOutputType MeshType Mesh - - - "Unused?" - typedef ^ InitOutputType SiKi MorisonVisRad {:} - - "radius of node (for FAST visualization)" (m) typedef ^ InitOutputType CHARACTER(ChanLen) WriteOutputHdr {:} - - "User-requested Output channel names" - typedef ^ ^ CHARACTER(ChanLen) WriteOutputUnt {:} - - "" - @@ -275,7 +288,7 @@ typedef ^ ContinuousStateType SiKi # # Define discrete (nondifferentiable) states here: # -typedef ^ DiscreteStateType SiKi DummyDiscState - - - "Remove this variable if you have discrete states" - +typedef ^ DiscreteStateType ReKi V_rel_n_FiltStat {:} - - "State of the high-pass filter for the joint relative normal velocity" m/s # # # Define constraint states here: @@ -289,79 +302,71 @@ typedef ^ OtherStateType IntKi # ..... 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 F_D {:}{:} - - "Member-based (side-effects) Nodal viscous drag loads at time t" - -#typedef ^ ^ ReKi F_I {:}{:} - - "Member-based (side-effects) Nodal inertial loads at time t" - -#typedef ^ ^ ReKi F_A {:}{:} - - "Member-based (side-effects) Nodal added mass loads at time t" - -#typedef ^ ^ ReKi F_B {:}{:} - - "Member-based (side-effects) Nodal buoyancy loads" - -#typedef ^ ^ ReKi F_BF {:}{:} - - "Member-based (side-effects) Nodal flooded ballast weight/buoyancy loads" - -#typedef ^ ^ ReKi F_If {:}{:} - - "Member-based (side-effects) Nodal flooded ballast inertia loads" - -#typedef ^ ^ ReKi F_WMG {:}{:} - - "Member-based (side-effects) Nodal marine growth weight loads" - -#typedef ^ ^ ReKi F_IMG {:}{:} - - "Member-based (side-effects) Nodal marine growth inertia loads" - -#typedef ^ ^ ReKi F_DP {:}{:} - - "Lumped dynamic pressure loads at time t, which may not correspond to the WaveTime array of times" - -typedef ^ MiscVarType ReKi FV {:}{:} - - "Fluid velocity at line element node at time t, which may not correspond to the WaveTime array of times" - +typedef ^ MiscVarType ReKi DispNodePosHdn {:}{:} - - "Instantaneous displaced position of the line element nodes at time t for hydrodynamic load calculation" (m) +typedef ^ ^ ReKi DispNodePosHst {:}{:} - - "Instantaneous displaced position of the line element nodes at time t for hydrostatic and other load calcuation" (m) +typedef ^ ^ ReKi FV {:}{:} - - "Fluid velocity at line element node at time t, which may not correspond to the WaveTime array of times" - typedef ^ ^ ReKi FA {:}{:} - - "Fluid acceleration at line element node at time t, which may not correspond to the WaveTime array of times" - +typedef ^ ^ ReKi FAMCF {:}{:} - - "Fluid acceleration at line element node at time t, which may not correspond to the WaveTime array of times" - typedef ^ ^ ReKi FDynP {:} - - "Fluid dynamic pressure at line element node at time t, which may not correspond to the WaveTime array of times" - +typedef ^ ^ SiKi WaveElev {:} - - "Total wave elevation" m +typedef ^ ^ SiKi WaveElev1 {:} - - "First order wave elevation" m +typedef ^ ^ SiKi WaveElev2 {:} - - "Second order wave elevation" m typedef ^ ^ ReKi vrel {:}{:} - - "velocity of structural node relative to the water" m/s^2 -typedef ^ ^ INTEGER nodeInWater {:} - - "Logical flag indicating if the node at the given time step is in the water, and hence needs to have hydrodynamic forces calculated" - -typedef ^ ^ Morison_MemberLoads memberLoads {:} - - "Array (NMembers long) of member-based side-effects load contributions" - -typedef ^ ^ ReKi F_B_End {:}{:} - - "" - +typedef ^ ^ INTEGER nodeInWater {:} - - "Logical flag indicating if the node at the given time step is in the water, and hence needs to have hydrodynamic forces calculated" - +typedef ^ ^ Morison_MemberLoads memberLoads {:} - - "Array (NMembers long) of member-based side-effects load contributions" - +typedef ^ ^ ReKi F_B_End {:}{:} - - "" - typedef ^ ^ ReKi F_D_End {:}{:} - - "Lumped viscous drag loads at time t, which may not correspond to the WaveTime array of times" - typedef ^ ^ ReKi F_I_End {:}{:} - - "Lumped intertia loads at time t, which may not correspond to the WaveTime array of times" - typedef ^ ^ ReKi F_IMG_End {:}{:} - - "Joint marine growth intertia loads at time t, which may not correspond to the WaveTime array of times" - -typedef ^ ^ ReKi F_A_End {:}{:} - - "Lumped added mass loads at time t, which may not correspond to the WaveTime array of times" - -typedef ^ ^ ReKi F_BF_End {:}{:} - - "" - -typedef ^ ^ INTEGER LastIndWave - - - "Last time index used in the wave kinematics arrays" - +typedef ^ ^ ReKi F_A_End {:}{:} - - "Lumped added mass loads at time t, which may not correspond to the WaveTime array of times" - +typedef ^ ^ ReKi F_BF_End {:}{:} - - "" - +typedef ^ ^ ReKi V_rel_n {:} - - "Normal relative flow velocity at joints" m/s +typedef ^ ^ ReKi V_rel_n_HiPass {:} - - "High-pass filtered normal relative flow velocity at joints" m/s typedef ^ ^ MeshMapType VisMeshMap - - - "Mesh mapping for visualization mesh" - +typedef ^ ^ SeaSt_WaveField_MiscVarType WaveField_m - - - "misc var information from the SeaState Interpolation module" - # ..... 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" (sec) -typedef ^ ^ ReKi Gravity - - - "Gravity (scalar, positive-valued)" m/s^2 -typedef ^ ^ ReKi WtrDens - - - "Water density" kg/m^3 -typedef ^ ^ ReKi WtrDpth - - - "Water depth (positive-valued)" m -typedef ^ ^ ReKi MSL2SWL - - - "Mean Sea Level to Still Water Level offset" m -typedef ^ ^ INTEGER NMembers - - - "number of members" - -typedef ^ ^ Morison_MemberType Members {:} - - "Array of Morison members used during simulation" - -typedef ^ ^ INTEGER NNodes - - - "" - -typedef ^ ^ INTEGER NJoints - - - "Number of user-specified joints" - -typedef ^ ^ ReKi I_MG_End {:}{:}{:} - - "Inertial matrix associated with marine growth mass at joint" - -typedef ^ ^ ReKi An_End {:}{:} - - "directional area vector of each joint" m^2 -typedef ^ ^ ReKi DragConst_End {:} - - "" - -typedef ^ ^ ReKi F_WMG_End {:}{:} - - "Joint marine growth weight loads, constant for all t" N -typedef ^ ^ ReKi DP_Const_End {:}{:} - - "Constant part of Joint dynamic pressure term" N -typedef ^ ^ ReKi Mass_MG_End {:} - - "Joint marine growth mass" kg -typedef ^ ^ ReKi AM_End {:}{:}{:} - - "3x3 Joint added mass matrix, constant for all t" N -typedef ^ ^ SiKi WaveVel {:}{:}{:} - - "" - -typedef ^ ^ SiKi WaveAcc {:}{:}{:} - - "" - -typedef ^ ^ SiKi WaveDynP {:}{:} - - "" - -typedef ^ ^ SiKi WaveTime {:} - - "Times for which the wave kinematics are pre-computed" s -typedef ^ ^ INTEGER nodeInWater {:}{:} - - "Logical flag indicating if the node at the given time step is in the water, and hence needs to have hydrodynamic forces calculated" - -typedef ^ ^ INTEGER NStepWave - - - "" - -typedef ^ ^ INTEGER NMOutputs - - - "" - -typedef ^ ^ Morison_MOutput MOutLst {:} - - "" - -typedef ^ ^ INTEGER NJOutputs - - - "" - -typedef ^ ^ Morison_JOutput JOutLst {:} - - "" - -typedef ^ ^ OutParmType OutParam {:} - - "" - -typedef ^ ^ INTEGER NumOuts - - - "" - -typedef ^ ^ INTEGER NumOutAll - - - "" - -typedef ^ ^ INTEGER OutSwtch - - - "" - -typedef ^ ^ INTEGER UnOutFile - - - "" - -typedef ^ ^ CHARACTER(20) OutFmt - - - "" - -typedef ^ ^ CHARACTER(20) OutSFmt - - - "" - -typedef ^ ^ CHARACTER(ChanLen) Delim - - - "" - -typedef ^ ^ logical VisMeshes - .false. - "Output visualization meshes" - +typedef ^ ParameterType DbKi DT - - - "Time step for continuous state integration & discrete state update" (sec) +typedef ^ ^ ReKi Gravity - - - "Gravity (scalar, positive-valued)" m/s^2 +typedef ^ ^ INTEGER WaveDisp - - - "Method of computing Wave Kinematics. (0: use undisplaced position, 1: use displaced position, 2: use low-pass filtered displaced position) " - +typedef ^ ^ INTEGER AMMod - - - "Method of computing distributed added-mass force. (0: Only and always on nodes below SWL at the undisplaced position. 1: Up to the instantaneous free surface) [overwrite to 0 when WaveMod = 0 or 6 or when WaveStMod = 0 in SeaState]" - +typedef ^ ^ INTEGER NMembers - - - "number of members" - +typedef ^ ^ Morison_MemberType Members {:} - - "Array of Morison members used during simulation" - +typedef ^ ^ INTEGER NNodes - - - "" - +typedef ^ ^ INTEGER NJoints - - - "Number of user-specified joints" - +typedef ^ ^ ReKi I_MG_End {:}{:}{:} - - "Inertial matrix associated with marine growth mass at joint" - +typedef ^ ^ ReKi An_End {:}{:} - - "directional area vector of each joint" m^2 +typedef ^ ^ ReKi DragConst_End {:} - - "" - +typedef ^ ^ ReKi VRelNFiltConst {:} - - "" - +typedef ^ ^ IntKi DragMod_End {:} - - "" - +typedef ^ ^ ReKi DragLoFSc_End {:} - - "" - +typedef ^ ^ ReKi F_WMG_End {:}{:} - - "Joint marine growth weight loads, constant for all t" N +typedef ^ ^ ReKi DP_Const_End {:}{:} - - "Constant part of Joint dynamic pressure term" N +typedef ^ ^ ReKi Mass_MG_End {:} - - "Joint marine growth mass" kg +typedef ^ ^ ReKi AM_End {:}{:}{:} - - "3x3 Joint added mass matrix, constant for all t" N +typedef ^ ^ INTEGER NMOutputs - - - "" - +typedef ^ ^ Morison_MOutput MOutLst {:} - - "" - +typedef ^ ^ INTEGER NJOutputs - - - "" - +typedef ^ ^ Morison_JOutput JOutLst {:} - - "" - +typedef ^ ^ OutParmType OutParam {:} - - "" - +typedef ^ ^ INTEGER NumOuts - - - "" - +typedef ^ ^ SeaSt_WaveFieldType *WaveField - - - "SeaState wave field" - +typedef ^ ^ logical VisMeshes - .false. - "Output visualization meshes" - +typedef ^ ^ INTEGER PtfmYMod - - - "Large yaw model" - # # # ..... Inputs .................................................................................................................... # Define inputs that are contained on the mesh here: # -typedef ^ InputType MeshType Mesh - - - "Kinematics of each node input mesh" - +typedef ^ InputType MeshType Mesh - - - "Kinematics of each node input mesh" - +typedef ^ ^ ReKi PtfmRefY - - - "Reference platform yaw offset" (rad) # # # ..... Outputs ................................................................................................................... # Define outputs that are contained on the mesh here: -typedef ^ OutputType MeshType Mesh - - - "Loads on each node output mesh" - -typedef ^ ^ MeshType VisMesh - - - "Line mesh for visualization" - -typedef ^ ^ ReKi WriteOutput {:} - - "" - +typedef ^ OutputType MeshType Mesh - - - "Loads on each node output mesh" - +typedef ^ ^ MeshType VisMesh - - - "Line mesh for visualization" - +typedef ^ ^ ReKi WriteOutput {:} - - "" - diff --git a/modules/hydrodyn/src/Morison_Output.f90 b/modules/hydrodyn/src/Morison_Output.f90 index d98a4565d2..16ccff3178 100644 --- a/modules/hydrodyn/src/Morison_Output.f90 +++ b/modules/hydrodyn/src/Morison_Output.f90 @@ -30,4636 +30,4670 @@ MODULE Morison_Output PRIVATE - ! 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 -! This code was generated by Write_ChckOutLst.m at 04-Jan-2014 12:13:30. +! =================================================================================================== +! 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 06-Sep-2022 13:57:52. ! Indices for computing output channels: - ! NOTES: + ! NOTES: ! (1) These parameters are in the order stored in "OutListParameters.xlsx" - ! (2) Array y%AllOuts() must be dimensioned to the value of the largest output parameter + ! (2) Array AllOuts() must be dimensioned to the value of the largest output parameter + + ! Time: - ! Time: - INTEGER(IntKi), PARAMETER :: Time = 0 + INTEGER(IntKi), PARAMETER :: Time = 0 - ! Member-level Wave Kinematics : + ! Member-level Wave Kinematics: - INTEGER(IntKi), PARAMETER :: M1N1Axi = 1 - INTEGER(IntKi), PARAMETER :: M1N2Axi = 2 - INTEGER(IntKi), PARAMETER :: M1N3Axi = 3 - INTEGER(IntKi), PARAMETER :: M1N4Axi = 4 - INTEGER(IntKi), PARAMETER :: M1N5Axi = 5 - INTEGER(IntKi), PARAMETER :: M1N6Axi = 6 - INTEGER(IntKi), PARAMETER :: M1N7Axi = 7 - INTEGER(IntKi), PARAMETER :: M1N8Axi = 8 - INTEGER(IntKi), PARAMETER :: M1N9Axi = 9 - INTEGER(IntKi), PARAMETER :: M2N1Axi = 10 - INTEGER(IntKi), PARAMETER :: M2N2Axi = 11 - INTEGER(IntKi), PARAMETER :: M2N3Axi = 12 - INTEGER(IntKi), PARAMETER :: M2N4Axi = 13 - INTEGER(IntKi), PARAMETER :: M2N5Axi = 14 - INTEGER(IntKi), PARAMETER :: M2N6Axi = 15 - INTEGER(IntKi), PARAMETER :: M2N7Axi = 16 - INTEGER(IntKi), PARAMETER :: M2N8Axi = 17 - INTEGER(IntKi), PARAMETER :: M2N9Axi = 18 - INTEGER(IntKi), PARAMETER :: M3N1Axi = 19 - INTEGER(IntKi), PARAMETER :: M3N2Axi = 20 - INTEGER(IntKi), PARAMETER :: M3N3Axi = 21 - INTEGER(IntKi), PARAMETER :: M3N4Axi = 22 - INTEGER(IntKi), PARAMETER :: M3N5Axi = 23 - INTEGER(IntKi), PARAMETER :: M3N6Axi = 24 - INTEGER(IntKi), PARAMETER :: M3N7Axi = 25 - INTEGER(IntKi), PARAMETER :: M3N8Axi = 26 - INTEGER(IntKi), PARAMETER :: M3N9Axi = 27 - INTEGER(IntKi), PARAMETER :: M4N1Axi = 28 - INTEGER(IntKi), PARAMETER :: M4N2Axi = 29 - INTEGER(IntKi), PARAMETER :: M4N3Axi = 30 - INTEGER(IntKi), PARAMETER :: M4N4Axi = 31 - INTEGER(IntKi), PARAMETER :: M4N5Axi = 32 - INTEGER(IntKi), PARAMETER :: M4N6Axi = 33 - INTEGER(IntKi), PARAMETER :: M4N7Axi = 34 - INTEGER(IntKi), PARAMETER :: M4N8Axi = 35 - INTEGER(IntKi), PARAMETER :: M4N9Axi = 36 - INTEGER(IntKi), PARAMETER :: M5N1Axi = 37 - INTEGER(IntKi), PARAMETER :: M5N2Axi = 38 - INTEGER(IntKi), PARAMETER :: M5N3Axi = 39 - INTEGER(IntKi), PARAMETER :: M5N4Axi = 40 - INTEGER(IntKi), PARAMETER :: M5N5Axi = 41 - INTEGER(IntKi), PARAMETER :: M5N6Axi = 42 - INTEGER(IntKi), PARAMETER :: M5N7Axi = 43 - INTEGER(IntKi), PARAMETER :: M5N8Axi = 44 - INTEGER(IntKi), PARAMETER :: M5N9Axi = 45 - INTEGER(IntKi), PARAMETER :: M6N1Axi = 46 - INTEGER(IntKi), PARAMETER :: M6N2Axi = 47 - INTEGER(IntKi), PARAMETER :: M6N3Axi = 48 - INTEGER(IntKi), PARAMETER :: M6N4Axi = 49 - INTEGER(IntKi), PARAMETER :: M6N5Axi = 50 - INTEGER(IntKi), PARAMETER :: M6N6Axi = 51 - INTEGER(IntKi), PARAMETER :: M6N7Axi = 52 - INTEGER(IntKi), PARAMETER :: M6N8Axi = 53 - INTEGER(IntKi), PARAMETER :: M6N9Axi = 54 - INTEGER(IntKi), PARAMETER :: M7N1Axi = 55 - INTEGER(IntKi), PARAMETER :: M7N2Axi = 56 - INTEGER(IntKi), PARAMETER :: M7N3Axi = 57 - INTEGER(IntKi), PARAMETER :: M7N4Axi = 58 - INTEGER(IntKi), PARAMETER :: M7N5Axi = 59 - INTEGER(IntKi), PARAMETER :: M7N6Axi = 60 - INTEGER(IntKi), PARAMETER :: M7N7Axi = 61 - INTEGER(IntKi), PARAMETER :: M7N8Axi = 62 - INTEGER(IntKi), PARAMETER :: M7N9Axi = 63 - INTEGER(IntKi), PARAMETER :: M8N1Axi = 64 - INTEGER(IntKi), PARAMETER :: M8N2Axi = 65 - INTEGER(IntKi), PARAMETER :: M8N3Axi = 66 - INTEGER(IntKi), PARAMETER :: M8N4Axi = 67 - INTEGER(IntKi), PARAMETER :: M8N5Axi = 68 - INTEGER(IntKi), PARAMETER :: M8N6Axi = 69 - INTEGER(IntKi), PARAMETER :: M8N7Axi = 70 - INTEGER(IntKi), PARAMETER :: M8N8Axi = 71 - INTEGER(IntKi), PARAMETER :: M8N9Axi = 72 - INTEGER(IntKi), PARAMETER :: M9N1Axi = 73 - INTEGER(IntKi), PARAMETER :: M9N2Axi = 74 - INTEGER(IntKi), PARAMETER :: M9N3Axi = 75 - INTEGER(IntKi), PARAMETER :: M9N4Axi = 76 - INTEGER(IntKi), PARAMETER :: M9N5Axi = 77 - INTEGER(IntKi), PARAMETER :: M9N6Axi = 78 - INTEGER(IntKi), PARAMETER :: M9N7Axi = 79 - INTEGER(IntKi), PARAMETER :: M9N8Axi = 80 - INTEGER(IntKi), PARAMETER :: M9N9Axi = 81 - INTEGER(IntKi), PARAMETER :: M1N1Ayi = 82 - INTEGER(IntKi), PARAMETER :: M1N2Ayi = 83 - INTEGER(IntKi), PARAMETER :: M1N3Ayi = 84 - INTEGER(IntKi), PARAMETER :: M1N4Ayi = 85 - INTEGER(IntKi), PARAMETER :: M1N5Ayi = 86 - INTEGER(IntKi), PARAMETER :: M1N6Ayi = 87 - INTEGER(IntKi), PARAMETER :: M1N7Ayi = 88 - INTEGER(IntKi), PARAMETER :: M1N8Ayi = 89 - INTEGER(IntKi), PARAMETER :: M1N9Ayi = 90 - INTEGER(IntKi), PARAMETER :: M2N1Ayi = 91 - INTEGER(IntKi), PARAMETER :: M2N2Ayi = 92 - INTEGER(IntKi), PARAMETER :: M2N3Ayi = 93 - INTEGER(IntKi), PARAMETER :: M2N4Ayi = 94 - INTEGER(IntKi), PARAMETER :: M2N5Ayi = 95 - INTEGER(IntKi), PARAMETER :: M2N6Ayi = 96 - INTEGER(IntKi), PARAMETER :: M2N7Ayi = 97 - INTEGER(IntKi), PARAMETER :: M2N8Ayi = 98 - INTEGER(IntKi), PARAMETER :: M2N9Ayi = 99 - INTEGER(IntKi), PARAMETER :: M3N1Ayi = 100 - INTEGER(IntKi), PARAMETER :: M3N2Ayi = 101 - INTEGER(IntKi), PARAMETER :: M3N3Ayi = 102 - INTEGER(IntKi), PARAMETER :: M3N4Ayi = 103 - INTEGER(IntKi), PARAMETER :: M3N5Ayi = 104 - INTEGER(IntKi), PARAMETER :: M3N6Ayi = 105 - INTEGER(IntKi), PARAMETER :: M3N7Ayi = 106 - INTEGER(IntKi), PARAMETER :: M3N8Ayi = 107 - INTEGER(IntKi), PARAMETER :: M3N9Ayi = 108 - INTEGER(IntKi), PARAMETER :: M4N1Ayi = 109 - INTEGER(IntKi), PARAMETER :: M4N2Ayi = 110 - INTEGER(IntKi), PARAMETER :: M4N3Ayi = 111 - INTEGER(IntKi), PARAMETER :: M4N4Ayi = 112 - INTEGER(IntKi), PARAMETER :: M4N5Ayi = 113 - INTEGER(IntKi), PARAMETER :: M4N6Ayi = 114 - INTEGER(IntKi), PARAMETER :: M4N7Ayi = 115 - INTEGER(IntKi), PARAMETER :: M4N8Ayi = 116 - INTEGER(IntKi), PARAMETER :: M4N9Ayi = 117 - INTEGER(IntKi), PARAMETER :: M5N1Ayi = 118 - INTEGER(IntKi), PARAMETER :: M5N2Ayi = 119 - INTEGER(IntKi), PARAMETER :: M5N3Ayi = 120 - INTEGER(IntKi), PARAMETER :: M5N4Ayi = 121 - INTEGER(IntKi), PARAMETER :: M5N5Ayi = 122 - INTEGER(IntKi), PARAMETER :: M5N6Ayi = 123 - INTEGER(IntKi), PARAMETER :: M5N7Ayi = 124 - INTEGER(IntKi), PARAMETER :: M5N8Ayi = 125 - INTEGER(IntKi), PARAMETER :: M5N9Ayi = 126 - INTEGER(IntKi), PARAMETER :: M6N1Ayi = 127 - INTEGER(IntKi), PARAMETER :: M6N2Ayi = 128 - INTEGER(IntKi), PARAMETER :: M6N3Ayi = 129 - INTEGER(IntKi), PARAMETER :: M6N4Ayi = 130 - INTEGER(IntKi), PARAMETER :: M6N5Ayi = 131 - INTEGER(IntKi), PARAMETER :: M6N6Ayi = 132 - INTEGER(IntKi), PARAMETER :: M6N7Ayi = 133 - INTEGER(IntKi), PARAMETER :: M6N8Ayi = 134 - INTEGER(IntKi), PARAMETER :: M6N9Ayi = 135 - INTEGER(IntKi), PARAMETER :: M7N1Ayi = 136 - INTEGER(IntKi), PARAMETER :: M7N2Ayi = 137 - INTEGER(IntKi), PARAMETER :: M7N3Ayi = 138 - INTEGER(IntKi), PARAMETER :: M7N4Ayi = 139 - INTEGER(IntKi), PARAMETER :: M7N5Ayi = 140 - INTEGER(IntKi), PARAMETER :: M7N6Ayi = 141 - INTEGER(IntKi), PARAMETER :: M7N7Ayi = 142 - INTEGER(IntKi), PARAMETER :: M7N8Ayi = 143 - INTEGER(IntKi), PARAMETER :: M7N9Ayi = 144 - INTEGER(IntKi), PARAMETER :: M8N1Ayi = 145 - INTEGER(IntKi), PARAMETER :: M8N2Ayi = 146 - INTEGER(IntKi), PARAMETER :: M8N3Ayi = 147 - INTEGER(IntKi), PARAMETER :: M8N4Ayi = 148 - INTEGER(IntKi), PARAMETER :: M8N5Ayi = 149 - INTEGER(IntKi), PARAMETER :: M8N6Ayi = 150 - INTEGER(IntKi), PARAMETER :: M8N7Ayi = 151 - INTEGER(IntKi), PARAMETER :: M8N8Ayi = 152 - INTEGER(IntKi), PARAMETER :: M8N9Ayi = 153 - INTEGER(IntKi), PARAMETER :: M9N1Ayi = 154 - INTEGER(IntKi), PARAMETER :: M9N2Ayi = 155 - INTEGER(IntKi), PARAMETER :: M9N3Ayi = 156 - INTEGER(IntKi), PARAMETER :: M9N4Ayi = 157 - INTEGER(IntKi), PARAMETER :: M9N5Ayi = 158 - INTEGER(IntKi), PARAMETER :: M9N6Ayi = 159 - INTEGER(IntKi), PARAMETER :: M9N7Ayi = 160 - INTEGER(IntKi), PARAMETER :: M9N8Ayi = 161 - INTEGER(IntKi), PARAMETER :: M9N9Ayi = 162 - INTEGER(IntKi), PARAMETER :: M1N1Azi = 163 - INTEGER(IntKi), PARAMETER :: M1N2Azi = 164 - INTEGER(IntKi), PARAMETER :: M1N3Azi = 165 - INTEGER(IntKi), PARAMETER :: M1N4Azi = 166 - INTEGER(IntKi), PARAMETER :: M1N5Azi = 167 - INTEGER(IntKi), PARAMETER :: M1N6Azi = 168 - INTEGER(IntKi), PARAMETER :: M1N7Azi = 169 - INTEGER(IntKi), PARAMETER :: M1N8Azi = 170 - INTEGER(IntKi), PARAMETER :: M1N9Azi = 171 - INTEGER(IntKi), PARAMETER :: M2N1Azi = 172 - INTEGER(IntKi), PARAMETER :: M2N2Azi = 173 - INTEGER(IntKi), PARAMETER :: M2N3Azi = 174 - INTEGER(IntKi), PARAMETER :: M2N4Azi = 175 - INTEGER(IntKi), PARAMETER :: M2N5Azi = 176 - INTEGER(IntKi), PARAMETER :: M2N6Azi = 177 - INTEGER(IntKi), PARAMETER :: M2N7Azi = 178 - INTEGER(IntKi), PARAMETER :: M2N8Azi = 179 - INTEGER(IntKi), PARAMETER :: M2N9Azi = 180 - INTEGER(IntKi), PARAMETER :: M3N1Azi = 181 - INTEGER(IntKi), PARAMETER :: M3N2Azi = 182 - INTEGER(IntKi), PARAMETER :: M3N3Azi = 183 - INTEGER(IntKi), PARAMETER :: M3N4Azi = 184 - INTEGER(IntKi), PARAMETER :: M3N5Azi = 185 - INTEGER(IntKi), PARAMETER :: M3N6Azi = 186 - INTEGER(IntKi), PARAMETER :: M3N7Azi = 187 - INTEGER(IntKi), PARAMETER :: M3N8Azi = 188 - INTEGER(IntKi), PARAMETER :: M3N9Azi = 189 - INTEGER(IntKi), PARAMETER :: M4N1Azi = 190 - INTEGER(IntKi), PARAMETER :: M4N2Azi = 191 - INTEGER(IntKi), PARAMETER :: M4N3Azi = 192 - INTEGER(IntKi), PARAMETER :: M4N4Azi = 193 - INTEGER(IntKi), PARAMETER :: M4N5Azi = 194 - INTEGER(IntKi), PARAMETER :: M4N6Azi = 195 - INTEGER(IntKi), PARAMETER :: M4N7Azi = 196 - INTEGER(IntKi), PARAMETER :: M4N8Azi = 197 - INTEGER(IntKi), PARAMETER :: M4N9Azi = 198 - INTEGER(IntKi), PARAMETER :: M5N1Azi = 199 - INTEGER(IntKi), PARAMETER :: M5N2Azi = 200 - INTEGER(IntKi), PARAMETER :: M5N3Azi = 201 - INTEGER(IntKi), PARAMETER :: M5N4Azi = 202 - INTEGER(IntKi), PARAMETER :: M5N5Azi = 203 - INTEGER(IntKi), PARAMETER :: M5N6Azi = 204 - INTEGER(IntKi), PARAMETER :: M5N7Azi = 205 - INTEGER(IntKi), PARAMETER :: M5N8Azi = 206 - INTEGER(IntKi), PARAMETER :: M5N9Azi = 207 - INTEGER(IntKi), PARAMETER :: M6N1Azi = 208 - INTEGER(IntKi), PARAMETER :: M6N2Azi = 209 - INTEGER(IntKi), PARAMETER :: M6N3Azi = 210 - INTEGER(IntKi), PARAMETER :: M6N4Azi = 211 - INTEGER(IntKi), PARAMETER :: M6N5Azi = 212 - INTEGER(IntKi), PARAMETER :: M6N6Azi = 213 - INTEGER(IntKi), PARAMETER :: M6N7Azi = 214 - INTEGER(IntKi), PARAMETER :: M6N8Azi = 215 - INTEGER(IntKi), PARAMETER :: M6N9Azi = 216 - INTEGER(IntKi), PARAMETER :: M7N1Azi = 217 - INTEGER(IntKi), PARAMETER :: M7N2Azi = 218 - INTEGER(IntKi), PARAMETER :: M7N3Azi = 219 - INTEGER(IntKi), PARAMETER :: M7N4Azi = 220 - INTEGER(IntKi), PARAMETER :: M7N5Azi = 221 - INTEGER(IntKi), PARAMETER :: M7N6Azi = 222 - INTEGER(IntKi), PARAMETER :: M7N7Azi = 223 - INTEGER(IntKi), PARAMETER :: M7N8Azi = 224 - INTEGER(IntKi), PARAMETER :: M7N9Azi = 225 - INTEGER(IntKi), PARAMETER :: M8N1Azi = 226 - INTEGER(IntKi), PARAMETER :: M8N2Azi = 227 - INTEGER(IntKi), PARAMETER :: M8N3Azi = 228 - INTEGER(IntKi), PARAMETER :: M8N4Azi = 229 - INTEGER(IntKi), PARAMETER :: M8N5Azi = 230 - INTEGER(IntKi), PARAMETER :: M8N6Azi = 231 - INTEGER(IntKi), PARAMETER :: M8N7Azi = 232 - INTEGER(IntKi), PARAMETER :: M8N8Azi = 233 - INTEGER(IntKi), PARAMETER :: M8N9Azi = 234 - INTEGER(IntKi), PARAMETER :: M9N1Azi = 235 - INTEGER(IntKi), PARAMETER :: M9N2Azi = 236 - INTEGER(IntKi), PARAMETER :: M9N3Azi = 237 - INTEGER(IntKi), PARAMETER :: M9N4Azi = 238 - INTEGER(IntKi), PARAMETER :: M9N5Azi = 239 - INTEGER(IntKi), PARAMETER :: M9N6Azi = 240 - INTEGER(IntKi), PARAMETER :: M9N7Azi = 241 - INTEGER(IntKi), PARAMETER :: M9N8Azi = 242 - INTEGER(IntKi), PARAMETER :: M9N9Azi = 243 - INTEGER(IntKi), PARAMETER :: M1N1Vxi = 244 - INTEGER(IntKi), PARAMETER :: M1N2Vxi = 245 - INTEGER(IntKi), PARAMETER :: M1N3Vxi = 246 - INTEGER(IntKi), PARAMETER :: M1N4Vxi = 247 - INTEGER(IntKi), PARAMETER :: M1N5Vxi = 248 - INTEGER(IntKi), PARAMETER :: M1N6Vxi = 249 - INTEGER(IntKi), PARAMETER :: M1N7Vxi = 250 - INTEGER(IntKi), PARAMETER :: M1N8Vxi = 251 - INTEGER(IntKi), PARAMETER :: M1N9Vxi = 252 - INTEGER(IntKi), PARAMETER :: M2N1Vxi = 253 - INTEGER(IntKi), PARAMETER :: M2N2Vxi = 254 - INTEGER(IntKi), PARAMETER :: M2N3Vxi = 255 - INTEGER(IntKi), PARAMETER :: M2N4Vxi = 256 - INTEGER(IntKi), PARAMETER :: M2N5Vxi = 257 - INTEGER(IntKi), PARAMETER :: M2N6Vxi = 258 - INTEGER(IntKi), PARAMETER :: M2N7Vxi = 259 - INTEGER(IntKi), PARAMETER :: M2N8Vxi = 260 - INTEGER(IntKi), PARAMETER :: M2N9Vxi = 261 - INTEGER(IntKi), PARAMETER :: M3N1Vxi = 262 - INTEGER(IntKi), PARAMETER :: M3N2Vxi = 263 - INTEGER(IntKi), PARAMETER :: M3N3Vxi = 264 - INTEGER(IntKi), PARAMETER :: M3N4Vxi = 265 - INTEGER(IntKi), PARAMETER :: M3N5Vxi = 266 - INTEGER(IntKi), PARAMETER :: M3N6Vxi = 267 - INTEGER(IntKi), PARAMETER :: M3N7Vxi = 268 - INTEGER(IntKi), PARAMETER :: M3N8Vxi = 269 - INTEGER(IntKi), PARAMETER :: M3N9Vxi = 270 - INTEGER(IntKi), PARAMETER :: M4N1Vxi = 271 - INTEGER(IntKi), PARAMETER :: M4N2Vxi = 272 - INTEGER(IntKi), PARAMETER :: M4N3Vxi = 273 - INTEGER(IntKi), PARAMETER :: M4N4Vxi = 274 - INTEGER(IntKi), PARAMETER :: M4N5Vxi = 275 - INTEGER(IntKi), PARAMETER :: M4N6Vxi = 276 - INTEGER(IntKi), PARAMETER :: M4N7Vxi = 277 - INTEGER(IntKi), PARAMETER :: M4N8Vxi = 278 - INTEGER(IntKi), PARAMETER :: M4N9Vxi = 279 - INTEGER(IntKi), PARAMETER :: M5N1Vxi = 280 - INTEGER(IntKi), PARAMETER :: M5N2Vxi = 281 - INTEGER(IntKi), PARAMETER :: M5N3Vxi = 282 - INTEGER(IntKi), PARAMETER :: M5N4Vxi = 283 - INTEGER(IntKi), PARAMETER :: M5N5Vxi = 284 - INTEGER(IntKi), PARAMETER :: M5N6Vxi = 285 - INTEGER(IntKi), PARAMETER :: M5N7Vxi = 286 - INTEGER(IntKi), PARAMETER :: M5N8Vxi = 287 - INTEGER(IntKi), PARAMETER :: M5N9Vxi = 288 - INTEGER(IntKi), PARAMETER :: M6N1Vxi = 289 - INTEGER(IntKi), PARAMETER :: M6N2Vxi = 290 - INTEGER(IntKi), PARAMETER :: M6N3Vxi = 291 - INTEGER(IntKi), PARAMETER :: M6N4Vxi = 292 - INTEGER(IntKi), PARAMETER :: M6N5Vxi = 293 - INTEGER(IntKi), PARAMETER :: M6N6Vxi = 294 - INTEGER(IntKi), PARAMETER :: M6N7Vxi = 295 - INTEGER(IntKi), PARAMETER :: M6N8Vxi = 296 - INTEGER(IntKi), PARAMETER :: M6N9Vxi = 297 - INTEGER(IntKi), PARAMETER :: M7N1Vxi = 298 - INTEGER(IntKi), PARAMETER :: M7N2Vxi = 299 - INTEGER(IntKi), PARAMETER :: M7N3Vxi = 300 - INTEGER(IntKi), PARAMETER :: M7N4Vxi = 301 - INTEGER(IntKi), PARAMETER :: M7N5Vxi = 302 - INTEGER(IntKi), PARAMETER :: M7N6Vxi = 303 - INTEGER(IntKi), PARAMETER :: M7N7Vxi = 304 - INTEGER(IntKi), PARAMETER :: M7N8Vxi = 305 - INTEGER(IntKi), PARAMETER :: M7N9Vxi = 306 - INTEGER(IntKi), PARAMETER :: M8N1Vxi = 307 - INTEGER(IntKi), PARAMETER :: M8N2Vxi = 308 - INTEGER(IntKi), PARAMETER :: M8N3Vxi = 309 - INTEGER(IntKi), PARAMETER :: M8N4Vxi = 310 - INTEGER(IntKi), PARAMETER :: M8N5Vxi = 311 - INTEGER(IntKi), PARAMETER :: M8N6Vxi = 312 - INTEGER(IntKi), PARAMETER :: M8N7Vxi = 313 - INTEGER(IntKi), PARAMETER :: M8N8Vxi = 314 - INTEGER(IntKi), PARAMETER :: M8N9Vxi = 315 - INTEGER(IntKi), PARAMETER :: M9N1Vxi = 316 - INTEGER(IntKi), PARAMETER :: M9N2Vxi = 317 - INTEGER(IntKi), PARAMETER :: M9N3Vxi = 318 - INTEGER(IntKi), PARAMETER :: M9N4Vxi = 319 - INTEGER(IntKi), PARAMETER :: M9N5Vxi = 320 - INTEGER(IntKi), PARAMETER :: M9N6Vxi = 321 - INTEGER(IntKi), PARAMETER :: M9N7Vxi = 322 - INTEGER(IntKi), PARAMETER :: M9N8Vxi = 323 - INTEGER(IntKi), PARAMETER :: M9N9Vxi = 324 - INTEGER(IntKi), PARAMETER :: M1N1Vyi = 325 - INTEGER(IntKi), PARAMETER :: M1N2Vyi = 326 - INTEGER(IntKi), PARAMETER :: M1N3Vyi = 327 - INTEGER(IntKi), PARAMETER :: M1N4Vyi = 328 - INTEGER(IntKi), PARAMETER :: M1N5Vyi = 329 - INTEGER(IntKi), PARAMETER :: M1N6Vyi = 330 - INTEGER(IntKi), PARAMETER :: M1N7Vyi = 331 - INTEGER(IntKi), PARAMETER :: M1N8Vyi = 332 - INTEGER(IntKi), PARAMETER :: M1N9Vyi = 333 - INTEGER(IntKi), PARAMETER :: M2N1Vyi = 334 - INTEGER(IntKi), PARAMETER :: M2N2Vyi = 335 - INTEGER(IntKi), PARAMETER :: M2N3Vyi = 336 - INTEGER(IntKi), PARAMETER :: M2N4Vyi = 337 - INTEGER(IntKi), PARAMETER :: M2N5Vyi = 338 - INTEGER(IntKi), PARAMETER :: M2N6Vyi = 339 - INTEGER(IntKi), PARAMETER :: M2N7Vyi = 340 - INTEGER(IntKi), PARAMETER :: M2N8Vyi = 341 - INTEGER(IntKi), PARAMETER :: M2N9Vyi = 342 - INTEGER(IntKi), PARAMETER :: M3N1Vyi = 343 - INTEGER(IntKi), PARAMETER :: M3N2Vyi = 344 - INTEGER(IntKi), PARAMETER :: M3N3Vyi = 345 - INTEGER(IntKi), PARAMETER :: M3N4Vyi = 346 - INTEGER(IntKi), PARAMETER :: M3N5Vyi = 347 - INTEGER(IntKi), PARAMETER :: M3N6Vyi = 348 - INTEGER(IntKi), PARAMETER :: M3N7Vyi = 349 - INTEGER(IntKi), PARAMETER :: M3N8Vyi = 350 - INTEGER(IntKi), PARAMETER :: M3N9Vyi = 351 - INTEGER(IntKi), PARAMETER :: M4N1Vyi = 352 - INTEGER(IntKi), PARAMETER :: M4N2Vyi = 353 - INTEGER(IntKi), PARAMETER :: M4N3Vyi = 354 - INTEGER(IntKi), PARAMETER :: M4N4Vyi = 355 - INTEGER(IntKi), PARAMETER :: M4N5Vyi = 356 - INTEGER(IntKi), PARAMETER :: M4N6Vyi = 357 - INTEGER(IntKi), PARAMETER :: M4N7Vyi = 358 - INTEGER(IntKi), PARAMETER :: M4N8Vyi = 359 - INTEGER(IntKi), PARAMETER :: M4N9Vyi = 360 - INTEGER(IntKi), PARAMETER :: M5N1Vyi = 361 - INTEGER(IntKi), PARAMETER :: M5N2Vyi = 362 - INTEGER(IntKi), PARAMETER :: M5N3Vyi = 363 - INTEGER(IntKi), PARAMETER :: M5N4Vyi = 364 - INTEGER(IntKi), PARAMETER :: M5N5Vyi = 365 - INTEGER(IntKi), PARAMETER :: M5N6Vyi = 366 - INTEGER(IntKi), PARAMETER :: M5N7Vyi = 367 - INTEGER(IntKi), PARAMETER :: M5N8Vyi = 368 - INTEGER(IntKi), PARAMETER :: M5N9Vyi = 369 - INTEGER(IntKi), PARAMETER :: M6N1Vyi = 370 - INTEGER(IntKi), PARAMETER :: M6N2Vyi = 371 - INTEGER(IntKi), PARAMETER :: M6N3Vyi = 372 - INTEGER(IntKi), PARAMETER :: M6N4Vyi = 373 - INTEGER(IntKi), PARAMETER :: M6N5Vyi = 374 - INTEGER(IntKi), PARAMETER :: M6N6Vyi = 375 - INTEGER(IntKi), PARAMETER :: M6N7Vyi = 376 - INTEGER(IntKi), PARAMETER :: M6N8Vyi = 377 - INTEGER(IntKi), PARAMETER :: M6N9Vyi = 378 - INTEGER(IntKi), PARAMETER :: M7N1Vyi = 379 - INTEGER(IntKi), PARAMETER :: M7N2Vyi = 380 - INTEGER(IntKi), PARAMETER :: M7N3Vyi = 381 - INTEGER(IntKi), PARAMETER :: M7N4Vyi = 382 - INTEGER(IntKi), PARAMETER :: M7N5Vyi = 383 - INTEGER(IntKi), PARAMETER :: M7N6Vyi = 384 - INTEGER(IntKi), PARAMETER :: M7N7Vyi = 385 - INTEGER(IntKi), PARAMETER :: M7N8Vyi = 386 - INTEGER(IntKi), PARAMETER :: M7N9Vyi = 387 - INTEGER(IntKi), PARAMETER :: M8N1Vyi = 388 - INTEGER(IntKi), PARAMETER :: M8N2Vyi = 389 - INTEGER(IntKi), PARAMETER :: M8N3Vyi = 390 - INTEGER(IntKi), PARAMETER :: M8N4Vyi = 391 - INTEGER(IntKi), PARAMETER :: M8N5Vyi = 392 - INTEGER(IntKi), PARAMETER :: M8N6Vyi = 393 - INTEGER(IntKi), PARAMETER :: M8N7Vyi = 394 - INTEGER(IntKi), PARAMETER :: M8N8Vyi = 395 - INTEGER(IntKi), PARAMETER :: M8N9Vyi = 396 - INTEGER(IntKi), PARAMETER :: M9N1Vyi = 397 - INTEGER(IntKi), PARAMETER :: M9N2Vyi = 398 - INTEGER(IntKi), PARAMETER :: M9N3Vyi = 399 - INTEGER(IntKi), PARAMETER :: M9N4Vyi = 400 - INTEGER(IntKi), PARAMETER :: M9N5Vyi = 401 - INTEGER(IntKi), PARAMETER :: M9N6Vyi = 402 - INTEGER(IntKi), PARAMETER :: M9N7Vyi = 403 - INTEGER(IntKi), PARAMETER :: M9N8Vyi = 404 - INTEGER(IntKi), PARAMETER :: M9N9Vyi = 405 - INTEGER(IntKi), PARAMETER :: M1N1Vzi = 406 - INTEGER(IntKi), PARAMETER :: M1N2Vzi = 407 - INTEGER(IntKi), PARAMETER :: M1N3Vzi = 408 - INTEGER(IntKi), PARAMETER :: M1N4Vzi = 409 - INTEGER(IntKi), PARAMETER :: M1N5Vzi = 410 - INTEGER(IntKi), PARAMETER :: M1N6Vzi = 411 - INTEGER(IntKi), PARAMETER :: M1N7Vzi = 412 - INTEGER(IntKi), PARAMETER :: M1N8Vzi = 413 - INTEGER(IntKi), PARAMETER :: M1N9Vzi = 414 - INTEGER(IntKi), PARAMETER :: M2N1Vzi = 415 - INTEGER(IntKi), PARAMETER :: M2N2Vzi = 416 - INTEGER(IntKi), PARAMETER :: M2N3Vzi = 417 - INTEGER(IntKi), PARAMETER :: M2N4Vzi = 418 - INTEGER(IntKi), PARAMETER :: M2N5Vzi = 419 - INTEGER(IntKi), PARAMETER :: M2N6Vzi = 420 - INTEGER(IntKi), PARAMETER :: M2N7Vzi = 421 - INTEGER(IntKi), PARAMETER :: M2N8Vzi = 422 - INTEGER(IntKi), PARAMETER :: M2N9Vzi = 423 - INTEGER(IntKi), PARAMETER :: M3N1Vzi = 424 - INTEGER(IntKi), PARAMETER :: M3N2Vzi = 425 - INTEGER(IntKi), PARAMETER :: M3N3Vzi = 426 - INTEGER(IntKi), PARAMETER :: M3N4Vzi = 427 - INTEGER(IntKi), PARAMETER :: M3N5Vzi = 428 - INTEGER(IntKi), PARAMETER :: M3N6Vzi = 429 - INTEGER(IntKi), PARAMETER :: M3N7Vzi = 430 - INTEGER(IntKi), PARAMETER :: M3N8Vzi = 431 - INTEGER(IntKi), PARAMETER :: M3N9Vzi = 432 - INTEGER(IntKi), PARAMETER :: M4N1Vzi = 433 - INTEGER(IntKi), PARAMETER :: M4N2Vzi = 434 - INTEGER(IntKi), PARAMETER :: M4N3Vzi = 435 - INTEGER(IntKi), PARAMETER :: M4N4Vzi = 436 - INTEGER(IntKi), PARAMETER :: M4N5Vzi = 437 - INTEGER(IntKi), PARAMETER :: M4N6Vzi = 438 - INTEGER(IntKi), PARAMETER :: M4N7Vzi = 439 - INTEGER(IntKi), PARAMETER :: M4N8Vzi = 440 - INTEGER(IntKi), PARAMETER :: M4N9Vzi = 441 - INTEGER(IntKi), PARAMETER :: M5N1Vzi = 442 - INTEGER(IntKi), PARAMETER :: M5N2Vzi = 443 - INTEGER(IntKi), PARAMETER :: M5N3Vzi = 444 - INTEGER(IntKi), PARAMETER :: M5N4Vzi = 445 - INTEGER(IntKi), PARAMETER :: M5N5Vzi = 446 - INTEGER(IntKi), PARAMETER :: M5N6Vzi = 447 - INTEGER(IntKi), PARAMETER :: M5N7Vzi = 448 - INTEGER(IntKi), PARAMETER :: M5N8Vzi = 449 - INTEGER(IntKi), PARAMETER :: M5N9Vzi = 450 - INTEGER(IntKi), PARAMETER :: M6N1Vzi = 451 - INTEGER(IntKi), PARAMETER :: M6N2Vzi = 452 - INTEGER(IntKi), PARAMETER :: M6N3Vzi = 453 - INTEGER(IntKi), PARAMETER :: M6N4Vzi = 454 - INTEGER(IntKi), PARAMETER :: M6N5Vzi = 455 - INTEGER(IntKi), PARAMETER :: M6N6Vzi = 456 - INTEGER(IntKi), PARAMETER :: M6N7Vzi = 457 - INTEGER(IntKi), PARAMETER :: M6N8Vzi = 458 - INTEGER(IntKi), PARAMETER :: M6N9Vzi = 459 - INTEGER(IntKi), PARAMETER :: M7N1Vzi = 460 - INTEGER(IntKi), PARAMETER :: M7N2Vzi = 461 - INTEGER(IntKi), PARAMETER :: M7N3Vzi = 462 - INTEGER(IntKi), PARAMETER :: M7N4Vzi = 463 - INTEGER(IntKi), PARAMETER :: M7N5Vzi = 464 - INTEGER(IntKi), PARAMETER :: M7N6Vzi = 465 - INTEGER(IntKi), PARAMETER :: M7N7Vzi = 466 - INTEGER(IntKi), PARAMETER :: M7N8Vzi = 467 - INTEGER(IntKi), PARAMETER :: M7N9Vzi = 468 - INTEGER(IntKi), PARAMETER :: M8N1Vzi = 469 - INTEGER(IntKi), PARAMETER :: M8N2Vzi = 470 - INTEGER(IntKi), PARAMETER :: M8N3Vzi = 471 - INTEGER(IntKi), PARAMETER :: M8N4Vzi = 472 - INTEGER(IntKi), PARAMETER :: M8N5Vzi = 473 - INTEGER(IntKi), PARAMETER :: M8N6Vzi = 474 - INTEGER(IntKi), PARAMETER :: M8N7Vzi = 475 - INTEGER(IntKi), PARAMETER :: M8N8Vzi = 476 - INTEGER(IntKi), PARAMETER :: M8N9Vzi = 477 - INTEGER(IntKi), PARAMETER :: M9N1Vzi = 478 - INTEGER(IntKi), PARAMETER :: M9N2Vzi = 479 - INTEGER(IntKi), PARAMETER :: M9N3Vzi = 480 - INTEGER(IntKi), PARAMETER :: M9N4Vzi = 481 - INTEGER(IntKi), PARAMETER :: M9N5Vzi = 482 - INTEGER(IntKi), PARAMETER :: M9N6Vzi = 483 - INTEGER(IntKi), PARAMETER :: M9N7Vzi = 484 - INTEGER(IntKi), PARAMETER :: M9N8Vzi = 485 - INTEGER(IntKi), PARAMETER :: M9N9Vzi = 486 - INTEGER(IntKi), PARAMETER :: M1N1DynP = 487 - INTEGER(IntKi), PARAMETER :: M1N2DynP = 488 - INTEGER(IntKi), PARAMETER :: M1N3DynP = 489 - INTEGER(IntKi), PARAMETER :: M1N4DynP = 490 - INTEGER(IntKi), PARAMETER :: M1N5DynP = 491 - INTEGER(IntKi), PARAMETER :: M1N6DynP = 492 - INTEGER(IntKi), PARAMETER :: M1N7DynP = 493 - INTEGER(IntKi), PARAMETER :: M1N8DynP = 494 - INTEGER(IntKi), PARAMETER :: M1N9DynP = 495 - INTEGER(IntKi), PARAMETER :: M2N1DynP = 496 - INTEGER(IntKi), PARAMETER :: M2N2DynP = 497 - INTEGER(IntKi), PARAMETER :: M2N3DynP = 498 - INTEGER(IntKi), PARAMETER :: M2N4DynP = 499 - INTEGER(IntKi), PARAMETER :: M2N5DynP = 500 - INTEGER(IntKi), PARAMETER :: M2N6DynP = 501 - INTEGER(IntKi), PARAMETER :: M2N7DynP = 502 - INTEGER(IntKi), PARAMETER :: M2N8DynP = 503 - INTEGER(IntKi), PARAMETER :: M2N9DynP = 504 - INTEGER(IntKi), PARAMETER :: M3N1DynP = 505 - INTEGER(IntKi), PARAMETER :: M3N2DynP = 506 - INTEGER(IntKi), PARAMETER :: M3N3DynP = 507 - INTEGER(IntKi), PARAMETER :: M3N4DynP = 508 - INTEGER(IntKi), PARAMETER :: M3N5DynP = 509 - INTEGER(IntKi), PARAMETER :: M3N6DynP = 510 - INTEGER(IntKi), PARAMETER :: M3N7DynP = 511 - INTEGER(IntKi), PARAMETER :: M3N8DynP = 512 - INTEGER(IntKi), PARAMETER :: M3N9DynP = 513 - INTEGER(IntKi), PARAMETER :: M4N1DynP = 514 - INTEGER(IntKi), PARAMETER :: M4N2DynP = 515 - INTEGER(IntKi), PARAMETER :: M4N3DynP = 516 - INTEGER(IntKi), PARAMETER :: M4N4DynP = 517 - INTEGER(IntKi), PARAMETER :: M4N5DynP = 518 - INTEGER(IntKi), PARAMETER :: M4N6DynP = 519 - INTEGER(IntKi), PARAMETER :: M4N7DynP = 520 - INTEGER(IntKi), PARAMETER :: M4N8DynP = 521 - INTEGER(IntKi), PARAMETER :: M4N9DynP = 522 - INTEGER(IntKi), PARAMETER :: M5N1DynP = 523 - INTEGER(IntKi), PARAMETER :: M5N2DynP = 524 - INTEGER(IntKi), PARAMETER :: M5N3DynP = 525 - INTEGER(IntKi), PARAMETER :: M5N4DynP = 526 - INTEGER(IntKi), PARAMETER :: M5N5DynP = 527 - INTEGER(IntKi), PARAMETER :: M5N6DynP = 528 - INTEGER(IntKi), PARAMETER :: M5N7DynP = 529 - INTEGER(IntKi), PARAMETER :: M5N8DynP = 530 - INTEGER(IntKi), PARAMETER :: M5N9DynP = 531 - INTEGER(IntKi), PARAMETER :: M6N1DynP = 532 - INTEGER(IntKi), PARAMETER :: M6N2DynP = 533 - INTEGER(IntKi), PARAMETER :: M6N3DynP = 534 - INTEGER(IntKi), PARAMETER :: M6N4DynP = 535 - INTEGER(IntKi), PARAMETER :: M6N5DynP = 536 - INTEGER(IntKi), PARAMETER :: M6N6DynP = 537 - INTEGER(IntKi), PARAMETER :: M6N7DynP = 538 - INTEGER(IntKi), PARAMETER :: M6N8DynP = 539 - INTEGER(IntKi), PARAMETER :: M6N9DynP = 540 - INTEGER(IntKi), PARAMETER :: M7N1DynP = 541 - INTEGER(IntKi), PARAMETER :: M7N2DynP = 542 - INTEGER(IntKi), PARAMETER :: M7N3DynP = 543 - INTEGER(IntKi), PARAMETER :: M7N4DynP = 544 - INTEGER(IntKi), PARAMETER :: M7N5DynP = 545 - INTEGER(IntKi), PARAMETER :: M7N6DynP = 546 - INTEGER(IntKi), PARAMETER :: M7N7DynP = 547 - INTEGER(IntKi), PARAMETER :: M7N8DynP = 548 - INTEGER(IntKi), PARAMETER :: M7N9DynP = 549 - INTEGER(IntKi), PARAMETER :: M8N1DynP = 550 - INTEGER(IntKi), PARAMETER :: M8N2DynP = 551 - INTEGER(IntKi), PARAMETER :: M8N3DynP = 552 - INTEGER(IntKi), PARAMETER :: M8N4DynP = 553 - INTEGER(IntKi), PARAMETER :: M8N5DynP = 554 - INTEGER(IntKi), PARAMETER :: M8N6DynP = 555 - INTEGER(IntKi), PARAMETER :: M8N7DynP = 556 - INTEGER(IntKi), PARAMETER :: M8N8DynP = 557 - INTEGER(IntKi), PARAMETER :: M8N9DynP = 558 - INTEGER(IntKi), PARAMETER :: M9N1DynP = 559 - INTEGER(IntKi), PARAMETER :: M9N2DynP = 560 - INTEGER(IntKi), PARAMETER :: M9N3DynP = 561 - INTEGER(IntKi), PARAMETER :: M9N4DynP = 562 - INTEGER(IntKi), PARAMETER :: M9N5DynP = 563 - INTEGER(IntKi), PARAMETER :: M9N6DynP = 564 - INTEGER(IntKi), PARAMETER :: M9N7DynP = 565 - INTEGER(IntKi), PARAMETER :: M9N8DynP = 566 - INTEGER(IntKi), PARAMETER :: M9N9DynP = 567 - INTEGER(IntKi), PARAMETER :: M1N1STVxi = 568 - INTEGER(IntKi), PARAMETER :: M1N2STVxi = 569 - INTEGER(IntKi), PARAMETER :: M1N3STVxi = 570 - INTEGER(IntKi), PARAMETER :: M1N4STVxi = 571 - INTEGER(IntKi), PARAMETER :: M1N5STVxi = 572 - INTEGER(IntKi), PARAMETER :: M1N6STVxi = 573 - INTEGER(IntKi), PARAMETER :: M1N7STVxi = 574 - INTEGER(IntKi), PARAMETER :: M1N8STVxi = 575 - INTEGER(IntKi), PARAMETER :: M1N9STVxi = 576 - INTEGER(IntKi), PARAMETER :: M2N1STVxi = 577 - INTEGER(IntKi), PARAMETER :: M2N2STVxi = 578 - INTEGER(IntKi), PARAMETER :: M2N3STVxi = 579 - INTEGER(IntKi), PARAMETER :: M2N4STVxi = 580 - INTEGER(IntKi), PARAMETER :: M2N5STVxi = 581 - INTEGER(IntKi), PARAMETER :: M2N6STVxi = 582 - INTEGER(IntKi), PARAMETER :: M2N7STVxi = 583 - INTEGER(IntKi), PARAMETER :: M2N8STVxi = 584 - INTEGER(IntKi), PARAMETER :: M2N9STVxi = 585 - INTEGER(IntKi), PARAMETER :: M3N1STVxi = 586 - INTEGER(IntKi), PARAMETER :: M3N2STVxi = 587 - INTEGER(IntKi), PARAMETER :: M3N3STVxi = 588 - INTEGER(IntKi), PARAMETER :: M3N4STVxi = 589 - INTEGER(IntKi), PARAMETER :: M3N5STVxi = 590 - INTEGER(IntKi), PARAMETER :: M3N6STVxi = 591 - INTEGER(IntKi), PARAMETER :: M3N7STVxi = 592 - INTEGER(IntKi), PARAMETER :: M3N8STVxi = 593 - INTEGER(IntKi), PARAMETER :: M3N9STVxi = 594 - INTEGER(IntKi), PARAMETER :: M4N1STVxi = 595 - INTEGER(IntKi), PARAMETER :: M4N2STVxi = 596 - INTEGER(IntKi), PARAMETER :: M4N3STVxi = 597 - INTEGER(IntKi), PARAMETER :: M4N4STVxi = 598 - INTEGER(IntKi), PARAMETER :: M4N5STVxi = 599 - INTEGER(IntKi), PARAMETER :: M4N6STVxi = 600 - INTEGER(IntKi), PARAMETER :: M4N7STVxi = 601 - INTEGER(IntKi), PARAMETER :: M4N8STVxi = 602 - INTEGER(IntKi), PARAMETER :: M4N9STVxi = 603 - INTEGER(IntKi), PARAMETER :: M5N1STVxi = 604 - INTEGER(IntKi), PARAMETER :: M5N2STVxi = 605 - INTEGER(IntKi), PARAMETER :: M5N3STVxi = 606 - INTEGER(IntKi), PARAMETER :: M5N4STVxi = 607 - INTEGER(IntKi), PARAMETER :: M5N5STVxi = 608 - INTEGER(IntKi), PARAMETER :: M5N6STVxi = 609 - INTEGER(IntKi), PARAMETER :: M5N7STVxi = 610 - INTEGER(IntKi), PARAMETER :: M5N8STVxi = 611 - INTEGER(IntKi), PARAMETER :: M5N9STVxi = 612 - INTEGER(IntKi), PARAMETER :: M6N1STVxi = 613 - INTEGER(IntKi), PARAMETER :: M6N2STVxi = 614 - INTEGER(IntKi), PARAMETER :: M6N3STVxi = 615 - INTEGER(IntKi), PARAMETER :: M6N4STVxi = 616 - INTEGER(IntKi), PARAMETER :: M6N5STVxi = 617 - INTEGER(IntKi), PARAMETER :: M6N6STVxi = 618 - INTEGER(IntKi), PARAMETER :: M6N7STVxi = 619 - INTEGER(IntKi), PARAMETER :: M6N8STVxi = 620 - INTEGER(IntKi), PARAMETER :: M6N9STVxi = 621 - INTEGER(IntKi), PARAMETER :: M7N1STVxi = 622 - INTEGER(IntKi), PARAMETER :: M7N2STVxi = 623 - INTEGER(IntKi), PARAMETER :: M7N3STVxi = 624 - INTEGER(IntKi), PARAMETER :: M7N4STVxi = 625 - INTEGER(IntKi), PARAMETER :: M7N5STVxi = 626 - INTEGER(IntKi), PARAMETER :: M7N6STVxi = 627 - INTEGER(IntKi), PARAMETER :: M7N7STVxi = 628 - INTEGER(IntKi), PARAMETER :: M7N8STVxi = 629 - INTEGER(IntKi), PARAMETER :: M7N9STVxi = 630 - INTEGER(IntKi), PARAMETER :: M8N1STVxi = 631 - INTEGER(IntKi), PARAMETER :: M8N2STVxi = 632 - INTEGER(IntKi), PARAMETER :: M8N3STVxi = 633 - INTEGER(IntKi), PARAMETER :: M8N4STVxi = 634 - INTEGER(IntKi), PARAMETER :: M8N5STVxi = 635 - INTEGER(IntKi), PARAMETER :: M8N6STVxi = 636 - INTEGER(IntKi), PARAMETER :: M8N7STVxi = 637 - INTEGER(IntKi), PARAMETER :: M8N8STVxi = 638 - INTEGER(IntKi), PARAMETER :: M8N9STVxi = 639 - INTEGER(IntKi), PARAMETER :: M9N1STVxi = 640 - INTEGER(IntKi), PARAMETER :: M9N2STVxi = 641 - INTEGER(IntKi), PARAMETER :: M9N3STVxi = 642 - INTEGER(IntKi), PARAMETER :: M9N4STVxi = 643 - INTEGER(IntKi), PARAMETER :: M9N5STVxi = 644 - INTEGER(IntKi), PARAMETER :: M9N6STVxi = 645 - INTEGER(IntKi), PARAMETER :: M9N7STVxi = 646 - INTEGER(IntKi), PARAMETER :: M9N8STVxi = 647 - INTEGER(IntKi), PARAMETER :: M9N9STVxi = 648 - INTEGER(IntKi), PARAMETER :: M1N1STVyi = 649 - INTEGER(IntKi), PARAMETER :: M1N2STVyi = 650 - INTEGER(IntKi), PARAMETER :: M1N3STVyi = 651 - INTEGER(IntKi), PARAMETER :: M1N4STVyi = 652 - INTEGER(IntKi), PARAMETER :: M1N5STVyi = 653 - INTEGER(IntKi), PARAMETER :: M1N6STVyi = 654 - INTEGER(IntKi), PARAMETER :: M1N7STVyi = 655 - INTEGER(IntKi), PARAMETER :: M1N8STVyi = 656 - INTEGER(IntKi), PARAMETER :: M1N9STVyi = 657 - INTEGER(IntKi), PARAMETER :: M2N1STVyi = 658 - INTEGER(IntKi), PARAMETER :: M2N2STVyi = 659 - INTEGER(IntKi), PARAMETER :: M2N3STVyi = 660 - INTEGER(IntKi), PARAMETER :: M2N4STVyi = 661 - INTEGER(IntKi), PARAMETER :: M2N5STVyi = 662 - INTEGER(IntKi), PARAMETER :: M2N6STVyi = 663 - INTEGER(IntKi), PARAMETER :: M2N7STVyi = 664 - INTEGER(IntKi), PARAMETER :: M2N8STVyi = 665 - INTEGER(IntKi), PARAMETER :: M2N9STVyi = 666 - INTEGER(IntKi), PARAMETER :: M3N1STVyi = 667 - INTEGER(IntKi), PARAMETER :: M3N2STVyi = 668 - INTEGER(IntKi), PARAMETER :: M3N3STVyi = 669 - INTEGER(IntKi), PARAMETER :: M3N4STVyi = 670 - INTEGER(IntKi), PARAMETER :: M3N5STVyi = 671 - INTEGER(IntKi), PARAMETER :: M3N6STVyi = 672 - INTEGER(IntKi), PARAMETER :: M3N7STVyi = 673 - INTEGER(IntKi), PARAMETER :: M3N8STVyi = 674 - INTEGER(IntKi), PARAMETER :: M3N9STVyi = 675 - INTEGER(IntKi), PARAMETER :: M4N1STVyi = 676 - INTEGER(IntKi), PARAMETER :: M4N2STVyi = 677 - INTEGER(IntKi), PARAMETER :: M4N3STVyi = 678 - INTEGER(IntKi), PARAMETER :: M4N4STVyi = 679 - INTEGER(IntKi), PARAMETER :: M4N5STVyi = 680 - INTEGER(IntKi), PARAMETER :: M4N6STVyi = 681 - INTEGER(IntKi), PARAMETER :: M4N7STVyi = 682 - INTEGER(IntKi), PARAMETER :: M4N8STVyi = 683 - INTEGER(IntKi), PARAMETER :: M4N9STVyi = 684 - INTEGER(IntKi), PARAMETER :: M5N1STVyi = 685 - INTEGER(IntKi), PARAMETER :: M5N2STVyi = 686 - INTEGER(IntKi), PARAMETER :: M5N3STVyi = 687 - INTEGER(IntKi), PARAMETER :: M5N4STVyi = 688 - INTEGER(IntKi), PARAMETER :: M5N5STVyi = 689 - INTEGER(IntKi), PARAMETER :: M5N6STVyi = 690 - INTEGER(IntKi), PARAMETER :: M5N7STVyi = 691 - INTEGER(IntKi), PARAMETER :: M5N8STVyi = 692 - INTEGER(IntKi), PARAMETER :: M5N9STVyi = 693 - INTEGER(IntKi), PARAMETER :: M6N1STVyi = 694 - INTEGER(IntKi), PARAMETER :: M6N2STVyi = 695 - INTEGER(IntKi), PARAMETER :: M6N3STVyi = 696 - INTEGER(IntKi), PARAMETER :: M6N4STVyi = 697 - INTEGER(IntKi), PARAMETER :: M6N5STVyi = 698 - INTEGER(IntKi), PARAMETER :: M6N6STVyi = 699 - INTEGER(IntKi), PARAMETER :: M6N7STVyi = 700 - INTEGER(IntKi), PARAMETER :: M6N8STVyi = 701 - INTEGER(IntKi), PARAMETER :: M6N9STVyi = 702 - INTEGER(IntKi), PARAMETER :: M7N1STVyi = 703 - INTEGER(IntKi), PARAMETER :: M7N2STVyi = 704 - INTEGER(IntKi), PARAMETER :: M7N3STVyi = 705 - INTEGER(IntKi), PARAMETER :: M7N4STVyi = 706 - INTEGER(IntKi), PARAMETER :: M7N5STVyi = 707 - INTEGER(IntKi), PARAMETER :: M7N6STVyi = 708 - INTEGER(IntKi), PARAMETER :: M7N7STVyi = 709 - INTEGER(IntKi), PARAMETER :: M7N8STVyi = 710 - INTEGER(IntKi), PARAMETER :: M7N9STVyi = 711 - INTEGER(IntKi), PARAMETER :: M8N1STVyi = 712 - INTEGER(IntKi), PARAMETER :: M8N2STVyi = 713 - INTEGER(IntKi), PARAMETER :: M8N3STVyi = 714 - INTEGER(IntKi), PARAMETER :: M8N4STVyi = 715 - INTEGER(IntKi), PARAMETER :: M8N5STVyi = 716 - INTEGER(IntKi), PARAMETER :: M8N6STVyi = 717 - INTEGER(IntKi), PARAMETER :: M8N7STVyi = 718 - INTEGER(IntKi), PARAMETER :: M8N8STVyi = 719 - INTEGER(IntKi), PARAMETER :: M8N9STVyi = 720 - INTEGER(IntKi), PARAMETER :: M9N1STVyi = 721 - INTEGER(IntKi), PARAMETER :: M9N2STVyi = 722 - INTEGER(IntKi), PARAMETER :: M9N3STVyi = 723 - INTEGER(IntKi), PARAMETER :: M9N4STVyi = 724 - INTEGER(IntKi), PARAMETER :: M9N5STVyi = 725 - INTEGER(IntKi), PARAMETER :: M9N6STVyi = 726 - INTEGER(IntKi), PARAMETER :: M9N7STVyi = 727 - INTEGER(IntKi), PARAMETER :: M9N8STVyi = 728 - INTEGER(IntKi), PARAMETER :: M9N9STVyi = 729 - INTEGER(IntKi), PARAMETER :: M1N1STVzi = 730 - INTEGER(IntKi), PARAMETER :: M1N2STVzi = 731 - INTEGER(IntKi), PARAMETER :: M1N3STVzi = 732 - INTEGER(IntKi), PARAMETER :: M1N4STVzi = 733 - INTEGER(IntKi), PARAMETER :: M1N5STVzi = 734 - INTEGER(IntKi), PARAMETER :: M1N6STVzi = 735 - INTEGER(IntKi), PARAMETER :: M1N7STVzi = 736 - INTEGER(IntKi), PARAMETER :: M1N8STVzi = 737 - INTEGER(IntKi), PARAMETER :: M1N9STVzi = 738 - INTEGER(IntKi), PARAMETER :: M2N1STVzi = 739 - INTEGER(IntKi), PARAMETER :: M2N2STVzi = 740 - INTEGER(IntKi), PARAMETER :: M2N3STVzi = 741 - INTEGER(IntKi), PARAMETER :: M2N4STVzi = 742 - INTEGER(IntKi), PARAMETER :: M2N5STVzi = 743 - INTEGER(IntKi), PARAMETER :: M2N6STVzi = 744 - INTEGER(IntKi), PARAMETER :: M2N7STVzi = 745 - INTEGER(IntKi), PARAMETER :: M2N8STVzi = 746 - INTEGER(IntKi), PARAMETER :: M2N9STVzi = 747 - INTEGER(IntKi), PARAMETER :: M3N1STVzi = 748 - INTEGER(IntKi), PARAMETER :: M3N2STVzi = 749 - INTEGER(IntKi), PARAMETER :: M3N3STVzi = 750 - INTEGER(IntKi), PARAMETER :: M3N4STVzi = 751 - INTEGER(IntKi), PARAMETER :: M3N5STVzi = 752 - INTEGER(IntKi), PARAMETER :: M3N6STVzi = 753 - INTEGER(IntKi), PARAMETER :: M3N7STVzi = 754 - INTEGER(IntKi), PARAMETER :: M3N8STVzi = 755 - INTEGER(IntKi), PARAMETER :: M3N9STVzi = 756 - INTEGER(IntKi), PARAMETER :: M4N1STVzi = 757 - INTEGER(IntKi), PARAMETER :: M4N2STVzi = 758 - INTEGER(IntKi), PARAMETER :: M4N3STVzi = 759 - INTEGER(IntKi), PARAMETER :: M4N4STVzi = 760 - INTEGER(IntKi), PARAMETER :: M4N5STVzi = 761 - INTEGER(IntKi), PARAMETER :: M4N6STVzi = 762 - INTEGER(IntKi), PARAMETER :: M4N7STVzi = 763 - INTEGER(IntKi), PARAMETER :: M4N8STVzi = 764 - INTEGER(IntKi), PARAMETER :: M4N9STVzi = 765 - INTEGER(IntKi), PARAMETER :: M5N1STVzi = 766 - INTEGER(IntKi), PARAMETER :: M5N2STVzi = 767 - INTEGER(IntKi), PARAMETER :: M5N3STVzi = 768 - INTEGER(IntKi), PARAMETER :: M5N4STVzi = 769 - INTEGER(IntKi), PARAMETER :: M5N5STVzi = 770 - INTEGER(IntKi), PARAMETER :: M5N6STVzi = 771 - INTEGER(IntKi), PARAMETER :: M5N7STVzi = 772 - INTEGER(IntKi), PARAMETER :: M5N8STVzi = 773 - INTEGER(IntKi), PARAMETER :: M5N9STVzi = 774 - INTEGER(IntKi), PARAMETER :: M6N1STVzi = 775 - INTEGER(IntKi), PARAMETER :: M6N2STVzi = 776 - INTEGER(IntKi), PARAMETER :: M6N3STVzi = 777 - INTEGER(IntKi), PARAMETER :: M6N4STVzi = 778 - INTEGER(IntKi), PARAMETER :: M6N5STVzi = 779 - INTEGER(IntKi), PARAMETER :: M6N6STVzi = 780 - INTEGER(IntKi), PARAMETER :: M6N7STVzi = 781 - INTEGER(IntKi), PARAMETER :: M6N8STVzi = 782 - INTEGER(IntKi), PARAMETER :: M6N9STVzi = 783 - INTEGER(IntKi), PARAMETER :: M7N1STVzi = 784 - INTEGER(IntKi), PARAMETER :: M7N2STVzi = 785 - INTEGER(IntKi), PARAMETER :: M7N3STVzi = 786 - INTEGER(IntKi), PARAMETER :: M7N4STVzi = 787 - INTEGER(IntKi), PARAMETER :: M7N5STVzi = 788 - INTEGER(IntKi), PARAMETER :: M7N6STVzi = 789 - INTEGER(IntKi), PARAMETER :: M7N7STVzi = 790 - INTEGER(IntKi), PARAMETER :: M7N8STVzi = 791 - INTEGER(IntKi), PARAMETER :: M7N9STVzi = 792 - INTEGER(IntKi), PARAMETER :: M8N1STVzi = 793 - INTEGER(IntKi), PARAMETER :: M8N2STVzi = 794 - INTEGER(IntKi), PARAMETER :: M8N3STVzi = 795 - INTEGER(IntKi), PARAMETER :: M8N4STVzi = 796 - INTEGER(IntKi), PARAMETER :: M8N5STVzi = 797 - INTEGER(IntKi), PARAMETER :: M8N6STVzi = 798 - INTEGER(IntKi), PARAMETER :: M8N7STVzi = 799 - INTEGER(IntKi), PARAMETER :: M8N8STVzi = 800 - INTEGER(IntKi), PARAMETER :: M8N9STVzi = 801 - INTEGER(IntKi), PARAMETER :: M9N1STVzi = 802 - INTEGER(IntKi), PARAMETER :: M9N2STVzi = 803 - INTEGER(IntKi), PARAMETER :: M9N3STVzi = 804 - INTEGER(IntKi), PARAMETER :: M9N4STVzi = 805 - INTEGER(IntKi), PARAMETER :: M9N5STVzi = 806 - INTEGER(IntKi), PARAMETER :: M9N6STVzi = 807 - INTEGER(IntKi), PARAMETER :: M9N7STVzi = 808 - INTEGER(IntKi), PARAMETER :: M9N8STVzi = 809 - INTEGER(IntKi), PARAMETER :: M9N9STVzi = 810 - INTEGER(IntKi), PARAMETER :: M1N1STAxi = 811 - INTEGER(IntKi), PARAMETER :: M1N2STAxi = 812 - INTEGER(IntKi), PARAMETER :: M1N3STAxi = 813 - INTEGER(IntKi), PARAMETER :: M1N4STAxi = 814 - INTEGER(IntKi), PARAMETER :: M1N5STAxi = 815 - INTEGER(IntKi), PARAMETER :: M1N6STAxi = 816 - INTEGER(IntKi), PARAMETER :: M1N7STAxi = 817 - INTEGER(IntKi), PARAMETER :: M1N8STAxi = 818 - INTEGER(IntKi), PARAMETER :: M1N9STAxi = 819 - INTEGER(IntKi), PARAMETER :: M2N1STAxi = 820 - INTEGER(IntKi), PARAMETER :: M2N2STAxi = 821 - INTEGER(IntKi), PARAMETER :: M2N3STAxi = 822 - INTEGER(IntKi), PARAMETER :: M2N4STAxi = 823 - INTEGER(IntKi), PARAMETER :: M2N5STAxi = 824 - INTEGER(IntKi), PARAMETER :: M2N6STAxi = 825 - INTEGER(IntKi), PARAMETER :: M2N7STAxi = 826 - INTEGER(IntKi), PARAMETER :: M2N8STAxi = 827 - INTEGER(IntKi), PARAMETER :: M2N9STAxi = 828 - INTEGER(IntKi), PARAMETER :: M3N1STAxi = 829 - INTEGER(IntKi), PARAMETER :: M3N2STAxi = 830 - INTEGER(IntKi), PARAMETER :: M3N3STAxi = 831 - INTEGER(IntKi), PARAMETER :: M3N4STAxi = 832 - INTEGER(IntKi), PARAMETER :: M3N5STAxi = 833 - INTEGER(IntKi), PARAMETER :: M3N6STAxi = 834 - INTEGER(IntKi), PARAMETER :: M3N7STAxi = 835 - INTEGER(IntKi), PARAMETER :: M3N8STAxi = 836 - INTEGER(IntKi), PARAMETER :: M3N9STAxi = 837 - INTEGER(IntKi), PARAMETER :: M4N1STAxi = 838 - INTEGER(IntKi), PARAMETER :: M4N2STAxi = 839 - INTEGER(IntKi), PARAMETER :: M4N3STAxi = 840 - INTEGER(IntKi), PARAMETER :: M4N4STAxi = 841 - INTEGER(IntKi), PARAMETER :: M4N5STAxi = 842 - INTEGER(IntKi), PARAMETER :: M4N6STAxi = 843 - INTEGER(IntKi), PARAMETER :: M4N7STAxi = 844 - INTEGER(IntKi), PARAMETER :: M4N8STAxi = 845 - INTEGER(IntKi), PARAMETER :: M4N9STAxi = 846 - INTEGER(IntKi), PARAMETER :: M5N1STAxi = 847 - INTEGER(IntKi), PARAMETER :: M5N2STAxi = 848 - INTEGER(IntKi), PARAMETER :: M5N3STAxi = 849 - INTEGER(IntKi), PARAMETER :: M5N4STAxi = 850 - INTEGER(IntKi), PARAMETER :: M5N5STAxi = 851 - INTEGER(IntKi), PARAMETER :: M5N6STAxi = 852 - INTEGER(IntKi), PARAMETER :: M5N7STAxi = 853 - INTEGER(IntKi), PARAMETER :: M5N8STAxi = 854 - INTEGER(IntKi), PARAMETER :: M5N9STAxi = 855 - INTEGER(IntKi), PARAMETER :: M6N1STAxi = 856 - INTEGER(IntKi), PARAMETER :: M6N2STAxi = 857 - INTEGER(IntKi), PARAMETER :: M6N3STAxi = 858 - INTEGER(IntKi), PARAMETER :: M6N4STAxi = 859 - INTEGER(IntKi), PARAMETER :: M6N5STAxi = 860 - INTEGER(IntKi), PARAMETER :: M6N6STAxi = 861 - INTEGER(IntKi), PARAMETER :: M6N7STAxi = 862 - INTEGER(IntKi), PARAMETER :: M6N8STAxi = 863 - INTEGER(IntKi), PARAMETER :: M6N9STAxi = 864 - INTEGER(IntKi), PARAMETER :: M7N1STAxi = 865 - INTEGER(IntKi), PARAMETER :: M7N2STAxi = 866 - INTEGER(IntKi), PARAMETER :: M7N3STAxi = 867 - INTEGER(IntKi), PARAMETER :: M7N4STAxi = 868 - INTEGER(IntKi), PARAMETER :: M7N5STAxi = 869 - INTEGER(IntKi), PARAMETER :: M7N6STAxi = 870 - INTEGER(IntKi), PARAMETER :: M7N7STAxi = 871 - INTEGER(IntKi), PARAMETER :: M7N8STAxi = 872 - INTEGER(IntKi), PARAMETER :: M7N9STAxi = 873 - INTEGER(IntKi), PARAMETER :: M8N1STAxi = 874 - INTEGER(IntKi), PARAMETER :: M8N2STAxi = 875 - INTEGER(IntKi), PARAMETER :: M8N3STAxi = 876 - INTEGER(IntKi), PARAMETER :: M8N4STAxi = 877 - INTEGER(IntKi), PARAMETER :: M8N5STAxi = 878 - INTEGER(IntKi), PARAMETER :: M8N6STAxi = 879 - INTEGER(IntKi), PARAMETER :: M8N7STAxi = 880 - INTEGER(IntKi), PARAMETER :: M8N8STAxi = 881 - INTEGER(IntKi), PARAMETER :: M8N9STAxi = 882 - INTEGER(IntKi), PARAMETER :: M9N1STAxi = 883 - INTEGER(IntKi), PARAMETER :: M9N2STAxi = 884 - INTEGER(IntKi), PARAMETER :: M9N3STAxi = 885 - INTEGER(IntKi), PARAMETER :: M9N4STAxi = 886 - INTEGER(IntKi), PARAMETER :: M9N5STAxi = 887 - INTEGER(IntKi), PARAMETER :: M9N6STAxi = 888 - INTEGER(IntKi), PARAMETER :: M9N7STAxi = 889 - INTEGER(IntKi), PARAMETER :: M9N8STAxi = 890 - INTEGER(IntKi), PARAMETER :: M9N9STAxi = 891 - INTEGER(IntKi), PARAMETER :: M1N1STAyi = 892 - INTEGER(IntKi), PARAMETER :: M1N2STAyi = 893 - INTEGER(IntKi), PARAMETER :: M1N3STAyi = 894 - INTEGER(IntKi), PARAMETER :: M1N4STAyi = 895 - INTEGER(IntKi), PARAMETER :: M1N5STAyi = 896 - INTEGER(IntKi), PARAMETER :: M1N6STAyi = 897 - INTEGER(IntKi), PARAMETER :: M1N7STAyi = 898 - INTEGER(IntKi), PARAMETER :: M1N8STAyi = 899 - INTEGER(IntKi), PARAMETER :: M1N9STAyi = 900 - INTEGER(IntKi), PARAMETER :: M2N1STAyi = 901 - INTEGER(IntKi), PARAMETER :: M2N2STAyi = 902 - INTEGER(IntKi), PARAMETER :: M2N3STAyi = 903 - INTEGER(IntKi), PARAMETER :: M2N4STAyi = 904 - INTEGER(IntKi), PARAMETER :: M2N5STAyi = 905 - INTEGER(IntKi), PARAMETER :: M2N6STAyi = 906 - INTEGER(IntKi), PARAMETER :: M2N7STAyi = 907 - INTEGER(IntKi), PARAMETER :: M2N8STAyi = 908 - INTEGER(IntKi), PARAMETER :: M2N9STAyi = 909 - INTEGER(IntKi), PARAMETER :: M3N1STAyi = 910 - INTEGER(IntKi), PARAMETER :: M3N2STAyi = 911 - INTEGER(IntKi), PARAMETER :: M3N3STAyi = 912 - INTEGER(IntKi), PARAMETER :: M3N4STAyi = 913 - INTEGER(IntKi), PARAMETER :: M3N5STAyi = 914 - INTEGER(IntKi), PARAMETER :: M3N6STAyi = 915 - INTEGER(IntKi), PARAMETER :: M3N7STAyi = 916 - INTEGER(IntKi), PARAMETER :: M3N8STAyi = 917 - INTEGER(IntKi), PARAMETER :: M3N9STAyi = 918 - INTEGER(IntKi), PARAMETER :: M4N1STAyi = 919 - INTEGER(IntKi), PARAMETER :: M4N2STAyi = 920 - INTEGER(IntKi), PARAMETER :: M4N3STAyi = 921 - INTEGER(IntKi), PARAMETER :: M4N4STAyi = 922 - INTEGER(IntKi), PARAMETER :: M4N5STAyi = 923 - INTEGER(IntKi), PARAMETER :: M4N6STAyi = 924 - INTEGER(IntKi), PARAMETER :: M4N7STAyi = 925 - INTEGER(IntKi), PARAMETER :: M4N8STAyi = 926 - INTEGER(IntKi), PARAMETER :: M4N9STAyi = 927 - INTEGER(IntKi), PARAMETER :: M5N1STAyi = 928 - INTEGER(IntKi), PARAMETER :: M5N2STAyi = 929 - INTEGER(IntKi), PARAMETER :: M5N3STAyi = 930 - INTEGER(IntKi), PARAMETER :: M5N4STAyi = 931 - INTEGER(IntKi), PARAMETER :: M5N5STAyi = 932 - INTEGER(IntKi), PARAMETER :: M5N6STAyi = 933 - INTEGER(IntKi), PARAMETER :: M5N7STAyi = 934 - INTEGER(IntKi), PARAMETER :: M5N8STAyi = 935 - INTEGER(IntKi), PARAMETER :: M5N9STAyi = 936 - INTEGER(IntKi), PARAMETER :: M6N1STAyi = 937 - INTEGER(IntKi), PARAMETER :: M6N2STAyi = 938 - INTEGER(IntKi), PARAMETER :: M6N3STAyi = 939 - INTEGER(IntKi), PARAMETER :: M6N4STAyi = 940 - INTEGER(IntKi), PARAMETER :: M6N5STAyi = 941 - INTEGER(IntKi), PARAMETER :: M6N6STAyi = 942 - INTEGER(IntKi), PARAMETER :: M6N7STAyi = 943 - INTEGER(IntKi), PARAMETER :: M6N8STAyi = 944 - INTEGER(IntKi), PARAMETER :: M6N9STAyi = 945 - INTEGER(IntKi), PARAMETER :: M7N1STAyi = 946 - INTEGER(IntKi), PARAMETER :: M7N2STAyi = 947 - INTEGER(IntKi), PARAMETER :: M7N3STAyi = 948 - INTEGER(IntKi), PARAMETER :: M7N4STAyi = 949 - INTEGER(IntKi), PARAMETER :: M7N5STAyi = 950 - INTEGER(IntKi), PARAMETER :: M7N6STAyi = 951 - INTEGER(IntKi), PARAMETER :: M7N7STAyi = 952 - INTEGER(IntKi), PARAMETER :: M7N8STAyi = 953 - INTEGER(IntKi), PARAMETER :: M7N9STAyi = 954 - INTEGER(IntKi), PARAMETER :: M8N1STAyi = 955 - INTEGER(IntKi), PARAMETER :: M8N2STAyi = 956 - INTEGER(IntKi), PARAMETER :: M8N3STAyi = 957 - INTEGER(IntKi), PARAMETER :: M8N4STAyi = 958 - INTEGER(IntKi), PARAMETER :: M8N5STAyi = 959 - INTEGER(IntKi), PARAMETER :: M8N6STAyi = 960 - INTEGER(IntKi), PARAMETER :: M8N7STAyi = 961 - INTEGER(IntKi), PARAMETER :: M8N8STAyi = 962 - INTEGER(IntKi), PARAMETER :: M8N9STAyi = 963 - INTEGER(IntKi), PARAMETER :: M9N1STAyi = 964 - INTEGER(IntKi), PARAMETER :: M9N2STAyi = 965 - INTEGER(IntKi), PARAMETER :: M9N3STAyi = 966 - INTEGER(IntKi), PARAMETER :: M9N4STAyi = 967 - INTEGER(IntKi), PARAMETER :: M9N5STAyi = 968 - INTEGER(IntKi), PARAMETER :: M9N6STAyi = 969 - INTEGER(IntKi), PARAMETER :: M9N7STAyi = 970 - INTEGER(IntKi), PARAMETER :: M9N8STAyi = 971 - INTEGER(IntKi), PARAMETER :: M9N9STAyi = 972 - INTEGER(IntKi), PARAMETER :: M1N1STAzi = 973 - INTEGER(IntKi), PARAMETER :: M1N2STAzi = 974 - INTEGER(IntKi), PARAMETER :: M1N3STAzi = 975 - INTEGER(IntKi), PARAMETER :: M1N4STAzi = 976 - INTEGER(IntKi), PARAMETER :: M1N5STAzi = 977 - INTEGER(IntKi), PARAMETER :: M1N6STAzi = 978 - INTEGER(IntKi), PARAMETER :: M1N7STAzi = 979 - INTEGER(IntKi), PARAMETER :: M1N8STAzi = 980 - INTEGER(IntKi), PARAMETER :: M1N9STAzi = 981 - INTEGER(IntKi), PARAMETER :: M2N1STAzi = 982 - INTEGER(IntKi), PARAMETER :: M2N2STAzi = 983 - INTEGER(IntKi), PARAMETER :: M2N3STAzi = 984 - INTEGER(IntKi), PARAMETER :: M2N4STAzi = 985 - INTEGER(IntKi), PARAMETER :: M2N5STAzi = 986 - INTEGER(IntKi), PARAMETER :: M2N6STAzi = 987 - INTEGER(IntKi), PARAMETER :: M2N7STAzi = 988 - INTEGER(IntKi), PARAMETER :: M2N8STAzi = 989 - INTEGER(IntKi), PARAMETER :: M2N9STAzi = 990 - INTEGER(IntKi), PARAMETER :: M3N1STAzi = 991 - INTEGER(IntKi), PARAMETER :: M3N2STAzi = 992 - INTEGER(IntKi), PARAMETER :: M3N3STAzi = 993 - INTEGER(IntKi), PARAMETER :: M3N4STAzi = 994 - INTEGER(IntKi), PARAMETER :: M3N5STAzi = 995 - INTEGER(IntKi), PARAMETER :: M3N6STAzi = 996 - INTEGER(IntKi), PARAMETER :: M3N7STAzi = 997 - INTEGER(IntKi), PARAMETER :: M3N8STAzi = 998 - INTEGER(IntKi), PARAMETER :: M3N9STAzi = 999 - INTEGER(IntKi), PARAMETER :: M4N1STAzi = 1000 - INTEGER(IntKi), PARAMETER :: M4N2STAzi = 1001 - INTEGER(IntKi), PARAMETER :: M4N3STAzi = 1002 - INTEGER(IntKi), PARAMETER :: M4N4STAzi = 1003 - INTEGER(IntKi), PARAMETER :: M4N5STAzi = 1004 - INTEGER(IntKi), PARAMETER :: M4N6STAzi = 1005 - INTEGER(IntKi), PARAMETER :: M4N7STAzi = 1006 - INTEGER(IntKi), PARAMETER :: M4N8STAzi = 1007 - INTEGER(IntKi), PARAMETER :: M4N9STAzi = 1008 - INTEGER(IntKi), PARAMETER :: M5N1STAzi = 1009 - INTEGER(IntKi), PARAMETER :: M5N2STAzi = 1010 - INTEGER(IntKi), PARAMETER :: M5N3STAzi = 1011 - INTEGER(IntKi), PARAMETER :: M5N4STAzi = 1012 - INTEGER(IntKi), PARAMETER :: M5N5STAzi = 1013 - INTEGER(IntKi), PARAMETER :: M5N6STAzi = 1014 - INTEGER(IntKi), PARAMETER :: M5N7STAzi = 1015 - INTEGER(IntKi), PARAMETER :: M5N8STAzi = 1016 - INTEGER(IntKi), PARAMETER :: M5N9STAzi = 1017 - INTEGER(IntKi), PARAMETER :: M6N1STAzi = 1018 - INTEGER(IntKi), PARAMETER :: M6N2STAzi = 1019 - INTEGER(IntKi), PARAMETER :: M6N3STAzi = 1020 - INTEGER(IntKi), PARAMETER :: M6N4STAzi = 1021 - INTEGER(IntKi), PARAMETER :: M6N5STAzi = 1022 - INTEGER(IntKi), PARAMETER :: M6N6STAzi = 1023 - INTEGER(IntKi), PARAMETER :: M6N7STAzi = 1024 - INTEGER(IntKi), PARAMETER :: M6N8STAzi = 1025 - INTEGER(IntKi), PARAMETER :: M6N9STAzi = 1026 - INTEGER(IntKi), PARAMETER :: M7N1STAzi = 1027 - INTEGER(IntKi), PARAMETER :: M7N2STAzi = 1028 - INTEGER(IntKi), PARAMETER :: M7N3STAzi = 1029 - INTEGER(IntKi), PARAMETER :: M7N4STAzi = 1030 - INTEGER(IntKi), PARAMETER :: M7N5STAzi = 1031 - INTEGER(IntKi), PARAMETER :: M7N6STAzi = 1032 - INTEGER(IntKi), PARAMETER :: M7N7STAzi = 1033 - INTEGER(IntKi), PARAMETER :: M7N8STAzi = 1034 - INTEGER(IntKi), PARAMETER :: M7N9STAzi = 1035 - INTEGER(IntKi), PARAMETER :: M8N1STAzi = 1036 - INTEGER(IntKi), PARAMETER :: M8N2STAzi = 1037 - INTEGER(IntKi), PARAMETER :: M8N3STAzi = 1038 - INTEGER(IntKi), PARAMETER :: M8N4STAzi = 1039 - INTEGER(IntKi), PARAMETER :: M8N5STAzi = 1040 - INTEGER(IntKi), PARAMETER :: M8N6STAzi = 1041 - INTEGER(IntKi), PARAMETER :: M8N7STAzi = 1042 - INTEGER(IntKi), PARAMETER :: M8N8STAzi = 1043 - INTEGER(IntKi), PARAMETER :: M8N9STAzi = 1044 - INTEGER(IntKi), PARAMETER :: M9N1STAzi = 1045 - INTEGER(IntKi), PARAMETER :: M9N2STAzi = 1046 - INTEGER(IntKi), PARAMETER :: M9N3STAzi = 1047 - INTEGER(IntKi), PARAMETER :: M9N4STAzi = 1048 - INTEGER(IntKi), PARAMETER :: M9N5STAzi = 1049 - INTEGER(IntKi), PARAMETER :: M9N6STAzi = 1050 - INTEGER(IntKi), PARAMETER :: M9N7STAzi = 1051 - INTEGER(IntKi), PARAMETER :: M9N8STAzi = 1052 - INTEGER(IntKi), PARAMETER :: M9N9STAzi = 1053 + INTEGER(IntKi), PARAMETER :: M1N1Axi = 1 + INTEGER(IntKi), PARAMETER :: M1N2Axi = 2 + INTEGER(IntKi), PARAMETER :: M1N3Axi = 3 + INTEGER(IntKi), PARAMETER :: M1N4Axi = 4 + INTEGER(IntKi), PARAMETER :: M1N5Axi = 5 + INTEGER(IntKi), PARAMETER :: M1N6Axi = 6 + INTEGER(IntKi), PARAMETER :: M1N7Axi = 7 + INTEGER(IntKi), PARAMETER :: M1N8Axi = 8 + INTEGER(IntKi), PARAMETER :: M1N9Axi = 9 + INTEGER(IntKi), PARAMETER :: M2N1Axi = 10 + INTEGER(IntKi), PARAMETER :: M2N2Axi = 11 + INTEGER(IntKi), PARAMETER :: M2N3Axi = 12 + INTEGER(IntKi), PARAMETER :: M2N4Axi = 13 + INTEGER(IntKi), PARAMETER :: M2N5Axi = 14 + INTEGER(IntKi), PARAMETER :: M2N6Axi = 15 + INTEGER(IntKi), PARAMETER :: M2N7Axi = 16 + INTEGER(IntKi), PARAMETER :: M2N8Axi = 17 + INTEGER(IntKi), PARAMETER :: M2N9Axi = 18 + INTEGER(IntKi), PARAMETER :: M3N1Axi = 19 + INTEGER(IntKi), PARAMETER :: M3N2Axi = 20 + INTEGER(IntKi), PARAMETER :: M3N3Axi = 21 + INTEGER(IntKi), PARAMETER :: M3N4Axi = 22 + INTEGER(IntKi), PARAMETER :: M3N5Axi = 23 + INTEGER(IntKi), PARAMETER :: M3N6Axi = 24 + INTEGER(IntKi), PARAMETER :: M3N7Axi = 25 + INTEGER(IntKi), PARAMETER :: M3N8Axi = 26 + INTEGER(IntKi), PARAMETER :: M3N9Axi = 27 + INTEGER(IntKi), PARAMETER :: M4N1Axi = 28 + INTEGER(IntKi), PARAMETER :: M4N2Axi = 29 + INTEGER(IntKi), PARAMETER :: M4N3Axi = 30 + INTEGER(IntKi), PARAMETER :: M4N4Axi = 31 + INTEGER(IntKi), PARAMETER :: M4N5Axi = 32 + INTEGER(IntKi), PARAMETER :: M4N6Axi = 33 + INTEGER(IntKi), PARAMETER :: M4N7Axi = 34 + INTEGER(IntKi), PARAMETER :: M4N8Axi = 35 + INTEGER(IntKi), PARAMETER :: M4N9Axi = 36 + INTEGER(IntKi), PARAMETER :: M5N1Axi = 37 + INTEGER(IntKi), PARAMETER :: M5N2Axi = 38 + INTEGER(IntKi), PARAMETER :: M5N3Axi = 39 + INTEGER(IntKi), PARAMETER :: M5N4Axi = 40 + INTEGER(IntKi), PARAMETER :: M5N5Axi = 41 + INTEGER(IntKi), PARAMETER :: M5N6Axi = 42 + INTEGER(IntKi), PARAMETER :: M5N7Axi = 43 + INTEGER(IntKi), PARAMETER :: M5N8Axi = 44 + INTEGER(IntKi), PARAMETER :: M5N9Axi = 45 + INTEGER(IntKi), PARAMETER :: M6N1Axi = 46 + INTEGER(IntKi), PARAMETER :: M6N2Axi = 47 + INTEGER(IntKi), PARAMETER :: M6N3Axi = 48 + INTEGER(IntKi), PARAMETER :: M6N4Axi = 49 + INTEGER(IntKi), PARAMETER :: M6N5Axi = 50 + INTEGER(IntKi), PARAMETER :: M6N6Axi = 51 + INTEGER(IntKi), PARAMETER :: M6N7Axi = 52 + INTEGER(IntKi), PARAMETER :: M6N8Axi = 53 + INTEGER(IntKi), PARAMETER :: M6N9Axi = 54 + INTEGER(IntKi), PARAMETER :: M7N1Axi = 55 + INTEGER(IntKi), PARAMETER :: M7N2Axi = 56 + INTEGER(IntKi), PARAMETER :: M7N3Axi = 57 + INTEGER(IntKi), PARAMETER :: M7N4Axi = 58 + INTEGER(IntKi), PARAMETER :: M7N5Axi = 59 + INTEGER(IntKi), PARAMETER :: M7N6Axi = 60 + INTEGER(IntKi), PARAMETER :: M7N7Axi = 61 + INTEGER(IntKi), PARAMETER :: M7N8Axi = 62 + INTEGER(IntKi), PARAMETER :: M7N9Axi = 63 + INTEGER(IntKi), PARAMETER :: M8N1Axi = 64 + INTEGER(IntKi), PARAMETER :: M8N2Axi = 65 + INTEGER(IntKi), PARAMETER :: M8N3Axi = 66 + INTEGER(IntKi), PARAMETER :: M8N4Axi = 67 + INTEGER(IntKi), PARAMETER :: M8N5Axi = 68 + INTEGER(IntKi), PARAMETER :: M8N6Axi = 69 + INTEGER(IntKi), PARAMETER :: M8N7Axi = 70 + INTEGER(IntKi), PARAMETER :: M8N8Axi = 71 + INTEGER(IntKi), PARAMETER :: M8N9Axi = 72 + INTEGER(IntKi), PARAMETER :: M9N1Axi = 73 + INTEGER(IntKi), PARAMETER :: M9N2Axi = 74 + INTEGER(IntKi), PARAMETER :: M9N3Axi = 75 + INTEGER(IntKi), PARAMETER :: M9N4Axi = 76 + INTEGER(IntKi), PARAMETER :: M9N5Axi = 77 + INTEGER(IntKi), PARAMETER :: M9N6Axi = 78 + INTEGER(IntKi), PARAMETER :: M9N7Axi = 79 + INTEGER(IntKi), PARAMETER :: M9N8Axi = 80 + INTEGER(IntKi), PARAMETER :: M9N9Axi = 81 + INTEGER(IntKi), PARAMETER :: M1N1Ayi = 82 + INTEGER(IntKi), PARAMETER :: M1N2Ayi = 83 + INTEGER(IntKi), PARAMETER :: M1N3Ayi = 84 + INTEGER(IntKi), PARAMETER :: M1N4Ayi = 85 + INTEGER(IntKi), PARAMETER :: M1N5Ayi = 86 + INTEGER(IntKi), PARAMETER :: M1N6Ayi = 87 + INTEGER(IntKi), PARAMETER :: M1N7Ayi = 88 + INTEGER(IntKi), PARAMETER :: M1N8Ayi = 89 + INTEGER(IntKi), PARAMETER :: M1N9Ayi = 90 + INTEGER(IntKi), PARAMETER :: M2N1Ayi = 91 + INTEGER(IntKi), PARAMETER :: M2N2Ayi = 92 + INTEGER(IntKi), PARAMETER :: M2N3Ayi = 93 + INTEGER(IntKi), PARAMETER :: M2N4Ayi = 94 + INTEGER(IntKi), PARAMETER :: M2N5Ayi = 95 + INTEGER(IntKi), PARAMETER :: M2N6Ayi = 96 + INTEGER(IntKi), PARAMETER :: M2N7Ayi = 97 + INTEGER(IntKi), PARAMETER :: M2N8Ayi = 98 + INTEGER(IntKi), PARAMETER :: M2N9Ayi = 99 + INTEGER(IntKi), PARAMETER :: M3N1Ayi = 100 + INTEGER(IntKi), PARAMETER :: M3N2Ayi = 101 + INTEGER(IntKi), PARAMETER :: M3N3Ayi = 102 + INTEGER(IntKi), PARAMETER :: M3N4Ayi = 103 + INTEGER(IntKi), PARAMETER :: M3N5Ayi = 104 + INTEGER(IntKi), PARAMETER :: M3N6Ayi = 105 + INTEGER(IntKi), PARAMETER :: M3N7Ayi = 106 + INTEGER(IntKi), PARAMETER :: M3N8Ayi = 107 + INTEGER(IntKi), PARAMETER :: M3N9Ayi = 108 + INTEGER(IntKi), PARAMETER :: M4N1Ayi = 109 + INTEGER(IntKi), PARAMETER :: M4N2Ayi = 110 + INTEGER(IntKi), PARAMETER :: M4N3Ayi = 111 + INTEGER(IntKi), PARAMETER :: M4N4Ayi = 112 + INTEGER(IntKi), PARAMETER :: M4N5Ayi = 113 + INTEGER(IntKi), PARAMETER :: M4N6Ayi = 114 + INTEGER(IntKi), PARAMETER :: M4N7Ayi = 115 + INTEGER(IntKi), PARAMETER :: M4N8Ayi = 116 + INTEGER(IntKi), PARAMETER :: M4N9Ayi = 117 + INTEGER(IntKi), PARAMETER :: M5N1Ayi = 118 + INTEGER(IntKi), PARAMETER :: M5N2Ayi = 119 + INTEGER(IntKi), PARAMETER :: M5N3Ayi = 120 + INTEGER(IntKi), PARAMETER :: M5N4Ayi = 121 + INTEGER(IntKi), PARAMETER :: M5N5Ayi = 122 + INTEGER(IntKi), PARAMETER :: M5N6Ayi = 123 + INTEGER(IntKi), PARAMETER :: M5N7Ayi = 124 + INTEGER(IntKi), PARAMETER :: M5N8Ayi = 125 + INTEGER(IntKi), PARAMETER :: M5N9Ayi = 126 + INTEGER(IntKi), PARAMETER :: M6N1Ayi = 127 + INTEGER(IntKi), PARAMETER :: M6N2Ayi = 128 + INTEGER(IntKi), PARAMETER :: M6N3Ayi = 129 + INTEGER(IntKi), PARAMETER :: M6N4Ayi = 130 + INTEGER(IntKi), PARAMETER :: M6N5Ayi = 131 + INTEGER(IntKi), PARAMETER :: M6N6Ayi = 132 + INTEGER(IntKi), PARAMETER :: M6N7Ayi = 133 + INTEGER(IntKi), PARAMETER :: M6N8Ayi = 134 + INTEGER(IntKi), PARAMETER :: M6N9Ayi = 135 + INTEGER(IntKi), PARAMETER :: M7N1Ayi = 136 + INTEGER(IntKi), PARAMETER :: M7N2Ayi = 137 + INTEGER(IntKi), PARAMETER :: M7N3Ayi = 138 + INTEGER(IntKi), PARAMETER :: M7N4Ayi = 139 + INTEGER(IntKi), PARAMETER :: M7N5Ayi = 140 + INTEGER(IntKi), PARAMETER :: M7N6Ayi = 141 + INTEGER(IntKi), PARAMETER :: M7N7Ayi = 142 + INTEGER(IntKi), PARAMETER :: M7N8Ayi = 143 + INTEGER(IntKi), PARAMETER :: M7N9Ayi = 144 + INTEGER(IntKi), PARAMETER :: M8N1Ayi = 145 + INTEGER(IntKi), PARAMETER :: M8N2Ayi = 146 + INTEGER(IntKi), PARAMETER :: M8N3Ayi = 147 + INTEGER(IntKi), PARAMETER :: M8N4Ayi = 148 + INTEGER(IntKi), PARAMETER :: M8N5Ayi = 149 + INTEGER(IntKi), PARAMETER :: M8N6Ayi = 150 + INTEGER(IntKi), PARAMETER :: M8N7Ayi = 151 + INTEGER(IntKi), PARAMETER :: M8N8Ayi = 152 + INTEGER(IntKi), PARAMETER :: M8N9Ayi = 153 + INTEGER(IntKi), PARAMETER :: M9N1Ayi = 154 + INTEGER(IntKi), PARAMETER :: M9N2Ayi = 155 + INTEGER(IntKi), PARAMETER :: M9N3Ayi = 156 + INTEGER(IntKi), PARAMETER :: M9N4Ayi = 157 + INTEGER(IntKi), PARAMETER :: M9N5Ayi = 158 + INTEGER(IntKi), PARAMETER :: M9N6Ayi = 159 + INTEGER(IntKi), PARAMETER :: M9N7Ayi = 160 + INTEGER(IntKi), PARAMETER :: M9N8Ayi = 161 + INTEGER(IntKi), PARAMETER :: M9N9Ayi = 162 + INTEGER(IntKi), PARAMETER :: M1N1Azi = 163 + INTEGER(IntKi), PARAMETER :: M1N2Azi = 164 + INTEGER(IntKi), PARAMETER :: M1N3Azi = 165 + INTEGER(IntKi), PARAMETER :: M1N4Azi = 166 + INTEGER(IntKi), PARAMETER :: M1N5Azi = 167 + INTEGER(IntKi), PARAMETER :: M1N6Azi = 168 + INTEGER(IntKi), PARAMETER :: M1N7Azi = 169 + INTEGER(IntKi), PARAMETER :: M1N8Azi = 170 + INTEGER(IntKi), PARAMETER :: M1N9Azi = 171 + INTEGER(IntKi), PARAMETER :: M2N1Azi = 172 + INTEGER(IntKi), PARAMETER :: M2N2Azi = 173 + INTEGER(IntKi), PARAMETER :: M2N3Azi = 174 + INTEGER(IntKi), PARAMETER :: M2N4Azi = 175 + INTEGER(IntKi), PARAMETER :: M2N5Azi = 176 + INTEGER(IntKi), PARAMETER :: M2N6Azi = 177 + INTEGER(IntKi), PARAMETER :: M2N7Azi = 178 + INTEGER(IntKi), PARAMETER :: M2N8Azi = 179 + INTEGER(IntKi), PARAMETER :: M2N9Azi = 180 + INTEGER(IntKi), PARAMETER :: M3N1Azi = 181 + INTEGER(IntKi), PARAMETER :: M3N2Azi = 182 + INTEGER(IntKi), PARAMETER :: M3N3Azi = 183 + INTEGER(IntKi), PARAMETER :: M3N4Azi = 184 + INTEGER(IntKi), PARAMETER :: M3N5Azi = 185 + INTEGER(IntKi), PARAMETER :: M3N6Azi = 186 + INTEGER(IntKi), PARAMETER :: M3N7Azi = 187 + INTEGER(IntKi), PARAMETER :: M3N8Azi = 188 + INTEGER(IntKi), PARAMETER :: M3N9Azi = 189 + INTEGER(IntKi), PARAMETER :: M4N1Azi = 190 + INTEGER(IntKi), PARAMETER :: M4N2Azi = 191 + INTEGER(IntKi), PARAMETER :: M4N3Azi = 192 + INTEGER(IntKi), PARAMETER :: M4N4Azi = 193 + INTEGER(IntKi), PARAMETER :: M4N5Azi = 194 + INTEGER(IntKi), PARAMETER :: M4N6Azi = 195 + INTEGER(IntKi), PARAMETER :: M4N7Azi = 196 + INTEGER(IntKi), PARAMETER :: M4N8Azi = 197 + INTEGER(IntKi), PARAMETER :: M4N9Azi = 198 + INTEGER(IntKi), PARAMETER :: M5N1Azi = 199 + INTEGER(IntKi), PARAMETER :: M5N2Azi = 200 + INTEGER(IntKi), PARAMETER :: M5N3Azi = 201 + INTEGER(IntKi), PARAMETER :: M5N4Azi = 202 + INTEGER(IntKi), PARAMETER :: M5N5Azi = 203 + INTEGER(IntKi), PARAMETER :: M5N6Azi = 204 + INTEGER(IntKi), PARAMETER :: M5N7Azi = 205 + INTEGER(IntKi), PARAMETER :: M5N8Azi = 206 + INTEGER(IntKi), PARAMETER :: M5N9Azi = 207 + INTEGER(IntKi), PARAMETER :: M6N1Azi = 208 + INTEGER(IntKi), PARAMETER :: M6N2Azi = 209 + INTEGER(IntKi), PARAMETER :: M6N3Azi = 210 + INTEGER(IntKi), PARAMETER :: M6N4Azi = 211 + INTEGER(IntKi), PARAMETER :: M6N5Azi = 212 + INTEGER(IntKi), PARAMETER :: M6N6Azi = 213 + INTEGER(IntKi), PARAMETER :: M6N7Azi = 214 + INTEGER(IntKi), PARAMETER :: M6N8Azi = 215 + INTEGER(IntKi), PARAMETER :: M6N9Azi = 216 + INTEGER(IntKi), PARAMETER :: M7N1Azi = 217 + INTEGER(IntKi), PARAMETER :: M7N2Azi = 218 + INTEGER(IntKi), PARAMETER :: M7N3Azi = 219 + INTEGER(IntKi), PARAMETER :: M7N4Azi = 220 + INTEGER(IntKi), PARAMETER :: M7N5Azi = 221 + INTEGER(IntKi), PARAMETER :: M7N6Azi = 222 + INTEGER(IntKi), PARAMETER :: M7N7Azi = 223 + INTEGER(IntKi), PARAMETER :: M7N8Azi = 224 + INTEGER(IntKi), PARAMETER :: M7N9Azi = 225 + INTEGER(IntKi), PARAMETER :: M8N1Azi = 226 + INTEGER(IntKi), PARAMETER :: M8N2Azi = 227 + INTEGER(IntKi), PARAMETER :: M8N3Azi = 228 + INTEGER(IntKi), PARAMETER :: M8N4Azi = 229 + INTEGER(IntKi), PARAMETER :: M8N5Azi = 230 + INTEGER(IntKi), PARAMETER :: M8N6Azi = 231 + INTEGER(IntKi), PARAMETER :: M8N7Azi = 232 + INTEGER(IntKi), PARAMETER :: M8N8Azi = 233 + INTEGER(IntKi), PARAMETER :: M8N9Azi = 234 + INTEGER(IntKi), PARAMETER :: M9N1Azi = 235 + INTEGER(IntKi), PARAMETER :: M9N2Azi = 236 + INTEGER(IntKi), PARAMETER :: M9N3Azi = 237 + INTEGER(IntKi), PARAMETER :: M9N4Azi = 238 + INTEGER(IntKi), PARAMETER :: M9N5Azi = 239 + INTEGER(IntKi), PARAMETER :: M9N6Azi = 240 + INTEGER(IntKi), PARAMETER :: M9N7Azi = 241 + INTEGER(IntKi), PARAMETER :: M9N8Azi = 242 + INTEGER(IntKi), PARAMETER :: M9N9Azi = 243 + INTEGER(IntKi), PARAMETER :: M1N1Vxi = 244 + INTEGER(IntKi), PARAMETER :: M1N2Vxi = 245 + INTEGER(IntKi), PARAMETER :: M1N3Vxi = 246 + INTEGER(IntKi), PARAMETER :: M1N4Vxi = 247 + INTEGER(IntKi), PARAMETER :: M1N5Vxi = 248 + INTEGER(IntKi), PARAMETER :: M1N6Vxi = 249 + INTEGER(IntKi), PARAMETER :: M1N7Vxi = 250 + INTEGER(IntKi), PARAMETER :: M1N8Vxi = 251 + INTEGER(IntKi), PARAMETER :: M1N9Vxi = 252 + INTEGER(IntKi), PARAMETER :: M2N1Vxi = 253 + INTEGER(IntKi), PARAMETER :: M2N2Vxi = 254 + INTEGER(IntKi), PARAMETER :: M2N3Vxi = 255 + INTEGER(IntKi), PARAMETER :: M2N4Vxi = 256 + INTEGER(IntKi), PARAMETER :: M2N5Vxi = 257 + INTEGER(IntKi), PARAMETER :: M2N6Vxi = 258 + INTEGER(IntKi), PARAMETER :: M2N7Vxi = 259 + INTEGER(IntKi), PARAMETER :: M2N8Vxi = 260 + INTEGER(IntKi), PARAMETER :: M2N9Vxi = 261 + INTEGER(IntKi), PARAMETER :: M3N1Vxi = 262 + INTEGER(IntKi), PARAMETER :: M3N2Vxi = 263 + INTEGER(IntKi), PARAMETER :: M3N3Vxi = 264 + INTEGER(IntKi), PARAMETER :: M3N4Vxi = 265 + INTEGER(IntKi), PARAMETER :: M3N5Vxi = 266 + INTEGER(IntKi), PARAMETER :: M3N6Vxi = 267 + INTEGER(IntKi), PARAMETER :: M3N7Vxi = 268 + INTEGER(IntKi), PARAMETER :: M3N8Vxi = 269 + INTEGER(IntKi), PARAMETER :: M3N9Vxi = 270 + INTEGER(IntKi), PARAMETER :: M4N1Vxi = 271 + INTEGER(IntKi), PARAMETER :: M4N2Vxi = 272 + INTEGER(IntKi), PARAMETER :: M4N3Vxi = 273 + INTEGER(IntKi), PARAMETER :: M4N4Vxi = 274 + INTEGER(IntKi), PARAMETER :: M4N5Vxi = 275 + INTEGER(IntKi), PARAMETER :: M4N6Vxi = 276 + INTEGER(IntKi), PARAMETER :: M4N7Vxi = 277 + INTEGER(IntKi), PARAMETER :: M4N8Vxi = 278 + INTEGER(IntKi), PARAMETER :: M4N9Vxi = 279 + INTEGER(IntKi), PARAMETER :: M5N1Vxi = 280 + INTEGER(IntKi), PARAMETER :: M5N2Vxi = 281 + INTEGER(IntKi), PARAMETER :: M5N3Vxi = 282 + INTEGER(IntKi), PARAMETER :: M5N4Vxi = 283 + INTEGER(IntKi), PARAMETER :: M5N5Vxi = 284 + INTEGER(IntKi), PARAMETER :: M5N6Vxi = 285 + INTEGER(IntKi), PARAMETER :: M5N7Vxi = 286 + INTEGER(IntKi), PARAMETER :: M5N8Vxi = 287 + INTEGER(IntKi), PARAMETER :: M5N9Vxi = 288 + INTEGER(IntKi), PARAMETER :: M6N1Vxi = 289 + INTEGER(IntKi), PARAMETER :: M6N2Vxi = 290 + INTEGER(IntKi), PARAMETER :: M6N3Vxi = 291 + INTEGER(IntKi), PARAMETER :: M6N4Vxi = 292 + INTEGER(IntKi), PARAMETER :: M6N5Vxi = 293 + INTEGER(IntKi), PARAMETER :: M6N6Vxi = 294 + INTEGER(IntKi), PARAMETER :: M6N7Vxi = 295 + INTEGER(IntKi), PARAMETER :: M6N8Vxi = 296 + INTEGER(IntKi), PARAMETER :: M6N9Vxi = 297 + INTEGER(IntKi), PARAMETER :: M7N1Vxi = 298 + INTEGER(IntKi), PARAMETER :: M7N2Vxi = 299 + INTEGER(IntKi), PARAMETER :: M7N3Vxi = 300 + INTEGER(IntKi), PARAMETER :: M7N4Vxi = 301 + INTEGER(IntKi), PARAMETER :: M7N5Vxi = 302 + INTEGER(IntKi), PARAMETER :: M7N6Vxi = 303 + INTEGER(IntKi), PARAMETER :: M7N7Vxi = 304 + INTEGER(IntKi), PARAMETER :: M7N8Vxi = 305 + INTEGER(IntKi), PARAMETER :: M7N9Vxi = 306 + INTEGER(IntKi), PARAMETER :: M8N1Vxi = 307 + INTEGER(IntKi), PARAMETER :: M8N2Vxi = 308 + INTEGER(IntKi), PARAMETER :: M8N3Vxi = 309 + INTEGER(IntKi), PARAMETER :: M8N4Vxi = 310 + INTEGER(IntKi), PARAMETER :: M8N5Vxi = 311 + INTEGER(IntKi), PARAMETER :: M8N6Vxi = 312 + INTEGER(IntKi), PARAMETER :: M8N7Vxi = 313 + INTEGER(IntKi), PARAMETER :: M8N8Vxi = 314 + INTEGER(IntKi), PARAMETER :: M8N9Vxi = 315 + INTEGER(IntKi), PARAMETER :: M9N1Vxi = 316 + INTEGER(IntKi), PARAMETER :: M9N2Vxi = 317 + INTEGER(IntKi), PARAMETER :: M9N3Vxi = 318 + INTEGER(IntKi), PARAMETER :: M9N4Vxi = 319 + INTEGER(IntKi), PARAMETER :: M9N5Vxi = 320 + INTEGER(IntKi), PARAMETER :: M9N6Vxi = 321 + INTEGER(IntKi), PARAMETER :: M9N7Vxi = 322 + INTEGER(IntKi), PARAMETER :: M9N8Vxi = 323 + INTEGER(IntKi), PARAMETER :: M9N9Vxi = 324 + INTEGER(IntKi), PARAMETER :: M1N1Vyi = 325 + INTEGER(IntKi), PARAMETER :: M1N2Vyi = 326 + INTEGER(IntKi), PARAMETER :: M1N3Vyi = 327 + INTEGER(IntKi), PARAMETER :: M1N4Vyi = 328 + INTEGER(IntKi), PARAMETER :: M1N5Vyi = 329 + INTEGER(IntKi), PARAMETER :: M1N6Vyi = 330 + INTEGER(IntKi), PARAMETER :: M1N7Vyi = 331 + INTEGER(IntKi), PARAMETER :: M1N8Vyi = 332 + INTEGER(IntKi), PARAMETER :: M1N9Vyi = 333 + INTEGER(IntKi), PARAMETER :: M2N1Vyi = 334 + INTEGER(IntKi), PARAMETER :: M2N2Vyi = 335 + INTEGER(IntKi), PARAMETER :: M2N3Vyi = 336 + INTEGER(IntKi), PARAMETER :: M2N4Vyi = 337 + INTEGER(IntKi), PARAMETER :: M2N5Vyi = 338 + INTEGER(IntKi), PARAMETER :: M2N6Vyi = 339 + INTEGER(IntKi), PARAMETER :: M2N7Vyi = 340 + INTEGER(IntKi), PARAMETER :: M2N8Vyi = 341 + INTEGER(IntKi), PARAMETER :: M2N9Vyi = 342 + INTEGER(IntKi), PARAMETER :: M3N1Vyi = 343 + INTEGER(IntKi), PARAMETER :: M3N2Vyi = 344 + INTEGER(IntKi), PARAMETER :: M3N3Vyi = 345 + INTEGER(IntKi), PARAMETER :: M3N4Vyi = 346 + INTEGER(IntKi), PARAMETER :: M3N5Vyi = 347 + INTEGER(IntKi), PARAMETER :: M3N6Vyi = 348 + INTEGER(IntKi), PARAMETER :: M3N7Vyi = 349 + INTEGER(IntKi), PARAMETER :: M3N8Vyi = 350 + INTEGER(IntKi), PARAMETER :: M3N9Vyi = 351 + INTEGER(IntKi), PARAMETER :: M4N1Vyi = 352 + INTEGER(IntKi), PARAMETER :: M4N2Vyi = 353 + INTEGER(IntKi), PARAMETER :: M4N3Vyi = 354 + INTEGER(IntKi), PARAMETER :: M4N4Vyi = 355 + INTEGER(IntKi), PARAMETER :: M4N5Vyi = 356 + INTEGER(IntKi), PARAMETER :: M4N6Vyi = 357 + INTEGER(IntKi), PARAMETER :: M4N7Vyi = 358 + INTEGER(IntKi), PARAMETER :: M4N8Vyi = 359 + INTEGER(IntKi), PARAMETER :: M4N9Vyi = 360 + INTEGER(IntKi), PARAMETER :: M5N1Vyi = 361 + INTEGER(IntKi), PARAMETER :: M5N2Vyi = 362 + INTEGER(IntKi), PARAMETER :: M5N3Vyi = 363 + INTEGER(IntKi), PARAMETER :: M5N4Vyi = 364 + INTEGER(IntKi), PARAMETER :: M5N5Vyi = 365 + INTEGER(IntKi), PARAMETER :: M5N6Vyi = 366 + INTEGER(IntKi), PARAMETER :: M5N7Vyi = 367 + INTEGER(IntKi), PARAMETER :: M5N8Vyi = 368 + INTEGER(IntKi), PARAMETER :: M5N9Vyi = 369 + INTEGER(IntKi), PARAMETER :: M6N1Vyi = 370 + INTEGER(IntKi), PARAMETER :: M6N2Vyi = 371 + INTEGER(IntKi), PARAMETER :: M6N3Vyi = 372 + INTEGER(IntKi), PARAMETER :: M6N4Vyi = 373 + INTEGER(IntKi), PARAMETER :: M6N5Vyi = 374 + INTEGER(IntKi), PARAMETER :: M6N6Vyi = 375 + INTEGER(IntKi), PARAMETER :: M6N7Vyi = 376 + INTEGER(IntKi), PARAMETER :: M6N8Vyi = 377 + INTEGER(IntKi), PARAMETER :: M6N9Vyi = 378 + INTEGER(IntKi), PARAMETER :: M7N1Vyi = 379 + INTEGER(IntKi), PARAMETER :: M7N2Vyi = 380 + INTEGER(IntKi), PARAMETER :: M7N3Vyi = 381 + INTEGER(IntKi), PARAMETER :: M7N4Vyi = 382 + INTEGER(IntKi), PARAMETER :: M7N5Vyi = 383 + INTEGER(IntKi), PARAMETER :: M7N6Vyi = 384 + INTEGER(IntKi), PARAMETER :: M7N7Vyi = 385 + INTEGER(IntKi), PARAMETER :: M7N8Vyi = 386 + INTEGER(IntKi), PARAMETER :: M7N9Vyi = 387 + INTEGER(IntKi), PARAMETER :: M8N1Vyi = 388 + INTEGER(IntKi), PARAMETER :: M8N2Vyi = 389 + INTEGER(IntKi), PARAMETER :: M8N3Vyi = 390 + INTEGER(IntKi), PARAMETER :: M8N4Vyi = 391 + INTEGER(IntKi), PARAMETER :: M8N5Vyi = 392 + INTEGER(IntKi), PARAMETER :: M8N6Vyi = 393 + INTEGER(IntKi), PARAMETER :: M8N7Vyi = 394 + INTEGER(IntKi), PARAMETER :: M8N8Vyi = 395 + INTEGER(IntKi), PARAMETER :: M8N9Vyi = 396 + INTEGER(IntKi), PARAMETER :: M9N1Vyi = 397 + INTEGER(IntKi), PARAMETER :: M9N2Vyi = 398 + INTEGER(IntKi), PARAMETER :: M9N3Vyi = 399 + INTEGER(IntKi), PARAMETER :: M9N4Vyi = 400 + INTEGER(IntKi), PARAMETER :: M9N5Vyi = 401 + INTEGER(IntKi), PARAMETER :: M9N6Vyi = 402 + INTEGER(IntKi), PARAMETER :: M9N7Vyi = 403 + INTEGER(IntKi), PARAMETER :: M9N8Vyi = 404 + INTEGER(IntKi), PARAMETER :: M9N9Vyi = 405 + INTEGER(IntKi), PARAMETER :: M1N1Vzi = 406 + INTEGER(IntKi), PARAMETER :: M1N2Vzi = 407 + INTEGER(IntKi), PARAMETER :: M1N3Vzi = 408 + INTEGER(IntKi), PARAMETER :: M1N4Vzi = 409 + INTEGER(IntKi), PARAMETER :: M1N5Vzi = 410 + INTEGER(IntKi), PARAMETER :: M1N6Vzi = 411 + INTEGER(IntKi), PARAMETER :: M1N7Vzi = 412 + INTEGER(IntKi), PARAMETER :: M1N8Vzi = 413 + INTEGER(IntKi), PARAMETER :: M1N9Vzi = 414 + INTEGER(IntKi), PARAMETER :: M2N1Vzi = 415 + INTEGER(IntKi), PARAMETER :: M2N2Vzi = 416 + INTEGER(IntKi), PARAMETER :: M2N3Vzi = 417 + INTEGER(IntKi), PARAMETER :: M2N4Vzi = 418 + INTEGER(IntKi), PARAMETER :: M2N5Vzi = 419 + INTEGER(IntKi), PARAMETER :: M2N6Vzi = 420 + INTEGER(IntKi), PARAMETER :: M2N7Vzi = 421 + INTEGER(IntKi), PARAMETER :: M2N8Vzi = 422 + INTEGER(IntKi), PARAMETER :: M2N9Vzi = 423 + INTEGER(IntKi), PARAMETER :: M3N1Vzi = 424 + INTEGER(IntKi), PARAMETER :: M3N2Vzi = 425 + INTEGER(IntKi), PARAMETER :: M3N3Vzi = 426 + INTEGER(IntKi), PARAMETER :: M3N4Vzi = 427 + INTEGER(IntKi), PARAMETER :: M3N5Vzi = 428 + INTEGER(IntKi), PARAMETER :: M3N6Vzi = 429 + INTEGER(IntKi), PARAMETER :: M3N7Vzi = 430 + INTEGER(IntKi), PARAMETER :: M3N8Vzi = 431 + INTEGER(IntKi), PARAMETER :: M3N9Vzi = 432 + INTEGER(IntKi), PARAMETER :: M4N1Vzi = 433 + INTEGER(IntKi), PARAMETER :: M4N2Vzi = 434 + INTEGER(IntKi), PARAMETER :: M4N3Vzi = 435 + INTEGER(IntKi), PARAMETER :: M4N4Vzi = 436 + INTEGER(IntKi), PARAMETER :: M4N5Vzi = 437 + INTEGER(IntKi), PARAMETER :: M4N6Vzi = 438 + INTEGER(IntKi), PARAMETER :: M4N7Vzi = 439 + INTEGER(IntKi), PARAMETER :: M4N8Vzi = 440 + INTEGER(IntKi), PARAMETER :: M4N9Vzi = 441 + INTEGER(IntKi), PARAMETER :: M5N1Vzi = 442 + INTEGER(IntKi), PARAMETER :: M5N2Vzi = 443 + INTEGER(IntKi), PARAMETER :: M5N3Vzi = 444 + INTEGER(IntKi), PARAMETER :: M5N4Vzi = 445 + INTEGER(IntKi), PARAMETER :: M5N5Vzi = 446 + INTEGER(IntKi), PARAMETER :: M5N6Vzi = 447 + INTEGER(IntKi), PARAMETER :: M5N7Vzi = 448 + INTEGER(IntKi), PARAMETER :: M5N8Vzi = 449 + INTEGER(IntKi), PARAMETER :: M5N9Vzi = 450 + INTEGER(IntKi), PARAMETER :: M6N1Vzi = 451 + INTEGER(IntKi), PARAMETER :: M6N2Vzi = 452 + INTEGER(IntKi), PARAMETER :: M6N3Vzi = 453 + INTEGER(IntKi), PARAMETER :: M6N4Vzi = 454 + INTEGER(IntKi), PARAMETER :: M6N5Vzi = 455 + INTEGER(IntKi), PARAMETER :: M6N6Vzi = 456 + INTEGER(IntKi), PARAMETER :: M6N7Vzi = 457 + INTEGER(IntKi), PARAMETER :: M6N8Vzi = 458 + INTEGER(IntKi), PARAMETER :: M6N9Vzi = 459 + INTEGER(IntKi), PARAMETER :: M7N1Vzi = 460 + INTEGER(IntKi), PARAMETER :: M7N2Vzi = 461 + INTEGER(IntKi), PARAMETER :: M7N3Vzi = 462 + INTEGER(IntKi), PARAMETER :: M7N4Vzi = 463 + INTEGER(IntKi), PARAMETER :: M7N5Vzi = 464 + INTEGER(IntKi), PARAMETER :: M7N6Vzi = 465 + INTEGER(IntKi), PARAMETER :: M7N7Vzi = 466 + INTEGER(IntKi), PARAMETER :: M7N8Vzi = 467 + INTEGER(IntKi), PARAMETER :: M7N9Vzi = 468 + INTEGER(IntKi), PARAMETER :: M8N1Vzi = 469 + INTEGER(IntKi), PARAMETER :: M8N2Vzi = 470 + INTEGER(IntKi), PARAMETER :: M8N3Vzi = 471 + INTEGER(IntKi), PARAMETER :: M8N4Vzi = 472 + INTEGER(IntKi), PARAMETER :: M8N5Vzi = 473 + INTEGER(IntKi), PARAMETER :: M8N6Vzi = 474 + INTEGER(IntKi), PARAMETER :: M8N7Vzi = 475 + INTEGER(IntKi), PARAMETER :: M8N8Vzi = 476 + INTEGER(IntKi), PARAMETER :: M8N9Vzi = 477 + INTEGER(IntKi), PARAMETER :: M9N1Vzi = 478 + INTEGER(IntKi), PARAMETER :: M9N2Vzi = 479 + INTEGER(IntKi), PARAMETER :: M9N3Vzi = 480 + INTEGER(IntKi), PARAMETER :: M9N4Vzi = 481 + INTEGER(IntKi), PARAMETER :: M9N5Vzi = 482 + INTEGER(IntKi), PARAMETER :: M9N6Vzi = 483 + INTEGER(IntKi), PARAMETER :: M9N7Vzi = 484 + INTEGER(IntKi), PARAMETER :: M9N8Vzi = 485 + INTEGER(IntKi), PARAMETER :: M9N9Vzi = 486 + INTEGER(IntKi), PARAMETER :: M1N1DynP = 487 + INTEGER(IntKi), PARAMETER :: M1N2DynP = 488 + INTEGER(IntKi), PARAMETER :: M1N3DynP = 489 + INTEGER(IntKi), PARAMETER :: M1N4DynP = 490 + INTEGER(IntKi), PARAMETER :: M1N5DynP = 491 + INTEGER(IntKi), PARAMETER :: M1N6DynP = 492 + INTEGER(IntKi), PARAMETER :: M1N7DynP = 493 + INTEGER(IntKi), PARAMETER :: M1N8DynP = 494 + INTEGER(IntKi), PARAMETER :: M1N9DynP = 495 + INTEGER(IntKi), PARAMETER :: M2N1DynP = 496 + INTEGER(IntKi), PARAMETER :: M2N2DynP = 497 + INTEGER(IntKi), PARAMETER :: M2N3DynP = 498 + INTEGER(IntKi), PARAMETER :: M2N4DynP = 499 + INTEGER(IntKi), PARAMETER :: M2N5DynP = 500 + INTEGER(IntKi), PARAMETER :: M2N6DynP = 501 + INTEGER(IntKi), PARAMETER :: M2N7DynP = 502 + INTEGER(IntKi), PARAMETER :: M2N8DynP = 503 + INTEGER(IntKi), PARAMETER :: M2N9DynP = 504 + INTEGER(IntKi), PARAMETER :: M3N1DynP = 505 + INTEGER(IntKi), PARAMETER :: M3N2DynP = 506 + INTEGER(IntKi), PARAMETER :: M3N3DynP = 507 + INTEGER(IntKi), PARAMETER :: M3N4DynP = 508 + INTEGER(IntKi), PARAMETER :: M3N5DynP = 509 + INTEGER(IntKi), PARAMETER :: M3N6DynP = 510 + INTEGER(IntKi), PARAMETER :: M3N7DynP = 511 + INTEGER(IntKi), PARAMETER :: M3N8DynP = 512 + INTEGER(IntKi), PARAMETER :: M3N9DynP = 513 + INTEGER(IntKi), PARAMETER :: M4N1DynP = 514 + INTEGER(IntKi), PARAMETER :: M4N2DynP = 515 + INTEGER(IntKi), PARAMETER :: M4N3DynP = 516 + INTEGER(IntKi), PARAMETER :: M4N4DynP = 517 + INTEGER(IntKi), PARAMETER :: M4N5DynP = 518 + INTEGER(IntKi), PARAMETER :: M4N6DynP = 519 + INTEGER(IntKi), PARAMETER :: M4N7DynP = 520 + INTEGER(IntKi), PARAMETER :: M4N8DynP = 521 + INTEGER(IntKi), PARAMETER :: M4N9DynP = 522 + INTEGER(IntKi), PARAMETER :: M5N1DynP = 523 + INTEGER(IntKi), PARAMETER :: M5N2DynP = 524 + INTEGER(IntKi), PARAMETER :: M5N3DynP = 525 + INTEGER(IntKi), PARAMETER :: M5N4DynP = 526 + INTEGER(IntKi), PARAMETER :: M5N5DynP = 527 + INTEGER(IntKi), PARAMETER :: M5N6DynP = 528 + INTEGER(IntKi), PARAMETER :: M5N7DynP = 529 + INTEGER(IntKi), PARAMETER :: M5N8DynP = 530 + INTEGER(IntKi), PARAMETER :: M5N9DynP = 531 + INTEGER(IntKi), PARAMETER :: M6N1DynP = 532 + INTEGER(IntKi), PARAMETER :: M6N2DynP = 533 + INTEGER(IntKi), PARAMETER :: M6N3DynP = 534 + INTEGER(IntKi), PARAMETER :: M6N4DynP = 535 + INTEGER(IntKi), PARAMETER :: M6N5DynP = 536 + INTEGER(IntKi), PARAMETER :: M6N6DynP = 537 + INTEGER(IntKi), PARAMETER :: M6N7DynP = 538 + INTEGER(IntKi), PARAMETER :: M6N8DynP = 539 + INTEGER(IntKi), PARAMETER :: M6N9DynP = 540 + INTEGER(IntKi), PARAMETER :: M7N1DynP = 541 + INTEGER(IntKi), PARAMETER :: M7N2DynP = 542 + INTEGER(IntKi), PARAMETER :: M7N3DynP = 543 + INTEGER(IntKi), PARAMETER :: M7N4DynP = 544 + INTEGER(IntKi), PARAMETER :: M7N5DynP = 545 + INTEGER(IntKi), PARAMETER :: M7N6DynP = 546 + INTEGER(IntKi), PARAMETER :: M7N7DynP = 547 + INTEGER(IntKi), PARAMETER :: M7N8DynP = 548 + INTEGER(IntKi), PARAMETER :: M7N9DynP = 549 + INTEGER(IntKi), PARAMETER :: M8N1DynP = 550 + INTEGER(IntKi), PARAMETER :: M8N2DynP = 551 + INTEGER(IntKi), PARAMETER :: M8N3DynP = 552 + INTEGER(IntKi), PARAMETER :: M8N4DynP = 553 + INTEGER(IntKi), PARAMETER :: M8N5DynP = 554 + INTEGER(IntKi), PARAMETER :: M8N6DynP = 555 + INTEGER(IntKi), PARAMETER :: M8N7DynP = 556 + INTEGER(IntKi), PARAMETER :: M8N8DynP = 557 + INTEGER(IntKi), PARAMETER :: M8N9DynP = 558 + INTEGER(IntKi), PARAMETER :: M9N1DynP = 559 + INTEGER(IntKi), PARAMETER :: M9N2DynP = 560 + INTEGER(IntKi), PARAMETER :: M9N3DynP = 561 + INTEGER(IntKi), PARAMETER :: M9N4DynP = 562 + INTEGER(IntKi), PARAMETER :: M9N5DynP = 563 + INTEGER(IntKi), PARAMETER :: M9N6DynP = 564 + INTEGER(IntKi), PARAMETER :: M9N7DynP = 565 + INTEGER(IntKi), PARAMETER :: M9N8DynP = 566 + INTEGER(IntKi), PARAMETER :: M9N9DynP = 567 + INTEGER(IntKi), PARAMETER :: M1N1STVxi = 568 + INTEGER(IntKi), PARAMETER :: M1N2STVxi = 569 + INTEGER(IntKi), PARAMETER :: M1N3STVxi = 570 + INTEGER(IntKi), PARAMETER :: M1N4STVxi = 571 + INTEGER(IntKi), PARAMETER :: M1N5STVxi = 572 + INTEGER(IntKi), PARAMETER :: M1N6STVxi = 573 + INTEGER(IntKi), PARAMETER :: M1N7STVxi = 574 + INTEGER(IntKi), PARAMETER :: M1N8STVxi = 575 + INTEGER(IntKi), PARAMETER :: M1N9STVxi = 576 + INTEGER(IntKi), PARAMETER :: M2N1STVxi = 577 + INTEGER(IntKi), PARAMETER :: M2N2STVxi = 578 + INTEGER(IntKi), PARAMETER :: M2N3STVxi = 579 + INTEGER(IntKi), PARAMETER :: M2N4STVxi = 580 + INTEGER(IntKi), PARAMETER :: M2N5STVxi = 581 + INTEGER(IntKi), PARAMETER :: M2N6STVxi = 582 + INTEGER(IntKi), PARAMETER :: M2N7STVxi = 583 + INTEGER(IntKi), PARAMETER :: M2N8STVxi = 584 + INTEGER(IntKi), PARAMETER :: M2N9STVxi = 585 + INTEGER(IntKi), PARAMETER :: M3N1STVxi = 586 + INTEGER(IntKi), PARAMETER :: M3N2STVxi = 587 + INTEGER(IntKi), PARAMETER :: M3N3STVxi = 588 + INTEGER(IntKi), PARAMETER :: M3N4STVxi = 589 + INTEGER(IntKi), PARAMETER :: M3N5STVxi = 590 + INTEGER(IntKi), PARAMETER :: M3N6STVxi = 591 + INTEGER(IntKi), PARAMETER :: M3N7STVxi = 592 + INTEGER(IntKi), PARAMETER :: M3N8STVxi = 593 + INTEGER(IntKi), PARAMETER :: M3N9STVxi = 594 + INTEGER(IntKi), PARAMETER :: M4N1STVxi = 595 + INTEGER(IntKi), PARAMETER :: M4N2STVxi = 596 + INTEGER(IntKi), PARAMETER :: M4N3STVxi = 597 + INTEGER(IntKi), PARAMETER :: M4N4STVxi = 598 + INTEGER(IntKi), PARAMETER :: M4N5STVxi = 599 + INTEGER(IntKi), PARAMETER :: M4N6STVxi = 600 + INTEGER(IntKi), PARAMETER :: M4N7STVxi = 601 + INTEGER(IntKi), PARAMETER :: M4N8STVxi = 602 + INTEGER(IntKi), PARAMETER :: M4N9STVxi = 603 + INTEGER(IntKi), PARAMETER :: M5N1STVxi = 604 + INTEGER(IntKi), PARAMETER :: M5N2STVxi = 605 + INTEGER(IntKi), PARAMETER :: M5N3STVxi = 606 + INTEGER(IntKi), PARAMETER :: M5N4STVxi = 607 + INTEGER(IntKi), PARAMETER :: M5N5STVxi = 608 + INTEGER(IntKi), PARAMETER :: M5N6STVxi = 609 + INTEGER(IntKi), PARAMETER :: M5N7STVxi = 610 + INTEGER(IntKi), PARAMETER :: M5N8STVxi = 611 + INTEGER(IntKi), PARAMETER :: M5N9STVxi = 612 + INTEGER(IntKi), PARAMETER :: M6N1STVxi = 613 + INTEGER(IntKi), PARAMETER :: M6N2STVxi = 614 + INTEGER(IntKi), PARAMETER :: M6N3STVxi = 615 + INTEGER(IntKi), PARAMETER :: M6N4STVxi = 616 + INTEGER(IntKi), PARAMETER :: M6N5STVxi = 617 + INTEGER(IntKi), PARAMETER :: M6N6STVxi = 618 + INTEGER(IntKi), PARAMETER :: M6N7STVxi = 619 + INTEGER(IntKi), PARAMETER :: M6N8STVxi = 620 + INTEGER(IntKi), PARAMETER :: M6N9STVxi = 621 + INTEGER(IntKi), PARAMETER :: M7N1STVxi = 622 + INTEGER(IntKi), PARAMETER :: M7N2STVxi = 623 + INTEGER(IntKi), PARAMETER :: M7N3STVxi = 624 + INTEGER(IntKi), PARAMETER :: M7N4STVxi = 625 + INTEGER(IntKi), PARAMETER :: M7N5STVxi = 626 + INTEGER(IntKi), PARAMETER :: M7N6STVxi = 627 + INTEGER(IntKi), PARAMETER :: M7N7STVxi = 628 + INTEGER(IntKi), PARAMETER :: M7N8STVxi = 629 + INTEGER(IntKi), PARAMETER :: M7N9STVxi = 630 + INTEGER(IntKi), PARAMETER :: M8N1STVxi = 631 + INTEGER(IntKi), PARAMETER :: M8N2STVxi = 632 + INTEGER(IntKi), PARAMETER :: M8N3STVxi = 633 + INTEGER(IntKi), PARAMETER :: M8N4STVxi = 634 + INTEGER(IntKi), PARAMETER :: M8N5STVxi = 635 + INTEGER(IntKi), PARAMETER :: M8N6STVxi = 636 + INTEGER(IntKi), PARAMETER :: M8N7STVxi = 637 + INTEGER(IntKi), PARAMETER :: M8N8STVxi = 638 + INTEGER(IntKi), PARAMETER :: M8N9STVxi = 639 + INTEGER(IntKi), PARAMETER :: M9N1STVxi = 640 + INTEGER(IntKi), PARAMETER :: M9N2STVxi = 641 + INTEGER(IntKi), PARAMETER :: M9N3STVxi = 642 + INTEGER(IntKi), PARAMETER :: M9N4STVxi = 643 + INTEGER(IntKi), PARAMETER :: M9N5STVxi = 644 + INTEGER(IntKi), PARAMETER :: M9N6STVxi = 645 + INTEGER(IntKi), PARAMETER :: M9N7STVxi = 646 + INTEGER(IntKi), PARAMETER :: M9N8STVxi = 647 + INTEGER(IntKi), PARAMETER :: M9N9STVxi = 648 + INTEGER(IntKi), PARAMETER :: M1N1STVyi = 649 + INTEGER(IntKi), PARAMETER :: M1N2STVyi = 650 + INTEGER(IntKi), PARAMETER :: M1N3STVyi = 651 + INTEGER(IntKi), PARAMETER :: M1N4STVyi = 652 + INTEGER(IntKi), PARAMETER :: M1N5STVyi = 653 + INTEGER(IntKi), PARAMETER :: M1N6STVyi = 654 + INTEGER(IntKi), PARAMETER :: M1N7STVyi = 655 + INTEGER(IntKi), PARAMETER :: M1N8STVyi = 656 + INTEGER(IntKi), PARAMETER :: M1N9STVyi = 657 + INTEGER(IntKi), PARAMETER :: M2N1STVyi = 658 + INTEGER(IntKi), PARAMETER :: M2N2STVyi = 659 + INTEGER(IntKi), PARAMETER :: M2N3STVyi = 660 + INTEGER(IntKi), PARAMETER :: M2N4STVyi = 661 + INTEGER(IntKi), PARAMETER :: M2N5STVyi = 662 + INTEGER(IntKi), PARAMETER :: M2N6STVyi = 663 + INTEGER(IntKi), PARAMETER :: M2N7STVyi = 664 + INTEGER(IntKi), PARAMETER :: M2N8STVyi = 665 + INTEGER(IntKi), PARAMETER :: M2N9STVyi = 666 + INTEGER(IntKi), PARAMETER :: M3N1STVyi = 667 + INTEGER(IntKi), PARAMETER :: M3N2STVyi = 668 + INTEGER(IntKi), PARAMETER :: M3N3STVyi = 669 + INTEGER(IntKi), PARAMETER :: M3N4STVyi = 670 + INTEGER(IntKi), PARAMETER :: M3N5STVyi = 671 + INTEGER(IntKi), PARAMETER :: M3N6STVyi = 672 + INTEGER(IntKi), PARAMETER :: M3N7STVyi = 673 + INTEGER(IntKi), PARAMETER :: M3N8STVyi = 674 + INTEGER(IntKi), PARAMETER :: M3N9STVyi = 675 + INTEGER(IntKi), PARAMETER :: M4N1STVyi = 676 + INTEGER(IntKi), PARAMETER :: M4N2STVyi = 677 + INTEGER(IntKi), PARAMETER :: M4N3STVyi = 678 + INTEGER(IntKi), PARAMETER :: M4N4STVyi = 679 + INTEGER(IntKi), PARAMETER :: M4N5STVyi = 680 + INTEGER(IntKi), PARAMETER :: M4N6STVyi = 681 + INTEGER(IntKi), PARAMETER :: M4N7STVyi = 682 + INTEGER(IntKi), PARAMETER :: M4N8STVyi = 683 + INTEGER(IntKi), PARAMETER :: M4N9STVyi = 684 + INTEGER(IntKi), PARAMETER :: M5N1STVyi = 685 + INTEGER(IntKi), PARAMETER :: M5N2STVyi = 686 + INTEGER(IntKi), PARAMETER :: M5N3STVyi = 687 + INTEGER(IntKi), PARAMETER :: M5N4STVyi = 688 + INTEGER(IntKi), PARAMETER :: M5N5STVyi = 689 + INTEGER(IntKi), PARAMETER :: M5N6STVyi = 690 + INTEGER(IntKi), PARAMETER :: M5N7STVyi = 691 + INTEGER(IntKi), PARAMETER :: M5N8STVyi = 692 + INTEGER(IntKi), PARAMETER :: M5N9STVyi = 693 + INTEGER(IntKi), PARAMETER :: M6N1STVyi = 694 + INTEGER(IntKi), PARAMETER :: M6N2STVyi = 695 + INTEGER(IntKi), PARAMETER :: M6N3STVyi = 696 + INTEGER(IntKi), PARAMETER :: M6N4STVyi = 697 + INTEGER(IntKi), PARAMETER :: M6N5STVyi = 698 + INTEGER(IntKi), PARAMETER :: M6N6STVyi = 699 + INTEGER(IntKi), PARAMETER :: M6N7STVyi = 700 + INTEGER(IntKi), PARAMETER :: M6N8STVyi = 701 + INTEGER(IntKi), PARAMETER :: M6N9STVyi = 702 + INTEGER(IntKi), PARAMETER :: M7N1STVyi = 703 + INTEGER(IntKi), PARAMETER :: M7N2STVyi = 704 + INTEGER(IntKi), PARAMETER :: M7N3STVyi = 705 + INTEGER(IntKi), PARAMETER :: M7N4STVyi = 706 + INTEGER(IntKi), PARAMETER :: M7N5STVyi = 707 + INTEGER(IntKi), PARAMETER :: M7N6STVyi = 708 + INTEGER(IntKi), PARAMETER :: M7N7STVyi = 709 + INTEGER(IntKi), PARAMETER :: M7N8STVyi = 710 + INTEGER(IntKi), PARAMETER :: M7N9STVyi = 711 + INTEGER(IntKi), PARAMETER :: M8N1STVyi = 712 + INTEGER(IntKi), PARAMETER :: M8N2STVyi = 713 + INTEGER(IntKi), PARAMETER :: M8N3STVyi = 714 + INTEGER(IntKi), PARAMETER :: M8N4STVyi = 715 + INTEGER(IntKi), PARAMETER :: M8N5STVyi = 716 + INTEGER(IntKi), PARAMETER :: M8N6STVyi = 717 + INTEGER(IntKi), PARAMETER :: M8N7STVyi = 718 + INTEGER(IntKi), PARAMETER :: M8N8STVyi = 719 + INTEGER(IntKi), PARAMETER :: M8N9STVyi = 720 + INTEGER(IntKi), PARAMETER :: M9N1STVyi = 721 + INTEGER(IntKi), PARAMETER :: M9N2STVyi = 722 + INTEGER(IntKi), PARAMETER :: M9N3STVyi = 723 + INTEGER(IntKi), PARAMETER :: M9N4STVyi = 724 + INTEGER(IntKi), PARAMETER :: M9N5STVyi = 725 + INTEGER(IntKi), PARAMETER :: M9N6STVyi = 726 + INTEGER(IntKi), PARAMETER :: M9N7STVyi = 727 + INTEGER(IntKi), PARAMETER :: M9N8STVyi = 728 + INTEGER(IntKi), PARAMETER :: M9N9STVyi = 729 + INTEGER(IntKi), PARAMETER :: M1N1STVzi = 730 + INTEGER(IntKi), PARAMETER :: M1N2STVzi = 731 + INTEGER(IntKi), PARAMETER :: M1N3STVzi = 732 + INTEGER(IntKi), PARAMETER :: M1N4STVzi = 733 + INTEGER(IntKi), PARAMETER :: M1N5STVzi = 734 + INTEGER(IntKi), PARAMETER :: M1N6STVzi = 735 + INTEGER(IntKi), PARAMETER :: M1N7STVzi = 736 + INTEGER(IntKi), PARAMETER :: M1N8STVzi = 737 + INTEGER(IntKi), PARAMETER :: M1N9STVzi = 738 + INTEGER(IntKi), PARAMETER :: M2N1STVzi = 739 + INTEGER(IntKi), PARAMETER :: M2N2STVzi = 740 + INTEGER(IntKi), PARAMETER :: M2N3STVzi = 741 + INTEGER(IntKi), PARAMETER :: M2N4STVzi = 742 + INTEGER(IntKi), PARAMETER :: M2N5STVzi = 743 + INTEGER(IntKi), PARAMETER :: M2N6STVzi = 744 + INTEGER(IntKi), PARAMETER :: M2N7STVzi = 745 + INTEGER(IntKi), PARAMETER :: M2N8STVzi = 746 + INTEGER(IntKi), PARAMETER :: M2N9STVzi = 747 + INTEGER(IntKi), PARAMETER :: M3N1STVzi = 748 + INTEGER(IntKi), PARAMETER :: M3N2STVzi = 749 + INTEGER(IntKi), PARAMETER :: M3N3STVzi = 750 + INTEGER(IntKi), PARAMETER :: M3N4STVzi = 751 + INTEGER(IntKi), PARAMETER :: M3N5STVzi = 752 + INTEGER(IntKi), PARAMETER :: M3N6STVzi = 753 + INTEGER(IntKi), PARAMETER :: M3N7STVzi = 754 + INTEGER(IntKi), PARAMETER :: M3N8STVzi = 755 + INTEGER(IntKi), PARAMETER :: M3N9STVzi = 756 + INTEGER(IntKi), PARAMETER :: M4N1STVzi = 757 + INTEGER(IntKi), PARAMETER :: M4N2STVzi = 758 + INTEGER(IntKi), PARAMETER :: M4N3STVzi = 759 + INTEGER(IntKi), PARAMETER :: M4N4STVzi = 760 + INTEGER(IntKi), PARAMETER :: M4N5STVzi = 761 + INTEGER(IntKi), PARAMETER :: M4N6STVzi = 762 + INTEGER(IntKi), PARAMETER :: M4N7STVzi = 763 + INTEGER(IntKi), PARAMETER :: M4N8STVzi = 764 + INTEGER(IntKi), PARAMETER :: M4N9STVzi = 765 + INTEGER(IntKi), PARAMETER :: M5N1STVzi = 766 + INTEGER(IntKi), PARAMETER :: M5N2STVzi = 767 + INTEGER(IntKi), PARAMETER :: M5N3STVzi = 768 + INTEGER(IntKi), PARAMETER :: M5N4STVzi = 769 + INTEGER(IntKi), PARAMETER :: M5N5STVzi = 770 + INTEGER(IntKi), PARAMETER :: M5N6STVzi = 771 + INTEGER(IntKi), PARAMETER :: M5N7STVzi = 772 + INTEGER(IntKi), PARAMETER :: M5N8STVzi = 773 + INTEGER(IntKi), PARAMETER :: M5N9STVzi = 774 + INTEGER(IntKi), PARAMETER :: M6N1STVzi = 775 + INTEGER(IntKi), PARAMETER :: M6N2STVzi = 776 + INTEGER(IntKi), PARAMETER :: M6N3STVzi = 777 + INTEGER(IntKi), PARAMETER :: M6N4STVzi = 778 + INTEGER(IntKi), PARAMETER :: M6N5STVzi = 779 + INTEGER(IntKi), PARAMETER :: M6N6STVzi = 780 + INTEGER(IntKi), PARAMETER :: M6N7STVzi = 781 + INTEGER(IntKi), PARAMETER :: M6N8STVzi = 782 + INTEGER(IntKi), PARAMETER :: M6N9STVzi = 783 + INTEGER(IntKi), PARAMETER :: M7N1STVzi = 784 + INTEGER(IntKi), PARAMETER :: M7N2STVzi = 785 + INTEGER(IntKi), PARAMETER :: M7N3STVzi = 786 + INTEGER(IntKi), PARAMETER :: M7N4STVzi = 787 + INTEGER(IntKi), PARAMETER :: M7N5STVzi = 788 + INTEGER(IntKi), PARAMETER :: M7N6STVzi = 789 + INTEGER(IntKi), PARAMETER :: M7N7STVzi = 790 + INTEGER(IntKi), PARAMETER :: M7N8STVzi = 791 + INTEGER(IntKi), PARAMETER :: M7N9STVzi = 792 + INTEGER(IntKi), PARAMETER :: M8N1STVzi = 793 + INTEGER(IntKi), PARAMETER :: M8N2STVzi = 794 + INTEGER(IntKi), PARAMETER :: M8N3STVzi = 795 + INTEGER(IntKi), PARAMETER :: M8N4STVzi = 796 + INTEGER(IntKi), PARAMETER :: M8N5STVzi = 797 + INTEGER(IntKi), PARAMETER :: M8N6STVzi = 798 + INTEGER(IntKi), PARAMETER :: M8N7STVzi = 799 + INTEGER(IntKi), PARAMETER :: M8N8STVzi = 800 + INTEGER(IntKi), PARAMETER :: M8N9STVzi = 801 + INTEGER(IntKi), PARAMETER :: M9N1STVzi = 802 + INTEGER(IntKi), PARAMETER :: M9N2STVzi = 803 + INTEGER(IntKi), PARAMETER :: M9N3STVzi = 804 + INTEGER(IntKi), PARAMETER :: M9N4STVzi = 805 + INTEGER(IntKi), PARAMETER :: M9N5STVzi = 806 + INTEGER(IntKi), PARAMETER :: M9N6STVzi = 807 + INTEGER(IntKi), PARAMETER :: M9N7STVzi = 808 + INTEGER(IntKi), PARAMETER :: M9N8STVzi = 809 + INTEGER(IntKi), PARAMETER :: M9N9STVzi = 810 + INTEGER(IntKi), PARAMETER :: M1N1STAxi = 811 + INTEGER(IntKi), PARAMETER :: M1N2STAxi = 812 + INTEGER(IntKi), PARAMETER :: M1N3STAxi = 813 + INTEGER(IntKi), PARAMETER :: M1N4STAxi = 814 + INTEGER(IntKi), PARAMETER :: M1N5STAxi = 815 + INTEGER(IntKi), PARAMETER :: M1N6STAxi = 816 + INTEGER(IntKi), PARAMETER :: M1N7STAxi = 817 + INTEGER(IntKi), PARAMETER :: M1N8STAxi = 818 + INTEGER(IntKi), PARAMETER :: M1N9STAxi = 819 + INTEGER(IntKi), PARAMETER :: M2N1STAxi = 820 + INTEGER(IntKi), PARAMETER :: M2N2STAxi = 821 + INTEGER(IntKi), PARAMETER :: M2N3STAxi = 822 + INTEGER(IntKi), PARAMETER :: M2N4STAxi = 823 + INTEGER(IntKi), PARAMETER :: M2N5STAxi = 824 + INTEGER(IntKi), PARAMETER :: M2N6STAxi = 825 + INTEGER(IntKi), PARAMETER :: M2N7STAxi = 826 + INTEGER(IntKi), PARAMETER :: M2N8STAxi = 827 + INTEGER(IntKi), PARAMETER :: M2N9STAxi = 828 + INTEGER(IntKi), PARAMETER :: M3N1STAxi = 829 + INTEGER(IntKi), PARAMETER :: M3N2STAxi = 830 + INTEGER(IntKi), PARAMETER :: M3N3STAxi = 831 + INTEGER(IntKi), PARAMETER :: M3N4STAxi = 832 + INTEGER(IntKi), PARAMETER :: M3N5STAxi = 833 + INTEGER(IntKi), PARAMETER :: M3N6STAxi = 834 + INTEGER(IntKi), PARAMETER :: M3N7STAxi = 835 + INTEGER(IntKi), PARAMETER :: M3N8STAxi = 836 + INTEGER(IntKi), PARAMETER :: M3N9STAxi = 837 + INTEGER(IntKi), PARAMETER :: M4N1STAxi = 838 + INTEGER(IntKi), PARAMETER :: M4N2STAxi = 839 + INTEGER(IntKi), PARAMETER :: M4N3STAxi = 840 + INTEGER(IntKi), PARAMETER :: M4N4STAxi = 841 + INTEGER(IntKi), PARAMETER :: M4N5STAxi = 842 + INTEGER(IntKi), PARAMETER :: M4N6STAxi = 843 + INTEGER(IntKi), PARAMETER :: M4N7STAxi = 844 + INTEGER(IntKi), PARAMETER :: M4N8STAxi = 845 + INTEGER(IntKi), PARAMETER :: M4N9STAxi = 846 + INTEGER(IntKi), PARAMETER :: M5N1STAxi = 847 + INTEGER(IntKi), PARAMETER :: M5N2STAxi = 848 + INTEGER(IntKi), PARAMETER :: M5N3STAxi = 849 + INTEGER(IntKi), PARAMETER :: M5N4STAxi = 850 + INTEGER(IntKi), PARAMETER :: M5N5STAxi = 851 + INTEGER(IntKi), PARAMETER :: M5N6STAxi = 852 + INTEGER(IntKi), PARAMETER :: M5N7STAxi = 853 + INTEGER(IntKi), PARAMETER :: M5N8STAxi = 854 + INTEGER(IntKi), PARAMETER :: M5N9STAxi = 855 + INTEGER(IntKi), PARAMETER :: M6N1STAxi = 856 + INTEGER(IntKi), PARAMETER :: M6N2STAxi = 857 + INTEGER(IntKi), PARAMETER :: M6N3STAxi = 858 + INTEGER(IntKi), PARAMETER :: M6N4STAxi = 859 + INTEGER(IntKi), PARAMETER :: M6N5STAxi = 860 + INTEGER(IntKi), PARAMETER :: M6N6STAxi = 861 + INTEGER(IntKi), PARAMETER :: M6N7STAxi = 862 + INTEGER(IntKi), PARAMETER :: M6N8STAxi = 863 + INTEGER(IntKi), PARAMETER :: M6N9STAxi = 864 + INTEGER(IntKi), PARAMETER :: M7N1STAxi = 865 + INTEGER(IntKi), PARAMETER :: M7N2STAxi = 866 + INTEGER(IntKi), PARAMETER :: M7N3STAxi = 867 + INTEGER(IntKi), PARAMETER :: M7N4STAxi = 868 + INTEGER(IntKi), PARAMETER :: M7N5STAxi = 869 + INTEGER(IntKi), PARAMETER :: M7N6STAxi = 870 + INTEGER(IntKi), PARAMETER :: M7N7STAxi = 871 + INTEGER(IntKi), PARAMETER :: M7N8STAxi = 872 + INTEGER(IntKi), PARAMETER :: M7N9STAxi = 873 + INTEGER(IntKi), PARAMETER :: M8N1STAxi = 874 + INTEGER(IntKi), PARAMETER :: M8N2STAxi = 875 + INTEGER(IntKi), PARAMETER :: M8N3STAxi = 876 + INTEGER(IntKi), PARAMETER :: M8N4STAxi = 877 + INTEGER(IntKi), PARAMETER :: M8N5STAxi = 878 + INTEGER(IntKi), PARAMETER :: M8N6STAxi = 879 + INTEGER(IntKi), PARAMETER :: M8N7STAxi = 880 + INTEGER(IntKi), PARAMETER :: M8N8STAxi = 881 + INTEGER(IntKi), PARAMETER :: M8N9STAxi = 882 + INTEGER(IntKi), PARAMETER :: M9N1STAxi = 883 + INTEGER(IntKi), PARAMETER :: M9N2STAxi = 884 + INTEGER(IntKi), PARAMETER :: M9N3STAxi = 885 + INTEGER(IntKi), PARAMETER :: M9N4STAxi = 886 + INTEGER(IntKi), PARAMETER :: M9N5STAxi = 887 + INTEGER(IntKi), PARAMETER :: M9N6STAxi = 888 + INTEGER(IntKi), PARAMETER :: M9N7STAxi = 889 + INTEGER(IntKi), PARAMETER :: M9N8STAxi = 890 + INTEGER(IntKi), PARAMETER :: M9N9STAxi = 891 + INTEGER(IntKi), PARAMETER :: M1N1STAyi = 892 + INTEGER(IntKi), PARAMETER :: M1N2STAyi = 893 + INTEGER(IntKi), PARAMETER :: M1N3STAyi = 894 + INTEGER(IntKi), PARAMETER :: M1N4STAyi = 895 + INTEGER(IntKi), PARAMETER :: M1N5STAyi = 896 + INTEGER(IntKi), PARAMETER :: M1N6STAyi = 897 + INTEGER(IntKi), PARAMETER :: M1N7STAyi = 898 + INTEGER(IntKi), PARAMETER :: M1N8STAyi = 899 + INTEGER(IntKi), PARAMETER :: M1N9STAyi = 900 + INTEGER(IntKi), PARAMETER :: M2N1STAyi = 901 + INTEGER(IntKi), PARAMETER :: M2N2STAyi = 902 + INTEGER(IntKi), PARAMETER :: M2N3STAyi = 903 + INTEGER(IntKi), PARAMETER :: M2N4STAyi = 904 + INTEGER(IntKi), PARAMETER :: M2N5STAyi = 905 + INTEGER(IntKi), PARAMETER :: M2N6STAyi = 906 + INTEGER(IntKi), PARAMETER :: M2N7STAyi = 907 + INTEGER(IntKi), PARAMETER :: M2N8STAyi = 908 + INTEGER(IntKi), PARAMETER :: M2N9STAyi = 909 + INTEGER(IntKi), PARAMETER :: M3N1STAyi = 910 + INTEGER(IntKi), PARAMETER :: M3N2STAyi = 911 + INTEGER(IntKi), PARAMETER :: M3N3STAyi = 912 + INTEGER(IntKi), PARAMETER :: M3N4STAyi = 913 + INTEGER(IntKi), PARAMETER :: M3N5STAyi = 914 + INTEGER(IntKi), PARAMETER :: M3N6STAyi = 915 + INTEGER(IntKi), PARAMETER :: M3N7STAyi = 916 + INTEGER(IntKi), PARAMETER :: M3N8STAyi = 917 + INTEGER(IntKi), PARAMETER :: M3N9STAyi = 918 + INTEGER(IntKi), PARAMETER :: M4N1STAyi = 919 + INTEGER(IntKi), PARAMETER :: M4N2STAyi = 920 + INTEGER(IntKi), PARAMETER :: M4N3STAyi = 921 + INTEGER(IntKi), PARAMETER :: M4N4STAyi = 922 + INTEGER(IntKi), PARAMETER :: M4N5STAyi = 923 + INTEGER(IntKi), PARAMETER :: M4N6STAyi = 924 + INTEGER(IntKi), PARAMETER :: M4N7STAyi = 925 + INTEGER(IntKi), PARAMETER :: M4N8STAyi = 926 + INTEGER(IntKi), PARAMETER :: M4N9STAyi = 927 + INTEGER(IntKi), PARAMETER :: M5N1STAyi = 928 + INTEGER(IntKi), PARAMETER :: M5N2STAyi = 929 + INTEGER(IntKi), PARAMETER :: M5N3STAyi = 930 + INTEGER(IntKi), PARAMETER :: M5N4STAyi = 931 + INTEGER(IntKi), PARAMETER :: M5N5STAyi = 932 + INTEGER(IntKi), PARAMETER :: M5N6STAyi = 933 + INTEGER(IntKi), PARAMETER :: M5N7STAyi = 934 + INTEGER(IntKi), PARAMETER :: M5N8STAyi = 935 + INTEGER(IntKi), PARAMETER :: M5N9STAyi = 936 + INTEGER(IntKi), PARAMETER :: M6N1STAyi = 937 + INTEGER(IntKi), PARAMETER :: M6N2STAyi = 938 + INTEGER(IntKi), PARAMETER :: M6N3STAyi = 939 + INTEGER(IntKi), PARAMETER :: M6N4STAyi = 940 + INTEGER(IntKi), PARAMETER :: M6N5STAyi = 941 + INTEGER(IntKi), PARAMETER :: M6N6STAyi = 942 + INTEGER(IntKi), PARAMETER :: M6N7STAyi = 943 + INTEGER(IntKi), PARAMETER :: M6N8STAyi = 944 + INTEGER(IntKi), PARAMETER :: M6N9STAyi = 945 + INTEGER(IntKi), PARAMETER :: M7N1STAyi = 946 + INTEGER(IntKi), PARAMETER :: M7N2STAyi = 947 + INTEGER(IntKi), PARAMETER :: M7N3STAyi = 948 + INTEGER(IntKi), PARAMETER :: M7N4STAyi = 949 + INTEGER(IntKi), PARAMETER :: M7N5STAyi = 950 + INTEGER(IntKi), PARAMETER :: M7N6STAyi = 951 + INTEGER(IntKi), PARAMETER :: M7N7STAyi = 952 + INTEGER(IntKi), PARAMETER :: M7N8STAyi = 953 + INTEGER(IntKi), PARAMETER :: M7N9STAyi = 954 + INTEGER(IntKi), PARAMETER :: M8N1STAyi = 955 + INTEGER(IntKi), PARAMETER :: M8N2STAyi = 956 + INTEGER(IntKi), PARAMETER :: M8N3STAyi = 957 + INTEGER(IntKi), PARAMETER :: M8N4STAyi = 958 + INTEGER(IntKi), PARAMETER :: M8N5STAyi = 959 + INTEGER(IntKi), PARAMETER :: M8N6STAyi = 960 + INTEGER(IntKi), PARAMETER :: M8N7STAyi = 961 + INTEGER(IntKi), PARAMETER :: M8N8STAyi = 962 + INTEGER(IntKi), PARAMETER :: M8N9STAyi = 963 + INTEGER(IntKi), PARAMETER :: M9N1STAyi = 964 + INTEGER(IntKi), PARAMETER :: M9N2STAyi = 965 + INTEGER(IntKi), PARAMETER :: M9N3STAyi = 966 + INTEGER(IntKi), PARAMETER :: M9N4STAyi = 967 + INTEGER(IntKi), PARAMETER :: M9N5STAyi = 968 + INTEGER(IntKi), PARAMETER :: M9N6STAyi = 969 + INTEGER(IntKi), PARAMETER :: M9N7STAyi = 970 + INTEGER(IntKi), PARAMETER :: M9N8STAyi = 971 + INTEGER(IntKi), PARAMETER :: M9N9STAyi = 972 + INTEGER(IntKi), PARAMETER :: M1N1STAzi = 973 + INTEGER(IntKi), PARAMETER :: M1N2STAzi = 974 + INTEGER(IntKi), PARAMETER :: M1N3STAzi = 975 + INTEGER(IntKi), PARAMETER :: M1N4STAzi = 976 + INTEGER(IntKi), PARAMETER :: M1N5STAzi = 977 + INTEGER(IntKi), PARAMETER :: M1N6STAzi = 978 + INTEGER(IntKi), PARAMETER :: M1N7STAzi = 979 + INTEGER(IntKi), PARAMETER :: M1N8STAzi = 980 + INTEGER(IntKi), PARAMETER :: M1N9STAzi = 981 + INTEGER(IntKi), PARAMETER :: M2N1STAzi = 982 + INTEGER(IntKi), PARAMETER :: M2N2STAzi = 983 + INTEGER(IntKi), PARAMETER :: M2N3STAzi = 984 + INTEGER(IntKi), PARAMETER :: M2N4STAzi = 985 + INTEGER(IntKi), PARAMETER :: M2N5STAzi = 986 + INTEGER(IntKi), PARAMETER :: M2N6STAzi = 987 + INTEGER(IntKi), PARAMETER :: M2N7STAzi = 988 + INTEGER(IntKi), PARAMETER :: M2N8STAzi = 989 + INTEGER(IntKi), PARAMETER :: M2N9STAzi = 990 + INTEGER(IntKi), PARAMETER :: M3N1STAzi = 991 + INTEGER(IntKi), PARAMETER :: M3N2STAzi = 992 + INTEGER(IntKi), PARAMETER :: M3N3STAzi = 993 + INTEGER(IntKi), PARAMETER :: M3N4STAzi = 994 + INTEGER(IntKi), PARAMETER :: M3N5STAzi = 995 + INTEGER(IntKi), PARAMETER :: M3N6STAzi = 996 + INTEGER(IntKi), PARAMETER :: M3N7STAzi = 997 + INTEGER(IntKi), PARAMETER :: M3N8STAzi = 998 + INTEGER(IntKi), PARAMETER :: M3N9STAzi = 999 + INTEGER(IntKi), PARAMETER :: M4N1STAzi = 1000 + INTEGER(IntKi), PARAMETER :: M4N2STAzi = 1001 + INTEGER(IntKi), PARAMETER :: M4N3STAzi = 1002 + INTEGER(IntKi), PARAMETER :: M4N4STAzi = 1003 + INTEGER(IntKi), PARAMETER :: M4N5STAzi = 1004 + INTEGER(IntKi), PARAMETER :: M4N6STAzi = 1005 + INTEGER(IntKi), PARAMETER :: M4N7STAzi = 1006 + INTEGER(IntKi), PARAMETER :: M4N8STAzi = 1007 + INTEGER(IntKi), PARAMETER :: M4N9STAzi = 1008 + INTEGER(IntKi), PARAMETER :: M5N1STAzi = 1009 + INTEGER(IntKi), PARAMETER :: M5N2STAzi = 1010 + INTEGER(IntKi), PARAMETER :: M5N3STAzi = 1011 + INTEGER(IntKi), PARAMETER :: M5N4STAzi = 1012 + INTEGER(IntKi), PARAMETER :: M5N5STAzi = 1013 + INTEGER(IntKi), PARAMETER :: M5N6STAzi = 1014 + INTEGER(IntKi), PARAMETER :: M5N7STAzi = 1015 + INTEGER(IntKi), PARAMETER :: M5N8STAzi = 1016 + INTEGER(IntKi), PARAMETER :: M5N9STAzi = 1017 + INTEGER(IntKi), PARAMETER :: M6N1STAzi = 1018 + INTEGER(IntKi), PARAMETER :: M6N2STAzi = 1019 + INTEGER(IntKi), PARAMETER :: M6N3STAzi = 1020 + INTEGER(IntKi), PARAMETER :: M6N4STAzi = 1021 + INTEGER(IntKi), PARAMETER :: M6N5STAzi = 1022 + INTEGER(IntKi), PARAMETER :: M6N6STAzi = 1023 + INTEGER(IntKi), PARAMETER :: M6N7STAzi = 1024 + INTEGER(IntKi), PARAMETER :: M6N8STAzi = 1025 + INTEGER(IntKi), PARAMETER :: M6N9STAzi = 1026 + INTEGER(IntKi), PARAMETER :: M7N1STAzi = 1027 + INTEGER(IntKi), PARAMETER :: M7N2STAzi = 1028 + INTEGER(IntKi), PARAMETER :: M7N3STAzi = 1029 + INTEGER(IntKi), PARAMETER :: M7N4STAzi = 1030 + INTEGER(IntKi), PARAMETER :: M7N5STAzi = 1031 + INTEGER(IntKi), PARAMETER :: M7N6STAzi = 1032 + INTEGER(IntKi), PARAMETER :: M7N7STAzi = 1033 + INTEGER(IntKi), PARAMETER :: M7N8STAzi = 1034 + INTEGER(IntKi), PARAMETER :: M7N9STAzi = 1035 + INTEGER(IntKi), PARAMETER :: M8N1STAzi = 1036 + INTEGER(IntKi), PARAMETER :: M8N2STAzi = 1037 + INTEGER(IntKi), PARAMETER :: M8N3STAzi = 1038 + INTEGER(IntKi), PARAMETER :: M8N4STAzi = 1039 + INTEGER(IntKi), PARAMETER :: M8N5STAzi = 1040 + INTEGER(IntKi), PARAMETER :: M8N6STAzi = 1041 + INTEGER(IntKi), PARAMETER :: M8N7STAzi = 1042 + INTEGER(IntKi), PARAMETER :: M8N8STAzi = 1043 + INTEGER(IntKi), PARAMETER :: M8N9STAzi = 1044 + INTEGER(IntKi), PARAMETER :: M9N1STAzi = 1045 + INTEGER(IntKi), PARAMETER :: M9N2STAzi = 1046 + INTEGER(IntKi), PARAMETER :: M9N3STAzi = 1047 + INTEGER(IntKi), PARAMETER :: M9N4STAzi = 1048 + INTEGER(IntKi), PARAMETER :: M9N5STAzi = 1049 + INTEGER(IntKi), PARAMETER :: M9N6STAzi = 1050 + INTEGER(IntKi), PARAMETER :: M9N7STAzi = 1051 + INTEGER(IntKi), PARAMETER :: M9N8STAzi = 1052 + INTEGER(IntKi), PARAMETER :: M9N9STAzi = 1053 ! Morison Element Loads: - INTEGER(IntKi), PARAMETER :: M1N1FDxi = 1054 - INTEGER(IntKi), PARAMETER :: M1N2FDxi = 1055 - INTEGER(IntKi), PARAMETER :: M1N3FDxi = 1056 - INTEGER(IntKi), PARAMETER :: M1N4FDxi = 1057 - INTEGER(IntKi), PARAMETER :: M1N5FDxi = 1058 - INTEGER(IntKi), PARAMETER :: M1N6FDxi = 1059 - INTEGER(IntKi), PARAMETER :: M1N7FDxi = 1060 - INTEGER(IntKi), PARAMETER :: M1N8FDxi = 1061 - INTEGER(IntKi), PARAMETER :: M1N9FDxi = 1062 - INTEGER(IntKi), PARAMETER :: M2N1FDxi = 1063 - INTEGER(IntKi), PARAMETER :: M2N2FDxi = 1064 - INTEGER(IntKi), PARAMETER :: M2N3FDxi = 1065 - INTEGER(IntKi), PARAMETER :: M2N4FDxi = 1066 - INTEGER(IntKi), PARAMETER :: M2N5FDxi = 1067 - INTEGER(IntKi), PARAMETER :: M2N6FDxi = 1068 - INTEGER(IntKi), PARAMETER :: M2N7FDxi = 1069 - INTEGER(IntKi), PARAMETER :: M2N8FDxi = 1070 - INTEGER(IntKi), PARAMETER :: M2N9FDxi = 1071 - INTEGER(IntKi), PARAMETER :: M3N1FDxi = 1072 - INTEGER(IntKi), PARAMETER :: M3N2FDxi = 1073 - INTEGER(IntKi), PARAMETER :: M3N3FDxi = 1074 - INTEGER(IntKi), PARAMETER :: M3N4FDxi = 1075 - INTEGER(IntKi), PARAMETER :: M3N5FDxi = 1076 - INTEGER(IntKi), PARAMETER :: M3N6FDxi = 1077 - INTEGER(IntKi), PARAMETER :: M3N7FDxi = 1078 - INTEGER(IntKi), PARAMETER :: M3N8FDxi = 1079 - INTEGER(IntKi), PARAMETER :: M3N9FDxi = 1080 - INTEGER(IntKi), PARAMETER :: M4N1FDxi = 1081 - INTEGER(IntKi), PARAMETER :: M4N2FDxi = 1082 - INTEGER(IntKi), PARAMETER :: M4N3FDxi = 1083 - INTEGER(IntKi), PARAMETER :: M4N4FDxi = 1084 - INTEGER(IntKi), PARAMETER :: M4N5FDxi = 1085 - INTEGER(IntKi), PARAMETER :: M4N6FDxi = 1086 - INTEGER(IntKi), PARAMETER :: M4N7FDxi = 1087 - INTEGER(IntKi), PARAMETER :: M4N8FDxi = 1088 - INTEGER(IntKi), PARAMETER :: M4N9FDxi = 1089 - INTEGER(IntKi), PARAMETER :: M5N1FDxi = 1090 - INTEGER(IntKi), PARAMETER :: M5N2FDxi = 1091 - INTEGER(IntKi), PARAMETER :: M5N3FDxi = 1092 - INTEGER(IntKi), PARAMETER :: M5N4FDxi = 1093 - INTEGER(IntKi), PARAMETER :: M5N5FDxi = 1094 - INTEGER(IntKi), PARAMETER :: M5N6FDxi = 1095 - INTEGER(IntKi), PARAMETER :: M5N7FDxi = 1096 - INTEGER(IntKi), PARAMETER :: M5N8FDxi = 1097 - INTEGER(IntKi), PARAMETER :: M5N9FDxi = 1098 - INTEGER(IntKi), PARAMETER :: M6N1FDxi = 1099 - INTEGER(IntKi), PARAMETER :: M6N2FDxi = 1100 - INTEGER(IntKi), PARAMETER :: M6N3FDxi = 1101 - INTEGER(IntKi), PARAMETER :: M6N4FDxi = 1102 - INTEGER(IntKi), PARAMETER :: M6N5FDxi = 1103 - INTEGER(IntKi), PARAMETER :: M6N6FDxi = 1104 - INTEGER(IntKi), PARAMETER :: M6N7FDxi = 1105 - INTEGER(IntKi), PARAMETER :: M6N8FDxi = 1106 - INTEGER(IntKi), PARAMETER :: M6N9FDxi = 1107 - INTEGER(IntKi), PARAMETER :: M7N1FDxi = 1108 - INTEGER(IntKi), PARAMETER :: M7N2FDxi = 1109 - INTEGER(IntKi), PARAMETER :: M7N3FDxi = 1110 - INTEGER(IntKi), PARAMETER :: M7N4FDxi = 1111 - INTEGER(IntKi), PARAMETER :: M7N5FDxi = 1112 - INTEGER(IntKi), PARAMETER :: M7N6FDxi = 1113 - INTEGER(IntKi), PARAMETER :: M7N7FDxi = 1114 - INTEGER(IntKi), PARAMETER :: M7N8FDxi = 1115 - INTEGER(IntKi), PARAMETER :: M7N9FDxi = 1116 - INTEGER(IntKi), PARAMETER :: M8N1FDxi = 1117 - INTEGER(IntKi), PARAMETER :: M8N2FDxi = 1118 - INTEGER(IntKi), PARAMETER :: M8N3FDxi = 1119 - INTEGER(IntKi), PARAMETER :: M8N4FDxi = 1120 - INTEGER(IntKi), PARAMETER :: M8N5FDxi = 1121 - INTEGER(IntKi), PARAMETER :: M8N6FDxi = 1122 - INTEGER(IntKi), PARAMETER :: M8N7FDxi = 1123 - INTEGER(IntKi), PARAMETER :: M8N8FDxi = 1124 - INTEGER(IntKi), PARAMETER :: M8N9FDxi = 1125 - INTEGER(IntKi), PARAMETER :: M9N1FDxi = 1126 - INTEGER(IntKi), PARAMETER :: M9N2FDxi = 1127 - INTEGER(IntKi), PARAMETER :: M9N3FDxi = 1128 - INTEGER(IntKi), PARAMETER :: M9N4FDxi = 1129 - INTEGER(IntKi), PARAMETER :: M9N5FDxi = 1130 - INTEGER(IntKi), PARAMETER :: M9N6FDxi = 1131 - INTEGER(IntKi), PARAMETER :: M9N7FDxi = 1132 - INTEGER(IntKi), PARAMETER :: M9N8FDxi = 1133 - INTEGER(IntKi), PARAMETER :: M9N9FDxi = 1134 - INTEGER(IntKi), PARAMETER :: M1N1FDyi = 1135 - INTEGER(IntKi), PARAMETER :: M1N2FDyi = 1136 - INTEGER(IntKi), PARAMETER :: M1N3FDyi = 1137 - INTEGER(IntKi), PARAMETER :: M1N4FDyi = 1138 - INTEGER(IntKi), PARAMETER :: M1N5FDyi = 1139 - INTEGER(IntKi), PARAMETER :: M1N6FDyi = 1140 - INTEGER(IntKi), PARAMETER :: M1N7FDyi = 1141 - INTEGER(IntKi), PARAMETER :: M1N8FDyi = 1142 - INTEGER(IntKi), PARAMETER :: M1N9FDyi = 1143 - INTEGER(IntKi), PARAMETER :: M2N1FDyi = 1144 - INTEGER(IntKi), PARAMETER :: M2N2FDyi = 1145 - INTEGER(IntKi), PARAMETER :: M2N3FDyi = 1146 - INTEGER(IntKi), PARAMETER :: M2N4FDyi = 1147 - INTEGER(IntKi), PARAMETER :: M2N5FDyi = 1148 - INTEGER(IntKi), PARAMETER :: M2N6FDyi = 1149 - INTEGER(IntKi), PARAMETER :: M2N7FDyi = 1150 - INTEGER(IntKi), PARAMETER :: M2N8FDyi = 1151 - INTEGER(IntKi), PARAMETER :: M2N9FDyi = 1152 - INTEGER(IntKi), PARAMETER :: M3N1FDyi = 1153 - INTEGER(IntKi), PARAMETER :: M3N2FDyi = 1154 - INTEGER(IntKi), PARAMETER :: M3N3FDyi = 1155 - INTEGER(IntKi), PARAMETER :: M3N4FDyi = 1156 - INTEGER(IntKi), PARAMETER :: M3N5FDyi = 1157 - INTEGER(IntKi), PARAMETER :: M3N6FDyi = 1158 - INTEGER(IntKi), PARAMETER :: M3N7FDyi = 1159 - INTEGER(IntKi), PARAMETER :: M3N8FDyi = 1160 - INTEGER(IntKi), PARAMETER :: M3N9FDyi = 1161 - INTEGER(IntKi), PARAMETER :: M4N1FDyi = 1162 - INTEGER(IntKi), PARAMETER :: M4N2FDyi = 1163 - INTEGER(IntKi), PARAMETER :: M4N3FDyi = 1164 - INTEGER(IntKi), PARAMETER :: M4N4FDyi = 1165 - INTEGER(IntKi), PARAMETER :: M4N5FDyi = 1166 - INTEGER(IntKi), PARAMETER :: M4N6FDyi = 1167 - INTEGER(IntKi), PARAMETER :: M4N7FDyi = 1168 - INTEGER(IntKi), PARAMETER :: M4N8FDyi = 1169 - INTEGER(IntKi), PARAMETER :: M4N9FDyi = 1170 - INTEGER(IntKi), PARAMETER :: M5N1FDyi = 1171 - INTEGER(IntKi), PARAMETER :: M5N2FDyi = 1172 - INTEGER(IntKi), PARAMETER :: M5N3FDyi = 1173 - INTEGER(IntKi), PARAMETER :: M5N4FDyi = 1174 - INTEGER(IntKi), PARAMETER :: M5N5FDyi = 1175 - INTEGER(IntKi), PARAMETER :: M5N6FDyi = 1176 - INTEGER(IntKi), PARAMETER :: M5N7FDyi = 1177 - INTEGER(IntKi), PARAMETER :: M5N8FDyi = 1178 - INTEGER(IntKi), PARAMETER :: M5N9FDyi = 1179 - INTEGER(IntKi), PARAMETER :: M6N1FDyi = 1180 - INTEGER(IntKi), PARAMETER :: M6N2FDyi = 1181 - INTEGER(IntKi), PARAMETER :: M6N3FDyi = 1182 - INTEGER(IntKi), PARAMETER :: M6N4FDyi = 1183 - INTEGER(IntKi), PARAMETER :: M6N5FDyi = 1184 - INTEGER(IntKi), PARAMETER :: M6N6FDyi = 1185 - INTEGER(IntKi), PARAMETER :: M6N7FDyi = 1186 - INTEGER(IntKi), PARAMETER :: M6N8FDyi = 1187 - INTEGER(IntKi), PARAMETER :: M6N9FDyi = 1188 - INTEGER(IntKi), PARAMETER :: M7N1FDyi = 1189 - INTEGER(IntKi), PARAMETER :: M7N2FDyi = 1190 - INTEGER(IntKi), PARAMETER :: M7N3FDyi = 1191 - INTEGER(IntKi), PARAMETER :: M7N4FDyi = 1192 - INTEGER(IntKi), PARAMETER :: M7N5FDyi = 1193 - INTEGER(IntKi), PARAMETER :: M7N6FDyi = 1194 - INTEGER(IntKi), PARAMETER :: M7N7FDyi = 1195 - INTEGER(IntKi), PARAMETER :: M7N8FDyi = 1196 - INTEGER(IntKi), PARAMETER :: M7N9FDyi = 1197 - INTEGER(IntKi), PARAMETER :: M8N1FDyi = 1198 - INTEGER(IntKi), PARAMETER :: M8N2FDyi = 1199 - INTEGER(IntKi), PARAMETER :: M8N3FDyi = 1200 - INTEGER(IntKi), PARAMETER :: M8N4FDyi = 1201 - INTEGER(IntKi), PARAMETER :: M8N5FDyi = 1202 - INTEGER(IntKi), PARAMETER :: M8N6FDyi = 1203 - INTEGER(IntKi), PARAMETER :: M8N7FDyi = 1204 - INTEGER(IntKi), PARAMETER :: M8N8FDyi = 1205 - INTEGER(IntKi), PARAMETER :: M8N9FDyi = 1206 - INTEGER(IntKi), PARAMETER :: M9N1FDyi = 1207 - INTEGER(IntKi), PARAMETER :: M9N2FDyi = 1208 - INTEGER(IntKi), PARAMETER :: M9N3FDyi = 1209 - INTEGER(IntKi), PARAMETER :: M9N4FDyi = 1210 - INTEGER(IntKi), PARAMETER :: M9N5FDyi = 1211 - INTEGER(IntKi), PARAMETER :: M9N6FDyi = 1212 - INTEGER(IntKi), PARAMETER :: M9N7FDyi = 1213 - INTEGER(IntKi), PARAMETER :: M9N8FDyi = 1214 - INTEGER(IntKi), PARAMETER :: M9N9FDyi = 1215 - INTEGER(IntKi), PARAMETER :: M1N1FDzi = 1216 - INTEGER(IntKi), PARAMETER :: M1N2FDzi = 1217 - INTEGER(IntKi), PARAMETER :: M1N3FDzi = 1218 - INTEGER(IntKi), PARAMETER :: M1N4FDzi = 1219 - INTEGER(IntKi), PARAMETER :: M1N5FDzi = 1220 - INTEGER(IntKi), PARAMETER :: M1N6FDzi = 1221 - INTEGER(IntKi), PARAMETER :: M1N7FDzi = 1222 - INTEGER(IntKi), PARAMETER :: M1N8FDzi = 1223 - INTEGER(IntKi), PARAMETER :: M1N9FDzi = 1224 - INTEGER(IntKi), PARAMETER :: M2N1FDzi = 1225 - INTEGER(IntKi), PARAMETER :: M2N2FDzi = 1226 - INTEGER(IntKi), PARAMETER :: M2N3FDzi = 1227 - INTEGER(IntKi), PARAMETER :: M2N4FDzi = 1228 - INTEGER(IntKi), PARAMETER :: M2N5FDzi = 1229 - INTEGER(IntKi), PARAMETER :: M2N6FDzi = 1230 - INTEGER(IntKi), PARAMETER :: M2N7FDzi = 1231 - INTEGER(IntKi), PARAMETER :: M2N8FDzi = 1232 - INTEGER(IntKi), PARAMETER :: M2N9FDzi = 1233 - INTEGER(IntKi), PARAMETER :: M3N1FDzi = 1234 - INTEGER(IntKi), PARAMETER :: M3N2FDzi = 1235 - INTEGER(IntKi), PARAMETER :: M3N3FDzi = 1236 - INTEGER(IntKi), PARAMETER :: M3N4FDzi = 1237 - INTEGER(IntKi), PARAMETER :: M3N5FDzi = 1238 - INTEGER(IntKi), PARAMETER :: M3N6FDzi = 1239 - INTEGER(IntKi), PARAMETER :: M3N7FDzi = 1240 - INTEGER(IntKi), PARAMETER :: M3N8FDzi = 1241 - INTEGER(IntKi), PARAMETER :: M3N9FDzi = 1242 - INTEGER(IntKi), PARAMETER :: M4N1FDzi = 1243 - INTEGER(IntKi), PARAMETER :: M4N2FDzi = 1244 - INTEGER(IntKi), PARAMETER :: M4N3FDzi = 1245 - INTEGER(IntKi), PARAMETER :: M4N4FDzi = 1246 - INTEGER(IntKi), PARAMETER :: M4N5FDzi = 1247 - INTEGER(IntKi), PARAMETER :: M4N6FDzi = 1248 - INTEGER(IntKi), PARAMETER :: M4N7FDzi = 1249 - INTEGER(IntKi), PARAMETER :: M4N8FDzi = 1250 - INTEGER(IntKi), PARAMETER :: M4N9FDzi = 1251 - INTEGER(IntKi), PARAMETER :: M5N1FDzi = 1252 - INTEGER(IntKi), PARAMETER :: M5N2FDzi = 1253 - INTEGER(IntKi), PARAMETER :: M5N3FDzi = 1254 - INTEGER(IntKi), PARAMETER :: M5N4FDzi = 1255 - INTEGER(IntKi), PARAMETER :: M5N5FDzi = 1256 - INTEGER(IntKi), PARAMETER :: M5N6FDzi = 1257 - INTEGER(IntKi), PARAMETER :: M5N7FDzi = 1258 - INTEGER(IntKi), PARAMETER :: M5N8FDzi = 1259 - INTEGER(IntKi), PARAMETER :: M5N9FDzi = 1260 - INTEGER(IntKi), PARAMETER :: M6N1FDzi = 1261 - INTEGER(IntKi), PARAMETER :: M6N2FDzi = 1262 - INTEGER(IntKi), PARAMETER :: M6N3FDzi = 1263 - INTEGER(IntKi), PARAMETER :: M6N4FDzi = 1264 - INTEGER(IntKi), PARAMETER :: M6N5FDzi = 1265 - INTEGER(IntKi), PARAMETER :: M6N6FDzi = 1266 - INTEGER(IntKi), PARAMETER :: M6N7FDzi = 1267 - INTEGER(IntKi), PARAMETER :: M6N8FDzi = 1268 - INTEGER(IntKi), PARAMETER :: M6N9FDzi = 1269 - INTEGER(IntKi), PARAMETER :: M7N1FDzi = 1270 - INTEGER(IntKi), PARAMETER :: M7N2FDzi = 1271 - INTEGER(IntKi), PARAMETER :: M7N3FDzi = 1272 - INTEGER(IntKi), PARAMETER :: M7N4FDzi = 1273 - INTEGER(IntKi), PARAMETER :: M7N5FDzi = 1274 - INTEGER(IntKi), PARAMETER :: M7N6FDzi = 1275 - INTEGER(IntKi), PARAMETER :: M7N7FDzi = 1276 - INTEGER(IntKi), PARAMETER :: M7N8FDzi = 1277 - INTEGER(IntKi), PARAMETER :: M7N9FDzi = 1278 - INTEGER(IntKi), PARAMETER :: M8N1FDzi = 1279 - INTEGER(IntKi), PARAMETER :: M8N2FDzi = 1280 - INTEGER(IntKi), PARAMETER :: M8N3FDzi = 1281 - INTEGER(IntKi), PARAMETER :: M8N4FDzi = 1282 - INTEGER(IntKi), PARAMETER :: M8N5FDzi = 1283 - INTEGER(IntKi), PARAMETER :: M8N6FDzi = 1284 - INTEGER(IntKi), PARAMETER :: M8N7FDzi = 1285 - INTEGER(IntKi), PARAMETER :: M8N8FDzi = 1286 - INTEGER(IntKi), PARAMETER :: M8N9FDzi = 1287 - INTEGER(IntKi), PARAMETER :: M9N1FDzi = 1288 - INTEGER(IntKi), PARAMETER :: M9N2FDzi = 1289 - INTEGER(IntKi), PARAMETER :: M9N3FDzi = 1290 - INTEGER(IntKi), PARAMETER :: M9N4FDzi = 1291 - INTEGER(IntKi), PARAMETER :: M9N5FDzi = 1292 - INTEGER(IntKi), PARAMETER :: M9N6FDzi = 1293 - INTEGER(IntKi), PARAMETER :: M9N7FDzi = 1294 - INTEGER(IntKi), PARAMETER :: M9N8FDzi = 1295 - INTEGER(IntKi), PARAMETER :: M9N9FDzi = 1296 - INTEGER(IntKi), PARAMETER :: M1N1FIxi = 1297 - INTEGER(IntKi), PARAMETER :: M1N2FIxi = 1298 - INTEGER(IntKi), PARAMETER :: M1N3FIxi = 1299 - INTEGER(IntKi), PARAMETER :: M1N4FIxi = 1300 - INTEGER(IntKi), PARAMETER :: M1N5FIxi = 1301 - INTEGER(IntKi), PARAMETER :: M1N6FIxi = 1302 - INTEGER(IntKi), PARAMETER :: M1N7FIxi = 1303 - INTEGER(IntKi), PARAMETER :: M1N8FIxi = 1304 - INTEGER(IntKi), PARAMETER :: M1N9FIxi = 1305 - INTEGER(IntKi), PARAMETER :: M2N1FIxi = 1306 - INTEGER(IntKi), PARAMETER :: M2N2FIxi = 1307 - INTEGER(IntKi), PARAMETER :: M2N3FIxi = 1308 - INTEGER(IntKi), PARAMETER :: M2N4FIxi = 1309 - INTEGER(IntKi), PARAMETER :: M2N5FIxi = 1310 - INTEGER(IntKi), PARAMETER :: M2N6FIxi = 1311 - INTEGER(IntKi), PARAMETER :: M2N7FIxi = 1312 - INTEGER(IntKi), PARAMETER :: M2N8FIxi = 1313 - INTEGER(IntKi), PARAMETER :: M2N9FIxi = 1314 - INTEGER(IntKi), PARAMETER :: M3N1FIxi = 1315 - INTEGER(IntKi), PARAMETER :: M3N2FIxi = 1316 - INTEGER(IntKi), PARAMETER :: M3N3FIxi = 1317 - INTEGER(IntKi), PARAMETER :: M3N4FIxi = 1318 - INTEGER(IntKi), PARAMETER :: M3N5FIxi = 1319 - INTEGER(IntKi), PARAMETER :: M3N6FIxi = 1320 - INTEGER(IntKi), PARAMETER :: M3N7FIxi = 1321 - INTEGER(IntKi), PARAMETER :: M3N8FIxi = 1322 - INTEGER(IntKi), PARAMETER :: M3N9FIxi = 1323 - INTEGER(IntKi), PARAMETER :: M4N1FIxi = 1324 - INTEGER(IntKi), PARAMETER :: M4N2FIxi = 1325 - INTEGER(IntKi), PARAMETER :: M4N3FIxi = 1326 - INTEGER(IntKi), PARAMETER :: M4N4FIxi = 1327 - INTEGER(IntKi), PARAMETER :: M4N5FIxi = 1328 - INTEGER(IntKi), PARAMETER :: M4N6FIxi = 1329 - INTEGER(IntKi), PARAMETER :: M4N7FIxi = 1330 - INTEGER(IntKi), PARAMETER :: M4N8FIxi = 1331 - INTEGER(IntKi), PARAMETER :: M4N9FIxi = 1332 - INTEGER(IntKi), PARAMETER :: M5N1FIxi = 1333 - INTEGER(IntKi), PARAMETER :: M5N2FIxi = 1334 - INTEGER(IntKi), PARAMETER :: M5N3FIxi = 1335 - INTEGER(IntKi), PARAMETER :: M5N4FIxi = 1336 - INTEGER(IntKi), PARAMETER :: M5N5FIxi = 1337 - INTEGER(IntKi), PARAMETER :: M5N6FIxi = 1338 - INTEGER(IntKi), PARAMETER :: M5N7FIxi = 1339 - INTEGER(IntKi), PARAMETER :: M5N8FIxi = 1340 - INTEGER(IntKi), PARAMETER :: M5N9FIxi = 1341 - INTEGER(IntKi), PARAMETER :: M6N1FIxi = 1342 - INTEGER(IntKi), PARAMETER :: M6N2FIxi = 1343 - INTEGER(IntKi), PARAMETER :: M6N3FIxi = 1344 - INTEGER(IntKi), PARAMETER :: M6N4FIxi = 1345 - INTEGER(IntKi), PARAMETER :: M6N5FIxi = 1346 - INTEGER(IntKi), PARAMETER :: M6N6FIxi = 1347 - INTEGER(IntKi), PARAMETER :: M6N7FIxi = 1348 - INTEGER(IntKi), PARAMETER :: M6N8FIxi = 1349 - INTEGER(IntKi), PARAMETER :: M6N9FIxi = 1350 - INTEGER(IntKi), PARAMETER :: M7N1FIxi = 1351 - INTEGER(IntKi), PARAMETER :: M7N2FIxi = 1352 - INTEGER(IntKi), PARAMETER :: M7N3FIxi = 1353 - INTEGER(IntKi), PARAMETER :: M7N4FIxi = 1354 - INTEGER(IntKi), PARAMETER :: M7N5FIxi = 1355 - INTEGER(IntKi), PARAMETER :: M7N6FIxi = 1356 - INTEGER(IntKi), PARAMETER :: M7N7FIxi = 1357 - INTEGER(IntKi), PARAMETER :: M7N8FIxi = 1358 - INTEGER(IntKi), PARAMETER :: M7N9FIxi = 1359 - INTEGER(IntKi), PARAMETER :: M8N1FIxi = 1360 - INTEGER(IntKi), PARAMETER :: M8N2FIxi = 1361 - INTEGER(IntKi), PARAMETER :: M8N3FIxi = 1362 - INTEGER(IntKi), PARAMETER :: M8N4FIxi = 1363 - INTEGER(IntKi), PARAMETER :: M8N5FIxi = 1364 - INTEGER(IntKi), PARAMETER :: M8N6FIxi = 1365 - INTEGER(IntKi), PARAMETER :: M8N7FIxi = 1366 - INTEGER(IntKi), PARAMETER :: M8N8FIxi = 1367 - INTEGER(IntKi), PARAMETER :: M8N9FIxi = 1368 - INTEGER(IntKi), PARAMETER :: M9N1FIxi = 1369 - INTEGER(IntKi), PARAMETER :: M9N2FIxi = 1370 - INTEGER(IntKi), PARAMETER :: M9N3FIxi = 1371 - INTEGER(IntKi), PARAMETER :: M9N4FIxi = 1372 - INTEGER(IntKi), PARAMETER :: M9N5FIxi = 1373 - INTEGER(IntKi), PARAMETER :: M9N6FIxi = 1374 - INTEGER(IntKi), PARAMETER :: M9N7FIxi = 1375 - INTEGER(IntKi), PARAMETER :: M9N8FIxi = 1376 - INTEGER(IntKi), PARAMETER :: M9N9FIxi = 1377 - INTEGER(IntKi), PARAMETER :: M1N1FIyi = 1378 - INTEGER(IntKi), PARAMETER :: M1N2FIyi = 1379 - INTEGER(IntKi), PARAMETER :: M1N3FIyi = 1380 - INTEGER(IntKi), PARAMETER :: M1N4FIyi = 1381 - INTEGER(IntKi), PARAMETER :: M1N5FIyi = 1382 - INTEGER(IntKi), PARAMETER :: M1N6FIyi = 1383 - INTEGER(IntKi), PARAMETER :: M1N7FIyi = 1384 - INTEGER(IntKi), PARAMETER :: M1N8FIyi = 1385 - INTEGER(IntKi), PARAMETER :: M1N9FIyi = 1386 - INTEGER(IntKi), PARAMETER :: M2N1FIyi = 1387 - INTEGER(IntKi), PARAMETER :: M2N2FIyi = 1388 - INTEGER(IntKi), PARAMETER :: M2N3FIyi = 1389 - INTEGER(IntKi), PARAMETER :: M2N4FIyi = 1390 - INTEGER(IntKi), PARAMETER :: M2N5FIyi = 1391 - INTEGER(IntKi), PARAMETER :: M2N6FIyi = 1392 - INTEGER(IntKi), PARAMETER :: M2N7FIyi = 1393 - INTEGER(IntKi), PARAMETER :: M2N8FIyi = 1394 - INTEGER(IntKi), PARAMETER :: M2N9FIyi = 1395 - INTEGER(IntKi), PARAMETER :: M3N1FIyi = 1396 - INTEGER(IntKi), PARAMETER :: M3N2FIyi = 1397 - INTEGER(IntKi), PARAMETER :: M3N3FIyi = 1398 - INTEGER(IntKi), PARAMETER :: M3N4FIyi = 1399 - INTEGER(IntKi), PARAMETER :: M3N5FIyi = 1400 - INTEGER(IntKi), PARAMETER :: M3N6FIyi = 1401 - INTEGER(IntKi), PARAMETER :: M3N7FIyi = 1402 - INTEGER(IntKi), PARAMETER :: M3N8FIyi = 1403 - INTEGER(IntKi), PARAMETER :: M3N9FIyi = 1404 - INTEGER(IntKi), PARAMETER :: M4N1FIyi = 1405 - INTEGER(IntKi), PARAMETER :: M4N2FIyi = 1406 - INTEGER(IntKi), PARAMETER :: M4N3FIyi = 1407 - INTEGER(IntKi), PARAMETER :: M4N4FIyi = 1408 - INTEGER(IntKi), PARAMETER :: M4N5FIyi = 1409 - INTEGER(IntKi), PARAMETER :: M4N6FIyi = 1410 - INTEGER(IntKi), PARAMETER :: M4N7FIyi = 1411 - INTEGER(IntKi), PARAMETER :: M4N8FIyi = 1412 - INTEGER(IntKi), PARAMETER :: M4N9FIyi = 1413 - INTEGER(IntKi), PARAMETER :: M5N1FIyi = 1414 - INTEGER(IntKi), PARAMETER :: M5N2FIyi = 1415 - INTEGER(IntKi), PARAMETER :: M5N3FIyi = 1416 - INTEGER(IntKi), PARAMETER :: M5N4FIyi = 1417 - INTEGER(IntKi), PARAMETER :: M5N5FIyi = 1418 - INTEGER(IntKi), PARAMETER :: M5N6FIyi = 1419 - INTEGER(IntKi), PARAMETER :: M5N7FIyi = 1420 - INTEGER(IntKi), PARAMETER :: M5N8FIyi = 1421 - INTEGER(IntKi), PARAMETER :: M5N9FIyi = 1422 - INTEGER(IntKi), PARAMETER :: M6N1FIyi = 1423 - INTEGER(IntKi), PARAMETER :: M6N2FIyi = 1424 - INTEGER(IntKi), PARAMETER :: M6N3FIyi = 1425 - INTEGER(IntKi), PARAMETER :: M6N4FIyi = 1426 - INTEGER(IntKi), PARAMETER :: M6N5FIyi = 1427 - INTEGER(IntKi), PARAMETER :: M6N6FIyi = 1428 - INTEGER(IntKi), PARAMETER :: M6N7FIyi = 1429 - INTEGER(IntKi), PARAMETER :: M6N8FIyi = 1430 - INTEGER(IntKi), PARAMETER :: M6N9FIyi = 1431 - INTEGER(IntKi), PARAMETER :: M7N1FIyi = 1432 - INTEGER(IntKi), PARAMETER :: M7N2FIyi = 1433 - INTEGER(IntKi), PARAMETER :: M7N3FIyi = 1434 - INTEGER(IntKi), PARAMETER :: M7N4FIyi = 1435 - INTEGER(IntKi), PARAMETER :: M7N5FIyi = 1436 - INTEGER(IntKi), PARAMETER :: M7N6FIyi = 1437 - INTEGER(IntKi), PARAMETER :: M7N7FIyi = 1438 - INTEGER(IntKi), PARAMETER :: M7N8FIyi = 1439 - INTEGER(IntKi), PARAMETER :: M7N9FIyi = 1440 - INTEGER(IntKi), PARAMETER :: M8N1FIyi = 1441 - INTEGER(IntKi), PARAMETER :: M8N2FIyi = 1442 - INTEGER(IntKi), PARAMETER :: M8N3FIyi = 1443 - INTEGER(IntKi), PARAMETER :: M8N4FIyi = 1444 - INTEGER(IntKi), PARAMETER :: M8N5FIyi = 1445 - INTEGER(IntKi), PARAMETER :: M8N6FIyi = 1446 - INTEGER(IntKi), PARAMETER :: M8N7FIyi = 1447 - INTEGER(IntKi), PARAMETER :: M8N8FIyi = 1448 - INTEGER(IntKi), PARAMETER :: M8N9FIyi = 1449 - INTEGER(IntKi), PARAMETER :: M9N1FIyi = 1450 - INTEGER(IntKi), PARAMETER :: M9N2FIyi = 1451 - INTEGER(IntKi), PARAMETER :: M9N3FIyi = 1452 - INTEGER(IntKi), PARAMETER :: M9N4FIyi = 1453 - INTEGER(IntKi), PARAMETER :: M9N5FIyi = 1454 - INTEGER(IntKi), PARAMETER :: M9N6FIyi = 1455 - INTEGER(IntKi), PARAMETER :: M9N7FIyi = 1456 - INTEGER(IntKi), PARAMETER :: M9N8FIyi = 1457 - INTEGER(IntKi), PARAMETER :: M9N9FIyi = 1458 - INTEGER(IntKi), PARAMETER :: M1N1FIzi = 1459 - INTEGER(IntKi), PARAMETER :: M1N2FIzi = 1460 - INTEGER(IntKi), PARAMETER :: M1N3FIzi = 1461 - INTEGER(IntKi), PARAMETER :: M1N4FIzi = 1462 - INTEGER(IntKi), PARAMETER :: M1N5FIzi = 1463 - INTEGER(IntKi), PARAMETER :: M1N6FIzi = 1464 - INTEGER(IntKi), PARAMETER :: M1N7FIzi = 1465 - INTEGER(IntKi), PARAMETER :: M1N8FIzi = 1466 - INTEGER(IntKi), PARAMETER :: M1N9FIzi = 1467 - INTEGER(IntKi), PARAMETER :: M2N1FIzi = 1468 - INTEGER(IntKi), PARAMETER :: M2N2FIzi = 1469 - INTEGER(IntKi), PARAMETER :: M2N3FIzi = 1470 - INTEGER(IntKi), PARAMETER :: M2N4FIzi = 1471 - INTEGER(IntKi), PARAMETER :: M2N5FIzi = 1472 - INTEGER(IntKi), PARAMETER :: M2N6FIzi = 1473 - INTEGER(IntKi), PARAMETER :: M2N7FIzi = 1474 - INTEGER(IntKi), PARAMETER :: M2N8FIzi = 1475 - INTEGER(IntKi), PARAMETER :: M2N9FIzi = 1476 - INTEGER(IntKi), PARAMETER :: M3N1FIzi = 1477 - INTEGER(IntKi), PARAMETER :: M3N2FIzi = 1478 - INTEGER(IntKi), PARAMETER :: M3N3FIzi = 1479 - INTEGER(IntKi), PARAMETER :: M3N4FIzi = 1480 - INTEGER(IntKi), PARAMETER :: M3N5FIzi = 1481 - INTEGER(IntKi), PARAMETER :: M3N6FIzi = 1482 - INTEGER(IntKi), PARAMETER :: M3N7FIzi = 1483 - INTEGER(IntKi), PARAMETER :: M3N8FIzi = 1484 - INTEGER(IntKi), PARAMETER :: M3N9FIzi = 1485 - INTEGER(IntKi), PARAMETER :: M4N1FIzi = 1486 - INTEGER(IntKi), PARAMETER :: M4N2FIzi = 1487 - INTEGER(IntKi), PARAMETER :: M4N3FIzi = 1488 - INTEGER(IntKi), PARAMETER :: M4N4FIzi = 1489 - INTEGER(IntKi), PARAMETER :: M4N5FIzi = 1490 - INTEGER(IntKi), PARAMETER :: M4N6FIzi = 1491 - INTEGER(IntKi), PARAMETER :: M4N7FIzi = 1492 - INTEGER(IntKi), PARAMETER :: M4N8FIzi = 1493 - INTEGER(IntKi), PARAMETER :: M4N9FIzi = 1494 - INTEGER(IntKi), PARAMETER :: M5N1FIzi = 1495 - INTEGER(IntKi), PARAMETER :: M5N2FIzi = 1496 - INTEGER(IntKi), PARAMETER :: M5N3FIzi = 1497 - INTEGER(IntKi), PARAMETER :: M5N4FIzi = 1498 - INTEGER(IntKi), PARAMETER :: M5N5FIzi = 1499 - INTEGER(IntKi), PARAMETER :: M5N6FIzi = 1500 - INTEGER(IntKi), PARAMETER :: M5N7FIzi = 1501 - INTEGER(IntKi), PARAMETER :: M5N8FIzi = 1502 - INTEGER(IntKi), PARAMETER :: M5N9FIzi = 1503 - INTEGER(IntKi), PARAMETER :: M6N1FIzi = 1504 - INTEGER(IntKi), PARAMETER :: M6N2FIzi = 1505 - INTEGER(IntKi), PARAMETER :: M6N3FIzi = 1506 - INTEGER(IntKi), PARAMETER :: M6N4FIzi = 1507 - INTEGER(IntKi), PARAMETER :: M6N5FIzi = 1508 - INTEGER(IntKi), PARAMETER :: M6N6FIzi = 1509 - INTEGER(IntKi), PARAMETER :: M6N7FIzi = 1510 - INTEGER(IntKi), PARAMETER :: M6N8FIzi = 1511 - INTEGER(IntKi), PARAMETER :: M6N9FIzi = 1512 - INTEGER(IntKi), PARAMETER :: M7N1FIzi = 1513 - INTEGER(IntKi), PARAMETER :: M7N2FIzi = 1514 - INTEGER(IntKi), PARAMETER :: M7N3FIzi = 1515 - INTEGER(IntKi), PARAMETER :: M7N4FIzi = 1516 - INTEGER(IntKi), PARAMETER :: M7N5FIzi = 1517 - INTEGER(IntKi), PARAMETER :: M7N6FIzi = 1518 - INTEGER(IntKi), PARAMETER :: M7N7FIzi = 1519 - INTEGER(IntKi), PARAMETER :: M7N8FIzi = 1520 - INTEGER(IntKi), PARAMETER :: M7N9FIzi = 1521 - INTEGER(IntKi), PARAMETER :: M8N1FIzi = 1522 - INTEGER(IntKi), PARAMETER :: M8N2FIzi = 1523 - INTEGER(IntKi), PARAMETER :: M8N3FIzi = 1524 - INTEGER(IntKi), PARAMETER :: M8N4FIzi = 1525 - INTEGER(IntKi), PARAMETER :: M8N5FIzi = 1526 - INTEGER(IntKi), PARAMETER :: M8N6FIzi = 1527 - INTEGER(IntKi), PARAMETER :: M8N7FIzi = 1528 - INTEGER(IntKi), PARAMETER :: M8N8FIzi = 1529 - INTEGER(IntKi), PARAMETER :: M8N9FIzi = 1530 - INTEGER(IntKi), PARAMETER :: M9N1FIzi = 1531 - INTEGER(IntKi), PARAMETER :: M9N2FIzi = 1532 - INTEGER(IntKi), PARAMETER :: M9N3FIzi = 1533 - INTEGER(IntKi), PARAMETER :: M9N4FIzi = 1534 - INTEGER(IntKi), PARAMETER :: M9N5FIzi = 1535 - INTEGER(IntKi), PARAMETER :: M9N6FIzi = 1536 - INTEGER(IntKi), PARAMETER :: M9N7FIzi = 1537 - INTEGER(IntKi), PARAMETER :: M9N8FIzi = 1538 - INTEGER(IntKi), PARAMETER :: M9N9FIzi = 1539 - INTEGER(IntKi), PARAMETER :: M1N1FBxi = 1540 - INTEGER(IntKi), PARAMETER :: M1N2FBxi = 1541 - INTEGER(IntKi), PARAMETER :: M1N3FBxi = 1542 - INTEGER(IntKi), PARAMETER :: M1N4FBxi = 1543 - INTEGER(IntKi), PARAMETER :: M1N5FBxi = 1544 - INTEGER(IntKi), PARAMETER :: M1N6FBxi = 1545 - INTEGER(IntKi), PARAMETER :: M1N7FBxi = 1546 - INTEGER(IntKi), PARAMETER :: M1N8FBxi = 1547 - INTEGER(IntKi), PARAMETER :: M1N9FBxi = 1548 - INTEGER(IntKi), PARAMETER :: M2N1FBxi = 1549 - INTEGER(IntKi), PARAMETER :: M2N2FBxi = 1550 - INTEGER(IntKi), PARAMETER :: M2N3FBxi = 1551 - INTEGER(IntKi), PARAMETER :: M2N4FBxi = 1552 - INTEGER(IntKi), PARAMETER :: M2N5FBxi = 1553 - INTEGER(IntKi), PARAMETER :: M2N6FBxi = 1554 - INTEGER(IntKi), PARAMETER :: M2N7FBxi = 1555 - INTEGER(IntKi), PARAMETER :: M2N8FBxi = 1556 - INTEGER(IntKi), PARAMETER :: M2N9FBxi = 1557 - INTEGER(IntKi), PARAMETER :: M3N1FBxi = 1558 - INTEGER(IntKi), PARAMETER :: M3N2FBxi = 1559 - INTEGER(IntKi), PARAMETER :: M3N3FBxi = 1560 - INTEGER(IntKi), PARAMETER :: M3N4FBxi = 1561 - INTEGER(IntKi), PARAMETER :: M3N5FBxi = 1562 - INTEGER(IntKi), PARAMETER :: M3N6FBxi = 1563 - INTEGER(IntKi), PARAMETER :: M3N7FBxi = 1564 - INTEGER(IntKi), PARAMETER :: M3N8FBxi = 1565 - INTEGER(IntKi), PARAMETER :: M3N9FBxi = 1566 - INTEGER(IntKi), PARAMETER :: M4N1FBxi = 1567 - INTEGER(IntKi), PARAMETER :: M4N2FBxi = 1568 - INTEGER(IntKi), PARAMETER :: M4N3FBxi = 1569 - INTEGER(IntKi), PARAMETER :: M4N4FBxi = 1570 - INTEGER(IntKi), PARAMETER :: M4N5FBxi = 1571 - INTEGER(IntKi), PARAMETER :: M4N6FBxi = 1572 - INTEGER(IntKi), PARAMETER :: M4N7FBxi = 1573 - INTEGER(IntKi), PARAMETER :: M4N8FBxi = 1574 - INTEGER(IntKi), PARAMETER :: M4N9FBxi = 1575 - INTEGER(IntKi), PARAMETER :: M5N1FBxi = 1576 - INTEGER(IntKi), PARAMETER :: M5N2FBxi = 1577 - INTEGER(IntKi), PARAMETER :: M5N3FBxi = 1578 - INTEGER(IntKi), PARAMETER :: M5N4FBxi = 1579 - INTEGER(IntKi), PARAMETER :: M5N5FBxi = 1580 - INTEGER(IntKi), PARAMETER :: M5N6FBxi = 1581 - INTEGER(IntKi), PARAMETER :: M5N7FBxi = 1582 - INTEGER(IntKi), PARAMETER :: M5N8FBxi = 1583 - INTEGER(IntKi), PARAMETER :: M5N9FBxi = 1584 - INTEGER(IntKi), PARAMETER :: M6N1FBxi = 1585 - INTEGER(IntKi), PARAMETER :: M6N2FBxi = 1586 - INTEGER(IntKi), PARAMETER :: M6N3FBxi = 1587 - INTEGER(IntKi), PARAMETER :: M6N4FBxi = 1588 - INTEGER(IntKi), PARAMETER :: M6N5FBxi = 1589 - INTEGER(IntKi), PARAMETER :: M6N6FBxi = 1590 - INTEGER(IntKi), PARAMETER :: M6N7FBxi = 1591 - INTEGER(IntKi), PARAMETER :: M6N8FBxi = 1592 - INTEGER(IntKi), PARAMETER :: M6N9FBxi = 1593 - INTEGER(IntKi), PARAMETER :: M7N1FBxi = 1594 - INTEGER(IntKi), PARAMETER :: M7N2FBxi = 1595 - INTEGER(IntKi), PARAMETER :: M7N3FBxi = 1596 - INTEGER(IntKi), PARAMETER :: M7N4FBxi = 1597 - INTEGER(IntKi), PARAMETER :: M7N5FBxi = 1598 - INTEGER(IntKi), PARAMETER :: M7N6FBxi = 1599 - INTEGER(IntKi), PARAMETER :: M7N7FBxi = 1600 - INTEGER(IntKi), PARAMETER :: M7N8FBxi = 1601 - INTEGER(IntKi), PARAMETER :: M7N9FBxi = 1602 - INTEGER(IntKi), PARAMETER :: M8N1FBxi = 1603 - INTEGER(IntKi), PARAMETER :: M8N2FBxi = 1604 - INTEGER(IntKi), PARAMETER :: M8N3FBxi = 1605 - INTEGER(IntKi), PARAMETER :: M8N4FBxi = 1606 - INTEGER(IntKi), PARAMETER :: M8N5FBxi = 1607 - INTEGER(IntKi), PARAMETER :: M8N6FBxi = 1608 - INTEGER(IntKi), PARAMETER :: M8N7FBxi = 1609 - INTEGER(IntKi), PARAMETER :: M8N8FBxi = 1610 - INTEGER(IntKi), PARAMETER :: M8N9FBxi = 1611 - INTEGER(IntKi), PARAMETER :: M9N1FBxi = 1612 - INTEGER(IntKi), PARAMETER :: M9N2FBxi = 1613 - INTEGER(IntKi), PARAMETER :: M9N3FBxi = 1614 - INTEGER(IntKi), PARAMETER :: M9N4FBxi = 1615 - INTEGER(IntKi), PARAMETER :: M9N5FBxi = 1616 - INTEGER(IntKi), PARAMETER :: M9N6FBxi = 1617 - INTEGER(IntKi), PARAMETER :: M9N7FBxi = 1618 - INTEGER(IntKi), PARAMETER :: M9N8FBxi = 1619 - INTEGER(IntKi), PARAMETER :: M9N9FBxi = 1620 - INTEGER(IntKi), PARAMETER :: M1N1FByi = 1621 - INTEGER(IntKi), PARAMETER :: M1N2FByi = 1622 - INTEGER(IntKi), PARAMETER :: M1N3FByi = 1623 - INTEGER(IntKi), PARAMETER :: M1N4FByi = 1624 - INTEGER(IntKi), PARAMETER :: M1N5FByi = 1625 - INTEGER(IntKi), PARAMETER :: M1N6FByi = 1626 - INTEGER(IntKi), PARAMETER :: M1N7FByi = 1627 - INTEGER(IntKi), PARAMETER :: M1N8FByi = 1628 - INTEGER(IntKi), PARAMETER :: M1N9FByi = 1629 - INTEGER(IntKi), PARAMETER :: M2N1FByi = 1630 - INTEGER(IntKi), PARAMETER :: M2N2FByi = 1631 - INTEGER(IntKi), PARAMETER :: M2N3FByi = 1632 - INTEGER(IntKi), PARAMETER :: M2N4FByi = 1633 - INTEGER(IntKi), PARAMETER :: M2N5FByi = 1634 - INTEGER(IntKi), PARAMETER :: M2N6FByi = 1635 - INTEGER(IntKi), PARAMETER :: M2N7FByi = 1636 - INTEGER(IntKi), PARAMETER :: M2N8FByi = 1637 - INTEGER(IntKi), PARAMETER :: M2N9FByi = 1638 - INTEGER(IntKi), PARAMETER :: M3N1FByi = 1639 - INTEGER(IntKi), PARAMETER :: M3N2FByi = 1640 - INTEGER(IntKi), PARAMETER :: M3N3FByi = 1641 - INTEGER(IntKi), PARAMETER :: M3N4FByi = 1642 - INTEGER(IntKi), PARAMETER :: M3N5FByi = 1643 - INTEGER(IntKi), PARAMETER :: M3N6FByi = 1644 - INTEGER(IntKi), PARAMETER :: M3N7FByi = 1645 - INTEGER(IntKi), PARAMETER :: M3N8FByi = 1646 - INTEGER(IntKi), PARAMETER :: M3N9FByi = 1647 - INTEGER(IntKi), PARAMETER :: M4N1FByi = 1648 - INTEGER(IntKi), PARAMETER :: M4N2FByi = 1649 - INTEGER(IntKi), PARAMETER :: M4N3FByi = 1650 - INTEGER(IntKi), PARAMETER :: M4N4FByi = 1651 - INTEGER(IntKi), PARAMETER :: M4N5FByi = 1652 - INTEGER(IntKi), PARAMETER :: M4N6FByi = 1653 - INTEGER(IntKi), PARAMETER :: M4N7FByi = 1654 - INTEGER(IntKi), PARAMETER :: M4N8FByi = 1655 - INTEGER(IntKi), PARAMETER :: M4N9FByi = 1656 - INTEGER(IntKi), PARAMETER :: M5N1FByi = 1657 - INTEGER(IntKi), PARAMETER :: M5N2FByi = 1658 - INTEGER(IntKi), PARAMETER :: M5N3FByi = 1659 - INTEGER(IntKi), PARAMETER :: M5N4FByi = 1660 - INTEGER(IntKi), PARAMETER :: M5N5FByi = 1661 - INTEGER(IntKi), PARAMETER :: M5N6FByi = 1662 - INTEGER(IntKi), PARAMETER :: M5N7FByi = 1663 - INTEGER(IntKi), PARAMETER :: M5N8FByi = 1664 - INTEGER(IntKi), PARAMETER :: M5N9FByi = 1665 - INTEGER(IntKi), PARAMETER :: M6N1FByi = 1666 - INTEGER(IntKi), PARAMETER :: M6N2FByi = 1667 - INTEGER(IntKi), PARAMETER :: M6N3FByi = 1668 - INTEGER(IntKi), PARAMETER :: M6N4FByi = 1669 - INTEGER(IntKi), PARAMETER :: M6N5FByi = 1670 - INTEGER(IntKi), PARAMETER :: M6N6FByi = 1671 - INTEGER(IntKi), PARAMETER :: M6N7FByi = 1672 - INTEGER(IntKi), PARAMETER :: M6N8FByi = 1673 - INTEGER(IntKi), PARAMETER :: M6N9FByi = 1674 - INTEGER(IntKi), PARAMETER :: M7N1FByi = 1675 - INTEGER(IntKi), PARAMETER :: M7N2FByi = 1676 - INTEGER(IntKi), PARAMETER :: M7N3FByi = 1677 - INTEGER(IntKi), PARAMETER :: M7N4FByi = 1678 - INTEGER(IntKi), PARAMETER :: M7N5FByi = 1679 - INTEGER(IntKi), PARAMETER :: M7N6FByi = 1680 - INTEGER(IntKi), PARAMETER :: M7N7FByi = 1681 - INTEGER(IntKi), PARAMETER :: M7N8FByi = 1682 - INTEGER(IntKi), PARAMETER :: M7N9FByi = 1683 - INTEGER(IntKi), PARAMETER :: M8N1FByi = 1684 - INTEGER(IntKi), PARAMETER :: M8N2FByi = 1685 - INTEGER(IntKi), PARAMETER :: M8N3FByi = 1686 - INTEGER(IntKi), PARAMETER :: M8N4FByi = 1687 - INTEGER(IntKi), PARAMETER :: M8N5FByi = 1688 - INTEGER(IntKi), PARAMETER :: M8N6FByi = 1689 - INTEGER(IntKi), PARAMETER :: M8N7FByi = 1690 - INTEGER(IntKi), PARAMETER :: M8N8FByi = 1691 - INTEGER(IntKi), PARAMETER :: M8N9FByi = 1692 - INTEGER(IntKi), PARAMETER :: M9N1FByi = 1693 - INTEGER(IntKi), PARAMETER :: M9N2FByi = 1694 - INTEGER(IntKi), PARAMETER :: M9N3FByi = 1695 - INTEGER(IntKi), PARAMETER :: M9N4FByi = 1696 - INTEGER(IntKi), PARAMETER :: M9N5FByi = 1697 - INTEGER(IntKi), PARAMETER :: M9N6FByi = 1698 - INTEGER(IntKi), PARAMETER :: M9N7FByi = 1699 - INTEGER(IntKi), PARAMETER :: M9N8FByi = 1700 - INTEGER(IntKi), PARAMETER :: M9N9FByi = 1701 - INTEGER(IntKi), PARAMETER :: M1N1FBzi = 1702 - INTEGER(IntKi), PARAMETER :: M1N2FBzi = 1703 - INTEGER(IntKi), PARAMETER :: M1N3FBzi = 1704 - INTEGER(IntKi), PARAMETER :: M1N4FBzi = 1705 - INTEGER(IntKi), PARAMETER :: M1N5FBzi = 1706 - INTEGER(IntKi), PARAMETER :: M1N6FBzi = 1707 - INTEGER(IntKi), PARAMETER :: M1N7FBzi = 1708 - INTEGER(IntKi), PARAMETER :: M1N8FBzi = 1709 - INTEGER(IntKi), PARAMETER :: M1N9FBzi = 1710 - INTEGER(IntKi), PARAMETER :: M2N1FBzi = 1711 - INTEGER(IntKi), PARAMETER :: M2N2FBzi = 1712 - INTEGER(IntKi), PARAMETER :: M2N3FBzi = 1713 - INTEGER(IntKi), PARAMETER :: M2N4FBzi = 1714 - INTEGER(IntKi), PARAMETER :: M2N5FBzi = 1715 - INTEGER(IntKi), PARAMETER :: M2N6FBzi = 1716 - INTEGER(IntKi), PARAMETER :: M2N7FBzi = 1717 - INTEGER(IntKi), PARAMETER :: M2N8FBzi = 1718 - INTEGER(IntKi), PARAMETER :: M2N9FBzi = 1719 - INTEGER(IntKi), PARAMETER :: M3N1FBzi = 1720 - INTEGER(IntKi), PARAMETER :: M3N2FBzi = 1721 - INTEGER(IntKi), PARAMETER :: M3N3FBzi = 1722 - INTEGER(IntKi), PARAMETER :: M3N4FBzi = 1723 - INTEGER(IntKi), PARAMETER :: M3N5FBzi = 1724 - INTEGER(IntKi), PARAMETER :: M3N6FBzi = 1725 - INTEGER(IntKi), PARAMETER :: M3N7FBzi = 1726 - INTEGER(IntKi), PARAMETER :: M3N8FBzi = 1727 - INTEGER(IntKi), PARAMETER :: M3N9FBzi = 1728 - INTEGER(IntKi), PARAMETER :: M4N1FBzi = 1729 - INTEGER(IntKi), PARAMETER :: M4N2FBzi = 1730 - INTEGER(IntKi), PARAMETER :: M4N3FBzi = 1731 - INTEGER(IntKi), PARAMETER :: M4N4FBzi = 1732 - INTEGER(IntKi), PARAMETER :: M4N5FBzi = 1733 - INTEGER(IntKi), PARAMETER :: M4N6FBzi = 1734 - INTEGER(IntKi), PARAMETER :: M4N7FBzi = 1735 - INTEGER(IntKi), PARAMETER :: M4N8FBzi = 1736 - INTEGER(IntKi), PARAMETER :: M4N9FBzi = 1737 - INTEGER(IntKi), PARAMETER :: M5N1FBzi = 1738 - INTEGER(IntKi), PARAMETER :: M5N2FBzi = 1739 - INTEGER(IntKi), PARAMETER :: M5N3FBzi = 1740 - INTEGER(IntKi), PARAMETER :: M5N4FBzi = 1741 - INTEGER(IntKi), PARAMETER :: M5N5FBzi = 1742 - INTEGER(IntKi), PARAMETER :: M5N6FBzi = 1743 - INTEGER(IntKi), PARAMETER :: M5N7FBzi = 1744 - INTEGER(IntKi), PARAMETER :: M5N8FBzi = 1745 - INTEGER(IntKi), PARAMETER :: M5N9FBzi = 1746 - INTEGER(IntKi), PARAMETER :: M6N1FBzi = 1747 - INTEGER(IntKi), PARAMETER :: M6N2FBzi = 1748 - INTEGER(IntKi), PARAMETER :: M6N3FBzi = 1749 - INTEGER(IntKi), PARAMETER :: M6N4FBzi = 1750 - INTEGER(IntKi), PARAMETER :: M6N5FBzi = 1751 - INTEGER(IntKi), PARAMETER :: M6N6FBzi = 1752 - INTEGER(IntKi), PARAMETER :: M6N7FBzi = 1753 - INTEGER(IntKi), PARAMETER :: M6N8FBzi = 1754 - INTEGER(IntKi), PARAMETER :: M6N9FBzi = 1755 - INTEGER(IntKi), PARAMETER :: M7N1FBzi = 1756 - INTEGER(IntKi), PARAMETER :: M7N2FBzi = 1757 - INTEGER(IntKi), PARAMETER :: M7N3FBzi = 1758 - INTEGER(IntKi), PARAMETER :: M7N4FBzi = 1759 - INTEGER(IntKi), PARAMETER :: M7N5FBzi = 1760 - INTEGER(IntKi), PARAMETER :: M7N6FBzi = 1761 - INTEGER(IntKi), PARAMETER :: M7N7FBzi = 1762 - INTEGER(IntKi), PARAMETER :: M7N8FBzi = 1763 - INTEGER(IntKi), PARAMETER :: M7N9FBzi = 1764 - INTEGER(IntKi), PARAMETER :: M8N1FBzi = 1765 - INTEGER(IntKi), PARAMETER :: M8N2FBzi = 1766 - INTEGER(IntKi), PARAMETER :: M8N3FBzi = 1767 - INTEGER(IntKi), PARAMETER :: M8N4FBzi = 1768 - INTEGER(IntKi), PARAMETER :: M8N5FBzi = 1769 - INTEGER(IntKi), PARAMETER :: M8N6FBzi = 1770 - INTEGER(IntKi), PARAMETER :: M8N7FBzi = 1771 - INTEGER(IntKi), PARAMETER :: M8N8FBzi = 1772 - INTEGER(IntKi), PARAMETER :: M8N9FBzi = 1773 - INTEGER(IntKi), PARAMETER :: M9N1FBzi = 1774 - INTEGER(IntKi), PARAMETER :: M9N2FBzi = 1775 - INTEGER(IntKi), PARAMETER :: M9N3FBzi = 1776 - INTEGER(IntKi), PARAMETER :: M9N4FBzi = 1777 - INTEGER(IntKi), PARAMETER :: M9N5FBzi = 1778 - INTEGER(IntKi), PARAMETER :: M9N6FBzi = 1779 - INTEGER(IntKi), PARAMETER :: M9N7FBzi = 1780 - INTEGER(IntKi), PARAMETER :: M9N8FBzi = 1781 - INTEGER(IntKi), PARAMETER :: M9N9FBzi = 1782 - INTEGER(IntKi), PARAMETER :: M1N1MBxi = 1783 - INTEGER(IntKi), PARAMETER :: M1N2MBxi = 1784 - INTEGER(IntKi), PARAMETER :: M1N3MBxi = 1785 - INTEGER(IntKi), PARAMETER :: M1N4MBxi = 1786 - INTEGER(IntKi), PARAMETER :: M1N5MBxi = 1787 - INTEGER(IntKi), PARAMETER :: M1N6MBxi = 1788 - INTEGER(IntKi), PARAMETER :: M1N7MBxi = 1789 - INTEGER(IntKi), PARAMETER :: M1N8MBxi = 1790 - INTEGER(IntKi), PARAMETER :: M1N9MBxi = 1791 - INTEGER(IntKi), PARAMETER :: M2N1MBxi = 1792 - INTEGER(IntKi), PARAMETER :: M2N2MBxi = 1793 - INTEGER(IntKi), PARAMETER :: M2N3MBxi = 1794 - INTEGER(IntKi), PARAMETER :: M2N4MBxi = 1795 - INTEGER(IntKi), PARAMETER :: M2N5MBxi = 1796 - INTEGER(IntKi), PARAMETER :: M2N6MBxi = 1797 - INTEGER(IntKi), PARAMETER :: M2N7MBxi = 1798 - INTEGER(IntKi), PARAMETER :: M2N8MBxi = 1799 - INTEGER(IntKi), PARAMETER :: M2N9MBxi = 1800 - INTEGER(IntKi), PARAMETER :: M3N1MBxi = 1801 - INTEGER(IntKi), PARAMETER :: M3N2MBxi = 1802 - INTEGER(IntKi), PARAMETER :: M3N3MBxi = 1803 - INTEGER(IntKi), PARAMETER :: M3N4MBxi = 1804 - INTEGER(IntKi), PARAMETER :: M3N5MBxi = 1805 - INTEGER(IntKi), PARAMETER :: M3N6MBxi = 1806 - INTEGER(IntKi), PARAMETER :: M3N7MBxi = 1807 - INTEGER(IntKi), PARAMETER :: M3N8MBxi = 1808 - INTEGER(IntKi), PARAMETER :: M3N9MBxi = 1809 - INTEGER(IntKi), PARAMETER :: M4N1MBxi = 1810 - INTEGER(IntKi), PARAMETER :: M4N2MBxi = 1811 - INTEGER(IntKi), PARAMETER :: M4N3MBxi = 1812 - INTEGER(IntKi), PARAMETER :: M4N4MBxi = 1813 - INTEGER(IntKi), PARAMETER :: M4N5MBxi = 1814 - INTEGER(IntKi), PARAMETER :: M4N6MBxi = 1815 - INTEGER(IntKi), PARAMETER :: M4N7MBxi = 1816 - INTEGER(IntKi), PARAMETER :: M4N8MBxi = 1817 - INTEGER(IntKi), PARAMETER :: M4N9MBxi = 1818 - INTEGER(IntKi), PARAMETER :: M5N1MBxi = 1819 - INTEGER(IntKi), PARAMETER :: M5N2MBxi = 1820 - INTEGER(IntKi), PARAMETER :: M5N3MBxi = 1821 - INTEGER(IntKi), PARAMETER :: M5N4MBxi = 1822 - INTEGER(IntKi), PARAMETER :: M5N5MBxi = 1823 - INTEGER(IntKi), PARAMETER :: M5N6MBxi = 1824 - INTEGER(IntKi), PARAMETER :: M5N7MBxi = 1825 - INTEGER(IntKi), PARAMETER :: M5N8MBxi = 1826 - INTEGER(IntKi), PARAMETER :: M5N9MBxi = 1827 - INTEGER(IntKi), PARAMETER :: M6N1MBxi = 1828 - INTEGER(IntKi), PARAMETER :: M6N2MBxi = 1829 - INTEGER(IntKi), PARAMETER :: M6N3MBxi = 1830 - INTEGER(IntKi), PARAMETER :: M6N4MBxi = 1831 - INTEGER(IntKi), PARAMETER :: M6N5MBxi = 1832 - INTEGER(IntKi), PARAMETER :: M6N6MBxi = 1833 - INTEGER(IntKi), PARAMETER :: M6N7MBxi = 1834 - INTEGER(IntKi), PARAMETER :: M6N8MBxi = 1835 - INTEGER(IntKi), PARAMETER :: M6N9MBxi = 1836 - INTEGER(IntKi), PARAMETER :: M7N1MBxi = 1837 - INTEGER(IntKi), PARAMETER :: M7N2MBxi = 1838 - INTEGER(IntKi), PARAMETER :: M7N3MBxi = 1839 - INTEGER(IntKi), PARAMETER :: M7N4MBxi = 1840 - INTEGER(IntKi), PARAMETER :: M7N5MBxi = 1841 - INTEGER(IntKi), PARAMETER :: M7N6MBxi = 1842 - INTEGER(IntKi), PARAMETER :: M7N7MBxi = 1843 - INTEGER(IntKi), PARAMETER :: M7N8MBxi = 1844 - INTEGER(IntKi), PARAMETER :: M7N9MBxi = 1845 - INTEGER(IntKi), PARAMETER :: M8N1MBxi = 1846 - INTEGER(IntKi), PARAMETER :: M8N2MBxi = 1847 - INTEGER(IntKi), PARAMETER :: M8N3MBxi = 1848 - INTEGER(IntKi), PARAMETER :: M8N4MBxi = 1849 - INTEGER(IntKi), PARAMETER :: M8N5MBxi = 1850 - INTEGER(IntKi), PARAMETER :: M8N6MBxi = 1851 - INTEGER(IntKi), PARAMETER :: M8N7MBxi = 1852 - INTEGER(IntKi), PARAMETER :: M8N8MBxi = 1853 - INTEGER(IntKi), PARAMETER :: M8N9MBxi = 1854 - INTEGER(IntKi), PARAMETER :: M9N1MBxi = 1855 - INTEGER(IntKi), PARAMETER :: M9N2MBxi = 1856 - INTEGER(IntKi), PARAMETER :: M9N3MBxi = 1857 - INTEGER(IntKi), PARAMETER :: M9N4MBxi = 1858 - INTEGER(IntKi), PARAMETER :: M9N5MBxi = 1859 - INTEGER(IntKi), PARAMETER :: M9N6MBxi = 1860 - INTEGER(IntKi), PARAMETER :: M9N7MBxi = 1861 - INTEGER(IntKi), PARAMETER :: M9N8MBxi = 1862 - INTEGER(IntKi), PARAMETER :: M9N9MBxi = 1863 - INTEGER(IntKi), PARAMETER :: M1N1MByi = 1864 - INTEGER(IntKi), PARAMETER :: M1N2MByi = 1865 - INTEGER(IntKi), PARAMETER :: M1N3MByi = 1866 - INTEGER(IntKi), PARAMETER :: M1N4MByi = 1867 - INTEGER(IntKi), PARAMETER :: M1N5MByi = 1868 - INTEGER(IntKi), PARAMETER :: M1N6MByi = 1869 - INTEGER(IntKi), PARAMETER :: M1N7MByi = 1870 - INTEGER(IntKi), PARAMETER :: M1N8MByi = 1871 - INTEGER(IntKi), PARAMETER :: M1N9MByi = 1872 - INTEGER(IntKi), PARAMETER :: M2N1MByi = 1873 - INTEGER(IntKi), PARAMETER :: M2N2MByi = 1874 - INTEGER(IntKi), PARAMETER :: M2N3MByi = 1875 - INTEGER(IntKi), PARAMETER :: M2N4MByi = 1876 - INTEGER(IntKi), PARAMETER :: M2N5MByi = 1877 - INTEGER(IntKi), PARAMETER :: M2N6MByi = 1878 - INTEGER(IntKi), PARAMETER :: M2N7MByi = 1879 - INTEGER(IntKi), PARAMETER :: M2N8MByi = 1880 - INTEGER(IntKi), PARAMETER :: M2N9MByi = 1881 - INTEGER(IntKi), PARAMETER :: M3N1MByi = 1882 - INTEGER(IntKi), PARAMETER :: M3N2MByi = 1883 - INTEGER(IntKi), PARAMETER :: M3N3MByi = 1884 - INTEGER(IntKi), PARAMETER :: M3N4MByi = 1885 - INTEGER(IntKi), PARAMETER :: M3N5MByi = 1886 - INTEGER(IntKi), PARAMETER :: M3N6MByi = 1887 - INTEGER(IntKi), PARAMETER :: M3N7MByi = 1888 - INTEGER(IntKi), PARAMETER :: M3N8MByi = 1889 - INTEGER(IntKi), PARAMETER :: M3N9MByi = 1890 - INTEGER(IntKi), PARAMETER :: M4N1MByi = 1891 - INTEGER(IntKi), PARAMETER :: M4N2MByi = 1892 - INTEGER(IntKi), PARAMETER :: M4N3MByi = 1893 - INTEGER(IntKi), PARAMETER :: M4N4MByi = 1894 - INTEGER(IntKi), PARAMETER :: M4N5MByi = 1895 - INTEGER(IntKi), PARAMETER :: M4N6MByi = 1896 - INTEGER(IntKi), PARAMETER :: M4N7MByi = 1897 - INTEGER(IntKi), PARAMETER :: M4N8MByi = 1898 - INTEGER(IntKi), PARAMETER :: M4N9MByi = 1899 - INTEGER(IntKi), PARAMETER :: M5N1MByi = 1900 - INTEGER(IntKi), PARAMETER :: M5N2MByi = 1901 - INTEGER(IntKi), PARAMETER :: M5N3MByi = 1902 - INTEGER(IntKi), PARAMETER :: M5N4MByi = 1903 - INTEGER(IntKi), PARAMETER :: M5N5MByi = 1904 - INTEGER(IntKi), PARAMETER :: M5N6MByi = 1905 - INTEGER(IntKi), PARAMETER :: M5N7MByi = 1906 - INTEGER(IntKi), PARAMETER :: M5N8MByi = 1907 - INTEGER(IntKi), PARAMETER :: M5N9MByi = 1908 - INTEGER(IntKi), PARAMETER :: M6N1MByi = 1909 - INTEGER(IntKi), PARAMETER :: M6N2MByi = 1910 - INTEGER(IntKi), PARAMETER :: M6N3MByi = 1911 - INTEGER(IntKi), PARAMETER :: M6N4MByi = 1912 - INTEGER(IntKi), PARAMETER :: M6N5MByi = 1913 - INTEGER(IntKi), PARAMETER :: M6N6MByi = 1914 - INTEGER(IntKi), PARAMETER :: M6N7MByi = 1915 - INTEGER(IntKi), PARAMETER :: M6N8MByi = 1916 - INTEGER(IntKi), PARAMETER :: M6N9MByi = 1917 - INTEGER(IntKi), PARAMETER :: M7N1MByi = 1918 - INTEGER(IntKi), PARAMETER :: M7N2MByi = 1919 - INTEGER(IntKi), PARAMETER :: M7N3MByi = 1920 - INTEGER(IntKi), PARAMETER :: M7N4MByi = 1921 - INTEGER(IntKi), PARAMETER :: M7N5MByi = 1922 - INTEGER(IntKi), PARAMETER :: M7N6MByi = 1923 - INTEGER(IntKi), PARAMETER :: M7N7MByi = 1924 - INTEGER(IntKi), PARAMETER :: M7N8MByi = 1925 - INTEGER(IntKi), PARAMETER :: M7N9MByi = 1926 - INTEGER(IntKi), PARAMETER :: M8N1MByi = 1927 - INTEGER(IntKi), PARAMETER :: M8N2MByi = 1928 - INTEGER(IntKi), PARAMETER :: M8N3MByi = 1929 - INTEGER(IntKi), PARAMETER :: M8N4MByi = 1930 - INTEGER(IntKi), PARAMETER :: M8N5MByi = 1931 - INTEGER(IntKi), PARAMETER :: M8N6MByi = 1932 - INTEGER(IntKi), PARAMETER :: M8N7MByi = 1933 - INTEGER(IntKi), PARAMETER :: M8N8MByi = 1934 - INTEGER(IntKi), PARAMETER :: M8N9MByi = 1935 - INTEGER(IntKi), PARAMETER :: M9N1MByi = 1936 - INTEGER(IntKi), PARAMETER :: M9N2MByi = 1937 - INTEGER(IntKi), PARAMETER :: M9N3MByi = 1938 - INTEGER(IntKi), PARAMETER :: M9N4MByi = 1939 - INTEGER(IntKi), PARAMETER :: M9N5MByi = 1940 - INTEGER(IntKi), PARAMETER :: M9N6MByi = 1941 - INTEGER(IntKi), PARAMETER :: M9N7MByi = 1942 - INTEGER(IntKi), PARAMETER :: M9N8MByi = 1943 - INTEGER(IntKi), PARAMETER :: M9N9MByi = 1944 - INTEGER(IntKi), PARAMETER :: M1N1MBzi = 1945 - INTEGER(IntKi), PARAMETER :: M1N2MBzi = 1946 - INTEGER(IntKi), PARAMETER :: M1N3MBzi = 1947 - INTEGER(IntKi), PARAMETER :: M1N4MBzi = 1948 - INTEGER(IntKi), PARAMETER :: M1N5MBzi = 1949 - INTEGER(IntKi), PARAMETER :: M1N6MBzi = 1950 - INTEGER(IntKi), PARAMETER :: M1N7MBzi = 1951 - INTEGER(IntKi), PARAMETER :: M1N8MBzi = 1952 - INTEGER(IntKi), PARAMETER :: M1N9MBzi = 1953 - INTEGER(IntKi), PARAMETER :: M2N1MBzi = 1954 - INTEGER(IntKi), PARAMETER :: M2N2MBzi = 1955 - INTEGER(IntKi), PARAMETER :: M2N3MBzi = 1956 - INTEGER(IntKi), PARAMETER :: M2N4MBzi = 1957 - INTEGER(IntKi), PARAMETER :: M2N5MBzi = 1958 - INTEGER(IntKi), PARAMETER :: M2N6MBzi = 1959 - INTEGER(IntKi), PARAMETER :: M2N7MBzi = 1960 - INTEGER(IntKi), PARAMETER :: M2N8MBzi = 1961 - INTEGER(IntKi), PARAMETER :: M2N9MBzi = 1962 - INTEGER(IntKi), PARAMETER :: M3N1MBzi = 1963 - INTEGER(IntKi), PARAMETER :: M3N2MBzi = 1964 - INTEGER(IntKi), PARAMETER :: M3N3MBzi = 1965 - INTEGER(IntKi), PARAMETER :: M3N4MBzi = 1966 - INTEGER(IntKi), PARAMETER :: M3N5MBzi = 1967 - INTEGER(IntKi), PARAMETER :: M3N6MBzi = 1968 - INTEGER(IntKi), PARAMETER :: M3N7MBzi = 1969 - INTEGER(IntKi), PARAMETER :: M3N8MBzi = 1970 - INTEGER(IntKi), PARAMETER :: M3N9MBzi = 1971 - INTEGER(IntKi), PARAMETER :: M4N1MBzi = 1972 - INTEGER(IntKi), PARAMETER :: M4N2MBzi = 1973 - INTEGER(IntKi), PARAMETER :: M4N3MBzi = 1974 - INTEGER(IntKi), PARAMETER :: M4N4MBzi = 1975 - INTEGER(IntKi), PARAMETER :: M4N5MBzi = 1976 - INTEGER(IntKi), PARAMETER :: M4N6MBzi = 1977 - INTEGER(IntKi), PARAMETER :: M4N7MBzi = 1978 - INTEGER(IntKi), PARAMETER :: M4N8MBzi = 1979 - INTEGER(IntKi), PARAMETER :: M4N9MBzi = 1980 - INTEGER(IntKi), PARAMETER :: M5N1MBzi = 1981 - INTEGER(IntKi), PARAMETER :: M5N2MBzi = 1982 - INTEGER(IntKi), PARAMETER :: M5N3MBzi = 1983 - INTEGER(IntKi), PARAMETER :: M5N4MBzi = 1984 - INTEGER(IntKi), PARAMETER :: M5N5MBzi = 1985 - INTEGER(IntKi), PARAMETER :: M5N6MBzi = 1986 - INTEGER(IntKi), PARAMETER :: M5N7MBzi = 1987 - INTEGER(IntKi), PARAMETER :: M5N8MBzi = 1988 - INTEGER(IntKi), PARAMETER :: M5N9MBzi = 1989 - INTEGER(IntKi), PARAMETER :: M6N1MBzi = 1990 - INTEGER(IntKi), PARAMETER :: M6N2MBzi = 1991 - INTEGER(IntKi), PARAMETER :: M6N3MBzi = 1992 - INTEGER(IntKi), PARAMETER :: M6N4MBzi = 1993 - INTEGER(IntKi), PARAMETER :: M6N5MBzi = 1994 - INTEGER(IntKi), PARAMETER :: M6N6MBzi = 1995 - INTEGER(IntKi), PARAMETER :: M6N7MBzi = 1996 - INTEGER(IntKi), PARAMETER :: M6N8MBzi = 1997 - INTEGER(IntKi), PARAMETER :: M6N9MBzi = 1998 - INTEGER(IntKi), PARAMETER :: M7N1MBzi = 1999 - INTEGER(IntKi), PARAMETER :: M7N2MBzi = 2000 - INTEGER(IntKi), PARAMETER :: M7N3MBzi = 2001 - INTEGER(IntKi), PARAMETER :: M7N4MBzi = 2002 - INTEGER(IntKi), PARAMETER :: M7N5MBzi = 2003 - INTEGER(IntKi), PARAMETER :: M7N6MBzi = 2004 - INTEGER(IntKi), PARAMETER :: M7N7MBzi = 2005 - INTEGER(IntKi), PARAMETER :: M7N8MBzi = 2006 - INTEGER(IntKi), PARAMETER :: M7N9MBzi = 2007 - INTEGER(IntKi), PARAMETER :: M8N1MBzi = 2008 - INTEGER(IntKi), PARAMETER :: M8N2MBzi = 2009 - INTEGER(IntKi), PARAMETER :: M8N3MBzi = 2010 - INTEGER(IntKi), PARAMETER :: M8N4MBzi = 2011 - INTEGER(IntKi), PARAMETER :: M8N5MBzi = 2012 - INTEGER(IntKi), PARAMETER :: M8N6MBzi = 2013 - INTEGER(IntKi), PARAMETER :: M8N7MBzi = 2014 - INTEGER(IntKi), PARAMETER :: M8N8MBzi = 2015 - INTEGER(IntKi), PARAMETER :: M8N9MBzi = 2016 - INTEGER(IntKi), PARAMETER :: M9N1MBzi = 2017 - INTEGER(IntKi), PARAMETER :: M9N2MBzi = 2018 - INTEGER(IntKi), PARAMETER :: M9N3MBzi = 2019 - INTEGER(IntKi), PARAMETER :: M9N4MBzi = 2020 - INTEGER(IntKi), PARAMETER :: M9N5MBzi = 2021 - INTEGER(IntKi), PARAMETER :: M9N6MBzi = 2022 - INTEGER(IntKi), PARAMETER :: M9N7MBzi = 2023 - INTEGER(IntKi), PARAMETER :: M9N8MBzi = 2024 - INTEGER(IntKi), PARAMETER :: M9N9MBzi = 2025 - INTEGER(IntKi), PARAMETER :: M1N1FBFxi = 2026 - INTEGER(IntKi), PARAMETER :: M1N2FBFxi = 2027 - INTEGER(IntKi), PARAMETER :: M1N3FBFxi = 2028 - INTEGER(IntKi), PARAMETER :: M1N4FBFxi = 2029 - INTEGER(IntKi), PARAMETER :: M1N5FBFxi = 2030 - INTEGER(IntKi), PARAMETER :: M1N6FBFxi = 2031 - INTEGER(IntKi), PARAMETER :: M1N7FBFxi = 2032 - INTEGER(IntKi), PARAMETER :: M1N8FBFxi = 2033 - INTEGER(IntKi), PARAMETER :: M1N9FBFxi = 2034 - INTEGER(IntKi), PARAMETER :: M2N1FBFxi = 2035 - INTEGER(IntKi), PARAMETER :: M2N2FBFxi = 2036 - INTEGER(IntKi), PARAMETER :: M2N3FBFxi = 2037 - INTEGER(IntKi), PARAMETER :: M2N4FBFxi = 2038 - INTEGER(IntKi), PARAMETER :: M2N5FBFxi = 2039 - INTEGER(IntKi), PARAMETER :: M2N6FBFxi = 2040 - INTEGER(IntKi), PARAMETER :: M2N7FBFxi = 2041 - INTEGER(IntKi), PARAMETER :: M2N8FBFxi = 2042 - INTEGER(IntKi), PARAMETER :: M2N9FBFxi = 2043 - INTEGER(IntKi), PARAMETER :: M3N1FBFxi = 2044 - INTEGER(IntKi), PARAMETER :: M3N2FBFxi = 2045 - INTEGER(IntKi), PARAMETER :: M3N3FBFxi = 2046 - INTEGER(IntKi), PARAMETER :: M3N4FBFxi = 2047 - INTEGER(IntKi), PARAMETER :: M3N5FBFxi = 2048 - INTEGER(IntKi), PARAMETER :: M3N6FBFxi = 2049 - INTEGER(IntKi), PARAMETER :: M3N7FBFxi = 2050 - INTEGER(IntKi), PARAMETER :: M3N8FBFxi = 2051 - INTEGER(IntKi), PARAMETER :: M3N9FBFxi = 2052 - INTEGER(IntKi), PARAMETER :: M4N1FBFxi = 2053 - INTEGER(IntKi), PARAMETER :: M4N2FBFxi = 2054 - INTEGER(IntKi), PARAMETER :: M4N3FBFxi = 2055 - INTEGER(IntKi), PARAMETER :: M4N4FBFxi = 2056 - INTEGER(IntKi), PARAMETER :: M4N5FBFxi = 2057 - INTEGER(IntKi), PARAMETER :: M4N6FBFxi = 2058 - INTEGER(IntKi), PARAMETER :: M4N7FBFxi = 2059 - INTEGER(IntKi), PARAMETER :: M4N8FBFxi = 2060 - INTEGER(IntKi), PARAMETER :: M4N9FBFxi = 2061 - INTEGER(IntKi), PARAMETER :: M5N1FBFxi = 2062 - INTEGER(IntKi), PARAMETER :: M5N2FBFxi = 2063 - INTEGER(IntKi), PARAMETER :: M5N3FBFxi = 2064 - INTEGER(IntKi), PARAMETER :: M5N4FBFxi = 2065 - INTEGER(IntKi), PARAMETER :: M5N5FBFxi = 2066 - INTEGER(IntKi), PARAMETER :: M5N6FBFxi = 2067 - INTEGER(IntKi), PARAMETER :: M5N7FBFxi = 2068 - INTEGER(IntKi), PARAMETER :: M5N8FBFxi = 2069 - INTEGER(IntKi), PARAMETER :: M5N9FBFxi = 2070 - INTEGER(IntKi), PARAMETER :: M6N1FBFxi = 2071 - INTEGER(IntKi), PARAMETER :: M6N2FBFxi = 2072 - INTEGER(IntKi), PARAMETER :: M6N3FBFxi = 2073 - INTEGER(IntKi), PARAMETER :: M6N4FBFxi = 2074 - INTEGER(IntKi), PARAMETER :: M6N5FBFxi = 2075 - INTEGER(IntKi), PARAMETER :: M6N6FBFxi = 2076 - INTEGER(IntKi), PARAMETER :: M6N7FBFxi = 2077 - INTEGER(IntKi), PARAMETER :: M6N8FBFxi = 2078 - INTEGER(IntKi), PARAMETER :: M6N9FBFxi = 2079 - INTEGER(IntKi), PARAMETER :: M7N1FBFxi = 2080 - INTEGER(IntKi), PARAMETER :: M7N2FBFxi = 2081 - INTEGER(IntKi), PARAMETER :: M7N3FBFxi = 2082 - INTEGER(IntKi), PARAMETER :: M7N4FBFxi = 2083 - INTEGER(IntKi), PARAMETER :: M7N5FBFxi = 2084 - INTEGER(IntKi), PARAMETER :: M7N6FBFxi = 2085 - INTEGER(IntKi), PARAMETER :: M7N7FBFxi = 2086 - INTEGER(IntKi), PARAMETER :: M7N8FBFxi = 2087 - INTEGER(IntKi), PARAMETER :: M7N9FBFxi = 2088 - INTEGER(IntKi), PARAMETER :: M8N1FBFxi = 2089 - INTEGER(IntKi), PARAMETER :: M8N2FBFxi = 2090 - INTEGER(IntKi), PARAMETER :: M8N3FBFxi = 2091 - INTEGER(IntKi), PARAMETER :: M8N4FBFxi = 2092 - INTEGER(IntKi), PARAMETER :: M8N5FBFxi = 2093 - INTEGER(IntKi), PARAMETER :: M8N6FBFxi = 2094 - INTEGER(IntKi), PARAMETER :: M8N7FBFxi = 2095 - INTEGER(IntKi), PARAMETER :: M8N8FBFxi = 2096 - INTEGER(IntKi), PARAMETER :: M8N9FBFxi = 2097 - INTEGER(IntKi), PARAMETER :: M9N1FBFxi = 2098 - INTEGER(IntKi), PARAMETER :: M9N2FBFxi = 2099 - INTEGER(IntKi), PARAMETER :: M9N3FBFxi = 2100 - INTEGER(IntKi), PARAMETER :: M9N4FBFxi = 2101 - INTEGER(IntKi), PARAMETER :: M9N5FBFxi = 2102 - INTEGER(IntKi), PARAMETER :: M9N6FBFxi = 2103 - INTEGER(IntKi), PARAMETER :: M9N7FBFxi = 2104 - INTEGER(IntKi), PARAMETER :: M9N8FBFxi = 2105 - INTEGER(IntKi), PARAMETER :: M9N9FBFxi = 2106 - INTEGER(IntKi), PARAMETER :: M1N1FBFyi = 2107 - INTEGER(IntKi), PARAMETER :: M1N2FBFyi = 2108 - INTEGER(IntKi), PARAMETER :: M1N3FBFyi = 2109 - INTEGER(IntKi), PARAMETER :: M1N4FBFyi = 2110 - INTEGER(IntKi), PARAMETER :: M1N5FBFyi = 2111 - INTEGER(IntKi), PARAMETER :: M1N6FBFyi = 2112 - INTEGER(IntKi), PARAMETER :: M1N7FBFyi = 2113 - INTEGER(IntKi), PARAMETER :: M1N8FBFyi = 2114 - INTEGER(IntKi), PARAMETER :: M1N9FBFyi = 2115 - INTEGER(IntKi), PARAMETER :: M2N1FBFyi = 2116 - INTEGER(IntKi), PARAMETER :: M2N2FBFyi = 2117 - INTEGER(IntKi), PARAMETER :: M2N3FBFyi = 2118 - INTEGER(IntKi), PARAMETER :: M2N4FBFyi = 2119 - INTEGER(IntKi), PARAMETER :: M2N5FBFyi = 2120 - INTEGER(IntKi), PARAMETER :: M2N6FBFyi = 2121 - INTEGER(IntKi), PARAMETER :: M2N7FBFyi = 2122 - INTEGER(IntKi), PARAMETER :: M2N8FBFyi = 2123 - INTEGER(IntKi), PARAMETER :: M2N9FBFyi = 2124 - INTEGER(IntKi), PARAMETER :: M3N1FBFyi = 2125 - INTEGER(IntKi), PARAMETER :: M3N2FBFyi = 2126 - INTEGER(IntKi), PARAMETER :: M3N3FBFyi = 2127 - INTEGER(IntKi), PARAMETER :: M3N4FBFyi = 2128 - INTEGER(IntKi), PARAMETER :: M3N5FBFyi = 2129 - INTEGER(IntKi), PARAMETER :: M3N6FBFyi = 2130 - INTEGER(IntKi), PARAMETER :: M3N7FBFyi = 2131 - INTEGER(IntKi), PARAMETER :: M3N8FBFyi = 2132 - INTEGER(IntKi), PARAMETER :: M3N9FBFyi = 2133 - INTEGER(IntKi), PARAMETER :: M4N1FBFyi = 2134 - INTEGER(IntKi), PARAMETER :: M4N2FBFyi = 2135 - INTEGER(IntKi), PARAMETER :: M4N3FBFyi = 2136 - INTEGER(IntKi), PARAMETER :: M4N4FBFyi = 2137 - INTEGER(IntKi), PARAMETER :: M4N5FBFyi = 2138 - INTEGER(IntKi), PARAMETER :: M4N6FBFyi = 2139 - INTEGER(IntKi), PARAMETER :: M4N7FBFyi = 2140 - INTEGER(IntKi), PARAMETER :: M4N8FBFyi = 2141 - INTEGER(IntKi), PARAMETER :: M4N9FBFyi = 2142 - INTEGER(IntKi), PARAMETER :: M5N1FBFyi = 2143 - INTEGER(IntKi), PARAMETER :: M5N2FBFyi = 2144 - INTEGER(IntKi), PARAMETER :: M5N3FBFyi = 2145 - INTEGER(IntKi), PARAMETER :: M5N4FBFyi = 2146 - INTEGER(IntKi), PARAMETER :: M5N5FBFyi = 2147 - INTEGER(IntKi), PARAMETER :: M5N6FBFyi = 2148 - INTEGER(IntKi), PARAMETER :: M5N7FBFyi = 2149 - INTEGER(IntKi), PARAMETER :: M5N8FBFyi = 2150 - INTEGER(IntKi), PARAMETER :: M5N9FBFyi = 2151 - INTEGER(IntKi), PARAMETER :: M6N1FBFyi = 2152 - INTEGER(IntKi), PARAMETER :: M6N2FBFyi = 2153 - INTEGER(IntKi), PARAMETER :: M6N3FBFyi = 2154 - INTEGER(IntKi), PARAMETER :: M6N4FBFyi = 2155 - INTEGER(IntKi), PARAMETER :: M6N5FBFyi = 2156 - INTEGER(IntKi), PARAMETER :: M6N6FBFyi = 2157 - INTEGER(IntKi), PARAMETER :: M6N7FBFyi = 2158 - INTEGER(IntKi), PARAMETER :: M6N8FBFyi = 2159 - INTEGER(IntKi), PARAMETER :: M6N9FBFyi = 2160 - INTEGER(IntKi), PARAMETER :: M7N1FBFyi = 2161 - INTEGER(IntKi), PARAMETER :: M7N2FBFyi = 2162 - INTEGER(IntKi), PARAMETER :: M7N3FBFyi = 2163 - INTEGER(IntKi), PARAMETER :: M7N4FBFyi = 2164 - INTEGER(IntKi), PARAMETER :: M7N5FBFyi = 2165 - INTEGER(IntKi), PARAMETER :: M7N6FBFyi = 2166 - INTEGER(IntKi), PARAMETER :: M7N7FBFyi = 2167 - INTEGER(IntKi), PARAMETER :: M7N8FBFyi = 2168 - INTEGER(IntKi), PARAMETER :: M7N9FBFyi = 2169 - INTEGER(IntKi), PARAMETER :: M8N1FBFyi = 2170 - INTEGER(IntKi), PARAMETER :: M8N2FBFyi = 2171 - INTEGER(IntKi), PARAMETER :: M8N3FBFyi = 2172 - INTEGER(IntKi), PARAMETER :: M8N4FBFyi = 2173 - INTEGER(IntKi), PARAMETER :: M8N5FBFyi = 2174 - INTEGER(IntKi), PARAMETER :: M8N6FBFyi = 2175 - INTEGER(IntKi), PARAMETER :: M8N7FBFyi = 2176 - INTEGER(IntKi), PARAMETER :: M8N8FBFyi = 2177 - INTEGER(IntKi), PARAMETER :: M8N9FBFyi = 2178 - INTEGER(IntKi), PARAMETER :: M9N1FBFyi = 2179 - INTEGER(IntKi), PARAMETER :: M9N2FBFyi = 2180 - INTEGER(IntKi), PARAMETER :: M9N3FBFyi = 2181 - INTEGER(IntKi), PARAMETER :: M9N4FBFyi = 2182 - INTEGER(IntKi), PARAMETER :: M9N5FBFyi = 2183 - INTEGER(IntKi), PARAMETER :: M9N6FBFyi = 2184 - INTEGER(IntKi), PARAMETER :: M9N7FBFyi = 2185 - INTEGER(IntKi), PARAMETER :: M9N8FBFyi = 2186 - INTEGER(IntKi), PARAMETER :: M9N9FBFyi = 2187 - INTEGER(IntKi), PARAMETER :: M1N1FBFzi = 2188 - INTEGER(IntKi), PARAMETER :: M1N2FBFzi = 2189 - INTEGER(IntKi), PARAMETER :: M1N3FBFzi = 2190 - INTEGER(IntKi), PARAMETER :: M1N4FBFzi = 2191 - INTEGER(IntKi), PARAMETER :: M1N5FBFzi = 2192 - INTEGER(IntKi), PARAMETER :: M1N6FBFzi = 2193 - INTEGER(IntKi), PARAMETER :: M1N7FBFzi = 2194 - INTEGER(IntKi), PARAMETER :: M1N8FBFzi = 2195 - INTEGER(IntKi), PARAMETER :: M1N9FBFzi = 2196 - INTEGER(IntKi), PARAMETER :: M2N1FBFzi = 2197 - INTEGER(IntKi), PARAMETER :: M2N2FBFzi = 2198 - INTEGER(IntKi), PARAMETER :: M2N3FBFzi = 2199 - INTEGER(IntKi), PARAMETER :: M2N4FBFzi = 2200 - INTEGER(IntKi), PARAMETER :: M2N5FBFzi = 2201 - INTEGER(IntKi), PARAMETER :: M2N6FBFzi = 2202 - INTEGER(IntKi), PARAMETER :: M2N7FBFzi = 2203 - INTEGER(IntKi), PARAMETER :: M2N8FBFzi = 2204 - INTEGER(IntKi), PARAMETER :: M2N9FBFzi = 2205 - INTEGER(IntKi), PARAMETER :: M3N1FBFzi = 2206 - INTEGER(IntKi), PARAMETER :: M3N2FBFzi = 2207 - INTEGER(IntKi), PARAMETER :: M3N3FBFzi = 2208 - INTEGER(IntKi), PARAMETER :: M3N4FBFzi = 2209 - INTEGER(IntKi), PARAMETER :: M3N5FBFzi = 2210 - INTEGER(IntKi), PARAMETER :: M3N6FBFzi = 2211 - INTEGER(IntKi), PARAMETER :: M3N7FBFzi = 2212 - INTEGER(IntKi), PARAMETER :: M3N8FBFzi = 2213 - INTEGER(IntKi), PARAMETER :: M3N9FBFzi = 2214 - INTEGER(IntKi), PARAMETER :: M4N1FBFzi = 2215 - INTEGER(IntKi), PARAMETER :: M4N2FBFzi = 2216 - INTEGER(IntKi), PARAMETER :: M4N3FBFzi = 2217 - INTEGER(IntKi), PARAMETER :: M4N4FBFzi = 2218 - INTEGER(IntKi), PARAMETER :: M4N5FBFzi = 2219 - INTEGER(IntKi), PARAMETER :: M4N6FBFzi = 2220 - INTEGER(IntKi), PARAMETER :: M4N7FBFzi = 2221 - INTEGER(IntKi), PARAMETER :: M4N8FBFzi = 2222 - INTEGER(IntKi), PARAMETER :: M4N9FBFzi = 2223 - INTEGER(IntKi), PARAMETER :: M5N1FBFzi = 2224 - INTEGER(IntKi), PARAMETER :: M5N2FBFzi = 2225 - INTEGER(IntKi), PARAMETER :: M5N3FBFzi = 2226 - INTEGER(IntKi), PARAMETER :: M5N4FBFzi = 2227 - INTEGER(IntKi), PARAMETER :: M5N5FBFzi = 2228 - INTEGER(IntKi), PARAMETER :: M5N6FBFzi = 2229 - INTEGER(IntKi), PARAMETER :: M5N7FBFzi = 2230 - INTEGER(IntKi), PARAMETER :: M5N8FBFzi = 2231 - INTEGER(IntKi), PARAMETER :: M5N9FBFzi = 2232 - INTEGER(IntKi), PARAMETER :: M6N1FBFzi = 2233 - INTEGER(IntKi), PARAMETER :: M6N2FBFzi = 2234 - INTEGER(IntKi), PARAMETER :: M6N3FBFzi = 2235 - INTEGER(IntKi), PARAMETER :: M6N4FBFzi = 2236 - INTEGER(IntKi), PARAMETER :: M6N5FBFzi = 2237 - INTEGER(IntKi), PARAMETER :: M6N6FBFzi = 2238 - INTEGER(IntKi), PARAMETER :: M6N7FBFzi = 2239 - INTEGER(IntKi), PARAMETER :: M6N8FBFzi = 2240 - INTEGER(IntKi), PARAMETER :: M6N9FBFzi = 2241 - INTEGER(IntKi), PARAMETER :: M7N1FBFzi = 2242 - INTEGER(IntKi), PARAMETER :: M7N2FBFzi = 2243 - INTEGER(IntKi), PARAMETER :: M7N3FBFzi = 2244 - INTEGER(IntKi), PARAMETER :: M7N4FBFzi = 2245 - INTEGER(IntKi), PARAMETER :: M7N5FBFzi = 2246 - INTEGER(IntKi), PARAMETER :: M7N6FBFzi = 2247 - INTEGER(IntKi), PARAMETER :: M7N7FBFzi = 2248 - INTEGER(IntKi), PARAMETER :: M7N8FBFzi = 2249 - INTEGER(IntKi), PARAMETER :: M7N9FBFzi = 2250 - INTEGER(IntKi), PARAMETER :: M8N1FBFzi = 2251 - INTEGER(IntKi), PARAMETER :: M8N2FBFzi = 2252 - INTEGER(IntKi), PARAMETER :: M8N3FBFzi = 2253 - INTEGER(IntKi), PARAMETER :: M8N4FBFzi = 2254 - INTEGER(IntKi), PARAMETER :: M8N5FBFzi = 2255 - INTEGER(IntKi), PARAMETER :: M8N6FBFzi = 2256 - INTEGER(IntKi), PARAMETER :: M8N7FBFzi = 2257 - INTEGER(IntKi), PARAMETER :: M8N8FBFzi = 2258 - INTEGER(IntKi), PARAMETER :: M8N9FBFzi = 2259 - INTEGER(IntKi), PARAMETER :: M9N1FBFzi = 2260 - INTEGER(IntKi), PARAMETER :: M9N2FBFzi = 2261 - INTEGER(IntKi), PARAMETER :: M9N3FBFzi = 2262 - INTEGER(IntKi), PARAMETER :: M9N4FBFzi = 2263 - INTEGER(IntKi), PARAMETER :: M9N5FBFzi = 2264 - INTEGER(IntKi), PARAMETER :: M9N6FBFzi = 2265 - INTEGER(IntKi), PARAMETER :: M9N7FBFzi = 2266 - INTEGER(IntKi), PARAMETER :: M9N8FBFzi = 2267 - INTEGER(IntKi), PARAMETER :: M9N9FBFzi = 2268 - INTEGER(IntKi), PARAMETER :: M1N1MBFxi = 2269 - INTEGER(IntKi), PARAMETER :: M1N2MBFxi = 2270 - INTEGER(IntKi), PARAMETER :: M1N3MBFxi = 2271 - INTEGER(IntKi), PARAMETER :: M1N4MBFxi = 2272 - INTEGER(IntKi), PARAMETER :: M1N5MBFxi = 2273 - INTEGER(IntKi), PARAMETER :: M1N6MBFxi = 2274 - INTEGER(IntKi), PARAMETER :: M1N7MBFxi = 2275 - INTEGER(IntKi), PARAMETER :: M1N8MBFxi = 2276 - INTEGER(IntKi), PARAMETER :: M1N9MBFxi = 2277 - INTEGER(IntKi), PARAMETER :: M2N1MBFxi = 2278 - INTEGER(IntKi), PARAMETER :: M2N2MBFxi = 2279 - INTEGER(IntKi), PARAMETER :: M2N3MBFxi = 2280 - INTEGER(IntKi), PARAMETER :: M2N4MBFxi = 2281 - INTEGER(IntKi), PARAMETER :: M2N5MBFxi = 2282 - INTEGER(IntKi), PARAMETER :: M2N6MBFxi = 2283 - INTEGER(IntKi), PARAMETER :: M2N7MBFxi = 2284 - INTEGER(IntKi), PARAMETER :: M2N8MBFxi = 2285 - INTEGER(IntKi), PARAMETER :: M2N9MBFxi = 2286 - INTEGER(IntKi), PARAMETER :: M3N1MBFxi = 2287 - INTEGER(IntKi), PARAMETER :: M3N2MBFxi = 2288 - INTEGER(IntKi), PARAMETER :: M3N3MBFxi = 2289 - INTEGER(IntKi), PARAMETER :: M3N4MBFxi = 2290 - INTEGER(IntKi), PARAMETER :: M3N5MBFxi = 2291 - INTEGER(IntKi), PARAMETER :: M3N6MBFxi = 2292 - INTEGER(IntKi), PARAMETER :: M3N7MBFxi = 2293 - INTEGER(IntKi), PARAMETER :: M3N8MBFxi = 2294 - INTEGER(IntKi), PARAMETER :: M3N9MBFxi = 2295 - INTEGER(IntKi), PARAMETER :: M4N1MBFxi = 2296 - INTEGER(IntKi), PARAMETER :: M4N2MBFxi = 2297 - INTEGER(IntKi), PARAMETER :: M4N3MBFxi = 2298 - INTEGER(IntKi), PARAMETER :: M4N4MBFxi = 2299 - INTEGER(IntKi), PARAMETER :: M4N5MBFxi = 2300 - INTEGER(IntKi), PARAMETER :: M4N6MBFxi = 2301 - INTEGER(IntKi), PARAMETER :: M4N7MBFxi = 2302 - INTEGER(IntKi), PARAMETER :: M4N8MBFxi = 2303 - INTEGER(IntKi), PARAMETER :: M4N9MBFxi = 2304 - INTEGER(IntKi), PARAMETER :: M5N1MBFxi = 2305 - INTEGER(IntKi), PARAMETER :: M5N2MBFxi = 2306 - INTEGER(IntKi), PARAMETER :: M5N3MBFxi = 2307 - INTEGER(IntKi), PARAMETER :: M5N4MBFxi = 2308 - INTEGER(IntKi), PARAMETER :: M5N5MBFxi = 2309 - INTEGER(IntKi), PARAMETER :: M5N6MBFxi = 2310 - INTEGER(IntKi), PARAMETER :: M5N7MBFxi = 2311 - INTEGER(IntKi), PARAMETER :: M5N8MBFxi = 2312 - INTEGER(IntKi), PARAMETER :: M5N9MBFxi = 2313 - INTEGER(IntKi), PARAMETER :: M6N1MBFxi = 2314 - INTEGER(IntKi), PARAMETER :: M6N2MBFxi = 2315 - INTEGER(IntKi), PARAMETER :: M6N3MBFxi = 2316 - INTEGER(IntKi), PARAMETER :: M6N4MBFxi = 2317 - INTEGER(IntKi), PARAMETER :: M6N5MBFxi = 2318 - INTEGER(IntKi), PARAMETER :: M6N6MBFxi = 2319 - INTEGER(IntKi), PARAMETER :: M6N7MBFxi = 2320 - INTEGER(IntKi), PARAMETER :: M6N8MBFxi = 2321 - INTEGER(IntKi), PARAMETER :: M6N9MBFxi = 2322 - INTEGER(IntKi), PARAMETER :: M7N1MBFxi = 2323 - INTEGER(IntKi), PARAMETER :: M7N2MBFxi = 2324 - INTEGER(IntKi), PARAMETER :: M7N3MBFxi = 2325 - INTEGER(IntKi), PARAMETER :: M7N4MBFxi = 2326 - INTEGER(IntKi), PARAMETER :: M7N5MBFxi = 2327 - INTEGER(IntKi), PARAMETER :: M7N6MBFxi = 2328 - INTEGER(IntKi), PARAMETER :: M7N7MBFxi = 2329 - INTEGER(IntKi), PARAMETER :: M7N8MBFxi = 2330 - INTEGER(IntKi), PARAMETER :: M7N9MBFxi = 2331 - INTEGER(IntKi), PARAMETER :: M8N1MBFxi = 2332 - INTEGER(IntKi), PARAMETER :: M8N2MBFxi = 2333 - INTEGER(IntKi), PARAMETER :: M8N3MBFxi = 2334 - INTEGER(IntKi), PARAMETER :: M8N4MBFxi = 2335 - INTEGER(IntKi), PARAMETER :: M8N5MBFxi = 2336 - INTEGER(IntKi), PARAMETER :: M8N6MBFxi = 2337 - INTEGER(IntKi), PARAMETER :: M8N7MBFxi = 2338 - INTEGER(IntKi), PARAMETER :: M8N8MBFxi = 2339 - INTEGER(IntKi), PARAMETER :: M8N9MBFxi = 2340 - INTEGER(IntKi), PARAMETER :: M9N1MBFxi = 2341 - INTEGER(IntKi), PARAMETER :: M9N2MBFxi = 2342 - INTEGER(IntKi), PARAMETER :: M9N3MBFxi = 2343 - INTEGER(IntKi), PARAMETER :: M9N4MBFxi = 2344 - INTEGER(IntKi), PARAMETER :: M9N5MBFxi = 2345 - INTEGER(IntKi), PARAMETER :: M9N6MBFxi = 2346 - INTEGER(IntKi), PARAMETER :: M9N7MBFxi = 2347 - INTEGER(IntKi), PARAMETER :: M9N8MBFxi = 2348 - INTEGER(IntKi), PARAMETER :: M9N9MBFxi = 2349 - INTEGER(IntKi), PARAMETER :: M1N1MBFyi = 2350 - INTEGER(IntKi), PARAMETER :: M1N2MBFyi = 2351 - INTEGER(IntKi), PARAMETER :: M1N3MBFyi = 2352 - INTEGER(IntKi), PARAMETER :: M1N4MBFyi = 2353 - INTEGER(IntKi), PARAMETER :: M1N5MBFyi = 2354 - INTEGER(IntKi), PARAMETER :: M1N6MBFyi = 2355 - INTEGER(IntKi), PARAMETER :: M1N7MBFyi = 2356 - INTEGER(IntKi), PARAMETER :: M1N8MBFyi = 2357 - INTEGER(IntKi), PARAMETER :: M1N9MBFyi = 2358 - INTEGER(IntKi), PARAMETER :: M2N1MBFyi = 2359 - INTEGER(IntKi), PARAMETER :: M2N2MBFyi = 2360 - INTEGER(IntKi), PARAMETER :: M2N3MBFyi = 2361 - INTEGER(IntKi), PARAMETER :: M2N4MBFyi = 2362 - INTEGER(IntKi), PARAMETER :: M2N5MBFyi = 2363 - INTEGER(IntKi), PARAMETER :: M2N6MBFyi = 2364 - INTEGER(IntKi), PARAMETER :: M2N7MBFyi = 2365 - INTEGER(IntKi), PARAMETER :: M2N8MBFyi = 2366 - INTEGER(IntKi), PARAMETER :: M2N9MBFyi = 2367 - INTEGER(IntKi), PARAMETER :: M3N1MBFyi = 2368 - INTEGER(IntKi), PARAMETER :: M3N2MBFyi = 2369 - INTEGER(IntKi), PARAMETER :: M3N3MBFyi = 2370 - INTEGER(IntKi), PARAMETER :: M3N4MBFyi = 2371 - INTEGER(IntKi), PARAMETER :: M3N5MBFyi = 2372 - INTEGER(IntKi), PARAMETER :: M3N6MBFyi = 2373 - INTEGER(IntKi), PARAMETER :: M3N7MBFyi = 2374 - INTEGER(IntKi), PARAMETER :: M3N8MBFyi = 2375 - INTEGER(IntKi), PARAMETER :: M3N9MBFyi = 2376 - INTEGER(IntKi), PARAMETER :: M4N1MBFyi = 2377 - INTEGER(IntKi), PARAMETER :: M4N2MBFyi = 2378 - INTEGER(IntKi), PARAMETER :: M4N3MBFyi = 2379 - INTEGER(IntKi), PARAMETER :: M4N4MBFyi = 2380 - INTEGER(IntKi), PARAMETER :: M4N5MBFyi = 2381 - INTEGER(IntKi), PARAMETER :: M4N6MBFyi = 2382 - INTEGER(IntKi), PARAMETER :: M4N7MBFyi = 2383 - INTEGER(IntKi), PARAMETER :: M4N8MBFyi = 2384 - INTEGER(IntKi), PARAMETER :: M4N9MBFyi = 2385 - INTEGER(IntKi), PARAMETER :: M5N1MBFyi = 2386 - INTEGER(IntKi), PARAMETER :: M5N2MBFyi = 2387 - INTEGER(IntKi), PARAMETER :: M5N3MBFyi = 2388 - INTEGER(IntKi), PARAMETER :: M5N4MBFyi = 2389 - INTEGER(IntKi), PARAMETER :: M5N5MBFyi = 2390 - INTEGER(IntKi), PARAMETER :: M5N6MBFyi = 2391 - INTEGER(IntKi), PARAMETER :: M5N7MBFyi = 2392 - INTEGER(IntKi), PARAMETER :: M5N8MBFyi = 2393 - INTEGER(IntKi), PARAMETER :: M5N9MBFyi = 2394 - INTEGER(IntKi), PARAMETER :: M6N1MBFyi = 2395 - INTEGER(IntKi), PARAMETER :: M6N2MBFyi = 2396 - INTEGER(IntKi), PARAMETER :: M6N3MBFyi = 2397 - INTEGER(IntKi), PARAMETER :: M6N4MBFyi = 2398 - INTEGER(IntKi), PARAMETER :: M6N5MBFyi = 2399 - INTEGER(IntKi), PARAMETER :: M6N6MBFyi = 2400 - INTEGER(IntKi), PARAMETER :: M6N7MBFyi = 2401 - INTEGER(IntKi), PARAMETER :: M6N8MBFyi = 2402 - INTEGER(IntKi), PARAMETER :: M6N9MBFyi = 2403 - INTEGER(IntKi), PARAMETER :: M7N1MBFyi = 2404 - INTEGER(IntKi), PARAMETER :: M7N2MBFyi = 2405 - INTEGER(IntKi), PARAMETER :: M7N3MBFyi = 2406 - INTEGER(IntKi), PARAMETER :: M7N4MBFyi = 2407 - INTEGER(IntKi), PARAMETER :: M7N5MBFyi = 2408 - INTEGER(IntKi), PARAMETER :: M7N6MBFyi = 2409 - INTEGER(IntKi), PARAMETER :: M7N7MBFyi = 2410 - INTEGER(IntKi), PARAMETER :: M7N8MBFyi = 2411 - INTEGER(IntKi), PARAMETER :: M7N9MBFyi = 2412 - INTEGER(IntKi), PARAMETER :: M8N1MBFyi = 2413 - INTEGER(IntKi), PARAMETER :: M8N2MBFyi = 2414 - INTEGER(IntKi), PARAMETER :: M8N3MBFyi = 2415 - INTEGER(IntKi), PARAMETER :: M8N4MBFyi = 2416 - INTEGER(IntKi), PARAMETER :: M8N5MBFyi = 2417 - INTEGER(IntKi), PARAMETER :: M8N6MBFyi = 2418 - INTEGER(IntKi), PARAMETER :: M8N7MBFyi = 2419 - INTEGER(IntKi), PARAMETER :: M8N8MBFyi = 2420 - INTEGER(IntKi), PARAMETER :: M8N9MBFyi = 2421 - INTEGER(IntKi), PARAMETER :: M9N1MBFyi = 2422 - INTEGER(IntKi), PARAMETER :: M9N2MBFyi = 2423 - INTEGER(IntKi), PARAMETER :: M9N3MBFyi = 2424 - INTEGER(IntKi), PARAMETER :: M9N4MBFyi = 2425 - INTEGER(IntKi), PARAMETER :: M9N5MBFyi = 2426 - INTEGER(IntKi), PARAMETER :: M9N6MBFyi = 2427 - INTEGER(IntKi), PARAMETER :: M9N7MBFyi = 2428 - INTEGER(IntKi), PARAMETER :: M9N8MBFyi = 2429 - INTEGER(IntKi), PARAMETER :: M9N9MBFyi = 2430 - INTEGER(IntKi), PARAMETER :: M1N1MBFzi = 2431 - INTEGER(IntKi), PARAMETER :: M1N2MBFzi = 2432 - INTEGER(IntKi), PARAMETER :: M1N3MBFzi = 2433 - INTEGER(IntKi), PARAMETER :: M1N4MBFzi = 2434 - INTEGER(IntKi), PARAMETER :: M1N5MBFzi = 2435 - INTEGER(IntKi), PARAMETER :: M1N6MBFzi = 2436 - INTEGER(IntKi), PARAMETER :: M1N7MBFzi = 2437 - INTEGER(IntKi), PARAMETER :: M1N8MBFzi = 2438 - INTEGER(IntKi), PARAMETER :: M1N9MBFzi = 2439 - INTEGER(IntKi), PARAMETER :: M2N1MBFzi = 2440 - INTEGER(IntKi), PARAMETER :: M2N2MBFzi = 2441 - INTEGER(IntKi), PARAMETER :: M2N3MBFzi = 2442 - INTEGER(IntKi), PARAMETER :: M2N4MBFzi = 2443 - INTEGER(IntKi), PARAMETER :: M2N5MBFzi = 2444 - INTEGER(IntKi), PARAMETER :: M2N6MBFzi = 2445 - INTEGER(IntKi), PARAMETER :: M2N7MBFzi = 2446 - INTEGER(IntKi), PARAMETER :: M2N8MBFzi = 2447 - INTEGER(IntKi), PARAMETER :: M2N9MBFzi = 2448 - INTEGER(IntKi), PARAMETER :: M3N1MBFzi = 2449 - INTEGER(IntKi), PARAMETER :: M3N2MBFzi = 2450 - INTEGER(IntKi), PARAMETER :: M3N3MBFzi = 2451 - INTEGER(IntKi), PARAMETER :: M3N4MBFzi = 2452 - INTEGER(IntKi), PARAMETER :: M3N5MBFzi = 2453 - INTEGER(IntKi), PARAMETER :: M3N6MBFzi = 2454 - INTEGER(IntKi), PARAMETER :: M3N7MBFzi = 2455 - INTEGER(IntKi), PARAMETER :: M3N8MBFzi = 2456 - INTEGER(IntKi), PARAMETER :: M3N9MBFzi = 2457 - INTEGER(IntKi), PARAMETER :: M4N1MBFzi = 2458 - INTEGER(IntKi), PARAMETER :: M4N2MBFzi = 2459 - INTEGER(IntKi), PARAMETER :: M4N3MBFzi = 2460 - INTEGER(IntKi), PARAMETER :: M4N4MBFzi = 2461 - INTEGER(IntKi), PARAMETER :: M4N5MBFzi = 2462 - INTEGER(IntKi), PARAMETER :: M4N6MBFzi = 2463 - INTEGER(IntKi), PARAMETER :: M4N7MBFzi = 2464 - INTEGER(IntKi), PARAMETER :: M4N8MBFzi = 2465 - INTEGER(IntKi), PARAMETER :: M4N9MBFzi = 2466 - INTEGER(IntKi), PARAMETER :: M5N1MBFzi = 2467 - INTEGER(IntKi), PARAMETER :: M5N2MBFzi = 2468 - INTEGER(IntKi), PARAMETER :: M5N3MBFzi = 2469 - INTEGER(IntKi), PARAMETER :: M5N4MBFzi = 2470 - INTEGER(IntKi), PARAMETER :: M5N5MBFzi = 2471 - INTEGER(IntKi), PARAMETER :: M5N6MBFzi = 2472 - INTEGER(IntKi), PARAMETER :: M5N7MBFzi = 2473 - INTEGER(IntKi), PARAMETER :: M5N8MBFzi = 2474 - INTEGER(IntKi), PARAMETER :: M5N9MBFzi = 2475 - INTEGER(IntKi), PARAMETER :: M6N1MBFzi = 2476 - INTEGER(IntKi), PARAMETER :: M6N2MBFzi = 2477 - INTEGER(IntKi), PARAMETER :: M6N3MBFzi = 2478 - INTEGER(IntKi), PARAMETER :: M6N4MBFzi = 2479 - INTEGER(IntKi), PARAMETER :: M6N5MBFzi = 2480 - INTEGER(IntKi), PARAMETER :: M6N6MBFzi = 2481 - INTEGER(IntKi), PARAMETER :: M6N7MBFzi = 2482 - INTEGER(IntKi), PARAMETER :: M6N8MBFzi = 2483 - INTEGER(IntKi), PARAMETER :: M6N9MBFzi = 2484 - INTEGER(IntKi), PARAMETER :: M7N1MBFzi = 2485 - INTEGER(IntKi), PARAMETER :: M7N2MBFzi = 2486 - INTEGER(IntKi), PARAMETER :: M7N3MBFzi = 2487 - INTEGER(IntKi), PARAMETER :: M7N4MBFzi = 2488 - INTEGER(IntKi), PARAMETER :: M7N5MBFzi = 2489 - INTEGER(IntKi), PARAMETER :: M7N6MBFzi = 2490 - INTEGER(IntKi), PARAMETER :: M7N7MBFzi = 2491 - INTEGER(IntKi), PARAMETER :: M7N8MBFzi = 2492 - INTEGER(IntKi), PARAMETER :: M7N9MBFzi = 2493 - INTEGER(IntKi), PARAMETER :: M8N1MBFzi = 2494 - INTEGER(IntKi), PARAMETER :: M8N2MBFzi = 2495 - INTEGER(IntKi), PARAMETER :: M8N3MBFzi = 2496 - INTEGER(IntKi), PARAMETER :: M8N4MBFzi = 2497 - INTEGER(IntKi), PARAMETER :: M8N5MBFzi = 2498 - INTEGER(IntKi), PARAMETER :: M8N6MBFzi = 2499 - INTEGER(IntKi), PARAMETER :: M8N7MBFzi = 2500 - INTEGER(IntKi), PARAMETER :: M8N8MBFzi = 2501 - INTEGER(IntKi), PARAMETER :: M8N9MBFzi = 2502 - INTEGER(IntKi), PARAMETER :: M9N1MBFzi = 2503 - INTEGER(IntKi), PARAMETER :: M9N2MBFzi = 2504 - INTEGER(IntKi), PARAMETER :: M9N3MBFzi = 2505 - INTEGER(IntKi), PARAMETER :: M9N4MBFzi = 2506 - INTEGER(IntKi), PARAMETER :: M9N5MBFzi = 2507 - INTEGER(IntKi), PARAMETER :: M9N6MBFzi = 2508 - INTEGER(IntKi), PARAMETER :: M9N7MBFzi = 2509 - INTEGER(IntKi), PARAMETER :: M9N8MBFzi = 2510 - INTEGER(IntKi), PARAMETER :: M9N9MBFzi = 2511 - INTEGER(IntKi), PARAMETER :: M1N1FMGxi = 2512 - INTEGER(IntKi), PARAMETER :: M1N2FMGxi = 2513 - INTEGER(IntKi), PARAMETER :: M1N3FMGxi = 2514 - INTEGER(IntKi), PARAMETER :: M1N4FMGxi = 2515 - INTEGER(IntKi), PARAMETER :: M1N5FMGxi = 2516 - INTEGER(IntKi), PARAMETER :: M1N6FMGxi = 2517 - INTEGER(IntKi), PARAMETER :: M1N7FMGxi = 2518 - INTEGER(IntKi), PARAMETER :: M1N8FMGxi = 2519 - INTEGER(IntKi), PARAMETER :: M1N9FMGxi = 2520 - INTEGER(IntKi), PARAMETER :: M2N1FMGxi = 2521 - INTEGER(IntKi), PARAMETER :: M2N2FMGxi = 2522 - INTEGER(IntKi), PARAMETER :: M2N3FMGxi = 2523 - INTEGER(IntKi), PARAMETER :: M2N4FMGxi = 2524 - INTEGER(IntKi), PARAMETER :: M2N5FMGxi = 2525 - INTEGER(IntKi), PARAMETER :: M2N6FMGxi = 2526 - INTEGER(IntKi), PARAMETER :: M2N7FMGxi = 2527 - INTEGER(IntKi), PARAMETER :: M2N8FMGxi = 2528 - INTEGER(IntKi), PARAMETER :: M2N9FMGxi = 2529 - INTEGER(IntKi), PARAMETER :: M3N1FMGxi = 2530 - INTEGER(IntKi), PARAMETER :: M3N2FMGxi = 2531 - INTEGER(IntKi), PARAMETER :: M3N3FMGxi = 2532 - INTEGER(IntKi), PARAMETER :: M3N4FMGxi = 2533 - INTEGER(IntKi), PARAMETER :: M3N5FMGxi = 2534 - INTEGER(IntKi), PARAMETER :: M3N6FMGxi = 2535 - INTEGER(IntKi), PARAMETER :: M3N7FMGxi = 2536 - INTEGER(IntKi), PARAMETER :: M3N8FMGxi = 2537 - INTEGER(IntKi), PARAMETER :: M3N9FMGxi = 2538 - INTEGER(IntKi), PARAMETER :: M4N1FMGxi = 2539 - INTEGER(IntKi), PARAMETER :: M4N2FMGxi = 2540 - INTEGER(IntKi), PARAMETER :: M4N3FMGxi = 2541 - INTEGER(IntKi), PARAMETER :: M4N4FMGxi = 2542 - INTEGER(IntKi), PARAMETER :: M4N5FMGxi = 2543 - INTEGER(IntKi), PARAMETER :: M4N6FMGxi = 2544 - INTEGER(IntKi), PARAMETER :: M4N7FMGxi = 2545 - INTEGER(IntKi), PARAMETER :: M4N8FMGxi = 2546 - INTEGER(IntKi), PARAMETER :: M4N9FMGxi = 2547 - INTEGER(IntKi), PARAMETER :: M5N1FMGxi = 2548 - INTEGER(IntKi), PARAMETER :: M5N2FMGxi = 2549 - INTEGER(IntKi), PARAMETER :: M5N3FMGxi = 2550 - INTEGER(IntKi), PARAMETER :: M5N4FMGxi = 2551 - INTEGER(IntKi), PARAMETER :: M5N5FMGxi = 2552 - INTEGER(IntKi), PARAMETER :: M5N6FMGxi = 2553 - INTEGER(IntKi), PARAMETER :: M5N7FMGxi = 2554 - INTEGER(IntKi), PARAMETER :: M5N8FMGxi = 2555 - INTEGER(IntKi), PARAMETER :: M5N9FMGxi = 2556 - INTEGER(IntKi), PARAMETER :: M6N1FMGxi = 2557 - INTEGER(IntKi), PARAMETER :: M6N2FMGxi = 2558 - INTEGER(IntKi), PARAMETER :: M6N3FMGxi = 2559 - INTEGER(IntKi), PARAMETER :: M6N4FMGxi = 2560 - INTEGER(IntKi), PARAMETER :: M6N5FMGxi = 2561 - INTEGER(IntKi), PARAMETER :: M6N6FMGxi = 2562 - INTEGER(IntKi), PARAMETER :: M6N7FMGxi = 2563 - INTEGER(IntKi), PARAMETER :: M6N8FMGxi = 2564 - INTEGER(IntKi), PARAMETER :: M6N9FMGxi = 2565 - INTEGER(IntKi), PARAMETER :: M7N1FMGxi = 2566 - INTEGER(IntKi), PARAMETER :: M7N2FMGxi = 2567 - INTEGER(IntKi), PARAMETER :: M7N3FMGxi = 2568 - INTEGER(IntKi), PARAMETER :: M7N4FMGxi = 2569 - INTEGER(IntKi), PARAMETER :: M7N5FMGxi = 2570 - INTEGER(IntKi), PARAMETER :: M7N6FMGxi = 2571 - INTEGER(IntKi), PARAMETER :: M7N7FMGxi = 2572 - INTEGER(IntKi), PARAMETER :: M7N8FMGxi = 2573 - INTEGER(IntKi), PARAMETER :: M7N9FMGxi = 2574 - INTEGER(IntKi), PARAMETER :: M8N1FMGxi = 2575 - INTEGER(IntKi), PARAMETER :: M8N2FMGxi = 2576 - INTEGER(IntKi), PARAMETER :: M8N3FMGxi = 2577 - INTEGER(IntKi), PARAMETER :: M8N4FMGxi = 2578 - INTEGER(IntKi), PARAMETER :: M8N5FMGxi = 2579 - INTEGER(IntKi), PARAMETER :: M8N6FMGxi = 2580 - INTEGER(IntKi), PARAMETER :: M8N7FMGxi = 2581 - INTEGER(IntKi), PARAMETER :: M8N8FMGxi = 2582 - INTEGER(IntKi), PARAMETER :: M8N9FMGxi = 2583 - INTEGER(IntKi), PARAMETER :: M9N1FMGxi = 2584 - INTEGER(IntKi), PARAMETER :: M9N2FMGxi = 2585 - INTEGER(IntKi), PARAMETER :: M9N3FMGxi = 2586 - INTEGER(IntKi), PARAMETER :: M9N4FMGxi = 2587 - INTEGER(IntKi), PARAMETER :: M9N5FMGxi = 2588 - INTEGER(IntKi), PARAMETER :: M9N6FMGxi = 2589 - INTEGER(IntKi), PARAMETER :: M9N7FMGxi = 2590 - INTEGER(IntKi), PARAMETER :: M9N8FMGxi = 2591 - INTEGER(IntKi), PARAMETER :: M9N9FMGxi = 2592 - INTEGER(IntKi), PARAMETER :: M1N1FMGyi = 2593 - INTEGER(IntKi), PARAMETER :: M1N2FMGyi = 2594 - INTEGER(IntKi), PARAMETER :: M1N3FMGyi = 2595 - INTEGER(IntKi), PARAMETER :: M1N4FMGyi = 2596 - INTEGER(IntKi), PARAMETER :: M1N5FMGyi = 2597 - INTEGER(IntKi), PARAMETER :: M1N6FMGyi = 2598 - INTEGER(IntKi), PARAMETER :: M1N7FMGyi = 2599 - INTEGER(IntKi), PARAMETER :: M1N8FMGyi = 2600 - INTEGER(IntKi), PARAMETER :: M1N9FMGyi = 2601 - INTEGER(IntKi), PARAMETER :: M2N1FMGyi = 2602 - INTEGER(IntKi), PARAMETER :: M2N2FMGyi = 2603 - INTEGER(IntKi), PARAMETER :: M2N3FMGyi = 2604 - INTEGER(IntKi), PARAMETER :: M2N4FMGyi = 2605 - INTEGER(IntKi), PARAMETER :: M2N5FMGyi = 2606 - INTEGER(IntKi), PARAMETER :: M2N6FMGyi = 2607 - INTEGER(IntKi), PARAMETER :: M2N7FMGyi = 2608 - INTEGER(IntKi), PARAMETER :: M2N8FMGyi = 2609 - INTEGER(IntKi), PARAMETER :: M2N9FMGyi = 2610 - INTEGER(IntKi), PARAMETER :: M3N1FMGyi = 2611 - INTEGER(IntKi), PARAMETER :: M3N2FMGyi = 2612 - INTEGER(IntKi), PARAMETER :: M3N3FMGyi = 2613 - INTEGER(IntKi), PARAMETER :: M3N4FMGyi = 2614 - INTEGER(IntKi), PARAMETER :: M3N5FMGyi = 2615 - INTEGER(IntKi), PARAMETER :: M3N6FMGyi = 2616 - INTEGER(IntKi), PARAMETER :: M3N7FMGyi = 2617 - INTEGER(IntKi), PARAMETER :: M3N8FMGyi = 2618 - INTEGER(IntKi), PARAMETER :: M3N9FMGyi = 2619 - INTEGER(IntKi), PARAMETER :: M4N1FMGyi = 2620 - INTEGER(IntKi), PARAMETER :: M4N2FMGyi = 2621 - INTEGER(IntKi), PARAMETER :: M4N3FMGyi = 2622 - INTEGER(IntKi), PARAMETER :: M4N4FMGyi = 2623 - INTEGER(IntKi), PARAMETER :: M4N5FMGyi = 2624 - INTEGER(IntKi), PARAMETER :: M4N6FMGyi = 2625 - INTEGER(IntKi), PARAMETER :: M4N7FMGyi = 2626 - INTEGER(IntKi), PARAMETER :: M4N8FMGyi = 2627 - INTEGER(IntKi), PARAMETER :: M4N9FMGyi = 2628 - INTEGER(IntKi), PARAMETER :: M5N1FMGyi = 2629 - INTEGER(IntKi), PARAMETER :: M5N2FMGyi = 2630 - INTEGER(IntKi), PARAMETER :: M5N3FMGyi = 2631 - INTEGER(IntKi), PARAMETER :: M5N4FMGyi = 2632 - INTEGER(IntKi), PARAMETER :: M5N5FMGyi = 2633 - INTEGER(IntKi), PARAMETER :: M5N6FMGyi = 2634 - INTEGER(IntKi), PARAMETER :: M5N7FMGyi = 2635 - INTEGER(IntKi), PARAMETER :: M5N8FMGyi = 2636 - INTEGER(IntKi), PARAMETER :: M5N9FMGyi = 2637 - INTEGER(IntKi), PARAMETER :: M6N1FMGyi = 2638 - INTEGER(IntKi), PARAMETER :: M6N2FMGyi = 2639 - INTEGER(IntKi), PARAMETER :: M6N3FMGyi = 2640 - INTEGER(IntKi), PARAMETER :: M6N4FMGyi = 2641 - INTEGER(IntKi), PARAMETER :: M6N5FMGyi = 2642 - INTEGER(IntKi), PARAMETER :: M6N6FMGyi = 2643 - INTEGER(IntKi), PARAMETER :: M6N7FMGyi = 2644 - INTEGER(IntKi), PARAMETER :: M6N8FMGyi = 2645 - INTEGER(IntKi), PARAMETER :: M6N9FMGyi = 2646 - INTEGER(IntKi), PARAMETER :: M7N1FMGyi = 2647 - INTEGER(IntKi), PARAMETER :: M7N2FMGyi = 2648 - INTEGER(IntKi), PARAMETER :: M7N3FMGyi = 2649 - INTEGER(IntKi), PARAMETER :: M7N4FMGyi = 2650 - INTEGER(IntKi), PARAMETER :: M7N5FMGyi = 2651 - INTEGER(IntKi), PARAMETER :: M7N6FMGyi = 2652 - INTEGER(IntKi), PARAMETER :: M7N7FMGyi = 2653 - INTEGER(IntKi), PARAMETER :: M7N8FMGyi = 2654 - INTEGER(IntKi), PARAMETER :: M7N9FMGyi = 2655 - INTEGER(IntKi), PARAMETER :: M8N1FMGyi = 2656 - INTEGER(IntKi), PARAMETER :: M8N2FMGyi = 2657 - INTEGER(IntKi), PARAMETER :: M8N3FMGyi = 2658 - INTEGER(IntKi), PARAMETER :: M8N4FMGyi = 2659 - INTEGER(IntKi), PARAMETER :: M8N5FMGyi = 2660 - INTEGER(IntKi), PARAMETER :: M8N6FMGyi = 2661 - INTEGER(IntKi), PARAMETER :: M8N7FMGyi = 2662 - INTEGER(IntKi), PARAMETER :: M8N8FMGyi = 2663 - INTEGER(IntKi), PARAMETER :: M8N9FMGyi = 2664 - INTEGER(IntKi), PARAMETER :: M9N1FMGyi = 2665 - INTEGER(IntKi), PARAMETER :: M9N2FMGyi = 2666 - INTEGER(IntKi), PARAMETER :: M9N3FMGyi = 2667 - INTEGER(IntKi), PARAMETER :: M9N4FMGyi = 2668 - INTEGER(IntKi), PARAMETER :: M9N5FMGyi = 2669 - INTEGER(IntKi), PARAMETER :: M9N6FMGyi = 2670 - INTEGER(IntKi), PARAMETER :: M9N7FMGyi = 2671 - INTEGER(IntKi), PARAMETER :: M9N8FMGyi = 2672 - INTEGER(IntKi), PARAMETER :: M9N9FMGyi = 2673 - INTEGER(IntKi), PARAMETER :: M1N1FMGzi = 2674 - INTEGER(IntKi), PARAMETER :: M1N2FMGzi = 2675 - INTEGER(IntKi), PARAMETER :: M1N3FMGzi = 2676 - INTEGER(IntKi), PARAMETER :: M1N4FMGzi = 2677 - INTEGER(IntKi), PARAMETER :: M1N5FMGzi = 2678 - INTEGER(IntKi), PARAMETER :: M1N6FMGzi = 2679 - INTEGER(IntKi), PARAMETER :: M1N7FMGzi = 2680 - INTEGER(IntKi), PARAMETER :: M1N8FMGzi = 2681 - INTEGER(IntKi), PARAMETER :: M1N9FMGzi = 2682 - INTEGER(IntKi), PARAMETER :: M2N1FMGzi = 2683 - INTEGER(IntKi), PARAMETER :: M2N2FMGzi = 2684 - INTEGER(IntKi), PARAMETER :: M2N3FMGzi = 2685 - INTEGER(IntKi), PARAMETER :: M2N4FMGzi = 2686 - INTEGER(IntKi), PARAMETER :: M2N5FMGzi = 2687 - INTEGER(IntKi), PARAMETER :: M2N6FMGzi = 2688 - INTEGER(IntKi), PARAMETER :: M2N7FMGzi = 2689 - INTEGER(IntKi), PARAMETER :: M2N8FMGzi = 2690 - INTEGER(IntKi), PARAMETER :: M2N9FMGzi = 2691 - INTEGER(IntKi), PARAMETER :: M3N1FMGzi = 2692 - INTEGER(IntKi), PARAMETER :: M3N2FMGzi = 2693 - INTEGER(IntKi), PARAMETER :: M3N3FMGzi = 2694 - INTEGER(IntKi), PARAMETER :: M3N4FMGzi = 2695 - INTEGER(IntKi), PARAMETER :: M3N5FMGzi = 2696 - INTEGER(IntKi), PARAMETER :: M3N6FMGzi = 2697 - INTEGER(IntKi), PARAMETER :: M3N7FMGzi = 2698 - INTEGER(IntKi), PARAMETER :: M3N8FMGzi = 2699 - INTEGER(IntKi), PARAMETER :: M3N9FMGzi = 2700 - INTEGER(IntKi), PARAMETER :: M4N1FMGzi = 2701 - INTEGER(IntKi), PARAMETER :: M4N2FMGzi = 2702 - INTEGER(IntKi), PARAMETER :: M4N3FMGzi = 2703 - INTEGER(IntKi), PARAMETER :: M4N4FMGzi = 2704 - INTEGER(IntKi), PARAMETER :: M4N5FMGzi = 2705 - INTEGER(IntKi), PARAMETER :: M4N6FMGzi = 2706 - INTEGER(IntKi), PARAMETER :: M4N7FMGzi = 2707 - INTEGER(IntKi), PARAMETER :: M4N8FMGzi = 2708 - INTEGER(IntKi), PARAMETER :: M4N9FMGzi = 2709 - INTEGER(IntKi), PARAMETER :: M5N1FMGzi = 2710 - INTEGER(IntKi), PARAMETER :: M5N2FMGzi = 2711 - INTEGER(IntKi), PARAMETER :: M5N3FMGzi = 2712 - INTEGER(IntKi), PARAMETER :: M5N4FMGzi = 2713 - INTEGER(IntKi), PARAMETER :: M5N5FMGzi = 2714 - INTEGER(IntKi), PARAMETER :: M5N6FMGzi = 2715 - INTEGER(IntKi), PARAMETER :: M5N7FMGzi = 2716 - INTEGER(IntKi), PARAMETER :: M5N8FMGzi = 2717 - INTEGER(IntKi), PARAMETER :: M5N9FMGzi = 2718 - INTEGER(IntKi), PARAMETER :: M6N1FMGzi = 2719 - INTEGER(IntKi), PARAMETER :: M6N2FMGzi = 2720 - INTEGER(IntKi), PARAMETER :: M6N3FMGzi = 2721 - INTEGER(IntKi), PARAMETER :: M6N4FMGzi = 2722 - INTEGER(IntKi), PARAMETER :: M6N5FMGzi = 2723 - INTEGER(IntKi), PARAMETER :: M6N6FMGzi = 2724 - INTEGER(IntKi), PARAMETER :: M6N7FMGzi = 2725 - INTEGER(IntKi), PARAMETER :: M6N8FMGzi = 2726 - INTEGER(IntKi), PARAMETER :: M6N9FMGzi = 2727 - INTEGER(IntKi), PARAMETER :: M7N1FMGzi = 2728 - INTEGER(IntKi), PARAMETER :: M7N2FMGzi = 2729 - INTEGER(IntKi), PARAMETER :: M7N3FMGzi = 2730 - INTEGER(IntKi), PARAMETER :: M7N4FMGzi = 2731 - INTEGER(IntKi), PARAMETER :: M7N5FMGzi = 2732 - INTEGER(IntKi), PARAMETER :: M7N6FMGzi = 2733 - INTEGER(IntKi), PARAMETER :: M7N7FMGzi = 2734 - INTEGER(IntKi), PARAMETER :: M7N8FMGzi = 2735 - INTEGER(IntKi), PARAMETER :: M7N9FMGzi = 2736 - INTEGER(IntKi), PARAMETER :: M8N1FMGzi = 2737 - INTEGER(IntKi), PARAMETER :: M8N2FMGzi = 2738 - INTEGER(IntKi), PARAMETER :: M8N3FMGzi = 2739 - INTEGER(IntKi), PARAMETER :: M8N4FMGzi = 2740 - INTEGER(IntKi), PARAMETER :: M8N5FMGzi = 2741 - INTEGER(IntKi), PARAMETER :: M8N6FMGzi = 2742 - INTEGER(IntKi), PARAMETER :: M8N7FMGzi = 2743 - INTEGER(IntKi), PARAMETER :: M8N8FMGzi = 2744 - INTEGER(IntKi), PARAMETER :: M8N9FMGzi = 2745 - INTEGER(IntKi), PARAMETER :: M9N1FMGzi = 2746 - INTEGER(IntKi), PARAMETER :: M9N2FMGzi = 2747 - INTEGER(IntKi), PARAMETER :: M9N3FMGzi = 2748 - INTEGER(IntKi), PARAMETER :: M9N4FMGzi = 2749 - INTEGER(IntKi), PARAMETER :: M9N5FMGzi = 2750 - INTEGER(IntKi), PARAMETER :: M9N6FMGzi = 2751 - INTEGER(IntKi), PARAMETER :: M9N7FMGzi = 2752 - INTEGER(IntKi), PARAMETER :: M9N8FMGzi = 2753 - INTEGER(IntKi), PARAMETER :: M9N9FMGzi = 2754 - INTEGER(IntKi), PARAMETER :: M1N1MMGxi = 2755 - INTEGER(IntKi), PARAMETER :: M1N2MMGxi = 2756 - INTEGER(IntKi), PARAMETER :: M1N3MMGxi = 2757 - INTEGER(IntKi), PARAMETER :: M1N4MMGxi = 2758 - INTEGER(IntKi), PARAMETER :: M1N5MMGxi = 2759 - INTEGER(IntKi), PARAMETER :: M1N6MMGxi = 2760 - INTEGER(IntKi), PARAMETER :: M1N7MMGxi = 2761 - INTEGER(IntKi), PARAMETER :: M1N8MMGxi = 2762 - INTEGER(IntKi), PARAMETER :: M1N9MMGxi = 2763 - INTEGER(IntKi), PARAMETER :: M2N1MMGxi = 2764 - INTEGER(IntKi), PARAMETER :: M2N2MMGxi = 2765 - INTEGER(IntKi), PARAMETER :: M2N3MMGxi = 2766 - INTEGER(IntKi), PARAMETER :: M2N4MMGxi = 2767 - INTEGER(IntKi), PARAMETER :: M2N5MMGxi = 2768 - INTEGER(IntKi), PARAMETER :: M2N6MMGxi = 2769 - INTEGER(IntKi), PARAMETER :: M2N7MMGxi = 2770 - INTEGER(IntKi), PARAMETER :: M2N8MMGxi = 2771 - INTEGER(IntKi), PARAMETER :: M2N9MMGxi = 2772 - INTEGER(IntKi), PARAMETER :: M3N1MMGxi = 2773 - INTEGER(IntKi), PARAMETER :: M3N2MMGxi = 2774 - INTEGER(IntKi), PARAMETER :: M3N3MMGxi = 2775 - INTEGER(IntKi), PARAMETER :: M3N4MMGxi = 2776 - INTEGER(IntKi), PARAMETER :: M3N5MMGxi = 2777 - INTEGER(IntKi), PARAMETER :: M3N6MMGxi = 2778 - INTEGER(IntKi), PARAMETER :: M3N7MMGxi = 2779 - INTEGER(IntKi), PARAMETER :: M3N8MMGxi = 2780 - INTEGER(IntKi), PARAMETER :: M3N9MMGxi = 2781 - INTEGER(IntKi), PARAMETER :: M4N1MMGxi = 2782 - INTEGER(IntKi), PARAMETER :: M4N2MMGxi = 2783 - INTEGER(IntKi), PARAMETER :: M4N3MMGxi = 2784 - INTEGER(IntKi), PARAMETER :: M4N4MMGxi = 2785 - INTEGER(IntKi), PARAMETER :: M4N5MMGxi = 2786 - INTEGER(IntKi), PARAMETER :: M4N6MMGxi = 2787 - INTEGER(IntKi), PARAMETER :: M4N7MMGxi = 2788 - INTEGER(IntKi), PARAMETER :: M4N8MMGxi = 2789 - INTEGER(IntKi), PARAMETER :: M4N9MMGxi = 2790 - INTEGER(IntKi), PARAMETER :: M5N1MMGxi = 2791 - INTEGER(IntKi), PARAMETER :: M5N2MMGxi = 2792 - INTEGER(IntKi), PARAMETER :: M5N3MMGxi = 2793 - INTEGER(IntKi), PARAMETER :: M5N4MMGxi = 2794 - INTEGER(IntKi), PARAMETER :: M5N5MMGxi = 2795 - INTEGER(IntKi), PARAMETER :: M5N6MMGxi = 2796 - INTEGER(IntKi), PARAMETER :: M5N7MMGxi = 2797 - INTEGER(IntKi), PARAMETER :: M5N8MMGxi = 2798 - INTEGER(IntKi), PARAMETER :: M5N9MMGxi = 2799 - INTEGER(IntKi), PARAMETER :: M6N1MMGxi = 2800 - INTEGER(IntKi), PARAMETER :: M6N2MMGxi = 2801 - INTEGER(IntKi), PARAMETER :: M6N3MMGxi = 2802 - INTEGER(IntKi), PARAMETER :: M6N4MMGxi = 2803 - INTEGER(IntKi), PARAMETER :: M6N5MMGxi = 2804 - INTEGER(IntKi), PARAMETER :: M6N6MMGxi = 2805 - INTEGER(IntKi), PARAMETER :: M6N7MMGxi = 2806 - INTEGER(IntKi), PARAMETER :: M6N8MMGxi = 2807 - INTEGER(IntKi), PARAMETER :: M6N9MMGxi = 2808 - INTEGER(IntKi), PARAMETER :: M7N1MMGxi = 2809 - INTEGER(IntKi), PARAMETER :: M7N2MMGxi = 2810 - INTEGER(IntKi), PARAMETER :: M7N3MMGxi = 2811 - INTEGER(IntKi), PARAMETER :: M7N4MMGxi = 2812 - INTEGER(IntKi), PARAMETER :: M7N5MMGxi = 2813 - INTEGER(IntKi), PARAMETER :: M7N6MMGxi = 2814 - INTEGER(IntKi), PARAMETER :: M7N7MMGxi = 2815 - INTEGER(IntKi), PARAMETER :: M7N8MMGxi = 2816 - INTEGER(IntKi), PARAMETER :: M7N9MMGxi = 2817 - INTEGER(IntKi), PARAMETER :: M8N1MMGxi = 2818 - INTEGER(IntKi), PARAMETER :: M8N2MMGxi = 2819 - INTEGER(IntKi), PARAMETER :: M8N3MMGxi = 2820 - INTEGER(IntKi), PARAMETER :: M8N4MMGxi = 2821 - INTEGER(IntKi), PARAMETER :: M8N5MMGxi = 2822 - INTEGER(IntKi), PARAMETER :: M8N6MMGxi = 2823 - INTEGER(IntKi), PARAMETER :: M8N7MMGxi = 2824 - INTEGER(IntKi), PARAMETER :: M8N8MMGxi = 2825 - INTEGER(IntKi), PARAMETER :: M8N9MMGxi = 2826 - INTEGER(IntKi), PARAMETER :: M9N1MMGxi = 2827 - INTEGER(IntKi), PARAMETER :: M9N2MMGxi = 2828 - INTEGER(IntKi), PARAMETER :: M9N3MMGxi = 2829 - INTEGER(IntKi), PARAMETER :: M9N4MMGxi = 2830 - INTEGER(IntKi), PARAMETER :: M9N5MMGxi = 2831 - INTEGER(IntKi), PARAMETER :: M9N6MMGxi = 2832 - INTEGER(IntKi), PARAMETER :: M9N7MMGxi = 2833 - INTEGER(IntKi), PARAMETER :: M9N8MMGxi = 2834 - INTEGER(IntKi), PARAMETER :: M9N9MMGxi = 2835 - INTEGER(IntKi), PARAMETER :: M1N1MMGyi = 2836 - INTEGER(IntKi), PARAMETER :: M1N2MMGyi = 2837 - INTEGER(IntKi), PARAMETER :: M1N3MMGyi = 2838 - INTEGER(IntKi), PARAMETER :: M1N4MMGyi = 2839 - INTEGER(IntKi), PARAMETER :: M1N5MMGyi = 2840 - INTEGER(IntKi), PARAMETER :: M1N6MMGyi = 2841 - INTEGER(IntKi), PARAMETER :: M1N7MMGyi = 2842 - INTEGER(IntKi), PARAMETER :: M1N8MMGyi = 2843 - INTEGER(IntKi), PARAMETER :: M1N9MMGyi = 2844 - INTEGER(IntKi), PARAMETER :: M2N1MMGyi = 2845 - INTEGER(IntKi), PARAMETER :: M2N2MMGyi = 2846 - INTEGER(IntKi), PARAMETER :: M2N3MMGyi = 2847 - INTEGER(IntKi), PARAMETER :: M2N4MMGyi = 2848 - INTEGER(IntKi), PARAMETER :: M2N5MMGyi = 2849 - INTEGER(IntKi), PARAMETER :: M2N6MMGyi = 2850 - INTEGER(IntKi), PARAMETER :: M2N7MMGyi = 2851 - INTEGER(IntKi), PARAMETER :: M2N8MMGyi = 2852 - INTEGER(IntKi), PARAMETER :: M2N9MMGyi = 2853 - INTEGER(IntKi), PARAMETER :: M3N1MMGyi = 2854 - INTEGER(IntKi), PARAMETER :: M3N2MMGyi = 2855 - INTEGER(IntKi), PARAMETER :: M3N3MMGyi = 2856 - INTEGER(IntKi), PARAMETER :: M3N4MMGyi = 2857 - INTEGER(IntKi), PARAMETER :: M3N5MMGyi = 2858 - INTEGER(IntKi), PARAMETER :: M3N6MMGyi = 2859 - INTEGER(IntKi), PARAMETER :: M3N7MMGyi = 2860 - INTEGER(IntKi), PARAMETER :: M3N8MMGyi = 2861 - INTEGER(IntKi), PARAMETER :: M3N9MMGyi = 2862 - INTEGER(IntKi), PARAMETER :: M4N1MMGyi = 2863 - INTEGER(IntKi), PARAMETER :: M4N2MMGyi = 2864 - INTEGER(IntKi), PARAMETER :: M4N3MMGyi = 2865 - INTEGER(IntKi), PARAMETER :: M4N4MMGyi = 2866 - INTEGER(IntKi), PARAMETER :: M4N5MMGyi = 2867 - INTEGER(IntKi), PARAMETER :: M4N6MMGyi = 2868 - INTEGER(IntKi), PARAMETER :: M4N7MMGyi = 2869 - INTEGER(IntKi), PARAMETER :: M4N8MMGyi = 2870 - INTEGER(IntKi), PARAMETER :: M4N9MMGyi = 2871 - INTEGER(IntKi), PARAMETER :: M5N1MMGyi = 2872 - INTEGER(IntKi), PARAMETER :: M5N2MMGyi = 2873 - INTEGER(IntKi), PARAMETER :: M5N3MMGyi = 2874 - INTEGER(IntKi), PARAMETER :: M5N4MMGyi = 2875 - INTEGER(IntKi), PARAMETER :: M5N5MMGyi = 2876 - INTEGER(IntKi), PARAMETER :: M5N6MMGyi = 2877 - INTEGER(IntKi), PARAMETER :: M5N7MMGyi = 2878 - INTEGER(IntKi), PARAMETER :: M5N8MMGyi = 2879 - INTEGER(IntKi), PARAMETER :: M5N9MMGyi = 2880 - INTEGER(IntKi), PARAMETER :: M6N1MMGyi = 2881 - INTEGER(IntKi), PARAMETER :: M6N2MMGyi = 2882 - INTEGER(IntKi), PARAMETER :: M6N3MMGyi = 2883 - INTEGER(IntKi), PARAMETER :: M6N4MMGyi = 2884 - INTEGER(IntKi), PARAMETER :: M6N5MMGyi = 2885 - INTEGER(IntKi), PARAMETER :: M6N6MMGyi = 2886 - INTEGER(IntKi), PARAMETER :: M6N7MMGyi = 2887 - INTEGER(IntKi), PARAMETER :: M6N8MMGyi = 2888 - INTEGER(IntKi), PARAMETER :: M6N9MMGyi = 2889 - INTEGER(IntKi), PARAMETER :: M7N1MMGyi = 2890 - INTEGER(IntKi), PARAMETER :: M7N2MMGyi = 2891 - INTEGER(IntKi), PARAMETER :: M7N3MMGyi = 2892 - INTEGER(IntKi), PARAMETER :: M7N4MMGyi = 2893 - INTEGER(IntKi), PARAMETER :: M7N5MMGyi = 2894 - INTEGER(IntKi), PARAMETER :: M7N6MMGyi = 2895 - INTEGER(IntKi), PARAMETER :: M7N7MMGyi = 2896 - INTEGER(IntKi), PARAMETER :: M7N8MMGyi = 2897 - INTEGER(IntKi), PARAMETER :: M7N9MMGyi = 2898 - INTEGER(IntKi), PARAMETER :: M8N1MMGyi = 2899 - INTEGER(IntKi), PARAMETER :: M8N2MMGyi = 2900 - INTEGER(IntKi), PARAMETER :: M8N3MMGyi = 2901 - INTEGER(IntKi), PARAMETER :: M8N4MMGyi = 2902 - INTEGER(IntKi), PARAMETER :: M8N5MMGyi = 2903 - INTEGER(IntKi), PARAMETER :: M8N6MMGyi = 2904 - INTEGER(IntKi), PARAMETER :: M8N7MMGyi = 2905 - INTEGER(IntKi), PARAMETER :: M8N8MMGyi = 2906 - INTEGER(IntKi), PARAMETER :: M8N9MMGyi = 2907 - INTEGER(IntKi), PARAMETER :: M9N1MMGyi = 2908 - INTEGER(IntKi), PARAMETER :: M9N2MMGyi = 2909 - INTEGER(IntKi), PARAMETER :: M9N3MMGyi = 2910 - INTEGER(IntKi), PARAMETER :: M9N4MMGyi = 2911 - INTEGER(IntKi), PARAMETER :: M9N5MMGyi = 2912 - INTEGER(IntKi), PARAMETER :: M9N6MMGyi = 2913 - INTEGER(IntKi), PARAMETER :: M9N7MMGyi = 2914 - INTEGER(IntKi), PARAMETER :: M9N8MMGyi = 2915 - INTEGER(IntKi), PARAMETER :: M9N9MMGyi = 2916 - INTEGER(IntKi), PARAMETER :: M1N1MMGzi = 2917 - INTEGER(IntKi), PARAMETER :: M1N2MMGzi = 2918 - INTEGER(IntKi), PARAMETER :: M1N3MMGzi = 2919 - INTEGER(IntKi), PARAMETER :: M1N4MMGzi = 2920 - INTEGER(IntKi), PARAMETER :: M1N5MMGzi = 2921 - INTEGER(IntKi), PARAMETER :: M1N6MMGzi = 2922 - INTEGER(IntKi), PARAMETER :: M1N7MMGzi = 2923 - INTEGER(IntKi), PARAMETER :: M1N8MMGzi = 2924 - INTEGER(IntKi), PARAMETER :: M1N9MMGzi = 2925 - INTEGER(IntKi), PARAMETER :: M2N1MMGzi = 2926 - INTEGER(IntKi), PARAMETER :: M2N2MMGzi = 2927 - INTEGER(IntKi), PARAMETER :: M2N3MMGzi = 2928 - INTEGER(IntKi), PARAMETER :: M2N4MMGzi = 2929 - INTEGER(IntKi), PARAMETER :: M2N5MMGzi = 2930 - INTEGER(IntKi), PARAMETER :: M2N6MMGzi = 2931 - INTEGER(IntKi), PARAMETER :: M2N7MMGzi = 2932 - INTEGER(IntKi), PARAMETER :: M2N8MMGzi = 2933 - INTEGER(IntKi), PARAMETER :: M2N9MMGzi = 2934 - INTEGER(IntKi), PARAMETER :: M3N1MMGzi = 2935 - INTEGER(IntKi), PARAMETER :: M3N2MMGzi = 2936 - INTEGER(IntKi), PARAMETER :: M3N3MMGzi = 2937 - INTEGER(IntKi), PARAMETER :: M3N4MMGzi = 2938 - INTEGER(IntKi), PARAMETER :: M3N5MMGzi = 2939 - INTEGER(IntKi), PARAMETER :: M3N6MMGzi = 2940 - INTEGER(IntKi), PARAMETER :: M3N7MMGzi = 2941 - INTEGER(IntKi), PARAMETER :: M3N8MMGzi = 2942 - INTEGER(IntKi), PARAMETER :: M3N9MMGzi = 2943 - INTEGER(IntKi), PARAMETER :: M4N1MMGzi = 2944 - INTEGER(IntKi), PARAMETER :: M4N2MMGzi = 2945 - INTEGER(IntKi), PARAMETER :: M4N3MMGzi = 2946 - INTEGER(IntKi), PARAMETER :: M4N4MMGzi = 2947 - INTEGER(IntKi), PARAMETER :: M4N5MMGzi = 2948 - INTEGER(IntKi), PARAMETER :: M4N6MMGzi = 2949 - INTEGER(IntKi), PARAMETER :: M4N7MMGzi = 2950 - INTEGER(IntKi), PARAMETER :: M4N8MMGzi = 2951 - INTEGER(IntKi), PARAMETER :: M4N9MMGzi = 2952 - INTEGER(IntKi), PARAMETER :: M5N1MMGzi = 2953 - INTEGER(IntKi), PARAMETER :: M5N2MMGzi = 2954 - INTEGER(IntKi), PARAMETER :: M5N3MMGzi = 2955 - INTEGER(IntKi), PARAMETER :: M5N4MMGzi = 2956 - INTEGER(IntKi), PARAMETER :: M5N5MMGzi = 2957 - INTEGER(IntKi), PARAMETER :: M5N6MMGzi = 2958 - INTEGER(IntKi), PARAMETER :: M5N7MMGzi = 2959 - INTEGER(IntKi), PARAMETER :: M5N8MMGzi = 2960 - INTEGER(IntKi), PARAMETER :: M5N9MMGzi = 2961 - INTEGER(IntKi), PARAMETER :: M6N1MMGzi = 2962 - INTEGER(IntKi), PARAMETER :: M6N2MMGzi = 2963 - INTEGER(IntKi), PARAMETER :: M6N3MMGzi = 2964 - INTEGER(IntKi), PARAMETER :: M6N4MMGzi = 2965 - INTEGER(IntKi), PARAMETER :: M6N5MMGzi = 2966 - INTEGER(IntKi), PARAMETER :: M6N6MMGzi = 2967 - INTEGER(IntKi), PARAMETER :: M6N7MMGzi = 2968 - INTEGER(IntKi), PARAMETER :: M6N8MMGzi = 2969 - INTEGER(IntKi), PARAMETER :: M6N9MMGzi = 2970 - INTEGER(IntKi), PARAMETER :: M7N1MMGzi = 2971 - INTEGER(IntKi), PARAMETER :: M7N2MMGzi = 2972 - INTEGER(IntKi), PARAMETER :: M7N3MMGzi = 2973 - INTEGER(IntKi), PARAMETER :: M7N4MMGzi = 2974 - INTEGER(IntKi), PARAMETER :: M7N5MMGzi = 2975 - INTEGER(IntKi), PARAMETER :: M7N6MMGzi = 2976 - INTEGER(IntKi), PARAMETER :: M7N7MMGzi = 2977 - INTEGER(IntKi), PARAMETER :: M7N8MMGzi = 2978 - INTEGER(IntKi), PARAMETER :: M7N9MMGzi = 2979 - INTEGER(IntKi), PARAMETER :: M8N1MMGzi = 2980 - INTEGER(IntKi), PARAMETER :: M8N2MMGzi = 2981 - INTEGER(IntKi), PARAMETER :: M8N3MMGzi = 2982 - INTEGER(IntKi), PARAMETER :: M8N4MMGzi = 2983 - INTEGER(IntKi), PARAMETER :: M8N5MMGzi = 2984 - INTEGER(IntKi), PARAMETER :: M8N6MMGzi = 2985 - INTEGER(IntKi), PARAMETER :: M8N7MMGzi = 2986 - INTEGER(IntKi), PARAMETER :: M8N8MMGzi = 2987 - INTEGER(IntKi), PARAMETER :: M8N9MMGzi = 2988 - INTEGER(IntKi), PARAMETER :: M9N1MMGzi = 2989 - INTEGER(IntKi), PARAMETER :: M9N2MMGzi = 2990 - INTEGER(IntKi), PARAMETER :: M9N3MMGzi = 2991 - INTEGER(IntKi), PARAMETER :: M9N4MMGzi = 2992 - INTEGER(IntKi), PARAMETER :: M9N5MMGzi = 2993 - INTEGER(IntKi), PARAMETER :: M9N6MMGzi = 2994 - INTEGER(IntKi), PARAMETER :: M9N7MMGzi = 2995 - INTEGER(IntKi), PARAMETER :: M9N8MMGzi = 2996 - INTEGER(IntKi), PARAMETER :: M9N9MMGzi = 2997 - INTEGER(IntKi), PARAMETER :: M1N1FAMxi = 2998 - INTEGER(IntKi), PARAMETER :: M1N2FAMxi = 2999 - INTEGER(IntKi), PARAMETER :: M1N3FAMxi = 3000 - INTEGER(IntKi), PARAMETER :: M1N4FAMxi = 3001 - INTEGER(IntKi), PARAMETER :: M1N5FAMxi = 3002 - INTEGER(IntKi), PARAMETER :: M1N6FAMxi = 3003 - INTEGER(IntKi), PARAMETER :: M1N7FAMxi = 3004 - INTEGER(IntKi), PARAMETER :: M1N8FAMxi = 3005 - INTEGER(IntKi), PARAMETER :: M1N9FAMxi = 3006 - INTEGER(IntKi), PARAMETER :: M2N1FAMxi = 3007 - INTEGER(IntKi), PARAMETER :: M2N2FAMxi = 3008 - INTEGER(IntKi), PARAMETER :: M2N3FAMxi = 3009 - INTEGER(IntKi), PARAMETER :: M2N4FAMxi = 3010 - INTEGER(IntKi), PARAMETER :: M2N5FAMxi = 3011 - INTEGER(IntKi), PARAMETER :: M2N6FAMxi = 3012 - INTEGER(IntKi), PARAMETER :: M2N7FAMxi = 3013 - INTEGER(IntKi), PARAMETER :: M2N8FAMxi = 3014 - INTEGER(IntKi), PARAMETER :: M2N9FAMxi = 3015 - INTEGER(IntKi), PARAMETER :: M3N1FAMxi = 3016 - INTEGER(IntKi), PARAMETER :: M3N2FAMxi = 3017 - INTEGER(IntKi), PARAMETER :: M3N3FAMxi = 3018 - INTEGER(IntKi), PARAMETER :: M3N4FAMxi = 3019 - INTEGER(IntKi), PARAMETER :: M3N5FAMxi = 3020 - INTEGER(IntKi), PARAMETER :: M3N6FAMxi = 3021 - INTEGER(IntKi), PARAMETER :: M3N7FAMxi = 3022 - INTEGER(IntKi), PARAMETER :: M3N8FAMxi = 3023 - INTEGER(IntKi), PARAMETER :: M3N9FAMxi = 3024 - INTEGER(IntKi), PARAMETER :: M4N1FAMxi = 3025 - INTEGER(IntKi), PARAMETER :: M4N2FAMxi = 3026 - INTEGER(IntKi), PARAMETER :: M4N3FAMxi = 3027 - INTEGER(IntKi), PARAMETER :: M4N4FAMxi = 3028 - INTEGER(IntKi), PARAMETER :: M4N5FAMxi = 3029 - INTEGER(IntKi), PARAMETER :: M4N6FAMxi = 3030 - INTEGER(IntKi), PARAMETER :: M4N7FAMxi = 3031 - INTEGER(IntKi), PARAMETER :: M4N8FAMxi = 3032 - INTEGER(IntKi), PARAMETER :: M4N9FAMxi = 3033 - INTEGER(IntKi), PARAMETER :: M5N1FAMxi = 3034 - INTEGER(IntKi), PARAMETER :: M5N2FAMxi = 3035 - INTEGER(IntKi), PARAMETER :: M5N3FAMxi = 3036 - INTEGER(IntKi), PARAMETER :: M5N4FAMxi = 3037 - INTEGER(IntKi), PARAMETER :: M5N5FAMxi = 3038 - INTEGER(IntKi), PARAMETER :: M5N6FAMxi = 3039 - INTEGER(IntKi), PARAMETER :: M5N7FAMxi = 3040 - INTEGER(IntKi), PARAMETER :: M5N8FAMxi = 3041 - INTEGER(IntKi), PARAMETER :: M5N9FAMxi = 3042 - INTEGER(IntKi), PARAMETER :: M6N1FAMxi = 3043 - INTEGER(IntKi), PARAMETER :: M6N2FAMxi = 3044 - INTEGER(IntKi), PARAMETER :: M6N3FAMxi = 3045 - INTEGER(IntKi), PARAMETER :: M6N4FAMxi = 3046 - INTEGER(IntKi), PARAMETER :: M6N5FAMxi = 3047 - INTEGER(IntKi), PARAMETER :: M6N6FAMxi = 3048 - INTEGER(IntKi), PARAMETER :: M6N7FAMxi = 3049 - INTEGER(IntKi), PARAMETER :: M6N8FAMxi = 3050 - INTEGER(IntKi), PARAMETER :: M6N9FAMxi = 3051 - INTEGER(IntKi), PARAMETER :: M7N1FAMxi = 3052 - INTEGER(IntKi), PARAMETER :: M7N2FAMxi = 3053 - INTEGER(IntKi), PARAMETER :: M7N3FAMxi = 3054 - INTEGER(IntKi), PARAMETER :: M7N4FAMxi = 3055 - INTEGER(IntKi), PARAMETER :: M7N5FAMxi = 3056 - INTEGER(IntKi), PARAMETER :: M7N6FAMxi = 3057 - INTEGER(IntKi), PARAMETER :: M7N7FAMxi = 3058 - INTEGER(IntKi), PARAMETER :: M7N8FAMxi = 3059 - INTEGER(IntKi), PARAMETER :: M7N9FAMxi = 3060 - INTEGER(IntKi), PARAMETER :: M8N1FAMxi = 3061 - INTEGER(IntKi), PARAMETER :: M8N2FAMxi = 3062 - INTEGER(IntKi), PARAMETER :: M8N3FAMxi = 3063 - INTEGER(IntKi), PARAMETER :: M8N4FAMxi = 3064 - INTEGER(IntKi), PARAMETER :: M8N5FAMxi = 3065 - INTEGER(IntKi), PARAMETER :: M8N6FAMxi = 3066 - INTEGER(IntKi), PARAMETER :: M8N7FAMxi = 3067 - INTEGER(IntKi), PARAMETER :: M8N8FAMxi = 3068 - INTEGER(IntKi), PARAMETER :: M8N9FAMxi = 3069 - INTEGER(IntKi), PARAMETER :: M9N1FAMxi = 3070 - INTEGER(IntKi), PARAMETER :: M9N2FAMxi = 3071 - INTEGER(IntKi), PARAMETER :: M9N3FAMxi = 3072 - INTEGER(IntKi), PARAMETER :: M9N4FAMxi = 3073 - INTEGER(IntKi), PARAMETER :: M9N5FAMxi = 3074 - INTEGER(IntKi), PARAMETER :: M9N6FAMxi = 3075 - INTEGER(IntKi), PARAMETER :: M9N7FAMxi = 3076 - INTEGER(IntKi), PARAMETER :: M9N8FAMxi = 3077 - INTEGER(IntKi), PARAMETER :: M9N9FAMxi = 3078 - INTEGER(IntKi), PARAMETER :: M1N1FAMyi = 3079 - INTEGER(IntKi), PARAMETER :: M1N2FAMyi = 3080 - INTEGER(IntKi), PARAMETER :: M1N3FAMyi = 3081 - INTEGER(IntKi), PARAMETER :: M1N4FAMyi = 3082 - INTEGER(IntKi), PARAMETER :: M1N5FAMyi = 3083 - INTEGER(IntKi), PARAMETER :: M1N6FAMyi = 3084 - INTEGER(IntKi), PARAMETER :: M1N7FAMyi = 3085 - INTEGER(IntKi), PARAMETER :: M1N8FAMyi = 3086 - INTEGER(IntKi), PARAMETER :: M1N9FAMyi = 3087 - INTEGER(IntKi), PARAMETER :: M2N1FAMyi = 3088 - INTEGER(IntKi), PARAMETER :: M2N2FAMyi = 3089 - INTEGER(IntKi), PARAMETER :: M2N3FAMyi = 3090 - INTEGER(IntKi), PARAMETER :: M2N4FAMyi = 3091 - INTEGER(IntKi), PARAMETER :: M2N5FAMyi = 3092 - INTEGER(IntKi), PARAMETER :: M2N6FAMyi = 3093 - INTEGER(IntKi), PARAMETER :: M2N7FAMyi = 3094 - INTEGER(IntKi), PARAMETER :: M2N8FAMyi = 3095 - INTEGER(IntKi), PARAMETER :: M2N9FAMyi = 3096 - INTEGER(IntKi), PARAMETER :: M3N1FAMyi = 3097 - INTEGER(IntKi), PARAMETER :: M3N2FAMyi = 3098 - INTEGER(IntKi), PARAMETER :: M3N3FAMyi = 3099 - INTEGER(IntKi), PARAMETER :: M3N4FAMyi = 3100 - INTEGER(IntKi), PARAMETER :: M3N5FAMyi = 3101 - INTEGER(IntKi), PARAMETER :: M3N6FAMyi = 3102 - INTEGER(IntKi), PARAMETER :: M3N7FAMyi = 3103 - INTEGER(IntKi), PARAMETER :: M3N8FAMyi = 3104 - INTEGER(IntKi), PARAMETER :: M3N9FAMyi = 3105 - INTEGER(IntKi), PARAMETER :: M4N1FAMyi = 3106 - INTEGER(IntKi), PARAMETER :: M4N2FAMyi = 3107 - INTEGER(IntKi), PARAMETER :: M4N3FAMyi = 3108 - INTEGER(IntKi), PARAMETER :: M4N4FAMyi = 3109 - INTEGER(IntKi), PARAMETER :: M4N5FAMyi = 3110 - INTEGER(IntKi), PARAMETER :: M4N6FAMyi = 3111 - INTEGER(IntKi), PARAMETER :: M4N7FAMyi = 3112 - INTEGER(IntKi), PARAMETER :: M4N8FAMyi = 3113 - INTEGER(IntKi), PARAMETER :: M4N9FAMyi = 3114 - INTEGER(IntKi), PARAMETER :: M5N1FAMyi = 3115 - INTEGER(IntKi), PARAMETER :: M5N2FAMyi = 3116 - INTEGER(IntKi), PARAMETER :: M5N3FAMyi = 3117 - INTEGER(IntKi), PARAMETER :: M5N4FAMyi = 3118 - INTEGER(IntKi), PARAMETER :: M5N5FAMyi = 3119 - INTEGER(IntKi), PARAMETER :: M5N6FAMyi = 3120 - INTEGER(IntKi), PARAMETER :: M5N7FAMyi = 3121 - INTEGER(IntKi), PARAMETER :: M5N8FAMyi = 3122 - INTEGER(IntKi), PARAMETER :: M5N9FAMyi = 3123 - INTEGER(IntKi), PARAMETER :: M6N1FAMyi = 3124 - INTEGER(IntKi), PARAMETER :: M6N2FAMyi = 3125 - INTEGER(IntKi), PARAMETER :: M6N3FAMyi = 3126 - INTEGER(IntKi), PARAMETER :: M6N4FAMyi = 3127 - INTEGER(IntKi), PARAMETER :: M6N5FAMyi = 3128 - INTEGER(IntKi), PARAMETER :: M6N6FAMyi = 3129 - INTEGER(IntKi), PARAMETER :: M6N7FAMyi = 3130 - INTEGER(IntKi), PARAMETER :: M6N8FAMyi = 3131 - INTEGER(IntKi), PARAMETER :: M6N9FAMyi = 3132 - INTEGER(IntKi), PARAMETER :: M7N1FAMyi = 3133 - INTEGER(IntKi), PARAMETER :: M7N2FAMyi = 3134 - INTEGER(IntKi), PARAMETER :: M7N3FAMyi = 3135 - INTEGER(IntKi), PARAMETER :: M7N4FAMyi = 3136 - INTEGER(IntKi), PARAMETER :: M7N5FAMyi = 3137 - INTEGER(IntKi), PARAMETER :: M7N6FAMyi = 3138 - INTEGER(IntKi), PARAMETER :: M7N7FAMyi = 3139 - INTEGER(IntKi), PARAMETER :: M7N8FAMyi = 3140 - INTEGER(IntKi), PARAMETER :: M7N9FAMyi = 3141 - INTEGER(IntKi), PARAMETER :: M8N1FAMyi = 3142 - INTEGER(IntKi), PARAMETER :: M8N2FAMyi = 3143 - INTEGER(IntKi), PARAMETER :: M8N3FAMyi = 3144 - INTEGER(IntKi), PARAMETER :: M8N4FAMyi = 3145 - INTEGER(IntKi), PARAMETER :: M8N5FAMyi = 3146 - INTEGER(IntKi), PARAMETER :: M8N6FAMyi = 3147 - INTEGER(IntKi), PARAMETER :: M8N7FAMyi = 3148 - INTEGER(IntKi), PARAMETER :: M8N8FAMyi = 3149 - INTEGER(IntKi), PARAMETER :: M8N9FAMyi = 3150 - INTEGER(IntKi), PARAMETER :: M9N1FAMyi = 3151 - INTEGER(IntKi), PARAMETER :: M9N2FAMyi = 3152 - INTEGER(IntKi), PARAMETER :: M9N3FAMyi = 3153 - INTEGER(IntKi), PARAMETER :: M9N4FAMyi = 3154 - INTEGER(IntKi), PARAMETER :: M9N5FAMyi = 3155 - INTEGER(IntKi), PARAMETER :: M9N6FAMyi = 3156 - INTEGER(IntKi), PARAMETER :: M9N7FAMyi = 3157 - INTEGER(IntKi), PARAMETER :: M9N8FAMyi = 3158 - INTEGER(IntKi), PARAMETER :: M9N9FAMyi = 3159 - INTEGER(IntKi), PARAMETER :: M1N1FAMzi = 3160 - INTEGER(IntKi), PARAMETER :: M1N2FAMzi = 3161 - INTEGER(IntKi), PARAMETER :: M1N3FAMzi = 3162 - INTEGER(IntKi), PARAMETER :: M1N4FAMzi = 3163 - INTEGER(IntKi), PARAMETER :: M1N5FAMzi = 3164 - INTEGER(IntKi), PARAMETER :: M1N6FAMzi = 3165 - INTEGER(IntKi), PARAMETER :: M1N7FAMzi = 3166 - INTEGER(IntKi), PARAMETER :: M1N8FAMzi = 3167 - INTEGER(IntKi), PARAMETER :: M1N9FAMzi = 3168 - INTEGER(IntKi), PARAMETER :: M2N1FAMzi = 3169 - INTEGER(IntKi), PARAMETER :: M2N2FAMzi = 3170 - INTEGER(IntKi), PARAMETER :: M2N3FAMzi = 3171 - INTEGER(IntKi), PARAMETER :: M2N4FAMzi = 3172 - INTEGER(IntKi), PARAMETER :: M2N5FAMzi = 3173 - INTEGER(IntKi), PARAMETER :: M2N6FAMzi = 3174 - INTEGER(IntKi), PARAMETER :: M2N7FAMzi = 3175 - INTEGER(IntKi), PARAMETER :: M2N8FAMzi = 3176 - INTEGER(IntKi), PARAMETER :: M2N9FAMzi = 3177 - INTEGER(IntKi), PARAMETER :: M3N1FAMzi = 3178 - INTEGER(IntKi), PARAMETER :: M3N2FAMzi = 3179 - INTEGER(IntKi), PARAMETER :: M3N3FAMzi = 3180 - INTEGER(IntKi), PARAMETER :: M3N4FAMzi = 3181 - INTEGER(IntKi), PARAMETER :: M3N5FAMzi = 3182 - INTEGER(IntKi), PARAMETER :: M3N6FAMzi = 3183 - INTEGER(IntKi), PARAMETER :: M3N7FAMzi = 3184 - INTEGER(IntKi), PARAMETER :: M3N8FAMzi = 3185 - INTEGER(IntKi), PARAMETER :: M3N9FAMzi = 3186 - INTEGER(IntKi), PARAMETER :: M4N1FAMzi = 3187 - INTEGER(IntKi), PARAMETER :: M4N2FAMzi = 3188 - INTEGER(IntKi), PARAMETER :: M4N3FAMzi = 3189 - INTEGER(IntKi), PARAMETER :: M4N4FAMzi = 3190 - INTEGER(IntKi), PARAMETER :: M4N5FAMzi = 3191 - INTEGER(IntKi), PARAMETER :: M4N6FAMzi = 3192 - INTEGER(IntKi), PARAMETER :: M4N7FAMzi = 3193 - INTEGER(IntKi), PARAMETER :: M4N8FAMzi = 3194 - INTEGER(IntKi), PARAMETER :: M4N9FAMzi = 3195 - INTEGER(IntKi), PARAMETER :: M5N1FAMzi = 3196 - INTEGER(IntKi), PARAMETER :: M5N2FAMzi = 3197 - INTEGER(IntKi), PARAMETER :: M5N3FAMzi = 3198 - INTEGER(IntKi), PARAMETER :: M5N4FAMzi = 3199 - INTEGER(IntKi), PARAMETER :: M5N5FAMzi = 3200 - INTEGER(IntKi), PARAMETER :: M5N6FAMzi = 3201 - INTEGER(IntKi), PARAMETER :: M5N7FAMzi = 3202 - INTEGER(IntKi), PARAMETER :: M5N8FAMzi = 3203 - INTEGER(IntKi), PARAMETER :: M5N9FAMzi = 3204 - INTEGER(IntKi), PARAMETER :: M6N1FAMzi = 3205 - INTEGER(IntKi), PARAMETER :: M6N2FAMzi = 3206 - INTEGER(IntKi), PARAMETER :: M6N3FAMzi = 3207 - INTEGER(IntKi), PARAMETER :: M6N4FAMzi = 3208 - INTEGER(IntKi), PARAMETER :: M6N5FAMzi = 3209 - INTEGER(IntKi), PARAMETER :: M6N6FAMzi = 3210 - INTEGER(IntKi), PARAMETER :: M6N7FAMzi = 3211 - INTEGER(IntKi), PARAMETER :: M6N8FAMzi = 3212 - INTEGER(IntKi), PARAMETER :: M6N9FAMzi = 3213 - INTEGER(IntKi), PARAMETER :: M7N1FAMzi = 3214 - INTEGER(IntKi), PARAMETER :: M7N2FAMzi = 3215 - INTEGER(IntKi), PARAMETER :: M7N3FAMzi = 3216 - INTEGER(IntKi), PARAMETER :: M7N4FAMzi = 3217 - INTEGER(IntKi), PARAMETER :: M7N5FAMzi = 3218 - INTEGER(IntKi), PARAMETER :: M7N6FAMzi = 3219 - INTEGER(IntKi), PARAMETER :: M7N7FAMzi = 3220 - INTEGER(IntKi), PARAMETER :: M7N8FAMzi = 3221 - INTEGER(IntKi), PARAMETER :: M7N9FAMzi = 3222 - INTEGER(IntKi), PARAMETER :: M8N1FAMzi = 3223 - INTEGER(IntKi), PARAMETER :: M8N2FAMzi = 3224 - INTEGER(IntKi), PARAMETER :: M8N3FAMzi = 3225 - INTEGER(IntKi), PARAMETER :: M8N4FAMzi = 3226 - INTEGER(IntKi), PARAMETER :: M8N5FAMzi = 3227 - INTEGER(IntKi), PARAMETER :: M8N6FAMzi = 3228 - INTEGER(IntKi), PARAMETER :: M8N7FAMzi = 3229 - INTEGER(IntKi), PARAMETER :: M8N8FAMzi = 3230 - INTEGER(IntKi), PARAMETER :: M8N9FAMzi = 3231 - INTEGER(IntKi), PARAMETER :: M9N1FAMzi = 3232 - INTEGER(IntKi), PARAMETER :: M9N2FAMzi = 3233 - INTEGER(IntKi), PARAMETER :: M9N3FAMzi = 3234 - INTEGER(IntKi), PARAMETER :: M9N4FAMzi = 3235 - INTEGER(IntKi), PARAMETER :: M9N5FAMzi = 3236 - INTEGER(IntKi), PARAMETER :: M9N6FAMzi = 3237 - INTEGER(IntKi), PARAMETER :: M9N7FAMzi = 3238 - INTEGER(IntKi), PARAMETER :: M9N8FAMzi = 3239 - INTEGER(IntKi), PARAMETER :: M9N9FAMzi = 3240 - INTEGER(IntKi), PARAMETER :: M1N1FAGxi = 3241 - INTEGER(IntKi), PARAMETER :: M1N2FAGxi = 3242 - INTEGER(IntKi), PARAMETER :: M1N3FAGxi = 3243 - INTEGER(IntKi), PARAMETER :: M1N4FAGxi = 3244 - INTEGER(IntKi), PARAMETER :: M1N5FAGxi = 3245 - INTEGER(IntKi), PARAMETER :: M1N6FAGxi = 3246 - INTEGER(IntKi), PARAMETER :: M1N7FAGxi = 3247 - INTEGER(IntKi), PARAMETER :: M1N8FAGxi = 3248 - INTEGER(IntKi), PARAMETER :: M1N9FAGxi = 3249 - INTEGER(IntKi), PARAMETER :: M2N1FAGxi = 3250 - INTEGER(IntKi), PARAMETER :: M2N2FAGxi = 3251 - INTEGER(IntKi), PARAMETER :: M2N3FAGxi = 3252 - INTEGER(IntKi), PARAMETER :: M2N4FAGxi = 3253 - INTEGER(IntKi), PARAMETER :: M2N5FAGxi = 3254 - INTEGER(IntKi), PARAMETER :: M2N6FAGxi = 3255 - INTEGER(IntKi), PARAMETER :: M2N7FAGxi = 3256 - INTEGER(IntKi), PARAMETER :: M2N8FAGxi = 3257 - INTEGER(IntKi), PARAMETER :: M2N9FAGxi = 3258 - INTEGER(IntKi), PARAMETER :: M3N1FAGxi = 3259 - INTEGER(IntKi), PARAMETER :: M3N2FAGxi = 3260 - INTEGER(IntKi), PARAMETER :: M3N3FAGxi = 3261 - INTEGER(IntKi), PARAMETER :: M3N4FAGxi = 3262 - INTEGER(IntKi), PARAMETER :: M3N5FAGxi = 3263 - INTEGER(IntKi), PARAMETER :: M3N6FAGxi = 3264 - INTEGER(IntKi), PARAMETER :: M3N7FAGxi = 3265 - INTEGER(IntKi), PARAMETER :: M3N8FAGxi = 3266 - INTEGER(IntKi), PARAMETER :: M3N9FAGxi = 3267 - INTEGER(IntKi), PARAMETER :: M4N1FAGxi = 3268 - INTEGER(IntKi), PARAMETER :: M4N2FAGxi = 3269 - INTEGER(IntKi), PARAMETER :: M4N3FAGxi = 3270 - INTEGER(IntKi), PARAMETER :: M4N4FAGxi = 3271 - INTEGER(IntKi), PARAMETER :: M4N5FAGxi = 3272 - INTEGER(IntKi), PARAMETER :: M4N6FAGxi = 3273 - INTEGER(IntKi), PARAMETER :: M4N7FAGxi = 3274 - INTEGER(IntKi), PARAMETER :: M4N8FAGxi = 3275 - INTEGER(IntKi), PARAMETER :: M4N9FAGxi = 3276 - INTEGER(IntKi), PARAMETER :: M5N1FAGxi = 3277 - INTEGER(IntKi), PARAMETER :: M5N2FAGxi = 3278 - INTEGER(IntKi), PARAMETER :: M5N3FAGxi = 3279 - INTEGER(IntKi), PARAMETER :: M5N4FAGxi = 3280 - INTEGER(IntKi), PARAMETER :: M5N5FAGxi = 3281 - INTEGER(IntKi), PARAMETER :: M5N6FAGxi = 3282 - INTEGER(IntKi), PARAMETER :: M5N7FAGxi = 3283 - INTEGER(IntKi), PARAMETER :: M5N8FAGxi = 3284 - INTEGER(IntKi), PARAMETER :: M5N9FAGxi = 3285 - INTEGER(IntKi), PARAMETER :: M6N1FAGxi = 3286 - INTEGER(IntKi), PARAMETER :: M6N2FAGxi = 3287 - INTEGER(IntKi), PARAMETER :: M6N3FAGxi = 3288 - INTEGER(IntKi), PARAMETER :: M6N4FAGxi = 3289 - INTEGER(IntKi), PARAMETER :: M6N5FAGxi = 3290 - INTEGER(IntKi), PARAMETER :: M6N6FAGxi = 3291 - INTEGER(IntKi), PARAMETER :: M6N7FAGxi = 3292 - INTEGER(IntKi), PARAMETER :: M6N8FAGxi = 3293 - INTEGER(IntKi), PARAMETER :: M6N9FAGxi = 3294 - INTEGER(IntKi), PARAMETER :: M7N1FAGxi = 3295 - INTEGER(IntKi), PARAMETER :: M7N2FAGxi = 3296 - INTEGER(IntKi), PARAMETER :: M7N3FAGxi = 3297 - INTEGER(IntKi), PARAMETER :: M7N4FAGxi = 3298 - INTEGER(IntKi), PARAMETER :: M7N5FAGxi = 3299 - INTEGER(IntKi), PARAMETER :: M7N6FAGxi = 3300 - INTEGER(IntKi), PARAMETER :: M7N7FAGxi = 3301 - INTEGER(IntKi), PARAMETER :: M7N8FAGxi = 3302 - INTEGER(IntKi), PARAMETER :: M7N9FAGxi = 3303 - INTEGER(IntKi), PARAMETER :: M8N1FAGxi = 3304 - INTEGER(IntKi), PARAMETER :: M8N2FAGxi = 3305 - INTEGER(IntKi), PARAMETER :: M8N3FAGxi = 3306 - INTEGER(IntKi), PARAMETER :: M8N4FAGxi = 3307 - INTEGER(IntKi), PARAMETER :: M8N5FAGxi = 3308 - INTEGER(IntKi), PARAMETER :: M8N6FAGxi = 3309 - INTEGER(IntKi), PARAMETER :: M8N7FAGxi = 3310 - INTEGER(IntKi), PARAMETER :: M8N8FAGxi = 3311 - INTEGER(IntKi), PARAMETER :: M8N9FAGxi = 3312 - INTEGER(IntKi), PARAMETER :: M9N1FAGxi = 3313 - INTEGER(IntKi), PARAMETER :: M9N2FAGxi = 3314 - INTEGER(IntKi), PARAMETER :: M9N3FAGxi = 3315 - INTEGER(IntKi), PARAMETER :: M9N4FAGxi = 3316 - INTEGER(IntKi), PARAMETER :: M9N5FAGxi = 3317 - INTEGER(IntKi), PARAMETER :: M9N6FAGxi = 3318 - INTEGER(IntKi), PARAMETER :: M9N7FAGxi = 3319 - INTEGER(IntKi), PARAMETER :: M9N8FAGxi = 3320 - INTEGER(IntKi), PARAMETER :: M9N9FAGxi = 3321 - INTEGER(IntKi), PARAMETER :: M1N1FAGyi = 3322 - INTEGER(IntKi), PARAMETER :: M1N2FAGyi = 3323 - INTEGER(IntKi), PARAMETER :: M1N3FAGyi = 3324 - INTEGER(IntKi), PARAMETER :: M1N4FAGyi = 3325 - INTEGER(IntKi), PARAMETER :: M1N5FAGyi = 3326 - INTEGER(IntKi), PARAMETER :: M1N6FAGyi = 3327 - INTEGER(IntKi), PARAMETER :: M1N7FAGyi = 3328 - INTEGER(IntKi), PARAMETER :: M1N8FAGyi = 3329 - INTEGER(IntKi), PARAMETER :: M1N9FAGyi = 3330 - INTEGER(IntKi), PARAMETER :: M2N1FAGyi = 3331 - INTEGER(IntKi), PARAMETER :: M2N2FAGyi = 3332 - INTEGER(IntKi), PARAMETER :: M2N3FAGyi = 3333 - INTEGER(IntKi), PARAMETER :: M2N4FAGyi = 3334 - INTEGER(IntKi), PARAMETER :: M2N5FAGyi = 3335 - INTEGER(IntKi), PARAMETER :: M2N6FAGyi = 3336 - INTEGER(IntKi), PARAMETER :: M2N7FAGyi = 3337 - INTEGER(IntKi), PARAMETER :: M2N8FAGyi = 3338 - INTEGER(IntKi), PARAMETER :: M2N9FAGyi = 3339 - INTEGER(IntKi), PARAMETER :: M3N1FAGyi = 3340 - INTEGER(IntKi), PARAMETER :: M3N2FAGyi = 3341 - INTEGER(IntKi), PARAMETER :: M3N3FAGyi = 3342 - INTEGER(IntKi), PARAMETER :: M3N4FAGyi = 3343 - INTEGER(IntKi), PARAMETER :: M3N5FAGyi = 3344 - INTEGER(IntKi), PARAMETER :: M3N6FAGyi = 3345 - INTEGER(IntKi), PARAMETER :: M3N7FAGyi = 3346 - INTEGER(IntKi), PARAMETER :: M3N8FAGyi = 3347 - INTEGER(IntKi), PARAMETER :: M3N9FAGyi = 3348 - INTEGER(IntKi), PARAMETER :: M4N1FAGyi = 3349 - INTEGER(IntKi), PARAMETER :: M4N2FAGyi = 3350 - INTEGER(IntKi), PARAMETER :: M4N3FAGyi = 3351 - INTEGER(IntKi), PARAMETER :: M4N4FAGyi = 3352 - INTEGER(IntKi), PARAMETER :: M4N5FAGyi = 3353 - INTEGER(IntKi), PARAMETER :: M4N6FAGyi = 3354 - INTEGER(IntKi), PARAMETER :: M4N7FAGyi = 3355 - INTEGER(IntKi), PARAMETER :: M4N8FAGyi = 3356 - INTEGER(IntKi), PARAMETER :: M4N9FAGyi = 3357 - INTEGER(IntKi), PARAMETER :: M5N1FAGyi = 3358 - INTEGER(IntKi), PARAMETER :: M5N2FAGyi = 3359 - INTEGER(IntKi), PARAMETER :: M5N3FAGyi = 3360 - INTEGER(IntKi), PARAMETER :: M5N4FAGyi = 3361 - INTEGER(IntKi), PARAMETER :: M5N5FAGyi = 3362 - INTEGER(IntKi), PARAMETER :: M5N6FAGyi = 3363 - INTEGER(IntKi), PARAMETER :: M5N7FAGyi = 3364 - INTEGER(IntKi), PARAMETER :: M5N8FAGyi = 3365 - INTEGER(IntKi), PARAMETER :: M5N9FAGyi = 3366 - INTEGER(IntKi), PARAMETER :: M6N1FAGyi = 3367 - INTEGER(IntKi), PARAMETER :: M6N2FAGyi = 3368 - INTEGER(IntKi), PARAMETER :: M6N3FAGyi = 3369 - INTEGER(IntKi), PARAMETER :: M6N4FAGyi = 3370 - INTEGER(IntKi), PARAMETER :: M6N5FAGyi = 3371 - INTEGER(IntKi), PARAMETER :: M6N6FAGyi = 3372 - INTEGER(IntKi), PARAMETER :: M6N7FAGyi = 3373 - INTEGER(IntKi), PARAMETER :: M6N8FAGyi = 3374 - INTEGER(IntKi), PARAMETER :: M6N9FAGyi = 3375 - INTEGER(IntKi), PARAMETER :: M7N1FAGyi = 3376 - INTEGER(IntKi), PARAMETER :: M7N2FAGyi = 3377 - INTEGER(IntKi), PARAMETER :: M7N3FAGyi = 3378 - INTEGER(IntKi), PARAMETER :: M7N4FAGyi = 3379 - INTEGER(IntKi), PARAMETER :: M7N5FAGyi = 3380 - INTEGER(IntKi), PARAMETER :: M7N6FAGyi = 3381 - INTEGER(IntKi), PARAMETER :: M7N7FAGyi = 3382 - INTEGER(IntKi), PARAMETER :: M7N8FAGyi = 3383 - INTEGER(IntKi), PARAMETER :: M7N9FAGyi = 3384 - INTEGER(IntKi), PARAMETER :: M8N1FAGyi = 3385 - INTEGER(IntKi), PARAMETER :: M8N2FAGyi = 3386 - INTEGER(IntKi), PARAMETER :: M8N3FAGyi = 3387 - INTEGER(IntKi), PARAMETER :: M8N4FAGyi = 3388 - INTEGER(IntKi), PARAMETER :: M8N5FAGyi = 3389 - INTEGER(IntKi), PARAMETER :: M8N6FAGyi = 3390 - INTEGER(IntKi), PARAMETER :: M8N7FAGyi = 3391 - INTEGER(IntKi), PARAMETER :: M8N8FAGyi = 3392 - INTEGER(IntKi), PARAMETER :: M8N9FAGyi = 3393 - INTEGER(IntKi), PARAMETER :: M9N1FAGyi = 3394 - INTEGER(IntKi), PARAMETER :: M9N2FAGyi = 3395 - INTEGER(IntKi), PARAMETER :: M9N3FAGyi = 3396 - INTEGER(IntKi), PARAMETER :: M9N4FAGyi = 3397 - INTEGER(IntKi), PARAMETER :: M9N5FAGyi = 3398 - INTEGER(IntKi), PARAMETER :: M9N6FAGyi = 3399 - INTEGER(IntKi), PARAMETER :: M9N7FAGyi = 3400 - INTEGER(IntKi), PARAMETER :: M9N8FAGyi = 3401 - INTEGER(IntKi), PARAMETER :: M9N9FAGyi = 3402 - INTEGER(IntKi), PARAMETER :: M1N1FAGzi = 3403 - INTEGER(IntKi), PARAMETER :: M1N2FAGzi = 3404 - INTEGER(IntKi), PARAMETER :: M1N3FAGzi = 3405 - INTEGER(IntKi), PARAMETER :: M1N4FAGzi = 3406 - INTEGER(IntKi), PARAMETER :: M1N5FAGzi = 3407 - INTEGER(IntKi), PARAMETER :: M1N6FAGzi = 3408 - INTEGER(IntKi), PARAMETER :: M1N7FAGzi = 3409 - INTEGER(IntKi), PARAMETER :: M1N8FAGzi = 3410 - INTEGER(IntKi), PARAMETER :: M1N9FAGzi = 3411 - INTEGER(IntKi), PARAMETER :: M2N1FAGzi = 3412 - INTEGER(IntKi), PARAMETER :: M2N2FAGzi = 3413 - INTEGER(IntKi), PARAMETER :: M2N3FAGzi = 3414 - INTEGER(IntKi), PARAMETER :: M2N4FAGzi = 3415 - INTEGER(IntKi), PARAMETER :: M2N5FAGzi = 3416 - INTEGER(IntKi), PARAMETER :: M2N6FAGzi = 3417 - INTEGER(IntKi), PARAMETER :: M2N7FAGzi = 3418 - INTEGER(IntKi), PARAMETER :: M2N8FAGzi = 3419 - INTEGER(IntKi), PARAMETER :: M2N9FAGzi = 3420 - INTEGER(IntKi), PARAMETER :: M3N1FAGzi = 3421 - INTEGER(IntKi), PARAMETER :: M3N2FAGzi = 3422 - INTEGER(IntKi), PARAMETER :: M3N3FAGzi = 3423 - INTEGER(IntKi), PARAMETER :: M3N4FAGzi = 3424 - INTEGER(IntKi), PARAMETER :: M3N5FAGzi = 3425 - INTEGER(IntKi), PARAMETER :: M3N6FAGzi = 3426 - INTEGER(IntKi), PARAMETER :: M3N7FAGzi = 3427 - INTEGER(IntKi), PARAMETER :: M3N8FAGzi = 3428 - INTEGER(IntKi), PARAMETER :: M3N9FAGzi = 3429 - INTEGER(IntKi), PARAMETER :: M4N1FAGzi = 3430 - INTEGER(IntKi), PARAMETER :: M4N2FAGzi = 3431 - INTEGER(IntKi), PARAMETER :: M4N3FAGzi = 3432 - INTEGER(IntKi), PARAMETER :: M4N4FAGzi = 3433 - INTEGER(IntKi), PARAMETER :: M4N5FAGzi = 3434 - INTEGER(IntKi), PARAMETER :: M4N6FAGzi = 3435 - INTEGER(IntKi), PARAMETER :: M4N7FAGzi = 3436 - INTEGER(IntKi), PARAMETER :: M4N8FAGzi = 3437 - INTEGER(IntKi), PARAMETER :: M4N9FAGzi = 3438 - INTEGER(IntKi), PARAMETER :: M5N1FAGzi = 3439 - INTEGER(IntKi), PARAMETER :: M5N2FAGzi = 3440 - INTEGER(IntKi), PARAMETER :: M5N3FAGzi = 3441 - INTEGER(IntKi), PARAMETER :: M5N4FAGzi = 3442 - INTEGER(IntKi), PARAMETER :: M5N5FAGzi = 3443 - INTEGER(IntKi), PARAMETER :: M5N6FAGzi = 3444 - INTEGER(IntKi), PARAMETER :: M5N7FAGzi = 3445 - INTEGER(IntKi), PARAMETER :: M5N8FAGzi = 3446 - INTEGER(IntKi), PARAMETER :: M5N9FAGzi = 3447 - INTEGER(IntKi), PARAMETER :: M6N1FAGzi = 3448 - INTEGER(IntKi), PARAMETER :: M6N2FAGzi = 3449 - INTEGER(IntKi), PARAMETER :: M6N3FAGzi = 3450 - INTEGER(IntKi), PARAMETER :: M6N4FAGzi = 3451 - INTEGER(IntKi), PARAMETER :: M6N5FAGzi = 3452 - INTEGER(IntKi), PARAMETER :: M6N6FAGzi = 3453 - INTEGER(IntKi), PARAMETER :: M6N7FAGzi = 3454 - INTEGER(IntKi), PARAMETER :: M6N8FAGzi = 3455 - INTEGER(IntKi), PARAMETER :: M6N9FAGzi = 3456 - INTEGER(IntKi), PARAMETER :: M7N1FAGzi = 3457 - INTEGER(IntKi), PARAMETER :: M7N2FAGzi = 3458 - INTEGER(IntKi), PARAMETER :: M7N3FAGzi = 3459 - INTEGER(IntKi), PARAMETER :: M7N4FAGzi = 3460 - INTEGER(IntKi), PARAMETER :: M7N5FAGzi = 3461 - INTEGER(IntKi), PARAMETER :: M7N6FAGzi = 3462 - INTEGER(IntKi), PARAMETER :: M7N7FAGzi = 3463 - INTEGER(IntKi), PARAMETER :: M7N8FAGzi = 3464 - INTEGER(IntKi), PARAMETER :: M7N9FAGzi = 3465 - INTEGER(IntKi), PARAMETER :: M8N1FAGzi = 3466 - INTEGER(IntKi), PARAMETER :: M8N2FAGzi = 3467 - INTEGER(IntKi), PARAMETER :: M8N3FAGzi = 3468 - INTEGER(IntKi), PARAMETER :: M8N4FAGzi = 3469 - INTEGER(IntKi), PARAMETER :: M8N5FAGzi = 3470 - INTEGER(IntKi), PARAMETER :: M8N6FAGzi = 3471 - INTEGER(IntKi), PARAMETER :: M8N7FAGzi = 3472 - INTEGER(IntKi), PARAMETER :: M8N8FAGzi = 3473 - INTEGER(IntKi), PARAMETER :: M8N9FAGzi = 3474 - INTEGER(IntKi), PARAMETER :: M9N1FAGzi = 3475 - INTEGER(IntKi), PARAMETER :: M9N2FAGzi = 3476 - INTEGER(IntKi), PARAMETER :: M9N3FAGzi = 3477 - INTEGER(IntKi), PARAMETER :: M9N4FAGzi = 3478 - INTEGER(IntKi), PARAMETER :: M9N5FAGzi = 3479 - INTEGER(IntKi), PARAMETER :: M9N6FAGzi = 3480 - INTEGER(IntKi), PARAMETER :: M9N7FAGzi = 3481 - INTEGER(IntKi), PARAMETER :: M9N8FAGzi = 3482 - INTEGER(IntKi), PARAMETER :: M9N9FAGzi = 3483 - INTEGER(IntKi), PARAMETER :: M1N1MAGxi = 3484 - INTEGER(IntKi), PARAMETER :: M1N2MAGxi = 3485 - INTEGER(IntKi), PARAMETER :: M1N3MAGxi = 3486 - INTEGER(IntKi), PARAMETER :: M1N4MAGxi = 3487 - INTEGER(IntKi), PARAMETER :: M1N5MAGxi = 3488 - INTEGER(IntKi), PARAMETER :: M1N6MAGxi = 3489 - INTEGER(IntKi), PARAMETER :: M1N7MAGxi = 3490 - INTEGER(IntKi), PARAMETER :: M1N8MAGxi = 3491 - INTEGER(IntKi), PARAMETER :: M1N9MAGxi = 3492 - INTEGER(IntKi), PARAMETER :: M2N1MAGxi = 3493 - INTEGER(IntKi), PARAMETER :: M2N2MAGxi = 3494 - INTEGER(IntKi), PARAMETER :: M2N3MAGxi = 3495 - INTEGER(IntKi), PARAMETER :: M2N4MAGxi = 3496 - INTEGER(IntKi), PARAMETER :: M2N5MAGxi = 3497 - INTEGER(IntKi), PARAMETER :: M2N6MAGxi = 3498 - INTEGER(IntKi), PARAMETER :: M2N7MAGxi = 3499 - INTEGER(IntKi), PARAMETER :: M2N8MAGxi = 3500 - INTEGER(IntKi), PARAMETER :: M2N9MAGxi = 3501 - INTEGER(IntKi), PARAMETER :: M3N1MAGxi = 3502 - INTEGER(IntKi), PARAMETER :: M3N2MAGxi = 3503 - INTEGER(IntKi), PARAMETER :: M3N3MAGxi = 3504 - INTEGER(IntKi), PARAMETER :: M3N4MAGxi = 3505 - INTEGER(IntKi), PARAMETER :: M3N5MAGxi = 3506 - INTEGER(IntKi), PARAMETER :: M3N6MAGxi = 3507 - INTEGER(IntKi), PARAMETER :: M3N7MAGxi = 3508 - INTEGER(IntKi), PARAMETER :: M3N8MAGxi = 3509 - INTEGER(IntKi), PARAMETER :: M3N9MAGxi = 3510 - INTEGER(IntKi), PARAMETER :: M4N1MAGxi = 3511 - INTEGER(IntKi), PARAMETER :: M4N2MAGxi = 3512 - INTEGER(IntKi), PARAMETER :: M4N3MAGxi = 3513 - INTEGER(IntKi), PARAMETER :: M4N4MAGxi = 3514 - INTEGER(IntKi), PARAMETER :: M4N5MAGxi = 3515 - INTEGER(IntKi), PARAMETER :: M4N6MAGxi = 3516 - INTEGER(IntKi), PARAMETER :: M4N7MAGxi = 3517 - INTEGER(IntKi), PARAMETER :: M4N8MAGxi = 3518 - INTEGER(IntKi), PARAMETER :: M4N9MAGxi = 3519 - INTEGER(IntKi), PARAMETER :: M5N1MAGxi = 3520 - INTEGER(IntKi), PARAMETER :: M5N2MAGxi = 3521 - INTEGER(IntKi), PARAMETER :: M5N3MAGxi = 3522 - INTEGER(IntKi), PARAMETER :: M5N4MAGxi = 3523 - INTEGER(IntKi), PARAMETER :: M5N5MAGxi = 3524 - INTEGER(IntKi), PARAMETER :: M5N6MAGxi = 3525 - INTEGER(IntKi), PARAMETER :: M5N7MAGxi = 3526 - INTEGER(IntKi), PARAMETER :: M5N8MAGxi = 3527 - INTEGER(IntKi), PARAMETER :: M5N9MAGxi = 3528 - INTEGER(IntKi), PARAMETER :: M6N1MAGxi = 3529 - INTEGER(IntKi), PARAMETER :: M6N2MAGxi = 3530 - INTEGER(IntKi), PARAMETER :: M6N3MAGxi = 3531 - INTEGER(IntKi), PARAMETER :: M6N4MAGxi = 3532 - INTEGER(IntKi), PARAMETER :: M6N5MAGxi = 3533 - INTEGER(IntKi), PARAMETER :: M6N6MAGxi = 3534 - INTEGER(IntKi), PARAMETER :: M6N7MAGxi = 3535 - INTEGER(IntKi), PARAMETER :: M6N8MAGxi = 3536 - INTEGER(IntKi), PARAMETER :: M6N9MAGxi = 3537 - INTEGER(IntKi), PARAMETER :: M7N1MAGxi = 3538 - INTEGER(IntKi), PARAMETER :: M7N2MAGxi = 3539 - INTEGER(IntKi), PARAMETER :: M7N3MAGxi = 3540 - INTEGER(IntKi), PARAMETER :: M7N4MAGxi = 3541 - INTEGER(IntKi), PARAMETER :: M7N5MAGxi = 3542 - INTEGER(IntKi), PARAMETER :: M7N6MAGxi = 3543 - INTEGER(IntKi), PARAMETER :: M7N7MAGxi = 3544 - INTEGER(IntKi), PARAMETER :: M7N8MAGxi = 3545 - INTEGER(IntKi), PARAMETER :: M7N9MAGxi = 3546 - INTEGER(IntKi), PARAMETER :: M8N1MAGxi = 3547 - INTEGER(IntKi), PARAMETER :: M8N2MAGxi = 3548 - INTEGER(IntKi), PARAMETER :: M8N3MAGxi = 3549 - INTEGER(IntKi), PARAMETER :: M8N4MAGxi = 3550 - INTEGER(IntKi), PARAMETER :: M8N5MAGxi = 3551 - INTEGER(IntKi), PARAMETER :: M8N6MAGxi = 3552 - INTEGER(IntKi), PARAMETER :: M8N7MAGxi = 3553 - INTEGER(IntKi), PARAMETER :: M8N8MAGxi = 3554 - INTEGER(IntKi), PARAMETER :: M8N9MAGxi = 3555 - INTEGER(IntKi), PARAMETER :: M9N1MAGxi = 3556 - INTEGER(IntKi), PARAMETER :: M9N2MAGxi = 3557 - INTEGER(IntKi), PARAMETER :: M9N3MAGxi = 3558 - INTEGER(IntKi), PARAMETER :: M9N4MAGxi = 3559 - INTEGER(IntKi), PARAMETER :: M9N5MAGxi = 3560 - INTEGER(IntKi), PARAMETER :: M9N6MAGxi = 3561 - INTEGER(IntKi), PARAMETER :: M9N7MAGxi = 3562 - INTEGER(IntKi), PARAMETER :: M9N8MAGxi = 3563 - INTEGER(IntKi), PARAMETER :: M9N9MAGxi = 3564 - INTEGER(IntKi), PARAMETER :: M1N1MAGyi = 3565 - INTEGER(IntKi), PARAMETER :: M1N2MAGyi = 3566 - INTEGER(IntKi), PARAMETER :: M1N3MAGyi = 3567 - INTEGER(IntKi), PARAMETER :: M1N4MAGyi = 3568 - INTEGER(IntKi), PARAMETER :: M1N5MAGyi = 3569 - INTEGER(IntKi), PARAMETER :: M1N6MAGyi = 3570 - INTEGER(IntKi), PARAMETER :: M1N7MAGyi = 3571 - INTEGER(IntKi), PARAMETER :: M1N8MAGyi = 3572 - INTEGER(IntKi), PARAMETER :: M1N9MAGyi = 3573 - INTEGER(IntKi), PARAMETER :: M2N1MAGyi = 3574 - INTEGER(IntKi), PARAMETER :: M2N2MAGyi = 3575 - INTEGER(IntKi), PARAMETER :: M2N3MAGyi = 3576 - INTEGER(IntKi), PARAMETER :: M2N4MAGyi = 3577 - INTEGER(IntKi), PARAMETER :: M2N5MAGyi = 3578 - INTEGER(IntKi), PARAMETER :: M2N6MAGyi = 3579 - INTEGER(IntKi), PARAMETER :: M2N7MAGyi = 3580 - INTEGER(IntKi), PARAMETER :: M2N8MAGyi = 3581 - INTEGER(IntKi), PARAMETER :: M2N9MAGyi = 3582 - INTEGER(IntKi), PARAMETER :: M3N1MAGyi = 3583 - INTEGER(IntKi), PARAMETER :: M3N2MAGyi = 3584 - INTEGER(IntKi), PARAMETER :: M3N3MAGyi = 3585 - INTEGER(IntKi), PARAMETER :: M3N4MAGyi = 3586 - INTEGER(IntKi), PARAMETER :: M3N5MAGyi = 3587 - INTEGER(IntKi), PARAMETER :: M3N6MAGyi = 3588 - INTEGER(IntKi), PARAMETER :: M3N7MAGyi = 3589 - INTEGER(IntKi), PARAMETER :: M3N8MAGyi = 3590 - INTEGER(IntKi), PARAMETER :: M3N9MAGyi = 3591 - INTEGER(IntKi), PARAMETER :: M4N1MAGyi = 3592 - INTEGER(IntKi), PARAMETER :: M4N2MAGyi = 3593 - INTEGER(IntKi), PARAMETER :: M4N3MAGyi = 3594 - INTEGER(IntKi), PARAMETER :: M4N4MAGyi = 3595 - INTEGER(IntKi), PARAMETER :: M4N5MAGyi = 3596 - INTEGER(IntKi), PARAMETER :: M4N6MAGyi = 3597 - INTEGER(IntKi), PARAMETER :: M4N7MAGyi = 3598 - INTEGER(IntKi), PARAMETER :: M4N8MAGyi = 3599 - INTEGER(IntKi), PARAMETER :: M4N9MAGyi = 3600 - INTEGER(IntKi), PARAMETER :: M5N1MAGyi = 3601 - INTEGER(IntKi), PARAMETER :: M5N2MAGyi = 3602 - INTEGER(IntKi), PARAMETER :: M5N3MAGyi = 3603 - INTEGER(IntKi), PARAMETER :: M5N4MAGyi = 3604 - INTEGER(IntKi), PARAMETER :: M5N5MAGyi = 3605 - INTEGER(IntKi), PARAMETER :: M5N6MAGyi = 3606 - INTEGER(IntKi), PARAMETER :: M5N7MAGyi = 3607 - INTEGER(IntKi), PARAMETER :: M5N8MAGyi = 3608 - INTEGER(IntKi), PARAMETER :: M5N9MAGyi = 3609 - INTEGER(IntKi), PARAMETER :: M6N1MAGyi = 3610 - INTEGER(IntKi), PARAMETER :: M6N2MAGyi = 3611 - INTEGER(IntKi), PARAMETER :: M6N3MAGyi = 3612 - INTEGER(IntKi), PARAMETER :: M6N4MAGyi = 3613 - INTEGER(IntKi), PARAMETER :: M6N5MAGyi = 3614 - INTEGER(IntKi), PARAMETER :: M6N6MAGyi = 3615 - INTEGER(IntKi), PARAMETER :: M6N7MAGyi = 3616 - INTEGER(IntKi), PARAMETER :: M6N8MAGyi = 3617 - INTEGER(IntKi), PARAMETER :: M6N9MAGyi = 3618 - INTEGER(IntKi), PARAMETER :: M7N1MAGyi = 3619 - INTEGER(IntKi), PARAMETER :: M7N2MAGyi = 3620 - INTEGER(IntKi), PARAMETER :: M7N3MAGyi = 3621 - INTEGER(IntKi), PARAMETER :: M7N4MAGyi = 3622 - INTEGER(IntKi), PARAMETER :: M7N5MAGyi = 3623 - INTEGER(IntKi), PARAMETER :: M7N6MAGyi = 3624 - INTEGER(IntKi), PARAMETER :: M7N7MAGyi = 3625 - INTEGER(IntKi), PARAMETER :: M7N8MAGyi = 3626 - INTEGER(IntKi), PARAMETER :: M7N9MAGyi = 3627 - INTEGER(IntKi), PARAMETER :: M8N1MAGyi = 3628 - INTEGER(IntKi), PARAMETER :: M8N2MAGyi = 3629 - INTEGER(IntKi), PARAMETER :: M8N3MAGyi = 3630 - INTEGER(IntKi), PARAMETER :: M8N4MAGyi = 3631 - INTEGER(IntKi), PARAMETER :: M8N5MAGyi = 3632 - INTEGER(IntKi), PARAMETER :: M8N6MAGyi = 3633 - INTEGER(IntKi), PARAMETER :: M8N7MAGyi = 3634 - INTEGER(IntKi), PARAMETER :: M8N8MAGyi = 3635 - INTEGER(IntKi), PARAMETER :: M8N9MAGyi = 3636 - INTEGER(IntKi), PARAMETER :: M9N1MAGyi = 3637 - INTEGER(IntKi), PARAMETER :: M9N2MAGyi = 3638 - INTEGER(IntKi), PARAMETER :: M9N3MAGyi = 3639 - INTEGER(IntKi), PARAMETER :: M9N4MAGyi = 3640 - INTEGER(IntKi), PARAMETER :: M9N5MAGyi = 3641 - INTEGER(IntKi), PARAMETER :: M9N6MAGyi = 3642 - INTEGER(IntKi), PARAMETER :: M9N7MAGyi = 3643 - INTEGER(IntKi), PARAMETER :: M9N8MAGyi = 3644 - INTEGER(IntKi), PARAMETER :: M9N9MAGyi = 3645 - INTEGER(IntKi), PARAMETER :: M1N1MAGzi = 3646 - INTEGER(IntKi), PARAMETER :: M1N2MAGzi = 3647 - INTEGER(IntKi), PARAMETER :: M1N3MAGzi = 3648 - INTEGER(IntKi), PARAMETER :: M1N4MAGzi = 3649 - INTEGER(IntKi), PARAMETER :: M1N5MAGzi = 3650 - INTEGER(IntKi), PARAMETER :: M1N6MAGzi = 3651 - INTEGER(IntKi), PARAMETER :: M1N7MAGzi = 3652 - INTEGER(IntKi), PARAMETER :: M1N8MAGzi = 3653 - INTEGER(IntKi), PARAMETER :: M1N9MAGzi = 3654 - INTEGER(IntKi), PARAMETER :: M2N1MAGzi = 3655 - INTEGER(IntKi), PARAMETER :: M2N2MAGzi = 3656 - INTEGER(IntKi), PARAMETER :: M2N3MAGzi = 3657 - INTEGER(IntKi), PARAMETER :: M2N4MAGzi = 3658 - INTEGER(IntKi), PARAMETER :: M2N5MAGzi = 3659 - INTEGER(IntKi), PARAMETER :: M2N6MAGzi = 3660 - INTEGER(IntKi), PARAMETER :: M2N7MAGzi = 3661 - INTEGER(IntKi), PARAMETER :: M2N8MAGzi = 3662 - INTEGER(IntKi), PARAMETER :: M2N9MAGzi = 3663 - INTEGER(IntKi), PARAMETER :: M3N1MAGzi = 3664 - INTEGER(IntKi), PARAMETER :: M3N2MAGzi = 3665 - INTEGER(IntKi), PARAMETER :: M3N3MAGzi = 3666 - INTEGER(IntKi), PARAMETER :: M3N4MAGzi = 3667 - INTEGER(IntKi), PARAMETER :: M3N5MAGzi = 3668 - INTEGER(IntKi), PARAMETER :: M3N6MAGzi = 3669 - INTEGER(IntKi), PARAMETER :: M3N7MAGzi = 3670 - INTEGER(IntKi), PARAMETER :: M3N8MAGzi = 3671 - INTEGER(IntKi), PARAMETER :: M3N9MAGzi = 3672 - INTEGER(IntKi), PARAMETER :: M4N1MAGzi = 3673 - INTEGER(IntKi), PARAMETER :: M4N2MAGzi = 3674 - INTEGER(IntKi), PARAMETER :: M4N3MAGzi = 3675 - INTEGER(IntKi), PARAMETER :: M4N4MAGzi = 3676 - INTEGER(IntKi), PARAMETER :: M4N5MAGzi = 3677 - INTEGER(IntKi), PARAMETER :: M4N6MAGzi = 3678 - INTEGER(IntKi), PARAMETER :: M4N7MAGzi = 3679 - INTEGER(IntKi), PARAMETER :: M4N8MAGzi = 3680 - INTEGER(IntKi), PARAMETER :: M4N9MAGzi = 3681 - INTEGER(IntKi), PARAMETER :: M5N1MAGzi = 3682 - INTEGER(IntKi), PARAMETER :: M5N2MAGzi = 3683 - INTEGER(IntKi), PARAMETER :: M5N3MAGzi = 3684 - INTEGER(IntKi), PARAMETER :: M5N4MAGzi = 3685 - INTEGER(IntKi), PARAMETER :: M5N5MAGzi = 3686 - INTEGER(IntKi), PARAMETER :: M5N6MAGzi = 3687 - INTEGER(IntKi), PARAMETER :: M5N7MAGzi = 3688 - INTEGER(IntKi), PARAMETER :: M5N8MAGzi = 3689 - INTEGER(IntKi), PARAMETER :: M5N9MAGzi = 3690 - INTEGER(IntKi), PARAMETER :: M6N1MAGzi = 3691 - INTEGER(IntKi), PARAMETER :: M6N2MAGzi = 3692 - INTEGER(IntKi), PARAMETER :: M6N3MAGzi = 3693 - INTEGER(IntKi), PARAMETER :: M6N4MAGzi = 3694 - INTEGER(IntKi), PARAMETER :: M6N5MAGzi = 3695 - INTEGER(IntKi), PARAMETER :: M6N6MAGzi = 3696 - INTEGER(IntKi), PARAMETER :: M6N7MAGzi = 3697 - INTEGER(IntKi), PARAMETER :: M6N8MAGzi = 3698 - INTEGER(IntKi), PARAMETER :: M6N9MAGzi = 3699 - INTEGER(IntKi), PARAMETER :: M7N1MAGzi = 3700 - INTEGER(IntKi), PARAMETER :: M7N2MAGzi = 3701 - INTEGER(IntKi), PARAMETER :: M7N3MAGzi = 3702 - INTEGER(IntKi), PARAMETER :: M7N4MAGzi = 3703 - INTEGER(IntKi), PARAMETER :: M7N5MAGzi = 3704 - INTEGER(IntKi), PARAMETER :: M7N6MAGzi = 3705 - INTEGER(IntKi), PARAMETER :: M7N7MAGzi = 3706 - INTEGER(IntKi), PARAMETER :: M7N8MAGzi = 3707 - INTEGER(IntKi), PARAMETER :: M7N9MAGzi = 3708 - INTEGER(IntKi), PARAMETER :: M8N1MAGzi = 3709 - INTEGER(IntKi), PARAMETER :: M8N2MAGzi = 3710 - INTEGER(IntKi), PARAMETER :: M8N3MAGzi = 3711 - INTEGER(IntKi), PARAMETER :: M8N4MAGzi = 3712 - INTEGER(IntKi), PARAMETER :: M8N5MAGzi = 3713 - INTEGER(IntKi), PARAMETER :: M8N6MAGzi = 3714 - INTEGER(IntKi), PARAMETER :: M8N7MAGzi = 3715 - INTEGER(IntKi), PARAMETER :: M8N8MAGzi = 3716 - INTEGER(IntKi), PARAMETER :: M8N9MAGzi = 3717 - INTEGER(IntKi), PARAMETER :: M9N1MAGzi = 3718 - INTEGER(IntKi), PARAMETER :: M9N2MAGzi = 3719 - INTEGER(IntKi), PARAMETER :: M9N3MAGzi = 3720 - INTEGER(IntKi), PARAMETER :: M9N4MAGzi = 3721 - INTEGER(IntKi), PARAMETER :: M9N5MAGzi = 3722 - INTEGER(IntKi), PARAMETER :: M9N6MAGzi = 3723 - INTEGER(IntKi), PARAMETER :: M9N7MAGzi = 3724 - INTEGER(IntKi), PARAMETER :: M9N8MAGzi = 3725 - INTEGER(IntKi), PARAMETER :: M9N9MAGzi = 3726 - INTEGER(IntKi), PARAMETER :: M1N1FAFxi = 3727 - INTEGER(IntKi), PARAMETER :: M1N2FAFxi = 3728 - INTEGER(IntKi), PARAMETER :: M1N3FAFxi = 3729 - INTEGER(IntKi), PARAMETER :: M1N4FAFxi = 3730 - INTEGER(IntKi), PARAMETER :: M1N5FAFxi = 3731 - INTEGER(IntKi), PARAMETER :: M1N6FAFxi = 3732 - INTEGER(IntKi), PARAMETER :: M1N7FAFxi = 3733 - INTEGER(IntKi), PARAMETER :: M1N8FAFxi = 3734 - INTEGER(IntKi), PARAMETER :: M1N9FAFxi = 3735 - INTEGER(IntKi), PARAMETER :: M2N1FAFxi = 3736 - INTEGER(IntKi), PARAMETER :: M2N2FAFxi = 3737 - INTEGER(IntKi), PARAMETER :: M2N3FAFxi = 3738 - INTEGER(IntKi), PARAMETER :: M2N4FAFxi = 3739 - INTEGER(IntKi), PARAMETER :: M2N5FAFxi = 3740 - INTEGER(IntKi), PARAMETER :: M2N6FAFxi = 3741 - INTEGER(IntKi), PARAMETER :: M2N7FAFxi = 3742 - INTEGER(IntKi), PARAMETER :: M2N8FAFxi = 3743 - INTEGER(IntKi), PARAMETER :: M2N9FAFxi = 3744 - INTEGER(IntKi), PARAMETER :: M3N1FAFxi = 3745 - INTEGER(IntKi), PARAMETER :: M3N2FAFxi = 3746 - INTEGER(IntKi), PARAMETER :: M3N3FAFxi = 3747 - INTEGER(IntKi), PARAMETER :: M3N4FAFxi = 3748 - INTEGER(IntKi), PARAMETER :: M3N5FAFxi = 3749 - INTEGER(IntKi), PARAMETER :: M3N6FAFxi = 3750 - INTEGER(IntKi), PARAMETER :: M3N7FAFxi = 3751 - INTEGER(IntKi), PARAMETER :: M3N8FAFxi = 3752 - INTEGER(IntKi), PARAMETER :: M3N9FAFxi = 3753 - INTEGER(IntKi), PARAMETER :: M4N1FAFxi = 3754 - INTEGER(IntKi), PARAMETER :: M4N2FAFxi = 3755 - INTEGER(IntKi), PARAMETER :: M4N3FAFxi = 3756 - INTEGER(IntKi), PARAMETER :: M4N4FAFxi = 3757 - INTEGER(IntKi), PARAMETER :: M4N5FAFxi = 3758 - INTEGER(IntKi), PARAMETER :: M4N6FAFxi = 3759 - INTEGER(IntKi), PARAMETER :: M4N7FAFxi = 3760 - INTEGER(IntKi), PARAMETER :: M4N8FAFxi = 3761 - INTEGER(IntKi), PARAMETER :: M4N9FAFxi = 3762 - INTEGER(IntKi), PARAMETER :: M5N1FAFxi = 3763 - INTEGER(IntKi), PARAMETER :: M5N2FAFxi = 3764 - INTEGER(IntKi), PARAMETER :: M5N3FAFxi = 3765 - INTEGER(IntKi), PARAMETER :: M5N4FAFxi = 3766 - INTEGER(IntKi), PARAMETER :: M5N5FAFxi = 3767 - INTEGER(IntKi), PARAMETER :: M5N6FAFxi = 3768 - INTEGER(IntKi), PARAMETER :: M5N7FAFxi = 3769 - INTEGER(IntKi), PARAMETER :: M5N8FAFxi = 3770 - INTEGER(IntKi), PARAMETER :: M5N9FAFxi = 3771 - INTEGER(IntKi), PARAMETER :: M6N1FAFxi = 3772 - INTEGER(IntKi), PARAMETER :: M6N2FAFxi = 3773 - INTEGER(IntKi), PARAMETER :: M6N3FAFxi = 3774 - INTEGER(IntKi), PARAMETER :: M6N4FAFxi = 3775 - INTEGER(IntKi), PARAMETER :: M6N5FAFxi = 3776 - INTEGER(IntKi), PARAMETER :: M6N6FAFxi = 3777 - INTEGER(IntKi), PARAMETER :: M6N7FAFxi = 3778 - INTEGER(IntKi), PARAMETER :: M6N8FAFxi = 3779 - INTEGER(IntKi), PARAMETER :: M6N9FAFxi = 3780 - INTEGER(IntKi), PARAMETER :: M7N1FAFxi = 3781 - INTEGER(IntKi), PARAMETER :: M7N2FAFxi = 3782 - INTEGER(IntKi), PARAMETER :: M7N3FAFxi = 3783 - INTEGER(IntKi), PARAMETER :: M7N4FAFxi = 3784 - INTEGER(IntKi), PARAMETER :: M7N5FAFxi = 3785 - INTEGER(IntKi), PARAMETER :: M7N6FAFxi = 3786 - INTEGER(IntKi), PARAMETER :: M7N7FAFxi = 3787 - INTEGER(IntKi), PARAMETER :: M7N8FAFxi = 3788 - INTEGER(IntKi), PARAMETER :: M7N9FAFxi = 3789 - INTEGER(IntKi), PARAMETER :: M8N1FAFxi = 3790 - INTEGER(IntKi), PARAMETER :: M8N2FAFxi = 3791 - INTEGER(IntKi), PARAMETER :: M8N3FAFxi = 3792 - INTEGER(IntKi), PARAMETER :: M8N4FAFxi = 3793 - INTEGER(IntKi), PARAMETER :: M8N5FAFxi = 3794 - INTEGER(IntKi), PARAMETER :: M8N6FAFxi = 3795 - INTEGER(IntKi), PARAMETER :: M8N7FAFxi = 3796 - INTEGER(IntKi), PARAMETER :: M8N8FAFxi = 3797 - INTEGER(IntKi), PARAMETER :: M8N9FAFxi = 3798 - INTEGER(IntKi), PARAMETER :: M9N1FAFxi = 3799 - INTEGER(IntKi), PARAMETER :: M9N2FAFxi = 3800 - INTEGER(IntKi), PARAMETER :: M9N3FAFxi = 3801 - INTEGER(IntKi), PARAMETER :: M9N4FAFxi = 3802 - INTEGER(IntKi), PARAMETER :: M9N5FAFxi = 3803 - INTEGER(IntKi), PARAMETER :: M9N6FAFxi = 3804 - INTEGER(IntKi), PARAMETER :: M9N7FAFxi = 3805 - INTEGER(IntKi), PARAMETER :: M9N8FAFxi = 3806 - INTEGER(IntKi), PARAMETER :: M9N9FAFxi = 3807 - INTEGER(IntKi), PARAMETER :: M1N1FAFyi = 3808 - INTEGER(IntKi), PARAMETER :: M1N2FAFyi = 3809 - INTEGER(IntKi), PARAMETER :: M1N3FAFyi = 3810 - INTEGER(IntKi), PARAMETER :: M1N4FAFyi = 3811 - INTEGER(IntKi), PARAMETER :: M1N5FAFyi = 3812 - INTEGER(IntKi), PARAMETER :: M1N6FAFyi = 3813 - INTEGER(IntKi), PARAMETER :: M1N7FAFyi = 3814 - INTEGER(IntKi), PARAMETER :: M1N8FAFyi = 3815 - INTEGER(IntKi), PARAMETER :: M1N9FAFyi = 3816 - INTEGER(IntKi), PARAMETER :: M2N1FAFyi = 3817 - INTEGER(IntKi), PARAMETER :: M2N2FAFyi = 3818 - INTEGER(IntKi), PARAMETER :: M2N3FAFyi = 3819 - INTEGER(IntKi), PARAMETER :: M2N4FAFyi = 3820 - INTEGER(IntKi), PARAMETER :: M2N5FAFyi = 3821 - INTEGER(IntKi), PARAMETER :: M2N6FAFyi = 3822 - INTEGER(IntKi), PARAMETER :: M2N7FAFyi = 3823 - INTEGER(IntKi), PARAMETER :: M2N8FAFyi = 3824 - INTEGER(IntKi), PARAMETER :: M2N9FAFyi = 3825 - INTEGER(IntKi), PARAMETER :: M3N1FAFyi = 3826 - INTEGER(IntKi), PARAMETER :: M3N2FAFyi = 3827 - INTEGER(IntKi), PARAMETER :: M3N3FAFyi = 3828 - INTEGER(IntKi), PARAMETER :: M3N4FAFyi = 3829 - INTEGER(IntKi), PARAMETER :: M3N5FAFyi = 3830 - INTEGER(IntKi), PARAMETER :: M3N6FAFyi = 3831 - INTEGER(IntKi), PARAMETER :: M3N7FAFyi = 3832 - INTEGER(IntKi), PARAMETER :: M3N8FAFyi = 3833 - INTEGER(IntKi), PARAMETER :: M3N9FAFyi = 3834 - INTEGER(IntKi), PARAMETER :: M4N1FAFyi = 3835 - INTEGER(IntKi), PARAMETER :: M4N2FAFyi = 3836 - INTEGER(IntKi), PARAMETER :: M4N3FAFyi = 3837 - INTEGER(IntKi), PARAMETER :: M4N4FAFyi = 3838 - INTEGER(IntKi), PARAMETER :: M4N5FAFyi = 3839 - INTEGER(IntKi), PARAMETER :: M4N6FAFyi = 3840 - INTEGER(IntKi), PARAMETER :: M4N7FAFyi = 3841 - INTEGER(IntKi), PARAMETER :: M4N8FAFyi = 3842 - INTEGER(IntKi), PARAMETER :: M4N9FAFyi = 3843 - INTEGER(IntKi), PARAMETER :: M5N1FAFyi = 3844 - INTEGER(IntKi), PARAMETER :: M5N2FAFyi = 3845 - INTEGER(IntKi), PARAMETER :: M5N3FAFyi = 3846 - INTEGER(IntKi), PARAMETER :: M5N4FAFyi = 3847 - INTEGER(IntKi), PARAMETER :: M5N5FAFyi = 3848 - INTEGER(IntKi), PARAMETER :: M5N6FAFyi = 3849 - INTEGER(IntKi), PARAMETER :: M5N7FAFyi = 3850 - INTEGER(IntKi), PARAMETER :: M5N8FAFyi = 3851 - INTEGER(IntKi), PARAMETER :: M5N9FAFyi = 3852 - INTEGER(IntKi), PARAMETER :: M6N1FAFyi = 3853 - INTEGER(IntKi), PARAMETER :: M6N2FAFyi = 3854 - INTEGER(IntKi), PARAMETER :: M6N3FAFyi = 3855 - INTEGER(IntKi), PARAMETER :: M6N4FAFyi = 3856 - INTEGER(IntKi), PARAMETER :: M6N5FAFyi = 3857 - INTEGER(IntKi), PARAMETER :: M6N6FAFyi = 3858 - INTEGER(IntKi), PARAMETER :: M6N7FAFyi = 3859 - INTEGER(IntKi), PARAMETER :: M6N8FAFyi = 3860 - INTEGER(IntKi), PARAMETER :: M6N9FAFyi = 3861 - INTEGER(IntKi), PARAMETER :: M7N1FAFyi = 3862 - INTEGER(IntKi), PARAMETER :: M7N2FAFyi = 3863 - INTEGER(IntKi), PARAMETER :: M7N3FAFyi = 3864 - INTEGER(IntKi), PARAMETER :: M7N4FAFyi = 3865 - INTEGER(IntKi), PARAMETER :: M7N5FAFyi = 3866 - INTEGER(IntKi), PARAMETER :: M7N6FAFyi = 3867 - INTEGER(IntKi), PARAMETER :: M7N7FAFyi = 3868 - INTEGER(IntKi), PARAMETER :: M7N8FAFyi = 3869 - INTEGER(IntKi), PARAMETER :: M7N9FAFyi = 3870 - INTEGER(IntKi), PARAMETER :: M8N1FAFyi = 3871 - INTEGER(IntKi), PARAMETER :: M8N2FAFyi = 3872 - INTEGER(IntKi), PARAMETER :: M8N3FAFyi = 3873 - INTEGER(IntKi), PARAMETER :: M8N4FAFyi = 3874 - INTEGER(IntKi), PARAMETER :: M8N5FAFyi = 3875 - INTEGER(IntKi), PARAMETER :: M8N6FAFyi = 3876 - INTEGER(IntKi), PARAMETER :: M8N7FAFyi = 3877 - INTEGER(IntKi), PARAMETER :: M8N8FAFyi = 3878 - INTEGER(IntKi), PARAMETER :: M8N9FAFyi = 3879 - INTEGER(IntKi), PARAMETER :: M9N1FAFyi = 3880 - INTEGER(IntKi), PARAMETER :: M9N2FAFyi = 3881 - INTEGER(IntKi), PARAMETER :: M9N3FAFyi = 3882 - INTEGER(IntKi), PARAMETER :: M9N4FAFyi = 3883 - INTEGER(IntKi), PARAMETER :: M9N5FAFyi = 3884 - INTEGER(IntKi), PARAMETER :: M9N6FAFyi = 3885 - INTEGER(IntKi), PARAMETER :: M9N7FAFyi = 3886 - INTEGER(IntKi), PARAMETER :: M9N8FAFyi = 3887 - INTEGER(IntKi), PARAMETER :: M9N9FAFyi = 3888 - INTEGER(IntKi), PARAMETER :: M1N1FAFzi = 3889 - INTEGER(IntKi), PARAMETER :: M1N2FAFzi = 3890 - INTEGER(IntKi), PARAMETER :: M1N3FAFzi = 3891 - INTEGER(IntKi), PARAMETER :: M1N4FAFzi = 3892 - INTEGER(IntKi), PARAMETER :: M1N5FAFzi = 3893 - INTEGER(IntKi), PARAMETER :: M1N6FAFzi = 3894 - INTEGER(IntKi), PARAMETER :: M1N7FAFzi = 3895 - INTEGER(IntKi), PARAMETER :: M1N8FAFzi = 3896 - INTEGER(IntKi), PARAMETER :: M1N9FAFzi = 3897 - INTEGER(IntKi), PARAMETER :: M2N1FAFzi = 3898 - INTEGER(IntKi), PARAMETER :: M2N2FAFzi = 3899 - INTEGER(IntKi), PARAMETER :: M2N3FAFzi = 3900 - INTEGER(IntKi), PARAMETER :: M2N4FAFzi = 3901 - INTEGER(IntKi), PARAMETER :: M2N5FAFzi = 3902 - INTEGER(IntKi), PARAMETER :: M2N6FAFzi = 3903 - INTEGER(IntKi), PARAMETER :: M2N7FAFzi = 3904 - INTEGER(IntKi), PARAMETER :: M2N8FAFzi = 3905 - INTEGER(IntKi), PARAMETER :: M2N9FAFzi = 3906 - INTEGER(IntKi), PARAMETER :: M3N1FAFzi = 3907 - INTEGER(IntKi), PARAMETER :: M3N2FAFzi = 3908 - INTEGER(IntKi), PARAMETER :: M3N3FAFzi = 3909 - INTEGER(IntKi), PARAMETER :: M3N4FAFzi = 3910 - INTEGER(IntKi), PARAMETER :: M3N5FAFzi = 3911 - INTEGER(IntKi), PARAMETER :: M3N6FAFzi = 3912 - INTEGER(IntKi), PARAMETER :: M3N7FAFzi = 3913 - INTEGER(IntKi), PARAMETER :: M3N8FAFzi = 3914 - INTEGER(IntKi), PARAMETER :: M3N9FAFzi = 3915 - INTEGER(IntKi), PARAMETER :: M4N1FAFzi = 3916 - INTEGER(IntKi), PARAMETER :: M4N2FAFzi = 3917 - INTEGER(IntKi), PARAMETER :: M4N3FAFzi = 3918 - INTEGER(IntKi), PARAMETER :: M4N4FAFzi = 3919 - INTEGER(IntKi), PARAMETER :: M4N5FAFzi = 3920 - INTEGER(IntKi), PARAMETER :: M4N6FAFzi = 3921 - INTEGER(IntKi), PARAMETER :: M4N7FAFzi = 3922 - INTEGER(IntKi), PARAMETER :: M4N8FAFzi = 3923 - INTEGER(IntKi), PARAMETER :: M4N9FAFzi = 3924 - INTEGER(IntKi), PARAMETER :: M5N1FAFzi = 3925 - INTEGER(IntKi), PARAMETER :: M5N2FAFzi = 3926 - INTEGER(IntKi), PARAMETER :: M5N3FAFzi = 3927 - INTEGER(IntKi), PARAMETER :: M5N4FAFzi = 3928 - INTEGER(IntKi), PARAMETER :: M5N5FAFzi = 3929 - INTEGER(IntKi), PARAMETER :: M5N6FAFzi = 3930 - INTEGER(IntKi), PARAMETER :: M5N7FAFzi = 3931 - INTEGER(IntKi), PARAMETER :: M5N8FAFzi = 3932 - INTEGER(IntKi), PARAMETER :: M5N9FAFzi = 3933 - INTEGER(IntKi), PARAMETER :: M6N1FAFzi = 3934 - INTEGER(IntKi), PARAMETER :: M6N2FAFzi = 3935 - INTEGER(IntKi), PARAMETER :: M6N3FAFzi = 3936 - INTEGER(IntKi), PARAMETER :: M6N4FAFzi = 3937 - INTEGER(IntKi), PARAMETER :: M6N5FAFzi = 3938 - INTEGER(IntKi), PARAMETER :: M6N6FAFzi = 3939 - INTEGER(IntKi), PARAMETER :: M6N7FAFzi = 3940 - INTEGER(IntKi), PARAMETER :: M6N8FAFzi = 3941 - INTEGER(IntKi), PARAMETER :: M6N9FAFzi = 3942 - INTEGER(IntKi), PARAMETER :: M7N1FAFzi = 3943 - INTEGER(IntKi), PARAMETER :: M7N2FAFzi = 3944 - INTEGER(IntKi), PARAMETER :: M7N3FAFzi = 3945 - INTEGER(IntKi), PARAMETER :: M7N4FAFzi = 3946 - INTEGER(IntKi), PARAMETER :: M7N5FAFzi = 3947 - INTEGER(IntKi), PARAMETER :: M7N6FAFzi = 3948 - INTEGER(IntKi), PARAMETER :: M7N7FAFzi = 3949 - INTEGER(IntKi), PARAMETER :: M7N8FAFzi = 3950 - INTEGER(IntKi), PARAMETER :: M7N9FAFzi = 3951 - INTEGER(IntKi), PARAMETER :: M8N1FAFzi = 3952 - INTEGER(IntKi), PARAMETER :: M8N2FAFzi = 3953 - INTEGER(IntKi), PARAMETER :: M8N3FAFzi = 3954 - INTEGER(IntKi), PARAMETER :: M8N4FAFzi = 3955 - INTEGER(IntKi), PARAMETER :: M8N5FAFzi = 3956 - INTEGER(IntKi), PARAMETER :: M8N6FAFzi = 3957 - INTEGER(IntKi), PARAMETER :: M8N7FAFzi = 3958 - INTEGER(IntKi), PARAMETER :: M8N8FAFzi = 3959 - INTEGER(IntKi), PARAMETER :: M8N9FAFzi = 3960 - INTEGER(IntKi), PARAMETER :: M9N1FAFzi = 3961 - INTEGER(IntKi), PARAMETER :: M9N2FAFzi = 3962 - INTEGER(IntKi), PARAMETER :: M9N3FAFzi = 3963 - INTEGER(IntKi), PARAMETER :: M9N4FAFzi = 3964 - INTEGER(IntKi), PARAMETER :: M9N5FAFzi = 3965 - INTEGER(IntKi), PARAMETER :: M9N6FAFzi = 3966 - INTEGER(IntKi), PARAMETER :: M9N7FAFzi = 3967 - INTEGER(IntKi), PARAMETER :: M9N8FAFzi = 3968 - INTEGER(IntKi), PARAMETER :: M9N9FAFzi = 3969 - INTEGER(IntKi), PARAMETER :: M1N1MAFxi = 3970 - INTEGER(IntKi), PARAMETER :: M1N2MAFxi = 3971 - INTEGER(IntKi), PARAMETER :: M1N3MAFxi = 3972 - INTEGER(IntKi), PARAMETER :: M1N4MAFxi = 3973 - INTEGER(IntKi), PARAMETER :: M1N5MAFxi = 3974 - INTEGER(IntKi), PARAMETER :: M1N6MAFxi = 3975 - INTEGER(IntKi), PARAMETER :: M1N7MAFxi = 3976 - INTEGER(IntKi), PARAMETER :: M1N8MAFxi = 3977 - INTEGER(IntKi), PARAMETER :: M1N9MAFxi = 3978 - INTEGER(IntKi), PARAMETER :: M2N1MAFxi = 3979 - INTEGER(IntKi), PARAMETER :: M2N2MAFxi = 3980 - INTEGER(IntKi), PARAMETER :: M2N3MAFxi = 3981 - INTEGER(IntKi), PARAMETER :: M2N4MAFxi = 3982 - INTEGER(IntKi), PARAMETER :: M2N5MAFxi = 3983 - INTEGER(IntKi), PARAMETER :: M2N6MAFxi = 3984 - INTEGER(IntKi), PARAMETER :: M2N7MAFxi = 3985 - INTEGER(IntKi), PARAMETER :: M2N8MAFxi = 3986 - INTEGER(IntKi), PARAMETER :: M2N9MAFxi = 3987 - INTEGER(IntKi), PARAMETER :: M3N1MAFxi = 3988 - INTEGER(IntKi), PARAMETER :: M3N2MAFxi = 3989 - INTEGER(IntKi), PARAMETER :: M3N3MAFxi = 3990 - INTEGER(IntKi), PARAMETER :: M3N4MAFxi = 3991 - INTEGER(IntKi), PARAMETER :: M3N5MAFxi = 3992 - INTEGER(IntKi), PARAMETER :: M3N6MAFxi = 3993 - INTEGER(IntKi), PARAMETER :: M3N7MAFxi = 3994 - INTEGER(IntKi), PARAMETER :: M3N8MAFxi = 3995 - INTEGER(IntKi), PARAMETER :: M3N9MAFxi = 3996 - INTEGER(IntKi), PARAMETER :: M4N1MAFxi = 3997 - INTEGER(IntKi), PARAMETER :: M4N2MAFxi = 3998 - INTEGER(IntKi), PARAMETER :: M4N3MAFxi = 3999 - INTEGER(IntKi), PARAMETER :: M4N4MAFxi = 4000 - INTEGER(IntKi), PARAMETER :: M4N5MAFxi = 4001 - INTEGER(IntKi), PARAMETER :: M4N6MAFxi = 4002 - INTEGER(IntKi), PARAMETER :: M4N7MAFxi = 4003 - INTEGER(IntKi), PARAMETER :: M4N8MAFxi = 4004 - INTEGER(IntKi), PARAMETER :: M4N9MAFxi = 4005 - INTEGER(IntKi), PARAMETER :: M5N1MAFxi = 4006 - INTEGER(IntKi), PARAMETER :: M5N2MAFxi = 4007 - INTEGER(IntKi), PARAMETER :: M5N3MAFxi = 4008 - INTEGER(IntKi), PARAMETER :: M5N4MAFxi = 4009 - INTEGER(IntKi), PARAMETER :: M5N5MAFxi = 4010 - INTEGER(IntKi), PARAMETER :: M5N6MAFxi = 4011 - INTEGER(IntKi), PARAMETER :: M5N7MAFxi = 4012 - INTEGER(IntKi), PARAMETER :: M5N8MAFxi = 4013 - INTEGER(IntKi), PARAMETER :: M5N9MAFxi = 4014 - INTEGER(IntKi), PARAMETER :: M6N1MAFxi = 4015 - INTEGER(IntKi), PARAMETER :: M6N2MAFxi = 4016 - INTEGER(IntKi), PARAMETER :: M6N3MAFxi = 4017 - INTEGER(IntKi), PARAMETER :: M6N4MAFxi = 4018 - INTEGER(IntKi), PARAMETER :: M6N5MAFxi = 4019 - INTEGER(IntKi), PARAMETER :: M6N6MAFxi = 4020 - INTEGER(IntKi), PARAMETER :: M6N7MAFxi = 4021 - INTEGER(IntKi), PARAMETER :: M6N8MAFxi = 4022 - INTEGER(IntKi), PARAMETER :: M6N9MAFxi = 4023 - INTEGER(IntKi), PARAMETER :: M7N1MAFxi = 4024 - INTEGER(IntKi), PARAMETER :: M7N2MAFxi = 4025 - INTEGER(IntKi), PARAMETER :: M7N3MAFxi = 4026 - INTEGER(IntKi), PARAMETER :: M7N4MAFxi = 4027 - INTEGER(IntKi), PARAMETER :: M7N5MAFxi = 4028 - INTEGER(IntKi), PARAMETER :: M7N6MAFxi = 4029 - INTEGER(IntKi), PARAMETER :: M7N7MAFxi = 4030 - INTEGER(IntKi), PARAMETER :: M7N8MAFxi = 4031 - INTEGER(IntKi), PARAMETER :: M7N9MAFxi = 4032 - INTEGER(IntKi), PARAMETER :: M8N1MAFxi = 4033 - INTEGER(IntKi), PARAMETER :: M8N2MAFxi = 4034 - INTEGER(IntKi), PARAMETER :: M8N3MAFxi = 4035 - INTEGER(IntKi), PARAMETER :: M8N4MAFxi = 4036 - INTEGER(IntKi), PARAMETER :: M8N5MAFxi = 4037 - INTEGER(IntKi), PARAMETER :: M8N6MAFxi = 4038 - INTEGER(IntKi), PARAMETER :: M8N7MAFxi = 4039 - INTEGER(IntKi), PARAMETER :: M8N8MAFxi = 4040 - INTEGER(IntKi), PARAMETER :: M8N9MAFxi = 4041 - INTEGER(IntKi), PARAMETER :: M9N1MAFxi = 4042 - INTEGER(IntKi), PARAMETER :: M9N2MAFxi = 4043 - INTEGER(IntKi), PARAMETER :: M9N3MAFxi = 4044 - INTEGER(IntKi), PARAMETER :: M9N4MAFxi = 4045 - INTEGER(IntKi), PARAMETER :: M9N5MAFxi = 4046 - INTEGER(IntKi), PARAMETER :: M9N6MAFxi = 4047 - INTEGER(IntKi), PARAMETER :: M9N7MAFxi = 4048 - INTEGER(IntKi), PARAMETER :: M9N8MAFxi = 4049 - INTEGER(IntKi), PARAMETER :: M9N9MAFxi = 4050 - INTEGER(IntKi), PARAMETER :: M1N1MAFyi = 4051 - INTEGER(IntKi), PARAMETER :: M1N2MAFyi = 4052 - INTEGER(IntKi), PARAMETER :: M1N3MAFyi = 4053 - INTEGER(IntKi), PARAMETER :: M1N4MAFyi = 4054 - INTEGER(IntKi), PARAMETER :: M1N5MAFyi = 4055 - INTEGER(IntKi), PARAMETER :: M1N6MAFyi = 4056 - INTEGER(IntKi), PARAMETER :: M1N7MAFyi = 4057 - INTEGER(IntKi), PARAMETER :: M1N8MAFyi = 4058 - INTEGER(IntKi), PARAMETER :: M1N9MAFyi = 4059 - INTEGER(IntKi), PARAMETER :: M2N1MAFyi = 4060 - INTEGER(IntKi), PARAMETER :: M2N2MAFyi = 4061 - INTEGER(IntKi), PARAMETER :: M2N3MAFyi = 4062 - INTEGER(IntKi), PARAMETER :: M2N4MAFyi = 4063 - INTEGER(IntKi), PARAMETER :: M2N5MAFyi = 4064 - INTEGER(IntKi), PARAMETER :: M2N6MAFyi = 4065 - INTEGER(IntKi), PARAMETER :: M2N7MAFyi = 4066 - INTEGER(IntKi), PARAMETER :: M2N8MAFyi = 4067 - INTEGER(IntKi), PARAMETER :: M2N9MAFyi = 4068 - INTEGER(IntKi), PARAMETER :: M3N1MAFyi = 4069 - INTEGER(IntKi), PARAMETER :: M3N2MAFyi = 4070 - INTEGER(IntKi), PARAMETER :: M3N3MAFyi = 4071 - INTEGER(IntKi), PARAMETER :: M3N4MAFyi = 4072 - INTEGER(IntKi), PARAMETER :: M3N5MAFyi = 4073 - INTEGER(IntKi), PARAMETER :: M3N6MAFyi = 4074 - INTEGER(IntKi), PARAMETER :: M3N7MAFyi = 4075 - INTEGER(IntKi), PARAMETER :: M3N8MAFyi = 4076 - INTEGER(IntKi), PARAMETER :: M3N9MAFyi = 4077 - INTEGER(IntKi), PARAMETER :: M4N1MAFyi = 4078 - INTEGER(IntKi), PARAMETER :: M4N2MAFyi = 4079 - INTEGER(IntKi), PARAMETER :: M4N3MAFyi = 4080 - INTEGER(IntKi), PARAMETER :: M4N4MAFyi = 4081 - INTEGER(IntKi), PARAMETER :: M4N5MAFyi = 4082 - INTEGER(IntKi), PARAMETER :: M4N6MAFyi = 4083 - INTEGER(IntKi), PARAMETER :: M4N7MAFyi = 4084 - INTEGER(IntKi), PARAMETER :: M4N8MAFyi = 4085 - INTEGER(IntKi), PARAMETER :: M4N9MAFyi = 4086 - INTEGER(IntKi), PARAMETER :: M5N1MAFyi = 4087 - INTEGER(IntKi), PARAMETER :: M5N2MAFyi = 4088 - INTEGER(IntKi), PARAMETER :: M5N3MAFyi = 4089 - INTEGER(IntKi), PARAMETER :: M5N4MAFyi = 4090 - INTEGER(IntKi), PARAMETER :: M5N5MAFyi = 4091 - INTEGER(IntKi), PARAMETER :: M5N6MAFyi = 4092 - INTEGER(IntKi), PARAMETER :: M5N7MAFyi = 4093 - INTEGER(IntKi), PARAMETER :: M5N8MAFyi = 4094 - INTEGER(IntKi), PARAMETER :: M5N9MAFyi = 4095 - INTEGER(IntKi), PARAMETER :: M6N1MAFyi = 4096 - INTEGER(IntKi), PARAMETER :: M6N2MAFyi = 4097 - INTEGER(IntKi), PARAMETER :: M6N3MAFyi = 4098 - INTEGER(IntKi), PARAMETER :: M6N4MAFyi = 4099 - INTEGER(IntKi), PARAMETER :: M6N5MAFyi = 4100 - INTEGER(IntKi), PARAMETER :: M6N6MAFyi = 4101 - INTEGER(IntKi), PARAMETER :: M6N7MAFyi = 4102 - INTEGER(IntKi), PARAMETER :: M6N8MAFyi = 4103 - INTEGER(IntKi), PARAMETER :: M6N9MAFyi = 4104 - INTEGER(IntKi), PARAMETER :: M7N1MAFyi = 4105 - INTEGER(IntKi), PARAMETER :: M7N2MAFyi = 4106 - INTEGER(IntKi), PARAMETER :: M7N3MAFyi = 4107 - INTEGER(IntKi), PARAMETER :: M7N4MAFyi = 4108 - INTEGER(IntKi), PARAMETER :: M7N5MAFyi = 4109 - INTEGER(IntKi), PARAMETER :: M7N6MAFyi = 4110 - INTEGER(IntKi), PARAMETER :: M7N7MAFyi = 4111 - INTEGER(IntKi), PARAMETER :: M7N8MAFyi = 4112 - INTEGER(IntKi), PARAMETER :: M7N9MAFyi = 4113 - INTEGER(IntKi), PARAMETER :: M8N1MAFyi = 4114 - INTEGER(IntKi), PARAMETER :: M8N2MAFyi = 4115 - INTEGER(IntKi), PARAMETER :: M8N3MAFyi = 4116 - INTEGER(IntKi), PARAMETER :: M8N4MAFyi = 4117 - INTEGER(IntKi), PARAMETER :: M8N5MAFyi = 4118 - INTEGER(IntKi), PARAMETER :: M8N6MAFyi = 4119 - INTEGER(IntKi), PARAMETER :: M8N7MAFyi = 4120 - INTEGER(IntKi), PARAMETER :: M8N8MAFyi = 4121 - INTEGER(IntKi), PARAMETER :: M8N9MAFyi = 4122 - INTEGER(IntKi), PARAMETER :: M9N1MAFyi = 4123 - INTEGER(IntKi), PARAMETER :: M9N2MAFyi = 4124 - INTEGER(IntKi), PARAMETER :: M9N3MAFyi = 4125 - INTEGER(IntKi), PARAMETER :: M9N4MAFyi = 4126 - INTEGER(IntKi), PARAMETER :: M9N5MAFyi = 4127 - INTEGER(IntKi), PARAMETER :: M9N6MAFyi = 4128 - INTEGER(IntKi), PARAMETER :: M9N7MAFyi = 4129 - INTEGER(IntKi), PARAMETER :: M9N8MAFyi = 4130 - INTEGER(IntKi), PARAMETER :: M9N9MAFyi = 4131 - INTEGER(IntKi), PARAMETER :: M1N1MAFzi = 4132 - INTEGER(IntKi), PARAMETER :: M1N2MAFzi = 4133 - INTEGER(IntKi), PARAMETER :: M1N3MAFzi = 4134 - INTEGER(IntKi), PARAMETER :: M1N4MAFzi = 4135 - INTEGER(IntKi), PARAMETER :: M1N5MAFzi = 4136 - INTEGER(IntKi), PARAMETER :: M1N6MAFzi = 4137 - INTEGER(IntKi), PARAMETER :: M1N7MAFzi = 4138 - INTEGER(IntKi), PARAMETER :: M1N8MAFzi = 4139 - INTEGER(IntKi), PARAMETER :: M1N9MAFzi = 4140 - INTEGER(IntKi), PARAMETER :: M2N1MAFzi = 4141 - INTEGER(IntKi), PARAMETER :: M2N2MAFzi = 4142 - INTEGER(IntKi), PARAMETER :: M2N3MAFzi = 4143 - INTEGER(IntKi), PARAMETER :: M2N4MAFzi = 4144 - INTEGER(IntKi), PARAMETER :: M2N5MAFzi = 4145 - INTEGER(IntKi), PARAMETER :: M2N6MAFzi = 4146 - INTEGER(IntKi), PARAMETER :: M2N7MAFzi = 4147 - INTEGER(IntKi), PARAMETER :: M2N8MAFzi = 4148 - INTEGER(IntKi), PARAMETER :: M2N9MAFzi = 4149 - INTEGER(IntKi), PARAMETER :: M3N1MAFzi = 4150 - INTEGER(IntKi), PARAMETER :: M3N2MAFzi = 4151 - INTEGER(IntKi), PARAMETER :: M3N3MAFzi = 4152 - INTEGER(IntKi), PARAMETER :: M3N4MAFzi = 4153 - INTEGER(IntKi), PARAMETER :: M3N5MAFzi = 4154 - INTEGER(IntKi), PARAMETER :: M3N6MAFzi = 4155 - INTEGER(IntKi), PARAMETER :: M3N7MAFzi = 4156 - INTEGER(IntKi), PARAMETER :: M3N8MAFzi = 4157 - INTEGER(IntKi), PARAMETER :: M3N9MAFzi = 4158 - INTEGER(IntKi), PARAMETER :: M4N1MAFzi = 4159 - INTEGER(IntKi), PARAMETER :: M4N2MAFzi = 4160 - INTEGER(IntKi), PARAMETER :: M4N3MAFzi = 4161 - INTEGER(IntKi), PARAMETER :: M4N4MAFzi = 4162 - INTEGER(IntKi), PARAMETER :: M4N5MAFzi = 4163 - INTEGER(IntKi), PARAMETER :: M4N6MAFzi = 4164 - INTEGER(IntKi), PARAMETER :: M4N7MAFzi = 4165 - INTEGER(IntKi), PARAMETER :: M4N8MAFzi = 4166 - INTEGER(IntKi), PARAMETER :: M4N9MAFzi = 4167 - INTEGER(IntKi), PARAMETER :: M5N1MAFzi = 4168 - INTEGER(IntKi), PARAMETER :: M5N2MAFzi = 4169 - INTEGER(IntKi), PARAMETER :: M5N3MAFzi = 4170 - INTEGER(IntKi), PARAMETER :: M5N4MAFzi = 4171 - INTEGER(IntKi), PARAMETER :: M5N5MAFzi = 4172 - INTEGER(IntKi), PARAMETER :: M5N6MAFzi = 4173 - INTEGER(IntKi), PARAMETER :: M5N7MAFzi = 4174 - INTEGER(IntKi), PARAMETER :: M5N8MAFzi = 4175 - INTEGER(IntKi), PARAMETER :: M5N9MAFzi = 4176 - INTEGER(IntKi), PARAMETER :: M6N1MAFzi = 4177 - INTEGER(IntKi), PARAMETER :: M6N2MAFzi = 4178 - INTEGER(IntKi), PARAMETER :: M6N3MAFzi = 4179 - INTEGER(IntKi), PARAMETER :: M6N4MAFzi = 4180 - INTEGER(IntKi), PARAMETER :: M6N5MAFzi = 4181 - INTEGER(IntKi), PARAMETER :: M6N6MAFzi = 4182 - INTEGER(IntKi), PARAMETER :: M6N7MAFzi = 4183 - INTEGER(IntKi), PARAMETER :: M6N8MAFzi = 4184 - INTEGER(IntKi), PARAMETER :: M6N9MAFzi = 4185 - INTEGER(IntKi), PARAMETER :: M7N1MAFzi = 4186 - INTEGER(IntKi), PARAMETER :: M7N2MAFzi = 4187 - INTEGER(IntKi), PARAMETER :: M7N3MAFzi = 4188 - INTEGER(IntKi), PARAMETER :: M7N4MAFzi = 4189 - INTEGER(IntKi), PARAMETER :: M7N5MAFzi = 4190 - INTEGER(IntKi), PARAMETER :: M7N6MAFzi = 4191 - INTEGER(IntKi), PARAMETER :: M7N7MAFzi = 4192 - INTEGER(IntKi), PARAMETER :: M7N8MAFzi = 4193 - INTEGER(IntKi), PARAMETER :: M7N9MAFzi = 4194 - INTEGER(IntKi), PARAMETER :: M8N1MAFzi = 4195 - INTEGER(IntKi), PARAMETER :: M8N2MAFzi = 4196 - INTEGER(IntKi), PARAMETER :: M8N3MAFzi = 4197 - INTEGER(IntKi), PARAMETER :: M8N4MAFzi = 4198 - INTEGER(IntKi), PARAMETER :: M8N5MAFzi = 4199 - INTEGER(IntKi), PARAMETER :: M8N6MAFzi = 4200 - INTEGER(IntKi), PARAMETER :: M8N7MAFzi = 4201 - INTEGER(IntKi), PARAMETER :: M8N8MAFzi = 4202 - INTEGER(IntKi), PARAMETER :: M8N9MAFzi = 4203 - INTEGER(IntKi), PARAMETER :: M9N1MAFzi = 4204 - INTEGER(IntKi), PARAMETER :: M9N2MAFzi = 4205 - INTEGER(IntKi), PARAMETER :: M9N3MAFzi = 4206 - INTEGER(IntKi), PARAMETER :: M9N4MAFzi = 4207 - INTEGER(IntKi), PARAMETER :: M9N5MAFzi = 4208 - INTEGER(IntKi), PARAMETER :: M9N6MAFzi = 4209 - INTEGER(IntKi), PARAMETER :: M9N7MAFzi = 4210 - INTEGER(IntKi), PARAMETER :: M9N8MAFzi = 4211 - INTEGER(IntKi), PARAMETER :: M9N9MAFzi = 4212 + INTEGER(IntKi), PARAMETER :: M1N1FDxi = 1054 + INTEGER(IntKi), PARAMETER :: M1N2FDxi = 1055 + INTEGER(IntKi), PARAMETER :: M1N3FDxi = 1056 + INTEGER(IntKi), PARAMETER :: M1N4FDxi = 1057 + INTEGER(IntKi), PARAMETER :: M1N5FDxi = 1058 + INTEGER(IntKi), PARAMETER :: M1N6FDxi = 1059 + INTEGER(IntKi), PARAMETER :: M1N7FDxi = 1060 + INTEGER(IntKi), PARAMETER :: M1N8FDxi = 1061 + INTEGER(IntKi), PARAMETER :: M1N9FDxi = 1062 + INTEGER(IntKi), PARAMETER :: M2N1FDxi = 1063 + INTEGER(IntKi), PARAMETER :: M2N2FDxi = 1064 + INTEGER(IntKi), PARAMETER :: M2N3FDxi = 1065 + INTEGER(IntKi), PARAMETER :: M2N4FDxi = 1066 + INTEGER(IntKi), PARAMETER :: M2N5FDxi = 1067 + INTEGER(IntKi), PARAMETER :: M2N6FDxi = 1068 + INTEGER(IntKi), PARAMETER :: M2N7FDxi = 1069 + INTEGER(IntKi), PARAMETER :: M2N8FDxi = 1070 + INTEGER(IntKi), PARAMETER :: M2N9FDxi = 1071 + INTEGER(IntKi), PARAMETER :: M3N1FDxi = 1072 + INTEGER(IntKi), PARAMETER :: M3N2FDxi = 1073 + INTEGER(IntKi), PARAMETER :: M3N3FDxi = 1074 + INTEGER(IntKi), PARAMETER :: M3N4FDxi = 1075 + INTEGER(IntKi), PARAMETER :: M3N5FDxi = 1076 + INTEGER(IntKi), PARAMETER :: M3N6FDxi = 1077 + INTEGER(IntKi), PARAMETER :: M3N7FDxi = 1078 + INTEGER(IntKi), PARAMETER :: M3N8FDxi = 1079 + INTEGER(IntKi), PARAMETER :: M3N9FDxi = 1080 + INTEGER(IntKi), PARAMETER :: M4N1FDxi = 1081 + INTEGER(IntKi), PARAMETER :: M4N2FDxi = 1082 + INTEGER(IntKi), PARAMETER :: M4N3FDxi = 1083 + INTEGER(IntKi), PARAMETER :: M4N4FDxi = 1084 + INTEGER(IntKi), PARAMETER :: M4N5FDxi = 1085 + INTEGER(IntKi), PARAMETER :: M4N6FDxi = 1086 + INTEGER(IntKi), PARAMETER :: M4N7FDxi = 1087 + INTEGER(IntKi), PARAMETER :: M4N8FDxi = 1088 + INTEGER(IntKi), PARAMETER :: M4N9FDxi = 1089 + INTEGER(IntKi), PARAMETER :: M5N1FDxi = 1090 + INTEGER(IntKi), PARAMETER :: M5N2FDxi = 1091 + INTEGER(IntKi), PARAMETER :: M5N3FDxi = 1092 + INTEGER(IntKi), PARAMETER :: M5N4FDxi = 1093 + INTEGER(IntKi), PARAMETER :: M5N5FDxi = 1094 + INTEGER(IntKi), PARAMETER :: M5N6FDxi = 1095 + INTEGER(IntKi), PARAMETER :: M5N7FDxi = 1096 + INTEGER(IntKi), PARAMETER :: M5N8FDxi = 1097 + INTEGER(IntKi), PARAMETER :: M5N9FDxi = 1098 + INTEGER(IntKi), PARAMETER :: M6N1FDxi = 1099 + INTEGER(IntKi), PARAMETER :: M6N2FDxi = 1100 + INTEGER(IntKi), PARAMETER :: M6N3FDxi = 1101 + INTEGER(IntKi), PARAMETER :: M6N4FDxi = 1102 + INTEGER(IntKi), PARAMETER :: M6N5FDxi = 1103 + INTEGER(IntKi), PARAMETER :: M6N6FDxi = 1104 + INTEGER(IntKi), PARAMETER :: M6N7FDxi = 1105 + INTEGER(IntKi), PARAMETER :: M6N8FDxi = 1106 + INTEGER(IntKi), PARAMETER :: M6N9FDxi = 1107 + INTEGER(IntKi), PARAMETER :: M7N1FDxi = 1108 + INTEGER(IntKi), PARAMETER :: M7N2FDxi = 1109 + INTEGER(IntKi), PARAMETER :: M7N3FDxi = 1110 + INTEGER(IntKi), PARAMETER :: M7N4FDxi = 1111 + INTEGER(IntKi), PARAMETER :: M7N5FDxi = 1112 + INTEGER(IntKi), PARAMETER :: M7N6FDxi = 1113 + INTEGER(IntKi), PARAMETER :: M7N7FDxi = 1114 + INTEGER(IntKi), PARAMETER :: M7N8FDxi = 1115 + INTEGER(IntKi), PARAMETER :: M7N9FDxi = 1116 + INTEGER(IntKi), PARAMETER :: M8N1FDxi = 1117 + INTEGER(IntKi), PARAMETER :: M8N2FDxi = 1118 + INTEGER(IntKi), PARAMETER :: M8N3FDxi = 1119 + INTEGER(IntKi), PARAMETER :: M8N4FDxi = 1120 + INTEGER(IntKi), PARAMETER :: M8N5FDxi = 1121 + INTEGER(IntKi), PARAMETER :: M8N6FDxi = 1122 + INTEGER(IntKi), PARAMETER :: M8N7FDxi = 1123 + INTEGER(IntKi), PARAMETER :: M8N8FDxi = 1124 + INTEGER(IntKi), PARAMETER :: M8N9FDxi = 1125 + INTEGER(IntKi), PARAMETER :: M9N1FDxi = 1126 + INTEGER(IntKi), PARAMETER :: M9N2FDxi = 1127 + INTEGER(IntKi), PARAMETER :: M9N3FDxi = 1128 + INTEGER(IntKi), PARAMETER :: M9N4FDxi = 1129 + INTEGER(IntKi), PARAMETER :: M9N5FDxi = 1130 + INTEGER(IntKi), PARAMETER :: M9N6FDxi = 1131 + INTEGER(IntKi), PARAMETER :: M9N7FDxi = 1132 + INTEGER(IntKi), PARAMETER :: M9N8FDxi = 1133 + INTEGER(IntKi), PARAMETER :: M9N9FDxi = 1134 + INTEGER(IntKi), PARAMETER :: M1N1FDyi = 1135 + INTEGER(IntKi), PARAMETER :: M1N2FDyi = 1136 + INTEGER(IntKi), PARAMETER :: M1N3FDyi = 1137 + INTEGER(IntKi), PARAMETER :: M1N4FDyi = 1138 + INTEGER(IntKi), PARAMETER :: M1N5FDyi = 1139 + INTEGER(IntKi), PARAMETER :: M1N6FDyi = 1140 + INTEGER(IntKi), PARAMETER :: M1N7FDyi = 1141 + INTEGER(IntKi), PARAMETER :: M1N8FDyi = 1142 + INTEGER(IntKi), PARAMETER :: M1N9FDyi = 1143 + INTEGER(IntKi), PARAMETER :: M2N1FDyi = 1144 + INTEGER(IntKi), PARAMETER :: M2N2FDyi = 1145 + INTEGER(IntKi), PARAMETER :: M2N3FDyi = 1146 + INTEGER(IntKi), PARAMETER :: M2N4FDyi = 1147 + INTEGER(IntKi), PARAMETER :: M2N5FDyi = 1148 + INTEGER(IntKi), PARAMETER :: M2N6FDyi = 1149 + INTEGER(IntKi), PARAMETER :: M2N7FDyi = 1150 + INTEGER(IntKi), PARAMETER :: M2N8FDyi = 1151 + INTEGER(IntKi), PARAMETER :: M2N9FDyi = 1152 + INTEGER(IntKi), PARAMETER :: M3N1FDyi = 1153 + INTEGER(IntKi), PARAMETER :: M3N2FDyi = 1154 + INTEGER(IntKi), PARAMETER :: M3N3FDyi = 1155 + INTEGER(IntKi), PARAMETER :: M3N4FDyi = 1156 + INTEGER(IntKi), PARAMETER :: M3N5FDyi = 1157 + INTEGER(IntKi), PARAMETER :: M3N6FDyi = 1158 + INTEGER(IntKi), PARAMETER :: M3N7FDyi = 1159 + INTEGER(IntKi), PARAMETER :: M3N8FDyi = 1160 + INTEGER(IntKi), PARAMETER :: M3N9FDyi = 1161 + INTEGER(IntKi), PARAMETER :: M4N1FDyi = 1162 + INTEGER(IntKi), PARAMETER :: M4N2FDyi = 1163 + INTEGER(IntKi), PARAMETER :: M4N3FDyi = 1164 + INTEGER(IntKi), PARAMETER :: M4N4FDyi = 1165 + INTEGER(IntKi), PARAMETER :: M4N5FDyi = 1166 + INTEGER(IntKi), PARAMETER :: M4N6FDyi = 1167 + INTEGER(IntKi), PARAMETER :: M4N7FDyi = 1168 + INTEGER(IntKi), PARAMETER :: M4N8FDyi = 1169 + INTEGER(IntKi), PARAMETER :: M4N9FDyi = 1170 + INTEGER(IntKi), PARAMETER :: M5N1FDyi = 1171 + INTEGER(IntKi), PARAMETER :: M5N2FDyi = 1172 + INTEGER(IntKi), PARAMETER :: M5N3FDyi = 1173 + INTEGER(IntKi), PARAMETER :: M5N4FDyi = 1174 + INTEGER(IntKi), PARAMETER :: M5N5FDyi = 1175 + INTEGER(IntKi), PARAMETER :: M5N6FDyi = 1176 + INTEGER(IntKi), PARAMETER :: M5N7FDyi = 1177 + INTEGER(IntKi), PARAMETER :: M5N8FDyi = 1178 + INTEGER(IntKi), PARAMETER :: M5N9FDyi = 1179 + INTEGER(IntKi), PARAMETER :: M6N1FDyi = 1180 + INTEGER(IntKi), PARAMETER :: M6N2FDyi = 1181 + INTEGER(IntKi), PARAMETER :: M6N3FDyi = 1182 + INTEGER(IntKi), PARAMETER :: M6N4FDyi = 1183 + INTEGER(IntKi), PARAMETER :: M6N5FDyi = 1184 + INTEGER(IntKi), PARAMETER :: M6N6FDyi = 1185 + INTEGER(IntKi), PARAMETER :: M6N7FDyi = 1186 + INTEGER(IntKi), PARAMETER :: M6N8FDyi = 1187 + INTEGER(IntKi), PARAMETER :: M6N9FDyi = 1188 + INTEGER(IntKi), PARAMETER :: M7N1FDyi = 1189 + INTEGER(IntKi), PARAMETER :: M7N2FDyi = 1190 + INTEGER(IntKi), PARAMETER :: M7N3FDyi = 1191 + INTEGER(IntKi), PARAMETER :: M7N4FDyi = 1192 + INTEGER(IntKi), PARAMETER :: M7N5FDyi = 1193 + INTEGER(IntKi), PARAMETER :: M7N6FDyi = 1194 + INTEGER(IntKi), PARAMETER :: M7N7FDyi = 1195 + INTEGER(IntKi), PARAMETER :: M7N8FDyi = 1196 + INTEGER(IntKi), PARAMETER :: M7N9FDyi = 1197 + INTEGER(IntKi), PARAMETER :: M8N1FDyi = 1198 + INTEGER(IntKi), PARAMETER :: M8N2FDyi = 1199 + INTEGER(IntKi), PARAMETER :: M8N3FDyi = 1200 + INTEGER(IntKi), PARAMETER :: M8N4FDyi = 1201 + INTEGER(IntKi), PARAMETER :: M8N5FDyi = 1202 + INTEGER(IntKi), PARAMETER :: M8N6FDyi = 1203 + INTEGER(IntKi), PARAMETER :: M8N7FDyi = 1204 + INTEGER(IntKi), PARAMETER :: M8N8FDyi = 1205 + INTEGER(IntKi), PARAMETER :: M8N9FDyi = 1206 + INTEGER(IntKi), PARAMETER :: M9N1FDyi = 1207 + INTEGER(IntKi), PARAMETER :: M9N2FDyi = 1208 + INTEGER(IntKi), PARAMETER :: M9N3FDyi = 1209 + INTEGER(IntKi), PARAMETER :: M9N4FDyi = 1210 + INTEGER(IntKi), PARAMETER :: M9N5FDyi = 1211 + INTEGER(IntKi), PARAMETER :: M9N6FDyi = 1212 + INTEGER(IntKi), PARAMETER :: M9N7FDyi = 1213 + INTEGER(IntKi), PARAMETER :: M9N8FDyi = 1214 + INTEGER(IntKi), PARAMETER :: M9N9FDyi = 1215 + INTEGER(IntKi), PARAMETER :: M1N1FDzi = 1216 + INTEGER(IntKi), PARAMETER :: M1N2FDzi = 1217 + INTEGER(IntKi), PARAMETER :: M1N3FDzi = 1218 + INTEGER(IntKi), PARAMETER :: M1N4FDzi = 1219 + INTEGER(IntKi), PARAMETER :: M1N5FDzi = 1220 + INTEGER(IntKi), PARAMETER :: M1N6FDzi = 1221 + INTEGER(IntKi), PARAMETER :: M1N7FDzi = 1222 + INTEGER(IntKi), PARAMETER :: M1N8FDzi = 1223 + INTEGER(IntKi), PARAMETER :: M1N9FDzi = 1224 + INTEGER(IntKi), PARAMETER :: M2N1FDzi = 1225 + INTEGER(IntKi), PARAMETER :: M2N2FDzi = 1226 + INTEGER(IntKi), PARAMETER :: M2N3FDzi = 1227 + INTEGER(IntKi), PARAMETER :: M2N4FDzi = 1228 + INTEGER(IntKi), PARAMETER :: M2N5FDzi = 1229 + INTEGER(IntKi), PARAMETER :: M2N6FDzi = 1230 + INTEGER(IntKi), PARAMETER :: M2N7FDzi = 1231 + INTEGER(IntKi), PARAMETER :: M2N8FDzi = 1232 + INTEGER(IntKi), PARAMETER :: M2N9FDzi = 1233 + INTEGER(IntKi), PARAMETER :: M3N1FDzi = 1234 + INTEGER(IntKi), PARAMETER :: M3N2FDzi = 1235 + INTEGER(IntKi), PARAMETER :: M3N3FDzi = 1236 + INTEGER(IntKi), PARAMETER :: M3N4FDzi = 1237 + INTEGER(IntKi), PARAMETER :: M3N5FDzi = 1238 + INTEGER(IntKi), PARAMETER :: M3N6FDzi = 1239 + INTEGER(IntKi), PARAMETER :: M3N7FDzi = 1240 + INTEGER(IntKi), PARAMETER :: M3N8FDzi = 1241 + INTEGER(IntKi), PARAMETER :: M3N9FDzi = 1242 + INTEGER(IntKi), PARAMETER :: M4N1FDzi = 1243 + INTEGER(IntKi), PARAMETER :: M4N2FDzi = 1244 + INTEGER(IntKi), PARAMETER :: M4N3FDzi = 1245 + INTEGER(IntKi), PARAMETER :: M4N4FDzi = 1246 + INTEGER(IntKi), PARAMETER :: M4N5FDzi = 1247 + INTEGER(IntKi), PARAMETER :: M4N6FDzi = 1248 + INTEGER(IntKi), PARAMETER :: M4N7FDzi = 1249 + INTEGER(IntKi), PARAMETER :: M4N8FDzi = 1250 + INTEGER(IntKi), PARAMETER :: M4N9FDzi = 1251 + INTEGER(IntKi), PARAMETER :: M5N1FDzi = 1252 + INTEGER(IntKi), PARAMETER :: M5N2FDzi = 1253 + INTEGER(IntKi), PARAMETER :: M5N3FDzi = 1254 + INTEGER(IntKi), PARAMETER :: M5N4FDzi = 1255 + INTEGER(IntKi), PARAMETER :: M5N5FDzi = 1256 + INTEGER(IntKi), PARAMETER :: M5N6FDzi = 1257 + INTEGER(IntKi), PARAMETER :: M5N7FDzi = 1258 + INTEGER(IntKi), PARAMETER :: M5N8FDzi = 1259 + INTEGER(IntKi), PARAMETER :: M5N9FDzi = 1260 + INTEGER(IntKi), PARAMETER :: M6N1FDzi = 1261 + INTEGER(IntKi), PARAMETER :: M6N2FDzi = 1262 + INTEGER(IntKi), PARAMETER :: M6N3FDzi = 1263 + INTEGER(IntKi), PARAMETER :: M6N4FDzi = 1264 + INTEGER(IntKi), PARAMETER :: M6N5FDzi = 1265 + INTEGER(IntKi), PARAMETER :: M6N6FDzi = 1266 + INTEGER(IntKi), PARAMETER :: M6N7FDzi = 1267 + INTEGER(IntKi), PARAMETER :: M6N8FDzi = 1268 + INTEGER(IntKi), PARAMETER :: M6N9FDzi = 1269 + INTEGER(IntKi), PARAMETER :: M7N1FDzi = 1270 + INTEGER(IntKi), PARAMETER :: M7N2FDzi = 1271 + INTEGER(IntKi), PARAMETER :: M7N3FDzi = 1272 + INTEGER(IntKi), PARAMETER :: M7N4FDzi = 1273 + INTEGER(IntKi), PARAMETER :: M7N5FDzi = 1274 + INTEGER(IntKi), PARAMETER :: M7N6FDzi = 1275 + INTEGER(IntKi), PARAMETER :: M7N7FDzi = 1276 + INTEGER(IntKi), PARAMETER :: M7N8FDzi = 1277 + INTEGER(IntKi), PARAMETER :: M7N9FDzi = 1278 + INTEGER(IntKi), PARAMETER :: M8N1FDzi = 1279 + INTEGER(IntKi), PARAMETER :: M8N2FDzi = 1280 + INTEGER(IntKi), PARAMETER :: M8N3FDzi = 1281 + INTEGER(IntKi), PARAMETER :: M8N4FDzi = 1282 + INTEGER(IntKi), PARAMETER :: M8N5FDzi = 1283 + INTEGER(IntKi), PARAMETER :: M8N6FDzi = 1284 + INTEGER(IntKi), PARAMETER :: M8N7FDzi = 1285 + INTEGER(IntKi), PARAMETER :: M8N8FDzi = 1286 + INTEGER(IntKi), PARAMETER :: M8N9FDzi = 1287 + INTEGER(IntKi), PARAMETER :: M9N1FDzi = 1288 + INTEGER(IntKi), PARAMETER :: M9N2FDzi = 1289 + INTEGER(IntKi), PARAMETER :: M9N3FDzi = 1290 + INTEGER(IntKi), PARAMETER :: M9N4FDzi = 1291 + INTEGER(IntKi), PARAMETER :: M9N5FDzi = 1292 + INTEGER(IntKi), PARAMETER :: M9N6FDzi = 1293 + INTEGER(IntKi), PARAMETER :: M9N7FDzi = 1294 + INTEGER(IntKi), PARAMETER :: M9N8FDzi = 1295 + INTEGER(IntKi), PARAMETER :: M9N9FDzi = 1296 + INTEGER(IntKi), PARAMETER :: M1N1FIxi = 1297 + INTEGER(IntKi), PARAMETER :: M1N2FIxi = 1298 + INTEGER(IntKi), PARAMETER :: M1N3FIxi = 1299 + INTEGER(IntKi), PARAMETER :: M1N4FIxi = 1300 + INTEGER(IntKi), PARAMETER :: M1N5FIxi = 1301 + INTEGER(IntKi), PARAMETER :: M1N6FIxi = 1302 + INTEGER(IntKi), PARAMETER :: M1N7FIxi = 1303 + INTEGER(IntKi), PARAMETER :: M1N8FIxi = 1304 + INTEGER(IntKi), PARAMETER :: M1N9FIxi = 1305 + INTEGER(IntKi), PARAMETER :: M2N1FIxi = 1306 + INTEGER(IntKi), PARAMETER :: M2N2FIxi = 1307 + INTEGER(IntKi), PARAMETER :: M2N3FIxi = 1308 + INTEGER(IntKi), PARAMETER :: M2N4FIxi = 1309 + INTEGER(IntKi), PARAMETER :: M2N5FIxi = 1310 + INTEGER(IntKi), PARAMETER :: M2N6FIxi = 1311 + INTEGER(IntKi), PARAMETER :: M2N7FIxi = 1312 + INTEGER(IntKi), PARAMETER :: M2N8FIxi = 1313 + INTEGER(IntKi), PARAMETER :: M2N9FIxi = 1314 + INTEGER(IntKi), PARAMETER :: M3N1FIxi = 1315 + INTEGER(IntKi), PARAMETER :: M3N2FIxi = 1316 + INTEGER(IntKi), PARAMETER :: M3N3FIxi = 1317 + INTEGER(IntKi), PARAMETER :: M3N4FIxi = 1318 + INTEGER(IntKi), PARAMETER :: M3N5FIxi = 1319 + INTEGER(IntKi), PARAMETER :: M3N6FIxi = 1320 + INTEGER(IntKi), PARAMETER :: M3N7FIxi = 1321 + INTEGER(IntKi), PARAMETER :: M3N8FIxi = 1322 + INTEGER(IntKi), PARAMETER :: M3N9FIxi = 1323 + INTEGER(IntKi), PARAMETER :: M4N1FIxi = 1324 + INTEGER(IntKi), PARAMETER :: M4N2FIxi = 1325 + INTEGER(IntKi), PARAMETER :: M4N3FIxi = 1326 + INTEGER(IntKi), PARAMETER :: M4N4FIxi = 1327 + INTEGER(IntKi), PARAMETER :: M4N5FIxi = 1328 + INTEGER(IntKi), PARAMETER :: M4N6FIxi = 1329 + INTEGER(IntKi), PARAMETER :: M4N7FIxi = 1330 + INTEGER(IntKi), PARAMETER :: M4N8FIxi = 1331 + INTEGER(IntKi), PARAMETER :: M4N9FIxi = 1332 + INTEGER(IntKi), PARAMETER :: M5N1FIxi = 1333 + INTEGER(IntKi), PARAMETER :: M5N2FIxi = 1334 + INTEGER(IntKi), PARAMETER :: M5N3FIxi = 1335 + INTEGER(IntKi), PARAMETER :: M5N4FIxi = 1336 + INTEGER(IntKi), PARAMETER :: M5N5FIxi = 1337 + INTEGER(IntKi), PARAMETER :: M5N6FIxi = 1338 + INTEGER(IntKi), PARAMETER :: M5N7FIxi = 1339 + INTEGER(IntKi), PARAMETER :: M5N8FIxi = 1340 + INTEGER(IntKi), PARAMETER :: M5N9FIxi = 1341 + INTEGER(IntKi), PARAMETER :: M6N1FIxi = 1342 + INTEGER(IntKi), PARAMETER :: M6N2FIxi = 1343 + INTEGER(IntKi), PARAMETER :: M6N3FIxi = 1344 + INTEGER(IntKi), PARAMETER :: M6N4FIxi = 1345 + INTEGER(IntKi), PARAMETER :: M6N5FIxi = 1346 + INTEGER(IntKi), PARAMETER :: M6N6FIxi = 1347 + INTEGER(IntKi), PARAMETER :: M6N7FIxi = 1348 + INTEGER(IntKi), PARAMETER :: M6N8FIxi = 1349 + INTEGER(IntKi), PARAMETER :: M6N9FIxi = 1350 + INTEGER(IntKi), PARAMETER :: M7N1FIxi = 1351 + INTEGER(IntKi), PARAMETER :: M7N2FIxi = 1352 + INTEGER(IntKi), PARAMETER :: M7N3FIxi = 1353 + INTEGER(IntKi), PARAMETER :: M7N4FIxi = 1354 + INTEGER(IntKi), PARAMETER :: M7N5FIxi = 1355 + INTEGER(IntKi), PARAMETER :: M7N6FIxi = 1356 + INTEGER(IntKi), PARAMETER :: M7N7FIxi = 1357 + INTEGER(IntKi), PARAMETER :: M7N8FIxi = 1358 + INTEGER(IntKi), PARAMETER :: M7N9FIxi = 1359 + INTEGER(IntKi), PARAMETER :: M8N1FIxi = 1360 + INTEGER(IntKi), PARAMETER :: M8N2FIxi = 1361 + INTEGER(IntKi), PARAMETER :: M8N3FIxi = 1362 + INTEGER(IntKi), PARAMETER :: M8N4FIxi = 1363 + INTEGER(IntKi), PARAMETER :: M8N5FIxi = 1364 + INTEGER(IntKi), PARAMETER :: M8N6FIxi = 1365 + INTEGER(IntKi), PARAMETER :: M8N7FIxi = 1366 + INTEGER(IntKi), PARAMETER :: M8N8FIxi = 1367 + INTEGER(IntKi), PARAMETER :: M8N9FIxi = 1368 + INTEGER(IntKi), PARAMETER :: M9N1FIxi = 1369 + INTEGER(IntKi), PARAMETER :: M9N2FIxi = 1370 + INTEGER(IntKi), PARAMETER :: M9N3FIxi = 1371 + INTEGER(IntKi), PARAMETER :: M9N4FIxi = 1372 + INTEGER(IntKi), PARAMETER :: M9N5FIxi = 1373 + INTEGER(IntKi), PARAMETER :: M9N6FIxi = 1374 + INTEGER(IntKi), PARAMETER :: M9N7FIxi = 1375 + INTEGER(IntKi), PARAMETER :: M9N8FIxi = 1376 + INTEGER(IntKi), PARAMETER :: M9N9FIxi = 1377 + INTEGER(IntKi), PARAMETER :: M1N1FIyi = 1378 + INTEGER(IntKi), PARAMETER :: M1N2FIyi = 1379 + INTEGER(IntKi), PARAMETER :: M1N3FIyi = 1380 + INTEGER(IntKi), PARAMETER :: M1N4FIyi = 1381 + INTEGER(IntKi), PARAMETER :: M1N5FIyi = 1382 + INTEGER(IntKi), PARAMETER :: M1N6FIyi = 1383 + INTEGER(IntKi), PARAMETER :: M1N7FIyi = 1384 + INTEGER(IntKi), PARAMETER :: M1N8FIyi = 1385 + INTEGER(IntKi), PARAMETER :: M1N9FIyi = 1386 + INTEGER(IntKi), PARAMETER :: M2N1FIyi = 1387 + INTEGER(IntKi), PARAMETER :: M2N2FIyi = 1388 + INTEGER(IntKi), PARAMETER :: M2N3FIyi = 1389 + INTEGER(IntKi), PARAMETER :: M2N4FIyi = 1390 + INTEGER(IntKi), PARAMETER :: M2N5FIyi = 1391 + INTEGER(IntKi), PARAMETER :: M2N6FIyi = 1392 + INTEGER(IntKi), PARAMETER :: M2N7FIyi = 1393 + INTEGER(IntKi), PARAMETER :: M2N8FIyi = 1394 + INTEGER(IntKi), PARAMETER :: M2N9FIyi = 1395 + INTEGER(IntKi), PARAMETER :: M3N1FIyi = 1396 + INTEGER(IntKi), PARAMETER :: M3N2FIyi = 1397 + INTEGER(IntKi), PARAMETER :: M3N3FIyi = 1398 + INTEGER(IntKi), PARAMETER :: M3N4FIyi = 1399 + INTEGER(IntKi), PARAMETER :: M3N5FIyi = 1400 + INTEGER(IntKi), PARAMETER :: M3N6FIyi = 1401 + INTEGER(IntKi), PARAMETER :: M3N7FIyi = 1402 + INTEGER(IntKi), PARAMETER :: M3N8FIyi = 1403 + INTEGER(IntKi), PARAMETER :: M3N9FIyi = 1404 + INTEGER(IntKi), PARAMETER :: M4N1FIyi = 1405 + INTEGER(IntKi), PARAMETER :: M4N2FIyi = 1406 + INTEGER(IntKi), PARAMETER :: M4N3FIyi = 1407 + INTEGER(IntKi), PARAMETER :: M4N4FIyi = 1408 + INTEGER(IntKi), PARAMETER :: M4N5FIyi = 1409 + INTEGER(IntKi), PARAMETER :: M4N6FIyi = 1410 + INTEGER(IntKi), PARAMETER :: M4N7FIyi = 1411 + INTEGER(IntKi), PARAMETER :: M4N8FIyi = 1412 + INTEGER(IntKi), PARAMETER :: M4N9FIyi = 1413 + INTEGER(IntKi), PARAMETER :: M5N1FIyi = 1414 + INTEGER(IntKi), PARAMETER :: M5N2FIyi = 1415 + INTEGER(IntKi), PARAMETER :: M5N3FIyi = 1416 + INTEGER(IntKi), PARAMETER :: M5N4FIyi = 1417 + INTEGER(IntKi), PARAMETER :: M5N5FIyi = 1418 + INTEGER(IntKi), PARAMETER :: M5N6FIyi = 1419 + INTEGER(IntKi), PARAMETER :: M5N7FIyi = 1420 + INTEGER(IntKi), PARAMETER :: M5N8FIyi = 1421 + INTEGER(IntKi), PARAMETER :: M5N9FIyi = 1422 + INTEGER(IntKi), PARAMETER :: M6N1FIyi = 1423 + INTEGER(IntKi), PARAMETER :: M6N2FIyi = 1424 + INTEGER(IntKi), PARAMETER :: M6N3FIyi = 1425 + INTEGER(IntKi), PARAMETER :: M6N4FIyi = 1426 + INTEGER(IntKi), PARAMETER :: M6N5FIyi = 1427 + INTEGER(IntKi), PARAMETER :: M6N6FIyi = 1428 + INTEGER(IntKi), PARAMETER :: M6N7FIyi = 1429 + INTEGER(IntKi), PARAMETER :: M6N8FIyi = 1430 + INTEGER(IntKi), PARAMETER :: M6N9FIyi = 1431 + INTEGER(IntKi), PARAMETER :: M7N1FIyi = 1432 + INTEGER(IntKi), PARAMETER :: M7N2FIyi = 1433 + INTEGER(IntKi), PARAMETER :: M7N3FIyi = 1434 + INTEGER(IntKi), PARAMETER :: M7N4FIyi = 1435 + INTEGER(IntKi), PARAMETER :: M7N5FIyi = 1436 + INTEGER(IntKi), PARAMETER :: M7N6FIyi = 1437 + INTEGER(IntKi), PARAMETER :: M7N7FIyi = 1438 + INTEGER(IntKi), PARAMETER :: M7N8FIyi = 1439 + INTEGER(IntKi), PARAMETER :: M7N9FIyi = 1440 + INTEGER(IntKi), PARAMETER :: M8N1FIyi = 1441 + INTEGER(IntKi), PARAMETER :: M8N2FIyi = 1442 + INTEGER(IntKi), PARAMETER :: M8N3FIyi = 1443 + INTEGER(IntKi), PARAMETER :: M8N4FIyi = 1444 + INTEGER(IntKi), PARAMETER :: M8N5FIyi = 1445 + INTEGER(IntKi), PARAMETER :: M8N6FIyi = 1446 + INTEGER(IntKi), PARAMETER :: M8N7FIyi = 1447 + INTEGER(IntKi), PARAMETER :: M8N8FIyi = 1448 + INTEGER(IntKi), PARAMETER :: M8N9FIyi = 1449 + INTEGER(IntKi), PARAMETER :: M9N1FIyi = 1450 + INTEGER(IntKi), PARAMETER :: M9N2FIyi = 1451 + INTEGER(IntKi), PARAMETER :: M9N3FIyi = 1452 + INTEGER(IntKi), PARAMETER :: M9N4FIyi = 1453 + INTEGER(IntKi), PARAMETER :: M9N5FIyi = 1454 + INTEGER(IntKi), PARAMETER :: M9N6FIyi = 1455 + INTEGER(IntKi), PARAMETER :: M9N7FIyi = 1456 + INTEGER(IntKi), PARAMETER :: M9N8FIyi = 1457 + INTEGER(IntKi), PARAMETER :: M9N9FIyi = 1458 + INTEGER(IntKi), PARAMETER :: M1N1FIzi = 1459 + INTEGER(IntKi), PARAMETER :: M1N2FIzi = 1460 + INTEGER(IntKi), PARAMETER :: M1N3FIzi = 1461 + INTEGER(IntKi), PARAMETER :: M1N4FIzi = 1462 + INTEGER(IntKi), PARAMETER :: M1N5FIzi = 1463 + INTEGER(IntKi), PARAMETER :: M1N6FIzi = 1464 + INTEGER(IntKi), PARAMETER :: M1N7FIzi = 1465 + INTEGER(IntKi), PARAMETER :: M1N8FIzi = 1466 + INTEGER(IntKi), PARAMETER :: M1N9FIzi = 1467 + INTEGER(IntKi), PARAMETER :: M2N1FIzi = 1468 + INTEGER(IntKi), PARAMETER :: M2N2FIzi = 1469 + INTEGER(IntKi), PARAMETER :: M2N3FIzi = 1470 + INTEGER(IntKi), PARAMETER :: M2N4FIzi = 1471 + INTEGER(IntKi), PARAMETER :: M2N5FIzi = 1472 + INTEGER(IntKi), PARAMETER :: M2N6FIzi = 1473 + INTEGER(IntKi), PARAMETER :: M2N7FIzi = 1474 + INTEGER(IntKi), PARAMETER :: M2N8FIzi = 1475 + INTEGER(IntKi), PARAMETER :: M2N9FIzi = 1476 + INTEGER(IntKi), PARAMETER :: M3N1FIzi = 1477 + INTEGER(IntKi), PARAMETER :: M3N2FIzi = 1478 + INTEGER(IntKi), PARAMETER :: M3N3FIzi = 1479 + INTEGER(IntKi), PARAMETER :: M3N4FIzi = 1480 + INTEGER(IntKi), PARAMETER :: M3N5FIzi = 1481 + INTEGER(IntKi), PARAMETER :: M3N6FIzi = 1482 + INTEGER(IntKi), PARAMETER :: M3N7FIzi = 1483 + INTEGER(IntKi), PARAMETER :: M3N8FIzi = 1484 + INTEGER(IntKi), PARAMETER :: M3N9FIzi = 1485 + INTEGER(IntKi), PARAMETER :: M4N1FIzi = 1486 + INTEGER(IntKi), PARAMETER :: M4N2FIzi = 1487 + INTEGER(IntKi), PARAMETER :: M4N3FIzi = 1488 + INTEGER(IntKi), PARAMETER :: M4N4FIzi = 1489 + INTEGER(IntKi), PARAMETER :: M4N5FIzi = 1490 + INTEGER(IntKi), PARAMETER :: M4N6FIzi = 1491 + INTEGER(IntKi), PARAMETER :: M4N7FIzi = 1492 + INTEGER(IntKi), PARAMETER :: M4N8FIzi = 1493 + INTEGER(IntKi), PARAMETER :: M4N9FIzi = 1494 + INTEGER(IntKi), PARAMETER :: M5N1FIzi = 1495 + INTEGER(IntKi), PARAMETER :: M5N2FIzi = 1496 + INTEGER(IntKi), PARAMETER :: M5N3FIzi = 1497 + INTEGER(IntKi), PARAMETER :: M5N4FIzi = 1498 + INTEGER(IntKi), PARAMETER :: M5N5FIzi = 1499 + INTEGER(IntKi), PARAMETER :: M5N6FIzi = 1500 + INTEGER(IntKi), PARAMETER :: M5N7FIzi = 1501 + INTEGER(IntKi), PARAMETER :: M5N8FIzi = 1502 + INTEGER(IntKi), PARAMETER :: M5N9FIzi = 1503 + INTEGER(IntKi), PARAMETER :: M6N1FIzi = 1504 + INTEGER(IntKi), PARAMETER :: M6N2FIzi = 1505 + INTEGER(IntKi), PARAMETER :: M6N3FIzi = 1506 + INTEGER(IntKi), PARAMETER :: M6N4FIzi = 1507 + INTEGER(IntKi), PARAMETER :: M6N5FIzi = 1508 + INTEGER(IntKi), PARAMETER :: M6N6FIzi = 1509 + INTEGER(IntKi), PARAMETER :: M6N7FIzi = 1510 + INTEGER(IntKi), PARAMETER :: M6N8FIzi = 1511 + INTEGER(IntKi), PARAMETER :: M6N9FIzi = 1512 + INTEGER(IntKi), PARAMETER :: M7N1FIzi = 1513 + INTEGER(IntKi), PARAMETER :: M7N2FIzi = 1514 + INTEGER(IntKi), PARAMETER :: M7N3FIzi = 1515 + INTEGER(IntKi), PARAMETER :: M7N4FIzi = 1516 + INTEGER(IntKi), PARAMETER :: M7N5FIzi = 1517 + INTEGER(IntKi), PARAMETER :: M7N6FIzi = 1518 + INTEGER(IntKi), PARAMETER :: M7N7FIzi = 1519 + INTEGER(IntKi), PARAMETER :: M7N8FIzi = 1520 + INTEGER(IntKi), PARAMETER :: M7N9FIzi = 1521 + INTEGER(IntKi), PARAMETER :: M8N1FIzi = 1522 + INTEGER(IntKi), PARAMETER :: M8N2FIzi = 1523 + INTEGER(IntKi), PARAMETER :: M8N3FIzi = 1524 + INTEGER(IntKi), PARAMETER :: M8N4FIzi = 1525 + INTEGER(IntKi), PARAMETER :: M8N5FIzi = 1526 + INTEGER(IntKi), PARAMETER :: M8N6FIzi = 1527 + INTEGER(IntKi), PARAMETER :: M8N7FIzi = 1528 + INTEGER(IntKi), PARAMETER :: M8N8FIzi = 1529 + INTEGER(IntKi), PARAMETER :: M8N9FIzi = 1530 + INTEGER(IntKi), PARAMETER :: M9N1FIzi = 1531 + INTEGER(IntKi), PARAMETER :: M9N2FIzi = 1532 + INTEGER(IntKi), PARAMETER :: M9N3FIzi = 1533 + INTEGER(IntKi), PARAMETER :: M9N4FIzi = 1534 + INTEGER(IntKi), PARAMETER :: M9N5FIzi = 1535 + INTEGER(IntKi), PARAMETER :: M9N6FIzi = 1536 + INTEGER(IntKi), PARAMETER :: M9N7FIzi = 1537 + INTEGER(IntKi), PARAMETER :: M9N8FIzi = 1538 + INTEGER(IntKi), PARAMETER :: M9N9FIzi = 1539 + INTEGER(IntKi), PARAMETER :: M1N1FBxi = 1540 + INTEGER(IntKi), PARAMETER :: M1N2FBxi = 1541 + INTEGER(IntKi), PARAMETER :: M1N3FBxi = 1542 + INTEGER(IntKi), PARAMETER :: M1N4FBxi = 1543 + INTEGER(IntKi), PARAMETER :: M1N5FBxi = 1544 + INTEGER(IntKi), PARAMETER :: M1N6FBxi = 1545 + INTEGER(IntKi), PARAMETER :: M1N7FBxi = 1546 + INTEGER(IntKi), PARAMETER :: M1N8FBxi = 1547 + INTEGER(IntKi), PARAMETER :: M1N9FBxi = 1548 + INTEGER(IntKi), PARAMETER :: M2N1FBxi = 1549 + INTEGER(IntKi), PARAMETER :: M2N2FBxi = 1550 + INTEGER(IntKi), PARAMETER :: M2N3FBxi = 1551 + INTEGER(IntKi), PARAMETER :: M2N4FBxi = 1552 + INTEGER(IntKi), PARAMETER :: M2N5FBxi = 1553 + INTEGER(IntKi), PARAMETER :: M2N6FBxi = 1554 + INTEGER(IntKi), PARAMETER :: M2N7FBxi = 1555 + INTEGER(IntKi), PARAMETER :: M2N8FBxi = 1556 + INTEGER(IntKi), PARAMETER :: M2N9FBxi = 1557 + INTEGER(IntKi), PARAMETER :: M3N1FBxi = 1558 + INTEGER(IntKi), PARAMETER :: M3N2FBxi = 1559 + INTEGER(IntKi), PARAMETER :: M3N3FBxi = 1560 + INTEGER(IntKi), PARAMETER :: M3N4FBxi = 1561 + INTEGER(IntKi), PARAMETER :: M3N5FBxi = 1562 + INTEGER(IntKi), PARAMETER :: M3N6FBxi = 1563 + INTEGER(IntKi), PARAMETER :: M3N7FBxi = 1564 + INTEGER(IntKi), PARAMETER :: M3N8FBxi = 1565 + INTEGER(IntKi), PARAMETER :: M3N9FBxi = 1566 + INTEGER(IntKi), PARAMETER :: M4N1FBxi = 1567 + INTEGER(IntKi), PARAMETER :: M4N2FBxi = 1568 + INTEGER(IntKi), PARAMETER :: M4N3FBxi = 1569 + INTEGER(IntKi), PARAMETER :: M4N4FBxi = 1570 + INTEGER(IntKi), PARAMETER :: M4N5FBxi = 1571 + INTEGER(IntKi), PARAMETER :: M4N6FBxi = 1572 + INTEGER(IntKi), PARAMETER :: M4N7FBxi = 1573 + INTEGER(IntKi), PARAMETER :: M4N8FBxi = 1574 + INTEGER(IntKi), PARAMETER :: M4N9FBxi = 1575 + INTEGER(IntKi), PARAMETER :: M5N1FBxi = 1576 + INTEGER(IntKi), PARAMETER :: M5N2FBxi = 1577 + INTEGER(IntKi), PARAMETER :: M5N3FBxi = 1578 + INTEGER(IntKi), PARAMETER :: M5N4FBxi = 1579 + INTEGER(IntKi), PARAMETER :: M5N5FBxi = 1580 + INTEGER(IntKi), PARAMETER :: M5N6FBxi = 1581 + INTEGER(IntKi), PARAMETER :: M5N7FBxi = 1582 + INTEGER(IntKi), PARAMETER :: M5N8FBxi = 1583 + INTEGER(IntKi), PARAMETER :: M5N9FBxi = 1584 + INTEGER(IntKi), PARAMETER :: M6N1FBxi = 1585 + INTEGER(IntKi), PARAMETER :: M6N2FBxi = 1586 + INTEGER(IntKi), PARAMETER :: M6N3FBxi = 1587 + INTEGER(IntKi), PARAMETER :: M6N4FBxi = 1588 + INTEGER(IntKi), PARAMETER :: M6N5FBxi = 1589 + INTEGER(IntKi), PARAMETER :: M6N6FBxi = 1590 + INTEGER(IntKi), PARAMETER :: M6N7FBxi = 1591 + INTEGER(IntKi), PARAMETER :: M6N8FBxi = 1592 + INTEGER(IntKi), PARAMETER :: M6N9FBxi = 1593 + INTEGER(IntKi), PARAMETER :: M7N1FBxi = 1594 + INTEGER(IntKi), PARAMETER :: M7N2FBxi = 1595 + INTEGER(IntKi), PARAMETER :: M7N3FBxi = 1596 + INTEGER(IntKi), PARAMETER :: M7N4FBxi = 1597 + INTEGER(IntKi), PARAMETER :: M7N5FBxi = 1598 + INTEGER(IntKi), PARAMETER :: M7N6FBxi = 1599 + INTEGER(IntKi), PARAMETER :: M7N7FBxi = 1600 + INTEGER(IntKi), PARAMETER :: M7N8FBxi = 1601 + INTEGER(IntKi), PARAMETER :: M7N9FBxi = 1602 + INTEGER(IntKi), PARAMETER :: M8N1FBxi = 1603 + INTEGER(IntKi), PARAMETER :: M8N2FBxi = 1604 + INTEGER(IntKi), PARAMETER :: M8N3FBxi = 1605 + INTEGER(IntKi), PARAMETER :: M8N4FBxi = 1606 + INTEGER(IntKi), PARAMETER :: M8N5FBxi = 1607 + INTEGER(IntKi), PARAMETER :: M8N6FBxi = 1608 + INTEGER(IntKi), PARAMETER :: M8N7FBxi = 1609 + INTEGER(IntKi), PARAMETER :: M8N8FBxi = 1610 + INTEGER(IntKi), PARAMETER :: M8N9FBxi = 1611 + INTEGER(IntKi), PARAMETER :: M9N1FBxi = 1612 + INTEGER(IntKi), PARAMETER :: M9N2FBxi = 1613 + INTEGER(IntKi), PARAMETER :: M9N3FBxi = 1614 + INTEGER(IntKi), PARAMETER :: M9N4FBxi = 1615 + INTEGER(IntKi), PARAMETER :: M9N5FBxi = 1616 + INTEGER(IntKi), PARAMETER :: M9N6FBxi = 1617 + INTEGER(IntKi), PARAMETER :: M9N7FBxi = 1618 + INTEGER(IntKi), PARAMETER :: M9N8FBxi = 1619 + INTEGER(IntKi), PARAMETER :: M9N9FBxi = 1620 + INTEGER(IntKi), PARAMETER :: M1N1FByi = 1621 + INTEGER(IntKi), PARAMETER :: M1N2FByi = 1622 + INTEGER(IntKi), PARAMETER :: M1N3FByi = 1623 + INTEGER(IntKi), PARAMETER :: M1N4FByi = 1624 + INTEGER(IntKi), PARAMETER :: M1N5FByi = 1625 + INTEGER(IntKi), PARAMETER :: M1N6FByi = 1626 + INTEGER(IntKi), PARAMETER :: M1N7FByi = 1627 + INTEGER(IntKi), PARAMETER :: M1N8FByi = 1628 + INTEGER(IntKi), PARAMETER :: M1N9FByi = 1629 + INTEGER(IntKi), PARAMETER :: M2N1FByi = 1630 + INTEGER(IntKi), PARAMETER :: M2N2FByi = 1631 + INTEGER(IntKi), PARAMETER :: M2N3FByi = 1632 + INTEGER(IntKi), PARAMETER :: M2N4FByi = 1633 + INTEGER(IntKi), PARAMETER :: M2N5FByi = 1634 + INTEGER(IntKi), PARAMETER :: M2N6FByi = 1635 + INTEGER(IntKi), PARAMETER :: M2N7FByi = 1636 + INTEGER(IntKi), PARAMETER :: M2N8FByi = 1637 + INTEGER(IntKi), PARAMETER :: M2N9FByi = 1638 + INTEGER(IntKi), PARAMETER :: M3N1FByi = 1639 + INTEGER(IntKi), PARAMETER :: M3N2FByi = 1640 + INTEGER(IntKi), PARAMETER :: M3N3FByi = 1641 + INTEGER(IntKi), PARAMETER :: M3N4FByi = 1642 + INTEGER(IntKi), PARAMETER :: M3N5FByi = 1643 + INTEGER(IntKi), PARAMETER :: M3N6FByi = 1644 + INTEGER(IntKi), PARAMETER :: M3N7FByi = 1645 + INTEGER(IntKi), PARAMETER :: M3N8FByi = 1646 + INTEGER(IntKi), PARAMETER :: M3N9FByi = 1647 + INTEGER(IntKi), PARAMETER :: M4N1FByi = 1648 + INTEGER(IntKi), PARAMETER :: M4N2FByi = 1649 + INTEGER(IntKi), PARAMETER :: M4N3FByi = 1650 + INTEGER(IntKi), PARAMETER :: M4N4FByi = 1651 + INTEGER(IntKi), PARAMETER :: M4N5FByi = 1652 + INTEGER(IntKi), PARAMETER :: M4N6FByi = 1653 + INTEGER(IntKi), PARAMETER :: M4N7FByi = 1654 + INTEGER(IntKi), PARAMETER :: M4N8FByi = 1655 + INTEGER(IntKi), PARAMETER :: M4N9FByi = 1656 + INTEGER(IntKi), PARAMETER :: M5N1FByi = 1657 + INTEGER(IntKi), PARAMETER :: M5N2FByi = 1658 + INTEGER(IntKi), PARAMETER :: M5N3FByi = 1659 + INTEGER(IntKi), PARAMETER :: M5N4FByi = 1660 + INTEGER(IntKi), PARAMETER :: M5N5FByi = 1661 + INTEGER(IntKi), PARAMETER :: M5N6FByi = 1662 + INTEGER(IntKi), PARAMETER :: M5N7FByi = 1663 + INTEGER(IntKi), PARAMETER :: M5N8FByi = 1664 + INTEGER(IntKi), PARAMETER :: M5N9FByi = 1665 + INTEGER(IntKi), PARAMETER :: M6N1FByi = 1666 + INTEGER(IntKi), PARAMETER :: M6N2FByi = 1667 + INTEGER(IntKi), PARAMETER :: M6N3FByi = 1668 + INTEGER(IntKi), PARAMETER :: M6N4FByi = 1669 + INTEGER(IntKi), PARAMETER :: M6N5FByi = 1670 + INTEGER(IntKi), PARAMETER :: M6N6FByi = 1671 + INTEGER(IntKi), PARAMETER :: M6N7FByi = 1672 + INTEGER(IntKi), PARAMETER :: M6N8FByi = 1673 + INTEGER(IntKi), PARAMETER :: M6N9FByi = 1674 + INTEGER(IntKi), PARAMETER :: M7N1FByi = 1675 + INTEGER(IntKi), PARAMETER :: M7N2FByi = 1676 + INTEGER(IntKi), PARAMETER :: M7N3FByi = 1677 + INTEGER(IntKi), PARAMETER :: M7N4FByi = 1678 + INTEGER(IntKi), PARAMETER :: M7N5FByi = 1679 + INTEGER(IntKi), PARAMETER :: M7N6FByi = 1680 + INTEGER(IntKi), PARAMETER :: M7N7FByi = 1681 + INTEGER(IntKi), PARAMETER :: M7N8FByi = 1682 + INTEGER(IntKi), PARAMETER :: M7N9FByi = 1683 + INTEGER(IntKi), PARAMETER :: M8N1FByi = 1684 + INTEGER(IntKi), PARAMETER :: M8N2FByi = 1685 + INTEGER(IntKi), PARAMETER :: M8N3FByi = 1686 + INTEGER(IntKi), PARAMETER :: M8N4FByi = 1687 + INTEGER(IntKi), PARAMETER :: M8N5FByi = 1688 + INTEGER(IntKi), PARAMETER :: M8N6FByi = 1689 + INTEGER(IntKi), PARAMETER :: M8N7FByi = 1690 + INTEGER(IntKi), PARAMETER :: M8N8FByi = 1691 + INTEGER(IntKi), PARAMETER :: M8N9FByi = 1692 + INTEGER(IntKi), PARAMETER :: M9N1FByi = 1693 + INTEGER(IntKi), PARAMETER :: M9N2FByi = 1694 + INTEGER(IntKi), PARAMETER :: M9N3FByi = 1695 + INTEGER(IntKi), PARAMETER :: M9N4FByi = 1696 + INTEGER(IntKi), PARAMETER :: M9N5FByi = 1697 + INTEGER(IntKi), PARAMETER :: M9N6FByi = 1698 + INTEGER(IntKi), PARAMETER :: M9N7FByi = 1699 + INTEGER(IntKi), PARAMETER :: M9N8FByi = 1700 + INTEGER(IntKi), PARAMETER :: M9N9FByi = 1701 + INTEGER(IntKi), PARAMETER :: M1N1FBzi = 1702 + INTEGER(IntKi), PARAMETER :: M1N2FBzi = 1703 + INTEGER(IntKi), PARAMETER :: M1N3FBzi = 1704 + INTEGER(IntKi), PARAMETER :: M1N4FBzi = 1705 + INTEGER(IntKi), PARAMETER :: M1N5FBzi = 1706 + INTEGER(IntKi), PARAMETER :: M1N6FBzi = 1707 + INTEGER(IntKi), PARAMETER :: M1N7FBzi = 1708 + INTEGER(IntKi), PARAMETER :: M1N8FBzi = 1709 + INTEGER(IntKi), PARAMETER :: M1N9FBzi = 1710 + INTEGER(IntKi), PARAMETER :: M2N1FBzi = 1711 + INTEGER(IntKi), PARAMETER :: M2N2FBzi = 1712 + INTEGER(IntKi), PARAMETER :: M2N3FBzi = 1713 + INTEGER(IntKi), PARAMETER :: M2N4FBzi = 1714 + INTEGER(IntKi), PARAMETER :: M2N5FBzi = 1715 + INTEGER(IntKi), PARAMETER :: M2N6FBzi = 1716 + INTEGER(IntKi), PARAMETER :: M2N7FBzi = 1717 + INTEGER(IntKi), PARAMETER :: M2N8FBzi = 1718 + INTEGER(IntKi), PARAMETER :: M2N9FBzi = 1719 + INTEGER(IntKi), PARAMETER :: M3N1FBzi = 1720 + INTEGER(IntKi), PARAMETER :: M3N2FBzi = 1721 + INTEGER(IntKi), PARAMETER :: M3N3FBzi = 1722 + INTEGER(IntKi), PARAMETER :: M3N4FBzi = 1723 + INTEGER(IntKi), PARAMETER :: M3N5FBzi = 1724 + INTEGER(IntKi), PARAMETER :: M3N6FBzi = 1725 + INTEGER(IntKi), PARAMETER :: M3N7FBzi = 1726 + INTEGER(IntKi), PARAMETER :: M3N8FBzi = 1727 + INTEGER(IntKi), PARAMETER :: M3N9FBzi = 1728 + INTEGER(IntKi), PARAMETER :: M4N1FBzi = 1729 + INTEGER(IntKi), PARAMETER :: M4N2FBzi = 1730 + INTEGER(IntKi), PARAMETER :: M4N3FBzi = 1731 + INTEGER(IntKi), PARAMETER :: M4N4FBzi = 1732 + INTEGER(IntKi), PARAMETER :: M4N5FBzi = 1733 + INTEGER(IntKi), PARAMETER :: M4N6FBzi = 1734 + INTEGER(IntKi), PARAMETER :: M4N7FBzi = 1735 + INTEGER(IntKi), PARAMETER :: M4N8FBzi = 1736 + INTEGER(IntKi), PARAMETER :: M4N9FBzi = 1737 + INTEGER(IntKi), PARAMETER :: M5N1FBzi = 1738 + INTEGER(IntKi), PARAMETER :: M5N2FBzi = 1739 + INTEGER(IntKi), PARAMETER :: M5N3FBzi = 1740 + INTEGER(IntKi), PARAMETER :: M5N4FBzi = 1741 + INTEGER(IntKi), PARAMETER :: M5N5FBzi = 1742 + INTEGER(IntKi), PARAMETER :: M5N6FBzi = 1743 + INTEGER(IntKi), PARAMETER :: M5N7FBzi = 1744 + INTEGER(IntKi), PARAMETER :: M5N8FBzi = 1745 + INTEGER(IntKi), PARAMETER :: M5N9FBzi = 1746 + INTEGER(IntKi), PARAMETER :: M6N1FBzi = 1747 + INTEGER(IntKi), PARAMETER :: M6N2FBzi = 1748 + INTEGER(IntKi), PARAMETER :: M6N3FBzi = 1749 + INTEGER(IntKi), PARAMETER :: M6N4FBzi = 1750 + INTEGER(IntKi), PARAMETER :: M6N5FBzi = 1751 + INTEGER(IntKi), PARAMETER :: M6N6FBzi = 1752 + INTEGER(IntKi), PARAMETER :: M6N7FBzi = 1753 + INTEGER(IntKi), PARAMETER :: M6N8FBzi = 1754 + INTEGER(IntKi), PARAMETER :: M6N9FBzi = 1755 + INTEGER(IntKi), PARAMETER :: M7N1FBzi = 1756 + INTEGER(IntKi), PARAMETER :: M7N2FBzi = 1757 + INTEGER(IntKi), PARAMETER :: M7N3FBzi = 1758 + INTEGER(IntKi), PARAMETER :: M7N4FBzi = 1759 + INTEGER(IntKi), PARAMETER :: M7N5FBzi = 1760 + INTEGER(IntKi), PARAMETER :: M7N6FBzi = 1761 + INTEGER(IntKi), PARAMETER :: M7N7FBzi = 1762 + INTEGER(IntKi), PARAMETER :: M7N8FBzi = 1763 + INTEGER(IntKi), PARAMETER :: M7N9FBzi = 1764 + INTEGER(IntKi), PARAMETER :: M8N1FBzi = 1765 + INTEGER(IntKi), PARAMETER :: M8N2FBzi = 1766 + INTEGER(IntKi), PARAMETER :: M8N3FBzi = 1767 + INTEGER(IntKi), PARAMETER :: M8N4FBzi = 1768 + INTEGER(IntKi), PARAMETER :: M8N5FBzi = 1769 + INTEGER(IntKi), PARAMETER :: M8N6FBzi = 1770 + INTEGER(IntKi), PARAMETER :: M8N7FBzi = 1771 + INTEGER(IntKi), PARAMETER :: M8N8FBzi = 1772 + INTEGER(IntKi), PARAMETER :: M8N9FBzi = 1773 + INTEGER(IntKi), PARAMETER :: M9N1FBzi = 1774 + INTEGER(IntKi), PARAMETER :: M9N2FBzi = 1775 + INTEGER(IntKi), PARAMETER :: M9N3FBzi = 1776 + INTEGER(IntKi), PARAMETER :: M9N4FBzi = 1777 + INTEGER(IntKi), PARAMETER :: M9N5FBzi = 1778 + INTEGER(IntKi), PARAMETER :: M9N6FBzi = 1779 + INTEGER(IntKi), PARAMETER :: M9N7FBzi = 1780 + INTEGER(IntKi), PARAMETER :: M9N8FBzi = 1781 + INTEGER(IntKi), PARAMETER :: M9N9FBzi = 1782 + INTEGER(IntKi), PARAMETER :: M1N1MBxi = 1783 + INTEGER(IntKi), PARAMETER :: M1N2MBxi = 1784 + INTEGER(IntKi), PARAMETER :: M1N3MBxi = 1785 + INTEGER(IntKi), PARAMETER :: M1N4MBxi = 1786 + INTEGER(IntKi), PARAMETER :: M1N5MBxi = 1787 + INTEGER(IntKi), PARAMETER :: M1N6MBxi = 1788 + INTEGER(IntKi), PARAMETER :: M1N7MBxi = 1789 + INTEGER(IntKi), PARAMETER :: M1N8MBxi = 1790 + INTEGER(IntKi), PARAMETER :: M1N9MBxi = 1791 + INTEGER(IntKi), PARAMETER :: M2N1MBxi = 1792 + INTEGER(IntKi), PARAMETER :: M2N2MBxi = 1793 + INTEGER(IntKi), PARAMETER :: M2N3MBxi = 1794 + INTEGER(IntKi), PARAMETER :: M2N4MBxi = 1795 + INTEGER(IntKi), PARAMETER :: M2N5MBxi = 1796 + INTEGER(IntKi), PARAMETER :: M2N6MBxi = 1797 + INTEGER(IntKi), PARAMETER :: M2N7MBxi = 1798 + INTEGER(IntKi), PARAMETER :: M2N8MBxi = 1799 + INTEGER(IntKi), PARAMETER :: M2N9MBxi = 1800 + INTEGER(IntKi), PARAMETER :: M3N1MBxi = 1801 + INTEGER(IntKi), PARAMETER :: M3N2MBxi = 1802 + INTEGER(IntKi), PARAMETER :: M3N3MBxi = 1803 + INTEGER(IntKi), PARAMETER :: M3N4MBxi = 1804 + INTEGER(IntKi), PARAMETER :: M3N5MBxi = 1805 + INTEGER(IntKi), PARAMETER :: M3N6MBxi = 1806 + INTEGER(IntKi), PARAMETER :: M3N7MBxi = 1807 + INTEGER(IntKi), PARAMETER :: M3N8MBxi = 1808 + INTEGER(IntKi), PARAMETER :: M3N9MBxi = 1809 + INTEGER(IntKi), PARAMETER :: M4N1MBxi = 1810 + INTEGER(IntKi), PARAMETER :: M4N2MBxi = 1811 + INTEGER(IntKi), PARAMETER :: M4N3MBxi = 1812 + INTEGER(IntKi), PARAMETER :: M4N4MBxi = 1813 + INTEGER(IntKi), PARAMETER :: M4N5MBxi = 1814 + INTEGER(IntKi), PARAMETER :: M4N6MBxi = 1815 + INTEGER(IntKi), PARAMETER :: M4N7MBxi = 1816 + INTEGER(IntKi), PARAMETER :: M4N8MBxi = 1817 + INTEGER(IntKi), PARAMETER :: M4N9MBxi = 1818 + INTEGER(IntKi), PARAMETER :: M5N1MBxi = 1819 + INTEGER(IntKi), PARAMETER :: M5N2MBxi = 1820 + INTEGER(IntKi), PARAMETER :: M5N3MBxi = 1821 + INTEGER(IntKi), PARAMETER :: M5N4MBxi = 1822 + INTEGER(IntKi), PARAMETER :: M5N5MBxi = 1823 + INTEGER(IntKi), PARAMETER :: M5N6MBxi = 1824 + INTEGER(IntKi), PARAMETER :: M5N7MBxi = 1825 + INTEGER(IntKi), PARAMETER :: M5N8MBxi = 1826 + INTEGER(IntKi), PARAMETER :: M5N9MBxi = 1827 + INTEGER(IntKi), PARAMETER :: M6N1MBxi = 1828 + INTEGER(IntKi), PARAMETER :: M6N2MBxi = 1829 + INTEGER(IntKi), PARAMETER :: M6N3MBxi = 1830 + INTEGER(IntKi), PARAMETER :: M6N4MBxi = 1831 + INTEGER(IntKi), PARAMETER :: M6N5MBxi = 1832 + INTEGER(IntKi), PARAMETER :: M6N6MBxi = 1833 + INTEGER(IntKi), PARAMETER :: M6N7MBxi = 1834 + INTEGER(IntKi), PARAMETER :: M6N8MBxi = 1835 + INTEGER(IntKi), PARAMETER :: M6N9MBxi = 1836 + INTEGER(IntKi), PARAMETER :: M7N1MBxi = 1837 + INTEGER(IntKi), PARAMETER :: M7N2MBxi = 1838 + INTEGER(IntKi), PARAMETER :: M7N3MBxi = 1839 + INTEGER(IntKi), PARAMETER :: M7N4MBxi = 1840 + INTEGER(IntKi), PARAMETER :: M7N5MBxi = 1841 + INTEGER(IntKi), PARAMETER :: M7N6MBxi = 1842 + INTEGER(IntKi), PARAMETER :: M7N7MBxi = 1843 + INTEGER(IntKi), PARAMETER :: M7N8MBxi = 1844 + INTEGER(IntKi), PARAMETER :: M7N9MBxi = 1845 + INTEGER(IntKi), PARAMETER :: M8N1MBxi = 1846 + INTEGER(IntKi), PARAMETER :: M8N2MBxi = 1847 + INTEGER(IntKi), PARAMETER :: M8N3MBxi = 1848 + INTEGER(IntKi), PARAMETER :: M8N4MBxi = 1849 + INTEGER(IntKi), PARAMETER :: M8N5MBxi = 1850 + INTEGER(IntKi), PARAMETER :: M8N6MBxi = 1851 + INTEGER(IntKi), PARAMETER :: M8N7MBxi = 1852 + INTEGER(IntKi), PARAMETER :: M8N8MBxi = 1853 + INTEGER(IntKi), PARAMETER :: M8N9MBxi = 1854 + INTEGER(IntKi), PARAMETER :: M9N1MBxi = 1855 + INTEGER(IntKi), PARAMETER :: M9N2MBxi = 1856 + INTEGER(IntKi), PARAMETER :: M9N3MBxi = 1857 + INTEGER(IntKi), PARAMETER :: M9N4MBxi = 1858 + INTEGER(IntKi), PARAMETER :: M9N5MBxi = 1859 + INTEGER(IntKi), PARAMETER :: M9N6MBxi = 1860 + INTEGER(IntKi), PARAMETER :: M9N7MBxi = 1861 + INTEGER(IntKi), PARAMETER :: M9N8MBxi = 1862 + INTEGER(IntKi), PARAMETER :: M9N9MBxi = 1863 + INTEGER(IntKi), PARAMETER :: M1N1MByi = 1864 + INTEGER(IntKi), PARAMETER :: M1N2MByi = 1865 + INTEGER(IntKi), PARAMETER :: M1N3MByi = 1866 + INTEGER(IntKi), PARAMETER :: M1N4MByi = 1867 + INTEGER(IntKi), PARAMETER :: M1N5MByi = 1868 + INTEGER(IntKi), PARAMETER :: M1N6MByi = 1869 + INTEGER(IntKi), PARAMETER :: M1N7MByi = 1870 + INTEGER(IntKi), PARAMETER :: M1N8MByi = 1871 + INTEGER(IntKi), PARAMETER :: M1N9MByi = 1872 + INTEGER(IntKi), PARAMETER :: M2N1MByi = 1873 + INTEGER(IntKi), PARAMETER :: M2N2MByi = 1874 + INTEGER(IntKi), PARAMETER :: M2N3MByi = 1875 + INTEGER(IntKi), PARAMETER :: M2N4MByi = 1876 + INTEGER(IntKi), PARAMETER :: M2N5MByi = 1877 + INTEGER(IntKi), PARAMETER :: M2N6MByi = 1878 + INTEGER(IntKi), PARAMETER :: M2N7MByi = 1879 + INTEGER(IntKi), PARAMETER :: M2N8MByi = 1880 + INTEGER(IntKi), PARAMETER :: M2N9MByi = 1881 + INTEGER(IntKi), PARAMETER :: M3N1MByi = 1882 + INTEGER(IntKi), PARAMETER :: M3N2MByi = 1883 + INTEGER(IntKi), PARAMETER :: M3N3MByi = 1884 + INTEGER(IntKi), PARAMETER :: M3N4MByi = 1885 + INTEGER(IntKi), PARAMETER :: M3N5MByi = 1886 + INTEGER(IntKi), PARAMETER :: M3N6MByi = 1887 + INTEGER(IntKi), PARAMETER :: M3N7MByi = 1888 + INTEGER(IntKi), PARAMETER :: M3N8MByi = 1889 + INTEGER(IntKi), PARAMETER :: M3N9MByi = 1890 + INTEGER(IntKi), PARAMETER :: M4N1MByi = 1891 + INTEGER(IntKi), PARAMETER :: M4N2MByi = 1892 + INTEGER(IntKi), PARAMETER :: M4N3MByi = 1893 + INTEGER(IntKi), PARAMETER :: M4N4MByi = 1894 + INTEGER(IntKi), PARAMETER :: M4N5MByi = 1895 + INTEGER(IntKi), PARAMETER :: M4N6MByi = 1896 + INTEGER(IntKi), PARAMETER :: M4N7MByi = 1897 + INTEGER(IntKi), PARAMETER :: M4N8MByi = 1898 + INTEGER(IntKi), PARAMETER :: M4N9MByi = 1899 + INTEGER(IntKi), PARAMETER :: M5N1MByi = 1900 + INTEGER(IntKi), PARAMETER :: M5N2MByi = 1901 + INTEGER(IntKi), PARAMETER :: M5N3MByi = 1902 + INTEGER(IntKi), PARAMETER :: M5N4MByi = 1903 + INTEGER(IntKi), PARAMETER :: M5N5MByi = 1904 + INTEGER(IntKi), PARAMETER :: M5N6MByi = 1905 + INTEGER(IntKi), PARAMETER :: M5N7MByi = 1906 + INTEGER(IntKi), PARAMETER :: M5N8MByi = 1907 + INTEGER(IntKi), PARAMETER :: M5N9MByi = 1908 + INTEGER(IntKi), PARAMETER :: M6N1MByi = 1909 + INTEGER(IntKi), PARAMETER :: M6N2MByi = 1910 + INTEGER(IntKi), PARAMETER :: M6N3MByi = 1911 + INTEGER(IntKi), PARAMETER :: M6N4MByi = 1912 + INTEGER(IntKi), PARAMETER :: M6N5MByi = 1913 + INTEGER(IntKi), PARAMETER :: M6N6MByi = 1914 + INTEGER(IntKi), PARAMETER :: M6N7MByi = 1915 + INTEGER(IntKi), PARAMETER :: M6N8MByi = 1916 + INTEGER(IntKi), PARAMETER :: M6N9MByi = 1917 + INTEGER(IntKi), PARAMETER :: M7N1MByi = 1918 + INTEGER(IntKi), PARAMETER :: M7N2MByi = 1919 + INTEGER(IntKi), PARAMETER :: M7N3MByi = 1920 + INTEGER(IntKi), PARAMETER :: M7N4MByi = 1921 + INTEGER(IntKi), PARAMETER :: M7N5MByi = 1922 + INTEGER(IntKi), PARAMETER :: M7N6MByi = 1923 + INTEGER(IntKi), PARAMETER :: M7N7MByi = 1924 + INTEGER(IntKi), PARAMETER :: M7N8MByi = 1925 + INTEGER(IntKi), PARAMETER :: M7N9MByi = 1926 + INTEGER(IntKi), PARAMETER :: M8N1MByi = 1927 + INTEGER(IntKi), PARAMETER :: M8N2MByi = 1928 + INTEGER(IntKi), PARAMETER :: M8N3MByi = 1929 + INTEGER(IntKi), PARAMETER :: M8N4MByi = 1930 + INTEGER(IntKi), PARAMETER :: M8N5MByi = 1931 + INTEGER(IntKi), PARAMETER :: M8N6MByi = 1932 + INTEGER(IntKi), PARAMETER :: M8N7MByi = 1933 + INTEGER(IntKi), PARAMETER :: M8N8MByi = 1934 + INTEGER(IntKi), PARAMETER :: M8N9MByi = 1935 + INTEGER(IntKi), PARAMETER :: M9N1MByi = 1936 + INTEGER(IntKi), PARAMETER :: M9N2MByi = 1937 + INTEGER(IntKi), PARAMETER :: M9N3MByi = 1938 + INTEGER(IntKi), PARAMETER :: M9N4MByi = 1939 + INTEGER(IntKi), PARAMETER :: M9N5MByi = 1940 + INTEGER(IntKi), PARAMETER :: M9N6MByi = 1941 + INTEGER(IntKi), PARAMETER :: M9N7MByi = 1942 + INTEGER(IntKi), PARAMETER :: M9N8MByi = 1943 + INTEGER(IntKi), PARAMETER :: M9N9MByi = 1944 + INTEGER(IntKi), PARAMETER :: M1N1MBzi = 1945 + INTEGER(IntKi), PARAMETER :: M1N2MBzi = 1946 + INTEGER(IntKi), PARAMETER :: M1N3MBzi = 1947 + INTEGER(IntKi), PARAMETER :: M1N4MBzi = 1948 + INTEGER(IntKi), PARAMETER :: M1N5MBzi = 1949 + INTEGER(IntKi), PARAMETER :: M1N6MBzi = 1950 + INTEGER(IntKi), PARAMETER :: M1N7MBzi = 1951 + INTEGER(IntKi), PARAMETER :: M1N8MBzi = 1952 + INTEGER(IntKi), PARAMETER :: M1N9MBzi = 1953 + INTEGER(IntKi), PARAMETER :: M2N1MBzi = 1954 + INTEGER(IntKi), PARAMETER :: M2N2MBzi = 1955 + INTEGER(IntKi), PARAMETER :: M2N3MBzi = 1956 + INTEGER(IntKi), PARAMETER :: M2N4MBzi = 1957 + INTEGER(IntKi), PARAMETER :: M2N5MBzi = 1958 + INTEGER(IntKi), PARAMETER :: M2N6MBzi = 1959 + INTEGER(IntKi), PARAMETER :: M2N7MBzi = 1960 + INTEGER(IntKi), PARAMETER :: M2N8MBzi = 1961 + INTEGER(IntKi), PARAMETER :: M2N9MBzi = 1962 + INTEGER(IntKi), PARAMETER :: M3N1MBzi = 1963 + INTEGER(IntKi), PARAMETER :: M3N2MBzi = 1964 + INTEGER(IntKi), PARAMETER :: M3N3MBzi = 1965 + INTEGER(IntKi), PARAMETER :: M3N4MBzi = 1966 + INTEGER(IntKi), PARAMETER :: M3N5MBzi = 1967 + INTEGER(IntKi), PARAMETER :: M3N6MBzi = 1968 + INTEGER(IntKi), PARAMETER :: M3N7MBzi = 1969 + INTEGER(IntKi), PARAMETER :: M3N8MBzi = 1970 + INTEGER(IntKi), PARAMETER :: M3N9MBzi = 1971 + INTEGER(IntKi), PARAMETER :: M4N1MBzi = 1972 + INTEGER(IntKi), PARAMETER :: M4N2MBzi = 1973 + INTEGER(IntKi), PARAMETER :: M4N3MBzi = 1974 + INTEGER(IntKi), PARAMETER :: M4N4MBzi = 1975 + INTEGER(IntKi), PARAMETER :: M4N5MBzi = 1976 + INTEGER(IntKi), PARAMETER :: M4N6MBzi = 1977 + INTEGER(IntKi), PARAMETER :: M4N7MBzi = 1978 + INTEGER(IntKi), PARAMETER :: M4N8MBzi = 1979 + INTEGER(IntKi), PARAMETER :: M4N9MBzi = 1980 + INTEGER(IntKi), PARAMETER :: M5N1MBzi = 1981 + INTEGER(IntKi), PARAMETER :: M5N2MBzi = 1982 + INTEGER(IntKi), PARAMETER :: M5N3MBzi = 1983 + INTEGER(IntKi), PARAMETER :: M5N4MBzi = 1984 + INTEGER(IntKi), PARAMETER :: M5N5MBzi = 1985 + INTEGER(IntKi), PARAMETER :: M5N6MBzi = 1986 + INTEGER(IntKi), PARAMETER :: M5N7MBzi = 1987 + INTEGER(IntKi), PARAMETER :: M5N8MBzi = 1988 + INTEGER(IntKi), PARAMETER :: M5N9MBzi = 1989 + INTEGER(IntKi), PARAMETER :: M6N1MBzi = 1990 + INTEGER(IntKi), PARAMETER :: M6N2MBzi = 1991 + INTEGER(IntKi), PARAMETER :: M6N3MBzi = 1992 + INTEGER(IntKi), PARAMETER :: M6N4MBzi = 1993 + INTEGER(IntKi), PARAMETER :: M6N5MBzi = 1994 + INTEGER(IntKi), PARAMETER :: M6N6MBzi = 1995 + INTEGER(IntKi), PARAMETER :: M6N7MBzi = 1996 + INTEGER(IntKi), PARAMETER :: M6N8MBzi = 1997 + INTEGER(IntKi), PARAMETER :: M6N9MBzi = 1998 + INTEGER(IntKi), PARAMETER :: M7N1MBzi = 1999 + INTEGER(IntKi), PARAMETER :: M7N2MBzi = 2000 + INTEGER(IntKi), PARAMETER :: M7N3MBzi = 2001 + INTEGER(IntKi), PARAMETER :: M7N4MBzi = 2002 + INTEGER(IntKi), PARAMETER :: M7N5MBzi = 2003 + INTEGER(IntKi), PARAMETER :: M7N6MBzi = 2004 + INTEGER(IntKi), PARAMETER :: M7N7MBzi = 2005 + INTEGER(IntKi), PARAMETER :: M7N8MBzi = 2006 + INTEGER(IntKi), PARAMETER :: M7N9MBzi = 2007 + INTEGER(IntKi), PARAMETER :: M8N1MBzi = 2008 + INTEGER(IntKi), PARAMETER :: M8N2MBzi = 2009 + INTEGER(IntKi), PARAMETER :: M8N3MBzi = 2010 + INTEGER(IntKi), PARAMETER :: M8N4MBzi = 2011 + INTEGER(IntKi), PARAMETER :: M8N5MBzi = 2012 + INTEGER(IntKi), PARAMETER :: M8N6MBzi = 2013 + INTEGER(IntKi), PARAMETER :: M8N7MBzi = 2014 + INTEGER(IntKi), PARAMETER :: M8N8MBzi = 2015 + INTEGER(IntKi), PARAMETER :: M8N9MBzi = 2016 + INTEGER(IntKi), PARAMETER :: M9N1MBzi = 2017 + INTEGER(IntKi), PARAMETER :: M9N2MBzi = 2018 + INTEGER(IntKi), PARAMETER :: M9N3MBzi = 2019 + INTEGER(IntKi), PARAMETER :: M9N4MBzi = 2020 + INTEGER(IntKi), PARAMETER :: M9N5MBzi = 2021 + INTEGER(IntKi), PARAMETER :: M9N6MBzi = 2022 + INTEGER(IntKi), PARAMETER :: M9N7MBzi = 2023 + INTEGER(IntKi), PARAMETER :: M9N8MBzi = 2024 + INTEGER(IntKi), PARAMETER :: M9N9MBzi = 2025 + INTEGER(IntKi), PARAMETER :: M1N1FBFxi = 2026 + INTEGER(IntKi), PARAMETER :: M1N2FBFxi = 2027 + INTEGER(IntKi), PARAMETER :: M1N3FBFxi = 2028 + INTEGER(IntKi), PARAMETER :: M1N4FBFxi = 2029 + INTEGER(IntKi), PARAMETER :: M1N5FBFxi = 2030 + INTEGER(IntKi), PARAMETER :: M1N6FBFxi = 2031 + INTEGER(IntKi), PARAMETER :: M1N7FBFxi = 2032 + INTEGER(IntKi), PARAMETER :: M1N8FBFxi = 2033 + INTEGER(IntKi), PARAMETER :: M1N9FBFxi = 2034 + INTEGER(IntKi), PARAMETER :: M2N1FBFxi = 2035 + INTEGER(IntKi), PARAMETER :: M2N2FBFxi = 2036 + INTEGER(IntKi), PARAMETER :: M2N3FBFxi = 2037 + INTEGER(IntKi), PARAMETER :: M2N4FBFxi = 2038 + INTEGER(IntKi), PARAMETER :: M2N5FBFxi = 2039 + INTEGER(IntKi), PARAMETER :: M2N6FBFxi = 2040 + INTEGER(IntKi), PARAMETER :: M2N7FBFxi = 2041 + INTEGER(IntKi), PARAMETER :: M2N8FBFxi = 2042 + INTEGER(IntKi), PARAMETER :: M2N9FBFxi = 2043 + INTEGER(IntKi), PARAMETER :: M3N1FBFxi = 2044 + INTEGER(IntKi), PARAMETER :: M3N2FBFxi = 2045 + INTEGER(IntKi), PARAMETER :: M3N3FBFxi = 2046 + INTEGER(IntKi), PARAMETER :: M3N4FBFxi = 2047 + INTEGER(IntKi), PARAMETER :: M3N5FBFxi = 2048 + INTEGER(IntKi), PARAMETER :: M3N6FBFxi = 2049 + INTEGER(IntKi), PARAMETER :: M3N7FBFxi = 2050 + INTEGER(IntKi), PARAMETER :: M3N8FBFxi = 2051 + INTEGER(IntKi), PARAMETER :: M3N9FBFxi = 2052 + INTEGER(IntKi), PARAMETER :: M4N1FBFxi = 2053 + INTEGER(IntKi), PARAMETER :: M4N2FBFxi = 2054 + INTEGER(IntKi), PARAMETER :: M4N3FBFxi = 2055 + INTEGER(IntKi), PARAMETER :: M4N4FBFxi = 2056 + INTEGER(IntKi), PARAMETER :: M4N5FBFxi = 2057 + INTEGER(IntKi), PARAMETER :: M4N6FBFxi = 2058 + INTEGER(IntKi), PARAMETER :: M4N7FBFxi = 2059 + INTEGER(IntKi), PARAMETER :: M4N8FBFxi = 2060 + INTEGER(IntKi), PARAMETER :: M4N9FBFxi = 2061 + INTEGER(IntKi), PARAMETER :: M5N1FBFxi = 2062 + INTEGER(IntKi), PARAMETER :: M5N2FBFxi = 2063 + INTEGER(IntKi), PARAMETER :: M5N3FBFxi = 2064 + INTEGER(IntKi), PARAMETER :: M5N4FBFxi = 2065 + INTEGER(IntKi), PARAMETER :: M5N5FBFxi = 2066 + INTEGER(IntKi), PARAMETER :: M5N6FBFxi = 2067 + INTEGER(IntKi), PARAMETER :: M5N7FBFxi = 2068 + INTEGER(IntKi), PARAMETER :: M5N8FBFxi = 2069 + INTEGER(IntKi), PARAMETER :: M5N9FBFxi = 2070 + INTEGER(IntKi), PARAMETER :: M6N1FBFxi = 2071 + INTEGER(IntKi), PARAMETER :: M6N2FBFxi = 2072 + INTEGER(IntKi), PARAMETER :: M6N3FBFxi = 2073 + INTEGER(IntKi), PARAMETER :: M6N4FBFxi = 2074 + INTEGER(IntKi), PARAMETER :: M6N5FBFxi = 2075 + INTEGER(IntKi), PARAMETER :: M6N6FBFxi = 2076 + INTEGER(IntKi), PARAMETER :: M6N7FBFxi = 2077 + INTEGER(IntKi), PARAMETER :: M6N8FBFxi = 2078 + INTEGER(IntKi), PARAMETER :: M6N9FBFxi = 2079 + INTEGER(IntKi), PARAMETER :: M7N1FBFxi = 2080 + INTEGER(IntKi), PARAMETER :: M7N2FBFxi = 2081 + INTEGER(IntKi), PARAMETER :: M7N3FBFxi = 2082 + INTEGER(IntKi), PARAMETER :: M7N4FBFxi = 2083 + INTEGER(IntKi), PARAMETER :: M7N5FBFxi = 2084 + INTEGER(IntKi), PARAMETER :: M7N6FBFxi = 2085 + INTEGER(IntKi), PARAMETER :: M7N7FBFxi = 2086 + INTEGER(IntKi), PARAMETER :: M7N8FBFxi = 2087 + INTEGER(IntKi), PARAMETER :: M7N9FBFxi = 2088 + INTEGER(IntKi), PARAMETER :: M8N1FBFxi = 2089 + INTEGER(IntKi), PARAMETER :: M8N2FBFxi = 2090 + INTEGER(IntKi), PARAMETER :: M8N3FBFxi = 2091 + INTEGER(IntKi), PARAMETER :: M8N4FBFxi = 2092 + INTEGER(IntKi), PARAMETER :: M8N5FBFxi = 2093 + INTEGER(IntKi), PARAMETER :: M8N6FBFxi = 2094 + INTEGER(IntKi), PARAMETER :: M8N7FBFxi = 2095 + INTEGER(IntKi), PARAMETER :: M8N8FBFxi = 2096 + INTEGER(IntKi), PARAMETER :: M8N9FBFxi = 2097 + INTEGER(IntKi), PARAMETER :: M9N1FBFxi = 2098 + INTEGER(IntKi), PARAMETER :: M9N2FBFxi = 2099 + INTEGER(IntKi), PARAMETER :: M9N3FBFxi = 2100 + INTEGER(IntKi), PARAMETER :: M9N4FBFxi = 2101 + INTEGER(IntKi), PARAMETER :: M9N5FBFxi = 2102 + INTEGER(IntKi), PARAMETER :: M9N6FBFxi = 2103 + INTEGER(IntKi), PARAMETER :: M9N7FBFxi = 2104 + INTEGER(IntKi), PARAMETER :: M9N8FBFxi = 2105 + INTEGER(IntKi), PARAMETER :: M9N9FBFxi = 2106 + INTEGER(IntKi), PARAMETER :: M1N1FBFyi = 2107 + INTEGER(IntKi), PARAMETER :: M1N2FBFyi = 2108 + INTEGER(IntKi), PARAMETER :: M1N3FBFyi = 2109 + INTEGER(IntKi), PARAMETER :: M1N4FBFyi = 2110 + INTEGER(IntKi), PARAMETER :: M1N5FBFyi = 2111 + INTEGER(IntKi), PARAMETER :: M1N6FBFyi = 2112 + INTEGER(IntKi), PARAMETER :: M1N7FBFyi = 2113 + INTEGER(IntKi), PARAMETER :: M1N8FBFyi = 2114 + INTEGER(IntKi), PARAMETER :: M1N9FBFyi = 2115 + INTEGER(IntKi), PARAMETER :: M2N1FBFyi = 2116 + INTEGER(IntKi), PARAMETER :: M2N2FBFyi = 2117 + INTEGER(IntKi), PARAMETER :: M2N3FBFyi = 2118 + INTEGER(IntKi), PARAMETER :: M2N4FBFyi = 2119 + INTEGER(IntKi), PARAMETER :: M2N5FBFyi = 2120 + INTEGER(IntKi), PARAMETER :: M2N6FBFyi = 2121 + INTEGER(IntKi), PARAMETER :: M2N7FBFyi = 2122 + INTEGER(IntKi), PARAMETER :: M2N8FBFyi = 2123 + INTEGER(IntKi), PARAMETER :: M2N9FBFyi = 2124 + INTEGER(IntKi), PARAMETER :: M3N1FBFyi = 2125 + INTEGER(IntKi), PARAMETER :: M3N2FBFyi = 2126 + INTEGER(IntKi), PARAMETER :: M3N3FBFyi = 2127 + INTEGER(IntKi), PARAMETER :: M3N4FBFyi = 2128 + INTEGER(IntKi), PARAMETER :: M3N5FBFyi = 2129 + INTEGER(IntKi), PARAMETER :: M3N6FBFyi = 2130 + INTEGER(IntKi), PARAMETER :: M3N7FBFyi = 2131 + INTEGER(IntKi), PARAMETER :: M3N8FBFyi = 2132 + INTEGER(IntKi), PARAMETER :: M3N9FBFyi = 2133 + INTEGER(IntKi), PARAMETER :: M4N1FBFyi = 2134 + INTEGER(IntKi), PARAMETER :: M4N2FBFyi = 2135 + INTEGER(IntKi), PARAMETER :: M4N3FBFyi = 2136 + INTEGER(IntKi), PARAMETER :: M4N4FBFyi = 2137 + INTEGER(IntKi), PARAMETER :: M4N5FBFyi = 2138 + INTEGER(IntKi), PARAMETER :: M4N6FBFyi = 2139 + INTEGER(IntKi), PARAMETER :: M4N7FBFyi = 2140 + INTEGER(IntKi), PARAMETER :: M4N8FBFyi = 2141 + INTEGER(IntKi), PARAMETER :: M4N9FBFyi = 2142 + INTEGER(IntKi), PARAMETER :: M5N1FBFyi = 2143 + INTEGER(IntKi), PARAMETER :: M5N2FBFyi = 2144 + INTEGER(IntKi), PARAMETER :: M5N3FBFyi = 2145 + INTEGER(IntKi), PARAMETER :: M5N4FBFyi = 2146 + INTEGER(IntKi), PARAMETER :: M5N5FBFyi = 2147 + INTEGER(IntKi), PARAMETER :: M5N6FBFyi = 2148 + INTEGER(IntKi), PARAMETER :: M5N7FBFyi = 2149 + INTEGER(IntKi), PARAMETER :: M5N8FBFyi = 2150 + INTEGER(IntKi), PARAMETER :: M5N9FBFyi = 2151 + INTEGER(IntKi), PARAMETER :: M6N1FBFyi = 2152 + INTEGER(IntKi), PARAMETER :: M6N2FBFyi = 2153 + INTEGER(IntKi), PARAMETER :: M6N3FBFyi = 2154 + INTEGER(IntKi), PARAMETER :: M6N4FBFyi = 2155 + INTEGER(IntKi), PARAMETER :: M6N5FBFyi = 2156 + INTEGER(IntKi), PARAMETER :: M6N6FBFyi = 2157 + INTEGER(IntKi), PARAMETER :: M6N7FBFyi = 2158 + INTEGER(IntKi), PARAMETER :: M6N8FBFyi = 2159 + INTEGER(IntKi), PARAMETER :: M6N9FBFyi = 2160 + INTEGER(IntKi), PARAMETER :: M7N1FBFyi = 2161 + INTEGER(IntKi), PARAMETER :: M7N2FBFyi = 2162 + INTEGER(IntKi), PARAMETER :: M7N3FBFyi = 2163 + INTEGER(IntKi), PARAMETER :: M7N4FBFyi = 2164 + INTEGER(IntKi), PARAMETER :: M7N5FBFyi = 2165 + INTEGER(IntKi), PARAMETER :: M7N6FBFyi = 2166 + INTEGER(IntKi), PARAMETER :: M7N7FBFyi = 2167 + INTEGER(IntKi), PARAMETER :: M7N8FBFyi = 2168 + INTEGER(IntKi), PARAMETER :: M7N9FBFyi = 2169 + INTEGER(IntKi), PARAMETER :: M8N1FBFyi = 2170 + INTEGER(IntKi), PARAMETER :: M8N2FBFyi = 2171 + INTEGER(IntKi), PARAMETER :: M8N3FBFyi = 2172 + INTEGER(IntKi), PARAMETER :: M8N4FBFyi = 2173 + INTEGER(IntKi), PARAMETER :: M8N5FBFyi = 2174 + INTEGER(IntKi), PARAMETER :: M8N6FBFyi = 2175 + INTEGER(IntKi), PARAMETER :: M8N7FBFyi = 2176 + INTEGER(IntKi), PARAMETER :: M8N8FBFyi = 2177 + INTEGER(IntKi), PARAMETER :: M8N9FBFyi = 2178 + INTEGER(IntKi), PARAMETER :: M9N1FBFyi = 2179 + INTEGER(IntKi), PARAMETER :: M9N2FBFyi = 2180 + INTEGER(IntKi), PARAMETER :: M9N3FBFyi = 2181 + INTEGER(IntKi), PARAMETER :: M9N4FBFyi = 2182 + INTEGER(IntKi), PARAMETER :: M9N5FBFyi = 2183 + INTEGER(IntKi), PARAMETER :: M9N6FBFyi = 2184 + INTEGER(IntKi), PARAMETER :: M9N7FBFyi = 2185 + INTEGER(IntKi), PARAMETER :: M9N8FBFyi = 2186 + INTEGER(IntKi), PARAMETER :: M9N9FBFyi = 2187 + INTEGER(IntKi), PARAMETER :: M1N1FBFzi = 2188 + INTEGER(IntKi), PARAMETER :: M1N2FBFzi = 2189 + INTEGER(IntKi), PARAMETER :: M1N3FBFzi = 2190 + INTEGER(IntKi), PARAMETER :: M1N4FBFzi = 2191 + INTEGER(IntKi), PARAMETER :: M1N5FBFzi = 2192 + INTEGER(IntKi), PARAMETER :: M1N6FBFzi = 2193 + INTEGER(IntKi), PARAMETER :: M1N7FBFzi = 2194 + INTEGER(IntKi), PARAMETER :: M1N8FBFzi = 2195 + INTEGER(IntKi), PARAMETER :: M1N9FBFzi = 2196 + INTEGER(IntKi), PARAMETER :: M2N1FBFzi = 2197 + INTEGER(IntKi), PARAMETER :: M2N2FBFzi = 2198 + INTEGER(IntKi), PARAMETER :: M2N3FBFzi = 2199 + INTEGER(IntKi), PARAMETER :: M2N4FBFzi = 2200 + INTEGER(IntKi), PARAMETER :: M2N5FBFzi = 2201 + INTEGER(IntKi), PARAMETER :: M2N6FBFzi = 2202 + INTEGER(IntKi), PARAMETER :: M2N7FBFzi = 2203 + INTEGER(IntKi), PARAMETER :: M2N8FBFzi = 2204 + INTEGER(IntKi), PARAMETER :: M2N9FBFzi = 2205 + INTEGER(IntKi), PARAMETER :: M3N1FBFzi = 2206 + INTEGER(IntKi), PARAMETER :: M3N2FBFzi = 2207 + INTEGER(IntKi), PARAMETER :: M3N3FBFzi = 2208 + INTEGER(IntKi), PARAMETER :: M3N4FBFzi = 2209 + INTEGER(IntKi), PARAMETER :: M3N5FBFzi = 2210 + INTEGER(IntKi), PARAMETER :: M3N6FBFzi = 2211 + INTEGER(IntKi), PARAMETER :: M3N7FBFzi = 2212 + INTEGER(IntKi), PARAMETER :: M3N8FBFzi = 2213 + INTEGER(IntKi), PARAMETER :: M3N9FBFzi = 2214 + INTEGER(IntKi), PARAMETER :: M4N1FBFzi = 2215 + INTEGER(IntKi), PARAMETER :: M4N2FBFzi = 2216 + INTEGER(IntKi), PARAMETER :: M4N3FBFzi = 2217 + INTEGER(IntKi), PARAMETER :: M4N4FBFzi = 2218 + INTEGER(IntKi), PARAMETER :: M4N5FBFzi = 2219 + INTEGER(IntKi), PARAMETER :: M4N6FBFzi = 2220 + INTEGER(IntKi), PARAMETER :: M4N7FBFzi = 2221 + INTEGER(IntKi), PARAMETER :: M4N8FBFzi = 2222 + INTEGER(IntKi), PARAMETER :: M4N9FBFzi = 2223 + INTEGER(IntKi), PARAMETER :: M5N1FBFzi = 2224 + INTEGER(IntKi), PARAMETER :: M5N2FBFzi = 2225 + INTEGER(IntKi), PARAMETER :: M5N3FBFzi = 2226 + INTEGER(IntKi), PARAMETER :: M5N4FBFzi = 2227 + INTEGER(IntKi), PARAMETER :: M5N5FBFzi = 2228 + INTEGER(IntKi), PARAMETER :: M5N6FBFzi = 2229 + INTEGER(IntKi), PARAMETER :: M5N7FBFzi = 2230 + INTEGER(IntKi), PARAMETER :: M5N8FBFzi = 2231 + INTEGER(IntKi), PARAMETER :: M5N9FBFzi = 2232 + INTEGER(IntKi), PARAMETER :: M6N1FBFzi = 2233 + INTEGER(IntKi), PARAMETER :: M6N2FBFzi = 2234 + INTEGER(IntKi), PARAMETER :: M6N3FBFzi = 2235 + INTEGER(IntKi), PARAMETER :: M6N4FBFzi = 2236 + INTEGER(IntKi), PARAMETER :: M6N5FBFzi = 2237 + INTEGER(IntKi), PARAMETER :: M6N6FBFzi = 2238 + INTEGER(IntKi), PARAMETER :: M6N7FBFzi = 2239 + INTEGER(IntKi), PARAMETER :: M6N8FBFzi = 2240 + INTEGER(IntKi), PARAMETER :: M6N9FBFzi = 2241 + INTEGER(IntKi), PARAMETER :: M7N1FBFzi = 2242 + INTEGER(IntKi), PARAMETER :: M7N2FBFzi = 2243 + INTEGER(IntKi), PARAMETER :: M7N3FBFzi = 2244 + INTEGER(IntKi), PARAMETER :: M7N4FBFzi = 2245 + INTEGER(IntKi), PARAMETER :: M7N5FBFzi = 2246 + INTEGER(IntKi), PARAMETER :: M7N6FBFzi = 2247 + INTEGER(IntKi), PARAMETER :: M7N7FBFzi = 2248 + INTEGER(IntKi), PARAMETER :: M7N8FBFzi = 2249 + INTEGER(IntKi), PARAMETER :: M7N9FBFzi = 2250 + INTEGER(IntKi), PARAMETER :: M8N1FBFzi = 2251 + INTEGER(IntKi), PARAMETER :: M8N2FBFzi = 2252 + INTEGER(IntKi), PARAMETER :: M8N3FBFzi = 2253 + INTEGER(IntKi), PARAMETER :: M8N4FBFzi = 2254 + INTEGER(IntKi), PARAMETER :: M8N5FBFzi = 2255 + INTEGER(IntKi), PARAMETER :: M8N6FBFzi = 2256 + INTEGER(IntKi), PARAMETER :: M8N7FBFzi = 2257 + INTEGER(IntKi), PARAMETER :: M8N8FBFzi = 2258 + INTEGER(IntKi), PARAMETER :: M8N9FBFzi = 2259 + INTEGER(IntKi), PARAMETER :: M9N1FBFzi = 2260 + INTEGER(IntKi), PARAMETER :: M9N2FBFzi = 2261 + INTEGER(IntKi), PARAMETER :: M9N3FBFzi = 2262 + INTEGER(IntKi), PARAMETER :: M9N4FBFzi = 2263 + INTEGER(IntKi), PARAMETER :: M9N5FBFzi = 2264 + INTEGER(IntKi), PARAMETER :: M9N6FBFzi = 2265 + INTEGER(IntKi), PARAMETER :: M9N7FBFzi = 2266 + INTEGER(IntKi), PARAMETER :: M9N8FBFzi = 2267 + INTEGER(IntKi), PARAMETER :: M9N9FBFzi = 2268 + INTEGER(IntKi), PARAMETER :: M1N1MBFxi = 2269 + INTEGER(IntKi), PARAMETER :: M1N2MBFxi = 2270 + INTEGER(IntKi), PARAMETER :: M1N3MBFxi = 2271 + INTEGER(IntKi), PARAMETER :: M1N4MBFxi = 2272 + INTEGER(IntKi), PARAMETER :: M1N5MBFxi = 2273 + INTEGER(IntKi), PARAMETER :: M1N6MBFxi = 2274 + INTEGER(IntKi), PARAMETER :: M1N7MBFxi = 2275 + INTEGER(IntKi), PARAMETER :: M1N8MBFxi = 2276 + INTEGER(IntKi), PARAMETER :: M1N9MBFxi = 2277 + INTEGER(IntKi), PARAMETER :: M2N1MBFxi = 2278 + INTEGER(IntKi), PARAMETER :: M2N2MBFxi = 2279 + INTEGER(IntKi), PARAMETER :: M2N3MBFxi = 2280 + INTEGER(IntKi), PARAMETER :: M2N4MBFxi = 2281 + INTEGER(IntKi), PARAMETER :: M2N5MBFxi = 2282 + INTEGER(IntKi), PARAMETER :: M2N6MBFxi = 2283 + INTEGER(IntKi), PARAMETER :: M2N7MBFxi = 2284 + INTEGER(IntKi), PARAMETER :: M2N8MBFxi = 2285 + INTEGER(IntKi), PARAMETER :: M2N9MBFxi = 2286 + INTEGER(IntKi), PARAMETER :: M3N1MBFxi = 2287 + INTEGER(IntKi), PARAMETER :: M3N2MBFxi = 2288 + INTEGER(IntKi), PARAMETER :: M3N3MBFxi = 2289 + INTEGER(IntKi), PARAMETER :: M3N4MBFxi = 2290 + INTEGER(IntKi), PARAMETER :: M3N5MBFxi = 2291 + INTEGER(IntKi), PARAMETER :: M3N6MBFxi = 2292 + INTEGER(IntKi), PARAMETER :: M3N7MBFxi = 2293 + INTEGER(IntKi), PARAMETER :: M3N8MBFxi = 2294 + INTEGER(IntKi), PARAMETER :: M3N9MBFxi = 2295 + INTEGER(IntKi), PARAMETER :: M4N1MBFxi = 2296 + INTEGER(IntKi), PARAMETER :: M4N2MBFxi = 2297 + INTEGER(IntKi), PARAMETER :: M4N3MBFxi = 2298 + INTEGER(IntKi), PARAMETER :: M4N4MBFxi = 2299 + INTEGER(IntKi), PARAMETER :: M4N5MBFxi = 2300 + INTEGER(IntKi), PARAMETER :: M4N6MBFxi = 2301 + INTEGER(IntKi), PARAMETER :: M4N7MBFxi = 2302 + INTEGER(IntKi), PARAMETER :: M4N8MBFxi = 2303 + INTEGER(IntKi), PARAMETER :: M4N9MBFxi = 2304 + INTEGER(IntKi), PARAMETER :: M5N1MBFxi = 2305 + INTEGER(IntKi), PARAMETER :: M5N2MBFxi = 2306 + INTEGER(IntKi), PARAMETER :: M5N3MBFxi = 2307 + INTEGER(IntKi), PARAMETER :: M5N4MBFxi = 2308 + INTEGER(IntKi), PARAMETER :: M5N5MBFxi = 2309 + INTEGER(IntKi), PARAMETER :: M5N6MBFxi = 2310 + INTEGER(IntKi), PARAMETER :: M5N7MBFxi = 2311 + INTEGER(IntKi), PARAMETER :: M5N8MBFxi = 2312 + INTEGER(IntKi), PARAMETER :: M5N9MBFxi = 2313 + INTEGER(IntKi), PARAMETER :: M6N1MBFxi = 2314 + INTEGER(IntKi), PARAMETER :: M6N2MBFxi = 2315 + INTEGER(IntKi), PARAMETER :: M6N3MBFxi = 2316 + INTEGER(IntKi), PARAMETER :: M6N4MBFxi = 2317 + INTEGER(IntKi), PARAMETER :: M6N5MBFxi = 2318 + INTEGER(IntKi), PARAMETER :: M6N6MBFxi = 2319 + INTEGER(IntKi), PARAMETER :: M6N7MBFxi = 2320 + INTEGER(IntKi), PARAMETER :: M6N8MBFxi = 2321 + INTEGER(IntKi), PARAMETER :: M6N9MBFxi = 2322 + INTEGER(IntKi), PARAMETER :: M7N1MBFxi = 2323 + INTEGER(IntKi), PARAMETER :: M7N2MBFxi = 2324 + INTEGER(IntKi), PARAMETER :: M7N3MBFxi = 2325 + INTEGER(IntKi), PARAMETER :: M7N4MBFxi = 2326 + INTEGER(IntKi), PARAMETER :: M7N5MBFxi = 2327 + INTEGER(IntKi), PARAMETER :: M7N6MBFxi = 2328 + INTEGER(IntKi), PARAMETER :: M7N7MBFxi = 2329 + INTEGER(IntKi), PARAMETER :: M7N8MBFxi = 2330 + INTEGER(IntKi), PARAMETER :: M7N9MBFxi = 2331 + INTEGER(IntKi), PARAMETER :: M8N1MBFxi = 2332 + INTEGER(IntKi), PARAMETER :: M8N2MBFxi = 2333 + INTEGER(IntKi), PARAMETER :: M8N3MBFxi = 2334 + INTEGER(IntKi), PARAMETER :: M8N4MBFxi = 2335 + INTEGER(IntKi), PARAMETER :: M8N5MBFxi = 2336 + INTEGER(IntKi), PARAMETER :: M8N6MBFxi = 2337 + INTEGER(IntKi), PARAMETER :: M8N7MBFxi = 2338 + INTEGER(IntKi), PARAMETER :: M8N8MBFxi = 2339 + INTEGER(IntKi), PARAMETER :: M8N9MBFxi = 2340 + INTEGER(IntKi), PARAMETER :: M9N1MBFxi = 2341 + INTEGER(IntKi), PARAMETER :: M9N2MBFxi = 2342 + INTEGER(IntKi), PARAMETER :: M9N3MBFxi = 2343 + INTEGER(IntKi), PARAMETER :: M9N4MBFxi = 2344 + INTEGER(IntKi), PARAMETER :: M9N5MBFxi = 2345 + INTEGER(IntKi), PARAMETER :: M9N6MBFxi = 2346 + INTEGER(IntKi), PARAMETER :: M9N7MBFxi = 2347 + INTEGER(IntKi), PARAMETER :: M9N8MBFxi = 2348 + INTEGER(IntKi), PARAMETER :: M9N9MBFxi = 2349 + INTEGER(IntKi), PARAMETER :: M1N1MBFyi = 2350 + INTEGER(IntKi), PARAMETER :: M1N2MBFyi = 2351 + INTEGER(IntKi), PARAMETER :: M1N3MBFyi = 2352 + INTEGER(IntKi), PARAMETER :: M1N4MBFyi = 2353 + INTEGER(IntKi), PARAMETER :: M1N5MBFyi = 2354 + INTEGER(IntKi), PARAMETER :: M1N6MBFyi = 2355 + INTEGER(IntKi), PARAMETER :: M1N7MBFyi = 2356 + INTEGER(IntKi), PARAMETER :: M1N8MBFyi = 2357 + INTEGER(IntKi), PARAMETER :: M1N9MBFyi = 2358 + INTEGER(IntKi), PARAMETER :: M2N1MBFyi = 2359 + INTEGER(IntKi), PARAMETER :: M2N2MBFyi = 2360 + INTEGER(IntKi), PARAMETER :: M2N3MBFyi = 2361 + INTEGER(IntKi), PARAMETER :: M2N4MBFyi = 2362 + INTEGER(IntKi), PARAMETER :: M2N5MBFyi = 2363 + INTEGER(IntKi), PARAMETER :: M2N6MBFyi = 2364 + INTEGER(IntKi), PARAMETER :: M2N7MBFyi = 2365 + INTEGER(IntKi), PARAMETER :: M2N8MBFyi = 2366 + INTEGER(IntKi), PARAMETER :: M2N9MBFyi = 2367 + INTEGER(IntKi), PARAMETER :: M3N1MBFyi = 2368 + INTEGER(IntKi), PARAMETER :: M3N2MBFyi = 2369 + INTEGER(IntKi), PARAMETER :: M3N3MBFyi = 2370 + INTEGER(IntKi), PARAMETER :: M3N4MBFyi = 2371 + INTEGER(IntKi), PARAMETER :: M3N5MBFyi = 2372 + INTEGER(IntKi), PARAMETER :: M3N6MBFyi = 2373 + INTEGER(IntKi), PARAMETER :: M3N7MBFyi = 2374 + INTEGER(IntKi), PARAMETER :: M3N8MBFyi = 2375 + INTEGER(IntKi), PARAMETER :: M3N9MBFyi = 2376 + INTEGER(IntKi), PARAMETER :: M4N1MBFyi = 2377 + INTEGER(IntKi), PARAMETER :: M4N2MBFyi = 2378 + INTEGER(IntKi), PARAMETER :: M4N3MBFyi = 2379 + INTEGER(IntKi), PARAMETER :: M4N4MBFyi = 2380 + INTEGER(IntKi), PARAMETER :: M4N5MBFyi = 2381 + INTEGER(IntKi), PARAMETER :: M4N6MBFyi = 2382 + INTEGER(IntKi), PARAMETER :: M4N7MBFyi = 2383 + INTEGER(IntKi), PARAMETER :: M4N8MBFyi = 2384 + INTEGER(IntKi), PARAMETER :: M4N9MBFyi = 2385 + INTEGER(IntKi), PARAMETER :: M5N1MBFyi = 2386 + INTEGER(IntKi), PARAMETER :: M5N2MBFyi = 2387 + INTEGER(IntKi), PARAMETER :: M5N3MBFyi = 2388 + INTEGER(IntKi), PARAMETER :: M5N4MBFyi = 2389 + INTEGER(IntKi), PARAMETER :: M5N5MBFyi = 2390 + INTEGER(IntKi), PARAMETER :: M5N6MBFyi = 2391 + INTEGER(IntKi), PARAMETER :: M5N7MBFyi = 2392 + INTEGER(IntKi), PARAMETER :: M5N8MBFyi = 2393 + INTEGER(IntKi), PARAMETER :: M5N9MBFyi = 2394 + INTEGER(IntKi), PARAMETER :: M6N1MBFyi = 2395 + INTEGER(IntKi), PARAMETER :: M6N2MBFyi = 2396 + INTEGER(IntKi), PARAMETER :: M6N3MBFyi = 2397 + INTEGER(IntKi), PARAMETER :: M6N4MBFyi = 2398 + INTEGER(IntKi), PARAMETER :: M6N5MBFyi = 2399 + INTEGER(IntKi), PARAMETER :: M6N6MBFyi = 2400 + INTEGER(IntKi), PARAMETER :: M6N7MBFyi = 2401 + INTEGER(IntKi), PARAMETER :: M6N8MBFyi = 2402 + INTEGER(IntKi), PARAMETER :: M6N9MBFyi = 2403 + INTEGER(IntKi), PARAMETER :: M7N1MBFyi = 2404 + INTEGER(IntKi), PARAMETER :: M7N2MBFyi = 2405 + INTEGER(IntKi), PARAMETER :: M7N3MBFyi = 2406 + INTEGER(IntKi), PARAMETER :: M7N4MBFyi = 2407 + INTEGER(IntKi), PARAMETER :: M7N5MBFyi = 2408 + INTEGER(IntKi), PARAMETER :: M7N6MBFyi = 2409 + INTEGER(IntKi), PARAMETER :: M7N7MBFyi = 2410 + INTEGER(IntKi), PARAMETER :: M7N8MBFyi = 2411 + INTEGER(IntKi), PARAMETER :: M7N9MBFyi = 2412 + INTEGER(IntKi), PARAMETER :: M8N1MBFyi = 2413 + INTEGER(IntKi), PARAMETER :: M8N2MBFyi = 2414 + INTEGER(IntKi), PARAMETER :: M8N3MBFyi = 2415 + INTEGER(IntKi), PARAMETER :: M8N4MBFyi = 2416 + INTEGER(IntKi), PARAMETER :: M8N5MBFyi = 2417 + INTEGER(IntKi), PARAMETER :: M8N6MBFyi = 2418 + INTEGER(IntKi), PARAMETER :: M8N7MBFyi = 2419 + INTEGER(IntKi), PARAMETER :: M8N8MBFyi = 2420 + INTEGER(IntKi), PARAMETER :: M8N9MBFyi = 2421 + INTEGER(IntKi), PARAMETER :: M9N1MBFyi = 2422 + INTEGER(IntKi), PARAMETER :: M9N2MBFyi = 2423 + INTEGER(IntKi), PARAMETER :: M9N3MBFyi = 2424 + INTEGER(IntKi), PARAMETER :: M9N4MBFyi = 2425 + INTEGER(IntKi), PARAMETER :: M9N5MBFyi = 2426 + INTEGER(IntKi), PARAMETER :: M9N6MBFyi = 2427 + INTEGER(IntKi), PARAMETER :: M9N7MBFyi = 2428 + INTEGER(IntKi), PARAMETER :: M9N8MBFyi = 2429 + INTEGER(IntKi), PARAMETER :: M9N9MBFyi = 2430 + INTEGER(IntKi), PARAMETER :: M1N1MBFzi = 2431 + INTEGER(IntKi), PARAMETER :: M1N2MBFzi = 2432 + INTEGER(IntKi), PARAMETER :: M1N3MBFzi = 2433 + INTEGER(IntKi), PARAMETER :: M1N4MBFzi = 2434 + INTEGER(IntKi), PARAMETER :: M1N5MBFzi = 2435 + INTEGER(IntKi), PARAMETER :: M1N6MBFzi = 2436 + INTEGER(IntKi), PARAMETER :: M1N7MBFzi = 2437 + INTEGER(IntKi), PARAMETER :: M1N8MBFzi = 2438 + INTEGER(IntKi), PARAMETER :: M1N9MBFzi = 2439 + INTEGER(IntKi), PARAMETER :: M2N1MBFzi = 2440 + INTEGER(IntKi), PARAMETER :: M2N2MBFzi = 2441 + INTEGER(IntKi), PARAMETER :: M2N3MBFzi = 2442 + INTEGER(IntKi), PARAMETER :: M2N4MBFzi = 2443 + INTEGER(IntKi), PARAMETER :: M2N5MBFzi = 2444 + INTEGER(IntKi), PARAMETER :: M2N6MBFzi = 2445 + INTEGER(IntKi), PARAMETER :: M2N7MBFzi = 2446 + INTEGER(IntKi), PARAMETER :: M2N8MBFzi = 2447 + INTEGER(IntKi), PARAMETER :: M2N9MBFzi = 2448 + INTEGER(IntKi), PARAMETER :: M3N1MBFzi = 2449 + INTEGER(IntKi), PARAMETER :: M3N2MBFzi = 2450 + INTEGER(IntKi), PARAMETER :: M3N3MBFzi = 2451 + INTEGER(IntKi), PARAMETER :: M3N4MBFzi = 2452 + INTEGER(IntKi), PARAMETER :: M3N5MBFzi = 2453 + INTEGER(IntKi), PARAMETER :: M3N6MBFzi = 2454 + INTEGER(IntKi), PARAMETER :: M3N7MBFzi = 2455 + INTEGER(IntKi), PARAMETER :: M3N8MBFzi = 2456 + INTEGER(IntKi), PARAMETER :: M3N9MBFzi = 2457 + INTEGER(IntKi), PARAMETER :: M4N1MBFzi = 2458 + INTEGER(IntKi), PARAMETER :: M4N2MBFzi = 2459 + INTEGER(IntKi), PARAMETER :: M4N3MBFzi = 2460 + INTEGER(IntKi), PARAMETER :: M4N4MBFzi = 2461 + INTEGER(IntKi), PARAMETER :: M4N5MBFzi = 2462 + INTEGER(IntKi), PARAMETER :: M4N6MBFzi = 2463 + INTEGER(IntKi), PARAMETER :: M4N7MBFzi = 2464 + INTEGER(IntKi), PARAMETER :: M4N8MBFzi = 2465 + INTEGER(IntKi), PARAMETER :: M4N9MBFzi = 2466 + INTEGER(IntKi), PARAMETER :: M5N1MBFzi = 2467 + INTEGER(IntKi), PARAMETER :: M5N2MBFzi = 2468 + INTEGER(IntKi), PARAMETER :: M5N3MBFzi = 2469 + INTEGER(IntKi), PARAMETER :: M5N4MBFzi = 2470 + INTEGER(IntKi), PARAMETER :: M5N5MBFzi = 2471 + INTEGER(IntKi), PARAMETER :: M5N6MBFzi = 2472 + INTEGER(IntKi), PARAMETER :: M5N7MBFzi = 2473 + INTEGER(IntKi), PARAMETER :: M5N8MBFzi = 2474 + INTEGER(IntKi), PARAMETER :: M5N9MBFzi = 2475 + INTEGER(IntKi), PARAMETER :: M6N1MBFzi = 2476 + INTEGER(IntKi), PARAMETER :: M6N2MBFzi = 2477 + INTEGER(IntKi), PARAMETER :: M6N3MBFzi = 2478 + INTEGER(IntKi), PARAMETER :: M6N4MBFzi = 2479 + INTEGER(IntKi), PARAMETER :: M6N5MBFzi = 2480 + INTEGER(IntKi), PARAMETER :: M6N6MBFzi = 2481 + INTEGER(IntKi), PARAMETER :: M6N7MBFzi = 2482 + INTEGER(IntKi), PARAMETER :: M6N8MBFzi = 2483 + INTEGER(IntKi), PARAMETER :: M6N9MBFzi = 2484 + INTEGER(IntKi), PARAMETER :: M7N1MBFzi = 2485 + INTEGER(IntKi), PARAMETER :: M7N2MBFzi = 2486 + INTEGER(IntKi), PARAMETER :: M7N3MBFzi = 2487 + INTEGER(IntKi), PARAMETER :: M7N4MBFzi = 2488 + INTEGER(IntKi), PARAMETER :: M7N5MBFzi = 2489 + INTEGER(IntKi), PARAMETER :: M7N6MBFzi = 2490 + INTEGER(IntKi), PARAMETER :: M7N7MBFzi = 2491 + INTEGER(IntKi), PARAMETER :: M7N8MBFzi = 2492 + INTEGER(IntKi), PARAMETER :: M7N9MBFzi = 2493 + INTEGER(IntKi), PARAMETER :: M8N1MBFzi = 2494 + INTEGER(IntKi), PARAMETER :: M8N2MBFzi = 2495 + INTEGER(IntKi), PARAMETER :: M8N3MBFzi = 2496 + INTEGER(IntKi), PARAMETER :: M8N4MBFzi = 2497 + INTEGER(IntKi), PARAMETER :: M8N5MBFzi = 2498 + INTEGER(IntKi), PARAMETER :: M8N6MBFzi = 2499 + INTEGER(IntKi), PARAMETER :: M8N7MBFzi = 2500 + INTEGER(IntKi), PARAMETER :: M8N8MBFzi = 2501 + INTEGER(IntKi), PARAMETER :: M8N9MBFzi = 2502 + INTEGER(IntKi), PARAMETER :: M9N1MBFzi = 2503 + INTEGER(IntKi), PARAMETER :: M9N2MBFzi = 2504 + INTEGER(IntKi), PARAMETER :: M9N3MBFzi = 2505 + INTEGER(IntKi), PARAMETER :: M9N4MBFzi = 2506 + INTEGER(IntKi), PARAMETER :: M9N5MBFzi = 2507 + INTEGER(IntKi), PARAMETER :: M9N6MBFzi = 2508 + INTEGER(IntKi), PARAMETER :: M9N7MBFzi = 2509 + INTEGER(IntKi), PARAMETER :: M9N8MBFzi = 2510 + INTEGER(IntKi), PARAMETER :: M9N9MBFzi = 2511 + INTEGER(IntKi), PARAMETER :: M1N1FMGxi = 2512 + INTEGER(IntKi), PARAMETER :: M1N2FMGxi = 2513 + INTEGER(IntKi), PARAMETER :: M1N3FMGxi = 2514 + INTEGER(IntKi), PARAMETER :: M1N4FMGxi = 2515 + INTEGER(IntKi), PARAMETER :: M1N5FMGxi = 2516 + INTEGER(IntKi), PARAMETER :: M1N6FMGxi = 2517 + INTEGER(IntKi), PARAMETER :: M1N7FMGxi = 2518 + INTEGER(IntKi), PARAMETER :: M1N8FMGxi = 2519 + INTEGER(IntKi), PARAMETER :: M1N9FMGxi = 2520 + INTEGER(IntKi), PARAMETER :: M2N1FMGxi = 2521 + INTEGER(IntKi), PARAMETER :: M2N2FMGxi = 2522 + INTEGER(IntKi), PARAMETER :: M2N3FMGxi = 2523 + INTEGER(IntKi), PARAMETER :: M2N4FMGxi = 2524 + INTEGER(IntKi), PARAMETER :: M2N5FMGxi = 2525 + INTEGER(IntKi), PARAMETER :: M2N6FMGxi = 2526 + INTEGER(IntKi), PARAMETER :: M2N7FMGxi = 2527 + INTEGER(IntKi), PARAMETER :: M2N8FMGxi = 2528 + INTEGER(IntKi), PARAMETER :: M2N9FMGxi = 2529 + INTEGER(IntKi), PARAMETER :: M3N1FMGxi = 2530 + INTEGER(IntKi), PARAMETER :: M3N2FMGxi = 2531 + INTEGER(IntKi), PARAMETER :: M3N3FMGxi = 2532 + INTEGER(IntKi), PARAMETER :: M3N4FMGxi = 2533 + INTEGER(IntKi), PARAMETER :: M3N5FMGxi = 2534 + INTEGER(IntKi), PARAMETER :: M3N6FMGxi = 2535 + INTEGER(IntKi), PARAMETER :: M3N7FMGxi = 2536 + INTEGER(IntKi), PARAMETER :: M3N8FMGxi = 2537 + INTEGER(IntKi), PARAMETER :: M3N9FMGxi = 2538 + INTEGER(IntKi), PARAMETER :: M4N1FMGxi = 2539 + INTEGER(IntKi), PARAMETER :: M4N2FMGxi = 2540 + INTEGER(IntKi), PARAMETER :: M4N3FMGxi = 2541 + INTEGER(IntKi), PARAMETER :: M4N4FMGxi = 2542 + INTEGER(IntKi), PARAMETER :: M4N5FMGxi = 2543 + INTEGER(IntKi), PARAMETER :: M4N6FMGxi = 2544 + INTEGER(IntKi), PARAMETER :: M4N7FMGxi = 2545 + INTEGER(IntKi), PARAMETER :: M4N8FMGxi = 2546 + INTEGER(IntKi), PARAMETER :: M4N9FMGxi = 2547 + INTEGER(IntKi), PARAMETER :: M5N1FMGxi = 2548 + INTEGER(IntKi), PARAMETER :: M5N2FMGxi = 2549 + INTEGER(IntKi), PARAMETER :: M5N3FMGxi = 2550 + INTEGER(IntKi), PARAMETER :: M5N4FMGxi = 2551 + INTEGER(IntKi), PARAMETER :: M5N5FMGxi = 2552 + INTEGER(IntKi), PARAMETER :: M5N6FMGxi = 2553 + INTEGER(IntKi), PARAMETER :: M5N7FMGxi = 2554 + INTEGER(IntKi), PARAMETER :: M5N8FMGxi = 2555 + INTEGER(IntKi), PARAMETER :: M5N9FMGxi = 2556 + INTEGER(IntKi), PARAMETER :: M6N1FMGxi = 2557 + INTEGER(IntKi), PARAMETER :: M6N2FMGxi = 2558 + INTEGER(IntKi), PARAMETER :: M6N3FMGxi = 2559 + INTEGER(IntKi), PARAMETER :: M6N4FMGxi = 2560 + INTEGER(IntKi), PARAMETER :: M6N5FMGxi = 2561 + INTEGER(IntKi), PARAMETER :: M6N6FMGxi = 2562 + INTEGER(IntKi), PARAMETER :: M6N7FMGxi = 2563 + INTEGER(IntKi), PARAMETER :: M6N8FMGxi = 2564 + INTEGER(IntKi), PARAMETER :: M6N9FMGxi = 2565 + INTEGER(IntKi), PARAMETER :: M7N1FMGxi = 2566 + INTEGER(IntKi), PARAMETER :: M7N2FMGxi = 2567 + INTEGER(IntKi), PARAMETER :: M7N3FMGxi = 2568 + INTEGER(IntKi), PARAMETER :: M7N4FMGxi = 2569 + INTEGER(IntKi), PARAMETER :: M7N5FMGxi = 2570 + INTEGER(IntKi), PARAMETER :: M7N6FMGxi = 2571 + INTEGER(IntKi), PARAMETER :: M7N7FMGxi = 2572 + INTEGER(IntKi), PARAMETER :: M7N8FMGxi = 2573 + INTEGER(IntKi), PARAMETER :: M7N9FMGxi = 2574 + INTEGER(IntKi), PARAMETER :: M8N1FMGxi = 2575 + INTEGER(IntKi), PARAMETER :: M8N2FMGxi = 2576 + INTEGER(IntKi), PARAMETER :: M8N3FMGxi = 2577 + INTEGER(IntKi), PARAMETER :: M8N4FMGxi = 2578 + INTEGER(IntKi), PARAMETER :: M8N5FMGxi = 2579 + INTEGER(IntKi), PARAMETER :: M8N6FMGxi = 2580 + INTEGER(IntKi), PARAMETER :: M8N7FMGxi = 2581 + INTEGER(IntKi), PARAMETER :: M8N8FMGxi = 2582 + INTEGER(IntKi), PARAMETER :: M8N9FMGxi = 2583 + INTEGER(IntKi), PARAMETER :: M9N1FMGxi = 2584 + INTEGER(IntKi), PARAMETER :: M9N2FMGxi = 2585 + INTEGER(IntKi), PARAMETER :: M9N3FMGxi = 2586 + INTEGER(IntKi), PARAMETER :: M9N4FMGxi = 2587 + INTEGER(IntKi), PARAMETER :: M9N5FMGxi = 2588 + INTEGER(IntKi), PARAMETER :: M9N6FMGxi = 2589 + INTEGER(IntKi), PARAMETER :: M9N7FMGxi = 2590 + INTEGER(IntKi), PARAMETER :: M9N8FMGxi = 2591 + INTEGER(IntKi), PARAMETER :: M9N9FMGxi = 2592 + INTEGER(IntKi), PARAMETER :: M1N1FMGyi = 2593 + INTEGER(IntKi), PARAMETER :: M1N2FMGyi = 2594 + INTEGER(IntKi), PARAMETER :: M1N3FMGyi = 2595 + INTEGER(IntKi), PARAMETER :: M1N4FMGyi = 2596 + INTEGER(IntKi), PARAMETER :: M1N5FMGyi = 2597 + INTEGER(IntKi), PARAMETER :: M1N6FMGyi = 2598 + INTEGER(IntKi), PARAMETER :: M1N7FMGyi = 2599 + INTEGER(IntKi), PARAMETER :: M1N8FMGyi = 2600 + INTEGER(IntKi), PARAMETER :: M1N9FMGyi = 2601 + INTEGER(IntKi), PARAMETER :: M2N1FMGyi = 2602 + INTEGER(IntKi), PARAMETER :: M2N2FMGyi = 2603 + INTEGER(IntKi), PARAMETER :: M2N3FMGyi = 2604 + INTEGER(IntKi), PARAMETER :: M2N4FMGyi = 2605 + INTEGER(IntKi), PARAMETER :: M2N5FMGyi = 2606 + INTEGER(IntKi), PARAMETER :: M2N6FMGyi = 2607 + INTEGER(IntKi), PARAMETER :: M2N7FMGyi = 2608 + INTEGER(IntKi), PARAMETER :: M2N8FMGyi = 2609 + INTEGER(IntKi), PARAMETER :: M2N9FMGyi = 2610 + INTEGER(IntKi), PARAMETER :: M3N1FMGyi = 2611 + INTEGER(IntKi), PARAMETER :: M3N2FMGyi = 2612 + INTEGER(IntKi), PARAMETER :: M3N3FMGyi = 2613 + INTEGER(IntKi), PARAMETER :: M3N4FMGyi = 2614 + INTEGER(IntKi), PARAMETER :: M3N5FMGyi = 2615 + INTEGER(IntKi), PARAMETER :: M3N6FMGyi = 2616 + INTEGER(IntKi), PARAMETER :: M3N7FMGyi = 2617 + INTEGER(IntKi), PARAMETER :: M3N8FMGyi = 2618 + INTEGER(IntKi), PARAMETER :: M3N9FMGyi = 2619 + INTEGER(IntKi), PARAMETER :: M4N1FMGyi = 2620 + INTEGER(IntKi), PARAMETER :: M4N2FMGyi = 2621 + INTEGER(IntKi), PARAMETER :: M4N3FMGyi = 2622 + INTEGER(IntKi), PARAMETER :: M4N4FMGyi = 2623 + INTEGER(IntKi), PARAMETER :: M4N5FMGyi = 2624 + INTEGER(IntKi), PARAMETER :: M4N6FMGyi = 2625 + INTEGER(IntKi), PARAMETER :: M4N7FMGyi = 2626 + INTEGER(IntKi), PARAMETER :: M4N8FMGyi = 2627 + INTEGER(IntKi), PARAMETER :: M4N9FMGyi = 2628 + INTEGER(IntKi), PARAMETER :: M5N1FMGyi = 2629 + INTEGER(IntKi), PARAMETER :: M5N2FMGyi = 2630 + INTEGER(IntKi), PARAMETER :: M5N3FMGyi = 2631 + INTEGER(IntKi), PARAMETER :: M5N4FMGyi = 2632 + INTEGER(IntKi), PARAMETER :: M5N5FMGyi = 2633 + INTEGER(IntKi), PARAMETER :: M5N6FMGyi = 2634 + INTEGER(IntKi), PARAMETER :: M5N7FMGyi = 2635 + INTEGER(IntKi), PARAMETER :: M5N8FMGyi = 2636 + INTEGER(IntKi), PARAMETER :: M5N9FMGyi = 2637 + INTEGER(IntKi), PARAMETER :: M6N1FMGyi = 2638 + INTEGER(IntKi), PARAMETER :: M6N2FMGyi = 2639 + INTEGER(IntKi), PARAMETER :: M6N3FMGyi = 2640 + INTEGER(IntKi), PARAMETER :: M6N4FMGyi = 2641 + INTEGER(IntKi), PARAMETER :: M6N5FMGyi = 2642 + INTEGER(IntKi), PARAMETER :: M6N6FMGyi = 2643 + INTEGER(IntKi), PARAMETER :: M6N7FMGyi = 2644 + INTEGER(IntKi), PARAMETER :: M6N8FMGyi = 2645 + INTEGER(IntKi), PARAMETER :: M6N9FMGyi = 2646 + INTEGER(IntKi), PARAMETER :: M7N1FMGyi = 2647 + INTEGER(IntKi), PARAMETER :: M7N2FMGyi = 2648 + INTEGER(IntKi), PARAMETER :: M7N3FMGyi = 2649 + INTEGER(IntKi), PARAMETER :: M7N4FMGyi = 2650 + INTEGER(IntKi), PARAMETER :: M7N5FMGyi = 2651 + INTEGER(IntKi), PARAMETER :: M7N6FMGyi = 2652 + INTEGER(IntKi), PARAMETER :: M7N7FMGyi = 2653 + INTEGER(IntKi), PARAMETER :: M7N8FMGyi = 2654 + INTEGER(IntKi), PARAMETER :: M7N9FMGyi = 2655 + INTEGER(IntKi), PARAMETER :: M8N1FMGyi = 2656 + INTEGER(IntKi), PARAMETER :: M8N2FMGyi = 2657 + INTEGER(IntKi), PARAMETER :: M8N3FMGyi = 2658 + INTEGER(IntKi), PARAMETER :: M8N4FMGyi = 2659 + INTEGER(IntKi), PARAMETER :: M8N5FMGyi = 2660 + INTEGER(IntKi), PARAMETER :: M8N6FMGyi = 2661 + INTEGER(IntKi), PARAMETER :: M8N7FMGyi = 2662 + INTEGER(IntKi), PARAMETER :: M8N8FMGyi = 2663 + INTEGER(IntKi), PARAMETER :: M8N9FMGyi = 2664 + INTEGER(IntKi), PARAMETER :: M9N1FMGyi = 2665 + INTEGER(IntKi), PARAMETER :: M9N2FMGyi = 2666 + INTEGER(IntKi), PARAMETER :: M9N3FMGyi = 2667 + INTEGER(IntKi), PARAMETER :: M9N4FMGyi = 2668 + INTEGER(IntKi), PARAMETER :: M9N5FMGyi = 2669 + INTEGER(IntKi), PARAMETER :: M9N6FMGyi = 2670 + INTEGER(IntKi), PARAMETER :: M9N7FMGyi = 2671 + INTEGER(IntKi), PARAMETER :: M9N8FMGyi = 2672 + INTEGER(IntKi), PARAMETER :: M9N9FMGyi = 2673 + INTEGER(IntKi), PARAMETER :: M1N1FMGzi = 2674 + INTEGER(IntKi), PARAMETER :: M1N2FMGzi = 2675 + INTEGER(IntKi), PARAMETER :: M1N3FMGzi = 2676 + INTEGER(IntKi), PARAMETER :: M1N4FMGzi = 2677 + INTEGER(IntKi), PARAMETER :: M1N5FMGzi = 2678 + INTEGER(IntKi), PARAMETER :: M1N6FMGzi = 2679 + INTEGER(IntKi), PARAMETER :: M1N7FMGzi = 2680 + INTEGER(IntKi), PARAMETER :: M1N8FMGzi = 2681 + INTEGER(IntKi), PARAMETER :: M1N9FMGzi = 2682 + INTEGER(IntKi), PARAMETER :: M2N1FMGzi = 2683 + INTEGER(IntKi), PARAMETER :: M2N2FMGzi = 2684 + INTEGER(IntKi), PARAMETER :: M2N3FMGzi = 2685 + INTEGER(IntKi), PARAMETER :: M2N4FMGzi = 2686 + INTEGER(IntKi), PARAMETER :: M2N5FMGzi = 2687 + INTEGER(IntKi), PARAMETER :: M2N6FMGzi = 2688 + INTEGER(IntKi), PARAMETER :: M2N7FMGzi = 2689 + INTEGER(IntKi), PARAMETER :: M2N8FMGzi = 2690 + INTEGER(IntKi), PARAMETER :: M2N9FMGzi = 2691 + INTEGER(IntKi), PARAMETER :: M3N1FMGzi = 2692 + INTEGER(IntKi), PARAMETER :: M3N2FMGzi = 2693 + INTEGER(IntKi), PARAMETER :: M3N3FMGzi = 2694 + INTEGER(IntKi), PARAMETER :: M3N4FMGzi = 2695 + INTEGER(IntKi), PARAMETER :: M3N5FMGzi = 2696 + INTEGER(IntKi), PARAMETER :: M3N6FMGzi = 2697 + INTEGER(IntKi), PARAMETER :: M3N7FMGzi = 2698 + INTEGER(IntKi), PARAMETER :: M3N8FMGzi = 2699 + INTEGER(IntKi), PARAMETER :: M3N9FMGzi = 2700 + INTEGER(IntKi), PARAMETER :: M4N1FMGzi = 2701 + INTEGER(IntKi), PARAMETER :: M4N2FMGzi = 2702 + INTEGER(IntKi), PARAMETER :: M4N3FMGzi = 2703 + INTEGER(IntKi), PARAMETER :: M4N4FMGzi = 2704 + INTEGER(IntKi), PARAMETER :: M4N5FMGzi = 2705 + INTEGER(IntKi), PARAMETER :: M4N6FMGzi = 2706 + INTEGER(IntKi), PARAMETER :: M4N7FMGzi = 2707 + INTEGER(IntKi), PARAMETER :: M4N8FMGzi = 2708 + INTEGER(IntKi), PARAMETER :: M4N9FMGzi = 2709 + INTEGER(IntKi), PARAMETER :: M5N1FMGzi = 2710 + INTEGER(IntKi), PARAMETER :: M5N2FMGzi = 2711 + INTEGER(IntKi), PARAMETER :: M5N3FMGzi = 2712 + INTEGER(IntKi), PARAMETER :: M5N4FMGzi = 2713 + INTEGER(IntKi), PARAMETER :: M5N5FMGzi = 2714 + INTEGER(IntKi), PARAMETER :: M5N6FMGzi = 2715 + INTEGER(IntKi), PARAMETER :: M5N7FMGzi = 2716 + INTEGER(IntKi), PARAMETER :: M5N8FMGzi = 2717 + INTEGER(IntKi), PARAMETER :: M5N9FMGzi = 2718 + INTEGER(IntKi), PARAMETER :: M6N1FMGzi = 2719 + INTEGER(IntKi), PARAMETER :: M6N2FMGzi = 2720 + INTEGER(IntKi), PARAMETER :: M6N3FMGzi = 2721 + INTEGER(IntKi), PARAMETER :: M6N4FMGzi = 2722 + INTEGER(IntKi), PARAMETER :: M6N5FMGzi = 2723 + INTEGER(IntKi), PARAMETER :: M6N6FMGzi = 2724 + INTEGER(IntKi), PARAMETER :: M6N7FMGzi = 2725 + INTEGER(IntKi), PARAMETER :: M6N8FMGzi = 2726 + INTEGER(IntKi), PARAMETER :: M6N9FMGzi = 2727 + INTEGER(IntKi), PARAMETER :: M7N1FMGzi = 2728 + INTEGER(IntKi), PARAMETER :: M7N2FMGzi = 2729 + INTEGER(IntKi), PARAMETER :: M7N3FMGzi = 2730 + INTEGER(IntKi), PARAMETER :: M7N4FMGzi = 2731 + INTEGER(IntKi), PARAMETER :: M7N5FMGzi = 2732 + INTEGER(IntKi), PARAMETER :: M7N6FMGzi = 2733 + INTEGER(IntKi), PARAMETER :: M7N7FMGzi = 2734 + INTEGER(IntKi), PARAMETER :: M7N8FMGzi = 2735 + INTEGER(IntKi), PARAMETER :: M7N9FMGzi = 2736 + INTEGER(IntKi), PARAMETER :: M8N1FMGzi = 2737 + INTEGER(IntKi), PARAMETER :: M8N2FMGzi = 2738 + INTEGER(IntKi), PARAMETER :: M8N3FMGzi = 2739 + INTEGER(IntKi), PARAMETER :: M8N4FMGzi = 2740 + INTEGER(IntKi), PARAMETER :: M8N5FMGzi = 2741 + INTEGER(IntKi), PARAMETER :: M8N6FMGzi = 2742 + INTEGER(IntKi), PARAMETER :: M8N7FMGzi = 2743 + INTEGER(IntKi), PARAMETER :: M8N8FMGzi = 2744 + INTEGER(IntKi), PARAMETER :: M8N9FMGzi = 2745 + INTEGER(IntKi), PARAMETER :: M9N1FMGzi = 2746 + INTEGER(IntKi), PARAMETER :: M9N2FMGzi = 2747 + INTEGER(IntKi), PARAMETER :: M9N3FMGzi = 2748 + INTEGER(IntKi), PARAMETER :: M9N4FMGzi = 2749 + INTEGER(IntKi), PARAMETER :: M9N5FMGzi = 2750 + INTEGER(IntKi), PARAMETER :: M9N6FMGzi = 2751 + INTEGER(IntKi), PARAMETER :: M9N7FMGzi = 2752 + INTEGER(IntKi), PARAMETER :: M9N8FMGzi = 2753 + INTEGER(IntKi), PARAMETER :: M9N9FMGzi = 2754 + INTEGER(IntKi), PARAMETER :: M1N1MMGxi = 2755 + INTEGER(IntKi), PARAMETER :: M1N2MMGxi = 2756 + INTEGER(IntKi), PARAMETER :: M1N3MMGxi = 2757 + INTEGER(IntKi), PARAMETER :: M1N4MMGxi = 2758 + INTEGER(IntKi), PARAMETER :: M1N5MMGxi = 2759 + INTEGER(IntKi), PARAMETER :: M1N6MMGxi = 2760 + INTEGER(IntKi), PARAMETER :: M1N7MMGxi = 2761 + INTEGER(IntKi), PARAMETER :: M1N8MMGxi = 2762 + INTEGER(IntKi), PARAMETER :: M1N9MMGxi = 2763 + INTEGER(IntKi), PARAMETER :: M2N1MMGxi = 2764 + INTEGER(IntKi), PARAMETER :: M2N2MMGxi = 2765 + INTEGER(IntKi), PARAMETER :: M2N3MMGxi = 2766 + INTEGER(IntKi), PARAMETER :: M2N4MMGxi = 2767 + INTEGER(IntKi), PARAMETER :: M2N5MMGxi = 2768 + INTEGER(IntKi), PARAMETER :: M2N6MMGxi = 2769 + INTEGER(IntKi), PARAMETER :: M2N7MMGxi = 2770 + INTEGER(IntKi), PARAMETER :: M2N8MMGxi = 2771 + INTEGER(IntKi), PARAMETER :: M2N9MMGxi = 2772 + INTEGER(IntKi), PARAMETER :: M3N1MMGxi = 2773 + INTEGER(IntKi), PARAMETER :: M3N2MMGxi = 2774 + INTEGER(IntKi), PARAMETER :: M3N3MMGxi = 2775 + INTEGER(IntKi), PARAMETER :: M3N4MMGxi = 2776 + INTEGER(IntKi), PARAMETER :: M3N5MMGxi = 2777 + INTEGER(IntKi), PARAMETER :: M3N6MMGxi = 2778 + INTEGER(IntKi), PARAMETER :: M3N7MMGxi = 2779 + INTEGER(IntKi), PARAMETER :: M3N8MMGxi = 2780 + INTEGER(IntKi), PARAMETER :: M3N9MMGxi = 2781 + INTEGER(IntKi), PARAMETER :: M4N1MMGxi = 2782 + INTEGER(IntKi), PARAMETER :: M4N2MMGxi = 2783 + INTEGER(IntKi), PARAMETER :: M4N3MMGxi = 2784 + INTEGER(IntKi), PARAMETER :: M4N4MMGxi = 2785 + INTEGER(IntKi), PARAMETER :: M4N5MMGxi = 2786 + INTEGER(IntKi), PARAMETER :: M4N6MMGxi = 2787 + INTEGER(IntKi), PARAMETER :: M4N7MMGxi = 2788 + INTEGER(IntKi), PARAMETER :: M4N8MMGxi = 2789 + INTEGER(IntKi), PARAMETER :: M4N9MMGxi = 2790 + INTEGER(IntKi), PARAMETER :: M5N1MMGxi = 2791 + INTEGER(IntKi), PARAMETER :: M5N2MMGxi = 2792 + INTEGER(IntKi), PARAMETER :: M5N3MMGxi = 2793 + INTEGER(IntKi), PARAMETER :: M5N4MMGxi = 2794 + INTEGER(IntKi), PARAMETER :: M5N5MMGxi = 2795 + INTEGER(IntKi), PARAMETER :: M5N6MMGxi = 2796 + INTEGER(IntKi), PARAMETER :: M5N7MMGxi = 2797 + INTEGER(IntKi), PARAMETER :: M5N8MMGxi = 2798 + INTEGER(IntKi), PARAMETER :: M5N9MMGxi = 2799 + INTEGER(IntKi), PARAMETER :: M6N1MMGxi = 2800 + INTEGER(IntKi), PARAMETER :: M6N2MMGxi = 2801 + INTEGER(IntKi), PARAMETER :: M6N3MMGxi = 2802 + INTEGER(IntKi), PARAMETER :: M6N4MMGxi = 2803 + INTEGER(IntKi), PARAMETER :: M6N5MMGxi = 2804 + INTEGER(IntKi), PARAMETER :: M6N6MMGxi = 2805 + INTEGER(IntKi), PARAMETER :: M6N7MMGxi = 2806 + INTEGER(IntKi), PARAMETER :: M6N8MMGxi = 2807 + INTEGER(IntKi), PARAMETER :: M6N9MMGxi = 2808 + INTEGER(IntKi), PARAMETER :: M7N1MMGxi = 2809 + INTEGER(IntKi), PARAMETER :: M7N2MMGxi = 2810 + INTEGER(IntKi), PARAMETER :: M7N3MMGxi = 2811 + INTEGER(IntKi), PARAMETER :: M7N4MMGxi = 2812 + INTEGER(IntKi), PARAMETER :: M7N5MMGxi = 2813 + INTEGER(IntKi), PARAMETER :: M7N6MMGxi = 2814 + INTEGER(IntKi), PARAMETER :: M7N7MMGxi = 2815 + INTEGER(IntKi), PARAMETER :: M7N8MMGxi = 2816 + INTEGER(IntKi), PARAMETER :: M7N9MMGxi = 2817 + INTEGER(IntKi), PARAMETER :: M8N1MMGxi = 2818 + INTEGER(IntKi), PARAMETER :: M8N2MMGxi = 2819 + INTEGER(IntKi), PARAMETER :: M8N3MMGxi = 2820 + INTEGER(IntKi), PARAMETER :: M8N4MMGxi = 2821 + INTEGER(IntKi), PARAMETER :: M8N5MMGxi = 2822 + INTEGER(IntKi), PARAMETER :: M8N6MMGxi = 2823 + INTEGER(IntKi), PARAMETER :: M8N7MMGxi = 2824 + INTEGER(IntKi), PARAMETER :: M8N8MMGxi = 2825 + INTEGER(IntKi), PARAMETER :: M8N9MMGxi = 2826 + INTEGER(IntKi), PARAMETER :: M9N1MMGxi = 2827 + INTEGER(IntKi), PARAMETER :: M9N2MMGxi = 2828 + INTEGER(IntKi), PARAMETER :: M9N3MMGxi = 2829 + INTEGER(IntKi), PARAMETER :: M9N4MMGxi = 2830 + INTEGER(IntKi), PARAMETER :: M9N5MMGxi = 2831 + INTEGER(IntKi), PARAMETER :: M9N6MMGxi = 2832 + INTEGER(IntKi), PARAMETER :: M9N7MMGxi = 2833 + INTEGER(IntKi), PARAMETER :: M9N8MMGxi = 2834 + INTEGER(IntKi), PARAMETER :: M9N9MMGxi = 2835 + INTEGER(IntKi), PARAMETER :: M1N1MMGyi = 2836 + INTEGER(IntKi), PARAMETER :: M1N2MMGyi = 2837 + INTEGER(IntKi), PARAMETER :: M1N3MMGyi = 2838 + INTEGER(IntKi), PARAMETER :: M1N4MMGyi = 2839 + INTEGER(IntKi), PARAMETER :: M1N5MMGyi = 2840 + INTEGER(IntKi), PARAMETER :: M1N6MMGyi = 2841 + INTEGER(IntKi), PARAMETER :: M1N7MMGyi = 2842 + INTEGER(IntKi), PARAMETER :: M1N8MMGyi = 2843 + INTEGER(IntKi), PARAMETER :: M1N9MMGyi = 2844 + INTEGER(IntKi), PARAMETER :: M2N1MMGyi = 2845 + INTEGER(IntKi), PARAMETER :: M2N2MMGyi = 2846 + INTEGER(IntKi), PARAMETER :: M2N3MMGyi = 2847 + INTEGER(IntKi), PARAMETER :: M2N4MMGyi = 2848 + INTEGER(IntKi), PARAMETER :: M2N5MMGyi = 2849 + INTEGER(IntKi), PARAMETER :: M2N6MMGyi = 2850 + INTEGER(IntKi), PARAMETER :: M2N7MMGyi = 2851 + INTEGER(IntKi), PARAMETER :: M2N8MMGyi = 2852 + INTEGER(IntKi), PARAMETER :: M2N9MMGyi = 2853 + INTEGER(IntKi), PARAMETER :: M3N1MMGyi = 2854 + INTEGER(IntKi), PARAMETER :: M3N2MMGyi = 2855 + INTEGER(IntKi), PARAMETER :: M3N3MMGyi = 2856 + INTEGER(IntKi), PARAMETER :: M3N4MMGyi = 2857 + INTEGER(IntKi), PARAMETER :: M3N5MMGyi = 2858 + INTEGER(IntKi), PARAMETER :: M3N6MMGyi = 2859 + INTEGER(IntKi), PARAMETER :: M3N7MMGyi = 2860 + INTEGER(IntKi), PARAMETER :: M3N8MMGyi = 2861 + INTEGER(IntKi), PARAMETER :: M3N9MMGyi = 2862 + INTEGER(IntKi), PARAMETER :: M4N1MMGyi = 2863 + INTEGER(IntKi), PARAMETER :: M4N2MMGyi = 2864 + INTEGER(IntKi), PARAMETER :: M4N3MMGyi = 2865 + INTEGER(IntKi), PARAMETER :: M4N4MMGyi = 2866 + INTEGER(IntKi), PARAMETER :: M4N5MMGyi = 2867 + INTEGER(IntKi), PARAMETER :: M4N6MMGyi = 2868 + INTEGER(IntKi), PARAMETER :: M4N7MMGyi = 2869 + INTEGER(IntKi), PARAMETER :: M4N8MMGyi = 2870 + INTEGER(IntKi), PARAMETER :: M4N9MMGyi = 2871 + INTEGER(IntKi), PARAMETER :: M5N1MMGyi = 2872 + INTEGER(IntKi), PARAMETER :: M5N2MMGyi = 2873 + INTEGER(IntKi), PARAMETER :: M5N3MMGyi = 2874 + INTEGER(IntKi), PARAMETER :: M5N4MMGyi = 2875 + INTEGER(IntKi), PARAMETER :: M5N5MMGyi = 2876 + INTEGER(IntKi), PARAMETER :: M5N6MMGyi = 2877 + INTEGER(IntKi), PARAMETER :: M5N7MMGyi = 2878 + INTEGER(IntKi), PARAMETER :: M5N8MMGyi = 2879 + INTEGER(IntKi), PARAMETER :: M5N9MMGyi = 2880 + INTEGER(IntKi), PARAMETER :: M6N1MMGyi = 2881 + INTEGER(IntKi), PARAMETER :: M6N2MMGyi = 2882 + INTEGER(IntKi), PARAMETER :: M6N3MMGyi = 2883 + INTEGER(IntKi), PARAMETER :: M6N4MMGyi = 2884 + INTEGER(IntKi), PARAMETER :: M6N5MMGyi = 2885 + INTEGER(IntKi), PARAMETER :: M6N6MMGyi = 2886 + INTEGER(IntKi), PARAMETER :: M6N7MMGyi = 2887 + INTEGER(IntKi), PARAMETER :: M6N8MMGyi = 2888 + INTEGER(IntKi), PARAMETER :: M6N9MMGyi = 2889 + INTEGER(IntKi), PARAMETER :: M7N1MMGyi = 2890 + INTEGER(IntKi), PARAMETER :: M7N2MMGyi = 2891 + INTEGER(IntKi), PARAMETER :: M7N3MMGyi = 2892 + INTEGER(IntKi), PARAMETER :: M7N4MMGyi = 2893 + INTEGER(IntKi), PARAMETER :: M7N5MMGyi = 2894 + INTEGER(IntKi), PARAMETER :: M7N6MMGyi = 2895 + INTEGER(IntKi), PARAMETER :: M7N7MMGyi = 2896 + INTEGER(IntKi), PARAMETER :: M7N8MMGyi = 2897 + INTEGER(IntKi), PARAMETER :: M7N9MMGyi = 2898 + INTEGER(IntKi), PARAMETER :: M8N1MMGyi = 2899 + INTEGER(IntKi), PARAMETER :: M8N2MMGyi = 2900 + INTEGER(IntKi), PARAMETER :: M8N3MMGyi = 2901 + INTEGER(IntKi), PARAMETER :: M8N4MMGyi = 2902 + INTEGER(IntKi), PARAMETER :: M8N5MMGyi = 2903 + INTEGER(IntKi), PARAMETER :: M8N6MMGyi = 2904 + INTEGER(IntKi), PARAMETER :: M8N7MMGyi = 2905 + INTEGER(IntKi), PARAMETER :: M8N8MMGyi = 2906 + INTEGER(IntKi), PARAMETER :: M8N9MMGyi = 2907 + INTEGER(IntKi), PARAMETER :: M9N1MMGyi = 2908 + INTEGER(IntKi), PARAMETER :: M9N2MMGyi = 2909 + INTEGER(IntKi), PARAMETER :: M9N3MMGyi = 2910 + INTEGER(IntKi), PARAMETER :: M9N4MMGyi = 2911 + INTEGER(IntKi), PARAMETER :: M9N5MMGyi = 2912 + INTEGER(IntKi), PARAMETER :: M9N6MMGyi = 2913 + INTEGER(IntKi), PARAMETER :: M9N7MMGyi = 2914 + INTEGER(IntKi), PARAMETER :: M9N8MMGyi = 2915 + INTEGER(IntKi), PARAMETER :: M9N9MMGyi = 2916 + INTEGER(IntKi), PARAMETER :: M1N1MMGzi = 2917 + INTEGER(IntKi), PARAMETER :: M1N2MMGzi = 2918 + INTEGER(IntKi), PARAMETER :: M1N3MMGzi = 2919 + INTEGER(IntKi), PARAMETER :: M1N4MMGzi = 2920 + INTEGER(IntKi), PARAMETER :: M1N5MMGzi = 2921 + INTEGER(IntKi), PARAMETER :: M1N6MMGzi = 2922 + INTEGER(IntKi), PARAMETER :: M1N7MMGzi = 2923 + INTEGER(IntKi), PARAMETER :: M1N8MMGzi = 2924 + INTEGER(IntKi), PARAMETER :: M1N9MMGzi = 2925 + INTEGER(IntKi), PARAMETER :: M2N1MMGzi = 2926 + INTEGER(IntKi), PARAMETER :: M2N2MMGzi = 2927 + INTEGER(IntKi), PARAMETER :: M2N3MMGzi = 2928 + INTEGER(IntKi), PARAMETER :: M2N4MMGzi = 2929 + INTEGER(IntKi), PARAMETER :: M2N5MMGzi = 2930 + INTEGER(IntKi), PARAMETER :: M2N6MMGzi = 2931 + INTEGER(IntKi), PARAMETER :: M2N7MMGzi = 2932 + INTEGER(IntKi), PARAMETER :: M2N8MMGzi = 2933 + INTEGER(IntKi), PARAMETER :: M2N9MMGzi = 2934 + INTEGER(IntKi), PARAMETER :: M3N1MMGzi = 2935 + INTEGER(IntKi), PARAMETER :: M3N2MMGzi = 2936 + INTEGER(IntKi), PARAMETER :: M3N3MMGzi = 2937 + INTEGER(IntKi), PARAMETER :: M3N4MMGzi = 2938 + INTEGER(IntKi), PARAMETER :: M3N5MMGzi = 2939 + INTEGER(IntKi), PARAMETER :: M3N6MMGzi = 2940 + INTEGER(IntKi), PARAMETER :: M3N7MMGzi = 2941 + INTEGER(IntKi), PARAMETER :: M3N8MMGzi = 2942 + INTEGER(IntKi), PARAMETER :: M3N9MMGzi = 2943 + INTEGER(IntKi), PARAMETER :: M4N1MMGzi = 2944 + INTEGER(IntKi), PARAMETER :: M4N2MMGzi = 2945 + INTEGER(IntKi), PARAMETER :: M4N3MMGzi = 2946 + INTEGER(IntKi), PARAMETER :: M4N4MMGzi = 2947 + INTEGER(IntKi), PARAMETER :: M4N5MMGzi = 2948 + INTEGER(IntKi), PARAMETER :: M4N6MMGzi = 2949 + INTEGER(IntKi), PARAMETER :: M4N7MMGzi = 2950 + INTEGER(IntKi), PARAMETER :: M4N8MMGzi = 2951 + INTEGER(IntKi), PARAMETER :: M4N9MMGzi = 2952 + INTEGER(IntKi), PARAMETER :: M5N1MMGzi = 2953 + INTEGER(IntKi), PARAMETER :: M5N2MMGzi = 2954 + INTEGER(IntKi), PARAMETER :: M5N3MMGzi = 2955 + INTEGER(IntKi), PARAMETER :: M5N4MMGzi = 2956 + INTEGER(IntKi), PARAMETER :: M5N5MMGzi = 2957 + INTEGER(IntKi), PARAMETER :: M5N6MMGzi = 2958 + INTEGER(IntKi), PARAMETER :: M5N7MMGzi = 2959 + INTEGER(IntKi), PARAMETER :: M5N8MMGzi = 2960 + INTEGER(IntKi), PARAMETER :: M5N9MMGzi = 2961 + INTEGER(IntKi), PARAMETER :: M6N1MMGzi = 2962 + INTEGER(IntKi), PARAMETER :: M6N2MMGzi = 2963 + INTEGER(IntKi), PARAMETER :: M6N3MMGzi = 2964 + INTEGER(IntKi), PARAMETER :: M6N4MMGzi = 2965 + INTEGER(IntKi), PARAMETER :: M6N5MMGzi = 2966 + INTEGER(IntKi), PARAMETER :: M6N6MMGzi = 2967 + INTEGER(IntKi), PARAMETER :: M6N7MMGzi = 2968 + INTEGER(IntKi), PARAMETER :: M6N8MMGzi = 2969 + INTEGER(IntKi), PARAMETER :: M6N9MMGzi = 2970 + INTEGER(IntKi), PARAMETER :: M7N1MMGzi = 2971 + INTEGER(IntKi), PARAMETER :: M7N2MMGzi = 2972 + INTEGER(IntKi), PARAMETER :: M7N3MMGzi = 2973 + INTEGER(IntKi), PARAMETER :: M7N4MMGzi = 2974 + INTEGER(IntKi), PARAMETER :: M7N5MMGzi = 2975 + INTEGER(IntKi), PARAMETER :: M7N6MMGzi = 2976 + INTEGER(IntKi), PARAMETER :: M7N7MMGzi = 2977 + INTEGER(IntKi), PARAMETER :: M7N8MMGzi = 2978 + INTEGER(IntKi), PARAMETER :: M7N9MMGzi = 2979 + INTEGER(IntKi), PARAMETER :: M8N1MMGzi = 2980 + INTEGER(IntKi), PARAMETER :: M8N2MMGzi = 2981 + INTEGER(IntKi), PARAMETER :: M8N3MMGzi = 2982 + INTEGER(IntKi), PARAMETER :: M8N4MMGzi = 2983 + INTEGER(IntKi), PARAMETER :: M8N5MMGzi = 2984 + INTEGER(IntKi), PARAMETER :: M8N6MMGzi = 2985 + INTEGER(IntKi), PARAMETER :: M8N7MMGzi = 2986 + INTEGER(IntKi), PARAMETER :: M8N8MMGzi = 2987 + INTEGER(IntKi), PARAMETER :: M8N9MMGzi = 2988 + INTEGER(IntKi), PARAMETER :: M9N1MMGzi = 2989 + INTEGER(IntKi), PARAMETER :: M9N2MMGzi = 2990 + INTEGER(IntKi), PARAMETER :: M9N3MMGzi = 2991 + INTEGER(IntKi), PARAMETER :: M9N4MMGzi = 2992 + INTEGER(IntKi), PARAMETER :: M9N5MMGzi = 2993 + INTEGER(IntKi), PARAMETER :: M9N6MMGzi = 2994 + INTEGER(IntKi), PARAMETER :: M9N7MMGzi = 2995 + INTEGER(IntKi), PARAMETER :: M9N8MMGzi = 2996 + INTEGER(IntKi), PARAMETER :: M9N9MMGzi = 2997 + INTEGER(IntKi), PARAMETER :: M1N1FAMxi = 2998 + INTEGER(IntKi), PARAMETER :: M1N2FAMxi = 2999 + INTEGER(IntKi), PARAMETER :: M1N3FAMxi = 3000 + INTEGER(IntKi), PARAMETER :: M1N4FAMxi = 3001 + INTEGER(IntKi), PARAMETER :: M1N5FAMxi = 3002 + INTEGER(IntKi), PARAMETER :: M1N6FAMxi = 3003 + INTEGER(IntKi), PARAMETER :: M1N7FAMxi = 3004 + INTEGER(IntKi), PARAMETER :: M1N8FAMxi = 3005 + INTEGER(IntKi), PARAMETER :: M1N9FAMxi = 3006 + INTEGER(IntKi), PARAMETER :: M2N1FAMxi = 3007 + INTEGER(IntKi), PARAMETER :: M2N2FAMxi = 3008 + INTEGER(IntKi), PARAMETER :: M2N3FAMxi = 3009 + INTEGER(IntKi), PARAMETER :: M2N4FAMxi = 3010 + INTEGER(IntKi), PARAMETER :: M2N5FAMxi = 3011 + INTEGER(IntKi), PARAMETER :: M2N6FAMxi = 3012 + INTEGER(IntKi), PARAMETER :: M2N7FAMxi = 3013 + INTEGER(IntKi), PARAMETER :: M2N8FAMxi = 3014 + INTEGER(IntKi), PARAMETER :: M2N9FAMxi = 3015 + INTEGER(IntKi), PARAMETER :: M3N1FAMxi = 3016 + INTEGER(IntKi), PARAMETER :: M3N2FAMxi = 3017 + INTEGER(IntKi), PARAMETER :: M3N3FAMxi = 3018 + INTEGER(IntKi), PARAMETER :: M3N4FAMxi = 3019 + INTEGER(IntKi), PARAMETER :: M3N5FAMxi = 3020 + INTEGER(IntKi), PARAMETER :: M3N6FAMxi = 3021 + INTEGER(IntKi), PARAMETER :: M3N7FAMxi = 3022 + INTEGER(IntKi), PARAMETER :: M3N8FAMxi = 3023 + INTEGER(IntKi), PARAMETER :: M3N9FAMxi = 3024 + INTEGER(IntKi), PARAMETER :: M4N1FAMxi = 3025 + INTEGER(IntKi), PARAMETER :: M4N2FAMxi = 3026 + INTEGER(IntKi), PARAMETER :: M4N3FAMxi = 3027 + INTEGER(IntKi), PARAMETER :: M4N4FAMxi = 3028 + INTEGER(IntKi), PARAMETER :: M4N5FAMxi = 3029 + INTEGER(IntKi), PARAMETER :: M4N6FAMxi = 3030 + INTEGER(IntKi), PARAMETER :: M4N7FAMxi = 3031 + INTEGER(IntKi), PARAMETER :: M4N8FAMxi = 3032 + INTEGER(IntKi), PARAMETER :: M4N9FAMxi = 3033 + INTEGER(IntKi), PARAMETER :: M5N1FAMxi = 3034 + INTEGER(IntKi), PARAMETER :: M5N2FAMxi = 3035 + INTEGER(IntKi), PARAMETER :: M5N3FAMxi = 3036 + INTEGER(IntKi), PARAMETER :: M5N4FAMxi = 3037 + INTEGER(IntKi), PARAMETER :: M5N5FAMxi = 3038 + INTEGER(IntKi), PARAMETER :: M5N6FAMxi = 3039 + INTEGER(IntKi), PARAMETER :: M5N7FAMxi = 3040 + INTEGER(IntKi), PARAMETER :: M5N8FAMxi = 3041 + INTEGER(IntKi), PARAMETER :: M5N9FAMxi = 3042 + INTEGER(IntKi), PARAMETER :: M6N1FAMxi = 3043 + INTEGER(IntKi), PARAMETER :: M6N2FAMxi = 3044 + INTEGER(IntKi), PARAMETER :: M6N3FAMxi = 3045 + INTEGER(IntKi), PARAMETER :: M6N4FAMxi = 3046 + INTEGER(IntKi), PARAMETER :: M6N5FAMxi = 3047 + INTEGER(IntKi), PARAMETER :: M6N6FAMxi = 3048 + INTEGER(IntKi), PARAMETER :: M6N7FAMxi = 3049 + INTEGER(IntKi), PARAMETER :: M6N8FAMxi = 3050 + INTEGER(IntKi), PARAMETER :: M6N9FAMxi = 3051 + INTEGER(IntKi), PARAMETER :: M7N1FAMxi = 3052 + INTEGER(IntKi), PARAMETER :: M7N2FAMxi = 3053 + INTEGER(IntKi), PARAMETER :: M7N3FAMxi = 3054 + INTEGER(IntKi), PARAMETER :: M7N4FAMxi = 3055 + INTEGER(IntKi), PARAMETER :: M7N5FAMxi = 3056 + INTEGER(IntKi), PARAMETER :: M7N6FAMxi = 3057 + INTEGER(IntKi), PARAMETER :: M7N7FAMxi = 3058 + INTEGER(IntKi), PARAMETER :: M7N8FAMxi = 3059 + INTEGER(IntKi), PARAMETER :: M7N9FAMxi = 3060 + INTEGER(IntKi), PARAMETER :: M8N1FAMxi = 3061 + INTEGER(IntKi), PARAMETER :: M8N2FAMxi = 3062 + INTEGER(IntKi), PARAMETER :: M8N3FAMxi = 3063 + INTEGER(IntKi), PARAMETER :: M8N4FAMxi = 3064 + INTEGER(IntKi), PARAMETER :: M8N5FAMxi = 3065 + INTEGER(IntKi), PARAMETER :: M8N6FAMxi = 3066 + INTEGER(IntKi), PARAMETER :: M8N7FAMxi = 3067 + INTEGER(IntKi), PARAMETER :: M8N8FAMxi = 3068 + INTEGER(IntKi), PARAMETER :: M8N9FAMxi = 3069 + INTEGER(IntKi), PARAMETER :: M9N1FAMxi = 3070 + INTEGER(IntKi), PARAMETER :: M9N2FAMxi = 3071 + INTEGER(IntKi), PARAMETER :: M9N3FAMxi = 3072 + INTEGER(IntKi), PARAMETER :: M9N4FAMxi = 3073 + INTEGER(IntKi), PARAMETER :: M9N5FAMxi = 3074 + INTEGER(IntKi), PARAMETER :: M9N6FAMxi = 3075 + INTEGER(IntKi), PARAMETER :: M9N7FAMxi = 3076 + INTEGER(IntKi), PARAMETER :: M9N8FAMxi = 3077 + INTEGER(IntKi), PARAMETER :: M9N9FAMxi = 3078 + INTEGER(IntKi), PARAMETER :: M1N1FAMyi = 3079 + INTEGER(IntKi), PARAMETER :: M1N2FAMyi = 3080 + INTEGER(IntKi), PARAMETER :: M1N3FAMyi = 3081 + INTEGER(IntKi), PARAMETER :: M1N4FAMyi = 3082 + INTEGER(IntKi), PARAMETER :: M1N5FAMyi = 3083 + INTEGER(IntKi), PARAMETER :: M1N6FAMyi = 3084 + INTEGER(IntKi), PARAMETER :: M1N7FAMyi = 3085 + INTEGER(IntKi), PARAMETER :: M1N8FAMyi = 3086 + INTEGER(IntKi), PARAMETER :: M1N9FAMyi = 3087 + INTEGER(IntKi), PARAMETER :: M2N1FAMyi = 3088 + INTEGER(IntKi), PARAMETER :: M2N2FAMyi = 3089 + INTEGER(IntKi), PARAMETER :: M2N3FAMyi = 3090 + INTEGER(IntKi), PARAMETER :: M2N4FAMyi = 3091 + INTEGER(IntKi), PARAMETER :: M2N5FAMyi = 3092 + INTEGER(IntKi), PARAMETER :: M2N6FAMyi = 3093 + INTEGER(IntKi), PARAMETER :: M2N7FAMyi = 3094 + INTEGER(IntKi), PARAMETER :: M2N8FAMyi = 3095 + INTEGER(IntKi), PARAMETER :: M2N9FAMyi = 3096 + INTEGER(IntKi), PARAMETER :: M3N1FAMyi = 3097 + INTEGER(IntKi), PARAMETER :: M3N2FAMyi = 3098 + INTEGER(IntKi), PARAMETER :: M3N3FAMyi = 3099 + INTEGER(IntKi), PARAMETER :: M3N4FAMyi = 3100 + INTEGER(IntKi), PARAMETER :: M3N5FAMyi = 3101 + INTEGER(IntKi), PARAMETER :: M3N6FAMyi = 3102 + INTEGER(IntKi), PARAMETER :: M3N7FAMyi = 3103 + INTEGER(IntKi), PARAMETER :: M3N8FAMyi = 3104 + INTEGER(IntKi), PARAMETER :: M3N9FAMyi = 3105 + INTEGER(IntKi), PARAMETER :: M4N1FAMyi = 3106 + INTEGER(IntKi), PARAMETER :: M4N2FAMyi = 3107 + INTEGER(IntKi), PARAMETER :: M4N3FAMyi = 3108 + INTEGER(IntKi), PARAMETER :: M4N4FAMyi = 3109 + INTEGER(IntKi), PARAMETER :: M4N5FAMyi = 3110 + INTEGER(IntKi), PARAMETER :: M4N6FAMyi = 3111 + INTEGER(IntKi), PARAMETER :: M4N7FAMyi = 3112 + INTEGER(IntKi), PARAMETER :: M4N8FAMyi = 3113 + INTEGER(IntKi), PARAMETER :: M4N9FAMyi = 3114 + INTEGER(IntKi), PARAMETER :: M5N1FAMyi = 3115 + INTEGER(IntKi), PARAMETER :: M5N2FAMyi = 3116 + INTEGER(IntKi), PARAMETER :: M5N3FAMyi = 3117 + INTEGER(IntKi), PARAMETER :: M5N4FAMyi = 3118 + INTEGER(IntKi), PARAMETER :: M5N5FAMyi = 3119 + INTEGER(IntKi), PARAMETER :: M5N6FAMyi = 3120 + INTEGER(IntKi), PARAMETER :: M5N7FAMyi = 3121 + INTEGER(IntKi), PARAMETER :: M5N8FAMyi = 3122 + INTEGER(IntKi), PARAMETER :: M5N9FAMyi = 3123 + INTEGER(IntKi), PARAMETER :: M6N1FAMyi = 3124 + INTEGER(IntKi), PARAMETER :: M6N2FAMyi = 3125 + INTEGER(IntKi), PARAMETER :: M6N3FAMyi = 3126 + INTEGER(IntKi), PARAMETER :: M6N4FAMyi = 3127 + INTEGER(IntKi), PARAMETER :: M6N5FAMyi = 3128 + INTEGER(IntKi), PARAMETER :: M6N6FAMyi = 3129 + INTEGER(IntKi), PARAMETER :: M6N7FAMyi = 3130 + INTEGER(IntKi), PARAMETER :: M6N8FAMyi = 3131 + INTEGER(IntKi), PARAMETER :: M6N9FAMyi = 3132 + INTEGER(IntKi), PARAMETER :: M7N1FAMyi = 3133 + INTEGER(IntKi), PARAMETER :: M7N2FAMyi = 3134 + INTEGER(IntKi), PARAMETER :: M7N3FAMyi = 3135 + INTEGER(IntKi), PARAMETER :: M7N4FAMyi = 3136 + INTEGER(IntKi), PARAMETER :: M7N5FAMyi = 3137 + INTEGER(IntKi), PARAMETER :: M7N6FAMyi = 3138 + INTEGER(IntKi), PARAMETER :: M7N7FAMyi = 3139 + INTEGER(IntKi), PARAMETER :: M7N8FAMyi = 3140 + INTEGER(IntKi), PARAMETER :: M7N9FAMyi = 3141 + INTEGER(IntKi), PARAMETER :: M8N1FAMyi = 3142 + INTEGER(IntKi), PARAMETER :: M8N2FAMyi = 3143 + INTEGER(IntKi), PARAMETER :: M8N3FAMyi = 3144 + INTEGER(IntKi), PARAMETER :: M8N4FAMyi = 3145 + INTEGER(IntKi), PARAMETER :: M8N5FAMyi = 3146 + INTEGER(IntKi), PARAMETER :: M8N6FAMyi = 3147 + INTEGER(IntKi), PARAMETER :: M8N7FAMyi = 3148 + INTEGER(IntKi), PARAMETER :: M8N8FAMyi = 3149 + INTEGER(IntKi), PARAMETER :: M8N9FAMyi = 3150 + INTEGER(IntKi), PARAMETER :: M9N1FAMyi = 3151 + INTEGER(IntKi), PARAMETER :: M9N2FAMyi = 3152 + INTEGER(IntKi), PARAMETER :: M9N3FAMyi = 3153 + INTEGER(IntKi), PARAMETER :: M9N4FAMyi = 3154 + INTEGER(IntKi), PARAMETER :: M9N5FAMyi = 3155 + INTEGER(IntKi), PARAMETER :: M9N6FAMyi = 3156 + INTEGER(IntKi), PARAMETER :: M9N7FAMyi = 3157 + INTEGER(IntKi), PARAMETER :: M9N8FAMyi = 3158 + INTEGER(IntKi), PARAMETER :: M9N9FAMyi = 3159 + INTEGER(IntKi), PARAMETER :: M1N1FAMzi = 3160 + INTEGER(IntKi), PARAMETER :: M1N2FAMzi = 3161 + INTEGER(IntKi), PARAMETER :: M1N3FAMzi = 3162 + INTEGER(IntKi), PARAMETER :: M1N4FAMzi = 3163 + INTEGER(IntKi), PARAMETER :: M1N5FAMzi = 3164 + INTEGER(IntKi), PARAMETER :: M1N6FAMzi = 3165 + INTEGER(IntKi), PARAMETER :: M1N7FAMzi = 3166 + INTEGER(IntKi), PARAMETER :: M1N8FAMzi = 3167 + INTEGER(IntKi), PARAMETER :: M1N9FAMzi = 3168 + INTEGER(IntKi), PARAMETER :: M2N1FAMzi = 3169 + INTEGER(IntKi), PARAMETER :: M2N2FAMzi = 3170 + INTEGER(IntKi), PARAMETER :: M2N3FAMzi = 3171 + INTEGER(IntKi), PARAMETER :: M2N4FAMzi = 3172 + INTEGER(IntKi), PARAMETER :: M2N5FAMzi = 3173 + INTEGER(IntKi), PARAMETER :: M2N6FAMzi = 3174 + INTEGER(IntKi), PARAMETER :: M2N7FAMzi = 3175 + INTEGER(IntKi), PARAMETER :: M2N8FAMzi = 3176 + INTEGER(IntKi), PARAMETER :: M2N9FAMzi = 3177 + INTEGER(IntKi), PARAMETER :: M3N1FAMzi = 3178 + INTEGER(IntKi), PARAMETER :: M3N2FAMzi = 3179 + INTEGER(IntKi), PARAMETER :: M3N3FAMzi = 3180 + INTEGER(IntKi), PARAMETER :: M3N4FAMzi = 3181 + INTEGER(IntKi), PARAMETER :: M3N5FAMzi = 3182 + INTEGER(IntKi), PARAMETER :: M3N6FAMzi = 3183 + INTEGER(IntKi), PARAMETER :: M3N7FAMzi = 3184 + INTEGER(IntKi), PARAMETER :: M3N8FAMzi = 3185 + INTEGER(IntKi), PARAMETER :: M3N9FAMzi = 3186 + INTEGER(IntKi), PARAMETER :: M4N1FAMzi = 3187 + INTEGER(IntKi), PARAMETER :: M4N2FAMzi = 3188 + INTEGER(IntKi), PARAMETER :: M4N3FAMzi = 3189 + INTEGER(IntKi), PARAMETER :: M4N4FAMzi = 3190 + INTEGER(IntKi), PARAMETER :: M4N5FAMzi = 3191 + INTEGER(IntKi), PARAMETER :: M4N6FAMzi = 3192 + INTEGER(IntKi), PARAMETER :: M4N7FAMzi = 3193 + INTEGER(IntKi), PARAMETER :: M4N8FAMzi = 3194 + INTEGER(IntKi), PARAMETER :: M4N9FAMzi = 3195 + INTEGER(IntKi), PARAMETER :: M5N1FAMzi = 3196 + INTEGER(IntKi), PARAMETER :: M5N2FAMzi = 3197 + INTEGER(IntKi), PARAMETER :: M5N3FAMzi = 3198 + INTEGER(IntKi), PARAMETER :: M5N4FAMzi = 3199 + INTEGER(IntKi), PARAMETER :: M5N5FAMzi = 3200 + INTEGER(IntKi), PARAMETER :: M5N6FAMzi = 3201 + INTEGER(IntKi), PARAMETER :: M5N7FAMzi = 3202 + INTEGER(IntKi), PARAMETER :: M5N8FAMzi = 3203 + INTEGER(IntKi), PARAMETER :: M5N9FAMzi = 3204 + INTEGER(IntKi), PARAMETER :: M6N1FAMzi = 3205 + INTEGER(IntKi), PARAMETER :: M6N2FAMzi = 3206 + INTEGER(IntKi), PARAMETER :: M6N3FAMzi = 3207 + INTEGER(IntKi), PARAMETER :: M6N4FAMzi = 3208 + INTEGER(IntKi), PARAMETER :: M6N5FAMzi = 3209 + INTEGER(IntKi), PARAMETER :: M6N6FAMzi = 3210 + INTEGER(IntKi), PARAMETER :: M6N7FAMzi = 3211 + INTEGER(IntKi), PARAMETER :: M6N8FAMzi = 3212 + INTEGER(IntKi), PARAMETER :: M6N9FAMzi = 3213 + INTEGER(IntKi), PARAMETER :: M7N1FAMzi = 3214 + INTEGER(IntKi), PARAMETER :: M7N2FAMzi = 3215 + INTEGER(IntKi), PARAMETER :: M7N3FAMzi = 3216 + INTEGER(IntKi), PARAMETER :: M7N4FAMzi = 3217 + INTEGER(IntKi), PARAMETER :: M7N5FAMzi = 3218 + INTEGER(IntKi), PARAMETER :: M7N6FAMzi = 3219 + INTEGER(IntKi), PARAMETER :: M7N7FAMzi = 3220 + INTEGER(IntKi), PARAMETER :: M7N8FAMzi = 3221 + INTEGER(IntKi), PARAMETER :: M7N9FAMzi = 3222 + INTEGER(IntKi), PARAMETER :: M8N1FAMzi = 3223 + INTEGER(IntKi), PARAMETER :: M8N2FAMzi = 3224 + INTEGER(IntKi), PARAMETER :: M8N3FAMzi = 3225 + INTEGER(IntKi), PARAMETER :: M8N4FAMzi = 3226 + INTEGER(IntKi), PARAMETER :: M8N5FAMzi = 3227 + INTEGER(IntKi), PARAMETER :: M8N6FAMzi = 3228 + INTEGER(IntKi), PARAMETER :: M8N7FAMzi = 3229 + INTEGER(IntKi), PARAMETER :: M8N8FAMzi = 3230 + INTEGER(IntKi), PARAMETER :: M8N9FAMzi = 3231 + INTEGER(IntKi), PARAMETER :: M9N1FAMzi = 3232 + INTEGER(IntKi), PARAMETER :: M9N2FAMzi = 3233 + INTEGER(IntKi), PARAMETER :: M9N3FAMzi = 3234 + INTEGER(IntKi), PARAMETER :: M9N4FAMzi = 3235 + INTEGER(IntKi), PARAMETER :: M9N5FAMzi = 3236 + INTEGER(IntKi), PARAMETER :: M9N6FAMzi = 3237 + INTEGER(IntKi), PARAMETER :: M9N7FAMzi = 3238 + INTEGER(IntKi), PARAMETER :: M9N8FAMzi = 3239 + INTEGER(IntKi), PARAMETER :: M9N9FAMzi = 3240 + INTEGER(IntKi), PARAMETER :: M1N1FAGxi = 3241 + INTEGER(IntKi), PARAMETER :: M1N2FAGxi = 3242 + INTEGER(IntKi), PARAMETER :: M1N3FAGxi = 3243 + INTEGER(IntKi), PARAMETER :: M1N4FAGxi = 3244 + INTEGER(IntKi), PARAMETER :: M1N5FAGxi = 3245 + INTEGER(IntKi), PARAMETER :: M1N6FAGxi = 3246 + INTEGER(IntKi), PARAMETER :: M1N7FAGxi = 3247 + INTEGER(IntKi), PARAMETER :: M1N8FAGxi = 3248 + INTEGER(IntKi), PARAMETER :: M1N9FAGxi = 3249 + INTEGER(IntKi), PARAMETER :: M2N1FAGxi = 3250 + INTEGER(IntKi), PARAMETER :: M2N2FAGxi = 3251 + INTEGER(IntKi), PARAMETER :: M2N3FAGxi = 3252 + INTEGER(IntKi), PARAMETER :: M2N4FAGxi = 3253 + INTEGER(IntKi), PARAMETER :: M2N5FAGxi = 3254 + INTEGER(IntKi), PARAMETER :: M2N6FAGxi = 3255 + INTEGER(IntKi), PARAMETER :: M2N7FAGxi = 3256 + INTEGER(IntKi), PARAMETER :: M2N8FAGxi = 3257 + INTEGER(IntKi), PARAMETER :: M2N9FAGxi = 3258 + INTEGER(IntKi), PARAMETER :: M3N1FAGxi = 3259 + INTEGER(IntKi), PARAMETER :: M3N2FAGxi = 3260 + INTEGER(IntKi), PARAMETER :: M3N3FAGxi = 3261 + INTEGER(IntKi), PARAMETER :: M3N4FAGxi = 3262 + INTEGER(IntKi), PARAMETER :: M3N5FAGxi = 3263 + INTEGER(IntKi), PARAMETER :: M3N6FAGxi = 3264 + INTEGER(IntKi), PARAMETER :: M3N7FAGxi = 3265 + INTEGER(IntKi), PARAMETER :: M3N8FAGxi = 3266 + INTEGER(IntKi), PARAMETER :: M3N9FAGxi = 3267 + INTEGER(IntKi), PARAMETER :: M4N1FAGxi = 3268 + INTEGER(IntKi), PARAMETER :: M4N2FAGxi = 3269 + INTEGER(IntKi), PARAMETER :: M4N3FAGxi = 3270 + INTEGER(IntKi), PARAMETER :: M4N4FAGxi = 3271 + INTEGER(IntKi), PARAMETER :: M4N5FAGxi = 3272 + INTEGER(IntKi), PARAMETER :: M4N6FAGxi = 3273 + INTEGER(IntKi), PARAMETER :: M4N7FAGxi = 3274 + INTEGER(IntKi), PARAMETER :: M4N8FAGxi = 3275 + INTEGER(IntKi), PARAMETER :: M4N9FAGxi = 3276 + INTEGER(IntKi), PARAMETER :: M5N1FAGxi = 3277 + INTEGER(IntKi), PARAMETER :: M5N2FAGxi = 3278 + INTEGER(IntKi), PARAMETER :: M5N3FAGxi = 3279 + INTEGER(IntKi), PARAMETER :: M5N4FAGxi = 3280 + INTEGER(IntKi), PARAMETER :: M5N5FAGxi = 3281 + INTEGER(IntKi), PARAMETER :: M5N6FAGxi = 3282 + INTEGER(IntKi), PARAMETER :: M5N7FAGxi = 3283 + INTEGER(IntKi), PARAMETER :: M5N8FAGxi = 3284 + INTEGER(IntKi), PARAMETER :: M5N9FAGxi = 3285 + INTEGER(IntKi), PARAMETER :: M6N1FAGxi = 3286 + INTEGER(IntKi), PARAMETER :: M6N2FAGxi = 3287 + INTEGER(IntKi), PARAMETER :: M6N3FAGxi = 3288 + INTEGER(IntKi), PARAMETER :: M6N4FAGxi = 3289 + INTEGER(IntKi), PARAMETER :: M6N5FAGxi = 3290 + INTEGER(IntKi), PARAMETER :: M6N6FAGxi = 3291 + INTEGER(IntKi), PARAMETER :: M6N7FAGxi = 3292 + INTEGER(IntKi), PARAMETER :: M6N8FAGxi = 3293 + INTEGER(IntKi), PARAMETER :: M6N9FAGxi = 3294 + INTEGER(IntKi), PARAMETER :: M7N1FAGxi = 3295 + INTEGER(IntKi), PARAMETER :: M7N2FAGxi = 3296 + INTEGER(IntKi), PARAMETER :: M7N3FAGxi = 3297 + INTEGER(IntKi), PARAMETER :: M7N4FAGxi = 3298 + INTEGER(IntKi), PARAMETER :: M7N5FAGxi = 3299 + INTEGER(IntKi), PARAMETER :: M7N6FAGxi = 3300 + INTEGER(IntKi), PARAMETER :: M7N7FAGxi = 3301 + INTEGER(IntKi), PARAMETER :: M7N8FAGxi = 3302 + INTEGER(IntKi), PARAMETER :: M7N9FAGxi = 3303 + INTEGER(IntKi), PARAMETER :: M8N1FAGxi = 3304 + INTEGER(IntKi), PARAMETER :: M8N2FAGxi = 3305 + INTEGER(IntKi), PARAMETER :: M8N3FAGxi = 3306 + INTEGER(IntKi), PARAMETER :: M8N4FAGxi = 3307 + INTEGER(IntKi), PARAMETER :: M8N5FAGxi = 3308 + INTEGER(IntKi), PARAMETER :: M8N6FAGxi = 3309 + INTEGER(IntKi), PARAMETER :: M8N7FAGxi = 3310 + INTEGER(IntKi), PARAMETER :: M8N8FAGxi = 3311 + INTEGER(IntKi), PARAMETER :: M8N9FAGxi = 3312 + INTEGER(IntKi), PARAMETER :: M9N1FAGxi = 3313 + INTEGER(IntKi), PARAMETER :: M9N2FAGxi = 3314 + INTEGER(IntKi), PARAMETER :: M9N3FAGxi = 3315 + INTEGER(IntKi), PARAMETER :: M9N4FAGxi = 3316 + INTEGER(IntKi), PARAMETER :: M9N5FAGxi = 3317 + INTEGER(IntKi), PARAMETER :: M9N6FAGxi = 3318 + INTEGER(IntKi), PARAMETER :: M9N7FAGxi = 3319 + INTEGER(IntKi), PARAMETER :: M9N8FAGxi = 3320 + INTEGER(IntKi), PARAMETER :: M9N9FAGxi = 3321 + INTEGER(IntKi), PARAMETER :: M1N1FAGyi = 3322 + INTEGER(IntKi), PARAMETER :: M1N2FAGyi = 3323 + INTEGER(IntKi), PARAMETER :: M1N3FAGyi = 3324 + INTEGER(IntKi), PARAMETER :: M1N4FAGyi = 3325 + INTEGER(IntKi), PARAMETER :: M1N5FAGyi = 3326 + INTEGER(IntKi), PARAMETER :: M1N6FAGyi = 3327 + INTEGER(IntKi), PARAMETER :: M1N7FAGyi = 3328 + INTEGER(IntKi), PARAMETER :: M1N8FAGyi = 3329 + INTEGER(IntKi), PARAMETER :: M1N9FAGyi = 3330 + INTEGER(IntKi), PARAMETER :: M2N1FAGyi = 3331 + INTEGER(IntKi), PARAMETER :: M2N2FAGyi = 3332 + INTEGER(IntKi), PARAMETER :: M2N3FAGyi = 3333 + INTEGER(IntKi), PARAMETER :: M2N4FAGyi = 3334 + INTEGER(IntKi), PARAMETER :: M2N5FAGyi = 3335 + INTEGER(IntKi), PARAMETER :: M2N6FAGyi = 3336 + INTEGER(IntKi), PARAMETER :: M2N7FAGyi = 3337 + INTEGER(IntKi), PARAMETER :: M2N8FAGyi = 3338 + INTEGER(IntKi), PARAMETER :: M2N9FAGyi = 3339 + INTEGER(IntKi), PARAMETER :: M3N1FAGyi = 3340 + INTEGER(IntKi), PARAMETER :: M3N2FAGyi = 3341 + INTEGER(IntKi), PARAMETER :: M3N3FAGyi = 3342 + INTEGER(IntKi), PARAMETER :: M3N4FAGyi = 3343 + INTEGER(IntKi), PARAMETER :: M3N5FAGyi = 3344 + INTEGER(IntKi), PARAMETER :: M3N6FAGyi = 3345 + INTEGER(IntKi), PARAMETER :: M3N7FAGyi = 3346 + INTEGER(IntKi), PARAMETER :: M3N8FAGyi = 3347 + INTEGER(IntKi), PARAMETER :: M3N9FAGyi = 3348 + INTEGER(IntKi), PARAMETER :: M4N1FAGyi = 3349 + INTEGER(IntKi), PARAMETER :: M4N2FAGyi = 3350 + INTEGER(IntKi), PARAMETER :: M4N3FAGyi = 3351 + INTEGER(IntKi), PARAMETER :: M4N4FAGyi = 3352 + INTEGER(IntKi), PARAMETER :: M4N5FAGyi = 3353 + INTEGER(IntKi), PARAMETER :: M4N6FAGyi = 3354 + INTEGER(IntKi), PARAMETER :: M4N7FAGyi = 3355 + INTEGER(IntKi), PARAMETER :: M4N8FAGyi = 3356 + INTEGER(IntKi), PARAMETER :: M4N9FAGyi = 3357 + INTEGER(IntKi), PARAMETER :: M5N1FAGyi = 3358 + INTEGER(IntKi), PARAMETER :: M5N2FAGyi = 3359 + INTEGER(IntKi), PARAMETER :: M5N3FAGyi = 3360 + INTEGER(IntKi), PARAMETER :: M5N4FAGyi = 3361 + INTEGER(IntKi), PARAMETER :: M5N5FAGyi = 3362 + INTEGER(IntKi), PARAMETER :: M5N6FAGyi = 3363 + INTEGER(IntKi), PARAMETER :: M5N7FAGyi = 3364 + INTEGER(IntKi), PARAMETER :: M5N8FAGyi = 3365 + INTEGER(IntKi), PARAMETER :: M5N9FAGyi = 3366 + INTEGER(IntKi), PARAMETER :: M6N1FAGyi = 3367 + INTEGER(IntKi), PARAMETER :: M6N2FAGyi = 3368 + INTEGER(IntKi), PARAMETER :: M6N3FAGyi = 3369 + INTEGER(IntKi), PARAMETER :: M6N4FAGyi = 3370 + INTEGER(IntKi), PARAMETER :: M6N5FAGyi = 3371 + INTEGER(IntKi), PARAMETER :: M6N6FAGyi = 3372 + INTEGER(IntKi), PARAMETER :: M6N7FAGyi = 3373 + INTEGER(IntKi), PARAMETER :: M6N8FAGyi = 3374 + INTEGER(IntKi), PARAMETER :: M6N9FAGyi = 3375 + INTEGER(IntKi), PARAMETER :: M7N1FAGyi = 3376 + INTEGER(IntKi), PARAMETER :: M7N2FAGyi = 3377 + INTEGER(IntKi), PARAMETER :: M7N3FAGyi = 3378 + INTEGER(IntKi), PARAMETER :: M7N4FAGyi = 3379 + INTEGER(IntKi), PARAMETER :: M7N5FAGyi = 3380 + INTEGER(IntKi), PARAMETER :: M7N6FAGyi = 3381 + INTEGER(IntKi), PARAMETER :: M7N7FAGyi = 3382 + INTEGER(IntKi), PARAMETER :: M7N8FAGyi = 3383 + INTEGER(IntKi), PARAMETER :: M7N9FAGyi = 3384 + INTEGER(IntKi), PARAMETER :: M8N1FAGyi = 3385 + INTEGER(IntKi), PARAMETER :: M8N2FAGyi = 3386 + INTEGER(IntKi), PARAMETER :: M8N3FAGyi = 3387 + INTEGER(IntKi), PARAMETER :: M8N4FAGyi = 3388 + INTEGER(IntKi), PARAMETER :: M8N5FAGyi = 3389 + INTEGER(IntKi), PARAMETER :: M8N6FAGyi = 3390 + INTEGER(IntKi), PARAMETER :: M8N7FAGyi = 3391 + INTEGER(IntKi), PARAMETER :: M8N8FAGyi = 3392 + INTEGER(IntKi), PARAMETER :: M8N9FAGyi = 3393 + INTEGER(IntKi), PARAMETER :: M9N1FAGyi = 3394 + INTEGER(IntKi), PARAMETER :: M9N2FAGyi = 3395 + INTEGER(IntKi), PARAMETER :: M9N3FAGyi = 3396 + INTEGER(IntKi), PARAMETER :: M9N4FAGyi = 3397 + INTEGER(IntKi), PARAMETER :: M9N5FAGyi = 3398 + INTEGER(IntKi), PARAMETER :: M9N6FAGyi = 3399 + INTEGER(IntKi), PARAMETER :: M9N7FAGyi = 3400 + INTEGER(IntKi), PARAMETER :: M9N8FAGyi = 3401 + INTEGER(IntKi), PARAMETER :: M9N9FAGyi = 3402 + INTEGER(IntKi), PARAMETER :: M1N1FAGzi = 3403 + INTEGER(IntKi), PARAMETER :: M1N2FAGzi = 3404 + INTEGER(IntKi), PARAMETER :: M1N3FAGzi = 3405 + INTEGER(IntKi), PARAMETER :: M1N4FAGzi = 3406 + INTEGER(IntKi), PARAMETER :: M1N5FAGzi = 3407 + INTEGER(IntKi), PARAMETER :: M1N6FAGzi = 3408 + INTEGER(IntKi), PARAMETER :: M1N7FAGzi = 3409 + INTEGER(IntKi), PARAMETER :: M1N8FAGzi = 3410 + INTEGER(IntKi), PARAMETER :: M1N9FAGzi = 3411 + INTEGER(IntKi), PARAMETER :: M2N1FAGzi = 3412 + INTEGER(IntKi), PARAMETER :: M2N2FAGzi = 3413 + INTEGER(IntKi), PARAMETER :: M2N3FAGzi = 3414 + INTEGER(IntKi), PARAMETER :: M2N4FAGzi = 3415 + INTEGER(IntKi), PARAMETER :: M2N5FAGzi = 3416 + INTEGER(IntKi), PARAMETER :: M2N6FAGzi = 3417 + INTEGER(IntKi), PARAMETER :: M2N7FAGzi = 3418 + INTEGER(IntKi), PARAMETER :: M2N8FAGzi = 3419 + INTEGER(IntKi), PARAMETER :: M2N9FAGzi = 3420 + INTEGER(IntKi), PARAMETER :: M3N1FAGzi = 3421 + INTEGER(IntKi), PARAMETER :: M3N2FAGzi = 3422 + INTEGER(IntKi), PARAMETER :: M3N3FAGzi = 3423 + INTEGER(IntKi), PARAMETER :: M3N4FAGzi = 3424 + INTEGER(IntKi), PARAMETER :: M3N5FAGzi = 3425 + INTEGER(IntKi), PARAMETER :: M3N6FAGzi = 3426 + INTEGER(IntKi), PARAMETER :: M3N7FAGzi = 3427 + INTEGER(IntKi), PARAMETER :: M3N8FAGzi = 3428 + INTEGER(IntKi), PARAMETER :: M3N9FAGzi = 3429 + INTEGER(IntKi), PARAMETER :: M4N1FAGzi = 3430 + INTEGER(IntKi), PARAMETER :: M4N2FAGzi = 3431 + INTEGER(IntKi), PARAMETER :: M4N3FAGzi = 3432 + INTEGER(IntKi), PARAMETER :: M4N4FAGzi = 3433 + INTEGER(IntKi), PARAMETER :: M4N5FAGzi = 3434 + INTEGER(IntKi), PARAMETER :: M4N6FAGzi = 3435 + INTEGER(IntKi), PARAMETER :: M4N7FAGzi = 3436 + INTEGER(IntKi), PARAMETER :: M4N8FAGzi = 3437 + INTEGER(IntKi), PARAMETER :: M4N9FAGzi = 3438 + INTEGER(IntKi), PARAMETER :: M5N1FAGzi = 3439 + INTEGER(IntKi), PARAMETER :: M5N2FAGzi = 3440 + INTEGER(IntKi), PARAMETER :: M5N3FAGzi = 3441 + INTEGER(IntKi), PARAMETER :: M5N4FAGzi = 3442 + INTEGER(IntKi), PARAMETER :: M5N5FAGzi = 3443 + INTEGER(IntKi), PARAMETER :: M5N6FAGzi = 3444 + INTEGER(IntKi), PARAMETER :: M5N7FAGzi = 3445 + INTEGER(IntKi), PARAMETER :: M5N8FAGzi = 3446 + INTEGER(IntKi), PARAMETER :: M5N9FAGzi = 3447 + INTEGER(IntKi), PARAMETER :: M6N1FAGzi = 3448 + INTEGER(IntKi), PARAMETER :: M6N2FAGzi = 3449 + INTEGER(IntKi), PARAMETER :: M6N3FAGzi = 3450 + INTEGER(IntKi), PARAMETER :: M6N4FAGzi = 3451 + INTEGER(IntKi), PARAMETER :: M6N5FAGzi = 3452 + INTEGER(IntKi), PARAMETER :: M6N6FAGzi = 3453 + INTEGER(IntKi), PARAMETER :: M6N7FAGzi = 3454 + INTEGER(IntKi), PARAMETER :: M6N8FAGzi = 3455 + INTEGER(IntKi), PARAMETER :: M6N9FAGzi = 3456 + INTEGER(IntKi), PARAMETER :: M7N1FAGzi = 3457 + INTEGER(IntKi), PARAMETER :: M7N2FAGzi = 3458 + INTEGER(IntKi), PARAMETER :: M7N3FAGzi = 3459 + INTEGER(IntKi), PARAMETER :: M7N4FAGzi = 3460 + INTEGER(IntKi), PARAMETER :: M7N5FAGzi = 3461 + INTEGER(IntKi), PARAMETER :: M7N6FAGzi = 3462 + INTEGER(IntKi), PARAMETER :: M7N7FAGzi = 3463 + INTEGER(IntKi), PARAMETER :: M7N8FAGzi = 3464 + INTEGER(IntKi), PARAMETER :: M7N9FAGzi = 3465 + INTEGER(IntKi), PARAMETER :: M8N1FAGzi = 3466 + INTEGER(IntKi), PARAMETER :: M8N2FAGzi = 3467 + INTEGER(IntKi), PARAMETER :: M8N3FAGzi = 3468 + INTEGER(IntKi), PARAMETER :: M8N4FAGzi = 3469 + INTEGER(IntKi), PARAMETER :: M8N5FAGzi = 3470 + INTEGER(IntKi), PARAMETER :: M8N6FAGzi = 3471 + INTEGER(IntKi), PARAMETER :: M8N7FAGzi = 3472 + INTEGER(IntKi), PARAMETER :: M8N8FAGzi = 3473 + INTEGER(IntKi), PARAMETER :: M8N9FAGzi = 3474 + INTEGER(IntKi), PARAMETER :: M9N1FAGzi = 3475 + INTEGER(IntKi), PARAMETER :: M9N2FAGzi = 3476 + INTEGER(IntKi), PARAMETER :: M9N3FAGzi = 3477 + INTEGER(IntKi), PARAMETER :: M9N4FAGzi = 3478 + INTEGER(IntKi), PARAMETER :: M9N5FAGzi = 3479 + INTEGER(IntKi), PARAMETER :: M9N6FAGzi = 3480 + INTEGER(IntKi), PARAMETER :: M9N7FAGzi = 3481 + INTEGER(IntKi), PARAMETER :: M9N8FAGzi = 3482 + INTEGER(IntKi), PARAMETER :: M9N9FAGzi = 3483 + INTEGER(IntKi), PARAMETER :: M1N1MAGxi = 3484 + INTEGER(IntKi), PARAMETER :: M1N2MAGxi = 3485 + INTEGER(IntKi), PARAMETER :: M1N3MAGxi = 3486 + INTEGER(IntKi), PARAMETER :: M1N4MAGxi = 3487 + INTEGER(IntKi), PARAMETER :: M1N5MAGxi = 3488 + INTEGER(IntKi), PARAMETER :: M1N6MAGxi = 3489 + INTEGER(IntKi), PARAMETER :: M1N7MAGxi = 3490 + INTEGER(IntKi), PARAMETER :: M1N8MAGxi = 3491 + INTEGER(IntKi), PARAMETER :: M1N9MAGxi = 3492 + INTEGER(IntKi), PARAMETER :: M2N1MAGxi = 3493 + INTEGER(IntKi), PARAMETER :: M2N2MAGxi = 3494 + INTEGER(IntKi), PARAMETER :: M2N3MAGxi = 3495 + INTEGER(IntKi), PARAMETER :: M2N4MAGxi = 3496 + INTEGER(IntKi), PARAMETER :: M2N5MAGxi = 3497 + INTEGER(IntKi), PARAMETER :: M2N6MAGxi = 3498 + INTEGER(IntKi), PARAMETER :: M2N7MAGxi = 3499 + INTEGER(IntKi), PARAMETER :: M2N8MAGxi = 3500 + INTEGER(IntKi), PARAMETER :: M2N9MAGxi = 3501 + INTEGER(IntKi), PARAMETER :: M3N1MAGxi = 3502 + INTEGER(IntKi), PARAMETER :: M3N2MAGxi = 3503 + INTEGER(IntKi), PARAMETER :: M3N3MAGxi = 3504 + INTEGER(IntKi), PARAMETER :: M3N4MAGxi = 3505 + INTEGER(IntKi), PARAMETER :: M3N5MAGxi = 3506 + INTEGER(IntKi), PARAMETER :: M3N6MAGxi = 3507 + INTEGER(IntKi), PARAMETER :: M3N7MAGxi = 3508 + INTEGER(IntKi), PARAMETER :: M3N8MAGxi = 3509 + INTEGER(IntKi), PARAMETER :: M3N9MAGxi = 3510 + INTEGER(IntKi), PARAMETER :: M4N1MAGxi = 3511 + INTEGER(IntKi), PARAMETER :: M4N2MAGxi = 3512 + INTEGER(IntKi), PARAMETER :: M4N3MAGxi = 3513 + INTEGER(IntKi), PARAMETER :: M4N4MAGxi = 3514 + INTEGER(IntKi), PARAMETER :: M4N5MAGxi = 3515 + INTEGER(IntKi), PARAMETER :: M4N6MAGxi = 3516 + INTEGER(IntKi), PARAMETER :: M4N7MAGxi = 3517 + INTEGER(IntKi), PARAMETER :: M4N8MAGxi = 3518 + INTEGER(IntKi), PARAMETER :: M4N9MAGxi = 3519 + INTEGER(IntKi), PARAMETER :: M5N1MAGxi = 3520 + INTEGER(IntKi), PARAMETER :: M5N2MAGxi = 3521 + INTEGER(IntKi), PARAMETER :: M5N3MAGxi = 3522 + INTEGER(IntKi), PARAMETER :: M5N4MAGxi = 3523 + INTEGER(IntKi), PARAMETER :: M5N5MAGxi = 3524 + INTEGER(IntKi), PARAMETER :: M5N6MAGxi = 3525 + INTEGER(IntKi), PARAMETER :: M5N7MAGxi = 3526 + INTEGER(IntKi), PARAMETER :: M5N8MAGxi = 3527 + INTEGER(IntKi), PARAMETER :: M5N9MAGxi = 3528 + INTEGER(IntKi), PARAMETER :: M6N1MAGxi = 3529 + INTEGER(IntKi), PARAMETER :: M6N2MAGxi = 3530 + INTEGER(IntKi), PARAMETER :: M6N3MAGxi = 3531 + INTEGER(IntKi), PARAMETER :: M6N4MAGxi = 3532 + INTEGER(IntKi), PARAMETER :: M6N5MAGxi = 3533 + INTEGER(IntKi), PARAMETER :: M6N6MAGxi = 3534 + INTEGER(IntKi), PARAMETER :: M6N7MAGxi = 3535 + INTEGER(IntKi), PARAMETER :: M6N8MAGxi = 3536 + INTEGER(IntKi), PARAMETER :: M6N9MAGxi = 3537 + INTEGER(IntKi), PARAMETER :: M7N1MAGxi = 3538 + INTEGER(IntKi), PARAMETER :: M7N2MAGxi = 3539 + INTEGER(IntKi), PARAMETER :: M7N3MAGxi = 3540 + INTEGER(IntKi), PARAMETER :: M7N4MAGxi = 3541 + INTEGER(IntKi), PARAMETER :: M7N5MAGxi = 3542 + INTEGER(IntKi), PARAMETER :: M7N6MAGxi = 3543 + INTEGER(IntKi), PARAMETER :: M7N7MAGxi = 3544 + INTEGER(IntKi), PARAMETER :: M7N8MAGxi = 3545 + INTEGER(IntKi), PARAMETER :: M7N9MAGxi = 3546 + INTEGER(IntKi), PARAMETER :: M8N1MAGxi = 3547 + INTEGER(IntKi), PARAMETER :: M8N2MAGxi = 3548 + INTEGER(IntKi), PARAMETER :: M8N3MAGxi = 3549 + INTEGER(IntKi), PARAMETER :: M8N4MAGxi = 3550 + INTEGER(IntKi), PARAMETER :: M8N5MAGxi = 3551 + INTEGER(IntKi), PARAMETER :: M8N6MAGxi = 3552 + INTEGER(IntKi), PARAMETER :: M8N7MAGxi = 3553 + INTEGER(IntKi), PARAMETER :: M8N8MAGxi = 3554 + INTEGER(IntKi), PARAMETER :: M8N9MAGxi = 3555 + INTEGER(IntKi), PARAMETER :: M9N1MAGxi = 3556 + INTEGER(IntKi), PARAMETER :: M9N2MAGxi = 3557 + INTEGER(IntKi), PARAMETER :: M9N3MAGxi = 3558 + INTEGER(IntKi), PARAMETER :: M9N4MAGxi = 3559 + INTEGER(IntKi), PARAMETER :: M9N5MAGxi = 3560 + INTEGER(IntKi), PARAMETER :: M9N6MAGxi = 3561 + INTEGER(IntKi), PARAMETER :: M9N7MAGxi = 3562 + INTEGER(IntKi), PARAMETER :: M9N8MAGxi = 3563 + INTEGER(IntKi), PARAMETER :: M9N9MAGxi = 3564 + INTEGER(IntKi), PARAMETER :: M1N1MAGyi = 3565 + INTEGER(IntKi), PARAMETER :: M1N2MAGyi = 3566 + INTEGER(IntKi), PARAMETER :: M1N3MAGyi = 3567 + INTEGER(IntKi), PARAMETER :: M1N4MAGyi = 3568 + INTEGER(IntKi), PARAMETER :: M1N5MAGyi = 3569 + INTEGER(IntKi), PARAMETER :: M1N6MAGyi = 3570 + INTEGER(IntKi), PARAMETER :: M1N7MAGyi = 3571 + INTEGER(IntKi), PARAMETER :: M1N8MAGyi = 3572 + INTEGER(IntKi), PARAMETER :: M1N9MAGyi = 3573 + INTEGER(IntKi), PARAMETER :: M2N1MAGyi = 3574 + INTEGER(IntKi), PARAMETER :: M2N2MAGyi = 3575 + INTEGER(IntKi), PARAMETER :: M2N3MAGyi = 3576 + INTEGER(IntKi), PARAMETER :: M2N4MAGyi = 3577 + INTEGER(IntKi), PARAMETER :: M2N5MAGyi = 3578 + INTEGER(IntKi), PARAMETER :: M2N6MAGyi = 3579 + INTEGER(IntKi), PARAMETER :: M2N7MAGyi = 3580 + INTEGER(IntKi), PARAMETER :: M2N8MAGyi = 3581 + INTEGER(IntKi), PARAMETER :: M2N9MAGyi = 3582 + INTEGER(IntKi), PARAMETER :: M3N1MAGyi = 3583 + INTEGER(IntKi), PARAMETER :: M3N2MAGyi = 3584 + INTEGER(IntKi), PARAMETER :: M3N3MAGyi = 3585 + INTEGER(IntKi), PARAMETER :: M3N4MAGyi = 3586 + INTEGER(IntKi), PARAMETER :: M3N5MAGyi = 3587 + INTEGER(IntKi), PARAMETER :: M3N6MAGyi = 3588 + INTEGER(IntKi), PARAMETER :: M3N7MAGyi = 3589 + INTEGER(IntKi), PARAMETER :: M3N8MAGyi = 3590 + INTEGER(IntKi), PARAMETER :: M3N9MAGyi = 3591 + INTEGER(IntKi), PARAMETER :: M4N1MAGyi = 3592 + INTEGER(IntKi), PARAMETER :: M4N2MAGyi = 3593 + INTEGER(IntKi), PARAMETER :: M4N3MAGyi = 3594 + INTEGER(IntKi), PARAMETER :: M4N4MAGyi = 3595 + INTEGER(IntKi), PARAMETER :: M4N5MAGyi = 3596 + INTEGER(IntKi), PARAMETER :: M4N6MAGyi = 3597 + INTEGER(IntKi), PARAMETER :: M4N7MAGyi = 3598 + INTEGER(IntKi), PARAMETER :: M4N8MAGyi = 3599 + INTEGER(IntKi), PARAMETER :: M4N9MAGyi = 3600 + INTEGER(IntKi), PARAMETER :: M5N1MAGyi = 3601 + INTEGER(IntKi), PARAMETER :: M5N2MAGyi = 3602 + INTEGER(IntKi), PARAMETER :: M5N3MAGyi = 3603 + INTEGER(IntKi), PARAMETER :: M5N4MAGyi = 3604 + INTEGER(IntKi), PARAMETER :: M5N5MAGyi = 3605 + INTEGER(IntKi), PARAMETER :: M5N6MAGyi = 3606 + INTEGER(IntKi), PARAMETER :: M5N7MAGyi = 3607 + INTEGER(IntKi), PARAMETER :: M5N8MAGyi = 3608 + INTEGER(IntKi), PARAMETER :: M5N9MAGyi = 3609 + INTEGER(IntKi), PARAMETER :: M6N1MAGyi = 3610 + INTEGER(IntKi), PARAMETER :: M6N2MAGyi = 3611 + INTEGER(IntKi), PARAMETER :: M6N3MAGyi = 3612 + INTEGER(IntKi), PARAMETER :: M6N4MAGyi = 3613 + INTEGER(IntKi), PARAMETER :: M6N5MAGyi = 3614 + INTEGER(IntKi), PARAMETER :: M6N6MAGyi = 3615 + INTEGER(IntKi), PARAMETER :: M6N7MAGyi = 3616 + INTEGER(IntKi), PARAMETER :: M6N8MAGyi = 3617 + INTEGER(IntKi), PARAMETER :: M6N9MAGyi = 3618 + INTEGER(IntKi), PARAMETER :: M7N1MAGyi = 3619 + INTEGER(IntKi), PARAMETER :: M7N2MAGyi = 3620 + INTEGER(IntKi), PARAMETER :: M7N3MAGyi = 3621 + INTEGER(IntKi), PARAMETER :: M7N4MAGyi = 3622 + INTEGER(IntKi), PARAMETER :: M7N5MAGyi = 3623 + INTEGER(IntKi), PARAMETER :: M7N6MAGyi = 3624 + INTEGER(IntKi), PARAMETER :: M7N7MAGyi = 3625 + INTEGER(IntKi), PARAMETER :: M7N8MAGyi = 3626 + INTEGER(IntKi), PARAMETER :: M7N9MAGyi = 3627 + INTEGER(IntKi), PARAMETER :: M8N1MAGyi = 3628 + INTEGER(IntKi), PARAMETER :: M8N2MAGyi = 3629 + INTEGER(IntKi), PARAMETER :: M8N3MAGyi = 3630 + INTEGER(IntKi), PARAMETER :: M8N4MAGyi = 3631 + INTEGER(IntKi), PARAMETER :: M8N5MAGyi = 3632 + INTEGER(IntKi), PARAMETER :: M8N6MAGyi = 3633 + INTEGER(IntKi), PARAMETER :: M8N7MAGyi = 3634 + INTEGER(IntKi), PARAMETER :: M8N8MAGyi = 3635 + INTEGER(IntKi), PARAMETER :: M8N9MAGyi = 3636 + INTEGER(IntKi), PARAMETER :: M9N1MAGyi = 3637 + INTEGER(IntKi), PARAMETER :: M9N2MAGyi = 3638 + INTEGER(IntKi), PARAMETER :: M9N3MAGyi = 3639 + INTEGER(IntKi), PARAMETER :: M9N4MAGyi = 3640 + INTEGER(IntKi), PARAMETER :: M9N5MAGyi = 3641 + INTEGER(IntKi), PARAMETER :: M9N6MAGyi = 3642 + INTEGER(IntKi), PARAMETER :: M9N7MAGyi = 3643 + INTEGER(IntKi), PARAMETER :: M9N8MAGyi = 3644 + INTEGER(IntKi), PARAMETER :: M9N9MAGyi = 3645 + INTEGER(IntKi), PARAMETER :: M1N1MAGzi = 3646 + INTEGER(IntKi), PARAMETER :: M1N2MAGzi = 3647 + INTEGER(IntKi), PARAMETER :: M1N3MAGzi = 3648 + INTEGER(IntKi), PARAMETER :: M1N4MAGzi = 3649 + INTEGER(IntKi), PARAMETER :: M1N5MAGzi = 3650 + INTEGER(IntKi), PARAMETER :: M1N6MAGzi = 3651 + INTEGER(IntKi), PARAMETER :: M1N7MAGzi = 3652 + INTEGER(IntKi), PARAMETER :: M1N8MAGzi = 3653 + INTEGER(IntKi), PARAMETER :: M1N9MAGzi = 3654 + INTEGER(IntKi), PARAMETER :: M2N1MAGzi = 3655 + INTEGER(IntKi), PARAMETER :: M2N2MAGzi = 3656 + INTEGER(IntKi), PARAMETER :: M2N3MAGzi = 3657 + INTEGER(IntKi), PARAMETER :: M2N4MAGzi = 3658 + INTEGER(IntKi), PARAMETER :: M2N5MAGzi = 3659 + INTEGER(IntKi), PARAMETER :: M2N6MAGzi = 3660 + INTEGER(IntKi), PARAMETER :: M2N7MAGzi = 3661 + INTEGER(IntKi), PARAMETER :: M2N8MAGzi = 3662 + INTEGER(IntKi), PARAMETER :: M2N9MAGzi = 3663 + INTEGER(IntKi), PARAMETER :: M3N1MAGzi = 3664 + INTEGER(IntKi), PARAMETER :: M3N2MAGzi = 3665 + INTEGER(IntKi), PARAMETER :: M3N3MAGzi = 3666 + INTEGER(IntKi), PARAMETER :: M3N4MAGzi = 3667 + INTEGER(IntKi), PARAMETER :: M3N5MAGzi = 3668 + INTEGER(IntKi), PARAMETER :: M3N6MAGzi = 3669 + INTEGER(IntKi), PARAMETER :: M3N7MAGzi = 3670 + INTEGER(IntKi), PARAMETER :: M3N8MAGzi = 3671 + INTEGER(IntKi), PARAMETER :: M3N9MAGzi = 3672 + INTEGER(IntKi), PARAMETER :: M4N1MAGzi = 3673 + INTEGER(IntKi), PARAMETER :: M4N2MAGzi = 3674 + INTEGER(IntKi), PARAMETER :: M4N3MAGzi = 3675 + INTEGER(IntKi), PARAMETER :: M4N4MAGzi = 3676 + INTEGER(IntKi), PARAMETER :: M4N5MAGzi = 3677 + INTEGER(IntKi), PARAMETER :: M4N6MAGzi = 3678 + INTEGER(IntKi), PARAMETER :: M4N7MAGzi = 3679 + INTEGER(IntKi), PARAMETER :: M4N8MAGzi = 3680 + INTEGER(IntKi), PARAMETER :: M4N9MAGzi = 3681 + INTEGER(IntKi), PARAMETER :: M5N1MAGzi = 3682 + INTEGER(IntKi), PARAMETER :: M5N2MAGzi = 3683 + INTEGER(IntKi), PARAMETER :: M5N3MAGzi = 3684 + INTEGER(IntKi), PARAMETER :: M5N4MAGzi = 3685 + INTEGER(IntKi), PARAMETER :: M5N5MAGzi = 3686 + INTEGER(IntKi), PARAMETER :: M5N6MAGzi = 3687 + INTEGER(IntKi), PARAMETER :: M5N7MAGzi = 3688 + INTEGER(IntKi), PARAMETER :: M5N8MAGzi = 3689 + INTEGER(IntKi), PARAMETER :: M5N9MAGzi = 3690 + INTEGER(IntKi), PARAMETER :: M6N1MAGzi = 3691 + INTEGER(IntKi), PARAMETER :: M6N2MAGzi = 3692 + INTEGER(IntKi), PARAMETER :: M6N3MAGzi = 3693 + INTEGER(IntKi), PARAMETER :: M6N4MAGzi = 3694 + INTEGER(IntKi), PARAMETER :: M6N5MAGzi = 3695 + INTEGER(IntKi), PARAMETER :: M6N6MAGzi = 3696 + INTEGER(IntKi), PARAMETER :: M6N7MAGzi = 3697 + INTEGER(IntKi), PARAMETER :: M6N8MAGzi = 3698 + INTEGER(IntKi), PARAMETER :: M6N9MAGzi = 3699 + INTEGER(IntKi), PARAMETER :: M7N1MAGzi = 3700 + INTEGER(IntKi), PARAMETER :: M7N2MAGzi = 3701 + INTEGER(IntKi), PARAMETER :: M7N3MAGzi = 3702 + INTEGER(IntKi), PARAMETER :: M7N4MAGzi = 3703 + INTEGER(IntKi), PARAMETER :: M7N5MAGzi = 3704 + INTEGER(IntKi), PARAMETER :: M7N6MAGzi = 3705 + INTEGER(IntKi), PARAMETER :: M7N7MAGzi = 3706 + INTEGER(IntKi), PARAMETER :: M7N8MAGzi = 3707 + INTEGER(IntKi), PARAMETER :: M7N9MAGzi = 3708 + INTEGER(IntKi), PARAMETER :: M8N1MAGzi = 3709 + INTEGER(IntKi), PARAMETER :: M8N2MAGzi = 3710 + INTEGER(IntKi), PARAMETER :: M8N3MAGzi = 3711 + INTEGER(IntKi), PARAMETER :: M8N4MAGzi = 3712 + INTEGER(IntKi), PARAMETER :: M8N5MAGzi = 3713 + INTEGER(IntKi), PARAMETER :: M8N6MAGzi = 3714 + INTEGER(IntKi), PARAMETER :: M8N7MAGzi = 3715 + INTEGER(IntKi), PARAMETER :: M8N8MAGzi = 3716 + INTEGER(IntKi), PARAMETER :: M8N9MAGzi = 3717 + INTEGER(IntKi), PARAMETER :: M9N1MAGzi = 3718 + INTEGER(IntKi), PARAMETER :: M9N2MAGzi = 3719 + INTEGER(IntKi), PARAMETER :: M9N3MAGzi = 3720 + INTEGER(IntKi), PARAMETER :: M9N4MAGzi = 3721 + INTEGER(IntKi), PARAMETER :: M9N5MAGzi = 3722 + INTEGER(IntKi), PARAMETER :: M9N6MAGzi = 3723 + INTEGER(IntKi), PARAMETER :: M9N7MAGzi = 3724 + INTEGER(IntKi), PARAMETER :: M9N8MAGzi = 3725 + INTEGER(IntKi), PARAMETER :: M9N9MAGzi = 3726 + INTEGER(IntKi), PARAMETER :: M1N1FAFxi = 3727 + INTEGER(IntKi), PARAMETER :: M1N2FAFxi = 3728 + INTEGER(IntKi), PARAMETER :: M1N3FAFxi = 3729 + INTEGER(IntKi), PARAMETER :: M1N4FAFxi = 3730 + INTEGER(IntKi), PARAMETER :: M1N5FAFxi = 3731 + INTEGER(IntKi), PARAMETER :: M1N6FAFxi = 3732 + INTEGER(IntKi), PARAMETER :: M1N7FAFxi = 3733 + INTEGER(IntKi), PARAMETER :: M1N8FAFxi = 3734 + INTEGER(IntKi), PARAMETER :: M1N9FAFxi = 3735 + INTEGER(IntKi), PARAMETER :: M2N1FAFxi = 3736 + INTEGER(IntKi), PARAMETER :: M2N2FAFxi = 3737 + INTEGER(IntKi), PARAMETER :: M2N3FAFxi = 3738 + INTEGER(IntKi), PARAMETER :: M2N4FAFxi = 3739 + INTEGER(IntKi), PARAMETER :: M2N5FAFxi = 3740 + INTEGER(IntKi), PARAMETER :: M2N6FAFxi = 3741 + INTEGER(IntKi), PARAMETER :: M2N7FAFxi = 3742 + INTEGER(IntKi), PARAMETER :: M2N8FAFxi = 3743 + INTEGER(IntKi), PARAMETER :: M2N9FAFxi = 3744 + INTEGER(IntKi), PARAMETER :: M3N1FAFxi = 3745 + INTEGER(IntKi), PARAMETER :: M3N2FAFxi = 3746 + INTEGER(IntKi), PARAMETER :: M3N3FAFxi = 3747 + INTEGER(IntKi), PARAMETER :: M3N4FAFxi = 3748 + INTEGER(IntKi), PARAMETER :: M3N5FAFxi = 3749 + INTEGER(IntKi), PARAMETER :: M3N6FAFxi = 3750 + INTEGER(IntKi), PARAMETER :: M3N7FAFxi = 3751 + INTEGER(IntKi), PARAMETER :: M3N8FAFxi = 3752 + INTEGER(IntKi), PARAMETER :: M3N9FAFxi = 3753 + INTEGER(IntKi), PARAMETER :: M4N1FAFxi = 3754 + INTEGER(IntKi), PARAMETER :: M4N2FAFxi = 3755 + INTEGER(IntKi), PARAMETER :: M4N3FAFxi = 3756 + INTEGER(IntKi), PARAMETER :: M4N4FAFxi = 3757 + INTEGER(IntKi), PARAMETER :: M4N5FAFxi = 3758 + INTEGER(IntKi), PARAMETER :: M4N6FAFxi = 3759 + INTEGER(IntKi), PARAMETER :: M4N7FAFxi = 3760 + INTEGER(IntKi), PARAMETER :: M4N8FAFxi = 3761 + INTEGER(IntKi), PARAMETER :: M4N9FAFxi = 3762 + INTEGER(IntKi), PARAMETER :: M5N1FAFxi = 3763 + INTEGER(IntKi), PARAMETER :: M5N2FAFxi = 3764 + INTEGER(IntKi), PARAMETER :: M5N3FAFxi = 3765 + INTEGER(IntKi), PARAMETER :: M5N4FAFxi = 3766 + INTEGER(IntKi), PARAMETER :: M5N5FAFxi = 3767 + INTEGER(IntKi), PARAMETER :: M5N6FAFxi = 3768 + INTEGER(IntKi), PARAMETER :: M5N7FAFxi = 3769 + INTEGER(IntKi), PARAMETER :: M5N8FAFxi = 3770 + INTEGER(IntKi), PARAMETER :: M5N9FAFxi = 3771 + INTEGER(IntKi), PARAMETER :: M6N1FAFxi = 3772 + INTEGER(IntKi), PARAMETER :: M6N2FAFxi = 3773 + INTEGER(IntKi), PARAMETER :: M6N3FAFxi = 3774 + INTEGER(IntKi), PARAMETER :: M6N4FAFxi = 3775 + INTEGER(IntKi), PARAMETER :: M6N5FAFxi = 3776 + INTEGER(IntKi), PARAMETER :: M6N6FAFxi = 3777 + INTEGER(IntKi), PARAMETER :: M6N7FAFxi = 3778 + INTEGER(IntKi), PARAMETER :: M6N8FAFxi = 3779 + INTEGER(IntKi), PARAMETER :: M6N9FAFxi = 3780 + INTEGER(IntKi), PARAMETER :: M7N1FAFxi = 3781 + INTEGER(IntKi), PARAMETER :: M7N2FAFxi = 3782 + INTEGER(IntKi), PARAMETER :: M7N3FAFxi = 3783 + INTEGER(IntKi), PARAMETER :: M7N4FAFxi = 3784 + INTEGER(IntKi), PARAMETER :: M7N5FAFxi = 3785 + INTEGER(IntKi), PARAMETER :: M7N6FAFxi = 3786 + INTEGER(IntKi), PARAMETER :: M7N7FAFxi = 3787 + INTEGER(IntKi), PARAMETER :: M7N8FAFxi = 3788 + INTEGER(IntKi), PARAMETER :: M7N9FAFxi = 3789 + INTEGER(IntKi), PARAMETER :: M8N1FAFxi = 3790 + INTEGER(IntKi), PARAMETER :: M8N2FAFxi = 3791 + INTEGER(IntKi), PARAMETER :: M8N3FAFxi = 3792 + INTEGER(IntKi), PARAMETER :: M8N4FAFxi = 3793 + INTEGER(IntKi), PARAMETER :: M8N5FAFxi = 3794 + INTEGER(IntKi), PARAMETER :: M8N6FAFxi = 3795 + INTEGER(IntKi), PARAMETER :: M8N7FAFxi = 3796 + INTEGER(IntKi), PARAMETER :: M8N8FAFxi = 3797 + INTEGER(IntKi), PARAMETER :: M8N9FAFxi = 3798 + INTEGER(IntKi), PARAMETER :: M9N1FAFxi = 3799 + INTEGER(IntKi), PARAMETER :: M9N2FAFxi = 3800 + INTEGER(IntKi), PARAMETER :: M9N3FAFxi = 3801 + INTEGER(IntKi), PARAMETER :: M9N4FAFxi = 3802 + INTEGER(IntKi), PARAMETER :: M9N5FAFxi = 3803 + INTEGER(IntKi), PARAMETER :: M9N6FAFxi = 3804 + INTEGER(IntKi), PARAMETER :: M9N7FAFxi = 3805 + INTEGER(IntKi), PARAMETER :: M9N8FAFxi = 3806 + INTEGER(IntKi), PARAMETER :: M9N9FAFxi = 3807 + INTEGER(IntKi), PARAMETER :: M1N1FAFyi = 3808 + INTEGER(IntKi), PARAMETER :: M1N2FAFyi = 3809 + INTEGER(IntKi), PARAMETER :: M1N3FAFyi = 3810 + INTEGER(IntKi), PARAMETER :: M1N4FAFyi = 3811 + INTEGER(IntKi), PARAMETER :: M1N5FAFyi = 3812 + INTEGER(IntKi), PARAMETER :: M1N6FAFyi = 3813 + INTEGER(IntKi), PARAMETER :: M1N7FAFyi = 3814 + INTEGER(IntKi), PARAMETER :: M1N8FAFyi = 3815 + INTEGER(IntKi), PARAMETER :: M1N9FAFyi = 3816 + INTEGER(IntKi), PARAMETER :: M2N1FAFyi = 3817 + INTEGER(IntKi), PARAMETER :: M2N2FAFyi = 3818 + INTEGER(IntKi), PARAMETER :: M2N3FAFyi = 3819 + INTEGER(IntKi), PARAMETER :: M2N4FAFyi = 3820 + INTEGER(IntKi), PARAMETER :: M2N5FAFyi = 3821 + INTEGER(IntKi), PARAMETER :: M2N6FAFyi = 3822 + INTEGER(IntKi), PARAMETER :: M2N7FAFyi = 3823 + INTEGER(IntKi), PARAMETER :: M2N8FAFyi = 3824 + INTEGER(IntKi), PARAMETER :: M2N9FAFyi = 3825 + INTEGER(IntKi), PARAMETER :: M3N1FAFyi = 3826 + INTEGER(IntKi), PARAMETER :: M3N2FAFyi = 3827 + INTEGER(IntKi), PARAMETER :: M3N3FAFyi = 3828 + INTEGER(IntKi), PARAMETER :: M3N4FAFyi = 3829 + INTEGER(IntKi), PARAMETER :: M3N5FAFyi = 3830 + INTEGER(IntKi), PARAMETER :: M3N6FAFyi = 3831 + INTEGER(IntKi), PARAMETER :: M3N7FAFyi = 3832 + INTEGER(IntKi), PARAMETER :: M3N8FAFyi = 3833 + INTEGER(IntKi), PARAMETER :: M3N9FAFyi = 3834 + INTEGER(IntKi), PARAMETER :: M4N1FAFyi = 3835 + INTEGER(IntKi), PARAMETER :: M4N2FAFyi = 3836 + INTEGER(IntKi), PARAMETER :: M4N3FAFyi = 3837 + INTEGER(IntKi), PARAMETER :: M4N4FAFyi = 3838 + INTEGER(IntKi), PARAMETER :: M4N5FAFyi = 3839 + INTEGER(IntKi), PARAMETER :: M4N6FAFyi = 3840 + INTEGER(IntKi), PARAMETER :: M4N7FAFyi = 3841 + INTEGER(IntKi), PARAMETER :: M4N8FAFyi = 3842 + INTEGER(IntKi), PARAMETER :: M4N9FAFyi = 3843 + INTEGER(IntKi), PARAMETER :: M5N1FAFyi = 3844 + INTEGER(IntKi), PARAMETER :: M5N2FAFyi = 3845 + INTEGER(IntKi), PARAMETER :: M5N3FAFyi = 3846 + INTEGER(IntKi), PARAMETER :: M5N4FAFyi = 3847 + INTEGER(IntKi), PARAMETER :: M5N5FAFyi = 3848 + INTEGER(IntKi), PARAMETER :: M5N6FAFyi = 3849 + INTEGER(IntKi), PARAMETER :: M5N7FAFyi = 3850 + INTEGER(IntKi), PARAMETER :: M5N8FAFyi = 3851 + INTEGER(IntKi), PARAMETER :: M5N9FAFyi = 3852 + INTEGER(IntKi), PARAMETER :: M6N1FAFyi = 3853 + INTEGER(IntKi), PARAMETER :: M6N2FAFyi = 3854 + INTEGER(IntKi), PARAMETER :: M6N3FAFyi = 3855 + INTEGER(IntKi), PARAMETER :: M6N4FAFyi = 3856 + INTEGER(IntKi), PARAMETER :: M6N5FAFyi = 3857 + INTEGER(IntKi), PARAMETER :: M6N6FAFyi = 3858 + INTEGER(IntKi), PARAMETER :: M6N7FAFyi = 3859 + INTEGER(IntKi), PARAMETER :: M6N8FAFyi = 3860 + INTEGER(IntKi), PARAMETER :: M6N9FAFyi = 3861 + INTEGER(IntKi), PARAMETER :: M7N1FAFyi = 3862 + INTEGER(IntKi), PARAMETER :: M7N2FAFyi = 3863 + INTEGER(IntKi), PARAMETER :: M7N3FAFyi = 3864 + INTEGER(IntKi), PARAMETER :: M7N4FAFyi = 3865 + INTEGER(IntKi), PARAMETER :: M7N5FAFyi = 3866 + INTEGER(IntKi), PARAMETER :: M7N6FAFyi = 3867 + INTEGER(IntKi), PARAMETER :: M7N7FAFyi = 3868 + INTEGER(IntKi), PARAMETER :: M7N8FAFyi = 3869 + INTEGER(IntKi), PARAMETER :: M7N9FAFyi = 3870 + INTEGER(IntKi), PARAMETER :: M8N1FAFyi = 3871 + INTEGER(IntKi), PARAMETER :: M8N2FAFyi = 3872 + INTEGER(IntKi), PARAMETER :: M8N3FAFyi = 3873 + INTEGER(IntKi), PARAMETER :: M8N4FAFyi = 3874 + INTEGER(IntKi), PARAMETER :: M8N5FAFyi = 3875 + INTEGER(IntKi), PARAMETER :: M8N6FAFyi = 3876 + INTEGER(IntKi), PARAMETER :: M8N7FAFyi = 3877 + INTEGER(IntKi), PARAMETER :: M8N8FAFyi = 3878 + INTEGER(IntKi), PARAMETER :: M8N9FAFyi = 3879 + INTEGER(IntKi), PARAMETER :: M9N1FAFyi = 3880 + INTEGER(IntKi), PARAMETER :: M9N2FAFyi = 3881 + INTEGER(IntKi), PARAMETER :: M9N3FAFyi = 3882 + INTEGER(IntKi), PARAMETER :: M9N4FAFyi = 3883 + INTEGER(IntKi), PARAMETER :: M9N5FAFyi = 3884 + INTEGER(IntKi), PARAMETER :: M9N6FAFyi = 3885 + INTEGER(IntKi), PARAMETER :: M9N7FAFyi = 3886 + INTEGER(IntKi), PARAMETER :: M9N8FAFyi = 3887 + INTEGER(IntKi), PARAMETER :: M9N9FAFyi = 3888 + INTEGER(IntKi), PARAMETER :: M1N1FAFzi = 3889 + INTEGER(IntKi), PARAMETER :: M1N2FAFzi = 3890 + INTEGER(IntKi), PARAMETER :: M1N3FAFzi = 3891 + INTEGER(IntKi), PARAMETER :: M1N4FAFzi = 3892 + INTEGER(IntKi), PARAMETER :: M1N5FAFzi = 3893 + INTEGER(IntKi), PARAMETER :: M1N6FAFzi = 3894 + INTEGER(IntKi), PARAMETER :: M1N7FAFzi = 3895 + INTEGER(IntKi), PARAMETER :: M1N8FAFzi = 3896 + INTEGER(IntKi), PARAMETER :: M1N9FAFzi = 3897 + INTEGER(IntKi), PARAMETER :: M2N1FAFzi = 3898 + INTEGER(IntKi), PARAMETER :: M2N2FAFzi = 3899 + INTEGER(IntKi), PARAMETER :: M2N3FAFzi = 3900 + INTEGER(IntKi), PARAMETER :: M2N4FAFzi = 3901 + INTEGER(IntKi), PARAMETER :: M2N5FAFzi = 3902 + INTEGER(IntKi), PARAMETER :: M2N6FAFzi = 3903 + INTEGER(IntKi), PARAMETER :: M2N7FAFzi = 3904 + INTEGER(IntKi), PARAMETER :: M2N8FAFzi = 3905 + INTEGER(IntKi), PARAMETER :: M2N9FAFzi = 3906 + INTEGER(IntKi), PARAMETER :: M3N1FAFzi = 3907 + INTEGER(IntKi), PARAMETER :: M3N2FAFzi = 3908 + INTEGER(IntKi), PARAMETER :: M3N3FAFzi = 3909 + INTEGER(IntKi), PARAMETER :: M3N4FAFzi = 3910 + INTEGER(IntKi), PARAMETER :: M3N5FAFzi = 3911 + INTEGER(IntKi), PARAMETER :: M3N6FAFzi = 3912 + INTEGER(IntKi), PARAMETER :: M3N7FAFzi = 3913 + INTEGER(IntKi), PARAMETER :: M3N8FAFzi = 3914 + INTEGER(IntKi), PARAMETER :: M3N9FAFzi = 3915 + INTEGER(IntKi), PARAMETER :: M4N1FAFzi = 3916 + INTEGER(IntKi), PARAMETER :: M4N2FAFzi = 3917 + INTEGER(IntKi), PARAMETER :: M4N3FAFzi = 3918 + INTEGER(IntKi), PARAMETER :: M4N4FAFzi = 3919 + INTEGER(IntKi), PARAMETER :: M4N5FAFzi = 3920 + INTEGER(IntKi), PARAMETER :: M4N6FAFzi = 3921 + INTEGER(IntKi), PARAMETER :: M4N7FAFzi = 3922 + INTEGER(IntKi), PARAMETER :: M4N8FAFzi = 3923 + INTEGER(IntKi), PARAMETER :: M4N9FAFzi = 3924 + INTEGER(IntKi), PARAMETER :: M5N1FAFzi = 3925 + INTEGER(IntKi), PARAMETER :: M5N2FAFzi = 3926 + INTEGER(IntKi), PARAMETER :: M5N3FAFzi = 3927 + INTEGER(IntKi), PARAMETER :: M5N4FAFzi = 3928 + INTEGER(IntKi), PARAMETER :: M5N5FAFzi = 3929 + INTEGER(IntKi), PARAMETER :: M5N6FAFzi = 3930 + INTEGER(IntKi), PARAMETER :: M5N7FAFzi = 3931 + INTEGER(IntKi), PARAMETER :: M5N8FAFzi = 3932 + INTEGER(IntKi), PARAMETER :: M5N9FAFzi = 3933 + INTEGER(IntKi), PARAMETER :: M6N1FAFzi = 3934 + INTEGER(IntKi), PARAMETER :: M6N2FAFzi = 3935 + INTEGER(IntKi), PARAMETER :: M6N3FAFzi = 3936 + INTEGER(IntKi), PARAMETER :: M6N4FAFzi = 3937 + INTEGER(IntKi), PARAMETER :: M6N5FAFzi = 3938 + INTEGER(IntKi), PARAMETER :: M6N6FAFzi = 3939 + INTEGER(IntKi), PARAMETER :: M6N7FAFzi = 3940 + INTEGER(IntKi), PARAMETER :: M6N8FAFzi = 3941 + INTEGER(IntKi), PARAMETER :: M6N9FAFzi = 3942 + INTEGER(IntKi), PARAMETER :: M7N1FAFzi = 3943 + INTEGER(IntKi), PARAMETER :: M7N2FAFzi = 3944 + INTEGER(IntKi), PARAMETER :: M7N3FAFzi = 3945 + INTEGER(IntKi), PARAMETER :: M7N4FAFzi = 3946 + INTEGER(IntKi), PARAMETER :: M7N5FAFzi = 3947 + INTEGER(IntKi), PARAMETER :: M7N6FAFzi = 3948 + INTEGER(IntKi), PARAMETER :: M7N7FAFzi = 3949 + INTEGER(IntKi), PARAMETER :: M7N8FAFzi = 3950 + INTEGER(IntKi), PARAMETER :: M7N9FAFzi = 3951 + INTEGER(IntKi), PARAMETER :: M8N1FAFzi = 3952 + INTEGER(IntKi), PARAMETER :: M8N2FAFzi = 3953 + INTEGER(IntKi), PARAMETER :: M8N3FAFzi = 3954 + INTEGER(IntKi), PARAMETER :: M8N4FAFzi = 3955 + INTEGER(IntKi), PARAMETER :: M8N5FAFzi = 3956 + INTEGER(IntKi), PARAMETER :: M8N6FAFzi = 3957 + INTEGER(IntKi), PARAMETER :: M8N7FAFzi = 3958 + INTEGER(IntKi), PARAMETER :: M8N8FAFzi = 3959 + INTEGER(IntKi), PARAMETER :: M8N9FAFzi = 3960 + INTEGER(IntKi), PARAMETER :: M9N1FAFzi = 3961 + INTEGER(IntKi), PARAMETER :: M9N2FAFzi = 3962 + INTEGER(IntKi), PARAMETER :: M9N3FAFzi = 3963 + INTEGER(IntKi), PARAMETER :: M9N4FAFzi = 3964 + INTEGER(IntKi), PARAMETER :: M9N5FAFzi = 3965 + INTEGER(IntKi), PARAMETER :: M9N6FAFzi = 3966 + INTEGER(IntKi), PARAMETER :: M9N7FAFzi = 3967 + INTEGER(IntKi), PARAMETER :: M9N8FAFzi = 3968 + INTEGER(IntKi), PARAMETER :: M9N9FAFzi = 3969 + INTEGER(IntKi), PARAMETER :: M1N1MAFxi = 3970 + INTEGER(IntKi), PARAMETER :: M1N2MAFxi = 3971 + INTEGER(IntKi), PARAMETER :: M1N3MAFxi = 3972 + INTEGER(IntKi), PARAMETER :: M1N4MAFxi = 3973 + INTEGER(IntKi), PARAMETER :: M1N5MAFxi = 3974 + INTEGER(IntKi), PARAMETER :: M1N6MAFxi = 3975 + INTEGER(IntKi), PARAMETER :: M1N7MAFxi = 3976 + INTEGER(IntKi), PARAMETER :: M1N8MAFxi = 3977 + INTEGER(IntKi), PARAMETER :: M1N9MAFxi = 3978 + INTEGER(IntKi), PARAMETER :: M2N1MAFxi = 3979 + INTEGER(IntKi), PARAMETER :: M2N2MAFxi = 3980 + INTEGER(IntKi), PARAMETER :: M2N3MAFxi = 3981 + INTEGER(IntKi), PARAMETER :: M2N4MAFxi = 3982 + INTEGER(IntKi), PARAMETER :: M2N5MAFxi = 3983 + INTEGER(IntKi), PARAMETER :: M2N6MAFxi = 3984 + INTEGER(IntKi), PARAMETER :: M2N7MAFxi = 3985 + INTEGER(IntKi), PARAMETER :: M2N8MAFxi = 3986 + INTEGER(IntKi), PARAMETER :: M2N9MAFxi = 3987 + INTEGER(IntKi), PARAMETER :: M3N1MAFxi = 3988 + INTEGER(IntKi), PARAMETER :: M3N2MAFxi = 3989 + INTEGER(IntKi), PARAMETER :: M3N3MAFxi = 3990 + INTEGER(IntKi), PARAMETER :: M3N4MAFxi = 3991 + INTEGER(IntKi), PARAMETER :: M3N5MAFxi = 3992 + INTEGER(IntKi), PARAMETER :: M3N6MAFxi = 3993 + INTEGER(IntKi), PARAMETER :: M3N7MAFxi = 3994 + INTEGER(IntKi), PARAMETER :: M3N8MAFxi = 3995 + INTEGER(IntKi), PARAMETER :: M3N9MAFxi = 3996 + INTEGER(IntKi), PARAMETER :: M4N1MAFxi = 3997 + INTEGER(IntKi), PARAMETER :: M4N2MAFxi = 3998 + INTEGER(IntKi), PARAMETER :: M4N3MAFxi = 3999 + INTEGER(IntKi), PARAMETER :: M4N4MAFxi = 4000 + INTEGER(IntKi), PARAMETER :: M4N5MAFxi = 4001 + INTEGER(IntKi), PARAMETER :: M4N6MAFxi = 4002 + INTEGER(IntKi), PARAMETER :: M4N7MAFxi = 4003 + INTEGER(IntKi), PARAMETER :: M4N8MAFxi = 4004 + INTEGER(IntKi), PARAMETER :: M4N9MAFxi = 4005 + INTEGER(IntKi), PARAMETER :: M5N1MAFxi = 4006 + INTEGER(IntKi), PARAMETER :: M5N2MAFxi = 4007 + INTEGER(IntKi), PARAMETER :: M5N3MAFxi = 4008 + INTEGER(IntKi), PARAMETER :: M5N4MAFxi = 4009 + INTEGER(IntKi), PARAMETER :: M5N5MAFxi = 4010 + INTEGER(IntKi), PARAMETER :: M5N6MAFxi = 4011 + INTEGER(IntKi), PARAMETER :: M5N7MAFxi = 4012 + INTEGER(IntKi), PARAMETER :: M5N8MAFxi = 4013 + INTEGER(IntKi), PARAMETER :: M5N9MAFxi = 4014 + INTEGER(IntKi), PARAMETER :: M6N1MAFxi = 4015 + INTEGER(IntKi), PARAMETER :: M6N2MAFxi = 4016 + INTEGER(IntKi), PARAMETER :: M6N3MAFxi = 4017 + INTEGER(IntKi), PARAMETER :: M6N4MAFxi = 4018 + INTEGER(IntKi), PARAMETER :: M6N5MAFxi = 4019 + INTEGER(IntKi), PARAMETER :: M6N6MAFxi = 4020 + INTEGER(IntKi), PARAMETER :: M6N7MAFxi = 4021 + INTEGER(IntKi), PARAMETER :: M6N8MAFxi = 4022 + INTEGER(IntKi), PARAMETER :: M6N9MAFxi = 4023 + INTEGER(IntKi), PARAMETER :: M7N1MAFxi = 4024 + INTEGER(IntKi), PARAMETER :: M7N2MAFxi = 4025 + INTEGER(IntKi), PARAMETER :: M7N3MAFxi = 4026 + INTEGER(IntKi), PARAMETER :: M7N4MAFxi = 4027 + INTEGER(IntKi), PARAMETER :: M7N5MAFxi = 4028 + INTEGER(IntKi), PARAMETER :: M7N6MAFxi = 4029 + INTEGER(IntKi), PARAMETER :: M7N7MAFxi = 4030 + INTEGER(IntKi), PARAMETER :: M7N8MAFxi = 4031 + INTEGER(IntKi), PARAMETER :: M7N9MAFxi = 4032 + INTEGER(IntKi), PARAMETER :: M8N1MAFxi = 4033 + INTEGER(IntKi), PARAMETER :: M8N2MAFxi = 4034 + INTEGER(IntKi), PARAMETER :: M8N3MAFxi = 4035 + INTEGER(IntKi), PARAMETER :: M8N4MAFxi = 4036 + INTEGER(IntKi), PARAMETER :: M8N5MAFxi = 4037 + INTEGER(IntKi), PARAMETER :: M8N6MAFxi = 4038 + INTEGER(IntKi), PARAMETER :: M8N7MAFxi = 4039 + INTEGER(IntKi), PARAMETER :: M8N8MAFxi = 4040 + INTEGER(IntKi), PARAMETER :: M8N9MAFxi = 4041 + INTEGER(IntKi), PARAMETER :: M9N1MAFxi = 4042 + INTEGER(IntKi), PARAMETER :: M9N2MAFxi = 4043 + INTEGER(IntKi), PARAMETER :: M9N3MAFxi = 4044 + INTEGER(IntKi), PARAMETER :: M9N4MAFxi = 4045 + INTEGER(IntKi), PARAMETER :: M9N5MAFxi = 4046 + INTEGER(IntKi), PARAMETER :: M9N6MAFxi = 4047 + INTEGER(IntKi), PARAMETER :: M9N7MAFxi = 4048 + INTEGER(IntKi), PARAMETER :: M9N8MAFxi = 4049 + INTEGER(IntKi), PARAMETER :: M9N9MAFxi = 4050 + INTEGER(IntKi), PARAMETER :: M1N1MAFyi = 4051 + INTEGER(IntKi), PARAMETER :: M1N2MAFyi = 4052 + INTEGER(IntKi), PARAMETER :: M1N3MAFyi = 4053 + INTEGER(IntKi), PARAMETER :: M1N4MAFyi = 4054 + INTEGER(IntKi), PARAMETER :: M1N5MAFyi = 4055 + INTEGER(IntKi), PARAMETER :: M1N6MAFyi = 4056 + INTEGER(IntKi), PARAMETER :: M1N7MAFyi = 4057 + INTEGER(IntKi), PARAMETER :: M1N8MAFyi = 4058 + INTEGER(IntKi), PARAMETER :: M1N9MAFyi = 4059 + INTEGER(IntKi), PARAMETER :: M2N1MAFyi = 4060 + INTEGER(IntKi), PARAMETER :: M2N2MAFyi = 4061 + INTEGER(IntKi), PARAMETER :: M2N3MAFyi = 4062 + INTEGER(IntKi), PARAMETER :: M2N4MAFyi = 4063 + INTEGER(IntKi), PARAMETER :: M2N5MAFyi = 4064 + INTEGER(IntKi), PARAMETER :: M2N6MAFyi = 4065 + INTEGER(IntKi), PARAMETER :: M2N7MAFyi = 4066 + INTEGER(IntKi), PARAMETER :: M2N8MAFyi = 4067 + INTEGER(IntKi), PARAMETER :: M2N9MAFyi = 4068 + INTEGER(IntKi), PARAMETER :: M3N1MAFyi = 4069 + INTEGER(IntKi), PARAMETER :: M3N2MAFyi = 4070 + INTEGER(IntKi), PARAMETER :: M3N3MAFyi = 4071 + INTEGER(IntKi), PARAMETER :: M3N4MAFyi = 4072 + INTEGER(IntKi), PARAMETER :: M3N5MAFyi = 4073 + INTEGER(IntKi), PARAMETER :: M3N6MAFyi = 4074 + INTEGER(IntKi), PARAMETER :: M3N7MAFyi = 4075 + INTEGER(IntKi), PARAMETER :: M3N8MAFyi = 4076 + INTEGER(IntKi), PARAMETER :: M3N9MAFyi = 4077 + INTEGER(IntKi), PARAMETER :: M4N1MAFyi = 4078 + INTEGER(IntKi), PARAMETER :: M4N2MAFyi = 4079 + INTEGER(IntKi), PARAMETER :: M4N3MAFyi = 4080 + INTEGER(IntKi), PARAMETER :: M4N4MAFyi = 4081 + INTEGER(IntKi), PARAMETER :: M4N5MAFyi = 4082 + INTEGER(IntKi), PARAMETER :: M4N6MAFyi = 4083 + INTEGER(IntKi), PARAMETER :: M4N7MAFyi = 4084 + INTEGER(IntKi), PARAMETER :: M4N8MAFyi = 4085 + INTEGER(IntKi), PARAMETER :: M4N9MAFyi = 4086 + INTEGER(IntKi), PARAMETER :: M5N1MAFyi = 4087 + INTEGER(IntKi), PARAMETER :: M5N2MAFyi = 4088 + INTEGER(IntKi), PARAMETER :: M5N3MAFyi = 4089 + INTEGER(IntKi), PARAMETER :: M5N4MAFyi = 4090 + INTEGER(IntKi), PARAMETER :: M5N5MAFyi = 4091 + INTEGER(IntKi), PARAMETER :: M5N6MAFyi = 4092 + INTEGER(IntKi), PARAMETER :: M5N7MAFyi = 4093 + INTEGER(IntKi), PARAMETER :: M5N8MAFyi = 4094 + INTEGER(IntKi), PARAMETER :: M5N9MAFyi = 4095 + INTEGER(IntKi), PARAMETER :: M6N1MAFyi = 4096 + INTEGER(IntKi), PARAMETER :: M6N2MAFyi = 4097 + INTEGER(IntKi), PARAMETER :: M6N3MAFyi = 4098 + INTEGER(IntKi), PARAMETER :: M6N4MAFyi = 4099 + INTEGER(IntKi), PARAMETER :: M6N5MAFyi = 4100 + INTEGER(IntKi), PARAMETER :: M6N6MAFyi = 4101 + INTEGER(IntKi), PARAMETER :: M6N7MAFyi = 4102 + INTEGER(IntKi), PARAMETER :: M6N8MAFyi = 4103 + INTEGER(IntKi), PARAMETER :: M6N9MAFyi = 4104 + INTEGER(IntKi), PARAMETER :: M7N1MAFyi = 4105 + INTEGER(IntKi), PARAMETER :: M7N2MAFyi = 4106 + INTEGER(IntKi), PARAMETER :: M7N3MAFyi = 4107 + INTEGER(IntKi), PARAMETER :: M7N4MAFyi = 4108 + INTEGER(IntKi), PARAMETER :: M7N5MAFyi = 4109 + INTEGER(IntKi), PARAMETER :: M7N6MAFyi = 4110 + INTEGER(IntKi), PARAMETER :: M7N7MAFyi = 4111 + INTEGER(IntKi), PARAMETER :: M7N8MAFyi = 4112 + INTEGER(IntKi), PARAMETER :: M7N9MAFyi = 4113 + INTEGER(IntKi), PARAMETER :: M8N1MAFyi = 4114 + INTEGER(IntKi), PARAMETER :: M8N2MAFyi = 4115 + INTEGER(IntKi), PARAMETER :: M8N3MAFyi = 4116 + INTEGER(IntKi), PARAMETER :: M8N4MAFyi = 4117 + INTEGER(IntKi), PARAMETER :: M8N5MAFyi = 4118 + INTEGER(IntKi), PARAMETER :: M8N6MAFyi = 4119 + INTEGER(IntKi), PARAMETER :: M8N7MAFyi = 4120 + INTEGER(IntKi), PARAMETER :: M8N8MAFyi = 4121 + INTEGER(IntKi), PARAMETER :: M8N9MAFyi = 4122 + INTEGER(IntKi), PARAMETER :: M9N1MAFyi = 4123 + INTEGER(IntKi), PARAMETER :: M9N2MAFyi = 4124 + INTEGER(IntKi), PARAMETER :: M9N3MAFyi = 4125 + INTEGER(IntKi), PARAMETER :: M9N4MAFyi = 4126 + INTEGER(IntKi), PARAMETER :: M9N5MAFyi = 4127 + INTEGER(IntKi), PARAMETER :: M9N6MAFyi = 4128 + INTEGER(IntKi), PARAMETER :: M9N7MAFyi = 4129 + INTEGER(IntKi), PARAMETER :: M9N8MAFyi = 4130 + INTEGER(IntKi), PARAMETER :: M9N9MAFyi = 4131 + INTEGER(IntKi), PARAMETER :: M1N1MAFzi = 4132 + INTEGER(IntKi), PARAMETER :: M1N2MAFzi = 4133 + INTEGER(IntKi), PARAMETER :: M1N3MAFzi = 4134 + INTEGER(IntKi), PARAMETER :: M1N4MAFzi = 4135 + INTEGER(IntKi), PARAMETER :: M1N5MAFzi = 4136 + INTEGER(IntKi), PARAMETER :: M1N6MAFzi = 4137 + INTEGER(IntKi), PARAMETER :: M1N7MAFzi = 4138 + INTEGER(IntKi), PARAMETER :: M1N8MAFzi = 4139 + INTEGER(IntKi), PARAMETER :: M1N9MAFzi = 4140 + INTEGER(IntKi), PARAMETER :: M2N1MAFzi = 4141 + INTEGER(IntKi), PARAMETER :: M2N2MAFzi = 4142 + INTEGER(IntKi), PARAMETER :: M2N3MAFzi = 4143 + INTEGER(IntKi), PARAMETER :: M2N4MAFzi = 4144 + INTEGER(IntKi), PARAMETER :: M2N5MAFzi = 4145 + INTEGER(IntKi), PARAMETER :: M2N6MAFzi = 4146 + INTEGER(IntKi), PARAMETER :: M2N7MAFzi = 4147 + INTEGER(IntKi), PARAMETER :: M2N8MAFzi = 4148 + INTEGER(IntKi), PARAMETER :: M2N9MAFzi = 4149 + INTEGER(IntKi), PARAMETER :: M3N1MAFzi = 4150 + INTEGER(IntKi), PARAMETER :: M3N2MAFzi = 4151 + INTEGER(IntKi), PARAMETER :: M3N3MAFzi = 4152 + INTEGER(IntKi), PARAMETER :: M3N4MAFzi = 4153 + INTEGER(IntKi), PARAMETER :: M3N5MAFzi = 4154 + INTEGER(IntKi), PARAMETER :: M3N6MAFzi = 4155 + INTEGER(IntKi), PARAMETER :: M3N7MAFzi = 4156 + INTEGER(IntKi), PARAMETER :: M3N8MAFzi = 4157 + INTEGER(IntKi), PARAMETER :: M3N9MAFzi = 4158 + INTEGER(IntKi), PARAMETER :: M4N1MAFzi = 4159 + INTEGER(IntKi), PARAMETER :: M4N2MAFzi = 4160 + INTEGER(IntKi), PARAMETER :: M4N3MAFzi = 4161 + INTEGER(IntKi), PARAMETER :: M4N4MAFzi = 4162 + INTEGER(IntKi), PARAMETER :: M4N5MAFzi = 4163 + INTEGER(IntKi), PARAMETER :: M4N6MAFzi = 4164 + INTEGER(IntKi), PARAMETER :: M4N7MAFzi = 4165 + INTEGER(IntKi), PARAMETER :: M4N8MAFzi = 4166 + INTEGER(IntKi), PARAMETER :: M4N9MAFzi = 4167 + INTEGER(IntKi), PARAMETER :: M5N1MAFzi = 4168 + INTEGER(IntKi), PARAMETER :: M5N2MAFzi = 4169 + INTEGER(IntKi), PARAMETER :: M5N3MAFzi = 4170 + INTEGER(IntKi), PARAMETER :: M5N4MAFzi = 4171 + INTEGER(IntKi), PARAMETER :: M5N5MAFzi = 4172 + INTEGER(IntKi), PARAMETER :: M5N6MAFzi = 4173 + INTEGER(IntKi), PARAMETER :: M5N7MAFzi = 4174 + INTEGER(IntKi), PARAMETER :: M5N8MAFzi = 4175 + INTEGER(IntKi), PARAMETER :: M5N9MAFzi = 4176 + INTEGER(IntKi), PARAMETER :: M6N1MAFzi = 4177 + INTEGER(IntKi), PARAMETER :: M6N2MAFzi = 4178 + INTEGER(IntKi), PARAMETER :: M6N3MAFzi = 4179 + INTEGER(IntKi), PARAMETER :: M6N4MAFzi = 4180 + INTEGER(IntKi), PARAMETER :: M6N5MAFzi = 4181 + INTEGER(IntKi), PARAMETER :: M6N6MAFzi = 4182 + INTEGER(IntKi), PARAMETER :: M6N7MAFzi = 4183 + INTEGER(IntKi), PARAMETER :: M6N8MAFzi = 4184 + INTEGER(IntKi), PARAMETER :: M6N9MAFzi = 4185 + INTEGER(IntKi), PARAMETER :: M7N1MAFzi = 4186 + INTEGER(IntKi), PARAMETER :: M7N2MAFzi = 4187 + INTEGER(IntKi), PARAMETER :: M7N3MAFzi = 4188 + INTEGER(IntKi), PARAMETER :: M7N4MAFzi = 4189 + INTEGER(IntKi), PARAMETER :: M7N5MAFzi = 4190 + INTEGER(IntKi), PARAMETER :: M7N6MAFzi = 4191 + INTEGER(IntKi), PARAMETER :: M7N7MAFzi = 4192 + INTEGER(IntKi), PARAMETER :: M7N8MAFzi = 4193 + INTEGER(IntKi), PARAMETER :: M7N9MAFzi = 4194 + INTEGER(IntKi), PARAMETER :: M8N1MAFzi = 4195 + INTEGER(IntKi), PARAMETER :: M8N2MAFzi = 4196 + INTEGER(IntKi), PARAMETER :: M8N3MAFzi = 4197 + INTEGER(IntKi), PARAMETER :: M8N4MAFzi = 4198 + INTEGER(IntKi), PARAMETER :: M8N5MAFzi = 4199 + INTEGER(IntKi), PARAMETER :: M8N6MAFzi = 4200 + INTEGER(IntKi), PARAMETER :: M8N7MAFzi = 4201 + INTEGER(IntKi), PARAMETER :: M8N8MAFzi = 4202 + INTEGER(IntKi), PARAMETER :: M8N9MAFzi = 4203 + INTEGER(IntKi), PARAMETER :: M9N1MAFzi = 4204 + INTEGER(IntKi), PARAMETER :: M9N2MAFzi = 4205 + INTEGER(IntKi), PARAMETER :: M9N3MAFzi = 4206 + INTEGER(IntKi), PARAMETER :: M9N4MAFzi = 4207 + INTEGER(IntKi), PARAMETER :: M9N5MAFzi = 4208 + INTEGER(IntKi), PARAMETER :: M9N6MAFzi = 4209 + INTEGER(IntKi), PARAMETER :: M9N7MAFzi = 4210 + INTEGER(IntKi), PARAMETER :: M9N8MAFzi = 4211 + INTEGER(IntKi), PARAMETER :: M9N9MAFzi = 4212 - ! Joint-level Wave Kinematics : + ! Joint-level Wave Kinematics: - INTEGER(IntKi), PARAMETER :: J1Vxi = 4213 - INTEGER(IntKi), PARAMETER :: J2Vxi = 4214 - INTEGER(IntKi), PARAMETER :: J3Vxi = 4215 - INTEGER(IntKi), PARAMETER :: J4Vxi = 4216 - INTEGER(IntKi), PARAMETER :: J5Vxi = 4217 - INTEGER(IntKi), PARAMETER :: J6Vxi = 4218 - INTEGER(IntKi), PARAMETER :: J7Vxi = 4219 - INTEGER(IntKi), PARAMETER :: J8Vxi = 4220 - INTEGER(IntKi), PARAMETER :: J9Vxi = 4221 - INTEGER(IntKi), PARAMETER :: J1Vyi = 4222 - INTEGER(IntKi), PARAMETER :: J2Vyi = 4223 - INTEGER(IntKi), PARAMETER :: J3Vyi = 4224 - INTEGER(IntKi), PARAMETER :: J4Vyi = 4225 - INTEGER(IntKi), PARAMETER :: J5Vyi = 4226 - INTEGER(IntKi), PARAMETER :: J6Vyi = 4227 - INTEGER(IntKi), PARAMETER :: J7Vyi = 4228 - INTEGER(IntKi), PARAMETER :: J8Vyi = 4229 - INTEGER(IntKi), PARAMETER :: J9Vyi = 4230 - INTEGER(IntKi), PARAMETER :: J1Vzi = 4231 - INTEGER(IntKi), PARAMETER :: J2Vzi = 4232 - INTEGER(IntKi), PARAMETER :: J3Vzi = 4233 - INTEGER(IntKi), PARAMETER :: J4Vzi = 4234 - INTEGER(IntKi), PARAMETER :: J5Vzi = 4235 - INTEGER(IntKi), PARAMETER :: J6Vzi = 4236 - INTEGER(IntKi), PARAMETER :: J7Vzi = 4237 - INTEGER(IntKi), PARAMETER :: J8Vzi = 4238 - INTEGER(IntKi), PARAMETER :: J9Vzi = 4239 - INTEGER(IntKi), PARAMETER :: J1Axi = 4240 - INTEGER(IntKi), PARAMETER :: J2Axi = 4241 - INTEGER(IntKi), PARAMETER :: J3Axi = 4242 - INTEGER(IntKi), PARAMETER :: J4Axi = 4243 - INTEGER(IntKi), PARAMETER :: J5Axi = 4244 - INTEGER(IntKi), PARAMETER :: J6Axi = 4245 - INTEGER(IntKi), PARAMETER :: J7Axi = 4246 - INTEGER(IntKi), PARAMETER :: J8Axi = 4247 - INTEGER(IntKi), PARAMETER :: J9Axi = 4248 - INTEGER(IntKi), PARAMETER :: J1Ayi = 4249 - INTEGER(IntKi), PARAMETER :: J2Ayi = 4250 - INTEGER(IntKi), PARAMETER :: J3Ayi = 4251 - INTEGER(IntKi), PARAMETER :: J4Ayi = 4252 - INTEGER(IntKi), PARAMETER :: J5Ayi = 4253 - INTEGER(IntKi), PARAMETER :: J6Ayi = 4254 - INTEGER(IntKi), PARAMETER :: J7Ayi = 4255 - INTEGER(IntKi), PARAMETER :: J8Ayi = 4256 - INTEGER(IntKi), PARAMETER :: J9Ayi = 4257 - INTEGER(IntKi), PARAMETER :: J1Azi = 4258 - INTEGER(IntKi), PARAMETER :: J2Azi = 4259 - INTEGER(IntKi), PARAMETER :: J3Azi = 4260 - INTEGER(IntKi), PARAMETER :: J4Azi = 4261 - INTEGER(IntKi), PARAMETER :: J5Azi = 4262 - INTEGER(IntKi), PARAMETER :: J6Azi = 4263 - INTEGER(IntKi), PARAMETER :: J7Azi = 4264 - INTEGER(IntKi), PARAMETER :: J8Azi = 4265 - INTEGER(IntKi), PARAMETER :: J9Azi = 4266 - INTEGER(IntKi), PARAMETER :: J1DynP = 4267 - INTEGER(IntKi), PARAMETER :: J2DynP = 4268 - INTEGER(IntKi), PARAMETER :: J3DynP = 4269 - INTEGER(IntKi), PARAMETER :: J4DynP = 4270 - INTEGER(IntKi), PARAMETER :: J5DynP = 4271 - INTEGER(IntKi), PARAMETER :: J6DynP = 4272 - INTEGER(IntKi), PARAMETER :: J7DynP = 4273 - INTEGER(IntKi), PARAMETER :: J8DynP = 4274 - INTEGER(IntKi), PARAMETER :: J9DynP = 4275 - INTEGER(IntKi), PARAMETER :: J1STVxi = 4276 - INTEGER(IntKi), PARAMETER :: J2STVxi = 4277 - INTEGER(IntKi), PARAMETER :: J3STVxi = 4278 - INTEGER(IntKi), PARAMETER :: J4STVxi = 4279 - INTEGER(IntKi), PARAMETER :: J5STVxi = 4280 - INTEGER(IntKi), PARAMETER :: J6STVxi = 4281 - INTEGER(IntKi), PARAMETER :: J7STVxi = 4282 - INTEGER(IntKi), PARAMETER :: J8STVxi = 4283 - INTEGER(IntKi), PARAMETER :: J9STVxi = 4284 - INTEGER(IntKi), PARAMETER :: J1STVyi = 4285 - INTEGER(IntKi), PARAMETER :: J2STVyi = 4286 - INTEGER(IntKi), PARAMETER :: J3STVyi = 4287 - INTEGER(IntKi), PARAMETER :: J4STVyi = 4288 - INTEGER(IntKi), PARAMETER :: J5STVyi = 4289 - INTEGER(IntKi), PARAMETER :: J6STVyi = 4290 - INTEGER(IntKi), PARAMETER :: J7STVyi = 4291 - INTEGER(IntKi), PARAMETER :: J8STVyi = 4292 - INTEGER(IntKi), PARAMETER :: J9STVyi = 4293 - INTEGER(IntKi), PARAMETER :: J1STVzi = 4294 - INTEGER(IntKi), PARAMETER :: J2STVzi = 4295 - INTEGER(IntKi), PARAMETER :: J3STVzi = 4296 - INTEGER(IntKi), PARAMETER :: J4STVzi = 4297 - INTEGER(IntKi), PARAMETER :: J5STVzi = 4298 - INTEGER(IntKi), PARAMETER :: J6STVzi = 4299 - INTEGER(IntKi), PARAMETER :: J7STVzi = 4300 - INTEGER(IntKi), PARAMETER :: J8STVzi = 4301 - INTEGER(IntKi), PARAMETER :: J9STVzi = 4302 - INTEGER(IntKi), PARAMETER :: J1STAxi = 4303 - INTEGER(IntKi), PARAMETER :: J2STAxi = 4304 - INTEGER(IntKi), PARAMETER :: J3STAxi = 4305 - INTEGER(IntKi), PARAMETER :: J4STAxi = 4306 - INTEGER(IntKi), PARAMETER :: J5STAxi = 4307 - INTEGER(IntKi), PARAMETER :: J6STAxi = 4308 - INTEGER(IntKi), PARAMETER :: J7STAxi = 4309 - INTEGER(IntKi), PARAMETER :: J8STAxi = 4310 - INTEGER(IntKi), PARAMETER :: J9STAxi = 4311 - INTEGER(IntKi), PARAMETER :: J1STAyi = 4312 - INTEGER(IntKi), PARAMETER :: J2STAyi = 4313 - INTEGER(IntKi), PARAMETER :: J3STAyi = 4314 - INTEGER(IntKi), PARAMETER :: J4STAyi = 4315 - INTEGER(IntKi), PARAMETER :: J5STAyi = 4316 - INTEGER(IntKi), PARAMETER :: J6STAyi = 4317 - INTEGER(IntKi), PARAMETER :: J7STAyi = 4318 - INTEGER(IntKi), PARAMETER :: J8STAyi = 4319 - INTEGER(IntKi), PARAMETER :: J9STAyi = 4320 - INTEGER(IntKi), PARAMETER :: J1STAzi = 4321 - INTEGER(IntKi), PARAMETER :: J2STAzi = 4322 - INTEGER(IntKi), PARAMETER :: J3STAzi = 4323 - INTEGER(IntKi), PARAMETER :: J4STAzi = 4324 - INTEGER(IntKi), PARAMETER :: J5STAzi = 4325 - INTEGER(IntKi), PARAMETER :: J6STAzi = 4326 - INTEGER(IntKi), PARAMETER :: J7STAzi = 4327 - INTEGER(IntKi), PARAMETER :: J8STAzi = 4328 - INTEGER(IntKi), PARAMETER :: J9STAzi = 4329 + INTEGER(IntKi), PARAMETER :: J1Vxi = 4213 + INTEGER(IntKi), PARAMETER :: J2Vxi = 4214 + INTEGER(IntKi), PARAMETER :: J3Vxi = 4215 + INTEGER(IntKi), PARAMETER :: J4Vxi = 4216 + INTEGER(IntKi), PARAMETER :: J5Vxi = 4217 + INTEGER(IntKi), PARAMETER :: J6Vxi = 4218 + INTEGER(IntKi), PARAMETER :: J7Vxi = 4219 + INTEGER(IntKi), PARAMETER :: J8Vxi = 4220 + INTEGER(IntKi), PARAMETER :: J9Vxi = 4221 + INTEGER(IntKi), PARAMETER :: J1Vyi = 4222 + INTEGER(IntKi), PARAMETER :: J2Vyi = 4223 + INTEGER(IntKi), PARAMETER :: J3Vyi = 4224 + INTEGER(IntKi), PARAMETER :: J4Vyi = 4225 + INTEGER(IntKi), PARAMETER :: J5Vyi = 4226 + INTEGER(IntKi), PARAMETER :: J6Vyi = 4227 + INTEGER(IntKi), PARAMETER :: J7Vyi = 4228 + INTEGER(IntKi), PARAMETER :: J8Vyi = 4229 + INTEGER(IntKi), PARAMETER :: J9Vyi = 4230 + INTEGER(IntKi), PARAMETER :: J1Vzi = 4231 + INTEGER(IntKi), PARAMETER :: J2Vzi = 4232 + INTEGER(IntKi), PARAMETER :: J3Vzi = 4233 + INTEGER(IntKi), PARAMETER :: J4Vzi = 4234 + INTEGER(IntKi), PARAMETER :: J5Vzi = 4235 + INTEGER(IntKi), PARAMETER :: J6Vzi = 4236 + INTEGER(IntKi), PARAMETER :: J7Vzi = 4237 + INTEGER(IntKi), PARAMETER :: J8Vzi = 4238 + INTEGER(IntKi), PARAMETER :: J9Vzi = 4239 + INTEGER(IntKi), PARAMETER :: J1Axi = 4240 + INTEGER(IntKi), PARAMETER :: J2Axi = 4241 + INTEGER(IntKi), PARAMETER :: J3Axi = 4242 + INTEGER(IntKi), PARAMETER :: J4Axi = 4243 + INTEGER(IntKi), PARAMETER :: J5Axi = 4244 + INTEGER(IntKi), PARAMETER :: J6Axi = 4245 + INTEGER(IntKi), PARAMETER :: J7Axi = 4246 + INTEGER(IntKi), PARAMETER :: J8Axi = 4247 + INTEGER(IntKi), PARAMETER :: J9Axi = 4248 + INTEGER(IntKi), PARAMETER :: J1Ayi = 4249 + INTEGER(IntKi), PARAMETER :: J2Ayi = 4250 + INTEGER(IntKi), PARAMETER :: J3Ayi = 4251 + INTEGER(IntKi), PARAMETER :: J4Ayi = 4252 + INTEGER(IntKi), PARAMETER :: J5Ayi = 4253 + INTEGER(IntKi), PARAMETER :: J6Ayi = 4254 + INTEGER(IntKi), PARAMETER :: J7Ayi = 4255 + INTEGER(IntKi), PARAMETER :: J8Ayi = 4256 + INTEGER(IntKi), PARAMETER :: J9Ayi = 4257 + INTEGER(IntKi), PARAMETER :: J1Azi = 4258 + INTEGER(IntKi), PARAMETER :: J2Azi = 4259 + INTEGER(IntKi), PARAMETER :: J3Azi = 4260 + INTEGER(IntKi), PARAMETER :: J4Azi = 4261 + INTEGER(IntKi), PARAMETER :: J5Azi = 4262 + INTEGER(IntKi), PARAMETER :: J6Azi = 4263 + INTEGER(IntKi), PARAMETER :: J7Azi = 4264 + INTEGER(IntKi), PARAMETER :: J8Azi = 4265 + INTEGER(IntKi), PARAMETER :: J9Azi = 4266 + INTEGER(IntKi), PARAMETER :: J1DynP = 4267 + INTEGER(IntKi), PARAMETER :: J2DynP = 4268 + INTEGER(IntKi), PARAMETER :: J3DynP = 4269 + INTEGER(IntKi), PARAMETER :: J4DynP = 4270 + INTEGER(IntKi), PARAMETER :: J5DynP = 4271 + INTEGER(IntKi), PARAMETER :: J6DynP = 4272 + INTEGER(IntKi), PARAMETER :: J7DynP = 4273 + INTEGER(IntKi), PARAMETER :: J8DynP = 4274 + INTEGER(IntKi), PARAMETER :: J9DynP = 4275 + INTEGER(IntKi), PARAMETER :: J1WaveElev = 4276 + INTEGER(IntKi), PARAMETER :: J2WaveElev = 4277 + INTEGER(IntKi), PARAMETER :: J3WaveElev = 4278 + INTEGER(IntKi), PARAMETER :: J4WaveElev = 4279 + INTEGER(IntKi), PARAMETER :: J5WaveElev = 4280 + INTEGER(IntKi), PARAMETER :: J6WaveElev = 4281 + INTEGER(IntKi), PARAMETER :: J7WaveElev = 4282 + INTEGER(IntKi), PARAMETER :: J8WaveElev = 4283 + INTEGER(IntKi), PARAMETER :: J9WaveElev = 4284 + INTEGER(IntKi), PARAMETER :: J1WaveElv1 = 4285 + INTEGER(IntKi), PARAMETER :: J2WaveElv1 = 4286 + INTEGER(IntKi), PARAMETER :: J3WaveElv1 = 4287 + INTEGER(IntKi), PARAMETER :: J4WaveElv1 = 4288 + INTEGER(IntKi), PARAMETER :: J5WaveElv1 = 4289 + INTEGER(IntKi), PARAMETER :: J6WaveElv1 = 4290 + INTEGER(IntKi), PARAMETER :: J7WaveElv1 = 4291 + INTEGER(IntKi), PARAMETER :: J8WaveElv1 = 4292 + INTEGER(IntKi), PARAMETER :: J9WaveElv1 = 4293 + INTEGER(IntKi), PARAMETER :: J1WaveElv2 = 4294 + INTEGER(IntKi), PARAMETER :: J2WaveElv2 = 4295 + INTEGER(IntKi), PARAMETER :: J3WaveElv2 = 4296 + INTEGER(IntKi), PARAMETER :: J4WaveElv2 = 4297 + INTEGER(IntKi), PARAMETER :: J5WaveElv2 = 4298 + INTEGER(IntKi), PARAMETER :: J6WaveElv2 = 4299 + INTEGER(IntKi), PARAMETER :: J7WaveElv2 = 4300 + INTEGER(IntKi), PARAMETER :: J8WaveElv2 = 4301 + INTEGER(IntKi), PARAMETER :: J9WaveElv2 = 4302 + INTEGER(IntKi), PARAMETER :: J1STVxi = 4303 + INTEGER(IntKi), PARAMETER :: J2STVxi = 4304 + INTEGER(IntKi), PARAMETER :: J3STVxi = 4305 + INTEGER(IntKi), PARAMETER :: J4STVxi = 4306 + INTEGER(IntKi), PARAMETER :: J5STVxi = 4307 + INTEGER(IntKi), PARAMETER :: J6STVxi = 4308 + INTEGER(IntKi), PARAMETER :: J7STVxi = 4309 + INTEGER(IntKi), PARAMETER :: J8STVxi = 4310 + INTEGER(IntKi), PARAMETER :: J9STVxi = 4311 + INTEGER(IntKi), PARAMETER :: J1STVyi = 4312 + INTEGER(IntKi), PARAMETER :: J2STVyi = 4313 + INTEGER(IntKi), PARAMETER :: J3STVyi = 4314 + INTEGER(IntKi), PARAMETER :: J4STVyi = 4315 + INTEGER(IntKi), PARAMETER :: J5STVyi = 4316 + INTEGER(IntKi), PARAMETER :: J6STVyi = 4317 + INTEGER(IntKi), PARAMETER :: J7STVyi = 4318 + INTEGER(IntKi), PARAMETER :: J8STVyi = 4319 + INTEGER(IntKi), PARAMETER :: J9STVyi = 4320 + INTEGER(IntKi), PARAMETER :: J1STVzi = 4321 + INTEGER(IntKi), PARAMETER :: J2STVzi = 4322 + INTEGER(IntKi), PARAMETER :: J3STVzi = 4323 + INTEGER(IntKi), PARAMETER :: J4STVzi = 4324 + INTEGER(IntKi), PARAMETER :: J5STVzi = 4325 + INTEGER(IntKi), PARAMETER :: J6STVzi = 4326 + INTEGER(IntKi), PARAMETER :: J7STVzi = 4327 + INTEGER(IntKi), PARAMETER :: J8STVzi = 4328 + INTEGER(IntKi), PARAMETER :: J9STVzi = 4329 + INTEGER(IntKi), PARAMETER :: J1STAxi = 4330 + INTEGER(IntKi), PARAMETER :: J2STAxi = 4331 + INTEGER(IntKi), PARAMETER :: J3STAxi = 4332 + INTEGER(IntKi), PARAMETER :: J4STAxi = 4333 + INTEGER(IntKi), PARAMETER :: J5STAxi = 4334 + INTEGER(IntKi), PARAMETER :: J6STAxi = 4335 + INTEGER(IntKi), PARAMETER :: J7STAxi = 4336 + INTEGER(IntKi), PARAMETER :: J8STAxi = 4337 + INTEGER(IntKi), PARAMETER :: J9STAxi = 4338 + INTEGER(IntKi), PARAMETER :: J1STAyi = 4339 + INTEGER(IntKi), PARAMETER :: J2STAyi = 4340 + INTEGER(IntKi), PARAMETER :: J3STAyi = 4341 + INTEGER(IntKi), PARAMETER :: J4STAyi = 4342 + INTEGER(IntKi), PARAMETER :: J5STAyi = 4343 + INTEGER(IntKi), PARAMETER :: J6STAyi = 4344 + INTEGER(IntKi), PARAMETER :: J7STAyi = 4345 + INTEGER(IntKi), PARAMETER :: J8STAyi = 4346 + INTEGER(IntKi), PARAMETER :: J9STAyi = 4347 + INTEGER(IntKi), PARAMETER :: J1STAzi = 4348 + INTEGER(IntKi), PARAMETER :: J2STAzi = 4349 + INTEGER(IntKi), PARAMETER :: J3STAzi = 4350 + INTEGER(IntKi), PARAMETER :: J4STAzi = 4351 + INTEGER(IntKi), PARAMETER :: J5STAzi = 4352 + INTEGER(IntKi), PARAMETER :: J6STAzi = 4353 + INTEGER(IntKi), PARAMETER :: J7STAzi = 4354 + INTEGER(IntKi), PARAMETER :: J8STAzi = 4355 + INTEGER(IntKi), PARAMETER :: J9STAzi = 4356 ! Joint Loads: - INTEGER(IntKi), PARAMETER :: J1FDxi = 4330 - INTEGER(IntKi), PARAMETER :: J2FDxi = 4331 - INTEGER(IntKi), PARAMETER :: J3FDxi = 4332 - INTEGER(IntKi), PARAMETER :: J4FDxi = 4333 - INTEGER(IntKi), PARAMETER :: J5FDxi = 4334 - INTEGER(IntKi), PARAMETER :: J6FDxi = 4335 - INTEGER(IntKi), PARAMETER :: J7FDxi = 4336 - INTEGER(IntKi), PARAMETER :: J8FDxi = 4337 - INTEGER(IntKi), PARAMETER :: J9FDxi = 4338 - INTEGER(IntKi), PARAMETER :: J1FDyi = 4339 - INTEGER(IntKi), PARAMETER :: J2FDyi = 4340 - INTEGER(IntKi), PARAMETER :: J3FDyi = 4341 - INTEGER(IntKi), PARAMETER :: J4FDyi = 4342 - INTEGER(IntKi), PARAMETER :: J5FDyi = 4343 - INTEGER(IntKi), PARAMETER :: J6FDyi = 4344 - INTEGER(IntKi), PARAMETER :: J7FDyi = 4345 - INTEGER(IntKi), PARAMETER :: J8FDyi = 4346 - INTEGER(IntKi), PARAMETER :: J9FDyi = 4347 - INTEGER(IntKi), PARAMETER :: J1FDzi = 4348 - INTEGER(IntKi), PARAMETER :: J2FDzi = 4349 - INTEGER(IntKi), PARAMETER :: J3FDzi = 4350 - INTEGER(IntKi), PARAMETER :: J4FDzi = 4351 - INTEGER(IntKi), PARAMETER :: J5FDzi = 4352 - INTEGER(IntKi), PARAMETER :: J6FDzi = 4353 - INTEGER(IntKi), PARAMETER :: J7FDzi = 4354 - INTEGER(IntKi), PARAMETER :: J8FDzi = 4355 - INTEGER(IntKi), PARAMETER :: J9FDzi = 4356 - INTEGER(IntKi), PARAMETER :: J1FBxi = 4357 - INTEGER(IntKi), PARAMETER :: J2FBxi = 4358 - INTEGER(IntKi), PARAMETER :: J3FBxi = 4359 - INTEGER(IntKi), PARAMETER :: J4FBxi = 4360 - INTEGER(IntKi), PARAMETER :: J5FBxi = 4361 - INTEGER(IntKi), PARAMETER :: J6FBxi = 4362 - INTEGER(IntKi), PARAMETER :: J7FBxi = 4363 - INTEGER(IntKi), PARAMETER :: J8FBxi = 4364 - INTEGER(IntKi), PARAMETER :: J9FBxi = 4365 - INTEGER(IntKi), PARAMETER :: J1FByi = 4366 - INTEGER(IntKi), PARAMETER :: J2FByi = 4367 - INTEGER(IntKi), PARAMETER :: J3FByi = 4368 - INTEGER(IntKi), PARAMETER :: J4FByi = 4369 - INTEGER(IntKi), PARAMETER :: J5FByi = 4370 - INTEGER(IntKi), PARAMETER :: J6FByi = 4371 - INTEGER(IntKi), PARAMETER :: J7FByi = 4372 - INTEGER(IntKi), PARAMETER :: J8FByi = 4373 - INTEGER(IntKi), PARAMETER :: J9FByi = 4374 - INTEGER(IntKi), PARAMETER :: J1FBzi = 4375 - INTEGER(IntKi), PARAMETER :: J2FBzi = 4376 - INTEGER(IntKi), PARAMETER :: J3FBzi = 4377 - INTEGER(IntKi), PARAMETER :: J4FBzi = 4378 - INTEGER(IntKi), PARAMETER :: J5FBzi = 4379 - INTEGER(IntKi), PARAMETER :: J6FBzi = 4380 - INTEGER(IntKi), PARAMETER :: J7FBzi = 4381 - INTEGER(IntKi), PARAMETER :: J8FBzi = 4382 - INTEGER(IntKi), PARAMETER :: J9FBzi = 4383 - INTEGER(IntKi), PARAMETER :: J1MBxi = 4384 - INTEGER(IntKi), PARAMETER :: J2MBxi = 4385 - INTEGER(IntKi), PARAMETER :: J3MBxi = 4386 - INTEGER(IntKi), PARAMETER :: J4MBxi = 4387 - INTEGER(IntKi), PARAMETER :: J5MBxi = 4388 - INTEGER(IntKi), PARAMETER :: J6MBxi = 4389 - INTEGER(IntKi), PARAMETER :: J7MBxi = 4390 - INTEGER(IntKi), PARAMETER :: J8MBxi = 4391 - INTEGER(IntKi), PARAMETER :: J9MBxi = 4392 - INTEGER(IntKi), PARAMETER :: J1MByi = 4393 - INTEGER(IntKi), PARAMETER :: J2MByi = 4394 - INTEGER(IntKi), PARAMETER :: J3MByi = 4395 - INTEGER(IntKi), PARAMETER :: J4MByi = 4396 - INTEGER(IntKi), PARAMETER :: J5MByi = 4397 - INTEGER(IntKi), PARAMETER :: J6MByi = 4398 - INTEGER(IntKi), PARAMETER :: J7MByi = 4399 - INTEGER(IntKi), PARAMETER :: J8MByi = 4400 - INTEGER(IntKi), PARAMETER :: J9MByi = 4401 - INTEGER(IntKi), PARAMETER :: J1MBzi = 4402 - INTEGER(IntKi), PARAMETER :: J2MBzi = 4403 - INTEGER(IntKi), PARAMETER :: J3MBzi = 4404 - INTEGER(IntKi), PARAMETER :: J4MBzi = 4405 - INTEGER(IntKi), PARAMETER :: J5MBzi = 4406 - INTEGER(IntKi), PARAMETER :: J6MBzi = 4407 - INTEGER(IntKi), PARAMETER :: J7MBzi = 4408 - INTEGER(IntKi), PARAMETER :: J8MBzi = 4409 - INTEGER(IntKi), PARAMETER :: J9MBzi = 4410 - INTEGER(IntKi), PARAMETER :: J1FBFxi = 4411 - INTEGER(IntKi), PARAMETER :: J2FBFxi = 4412 - INTEGER(IntKi), PARAMETER :: J3FBFxi = 4413 - INTEGER(IntKi), PARAMETER :: J4FBFxi = 4414 - INTEGER(IntKi), PARAMETER :: J5FBFxi = 4415 - INTEGER(IntKi), PARAMETER :: J6FBFxi = 4416 - INTEGER(IntKi), PARAMETER :: J7FBFxi = 4417 - INTEGER(IntKi), PARAMETER :: J8FBFxi = 4418 - INTEGER(IntKi), PARAMETER :: J9FBFxi = 4419 - INTEGER(IntKi), PARAMETER :: J1FBFyi = 4420 - INTEGER(IntKi), PARAMETER :: J2FBFyi = 4421 - INTEGER(IntKi), PARAMETER :: J3FBFyi = 4422 - INTEGER(IntKi), PARAMETER :: J4FBFyi = 4423 - INTEGER(IntKi), PARAMETER :: J5FBFyi = 4424 - INTEGER(IntKi), PARAMETER :: J6FBFyi = 4425 - INTEGER(IntKi), PARAMETER :: J7FBFyi = 4426 - INTEGER(IntKi), PARAMETER :: J8FBFyi = 4427 - INTEGER(IntKi), PARAMETER :: J9FBFyi = 4428 - INTEGER(IntKi), PARAMETER :: J1FBFzi = 4429 - INTEGER(IntKi), PARAMETER :: J2FBFzi = 4430 - INTEGER(IntKi), PARAMETER :: J3FBFzi = 4431 - INTEGER(IntKi), PARAMETER :: J4FBFzi = 4432 - INTEGER(IntKi), PARAMETER :: J5FBFzi = 4433 - INTEGER(IntKi), PARAMETER :: J6FBFzi = 4434 - INTEGER(IntKi), PARAMETER :: J7FBFzi = 4435 - INTEGER(IntKi), PARAMETER :: J8FBFzi = 4436 - INTEGER(IntKi), PARAMETER :: J9FBFzi = 4437 - INTEGER(IntKi), PARAMETER :: J1MBFxi = 4438 - INTEGER(IntKi), PARAMETER :: J2MBFxi = 4439 - INTEGER(IntKi), PARAMETER :: J3MBFxi = 4440 - INTEGER(IntKi), PARAMETER :: J4MBFxi = 4441 - INTEGER(IntKi), PARAMETER :: J5MBFxi = 4442 - INTEGER(IntKi), PARAMETER :: J6MBFxi = 4443 - INTEGER(IntKi), PARAMETER :: J7MBFxi = 4444 - INTEGER(IntKi), PARAMETER :: J8MBFxi = 4445 - INTEGER(IntKi), PARAMETER :: J9MBFxi = 4446 - INTEGER(IntKi), PARAMETER :: J1MBFyi = 4447 - INTEGER(IntKi), PARAMETER :: J2MBFyi = 4448 - INTEGER(IntKi), PARAMETER :: J3MBFyi = 4449 - INTEGER(IntKi), PARAMETER :: J4MBFyi = 4450 - INTEGER(IntKi), PARAMETER :: J5MBFyi = 4451 - INTEGER(IntKi), PARAMETER :: J6MBFyi = 4452 - INTEGER(IntKi), PARAMETER :: J7MBFyi = 4453 - INTEGER(IntKi), PARAMETER :: J8MBFyi = 4454 - INTEGER(IntKi), PARAMETER :: J9MBFyi = 4455 - INTEGER(IntKi), PARAMETER :: J1MBFzi = 4456 - INTEGER(IntKi), PARAMETER :: J2MBFzi = 4457 - INTEGER(IntKi), PARAMETER :: J3MBFzi = 4458 - INTEGER(IntKi), PARAMETER :: J4MBFzi = 4459 - INTEGER(IntKi), PARAMETER :: J5MBFzi = 4460 - INTEGER(IntKi), PARAMETER :: J6MBFzi = 4461 - INTEGER(IntKi), PARAMETER :: J7MBFzi = 4462 - INTEGER(IntKi), PARAMETER :: J8MBFzi = 4463 - INTEGER(IntKi), PARAMETER :: J9MBFzi = 4464 - INTEGER(IntKi), PARAMETER :: J1FIxi = 4465 - INTEGER(IntKi), PARAMETER :: J2FIxi = 4466 - INTEGER(IntKi), PARAMETER :: J3FIxi = 4467 - INTEGER(IntKi), PARAMETER :: J4FIxi = 4468 - INTEGER(IntKi), PARAMETER :: J5FIxi = 4469 - INTEGER(IntKi), PARAMETER :: J6FIxi = 4470 - INTEGER(IntKi), PARAMETER :: J7FIxi = 4471 - INTEGER(IntKi), PARAMETER :: J8FIxi = 4472 - INTEGER(IntKi), PARAMETER :: J9FIxi = 4473 - INTEGER(IntKi), PARAMETER :: J1FIyi = 4474 - INTEGER(IntKi), PARAMETER :: J2FIyi = 4475 - INTEGER(IntKi), PARAMETER :: J3FIyi = 4476 - INTEGER(IntKi), PARAMETER :: J4FIyi = 4477 - INTEGER(IntKi), PARAMETER :: J5FIyi = 4478 - INTEGER(IntKi), PARAMETER :: J6FIyi = 4479 - INTEGER(IntKi), PARAMETER :: J7FIyi = 4480 - INTEGER(IntKi), PARAMETER :: J8FIyi = 4481 - INTEGER(IntKi), PARAMETER :: J9FIyi = 4482 - INTEGER(IntKi), PARAMETER :: J1FIzi = 4483 - INTEGER(IntKi), PARAMETER :: J2FIzi = 4484 - INTEGER(IntKi), PARAMETER :: J3FIzi = 4485 - INTEGER(IntKi), PARAMETER :: J4FIzi = 4486 - INTEGER(IntKi), PARAMETER :: J5FIzi = 4487 - INTEGER(IntKi), PARAMETER :: J6FIzi = 4488 - INTEGER(IntKi), PARAMETER :: J7FIzi = 4489 - INTEGER(IntKi), PARAMETER :: J8FIzi = 4490 - INTEGER(IntKi), PARAMETER :: J9FIzi = 4491 - INTEGER(IntKi), PARAMETER :: J1FAMxi = 4492 - INTEGER(IntKi), PARAMETER :: J2FAMxi = 4493 - INTEGER(IntKi), PARAMETER :: J3FAMxi = 4494 - INTEGER(IntKi), PARAMETER :: J4FAMxi = 4495 - INTEGER(IntKi), PARAMETER :: J5FAMxi = 4496 - INTEGER(IntKi), PARAMETER :: J6FAMxi = 4497 - INTEGER(IntKi), PARAMETER :: J7FAMxi = 4498 - INTEGER(IntKi), PARAMETER :: J8FAMxi = 4499 - INTEGER(IntKi), PARAMETER :: J9FAMxi = 4500 - INTEGER(IntKi), PARAMETER :: J1FAMyi = 4501 - INTEGER(IntKi), PARAMETER :: J2FAMyi = 4502 - INTEGER(IntKi), PARAMETER :: J3FAMyi = 4503 - INTEGER(IntKi), PARAMETER :: J4FAMyi = 4504 - INTEGER(IntKi), PARAMETER :: J5FAMyi = 4505 - INTEGER(IntKi), PARAMETER :: J6FAMyi = 4506 - INTEGER(IntKi), PARAMETER :: J7FAMyi = 4507 - INTEGER(IntKi), PARAMETER :: J8FAMyi = 4508 - INTEGER(IntKi), PARAMETER :: J9FAMyi = 4509 - INTEGER(IntKi), PARAMETER :: J1FAMzi = 4510 - INTEGER(IntKi), PARAMETER :: J2FAMzi = 4511 - INTEGER(IntKi), PARAMETER :: J3FAMzi = 4512 - INTEGER(IntKi), PARAMETER :: J4FAMzi = 4513 - INTEGER(IntKi), PARAMETER :: J5FAMzi = 4514 - INTEGER(IntKi), PARAMETER :: J6FAMzi = 4515 - INTEGER(IntKi), PARAMETER :: J7FAMzi = 4516 - INTEGER(IntKi), PARAMETER :: J8FAMzi = 4517 - INTEGER(IntKi), PARAMETER :: J9FAMzi = 4518 - INTEGER(IntKi), PARAMETER :: J1FAGxi = 4519 - INTEGER(IntKi), PARAMETER :: J2FAGxi = 4520 - INTEGER(IntKi), PARAMETER :: J3FAGxi = 4521 - INTEGER(IntKi), PARAMETER :: J4FAGxi = 4522 - INTEGER(IntKi), PARAMETER :: J5FAGxi = 4523 - INTEGER(IntKi), PARAMETER :: J6FAGxi = 4524 - INTEGER(IntKi), PARAMETER :: J7FAGxi = 4525 - INTEGER(IntKi), PARAMETER :: J8FAGxi = 4526 - INTEGER(IntKi), PARAMETER :: J9FAGxi = 4527 - INTEGER(IntKi), PARAMETER :: J1FAGyi = 4528 - INTEGER(IntKi), PARAMETER :: J2FAGyi = 4529 - INTEGER(IntKi), PARAMETER :: J3FAGyi = 4530 - INTEGER(IntKi), PARAMETER :: J4FAGyi = 4531 - INTEGER(IntKi), PARAMETER :: J5FAGyi = 4532 - INTEGER(IntKi), PARAMETER :: J6FAGyi = 4533 - INTEGER(IntKi), PARAMETER :: J7FAGyi = 4534 - INTEGER(IntKi), PARAMETER :: J8FAGyi = 4535 - INTEGER(IntKi), PARAMETER :: J9FAGyi = 4536 - INTEGER(IntKi), PARAMETER :: J1FAGzi = 4537 - INTEGER(IntKi), PARAMETER :: J2FAGzi = 4538 - INTEGER(IntKi), PARAMETER :: J3FAGzi = 4539 - INTEGER(IntKi), PARAMETER :: J4FAGzi = 4540 - INTEGER(IntKi), PARAMETER :: J5FAGzi = 4541 - INTEGER(IntKi), PARAMETER :: J6FAGzi = 4542 - INTEGER(IntKi), PARAMETER :: J7FAGzi = 4543 - INTEGER(IntKi), PARAMETER :: J8FAGzi = 4544 - INTEGER(IntKi), PARAMETER :: J9FAGzi = 4545 - INTEGER(IntKi), PARAMETER :: J1MAGxi = 4546 - INTEGER(IntKi), PARAMETER :: J2MAGxi = 4547 - INTEGER(IntKi), PARAMETER :: J3MAGxi = 4548 - INTEGER(IntKi), PARAMETER :: J4MAGxi = 4549 - INTEGER(IntKi), PARAMETER :: J5MAGxi = 4550 - INTEGER(IntKi), PARAMETER :: J6MAGxi = 4551 - INTEGER(IntKi), PARAMETER :: J7MAGxi = 4552 - INTEGER(IntKi), PARAMETER :: J8MAGxi = 4553 - INTEGER(IntKi), PARAMETER :: J9MAGxi = 4554 - INTEGER(IntKi), PARAMETER :: J1MAGyi = 4555 - INTEGER(IntKi), PARAMETER :: J2MAGyi = 4556 - INTEGER(IntKi), PARAMETER :: J3MAGyi = 4557 - INTEGER(IntKi), PARAMETER :: J4MAGyi = 4558 - INTEGER(IntKi), PARAMETER :: J5MAGyi = 4559 - INTEGER(IntKi), PARAMETER :: J6MAGyi = 4560 - INTEGER(IntKi), PARAMETER :: J7MAGyi = 4561 - INTEGER(IntKi), PARAMETER :: J8MAGyi = 4562 - INTEGER(IntKi), PARAMETER :: J9MAGyi = 4563 - INTEGER(IntKi), PARAMETER :: J1MAGzi = 4564 - INTEGER(IntKi), PARAMETER :: J2MAGzi = 4565 - INTEGER(IntKi), PARAMETER :: J3MAGzi = 4566 - INTEGER(IntKi), PARAMETER :: J4MAGzi = 4567 - INTEGER(IntKi), PARAMETER :: J5MAGzi = 4568 - INTEGER(IntKi), PARAMETER :: J6MAGzi = 4569 - INTEGER(IntKi), PARAMETER :: J7MAGzi = 4570 - INTEGER(IntKi), PARAMETER :: J8MAGzi = 4571 - INTEGER(IntKi), PARAMETER :: J9MAGzi = 4572 - INTEGER(IntKi), PARAMETER :: J1FMGxi = 4573 - INTEGER(IntKi), PARAMETER :: J2FMGxi = 4574 - INTEGER(IntKi), PARAMETER :: J3FMGxi = 4575 - INTEGER(IntKi), PARAMETER :: J4FMGxi = 4576 - INTEGER(IntKi), PARAMETER :: J5FMGxi = 4577 - INTEGER(IntKi), PARAMETER :: J6FMGxi = 4578 - INTEGER(IntKi), PARAMETER :: J7FMGxi = 4579 - INTEGER(IntKi), PARAMETER :: J8FMGxi = 4580 - INTEGER(IntKi), PARAMETER :: J9FMGxi = 4581 - INTEGER(IntKi), PARAMETER :: J1FMGyi = 4582 - INTEGER(IntKi), PARAMETER :: J2FMGyi = 4583 - INTEGER(IntKi), PARAMETER :: J3FMGyi = 4584 - INTEGER(IntKi), PARAMETER :: J4FMGyi = 4585 - INTEGER(IntKi), PARAMETER :: J5FMGyi = 4586 - INTEGER(IntKi), PARAMETER :: J6FMGyi = 4587 - INTEGER(IntKi), PARAMETER :: J7FMGyi = 4588 - INTEGER(IntKi), PARAMETER :: J8FMGyi = 4589 - INTEGER(IntKi), PARAMETER :: J9FMGyi = 4590 - INTEGER(IntKi), PARAMETER :: J1FMGzi = 4591 - INTEGER(IntKi), PARAMETER :: J2FMGzi = 4592 - INTEGER(IntKi), PARAMETER :: J3FMGzi = 4593 - INTEGER(IntKi), PARAMETER :: J4FMGzi = 4594 - INTEGER(IntKi), PARAMETER :: J5FMGzi = 4595 - INTEGER(IntKi), PARAMETER :: J6FMGzi = 4596 - INTEGER(IntKi), PARAMETER :: J7FMGzi = 4597 - INTEGER(IntKi), PARAMETER :: J8FMGzi = 4598 - INTEGER(IntKi), PARAMETER :: J9FMGzi = 4599 + INTEGER(IntKi), PARAMETER :: J1FDxi = 4357 + INTEGER(IntKi), PARAMETER :: J2FDxi = 4358 + INTEGER(IntKi), PARAMETER :: J3FDxi = 4359 + INTEGER(IntKi), PARAMETER :: J4FDxi = 4360 + INTEGER(IntKi), PARAMETER :: J5FDxi = 4361 + INTEGER(IntKi), PARAMETER :: J6FDxi = 4362 + INTEGER(IntKi), PARAMETER :: J7FDxi = 4363 + INTEGER(IntKi), PARAMETER :: J8FDxi = 4364 + INTEGER(IntKi), PARAMETER :: J9FDxi = 4365 + INTEGER(IntKi), PARAMETER :: J1FDyi = 4366 + INTEGER(IntKi), PARAMETER :: J2FDyi = 4367 + INTEGER(IntKi), PARAMETER :: J3FDyi = 4368 + INTEGER(IntKi), PARAMETER :: J4FDyi = 4369 + INTEGER(IntKi), PARAMETER :: J5FDyi = 4370 + INTEGER(IntKi), PARAMETER :: J6FDyi = 4371 + INTEGER(IntKi), PARAMETER :: J7FDyi = 4372 + INTEGER(IntKi), PARAMETER :: J8FDyi = 4373 + INTEGER(IntKi), PARAMETER :: J9FDyi = 4374 + INTEGER(IntKi), PARAMETER :: J1FDzi = 4375 + INTEGER(IntKi), PARAMETER :: J2FDzi = 4376 + INTEGER(IntKi), PARAMETER :: J3FDzi = 4377 + INTEGER(IntKi), PARAMETER :: J4FDzi = 4378 + INTEGER(IntKi), PARAMETER :: J5FDzi = 4379 + INTEGER(IntKi), PARAMETER :: J6FDzi = 4380 + INTEGER(IntKi), PARAMETER :: J7FDzi = 4381 + INTEGER(IntKi), PARAMETER :: J8FDzi = 4382 + INTEGER(IntKi), PARAMETER :: J9FDzi = 4383 + INTEGER(IntKi), PARAMETER :: J1FBxi = 4384 + INTEGER(IntKi), PARAMETER :: J2FBxi = 4385 + INTEGER(IntKi), PARAMETER :: J3FBxi = 4386 + INTEGER(IntKi), PARAMETER :: J4FBxi = 4387 + INTEGER(IntKi), PARAMETER :: J5FBxi = 4388 + INTEGER(IntKi), PARAMETER :: J6FBxi = 4389 + INTEGER(IntKi), PARAMETER :: J7FBxi = 4390 + INTEGER(IntKi), PARAMETER :: J8FBxi = 4391 + INTEGER(IntKi), PARAMETER :: J9FBxi = 4392 + INTEGER(IntKi), PARAMETER :: J1FByi = 4393 + INTEGER(IntKi), PARAMETER :: J2FByi = 4394 + INTEGER(IntKi), PARAMETER :: J3FByi = 4395 + INTEGER(IntKi), PARAMETER :: J4FByi = 4396 + INTEGER(IntKi), PARAMETER :: J5FByi = 4397 + INTEGER(IntKi), PARAMETER :: J6FByi = 4398 + INTEGER(IntKi), PARAMETER :: J7FByi = 4399 + INTEGER(IntKi), PARAMETER :: J8FByi = 4400 + INTEGER(IntKi), PARAMETER :: J9FByi = 4401 + INTEGER(IntKi), PARAMETER :: J1FBzi = 4402 + INTEGER(IntKi), PARAMETER :: J2FBzi = 4403 + INTEGER(IntKi), PARAMETER :: J3FBzi = 4404 + INTEGER(IntKi), PARAMETER :: J4FBzi = 4405 + INTEGER(IntKi), PARAMETER :: J5FBzi = 4406 + INTEGER(IntKi), PARAMETER :: J6FBzi = 4407 + INTEGER(IntKi), PARAMETER :: J7FBzi = 4408 + INTEGER(IntKi), PARAMETER :: J8FBzi = 4409 + INTEGER(IntKi), PARAMETER :: J9FBzi = 4410 + INTEGER(IntKi), PARAMETER :: J1MBxi = 4411 + INTEGER(IntKi), PARAMETER :: J2MBxi = 4412 + INTEGER(IntKi), PARAMETER :: J3MBxi = 4413 + INTEGER(IntKi), PARAMETER :: J4MBxi = 4414 + INTEGER(IntKi), PARAMETER :: J5MBxi = 4415 + INTEGER(IntKi), PARAMETER :: J6MBxi = 4416 + INTEGER(IntKi), PARAMETER :: J7MBxi = 4417 + INTEGER(IntKi), PARAMETER :: J8MBxi = 4418 + INTEGER(IntKi), PARAMETER :: J9MBxi = 4419 + INTEGER(IntKi), PARAMETER :: J1MByi = 4420 + INTEGER(IntKi), PARAMETER :: J2MByi = 4421 + INTEGER(IntKi), PARAMETER :: J3MByi = 4422 + INTEGER(IntKi), PARAMETER :: J4MByi = 4423 + INTEGER(IntKi), PARAMETER :: J5MByi = 4424 + INTEGER(IntKi), PARAMETER :: J6MByi = 4425 + INTEGER(IntKi), PARAMETER :: J7MByi = 4426 + INTEGER(IntKi), PARAMETER :: J8MByi = 4427 + INTEGER(IntKi), PARAMETER :: J9MByi = 4428 + INTEGER(IntKi), PARAMETER :: J1MBzi = 4429 + INTEGER(IntKi), PARAMETER :: J2MBzi = 4430 + INTEGER(IntKi), PARAMETER :: J3MBzi = 4431 + INTEGER(IntKi), PARAMETER :: J4MBzi = 4432 + INTEGER(IntKi), PARAMETER :: J5MBzi = 4433 + INTEGER(IntKi), PARAMETER :: J6MBzi = 4434 + INTEGER(IntKi), PARAMETER :: J7MBzi = 4435 + INTEGER(IntKi), PARAMETER :: J8MBzi = 4436 + INTEGER(IntKi), PARAMETER :: J9MBzi = 4437 + INTEGER(IntKi), PARAMETER :: J1FBFxi = 4438 + INTEGER(IntKi), PARAMETER :: J2FBFxi = 4439 + INTEGER(IntKi), PARAMETER :: J3FBFxi = 4440 + INTEGER(IntKi), PARAMETER :: J4FBFxi = 4441 + INTEGER(IntKi), PARAMETER :: J5FBFxi = 4442 + INTEGER(IntKi), PARAMETER :: J6FBFxi = 4443 + INTEGER(IntKi), PARAMETER :: J7FBFxi = 4444 + INTEGER(IntKi), PARAMETER :: J8FBFxi = 4445 + INTEGER(IntKi), PARAMETER :: J9FBFxi = 4446 + INTEGER(IntKi), PARAMETER :: J1FBFyi = 4447 + INTEGER(IntKi), PARAMETER :: J2FBFyi = 4448 + INTEGER(IntKi), PARAMETER :: J3FBFyi = 4449 + INTEGER(IntKi), PARAMETER :: J4FBFyi = 4450 + INTEGER(IntKi), PARAMETER :: J5FBFyi = 4451 + INTEGER(IntKi), PARAMETER :: J6FBFyi = 4452 + INTEGER(IntKi), PARAMETER :: J7FBFyi = 4453 + INTEGER(IntKi), PARAMETER :: J8FBFyi = 4454 + INTEGER(IntKi), PARAMETER :: J9FBFyi = 4455 + INTEGER(IntKi), PARAMETER :: J1FBFzi = 4456 + INTEGER(IntKi), PARAMETER :: J2FBFzi = 4457 + INTEGER(IntKi), PARAMETER :: J3FBFzi = 4458 + INTEGER(IntKi), PARAMETER :: J4FBFzi = 4459 + INTEGER(IntKi), PARAMETER :: J5FBFzi = 4460 + INTEGER(IntKi), PARAMETER :: J6FBFzi = 4461 + INTEGER(IntKi), PARAMETER :: J7FBFzi = 4462 + INTEGER(IntKi), PARAMETER :: J8FBFzi = 4463 + INTEGER(IntKi), PARAMETER :: J9FBFzi = 4464 + INTEGER(IntKi), PARAMETER :: J1MBFxi = 4465 + INTEGER(IntKi), PARAMETER :: J2MBFxi = 4466 + INTEGER(IntKi), PARAMETER :: J3MBFxi = 4467 + INTEGER(IntKi), PARAMETER :: J4MBFxi = 4468 + INTEGER(IntKi), PARAMETER :: J5MBFxi = 4469 + INTEGER(IntKi), PARAMETER :: J6MBFxi = 4470 + INTEGER(IntKi), PARAMETER :: J7MBFxi = 4471 + INTEGER(IntKi), PARAMETER :: J8MBFxi = 4472 + INTEGER(IntKi), PARAMETER :: J9MBFxi = 4473 + INTEGER(IntKi), PARAMETER :: J1MBFyi = 4474 + INTEGER(IntKi), PARAMETER :: J2MBFyi = 4475 + INTEGER(IntKi), PARAMETER :: J3MBFyi = 4476 + INTEGER(IntKi), PARAMETER :: J4MBFyi = 4477 + INTEGER(IntKi), PARAMETER :: J5MBFyi = 4478 + INTEGER(IntKi), PARAMETER :: J6MBFyi = 4479 + INTEGER(IntKi), PARAMETER :: J7MBFyi = 4480 + INTEGER(IntKi), PARAMETER :: J8MBFyi = 4481 + INTEGER(IntKi), PARAMETER :: J9MBFyi = 4482 + INTEGER(IntKi), PARAMETER :: J1MBFzi = 4483 + INTEGER(IntKi), PARAMETER :: J2MBFzi = 4484 + INTEGER(IntKi), PARAMETER :: J3MBFzi = 4485 + INTEGER(IntKi), PARAMETER :: J4MBFzi = 4486 + INTEGER(IntKi), PARAMETER :: J5MBFzi = 4487 + INTEGER(IntKi), PARAMETER :: J6MBFzi = 4488 + INTEGER(IntKi), PARAMETER :: J7MBFzi = 4489 + INTEGER(IntKi), PARAMETER :: J8MBFzi = 4490 + INTEGER(IntKi), PARAMETER :: J9MBFzi = 4491 + INTEGER(IntKi), PARAMETER :: J1FIxi = 4492 + INTEGER(IntKi), PARAMETER :: J2FIxi = 4493 + INTEGER(IntKi), PARAMETER :: J3FIxi = 4494 + INTEGER(IntKi), PARAMETER :: J4FIxi = 4495 + INTEGER(IntKi), PARAMETER :: J5FIxi = 4496 + INTEGER(IntKi), PARAMETER :: J6FIxi = 4497 + INTEGER(IntKi), PARAMETER :: J7FIxi = 4498 + INTEGER(IntKi), PARAMETER :: J8FIxi = 4499 + INTEGER(IntKi), PARAMETER :: J9FIxi = 4500 + INTEGER(IntKi), PARAMETER :: J1FIyi = 4501 + INTEGER(IntKi), PARAMETER :: J2FIyi = 4502 + INTEGER(IntKi), PARAMETER :: J3FIyi = 4503 + INTEGER(IntKi), PARAMETER :: J4FIyi = 4504 + INTEGER(IntKi), PARAMETER :: J5FIyi = 4505 + INTEGER(IntKi), PARAMETER :: J6FIyi = 4506 + INTEGER(IntKi), PARAMETER :: J7FIyi = 4507 + INTEGER(IntKi), PARAMETER :: J8FIyi = 4508 + INTEGER(IntKi), PARAMETER :: J9FIyi = 4509 + INTEGER(IntKi), PARAMETER :: J1FIzi = 4510 + INTEGER(IntKi), PARAMETER :: J2FIzi = 4511 + INTEGER(IntKi), PARAMETER :: J3FIzi = 4512 + INTEGER(IntKi), PARAMETER :: J4FIzi = 4513 + INTEGER(IntKi), PARAMETER :: J5FIzi = 4514 + INTEGER(IntKi), PARAMETER :: J6FIzi = 4515 + INTEGER(IntKi), PARAMETER :: J7FIzi = 4516 + INTEGER(IntKi), PARAMETER :: J8FIzi = 4517 + INTEGER(IntKi), PARAMETER :: J9FIzi = 4518 + INTEGER(IntKi), PARAMETER :: J1FAMxi = 4519 + INTEGER(IntKi), PARAMETER :: J2FAMxi = 4520 + INTEGER(IntKi), PARAMETER :: J3FAMxi = 4521 + INTEGER(IntKi), PARAMETER :: J4FAMxi = 4522 + INTEGER(IntKi), PARAMETER :: J5FAMxi = 4523 + INTEGER(IntKi), PARAMETER :: J6FAMxi = 4524 + INTEGER(IntKi), PARAMETER :: J7FAMxi = 4525 + INTEGER(IntKi), PARAMETER :: J8FAMxi = 4526 + INTEGER(IntKi), PARAMETER :: J9FAMxi = 4527 + INTEGER(IntKi), PARAMETER :: J1FAMyi = 4528 + INTEGER(IntKi), PARAMETER :: J2FAMyi = 4529 + INTEGER(IntKi), PARAMETER :: J3FAMyi = 4530 + INTEGER(IntKi), PARAMETER :: J4FAMyi = 4531 + INTEGER(IntKi), PARAMETER :: J5FAMyi = 4532 + INTEGER(IntKi), PARAMETER :: J6FAMyi = 4533 + INTEGER(IntKi), PARAMETER :: J7FAMyi = 4534 + INTEGER(IntKi), PARAMETER :: J8FAMyi = 4535 + INTEGER(IntKi), PARAMETER :: J9FAMyi = 4536 + INTEGER(IntKi), PARAMETER :: J1FAMzi = 4537 + INTEGER(IntKi), PARAMETER :: J2FAMzi = 4538 + INTEGER(IntKi), PARAMETER :: J3FAMzi = 4539 + INTEGER(IntKi), PARAMETER :: J4FAMzi = 4540 + INTEGER(IntKi), PARAMETER :: J5FAMzi = 4541 + INTEGER(IntKi), PARAMETER :: J6FAMzi = 4542 + INTEGER(IntKi), PARAMETER :: J7FAMzi = 4543 + INTEGER(IntKi), PARAMETER :: J8FAMzi = 4544 + INTEGER(IntKi), PARAMETER :: J9FAMzi = 4545 + INTEGER(IntKi), PARAMETER :: J1FAGxi = 4546 + INTEGER(IntKi), PARAMETER :: J2FAGxi = 4547 + INTEGER(IntKi), PARAMETER :: J3FAGxi = 4548 + INTEGER(IntKi), PARAMETER :: J4FAGxi = 4549 + INTEGER(IntKi), PARAMETER :: J5FAGxi = 4550 + INTEGER(IntKi), PARAMETER :: J6FAGxi = 4551 + INTEGER(IntKi), PARAMETER :: J7FAGxi = 4552 + INTEGER(IntKi), PARAMETER :: J8FAGxi = 4553 + INTEGER(IntKi), PARAMETER :: J9FAGxi = 4554 + INTEGER(IntKi), PARAMETER :: J1FAGyi = 4555 + INTEGER(IntKi), PARAMETER :: J2FAGyi = 4556 + INTEGER(IntKi), PARAMETER :: J3FAGyi = 4557 + INTEGER(IntKi), PARAMETER :: J4FAGyi = 4558 + INTEGER(IntKi), PARAMETER :: J5FAGyi = 4559 + INTEGER(IntKi), PARAMETER :: J6FAGyi = 4560 + INTEGER(IntKi), PARAMETER :: J7FAGyi = 4561 + INTEGER(IntKi), PARAMETER :: J8FAGyi = 4562 + INTEGER(IntKi), PARAMETER :: J9FAGyi = 4563 + INTEGER(IntKi), PARAMETER :: J1FAGzi = 4564 + INTEGER(IntKi), PARAMETER :: J2FAGzi = 4565 + INTEGER(IntKi), PARAMETER :: J3FAGzi = 4566 + INTEGER(IntKi), PARAMETER :: J4FAGzi = 4567 + INTEGER(IntKi), PARAMETER :: J5FAGzi = 4568 + INTEGER(IntKi), PARAMETER :: J6FAGzi = 4569 + INTEGER(IntKi), PARAMETER :: J7FAGzi = 4570 + INTEGER(IntKi), PARAMETER :: J8FAGzi = 4571 + INTEGER(IntKi), PARAMETER :: J9FAGzi = 4572 + INTEGER(IntKi), PARAMETER :: J1MAGxi = 4573 + INTEGER(IntKi), PARAMETER :: J2MAGxi = 4574 + INTEGER(IntKi), PARAMETER :: J3MAGxi = 4575 + INTEGER(IntKi), PARAMETER :: J4MAGxi = 4576 + INTEGER(IntKi), PARAMETER :: J5MAGxi = 4577 + INTEGER(IntKi), PARAMETER :: J6MAGxi = 4578 + INTEGER(IntKi), PARAMETER :: J7MAGxi = 4579 + INTEGER(IntKi), PARAMETER :: J8MAGxi = 4580 + INTEGER(IntKi), PARAMETER :: J9MAGxi = 4581 + INTEGER(IntKi), PARAMETER :: J1MAGyi = 4582 + INTEGER(IntKi), PARAMETER :: J2MAGyi = 4583 + INTEGER(IntKi), PARAMETER :: J3MAGyi = 4584 + INTEGER(IntKi), PARAMETER :: J4MAGyi = 4585 + INTEGER(IntKi), PARAMETER :: J5MAGyi = 4586 + INTEGER(IntKi), PARAMETER :: J6MAGyi = 4587 + INTEGER(IntKi), PARAMETER :: J7MAGyi = 4588 + INTEGER(IntKi), PARAMETER :: J8MAGyi = 4589 + INTEGER(IntKi), PARAMETER :: J9MAGyi = 4590 + INTEGER(IntKi), PARAMETER :: J1MAGzi = 4591 + INTEGER(IntKi), PARAMETER :: J2MAGzi = 4592 + INTEGER(IntKi), PARAMETER :: J3MAGzi = 4593 + INTEGER(IntKi), PARAMETER :: J4MAGzi = 4594 + INTEGER(IntKi), PARAMETER :: J5MAGzi = 4595 + INTEGER(IntKi), PARAMETER :: J6MAGzi = 4596 + INTEGER(IntKi), PARAMETER :: J7MAGzi = 4597 + INTEGER(IntKi), PARAMETER :: J8MAGzi = 4598 + INTEGER(IntKi), PARAMETER :: J9MAGzi = 4599 + INTEGER(IntKi), PARAMETER :: J1FMGxi = 4600 + INTEGER(IntKi), PARAMETER :: J2FMGxi = 4601 + INTEGER(IntKi), PARAMETER :: J3FMGxi = 4602 + INTEGER(IntKi), PARAMETER :: J4FMGxi = 4603 + INTEGER(IntKi), PARAMETER :: J5FMGxi = 4604 + INTEGER(IntKi), PARAMETER :: J6FMGxi = 4605 + INTEGER(IntKi), PARAMETER :: J7FMGxi = 4606 + INTEGER(IntKi), PARAMETER :: J8FMGxi = 4607 + INTEGER(IntKi), PARAMETER :: J9FMGxi = 4608 + INTEGER(IntKi), PARAMETER :: J1FMGyi = 4609 + INTEGER(IntKi), PARAMETER :: J2FMGyi = 4610 + INTEGER(IntKi), PARAMETER :: J3FMGyi = 4611 + INTEGER(IntKi), PARAMETER :: J4FMGyi = 4612 + INTEGER(IntKi), PARAMETER :: J5FMGyi = 4613 + INTEGER(IntKi), PARAMETER :: J6FMGyi = 4614 + INTEGER(IntKi), PARAMETER :: J7FMGyi = 4615 + INTEGER(IntKi), PARAMETER :: J8FMGyi = 4616 + INTEGER(IntKi), PARAMETER :: J9FMGyi = 4617 + INTEGER(IntKi), PARAMETER :: J1FMGzi = 4618 + INTEGER(IntKi), PARAMETER :: J2FMGzi = 4619 + INTEGER(IntKi), PARAMETER :: J3FMGzi = 4620 + INTEGER(IntKi), PARAMETER :: J4FMGzi = 4621 + INTEGER(IntKi), PARAMETER :: J5FMGzi = 4622 + INTEGER(IntKi), PARAMETER :: J6FMGzi = 4623 + INTEGER(IntKi), PARAMETER :: J7FMGzi = 4624 + INTEGER(IntKi), PARAMETER :: J8FMGzi = 4625 + INTEGER(IntKi), PARAMETER :: J9FMGzi = 4626 -!End of code generated by Matlab script + + ! The maximum number of output channels which can be output by the code. + INTEGER(IntKi), PARAMETER, PUBLIC :: MaxOutPts = 4626 + +!End of code generated by Matlab script Write_ChckOutLst +! =================================================================================================== !INTEGER, PARAMETER :: WaveElevi(9) = (/Wave1Elev,Wave2Elev,Wave3Elev,Wave4Elev,Wave5Elev,Wave6Elev,Wave7Elev,Wave8Elev,Wave9Elev/) @@ -6258,6 +6292,18 @@ MODULE Morison_Output INTEGER, PARAMETER :: JDynP(9) = reshape((/J1DynP, J2DynP, J3DynP , & J4DynP, J5DynP, J6DynP , & J7DynP, J8DynP, J9DynP/), (/9/)) + INTEGER, PARAMETER :: JWaveElev(9) = reshape((/J1WaveElev, J2WaveElev, J3WaveElev , & + J4WaveElev, J5WaveElev, J6WaveElev , & + J7WaveElev, J8WaveElev, J9WaveElev/), (/9/)) + + INTEGER, PARAMETER :: JWaveElev1(9) = reshape((/J1WaveElv1, J2WaveElv1, J3WaveElv1 , & + J4WaveElv1, J5WaveElv1, J6WaveElv1 , & + J7WaveElv1, J8WaveElv1, J9WaveElv1/), (/9/)) + + INTEGER, PARAMETER :: JWaveElev2(9) = reshape((/J1WaveElv2, J2WaveElv2, J3WaveElv2 , & + J4WaveElv2, J5WaveElv2, J6WaveElv2 , & + J7WaveElv2, J8WaveElv2, J9WaveElv2/), (/9/)) + INTEGER, PARAMETER :: JSTVi(3,9) = reshape((/J1STVxi, J1STVyi, J1STVzi , & J2STVxi, J2STVyi, J2STVzi , & @@ -6381,57 +6427,1362 @@ MODULE Morison_Output J9FMGxi, J9FMGyi, J9FMGzi/), (/3,9/)) !********************************************************************************************************************************** -! 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-Jan-2014 12:13:30. - CHARACTER(OutStrLenM1) :: ValidParamAry(4599) ! This lists the names of the allowed parameters, which must be sorted alphabetically - INTEGER(IntKi) :: ParamIndxAry(4599) ! This lists the index into AllOuts(:) of the allowed parameters ValidParamAry(:) - CHARACTER(OutStrLenM1) :: ParamUnitsAry(4599) ! This lists the names of the allowed parameters, which must be sorted alphabetically - - + CHARACTER(OutStrLenM1), PARAMETER :: ValidParamAry1(1542) = (/ & ! This lists the names of the allowed parameters, which must be sorted alphabetically + "J1AXI ","J1AYI ","J1AZI ","J1DYNP ","J1FAGXI ","J1FAGYI ","J1FAGZI ", & + "J1FAMXI ","J1FAMYI ","J1FAMZI ","J1FBFXI ","J1FBFYI ","J1FBFZI ","J1FBXI ", & + "J1FBYI ","J1FBZI ","J1FDXI ","J1FDYI ","J1FDZI ","J1FIXI ","J1FIYI ", & + "J1FIZI ","J1FMGXI ","J1FMGYI ","J1FMGZI ","J1MAGXI ","J1MAGYI ","J1MAGZI ", & + "J1MBFXI ","J1MBFYI ","J1MBFZI ","J1MBXI ","J1MBYI ","J1MBZI ","J1STAXI ", & + "J1STAYI ","J1STAZI ","J1STVXI ","J1STVYI ","J1STVZI ","J1VXI ","J1VYI ", & + "J1VZI ","J1WAVEELEV","J1WAVEELV1","J1WAVEELV2","J2AXI ","J2AYI ","J2AZI ", & + "J2DYNP ","J2FAGXI ","J2FAGYI ","J2FAGZI ","J2FAMXI ","J2FAMYI ","J2FAMZI ", & + "J2FBFXI ","J2FBFYI ","J2FBFZI ","J2FBXI ","J2FBYI ","J2FBZI ","J2FDXI ", & + "J2FDYI ","J2FDZI ","J2FIXI ","J2FIYI ","J2FIZI ","J2FMGXI ","J2FMGYI ", & + "J2FMGZI ","J2MAGXI ","J2MAGYI ","J2MAGZI ","J2MBFXI ","J2MBFYI ","J2MBFZI ", & + "J2MBXI ","J2MBYI ","J2MBZI ","J2STAXI ","J2STAYI ","J2STAZI ","J2STVXI ", & + "J2STVYI ","J2STVZI ","J2VXI ","J2VYI ","J2VZI ","J2WAVEELEV","J2WAVEELV1", & + "J2WAVEELV2","J3AXI ","J3AYI ","J3AZI ","J3DYNP ","J3FAGXI ","J3FAGYI ", & + "J3FAGZI ","J3FAMXI ","J3FAMYI ","J3FAMZI ","J3FBFXI ","J3FBFYI ","J3FBFZI ", & + "J3FBXI ","J3FBYI ","J3FBZI ","J3FDXI ","J3FDYI ","J3FDZI ","J3FIXI ", & + "J3FIYI ","J3FIZI ","J3FMGXI ","J3FMGYI ","J3FMGZI ","J3MAGXI ","J3MAGYI ", & + "J3MAGZI ","J3MBFXI ","J3MBFYI ","J3MBFZI ","J3MBXI ","J3MBYI ","J3MBZI ", & + "J3STAXI ","J3STAYI ","J3STAZI ","J3STVXI ","J3STVYI ","J3STVZI ","J3VXI ", & + "J3VYI ","J3VZI ","J3WAVEELEV","J3WAVEELV1","J3WAVEELV2","J4AXI ","J4AYI ", & + "J4AZI ","J4DYNP ","J4FAGXI ","J4FAGYI ","J4FAGZI ","J4FAMXI ","J4FAMYI ", & + "J4FAMZI ","J4FBFXI ","J4FBFYI ","J4FBFZI ","J4FBXI ","J4FBYI ","J4FBZI ", & + "J4FDXI ","J4FDYI ","J4FDZI ","J4FIXI ","J4FIYI ","J4FIZI ","J4FMGXI ", & + "J4FMGYI ","J4FMGZI ","J4MAGXI ","J4MAGYI ","J4MAGZI ","J4MBFXI ","J4MBFYI ", & + "J4MBFZI ","J4MBXI ","J4MBYI ","J4MBZI ","J4STAXI ","J4STAYI ","J4STAZI ", & + "J4STVXI ","J4STVYI ","J4STVZI ","J4VXI ","J4VYI ","J4VZI ","J4WAVEELEV", & + "J4WAVEELV1","J4WAVEELV2","J5AXI ","J5AYI ","J5AZI ","J5DYNP ","J5FAGXI ", & + "J5FAGYI ","J5FAGZI ","J5FAMXI ","J5FAMYI ","J5FAMZI ","J5FBFXI ","J5FBFYI ", & + "J5FBFZI ","J5FBXI ","J5FBYI ","J5FBZI ","J5FDXI ","J5FDYI ","J5FDZI ", & + "J5FIXI ","J5FIYI ","J5FIZI ","J5FMGXI ","J5FMGYI ","J5FMGZI ","J5MAGXI ", & + "J5MAGYI ","J5MAGZI ","J5MBFXI ","J5MBFYI ","J5MBFZI ","J5MBXI ","J5MBYI ", & + "J5MBZI ","J5STAXI ","J5STAYI ","J5STAZI ","J5STVXI ","J5STVYI ","J5STVZI ", & + "J5VXI ","J5VYI ","J5VZI ","J5WAVEELEV","J5WAVEELV1","J5WAVEELV2","J6AXI ", & + "J6AYI ","J6AZI ","J6DYNP ","J6FAGXI ","J6FAGYI ","J6FAGZI ","J6FAMXI ", & + "J6FAMYI ","J6FAMZI ","J6FBFXI ","J6FBFYI ","J6FBFZI ","J6FBXI ","J6FBYI ", & + "J6FBZI ","J6FDXI ","J6FDYI ","J6FDZI ","J6FIXI ","J6FIYI ","J6FIZI ", & + "J6FMGXI ","J6FMGYI ","J6FMGZI ","J6MAGXI ","J6MAGYI ","J6MAGZI ","J6MBFXI ", & + "J6MBFYI ","J6MBFZI ","J6MBXI ","J6MBYI ","J6MBZI ","J6STAXI ","J6STAYI ", & + "J6STAZI ","J6STVXI ","J6STVYI ","J6STVZI ","J6VXI ","J6VYI ","J6VZI ", & + "J6WAVEELEV","J6WAVEELV1","J6WAVEELV2","J7AXI ","J7AYI ","J7AZI ","J7DYNP ", & + "J7FAGXI ","J7FAGYI ","J7FAGZI ","J7FAMXI ","J7FAMYI ","J7FAMZI ","J7FBFXI ", & + "J7FBFYI ","J7FBFZI ","J7FBXI ","J7FBYI ","J7FBZI ","J7FDXI ","J7FDYI ", & + "J7FDZI ","J7FIXI ","J7FIYI ","J7FIZI ","J7FMGXI ","J7FMGYI ","J7FMGZI ", & + "J7MAGXI ","J7MAGYI ","J7MAGZI ","J7MBFXI ","J7MBFYI ","J7MBFZI ","J7MBXI ", & + "J7MBYI ","J7MBZI ","J7STAXI ","J7STAYI ","J7STAZI ","J7STVXI ","J7STVYI ", & + "J7STVZI ","J7VXI ","J7VYI ","J7VZI ","J7WAVEELEV","J7WAVEELV1","J7WAVEELV2", & + "J8AXI ","J8AYI ","J8AZI ","J8DYNP ","J8FAGXI ","J8FAGYI ","J8FAGZI ", & + "J8FAMXI ","J8FAMYI ","J8FAMZI ","J8FBFXI ","J8FBFYI ","J8FBFZI ","J8FBXI ", & + "J8FBYI ","J8FBZI ","J8FDXI ","J8FDYI ","J8FDZI ","J8FIXI ","J8FIYI ", & + "J8FIZI ","J8FMGXI ","J8FMGYI ","J8FMGZI ","J8MAGXI ","J8MAGYI ","J8MAGZI ", & + "J8MBFXI ","J8MBFYI ","J8MBFZI ","J8MBXI ","J8MBYI ","J8MBZI ","J8STAXI ", & + "J8STAYI ","J8STAZI ","J8STVXI ","J8STVYI ","J8STVZI ","J8VXI ","J8VYI ", & + "J8VZI ","J8WAVEELEV","J8WAVEELV1","J8WAVEELV2","J9AXI ","J9AYI ","J9AZI ", & + "J9DYNP ","J9FAGXI ","J9FAGYI ","J9FAGZI ","J9FAMXI ","J9FAMYI ","J9FAMZI ", & + "J9FBFXI ","J9FBFYI ","J9FBFZI ","J9FBXI ","J9FBYI ","J9FBZI ","J9FDXI ", & + "J9FDYI ","J9FDZI ","J9FIXI ","J9FIYI ","J9FIZI ","J9FMGXI ","J9FMGYI ", & + "J9FMGZI ","J9MAGXI ","J9MAGYI ","J9MAGZI ","J9MBFXI ","J9MBFYI ","J9MBFZI ", & + "J9MBXI ","J9MBYI ","J9MBZI ","J9STAXI ","J9STAYI ","J9STAZI ","J9STVXI ", & + "J9STVYI ","J9STVZI ","J9VXI ","J9VYI ","J9VZI ","J9WAVEELEV","J9WAVEELV1", & + "J9WAVEELV2","M1N1AXI ","M1N1AYI ","M1N1AZI ","M1N1DYNP ","M1N1FAFXI ","M1N1FAFYI ", & + "M1N1FAFZI ","M1N1FAGXI ","M1N1FAGYI ","M1N1FAGZI ","M1N1FAMXI ","M1N1FAMYI ","M1N1FAMZI ", & + "M1N1FBFXI ","M1N1FBFYI ","M1N1FBFZI ","M1N1FBXI ","M1N1FBYI ","M1N1FBZI ","M1N1FDXI ", & + "M1N1FDYI ","M1N1FDZI ","M1N1FIXI ","M1N1FIYI ","M1N1FIZI ","M1N1FMGXI ","M1N1FMGYI ", & + "M1N1FMGZI ","M1N1MAFXI ","M1N1MAFYI ","M1N1MAFZI ","M1N1MAGXI ","M1N1MAGYI ","M1N1MAGZI ", & + "M1N1MBFXI ","M1N1MBFYI ","M1N1MBFZI ","M1N1MBXI ","M1N1MBYI ","M1N1MBZI ","M1N1MMGXI ", & + "M1N1MMGYI ","M1N1MMGZI ","M1N1STAXI ","M1N1STAYI ","M1N1STAZI ","M1N1STVXI ","M1N1STVYI ", & + "M1N1STVZI ","M1N1VXI ","M1N1VYI ","M1N1VZI ","M1N2AXI ","M1N2AYI ","M1N2AZI ", & + "M1N2DYNP ","M1N2FAFXI ","M1N2FAFYI ","M1N2FAFZI ","M1N2FAGXI ","M1N2FAGYI ","M1N2FAGZI ", & + "M1N2FAMXI ","M1N2FAMYI ","M1N2FAMZI ","M1N2FBFXI ","M1N2FBFYI ","M1N2FBFZI ","M1N2FBXI ", & + "M1N2FBYI ","M1N2FBZI ","M1N2FDXI ","M1N2FDYI ","M1N2FDZI ","M1N2FIXI ","M1N2FIYI ", & + "M1N2FIZI ","M1N2FMGXI ","M1N2FMGYI ","M1N2FMGZI ","M1N2MAFXI ","M1N2MAFYI ","M1N2MAFZI ", & + "M1N2MAGXI ","M1N2MAGYI ","M1N2MAGZI ","M1N2MBFXI ","M1N2MBFYI ","M1N2MBFZI ","M1N2MBXI ", & + "M1N2MBYI ","M1N2MBZI ","M1N2MMGXI ","M1N2MMGYI ","M1N2MMGZI ","M1N2STAXI ","M1N2STAYI ", & + "M1N2STAZI ","M1N2STVXI ","M1N2STVYI ","M1N2STVZI ","M1N2VXI ","M1N2VYI ","M1N2VZI ", & + "M1N3AXI ","M1N3AYI ","M1N3AZI ","M1N3DYNP ","M1N3FAFXI ","M1N3FAFYI ","M1N3FAFZI ", & + "M1N3FAGXI ","M1N3FAGYI ","M1N3FAGZI ","M1N3FAMXI ","M1N3FAMYI ","M1N3FAMZI ","M1N3FBFXI ", & + "M1N3FBFYI ","M1N3FBFZI ","M1N3FBXI ","M1N3FBYI ","M1N3FBZI ","M1N3FDXI ","M1N3FDYI ", & + "M1N3FDZI ","M1N3FIXI ","M1N3FIYI ","M1N3FIZI ","M1N3FMGXI ","M1N3FMGYI ","M1N3FMGZI ", & + "M1N3MAFXI ","M1N3MAFYI ","M1N3MAFZI ","M1N3MAGXI ","M1N3MAGYI ","M1N3MAGZI ","M1N3MBFXI ", & + "M1N3MBFYI ","M1N3MBFZI ","M1N3MBXI ","M1N3MBYI ","M1N3MBZI ","M1N3MMGXI ","M1N3MMGYI ", & + "M1N3MMGZI ","M1N3STAXI ","M1N3STAYI ","M1N3STAZI ","M1N3STVXI ","M1N3STVYI ","M1N3STVZI ", & + "M1N3VXI ","M1N3VYI ","M1N3VZI ","M1N4AXI ","M1N4AYI ","M1N4AZI ","M1N4DYNP ", & + "M1N4FAFXI ","M1N4FAFYI ","M1N4FAFZI ","M1N4FAGXI ","M1N4FAGYI ","M1N4FAGZI ","M1N4FAMXI ", & + "M1N4FAMYI ","M1N4FAMZI ","M1N4FBFXI ","M1N4FBFYI ","M1N4FBFZI ","M1N4FBXI ","M1N4FBYI ", & + "M1N4FBZI ","M1N4FDXI ","M1N4FDYI ","M1N4FDZI ","M1N4FIXI ","M1N4FIYI ","M1N4FIZI ", & + "M1N4FMGXI ","M1N4FMGYI ","M1N4FMGZI ","M1N4MAFXI ","M1N4MAFYI ","M1N4MAFZI ","M1N4MAGXI ", & + "M1N4MAGYI ","M1N4MAGZI ","M1N4MBFXI ","M1N4MBFYI ","M1N4MBFZI ","M1N4MBXI ","M1N4MBYI ", & + "M1N4MBZI ","M1N4MMGXI ","M1N4MMGYI ","M1N4MMGZI ","M1N4STAXI ","M1N4STAYI ","M1N4STAZI ", & + "M1N4STVXI ","M1N4STVYI ","M1N4STVZI ","M1N4VXI ","M1N4VYI ","M1N4VZI ","M1N5AXI ", & + "M1N5AYI ","M1N5AZI ","M1N5DYNP ","M1N5FAFXI ","M1N5FAFYI ","M1N5FAFZI ","M1N5FAGXI ", & + "M1N5FAGYI ","M1N5FAGZI ","M1N5FAMXI ","M1N5FAMYI ","M1N5FAMZI ","M1N5FBFXI ","M1N5FBFYI ", & + "M1N5FBFZI ","M1N5FBXI ","M1N5FBYI ","M1N5FBZI ","M1N5FDXI ","M1N5FDYI ","M1N5FDZI ", & + "M1N5FIXI ","M1N5FIYI ","M1N5FIZI ","M1N5FMGXI ","M1N5FMGYI ","M1N5FMGZI ","M1N5MAFXI ", & + "M1N5MAFYI ","M1N5MAFZI ","M1N5MAGXI ","M1N5MAGYI ","M1N5MAGZI ","M1N5MBFXI ","M1N5MBFYI ", & + "M1N5MBFZI ","M1N5MBXI ","M1N5MBYI ","M1N5MBZI ","M1N5MMGXI ","M1N5MMGYI ","M1N5MMGZI ", & + "M1N5STAXI ","M1N5STAYI ","M1N5STAZI ","M1N5STVXI ","M1N5STVYI ","M1N5STVZI ","M1N5VXI ", & + "M1N5VYI ","M1N5VZI ","M1N6AXI ","M1N6AYI ","M1N6AZI ","M1N6DYNP ","M1N6FAFXI ", & + "M1N6FAFYI ","M1N6FAFZI ","M1N6FAGXI ","M1N6FAGYI ","M1N6FAGZI ","M1N6FAMXI ","M1N6FAMYI ", & + "M1N6FAMZI ","M1N6FBFXI ","M1N6FBFYI ","M1N6FBFZI ","M1N6FBXI ","M1N6FBYI ","M1N6FBZI ", & + "M1N6FDXI ","M1N6FDYI ","M1N6FDZI ","M1N6FIXI ","M1N6FIYI ","M1N6FIZI ","M1N6FMGXI ", & + "M1N6FMGYI ","M1N6FMGZI ","M1N6MAFXI ","M1N6MAFYI ","M1N6MAFZI ","M1N6MAGXI ","M1N6MAGYI ", & + "M1N6MAGZI ","M1N6MBFXI ","M1N6MBFYI ","M1N6MBFZI ","M1N6MBXI ","M1N6MBYI ","M1N6MBZI ", & + "M1N6MMGXI ","M1N6MMGYI ","M1N6MMGZI ","M1N6STAXI ","M1N6STAYI ","M1N6STAZI ","M1N6STVXI ", & + "M1N6STVYI ","M1N6STVZI ","M1N6VXI ","M1N6VYI ","M1N6VZI ","M1N7AXI ","M1N7AYI ", & + "M1N7AZI ","M1N7DYNP ","M1N7FAFXI ","M1N7FAFYI ","M1N7FAFZI ","M1N7FAGXI ","M1N7FAGYI ", & + "M1N7FAGZI ","M1N7FAMXI ","M1N7FAMYI ","M1N7FAMZI ","M1N7FBFXI ","M1N7FBFYI ","M1N7FBFZI ", & + "M1N7FBXI ","M1N7FBYI ","M1N7FBZI ","M1N7FDXI ","M1N7FDYI ","M1N7FDZI ","M1N7FIXI ", & + "M1N7FIYI ","M1N7FIZI ","M1N7FMGXI ","M1N7FMGYI ","M1N7FMGZI ","M1N7MAFXI ","M1N7MAFYI ", & + "M1N7MAFZI ","M1N7MAGXI ","M1N7MAGYI ","M1N7MAGZI ","M1N7MBFXI ","M1N7MBFYI ","M1N7MBFZI ", & + "M1N7MBXI ","M1N7MBYI ","M1N7MBZI ","M1N7MMGXI ","M1N7MMGYI ","M1N7MMGZI ","M1N7STAXI ", & + "M1N7STAYI ","M1N7STAZI ","M1N7STVXI ","M1N7STVYI ","M1N7STVZI ","M1N7VXI ","M1N7VYI ", & + "M1N7VZI ","M1N8AXI ","M1N8AYI ","M1N8AZI ","M1N8DYNP ","M1N8FAFXI ","M1N8FAFYI ", & + "M1N8FAFZI ","M1N8FAGXI ","M1N8FAGYI ","M1N8FAGZI ","M1N8FAMXI ","M1N8FAMYI ","M1N8FAMZI ", & + "M1N8FBFXI ","M1N8FBFYI ","M1N8FBFZI ","M1N8FBXI ","M1N8FBYI ","M1N8FBZI ","M1N8FDXI ", & + "M1N8FDYI ","M1N8FDZI ","M1N8FIXI ","M1N8FIYI ","M1N8FIZI ","M1N8FMGXI ","M1N8FMGYI ", & + "M1N8FMGZI ","M1N8MAFXI ","M1N8MAFYI ","M1N8MAFZI ","M1N8MAGXI ","M1N8MAGYI ","M1N8MAGZI ", & + "M1N8MBFXI ","M1N8MBFYI ","M1N8MBFZI ","M1N8MBXI ","M1N8MBYI ","M1N8MBZI ","M1N8MMGXI ", & + "M1N8MMGYI ","M1N8MMGZI ","M1N8STAXI ","M1N8STAYI ","M1N8STAZI ","M1N8STVXI ","M1N8STVYI ", & + "M1N8STVZI ","M1N8VXI ","M1N8VYI ","M1N8VZI ","M1N9AXI ","M1N9AYI ","M1N9AZI ", & + "M1N9DYNP ","M1N9FAFXI ","M1N9FAFYI ","M1N9FAFZI ","M1N9FAGXI ","M1N9FAGYI ","M1N9FAGZI ", & + "M1N9FAMXI ","M1N9FAMYI ","M1N9FAMZI ","M1N9FBFXI ","M1N9FBFYI ","M1N9FBFZI ","M1N9FBXI ", & + "M1N9FBYI ","M1N9FBZI ","M1N9FDXI ","M1N9FDYI ","M1N9FDZI ","M1N9FIXI ","M1N9FIYI ", & + "M1N9FIZI ","M1N9FMGXI ","M1N9FMGYI ","M1N9FMGZI ","M1N9MAFXI ","M1N9MAFYI ","M1N9MAFZI ", & + "M1N9MAGXI ","M1N9MAGYI ","M1N9MAGZI ","M1N9MBFXI ","M1N9MBFYI ","M1N9MBFZI ","M1N9MBXI ", & + "M1N9MBYI ","M1N9MBZI ","M1N9MMGXI ","M1N9MMGYI ","M1N9MMGZI ","M1N9STAXI ","M1N9STAYI ", & + "M1N9STAZI ","M1N9STVXI ","M1N9STVYI ","M1N9STVZI ","M1N9VXI ","M1N9VYI ","M1N9VZI ", & + "M2N1AXI ","M2N1AYI ","M2N1AZI ","M2N1DYNP ","M2N1FAFXI ","M2N1FAFYI ","M2N1FAFZI ", & + "M2N1FAGXI ","M2N1FAGYI ","M2N1FAGZI ","M2N1FAMXI ","M2N1FAMYI ","M2N1FAMZI ","M2N1FBFXI ", & + "M2N1FBFYI ","M2N1FBFZI ","M2N1FBXI ","M2N1FBYI ","M2N1FBZI ","M2N1FDXI ","M2N1FDYI ", & + "M2N1FDZI ","M2N1FIXI ","M2N1FIYI ","M2N1FIZI ","M2N1FMGXI ","M2N1FMGYI ","M2N1FMGZI ", & + "M2N1MAFXI ","M2N1MAFYI ","M2N1MAFZI ","M2N1MAGXI ","M2N1MAGYI ","M2N1MAGZI ","M2N1MBFXI ", & + "M2N1MBFYI ","M2N1MBFZI ","M2N1MBXI ","M2N1MBYI ","M2N1MBZI ","M2N1MMGXI ","M2N1MMGYI ", & + "M2N1MMGZI ","M2N1STAXI ","M2N1STAYI ","M2N1STAZI ","M2N1STVXI ","M2N1STVYI ","M2N1STVZI ", & + "M2N1VXI ","M2N1VYI ","M2N1VZI ","M2N2AXI ","M2N2AYI ","M2N2AZI ","M2N2DYNP ", & + "M2N2FAFXI ","M2N2FAFYI ","M2N2FAFZI ","M2N2FAGXI ","M2N2FAGYI ","M2N2FAGZI ","M2N2FAMXI ", & + "M2N2FAMYI ","M2N2FAMZI ","M2N2FBFXI ","M2N2FBFYI ","M2N2FBFZI ","M2N2FBXI ","M2N2FBYI ", & + "M2N2FBZI ","M2N2FDXI ","M2N2FDYI ","M2N2FDZI ","M2N2FIXI ","M2N2FIYI ","M2N2FIZI ", & + "M2N2FMGXI ","M2N2FMGYI ","M2N2FMGZI ","M2N2MAFXI ","M2N2MAFYI ","M2N2MAFZI ","M2N2MAGXI ", & + "M2N2MAGYI ","M2N2MAGZI ","M2N2MBFXI ","M2N2MBFYI ","M2N2MBFZI ","M2N2MBXI ","M2N2MBYI ", & + "M2N2MBZI ","M2N2MMGXI ","M2N2MMGYI ","M2N2MMGZI ","M2N2STAXI ","M2N2STAYI ","M2N2STAZI ", & + "M2N2STVXI ","M2N2STVYI ","M2N2STVZI ","M2N2VXI ","M2N2VYI ","M2N2VZI ","M2N3AXI ", & + "M2N3AYI ","M2N3AZI ","M2N3DYNP ","M2N3FAFXI ","M2N3FAFYI ","M2N3FAFZI ","M2N3FAGXI ", & + "M2N3FAGYI ","M2N3FAGZI ","M2N3FAMXI ","M2N3FAMYI ","M2N3FAMZI ","M2N3FBFXI ","M2N3FBFYI ", & + "M2N3FBFZI ","M2N3FBXI ","M2N3FBYI ","M2N3FBZI ","M2N3FDXI ","M2N3FDYI ","M2N3FDZI ", & + "M2N3FIXI ","M2N3FIYI ","M2N3FIZI ","M2N3FMGXI ","M2N3FMGYI ","M2N3FMGZI ","M2N3MAFXI ", & + "M2N3MAFYI ","M2N3MAFZI ","M2N3MAGXI ","M2N3MAGYI ","M2N3MAGZI ","M2N3MBFXI ","M2N3MBFYI ", & + "M2N3MBFZI ","M2N3MBXI ","M2N3MBYI ","M2N3MBZI ","M2N3MMGXI ","M2N3MMGYI ","M2N3MMGZI ", & + "M2N3STAXI ","M2N3STAYI ","M2N3STAZI ","M2N3STVXI ","M2N3STVYI ","M2N3STVZI ","M2N3VXI ", & + "M2N3VYI ","M2N3VZI ","M2N4AXI ","M2N4AYI ","M2N4AZI ","M2N4DYNP ","M2N4FAFXI ", & + "M2N4FAFYI ","M2N4FAFZI ","M2N4FAGXI ","M2N4FAGYI ","M2N4FAGZI ","M2N4FAMXI ","M2N4FAMYI ", & + "M2N4FAMZI ","M2N4FBFXI ","M2N4FBFYI ","M2N4FBFZI ","M2N4FBXI ","M2N4FBYI ","M2N4FBZI ", & + "M2N4FDXI ","M2N4FDYI ","M2N4FDZI ","M2N4FIXI ","M2N4FIYI ","M2N4FIZI ","M2N4FMGXI ", & + "M2N4FMGYI ","M2N4FMGZI ","M2N4MAFXI ","M2N4MAFYI ","M2N4MAFZI ","M2N4MAGXI ","M2N4MAGYI ", & + "M2N4MAGZI ","M2N4MBFXI ","M2N4MBFYI ","M2N4MBFZI ","M2N4MBXI ","M2N4MBYI ","M2N4MBZI ", & + "M2N4MMGXI ","M2N4MMGYI ","M2N4MMGZI ","M2N4STAXI ","M2N4STAYI ","M2N4STAZI ","M2N4STVXI ", & + "M2N4STVYI ","M2N4STVZI ","M2N4VXI ","M2N4VYI ","M2N4VZI ","M2N5AXI ","M2N5AYI ", & + "M2N5AZI ","M2N5DYNP ","M2N5FAFXI ","M2N5FAFYI ","M2N5FAFZI ","M2N5FAGXI ","M2N5FAGYI ", & + "M2N5FAGZI ","M2N5FAMXI ","M2N5FAMYI ","M2N5FAMZI ","M2N5FBFXI ","M2N5FBFYI ","M2N5FBFZI ", & + "M2N5FBXI ","M2N5FBYI ","M2N5FBZI ","M2N5FDXI ","M2N5FDYI ","M2N5FDZI ","M2N5FIXI ", & + "M2N5FIYI ","M2N5FIZI ","M2N5FMGXI ","M2N5FMGYI ","M2N5FMGZI ","M2N5MAFXI ","M2N5MAFYI ", & + "M2N5MAFZI ","M2N5MAGXI ","M2N5MAGYI ","M2N5MAGZI ","M2N5MBFXI ","M2N5MBFYI ","M2N5MBFZI ", & + "M2N5MBXI ","M2N5MBYI ","M2N5MBZI ","M2N5MMGXI ","M2N5MMGYI ","M2N5MMGZI ","M2N5STAXI ", & + "M2N5STAYI ","M2N5STAZI ","M2N5STVXI ","M2N5STVYI ","M2N5STVZI ","M2N5VXI ","M2N5VYI ", & + "M2N5VZI ","M2N6AXI ","M2N6AYI ","M2N6AZI ","M2N6DYNP ","M2N6FAFXI ","M2N6FAFYI ", & + "M2N6FAFZI ","M2N6FAGXI ","M2N6FAGYI ","M2N6FAGZI ","M2N6FAMXI ","M2N6FAMYI ","M2N6FAMZI ", & + "M2N6FBFXI ","M2N6FBFYI ","M2N6FBFZI ","M2N6FBXI ","M2N6FBYI ","M2N6FBZI ","M2N6FDXI ", & + "M2N6FDYI ","M2N6FDZI ","M2N6FIXI ","M2N6FIYI ","M2N6FIZI ","M2N6FMGXI ","M2N6FMGYI ", & + "M2N6FMGZI ","M2N6MAFXI ","M2N6MAFYI ","M2N6MAFZI ","M2N6MAGXI ","M2N6MAGYI ","M2N6MAGZI ", & + "M2N6MBFXI ","M2N6MBFYI ","M2N6MBFZI ","M2N6MBXI ","M2N6MBYI ","M2N6MBZI ","M2N6MMGXI ", & + "M2N6MMGYI ","M2N6MMGZI ","M2N6STAXI ","M2N6STAYI ","M2N6STAZI ","M2N6STVXI ","M2N6STVYI ", & + "M2N6STVZI ","M2N6VXI ","M2N6VYI ","M2N6VZI ","M2N7AXI ","M2N7AYI ","M2N7AZI ", & + "M2N7DYNP ","M2N7FAFXI ","M2N7FAFYI ","M2N7FAFZI ","M2N7FAGXI ","M2N7FAGYI ","M2N7FAGZI ", & + "M2N7FAMXI ","M2N7FAMYI ","M2N7FAMZI ","M2N7FBFXI ","M2N7FBFYI ","M2N7FBFZI ","M2N7FBXI ", & + "M2N7FBYI ","M2N7FBZI ","M2N7FDXI ","M2N7FDYI ","M2N7FDZI ","M2N7FIXI ","M2N7FIYI ", & + "M2N7FIZI ","M2N7FMGXI ","M2N7FMGYI ","M2N7FMGZI ","M2N7MAFXI ","M2N7MAFYI ","M2N7MAFZI ", & + "M2N7MAGXI ","M2N7MAGYI ","M2N7MAGZI ","M2N7MBFXI ","M2N7MBFYI ","M2N7MBFZI ","M2N7MBXI ", & + "M2N7MBYI ","M2N7MBZI ","M2N7MMGXI ","M2N7MMGYI ","M2N7MMGZI ","M2N7STAXI ","M2N7STAYI ", & + "M2N7STAZI ","M2N7STVXI ","M2N7STVYI ","M2N7STVZI ","M2N7VXI ","M2N7VYI ","M2N7VZI ", & + "M2N8AXI ","M2N8AYI ","M2N8AZI ","M2N8DYNP ","M2N8FAFXI ","M2N8FAFYI ","M2N8FAFZI ", & + "M2N8FAGXI ","M2N8FAGYI ","M2N8FAGZI ","M2N8FAMXI ","M2N8FAMYI ","M2N8FAMZI ","M2N8FBFXI ", & + "M2N8FBFYI ","M2N8FBFZI ","M2N8FBXI ","M2N8FBYI ","M2N8FBZI ","M2N8FDXI ","M2N8FDYI ", & + "M2N8FDZI ","M2N8FIXI ","M2N8FIYI ","M2N8FIZI ","M2N8FMGXI ","M2N8FMGYI ","M2N8FMGZI ", & + "M2N8MAFXI ","M2N8MAFYI ","M2N8MAFZI ","M2N8MAGXI ","M2N8MAGYI ","M2N8MAGZI ","M2N8MBFXI ", & + "M2N8MBFYI ","M2N8MBFZI ","M2N8MBXI ","M2N8MBYI ","M2N8MBZI ","M2N8MMGXI ","M2N8MMGYI ", & + "M2N8MMGZI ","M2N8STAXI ","M2N8STAYI ","M2N8STAZI ","M2N8STVXI ","M2N8STVYI ","M2N8STVZI ", & + "M2N8VXI ","M2N8VYI ","M2N8VZI ","M2N9AXI ","M2N9AYI ","M2N9AZI ","M2N9DYNP ", & + "M2N9FAFXI ","M2N9FAFYI ","M2N9FAFZI ","M2N9FAGXI ","M2N9FAGYI ","M2N9FAGZI ","M2N9FAMXI ", & + "M2N9FAMYI ","M2N9FAMZI ","M2N9FBFXI ","M2N9FBFYI ","M2N9FBFZI ","M2N9FBXI ","M2N9FBYI ", & + "M2N9FBZI ","M2N9FDXI ","M2N9FDYI ","M2N9FDZI ","M2N9FIXI ","M2N9FIYI ","M2N9FIZI ", & + "M2N9FMGXI ","M2N9FMGYI ","M2N9FMGZI ","M2N9MAFXI ","M2N9MAFYI ","M2N9MAFZI ","M2N9MAGXI ", & + "M2N9MAGYI ","M2N9MAGZI ","M2N9MBFXI ","M2N9MBFYI ","M2N9MBFZI ","M2N9MBXI ","M2N9MBYI ", & + "M2N9MBZI ","M2N9MMGXI ","M2N9MMGYI ","M2N9MMGZI ","M2N9STAXI ","M2N9STAYI ","M2N9STAZI ", & + "M2N9STVXI ","M2N9STVYI ","M2N9STVZI ","M2N9VXI ","M2N9VYI ","M2N9VZI ","M3N1AXI ", & + "M3N1AYI ","M3N1AZI ","M3N1DYNP ","M3N1FAFXI ","M3N1FAFYI ","M3N1FAFZI ","M3N1FAGXI ", & + "M3N1FAGYI ","M3N1FAGZI ","M3N1FAMXI ","M3N1FAMYI ","M3N1FAMZI ","M3N1FBFXI ","M3N1FBFYI ", & + "M3N1FBFZI ","M3N1FBXI ","M3N1FBYI ","M3N1FBZI ","M3N1FDXI ","M3N1FDYI ","M3N1FDZI ", & + "M3N1FIXI ","M3N1FIYI ","M3N1FIZI ","M3N1FMGXI ","M3N1FMGYI ","M3N1FMGZI ","M3N1MAFXI ", & + "M3N1MAFYI ","M3N1MAFZI ","M3N1MAGXI ","M3N1MAGYI ","M3N1MAGZI ","M3N1MBFXI ","M3N1MBFYI ", & + "M3N1MBFZI ","M3N1MBXI ","M3N1MBYI ","M3N1MBZI ","M3N1MMGXI ","M3N1MMGYI ","M3N1MMGZI ", & + "M3N1STAXI ","M3N1STAYI ","M3N1STAZI ","M3N1STVXI ","M3N1STVYI ","M3N1STVZI ","M3N1VXI ", & + "M3N1VYI ","M3N1VZI ","M3N2AXI ","M3N2AYI ","M3N2AZI ","M3N2DYNP ","M3N2FAFXI ", & + "M3N2FAFYI ","M3N2FAFZI ","M3N2FAGXI ","M3N2FAGYI ","M3N2FAGZI ","M3N2FAMXI ","M3N2FAMYI ", & + "M3N2FAMZI ","M3N2FBFXI ","M3N2FBFYI ","M3N2FBFZI ","M3N2FBXI ","M3N2FBYI ","M3N2FBZI ", & + "M3N2FDXI ","M3N2FDYI ","M3N2FDZI ","M3N2FIXI ","M3N2FIYI ","M3N2FIZI ","M3N2FMGXI ", & + "M3N2FMGYI ","M3N2FMGZI ","M3N2MAFXI ","M3N2MAFYI ","M3N2MAFZI ","M3N2MAGXI ","M3N2MAGYI ", & + "M3N2MAGZI ","M3N2MBFXI ","M3N2MBFYI ","M3N2MBFZI ","M3N2MBXI ","M3N2MBYI ","M3N2MBZI ", & + "M3N2MMGXI ","M3N2MMGYI ","M3N2MMGZI ","M3N2STAXI ","M3N2STAYI ","M3N2STAZI ","M3N2STVXI ", & + "M3N2STVYI ","M3N2STVZI ","M3N2VXI ","M3N2VYI ","M3N2VZI ","M3N3AXI ","M3N3AYI ", & + "M3N3AZI ","M3N3DYNP ","M3N3FAFXI ","M3N3FAFYI ","M3N3FAFZI ","M3N3FAGXI ","M3N3FAGYI ", & + "M3N3FAGZI ","M3N3FAMXI ","M3N3FAMYI ","M3N3FAMZI ","M3N3FBFXI ","M3N3FBFYI ","M3N3FBFZI ", & + "M3N3FBXI ","M3N3FBYI ","M3N3FBZI ","M3N3FDXI ","M3N3FDYI ","M3N3FDZI ","M3N3FIXI ", & + "M3N3FIYI ","M3N3FIZI ","M3N3FMGXI ","M3N3FMGYI ","M3N3FMGZI ","M3N3MAFXI ","M3N3MAFYI ", & + "M3N3MAFZI ","M3N3MAGXI ","M3N3MAGYI ","M3N3MAGZI ","M3N3MBFXI ","M3N3MBFYI ","M3N3MBFZI ", & + "M3N3MBXI ","M3N3MBYI ","M3N3MBZI ","M3N3MMGXI ","M3N3MMGYI ","M3N3MMGZI ","M3N3STAXI ", & + "M3N3STAYI ","M3N3STAZI ","M3N3STVXI ","M3N3STVYI ","M3N3STVZI ","M3N3VXI ","M3N3VYI ", & + "M3N3VZI ","M3N4AXI ","M3N4AYI ","M3N4AZI ","M3N4DYNP ","M3N4FAFXI ","M3N4FAFYI ", & + "M3N4FAFZI ","M3N4FAGXI ","M3N4FAGYI ","M3N4FAGZI ","M3N4FAMXI ","M3N4FAMYI ","M3N4FAMZI ", & + "M3N4FBFXI ","M3N4FBFYI ","M3N4FBFZI ","M3N4FBXI ","M3N4FBYI ","M3N4FBZI ","M3N4FDXI ", & + "M3N4FDYI ","M3N4FDZI ","M3N4FIXI ","M3N4FIYI ","M3N4FIZI ","M3N4FMGXI ","M3N4FMGYI ", & + "M3N4FMGZI ","M3N4MAFXI ","M3N4MAFYI ","M3N4MAFZI ","M3N4MAGXI ","M3N4MAGYI ","M3N4MAGZI ", & + "M3N4MBFXI ","M3N4MBFYI "/) + CHARACTER(OutStrLenM1), PARAMETER :: ValidParamAry2(1542) = (/ & ! This lists the names of the allowed parameters, which must be sorted alphabetically + "M3N4MBFZI ","M3N4MBXI ","M3N4MBYI ","M3N4MBZI ","M3N4MMGXI ","M3N4MMGYI ","M3N4MMGZI ", & + "M3N4STAXI ","M3N4STAYI ","M3N4STAZI ","M3N4STVXI ","M3N4STVYI ","M3N4STVZI ","M3N4VXI ", & + "M3N4VYI ","M3N4VZI ","M3N5AXI ","M3N5AYI ","M3N5AZI ","M3N5DYNP ","M3N5FAFXI ", & + "M3N5FAFYI ","M3N5FAFZI ","M3N5FAGXI ","M3N5FAGYI ","M3N5FAGZI ","M3N5FAMXI ","M3N5FAMYI ", & + "M3N5FAMZI ","M3N5FBFXI ","M3N5FBFYI ","M3N5FBFZI ","M3N5FBXI ","M3N5FBYI ","M3N5FBZI ", & + "M3N5FDXI ","M3N5FDYI ","M3N5FDZI ","M3N5FIXI ","M3N5FIYI ","M3N5FIZI ","M3N5FMGXI ", & + "M3N5FMGYI ","M3N5FMGZI ","M3N5MAFXI ","M3N5MAFYI ","M3N5MAFZI ","M3N5MAGXI ","M3N5MAGYI ", & + "M3N5MAGZI ","M3N5MBFXI ","M3N5MBFYI ","M3N5MBFZI ","M3N5MBXI ","M3N5MBYI ","M3N5MBZI ", & + "M3N5MMGXI ","M3N5MMGYI ","M3N5MMGZI ","M3N5STAXI ","M3N5STAYI ","M3N5STAZI ","M3N5STVXI ", & + "M3N5STVYI ","M3N5STVZI ","M3N5VXI ","M3N5VYI ","M3N5VZI ","M3N6AXI ","M3N6AYI ", & + "M3N6AZI ","M3N6DYNP ","M3N6FAFXI ","M3N6FAFYI ","M3N6FAFZI ","M3N6FAGXI ","M3N6FAGYI ", & + "M3N6FAGZI ","M3N6FAMXI ","M3N6FAMYI ","M3N6FAMZI ","M3N6FBFXI ","M3N6FBFYI ","M3N6FBFZI ", & + "M3N6FBXI ","M3N6FBYI ","M3N6FBZI ","M3N6FDXI ","M3N6FDYI ","M3N6FDZI ","M3N6FIXI ", & + "M3N6FIYI ","M3N6FIZI ","M3N6FMGXI ","M3N6FMGYI ","M3N6FMGZI ","M3N6MAFXI ","M3N6MAFYI ", & + "M3N6MAFZI ","M3N6MAGXI ","M3N6MAGYI ","M3N6MAGZI ","M3N6MBFXI ","M3N6MBFYI ","M3N6MBFZI ", & + "M3N6MBXI ","M3N6MBYI ","M3N6MBZI ","M3N6MMGXI ","M3N6MMGYI ","M3N6MMGZI ","M3N6STAXI ", & + "M3N6STAYI ","M3N6STAZI ","M3N6STVXI ","M3N6STVYI ","M3N6STVZI ","M3N6VXI ","M3N6VYI ", & + "M3N6VZI ","M3N7AXI ","M3N7AYI ","M3N7AZI ","M3N7DYNP ","M3N7FAFXI ","M3N7FAFYI ", & + "M3N7FAFZI ","M3N7FAGXI ","M3N7FAGYI ","M3N7FAGZI ","M3N7FAMXI ","M3N7FAMYI ","M3N7FAMZI ", & + "M3N7FBFXI ","M3N7FBFYI ","M3N7FBFZI ","M3N7FBXI ","M3N7FBYI ","M3N7FBZI ","M3N7FDXI ", & + "M3N7FDYI ","M3N7FDZI ","M3N7FIXI ","M3N7FIYI ","M3N7FIZI ","M3N7FMGXI ","M3N7FMGYI ", & + "M3N7FMGZI ","M3N7MAFXI ","M3N7MAFYI ","M3N7MAFZI ","M3N7MAGXI ","M3N7MAGYI ","M3N7MAGZI ", & + "M3N7MBFXI ","M3N7MBFYI ","M3N7MBFZI ","M3N7MBXI ","M3N7MBYI ","M3N7MBZI ","M3N7MMGXI ", & + "M3N7MMGYI ","M3N7MMGZI ","M3N7STAXI ","M3N7STAYI ","M3N7STAZI ","M3N7STVXI ","M3N7STVYI ", & + "M3N7STVZI ","M3N7VXI ","M3N7VYI ","M3N7VZI ","M3N8AXI ","M3N8AYI ","M3N8AZI ", & + "M3N8DYNP ","M3N8FAFXI ","M3N8FAFYI ","M3N8FAFZI ","M3N8FAGXI ","M3N8FAGYI ","M3N8FAGZI ", & + "M3N8FAMXI ","M3N8FAMYI ","M3N8FAMZI ","M3N8FBFXI ","M3N8FBFYI ","M3N8FBFZI ","M3N8FBXI ", & + "M3N8FBYI ","M3N8FBZI ","M3N8FDXI ","M3N8FDYI ","M3N8FDZI ","M3N8FIXI ","M3N8FIYI ", & + "M3N8FIZI ","M3N8FMGXI ","M3N8FMGYI ","M3N8FMGZI ","M3N8MAFXI ","M3N8MAFYI ","M3N8MAFZI ", & + "M3N8MAGXI ","M3N8MAGYI ","M3N8MAGZI ","M3N8MBFXI ","M3N8MBFYI ","M3N8MBFZI ","M3N8MBXI ", & + "M3N8MBYI ","M3N8MBZI ","M3N8MMGXI ","M3N8MMGYI ","M3N8MMGZI ","M3N8STAXI ","M3N8STAYI ", & + "M3N8STAZI ","M3N8STVXI ","M3N8STVYI ","M3N8STVZI ","M3N8VXI ","M3N8VYI ","M3N8VZI ", & + "M3N9AXI ","M3N9AYI ","M3N9AZI ","M3N9DYNP ","M3N9FAFXI ","M3N9FAFYI ","M3N9FAFZI ", & + "M3N9FAGXI ","M3N9FAGYI ","M3N9FAGZI ","M3N9FAMXI ","M3N9FAMYI ","M3N9FAMZI ","M3N9FBFXI ", & + "M3N9FBFYI ","M3N9FBFZI ","M3N9FBXI ","M3N9FBYI ","M3N9FBZI ","M3N9FDXI ","M3N9FDYI ", & + "M3N9FDZI ","M3N9FIXI ","M3N9FIYI ","M3N9FIZI ","M3N9FMGXI ","M3N9FMGYI ","M3N9FMGZI ", & + "M3N9MAFXI ","M3N9MAFYI ","M3N9MAFZI ","M3N9MAGXI ","M3N9MAGYI ","M3N9MAGZI ","M3N9MBFXI ", & + "M3N9MBFYI ","M3N9MBFZI ","M3N9MBXI ","M3N9MBYI ","M3N9MBZI ","M3N9MMGXI ","M3N9MMGYI ", & + "M3N9MMGZI ","M3N9STAXI ","M3N9STAYI ","M3N9STAZI ","M3N9STVXI ","M3N9STVYI ","M3N9STVZI ", & + "M3N9VXI ","M3N9VYI ","M3N9VZI ","M4N1AXI ","M4N1AYI ","M4N1AZI ","M4N1DYNP ", & + "M4N1FAFXI ","M4N1FAFYI ","M4N1FAFZI ","M4N1FAGXI ","M4N1FAGYI ","M4N1FAGZI ","M4N1FAMXI ", & + "M4N1FAMYI ","M4N1FAMZI ","M4N1FBFXI ","M4N1FBFYI ","M4N1FBFZI ","M4N1FBXI ","M4N1FBYI ", & + "M4N1FBZI ","M4N1FDXI ","M4N1FDYI ","M4N1FDZI ","M4N1FIXI ","M4N1FIYI ","M4N1FIZI ", & + "M4N1FMGXI ","M4N1FMGYI ","M4N1FMGZI ","M4N1MAFXI ","M4N1MAFYI ","M4N1MAFZI ","M4N1MAGXI ", & + "M4N1MAGYI ","M4N1MAGZI ","M4N1MBFXI ","M4N1MBFYI ","M4N1MBFZI ","M4N1MBXI ","M4N1MBYI ", & + "M4N1MBZI ","M4N1MMGXI ","M4N1MMGYI ","M4N1MMGZI ","M4N1STAXI ","M4N1STAYI ","M4N1STAZI ", & + "M4N1STVXI ","M4N1STVYI ","M4N1STVZI ","M4N1VXI ","M4N1VYI ","M4N1VZI ","M4N2AXI ", & + "M4N2AYI ","M4N2AZI ","M4N2DYNP ","M4N2FAFXI ","M4N2FAFYI ","M4N2FAFZI ","M4N2FAGXI ", & + "M4N2FAGYI ","M4N2FAGZI ","M4N2FAMXI ","M4N2FAMYI ","M4N2FAMZI ","M4N2FBFXI ","M4N2FBFYI ", & + "M4N2FBFZI ","M4N2FBXI ","M4N2FBYI ","M4N2FBZI ","M4N2FDXI ","M4N2FDYI ","M4N2FDZI ", & + "M4N2FIXI ","M4N2FIYI ","M4N2FIZI ","M4N2FMGXI ","M4N2FMGYI ","M4N2FMGZI ","M4N2MAFXI ", & + "M4N2MAFYI ","M4N2MAFZI ","M4N2MAGXI ","M4N2MAGYI ","M4N2MAGZI ","M4N2MBFXI ","M4N2MBFYI ", & + "M4N2MBFZI ","M4N2MBXI ","M4N2MBYI ","M4N2MBZI ","M4N2MMGXI ","M4N2MMGYI ","M4N2MMGZI ", & + "M4N2STAXI ","M4N2STAYI ","M4N2STAZI ","M4N2STVXI ","M4N2STVYI ","M4N2STVZI ","M4N2VXI ", & + "M4N2VYI ","M4N2VZI ","M4N3AXI ","M4N3AYI ","M4N3AZI ","M4N3DYNP ","M4N3FAFXI ", & + "M4N3FAFYI ","M4N3FAFZI ","M4N3FAGXI ","M4N3FAGYI ","M4N3FAGZI ","M4N3FAMXI ","M4N3FAMYI ", & + "M4N3FAMZI ","M4N3FBFXI ","M4N3FBFYI ","M4N3FBFZI ","M4N3FBXI ","M4N3FBYI ","M4N3FBZI ", & + "M4N3FDXI ","M4N3FDYI ","M4N3FDZI ","M4N3FIXI ","M4N3FIYI ","M4N3FIZI ","M4N3FMGXI ", & + "M4N3FMGYI ","M4N3FMGZI ","M4N3MAFXI ","M4N3MAFYI ","M4N3MAFZI ","M4N3MAGXI ","M4N3MAGYI ", & + "M4N3MAGZI ","M4N3MBFXI ","M4N3MBFYI ","M4N3MBFZI ","M4N3MBXI ","M4N3MBYI ","M4N3MBZI ", & + "M4N3MMGXI ","M4N3MMGYI ","M4N3MMGZI ","M4N3STAXI ","M4N3STAYI ","M4N3STAZI ","M4N3STVXI ", & + "M4N3STVYI ","M4N3STVZI ","M4N3VXI ","M4N3VYI ","M4N3VZI ","M4N4AXI ","M4N4AYI ", & + "M4N4AZI ","M4N4DYNP ","M4N4FAFXI ","M4N4FAFYI ","M4N4FAFZI ","M4N4FAGXI ","M4N4FAGYI ", & + "M4N4FAGZI ","M4N4FAMXI ","M4N4FAMYI ","M4N4FAMZI ","M4N4FBFXI ","M4N4FBFYI ","M4N4FBFZI ", & + "M4N4FBXI ","M4N4FBYI ","M4N4FBZI ","M4N4FDXI ","M4N4FDYI ","M4N4FDZI ","M4N4FIXI ", & + "M4N4FIYI ","M4N4FIZI ","M4N4FMGXI ","M4N4FMGYI ","M4N4FMGZI ","M4N4MAFXI ","M4N4MAFYI ", & + "M4N4MAFZI ","M4N4MAGXI ","M4N4MAGYI ","M4N4MAGZI ","M4N4MBFXI ","M4N4MBFYI ","M4N4MBFZI ", & + "M4N4MBXI ","M4N4MBYI ","M4N4MBZI ","M4N4MMGXI ","M4N4MMGYI ","M4N4MMGZI ","M4N4STAXI ", & + "M4N4STAYI ","M4N4STAZI ","M4N4STVXI ","M4N4STVYI ","M4N4STVZI ","M4N4VXI ","M4N4VYI ", & + "M4N4VZI ","M4N5AXI ","M4N5AYI ","M4N5AZI ","M4N5DYNP ","M4N5FAFXI ","M4N5FAFYI ", & + "M4N5FAFZI ","M4N5FAGXI ","M4N5FAGYI ","M4N5FAGZI ","M4N5FAMXI ","M4N5FAMYI ","M4N5FAMZI ", & + "M4N5FBFXI ","M4N5FBFYI ","M4N5FBFZI ","M4N5FBXI ","M4N5FBYI ","M4N5FBZI ","M4N5FDXI ", & + "M4N5FDYI ","M4N5FDZI ","M4N5FIXI ","M4N5FIYI ","M4N5FIZI ","M4N5FMGXI ","M4N5FMGYI ", & + "M4N5FMGZI ","M4N5MAFXI ","M4N5MAFYI ","M4N5MAFZI ","M4N5MAGXI ","M4N5MAGYI ","M4N5MAGZI ", & + "M4N5MBFXI ","M4N5MBFYI ","M4N5MBFZI ","M4N5MBXI ","M4N5MBYI ","M4N5MBZI ","M4N5MMGXI ", & + "M4N5MMGYI ","M4N5MMGZI ","M4N5STAXI ","M4N5STAYI ","M4N5STAZI ","M4N5STVXI ","M4N5STVYI ", & + "M4N5STVZI ","M4N5VXI ","M4N5VYI ","M4N5VZI ","M4N6AXI ","M4N6AYI ","M4N6AZI ", & + "M4N6DYNP ","M4N6FAFXI ","M4N6FAFYI ","M4N6FAFZI ","M4N6FAGXI ","M4N6FAGYI ","M4N6FAGZI ", & + "M4N6FAMXI ","M4N6FAMYI ","M4N6FAMZI ","M4N6FBFXI ","M4N6FBFYI ","M4N6FBFZI ","M4N6FBXI ", & + "M4N6FBYI ","M4N6FBZI ","M4N6FDXI ","M4N6FDYI ","M4N6FDZI ","M4N6FIXI ","M4N6FIYI ", & + "M4N6FIZI ","M4N6FMGXI ","M4N6FMGYI ","M4N6FMGZI ","M4N6MAFXI ","M4N6MAFYI ","M4N6MAFZI ", & + "M4N6MAGXI ","M4N6MAGYI ","M4N6MAGZI ","M4N6MBFXI ","M4N6MBFYI ","M4N6MBFZI ","M4N6MBXI ", & + "M4N6MBYI ","M4N6MBZI ","M4N6MMGXI ","M4N6MMGYI ","M4N6MMGZI ","M4N6STAXI ","M4N6STAYI ", & + "M4N6STAZI ","M4N6STVXI ","M4N6STVYI ","M4N6STVZI ","M4N6VXI ","M4N6VYI ","M4N6VZI ", & + "M4N7AXI ","M4N7AYI ","M4N7AZI ","M4N7DYNP ","M4N7FAFXI ","M4N7FAFYI ","M4N7FAFZI ", & + "M4N7FAGXI ","M4N7FAGYI ","M4N7FAGZI ","M4N7FAMXI ","M4N7FAMYI ","M4N7FAMZI ","M4N7FBFXI ", & + "M4N7FBFYI ","M4N7FBFZI ","M4N7FBXI ","M4N7FBYI ","M4N7FBZI ","M4N7FDXI ","M4N7FDYI ", & + "M4N7FDZI ","M4N7FIXI ","M4N7FIYI ","M4N7FIZI ","M4N7FMGXI ","M4N7FMGYI ","M4N7FMGZI ", & + "M4N7MAFXI ","M4N7MAFYI ","M4N7MAFZI ","M4N7MAGXI ","M4N7MAGYI ","M4N7MAGZI ","M4N7MBFXI ", & + "M4N7MBFYI ","M4N7MBFZI ","M4N7MBXI ","M4N7MBYI ","M4N7MBZI ","M4N7MMGXI ","M4N7MMGYI ", & + "M4N7MMGZI ","M4N7STAXI ","M4N7STAYI ","M4N7STAZI ","M4N7STVXI ","M4N7STVYI ","M4N7STVZI ", & + "M4N7VXI ","M4N7VYI ","M4N7VZI ","M4N8AXI ","M4N8AYI ","M4N8AZI ","M4N8DYNP ", & + "M4N8FAFXI ","M4N8FAFYI ","M4N8FAFZI ","M4N8FAGXI ","M4N8FAGYI ","M4N8FAGZI ","M4N8FAMXI ", & + "M4N8FAMYI ","M4N8FAMZI ","M4N8FBFXI ","M4N8FBFYI ","M4N8FBFZI ","M4N8FBXI ","M4N8FBYI ", & + "M4N8FBZI ","M4N8FDXI ","M4N8FDYI ","M4N8FDZI ","M4N8FIXI ","M4N8FIYI ","M4N8FIZI ", & + "M4N8FMGXI ","M4N8FMGYI ","M4N8FMGZI ","M4N8MAFXI ","M4N8MAFYI ","M4N8MAFZI ","M4N8MAGXI ", & + "M4N8MAGYI ","M4N8MAGZI ","M4N8MBFXI ","M4N8MBFYI ","M4N8MBFZI ","M4N8MBXI ","M4N8MBYI ", & + "M4N8MBZI ","M4N8MMGXI ","M4N8MMGYI ","M4N8MMGZI ","M4N8STAXI ","M4N8STAYI ","M4N8STAZI ", & + "M4N8STVXI ","M4N8STVYI ","M4N8STVZI ","M4N8VXI ","M4N8VYI ","M4N8VZI ","M4N9AXI ", & + "M4N9AYI ","M4N9AZI ","M4N9DYNP ","M4N9FAFXI ","M4N9FAFYI ","M4N9FAFZI ","M4N9FAGXI ", & + "M4N9FAGYI ","M4N9FAGZI ","M4N9FAMXI ","M4N9FAMYI ","M4N9FAMZI ","M4N9FBFXI ","M4N9FBFYI ", & + "M4N9FBFZI ","M4N9FBXI ","M4N9FBYI ","M4N9FBZI ","M4N9FDXI ","M4N9FDYI ","M4N9FDZI ", & + "M4N9FIXI ","M4N9FIYI ","M4N9FIZI ","M4N9FMGXI ","M4N9FMGYI ","M4N9FMGZI ","M4N9MAFXI ", & + "M4N9MAFYI ","M4N9MAFZI ","M4N9MAGXI ","M4N9MAGYI ","M4N9MAGZI ","M4N9MBFXI ","M4N9MBFYI ", & + "M4N9MBFZI ","M4N9MBXI ","M4N9MBYI ","M4N9MBZI ","M4N9MMGXI ","M4N9MMGYI ","M4N9MMGZI ", & + "M4N9STAXI ","M4N9STAYI ","M4N9STAZI ","M4N9STVXI ","M4N9STVYI ","M4N9STVZI ","M4N9VXI ", & + "M4N9VYI ","M4N9VZI ","M5N1AXI ","M5N1AYI ","M5N1AZI ","M5N1DYNP ","M5N1FAFXI ", & + "M5N1FAFYI ","M5N1FAFZI ","M5N1FAGXI ","M5N1FAGYI ","M5N1FAGZI ","M5N1FAMXI ","M5N1FAMYI ", & + "M5N1FAMZI ","M5N1FBFXI ","M5N1FBFYI ","M5N1FBFZI ","M5N1FBXI ","M5N1FBYI ","M5N1FBZI ", & + "M5N1FDXI ","M5N1FDYI ","M5N1FDZI ","M5N1FIXI ","M5N1FIYI ","M5N1FIZI ","M5N1FMGXI ", & + "M5N1FMGYI ","M5N1FMGZI ","M5N1MAFXI ","M5N1MAFYI ","M5N1MAFZI ","M5N1MAGXI ","M5N1MAGYI ", & + "M5N1MAGZI ","M5N1MBFXI ","M5N1MBFYI ","M5N1MBFZI ","M5N1MBXI ","M5N1MBYI ","M5N1MBZI ", & + "M5N1MMGXI ","M5N1MMGYI ","M5N1MMGZI ","M5N1STAXI ","M5N1STAYI ","M5N1STAZI ","M5N1STVXI ", & + "M5N1STVYI ","M5N1STVZI ","M5N1VXI ","M5N1VYI ","M5N1VZI ","M5N2AXI ","M5N2AYI ", & + "M5N2AZI ","M5N2DYNP ","M5N2FAFXI ","M5N2FAFYI ","M5N2FAFZI ","M5N2FAGXI ","M5N2FAGYI ", & + "M5N2FAGZI ","M5N2FAMXI ","M5N2FAMYI ","M5N2FAMZI ","M5N2FBFXI ","M5N2FBFYI ","M5N2FBFZI ", & + "M5N2FBXI ","M5N2FBYI ","M5N2FBZI ","M5N2FDXI ","M5N2FDYI ","M5N2FDZI ","M5N2FIXI ", & + "M5N2FIYI ","M5N2FIZI ","M5N2FMGXI ","M5N2FMGYI ","M5N2FMGZI ","M5N2MAFXI ","M5N2MAFYI ", & + "M5N2MAFZI ","M5N2MAGXI ","M5N2MAGYI ","M5N2MAGZI ","M5N2MBFXI ","M5N2MBFYI ","M5N2MBFZI ", & + "M5N2MBXI ","M5N2MBYI ","M5N2MBZI ","M5N2MMGXI ","M5N2MMGYI ","M5N2MMGZI ","M5N2STAXI ", & + "M5N2STAYI ","M5N2STAZI ","M5N2STVXI ","M5N2STVYI ","M5N2STVZI ","M5N2VXI ","M5N2VYI ", & + "M5N2VZI ","M5N3AXI ","M5N3AYI ","M5N3AZI ","M5N3DYNP ","M5N3FAFXI ","M5N3FAFYI ", & + "M5N3FAFZI ","M5N3FAGXI ","M5N3FAGYI ","M5N3FAGZI ","M5N3FAMXI ","M5N3FAMYI ","M5N3FAMZI ", & + "M5N3FBFXI ","M5N3FBFYI ","M5N3FBFZI ","M5N3FBXI ","M5N3FBYI ","M5N3FBZI ","M5N3FDXI ", & + "M5N3FDYI ","M5N3FDZI ","M5N3FIXI ","M5N3FIYI ","M5N3FIZI ","M5N3FMGXI ","M5N3FMGYI ", & + "M5N3FMGZI ","M5N3MAFXI ","M5N3MAFYI ","M5N3MAFZI ","M5N3MAGXI ","M5N3MAGYI ","M5N3MAGZI ", & + "M5N3MBFXI ","M5N3MBFYI ","M5N3MBFZI ","M5N3MBXI ","M5N3MBYI ","M5N3MBZI ","M5N3MMGXI ", & + "M5N3MMGYI ","M5N3MMGZI ","M5N3STAXI ","M5N3STAYI ","M5N3STAZI ","M5N3STVXI ","M5N3STVYI ", & + "M5N3STVZI ","M5N3VXI ","M5N3VYI ","M5N3VZI ","M5N4AXI ","M5N4AYI ","M5N4AZI ", & + "M5N4DYNP ","M5N4FAFXI ","M5N4FAFYI ","M5N4FAFZI ","M5N4FAGXI ","M5N4FAGYI ","M5N4FAGZI ", & + "M5N4FAMXI ","M5N4FAMYI ","M5N4FAMZI ","M5N4FBFXI ","M5N4FBFYI ","M5N4FBFZI ","M5N4FBXI ", & + "M5N4FBYI ","M5N4FBZI ","M5N4FDXI ","M5N4FDYI ","M5N4FDZI ","M5N4FIXI ","M5N4FIYI ", & + "M5N4FIZI ","M5N4FMGXI ","M5N4FMGYI ","M5N4FMGZI ","M5N4MAFXI ","M5N4MAFYI ","M5N4MAFZI ", & + "M5N4MAGXI ","M5N4MAGYI ","M5N4MAGZI ","M5N4MBFXI ","M5N4MBFYI ","M5N4MBFZI ","M5N4MBXI ", & + "M5N4MBYI ","M5N4MBZI ","M5N4MMGXI ","M5N4MMGYI ","M5N4MMGZI ","M5N4STAXI ","M5N4STAYI ", & + "M5N4STAZI ","M5N4STVXI ","M5N4STVYI ","M5N4STVZI ","M5N4VXI ","M5N4VYI ","M5N4VZI ", & + "M5N5AXI ","M5N5AYI ","M5N5AZI ","M5N5DYNP ","M5N5FAFXI ","M5N5FAFYI ","M5N5FAFZI ", & + "M5N5FAGXI ","M5N5FAGYI ","M5N5FAGZI ","M5N5FAMXI ","M5N5FAMYI ","M5N5FAMZI ","M5N5FBFXI ", & + "M5N5FBFYI ","M5N5FBFZI ","M5N5FBXI ","M5N5FBYI ","M5N5FBZI ","M5N5FDXI ","M5N5FDYI ", & + "M5N5FDZI ","M5N5FIXI ","M5N5FIYI ","M5N5FIZI ","M5N5FMGXI ","M5N5FMGYI ","M5N5FMGZI ", & + "M5N5MAFXI ","M5N5MAFYI ","M5N5MAFZI ","M5N5MAGXI ","M5N5MAGYI ","M5N5MAGZI ","M5N5MBFXI ", & + "M5N5MBFYI ","M5N5MBFZI ","M5N5MBXI ","M5N5MBYI ","M5N5MBZI ","M5N5MMGXI ","M5N5MMGYI ", & + "M5N5MMGZI ","M5N5STAXI ","M5N5STAYI ","M5N5STAZI ","M5N5STVXI ","M5N5STVYI ","M5N5STVZI ", & + "M5N5VXI ","M5N5VYI ","M5N5VZI ","M5N6AXI ","M5N6AYI ","M5N6AZI ","M5N6DYNP ", & + "M5N6FAFXI ","M5N6FAFYI ","M5N6FAFZI ","M5N6FAGXI ","M5N6FAGYI ","M5N6FAGZI ","M5N6FAMXI ", & + "M5N6FAMYI ","M5N6FAMZI ","M5N6FBFXI ","M5N6FBFYI ","M5N6FBFZI ","M5N6FBXI ","M5N6FBYI ", & + "M5N6FBZI ","M5N6FDXI ","M5N6FDYI ","M5N6FDZI ","M5N6FIXI ","M5N6FIYI ","M5N6FIZI ", & + "M5N6FMGXI ","M5N6FMGYI ","M5N6FMGZI ","M5N6MAFXI ","M5N6MAFYI ","M5N6MAFZI ","M5N6MAGXI ", & + "M5N6MAGYI ","M5N6MAGZI ","M5N6MBFXI ","M5N6MBFYI ","M5N6MBFZI ","M5N6MBXI ","M5N6MBYI ", & + "M5N6MBZI ","M5N6MMGXI ","M5N6MMGYI ","M5N6MMGZI ","M5N6STAXI ","M5N6STAYI ","M5N6STAZI ", & + "M5N6STVXI ","M5N6STVYI ","M5N6STVZI ","M5N6VXI ","M5N6VYI ","M5N6VZI ","M5N7AXI ", & + "M5N7AYI ","M5N7AZI ","M5N7DYNP ","M5N7FAFXI ","M5N7FAFYI ","M5N7FAFZI ","M5N7FAGXI ", & + "M5N7FAGYI ","M5N7FAGZI ","M5N7FAMXI ","M5N7FAMYI ","M5N7FAMZI ","M5N7FBFXI ","M5N7FBFYI ", & + "M5N7FBFZI ","M5N7FBXI ","M5N7FBYI ","M5N7FBZI ","M5N7FDXI ","M5N7FDYI ","M5N7FDZI ", & + "M5N7FIXI ","M5N7FIYI ","M5N7FIZI ","M5N7FMGXI ","M5N7FMGYI ","M5N7FMGZI ","M5N7MAFXI ", & + "M5N7MAFYI ","M5N7MAFZI ","M5N7MAGXI ","M5N7MAGYI ","M5N7MAGZI ","M5N7MBFXI ","M5N7MBFYI ", & + "M5N7MBFZI ","M5N7MBXI ","M5N7MBYI ","M5N7MBZI ","M5N7MMGXI ","M5N7MMGYI ","M5N7MMGZI ", & + "M5N7STAXI ","M5N7STAYI ","M5N7STAZI ","M5N7STVXI ","M5N7STVYI ","M5N7STVZI ","M5N7VXI ", & + "M5N7VYI ","M5N7VZI ","M5N8AXI ","M5N8AYI ","M5N8AZI ","M5N8DYNP ","M5N8FAFXI ", & + "M5N8FAFYI ","M5N8FAFZI ","M5N8FAGXI ","M5N8FAGYI ","M5N8FAGZI ","M5N8FAMXI ","M5N8FAMYI ", & + "M5N8FAMZI ","M5N8FBFXI ","M5N8FBFYI ","M5N8FBFZI ","M5N8FBXI ","M5N8FBYI ","M5N8FBZI ", & + "M5N8FDXI ","M5N8FDYI ","M5N8FDZI ","M5N8FIXI ","M5N8FIYI ","M5N8FIZI ","M5N8FMGXI ", & + "M5N8FMGYI ","M5N8FMGZI ","M5N8MAFXI ","M5N8MAFYI ","M5N8MAFZI ","M5N8MAGXI ","M5N8MAGYI ", & + "M5N8MAGZI ","M5N8MBFXI ","M5N8MBFYI ","M5N8MBFZI ","M5N8MBXI ","M5N8MBYI ","M5N8MBZI ", & + "M5N8MMGXI ","M5N8MMGYI ","M5N8MMGZI ","M5N8STAXI ","M5N8STAYI ","M5N8STAZI ","M5N8STVXI ", & + "M5N8STVYI ","M5N8STVZI ","M5N8VXI ","M5N8VYI ","M5N8VZI ","M5N9AXI ","M5N9AYI ", & + "M5N9AZI ","M5N9DYNP ","M5N9FAFXI ","M5N9FAFYI ","M5N9FAFZI ","M5N9FAGXI ","M5N9FAGYI ", & + "M5N9FAGZI ","M5N9FAMXI ","M5N9FAMYI ","M5N9FAMZI ","M5N9FBFXI ","M5N9FBFYI ","M5N9FBFZI ", & + "M5N9FBXI ","M5N9FBYI ","M5N9FBZI ","M5N9FDXI ","M5N9FDYI ","M5N9FDZI ","M5N9FIXI ", & + "M5N9FIYI ","M5N9FIZI ","M5N9FMGXI ","M5N9FMGYI ","M5N9FMGZI ","M5N9MAFXI ","M5N9MAFYI ", & + "M5N9MAFZI ","M5N9MAGXI ","M5N9MAGYI ","M5N9MAGZI ","M5N9MBFXI ","M5N9MBFYI ","M5N9MBFZI ", & + "M5N9MBXI ","M5N9MBYI ","M5N9MBZI ","M5N9MMGXI ","M5N9MMGYI ","M5N9MMGZI ","M5N9STAXI ", & + "M5N9STAYI ","M5N9STAZI ","M5N9STVXI ","M5N9STVYI ","M5N9STVZI ","M5N9VXI ","M5N9VYI ", & + "M5N9VZI ","M6N1AXI ","M6N1AYI ","M6N1AZI ","M6N1DYNP ","M6N1FAFXI ","M6N1FAFYI ", & + "M6N1FAFZI ","M6N1FAGXI ","M6N1FAGYI ","M6N1FAGZI ","M6N1FAMXI ","M6N1FAMYI ","M6N1FAMZI ", & + "M6N1FBFXI ","M6N1FBFYI ","M6N1FBFZI ","M6N1FBXI ","M6N1FBYI ","M6N1FBZI ","M6N1FDXI ", & + "M6N1FDYI ","M6N1FDZI ","M6N1FIXI ","M6N1FIYI ","M6N1FIZI ","M6N1FMGXI ","M6N1FMGYI ", & + "M6N1FMGZI ","M6N1MAFXI ","M6N1MAFYI ","M6N1MAFZI ","M6N1MAGXI ","M6N1MAGYI ","M6N1MAGZI ", & + "M6N1MBFXI ","M6N1MBFYI ","M6N1MBFZI ","M6N1MBXI ","M6N1MBYI ","M6N1MBZI ","M6N1MMGXI ", & + "M6N1MMGYI ","M6N1MMGZI ","M6N1STAXI ","M6N1STAYI ","M6N1STAZI ","M6N1STVXI ","M6N1STVYI ", & + "M6N1STVZI ","M6N1VXI ","M6N1VYI ","M6N1VZI ","M6N2AXI ","M6N2AYI ","M6N2AZI ", & + "M6N2DYNP ","M6N2FAFXI ","M6N2FAFYI ","M6N2FAFZI ","M6N2FAGXI ","M6N2FAGYI ","M6N2FAGZI ", & + "M6N2FAMXI ","M6N2FAMYI ","M6N2FAMZI ","M6N2FBFXI ","M6N2FBFYI ","M6N2FBFZI ","M6N2FBXI ", & + "M6N2FBYI ","M6N2FBZI ","M6N2FDXI ","M6N2FDYI ","M6N2FDZI ","M6N2FIXI ","M6N2FIYI ", & + "M6N2FIZI ","M6N2FMGXI ","M6N2FMGYI ","M6N2FMGZI ","M6N2MAFXI ","M6N2MAFYI ","M6N2MAFZI ", & + "M6N2MAGXI ","M6N2MAGYI ","M6N2MAGZI ","M6N2MBFXI ","M6N2MBFYI ","M6N2MBFZI ","M6N2MBXI ", & + "M6N2MBYI ","M6N2MBZI ","M6N2MMGXI ","M6N2MMGYI ","M6N2MMGZI ","M6N2STAXI ","M6N2STAYI ", & + "M6N2STAZI ","M6N2STVXI ","M6N2STVYI ","M6N2STVZI ","M6N2VXI ","M6N2VYI ","M6N2VZI ", & + "M6N3AXI ","M6N3AYI ","M6N3AZI ","M6N3DYNP ","M6N3FAFXI ","M6N3FAFYI ","M6N3FAFZI ", & + "M6N3FAGXI ","M6N3FAGYI ","M6N3FAGZI ","M6N3FAMXI ","M6N3FAMYI ","M6N3FAMZI ","M6N3FBFXI ", & + "M6N3FBFYI ","M6N3FBFZI ","M6N3FBXI ","M6N3FBYI ","M6N3FBZI ","M6N3FDXI ","M6N3FDYI ", & + "M6N3FDZI ","M6N3FIXI ","M6N3FIYI ","M6N3FIZI ","M6N3FMGXI ","M6N3FMGYI ","M6N3FMGZI ", & + "M6N3MAFXI ","M6N3MAFYI ","M6N3MAFZI ","M6N3MAGXI ","M6N3MAGYI ","M6N3MAGZI ","M6N3MBFXI ", & + "M6N3MBFYI ","M6N3MBFZI ","M6N3MBXI ","M6N3MBYI ","M6N3MBZI ","M6N3MMGXI ","M6N3MMGYI ", & + "M6N3MMGZI ","M6N3STAXI ","M6N3STAYI ","M6N3STAZI ","M6N3STVXI ","M6N3STVYI ","M6N3STVZI ", & + "M6N3VXI ","M6N3VYI ","M6N3VZI ","M6N4AXI ","M6N4AYI ","M6N4AZI ","M6N4DYNP ", & + "M6N4FAFXI ","M6N4FAFYI ","M6N4FAFZI ","M6N4FAGXI ","M6N4FAGYI ","M6N4FAGZI ","M6N4FAMXI ", & + "M6N4FAMYI ","M6N4FAMZI ","M6N4FBFXI ","M6N4FBFYI ","M6N4FBFZI ","M6N4FBXI ","M6N4FBYI ", & + "M6N4FBZI ","M6N4FDXI ","M6N4FDYI ","M6N4FDZI ","M6N4FIXI ","M6N4FIYI ","M6N4FIZI ", & + "M6N4FMGXI ","M6N4FMGYI ","M6N4FMGZI ","M6N4MAFXI ","M6N4MAFYI ","M6N4MAFZI ","M6N4MAGXI ", & + "M6N4MAGYI ","M6N4MAGZI ","M6N4MBFXI ","M6N4MBFYI ","M6N4MBFZI ","M6N4MBXI ","M6N4MBYI ", & + "M6N4MBZI ","M6N4MMGXI ","M6N4MMGYI ","M6N4MMGZI ","M6N4STAXI ","M6N4STAYI ","M6N4STAZI ", & + "M6N4STVXI ","M6N4STVYI ","M6N4STVZI ","M6N4VXI ","M6N4VYI ","M6N4VZI ","M6N5AXI ", & + "M6N5AYI ","M6N5AZI ","M6N5DYNP ","M6N5FAFXI ","M6N5FAFYI ","M6N5FAFZI ","M6N5FAGXI ", & + "M6N5FAGYI ","M6N5FAGZI ","M6N5FAMXI ","M6N5FAMYI ","M6N5FAMZI ","M6N5FBFXI ","M6N5FBFYI ", & + "M6N5FBFZI ","M6N5FBXI ","M6N5FBYI ","M6N5FBZI ","M6N5FDXI ","M6N5FDYI ","M6N5FDZI ", & + "M6N5FIXI ","M6N5FIYI ","M6N5FIZI ","M6N5FMGXI ","M6N5FMGYI ","M6N5FMGZI ","M6N5MAFXI ", & + "M6N5MAFYI ","M6N5MAFZI ","M6N5MAGXI ","M6N5MAGYI ","M6N5MAGZI ","M6N5MBFXI ","M6N5MBFYI ", & + "M6N5MBFZI ","M6N5MBXI ","M6N5MBYI ","M6N5MBZI ","M6N5MMGXI ","M6N5MMGYI ","M6N5MMGZI ", & + "M6N5STAXI ","M6N5STAYI ","M6N5STAZI ","M6N5STVXI ","M6N5STVYI ","M6N5STVZI ","M6N5VXI ", & + "M6N5VYI ","M6N5VZI ","M6N6AXI ","M6N6AYI ","M6N6AZI ","M6N6DYNP ","M6N6FAFXI ", & + "M6N6FAFYI ","M6N6FAFZI ","M6N6FAGXI ","M6N6FAGYI ","M6N6FAGZI ","M6N6FAMXI ","M6N6FAMYI ", & + "M6N6FAMZI ","M6N6FBFXI ","M6N6FBFYI ","M6N6FBFZI ","M6N6FBXI ","M6N6FBYI ","M6N6FBZI ", & + "M6N6FDXI ","M6N6FDYI ","M6N6FDZI ","M6N6FIXI ","M6N6FIYI ","M6N6FIZI ","M6N6FMGXI ", & + "M6N6FMGYI ","M6N6FMGZI ","M6N6MAFXI ","M6N6MAFYI ","M6N6MAFZI ","M6N6MAGXI ","M6N6MAGYI ", & + "M6N6MAGZI ","M6N6MBFXI ","M6N6MBFYI ","M6N6MBFZI ","M6N6MBXI ","M6N6MBYI ","M6N6MBZI ", & + "M6N6MMGXI ","M6N6MMGYI ","M6N6MMGZI ","M6N6STAXI ","M6N6STAYI ","M6N6STAZI ","M6N6STVXI ", & + "M6N6STVYI ","M6N6STVZI ","M6N6VXI ","M6N6VYI ","M6N6VZI ","M6N7AXI ","M6N7AYI ", & + "M6N7AZI ","M6N7DYNP ","M6N7FAFXI ","M6N7FAFYI ","M6N7FAFZI ","M6N7FAGXI ","M6N7FAGYI ", & + "M6N7FAGZI ","M6N7FAMXI ","M6N7FAMYI ","M6N7FAMZI ","M6N7FBFXI ","M6N7FBFYI ","M6N7FBFZI ", & + "M6N7FBXI ","M6N7FBYI "/) + CHARACTER(OutStrLenM1), PARAMETER :: ValidParamAry3(1542) = (/ & ! This lists the names of the allowed parameters, which must be sorted alphabetically + "M6N7FBZI ","M6N7FDXI ","M6N7FDYI ","M6N7FDZI ","M6N7FIXI ","M6N7FIYI ","M6N7FIZI ", & + "M6N7FMGXI ","M6N7FMGYI ","M6N7FMGZI ","M6N7MAFXI ","M6N7MAFYI ","M6N7MAFZI ","M6N7MAGXI ", & + "M6N7MAGYI ","M6N7MAGZI ","M6N7MBFXI ","M6N7MBFYI ","M6N7MBFZI ","M6N7MBXI ","M6N7MBYI ", & + "M6N7MBZI ","M6N7MMGXI ","M6N7MMGYI ","M6N7MMGZI ","M6N7STAXI ","M6N7STAYI ","M6N7STAZI ", & + "M6N7STVXI ","M6N7STVYI ","M6N7STVZI ","M6N7VXI ","M6N7VYI ","M6N7VZI ","M6N8AXI ", & + "M6N8AYI ","M6N8AZI ","M6N8DYNP ","M6N8FAFXI ","M6N8FAFYI ","M6N8FAFZI ","M6N8FAGXI ", & + "M6N8FAGYI ","M6N8FAGZI ","M6N8FAMXI ","M6N8FAMYI ","M6N8FAMZI ","M6N8FBFXI ","M6N8FBFYI ", & + "M6N8FBFZI ","M6N8FBXI ","M6N8FBYI ","M6N8FBZI ","M6N8FDXI ","M6N8FDYI ","M6N8FDZI ", & + "M6N8FIXI ","M6N8FIYI ","M6N8FIZI ","M6N8FMGXI ","M6N8FMGYI ","M6N8FMGZI ","M6N8MAFXI ", & + "M6N8MAFYI ","M6N8MAFZI ","M6N8MAGXI ","M6N8MAGYI ","M6N8MAGZI ","M6N8MBFXI ","M6N8MBFYI ", & + "M6N8MBFZI ","M6N8MBXI ","M6N8MBYI ","M6N8MBZI ","M6N8MMGXI ","M6N8MMGYI ","M6N8MMGZI ", & + "M6N8STAXI ","M6N8STAYI ","M6N8STAZI ","M6N8STVXI ","M6N8STVYI ","M6N8STVZI ","M6N8VXI ", & + "M6N8VYI ","M6N8VZI ","M6N9AXI ","M6N9AYI ","M6N9AZI ","M6N9DYNP ","M6N9FAFXI ", & + "M6N9FAFYI ","M6N9FAFZI ","M6N9FAGXI ","M6N9FAGYI ","M6N9FAGZI ","M6N9FAMXI ","M6N9FAMYI ", & + "M6N9FAMZI ","M6N9FBFXI ","M6N9FBFYI ","M6N9FBFZI ","M6N9FBXI ","M6N9FBYI ","M6N9FBZI ", & + "M6N9FDXI ","M6N9FDYI ","M6N9FDZI ","M6N9FIXI ","M6N9FIYI ","M6N9FIZI ","M6N9FMGXI ", & + "M6N9FMGYI ","M6N9FMGZI ","M6N9MAFXI ","M6N9MAFYI ","M6N9MAFZI ","M6N9MAGXI ","M6N9MAGYI ", & + "M6N9MAGZI ","M6N9MBFXI ","M6N9MBFYI ","M6N9MBFZI ","M6N9MBXI ","M6N9MBYI ","M6N9MBZI ", & + "M6N9MMGXI ","M6N9MMGYI ","M6N9MMGZI ","M6N9STAXI ","M6N9STAYI ","M6N9STAZI ","M6N9STVXI ", & + "M6N9STVYI ","M6N9STVZI ","M6N9VXI ","M6N9VYI ","M6N9VZI ","M7N1AXI ","M7N1AYI ", & + "M7N1AZI ","M7N1DYNP ","M7N1FAFXI ","M7N1FAFYI ","M7N1FAFZI ","M7N1FAGXI ","M7N1FAGYI ", & + "M7N1FAGZI ","M7N1FAMXI ","M7N1FAMYI ","M7N1FAMZI ","M7N1FBFXI ","M7N1FBFYI ","M7N1FBFZI ", & + "M7N1FBXI ","M7N1FBYI ","M7N1FBZI ","M7N1FDXI ","M7N1FDYI ","M7N1FDZI ","M7N1FIXI ", & + "M7N1FIYI ","M7N1FIZI ","M7N1FMGXI ","M7N1FMGYI ","M7N1FMGZI ","M7N1MAFXI ","M7N1MAFYI ", & + "M7N1MAFZI ","M7N1MAGXI ","M7N1MAGYI ","M7N1MAGZI ","M7N1MBFXI ","M7N1MBFYI ","M7N1MBFZI ", & + "M7N1MBXI ","M7N1MBYI ","M7N1MBZI ","M7N1MMGXI ","M7N1MMGYI ","M7N1MMGZI ","M7N1STAXI ", & + "M7N1STAYI ","M7N1STAZI ","M7N1STVXI ","M7N1STVYI ","M7N1STVZI ","M7N1VXI ","M7N1VYI ", & + "M7N1VZI ","M7N2AXI ","M7N2AYI ","M7N2AZI ","M7N2DYNP ","M7N2FAFXI ","M7N2FAFYI ", & + "M7N2FAFZI ","M7N2FAGXI ","M7N2FAGYI ","M7N2FAGZI ","M7N2FAMXI ","M7N2FAMYI ","M7N2FAMZI ", & + "M7N2FBFXI ","M7N2FBFYI ","M7N2FBFZI ","M7N2FBXI ","M7N2FBYI ","M7N2FBZI ","M7N2FDXI ", & + "M7N2FDYI ","M7N2FDZI ","M7N2FIXI ","M7N2FIYI ","M7N2FIZI ","M7N2FMGXI ","M7N2FMGYI ", & + "M7N2FMGZI ","M7N2MAFXI ","M7N2MAFYI ","M7N2MAFZI ","M7N2MAGXI ","M7N2MAGYI ","M7N2MAGZI ", & + "M7N2MBFXI ","M7N2MBFYI ","M7N2MBFZI ","M7N2MBXI ","M7N2MBYI ","M7N2MBZI ","M7N2MMGXI ", & + "M7N2MMGYI ","M7N2MMGZI ","M7N2STAXI ","M7N2STAYI ","M7N2STAZI ","M7N2STVXI ","M7N2STVYI ", & + "M7N2STVZI ","M7N2VXI ","M7N2VYI ","M7N2VZI ","M7N3AXI ","M7N3AYI ","M7N3AZI ", & + "M7N3DYNP ","M7N3FAFXI ","M7N3FAFYI ","M7N3FAFZI ","M7N3FAGXI ","M7N3FAGYI ","M7N3FAGZI ", & + "M7N3FAMXI ","M7N3FAMYI ","M7N3FAMZI ","M7N3FBFXI ","M7N3FBFYI ","M7N3FBFZI ","M7N3FBXI ", & + "M7N3FBYI ","M7N3FBZI ","M7N3FDXI ","M7N3FDYI ","M7N3FDZI ","M7N3FIXI ","M7N3FIYI ", & + "M7N3FIZI ","M7N3FMGXI ","M7N3FMGYI ","M7N3FMGZI ","M7N3MAFXI ","M7N3MAFYI ","M7N3MAFZI ", & + "M7N3MAGXI ","M7N3MAGYI ","M7N3MAGZI ","M7N3MBFXI ","M7N3MBFYI ","M7N3MBFZI ","M7N3MBXI ", & + "M7N3MBYI ","M7N3MBZI ","M7N3MMGXI ","M7N3MMGYI ","M7N3MMGZI ","M7N3STAXI ","M7N3STAYI ", & + "M7N3STAZI ","M7N3STVXI ","M7N3STVYI ","M7N3STVZI ","M7N3VXI ","M7N3VYI ","M7N3VZI ", & + "M7N4AXI ","M7N4AYI ","M7N4AZI ","M7N4DYNP ","M7N4FAFXI ","M7N4FAFYI ","M7N4FAFZI ", & + "M7N4FAGXI ","M7N4FAGYI ","M7N4FAGZI ","M7N4FAMXI ","M7N4FAMYI ","M7N4FAMZI ","M7N4FBFXI ", & + "M7N4FBFYI ","M7N4FBFZI ","M7N4FBXI ","M7N4FBYI ","M7N4FBZI ","M7N4FDXI ","M7N4FDYI ", & + "M7N4FDZI ","M7N4FIXI ","M7N4FIYI ","M7N4FIZI ","M7N4FMGXI ","M7N4FMGYI ","M7N4FMGZI ", & + "M7N4MAFXI ","M7N4MAFYI ","M7N4MAFZI ","M7N4MAGXI ","M7N4MAGYI ","M7N4MAGZI ","M7N4MBFXI ", & + "M7N4MBFYI ","M7N4MBFZI ","M7N4MBXI ","M7N4MBYI ","M7N4MBZI ","M7N4MMGXI ","M7N4MMGYI ", & + "M7N4MMGZI ","M7N4STAXI ","M7N4STAYI ","M7N4STAZI ","M7N4STVXI ","M7N4STVYI ","M7N4STVZI ", & + "M7N4VXI ","M7N4VYI ","M7N4VZI ","M7N5AXI ","M7N5AYI ","M7N5AZI ","M7N5DYNP ", & + "M7N5FAFXI ","M7N5FAFYI ","M7N5FAFZI ","M7N5FAGXI ","M7N5FAGYI ","M7N5FAGZI ","M7N5FAMXI ", & + "M7N5FAMYI ","M7N5FAMZI ","M7N5FBFXI ","M7N5FBFYI ","M7N5FBFZI ","M7N5FBXI ","M7N5FBYI ", & + "M7N5FBZI ","M7N5FDXI ","M7N5FDYI ","M7N5FDZI ","M7N5FIXI ","M7N5FIYI ","M7N5FIZI ", & + "M7N5FMGXI ","M7N5FMGYI ","M7N5FMGZI ","M7N5MAFXI ","M7N5MAFYI ","M7N5MAFZI ","M7N5MAGXI ", & + "M7N5MAGYI ","M7N5MAGZI ","M7N5MBFXI ","M7N5MBFYI ","M7N5MBFZI ","M7N5MBXI ","M7N5MBYI ", & + "M7N5MBZI ","M7N5MMGXI ","M7N5MMGYI ","M7N5MMGZI ","M7N5STAXI ","M7N5STAYI ","M7N5STAZI ", & + "M7N5STVXI ","M7N5STVYI ","M7N5STVZI ","M7N5VXI ","M7N5VYI ","M7N5VZI ","M7N6AXI ", & + "M7N6AYI ","M7N6AZI ","M7N6DYNP ","M7N6FAFXI ","M7N6FAFYI ","M7N6FAFZI ","M7N6FAGXI ", & + "M7N6FAGYI ","M7N6FAGZI ","M7N6FAMXI ","M7N6FAMYI ","M7N6FAMZI ","M7N6FBFXI ","M7N6FBFYI ", & + "M7N6FBFZI ","M7N6FBXI ","M7N6FBYI ","M7N6FBZI ","M7N6FDXI ","M7N6FDYI ","M7N6FDZI ", & + "M7N6FIXI ","M7N6FIYI ","M7N6FIZI ","M7N6FMGXI ","M7N6FMGYI ","M7N6FMGZI ","M7N6MAFXI ", & + "M7N6MAFYI ","M7N6MAFZI ","M7N6MAGXI ","M7N6MAGYI ","M7N6MAGZI ","M7N6MBFXI ","M7N6MBFYI ", & + "M7N6MBFZI ","M7N6MBXI ","M7N6MBYI ","M7N6MBZI ","M7N6MMGXI ","M7N6MMGYI ","M7N6MMGZI ", & + "M7N6STAXI ","M7N6STAYI ","M7N6STAZI ","M7N6STVXI ","M7N6STVYI ","M7N6STVZI ","M7N6VXI ", & + "M7N6VYI ","M7N6VZI ","M7N7AXI ","M7N7AYI ","M7N7AZI ","M7N7DYNP ","M7N7FAFXI ", & + "M7N7FAFYI ","M7N7FAFZI ","M7N7FAGXI ","M7N7FAGYI ","M7N7FAGZI ","M7N7FAMXI ","M7N7FAMYI ", & + "M7N7FAMZI ","M7N7FBFXI ","M7N7FBFYI ","M7N7FBFZI ","M7N7FBXI ","M7N7FBYI ","M7N7FBZI ", & + "M7N7FDXI ","M7N7FDYI ","M7N7FDZI ","M7N7FIXI ","M7N7FIYI ","M7N7FIZI ","M7N7FMGXI ", & + "M7N7FMGYI ","M7N7FMGZI ","M7N7MAFXI ","M7N7MAFYI ","M7N7MAFZI ","M7N7MAGXI ","M7N7MAGYI ", & + "M7N7MAGZI ","M7N7MBFXI ","M7N7MBFYI ","M7N7MBFZI ","M7N7MBXI ","M7N7MBYI ","M7N7MBZI ", & + "M7N7MMGXI ","M7N7MMGYI ","M7N7MMGZI ","M7N7STAXI ","M7N7STAYI ","M7N7STAZI ","M7N7STVXI ", & + "M7N7STVYI ","M7N7STVZI ","M7N7VXI ","M7N7VYI ","M7N7VZI ","M7N8AXI ","M7N8AYI ", & + "M7N8AZI ","M7N8DYNP ","M7N8FAFXI ","M7N8FAFYI ","M7N8FAFZI ","M7N8FAGXI ","M7N8FAGYI ", & + "M7N8FAGZI ","M7N8FAMXI ","M7N8FAMYI ","M7N8FAMZI ","M7N8FBFXI ","M7N8FBFYI ","M7N8FBFZI ", & + "M7N8FBXI ","M7N8FBYI ","M7N8FBZI ","M7N8FDXI ","M7N8FDYI ","M7N8FDZI ","M7N8FIXI ", & + "M7N8FIYI ","M7N8FIZI ","M7N8FMGXI ","M7N8FMGYI ","M7N8FMGZI ","M7N8MAFXI ","M7N8MAFYI ", & + "M7N8MAFZI ","M7N8MAGXI ","M7N8MAGYI ","M7N8MAGZI ","M7N8MBFXI ","M7N8MBFYI ","M7N8MBFZI ", & + "M7N8MBXI ","M7N8MBYI ","M7N8MBZI ","M7N8MMGXI ","M7N8MMGYI ","M7N8MMGZI ","M7N8STAXI ", & + "M7N8STAYI ","M7N8STAZI ","M7N8STVXI ","M7N8STVYI ","M7N8STVZI ","M7N8VXI ","M7N8VYI ", & + "M7N8VZI ","M7N9AXI ","M7N9AYI ","M7N9AZI ","M7N9DYNP ","M7N9FAFXI ","M7N9FAFYI ", & + "M7N9FAFZI ","M7N9FAGXI ","M7N9FAGYI ","M7N9FAGZI ","M7N9FAMXI ","M7N9FAMYI ","M7N9FAMZI ", & + "M7N9FBFXI ","M7N9FBFYI ","M7N9FBFZI ","M7N9FBXI ","M7N9FBYI ","M7N9FBZI ","M7N9FDXI ", & + "M7N9FDYI ","M7N9FDZI ","M7N9FIXI ","M7N9FIYI ","M7N9FIZI ","M7N9FMGXI ","M7N9FMGYI ", & + "M7N9FMGZI ","M7N9MAFXI ","M7N9MAFYI ","M7N9MAFZI ","M7N9MAGXI ","M7N9MAGYI ","M7N9MAGZI ", & + "M7N9MBFXI ","M7N9MBFYI ","M7N9MBFZI ","M7N9MBXI ","M7N9MBYI ","M7N9MBZI ","M7N9MMGXI ", & + "M7N9MMGYI ","M7N9MMGZI ","M7N9STAXI ","M7N9STAYI ","M7N9STAZI ","M7N9STVXI ","M7N9STVYI ", & + "M7N9STVZI ","M7N9VXI ","M7N9VYI ","M7N9VZI ","M8N1AXI ","M8N1AYI ","M8N1AZI ", & + "M8N1DYNP ","M8N1FAFXI ","M8N1FAFYI ","M8N1FAFZI ","M8N1FAGXI ","M8N1FAGYI ","M8N1FAGZI ", & + "M8N1FAMXI ","M8N1FAMYI ","M8N1FAMZI ","M8N1FBFXI ","M8N1FBFYI ","M8N1FBFZI ","M8N1FBXI ", & + "M8N1FBYI ","M8N1FBZI ","M8N1FDXI ","M8N1FDYI ","M8N1FDZI ","M8N1FIXI ","M8N1FIYI ", & + "M8N1FIZI ","M8N1FMGXI ","M8N1FMGYI ","M8N1FMGZI ","M8N1MAFXI ","M8N1MAFYI ","M8N1MAFZI ", & + "M8N1MAGXI ","M8N1MAGYI ","M8N1MAGZI ","M8N1MBFXI ","M8N1MBFYI ","M8N1MBFZI ","M8N1MBXI ", & + "M8N1MBYI ","M8N1MBZI ","M8N1MMGXI ","M8N1MMGYI ","M8N1MMGZI ","M8N1STAXI ","M8N1STAYI ", & + "M8N1STAZI ","M8N1STVXI ","M8N1STVYI ","M8N1STVZI ","M8N1VXI ","M8N1VYI ","M8N1VZI ", & + "M8N2AXI ","M8N2AYI ","M8N2AZI ","M8N2DYNP ","M8N2FAFXI ","M8N2FAFYI ","M8N2FAFZI ", & + "M8N2FAGXI ","M8N2FAGYI ","M8N2FAGZI ","M8N2FAMXI ","M8N2FAMYI ","M8N2FAMZI ","M8N2FBFXI ", & + "M8N2FBFYI ","M8N2FBFZI ","M8N2FBXI ","M8N2FBYI ","M8N2FBZI ","M8N2FDXI ","M8N2FDYI ", & + "M8N2FDZI ","M8N2FIXI ","M8N2FIYI ","M8N2FIZI ","M8N2FMGXI ","M8N2FMGYI ","M8N2FMGZI ", & + "M8N2MAFXI ","M8N2MAFYI ","M8N2MAFZI ","M8N2MAGXI ","M8N2MAGYI ","M8N2MAGZI ","M8N2MBFXI ", & + "M8N2MBFYI ","M8N2MBFZI ","M8N2MBXI ","M8N2MBYI ","M8N2MBZI ","M8N2MMGXI ","M8N2MMGYI ", & + "M8N2MMGZI ","M8N2STAXI ","M8N2STAYI ","M8N2STAZI ","M8N2STVXI ","M8N2STVYI ","M8N2STVZI ", & + "M8N2VXI ","M8N2VYI ","M8N2VZI ","M8N3AXI ","M8N3AYI ","M8N3AZI ","M8N3DYNP ", & + "M8N3FAFXI ","M8N3FAFYI ","M8N3FAFZI ","M8N3FAGXI ","M8N3FAGYI ","M8N3FAGZI ","M8N3FAMXI ", & + "M8N3FAMYI ","M8N3FAMZI ","M8N3FBFXI ","M8N3FBFYI ","M8N3FBFZI ","M8N3FBXI ","M8N3FBYI ", & + "M8N3FBZI ","M8N3FDXI ","M8N3FDYI ","M8N3FDZI ","M8N3FIXI ","M8N3FIYI ","M8N3FIZI ", & + "M8N3FMGXI ","M8N3FMGYI ","M8N3FMGZI ","M8N3MAFXI ","M8N3MAFYI ","M8N3MAFZI ","M8N3MAGXI ", & + "M8N3MAGYI ","M8N3MAGZI ","M8N3MBFXI ","M8N3MBFYI ","M8N3MBFZI ","M8N3MBXI ","M8N3MBYI ", & + "M8N3MBZI ","M8N3MMGXI ","M8N3MMGYI ","M8N3MMGZI ","M8N3STAXI ","M8N3STAYI ","M8N3STAZI ", & + "M8N3STVXI ","M8N3STVYI ","M8N3STVZI ","M8N3VXI ","M8N3VYI ","M8N3VZI ","M8N4AXI ", & + "M8N4AYI ","M8N4AZI ","M8N4DYNP ","M8N4FAFXI ","M8N4FAFYI ","M8N4FAFZI ","M8N4FAGXI ", & + "M8N4FAGYI ","M8N4FAGZI ","M8N4FAMXI ","M8N4FAMYI ","M8N4FAMZI ","M8N4FBFXI ","M8N4FBFYI ", & + "M8N4FBFZI ","M8N4FBXI ","M8N4FBYI ","M8N4FBZI ","M8N4FDXI ","M8N4FDYI ","M8N4FDZI ", & + "M8N4FIXI ","M8N4FIYI ","M8N4FIZI ","M8N4FMGXI ","M8N4FMGYI ","M8N4FMGZI ","M8N4MAFXI ", & + "M8N4MAFYI ","M8N4MAFZI ","M8N4MAGXI ","M8N4MAGYI ","M8N4MAGZI ","M8N4MBFXI ","M8N4MBFYI ", & + "M8N4MBFZI ","M8N4MBXI ","M8N4MBYI ","M8N4MBZI ","M8N4MMGXI ","M8N4MMGYI ","M8N4MMGZI ", & + "M8N4STAXI ","M8N4STAYI ","M8N4STAZI ","M8N4STVXI ","M8N4STVYI ","M8N4STVZI ","M8N4VXI ", & + "M8N4VYI ","M8N4VZI ","M8N5AXI ","M8N5AYI ","M8N5AZI ","M8N5DYNP ","M8N5FAFXI ", & + "M8N5FAFYI ","M8N5FAFZI ","M8N5FAGXI ","M8N5FAGYI ","M8N5FAGZI ","M8N5FAMXI ","M8N5FAMYI ", & + "M8N5FAMZI ","M8N5FBFXI ","M8N5FBFYI ","M8N5FBFZI ","M8N5FBXI ","M8N5FBYI ","M8N5FBZI ", & + "M8N5FDXI ","M8N5FDYI ","M8N5FDZI ","M8N5FIXI ","M8N5FIYI ","M8N5FIZI ","M8N5FMGXI ", & + "M8N5FMGYI ","M8N5FMGZI ","M8N5MAFXI ","M8N5MAFYI ","M8N5MAFZI ","M8N5MAGXI ","M8N5MAGYI ", & + "M8N5MAGZI ","M8N5MBFXI ","M8N5MBFYI ","M8N5MBFZI ","M8N5MBXI ","M8N5MBYI ","M8N5MBZI ", & + "M8N5MMGXI ","M8N5MMGYI ","M8N5MMGZI ","M8N5STAXI ","M8N5STAYI ","M8N5STAZI ","M8N5STVXI ", & + "M8N5STVYI ","M8N5STVZI ","M8N5VXI ","M8N5VYI ","M8N5VZI ","M8N6AXI ","M8N6AYI ", & + "M8N6AZI ","M8N6DYNP ","M8N6FAFXI ","M8N6FAFYI ","M8N6FAFZI ","M8N6FAGXI ","M8N6FAGYI ", & + "M8N6FAGZI ","M8N6FAMXI ","M8N6FAMYI ","M8N6FAMZI ","M8N6FBFXI ","M8N6FBFYI ","M8N6FBFZI ", & + "M8N6FBXI ","M8N6FBYI ","M8N6FBZI ","M8N6FDXI ","M8N6FDYI ","M8N6FDZI ","M8N6FIXI ", & + "M8N6FIYI ","M8N6FIZI ","M8N6FMGXI ","M8N6FMGYI ","M8N6FMGZI ","M8N6MAFXI ","M8N6MAFYI ", & + "M8N6MAFZI ","M8N6MAGXI ","M8N6MAGYI ","M8N6MAGZI ","M8N6MBFXI ","M8N6MBFYI ","M8N6MBFZI ", & + "M8N6MBXI ","M8N6MBYI ","M8N6MBZI ","M8N6MMGXI ","M8N6MMGYI ","M8N6MMGZI ","M8N6STAXI ", & + "M8N6STAYI ","M8N6STAZI ","M8N6STVXI ","M8N6STVYI ","M8N6STVZI ","M8N6VXI ","M8N6VYI ", & + "M8N6VZI ","M8N7AXI ","M8N7AYI ","M8N7AZI ","M8N7DYNP ","M8N7FAFXI ","M8N7FAFYI ", & + "M8N7FAFZI ","M8N7FAGXI ","M8N7FAGYI ","M8N7FAGZI ","M8N7FAMXI ","M8N7FAMYI ","M8N7FAMZI ", & + "M8N7FBFXI ","M8N7FBFYI ","M8N7FBFZI ","M8N7FBXI ","M8N7FBYI ","M8N7FBZI ","M8N7FDXI ", & + "M8N7FDYI ","M8N7FDZI ","M8N7FIXI ","M8N7FIYI ","M8N7FIZI ","M8N7FMGXI ","M8N7FMGYI ", & + "M8N7FMGZI ","M8N7MAFXI ","M8N7MAFYI ","M8N7MAFZI ","M8N7MAGXI ","M8N7MAGYI ","M8N7MAGZI ", & + "M8N7MBFXI ","M8N7MBFYI ","M8N7MBFZI ","M8N7MBXI ","M8N7MBYI ","M8N7MBZI ","M8N7MMGXI ", & + "M8N7MMGYI ","M8N7MMGZI ","M8N7STAXI ","M8N7STAYI ","M8N7STAZI ","M8N7STVXI ","M8N7STVYI ", & + "M8N7STVZI ","M8N7VXI ","M8N7VYI ","M8N7VZI ","M8N8AXI ","M8N8AYI ","M8N8AZI ", & + "M8N8DYNP ","M8N8FAFXI ","M8N8FAFYI ","M8N8FAFZI ","M8N8FAGXI ","M8N8FAGYI ","M8N8FAGZI ", & + "M8N8FAMXI ","M8N8FAMYI ","M8N8FAMZI ","M8N8FBFXI ","M8N8FBFYI ","M8N8FBFZI ","M8N8FBXI ", & + "M8N8FBYI ","M8N8FBZI ","M8N8FDXI ","M8N8FDYI ","M8N8FDZI ","M8N8FIXI ","M8N8FIYI ", & + "M8N8FIZI ","M8N8FMGXI ","M8N8FMGYI ","M8N8FMGZI ","M8N8MAFXI ","M8N8MAFYI ","M8N8MAFZI ", & + "M8N8MAGXI ","M8N8MAGYI ","M8N8MAGZI ","M8N8MBFXI ","M8N8MBFYI ","M8N8MBFZI ","M8N8MBXI ", & + "M8N8MBYI ","M8N8MBZI ","M8N8MMGXI ","M8N8MMGYI ","M8N8MMGZI ","M8N8STAXI ","M8N8STAYI ", & + "M8N8STAZI ","M8N8STVXI ","M8N8STVYI ","M8N8STVZI ","M8N8VXI ","M8N8VYI ","M8N8VZI ", & + "M8N9AXI ","M8N9AYI ","M8N9AZI ","M8N9DYNP ","M8N9FAFXI ","M8N9FAFYI ","M8N9FAFZI ", & + "M8N9FAGXI ","M8N9FAGYI ","M8N9FAGZI ","M8N9FAMXI ","M8N9FAMYI ","M8N9FAMZI ","M8N9FBFXI ", & + "M8N9FBFYI ","M8N9FBFZI ","M8N9FBXI ","M8N9FBYI ","M8N9FBZI ","M8N9FDXI ","M8N9FDYI ", & + "M8N9FDZI ","M8N9FIXI ","M8N9FIYI ","M8N9FIZI ","M8N9FMGXI ","M8N9FMGYI ","M8N9FMGZI ", & + "M8N9MAFXI ","M8N9MAFYI ","M8N9MAFZI ","M8N9MAGXI ","M8N9MAGYI ","M8N9MAGZI ","M8N9MBFXI ", & + "M8N9MBFYI ","M8N9MBFZI ","M8N9MBXI ","M8N9MBYI ","M8N9MBZI ","M8N9MMGXI ","M8N9MMGYI ", & + "M8N9MMGZI ","M8N9STAXI ","M8N9STAYI ","M8N9STAZI ","M8N9STVXI ","M8N9STVYI ","M8N9STVZI ", & + "M8N9VXI ","M8N9VYI ","M8N9VZI ","M9N1AXI ","M9N1AYI ","M9N1AZI ","M9N1DYNP ", & + "M9N1FAFXI ","M9N1FAFYI ","M9N1FAFZI ","M9N1FAGXI ","M9N1FAGYI ","M9N1FAGZI ","M9N1FAMXI ", & + "M9N1FAMYI ","M9N1FAMZI ","M9N1FBFXI ","M9N1FBFYI ","M9N1FBFZI ","M9N1FBXI ","M9N1FBYI ", & + "M9N1FBZI ","M9N1FDXI ","M9N1FDYI ","M9N1FDZI ","M9N1FIXI ","M9N1FIYI ","M9N1FIZI ", & + "M9N1FMGXI ","M9N1FMGYI ","M9N1FMGZI ","M9N1MAFXI ","M9N1MAFYI ","M9N1MAFZI ","M9N1MAGXI ", & + "M9N1MAGYI ","M9N1MAGZI ","M9N1MBFXI ","M9N1MBFYI ","M9N1MBFZI ","M9N1MBXI ","M9N1MBYI ", & + "M9N1MBZI ","M9N1MMGXI ","M9N1MMGYI ","M9N1MMGZI ","M9N1STAXI ","M9N1STAYI ","M9N1STAZI ", & + "M9N1STVXI ","M9N1STVYI ","M9N1STVZI ","M9N1VXI ","M9N1VYI ","M9N1VZI ","M9N2AXI ", & + "M9N2AYI ","M9N2AZI ","M9N2DYNP ","M9N2FAFXI ","M9N2FAFYI ","M9N2FAFZI ","M9N2FAGXI ", & + "M9N2FAGYI ","M9N2FAGZI ","M9N2FAMXI ","M9N2FAMYI ","M9N2FAMZI ","M9N2FBFXI ","M9N2FBFYI ", & + "M9N2FBFZI ","M9N2FBXI ","M9N2FBYI ","M9N2FBZI ","M9N2FDXI ","M9N2FDYI ","M9N2FDZI ", & + "M9N2FIXI ","M9N2FIYI ","M9N2FIZI ","M9N2FMGXI ","M9N2FMGYI ","M9N2FMGZI ","M9N2MAFXI ", & + "M9N2MAFYI ","M9N2MAFZI ","M9N2MAGXI ","M9N2MAGYI ","M9N2MAGZI ","M9N2MBFXI ","M9N2MBFYI ", & + "M9N2MBFZI ","M9N2MBXI ","M9N2MBYI ","M9N2MBZI ","M9N2MMGXI ","M9N2MMGYI ","M9N2MMGZI ", & + "M9N2STAXI ","M9N2STAYI ","M9N2STAZI ","M9N2STVXI ","M9N2STVYI ","M9N2STVZI ","M9N2VXI ", & + "M9N2VYI ","M9N2VZI ","M9N3AXI ","M9N3AYI ","M9N3AZI ","M9N3DYNP ","M9N3FAFXI ", & + "M9N3FAFYI ","M9N3FAFZI ","M9N3FAGXI ","M9N3FAGYI ","M9N3FAGZI ","M9N3FAMXI ","M9N3FAMYI ", & + "M9N3FAMZI ","M9N3FBFXI ","M9N3FBFYI ","M9N3FBFZI ","M9N3FBXI ","M9N3FBYI ","M9N3FBZI ", & + "M9N3FDXI ","M9N3FDYI ","M9N3FDZI ","M9N3FIXI ","M9N3FIYI ","M9N3FIZI ","M9N3FMGXI ", & + "M9N3FMGYI ","M9N3FMGZI ","M9N3MAFXI ","M9N3MAFYI ","M9N3MAFZI ","M9N3MAGXI ","M9N3MAGYI ", & + "M9N3MAGZI ","M9N3MBFXI ","M9N3MBFYI ","M9N3MBFZI ","M9N3MBXI ","M9N3MBYI ","M9N3MBZI ", & + "M9N3MMGXI ","M9N3MMGYI ","M9N3MMGZI ","M9N3STAXI ","M9N3STAYI ","M9N3STAZI ","M9N3STVXI ", & + "M9N3STVYI ","M9N3STVZI ","M9N3VXI ","M9N3VYI ","M9N3VZI ","M9N4AXI ","M9N4AYI ", & + "M9N4AZI ","M9N4DYNP ","M9N4FAFXI ","M9N4FAFYI ","M9N4FAFZI ","M9N4FAGXI ","M9N4FAGYI ", & + "M9N4FAGZI ","M9N4FAMXI ","M9N4FAMYI ","M9N4FAMZI ","M9N4FBFXI ","M9N4FBFYI ","M9N4FBFZI ", & + "M9N4FBXI ","M9N4FBYI ","M9N4FBZI ","M9N4FDXI ","M9N4FDYI ","M9N4FDZI ","M9N4FIXI ", & + "M9N4FIYI ","M9N4FIZI ","M9N4FMGXI ","M9N4FMGYI ","M9N4FMGZI ","M9N4MAFXI ","M9N4MAFYI ", & + "M9N4MAFZI ","M9N4MAGXI ","M9N4MAGYI ","M9N4MAGZI ","M9N4MBFXI ","M9N4MBFYI ","M9N4MBFZI ", & + "M9N4MBXI ","M9N4MBYI ","M9N4MBZI ","M9N4MMGXI ","M9N4MMGYI ","M9N4MMGZI ","M9N4STAXI ", & + "M9N4STAYI ","M9N4STAZI ","M9N4STVXI ","M9N4STVYI ","M9N4STVZI ","M9N4VXI ","M9N4VYI ", & + "M9N4VZI ","M9N5AXI ","M9N5AYI ","M9N5AZI ","M9N5DYNP ","M9N5FAFXI ","M9N5FAFYI ", & + "M9N5FAFZI ","M9N5FAGXI ","M9N5FAGYI ","M9N5FAGZI ","M9N5FAMXI ","M9N5FAMYI ","M9N5FAMZI ", & + "M9N5FBFXI ","M9N5FBFYI ","M9N5FBFZI ","M9N5FBXI ","M9N5FBYI ","M9N5FBZI ","M9N5FDXI ", & + "M9N5FDYI ","M9N5FDZI ","M9N5FIXI ","M9N5FIYI ","M9N5FIZI ","M9N5FMGXI ","M9N5FMGYI ", & + "M9N5FMGZI ","M9N5MAFXI ","M9N5MAFYI ","M9N5MAFZI ","M9N5MAGXI ","M9N5MAGYI ","M9N5MAGZI ", & + "M9N5MBFXI ","M9N5MBFYI ","M9N5MBFZI ","M9N5MBXI ","M9N5MBYI ","M9N5MBZI ","M9N5MMGXI ", & + "M9N5MMGYI ","M9N5MMGZI ","M9N5STAXI ","M9N5STAYI ","M9N5STAZI ","M9N5STVXI ","M9N5STVYI ", & + "M9N5STVZI ","M9N5VXI ","M9N5VYI ","M9N5VZI ","M9N6AXI ","M9N6AYI ","M9N6AZI ", & + "M9N6DYNP ","M9N6FAFXI ","M9N6FAFYI ","M9N6FAFZI ","M9N6FAGXI ","M9N6FAGYI ","M9N6FAGZI ", & + "M9N6FAMXI ","M9N6FAMYI ","M9N6FAMZI ","M9N6FBFXI ","M9N6FBFYI ","M9N6FBFZI ","M9N6FBXI ", & + "M9N6FBYI ","M9N6FBZI ","M9N6FDXI ","M9N6FDYI ","M9N6FDZI ","M9N6FIXI ","M9N6FIYI ", & + "M9N6FIZI ","M9N6FMGXI ","M9N6FMGYI ","M9N6FMGZI ","M9N6MAFXI ","M9N6MAFYI ","M9N6MAFZI ", & + "M9N6MAGXI ","M9N6MAGYI ","M9N6MAGZI ","M9N6MBFXI ","M9N6MBFYI ","M9N6MBFZI ","M9N6MBXI ", & + "M9N6MBYI ","M9N6MBZI ","M9N6MMGXI ","M9N6MMGYI ","M9N6MMGZI ","M9N6STAXI ","M9N6STAYI ", & + "M9N6STAZI ","M9N6STVXI ","M9N6STVYI ","M9N6STVZI ","M9N6VXI ","M9N6VYI ","M9N6VZI ", & + "M9N7AXI ","M9N7AYI ","M9N7AZI ","M9N7DYNP ","M9N7FAFXI ","M9N7FAFYI ","M9N7FAFZI ", & + "M9N7FAGXI ","M9N7FAGYI ","M9N7FAGZI ","M9N7FAMXI ","M9N7FAMYI ","M9N7FAMZI ","M9N7FBFXI ", & + "M9N7FBFYI ","M9N7FBFZI ","M9N7FBXI ","M9N7FBYI ","M9N7FBZI ","M9N7FDXI ","M9N7FDYI ", & + "M9N7FDZI ","M9N7FIXI ","M9N7FIYI ","M9N7FIZI ","M9N7FMGXI ","M9N7FMGYI ","M9N7FMGZI ", & + "M9N7MAFXI ","M9N7MAFYI ","M9N7MAFZI ","M9N7MAGXI ","M9N7MAGYI ","M9N7MAGZI ","M9N7MBFXI ", & + "M9N7MBFYI ","M9N7MBFZI ","M9N7MBXI ","M9N7MBYI ","M9N7MBZI ","M9N7MMGXI ","M9N7MMGYI ", & + "M9N7MMGZI ","M9N7STAXI ","M9N7STAYI ","M9N7STAZI ","M9N7STVXI ","M9N7STVYI ","M9N7STVZI ", & + "M9N7VXI ","M9N7VYI ","M9N7VZI ","M9N8AXI ","M9N8AYI ","M9N8AZI ","M9N8DYNP ", & + "M9N8FAFXI ","M9N8FAFYI ","M9N8FAFZI ","M9N8FAGXI ","M9N8FAGYI ","M9N8FAGZI ","M9N8FAMXI ", & + "M9N8FAMYI ","M9N8FAMZI ","M9N8FBFXI ","M9N8FBFYI ","M9N8FBFZI ","M9N8FBXI ","M9N8FBYI ", & + "M9N8FBZI ","M9N8FDXI ","M9N8FDYI ","M9N8FDZI ","M9N8FIXI ","M9N8FIYI ","M9N8FIZI ", & + "M9N8FMGXI ","M9N8FMGYI ","M9N8FMGZI ","M9N8MAFXI ","M9N8MAFYI ","M9N8MAFZI ","M9N8MAGXI ", & + "M9N8MAGYI ","M9N8MAGZI ","M9N8MBFXI ","M9N8MBFYI ","M9N8MBFZI ","M9N8MBXI ","M9N8MBYI ", & + "M9N8MBZI ","M9N8MMGXI ","M9N8MMGYI ","M9N8MMGZI ","M9N8STAXI ","M9N8STAYI ","M9N8STAZI ", & + "M9N8STVXI ","M9N8STVYI ","M9N8STVZI ","M9N8VXI ","M9N8VYI ","M9N8VZI ","M9N9AXI ", & + "M9N9AYI ","M9N9AZI ","M9N9DYNP ","M9N9FAFXI ","M9N9FAFYI ","M9N9FAFZI ","M9N9FAGXI ", & + "M9N9FAGYI ","M9N9FAGZI ","M9N9FAMXI ","M9N9FAMYI ","M9N9FAMZI ","M9N9FBFXI ","M9N9FBFYI ", & + "M9N9FBFZI ","M9N9FBXI ","M9N9FBYI ","M9N9FBZI ","M9N9FDXI ","M9N9FDYI ","M9N9FDZI ", & + "M9N9FIXI ","M9N9FIYI ","M9N9FIZI ","M9N9FMGXI ","M9N9FMGYI ","M9N9FMGZI ","M9N9MAFXI ", & + "M9N9MAFYI ","M9N9MAFZI ","M9N9MAGXI ","M9N9MAGYI ","M9N9MAGZI ","M9N9MBFXI ","M9N9MBFYI ", & + "M9N9MBFZI ","M9N9MBXI ","M9N9MBYI ","M9N9MBZI ","M9N9MMGXI ","M9N9MMGYI ","M9N9MMGZI ", & + "M9N9STAXI ","M9N9STAYI ","M9N9STAZI ","M9N9STVXI ","M9N9STVYI ","M9N9STVZI ","M9N9VXI ", & + "M9N9VYI ","M9N9VZI "/) + CHARACTER(OutStrLenM1), PARAMETER :: ValidParamAry(4626) = (/ & ! This lists the names of the allowed parameters, which must be sorted alphabetically + ValidParamAry1, ValidParamAry2, ValidParamAry3/) + + INTEGER(IntKi), PARAMETER :: ParamIndxAry1(1542) = (/ & ! This lists the index into AllOuts(:) of the allowed parameters ValidParamAry(:) + J1Axi , J1Ayi , J1Azi , J1DynP , J1FAGxi , J1FAGyi , J1FAGzi , & + J1FAMxi , J1FAMyi , J1FAMzi , J1FBFxi , J1FBFyi , J1FBFzi , J1FBxi , & + J1FByi , J1FBzi , J1FDxi , J1FDyi , J1FDzi , J1FIxi , J1FIyi , & + J1FIzi , J1FMGxi , J1FMGyi , J1FMGzi , J1MAGxi , J1MAGyi , J1MAGzi , & + J1MBFxi , J1MBFyi , J1MBFzi , J1MBxi , J1MByi , J1MBzi , J1STAxi , & + J1STAyi , J1STAzi , J1STVxi , J1STVyi , J1STVzi , J1Vxi , J1Vyi , & + J1Vzi , J1WaveElev , J1WaveElv1 , J1WaveElv2 , J2Axi , J2Ayi , J2Azi , & + J2DynP , J2FAGxi , J2FAGyi , J2FAGzi , J2FAMxi , J2FAMyi , J2FAMzi , & + J2FBFxi , J2FBFyi , J2FBFzi , J2FBxi , J2FByi , J2FBzi , J2FDxi , & + J2FDyi , J2FDzi , J2FIxi , J2FIyi , J2FIzi , J2FMGxi , J2FMGyi , & + J2FMGzi , J2MAGxi , J2MAGyi , J2MAGzi , J2MBFxi , J2MBFyi , J2MBFzi , & + J2MBxi , J2MByi , J2MBzi , J2STAxi , J2STAyi , J2STAzi , J2STVxi , & + J2STVyi , J2STVzi , J2Vxi , J2Vyi , J2Vzi , J2WaveElev , J2WaveElv1 , & + J2WaveElv2 , J3Axi , J3Ayi , J3Azi , J3DynP , J3FAGxi , J3FAGyi , & + J3FAGzi , J3FAMxi , J3FAMyi , J3FAMzi , J3FBFxi , J3FBFyi , J3FBFzi , & + J3FBxi , J3FByi , J3FBzi , J3FDxi , J3FDyi , J3FDzi , J3FIxi , & + J3FIyi , J3FIzi , J3FMGxi , J3FMGyi , J3FMGzi , J3MAGxi , J3MAGyi , & + J3MAGzi , J3MBFxi , J3MBFyi , J3MBFzi , J3MBxi , J3MByi , J3MBzi , & + J3STAxi , J3STAyi , J3STAzi , J3STVxi , J3STVyi , J3STVzi , J3Vxi , & + J3Vyi , J3Vzi , J3WaveElev , J3WaveElv1 , J3WaveElv2 , J4Axi , J4Ayi , & + J4Azi , J4DynP , J4FAGxi , J4FAGyi , J4FAGzi , J4FAMxi , J4FAMyi , & + J4FAMzi , J4FBFxi , J4FBFyi , J4FBFzi , J4FBxi , J4FByi , J4FBzi , & + J4FDxi , J4FDyi , J4FDzi , J4FIxi , J4FIyi , J4FIzi , J4FMGxi , & + J4FMGyi , J4FMGzi , J4MAGxi , J4MAGyi , J4MAGzi , J4MBFxi , J4MBFyi , & + J4MBFzi , J4MBxi , J4MByi , J4MBzi , J4STAxi , J4STAyi , J4STAzi , & + J4STVxi , J4STVyi , J4STVzi , J4Vxi , J4Vyi , J4Vzi , J4WaveElev , & + J4WaveElv1 , J4WaveElv2 , J5Axi , J5Ayi , J5Azi , J5DynP , J5FAGxi , & + J5FAGyi , J5FAGzi , J5FAMxi , J5FAMyi , J5FAMzi , J5FBFxi , J5FBFyi , & + J5FBFzi , J5FBxi , J5FByi , J5FBzi , J5FDxi , J5FDyi , J5FDzi , & + J5FIxi , J5FIyi , J5FIzi , J5FMGxi , J5FMGyi , J5FMGzi , J5MAGxi , & + J5MAGyi , J5MAGzi , J5MBFxi , J5MBFyi , J5MBFzi , J5MBxi , J5MByi , & + J5MBzi , J5STAxi , J5STAyi , J5STAzi , J5STVxi , J5STVyi , J5STVzi , & + J5Vxi , J5Vyi , J5Vzi , J5WaveElev , J5WaveElv1 , J5WaveElv2 , J6Axi , & + J6Ayi , J6Azi , J6DynP , J6FAGxi , J6FAGyi , J6FAGzi , J6FAMxi , & + J6FAMyi , J6FAMzi , J6FBFxi , J6FBFyi , J6FBFzi , J6FBxi , J6FByi , & + J6FBzi , J6FDxi , J6FDyi , J6FDzi , J6FIxi , J6FIyi , J6FIzi , & + J6FMGxi , J6FMGyi , J6FMGzi , J6MAGxi , J6MAGyi , J6MAGzi , J6MBFxi , & + J6MBFyi , J6MBFzi , J6MBxi , J6MByi , J6MBzi , J6STAxi , J6STAyi , & + J6STAzi , J6STVxi , J6STVyi , J6STVzi , J6Vxi , J6Vyi , J6Vzi , & + J6WaveElev , J6WaveElv1 , J6WaveElv2 , J7Axi , J7Ayi , J7Azi , J7DynP , & + J7FAGxi , J7FAGyi , J7FAGzi , J7FAMxi , J7FAMyi , J7FAMzi , J7FBFxi , & + J7FBFyi , J7FBFzi , J7FBxi , J7FByi , J7FBzi , J7FDxi , J7FDyi , & + J7FDzi , J7FIxi , J7FIyi , J7FIzi , J7FMGxi , J7FMGyi , J7FMGzi , & + J7MAGxi , J7MAGyi , J7MAGzi , J7MBFxi , J7MBFyi , J7MBFzi , J7MBxi , & + J7MByi , J7MBzi , J7STAxi , J7STAyi , J7STAzi , J7STVxi , J7STVyi , & + J7STVzi , J7Vxi , J7Vyi , J7Vzi , J7WaveElev , J7WaveElv1 , J7WaveElv2 , & + J8Axi , J8Ayi , J8Azi , J8DynP , J8FAGxi , J8FAGyi , J8FAGzi , & + J8FAMxi , J8FAMyi , J8FAMzi , J8FBFxi , J8FBFyi , J8FBFzi , J8FBxi , & + J8FByi , J8FBzi , J8FDxi , J8FDyi , J8FDzi , J8FIxi , J8FIyi , & + J8FIzi , J8FMGxi , J8FMGyi , J8FMGzi , J8MAGxi , J8MAGyi , J8MAGzi , & + J8MBFxi , J8MBFyi , J8MBFzi , J8MBxi , J8MByi , J8MBzi , J8STAxi , & + J8STAyi , J8STAzi , J8STVxi , J8STVyi , J8STVzi , J8Vxi , J8Vyi , & + J8Vzi , J8WaveElev , J8WaveElv1 , J8WaveElv2 , J9Axi , J9Ayi , J9Azi , & + J9DynP , J9FAGxi , J9FAGyi , J9FAGzi , J9FAMxi , J9FAMyi , J9FAMzi , & + J9FBFxi , J9FBFyi , J9FBFzi , J9FBxi , J9FByi , J9FBzi , J9FDxi , & + J9FDyi , J9FDzi , J9FIxi , J9FIyi , J9FIzi , J9FMGxi , J9FMGyi , & + J9FMGzi , J9MAGxi , J9MAGyi , J9MAGzi , J9MBFxi , J9MBFyi , J9MBFzi , & + J9MBxi , J9MByi , J9MBzi , J9STAxi , J9STAyi , J9STAzi , J9STVxi , & + J9STVyi , J9STVzi , J9Vxi , J9Vyi , J9Vzi , J9WaveElev , J9WaveElv1 , & + J9WaveElv2 , M1N1Axi , M1N1Ayi , M1N1Azi , M1N1DynP , M1N1FAFxi , M1N1FAFyi , & + M1N1FAFzi , M1N1FAGxi , M1N1FAGyi , M1N1FAGzi , M1N1FAMxi , M1N1FAMyi , M1N1FAMzi , & + M1N1FBFxi , M1N1FBFyi , M1N1FBFzi , M1N1FBxi , M1N1FByi , M1N1FBzi , M1N1FDxi , & + M1N1FDyi , M1N1FDzi , M1N1FIxi , M1N1FIyi , M1N1FIzi , M1N1FMGxi , M1N1FMGyi , & + M1N1FMGzi , M1N1MAFxi , M1N1MAFyi , M1N1MAFzi , M1N1MAGxi , M1N1MAGyi , M1N1MAGzi , & + M1N1MBFxi , M1N1MBFyi , M1N1MBFzi , M1N1MBxi , M1N1MByi , M1N1MBzi , M1N1MMGxi , & + M1N1MMGyi , M1N1MMGzi , M1N1STAxi , M1N1STAyi , M1N1STAzi , M1N1STVxi , M1N1STVyi , & + M1N1STVzi , M1N1Vxi , M1N1Vyi , M1N1Vzi , M1N2Axi , M1N2Ayi , M1N2Azi , & + M1N2DynP , M1N2FAFxi , M1N2FAFyi , M1N2FAFzi , M1N2FAGxi , M1N2FAGyi , M1N2FAGzi , & + M1N2FAMxi , M1N2FAMyi , M1N2FAMzi , M1N2FBFxi , M1N2FBFyi , M1N2FBFzi , M1N2FBxi , & + M1N2FByi , M1N2FBzi , M1N2FDxi , M1N2FDyi , M1N2FDzi , M1N2FIxi , M1N2FIyi , & + M1N2FIzi , M1N2FMGxi , M1N2FMGyi , M1N2FMGzi , M1N2MAFxi , M1N2MAFyi , M1N2MAFzi , & + M1N2MAGxi , M1N2MAGyi , M1N2MAGzi , M1N2MBFxi , M1N2MBFyi , M1N2MBFzi , M1N2MBxi , & + M1N2MByi , M1N2MBzi , M1N2MMGxi , M1N2MMGyi , M1N2MMGzi , M1N2STAxi , M1N2STAyi , & + M1N2STAzi , M1N2STVxi , M1N2STVyi , M1N2STVzi , M1N2Vxi , M1N2Vyi , M1N2Vzi , & + M1N3Axi , M1N3Ayi , M1N3Azi , M1N3DynP , M1N3FAFxi , M1N3FAFyi , M1N3FAFzi , & + M1N3FAGxi , M1N3FAGyi , M1N3FAGzi , M1N3FAMxi , M1N3FAMyi , M1N3FAMzi , M1N3FBFxi , & + M1N3FBFyi , M1N3FBFzi , M1N3FBxi , M1N3FByi , M1N3FBzi , M1N3FDxi , M1N3FDyi , & + M1N3FDzi , M1N3FIxi , M1N3FIyi , M1N3FIzi , M1N3FMGxi , M1N3FMGyi , M1N3FMGzi , & + M1N3MAFxi , M1N3MAFyi , M1N3MAFzi , M1N3MAGxi , M1N3MAGyi , M1N3MAGzi , M1N3MBFxi , & + M1N3MBFyi , M1N3MBFzi , M1N3MBxi , M1N3MByi , M1N3MBzi , M1N3MMGxi , M1N3MMGyi , & + M1N3MMGzi , M1N3STAxi , M1N3STAyi , M1N3STAzi , M1N3STVxi , M1N3STVyi , M1N3STVzi , & + M1N3Vxi , M1N3Vyi , M1N3Vzi , M1N4Axi , M1N4Ayi , M1N4Azi , M1N4DynP , & + M1N4FAFxi , M1N4FAFyi , M1N4FAFzi , M1N4FAGxi , M1N4FAGyi , M1N4FAGzi , M1N4FAMxi , & + M1N4FAMyi , M1N4FAMzi , M1N4FBFxi , M1N4FBFyi , M1N4FBFzi , M1N4FBxi , M1N4FByi , & + M1N4FBzi , M1N4FDxi , M1N4FDyi , M1N4FDzi , M1N4FIxi , M1N4FIyi , M1N4FIzi , & + M1N4FMGxi , M1N4FMGyi , M1N4FMGzi , M1N4MAFxi , M1N4MAFyi , M1N4MAFzi , M1N4MAGxi , & + M1N4MAGyi , M1N4MAGzi , M1N4MBFxi , M1N4MBFyi , M1N4MBFzi , M1N4MBxi , M1N4MByi , & + M1N4MBzi , M1N4MMGxi , M1N4MMGyi , M1N4MMGzi , M1N4STAxi , M1N4STAyi , M1N4STAzi , & + M1N4STVxi , M1N4STVyi , M1N4STVzi , M1N4Vxi , M1N4Vyi , M1N4Vzi , M1N5Axi , & + M1N5Ayi , M1N5Azi , M1N5DynP , M1N5FAFxi , M1N5FAFyi , M1N5FAFzi , M1N5FAGxi , & + M1N5FAGyi , M1N5FAGzi , M1N5FAMxi , M1N5FAMyi , M1N5FAMzi , M1N5FBFxi , M1N5FBFyi , & + M1N5FBFzi , M1N5FBxi , M1N5FByi , M1N5FBzi , M1N5FDxi , M1N5FDyi , M1N5FDzi , & + M1N5FIxi , M1N5FIyi , M1N5FIzi , M1N5FMGxi , M1N5FMGyi , M1N5FMGzi , M1N5MAFxi , & + M1N5MAFyi , M1N5MAFzi , M1N5MAGxi , M1N5MAGyi , M1N5MAGzi , M1N5MBFxi , M1N5MBFyi , & + M1N5MBFzi , M1N5MBxi , M1N5MByi , M1N5MBzi , M1N5MMGxi , M1N5MMGyi , M1N5MMGzi , & + M1N5STAxi , M1N5STAyi , M1N5STAzi , M1N5STVxi , M1N5STVyi , M1N5STVzi , M1N5Vxi , & + M1N5Vyi , M1N5Vzi , M1N6Axi , M1N6Ayi , M1N6Azi , M1N6DynP , M1N6FAFxi , & + M1N6FAFyi , M1N6FAFzi , M1N6FAGxi , M1N6FAGyi , M1N6FAGzi , M1N6FAMxi , M1N6FAMyi , & + M1N6FAMzi , M1N6FBFxi , M1N6FBFyi , M1N6FBFzi , M1N6FBxi , M1N6FByi , M1N6FBzi , & + M1N6FDxi , M1N6FDyi , M1N6FDzi , M1N6FIxi , M1N6FIyi , M1N6FIzi , M1N6FMGxi , & + M1N6FMGyi , M1N6FMGzi , M1N6MAFxi , M1N6MAFyi , M1N6MAFzi , M1N6MAGxi , M1N6MAGyi , & + M1N6MAGzi , M1N6MBFxi , M1N6MBFyi , M1N6MBFzi , M1N6MBxi , M1N6MByi , M1N6MBzi , & + M1N6MMGxi , M1N6MMGyi , M1N6MMGzi , M1N6STAxi , M1N6STAyi , M1N6STAzi , M1N6STVxi , & + M1N6STVyi , M1N6STVzi , M1N6Vxi , M1N6Vyi , M1N6Vzi , M1N7Axi , M1N7Ayi , & + M1N7Azi , M1N7DynP , M1N7FAFxi , M1N7FAFyi , M1N7FAFzi , M1N7FAGxi , M1N7FAGyi , & + M1N7FAGzi , M1N7FAMxi , M1N7FAMyi , M1N7FAMzi , M1N7FBFxi , M1N7FBFyi , M1N7FBFzi , & + M1N7FBxi , M1N7FByi , M1N7FBzi , M1N7FDxi , M1N7FDyi , M1N7FDzi , M1N7FIxi , & + M1N7FIyi , M1N7FIzi , M1N7FMGxi , M1N7FMGyi , M1N7FMGzi , M1N7MAFxi , M1N7MAFyi , & + M1N7MAFzi , M1N7MAGxi , M1N7MAGyi , M1N7MAGzi , M1N7MBFxi , M1N7MBFyi , M1N7MBFzi , & + M1N7MBxi , M1N7MByi , M1N7MBzi , M1N7MMGxi , M1N7MMGyi , M1N7MMGzi , M1N7STAxi , & + M1N7STAyi , M1N7STAzi , M1N7STVxi , M1N7STVyi , M1N7STVzi , M1N7Vxi , M1N7Vyi , & + M1N7Vzi , M1N8Axi , M1N8Ayi , M1N8Azi , M1N8DynP , M1N8FAFxi , M1N8FAFyi , & + M1N8FAFzi , M1N8FAGxi , M1N8FAGyi , M1N8FAGzi , M1N8FAMxi , M1N8FAMyi , M1N8FAMzi , & + M1N8FBFxi , M1N8FBFyi , M1N8FBFzi , M1N8FBxi , M1N8FByi , M1N8FBzi , M1N8FDxi , & + M1N8FDyi , M1N8FDzi , M1N8FIxi , M1N8FIyi , M1N8FIzi , M1N8FMGxi , M1N8FMGyi , & + M1N8FMGzi , M1N8MAFxi , M1N8MAFyi , M1N8MAFzi , M1N8MAGxi , M1N8MAGyi , M1N8MAGzi , & + M1N8MBFxi , M1N8MBFyi , M1N8MBFzi , M1N8MBxi , M1N8MByi , M1N8MBzi , M1N8MMGxi , & + M1N8MMGyi , M1N8MMGzi , M1N8STAxi , M1N8STAyi , M1N8STAzi , M1N8STVxi , M1N8STVyi , & + M1N8STVzi , M1N8Vxi , M1N8Vyi , M1N8Vzi , M1N9Axi , M1N9Ayi , M1N9Azi , & + M1N9DynP , M1N9FAFxi , M1N9FAFyi , M1N9FAFzi , M1N9FAGxi , M1N9FAGyi , M1N9FAGzi , & + M1N9FAMxi , M1N9FAMyi , M1N9FAMzi , M1N9FBFxi , M1N9FBFyi , M1N9FBFzi , M1N9FBxi , & + M1N9FByi , M1N9FBzi , M1N9FDxi , M1N9FDyi , M1N9FDzi , M1N9FIxi , M1N9FIyi , & + M1N9FIzi , M1N9FMGxi , M1N9FMGyi , M1N9FMGzi , M1N9MAFxi , M1N9MAFyi , M1N9MAFzi , & + M1N9MAGxi , M1N9MAGyi , M1N9MAGzi , M1N9MBFxi , M1N9MBFyi , M1N9MBFzi , M1N9MBxi , & + M1N9MByi , M1N9MBzi , M1N9MMGxi , M1N9MMGyi , M1N9MMGzi , M1N9STAxi , M1N9STAyi , & + M1N9STAzi , M1N9STVxi , M1N9STVyi , M1N9STVzi , M1N9Vxi , M1N9Vyi , M1N9Vzi , & + M2N1Axi , M2N1Ayi , M2N1Azi , M2N1DynP , M2N1FAFxi , M2N1FAFyi , M2N1FAFzi , & + M2N1FAGxi , M2N1FAGyi , M2N1FAGzi , M2N1FAMxi , M2N1FAMyi , M2N1FAMzi , M2N1FBFxi , & + M2N1FBFyi , M2N1FBFzi , M2N1FBxi , M2N1FByi , M2N1FBzi , M2N1FDxi , M2N1FDyi , & + M2N1FDzi , M2N1FIxi , M2N1FIyi , M2N1FIzi , M2N1FMGxi , M2N1FMGyi , M2N1FMGzi , & + M2N1MAFxi , M2N1MAFyi , M2N1MAFzi , M2N1MAGxi , M2N1MAGyi , M2N1MAGzi , M2N1MBFxi , & + M2N1MBFyi , M2N1MBFzi , M2N1MBxi , M2N1MByi , M2N1MBzi , M2N1MMGxi , M2N1MMGyi , & + M2N1MMGzi , M2N1STAxi , M2N1STAyi , M2N1STAzi , M2N1STVxi , M2N1STVyi , M2N1STVzi , & + M2N1Vxi , M2N1Vyi , M2N1Vzi , M2N2Axi , M2N2Ayi , M2N2Azi , M2N2DynP , & + M2N2FAFxi , M2N2FAFyi , M2N2FAFzi , M2N2FAGxi , M2N2FAGyi , M2N2FAGzi , M2N2FAMxi , & + M2N2FAMyi , M2N2FAMzi , M2N2FBFxi , M2N2FBFyi , M2N2FBFzi , M2N2FBxi , M2N2FByi , & + M2N2FBzi , M2N2FDxi , M2N2FDyi , M2N2FDzi , M2N2FIxi , M2N2FIyi , M2N2FIzi , & + M2N2FMGxi , M2N2FMGyi , M2N2FMGzi , M2N2MAFxi , M2N2MAFyi , M2N2MAFzi , M2N2MAGxi , & + M2N2MAGyi , M2N2MAGzi , M2N2MBFxi , M2N2MBFyi , M2N2MBFzi , M2N2MBxi , M2N2MByi , & + M2N2MBzi , M2N2MMGxi , M2N2MMGyi , M2N2MMGzi , M2N2STAxi , M2N2STAyi , M2N2STAzi , & + M2N2STVxi , M2N2STVyi , M2N2STVzi , M2N2Vxi , M2N2Vyi , M2N2Vzi , M2N3Axi , & + M2N3Ayi , M2N3Azi , M2N3DynP , M2N3FAFxi , M2N3FAFyi , M2N3FAFzi , M2N3FAGxi , & + M2N3FAGyi , M2N3FAGzi , M2N3FAMxi , M2N3FAMyi , M2N3FAMzi , M2N3FBFxi , M2N3FBFyi , & + M2N3FBFzi , M2N3FBxi , M2N3FByi , M2N3FBzi , M2N3FDxi , M2N3FDyi , M2N3FDzi , & + M2N3FIxi , M2N3FIyi , M2N3FIzi , M2N3FMGxi , M2N3FMGyi , M2N3FMGzi , M2N3MAFxi , & + M2N3MAFyi , M2N3MAFzi , M2N3MAGxi , M2N3MAGyi , M2N3MAGzi , M2N3MBFxi , M2N3MBFyi , & + M2N3MBFzi , M2N3MBxi , M2N3MByi , M2N3MBzi , M2N3MMGxi , M2N3MMGyi , M2N3MMGzi , & + M2N3STAxi , M2N3STAyi , M2N3STAzi , M2N3STVxi , M2N3STVyi , M2N3STVzi , M2N3Vxi , & + M2N3Vyi , M2N3Vzi , M2N4Axi , M2N4Ayi , M2N4Azi , M2N4DynP , M2N4FAFxi , & + M2N4FAFyi , M2N4FAFzi , M2N4FAGxi , M2N4FAGyi , M2N4FAGzi , M2N4FAMxi , M2N4FAMyi , & + M2N4FAMzi , M2N4FBFxi , M2N4FBFyi , M2N4FBFzi , M2N4FBxi , M2N4FByi , M2N4FBzi , & + M2N4FDxi , M2N4FDyi , M2N4FDzi , M2N4FIxi , M2N4FIyi , M2N4FIzi , M2N4FMGxi , & + M2N4FMGyi , M2N4FMGzi , M2N4MAFxi , M2N4MAFyi , M2N4MAFzi , M2N4MAGxi , M2N4MAGyi , & + M2N4MAGzi , M2N4MBFxi , M2N4MBFyi , M2N4MBFzi , M2N4MBxi , M2N4MByi , M2N4MBzi , & + M2N4MMGxi , M2N4MMGyi , M2N4MMGzi , M2N4STAxi , M2N4STAyi , M2N4STAzi , M2N4STVxi , & + M2N4STVyi , M2N4STVzi , M2N4Vxi , M2N4Vyi , M2N4Vzi , M2N5Axi , M2N5Ayi , & + M2N5Azi , M2N5DynP , M2N5FAFxi , M2N5FAFyi , M2N5FAFzi , M2N5FAGxi , M2N5FAGyi , & + M2N5FAGzi , M2N5FAMxi , M2N5FAMyi , M2N5FAMzi , M2N5FBFxi , M2N5FBFyi , M2N5FBFzi , & + M2N5FBxi , M2N5FByi , M2N5FBzi , M2N5FDxi , M2N5FDyi , M2N5FDzi , M2N5FIxi , & + M2N5FIyi , M2N5FIzi , M2N5FMGxi , M2N5FMGyi , M2N5FMGzi , M2N5MAFxi , M2N5MAFyi , & + M2N5MAFzi , M2N5MAGxi , M2N5MAGyi , M2N5MAGzi , M2N5MBFxi , M2N5MBFyi , M2N5MBFzi , & + M2N5MBxi , M2N5MByi , M2N5MBzi , M2N5MMGxi , M2N5MMGyi , M2N5MMGzi , M2N5STAxi , & + M2N5STAyi , M2N5STAzi , M2N5STVxi , M2N5STVyi , M2N5STVzi , M2N5Vxi , M2N5Vyi , & + M2N5Vzi , M2N6Axi , M2N6Ayi , M2N6Azi , M2N6DynP , M2N6FAFxi , M2N6FAFyi , & + M2N6FAFzi , M2N6FAGxi , M2N6FAGyi , M2N6FAGzi , M2N6FAMxi , M2N6FAMyi , M2N6FAMzi , & + M2N6FBFxi , M2N6FBFyi , M2N6FBFzi , M2N6FBxi , M2N6FByi , M2N6FBzi , M2N6FDxi , & + M2N6FDyi , M2N6FDzi , M2N6FIxi , M2N6FIyi , M2N6FIzi , M2N6FMGxi , M2N6FMGyi , & + M2N6FMGzi , M2N6MAFxi , M2N6MAFyi , M2N6MAFzi , M2N6MAGxi , M2N6MAGyi , M2N6MAGzi , & + M2N6MBFxi , M2N6MBFyi , M2N6MBFzi , M2N6MBxi , M2N6MByi , M2N6MBzi , M2N6MMGxi , & + M2N6MMGyi , M2N6MMGzi , M2N6STAxi , M2N6STAyi , M2N6STAzi , M2N6STVxi , M2N6STVyi , & + M2N6STVzi , M2N6Vxi , M2N6Vyi , M2N6Vzi , M2N7Axi , M2N7Ayi , M2N7Azi , & + M2N7DynP , M2N7FAFxi , M2N7FAFyi , M2N7FAFzi , M2N7FAGxi , M2N7FAGyi , M2N7FAGzi , & + M2N7FAMxi , M2N7FAMyi , M2N7FAMzi , M2N7FBFxi , M2N7FBFyi , M2N7FBFzi , M2N7FBxi , & + M2N7FByi , M2N7FBzi , M2N7FDxi , M2N7FDyi , M2N7FDzi , M2N7FIxi , M2N7FIyi , & + M2N7FIzi , M2N7FMGxi , M2N7FMGyi , M2N7FMGzi , M2N7MAFxi , M2N7MAFyi , M2N7MAFzi , & + M2N7MAGxi , M2N7MAGyi , M2N7MAGzi , M2N7MBFxi , M2N7MBFyi , M2N7MBFzi , M2N7MBxi , & + M2N7MByi , M2N7MBzi , M2N7MMGxi , M2N7MMGyi , M2N7MMGzi , M2N7STAxi , M2N7STAyi , & + M2N7STAzi , M2N7STVxi , M2N7STVyi , M2N7STVzi , M2N7Vxi , M2N7Vyi , M2N7Vzi , & + M2N8Axi , M2N8Ayi , M2N8Azi , M2N8DynP , M2N8FAFxi , M2N8FAFyi , M2N8FAFzi , & + M2N8FAGxi , M2N8FAGyi , M2N8FAGzi , M2N8FAMxi , M2N8FAMyi , M2N8FAMzi , M2N8FBFxi , & + M2N8FBFyi , M2N8FBFzi , M2N8FBxi , M2N8FByi , M2N8FBzi , M2N8FDxi , M2N8FDyi , & + M2N8FDzi , M2N8FIxi , M2N8FIyi , M2N8FIzi , M2N8FMGxi , M2N8FMGyi , M2N8FMGzi , & + M2N8MAFxi , M2N8MAFyi , M2N8MAFzi , M2N8MAGxi , M2N8MAGyi , M2N8MAGzi , M2N8MBFxi , & + M2N8MBFyi , M2N8MBFzi , M2N8MBxi , M2N8MByi , M2N8MBzi , M2N8MMGxi , M2N8MMGyi , & + M2N8MMGzi , M2N8STAxi , M2N8STAyi , M2N8STAzi , M2N8STVxi , M2N8STVyi , M2N8STVzi , & + M2N8Vxi , M2N8Vyi , M2N8Vzi , M2N9Axi , M2N9Ayi , M2N9Azi , M2N9DynP , & + M2N9FAFxi , M2N9FAFyi , M2N9FAFzi , M2N9FAGxi , M2N9FAGyi , M2N9FAGzi , M2N9FAMxi , & + M2N9FAMyi , M2N9FAMzi , M2N9FBFxi , M2N9FBFyi , M2N9FBFzi , M2N9FBxi , M2N9FByi , & + M2N9FBzi , M2N9FDxi , M2N9FDyi , M2N9FDzi , M2N9FIxi , M2N9FIyi , M2N9FIzi , & + M2N9FMGxi , M2N9FMGyi , M2N9FMGzi , M2N9MAFxi , M2N9MAFyi , M2N9MAFzi , M2N9MAGxi , & + M2N9MAGyi , M2N9MAGzi , M2N9MBFxi , M2N9MBFyi , M2N9MBFzi , M2N9MBxi , M2N9MByi , & + M2N9MBzi , M2N9MMGxi , M2N9MMGyi , M2N9MMGzi , M2N9STAxi , M2N9STAyi , M2N9STAzi , & + M2N9STVxi , M2N9STVyi , M2N9STVzi , M2N9Vxi , M2N9Vyi , M2N9Vzi , M3N1Axi , & + M3N1Ayi , M3N1Azi , M3N1DynP , M3N1FAFxi , M3N1FAFyi , M3N1FAFzi , M3N1FAGxi , & + M3N1FAGyi , M3N1FAGzi , M3N1FAMxi , M3N1FAMyi , M3N1FAMzi , M3N1FBFxi , M3N1FBFyi , & + M3N1FBFzi , M3N1FBxi , M3N1FByi , M3N1FBzi , M3N1FDxi , M3N1FDyi , M3N1FDzi , & + M3N1FIxi , M3N1FIyi , M3N1FIzi , M3N1FMGxi , M3N1FMGyi , M3N1FMGzi , M3N1MAFxi , & + M3N1MAFyi , M3N1MAFzi , M3N1MAGxi , M3N1MAGyi , M3N1MAGzi , M3N1MBFxi , M3N1MBFyi , & + M3N1MBFzi , M3N1MBxi , M3N1MByi , M3N1MBzi , M3N1MMGxi , M3N1MMGyi , M3N1MMGzi , & + M3N1STAxi , M3N1STAyi , M3N1STAzi , M3N1STVxi , M3N1STVyi , M3N1STVzi , M3N1Vxi , & + M3N1Vyi , M3N1Vzi , M3N2Axi , M3N2Ayi , M3N2Azi , M3N2DynP , M3N2FAFxi , & + M3N2FAFyi , M3N2FAFzi , M3N2FAGxi , M3N2FAGyi , M3N2FAGzi , M3N2FAMxi , M3N2FAMyi , & + M3N2FAMzi , M3N2FBFxi , M3N2FBFyi , M3N2FBFzi , M3N2FBxi , M3N2FByi , M3N2FBzi , & + M3N2FDxi , M3N2FDyi , M3N2FDzi , M3N2FIxi , M3N2FIyi , M3N2FIzi , M3N2FMGxi , & + M3N2FMGyi , M3N2FMGzi , M3N2MAFxi , M3N2MAFyi , M3N2MAFzi , M3N2MAGxi , M3N2MAGyi , & + M3N2MAGzi , M3N2MBFxi , M3N2MBFyi , M3N2MBFzi , M3N2MBxi , M3N2MByi , M3N2MBzi , & + M3N2MMGxi , M3N2MMGyi , M3N2MMGzi , M3N2STAxi , M3N2STAyi , M3N2STAzi , M3N2STVxi , & + M3N2STVyi , M3N2STVzi , M3N2Vxi , M3N2Vyi , M3N2Vzi , M3N3Axi , M3N3Ayi , & + M3N3Azi , M3N3DynP , M3N3FAFxi , M3N3FAFyi , M3N3FAFzi , M3N3FAGxi , M3N3FAGyi , & + M3N3FAGzi , M3N3FAMxi , M3N3FAMyi , M3N3FAMzi , M3N3FBFxi , M3N3FBFyi , M3N3FBFzi , & + M3N3FBxi , M3N3FByi , M3N3FBzi , M3N3FDxi , M3N3FDyi , M3N3FDzi , M3N3FIxi , & + M3N3FIyi , M3N3FIzi , M3N3FMGxi , M3N3FMGyi , M3N3FMGzi , M3N3MAFxi , M3N3MAFyi , & + M3N3MAFzi , M3N3MAGxi , M3N3MAGyi , M3N3MAGzi , M3N3MBFxi , M3N3MBFyi , M3N3MBFzi , & + M3N3MBxi , M3N3MByi , M3N3MBzi , M3N3MMGxi , M3N3MMGyi , M3N3MMGzi , M3N3STAxi , & + M3N3STAyi , M3N3STAzi , M3N3STVxi , M3N3STVyi , M3N3STVzi , M3N3Vxi , M3N3Vyi , & + M3N3Vzi , M3N4Axi , M3N4Ayi , M3N4Azi , M3N4DynP , M3N4FAFxi , M3N4FAFyi , & + M3N4FAFzi , M3N4FAGxi , M3N4FAGyi , M3N4FAGzi , M3N4FAMxi , M3N4FAMyi , M3N4FAMzi , & + M3N4FBFxi , M3N4FBFyi , M3N4FBFzi , M3N4FBxi , M3N4FByi , M3N4FBzi , M3N4FDxi , & + M3N4FDyi , M3N4FDzi , M3N4FIxi , M3N4FIyi , M3N4FIzi , M3N4FMGxi , M3N4FMGyi , & + M3N4FMGzi , M3N4MAFxi , M3N4MAFyi , M3N4MAFzi , M3N4MAGxi , M3N4MAGyi , M3N4MAGzi , & + M3N4MBFxi , M3N4MBFyi /) + INTEGER(IntKi), PARAMETER :: ParamIndxAry2(1542) = (/ & ! This lists the index into AllOuts(:) of the allowed parameters ValidParamAry(:) + M3N4MBFzi , M3N4MBxi , M3N4MByi , M3N4MBzi , M3N4MMGxi , M3N4MMGyi , M3N4MMGzi , & + M3N4STAxi , M3N4STAyi , M3N4STAzi , M3N4STVxi , M3N4STVyi , M3N4STVzi , M3N4Vxi , & + M3N4Vyi , M3N4Vzi , M3N5Axi , M3N5Ayi , M3N5Azi , M3N5DynP , M3N5FAFxi , & + M3N5FAFyi , M3N5FAFzi , M3N5FAGxi , M3N5FAGyi , M3N5FAGzi , M3N5FAMxi , M3N5FAMyi , & + M3N5FAMzi , M3N5FBFxi , M3N5FBFyi , M3N5FBFzi , M3N5FBxi , M3N5FByi , M3N5FBzi , & + M3N5FDxi , M3N5FDyi , M3N5FDzi , M3N5FIxi , M3N5FIyi , M3N5FIzi , M3N5FMGxi , & + M3N5FMGyi , M3N5FMGzi , M3N5MAFxi , M3N5MAFyi , M3N5MAFzi , M3N5MAGxi , M3N5MAGyi , & + M3N5MAGzi , M3N5MBFxi , M3N5MBFyi , M3N5MBFzi , M3N5MBxi , M3N5MByi , M3N5MBzi , & + M3N5MMGxi , M3N5MMGyi , M3N5MMGzi , M3N5STAxi , M3N5STAyi , M3N5STAzi , M3N5STVxi , & + M3N5STVyi , M3N5STVzi , M3N5Vxi , M3N5Vyi , M3N5Vzi , M3N6Axi , M3N6Ayi , & + M3N6Azi , M3N6DynP , M3N6FAFxi , M3N6FAFyi , M3N6FAFzi , M3N6FAGxi , M3N6FAGyi , & + M3N6FAGzi , M3N6FAMxi , M3N6FAMyi , M3N6FAMzi , M3N6FBFxi , M3N6FBFyi , M3N6FBFzi , & + M3N6FBxi , M3N6FByi , M3N6FBzi , M3N6FDxi , M3N6FDyi , M3N6FDzi , M3N6FIxi , & + M3N6FIyi , M3N6FIzi , M3N6FMGxi , M3N6FMGyi , M3N6FMGzi , M3N6MAFxi , M3N6MAFyi , & + M3N6MAFzi , M3N6MAGxi , M3N6MAGyi , M3N6MAGzi , M3N6MBFxi , M3N6MBFyi , M3N6MBFzi , & + M3N6MBxi , M3N6MByi , M3N6MBzi , M3N6MMGxi , M3N6MMGyi , M3N6MMGzi , M3N6STAxi , & + M3N6STAyi , M3N6STAzi , M3N6STVxi , M3N6STVyi , M3N6STVzi , M3N6Vxi , M3N6Vyi , & + M3N6Vzi , M3N7Axi , M3N7Ayi , M3N7Azi , M3N7DynP , M3N7FAFxi , M3N7FAFyi , & + M3N7FAFzi , M3N7FAGxi , M3N7FAGyi , M3N7FAGzi , M3N7FAMxi , M3N7FAMyi , M3N7FAMzi , & + M3N7FBFxi , M3N7FBFyi , M3N7FBFzi , M3N7FBxi , M3N7FByi , M3N7FBzi , M3N7FDxi , & + M3N7FDyi , M3N7FDzi , M3N7FIxi , M3N7FIyi , M3N7FIzi , M3N7FMGxi , M3N7FMGyi , & + M3N7FMGzi , M3N7MAFxi , M3N7MAFyi , M3N7MAFzi , M3N7MAGxi , M3N7MAGyi , M3N7MAGzi , & + M3N7MBFxi , M3N7MBFyi , M3N7MBFzi , M3N7MBxi , M3N7MByi , M3N7MBzi , M3N7MMGxi , & + M3N7MMGyi , M3N7MMGzi , M3N7STAxi , M3N7STAyi , M3N7STAzi , M3N7STVxi , M3N7STVyi , & + M3N7STVzi , M3N7Vxi , M3N7Vyi , M3N7Vzi , M3N8Axi , M3N8Ayi , M3N8Azi , & + M3N8DynP , M3N8FAFxi , M3N8FAFyi , M3N8FAFzi , M3N8FAGxi , M3N8FAGyi , M3N8FAGzi , & + M3N8FAMxi , M3N8FAMyi , M3N8FAMzi , M3N8FBFxi , M3N8FBFyi , M3N8FBFzi , M3N8FBxi , & + M3N8FByi , M3N8FBzi , M3N8FDxi , M3N8FDyi , M3N8FDzi , M3N8FIxi , M3N8FIyi , & + M3N8FIzi , M3N8FMGxi , M3N8FMGyi , M3N8FMGzi , M3N8MAFxi , M3N8MAFyi , M3N8MAFzi , & + M3N8MAGxi , M3N8MAGyi , M3N8MAGzi , M3N8MBFxi , M3N8MBFyi , M3N8MBFzi , M3N8MBxi , & + M3N8MByi , M3N8MBzi , M3N8MMGxi , M3N8MMGyi , M3N8MMGzi , M3N8STAxi , M3N8STAyi , & + M3N8STAzi , M3N8STVxi , M3N8STVyi , M3N8STVzi , M3N8Vxi , M3N8Vyi , M3N8Vzi , & + M3N9Axi , M3N9Ayi , M3N9Azi , M3N9DynP , M3N9FAFxi , M3N9FAFyi , M3N9FAFzi , & + M3N9FAGxi , M3N9FAGyi , M3N9FAGzi , M3N9FAMxi , M3N9FAMyi , M3N9FAMzi , M3N9FBFxi , & + M3N9FBFyi , M3N9FBFzi , M3N9FBxi , M3N9FByi , M3N9FBzi , M3N9FDxi , M3N9FDyi , & + M3N9FDzi , M3N9FIxi , M3N9FIyi , M3N9FIzi , M3N9FMGxi , M3N9FMGyi , M3N9FMGzi , & + M3N9MAFxi , M3N9MAFyi , M3N9MAFzi , M3N9MAGxi , M3N9MAGyi , M3N9MAGzi , M3N9MBFxi , & + M3N9MBFyi , M3N9MBFzi , M3N9MBxi , M3N9MByi , M3N9MBzi , M3N9MMGxi , M3N9MMGyi , & + M3N9MMGzi , M3N9STAxi , M3N9STAyi , M3N9STAzi , M3N9STVxi , M3N9STVyi , M3N9STVzi , & + M3N9Vxi , M3N9Vyi , M3N9Vzi , M4N1Axi , M4N1Ayi , M4N1Azi , M4N1DynP , & + M4N1FAFxi , M4N1FAFyi , M4N1FAFzi , M4N1FAGxi , M4N1FAGyi , M4N1FAGzi , M4N1FAMxi , & + M4N1FAMyi , M4N1FAMzi , M4N1FBFxi , M4N1FBFyi , M4N1FBFzi , M4N1FBxi , M4N1FByi , & + M4N1FBzi , M4N1FDxi , M4N1FDyi , M4N1FDzi , M4N1FIxi , M4N1FIyi , M4N1FIzi , & + M4N1FMGxi , M4N1FMGyi , M4N1FMGzi , M4N1MAFxi , M4N1MAFyi , M4N1MAFzi , M4N1MAGxi , & + M4N1MAGyi , M4N1MAGzi , M4N1MBFxi , M4N1MBFyi , M4N1MBFzi , M4N1MBxi , M4N1MByi , & + M4N1MBzi , M4N1MMGxi , M4N1MMGyi , M4N1MMGzi , M4N1STAxi , M4N1STAyi , M4N1STAzi , & + M4N1STVxi , M4N1STVyi , M4N1STVzi , M4N1Vxi , M4N1Vyi , M4N1Vzi , M4N2Axi , & + M4N2Ayi , M4N2Azi , M4N2DynP , M4N2FAFxi , M4N2FAFyi , M4N2FAFzi , M4N2FAGxi , & + M4N2FAGyi , M4N2FAGzi , M4N2FAMxi , M4N2FAMyi , M4N2FAMzi , M4N2FBFxi , M4N2FBFyi , & + M4N2FBFzi , M4N2FBxi , M4N2FByi , M4N2FBzi , M4N2FDxi , M4N2FDyi , M4N2FDzi , & + M4N2FIxi , M4N2FIyi , M4N2FIzi , M4N2FMGxi , M4N2FMGyi , M4N2FMGzi , M4N2MAFxi , & + M4N2MAFyi , M4N2MAFzi , M4N2MAGxi , M4N2MAGyi , M4N2MAGzi , M4N2MBFxi , M4N2MBFyi , & + M4N2MBFzi , M4N2MBxi , M4N2MByi , M4N2MBzi , M4N2MMGxi , M4N2MMGyi , M4N2MMGzi , & + M4N2STAxi , M4N2STAyi , M4N2STAzi , M4N2STVxi , M4N2STVyi , M4N2STVzi , M4N2Vxi , & + M4N2Vyi , M4N2Vzi , M4N3Axi , M4N3Ayi , M4N3Azi , M4N3DynP , M4N3FAFxi , & + M4N3FAFyi , M4N3FAFzi , M4N3FAGxi , M4N3FAGyi , M4N3FAGzi , M4N3FAMxi , M4N3FAMyi , & + M4N3FAMzi , M4N3FBFxi , M4N3FBFyi , M4N3FBFzi , M4N3FBxi , M4N3FByi , M4N3FBzi , & + M4N3FDxi , M4N3FDyi , M4N3FDzi , M4N3FIxi , M4N3FIyi , M4N3FIzi , M4N3FMGxi , & + M4N3FMGyi , M4N3FMGzi , M4N3MAFxi , M4N3MAFyi , M4N3MAFzi , M4N3MAGxi , M4N3MAGyi , & + M4N3MAGzi , M4N3MBFxi , M4N3MBFyi , M4N3MBFzi , M4N3MBxi , M4N3MByi , M4N3MBzi , & + M4N3MMGxi , M4N3MMGyi , M4N3MMGzi , M4N3STAxi , M4N3STAyi , M4N3STAzi , M4N3STVxi , & + M4N3STVyi , M4N3STVzi , M4N3Vxi , M4N3Vyi , M4N3Vzi , M4N4Axi , M4N4Ayi , & + M4N4Azi , M4N4DynP , M4N4FAFxi , M4N4FAFyi , M4N4FAFzi , M4N4FAGxi , M4N4FAGyi , & + M4N4FAGzi , M4N4FAMxi , M4N4FAMyi , M4N4FAMzi , M4N4FBFxi , M4N4FBFyi , M4N4FBFzi , & + M4N4FBxi , M4N4FByi , M4N4FBzi , M4N4FDxi , M4N4FDyi , M4N4FDzi , M4N4FIxi , & + M4N4FIyi , M4N4FIzi , M4N4FMGxi , M4N4FMGyi , M4N4FMGzi , M4N4MAFxi , M4N4MAFyi , & + M4N4MAFzi , M4N4MAGxi , M4N4MAGyi , M4N4MAGzi , M4N4MBFxi , M4N4MBFyi , M4N4MBFzi , & + M4N4MBxi , M4N4MByi , M4N4MBzi , M4N4MMGxi , M4N4MMGyi , M4N4MMGzi , M4N4STAxi , & + M4N4STAyi , M4N4STAzi , M4N4STVxi , M4N4STVyi , M4N4STVzi , M4N4Vxi , M4N4Vyi , & + M4N4Vzi , M4N5Axi , M4N5Ayi , M4N5Azi , M4N5DynP , M4N5FAFxi , M4N5FAFyi , & + M4N5FAFzi , M4N5FAGxi , M4N5FAGyi , M4N5FAGzi , M4N5FAMxi , M4N5FAMyi , M4N5FAMzi , & + M4N5FBFxi , M4N5FBFyi , M4N5FBFzi , M4N5FBxi , M4N5FByi , M4N5FBzi , M4N5FDxi , & + M4N5FDyi , M4N5FDzi , M4N5FIxi , M4N5FIyi , M4N5FIzi , M4N5FMGxi , M4N5FMGyi , & + M4N5FMGzi , M4N5MAFxi , M4N5MAFyi , M4N5MAFzi , M4N5MAGxi , M4N5MAGyi , M4N5MAGzi , & + M4N5MBFxi , M4N5MBFyi , M4N5MBFzi , M4N5MBxi , M4N5MByi , M4N5MBzi , M4N5MMGxi , & + M4N5MMGyi , M4N5MMGzi , M4N5STAxi , M4N5STAyi , M4N5STAzi , M4N5STVxi , M4N5STVyi , & + M4N5STVzi , M4N5Vxi , M4N5Vyi , M4N5Vzi , M4N6Axi , M4N6Ayi , M4N6Azi , & + M4N6DynP , M4N6FAFxi , M4N6FAFyi , M4N6FAFzi , M4N6FAGxi , M4N6FAGyi , M4N6FAGzi , & + M4N6FAMxi , M4N6FAMyi , M4N6FAMzi , M4N6FBFxi , M4N6FBFyi , M4N6FBFzi , M4N6FBxi , & + M4N6FByi , M4N6FBzi , M4N6FDxi , M4N6FDyi , M4N6FDzi , M4N6FIxi , M4N6FIyi , & + M4N6FIzi , M4N6FMGxi , M4N6FMGyi , M4N6FMGzi , M4N6MAFxi , M4N6MAFyi , M4N6MAFzi , & + M4N6MAGxi , M4N6MAGyi , M4N6MAGzi , M4N6MBFxi , M4N6MBFyi , M4N6MBFzi , M4N6MBxi , & + M4N6MByi , M4N6MBzi , M4N6MMGxi , M4N6MMGyi , M4N6MMGzi , M4N6STAxi , M4N6STAyi , & + M4N6STAzi , M4N6STVxi , M4N6STVyi , M4N6STVzi , M4N6Vxi , M4N6Vyi , M4N6Vzi , & + M4N7Axi , M4N7Ayi , M4N7Azi , M4N7DynP , M4N7FAFxi , M4N7FAFyi , M4N7FAFzi , & + M4N7FAGxi , M4N7FAGyi , M4N7FAGzi , M4N7FAMxi , M4N7FAMyi , M4N7FAMzi , M4N7FBFxi , & + M4N7FBFyi , M4N7FBFzi , M4N7FBxi , M4N7FByi , M4N7FBzi , M4N7FDxi , M4N7FDyi , & + M4N7FDzi , M4N7FIxi , M4N7FIyi , M4N7FIzi , M4N7FMGxi , M4N7FMGyi , M4N7FMGzi , & + M4N7MAFxi , M4N7MAFyi , M4N7MAFzi , M4N7MAGxi , M4N7MAGyi , M4N7MAGzi , M4N7MBFxi , & + M4N7MBFyi , M4N7MBFzi , M4N7MBxi , M4N7MByi , M4N7MBzi , M4N7MMGxi , M4N7MMGyi , & + M4N7MMGzi , M4N7STAxi , M4N7STAyi , M4N7STAzi , M4N7STVxi , M4N7STVyi , M4N7STVzi , & + M4N7Vxi , M4N7Vyi , M4N7Vzi , M4N8Axi , M4N8Ayi , M4N8Azi , M4N8DynP , & + M4N8FAFxi , M4N8FAFyi , M4N8FAFzi , M4N8FAGxi , M4N8FAGyi , M4N8FAGzi , M4N8FAMxi , & + M4N8FAMyi , M4N8FAMzi , M4N8FBFxi , M4N8FBFyi , M4N8FBFzi , M4N8FBxi , M4N8FByi , & + M4N8FBzi , M4N8FDxi , M4N8FDyi , M4N8FDzi , M4N8FIxi , M4N8FIyi , M4N8FIzi , & + M4N8FMGxi , M4N8FMGyi , M4N8FMGzi , M4N8MAFxi , M4N8MAFyi , M4N8MAFzi , M4N8MAGxi , & + M4N8MAGyi , M4N8MAGzi , M4N8MBFxi , M4N8MBFyi , M4N8MBFzi , M4N8MBxi , M4N8MByi , & + M4N8MBzi , M4N8MMGxi , M4N8MMGyi , M4N8MMGzi , M4N8STAxi , M4N8STAyi , M4N8STAzi , & + M4N8STVxi , M4N8STVyi , M4N8STVzi , M4N8Vxi , M4N8Vyi , M4N8Vzi , M4N9Axi , & + M4N9Ayi , M4N9Azi , M4N9DynP , M4N9FAFxi , M4N9FAFyi , M4N9FAFzi , M4N9FAGxi , & + M4N9FAGyi , M4N9FAGzi , M4N9FAMxi , M4N9FAMyi , M4N9FAMzi , M4N9FBFxi , M4N9FBFyi , & + M4N9FBFzi , M4N9FBxi , M4N9FByi , M4N9FBzi , M4N9FDxi , M4N9FDyi , M4N9FDzi , & + M4N9FIxi , M4N9FIyi , M4N9FIzi , M4N9FMGxi , M4N9FMGyi , M4N9FMGzi , M4N9MAFxi , & + M4N9MAFyi , M4N9MAFzi , M4N9MAGxi , M4N9MAGyi , M4N9MAGzi , M4N9MBFxi , M4N9MBFyi , & + M4N9MBFzi , M4N9MBxi , M4N9MByi , M4N9MBzi , M4N9MMGxi , M4N9MMGyi , M4N9MMGzi , & + M4N9STAxi , M4N9STAyi , M4N9STAzi , M4N9STVxi , M4N9STVyi , M4N9STVzi , M4N9Vxi , & + M4N9Vyi , M4N9Vzi , M5N1Axi , M5N1Ayi , M5N1Azi , M5N1DynP , M5N1FAFxi , & + M5N1FAFyi , M5N1FAFzi , M5N1FAGxi , M5N1FAGyi , M5N1FAGzi , M5N1FAMxi , M5N1FAMyi , & + M5N1FAMzi , M5N1FBFxi , M5N1FBFyi , M5N1FBFzi , M5N1FBxi , M5N1FByi , M5N1FBzi , & + M5N1FDxi , M5N1FDyi , M5N1FDzi , M5N1FIxi , M5N1FIyi , M5N1FIzi , M5N1FMGxi , & + M5N1FMGyi , M5N1FMGzi , M5N1MAFxi , M5N1MAFyi , M5N1MAFzi , M5N1MAGxi , M5N1MAGyi , & + M5N1MAGzi , M5N1MBFxi , M5N1MBFyi , M5N1MBFzi , M5N1MBxi , M5N1MByi , M5N1MBzi , & + M5N1MMGxi , M5N1MMGyi , M5N1MMGzi , M5N1STAxi , M5N1STAyi , M5N1STAzi , M5N1STVxi , & + M5N1STVyi , M5N1STVzi , M5N1Vxi , M5N1Vyi , M5N1Vzi , M5N2Axi , M5N2Ayi , & + M5N2Azi , M5N2DynP , M5N2FAFxi , M5N2FAFyi , M5N2FAFzi , M5N2FAGxi , M5N2FAGyi , & + M5N2FAGzi , M5N2FAMxi , M5N2FAMyi , M5N2FAMzi , M5N2FBFxi , M5N2FBFyi , M5N2FBFzi , & + M5N2FBxi , M5N2FByi , M5N2FBzi , M5N2FDxi , M5N2FDyi , M5N2FDzi , M5N2FIxi , & + M5N2FIyi , M5N2FIzi , M5N2FMGxi , M5N2FMGyi , M5N2FMGzi , M5N2MAFxi , M5N2MAFyi , & + M5N2MAFzi , M5N2MAGxi , M5N2MAGyi , M5N2MAGzi , M5N2MBFxi , M5N2MBFyi , M5N2MBFzi , & + M5N2MBxi , M5N2MByi , M5N2MBzi , M5N2MMGxi , M5N2MMGyi , M5N2MMGzi , M5N2STAxi , & + M5N2STAyi , M5N2STAzi , M5N2STVxi , M5N2STVyi , M5N2STVzi , M5N2Vxi , M5N2Vyi , & + M5N2Vzi , M5N3Axi , M5N3Ayi , M5N3Azi , M5N3DynP , M5N3FAFxi , M5N3FAFyi , & + M5N3FAFzi , M5N3FAGxi , M5N3FAGyi , M5N3FAGzi , M5N3FAMxi , M5N3FAMyi , M5N3FAMzi , & + M5N3FBFxi , M5N3FBFyi , M5N3FBFzi , M5N3FBxi , M5N3FByi , M5N3FBzi , M5N3FDxi , & + M5N3FDyi , M5N3FDzi , M5N3FIxi , M5N3FIyi , M5N3FIzi , M5N3FMGxi , M5N3FMGyi , & + M5N3FMGzi , M5N3MAFxi , M5N3MAFyi , M5N3MAFzi , M5N3MAGxi , M5N3MAGyi , M5N3MAGzi , & + M5N3MBFxi , M5N3MBFyi , M5N3MBFzi , M5N3MBxi , M5N3MByi , M5N3MBzi , M5N3MMGxi , & + M5N3MMGyi , M5N3MMGzi , M5N3STAxi , M5N3STAyi , M5N3STAzi , M5N3STVxi , M5N3STVyi , & + M5N3STVzi , M5N3Vxi , M5N3Vyi , M5N3Vzi , M5N4Axi , M5N4Ayi , M5N4Azi , & + M5N4DynP , M5N4FAFxi , M5N4FAFyi , M5N4FAFzi , M5N4FAGxi , M5N4FAGyi , M5N4FAGzi , & + M5N4FAMxi , M5N4FAMyi , M5N4FAMzi , M5N4FBFxi , M5N4FBFyi , M5N4FBFzi , M5N4FBxi , & + M5N4FByi , M5N4FBzi , M5N4FDxi , M5N4FDyi , M5N4FDzi , M5N4FIxi , M5N4FIyi , & + M5N4FIzi , M5N4FMGxi , M5N4FMGyi , M5N4FMGzi , M5N4MAFxi , M5N4MAFyi , M5N4MAFzi , & + M5N4MAGxi , M5N4MAGyi , M5N4MAGzi , M5N4MBFxi , M5N4MBFyi , M5N4MBFzi , M5N4MBxi , & + M5N4MByi , M5N4MBzi , M5N4MMGxi , M5N4MMGyi , M5N4MMGzi , M5N4STAxi , M5N4STAyi , & + M5N4STAzi , M5N4STVxi , M5N4STVyi , M5N4STVzi , M5N4Vxi , M5N4Vyi , M5N4Vzi , & + M5N5Axi , M5N5Ayi , M5N5Azi , M5N5DynP , M5N5FAFxi , M5N5FAFyi , M5N5FAFzi , & + M5N5FAGxi , M5N5FAGyi , M5N5FAGzi , M5N5FAMxi , M5N5FAMyi , M5N5FAMzi , M5N5FBFxi , & + M5N5FBFyi , M5N5FBFzi , M5N5FBxi , M5N5FByi , M5N5FBzi , M5N5FDxi , M5N5FDyi , & + M5N5FDzi , M5N5FIxi , M5N5FIyi , M5N5FIzi , M5N5FMGxi , M5N5FMGyi , M5N5FMGzi , & + M5N5MAFxi , M5N5MAFyi , M5N5MAFzi , M5N5MAGxi , M5N5MAGyi , M5N5MAGzi , M5N5MBFxi , & + M5N5MBFyi , M5N5MBFzi , M5N5MBxi , M5N5MByi , M5N5MBzi , M5N5MMGxi , M5N5MMGyi , & + M5N5MMGzi , M5N5STAxi , M5N5STAyi , M5N5STAzi , M5N5STVxi , M5N5STVyi , M5N5STVzi , & + M5N5Vxi , M5N5Vyi , M5N5Vzi , M5N6Axi , M5N6Ayi , M5N6Azi , M5N6DynP , & + M5N6FAFxi , M5N6FAFyi , M5N6FAFzi , M5N6FAGxi , M5N6FAGyi , M5N6FAGzi , M5N6FAMxi , & + M5N6FAMyi , M5N6FAMzi , M5N6FBFxi , M5N6FBFyi , M5N6FBFzi , M5N6FBxi , M5N6FByi , & + M5N6FBzi , M5N6FDxi , M5N6FDyi , M5N6FDzi , M5N6FIxi , M5N6FIyi , M5N6FIzi , & + M5N6FMGxi , M5N6FMGyi , M5N6FMGzi , M5N6MAFxi , M5N6MAFyi , M5N6MAFzi , M5N6MAGxi , & + M5N6MAGyi , M5N6MAGzi , M5N6MBFxi , M5N6MBFyi , M5N6MBFzi , M5N6MBxi , M5N6MByi , & + M5N6MBzi , M5N6MMGxi , M5N6MMGyi , M5N6MMGzi , M5N6STAxi , M5N6STAyi , M5N6STAzi , & + M5N6STVxi , M5N6STVyi , M5N6STVzi , M5N6Vxi , M5N6Vyi , M5N6Vzi , M5N7Axi , & + M5N7Ayi , M5N7Azi , M5N7DynP , M5N7FAFxi , M5N7FAFyi , M5N7FAFzi , M5N7FAGxi , & + M5N7FAGyi , M5N7FAGzi , M5N7FAMxi , M5N7FAMyi , M5N7FAMzi , M5N7FBFxi , M5N7FBFyi , & + M5N7FBFzi , M5N7FBxi , M5N7FByi , M5N7FBzi , M5N7FDxi , M5N7FDyi , M5N7FDzi , & + M5N7FIxi , M5N7FIyi , M5N7FIzi , M5N7FMGxi , M5N7FMGyi , M5N7FMGzi , M5N7MAFxi , & + M5N7MAFyi , M5N7MAFzi , M5N7MAGxi , M5N7MAGyi , M5N7MAGzi , M5N7MBFxi , M5N7MBFyi , & + M5N7MBFzi , M5N7MBxi , M5N7MByi , M5N7MBzi , M5N7MMGxi , M5N7MMGyi , M5N7MMGzi , & + M5N7STAxi , M5N7STAyi , M5N7STAzi , M5N7STVxi , M5N7STVyi , M5N7STVzi , M5N7Vxi , & + M5N7Vyi , M5N7Vzi , M5N8Axi , M5N8Ayi , M5N8Azi , M5N8DynP , M5N8FAFxi , & + M5N8FAFyi , M5N8FAFzi , M5N8FAGxi , M5N8FAGyi , M5N8FAGzi , M5N8FAMxi , M5N8FAMyi , & + M5N8FAMzi , M5N8FBFxi , M5N8FBFyi , M5N8FBFzi , M5N8FBxi , M5N8FByi , M5N8FBzi , & + M5N8FDxi , M5N8FDyi , M5N8FDzi , M5N8FIxi , M5N8FIyi , M5N8FIzi , M5N8FMGxi , & + M5N8FMGyi , M5N8FMGzi , M5N8MAFxi , M5N8MAFyi , M5N8MAFzi , M5N8MAGxi , M5N8MAGyi , & + M5N8MAGzi , M5N8MBFxi , M5N8MBFyi , M5N8MBFzi , M5N8MBxi , M5N8MByi , M5N8MBzi , & + M5N8MMGxi , M5N8MMGyi , M5N8MMGzi , M5N8STAxi , M5N8STAyi , M5N8STAzi , M5N8STVxi , & + M5N8STVyi , M5N8STVzi , M5N8Vxi , M5N8Vyi , M5N8Vzi , M5N9Axi , M5N9Ayi , & + M5N9Azi , M5N9DynP , M5N9FAFxi , M5N9FAFyi , M5N9FAFzi , M5N9FAGxi , M5N9FAGyi , & + M5N9FAGzi , M5N9FAMxi , M5N9FAMyi , M5N9FAMzi , M5N9FBFxi , M5N9FBFyi , M5N9FBFzi , & + M5N9FBxi , M5N9FByi , M5N9FBzi , M5N9FDxi , M5N9FDyi , M5N9FDzi , M5N9FIxi , & + M5N9FIyi , M5N9FIzi , M5N9FMGxi , M5N9FMGyi , M5N9FMGzi , M5N9MAFxi , M5N9MAFyi , & + M5N9MAFzi , M5N9MAGxi , M5N9MAGyi , M5N9MAGzi , M5N9MBFxi , M5N9MBFyi , M5N9MBFzi , & + M5N9MBxi , M5N9MByi , M5N9MBzi , M5N9MMGxi , M5N9MMGyi , M5N9MMGzi , M5N9STAxi , & + M5N9STAyi , M5N9STAzi , M5N9STVxi , M5N9STVyi , M5N9STVzi , M5N9Vxi , M5N9Vyi , & + M5N9Vzi , M6N1Axi , M6N1Ayi , M6N1Azi , M6N1DynP , M6N1FAFxi , M6N1FAFyi , & + M6N1FAFzi , M6N1FAGxi , M6N1FAGyi , M6N1FAGzi , M6N1FAMxi , M6N1FAMyi , M6N1FAMzi , & + M6N1FBFxi , M6N1FBFyi , M6N1FBFzi , M6N1FBxi , M6N1FByi , M6N1FBzi , M6N1FDxi , & + M6N1FDyi , M6N1FDzi , M6N1FIxi , M6N1FIyi , M6N1FIzi , M6N1FMGxi , M6N1FMGyi , & + M6N1FMGzi , M6N1MAFxi , M6N1MAFyi , M6N1MAFzi , M6N1MAGxi , M6N1MAGyi , M6N1MAGzi , & + M6N1MBFxi , M6N1MBFyi , M6N1MBFzi , M6N1MBxi , M6N1MByi , M6N1MBzi , M6N1MMGxi , & + M6N1MMGyi , M6N1MMGzi , M6N1STAxi , M6N1STAyi , M6N1STAzi , M6N1STVxi , M6N1STVyi , & + M6N1STVzi , M6N1Vxi , M6N1Vyi , M6N1Vzi , M6N2Axi , M6N2Ayi , M6N2Azi , & + M6N2DynP , M6N2FAFxi , M6N2FAFyi , M6N2FAFzi , M6N2FAGxi , M6N2FAGyi , M6N2FAGzi , & + M6N2FAMxi , M6N2FAMyi , M6N2FAMzi , M6N2FBFxi , M6N2FBFyi , M6N2FBFzi , M6N2FBxi , & + M6N2FByi , M6N2FBzi , M6N2FDxi , M6N2FDyi , M6N2FDzi , M6N2FIxi , M6N2FIyi , & + M6N2FIzi , M6N2FMGxi , M6N2FMGyi , M6N2FMGzi , M6N2MAFxi , M6N2MAFyi , M6N2MAFzi , & + M6N2MAGxi , M6N2MAGyi , M6N2MAGzi , M6N2MBFxi , M6N2MBFyi , M6N2MBFzi , M6N2MBxi , & + M6N2MByi , M6N2MBzi , M6N2MMGxi , M6N2MMGyi , M6N2MMGzi , M6N2STAxi , M6N2STAyi , & + M6N2STAzi , M6N2STVxi , M6N2STVyi , M6N2STVzi , M6N2Vxi , M6N2Vyi , M6N2Vzi , & + M6N3Axi , M6N3Ayi , M6N3Azi , M6N3DynP , M6N3FAFxi , M6N3FAFyi , M6N3FAFzi , & + M6N3FAGxi , M6N3FAGyi , M6N3FAGzi , M6N3FAMxi , M6N3FAMyi , M6N3FAMzi , M6N3FBFxi , & + M6N3FBFyi , M6N3FBFzi , M6N3FBxi , M6N3FByi , M6N3FBzi , M6N3FDxi , M6N3FDyi , & + M6N3FDzi , M6N3FIxi , M6N3FIyi , M6N3FIzi , M6N3FMGxi , M6N3FMGyi , M6N3FMGzi , & + M6N3MAFxi , M6N3MAFyi , M6N3MAFzi , M6N3MAGxi , M6N3MAGyi , M6N3MAGzi , M6N3MBFxi , & + M6N3MBFyi , M6N3MBFzi , M6N3MBxi , M6N3MByi , M6N3MBzi , M6N3MMGxi , M6N3MMGyi , & + M6N3MMGzi , M6N3STAxi , M6N3STAyi , M6N3STAzi , M6N3STVxi , M6N3STVyi , M6N3STVzi , & + M6N3Vxi , M6N3Vyi , M6N3Vzi , M6N4Axi , M6N4Ayi , M6N4Azi , M6N4DynP , & + M6N4FAFxi , M6N4FAFyi , M6N4FAFzi , M6N4FAGxi , M6N4FAGyi , M6N4FAGzi , M6N4FAMxi , & + M6N4FAMyi , M6N4FAMzi , M6N4FBFxi , M6N4FBFyi , M6N4FBFzi , M6N4FBxi , M6N4FByi , & + M6N4FBzi , M6N4FDxi , M6N4FDyi , M6N4FDzi , M6N4FIxi , M6N4FIyi , M6N4FIzi , & + M6N4FMGxi , M6N4FMGyi , M6N4FMGzi , M6N4MAFxi , M6N4MAFyi , M6N4MAFzi , M6N4MAGxi , & + M6N4MAGyi , M6N4MAGzi , M6N4MBFxi , M6N4MBFyi , M6N4MBFzi , M6N4MBxi , M6N4MByi , & + M6N4MBzi , M6N4MMGxi , M6N4MMGyi , M6N4MMGzi , M6N4STAxi , M6N4STAyi , M6N4STAzi , & + M6N4STVxi , M6N4STVyi , M6N4STVzi , M6N4Vxi , M6N4Vyi , M6N4Vzi , M6N5Axi , & + M6N5Ayi , M6N5Azi , M6N5DynP , M6N5FAFxi , M6N5FAFyi , M6N5FAFzi , M6N5FAGxi , & + M6N5FAGyi , M6N5FAGzi , M6N5FAMxi , M6N5FAMyi , M6N5FAMzi , M6N5FBFxi , M6N5FBFyi , & + M6N5FBFzi , M6N5FBxi , M6N5FByi , M6N5FBzi , M6N5FDxi , M6N5FDyi , M6N5FDzi , & + M6N5FIxi , M6N5FIyi , M6N5FIzi , M6N5FMGxi , M6N5FMGyi , M6N5FMGzi , M6N5MAFxi , & + M6N5MAFyi , M6N5MAFzi , M6N5MAGxi , M6N5MAGyi , M6N5MAGzi , M6N5MBFxi , M6N5MBFyi , & + M6N5MBFzi , M6N5MBxi , M6N5MByi , M6N5MBzi , M6N5MMGxi , M6N5MMGyi , M6N5MMGzi , & + M6N5STAxi , M6N5STAyi , M6N5STAzi , M6N5STVxi , M6N5STVyi , M6N5STVzi , M6N5Vxi , & + M6N5Vyi , M6N5Vzi , M6N6Axi , M6N6Ayi , M6N6Azi , M6N6DynP , M6N6FAFxi , & + M6N6FAFyi , M6N6FAFzi , M6N6FAGxi , M6N6FAGyi , M6N6FAGzi , M6N6FAMxi , M6N6FAMyi , & + M6N6FAMzi , M6N6FBFxi , M6N6FBFyi , M6N6FBFzi , M6N6FBxi , M6N6FByi , M6N6FBzi , & + M6N6FDxi , M6N6FDyi , M6N6FDzi , M6N6FIxi , M6N6FIyi , M6N6FIzi , M6N6FMGxi , & + M6N6FMGyi , M6N6FMGzi , M6N6MAFxi , M6N6MAFyi , M6N6MAFzi , M6N6MAGxi , M6N6MAGyi , & + M6N6MAGzi , M6N6MBFxi , M6N6MBFyi , M6N6MBFzi , M6N6MBxi , M6N6MByi , M6N6MBzi , & + M6N6MMGxi , M6N6MMGyi , M6N6MMGzi , M6N6STAxi , M6N6STAyi , M6N6STAzi , M6N6STVxi , & + M6N6STVyi , M6N6STVzi , M6N6Vxi , M6N6Vyi , M6N6Vzi , M6N7Axi , M6N7Ayi , & + M6N7Azi , M6N7DynP , M6N7FAFxi , M6N7FAFyi , M6N7FAFzi , M6N7FAGxi , M6N7FAGyi , & + M6N7FAGzi , M6N7FAMxi , M6N7FAMyi , M6N7FAMzi , M6N7FBFxi , M6N7FBFyi , M6N7FBFzi , & + M6N7FBxi , M6N7FByi /) + INTEGER(IntKi), PARAMETER :: ParamIndxAry3(1542) = (/ & ! This lists the index into AllOuts(:) of the allowed parameters ValidParamAry(:) + M6N7FBzi , M6N7FDxi , M6N7FDyi , M6N7FDzi , M6N7FIxi , M6N7FIyi , M6N7FIzi , & + M6N7FMGxi , M6N7FMGyi , M6N7FMGzi , M6N7MAFxi , M6N7MAFyi , M6N7MAFzi , M6N7MAGxi , & + M6N7MAGyi , M6N7MAGzi , M6N7MBFxi , M6N7MBFyi , M6N7MBFzi , M6N7MBxi , M6N7MByi , & + M6N7MBzi , M6N7MMGxi , M6N7MMGyi , M6N7MMGzi , M6N7STAxi , M6N7STAyi , M6N7STAzi , & + M6N7STVxi , M6N7STVyi , M6N7STVzi , M6N7Vxi , M6N7Vyi , M6N7Vzi , M6N8Axi , & + M6N8Ayi , M6N8Azi , M6N8DynP , M6N8FAFxi , M6N8FAFyi , M6N8FAFzi , M6N8FAGxi , & + M6N8FAGyi , M6N8FAGzi , M6N8FAMxi , M6N8FAMyi , M6N8FAMzi , M6N8FBFxi , M6N8FBFyi , & + M6N8FBFzi , M6N8FBxi , M6N8FByi , M6N8FBzi , M6N8FDxi , M6N8FDyi , M6N8FDzi , & + M6N8FIxi , M6N8FIyi , M6N8FIzi , M6N8FMGxi , M6N8FMGyi , M6N8FMGzi , M6N8MAFxi , & + M6N8MAFyi , M6N8MAFzi , M6N8MAGxi , M6N8MAGyi , M6N8MAGzi , M6N8MBFxi , M6N8MBFyi , & + M6N8MBFzi , M6N8MBxi , M6N8MByi , M6N8MBzi , M6N8MMGxi , M6N8MMGyi , M6N8MMGzi , & + M6N8STAxi , M6N8STAyi , M6N8STAzi , M6N8STVxi , M6N8STVyi , M6N8STVzi , M6N8Vxi , & + M6N8Vyi , M6N8Vzi , M6N9Axi , M6N9Ayi , M6N9Azi , M6N9DynP , M6N9FAFxi , & + M6N9FAFyi , M6N9FAFzi , M6N9FAGxi , M6N9FAGyi , M6N9FAGzi , M6N9FAMxi , M6N9FAMyi , & + M6N9FAMzi , M6N9FBFxi , M6N9FBFyi , M6N9FBFzi , M6N9FBxi , M6N9FByi , M6N9FBzi , & + M6N9FDxi , M6N9FDyi , M6N9FDzi , M6N9FIxi , M6N9FIyi , M6N9FIzi , M6N9FMGxi , & + M6N9FMGyi , M6N9FMGzi , M6N9MAFxi , M6N9MAFyi , M6N9MAFzi , M6N9MAGxi , M6N9MAGyi , & + M6N9MAGzi , M6N9MBFxi , M6N9MBFyi , M6N9MBFzi , M6N9MBxi , M6N9MByi , M6N9MBzi , & + M6N9MMGxi , M6N9MMGyi , M6N9MMGzi , M6N9STAxi , M6N9STAyi , M6N9STAzi , M6N9STVxi , & + M6N9STVyi , M6N9STVzi , M6N9Vxi , M6N9Vyi , M6N9Vzi , M7N1Axi , M7N1Ayi , & + M7N1Azi , M7N1DynP , M7N1FAFxi , M7N1FAFyi , M7N1FAFzi , M7N1FAGxi , M7N1FAGyi , & + M7N1FAGzi , M7N1FAMxi , M7N1FAMyi , M7N1FAMzi , M7N1FBFxi , M7N1FBFyi , M7N1FBFzi , & + M7N1FBxi , M7N1FByi , M7N1FBzi , M7N1FDxi , M7N1FDyi , M7N1FDzi , M7N1FIxi , & + M7N1FIyi , M7N1FIzi , M7N1FMGxi , M7N1FMGyi , M7N1FMGzi , M7N1MAFxi , M7N1MAFyi , & + M7N1MAFzi , M7N1MAGxi , M7N1MAGyi , M7N1MAGzi , M7N1MBFxi , M7N1MBFyi , M7N1MBFzi , & + M7N1MBxi , M7N1MByi , M7N1MBzi , M7N1MMGxi , M7N1MMGyi , M7N1MMGzi , M7N1STAxi , & + M7N1STAyi , M7N1STAzi , M7N1STVxi , M7N1STVyi , M7N1STVzi , M7N1Vxi , M7N1Vyi , & + M7N1Vzi , M7N2Axi , M7N2Ayi , M7N2Azi , M7N2DynP , M7N2FAFxi , M7N2FAFyi , & + M7N2FAFzi , M7N2FAGxi , M7N2FAGyi , M7N2FAGzi , M7N2FAMxi , M7N2FAMyi , M7N2FAMzi , & + M7N2FBFxi , M7N2FBFyi , M7N2FBFzi , M7N2FBxi , M7N2FByi , M7N2FBzi , M7N2FDxi , & + M7N2FDyi , M7N2FDzi , M7N2FIxi , M7N2FIyi , M7N2FIzi , M7N2FMGxi , M7N2FMGyi , & + M7N2FMGzi , M7N2MAFxi , M7N2MAFyi , M7N2MAFzi , M7N2MAGxi , M7N2MAGyi , M7N2MAGzi , & + M7N2MBFxi , M7N2MBFyi , M7N2MBFzi , M7N2MBxi , M7N2MByi , M7N2MBzi , M7N2MMGxi , & + M7N2MMGyi , M7N2MMGzi , M7N2STAxi , M7N2STAyi , M7N2STAzi , M7N2STVxi , M7N2STVyi , & + M7N2STVzi , M7N2Vxi , M7N2Vyi , M7N2Vzi , M7N3Axi , M7N3Ayi , M7N3Azi , & + M7N3DynP , M7N3FAFxi , M7N3FAFyi , M7N3FAFzi , M7N3FAGxi , M7N3FAGyi , M7N3FAGzi , & + M7N3FAMxi , M7N3FAMyi , M7N3FAMzi , M7N3FBFxi , M7N3FBFyi , M7N3FBFzi , M7N3FBxi , & + M7N3FByi , M7N3FBzi , M7N3FDxi , M7N3FDyi , M7N3FDzi , M7N3FIxi , M7N3FIyi , & + M7N3FIzi , M7N3FMGxi , M7N3FMGyi , M7N3FMGzi , M7N3MAFxi , M7N3MAFyi , M7N3MAFzi , & + M7N3MAGxi , M7N3MAGyi , M7N3MAGzi , M7N3MBFxi , M7N3MBFyi , M7N3MBFzi , M7N3MBxi , & + M7N3MByi , M7N3MBzi , M7N3MMGxi , M7N3MMGyi , M7N3MMGzi , M7N3STAxi , M7N3STAyi , & + M7N3STAzi , M7N3STVxi , M7N3STVyi , M7N3STVzi , M7N3Vxi , M7N3Vyi , M7N3Vzi , & + M7N4Axi , M7N4Ayi , M7N4Azi , M7N4DynP , M7N4FAFxi , M7N4FAFyi , M7N4FAFzi , & + M7N4FAGxi , M7N4FAGyi , M7N4FAGzi , M7N4FAMxi , M7N4FAMyi , M7N4FAMzi , M7N4FBFxi , & + M7N4FBFyi , M7N4FBFzi , M7N4FBxi , M7N4FByi , M7N4FBzi , M7N4FDxi , M7N4FDyi , & + M7N4FDzi , M7N4FIxi , M7N4FIyi , M7N4FIzi , M7N4FMGxi , M7N4FMGyi , M7N4FMGzi , & + M7N4MAFxi , M7N4MAFyi , M7N4MAFzi , M7N4MAGxi , M7N4MAGyi , M7N4MAGzi , M7N4MBFxi , & + M7N4MBFyi , M7N4MBFzi , M7N4MBxi , M7N4MByi , M7N4MBzi , M7N4MMGxi , M7N4MMGyi , & + M7N4MMGzi , M7N4STAxi , M7N4STAyi , M7N4STAzi , M7N4STVxi , M7N4STVyi , M7N4STVzi , & + M7N4Vxi , M7N4Vyi , M7N4Vzi , M7N5Axi , M7N5Ayi , M7N5Azi , M7N5DynP , & + M7N5FAFxi , M7N5FAFyi , M7N5FAFzi , M7N5FAGxi , M7N5FAGyi , M7N5FAGzi , M7N5FAMxi , & + M7N5FAMyi , M7N5FAMzi , M7N5FBFxi , M7N5FBFyi , M7N5FBFzi , M7N5FBxi , M7N5FByi , & + M7N5FBzi , M7N5FDxi , M7N5FDyi , M7N5FDzi , M7N5FIxi , M7N5FIyi , M7N5FIzi , & + M7N5FMGxi , M7N5FMGyi , M7N5FMGzi , M7N5MAFxi , M7N5MAFyi , M7N5MAFzi , M7N5MAGxi , & + M7N5MAGyi , M7N5MAGzi , M7N5MBFxi , M7N5MBFyi , M7N5MBFzi , M7N5MBxi , M7N5MByi , & + M7N5MBzi , M7N5MMGxi , M7N5MMGyi , M7N5MMGzi , M7N5STAxi , M7N5STAyi , M7N5STAzi , & + M7N5STVxi , M7N5STVyi , M7N5STVzi , M7N5Vxi , M7N5Vyi , M7N5Vzi , M7N6Axi , & + M7N6Ayi , M7N6Azi , M7N6DynP , M7N6FAFxi , M7N6FAFyi , M7N6FAFzi , M7N6FAGxi , & + M7N6FAGyi , M7N6FAGzi , M7N6FAMxi , M7N6FAMyi , M7N6FAMzi , M7N6FBFxi , M7N6FBFyi , & + M7N6FBFzi , M7N6FBxi , M7N6FByi , M7N6FBzi , M7N6FDxi , M7N6FDyi , M7N6FDzi , & + M7N6FIxi , M7N6FIyi , M7N6FIzi , M7N6FMGxi , M7N6FMGyi , M7N6FMGzi , M7N6MAFxi , & + M7N6MAFyi , M7N6MAFzi , M7N6MAGxi , M7N6MAGyi , M7N6MAGzi , M7N6MBFxi , M7N6MBFyi , & + M7N6MBFzi , M7N6MBxi , M7N6MByi , M7N6MBzi , M7N6MMGxi , M7N6MMGyi , M7N6MMGzi , & + M7N6STAxi , M7N6STAyi , M7N6STAzi , M7N6STVxi , M7N6STVyi , M7N6STVzi , M7N6Vxi , & + M7N6Vyi , M7N6Vzi , M7N7Axi , M7N7Ayi , M7N7Azi , M7N7DynP , M7N7FAFxi , & + M7N7FAFyi , M7N7FAFzi , M7N7FAGxi , M7N7FAGyi , M7N7FAGzi , M7N7FAMxi , M7N7FAMyi , & + M7N7FAMzi , M7N7FBFxi , M7N7FBFyi , M7N7FBFzi , M7N7FBxi , M7N7FByi , M7N7FBzi , & + M7N7FDxi , M7N7FDyi , M7N7FDzi , M7N7FIxi , M7N7FIyi , M7N7FIzi , M7N7FMGxi , & + M7N7FMGyi , M7N7FMGzi , M7N7MAFxi , M7N7MAFyi , M7N7MAFzi , M7N7MAGxi , M7N7MAGyi , & + M7N7MAGzi , M7N7MBFxi , M7N7MBFyi , M7N7MBFzi , M7N7MBxi , M7N7MByi , M7N7MBzi , & + M7N7MMGxi , M7N7MMGyi , M7N7MMGzi , M7N7STAxi , M7N7STAyi , M7N7STAzi , M7N7STVxi , & + M7N7STVyi , M7N7STVzi , M7N7Vxi , M7N7Vyi , M7N7Vzi , M7N8Axi , M7N8Ayi , & + M7N8Azi , M7N8DynP , M7N8FAFxi , M7N8FAFyi , M7N8FAFzi , M7N8FAGxi , M7N8FAGyi , & + M7N8FAGzi , M7N8FAMxi , M7N8FAMyi , M7N8FAMzi , M7N8FBFxi , M7N8FBFyi , M7N8FBFzi , & + M7N8FBxi , M7N8FByi , M7N8FBzi , M7N8FDxi , M7N8FDyi , M7N8FDzi , M7N8FIxi , & + M7N8FIyi , M7N8FIzi , M7N8FMGxi , M7N8FMGyi , M7N8FMGzi , M7N8MAFxi , M7N8MAFyi , & + M7N8MAFzi , M7N8MAGxi , M7N8MAGyi , M7N8MAGzi , M7N8MBFxi , M7N8MBFyi , M7N8MBFzi , & + M7N8MBxi , M7N8MByi , M7N8MBzi , M7N8MMGxi , M7N8MMGyi , M7N8MMGzi , M7N8STAxi , & + M7N8STAyi , M7N8STAzi , M7N8STVxi , M7N8STVyi , M7N8STVzi , M7N8Vxi , M7N8Vyi , & + M7N8Vzi , M7N9Axi , M7N9Ayi , M7N9Azi , M7N9DynP , M7N9FAFxi , M7N9FAFyi , & + M7N9FAFzi , M7N9FAGxi , M7N9FAGyi , M7N9FAGzi , M7N9FAMxi , M7N9FAMyi , M7N9FAMzi , & + M7N9FBFxi , M7N9FBFyi , M7N9FBFzi , M7N9FBxi , M7N9FByi , M7N9FBzi , M7N9FDxi , & + M7N9FDyi , M7N9FDzi , M7N9FIxi , M7N9FIyi , M7N9FIzi , M7N9FMGxi , M7N9FMGyi , & + M7N9FMGzi , M7N9MAFxi , M7N9MAFyi , M7N9MAFzi , M7N9MAGxi , M7N9MAGyi , M7N9MAGzi , & + M7N9MBFxi , M7N9MBFyi , M7N9MBFzi , M7N9MBxi , M7N9MByi , M7N9MBzi , M7N9MMGxi , & + M7N9MMGyi , M7N9MMGzi , M7N9STAxi , M7N9STAyi , M7N9STAzi , M7N9STVxi , M7N9STVyi , & + M7N9STVzi , M7N9Vxi , M7N9Vyi , M7N9Vzi , M8N1Axi , M8N1Ayi , M8N1Azi , & + M8N1DynP , M8N1FAFxi , M8N1FAFyi , M8N1FAFzi , M8N1FAGxi , M8N1FAGyi , M8N1FAGzi , & + M8N1FAMxi , M8N1FAMyi , M8N1FAMzi , M8N1FBFxi , M8N1FBFyi , M8N1FBFzi , M8N1FBxi , & + M8N1FByi , M8N1FBzi , M8N1FDxi , M8N1FDyi , M8N1FDzi , M8N1FIxi , M8N1FIyi , & + M8N1FIzi , M8N1FMGxi , M8N1FMGyi , M8N1FMGzi , M8N1MAFxi , M8N1MAFyi , M8N1MAFzi , & + M8N1MAGxi , M8N1MAGyi , M8N1MAGzi , M8N1MBFxi , M8N1MBFyi , M8N1MBFzi , M8N1MBxi , & + M8N1MByi , M8N1MBzi , M8N1MMGxi , M8N1MMGyi , M8N1MMGzi , M8N1STAxi , M8N1STAyi , & + M8N1STAzi , M8N1STVxi , M8N1STVyi , M8N1STVzi , M8N1Vxi , M8N1Vyi , M8N1Vzi , & + M8N2Axi , M8N2Ayi , M8N2Azi , M8N2DynP , M8N2FAFxi , M8N2FAFyi , M8N2FAFzi , & + M8N2FAGxi , M8N2FAGyi , M8N2FAGzi , M8N2FAMxi , M8N2FAMyi , M8N2FAMzi , M8N2FBFxi , & + M8N2FBFyi , M8N2FBFzi , M8N2FBxi , M8N2FByi , M8N2FBzi , M8N2FDxi , M8N2FDyi , & + M8N2FDzi , M8N2FIxi , M8N2FIyi , M8N2FIzi , M8N2FMGxi , M8N2FMGyi , M8N2FMGzi , & + M8N2MAFxi , M8N2MAFyi , M8N2MAFzi , M8N2MAGxi , M8N2MAGyi , M8N2MAGzi , M8N2MBFxi , & + M8N2MBFyi , M8N2MBFzi , M8N2MBxi , M8N2MByi , M8N2MBzi , M8N2MMGxi , M8N2MMGyi , & + M8N2MMGzi , M8N2STAxi , M8N2STAyi , M8N2STAzi , M8N2STVxi , M8N2STVyi , M8N2STVzi , & + M8N2Vxi , M8N2Vyi , M8N2Vzi , M8N3Axi , M8N3Ayi , M8N3Azi , M8N3DynP , & + M8N3FAFxi , M8N3FAFyi , M8N3FAFzi , M8N3FAGxi , M8N3FAGyi , M8N3FAGzi , M8N3FAMxi , & + M8N3FAMyi , M8N3FAMzi , M8N3FBFxi , M8N3FBFyi , M8N3FBFzi , M8N3FBxi , M8N3FByi , & + M8N3FBzi , M8N3FDxi , M8N3FDyi , M8N3FDzi , M8N3FIxi , M8N3FIyi , M8N3FIzi , & + M8N3FMGxi , M8N3FMGyi , M8N3FMGzi , M8N3MAFxi , M8N3MAFyi , M8N3MAFzi , M8N3MAGxi , & + M8N3MAGyi , M8N3MAGzi , M8N3MBFxi , M8N3MBFyi , M8N3MBFzi , M8N3MBxi , M8N3MByi , & + M8N3MBzi , M8N3MMGxi , M8N3MMGyi , M8N3MMGzi , M8N3STAxi , M8N3STAyi , M8N3STAzi , & + M8N3STVxi , M8N3STVyi , M8N3STVzi , M8N3Vxi , M8N3Vyi , M8N3Vzi , M8N4Axi , & + M8N4Ayi , M8N4Azi , M8N4DynP , M8N4FAFxi , M8N4FAFyi , M8N4FAFzi , M8N4FAGxi , & + M8N4FAGyi , M8N4FAGzi , M8N4FAMxi , M8N4FAMyi , M8N4FAMzi , M8N4FBFxi , M8N4FBFyi , & + M8N4FBFzi , M8N4FBxi , M8N4FByi , M8N4FBzi , M8N4FDxi , M8N4FDyi , M8N4FDzi , & + M8N4FIxi , M8N4FIyi , M8N4FIzi , M8N4FMGxi , M8N4FMGyi , M8N4FMGzi , M8N4MAFxi , & + M8N4MAFyi , M8N4MAFzi , M8N4MAGxi , M8N4MAGyi , M8N4MAGzi , M8N4MBFxi , M8N4MBFyi , & + M8N4MBFzi , M8N4MBxi , M8N4MByi , M8N4MBzi , M8N4MMGxi , M8N4MMGyi , M8N4MMGzi , & + M8N4STAxi , M8N4STAyi , M8N4STAzi , M8N4STVxi , M8N4STVyi , M8N4STVzi , M8N4Vxi , & + M8N4Vyi , M8N4Vzi , M8N5Axi , M8N5Ayi , M8N5Azi , M8N5DynP , M8N5FAFxi , & + M8N5FAFyi , M8N5FAFzi , M8N5FAGxi , M8N5FAGyi , M8N5FAGzi , M8N5FAMxi , M8N5FAMyi , & + M8N5FAMzi , M8N5FBFxi , M8N5FBFyi , M8N5FBFzi , M8N5FBxi , M8N5FByi , M8N5FBzi , & + M8N5FDxi , M8N5FDyi , M8N5FDzi , M8N5FIxi , M8N5FIyi , M8N5FIzi , M8N5FMGxi , & + M8N5FMGyi , M8N5FMGzi , M8N5MAFxi , M8N5MAFyi , M8N5MAFzi , M8N5MAGxi , M8N5MAGyi , & + M8N5MAGzi , M8N5MBFxi , M8N5MBFyi , M8N5MBFzi , M8N5MBxi , M8N5MByi , M8N5MBzi , & + M8N5MMGxi , M8N5MMGyi , M8N5MMGzi , M8N5STAxi , M8N5STAyi , M8N5STAzi , M8N5STVxi , & + M8N5STVyi , M8N5STVzi , M8N5Vxi , M8N5Vyi , M8N5Vzi , M8N6Axi , M8N6Ayi , & + M8N6Azi , M8N6DynP , M8N6FAFxi , M8N6FAFyi , M8N6FAFzi , M8N6FAGxi , M8N6FAGyi , & + M8N6FAGzi , M8N6FAMxi , M8N6FAMyi , M8N6FAMzi , M8N6FBFxi , M8N6FBFyi , M8N6FBFzi , & + M8N6FBxi , M8N6FByi , M8N6FBzi , M8N6FDxi , M8N6FDyi , M8N6FDzi , M8N6FIxi , & + M8N6FIyi , M8N6FIzi , M8N6FMGxi , M8N6FMGyi , M8N6FMGzi , M8N6MAFxi , M8N6MAFyi , & + M8N6MAFzi , M8N6MAGxi , M8N6MAGyi , M8N6MAGzi , M8N6MBFxi , M8N6MBFyi , M8N6MBFzi , & + M8N6MBxi , M8N6MByi , M8N6MBzi , M8N6MMGxi , M8N6MMGyi , M8N6MMGzi , M8N6STAxi , & + M8N6STAyi , M8N6STAzi , M8N6STVxi , M8N6STVyi , M8N6STVzi , M8N6Vxi , M8N6Vyi , & + M8N6Vzi , M8N7Axi , M8N7Ayi , M8N7Azi , M8N7DynP , M8N7FAFxi , M8N7FAFyi , & + M8N7FAFzi , M8N7FAGxi , M8N7FAGyi , M8N7FAGzi , M8N7FAMxi , M8N7FAMyi , M8N7FAMzi , & + M8N7FBFxi , M8N7FBFyi , M8N7FBFzi , M8N7FBxi , M8N7FByi , M8N7FBzi , M8N7FDxi , & + M8N7FDyi , M8N7FDzi , M8N7FIxi , M8N7FIyi , M8N7FIzi , M8N7FMGxi , M8N7FMGyi , & + M8N7FMGzi , M8N7MAFxi , M8N7MAFyi , M8N7MAFzi , M8N7MAGxi , M8N7MAGyi , M8N7MAGzi , & + M8N7MBFxi , M8N7MBFyi , M8N7MBFzi , M8N7MBxi , M8N7MByi , M8N7MBzi , M8N7MMGxi , & + M8N7MMGyi , M8N7MMGzi , M8N7STAxi , M8N7STAyi , M8N7STAzi , M8N7STVxi , M8N7STVyi , & + M8N7STVzi , M8N7Vxi , M8N7Vyi , M8N7Vzi , M8N8Axi , M8N8Ayi , M8N8Azi , & + M8N8DynP , M8N8FAFxi , M8N8FAFyi , M8N8FAFzi , M8N8FAGxi , M8N8FAGyi , M8N8FAGzi , & + M8N8FAMxi , M8N8FAMyi , M8N8FAMzi , M8N8FBFxi , M8N8FBFyi , M8N8FBFzi , M8N8FBxi , & + M8N8FByi , M8N8FBzi , M8N8FDxi , M8N8FDyi , M8N8FDzi , M8N8FIxi , M8N8FIyi , & + M8N8FIzi , M8N8FMGxi , M8N8FMGyi , M8N8FMGzi , M8N8MAFxi , M8N8MAFyi , M8N8MAFzi , & + M8N8MAGxi , M8N8MAGyi , M8N8MAGzi , M8N8MBFxi , M8N8MBFyi , M8N8MBFzi , M8N8MBxi , & + M8N8MByi , M8N8MBzi , M8N8MMGxi , M8N8MMGyi , M8N8MMGzi , M8N8STAxi , M8N8STAyi , & + M8N8STAzi , M8N8STVxi , M8N8STVyi , M8N8STVzi , M8N8Vxi , M8N8Vyi , M8N8Vzi , & + M8N9Axi , M8N9Ayi , M8N9Azi , M8N9DynP , M8N9FAFxi , M8N9FAFyi , M8N9FAFzi , & + M8N9FAGxi , M8N9FAGyi , M8N9FAGzi , M8N9FAMxi , M8N9FAMyi , M8N9FAMzi , M8N9FBFxi , & + M8N9FBFyi , M8N9FBFzi , M8N9FBxi , M8N9FByi , M8N9FBzi , M8N9FDxi , M8N9FDyi , & + M8N9FDzi , M8N9FIxi , M8N9FIyi , M8N9FIzi , M8N9FMGxi , M8N9FMGyi , M8N9FMGzi , & + M8N9MAFxi , M8N9MAFyi , M8N9MAFzi , M8N9MAGxi , M8N9MAGyi , M8N9MAGzi , M8N9MBFxi , & + M8N9MBFyi , M8N9MBFzi , M8N9MBxi , M8N9MByi , M8N9MBzi , M8N9MMGxi , M8N9MMGyi , & + M8N9MMGzi , M8N9STAxi , M8N9STAyi , M8N9STAzi , M8N9STVxi , M8N9STVyi , M8N9STVzi , & + M8N9Vxi , M8N9Vyi , M8N9Vzi , M9N1Axi , M9N1Ayi , M9N1Azi , M9N1DynP , & + M9N1FAFxi , M9N1FAFyi , M9N1FAFzi , M9N1FAGxi , M9N1FAGyi , M9N1FAGzi , M9N1FAMxi , & + M9N1FAMyi , M9N1FAMzi , M9N1FBFxi , M9N1FBFyi , M9N1FBFzi , M9N1FBxi , M9N1FByi , & + M9N1FBzi , M9N1FDxi , M9N1FDyi , M9N1FDzi , M9N1FIxi , M9N1FIyi , M9N1FIzi , & + M9N1FMGxi , M9N1FMGyi , M9N1FMGzi , M9N1MAFxi , M9N1MAFyi , M9N1MAFzi , M9N1MAGxi , & + M9N1MAGyi , M9N1MAGzi , M9N1MBFxi , M9N1MBFyi , M9N1MBFzi , M9N1MBxi , M9N1MByi , & + M9N1MBzi , M9N1MMGxi , M9N1MMGyi , M9N1MMGzi , M9N1STAxi , M9N1STAyi , M9N1STAzi , & + M9N1STVxi , M9N1STVyi , M9N1STVzi , M9N1Vxi , M9N1Vyi , M9N1Vzi , M9N2Axi , & + M9N2Ayi , M9N2Azi , M9N2DynP , M9N2FAFxi , M9N2FAFyi , M9N2FAFzi , M9N2FAGxi , & + M9N2FAGyi , M9N2FAGzi , M9N2FAMxi , M9N2FAMyi , M9N2FAMzi , M9N2FBFxi , M9N2FBFyi , & + M9N2FBFzi , M9N2FBxi , M9N2FByi , M9N2FBzi , M9N2FDxi , M9N2FDyi , M9N2FDzi , & + M9N2FIxi , M9N2FIyi , M9N2FIzi , M9N2FMGxi , M9N2FMGyi , M9N2FMGzi , M9N2MAFxi , & + M9N2MAFyi , M9N2MAFzi , M9N2MAGxi , M9N2MAGyi , M9N2MAGzi , M9N2MBFxi , M9N2MBFyi , & + M9N2MBFzi , M9N2MBxi , M9N2MByi , M9N2MBzi , M9N2MMGxi , M9N2MMGyi , M9N2MMGzi , & + M9N2STAxi , M9N2STAyi , M9N2STAzi , M9N2STVxi , M9N2STVyi , M9N2STVzi , M9N2Vxi , & + M9N2Vyi , M9N2Vzi , M9N3Axi , M9N3Ayi , M9N3Azi , M9N3DynP , M9N3FAFxi , & + M9N3FAFyi , M9N3FAFzi , M9N3FAGxi , M9N3FAGyi , M9N3FAGzi , M9N3FAMxi , M9N3FAMyi , & + M9N3FAMzi , M9N3FBFxi , M9N3FBFyi , M9N3FBFzi , M9N3FBxi , M9N3FByi , M9N3FBzi , & + M9N3FDxi , M9N3FDyi , M9N3FDzi , M9N3FIxi , M9N3FIyi , M9N3FIzi , M9N3FMGxi , & + M9N3FMGyi , M9N3FMGzi , M9N3MAFxi , M9N3MAFyi , M9N3MAFzi , M9N3MAGxi , M9N3MAGyi , & + M9N3MAGzi , M9N3MBFxi , M9N3MBFyi , M9N3MBFzi , M9N3MBxi , M9N3MByi , M9N3MBzi , & + M9N3MMGxi , M9N3MMGyi , M9N3MMGzi , M9N3STAxi , M9N3STAyi , M9N3STAzi , M9N3STVxi , & + M9N3STVyi , M9N3STVzi , M9N3Vxi , M9N3Vyi , M9N3Vzi , M9N4Axi , M9N4Ayi , & + M9N4Azi , M9N4DynP , M9N4FAFxi , M9N4FAFyi , M9N4FAFzi , M9N4FAGxi , M9N4FAGyi , & + M9N4FAGzi , M9N4FAMxi , M9N4FAMyi , M9N4FAMzi , M9N4FBFxi , M9N4FBFyi , M9N4FBFzi , & + M9N4FBxi , M9N4FByi , M9N4FBzi , M9N4FDxi , M9N4FDyi , M9N4FDzi , M9N4FIxi , & + M9N4FIyi , M9N4FIzi , M9N4FMGxi , M9N4FMGyi , M9N4FMGzi , M9N4MAFxi , M9N4MAFyi , & + M9N4MAFzi , M9N4MAGxi , M9N4MAGyi , M9N4MAGzi , M9N4MBFxi , M9N4MBFyi , M9N4MBFzi , & + M9N4MBxi , M9N4MByi , M9N4MBzi , M9N4MMGxi , M9N4MMGyi , M9N4MMGzi , M9N4STAxi , & + M9N4STAyi , M9N4STAzi , M9N4STVxi , M9N4STVyi , M9N4STVzi , M9N4Vxi , M9N4Vyi , & + M9N4Vzi , M9N5Axi , M9N5Ayi , M9N5Azi , M9N5DynP , M9N5FAFxi , M9N5FAFyi , & + M9N5FAFzi , M9N5FAGxi , M9N5FAGyi , M9N5FAGzi , M9N5FAMxi , M9N5FAMyi , M9N5FAMzi , & + M9N5FBFxi , M9N5FBFyi , M9N5FBFzi , M9N5FBxi , M9N5FByi , M9N5FBzi , M9N5FDxi , & + M9N5FDyi , M9N5FDzi , M9N5FIxi , M9N5FIyi , M9N5FIzi , M9N5FMGxi , M9N5FMGyi , & + M9N5FMGzi , M9N5MAFxi , M9N5MAFyi , M9N5MAFzi , M9N5MAGxi , M9N5MAGyi , M9N5MAGzi , & + M9N5MBFxi , M9N5MBFyi , M9N5MBFzi , M9N5MBxi , M9N5MByi , M9N5MBzi , M9N5MMGxi , & + M9N5MMGyi , M9N5MMGzi , M9N5STAxi , M9N5STAyi , M9N5STAzi , M9N5STVxi , M9N5STVyi , & + M9N5STVzi , M9N5Vxi , M9N5Vyi , M9N5Vzi , M9N6Axi , M9N6Ayi , M9N6Azi , & + M9N6DynP , M9N6FAFxi , M9N6FAFyi , M9N6FAFzi , M9N6FAGxi , M9N6FAGyi , M9N6FAGzi , & + M9N6FAMxi , M9N6FAMyi , M9N6FAMzi , M9N6FBFxi , M9N6FBFyi , M9N6FBFzi , M9N6FBxi , & + M9N6FByi , M9N6FBzi , M9N6FDxi , M9N6FDyi , M9N6FDzi , M9N6FIxi , M9N6FIyi , & + M9N6FIzi , M9N6FMGxi , M9N6FMGyi , M9N6FMGzi , M9N6MAFxi , M9N6MAFyi , M9N6MAFzi , & + M9N6MAGxi , M9N6MAGyi , M9N6MAGzi , M9N6MBFxi , M9N6MBFyi , M9N6MBFzi , M9N6MBxi , & + M9N6MByi , M9N6MBzi , M9N6MMGxi , M9N6MMGyi , M9N6MMGzi , M9N6STAxi , M9N6STAyi , & + M9N6STAzi , M9N6STVxi , M9N6STVyi , M9N6STVzi , M9N6Vxi , M9N6Vyi , M9N6Vzi , & + M9N7Axi , M9N7Ayi , M9N7Azi , M9N7DynP , M9N7FAFxi , M9N7FAFyi , M9N7FAFzi , & + M9N7FAGxi , M9N7FAGyi , M9N7FAGzi , M9N7FAMxi , M9N7FAMyi , M9N7FAMzi , M9N7FBFxi , & + M9N7FBFyi , M9N7FBFzi , M9N7FBxi , M9N7FByi , M9N7FBzi , M9N7FDxi , M9N7FDyi , & + M9N7FDzi , M9N7FIxi , M9N7FIyi , M9N7FIzi , M9N7FMGxi , M9N7FMGyi , M9N7FMGzi , & + M9N7MAFxi , M9N7MAFyi , M9N7MAFzi , M9N7MAGxi , M9N7MAGyi , M9N7MAGzi , M9N7MBFxi , & + M9N7MBFyi , M9N7MBFzi , M9N7MBxi , M9N7MByi , M9N7MBzi , M9N7MMGxi , M9N7MMGyi , & + M9N7MMGzi , M9N7STAxi , M9N7STAyi , M9N7STAzi , M9N7STVxi , M9N7STVyi , M9N7STVzi , & + M9N7Vxi , M9N7Vyi , M9N7Vzi , M9N8Axi , M9N8Ayi , M9N8Azi , M9N8DynP , & + M9N8FAFxi , M9N8FAFyi , M9N8FAFzi , M9N8FAGxi , M9N8FAGyi , M9N8FAGzi , M9N8FAMxi , & + M9N8FAMyi , M9N8FAMzi , M9N8FBFxi , M9N8FBFyi , M9N8FBFzi , M9N8FBxi , M9N8FByi , & + M9N8FBzi , M9N8FDxi , M9N8FDyi , M9N8FDzi , M9N8FIxi , M9N8FIyi , M9N8FIzi , & + M9N8FMGxi , M9N8FMGyi , M9N8FMGzi , M9N8MAFxi , M9N8MAFyi , M9N8MAFzi , M9N8MAGxi , & + M9N8MAGyi , M9N8MAGzi , M9N8MBFxi , M9N8MBFyi , M9N8MBFzi , M9N8MBxi , M9N8MByi , & + M9N8MBzi , M9N8MMGxi , M9N8MMGyi , M9N8MMGzi , M9N8STAxi , M9N8STAyi , M9N8STAzi , & + M9N8STVxi , M9N8STVyi , M9N8STVzi , M9N8Vxi , M9N8Vyi , M9N8Vzi , M9N9Axi , & + M9N9Ayi , M9N9Azi , M9N9DynP , M9N9FAFxi , M9N9FAFyi , M9N9FAFzi , M9N9FAGxi , & + M9N9FAGyi , M9N9FAGzi , M9N9FAMxi , M9N9FAMyi , M9N9FAMzi , M9N9FBFxi , M9N9FBFyi , & + M9N9FBFzi , M9N9FBxi , M9N9FByi , M9N9FBzi , M9N9FDxi , M9N9FDyi , M9N9FDzi , & + M9N9FIxi , M9N9FIyi , M9N9FIzi , M9N9FMGxi , M9N9FMGyi , M9N9FMGzi , M9N9MAFxi , & + M9N9MAFyi , M9N9MAFzi , M9N9MAGxi , M9N9MAGyi , M9N9MAGzi , M9N9MBFxi , M9N9MBFyi , & + M9N9MBFzi , M9N9MBxi , M9N9MByi , M9N9MBzi , M9N9MMGxi , M9N9MMGyi , M9N9MMGzi , & + M9N9STAxi , M9N9STAyi , M9N9STAzi , M9N9STVxi , M9N9STVyi , M9N9STVzi , M9N9Vxi , & + M9N9Vyi , M9N9Vzi /) + INTEGER(IntKi), PARAMETER :: ParamIndxAry(4626) = (/ & ! This lists the index into AllOuts(:) of the allowed parameters ValidParamAry(:) + ParamIndxAry1, ParamIndxAry2, ParamIndxAry3/) +!********************************************************************************************************************************** + + ! ..... Public Subroutines ................................................................................................... PUBLIC :: MrsnOut_MapOutputs - PUBLIC :: MrsnOut_OpenOutput - PUBLIC :: MrsnOut_CloseOutput - PUBLIC :: MrsnOut_WriteOutputNames - PUBLIC :: MrsnOut_WriteOutputUnits - PUBLIC :: MrsnOut_WriteOutputs PUBLIC :: MrsnOut_Init - PUBLIC :: MrsnOut_DestroyParam PUBLIC :: GetMorisonChannels CONTAINS - -!==================================================================================================== -SUBROUTINE SetInvalidOutputs(NMOutputs, MOutLst, NJOutputs, JOutLst, InvalidOutput) -! This subroutine checks the user requested member and joint output lists and sets the unused items to -! invalid. -!---------------------------------------------------------------------------------------------------- - INTEGER, INTENT( IN ) :: NMOutputs - TYPE(Morison_MOutput), INTENT( IN ) :: MOutLst(:) - INTEGER, INTENT( IN ) :: NJOutputs - TYPE(Morison_JOutput), INTENT( IN ) :: JOutLst(:) - LOGICAL, INTENT( INOUT ) :: InvalidOutput(:) - - - -END SUBROUTINE SetInvalidOutputs - !==================================================================================================== -SUBROUTINE MrsnOut_MapOutputs( CurrentTime, y, p, u, m, AllOuts, ErrStat, ErrMsg ) +SUBROUTINE MrsnOut_MapOutputs( y, p, u, m ) ! This subroutine writes the data stored in the y variable to the correct indexed postions in WriteOutput ! This is called by HydroDyn_CalcOutput() at each time step. !---------------------------------------------------------------------------------------------------- - REAL(DbKi), INTENT( IN ) :: CurrentTime ! Current simulation time in seconds TYPE(Morison_OutputType), INTENT( INOUT ) :: y ! Morison module's output data TYPE(Morison_ParameterType), INTENT( IN ) :: p ! Morison module's parameter data TYPE(Morison_InputType), INTENT( IN ) :: u ! Morison module's input data TYPE(Morison_MiscVarType), INTENT( INOUT ) :: m ! Misc/optimization variables - REAL(ReKi), INTENT( OUT ) :: AllOuts(MaxMrsnOutputs) ! 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 INTEGER :: I, J @@ -6439,10 +7790,9 @@ SUBROUTINE MrsnOut_MapOutputs( CurrentTime, y, p, u, m, AllOuts, ErrStat, ErrMsg real(ReKi) :: mult1, mult2 ! Load multiplier for joint nodes vs interior nodes real(ReKi) :: dl ! member element length (m) REAL(ReKi) :: s ! The linear interpolation factor for the requested location + REAL(ReKi) :: AllOuts(MaxOutPts) ! Array of output data for all possible outputs - - ErrStat = ErrID_None - ErrMsg = "" + AllOuts = 0.0_ReKi ! Only generate member-based outputs for the number of user-requested member outputs @@ -6548,6 +7898,9 @@ SUBROUTINE MrsnOut_MapOutputs( CurrentTime, y, p, u, m, AllOuts, ErrStat, ErrMsg AllOuts(JVi (:,I)) = m%FV (1:3,m1) ! fluid velocity AllOuts(JAi (:,I)) = m%FA (1:3,m1) ! fluid acceleration AllOuts(JDynP( I)) = m%FDynP( m1) ! fluid dynamic pressure + AllOuts(JWaveElev( I)) = m%WaveElev( m1) ! total wave elevation + AllOuts(JWaveElev1( I)) = m%WaveElev1( m1) ! 1st order wave elevation effects + AllOuts(JWaveElev2( I)) = m%WaveElev2( m1) ! 2nd order wave elevation effects AllOuts(JSTVi (:,I)) = u%Mesh%TranslationVel(: ,m1) ! structural velocity AllOuts(JSTAi (:,I)) = u%Mesh%TranslationAcc(: ,m1) ! structural acceleration @@ -6564,226 +7917,18 @@ SUBROUTINE MrsnOut_MapOutputs( CurrentTime, y, p, u, m, AllOuts, ErrStat, ErrMsg END DO - - END IF -END SUBROUTINE MrsnOut_MapOutputs - -!==================================================================================================== -SUBROUTINE MrsnOut_OpenOutput( ProgName, 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 - - CHARACTER(*), INTENT( IN ) :: ProgName - CHARACTER(*), INTENT( IN ) :: OutRootName ! Root name for the output file - TYPE(Morison_ParameterType), INTENT( INOUT ) :: p - TYPE(Morison_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 -! INTEGER :: J ! Generic loop counter -! INTEGER :: Indx ! Counts the current index into the WaveKinNd array - CHARACTER(1024) :: OutFileName ! The name of the output file including the full path. - CHARACTER(200) :: Frmt ! a string to hold a format statement - - !------------------------------------------------------------------------------------------------- - ! Initialize local variables - !------------------------------------------------------------------------------------------------- - - - ErrStat = ErrID_None - ErrMsg = "" - - !TODO Finish error handling - - !------------------------------------------------------------------------------------------------- - ! 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)//'.MRSN.out' - !$OMP critical(fileopen) - CALL GetNewUnit( p%UnOutFile ) - - CALL OpenFOutFile ( p%UnOutFile, OutFileName, ErrStat, ErrMsg ) - !$OMP end critical(fileopen) - IF (ErrStat >=AbortErrLev) RETURN - - - - ! Write the output file header - - WRITE (p%UnOutFile,'(/,A/)', IOSTAT=ErrStat) 'These predictions were generated by '//TRIM(ProgName)//& - ' on '//CurDate()//' at '//CurTime()//'.' - - ! Write the names of the output parameters: - - Frmt = '(A8,'//TRIM(Int2LStr(p%NumOuts))//'(:,A,'//TRIM( p%OutSFmt )//'))' - WRITE(p%UnOutFile,Frmt) TRIM( 'Time' ), ( p%Delim, TRIM( InitOut%WriteOutputHdr(I) ), I=1,p%NumOuts ) - - - - WRITE (p%UnOutFile,'()', IOSTAT=ErrStat) ! write the line return - - - ! Write the units of the output parameters: - - - - WRITE(p%UnOutFile,Frmt) TRIM( 's'), ( p%Delim, TRIM( InitOut%WriteOutputUnt(I) ), I=1,p%NumOuts ) - - - WRITE (p%UnOutFile,'()', IOSTAT=ErrStat) ! write the line return - - - - - END IF ! there are any requested outputs - - RETURN - -END SUBROUTINE MrsnOut_OpenOutput - -!==================================================================================================== - - -!==================================================================================================== -SUBROUTINE MrsnOut_CloseOutput ( p, ErrStat, ErrMsg ) -! This function cleans up after running the HydroDyn output module. It closes the output file, -! releases memory, and resets the number of outputs requested to 0. -!---------------------------------------------------------------------------------------------------- - - ! Passed variables - - TYPE(Morison_ParameterType), INTENT( INOUT ) :: p ! parameter data for this instance of the Morison module - INTEGER, INTENT( OUT ) :: ErrStat ! a non-zero value indicates an error occurred - CHARACTER(*), INTENT( OUT ) :: ErrMsg ! Error message if ErrStat /= ErrID_None - -! ! Internal variables - LOGICAL :: Err - - - !------------------------------------------------------------------------------------------------- - ! Initialize error information - !------------------------------------------------------------------------------------------------- - ErrStat = ErrID_None - ErrMsg = "" - Err = .FALSE. - - !------------------------------------------------------------------------------------------------- - ! Close our output file - !------------------------------------------------------------------------------------------------- - CLOSE( p%UnOutFile, 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 MrsnOut_CloseOutput -!==================================================================================================== - - -SUBROUTINE MrsnOut_WriteOutputNames( UnOutFile, p, ErrStat, ErrMsg ) - - INTEGER, INTENT( IN ) :: UnOutFile ! file unit for the output file - TYPE(Morison_ParameterType), INTENT( IN ) :: p ! Morison 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))//'(:,A,'//TRIM( p%OutSFmt )//'))' - - WRITE(UnOutFile,Frmt) 'Time', ( p%Delim, TRIM( p%OutParam(I)%Name ), I=1,p%NumOuts ) - -END SUBROUTINE MrsnOut_WriteOutputNames - -!==================================================================================================== - - -SUBROUTINE MrsnOut_WriteOutputUnits( UnOutFile, p, ErrStat, ErrMsg ) - - INTEGER, INTENT( IN ) :: UnOutFile ! file unit for the output file - TYPE(Morison_ParameterType), INTENT( IN ) :: p ! Morison 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 + ! Put the output data in the WriteOutput array + DO I = 1,p%NumOuts + y%WriteOutput(I) = p%OutParam(I)%SignM * AllOuts( p%OutParam(I)%Indx ) + END DO - CHARACTER(200) :: Frmt ! a string to hold a format statement - INTEGER :: I ! Generic loop counter + END IF ! p%NumOuts > 0 - ErrStat = ErrID_None - ErrMsg = "" - - Frmt = '(A8,'//TRIM(Int2LStr(p%NumOuts))//'(:,A,'//TRIM( p%OutSFmt )//'))' +END SUBROUTINE MrsnOut_MapOutputs - WRITE(UnOutFile,Frmt) '(sec)', ( p%Delim, TRIM( p%OutParam(I)%Units ), I=1,p%NumOuts ) - -END SUBROUTINE MrsnOut_WriteOutputUnits !==================================================================================================== -SUBROUTINE MrsnOut_WriteOutputs( UnOutFile, Time, y, p, ErrStat, ErrMsg ) -! This subroutine writes the data stored in WriteOutputs (and indexed in OutParam) to the file -! opened in MrsnOut_Init() -!---------------------------------------------------------------------------------------------------- - - ! Passed variables - INTEGER, INTENT( IN ) :: UnOutFile ! file unit for the output file - REAL(DbKi), INTENT( IN ) :: Time ! Time for this output - TYPE(Morison_OutputType), INTENT( IN ) :: y ! Morison module's output data - TYPE(Morison_ParameterType), INTENT( IN ) :: p ! Morison 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 - ! REAL(ReKi) :: OutData (0:p%NumOuts) ! an output array - INTEGER :: I ! Generic loop counter - CHARACTER(200) :: Frmt ! a string to hold a format statement - - - - ! Initialize ErrStat and determine if it makes any sense to write output - - IF ( .NOT. ALLOCATED( p%OutParam ) .OR. UnOutFile < 0 ) THEN - ErrStat = ErrID_Warn - ErrMsg = ' To write outputs for HydroDyn there must be a valid file ID and OutParam must be allocated.' - RETURN - ELSE - ErrStat = ErrID_None - ErrMsg = '' - END IF - - - ! Write the output parameters to the file - - Frmt = '(F8.3,'//TRIM(Int2LStr(p%NumOuts))//'(:,A,'//TRIM( p%OutFmt )//'))' - !Frmt = '('//TRIM( p%OutFmt )//','//TRIM(Int2LStr(p%NumOuts))//'(:,A,'//TRIM( p%OutFmt )//'))' - - WRITE(UnOutFile,Frmt) Time, ( p%Delim, y%WriteOutput(I), I=1,p%NumOuts ) - - - RETURN - - -END SUBROUTINE MrsnOut_WriteOutputs SUBROUTINE GetNeighboringNodes(member, d, m1, m2, i1, i2, s, ErrStat, ErrMsg) @@ -6865,25 +8010,18 @@ SUBROUTINE MrsnOut_Init( InitInp, y, p, InitOut, ErrStat, ErrMsg ) ! MrsnOut_Data%NumOuts = HDO_InitData%NumOuts if (p%NumOuts > 0 ) THEN - CALL MrsnOut_ChkOutLst( InitInp%OutList(1:p%NumOuts), InitInp%ValidOutList(1:p%NumOuts), y, p, ErrStat, ErrMsg ) + CALL SetOutParam( InitInp%OutList, p, ErrStat, ErrMsg ) IF ( ErrStat >= AbortErrLev ) RETURN END IF - ! Set the number of outputs related to the OutAll flag - - IF ( InitInp%OutAll ) THEN - ! p%NumOutAll = InitInp%NMember*2*22 + InitInp%NJoints*19 - p%NumOutAll = 0 - ELSE - p%NumOutAll = 0 - END IF + !------------------------------------------------------------------------------------------------- ! Open the output file, if necessary, and write the header !------------------------------------------------------------------------------------------------- - - IF ( InitInp%OutAll .OR. ( ALLOCATED( p%OutParam ) .AND. p%NumOuts > 0 ) ) THEN ! Output has been requested so let's open an output file + + IF ( ALLOCATED( p%OutParam ) .AND. p%NumOuts > 0 ) THEN ! Output has been requested so let's open an output file - ALLOCATE( y%WriteOutput( p%NumOuts + p%NumOutAll ), STAT = ErrStat ) + ALLOCATE( y%WriteOutput( p%NumOuts ), STAT = ErrStat ) IF ( ErrStat /= ErrID_None ) THEN ErrMsg = ' Error allocating space for WriteOutput array.' ErrStat = ErrID_Fatal @@ -6916,14 +8054,14 @@ SUBROUTINE MrsnOut_Init( InitInp, y, p, InitOut, ErrStat, ErrMsg ) ! These variables are to help follow the framework template, but the data in them is simply a copy of data ! already available in the OutParam data structure - ALLOCATE ( InitOut%WriteOutputHdr(p%NumOuts + p%NumOutAll), STAT = ErrStat ) + ALLOCATE ( InitOut%WriteOutputHdr(p%NumOuts), STAT = ErrStat ) IF ( ErrStat /= ErrID_None ) THEN ErrMsg = ' Error allocating space for WriteOutputHdr array.' ErrStat = ErrID_Fatal RETURN END IF - ALLOCATE ( InitOut%WriteOutputUnt(p%NumOuts + p%NumOutAll), STAT = ErrStat ) + ALLOCATE ( InitOut%WriteOutputUnt(p%NumOuts), STAT = ErrStat ) IF ( ErrStat /= ErrID_None ) THEN ErrMsg = ' Error allocating space for WriteOutputHdr array.' ErrStat = ErrID_Fatal @@ -6937,15 +8075,7 @@ SUBROUTINE MrsnOut_Init( InitInp, y, p, InitOut, ErrStat, ErrMsg ) InitOut%WriteOutputHdr(I) = TRIM( p%OutParam(I)%Name ) InitOut%WriteOutputUnt(I) = TRIM( p%OutParam(I)%Units ) - END DO - - IF ( InitInp%OutAll ) THEN - ! Loop over joints - ! J1FDXi, ... - ! Loop over members - ! M1BEGFDXi, M1ENDFDXi, ... - !InitOut%WriteOutputHdr(p%NOuts+count) - END IF + END DO END IF ! there are any requested outputs @@ -6961,7 +8091,7 @@ FUNCTION GetMorisonChannels ( NUserOutputs, UserOutputs, OutList, foundMask !---------------------------------------------------------------------------------------------------- INTEGER, INTENT( IN ) :: NUserOutputs ! Number of user-specified output channels CHARACTER(ChanLen), INTENT( IN ) :: UserOutputs (:) ! An array holding the names of the requested output channels. - CHARACTER(ChanLen), INTENT( OUT ) :: OutList (:) ! An array holding the names of the matched WAMIT output channels. + CHARACTER(ChanLen),ALLOCATABLE,INTENT( OUT ) :: OutList (:) ! An array holding the names of the matched Morison output channels. LOGICAL, INTENT( INOUT ) :: foundMask (:) ! A mask indicating whether a user requested channel belongs to a module's output channels. INTEGER, INTENT( OUT ) :: ErrStat ! a non-zero value indicates an error occurred CHARACTER(*), INTENT( OUT ) :: ErrMsg ! Error message if ErrStat /= ErrID_None @@ -6970,2255 +8100,893 @@ FUNCTION GetMorisonChannels ( NUserOutputs, UserOutputs, OutList, foundMask ! Local variables. - INTEGER :: I ! Generic loop-counting index. + INTEGER :: I, J ! Generic loop-counting index. INTEGER :: count ! Generic loop-counting index. INTEGER :: INDX ! Index for valid arrays + INTEGER :: newFoundMask (NUserOutputs) ! A mask indicating whether a user requested channel belongs to a module's output channels - 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. -! LOGICAL :: InvalidOutput(MaxMrsnOutputs) ! This array determines if the output channel is valid for this configuration - LOGICAL :: CheckOutListAgain - LOGICAL :: newFoundMask (NUserOutputs) ! A mask indicating whether a user requested channel belongs to a module's output channels. ! Initialize ErrStat - - ErrStat = ErrID_None + ErrStat = ErrID_None ErrMsg = "" - ValidParamAry(1:500) = (/ & - "J1AXI ","J1AYI ","J1AZI ","J1DYNP ","J1FAGXI ","J1FAGYI ","J1FAGZI ", & - "J1FAMXI ","J1FAMYI ","J1FAMZI ","J1FBFXI ","J1FBFYI ","J1FBFZI ","J1FBXI ", & - "J1FBYI ","J1FBZI ","J1FDXI ","J1FDYI ","J1FDZI ","J1FIXI ","J1FIYI ", & - "J1FIZI ","J1FMGXI ","J1FMGYI ","J1FMGZI ","J1MAGXI ","J1MAGYI ","J1MAGZI ", & - "J1MBFXI ","J1MBFYI ","J1MBFZI ","J1MBXI ","J1MBYI ","J1MBZI ","J1STAXI ", & - "J1STAYI ","J1STAZI ","J1STVXI ","J1STVYI ","J1STVZI ","J1VXI ","J1VYI ", & - "J1VZI ","J2AXI ","J2AYI ","J2AZI ","J2DYNP ","J2FAGXI ","J2FAGYI ", & - "J2FAGZI ","J2FAMXI ","J2FAMYI ","J2FAMZI ","J2FBFXI ","J2FBFYI ","J2FBFZI ", & - "J2FBXI ","J2FBYI ","J2FBZI ","J2FDXI ","J2FDYI ","J2FDZI ","J2FIXI ", & - "J2FIYI ","J2FIZI ","J2FMGXI ","J2FMGYI ","J2FMGZI ","J2MAGXI ","J2MAGYI ", & - "J2MAGZI ","J2MBFXI ","J2MBFYI ","J2MBFZI ","J2MBXI ","J2MBYI ","J2MBZI ", & - "J2STAXI ","J2STAYI ","J2STAZI ","J2STVXI ","J2STVYI ","J2STVZI ","J2VXI ", & - "J2VYI ","J2VZI ","J3AXI ","J3AYI ","J3AZI ","J3DYNP ","J3FAGXI ", & - "J3FAGYI ","J3FAGZI ","J3FAMXI ","J3FAMYI ","J3FAMZI ","J3FBFXI ","J3FBFYI ", & - "J3FBFZI ","J3FBXI ","J3FBYI ","J3FBZI ","J3FDXI ","J3FDYI ","J3FDZI ", & - "J3FIXI ","J3FIYI ","J3FIZI ","J3FMGXI ","J3FMGYI ","J3FMGZI ","J3MAGXI ", & - "J3MAGYI ","J3MAGZI ","J3MBFXI ","J3MBFYI ","J3MBFZI ","J3MBXI ","J3MBYI ", & - "J3MBZI ","J3STAXI ","J3STAYI ","J3STAZI ","J3STVXI ","J3STVYI ","J3STVZI ", & - "J3VXI ","J3VYI ","J3VZI ","J4AXI ","J4AYI ","J4AZI ","J4DYNP ", & - "J4FAGXI ","J4FAGYI ","J4FAGZI ","J4FAMXI ","J4FAMYI ","J4FAMZI ","J4FBFXI ", & - "J4FBFYI ","J4FBFZI ","J4FBXI ","J4FBYI ","J4FBZI ","J4FDXI ","J4FDYI ", & - "J4FDZI ","J4FIXI ","J4FIYI ","J4FIZI ","J4FMGXI ","J4FMGYI ","J4FMGZI ", & - "J4MAGXI ","J4MAGYI ","J4MAGZI ","J4MBFXI ","J4MBFYI ","J4MBFZI ","J4MBXI ", & - "J4MBYI ","J4MBZI ","J4STAXI ","J4STAYI ","J4STAZI ","J4STVXI ","J4STVYI ", & - "J4STVZI ","J4VXI ","J4VYI ","J4VZI ","J5AXI ","J5AYI ","J5AZI ", & - "J5DYNP ","J5FAGXI ","J5FAGYI ","J5FAGZI ","J5FAMXI ","J5FAMYI ","J5FAMZI ", & - "J5FBFXI ","J5FBFYI ","J5FBFZI ","J5FBXI ","J5FBYI ","J5FBZI ","J5FDXI ", & - "J5FDYI ","J5FDZI ","J5FIXI ","J5FIYI ","J5FIZI ","J5FMGXI ","J5FMGYI ", & - "J5FMGZI ","J5MAGXI ","J5MAGYI ","J5MAGZI ","J5MBFXI ","J5MBFYI ","J5MBFZI ", & - "J5MBXI ","J5MBYI ","J5MBZI ","J5STAXI ","J5STAYI ","J5STAZI ","J5STVXI ", & - "J5STVYI ","J5STVZI ","J5VXI ","J5VYI ","J5VZI ","J6AXI ","J6AYI ", & - "J6AZI ","J6DYNP ","J6FAGXI ","J6FAGYI ","J6FAGZI ","J6FAMXI ","J6FAMYI ", & - "J6FAMZI ","J6FBFXI ","J6FBFYI ","J6FBFZI ","J6FBXI ","J6FBYI ","J6FBZI ", & - "J6FDXI ","J6FDYI ","J6FDZI ","J6FIXI ","J6FIYI ","J6FIZI ","J6FMGXI ", & - "J6FMGYI ","J6FMGZI ","J6MAGXI ","J6MAGYI ","J6MAGZI ","J6MBFXI ","J6MBFYI ", & - "J6MBFZI ","J6MBXI ","J6MBYI ","J6MBZI ","J6STAXI ","J6STAYI ","J6STAZI ", & - "J6STVXI ","J6STVYI ","J6STVZI ","J6VXI ","J6VYI ","J6VZI ","J7AXI ", & - "J7AYI ","J7AZI ","J7DYNP ","J7FAGXI ","J7FAGYI ","J7FAGZI ","J7FAMXI ", & - "J7FAMYI ","J7FAMZI ","J7FBFXI ","J7FBFYI ","J7FBFZI ","J7FBXI ","J7FBYI ", & - "J7FBZI ","J7FDXI ","J7FDYI ","J7FDZI ","J7FIXI ","J7FIYI ","J7FIZI ", & - "J7FMGXI ","J7FMGYI ","J7FMGZI ","J7MAGXI ","J7MAGYI ","J7MAGZI ","J7MBFXI ", & - "J7MBFYI ","J7MBFZI ","J7MBXI ","J7MBYI ","J7MBZI ","J7STAXI ","J7STAYI ", & - "J7STAZI ","J7STVXI ","J7STVYI ","J7STVZI ","J7VXI ","J7VYI ","J7VZI ", & - "J8AXI ","J8AYI ","J8AZI ","J8DYNP ","J8FAGXI ","J8FAGYI ","J8FAGZI ", & - "J8FAMXI ","J8FAMYI ","J8FAMZI ","J8FBFXI ","J8FBFYI ","J8FBFZI ","J8FBXI ", & - "J8FBYI ","J8FBZI ","J8FDXI ","J8FDYI ","J8FDZI ","J8FIXI ","J8FIYI ", & - "J8FIZI ","J8FMGXI ","J8FMGYI ","J8FMGZI ","J8MAGXI ","J8MAGYI ","J8MAGZI ", & - "J8MBFXI ","J8MBFYI ","J8MBFZI ","J8MBXI ","J8MBYI ","J8MBZI ","J8STAXI ", & - "J8STAYI ","J8STAZI ","J8STVXI ","J8STVYI ","J8STVZI ","J8VXI ","J8VYI ", & - "J8VZI ","J9AXI ","J9AYI ","J9AZI ","J9DYNP ","J9FAGXI ","J9FAGYI ", & - "J9FAGZI ","J9FAMXI ","J9FAMYI ","J9FAMZI ","J9FBFXI ","J9FBFYI ","J9FBFZI ", & - "J9FBXI ","J9FBYI ","J9FBZI ","J9FDXI ","J9FDYI ","J9FDZI ","J9FIXI ", & - "J9FIYI ","J9FIZI ","J9FMGXI ","J9FMGYI ","J9FMGZI ","J9MAGXI ","J9MAGYI ", & - "J9MAGZI ","J9MBFXI ","J9MBFYI ","J9MBFZI ","J9MBXI ","J9MBYI ","J9MBZI ", & - "J9STAXI ","J9STAYI ","J9STAZI ","J9STVXI ","J9STVYI ","J9STVZI ","J9VXI ", & - "J9VYI ","J9VZI ","M1N1AXI ","M1N1AYI ","M1N1AZI ","M1N1DYNP ","M1N1FAFXI", & - "M1N1FAFYI","M1N1FAFZI","M1N1FAGXI","M1N1FAGYI","M1N1FAGZI","M1N1FAMXI","M1N1FAMYI", & - "M1N1FAMZI","M1N1FBFXI","M1N1FBFYI","M1N1FBFZI","M1N1FBXI ","M1N1FBYI ","M1N1FBZI ", & - "M1N1FDXI ","M1N1FDYI ","M1N1FDZI ","M1N1FIXI ","M1N1FIYI ","M1N1FIZI ","M1N1FMGXI", & - "M1N1FMGYI","M1N1FMGZI","M1N1MAFXI","M1N1MAFYI","M1N1MAFZI","M1N1MAGXI","M1N1MAGYI", & - "M1N1MAGZI","M1N1MBFXI","M1N1MBFYI","M1N1MBFZI","M1N1MBXI ","M1N1MBYI ","M1N1MBZI ", & - "M1N1MMGXI","M1N1MMGYI","M1N1MMGZI","M1N1STAXI","M1N1STAYI","M1N1STAZI","M1N1STVXI", & - "M1N1STVYI","M1N1STVZI","M1N1VXI ","M1N1VYI ","M1N1VZI ","M1N2AXI ","M1N2AYI ", & - "M1N2AZI ","M1N2DYNP ","M1N2FAFXI","M1N2FAFYI","M1N2FAFZI","M1N2FAGXI","M1N2FAGYI", & - "M1N2FAGZI","M1N2FAMXI","M1N2FAMYI","M1N2FAMZI","M1N2FBFXI","M1N2FBFYI","M1N2FBFZI", & - "M1N2FBXI ","M1N2FBYI ","M1N2FBZI ","M1N2FDXI ","M1N2FDYI ","M1N2FDZI ","M1N2FIXI ", & - "M1N2FIYI ","M1N2FIZI ","M1N2FMGXI","M1N2FMGYI","M1N2FMGZI","M1N2MAFXI","M1N2MAFYI", & - "M1N2MAFZI","M1N2MAGXI","M1N2MAGYI","M1N2MAGZI","M1N2MBFXI","M1N2MBFYI","M1N2MBFZI", & - "M1N2MBXI ","M1N2MBYI ","M1N2MBZI ","M1N2MMGXI","M1N2MMGYI","M1N2MMGZI","M1N2STAXI", & - "M1N2STAYI","M1N2STAZI","M1N2STVXI","M1N2STVYI","M1N2STVZI","M1N2VXI ","M1N2VYI ", & - "M1N2VZI ","M1N3AXI ","M1N3AYI ","M1N3AZI ","M1N3DYNP ","M1N3FAFXI","M1N3FAFYI", & - "M1N3FAFZI","M1N3FAGXI","M1N3FAGYI"/) - ValidParamAry(501:1000) = (/ & - "M1N3FAGZI","M1N3FAMXI","M1N3FAMYI","M1N3FAMZI","M1N3FBFXI","M1N3FBFYI","M1N3FBFZI", & - "M1N3FBXI ","M1N3FBYI ","M1N3FBZI ","M1N3FDXI ","M1N3FDYI ","M1N3FDZI ","M1N3FIXI ", & - "M1N3FIYI ","M1N3FIZI ","M1N3FMGXI","M1N3FMGYI","M1N3FMGZI","M1N3MAFXI","M1N3MAFYI", & - "M1N3MAFZI","M1N3MAGXI","M1N3MAGYI","M1N3MAGZI","M1N3MBFXI","M1N3MBFYI","M1N3MBFZI", & - "M1N3MBXI ","M1N3MBYI ","M1N3MBZI ","M1N3MMGXI","M1N3MMGYI","M1N3MMGZI","M1N3STAXI", & - "M1N3STAYI","M1N3STAZI","M1N3STVXI","M1N3STVYI","M1N3STVZI","M1N3VXI ","M1N3VYI ", & - "M1N3VZI ","M1N4AXI ","M1N4AYI ","M1N4AZI ","M1N4DYNP ","M1N4FAFXI","M1N4FAFYI", & - "M1N4FAFZI","M1N4FAGXI","M1N4FAGYI","M1N4FAGZI","M1N4FAMXI","M1N4FAMYI","M1N4FAMZI", & - "M1N4FBFXI","M1N4FBFYI","M1N4FBFZI","M1N4FBXI ","M1N4FBYI ","M1N4FBZI ","M1N4FDXI ", & - "M1N4FDYI ","M1N4FDZI ","M1N4FIXI ","M1N4FIYI ","M1N4FIZI ","M1N4FMGXI","M1N4FMGYI", & - "M1N4FMGZI","M1N4MAFXI","M1N4MAFYI","M1N4MAFZI","M1N4MAGXI","M1N4MAGYI","M1N4MAGZI", & - "M1N4MBFXI","M1N4MBFYI","M1N4MBFZI","M1N4MBXI ","M1N4MBYI ","M1N4MBZI ","M1N4MMGXI", & - "M1N4MMGYI","M1N4MMGZI","M1N4STAXI","M1N4STAYI","M1N4STAZI","M1N4STVXI","M1N4STVYI", & - "M1N4STVZI","M1N4VXI ","M1N4VYI ","M1N4VZI ","M1N5AXI ","M1N5AYI ","M1N5AZI ", & - "M1N5DYNP ","M1N5FAFXI","M1N5FAFYI","M1N5FAFZI","M1N5FAGXI","M1N5FAGYI","M1N5FAGZI", & - "M1N5FAMXI","M1N5FAMYI","M1N5FAMZI","M1N5FBFXI","M1N5FBFYI","M1N5FBFZI","M1N5FBXI ", & - "M1N5FBYI ","M1N5FBZI ","M1N5FDXI ","M1N5FDYI ","M1N5FDZI ","M1N5FIXI ","M1N5FIYI ", & - "M1N5FIZI ","M1N5FMGXI","M1N5FMGYI","M1N5FMGZI","M1N5MAFXI","M1N5MAFYI","M1N5MAFZI", & - "M1N5MAGXI","M1N5MAGYI","M1N5MAGZI","M1N5MBFXI","M1N5MBFYI","M1N5MBFZI","M1N5MBXI ", & - "M1N5MBYI ","M1N5MBZI ","M1N5MMGXI","M1N5MMGYI","M1N5MMGZI","M1N5STAXI","M1N5STAYI", & - "M1N5STAZI","M1N5STVXI","M1N5STVYI","M1N5STVZI","M1N5VXI ","M1N5VYI ","M1N5VZI ", & - "M1N6AXI ","M1N6AYI ","M1N6AZI ","M1N6DYNP ","M1N6FAFXI","M1N6FAFYI","M1N6FAFZI", & - "M1N6FAGXI","M1N6FAGYI","M1N6FAGZI","M1N6FAMXI","M1N6FAMYI","M1N6FAMZI","M1N6FBFXI", & - "M1N6FBFYI","M1N6FBFZI","M1N6FBXI ","M1N6FBYI ","M1N6FBZI ","M1N6FDXI ","M1N6FDYI ", & - "M1N6FDZI ","M1N6FIXI ","M1N6FIYI ","M1N6FIZI ","M1N6FMGXI","M1N6FMGYI","M1N6FMGZI", & - "M1N6MAFXI","M1N6MAFYI","M1N6MAFZI","M1N6MAGXI","M1N6MAGYI","M1N6MAGZI","M1N6MBFXI", & - "M1N6MBFYI","M1N6MBFZI","M1N6MBXI ","M1N6MBYI ","M1N6MBZI ","M1N6MMGXI","M1N6MMGYI", & - "M1N6MMGZI","M1N6STAXI","M1N6STAYI","M1N6STAZI","M1N6STVXI","M1N6STVYI","M1N6STVZI", & - "M1N6VXI ","M1N6VYI ","M1N6VZI ","M1N7AXI ","M1N7AYI ","M1N7AZI ","M1N7DYNP ", & - "M1N7FAFXI","M1N7FAFYI","M1N7FAFZI","M1N7FAGXI","M1N7FAGYI","M1N7FAGZI","M1N7FAMXI", & - "M1N7FAMYI","M1N7FAMZI","M1N7FBFXI","M1N7FBFYI","M1N7FBFZI","M1N7FBXI ","M1N7FBYI ", & - "M1N7FBZI ","M1N7FDXI ","M1N7FDYI ","M1N7FDZI ","M1N7FIXI ","M1N7FIYI ","M1N7FIZI ", & - "M1N7FMGXI","M1N7FMGYI","M1N7FMGZI","M1N7MAFXI","M1N7MAFYI","M1N7MAFZI","M1N7MAGXI", & - "M1N7MAGYI","M1N7MAGZI","M1N7MBFXI","M1N7MBFYI","M1N7MBFZI","M1N7MBXI ","M1N7MBYI ", & - "M1N7MBZI ","M1N7MMGXI","M1N7MMGYI","M1N7MMGZI","M1N7STAXI","M1N7STAYI","M1N7STAZI", & - "M1N7STVXI","M1N7STVYI","M1N7STVZI","M1N7VXI ","M1N7VYI ","M1N7VZI ","M1N8AXI ", & - "M1N8AYI ","M1N8AZI ","M1N8DYNP ","M1N8FAFXI","M1N8FAFYI","M1N8FAFZI","M1N8FAGXI", & - "M1N8FAGYI","M1N8FAGZI","M1N8FAMXI","M1N8FAMYI","M1N8FAMZI","M1N8FBFXI","M1N8FBFYI", & - "M1N8FBFZI","M1N8FBXI ","M1N8FBYI ","M1N8FBZI ","M1N8FDXI ","M1N8FDYI ","M1N8FDZI ", & - "M1N8FIXI ","M1N8FIYI ","M1N8FIZI ","M1N8FMGXI","M1N8FMGYI","M1N8FMGZI","M1N8MAFXI", & - "M1N8MAFYI","M1N8MAFZI","M1N8MAGXI","M1N8MAGYI","M1N8MAGZI","M1N8MBFXI","M1N8MBFYI", & - "M1N8MBFZI","M1N8MBXI ","M1N8MBYI ","M1N8MBZI ","M1N8MMGXI","M1N8MMGYI","M1N8MMGZI", & - "M1N8STAXI","M1N8STAYI","M1N8STAZI","M1N8STVXI","M1N8STVYI","M1N8STVZI","M1N8VXI ", & - "M1N8VYI ","M1N8VZI ","M1N9AXI ","M1N9AYI ","M1N9AZI ","M1N9DYNP ","M1N9FAFXI", & - "M1N9FAFYI","M1N9FAFZI","M1N9FAGXI","M1N9FAGYI","M1N9FAGZI","M1N9FAMXI","M1N9FAMYI", & - "M1N9FAMZI","M1N9FBFXI","M1N9FBFYI","M1N9FBFZI","M1N9FBXI ","M1N9FBYI ","M1N9FBZI ", & - "M1N9FDXI ","M1N9FDYI ","M1N9FDZI ","M1N9FIXI ","M1N9FIYI ","M1N9FIZI ","M1N9FMGXI", & - "M1N9FMGYI","M1N9FMGZI","M1N9MAFXI","M1N9MAFYI","M1N9MAFZI","M1N9MAGXI","M1N9MAGYI", & - "M1N9MAGZI","M1N9MBFXI","M1N9MBFYI","M1N9MBFZI","M1N9MBXI ","M1N9MBYI ","M1N9MBZI ", & - "M1N9MMGXI","M1N9MMGYI","M1N9MMGZI","M1N9STAXI","M1N9STAYI","M1N9STAZI","M1N9STVXI", & - "M1N9STVYI","M1N9STVZI","M1N9VXI ","M1N9VYI ","M1N9VZI ","M2N1AXI ","M2N1AYI ", & - "M2N1AZI ","M2N1DYNP ","M2N1FAFXI","M2N1FAFYI","M2N1FAFZI","M2N1FAGXI","M2N1FAGYI", & - "M2N1FAGZI","M2N1FAMXI","M2N1FAMYI","M2N1FAMZI","M2N1FBFXI","M2N1FBFYI","M2N1FBFZI", & - "M2N1FBXI ","M2N1FBYI ","M2N1FBZI ","M2N1FDXI ","M2N1FDYI ","M2N1FDZI ","M2N1FIXI ", & - "M2N1FIYI ","M2N1FIZI ","M2N1FMGXI","M2N1FMGYI","M2N1FMGZI","M2N1MAFXI","M2N1MAFYI", & - "M2N1MAFZI","M2N1MAGXI","M2N1MAGYI","M2N1MAGZI","M2N1MBFXI","M2N1MBFYI","M2N1MBFZI", & - "M2N1MBXI ","M2N1MBYI ","M2N1MBZI ","M2N1MMGXI","M2N1MMGYI","M2N1MMGZI","M2N1STAXI", & - "M2N1STAYI","M2N1STAZI","M2N1STVXI","M2N1STVYI","M2N1STVZI","M2N1VXI ","M2N1VYI ", & - "M2N1VZI ","M2N2AXI ","M2N2AYI ","M2N2AZI ","M2N2DYNP ","M2N2FAFXI","M2N2FAFYI", & - "M2N2FAFZI","M2N2FAGXI","M2N2FAGYI","M2N2FAGZI","M2N2FAMXI","M2N2FAMYI","M2N2FAMZI", & - "M2N2FBFXI","M2N2FBFYI","M2N2FBFZI","M2N2FBXI ","M2N2FBYI ","M2N2FBZI ","M2N2FDXI ", & - "M2N2FDYI ","M2N2FDZI ","M2N2FIXI ","M2N2FIYI ","M2N2FIZI ","M2N2FMGXI","M2N2FMGYI", & - "M2N2FMGZI","M2N2MAFXI","M2N2MAFYI","M2N2MAFZI","M2N2MAGXI","M2N2MAGYI","M2N2MAGZI", & - "M2N2MBFXI","M2N2MBFYI","M2N2MBFZI","M2N2MBXI ","M2N2MBYI ","M2N2MBZI ","M2N2MMGXI", & - "M2N2MMGYI","M2N2MMGZI","M2N2STAXI","M2N2STAYI","M2N2STAZI","M2N2STVXI","M2N2STVYI", & - "M2N2STVZI","M2N2VXI ","M2N2VYI ","M2N2VZI ","M2N3AXI ","M2N3AYI ","M2N3AZI ", & - "M2N3DYNP ","M2N3FAFXI","M2N3FAFYI","M2N3FAFZI","M2N3FAGXI","M2N3FAGYI","M2N3FAGZI", & - "M2N3FAMXI","M2N3FAMYI","M2N3FAMZI","M2N3FBFXI","M2N3FBFYI","M2N3FBFZI","M2N3FBXI ", & - "M2N3FBYI ","M2N3FBZI ","M2N3FDXI ","M2N3FDYI ","M2N3FDZI ","M2N3FIXI ","M2N3FIYI ", & - "M2N3FIZI ","M2N3FMGXI","M2N3FMGYI","M2N3FMGZI","M2N3MAFXI","M2N3MAFYI","M2N3MAFZI", & - "M2N3MAGXI","M2N3MAGYI","M2N3MAGZI","M2N3MBFXI","M2N3MBFYI","M2N3MBFZI","M2N3MBXI ", & - "M2N3MBYI ","M2N3MBZI ","M2N3MMGXI"/) - ValidParamAry(1001:1500) = (/ & - "M2N3MMGYI","M2N3MMGZI","M2N3STAXI","M2N3STAYI","M2N3STAZI","M2N3STVXI","M2N3STVYI", & - "M2N3STVZI","M2N3VXI ","M2N3VYI ","M2N3VZI ","M2N4AXI ","M2N4AYI ","M2N4AZI ", & - "M2N4DYNP ","M2N4FAFXI","M2N4FAFYI","M2N4FAFZI","M2N4FAGXI","M2N4FAGYI","M2N4FAGZI", & - "M2N4FAMXI","M2N4FAMYI","M2N4FAMZI","M2N4FBFXI","M2N4FBFYI","M2N4FBFZI","M2N4FBXI ", & - "M2N4FBYI ","M2N4FBZI ","M2N4FDXI ","M2N4FDYI ","M2N4FDZI ","M2N4FIXI ","M2N4FIYI ", & - "M2N4FIZI ","M2N4FMGXI","M2N4FMGYI","M2N4FMGZI","M2N4MAFXI","M2N4MAFYI","M2N4MAFZI", & - "M2N4MAGXI","M2N4MAGYI","M2N4MAGZI","M2N4MBFXI","M2N4MBFYI","M2N4MBFZI","M2N4MBXI ", & - "M2N4MBYI ","M2N4MBZI ","M2N4MMGXI","M2N4MMGYI","M2N4MMGZI","M2N4STAXI","M2N4STAYI", & - "M2N4STAZI","M2N4STVXI","M2N4STVYI","M2N4STVZI","M2N4VXI ","M2N4VYI ","M2N4VZI ", & - "M2N5AXI ","M2N5AYI ","M2N5AZI ","M2N5DYNP ","M2N5FAFXI","M2N5FAFYI","M2N5FAFZI", & - "M2N5FAGXI","M2N5FAGYI","M2N5FAGZI","M2N5FAMXI","M2N5FAMYI","M2N5FAMZI","M2N5FBFXI", & - "M2N5FBFYI","M2N5FBFZI","M2N5FBXI ","M2N5FBYI ","M2N5FBZI ","M2N5FDXI ","M2N5FDYI ", & - "M2N5FDZI ","M2N5FIXI ","M2N5FIYI ","M2N5FIZI ","M2N5FMGXI","M2N5FMGYI","M2N5FMGZI", & - "M2N5MAFXI","M2N5MAFYI","M2N5MAFZI","M2N5MAGXI","M2N5MAGYI","M2N5MAGZI","M2N5MBFXI", & - "M2N5MBFYI","M2N5MBFZI","M2N5MBXI ","M2N5MBYI ","M2N5MBZI ","M2N5MMGXI","M2N5MMGYI", & - "M2N5MMGZI","M2N5STAXI","M2N5STAYI","M2N5STAZI","M2N5STVXI","M2N5STVYI","M2N5STVZI", & - "M2N5VXI ","M2N5VYI ","M2N5VZI ","M2N6AXI ","M2N6AYI ","M2N6AZI ","M2N6DYNP ", & - "M2N6FAFXI","M2N6FAFYI","M2N6FAFZI","M2N6FAGXI","M2N6FAGYI","M2N6FAGZI","M2N6FAMXI", & - "M2N6FAMYI","M2N6FAMZI","M2N6FBFXI","M2N6FBFYI","M2N6FBFZI","M2N6FBXI ","M2N6FBYI ", & - "M2N6FBZI ","M2N6FDXI ","M2N6FDYI ","M2N6FDZI ","M2N6FIXI ","M2N6FIYI ","M2N6FIZI ", & - "M2N6FMGXI","M2N6FMGYI","M2N6FMGZI","M2N6MAFXI","M2N6MAFYI","M2N6MAFZI","M2N6MAGXI", & - "M2N6MAGYI","M2N6MAGZI","M2N6MBFXI","M2N6MBFYI","M2N6MBFZI","M2N6MBXI ","M2N6MBYI ", & - "M2N6MBZI ","M2N6MMGXI","M2N6MMGYI","M2N6MMGZI","M2N6STAXI","M2N6STAYI","M2N6STAZI", & - "M2N6STVXI","M2N6STVYI","M2N6STVZI","M2N6VXI ","M2N6VYI ","M2N6VZI ","M2N7AXI ", & - "M2N7AYI ","M2N7AZI ","M2N7DYNP ","M2N7FAFXI","M2N7FAFYI","M2N7FAFZI","M2N7FAGXI", & - "M2N7FAGYI","M2N7FAGZI","M2N7FAMXI","M2N7FAMYI","M2N7FAMZI","M2N7FBFXI","M2N7FBFYI", & - "M2N7FBFZI","M2N7FBXI ","M2N7FBYI ","M2N7FBZI ","M2N7FDXI ","M2N7FDYI ","M2N7FDZI ", & - "M2N7FIXI ","M2N7FIYI ","M2N7FIZI ","M2N7FMGXI","M2N7FMGYI","M2N7FMGZI","M2N7MAFXI", & - "M2N7MAFYI","M2N7MAFZI","M2N7MAGXI","M2N7MAGYI","M2N7MAGZI","M2N7MBFXI","M2N7MBFYI", & - "M2N7MBFZI","M2N7MBXI ","M2N7MBYI ","M2N7MBZI ","M2N7MMGXI","M2N7MMGYI","M2N7MMGZI", & - "M2N7STAXI","M2N7STAYI","M2N7STAZI","M2N7STVXI","M2N7STVYI","M2N7STVZI","M2N7VXI ", & - "M2N7VYI ","M2N7VZI ","M2N8AXI ","M2N8AYI ","M2N8AZI ","M2N8DYNP ","M2N8FAFXI", & - "M2N8FAFYI","M2N8FAFZI","M2N8FAGXI","M2N8FAGYI","M2N8FAGZI","M2N8FAMXI","M2N8FAMYI", & - "M2N8FAMZI","M2N8FBFXI","M2N8FBFYI","M2N8FBFZI","M2N8FBXI ","M2N8FBYI ","M2N8FBZI ", & - "M2N8FDXI ","M2N8FDYI ","M2N8FDZI ","M2N8FIXI ","M2N8FIYI ","M2N8FIZI ","M2N8FMGXI", & - "M2N8FMGYI","M2N8FMGZI","M2N8MAFXI","M2N8MAFYI","M2N8MAFZI","M2N8MAGXI","M2N8MAGYI", & - "M2N8MAGZI","M2N8MBFXI","M2N8MBFYI","M2N8MBFZI","M2N8MBXI ","M2N8MBYI ","M2N8MBZI ", & - "M2N8MMGXI","M2N8MMGYI","M2N8MMGZI","M2N8STAXI","M2N8STAYI","M2N8STAZI","M2N8STVXI", & - "M2N8STVYI","M2N8STVZI","M2N8VXI ","M2N8VYI ","M2N8VZI ","M2N9AXI ","M2N9AYI ", & - "M2N9AZI ","M2N9DYNP ","M2N9FAFXI","M2N9FAFYI","M2N9FAFZI","M2N9FAGXI","M2N9FAGYI", & - "M2N9FAGZI","M2N9FAMXI","M2N9FAMYI","M2N9FAMZI","M2N9FBFXI","M2N9FBFYI","M2N9FBFZI", & - "M2N9FBXI ","M2N9FBYI ","M2N9FBZI ","M2N9FDXI ","M2N9FDYI ","M2N9FDZI ","M2N9FIXI ", & - "M2N9FIYI ","M2N9FIZI ","M2N9FMGXI","M2N9FMGYI","M2N9FMGZI","M2N9MAFXI","M2N9MAFYI", & - "M2N9MAFZI","M2N9MAGXI","M2N9MAGYI","M2N9MAGZI","M2N9MBFXI","M2N9MBFYI","M2N9MBFZI", & - "M2N9MBXI ","M2N9MBYI ","M2N9MBZI ","M2N9MMGXI","M2N9MMGYI","M2N9MMGZI","M2N9STAXI", & - "M2N9STAYI","M2N9STAZI","M2N9STVXI","M2N9STVYI","M2N9STVZI","M2N9VXI ","M2N9VYI ", & - "M2N9VZI ","M3N1AXI ","M3N1AYI ","M3N1AZI ","M3N1DYNP ","M3N1FAFXI","M3N1FAFYI", & - "M3N1FAFZI","M3N1FAGXI","M3N1FAGYI","M3N1FAGZI","M3N1FAMXI","M3N1FAMYI","M3N1FAMZI", & - "M3N1FBFXI","M3N1FBFYI","M3N1FBFZI","M3N1FBXI ","M3N1FBYI ","M3N1FBZI ","M3N1FDXI ", & - "M3N1FDYI ","M3N1FDZI ","M3N1FIXI ","M3N1FIYI ","M3N1FIZI ","M3N1FMGXI","M3N1FMGYI", & - "M3N1FMGZI","M3N1MAFXI","M3N1MAFYI","M3N1MAFZI","M3N1MAGXI","M3N1MAGYI","M3N1MAGZI", & - "M3N1MBFXI","M3N1MBFYI","M3N1MBFZI","M3N1MBXI ","M3N1MBYI ","M3N1MBZI ","M3N1MMGXI", & - "M3N1MMGYI","M3N1MMGZI","M3N1STAXI","M3N1STAYI","M3N1STAZI","M3N1STVXI","M3N1STVYI", & - "M3N1STVZI","M3N1VXI ","M3N1VYI ","M3N1VZI ","M3N2AXI ","M3N2AYI ","M3N2AZI ", & - "M3N2DYNP ","M3N2FAFXI","M3N2FAFYI","M3N2FAFZI","M3N2FAGXI","M3N2FAGYI","M3N2FAGZI", & - "M3N2FAMXI","M3N2FAMYI","M3N2FAMZI","M3N2FBFXI","M3N2FBFYI","M3N2FBFZI","M3N2FBXI ", & - "M3N2FBYI ","M3N2FBZI ","M3N2FDXI ","M3N2FDYI ","M3N2FDZI ","M3N2FIXI ","M3N2FIYI ", & - "M3N2FIZI ","M3N2FMGXI","M3N2FMGYI","M3N2FMGZI","M3N2MAFXI","M3N2MAFYI","M3N2MAFZI", & - "M3N2MAGXI","M3N2MAGYI","M3N2MAGZI","M3N2MBFXI","M3N2MBFYI","M3N2MBFZI","M3N2MBXI ", & - "M3N2MBYI ","M3N2MBZI ","M3N2MMGXI","M3N2MMGYI","M3N2MMGZI","M3N2STAXI","M3N2STAYI", & - "M3N2STAZI","M3N2STVXI","M3N2STVYI","M3N2STVZI","M3N2VXI ","M3N2VYI ","M3N2VZI ", & - "M3N3AXI ","M3N3AYI ","M3N3AZI ","M3N3DYNP ","M3N3FAFXI","M3N3FAFYI","M3N3FAFZI", & - "M3N3FAGXI","M3N3FAGYI","M3N3FAGZI","M3N3FAMXI","M3N3FAMYI","M3N3FAMZI","M3N3FBFXI", & - "M3N3FBFYI","M3N3FBFZI","M3N3FBXI ","M3N3FBYI ","M3N3FBZI ","M3N3FDXI ","M3N3FDYI ", & - "M3N3FDZI ","M3N3FIXI ","M3N3FIYI ","M3N3FIZI ","M3N3FMGXI","M3N3FMGYI","M3N3FMGZI", & - "M3N3MAFXI","M3N3MAFYI","M3N3MAFZI","M3N3MAGXI","M3N3MAGYI","M3N3MAGZI","M3N3MBFXI", & - "M3N3MBFYI","M3N3MBFZI","M3N3MBXI ","M3N3MBYI ","M3N3MBZI ","M3N3MMGXI","M3N3MMGYI", & - "M3N3MMGZI","M3N3STAXI","M3N3STAYI","M3N3STAZI","M3N3STVXI","M3N3STVYI","M3N3STVZI", & - "M3N3VXI ","M3N3VYI ","M3N3VZI ","M3N4AXI ","M3N4AYI ","M3N4AZI ","M3N4DYNP ", & - "M3N4FAFXI","M3N4FAFYI","M3N4FAFZI","M3N4FAGXI","M3N4FAGYI","M3N4FAGZI","M3N4FAMXI", & - "M3N4FAMYI","M3N4FAMZI","M3N4FBFXI","M3N4FBFYI","M3N4FBFZI","M3N4FBXI ","M3N4FBYI ", & - "M3N4FBZI ","M3N4FDXI ","M3N4FDYI "/) - ValidParamAry(1501:2000) = (/ & - "M3N4FDZI ","M3N4FIXI ","M3N4FIYI ","M3N4FIZI ","M3N4FMGXI","M3N4FMGYI","M3N4FMGZI", & - "M3N4MAFXI","M3N4MAFYI","M3N4MAFZI","M3N4MAGXI","M3N4MAGYI","M3N4MAGZI","M3N4MBFXI", & - "M3N4MBFYI","M3N4MBFZI","M3N4MBXI ","M3N4MBYI ","M3N4MBZI ","M3N4MMGXI","M3N4MMGYI", & - "M3N4MMGZI","M3N4STAXI","M3N4STAYI","M3N4STAZI","M3N4STVXI","M3N4STVYI","M3N4STVZI", & - "M3N4VXI ","M3N4VYI ","M3N4VZI ","M3N5AXI ","M3N5AYI ","M3N5AZI ","M3N5DYNP ", & - "M3N5FAFXI","M3N5FAFYI","M3N5FAFZI","M3N5FAGXI","M3N5FAGYI","M3N5FAGZI","M3N5FAMXI", & - "M3N5FAMYI","M3N5FAMZI","M3N5FBFXI","M3N5FBFYI","M3N5FBFZI","M3N5FBXI ","M3N5FBYI ", & - "M3N5FBZI ","M3N5FDXI ","M3N5FDYI ","M3N5FDZI ","M3N5FIXI ","M3N5FIYI ","M3N5FIZI ", & - "M3N5FMGXI","M3N5FMGYI","M3N5FMGZI","M3N5MAFXI","M3N5MAFYI","M3N5MAFZI","M3N5MAGXI", & - "M3N5MAGYI","M3N5MAGZI","M3N5MBFXI","M3N5MBFYI","M3N5MBFZI","M3N5MBXI ","M3N5MBYI ", & - "M3N5MBZI ","M3N5MMGXI","M3N5MMGYI","M3N5MMGZI","M3N5STAXI","M3N5STAYI","M3N5STAZI", & - "M3N5STVXI","M3N5STVYI","M3N5STVZI","M3N5VXI ","M3N5VYI ","M3N5VZI ","M3N6AXI ", & - "M3N6AYI ","M3N6AZI ","M3N6DYNP ","M3N6FAFXI","M3N6FAFYI","M3N6FAFZI","M3N6FAGXI", & - "M3N6FAGYI","M3N6FAGZI","M3N6FAMXI","M3N6FAMYI","M3N6FAMZI","M3N6FBFXI","M3N6FBFYI", & - "M3N6FBFZI","M3N6FBXI ","M3N6FBYI ","M3N6FBZI ","M3N6FDXI ","M3N6FDYI ","M3N6FDZI ", & - "M3N6FIXI ","M3N6FIYI ","M3N6FIZI ","M3N6FMGXI","M3N6FMGYI","M3N6FMGZI","M3N6MAFXI", & - "M3N6MAFYI","M3N6MAFZI","M3N6MAGXI","M3N6MAGYI","M3N6MAGZI","M3N6MBFXI","M3N6MBFYI", & - "M3N6MBFZI","M3N6MBXI ","M3N6MBYI ","M3N6MBZI ","M3N6MMGXI","M3N6MMGYI","M3N6MMGZI", & - "M3N6STAXI","M3N6STAYI","M3N6STAZI","M3N6STVXI","M3N6STVYI","M3N6STVZI","M3N6VXI ", & - "M3N6VYI ","M3N6VZI ","M3N7AXI ","M3N7AYI ","M3N7AZI ","M3N7DYNP ","M3N7FAFXI", & - "M3N7FAFYI","M3N7FAFZI","M3N7FAGXI","M3N7FAGYI","M3N7FAGZI","M3N7FAMXI","M3N7FAMYI", & - "M3N7FAMZI","M3N7FBFXI","M3N7FBFYI","M3N7FBFZI","M3N7FBXI ","M3N7FBYI ","M3N7FBZI ", & - "M3N7FDXI ","M3N7FDYI ","M3N7FDZI ","M3N7FIXI ","M3N7FIYI ","M3N7FIZI ","M3N7FMGXI", & - "M3N7FMGYI","M3N7FMGZI","M3N7MAFXI","M3N7MAFYI","M3N7MAFZI","M3N7MAGXI","M3N7MAGYI", & - "M3N7MAGZI","M3N7MBFXI","M3N7MBFYI","M3N7MBFZI","M3N7MBXI ","M3N7MBYI ","M3N7MBZI ", & - "M3N7MMGXI","M3N7MMGYI","M3N7MMGZI","M3N7STAXI","M3N7STAYI","M3N7STAZI","M3N7STVXI", & - "M3N7STVYI","M3N7STVZI","M3N7VXI ","M3N7VYI ","M3N7VZI ","M3N8AXI ","M3N8AYI ", & - "M3N8AZI ","M3N8DYNP ","M3N8FAFXI","M3N8FAFYI","M3N8FAFZI","M3N8FAGXI","M3N8FAGYI", & - "M3N8FAGZI","M3N8FAMXI","M3N8FAMYI","M3N8FAMZI","M3N8FBFXI","M3N8FBFYI","M3N8FBFZI", & - "M3N8FBXI ","M3N8FBYI ","M3N8FBZI ","M3N8FDXI ","M3N8FDYI ","M3N8FDZI ","M3N8FIXI ", & - "M3N8FIYI ","M3N8FIZI ","M3N8FMGXI","M3N8FMGYI","M3N8FMGZI","M3N8MAFXI","M3N8MAFYI", & - "M3N8MAFZI","M3N8MAGXI","M3N8MAGYI","M3N8MAGZI","M3N8MBFXI","M3N8MBFYI","M3N8MBFZI", & - "M3N8MBXI ","M3N8MBYI ","M3N8MBZI ","M3N8MMGXI","M3N8MMGYI","M3N8MMGZI","M3N8STAXI", & - "M3N8STAYI","M3N8STAZI","M3N8STVXI","M3N8STVYI","M3N8STVZI","M3N8VXI ","M3N8VYI ", & - "M3N8VZI ","M3N9AXI ","M3N9AYI ","M3N9AZI ","M3N9DYNP ","M3N9FAFXI","M3N9FAFYI", & - "M3N9FAFZI","M3N9FAGXI","M3N9FAGYI","M3N9FAGZI","M3N9FAMXI","M3N9FAMYI","M3N9FAMZI", & - "M3N9FBFXI","M3N9FBFYI","M3N9FBFZI","M3N9FBXI ","M3N9FBYI ","M3N9FBZI ","M3N9FDXI ", & - "M3N9FDYI ","M3N9FDZI ","M3N9FIXI ","M3N9FIYI ","M3N9FIZI ","M3N9FMGXI","M3N9FMGYI", & - "M3N9FMGZI","M3N9MAFXI","M3N9MAFYI","M3N9MAFZI","M3N9MAGXI","M3N9MAGYI","M3N9MAGZI", & - "M3N9MBFXI","M3N9MBFYI","M3N9MBFZI","M3N9MBXI ","M3N9MBYI ","M3N9MBZI ","M3N9MMGXI", & - "M3N9MMGYI","M3N9MMGZI","M3N9STAXI","M3N9STAYI","M3N9STAZI","M3N9STVXI","M3N9STVYI", & - "M3N9STVZI","M3N9VXI ","M3N9VYI ","M3N9VZI ","M4N1AXI ","M4N1AYI ","M4N1AZI ", & - "M4N1DYNP ","M4N1FAFXI","M4N1FAFYI","M4N1FAFZI","M4N1FAGXI","M4N1FAGYI","M4N1FAGZI", & - "M4N1FAMXI","M4N1FAMYI","M4N1FAMZI","M4N1FBFXI","M4N1FBFYI","M4N1FBFZI","M4N1FBXI ", & - "M4N1FBYI ","M4N1FBZI ","M4N1FDXI ","M4N1FDYI ","M4N1FDZI ","M4N1FIXI ","M4N1FIYI ", & - "M4N1FIZI ","M4N1FMGXI","M4N1FMGYI","M4N1FMGZI","M4N1MAFXI","M4N1MAFYI","M4N1MAFZI", & - "M4N1MAGXI","M4N1MAGYI","M4N1MAGZI","M4N1MBFXI","M4N1MBFYI","M4N1MBFZI","M4N1MBXI ", & - "M4N1MBYI ","M4N1MBZI ","M4N1MMGXI","M4N1MMGYI","M4N1MMGZI","M4N1STAXI","M4N1STAYI", & - "M4N1STAZI","M4N1STVXI","M4N1STVYI","M4N1STVZI","M4N1VXI ","M4N1VYI ","M4N1VZI ", & - "M4N2AXI ","M4N2AYI ","M4N2AZI ","M4N2DYNP ","M4N2FAFXI","M4N2FAFYI","M4N2FAFZI", & - "M4N2FAGXI","M4N2FAGYI","M4N2FAGZI","M4N2FAMXI","M4N2FAMYI","M4N2FAMZI","M4N2FBFXI", & - "M4N2FBFYI","M4N2FBFZI","M4N2FBXI ","M4N2FBYI ","M4N2FBZI ","M4N2FDXI ","M4N2FDYI ", & - "M4N2FDZI ","M4N2FIXI ","M4N2FIYI ","M4N2FIZI ","M4N2FMGXI","M4N2FMGYI","M4N2FMGZI", & - "M4N2MAFXI","M4N2MAFYI","M4N2MAFZI","M4N2MAGXI","M4N2MAGYI","M4N2MAGZI","M4N2MBFXI", & - "M4N2MBFYI","M4N2MBFZI","M4N2MBXI ","M4N2MBYI ","M4N2MBZI ","M4N2MMGXI","M4N2MMGYI", & - "M4N2MMGZI","M4N2STAXI","M4N2STAYI","M4N2STAZI","M4N2STVXI","M4N2STVYI","M4N2STVZI", & - "M4N2VXI ","M4N2VYI ","M4N2VZI ","M4N3AXI ","M4N3AYI ","M4N3AZI ","M4N3DYNP ", & - "M4N3FAFXI","M4N3FAFYI","M4N3FAFZI","M4N3FAGXI","M4N3FAGYI","M4N3FAGZI","M4N3FAMXI", & - "M4N3FAMYI","M4N3FAMZI","M4N3FBFXI","M4N3FBFYI","M4N3FBFZI","M4N3FBXI ","M4N3FBYI ", & - "M4N3FBZI ","M4N3FDXI ","M4N3FDYI ","M4N3FDZI ","M4N3FIXI ","M4N3FIYI ","M4N3FIZI ", & - "M4N3FMGXI","M4N3FMGYI","M4N3FMGZI","M4N3MAFXI","M4N3MAFYI","M4N3MAFZI","M4N3MAGXI", & - "M4N3MAGYI","M4N3MAGZI","M4N3MBFXI","M4N3MBFYI","M4N3MBFZI","M4N3MBXI ","M4N3MBYI ", & - "M4N3MBZI ","M4N3MMGXI","M4N3MMGYI","M4N3MMGZI","M4N3STAXI","M4N3STAYI","M4N3STAZI", & - "M4N3STVXI","M4N3STVYI","M4N3STVZI","M4N3VXI ","M4N3VYI ","M4N3VZI ","M4N4AXI ", & - "M4N4AYI ","M4N4AZI ","M4N4DYNP ","M4N4FAFXI","M4N4FAFYI","M4N4FAFZI","M4N4FAGXI", & - "M4N4FAGYI","M4N4FAGZI","M4N4FAMXI","M4N4FAMYI","M4N4FAMZI","M4N4FBFXI","M4N4FBFYI", & - "M4N4FBFZI","M4N4FBXI ","M4N4FBYI ","M4N4FBZI ","M4N4FDXI ","M4N4FDYI ","M4N4FDZI ", & - "M4N4FIXI ","M4N4FIYI ","M4N4FIZI ","M4N4FMGXI","M4N4FMGYI","M4N4FMGZI","M4N4MAFXI", & - "M4N4MAFYI","M4N4MAFZI","M4N4MAGXI","M4N4MAGYI","M4N4MAGZI","M4N4MBFXI","M4N4MBFYI", & - "M4N4MBFZI","M4N4MBXI ","M4N4MBYI ","M4N4MBZI ","M4N4MMGXI","M4N4MMGYI","M4N4MMGZI", & - "M4N4STAXI","M4N4STAYI","M4N4STAZI","M4N4STVXI","M4N4STVYI","M4N4STVZI","M4N4VXI ", & - "M4N4VYI ","M4N4VZI ","M4N5AXI "/) - ValidParamAry(2001:2500) = (/ & - "M4N5AYI ","M4N5AZI ","M4N5DYNP ","M4N5FAFXI","M4N5FAFYI","M4N5FAFZI","M4N5FAGXI", & - "M4N5FAGYI","M4N5FAGZI","M4N5FAMXI","M4N5FAMYI","M4N5FAMZI","M4N5FBFXI","M4N5FBFYI", & - "M4N5FBFZI","M4N5FBXI ","M4N5FBYI ","M4N5FBZI ","M4N5FDXI ","M4N5FDYI ","M4N5FDZI ", & - "M4N5FIXI ","M4N5FIYI ","M4N5FIZI ","M4N5FMGXI","M4N5FMGYI","M4N5FMGZI","M4N5MAFXI", & - "M4N5MAFYI","M4N5MAFZI","M4N5MAGXI","M4N5MAGYI","M4N5MAGZI","M4N5MBFXI","M4N5MBFYI", & - "M4N5MBFZI","M4N5MBXI ","M4N5MBYI ","M4N5MBZI ","M4N5MMGXI","M4N5MMGYI","M4N5MMGZI", & - "M4N5STAXI","M4N5STAYI","M4N5STAZI","M4N5STVXI","M4N5STVYI","M4N5STVZI","M4N5VXI ", & - "M4N5VYI ","M4N5VZI ","M4N6AXI ","M4N6AYI ","M4N6AZI ","M4N6DYNP ","M4N6FAFXI", & - "M4N6FAFYI","M4N6FAFZI","M4N6FAGXI","M4N6FAGYI","M4N6FAGZI","M4N6FAMXI","M4N6FAMYI", & - "M4N6FAMZI","M4N6FBFXI","M4N6FBFYI","M4N6FBFZI","M4N6FBXI ","M4N6FBYI ","M4N6FBZI ", & - "M4N6FDXI ","M4N6FDYI ","M4N6FDZI ","M4N6FIXI ","M4N6FIYI ","M4N6FIZI ","M4N6FMGXI", & - "M4N6FMGYI","M4N6FMGZI","M4N6MAFXI","M4N6MAFYI","M4N6MAFZI","M4N6MAGXI","M4N6MAGYI", & - "M4N6MAGZI","M4N6MBFXI","M4N6MBFYI","M4N6MBFZI","M4N6MBXI ","M4N6MBYI ","M4N6MBZI ", & - "M4N6MMGXI","M4N6MMGYI","M4N6MMGZI","M4N6STAXI","M4N6STAYI","M4N6STAZI","M4N6STVXI", & - "M4N6STVYI","M4N6STVZI","M4N6VXI ","M4N6VYI ","M4N6VZI ","M4N7AXI ","M4N7AYI ", & - "M4N7AZI ","M4N7DYNP ","M4N7FAFXI","M4N7FAFYI","M4N7FAFZI","M4N7FAGXI","M4N7FAGYI", & - "M4N7FAGZI","M4N7FAMXI","M4N7FAMYI","M4N7FAMZI","M4N7FBFXI","M4N7FBFYI","M4N7FBFZI", & - "M4N7FBXI ","M4N7FBYI ","M4N7FBZI ","M4N7FDXI ","M4N7FDYI ","M4N7FDZI ","M4N7FIXI ", & - "M4N7FIYI ","M4N7FIZI ","M4N7FMGXI","M4N7FMGYI","M4N7FMGZI","M4N7MAFXI","M4N7MAFYI", & - "M4N7MAFZI","M4N7MAGXI","M4N7MAGYI","M4N7MAGZI","M4N7MBFXI","M4N7MBFYI","M4N7MBFZI", & - "M4N7MBXI ","M4N7MBYI ","M4N7MBZI ","M4N7MMGXI","M4N7MMGYI","M4N7MMGZI","M4N7STAXI", & - "M4N7STAYI","M4N7STAZI","M4N7STVXI","M4N7STVYI","M4N7STVZI","M4N7VXI ","M4N7VYI ", & - "M4N7VZI ","M4N8AXI ","M4N8AYI ","M4N8AZI ","M4N8DYNP ","M4N8FAFXI","M4N8FAFYI", & - "M4N8FAFZI","M4N8FAGXI","M4N8FAGYI","M4N8FAGZI","M4N8FAMXI","M4N8FAMYI","M4N8FAMZI", & - "M4N8FBFXI","M4N8FBFYI","M4N8FBFZI","M4N8FBXI ","M4N8FBYI ","M4N8FBZI ","M4N8FDXI ", & - "M4N8FDYI ","M4N8FDZI ","M4N8FIXI ","M4N8FIYI ","M4N8FIZI ","M4N8FMGXI","M4N8FMGYI", & - "M4N8FMGZI","M4N8MAFXI","M4N8MAFYI","M4N8MAFZI","M4N8MAGXI","M4N8MAGYI","M4N8MAGZI", & - "M4N8MBFXI","M4N8MBFYI","M4N8MBFZI","M4N8MBXI ","M4N8MBYI ","M4N8MBZI ","M4N8MMGXI", & - "M4N8MMGYI","M4N8MMGZI","M4N8STAXI","M4N8STAYI","M4N8STAZI","M4N8STVXI","M4N8STVYI", & - "M4N8STVZI","M4N8VXI ","M4N8VYI ","M4N8VZI ","M4N9AXI ","M4N9AYI ","M4N9AZI ", & - "M4N9DYNP ","M4N9FAFXI","M4N9FAFYI","M4N9FAFZI","M4N9FAGXI","M4N9FAGYI","M4N9FAGZI", & - "M4N9FAMXI","M4N9FAMYI","M4N9FAMZI","M4N9FBFXI","M4N9FBFYI","M4N9FBFZI","M4N9FBXI ", & - "M4N9FBYI ","M4N9FBZI ","M4N9FDXI ","M4N9FDYI ","M4N9FDZI ","M4N9FIXI ","M4N9FIYI ", & - "M4N9FIZI ","M4N9FMGXI","M4N9FMGYI","M4N9FMGZI","M4N9MAFXI","M4N9MAFYI","M4N9MAFZI", & - "M4N9MAGXI","M4N9MAGYI","M4N9MAGZI","M4N9MBFXI","M4N9MBFYI","M4N9MBFZI","M4N9MBXI ", & - "M4N9MBYI ","M4N9MBZI ","M4N9MMGXI","M4N9MMGYI","M4N9MMGZI","M4N9STAXI","M4N9STAYI", & - "M4N9STAZI","M4N9STVXI","M4N9STVYI","M4N9STVZI","M4N9VXI ","M4N9VYI ","M4N9VZI ", & - "M5N1AXI ","M5N1AYI ","M5N1AZI ","M5N1DYNP ","M5N1FAFXI","M5N1FAFYI","M5N1FAFZI", & - "M5N1FAGXI","M5N1FAGYI","M5N1FAGZI","M5N1FAMXI","M5N1FAMYI","M5N1FAMZI","M5N1FBFXI", & - "M5N1FBFYI","M5N1FBFZI","M5N1FBXI ","M5N1FBYI ","M5N1FBZI ","M5N1FDXI ","M5N1FDYI ", & - "M5N1FDZI ","M5N1FIXI ","M5N1FIYI ","M5N1FIZI ","M5N1FMGXI","M5N1FMGYI","M5N1FMGZI", & - "M5N1MAFXI","M5N1MAFYI","M5N1MAFZI","M5N1MAGXI","M5N1MAGYI","M5N1MAGZI","M5N1MBFXI", & - "M5N1MBFYI","M5N1MBFZI","M5N1MBXI ","M5N1MBYI ","M5N1MBZI ","M5N1MMGXI","M5N1MMGYI", & - "M5N1MMGZI","M5N1STAXI","M5N1STAYI","M5N1STAZI","M5N1STVXI","M5N1STVYI","M5N1STVZI", & - "M5N1VXI ","M5N1VYI ","M5N1VZI ","M5N2AXI ","M5N2AYI ","M5N2AZI ","M5N2DYNP ", & - "M5N2FAFXI","M5N2FAFYI","M5N2FAFZI","M5N2FAGXI","M5N2FAGYI","M5N2FAGZI","M5N2FAMXI", & - "M5N2FAMYI","M5N2FAMZI","M5N2FBFXI","M5N2FBFYI","M5N2FBFZI","M5N2FBXI ","M5N2FBYI ", & - "M5N2FBZI ","M5N2FDXI ","M5N2FDYI ","M5N2FDZI ","M5N2FIXI ","M5N2FIYI ","M5N2FIZI ", & - "M5N2FMGXI","M5N2FMGYI","M5N2FMGZI","M5N2MAFXI","M5N2MAFYI","M5N2MAFZI","M5N2MAGXI", & - "M5N2MAGYI","M5N2MAGZI","M5N2MBFXI","M5N2MBFYI","M5N2MBFZI","M5N2MBXI ","M5N2MBYI ", & - "M5N2MBZI ","M5N2MMGXI","M5N2MMGYI","M5N2MMGZI","M5N2STAXI","M5N2STAYI","M5N2STAZI", & - "M5N2STVXI","M5N2STVYI","M5N2STVZI","M5N2VXI ","M5N2VYI ","M5N2VZI ","M5N3AXI ", & - "M5N3AYI ","M5N3AZI ","M5N3DYNP ","M5N3FAFXI","M5N3FAFYI","M5N3FAFZI","M5N3FAGXI", & - "M5N3FAGYI","M5N3FAGZI","M5N3FAMXI","M5N3FAMYI","M5N3FAMZI","M5N3FBFXI","M5N3FBFYI", & - "M5N3FBFZI","M5N3FBXI ","M5N3FBYI ","M5N3FBZI ","M5N3FDXI ","M5N3FDYI ","M5N3FDZI ", & - "M5N3FIXI ","M5N3FIYI ","M5N3FIZI ","M5N3FMGXI","M5N3FMGYI","M5N3FMGZI","M5N3MAFXI", & - "M5N3MAFYI","M5N3MAFZI","M5N3MAGXI","M5N3MAGYI","M5N3MAGZI","M5N3MBFXI","M5N3MBFYI", & - "M5N3MBFZI","M5N3MBXI ","M5N3MBYI ","M5N3MBZI ","M5N3MMGXI","M5N3MMGYI","M5N3MMGZI", & - "M5N3STAXI","M5N3STAYI","M5N3STAZI","M5N3STVXI","M5N3STVYI","M5N3STVZI","M5N3VXI ", & - "M5N3VYI ","M5N3VZI ","M5N4AXI ","M5N4AYI ","M5N4AZI ","M5N4DYNP ","M5N4FAFXI", & - "M5N4FAFYI","M5N4FAFZI","M5N4FAGXI","M5N4FAGYI","M5N4FAGZI","M5N4FAMXI","M5N4FAMYI", & - "M5N4FAMZI","M5N4FBFXI","M5N4FBFYI","M5N4FBFZI","M5N4FBXI ","M5N4FBYI ","M5N4FBZI ", & - "M5N4FDXI ","M5N4FDYI ","M5N4FDZI ","M5N4FIXI ","M5N4FIYI ","M5N4FIZI ","M5N4FMGXI", & - "M5N4FMGYI","M5N4FMGZI","M5N4MAFXI","M5N4MAFYI","M5N4MAFZI","M5N4MAGXI","M5N4MAGYI", & - "M5N4MAGZI","M5N4MBFXI","M5N4MBFYI","M5N4MBFZI","M5N4MBXI ","M5N4MBYI ","M5N4MBZI ", & - "M5N4MMGXI","M5N4MMGYI","M5N4MMGZI","M5N4STAXI","M5N4STAYI","M5N4STAZI","M5N4STVXI", & - "M5N4STVYI","M5N4STVZI","M5N4VXI ","M5N4VYI ","M5N4VZI ","M5N5AXI ","M5N5AYI ", & - "M5N5AZI ","M5N5DYNP ","M5N5FAFXI","M5N5FAFYI","M5N5FAFZI","M5N5FAGXI","M5N5FAGYI", & - "M5N5FAGZI","M5N5FAMXI","M5N5FAMYI","M5N5FAMZI","M5N5FBFXI","M5N5FBFYI","M5N5FBFZI", & - "M5N5FBXI ","M5N5FBYI ","M5N5FBZI ","M5N5FDXI ","M5N5FDYI ","M5N5FDZI ","M5N5FIXI ", & - "M5N5FIYI ","M5N5FIZI ","M5N5FMGXI","M5N5FMGYI","M5N5FMGZI","M5N5MAFXI","M5N5MAFYI", & - "M5N5MAFZI","M5N5MAGXI","M5N5MAGYI"/) - ValidParamAry(2501:3000) = (/ & - "M5N5MAGZI","M5N5MBFXI","M5N5MBFYI","M5N5MBFZI","M5N5MBXI ","M5N5MBYI ","M5N5MBZI ", & - "M5N5MMGXI","M5N5MMGYI","M5N5MMGZI","M5N5STAXI","M5N5STAYI","M5N5STAZI","M5N5STVXI", & - "M5N5STVYI","M5N5STVZI","M5N5VXI ","M5N5VYI ","M5N5VZI ","M5N6AXI ","M5N6AYI ", & - "M5N6AZI ","M5N6DYNP ","M5N6FAFXI","M5N6FAFYI","M5N6FAFZI","M5N6FAGXI","M5N6FAGYI", & - "M5N6FAGZI","M5N6FAMXI","M5N6FAMYI","M5N6FAMZI","M5N6FBFXI","M5N6FBFYI","M5N6FBFZI", & - "M5N6FBXI ","M5N6FBYI ","M5N6FBZI ","M5N6FDXI ","M5N6FDYI ","M5N6FDZI ","M5N6FIXI ", & - "M5N6FIYI ","M5N6FIZI ","M5N6FMGXI","M5N6FMGYI","M5N6FMGZI","M5N6MAFXI","M5N6MAFYI", & - "M5N6MAFZI","M5N6MAGXI","M5N6MAGYI","M5N6MAGZI","M5N6MBFXI","M5N6MBFYI","M5N6MBFZI", & - "M5N6MBXI ","M5N6MBYI ","M5N6MBZI ","M5N6MMGXI","M5N6MMGYI","M5N6MMGZI","M5N6STAXI", & - "M5N6STAYI","M5N6STAZI","M5N6STVXI","M5N6STVYI","M5N6STVZI","M5N6VXI ","M5N6VYI ", & - "M5N6VZI ","M5N7AXI ","M5N7AYI ","M5N7AZI ","M5N7DYNP ","M5N7FAFXI","M5N7FAFYI", & - "M5N7FAFZI","M5N7FAGXI","M5N7FAGYI","M5N7FAGZI","M5N7FAMXI","M5N7FAMYI","M5N7FAMZI", & - "M5N7FBFXI","M5N7FBFYI","M5N7FBFZI","M5N7FBXI ","M5N7FBYI ","M5N7FBZI ","M5N7FDXI ", & - "M5N7FDYI ","M5N7FDZI ","M5N7FIXI ","M5N7FIYI ","M5N7FIZI ","M5N7FMGXI","M5N7FMGYI", & - "M5N7FMGZI","M5N7MAFXI","M5N7MAFYI","M5N7MAFZI","M5N7MAGXI","M5N7MAGYI","M5N7MAGZI", & - "M5N7MBFXI","M5N7MBFYI","M5N7MBFZI","M5N7MBXI ","M5N7MBYI ","M5N7MBZI ","M5N7MMGXI", & - "M5N7MMGYI","M5N7MMGZI","M5N7STAXI","M5N7STAYI","M5N7STAZI","M5N7STVXI","M5N7STVYI", & - "M5N7STVZI","M5N7VXI ","M5N7VYI ","M5N7VZI ","M5N8AXI ","M5N8AYI ","M5N8AZI ", & - "M5N8DYNP ","M5N8FAFXI","M5N8FAFYI","M5N8FAFZI","M5N8FAGXI","M5N8FAGYI","M5N8FAGZI", & - "M5N8FAMXI","M5N8FAMYI","M5N8FAMZI","M5N8FBFXI","M5N8FBFYI","M5N8FBFZI","M5N8FBXI ", & - "M5N8FBYI ","M5N8FBZI ","M5N8FDXI ","M5N8FDYI ","M5N8FDZI ","M5N8FIXI ","M5N8FIYI ", & - "M5N8FIZI ","M5N8FMGXI","M5N8FMGYI","M5N8FMGZI","M5N8MAFXI","M5N8MAFYI","M5N8MAFZI", & - "M5N8MAGXI","M5N8MAGYI","M5N8MAGZI","M5N8MBFXI","M5N8MBFYI","M5N8MBFZI","M5N8MBXI ", & - "M5N8MBYI ","M5N8MBZI ","M5N8MMGXI","M5N8MMGYI","M5N8MMGZI","M5N8STAXI","M5N8STAYI", & - "M5N8STAZI","M5N8STVXI","M5N8STVYI","M5N8STVZI","M5N8VXI ","M5N8VYI ","M5N8VZI ", & - "M5N9AXI ","M5N9AYI ","M5N9AZI ","M5N9DYNP ","M5N9FAFXI","M5N9FAFYI","M5N9FAFZI", & - "M5N9FAGXI","M5N9FAGYI","M5N9FAGZI","M5N9FAMXI","M5N9FAMYI","M5N9FAMZI","M5N9FBFXI", & - "M5N9FBFYI","M5N9FBFZI","M5N9FBXI ","M5N9FBYI ","M5N9FBZI ","M5N9FDXI ","M5N9FDYI ", & - "M5N9FDZI ","M5N9FIXI ","M5N9FIYI ","M5N9FIZI ","M5N9FMGXI","M5N9FMGYI","M5N9FMGZI", & - "M5N9MAFXI","M5N9MAFYI","M5N9MAFZI","M5N9MAGXI","M5N9MAGYI","M5N9MAGZI","M5N9MBFXI", & - "M5N9MBFYI","M5N9MBFZI","M5N9MBXI ","M5N9MBYI ","M5N9MBZI ","M5N9MMGXI","M5N9MMGYI", & - "M5N9MMGZI","M5N9STAXI","M5N9STAYI","M5N9STAZI","M5N9STVXI","M5N9STVYI","M5N9STVZI", & - "M5N9VXI ","M5N9VYI ","M5N9VZI ","M6N1AXI ","M6N1AYI ","M6N1AZI ","M6N1DYNP ", & - "M6N1FAFXI","M6N1FAFYI","M6N1FAFZI","M6N1FAGXI","M6N1FAGYI","M6N1FAGZI","M6N1FAMXI", & - "M6N1FAMYI","M6N1FAMZI","M6N1FBFXI","M6N1FBFYI","M6N1FBFZI","M6N1FBXI ","M6N1FBYI ", & - "M6N1FBZI ","M6N1FDXI ","M6N1FDYI ","M6N1FDZI ","M6N1FIXI ","M6N1FIYI ","M6N1FIZI ", & - "M6N1FMGXI","M6N1FMGYI","M6N1FMGZI","M6N1MAFXI","M6N1MAFYI","M6N1MAFZI","M6N1MAGXI", & - "M6N1MAGYI","M6N1MAGZI","M6N1MBFXI","M6N1MBFYI","M6N1MBFZI","M6N1MBXI ","M6N1MBYI ", & - "M6N1MBZI ","M6N1MMGXI","M6N1MMGYI","M6N1MMGZI","M6N1STAXI","M6N1STAYI","M6N1STAZI", & - "M6N1STVXI","M6N1STVYI","M6N1STVZI","M6N1VXI ","M6N1VYI ","M6N1VZI ","M6N2AXI ", & - "M6N2AYI ","M6N2AZI ","M6N2DYNP ","M6N2FAFXI","M6N2FAFYI","M6N2FAFZI","M6N2FAGXI", & - "M6N2FAGYI","M6N2FAGZI","M6N2FAMXI","M6N2FAMYI","M6N2FAMZI","M6N2FBFXI","M6N2FBFYI", & - "M6N2FBFZI","M6N2FBXI ","M6N2FBYI ","M6N2FBZI ","M6N2FDXI ","M6N2FDYI ","M6N2FDZI ", & - "M6N2FIXI ","M6N2FIYI ","M6N2FIZI ","M6N2FMGXI","M6N2FMGYI","M6N2FMGZI","M6N2MAFXI", & - "M6N2MAFYI","M6N2MAFZI","M6N2MAGXI","M6N2MAGYI","M6N2MAGZI","M6N2MBFXI","M6N2MBFYI", & - "M6N2MBFZI","M6N2MBXI ","M6N2MBYI ","M6N2MBZI ","M6N2MMGXI","M6N2MMGYI","M6N2MMGZI", & - "M6N2STAXI","M6N2STAYI","M6N2STAZI","M6N2STVXI","M6N2STVYI","M6N2STVZI","M6N2VXI ", & - "M6N2VYI ","M6N2VZI ","M6N3AXI ","M6N3AYI ","M6N3AZI ","M6N3DYNP ","M6N3FAFXI", & - "M6N3FAFYI","M6N3FAFZI","M6N3FAGXI","M6N3FAGYI","M6N3FAGZI","M6N3FAMXI","M6N3FAMYI", & - "M6N3FAMZI","M6N3FBFXI","M6N3FBFYI","M6N3FBFZI","M6N3FBXI ","M6N3FBYI ","M6N3FBZI ", & - "M6N3FDXI ","M6N3FDYI ","M6N3FDZI ","M6N3FIXI ","M6N3FIYI ","M6N3FIZI ","M6N3FMGXI", & - "M6N3FMGYI","M6N3FMGZI","M6N3MAFXI","M6N3MAFYI","M6N3MAFZI","M6N3MAGXI","M6N3MAGYI", & - "M6N3MAGZI","M6N3MBFXI","M6N3MBFYI","M6N3MBFZI","M6N3MBXI ","M6N3MBYI ","M6N3MBZI ", & - "M6N3MMGXI","M6N3MMGYI","M6N3MMGZI","M6N3STAXI","M6N3STAYI","M6N3STAZI","M6N3STVXI", & - "M6N3STVYI","M6N3STVZI","M6N3VXI ","M6N3VYI ","M6N3VZI ","M6N4AXI ","M6N4AYI ", & - "M6N4AZI ","M6N4DYNP ","M6N4FAFXI","M6N4FAFYI","M6N4FAFZI","M6N4FAGXI","M6N4FAGYI", & - "M6N4FAGZI","M6N4FAMXI","M6N4FAMYI","M6N4FAMZI","M6N4FBFXI","M6N4FBFYI","M6N4FBFZI", & - "M6N4FBXI ","M6N4FBYI ","M6N4FBZI ","M6N4FDXI ","M6N4FDYI ","M6N4FDZI ","M6N4FIXI ", & - "M6N4FIYI ","M6N4FIZI ","M6N4FMGXI","M6N4FMGYI","M6N4FMGZI","M6N4MAFXI","M6N4MAFYI", & - "M6N4MAFZI","M6N4MAGXI","M6N4MAGYI","M6N4MAGZI","M6N4MBFXI","M6N4MBFYI","M6N4MBFZI", & - "M6N4MBXI ","M6N4MBYI ","M6N4MBZI ","M6N4MMGXI","M6N4MMGYI","M6N4MMGZI","M6N4STAXI", & - "M6N4STAYI","M6N4STAZI","M6N4STVXI","M6N4STVYI","M6N4STVZI","M6N4VXI ","M6N4VYI ", & - "M6N4VZI ","M6N5AXI ","M6N5AYI ","M6N5AZI ","M6N5DYNP ","M6N5FAFXI","M6N5FAFYI", & - "M6N5FAFZI","M6N5FAGXI","M6N5FAGYI","M6N5FAGZI","M6N5FAMXI","M6N5FAMYI","M6N5FAMZI", & - "M6N5FBFXI","M6N5FBFYI","M6N5FBFZI","M6N5FBXI ","M6N5FBYI ","M6N5FBZI ","M6N5FDXI ", & - "M6N5FDYI ","M6N5FDZI ","M6N5FIXI ","M6N5FIYI ","M6N5FIZI ","M6N5FMGXI","M6N5FMGYI", & - "M6N5FMGZI","M6N5MAFXI","M6N5MAFYI","M6N5MAFZI","M6N5MAGXI","M6N5MAGYI","M6N5MAGZI", & - "M6N5MBFXI","M6N5MBFYI","M6N5MBFZI","M6N5MBXI ","M6N5MBYI ","M6N5MBZI ","M6N5MMGXI", & - "M6N5MMGYI","M6N5MMGZI","M6N5STAXI","M6N5STAYI","M6N5STAZI","M6N5STVXI","M6N5STVYI", & - "M6N5STVZI","M6N5VXI ","M6N5VYI ","M6N5VZI ","M6N6AXI ","M6N6AYI ","M6N6AZI ", & - "M6N6DYNP ","M6N6FAFXI","M6N6FAFYI","M6N6FAFZI","M6N6FAGXI","M6N6FAGYI","M6N6FAGZI", & - "M6N6FAMXI","M6N6FAMYI","M6N6FAMZI"/) - ValidParamAry(3001:3500) = (/ & - "M6N6FBFXI","M6N6FBFYI","M6N6FBFZI","M6N6FBXI ","M6N6FBYI ","M6N6FBZI ","M6N6FDXI ", & - "M6N6FDYI ","M6N6FDZI ","M6N6FIXI ","M6N6FIYI ","M6N6FIZI ","M6N6FMGXI","M6N6FMGYI", & - "M6N6FMGZI","M6N6MAFXI","M6N6MAFYI","M6N6MAFZI","M6N6MAGXI","M6N6MAGYI","M6N6MAGZI", & - "M6N6MBFXI","M6N6MBFYI","M6N6MBFZI","M6N6MBXI ","M6N6MBYI ","M6N6MBZI ","M6N6MMGXI", & - "M6N6MMGYI","M6N6MMGZI","M6N6STAXI","M6N6STAYI","M6N6STAZI","M6N6STVXI","M6N6STVYI", & - "M6N6STVZI","M6N6VXI ","M6N6VYI ","M6N6VZI ","M6N7AXI ","M6N7AYI ","M6N7AZI ", & - "M6N7DYNP ","M6N7FAFXI","M6N7FAFYI","M6N7FAFZI","M6N7FAGXI","M6N7FAGYI","M6N7FAGZI", & - "M6N7FAMXI","M6N7FAMYI","M6N7FAMZI","M6N7FBFXI","M6N7FBFYI","M6N7FBFZI","M6N7FBXI ", & - "M6N7FBYI ","M6N7FBZI ","M6N7FDXI ","M6N7FDYI ","M6N7FDZI ","M6N7FIXI ","M6N7FIYI ", & - "M6N7FIZI ","M6N7FMGXI","M6N7FMGYI","M6N7FMGZI","M6N7MAFXI","M6N7MAFYI","M6N7MAFZI", & - "M6N7MAGXI","M6N7MAGYI","M6N7MAGZI","M6N7MBFXI","M6N7MBFYI","M6N7MBFZI","M6N7MBXI ", & - "M6N7MBYI ","M6N7MBZI ","M6N7MMGXI","M6N7MMGYI","M6N7MMGZI","M6N7STAXI","M6N7STAYI", & - "M6N7STAZI","M6N7STVXI","M6N7STVYI","M6N7STVZI","M6N7VXI ","M6N7VYI ","M6N7VZI ", & - "M6N8AXI ","M6N8AYI ","M6N8AZI ","M6N8DYNP ","M6N8FAFXI","M6N8FAFYI","M6N8FAFZI", & - "M6N8FAGXI","M6N8FAGYI","M6N8FAGZI","M6N8FAMXI","M6N8FAMYI","M6N8FAMZI","M6N8FBFXI", & - "M6N8FBFYI","M6N8FBFZI","M6N8FBXI ","M6N8FBYI ","M6N8FBZI ","M6N8FDXI ","M6N8FDYI ", & - "M6N8FDZI ","M6N8FIXI ","M6N8FIYI ","M6N8FIZI ","M6N8FMGXI","M6N8FMGYI","M6N8FMGZI", & - "M6N8MAFXI","M6N8MAFYI","M6N8MAFZI","M6N8MAGXI","M6N8MAGYI","M6N8MAGZI","M6N8MBFXI", & - "M6N8MBFYI","M6N8MBFZI","M6N8MBXI ","M6N8MBYI ","M6N8MBZI ","M6N8MMGXI","M6N8MMGYI", & - "M6N8MMGZI","M6N8STAXI","M6N8STAYI","M6N8STAZI","M6N8STVXI","M6N8STVYI","M6N8STVZI", & - "M6N8VXI ","M6N8VYI ","M6N8VZI ","M6N9AXI ","M6N9AYI ","M6N9AZI ","M6N9DYNP ", & - "M6N9FAFXI","M6N9FAFYI","M6N9FAFZI","M6N9FAGXI","M6N9FAGYI","M6N9FAGZI","M6N9FAMXI", & - "M6N9FAMYI","M6N9FAMZI","M6N9FBFXI","M6N9FBFYI","M6N9FBFZI","M6N9FBXI ","M6N9FBYI ", & - "M6N9FBZI ","M6N9FDXI ","M6N9FDYI ","M6N9FDZI ","M6N9FIXI ","M6N9FIYI ","M6N9FIZI ", & - "M6N9FMGXI","M6N9FMGYI","M6N9FMGZI","M6N9MAFXI","M6N9MAFYI","M6N9MAFZI","M6N9MAGXI", & - "M6N9MAGYI","M6N9MAGZI","M6N9MBFXI","M6N9MBFYI","M6N9MBFZI","M6N9MBXI ","M6N9MBYI ", & - "M6N9MBZI ","M6N9MMGXI","M6N9MMGYI","M6N9MMGZI","M6N9STAXI","M6N9STAYI","M6N9STAZI", & - "M6N9STVXI","M6N9STVYI","M6N9STVZI","M6N9VXI ","M6N9VYI ","M6N9VZI ","M7N1AXI ", & - "M7N1AYI ","M7N1AZI ","M7N1DYNP ","M7N1FAFXI","M7N1FAFYI","M7N1FAFZI","M7N1FAGXI", & - "M7N1FAGYI","M7N1FAGZI","M7N1FAMXI","M7N1FAMYI","M7N1FAMZI","M7N1FBFXI","M7N1FBFYI", & - "M7N1FBFZI","M7N1FBXI ","M7N1FBYI ","M7N1FBZI ","M7N1FDXI ","M7N1FDYI ","M7N1FDZI ", & - "M7N1FIXI ","M7N1FIYI ","M7N1FIZI ","M7N1FMGXI","M7N1FMGYI","M7N1FMGZI","M7N1MAFXI", & - "M7N1MAFYI","M7N1MAFZI","M7N1MAGXI","M7N1MAGYI","M7N1MAGZI","M7N1MBFXI","M7N1MBFYI", & - "M7N1MBFZI","M7N1MBXI ","M7N1MBYI ","M7N1MBZI ","M7N1MMGXI","M7N1MMGYI","M7N1MMGZI", & - "M7N1STAXI","M7N1STAYI","M7N1STAZI","M7N1STVXI","M7N1STVYI","M7N1STVZI","M7N1VXI ", & - "M7N1VYI ","M7N1VZI ","M7N2AXI ","M7N2AYI ","M7N2AZI ","M7N2DYNP ","M7N2FAFXI", & - "M7N2FAFYI","M7N2FAFZI","M7N2FAGXI","M7N2FAGYI","M7N2FAGZI","M7N2FAMXI","M7N2FAMYI", & - "M7N2FAMZI","M7N2FBFXI","M7N2FBFYI","M7N2FBFZI","M7N2FBXI ","M7N2FBYI ","M7N2FBZI ", & - "M7N2FDXI ","M7N2FDYI ","M7N2FDZI ","M7N2FIXI ","M7N2FIYI ","M7N2FIZI ","M7N2FMGXI", & - "M7N2FMGYI","M7N2FMGZI","M7N2MAFXI","M7N2MAFYI","M7N2MAFZI","M7N2MAGXI","M7N2MAGYI", & - "M7N2MAGZI","M7N2MBFXI","M7N2MBFYI","M7N2MBFZI","M7N2MBXI ","M7N2MBYI ","M7N2MBZI ", & - "M7N2MMGXI","M7N2MMGYI","M7N2MMGZI","M7N2STAXI","M7N2STAYI","M7N2STAZI","M7N2STVXI", & - "M7N2STVYI","M7N2STVZI","M7N2VXI ","M7N2VYI ","M7N2VZI ","M7N3AXI ","M7N3AYI ", & - "M7N3AZI ","M7N3DYNP ","M7N3FAFXI","M7N3FAFYI","M7N3FAFZI","M7N3FAGXI","M7N3FAGYI", & - "M7N3FAGZI","M7N3FAMXI","M7N3FAMYI","M7N3FAMZI","M7N3FBFXI","M7N3FBFYI","M7N3FBFZI", & - "M7N3FBXI ","M7N3FBYI ","M7N3FBZI ","M7N3FDXI ","M7N3FDYI ","M7N3FDZI ","M7N3FIXI ", & - "M7N3FIYI ","M7N3FIZI ","M7N3FMGXI","M7N3FMGYI","M7N3FMGZI","M7N3MAFXI","M7N3MAFYI", & - "M7N3MAFZI","M7N3MAGXI","M7N3MAGYI","M7N3MAGZI","M7N3MBFXI","M7N3MBFYI","M7N3MBFZI", & - "M7N3MBXI ","M7N3MBYI ","M7N3MBZI ","M7N3MMGXI","M7N3MMGYI","M7N3MMGZI","M7N3STAXI", & - "M7N3STAYI","M7N3STAZI","M7N3STVXI","M7N3STVYI","M7N3STVZI","M7N3VXI ","M7N3VYI ", & - "M7N3VZI ","M7N4AXI ","M7N4AYI ","M7N4AZI ","M7N4DYNP ","M7N4FAFXI","M7N4FAFYI", & - "M7N4FAFZI","M7N4FAGXI","M7N4FAGYI","M7N4FAGZI","M7N4FAMXI","M7N4FAMYI","M7N4FAMZI", & - "M7N4FBFXI","M7N4FBFYI","M7N4FBFZI","M7N4FBXI ","M7N4FBYI ","M7N4FBZI ","M7N4FDXI ", & - "M7N4FDYI ","M7N4FDZI ","M7N4FIXI ","M7N4FIYI ","M7N4FIZI ","M7N4FMGXI","M7N4FMGYI", & - "M7N4FMGZI","M7N4MAFXI","M7N4MAFYI","M7N4MAFZI","M7N4MAGXI","M7N4MAGYI","M7N4MAGZI", & - "M7N4MBFXI","M7N4MBFYI","M7N4MBFZI","M7N4MBXI ","M7N4MBYI ","M7N4MBZI ","M7N4MMGXI", & - "M7N4MMGYI","M7N4MMGZI","M7N4STAXI","M7N4STAYI","M7N4STAZI","M7N4STVXI","M7N4STVYI", & - "M7N4STVZI","M7N4VXI ","M7N4VYI ","M7N4VZI ","M7N5AXI ","M7N5AYI ","M7N5AZI ", & - "M7N5DYNP ","M7N5FAFXI","M7N5FAFYI","M7N5FAFZI","M7N5FAGXI","M7N5FAGYI","M7N5FAGZI", & - "M7N5FAMXI","M7N5FAMYI","M7N5FAMZI","M7N5FBFXI","M7N5FBFYI","M7N5FBFZI","M7N5FBXI ", & - "M7N5FBYI ","M7N5FBZI ","M7N5FDXI ","M7N5FDYI ","M7N5FDZI ","M7N5FIXI ","M7N5FIYI ", & - "M7N5FIZI ","M7N5FMGXI","M7N5FMGYI","M7N5FMGZI","M7N5MAFXI","M7N5MAFYI","M7N5MAFZI", & - "M7N5MAGXI","M7N5MAGYI","M7N5MAGZI","M7N5MBFXI","M7N5MBFYI","M7N5MBFZI","M7N5MBXI ", & - "M7N5MBYI ","M7N5MBZI ","M7N5MMGXI","M7N5MMGYI","M7N5MMGZI","M7N5STAXI","M7N5STAYI", & - "M7N5STAZI","M7N5STVXI","M7N5STVYI","M7N5STVZI","M7N5VXI ","M7N5VYI ","M7N5VZI ", & - "M7N6AXI ","M7N6AYI ","M7N6AZI ","M7N6DYNP ","M7N6FAFXI","M7N6FAFYI","M7N6FAFZI", & - "M7N6FAGXI","M7N6FAGYI","M7N6FAGZI","M7N6FAMXI","M7N6FAMYI","M7N6FAMZI","M7N6FBFXI", & - "M7N6FBFYI","M7N6FBFZI","M7N6FBXI ","M7N6FBYI ","M7N6FBZI ","M7N6FDXI ","M7N6FDYI ", & - "M7N6FDZI ","M7N6FIXI ","M7N6FIYI ","M7N6FIZI ","M7N6FMGXI","M7N6FMGYI","M7N6FMGZI", & - "M7N6MAFXI","M7N6MAFYI","M7N6MAFZI","M7N6MAGXI","M7N6MAGYI","M7N6MAGZI","M7N6MBFXI", & - "M7N6MBFYI","M7N6MBFZI","M7N6MBXI ","M7N6MBYI ","M7N6MBZI ","M7N6MMGXI","M7N6MMGYI", & - "M7N6MMGZI","M7N6STAXI","M7N6STAYI"/) - ValidParamAry(3501:4000) = (/ & - "M7N6STAZI","M7N6STVXI","M7N6STVYI","M7N6STVZI","M7N6VXI ","M7N6VYI ","M7N6VZI ", & - "M7N7AXI ","M7N7AYI ","M7N7AZI ","M7N7DYNP ","M7N7FAFXI","M7N7FAFYI","M7N7FAFZI", & - "M7N7FAGXI","M7N7FAGYI","M7N7FAGZI","M7N7FAMXI","M7N7FAMYI","M7N7FAMZI","M7N7FBFXI", & - "M7N7FBFYI","M7N7FBFZI","M7N7FBXI ","M7N7FBYI ","M7N7FBZI ","M7N7FDXI ","M7N7FDYI ", & - "M7N7FDZI ","M7N7FIXI ","M7N7FIYI ","M7N7FIZI ","M7N7FMGXI","M7N7FMGYI","M7N7FMGZI", & - "M7N7MAFXI","M7N7MAFYI","M7N7MAFZI","M7N7MAGXI","M7N7MAGYI","M7N7MAGZI","M7N7MBFXI", & - "M7N7MBFYI","M7N7MBFZI","M7N7MBXI ","M7N7MBYI ","M7N7MBZI ","M7N7MMGXI","M7N7MMGYI", & - "M7N7MMGZI","M7N7STAXI","M7N7STAYI","M7N7STAZI","M7N7STVXI","M7N7STVYI","M7N7STVZI", & - "M7N7VXI ","M7N7VYI ","M7N7VZI ","M7N8AXI ","M7N8AYI ","M7N8AZI ","M7N8DYNP ", & - "M7N8FAFXI","M7N8FAFYI","M7N8FAFZI","M7N8FAGXI","M7N8FAGYI","M7N8FAGZI","M7N8FAMXI", & - "M7N8FAMYI","M7N8FAMZI","M7N8FBFXI","M7N8FBFYI","M7N8FBFZI","M7N8FBXI ","M7N8FBYI ", & - "M7N8FBZI ","M7N8FDXI ","M7N8FDYI ","M7N8FDZI ","M7N8FIXI ","M7N8FIYI ","M7N8FIZI ", & - "M7N8FMGXI","M7N8FMGYI","M7N8FMGZI","M7N8MAFXI","M7N8MAFYI","M7N8MAFZI","M7N8MAGXI", & - "M7N8MAGYI","M7N8MAGZI","M7N8MBFXI","M7N8MBFYI","M7N8MBFZI","M7N8MBXI ","M7N8MBYI ", & - "M7N8MBZI ","M7N8MMGXI","M7N8MMGYI","M7N8MMGZI","M7N8STAXI","M7N8STAYI","M7N8STAZI", & - "M7N8STVXI","M7N8STVYI","M7N8STVZI","M7N8VXI ","M7N8VYI ","M7N8VZI ","M7N9AXI ", & - "M7N9AYI ","M7N9AZI ","M7N9DYNP ","M7N9FAFXI","M7N9FAFYI","M7N9FAFZI","M7N9FAGXI", & - "M7N9FAGYI","M7N9FAGZI","M7N9FAMXI","M7N9FAMYI","M7N9FAMZI","M7N9FBFXI","M7N9FBFYI", & - "M7N9FBFZI","M7N9FBXI ","M7N9FBYI ","M7N9FBZI ","M7N9FDXI ","M7N9FDYI ","M7N9FDZI ", & - "M7N9FIXI ","M7N9FIYI ","M7N9FIZI ","M7N9FMGXI","M7N9FMGYI","M7N9FMGZI","M7N9MAFXI", & - "M7N9MAFYI","M7N9MAFZI","M7N9MAGXI","M7N9MAGYI","M7N9MAGZI","M7N9MBFXI","M7N9MBFYI", & - "M7N9MBFZI","M7N9MBXI ","M7N9MBYI ","M7N9MBZI ","M7N9MMGXI","M7N9MMGYI","M7N9MMGZI", & - "M7N9STAXI","M7N9STAYI","M7N9STAZI","M7N9STVXI","M7N9STVYI","M7N9STVZI","M7N9VXI ", & - "M7N9VYI ","M7N9VZI ","M8N1AXI ","M8N1AYI ","M8N1AZI ","M8N1DYNP ","M8N1FAFXI", & - "M8N1FAFYI","M8N1FAFZI","M8N1FAGXI","M8N1FAGYI","M8N1FAGZI","M8N1FAMXI","M8N1FAMYI", & - "M8N1FAMZI","M8N1FBFXI","M8N1FBFYI","M8N1FBFZI","M8N1FBXI ","M8N1FBYI ","M8N1FBZI ", & - "M8N1FDXI ","M8N1FDYI ","M8N1FDZI ","M8N1FIXI ","M8N1FIYI ","M8N1FIZI ","M8N1FMGXI", & - "M8N1FMGYI","M8N1FMGZI","M8N1MAFXI","M8N1MAFYI","M8N1MAFZI","M8N1MAGXI","M8N1MAGYI", & - "M8N1MAGZI","M8N1MBFXI","M8N1MBFYI","M8N1MBFZI","M8N1MBXI ","M8N1MBYI ","M8N1MBZI ", & - "M8N1MMGXI","M8N1MMGYI","M8N1MMGZI","M8N1STAXI","M8N1STAYI","M8N1STAZI","M8N1STVXI", & - "M8N1STVYI","M8N1STVZI","M8N1VXI ","M8N1VYI ","M8N1VZI ","M8N2AXI ","M8N2AYI ", & - "M8N2AZI ","M8N2DYNP ","M8N2FAFXI","M8N2FAFYI","M8N2FAFZI","M8N2FAGXI","M8N2FAGYI", & - "M8N2FAGZI","M8N2FAMXI","M8N2FAMYI","M8N2FAMZI","M8N2FBFXI","M8N2FBFYI","M8N2FBFZI", & - "M8N2FBXI ","M8N2FBYI ","M8N2FBZI ","M8N2FDXI ","M8N2FDYI ","M8N2FDZI ","M8N2FIXI ", & - "M8N2FIYI ","M8N2FIZI ","M8N2FMGXI","M8N2FMGYI","M8N2FMGZI","M8N2MAFXI","M8N2MAFYI", & - "M8N2MAFZI","M8N2MAGXI","M8N2MAGYI","M8N2MAGZI","M8N2MBFXI","M8N2MBFYI","M8N2MBFZI", & - "M8N2MBXI ","M8N2MBYI ","M8N2MBZI ","M8N2MMGXI","M8N2MMGYI","M8N2MMGZI","M8N2STAXI", & - "M8N2STAYI","M8N2STAZI","M8N2STVXI","M8N2STVYI","M8N2STVZI","M8N2VXI ","M8N2VYI ", & - "M8N2VZI ","M8N3AXI ","M8N3AYI ","M8N3AZI ","M8N3DYNP ","M8N3FAFXI","M8N3FAFYI", & - "M8N3FAFZI","M8N3FAGXI","M8N3FAGYI","M8N3FAGZI","M8N3FAMXI","M8N3FAMYI","M8N3FAMZI", & - "M8N3FBFXI","M8N3FBFYI","M8N3FBFZI","M8N3FBXI ","M8N3FBYI ","M8N3FBZI ","M8N3FDXI ", & - "M8N3FDYI ","M8N3FDZI ","M8N3FIXI ","M8N3FIYI ","M8N3FIZI ","M8N3FMGXI","M8N3FMGYI", & - "M8N3FMGZI","M8N3MAFXI","M8N3MAFYI","M8N3MAFZI","M8N3MAGXI","M8N3MAGYI","M8N3MAGZI", & - "M8N3MBFXI","M8N3MBFYI","M8N3MBFZI","M8N3MBXI ","M8N3MBYI ","M8N3MBZI ","M8N3MMGXI", & - "M8N3MMGYI","M8N3MMGZI","M8N3STAXI","M8N3STAYI","M8N3STAZI","M8N3STVXI","M8N3STVYI", & - "M8N3STVZI","M8N3VXI ","M8N3VYI ","M8N3VZI ","M8N4AXI ","M8N4AYI ","M8N4AZI ", & - "M8N4DYNP ","M8N4FAFXI","M8N4FAFYI","M8N4FAFZI","M8N4FAGXI","M8N4FAGYI","M8N4FAGZI", & - "M8N4FAMXI","M8N4FAMYI","M8N4FAMZI","M8N4FBFXI","M8N4FBFYI","M8N4FBFZI","M8N4FBXI ", & - "M8N4FBYI ","M8N4FBZI ","M8N4FDXI ","M8N4FDYI ","M8N4FDZI ","M8N4FIXI ","M8N4FIYI ", & - "M8N4FIZI ","M8N4FMGXI","M8N4FMGYI","M8N4FMGZI","M8N4MAFXI","M8N4MAFYI","M8N4MAFZI", & - "M8N4MAGXI","M8N4MAGYI","M8N4MAGZI","M8N4MBFXI","M8N4MBFYI","M8N4MBFZI","M8N4MBXI ", & - "M8N4MBYI ","M8N4MBZI ","M8N4MMGXI","M8N4MMGYI","M8N4MMGZI","M8N4STAXI","M8N4STAYI", & - "M8N4STAZI","M8N4STVXI","M8N4STVYI","M8N4STVZI","M8N4VXI ","M8N4VYI ","M8N4VZI ", & - "M8N5AXI ","M8N5AYI ","M8N5AZI ","M8N5DYNP ","M8N5FAFXI","M8N5FAFYI","M8N5FAFZI", & - "M8N5FAGXI","M8N5FAGYI","M8N5FAGZI","M8N5FAMXI","M8N5FAMYI","M8N5FAMZI","M8N5FBFXI", & - "M8N5FBFYI","M8N5FBFZI","M8N5FBXI ","M8N5FBYI ","M8N5FBZI ","M8N5FDXI ","M8N5FDYI ", & - "M8N5FDZI ","M8N5FIXI ","M8N5FIYI ","M8N5FIZI ","M8N5FMGXI","M8N5FMGYI","M8N5FMGZI", & - "M8N5MAFXI","M8N5MAFYI","M8N5MAFZI","M8N5MAGXI","M8N5MAGYI","M8N5MAGZI","M8N5MBFXI", & - "M8N5MBFYI","M8N5MBFZI","M8N5MBXI ","M8N5MBYI ","M8N5MBZI ","M8N5MMGXI","M8N5MMGYI", & - "M8N5MMGZI","M8N5STAXI","M8N5STAYI","M8N5STAZI","M8N5STVXI","M8N5STVYI","M8N5STVZI", & - "M8N5VXI ","M8N5VYI ","M8N5VZI ","M8N6AXI ","M8N6AYI ","M8N6AZI ","M8N6DYNP ", & - "M8N6FAFXI","M8N6FAFYI","M8N6FAFZI","M8N6FAGXI","M8N6FAGYI","M8N6FAGZI","M8N6FAMXI", & - "M8N6FAMYI","M8N6FAMZI","M8N6FBFXI","M8N6FBFYI","M8N6FBFZI","M8N6FBXI ","M8N6FBYI ", & - "M8N6FBZI ","M8N6FDXI ","M8N6FDYI ","M8N6FDZI ","M8N6FIXI ","M8N6FIYI ","M8N6FIZI ", & - "M8N6FMGXI","M8N6FMGYI","M8N6FMGZI","M8N6MAFXI","M8N6MAFYI","M8N6MAFZI","M8N6MAGXI", & - "M8N6MAGYI","M8N6MAGZI","M8N6MBFXI","M8N6MBFYI","M8N6MBFZI","M8N6MBXI ","M8N6MBYI ", & - "M8N6MBZI ","M8N6MMGXI","M8N6MMGYI","M8N6MMGZI","M8N6STAXI","M8N6STAYI","M8N6STAZI", & - "M8N6STVXI","M8N6STVYI","M8N6STVZI","M8N6VXI ","M8N6VYI ","M8N6VZI ","M8N7AXI ", & - "M8N7AYI ","M8N7AZI ","M8N7DYNP ","M8N7FAFXI","M8N7FAFYI","M8N7FAFZI","M8N7FAGXI", & - "M8N7FAGYI","M8N7FAGZI","M8N7FAMXI","M8N7FAMYI","M8N7FAMZI","M8N7FBFXI","M8N7FBFYI", & - "M8N7FBFZI","M8N7FBXI ","M8N7FBYI ","M8N7FBZI ","M8N7FDXI ","M8N7FDYI ","M8N7FDZI ", & - "M8N7FIXI ","M8N7FIYI ","M8N7FIZI "/) - ValidParamAry(4001:4500) = (/ & - "M8N7FMGXI","M8N7FMGYI","M8N7FMGZI","M8N7MAFXI","M8N7MAFYI","M8N7MAFZI","M8N7MAGXI", & - "M8N7MAGYI","M8N7MAGZI","M8N7MBFXI","M8N7MBFYI","M8N7MBFZI","M8N7MBXI ","M8N7MBYI ", & - "M8N7MBZI ","M8N7MMGXI","M8N7MMGYI","M8N7MMGZI","M8N7STAXI","M8N7STAYI","M8N7STAZI", & - "M8N7STVXI","M8N7STVYI","M8N7STVZI","M8N7VXI ","M8N7VYI ","M8N7VZI ","M8N8AXI ", & - "M8N8AYI ","M8N8AZI ","M8N8DYNP ","M8N8FAFXI","M8N8FAFYI","M8N8FAFZI","M8N8FAGXI", & - "M8N8FAGYI","M8N8FAGZI","M8N8FAMXI","M8N8FAMYI","M8N8FAMZI","M8N8FBFXI","M8N8FBFYI", & - "M8N8FBFZI","M8N8FBXI ","M8N8FBYI ","M8N8FBZI ","M8N8FDXI ","M8N8FDYI ","M8N8FDZI ", & - "M8N8FIXI ","M8N8FIYI ","M8N8FIZI ","M8N8FMGXI","M8N8FMGYI","M8N8FMGZI","M8N8MAFXI", & - "M8N8MAFYI","M8N8MAFZI","M8N8MAGXI","M8N8MAGYI","M8N8MAGZI","M8N8MBFXI","M8N8MBFYI", & - "M8N8MBFZI","M8N8MBXI ","M8N8MBYI ","M8N8MBZI ","M8N8MMGXI","M8N8MMGYI","M8N8MMGZI", & - "M8N8STAXI","M8N8STAYI","M8N8STAZI","M8N8STVXI","M8N8STVYI","M8N8STVZI","M8N8VXI ", & - "M8N8VYI ","M8N8VZI ","M8N9AXI ","M8N9AYI ","M8N9AZI ","M8N9DYNP ","M8N9FAFXI", & - "M8N9FAFYI","M8N9FAFZI","M8N9FAGXI","M8N9FAGYI","M8N9FAGZI","M8N9FAMXI","M8N9FAMYI", & - "M8N9FAMZI","M8N9FBFXI","M8N9FBFYI","M8N9FBFZI","M8N9FBXI ","M8N9FBYI ","M8N9FBZI ", & - "M8N9FDXI ","M8N9FDYI ","M8N9FDZI ","M8N9FIXI ","M8N9FIYI ","M8N9FIZI ","M8N9FMGXI", & - "M8N9FMGYI","M8N9FMGZI","M8N9MAFXI","M8N9MAFYI","M8N9MAFZI","M8N9MAGXI","M8N9MAGYI", & - "M8N9MAGZI","M8N9MBFXI","M8N9MBFYI","M8N9MBFZI","M8N9MBXI ","M8N9MBYI ","M8N9MBZI ", & - "M8N9MMGXI","M8N9MMGYI","M8N9MMGZI","M8N9STAXI","M8N9STAYI","M8N9STAZI","M8N9STVXI", & - "M8N9STVYI","M8N9STVZI","M8N9VXI ","M8N9VYI ","M8N9VZI ","M9N1AXI ","M9N1AYI ", & - "M9N1AZI ","M9N1DYNP ","M9N1FAFXI","M9N1FAFYI","M9N1FAFZI","M9N1FAGXI","M9N1FAGYI", & - "M9N1FAGZI","M9N1FAMXI","M9N1FAMYI","M9N1FAMZI","M9N1FBFXI","M9N1FBFYI","M9N1FBFZI", & - "M9N1FBXI ","M9N1FBYI ","M9N1FBZI ","M9N1FDXI ","M9N1FDYI ","M9N1FDZI ","M9N1FIXI ", & - "M9N1FIYI ","M9N1FIZI ","M9N1FMGXI","M9N1FMGYI","M9N1FMGZI","M9N1MAFXI","M9N1MAFYI", & - "M9N1MAFZI","M9N1MAGXI","M9N1MAGYI","M9N1MAGZI","M9N1MBFXI","M9N1MBFYI","M9N1MBFZI", & - "M9N1MBXI ","M9N1MBYI ","M9N1MBZI ","M9N1MMGXI","M9N1MMGYI","M9N1MMGZI","M9N1STAXI", & - "M9N1STAYI","M9N1STAZI","M9N1STVXI","M9N1STVYI","M9N1STVZI","M9N1VXI ","M9N1VYI ", & - "M9N1VZI ","M9N2AXI ","M9N2AYI ","M9N2AZI ","M9N2DYNP ","M9N2FAFXI","M9N2FAFYI", & - "M9N2FAFZI","M9N2FAGXI","M9N2FAGYI","M9N2FAGZI","M9N2FAMXI","M9N2FAMYI","M9N2FAMZI", & - "M9N2FBFXI","M9N2FBFYI","M9N2FBFZI","M9N2FBXI ","M9N2FBYI ","M9N2FBZI ","M9N2FDXI ", & - "M9N2FDYI ","M9N2FDZI ","M9N2FIXI ","M9N2FIYI ","M9N2FIZI ","M9N2FMGXI","M9N2FMGYI", & - "M9N2FMGZI","M9N2MAFXI","M9N2MAFYI","M9N2MAFZI","M9N2MAGXI","M9N2MAGYI","M9N2MAGZI", & - "M9N2MBFXI","M9N2MBFYI","M9N2MBFZI","M9N2MBXI ","M9N2MBYI ","M9N2MBZI ","M9N2MMGXI", & - "M9N2MMGYI","M9N2MMGZI","M9N2STAXI","M9N2STAYI","M9N2STAZI","M9N2STVXI","M9N2STVYI", & - "M9N2STVZI","M9N2VXI ","M9N2VYI ","M9N2VZI ","M9N3AXI ","M9N3AYI ","M9N3AZI ", & - "M9N3DYNP ","M9N3FAFXI","M9N3FAFYI","M9N3FAFZI","M9N3FAGXI","M9N3FAGYI","M9N3FAGZI", & - "M9N3FAMXI","M9N3FAMYI","M9N3FAMZI","M9N3FBFXI","M9N3FBFYI","M9N3FBFZI","M9N3FBXI ", & - "M9N3FBYI ","M9N3FBZI ","M9N3FDXI ","M9N3FDYI ","M9N3FDZI ","M9N3FIXI ","M9N3FIYI ", & - "M9N3FIZI ","M9N3FMGXI","M9N3FMGYI","M9N3FMGZI","M9N3MAFXI","M9N3MAFYI","M9N3MAFZI", & - "M9N3MAGXI","M9N3MAGYI","M9N3MAGZI","M9N3MBFXI","M9N3MBFYI","M9N3MBFZI","M9N3MBXI ", & - "M9N3MBYI ","M9N3MBZI ","M9N3MMGXI","M9N3MMGYI","M9N3MMGZI","M9N3STAXI","M9N3STAYI", & - "M9N3STAZI","M9N3STVXI","M9N3STVYI","M9N3STVZI","M9N3VXI ","M9N3VYI ","M9N3VZI ", & - "M9N4AXI ","M9N4AYI ","M9N4AZI ","M9N4DYNP ","M9N4FAFXI","M9N4FAFYI","M9N4FAFZI", & - "M9N4FAGXI","M9N4FAGYI","M9N4FAGZI","M9N4FAMXI","M9N4FAMYI","M9N4FAMZI","M9N4FBFXI", & - "M9N4FBFYI","M9N4FBFZI","M9N4FBXI ","M9N4FBYI ","M9N4FBZI ","M9N4FDXI ","M9N4FDYI ", & - "M9N4FDZI ","M9N4FIXI ","M9N4FIYI ","M9N4FIZI ","M9N4FMGXI","M9N4FMGYI","M9N4FMGZI", & - "M9N4MAFXI","M9N4MAFYI","M9N4MAFZI","M9N4MAGXI","M9N4MAGYI","M9N4MAGZI","M9N4MBFXI", & - "M9N4MBFYI","M9N4MBFZI","M9N4MBXI ","M9N4MBYI ","M9N4MBZI ","M9N4MMGXI","M9N4MMGYI", & - "M9N4MMGZI","M9N4STAXI","M9N4STAYI","M9N4STAZI","M9N4STVXI","M9N4STVYI","M9N4STVZI", & - "M9N4VXI ","M9N4VYI ","M9N4VZI ","M9N5AXI ","M9N5AYI ","M9N5AZI ","M9N5DYNP ", & - "M9N5FAFXI","M9N5FAFYI","M9N5FAFZI","M9N5FAGXI","M9N5FAGYI","M9N5FAGZI","M9N5FAMXI", & - "M9N5FAMYI","M9N5FAMZI","M9N5FBFXI","M9N5FBFYI","M9N5FBFZI","M9N5FBXI ","M9N5FBYI ", & - "M9N5FBZI ","M9N5FDXI ","M9N5FDYI ","M9N5FDZI ","M9N5FIXI ","M9N5FIYI ","M9N5FIZI ", & - "M9N5FMGXI","M9N5FMGYI","M9N5FMGZI","M9N5MAFXI","M9N5MAFYI","M9N5MAFZI","M9N5MAGXI", & - "M9N5MAGYI","M9N5MAGZI","M9N5MBFXI","M9N5MBFYI","M9N5MBFZI","M9N5MBXI ","M9N5MBYI ", & - "M9N5MBZI ","M9N5MMGXI","M9N5MMGYI","M9N5MMGZI","M9N5STAXI","M9N5STAYI","M9N5STAZI", & - "M9N5STVXI","M9N5STVYI","M9N5STVZI","M9N5VXI ","M9N5VYI ","M9N5VZI ","M9N6AXI ", & - "M9N6AYI ","M9N6AZI ","M9N6DYNP ","M9N6FAFXI","M9N6FAFYI","M9N6FAFZI","M9N6FAGXI", & - "M9N6FAGYI","M9N6FAGZI","M9N6FAMXI","M9N6FAMYI","M9N6FAMZI","M9N6FBFXI","M9N6FBFYI", & - "M9N6FBFZI","M9N6FBXI ","M9N6FBYI ","M9N6FBZI ","M9N6FDXI ","M9N6FDYI ","M9N6FDZI ", & - "M9N6FIXI ","M9N6FIYI ","M9N6FIZI ","M9N6FMGXI","M9N6FMGYI","M9N6FMGZI","M9N6MAFXI", & - "M9N6MAFYI","M9N6MAFZI","M9N6MAGXI","M9N6MAGYI","M9N6MAGZI","M9N6MBFXI","M9N6MBFYI", & - "M9N6MBFZI","M9N6MBXI ","M9N6MBYI ","M9N6MBZI ","M9N6MMGXI","M9N6MMGYI","M9N6MMGZI", & - "M9N6STAXI","M9N6STAYI","M9N6STAZI","M9N6STVXI","M9N6STVYI","M9N6STVZI","M9N6VXI ", & - "M9N6VYI ","M9N6VZI ","M9N7AXI ","M9N7AYI ","M9N7AZI ","M9N7DYNP ","M9N7FAFXI", & - "M9N7FAFYI","M9N7FAFZI","M9N7FAGXI","M9N7FAGYI","M9N7FAGZI","M9N7FAMXI","M9N7FAMYI", & - "M9N7FAMZI","M9N7FBFXI","M9N7FBFYI","M9N7FBFZI","M9N7FBXI ","M9N7FBYI ","M9N7FBZI ", & - "M9N7FDXI ","M9N7FDYI ","M9N7FDZI ","M9N7FIXI ","M9N7FIYI ","M9N7FIZI ","M9N7FMGXI", & - "M9N7FMGYI","M9N7FMGZI","M9N7MAFXI","M9N7MAFYI","M9N7MAFZI","M9N7MAGXI","M9N7MAGYI", & - "M9N7MAGZI","M9N7MBFXI","M9N7MBFYI","M9N7MBFZI","M9N7MBXI ","M9N7MBYI ","M9N7MBZI ", & - "M9N7MMGXI","M9N7MMGYI","M9N7MMGZI","M9N7STAXI","M9N7STAYI","M9N7STAZI","M9N7STVXI", & - "M9N7STVYI","M9N7STVZI","M9N7VXI ","M9N7VYI ","M9N7VZI ","M9N8AXI ","M9N8AYI ", & - "M9N8AZI ","M9N8DYNP ","M9N8FAFXI"/) - ValidParamAry(4501:4599) = (/ & - "M9N8FAFYI","M9N8FAFZI","M9N8FAGXI","M9N8FAGYI","M9N8FAGZI","M9N8FAMXI","M9N8FAMYI", & - "M9N8FAMZI","M9N8FBFXI","M9N8FBFYI","M9N8FBFZI","M9N8FBXI ","M9N8FBYI ","M9N8FBZI ", & - "M9N8FDXI ","M9N8FDYI ","M9N8FDZI ","M9N8FIXI ","M9N8FIYI ","M9N8FIZI ","M9N8FMGXI", & - "M9N8FMGYI","M9N8FMGZI","M9N8MAFXI","M9N8MAFYI","M9N8MAFZI","M9N8MAGXI","M9N8MAGYI", & - "M9N8MAGZI","M9N8MBFXI","M9N8MBFYI","M9N8MBFZI","M9N8MBXI ","M9N8MBYI ","M9N8MBZI ", & - "M9N8MMGXI","M9N8MMGYI","M9N8MMGZI","M9N8STAXI","M9N8STAYI","M9N8STAZI","M9N8STVXI", & - "M9N8STVYI","M9N8STVZI","M9N8VXI ","M9N8VYI ","M9N8VZI ","M9N9AXI ","M9N9AYI ", & - "M9N9AZI ","M9N9DYNP ","M9N9FAFXI","M9N9FAFYI","M9N9FAFZI","M9N9FAGXI","M9N9FAGYI", & - "M9N9FAGZI","M9N9FAMXI","M9N9FAMYI","M9N9FAMZI","M9N9FBFXI","M9N9FBFYI","M9N9FBFZI", & - "M9N9FBXI ","M9N9FBYI ","M9N9FBZI ","M9N9FDXI ","M9N9FDYI ","M9N9FDZI ","M9N9FIXI ", & - "M9N9FIYI ","M9N9FIZI ","M9N9FMGXI","M9N9FMGYI","M9N9FMGZI","M9N9MAFXI","M9N9MAFYI", & - "M9N9MAFZI","M9N9MAGXI","M9N9MAGYI","M9N9MAGZI","M9N9MBFXI","M9N9MBFYI","M9N9MBFZI", & - "M9N9MBXI ","M9N9MBYI ","M9N9MBZI ","M9N9MMGXI","M9N9MMGYI","M9N9MMGZI","M9N9STAXI", & - "M9N9STAYI","M9N9STAZI","M9N9STVXI","M9N9STVYI","M9N9STVZI","M9N9VXI ","M9N9VYI ", & - "M9N9VZI "/) - ParamIndxAry(1:500) = (/ & - J1Axi , J1Ayi , J1Azi , J1DynP , J1FAGxi , J1FAGyi , J1FAGzi , & - J1FAMxi , J1FAMyi , J1FAMzi , J1FBFxi , J1FBFyi , J1FBFzi , J1FBxi , & - J1FByi , J1FBzi , J1FDxi , J1FDyi , J1FDzi , J1FIxi , J1FIyi , & - J1FIzi , J1FMGxi , J1FMGyi , J1FMGzi , J1MAGxi , J1MAGyi , J1MAGzi , & - J1MBFxi , J1MBFyi , J1MBFzi , J1MBxi , J1MByi , J1MBzi , J1STAxi , & - J1STAyi , J1STAzi , J1STVxi , J1STVyi , J1STVzi , J1Vxi , J1Vyi , & - J1Vzi , J2Axi , J2Ayi , J2Azi , J2DynP , J2FAGxi , J2FAGyi , & - J2FAGzi , J2FAMxi , J2FAMyi , J2FAMzi , J2FBFxi , J2FBFyi , J2FBFzi , & - J2FBxi , J2FByi , J2FBzi , J2FDxi , J2FDyi , J2FDzi , J2FIxi , & - J2FIyi , J2FIzi , J2FMGxi , J2FMGyi , J2FMGzi , J2MAGxi , J2MAGyi , & - J2MAGzi , J2MBFxi , J2MBFyi , J2MBFzi , J2MBxi , J2MByi , J2MBzi , & - J2STAxi , J2STAyi , J2STAzi , J2STVxi , J2STVyi , J2STVzi , J2Vxi , & - J2Vyi , J2Vzi , J3Axi , J3Ayi , J3Azi , J3DynP , J3FAGxi , & - J3FAGyi , J3FAGzi , J3FAMxi , J3FAMyi , J3FAMzi , J3FBFxi , J3FBFyi , & - J3FBFzi , J3FBxi , J3FByi , J3FBzi , J3FDxi , J3FDyi , J3FDzi , & - J3FIxi , J3FIyi , J3FIzi , J3FMGxi , J3FMGyi , J3FMGzi , J3MAGxi , & - J3MAGyi , J3MAGzi , J3MBFxi , J3MBFyi , J3MBFzi , J3MBxi , J3MByi , & - J3MBzi , J3STAxi , J3STAyi , J3STAzi , J3STVxi , J3STVyi , J3STVzi , & - J3Vxi , J3Vyi , J3Vzi , J4Axi , J4Ayi , J4Azi , J4DynP , & - J4FAGxi , J4FAGyi , J4FAGzi , J4FAMxi , J4FAMyi , J4FAMzi , J4FBFxi , & - J4FBFyi , J4FBFzi , J4FBxi , J4FByi , J4FBzi , J4FDxi , J4FDyi , & - J4FDzi , J4FIxi , J4FIyi , J4FIzi , J4FMGxi , J4FMGyi , J4FMGzi , & - J4MAGxi , J4MAGyi , J4MAGzi , J4MBFxi , J4MBFyi , J4MBFzi , J4MBxi , & - J4MByi , J4MBzi , J4STAxi , J4STAyi , J4STAzi , J4STVxi , J4STVyi , & - J4STVzi , J4Vxi , J4Vyi , J4Vzi , J5Axi , J5Ayi , J5Azi , & - J5DynP , J5FAGxi , J5FAGyi , J5FAGzi , J5FAMxi , J5FAMyi , J5FAMzi , & - J5FBFxi , J5FBFyi , J5FBFzi , J5FBxi , J5FByi , J5FBzi , J5FDxi , & - J5FDyi , J5FDzi , J5FIxi , J5FIyi , J5FIzi , J5FMGxi , J5FMGyi , & - J5FMGzi , J5MAGxi , J5MAGyi , J5MAGzi , J5MBFxi , J5MBFyi , J5MBFzi , & - J5MBxi , J5MByi , J5MBzi , J5STAxi , J5STAyi , J5STAzi , J5STVxi , & - J5STVyi , J5STVzi , J5Vxi , J5Vyi , J5Vzi , J6Axi , J6Ayi , & - J6Azi , J6DynP , J6FAGxi , J6FAGyi , J6FAGzi , J6FAMxi , J6FAMyi , & - J6FAMzi , J6FBFxi , J6FBFyi , J6FBFzi , J6FBxi , J6FByi , J6FBzi , & - J6FDxi , J6FDyi , J6FDzi , J6FIxi , J6FIyi , J6FIzi , J6FMGxi , & - J6FMGyi , J6FMGzi , J6MAGxi , J6MAGyi , J6MAGzi , J6MBFxi , J6MBFyi , & - J6MBFzi , J6MBxi , J6MByi , J6MBzi , J6STAxi , J6STAyi , J6STAzi , & - J6STVxi , J6STVyi , J6STVzi , J6Vxi , J6Vyi , J6Vzi , J7Axi , & - J7Ayi , J7Azi , J7DynP , J7FAGxi , J7FAGyi , J7FAGzi , J7FAMxi , & - J7FAMyi , J7FAMzi , J7FBFxi , J7FBFyi , J7FBFzi , J7FBxi , J7FByi , & - J7FBzi , J7FDxi , J7FDyi , J7FDzi , J7FIxi , J7FIyi , J7FIzi , & - J7FMGxi , J7FMGyi , J7FMGzi , J7MAGxi , J7MAGyi , J7MAGzi , J7MBFxi , & - J7MBFyi , J7MBFzi , J7MBxi , J7MByi , J7MBzi , J7STAxi , J7STAyi , & - J7STAzi , J7STVxi , J7STVyi , J7STVzi , J7Vxi , J7Vyi , J7Vzi , & - J8Axi , J8Ayi , J8Azi , J8DynP , J8FAGxi , J8FAGyi , J8FAGzi , & - J8FAMxi , J8FAMyi , J8FAMzi , J8FBFxi , J8FBFyi , J8FBFzi , J8FBxi , & - J8FByi , J8FBzi , J8FDxi , J8FDyi , J8FDzi , J8FIxi , J8FIyi , & - J8FIzi , J8FMGxi , J8FMGyi , J8FMGzi , J8MAGxi , J8MAGyi , J8MAGzi , & - J8MBFxi , J8MBFyi , J8MBFzi , J8MBxi , J8MByi , J8MBzi , J8STAxi , & - J8STAyi , J8STAzi , J8STVxi , J8STVyi , J8STVzi , J8Vxi , J8Vyi , & - J8Vzi , J9Axi , J9Ayi , J9Azi , J9DynP , J9FAGxi , J9FAGyi , & - J9FAGzi , J9FAMxi , J9FAMyi , J9FAMzi , J9FBFxi , J9FBFyi , J9FBFzi , & - J9FBxi , J9FByi , J9FBzi , J9FDxi , J9FDyi , J9FDzi , J9FIxi , & - J9FIyi , J9FIzi , J9FMGxi , J9FMGyi , J9FMGzi , J9MAGxi , J9MAGyi , & - J9MAGzi , J9MBFxi , J9MBFyi , J9MBFzi , J9MBxi , J9MByi , J9MBzi , & - J9STAxi , J9STAyi , J9STAzi , J9STVxi , J9STVyi , J9STVzi , J9Vxi , & - J9Vyi , J9Vzi , M1N1Axi , M1N1Ayi , M1N1Azi , M1N1DynP , M1N1FAFxi , & - M1N1FAFyi , M1N1FAFzi , M1N1FAGxi , M1N1FAGyi , M1N1FAGzi , M1N1FAMxi , M1N1FAMyi , & - M1N1FAMzi , M1N1FBFxi , M1N1FBFyi , M1N1FBFzi , M1N1FBxi , M1N1FByi , M1N1FBzi , & - M1N1FDxi , M1N1FDyi , M1N1FDzi , M1N1FIxi , M1N1FIyi , M1N1FIzi , M1N1FMGxi , & - M1N1FMGyi , M1N1FMGzi , M1N1MAFxi , M1N1MAFyi , M1N1MAFzi , M1N1MAGxi , M1N1MAGyi , & - M1N1MAGzi , M1N1MBFxi , M1N1MBFyi , M1N1MBFzi , M1N1MBxi , M1N1MByi , M1N1MBzi , & - M1N1MMGxi , M1N1MMGyi , M1N1MMGzi , M1N1STAxi , M1N1STAyi , M1N1STAzi , M1N1STVxi , & - M1N1STVyi , M1N1STVzi , M1N1Vxi , M1N1Vyi , M1N1Vzi , M1N2Axi , M1N2Ayi , & - M1N2Azi , M1N2DynP , M1N2FAFxi , M1N2FAFyi , M1N2FAFzi , M1N2FAGxi , M1N2FAGyi , & - M1N2FAGzi , M1N2FAMxi , M1N2FAMyi , M1N2FAMzi , M1N2FBFxi , M1N2FBFyi , M1N2FBFzi , & - M1N2FBxi , M1N2FByi , M1N2FBzi , M1N2FDxi , M1N2FDyi , M1N2FDzi , M1N2FIxi , & - M1N2FIyi , M1N2FIzi , M1N2FMGxi , M1N2FMGyi , M1N2FMGzi , M1N2MAFxi , M1N2MAFyi , & - M1N2MAFzi , M1N2MAGxi , M1N2MAGyi , M1N2MAGzi , M1N2MBFxi , M1N2MBFyi , M1N2MBFzi , & - M1N2MBxi , M1N2MByi , M1N2MBzi , M1N2MMGxi , M1N2MMGyi , M1N2MMGzi , M1N2STAxi , & - M1N2STAyi , M1N2STAzi , M1N2STVxi , M1N2STVyi , M1N2STVzi , M1N2Vxi , M1N2Vyi , & - M1N2Vzi , M1N3Axi , M1N3Ayi , M1N3Azi , M1N3DynP , M1N3FAFxi , M1N3FAFyi , & - M1N3FAFzi , M1N3FAGxi , M1N3FAGyi /) - ParamIndxAry(501:1000) = (/ & - M1N3FAGzi , M1N3FAMxi , M1N3FAMyi , M1N3FAMzi , M1N3FBFxi , M1N3FBFyi , M1N3FBFzi , & - M1N3FBxi , M1N3FByi , M1N3FBzi , M1N3FDxi , M1N3FDyi , M1N3FDzi , M1N3FIxi , & - M1N3FIyi , M1N3FIzi , M1N3FMGxi , M1N3FMGyi , M1N3FMGzi , M1N3MAFxi , M1N3MAFyi , & - M1N3MAFzi , M1N3MAGxi , M1N3MAGyi , M1N3MAGzi , M1N3MBFxi , M1N3MBFyi , M1N3MBFzi , & - M1N3MBxi , M1N3MByi , M1N3MBzi , M1N3MMGxi , M1N3MMGyi , M1N3MMGzi , M1N3STAxi , & - M1N3STAyi , M1N3STAzi , M1N3STVxi , M1N3STVyi , M1N3STVzi , M1N3Vxi , M1N3Vyi , & - M1N3Vzi , M1N4Axi , M1N4Ayi , M1N4Azi , M1N4DynP , M1N4FAFxi , M1N4FAFyi , & - M1N4FAFzi , M1N4FAGxi , M1N4FAGyi , M1N4FAGzi , M1N4FAMxi , M1N4FAMyi , M1N4FAMzi , & - M1N4FBFxi , M1N4FBFyi , M1N4FBFzi , M1N4FBxi , M1N4FByi , M1N4FBzi , M1N4FDxi , & - M1N4FDyi , M1N4FDzi , M1N4FIxi , M1N4FIyi , M1N4FIzi , M1N4FMGxi , M1N4FMGyi , & - M1N4FMGzi , M1N4MAFxi , M1N4MAFyi , M1N4MAFzi , M1N4MAGxi , M1N4MAGyi , M1N4MAGzi , & - M1N4MBFxi , M1N4MBFyi , M1N4MBFzi , M1N4MBxi , M1N4MByi , M1N4MBzi , M1N4MMGxi , & - M1N4MMGyi , M1N4MMGzi , M1N4STAxi , M1N4STAyi , M1N4STAzi , M1N4STVxi , M1N4STVyi , & - M1N4STVzi , M1N4Vxi , M1N4Vyi , M1N4Vzi , M1N5Axi , M1N5Ayi , M1N5Azi , & - M1N5DynP , M1N5FAFxi , M1N5FAFyi , M1N5FAFzi , M1N5FAGxi , M1N5FAGyi , M1N5FAGzi , & - M1N5FAMxi , M1N5FAMyi , M1N5FAMzi , M1N5FBFxi , M1N5FBFyi , M1N5FBFzi , M1N5FBxi , & - M1N5FByi , M1N5FBzi , M1N5FDxi , M1N5FDyi , M1N5FDzi , M1N5FIxi , M1N5FIyi , & - M1N5FIzi , M1N5FMGxi , M1N5FMGyi , M1N5FMGzi , M1N5MAFxi , M1N5MAFyi , M1N5MAFzi , & - M1N5MAGxi , M1N5MAGyi , M1N5MAGzi , M1N5MBFxi , M1N5MBFyi , M1N5MBFzi , M1N5MBxi , & - M1N5MByi , M1N5MBzi , M1N5MMGxi , M1N5MMGyi , M1N5MMGzi , M1N5STAxi , M1N5STAyi , & - M1N5STAzi , M1N5STVxi , M1N5STVyi , M1N5STVzi , M1N5Vxi , M1N5Vyi , M1N5Vzi , & - M1N6Axi , M1N6Ayi , M1N6Azi , M1N6DynP , M1N6FAFxi , M1N6FAFyi , M1N6FAFzi , & - M1N6FAGxi , M1N6FAGyi , M1N6FAGzi , M1N6FAMxi , M1N6FAMyi , M1N6FAMzi , M1N6FBFxi , & - M1N6FBFyi , M1N6FBFzi , M1N6FBxi , M1N6FByi , M1N6FBzi , M1N6FDxi , M1N6FDyi , & - M1N6FDzi , M1N6FIxi , M1N6FIyi , M1N6FIzi , M1N6FMGxi , M1N6FMGyi , M1N6FMGzi , & - M1N6MAFxi , M1N6MAFyi , M1N6MAFzi , M1N6MAGxi , M1N6MAGyi , M1N6MAGzi , M1N6MBFxi , & - M1N6MBFyi , M1N6MBFzi , M1N6MBxi , M1N6MByi , M1N6MBzi , M1N6MMGxi , M1N6MMGyi , & - M1N6MMGzi , M1N6STAxi , M1N6STAyi , M1N6STAzi , M1N6STVxi , M1N6STVyi , M1N6STVzi , & - M1N6Vxi , M1N6Vyi , M1N6Vzi , M1N7Axi , M1N7Ayi , M1N7Azi , M1N7DynP , & - M1N7FAFxi , M1N7FAFyi , M1N7FAFzi , M1N7FAGxi , M1N7FAGyi , M1N7FAGzi , M1N7FAMxi , & - M1N7FAMyi , M1N7FAMzi , M1N7FBFxi , M1N7FBFyi , M1N7FBFzi , M1N7FBxi , M1N7FByi , & - M1N7FBzi , M1N7FDxi , M1N7FDyi , M1N7FDzi , M1N7FIxi , M1N7FIyi , M1N7FIzi , & - M1N7FMGxi , M1N7FMGyi , M1N7FMGzi , M1N7MAFxi , M1N7MAFyi , M1N7MAFzi , M1N7MAGxi , & - M1N7MAGyi , M1N7MAGzi , M1N7MBFxi , M1N7MBFyi , M1N7MBFzi , M1N7MBxi , M1N7MByi , & - M1N7MBzi , M1N7MMGxi , M1N7MMGyi , M1N7MMGzi , M1N7STAxi , M1N7STAyi , M1N7STAzi , & - M1N7STVxi , M1N7STVyi , M1N7STVzi , M1N7Vxi , M1N7Vyi , M1N7Vzi , M1N8Axi , & - M1N8Ayi , M1N8Azi , M1N8DynP , M1N8FAFxi , M1N8FAFyi , M1N8FAFzi , M1N8FAGxi , & - M1N8FAGyi , M1N8FAGzi , M1N8FAMxi , M1N8FAMyi , M1N8FAMzi , M1N8FBFxi , M1N8FBFyi , & - M1N8FBFzi , M1N8FBxi , M1N8FByi , M1N8FBzi , M1N8FDxi , M1N8FDyi , M1N8FDzi , & - M1N8FIxi , M1N8FIyi , M1N8FIzi , M1N8FMGxi , M1N8FMGyi , M1N8FMGzi , M1N8MAFxi , & - M1N8MAFyi , M1N8MAFzi , M1N8MAGxi , M1N8MAGyi , M1N8MAGzi , M1N8MBFxi , M1N8MBFyi , & - M1N8MBFzi , M1N8MBxi , M1N8MByi , M1N8MBzi , M1N8MMGxi , M1N8MMGyi , M1N8MMGzi , & - M1N8STAxi , M1N8STAyi , M1N8STAzi , M1N8STVxi , M1N8STVyi , M1N8STVzi , M1N8Vxi , & - M1N8Vyi , M1N8Vzi , M1N9Axi , M1N9Ayi , M1N9Azi , M1N9DynP , M1N9FAFxi , & - M1N9FAFyi , M1N9FAFzi , M1N9FAGxi , M1N9FAGyi , M1N9FAGzi , M1N9FAMxi , M1N9FAMyi , & - M1N9FAMzi , M1N9FBFxi , M1N9FBFyi , M1N9FBFzi , M1N9FBxi , M1N9FByi , M1N9FBzi , & - M1N9FDxi , M1N9FDyi , M1N9FDzi , M1N9FIxi , M1N9FIyi , M1N9FIzi , M1N9FMGxi , & - M1N9FMGyi , M1N9FMGzi , M1N9MAFxi , M1N9MAFyi , M1N9MAFzi , M1N9MAGxi , M1N9MAGyi , & - M1N9MAGzi , M1N9MBFxi , M1N9MBFyi , M1N9MBFzi , M1N9MBxi , M1N9MByi , M1N9MBzi , & - M1N9MMGxi , M1N9MMGyi , M1N9MMGzi , M1N9STAxi , M1N9STAyi , M1N9STAzi , M1N9STVxi , & - M1N9STVyi , M1N9STVzi , M1N9Vxi , M1N9Vyi , M1N9Vzi , M2N1Axi , M2N1Ayi , & - M2N1Azi , M2N1DynP , M2N1FAFxi , M2N1FAFyi , M2N1FAFzi , M2N1FAGxi , M2N1FAGyi , & - M2N1FAGzi , M2N1FAMxi , M2N1FAMyi , M2N1FAMzi , M2N1FBFxi , M2N1FBFyi , M2N1FBFzi , & - M2N1FBxi , M2N1FByi , M2N1FBzi , M2N1FDxi , M2N1FDyi , M2N1FDzi , M2N1FIxi , & - M2N1FIyi , M2N1FIzi , M2N1FMGxi , M2N1FMGyi , M2N1FMGzi , M2N1MAFxi , M2N1MAFyi , & - M2N1MAFzi , M2N1MAGxi , M2N1MAGyi , M2N1MAGzi , M2N1MBFxi , M2N1MBFyi , M2N1MBFzi , & - M2N1MBxi , M2N1MByi , M2N1MBzi , M2N1MMGxi , M2N1MMGyi , M2N1MMGzi , M2N1STAxi , & - M2N1STAyi , M2N1STAzi , M2N1STVxi , M2N1STVyi , M2N1STVzi , M2N1Vxi , M2N1Vyi , & - M2N1Vzi , M2N2Axi , M2N2Ayi , M2N2Azi , M2N2DynP , M2N2FAFxi , M2N2FAFyi , & - M2N2FAFzi , M2N2FAGxi , M2N2FAGyi , M2N2FAGzi , M2N2FAMxi , M2N2FAMyi , M2N2FAMzi , & - M2N2FBFxi , M2N2FBFyi , M2N2FBFzi , M2N2FBxi , M2N2FByi , M2N2FBzi , M2N2FDxi , & - M2N2FDyi , M2N2FDzi , M2N2FIxi , M2N2FIyi , M2N2FIzi , M2N2FMGxi , M2N2FMGyi , & - M2N2FMGzi , M2N2MAFxi , M2N2MAFyi , M2N2MAFzi , M2N2MAGxi , M2N2MAGyi , M2N2MAGzi , & - M2N2MBFxi , M2N2MBFyi , M2N2MBFzi , M2N2MBxi , M2N2MByi , M2N2MBzi , M2N2MMGxi , & - M2N2MMGyi , M2N2MMGzi , M2N2STAxi , M2N2STAyi , M2N2STAzi , M2N2STVxi , M2N2STVyi , & - M2N2STVzi , M2N2Vxi , M2N2Vyi , M2N2Vzi , M2N3Axi , M2N3Ayi , M2N3Azi , & - M2N3DynP , M2N3FAFxi , M2N3FAFyi , M2N3FAFzi , M2N3FAGxi , M2N3FAGyi , M2N3FAGzi , & - M2N3FAMxi , M2N3FAMyi , M2N3FAMzi , M2N3FBFxi , M2N3FBFyi , M2N3FBFzi , M2N3FBxi , & - M2N3FByi , M2N3FBzi , M2N3FDxi , M2N3FDyi , M2N3FDzi , M2N3FIxi , M2N3FIyi , & - M2N3FIzi , M2N3FMGxi , M2N3FMGyi , M2N3FMGzi , M2N3MAFxi , M2N3MAFyi , M2N3MAFzi , & - M2N3MAGxi , M2N3MAGyi , M2N3MAGzi , M2N3MBFxi , M2N3MBFyi , M2N3MBFzi , M2N3MBxi , & - M2N3MByi , M2N3MBzi , M2N3MMGxi /) - ParamIndxAry(1001:1500) = (/ & - M2N3MMGyi , M2N3MMGzi , M2N3STAxi , M2N3STAyi , M2N3STAzi , M2N3STVxi , M2N3STVyi , & - M2N3STVzi , M2N3Vxi , M2N3Vyi , M2N3Vzi , M2N4Axi , M2N4Ayi , M2N4Azi , & - M2N4DynP , M2N4FAFxi , M2N4FAFyi , M2N4FAFzi , M2N4FAGxi , M2N4FAGyi , M2N4FAGzi , & - M2N4FAMxi , M2N4FAMyi , M2N4FAMzi , M2N4FBFxi , M2N4FBFyi , M2N4FBFzi , M2N4FBxi , & - M2N4FByi , M2N4FBzi , M2N4FDxi , M2N4FDyi , M2N4FDzi , M2N4FIxi , M2N4FIyi , & - M2N4FIzi , M2N4FMGxi , M2N4FMGyi , M2N4FMGzi , M2N4MAFxi , M2N4MAFyi , M2N4MAFzi , & - M2N4MAGxi , M2N4MAGyi , M2N4MAGzi , M2N4MBFxi , M2N4MBFyi , M2N4MBFzi , M2N4MBxi , & - M2N4MByi , M2N4MBzi , M2N4MMGxi , M2N4MMGyi , M2N4MMGzi , M2N4STAxi , M2N4STAyi , & - M2N4STAzi , M2N4STVxi , M2N4STVyi , M2N4STVzi , M2N4Vxi , M2N4Vyi , M2N4Vzi , & - M2N5Axi , M2N5Ayi , M2N5Azi , M2N5DynP , M2N5FAFxi , M2N5FAFyi , M2N5FAFzi , & - M2N5FAGxi , M2N5FAGyi , M2N5FAGzi , M2N5FAMxi , M2N5FAMyi , M2N5FAMzi , M2N5FBFxi , & - M2N5FBFyi , M2N5FBFzi , M2N5FBxi , M2N5FByi , M2N5FBzi , M2N5FDxi , M2N5FDyi , & - M2N5FDzi , M2N5FIxi , M2N5FIyi , M2N5FIzi , M2N5FMGxi , M2N5FMGyi , M2N5FMGzi , & - M2N5MAFxi , M2N5MAFyi , M2N5MAFzi , M2N5MAGxi , M2N5MAGyi , M2N5MAGzi , M2N5MBFxi , & - M2N5MBFyi , M2N5MBFzi , M2N5MBxi , M2N5MByi , M2N5MBzi , M2N5MMGxi , M2N5MMGyi , & - M2N5MMGzi , M2N5STAxi , M2N5STAyi , M2N5STAzi , M2N5STVxi , M2N5STVyi , M2N5STVzi , & - M2N5Vxi , M2N5Vyi , M2N5Vzi , M2N6Axi , M2N6Ayi , M2N6Azi , M2N6DynP , & - M2N6FAFxi , M2N6FAFyi , M2N6FAFzi , M2N6FAGxi , M2N6FAGyi , M2N6FAGzi , M2N6FAMxi , & - M2N6FAMyi , M2N6FAMzi , M2N6FBFxi , M2N6FBFyi , M2N6FBFzi , M2N6FBxi , M2N6FByi , & - M2N6FBzi , M2N6FDxi , M2N6FDyi , M2N6FDzi , M2N6FIxi , M2N6FIyi , M2N6FIzi , & - M2N6FMGxi , M2N6FMGyi , M2N6FMGzi , M2N6MAFxi , M2N6MAFyi , M2N6MAFzi , M2N6MAGxi , & - M2N6MAGyi , M2N6MAGzi , M2N6MBFxi , M2N6MBFyi , M2N6MBFzi , M2N6MBxi , M2N6MByi , & - M2N6MBzi , M2N6MMGxi , M2N6MMGyi , M2N6MMGzi , M2N6STAxi , M2N6STAyi , M2N6STAzi , & - M2N6STVxi , M2N6STVyi , M2N6STVzi , M2N6Vxi , M2N6Vyi , M2N6Vzi , M2N7Axi , & - M2N7Ayi , M2N7Azi , M2N7DynP , M2N7FAFxi , M2N7FAFyi , M2N7FAFzi , M2N7FAGxi , & - M2N7FAGyi , M2N7FAGzi , M2N7FAMxi , M2N7FAMyi , M2N7FAMzi , M2N7FBFxi , M2N7FBFyi , & - M2N7FBFzi , M2N7FBxi , M2N7FByi , M2N7FBzi , M2N7FDxi , M2N7FDyi , M2N7FDzi , & - M2N7FIxi , M2N7FIyi , M2N7FIzi , M2N7FMGxi , M2N7FMGyi , M2N7FMGzi , M2N7MAFxi , & - M2N7MAFyi , M2N7MAFzi , M2N7MAGxi , M2N7MAGyi , M2N7MAGzi , M2N7MBFxi , M2N7MBFyi , & - M2N7MBFzi , M2N7MBxi , M2N7MByi , M2N7MBzi , M2N7MMGxi , M2N7MMGyi , M2N7MMGzi , & - M2N7STAxi , M2N7STAyi , M2N7STAzi , M2N7STVxi , M2N7STVyi , M2N7STVzi , M2N7Vxi , & - M2N7Vyi , M2N7Vzi , M2N8Axi , M2N8Ayi , M2N8Azi , M2N8DynP , M2N8FAFxi , & - M2N8FAFyi , M2N8FAFzi , M2N8FAGxi , M2N8FAGyi , M2N8FAGzi , M2N8FAMxi , M2N8FAMyi , & - M2N8FAMzi , M2N8FBFxi , M2N8FBFyi , M2N8FBFzi , M2N8FBxi , M2N8FByi , M2N8FBzi , & - M2N8FDxi , M2N8FDyi , M2N8FDzi , M2N8FIxi , M2N8FIyi , M2N8FIzi , M2N8FMGxi , & - M2N8FMGyi , M2N8FMGzi , M2N8MAFxi , M2N8MAFyi , M2N8MAFzi , M2N8MAGxi , M2N8MAGyi , & - M2N8MAGzi , M2N8MBFxi , M2N8MBFyi , M2N8MBFzi , M2N8MBxi , M2N8MByi , M2N8MBzi , & - M2N8MMGxi , M2N8MMGyi , M2N8MMGzi , M2N8STAxi , M2N8STAyi , M2N8STAzi , M2N8STVxi , & - M2N8STVyi , M2N8STVzi , M2N8Vxi , M2N8Vyi , M2N8Vzi , M2N9Axi , M2N9Ayi , & - M2N9Azi , M2N9DynP , M2N9FAFxi , M2N9FAFyi , M2N9FAFzi , M2N9FAGxi , M2N9FAGyi , & - M2N9FAGzi , M2N9FAMxi , M2N9FAMyi , M2N9FAMzi , M2N9FBFxi , M2N9FBFyi , M2N9FBFzi , & - M2N9FBxi , M2N9FByi , M2N9FBzi , M2N9FDxi , M2N9FDyi , M2N9FDzi , M2N9FIxi , & - M2N9FIyi , M2N9FIzi , M2N9FMGxi , M2N9FMGyi , M2N9FMGzi , M2N9MAFxi , M2N9MAFyi , & - M2N9MAFzi , M2N9MAGxi , M2N9MAGyi , M2N9MAGzi , M2N9MBFxi , M2N9MBFyi , M2N9MBFzi , & - M2N9MBxi , M2N9MByi , M2N9MBzi , M2N9MMGxi , M2N9MMGyi , M2N9MMGzi , M2N9STAxi , & - M2N9STAyi , M2N9STAzi , M2N9STVxi , M2N9STVyi , M2N9STVzi , M2N9Vxi , M2N9Vyi , & - M2N9Vzi , M3N1Axi , M3N1Ayi , M3N1Azi , M3N1DynP , M3N1FAFxi , M3N1FAFyi , & - M3N1FAFzi , M3N1FAGxi , M3N1FAGyi , M3N1FAGzi , M3N1FAMxi , M3N1FAMyi , M3N1FAMzi , & - M3N1FBFxi , M3N1FBFyi , M3N1FBFzi , M3N1FBxi , M3N1FByi , M3N1FBzi , M3N1FDxi , & - M3N1FDyi , M3N1FDzi , M3N1FIxi , M3N1FIyi , M3N1FIzi , M3N1FMGxi , M3N1FMGyi , & - M3N1FMGzi , M3N1MAFxi , M3N1MAFyi , M3N1MAFzi , M3N1MAGxi , M3N1MAGyi , M3N1MAGzi , & - M3N1MBFxi , M3N1MBFyi , M3N1MBFzi , M3N1MBxi , M3N1MByi , M3N1MBzi , M3N1MMGxi , & - M3N1MMGyi , M3N1MMGzi , M3N1STAxi , M3N1STAyi , M3N1STAzi , M3N1STVxi , M3N1STVyi , & - M3N1STVzi , M3N1Vxi , M3N1Vyi , M3N1Vzi , M3N2Axi , M3N2Ayi , M3N2Azi , & - M3N2DynP , M3N2FAFxi , M3N2FAFyi , M3N2FAFzi , M3N2FAGxi , M3N2FAGyi , M3N2FAGzi , & - M3N2FAMxi , M3N2FAMyi , M3N2FAMzi , M3N2FBFxi , M3N2FBFyi , M3N2FBFzi , M3N2FBxi , & - M3N2FByi , M3N2FBzi , M3N2FDxi , M3N2FDyi , M3N2FDzi , M3N2FIxi , M3N2FIyi , & - M3N2FIzi , M3N2FMGxi , M3N2FMGyi , M3N2FMGzi , M3N2MAFxi , M3N2MAFyi , M3N2MAFzi , & - M3N2MAGxi , M3N2MAGyi , M3N2MAGzi , M3N2MBFxi , M3N2MBFyi , M3N2MBFzi , M3N2MBxi , & - M3N2MByi , M3N2MBzi , M3N2MMGxi , M3N2MMGyi , M3N2MMGzi , M3N2STAxi , M3N2STAyi , & - M3N2STAzi , M3N2STVxi , M3N2STVyi , M3N2STVzi , M3N2Vxi , M3N2Vyi , M3N2Vzi , & - M3N3Axi , M3N3Ayi , M3N3Azi , M3N3DynP , M3N3FAFxi , M3N3FAFyi , M3N3FAFzi , & - M3N3FAGxi , M3N3FAGyi , M3N3FAGzi , M3N3FAMxi , M3N3FAMyi , M3N3FAMzi , M3N3FBFxi , & - M3N3FBFyi , M3N3FBFzi , M3N3FBxi , M3N3FByi , M3N3FBzi , M3N3FDxi , M3N3FDyi , & - M3N3FDzi , M3N3FIxi , M3N3FIyi , M3N3FIzi , M3N3FMGxi , M3N3FMGyi , M3N3FMGzi , & - M3N3MAFxi , M3N3MAFyi , M3N3MAFzi , M3N3MAGxi , M3N3MAGyi , M3N3MAGzi , M3N3MBFxi , & - M3N3MBFyi , M3N3MBFzi , M3N3MBxi , M3N3MByi , M3N3MBzi , M3N3MMGxi , M3N3MMGyi , & - M3N3MMGzi , M3N3STAxi , M3N3STAyi , M3N3STAzi , M3N3STVxi , M3N3STVyi , M3N3STVzi , & - M3N3Vxi , M3N3Vyi , M3N3Vzi , M3N4Axi , M3N4Ayi , M3N4Azi , M3N4DynP , & - M3N4FAFxi , M3N4FAFyi , M3N4FAFzi , M3N4FAGxi , M3N4FAGyi , M3N4FAGzi , M3N4FAMxi , & - M3N4FAMyi , M3N4FAMzi , M3N4FBFxi , M3N4FBFyi , M3N4FBFzi , M3N4FBxi , M3N4FByi , & - M3N4FBzi , M3N4FDxi , M3N4FDyi /) - ParamIndxAry(1501:2000) = (/ & - M3N4FDzi , M3N4FIxi , M3N4FIyi , M3N4FIzi , M3N4FMGxi , M3N4FMGyi , M3N4FMGzi , & - M3N4MAFxi , M3N4MAFyi , M3N4MAFzi , M3N4MAGxi , M3N4MAGyi , M3N4MAGzi , M3N4MBFxi , & - M3N4MBFyi , M3N4MBFzi , M3N4MBxi , M3N4MByi , M3N4MBzi , M3N4MMGxi , M3N4MMGyi , & - M3N4MMGzi , M3N4STAxi , M3N4STAyi , M3N4STAzi , M3N4STVxi , M3N4STVyi , M3N4STVzi , & - M3N4Vxi , M3N4Vyi , M3N4Vzi , M3N5Axi , M3N5Ayi , M3N5Azi , M3N5DynP , & - M3N5FAFxi , M3N5FAFyi , M3N5FAFzi , M3N5FAGxi , M3N5FAGyi , M3N5FAGzi , M3N5FAMxi , & - M3N5FAMyi , M3N5FAMzi , M3N5FBFxi , M3N5FBFyi , M3N5FBFzi , M3N5FBxi , M3N5FByi , & - M3N5FBzi , M3N5FDxi , M3N5FDyi , M3N5FDzi , M3N5FIxi , M3N5FIyi , M3N5FIzi , & - M3N5FMGxi , M3N5FMGyi , M3N5FMGzi , M3N5MAFxi , M3N5MAFyi , M3N5MAFzi , M3N5MAGxi , & - M3N5MAGyi , M3N5MAGzi , M3N5MBFxi , M3N5MBFyi , M3N5MBFzi , M3N5MBxi , M3N5MByi , & - M3N5MBzi , M3N5MMGxi , M3N5MMGyi , M3N5MMGzi , M3N5STAxi , M3N5STAyi , M3N5STAzi , & - M3N5STVxi , M3N5STVyi , M3N5STVzi , M3N5Vxi , M3N5Vyi , M3N5Vzi , M3N6Axi , & - M3N6Ayi , M3N6Azi , M3N6DynP , M3N6FAFxi , M3N6FAFyi , M3N6FAFzi , M3N6FAGxi , & - M3N6FAGyi , M3N6FAGzi , M3N6FAMxi , M3N6FAMyi , M3N6FAMzi , M3N6FBFxi , M3N6FBFyi , & - M3N6FBFzi , M3N6FBxi , M3N6FByi , M3N6FBzi , M3N6FDxi , M3N6FDyi , M3N6FDzi , & - M3N6FIxi , M3N6FIyi , M3N6FIzi , M3N6FMGxi , M3N6FMGyi , M3N6FMGzi , M3N6MAFxi , & - M3N6MAFyi , M3N6MAFzi , M3N6MAGxi , M3N6MAGyi , M3N6MAGzi , M3N6MBFxi , M3N6MBFyi , & - M3N6MBFzi , M3N6MBxi , M3N6MByi , M3N6MBzi , M3N6MMGxi , M3N6MMGyi , M3N6MMGzi , & - M3N6STAxi , M3N6STAyi , M3N6STAzi , M3N6STVxi , M3N6STVyi , M3N6STVzi , M3N6Vxi , & - M3N6Vyi , M3N6Vzi , M3N7Axi , M3N7Ayi , M3N7Azi , M3N7DynP , M3N7FAFxi , & - M3N7FAFyi , M3N7FAFzi , M3N7FAGxi , M3N7FAGyi , M3N7FAGzi , M3N7FAMxi , M3N7FAMyi , & - M3N7FAMzi , M3N7FBFxi , M3N7FBFyi , M3N7FBFzi , M3N7FBxi , M3N7FByi , M3N7FBzi , & - M3N7FDxi , M3N7FDyi , M3N7FDzi , M3N7FIxi , M3N7FIyi , M3N7FIzi , M3N7FMGxi , & - M3N7FMGyi , M3N7FMGzi , M3N7MAFxi , M3N7MAFyi , M3N7MAFzi , M3N7MAGxi , M3N7MAGyi , & - M3N7MAGzi , M3N7MBFxi , M3N7MBFyi , M3N7MBFzi , M3N7MBxi , M3N7MByi , M3N7MBzi , & - M3N7MMGxi , M3N7MMGyi , M3N7MMGzi , M3N7STAxi , M3N7STAyi , M3N7STAzi , M3N7STVxi , & - M3N7STVyi , M3N7STVzi , M3N7Vxi , M3N7Vyi , M3N7Vzi , M3N8Axi , M3N8Ayi , & - M3N8Azi , M3N8DynP , M3N8FAFxi , M3N8FAFyi , M3N8FAFzi , M3N8FAGxi , M3N8FAGyi , & - M3N8FAGzi , M3N8FAMxi , M3N8FAMyi , M3N8FAMzi , M3N8FBFxi , M3N8FBFyi , M3N8FBFzi , & - M3N8FBxi , M3N8FByi , M3N8FBzi , M3N8FDxi , M3N8FDyi , M3N8FDzi , M3N8FIxi , & - M3N8FIyi , M3N8FIzi , M3N8FMGxi , M3N8FMGyi , M3N8FMGzi , M3N8MAFxi , M3N8MAFyi , & - M3N8MAFzi , M3N8MAGxi , M3N8MAGyi , M3N8MAGzi , M3N8MBFxi , M3N8MBFyi , M3N8MBFzi , & - M3N8MBxi , M3N8MByi , M3N8MBzi , M3N8MMGxi , M3N8MMGyi , M3N8MMGzi , M3N8STAxi , & - M3N8STAyi , M3N8STAzi , M3N8STVxi , M3N8STVyi , M3N8STVzi , M3N8Vxi , M3N8Vyi , & - M3N8Vzi , M3N9Axi , M3N9Ayi , M3N9Azi , M3N9DynP , M3N9FAFxi , M3N9FAFyi , & - M3N9FAFzi , M3N9FAGxi , M3N9FAGyi , M3N9FAGzi , M3N9FAMxi , M3N9FAMyi , M3N9FAMzi , & - M3N9FBFxi , M3N9FBFyi , M3N9FBFzi , M3N9FBxi , M3N9FByi , M3N9FBzi , M3N9FDxi , & - M3N9FDyi , M3N9FDzi , M3N9FIxi , M3N9FIyi , M3N9FIzi , M3N9FMGxi , M3N9FMGyi , & - M3N9FMGzi , M3N9MAFxi , M3N9MAFyi , M3N9MAFzi , M3N9MAGxi , M3N9MAGyi , M3N9MAGzi , & - M3N9MBFxi , M3N9MBFyi , M3N9MBFzi , M3N9MBxi , M3N9MByi , M3N9MBzi , M3N9MMGxi , & - M3N9MMGyi , M3N9MMGzi , M3N9STAxi , M3N9STAyi , M3N9STAzi , M3N9STVxi , M3N9STVyi , & - M3N9STVzi , M3N9Vxi , M3N9Vyi , M3N9Vzi , M4N1Axi , M4N1Ayi , M4N1Azi , & - M4N1DynP , M4N1FAFxi , M4N1FAFyi , M4N1FAFzi , M4N1FAGxi , M4N1FAGyi , M4N1FAGzi , & - M4N1FAMxi , M4N1FAMyi , M4N1FAMzi , M4N1FBFxi , M4N1FBFyi , M4N1FBFzi , M4N1FBxi , & - M4N1FByi , M4N1FBzi , M4N1FDxi , M4N1FDyi , M4N1FDzi , M4N1FIxi , M4N1FIyi , & - M4N1FIzi , M4N1FMGxi , M4N1FMGyi , M4N1FMGzi , M4N1MAFxi , M4N1MAFyi , M4N1MAFzi , & - M4N1MAGxi , M4N1MAGyi , M4N1MAGzi , M4N1MBFxi , M4N1MBFyi , M4N1MBFzi , M4N1MBxi , & - M4N1MByi , M4N1MBzi , M4N1MMGxi , M4N1MMGyi , M4N1MMGzi , M4N1STAxi , M4N1STAyi , & - M4N1STAzi , M4N1STVxi , M4N1STVyi , M4N1STVzi , M4N1Vxi , M4N1Vyi , M4N1Vzi , & - M4N2Axi , M4N2Ayi , M4N2Azi , M4N2DynP , M4N2FAFxi , M4N2FAFyi , M4N2FAFzi , & - M4N2FAGxi , M4N2FAGyi , M4N2FAGzi , M4N2FAMxi , M4N2FAMyi , M4N2FAMzi , M4N2FBFxi , & - M4N2FBFyi , M4N2FBFzi , M4N2FBxi , M4N2FByi , M4N2FBzi , M4N2FDxi , M4N2FDyi , & - M4N2FDzi , M4N2FIxi , M4N2FIyi , M4N2FIzi , M4N2FMGxi , M4N2FMGyi , M4N2FMGzi , & - M4N2MAFxi , M4N2MAFyi , M4N2MAFzi , M4N2MAGxi , M4N2MAGyi , M4N2MAGzi , M4N2MBFxi , & - M4N2MBFyi , M4N2MBFzi , M4N2MBxi , M4N2MByi , M4N2MBzi , M4N2MMGxi , M4N2MMGyi , & - M4N2MMGzi , M4N2STAxi , M4N2STAyi , M4N2STAzi , M4N2STVxi , M4N2STVyi , M4N2STVzi , & - M4N2Vxi , M4N2Vyi , M4N2Vzi , M4N3Axi , M4N3Ayi , M4N3Azi , M4N3DynP , & - M4N3FAFxi , M4N3FAFyi , M4N3FAFzi , M4N3FAGxi , M4N3FAGyi , M4N3FAGzi , M4N3FAMxi , & - M4N3FAMyi , M4N3FAMzi , M4N3FBFxi , M4N3FBFyi , M4N3FBFzi , M4N3FBxi , M4N3FByi , & - M4N3FBzi , M4N3FDxi , M4N3FDyi , M4N3FDzi , M4N3FIxi , M4N3FIyi , M4N3FIzi , & - M4N3FMGxi , M4N3FMGyi , M4N3FMGzi , M4N3MAFxi , M4N3MAFyi , M4N3MAFzi , M4N3MAGxi , & - M4N3MAGyi , M4N3MAGzi , M4N3MBFxi , M4N3MBFyi , M4N3MBFzi , M4N3MBxi , M4N3MByi , & - M4N3MBzi , M4N3MMGxi , M4N3MMGyi , M4N3MMGzi , M4N3STAxi , M4N3STAyi , M4N3STAzi , & - M4N3STVxi , M4N3STVyi , M4N3STVzi , M4N3Vxi , M4N3Vyi , M4N3Vzi , M4N4Axi , & - M4N4Ayi , M4N4Azi , M4N4DynP , M4N4FAFxi , M4N4FAFyi , M4N4FAFzi , M4N4FAGxi , & - M4N4FAGyi , M4N4FAGzi , M4N4FAMxi , M4N4FAMyi , M4N4FAMzi , M4N4FBFxi , M4N4FBFyi , & - M4N4FBFzi , M4N4FBxi , M4N4FByi , M4N4FBzi , M4N4FDxi , M4N4FDyi , M4N4FDzi , & - M4N4FIxi , M4N4FIyi , M4N4FIzi , M4N4FMGxi , M4N4FMGyi , M4N4FMGzi , M4N4MAFxi , & - M4N4MAFyi , M4N4MAFzi , M4N4MAGxi , M4N4MAGyi , M4N4MAGzi , M4N4MBFxi , M4N4MBFyi , & - M4N4MBFzi , M4N4MBxi , M4N4MByi , M4N4MBzi , M4N4MMGxi , M4N4MMGyi , M4N4MMGzi , & - M4N4STAxi , M4N4STAyi , M4N4STAzi , M4N4STVxi , M4N4STVyi , M4N4STVzi , M4N4Vxi , & - M4N4Vyi , M4N4Vzi , M4N5Axi /) - ParamIndxAry(2001:2500) = (/ & - M4N5Ayi , M4N5Azi , M4N5DynP , M4N5FAFxi , M4N5FAFyi , M4N5FAFzi , M4N5FAGxi , & - M4N5FAGyi , M4N5FAGzi , M4N5FAMxi , M4N5FAMyi , M4N5FAMzi , M4N5FBFxi , M4N5FBFyi , & - M4N5FBFzi , M4N5FBxi , M4N5FByi , M4N5FBzi , M4N5FDxi , M4N5FDyi , M4N5FDzi , & - M4N5FIxi , M4N5FIyi , M4N5FIzi , M4N5FMGxi , M4N5FMGyi , M4N5FMGzi , M4N5MAFxi , & - M4N5MAFyi , M4N5MAFzi , M4N5MAGxi , M4N5MAGyi , M4N5MAGzi , M4N5MBFxi , M4N5MBFyi , & - M4N5MBFzi , M4N5MBxi , M4N5MByi , M4N5MBzi , M4N5MMGxi , M4N5MMGyi , M4N5MMGzi , & - M4N5STAxi , M4N5STAyi , M4N5STAzi , M4N5STVxi , M4N5STVyi , M4N5STVzi , M4N5Vxi , & - M4N5Vyi , M4N5Vzi , M4N6Axi , M4N6Ayi , M4N6Azi , M4N6DynP , M4N6FAFxi , & - M4N6FAFyi , M4N6FAFzi , M4N6FAGxi , M4N6FAGyi , M4N6FAGzi , M4N6FAMxi , M4N6FAMyi , & - M4N6FAMzi , M4N6FBFxi , M4N6FBFyi , M4N6FBFzi , M4N6FBxi , M4N6FByi , M4N6FBzi , & - M4N6FDxi , M4N6FDyi , M4N6FDzi , M4N6FIxi , M4N6FIyi , M4N6FIzi , M4N6FMGxi , & - M4N6FMGyi , M4N6FMGzi , M4N6MAFxi , M4N6MAFyi , M4N6MAFzi , M4N6MAGxi , M4N6MAGyi , & - M4N6MAGzi , M4N6MBFxi , M4N6MBFyi , M4N6MBFzi , M4N6MBxi , M4N6MByi , M4N6MBzi , & - M4N6MMGxi , M4N6MMGyi , M4N6MMGzi , M4N6STAxi , M4N6STAyi , M4N6STAzi , M4N6STVxi , & - M4N6STVyi , M4N6STVzi , M4N6Vxi , M4N6Vyi , M4N6Vzi , M4N7Axi , M4N7Ayi , & - M4N7Azi , M4N7DynP , M4N7FAFxi , M4N7FAFyi , M4N7FAFzi , M4N7FAGxi , M4N7FAGyi , & - M4N7FAGzi , M4N7FAMxi , M4N7FAMyi , M4N7FAMzi , M4N7FBFxi , M4N7FBFyi , M4N7FBFzi , & - M4N7FBxi , M4N7FByi , M4N7FBzi , M4N7FDxi , M4N7FDyi , M4N7FDzi , M4N7FIxi , & - M4N7FIyi , M4N7FIzi , M4N7FMGxi , M4N7FMGyi , M4N7FMGzi , M4N7MAFxi , M4N7MAFyi , & - M4N7MAFzi , M4N7MAGxi , M4N7MAGyi , M4N7MAGzi , M4N7MBFxi , M4N7MBFyi , M4N7MBFzi , & - M4N7MBxi , M4N7MByi , M4N7MBzi , M4N7MMGxi , M4N7MMGyi , M4N7MMGzi , M4N7STAxi , & - M4N7STAyi , M4N7STAzi , M4N7STVxi , M4N7STVyi , M4N7STVzi , M4N7Vxi , M4N7Vyi , & - M4N7Vzi , M4N8Axi , M4N8Ayi , M4N8Azi , M4N8DynP , M4N8FAFxi , M4N8FAFyi , & - M4N8FAFzi , M4N8FAGxi , M4N8FAGyi , M4N8FAGzi , M4N8FAMxi , M4N8FAMyi , M4N8FAMzi , & - M4N8FBFxi , M4N8FBFyi , M4N8FBFzi , M4N8FBxi , M4N8FByi , M4N8FBzi , M4N8FDxi , & - M4N8FDyi , M4N8FDzi , M4N8FIxi , M4N8FIyi , M4N8FIzi , M4N8FMGxi , M4N8FMGyi , & - M4N8FMGzi , M4N8MAFxi , M4N8MAFyi , M4N8MAFzi , M4N8MAGxi , M4N8MAGyi , M4N8MAGzi , & - M4N8MBFxi , M4N8MBFyi , M4N8MBFzi , M4N8MBxi , M4N8MByi , M4N8MBzi , M4N8MMGxi , & - M4N8MMGyi , M4N8MMGzi , M4N8STAxi , M4N8STAyi , M4N8STAzi , M4N8STVxi , M4N8STVyi , & - M4N8STVzi , M4N8Vxi , M4N8Vyi , M4N8Vzi , M4N9Axi , M4N9Ayi , M4N9Azi , & - M4N9DynP , M4N9FAFxi , M4N9FAFyi , M4N9FAFzi , M4N9FAGxi , M4N9FAGyi , M4N9FAGzi , & - M4N9FAMxi , M4N9FAMyi , M4N9FAMzi , M4N9FBFxi , M4N9FBFyi , M4N9FBFzi , M4N9FBxi , & - M4N9FByi , M4N9FBzi , M4N9FDxi , M4N9FDyi , M4N9FDzi , M4N9FIxi , M4N9FIyi , & - M4N9FIzi , M4N9FMGxi , M4N9FMGyi , M4N9FMGzi , M4N9MAFxi , M4N9MAFyi , M4N9MAFzi , & - M4N9MAGxi , M4N9MAGyi , M4N9MAGzi , M4N9MBFxi , M4N9MBFyi , M4N9MBFzi , M4N9MBxi , & - M4N9MByi , M4N9MBzi , M4N9MMGxi , M4N9MMGyi , M4N9MMGzi , M4N9STAxi , M4N9STAyi , & - M4N9STAzi , M4N9STVxi , M4N9STVyi , M4N9STVzi , M4N9Vxi , M4N9Vyi , M4N9Vzi , & - M5N1Axi , M5N1Ayi , M5N1Azi , M5N1DynP , M5N1FAFxi , M5N1FAFyi , M5N1FAFzi , & - M5N1FAGxi , M5N1FAGyi , M5N1FAGzi , M5N1FAMxi , M5N1FAMyi , M5N1FAMzi , M5N1FBFxi , & - M5N1FBFyi , M5N1FBFzi , M5N1FBxi , M5N1FByi , M5N1FBzi , M5N1FDxi , M5N1FDyi , & - M5N1FDzi , M5N1FIxi , M5N1FIyi , M5N1FIzi , M5N1FMGxi , M5N1FMGyi , M5N1FMGzi , & - M5N1MAFxi , M5N1MAFyi , M5N1MAFzi , M5N1MAGxi , M5N1MAGyi , M5N1MAGzi , M5N1MBFxi , & - M5N1MBFyi , M5N1MBFzi , M5N1MBxi , M5N1MByi , M5N1MBzi , M5N1MMGxi , M5N1MMGyi , & - M5N1MMGzi , M5N1STAxi , M5N1STAyi , M5N1STAzi , M5N1STVxi , M5N1STVyi , M5N1STVzi , & - M5N1Vxi , M5N1Vyi , M5N1Vzi , M5N2Axi , M5N2Ayi , M5N2Azi , M5N2DynP , & - M5N2FAFxi , M5N2FAFyi , M5N2FAFzi , M5N2FAGxi , M5N2FAGyi , M5N2FAGzi , M5N2FAMxi , & - M5N2FAMyi , M5N2FAMzi , M5N2FBFxi , M5N2FBFyi , M5N2FBFzi , M5N2FBxi , M5N2FByi , & - M5N2FBzi , M5N2FDxi , M5N2FDyi , M5N2FDzi , M5N2FIxi , M5N2FIyi , M5N2FIzi , & - M5N2FMGxi , M5N2FMGyi , M5N2FMGzi , M5N2MAFxi , M5N2MAFyi , M5N2MAFzi , M5N2MAGxi , & - M5N2MAGyi , M5N2MAGzi , M5N2MBFxi , M5N2MBFyi , M5N2MBFzi , M5N2MBxi , M5N2MByi , & - M5N2MBzi , M5N2MMGxi , M5N2MMGyi , M5N2MMGzi , M5N2STAxi , M5N2STAyi , M5N2STAzi , & - M5N2STVxi , M5N2STVyi , M5N2STVzi , M5N2Vxi , M5N2Vyi , M5N2Vzi , M5N3Axi , & - M5N3Ayi , M5N3Azi , M5N3DynP , M5N3FAFxi , M5N3FAFyi , M5N3FAFzi , M5N3FAGxi , & - M5N3FAGyi , M5N3FAGzi , M5N3FAMxi , M5N3FAMyi , M5N3FAMzi , M5N3FBFxi , M5N3FBFyi , & - M5N3FBFzi , M5N3FBxi , M5N3FByi , M5N3FBzi , M5N3FDxi , M5N3FDyi , M5N3FDzi , & - M5N3FIxi , M5N3FIyi , M5N3FIzi , M5N3FMGxi , M5N3FMGyi , M5N3FMGzi , M5N3MAFxi , & - M5N3MAFyi , M5N3MAFzi , M5N3MAGxi , M5N3MAGyi , M5N3MAGzi , M5N3MBFxi , M5N3MBFyi , & - M5N3MBFzi , M5N3MBxi , M5N3MByi , M5N3MBzi , M5N3MMGxi , M5N3MMGyi , M5N3MMGzi , & - M5N3STAxi , M5N3STAyi , M5N3STAzi , M5N3STVxi , M5N3STVyi , M5N3STVzi , M5N3Vxi , & - M5N3Vyi , M5N3Vzi , M5N4Axi , M5N4Ayi , M5N4Azi , M5N4DynP , M5N4FAFxi , & - M5N4FAFyi , M5N4FAFzi , M5N4FAGxi , M5N4FAGyi , M5N4FAGzi , M5N4FAMxi , M5N4FAMyi , & - M5N4FAMzi , M5N4FBFxi , M5N4FBFyi , M5N4FBFzi , M5N4FBxi , M5N4FByi , M5N4FBzi , & - M5N4FDxi , M5N4FDyi , M5N4FDzi , M5N4FIxi , M5N4FIyi , M5N4FIzi , M5N4FMGxi , & - M5N4FMGyi , M5N4FMGzi , M5N4MAFxi , M5N4MAFyi , M5N4MAFzi , M5N4MAGxi , M5N4MAGyi , & - M5N4MAGzi , M5N4MBFxi , M5N4MBFyi , M5N4MBFzi , M5N4MBxi , M5N4MByi , M5N4MBzi , & - M5N4MMGxi , M5N4MMGyi , M5N4MMGzi , M5N4STAxi , M5N4STAyi , M5N4STAzi , M5N4STVxi , & - M5N4STVyi , M5N4STVzi , M5N4Vxi , M5N4Vyi , M5N4Vzi , M5N5Axi , M5N5Ayi , & - M5N5Azi , M5N5DynP , M5N5FAFxi , M5N5FAFyi , M5N5FAFzi , M5N5FAGxi , M5N5FAGyi , & - M5N5FAGzi , M5N5FAMxi , M5N5FAMyi , M5N5FAMzi , M5N5FBFxi , M5N5FBFyi , M5N5FBFzi , & - M5N5FBxi , M5N5FByi , M5N5FBzi , M5N5FDxi , M5N5FDyi , M5N5FDzi , M5N5FIxi , & - M5N5FIyi , M5N5FIzi , M5N5FMGxi , M5N5FMGyi , M5N5FMGzi , M5N5MAFxi , M5N5MAFyi , & - M5N5MAFzi , M5N5MAGxi , M5N5MAGyi /) - ParamIndxAry(2501:3000) = (/ & - M5N5MAGzi , M5N5MBFxi , M5N5MBFyi , M5N5MBFzi , M5N5MBxi , M5N5MByi , M5N5MBzi , & - M5N5MMGxi , M5N5MMGyi , M5N5MMGzi , M5N5STAxi , M5N5STAyi , M5N5STAzi , M5N5STVxi , & - M5N5STVyi , M5N5STVzi , M5N5Vxi , M5N5Vyi , M5N5Vzi , M5N6Axi , M5N6Ayi , & - M5N6Azi , M5N6DynP , M5N6FAFxi , M5N6FAFyi , M5N6FAFzi , M5N6FAGxi , M5N6FAGyi , & - M5N6FAGzi , M5N6FAMxi , M5N6FAMyi , M5N6FAMzi , M5N6FBFxi , M5N6FBFyi , M5N6FBFzi , & - M5N6FBxi , M5N6FByi , M5N6FBzi , M5N6FDxi , M5N6FDyi , M5N6FDzi , M5N6FIxi , & - M5N6FIyi , M5N6FIzi , M5N6FMGxi , M5N6FMGyi , M5N6FMGzi , M5N6MAFxi , M5N6MAFyi , & - M5N6MAFzi , M5N6MAGxi , M5N6MAGyi , M5N6MAGzi , M5N6MBFxi , M5N6MBFyi , M5N6MBFzi , & - M5N6MBxi , M5N6MByi , M5N6MBzi , M5N6MMGxi , M5N6MMGyi , M5N6MMGzi , M5N6STAxi , & - M5N6STAyi , M5N6STAzi , M5N6STVxi , M5N6STVyi , M5N6STVzi , M5N6Vxi , M5N6Vyi , & - M5N6Vzi , M5N7Axi , M5N7Ayi , M5N7Azi , M5N7DynP , M5N7FAFxi , M5N7FAFyi , & - M5N7FAFzi , M5N7FAGxi , M5N7FAGyi , M5N7FAGzi , M5N7FAMxi , M5N7FAMyi , M5N7FAMzi , & - M5N7FBFxi , M5N7FBFyi , M5N7FBFzi , M5N7FBxi , M5N7FByi , M5N7FBzi , M5N7FDxi , & - M5N7FDyi , M5N7FDzi , M5N7FIxi , M5N7FIyi , M5N7FIzi , M5N7FMGxi , M5N7FMGyi , & - M5N7FMGzi , M5N7MAFxi , M5N7MAFyi , M5N7MAFzi , M5N7MAGxi , M5N7MAGyi , M5N7MAGzi , & - M5N7MBFxi , M5N7MBFyi , M5N7MBFzi , M5N7MBxi , M5N7MByi , M5N7MBzi , M5N7MMGxi , & - M5N7MMGyi , M5N7MMGzi , M5N7STAxi , M5N7STAyi , M5N7STAzi , M5N7STVxi , M5N7STVyi , & - M5N7STVzi , M5N7Vxi , M5N7Vyi , M5N7Vzi , M5N8Axi , M5N8Ayi , M5N8Azi , & - M5N8DynP , M5N8FAFxi , M5N8FAFyi , M5N8FAFzi , M5N8FAGxi , M5N8FAGyi , M5N8FAGzi , & - M5N8FAMxi , M5N8FAMyi , M5N8FAMzi , M5N8FBFxi , M5N8FBFyi , M5N8FBFzi , M5N8FBxi , & - M5N8FByi , M5N8FBzi , M5N8FDxi , M5N8FDyi , M5N8FDzi , M5N8FIxi , M5N8FIyi , & - M5N8FIzi , M5N8FMGxi , M5N8FMGyi , M5N8FMGzi , M5N8MAFxi , M5N8MAFyi , M5N8MAFzi , & - M5N8MAGxi , M5N8MAGyi , M5N8MAGzi , M5N8MBFxi , M5N8MBFyi , M5N8MBFzi , M5N8MBxi , & - M5N8MByi , M5N8MBzi , M5N8MMGxi , M5N8MMGyi , M5N8MMGzi , M5N8STAxi , M5N8STAyi , & - M5N8STAzi , M5N8STVxi , M5N8STVyi , M5N8STVzi , M5N8Vxi , M5N8Vyi , M5N8Vzi , & - M5N9Axi , M5N9Ayi , M5N9Azi , M5N9DynP , M5N9FAFxi , M5N9FAFyi , M5N9FAFzi , & - M5N9FAGxi , M5N9FAGyi , M5N9FAGzi , M5N9FAMxi , M5N9FAMyi , M5N9FAMzi , M5N9FBFxi , & - M5N9FBFyi , M5N9FBFzi , M5N9FBxi , M5N9FByi , M5N9FBzi , M5N9FDxi , M5N9FDyi , & - M5N9FDzi , M5N9FIxi , M5N9FIyi , M5N9FIzi , M5N9FMGxi , M5N9FMGyi , M5N9FMGzi , & - M5N9MAFxi , M5N9MAFyi , M5N9MAFzi , M5N9MAGxi , M5N9MAGyi , M5N9MAGzi , M5N9MBFxi , & - M5N9MBFyi , M5N9MBFzi , M5N9MBxi , M5N9MByi , M5N9MBzi , M5N9MMGxi , M5N9MMGyi , & - M5N9MMGzi , M5N9STAxi , M5N9STAyi , M5N9STAzi , M5N9STVxi , M5N9STVyi , M5N9STVzi , & - M5N9Vxi , M5N9Vyi , M5N9Vzi , M6N1Axi , M6N1Ayi , M6N1Azi , M6N1DynP , & - M6N1FAFxi , M6N1FAFyi , M6N1FAFzi , M6N1FAGxi , M6N1FAGyi , M6N1FAGzi , M6N1FAMxi , & - M6N1FAMyi , M6N1FAMzi , M6N1FBFxi , M6N1FBFyi , M6N1FBFzi , M6N1FBxi , M6N1FByi , & - M6N1FBzi , M6N1FDxi , M6N1FDyi , M6N1FDzi , M6N1FIxi , M6N1FIyi , M6N1FIzi , & - M6N1FMGxi , M6N1FMGyi , M6N1FMGzi , M6N1MAFxi , M6N1MAFyi , M6N1MAFzi , M6N1MAGxi , & - M6N1MAGyi , M6N1MAGzi , M6N1MBFxi , M6N1MBFyi , M6N1MBFzi , M6N1MBxi , M6N1MByi , & - M6N1MBzi , M6N1MMGxi , M6N1MMGyi , M6N1MMGzi , M6N1STAxi , M6N1STAyi , M6N1STAzi , & - M6N1STVxi , M6N1STVyi , M6N1STVzi , M6N1Vxi , M6N1Vyi , M6N1Vzi , M6N2Axi , & - M6N2Ayi , M6N2Azi , M6N2DynP , M6N2FAFxi , M6N2FAFyi , M6N2FAFzi , M6N2FAGxi , & - M6N2FAGyi , M6N2FAGzi , M6N2FAMxi , M6N2FAMyi , M6N2FAMzi , M6N2FBFxi , M6N2FBFyi , & - M6N2FBFzi , M6N2FBxi , M6N2FByi , M6N2FBzi , M6N2FDxi , M6N2FDyi , M6N2FDzi , & - M6N2FIxi , M6N2FIyi , M6N2FIzi , M6N2FMGxi , M6N2FMGyi , M6N2FMGzi , M6N2MAFxi , & - M6N2MAFyi , M6N2MAFzi , M6N2MAGxi , M6N2MAGyi , M6N2MAGzi , M6N2MBFxi , M6N2MBFyi , & - M6N2MBFzi , M6N2MBxi , M6N2MByi , M6N2MBzi , M6N2MMGxi , M6N2MMGyi , M6N2MMGzi , & - M6N2STAxi , M6N2STAyi , M6N2STAzi , M6N2STVxi , M6N2STVyi , M6N2STVzi , M6N2Vxi , & - M6N2Vyi , M6N2Vzi , M6N3Axi , M6N3Ayi , M6N3Azi , M6N3DynP , M6N3FAFxi , & - M6N3FAFyi , M6N3FAFzi , M6N3FAGxi , M6N3FAGyi , M6N3FAGzi , M6N3FAMxi , M6N3FAMyi , & - M6N3FAMzi , M6N3FBFxi , M6N3FBFyi , M6N3FBFzi , M6N3FBxi , M6N3FByi , M6N3FBzi , & - M6N3FDxi , M6N3FDyi , M6N3FDzi , M6N3FIxi , M6N3FIyi , M6N3FIzi , M6N3FMGxi , & - M6N3FMGyi , M6N3FMGzi , M6N3MAFxi , M6N3MAFyi , M6N3MAFzi , M6N3MAGxi , M6N3MAGyi , & - M6N3MAGzi , M6N3MBFxi , M6N3MBFyi , M6N3MBFzi , M6N3MBxi , M6N3MByi , M6N3MBzi , & - M6N3MMGxi , M6N3MMGyi , M6N3MMGzi , M6N3STAxi , M6N3STAyi , M6N3STAzi , M6N3STVxi , & - M6N3STVyi , M6N3STVzi , M6N3Vxi , M6N3Vyi , M6N3Vzi , M6N4Axi , M6N4Ayi , & - M6N4Azi , M6N4DynP , M6N4FAFxi , M6N4FAFyi , M6N4FAFzi , M6N4FAGxi , M6N4FAGyi , & - M6N4FAGzi , M6N4FAMxi , M6N4FAMyi , M6N4FAMzi , M6N4FBFxi , M6N4FBFyi , M6N4FBFzi , & - M6N4FBxi , M6N4FByi , M6N4FBzi , M6N4FDxi , M6N4FDyi , M6N4FDzi , M6N4FIxi , & - M6N4FIyi , M6N4FIzi , M6N4FMGxi , M6N4FMGyi , M6N4FMGzi , M6N4MAFxi , M6N4MAFyi , & - M6N4MAFzi , M6N4MAGxi , M6N4MAGyi , M6N4MAGzi , M6N4MBFxi , M6N4MBFyi , M6N4MBFzi , & - M6N4MBxi , M6N4MByi , M6N4MBzi , M6N4MMGxi , M6N4MMGyi , M6N4MMGzi , M6N4STAxi , & - M6N4STAyi , M6N4STAzi , M6N4STVxi , M6N4STVyi , M6N4STVzi , M6N4Vxi , M6N4Vyi , & - M6N4Vzi , M6N5Axi , M6N5Ayi , M6N5Azi , M6N5DynP , M6N5FAFxi , M6N5FAFyi , & - M6N5FAFzi , M6N5FAGxi , M6N5FAGyi , M6N5FAGzi , M6N5FAMxi , M6N5FAMyi , M6N5FAMzi , & - M6N5FBFxi , M6N5FBFyi , M6N5FBFzi , M6N5FBxi , M6N5FByi , M6N5FBzi , M6N5FDxi , & - M6N5FDyi , M6N5FDzi , M6N5FIxi , M6N5FIyi , M6N5FIzi , M6N5FMGxi , M6N5FMGyi , & - M6N5FMGzi , M6N5MAFxi , M6N5MAFyi , M6N5MAFzi , M6N5MAGxi , M6N5MAGyi , M6N5MAGzi , & - M6N5MBFxi , M6N5MBFyi , M6N5MBFzi , M6N5MBxi , M6N5MByi , M6N5MBzi , M6N5MMGxi , & - M6N5MMGyi , M6N5MMGzi , M6N5STAxi , M6N5STAyi , M6N5STAzi , M6N5STVxi , M6N5STVyi , & - M6N5STVzi , M6N5Vxi , M6N5Vyi , M6N5Vzi , M6N6Axi , M6N6Ayi , M6N6Azi , & - M6N6DynP , M6N6FAFxi , M6N6FAFyi , M6N6FAFzi , M6N6FAGxi , M6N6FAGyi , M6N6FAGzi , & - M6N6FAMxi , M6N6FAMyi , M6N6FAMzi /) - ParamIndxAry(3001:3500) = (/ & - M6N6FBFxi , M6N6FBFyi , M6N6FBFzi , M6N6FBxi , M6N6FByi , M6N6FBzi , M6N6FDxi , & - M6N6FDyi , M6N6FDzi , M6N6FIxi , M6N6FIyi , M6N6FIzi , M6N6FMGxi , M6N6FMGyi , & - M6N6FMGzi , M6N6MAFxi , M6N6MAFyi , M6N6MAFzi , M6N6MAGxi , M6N6MAGyi , M6N6MAGzi , & - M6N6MBFxi , M6N6MBFyi , M6N6MBFzi , M6N6MBxi , M6N6MByi , M6N6MBzi , M6N6MMGxi , & - M6N6MMGyi , M6N6MMGzi , M6N6STAxi , M6N6STAyi , M6N6STAzi , M6N6STVxi , M6N6STVyi , & - M6N6STVzi , M6N6Vxi , M6N6Vyi , M6N6Vzi , M6N7Axi , M6N7Ayi , M6N7Azi , & - M6N7DynP , M6N7FAFxi , M6N7FAFyi , M6N7FAFzi , M6N7FAGxi , M6N7FAGyi , M6N7FAGzi , & - M6N7FAMxi , M6N7FAMyi , M6N7FAMzi , M6N7FBFxi , M6N7FBFyi , M6N7FBFzi , M6N7FBxi , & - M6N7FByi , M6N7FBzi , M6N7FDxi , M6N7FDyi , M6N7FDzi , M6N7FIxi , M6N7FIyi , & - M6N7FIzi , M6N7FMGxi , M6N7FMGyi , M6N7FMGzi , M6N7MAFxi , M6N7MAFyi , M6N7MAFzi , & - M6N7MAGxi , M6N7MAGyi , M6N7MAGzi , M6N7MBFxi , M6N7MBFyi , M6N7MBFzi , M6N7MBxi , & - M6N7MByi , M6N7MBzi , M6N7MMGxi , M6N7MMGyi , M6N7MMGzi , M6N7STAxi , M6N7STAyi , & - M6N7STAzi , M6N7STVxi , M6N7STVyi , M6N7STVzi , M6N7Vxi , M6N7Vyi , M6N7Vzi , & - M6N8Axi , M6N8Ayi , M6N8Azi , M6N8DynP , M6N8FAFxi , M6N8FAFyi , M6N8FAFzi , & - M6N8FAGxi , M6N8FAGyi , M6N8FAGzi , M6N8FAMxi , M6N8FAMyi , M6N8FAMzi , M6N8FBFxi , & - M6N8FBFyi , M6N8FBFzi , M6N8FBxi , M6N8FByi , M6N8FBzi , M6N8FDxi , M6N8FDyi , & - M6N8FDzi , M6N8FIxi , M6N8FIyi , M6N8FIzi , M6N8FMGxi , M6N8FMGyi , M6N8FMGzi , & - M6N8MAFxi , M6N8MAFyi , M6N8MAFzi , M6N8MAGxi , M6N8MAGyi , M6N8MAGzi , M6N8MBFxi , & - M6N8MBFyi , M6N8MBFzi , M6N8MBxi , M6N8MByi , M6N8MBzi , M6N8MMGxi , M6N8MMGyi , & - M6N8MMGzi , M6N8STAxi , M6N8STAyi , M6N8STAzi , M6N8STVxi , M6N8STVyi , M6N8STVzi , & - M6N8Vxi , M6N8Vyi , M6N8Vzi , M6N9Axi , M6N9Ayi , M6N9Azi , M6N9DynP , & - M6N9FAFxi , M6N9FAFyi , M6N9FAFzi , M6N9FAGxi , M6N9FAGyi , M6N9FAGzi , M6N9FAMxi , & - M6N9FAMyi , M6N9FAMzi , M6N9FBFxi , M6N9FBFyi , M6N9FBFzi , M6N9FBxi , M6N9FByi , & - M6N9FBzi , M6N9FDxi , M6N9FDyi , M6N9FDzi , M6N9FIxi , M6N9FIyi , M6N9FIzi , & - M6N9FMGxi , M6N9FMGyi , M6N9FMGzi , M6N9MAFxi , M6N9MAFyi , M6N9MAFzi , M6N9MAGxi , & - M6N9MAGyi , M6N9MAGzi , M6N9MBFxi , M6N9MBFyi , M6N9MBFzi , M6N9MBxi , M6N9MByi , & - M6N9MBzi , M6N9MMGxi , M6N9MMGyi , M6N9MMGzi , M6N9STAxi , M6N9STAyi , M6N9STAzi , & - M6N9STVxi , M6N9STVyi , M6N9STVzi , M6N9Vxi , M6N9Vyi , M6N9Vzi , M7N1Axi , & - M7N1Ayi , M7N1Azi , M7N1DynP , M7N1FAFxi , M7N1FAFyi , M7N1FAFzi , M7N1FAGxi , & - M7N1FAGyi , M7N1FAGzi , M7N1FAMxi , M7N1FAMyi , M7N1FAMzi , M7N1FBFxi , M7N1FBFyi , & - M7N1FBFzi , M7N1FBxi , M7N1FByi , M7N1FBzi , M7N1FDxi , M7N1FDyi , M7N1FDzi , & - M7N1FIxi , M7N1FIyi , M7N1FIzi , M7N1FMGxi , M7N1FMGyi , M7N1FMGzi , M7N1MAFxi , & - M7N1MAFyi , M7N1MAFzi , M7N1MAGxi , M7N1MAGyi , M7N1MAGzi , M7N1MBFxi , M7N1MBFyi , & - M7N1MBFzi , M7N1MBxi , M7N1MByi , M7N1MBzi , M7N1MMGxi , M7N1MMGyi , M7N1MMGzi , & - M7N1STAxi , M7N1STAyi , M7N1STAzi , M7N1STVxi , M7N1STVyi , M7N1STVzi , M7N1Vxi , & - M7N1Vyi , M7N1Vzi , M7N2Axi , M7N2Ayi , M7N2Azi , M7N2DynP , M7N2FAFxi , & - M7N2FAFyi , M7N2FAFzi , M7N2FAGxi , M7N2FAGyi , M7N2FAGzi , M7N2FAMxi , M7N2FAMyi , & - M7N2FAMzi , M7N2FBFxi , M7N2FBFyi , M7N2FBFzi , M7N2FBxi , M7N2FByi , M7N2FBzi , & - M7N2FDxi , M7N2FDyi , M7N2FDzi , M7N2FIxi , M7N2FIyi , M7N2FIzi , M7N2FMGxi , & - M7N2FMGyi , M7N2FMGzi , M7N2MAFxi , M7N2MAFyi , M7N2MAFzi , M7N2MAGxi , M7N2MAGyi , & - M7N2MAGzi , M7N2MBFxi , M7N2MBFyi , M7N2MBFzi , M7N2MBxi , M7N2MByi , M7N2MBzi , & - M7N2MMGxi , M7N2MMGyi , M7N2MMGzi , M7N2STAxi , M7N2STAyi , M7N2STAzi , M7N2STVxi , & - M7N2STVyi , M7N2STVzi , M7N2Vxi , M7N2Vyi , M7N2Vzi , M7N3Axi , M7N3Ayi , & - M7N3Azi , M7N3DynP , M7N3FAFxi , M7N3FAFyi , M7N3FAFzi , M7N3FAGxi , M7N3FAGyi , & - M7N3FAGzi , M7N3FAMxi , M7N3FAMyi , M7N3FAMzi , M7N3FBFxi , M7N3FBFyi , M7N3FBFzi , & - M7N3FBxi , M7N3FByi , M7N3FBzi , M7N3FDxi , M7N3FDyi , M7N3FDzi , M7N3FIxi , & - M7N3FIyi , M7N3FIzi , M7N3FMGxi , M7N3FMGyi , M7N3FMGzi , M7N3MAFxi , M7N3MAFyi , & - M7N3MAFzi , M7N3MAGxi , M7N3MAGyi , M7N3MAGzi , M7N3MBFxi , M7N3MBFyi , M7N3MBFzi , & - M7N3MBxi , M7N3MByi , M7N3MBzi , M7N3MMGxi , M7N3MMGyi , M7N3MMGzi , M7N3STAxi , & - M7N3STAyi , M7N3STAzi , M7N3STVxi , M7N3STVyi , M7N3STVzi , M7N3Vxi , M7N3Vyi , & - M7N3Vzi , M7N4Axi , M7N4Ayi , M7N4Azi , M7N4DynP , M7N4FAFxi , M7N4FAFyi , & - M7N4FAFzi , M7N4FAGxi , M7N4FAGyi , M7N4FAGzi , M7N4FAMxi , M7N4FAMyi , M7N4FAMzi , & - M7N4FBFxi , M7N4FBFyi , M7N4FBFzi , M7N4FBxi , M7N4FByi , M7N4FBzi , M7N4FDxi , & - M7N4FDyi , M7N4FDzi , M7N4FIxi , M7N4FIyi , M7N4FIzi , M7N4FMGxi , M7N4FMGyi , & - M7N4FMGzi , M7N4MAFxi , M7N4MAFyi , M7N4MAFzi , M7N4MAGxi , M7N4MAGyi , M7N4MAGzi , & - M7N4MBFxi , M7N4MBFyi , M7N4MBFzi , M7N4MBxi , M7N4MByi , M7N4MBzi , M7N4MMGxi , & - M7N4MMGyi , M7N4MMGzi , M7N4STAxi , M7N4STAyi , M7N4STAzi , M7N4STVxi , M7N4STVyi , & - M7N4STVzi , M7N4Vxi , M7N4Vyi , M7N4Vzi , M7N5Axi , M7N5Ayi , M7N5Azi , & - M7N5DynP , M7N5FAFxi , M7N5FAFyi , M7N5FAFzi , M7N5FAGxi , M7N5FAGyi , M7N5FAGzi , & - M7N5FAMxi , M7N5FAMyi , M7N5FAMzi , M7N5FBFxi , M7N5FBFyi , M7N5FBFzi , M7N5FBxi , & - M7N5FByi , M7N5FBzi , M7N5FDxi , M7N5FDyi , M7N5FDzi , M7N5FIxi , M7N5FIyi , & - M7N5FIzi , M7N5FMGxi , M7N5FMGyi , M7N5FMGzi , M7N5MAFxi , M7N5MAFyi , M7N5MAFzi , & - M7N5MAGxi , M7N5MAGyi , M7N5MAGzi , M7N5MBFxi , M7N5MBFyi , M7N5MBFzi , M7N5MBxi , & - M7N5MByi , M7N5MBzi , M7N5MMGxi , M7N5MMGyi , M7N5MMGzi , M7N5STAxi , M7N5STAyi , & - M7N5STAzi , M7N5STVxi , M7N5STVyi , M7N5STVzi , M7N5Vxi , M7N5Vyi , M7N5Vzi , & - M7N6Axi , M7N6Ayi , M7N6Azi , M7N6DynP , M7N6FAFxi , M7N6FAFyi , M7N6FAFzi , & - M7N6FAGxi , M7N6FAGyi , M7N6FAGzi , M7N6FAMxi , M7N6FAMyi , M7N6FAMzi , M7N6FBFxi , & - M7N6FBFyi , M7N6FBFzi , M7N6FBxi , M7N6FByi , M7N6FBzi , M7N6FDxi , M7N6FDyi , & - M7N6FDzi , M7N6FIxi , M7N6FIyi , M7N6FIzi , M7N6FMGxi , M7N6FMGyi , M7N6FMGzi , & - M7N6MAFxi , M7N6MAFyi , M7N6MAFzi , M7N6MAGxi , M7N6MAGyi , M7N6MAGzi , M7N6MBFxi , & - M7N6MBFyi , M7N6MBFzi , M7N6MBxi , M7N6MByi , M7N6MBzi , M7N6MMGxi , M7N6MMGyi , & - M7N6MMGzi , M7N6STAxi , M7N6STAyi /) - ParamIndxAry(3501:4000) = (/ & - M7N6STAzi , M7N6STVxi , M7N6STVyi , M7N6STVzi , M7N6Vxi , M7N6Vyi , M7N6Vzi , & - M7N7Axi , M7N7Ayi , M7N7Azi , M7N7DynP , M7N7FAFxi , M7N7FAFyi , M7N7FAFzi , & - M7N7FAGxi , M7N7FAGyi , M7N7FAGzi , M7N7FAMxi , M7N7FAMyi , M7N7FAMzi , M7N7FBFxi , & - M7N7FBFyi , M7N7FBFzi , M7N7FBxi , M7N7FByi , M7N7FBzi , M7N7FDxi , M7N7FDyi , & - M7N7FDzi , M7N7FIxi , M7N7FIyi , M7N7FIzi , M7N7FMGxi , M7N7FMGyi , M7N7FMGzi , & - M7N7MAFxi , M7N7MAFyi , M7N7MAFzi , M7N7MAGxi , M7N7MAGyi , M7N7MAGzi , M7N7MBFxi , & - M7N7MBFyi , M7N7MBFzi , M7N7MBxi , M7N7MByi , M7N7MBzi , M7N7MMGxi , M7N7MMGyi , & - M7N7MMGzi , M7N7STAxi , M7N7STAyi , M7N7STAzi , M7N7STVxi , M7N7STVyi , M7N7STVzi , & - M7N7Vxi , M7N7Vyi , M7N7Vzi , M7N8Axi , M7N8Ayi , M7N8Azi , M7N8DynP , & - M7N8FAFxi , M7N8FAFyi , M7N8FAFzi , M7N8FAGxi , M7N8FAGyi , M7N8FAGzi , M7N8FAMxi , & - M7N8FAMyi , M7N8FAMzi , M7N8FBFxi , M7N8FBFyi , M7N8FBFzi , M7N8FBxi , M7N8FByi , & - M7N8FBzi , M7N8FDxi , M7N8FDyi , M7N8FDzi , M7N8FIxi , M7N8FIyi , M7N8FIzi , & - M7N8FMGxi , M7N8FMGyi , M7N8FMGzi , M7N8MAFxi , M7N8MAFyi , M7N8MAFzi , M7N8MAGxi , & - M7N8MAGyi , M7N8MAGzi , M7N8MBFxi , M7N8MBFyi , M7N8MBFzi , M7N8MBxi , M7N8MByi , & - M7N8MBzi , M7N8MMGxi , M7N8MMGyi , M7N8MMGzi , M7N8STAxi , M7N8STAyi , M7N8STAzi , & - M7N8STVxi , M7N8STVyi , M7N8STVzi , M7N8Vxi , M7N8Vyi , M7N8Vzi , M7N9Axi , & - M7N9Ayi , M7N9Azi , M7N9DynP , M7N9FAFxi , M7N9FAFyi , M7N9FAFzi , M7N9FAGxi , & - M7N9FAGyi , M7N9FAGzi , M7N9FAMxi , M7N9FAMyi , M7N9FAMzi , M7N9FBFxi , M7N9FBFyi , & - M7N9FBFzi , M7N9FBxi , M7N9FByi , M7N9FBzi , M7N9FDxi , M7N9FDyi , M7N9FDzi , & - M7N9FIxi , M7N9FIyi , M7N9FIzi , M7N9FMGxi , M7N9FMGyi , M7N9FMGzi , M7N9MAFxi , & - M7N9MAFyi , M7N9MAFzi , M7N9MAGxi , M7N9MAGyi , M7N9MAGzi , M7N9MBFxi , M7N9MBFyi , & - M7N9MBFzi , M7N9MBxi , M7N9MByi , M7N9MBzi , M7N9MMGxi , M7N9MMGyi , M7N9MMGzi , & - M7N9STAxi , M7N9STAyi , M7N9STAzi , M7N9STVxi , M7N9STVyi , M7N9STVzi , M7N9Vxi , & - M7N9Vyi , M7N9Vzi , M8N1Axi , M8N1Ayi , M8N1Azi , M8N1DynP , M8N1FAFxi , & - M8N1FAFyi , M8N1FAFzi , M8N1FAGxi , M8N1FAGyi , M8N1FAGzi , M8N1FAMxi , M8N1FAMyi , & - M8N1FAMzi , M8N1FBFxi , M8N1FBFyi , M8N1FBFzi , M8N1FBxi , M8N1FByi , M8N1FBzi , & - M8N1FDxi , M8N1FDyi , M8N1FDzi , M8N1FIxi , M8N1FIyi , M8N1FIzi , M8N1FMGxi , & - M8N1FMGyi , M8N1FMGzi , M8N1MAFxi , M8N1MAFyi , M8N1MAFzi , M8N1MAGxi , M8N1MAGyi , & - M8N1MAGzi , M8N1MBFxi , M8N1MBFyi , M8N1MBFzi , M8N1MBxi , M8N1MByi , M8N1MBzi , & - M8N1MMGxi , M8N1MMGyi , M8N1MMGzi , M8N1STAxi , M8N1STAyi , M8N1STAzi , M8N1STVxi , & - M8N1STVyi , M8N1STVzi , M8N1Vxi , M8N1Vyi , M8N1Vzi , M8N2Axi , M8N2Ayi , & - M8N2Azi , M8N2DynP , M8N2FAFxi , M8N2FAFyi , M8N2FAFzi , M8N2FAGxi , M8N2FAGyi , & - M8N2FAGzi , M8N2FAMxi , M8N2FAMyi , M8N2FAMzi , M8N2FBFxi , M8N2FBFyi , M8N2FBFzi , & - M8N2FBxi , M8N2FByi , M8N2FBzi , M8N2FDxi , M8N2FDyi , M8N2FDzi , M8N2FIxi , & - M8N2FIyi , M8N2FIzi , M8N2FMGxi , M8N2FMGyi , M8N2FMGzi , M8N2MAFxi , M8N2MAFyi , & - M8N2MAFzi , M8N2MAGxi , M8N2MAGyi , M8N2MAGzi , M8N2MBFxi , M8N2MBFyi , M8N2MBFzi , & - M8N2MBxi , M8N2MByi , M8N2MBzi , M8N2MMGxi , M8N2MMGyi , M8N2MMGzi , M8N2STAxi , & - M8N2STAyi , M8N2STAzi , M8N2STVxi , M8N2STVyi , M8N2STVzi , M8N2Vxi , M8N2Vyi , & - M8N2Vzi , M8N3Axi , M8N3Ayi , M8N3Azi , M8N3DynP , M8N3FAFxi , M8N3FAFyi , & - M8N3FAFzi , M8N3FAGxi , M8N3FAGyi , M8N3FAGzi , M8N3FAMxi , M8N3FAMyi , M8N3FAMzi , & - M8N3FBFxi , M8N3FBFyi , M8N3FBFzi , M8N3FBxi , M8N3FByi , M8N3FBzi , M8N3FDxi , & - M8N3FDyi , M8N3FDzi , M8N3FIxi , M8N3FIyi , M8N3FIzi , M8N3FMGxi , M8N3FMGyi , & - M8N3FMGzi , M8N3MAFxi , M8N3MAFyi , M8N3MAFzi , M8N3MAGxi , M8N3MAGyi , M8N3MAGzi , & - M8N3MBFxi , M8N3MBFyi , M8N3MBFzi , M8N3MBxi , M8N3MByi , M8N3MBzi , M8N3MMGxi , & - M8N3MMGyi , M8N3MMGzi , M8N3STAxi , M8N3STAyi , M8N3STAzi , M8N3STVxi , M8N3STVyi , & - M8N3STVzi , M8N3Vxi , M8N3Vyi , M8N3Vzi , M8N4Axi , M8N4Ayi , M8N4Azi , & - M8N4DynP , M8N4FAFxi , M8N4FAFyi , M8N4FAFzi , M8N4FAGxi , M8N4FAGyi , M8N4FAGzi , & - M8N4FAMxi , M8N4FAMyi , M8N4FAMzi , M8N4FBFxi , M8N4FBFyi , M8N4FBFzi , M8N4FBxi , & - M8N4FByi , M8N4FBzi , M8N4FDxi , M8N4FDyi , M8N4FDzi , M8N4FIxi , M8N4FIyi , & - M8N4FIzi , M8N4FMGxi , M8N4FMGyi , M8N4FMGzi , M8N4MAFxi , M8N4MAFyi , M8N4MAFzi , & - M8N4MAGxi , M8N4MAGyi , M8N4MAGzi , M8N4MBFxi , M8N4MBFyi , M8N4MBFzi , M8N4MBxi , & - M8N4MByi , M8N4MBzi , M8N4MMGxi , M8N4MMGyi , M8N4MMGzi , M8N4STAxi , M8N4STAyi , & - M8N4STAzi , M8N4STVxi , M8N4STVyi , M8N4STVzi , M8N4Vxi , M8N4Vyi , M8N4Vzi , & - M8N5Axi , M8N5Ayi , M8N5Azi , M8N5DynP , M8N5FAFxi , M8N5FAFyi , M8N5FAFzi , & - M8N5FAGxi , M8N5FAGyi , M8N5FAGzi , M8N5FAMxi , M8N5FAMyi , M8N5FAMzi , M8N5FBFxi , & - M8N5FBFyi , M8N5FBFzi , M8N5FBxi , M8N5FByi , M8N5FBzi , M8N5FDxi , M8N5FDyi , & - M8N5FDzi , M8N5FIxi , M8N5FIyi , M8N5FIzi , M8N5FMGxi , M8N5FMGyi , M8N5FMGzi , & - M8N5MAFxi , M8N5MAFyi , M8N5MAFzi , M8N5MAGxi , M8N5MAGyi , M8N5MAGzi , M8N5MBFxi , & - M8N5MBFyi , M8N5MBFzi , M8N5MBxi , M8N5MByi , M8N5MBzi , M8N5MMGxi , M8N5MMGyi , & - M8N5MMGzi , M8N5STAxi , M8N5STAyi , M8N5STAzi , M8N5STVxi , M8N5STVyi , M8N5STVzi , & - M8N5Vxi , M8N5Vyi , M8N5Vzi , M8N6Axi , M8N6Ayi , M8N6Azi , M8N6DynP , & - M8N6FAFxi , M8N6FAFyi , M8N6FAFzi , M8N6FAGxi , M8N6FAGyi , M8N6FAGzi , M8N6FAMxi , & - M8N6FAMyi , M8N6FAMzi , M8N6FBFxi , M8N6FBFyi , M8N6FBFzi , M8N6FBxi , M8N6FByi , & - M8N6FBzi , M8N6FDxi , M8N6FDyi , M8N6FDzi , M8N6FIxi , M8N6FIyi , M8N6FIzi , & - M8N6FMGxi , M8N6FMGyi , M8N6FMGzi , M8N6MAFxi , M8N6MAFyi , M8N6MAFzi , M8N6MAGxi , & - M8N6MAGyi , M8N6MAGzi , M8N6MBFxi , M8N6MBFyi , M8N6MBFzi , M8N6MBxi , M8N6MByi , & - M8N6MBzi , M8N6MMGxi , M8N6MMGyi , M8N6MMGzi , M8N6STAxi , M8N6STAyi , M8N6STAzi , & - M8N6STVxi , M8N6STVyi , M8N6STVzi , M8N6Vxi , M8N6Vyi , M8N6Vzi , M8N7Axi , & - M8N7Ayi , M8N7Azi , M8N7DynP , M8N7FAFxi , M8N7FAFyi , M8N7FAFzi , M8N7FAGxi , & - M8N7FAGyi , M8N7FAGzi , M8N7FAMxi , M8N7FAMyi , M8N7FAMzi , M8N7FBFxi , M8N7FBFyi , & - M8N7FBFzi , M8N7FBxi , M8N7FByi , M8N7FBzi , M8N7FDxi , M8N7FDyi , M8N7FDzi , & - M8N7FIxi , M8N7FIyi , M8N7FIzi /) - ParamIndxAry(4001:4500) = (/ & - M8N7FMGxi , M8N7FMGyi , M8N7FMGzi , M8N7MAFxi , M8N7MAFyi , M8N7MAFzi , M8N7MAGxi , & - M8N7MAGyi , M8N7MAGzi , M8N7MBFxi , M8N7MBFyi , M8N7MBFzi , M8N7MBxi , M8N7MByi , & - M8N7MBzi , M8N7MMGxi , M8N7MMGyi , M8N7MMGzi , M8N7STAxi , M8N7STAyi , M8N7STAzi , & - M8N7STVxi , M8N7STVyi , M8N7STVzi , M8N7Vxi , M8N7Vyi , M8N7Vzi , M8N8Axi , & - M8N8Ayi , M8N8Azi , M8N8DynP , M8N8FAFxi , M8N8FAFyi , M8N8FAFzi , M8N8FAGxi , & - M8N8FAGyi , M8N8FAGzi , M8N8FAMxi , M8N8FAMyi , M8N8FAMzi , M8N8FBFxi , M8N8FBFyi , & - M8N8FBFzi , M8N8FBxi , M8N8FByi , M8N8FBzi , M8N8FDxi , M8N8FDyi , M8N8FDzi , & - M8N8FIxi , M8N8FIyi , M8N8FIzi , M8N8FMGxi , M8N8FMGyi , M8N8FMGzi , M8N8MAFxi , & - M8N8MAFyi , M8N8MAFzi , M8N8MAGxi , M8N8MAGyi , M8N8MAGzi , M8N8MBFxi , M8N8MBFyi , & - M8N8MBFzi , M8N8MBxi , M8N8MByi , M8N8MBzi , M8N8MMGxi , M8N8MMGyi , M8N8MMGzi , & - M8N8STAxi , M8N8STAyi , M8N8STAzi , M8N8STVxi , M8N8STVyi , M8N8STVzi , M8N8Vxi , & - M8N8Vyi , M8N8Vzi , M8N9Axi , M8N9Ayi , M8N9Azi , M8N9DynP , M8N9FAFxi , & - M8N9FAFyi , M8N9FAFzi , M8N9FAGxi , M8N9FAGyi , M8N9FAGzi , M8N9FAMxi , M8N9FAMyi , & - M8N9FAMzi , M8N9FBFxi , M8N9FBFyi , M8N9FBFzi , M8N9FBxi , M8N9FByi , M8N9FBzi , & - M8N9FDxi , M8N9FDyi , M8N9FDzi , M8N9FIxi , M8N9FIyi , M8N9FIzi , M8N9FMGxi , & - M8N9FMGyi , M8N9FMGzi , M8N9MAFxi , M8N9MAFyi , M8N9MAFzi , M8N9MAGxi , M8N9MAGyi , & - M8N9MAGzi , M8N9MBFxi , M8N9MBFyi , M8N9MBFzi , M8N9MBxi , M8N9MByi , M8N9MBzi , & - M8N9MMGxi , M8N9MMGyi , M8N9MMGzi , M8N9STAxi , M8N9STAyi , M8N9STAzi , M8N9STVxi , & - M8N9STVyi , M8N9STVzi , M8N9Vxi , M8N9Vyi , M8N9Vzi , M9N1Axi , M9N1Ayi , & - M9N1Azi , M9N1DynP , M9N1FAFxi , M9N1FAFyi , M9N1FAFzi , M9N1FAGxi , M9N1FAGyi , & - M9N1FAGzi , M9N1FAMxi , M9N1FAMyi , M9N1FAMzi , M9N1FBFxi , M9N1FBFyi , M9N1FBFzi , & - M9N1FBxi , M9N1FByi , M9N1FBzi , M9N1FDxi , M9N1FDyi , M9N1FDzi , M9N1FIxi , & - M9N1FIyi , M9N1FIzi , M9N1FMGxi , M9N1FMGyi , M9N1FMGzi , M9N1MAFxi , M9N1MAFyi , & - M9N1MAFzi , M9N1MAGxi , M9N1MAGyi , M9N1MAGzi , M9N1MBFxi , M9N1MBFyi , M9N1MBFzi , & - M9N1MBxi , M9N1MByi , M9N1MBzi , M9N1MMGxi , M9N1MMGyi , M9N1MMGzi , M9N1STAxi , & - M9N1STAyi , M9N1STAzi , M9N1STVxi , M9N1STVyi , M9N1STVzi , M9N1Vxi , M9N1Vyi , & - M9N1Vzi , M9N2Axi , M9N2Ayi , M9N2Azi , M9N2DynP , M9N2FAFxi , M9N2FAFyi , & - M9N2FAFzi , M9N2FAGxi , M9N2FAGyi , M9N2FAGzi , M9N2FAMxi , M9N2FAMyi , M9N2FAMzi , & - M9N2FBFxi , M9N2FBFyi , M9N2FBFzi , M9N2FBxi , M9N2FByi , M9N2FBzi , M9N2FDxi , & - M9N2FDyi , M9N2FDzi , M9N2FIxi , M9N2FIyi , M9N2FIzi , M9N2FMGxi , M9N2FMGyi , & - M9N2FMGzi , M9N2MAFxi , M9N2MAFyi , M9N2MAFzi , M9N2MAGxi , M9N2MAGyi , M9N2MAGzi , & - M9N2MBFxi , M9N2MBFyi , M9N2MBFzi , M9N2MBxi , M9N2MByi , M9N2MBzi , M9N2MMGxi , & - M9N2MMGyi , M9N2MMGzi , M9N2STAxi , M9N2STAyi , M9N2STAzi , M9N2STVxi , M9N2STVyi , & - M9N2STVzi , M9N2Vxi , M9N2Vyi , M9N2Vzi , M9N3Axi , M9N3Ayi , M9N3Azi , & - M9N3DynP , M9N3FAFxi , M9N3FAFyi , M9N3FAFzi , M9N3FAGxi , M9N3FAGyi , M9N3FAGzi , & - M9N3FAMxi , M9N3FAMyi , M9N3FAMzi , M9N3FBFxi , M9N3FBFyi , M9N3FBFzi , M9N3FBxi , & - M9N3FByi , M9N3FBzi , M9N3FDxi , M9N3FDyi , M9N3FDzi , M9N3FIxi , M9N3FIyi , & - M9N3FIzi , M9N3FMGxi , M9N3FMGyi , M9N3FMGzi , M9N3MAFxi , M9N3MAFyi , M9N3MAFzi , & - M9N3MAGxi , M9N3MAGyi , M9N3MAGzi , M9N3MBFxi , M9N3MBFyi , M9N3MBFzi , M9N3MBxi , & - M9N3MByi , M9N3MBzi , M9N3MMGxi , M9N3MMGyi , M9N3MMGzi , M9N3STAxi , M9N3STAyi , & - M9N3STAzi , M9N3STVxi , M9N3STVyi , M9N3STVzi , M9N3Vxi , M9N3Vyi , M9N3Vzi , & - M9N4Axi , M9N4Ayi , M9N4Azi , M9N4DynP , M9N4FAFxi , M9N4FAFyi , M9N4FAFzi , & - M9N4FAGxi , M9N4FAGyi , M9N4FAGzi , M9N4FAMxi , M9N4FAMyi , M9N4FAMzi , M9N4FBFxi , & - M9N4FBFyi , M9N4FBFzi , M9N4FBxi , M9N4FByi , M9N4FBzi , M9N4FDxi , M9N4FDyi , & - M9N4FDzi , M9N4FIxi , M9N4FIyi , M9N4FIzi , M9N4FMGxi , M9N4FMGyi , M9N4FMGzi , & - M9N4MAFxi , M9N4MAFyi , M9N4MAFzi , M9N4MAGxi , M9N4MAGyi , M9N4MAGzi , M9N4MBFxi , & - M9N4MBFyi , M9N4MBFzi , M9N4MBxi , M9N4MByi , M9N4MBzi , M9N4MMGxi , M9N4MMGyi , & - M9N4MMGzi , M9N4STAxi , M9N4STAyi , M9N4STAzi , M9N4STVxi , M9N4STVyi , M9N4STVzi , & - M9N4Vxi , M9N4Vyi , M9N4Vzi , M9N5Axi , M9N5Ayi , M9N5Azi , M9N5DynP , & - M9N5FAFxi , M9N5FAFyi , M9N5FAFzi , M9N5FAGxi , M9N5FAGyi , M9N5FAGzi , M9N5FAMxi , & - M9N5FAMyi , M9N5FAMzi , M9N5FBFxi , M9N5FBFyi , M9N5FBFzi , M9N5FBxi , M9N5FByi , & - M9N5FBzi , M9N5FDxi , M9N5FDyi , M9N5FDzi , M9N5FIxi , M9N5FIyi , M9N5FIzi , & - M9N5FMGxi , M9N5FMGyi , M9N5FMGzi , M9N5MAFxi , M9N5MAFyi , M9N5MAFzi , M9N5MAGxi , & - M9N5MAGyi , M9N5MAGzi , M9N5MBFxi , M9N5MBFyi , M9N5MBFzi , M9N5MBxi , M9N5MByi , & - M9N5MBzi , M9N5MMGxi , M9N5MMGyi , M9N5MMGzi , M9N5STAxi , M9N5STAyi , M9N5STAzi , & - M9N5STVxi , M9N5STVyi , M9N5STVzi , M9N5Vxi , M9N5Vyi , M9N5Vzi , M9N6Axi , & - M9N6Ayi , M9N6Azi , M9N6DynP , M9N6FAFxi , M9N6FAFyi , M9N6FAFzi , M9N6FAGxi , & - M9N6FAGyi , M9N6FAGzi , M9N6FAMxi , M9N6FAMyi , M9N6FAMzi , M9N6FBFxi , M9N6FBFyi , & - M9N6FBFzi , M9N6FBxi , M9N6FByi , M9N6FBzi , M9N6FDxi , M9N6FDyi , M9N6FDzi , & - M9N6FIxi , M9N6FIyi , M9N6FIzi , M9N6FMGxi , M9N6FMGyi , M9N6FMGzi , M9N6MAFxi , & - M9N6MAFyi , M9N6MAFzi , M9N6MAGxi , M9N6MAGyi , M9N6MAGzi , M9N6MBFxi , M9N6MBFyi , & - M9N6MBFzi , M9N6MBxi , M9N6MByi , M9N6MBzi , M9N6MMGxi , M9N6MMGyi , M9N6MMGzi , & - M9N6STAxi , M9N6STAyi , M9N6STAzi , M9N6STVxi , M9N6STVyi , M9N6STVzi , M9N6Vxi , & - M9N6Vyi , M9N6Vzi , M9N7Axi , M9N7Ayi , M9N7Azi , M9N7DynP , M9N7FAFxi , & - M9N7FAFyi , M9N7FAFzi , M9N7FAGxi , M9N7FAGyi , M9N7FAGzi , M9N7FAMxi , M9N7FAMyi , & - M9N7FAMzi , M9N7FBFxi , M9N7FBFyi , M9N7FBFzi , M9N7FBxi , M9N7FByi , M9N7FBzi , & - M9N7FDxi , M9N7FDyi , M9N7FDzi , M9N7FIxi , M9N7FIyi , M9N7FIzi , M9N7FMGxi , & - M9N7FMGyi , M9N7FMGzi , M9N7MAFxi , M9N7MAFyi , M9N7MAFzi , M9N7MAGxi , M9N7MAGyi , & - M9N7MAGzi , M9N7MBFxi , M9N7MBFyi , M9N7MBFzi , M9N7MBxi , M9N7MByi , M9N7MBzi , & - M9N7MMGxi , M9N7MMGyi , M9N7MMGzi , M9N7STAxi , M9N7STAyi , M9N7STAzi , M9N7STVxi , & - M9N7STVyi , M9N7STVzi , M9N7Vxi , M9N7Vyi , M9N7Vzi , M9N8Axi , M9N8Ayi , & - M9N8Azi , M9N8DynP , M9N8FAFxi /) - ParamIndxAry(4501:4599) = (/ & - M9N8FAFyi , M9N8FAFzi , M9N8FAGxi , M9N8FAGyi , M9N8FAGzi , M9N8FAMxi , M9N8FAMyi , & - M9N8FAMzi , M9N8FBFxi , M9N8FBFyi , M9N8FBFzi , M9N8FBxi , M9N8FByi , M9N8FBzi , & - M9N8FDxi , M9N8FDyi , M9N8FDzi , M9N8FIxi , M9N8FIyi , M9N8FIzi , M9N8FMGxi , & - M9N8FMGyi , M9N8FMGzi , M9N8MAFxi , M9N8MAFyi , M9N8MAFzi , M9N8MAGxi , M9N8MAGyi , & - M9N8MAGzi , M9N8MBFxi , M9N8MBFyi , M9N8MBFzi , M9N8MBxi , M9N8MByi , M9N8MBzi , & - M9N8MMGxi , M9N8MMGyi , M9N8MMGzi , M9N8STAxi , M9N8STAyi , M9N8STAzi , M9N8STVxi , & - M9N8STVyi , M9N8STVzi , M9N8Vxi , M9N8Vyi , M9N8Vzi , M9N9Axi , M9N9Ayi , & - M9N9Azi , M9N9DynP , M9N9FAFxi , M9N9FAFyi , M9N9FAFzi , M9N9FAGxi , M9N9FAGyi , & - M9N9FAGzi , M9N9FAMxi , M9N9FAMyi , M9N9FAMzi , M9N9FBFxi , M9N9FBFyi , M9N9FBFzi , & - M9N9FBxi , M9N9FByi , M9N9FBzi , M9N9FDxi , M9N9FDyi , M9N9FDzi , M9N9FIxi , & - M9N9FIyi , M9N9FIzi , M9N9FMGxi , M9N9FMGyi , M9N9FMGzi , M9N9MAFxi , M9N9MAFyi , & - M9N9MAFzi , M9N9MAGxi , M9N9MAGyi , M9N9MAGzi , M9N9MBFxi , M9N9MBFyi , M9N9MBFzi , & - M9N9MBxi , M9N9MByi , M9N9MBzi , M9N9MMGxi , M9N9MMGyi , M9N9MMGzi , M9N9STAxi , & - M9N9STAyi , M9N9STAzi , M9N9STVxi , M9N9STVyi , M9N9STVzi , M9N9Vxi , M9N9Vyi , & - M9N9Vzi /) - ParamUnitsAry(1:500) = (/ & ! This lists the names of the allowed parameters, which must be sorted alphabetically - "(m/s^2) ","(m/s^2) ","(m/s^2) ","(Pa) ","(N) ","(N) ","(N) ", & - "(N) ","(N) ","(N) ","(N) ","(N) ","(N) ","(N) ", & - "(N) ","(N) ","(N) ","(N) ","(N) ","(N) ","(N) ", & - "(N) ","(N) ","(N) ","(N) ","(N-m) ","(N-m) ","(N-m) ", & - "(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ","(m/s^2) ", & - "(m/s^2) ","(m/s^2) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(Pa) ","(N) ","(N) ", & - "(N) ","(N) ","(N) ","(N) ","(N) ","(N) ","(N) ", & - "(N) ","(N) ","(N) ","(N) ","(N) ","(N) ","(N) ", & - "(N) ","(N) ","(N) ","(N) ","(N) ","(N-m) ","(N-m) ", & - "(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ", & - "(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(Pa) ","(N) ", & - "(N) ","(N) ","(N) ","(N) ","(N) ","(N) ","(N) ", & - "(N) ","(N) ","(N) ","(N) ","(N) ","(N) ","(N) ", & - "(N) ","(N) ","(N) ","(N) ","(N) ","(N) ","(N-m) ", & - "(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ", & - "(N-m) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(Pa) ", & - "(N) ","(N) ","(N) ","(N) ","(N) ","(N) ","(N) ", & - "(N) ","(N) ","(N) ","(N) ","(N) ","(N) ","(N) ", & - "(N) ","(N) ","(N) ","(N) ","(N) ","(N) ","(N) ", & - "(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ", & - "(N-m) ","(N-m) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s^2) ","(m/s^2) ","(m/s^2) ", & - "(Pa) ","(N) ","(N) ","(N) ","(N) ","(N) ","(N) ", & - "(N) ","(N) ","(N) ","(N) ","(N) ","(N) ","(N) ", & - "(N) ","(N) ","(N) ","(N) ","(N) ","(N) ","(N) ", & - "(N) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ", & - "(N-m) ","(N-m) ","(N-m) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s^2) ","(m/s^2) ", & - "(m/s^2) ","(Pa) ","(N) ","(N) ","(N) ","(N) ","(N) ", & - "(N) ","(N) ","(N) ","(N) ","(N) ","(N) ","(N) ", & - "(N) ","(N) ","(N) ","(N) ","(N) ","(N) ","(N) ", & - "(N) ","(N) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ", & - "(N-m) ","(N-m) ","(N-m) ","(N-m) ","(m/s^2) ","(m/s^2) ","(m/s^2) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s^2) ", & - "(m/s^2) ","(m/s^2) ","(Pa) ","(N) ","(N) ","(N) ","(N) ", & - "(N) ","(N) ","(N) ","(N) ","(N) ","(N) ","(N) ", & - "(N) ","(N) ","(N) ","(N) ","(N) ","(N) ","(N) ", & - "(N) ","(N) ","(N) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ", & - "(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ","(m/s^2) ","(m/s^2) ", & - "(m/s^2) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s^2) ","(m/s^2) ","(m/s^2) ","(Pa) ","(N) ","(N) ","(N) ", & - "(N) ","(N) ","(N) ","(N) ","(N) ","(N) ","(N) ", & - "(N) ","(N) ","(N) ","(N) ","(N) ","(N) ","(N) ", & - "(N) ","(N) ","(N) ","(N) ","(N-m) ","(N-m) ","(N-m) ", & - "(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ","(m/s^2) ", & - "(m/s^2) ","(m/s^2) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(Pa) ","(N) ","(N) ", & - "(N) ","(N) ","(N) ","(N) ","(N) ","(N) ","(N) ", & - "(N) ","(N) ","(N) ","(N) ","(N) ","(N) ","(N) ", & - "(N) ","(N) ","(N) ","(N) ","(N) ","(N-m) ","(N-m) ", & - "(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ", & - "(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(Pa) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s^2) ","(m/s^2) ", & - "(m/s^2) ","(Pa) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(m/s^2) ", & - "(m/s^2) ","(m/s^2) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(Pa) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) "/) - ParamUnitsAry(501:1000) = (/ & ! This lists the names of the allowed parameters, which must be sorted alphabetically - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(m/s^2) ", & - "(m/s^2) ","(m/s^2) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(Pa) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s^2) ","(m/s^2) ","(m/s^2) ", & - "(Pa) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(m/s^2) ","(m/s^2) ", & - "(m/s^2) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s^2) ","(m/s^2) ","(m/s^2) ","(Pa) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(Pa) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(m/s^2) ","(m/s^2) ","(m/s^2) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s^2) ", & - "(m/s^2) ","(m/s^2) ","(Pa) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(Pa) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s^2) ","(m/s^2) ", & - "(m/s^2) ","(Pa) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(m/s^2) ", & - "(m/s^2) ","(m/s^2) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(Pa) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s^2) ","(m/s^2) ","(m/s^2) ", & - "(Pa) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) "/) - ParamUnitsAry(1001:1500) = (/ & ! This lists the names of the allowed parameters, which must be sorted alphabetically - "(N-m/m) ","(N-m/m) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s^2) ","(m/s^2) ","(m/s^2) ", & - "(Pa) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(m/s^2) ","(m/s^2) ", & - "(m/s^2) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s^2) ","(m/s^2) ","(m/s^2) ","(Pa) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(Pa) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(m/s^2) ","(m/s^2) ","(m/s^2) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s^2) ", & - "(m/s^2) ","(m/s^2) ","(Pa) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(Pa) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s^2) ","(m/s^2) ", & - "(m/s^2) ","(Pa) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(m/s^2) ", & - "(m/s^2) ","(m/s^2) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(Pa) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s^2) ","(m/s^2) ","(m/s^2) ", & - "(Pa) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(m/s^2) ","(m/s^2) ", & - "(m/s^2) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s^2) ","(m/s^2) ","(m/s^2) ","(Pa) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(Pa) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) "/) - ParamUnitsAry(1501:2000) = (/ & ! This lists the names of the allowed parameters, which must be sorted alphabetically - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(Pa) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(m/s^2) ","(m/s^2) ","(m/s^2) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s^2) ", & - "(m/s^2) ","(m/s^2) ","(Pa) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(Pa) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s^2) ","(m/s^2) ", & - "(m/s^2) ","(Pa) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(m/s^2) ", & - "(m/s^2) ","(m/s^2) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(Pa) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s^2) ","(m/s^2) ","(m/s^2) ", & - "(Pa) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(m/s^2) ","(m/s^2) ", & - "(m/s^2) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s^2) ","(m/s^2) ","(m/s^2) ","(Pa) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(Pa) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(m/s^2) ","(m/s^2) ","(m/s^2) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s^2) ", & - "(m/s^2) ","(m/s^2) ","(Pa) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s^2) "/) - ParamUnitsAry(2001:2500) = (/ & ! This lists the names of the allowed parameters, which must be sorted alphabetically - "(m/s^2) ","(m/s^2) ","(Pa) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(Pa) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s^2) ","(m/s^2) ", & - "(m/s^2) ","(Pa) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(m/s^2) ", & - "(m/s^2) ","(m/s^2) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(Pa) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s^2) ","(m/s^2) ","(m/s^2) ", & - "(Pa) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(m/s^2) ","(m/s^2) ", & - "(m/s^2) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s^2) ","(m/s^2) ","(m/s^2) ","(Pa) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(Pa) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(m/s^2) ","(m/s^2) ","(m/s^2) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s^2) ", & - "(m/s^2) ","(m/s^2) ","(Pa) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(Pa) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s^2) ","(m/s^2) ", & - "(m/s^2) ","(Pa) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) "/) - ParamUnitsAry(2501:3000) = (/ & ! This lists the names of the allowed parameters, which must be sorted alphabetically - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s^2) ","(m/s^2) ", & - "(m/s^2) ","(Pa) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(m/s^2) ", & - "(m/s^2) ","(m/s^2) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(Pa) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s^2) ","(m/s^2) ","(m/s^2) ", & - "(Pa) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(m/s^2) ","(m/s^2) ", & - "(m/s^2) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s^2) ","(m/s^2) ","(m/s^2) ","(Pa) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(Pa) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(m/s^2) ","(m/s^2) ","(m/s^2) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s^2) ", & - "(m/s^2) ","(m/s^2) ","(Pa) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(Pa) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s^2) ","(m/s^2) ", & - "(m/s^2) ","(Pa) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(m/s^2) ", & - "(m/s^2) ","(m/s^2) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(Pa) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s^2) ","(m/s^2) ","(m/s^2) ", & - "(Pa) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) "/) - ParamUnitsAry(3001:3500) = (/ & ! This lists the names of the allowed parameters, which must be sorted alphabetically - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s^2) ","(m/s^2) ","(m/s^2) ", & - "(Pa) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(m/s^2) ","(m/s^2) ", & - "(m/s^2) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s^2) ","(m/s^2) ","(m/s^2) ","(Pa) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(Pa) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(m/s^2) ","(m/s^2) ","(m/s^2) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s^2) ", & - "(m/s^2) ","(m/s^2) ","(Pa) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(Pa) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s^2) ","(m/s^2) ", & - "(m/s^2) ","(Pa) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(m/s^2) ", & - "(m/s^2) ","(m/s^2) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(Pa) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s^2) ","(m/s^2) ","(m/s^2) ", & - "(Pa) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(m/s^2) ","(m/s^2) ", & - "(m/s^2) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s^2) ","(m/s^2) ","(m/s^2) ","(Pa) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(m/s^2) ","(m/s^2) "/) - ParamUnitsAry(3501:4000) = (/ & ! This lists the names of the allowed parameters, which must be sorted alphabetically - "(m/s^2) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s^2) ","(m/s^2) ","(m/s^2) ","(Pa) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(Pa) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(m/s^2) ","(m/s^2) ","(m/s^2) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s^2) ", & - "(m/s^2) ","(m/s^2) ","(Pa) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(Pa) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s^2) ","(m/s^2) ", & - "(m/s^2) ","(Pa) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(m/s^2) ", & - "(m/s^2) ","(m/s^2) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(Pa) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s^2) ","(m/s^2) ","(m/s^2) ", & - "(Pa) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(m/s^2) ","(m/s^2) ", & - "(m/s^2) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s^2) ","(m/s^2) ","(m/s^2) ","(Pa) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(Pa) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(m/s^2) ","(m/s^2) ","(m/s^2) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s^2) ", & - "(m/s^2) ","(m/s^2) ","(Pa) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) "/) - ParamUnitsAry(4001:4500) = (/ & ! This lists the names of the allowed parameters, which must be sorted alphabetically - "(N/m) ","(N/m) ","(N/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(m/s^2) ","(m/s^2) ","(m/s^2) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s^2) ", & - "(m/s^2) ","(m/s^2) ","(Pa) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(Pa) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s^2) ","(m/s^2) ", & - "(m/s^2) ","(Pa) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(m/s^2) ", & - "(m/s^2) ","(m/s^2) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(Pa) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s^2) ","(m/s^2) ","(m/s^2) ", & - "(Pa) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(m/s^2) ","(m/s^2) ", & - "(m/s^2) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s^2) ","(m/s^2) ","(m/s^2) ","(Pa) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(Pa) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(m/s^2) ","(m/s^2) ","(m/s^2) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s^2) ", & - "(m/s^2) ","(m/s^2) ","(Pa) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(Pa) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s^2) ","(m/s^2) ", & - "(m/s^2) ","(Pa) ","(N/m) "/) - ParamUnitsAry(4501:4599) = (/ & ! This lists the names of the allowed parameters, which must be sorted alphabetically - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s^2) ","(m/s^2) ", & - "(m/s^2) ","(Pa) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ", & - "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(m/s^2) ", & - "(m/s^2) ","(m/s^2) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s) "/) - - - GetMorisonChannels = 0 - - newFoundMask = .FALSE. + newFoundMask = 0 DO I = 1,NUserOutputs IF (.NOT. foundMask(I) ) THEN Indx = FindValidChannelIndx(UserOutputs(I), ValidParamAry) IF ( Indx > 0 ) THEN - newFoundMask(I) = .TRUE. + newFoundMask(I) = newFoundMask(I) + 1 foundMask(I) = .TRUE. GetMorisonChannels = GetMorisonChannels + 1 - - !ELSE - ! foundMask(I) = .FALSE. - END IF - END IF -END DO + END IF + END IF ! not found + END DO -IF ( GetMorisonChannels > 0 ) THEN + CALL AllocAry(OutList, GetMorisonChannels, 'Morison OutList', ErrStat, ErrMsg) - count = 1 - ! Test that num channels does not exceed max possible channels due to size of OutList - !ALLOCATE ( OutList(GetWAMITChannels) , STAT=ErrStat ) - IF ( ErrStat /= 0 ) THEN - ErrMsg = ' Error allocating memory for the OutList array in the GetMorisonChannels function.' - ErrStat = ErrID_Fatal - RETURN - END IF + IF ( GetMorisonChannels > 0 .and. ErrStat < AbortErrLev) THEN + count = 1 - DO I = 1,NUserOutputs - IF ( newFoundMask(I) ) THEN - OutList(count) = UserOutputs(I) - count = count + 1 - END IF - - END DO + DO I = 1,NUserOutputs + DO J = 1, newFoundMask(I) ! in case an output is requested more than one time + OutList(count) = UserOutputs(I) + count = count + 1 + END DO + END DO -END IF + END IF END FUNCTION GetMorisonChannels -!==================================================================================================== -SUBROUTINE MrsnOut_ChkOutLst( OutList, ValidOutList, y, 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 that the Morison module must be initialized prior to calling this function (if it -! is being used) so that it can correctly determine if the Lines outputs are valid. -!---------------------------------------------------------------------------------------------------- - - - + +!********************************************************************************************************************************** +! 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 06-Sep-2022 13:57:52. +SUBROUTINE SetOutParam(OutList, p, ErrStat, ErrMsg ) +!.................................................................................................................................. + + IMPLICIT NONE + ! Passed variables - CHARACTER(ChanLen), INTENT( IN ) :: OutList (:) ! An array holding the names of the requested output channels. - LOGICAL, INTENT( IN ) :: ValidOutList (:) ! An array holding the a flag for whether the elements are valid requested output channels. - TYPE(Morison_OutputType), INTENT( INOUT ) :: y ! Morison module output data - TYPE(Morison_ParameterType), INTENT( INOUT ) :: p ! Morison module parameter data - - 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-counting index. -! INTEGER :: J ! 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. - - - LOGICAL :: InvalidOutput(MaxMrsnOutputs) ! This array determines if the output channel is valid for this configuration - LOGICAL :: CheckOutListAgain - - InvalidOutput = .FALSE. + CHARACTER(ChanLen), INTENT(IN) :: OutList(:) !< The list out user-requested outputs + TYPE(Morison_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 - - ! Initialize ErrStat - - ErrStat = ErrID_None - ErrMsg = "" - - !------------------------------------------------------------------------------------------------- - ! ALLOCATE the OutParam array - !------------------------------------------------------------------------------------------------- - ALLOCATE ( p%OutParam(p%NumOuts) , STAT=ErrStat ) - IF ( ErrStat /= 0 ) THEN - ErrMsg = ' Error allocating memory for the OutParam array.' - ErrStat = ErrID_Fatal - RETURN - END IF - - - ! Check user-requested member and joint outputs and node lists and set InvalidOutput array values as needed - !CALL SetInvalidOutputs(NMOutputs, MOutLst, NJOutputs, JOutLst, InvalidOutput) - - 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 - - CALL WrScr(p%OutParam(I)%Name//' is not an available output channel.') - ErrMsg = ' An output channel was set as INVALID.' - ErrStat = ErrID_Warn - p%OutParam(I)%Units = 'INVALID' - p%OutParam(I)%Indx = 1 - p%OutParam(I)%SignM = 0 ! this will print all zeros - END IF - - IF ( .NOT. ValidOutList(I) ) THEN - ErrMsg = ' An output channel was set as INVALID.' - CALL WrScr(p%OutParam(I)%Name//' is not an available output channel.') - ErrStat = ErrID_Warn - p%OutParam(I)%Units = 'INVALID' - p%OutParam(I)%Indx = 1 - p%OutParam(I)%SignM = 0 - END IF - - END DO - - - - - RETURN -END SUBROUTINE MrsnOut_ChkOutLst + ! Local variables + INTEGER :: ErrStat2 ! temporary (local) error status + INTEGER :: I ! Generic loop-counting index + INTEGER :: J ! Generic loop-counting index + INTEGER :: K ! Generic loop-counting index + INTEGER :: INDX ! Index for valid arrays -!==================================================================================================== -SUBROUTINE MrsnOut_DestroyParam ( p, ErrStat, ErrMsg ) -! This function cleans up after running the HydroDyn output module. It closes the output file, -! releases memory, and resets the number of outputs requested to 0. -!---------------------------------------------------------------------------------------------------- + LOGICAL :: InvalidOutput(0:MaxOutPts) ! This array determines if the output channel is valid for this configuration + CHARACTER(*), PARAMETER :: RoutineName = "SetOutParam" - ! Passed variables - TYPE(Morison_ParameterType), INTENT( INOUT ) :: p ! parameter data for this instance of the Morison module - INTEGER, INTENT( OUT ) :: ErrStat ! a non-zero value indicates an error occurred - CHARACTER(*), INTENT( OUT ) :: ErrMsg ! Error message if ErrStat /= ErrID_None -! ! Internal variables - LOGICAL :: Err + CHARACTER(ChanLen), PARAMETER :: ParamUnitsAry1(1542) = (/ character(ChanLen) :: & ! This lists the units corresponding to the allowed parameters + "(m/s^2)","(m/s^2)","(m/s^2)","(Pa) ","(N) ","(N) ","(N) ", & + "(N) ","(N) ","(N) ","(N) ","(N) ","(N) ","(N) ", & + "(N) ","(N) ","(N) ","(N) ","(N) ","(N) ","(N) ", & + "(N) ","(N) ","(N) ","(N) ","(N-m) ","(N-m) ","(N-m) ", & + "(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ","(m/s^2)", & + "(m/s^2)","(m/s^2)","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & + "(m/s) ","(m) ","(m) ","(m) ","(m/s^2)","(m/s^2)","(m/s^2)", & + "(Pa) ","(N) ","(N) ","(N) ","(N) ","(N) ","(N) ", & + "(N) ","(N) ","(N) ","(N) ","(N) ","(N) ","(N) ", & + "(N) ","(N) ","(N) ","(N) ","(N) ","(N) ","(N) ", & + "(N) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ", & + "(N-m) ","(N-m) ","(N-m) ","(m/s^2)","(m/s^2)","(m/s^2)","(m/s) ", & + "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m) ","(m) ", & + "(m) ","(m/s^2)","(m/s^2)","(m/s^2)","(Pa) ","(N) ","(N) ", & + "(N) ","(N) ","(N) ","(N) ","(N) ","(N) ","(N) ", & + "(N) ","(N) ","(N) ","(N) ","(N) ","(N) ","(N) ", & + "(N) ","(N) ","(N) ","(N) ","(N) ","(N-m) ","(N-m) ", & + "(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ", & + "(m/s^2)","(m/s^2)","(m/s^2)","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & + "(m/s) ","(m/s) ","(m) ","(m) ","(m) ","(m/s^2)","(m/s^2)", & + "(m/s^2)","(Pa) ","(N) ","(N) ","(N) ","(N) ","(N) ", & + "(N) ","(N) ","(N) ","(N) ","(N) ","(N) ","(N) ", & + "(N) ","(N) ","(N) ","(N) ","(N) ","(N) ","(N) ", & + "(N) ","(N) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ", & + "(N-m) ","(N-m) ","(N-m) ","(N-m) ","(m/s^2)","(m/s^2)","(m/s^2)", & + "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m) ", & + "(m) ","(m) ","(m/s^2)","(m/s^2)","(m/s^2)","(Pa) ","(N) ", & + "(N) ","(N) ","(N) ","(N) ","(N) ","(N) ","(N) ", & + "(N) ","(N) ","(N) ","(N) ","(N) ","(N) ","(N) ", & + "(N) ","(N) ","(N) ","(N) ","(N) ","(N) ","(N-m) ", & + "(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ", & + "(N-m) ","(m/s^2)","(m/s^2)","(m/s^2)","(m/s) ","(m/s) ","(m/s) ", & + "(m/s) ","(m/s) ","(m/s) ","(m) ","(m) ","(m) ","(m/s^2)", & + "(m/s^2)","(m/s^2)","(Pa) ","(N) ","(N) ","(N) ","(N) ", & + "(N) ","(N) ","(N) ","(N) ","(N) ","(N) ","(N) ", & + "(N) ","(N) ","(N) ","(N) ","(N) ","(N) ","(N) ", & + "(N) ","(N) ","(N) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ", & + "(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ","(m/s^2)","(m/s^2)", & + "(m/s^2)","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & + "(m) ","(m) ","(m) ","(m/s^2)","(m/s^2)","(m/s^2)","(Pa) ", & + "(N) ","(N) ","(N) ","(N) ","(N) ","(N) ","(N) ", & + "(N) ","(N) ","(N) ","(N) ","(N) ","(N) ","(N) ", & + "(N) ","(N) ","(N) ","(N) ","(N) ","(N) ","(N) ", & + "(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ", & + "(N-m) ","(N-m) ","(m/s^2)","(m/s^2)","(m/s^2)","(m/s) ","(m/s) ", & + "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m) ","(m) ","(m) ", & + "(m/s^2)","(m/s^2)","(m/s^2)","(Pa) ","(N) ","(N) ","(N) ", & + "(N) ","(N) ","(N) ","(N) ","(N) ","(N) ","(N) ", & + "(N) ","(N) ","(N) ","(N) ","(N) ","(N) ","(N) ", & + "(N) ","(N) ","(N) ","(N) ","(N-m) ","(N-m) ","(N-m) ", & + "(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ","(m/s^2)", & + "(m/s^2)","(m/s^2)","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & + "(m/s) ","(m) ","(m) ","(m) ","(m/s^2)","(m/s^2)","(m/s^2)", & + "(Pa) ","(N) ","(N) ","(N) ","(N) ","(N) ","(N) ", & + "(N) ","(N) ","(N) ","(N) ","(N) ","(N) ","(N) ", & + "(N) ","(N) ","(N) ","(N) ","(N) ","(N) ","(N) ", & + "(N) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ", & + "(N-m) ","(N-m) ","(N-m) ","(m/s^2)","(m/s^2)","(m/s^2)","(m/s) ", & + "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m) ","(m) ", & + "(m) ","(m/s^2)","(m/s^2)","(m/s^2)","(Pa) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(m/s^2)","(m/s^2)","(m/s^2)","(m/s) ","(m/s) ", & + "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s^2)","(m/s^2)","(m/s^2)", & + "(Pa) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(m/s^2)","(m/s^2)", & + "(m/s^2)","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & + "(m/s^2)","(m/s^2)","(m/s^2)","(Pa) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(m/s^2)","(m/s^2)","(m/s^2)","(m/s) ","(m/s) ","(m/s) ", & + "(m/s) ","(m/s) ","(m/s) ","(m/s^2)","(m/s^2)","(m/s^2)","(Pa) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(m/s^2)","(m/s^2)","(m/s^2)", & + "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s^2)", & + "(m/s^2)","(m/s^2)","(Pa) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(m/s^2)","(m/s^2)","(m/s^2)","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & + "(m/s) ","(m/s) ","(m/s^2)","(m/s^2)","(m/s^2)","(Pa) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(m/s^2)","(m/s^2)","(m/s^2)","(m/s) ", & + "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s^2)","(m/s^2)", & + "(m/s^2)","(Pa) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(m/s^2)", & + "(m/s^2)","(m/s^2)","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & + "(m/s) ","(m/s^2)","(m/s^2)","(m/s^2)","(Pa) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(m/s^2)","(m/s^2)","(m/s^2)","(m/s) ","(m/s) ", & + "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s^2)","(m/s^2)","(m/s^2)", & + "(Pa) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(m/s^2)","(m/s^2)", & + "(m/s^2)","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & + "(m/s^2)","(m/s^2)","(m/s^2)","(Pa) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(m/s^2)","(m/s^2)","(m/s^2)","(m/s) ","(m/s) ","(m/s) ", & + "(m/s) ","(m/s) ","(m/s) ","(m/s^2)","(m/s^2)","(m/s^2)","(Pa) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(m/s^2)","(m/s^2)","(m/s^2)", & + "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s^2)", & + "(m/s^2)","(m/s^2)","(Pa) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(m/s^2)","(m/s^2)","(m/s^2)","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & + "(m/s) ","(m/s) ","(m/s^2)","(m/s^2)","(m/s^2)","(Pa) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(m/s^2)","(m/s^2)","(m/s^2)","(m/s) ", & + "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s^2)","(m/s^2)", & + "(m/s^2)","(Pa) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(m/s^2)", & + "(m/s^2)","(m/s^2)","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & + "(m/s) ","(m/s^2)","(m/s^2)","(m/s^2)","(Pa) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(m/s^2)","(m/s^2)","(m/s^2)","(m/s) ","(m/s) ", & + "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s^2)","(m/s^2)","(m/s^2)", & + "(Pa) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(m/s^2)","(m/s^2)", & + "(m/s^2)","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & + "(m/s^2)","(m/s^2)","(m/s^2)","(Pa) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(m/s^2)","(m/s^2)","(m/s^2)","(m/s) ","(m/s) ","(m/s) ", & + "(m/s) ","(m/s) ","(m/s) ","(m/s^2)","(m/s^2)","(m/s^2)","(Pa) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(m/s^2)","(m/s^2)","(m/s^2)", & + "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s^2)", & + "(m/s^2)","(m/s^2)","(Pa) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(m/s^2)","(m/s^2)","(m/s^2)","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & + "(m/s) ","(m/s) ","(m/s^2)","(m/s^2)","(m/s^2)","(Pa) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(m/s^2)","(m/s^2)","(m/s^2)","(m/s) ", & + "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s^2)","(m/s^2)", & + "(m/s^2)","(Pa) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(m/s^2)", & + "(m/s^2)","(m/s^2)","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & + "(m/s) ","(m/s^2)","(m/s^2)","(m/s^2)","(Pa) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)"/) + CHARACTER(ChanLen), PARAMETER :: ParamUnitsAry2(1542) = (/ character(ChanLen) :: & ! This lists the units corresponding to the allowed parameters + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(m/s^2)","(m/s^2)","(m/s^2)","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & + "(m/s) ","(m/s) ","(m/s^2)","(m/s^2)","(m/s^2)","(Pa) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(m/s^2)","(m/s^2)","(m/s^2)","(m/s) ", & + "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s^2)","(m/s^2)", & + "(m/s^2)","(Pa) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(m/s^2)", & + "(m/s^2)","(m/s^2)","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & + "(m/s) ","(m/s^2)","(m/s^2)","(m/s^2)","(Pa) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(m/s^2)","(m/s^2)","(m/s^2)","(m/s) ","(m/s) ", & + "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s^2)","(m/s^2)","(m/s^2)", & + "(Pa) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(m/s^2)","(m/s^2)", & + "(m/s^2)","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & + "(m/s^2)","(m/s^2)","(m/s^2)","(Pa) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(m/s^2)","(m/s^2)","(m/s^2)","(m/s) ","(m/s) ","(m/s) ", & + "(m/s) ","(m/s) ","(m/s) ","(m/s^2)","(m/s^2)","(m/s^2)","(Pa) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(m/s^2)","(m/s^2)","(m/s^2)", & + "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s^2)", & + "(m/s^2)","(m/s^2)","(Pa) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(m/s^2)","(m/s^2)","(m/s^2)","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & + "(m/s) ","(m/s) ","(m/s^2)","(m/s^2)","(m/s^2)","(Pa) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(m/s^2)","(m/s^2)","(m/s^2)","(m/s) ", & + "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s^2)","(m/s^2)", & + "(m/s^2)","(Pa) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(m/s^2)", & + "(m/s^2)","(m/s^2)","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & + "(m/s) ","(m/s^2)","(m/s^2)","(m/s^2)","(Pa) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(m/s^2)","(m/s^2)","(m/s^2)","(m/s) ","(m/s) ", & + "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s^2)","(m/s^2)","(m/s^2)", & + "(Pa) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(m/s^2)","(m/s^2)", & + "(m/s^2)","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & + "(m/s^2)","(m/s^2)","(m/s^2)","(Pa) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(m/s^2)","(m/s^2)","(m/s^2)","(m/s) ","(m/s) ","(m/s) ", & + "(m/s) ","(m/s) ","(m/s) ","(m/s^2)","(m/s^2)","(m/s^2)","(Pa) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(m/s^2)","(m/s^2)","(m/s^2)", & + "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s^2)", & + "(m/s^2)","(m/s^2)","(Pa) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(m/s^2)","(m/s^2)","(m/s^2)","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & + "(m/s) ","(m/s) ","(m/s^2)","(m/s^2)","(m/s^2)","(Pa) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(m/s^2)","(m/s^2)","(m/s^2)","(m/s) ", & + "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s^2)","(m/s^2)", & + "(m/s^2)","(Pa) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(m/s^2)", & + "(m/s^2)","(m/s^2)","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & + "(m/s) ","(m/s^2)","(m/s^2)","(m/s^2)","(Pa) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(m/s^2)","(m/s^2)","(m/s^2)","(m/s) ","(m/s) ", & + "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s^2)","(m/s^2)","(m/s^2)", & + "(Pa) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(m/s^2)","(m/s^2)", & + "(m/s^2)","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & + "(m/s^2)","(m/s^2)","(m/s^2)","(Pa) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(m/s^2)","(m/s^2)","(m/s^2)","(m/s) ","(m/s) ","(m/s) ", & + "(m/s) ","(m/s) ","(m/s) ","(m/s^2)","(m/s^2)","(m/s^2)","(Pa) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(m/s^2)","(m/s^2)","(m/s^2)", & + "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s^2)", & + "(m/s^2)","(m/s^2)","(Pa) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(m/s^2)","(m/s^2)","(m/s^2)","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & + "(m/s) ","(m/s) ","(m/s^2)","(m/s^2)","(m/s^2)","(Pa) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(m/s^2)","(m/s^2)","(m/s^2)","(m/s) ", & + "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s^2)","(m/s^2)", & + "(m/s^2)","(Pa) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(m/s^2)", & + "(m/s^2)","(m/s^2)","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & + "(m/s) ","(m/s^2)","(m/s^2)","(m/s^2)","(Pa) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(m/s^2)","(m/s^2)","(m/s^2)","(m/s) ","(m/s) ", & + "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s^2)","(m/s^2)","(m/s^2)", & + "(Pa) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(m/s^2)","(m/s^2)", & + "(m/s^2)","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & + "(m/s^2)","(m/s^2)","(m/s^2)","(Pa) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(m/s^2)","(m/s^2)","(m/s^2)","(m/s) ","(m/s) ","(m/s) ", & + "(m/s) ","(m/s) ","(m/s) ","(m/s^2)","(m/s^2)","(m/s^2)","(Pa) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(m/s^2)","(m/s^2)","(m/s^2)", & + "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s^2)", & + "(m/s^2)","(m/s^2)","(Pa) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(m/s^2)","(m/s^2)","(m/s^2)","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & + "(m/s) ","(m/s) ","(m/s^2)","(m/s^2)","(m/s^2)","(Pa) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(m/s^2)","(m/s^2)","(m/s^2)","(m/s) ", & + "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s^2)","(m/s^2)", & + "(m/s^2)","(Pa) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) "/) + CHARACTER(ChanLen), PARAMETER :: ParamUnitsAry3(1542) = (/ character(ChanLen) :: & ! This lists the units corresponding to the allowed parameters + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(m/s^2)","(m/s^2)","(m/s^2)", & + "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s^2)", & + "(m/s^2)","(m/s^2)","(Pa) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(m/s^2)","(m/s^2)","(m/s^2)","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & + "(m/s) ","(m/s) ","(m/s^2)","(m/s^2)","(m/s^2)","(Pa) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(m/s^2)","(m/s^2)","(m/s^2)","(m/s) ", & + "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s^2)","(m/s^2)", & + "(m/s^2)","(Pa) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(m/s^2)", & + "(m/s^2)","(m/s^2)","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & + "(m/s) ","(m/s^2)","(m/s^2)","(m/s^2)","(Pa) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(m/s^2)","(m/s^2)","(m/s^2)","(m/s) ","(m/s) ", & + "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s^2)","(m/s^2)","(m/s^2)", & + "(Pa) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(m/s^2)","(m/s^2)", & + "(m/s^2)","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & + "(m/s^2)","(m/s^2)","(m/s^2)","(Pa) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(m/s^2)","(m/s^2)","(m/s^2)","(m/s) ","(m/s) ","(m/s) ", & + "(m/s) ","(m/s) ","(m/s) ","(m/s^2)","(m/s^2)","(m/s^2)","(Pa) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(m/s^2)","(m/s^2)","(m/s^2)", & + "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s^2)", & + "(m/s^2)","(m/s^2)","(Pa) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(m/s^2)","(m/s^2)","(m/s^2)","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & + "(m/s) ","(m/s) ","(m/s^2)","(m/s^2)","(m/s^2)","(Pa) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(m/s^2)","(m/s^2)","(m/s^2)","(m/s) ", & + "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s^2)","(m/s^2)", & + "(m/s^2)","(Pa) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(m/s^2)", & + "(m/s^2)","(m/s^2)","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & + "(m/s) ","(m/s^2)","(m/s^2)","(m/s^2)","(Pa) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(m/s^2)","(m/s^2)","(m/s^2)","(m/s) ","(m/s) ", & + "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s^2)","(m/s^2)","(m/s^2)", & + "(Pa) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(m/s^2)","(m/s^2)", & + "(m/s^2)","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & + "(m/s^2)","(m/s^2)","(m/s^2)","(Pa) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(m/s^2)","(m/s^2)","(m/s^2)","(m/s) ","(m/s) ","(m/s) ", & + "(m/s) ","(m/s) ","(m/s) ","(m/s^2)","(m/s^2)","(m/s^2)","(Pa) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(m/s^2)","(m/s^2)","(m/s^2)", & + "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s^2)", & + "(m/s^2)","(m/s^2)","(Pa) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(m/s^2)","(m/s^2)","(m/s^2)","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & + "(m/s) ","(m/s) ","(m/s^2)","(m/s^2)","(m/s^2)","(Pa) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(m/s^2)","(m/s^2)","(m/s^2)","(m/s) ", & + "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s^2)","(m/s^2)", & + "(m/s^2)","(Pa) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(m/s^2)", & + "(m/s^2)","(m/s^2)","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & + "(m/s) ","(m/s^2)","(m/s^2)","(m/s^2)","(Pa) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(m/s^2)","(m/s^2)","(m/s^2)","(m/s) ","(m/s) ", & + "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s^2)","(m/s^2)","(m/s^2)", & + "(Pa) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(m/s^2)","(m/s^2)", & + "(m/s^2)","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & + "(m/s^2)","(m/s^2)","(m/s^2)","(Pa) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(m/s^2)","(m/s^2)","(m/s^2)","(m/s) ","(m/s) ","(m/s) ", & + "(m/s) ","(m/s) ","(m/s) ","(m/s^2)","(m/s^2)","(m/s^2)","(Pa) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(m/s^2)","(m/s^2)","(m/s^2)", & + "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s^2)", & + "(m/s^2)","(m/s^2)","(Pa) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(m/s^2)","(m/s^2)","(m/s^2)","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & + "(m/s) ","(m/s) ","(m/s^2)","(m/s^2)","(m/s^2)","(Pa) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(m/s^2)","(m/s^2)","(m/s^2)","(m/s) ", & + "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s^2)","(m/s^2)", & + "(m/s^2)","(Pa) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(m/s^2)", & + "(m/s^2)","(m/s^2)","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & + "(m/s) ","(m/s^2)","(m/s^2)","(m/s^2)","(Pa) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(m/s^2)","(m/s^2)","(m/s^2)","(m/s) ","(m/s) ", & + "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s^2)","(m/s^2)","(m/s^2)", & + "(Pa) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(m/s^2)","(m/s^2)", & + "(m/s^2)","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & + "(m/s^2)","(m/s^2)","(m/s^2)","(Pa) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(m/s^2)","(m/s^2)","(m/s^2)","(m/s) ","(m/s) ","(m/s) ", & + "(m/s) ","(m/s) ","(m/s) ","(m/s^2)","(m/s^2)","(m/s^2)","(Pa) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(m/s^2)","(m/s^2)","(m/s^2)", & + "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s^2)", & + "(m/s^2)","(m/s^2)","(Pa) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)","(N-m/m)", & + "(m/s^2)","(m/s^2)","(m/s^2)","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & + "(m/s) ","(m/s) "/) + CHARACTER(OutStrLenM1), PARAMETER :: ParamUnitsAry(4626) = (/ & ! This lists the units corresponding to the allowed parameters + ParamUnitsAry1, ParamUnitsAry2, ParamUnitsAry3/) - !------------------------------------------------------------------------------------------------- - ! Initialize error information - !------------------------------------------------------------------------------------------------- + + ! Initialize values ErrStat = ErrID_None - ErrMsg = "" - Err = .FALSE. + ErrMsg = "" + InvalidOutput = .FALSE. - - !------------------------------------------------------------------------------------------------- - ! Deallocate arrays - !------------------------------------------------------------------------------------------------- - IF ( ALLOCATED( p%OutParam ) ) DEALLOCATE ( p%OutParam, STAT=ErrStat ) - IF ( ErrStat /= 0 ) Err = .TRUE. - - !------------------------------------------------------------------------------------------------- - ! Reset number of outputs - !------------------------------------------------------------------------------------------------- - p%NumOuts = 0 - +! ..... Developer must add checking for invalid inputs here: ..... + ! invalid members + DO J=p%NMOutputs+1, 9 + DO I=1,9 + InvalidOutput( MNDynP( I,J)) = .true. + DO K=1,3 + InvalidOutput( MNVi( K,I,J)) = .true. + InvalidOutput( MNAi( K,I,J)) = .true. + InvalidOutput( MNSTVi(K,I,J)) = .true. + InvalidOutput( MNSTAi(K,I,J)) = .true. + InvalidOutput( MNFDi( K,I,J)) = .true. + InvalidOutput( MNFIi( K,I,J)) = .true. + InvalidOutput( MNFBi( K,I,J)) = .true. + InvalidOutput( MNMBi( K,I,J)) = .true. + InvalidOutput( MNFBFi(K,I,J)) = .true. + InvalidOutput( MNMBFi(K,I,J)) = .true. + InvalidOutput( MNFMGi(K,I,J)) = .true. + InvalidOutput( MNMMGi(K,I,J)) = .true. + InvalidOutput( MNFAMi(K,I,J)) = .true. + InvalidOutput( MNFAGi(K,I,J)) = .true. + InvalidOutput( MNMAGi(K,I,J)) = .true. + InvalidOutput( MNFAFi(K,I,J)) = .true. + InvalidOutput( MNMAFi(K,I,J)) = .true. + END DO + END DO + END DO + + ! invalid nodes on valid members + DO J=1,p%NMOutputs + DO I=p%MOutLst(J)%NOutLoc+1,9 + InvalidOutput( MNDynP( I,J)) = .true. + DO K=1,3 + InvalidOutput( MNVi( K,I,J)) = .true. + InvalidOutput( MNAi( K,I,J)) = .true. + InvalidOutput( MNSTVi(K,I,J)) = .true. + InvalidOutput( MNSTAi(K,I,J)) = .true. + InvalidOutput( MNFDi( K,I,J)) = .true. + InvalidOutput( MNFIi( K,I,J)) = .true. + InvalidOutput( MNFBi( K,I,J)) = .true. + InvalidOutput( MNMBi( K,I,J)) = .true. + InvalidOutput( MNFBFi(K,I,J)) = .true. + InvalidOutput( MNMBFi(K,I,J)) = .true. + InvalidOutput( MNFMGi(K,I,J)) = .true. + InvalidOutput( MNMMGi(K,I,J)) = .true. + InvalidOutput( MNFAMi(K,I,J)) = .true. + InvalidOutput( MNFAGi(K,I,J)) = .true. + InvalidOutput( MNMAGi(K,I,J)) = .true. + InvalidOutput( MNFAFi(K,I,J)) = .true. + InvalidOutput( MNMAFi(K,I,J)) = .true. + END DO + END DO + END DO + + ! invalid joints + DO I=p%NJOutputs+1,9 + InvalidOutput( JDynP( I)) = .true. + InvalidOutput( JWaveElev( I)) = .true. + InvalidOutput( JWaveElev1(I)) = .true. + InvalidOutput( JWaveElev2(I)) = .true. + DO K=1,3 + InvalidOutput( JVi( K,I)) = .true. + InvalidOutput( JAi( K,I)) = .true. + InvalidOutput( JSTVi(K,I)) = .true. + InvalidOutput( JSTAi(K,I)) = .true. + InvalidOutput( JFDi( K,I)) = .true. + InvalidOutput( JFBi( K,I)) = .true. + InvalidOutput( JMBi( K,I)) = .true. + InvalidOutput( JFBFi(K,I)) = .true. + InvalidOutput( JMBFi(K,I)) = .true. + InvalidOutput( JFIi( K,I)) = .true. + InvalidOutput( JFAMi(K,I)) = .true. + InvalidOutput( JFAGi(K,I)) = .true. + InvalidOutput( JMAGi(K,I)) = .true. + InvalidOutput( JFMGi(K,I)) = .true. + END DO + END DO + +! ................. End of validity checking ................. + + !------------------------------------------------------------------------------------------------- - ! Make sure ErrStat is non-zero if an error occurred + ! 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. !------------------------------------------------------------------------------------------------- - IF ( Err ) ErrStat = ErrID_Fatal - - RETURN -END SUBROUTINE MrsnOut_DestroyParam -!==================================================================================================== + ALLOCATE ( p%OutParam(1:p%NumOuts) , STAT=ErrStat2 ) + IF ( ErrStat2 /= 0_IntKi ) THEN + CALL SetErrStat( ErrID_Fatal,"Error allocating memory for the Morison 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) + + Indx = FindValidChannelIndx(OutList(I), ValidParamAry, p%OutParam(I)%SignM) + + 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 = 1 ! pick any channel in the AllOuts array + 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 = 1 ! pick any channel in the AllOuts array + p%OutParam(I)%Units = "INVALID" + p%OutParam(I)%SignM = 0 ! multiply all results by zero + + CALL SetErrStat(ErrID_Warn, 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 Morison_Output diff --git a/modules/hydrodyn/src/Morison_Types.f90 b/modules/hydrodyn/src/Morison_Types.f90 index bfa9d65c53..debd48162d 100644 --- a/modules/hydrodyn/src/Morison_Types.f90 +++ b/modules/hydrodyn/src/Morison_Types.f90 @@ -31,128 +31,141 @@ !! unpack routines associated with each defined data type. This code is automatically generated by the FAST Registry. MODULE Morison_Types !--------------------------------------------------------------------------------------------------------------------------------- +USE SeaSt_WaveField_Types USE NWTC_Library IMPLICIT NONE - INTEGER(IntKi), PUBLIC, PARAMETER :: MaxMrsnOutputs = 4599 ! Total number of possible Morison module output channels [-] ! ========= Morison_JointType ======= TYPE, PUBLIC :: Morison_JointType - INTEGER(IntKi) :: JointID !< User-specified integer ID for the given joint [-] - REAL(ReKi) , DIMENSION(1:3) :: Position !< Undisplaced location of the joint in the platform coordinate system [m] - INTEGER(IntKi) :: JointAxID !< Axial ID (found in the user-supplied Axial Coefficients Table) for this joint: used to determine axial coefs [-] - INTEGER(IntKi) :: JointAxIDIndx !< The index into the Axial Coefs arrays corresponding to the above Axial ID [-] - INTEGER(IntKi) :: JointOvrlp !< Joint overlap code [Unused [-] - INTEGER(IntKi) :: NConnections !< Number of members connecting to this joint [-] - INTEGER(IntKi) , DIMENSION(1:10) :: ConnectionList !< List of Members connected to this joint. The member index is what is stored, not the Member ID [-] + INTEGER(IntKi) :: JointID = 0_IntKi !< User-specified integer ID for the given joint [-] + REAL(ReKi) , DIMENSION(1:3) :: Position = 0.0_ReKi !< Undisplaced location of the joint in the platform coordinate system [m] + INTEGER(IntKi) :: JointAxID = 0_IntKi !< Axial ID (found in the user-supplied Axial Coefficients Table) for this joint: used to determine axial coefs [-] + INTEGER(IntKi) :: JointAxIDIndx = 0_IntKi !< The index into the Axial Coefs arrays corresponding to the above Axial ID [-] + INTEGER(IntKi) :: JointOvrlp = 0_IntKi !< Joint overlap code [Unused [-] + INTEGER(IntKi) :: NConnections = 0_IntKi !< Number of members connecting to this joint [-] + INTEGER(IntKi) , DIMENSION(1:50) :: ConnectionList = 0_IntKi !< List of Members connected to this joint. The member index is what is stored, not the Member ID [-] END TYPE Morison_JointType ! ======================= ! ========= Morison_MemberPropType ======= TYPE, PUBLIC :: Morison_MemberPropType - INTEGER(IntKi) :: PropSetID !< User-specified integer ID for this group of properties [-] - REAL(ReKi) :: PropD !< Diameter [m] - REAL(ReKi) :: PropThck !< Wall thickness [m] + INTEGER(IntKi) :: PropSetID = 0_IntKi !< User-specified integer ID for this group of properties [-] + REAL(ReKi) :: PropD = 0.0_ReKi !< Diameter [m] + REAL(ReKi) :: PropThck = 0.0_ReKi !< Wall thickness [m] END TYPE Morison_MemberPropType ! ======================= ! ========= Morison_FilledGroupType ======= TYPE, PUBLIC :: Morison_FilledGroupType - INTEGER(IntKi) :: FillNumM !< Number of members in the Fill Group [-] + INTEGER(IntKi) :: FillNumM = 0_IntKi !< Number of members in the Fill Group [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: FillMList !< List of Member IDs for the members in this fill group [-] - REAL(ReKi) :: FillFSLoc !< The free-surface location (in Z) for this fill group [m] + REAL(ReKi) :: FillFSLoc = 0.0_ReKi !< The free-surface location (in Z) for this fill group [m] CHARACTER(80) :: FillDensChr !< String version of the Fill density [can be DEFAULT which sets the fill density to WtrDens] [kg/m^3] - REAL(ReKi) :: FillDens !< Numerical fill density [kg/m^3] + REAL(ReKi) :: FillDens = 0.0_ReKi !< Numerical fill density [kg/m^3] END TYPE Morison_FilledGroupType ! ======================= ! ========= Morison_CoefDpths ======= TYPE, PUBLIC :: Morison_CoefDpths - REAL(ReKi) :: Dpth !< Depth location for these depth-based hydrodynamic coefs [m] - REAL(ReKi) :: DpthCd !< Depth-based drag coef [-] - REAL(ReKi) :: DpthCdMG !< Depth-based drag coef for marine growth [-] - REAL(ReKi) :: DpthCa !< Depth-based Ca [-] - REAL(ReKi) :: DpthCaMG !< Depth-based Ca for marine growth [-] - REAL(ReKi) :: DpthCp !< Depth-based Cp [-] - REAL(ReKi) :: DpthCpMG !< Depth-based Cp for marine growth [-] - REAL(ReKi) :: DpthAxCd !< Depth-based Axial Cd [-] - REAL(ReKi) :: DpthAxCdMG !< Depth-based Axial Cd for marine growth [-] - REAL(ReKi) :: DpthAxCa !< Depth-based Axial Ca [-] - REAL(ReKi) :: DpthAxCaMG !< Depth-based Axial Ca for marine growth [-] - REAL(ReKi) :: DpthAxCp !< Depth-based Axial Cp [-] - REAL(ReKi) :: DpthAxCpMG !< Depth-based Axial Cp for marine growth [-] + REAL(ReKi) :: Dpth = 0.0_ReKi !< Depth location for these depth-based hydrodynamic coefs [m] + REAL(ReKi) :: DpthCd = 0.0_ReKi !< Depth-based drag coef [-] + REAL(ReKi) :: DpthCdMG = 0.0_ReKi !< Depth-based drag coef for marine growth [-] + REAL(ReKi) :: DpthCa = 0.0_ReKi !< Depth-based Ca [-] + REAL(ReKi) :: DpthCaMG = 0.0_ReKi !< Depth-based Ca for marine growth [-] + REAL(ReKi) :: DpthCp = 0.0_ReKi !< Depth-based Cp [-] + REAL(ReKi) :: DpthCpMG = 0.0_ReKi !< Depth-based Cp for marine growth [-] + REAL(ReKi) :: DpthAxCd = 0.0_ReKi !< Depth-based Axial Cd [-] + REAL(ReKi) :: DpthAxCdMG = 0.0_ReKi !< Depth-based Axial Cd for marine growth [-] + REAL(ReKi) :: DpthAxCa = 0.0_ReKi !< Depth-based Axial Ca [-] + REAL(ReKi) :: DpthAxCaMG = 0.0_ReKi !< Depth-based Axial Ca for marine growth [-] + REAL(ReKi) :: DpthAxCp = 0.0_ReKi !< Depth-based Axial Cp [-] + REAL(ReKi) :: DpthAxCpMG = 0.0_ReKi !< Depth-based Axial Cp for marine growth [-] + REAL(ReKi) :: DpthCb = 0.0_ReKi !< Simple model hydrostatic/buoyancy load coefficient [-] + REAL(ReKi) :: DpthCbMg = 0.0_ReKi !< Simple model hydrostatic/buoyancy load coefficient for marine growth [-] + LOGICAL :: DpthMCF = .false. !< Flag T/F for whether the member is modeled with the MacCamy-Fuchs diffraction model [-] END TYPE Morison_CoefDpths ! ======================= ! ========= Morison_AxialCoefType ======= TYPE, PUBLIC :: Morison_AxialCoefType - INTEGER(IntKi) :: AxCoefID !< User-supplied integer ID for this set of Axial coefs [-] - REAL(ReKi) :: AxCd !< Axial Cd [-] - REAL(ReKi) :: AxCa !< Axial Ca [-] - REAL(ReKi) :: AxCp !< Axial Cp [-] + INTEGER(IntKi) :: AxCoefID = 0_IntKi !< User-supplied integer ID for this set of Axial coefs [-] + REAL(ReKi) :: AxCd = 0.0_ReKi !< Axial Cd [-] + REAL(ReKi) :: AxCa = 0.0_ReKi !< Axial Ca [-] + REAL(ReKi) :: AxCp = 0.0_ReKi !< Axial Cp [-] + REAL(ReKi) :: AxVnCOff = 0.0_ReKi !< High-pass cut-off frequency for normal velocity when computing axial drag force [-] + REAL(ReKi) :: AxFDLoFSc = 0.0_ReKi !< Scaling factor for low frequency axial drag force [-] + INTEGER(IntKi) :: AxFDMod = 0_IntKi !< Switch for the axial drag formulation {0: original formulation, 1: Away from member only} [-] END TYPE Morison_AxialCoefType ! ======================= ! ========= Morison_MemberInputType ======= TYPE, PUBLIC :: Morison_MemberInputType - INTEGER(IntKi) :: MemberID !< User-supplied integer ID for this member [-] + INTEGER(IntKi) :: MemberID = 0_IntKi !< User-supplied integer ID for this member [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: NodeIndx !< Index of each of the member's nodes in the master node list [-] - INTEGER(IntKi) :: MJointID1 !< Joint ID for start of member [-] - INTEGER(IntKi) :: MJointID2 !< Joint ID for end of member [-] - INTEGER(IntKi) :: MJointID1Indx !< Index into the joint table for the start of this member [-] - INTEGER(IntKi) :: MJointID2Indx !< Index into the joint table for the end of this member [-] - INTEGER(IntKi) :: MPropSetID1 !< Property set ID for the start of this member [-] - INTEGER(IntKi) :: MPropSetID2 !< Property set ID for the end of this member [-] - INTEGER(IntKi) :: MPropSetID1Indx !< Index into the Property table for the start of this member [-] - INTEGER(IntKi) :: MPropSetID2Indx !< Index into the Property table for the end of this member [-] - REAL(ReKi) :: MDivSize !< User-specified desired member discretization size for the final element [m] - INTEGER(IntKi) :: MCoefMod !< Which coef. model is being used for this member [1=simple, 2=depth-based, 3=member-based] [-] - INTEGER(IntKi) :: MmbrCoefIDIndx !< Index into the appropriate coefs table for this member's properties [-] - INTEGER(IntKi) :: MmbrFilledIDIndx !< Index into the filled group table if this is a filled member [-] - LOGICAL :: PropPot !< Flag T/F for whether the member is modeled with potential flow theory [-] - INTEGER(IntKi) :: NElements !< number of elements in this member [-] - REAL(ReKi) :: RefLength !< the reference total length for this member [m] - REAL(ReKi) :: dl !< the reference element length for this member (may be less than MDivSize to achieve uniform element lengths) [m] + INTEGER(IntKi) :: MJointID1 = 0_IntKi !< Joint ID for start of member [-] + INTEGER(IntKi) :: MJointID2 = 0_IntKi !< Joint ID for end of member [-] + INTEGER(IntKi) :: MJointID1Indx = 0_IntKi !< Index into the joint table for the start of this member [-] + INTEGER(IntKi) :: MJointID2Indx = 0_IntKi !< Index into the joint table for the end of this member [-] + INTEGER(IntKi) :: MPropSetID1 = 0_IntKi !< Property set ID for the start of this member [-] + INTEGER(IntKi) :: MPropSetID2 = 0_IntKi !< Property set ID for the end of this member [-] + INTEGER(IntKi) :: MPropSetID1Indx = 0_IntKi !< Index into the Property table for the start of this member [-] + INTEGER(IntKi) :: MPropSetID2Indx = 0_IntKi !< Index into the Property table for the end of this member [-] + REAL(ReKi) :: MDivSize = 0.0_ReKi !< User-specified desired member discretization size for the final element [m] + INTEGER(IntKi) :: MCoefMod = 0_IntKi !< Which coef. model is being used for this member [1=simple, 2=depth-based, 3=member-based] [-] + INTEGER(IntKi) :: MHstLMod = 0_IntKi !< Which hydrostatic model is being used for this member [1=column-type, 2=ship-type] [-] + INTEGER(IntKi) :: MmbrCoefIDIndx = 0_IntKi !< Index into the appropriate coefs table for this member's properties [-] + INTEGER(IntKi) :: MmbrFilledIDIndx = 0_IntKi !< Index into the filled group table if this is a filled member [-] + LOGICAL :: PropPot = .false. !< Flag T/F for whether the member is modeled with potential flow theory [-] + LOGICAL :: PropMCF = .false. !< Flag T/F for whether the member is modeled with the MacCamy-Fuchs diffraction model [-] + INTEGER(IntKi) :: NElements = 0_IntKi !< number of elements in this member [-] + REAL(ReKi) :: RefLength = 0.0_ReKi !< the reference total length for this member [m] + REAL(ReKi) :: dl = 0.0_ReKi !< the reference element length for this member (may be less than MDivSize to achieve uniform element lengths) [m] END TYPE Morison_MemberInputType ! ======================= ! ========= Morison_NodeType ======= TYPE, PUBLIC :: Morison_NodeType - INTEGER(IntKi) :: JointIndx !< Joint index from the user joint table that this node corresponds to. If the software created this node, index is set to -1 [-] - REAL(ReKi) , DIMENSION(1:3) :: Position !< Position of the node in global coordinates [m] - INTEGER(IntKi) :: JointOvrlp !< [-] - INTEGER(IntKi) :: JointAxIDIndx !< [-] - INTEGER(IntKi) :: NConnections !< Number of elements connecting to this node [-] - INTEGER(IntKi) , DIMENSION(1:10) :: ConnectionList !< Indices of all the members connected to this node (positive if end 1, negative if end 2) [-] - REAL(ReKi) :: JAxCd !< Nodal lumped (joint) axial Cd [-] - REAL(ReKi) :: JAxCa !< Nodal lumped (joint) axial Cp [-] - REAL(ReKi) :: JAxCp !< Nodal lumped (joint) axial Ca [-] - REAL(ReKi) :: FillDensity !< Fill fluid density [kg/m^3] - REAL(ReKi) :: tMG !< Nodal thickness with marine growth [m] - REAL(ReKi) :: MGdensity !< Nodal density of marine growth [kg/m^3] + INTEGER(IntKi) :: JointIndx = 0_IntKi !< Joint index from the user joint table that this node corresponds to. If the software created this node, index is set to -1 [-] + REAL(ReKi) , DIMENSION(1:3) :: Position = 0.0_ReKi !< Position of the node in global coordinates [m] + INTEGER(IntKi) :: JointOvrlp = 0_IntKi !< [-] + INTEGER(IntKi) :: JointAxIDIndx = 0_IntKi !< [-] + INTEGER(IntKi) :: NConnections = 0_IntKi !< Number of elements connecting to this node [-] + INTEGER(IntKi) , DIMENSION(1:50) :: ConnectionList = 0_IntKi !< Indices of all the members connected to this node (positive if end 1, negative if end 2) [-] + REAL(ReKi) :: JAxCd = 0.0_ReKi !< Nodal lumped (joint) axial Cd [-] + REAL(ReKi) :: JAxCa = 0.0_ReKi !< Nodal lumped (joint) axial Cp [-] + REAL(ReKi) :: JAxCp = 0.0_ReKi !< Nodal lumped (joint) axial Ca [-] + REAL(ReKi) :: JAxVnCOff = 0.0_ReKi !< High-pass cut-off frequency for normal velocity when computing axial drag force [-] + REAL(ReKi) :: JAxFDLoFSc = 0.0_ReKi !< Scaling factor for low frequency axial drag force [-] + INTEGER(IntKi) :: JAxFDMod = 0_IntKi !< Switch for the axial drag formulation {0: original formulation, 1: Away from member only} [-] + REAL(ReKi) :: FillDensity = 0.0_ReKi !< Fill fluid density [kg/m^3] + REAL(ReKi) :: tMG = 0.0_ReKi !< Nodal thickness with marine growth [m] + REAL(ReKi) :: MGdensity = 0.0_ReKi !< Nodal density of marine growth [kg/m^3] END TYPE Morison_NodeType ! ======================= ! ========= Morison_MemberType ======= TYPE, PUBLIC :: Morison_MemberType INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: NodeIndx !< Index of each of the member's nodes in the master node list [-] - INTEGER(IntKi) :: MemberID !< User-supplied integer ID for this member [-] - INTEGER(IntKi) :: NElements !< number of elements in this member [-] - REAL(ReKi) :: RefLength !< the reference total length for this member [m] - REAL(ReKi) :: cosPhi_ref !< the reference cosine of the inclination angle of the member [-] - REAL(ReKi) :: dl !< the reference element length for this member (may be less than MDivSize to achieve uniform element lengths) [m] - REAL(ReKi) , DIMENSION(1:3) :: k !< unit vector of the member's orientation (may be changed to per-element once additional flexibility is accounted for in HydroDyn) [m] - REAL(ReKi) , DIMENSION(1:3,1:3) :: kkt !< matrix of matmul(k_hat, transpose(k_hat) [-] - REAL(ReKi) , DIMENSION(1:3,1:3) :: Ak !< matrix of I - kkt [-] + INTEGER(IntKi) :: MemberID = 0_IntKi !< User-supplied integer ID for this member [-] + INTEGER(IntKi) :: NElements = 0_IntKi !< number of elements in this member [-] + REAL(ReKi) :: RefLength = 0.0_ReKi !< the reference total length for this member [m] + REAL(ReKi) :: cosPhi_ref = 0.0_ReKi !< the reference cosine of the inclination angle of the member [-] + REAL(ReKi) :: dl = 0.0_ReKi !< the reference element length for this member (may be less than MDivSize to achieve uniform element lengths) [m] + REAL(ReKi) , DIMENSION(1:3) :: k = 0.0_ReKi !< unit vector of the member's orientation (may be changed to per-element once additional flexibility is accounted for in HydroDyn) [m] + REAL(ReKi) , DIMENSION(1:3,1:3) :: kkt = 0.0_ReKi !< matrix of matmul(k_hat, transpose(k_hat) [-] + REAL(ReKi) , DIMENSION(1:3,1:3) :: Ak = 0.0_ReKi !< matrix of I - kkt [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: R !< outer member radius at each node [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: RMG !< radius at each node including marine growth [m] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: RMGB !< radius at each node including marine growth scaled by sqrt(Cb) [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Rin !< inner member radius at node, equivalent to radius of water ballast at this node if filled [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: tMG !< Nodal thickness with marine growth (of member at node location) [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: MGdensity !< Nodal density of marine growth [kg/m^3] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: dRdl_mg !< taper dr/dl of outer surface including marine growth of each element [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: dRdl_mg_b !< taper dr/dl of outer surface including marine growth of each element with scaling of sqrt(Cb) [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: dRdl_in !< taper dr/dl of interior surface of each element [-] - REAL(ReKi) :: Vinner !< Member volume without marine growth [m^3] - REAL(ReKi) :: Vouter !< Member volume including marine growth [m^3] - REAL(ReKi) :: Vballast !< Member ballast volume [m^3] - REAL(ReKi) :: Vsubmerged !< Submerged volume corresponding to portion of Member in the water [m^3] - REAL(ReKi) :: l_fill !< fill length along member axis from start node 1 [m] - REAL(ReKi) :: h_fill !< fill length of partially flooded element [m] - REAL(ReKi) :: z_overfill !< if member is fully filled, the head height of the fill pressure at the end node N+1. Zero if member is partially filled. [m] - REAL(ReKi) :: h_floor !< the distance from the node to the seabed along the member axis (negative value) [m] - INTEGER(IntKi) :: i_floor !< the number of the element that pierces the seabed (zero if the member doesn't pierce it) [-] - LOGICAL :: doEndBuoyancy !< compute the end plate effect for the hightest node of this member [-] - INTEGER(IntKi) :: memfloodstatus !< Member-level flooded status for each elemen: 0 unflooded or fully below seabed, 2 partially flooded, 1 fully flooded [-] + REAL(ReKi) :: Vinner = 0.0_ReKi !< Member volume without marine growth [m^3] + REAL(ReKi) :: Vouter = 0.0_ReKi !< Member volume including marine growth [m^3] + REAL(ReKi) :: Vballast = 0.0_ReKi !< Member ballast volume [m^3] + REAL(ReKi) :: Vsubmerged = 0.0_ReKi !< Submerged volume corresponding to portion of Member in the water [m^3] + REAL(ReKi) :: l_fill = 0.0_ReKi !< fill length along member axis from start node 1 [m] + REAL(ReKi) :: h_fill = 0.0_ReKi !< fill length of partially flooded element [m] + REAL(ReKi) :: z_overfill = 0.0_ReKi !< if member is fully filled, the head height of the fill pressure at the end node N+1. Zero if member is partially filled. [m] + REAL(ReKi) :: h_floor = 0.0_ReKi !< the distance from the node to the seabed along the member axis (negative value) [m] + INTEGER(IntKi) :: i_floor = 0_IntKi !< the number of the element that pierces the seabed (zero if the member doesn't pierce it) [-] + LOGICAL :: doEndBuoyancy = .false. !< compute the end plate effect for the hightest node of this member [-] + INTEGER(IntKi) :: memfloodstatus = 0_IntKi !< Member-level flooded status for each elemen: 0 unflooded or fully below seabed, 2 partially flooded, 1 fully flooded [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: floodstatus !< flooded status for each element: 0 unflooded or fully below seabed, 1 fully flooded, 2 partially flooded [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: alpha !< relative volume centroid of each element including marine growth, from node i to node i+1 [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: alpha_fb !< relative volume centroid of each element's flooded ballast, from node i to node i+1 [-] @@ -163,6 +176,7 @@ MODULE Morison_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: AxCd !< Member axial Cd at each node [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: AxCa !< Member axial Ca at each node [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: AxCp !< Member axial Cp at each node [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Cb !< Member Cb at each node [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: m_fb_l !< mass of flooded ballast in lower portion of each element [kg] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: m_fb_u !< mass of flooded ballast in upper portion of each element [kg] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: h_cfb_l !< distance to flooded ballast centroid from node point in lower portion of each element [m] @@ -182,15 +196,17 @@ MODULE Morison_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Cfl_fb !< axial force constant due to flooded ballast, for each element [N] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Cfr_fb !< radial force constant due to flooded ballast, for each element [N] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: CM0_fb !< moment constant due to flooded ballast, for each element about lower node [Nm] - REAL(ReKi) :: MGvolume !< Volume of marine growth material for this member/element [m^3] - REAL(ReKi) :: MDivSize !< User-requested final element length (actual length may vary from this request) [m] - INTEGER(IntKi) :: MCoefMod !< Coefs model for member: 1 = simple, 2 =depth, 3 = member-based [-] - INTEGER(IntKi) :: MmbrCoefIDIndx !< If MCoefMod=3, then this is the index for the member's coefs in the master Member Coefs Table [-] - INTEGER(IntKi) :: MmbrFilledIDIndx !< If this member is part of a fill group, this is the index into the master fill group table, if not = -1 [-] - REAL(ReKi) :: FillFSLoc !< Z-location of the filled free-surface [m] - REAL(ReKi) :: FillDens !< Filled fluid density [kg/m^3] - LOGICAL :: PropPot !< Is this element/member modeled with potential flow theory T/F [-] - LOGICAL :: Flipped !< Was the member flipped in a reordering event? Need to know this to get the correct normal vector to the ends [-] + REAL(ReKi) :: MGvolume = 0.0_ReKi !< Volume of marine growth material for this member/element [m^3] + REAL(ReKi) :: MDivSize = 0.0_ReKi !< User-requested final element length (actual length may vary from this request) [m] + INTEGER(IntKi) :: MCoefMod = 0_IntKi !< Coefs model for member: 1 = simple, 2 =depth, 3 = member-based [-] + INTEGER(IntKi) :: MmbrCoefIDIndx = 0_IntKi !< If MCoefMod=3, then this is the index for the member's coefs in the master Member Coefs Table [-] + INTEGER(IntKi) :: MmbrFilledIDIndx = 0_IntKi !< If this member is part of a fill group, this is the index into the master fill group table, if not = -1 [-] + INTEGER(IntKi) :: MHstLMod = 0_IntKi !< Hydrostatic model for member [1=column-type, 2=ship-type] [-] + REAL(ReKi) :: FillFSLoc = 0.0_ReKi !< Z-location of the filled free-surface [m] + REAL(ReKi) :: FillDens = 0.0_ReKi !< Filled fluid density [kg/m^3] + LOGICAL :: PropPot = .false. !< Is this element/member modeled with potential flow theory T/F [-] + LOGICAL :: PropMCF = .false. !< Flag T/F for whether the member is modeled with the MacCamy-Fuchs diffraction model [-] + LOGICAL :: Flipped = .false. !< Was the member flipped in a reordering event? Need to know this to get the correct normal vector to the ends [-] END TYPE Morison_MemberType ! ======================= ! ========= Morison_MemberLoads ======= @@ -210,46 +226,51 @@ MODULE Morison_Types ! ======================= ! ========= Morison_CoefMembers ======= TYPE, PUBLIC :: Morison_CoefMembers - INTEGER(IntKi) :: MemberID !< User-specified integer id for the Member-based coefs [-] - REAL(ReKi) :: MemberCd1 !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] - REAL(ReKi) :: MemberCd2 !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] - REAL(ReKi) :: MemberCdMG1 !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] - REAL(ReKi) :: MemberCdMG2 !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] - REAL(ReKi) :: MemberCa1 !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] - REAL(ReKi) :: MemberCa2 !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] - REAL(ReKi) :: MemberCaMG1 !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] - REAL(ReKi) :: MemberCaMG2 !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] - REAL(ReKi) :: MemberCp1 !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] - REAL(ReKi) :: MemberCp2 !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] - REAL(ReKi) :: MemberCpMG1 !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] - REAL(ReKi) :: MemberCpMG2 !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] - REAL(ReKi) :: MemberAxCd1 !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] - REAL(ReKi) :: MemberAxCd2 !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] - REAL(ReKi) :: MemberAxCdMG1 !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] - REAL(ReKi) :: MemberAxCdMG2 !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] - REAL(ReKi) :: MemberAxCa1 !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] - REAL(ReKi) :: MemberAxCa2 !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] - REAL(ReKi) :: MemberAxCaMG1 !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] - REAL(ReKi) :: MemberAxCaMG2 !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] - REAL(ReKi) :: MemberAxCp1 !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] - REAL(ReKi) :: MemberAxCp2 !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] - REAL(ReKi) :: MemberAxCpMG1 !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] - REAL(ReKi) :: MemberAxCpMG2 !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] + INTEGER(IntKi) :: MemberID = 0_IntKi !< User-specified integer id for the Member-based coefs [-] + REAL(ReKi) :: MemberCd1 = 0.0_ReKi !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] + REAL(ReKi) :: MemberCd2 = 0.0_ReKi !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] + REAL(ReKi) :: MemberCdMG1 = 0.0_ReKi !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] + REAL(ReKi) :: MemberCdMG2 = 0.0_ReKi !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] + REAL(ReKi) :: MemberCa1 = 0.0_ReKi !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] + REAL(ReKi) :: MemberCa2 = 0.0_ReKi !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] + REAL(ReKi) :: MemberCaMG1 = 0.0_ReKi !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] + REAL(ReKi) :: MemberCaMG2 = 0.0_ReKi !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] + REAL(ReKi) :: MemberCp1 = 0.0_ReKi !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] + REAL(ReKi) :: MemberCp2 = 0.0_ReKi !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] + REAL(ReKi) :: MemberCpMG1 = 0.0_ReKi !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] + REAL(ReKi) :: MemberCpMG2 = 0.0_ReKi !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] + REAL(ReKi) :: MemberAxCd1 = 0.0_ReKi !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] + REAL(ReKi) :: MemberAxCd2 = 0.0_ReKi !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] + REAL(ReKi) :: MemberAxCdMG1 = 0.0_ReKi !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] + REAL(ReKi) :: MemberAxCdMG2 = 0.0_ReKi !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] + REAL(ReKi) :: MemberAxCa1 = 0.0_ReKi !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] + REAL(ReKi) :: MemberAxCa2 = 0.0_ReKi !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] + REAL(ReKi) :: MemberAxCaMG1 = 0.0_ReKi !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] + REAL(ReKi) :: MemberAxCaMG2 = 0.0_ReKi !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] + REAL(ReKi) :: MemberAxCp1 = 0.0_ReKi !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] + REAL(ReKi) :: MemberAxCp2 = 0.0_ReKi !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] + REAL(ReKi) :: MemberAxCpMG1 = 0.0_ReKi !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] + REAL(ReKi) :: MemberAxCpMG2 = 0.0_ReKi !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] + REAL(ReKi) :: MemberCb1 = 0.0_ReKi !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] + REAL(ReKi) :: MemberCb2 = 0.0_ReKi !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] + REAL(ReKi) :: MemberCbMG1 = 0.0_ReKi !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] + REAL(ReKi) :: MemberCbMG2 = 0.0_ReKi !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] + LOGICAL :: MemberMCF = .false. !< Flag T/F for whether the member is modeled with the MacCamy-Fuchs diffraction model [-] END TYPE Morison_CoefMembers ! ======================= ! ========= Morison_MGDepthsType ======= TYPE, PUBLIC :: Morison_MGDepthsType - REAL(ReKi) :: MGDpth !< Marine growth depth location for these properties [m] - REAL(ReKi) :: MGThck !< Marine growth thickness [m] - REAL(ReKi) :: MGDens !< Marine growth density [kg/m^3] + REAL(ReKi) :: MGDpth = 0.0_ReKi !< Marine growth depth location for these properties [m] + REAL(ReKi) :: MGThck = 0.0_ReKi !< Marine growth thickness [m] + REAL(ReKi) :: MGDens = 0.0_ReKi !< Marine growth density [kg/m^3] END TYPE Morison_MGDepthsType ! ======================= ! ========= Morison_MOutput ======= TYPE, PUBLIC :: Morison_MOutput - INTEGER(IntKi) :: MemberID !< Member ID for requested output [-] - INTEGER(IntKi) :: NOutLoc !< The number of requested output locations [-] + INTEGER(IntKi) :: MemberID = 0_IntKi !< Member ID for requested output [-] + INTEGER(IntKi) :: NOutLoc = 0_IntKi !< The number of requested output locations [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: NodeLocs !< Normalized locations along user-specified member for the outputs [-] - INTEGER(IntKi) :: MemberIDIndx !< Index for member in the master list [-] + INTEGER(IntKi) :: MemberIDIndx = 0_IntKi !< Index for member in the master list [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: MeshIndx1 !< Index of node in Mesh for the start of the member element [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: MeshIndx2 !< Index of node in Mesh for the end of the member element [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: MemberIndx1 !< Index of Member nodes for the start of the member element [-] @@ -259,67 +280,60 @@ MODULE Morison_Types ! ======================= ! ========= Morison_JOutput ======= TYPE, PUBLIC :: Morison_JOutput - INTEGER(IntKi) :: JointID !< Joint ID for the requested output [-] - INTEGER(IntKi) :: JointIDIndx !< Joint index in the master list [-] + INTEGER(IntKi) :: JointID = 0_IntKi !< Joint ID for the requested output [-] + INTEGER(IntKi) :: JointIDIndx = 0_IntKi !< Joint index in the master list [-] END TYPE Morison_JOutput ! ======================= ! ========= Morison_InitInputType ======= TYPE, PUBLIC :: Morison_InitInputType - REAL(ReKi) :: Gravity !< Gravity (scalar, positive-valued) [m/s^2] - REAL(ReKi) :: WtrDens !< Water density [kg/m^3] - REAL(ReKi) :: WtrDpth !< Water depth (positive-valued) [m] - REAL(ReKi) :: MSL2SWL !< Mean Sea Level to Still Water Level offset [m] - INTEGER(IntKi) :: NJoints !< Number of user-specified joints [-] - INTEGER(IntKi) :: NNodes !< Total number of nodes in the final software model [-] + REAL(ReKi) :: Gravity = 0.0_ReKi !< Gravity (scalar, positive-valued) [m/s^2] + INTEGER(IntKi) :: WaveDisp = 0_IntKi !< Method of computing Wave Kinematics. (0: use undisplaced position, 1: use displaced position, 2: use low-pass filtered displaced position) [-] + INTEGER(IntKi) :: AMMod = 0_IntKi !< Method of computing distributed added-mass force. (0: Only and always on nodes below SWL at the undisplaced position. 1: Up to the instantaneous free surface) [overwrite to 0 when WaveMod = 0 or 6 or when WaveStMod = 0 in SeaState] [-] + INTEGER(IntKi) :: NJoints = 0_IntKi !< Number of user-specified joints [-] + INTEGER(IntKi) :: NNodes = 0_IntKi !< Total number of nodes in the final software model [-] TYPE(Morison_JointType) , DIMENSION(:), ALLOCATABLE :: InpJoints !< Array of user-specified joints [-] TYPE(Morison_NodeType) , DIMENSION(:), ALLOCATABLE :: Nodes !< Array of simulation node (some correspond to user-specified joints, others are created by software) [-] - INTEGER(IntKi) :: NAxCoefs !< Number of axial Coefs entries in input file table [-] + INTEGER(IntKi) :: NAxCoefs = 0_IntKi !< Number of axial Coefs entries in input file table [-] TYPE(Morison_AxialCoefType) , DIMENSION(:), ALLOCATABLE :: AxialCoefs !< List of axial coefs [-] - INTEGER(IntKi) :: NPropSets !< Number of member property sets [-] + INTEGER(IntKi) :: NPropSets = 0_IntKi !< Number of member property sets [-] TYPE(Morison_MemberPropType) , DIMENSION(:), ALLOCATABLE :: MPropSets !< List of Member property sets [-] - REAL(ReKi) :: SimplCd !< Simple model drag coef [-] - REAL(ReKi) :: SimplCdMG !< Simple model drag coef for marine growth [-] - REAL(ReKi) :: SimplCa !< Simple model Ca [-] - REAL(ReKi) :: SimplCaMG !< Simple model Ca for marine growth [-] - REAL(ReKi) :: SimplCp !< Simple model Cp [-] - REAL(ReKi) :: SimplCpMG !< Simple model Cp for marine growth [-] - REAL(ReKi) :: SimplAxCd !< Simple model Axial Cd [-] - REAL(ReKi) :: SimplAxCdMG !< Simple model Axial Cd for marine growth [-] - REAL(ReKi) :: SimplAxCa !< Simple model Axial Ca [-] - REAL(ReKi) :: SimplAxCaMG !< Simple model Axial Ca for marine growth [-] - REAL(ReKi) :: SimplAxCp !< Simple model Axial Cp [-] - REAL(ReKi) :: SimplAxCpMG !< Simple model Axial Cp for marine growth [-] - INTEGER(IntKi) :: NCoefDpth !< [-] + REAL(ReKi) :: SimplCd = 0.0_ReKi !< Simple model drag coef [-] + REAL(ReKi) :: SimplCdMG = 0.0_ReKi !< Simple model drag coef for marine growth [-] + REAL(ReKi) :: SimplCa = 0.0_ReKi !< Simple model Ca [-] + REAL(ReKi) :: SimplCaMG = 0.0_ReKi !< Simple model Ca for marine growth [-] + REAL(ReKi) :: SimplCp = 0.0_ReKi !< Simple model Cp [-] + REAL(ReKi) :: SimplCpMG = 0.0_ReKi !< Simple model Cp for marine growth [-] + REAL(ReKi) :: SimplAxCd = 0.0_ReKi !< Simple model Axial Cd [-] + REAL(ReKi) :: SimplAxCdMG = 0.0_ReKi !< Simple model Axial Cd for marine growth [-] + REAL(ReKi) :: SimplAxCa = 0.0_ReKi !< Simple model Axial Ca [-] + REAL(ReKi) :: SimplAxCaMG = 0.0_ReKi !< Simple model Axial Ca for marine growth [-] + REAL(ReKi) :: SimplAxCp = 0.0_ReKi !< Simple model Axial Cp [-] + REAL(ReKi) :: SimplAxCpMG = 0.0_ReKi !< Simple model Axial Cp for marine growth [-] + REAL(ReKi) :: SimplCb = 0.0_ReKi !< Simple model hydrostatic/buoyancy load coefficient [-] + REAL(ReKi) :: SimplCbMg = 0.0_ReKi !< Simple model hydrostatic/buoyancy load coefficient for marine growth [-] + LOGICAL :: SimplMCF = .false. !< Flag T/F for whether the member is modeled with the MacCamy-Fuchs diffraction model [-] + INTEGER(IntKi) :: NCoefDpth = 0_IntKi !< [-] TYPE(Morison_CoefDpths) , DIMENSION(:), ALLOCATABLE :: CoefDpths !< [-] - INTEGER(IntKi) :: NCoefMembers !< [-] + INTEGER(IntKi) :: NCoefMembers = 0_IntKi !< [-] TYPE(Morison_CoefMembers) , DIMENSION(:), ALLOCATABLE :: CoefMembers !< [-] - INTEGER(IntKi) :: NMembers !< Number of user-specified members in the input file [-] + INTEGER(IntKi) :: NMembers = 0_IntKi !< Number of user-specified members in the input file [-] TYPE(Morison_MemberInputType) , DIMENSION(:), ALLOCATABLE :: InpMembers !< Array of user-specified members [-] - INTEGER(IntKi) :: NFillGroups !< [-] + INTEGER(IntKi) :: NFillGroups = 0_IntKi !< [-] TYPE(Morison_FilledGroupType) , DIMENSION(:), ALLOCATABLE :: FilledGroups !< [-] - INTEGER(IntKi) :: NMGDepths !< [-] + INTEGER(IntKi) :: NMGDepths = 0_IntKi !< [-] TYPE(Morison_MGDepthsType) , DIMENSION(:), ALLOCATABLE :: MGDepths !< [-] - REAL(ReKi) :: MGTop !< [-] - REAL(ReKi) :: MGBottom !< [-] - INTEGER(IntKi) :: NMOutputs !< [-] + REAL(ReKi) :: MGTop = 0.0_ReKi !< [-] + REAL(ReKi) :: MGBottom = 0.0_ReKi !< [-] + INTEGER(IntKi) :: NMOutputs = 0_IntKi !< [-] TYPE(Morison_MOutput) , DIMENSION(:), ALLOCATABLE :: MOutLst !< [-] - INTEGER(IntKi) :: NJOutputs !< [-] + INTEGER(IntKi) :: NJOutputs = 0_IntKi !< [-] TYPE(Morison_JOutput) , DIMENSION(:), ALLOCATABLE :: JOutLst !< [-] - CHARACTER(ChanLen) , DIMENSION(1:4032) :: OutList !< This list size needs to be the maximum of possible outputs because of the use of ReadAry() [-] - LOGICAL , DIMENSION(:), ALLOCATABLE :: ValidOutList !< [-] - INTEGER(IntKi) :: NumOuts !< [-] - INTEGER(IntKi) :: OutSwtch !< [-] - LOGICAL :: OutAll !< [-] - CHARACTER(1024) :: OutRootName !< [-] - INTEGER(IntKi) :: UnOutFile !< [-] - INTEGER(IntKi) :: UnSum !< [-] - INTEGER(IntKi) :: NStepWave !< [-] - REAL(SiKi) , DIMENSION(:,:,:), ALLOCATABLE :: WaveAcc !< [-] - REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveTime !< [-] - REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: WaveDynP !< [-] - REAL(SiKi) , DIMENSION(:,:,:), ALLOCATABLE :: WaveVel !< [-] - INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: nodeInWater !< Logical flag indicating if the node at the given time step is in the water, and hence needs to have hydrodynamic forces calculated [-] + CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: OutList !< This list size needs to be the maximum # of possible outputs because of the use of ReadAry(). Use MaxMrsnOutputs [-] + INTEGER(IntKi) :: NumOuts = 0_IntKi !< [-] + INTEGER(IntKi) :: UnSum = 0_IntKi !< [-] + TYPE(SeaSt_WaveFieldType) , POINTER :: WaveField => NULL() !< Pointer to SeaState wave field [-] LOGICAL :: VisMeshes = .false. !< Output visualization meshes [-] + INTEGER(IntKi) :: PtfmYMod = 0_IntKi !< Large yaw model [-] END TYPE Morison_InitInputType ! ======================= ! ========= Morison_InitOutputType ======= @@ -331,29 +345,35 @@ MODULE Morison_Types ! ======================= ! ========= Morison_ContinuousStateType ======= TYPE, PUBLIC :: Morison_ContinuousStateType - REAL(SiKi) :: DummyContState !< Remove this variable if you have continuous states [-] + REAL(SiKi) :: DummyContState = 0.0_R4Ki !< Remove this variable if you have continuous states [-] END TYPE Morison_ContinuousStateType ! ======================= ! ========= Morison_DiscreteStateType ======= TYPE, PUBLIC :: Morison_DiscreteStateType - REAL(SiKi) :: DummyDiscState !< Remove this variable if you have discrete states [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: V_rel_n_FiltStat !< State of the high-pass filter for the joint relative normal velocity [m/s] END TYPE Morison_DiscreteStateType ! ======================= ! ========= Morison_ConstraintStateType ======= TYPE, PUBLIC :: Morison_ConstraintStateType - REAL(SiKi) :: DummyConstrState !< Remove this variable if you have constraint states [-] + REAL(SiKi) :: DummyConstrState = 0.0_R4Ki !< Remove this variable if you have constraint states [-] END TYPE Morison_ConstraintStateType ! ======================= ! ========= Morison_OtherStateType ======= TYPE, PUBLIC :: Morison_OtherStateType - INTEGER(IntKi) :: DummyOtherState !< Remove this variable if you have other states [-] + INTEGER(IntKi) :: DummyOtherState = 0_IntKi !< Remove this variable if you have other states [-] END TYPE Morison_OtherStateType ! ======================= ! ========= Morison_MiscVarType ======= TYPE, PUBLIC :: Morison_MiscVarType + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: DispNodePosHdn !< Instantaneous displaced position of the line element nodes at time t for hydrodynamic load calculation [(m)] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: DispNodePosHst !< Instantaneous displaced position of the line element nodes at time t for hydrostatic and other load calcuation [(m)] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: FV !< Fluid velocity at line element node at time t, which may not correspond to the WaveTime array of times [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: FA !< Fluid acceleration at line element node at time t, which may not correspond to the WaveTime array of times [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: FAMCF !< Fluid acceleration at line element node at time t, which may not correspond to the WaveTime array of times [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: FDynP !< Fluid dynamic pressure at line element node at time t, which may not correspond to the WaveTime array of times [-] + REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveElev !< Total wave elevation [m] + REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveElev1 !< First order wave elevation [m] + REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveElev2 !< Second order wave elevation [m] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: vrel !< velocity of structural node relative to the water [m/s^2] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: nodeInWater !< Logical flag indicating if the node at the given time step is in the water, and hence needs to have hydrodynamic forces calculated [-] TYPE(Morison_MemberLoads) , DIMENSION(:), ALLOCATABLE :: memberLoads !< Array (NMembers long) of member-based side-effects load contributions [-] @@ -363,52 +383,47 @@ MODULE Morison_Types REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: F_IMG_End !< Joint marine growth intertia loads at time t, which may not correspond to the WaveTime array of times [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: F_A_End !< Lumped added mass loads at time t, which may not correspond to the WaveTime array of times [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: F_BF_End !< [-] - INTEGER(IntKi) :: LastIndWave !< Last time index used in the wave kinematics arrays [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: V_rel_n !< Normal relative flow velocity at joints [m/s] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: V_rel_n_HiPass !< High-pass filtered normal relative flow velocity at joints [m/s] TYPE(MeshMapType) :: VisMeshMap !< Mesh mapping for visualization mesh [-] + TYPE(SeaSt_WaveField_MiscVarType) :: WaveField_m !< misc var information from the SeaState Interpolation module [-] END TYPE Morison_MiscVarType ! ======================= ! ========= Morison_ParameterType ======= TYPE, PUBLIC :: Morison_ParameterType - REAL(DbKi) :: DT !< Time step for continuous state integration & discrete state update [(sec)] - REAL(ReKi) :: Gravity !< Gravity (scalar, positive-valued) [m/s^2] - REAL(ReKi) :: WtrDens !< Water density [kg/m^3] - REAL(ReKi) :: WtrDpth !< Water depth (positive-valued) [m] - REAL(ReKi) :: MSL2SWL !< Mean Sea Level to Still Water Level offset [m] - INTEGER(IntKi) :: NMembers !< number of members [-] + REAL(DbKi) :: DT = 0.0_R8Ki !< Time step for continuous state integration & discrete state update [(sec)] + REAL(ReKi) :: Gravity = 0.0_ReKi !< Gravity (scalar, positive-valued) [m/s^2] + INTEGER(IntKi) :: WaveDisp = 0_IntKi !< Method of computing Wave Kinematics. (0: use undisplaced position, 1: use displaced position, 2: use low-pass filtered displaced position) [-] + INTEGER(IntKi) :: AMMod = 0_IntKi !< Method of computing distributed added-mass force. (0: Only and always on nodes below SWL at the undisplaced position. 1: Up to the instantaneous free surface) [overwrite to 0 when WaveMod = 0 or 6 or when WaveStMod = 0 in SeaState] [-] + INTEGER(IntKi) :: NMembers = 0_IntKi !< number of members [-] TYPE(Morison_MemberType) , DIMENSION(:), ALLOCATABLE :: Members !< Array of Morison members used during simulation [-] - INTEGER(IntKi) :: NNodes !< [-] - INTEGER(IntKi) :: NJoints !< Number of user-specified joints [-] + INTEGER(IntKi) :: NNodes = 0_IntKi !< [-] + INTEGER(IntKi) :: NJoints = 0_IntKi !< Number of user-specified joints [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: I_MG_End !< Inertial matrix associated with marine growth mass at joint [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: An_End !< directional area vector of each joint [m^2] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: DragConst_End !< [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: VRelNFiltConst !< [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: DragMod_End !< [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: DragLoFSc_End !< [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: F_WMG_End !< Joint marine growth weight loads, constant for all t [N] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: DP_Const_End !< Constant part of Joint dynamic pressure term [N] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Mass_MG_End !< Joint marine growth mass [kg] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: AM_End !< 3x3 Joint added mass matrix, constant for all t [N] - REAL(SiKi) , DIMENSION(:,:,:), ALLOCATABLE :: WaveVel !< [-] - REAL(SiKi) , DIMENSION(:,:,:), ALLOCATABLE :: WaveAcc !< [-] - REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: WaveDynP !< [-] - REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveTime !< Times for which the wave kinematics are pre-computed [s] - INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: nodeInWater !< Logical flag indicating if the node at the given time step is in the water, and hence needs to have hydrodynamic forces calculated [-] - INTEGER(IntKi) :: NStepWave !< [-] - INTEGER(IntKi) :: NMOutputs !< [-] + INTEGER(IntKi) :: NMOutputs = 0_IntKi !< [-] TYPE(Morison_MOutput) , DIMENSION(:), ALLOCATABLE :: MOutLst !< [-] - INTEGER(IntKi) :: NJOutputs !< [-] + INTEGER(IntKi) :: NJOutputs = 0_IntKi !< [-] TYPE(Morison_JOutput) , DIMENSION(:), ALLOCATABLE :: JOutLst !< [-] TYPE(OutParmType) , DIMENSION(:), ALLOCATABLE :: OutParam !< [-] - INTEGER(IntKi) :: NumOuts !< [-] - INTEGER(IntKi) :: NumOutAll !< [-] - INTEGER(IntKi) :: OutSwtch !< [-] - INTEGER(IntKi) :: UnOutFile !< [-] - CHARACTER(20) :: OutFmt !< [-] - CHARACTER(20) :: OutSFmt !< [-] - CHARACTER(ChanLen) :: Delim !< [-] + INTEGER(IntKi) :: NumOuts = 0_IntKi !< [-] + TYPE(SeaSt_WaveFieldType) , POINTER :: WaveField => NULL() !< SeaState wave field [-] LOGICAL :: VisMeshes = .false. !< Output visualization meshes [-] + INTEGER(IntKi) :: PtfmYMod = 0_IntKi !< Large yaw model [-] END TYPE Morison_ParameterType ! ======================= ! ========= Morison_InputType ======= TYPE, PUBLIC :: Morison_InputType TYPE(MeshType) :: Mesh !< Kinematics of each node input mesh [-] + REAL(ReKi) :: PtfmRefY = 0.0_ReKi !< Reference platform yaw offset [(rad)] END TYPE Morison_InputType ! ======================= ! ========= Morison_OutputType ======= @@ -419,12142 +434,3969 @@ MODULE Morison_Types END TYPE Morison_OutputType ! ======================= CONTAINS - SUBROUTINE Morison_CopyJointType( SrcJointTypeData, DstJointTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Morison_JointType), INTENT(IN) :: SrcJointTypeData - TYPE(Morison_JointType), INTENT(INOUT) :: DstJointTypeData - 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 = 'Morison_CopyJointType' -! - ErrStat = ErrID_None - ErrMsg = "" - DstJointTypeData%JointID = SrcJointTypeData%JointID - DstJointTypeData%Position = SrcJointTypeData%Position - DstJointTypeData%JointAxID = SrcJointTypeData%JointAxID - DstJointTypeData%JointAxIDIndx = SrcJointTypeData%JointAxIDIndx - DstJointTypeData%JointOvrlp = SrcJointTypeData%JointOvrlp - DstJointTypeData%NConnections = SrcJointTypeData%NConnections - DstJointTypeData%ConnectionList = SrcJointTypeData%ConnectionList - END SUBROUTINE Morison_CopyJointType - - SUBROUTINE Morison_DestroyJointType( JointTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(Morison_JointType), INTENT(INOUT) :: JointTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_DestroyJointType' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE Morison_DestroyJointType - - SUBROUTINE Morison_PackJointType( 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(Morison_JointType), 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 = 'Morison_PackJointType' - ! 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 ! JointID - Re_BufSz = Re_BufSz + SIZE(InData%Position) ! Position - Int_BufSz = Int_BufSz + 1 ! JointAxID - Int_BufSz = Int_BufSz + 1 ! JointAxIDIndx - Int_BufSz = Int_BufSz + 1 ! JointOvrlp - Int_BufSz = Int_BufSz + 1 ! NConnections - Int_BufSz = Int_BufSz + SIZE(InData%ConnectionList) ! ConnectionList - 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%JointID - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%Position,1), UBOUND(InData%Position,1) - ReKiBuf(Re_Xferred) = InData%Position(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%JointAxID - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%JointAxIDIndx - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%JointOvrlp - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NConnections - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%ConnectionList,1), UBOUND(InData%ConnectionList,1) - IntKiBuf(Int_Xferred) = InData%ConnectionList(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END SUBROUTINE Morison_PackJointType - - SUBROUTINE Morison_UnPackJointType( 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(Morison_JointType), 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 = 'Morison_UnPackJointType' - ! 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%JointID = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%Position,1) - i1_u = UBOUND(OutData%Position,1) - DO i1 = LBOUND(OutData%Position,1), UBOUND(OutData%Position,1) - OutData%Position(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%JointAxID = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%JointAxIDIndx = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%JointOvrlp = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NConnections = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%ConnectionList,1) - i1_u = UBOUND(OutData%ConnectionList,1) - DO i1 = LBOUND(OutData%ConnectionList,1), UBOUND(OutData%ConnectionList,1) - OutData%ConnectionList(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END SUBROUTINE Morison_UnPackJointType - - SUBROUTINE Morison_CopyMemberPropType( SrcMemberPropTypeData, DstMemberPropTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Morison_MemberPropType), INTENT(IN) :: SrcMemberPropTypeData - TYPE(Morison_MemberPropType), INTENT(INOUT) :: DstMemberPropTypeData - 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 = 'Morison_CopyMemberPropType' -! - ErrStat = ErrID_None - ErrMsg = "" - DstMemberPropTypeData%PropSetID = SrcMemberPropTypeData%PropSetID - DstMemberPropTypeData%PropD = SrcMemberPropTypeData%PropD - DstMemberPropTypeData%PropThck = SrcMemberPropTypeData%PropThck - END SUBROUTINE Morison_CopyMemberPropType - - SUBROUTINE Morison_DestroyMemberPropType( MemberPropTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(Morison_MemberPropType), INTENT(INOUT) :: MemberPropTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_DestroyMemberPropType' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE Morison_DestroyMemberPropType - - SUBROUTINE Morison_PackMemberPropType( 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(Morison_MemberPropType), 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 = 'Morison_PackMemberPropType' - ! 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 ! PropSetID - Re_BufSz = Re_BufSz + 1 ! PropD - Re_BufSz = Re_BufSz + 1 ! PropThck - 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%PropSetID - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PropD - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PropThck - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Morison_PackMemberPropType - - SUBROUTINE Morison_UnPackMemberPropType( 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(Morison_MemberPropType), 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 = 'Morison_UnPackMemberPropType' - ! 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%PropSetID = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%PropD = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PropThck = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Morison_UnPackMemberPropType - - SUBROUTINE Morison_CopyFilledGroupType( SrcFilledGroupTypeData, DstFilledGroupTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Morison_FilledGroupType), INTENT(IN) :: SrcFilledGroupTypeData - TYPE(Morison_FilledGroupType), INTENT(INOUT) :: DstFilledGroupTypeData - 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 = 'Morison_CopyFilledGroupType' -! - ErrStat = ErrID_None - ErrMsg = "" - DstFilledGroupTypeData%FillNumM = SrcFilledGroupTypeData%FillNumM -IF (ALLOCATED(SrcFilledGroupTypeData%FillMList)) THEN - i1_l = LBOUND(SrcFilledGroupTypeData%FillMList,1) - i1_u = UBOUND(SrcFilledGroupTypeData%FillMList,1) - IF (.NOT. ALLOCATED(DstFilledGroupTypeData%FillMList)) THEN - ALLOCATE(DstFilledGroupTypeData%FillMList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstFilledGroupTypeData%FillMList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstFilledGroupTypeData%FillMList = SrcFilledGroupTypeData%FillMList -ENDIF - DstFilledGroupTypeData%FillFSLoc = SrcFilledGroupTypeData%FillFSLoc - DstFilledGroupTypeData%FillDensChr = SrcFilledGroupTypeData%FillDensChr - DstFilledGroupTypeData%FillDens = SrcFilledGroupTypeData%FillDens - END SUBROUTINE Morison_CopyFilledGroupType - - SUBROUTINE Morison_DestroyFilledGroupType( FilledGroupTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(Morison_FilledGroupType), INTENT(INOUT) :: FilledGroupTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_DestroyFilledGroupType' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(FilledGroupTypeData%FillMList)) THEN - DEALLOCATE(FilledGroupTypeData%FillMList) -ENDIF - END SUBROUTINE Morison_DestroyFilledGroupType - - SUBROUTINE Morison_PackFilledGroupType( 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(Morison_FilledGroupType), 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 = 'Morison_PackFilledGroupType' - ! 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 ! FillNumM - Int_BufSz = Int_BufSz + 1 ! FillMList allocated yes/no - IF ( ALLOCATED(InData%FillMList) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! FillMList upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%FillMList) ! FillMList - END IF - Re_BufSz = Re_BufSz + 1 ! FillFSLoc - Int_BufSz = Int_BufSz + 1*LEN(InData%FillDensChr) ! FillDensChr - Re_BufSz = Re_BufSz + 1 ! FillDens - 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%FillNumM - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%FillMList) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FillMList,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FillMList,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%FillMList,1), UBOUND(InData%FillMList,1) - IntKiBuf(Int_Xferred) = InData%FillMList(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%FillFSLoc - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(InData%FillDensChr) - IntKiBuf(Int_Xferred) = ICHAR(InData%FillDensChr(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - ReKiBuf(Re_Xferred) = InData%FillDens - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Morison_PackFilledGroupType - - SUBROUTINE Morison_UnPackFilledGroupType( 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(Morison_FilledGroupType), 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 = 'Morison_UnPackFilledGroupType' - ! 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%FillNumM = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FillMList not allocated - Int_Xferred = Int_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%FillMList)) DEALLOCATE(OutData%FillMList) - ALLOCATE(OutData%FillMList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FillMList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%FillMList,1), UBOUND(OutData%FillMList,1) - OutData%FillMList(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - OutData%FillFSLoc = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(OutData%FillDensChr) - OutData%FillDensChr(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%FillDens = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Morison_UnPackFilledGroupType - - SUBROUTINE Morison_CopyCoefDpths( SrcCoefDpthsData, DstCoefDpthsData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Morison_CoefDpths), INTENT(IN) :: SrcCoefDpthsData - TYPE(Morison_CoefDpths), INTENT(INOUT) :: DstCoefDpthsData - 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 = 'Morison_CopyCoefDpths' -! - ErrStat = ErrID_None - ErrMsg = "" - DstCoefDpthsData%Dpth = SrcCoefDpthsData%Dpth - DstCoefDpthsData%DpthCd = SrcCoefDpthsData%DpthCd - DstCoefDpthsData%DpthCdMG = SrcCoefDpthsData%DpthCdMG - DstCoefDpthsData%DpthCa = SrcCoefDpthsData%DpthCa - DstCoefDpthsData%DpthCaMG = SrcCoefDpthsData%DpthCaMG - DstCoefDpthsData%DpthCp = SrcCoefDpthsData%DpthCp - DstCoefDpthsData%DpthCpMG = SrcCoefDpthsData%DpthCpMG - DstCoefDpthsData%DpthAxCd = SrcCoefDpthsData%DpthAxCd - DstCoefDpthsData%DpthAxCdMG = SrcCoefDpthsData%DpthAxCdMG - DstCoefDpthsData%DpthAxCa = SrcCoefDpthsData%DpthAxCa - DstCoefDpthsData%DpthAxCaMG = SrcCoefDpthsData%DpthAxCaMG - DstCoefDpthsData%DpthAxCp = SrcCoefDpthsData%DpthAxCp - DstCoefDpthsData%DpthAxCpMG = SrcCoefDpthsData%DpthAxCpMG - END SUBROUTINE Morison_CopyCoefDpths - - SUBROUTINE Morison_DestroyCoefDpths( CoefDpthsData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(Morison_CoefDpths), INTENT(INOUT) :: CoefDpthsData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_DestroyCoefDpths' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE Morison_DestroyCoefDpths - - SUBROUTINE Morison_PackCoefDpths( 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(Morison_CoefDpths), 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 = 'Morison_PackCoefDpths' - ! 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 ! Dpth - Re_BufSz = Re_BufSz + 1 ! DpthCd - Re_BufSz = Re_BufSz + 1 ! DpthCdMG - Re_BufSz = Re_BufSz + 1 ! DpthCa - Re_BufSz = Re_BufSz + 1 ! DpthCaMG - Re_BufSz = Re_BufSz + 1 ! DpthCp - Re_BufSz = Re_BufSz + 1 ! DpthCpMG - Re_BufSz = Re_BufSz + 1 ! DpthAxCd - Re_BufSz = Re_BufSz + 1 ! DpthAxCdMG - Re_BufSz = Re_BufSz + 1 ! DpthAxCa - Re_BufSz = Re_BufSz + 1 ! DpthAxCaMG - Re_BufSz = Re_BufSz + 1 ! DpthAxCp - Re_BufSz = Re_BufSz + 1 ! DpthAxCpMG - 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%Dpth - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%DpthCd - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%DpthCdMG - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%DpthCa - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%DpthCaMG - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%DpthCp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%DpthCpMG - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%DpthAxCd - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%DpthAxCdMG - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%DpthAxCa - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%DpthAxCaMG - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%DpthAxCp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%DpthAxCpMG - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Morison_PackCoefDpths - - SUBROUTINE Morison_UnPackCoefDpths( 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(Morison_CoefDpths), 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 = 'Morison_UnPackCoefDpths' - ! 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%Dpth = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%DpthCd = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%DpthCdMG = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%DpthCa = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%DpthCaMG = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%DpthCp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%DpthCpMG = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%DpthAxCd = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%DpthAxCdMG = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%DpthAxCa = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%DpthAxCaMG = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%DpthAxCp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%DpthAxCpMG = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Morison_UnPackCoefDpths - - SUBROUTINE Morison_CopyAxialCoefType( SrcAxialCoefTypeData, DstAxialCoefTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Morison_AxialCoefType), INTENT(IN) :: SrcAxialCoefTypeData - TYPE(Morison_AxialCoefType), INTENT(INOUT) :: DstAxialCoefTypeData - 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 = 'Morison_CopyAxialCoefType' -! - ErrStat = ErrID_None - ErrMsg = "" - DstAxialCoefTypeData%AxCoefID = SrcAxialCoefTypeData%AxCoefID - DstAxialCoefTypeData%AxCd = SrcAxialCoefTypeData%AxCd - DstAxialCoefTypeData%AxCa = SrcAxialCoefTypeData%AxCa - DstAxialCoefTypeData%AxCp = SrcAxialCoefTypeData%AxCp - END SUBROUTINE Morison_CopyAxialCoefType - - SUBROUTINE Morison_DestroyAxialCoefType( AxialCoefTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(Morison_AxialCoefType), INTENT(INOUT) :: AxialCoefTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_DestroyAxialCoefType' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE Morison_DestroyAxialCoefType - - SUBROUTINE Morison_PackAxialCoefType( 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(Morison_AxialCoefType), 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 = 'Morison_PackAxialCoefType' - ! 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 ! AxCoefID - Re_BufSz = Re_BufSz + 1 ! AxCd - Re_BufSz = Re_BufSz + 1 ! AxCa - Re_BufSz = Re_BufSz + 1 ! AxCp - 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%AxCoefID - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%AxCd - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%AxCa - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%AxCp - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Morison_PackAxialCoefType - - SUBROUTINE Morison_UnPackAxialCoefType( 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(Morison_AxialCoefType), 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 = 'Morison_UnPackAxialCoefType' - ! 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%AxCoefID = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%AxCd = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%AxCa = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%AxCp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Morison_UnPackAxialCoefType - - SUBROUTINE Morison_CopyMemberInputType( SrcMemberInputTypeData, DstMemberInputTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Morison_MemberInputType), INTENT(IN) :: SrcMemberInputTypeData - TYPE(Morison_MemberInputType), INTENT(INOUT) :: DstMemberInputTypeData - 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 = 'Morison_CopyMemberInputType' -! - ErrStat = ErrID_None - ErrMsg = "" - DstMemberInputTypeData%MemberID = SrcMemberInputTypeData%MemberID -IF (ALLOCATED(SrcMemberInputTypeData%NodeIndx)) THEN - i1_l = LBOUND(SrcMemberInputTypeData%NodeIndx,1) - i1_u = UBOUND(SrcMemberInputTypeData%NodeIndx,1) - IF (.NOT. ALLOCATED(DstMemberInputTypeData%NodeIndx)) THEN - ALLOCATE(DstMemberInputTypeData%NodeIndx(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberInputTypeData%NodeIndx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberInputTypeData%NodeIndx = SrcMemberInputTypeData%NodeIndx -ENDIF - DstMemberInputTypeData%MJointID1 = SrcMemberInputTypeData%MJointID1 - DstMemberInputTypeData%MJointID2 = SrcMemberInputTypeData%MJointID2 - DstMemberInputTypeData%MJointID1Indx = SrcMemberInputTypeData%MJointID1Indx - DstMemberInputTypeData%MJointID2Indx = SrcMemberInputTypeData%MJointID2Indx - DstMemberInputTypeData%MPropSetID1 = SrcMemberInputTypeData%MPropSetID1 - DstMemberInputTypeData%MPropSetID2 = SrcMemberInputTypeData%MPropSetID2 - DstMemberInputTypeData%MPropSetID1Indx = SrcMemberInputTypeData%MPropSetID1Indx - DstMemberInputTypeData%MPropSetID2Indx = SrcMemberInputTypeData%MPropSetID2Indx - DstMemberInputTypeData%MDivSize = SrcMemberInputTypeData%MDivSize - DstMemberInputTypeData%MCoefMod = SrcMemberInputTypeData%MCoefMod - DstMemberInputTypeData%MmbrCoefIDIndx = SrcMemberInputTypeData%MmbrCoefIDIndx - DstMemberInputTypeData%MmbrFilledIDIndx = SrcMemberInputTypeData%MmbrFilledIDIndx - DstMemberInputTypeData%PropPot = SrcMemberInputTypeData%PropPot - DstMemberInputTypeData%NElements = SrcMemberInputTypeData%NElements - DstMemberInputTypeData%RefLength = SrcMemberInputTypeData%RefLength - DstMemberInputTypeData%dl = SrcMemberInputTypeData%dl - END SUBROUTINE Morison_CopyMemberInputType - - SUBROUTINE Morison_DestroyMemberInputType( MemberInputTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(Morison_MemberInputType), INTENT(INOUT) :: MemberInputTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_DestroyMemberInputType' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(MemberInputTypeData%NodeIndx)) THEN - DEALLOCATE(MemberInputTypeData%NodeIndx) -ENDIF - END SUBROUTINE Morison_DestroyMemberInputType - - SUBROUTINE Morison_PackMemberInputType( 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(Morison_MemberInputType), 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 = 'Morison_PackMemberInputType' - ! 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 ! NodeIndx allocated yes/no - IF ( ALLOCATED(InData%NodeIndx) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! NodeIndx upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%NodeIndx) ! NodeIndx - END IF - Int_BufSz = Int_BufSz + 1 ! MJointID1 - Int_BufSz = Int_BufSz + 1 ! MJointID2 - Int_BufSz = Int_BufSz + 1 ! MJointID1Indx - Int_BufSz = Int_BufSz + 1 ! MJointID2Indx - Int_BufSz = Int_BufSz + 1 ! MPropSetID1 - Int_BufSz = Int_BufSz + 1 ! MPropSetID2 - Int_BufSz = Int_BufSz + 1 ! MPropSetID1Indx - Int_BufSz = Int_BufSz + 1 ! MPropSetID2Indx - Re_BufSz = Re_BufSz + 1 ! MDivSize - Int_BufSz = Int_BufSz + 1 ! MCoefMod - Int_BufSz = Int_BufSz + 1 ! MmbrCoefIDIndx - Int_BufSz = Int_BufSz + 1 ! MmbrFilledIDIndx - Int_BufSz = Int_BufSz + 1 ! PropPot - Int_BufSz = Int_BufSz + 1 ! NElements - Re_BufSz = Re_BufSz + 1 ! RefLength - Re_BufSz = Re_BufSz + 1 ! dl - 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 - IF ( .NOT. ALLOCATED(InData%NodeIndx) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%NodeIndx,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NodeIndx,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%NodeIndx,1), UBOUND(InData%NodeIndx,1) - IntKiBuf(Int_Xferred) = InData%NodeIndx(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%MJointID1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%MJointID2 - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%MJointID1Indx - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%MJointID2Indx - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%MPropSetID1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%MPropSetID2 - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%MPropSetID1Indx - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%MPropSetID2Indx - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MDivSize - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%MCoefMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%MmbrCoefIDIndx - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%MmbrFilledIDIndx - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%PropPot, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NElements - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RefLength - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%dl - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Morison_PackMemberInputType - - SUBROUTINE Morison_UnPackMemberInputType( 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(Morison_MemberInputType), 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 = 'Morison_UnPackMemberInputType' - ! 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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NodeIndx not allocated - Int_Xferred = Int_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%NodeIndx)) DEALLOCATE(OutData%NodeIndx) - ALLOCATE(OutData%NodeIndx(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NodeIndx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%NodeIndx,1), UBOUND(OutData%NodeIndx,1) - OutData%NodeIndx(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - OutData%MJointID1 = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%MJointID2 = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%MJointID1Indx = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%MJointID2Indx = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%MPropSetID1 = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%MPropSetID2 = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%MPropSetID1Indx = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%MPropSetID2Indx = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%MDivSize = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MCoefMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%MmbrCoefIDIndx = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%MmbrFilledIDIndx = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%PropPot = TRANSFER(IntKiBuf(Int_Xferred), OutData%PropPot) - Int_Xferred = Int_Xferred + 1 - OutData%NElements = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%RefLength = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%dl = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Morison_UnPackMemberInputType - - SUBROUTINE Morison_CopyNodeType( SrcNodeTypeData, DstNodeTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Morison_NodeType), INTENT(IN) :: SrcNodeTypeData - TYPE(Morison_NodeType), INTENT(INOUT) :: DstNodeTypeData - 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 = 'Morison_CopyNodeType' -! - ErrStat = ErrID_None - ErrMsg = "" - DstNodeTypeData%JointIndx = SrcNodeTypeData%JointIndx - DstNodeTypeData%Position = SrcNodeTypeData%Position - DstNodeTypeData%JointOvrlp = SrcNodeTypeData%JointOvrlp - DstNodeTypeData%JointAxIDIndx = SrcNodeTypeData%JointAxIDIndx - DstNodeTypeData%NConnections = SrcNodeTypeData%NConnections - DstNodeTypeData%ConnectionList = SrcNodeTypeData%ConnectionList - DstNodeTypeData%JAxCd = SrcNodeTypeData%JAxCd - DstNodeTypeData%JAxCa = SrcNodeTypeData%JAxCa - DstNodeTypeData%JAxCp = SrcNodeTypeData%JAxCp - DstNodeTypeData%FillDensity = SrcNodeTypeData%FillDensity - DstNodeTypeData%tMG = SrcNodeTypeData%tMG - DstNodeTypeData%MGdensity = SrcNodeTypeData%MGdensity - END SUBROUTINE Morison_CopyNodeType - - SUBROUTINE Morison_DestroyNodeType( NodeTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(Morison_NodeType), INTENT(INOUT) :: NodeTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_DestroyNodeType' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE Morison_DestroyNodeType - - SUBROUTINE Morison_PackNodeType( 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(Morison_NodeType), 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 = 'Morison_PackNodeType' - ! 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 ! JointIndx - Re_BufSz = Re_BufSz + SIZE(InData%Position) ! Position - Int_BufSz = Int_BufSz + 1 ! JointOvrlp - Int_BufSz = Int_BufSz + 1 ! JointAxIDIndx - Int_BufSz = Int_BufSz + 1 ! NConnections - Int_BufSz = Int_BufSz + SIZE(InData%ConnectionList) ! ConnectionList - Re_BufSz = Re_BufSz + 1 ! JAxCd - Re_BufSz = Re_BufSz + 1 ! JAxCa - Re_BufSz = Re_BufSz + 1 ! JAxCp - Re_BufSz = Re_BufSz + 1 ! FillDensity - Re_BufSz = Re_BufSz + 1 ! tMG - Re_BufSz = Re_BufSz + 1 ! MGdensity - 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%JointIndx - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%Position,1), UBOUND(InData%Position,1) - ReKiBuf(Re_Xferred) = InData%Position(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%JointOvrlp - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%JointAxIDIndx - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NConnections - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%ConnectionList,1), UBOUND(InData%ConnectionList,1) - IntKiBuf(Int_Xferred) = InData%ConnectionList(i1) - Int_Xferred = Int_Xferred + 1 - END DO - ReKiBuf(Re_Xferred) = InData%JAxCd - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%JAxCa - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%JAxCp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%FillDensity - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%tMG - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MGdensity - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Morison_PackNodeType - - SUBROUTINE Morison_UnPackNodeType( 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(Morison_NodeType), 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 = 'Morison_UnPackNodeType' - ! 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%JointIndx = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%Position,1) - i1_u = UBOUND(OutData%Position,1) - DO i1 = LBOUND(OutData%Position,1), UBOUND(OutData%Position,1) - OutData%Position(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%JointOvrlp = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%JointAxIDIndx = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NConnections = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%ConnectionList,1) - i1_u = UBOUND(OutData%ConnectionList,1) - DO i1 = LBOUND(OutData%ConnectionList,1), UBOUND(OutData%ConnectionList,1) - OutData%ConnectionList(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - OutData%JAxCd = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%JAxCa = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%JAxCp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%FillDensity = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%tMG = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MGdensity = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Morison_UnPackNodeType - - SUBROUTINE Morison_CopyMemberType( SrcMemberTypeData, DstMemberTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Morison_MemberType), INTENT(IN) :: SrcMemberTypeData - TYPE(Morison_MemberType), INTENT(INOUT) :: DstMemberTypeData - 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 = 'Morison_CopyMemberType' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcMemberTypeData%NodeIndx)) THEN - i1_l = LBOUND(SrcMemberTypeData%NodeIndx,1) - i1_u = UBOUND(SrcMemberTypeData%NodeIndx,1) - IF (.NOT. ALLOCATED(DstMemberTypeData%NodeIndx)) THEN - ALLOCATE(DstMemberTypeData%NodeIndx(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%NodeIndx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberTypeData%NodeIndx = SrcMemberTypeData%NodeIndx -ENDIF - DstMemberTypeData%MemberID = SrcMemberTypeData%MemberID - DstMemberTypeData%NElements = SrcMemberTypeData%NElements - DstMemberTypeData%RefLength = SrcMemberTypeData%RefLength - DstMemberTypeData%cosPhi_ref = SrcMemberTypeData%cosPhi_ref - DstMemberTypeData%dl = SrcMemberTypeData%dl - DstMemberTypeData%k = SrcMemberTypeData%k - DstMemberTypeData%kkt = SrcMemberTypeData%kkt - DstMemberTypeData%Ak = SrcMemberTypeData%Ak -IF (ALLOCATED(SrcMemberTypeData%R)) THEN - i1_l = LBOUND(SrcMemberTypeData%R,1) - i1_u = UBOUND(SrcMemberTypeData%R,1) - IF (.NOT. ALLOCATED(DstMemberTypeData%R)) THEN - ALLOCATE(DstMemberTypeData%R(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%R.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberTypeData%R = SrcMemberTypeData%R -ENDIF -IF (ALLOCATED(SrcMemberTypeData%RMG)) THEN - i1_l = LBOUND(SrcMemberTypeData%RMG,1) - i1_u = UBOUND(SrcMemberTypeData%RMG,1) - IF (.NOT. ALLOCATED(DstMemberTypeData%RMG)) THEN - ALLOCATE(DstMemberTypeData%RMG(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%RMG.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberTypeData%RMG = SrcMemberTypeData%RMG -ENDIF -IF (ALLOCATED(SrcMemberTypeData%Rin)) THEN - i1_l = LBOUND(SrcMemberTypeData%Rin,1) - i1_u = UBOUND(SrcMemberTypeData%Rin,1) - IF (.NOT. ALLOCATED(DstMemberTypeData%Rin)) THEN - ALLOCATE(DstMemberTypeData%Rin(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%Rin.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberTypeData%Rin = SrcMemberTypeData%Rin -ENDIF -IF (ALLOCATED(SrcMemberTypeData%tMG)) THEN - i1_l = LBOUND(SrcMemberTypeData%tMG,1) - i1_u = UBOUND(SrcMemberTypeData%tMG,1) - IF (.NOT. ALLOCATED(DstMemberTypeData%tMG)) THEN - ALLOCATE(DstMemberTypeData%tMG(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%tMG.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberTypeData%tMG = SrcMemberTypeData%tMG -ENDIF -IF (ALLOCATED(SrcMemberTypeData%MGdensity)) THEN - i1_l = LBOUND(SrcMemberTypeData%MGdensity,1) - i1_u = UBOUND(SrcMemberTypeData%MGdensity,1) - IF (.NOT. ALLOCATED(DstMemberTypeData%MGdensity)) THEN - ALLOCATE(DstMemberTypeData%MGdensity(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%MGdensity.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberTypeData%MGdensity = SrcMemberTypeData%MGdensity -ENDIF -IF (ALLOCATED(SrcMemberTypeData%dRdl_mg)) THEN - i1_l = LBOUND(SrcMemberTypeData%dRdl_mg,1) - i1_u = UBOUND(SrcMemberTypeData%dRdl_mg,1) - IF (.NOT. ALLOCATED(DstMemberTypeData%dRdl_mg)) THEN - ALLOCATE(DstMemberTypeData%dRdl_mg(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%dRdl_mg.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberTypeData%dRdl_mg = SrcMemberTypeData%dRdl_mg -ENDIF -IF (ALLOCATED(SrcMemberTypeData%dRdl_in)) THEN - i1_l = LBOUND(SrcMemberTypeData%dRdl_in,1) - i1_u = UBOUND(SrcMemberTypeData%dRdl_in,1) - IF (.NOT. ALLOCATED(DstMemberTypeData%dRdl_in)) THEN - ALLOCATE(DstMemberTypeData%dRdl_in(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%dRdl_in.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberTypeData%dRdl_in = SrcMemberTypeData%dRdl_in -ENDIF - DstMemberTypeData%Vinner = SrcMemberTypeData%Vinner - DstMemberTypeData%Vouter = SrcMemberTypeData%Vouter - DstMemberTypeData%Vballast = SrcMemberTypeData%Vballast - DstMemberTypeData%Vsubmerged = SrcMemberTypeData%Vsubmerged - DstMemberTypeData%l_fill = SrcMemberTypeData%l_fill - DstMemberTypeData%h_fill = SrcMemberTypeData%h_fill - DstMemberTypeData%z_overfill = SrcMemberTypeData%z_overfill - DstMemberTypeData%h_floor = SrcMemberTypeData%h_floor - DstMemberTypeData%i_floor = SrcMemberTypeData%i_floor - DstMemberTypeData%doEndBuoyancy = SrcMemberTypeData%doEndBuoyancy - DstMemberTypeData%memfloodstatus = SrcMemberTypeData%memfloodstatus -IF (ALLOCATED(SrcMemberTypeData%floodstatus)) THEN - i1_l = LBOUND(SrcMemberTypeData%floodstatus,1) - i1_u = UBOUND(SrcMemberTypeData%floodstatus,1) - IF (.NOT. ALLOCATED(DstMemberTypeData%floodstatus)) THEN - ALLOCATE(DstMemberTypeData%floodstatus(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%floodstatus.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberTypeData%floodstatus = SrcMemberTypeData%floodstatus -ENDIF -IF (ALLOCATED(SrcMemberTypeData%alpha)) THEN - i1_l = LBOUND(SrcMemberTypeData%alpha,1) - i1_u = UBOUND(SrcMemberTypeData%alpha,1) - IF (.NOT. ALLOCATED(DstMemberTypeData%alpha)) THEN - ALLOCATE(DstMemberTypeData%alpha(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%alpha.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberTypeData%alpha = SrcMemberTypeData%alpha -ENDIF -IF (ALLOCATED(SrcMemberTypeData%alpha_fb)) THEN - i1_l = LBOUND(SrcMemberTypeData%alpha_fb,1) - i1_u = UBOUND(SrcMemberTypeData%alpha_fb,1) - IF (.NOT. ALLOCATED(DstMemberTypeData%alpha_fb)) THEN - ALLOCATE(DstMemberTypeData%alpha_fb(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%alpha_fb.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberTypeData%alpha_fb = SrcMemberTypeData%alpha_fb -ENDIF -IF (ALLOCATED(SrcMemberTypeData%alpha_fb_star)) THEN - i1_l = LBOUND(SrcMemberTypeData%alpha_fb_star,1) - i1_u = UBOUND(SrcMemberTypeData%alpha_fb_star,1) - IF (.NOT. ALLOCATED(DstMemberTypeData%alpha_fb_star)) THEN - ALLOCATE(DstMemberTypeData%alpha_fb_star(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%alpha_fb_star.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberTypeData%alpha_fb_star = SrcMemberTypeData%alpha_fb_star -ENDIF -IF (ALLOCATED(SrcMemberTypeData%Cd)) THEN - i1_l = LBOUND(SrcMemberTypeData%Cd,1) - i1_u = UBOUND(SrcMemberTypeData%Cd,1) - IF (.NOT. ALLOCATED(DstMemberTypeData%Cd)) THEN - ALLOCATE(DstMemberTypeData%Cd(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%Cd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberTypeData%Cd = SrcMemberTypeData%Cd -ENDIF -IF (ALLOCATED(SrcMemberTypeData%Ca)) THEN - i1_l = LBOUND(SrcMemberTypeData%Ca,1) - i1_u = UBOUND(SrcMemberTypeData%Ca,1) - IF (.NOT. ALLOCATED(DstMemberTypeData%Ca)) THEN - ALLOCATE(DstMemberTypeData%Ca(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%Ca.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberTypeData%Ca = SrcMemberTypeData%Ca -ENDIF -IF (ALLOCATED(SrcMemberTypeData%Cp)) THEN - i1_l = LBOUND(SrcMemberTypeData%Cp,1) - i1_u = UBOUND(SrcMemberTypeData%Cp,1) - IF (.NOT. ALLOCATED(DstMemberTypeData%Cp)) THEN - ALLOCATE(DstMemberTypeData%Cp(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%Cp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberTypeData%Cp = SrcMemberTypeData%Cp -ENDIF -IF (ALLOCATED(SrcMemberTypeData%AxCd)) THEN - i1_l = LBOUND(SrcMemberTypeData%AxCd,1) - i1_u = UBOUND(SrcMemberTypeData%AxCd,1) - IF (.NOT. ALLOCATED(DstMemberTypeData%AxCd)) THEN - ALLOCATE(DstMemberTypeData%AxCd(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%AxCd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberTypeData%AxCd = SrcMemberTypeData%AxCd -ENDIF -IF (ALLOCATED(SrcMemberTypeData%AxCa)) THEN - i1_l = LBOUND(SrcMemberTypeData%AxCa,1) - i1_u = UBOUND(SrcMemberTypeData%AxCa,1) - IF (.NOT. ALLOCATED(DstMemberTypeData%AxCa)) THEN - ALLOCATE(DstMemberTypeData%AxCa(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%AxCa.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberTypeData%AxCa = SrcMemberTypeData%AxCa -ENDIF -IF (ALLOCATED(SrcMemberTypeData%AxCp)) THEN - i1_l = LBOUND(SrcMemberTypeData%AxCp,1) - i1_u = UBOUND(SrcMemberTypeData%AxCp,1) - IF (.NOT. ALLOCATED(DstMemberTypeData%AxCp)) THEN - ALLOCATE(DstMemberTypeData%AxCp(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%AxCp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberTypeData%AxCp = SrcMemberTypeData%AxCp -ENDIF -IF (ALLOCATED(SrcMemberTypeData%m_fb_l)) THEN - i1_l = LBOUND(SrcMemberTypeData%m_fb_l,1) - i1_u = UBOUND(SrcMemberTypeData%m_fb_l,1) - IF (.NOT. ALLOCATED(DstMemberTypeData%m_fb_l)) THEN - ALLOCATE(DstMemberTypeData%m_fb_l(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%m_fb_l.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberTypeData%m_fb_l = SrcMemberTypeData%m_fb_l -ENDIF -IF (ALLOCATED(SrcMemberTypeData%m_fb_u)) THEN - i1_l = LBOUND(SrcMemberTypeData%m_fb_u,1) - i1_u = UBOUND(SrcMemberTypeData%m_fb_u,1) - IF (.NOT. ALLOCATED(DstMemberTypeData%m_fb_u)) THEN - ALLOCATE(DstMemberTypeData%m_fb_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%m_fb_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberTypeData%m_fb_u = SrcMemberTypeData%m_fb_u -ENDIF -IF (ALLOCATED(SrcMemberTypeData%h_cfb_l)) THEN - i1_l = LBOUND(SrcMemberTypeData%h_cfb_l,1) - i1_u = UBOUND(SrcMemberTypeData%h_cfb_l,1) - IF (.NOT. ALLOCATED(DstMemberTypeData%h_cfb_l)) THEN - ALLOCATE(DstMemberTypeData%h_cfb_l(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%h_cfb_l.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberTypeData%h_cfb_l = SrcMemberTypeData%h_cfb_l -ENDIF -IF (ALLOCATED(SrcMemberTypeData%h_cfb_u)) THEN - i1_l = LBOUND(SrcMemberTypeData%h_cfb_u,1) - i1_u = UBOUND(SrcMemberTypeData%h_cfb_u,1) - IF (.NOT. ALLOCATED(DstMemberTypeData%h_cfb_u)) THEN - ALLOCATE(DstMemberTypeData%h_cfb_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%h_cfb_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberTypeData%h_cfb_u = SrcMemberTypeData%h_cfb_u -ENDIF -IF (ALLOCATED(SrcMemberTypeData%I_lfb_l)) THEN - i1_l = LBOUND(SrcMemberTypeData%I_lfb_l,1) - i1_u = UBOUND(SrcMemberTypeData%I_lfb_l,1) - IF (.NOT. ALLOCATED(DstMemberTypeData%I_lfb_l)) THEN - ALLOCATE(DstMemberTypeData%I_lfb_l(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%I_lfb_l.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberTypeData%I_lfb_l = SrcMemberTypeData%I_lfb_l -ENDIF -IF (ALLOCATED(SrcMemberTypeData%I_lfb_u)) THEN - i1_l = LBOUND(SrcMemberTypeData%I_lfb_u,1) - i1_u = UBOUND(SrcMemberTypeData%I_lfb_u,1) - IF (.NOT. ALLOCATED(DstMemberTypeData%I_lfb_u)) THEN - ALLOCATE(DstMemberTypeData%I_lfb_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%I_lfb_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberTypeData%I_lfb_u = SrcMemberTypeData%I_lfb_u -ENDIF -IF (ALLOCATED(SrcMemberTypeData%I_rfb_l)) THEN - i1_l = LBOUND(SrcMemberTypeData%I_rfb_l,1) - i1_u = UBOUND(SrcMemberTypeData%I_rfb_l,1) - IF (.NOT. ALLOCATED(DstMemberTypeData%I_rfb_l)) THEN - ALLOCATE(DstMemberTypeData%I_rfb_l(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%I_rfb_l.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberTypeData%I_rfb_l = SrcMemberTypeData%I_rfb_l -ENDIF -IF (ALLOCATED(SrcMemberTypeData%I_rfb_u)) THEN - i1_l = LBOUND(SrcMemberTypeData%I_rfb_u,1) - i1_u = UBOUND(SrcMemberTypeData%I_rfb_u,1) - IF (.NOT. ALLOCATED(DstMemberTypeData%I_rfb_u)) THEN - ALLOCATE(DstMemberTypeData%I_rfb_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%I_rfb_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberTypeData%I_rfb_u = SrcMemberTypeData%I_rfb_u -ENDIF -IF (ALLOCATED(SrcMemberTypeData%m_mg_l)) THEN - i1_l = LBOUND(SrcMemberTypeData%m_mg_l,1) - i1_u = UBOUND(SrcMemberTypeData%m_mg_l,1) - IF (.NOT. ALLOCATED(DstMemberTypeData%m_mg_l)) THEN - ALLOCATE(DstMemberTypeData%m_mg_l(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%m_mg_l.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberTypeData%m_mg_l = SrcMemberTypeData%m_mg_l -ENDIF -IF (ALLOCATED(SrcMemberTypeData%m_mg_u)) THEN - i1_l = LBOUND(SrcMemberTypeData%m_mg_u,1) - i1_u = UBOUND(SrcMemberTypeData%m_mg_u,1) - IF (.NOT. ALLOCATED(DstMemberTypeData%m_mg_u)) THEN - ALLOCATE(DstMemberTypeData%m_mg_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%m_mg_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberTypeData%m_mg_u = SrcMemberTypeData%m_mg_u -ENDIF -IF (ALLOCATED(SrcMemberTypeData%h_cmg_l)) THEN - i1_l = LBOUND(SrcMemberTypeData%h_cmg_l,1) - i1_u = UBOUND(SrcMemberTypeData%h_cmg_l,1) - IF (.NOT. ALLOCATED(DstMemberTypeData%h_cmg_l)) THEN - ALLOCATE(DstMemberTypeData%h_cmg_l(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%h_cmg_l.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberTypeData%h_cmg_l = SrcMemberTypeData%h_cmg_l -ENDIF -IF (ALLOCATED(SrcMemberTypeData%h_cmg_u)) THEN - i1_l = LBOUND(SrcMemberTypeData%h_cmg_u,1) - i1_u = UBOUND(SrcMemberTypeData%h_cmg_u,1) - IF (.NOT. ALLOCATED(DstMemberTypeData%h_cmg_u)) THEN - ALLOCATE(DstMemberTypeData%h_cmg_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%h_cmg_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberTypeData%h_cmg_u = SrcMemberTypeData%h_cmg_u -ENDIF -IF (ALLOCATED(SrcMemberTypeData%I_lmg_l)) THEN - i1_l = LBOUND(SrcMemberTypeData%I_lmg_l,1) - i1_u = UBOUND(SrcMemberTypeData%I_lmg_l,1) - IF (.NOT. ALLOCATED(DstMemberTypeData%I_lmg_l)) THEN - ALLOCATE(DstMemberTypeData%I_lmg_l(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%I_lmg_l.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberTypeData%I_lmg_l = SrcMemberTypeData%I_lmg_l -ENDIF -IF (ALLOCATED(SrcMemberTypeData%I_lmg_u)) THEN - i1_l = LBOUND(SrcMemberTypeData%I_lmg_u,1) - i1_u = UBOUND(SrcMemberTypeData%I_lmg_u,1) - IF (.NOT. ALLOCATED(DstMemberTypeData%I_lmg_u)) THEN - ALLOCATE(DstMemberTypeData%I_lmg_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%I_lmg_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberTypeData%I_lmg_u = SrcMemberTypeData%I_lmg_u -ENDIF -IF (ALLOCATED(SrcMemberTypeData%I_rmg_l)) THEN - i1_l = LBOUND(SrcMemberTypeData%I_rmg_l,1) - i1_u = UBOUND(SrcMemberTypeData%I_rmg_l,1) - IF (.NOT. ALLOCATED(DstMemberTypeData%I_rmg_l)) THEN - ALLOCATE(DstMemberTypeData%I_rmg_l(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%I_rmg_l.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberTypeData%I_rmg_l = SrcMemberTypeData%I_rmg_l -ENDIF -IF (ALLOCATED(SrcMemberTypeData%I_rmg_u)) THEN - i1_l = LBOUND(SrcMemberTypeData%I_rmg_u,1) - i1_u = UBOUND(SrcMemberTypeData%I_rmg_u,1) - IF (.NOT. ALLOCATED(DstMemberTypeData%I_rmg_u)) THEN - ALLOCATE(DstMemberTypeData%I_rmg_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%I_rmg_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberTypeData%I_rmg_u = SrcMemberTypeData%I_rmg_u -ENDIF -IF (ALLOCATED(SrcMemberTypeData%Cfl_fb)) THEN - i1_l = LBOUND(SrcMemberTypeData%Cfl_fb,1) - i1_u = UBOUND(SrcMemberTypeData%Cfl_fb,1) - IF (.NOT. ALLOCATED(DstMemberTypeData%Cfl_fb)) THEN - ALLOCATE(DstMemberTypeData%Cfl_fb(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%Cfl_fb.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberTypeData%Cfl_fb = SrcMemberTypeData%Cfl_fb -ENDIF -IF (ALLOCATED(SrcMemberTypeData%Cfr_fb)) THEN - i1_l = LBOUND(SrcMemberTypeData%Cfr_fb,1) - i1_u = UBOUND(SrcMemberTypeData%Cfr_fb,1) - IF (.NOT. ALLOCATED(DstMemberTypeData%Cfr_fb)) THEN - ALLOCATE(DstMemberTypeData%Cfr_fb(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%Cfr_fb.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberTypeData%Cfr_fb = SrcMemberTypeData%Cfr_fb -ENDIF -IF (ALLOCATED(SrcMemberTypeData%CM0_fb)) THEN - i1_l = LBOUND(SrcMemberTypeData%CM0_fb,1) - i1_u = UBOUND(SrcMemberTypeData%CM0_fb,1) - IF (.NOT. ALLOCATED(DstMemberTypeData%CM0_fb)) THEN - ALLOCATE(DstMemberTypeData%CM0_fb(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%CM0_fb.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberTypeData%CM0_fb = SrcMemberTypeData%CM0_fb -ENDIF - DstMemberTypeData%MGvolume = SrcMemberTypeData%MGvolume - DstMemberTypeData%MDivSize = SrcMemberTypeData%MDivSize - DstMemberTypeData%MCoefMod = SrcMemberTypeData%MCoefMod - DstMemberTypeData%MmbrCoefIDIndx = SrcMemberTypeData%MmbrCoefIDIndx - DstMemberTypeData%MmbrFilledIDIndx = SrcMemberTypeData%MmbrFilledIDIndx - DstMemberTypeData%FillFSLoc = SrcMemberTypeData%FillFSLoc - DstMemberTypeData%FillDens = SrcMemberTypeData%FillDens - DstMemberTypeData%PropPot = SrcMemberTypeData%PropPot - DstMemberTypeData%Flipped = SrcMemberTypeData%Flipped - END SUBROUTINE Morison_CopyMemberType - - SUBROUTINE Morison_DestroyMemberType( MemberTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(Morison_MemberType), INTENT(INOUT) :: MemberTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_DestroyMemberType' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(MemberTypeData%NodeIndx)) THEN - DEALLOCATE(MemberTypeData%NodeIndx) -ENDIF -IF (ALLOCATED(MemberTypeData%R)) THEN - DEALLOCATE(MemberTypeData%R) -ENDIF -IF (ALLOCATED(MemberTypeData%RMG)) THEN - DEALLOCATE(MemberTypeData%RMG) -ENDIF -IF (ALLOCATED(MemberTypeData%Rin)) THEN - DEALLOCATE(MemberTypeData%Rin) -ENDIF -IF (ALLOCATED(MemberTypeData%tMG)) THEN - DEALLOCATE(MemberTypeData%tMG) -ENDIF -IF (ALLOCATED(MemberTypeData%MGdensity)) THEN - DEALLOCATE(MemberTypeData%MGdensity) -ENDIF -IF (ALLOCATED(MemberTypeData%dRdl_mg)) THEN - DEALLOCATE(MemberTypeData%dRdl_mg) -ENDIF -IF (ALLOCATED(MemberTypeData%dRdl_in)) THEN - DEALLOCATE(MemberTypeData%dRdl_in) -ENDIF -IF (ALLOCATED(MemberTypeData%floodstatus)) THEN - DEALLOCATE(MemberTypeData%floodstatus) -ENDIF -IF (ALLOCATED(MemberTypeData%alpha)) THEN - DEALLOCATE(MemberTypeData%alpha) -ENDIF -IF (ALLOCATED(MemberTypeData%alpha_fb)) THEN - DEALLOCATE(MemberTypeData%alpha_fb) -ENDIF -IF (ALLOCATED(MemberTypeData%alpha_fb_star)) THEN - DEALLOCATE(MemberTypeData%alpha_fb_star) -ENDIF -IF (ALLOCATED(MemberTypeData%Cd)) THEN - DEALLOCATE(MemberTypeData%Cd) -ENDIF -IF (ALLOCATED(MemberTypeData%Ca)) THEN - DEALLOCATE(MemberTypeData%Ca) -ENDIF -IF (ALLOCATED(MemberTypeData%Cp)) THEN - DEALLOCATE(MemberTypeData%Cp) -ENDIF -IF (ALLOCATED(MemberTypeData%AxCd)) THEN - DEALLOCATE(MemberTypeData%AxCd) -ENDIF -IF (ALLOCATED(MemberTypeData%AxCa)) THEN - DEALLOCATE(MemberTypeData%AxCa) -ENDIF -IF (ALLOCATED(MemberTypeData%AxCp)) THEN - DEALLOCATE(MemberTypeData%AxCp) -ENDIF -IF (ALLOCATED(MemberTypeData%m_fb_l)) THEN - DEALLOCATE(MemberTypeData%m_fb_l) -ENDIF -IF (ALLOCATED(MemberTypeData%m_fb_u)) THEN - DEALLOCATE(MemberTypeData%m_fb_u) -ENDIF -IF (ALLOCATED(MemberTypeData%h_cfb_l)) THEN - DEALLOCATE(MemberTypeData%h_cfb_l) -ENDIF -IF (ALLOCATED(MemberTypeData%h_cfb_u)) THEN - DEALLOCATE(MemberTypeData%h_cfb_u) -ENDIF -IF (ALLOCATED(MemberTypeData%I_lfb_l)) THEN - DEALLOCATE(MemberTypeData%I_lfb_l) -ENDIF -IF (ALLOCATED(MemberTypeData%I_lfb_u)) THEN - DEALLOCATE(MemberTypeData%I_lfb_u) -ENDIF -IF (ALLOCATED(MemberTypeData%I_rfb_l)) THEN - DEALLOCATE(MemberTypeData%I_rfb_l) -ENDIF -IF (ALLOCATED(MemberTypeData%I_rfb_u)) THEN - DEALLOCATE(MemberTypeData%I_rfb_u) -ENDIF -IF (ALLOCATED(MemberTypeData%m_mg_l)) THEN - DEALLOCATE(MemberTypeData%m_mg_l) -ENDIF -IF (ALLOCATED(MemberTypeData%m_mg_u)) THEN - DEALLOCATE(MemberTypeData%m_mg_u) -ENDIF -IF (ALLOCATED(MemberTypeData%h_cmg_l)) THEN - DEALLOCATE(MemberTypeData%h_cmg_l) -ENDIF -IF (ALLOCATED(MemberTypeData%h_cmg_u)) THEN - DEALLOCATE(MemberTypeData%h_cmg_u) -ENDIF -IF (ALLOCATED(MemberTypeData%I_lmg_l)) THEN - DEALLOCATE(MemberTypeData%I_lmg_l) -ENDIF -IF (ALLOCATED(MemberTypeData%I_lmg_u)) THEN - DEALLOCATE(MemberTypeData%I_lmg_u) -ENDIF -IF (ALLOCATED(MemberTypeData%I_rmg_l)) THEN - DEALLOCATE(MemberTypeData%I_rmg_l) -ENDIF -IF (ALLOCATED(MemberTypeData%I_rmg_u)) THEN - DEALLOCATE(MemberTypeData%I_rmg_u) -ENDIF -IF (ALLOCATED(MemberTypeData%Cfl_fb)) THEN - DEALLOCATE(MemberTypeData%Cfl_fb) -ENDIF -IF (ALLOCATED(MemberTypeData%Cfr_fb)) THEN - DEALLOCATE(MemberTypeData%Cfr_fb) -ENDIF -IF (ALLOCATED(MemberTypeData%CM0_fb)) THEN - DEALLOCATE(MemberTypeData%CM0_fb) -ENDIF - END SUBROUTINE Morison_DestroyMemberType - - SUBROUTINE Morison_PackMemberType( 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(Morison_MemberType), 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 = 'Morison_PackMemberType' - ! 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 ! NodeIndx allocated yes/no - IF ( ALLOCATED(InData%NodeIndx) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! NodeIndx upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%NodeIndx) ! NodeIndx - END IF - Int_BufSz = Int_BufSz + 1 ! MemberID - Int_BufSz = Int_BufSz + 1 ! NElements - Re_BufSz = Re_BufSz + 1 ! RefLength - Re_BufSz = Re_BufSz + 1 ! cosPhi_ref - Re_BufSz = Re_BufSz + 1 ! dl - Re_BufSz = Re_BufSz + SIZE(InData%k) ! k - Re_BufSz = Re_BufSz + SIZE(InData%kkt) ! kkt - Re_BufSz = Re_BufSz + SIZE(InData%Ak) ! Ak - 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 - Int_BufSz = Int_BufSz + 1 ! RMG allocated yes/no - IF ( ALLOCATED(InData%RMG) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! RMG upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%RMG) ! RMG - END IF - Int_BufSz = Int_BufSz + 1 ! Rin allocated yes/no - IF ( ALLOCATED(InData%Rin) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Rin upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Rin) ! Rin - END IF - Int_BufSz = Int_BufSz + 1 ! tMG allocated yes/no - IF ( ALLOCATED(InData%tMG) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! tMG upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%tMG) ! tMG - END IF - Int_BufSz = Int_BufSz + 1 ! MGdensity allocated yes/no - IF ( ALLOCATED(InData%MGdensity) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! MGdensity upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%MGdensity) ! MGdensity - END IF - Int_BufSz = Int_BufSz + 1 ! dRdl_mg allocated yes/no - IF ( ALLOCATED(InData%dRdl_mg) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! dRdl_mg upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%dRdl_mg) ! dRdl_mg - END IF - Int_BufSz = Int_BufSz + 1 ! dRdl_in allocated yes/no - IF ( ALLOCATED(InData%dRdl_in) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! dRdl_in upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%dRdl_in) ! dRdl_in - END IF - Re_BufSz = Re_BufSz + 1 ! Vinner - Re_BufSz = Re_BufSz + 1 ! Vouter - Re_BufSz = Re_BufSz + 1 ! Vballast - Re_BufSz = Re_BufSz + 1 ! Vsubmerged - Re_BufSz = Re_BufSz + 1 ! l_fill - Re_BufSz = Re_BufSz + 1 ! h_fill - Re_BufSz = Re_BufSz + 1 ! z_overfill - Re_BufSz = Re_BufSz + 1 ! h_floor - Int_BufSz = Int_BufSz + 1 ! i_floor - Int_BufSz = Int_BufSz + 1 ! doEndBuoyancy - Int_BufSz = Int_BufSz + 1 ! memfloodstatus - Int_BufSz = Int_BufSz + 1 ! floodstatus allocated yes/no - IF ( ALLOCATED(InData%floodstatus) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! floodstatus upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%floodstatus) ! floodstatus - END IF - Int_BufSz = Int_BufSz + 1 ! alpha allocated yes/no - IF ( ALLOCATED(InData%alpha) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! alpha upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%alpha) ! alpha - END IF - Int_BufSz = Int_BufSz + 1 ! alpha_fb allocated yes/no - IF ( ALLOCATED(InData%alpha_fb) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! alpha_fb upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%alpha_fb) ! alpha_fb - END IF - Int_BufSz = Int_BufSz + 1 ! alpha_fb_star allocated yes/no - IF ( ALLOCATED(InData%alpha_fb_star) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! alpha_fb_star upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%alpha_fb_star) ! alpha_fb_star - END IF - Int_BufSz = Int_BufSz + 1 ! Cd allocated yes/no - IF ( ALLOCATED(InData%Cd) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Cd upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Cd) ! Cd - END IF - Int_BufSz = Int_BufSz + 1 ! Ca allocated yes/no - IF ( ALLOCATED(InData%Ca) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Ca upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Ca) ! Ca - END IF - Int_BufSz = Int_BufSz + 1 ! Cp allocated yes/no - IF ( ALLOCATED(InData%Cp) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Cp upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Cp) ! Cp - END IF - Int_BufSz = Int_BufSz + 1 ! AxCd allocated yes/no - IF ( ALLOCATED(InData%AxCd) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! AxCd upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AxCd) ! AxCd - END IF - Int_BufSz = Int_BufSz + 1 ! AxCa allocated yes/no - IF ( ALLOCATED(InData%AxCa) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! AxCa upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AxCa) ! AxCa - END IF - Int_BufSz = Int_BufSz + 1 ! AxCp allocated yes/no - IF ( ALLOCATED(InData%AxCp) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! AxCp upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AxCp) ! AxCp - END IF - Int_BufSz = Int_BufSz + 1 ! m_fb_l allocated yes/no - IF ( ALLOCATED(InData%m_fb_l) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! m_fb_l upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%m_fb_l) ! m_fb_l - END IF - Int_BufSz = Int_BufSz + 1 ! m_fb_u allocated yes/no - IF ( ALLOCATED(InData%m_fb_u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! m_fb_u upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%m_fb_u) ! m_fb_u - END IF - Int_BufSz = Int_BufSz + 1 ! h_cfb_l allocated yes/no - IF ( ALLOCATED(InData%h_cfb_l) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! h_cfb_l upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%h_cfb_l) ! h_cfb_l - END IF - Int_BufSz = Int_BufSz + 1 ! h_cfb_u allocated yes/no - IF ( ALLOCATED(InData%h_cfb_u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! h_cfb_u upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%h_cfb_u) ! h_cfb_u - END IF - Int_BufSz = Int_BufSz + 1 ! I_lfb_l allocated yes/no - IF ( ALLOCATED(InData%I_lfb_l) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! I_lfb_l upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%I_lfb_l) ! I_lfb_l - END IF - Int_BufSz = Int_BufSz + 1 ! I_lfb_u allocated yes/no - IF ( ALLOCATED(InData%I_lfb_u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! I_lfb_u upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%I_lfb_u) ! I_lfb_u - END IF - Int_BufSz = Int_BufSz + 1 ! I_rfb_l allocated yes/no - IF ( ALLOCATED(InData%I_rfb_l) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! I_rfb_l upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%I_rfb_l) ! I_rfb_l - END IF - Int_BufSz = Int_BufSz + 1 ! I_rfb_u allocated yes/no - IF ( ALLOCATED(InData%I_rfb_u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! I_rfb_u upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%I_rfb_u) ! I_rfb_u - END IF - Int_BufSz = Int_BufSz + 1 ! m_mg_l allocated yes/no - IF ( ALLOCATED(InData%m_mg_l) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! m_mg_l upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%m_mg_l) ! m_mg_l - END IF - Int_BufSz = Int_BufSz + 1 ! m_mg_u allocated yes/no - IF ( ALLOCATED(InData%m_mg_u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! m_mg_u upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%m_mg_u) ! m_mg_u - END IF - Int_BufSz = Int_BufSz + 1 ! h_cmg_l allocated yes/no - IF ( ALLOCATED(InData%h_cmg_l) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! h_cmg_l upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%h_cmg_l) ! h_cmg_l - END IF - Int_BufSz = Int_BufSz + 1 ! h_cmg_u allocated yes/no - IF ( ALLOCATED(InData%h_cmg_u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! h_cmg_u upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%h_cmg_u) ! h_cmg_u - END IF - Int_BufSz = Int_BufSz + 1 ! I_lmg_l allocated yes/no - IF ( ALLOCATED(InData%I_lmg_l) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! I_lmg_l upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%I_lmg_l) ! I_lmg_l - END IF - Int_BufSz = Int_BufSz + 1 ! I_lmg_u allocated yes/no - IF ( ALLOCATED(InData%I_lmg_u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! I_lmg_u upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%I_lmg_u) ! I_lmg_u - END IF - Int_BufSz = Int_BufSz + 1 ! I_rmg_l allocated yes/no - IF ( ALLOCATED(InData%I_rmg_l) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! I_rmg_l upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%I_rmg_l) ! I_rmg_l - END IF - Int_BufSz = Int_BufSz + 1 ! I_rmg_u allocated yes/no - IF ( ALLOCATED(InData%I_rmg_u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! I_rmg_u upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%I_rmg_u) ! I_rmg_u - END IF - Int_BufSz = Int_BufSz + 1 ! Cfl_fb allocated yes/no - IF ( ALLOCATED(InData%Cfl_fb) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Cfl_fb upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Cfl_fb) ! Cfl_fb - END IF - Int_BufSz = Int_BufSz + 1 ! Cfr_fb allocated yes/no - IF ( ALLOCATED(InData%Cfr_fb) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Cfr_fb upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Cfr_fb) ! Cfr_fb - END IF - Int_BufSz = Int_BufSz + 1 ! CM0_fb allocated yes/no - IF ( ALLOCATED(InData%CM0_fb) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! CM0_fb upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CM0_fb) ! CM0_fb - END IF - Re_BufSz = Re_BufSz + 1 ! MGvolume - Re_BufSz = Re_BufSz + 1 ! MDivSize - Int_BufSz = Int_BufSz + 1 ! MCoefMod - Int_BufSz = Int_BufSz + 1 ! MmbrCoefIDIndx - Int_BufSz = Int_BufSz + 1 ! MmbrFilledIDIndx - Re_BufSz = Re_BufSz + 1 ! FillFSLoc - Re_BufSz = Re_BufSz + 1 ! FillDens - Int_BufSz = Int_BufSz + 1 ! PropPot - Int_BufSz = Int_BufSz + 1 ! Flipped - 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%NodeIndx) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%NodeIndx,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NodeIndx,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%NodeIndx,1), UBOUND(InData%NodeIndx,1) - IntKiBuf(Int_Xferred) = InData%NodeIndx(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%MemberID - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NElements - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RefLength - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%cosPhi_ref - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%dl - Re_Xferred = Re_Xferred + 1 - DO i1 = LBOUND(InData%k,1), UBOUND(InData%k,1) - ReKiBuf(Re_Xferred) = InData%k(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i2 = LBOUND(InData%kkt,2), UBOUND(InData%kkt,2) - DO i1 = LBOUND(InData%kkt,1), UBOUND(InData%kkt,1) - ReKiBuf(Re_Xferred) = InData%kkt(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - DO i2 = LBOUND(InData%Ak,2), UBOUND(InData%Ak,2) - DO i1 = LBOUND(InData%Ak,1), UBOUND(InData%Ak,1) - ReKiBuf(Re_Xferred) = InData%Ak(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - 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 - IF ( .NOT. ALLOCATED(InData%RMG) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RMG,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RMG,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%RMG,1), UBOUND(InData%RMG,1) - ReKiBuf(Re_Xferred) = InData%RMG(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Rin) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Rin,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Rin,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Rin,1), UBOUND(InData%Rin,1) - ReKiBuf(Re_Xferred) = InData%Rin(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%tMG) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%tMG,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%tMG,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%tMG,1), UBOUND(InData%tMG,1) - ReKiBuf(Re_Xferred) = InData%tMG(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%MGdensity) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MGdensity,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MGdensity,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%MGdensity,1), UBOUND(InData%MGdensity,1) - ReKiBuf(Re_Xferred) = InData%MGdensity(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%dRdl_mg) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%dRdl_mg,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dRdl_mg,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%dRdl_mg,1), UBOUND(InData%dRdl_mg,1) - ReKiBuf(Re_Xferred) = InData%dRdl_mg(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%dRdl_in) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%dRdl_in,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dRdl_in,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%dRdl_in,1), UBOUND(InData%dRdl_in,1) - ReKiBuf(Re_Xferred) = InData%dRdl_in(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%Vinner - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Vouter - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Vballast - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Vsubmerged - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%l_fill - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%h_fill - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%z_overfill - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%h_floor - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%i_floor - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%doEndBuoyancy, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%memfloodstatus - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%floodstatus) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%floodstatus,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%floodstatus,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%floodstatus,1), UBOUND(InData%floodstatus,1) - IntKiBuf(Int_Xferred) = InData%floodstatus(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%alpha) ) THEN - 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,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%alpha,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%alpha,1), UBOUND(InData%alpha,1) - ReKiBuf(Re_Xferred) = InData%alpha(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%alpha_fb) ) THEN - 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_fb,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%alpha_fb,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%alpha_fb,1), UBOUND(InData%alpha_fb,1) - ReKiBuf(Re_Xferred) = InData%alpha_fb(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%alpha_fb_star) ) THEN - 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_fb_star,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%alpha_fb_star,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%alpha_fb_star,1), UBOUND(InData%alpha_fb_star,1) - ReKiBuf(Re_Xferred) = InData%alpha_fb_star(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Cd) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Cd,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cd,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Cd,1), UBOUND(InData%Cd,1) - ReKiBuf(Re_Xferred) = InData%Cd(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Ca) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Ca,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Ca,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Ca,1), UBOUND(InData%Ca,1) - ReKiBuf(Re_Xferred) = InData%Ca(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Cp) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Cp,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cp,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Cp,1), UBOUND(InData%Cp,1) - ReKiBuf(Re_Xferred) = InData%Cp(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AxCd) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AxCd,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AxCd,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%AxCd,1), UBOUND(InData%AxCd,1) - ReKiBuf(Re_Xferred) = InData%AxCd(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AxCa) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AxCa,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AxCa,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%AxCa,1), UBOUND(InData%AxCa,1) - ReKiBuf(Re_Xferred) = InData%AxCa(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AxCp) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AxCp,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AxCp,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%AxCp,1), UBOUND(InData%AxCp,1) - ReKiBuf(Re_Xferred) = InData%AxCp(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%m_fb_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%m_fb_l,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%m_fb_l,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%m_fb_l,1), UBOUND(InData%m_fb_l,1) - ReKiBuf(Re_Xferred) = InData%m_fb_l(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%m_fb_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%m_fb_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%m_fb_u,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%m_fb_u,1), UBOUND(InData%m_fb_u,1) - ReKiBuf(Re_Xferred) = InData%m_fb_u(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%h_cfb_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%h_cfb_l,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%h_cfb_l,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%h_cfb_l,1), UBOUND(InData%h_cfb_l,1) - ReKiBuf(Re_Xferred) = InData%h_cfb_l(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%h_cfb_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%h_cfb_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%h_cfb_u,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%h_cfb_u,1), UBOUND(InData%h_cfb_u,1) - ReKiBuf(Re_Xferred) = InData%h_cfb_u(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%I_lfb_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%I_lfb_l,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%I_lfb_l,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%I_lfb_l,1), UBOUND(InData%I_lfb_l,1) - ReKiBuf(Re_Xferred) = InData%I_lfb_l(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%I_lfb_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%I_lfb_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%I_lfb_u,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%I_lfb_u,1), UBOUND(InData%I_lfb_u,1) - ReKiBuf(Re_Xferred) = InData%I_lfb_u(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%I_rfb_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%I_rfb_l,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%I_rfb_l,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%I_rfb_l,1), UBOUND(InData%I_rfb_l,1) - ReKiBuf(Re_Xferred) = InData%I_rfb_l(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%I_rfb_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%I_rfb_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%I_rfb_u,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%I_rfb_u,1), UBOUND(InData%I_rfb_u,1) - ReKiBuf(Re_Xferred) = InData%I_rfb_u(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%m_mg_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%m_mg_l,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%m_mg_l,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%m_mg_l,1), UBOUND(InData%m_mg_l,1) - ReKiBuf(Re_Xferred) = InData%m_mg_l(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%m_mg_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%m_mg_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%m_mg_u,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%m_mg_u,1), UBOUND(InData%m_mg_u,1) - ReKiBuf(Re_Xferred) = InData%m_mg_u(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%h_cmg_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%h_cmg_l,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%h_cmg_l,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%h_cmg_l,1), UBOUND(InData%h_cmg_l,1) - ReKiBuf(Re_Xferred) = InData%h_cmg_l(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%h_cmg_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%h_cmg_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%h_cmg_u,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%h_cmg_u,1), UBOUND(InData%h_cmg_u,1) - ReKiBuf(Re_Xferred) = InData%h_cmg_u(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%I_lmg_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%I_lmg_l,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%I_lmg_l,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%I_lmg_l,1), UBOUND(InData%I_lmg_l,1) - ReKiBuf(Re_Xferred) = InData%I_lmg_l(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%I_lmg_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%I_lmg_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%I_lmg_u,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%I_lmg_u,1), UBOUND(InData%I_lmg_u,1) - ReKiBuf(Re_Xferred) = InData%I_lmg_u(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%I_rmg_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%I_rmg_l,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%I_rmg_l,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%I_rmg_l,1), UBOUND(InData%I_rmg_l,1) - ReKiBuf(Re_Xferred) = InData%I_rmg_l(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%I_rmg_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%I_rmg_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%I_rmg_u,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%I_rmg_u,1), UBOUND(InData%I_rmg_u,1) - ReKiBuf(Re_Xferred) = InData%I_rmg_u(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Cfl_fb) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Cfl_fb,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cfl_fb,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Cfl_fb,1), UBOUND(InData%Cfl_fb,1) - ReKiBuf(Re_Xferred) = InData%Cfl_fb(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Cfr_fb) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Cfr_fb,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cfr_fb,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Cfr_fb,1), UBOUND(InData%Cfr_fb,1) - ReKiBuf(Re_Xferred) = InData%Cfr_fb(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CM0_fb) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CM0_fb,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CM0_fb,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%CM0_fb,1), UBOUND(InData%CM0_fb,1) - ReKiBuf(Re_Xferred) = InData%CM0_fb(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%MGvolume - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MDivSize - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%MCoefMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%MmbrCoefIDIndx - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%MmbrFilledIDIndx - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%FillFSLoc - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%FillDens - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%PropPot, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%Flipped, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Morison_PackMemberType - - SUBROUTINE Morison_UnPackMemberType( 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(Morison_MemberType), 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 = 'Morison_UnPackMemberType' - ! 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 ! NodeIndx not allocated - Int_Xferred = Int_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%NodeIndx)) DEALLOCATE(OutData%NodeIndx) - ALLOCATE(OutData%NodeIndx(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NodeIndx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%NodeIndx,1), UBOUND(OutData%NodeIndx,1) - OutData%NodeIndx(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - OutData%MemberID = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NElements = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%RefLength = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%cosPhi_ref = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%dl = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%k,1) - i1_u = UBOUND(OutData%k,1) - DO i1 = LBOUND(OutData%k,1), UBOUND(OutData%k,1) - OutData%k(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%kkt,1) - i1_u = UBOUND(OutData%kkt,1) - i2_l = LBOUND(OutData%kkt,2) - i2_u = UBOUND(OutData%kkt,2) - DO i2 = LBOUND(OutData%kkt,2), UBOUND(OutData%kkt,2) - DO i1 = LBOUND(OutData%kkt,1), UBOUND(OutData%kkt,1) - OutData%kkt(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%Ak,1) - i1_u = UBOUND(OutData%Ak,1) - i2_l = LBOUND(OutData%Ak,2) - i2_u = UBOUND(OutData%Ak,2) - DO i2 = LBOUND(OutData%Ak,2), UBOUND(OutData%Ak,2) - DO i1 = LBOUND(OutData%Ak,1), UBOUND(OutData%Ak,1) - OutData%Ak(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - 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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RMG not allocated - Int_Xferred = Int_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%RMG)) DEALLOCATE(OutData%RMG) - ALLOCATE(OutData%RMG(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RMG.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%RMG,1), UBOUND(OutData%RMG,1) - OutData%RMG(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Rin not allocated - Int_Xferred = Int_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%Rin)) DEALLOCATE(OutData%Rin) - ALLOCATE(OutData%Rin(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Rin.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Rin,1), UBOUND(OutData%Rin,1) - OutData%Rin(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! tMG not allocated - Int_Xferred = Int_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%tMG)) DEALLOCATE(OutData%tMG) - ALLOCATE(OutData%tMG(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%tMG.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%tMG,1), UBOUND(OutData%tMG,1) - OutData%tMG(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MGdensity not allocated - Int_Xferred = Int_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%MGdensity)) DEALLOCATE(OutData%MGdensity) - ALLOCATE(OutData%MGdensity(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MGdensity.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%MGdensity,1), UBOUND(OutData%MGdensity,1) - OutData%MGdensity(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! dRdl_mg not allocated - Int_Xferred = Int_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%dRdl_mg)) DEALLOCATE(OutData%dRdl_mg) - ALLOCATE(OutData%dRdl_mg(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%dRdl_mg.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%dRdl_mg,1), UBOUND(OutData%dRdl_mg,1) - OutData%dRdl_mg(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! dRdl_in not allocated - Int_Xferred = Int_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%dRdl_in)) DEALLOCATE(OutData%dRdl_in) - ALLOCATE(OutData%dRdl_in(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%dRdl_in.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%dRdl_in,1), UBOUND(OutData%dRdl_in,1) - OutData%dRdl_in(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%Vinner = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Vouter = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Vballast = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Vsubmerged = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%l_fill = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%h_fill = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%z_overfill = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%h_floor = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%i_floor = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%doEndBuoyancy = TRANSFER(IntKiBuf(Int_Xferred), OutData%doEndBuoyancy) - Int_Xferred = Int_Xferred + 1 - OutData%memfloodstatus = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! floodstatus not allocated - Int_Xferred = Int_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%floodstatus)) DEALLOCATE(OutData%floodstatus) - ALLOCATE(OutData%floodstatus(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%floodstatus.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%floodstatus,1), UBOUND(OutData%floodstatus,1) - OutData%floodstatus(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! alpha not allocated - Int_Xferred = Int_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%alpha)) DEALLOCATE(OutData%alpha) - ALLOCATE(OutData%alpha(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%alpha.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%alpha,1), UBOUND(OutData%alpha,1) - OutData%alpha(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! alpha_fb not allocated - Int_Xferred = Int_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%alpha_fb)) DEALLOCATE(OutData%alpha_fb) - ALLOCATE(OutData%alpha_fb(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%alpha_fb.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%alpha_fb,1), UBOUND(OutData%alpha_fb,1) - OutData%alpha_fb(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! alpha_fb_star not allocated - Int_Xferred = Int_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%alpha_fb_star)) DEALLOCATE(OutData%alpha_fb_star) - ALLOCATE(OutData%alpha_fb_star(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%alpha_fb_star.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%alpha_fb_star,1), UBOUND(OutData%alpha_fb_star,1) - OutData%alpha_fb_star(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Cd not allocated - Int_Xferred = Int_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%Cd)) DEALLOCATE(OutData%Cd) - ALLOCATE(OutData%Cd(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Cd,1), UBOUND(OutData%Cd,1) - OutData%Cd(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Ca not allocated - Int_Xferred = Int_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%Ca)) DEALLOCATE(OutData%Ca) - ALLOCATE(OutData%Ca(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Ca.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Ca,1), UBOUND(OutData%Ca,1) - OutData%Ca(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Cp not allocated - Int_Xferred = Int_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%Cp)) DEALLOCATE(OutData%Cp) - ALLOCATE(OutData%Cp(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Cp,1), UBOUND(OutData%Cp,1) - OutData%Cp(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AxCd not allocated - Int_Xferred = Int_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%AxCd)) DEALLOCATE(OutData%AxCd) - ALLOCATE(OutData%AxCd(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AxCd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%AxCd,1), UBOUND(OutData%AxCd,1) - OutData%AxCd(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AxCa not allocated - Int_Xferred = Int_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%AxCa)) DEALLOCATE(OutData%AxCa) - ALLOCATE(OutData%AxCa(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AxCa.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%AxCa,1), UBOUND(OutData%AxCa,1) - OutData%AxCa(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AxCp not allocated - Int_Xferred = Int_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%AxCp)) DEALLOCATE(OutData%AxCp) - ALLOCATE(OutData%AxCp(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AxCp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%AxCp,1), UBOUND(OutData%AxCp,1) - OutData%AxCp(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! m_fb_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%m_fb_l)) DEALLOCATE(OutData%m_fb_l) - ALLOCATE(OutData%m_fb_l(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%m_fb_l.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%m_fb_l,1), UBOUND(OutData%m_fb_l,1) - OutData%m_fb_l(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! m_fb_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%m_fb_u)) DEALLOCATE(OutData%m_fb_u) - ALLOCATE(OutData%m_fb_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%m_fb_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%m_fb_u,1), UBOUND(OutData%m_fb_u,1) - OutData%m_fb_u(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! h_cfb_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%h_cfb_l)) DEALLOCATE(OutData%h_cfb_l) - ALLOCATE(OutData%h_cfb_l(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%h_cfb_l.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%h_cfb_l,1), UBOUND(OutData%h_cfb_l,1) - OutData%h_cfb_l(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! h_cfb_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%h_cfb_u)) DEALLOCATE(OutData%h_cfb_u) - ALLOCATE(OutData%h_cfb_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%h_cfb_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%h_cfb_u,1), UBOUND(OutData%h_cfb_u,1) - OutData%h_cfb_u(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! I_lfb_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%I_lfb_l)) DEALLOCATE(OutData%I_lfb_l) - ALLOCATE(OutData%I_lfb_l(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%I_lfb_l.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%I_lfb_l,1), UBOUND(OutData%I_lfb_l,1) - OutData%I_lfb_l(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! I_lfb_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%I_lfb_u)) DEALLOCATE(OutData%I_lfb_u) - ALLOCATE(OutData%I_lfb_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%I_lfb_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%I_lfb_u,1), UBOUND(OutData%I_lfb_u,1) - OutData%I_lfb_u(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! I_rfb_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%I_rfb_l)) DEALLOCATE(OutData%I_rfb_l) - ALLOCATE(OutData%I_rfb_l(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%I_rfb_l.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%I_rfb_l,1), UBOUND(OutData%I_rfb_l,1) - OutData%I_rfb_l(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! I_rfb_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%I_rfb_u)) DEALLOCATE(OutData%I_rfb_u) - ALLOCATE(OutData%I_rfb_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%I_rfb_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%I_rfb_u,1), UBOUND(OutData%I_rfb_u,1) - OutData%I_rfb_u(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! m_mg_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%m_mg_l)) DEALLOCATE(OutData%m_mg_l) - ALLOCATE(OutData%m_mg_l(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%m_mg_l.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%m_mg_l,1), UBOUND(OutData%m_mg_l,1) - OutData%m_mg_l(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! m_mg_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%m_mg_u)) DEALLOCATE(OutData%m_mg_u) - ALLOCATE(OutData%m_mg_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%m_mg_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%m_mg_u,1), UBOUND(OutData%m_mg_u,1) - OutData%m_mg_u(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! h_cmg_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%h_cmg_l)) DEALLOCATE(OutData%h_cmg_l) - ALLOCATE(OutData%h_cmg_l(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%h_cmg_l.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%h_cmg_l,1), UBOUND(OutData%h_cmg_l,1) - OutData%h_cmg_l(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! h_cmg_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%h_cmg_u)) DEALLOCATE(OutData%h_cmg_u) - ALLOCATE(OutData%h_cmg_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%h_cmg_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%h_cmg_u,1), UBOUND(OutData%h_cmg_u,1) - OutData%h_cmg_u(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! I_lmg_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%I_lmg_l)) DEALLOCATE(OutData%I_lmg_l) - ALLOCATE(OutData%I_lmg_l(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%I_lmg_l.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%I_lmg_l,1), UBOUND(OutData%I_lmg_l,1) - OutData%I_lmg_l(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! I_lmg_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%I_lmg_u)) DEALLOCATE(OutData%I_lmg_u) - ALLOCATE(OutData%I_lmg_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%I_lmg_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%I_lmg_u,1), UBOUND(OutData%I_lmg_u,1) - OutData%I_lmg_u(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! I_rmg_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%I_rmg_l)) DEALLOCATE(OutData%I_rmg_l) - ALLOCATE(OutData%I_rmg_l(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%I_rmg_l.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%I_rmg_l,1), UBOUND(OutData%I_rmg_l,1) - OutData%I_rmg_l(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! I_rmg_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%I_rmg_u)) DEALLOCATE(OutData%I_rmg_u) - ALLOCATE(OutData%I_rmg_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%I_rmg_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%I_rmg_u,1), UBOUND(OutData%I_rmg_u,1) - OutData%I_rmg_u(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Cfl_fb not allocated - Int_Xferred = Int_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%Cfl_fb)) DEALLOCATE(OutData%Cfl_fb) - ALLOCATE(OutData%Cfl_fb(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cfl_fb.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Cfl_fb,1), UBOUND(OutData%Cfl_fb,1) - OutData%Cfl_fb(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Cfr_fb not allocated - Int_Xferred = Int_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%Cfr_fb)) DEALLOCATE(OutData%Cfr_fb) - ALLOCATE(OutData%Cfr_fb(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cfr_fb.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Cfr_fb,1), UBOUND(OutData%Cfr_fb,1) - OutData%Cfr_fb(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CM0_fb not allocated - Int_Xferred = Int_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%CM0_fb)) DEALLOCATE(OutData%CM0_fb) - ALLOCATE(OutData%CM0_fb(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CM0_fb.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%CM0_fb,1), UBOUND(OutData%CM0_fb,1) - OutData%CM0_fb(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%MGvolume = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MDivSize = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MCoefMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%MmbrCoefIDIndx = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%MmbrFilledIDIndx = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%FillFSLoc = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%FillDens = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PropPot = TRANSFER(IntKiBuf(Int_Xferred), OutData%PropPot) - Int_Xferred = Int_Xferred + 1 - OutData%Flipped = TRANSFER(IntKiBuf(Int_Xferred), OutData%Flipped) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Morison_UnPackMemberType - - SUBROUTINE Morison_CopyMemberLoads( SrcMemberLoadsData, DstMemberLoadsData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Morison_MemberLoads), INTENT(IN) :: SrcMemberLoadsData - TYPE(Morison_MemberLoads), INTENT(INOUT) :: DstMemberLoadsData - 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 = 'Morison_CopyMemberLoads' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcMemberLoadsData%F_D)) THEN - i1_l = LBOUND(SrcMemberLoadsData%F_D,1) - i1_u = UBOUND(SrcMemberLoadsData%F_D,1) - i2_l = LBOUND(SrcMemberLoadsData%F_D,2) - i2_u = UBOUND(SrcMemberLoadsData%F_D,2) - IF (.NOT. ALLOCATED(DstMemberLoadsData%F_D)) THEN - ALLOCATE(DstMemberLoadsData%F_D(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberLoadsData%F_D.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberLoadsData%F_D = SrcMemberLoadsData%F_D -ENDIF -IF (ALLOCATED(SrcMemberLoadsData%F_I)) THEN - i1_l = LBOUND(SrcMemberLoadsData%F_I,1) - i1_u = UBOUND(SrcMemberLoadsData%F_I,1) - i2_l = LBOUND(SrcMemberLoadsData%F_I,2) - i2_u = UBOUND(SrcMemberLoadsData%F_I,2) - IF (.NOT. ALLOCATED(DstMemberLoadsData%F_I)) THEN - ALLOCATE(DstMemberLoadsData%F_I(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberLoadsData%F_I.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberLoadsData%F_I = SrcMemberLoadsData%F_I -ENDIF -IF (ALLOCATED(SrcMemberLoadsData%F_A)) THEN - i1_l = LBOUND(SrcMemberLoadsData%F_A,1) - i1_u = UBOUND(SrcMemberLoadsData%F_A,1) - i2_l = LBOUND(SrcMemberLoadsData%F_A,2) - i2_u = UBOUND(SrcMemberLoadsData%F_A,2) - IF (.NOT. ALLOCATED(DstMemberLoadsData%F_A)) THEN - ALLOCATE(DstMemberLoadsData%F_A(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberLoadsData%F_A.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberLoadsData%F_A = SrcMemberLoadsData%F_A -ENDIF -IF (ALLOCATED(SrcMemberLoadsData%F_B)) THEN - i1_l = LBOUND(SrcMemberLoadsData%F_B,1) - i1_u = UBOUND(SrcMemberLoadsData%F_B,1) - i2_l = LBOUND(SrcMemberLoadsData%F_B,2) - i2_u = UBOUND(SrcMemberLoadsData%F_B,2) - IF (.NOT. ALLOCATED(DstMemberLoadsData%F_B)) THEN - ALLOCATE(DstMemberLoadsData%F_B(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberLoadsData%F_B.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberLoadsData%F_B = SrcMemberLoadsData%F_B -ENDIF -IF (ALLOCATED(SrcMemberLoadsData%F_BF)) THEN - i1_l = LBOUND(SrcMemberLoadsData%F_BF,1) - i1_u = UBOUND(SrcMemberLoadsData%F_BF,1) - i2_l = LBOUND(SrcMemberLoadsData%F_BF,2) - i2_u = UBOUND(SrcMemberLoadsData%F_BF,2) - IF (.NOT. ALLOCATED(DstMemberLoadsData%F_BF)) THEN - ALLOCATE(DstMemberLoadsData%F_BF(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberLoadsData%F_BF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberLoadsData%F_BF = SrcMemberLoadsData%F_BF -ENDIF -IF (ALLOCATED(SrcMemberLoadsData%F_If)) THEN - i1_l = LBOUND(SrcMemberLoadsData%F_If,1) - i1_u = UBOUND(SrcMemberLoadsData%F_If,1) - i2_l = LBOUND(SrcMemberLoadsData%F_If,2) - i2_u = UBOUND(SrcMemberLoadsData%F_If,2) - IF (.NOT. ALLOCATED(DstMemberLoadsData%F_If)) THEN - ALLOCATE(DstMemberLoadsData%F_If(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberLoadsData%F_If.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberLoadsData%F_If = SrcMemberLoadsData%F_If -ENDIF -IF (ALLOCATED(SrcMemberLoadsData%F_WMG)) THEN - i1_l = LBOUND(SrcMemberLoadsData%F_WMG,1) - i1_u = UBOUND(SrcMemberLoadsData%F_WMG,1) - i2_l = LBOUND(SrcMemberLoadsData%F_WMG,2) - i2_u = UBOUND(SrcMemberLoadsData%F_WMG,2) - IF (.NOT. ALLOCATED(DstMemberLoadsData%F_WMG)) THEN - ALLOCATE(DstMemberLoadsData%F_WMG(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberLoadsData%F_WMG.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberLoadsData%F_WMG = SrcMemberLoadsData%F_WMG -ENDIF -IF (ALLOCATED(SrcMemberLoadsData%F_IMG)) THEN - i1_l = LBOUND(SrcMemberLoadsData%F_IMG,1) - i1_u = UBOUND(SrcMemberLoadsData%F_IMG,1) - i2_l = LBOUND(SrcMemberLoadsData%F_IMG,2) - i2_u = UBOUND(SrcMemberLoadsData%F_IMG,2) - IF (.NOT. ALLOCATED(DstMemberLoadsData%F_IMG)) THEN - ALLOCATE(DstMemberLoadsData%F_IMG(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberLoadsData%F_IMG.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberLoadsData%F_IMG = SrcMemberLoadsData%F_IMG -ENDIF -IF (ALLOCATED(SrcMemberLoadsData%FV)) THEN - i1_l = LBOUND(SrcMemberLoadsData%FV,1) - i1_u = UBOUND(SrcMemberLoadsData%FV,1) - i2_l = LBOUND(SrcMemberLoadsData%FV,2) - i2_u = UBOUND(SrcMemberLoadsData%FV,2) - IF (.NOT. ALLOCATED(DstMemberLoadsData%FV)) THEN - ALLOCATE(DstMemberLoadsData%FV(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberLoadsData%FV.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberLoadsData%FV = SrcMemberLoadsData%FV -ENDIF -IF (ALLOCATED(SrcMemberLoadsData%FA)) THEN - i1_l = LBOUND(SrcMemberLoadsData%FA,1) - i1_u = UBOUND(SrcMemberLoadsData%FA,1) - i2_l = LBOUND(SrcMemberLoadsData%FA,2) - i2_u = UBOUND(SrcMemberLoadsData%FA,2) - IF (.NOT. ALLOCATED(DstMemberLoadsData%FA)) THEN - ALLOCATE(DstMemberLoadsData%FA(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberLoadsData%FA.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberLoadsData%FA = SrcMemberLoadsData%FA -ENDIF -IF (ALLOCATED(SrcMemberLoadsData%F_DP)) THEN - i1_l = LBOUND(SrcMemberLoadsData%F_DP,1) - i1_u = UBOUND(SrcMemberLoadsData%F_DP,1) - i2_l = LBOUND(SrcMemberLoadsData%F_DP,2) - i2_u = UBOUND(SrcMemberLoadsData%F_DP,2) - IF (.NOT. ALLOCATED(DstMemberLoadsData%F_DP)) THEN - ALLOCATE(DstMemberLoadsData%F_DP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberLoadsData%F_DP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberLoadsData%F_DP = SrcMemberLoadsData%F_DP -ENDIF - END SUBROUTINE Morison_CopyMemberLoads - - SUBROUTINE Morison_DestroyMemberLoads( MemberLoadsData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(Morison_MemberLoads), INTENT(INOUT) :: MemberLoadsData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_DestroyMemberLoads' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(MemberLoadsData%F_D)) THEN - DEALLOCATE(MemberLoadsData%F_D) -ENDIF -IF (ALLOCATED(MemberLoadsData%F_I)) THEN - DEALLOCATE(MemberLoadsData%F_I) -ENDIF -IF (ALLOCATED(MemberLoadsData%F_A)) THEN - DEALLOCATE(MemberLoadsData%F_A) -ENDIF -IF (ALLOCATED(MemberLoadsData%F_B)) THEN - DEALLOCATE(MemberLoadsData%F_B) -ENDIF -IF (ALLOCATED(MemberLoadsData%F_BF)) THEN - DEALLOCATE(MemberLoadsData%F_BF) -ENDIF -IF (ALLOCATED(MemberLoadsData%F_If)) THEN - DEALLOCATE(MemberLoadsData%F_If) -ENDIF -IF (ALLOCATED(MemberLoadsData%F_WMG)) THEN - DEALLOCATE(MemberLoadsData%F_WMG) -ENDIF -IF (ALLOCATED(MemberLoadsData%F_IMG)) THEN - DEALLOCATE(MemberLoadsData%F_IMG) -ENDIF -IF (ALLOCATED(MemberLoadsData%FV)) THEN - DEALLOCATE(MemberLoadsData%FV) -ENDIF -IF (ALLOCATED(MemberLoadsData%FA)) THEN - DEALLOCATE(MemberLoadsData%FA) -ENDIF -IF (ALLOCATED(MemberLoadsData%F_DP)) THEN - DEALLOCATE(MemberLoadsData%F_DP) -ENDIF - END SUBROUTINE Morison_DestroyMemberLoads - - SUBROUTINE Morison_PackMemberLoads( 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(Morison_MemberLoads), 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 = 'Morison_PackMemberLoads' - ! 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_D allocated yes/no - IF ( ALLOCATED(InData%F_D) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! F_D upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_D) ! F_D - END IF - Int_BufSz = Int_BufSz + 1 ! F_I allocated yes/no - IF ( ALLOCATED(InData%F_I) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! F_I upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_I) ! F_I - END IF - Int_BufSz = Int_BufSz + 1 ! F_A allocated yes/no - IF ( ALLOCATED(InData%F_A) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! F_A upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_A) ! F_A - END IF - Int_BufSz = Int_BufSz + 1 ! F_B allocated yes/no - IF ( ALLOCATED(InData%F_B) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! F_B upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_B) ! F_B - END IF - Int_BufSz = Int_BufSz + 1 ! F_BF allocated yes/no - IF ( ALLOCATED(InData%F_BF) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! F_BF upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_BF) ! F_BF - END IF - Int_BufSz = Int_BufSz + 1 ! F_If allocated yes/no - IF ( ALLOCATED(InData%F_If) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! F_If upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_If) ! F_If - END IF - Int_BufSz = Int_BufSz + 1 ! F_WMG allocated yes/no - IF ( ALLOCATED(InData%F_WMG) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! F_WMG upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_WMG) ! F_WMG - END IF - Int_BufSz = Int_BufSz + 1 ! F_IMG allocated yes/no - IF ( ALLOCATED(InData%F_IMG) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! F_IMG upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_IMG) ! F_IMG - END IF - Int_BufSz = Int_BufSz + 1 ! FV allocated yes/no - IF ( ALLOCATED(InData%FV) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! FV upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%FV) ! FV - END IF - Int_BufSz = Int_BufSz + 1 ! FA allocated yes/no - IF ( ALLOCATED(InData%FA) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! FA upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%FA) ! FA - END IF - Int_BufSz = Int_BufSz + 1 ! F_DP allocated yes/no - IF ( ALLOCATED(InData%F_DP) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! F_DP upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_DP) ! F_DP - 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%F_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%F_D,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_D,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_D,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_D,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%F_D,2), UBOUND(InData%F_D,2) - DO i1 = LBOUND(InData%F_D,1), UBOUND(InData%F_D,1) - ReKiBuf(Re_Xferred) = InData%F_D(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%F_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%F_I,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_I,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_I,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_I,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%F_I,2), UBOUND(InData%F_I,2) - DO i1 = LBOUND(InData%F_I,1), UBOUND(InData%F_I,1) - ReKiBuf(Re_Xferred) = InData%F_I(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%F_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%F_A,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_A,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_A,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_A,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%F_A,2), UBOUND(InData%F_A,2) - DO i1 = LBOUND(InData%F_A,1), UBOUND(InData%F_A,1) - ReKiBuf(Re_Xferred) = InData%F_A(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%F_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%F_B,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_B,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_B,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_B,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%F_B,2), UBOUND(InData%F_B,2) - DO i1 = LBOUND(InData%F_B,1), UBOUND(InData%F_B,1) - ReKiBuf(Re_Xferred) = InData%F_B(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%F_BF) ) THEN - 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_BF,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_BF,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_BF,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_BF,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%F_BF,2), UBOUND(InData%F_BF,2) - DO i1 = LBOUND(InData%F_BF,1), UBOUND(InData%F_BF,1) - ReKiBuf(Re_Xferred) = InData%F_BF(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%F_If) ) THEN - 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_If,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_If,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_If,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_If,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%F_If,2), UBOUND(InData%F_If,2) - DO i1 = LBOUND(InData%F_If,1), UBOUND(InData%F_If,1) - ReKiBuf(Re_Xferred) = InData%F_If(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%F_WMG) ) THEN - 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_WMG,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_WMG,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_WMG,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_WMG,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%F_WMG,2), UBOUND(InData%F_WMG,2) - DO i1 = LBOUND(InData%F_WMG,1), UBOUND(InData%F_WMG,1) - ReKiBuf(Re_Xferred) = InData%F_WMG(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%F_IMG) ) THEN - 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_IMG,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_IMG,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_IMG,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_IMG,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%F_IMG,2), UBOUND(InData%F_IMG,2) - DO i1 = LBOUND(InData%F_IMG,1), UBOUND(InData%F_IMG,1) - ReKiBuf(Re_Xferred) = InData%F_IMG(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%FV) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FV,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FV,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FV,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FV,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%FV,2), UBOUND(InData%FV,2) - DO i1 = LBOUND(InData%FV,1), UBOUND(InData%FV,1) - ReKiBuf(Re_Xferred) = InData%FV(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%FA) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FA,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FA,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FA,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FA,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%FA,2), UBOUND(InData%FA,2) - DO i1 = LBOUND(InData%FA,1), UBOUND(InData%FA,1) - ReKiBuf(Re_Xferred) = InData%FA(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%F_DP) ) THEN - 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_DP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_DP,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_DP,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_DP,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%F_DP,2), UBOUND(InData%F_DP,2) - DO i1 = LBOUND(InData%F_DP,1), UBOUND(InData%F_DP,1) - ReKiBuf(Re_Xferred) = InData%F_DP(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE Morison_PackMemberLoads - - SUBROUTINE Morison_UnPackMemberLoads( 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(Morison_MemberLoads), 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 = 'Morison_UnPackMemberLoads' - ! 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_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 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%F_D)) DEALLOCATE(OutData%F_D) - ALLOCATE(OutData%F_D(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_D.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%F_D,2), UBOUND(OutData%F_D,2) - DO i1 = LBOUND(OutData%F_D,1), UBOUND(OutData%F_D,1) - OutData%F_D(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_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%F_I)) DEALLOCATE(OutData%F_I) - ALLOCATE(OutData%F_I(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_I.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%F_I,2), UBOUND(OutData%F_I,2) - DO i1 = LBOUND(OutData%F_I,1), UBOUND(OutData%F_I,1) - OutData%F_I(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_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 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%F_A)) DEALLOCATE(OutData%F_A) - ALLOCATE(OutData%F_A(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_A.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%F_A,2), UBOUND(OutData%F_A,2) - DO i1 = LBOUND(OutData%F_A,1), UBOUND(OutData%F_A,1) - OutData%F_A(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_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 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%F_B)) DEALLOCATE(OutData%F_B) - ALLOCATE(OutData%F_B(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_B.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%F_B,2), UBOUND(OutData%F_B,2) - DO i1 = LBOUND(OutData%F_B,1), UBOUND(OutData%F_B,1) - OutData%F_B(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_BF not allocated - Int_Xferred = Int_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_BF)) DEALLOCATE(OutData%F_BF) - ALLOCATE(OutData%F_BF(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_BF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%F_BF,2), UBOUND(OutData%F_BF,2) - DO i1 = LBOUND(OutData%F_BF,1), UBOUND(OutData%F_BF,1) - OutData%F_BF(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_If not allocated - Int_Xferred = Int_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_If)) DEALLOCATE(OutData%F_If) - ALLOCATE(OutData%F_If(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_If.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%F_If,2), UBOUND(OutData%F_If,2) - DO i1 = LBOUND(OutData%F_If,1), UBOUND(OutData%F_If,1) - OutData%F_If(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_WMG not allocated - Int_Xferred = Int_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_WMG)) DEALLOCATE(OutData%F_WMG) - ALLOCATE(OutData%F_WMG(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_WMG.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%F_WMG,2), UBOUND(OutData%F_WMG,2) - DO i1 = LBOUND(OutData%F_WMG,1), UBOUND(OutData%F_WMG,1) - OutData%F_WMG(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_IMG not allocated - Int_Xferred = Int_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_IMG)) DEALLOCATE(OutData%F_IMG) - ALLOCATE(OutData%F_IMG(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_IMG.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%F_IMG,2), UBOUND(OutData%F_IMG,2) - DO i1 = LBOUND(OutData%F_IMG,1), UBOUND(OutData%F_IMG,1) - OutData%F_IMG(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FV not allocated - Int_Xferred = Int_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%FV)) DEALLOCATE(OutData%FV) - ALLOCATE(OutData%FV(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FV.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%FV,2), UBOUND(OutData%FV,2) - DO i1 = LBOUND(OutData%FV,1), UBOUND(OutData%FV,1) - OutData%FV(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FA not allocated - Int_Xferred = Int_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%FA)) DEALLOCATE(OutData%FA) - ALLOCATE(OutData%FA(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FA.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%FA,2), UBOUND(OutData%FA,2) - DO i1 = LBOUND(OutData%FA,1), UBOUND(OutData%FA,1) - OutData%FA(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_DP not allocated - Int_Xferred = Int_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_DP)) DEALLOCATE(OutData%F_DP) - ALLOCATE(OutData%F_DP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_DP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%F_DP,2), UBOUND(OutData%F_DP,2) - DO i1 = LBOUND(OutData%F_DP,1), UBOUND(OutData%F_DP,1) - OutData%F_DP(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE Morison_UnPackMemberLoads - - SUBROUTINE Morison_CopyCoefMembers( SrcCoefMembersData, DstCoefMembersData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Morison_CoefMembers), INTENT(IN) :: SrcCoefMembersData - TYPE(Morison_CoefMembers), INTENT(INOUT) :: DstCoefMembersData - 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 = 'Morison_CopyCoefMembers' -! - ErrStat = ErrID_None - ErrMsg = "" - DstCoefMembersData%MemberID = SrcCoefMembersData%MemberID - DstCoefMembersData%MemberCd1 = SrcCoefMembersData%MemberCd1 - DstCoefMembersData%MemberCd2 = SrcCoefMembersData%MemberCd2 - DstCoefMembersData%MemberCdMG1 = SrcCoefMembersData%MemberCdMG1 - DstCoefMembersData%MemberCdMG2 = SrcCoefMembersData%MemberCdMG2 - DstCoefMembersData%MemberCa1 = SrcCoefMembersData%MemberCa1 - DstCoefMembersData%MemberCa2 = SrcCoefMembersData%MemberCa2 - DstCoefMembersData%MemberCaMG1 = SrcCoefMembersData%MemberCaMG1 - DstCoefMembersData%MemberCaMG2 = SrcCoefMembersData%MemberCaMG2 - DstCoefMembersData%MemberCp1 = SrcCoefMembersData%MemberCp1 - DstCoefMembersData%MemberCp2 = SrcCoefMembersData%MemberCp2 - DstCoefMembersData%MemberCpMG1 = SrcCoefMembersData%MemberCpMG1 - DstCoefMembersData%MemberCpMG2 = SrcCoefMembersData%MemberCpMG2 - DstCoefMembersData%MemberAxCd1 = SrcCoefMembersData%MemberAxCd1 - DstCoefMembersData%MemberAxCd2 = SrcCoefMembersData%MemberAxCd2 - DstCoefMembersData%MemberAxCdMG1 = SrcCoefMembersData%MemberAxCdMG1 - DstCoefMembersData%MemberAxCdMG2 = SrcCoefMembersData%MemberAxCdMG2 - DstCoefMembersData%MemberAxCa1 = SrcCoefMembersData%MemberAxCa1 - DstCoefMembersData%MemberAxCa2 = SrcCoefMembersData%MemberAxCa2 - DstCoefMembersData%MemberAxCaMG1 = SrcCoefMembersData%MemberAxCaMG1 - DstCoefMembersData%MemberAxCaMG2 = SrcCoefMembersData%MemberAxCaMG2 - DstCoefMembersData%MemberAxCp1 = SrcCoefMembersData%MemberAxCp1 - DstCoefMembersData%MemberAxCp2 = SrcCoefMembersData%MemberAxCp2 - DstCoefMembersData%MemberAxCpMG1 = SrcCoefMembersData%MemberAxCpMG1 - DstCoefMembersData%MemberAxCpMG2 = SrcCoefMembersData%MemberAxCpMG2 - END SUBROUTINE Morison_CopyCoefMembers - - SUBROUTINE Morison_DestroyCoefMembers( CoefMembersData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(Morison_CoefMembers), INTENT(INOUT) :: CoefMembersData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_DestroyCoefMembers' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE Morison_DestroyCoefMembers - - SUBROUTINE Morison_PackCoefMembers( 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(Morison_CoefMembers), 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 = 'Morison_PackCoefMembers' - ! 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 - Re_BufSz = Re_BufSz + 1 ! MemberCd1 - Re_BufSz = Re_BufSz + 1 ! MemberCd2 - Re_BufSz = Re_BufSz + 1 ! MemberCdMG1 - Re_BufSz = Re_BufSz + 1 ! MemberCdMG2 - Re_BufSz = Re_BufSz + 1 ! MemberCa1 - Re_BufSz = Re_BufSz + 1 ! MemberCa2 - Re_BufSz = Re_BufSz + 1 ! MemberCaMG1 - Re_BufSz = Re_BufSz + 1 ! MemberCaMG2 - Re_BufSz = Re_BufSz + 1 ! MemberCp1 - Re_BufSz = Re_BufSz + 1 ! MemberCp2 - Re_BufSz = Re_BufSz + 1 ! MemberCpMG1 - Re_BufSz = Re_BufSz + 1 ! MemberCpMG2 - Re_BufSz = Re_BufSz + 1 ! MemberAxCd1 - Re_BufSz = Re_BufSz + 1 ! MemberAxCd2 - Re_BufSz = Re_BufSz + 1 ! MemberAxCdMG1 - Re_BufSz = Re_BufSz + 1 ! MemberAxCdMG2 - Re_BufSz = Re_BufSz + 1 ! MemberAxCa1 - Re_BufSz = Re_BufSz + 1 ! MemberAxCa2 - Re_BufSz = Re_BufSz + 1 ! MemberAxCaMG1 - Re_BufSz = Re_BufSz + 1 ! MemberAxCaMG2 - Re_BufSz = Re_BufSz + 1 ! MemberAxCp1 - Re_BufSz = Re_BufSz + 1 ! MemberAxCp2 - Re_BufSz = Re_BufSz + 1 ! MemberAxCpMG1 - Re_BufSz = Re_BufSz + 1 ! MemberAxCpMG2 - 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 - ReKiBuf(Re_Xferred) = InData%MemberCd1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MemberCd2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MemberCdMG1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MemberCdMG2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MemberCa1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MemberCa2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MemberCaMG1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MemberCaMG2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MemberCp1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MemberCp2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MemberCpMG1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MemberCpMG2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MemberAxCd1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MemberAxCd2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MemberAxCdMG1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MemberAxCdMG2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MemberAxCa1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MemberAxCa2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MemberAxCaMG1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MemberAxCaMG2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MemberAxCp1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MemberAxCp2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MemberAxCpMG1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MemberAxCpMG2 - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Morison_PackCoefMembers - - SUBROUTINE Morison_UnPackCoefMembers( 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(Morison_CoefMembers), 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 = 'Morison_UnPackCoefMembers' - ! 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%MemberCd1 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MemberCd2 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MemberCdMG1 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MemberCdMG2 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MemberCa1 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MemberCa2 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MemberCaMG1 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MemberCaMG2 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MemberCp1 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MemberCp2 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MemberCpMG1 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MemberCpMG2 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MemberAxCd1 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MemberAxCd2 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MemberAxCdMG1 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MemberAxCdMG2 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MemberAxCa1 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MemberAxCa2 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MemberAxCaMG1 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MemberAxCaMG2 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MemberAxCp1 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MemberAxCp2 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MemberAxCpMG1 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MemberAxCpMG2 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Morison_UnPackCoefMembers - - SUBROUTINE Morison_CopyMGDepthsType( SrcMGDepthsTypeData, DstMGDepthsTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Morison_MGDepthsType), INTENT(IN) :: SrcMGDepthsTypeData - TYPE(Morison_MGDepthsType), INTENT(INOUT) :: DstMGDepthsTypeData - 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 = 'Morison_CopyMGDepthsType' -! - ErrStat = ErrID_None - ErrMsg = "" - DstMGDepthsTypeData%MGDpth = SrcMGDepthsTypeData%MGDpth - DstMGDepthsTypeData%MGThck = SrcMGDepthsTypeData%MGThck - DstMGDepthsTypeData%MGDens = SrcMGDepthsTypeData%MGDens - END SUBROUTINE Morison_CopyMGDepthsType - - SUBROUTINE Morison_DestroyMGDepthsType( MGDepthsTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(Morison_MGDepthsType), INTENT(INOUT) :: MGDepthsTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_DestroyMGDepthsType' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE Morison_DestroyMGDepthsType - - SUBROUTINE Morison_PackMGDepthsType( 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(Morison_MGDepthsType), 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 = 'Morison_PackMGDepthsType' - ! 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 ! MGDpth - Re_BufSz = Re_BufSz + 1 ! MGThck - Re_BufSz = Re_BufSz + 1 ! MGDens - 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%MGDpth - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MGThck - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MGDens - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Morison_PackMGDepthsType - - SUBROUTINE Morison_UnPackMGDepthsType( 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(Morison_MGDepthsType), 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 = 'Morison_UnPackMGDepthsType' - ! 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%MGDpth = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MGThck = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MGDens = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Morison_UnPackMGDepthsType - - SUBROUTINE Morison_CopyMOutput( SrcMOutputData, DstMOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Morison_MOutput), INTENT(IN) :: SrcMOutputData - TYPE(Morison_MOutput), INTENT(INOUT) :: DstMOutputData - 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 = 'Morison_CopyMOutput' -! - ErrStat = ErrID_None - ErrMsg = "" - DstMOutputData%MemberID = SrcMOutputData%MemberID - DstMOutputData%NOutLoc = SrcMOutputData%NOutLoc -IF (ALLOCATED(SrcMOutputData%NodeLocs)) THEN - i1_l = LBOUND(SrcMOutputData%NodeLocs,1) - i1_u = UBOUND(SrcMOutputData%NodeLocs,1) - IF (.NOT. ALLOCATED(DstMOutputData%NodeLocs)) THEN - ALLOCATE(DstMOutputData%NodeLocs(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMOutputData%NodeLocs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMOutputData%NodeLocs = SrcMOutputData%NodeLocs -ENDIF - DstMOutputData%MemberIDIndx = SrcMOutputData%MemberIDIndx -IF (ALLOCATED(SrcMOutputData%MeshIndx1)) THEN - i1_l = LBOUND(SrcMOutputData%MeshIndx1,1) - i1_u = UBOUND(SrcMOutputData%MeshIndx1,1) - IF (.NOT. ALLOCATED(DstMOutputData%MeshIndx1)) THEN - ALLOCATE(DstMOutputData%MeshIndx1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMOutputData%MeshIndx1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMOutputData%MeshIndx1 = SrcMOutputData%MeshIndx1 -ENDIF -IF (ALLOCATED(SrcMOutputData%MeshIndx2)) THEN - i1_l = LBOUND(SrcMOutputData%MeshIndx2,1) - i1_u = UBOUND(SrcMOutputData%MeshIndx2,1) - IF (.NOT. ALLOCATED(DstMOutputData%MeshIndx2)) THEN - ALLOCATE(DstMOutputData%MeshIndx2(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMOutputData%MeshIndx2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMOutputData%MeshIndx2 = SrcMOutputData%MeshIndx2 -ENDIF -IF (ALLOCATED(SrcMOutputData%MemberIndx1)) THEN - i1_l = LBOUND(SrcMOutputData%MemberIndx1,1) - i1_u = UBOUND(SrcMOutputData%MemberIndx1,1) - IF (.NOT. ALLOCATED(DstMOutputData%MemberIndx1)) THEN - ALLOCATE(DstMOutputData%MemberIndx1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMOutputData%MemberIndx1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMOutputData%MemberIndx1 = SrcMOutputData%MemberIndx1 -ENDIF -IF (ALLOCATED(SrcMOutputData%MemberIndx2)) THEN - i1_l = LBOUND(SrcMOutputData%MemberIndx2,1) - i1_u = UBOUND(SrcMOutputData%MemberIndx2,1) - IF (.NOT. ALLOCATED(DstMOutputData%MemberIndx2)) THEN - ALLOCATE(DstMOutputData%MemberIndx2(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMOutputData%MemberIndx2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMOutputData%MemberIndx2 = SrcMOutputData%MemberIndx2 -ENDIF -IF (ALLOCATED(SrcMOutputData%s)) THEN - i1_l = LBOUND(SrcMOutputData%s,1) - i1_u = UBOUND(SrcMOutputData%s,1) - IF (.NOT. ALLOCATED(DstMOutputData%s)) THEN - ALLOCATE(DstMOutputData%s(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMOutputData%s.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMOutputData%s = SrcMOutputData%s -ENDIF - END SUBROUTINE Morison_CopyMOutput - - SUBROUTINE Morison_DestroyMOutput( MOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(Morison_MOutput), INTENT(INOUT) :: MOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_DestroyMOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(MOutputData%NodeLocs)) THEN - DEALLOCATE(MOutputData%NodeLocs) -ENDIF -IF (ALLOCATED(MOutputData%MeshIndx1)) THEN - DEALLOCATE(MOutputData%MeshIndx1) -ENDIF -IF (ALLOCATED(MOutputData%MeshIndx2)) THEN - DEALLOCATE(MOutputData%MeshIndx2) -ENDIF -IF (ALLOCATED(MOutputData%MemberIndx1)) THEN - DEALLOCATE(MOutputData%MemberIndx1) -ENDIF -IF (ALLOCATED(MOutputData%MemberIndx2)) THEN - DEALLOCATE(MOutputData%MemberIndx2) -ENDIF -IF (ALLOCATED(MOutputData%s)) THEN - DEALLOCATE(MOutputData%s) -ENDIF - END SUBROUTINE Morison_DestroyMOutput - - SUBROUTINE Morison_PackMOutput( 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(Morison_MOutput), 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 = 'Morison_PackMOutput' - ! 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 ! NOutLoc - Int_BufSz = Int_BufSz + 1 ! NodeLocs allocated yes/no - IF ( ALLOCATED(InData%NodeLocs) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! NodeLocs upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%NodeLocs) ! NodeLocs - END IF - Int_BufSz = Int_BufSz + 1 ! MemberIDIndx - Int_BufSz = Int_BufSz + 1 ! MeshIndx1 allocated yes/no - IF ( ALLOCATED(InData%MeshIndx1) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! MeshIndx1 upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%MeshIndx1) ! MeshIndx1 - END IF - Int_BufSz = Int_BufSz + 1 ! MeshIndx2 allocated yes/no - IF ( ALLOCATED(InData%MeshIndx2) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! MeshIndx2 upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%MeshIndx2) ! MeshIndx2 - END IF - Int_BufSz = Int_BufSz + 1 ! MemberIndx1 allocated yes/no - IF ( ALLOCATED(InData%MemberIndx1) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! MemberIndx1 upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%MemberIndx1) ! MemberIndx1 - END IF - Int_BufSz = Int_BufSz + 1 ! MemberIndx2 allocated yes/no - IF ( ALLOCATED(InData%MemberIndx2) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! MemberIndx2 upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%MemberIndx2) ! MemberIndx2 - END IF - Int_BufSz = Int_BufSz + 1 ! s allocated yes/no - IF ( ALLOCATED(InData%s) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! s upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%s) ! s - 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%NOutLoc - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%NodeLocs) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%NodeLocs,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NodeLocs,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%NodeLocs,1), UBOUND(InData%NodeLocs,1) - ReKiBuf(Re_Xferred) = InData%NodeLocs(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%MemberIDIndx - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%MeshIndx1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MeshIndx1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MeshIndx1,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%MeshIndx1,1), UBOUND(InData%MeshIndx1,1) - IntKiBuf(Int_Xferred) = InData%MeshIndx1(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%MeshIndx2) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MeshIndx2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MeshIndx2,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%MeshIndx2,1), UBOUND(InData%MeshIndx2,1) - IntKiBuf(Int_Xferred) = InData%MeshIndx2(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%MemberIndx1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MemberIndx1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MemberIndx1,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%MemberIndx1,1), UBOUND(InData%MemberIndx1,1) - IntKiBuf(Int_Xferred) = InData%MemberIndx1(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%MemberIndx2) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MemberIndx2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MemberIndx2,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%MemberIndx2,1), UBOUND(InData%MemberIndx2,1) - IntKiBuf(Int_Xferred) = InData%MemberIndx2(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%s) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%s,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%s,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%s,1), UBOUND(InData%s,1) - ReKiBuf(Re_Xferred) = InData%s(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE Morison_PackMOutput - - SUBROUTINE Morison_UnPackMOutput( 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(Morison_MOutput), 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 = 'Morison_UnPackMOutput' - ! 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%NOutLoc = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NodeLocs not allocated - Int_Xferred = Int_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%NodeLocs)) DEALLOCATE(OutData%NodeLocs) - ALLOCATE(OutData%NodeLocs(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NodeLocs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%NodeLocs,1), UBOUND(OutData%NodeLocs,1) - OutData%NodeLocs(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%MemberIDIndx = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MeshIndx1 not allocated - Int_Xferred = Int_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%MeshIndx1)) DEALLOCATE(OutData%MeshIndx1) - ALLOCATE(OutData%MeshIndx1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MeshIndx1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%MeshIndx1,1), UBOUND(OutData%MeshIndx1,1) - OutData%MeshIndx1(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MeshIndx2 not allocated - Int_Xferred = Int_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%MeshIndx2)) DEALLOCATE(OutData%MeshIndx2) - ALLOCATE(OutData%MeshIndx2(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MeshIndx2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%MeshIndx2,1), UBOUND(OutData%MeshIndx2,1) - OutData%MeshIndx2(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MemberIndx1 not allocated - Int_Xferred = Int_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%MemberIndx1)) DEALLOCATE(OutData%MemberIndx1) - ALLOCATE(OutData%MemberIndx1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MemberIndx1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%MemberIndx1,1), UBOUND(OutData%MemberIndx1,1) - OutData%MemberIndx1(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MemberIndx2 not allocated - Int_Xferred = Int_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%MemberIndx2)) DEALLOCATE(OutData%MemberIndx2) - ALLOCATE(OutData%MemberIndx2(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MemberIndx2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%MemberIndx2,1), UBOUND(OutData%MemberIndx2,1) - OutData%MemberIndx2(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! s not allocated - Int_Xferred = Int_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%s)) DEALLOCATE(OutData%s) - ALLOCATE(OutData%s(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%s.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%s,1), UBOUND(OutData%s,1) - OutData%s(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE Morison_UnPackMOutput - - SUBROUTINE Morison_CopyJOutput( SrcJOutputData, DstJOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Morison_JOutput), INTENT(IN) :: SrcJOutputData - TYPE(Morison_JOutput), INTENT(INOUT) :: DstJOutputData - 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 = 'Morison_CopyJOutput' -! - ErrStat = ErrID_None - ErrMsg = "" - DstJOutputData%JointID = SrcJOutputData%JointID - DstJOutputData%JointIDIndx = SrcJOutputData%JointIDIndx - END SUBROUTINE Morison_CopyJOutput - - SUBROUTINE Morison_DestroyJOutput( JOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(Morison_JOutput), INTENT(INOUT) :: JOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_DestroyJOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE Morison_DestroyJOutput - - SUBROUTINE Morison_PackJOutput( 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(Morison_JOutput), 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 = 'Morison_PackJOutput' - ! 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 ! JointID - Int_BufSz = Int_BufSz + 1 ! JointIDIndx - 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%JointID - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%JointIDIndx - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Morison_PackJOutput - - SUBROUTINE Morison_UnPackJOutput( 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(Morison_JOutput), 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 = 'Morison_UnPackJOutput' - ! 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%JointID = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%JointIDIndx = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Morison_UnPackJOutput - - SUBROUTINE Morison_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Morison_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(Morison_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 = 'Morison_CopyInitInput' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInitInputData%Gravity = SrcInitInputData%Gravity - DstInitInputData%WtrDens = SrcInitInputData%WtrDens - DstInitInputData%WtrDpth = SrcInitInputData%WtrDpth - DstInitInputData%MSL2SWL = SrcInitInputData%MSL2SWL - DstInitInputData%NJoints = SrcInitInputData%NJoints - DstInitInputData%NNodes = SrcInitInputData%NNodes -IF (ALLOCATED(SrcInitInputData%InpJoints)) THEN - i1_l = LBOUND(SrcInitInputData%InpJoints,1) - i1_u = UBOUND(SrcInitInputData%InpJoints,1) - IF (.NOT. ALLOCATED(DstInitInputData%InpJoints)) THEN - ALLOCATE(DstInitInputData%InpJoints(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%InpJoints.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcInitInputData%InpJoints,1), UBOUND(SrcInitInputData%InpJoints,1) - CALL Morison_Copyjointtype( SrcInitInputData%InpJoints(i1), DstInitInputData%InpJoints(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcInitInputData%Nodes)) THEN - i1_l = LBOUND(SrcInitInputData%Nodes,1) - i1_u = UBOUND(SrcInitInputData%Nodes,1) - IF (.NOT. ALLOCATED(DstInitInputData%Nodes)) THEN - ALLOCATE(DstInitInputData%Nodes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%Nodes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcInitInputData%Nodes,1), UBOUND(SrcInitInputData%Nodes,1) - CALL Morison_Copynodetype( SrcInitInputData%Nodes(i1), DstInitInputData%Nodes(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - DstInitInputData%NAxCoefs = SrcInitInputData%NAxCoefs -IF (ALLOCATED(SrcInitInputData%AxialCoefs)) THEN - i1_l = LBOUND(SrcInitInputData%AxialCoefs,1) - i1_u = UBOUND(SrcInitInputData%AxialCoefs,1) - IF (.NOT. ALLOCATED(DstInitInputData%AxialCoefs)) THEN - ALLOCATE(DstInitInputData%AxialCoefs(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%AxialCoefs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcInitInputData%AxialCoefs,1), UBOUND(SrcInitInputData%AxialCoefs,1) - CALL Morison_Copyaxialcoeftype( SrcInitInputData%AxialCoefs(i1), DstInitInputData%AxialCoefs(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - DstInitInputData%NPropSets = SrcInitInputData%NPropSets -IF (ALLOCATED(SrcInitInputData%MPropSets)) THEN - i1_l = LBOUND(SrcInitInputData%MPropSets,1) - i1_u = UBOUND(SrcInitInputData%MPropSets,1) - IF (.NOT. ALLOCATED(DstInitInputData%MPropSets)) THEN - ALLOCATE(DstInitInputData%MPropSets(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%MPropSets.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcInitInputData%MPropSets,1), UBOUND(SrcInitInputData%MPropSets,1) - CALL Morison_Copymemberproptype( SrcInitInputData%MPropSets(i1), DstInitInputData%MPropSets(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - DstInitInputData%SimplCd = SrcInitInputData%SimplCd - DstInitInputData%SimplCdMG = SrcInitInputData%SimplCdMG - DstInitInputData%SimplCa = SrcInitInputData%SimplCa - DstInitInputData%SimplCaMG = SrcInitInputData%SimplCaMG - DstInitInputData%SimplCp = SrcInitInputData%SimplCp - DstInitInputData%SimplCpMG = SrcInitInputData%SimplCpMG - DstInitInputData%SimplAxCd = SrcInitInputData%SimplAxCd - DstInitInputData%SimplAxCdMG = SrcInitInputData%SimplAxCdMG - DstInitInputData%SimplAxCa = SrcInitInputData%SimplAxCa - DstInitInputData%SimplAxCaMG = SrcInitInputData%SimplAxCaMG - DstInitInputData%SimplAxCp = SrcInitInputData%SimplAxCp - DstInitInputData%SimplAxCpMG = SrcInitInputData%SimplAxCpMG - DstInitInputData%NCoefDpth = SrcInitInputData%NCoefDpth -IF (ALLOCATED(SrcInitInputData%CoefDpths)) THEN - i1_l = LBOUND(SrcInitInputData%CoefDpths,1) - i1_u = UBOUND(SrcInitInputData%CoefDpths,1) - IF (.NOT. ALLOCATED(DstInitInputData%CoefDpths)) THEN - ALLOCATE(DstInitInputData%CoefDpths(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%CoefDpths.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcInitInputData%CoefDpths,1), UBOUND(SrcInitInputData%CoefDpths,1) - CALL Morison_Copycoefdpths( SrcInitInputData%CoefDpths(i1), DstInitInputData%CoefDpths(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - DstInitInputData%NCoefMembers = SrcInitInputData%NCoefMembers -IF (ALLOCATED(SrcInitInputData%CoefMembers)) THEN - i1_l = LBOUND(SrcInitInputData%CoefMembers,1) - i1_u = UBOUND(SrcInitInputData%CoefMembers,1) - IF (.NOT. ALLOCATED(DstInitInputData%CoefMembers)) THEN - ALLOCATE(DstInitInputData%CoefMembers(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%CoefMembers.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcInitInputData%CoefMembers,1), UBOUND(SrcInitInputData%CoefMembers,1) - CALL Morison_Copycoefmembers( SrcInitInputData%CoefMembers(i1), DstInitInputData%CoefMembers(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - DstInitInputData%NMembers = SrcInitInputData%NMembers -IF (ALLOCATED(SrcInitInputData%InpMembers)) THEN - i1_l = LBOUND(SrcInitInputData%InpMembers,1) - i1_u = UBOUND(SrcInitInputData%InpMembers,1) - IF (.NOT. ALLOCATED(DstInitInputData%InpMembers)) THEN - ALLOCATE(DstInitInputData%InpMembers(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%InpMembers.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcInitInputData%InpMembers,1), UBOUND(SrcInitInputData%InpMembers,1) - CALL Morison_Copymemberinputtype( SrcInitInputData%InpMembers(i1), DstInitInputData%InpMembers(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - DstInitInputData%NFillGroups = SrcInitInputData%NFillGroups -IF (ALLOCATED(SrcInitInputData%FilledGroups)) THEN - i1_l = LBOUND(SrcInitInputData%FilledGroups,1) - i1_u = UBOUND(SrcInitInputData%FilledGroups,1) - IF (.NOT. ALLOCATED(DstInitInputData%FilledGroups)) THEN - ALLOCATE(DstInitInputData%FilledGroups(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%FilledGroups.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcInitInputData%FilledGroups,1), UBOUND(SrcInitInputData%FilledGroups,1) - CALL Morison_Copyfilledgrouptype( SrcInitInputData%FilledGroups(i1), DstInitInputData%FilledGroups(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - DstInitInputData%NMGDepths = SrcInitInputData%NMGDepths -IF (ALLOCATED(SrcInitInputData%MGDepths)) THEN - i1_l = LBOUND(SrcInitInputData%MGDepths,1) - i1_u = UBOUND(SrcInitInputData%MGDepths,1) - IF (.NOT. ALLOCATED(DstInitInputData%MGDepths)) THEN - ALLOCATE(DstInitInputData%MGDepths(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%MGDepths.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcInitInputData%MGDepths,1), UBOUND(SrcInitInputData%MGDepths,1) - CALL Morison_Copymgdepthstype( SrcInitInputData%MGDepths(i1), DstInitInputData%MGDepths(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - DstInitInputData%MGTop = SrcInitInputData%MGTop - DstInitInputData%MGBottom = SrcInitInputData%MGBottom - DstInitInputData%NMOutputs = SrcInitInputData%NMOutputs -IF (ALLOCATED(SrcInitInputData%MOutLst)) THEN - i1_l = LBOUND(SrcInitInputData%MOutLst,1) - i1_u = UBOUND(SrcInitInputData%MOutLst,1) - IF (.NOT. ALLOCATED(DstInitInputData%MOutLst)) THEN - ALLOCATE(DstInitInputData%MOutLst(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%MOutLst.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcInitInputData%MOutLst,1), UBOUND(SrcInitInputData%MOutLst,1) - CALL Morison_Copymoutput( SrcInitInputData%MOutLst(i1), DstInitInputData%MOutLst(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - DstInitInputData%NJOutputs = SrcInitInputData%NJOutputs -IF (ALLOCATED(SrcInitInputData%JOutLst)) THEN - i1_l = LBOUND(SrcInitInputData%JOutLst,1) - i1_u = UBOUND(SrcInitInputData%JOutLst,1) - IF (.NOT. ALLOCATED(DstInitInputData%JOutLst)) THEN - ALLOCATE(DstInitInputData%JOutLst(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%JOutLst.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcInitInputData%JOutLst,1), UBOUND(SrcInitInputData%JOutLst,1) - CALL Morison_Copyjoutput( SrcInitInputData%JOutLst(i1), DstInitInputData%JOutLst(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - DstInitInputData%OutList = SrcInitInputData%OutList -IF (ALLOCATED(SrcInitInputData%ValidOutList)) THEN - i1_l = LBOUND(SrcInitInputData%ValidOutList,1) - i1_u = UBOUND(SrcInitInputData%ValidOutList,1) - IF (.NOT. ALLOCATED(DstInitInputData%ValidOutList)) THEN - ALLOCATE(DstInitInputData%ValidOutList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%ValidOutList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%ValidOutList = SrcInitInputData%ValidOutList -ENDIF - DstInitInputData%NumOuts = SrcInitInputData%NumOuts - DstInitInputData%OutSwtch = SrcInitInputData%OutSwtch - DstInitInputData%OutAll = SrcInitInputData%OutAll - DstInitInputData%OutRootName = SrcInitInputData%OutRootName - DstInitInputData%UnOutFile = SrcInitInputData%UnOutFile - DstInitInputData%UnSum = SrcInitInputData%UnSum - DstInitInputData%NStepWave = SrcInitInputData%NStepWave -IF (ALLOCATED(SrcInitInputData%WaveAcc)) THEN - i1_l = LBOUND(SrcInitInputData%WaveAcc,1) - i1_u = UBOUND(SrcInitInputData%WaveAcc,1) - i2_l = LBOUND(SrcInitInputData%WaveAcc,2) - i2_u = UBOUND(SrcInitInputData%WaveAcc,2) - i3_l = LBOUND(SrcInitInputData%WaveAcc,3) - i3_u = UBOUND(SrcInitInputData%WaveAcc,3) - IF (.NOT. ALLOCATED(DstInitInputData%WaveAcc)) THEN - ALLOCATE(DstInitInputData%WaveAcc(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%WaveAcc.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%WaveAcc = SrcInitInputData%WaveAcc -ENDIF -IF (ALLOCATED(SrcInitInputData%WaveTime)) THEN - i1_l = LBOUND(SrcInitInputData%WaveTime,1) - i1_u = UBOUND(SrcInitInputData%WaveTime,1) - IF (.NOT. ALLOCATED(DstInitInputData%WaveTime)) THEN - ALLOCATE(DstInitInputData%WaveTime(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveTime.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%WaveTime = SrcInitInputData%WaveTime -ENDIF -IF (ALLOCATED(SrcInitInputData%WaveDynP)) THEN - i1_l = LBOUND(SrcInitInputData%WaveDynP,1) - i1_u = UBOUND(SrcInitInputData%WaveDynP,1) - i2_l = LBOUND(SrcInitInputData%WaveDynP,2) - i2_u = UBOUND(SrcInitInputData%WaveDynP,2) - IF (.NOT. ALLOCATED(DstInitInputData%WaveDynP)) THEN - ALLOCATE(DstInitInputData%WaveDynP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveDynP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%WaveDynP = SrcInitInputData%WaveDynP -ENDIF -IF (ALLOCATED(SrcInitInputData%WaveVel)) THEN - i1_l = LBOUND(SrcInitInputData%WaveVel,1) - i1_u = UBOUND(SrcInitInputData%WaveVel,1) - i2_l = LBOUND(SrcInitInputData%WaveVel,2) - i2_u = UBOUND(SrcInitInputData%WaveVel,2) - i3_l = LBOUND(SrcInitInputData%WaveVel,3) - i3_u = UBOUND(SrcInitInputData%WaveVel,3) - IF (.NOT. ALLOCATED(DstInitInputData%WaveVel)) THEN - ALLOCATE(DstInitInputData%WaveVel(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%WaveVel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%WaveVel = SrcInitInputData%WaveVel -ENDIF -IF (ALLOCATED(SrcInitInputData%nodeInWater)) THEN - i1_l = LBOUND(SrcInitInputData%nodeInWater,1) - i1_u = UBOUND(SrcInitInputData%nodeInWater,1) - i2_l = LBOUND(SrcInitInputData%nodeInWater,2) - i2_u = UBOUND(SrcInitInputData%nodeInWater,2) - IF (.NOT. ALLOCATED(DstInitInputData%nodeInWater)) THEN - ALLOCATE(DstInitInputData%nodeInWater(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%nodeInWater.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%nodeInWater = SrcInitInputData%nodeInWater -ENDIF - DstInitInputData%VisMeshes = SrcInitInputData%VisMeshes - END SUBROUTINE Morison_CopyInitInput - - SUBROUTINE Morison_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(Morison_InitInputType), INTENT(INOUT) :: InitInputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_DestroyInitInput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(InitInputData%InpJoints)) THEN -DO i1 = LBOUND(InitInputData%InpJoints,1), UBOUND(InitInputData%InpJoints,1) - CALL Morison_Destroyjointtype( InitInputData%InpJoints(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(InitInputData%InpJoints) -ENDIF -IF (ALLOCATED(InitInputData%Nodes)) THEN -DO i1 = LBOUND(InitInputData%Nodes,1), UBOUND(InitInputData%Nodes,1) - CALL Morison_Destroynodetype( InitInputData%Nodes(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(InitInputData%Nodes) -ENDIF -IF (ALLOCATED(InitInputData%AxialCoefs)) THEN -DO i1 = LBOUND(InitInputData%AxialCoefs,1), UBOUND(InitInputData%AxialCoefs,1) - CALL Morison_Destroyaxialcoeftype( InitInputData%AxialCoefs(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(InitInputData%AxialCoefs) -ENDIF -IF (ALLOCATED(InitInputData%MPropSets)) THEN -DO i1 = LBOUND(InitInputData%MPropSets,1), UBOUND(InitInputData%MPropSets,1) - CALL Morison_Destroymemberproptype( InitInputData%MPropSets(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(InitInputData%MPropSets) -ENDIF -IF (ALLOCATED(InitInputData%CoefDpths)) THEN -DO i1 = LBOUND(InitInputData%CoefDpths,1), UBOUND(InitInputData%CoefDpths,1) - CALL Morison_Destroycoefdpths( InitInputData%CoefDpths(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(InitInputData%CoefDpths) -ENDIF -IF (ALLOCATED(InitInputData%CoefMembers)) THEN -DO i1 = LBOUND(InitInputData%CoefMembers,1), UBOUND(InitInputData%CoefMembers,1) - CALL Morison_Destroycoefmembers( InitInputData%CoefMembers(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(InitInputData%CoefMembers) -ENDIF -IF (ALLOCATED(InitInputData%InpMembers)) THEN -DO i1 = LBOUND(InitInputData%InpMembers,1), UBOUND(InitInputData%InpMembers,1) - CALL Morison_Destroymemberinputtype( InitInputData%InpMembers(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(InitInputData%InpMembers) -ENDIF -IF (ALLOCATED(InitInputData%FilledGroups)) THEN -DO i1 = LBOUND(InitInputData%FilledGroups,1), UBOUND(InitInputData%FilledGroups,1) - CALL Morison_Destroyfilledgrouptype( InitInputData%FilledGroups(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(InitInputData%FilledGroups) -ENDIF -IF (ALLOCATED(InitInputData%MGDepths)) THEN -DO i1 = LBOUND(InitInputData%MGDepths,1), UBOUND(InitInputData%MGDepths,1) - CALL Morison_Destroymgdepthstype( InitInputData%MGDepths(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(InitInputData%MGDepths) -ENDIF -IF (ALLOCATED(InitInputData%MOutLst)) THEN -DO i1 = LBOUND(InitInputData%MOutLst,1), UBOUND(InitInputData%MOutLst,1) - CALL Morison_Destroymoutput( InitInputData%MOutLst(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(InitInputData%MOutLst) -ENDIF -IF (ALLOCATED(InitInputData%JOutLst)) THEN -DO i1 = LBOUND(InitInputData%JOutLst,1), UBOUND(InitInputData%JOutLst,1) - CALL Morison_Destroyjoutput( InitInputData%JOutLst(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(InitInputData%JOutLst) -ENDIF -IF (ALLOCATED(InitInputData%ValidOutList)) THEN - DEALLOCATE(InitInputData%ValidOutList) -ENDIF -IF (ALLOCATED(InitInputData%WaveAcc)) THEN - DEALLOCATE(InitInputData%WaveAcc) -ENDIF -IF (ALLOCATED(InitInputData%WaveTime)) THEN - DEALLOCATE(InitInputData%WaveTime) -ENDIF -IF (ALLOCATED(InitInputData%WaveDynP)) THEN - DEALLOCATE(InitInputData%WaveDynP) -ENDIF -IF (ALLOCATED(InitInputData%WaveVel)) THEN - DEALLOCATE(InitInputData%WaveVel) -ENDIF -IF (ALLOCATED(InitInputData%nodeInWater)) THEN - DEALLOCATE(InitInputData%nodeInWater) -ENDIF - END SUBROUTINE Morison_DestroyInitInput - - SUBROUTINE Morison_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(Morison_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 = 'Morison_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 - Re_BufSz = Re_BufSz + 1 ! Gravity - Re_BufSz = Re_BufSz + 1 ! WtrDens - Re_BufSz = Re_BufSz + 1 ! WtrDpth - Re_BufSz = Re_BufSz + 1 ! MSL2SWL - Int_BufSz = Int_BufSz + 1 ! NJoints - Int_BufSz = Int_BufSz + 1 ! NNodes - Int_BufSz = Int_BufSz + 1 ! InpJoints allocated yes/no - IF ( ALLOCATED(InData%InpJoints) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! InpJoints upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%InpJoints,1), UBOUND(InData%InpJoints,1) - Int_BufSz = Int_BufSz + 3 ! InpJoints: size of buffers for each call to pack subtype - CALL Morison_Packjointtype( Re_Buf, Db_Buf, Int_Buf, InData%InpJoints(i1), ErrStat2, ErrMsg2, .TRUE. ) ! InpJoints - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! InpJoints - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! InpJoints - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! InpJoints - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! Nodes allocated yes/no - IF ( ALLOCATED(InData%Nodes) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Nodes upper/lower bounds for each dimension - DO i1 = LBOUND(InData%Nodes,1), UBOUND(InData%Nodes,1) - Int_BufSz = Int_BufSz + 3 ! Nodes: size of buffers for each call to pack subtype - CALL Morison_Packnodetype( Re_Buf, Db_Buf, Int_Buf, InData%Nodes(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Nodes - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Nodes - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Nodes - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Nodes - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! NAxCoefs - Int_BufSz = Int_BufSz + 1 ! AxialCoefs allocated yes/no - IF ( ALLOCATED(InData%AxialCoefs) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! AxialCoefs upper/lower bounds for each dimension - DO i1 = LBOUND(InData%AxialCoefs,1), UBOUND(InData%AxialCoefs,1) - Int_BufSz = Int_BufSz + 3 ! AxialCoefs: size of buffers for each call to pack subtype - CALL Morison_Packaxialcoeftype( Re_Buf, Db_Buf, Int_Buf, InData%AxialCoefs(i1), ErrStat2, ErrMsg2, .TRUE. ) ! AxialCoefs - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! AxialCoefs - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! AxialCoefs - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! AxialCoefs - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! NPropSets - Int_BufSz = Int_BufSz + 1 ! MPropSets allocated yes/no - IF ( ALLOCATED(InData%MPropSets) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! MPropSets upper/lower bounds for each dimension - DO i1 = LBOUND(InData%MPropSets,1), UBOUND(InData%MPropSets,1) - Int_BufSz = Int_BufSz + 3 ! MPropSets: size of buffers for each call to pack subtype - CALL Morison_Packmemberproptype( Re_Buf, Db_Buf, Int_Buf, InData%MPropSets(i1), ErrStat2, ErrMsg2, .TRUE. ) ! MPropSets - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! MPropSets - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! MPropSets - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! MPropSets - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Re_BufSz = Re_BufSz + 1 ! SimplCd - Re_BufSz = Re_BufSz + 1 ! SimplCdMG - Re_BufSz = Re_BufSz + 1 ! SimplCa - Re_BufSz = Re_BufSz + 1 ! SimplCaMG - Re_BufSz = Re_BufSz + 1 ! SimplCp - Re_BufSz = Re_BufSz + 1 ! SimplCpMG - Re_BufSz = Re_BufSz + 1 ! SimplAxCd - Re_BufSz = Re_BufSz + 1 ! SimplAxCdMG - Re_BufSz = Re_BufSz + 1 ! SimplAxCa - Re_BufSz = Re_BufSz + 1 ! SimplAxCaMG - Re_BufSz = Re_BufSz + 1 ! SimplAxCp - Re_BufSz = Re_BufSz + 1 ! SimplAxCpMG - Int_BufSz = Int_BufSz + 1 ! NCoefDpth - Int_BufSz = Int_BufSz + 1 ! CoefDpths allocated yes/no - IF ( ALLOCATED(InData%CoefDpths) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! CoefDpths upper/lower bounds for each dimension - DO i1 = LBOUND(InData%CoefDpths,1), UBOUND(InData%CoefDpths,1) - Int_BufSz = Int_BufSz + 3 ! CoefDpths: size of buffers for each call to pack subtype - CALL Morison_Packcoefdpths( Re_Buf, Db_Buf, Int_Buf, InData%CoefDpths(i1), ErrStat2, ErrMsg2, .TRUE. ) ! CoefDpths - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! CoefDpths - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! CoefDpths - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! CoefDpths - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! NCoefMembers - Int_BufSz = Int_BufSz + 1 ! CoefMembers allocated yes/no - IF ( ALLOCATED(InData%CoefMembers) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! CoefMembers upper/lower bounds for each dimension - DO i1 = LBOUND(InData%CoefMembers,1), UBOUND(InData%CoefMembers,1) - Int_BufSz = Int_BufSz + 3 ! CoefMembers: size of buffers for each call to pack subtype - CALL Morison_Packcoefmembers( Re_Buf, Db_Buf, Int_Buf, InData%CoefMembers(i1), ErrStat2, ErrMsg2, .TRUE. ) ! CoefMembers - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! CoefMembers - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! CoefMembers - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! CoefMembers - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! NMembers - Int_BufSz = Int_BufSz + 1 ! InpMembers allocated yes/no - IF ( ALLOCATED(InData%InpMembers) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! InpMembers upper/lower bounds for each dimension - DO i1 = LBOUND(InData%InpMembers,1), UBOUND(InData%InpMembers,1) - Int_BufSz = Int_BufSz + 3 ! InpMembers: size of buffers for each call to pack subtype - CALL Morison_Packmemberinputtype( Re_Buf, Db_Buf, Int_Buf, InData%InpMembers(i1), ErrStat2, ErrMsg2, .TRUE. ) ! InpMembers - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! InpMembers - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! InpMembers - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! InpMembers - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! NFillGroups - Int_BufSz = Int_BufSz + 1 ! FilledGroups allocated yes/no - IF ( ALLOCATED(InData%FilledGroups) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! FilledGroups upper/lower bounds for each dimension - DO i1 = LBOUND(InData%FilledGroups,1), UBOUND(InData%FilledGroups,1) - Int_BufSz = Int_BufSz + 3 ! FilledGroups: size of buffers for each call to pack subtype - CALL Morison_Packfilledgrouptype( Re_Buf, Db_Buf, Int_Buf, InData%FilledGroups(i1), ErrStat2, ErrMsg2, .TRUE. ) ! FilledGroups - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! FilledGroups - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! FilledGroups - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! FilledGroups - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! NMGDepths - Int_BufSz = Int_BufSz + 1 ! MGDepths allocated yes/no - IF ( ALLOCATED(InData%MGDepths) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! MGDepths upper/lower bounds for each dimension - DO i1 = LBOUND(InData%MGDepths,1), UBOUND(InData%MGDepths,1) - Int_BufSz = Int_BufSz + 3 ! MGDepths: size of buffers for each call to pack subtype - CALL Morison_Packmgdepthstype( Re_Buf, Db_Buf, Int_Buf, InData%MGDepths(i1), ErrStat2, ErrMsg2, .TRUE. ) ! MGDepths - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! MGDepths - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! MGDepths - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! MGDepths - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Re_BufSz = Re_BufSz + 1 ! MGTop - Re_BufSz = Re_BufSz + 1 ! MGBottom - Int_BufSz = Int_BufSz + 1 ! NMOutputs - 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 Morison_Packmoutput( 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 ! NJOutputs - Int_BufSz = Int_BufSz + 1 ! JOutLst allocated yes/no - IF ( ALLOCATED(InData%JOutLst) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! JOutLst upper/lower bounds for each dimension - DO i1 = LBOUND(InData%JOutLst,1), UBOUND(InData%JOutLst,1) - Int_BufSz = Int_BufSz + 3 ! JOutLst: size of buffers for each call to pack subtype - CALL Morison_Packjoutput( Re_Buf, Db_Buf, Int_Buf, InData%JOutLst(i1), ErrStat2, ErrMsg2, .TRUE. ) ! JOutLst - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! JOutLst - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! JOutLst - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! JOutLst - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + SIZE(InData%OutList)*LEN(InData%OutList) ! OutList - Int_BufSz = Int_BufSz + 1 ! ValidOutList allocated yes/no - IF ( ALLOCATED(InData%ValidOutList) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ValidOutList upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%ValidOutList) ! ValidOutList - END IF - Int_BufSz = Int_BufSz + 1 ! NumOuts - Int_BufSz = Int_BufSz + 1 ! OutSwtch - Int_BufSz = Int_BufSz + 1 ! OutAll - Int_BufSz = Int_BufSz + 1*LEN(InData%OutRootName) ! OutRootName - Int_BufSz = Int_BufSz + 1 ! UnOutFile - Int_BufSz = Int_BufSz + 1 ! UnSum - Int_BufSz = Int_BufSz + 1 ! NStepWave - Int_BufSz = Int_BufSz + 1 ! WaveAcc allocated yes/no - IF ( ALLOCATED(InData%WaveAcc) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! WaveAcc upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveAcc) ! WaveAcc - END IF - Int_BufSz = Int_BufSz + 1 ! WaveTime allocated yes/no - IF ( ALLOCATED(InData%WaveTime) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WaveTime upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveTime) ! WaveTime - END IF - Int_BufSz = Int_BufSz + 1 ! WaveDynP allocated yes/no - IF ( ALLOCATED(InData%WaveDynP) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! WaveDynP upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveDynP) ! WaveDynP - END IF - Int_BufSz = Int_BufSz + 1 ! WaveVel allocated yes/no - IF ( ALLOCATED(InData%WaveVel) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! WaveVel upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveVel) ! WaveVel - END IF - Int_BufSz = Int_BufSz + 1 ! nodeInWater allocated yes/no - IF ( ALLOCATED(InData%nodeInWater) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! nodeInWater upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%nodeInWater) ! nodeInWater - END IF - Int_BufSz = Int_BufSz + 1 ! VisMeshes - 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%Gravity - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WtrDens - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WtrDpth - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MSL2SWL - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NJoints - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NNodes - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%InpJoints) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InpJoints,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InpJoints,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%InpJoints,1), UBOUND(InData%InpJoints,1) - CALL Morison_Packjointtype( Re_Buf, Db_Buf, Int_Buf, InData%InpJoints(i1), ErrStat2, ErrMsg2, OnlySize ) ! InpJoints - 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%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 - - DO i1 = LBOUND(InData%Nodes,1), UBOUND(InData%Nodes,1) - CALL Morison_Packnodetype( Re_Buf, Db_Buf, Int_Buf, InData%Nodes(i1), ErrStat2, ErrMsg2, OnlySize ) ! Nodes - 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%NAxCoefs - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%AxialCoefs) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AxialCoefs,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AxialCoefs,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%AxialCoefs,1), UBOUND(InData%AxialCoefs,1) - CALL Morison_Packaxialcoeftype( Re_Buf, Db_Buf, Int_Buf, InData%AxialCoefs(i1), ErrStat2, ErrMsg2, OnlySize ) ! AxialCoefs - 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%NPropSets - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%MPropSets) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MPropSets,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MPropSets,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%MPropSets,1), UBOUND(InData%MPropSets,1) - CALL Morison_Packmemberproptype( Re_Buf, Db_Buf, Int_Buf, InData%MPropSets(i1), ErrStat2, ErrMsg2, OnlySize ) ! MPropSets - 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 - ReKiBuf(Re_Xferred) = InData%SimplCd - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%SimplCdMG - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%SimplCa - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%SimplCaMG - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%SimplCp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%SimplCpMG - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%SimplAxCd - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%SimplAxCdMG - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%SimplAxCa - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%SimplAxCaMG - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%SimplAxCp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%SimplAxCpMG - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NCoefDpth - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%CoefDpths) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CoefDpths,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CoefDpths,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%CoefDpths,1), UBOUND(InData%CoefDpths,1) - CALL Morison_Packcoefdpths( Re_Buf, Db_Buf, Int_Buf, InData%CoefDpths(i1), ErrStat2, ErrMsg2, OnlySize ) ! CoefDpths - 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%NCoefMembers - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%CoefMembers) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CoefMembers,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CoefMembers,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%CoefMembers,1), UBOUND(InData%CoefMembers,1) - CALL Morison_Packcoefmembers( Re_Buf, Db_Buf, Int_Buf, InData%CoefMembers(i1), ErrStat2, ErrMsg2, OnlySize ) ! CoefMembers - 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%NMembers - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%InpMembers) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InpMembers,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InpMembers,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%InpMembers,1), UBOUND(InData%InpMembers,1) - CALL Morison_Packmemberinputtype( Re_Buf, Db_Buf, Int_Buf, InData%InpMembers(i1), ErrStat2, ErrMsg2, OnlySize ) ! InpMembers - 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%NFillGroups - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%FilledGroups) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FilledGroups,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FilledGroups,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%FilledGroups,1), UBOUND(InData%FilledGroups,1) - CALL Morison_Packfilledgrouptype( Re_Buf, Db_Buf, Int_Buf, InData%FilledGroups(i1), ErrStat2, ErrMsg2, OnlySize ) ! FilledGroups - 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%NMGDepths - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%MGDepths) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MGDepths,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MGDepths,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%MGDepths,1), UBOUND(InData%MGDepths,1) - CALL Morison_Packmgdepthstype( Re_Buf, Db_Buf, Int_Buf, InData%MGDepths(i1), ErrStat2, ErrMsg2, OnlySize ) ! MGDepths - 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 - ReKiBuf(Re_Xferred) = InData%MGTop - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MGBottom - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NMOutputs - Int_Xferred = Int_Xferred + 1 - 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 Morison_Packmoutput( 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 - IntKiBuf(Int_Xferred) = InData%NJOutputs - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%JOutLst) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%JOutLst,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%JOutLst,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%JOutLst,1), UBOUND(InData%JOutLst,1) - CALL Morison_Packjoutput( Re_Buf, Db_Buf, Int_Buf, InData%JOutLst(i1), ErrStat2, ErrMsg2, OnlySize ) ! JOutLst - 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 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 - IF ( .NOT. ALLOCATED(InData%ValidOutList) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ValidOutList,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ValidOutList,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ValidOutList,1), UBOUND(InData%ValidOutList,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%ValidOutList(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%OutSwtch - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%OutAll, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%OutRootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutRootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = InData%UnOutFile - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%UnSum - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NStepWave - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%WaveAcc) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%WaveAcc,3), UBOUND(InData%WaveAcc,3) - DO i2 = LBOUND(InData%WaveAcc,2), UBOUND(InData%WaveAcc,2) - DO i1 = LBOUND(InData%WaveAcc,1), UBOUND(InData%WaveAcc,1) - ReKiBuf(Re_Xferred) = InData%WaveAcc(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveTime) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveTime,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveTime,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WaveTime,1), UBOUND(InData%WaveTime,1) - ReKiBuf(Re_Xferred) = InData%WaveTime(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveDynP) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveDynP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDynP,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveDynP,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDynP,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%WaveDynP,2), UBOUND(InData%WaveDynP,2) - DO i1 = LBOUND(InData%WaveDynP,1), UBOUND(InData%WaveDynP,1) - ReKiBuf(Re_Xferred) = InData%WaveDynP(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveVel) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%WaveVel,3), UBOUND(InData%WaveVel,3) - DO i2 = LBOUND(InData%WaveVel,2), UBOUND(InData%WaveVel,2) - DO i1 = LBOUND(InData%WaveVel,1), UBOUND(InData%WaveVel,1) - ReKiBuf(Re_Xferred) = InData%WaveVel(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%nodeInWater) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%nodeInWater,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%nodeInWater,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%nodeInWater,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%nodeInWater,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%nodeInWater,2), UBOUND(InData%nodeInWater,2) - DO i1 = LBOUND(InData%nodeInWater,1), UBOUND(InData%nodeInWater,1) - IntKiBuf(Int_Xferred) = InData%nodeInWater(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = TRANSFER(InData%VisMeshes, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Morison_PackInitInput - - SUBROUTINE Morison_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(Morison_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 = 'Morison_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%Gravity = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%WtrDens = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%WtrDpth = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MSL2SWL = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NJoints = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NNodes = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InpJoints not allocated - Int_Xferred = Int_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%InpJoints)) DEALLOCATE(OutData%InpJoints) - ALLOCATE(OutData%InpJoints(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InpJoints.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%InpJoints,1), UBOUND(OutData%InpJoints,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 Morison_Unpackjointtype( Re_Buf, Db_Buf, Int_Buf, OutData%InpJoints(i1), ErrStat2, ErrMsg2 ) ! InpJoints - 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 ! 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%Nodes)) DEALLOCATE(OutData%Nodes) - ALLOCATE(OutData%Nodes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Nodes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Nodes,1), UBOUND(OutData%Nodes,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 Morison_Unpacknodetype( Re_Buf, Db_Buf, Int_Buf, OutData%Nodes(i1), ErrStat2, ErrMsg2 ) ! Nodes - 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%NAxCoefs = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AxialCoefs not allocated - Int_Xferred = Int_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%AxialCoefs)) DEALLOCATE(OutData%AxialCoefs) - ALLOCATE(OutData%AxialCoefs(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AxialCoefs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%AxialCoefs,1), UBOUND(OutData%AxialCoefs,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 Morison_Unpackaxialcoeftype( Re_Buf, Db_Buf, Int_Buf, OutData%AxialCoefs(i1), ErrStat2, ErrMsg2 ) ! AxialCoefs - 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%NPropSets = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MPropSets not allocated - Int_Xferred = Int_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%MPropSets)) DEALLOCATE(OutData%MPropSets) - ALLOCATE(OutData%MPropSets(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MPropSets.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%MPropSets,1), UBOUND(OutData%MPropSets,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 Morison_Unpackmemberproptype( Re_Buf, Db_Buf, Int_Buf, OutData%MPropSets(i1), ErrStat2, ErrMsg2 ) ! MPropSets - 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%SimplCd = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SimplCdMG = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SimplCa = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SimplCaMG = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SimplCp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SimplCpMG = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SimplAxCd = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SimplAxCdMG = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SimplAxCa = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SimplAxCaMG = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SimplAxCp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SimplAxCpMG = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NCoefDpth = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CoefDpths not allocated - Int_Xferred = Int_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%CoefDpths)) DEALLOCATE(OutData%CoefDpths) - ALLOCATE(OutData%CoefDpths(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CoefDpths.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%CoefDpths,1), UBOUND(OutData%CoefDpths,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 Morison_Unpackcoefdpths( Re_Buf, Db_Buf, Int_Buf, OutData%CoefDpths(i1), ErrStat2, ErrMsg2 ) ! CoefDpths - 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%NCoefMembers = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CoefMembers not allocated - Int_Xferred = Int_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%CoefMembers)) DEALLOCATE(OutData%CoefMembers) - ALLOCATE(OutData%CoefMembers(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CoefMembers.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%CoefMembers,1), UBOUND(OutData%CoefMembers,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 Morison_Unpackcoefmembers( Re_Buf, Db_Buf, Int_Buf, OutData%CoefMembers(i1), ErrStat2, ErrMsg2 ) ! CoefMembers - 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%NMembers = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InpMembers not allocated - Int_Xferred = Int_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%InpMembers)) DEALLOCATE(OutData%InpMembers) - ALLOCATE(OutData%InpMembers(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InpMembers.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%InpMembers,1), UBOUND(OutData%InpMembers,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 Morison_Unpackmemberinputtype( Re_Buf, Db_Buf, Int_Buf, OutData%InpMembers(i1), ErrStat2, ErrMsg2 ) ! InpMembers - 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%NFillGroups = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FilledGroups not allocated - Int_Xferred = Int_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%FilledGroups)) DEALLOCATE(OutData%FilledGroups) - ALLOCATE(OutData%FilledGroups(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FilledGroups.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%FilledGroups,1), UBOUND(OutData%FilledGroups,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 Morison_Unpackfilledgrouptype( Re_Buf, Db_Buf, Int_Buf, OutData%FilledGroups(i1), ErrStat2, ErrMsg2 ) ! FilledGroups - 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%NMGDepths = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MGDepths not allocated - Int_Xferred = Int_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%MGDepths)) DEALLOCATE(OutData%MGDepths) - ALLOCATE(OutData%MGDepths(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MGDepths.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%MGDepths,1), UBOUND(OutData%MGDepths,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 Morison_Unpackmgdepthstype( Re_Buf, Db_Buf, Int_Buf, OutData%MGDepths(i1), ErrStat2, ErrMsg2 ) ! MGDepths - 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%MGTop = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MGBottom = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NMOutputs = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - 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 Morison_Unpackmoutput( 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 - OutData%NJOutputs = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! JOutLst not allocated - Int_Xferred = Int_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%JOutLst)) DEALLOCATE(OutData%JOutLst) - ALLOCATE(OutData%JOutLst(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%JOutLst.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%JOutLst,1), UBOUND(OutData%JOutLst,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 Morison_Unpackjoutput( Re_Buf, Db_Buf, Int_Buf, OutData%JOutLst(i1), ErrStat2, ErrMsg2 ) ! JOutLst - 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 - i1_l = LBOUND(OutData%OutList,1) - i1_u = UBOUND(OutData%OutList,1) - 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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ValidOutList not allocated - Int_Xferred = Int_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%ValidOutList)) DEALLOCATE(OutData%ValidOutList) - ALLOCATE(OutData%ValidOutList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ValidOutList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ValidOutList,1), UBOUND(OutData%ValidOutList,1) - OutData%ValidOutList(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%ValidOutList(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - OutData%NumOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%OutSwtch = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%OutAll = TRANSFER(IntKiBuf(Int_Xferred), OutData%OutAll) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%OutRootName) - OutData%OutRootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%UnOutFile = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%UnSum = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NStepWave = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveAcc not allocated - Int_Xferred = Int_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%WaveAcc)) DEALLOCATE(OutData%WaveAcc) - ALLOCATE(OutData%WaveAcc(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%WaveAcc.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%WaveAcc,3), UBOUND(OutData%WaveAcc,3) - DO i2 = LBOUND(OutData%WaveAcc,2), UBOUND(OutData%WaveAcc,2) - DO i1 = LBOUND(OutData%WaveAcc,1), UBOUND(OutData%WaveAcc,1) - OutData%WaveAcc(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveTime not allocated - Int_Xferred = Int_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%WaveTime)) DEALLOCATE(OutData%WaveTime) - ALLOCATE(OutData%WaveTime(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveTime.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WaveTime,1), UBOUND(OutData%WaveTime,1) - OutData%WaveTime(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveDynP not allocated - Int_Xferred = Int_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%WaveDynP)) DEALLOCATE(OutData%WaveDynP) - ALLOCATE(OutData%WaveDynP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDynP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%WaveDynP,2), UBOUND(OutData%WaveDynP,2) - DO i1 = LBOUND(OutData%WaveDynP,1), UBOUND(OutData%WaveDynP,1) - OutData%WaveDynP(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveVel not allocated - Int_Xferred = Int_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%WaveVel)) DEALLOCATE(OutData%WaveVel) - ALLOCATE(OutData%WaveVel(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%WaveVel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%WaveVel,3), UBOUND(OutData%WaveVel,3) - DO i2 = LBOUND(OutData%WaveVel,2), UBOUND(OutData%WaveVel,2) - DO i1 = LBOUND(OutData%WaveVel,1), UBOUND(OutData%WaveVel,1) - OutData%WaveVel(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! nodeInWater not allocated - Int_Xferred = Int_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%nodeInWater)) DEALLOCATE(OutData%nodeInWater) - ALLOCATE(OutData%nodeInWater(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%nodeInWater.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%nodeInWater,2), UBOUND(OutData%nodeInWater,2) - DO i1 = LBOUND(OutData%nodeInWater,1), UBOUND(OutData%nodeInWater,1) - OutData%nodeInWater(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - OutData%VisMeshes = TRANSFER(IntKiBuf(Int_Xferred), OutData%VisMeshes) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Morison_UnPackInitInput - - SUBROUTINE Morison_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Morison_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(Morison_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 = 'Morison_CopyInitOutput' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcInitOutputData%MorisonVisRad)) THEN - i1_l = LBOUND(SrcInitOutputData%MorisonVisRad,1) - i1_u = UBOUND(SrcInitOutputData%MorisonVisRad,1) - IF (.NOT. ALLOCATED(DstInitOutputData%MorisonVisRad)) THEN - ALLOCATE(DstInitOutputData%MorisonVisRad(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%MorisonVisRad.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%MorisonVisRad = SrcInitOutputData%MorisonVisRad -ENDIF -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 Morison_CopyInitOutput - - SUBROUTINE Morison_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(Morison_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_DestroyInitOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(InitOutputData%MorisonVisRad)) THEN - DEALLOCATE(InitOutputData%MorisonVisRad) -ENDIF -IF (ALLOCATED(InitOutputData%WriteOutputHdr)) THEN - DEALLOCATE(InitOutputData%WriteOutputHdr) -ENDIF -IF (ALLOCATED(InitOutputData%WriteOutputUnt)) THEN - DEALLOCATE(InitOutputData%WriteOutputUnt) -ENDIF - END SUBROUTINE Morison_DestroyInitOutput - - SUBROUTINE Morison_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(Morison_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 = 'Morison_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 ! MorisonVisRad allocated yes/no - IF ( ALLOCATED(InData%MorisonVisRad) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! MorisonVisRad upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%MorisonVisRad) ! MorisonVisRad - 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 - - IF ( .NOT. ALLOCATED(InData%MorisonVisRad) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MorisonVisRad,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MorisonVisRad,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%MorisonVisRad,1), UBOUND(InData%MorisonVisRad,1) - ReKiBuf(Re_Xferred) = InData%MorisonVisRad(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - 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 Morison_PackInitOutput - SUBROUTINE Morison_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(Morison_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 = 'Morison_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 ! MorisonVisRad not allocated - Int_Xferred = Int_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%MorisonVisRad)) DEALLOCATE(OutData%MorisonVisRad) - ALLOCATE(OutData%MorisonVisRad(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MorisonVisRad.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%MorisonVisRad,1), UBOUND(OutData%MorisonVisRad,1) - OutData%MorisonVisRad(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - 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 Morison_UnPackInitOutput - - SUBROUTINE Morison_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Morison_ContinuousStateType), INTENT(IN) :: SrcContStateData - TYPE(Morison_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 = 'Morison_CopyContState' -! +subroutine Morison_CopyJointType(SrcJointTypeData, DstJointTypeData, CtrlCode, ErrStat, ErrMsg) + type(Morison_JointType), intent(in) :: SrcJointTypeData + type(Morison_JointType), intent(inout) :: DstJointTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Morison_CopyJointType' ErrStat = ErrID_None - ErrMsg = "" - DstContStateData%DummyContState = SrcContStateData%DummyContState - END SUBROUTINE Morison_CopyContState - - SUBROUTINE Morison_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(Morison_ContinuousStateType), INTENT(INOUT) :: ContStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_DestroyContState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE Morison_DestroyContState - - SUBROUTINE Morison_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(Morison_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 = 'Morison_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 Morison_PackContState - - SUBROUTINE Morison_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(Morison_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 = 'Morison_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 = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Morison_UnPackContState - - SUBROUTINE Morison_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Morison_DiscreteStateType), INTENT(IN) :: SrcDiscStateData - TYPE(Morison_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 = 'Morison_CopyDiscState' -! + ErrMsg = '' + DstJointTypeData%JointID = SrcJointTypeData%JointID + DstJointTypeData%Position = SrcJointTypeData%Position + DstJointTypeData%JointAxID = SrcJointTypeData%JointAxID + DstJointTypeData%JointAxIDIndx = SrcJointTypeData%JointAxIDIndx + DstJointTypeData%JointOvrlp = SrcJointTypeData%JointOvrlp + DstJointTypeData%NConnections = SrcJointTypeData%NConnections + DstJointTypeData%ConnectionList = SrcJointTypeData%ConnectionList +end subroutine + +subroutine Morison_DestroyJointType(JointTypeData, ErrStat, ErrMsg) + type(Morison_JointType), intent(inout) :: JointTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Morison_DestroyJointType' ErrStat = ErrID_None - ErrMsg = "" - DstDiscStateData%DummyDiscState = SrcDiscStateData%DummyDiscState - END SUBROUTINE Morison_CopyDiscState - - SUBROUTINE Morison_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(Morison_DiscreteStateType), INTENT(INOUT) :: DiscStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_DestroyDiscState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE Morison_DestroyDiscState - - SUBROUTINE Morison_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(Morison_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 = 'Morison_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 Morison_PackDiscState - - SUBROUTINE Morison_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(Morison_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 = 'Morison_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 = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Morison_UnPackDiscState - - SUBROUTINE Morison_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Morison_ConstraintStateType), INTENT(IN) :: SrcConstrStateData - TYPE(Morison_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 = 'Morison_CopyConstrState' -! + ErrMsg = '' +end subroutine + +subroutine Morison_PackJointType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Morison_JointType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Morison_PackJointType' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%JointID) + call RegPack(RF, InData%Position) + call RegPack(RF, InData%JointAxID) + call RegPack(RF, InData%JointAxIDIndx) + call RegPack(RF, InData%JointOvrlp) + call RegPack(RF, InData%NConnections) + call RegPack(RF, InData%ConnectionList) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Morison_UnPackJointType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Morison_JointType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Morison_UnPackJointType' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%JointID); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Position); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%JointAxID); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%JointAxIDIndx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%JointOvrlp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NConnections); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ConnectionList); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Morison_CopyMemberPropType(SrcMemberPropTypeData, DstMemberPropTypeData, CtrlCode, ErrStat, ErrMsg) + type(Morison_MemberPropType), intent(in) :: SrcMemberPropTypeData + type(Morison_MemberPropType), intent(inout) :: DstMemberPropTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Morison_CopyMemberPropType' ErrStat = ErrID_None - ErrMsg = "" - DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState - END SUBROUTINE Morison_CopyConstrState - - SUBROUTINE Morison_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(Morison_ConstraintStateType), INTENT(INOUT) :: ConstrStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_DestroyConstrState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE Morison_DestroyConstrState - - SUBROUTINE Morison_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(Morison_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 = 'Morison_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 Morison_PackConstrState - - SUBROUTINE Morison_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(Morison_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 = 'Morison_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 = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Morison_UnPackConstrState - - SUBROUTINE Morison_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Morison_OtherStateType), INTENT(IN) :: SrcOtherStateData - TYPE(Morison_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 = 'Morison_CopyOtherState' -! + ErrMsg = '' + DstMemberPropTypeData%PropSetID = SrcMemberPropTypeData%PropSetID + DstMemberPropTypeData%PropD = SrcMemberPropTypeData%PropD + DstMemberPropTypeData%PropThck = SrcMemberPropTypeData%PropThck +end subroutine + +subroutine Morison_DestroyMemberPropType(MemberPropTypeData, ErrStat, ErrMsg) + type(Morison_MemberPropType), intent(inout) :: MemberPropTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Morison_DestroyMemberPropType' ErrStat = ErrID_None - ErrMsg = "" - DstOtherStateData%DummyOtherState = SrcOtherStateData%DummyOtherState - END SUBROUTINE Morison_CopyOtherState - - SUBROUTINE Morison_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(Morison_OtherStateType), INTENT(INOUT) :: OtherStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_DestroyOtherState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE Morison_DestroyOtherState - - SUBROUTINE Morison_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(Morison_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 = 'Morison_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) = InData%DummyOtherState - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Morison_PackOtherState - - SUBROUTINE Morison_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(Morison_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 = 'Morison_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 Morison_UnPackOtherState - - SUBROUTINE Morison_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Morison_MiscVarType), INTENT(INOUT) :: SrcMiscData - TYPE(Morison_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 = 'Morison_CopyMisc' -! + ErrMsg = '' +end subroutine + +subroutine Morison_PackMemberPropType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Morison_MemberPropType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Morison_PackMemberPropType' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%PropSetID) + call RegPack(RF, InData%PropD) + call RegPack(RF, InData%PropThck) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Morison_UnPackMemberPropType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Morison_MemberPropType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Morison_UnPackMemberPropType' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%PropSetID); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PropD); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PropThck); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Morison_CopyFilledGroupType(SrcFilledGroupTypeData, DstFilledGroupTypeData, CtrlCode, ErrStat, ErrMsg) + type(Morison_FilledGroupType), intent(in) :: SrcFilledGroupTypeData + type(Morison_FilledGroupType), intent(inout) :: DstFilledGroupTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'Morison_CopyFilledGroupType' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcMiscData%FV)) THEN - i1_l = LBOUND(SrcMiscData%FV,1) - i1_u = UBOUND(SrcMiscData%FV,1) - i2_l = LBOUND(SrcMiscData%FV,2) - i2_u = UBOUND(SrcMiscData%FV,2) - IF (.NOT. ALLOCATED(DstMiscData%FV)) THEN - ALLOCATE(DstMiscData%FV(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FV.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%FV = SrcMiscData%FV -ENDIF -IF (ALLOCATED(SrcMiscData%FA)) THEN - i1_l = LBOUND(SrcMiscData%FA,1) - i1_u = UBOUND(SrcMiscData%FA,1) - i2_l = LBOUND(SrcMiscData%FA,2) - i2_u = UBOUND(SrcMiscData%FA,2) - IF (.NOT. ALLOCATED(DstMiscData%FA)) THEN - ALLOCATE(DstMiscData%FA(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FA.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%FA = SrcMiscData%FA -ENDIF -IF (ALLOCATED(SrcMiscData%FDynP)) THEN - i1_l = LBOUND(SrcMiscData%FDynP,1) - i1_u = UBOUND(SrcMiscData%FDynP,1) - IF (.NOT. ALLOCATED(DstMiscData%FDynP)) THEN - ALLOCATE(DstMiscData%FDynP(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FDynP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%FDynP = SrcMiscData%FDynP -ENDIF -IF (ALLOCATED(SrcMiscData%vrel)) THEN - i1_l = LBOUND(SrcMiscData%vrel,1) - i1_u = UBOUND(SrcMiscData%vrel,1) - i2_l = LBOUND(SrcMiscData%vrel,2) - i2_u = UBOUND(SrcMiscData%vrel,2) - IF (.NOT. ALLOCATED(DstMiscData%vrel)) THEN - ALLOCATE(DstMiscData%vrel(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%vrel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%vrel = SrcMiscData%vrel -ENDIF -IF (ALLOCATED(SrcMiscData%nodeInWater)) THEN - i1_l = LBOUND(SrcMiscData%nodeInWater,1) - i1_u = UBOUND(SrcMiscData%nodeInWater,1) - IF (.NOT. ALLOCATED(DstMiscData%nodeInWater)) THEN - ALLOCATE(DstMiscData%nodeInWater(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%nodeInWater.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%nodeInWater = SrcMiscData%nodeInWater -ENDIF -IF (ALLOCATED(SrcMiscData%memberLoads)) THEN - i1_l = LBOUND(SrcMiscData%memberLoads,1) - i1_u = UBOUND(SrcMiscData%memberLoads,1) - IF (.NOT. ALLOCATED(DstMiscData%memberLoads)) THEN - ALLOCATE(DstMiscData%memberLoads(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%memberLoads.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%memberLoads,1), UBOUND(SrcMiscData%memberLoads,1) - CALL Morison_Copymemberloads( SrcMiscData%memberLoads(i1), DstMiscData%memberLoads(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcMiscData%F_B_End)) THEN - i1_l = LBOUND(SrcMiscData%F_B_End,1) - i1_u = UBOUND(SrcMiscData%F_B_End,1) - i2_l = LBOUND(SrcMiscData%F_B_End,2) - i2_u = UBOUND(SrcMiscData%F_B_End,2) - IF (.NOT. ALLOCATED(DstMiscData%F_B_End)) THEN - ALLOCATE(DstMiscData%F_B_End(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_B_End.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%F_B_End = SrcMiscData%F_B_End -ENDIF -IF (ALLOCATED(SrcMiscData%F_D_End)) THEN - i1_l = LBOUND(SrcMiscData%F_D_End,1) - i1_u = UBOUND(SrcMiscData%F_D_End,1) - i2_l = LBOUND(SrcMiscData%F_D_End,2) - i2_u = UBOUND(SrcMiscData%F_D_End,2) - IF (.NOT. ALLOCATED(DstMiscData%F_D_End)) THEN - ALLOCATE(DstMiscData%F_D_End(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_D_End.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%F_D_End = SrcMiscData%F_D_End -ENDIF -IF (ALLOCATED(SrcMiscData%F_I_End)) THEN - i1_l = LBOUND(SrcMiscData%F_I_End,1) - i1_u = UBOUND(SrcMiscData%F_I_End,1) - i2_l = LBOUND(SrcMiscData%F_I_End,2) - i2_u = UBOUND(SrcMiscData%F_I_End,2) - IF (.NOT. ALLOCATED(DstMiscData%F_I_End)) THEN - ALLOCATE(DstMiscData%F_I_End(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_I_End.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%F_I_End = SrcMiscData%F_I_End -ENDIF -IF (ALLOCATED(SrcMiscData%F_IMG_End)) THEN - i1_l = LBOUND(SrcMiscData%F_IMG_End,1) - i1_u = UBOUND(SrcMiscData%F_IMG_End,1) - i2_l = LBOUND(SrcMiscData%F_IMG_End,2) - i2_u = UBOUND(SrcMiscData%F_IMG_End,2) - IF (.NOT. ALLOCATED(DstMiscData%F_IMG_End)) THEN - ALLOCATE(DstMiscData%F_IMG_End(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_IMG_End.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%F_IMG_End = SrcMiscData%F_IMG_End -ENDIF -IF (ALLOCATED(SrcMiscData%F_A_End)) THEN - i1_l = LBOUND(SrcMiscData%F_A_End,1) - i1_u = UBOUND(SrcMiscData%F_A_End,1) - i2_l = LBOUND(SrcMiscData%F_A_End,2) - i2_u = UBOUND(SrcMiscData%F_A_End,2) - IF (.NOT. ALLOCATED(DstMiscData%F_A_End)) THEN - ALLOCATE(DstMiscData%F_A_End(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_A_End.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%F_A_End = SrcMiscData%F_A_End -ENDIF -IF (ALLOCATED(SrcMiscData%F_BF_End)) THEN - i1_l = LBOUND(SrcMiscData%F_BF_End,1) - i1_u = UBOUND(SrcMiscData%F_BF_End,1) - i2_l = LBOUND(SrcMiscData%F_BF_End,2) - i2_u = UBOUND(SrcMiscData%F_BF_End,2) - IF (.NOT. ALLOCATED(DstMiscData%F_BF_End)) THEN - ALLOCATE(DstMiscData%F_BF_End(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_BF_End.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%F_BF_End = SrcMiscData%F_BF_End -ENDIF - DstMiscData%LastIndWave = SrcMiscData%LastIndWave - CALL NWTC_Library_Copymeshmaptype( SrcMiscData%VisMeshMap, DstMiscData%VisMeshMap, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE Morison_CopyMisc - - SUBROUTINE Morison_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(Morison_MiscVarType), INTENT(INOUT) :: MiscData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_DestroyMisc' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(MiscData%FV)) THEN - DEALLOCATE(MiscData%FV) -ENDIF -IF (ALLOCATED(MiscData%FA)) THEN - DEALLOCATE(MiscData%FA) -ENDIF -IF (ALLOCATED(MiscData%FDynP)) THEN - DEALLOCATE(MiscData%FDynP) -ENDIF -IF (ALLOCATED(MiscData%vrel)) THEN - DEALLOCATE(MiscData%vrel) -ENDIF -IF (ALLOCATED(MiscData%nodeInWater)) THEN - DEALLOCATE(MiscData%nodeInWater) -ENDIF -IF (ALLOCATED(MiscData%memberLoads)) THEN -DO i1 = LBOUND(MiscData%memberLoads,1), UBOUND(MiscData%memberLoads,1) - CALL Morison_Destroymemberloads( MiscData%memberLoads(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MiscData%memberLoads) -ENDIF -IF (ALLOCATED(MiscData%F_B_End)) THEN - DEALLOCATE(MiscData%F_B_End) -ENDIF -IF (ALLOCATED(MiscData%F_D_End)) THEN - DEALLOCATE(MiscData%F_D_End) -ENDIF -IF (ALLOCATED(MiscData%F_I_End)) THEN - DEALLOCATE(MiscData%F_I_End) -ENDIF -IF (ALLOCATED(MiscData%F_IMG_End)) THEN - DEALLOCATE(MiscData%F_IMG_End) -ENDIF -IF (ALLOCATED(MiscData%F_A_End)) THEN - DEALLOCATE(MiscData%F_A_End) -ENDIF -IF (ALLOCATED(MiscData%F_BF_End)) THEN - DEALLOCATE(MiscData%F_BF_End) -ENDIF - CALL NWTC_Library_Destroymeshmaptype( MiscData%VisMeshMap, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE Morison_DestroyMisc - - SUBROUTINE Morison_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(Morison_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 = 'Morison_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 ! FV allocated yes/no - IF ( ALLOCATED(InData%FV) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! FV upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%FV) ! FV - END IF - Int_BufSz = Int_BufSz + 1 ! FA allocated yes/no - IF ( ALLOCATED(InData%FA) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! FA upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%FA) ! FA - END IF - Int_BufSz = Int_BufSz + 1 ! FDynP allocated yes/no - IF ( ALLOCATED(InData%FDynP) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! FDynP upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%FDynP) ! FDynP - END IF - Int_BufSz = Int_BufSz + 1 ! vrel allocated yes/no - IF ( ALLOCATED(InData%vrel) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! vrel upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%vrel) ! vrel - END IF - Int_BufSz = Int_BufSz + 1 ! nodeInWater allocated yes/no - IF ( ALLOCATED(InData%nodeInWater) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! nodeInWater upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%nodeInWater) ! nodeInWater - END IF - Int_BufSz = Int_BufSz + 1 ! memberLoads allocated yes/no - IF ( ALLOCATED(InData%memberLoads) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! memberLoads upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%memberLoads,1), UBOUND(InData%memberLoads,1) - Int_BufSz = Int_BufSz + 3 ! memberLoads: size of buffers for each call to pack subtype - CALL Morison_Packmemberloads( Re_Buf, Db_Buf, Int_Buf, InData%memberLoads(i1), ErrStat2, ErrMsg2, .TRUE. ) ! memberLoads - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! memberLoads - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! memberLoads - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! memberLoads - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! F_B_End allocated yes/no - IF ( ALLOCATED(InData%F_B_End) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! F_B_End upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_B_End) ! F_B_End - END IF - Int_BufSz = Int_BufSz + 1 ! F_D_End allocated yes/no - IF ( ALLOCATED(InData%F_D_End) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! F_D_End upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_D_End) ! F_D_End - END IF - Int_BufSz = Int_BufSz + 1 ! F_I_End allocated yes/no - IF ( ALLOCATED(InData%F_I_End) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! F_I_End upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_I_End) ! F_I_End - END IF - Int_BufSz = Int_BufSz + 1 ! F_IMG_End allocated yes/no - IF ( ALLOCATED(InData%F_IMG_End) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! F_IMG_End upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_IMG_End) ! F_IMG_End - END IF - Int_BufSz = Int_BufSz + 1 ! F_A_End allocated yes/no - IF ( ALLOCATED(InData%F_A_End) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! F_A_End upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_A_End) ! F_A_End - END IF - Int_BufSz = Int_BufSz + 1 ! F_BF_End allocated yes/no - IF ( ALLOCATED(InData%F_BF_End) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! F_BF_End upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_BF_End) ! F_BF_End - END IF - Int_BufSz = Int_BufSz + 1 ! LastIndWave - Int_BufSz = Int_BufSz + 3 ! VisMeshMap: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%VisMeshMap, ErrStat2, ErrMsg2, .TRUE. ) ! VisMeshMap - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! VisMeshMap - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! VisMeshMap - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! VisMeshMap - 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%FV) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FV,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FV,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FV,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FV,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%FV,2), UBOUND(InData%FV,2) - DO i1 = LBOUND(InData%FV,1), UBOUND(InData%FV,1) - ReKiBuf(Re_Xferred) = InData%FV(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%FA) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FA,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FA,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FA,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FA,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%FA,2), UBOUND(InData%FA,2) - DO i1 = LBOUND(InData%FA,1), UBOUND(InData%FA,1) - ReKiBuf(Re_Xferred) = InData%FA(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%FDynP) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FDynP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FDynP,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%FDynP,1), UBOUND(InData%FDynP,1) - ReKiBuf(Re_Xferred) = InData%FDynP(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%vrel) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%vrel,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%vrel,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%vrel,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%vrel,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%vrel,2), UBOUND(InData%vrel,2) - DO i1 = LBOUND(InData%vrel,1), UBOUND(InData%vrel,1) - ReKiBuf(Re_Xferred) = InData%vrel(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%nodeInWater) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%nodeInWater,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%nodeInWater,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%nodeInWater,1), UBOUND(InData%nodeInWater,1) - IntKiBuf(Int_Xferred) = InData%nodeInWater(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%memberLoads) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%memberLoads,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%memberLoads,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%memberLoads,1), UBOUND(InData%memberLoads,1) - CALL Morison_Packmemberloads( Re_Buf, Db_Buf, Int_Buf, InData%memberLoads(i1), ErrStat2, ErrMsg2, OnlySize ) ! memberLoads - 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%F_B_End) ) THEN - 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_B_End,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_B_End,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_B_End,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_B_End,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%F_B_End,2), UBOUND(InData%F_B_End,2) - DO i1 = LBOUND(InData%F_B_End,1), UBOUND(InData%F_B_End,1) - ReKiBuf(Re_Xferred) = InData%F_B_End(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%F_D_End) ) THEN - 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_D_End,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_D_End,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_D_End,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_D_End,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%F_D_End,2), UBOUND(InData%F_D_End,2) - DO i1 = LBOUND(InData%F_D_End,1), UBOUND(InData%F_D_End,1) - ReKiBuf(Re_Xferred) = InData%F_D_End(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%F_I_End) ) THEN - 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_I_End,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_I_End,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_I_End,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_I_End,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%F_I_End,2), UBOUND(InData%F_I_End,2) - DO i1 = LBOUND(InData%F_I_End,1), UBOUND(InData%F_I_End,1) - ReKiBuf(Re_Xferred) = InData%F_I_End(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%F_IMG_End) ) THEN - 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_IMG_End,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_IMG_End,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_IMG_End,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_IMG_End,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%F_IMG_End,2), UBOUND(InData%F_IMG_End,2) - DO i1 = LBOUND(InData%F_IMG_End,1), UBOUND(InData%F_IMG_End,1) - ReKiBuf(Re_Xferred) = InData%F_IMG_End(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%F_A_End) ) THEN - 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_A_End,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_A_End,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_A_End,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_A_End,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%F_A_End,2), UBOUND(InData%F_A_End,2) - DO i1 = LBOUND(InData%F_A_End,1), UBOUND(InData%F_A_End,1) - ReKiBuf(Re_Xferred) = InData%F_A_End(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%F_BF_End) ) THEN - 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_BF_End,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_BF_End,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_BF_End,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_BF_End,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%F_BF_End,2), UBOUND(InData%F_BF_End,2) - DO i1 = LBOUND(InData%F_BF_End,1), UBOUND(InData%F_BF_End,1) - ReKiBuf(Re_Xferred) = InData%F_BF_End(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%LastIndWave - Int_Xferred = Int_Xferred + 1 - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%VisMeshMap, ErrStat2, ErrMsg2, OnlySize ) ! VisMeshMap - 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 Morison_PackMisc - - SUBROUTINE Morison_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(Morison_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 = 'Morison_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 ! FV not allocated - Int_Xferred = Int_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%FV)) DEALLOCATE(OutData%FV) - ALLOCATE(OutData%FV(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FV.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%FV,2), UBOUND(OutData%FV,2) - DO i1 = LBOUND(OutData%FV,1), UBOUND(OutData%FV,1) - OutData%FV(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FA not allocated - Int_Xferred = Int_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%FA)) DEALLOCATE(OutData%FA) - ALLOCATE(OutData%FA(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FA.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%FA,2), UBOUND(OutData%FA,2) - DO i1 = LBOUND(OutData%FA,1), UBOUND(OutData%FA,1) - OutData%FA(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FDynP not allocated - Int_Xferred = Int_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%FDynP)) DEALLOCATE(OutData%FDynP) - ALLOCATE(OutData%FDynP(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FDynP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%FDynP,1), UBOUND(OutData%FDynP,1) - OutData%FDynP(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! vrel not allocated - Int_Xferred = Int_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%vrel)) DEALLOCATE(OutData%vrel) - ALLOCATE(OutData%vrel(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%vrel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%vrel,2), UBOUND(OutData%vrel,2) - DO i1 = LBOUND(OutData%vrel,1), UBOUND(OutData%vrel,1) - OutData%vrel(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! nodeInWater not allocated - Int_Xferred = Int_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%nodeInWater)) DEALLOCATE(OutData%nodeInWater) - ALLOCATE(OutData%nodeInWater(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%nodeInWater.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%nodeInWater,1), UBOUND(OutData%nodeInWater,1) - OutData%nodeInWater(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! memberLoads not allocated - Int_Xferred = Int_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%memberLoads)) DEALLOCATE(OutData%memberLoads) - ALLOCATE(OutData%memberLoads(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%memberLoads.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%memberLoads,1), UBOUND(OutData%memberLoads,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 Morison_Unpackmemberloads( Re_Buf, Db_Buf, Int_Buf, OutData%memberLoads(i1), ErrStat2, ErrMsg2 ) ! memberLoads - 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 ! F_B_End not allocated - Int_Xferred = Int_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_B_End)) DEALLOCATE(OutData%F_B_End) - ALLOCATE(OutData%F_B_End(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_B_End.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%F_B_End,2), UBOUND(OutData%F_B_End,2) - DO i1 = LBOUND(OutData%F_B_End,1), UBOUND(OutData%F_B_End,1) - OutData%F_B_End(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_D_End not allocated - Int_Xferred = Int_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_D_End)) DEALLOCATE(OutData%F_D_End) - ALLOCATE(OutData%F_D_End(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_D_End.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%F_D_End,2), UBOUND(OutData%F_D_End,2) - DO i1 = LBOUND(OutData%F_D_End,1), UBOUND(OutData%F_D_End,1) - OutData%F_D_End(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_I_End not allocated - Int_Xferred = Int_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_I_End)) DEALLOCATE(OutData%F_I_End) - ALLOCATE(OutData%F_I_End(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_I_End.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%F_I_End,2), UBOUND(OutData%F_I_End,2) - DO i1 = LBOUND(OutData%F_I_End,1), UBOUND(OutData%F_I_End,1) - OutData%F_I_End(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_IMG_End not allocated - Int_Xferred = Int_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_IMG_End)) DEALLOCATE(OutData%F_IMG_End) - ALLOCATE(OutData%F_IMG_End(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_IMG_End.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%F_IMG_End,2), UBOUND(OutData%F_IMG_End,2) - DO i1 = LBOUND(OutData%F_IMG_End,1), UBOUND(OutData%F_IMG_End,1) - OutData%F_IMG_End(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_A_End not allocated - Int_Xferred = Int_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_A_End)) DEALLOCATE(OutData%F_A_End) - ALLOCATE(OutData%F_A_End(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_A_End.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%F_A_End,2), UBOUND(OutData%F_A_End,2) - DO i1 = LBOUND(OutData%F_A_End,1), UBOUND(OutData%F_A_End,1) - OutData%F_A_End(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_BF_End not allocated - Int_Xferred = Int_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_BF_End)) DEALLOCATE(OutData%F_BF_End) - ALLOCATE(OutData%F_BF_End(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_BF_End.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%F_BF_End,2), UBOUND(OutData%F_BF_End,2) - DO i1 = LBOUND(OutData%F_BF_End,1), UBOUND(OutData%F_BF_End,1) - OutData%F_BF_End(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%LastIndWave = IntKiBuf(Int_Xferred) - 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_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%VisMeshMap, ErrStat2, ErrMsg2 ) ! VisMeshMap - 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 Morison_UnPackMisc - - SUBROUTINE Morison_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Morison_ParameterType), INTENT(IN) :: SrcParamData - TYPE(Morison_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) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_CopyParam' -! + ErrMsg = '' + DstFilledGroupTypeData%FillNumM = SrcFilledGroupTypeData%FillNumM + if (allocated(SrcFilledGroupTypeData%FillMList)) then + LB(1:1) = lbound(SrcFilledGroupTypeData%FillMList) + UB(1:1) = ubound(SrcFilledGroupTypeData%FillMList) + if (.not. allocated(DstFilledGroupTypeData%FillMList)) then + allocate(DstFilledGroupTypeData%FillMList(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstFilledGroupTypeData%FillMList.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstFilledGroupTypeData%FillMList = SrcFilledGroupTypeData%FillMList + end if + DstFilledGroupTypeData%FillFSLoc = SrcFilledGroupTypeData%FillFSLoc + DstFilledGroupTypeData%FillDensChr = SrcFilledGroupTypeData%FillDensChr + DstFilledGroupTypeData%FillDens = SrcFilledGroupTypeData%FillDens +end subroutine + +subroutine Morison_DestroyFilledGroupType(FilledGroupTypeData, ErrStat, ErrMsg) + type(Morison_FilledGroupType), intent(inout) :: FilledGroupTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Morison_DestroyFilledGroupType' ErrStat = ErrID_None - ErrMsg = "" - DstParamData%DT = SrcParamData%DT - DstParamData%Gravity = SrcParamData%Gravity - DstParamData%WtrDens = SrcParamData%WtrDens - DstParamData%WtrDpth = SrcParamData%WtrDpth - DstParamData%MSL2SWL = SrcParamData%MSL2SWL - DstParamData%NMembers = SrcParamData%NMembers -IF (ALLOCATED(SrcParamData%Members)) THEN - i1_l = LBOUND(SrcParamData%Members,1) - i1_u = UBOUND(SrcParamData%Members,1) - IF (.NOT. ALLOCATED(DstParamData%Members)) THEN - ALLOCATE(DstParamData%Members(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Members.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcParamData%Members,1), UBOUND(SrcParamData%Members,1) - CALL Morison_Copymembertype( SrcParamData%Members(i1), DstParamData%Members(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - DstParamData%NNodes = SrcParamData%NNodes - DstParamData%NJoints = SrcParamData%NJoints -IF (ALLOCATED(SrcParamData%I_MG_End)) THEN - i1_l = LBOUND(SrcParamData%I_MG_End,1) - i1_u = UBOUND(SrcParamData%I_MG_End,1) - i2_l = LBOUND(SrcParamData%I_MG_End,2) - i2_u = UBOUND(SrcParamData%I_MG_End,2) - i3_l = LBOUND(SrcParamData%I_MG_End,3) - i3_u = UBOUND(SrcParamData%I_MG_End,3) - IF (.NOT. ALLOCATED(DstParamData%I_MG_End)) THEN - ALLOCATE(DstParamData%I_MG_End(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%I_MG_End.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%I_MG_End = SrcParamData%I_MG_End -ENDIF -IF (ALLOCATED(SrcParamData%An_End)) THEN - i1_l = LBOUND(SrcParamData%An_End,1) - i1_u = UBOUND(SrcParamData%An_End,1) - i2_l = LBOUND(SrcParamData%An_End,2) - i2_u = UBOUND(SrcParamData%An_End,2) - IF (.NOT. ALLOCATED(DstParamData%An_End)) THEN - ALLOCATE(DstParamData%An_End(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%An_End.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%An_End = SrcParamData%An_End -ENDIF -IF (ALLOCATED(SrcParamData%DragConst_End)) THEN - i1_l = LBOUND(SrcParamData%DragConst_End,1) - i1_u = UBOUND(SrcParamData%DragConst_End,1) - IF (.NOT. ALLOCATED(DstParamData%DragConst_End)) THEN - ALLOCATE(DstParamData%DragConst_End(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%DragConst_End.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%DragConst_End = SrcParamData%DragConst_End -ENDIF -IF (ALLOCATED(SrcParamData%F_WMG_End)) THEN - i1_l = LBOUND(SrcParamData%F_WMG_End,1) - i1_u = UBOUND(SrcParamData%F_WMG_End,1) - i2_l = LBOUND(SrcParamData%F_WMG_End,2) - i2_u = UBOUND(SrcParamData%F_WMG_End,2) - IF (.NOT. ALLOCATED(DstParamData%F_WMG_End)) THEN - ALLOCATE(DstParamData%F_WMG_End(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%F_WMG_End.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%F_WMG_End = SrcParamData%F_WMG_End -ENDIF -IF (ALLOCATED(SrcParamData%DP_Const_End)) THEN - i1_l = LBOUND(SrcParamData%DP_Const_End,1) - i1_u = UBOUND(SrcParamData%DP_Const_End,1) - i2_l = LBOUND(SrcParamData%DP_Const_End,2) - i2_u = UBOUND(SrcParamData%DP_Const_End,2) - IF (.NOT. ALLOCATED(DstParamData%DP_Const_End)) THEN - ALLOCATE(DstParamData%DP_Const_End(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%DP_Const_End.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%DP_Const_End = SrcParamData%DP_Const_End -ENDIF -IF (ALLOCATED(SrcParamData%Mass_MG_End)) THEN - i1_l = LBOUND(SrcParamData%Mass_MG_End,1) - i1_u = UBOUND(SrcParamData%Mass_MG_End,1) - IF (.NOT. ALLOCATED(DstParamData%Mass_MG_End)) THEN - ALLOCATE(DstParamData%Mass_MG_End(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Mass_MG_End.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Mass_MG_End = SrcParamData%Mass_MG_End -ENDIF -IF (ALLOCATED(SrcParamData%AM_End)) THEN - i1_l = LBOUND(SrcParamData%AM_End,1) - i1_u = UBOUND(SrcParamData%AM_End,1) - i2_l = LBOUND(SrcParamData%AM_End,2) - i2_u = UBOUND(SrcParamData%AM_End,2) - i3_l = LBOUND(SrcParamData%AM_End,3) - i3_u = UBOUND(SrcParamData%AM_End,3) - IF (.NOT. ALLOCATED(DstParamData%AM_End)) THEN - ALLOCATE(DstParamData%AM_End(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AM_End.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%AM_End = SrcParamData%AM_End -ENDIF -IF (ALLOCATED(SrcParamData%WaveVel)) THEN - i1_l = LBOUND(SrcParamData%WaveVel,1) - i1_u = UBOUND(SrcParamData%WaveVel,1) - i2_l = LBOUND(SrcParamData%WaveVel,2) - i2_u = UBOUND(SrcParamData%WaveVel,2) - i3_l = LBOUND(SrcParamData%WaveVel,3) - i3_u = UBOUND(SrcParamData%WaveVel,3) - IF (.NOT. ALLOCATED(DstParamData%WaveVel)) THEN - ALLOCATE(DstParamData%WaveVel(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WaveVel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%WaveVel = SrcParamData%WaveVel -ENDIF -IF (ALLOCATED(SrcParamData%WaveAcc)) THEN - i1_l = LBOUND(SrcParamData%WaveAcc,1) - i1_u = UBOUND(SrcParamData%WaveAcc,1) - i2_l = LBOUND(SrcParamData%WaveAcc,2) - i2_u = UBOUND(SrcParamData%WaveAcc,2) - i3_l = LBOUND(SrcParamData%WaveAcc,3) - i3_u = UBOUND(SrcParamData%WaveAcc,3) - IF (.NOT. ALLOCATED(DstParamData%WaveAcc)) THEN - ALLOCATE(DstParamData%WaveAcc(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WaveAcc.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%WaveAcc = SrcParamData%WaveAcc -ENDIF -IF (ALLOCATED(SrcParamData%WaveDynP)) THEN - i1_l = LBOUND(SrcParamData%WaveDynP,1) - i1_u = UBOUND(SrcParamData%WaveDynP,1) - i2_l = LBOUND(SrcParamData%WaveDynP,2) - i2_u = UBOUND(SrcParamData%WaveDynP,2) - IF (.NOT. ALLOCATED(DstParamData%WaveDynP)) THEN - ALLOCATE(DstParamData%WaveDynP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WaveDynP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%WaveDynP = SrcParamData%WaveDynP -ENDIF -IF (ALLOCATED(SrcParamData%WaveTime)) THEN - i1_l = LBOUND(SrcParamData%WaveTime,1) - i1_u = UBOUND(SrcParamData%WaveTime,1) - IF (.NOT. ALLOCATED(DstParamData%WaveTime)) THEN - ALLOCATE(DstParamData%WaveTime(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WaveTime.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%WaveTime = SrcParamData%WaveTime -ENDIF -IF (ALLOCATED(SrcParamData%nodeInWater)) THEN - i1_l = LBOUND(SrcParamData%nodeInWater,1) - i1_u = UBOUND(SrcParamData%nodeInWater,1) - i2_l = LBOUND(SrcParamData%nodeInWater,2) - i2_u = UBOUND(SrcParamData%nodeInWater,2) - IF (.NOT. ALLOCATED(DstParamData%nodeInWater)) THEN - ALLOCATE(DstParamData%nodeInWater(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%nodeInWater.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%nodeInWater = SrcParamData%nodeInWater -ENDIF - DstParamData%NStepWave = SrcParamData%NStepWave - DstParamData%NMOutputs = SrcParamData%NMOutputs -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 Morison_Copymoutput( SrcParamData%MOutLst(i1), DstParamData%MOutLst(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - DstParamData%NJOutputs = SrcParamData%NJOutputs -IF (ALLOCATED(SrcParamData%JOutLst)) THEN - i1_l = LBOUND(SrcParamData%JOutLst,1) - i1_u = UBOUND(SrcParamData%JOutLst,1) - IF (.NOT. ALLOCATED(DstParamData%JOutLst)) THEN - ALLOCATE(DstParamData%JOutLst(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%JOutLst.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcParamData%JOutLst,1), UBOUND(SrcParamData%JOutLst,1) - CALL Morison_Copyjoutput( SrcParamData%JOutLst(i1), DstParamData%JOutLst(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%NumOuts = SrcParamData%NumOuts - DstParamData%NumOutAll = SrcParamData%NumOutAll - DstParamData%OutSwtch = SrcParamData%OutSwtch - DstParamData%UnOutFile = SrcParamData%UnOutFile - DstParamData%OutFmt = SrcParamData%OutFmt - DstParamData%OutSFmt = SrcParamData%OutSFmt - DstParamData%Delim = SrcParamData%Delim - DstParamData%VisMeshes = SrcParamData%VisMeshes - END SUBROUTINE Morison_CopyParam - - SUBROUTINE Morison_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(Morison_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(ParamData%Members)) THEN -DO i1 = LBOUND(ParamData%Members,1), UBOUND(ParamData%Members,1) - CALL Morison_Destroymembertype( ParamData%Members(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ParamData%Members) -ENDIF -IF (ALLOCATED(ParamData%I_MG_End)) THEN - DEALLOCATE(ParamData%I_MG_End) -ENDIF -IF (ALLOCATED(ParamData%An_End)) THEN - DEALLOCATE(ParamData%An_End) -ENDIF -IF (ALLOCATED(ParamData%DragConst_End)) THEN - DEALLOCATE(ParamData%DragConst_End) -ENDIF -IF (ALLOCATED(ParamData%F_WMG_End)) THEN - DEALLOCATE(ParamData%F_WMG_End) -ENDIF -IF (ALLOCATED(ParamData%DP_Const_End)) THEN - DEALLOCATE(ParamData%DP_Const_End) -ENDIF -IF (ALLOCATED(ParamData%Mass_MG_End)) THEN - DEALLOCATE(ParamData%Mass_MG_End) -ENDIF -IF (ALLOCATED(ParamData%AM_End)) THEN - DEALLOCATE(ParamData%AM_End) -ENDIF -IF (ALLOCATED(ParamData%WaveVel)) THEN - DEALLOCATE(ParamData%WaveVel) -ENDIF -IF (ALLOCATED(ParamData%WaveAcc)) THEN - DEALLOCATE(ParamData%WaveAcc) -ENDIF -IF (ALLOCATED(ParamData%WaveDynP)) THEN - DEALLOCATE(ParamData%WaveDynP) -ENDIF -IF (ALLOCATED(ParamData%WaveTime)) THEN - DEALLOCATE(ParamData%WaveTime) -ENDIF -IF (ALLOCATED(ParamData%nodeInWater)) THEN - DEALLOCATE(ParamData%nodeInWater) -ENDIF -IF (ALLOCATED(ParamData%MOutLst)) THEN -DO i1 = LBOUND(ParamData%MOutLst,1), UBOUND(ParamData%MOutLst,1) - CALL Morison_Destroymoutput( ParamData%MOutLst(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ParamData%MOutLst) -ENDIF -IF (ALLOCATED(ParamData%JOutLst)) THEN -DO i1 = LBOUND(ParamData%JOutLst,1), UBOUND(ParamData%JOutLst,1) - CALL Morison_Destroyjoutput( ParamData%JOutLst(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ParamData%JOutLst) -ENDIF -IF (ALLOCATED(ParamData%OutParam)) THEN -DO i1 = LBOUND(ParamData%OutParam,1), UBOUND(ParamData%OutParam,1) - CALL NWTC_Library_Destroyoutparmtype( ParamData%OutParam(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ParamData%OutParam) -ENDIF - END SUBROUTINE Morison_DestroyParam - - SUBROUTINE Morison_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(Morison_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 = 'Morison_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 - Re_BufSz = Re_BufSz + 1 ! Gravity - Re_BufSz = Re_BufSz + 1 ! WtrDens - Re_BufSz = Re_BufSz + 1 ! WtrDpth - Re_BufSz = Re_BufSz + 1 ! MSL2SWL - Int_BufSz = Int_BufSz + 1 ! NMembers - Int_BufSz = Int_BufSz + 1 ! Members allocated yes/no - IF ( ALLOCATED(InData%Members) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Members upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%Members,1), UBOUND(InData%Members,1) - Int_BufSz = Int_BufSz + 3 ! Members: size of buffers for each call to pack subtype - CALL Morison_Packmembertype( Re_Buf, Db_Buf, Int_Buf, InData%Members(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Members - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Members - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Members - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Members - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! NNodes - Int_BufSz = Int_BufSz + 1 ! NJoints - Int_BufSz = Int_BufSz + 1 ! I_MG_End allocated yes/no - IF ( ALLOCATED(InData%I_MG_End) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! I_MG_End upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%I_MG_End) ! I_MG_End - END IF - Int_BufSz = Int_BufSz + 1 ! An_End allocated yes/no - IF ( ALLOCATED(InData%An_End) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! An_End upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%An_End) ! An_End - END IF - Int_BufSz = Int_BufSz + 1 ! DragConst_End allocated yes/no - IF ( ALLOCATED(InData%DragConst_End) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! DragConst_End upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%DragConst_End) ! DragConst_End - END IF - Int_BufSz = Int_BufSz + 1 ! F_WMG_End allocated yes/no - IF ( ALLOCATED(InData%F_WMG_End) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! F_WMG_End upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_WMG_End) ! F_WMG_End - END IF - Int_BufSz = Int_BufSz + 1 ! DP_Const_End allocated yes/no - IF ( ALLOCATED(InData%DP_Const_End) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! DP_Const_End upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%DP_Const_End) ! DP_Const_End - END IF - Int_BufSz = Int_BufSz + 1 ! Mass_MG_End allocated yes/no - IF ( ALLOCATED(InData%Mass_MG_End) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Mass_MG_End upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Mass_MG_End) ! Mass_MG_End - END IF - Int_BufSz = Int_BufSz + 1 ! AM_End allocated yes/no - IF ( ALLOCATED(InData%AM_End) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! AM_End upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AM_End) ! AM_End - END IF - Int_BufSz = Int_BufSz + 1 ! WaveVel allocated yes/no - IF ( ALLOCATED(InData%WaveVel) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! WaveVel upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveVel) ! WaveVel - END IF - Int_BufSz = Int_BufSz + 1 ! WaveAcc allocated yes/no - IF ( ALLOCATED(InData%WaveAcc) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! WaveAcc upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveAcc) ! WaveAcc - END IF - Int_BufSz = Int_BufSz + 1 ! WaveDynP allocated yes/no - IF ( ALLOCATED(InData%WaveDynP) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! WaveDynP upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveDynP) ! WaveDynP - END IF - Int_BufSz = Int_BufSz + 1 ! WaveTime allocated yes/no - IF ( ALLOCATED(InData%WaveTime) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WaveTime upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveTime) ! WaveTime - END IF - Int_BufSz = Int_BufSz + 1 ! nodeInWater allocated yes/no - IF ( ALLOCATED(InData%nodeInWater) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! nodeInWater upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%nodeInWater) ! nodeInWater - END IF - Int_BufSz = Int_BufSz + 1 ! NStepWave - Int_BufSz = Int_BufSz + 1 ! NMOutputs - 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 Morison_Packmoutput( 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 ! NJOutputs - Int_BufSz = Int_BufSz + 1 ! JOutLst allocated yes/no - IF ( ALLOCATED(InData%JOutLst) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! JOutLst upper/lower bounds for each dimension - DO i1 = LBOUND(InData%JOutLst,1), UBOUND(InData%JOutLst,1) - Int_BufSz = Int_BufSz + 3 ! JOutLst: size of buffers for each call to pack subtype - CALL Morison_Packjoutput( Re_Buf, Db_Buf, Int_Buf, InData%JOutLst(i1), ErrStat2, ErrMsg2, .TRUE. ) ! JOutLst - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! JOutLst - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! JOutLst - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! JOutLst - 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 ! NumOuts - Int_BufSz = Int_BufSz + 1 ! NumOutAll - Int_BufSz = Int_BufSz + 1 ! OutSwtch - Int_BufSz = Int_BufSz + 1 ! UnOutFile - Int_BufSz = Int_BufSz + 1*LEN(InData%OutFmt) ! OutFmt - Int_BufSz = Int_BufSz + 1*LEN(InData%OutSFmt) ! OutSFmt - Int_BufSz = Int_BufSz + 1*LEN(InData%Delim) ! Delim - Int_BufSz = Int_BufSz + 1 ! VisMeshes - 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 - ReKiBuf(Re_Xferred) = InData%Gravity - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WtrDens - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WtrDpth - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MSL2SWL - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NMembers - Int_Xferred = Int_Xferred + 1 - 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 - - DO i1 = LBOUND(InData%Members,1), UBOUND(InData%Members,1) - CALL Morison_Packmembertype( Re_Buf, Db_Buf, Int_Buf, InData%Members(i1), ErrStat2, ErrMsg2, OnlySize ) ! Members - 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%NNodes - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NJoints - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%I_MG_End) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%I_MG_End,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%I_MG_End,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%I_MG_End,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%I_MG_End,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%I_MG_End,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%I_MG_End,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%I_MG_End,3), UBOUND(InData%I_MG_End,3) - DO i2 = LBOUND(InData%I_MG_End,2), UBOUND(InData%I_MG_End,2) - DO i1 = LBOUND(InData%I_MG_End,1), UBOUND(InData%I_MG_End,1) - ReKiBuf(Re_Xferred) = InData%I_MG_End(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%An_End) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%An_End,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%An_End,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%An_End,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%An_End,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%An_End,2), UBOUND(InData%An_End,2) - DO i1 = LBOUND(InData%An_End,1), UBOUND(InData%An_End,1) - ReKiBuf(Re_Xferred) = InData%An_End(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%DragConst_End) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DragConst_End,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DragConst_End,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%DragConst_End,1), UBOUND(InData%DragConst_End,1) - ReKiBuf(Re_Xferred) = InData%DragConst_End(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%F_WMG_End) ) THEN - 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_WMG_End,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_WMG_End,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_WMG_End,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_WMG_End,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%F_WMG_End,2), UBOUND(InData%F_WMG_End,2) - DO i1 = LBOUND(InData%F_WMG_End,1), UBOUND(InData%F_WMG_End,1) - ReKiBuf(Re_Xferred) = InData%F_WMG_End(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%DP_Const_End) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DP_Const_End,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DP_Const_End,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DP_Const_End,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DP_Const_End,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%DP_Const_End,2), UBOUND(InData%DP_Const_End,2) - DO i1 = LBOUND(InData%DP_Const_End,1), UBOUND(InData%DP_Const_End,1) - ReKiBuf(Re_Xferred) = InData%DP_Const_End(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Mass_MG_End) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Mass_MG_End,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Mass_MG_End,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Mass_MG_End,1), UBOUND(InData%Mass_MG_End,1) - ReKiBuf(Re_Xferred) = InData%Mass_MG_End(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AM_End) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AM_End,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AM_End,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AM_End,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AM_End,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AM_End,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AM_End,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%AM_End,3), UBOUND(InData%AM_End,3) - DO i2 = LBOUND(InData%AM_End,2), UBOUND(InData%AM_End,2) - DO i1 = LBOUND(InData%AM_End,1), UBOUND(InData%AM_End,1) - ReKiBuf(Re_Xferred) = InData%AM_End(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveVel) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%WaveVel,3), UBOUND(InData%WaveVel,3) - DO i2 = LBOUND(InData%WaveVel,2), UBOUND(InData%WaveVel,2) - DO i1 = LBOUND(InData%WaveVel,1), UBOUND(InData%WaveVel,1) - ReKiBuf(Re_Xferred) = InData%WaveVel(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveAcc) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%WaveAcc,3), UBOUND(InData%WaveAcc,3) - DO i2 = LBOUND(InData%WaveAcc,2), UBOUND(InData%WaveAcc,2) - DO i1 = LBOUND(InData%WaveAcc,1), UBOUND(InData%WaveAcc,1) - ReKiBuf(Re_Xferred) = InData%WaveAcc(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveDynP) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveDynP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDynP,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveDynP,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDynP,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%WaveDynP,2), UBOUND(InData%WaveDynP,2) - DO i1 = LBOUND(InData%WaveDynP,1), UBOUND(InData%WaveDynP,1) - ReKiBuf(Re_Xferred) = InData%WaveDynP(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveTime) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveTime,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveTime,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WaveTime,1), UBOUND(InData%WaveTime,1) - ReKiBuf(Re_Xferred) = InData%WaveTime(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%nodeInWater) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%nodeInWater,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%nodeInWater,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%nodeInWater,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%nodeInWater,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%nodeInWater,2), UBOUND(InData%nodeInWater,2) - DO i1 = LBOUND(InData%nodeInWater,1), UBOUND(InData%nodeInWater,1) - IntKiBuf(Int_Xferred) = InData%nodeInWater(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NStepWave - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NMOutputs - Int_Xferred = Int_Xferred + 1 - 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 Morison_Packmoutput( 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 - IntKiBuf(Int_Xferred) = InData%NJOutputs - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%JOutLst) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%JOutLst,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%JOutLst,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%JOutLst,1), UBOUND(InData%JOutLst,1) - CALL Morison_Packjoutput( Re_Buf, Db_Buf, Int_Buf, InData%JOutLst(i1), ErrStat2, ErrMsg2, OnlySize ) ! JOutLst - 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) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumOutAll - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%OutSwtch - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%UnOutFile - 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 - DO I = 1, LEN(InData%OutSFmt) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutSFmt(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - 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%VisMeshes, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Morison_PackParam - - SUBROUTINE Morison_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(Morison_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) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_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%Gravity = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%WtrDens = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%WtrDpth = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MSL2SWL = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NMembers = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - 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 - IF (ALLOCATED(OutData%Members)) DEALLOCATE(OutData%Members) - ALLOCATE(OutData%Members(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Members.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Members,1), UBOUND(OutData%Members,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 Morison_Unpackmembertype( Re_Buf, Db_Buf, Int_Buf, OutData%Members(i1), ErrStat2, ErrMsg2 ) ! Members - 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%NNodes = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NJoints = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! I_MG_End not allocated - Int_Xferred = Int_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%I_MG_End)) DEALLOCATE(OutData%I_MG_End) - ALLOCATE(OutData%I_MG_End(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%I_MG_End.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%I_MG_End,3), UBOUND(OutData%I_MG_End,3) - DO i2 = LBOUND(OutData%I_MG_End,2), UBOUND(OutData%I_MG_End,2) - DO i1 = LBOUND(OutData%I_MG_End,1), UBOUND(OutData%I_MG_End,1) - OutData%I_MG_End(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 ! An_End not allocated - Int_Xferred = Int_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%An_End)) DEALLOCATE(OutData%An_End) - ALLOCATE(OutData%An_End(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%An_End.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%An_End,2), UBOUND(OutData%An_End,2) - DO i1 = LBOUND(OutData%An_End,1), UBOUND(OutData%An_End,1) - OutData%An_End(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DragConst_End not allocated - Int_Xferred = Int_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%DragConst_End)) DEALLOCATE(OutData%DragConst_End) - ALLOCATE(OutData%DragConst_End(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DragConst_End.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%DragConst_End,1), UBOUND(OutData%DragConst_End,1) - OutData%DragConst_End(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_WMG_End not allocated - Int_Xferred = Int_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_WMG_End)) DEALLOCATE(OutData%F_WMG_End) - ALLOCATE(OutData%F_WMG_End(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_WMG_End.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%F_WMG_End,2), UBOUND(OutData%F_WMG_End,2) - DO i1 = LBOUND(OutData%F_WMG_End,1), UBOUND(OutData%F_WMG_End,1) - OutData%F_WMG_End(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DP_Const_End not allocated - Int_Xferred = Int_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%DP_Const_End)) DEALLOCATE(OutData%DP_Const_End) - ALLOCATE(OutData%DP_Const_End(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DP_Const_End.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%DP_Const_End,2), UBOUND(OutData%DP_Const_End,2) - DO i1 = LBOUND(OutData%DP_Const_End,1), UBOUND(OutData%DP_Const_End,1) - OutData%DP_Const_End(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Mass_MG_End not allocated - Int_Xferred = Int_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%Mass_MG_End)) DEALLOCATE(OutData%Mass_MG_End) - ALLOCATE(OutData%Mass_MG_End(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Mass_MG_End.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Mass_MG_End,1), UBOUND(OutData%Mass_MG_End,1) - OutData%Mass_MG_End(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AM_End not allocated - Int_Xferred = Int_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%AM_End)) DEALLOCATE(OutData%AM_End) - ALLOCATE(OutData%AM_End(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%AM_End.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%AM_End,3), UBOUND(OutData%AM_End,3) - DO i2 = LBOUND(OutData%AM_End,2), UBOUND(OutData%AM_End,2) - DO i1 = LBOUND(OutData%AM_End,1), UBOUND(OutData%AM_End,1) - OutData%AM_End(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 ! WaveVel not allocated - Int_Xferred = Int_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%WaveVel)) DEALLOCATE(OutData%WaveVel) - ALLOCATE(OutData%WaveVel(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%WaveVel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%WaveVel,3), UBOUND(OutData%WaveVel,3) - DO i2 = LBOUND(OutData%WaveVel,2), UBOUND(OutData%WaveVel,2) - DO i1 = LBOUND(OutData%WaveVel,1), UBOUND(OutData%WaveVel,1) - OutData%WaveVel(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveAcc not allocated - Int_Xferred = Int_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%WaveAcc)) DEALLOCATE(OutData%WaveAcc) - ALLOCATE(OutData%WaveAcc(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%WaveAcc.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%WaveAcc,3), UBOUND(OutData%WaveAcc,3) - DO i2 = LBOUND(OutData%WaveAcc,2), UBOUND(OutData%WaveAcc,2) - DO i1 = LBOUND(OutData%WaveAcc,1), UBOUND(OutData%WaveAcc,1) - OutData%WaveAcc(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveDynP not allocated - Int_Xferred = Int_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%WaveDynP)) DEALLOCATE(OutData%WaveDynP) - ALLOCATE(OutData%WaveDynP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDynP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%WaveDynP,2), UBOUND(OutData%WaveDynP,2) - DO i1 = LBOUND(OutData%WaveDynP,1), UBOUND(OutData%WaveDynP,1) - OutData%WaveDynP(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveTime not allocated - Int_Xferred = Int_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%WaveTime)) DEALLOCATE(OutData%WaveTime) - ALLOCATE(OutData%WaveTime(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveTime.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WaveTime,1), UBOUND(OutData%WaveTime,1) - OutData%WaveTime(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! nodeInWater not allocated - Int_Xferred = Int_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%nodeInWater)) DEALLOCATE(OutData%nodeInWater) - ALLOCATE(OutData%nodeInWater(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%nodeInWater.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%nodeInWater,2), UBOUND(OutData%nodeInWater,2) - DO i1 = LBOUND(OutData%nodeInWater,1), UBOUND(OutData%nodeInWater,1) - OutData%nodeInWater(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - OutData%NStepWave = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NMOutputs = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - 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 Morison_Unpackmoutput( 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 - OutData%NJOutputs = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! JOutLst not allocated - Int_Xferred = Int_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%JOutLst)) DEALLOCATE(OutData%JOutLst) - ALLOCATE(OutData%JOutLst(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%JOutLst.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%JOutLst,1), UBOUND(OutData%JOutLst,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 Morison_Unpackjoutput( Re_Buf, Db_Buf, Int_Buf, OutData%JOutLst(i1), ErrStat2, ErrMsg2 ) ! JOutLst - 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%NumOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumOutAll = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%OutSwtch = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%UnOutFile = IntKiBuf(Int_Xferred) - 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 - DO I = 1, LEN(OutData%OutSFmt) - OutData%OutSFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%Delim) - OutData%Delim(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%VisMeshes = TRANSFER(IntKiBuf(Int_Xferred), OutData%VisMeshes) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Morison_UnPackParam - - SUBROUTINE Morison_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Morison_InputType), INTENT(INOUT) :: SrcInputData - TYPE(Morison_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 = 'Morison_CopyInput' -! + ErrMsg = '' + if (allocated(FilledGroupTypeData%FillMList)) then + deallocate(FilledGroupTypeData%FillMList) + end if +end subroutine + +subroutine Morison_PackFilledGroupType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Morison_FilledGroupType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Morison_PackFilledGroupType' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%FillNumM) + call RegPackAlloc(RF, InData%FillMList) + call RegPack(RF, InData%FillFSLoc) + call RegPack(RF, InData%FillDensChr) + call RegPack(RF, InData%FillDens) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Morison_UnPackFilledGroupType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Morison_FilledGroupType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Morison_UnPackFilledGroupType' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%FillNumM); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%FillMList); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FillFSLoc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FillDensChr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FillDens); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Morison_CopyCoefDpths(SrcCoefDpthsData, DstCoefDpthsData, CtrlCode, ErrStat, ErrMsg) + type(Morison_CoefDpths), intent(in) :: SrcCoefDpthsData + type(Morison_CoefDpths), intent(inout) :: DstCoefDpthsData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Morison_CopyCoefDpths' ErrStat = ErrID_None - ErrMsg = "" - CALL MeshCopy( SrcInputData%Mesh, DstInputData%Mesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE Morison_CopyInput - - SUBROUTINE Morison_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(Morison_InputType), INTENT(INOUT) :: InputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_DestroyInput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL MeshDestroy( InputData%Mesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE Morison_DestroyInput - - SUBROUTINE Morison_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(Morison_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 = 'Morison_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 ! Mesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%Mesh, 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 - 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%Mesh, 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 SUBROUTINE Morison_PackInput - - SUBROUTINE Morison_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(Morison_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 = 'Morison_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%Mesh, 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 SUBROUTINE Morison_UnPackInput - - SUBROUTINE Morison_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Morison_OutputType), INTENT(INOUT) :: SrcOutputData - TYPE(Morison_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 = 'Morison_CopyOutput' -! + ErrMsg = '' + DstCoefDpthsData%Dpth = SrcCoefDpthsData%Dpth + DstCoefDpthsData%DpthCd = SrcCoefDpthsData%DpthCd + DstCoefDpthsData%DpthCdMG = SrcCoefDpthsData%DpthCdMG + DstCoefDpthsData%DpthCa = SrcCoefDpthsData%DpthCa + DstCoefDpthsData%DpthCaMG = SrcCoefDpthsData%DpthCaMG + DstCoefDpthsData%DpthCp = SrcCoefDpthsData%DpthCp + DstCoefDpthsData%DpthCpMG = SrcCoefDpthsData%DpthCpMG + DstCoefDpthsData%DpthAxCd = SrcCoefDpthsData%DpthAxCd + DstCoefDpthsData%DpthAxCdMG = SrcCoefDpthsData%DpthAxCdMG + DstCoefDpthsData%DpthAxCa = SrcCoefDpthsData%DpthAxCa + DstCoefDpthsData%DpthAxCaMG = SrcCoefDpthsData%DpthAxCaMG + DstCoefDpthsData%DpthAxCp = SrcCoefDpthsData%DpthAxCp + DstCoefDpthsData%DpthAxCpMG = SrcCoefDpthsData%DpthAxCpMG + DstCoefDpthsData%DpthCb = SrcCoefDpthsData%DpthCb + DstCoefDpthsData%DpthCbMg = SrcCoefDpthsData%DpthCbMg + DstCoefDpthsData%DpthMCF = SrcCoefDpthsData%DpthMCF +end subroutine + +subroutine Morison_DestroyCoefDpths(CoefDpthsData, ErrStat, ErrMsg) + type(Morison_CoefDpths), intent(inout) :: CoefDpthsData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Morison_DestroyCoefDpths' ErrStat = ErrID_None - ErrMsg = "" - CALL MeshCopy( SrcOutputData%Mesh, DstOutputData%Mesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcOutputData%VisMesh, DstOutputData%VisMesh, 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 Morison_CopyOutput - - SUBROUTINE Morison_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(Morison_OutputType), INTENT(INOUT) :: OutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_DestroyOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL MeshDestroy( OutputData%Mesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( OutputData%VisMesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(OutputData%WriteOutput)) THEN - DEALLOCATE(OutputData%WriteOutput) -ENDIF - END SUBROUTINE Morison_DestroyOutput - - SUBROUTINE Morison_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(Morison_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 = 'Morison_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 ! Mesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%Mesh, 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 - Int_BufSz = Int_BufSz + 3 ! VisMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%VisMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! VisMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! VisMesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! VisMesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! VisMesh - 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%Mesh, 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 - CALL MeshPack( InData%VisMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! VisMesh - 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 Morison_PackOutput - - SUBROUTINE Morison_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(Morison_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 = 'Morison_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%Mesh, 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) - 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%VisMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! VisMesh - 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 Morison_UnPackOutput - - - SUBROUTINE Morison_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(Morison_InputType), INTENT(INOUT) :: u(:) ! Input at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Inputs - TYPE(Morison_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 + ErrMsg = '' +end subroutine + +subroutine Morison_PackCoefDpths(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Morison_CoefDpths), intent(in) :: InData + character(*), parameter :: RoutineName = 'Morison_PackCoefDpths' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%Dpth) + call RegPack(RF, InData%DpthCd) + call RegPack(RF, InData%DpthCdMG) + call RegPack(RF, InData%DpthCa) + call RegPack(RF, InData%DpthCaMG) + call RegPack(RF, InData%DpthCp) + call RegPack(RF, InData%DpthCpMG) + call RegPack(RF, InData%DpthAxCd) + call RegPack(RF, InData%DpthAxCdMG) + call RegPack(RF, InData%DpthAxCa) + call RegPack(RF, InData%DpthAxCaMG) + call RegPack(RF, InData%DpthAxCp) + call RegPack(RF, InData%DpthAxCpMG) + call RegPack(RF, InData%DpthCb) + call RegPack(RF, InData%DpthCbMg) + call RegPack(RF, InData%DpthMCF) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Morison_UnPackCoefDpths(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Morison_CoefDpths), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Morison_UnPackCoefDpths' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%Dpth); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DpthCd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DpthCdMG); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DpthCa); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DpthCaMG); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DpthCp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DpthCpMG); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DpthAxCd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DpthAxCdMG); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DpthAxCa); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DpthAxCaMG); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DpthAxCp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DpthAxCpMG); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DpthCb); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DpthCbMg); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DpthMCF); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Morison_CopyAxialCoefType(SrcAxialCoefTypeData, DstAxialCoefTypeData, CtrlCode, ErrStat, ErrMsg) + type(Morison_AxialCoefType), intent(in) :: SrcAxialCoefTypeData + type(Morison_AxialCoefType), intent(inout) :: DstAxialCoefTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Morison_CopyAxialCoefType' + ErrStat = ErrID_None + ErrMsg = '' + DstAxialCoefTypeData%AxCoefID = SrcAxialCoefTypeData%AxCoefID + DstAxialCoefTypeData%AxCd = SrcAxialCoefTypeData%AxCd + DstAxialCoefTypeData%AxCa = SrcAxialCoefTypeData%AxCa + DstAxialCoefTypeData%AxCp = SrcAxialCoefTypeData%AxCp + DstAxialCoefTypeData%AxVnCOff = SrcAxialCoefTypeData%AxVnCOff + DstAxialCoefTypeData%AxFDLoFSc = SrcAxialCoefTypeData%AxFDLoFSc + DstAxialCoefTypeData%AxFDMod = SrcAxialCoefTypeData%AxFDMod +end subroutine + +subroutine Morison_DestroyAxialCoefType(AxialCoefTypeData, ErrStat, ErrMsg) + type(Morison_AxialCoefType), intent(inout) :: AxialCoefTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Morison_DestroyAxialCoefType' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine Morison_PackAxialCoefType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Morison_AxialCoefType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Morison_PackAxialCoefType' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%AxCoefID) + call RegPack(RF, InData%AxCd) + call RegPack(RF, InData%AxCa) + call RegPack(RF, InData%AxCp) + call RegPack(RF, InData%AxVnCOff) + call RegPack(RF, InData%AxFDLoFSc) + call RegPack(RF, InData%AxFDMod) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Morison_UnPackAxialCoefType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Morison_AxialCoefType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Morison_UnPackAxialCoefType' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%AxCoefID); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AxCd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AxCa); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AxCp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AxVnCOff); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AxFDLoFSc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AxFDMod); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Morison_CopyMemberInputType(SrcMemberInputTypeData, DstMemberInputTypeData, CtrlCode, ErrStat, ErrMsg) + type(Morison_MemberInputType), intent(in) :: SrcMemberInputTypeData + type(Morison_MemberInputType), intent(inout) :: DstMemberInputTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'Morison_CopyMemberInputType' + ErrStat = ErrID_None + ErrMsg = '' + DstMemberInputTypeData%MemberID = SrcMemberInputTypeData%MemberID + if (allocated(SrcMemberInputTypeData%NodeIndx)) then + LB(1:1) = lbound(SrcMemberInputTypeData%NodeIndx) + UB(1:1) = ubound(SrcMemberInputTypeData%NodeIndx) + if (.not. allocated(DstMemberInputTypeData%NodeIndx)) then + allocate(DstMemberInputTypeData%NodeIndx(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberInputTypeData%NodeIndx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberInputTypeData%NodeIndx = SrcMemberInputTypeData%NodeIndx + end if + DstMemberInputTypeData%MJointID1 = SrcMemberInputTypeData%MJointID1 + DstMemberInputTypeData%MJointID2 = SrcMemberInputTypeData%MJointID2 + DstMemberInputTypeData%MJointID1Indx = SrcMemberInputTypeData%MJointID1Indx + DstMemberInputTypeData%MJointID2Indx = SrcMemberInputTypeData%MJointID2Indx + DstMemberInputTypeData%MPropSetID1 = SrcMemberInputTypeData%MPropSetID1 + DstMemberInputTypeData%MPropSetID2 = SrcMemberInputTypeData%MPropSetID2 + DstMemberInputTypeData%MPropSetID1Indx = SrcMemberInputTypeData%MPropSetID1Indx + DstMemberInputTypeData%MPropSetID2Indx = SrcMemberInputTypeData%MPropSetID2Indx + DstMemberInputTypeData%MDivSize = SrcMemberInputTypeData%MDivSize + DstMemberInputTypeData%MCoefMod = SrcMemberInputTypeData%MCoefMod + DstMemberInputTypeData%MHstLMod = SrcMemberInputTypeData%MHstLMod + DstMemberInputTypeData%MmbrCoefIDIndx = SrcMemberInputTypeData%MmbrCoefIDIndx + DstMemberInputTypeData%MmbrFilledIDIndx = SrcMemberInputTypeData%MmbrFilledIDIndx + DstMemberInputTypeData%PropPot = SrcMemberInputTypeData%PropPot + DstMemberInputTypeData%PropMCF = SrcMemberInputTypeData%PropMCF + DstMemberInputTypeData%NElements = SrcMemberInputTypeData%NElements + DstMemberInputTypeData%RefLength = SrcMemberInputTypeData%RefLength + DstMemberInputTypeData%dl = SrcMemberInputTypeData%dl +end subroutine + +subroutine Morison_DestroyMemberInputType(MemberInputTypeData, ErrStat, ErrMsg) + type(Morison_MemberInputType), intent(inout) :: MemberInputTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Morison_DestroyMemberInputType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(MemberInputTypeData%NodeIndx)) then + deallocate(MemberInputTypeData%NodeIndx) + end if +end subroutine + +subroutine Morison_PackMemberInputType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Morison_MemberInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Morison_PackMemberInputType' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%MemberID) + call RegPackAlloc(RF, InData%NodeIndx) + call RegPack(RF, InData%MJointID1) + call RegPack(RF, InData%MJointID2) + call RegPack(RF, InData%MJointID1Indx) + call RegPack(RF, InData%MJointID2Indx) + call RegPack(RF, InData%MPropSetID1) + call RegPack(RF, InData%MPropSetID2) + call RegPack(RF, InData%MPropSetID1Indx) + call RegPack(RF, InData%MPropSetID2Indx) + call RegPack(RF, InData%MDivSize) + call RegPack(RF, InData%MCoefMod) + call RegPack(RF, InData%MHstLMod) + call RegPack(RF, InData%MmbrCoefIDIndx) + call RegPack(RF, InData%MmbrFilledIDIndx) + call RegPack(RF, InData%PropPot) + call RegPack(RF, InData%PropMCF) + call RegPack(RF, InData%NElements) + call RegPack(RF, InData%RefLength) + call RegPack(RF, InData%dl) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Morison_UnPackMemberInputType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Morison_MemberInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Morison_UnPackMemberInputType' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%MemberID); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%NodeIndx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MJointID1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MJointID2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MJointID1Indx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MJointID2Indx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MPropSetID1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MPropSetID2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MPropSetID1Indx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MPropSetID2Indx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MDivSize); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MCoefMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MHstLMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MmbrCoefIDIndx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MmbrFilledIDIndx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PropPot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PropMCF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NElements); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RefLength); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%dl); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Morison_CopyNodeType(SrcNodeTypeData, DstNodeTypeData, CtrlCode, ErrStat, ErrMsg) + type(Morison_NodeType), intent(in) :: SrcNodeTypeData + type(Morison_NodeType), intent(inout) :: DstNodeTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Morison_CopyNodeType' + ErrStat = ErrID_None + ErrMsg = '' + DstNodeTypeData%JointIndx = SrcNodeTypeData%JointIndx + DstNodeTypeData%Position = SrcNodeTypeData%Position + DstNodeTypeData%JointOvrlp = SrcNodeTypeData%JointOvrlp + DstNodeTypeData%JointAxIDIndx = SrcNodeTypeData%JointAxIDIndx + DstNodeTypeData%NConnections = SrcNodeTypeData%NConnections + DstNodeTypeData%ConnectionList = SrcNodeTypeData%ConnectionList + DstNodeTypeData%JAxCd = SrcNodeTypeData%JAxCd + DstNodeTypeData%JAxCa = SrcNodeTypeData%JAxCa + DstNodeTypeData%JAxCp = SrcNodeTypeData%JAxCp + DstNodeTypeData%JAxVnCOff = SrcNodeTypeData%JAxVnCOff + DstNodeTypeData%JAxFDLoFSc = SrcNodeTypeData%JAxFDLoFSc + DstNodeTypeData%JAxFDMod = SrcNodeTypeData%JAxFDMod + DstNodeTypeData%FillDensity = SrcNodeTypeData%FillDensity + DstNodeTypeData%tMG = SrcNodeTypeData%tMG + DstNodeTypeData%MGdensity = SrcNodeTypeData%MGdensity +end subroutine + +subroutine Morison_DestroyNodeType(NodeTypeData, ErrStat, ErrMsg) + type(Morison_NodeType), intent(inout) :: NodeTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Morison_DestroyNodeType' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine Morison_PackNodeType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Morison_NodeType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Morison_PackNodeType' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%JointIndx) + call RegPack(RF, InData%Position) + call RegPack(RF, InData%JointOvrlp) + call RegPack(RF, InData%JointAxIDIndx) + call RegPack(RF, InData%NConnections) + call RegPack(RF, InData%ConnectionList) + call RegPack(RF, InData%JAxCd) + call RegPack(RF, InData%JAxCa) + call RegPack(RF, InData%JAxCp) + call RegPack(RF, InData%JAxVnCOff) + call RegPack(RF, InData%JAxFDLoFSc) + call RegPack(RF, InData%JAxFDMod) + call RegPack(RF, InData%FillDensity) + call RegPack(RF, InData%tMG) + call RegPack(RF, InData%MGdensity) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Morison_UnPackNodeType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Morison_NodeType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Morison_UnPackNodeType' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%JointIndx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Position); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%JointOvrlp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%JointAxIDIndx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NConnections); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ConnectionList); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%JAxCd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%JAxCa); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%JAxCp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%JAxVnCOff); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%JAxFDLoFSc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%JAxFDMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FillDensity); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%tMG); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MGdensity); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode, ErrStat, ErrMsg) + type(Morison_MemberType), intent(in) :: SrcMemberTypeData + type(Morison_MemberType), intent(inout) :: DstMemberTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'Morison_CopyMemberType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcMemberTypeData%NodeIndx)) then + LB(1:1) = lbound(SrcMemberTypeData%NodeIndx) + UB(1:1) = ubound(SrcMemberTypeData%NodeIndx) + if (.not. allocated(DstMemberTypeData%NodeIndx)) then + allocate(DstMemberTypeData%NodeIndx(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%NodeIndx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%NodeIndx = SrcMemberTypeData%NodeIndx + end if + DstMemberTypeData%MemberID = SrcMemberTypeData%MemberID + DstMemberTypeData%NElements = SrcMemberTypeData%NElements + DstMemberTypeData%RefLength = SrcMemberTypeData%RefLength + DstMemberTypeData%cosPhi_ref = SrcMemberTypeData%cosPhi_ref + DstMemberTypeData%dl = SrcMemberTypeData%dl + DstMemberTypeData%k = SrcMemberTypeData%k + DstMemberTypeData%kkt = SrcMemberTypeData%kkt + DstMemberTypeData%Ak = SrcMemberTypeData%Ak + if (allocated(SrcMemberTypeData%R)) then + LB(1:1) = lbound(SrcMemberTypeData%R) + UB(1:1) = ubound(SrcMemberTypeData%R) + if (.not. allocated(DstMemberTypeData%R)) then + allocate(DstMemberTypeData%R(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%R.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%R = SrcMemberTypeData%R + end if + if (allocated(SrcMemberTypeData%RMG)) then + LB(1:1) = lbound(SrcMemberTypeData%RMG) + UB(1:1) = ubound(SrcMemberTypeData%RMG) + if (.not. allocated(DstMemberTypeData%RMG)) then + allocate(DstMemberTypeData%RMG(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%RMG.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%RMG = SrcMemberTypeData%RMG + end if + if (allocated(SrcMemberTypeData%RMGB)) then + LB(1:1) = lbound(SrcMemberTypeData%RMGB) + UB(1:1) = ubound(SrcMemberTypeData%RMGB) + if (.not. allocated(DstMemberTypeData%RMGB)) then + allocate(DstMemberTypeData%RMGB(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%RMGB.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%RMGB = SrcMemberTypeData%RMGB + end if + if (allocated(SrcMemberTypeData%Rin)) then + LB(1:1) = lbound(SrcMemberTypeData%Rin) + UB(1:1) = ubound(SrcMemberTypeData%Rin) + if (.not. allocated(DstMemberTypeData%Rin)) then + allocate(DstMemberTypeData%Rin(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%Rin.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%Rin = SrcMemberTypeData%Rin + end if + if (allocated(SrcMemberTypeData%tMG)) then + LB(1:1) = lbound(SrcMemberTypeData%tMG) + UB(1:1) = ubound(SrcMemberTypeData%tMG) + if (.not. allocated(DstMemberTypeData%tMG)) then + allocate(DstMemberTypeData%tMG(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%tMG.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%tMG = SrcMemberTypeData%tMG + end if + if (allocated(SrcMemberTypeData%MGdensity)) then + LB(1:1) = lbound(SrcMemberTypeData%MGdensity) + UB(1:1) = ubound(SrcMemberTypeData%MGdensity) + if (.not. allocated(DstMemberTypeData%MGdensity)) then + allocate(DstMemberTypeData%MGdensity(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%MGdensity.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%MGdensity = SrcMemberTypeData%MGdensity + end if + if (allocated(SrcMemberTypeData%dRdl_mg)) then + LB(1:1) = lbound(SrcMemberTypeData%dRdl_mg) + UB(1:1) = ubound(SrcMemberTypeData%dRdl_mg) + if (.not. allocated(DstMemberTypeData%dRdl_mg)) then + allocate(DstMemberTypeData%dRdl_mg(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%dRdl_mg.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%dRdl_mg = SrcMemberTypeData%dRdl_mg + end if + if (allocated(SrcMemberTypeData%dRdl_mg_b)) then + LB(1:1) = lbound(SrcMemberTypeData%dRdl_mg_b) + UB(1:1) = ubound(SrcMemberTypeData%dRdl_mg_b) + if (.not. allocated(DstMemberTypeData%dRdl_mg_b)) then + allocate(DstMemberTypeData%dRdl_mg_b(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%dRdl_mg_b.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%dRdl_mg_b = SrcMemberTypeData%dRdl_mg_b + end if + if (allocated(SrcMemberTypeData%dRdl_in)) then + LB(1:1) = lbound(SrcMemberTypeData%dRdl_in) + UB(1:1) = ubound(SrcMemberTypeData%dRdl_in) + if (.not. allocated(DstMemberTypeData%dRdl_in)) then + allocate(DstMemberTypeData%dRdl_in(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%dRdl_in.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%dRdl_in = SrcMemberTypeData%dRdl_in + end if + DstMemberTypeData%Vinner = SrcMemberTypeData%Vinner + DstMemberTypeData%Vouter = SrcMemberTypeData%Vouter + DstMemberTypeData%Vballast = SrcMemberTypeData%Vballast + DstMemberTypeData%Vsubmerged = SrcMemberTypeData%Vsubmerged + DstMemberTypeData%l_fill = SrcMemberTypeData%l_fill + DstMemberTypeData%h_fill = SrcMemberTypeData%h_fill + DstMemberTypeData%z_overfill = SrcMemberTypeData%z_overfill + DstMemberTypeData%h_floor = SrcMemberTypeData%h_floor + DstMemberTypeData%i_floor = SrcMemberTypeData%i_floor + DstMemberTypeData%doEndBuoyancy = SrcMemberTypeData%doEndBuoyancy + DstMemberTypeData%memfloodstatus = SrcMemberTypeData%memfloodstatus + if (allocated(SrcMemberTypeData%floodstatus)) then + LB(1:1) = lbound(SrcMemberTypeData%floodstatus) + UB(1:1) = ubound(SrcMemberTypeData%floodstatus) + if (.not. allocated(DstMemberTypeData%floodstatus)) then + allocate(DstMemberTypeData%floodstatus(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%floodstatus.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%floodstatus = SrcMemberTypeData%floodstatus + end if + if (allocated(SrcMemberTypeData%alpha)) then + LB(1:1) = lbound(SrcMemberTypeData%alpha) + UB(1:1) = ubound(SrcMemberTypeData%alpha) + if (.not. allocated(DstMemberTypeData%alpha)) then + allocate(DstMemberTypeData%alpha(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%alpha.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%alpha = SrcMemberTypeData%alpha + end if + if (allocated(SrcMemberTypeData%alpha_fb)) then + LB(1:1) = lbound(SrcMemberTypeData%alpha_fb) + UB(1:1) = ubound(SrcMemberTypeData%alpha_fb) + if (.not. allocated(DstMemberTypeData%alpha_fb)) then + allocate(DstMemberTypeData%alpha_fb(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%alpha_fb.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%alpha_fb = SrcMemberTypeData%alpha_fb + end if + if (allocated(SrcMemberTypeData%alpha_fb_star)) then + LB(1:1) = lbound(SrcMemberTypeData%alpha_fb_star) + UB(1:1) = ubound(SrcMemberTypeData%alpha_fb_star) + if (.not. allocated(DstMemberTypeData%alpha_fb_star)) then + allocate(DstMemberTypeData%alpha_fb_star(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%alpha_fb_star.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%alpha_fb_star = SrcMemberTypeData%alpha_fb_star + end if + if (allocated(SrcMemberTypeData%Cd)) then + LB(1:1) = lbound(SrcMemberTypeData%Cd) + UB(1:1) = ubound(SrcMemberTypeData%Cd) + if (.not. allocated(DstMemberTypeData%Cd)) then + allocate(DstMemberTypeData%Cd(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%Cd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%Cd = SrcMemberTypeData%Cd + end if + if (allocated(SrcMemberTypeData%Ca)) then + LB(1:1) = lbound(SrcMemberTypeData%Ca) + UB(1:1) = ubound(SrcMemberTypeData%Ca) + if (.not. allocated(DstMemberTypeData%Ca)) then + allocate(DstMemberTypeData%Ca(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%Ca.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%Ca = SrcMemberTypeData%Ca + end if + if (allocated(SrcMemberTypeData%Cp)) then + LB(1:1) = lbound(SrcMemberTypeData%Cp) + UB(1:1) = ubound(SrcMemberTypeData%Cp) + if (.not. allocated(DstMemberTypeData%Cp)) then + allocate(DstMemberTypeData%Cp(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%Cp.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%Cp = SrcMemberTypeData%Cp + end if + if (allocated(SrcMemberTypeData%AxCd)) then + LB(1:1) = lbound(SrcMemberTypeData%AxCd) + UB(1:1) = ubound(SrcMemberTypeData%AxCd) + if (.not. allocated(DstMemberTypeData%AxCd)) then + allocate(DstMemberTypeData%AxCd(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%AxCd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%AxCd = SrcMemberTypeData%AxCd + end if + if (allocated(SrcMemberTypeData%AxCa)) then + LB(1:1) = lbound(SrcMemberTypeData%AxCa) + UB(1:1) = ubound(SrcMemberTypeData%AxCa) + if (.not. allocated(DstMemberTypeData%AxCa)) then + allocate(DstMemberTypeData%AxCa(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%AxCa.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%AxCa = SrcMemberTypeData%AxCa + end if + if (allocated(SrcMemberTypeData%AxCp)) then + LB(1:1) = lbound(SrcMemberTypeData%AxCp) + UB(1:1) = ubound(SrcMemberTypeData%AxCp) + if (.not. allocated(DstMemberTypeData%AxCp)) then + allocate(DstMemberTypeData%AxCp(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%AxCp.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%AxCp = SrcMemberTypeData%AxCp + end if + if (allocated(SrcMemberTypeData%Cb)) then + LB(1:1) = lbound(SrcMemberTypeData%Cb) + UB(1:1) = ubound(SrcMemberTypeData%Cb) + if (.not. allocated(DstMemberTypeData%Cb)) then + allocate(DstMemberTypeData%Cb(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%Cb.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%Cb = SrcMemberTypeData%Cb + end if + if (allocated(SrcMemberTypeData%m_fb_l)) then + LB(1:1) = lbound(SrcMemberTypeData%m_fb_l) + UB(1:1) = ubound(SrcMemberTypeData%m_fb_l) + if (.not. allocated(DstMemberTypeData%m_fb_l)) then + allocate(DstMemberTypeData%m_fb_l(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%m_fb_l.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%m_fb_l = SrcMemberTypeData%m_fb_l + end if + if (allocated(SrcMemberTypeData%m_fb_u)) then + LB(1:1) = lbound(SrcMemberTypeData%m_fb_u) + UB(1:1) = ubound(SrcMemberTypeData%m_fb_u) + if (.not. allocated(DstMemberTypeData%m_fb_u)) then + allocate(DstMemberTypeData%m_fb_u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%m_fb_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%m_fb_u = SrcMemberTypeData%m_fb_u + end if + if (allocated(SrcMemberTypeData%h_cfb_l)) then + LB(1:1) = lbound(SrcMemberTypeData%h_cfb_l) + UB(1:1) = ubound(SrcMemberTypeData%h_cfb_l) + if (.not. allocated(DstMemberTypeData%h_cfb_l)) then + allocate(DstMemberTypeData%h_cfb_l(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%h_cfb_l.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%h_cfb_l = SrcMemberTypeData%h_cfb_l + end if + if (allocated(SrcMemberTypeData%h_cfb_u)) then + LB(1:1) = lbound(SrcMemberTypeData%h_cfb_u) + UB(1:1) = ubound(SrcMemberTypeData%h_cfb_u) + if (.not. allocated(DstMemberTypeData%h_cfb_u)) then + allocate(DstMemberTypeData%h_cfb_u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%h_cfb_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%h_cfb_u = SrcMemberTypeData%h_cfb_u + end if + if (allocated(SrcMemberTypeData%I_lfb_l)) then + LB(1:1) = lbound(SrcMemberTypeData%I_lfb_l) + UB(1:1) = ubound(SrcMemberTypeData%I_lfb_l) + if (.not. allocated(DstMemberTypeData%I_lfb_l)) then + allocate(DstMemberTypeData%I_lfb_l(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%I_lfb_l.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%I_lfb_l = SrcMemberTypeData%I_lfb_l + end if + if (allocated(SrcMemberTypeData%I_lfb_u)) then + LB(1:1) = lbound(SrcMemberTypeData%I_lfb_u) + UB(1:1) = ubound(SrcMemberTypeData%I_lfb_u) + if (.not. allocated(DstMemberTypeData%I_lfb_u)) then + allocate(DstMemberTypeData%I_lfb_u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%I_lfb_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%I_lfb_u = SrcMemberTypeData%I_lfb_u + end if + if (allocated(SrcMemberTypeData%I_rfb_l)) then + LB(1:1) = lbound(SrcMemberTypeData%I_rfb_l) + UB(1:1) = ubound(SrcMemberTypeData%I_rfb_l) + if (.not. allocated(DstMemberTypeData%I_rfb_l)) then + allocate(DstMemberTypeData%I_rfb_l(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%I_rfb_l.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%I_rfb_l = SrcMemberTypeData%I_rfb_l + end if + if (allocated(SrcMemberTypeData%I_rfb_u)) then + LB(1:1) = lbound(SrcMemberTypeData%I_rfb_u) + UB(1:1) = ubound(SrcMemberTypeData%I_rfb_u) + if (.not. allocated(DstMemberTypeData%I_rfb_u)) then + allocate(DstMemberTypeData%I_rfb_u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%I_rfb_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%I_rfb_u = SrcMemberTypeData%I_rfb_u + end if + if (allocated(SrcMemberTypeData%m_mg_l)) then + LB(1:1) = lbound(SrcMemberTypeData%m_mg_l) + UB(1:1) = ubound(SrcMemberTypeData%m_mg_l) + if (.not. allocated(DstMemberTypeData%m_mg_l)) then + allocate(DstMemberTypeData%m_mg_l(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%m_mg_l.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%m_mg_l = SrcMemberTypeData%m_mg_l + end if + if (allocated(SrcMemberTypeData%m_mg_u)) then + LB(1:1) = lbound(SrcMemberTypeData%m_mg_u) + UB(1:1) = ubound(SrcMemberTypeData%m_mg_u) + if (.not. allocated(DstMemberTypeData%m_mg_u)) then + allocate(DstMemberTypeData%m_mg_u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%m_mg_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%m_mg_u = SrcMemberTypeData%m_mg_u + end if + if (allocated(SrcMemberTypeData%h_cmg_l)) then + LB(1:1) = lbound(SrcMemberTypeData%h_cmg_l) + UB(1:1) = ubound(SrcMemberTypeData%h_cmg_l) + if (.not. allocated(DstMemberTypeData%h_cmg_l)) then + allocate(DstMemberTypeData%h_cmg_l(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%h_cmg_l.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%h_cmg_l = SrcMemberTypeData%h_cmg_l + end if + if (allocated(SrcMemberTypeData%h_cmg_u)) then + LB(1:1) = lbound(SrcMemberTypeData%h_cmg_u) + UB(1:1) = ubound(SrcMemberTypeData%h_cmg_u) + if (.not. allocated(DstMemberTypeData%h_cmg_u)) then + allocate(DstMemberTypeData%h_cmg_u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%h_cmg_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%h_cmg_u = SrcMemberTypeData%h_cmg_u + end if + if (allocated(SrcMemberTypeData%I_lmg_l)) then + LB(1:1) = lbound(SrcMemberTypeData%I_lmg_l) + UB(1:1) = ubound(SrcMemberTypeData%I_lmg_l) + if (.not. allocated(DstMemberTypeData%I_lmg_l)) then + allocate(DstMemberTypeData%I_lmg_l(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%I_lmg_l.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%I_lmg_l = SrcMemberTypeData%I_lmg_l + end if + if (allocated(SrcMemberTypeData%I_lmg_u)) then + LB(1:1) = lbound(SrcMemberTypeData%I_lmg_u) + UB(1:1) = ubound(SrcMemberTypeData%I_lmg_u) + if (.not. allocated(DstMemberTypeData%I_lmg_u)) then + allocate(DstMemberTypeData%I_lmg_u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%I_lmg_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%I_lmg_u = SrcMemberTypeData%I_lmg_u + end if + if (allocated(SrcMemberTypeData%I_rmg_l)) then + LB(1:1) = lbound(SrcMemberTypeData%I_rmg_l) + UB(1:1) = ubound(SrcMemberTypeData%I_rmg_l) + if (.not. allocated(DstMemberTypeData%I_rmg_l)) then + allocate(DstMemberTypeData%I_rmg_l(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%I_rmg_l.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%I_rmg_l = SrcMemberTypeData%I_rmg_l + end if + if (allocated(SrcMemberTypeData%I_rmg_u)) then + LB(1:1) = lbound(SrcMemberTypeData%I_rmg_u) + UB(1:1) = ubound(SrcMemberTypeData%I_rmg_u) + if (.not. allocated(DstMemberTypeData%I_rmg_u)) then + allocate(DstMemberTypeData%I_rmg_u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%I_rmg_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%I_rmg_u = SrcMemberTypeData%I_rmg_u + end if + if (allocated(SrcMemberTypeData%Cfl_fb)) then + LB(1:1) = lbound(SrcMemberTypeData%Cfl_fb) + UB(1:1) = ubound(SrcMemberTypeData%Cfl_fb) + if (.not. allocated(DstMemberTypeData%Cfl_fb)) then + allocate(DstMemberTypeData%Cfl_fb(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%Cfl_fb.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%Cfl_fb = SrcMemberTypeData%Cfl_fb + end if + if (allocated(SrcMemberTypeData%Cfr_fb)) then + LB(1:1) = lbound(SrcMemberTypeData%Cfr_fb) + UB(1:1) = ubound(SrcMemberTypeData%Cfr_fb) + if (.not. allocated(DstMemberTypeData%Cfr_fb)) then + allocate(DstMemberTypeData%Cfr_fb(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%Cfr_fb.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%Cfr_fb = SrcMemberTypeData%Cfr_fb + end if + if (allocated(SrcMemberTypeData%CM0_fb)) then + LB(1:1) = lbound(SrcMemberTypeData%CM0_fb) + UB(1:1) = ubound(SrcMemberTypeData%CM0_fb) + if (.not. allocated(DstMemberTypeData%CM0_fb)) then + allocate(DstMemberTypeData%CM0_fb(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%CM0_fb.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%CM0_fb = SrcMemberTypeData%CM0_fb + end if + DstMemberTypeData%MGvolume = SrcMemberTypeData%MGvolume + DstMemberTypeData%MDivSize = SrcMemberTypeData%MDivSize + DstMemberTypeData%MCoefMod = SrcMemberTypeData%MCoefMod + DstMemberTypeData%MmbrCoefIDIndx = SrcMemberTypeData%MmbrCoefIDIndx + DstMemberTypeData%MmbrFilledIDIndx = SrcMemberTypeData%MmbrFilledIDIndx + DstMemberTypeData%MHstLMod = SrcMemberTypeData%MHstLMod + DstMemberTypeData%FillFSLoc = SrcMemberTypeData%FillFSLoc + DstMemberTypeData%FillDens = SrcMemberTypeData%FillDens + DstMemberTypeData%PropPot = SrcMemberTypeData%PropPot + DstMemberTypeData%PropMCF = SrcMemberTypeData%PropMCF + DstMemberTypeData%Flipped = SrcMemberTypeData%Flipped +end subroutine + +subroutine Morison_DestroyMemberType(MemberTypeData, ErrStat, ErrMsg) + type(Morison_MemberType), intent(inout) :: MemberTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Morison_DestroyMemberType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(MemberTypeData%NodeIndx)) then + deallocate(MemberTypeData%NodeIndx) + end if + if (allocated(MemberTypeData%R)) then + deallocate(MemberTypeData%R) + end if + if (allocated(MemberTypeData%RMG)) then + deallocate(MemberTypeData%RMG) + end if + if (allocated(MemberTypeData%RMGB)) then + deallocate(MemberTypeData%RMGB) + end if + if (allocated(MemberTypeData%Rin)) then + deallocate(MemberTypeData%Rin) + end if + if (allocated(MemberTypeData%tMG)) then + deallocate(MemberTypeData%tMG) + end if + if (allocated(MemberTypeData%MGdensity)) then + deallocate(MemberTypeData%MGdensity) + end if + if (allocated(MemberTypeData%dRdl_mg)) then + deallocate(MemberTypeData%dRdl_mg) + end if + if (allocated(MemberTypeData%dRdl_mg_b)) then + deallocate(MemberTypeData%dRdl_mg_b) + end if + if (allocated(MemberTypeData%dRdl_in)) then + deallocate(MemberTypeData%dRdl_in) + end if + if (allocated(MemberTypeData%floodstatus)) then + deallocate(MemberTypeData%floodstatus) + end if + if (allocated(MemberTypeData%alpha)) then + deallocate(MemberTypeData%alpha) + end if + if (allocated(MemberTypeData%alpha_fb)) then + deallocate(MemberTypeData%alpha_fb) + end if + if (allocated(MemberTypeData%alpha_fb_star)) then + deallocate(MemberTypeData%alpha_fb_star) + end if + if (allocated(MemberTypeData%Cd)) then + deallocate(MemberTypeData%Cd) + end if + if (allocated(MemberTypeData%Ca)) then + deallocate(MemberTypeData%Ca) + end if + if (allocated(MemberTypeData%Cp)) then + deallocate(MemberTypeData%Cp) + end if + if (allocated(MemberTypeData%AxCd)) then + deallocate(MemberTypeData%AxCd) + end if + if (allocated(MemberTypeData%AxCa)) then + deallocate(MemberTypeData%AxCa) + end if + if (allocated(MemberTypeData%AxCp)) then + deallocate(MemberTypeData%AxCp) + end if + if (allocated(MemberTypeData%Cb)) then + deallocate(MemberTypeData%Cb) + end if + if (allocated(MemberTypeData%m_fb_l)) then + deallocate(MemberTypeData%m_fb_l) + end if + if (allocated(MemberTypeData%m_fb_u)) then + deallocate(MemberTypeData%m_fb_u) + end if + if (allocated(MemberTypeData%h_cfb_l)) then + deallocate(MemberTypeData%h_cfb_l) + end if + if (allocated(MemberTypeData%h_cfb_u)) then + deallocate(MemberTypeData%h_cfb_u) + end if + if (allocated(MemberTypeData%I_lfb_l)) then + deallocate(MemberTypeData%I_lfb_l) + end if + if (allocated(MemberTypeData%I_lfb_u)) then + deallocate(MemberTypeData%I_lfb_u) + end if + if (allocated(MemberTypeData%I_rfb_l)) then + deallocate(MemberTypeData%I_rfb_l) + end if + if (allocated(MemberTypeData%I_rfb_u)) then + deallocate(MemberTypeData%I_rfb_u) + end if + if (allocated(MemberTypeData%m_mg_l)) then + deallocate(MemberTypeData%m_mg_l) + end if + if (allocated(MemberTypeData%m_mg_u)) then + deallocate(MemberTypeData%m_mg_u) + end if + if (allocated(MemberTypeData%h_cmg_l)) then + deallocate(MemberTypeData%h_cmg_l) + end if + if (allocated(MemberTypeData%h_cmg_u)) then + deallocate(MemberTypeData%h_cmg_u) + end if + if (allocated(MemberTypeData%I_lmg_l)) then + deallocate(MemberTypeData%I_lmg_l) + end if + if (allocated(MemberTypeData%I_lmg_u)) then + deallocate(MemberTypeData%I_lmg_u) + end if + if (allocated(MemberTypeData%I_rmg_l)) then + deallocate(MemberTypeData%I_rmg_l) + end if + if (allocated(MemberTypeData%I_rmg_u)) then + deallocate(MemberTypeData%I_rmg_u) + end if + if (allocated(MemberTypeData%Cfl_fb)) then + deallocate(MemberTypeData%Cfl_fb) + end if + if (allocated(MemberTypeData%Cfr_fb)) then + deallocate(MemberTypeData%Cfr_fb) + end if + if (allocated(MemberTypeData%CM0_fb)) then + deallocate(MemberTypeData%CM0_fb) + end if +end subroutine + +subroutine Morison_PackMemberType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Morison_MemberType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Morison_PackMemberType' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%NodeIndx) + call RegPack(RF, InData%MemberID) + call RegPack(RF, InData%NElements) + call RegPack(RF, InData%RefLength) + call RegPack(RF, InData%cosPhi_ref) + call RegPack(RF, InData%dl) + call RegPack(RF, InData%k) + call RegPack(RF, InData%kkt) + call RegPack(RF, InData%Ak) + call RegPackAlloc(RF, InData%R) + call RegPackAlloc(RF, InData%RMG) + call RegPackAlloc(RF, InData%RMGB) + call RegPackAlloc(RF, InData%Rin) + call RegPackAlloc(RF, InData%tMG) + call RegPackAlloc(RF, InData%MGdensity) + call RegPackAlloc(RF, InData%dRdl_mg) + call RegPackAlloc(RF, InData%dRdl_mg_b) + call RegPackAlloc(RF, InData%dRdl_in) + call RegPack(RF, InData%Vinner) + call RegPack(RF, InData%Vouter) + call RegPack(RF, InData%Vballast) + call RegPack(RF, InData%Vsubmerged) + call RegPack(RF, InData%l_fill) + call RegPack(RF, InData%h_fill) + call RegPack(RF, InData%z_overfill) + call RegPack(RF, InData%h_floor) + call RegPack(RF, InData%i_floor) + call RegPack(RF, InData%doEndBuoyancy) + call RegPack(RF, InData%memfloodstatus) + call RegPackAlloc(RF, InData%floodstatus) + call RegPackAlloc(RF, InData%alpha) + call RegPackAlloc(RF, InData%alpha_fb) + call RegPackAlloc(RF, InData%alpha_fb_star) + call RegPackAlloc(RF, InData%Cd) + call RegPackAlloc(RF, InData%Ca) + call RegPackAlloc(RF, InData%Cp) + call RegPackAlloc(RF, InData%AxCd) + call RegPackAlloc(RF, InData%AxCa) + call RegPackAlloc(RF, InData%AxCp) + call RegPackAlloc(RF, InData%Cb) + call RegPackAlloc(RF, InData%m_fb_l) + call RegPackAlloc(RF, InData%m_fb_u) + call RegPackAlloc(RF, InData%h_cfb_l) + call RegPackAlloc(RF, InData%h_cfb_u) + call RegPackAlloc(RF, InData%I_lfb_l) + call RegPackAlloc(RF, InData%I_lfb_u) + call RegPackAlloc(RF, InData%I_rfb_l) + call RegPackAlloc(RF, InData%I_rfb_u) + call RegPackAlloc(RF, InData%m_mg_l) + call RegPackAlloc(RF, InData%m_mg_u) + call RegPackAlloc(RF, InData%h_cmg_l) + call RegPackAlloc(RF, InData%h_cmg_u) + call RegPackAlloc(RF, InData%I_lmg_l) + call RegPackAlloc(RF, InData%I_lmg_u) + call RegPackAlloc(RF, InData%I_rmg_l) + call RegPackAlloc(RF, InData%I_rmg_u) + call RegPackAlloc(RF, InData%Cfl_fb) + call RegPackAlloc(RF, InData%Cfr_fb) + call RegPackAlloc(RF, InData%CM0_fb) + call RegPack(RF, InData%MGvolume) + call RegPack(RF, InData%MDivSize) + call RegPack(RF, InData%MCoefMod) + call RegPack(RF, InData%MmbrCoefIDIndx) + call RegPack(RF, InData%MmbrFilledIDIndx) + call RegPack(RF, InData%MHstLMod) + call RegPack(RF, InData%FillFSLoc) + call RegPack(RF, InData%FillDens) + call RegPack(RF, InData%PropPot) + call RegPack(RF, InData%PropMCF) + call RegPack(RF, InData%Flipped) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Morison_UnPackMemberType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Morison_MemberType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Morison_UnPackMemberType' + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%NodeIndx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MemberID); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NElements); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RefLength); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%cosPhi_ref); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%dl); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%k); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%kkt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Ak); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%R); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%RMG); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%RMGB); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Rin); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%tMG); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%MGdensity); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dRdl_mg); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dRdl_mg_b); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dRdl_in); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Vinner); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Vouter); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Vballast); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Vsubmerged); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%l_fill); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%h_fill); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%z_overfill); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%h_floor); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%i_floor); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%doEndBuoyancy); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%memfloodstatus); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%floodstatus); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%alpha); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%alpha_fb); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%alpha_fb_star); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Cd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Ca); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Cp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AxCd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AxCa); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AxCp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Cb); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%m_fb_l); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%m_fb_u); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%h_cfb_l); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%h_cfb_u); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%I_lfb_l); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%I_lfb_u); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%I_rfb_l); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%I_rfb_u); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%m_mg_l); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%m_mg_u); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%h_cmg_l); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%h_cmg_u); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%I_lmg_l); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%I_lmg_u); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%I_rmg_l); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%I_rmg_u); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Cfl_fb); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Cfr_fb); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%CM0_fb); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MGvolume); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MDivSize); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MCoefMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MmbrCoefIDIndx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MmbrFilledIDIndx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MHstLMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FillFSLoc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FillDens); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PropPot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PropMCF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Flipped); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Morison_CopyMemberLoads(SrcMemberLoadsData, DstMemberLoadsData, CtrlCode, ErrStat, ErrMsg) + type(Morison_MemberLoads), intent(in) :: SrcMemberLoadsData + type(Morison_MemberLoads), intent(inout) :: DstMemberLoadsData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'Morison_CopyMemberLoads' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcMemberLoadsData%F_D)) then + LB(1:2) = lbound(SrcMemberLoadsData%F_D) + UB(1:2) = ubound(SrcMemberLoadsData%F_D) + if (.not. allocated(DstMemberLoadsData%F_D)) then + allocate(DstMemberLoadsData%F_D(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberLoadsData%F_D.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberLoadsData%F_D = SrcMemberLoadsData%F_D + end if + if (allocated(SrcMemberLoadsData%F_I)) then + LB(1:2) = lbound(SrcMemberLoadsData%F_I) + UB(1:2) = ubound(SrcMemberLoadsData%F_I) + if (.not. allocated(DstMemberLoadsData%F_I)) then + allocate(DstMemberLoadsData%F_I(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberLoadsData%F_I.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberLoadsData%F_I = SrcMemberLoadsData%F_I + end if + if (allocated(SrcMemberLoadsData%F_A)) then + LB(1:2) = lbound(SrcMemberLoadsData%F_A) + UB(1:2) = ubound(SrcMemberLoadsData%F_A) + if (.not. allocated(DstMemberLoadsData%F_A)) then + allocate(DstMemberLoadsData%F_A(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberLoadsData%F_A.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberLoadsData%F_A = SrcMemberLoadsData%F_A + end if + if (allocated(SrcMemberLoadsData%F_B)) then + LB(1:2) = lbound(SrcMemberLoadsData%F_B) + UB(1:2) = ubound(SrcMemberLoadsData%F_B) + if (.not. allocated(DstMemberLoadsData%F_B)) then + allocate(DstMemberLoadsData%F_B(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberLoadsData%F_B.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberLoadsData%F_B = SrcMemberLoadsData%F_B + end if + if (allocated(SrcMemberLoadsData%F_BF)) then + LB(1:2) = lbound(SrcMemberLoadsData%F_BF) + UB(1:2) = ubound(SrcMemberLoadsData%F_BF) + if (.not. allocated(DstMemberLoadsData%F_BF)) then + allocate(DstMemberLoadsData%F_BF(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberLoadsData%F_BF.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberLoadsData%F_BF = SrcMemberLoadsData%F_BF + end if + if (allocated(SrcMemberLoadsData%F_If)) then + LB(1:2) = lbound(SrcMemberLoadsData%F_If) + UB(1:2) = ubound(SrcMemberLoadsData%F_If) + if (.not. allocated(DstMemberLoadsData%F_If)) then + allocate(DstMemberLoadsData%F_If(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberLoadsData%F_If.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberLoadsData%F_If = SrcMemberLoadsData%F_If + end if + if (allocated(SrcMemberLoadsData%F_WMG)) then + LB(1:2) = lbound(SrcMemberLoadsData%F_WMG) + UB(1:2) = ubound(SrcMemberLoadsData%F_WMG) + if (.not. allocated(DstMemberLoadsData%F_WMG)) then + allocate(DstMemberLoadsData%F_WMG(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberLoadsData%F_WMG.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberLoadsData%F_WMG = SrcMemberLoadsData%F_WMG + end if + if (allocated(SrcMemberLoadsData%F_IMG)) then + LB(1:2) = lbound(SrcMemberLoadsData%F_IMG) + UB(1:2) = ubound(SrcMemberLoadsData%F_IMG) + if (.not. allocated(DstMemberLoadsData%F_IMG)) then + allocate(DstMemberLoadsData%F_IMG(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberLoadsData%F_IMG.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberLoadsData%F_IMG = SrcMemberLoadsData%F_IMG + end if + if (allocated(SrcMemberLoadsData%FV)) then + LB(1:2) = lbound(SrcMemberLoadsData%FV) + UB(1:2) = ubound(SrcMemberLoadsData%FV) + if (.not. allocated(DstMemberLoadsData%FV)) then + allocate(DstMemberLoadsData%FV(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberLoadsData%FV.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberLoadsData%FV = SrcMemberLoadsData%FV + end if + if (allocated(SrcMemberLoadsData%FA)) then + LB(1:2) = lbound(SrcMemberLoadsData%FA) + UB(1:2) = ubound(SrcMemberLoadsData%FA) + if (.not. allocated(DstMemberLoadsData%FA)) then + allocate(DstMemberLoadsData%FA(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberLoadsData%FA.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberLoadsData%FA = SrcMemberLoadsData%FA + end if + if (allocated(SrcMemberLoadsData%F_DP)) then + LB(1:2) = lbound(SrcMemberLoadsData%F_DP) + UB(1:2) = ubound(SrcMemberLoadsData%F_DP) + if (.not. allocated(DstMemberLoadsData%F_DP)) then + allocate(DstMemberLoadsData%F_DP(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberLoadsData%F_DP.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberLoadsData%F_DP = SrcMemberLoadsData%F_DP + end if +end subroutine + +subroutine Morison_DestroyMemberLoads(MemberLoadsData, ErrStat, ErrMsg) + type(Morison_MemberLoads), intent(inout) :: MemberLoadsData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Morison_DestroyMemberLoads' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(MemberLoadsData%F_D)) then + deallocate(MemberLoadsData%F_D) + end if + if (allocated(MemberLoadsData%F_I)) then + deallocate(MemberLoadsData%F_I) + end if + if (allocated(MemberLoadsData%F_A)) then + deallocate(MemberLoadsData%F_A) + end if + if (allocated(MemberLoadsData%F_B)) then + deallocate(MemberLoadsData%F_B) + end if + if (allocated(MemberLoadsData%F_BF)) then + deallocate(MemberLoadsData%F_BF) + end if + if (allocated(MemberLoadsData%F_If)) then + deallocate(MemberLoadsData%F_If) + end if + if (allocated(MemberLoadsData%F_WMG)) then + deallocate(MemberLoadsData%F_WMG) + end if + if (allocated(MemberLoadsData%F_IMG)) then + deallocate(MemberLoadsData%F_IMG) + end if + if (allocated(MemberLoadsData%FV)) then + deallocate(MemberLoadsData%FV) + end if + if (allocated(MemberLoadsData%FA)) then + deallocate(MemberLoadsData%FA) + end if + if (allocated(MemberLoadsData%F_DP)) then + deallocate(MemberLoadsData%F_DP) + end if +end subroutine + +subroutine Morison_PackMemberLoads(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Morison_MemberLoads), intent(in) :: InData + character(*), parameter :: RoutineName = 'Morison_PackMemberLoads' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%F_D) + call RegPackAlloc(RF, InData%F_I) + call RegPackAlloc(RF, InData%F_A) + call RegPackAlloc(RF, InData%F_B) + call RegPackAlloc(RF, InData%F_BF) + call RegPackAlloc(RF, InData%F_If) + call RegPackAlloc(RF, InData%F_WMG) + call RegPackAlloc(RF, InData%F_IMG) + call RegPackAlloc(RF, InData%FV) + call RegPackAlloc(RF, InData%FA) + call RegPackAlloc(RF, InData%F_DP) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Morison_UnPackMemberLoads(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Morison_MemberLoads), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Morison_UnPackMemberLoads' + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%F_D); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%F_I); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%F_A); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%F_B); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%F_BF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%F_If); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%F_WMG); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%F_IMG); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%FV); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%FA); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%F_DP); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Morison_CopyCoefMembers(SrcCoefMembersData, DstCoefMembersData, CtrlCode, ErrStat, ErrMsg) + type(Morison_CoefMembers), intent(in) :: SrcCoefMembersData + type(Morison_CoefMembers), intent(inout) :: DstCoefMembersData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Morison_CopyCoefMembers' + ErrStat = ErrID_None + ErrMsg = '' + DstCoefMembersData%MemberID = SrcCoefMembersData%MemberID + DstCoefMembersData%MemberCd1 = SrcCoefMembersData%MemberCd1 + DstCoefMembersData%MemberCd2 = SrcCoefMembersData%MemberCd2 + DstCoefMembersData%MemberCdMG1 = SrcCoefMembersData%MemberCdMG1 + DstCoefMembersData%MemberCdMG2 = SrcCoefMembersData%MemberCdMG2 + DstCoefMembersData%MemberCa1 = SrcCoefMembersData%MemberCa1 + DstCoefMembersData%MemberCa2 = SrcCoefMembersData%MemberCa2 + DstCoefMembersData%MemberCaMG1 = SrcCoefMembersData%MemberCaMG1 + DstCoefMembersData%MemberCaMG2 = SrcCoefMembersData%MemberCaMG2 + DstCoefMembersData%MemberCp1 = SrcCoefMembersData%MemberCp1 + DstCoefMembersData%MemberCp2 = SrcCoefMembersData%MemberCp2 + DstCoefMembersData%MemberCpMG1 = SrcCoefMembersData%MemberCpMG1 + DstCoefMembersData%MemberCpMG2 = SrcCoefMembersData%MemberCpMG2 + DstCoefMembersData%MemberAxCd1 = SrcCoefMembersData%MemberAxCd1 + DstCoefMembersData%MemberAxCd2 = SrcCoefMembersData%MemberAxCd2 + DstCoefMembersData%MemberAxCdMG1 = SrcCoefMembersData%MemberAxCdMG1 + DstCoefMembersData%MemberAxCdMG2 = SrcCoefMembersData%MemberAxCdMG2 + DstCoefMembersData%MemberAxCa1 = SrcCoefMembersData%MemberAxCa1 + DstCoefMembersData%MemberAxCa2 = SrcCoefMembersData%MemberAxCa2 + DstCoefMembersData%MemberAxCaMG1 = SrcCoefMembersData%MemberAxCaMG1 + DstCoefMembersData%MemberAxCaMG2 = SrcCoefMembersData%MemberAxCaMG2 + DstCoefMembersData%MemberAxCp1 = SrcCoefMembersData%MemberAxCp1 + DstCoefMembersData%MemberAxCp2 = SrcCoefMembersData%MemberAxCp2 + DstCoefMembersData%MemberAxCpMG1 = SrcCoefMembersData%MemberAxCpMG1 + DstCoefMembersData%MemberAxCpMG2 = SrcCoefMembersData%MemberAxCpMG2 + DstCoefMembersData%MemberCb1 = SrcCoefMembersData%MemberCb1 + DstCoefMembersData%MemberCb2 = SrcCoefMembersData%MemberCb2 + DstCoefMembersData%MemberCbMG1 = SrcCoefMembersData%MemberCbMG1 + DstCoefMembersData%MemberCbMG2 = SrcCoefMembersData%MemberCbMG2 + DstCoefMembersData%MemberMCF = SrcCoefMembersData%MemberMCF +end subroutine + +subroutine Morison_DestroyCoefMembers(CoefMembersData, ErrStat, ErrMsg) + type(Morison_CoefMembers), intent(inout) :: CoefMembersData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Morison_DestroyCoefMembers' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine Morison_PackCoefMembers(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Morison_CoefMembers), intent(in) :: InData + character(*), parameter :: RoutineName = 'Morison_PackCoefMembers' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%MemberID) + call RegPack(RF, InData%MemberCd1) + call RegPack(RF, InData%MemberCd2) + call RegPack(RF, InData%MemberCdMG1) + call RegPack(RF, InData%MemberCdMG2) + call RegPack(RF, InData%MemberCa1) + call RegPack(RF, InData%MemberCa2) + call RegPack(RF, InData%MemberCaMG1) + call RegPack(RF, InData%MemberCaMG2) + call RegPack(RF, InData%MemberCp1) + call RegPack(RF, InData%MemberCp2) + call RegPack(RF, InData%MemberCpMG1) + call RegPack(RF, InData%MemberCpMG2) + call RegPack(RF, InData%MemberAxCd1) + call RegPack(RF, InData%MemberAxCd2) + call RegPack(RF, InData%MemberAxCdMG1) + call RegPack(RF, InData%MemberAxCdMG2) + call RegPack(RF, InData%MemberAxCa1) + call RegPack(RF, InData%MemberAxCa2) + call RegPack(RF, InData%MemberAxCaMG1) + call RegPack(RF, InData%MemberAxCaMG2) + call RegPack(RF, InData%MemberAxCp1) + call RegPack(RF, InData%MemberAxCp2) + call RegPack(RF, InData%MemberAxCpMG1) + call RegPack(RF, InData%MemberAxCpMG2) + call RegPack(RF, InData%MemberCb1) + call RegPack(RF, InData%MemberCb2) + call RegPack(RF, InData%MemberCbMG1) + call RegPack(RF, InData%MemberCbMG2) + call RegPack(RF, InData%MemberMCF) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Morison_UnPackCoefMembers(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Morison_CoefMembers), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Morison_UnPackCoefMembers' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%MemberID); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MemberCd1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MemberCd2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MemberCdMG1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MemberCdMG2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MemberCa1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MemberCa2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MemberCaMG1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MemberCaMG2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MemberCp1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MemberCp2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MemberCpMG1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MemberCpMG2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MemberAxCd1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MemberAxCd2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MemberAxCdMG1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MemberAxCdMG2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MemberAxCa1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MemberAxCa2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MemberAxCaMG1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MemberAxCaMG2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MemberAxCp1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MemberAxCp2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MemberAxCpMG1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MemberAxCpMG2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MemberCb1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MemberCb2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MemberCbMG1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MemberCbMG2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MemberMCF); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Morison_CopyMGDepthsType(SrcMGDepthsTypeData, DstMGDepthsTypeData, CtrlCode, ErrStat, ErrMsg) + type(Morison_MGDepthsType), intent(in) :: SrcMGDepthsTypeData + type(Morison_MGDepthsType), intent(inout) :: DstMGDepthsTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Morison_CopyMGDepthsType' + ErrStat = ErrID_None + ErrMsg = '' + DstMGDepthsTypeData%MGDpth = SrcMGDepthsTypeData%MGDpth + DstMGDepthsTypeData%MGThck = SrcMGDepthsTypeData%MGThck + DstMGDepthsTypeData%MGDens = SrcMGDepthsTypeData%MGDens +end subroutine + +subroutine Morison_DestroyMGDepthsType(MGDepthsTypeData, ErrStat, ErrMsg) + type(Morison_MGDepthsType), intent(inout) :: MGDepthsTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Morison_DestroyMGDepthsType' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine Morison_PackMGDepthsType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Morison_MGDepthsType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Morison_PackMGDepthsType' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%MGDpth) + call RegPack(RF, InData%MGThck) + call RegPack(RF, InData%MGDens) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Morison_UnPackMGDepthsType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Morison_MGDepthsType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Morison_UnPackMGDepthsType' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%MGDpth); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MGThck); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MGDens); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Morison_CopyMOutput(SrcMOutputData, DstMOutputData, CtrlCode, ErrStat, ErrMsg) + type(Morison_MOutput), intent(in) :: SrcMOutputData + type(Morison_MOutput), intent(inout) :: DstMOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'Morison_CopyMOutput' + ErrStat = ErrID_None + ErrMsg = '' + DstMOutputData%MemberID = SrcMOutputData%MemberID + DstMOutputData%NOutLoc = SrcMOutputData%NOutLoc + if (allocated(SrcMOutputData%NodeLocs)) then + LB(1:1) = lbound(SrcMOutputData%NodeLocs) + UB(1:1) = ubound(SrcMOutputData%NodeLocs) + if (.not. allocated(DstMOutputData%NodeLocs)) then + allocate(DstMOutputData%NodeLocs(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMOutputData%NodeLocs.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMOutputData%NodeLocs = SrcMOutputData%NodeLocs + end if + DstMOutputData%MemberIDIndx = SrcMOutputData%MemberIDIndx + if (allocated(SrcMOutputData%MeshIndx1)) then + LB(1:1) = lbound(SrcMOutputData%MeshIndx1) + UB(1:1) = ubound(SrcMOutputData%MeshIndx1) + if (.not. allocated(DstMOutputData%MeshIndx1)) then + allocate(DstMOutputData%MeshIndx1(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMOutputData%MeshIndx1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMOutputData%MeshIndx1 = SrcMOutputData%MeshIndx1 + end if + if (allocated(SrcMOutputData%MeshIndx2)) then + LB(1:1) = lbound(SrcMOutputData%MeshIndx2) + UB(1:1) = ubound(SrcMOutputData%MeshIndx2) + if (.not. allocated(DstMOutputData%MeshIndx2)) then + allocate(DstMOutputData%MeshIndx2(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMOutputData%MeshIndx2.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMOutputData%MeshIndx2 = SrcMOutputData%MeshIndx2 + end if + if (allocated(SrcMOutputData%MemberIndx1)) then + LB(1:1) = lbound(SrcMOutputData%MemberIndx1) + UB(1:1) = ubound(SrcMOutputData%MemberIndx1) + if (.not. allocated(DstMOutputData%MemberIndx1)) then + allocate(DstMOutputData%MemberIndx1(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMOutputData%MemberIndx1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMOutputData%MemberIndx1 = SrcMOutputData%MemberIndx1 + end if + if (allocated(SrcMOutputData%MemberIndx2)) then + LB(1:1) = lbound(SrcMOutputData%MemberIndx2) + UB(1:1) = ubound(SrcMOutputData%MemberIndx2) + if (.not. allocated(DstMOutputData%MemberIndx2)) then + allocate(DstMOutputData%MemberIndx2(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMOutputData%MemberIndx2.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMOutputData%MemberIndx2 = SrcMOutputData%MemberIndx2 + end if + if (allocated(SrcMOutputData%s)) then + LB(1:1) = lbound(SrcMOutputData%s) + UB(1:1) = ubound(SrcMOutputData%s) + if (.not. allocated(DstMOutputData%s)) then + allocate(DstMOutputData%s(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMOutputData%s.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMOutputData%s = SrcMOutputData%s + end if +end subroutine + +subroutine Morison_DestroyMOutput(MOutputData, ErrStat, ErrMsg) + type(Morison_MOutput), intent(inout) :: MOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Morison_DestroyMOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(MOutputData%NodeLocs)) then + deallocate(MOutputData%NodeLocs) + end if + if (allocated(MOutputData%MeshIndx1)) then + deallocate(MOutputData%MeshIndx1) + end if + if (allocated(MOutputData%MeshIndx2)) then + deallocate(MOutputData%MeshIndx2) + end if + if (allocated(MOutputData%MemberIndx1)) then + deallocate(MOutputData%MemberIndx1) + end if + if (allocated(MOutputData%MemberIndx2)) then + deallocate(MOutputData%MemberIndx2) + end if + if (allocated(MOutputData%s)) then + deallocate(MOutputData%s) + end if +end subroutine + +subroutine Morison_PackMOutput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Morison_MOutput), intent(in) :: InData + character(*), parameter :: RoutineName = 'Morison_PackMOutput' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%MemberID) + call RegPack(RF, InData%NOutLoc) + call RegPackAlloc(RF, InData%NodeLocs) + call RegPack(RF, InData%MemberIDIndx) + call RegPackAlloc(RF, InData%MeshIndx1) + call RegPackAlloc(RF, InData%MeshIndx2) + call RegPackAlloc(RF, InData%MemberIndx1) + call RegPackAlloc(RF, InData%MemberIndx2) + call RegPackAlloc(RF, InData%s) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Morison_UnPackMOutput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Morison_MOutput), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Morison_UnPackMOutput' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%MemberID); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NOutLoc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%NodeLocs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MemberIDIndx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%MeshIndx1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%MeshIndx2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%MemberIndx1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%MemberIndx2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%s); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Morison_CopyJOutput(SrcJOutputData, DstJOutputData, CtrlCode, ErrStat, ErrMsg) + type(Morison_JOutput), intent(in) :: SrcJOutputData + type(Morison_JOutput), intent(inout) :: DstJOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Morison_CopyJOutput' + ErrStat = ErrID_None + ErrMsg = '' + DstJOutputData%JointID = SrcJOutputData%JointID + DstJOutputData%JointIDIndx = SrcJOutputData%JointIDIndx +end subroutine + +subroutine Morison_DestroyJOutput(JOutputData, ErrStat, ErrMsg) + type(Morison_JOutput), intent(inout) :: JOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Morison_DestroyJOutput' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine Morison_PackJOutput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Morison_JOutput), intent(in) :: InData + character(*), parameter :: RoutineName = 'Morison_PackJOutput' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%JointID) + call RegPack(RF, InData%JointIDIndx) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Morison_UnPackJOutput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Morison_JOutput), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Morison_UnPackJOutput' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%JointID); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%JointIDIndx); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Morison_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) + type(Morison_InitInputType), intent(in) :: SrcInitInputData + type(Morison_InitInputType), intent(inout) :: DstInitInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Morison_CopyInitInput' + ErrStat = ErrID_None + ErrMsg = '' + DstInitInputData%Gravity = SrcInitInputData%Gravity + DstInitInputData%WaveDisp = SrcInitInputData%WaveDisp + DstInitInputData%AMMod = SrcInitInputData%AMMod + DstInitInputData%NJoints = SrcInitInputData%NJoints + DstInitInputData%NNodes = SrcInitInputData%NNodes + if (allocated(SrcInitInputData%InpJoints)) then + LB(1:1) = lbound(SrcInitInputData%InpJoints) + UB(1:1) = ubound(SrcInitInputData%InpJoints) + if (.not. allocated(DstInitInputData%InpJoints)) then + allocate(DstInitInputData%InpJoints(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%InpJoints.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call Morison_CopyJointType(SrcInitInputData%InpJoints(i1), DstInitInputData%InpJoints(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcInitInputData%Nodes)) then + LB(1:1) = lbound(SrcInitInputData%Nodes) + UB(1:1) = ubound(SrcInitInputData%Nodes) + if (.not. allocated(DstInitInputData%Nodes)) then + allocate(DstInitInputData%Nodes(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%Nodes.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call Morison_CopyNodeType(SrcInitInputData%Nodes(i1), DstInitInputData%Nodes(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + DstInitInputData%NAxCoefs = SrcInitInputData%NAxCoefs + if (allocated(SrcInitInputData%AxialCoefs)) then + LB(1:1) = lbound(SrcInitInputData%AxialCoefs) + UB(1:1) = ubound(SrcInitInputData%AxialCoefs) + if (.not. allocated(DstInitInputData%AxialCoefs)) then + allocate(DstInitInputData%AxialCoefs(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%AxialCoefs.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call Morison_CopyAxialCoefType(SrcInitInputData%AxialCoefs(i1), DstInitInputData%AxialCoefs(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + DstInitInputData%NPropSets = SrcInitInputData%NPropSets + if (allocated(SrcInitInputData%MPropSets)) then + LB(1:1) = lbound(SrcInitInputData%MPropSets) + UB(1:1) = ubound(SrcInitInputData%MPropSets) + if (.not. allocated(DstInitInputData%MPropSets)) then + allocate(DstInitInputData%MPropSets(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%MPropSets.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call Morison_CopyMemberPropType(SrcInitInputData%MPropSets(i1), DstInitInputData%MPropSets(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + DstInitInputData%SimplCd = SrcInitInputData%SimplCd + DstInitInputData%SimplCdMG = SrcInitInputData%SimplCdMG + DstInitInputData%SimplCa = SrcInitInputData%SimplCa + DstInitInputData%SimplCaMG = SrcInitInputData%SimplCaMG + DstInitInputData%SimplCp = SrcInitInputData%SimplCp + DstInitInputData%SimplCpMG = SrcInitInputData%SimplCpMG + DstInitInputData%SimplAxCd = SrcInitInputData%SimplAxCd + DstInitInputData%SimplAxCdMG = SrcInitInputData%SimplAxCdMG + DstInitInputData%SimplAxCa = SrcInitInputData%SimplAxCa + DstInitInputData%SimplAxCaMG = SrcInitInputData%SimplAxCaMG + DstInitInputData%SimplAxCp = SrcInitInputData%SimplAxCp + DstInitInputData%SimplAxCpMG = SrcInitInputData%SimplAxCpMG + DstInitInputData%SimplCb = SrcInitInputData%SimplCb + DstInitInputData%SimplCbMg = SrcInitInputData%SimplCbMg + DstInitInputData%SimplMCF = SrcInitInputData%SimplMCF + DstInitInputData%NCoefDpth = SrcInitInputData%NCoefDpth + if (allocated(SrcInitInputData%CoefDpths)) then + LB(1:1) = lbound(SrcInitInputData%CoefDpths) + UB(1:1) = ubound(SrcInitInputData%CoefDpths) + if (.not. allocated(DstInitInputData%CoefDpths)) then + allocate(DstInitInputData%CoefDpths(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%CoefDpths.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call Morison_CopyCoefDpths(SrcInitInputData%CoefDpths(i1), DstInitInputData%CoefDpths(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + DstInitInputData%NCoefMembers = SrcInitInputData%NCoefMembers + if (allocated(SrcInitInputData%CoefMembers)) then + LB(1:1) = lbound(SrcInitInputData%CoefMembers) + UB(1:1) = ubound(SrcInitInputData%CoefMembers) + if (.not. allocated(DstInitInputData%CoefMembers)) then + allocate(DstInitInputData%CoefMembers(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%CoefMembers.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call Morison_CopyCoefMembers(SrcInitInputData%CoefMembers(i1), DstInitInputData%CoefMembers(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + DstInitInputData%NMembers = SrcInitInputData%NMembers + if (allocated(SrcInitInputData%InpMembers)) then + LB(1:1) = lbound(SrcInitInputData%InpMembers) + UB(1:1) = ubound(SrcInitInputData%InpMembers) + if (.not. allocated(DstInitInputData%InpMembers)) then + allocate(DstInitInputData%InpMembers(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%InpMembers.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call Morison_CopyMemberInputType(SrcInitInputData%InpMembers(i1), DstInitInputData%InpMembers(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + DstInitInputData%NFillGroups = SrcInitInputData%NFillGroups + if (allocated(SrcInitInputData%FilledGroups)) then + LB(1:1) = lbound(SrcInitInputData%FilledGroups) + UB(1:1) = ubound(SrcInitInputData%FilledGroups) + if (.not. allocated(DstInitInputData%FilledGroups)) then + allocate(DstInitInputData%FilledGroups(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%FilledGroups.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call Morison_CopyFilledGroupType(SrcInitInputData%FilledGroups(i1), DstInitInputData%FilledGroups(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + DstInitInputData%NMGDepths = SrcInitInputData%NMGDepths + if (allocated(SrcInitInputData%MGDepths)) then + LB(1:1) = lbound(SrcInitInputData%MGDepths) + UB(1:1) = ubound(SrcInitInputData%MGDepths) + if (.not. allocated(DstInitInputData%MGDepths)) then + allocate(DstInitInputData%MGDepths(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%MGDepths.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call Morison_CopyMGDepthsType(SrcInitInputData%MGDepths(i1), DstInitInputData%MGDepths(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + DstInitInputData%MGTop = SrcInitInputData%MGTop + DstInitInputData%MGBottom = SrcInitInputData%MGBottom + DstInitInputData%NMOutputs = SrcInitInputData%NMOutputs + if (allocated(SrcInitInputData%MOutLst)) then + LB(1:1) = lbound(SrcInitInputData%MOutLst) + UB(1:1) = ubound(SrcInitInputData%MOutLst) + if (.not. allocated(DstInitInputData%MOutLst)) then + allocate(DstInitInputData%MOutLst(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%MOutLst.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call Morison_CopyMOutput(SrcInitInputData%MOutLst(i1), DstInitInputData%MOutLst(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + DstInitInputData%NJOutputs = SrcInitInputData%NJOutputs + if (allocated(SrcInitInputData%JOutLst)) then + LB(1:1) = lbound(SrcInitInputData%JOutLst) + UB(1:1) = ubound(SrcInitInputData%JOutLst) + if (.not. allocated(DstInitInputData%JOutLst)) then + allocate(DstInitInputData%JOutLst(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%JOutLst.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call Morison_CopyJOutput(SrcInitInputData%JOutLst(i1), DstInitInputData%JOutLst(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcInitInputData%OutList)) then + LB(1:1) = lbound(SrcInitInputData%OutList) + UB(1:1) = ubound(SrcInitInputData%OutList) + if (.not. allocated(DstInitInputData%OutList)) then + allocate(DstInitInputData%OutList(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%OutList.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%OutList = SrcInitInputData%OutList + end if + DstInitInputData%NumOuts = SrcInitInputData%NumOuts + DstInitInputData%UnSum = SrcInitInputData%UnSum + DstInitInputData%WaveField => SrcInitInputData%WaveField + DstInitInputData%VisMeshes = SrcInitInputData%VisMeshes + DstInitInputData%PtfmYMod = SrcInitInputData%PtfmYMod +end subroutine + +subroutine Morison_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(Morison_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Morison_DestroyInitInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InitInputData%InpJoints)) then + LB(1:1) = lbound(InitInputData%InpJoints) + UB(1:1) = ubound(InitInputData%InpJoints) + do i1 = LB(1), UB(1) + call Morison_DestroyJointType(InitInputData%InpJoints(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InitInputData%InpJoints) + end if + if (allocated(InitInputData%Nodes)) then + LB(1:1) = lbound(InitInputData%Nodes) + UB(1:1) = ubound(InitInputData%Nodes) + do i1 = LB(1), UB(1) + call Morison_DestroyNodeType(InitInputData%Nodes(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InitInputData%Nodes) + end if + if (allocated(InitInputData%AxialCoefs)) then + LB(1:1) = lbound(InitInputData%AxialCoefs) + UB(1:1) = ubound(InitInputData%AxialCoefs) + do i1 = LB(1), UB(1) + call Morison_DestroyAxialCoefType(InitInputData%AxialCoefs(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InitInputData%AxialCoefs) + end if + if (allocated(InitInputData%MPropSets)) then + LB(1:1) = lbound(InitInputData%MPropSets) + UB(1:1) = ubound(InitInputData%MPropSets) + do i1 = LB(1), UB(1) + call Morison_DestroyMemberPropType(InitInputData%MPropSets(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InitInputData%MPropSets) + end if + if (allocated(InitInputData%CoefDpths)) then + LB(1:1) = lbound(InitInputData%CoefDpths) + UB(1:1) = ubound(InitInputData%CoefDpths) + do i1 = LB(1), UB(1) + call Morison_DestroyCoefDpths(InitInputData%CoefDpths(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InitInputData%CoefDpths) + end if + if (allocated(InitInputData%CoefMembers)) then + LB(1:1) = lbound(InitInputData%CoefMembers) + UB(1:1) = ubound(InitInputData%CoefMembers) + do i1 = LB(1), UB(1) + call Morison_DestroyCoefMembers(InitInputData%CoefMembers(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InitInputData%CoefMembers) + end if + if (allocated(InitInputData%InpMembers)) then + LB(1:1) = lbound(InitInputData%InpMembers) + UB(1:1) = ubound(InitInputData%InpMembers) + do i1 = LB(1), UB(1) + call Morison_DestroyMemberInputType(InitInputData%InpMembers(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InitInputData%InpMembers) + end if + if (allocated(InitInputData%FilledGroups)) then + LB(1:1) = lbound(InitInputData%FilledGroups) + UB(1:1) = ubound(InitInputData%FilledGroups) + do i1 = LB(1), UB(1) + call Morison_DestroyFilledGroupType(InitInputData%FilledGroups(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InitInputData%FilledGroups) + end if + if (allocated(InitInputData%MGDepths)) then + LB(1:1) = lbound(InitInputData%MGDepths) + UB(1:1) = ubound(InitInputData%MGDepths) + do i1 = LB(1), UB(1) + call Morison_DestroyMGDepthsType(InitInputData%MGDepths(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InitInputData%MGDepths) + end if + if (allocated(InitInputData%MOutLst)) then + LB(1:1) = lbound(InitInputData%MOutLst) + UB(1:1) = ubound(InitInputData%MOutLst) + do i1 = LB(1), UB(1) + call Morison_DestroyMOutput(InitInputData%MOutLst(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InitInputData%MOutLst) + end if + if (allocated(InitInputData%JOutLst)) then + LB(1:1) = lbound(InitInputData%JOutLst) + UB(1:1) = ubound(InitInputData%JOutLst) + do i1 = LB(1), UB(1) + call Morison_DestroyJOutput(InitInputData%JOutLst(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InitInputData%JOutLst) + end if + if (allocated(InitInputData%OutList)) then + deallocate(InitInputData%OutList) + end if + nullify(InitInputData%WaveField) +end subroutine + +subroutine Morison_PackInitInput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Morison_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Morison_PackInitInput' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + logical :: PtrInIndex + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%Gravity) + call RegPack(RF, InData%WaveDisp) + call RegPack(RF, InData%AMMod) + call RegPack(RF, InData%NJoints) + call RegPack(RF, InData%NNodes) + call RegPack(RF, allocated(InData%InpJoints)) + if (allocated(InData%InpJoints)) then + call RegPackBounds(RF, 1, lbound(InData%InpJoints), ubound(InData%InpJoints)) + LB(1:1) = lbound(InData%InpJoints) + UB(1:1) = ubound(InData%InpJoints) + do i1 = LB(1), UB(1) + call Morison_PackJointType(RF, InData%InpJoints(i1)) + end do + end if + call RegPack(RF, allocated(InData%Nodes)) + if (allocated(InData%Nodes)) then + call RegPackBounds(RF, 1, lbound(InData%Nodes), ubound(InData%Nodes)) + LB(1:1) = lbound(InData%Nodes) + UB(1:1) = ubound(InData%Nodes) + do i1 = LB(1), UB(1) + call Morison_PackNodeType(RF, InData%Nodes(i1)) + end do + end if + call RegPack(RF, InData%NAxCoefs) + call RegPack(RF, allocated(InData%AxialCoefs)) + if (allocated(InData%AxialCoefs)) then + call RegPackBounds(RF, 1, lbound(InData%AxialCoefs), ubound(InData%AxialCoefs)) + LB(1:1) = lbound(InData%AxialCoefs) + UB(1:1) = ubound(InData%AxialCoefs) + do i1 = LB(1), UB(1) + call Morison_PackAxialCoefType(RF, InData%AxialCoefs(i1)) + end do + end if + call RegPack(RF, InData%NPropSets) + call RegPack(RF, allocated(InData%MPropSets)) + if (allocated(InData%MPropSets)) then + call RegPackBounds(RF, 1, lbound(InData%MPropSets), ubound(InData%MPropSets)) + LB(1:1) = lbound(InData%MPropSets) + UB(1:1) = ubound(InData%MPropSets) + do i1 = LB(1), UB(1) + call Morison_PackMemberPropType(RF, InData%MPropSets(i1)) + end do + end if + call RegPack(RF, InData%SimplCd) + call RegPack(RF, InData%SimplCdMG) + call RegPack(RF, InData%SimplCa) + call RegPack(RF, InData%SimplCaMG) + call RegPack(RF, InData%SimplCp) + call RegPack(RF, InData%SimplCpMG) + call RegPack(RF, InData%SimplAxCd) + call RegPack(RF, InData%SimplAxCdMG) + call RegPack(RF, InData%SimplAxCa) + call RegPack(RF, InData%SimplAxCaMG) + call RegPack(RF, InData%SimplAxCp) + call RegPack(RF, InData%SimplAxCpMG) + call RegPack(RF, InData%SimplCb) + call RegPack(RF, InData%SimplCbMg) + call RegPack(RF, InData%SimplMCF) + call RegPack(RF, InData%NCoefDpth) + call RegPack(RF, allocated(InData%CoefDpths)) + if (allocated(InData%CoefDpths)) then + call RegPackBounds(RF, 1, lbound(InData%CoefDpths), ubound(InData%CoefDpths)) + LB(1:1) = lbound(InData%CoefDpths) + UB(1:1) = ubound(InData%CoefDpths) + do i1 = LB(1), UB(1) + call Morison_PackCoefDpths(RF, InData%CoefDpths(i1)) + end do + end if + call RegPack(RF, InData%NCoefMembers) + call RegPack(RF, allocated(InData%CoefMembers)) + if (allocated(InData%CoefMembers)) then + call RegPackBounds(RF, 1, lbound(InData%CoefMembers), ubound(InData%CoefMembers)) + LB(1:1) = lbound(InData%CoefMembers) + UB(1:1) = ubound(InData%CoefMembers) + do i1 = LB(1), UB(1) + call Morison_PackCoefMembers(RF, InData%CoefMembers(i1)) + end do + end if + call RegPack(RF, InData%NMembers) + call RegPack(RF, allocated(InData%InpMembers)) + if (allocated(InData%InpMembers)) then + call RegPackBounds(RF, 1, lbound(InData%InpMembers), ubound(InData%InpMembers)) + LB(1:1) = lbound(InData%InpMembers) + UB(1:1) = ubound(InData%InpMembers) + do i1 = LB(1), UB(1) + call Morison_PackMemberInputType(RF, InData%InpMembers(i1)) + end do + end if + call RegPack(RF, InData%NFillGroups) + call RegPack(RF, allocated(InData%FilledGroups)) + if (allocated(InData%FilledGroups)) then + call RegPackBounds(RF, 1, lbound(InData%FilledGroups), ubound(InData%FilledGroups)) + LB(1:1) = lbound(InData%FilledGroups) + UB(1:1) = ubound(InData%FilledGroups) + do i1 = LB(1), UB(1) + call Morison_PackFilledGroupType(RF, InData%FilledGroups(i1)) + end do + end if + call RegPack(RF, InData%NMGDepths) + call RegPack(RF, allocated(InData%MGDepths)) + if (allocated(InData%MGDepths)) then + call RegPackBounds(RF, 1, lbound(InData%MGDepths), ubound(InData%MGDepths)) + LB(1:1) = lbound(InData%MGDepths) + UB(1:1) = ubound(InData%MGDepths) + do i1 = LB(1), UB(1) + call Morison_PackMGDepthsType(RF, InData%MGDepths(i1)) + end do + end if + call RegPack(RF, InData%MGTop) + call RegPack(RF, InData%MGBottom) + call RegPack(RF, InData%NMOutputs) + call RegPack(RF, allocated(InData%MOutLst)) + if (allocated(InData%MOutLst)) then + call RegPackBounds(RF, 1, lbound(InData%MOutLst), ubound(InData%MOutLst)) + LB(1:1) = lbound(InData%MOutLst) + UB(1:1) = ubound(InData%MOutLst) + do i1 = LB(1), UB(1) + call Morison_PackMOutput(RF, InData%MOutLst(i1)) + end do + end if + call RegPack(RF, InData%NJOutputs) + call RegPack(RF, allocated(InData%JOutLst)) + if (allocated(InData%JOutLst)) then + call RegPackBounds(RF, 1, lbound(InData%JOutLst), ubound(InData%JOutLst)) + LB(1:1) = lbound(InData%JOutLst) + UB(1:1) = ubound(InData%JOutLst) + do i1 = LB(1), UB(1) + call Morison_PackJOutput(RF, InData%JOutLst(i1)) + end do + end if + call RegPackAlloc(RF, InData%OutList) + call RegPack(RF, InData%NumOuts) + call RegPack(RF, InData%UnSum) + call RegPack(RF, associated(InData%WaveField)) + if (associated(InData%WaveField)) then + call RegPackPointer(RF, c_loc(InData%WaveField), PtrInIndex) + if (.not. PtrInIndex) then + call SeaSt_WaveField_PackSeaSt_WaveFieldType(RF, InData%WaveField) + end if + end if + call RegPack(RF, InData%VisMeshes) + call RegPack(RF, InData%PtfmYMod) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Morison_UnPackInitInput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Morison_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Morison_UnPackInitInput' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(B8Ki) :: PtrIdx + type(c_ptr) :: Ptr + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%Gravity); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WaveDisp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AMMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NJoints); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NNodes); if (RegCheckErr(RF, RoutineName)) return + if (allocated(OutData%InpJoints)) deallocate(OutData%InpJoints) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%InpJoints(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InpJoints.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call Morison_UnpackJointType(RF, OutData%InpJoints(i1)) ! InpJoints + end do + end if + if (allocated(OutData%Nodes)) deallocate(OutData%Nodes) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%Nodes(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Nodes.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call Morison_UnpackNodeType(RF, OutData%Nodes(i1)) ! Nodes + end do + end if + call RegUnpack(RF, OutData%NAxCoefs); if (RegCheckErr(RF, RoutineName)) return + if (allocated(OutData%AxialCoefs)) deallocate(OutData%AxialCoefs) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%AxialCoefs(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AxialCoefs.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call Morison_UnpackAxialCoefType(RF, OutData%AxialCoefs(i1)) ! AxialCoefs + end do + end if + call RegUnpack(RF, OutData%NPropSets); if (RegCheckErr(RF, RoutineName)) return + if (allocated(OutData%MPropSets)) deallocate(OutData%MPropSets) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%MPropSets(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MPropSets.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call Morison_UnpackMemberPropType(RF, OutData%MPropSets(i1)) ! MPropSets + end do + end if + call RegUnpack(RF, OutData%SimplCd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SimplCdMG); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SimplCa); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SimplCaMG); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SimplCp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SimplCpMG); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SimplAxCd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SimplAxCdMG); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SimplAxCa); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SimplAxCaMG); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SimplAxCp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SimplAxCpMG); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SimplCb); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SimplCbMg); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SimplMCF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NCoefDpth); if (RegCheckErr(RF, RoutineName)) return + if (allocated(OutData%CoefDpths)) deallocate(OutData%CoefDpths) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%CoefDpths(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CoefDpths.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call Morison_UnpackCoefDpths(RF, OutData%CoefDpths(i1)) ! CoefDpths + end do + end if + call RegUnpack(RF, OutData%NCoefMembers); if (RegCheckErr(RF, RoutineName)) return + if (allocated(OutData%CoefMembers)) deallocate(OutData%CoefMembers) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%CoefMembers(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CoefMembers.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call Morison_UnpackCoefMembers(RF, OutData%CoefMembers(i1)) ! CoefMembers + end do + end if + call RegUnpack(RF, OutData%NMembers); if (RegCheckErr(RF, RoutineName)) return + if (allocated(OutData%InpMembers)) deallocate(OutData%InpMembers) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%InpMembers(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InpMembers.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call Morison_UnpackMemberInputType(RF, OutData%InpMembers(i1)) ! InpMembers + end do + end if + call RegUnpack(RF, OutData%NFillGroups); if (RegCheckErr(RF, RoutineName)) return + if (allocated(OutData%FilledGroups)) deallocate(OutData%FilledGroups) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%FilledGroups(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FilledGroups.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call Morison_UnpackFilledGroupType(RF, OutData%FilledGroups(i1)) ! FilledGroups + end do + end if + call RegUnpack(RF, OutData%NMGDepths); if (RegCheckErr(RF, RoutineName)) return + if (allocated(OutData%MGDepths)) deallocate(OutData%MGDepths) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%MGDepths(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MGDepths.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call Morison_UnpackMGDepthsType(RF, OutData%MGDepths(i1)) ! MGDepths + end do + end if + call RegUnpack(RF, OutData%MGTop); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MGBottom); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NMOutputs); if (RegCheckErr(RF, RoutineName)) return + if (allocated(OutData%MOutLst)) deallocate(OutData%MOutLst) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%MOutLst(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MOutLst.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call Morison_UnpackMOutput(RF, OutData%MOutLst(i1)) ! MOutLst + end do + end if + call RegUnpack(RF, OutData%NJOutputs); if (RegCheckErr(RF, RoutineName)) return + if (allocated(OutData%JOutLst)) deallocate(OutData%JOutLst) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%JOutLst(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%JOutLst.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call Morison_UnpackJOutput(RF, OutData%JOutLst(i1)) ! JOutLst + end do + end if + call RegUnpackAlloc(RF, OutData%OutList); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumOuts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UnSum); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%WaveField)) deallocate(OutData%WaveField) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackPointer(RF, Ptr, PtrIdx); if (RegCheckErr(RF, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveField) + else + allocate(OutData%WaveField,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveField.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + RF%Pointers(PtrIdx) = c_loc(OutData%WaveField) + call SeaSt_WaveField_UnpackSeaSt_WaveFieldType(RF, OutData%WaveField) ! WaveField + end if + else + OutData%WaveField => null() + end if + call RegUnpack(RF, OutData%VisMeshes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PtfmYMod); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Morison_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) + type(Morison_InitOutputType), intent(in) :: SrcInitOutputData + type(Morison_InitOutputType), intent(inout) :: DstInitOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'Morison_CopyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcInitOutputData%MorisonVisRad)) then + LB(1:1) = lbound(SrcInitOutputData%MorisonVisRad) + UB(1:1) = ubound(SrcInitOutputData%MorisonVisRad) + if (.not. allocated(DstInitOutputData%MorisonVisRad)) then + allocate(DstInitOutputData%MorisonVisRad(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%MorisonVisRad.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%MorisonVisRad = SrcInitOutputData%MorisonVisRad + end if + if (allocated(SrcInitOutputData%WriteOutputHdr)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) + if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then + allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitOutputData%WriteOutputUnt)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) + if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then + allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), 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 + end if +end subroutine + +subroutine Morison_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(Morison_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Morison_DestroyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InitOutputData%MorisonVisRad)) then + deallocate(InitOutputData%MorisonVisRad) + end if + if (allocated(InitOutputData%WriteOutputHdr)) then + deallocate(InitOutputData%WriteOutputHdr) + end if + if (allocated(InitOutputData%WriteOutputUnt)) then + deallocate(InitOutputData%WriteOutputUnt) + end if +end subroutine + +subroutine Morison_PackInitOutput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Morison_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Morison_PackInitOutput' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%MorisonVisRad) + call RegPackAlloc(RF, InData%WriteOutputHdr) + call RegPackAlloc(RF, InData%WriteOutputUnt) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Morison_UnPackInitOutput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Morison_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Morison_UnPackInitOutput' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%MorisonVisRad); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WriteOutputHdr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WriteOutputUnt); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Morison_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) + type(Morison_ContinuousStateType), intent(in) :: SrcContStateData + type(Morison_ContinuousStateType), intent(inout) :: DstContStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Morison_CopyContState' + ErrStat = ErrID_None + ErrMsg = '' + DstContStateData%DummyContState = SrcContStateData%DummyContState +end subroutine + +subroutine Morison_DestroyContState(ContStateData, ErrStat, ErrMsg) + type(Morison_ContinuousStateType), intent(inout) :: ContStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Morison_DestroyContState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine Morison_PackContState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Morison_ContinuousStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Morison_PackContState' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyContState) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Morison_UnPackContState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Morison_ContinuousStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Morison_UnPackContState' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyContState); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Morison_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) + type(Morison_DiscreteStateType), intent(in) :: SrcDiscStateData + type(Morison_DiscreteStateType), intent(inout) :: DstDiscStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'Morison_CopyDiscState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcDiscStateData%V_rel_n_FiltStat)) then + LB(1:1) = lbound(SrcDiscStateData%V_rel_n_FiltStat) + UB(1:1) = ubound(SrcDiscStateData%V_rel_n_FiltStat) + if (.not. allocated(DstDiscStateData%V_rel_n_FiltStat)) then + allocate(DstDiscStateData%V_rel_n_FiltStat(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%V_rel_n_FiltStat.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%V_rel_n_FiltStat = SrcDiscStateData%V_rel_n_FiltStat + end if +end subroutine + +subroutine Morison_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) + type(Morison_DiscreteStateType), intent(inout) :: DiscStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Morison_DestroyDiscState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(DiscStateData%V_rel_n_FiltStat)) then + deallocate(DiscStateData%V_rel_n_FiltStat) + end if +end subroutine + +subroutine Morison_PackDiscState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Morison_DiscreteStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Morison_PackDiscState' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%V_rel_n_FiltStat) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Morison_UnPackDiscState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Morison_DiscreteStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Morison_UnPackDiscState' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%V_rel_n_FiltStat); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Morison_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) + type(Morison_ConstraintStateType), intent(in) :: SrcConstrStateData + type(Morison_ConstraintStateType), intent(inout) :: DstConstrStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Morison_CopyConstrState' + ErrStat = ErrID_None + ErrMsg = '' + DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState +end subroutine + +subroutine Morison_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) + type(Morison_ConstraintStateType), intent(inout) :: ConstrStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Morison_DestroyConstrState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine Morison_PackConstrState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Morison_ConstraintStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Morison_PackConstrState' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyConstrState) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Morison_UnPackConstrState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Morison_ConstraintStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Morison_UnPackConstrState' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyConstrState); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Morison_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) + type(Morison_OtherStateType), intent(in) :: SrcOtherStateData + type(Morison_OtherStateType), intent(inout) :: DstOtherStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Morison_CopyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + DstOtherStateData%DummyOtherState = SrcOtherStateData%DummyOtherState +end subroutine + +subroutine Morison_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) + type(Morison_OtherStateType), intent(inout) :: OtherStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Morison_DestroyOtherState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine Morison_PackOtherState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Morison_OtherStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Morison_PackOtherState' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyOtherState) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Morison_UnPackOtherState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Morison_OtherStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Morison_UnPackOtherState' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyOtherState); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Morison_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(Morison_MiscVarType), intent(inout) :: SrcMiscData + type(Morison_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Morison_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcMiscData%DispNodePosHdn)) then + LB(1:2) = lbound(SrcMiscData%DispNodePosHdn) + UB(1:2) = ubound(SrcMiscData%DispNodePosHdn) + if (.not. allocated(DstMiscData%DispNodePosHdn)) then + allocate(DstMiscData%DispNodePosHdn(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%DispNodePosHdn.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%DispNodePosHdn = SrcMiscData%DispNodePosHdn + end if + if (allocated(SrcMiscData%DispNodePosHst)) then + LB(1:2) = lbound(SrcMiscData%DispNodePosHst) + UB(1:2) = ubound(SrcMiscData%DispNodePosHst) + if (.not. allocated(DstMiscData%DispNodePosHst)) then + allocate(DstMiscData%DispNodePosHst(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%DispNodePosHst.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%DispNodePosHst = SrcMiscData%DispNodePosHst + end if + if (allocated(SrcMiscData%FV)) then + LB(1:2) = lbound(SrcMiscData%FV) + UB(1:2) = ubound(SrcMiscData%FV) + if (.not. allocated(DstMiscData%FV)) then + allocate(DstMiscData%FV(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FV.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%FV = SrcMiscData%FV + end if + if (allocated(SrcMiscData%FA)) then + LB(1:2) = lbound(SrcMiscData%FA) + UB(1:2) = ubound(SrcMiscData%FA) + if (.not. allocated(DstMiscData%FA)) then + allocate(DstMiscData%FA(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FA.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%FA = SrcMiscData%FA + end if + if (allocated(SrcMiscData%FAMCF)) then + LB(1:2) = lbound(SrcMiscData%FAMCF) + UB(1:2) = ubound(SrcMiscData%FAMCF) + if (.not. allocated(DstMiscData%FAMCF)) then + allocate(DstMiscData%FAMCF(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FAMCF.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%FAMCF = SrcMiscData%FAMCF + end if + if (allocated(SrcMiscData%FDynP)) then + LB(1:1) = lbound(SrcMiscData%FDynP) + UB(1:1) = ubound(SrcMiscData%FDynP) + if (.not. allocated(DstMiscData%FDynP)) then + allocate(DstMiscData%FDynP(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FDynP.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%FDynP = SrcMiscData%FDynP + end if + if (allocated(SrcMiscData%WaveElev)) then + LB(1:1) = lbound(SrcMiscData%WaveElev) + UB(1:1) = ubound(SrcMiscData%WaveElev) + if (.not. allocated(DstMiscData%WaveElev)) then + allocate(DstMiscData%WaveElev(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%WaveElev.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%WaveElev = SrcMiscData%WaveElev + end if + if (allocated(SrcMiscData%WaveElev1)) then + LB(1:1) = lbound(SrcMiscData%WaveElev1) + UB(1:1) = ubound(SrcMiscData%WaveElev1) + if (.not. allocated(DstMiscData%WaveElev1)) then + allocate(DstMiscData%WaveElev1(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%WaveElev1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%WaveElev1 = SrcMiscData%WaveElev1 + end if + if (allocated(SrcMiscData%WaveElev2)) then + LB(1:1) = lbound(SrcMiscData%WaveElev2) + UB(1:1) = ubound(SrcMiscData%WaveElev2) + if (.not. allocated(DstMiscData%WaveElev2)) then + allocate(DstMiscData%WaveElev2(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%WaveElev2.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%WaveElev2 = SrcMiscData%WaveElev2 + end if + if (allocated(SrcMiscData%vrel)) then + LB(1:2) = lbound(SrcMiscData%vrel) + UB(1:2) = ubound(SrcMiscData%vrel) + if (.not. allocated(DstMiscData%vrel)) then + allocate(DstMiscData%vrel(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%vrel.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%vrel = SrcMiscData%vrel + end if + if (allocated(SrcMiscData%nodeInWater)) then + LB(1:1) = lbound(SrcMiscData%nodeInWater) + UB(1:1) = ubound(SrcMiscData%nodeInWater) + if (.not. allocated(DstMiscData%nodeInWater)) then + allocate(DstMiscData%nodeInWater(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%nodeInWater.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%nodeInWater = SrcMiscData%nodeInWater + end if + if (allocated(SrcMiscData%memberLoads)) then + LB(1:1) = lbound(SrcMiscData%memberLoads) + UB(1:1) = ubound(SrcMiscData%memberLoads) + if (.not. allocated(DstMiscData%memberLoads)) then + allocate(DstMiscData%memberLoads(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%memberLoads.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call Morison_CopyMemberLoads(SrcMiscData%memberLoads(i1), DstMiscData%memberLoads(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcMiscData%F_B_End)) then + LB(1:2) = lbound(SrcMiscData%F_B_End) + UB(1:2) = ubound(SrcMiscData%F_B_End) + if (.not. allocated(DstMiscData%F_B_End)) then + allocate(DstMiscData%F_B_End(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_B_End.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%F_B_End = SrcMiscData%F_B_End + end if + if (allocated(SrcMiscData%F_D_End)) then + LB(1:2) = lbound(SrcMiscData%F_D_End) + UB(1:2) = ubound(SrcMiscData%F_D_End) + if (.not. allocated(DstMiscData%F_D_End)) then + allocate(DstMiscData%F_D_End(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_D_End.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%F_D_End = SrcMiscData%F_D_End + end if + if (allocated(SrcMiscData%F_I_End)) then + LB(1:2) = lbound(SrcMiscData%F_I_End) + UB(1:2) = ubound(SrcMiscData%F_I_End) + if (.not. allocated(DstMiscData%F_I_End)) then + allocate(DstMiscData%F_I_End(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_I_End.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%F_I_End = SrcMiscData%F_I_End + end if + if (allocated(SrcMiscData%F_IMG_End)) then + LB(1:2) = lbound(SrcMiscData%F_IMG_End) + UB(1:2) = ubound(SrcMiscData%F_IMG_End) + if (.not. allocated(DstMiscData%F_IMG_End)) then + allocate(DstMiscData%F_IMG_End(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_IMG_End.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%F_IMG_End = SrcMiscData%F_IMG_End + end if + if (allocated(SrcMiscData%F_A_End)) then + LB(1:2) = lbound(SrcMiscData%F_A_End) + UB(1:2) = ubound(SrcMiscData%F_A_End) + if (.not. allocated(DstMiscData%F_A_End)) then + allocate(DstMiscData%F_A_End(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_A_End.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%F_A_End = SrcMiscData%F_A_End + end if + if (allocated(SrcMiscData%F_BF_End)) then + LB(1:2) = lbound(SrcMiscData%F_BF_End) + UB(1:2) = ubound(SrcMiscData%F_BF_End) + if (.not. allocated(DstMiscData%F_BF_End)) then + allocate(DstMiscData%F_BF_End(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_BF_End.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%F_BF_End = SrcMiscData%F_BF_End + end if + if (allocated(SrcMiscData%V_rel_n)) then + LB(1:1) = lbound(SrcMiscData%V_rel_n) + UB(1:1) = ubound(SrcMiscData%V_rel_n) + if (.not. allocated(DstMiscData%V_rel_n)) then + allocate(DstMiscData%V_rel_n(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%V_rel_n.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%V_rel_n = SrcMiscData%V_rel_n + end if + if (allocated(SrcMiscData%V_rel_n_HiPass)) then + LB(1:1) = lbound(SrcMiscData%V_rel_n_HiPass) + UB(1:1) = ubound(SrcMiscData%V_rel_n_HiPass) + if (.not. allocated(DstMiscData%V_rel_n_HiPass)) then + allocate(DstMiscData%V_rel_n_HiPass(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%V_rel_n_HiPass.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%V_rel_n_HiPass = SrcMiscData%V_rel_n_HiPass + end if + call NWTC_Library_CopyMeshMapType(SrcMiscData%VisMeshMap, DstMiscData%VisMeshMap, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SeaSt_WaveField_CopyMisc(SrcMiscData%WaveField_m, DstMiscData%WaveField_m, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine Morison_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(Morison_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Morison_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(MiscData%DispNodePosHdn)) then + deallocate(MiscData%DispNodePosHdn) + end if + if (allocated(MiscData%DispNodePosHst)) then + deallocate(MiscData%DispNodePosHst) + end if + if (allocated(MiscData%FV)) then + deallocate(MiscData%FV) + end if + if (allocated(MiscData%FA)) then + deallocate(MiscData%FA) + end if + if (allocated(MiscData%FAMCF)) then + deallocate(MiscData%FAMCF) + end if + if (allocated(MiscData%FDynP)) then + deallocate(MiscData%FDynP) + end if + if (allocated(MiscData%WaveElev)) then + deallocate(MiscData%WaveElev) + end if + if (allocated(MiscData%WaveElev1)) then + deallocate(MiscData%WaveElev1) + end if + if (allocated(MiscData%WaveElev2)) then + deallocate(MiscData%WaveElev2) + end if + if (allocated(MiscData%vrel)) then + deallocate(MiscData%vrel) + end if + if (allocated(MiscData%nodeInWater)) then + deallocate(MiscData%nodeInWater) + end if + if (allocated(MiscData%memberLoads)) then + LB(1:1) = lbound(MiscData%memberLoads) + UB(1:1) = ubound(MiscData%memberLoads) + do i1 = LB(1), UB(1) + call Morison_DestroyMemberLoads(MiscData%memberLoads(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%memberLoads) + end if + if (allocated(MiscData%F_B_End)) then + deallocate(MiscData%F_B_End) + end if + if (allocated(MiscData%F_D_End)) then + deallocate(MiscData%F_D_End) + end if + if (allocated(MiscData%F_I_End)) then + deallocate(MiscData%F_I_End) + end if + if (allocated(MiscData%F_IMG_End)) then + deallocate(MiscData%F_IMG_End) + end if + if (allocated(MiscData%F_A_End)) then + deallocate(MiscData%F_A_End) + end if + if (allocated(MiscData%F_BF_End)) then + deallocate(MiscData%F_BF_End) + end if + if (allocated(MiscData%V_rel_n)) then + deallocate(MiscData%V_rel_n) + end if + if (allocated(MiscData%V_rel_n_HiPass)) then + deallocate(MiscData%V_rel_n_HiPass) + end if + call NWTC_Library_DestroyMeshMapType(MiscData%VisMeshMap, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SeaSt_WaveField_DestroyMisc(MiscData%WaveField_m, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine Morison_PackMisc(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Morison_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Morison_PackMisc' + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%DispNodePosHdn) + call RegPackAlloc(RF, InData%DispNodePosHst) + call RegPackAlloc(RF, InData%FV) + call RegPackAlloc(RF, InData%FA) + call RegPackAlloc(RF, InData%FAMCF) + call RegPackAlloc(RF, InData%FDynP) + call RegPackAlloc(RF, InData%WaveElev) + call RegPackAlloc(RF, InData%WaveElev1) + call RegPackAlloc(RF, InData%WaveElev2) + call RegPackAlloc(RF, InData%vrel) + call RegPackAlloc(RF, InData%nodeInWater) + call RegPack(RF, allocated(InData%memberLoads)) + if (allocated(InData%memberLoads)) then + call RegPackBounds(RF, 1, lbound(InData%memberLoads), ubound(InData%memberLoads)) + LB(1:1) = lbound(InData%memberLoads) + UB(1:1) = ubound(InData%memberLoads) + do i1 = LB(1), UB(1) + call Morison_PackMemberLoads(RF, InData%memberLoads(i1)) + end do + end if + call RegPackAlloc(RF, InData%F_B_End) + call RegPackAlloc(RF, InData%F_D_End) + call RegPackAlloc(RF, InData%F_I_End) + call RegPackAlloc(RF, InData%F_IMG_End) + call RegPackAlloc(RF, InData%F_A_End) + call RegPackAlloc(RF, InData%F_BF_End) + call RegPackAlloc(RF, InData%V_rel_n) + call RegPackAlloc(RF, InData%V_rel_n_HiPass) + call NWTC_Library_PackMeshMapType(RF, InData%VisMeshMap) + call SeaSt_WaveField_PackMisc(RF, InData%WaveField_m) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Morison_UnPackMisc(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Morison_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Morison_UnPackMisc' + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%DispNodePosHdn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%DispNodePosHst); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%FV); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%FA); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%FAMCF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%FDynP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WaveElev); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WaveElev1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WaveElev2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%vrel); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%nodeInWater); if (RegCheckErr(RF, RoutineName)) return + if (allocated(OutData%memberLoads)) deallocate(OutData%memberLoads) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%memberLoads(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%memberLoads.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call Morison_UnpackMemberLoads(RF, OutData%memberLoads(i1)) ! memberLoads + end do + end if + call RegUnpackAlloc(RF, OutData%F_B_End); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%F_D_End); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%F_I_End); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%F_IMG_End); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%F_A_End); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%F_BF_End); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%V_rel_n); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%V_rel_n_HiPass); if (RegCheckErr(RF, RoutineName)) return + call NWTC_Library_UnpackMeshMapType(RF, OutData%VisMeshMap) ! VisMeshMap + call SeaSt_WaveField_UnpackMisc(RF, OutData%WaveField_m) ! WaveField_m +end subroutine + +subroutine Morison_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(Morison_ParameterType), intent(in) :: SrcParamData + type(Morison_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Morison_CopyParam' + ErrStat = ErrID_None + ErrMsg = '' + DstParamData%DT = SrcParamData%DT + DstParamData%Gravity = SrcParamData%Gravity + DstParamData%WaveDisp = SrcParamData%WaveDisp + DstParamData%AMMod = SrcParamData%AMMod + DstParamData%NMembers = SrcParamData%NMembers + if (allocated(SrcParamData%Members)) then + LB(1:1) = lbound(SrcParamData%Members) + UB(1:1) = ubound(SrcParamData%Members) + if (.not. allocated(DstParamData%Members)) then + allocate(DstParamData%Members(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Members.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call Morison_CopyMemberType(SrcParamData%Members(i1), DstParamData%Members(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + DstParamData%NNodes = SrcParamData%NNodes + DstParamData%NJoints = SrcParamData%NJoints + if (allocated(SrcParamData%I_MG_End)) then + LB(1:3) = lbound(SrcParamData%I_MG_End) + UB(1:3) = ubound(SrcParamData%I_MG_End) + if (.not. allocated(DstParamData%I_MG_End)) then + allocate(DstParamData%I_MG_End(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%I_MG_End.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%I_MG_End = SrcParamData%I_MG_End + end if + if (allocated(SrcParamData%An_End)) then + LB(1:2) = lbound(SrcParamData%An_End) + UB(1:2) = ubound(SrcParamData%An_End) + if (.not. allocated(DstParamData%An_End)) then + allocate(DstParamData%An_End(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%An_End.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%An_End = SrcParamData%An_End + end if + if (allocated(SrcParamData%DragConst_End)) then + LB(1:1) = lbound(SrcParamData%DragConst_End) + UB(1:1) = ubound(SrcParamData%DragConst_End) + if (.not. allocated(DstParamData%DragConst_End)) then + allocate(DstParamData%DragConst_End(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%DragConst_End.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%DragConst_End = SrcParamData%DragConst_End + end if + if (allocated(SrcParamData%VRelNFiltConst)) then + LB(1:1) = lbound(SrcParamData%VRelNFiltConst) + UB(1:1) = ubound(SrcParamData%VRelNFiltConst) + if (.not. allocated(DstParamData%VRelNFiltConst)) then + allocate(DstParamData%VRelNFiltConst(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%VRelNFiltConst.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%VRelNFiltConst = SrcParamData%VRelNFiltConst + end if + if (allocated(SrcParamData%DragMod_End)) then + LB(1:1) = lbound(SrcParamData%DragMod_End) + UB(1:1) = ubound(SrcParamData%DragMod_End) + if (.not. allocated(DstParamData%DragMod_End)) then + allocate(DstParamData%DragMod_End(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%DragMod_End.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%DragMod_End = SrcParamData%DragMod_End + end if + if (allocated(SrcParamData%DragLoFSc_End)) then + LB(1:1) = lbound(SrcParamData%DragLoFSc_End) + UB(1:1) = ubound(SrcParamData%DragLoFSc_End) + if (.not. allocated(DstParamData%DragLoFSc_End)) then + allocate(DstParamData%DragLoFSc_End(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%DragLoFSc_End.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%DragLoFSc_End = SrcParamData%DragLoFSc_End + end if + if (allocated(SrcParamData%F_WMG_End)) then + LB(1:2) = lbound(SrcParamData%F_WMG_End) + UB(1:2) = ubound(SrcParamData%F_WMG_End) + if (.not. allocated(DstParamData%F_WMG_End)) then + allocate(DstParamData%F_WMG_End(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%F_WMG_End.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%F_WMG_End = SrcParamData%F_WMG_End + end if + if (allocated(SrcParamData%DP_Const_End)) then + LB(1:2) = lbound(SrcParamData%DP_Const_End) + UB(1:2) = ubound(SrcParamData%DP_Const_End) + if (.not. allocated(DstParamData%DP_Const_End)) then + allocate(DstParamData%DP_Const_End(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%DP_Const_End.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%DP_Const_End = SrcParamData%DP_Const_End + end if + if (allocated(SrcParamData%Mass_MG_End)) then + LB(1:1) = lbound(SrcParamData%Mass_MG_End) + UB(1:1) = ubound(SrcParamData%Mass_MG_End) + if (.not. allocated(DstParamData%Mass_MG_End)) then + allocate(DstParamData%Mass_MG_End(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Mass_MG_End.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Mass_MG_End = SrcParamData%Mass_MG_End + end if + if (allocated(SrcParamData%AM_End)) then + LB(1:3) = lbound(SrcParamData%AM_End) + UB(1:3) = ubound(SrcParamData%AM_End) + if (.not. allocated(DstParamData%AM_End)) then + allocate(DstParamData%AM_End(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AM_End.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%AM_End = SrcParamData%AM_End + end if + DstParamData%NMOutputs = SrcParamData%NMOutputs + if (allocated(SrcParamData%MOutLst)) then + LB(1:1) = lbound(SrcParamData%MOutLst) + UB(1:1) = ubound(SrcParamData%MOutLst) + if (.not. allocated(DstParamData%MOutLst)) then + allocate(DstParamData%MOutLst(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%MOutLst.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call Morison_CopyMOutput(SrcParamData%MOutLst(i1), DstParamData%MOutLst(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + DstParamData%NJOutputs = SrcParamData%NJOutputs + if (allocated(SrcParamData%JOutLst)) then + LB(1:1) = lbound(SrcParamData%JOutLst) + UB(1:1) = ubound(SrcParamData%JOutLst) + if (.not. allocated(DstParamData%JOutLst)) then + allocate(DstParamData%JOutLst(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%JOutLst.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call Morison_CopyJOutput(SrcParamData%JOutLst(i1), DstParamData%JOutLst(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcParamData%OutParam)) then + LB(1:1) = lbound(SrcParamData%OutParam) + UB(1:1) = ubound(SrcParamData%OutParam) + if (.not. allocated(DstParamData%OutParam)) then + allocate(DstParamData%OutParam(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutParam.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyOutParmType(SrcParamData%OutParam(i1), DstParamData%OutParam(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + DstParamData%NumOuts = SrcParamData%NumOuts + DstParamData%WaveField => SrcParamData%WaveField + DstParamData%VisMeshes = SrcParamData%VisMeshes + DstParamData%PtfmYMod = SrcParamData%PtfmYMod +end subroutine + +subroutine Morison_DestroyParam(ParamData, ErrStat, ErrMsg) + type(Morison_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Morison_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ParamData%Members)) then + LB(1:1) = lbound(ParamData%Members) + UB(1:1) = ubound(ParamData%Members) + do i1 = LB(1), UB(1) + call Morison_DestroyMemberType(ParamData%Members(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%Members) + end if + if (allocated(ParamData%I_MG_End)) then + deallocate(ParamData%I_MG_End) + end if + if (allocated(ParamData%An_End)) then + deallocate(ParamData%An_End) + end if + if (allocated(ParamData%DragConst_End)) then + deallocate(ParamData%DragConst_End) + end if + if (allocated(ParamData%VRelNFiltConst)) then + deallocate(ParamData%VRelNFiltConst) + end if + if (allocated(ParamData%DragMod_End)) then + deallocate(ParamData%DragMod_End) + end if + if (allocated(ParamData%DragLoFSc_End)) then + deallocate(ParamData%DragLoFSc_End) + end if + if (allocated(ParamData%F_WMG_End)) then + deallocate(ParamData%F_WMG_End) + end if + if (allocated(ParamData%DP_Const_End)) then + deallocate(ParamData%DP_Const_End) + end if + if (allocated(ParamData%Mass_MG_End)) then + deallocate(ParamData%Mass_MG_End) + end if + if (allocated(ParamData%AM_End)) then + deallocate(ParamData%AM_End) + end if + if (allocated(ParamData%MOutLst)) then + LB(1:1) = lbound(ParamData%MOutLst) + UB(1:1) = ubound(ParamData%MOutLst) + do i1 = LB(1), UB(1) + call Morison_DestroyMOutput(ParamData%MOutLst(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%MOutLst) + end if + if (allocated(ParamData%JOutLst)) then + LB(1:1) = lbound(ParamData%JOutLst) + UB(1:1) = ubound(ParamData%JOutLst) + do i1 = LB(1), UB(1) + call Morison_DestroyJOutput(ParamData%JOutLst(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%JOutLst) + end if + if (allocated(ParamData%OutParam)) then + LB(1:1) = lbound(ParamData%OutParam) + UB(1:1) = ubound(ParamData%OutParam) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyOutParmType(ParamData%OutParam(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%OutParam) + end if + nullify(ParamData%WaveField) +end subroutine + +subroutine Morison_PackParam(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Morison_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Morison_PackParam' + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) + logical :: PtrInIndex + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DT) + call RegPack(RF, InData%Gravity) + call RegPack(RF, InData%WaveDisp) + call RegPack(RF, InData%AMMod) + call RegPack(RF, InData%NMembers) + call RegPack(RF, allocated(InData%Members)) + if (allocated(InData%Members)) then + call RegPackBounds(RF, 1, lbound(InData%Members), ubound(InData%Members)) + LB(1:1) = lbound(InData%Members) + UB(1:1) = ubound(InData%Members) + do i1 = LB(1), UB(1) + call Morison_PackMemberType(RF, InData%Members(i1)) + end do + end if + call RegPack(RF, InData%NNodes) + call RegPack(RF, InData%NJoints) + call RegPackAlloc(RF, InData%I_MG_End) + call RegPackAlloc(RF, InData%An_End) + call RegPackAlloc(RF, InData%DragConst_End) + call RegPackAlloc(RF, InData%VRelNFiltConst) + call RegPackAlloc(RF, InData%DragMod_End) + call RegPackAlloc(RF, InData%DragLoFSc_End) + call RegPackAlloc(RF, InData%F_WMG_End) + call RegPackAlloc(RF, InData%DP_Const_End) + call RegPackAlloc(RF, InData%Mass_MG_End) + call RegPackAlloc(RF, InData%AM_End) + call RegPack(RF, InData%NMOutputs) + call RegPack(RF, allocated(InData%MOutLst)) + if (allocated(InData%MOutLst)) then + call RegPackBounds(RF, 1, lbound(InData%MOutLst), ubound(InData%MOutLst)) + LB(1:1) = lbound(InData%MOutLst) + UB(1:1) = ubound(InData%MOutLst) + do i1 = LB(1), UB(1) + call Morison_PackMOutput(RF, InData%MOutLst(i1)) + end do + end if + call RegPack(RF, InData%NJOutputs) + call RegPack(RF, allocated(InData%JOutLst)) + if (allocated(InData%JOutLst)) then + call RegPackBounds(RF, 1, lbound(InData%JOutLst), ubound(InData%JOutLst)) + LB(1:1) = lbound(InData%JOutLst) + UB(1:1) = ubound(InData%JOutLst) + do i1 = LB(1), UB(1) + call Morison_PackJOutput(RF, InData%JOutLst(i1)) + end do + end if + call RegPack(RF, allocated(InData%OutParam)) + if (allocated(InData%OutParam)) then + call RegPackBounds(RF, 1, lbound(InData%OutParam), ubound(InData%OutParam)) + LB(1:1) = lbound(InData%OutParam) + UB(1:1) = ubound(InData%OutParam) + do i1 = LB(1), UB(1) + call NWTC_Library_PackOutParmType(RF, InData%OutParam(i1)) + end do + end if + call RegPack(RF, InData%NumOuts) + call RegPack(RF, associated(InData%WaveField)) + if (associated(InData%WaveField)) then + call RegPackPointer(RF, c_loc(InData%WaveField), PtrInIndex) + if (.not. PtrInIndex) then + call SeaSt_WaveField_PackSeaSt_WaveFieldType(RF, InData%WaveField) + end if + end if + call RegPack(RF, InData%VisMeshes) + call RegPack(RF, InData%PtfmYMod) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Morison_UnPackParam(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Morison_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Morison_UnPackParam' + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(B8Ki) :: PtrIdx + type(c_ptr) :: Ptr + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Gravity); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WaveDisp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AMMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NMembers); if (RegCheckErr(RF, RoutineName)) return + if (allocated(OutData%Members)) deallocate(OutData%Members) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%Members(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Members.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call Morison_UnpackMemberType(RF, OutData%Members(i1)) ! Members + end do + end if + call RegUnpack(RF, OutData%NNodes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NJoints); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%I_MG_End); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%An_End); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%DragConst_End); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%VRelNFiltConst); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%DragMod_End); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%DragLoFSc_End); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%F_WMG_End); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%DP_Const_End); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Mass_MG_End); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AM_End); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NMOutputs); if (RegCheckErr(RF, RoutineName)) return + if (allocated(OutData%MOutLst)) deallocate(OutData%MOutLst) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%MOutLst(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MOutLst.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call Morison_UnpackMOutput(RF, OutData%MOutLst(i1)) ! MOutLst + end do + end if + call RegUnpack(RF, OutData%NJOutputs); if (RegCheckErr(RF, RoutineName)) return + if (allocated(OutData%JOutLst)) deallocate(OutData%JOutLst) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%JOutLst(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%JOutLst.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call Morison_UnpackJOutput(RF, OutData%JOutLst(i1)) ! JOutLst + end do + end if + if (allocated(OutData%OutParam)) deallocate(OutData%OutParam) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%OutParam(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackOutParmType(RF, OutData%OutParam(i1)) ! OutParam + end do + end if + call RegUnpack(RF, OutData%NumOuts); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%WaveField)) deallocate(OutData%WaveField) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackPointer(RF, Ptr, PtrIdx); if (RegCheckErr(RF, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveField) + else + allocate(OutData%WaveField,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveField.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + RF%Pointers(PtrIdx) = c_loc(OutData%WaveField) + call SeaSt_WaveField_UnpackSeaSt_WaveFieldType(RF, OutData%WaveField) ! WaveField + end if + else + OutData%WaveField => null() + end if + call RegUnpack(RF, OutData%VisMeshes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PtfmYMod); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Morison_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) + type(Morison_InputType), intent(inout) :: SrcInputData + type(Morison_InputType), intent(inout) :: DstInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Morison_CopyInput' + ErrStat = ErrID_None + ErrMsg = '' + call MeshCopy(SrcInputData%Mesh, DstInputData%Mesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstInputData%PtfmRefY = SrcInputData%PtfmRefY +end subroutine + +subroutine Morison_DestroyInput(InputData, ErrStat, ErrMsg) + type(Morison_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Morison_DestroyInput' + ErrStat = ErrID_None + ErrMsg = '' + call MeshDestroy( InputData%Mesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine Morison_PackInput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Morison_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Morison_PackInput' + if (RF%ErrStat >= AbortErrLev) return + call MeshPack(RF, InData%Mesh) + call RegPack(RF, InData%PtfmRefY) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Morison_UnPackInput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Morison_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Morison_UnPackInput' + if (RF%ErrStat /= ErrID_None) return + call MeshUnpack(RF, OutData%Mesh) ! Mesh + call RegUnpack(RF, OutData%PtfmRefY); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Morison_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(Morison_OutputType), intent(inout) :: SrcOutputData + type(Morison_OutputType), intent(inout) :: DstOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Morison_CopyOutput' + ErrStat = ErrID_None + ErrMsg = '' + call MeshCopy(SrcOutputData%Mesh, DstOutputData%Mesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcOutputData%VisMesh, DstOutputData%VisMesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcOutputData%WriteOutput)) then + LB(1:1) = lbound(SrcOutputData%WriteOutput) + UB(1:1) = ubound(SrcOutputData%WriteOutput) + if (.not. allocated(DstOutputData%WriteOutput)) then + allocate(DstOutputData%WriteOutput(LB(1):UB(1)), 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 + end if +end subroutine + +subroutine Morison_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(Morison_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Morison_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' + call MeshDestroy( OutputData%Mesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( OutputData%VisMesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(OutputData%WriteOutput)) then + deallocate(OutputData%WriteOutput) + end if +end subroutine + +subroutine Morison_PackOutput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Morison_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Morison_PackOutput' + if (RF%ErrStat >= AbortErrLev) return + call MeshPack(RF, InData%Mesh) + call MeshPack(RF, InData%VisMesh) + call RegPackAlloc(RF, InData%WriteOutput) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Morison_UnPackOutput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Morison_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Morison_UnPackOutput' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call MeshUnpack(RF, OutData%Mesh) ! Mesh + call MeshUnpack(RF, OutData%VisMesh) ! VisMesh + call RegUnpackAlloc(RF, OutData%WriteOutput); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Morison_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(Morison_InputType), intent(inout) :: u(:) ! Input at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Inputs + type(Morison_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 = 'Morison_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 Morison_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL Morison_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 Morison_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 Morison_Input_ExtrapInterp - - - SUBROUTINE Morison_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'Morison_Input_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(u)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(u)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(u) - 1 + select case (order) + case (0) + call Morison_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call Morison_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call Morison_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(u) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE Morison_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. @@ -12566,41 +4408,43 @@ SUBROUTINE Morison_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, Err ! !.................................................................................................................................. - TYPE(Morison_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 - TYPE(Morison_InputType), INTENT(INOUT) :: u2 ! Input at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs - TYPE(Morison_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 + TYPE(Morison_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 + TYPE(Morison_InputType), INTENT(INOUT) :: u2 ! Input at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs + TYPE(Morison_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 = 'Morison_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 + REAL(DbKi) :: t(2) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'Morison_Input_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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%Mesh, u2%Mesh, tin, u_out%Mesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - END SUBROUTINE Morison_Input_ExtrapInterp1 - - - SUBROUTINE Morison_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + CALL MeshExtrapInterp1(u1%Mesh, u2%Mesh, tin, u_out%Mesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + u_out%PtfmRefY = a1*u1%PtfmRefY + a2*u2%PtfmRefY +END SUBROUTINE + +SUBROUTINE Morison_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. @@ -12614,101 +4458,103 @@ SUBROUTINE Morison_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ! !.................................................................................................................................. - TYPE(Morison_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 > t3 - TYPE(Morison_InputType), INTENT(INOUT) :: u2 ! Input at t2 > t3 - TYPE(Morison_InputType), INTENT(INOUT) :: u3 ! Input at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs - TYPE(Morison_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 + TYPE(Morison_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 > t3 + TYPE(Morison_InputType), INTENT(INOUT) :: u2 ! Input at t2 > t3 + TYPE(Morison_InputType), INTENT(INOUT) :: u3 ! Input at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs + TYPE(Morison_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 = 'Morison_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) - + 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) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'Morison_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 + 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 + 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 + 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%Mesh, u2%Mesh, u3%Mesh, tin, u_out%Mesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - END SUBROUTINE Morison_Input_ExtrapInterp2 - - - SUBROUTINE Morison_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(Morison_OutputType), INTENT(INOUT) :: y(:) ! Output at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Outputs - TYPE(Morison_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 + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + CALL MeshExtrapInterp2(u1%Mesh, u2%Mesh, u3%Mesh, tin, u_out%Mesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + u_out%PtfmRefY = a1*u1%PtfmRefY + a2*u2%PtfmRefY + a3*u3%PtfmRefY +END SUBROUTINE + +subroutine Morison_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(Morison_OutputType), intent(inout) :: y(:) ! Output at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Outputs + type(Morison_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 = 'Morison_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 Morison_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL Morison_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 Morison_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 Morison_Output_ExtrapInterp - - - SUBROUTINE Morison_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'Morison_Output_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(y)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(y)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(y) - 1 + select case (order) + case (0) + call Morison_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call Morison_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call Morison_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(y) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE Morison_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. @@ -12720,51 +4566,49 @@ SUBROUTINE Morison_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, Er ! !.................................................................................................................................. - TYPE(Morison_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 - TYPE(Morison_OutputType), INTENT(INOUT) :: y2 ! Output at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs - TYPE(Morison_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 + TYPE(Morison_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 + TYPE(Morison_OutputType), INTENT(INOUT) :: y2 ! Output at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs + TYPE(Morison_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 = 'Morison_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 + REAL(DbKi) :: t(2) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'Morison_Output_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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%Mesh, y2%Mesh, tin, y_out%Mesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp1(y1%VisMesh, y2%VisMesh, tin, y_out%VisMesh, 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 Morison_Output_ExtrapInterp1 - - - SUBROUTINE Morison_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + CALL MeshExtrapInterp1(y1%Mesh, y2%Mesh, tin, y_out%Mesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp1(y1%VisMesh, y2%VisMesh, tin, y_out%VisMesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + END IF ! check if allocated +END SUBROUTINE + +SUBROUTINE Morison_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. @@ -12778,58 +4622,54 @@ SUBROUTINE Morison_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat ! !.................................................................................................................................. - TYPE(Morison_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 > t3 - TYPE(Morison_OutputType), INTENT(INOUT) :: y2 ! Output at t2 > t3 - TYPE(Morison_OutputType), INTENT(INOUT) :: y3 ! Output at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs - TYPE(Morison_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 + TYPE(Morison_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 > t3 + TYPE(Morison_OutputType), INTENT(INOUT) :: y2 ! Output at t2 > t3 + TYPE(Morison_OutputType), INTENT(INOUT) :: y3 ! Output at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs + TYPE(Morison_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 = 'Morison_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) - + 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) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'Morison_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 + 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 + 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 + 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%Mesh, y2%Mesh, y3%Mesh, tin, y_out%Mesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp2(y1%VisMesh, y2%VisMesh, y3%VisMesh, tin, y_out%VisMesh, 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 Morison_Output_ExtrapInterp2 - + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + CALL MeshExtrapInterp2(y1%Mesh, y2%Mesh, y3%Mesh, tin, y_out%Mesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp2(y1%VisMesh, y2%VisMesh, y3%VisMesh, tin, y_out%VisMesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + a3*y3%WriteOutput + END IF ! check if allocated +END SUBROUTINE END MODULE Morison_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/hydrodyn/src/SS_Excitation.f90 b/modules/hydrodyn/src/SS_Excitation.f90 index 5af0dd457c..125217fb3e 100644 --- a/modules/hydrodyn/src/SS_Excitation.f90 +++ b/modules/hydrodyn/src/SS_Excitation.f90 @@ -20,8 +20,8 @@ ! !********************************************************************************************************************************** MODULE SS_Excitation - - USE SS_Excitation_Types + USE SS_Excitation_Types + use SeaSt_WaveField, only: WaveField_GetNodeTotalWaveElev USE NWTC_Library IMPLICIT NONE @@ -77,7 +77,50 @@ subroutine TransformStateSpaceMatrices( NBody, RotZ, C ) end do end subroutine TransformStateSpaceMatrices + +function GetWaveElevation ( time, u_in, t_in, p, m, ErrStat, ErrMsg ) + real(DbKi), intent(in) :: time + TYPE(SS_Exc_InputType), INTENT(IN) :: u_in(:) ! Input at t1 > t2 > t3 + real(DbKi), intent(in) :: t_in(:) + TYPE(SS_Exc_ParameterType), INTENT(in) :: p !< Parameters + TYPE(SS_Exc_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 + + real(SiKi) :: GetWaveElevation(p%NBody) + TYPE(SS_Exc_InputType) :: u_out ! extra_interp result + integer :: iBody + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'GetWaveElevation' + + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" + + + if (p%ExctnDisp == 0) then + GetWaveElevation = InterpWrappedStpReal ( real(time, SiKi), p%WaveField%WaveTime, p%WaveField%WaveElev0, m%LastIndWave, p%WaveField%NStepWave + 1 ) + else + + call SS_Exc_CopyInput(u_in(1), u_out, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) ! allocates arrays so that SS_Exc_Input_ExtrapInterp will work + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + call SS_Exc_Input_ExtrapInterp(u_in, t_in, u_out, time, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + do iBody = 1, p%NBody +!FIXME: this is the total wave elevation. Should it include second order, or should it only include first order? + GetWaveElevation(iBody) = WaveField_GetNodeTotalWaveElev(p%WaveField, m%WaveField_m, time, u_out%PtfmPos(1:2,iBody), ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + + call SS_Exc_DestroyInput(u_out, ErrStat2, ErrMsg2 ) + + end if +end function GetWaveElevation !---------------------------------------------------------------------------------------------------------------------------------- !> 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. @@ -85,7 +128,7 @@ end subroutine TransformStateSpaceMatrices SUBROUTINE SS_Exc_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut, ErrStat, ErrMsg ) !.................................................................................................................................. - TYPE(SS_Exc_InitInputType), INTENT(IN ) :: InitInp !< Input data for initialization routine + TYPE(SS_Exc_InitInputType), INTENT(INOUT) :: InitInp !< Input data for initialization routine TYPE(SS_Exc_InputType), INTENT( OUT) :: u !< An initial guess for the input; input mesh must be defined TYPE(SS_Exc_ParameterType), INTENT( OUT) :: p !< Parameters TYPE(SS_Exc_ContinuousStateType), INTENT( OUT) :: x !< Initial continuous states @@ -111,25 +154,34 @@ SUBROUTINE SS_Exc_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Ini INTEGER :: Nlines ! Number of lines in the input file, used to determine N INTEGER :: UnSS ! I/O unit number for the WAMIT output file with the .ss extension; this file contains the state-space matrices. INTEGER :: Sttus ! Error in reading .ssexctn file - real(ReKi) :: WaveDir ! Temp wave direction angle (deg) + real(SiKi) :: WaveDir ! Temp wave direction angle (deg) character(3) :: bodystr integer :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 + character(1024) :: InFile + character(*), parameter :: RoutineName = 'SS_Exc_Init' ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" - - u%DummyInput = 0.0_ReKi + Allocate(u%PtfmPos(3,InitInp%NBody), Stat= ErrStat) + u%PtfmPos = 0.0_ReKi UnSS = -1 - p%numStates = 0 - p%NBody = InitInp%NBody ! Number of WAMIT bodies: =1 if WAMIT is using NBodyMod > 1, >=1 if NBodyMod=1 - + p%numStates = 0 + + ! Set wave field data and parameters from InitInp: + p%WaveField => InitInp%WaveField + + p%ExctnDisp = InitInp%ExctnDisp + p%NBody = InitInp%NBody ! Number of WAMIT bodies: =1 if WAMIT is using NBodyMod > 1, >=1 if NBodyMod=1 + + ! Open the .ss input file! + InFile = TRIM(InitInp%InputFile)//'.ssexctn' CALL GetNewUnit( UnSS ) - CALL OpenFInpFile ( UnSS, TRIM(InitInp%InputFile)//'.ssexctn', ErrStat2, ErrMsg2 ) ! Open file. - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'SS_Exc_Init') + CALL OpenFInpFile ( UnSS, TRIM(InFile), ErrStat2, ErrMsg2 ) ! Open file. + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) IF (ErrStat >= AbortErrLev) THEN CALL CleanUp() RETURN @@ -138,23 +190,24 @@ SUBROUTINE SS_Exc_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Ini ! Determine the number of states and size of the matrices Nlines = 1 - CALL ReadCom ( UnSS, TRIM(InitInp%InputFile)//'.ssexctn', 'Header',ErrStat2, ErrMsg2 )! Reads the first entire line (Title header) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'SS_Exc_Init') + CALL ReadCom ( UnSS, InFile, 'Header',ErrStat2, ErrMsg2 )! Reads the first entire line (Title header) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - CALL ReadVar( UnSS,TRIM(InitInp%InputFile)//'.ssexctn', WaveDir, 'WaveDir', 'Wave direction (deg)',ErrStat2, ErrMsg2) ! Reads in the second line, containing the wave direction - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'SS_Exc_Init') + CALL ReadVar( UnSS,InFile, WaveDir, 'WaveDir', 'Wave direction (deg)',ErrStat2, ErrMsg2) ! Reads in the second line, containing the wave direction + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! Check that excitation state-space file Beta angle (in degrees) matches the HydroDyn input file angle - if ( .not. EqualRealNos(InitInp%WaveDir, WaveDir) ) call SetErrStat(ErrID_FATAL,'HydroDyn Wave direction does not match the wave excitation wave direction',ErrStat,ErrMsg,'SS_Exc_Init') + if ( .not. EqualRealNos(InitInp%WaveField%WaveDir, WaveDir) ) call SetErrStat(ErrID_FATAL,'HydroDyn Wave direction does not match the wave excitation wave direction',ErrStat,ErrMsg,RoutineName) - CALL ReadVar( UnSS,TRIM(InitInp%InputFile)//'.ssexctn', p%Tc, 'p%Tc', 'Time offset (s)',ErrStat2, ErrMsg2) ! Reads in the third line, containing the number of states - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'SS_Exc_Init') - - CALL ReadVar( UnSS,TRIM(InitInp%InputFile)//'.ssexctn', p%numStates, 'p%numStates', 'Number of states',ErrStat2, ErrMsg2) ! Reads in the third line, containing the number of states - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'SS_Exc_Init') + CALL ReadVar( UnSS,InFile, p%Tc, 'p%Tc', 'Time offset (s)',ErrStat2, ErrMsg2) ! Reads in the third line, containing the number of states + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - CALL ReadAry( UnSS,TRIM(InitInp%InputFile)//'.ssexctn', p%spDOF, 6*p%NBody, 'p%spDOF', 'States per DOF',ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'SS_Exc_Init') + CALL ReadVar( UnSS,InFile, p%numStates, 'p%numStates', 'Number of states',ErrStat2, ErrMsg2) ! Reads in the third line, containing the number of states + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + call AllocAry( p%spdof, 6*p%NBody, 'p%spdof', ErrStat2, ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + CALL ReadAry( UnSS,InFile, p%spDOF, 6*p%NBody, 'p%spDOF', 'States per DOF',ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) IF (ErrStat >= AbortErrLev) THEN CALL CleanUp() @@ -162,7 +215,7 @@ SUBROUTINE SS_Exc_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Ini END IF DO !Loop through all the lines of the file - CALL ReadCom ( UnSS, TRIM(InitInp%InputFile)//'.ssexctn', 'Header',Sttus,ErrMsg2 )! Reads the first entire line (Title header) + CALL ReadCom ( UnSS, InFile, 'Header',Sttus,ErrMsg2 )! Reads the first entire line (Title header) IF ( Sttus == ErrID_None ) THEN ! .TRUE. when data is read in successfully Nlines=Nlines+1 ELSE !We must have reached the end of the file @@ -174,7 +227,7 @@ SUBROUTINE SS_Exc_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Ini !Verifications on the input file IF ( ( Nlines - 6*p%NBody ) / 2 /= p%numStates) THEN - CALL SetErrStat(ErrID_Severe,'Error in the input file .ssexctn: The size of the matrices does not correspond to the number of states!',ErrStat,ErrMsg,'SS_Exc_Init') + CALL SetErrStat(ErrID_Severe,'Error in the input file .ssexctn: The size of the matrices does not correspond to the number of states!',ErrStat,ErrMsg,RoutineName) END IF @@ -185,9 +238,9 @@ SUBROUTINE SS_Exc_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Ini ! Now we can allocate the temporary matrices A, B and C - CALL AllocAry( p%A, p%numStates, p%numStates, 'p%A', ErrStat2, ErrMsg2); CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'SS_Exc_Init') - CALL AllocAry( p%B, p%numStates, 'p%B', ErrStat2, ErrMsg2); CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'SS_Exc_Init') - CALL AllocAry( p%C, 6*p%NBody, p%numStates, 'p%C', ErrStat2, ErrMsg2); CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'SS_Exc_Init') + CALL AllocAry( p%A, p%numStates, p%numStates, 'p%A', ErrStat2, ErrMsg2); CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + CALL AllocAry( p%B, p%numStates, 'p%B', ErrStat2, ErrMsg2); CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + CALL AllocAry( p%C, 6*p%NBody, p%numStates, 'p%C', ErrStat2, ErrMsg2); CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) IF (ErrStat >= AbortErrLev) THEN CALL CleanUp() @@ -198,25 +251,25 @@ SUBROUTINE SS_Exc_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Ini REWIND (UNIT=UnSS) ! REWIND the file so we can read it in a second time. ! Skip the first 4 lines: (NOTE: no error handling here because we would have caught it the first time through) - CALL ReadCom ( UnSS, TRIM(InitInp%InputFile)//'.ssexctn', 'Header', ErrStat2, ErrMsg2 )! Reads the first entire line (Title header) - CALL ReadCom ( UnSS, TRIM(InitInp%InputFile)//'.ssexctn', 'Wave direction (deg)', ErrStat2, ErrMsg2 )! Reads the first entire line (Title header) - CALL ReadCom ( UnSS, TRIM(InitInp%InputFile)//'.ssexctn', 'Time offset (s)', ErrStat2, ErrMsg2 )! Reads the first entire line (Title header) - CALL ReadCom ( UnSS, TRIM(InitInp%InputFile)//'.ssexctn', 'Number of Excitation States', ErrStat2, ErrMsg2 )! Reads the first entire line (Title header) - CALL ReadCom ( UnSS, TRIM(InitInp%InputFile)//'.ssexctn', 'Number of states per dofs', ErrStat2, ErrMsg2 )! Reads the first entire line (Title header) + CALL ReadCom ( UnSS, InFile, 'Header', ErrStat2, ErrMsg2 )! Reads the first entire line (Title header) + CALL ReadCom ( UnSS, InFile, 'Wave direction (deg)', ErrStat2, ErrMsg2 )! Reads the first entire line (Title header) + CALL ReadCom ( UnSS, InFile, 'Time offset (s)', ErrStat2, ErrMsg2 )! Reads the first entire line (Title header) + CALL ReadCom ( UnSS, InFile, 'Number of Excitation States', ErrStat2, ErrMsg2 )! Reads the first entire line (Title header) + CALL ReadCom ( UnSS, InFile, 'Number of states per dofs', ErrStat2, ErrMsg2 )! Reads the first entire line (Title header) DO I = 1,p%numStates !Read A MatriX - CALL ReadAry( UnSS,TRIM(InitInp%InputFile)//'.ssexctn', p%A(I,:), p%numStates, 'p%A', 'A_Matrix',ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'SS_Exc_Init') + CALL ReadAry( UnSS,InFile, p%A(I,:), p%numStates, 'p%A', 'A_Matrix',ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) END DO DO I = 1,p%numStates !Read B Matrix - CALL ReadVar( UnSS, TRIM(InitInp%InputFile)//'.ssexctn', p%B(I), 'p%B', 'B_Matrix',ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'SS_Exc_Init') + CALL ReadVar( UnSS, InFile, p%B(I), 'p%B', 'B_Matrix',ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) END DO DO I = 1,6*p%NBody !Read C Matrix - CALL ReadAry( UnSS, TRIM(InitInp%InputFile)//'.ssexctn', p%C(I,:), p%numStates, 'p%C', 'C_Matrix',ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'SS_Exc_Init') + CALL ReadAry( UnSS, InFile, p%C(I,:), p%numStates, 'p%C', 'C_Matrix',ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) END DO CLOSE ( UnSS ) !Close .ss input file UnSS = -1 ! Indicate the file is closed @@ -230,28 +283,10 @@ SUBROUTINE SS_Exc_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Ini p%DT = Interval - ! Allocate Wave-elevation related arrays - p%NStepWave = InitInp%NStepWave - allocate ( p%WaveElev0(0:p%NStepWave) , STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal,'Error allocating p%WaveElev0 array',ErrStat,ErrMsg,'SS_Exc_Init') - end if - allocate ( p%WaveTime (0:p%NStepWave) , STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal,'Error allocating p%WaveTime array',ErrStat,ErrMsg,'SS_Exc_Init') - end if - - IF (ErrStat >= AbortErrLev) THEN - CALL CleanUp() - RETURN - END IF - - p%WaveTime = InitInp%WaveTime - p%WaveElev0 = InitInp%WaveElev0 ! Define initial system states here: - CALL AllocAry( x%x, p%numStates, 'x%x', ErrStat2, ErrMsg2); CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'SS_Exc_Init') + CALL AllocAry( x%x, p%numStates, 'x%x', ErrStat2, ErrMsg2); CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) IF (ErrStat >= AbortErrLev) THEN CALL CleanUp() RETURN @@ -264,7 +299,7 @@ SUBROUTINE SS_Exc_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Ini ! Define other States: DO I=1,SIZE(OtherState%xdot) - CALL SS_Exc_CopyContState( x, OtherState%xdot(i), MESH_NEWCOPY, ErrStat2, ErrMsg2); CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'SS_Exc_Init') + CALL SS_Exc_CopyContState( x, OtherState%xdot(i), MESH_NEWCOPY, ErrStat2, ErrMsg2); CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) END DO OtherState%n = -1 @@ -275,17 +310,17 @@ SUBROUTINE SS_Exc_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Ini ! no inputs ! Define system output initializations (set up mesh) here: - call AllocAry( y%y, p%NBody*6, 'y%y', ErrStat2, ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'SS_Exc_Init') + call AllocAry( y%y, p%NBody*6, 'y%y', ErrStat2, ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) y%y = 0 - call AllocAry( y%WriteOutput, 6*p%NBody+1, 'y%WriteOutput', ErrStat2, ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'SS_Rad_Init') + call AllocAry( y%WriteOutput, 6*p%NBody+1, 'y%WriteOutput', ErrStat2, ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) y%WriteOutput = 0 ! Define initialization-routine output here: ! For OpenFAST, these outputs are attached (via HydroDyn) to the Radiation Force/Moment channels within HydroDyn - call AllocAry( InitOut%WriteOutputHdr, 6*p%NBody+1, 'InitOut%WriteOutputHdr', ErrStat2, ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'SS_Rad_Init') - call AllocAry( InitOut%WriteOutputUnt, 6*p%NBody+1, 'InitOut%WriteOutputUnt', ErrStat2, ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'SS_Rad_Init') + call AllocAry( InitOut%WriteOutputHdr, 6*p%NBody+1, 'InitOut%WriteOutputHdr', ErrStat2, ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + call AllocAry( InitOut%WriteOutputUnt, 6*p%NBody+1, 'InitOut%WriteOutputUnt', ErrStat2, ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) InitOut%WriteOutputHdr(1) = 'Time' InitOut%WriteOutputUnt(1) = '(s) ' do i = 1, p%NBody @@ -304,7 +339,7 @@ END SUBROUTINE CleanUp END SUBROUTINE SS_Exc_Init !---------------------------------------------------------------------------------------------------------------------------------- -!> This routine is called at the end of the simulation. +!> This routine is called at the end of the simulation. It does NOT deallocate pointers to SeaState data. SUBROUTINE SS_Exc_End( u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) !.................................................................................................................................. @@ -320,7 +355,6 @@ SUBROUTINE SS_Exc_End( u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - ! Initialize ErrStat ErrStat = ErrID_None @@ -333,8 +367,8 @@ SUBROUTINE SS_Exc_End( u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) CALL SS_Exc_DestroyInput( u, ErrStat, ErrMsg ) - ! Destroy the parameter data: - + ! Destroy the parameter data, but don't deallocate SeaState data: + ! **** Note, this is called only from the SS Excitation driver code, so there should not be any issues with pointers on restart*** CALL SS_Exc_DestroyParam( p, ErrStat, ErrMsg ) @@ -387,15 +421,15 @@ SUBROUTINE SS_Exc_UpdateStates( t, n, Inputs, InputTimes, p, x, xd, z, OtherStat CASE (1) ! RK4 - CALL SS_Exc_RK4( t, n, InputTimes, p, x, xd, z, OtherState, m, ErrStat, ErrMsg ) + CALL SS_Exc_RK4( t, n, Inputs, InputTimes, p, x, xd, z, OtherState, m, ErrStat, ErrMsg ) CASE (2) ! AB4 - CALL SS_Exc_AB4( t, n, InputTimes, p, x, xd, z, OtherState, m, ErrStat, ErrMsg ) + CALL SS_Exc_AB4( t, n, Inputs, InputTimes, p, x, xd, z, OtherState, m, ErrStat, ErrMsg ) CASE (3) ! ABM4 - CALL SS_Exc_ABM4( t, n, InputTimes, p, x, xd, z, OtherState, m, ErrStat, ErrMsg ) + CALL SS_Exc_ABM4( t, n, Inputs, InputTimes, p, x, xd, z, OtherState, m, ErrStat, ErrMsg ) CASE DEFAULT !bjj: we already checked this at initialization, but for completeness: @@ -446,7 +480,7 @@ SUBROUTINE SS_Exc_CalcContStateDeriv( Time, waveElev0, p, x, xd, z, OtherState, !.................................................................................................................................. REAL(DbKi), INTENT(IN ) :: Time !< Current simulation time in seconds - REAL(SiKi), INTENT(IN ) :: waveElev0 !< Wave elevation at origin at time: Time (m) + REAL(SiKi), INTENT(IN ) :: waveElev0(:) !< Wave elevation at origin at time: Time (m) TYPE(SS_Exc_ParameterType), INTENT(IN ) :: p !< Parameters TYPE(SS_Exc_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at Time TYPE(SS_Exc_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at Time @@ -457,6 +491,8 @@ SUBROUTINE SS_Exc_CalcContStateDeriv( Time, waveElev0, p, x, xd, z, OtherState, INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + real(SiKi) :: Bwave(p%numStates) + integer(IntKi) :: i, iBody, spbody, count, iStart ! Initialize ErrStat ErrStat = ErrID_None @@ -470,8 +506,21 @@ SUBROUTINE SS_Exc_CalcContStateDeriv( Time, waveElev0, p, x, xd, z, OtherState, !Calc dxdt of a state space system ! [dxdt] = [A]*[xr]+B*[q] - - dxdt%x =matmul(p%A,x%x) + p%B * waveElev0 + spbody = 0 + count = 1 + iStart = 1 + do iBody=1,p%NBody + spbody = 0 + do i = 1,6 + spbody = spbody + p%spdof(count) + count = count + 1 + end do + + Bwave(iStart:iStart+spbody-1) = p%B(iStart:iStart+spbody-1)*waveElev0(iBody) + iStart = iStart + spBody + end do + + dxdt%x =matmul(p%A,x%x) + Bwave END SUBROUTINE SS_Exc_CalcContStateDeriv !---------------------------------------------------------------------------------------------------------------------------------- @@ -549,12 +598,13 @@ END SUBROUTINE SS_Exc_CalcConstrStateResidual !! Runge-Kutta." �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 SS_Exc_RK4( t, n, utimes, p, x, xd, z, OtherState, m, ErrStat, ErrMsg ) +SUBROUTINE SS_Exc_RK4( t, n, Inputs, 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 REAL(DbKi), INTENT(IN ) :: utimes(:) !< times of input + TYPE(SS_Exc_InputType), INTENT(INOUT) :: Inputs(:) !< Inputs at InputTimes TYPE(SS_Exc_ParameterType), INTENT(IN ) :: p !< Parameters TYPE(SS_Exc_ContinuousStateType), INTENT(INOUT) :: x !< Continuous states at t on input at t + dt on output TYPE(SS_Exc_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at t @@ -572,7 +622,7 @@ SUBROUTINE SS_Exc_RK4( t, n, utimes, p, x, xd, z, OtherState, m, ErrStat, ErrMsg TYPE(SS_Exc_ContinuousStateType) :: k3 ! RK4 constant; see above TYPE(SS_Exc_ContinuousStateType) :: k4 ! RK4 constant; see above TYPE(SS_Exc_ContinuousStateType) :: x_tmp ! Holds temporary modification to x - real(SiKi) :: waveElev0 ! interpolated value of the wave elevation at the origin + real(SiKi) :: waveElev0(p%NBody) ! interpolated value of the wave elevation at the origin INTEGER(IntKi) :: ErrStat2 ! local error status CHARACTER(ErrMsgLen) :: ErrMsg2 ! local error message (ErrMsg) @@ -594,8 +644,11 @@ SUBROUTINE SS_Exc_RK4( t, n, utimes, p, x, xd, z, OtherState, m, ErrStat, ErrMsg IF ( ErrStat >= AbortErrLev ) RETURN ! find waveElev0 for time, t+p%Tc - - waveElev0 = InterpWrappedStpReal ( REAL(t+p%Tc, SiKi), p%WaveTime(:), p%WaveElev0(:), m%LastIndWave, p%NStepWave + 1 ) + !TODO: Replace with function call which extracts the correct form of wave elevation based on ExctnDisp, etc. + waveElev0 = GetWaveElevation( t+p%Tc, Inputs, utimes, p, m, ErrStat2, ErrMsg2 ) + CALL CheckError(ErrStat2,ErrMsg2) + IF ( ErrStat >= AbortErrLev ) RETURN + !waveElev0 = InterpWrappedStpReal ( REAL(t+p%Tc, SiKi), p%WaveTime(:), p%WaveElev0(:), m%LastIndWave, p%NStepWave + 1 ) ! find xdot at t CALL SS_Exc_CalcContStateDeriv( t, waveElev0, p, x, xd, z, OtherState, m, xdot, ErrStat2, ErrMsg2 ) CALL CheckError(ErrStat2,ErrMsg2) @@ -605,7 +658,11 @@ SUBROUTINE SS_Exc_RK4( t, n, utimes, p, x, xd, z, OtherState, m, ErrStat, ErrMsg x_tmp%x = x%x + 0.5 * k1%x ! find waveElev0 for time, t + p%Tc + dt/2 - waveElev0 = InterpWrappedStpReal ( REAL(t+p%Tc+p%DT/2.0, SiKi), p%WaveTime(:), p%WaveElev0(:), m%LastIndWave, p%NStepWave + 1 ) + !TODO: Replace with function call which extracts the correct form of wave elevation based on ExctnDisp, etc. + waveElev0 = GetWaveElevation( t+p%Tc+p%DT/2.0, Inputs, utimes, p, m, ErrStat2, ErrMsg2 ) + CALL CheckError(ErrStat2,ErrMsg2) + IF ( ErrStat >= AbortErrLev ) RETURN + !waveElev0 = InterpWrappedStpReal ( REAL(t+p%Tc+p%DT/2.0, SiKi), p%WaveTime(:), p%WaveElev0(:), m%LastIndWave, p%NStepWave + 1 ) ! find xdot at t + dt/2 CALL SS_Exc_CalcContStateDeriv( t + 0.5*p%dt, waveElev0, p, x_tmp, xd, z, OtherState, m, xdot, ErrStat2, ErrMsg2 ) @@ -624,7 +681,11 @@ SUBROUTINE SS_Exc_RK4( t, n, utimes, p, x, xd, z, OtherState, m, ErrStat, ErrMsg x_tmp%x = x%x + k3%x ! find waveElev0 for time, (t + p%Tc + dt) - waveElev0 = InterpWrappedStpReal ( REAL(t+p%Tc+p%DT, SiKi), p%WaveTime(:), p%WaveElev0(:), m%LastIndWave, p%NStepWave + 1 ) + !TODO: Replace with function call which extracts the correct form of wave elevation based on ExctnDisp, etc. + waveElev0 = GetWaveElevation( t+p%Tc+p%DT, Inputs, utimes, p, m, ErrStat2, ErrMsg2 ) + CALL CheckError(ErrStat2,ErrMsg2) + IF ( ErrStat >= AbortErrLev ) RETURN + !waveElev0 = InterpWrappedStpReal ( REAL(t+p%Tc+p%DT, SiKi), p%WaveTime(:), p%WaveElev0(:), m%LastIndWave, p%NStepWave + 1 ) ! find xdot at t + dt @@ -708,12 +769,13 @@ END SUBROUTINE SS_Exc_RK4 !! !! K. E. Atkinson, "An Introduction to Numerical Analysis", 1989, John Wiley & Sons, Inc, Second Edition. !! -SUBROUTINE SS_Exc_AB4( t, n, utimes, p, x, xd, z, OtherState, m, ErrStat, ErrMsg ) +SUBROUTINE SS_Exc_AB4( t, n, Inputs, 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 REAL(DbKi), INTENT(IN ) :: utimes(:) !< times of input + TYPE(SS_Exc_InputType), INTENT(INOUT) :: Inputs(:) !< Inputs at InputTimes TYPE(SS_Exc_ParameterType), INTENT(IN ) :: p !< Parameters TYPE(SS_Exc_ContinuousStateType), INTENT(INOUT) :: x !< Continuous states at t on input at t + dt on output TYPE(SS_Exc_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at t @@ -726,7 +788,7 @@ SUBROUTINE SS_Exc_AB4( t, n, utimes, p, x, xd, z, OtherState, m, ErrStat, ErrMsg ! local variables - real(SiKi) :: waveElev0 + real(SiKi) :: waveElev0(p%NBody) INTEGER(IntKi) :: ErrStat2 ! local error status CHARACTER(ErrMsgLen) :: ErrMsg2 ! local error message (ErrMsg) @@ -761,7 +823,11 @@ SUBROUTINE SS_Exc_AB4( t, n, utimes, p, x, xd, z, OtherState, m, ErrStat, ErrMsg endif ! find waveElev at t + Tc - waveElev0 = InterpWrappedStpReal ( REAL(t+p%Tc, SiKi), p%WaveTime(:), p%WaveElev0(:), m%LastIndWave, p%NStepWave + 1 ) + !TODO: Replace with function call which extracts the correct form of wave elevation based on ExctnDisp, etc. + waveElev0 = GetWaveElevation( t+p%Tc, Inputs, utimes, p, m, ErrStat2, ErrMsg2 ) + CALL CheckError(ErrStat2,ErrMsg2) + IF ( ErrStat >= AbortErrLev ) RETURN + !waveElev0 = InterpWrappedStpReal ( REAL(t+p%Tc, SiKi), p%WaveTime(:), p%WaveElev0(:), m%LastIndWave, p%NStepWave + 1 ) CALL SS_Exc_CalcContStateDeriv( t, waveElev0, p, x, xd, z, OtherState, m, OtherState%xdot ( 1 ), ErrStat2, ErrMsg2 ) ! initializes OtherState%xdot ( 1 ) CALL CheckError(ErrStat2,ErrMsg2) @@ -770,7 +836,7 @@ SUBROUTINE SS_Exc_AB4( t, n, utimes, p, x, xd, z, OtherState, m, ErrStat, ErrMsg if (n .le. 2) then - CALL SS_Exc_RK4(t, n, utimes, p, x, xd, z, OtherState, m, ErrStat2, ErrMsg2 ) + CALL SS_Exc_RK4(t, n, Inputs, utimes, p, x, xd, z, OtherState, m, ErrStat2, ErrMsg2 ) CALL CheckError(ErrStat2,ErrMsg2) IF ( ErrStat >= AbortErrLev ) RETURN @@ -836,12 +902,13 @@ END SUBROUTINE SS_Exc_AB4 !! or !! !! K. E. Atkinson, "An Introduction to Numerical Analysis", 1989, John Wiley & Sons, Inc, Second Edition. -SUBROUTINE SS_Exc_ABM4( t, n, utimes, p, x, xd, z, OtherState, m, ErrStat, ErrMsg ) +SUBROUTINE SS_Exc_ABM4( t, n, Inputs, 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 REAL(DbKi), INTENT(IN ) :: utimes(:) !< times of input + TYPE(SS_Exc_InputType), INTENT(INOUT) :: Inputs(:) !< Inputs at InputTimes TYPE(SS_Exc_ParameterType), INTENT(IN ) :: p !< Parameters TYPE(SS_Exc_ContinuousStateType), INTENT(INOUT) :: x !< Continuous states at t on input at t + dt on output TYPE(SS_Exc_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at t @@ -855,7 +922,7 @@ SUBROUTINE SS_Exc_ABM4( t, n, utimes, p, x, xd, z, OtherState, m, ErrStat, ErrMs TYPE(SS_Exc_ContinuousStateType) :: x_pred ! Continuous states at t TYPE(SS_Exc_ContinuousStateType) :: xdot_pred ! Derivative of continuous states at t - real(SiKi) :: waveElev0 + real(SiKi) :: waveElev0(p%NBody) INTEGER(IntKi) :: ErrStat2 ! local error status CHARACTER(ErrMsgLen) :: ErrMsg2 ! local error message (ErrMsg) @@ -869,13 +936,16 @@ SUBROUTINE SS_Exc_ABM4( t, n, utimes, p, x, xd, z, OtherState, m, ErrStat, ErrMs CALL CheckError(ErrStat2,ErrMsg2) IF ( ErrStat >= AbortErrLev ) RETURN - CALL SS_Exc_AB4( t, n, utimes, p, x_pred, xd, z, OtherState, m, ErrStat2, ErrMsg2 ) + CALL SS_Exc_AB4( t, n, Inputs, utimes, p, x_pred, xd, z, OtherState, m, ErrStat2, ErrMsg2 ) CALL CheckError(ErrStat2,ErrMsg2) IF ( ErrStat >= AbortErrLev ) RETURN if (n .gt. 2_IntKi) then - - waveElev0 = InterpWrappedStpReal ( REAL(t+p%Tc+p%DT, SiKi), p%WaveTime(:), p%WaveElev0(:), m%LastIndWave, p%NStepWave + 1 ) + !TODO: Replace with function call which extracts the correct form of wave elevation based on ExctnDisp, etc. + waveElev0 = GetWaveElevation( t+p%Tc+p%DT, Inputs, utimes, p, m, ErrStat2, ErrMsg2 ) + CALL CheckError(ErrStat2,ErrMsg2) + IF ( ErrStat >= AbortErrLev ) RETURN + !waveElev0 = InterpWrappedStpReal ( REAL(t+p%Tc+p%DT, SiKi), p%WaveTime(:), p%WaveElev0(:), m%LastIndWave, p%NStepWave + 1 ) CALL SS_Exc_CalcContStateDeriv(t + p%dt, waveElev0, p, x_pred, xd, z, OtherState, m, xdot_pred, ErrStat2, ErrMsg2 ) CALL CheckError(ErrStat2,ErrMsg2) IF ( ErrStat >= AbortErrLev ) RETURN diff --git a/modules/hydrodyn/src/SS_Excitation.txt b/modules/hydrodyn/src/SS_Excitation.txt index 251d863d7a..1372e9a823 100644 --- a/modules/hydrodyn/src/SS_Excitation.txt +++ b/modules/hydrodyn/src/SS_Excitation.txt @@ -14,22 +14,23 @@ # (File) Revision #: $Rev$ # URL: $HeadURL$ ################################################################################################################################### +usefrom SeaSt_WaveField.txt typedef SS_Excitation/SS_Exc InitInputType CHARACTER(1024) InputFile - - - "Name of the input file" - typedef ^ ^ IntKi NBody - - - "Number of WAMIT bodies for this State Space model" - -typedef ^ ^ ReKi WaveDir - - - "Wave direction" rad -typedef ^ ^ INTEGER NStepWave - - - "Number of timesteps in the WaveTime array" - +typedef ^ ^ IntKi ExctnDisp - - - "0: use undisplaced position, 1: use displaced position, 2: use low-pass filtered displaced position) [only used when PotMod=1 and ExctnMod>0]" - typedef ^ ^ R8Ki PtfmRefztRot {:} - - "The rotation about zt of the body reference frame(s) from xt/yt" radians -typedef ^ ^ SiKi WaveElev0 {:} - - "Wave elevation time history at origin" m -typedef ^ ^ SiKi WaveTime {:} - - "Times where wave elevation is known" s - +typedef ^ ^ SeaSt_WaveFieldType *WaveField - - - "Pointer to SeaState wave field" - + + + typedef ^ InitOutputType CHARACTER(10) WriteOutputHdr {:} - - "Header of the output" - typedef ^ InitOutputType CHARACTER(10) WriteOutputUnt {:} - - "Units of the output" - - + typedef ^ ContinuousStateType R8Ki x {:} - - "Continuous States" - - + typedef ^ DiscreteStateType SiKi DummyDiscState - - - "" - - + # Define constraint states here: typedef ^ ConstraintStateType SiKi DummyConstrState - - - "" - @@ -42,6 +43,7 @@ typedef ^ ^ SS_Exc_ContinuousStateType # Define any data that are used only for efficiency purposes (these variables are not associated with time): # e.g. indices for searching in an array, large arrays that are local variables in any routine called multiple times, etc. typedef ^ MiscVarType INTEGER LastIndWave - 1 - "last used index in the WaveTime array" - +typedef ^ ^ SeaSt_WaveField_MiscVarType WaveField_m - - - "misc var information from the SeaState Interpolation module" - # ..... Parameters ......................... @@ -50,19 +52,18 @@ typedef ^ MiscVarType INTEGER typedef ^ ParameterType DbKi DT - - - "Time step" s typedef ^ ^ IntKi NBody - - - "Number of WAMIT bodies for this State Space model" - -typedef ^ ^ INTEGER NStepWave - - - "Number of timesteps in the WaveTime array" - -typedef ^ ^ IntKi spDOF {6} - - "States per DOF" - +typedef ^ ^ IntKi ExctnDisp - - - "0: use undisplaced position, 1: use displaced position, 2: use low-pass filtered displaced position) [only used when PotMod=1 and ExctnMod>0]" - +typedef ^ ^ IntKi spDOF {:} - - "States per DOF" - typedef ^ ^ ReKi A {:}{:} - - "A matrix" - typedef ^ ^ ReKi B {:} - - "B matrix" - typedef ^ ^ ReKi C {:}{:} - - "C matrix" - typedef ^ ^ INTEGER numStates - 0 - "Number of states" - typedef ^ ^ DbKi Tc - - - "Time shift" s -typedef ^ ^ SiKi WaveElev0 {:} - - "Wave elevation time history at origin" m -typedef ^ ^ SiKi WaveTime {:} - - "Times where wave elevation is known" s +typedef ^ ^ SeaSt_WaveFieldType *WaveField - - - "Pointer to SeaState wave field" - # ..... Inputs ............................. # Define inputs that are contained on the mesh here: -typedef ^ InputType ReKi DummyInput - - - "Remove this variable if you have input variables" - +typedef ^ InputType ReKi PtfmPos {:}{:} - - "Positions of the NBody platforms. Used when ExctnDisp = 1. For NBodyMod = 2, use actual instantaneous position, otherwise use only displacement" - # ..... Outputs ............................ diff --git a/modules/hydrodyn/src/SS_Excitation_Driver.f90 b/modules/hydrodyn/src/SS_Excitation_Driver.f90 deleted file mode 100644 index e9170bf772..0000000000 --- a/modules/hydrodyn/src/SS_Excitation_Driver.f90 +++ /dev/null @@ -1,295 +0,0 @@ -!********************************************************************************************************************************** -! SS_Excitation_Driver: This code tests the SS_Excitation module -!.................................................................................................................................. -! LICENSING -! Copyright (C) 2018 National Renewable Energy Laboratory -! -! This file is part of SS_Excitation. -! -! 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 -! -!********************************************************************************************************************************** -PROGRAM SS_Excitation_Driver - - USE NWTC_Library - USE SS_Excitation - USE SS_Excitation_Types - - IMPLICIT NONE - - ! Program variables - - REAL(DbKi) :: Time ! Variable for storing time, in seconds - REAL(DbKi) :: waveDT - !REAL(DbKi) :: Time2(145201,1) ! Variable for storing time, in seconds - !REAL(DbKi) :: tdq(145201,7) ! Variable for storing time and body velocities, in m/s or rad/s - !REAL(DbKi) :: dq(145201,6) ! Variable for storing body velocities, in m/s or rad/s - REAL(DbKi) :: TimeInterval ! Interval between time steps, in seconds - !INTEGER(B1Ki), ALLOCATABLE :: SaveAry(:) ! Array to store packed data structure - - TYPE(SS_Exc_InitInputType) :: InitInData ! Input data for initialization - TYPE(SS_Exc_InitOutputType) :: InitOutData ! Output data from initialization - - TYPE(SS_Exc_ContinuousStateType) :: x ! Continuous states - TYPE(SS_Exc_ContinuousStateType) :: x_new ! Continuous states at updated time - TYPE(SS_Exc_DiscreteStateType) :: xd ! Discrete states - TYPE(SS_Exc_DiscreteStateType) :: xd_new ! Discrete states at updated time - TYPE(SS_Exc_ConstraintStateType) :: z ! Constraint states - TYPE(SS_Exc_ConstraintStateType) :: z_residual ! Residual of the constraint state equations (Z) - TYPE(SS_Exc_OtherStateType) :: OtherState ! Other states - - TYPE(SS_Exc_ParameterType) :: p ! Parameters - TYPE(SS_Exc_InputType) :: u(1) ! System inputs - REAL(DbKi) :: InputTimes(1) ! System input times - TYPE(SS_Exc_OutputType) :: y ! System outputs - TYPE(SS_Exc_MiscVarType) :: m ! misc/optimization variables - - TYPE(SS_Exc_ContinuousStateType) :: dxdt ! First time derivatives of the continuous states - - - - !Local Variables - INTEGER(IntKi) :: n ! Loop counter (for time step) - INTEGER(IntKi) :: I ! Loop counter (for time step) - INTEGER(IntKi) :: J ! Loop counter (for time step) - REAL(SiKi) :: ElevData - INTEGER(IntKi) :: UnWvEl ! Input file identifier - INTEGER(IntKi) :: Outputy ! Output file identifier - INTEGER(IntKi) :: ErrStat, ErrStat2 ! Status of error message - CHARACTER(1024) :: ErrMsg, ErrMsg2 ! Error message if ErrStat /= ErrID_None - INTEGER :: Sttus ! Error in reading input file - REAL(ReKi) :: Start ! CPU Time at start of the program - REAL(ReKi) :: Finnish ! CPU Time at the end of the program - REAL(ReKi) :: UsrTime - REAL(ReKi) :: Tratio - REAL(ReKi) :: Factor - CHARACTER(8) :: TimePer - INTEGER(4) :: EndTimes (8) ! An array holding the ending clock time of the simulation. - INTEGER(4) :: StrtTime (8) ! An array holding the starting clock time of the simulation. - REAL(ReKi) :: ClckTime - INTEGER :: len ! Number of input arguments - CHARACTER(1024) :: waveFile - - !............................................................................................................................... - ! Routines called in initialization - !............................................................................................................................... - - ErrStat = ErrID_None - ErrMsg = '' - - call NWTC_Init() - - ! Call Time - !call cpu_time(start) - !call DATE_AND_TIME ( Values=StrtTime ) - - - - ! Populate the InitInData data structure - - - ! This file name should be the WAMIT file name without extension! - InitInData%InputFile = 'C:\Dev\Envision\all-changes\Test_Models\5MW_Baseline\HydroData\barge' - InitInData%WaveDir = 0.0_ReKi - InitInData%NStepWave = 14520 - waveDT = 0.25 - allocate ( InitInData%WaveElev0(0:InitInData%NStepWave) , STAT=ErrStat2 ) - allocate ( InitInData%WaveTime (0:InitInData%NStepWave) , STAT=ErrStat2 ) - - ! Construct the wave times array - do i = 0,InitInData%NStepWave - InitInData%WaveTime(i) = waveDT*i - end do - - ! Need to read in the wave elevation data to pass in as initialization data - waveFile = 'C:\Dev\Envision\all-changes\Test_Models\5MW_ITIBarge_DLL_WTurb_WavesIrr\barge.Elev' - call GetNewUnit ( UnWvEl, ErrStat, ErrMsg ) - call OpenFInpFile ( UnWvEl, trim(waveFile), ErrStat, ErrMsg ) ! Open wave elevation file. - if ( ErrStat /= 0 ) then - ErrStat = ErrID_Fatal - ErrMsg = ' Could not open wave elevation file.' - print*, ( ErrMsg ) - end if - - call ReadCom ( UnWvEl, trim(waveFile), 'Header',ErrStat2, ErrMsg2 )! Reads the first entire line (Title header) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'SS_Excitation_Driver') - - do i = 0,InitInData%NStepWave - 1 - call ReadVar( UnWvEl,trim(waveFile), InitInData%WaveElev0(i), 'InitInData%WaveElev0(i)', 'Wave elevation',ErrStat2, ErrMsg2) ! Reads in the third line, containing the number of states - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'SS_Excitation_Driver') - end do - - close ( UnWvEl ) !Close dq input file - - ! Now set the last element of the Wave elevation array to match the initial elevation for wrapping - InitInData%WaveElev0(InitInData%NStepWave) = InitInData%WaveElev0(0) - - - - ! Set the driver's request for time interval here: This should be the Rdtn DT defined in the hydrodyn input file - TimeInterval = 0.005 - - CALL SS_Exc_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 - CALL WrScr( ErrMsg ) - END IF - - - - ! Initialize output file - call GetNewUnit ( Outputy, ErrStat, ErrMsg ) - CALL OpenFOutFile ( Outputy, (TRIM(InitInData%InputFile)//'.out'), ErrStat, ErrMsg) - IF ( ErrStat /= 0 ) THEN - ErrStat = ErrID_Fatal - ErrMsg = ' Error opening output file.' - CALL WrScr( ErrMsg ) - END IF - - WRITE(Outputy,*,IOSTAT=Sttus) InitOutData%WriteOutputHdr - IF ( Sttus /= 0 ) THEN - ErrStat = ErrID_Fatal - ErrMsg = ' Error writing output file.' - CALL WrScr( ErrMsg ) - ENDIF - - WRITE(Outputy,*,IOSTAT=Sttus) InitOutData%WriteOutputUnt - IF ( Sttus /= 0 ) THEN - ErrStat = ErrID_Fatal - ErrMsg = ' Error writing output file.' - CALL WrScr( ErrMsg ) - ENDIF - - !............................................................................................................................... - ! Routines called in loose coupling -- the glue code may implement this in various ways - !............................................................................................................................... - - CALL WrScr( 'Runnig SS_Excitation in Loose Coupling using a Adams-Bashforth-Moulton Method' ) - - CALL SS_Exc_CopyDiscState( xd, xd_new, MESH_NEWCOPY, 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 SS_Exc_CopyContState( x, x_new, MESH_NEWCOPY, 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 - ! - - DO n = 0,InitInData%NStepWave-1 - - Time = n*TimeInterval - InputTimes(1) = Time - - ! Get state variables at next step: constraint states (z) at step n, continuous and discrete states at step n + 1 - CALL SS_Exc_UpdateStates( Time, n, u, InputTimes, p, x_new, xd_new, 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 - !print*, x%x - ! Calculate outputs at n - - CALL SS_Exc_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 - - ! Update x and xd with continuous and discrete states at n + 1 - ! Note that the constraint state guess at n+1 is the value of the constraint state at n (so it doesn't need updating here) - - CALL SS_Exc_CopyContState( x_new, x, MESH_UPDATECOPY, 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 SS_Exc_CopyDiscState( xd_new, xd, MESH_UPDATECOPY, 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 Output to file - WRITE(Outputy,'(7(e16.6))',IOSTAT=Sttus) y%WriteOutput - IF ( Sttus /= 0 ) THEN - ErrStat = ErrID_Fatal - ErrMsg = ' Error writing output file.' - CALL WrScr( ErrMsg ) - print*, ErrMsg - ENDIF - END DO - - - CALL SS_Exc_DestroyDiscState( xd_new, 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 SS_Exc_DestroyContState( x_new, 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 - - - !............................................................................................................................... - ! Routine to terminate program execution - !............................................................................................................................... - CALL SS_Exc_End( u(1), p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) - IF ( ErrStat /= ErrID_None ) THEN - CALL WrScr( ErrMsg ) - END IF - - - !!!! GREG: This is also to ouput values (dont need it) - !CALL DATE_AND_TIME ( VALUES=EndTimes ) - !CALL cpu_time(finnish) - ! - !ClckTime = 0.001*( EndTimes(8) - StrtTime(8) ) + ( EndTimes(7) - StrtTime(7) ) + 60.0*( EndTimes(6) - StrtTime(6) ) & - ! + 3600.0*( EndTimes(5) - StrtTime(5) ) + 86400.0*( EndTimes(3) - StrtTime(3) ) - ! - !UsrTime = finnish-start - ! - !IF ( UsrTime /= 0.0 ) THEN - ! - !TRatio = Time / UsrTime - ! - !IF ( UsrTime > 86400.0 ) THEN - ! Factor = 1.0/86400.0 - ! TimePer = ' days' - !ELSEIF ( UsrTime > 3600.0 ) THEN - ! Factor = 1.0/3600.0 - ! TimePer = ' hours' - !ELSEIF ( UsrTime > 60.0 ) THEN - ! Factor = 1.0/60.0 - ! TimePer = ' minutes' - !ELSE - ! Factor = 1.0 - ! TimePer = ' seconds' - !ENDIF - ! - !CALL WrScr ( ' Total Real Time: '//TRIM( Flt2LStr( Factor*ClckTime ) )//TRIM( TimePer ) ) - !CALL WrScr ( ' Total CPU Time: '//TRIM( Flt2LStr( Factor*UsrTime ) )//TRIM( TimePer ) ) - !CALL WrScr ( ' Simulated Time: '//TRIM( Flt2LStr( Factor*REAL( Time ) ) )//TRIM( TimePer ) ) - !CALL WrScr ( ' Time Ratio (Sim/CPU): '//TRIM( Flt2LStr( TRatio ) ) ) - ! - !ENDIF - - - !!Write Output to file - ! WRITE(Outputy,'(1(e16.6))',IOSTAT=Sttus) TRatio - ! ! Ending routines - - CLOSE( Outputy ) - - - -END PROGRAM SS_Excitation_Driver - diff --git a/modules/hydrodyn/src/SS_Excitation_Types.f90 b/modules/hydrodyn/src/SS_Excitation_Types.f90 index df75e5077f..22ba2cac7b 100644 --- a/modules/hydrodyn/src/SS_Excitation_Types.f90 +++ b/modules/hydrodyn/src/SS_Excitation_Types.f90 @@ -31,17 +31,16 @@ !! unpack routines associated with each defined data type. This code is automatically generated by the FAST Registry. MODULE SS_Excitation_Types !--------------------------------------------------------------------------------------------------------------------------------- +USE SeaSt_WaveField_Types USE NWTC_Library IMPLICIT NONE ! ========= SS_Exc_InitInputType ======= TYPE, PUBLIC :: SS_Exc_InitInputType CHARACTER(1024) :: InputFile !< Name of the input file [-] - INTEGER(IntKi) :: NBody !< Number of WAMIT bodies for this State Space model [-] - REAL(ReKi) :: WaveDir !< Wave direction [rad] - INTEGER(IntKi) :: NStepWave !< Number of timesteps in the WaveTime array [-] + INTEGER(IntKi) :: NBody = 0_IntKi !< Number of WAMIT bodies for this State Space model [-] + INTEGER(IntKi) :: ExctnDisp = 0_IntKi !< 0: use undisplaced position, 1: use displaced position, 2: use low-pass filtered displaced position) [only used when PotMod=1 and ExctnMod>0] [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: PtfmRefztRot !< The rotation about zt of the body reference frame(s) from xt/yt [radians] - REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveElev0 !< Wave elevation time history at origin [m] - REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveTime !< Times where wave elevation is known [s] + TYPE(SeaSt_WaveFieldType) , POINTER :: WaveField => NULL() !< Pointer to SeaState wave field [-] END TYPE SS_Exc_InitInputType ! ======================= ! ========= SS_Exc_InitOutputType ======= @@ -57,43 +56,43 @@ MODULE SS_Excitation_Types ! ======================= ! ========= SS_Exc_DiscreteStateType ======= TYPE, PUBLIC :: SS_Exc_DiscreteStateType - REAL(SiKi) :: DummyDiscState !< [-] + REAL(SiKi) :: DummyDiscState = 0.0_R4Ki !< [-] END TYPE SS_Exc_DiscreteStateType ! ======================= ! ========= SS_Exc_ConstraintStateType ======= TYPE, PUBLIC :: SS_Exc_ConstraintStateType - REAL(SiKi) :: DummyConstrState !< [-] + REAL(SiKi) :: DummyConstrState = 0.0_R4Ki !< [-] END TYPE SS_Exc_ConstraintStateType ! ======================= ! ========= SS_Exc_OtherStateType ======= TYPE, PUBLIC :: SS_Exc_OtherStateType - INTEGER(IntKi) :: n !< Current Time step [-] + INTEGER(IntKi) :: n = 0_IntKi !< Current Time step [-] TYPE(SS_Exc_ContinuousStateType) , DIMENSION(1:4) :: xdot !< Old Values of dxdt to used by the solver (multistep method) [-] END TYPE SS_Exc_OtherStateType ! ======================= ! ========= SS_Exc_MiscVarType ======= TYPE, PUBLIC :: SS_Exc_MiscVarType INTEGER(IntKi) :: LastIndWave = 1 !< last used index in the WaveTime array [-] + TYPE(SeaSt_WaveField_MiscVarType) :: WaveField_m !< misc var information from the SeaState Interpolation module [-] END TYPE SS_Exc_MiscVarType ! ======================= ! ========= SS_Exc_ParameterType ======= TYPE, PUBLIC :: SS_Exc_ParameterType - REAL(DbKi) :: DT !< Time step [s] - INTEGER(IntKi) :: NBody !< Number of WAMIT bodies for this State Space model [-] - INTEGER(IntKi) :: NStepWave !< Number of timesteps in the WaveTime array [-] - INTEGER(IntKi) , DIMENSION(1:6) :: spDOF !< States per DOF [-] + REAL(DbKi) :: DT = 0.0_R8Ki !< Time step [s] + INTEGER(IntKi) :: NBody = 0_IntKi !< Number of WAMIT bodies for this State Space model [-] + INTEGER(IntKi) :: ExctnDisp = 0_IntKi !< 0: use undisplaced position, 1: use displaced position, 2: use low-pass filtered displaced position) [only used when PotMod=1 and ExctnMod>0] [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: spDOF !< States per DOF [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: A !< A matrix [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: B !< B matrix [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: C !< C matrix [-] INTEGER(IntKi) :: numStates = 0 !< Number of states [-] - REAL(DbKi) :: Tc !< Time shift [s] - REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveElev0 !< Wave elevation time history at origin [m] - REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveTime !< Times where wave elevation is known [s] + REAL(DbKi) :: Tc = 0.0_R8Ki !< Time shift [s] + TYPE(SeaSt_WaveFieldType) , POINTER :: WaveField => NULL() !< Pointer to SeaState wave field [-] END TYPE SS_Exc_ParameterType ! ======================= ! ========= SS_Exc_InputType ======= TYPE, PUBLIC :: SS_Exc_InputType - REAL(ReKi) :: DummyInput !< Remove this variable if you have input variables [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PtfmPos !< Positions of the NBody platforms. Used when ExctnDisp = 1. For NBodyMod = 2, use actual instantaneous position, otherwise use only displacement [-] END TYPE SS_Exc_InputType ! ======================= ! ========= SS_Exc_OutputType ======= @@ -103,2309 +102,775 @@ MODULE SS_Excitation_Types END TYPE SS_Exc_OutputType ! ======================= CONTAINS - SUBROUTINE SS_Exc_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SS_Exc_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(SS_Exc_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 = 'SS_Exc_CopyInitInput' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInitInputData%InputFile = SrcInitInputData%InputFile - DstInitInputData%NBody = SrcInitInputData%NBody - DstInitInputData%WaveDir = SrcInitInputData%WaveDir - DstInitInputData%NStepWave = SrcInitInputData%NStepWave -IF (ALLOCATED(SrcInitInputData%PtfmRefztRot)) THEN - i1_l = LBOUND(SrcInitInputData%PtfmRefztRot,1) - i1_u = UBOUND(SrcInitInputData%PtfmRefztRot,1) - IF (.NOT. ALLOCATED(DstInitInputData%PtfmRefztRot)) THEN - ALLOCATE(DstInitInputData%PtfmRefztRot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%PtfmRefztRot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%PtfmRefztRot = SrcInitInputData%PtfmRefztRot -ENDIF -IF (ALLOCATED(SrcInitInputData%WaveElev0)) THEN - i1_l = LBOUND(SrcInitInputData%WaveElev0,1) - i1_u = UBOUND(SrcInitInputData%WaveElev0,1) - IF (.NOT. ALLOCATED(DstInitInputData%WaveElev0)) THEN - ALLOCATE(DstInitInputData%WaveElev0(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveElev0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%WaveElev0 = SrcInitInputData%WaveElev0 -ENDIF -IF (ALLOCATED(SrcInitInputData%WaveTime)) THEN - i1_l = LBOUND(SrcInitInputData%WaveTime,1) - i1_u = UBOUND(SrcInitInputData%WaveTime,1) - IF (.NOT. ALLOCATED(DstInitInputData%WaveTime)) THEN - ALLOCATE(DstInitInputData%WaveTime(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveTime.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%WaveTime = SrcInitInputData%WaveTime -ENDIF - END SUBROUTINE SS_Exc_CopyInitInput - - SUBROUTINE SS_Exc_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(SS_Exc_InitInputType), INTENT(INOUT) :: InitInputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_DestroyInitInput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(InitInputData%PtfmRefztRot)) THEN - DEALLOCATE(InitInputData%PtfmRefztRot) -ENDIF -IF (ALLOCATED(InitInputData%WaveElev0)) THEN - DEALLOCATE(InitInputData%WaveElev0) -ENDIF -IF (ALLOCATED(InitInputData%WaveTime)) THEN - DEALLOCATE(InitInputData%WaveTime) -ENDIF - END SUBROUTINE SS_Exc_DestroyInitInput - - SUBROUTINE SS_Exc_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(SS_Exc_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 = 'SS_Exc_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 ! NBody - Re_BufSz = Re_BufSz + 1 ! WaveDir - Int_BufSz = Int_BufSz + 1 ! NStepWave - Int_BufSz = Int_BufSz + 1 ! PtfmRefztRot allocated yes/no - IF ( ALLOCATED(InData%PtfmRefztRot) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PtfmRefztRot upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%PtfmRefztRot) ! PtfmRefztRot - END IF - Int_BufSz = Int_BufSz + 1 ! WaveElev0 allocated yes/no - IF ( ALLOCATED(InData%WaveElev0) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WaveElev0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveElev0) ! WaveElev0 - END IF - Int_BufSz = Int_BufSz + 1 ! WaveTime allocated yes/no - IF ( ALLOCATED(InData%WaveTime) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WaveTime upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveTime) ! WaveTime - 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) = InData%NBody - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WaveDir - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NStepWave - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%PtfmRefztRot) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PtfmRefztRot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PtfmRefztRot,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PtfmRefztRot,1), UBOUND(InData%PtfmRefztRot,1) - DbKiBuf(Db_Xferred) = InData%PtfmRefztRot(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveElev0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev0,1) - Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WaveElev0,1), UBOUND(InData%WaveElev0,1) - ReKiBuf(Re_Xferred) = InData%WaveElev0(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveTime) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveTime,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveTime,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WaveTime,1), UBOUND(InData%WaveTime,1) - ReKiBuf(Re_Xferred) = InData%WaveTime(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE SS_Exc_PackInitInput - - SUBROUTINE SS_Exc_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(SS_Exc_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 = 'SS_Exc_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%NBody = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WaveDir = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NStepWave = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PtfmRefztRot not allocated - Int_Xferred = Int_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%PtfmRefztRot)) DEALLOCATE(OutData%PtfmRefztRot) - ALLOCATE(OutData%PtfmRefztRot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmRefztRot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PtfmRefztRot,1), UBOUND(OutData%PtfmRefztRot,1) - OutData%PtfmRefztRot(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElev0 not allocated - Int_Xferred = Int_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%WaveElev0)) DEALLOCATE(OutData%WaveElev0) - ALLOCATE(OutData%WaveElev0(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WaveElev0,1), UBOUND(OutData%WaveElev0,1) - OutData%WaveElev0(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveTime not allocated - Int_Xferred = Int_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%WaveTime)) DEALLOCATE(OutData%WaveTime) - ALLOCATE(OutData%WaveTime(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveTime.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WaveTime,1), UBOUND(OutData%WaveTime,1) - OutData%WaveTime(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE SS_Exc_UnPackInitInput - - SUBROUTINE SS_Exc_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SS_Exc_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(SS_Exc_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 = 'SS_Exc_CopyInitOutput' -! +subroutine SS_Exc_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) + type(SS_Exc_InitInputType), intent(in) :: SrcInitInputData + type(SS_Exc_InitInputType), intent(inout) :: DstInitInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SS_Exc_CopyInitInput' 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 SS_Exc_CopyInitOutput - - SUBROUTINE SS_Exc_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(SS_Exc_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_DestroyInitOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(InitOutputData%WriteOutputHdr)) THEN - DEALLOCATE(InitOutputData%WriteOutputHdr) -ENDIF -IF (ALLOCATED(InitOutputData%WriteOutputUnt)) THEN - DEALLOCATE(InitOutputData%WriteOutputUnt) -ENDIF - END SUBROUTINE SS_Exc_DestroyInitOutput - - SUBROUTINE SS_Exc_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(SS_Exc_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 = 'SS_Exc_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 - 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 SS_Exc_PackInitOutput - - SUBROUTINE SS_Exc_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(SS_Exc_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 = 'SS_Exc_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 - END SUBROUTINE SS_Exc_UnPackInitOutput - - SUBROUTINE SS_Exc_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SS_Exc_ContinuousStateType), INTENT(IN) :: SrcContStateData - TYPE(SS_Exc_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 = 'SS_Exc_CopyContState' -! + ErrMsg = '' + DstInitInputData%InputFile = SrcInitInputData%InputFile + DstInitInputData%NBody = SrcInitInputData%NBody + DstInitInputData%ExctnDisp = SrcInitInputData%ExctnDisp + if (allocated(SrcInitInputData%PtfmRefztRot)) then + LB(1:1) = lbound(SrcInitInputData%PtfmRefztRot) + UB(1:1) = ubound(SrcInitInputData%PtfmRefztRot) + if (.not. allocated(DstInitInputData%PtfmRefztRot)) then + allocate(DstInitInputData%PtfmRefztRot(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%PtfmRefztRot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%PtfmRefztRot = SrcInitInputData%PtfmRefztRot + end if + DstInitInputData%WaveField => SrcInitInputData%WaveField +end subroutine + +subroutine SS_Exc_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(SS_Exc_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SS_Exc_DestroyInitInput' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcContStateData%x)) THEN - i1_l = LBOUND(SrcContStateData%x,1) - i1_u = UBOUND(SrcContStateData%x,1) - IF (.NOT. ALLOCATED(DstContStateData%x)) THEN - ALLOCATE(DstContStateData%x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstContStateData%x = SrcContStateData%x -ENDIF - END SUBROUTINE SS_Exc_CopyContState - - SUBROUTINE SS_Exc_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(SS_Exc_ContinuousStateType), INTENT(INOUT) :: ContStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_DestroyContState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(ContStateData%x)) THEN - DEALLOCATE(ContStateData%x) -ENDIF - END SUBROUTINE SS_Exc_DestroyContState - - SUBROUTINE SS_Exc_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(SS_Exc_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 = 'SS_Exc_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 ! x allocated yes/no - IF ( ALLOCATED(InData%x) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! x upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%x) ! 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%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%x,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - DbKiBuf(Db_Xferred) = InData%x(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE SS_Exc_PackContState - - SUBROUTINE SS_Exc_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(SS_Exc_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 = 'SS_Exc_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 ! 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%x)) DEALLOCATE(OutData%x) - ALLOCATE(OutData%x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,1) - OutData%x(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE SS_Exc_UnPackContState - - SUBROUTINE SS_Exc_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SS_Exc_DiscreteStateType), INTENT(IN) :: SrcDiscStateData - TYPE(SS_Exc_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 = 'SS_Exc_CopyDiscState' -! + ErrMsg = '' + if (allocated(InitInputData%PtfmRefztRot)) then + deallocate(InitInputData%PtfmRefztRot) + end if + nullify(InitInputData%WaveField) +end subroutine + +subroutine SS_Exc_PackInitInput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SS_Exc_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SS_Exc_PackInitInput' + logical :: PtrInIndex + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%InputFile) + call RegPack(RF, InData%NBody) + call RegPack(RF, InData%ExctnDisp) + call RegPackAlloc(RF, InData%PtfmRefztRot) + call RegPack(RF, associated(InData%WaveField)) + if (associated(InData%WaveField)) then + call RegPackPointer(RF, c_loc(InData%WaveField), PtrInIndex) + if (.not. PtrInIndex) then + call SeaSt_WaveField_PackSeaSt_WaveFieldType(RF, InData%WaveField) + end if + end if + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SS_Exc_UnPackInitInput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SS_Exc_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SS_Exc_UnPackInitInput' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(B8Ki) :: PtrIdx + type(c_ptr) :: Ptr + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%InputFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NBody); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ExctnDisp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PtfmRefztRot); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%WaveField)) deallocate(OutData%WaveField) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackPointer(RF, Ptr, PtrIdx); if (RegCheckErr(RF, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveField) + else + allocate(OutData%WaveField,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveField.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + RF%Pointers(PtrIdx) = c_loc(OutData%WaveField) + call SeaSt_WaveField_UnpackSeaSt_WaveFieldType(RF, OutData%WaveField) ! WaveField + end if + else + OutData%WaveField => null() + end if +end subroutine + +subroutine SS_Exc_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) + type(SS_Exc_InitOutputType), intent(in) :: SrcInitOutputData + type(SS_Exc_InitOutputType), intent(inout) :: DstInitOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'SS_Exc_CopyInitOutput' ErrStat = ErrID_None - ErrMsg = "" - DstDiscStateData%DummyDiscState = SrcDiscStateData%DummyDiscState - END SUBROUTINE SS_Exc_CopyDiscState - - SUBROUTINE SS_Exc_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(SS_Exc_DiscreteStateType), INTENT(INOUT) :: DiscStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_DestroyDiscState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE SS_Exc_DestroyDiscState - - SUBROUTINE SS_Exc_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(SS_Exc_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 = 'SS_Exc_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 SS_Exc_PackDiscState - - SUBROUTINE SS_Exc_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(SS_Exc_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 = 'SS_Exc_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 = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE SS_Exc_UnPackDiscState - - SUBROUTINE SS_Exc_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SS_Exc_ConstraintStateType), INTENT(IN) :: SrcConstrStateData - TYPE(SS_Exc_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 = 'SS_Exc_CopyConstrState' -! + ErrMsg = '' + if (allocated(SrcInitOutputData%WriteOutputHdr)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) + if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then + allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitOutputData%WriteOutputUnt)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) + if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then + allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), 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 + end if +end subroutine + +subroutine SS_Exc_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(SS_Exc_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SS_Exc_DestroyInitOutput' ErrStat = ErrID_None - ErrMsg = "" - DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState - END SUBROUTINE SS_Exc_CopyConstrState - - SUBROUTINE SS_Exc_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(SS_Exc_ConstraintStateType), INTENT(INOUT) :: ConstrStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_DestroyConstrState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE SS_Exc_DestroyConstrState - - SUBROUTINE SS_Exc_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(SS_Exc_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 = 'SS_Exc_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 SS_Exc_PackConstrState - - SUBROUTINE SS_Exc_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(SS_Exc_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 = 'SS_Exc_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 = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE SS_Exc_UnPackConstrState - - SUBROUTINE SS_Exc_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SS_Exc_OtherStateType), INTENT(IN) :: SrcOtherStateData - TYPE(SS_Exc_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 = 'SS_Exc_CopyOtherState' -! + ErrMsg = '' + if (allocated(InitOutputData%WriteOutputHdr)) then + deallocate(InitOutputData%WriteOutputHdr) + end if + if (allocated(InitOutputData%WriteOutputUnt)) then + deallocate(InitOutputData%WriteOutputUnt) + end if +end subroutine + +subroutine SS_Exc_PackInitOutput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SS_Exc_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SS_Exc_PackInitOutput' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%WriteOutputHdr) + call RegPackAlloc(RF, InData%WriteOutputUnt) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SS_Exc_UnPackInitOutput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SS_Exc_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SS_Exc_UnPackInitOutput' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%WriteOutputHdr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WriteOutputUnt); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SS_Exc_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) + type(SS_Exc_ContinuousStateType), intent(in) :: SrcContStateData + type(SS_Exc_ContinuousStateType), intent(inout) :: DstContStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'SS_Exc_CopyContState' ErrStat = ErrID_None - ErrMsg = "" - DstOtherStateData%n = SrcOtherStateData%n - DO i1 = LBOUND(SrcOtherStateData%xdot,1), UBOUND(SrcOtherStateData%xdot,1) - CALL SS_Exc_CopyContState( SrcOtherStateData%xdot(i1), DstOtherStateData%xdot(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - END SUBROUTINE SS_Exc_CopyOtherState - - SUBROUTINE SS_Exc_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(SS_Exc_OtherStateType), INTENT(INOUT) :: OtherStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_DestroyOtherState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -DO i1 = LBOUND(OtherStateData%xdot,1), UBOUND(OtherStateData%xdot,1) - CALL SS_Exc_DestroyContState( OtherStateData%xdot(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - END SUBROUTINE SS_Exc_DestroyOtherState - - SUBROUTINE SS_Exc_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(SS_Exc_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 = 'SS_Exc_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 ! n - ! 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 SS_Exc_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 - 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%n - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%xdot,1), UBOUND(InData%xdot,1) - CALL SS_Exc_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 SUBROUTINE SS_Exc_PackOtherState - - SUBROUTINE SS_Exc_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(SS_Exc_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 = 'SS_Exc_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%n = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%xdot,1) - i1_u = UBOUND(OutData%xdot,1) - 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 SS_Exc_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 SUBROUTINE SS_Exc_UnPackOtherState - - SUBROUTINE SS_Exc_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SS_Exc_MiscVarType), INTENT(IN) :: SrcMiscData - TYPE(SS_Exc_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 = 'SS_Exc_CopyMisc' -! + ErrMsg = '' + if (allocated(SrcContStateData%x)) then + LB(1:1) = lbound(SrcContStateData%x) + UB(1:1) = ubound(SrcContStateData%x) + if (.not. allocated(DstContStateData%x)) then + allocate(DstContStateData%x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstContStateData%x = SrcContStateData%x + end if +end subroutine + +subroutine SS_Exc_DestroyContState(ContStateData, ErrStat, ErrMsg) + type(SS_Exc_ContinuousStateType), intent(inout) :: ContStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SS_Exc_DestroyContState' ErrStat = ErrID_None - ErrMsg = "" - DstMiscData%LastIndWave = SrcMiscData%LastIndWave - END SUBROUTINE SS_Exc_CopyMisc - - SUBROUTINE SS_Exc_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(SS_Exc_MiscVarType), INTENT(INOUT) :: MiscData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_DestroyMisc' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE SS_Exc_DestroyMisc - - SUBROUTINE SS_Exc_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(SS_Exc_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 = 'SS_Exc_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 ! LastIndWave - 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%LastIndWave - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE SS_Exc_PackMisc - - SUBROUTINE SS_Exc_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(SS_Exc_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 = 'SS_Exc_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%LastIndWave = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE SS_Exc_UnPackMisc - - SUBROUTINE SS_Exc_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SS_Exc_ParameterType), INTENT(IN) :: SrcParamData - TYPE(SS_Exc_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 = 'SS_Exc_CopyParam' -! + ErrMsg = '' + if (allocated(ContStateData%x)) then + deallocate(ContStateData%x) + end if +end subroutine + +subroutine SS_Exc_PackContState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SS_Exc_ContinuousStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SS_Exc_PackContState' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%x) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SS_Exc_UnPackContState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SS_Exc_ContinuousStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SS_Exc_UnPackContState' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%x); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SS_Exc_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) + type(SS_Exc_DiscreteStateType), intent(in) :: SrcDiscStateData + type(SS_Exc_DiscreteStateType), intent(inout) :: DstDiscStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SS_Exc_CopyDiscState' ErrStat = ErrID_None - ErrMsg = "" - DstParamData%DT = SrcParamData%DT - DstParamData%NBody = SrcParamData%NBody - DstParamData%NStepWave = SrcParamData%NStepWave - DstParamData%spDOF = SrcParamData%spDOF -IF (ALLOCATED(SrcParamData%A)) THEN - i1_l = LBOUND(SrcParamData%A,1) - i1_u = UBOUND(SrcParamData%A,1) - i2_l = LBOUND(SrcParamData%A,2) - i2_u = UBOUND(SrcParamData%A,2) - IF (.NOT. ALLOCATED(DstParamData%A)) THEN - ALLOCATE(DstParamData%A(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%A.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%A = SrcParamData%A -ENDIF -IF (ALLOCATED(SrcParamData%B)) THEN - i1_l = LBOUND(SrcParamData%B,1) - i1_u = UBOUND(SrcParamData%B,1) - IF (.NOT. ALLOCATED(DstParamData%B)) THEN - ALLOCATE(DstParamData%B(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%B.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%B = SrcParamData%B -ENDIF -IF (ALLOCATED(SrcParamData%C)) THEN - i1_l = LBOUND(SrcParamData%C,1) - i1_u = UBOUND(SrcParamData%C,1) - i2_l = LBOUND(SrcParamData%C,2) - i2_u = UBOUND(SrcParamData%C,2) - IF (.NOT. ALLOCATED(DstParamData%C)) THEN - ALLOCATE(DstParamData%C(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%C.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%C = SrcParamData%C -ENDIF - DstParamData%numStates = SrcParamData%numStates - DstParamData%Tc = SrcParamData%Tc -IF (ALLOCATED(SrcParamData%WaveElev0)) THEN - i1_l = LBOUND(SrcParamData%WaveElev0,1) - i1_u = UBOUND(SrcParamData%WaveElev0,1) - IF (.NOT. ALLOCATED(DstParamData%WaveElev0)) THEN - ALLOCATE(DstParamData%WaveElev0(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WaveElev0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%WaveElev0 = SrcParamData%WaveElev0 -ENDIF -IF (ALLOCATED(SrcParamData%WaveTime)) THEN - i1_l = LBOUND(SrcParamData%WaveTime,1) - i1_u = UBOUND(SrcParamData%WaveTime,1) - IF (.NOT. ALLOCATED(DstParamData%WaveTime)) THEN - ALLOCATE(DstParamData%WaveTime(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WaveTime.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%WaveTime = SrcParamData%WaveTime -ENDIF - END SUBROUTINE SS_Exc_CopyParam - - SUBROUTINE SS_Exc_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(SS_Exc_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(ParamData%A)) THEN - DEALLOCATE(ParamData%A) -ENDIF -IF (ALLOCATED(ParamData%B)) THEN - DEALLOCATE(ParamData%B) -ENDIF -IF (ALLOCATED(ParamData%C)) THEN - DEALLOCATE(ParamData%C) -ENDIF -IF (ALLOCATED(ParamData%WaveElev0)) THEN - DEALLOCATE(ParamData%WaveElev0) -ENDIF -IF (ALLOCATED(ParamData%WaveTime)) THEN - DEALLOCATE(ParamData%WaveTime) -ENDIF - END SUBROUTINE SS_Exc_DestroyParam - - SUBROUTINE SS_Exc_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(SS_Exc_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 = 'SS_Exc_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 ! NBody - Int_BufSz = Int_BufSz + 1 ! NStepWave - Int_BufSz = Int_BufSz + SIZE(InData%spDOF) ! spDOF - Int_BufSz = Int_BufSz + 1 ! A allocated yes/no - IF ( ALLOCATED(InData%A) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! 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*2 ! C upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%C) ! C - END IF - Int_BufSz = Int_BufSz + 1 ! numStates - Db_BufSz = Db_BufSz + 1 ! Tc - Int_BufSz = Int_BufSz + 1 ! WaveElev0 allocated yes/no - IF ( ALLOCATED(InData%WaveElev0) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WaveElev0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveElev0) ! WaveElev0 - END IF - Int_BufSz = Int_BufSz + 1 ! WaveTime allocated yes/no - IF ( ALLOCATED(InData%WaveTime) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WaveTime upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveTime) ! WaveTime - 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) = InData%NBody - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NStepWave - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%spDOF,1), UBOUND(InData%spDOF,1) - IntKiBuf(Int_Xferred) = InData%spDOF(i1) - Int_Xferred = Int_Xferred + 1 - END DO - 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 - IntKiBuf( Int_Xferred ) = LBOUND(InData%A,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%A,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%A,2), UBOUND(InData%A,2) - DO i1 = LBOUND(InData%A,1), UBOUND(InData%A,1) - ReKiBuf(Re_Xferred) = InData%A(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - 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 - IntKiBuf( Int_Xferred ) = LBOUND(InData%C,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%C,2), UBOUND(InData%C,2) - DO i1 = LBOUND(InData%C,1), UBOUND(InData%C,1) - ReKiBuf(Re_Xferred) = InData%C(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%numStates - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%Tc - Db_Xferred = Db_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%WaveElev0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev0,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WaveElev0,1), UBOUND(InData%WaveElev0,1) - ReKiBuf(Re_Xferred) = InData%WaveElev0(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveTime) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveTime,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveTime,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WaveTime,1), UBOUND(InData%WaveTime,1) - ReKiBuf(Re_Xferred) = InData%WaveTime(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE SS_Exc_PackParam - - SUBROUTINE SS_Exc_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(SS_Exc_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 = 'SS_Exc_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%NBody = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NStepWave = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%spDOF,1) - i1_u = UBOUND(OutData%spDOF,1) - DO i1 = LBOUND(OutData%spDOF,1), UBOUND(OutData%spDOF,1) - OutData%spDOF(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - 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 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%A)) DEALLOCATE(OutData%A) - ALLOCATE(OutData%A(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%A.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%A,2), UBOUND(OutData%A,2) - DO i1 = LBOUND(OutData%A,1), UBOUND(OutData%A,1) - OutData%A(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - 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 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%C)) DEALLOCATE(OutData%C) - ALLOCATE(OutData%C(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%C.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%C,2), UBOUND(OutData%C,2) - DO i1 = LBOUND(OutData%C,1), UBOUND(OutData%C,1) - OutData%C(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%numStates = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%Tc = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElev0 not allocated - Int_Xferred = Int_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%WaveElev0)) DEALLOCATE(OutData%WaveElev0) - ALLOCATE(OutData%WaveElev0(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WaveElev0,1), UBOUND(OutData%WaveElev0,1) - OutData%WaveElev0(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveTime not allocated - Int_Xferred = Int_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%WaveTime)) DEALLOCATE(OutData%WaveTime) - ALLOCATE(OutData%WaveTime(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveTime.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WaveTime,1), UBOUND(OutData%WaveTime,1) - OutData%WaveTime(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE SS_Exc_UnPackParam - - SUBROUTINE SS_Exc_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SS_Exc_InputType), INTENT(IN) :: SrcInputData - TYPE(SS_Exc_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 = 'SS_Exc_CopyInput' -! + ErrMsg = '' + DstDiscStateData%DummyDiscState = SrcDiscStateData%DummyDiscState +end subroutine + +subroutine SS_Exc_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) + type(SS_Exc_DiscreteStateType), intent(inout) :: DiscStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SS_Exc_DestroyDiscState' ErrStat = ErrID_None - ErrMsg = "" - DstInputData%DummyInput = SrcInputData%DummyInput - END SUBROUTINE SS_Exc_CopyInput - - SUBROUTINE SS_Exc_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(SS_Exc_InputType), INTENT(INOUT) :: InputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_DestroyInput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE SS_Exc_DestroyInput - - SUBROUTINE SS_Exc_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(SS_Exc_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 = 'SS_Exc_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) = InData%DummyInput - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE SS_Exc_PackInput - - SUBROUTINE SS_Exc_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(SS_Exc_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 = 'SS_Exc_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 SS_Exc_UnPackInput - - SUBROUTINE SS_Exc_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SS_Exc_OutputType), INTENT(IN) :: SrcOutputData - TYPE(SS_Exc_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 = 'SS_Exc_CopyOutput' -! + ErrMsg = '' +end subroutine + +subroutine SS_Exc_PackDiscState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SS_Exc_DiscreteStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SS_Exc_PackDiscState' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyDiscState) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SS_Exc_UnPackDiscState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SS_Exc_DiscreteStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SS_Exc_UnPackDiscState' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyDiscState); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SS_Exc_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) + type(SS_Exc_ConstraintStateType), intent(in) :: SrcConstrStateData + type(SS_Exc_ConstraintStateType), intent(inout) :: DstConstrStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SS_Exc_CopyConstrState' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcOutputData%y)) THEN - i1_l = LBOUND(SrcOutputData%y,1) - i1_u = UBOUND(SrcOutputData%y,1) - IF (.NOT. ALLOCATED(DstOutputData%y)) THEN - ALLOCATE(DstOutputData%y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%y = SrcOutputData%y -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 SS_Exc_CopyOutput - - SUBROUTINE SS_Exc_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(SS_Exc_OutputType), INTENT(INOUT) :: OutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_DestroyOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(OutputData%y)) THEN - DEALLOCATE(OutputData%y) -ENDIF -IF (ALLOCATED(OutputData%WriteOutput)) THEN - DEALLOCATE(OutputData%WriteOutput) -ENDIF - END SUBROUTINE SS_Exc_DestroyOutput - - SUBROUTINE SS_Exc_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(SS_Exc_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 = 'SS_Exc_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 ! y allocated yes/no - IF ( ALLOCATED(InData%y) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! y upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%y) ! y - 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 - - IF ( .NOT. ALLOCATED(InData%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%y,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%y,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%y,1), UBOUND(InData%y,1) - ReKiBuf(Re_Xferred) = InData%y(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 SS_Exc_PackOutput - - SUBROUTINE SS_Exc_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(SS_Exc_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 = 'SS_Exc_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 ! 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%y)) DEALLOCATE(OutData%y) - ALLOCATE(OutData%y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%y,1), UBOUND(OutData%y,1) - OutData%y(i1) = ReKiBuf(Re_Xferred) - 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 SS_Exc_UnPackOutput - - - SUBROUTINE SS_Exc_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(SS_Exc_InputType), INTENT(IN) :: u(:) ! Input at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Inputs - TYPE(SS_Exc_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 + ErrMsg = '' + DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState +end subroutine + +subroutine SS_Exc_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) + type(SS_Exc_ConstraintStateType), intent(inout) :: ConstrStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SS_Exc_DestroyConstrState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine SS_Exc_PackConstrState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SS_Exc_ConstraintStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SS_Exc_PackConstrState' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyConstrState) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SS_Exc_UnPackConstrState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SS_Exc_ConstraintStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SS_Exc_UnPackConstrState' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyConstrState); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SS_Exc_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) + type(SS_Exc_OtherStateType), intent(in) :: SrcOtherStateData + type(SS_Exc_OtherStateType), intent(inout) :: DstOtherStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SS_Exc_CopyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + DstOtherStateData%n = SrcOtherStateData%n + LB(1:1) = lbound(SrcOtherStateData%xdot) + UB(1:1) = ubound(SrcOtherStateData%xdot) + do i1 = LB(1), UB(1) + call SS_Exc_CopyContState(SrcOtherStateData%xdot(i1), DstOtherStateData%xdot(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do +end subroutine + +subroutine SS_Exc_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) + type(SS_Exc_OtherStateType), intent(inout) :: OtherStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SS_Exc_DestroyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + LB(1:1) = lbound(OtherStateData%xdot) + UB(1:1) = ubound(OtherStateData%xdot) + do i1 = LB(1), UB(1) + call SS_Exc_DestroyContState(OtherStateData%xdot(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do +end subroutine + +subroutine SS_Exc_PackOtherState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SS_Exc_OtherStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SS_Exc_PackOtherState' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%n) + LB(1:1) = lbound(InData%xdot) + UB(1:1) = ubound(InData%xdot) + do i1 = LB(1), UB(1) + call SS_Exc_PackContState(RF, InData%xdot(i1)) + end do + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SS_Exc_UnPackOtherState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SS_Exc_OtherStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SS_Exc_UnPackOtherState' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%n); if (RegCheckErr(RF, RoutineName)) return + LB(1:1) = lbound(OutData%xdot) + UB(1:1) = ubound(OutData%xdot) + do i1 = LB(1), UB(1) + call SS_Exc_UnpackContState(RF, OutData%xdot(i1)) ! xdot + end do +end subroutine + +subroutine SS_Exc_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(SS_Exc_MiscVarType), intent(in) :: SrcMiscData + type(SS_Exc_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SS_Exc_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + DstMiscData%LastIndWave = SrcMiscData%LastIndWave + call SeaSt_WaveField_CopyMisc(SrcMiscData%WaveField_m, DstMiscData%WaveField_m, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine SS_Exc_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(SS_Exc_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SS_Exc_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' + call SeaSt_WaveField_DestroyMisc(MiscData%WaveField_m, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine SS_Exc_PackMisc(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SS_Exc_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SS_Exc_PackMisc' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%LastIndWave) + call SeaSt_WaveField_PackMisc(RF, InData%WaveField_m) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SS_Exc_UnPackMisc(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SS_Exc_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SS_Exc_UnPackMisc' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%LastIndWave); if (RegCheckErr(RF, RoutineName)) return + call SeaSt_WaveField_UnpackMisc(RF, OutData%WaveField_m) ! WaveField_m +end subroutine + +subroutine SS_Exc_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(SS_Exc_ParameterType), intent(in) :: SrcParamData + type(SS_Exc_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SS_Exc_CopyParam' + ErrStat = ErrID_None + ErrMsg = '' + DstParamData%DT = SrcParamData%DT + DstParamData%NBody = SrcParamData%NBody + DstParamData%ExctnDisp = SrcParamData%ExctnDisp + if (allocated(SrcParamData%spDOF)) then + LB(1:1) = lbound(SrcParamData%spDOF) + UB(1:1) = ubound(SrcParamData%spDOF) + if (.not. allocated(DstParamData%spDOF)) then + allocate(DstParamData%spDOF(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%spDOF.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%spDOF = SrcParamData%spDOF + end if + if (allocated(SrcParamData%A)) then + LB(1:2) = lbound(SrcParamData%A) + UB(1:2) = ubound(SrcParamData%A) + if (.not. allocated(DstParamData%A)) then + allocate(DstParamData%A(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%A.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%A = SrcParamData%A + end if + if (allocated(SrcParamData%B)) then + LB(1:1) = lbound(SrcParamData%B) + UB(1:1) = ubound(SrcParamData%B) + if (.not. allocated(DstParamData%B)) then + allocate(DstParamData%B(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%B.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%B = SrcParamData%B + end if + if (allocated(SrcParamData%C)) then + LB(1:2) = lbound(SrcParamData%C) + UB(1:2) = ubound(SrcParamData%C) + if (.not. allocated(DstParamData%C)) then + allocate(DstParamData%C(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%C.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%C = SrcParamData%C + end if + DstParamData%numStates = SrcParamData%numStates + DstParamData%Tc = SrcParamData%Tc + DstParamData%WaveField => SrcParamData%WaveField +end subroutine + +subroutine SS_Exc_DestroyParam(ParamData, ErrStat, ErrMsg) + type(SS_Exc_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SS_Exc_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ParamData%spDOF)) then + deallocate(ParamData%spDOF) + end if + if (allocated(ParamData%A)) then + deallocate(ParamData%A) + end if + if (allocated(ParamData%B)) then + deallocate(ParamData%B) + end if + if (allocated(ParamData%C)) then + deallocate(ParamData%C) + end if + nullify(ParamData%WaveField) +end subroutine + +subroutine SS_Exc_PackParam(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SS_Exc_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SS_Exc_PackParam' + logical :: PtrInIndex + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DT) + call RegPack(RF, InData%NBody) + call RegPack(RF, InData%ExctnDisp) + call RegPackAlloc(RF, InData%spDOF) + call RegPackAlloc(RF, InData%A) + call RegPackAlloc(RF, InData%B) + call RegPackAlloc(RF, InData%C) + call RegPack(RF, InData%numStates) + call RegPack(RF, InData%Tc) + call RegPack(RF, associated(InData%WaveField)) + if (associated(InData%WaveField)) then + call RegPackPointer(RF, c_loc(InData%WaveField), PtrInIndex) + if (.not. PtrInIndex) then + call SeaSt_WaveField_PackSeaSt_WaveFieldType(RF, InData%WaveField) + end if + end if + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SS_Exc_UnPackParam(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SS_Exc_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SS_Exc_UnPackParam' + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(B8Ki) :: PtrIdx + type(c_ptr) :: Ptr + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NBody); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ExctnDisp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%spDOF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%A); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%B); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%C); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%numStates); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Tc); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%WaveField)) deallocate(OutData%WaveField) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackPointer(RF, Ptr, PtrIdx); if (RegCheckErr(RF, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveField) + else + allocate(OutData%WaveField,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveField.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + RF%Pointers(PtrIdx) = c_loc(OutData%WaveField) + call SeaSt_WaveField_UnpackSeaSt_WaveFieldType(RF, OutData%WaveField) ! WaveField + end if + else + OutData%WaveField => null() + end if +end subroutine + +subroutine SS_Exc_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) + type(SS_Exc_InputType), intent(in) :: SrcInputData + type(SS_Exc_InputType), intent(inout) :: DstInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'SS_Exc_CopyInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcInputData%PtfmPos)) then + LB(1:2) = lbound(SrcInputData%PtfmPos) + UB(1:2) = ubound(SrcInputData%PtfmPos) + if (.not. allocated(DstInputData%PtfmPos)) then + allocate(DstInputData%PtfmPos(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%PtfmPos.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%PtfmPos = SrcInputData%PtfmPos + end if +end subroutine + +subroutine SS_Exc_DestroyInput(InputData, ErrStat, ErrMsg) + type(SS_Exc_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SS_Exc_DestroyInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InputData%PtfmPos)) then + deallocate(InputData%PtfmPos) + end if +end subroutine + +subroutine SS_Exc_PackInput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SS_Exc_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SS_Exc_PackInput' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%PtfmPos) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SS_Exc_UnPackInput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SS_Exc_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SS_Exc_UnPackInput' + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%PtfmPos); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SS_Exc_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(SS_Exc_OutputType), intent(in) :: SrcOutputData + type(SS_Exc_OutputType), intent(inout) :: DstOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'SS_Exc_CopyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcOutputData%y)) then + LB(1:1) = lbound(SrcOutputData%y) + UB(1:1) = ubound(SrcOutputData%y) + if (.not. allocated(DstOutputData%y)) then + allocate(DstOutputData%y(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%y.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%y = SrcOutputData%y + end if + if (allocated(SrcOutputData%WriteOutput)) then + LB(1:1) = lbound(SrcOutputData%WriteOutput) + UB(1:1) = ubound(SrcOutputData%WriteOutput) + if (.not. allocated(DstOutputData%WriteOutput)) then + allocate(DstOutputData%WriteOutput(LB(1):UB(1)), 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 + end if +end subroutine + +subroutine SS_Exc_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(SS_Exc_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SS_Exc_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OutputData%y)) then + deallocate(OutputData%y) + end if + if (allocated(OutputData%WriteOutput)) then + deallocate(OutputData%WriteOutput) + end if +end subroutine + +subroutine SS_Exc_PackOutput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SS_Exc_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SS_Exc_PackOutput' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%y) + call RegPackAlloc(RF, InData%WriteOutput) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SS_Exc_UnPackOutput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SS_Exc_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SS_Exc_UnPackOutput' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WriteOutput); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SS_Exc_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(SS_Exc_InputType), intent(in) :: u(:) ! Input at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Inputs + type(SS_Exc_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 = 'SS_Exc_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 SS_Exc_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL SS_Exc_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 SS_Exc_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 SS_Exc_Input_ExtrapInterp - - - SUBROUTINE SS_Exc_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'SS_Exc_Input_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(u)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(u)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(u) - 1 + select case (order) + case (0) + call SS_Exc_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call SS_Exc_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call SS_Exc_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(u) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE SS_Exc_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. @@ -2417,41 +882,47 @@ SUBROUTINE SS_Exc_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrM ! !.................................................................................................................................. - TYPE(SS_Exc_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 - TYPE(SS_Exc_InputType), INTENT(IN) :: u2 ! Input at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs - TYPE(SS_Exc_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 + TYPE(SS_Exc_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 + TYPE(SS_Exc_InputType), INTENT(IN) :: u2 ! Input at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs + TYPE(SS_Exc_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 = 'SS_Exc_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 + REAL(DbKi) :: t(2) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_Input_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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 :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 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) - b = -(u1%DummyInput - u2%DummyInput) - u_out%DummyInput = u1%DummyInput + b * ScaleFactor - END SUBROUTINE SS_Exc_Input_ExtrapInterp1 - - - SUBROUTINE SS_Exc_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + IF (ALLOCATED(u_out%PtfmPos) .AND. ALLOCATED(u1%PtfmPos)) THEN + u_out%PtfmPos = a1*u1%PtfmPos + a2*u2%PtfmPos + END IF ! check if allocated +END SUBROUTINE + +SUBROUTINE SS_Exc_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. @@ -2465,102 +936,107 @@ SUBROUTINE SS_Exc_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ! !.................................................................................................................................. - TYPE(SS_Exc_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 > t3 - TYPE(SS_Exc_InputType), INTENT(IN) :: u2 ! Input at t2 > t3 - TYPE(SS_Exc_InputType), INTENT(IN) :: u3 ! Input at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs - TYPE(SS_Exc_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 + TYPE(SS_Exc_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 > t3 + TYPE(SS_Exc_InputType), INTENT(IN) :: u2 ! Input at t2 > t3 + TYPE(SS_Exc_InputType), INTENT(IN) :: u3 ! Input at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs + TYPE(SS_Exc_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 = 'SS_Exc_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) - + 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) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_Input_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 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 + 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 + 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 + 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))) - b = (t(3)**2*(u1%DummyInput - u2%DummyInput) + t(2)**2*(-u1%DummyInput + u3%DummyInput))* scaleFactor - c = ( (t(2)-t(3))*u1%DummyInput + t(3)*u2%DummyInput - t(2)*u3%DummyInput ) * scaleFactor - u_out%DummyInput = u1%DummyInput + b + c * t_out - END SUBROUTINE SS_Exc_Input_ExtrapInterp2 - - - SUBROUTINE SS_Exc_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(SS_Exc_OutputType), INTENT(IN) :: y(:) ! Output at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Outputs - TYPE(SS_Exc_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 + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + IF (ALLOCATED(u_out%PtfmPos) .AND. ALLOCATED(u1%PtfmPos)) THEN + u_out%PtfmPos = a1*u1%PtfmPos + a2*u2%PtfmPos + a3*u3%PtfmPos + END IF ! check if allocated +END SUBROUTINE + +subroutine SS_Exc_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(SS_Exc_OutputType), intent(in) :: y(:) ! Output at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Outputs + type(SS_Exc_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 = 'SS_Exc_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 SS_Exc_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL SS_Exc_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 SS_Exc_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 SS_Exc_Output_ExtrapInterp - - - SUBROUTINE SS_Exc_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'SS_Exc_Output_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(y)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(y)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(y) - 1 + select case (order) + case (0) + call SS_Exc_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call SS_Exc_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call SS_Exc_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(y) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE SS_Exc_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. @@ -2572,53 +1048,48 @@ SUBROUTINE SS_Exc_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, Err ! !.................................................................................................................................. - TYPE(SS_Exc_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 - TYPE(SS_Exc_OutputType), INTENT(IN) :: y2 ! Output at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs - TYPE(SS_Exc_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 + TYPE(SS_Exc_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 + TYPE(SS_Exc_OutputType), INTENT(IN) :: y2 ! Output at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs + TYPE(SS_Exc_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 = 'SS_Exc_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 + REAL(DbKi) :: t(2) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_Output_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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%y) .AND. ALLOCATED(y1%y)) THEN - DO i1 = LBOUND(y_out%y,1),UBOUND(y_out%y,1) - b = -(y1%y(i1) - y2%y(i1)) - y_out%y(i1) = y1%y(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 SS_Exc_Output_ExtrapInterp1 - - - SUBROUTINE SS_Exc_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + IF (ALLOCATED(y_out%y) .AND. ALLOCATED(y1%y)) THEN + y_out%y = a1*y1%y + a2*y2%y + END IF ! check if allocated + IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + END IF ! check if allocated +END SUBROUTINE + +SUBROUTINE SS_Exc_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. @@ -2632,61 +1103,53 @@ SUBROUTINE SS_Exc_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ! !.................................................................................................................................. - TYPE(SS_Exc_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 > t3 - TYPE(SS_Exc_OutputType), INTENT(IN) :: y2 ! Output at t2 > t3 - TYPE(SS_Exc_OutputType), INTENT(IN) :: y3 ! Output at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs - TYPE(SS_Exc_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 + TYPE(SS_Exc_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 > t3 + TYPE(SS_Exc_OutputType), INTENT(IN) :: y2 ! Output at t2 > t3 + TYPE(SS_Exc_OutputType), INTENT(IN) :: y3 ! Output at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs + TYPE(SS_Exc_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 = 'SS_Exc_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) - + 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) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_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 + 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 + 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 + 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%y) .AND. ALLOCATED(y1%y)) THEN - DO i1 = LBOUND(y_out%y,1),UBOUND(y_out%y,1) - b = (t(3)**2*(y1%y(i1) - y2%y(i1)) + t(2)**2*(-y1%y(i1) + y3%y(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%y(i1) + t(3)*y2%y(i1) - t(2)*y3%y(i1) ) * scaleFactor - y_out%y(i1) = y1%y(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 SS_Exc_Output_ExtrapInterp2 - + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + IF (ALLOCATED(y_out%y) .AND. ALLOCATED(y1%y)) THEN + y_out%y = a1*y1%y + a2*y2%y + a3*y3%y + END IF ! check if allocated + IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + a3*y3%WriteOutput + END IF ! check if allocated +END SUBROUTINE END MODULE SS_Excitation_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/hydrodyn/src/SS_Radiation_DriverCode.f90 b/modules/hydrodyn/src/SS_Radiation_DriverCode.f90 deleted file mode 100644 index 49f8e464c8..0000000000 --- a/modules/hydrodyn/src/SS_Radiation_DriverCode.f90 +++ /dev/null @@ -1,282 +0,0 @@ -!********************************************************************************************************************************** -! SS_Radiation_DriverCode: This code tests the template modules -!.................................................................................................................................. -! LICENSING -! Copyright (C) 2012 National Renewable Energy Laboratory -! -! This file is part of SS_Radiation. -! -! SS_Radiation 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 SS_Radiation. -! If not, see . -! -!********************************************************************************************************************************** -PROGRAM SS_Radiation_Driver - - USE NWTC_Library - USE SS_Radiation - USE SS_Radiation_Types - - IMPLICIT NONE - - ! Program variables - - REAL(DbKi) :: Time ! Variable for storing time, in seconds - REAL(DbKi) :: Time2(145201,1) ! Variable for storing time, in seconds - REAL(DbKi) :: tdq(145201,7) ! Variable for storing time and body velocities, in m/s or rad/s - REAL(DbKi) :: dq(145201,6) ! Variable for storing body velocities, in m/s or rad/s - REAL(DbKi) :: TimeInterval ! Interval between time steps, in seconds - INTEGER(B1Ki), ALLOCATABLE :: SaveAry(:) ! Array to store packed data structure - - TYPE(SS_Rad_InitInputType) :: InitInData ! Input data for initialization - TYPE(SS_Rad_InitOutputType) :: InitOutData ! Output data from initialization - - TYPE(SS_Rad_ContinuousStateType) :: x ! Continuous states - TYPE(SS_Rad_ContinuousStateType) :: x_new ! Continuous states at updated time - TYPE(SS_Rad_DiscreteStateType) :: xd ! Discrete states - TYPE(SS_Rad_DiscreteStateType) :: xd_new ! Discrete states at updated time - TYPE(SS_Rad_ConstraintStateType) :: z ! Constraint states - TYPE(SS_Rad_ConstraintStateType) :: z_residual ! Residual of the constraint state equations (Z) - TYPE(SS_Rad_OtherStateType) :: OtherState ! Other states - - TYPE(SS_Rad_ParameterType) :: p ! Parameters - TYPE(SS_Rad_InputType) :: u ! System inputs - TYPE(SS_Rad_OutputType) :: y ! System outputs - TYPE(SS_Rad_MiscVarType) :: m ! misc/optimization variables - - TYPE(SS_Rad_ContinuousStateType) :: dxdt ! First time derivatives of the continuous states - - - - !Local Variables - 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) :: Inputdq ! Input file identifier - INTEGER(IntKi) :: Outputy ! Output file identifier - INTEGER(IntKi) :: ErrStat ! Status of error message - CHARACTER(1024) :: ErrMsg ! Error message if ErrStat /= ErrID_None - INTEGER :: Sttus ! Error in reading input file - REAL(ReKi) :: Start ! CPU Time at start of the program - REAL(ReKi) :: Finnish ! CPU Time at the end of the program - REAL(ReKi) :: UsrTime - REAL(ReKi) :: Tratio - REAL(ReKi) :: Factor - CHARACTER(8) :: TimePer - INTEGER(4) :: EndTimes (8) ! An array holding the ending clock time of the simulation. - INTEGER(4) :: StrtTime (8) ! An array holding the starting clock time of the simulation. - REAL(ReKi) :: ClckTime - INTEGER :: len ! Number of input arguments - - !............................................................................................................................... - ! Routines called in initialization - !............................................................................................................................... - - ! Call Time - CALL cpu_time(start) - CALL DATE_AND_TIME ( Values=StrtTime ) - - ! Populate the InitInData data structure here: - - InitInData%InputFile = 'C:\Users\tduarte\Documents\SS_Module\Comparisons\FAST_output_freq\spar_IMP_097' - !!! GREG !!!: This file name should be the WAMIT file name without extension! - - - InitInData%Dofs = 1 - !!! GREG: This is a vector of [1x6] containing 0 and 1 if each of the 6 dofs is enabled or not (as we discussed today in the meeting) - - - ! Set the driver's request for time interval here: - TimeInterval = 0.025 ! Glue code's request for delta time (likely based on information from other modules) - !!! GREG: This should be the Rdtn DT defined in the platform input file@ - - CALL SS_Rad_Init( InitInData, u, 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 - CALL WrScr( ErrMsg ) - END IF - - !!! GREG: This version reads in the desired file containing the platform velocities. You don't need this in your case. - CALL CheckArgs( InitInData%InputFile ) - - CALL Get_Arg_Num (len ) - - ! Read the time dependent input vector dq - CALL OpenFInpFile ( Inputdq, (TRIM(InitInData%InputFile)//'.txt'), ErrStat ) ! Open motion file. - IF ( ErrStat /= 0 ) THEN - ErrStat = ErrID_Fatal - ErrMsg = ' Error allocating memory for the dq array.' - print*, ( ErrMsg ) - END IF - - - - DO I = 1,145201 !Read dq Matrix - READ (Inputdq,*,IOSTAT=Sttus) (tdq (I,J), J=1,7) - ENDDO - - CLOSE ( Inputdq ) !Close dq input file - - Time2(:,1) = tdq(:,1) - dq = tdq(:,2:7) - - !!!GREG: here the output file is opened, you should not need this - !Initialize output file - CALL OpenFOutFile ( Outputy, (TRIM(InitInData%InputFile)//'.out'), ErrStat) - IF ( ErrStat /= 0 ) THEN - ErrStat = ErrID_Fatal - ErrMsg = ' Error opening output file.' - CALL WrScr( ErrMsg ) - END IF - - WRITE(Outputy,*,IOSTAT=Sttus) InitOutData%WriteOutputHdr - IF ( Sttus /= 0 ) THEN - ErrStat = ErrID_Fatal - ErrMsg = ' Error writing output file.' - CALL WrScr( ErrMsg ) - ENDIF - - WRITE(Outputy,*,IOSTAT=Sttus) InitOutData%WriteOutputUnt - IF ( Sttus /= 0 ) THEN - ErrStat = ErrID_Fatal - ErrMsg = ' Error writing output file.' - CALL WrScr( ErrMsg ) - ENDIF - - !............................................................................................................................... - ! Routines called in loose coupling -- the glue code may implement this in various ways - !............................................................................................................................... - - CALL WrScr( 'Runnig SS_Radiation in Loose Coupling using a Adams-Bashforth-Moulton Method' ) - - CALL SS_Rad_CopyDiscState( xd, xd_new, MESH_NEWCOPY, 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 SS_Rad_CopyContState( x, x_new, MESH_NEWCOPY, 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 cpu_time(T1) - DO n = 0,145200 - - Time = n*TimeInterval - - ! Modify u (likely from the outputs of another module or a set of test conditions) here: - - u%dq(1,1) = dq (n+1,1) - u%dq(2,1) = dq (n+1,2) - u%dq(3,1) = dq (n+1,3) - u%dq(4,1) = dq (n+1,4) - u%dq(5,1) = dq (n+1,5) - u%dq(6,1) = dq (n+1,6) - - ! Get state variables at next step: constraint states (z) at step n, continuous and discrete states at step n + 1 - - CALL SS_Rad_UpdateStates( Time, u, p, x_new, xd_new, 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 - !print*, x%x - ! Calculate outputs at n - - CALL SS_Rad_CalcOutput( Time, u, 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 - - ! Update x and xd with continuous and discrete states at n + 1 - ! Note that the constraint state guess at n+1 is the value of the constraint state at n (so it doesn't need updating here) - - CALL SS_Rad_CopyContState( x_new, x, MESH_UPDATECOPY, 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 SS_Rad_CopyDiscState( xd_new, xd, MESH_UPDATECOPY, 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 Output to file - WRITE(Outputy,'(7(e16.6))',IOSTAT=Sttus) y%WriteOutput - IF ( Sttus /= 0 ) THEN - ErrStat = ErrID_Fatal - ErrMsg = ' Error writing output file.' - CALL WrScr( ErrMsg ) - print*, ErrMsg - ENDIF - END DO - - - CALL SS_Rad_DestroyDiscState( xd_new, 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 SS_Rad_DestroyContState( x_new, 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 - - - !............................................................................................................................... - ! Routine to terminate program execution - !............................................................................................................................... - CALL SS_Rad_End( u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) - IF ( ErrStat /= ErrID_None ) THEN - CALL WrScr( ErrMsg ) - END IF - - - !!! GREG: This is also to ouput values (dont need it) - CALL DATE_AND_TIME ( VALUES=EndTimes ) - CALL cpu_time(finnish) - - ClckTime = 0.001*( EndTimes(8) - StrtTime(8) ) + ( EndTimes(7) - StrtTime(7) ) + 60.0*( EndTimes(6) - StrtTime(6) ) & - + 3600.0*( EndTimes(5) - StrtTime(5) ) + 86400.0*( EndTimes(3) - StrtTime(3) ) - - UsrTime = finnish-start - - IF ( UsrTime /= 0.0 ) THEN - - TRatio = Time / UsrTime - - IF ( UsrTime > 86400.0 ) THEN - Factor = 1.0/86400.0 - TimePer = ' days' - ELSEIF ( UsrTime > 3600.0 ) THEN - Factor = 1.0/3600.0 - TimePer = ' hours' - ELSEIF ( UsrTime > 60.0 ) THEN - Factor = 1.0/60.0 - TimePer = ' minutes' - ELSE - Factor = 1.0 - TimePer = ' seconds' - ENDIF - - CALL WrScr ( ' Total Real Time: '//TRIM( Flt2LStr( Factor*ClckTime ) )//TRIM( TimePer ) ) - CALL WrScr ( ' Total CPU Time: '//TRIM( Flt2LStr( Factor*UsrTime ) )//TRIM( TimePer ) ) - CALL WrScr ( ' Simulated Time: '//TRIM( Flt2LStr( Factor*REAL( Time ) ) )//TRIM( TimePer ) ) - CALL WrScr ( ' Time Ratio (Sim/CPU): '//TRIM( Flt2LStr( TRatio ) ) ) - - ENDIF - - - !Write Output to file - WRITE(Outputy,'(1(e16.6))',IOSTAT=Sttus) TRatio - ! Ending routines - CLOSE( Outputy ) - - - -END PROGRAM SS_Radiation_Driver - diff --git a/modules/hydrodyn/src/SS_Radiation_Types.f90 b/modules/hydrodyn/src/SS_Radiation_Types.f90 index dcea3022a3..59b45510aa 100644 --- a/modules/hydrodyn/src/SS_Radiation_Types.f90 +++ b/modules/hydrodyn/src/SS_Radiation_Types.f90 @@ -37,7 +37,7 @@ MODULE SS_Radiation_Types TYPE, PUBLIC :: SS_Rad_InitInputType CHARACTER(1024) :: InputFile !< Name of the input file [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: enabledDOFs !< Vector with enable platf. DOFs [(m/s] - INTEGER(IntKi) :: NBody !< Number of WAMIT bodies for this State Space model [-] + INTEGER(IntKi) :: NBody = 0_IntKi !< Number of WAMIT bodies for this State Space model [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: PtfmRefztRot !< The rotation about zt of the body reference frame(s) from xt/yt [radians] END TYPE SS_Rad_InitInputType ! ======================= @@ -54,34 +54,34 @@ MODULE SS_Radiation_Types ! ======================= ! ========= SS_Rad_DiscreteStateType ======= TYPE, PUBLIC :: SS_Rad_DiscreteStateType - REAL(SiKi) :: DummyDiscState !< [-] + REAL(SiKi) :: DummyDiscState = 0.0_R4Ki !< [-] END TYPE SS_Rad_DiscreteStateType ! ======================= ! ========= SS_Rad_ConstraintStateType ======= TYPE, PUBLIC :: SS_Rad_ConstraintStateType - REAL(SiKi) :: DummyConstrState !< [-] + REAL(SiKi) :: DummyConstrState = 0.0_R4Ki !< [-] END TYPE SS_Rad_ConstraintStateType ! ======================= ! ========= SS_Rad_OtherStateType ======= TYPE, PUBLIC :: SS_Rad_OtherStateType - INTEGER(IntKi) :: n !< Current Time step [-] + INTEGER(IntKi) :: n = 0_IntKi !< Current Time step [-] TYPE(SS_Rad_ContinuousStateType) , DIMENSION(1:4) :: xdot !< Old Values of dxdt to used by the solver (multistep method) [-] END TYPE SS_Rad_OtherStateType ! ======================= ! ========= SS_Rad_MiscVarType ======= TYPE, PUBLIC :: SS_Rad_MiscVarType - REAL(SiKi) :: DummyMiscVar !< Remove this variable if you have misc/optimization variables [-] + REAL(SiKi) :: DummyMiscVar = 0.0_R4Ki !< Remove this variable if you have misc/optimization variables [-] END TYPE SS_Rad_MiscVarType ! ======================= ! ========= SS_Rad_ParameterType ======= TYPE, PUBLIC :: SS_Rad_ParameterType - REAL(DbKi) :: DT !< Time step [(s)] + REAL(DbKi) :: DT = 0.0_R8Ki !< Time step [(s)] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: A !< A matrix [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: B !< B matrix [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: C !< C matrix [-] INTEGER(IntKi) :: numStates = 0 !< Number of states [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: spdof !< States per dof [-] - INTEGER(IntKi) :: NBody !< Number of WAMIT bodies for this State Space model [-] + INTEGER(IntKi) :: NBody = 0_IntKi !< Number of WAMIT bodies for this State Space model [-] END TYPE SS_Rad_ParameterType ! ======================= ! ========= SS_Rad_InputType ======= @@ -96,2228 +96,706 @@ MODULE SS_Radiation_Types END TYPE SS_Rad_OutputType ! ======================= CONTAINS - SUBROUTINE SS_Rad_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SS_Rad_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(SS_Rad_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 = 'SS_Rad_CopyInitInput' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInitInputData%InputFile = SrcInitInputData%InputFile -IF (ALLOCATED(SrcInitInputData%enabledDOFs)) THEN - i1_l = LBOUND(SrcInitInputData%enabledDOFs,1) - i1_u = UBOUND(SrcInitInputData%enabledDOFs,1) - IF (.NOT. ALLOCATED(DstInitInputData%enabledDOFs)) THEN - ALLOCATE(DstInitInputData%enabledDOFs(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%enabledDOFs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%enabledDOFs = SrcInitInputData%enabledDOFs -ENDIF - DstInitInputData%NBody = SrcInitInputData%NBody -IF (ALLOCATED(SrcInitInputData%PtfmRefztRot)) THEN - i1_l = LBOUND(SrcInitInputData%PtfmRefztRot,1) - i1_u = UBOUND(SrcInitInputData%PtfmRefztRot,1) - IF (.NOT. ALLOCATED(DstInitInputData%PtfmRefztRot)) THEN - ALLOCATE(DstInitInputData%PtfmRefztRot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%PtfmRefztRot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%PtfmRefztRot = SrcInitInputData%PtfmRefztRot -ENDIF - END SUBROUTINE SS_Rad_CopyInitInput - - SUBROUTINE SS_Rad_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(SS_Rad_InitInputType), INTENT(INOUT) :: InitInputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Rad_DestroyInitInput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(InitInputData%enabledDOFs)) THEN - DEALLOCATE(InitInputData%enabledDOFs) -ENDIF -IF (ALLOCATED(InitInputData%PtfmRefztRot)) THEN - DEALLOCATE(InitInputData%PtfmRefztRot) -ENDIF - END SUBROUTINE SS_Rad_DestroyInitInput - - SUBROUTINE SS_Rad_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(SS_Rad_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 = 'SS_Rad_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 ! enabledDOFs allocated yes/no - IF ( ALLOCATED(InData%enabledDOFs) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! enabledDOFs upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%enabledDOFs) ! enabledDOFs - END IF - Int_BufSz = Int_BufSz + 1 ! NBody - Int_BufSz = Int_BufSz + 1 ! PtfmRefztRot allocated yes/no - IF ( ALLOCATED(InData%PtfmRefztRot) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PtfmRefztRot upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%PtfmRefztRot) ! PtfmRefztRot - 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 - IF ( .NOT. ALLOCATED(InData%enabledDOFs) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%enabledDOFs,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%enabledDOFs,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%enabledDOFs,1), UBOUND(InData%enabledDOFs,1) - ReKiBuf(Re_Xferred) = InData%enabledDOFs(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NBody - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%PtfmRefztRot) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PtfmRefztRot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PtfmRefztRot,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PtfmRefztRot,1), UBOUND(InData%PtfmRefztRot,1) - DbKiBuf(Db_Xferred) = InData%PtfmRefztRot(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE SS_Rad_PackInitInput - SUBROUTINE SS_Rad_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(SS_Rad_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 = 'SS_Rad_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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! enabledDOFs not allocated - Int_Xferred = Int_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%enabledDOFs)) DEALLOCATE(OutData%enabledDOFs) - ALLOCATE(OutData%enabledDOFs(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%enabledDOFs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%enabledDOFs,1), UBOUND(OutData%enabledDOFs,1) - OutData%enabledDOFs(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%NBody = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PtfmRefztRot not allocated - Int_Xferred = Int_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%PtfmRefztRot)) DEALLOCATE(OutData%PtfmRefztRot) - ALLOCATE(OutData%PtfmRefztRot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmRefztRot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PtfmRefztRot,1), UBOUND(OutData%PtfmRefztRot,1) - OutData%PtfmRefztRot(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE SS_Rad_UnPackInitInput - - SUBROUTINE SS_Rad_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SS_Rad_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(SS_Rad_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 = 'SS_Rad_CopyInitOutput' -! +subroutine SS_Rad_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) + type(SS_Rad_InitInputType), intent(in) :: SrcInitInputData + type(SS_Rad_InitInputType), intent(inout) :: DstInitInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'SS_Rad_CopyInitInput' 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 SS_Rad_CopyInitOutput - - SUBROUTINE SS_Rad_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(SS_Rad_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Rad_DestroyInitOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(InitOutputData%WriteOutputHdr)) THEN - DEALLOCATE(InitOutputData%WriteOutputHdr) -ENDIF -IF (ALLOCATED(InitOutputData%WriteOutputUnt)) THEN - DEALLOCATE(InitOutputData%WriteOutputUnt) -ENDIF - END SUBROUTINE SS_Rad_DestroyInitOutput - - SUBROUTINE SS_Rad_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(SS_Rad_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 = 'SS_Rad_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 - 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 SS_Rad_PackInitOutput - - SUBROUTINE SS_Rad_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(SS_Rad_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 = 'SS_Rad_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 - END SUBROUTINE SS_Rad_UnPackInitOutput - - SUBROUTINE SS_Rad_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SS_Rad_ContinuousStateType), INTENT(IN) :: SrcContStateData - TYPE(SS_Rad_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 = 'SS_Rad_CopyContState' -! + ErrMsg = '' + DstInitInputData%InputFile = SrcInitInputData%InputFile + if (allocated(SrcInitInputData%enabledDOFs)) then + LB(1:1) = lbound(SrcInitInputData%enabledDOFs) + UB(1:1) = ubound(SrcInitInputData%enabledDOFs) + if (.not. allocated(DstInitInputData%enabledDOFs)) then + allocate(DstInitInputData%enabledDOFs(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%enabledDOFs.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%enabledDOFs = SrcInitInputData%enabledDOFs + end if + DstInitInputData%NBody = SrcInitInputData%NBody + if (allocated(SrcInitInputData%PtfmRefztRot)) then + LB(1:1) = lbound(SrcInitInputData%PtfmRefztRot) + UB(1:1) = ubound(SrcInitInputData%PtfmRefztRot) + if (.not. allocated(DstInitInputData%PtfmRefztRot)) then + allocate(DstInitInputData%PtfmRefztRot(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%PtfmRefztRot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%PtfmRefztRot = SrcInitInputData%PtfmRefztRot + end if +end subroutine + +subroutine SS_Rad_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(SS_Rad_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SS_Rad_DestroyInitInput' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcContStateData%x)) THEN - i1_l = LBOUND(SrcContStateData%x,1) - i1_u = UBOUND(SrcContStateData%x,1) - IF (.NOT. ALLOCATED(DstContStateData%x)) THEN - ALLOCATE(DstContStateData%x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstContStateData%x = SrcContStateData%x -ENDIF - END SUBROUTINE SS_Rad_CopyContState - - SUBROUTINE SS_Rad_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(SS_Rad_ContinuousStateType), INTENT(INOUT) :: ContStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Rad_DestroyContState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(ContStateData%x)) THEN - DEALLOCATE(ContStateData%x) -ENDIF - END SUBROUTINE SS_Rad_DestroyContState - - SUBROUTINE SS_Rad_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(SS_Rad_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 = 'SS_Rad_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 ! x allocated yes/no - IF ( ALLOCATED(InData%x) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! x upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%x) ! 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%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%x,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - DbKiBuf(Db_Xferred) = InData%x(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE SS_Rad_PackContState - - SUBROUTINE SS_Rad_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(SS_Rad_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 = 'SS_Rad_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 ! 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%x)) DEALLOCATE(OutData%x) - ALLOCATE(OutData%x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,1) - OutData%x(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE SS_Rad_UnPackContState - - SUBROUTINE SS_Rad_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SS_Rad_DiscreteStateType), INTENT(IN) :: SrcDiscStateData - TYPE(SS_Rad_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 = 'SS_Rad_CopyDiscState' -! + ErrMsg = '' + if (allocated(InitInputData%enabledDOFs)) then + deallocate(InitInputData%enabledDOFs) + end if + if (allocated(InitInputData%PtfmRefztRot)) then + deallocate(InitInputData%PtfmRefztRot) + end if +end subroutine + +subroutine SS_Rad_PackInitInput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SS_Rad_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SS_Rad_PackInitInput' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%InputFile) + call RegPackAlloc(RF, InData%enabledDOFs) + call RegPack(RF, InData%NBody) + call RegPackAlloc(RF, InData%PtfmRefztRot) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SS_Rad_UnPackInitInput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SS_Rad_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SS_Rad_UnPackInitInput' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%InputFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%enabledDOFs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NBody); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PtfmRefztRot); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SS_Rad_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) + type(SS_Rad_InitOutputType), intent(in) :: SrcInitOutputData + type(SS_Rad_InitOutputType), intent(inout) :: DstInitOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'SS_Rad_CopyInitOutput' ErrStat = ErrID_None - ErrMsg = "" - DstDiscStateData%DummyDiscState = SrcDiscStateData%DummyDiscState - END SUBROUTINE SS_Rad_CopyDiscState - - SUBROUTINE SS_Rad_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(SS_Rad_DiscreteStateType), INTENT(INOUT) :: DiscStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Rad_DestroyDiscState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE SS_Rad_DestroyDiscState - - SUBROUTINE SS_Rad_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(SS_Rad_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 = 'SS_Rad_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 SS_Rad_PackDiscState - - SUBROUTINE SS_Rad_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(SS_Rad_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 = 'SS_Rad_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 = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE SS_Rad_UnPackDiscState - - SUBROUTINE SS_Rad_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SS_Rad_ConstraintStateType), INTENT(IN) :: SrcConstrStateData - TYPE(SS_Rad_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 = 'SS_Rad_CopyConstrState' -! + ErrMsg = '' + if (allocated(SrcInitOutputData%WriteOutputHdr)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) + if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then + allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitOutputData%WriteOutputUnt)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) + if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then + allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), 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 + end if +end subroutine + +subroutine SS_Rad_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(SS_Rad_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SS_Rad_DestroyInitOutput' ErrStat = ErrID_None - ErrMsg = "" - DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState - END SUBROUTINE SS_Rad_CopyConstrState - - SUBROUTINE SS_Rad_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(SS_Rad_ConstraintStateType), INTENT(INOUT) :: ConstrStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Rad_DestroyConstrState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE SS_Rad_DestroyConstrState - - SUBROUTINE SS_Rad_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(SS_Rad_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 = 'SS_Rad_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 SS_Rad_PackConstrState - - SUBROUTINE SS_Rad_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(SS_Rad_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 = 'SS_Rad_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 = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE SS_Rad_UnPackConstrState - - SUBROUTINE SS_Rad_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SS_Rad_OtherStateType), INTENT(IN) :: SrcOtherStateData - TYPE(SS_Rad_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 = 'SS_Rad_CopyOtherState' -! + ErrMsg = '' + if (allocated(InitOutputData%WriteOutputHdr)) then + deallocate(InitOutputData%WriteOutputHdr) + end if + if (allocated(InitOutputData%WriteOutputUnt)) then + deallocate(InitOutputData%WriteOutputUnt) + end if +end subroutine + +subroutine SS_Rad_PackInitOutput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SS_Rad_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SS_Rad_PackInitOutput' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%WriteOutputHdr) + call RegPackAlloc(RF, InData%WriteOutputUnt) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SS_Rad_UnPackInitOutput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SS_Rad_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SS_Rad_UnPackInitOutput' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%WriteOutputHdr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WriteOutputUnt); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SS_Rad_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) + type(SS_Rad_ContinuousStateType), intent(in) :: SrcContStateData + type(SS_Rad_ContinuousStateType), intent(inout) :: DstContStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'SS_Rad_CopyContState' ErrStat = ErrID_None - ErrMsg = "" - DstOtherStateData%n = SrcOtherStateData%n - DO i1 = LBOUND(SrcOtherStateData%xdot,1), UBOUND(SrcOtherStateData%xdot,1) - CALL SS_Rad_CopyContState( SrcOtherStateData%xdot(i1), DstOtherStateData%xdot(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - END SUBROUTINE SS_Rad_CopyOtherState - - SUBROUTINE SS_Rad_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(SS_Rad_OtherStateType), INTENT(INOUT) :: OtherStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Rad_DestroyOtherState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -DO i1 = LBOUND(OtherStateData%xdot,1), UBOUND(OtherStateData%xdot,1) - CALL SS_Rad_DestroyContState( OtherStateData%xdot(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - END SUBROUTINE SS_Rad_DestroyOtherState - - SUBROUTINE SS_Rad_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(SS_Rad_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 = 'SS_Rad_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 ! n - ! 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 SS_Rad_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 - 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%n - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%xdot,1), UBOUND(InData%xdot,1) - CALL SS_Rad_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 SUBROUTINE SS_Rad_PackOtherState - - SUBROUTINE SS_Rad_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(SS_Rad_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 = 'SS_Rad_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%n = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%xdot,1) - i1_u = UBOUND(OutData%xdot,1) - 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 SS_Rad_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 SUBROUTINE SS_Rad_UnPackOtherState - - SUBROUTINE SS_Rad_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SS_Rad_MiscVarType), INTENT(IN) :: SrcMiscData - TYPE(SS_Rad_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 = 'SS_Rad_CopyMisc' -! + ErrMsg = '' + if (allocated(SrcContStateData%x)) then + LB(1:1) = lbound(SrcContStateData%x) + UB(1:1) = ubound(SrcContStateData%x) + if (.not. allocated(DstContStateData%x)) then + allocate(DstContStateData%x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstContStateData%x = SrcContStateData%x + end if +end subroutine + +subroutine SS_Rad_DestroyContState(ContStateData, ErrStat, ErrMsg) + type(SS_Rad_ContinuousStateType), intent(inout) :: ContStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SS_Rad_DestroyContState' ErrStat = ErrID_None - ErrMsg = "" - DstMiscData%DummyMiscVar = SrcMiscData%DummyMiscVar - END SUBROUTINE SS_Rad_CopyMisc - - SUBROUTINE SS_Rad_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(SS_Rad_MiscVarType), INTENT(INOUT) :: MiscData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Rad_DestroyMisc' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE SS_Rad_DestroyMisc - - SUBROUTINE SS_Rad_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(SS_Rad_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 = 'SS_Rad_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) = InData%DummyMiscVar - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE SS_Rad_PackMisc - - SUBROUTINE SS_Rad_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(SS_Rad_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 = 'SS_Rad_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 = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE SS_Rad_UnPackMisc - - SUBROUTINE SS_Rad_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SS_Rad_ParameterType), INTENT(IN) :: SrcParamData - TYPE(SS_Rad_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 = 'SS_Rad_CopyParam' -! + ErrMsg = '' + if (allocated(ContStateData%x)) then + deallocate(ContStateData%x) + end if +end subroutine + +subroutine SS_Rad_PackContState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SS_Rad_ContinuousStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SS_Rad_PackContState' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%x) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SS_Rad_UnPackContState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SS_Rad_ContinuousStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SS_Rad_UnPackContState' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%x); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SS_Rad_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) + type(SS_Rad_DiscreteStateType), intent(in) :: SrcDiscStateData + type(SS_Rad_DiscreteStateType), intent(inout) :: DstDiscStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SS_Rad_CopyDiscState' ErrStat = ErrID_None - ErrMsg = "" - DstParamData%DT = SrcParamData%DT -IF (ALLOCATED(SrcParamData%A)) THEN - i1_l = LBOUND(SrcParamData%A,1) - i1_u = UBOUND(SrcParamData%A,1) - i2_l = LBOUND(SrcParamData%A,2) - i2_u = UBOUND(SrcParamData%A,2) - IF (.NOT. ALLOCATED(DstParamData%A)) THEN - ALLOCATE(DstParamData%A(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%A.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%A = SrcParamData%A -ENDIF -IF (ALLOCATED(SrcParamData%B)) THEN - i1_l = LBOUND(SrcParamData%B,1) - i1_u = UBOUND(SrcParamData%B,1) - i2_l = LBOUND(SrcParamData%B,2) - i2_u = UBOUND(SrcParamData%B,2) - IF (.NOT. ALLOCATED(DstParamData%B)) THEN - ALLOCATE(DstParamData%B(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%B.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%B = SrcParamData%B -ENDIF -IF (ALLOCATED(SrcParamData%C)) THEN - i1_l = LBOUND(SrcParamData%C,1) - i1_u = UBOUND(SrcParamData%C,1) - i2_l = LBOUND(SrcParamData%C,2) - i2_u = UBOUND(SrcParamData%C,2) - IF (.NOT. ALLOCATED(DstParamData%C)) THEN - ALLOCATE(DstParamData%C(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%C.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%C = SrcParamData%C -ENDIF - DstParamData%numStates = SrcParamData%numStates -IF (ALLOCATED(SrcParamData%spdof)) THEN - i1_l = LBOUND(SrcParamData%spdof,1) - i1_u = UBOUND(SrcParamData%spdof,1) - IF (.NOT. ALLOCATED(DstParamData%spdof)) THEN - ALLOCATE(DstParamData%spdof(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%spdof.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%spdof = SrcParamData%spdof -ENDIF - DstParamData%NBody = SrcParamData%NBody - END SUBROUTINE SS_Rad_CopyParam - - SUBROUTINE SS_Rad_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(SS_Rad_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Rad_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(ParamData%A)) THEN - DEALLOCATE(ParamData%A) -ENDIF -IF (ALLOCATED(ParamData%B)) THEN - DEALLOCATE(ParamData%B) -ENDIF -IF (ALLOCATED(ParamData%C)) THEN - DEALLOCATE(ParamData%C) -ENDIF -IF (ALLOCATED(ParamData%spdof)) THEN - DEALLOCATE(ParamData%spdof) -ENDIF - END SUBROUTINE SS_Rad_DestroyParam - - SUBROUTINE SS_Rad_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(SS_Rad_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 = 'SS_Rad_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 ! A allocated yes/no - IF ( ALLOCATED(InData%A) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! 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*2 ! 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*2 ! C upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%C) ! C - END IF - Int_BufSz = Int_BufSz + 1 ! numStates - Int_BufSz = Int_BufSz + 1 ! spdof allocated yes/no - IF ( ALLOCATED(InData%spdof) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! spdof upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%spdof) ! spdof - END IF - Int_BufSz = Int_BufSz + 1 ! NBody - 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 - 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 - IntKiBuf( Int_Xferred ) = LBOUND(InData%A,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%A,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%A,2), UBOUND(InData%A,2) - DO i1 = LBOUND(InData%A,1), UBOUND(InData%A,1) - ReKiBuf(Re_Xferred) = InData%A(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - 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 - IntKiBuf( Int_Xferred ) = LBOUND(InData%B,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%B,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%B,2), UBOUND(InData%B,2) - DO i1 = LBOUND(InData%B,1), UBOUND(InData%B,1) - ReKiBuf(Re_Xferred) = InData%B(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - 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 - IntKiBuf( Int_Xferred ) = LBOUND(InData%C,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%C,2), UBOUND(InData%C,2) - DO i1 = LBOUND(InData%C,1), UBOUND(InData%C,1) - ReKiBuf(Re_Xferred) = InData%C(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%numStates - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%spdof) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%spdof,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%spdof,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%spdof,1), UBOUND(InData%spdof,1) - IntKiBuf(Int_Xferred) = InData%spdof(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NBody - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE SS_Rad_PackParam - - SUBROUTINE SS_Rad_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(SS_Rad_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 = 'SS_Rad_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 - 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 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%A)) DEALLOCATE(OutData%A) - ALLOCATE(OutData%A(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%A.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%A,2), UBOUND(OutData%A,2) - DO i1 = LBOUND(OutData%A,1), UBOUND(OutData%A,1) - OutData%A(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - 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 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%B)) DEALLOCATE(OutData%B) - ALLOCATE(OutData%B(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%B.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%B,2), UBOUND(OutData%B,2) - DO i1 = LBOUND(OutData%B,1), UBOUND(OutData%B,1) - OutData%B(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - 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 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%C)) DEALLOCATE(OutData%C) - ALLOCATE(OutData%C(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%C.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%C,2), UBOUND(OutData%C,2) - DO i1 = LBOUND(OutData%C,1), UBOUND(OutData%C,1) - OutData%C(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%numStates = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! spdof not allocated - Int_Xferred = Int_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%spdof)) DEALLOCATE(OutData%spdof) - ALLOCATE(OutData%spdof(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%spdof.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%spdof,1), UBOUND(OutData%spdof,1) - OutData%spdof(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - OutData%NBody = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE SS_Rad_UnPackParam - - SUBROUTINE SS_Rad_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SS_Rad_InputType), INTENT(IN) :: SrcInputData - TYPE(SS_Rad_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 = 'SS_Rad_CopyInput' -! + ErrMsg = '' + DstDiscStateData%DummyDiscState = SrcDiscStateData%DummyDiscState +end subroutine + +subroutine SS_Rad_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) + type(SS_Rad_DiscreteStateType), intent(inout) :: DiscStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SS_Rad_DestroyDiscState' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcInputData%dq)) THEN - i1_l = LBOUND(SrcInputData%dq,1) - i1_u = UBOUND(SrcInputData%dq,1) - IF (.NOT. ALLOCATED(DstInputData%dq)) THEN - ALLOCATE(DstInputData%dq(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%dq.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%dq = SrcInputData%dq -ENDIF - END SUBROUTINE SS_Rad_CopyInput - - SUBROUTINE SS_Rad_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(SS_Rad_InputType), INTENT(INOUT) :: InputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Rad_DestroyInput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(InputData%dq)) THEN - DEALLOCATE(InputData%dq) -ENDIF - END SUBROUTINE SS_Rad_DestroyInput - - SUBROUTINE SS_Rad_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(SS_Rad_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 = 'SS_Rad_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 ! dq allocated yes/no - IF ( ALLOCATED(InData%dq) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! dq upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%dq) ! dq - 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%dq) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%dq,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dq,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%dq,1), UBOUND(InData%dq,1) - ReKiBuf(Re_Xferred) = InData%dq(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE SS_Rad_PackInput - - SUBROUTINE SS_Rad_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(SS_Rad_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 = 'SS_Rad_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 ! dq not allocated - Int_Xferred = Int_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%dq)) DEALLOCATE(OutData%dq) - ALLOCATE(OutData%dq(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%dq.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%dq,1), UBOUND(OutData%dq,1) - OutData%dq(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE SS_Rad_UnPackInput - - SUBROUTINE SS_Rad_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SS_Rad_OutputType), INTENT(IN) :: SrcOutputData - TYPE(SS_Rad_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 = 'SS_Rad_CopyOutput' -! + ErrMsg = '' +end subroutine + +subroutine SS_Rad_PackDiscState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SS_Rad_DiscreteStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SS_Rad_PackDiscState' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyDiscState) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SS_Rad_UnPackDiscState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SS_Rad_DiscreteStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SS_Rad_UnPackDiscState' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyDiscState); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SS_Rad_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) + type(SS_Rad_ConstraintStateType), intent(in) :: SrcConstrStateData + type(SS_Rad_ConstraintStateType), intent(inout) :: DstConstrStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SS_Rad_CopyConstrState' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcOutputData%y)) THEN - i1_l = LBOUND(SrcOutputData%y,1) - i1_u = UBOUND(SrcOutputData%y,1) - IF (.NOT. ALLOCATED(DstOutputData%y)) THEN - ALLOCATE(DstOutputData%y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%y = SrcOutputData%y -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 SS_Rad_CopyOutput - - SUBROUTINE SS_Rad_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(SS_Rad_OutputType), INTENT(INOUT) :: OutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Rad_DestroyOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(OutputData%y)) THEN - DEALLOCATE(OutputData%y) -ENDIF -IF (ALLOCATED(OutputData%WriteOutput)) THEN - DEALLOCATE(OutputData%WriteOutput) -ENDIF - END SUBROUTINE SS_Rad_DestroyOutput - - SUBROUTINE SS_Rad_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(SS_Rad_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 = 'SS_Rad_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 ! y allocated yes/no - IF ( ALLOCATED(InData%y) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! y upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%y) ! y - 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 - - IF ( .NOT. ALLOCATED(InData%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%y,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%y,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%y,1), UBOUND(InData%y,1) - ReKiBuf(Re_Xferred) = InData%y(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 SS_Rad_PackOutput - - SUBROUTINE SS_Rad_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(SS_Rad_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 = 'SS_Rad_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 ! 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%y)) DEALLOCATE(OutData%y) - ALLOCATE(OutData%y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%y,1), UBOUND(OutData%y,1) - OutData%y(i1) = ReKiBuf(Re_Xferred) - 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 SS_Rad_UnPackOutput - - - SUBROUTINE SS_Rad_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(SS_Rad_InputType), INTENT(IN) :: u(:) ! Input at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Inputs - TYPE(SS_Rad_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 + ErrMsg = '' + DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState +end subroutine + +subroutine SS_Rad_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) + type(SS_Rad_ConstraintStateType), intent(inout) :: ConstrStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SS_Rad_DestroyConstrState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine SS_Rad_PackConstrState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SS_Rad_ConstraintStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SS_Rad_PackConstrState' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyConstrState) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SS_Rad_UnPackConstrState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SS_Rad_ConstraintStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SS_Rad_UnPackConstrState' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyConstrState); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SS_Rad_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) + type(SS_Rad_OtherStateType), intent(in) :: SrcOtherStateData + type(SS_Rad_OtherStateType), intent(inout) :: DstOtherStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SS_Rad_CopyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + DstOtherStateData%n = SrcOtherStateData%n + LB(1:1) = lbound(SrcOtherStateData%xdot) + UB(1:1) = ubound(SrcOtherStateData%xdot) + do i1 = LB(1), UB(1) + call SS_Rad_CopyContState(SrcOtherStateData%xdot(i1), DstOtherStateData%xdot(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do +end subroutine + +subroutine SS_Rad_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) + type(SS_Rad_OtherStateType), intent(inout) :: OtherStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SS_Rad_DestroyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + LB(1:1) = lbound(OtherStateData%xdot) + UB(1:1) = ubound(OtherStateData%xdot) + do i1 = LB(1), UB(1) + call SS_Rad_DestroyContState(OtherStateData%xdot(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do +end subroutine + +subroutine SS_Rad_PackOtherState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SS_Rad_OtherStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SS_Rad_PackOtherState' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%n) + LB(1:1) = lbound(InData%xdot) + UB(1:1) = ubound(InData%xdot) + do i1 = LB(1), UB(1) + call SS_Rad_PackContState(RF, InData%xdot(i1)) + end do + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SS_Rad_UnPackOtherState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SS_Rad_OtherStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SS_Rad_UnPackOtherState' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%n); if (RegCheckErr(RF, RoutineName)) return + LB(1:1) = lbound(OutData%xdot) + UB(1:1) = ubound(OutData%xdot) + do i1 = LB(1), UB(1) + call SS_Rad_UnpackContState(RF, OutData%xdot(i1)) ! xdot + end do +end subroutine + +subroutine SS_Rad_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(SS_Rad_MiscVarType), intent(in) :: SrcMiscData + type(SS_Rad_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SS_Rad_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + DstMiscData%DummyMiscVar = SrcMiscData%DummyMiscVar +end subroutine + +subroutine SS_Rad_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(SS_Rad_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SS_Rad_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine SS_Rad_PackMisc(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SS_Rad_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SS_Rad_PackMisc' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyMiscVar) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SS_Rad_UnPackMisc(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SS_Rad_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SS_Rad_UnPackMisc' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyMiscVar); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SS_Rad_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(SS_Rad_ParameterType), intent(in) :: SrcParamData + type(SS_Rad_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'SS_Rad_CopyParam' + ErrStat = ErrID_None + ErrMsg = '' + DstParamData%DT = SrcParamData%DT + if (allocated(SrcParamData%A)) then + LB(1:2) = lbound(SrcParamData%A) + UB(1:2) = ubound(SrcParamData%A) + if (.not. allocated(DstParamData%A)) then + allocate(DstParamData%A(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%A.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%A = SrcParamData%A + end if + if (allocated(SrcParamData%B)) then + LB(1:2) = lbound(SrcParamData%B) + UB(1:2) = ubound(SrcParamData%B) + if (.not. allocated(DstParamData%B)) then + allocate(DstParamData%B(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%B.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%B = SrcParamData%B + end if + if (allocated(SrcParamData%C)) then + LB(1:2) = lbound(SrcParamData%C) + UB(1:2) = ubound(SrcParamData%C) + if (.not. allocated(DstParamData%C)) then + allocate(DstParamData%C(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%C.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%C = SrcParamData%C + end if + DstParamData%numStates = SrcParamData%numStates + if (allocated(SrcParamData%spdof)) then + LB(1:1) = lbound(SrcParamData%spdof) + UB(1:1) = ubound(SrcParamData%spdof) + if (.not. allocated(DstParamData%spdof)) then + allocate(DstParamData%spdof(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%spdof.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%spdof = SrcParamData%spdof + end if + DstParamData%NBody = SrcParamData%NBody +end subroutine + +subroutine SS_Rad_DestroyParam(ParamData, ErrStat, ErrMsg) + type(SS_Rad_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SS_Rad_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ParamData%A)) then + deallocate(ParamData%A) + end if + if (allocated(ParamData%B)) then + deallocate(ParamData%B) + end if + if (allocated(ParamData%C)) then + deallocate(ParamData%C) + end if + if (allocated(ParamData%spdof)) then + deallocate(ParamData%spdof) + end if +end subroutine + +subroutine SS_Rad_PackParam(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SS_Rad_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SS_Rad_PackParam' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DT) + call RegPackAlloc(RF, InData%A) + call RegPackAlloc(RF, InData%B) + call RegPackAlloc(RF, InData%C) + call RegPack(RF, InData%numStates) + call RegPackAlloc(RF, InData%spdof) + call RegPack(RF, InData%NBody) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SS_Rad_UnPackParam(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SS_Rad_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SS_Rad_UnPackParam' + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%A); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%B); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%C); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%numStates); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%spdof); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NBody); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SS_Rad_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) + type(SS_Rad_InputType), intent(in) :: SrcInputData + type(SS_Rad_InputType), intent(inout) :: DstInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'SS_Rad_CopyInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcInputData%dq)) then + LB(1:1) = lbound(SrcInputData%dq) + UB(1:1) = ubound(SrcInputData%dq) + if (.not. allocated(DstInputData%dq)) then + allocate(DstInputData%dq(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%dq.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%dq = SrcInputData%dq + end if +end subroutine + +subroutine SS_Rad_DestroyInput(InputData, ErrStat, ErrMsg) + type(SS_Rad_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SS_Rad_DestroyInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InputData%dq)) then + deallocate(InputData%dq) + end if +end subroutine + +subroutine SS_Rad_PackInput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SS_Rad_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SS_Rad_PackInput' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%dq) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SS_Rad_UnPackInput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SS_Rad_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SS_Rad_UnPackInput' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%dq); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SS_Rad_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(SS_Rad_OutputType), intent(in) :: SrcOutputData + type(SS_Rad_OutputType), intent(inout) :: DstOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'SS_Rad_CopyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcOutputData%y)) then + LB(1:1) = lbound(SrcOutputData%y) + UB(1:1) = ubound(SrcOutputData%y) + if (.not. allocated(DstOutputData%y)) then + allocate(DstOutputData%y(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%y.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%y = SrcOutputData%y + end if + if (allocated(SrcOutputData%WriteOutput)) then + LB(1:1) = lbound(SrcOutputData%WriteOutput) + UB(1:1) = ubound(SrcOutputData%WriteOutput) + if (.not. allocated(DstOutputData%WriteOutput)) then + allocate(DstOutputData%WriteOutput(LB(1):UB(1)), 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 + end if +end subroutine + +subroutine SS_Rad_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(SS_Rad_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SS_Rad_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OutputData%y)) then + deallocate(OutputData%y) + end if + if (allocated(OutputData%WriteOutput)) then + deallocate(OutputData%WriteOutput) + end if +end subroutine + +subroutine SS_Rad_PackOutput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SS_Rad_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SS_Rad_PackOutput' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%y) + call RegPackAlloc(RF, InData%WriteOutput) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SS_Rad_UnPackOutput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SS_Rad_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SS_Rad_UnPackOutput' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WriteOutput); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SS_Rad_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(SS_Rad_InputType), intent(in) :: u(:) ! Input at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Inputs + type(SS_Rad_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 = 'SS_Rad_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 SS_Rad_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL SS_Rad_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 SS_Rad_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 SS_Rad_Input_ExtrapInterp - - - SUBROUTINE SS_Rad_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'SS_Rad_Input_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(u)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(u)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(u) - 1 + select case (order) + case (0) + call SS_Rad_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call SS_Rad_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call SS_Rad_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(u) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE SS_Rad_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. @@ -2329,47 +807,45 @@ SUBROUTINE SS_Rad_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrM ! !.................................................................................................................................. - TYPE(SS_Rad_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 - TYPE(SS_Rad_InputType), INTENT(IN) :: u2 ! Input at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs - TYPE(SS_Rad_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 + TYPE(SS_Rad_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 + TYPE(SS_Rad_InputType), INTENT(IN) :: u2 ! Input at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs + TYPE(SS_Rad_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 = 'SS_Rad_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 + REAL(DbKi) :: t(2) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'SS_Rad_Input_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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%dq) .AND. ALLOCATED(u1%dq)) THEN - DO i1 = LBOUND(u_out%dq,1),UBOUND(u_out%dq,1) - b = -(u1%dq(i1) - u2%dq(i1)) - u_out%dq(i1) = u1%dq(i1) + b * ScaleFactor - END DO -END IF ! check if allocated - END SUBROUTINE SS_Rad_Input_ExtrapInterp1 - - - SUBROUTINE SS_Rad_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + IF (ALLOCATED(u_out%dq) .AND. ALLOCATED(u1%dq)) THEN + u_out%dq = a1*u1%dq + a2*u2%dq + END IF ! check if allocated +END SUBROUTINE + +SUBROUTINE SS_Rad_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. @@ -2383,108 +859,105 @@ SUBROUTINE SS_Rad_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ! !.................................................................................................................................. - TYPE(SS_Rad_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 > t3 - TYPE(SS_Rad_InputType), INTENT(IN) :: u2 ! Input at t2 > t3 - TYPE(SS_Rad_InputType), INTENT(IN) :: u3 ! Input at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs - TYPE(SS_Rad_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 + TYPE(SS_Rad_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 > t3 + TYPE(SS_Rad_InputType), INTENT(IN) :: u2 ! Input at t2 > t3 + TYPE(SS_Rad_InputType), INTENT(IN) :: u3 ! Input at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs + TYPE(SS_Rad_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 = 'SS_Rad_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) - + 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) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'SS_Rad_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 + 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 + 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 + 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%dq) .AND. ALLOCATED(u1%dq)) THEN - DO i1 = LBOUND(u_out%dq,1),UBOUND(u_out%dq,1) - b = (t(3)**2*(u1%dq(i1) - u2%dq(i1)) + t(2)**2*(-u1%dq(i1) + u3%dq(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%dq(i1) + t(3)*u2%dq(i1) - t(2)*u3%dq(i1) ) * scaleFactor - u_out%dq(i1) = u1%dq(i1) + b + c * t_out - END DO -END IF ! check if allocated - END SUBROUTINE SS_Rad_Input_ExtrapInterp2 - - - SUBROUTINE SS_Rad_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(SS_Rad_OutputType), INTENT(IN) :: y(:) ! Output at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Outputs - TYPE(SS_Rad_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 + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + IF (ALLOCATED(u_out%dq) .AND. ALLOCATED(u1%dq)) THEN + u_out%dq = a1*u1%dq + a2*u2%dq + a3*u3%dq + END IF ! check if allocated +END SUBROUTINE + +subroutine SS_Rad_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(SS_Rad_OutputType), intent(in) :: y(:) ! Output at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Outputs + type(SS_Rad_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 = 'SS_Rad_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 SS_Rad_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL SS_Rad_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 SS_Rad_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 SS_Rad_Output_ExtrapInterp - - - SUBROUTINE SS_Rad_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'SS_Rad_Output_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(y)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(y)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(y) - 1 + select case (order) + case (0) + call SS_Rad_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call SS_Rad_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call SS_Rad_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(y) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE SS_Rad_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. @@ -2496,53 +969,48 @@ SUBROUTINE SS_Rad_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, Err ! !.................................................................................................................................. - TYPE(SS_Rad_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 - TYPE(SS_Rad_OutputType), INTENT(IN) :: y2 ! Output at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs - TYPE(SS_Rad_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 + TYPE(SS_Rad_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 + TYPE(SS_Rad_OutputType), INTENT(IN) :: y2 ! Output at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs + TYPE(SS_Rad_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 = 'SS_Rad_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 + REAL(DbKi) :: t(2) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'SS_Rad_Output_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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%y) .AND. ALLOCATED(y1%y)) THEN - DO i1 = LBOUND(y_out%y,1),UBOUND(y_out%y,1) - b = -(y1%y(i1) - y2%y(i1)) - y_out%y(i1) = y1%y(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 SS_Rad_Output_ExtrapInterp1 - - - SUBROUTINE SS_Rad_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + IF (ALLOCATED(y_out%y) .AND. ALLOCATED(y1%y)) THEN + y_out%y = a1*y1%y + a2*y2%y + END IF ! check if allocated + IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + END IF ! check if allocated +END SUBROUTINE + +SUBROUTINE SS_Rad_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. @@ -2556,61 +1024,53 @@ SUBROUTINE SS_Rad_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ! !.................................................................................................................................. - TYPE(SS_Rad_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 > t3 - TYPE(SS_Rad_OutputType), INTENT(IN) :: y2 ! Output at t2 > t3 - TYPE(SS_Rad_OutputType), INTENT(IN) :: y3 ! Output at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs - TYPE(SS_Rad_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 + TYPE(SS_Rad_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 > t3 + TYPE(SS_Rad_OutputType), INTENT(IN) :: y2 ! Output at t2 > t3 + TYPE(SS_Rad_OutputType), INTENT(IN) :: y3 ! Output at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs + TYPE(SS_Rad_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 = 'SS_Rad_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) - + 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) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'SS_Rad_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 + 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 + 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 + 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%y) .AND. ALLOCATED(y1%y)) THEN - DO i1 = LBOUND(y_out%y,1),UBOUND(y_out%y,1) - b = (t(3)**2*(y1%y(i1) - y2%y(i1)) + t(2)**2*(-y1%y(i1) + y3%y(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%y(i1) + t(3)*y2%y(i1) - t(2)*y3%y(i1) ) * scaleFactor - y_out%y(i1) = y1%y(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 SS_Rad_Output_ExtrapInterp2 - + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + IF (ALLOCATED(y_out%y) .AND. ALLOCATED(y1%y)) THEN + y_out%y = a1*y1%y + a2*y2%y + a3*y3%y + END IF ! check if allocated + IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + a3*y3%WriteOutput + END IF ! check if allocated +END SUBROUTINE END MODULE SS_Radiation_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/hydrodyn/src/UserWaves.f90 b/modules/hydrodyn/src/UserWaves.f90 deleted file mode 100644 index 4689ba2438..0000000000 --- a/modules/hydrodyn/src/UserWaves.f90 +++ /dev/null @@ -1,984 +0,0 @@ -MODULE UserWaves - - USE Waves_Types - USE NWTC_Library - USE NWTC_FFTPACK - - IMPLICIT NONE - PRIVATE - - PUBLIC :: UserWaves_Init - PUBLIC :: UserWaveElevations_Init - - - ! Data type for reading in wave elevation data from a file. - TYPE :: WaveElevInputDataFile - REAL(DbKi) :: WaveDT !< time step size - INTEGER(IntKi) :: NStepWave !< Number of wave elevation steps - REAL(SiKi) :: WaveTMax !< Maximum time - REAL(SiKi), ALLOCATABLE :: WaveElev(:) !< Wave elevation at each timestep (m) - REAL(SiKi), ALLOCATABLE :: WaveTime(:) !< Timestamp of each wave elevation (s) - CHARACTER(1024) :: FileName !< Name of the file - END TYPE WaveElevInputDataFile - - - - - CONTAINS - - - - - -!---------------------------------------------------------------------------------------------------------------------------------- -!> This subroutine reads in the wave elevations from a file and reconstructs the frequency information. -!! -!! FILE Format: -!! Header info: -!! This file may have header lines. These can be any number of lines at the beginning of the file that -!! start with non-numeric data. The Value of WaveDT is calculated using the first and last rows of data, -!! and the number of timesteps. The Number of timesteps is calculated as the number of lines of data, minus 1. -!! -!! column headings --> column 1 = time (s), column 2 = elevation (m) -!! -!! -SUBROUTINE WaveElev_ReadFile ( InitInp, WaveElevData, ErrStat, ErrMsg ) - - IMPLICIT NONE - TYPE(Waves_InitInputType), INTENT(IN ) :: InitInp !< Input data for initialization routine - TYPE(WaveElevInputDataFile), INTENT( OUT) :: WaveElevData !< Wave elevation file data, after changing NStepWave - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error Status at return - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - - ! Variables for reading in the wave elevation - CHARACTER(1024) :: FileName !< Name of the file we are reading - REAL(SiKi) :: TmpWaveElevRow(2) !< row read in from the wave elevation input file - - - ! Local Variables - CHARACTER(1024) :: TextLine !< One line of text read from the file - INTEGER(IntKi) :: LineLen !< The length of the line read in - INTEGER(IntKi) :: I !< Generic counter integer - INTEGER(IntKi) :: NumDataColumns !< Number of columns of data found in the file - INTEGER(IntKi) :: NumHeaderLines !< Number of header lines in the file. - INTEGER(IntKi) :: WaveElevUnit !< Unit number for the ElevFileName - INTEGER(IntKi) :: ErrStatTmp !< Temporarary error status for procesing - CHARACTER(ErrMsgLen) :: ErrMsgTmp !< Temporary error message for processing - CHARACTER(*), PARAMETER :: RoutineName = 'WaveElev_ReadFile' - - - - - ! Initialize the error handling - ErrStat = ErrID_None - ErrMsg = "" - - - ! Get a unit number for reading in the file - CALL GetNewUnit( WaveElevUnit ) - - ! Assemble the filename for the wave elevation data. - WaveElevData%FileName = TRIM(InitInp%WvKinFile)//'.Elev' - - ! Open the file containing the wave elevation timeseries - CALL OpenFInpFile( WaveElevUnit, WaveElevData%FileName, ErrStatTmp, ErrMsgTmp ) - CALL SetErrStat( ErrStatTmp, ErrMsgTmp, ErrStat,ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) THEN - CLOSE ( WaveElevUnit ) - CALL CleanUp() - RETURN - END IF - - - ! Find out how the data is formatted - CALL GetFileLength(WaveElevUnit, TRIM(WaveElevData%Filename), NumDataColumns, WaveElevData%NStepWave, NumHeaderLines, ErrStatTmp, ErrMsgTmp) - CALL SetErrStat( ErrStatTmp, ErrMsgTmp, ErrStat,ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) THEN - CLOSE ( WaveElevUnit ) - CALL CleanUp() - RETURN - END IF - - - ! Check that we read in two columns - IF ( NumDataColumns /= 2_IntKi ) THEN - CALL SetErrStat( ErrID_Fatal, ' Wave elevation files should contain only two columns of data: Time (s) and Elevation (m). '// & - 'Found '//TRIM(Num2LStr(NumDataColumns))//' of data in '//TRIM(WaveElevData%FileName)//'.', ErrStat, ErrMsg, RoutineName) - CLOSE ( WaveElevUnit ) - CALL CleanUp() - RETURN - END IF - - - ! Adjust the number of steps since we index from zero - WaveElevData%NStepWave = WaveElevData%NStepWave - 1_IntKi - - - - !-------------------------------------------------- - ! Read in the data - !-------------------------------------------------- - - ! Allocate the array to store the time series - ALLOCATE ( WaveElevData%WaveTime(0:WaveElevData%NStepWave), STAT = ErrStatTmp ) - IF ( ErrStatTmp /= 0 ) THEN - CALL SetErrStat( ErrID_Fatal, 'Error allocating space for user WaveTime array.', ErrStat, ErrMsg, RoutineName ) - CLOSE ( WaveElevUnit ) - CALL CleanUp() - RETURN - END IF - - ! Allocate the array to store the elevation series - ALLOCATE ( WaveElevData%WaveElev(0:WaveElevData%NStepWave), STAT = ErrStatTmp ) - IF ( ErrStatTmp /= 0 ) THEN - CALL SetErrStat( ErrID_Fatal, 'Error allocating space for user WaveElev array.', ErrStat, ErrMsg, RoutineName ) - CLOSE ( WaveElevUnit ) - CALL CleanUp() - RETURN - END IF - - - ! Read and discard the header lines - DO I=1,NumHeaderLines - CALL ReadLine( WaveElevUnit, '', TextLine, LineLen, ErrStatTmp ) - ENDDO - - - ! Read in all the data - DO I=0,WaveElevData%NStepWave - CALL ReadAry( WaveElevUnit, WaveElevData%FileName, TmpWaveElevRow(1:2), 2, 'TmpWaveElevRow','Temporary variable holding the time and wave elevation pair', & - ErrStatTmp,ErrMsgTmp ) - IF ( ErrStatTmp /= 0 ) THEN - CALL SetErrStat( ErrID_Fatal, 'Error in reading in value from the file: line number '//TRIM(Num2LStr(I))//'. Expecting a total of '// & - TRIM(Num2LStr(WaveElevData%NStepWave))//' rows of data.', ErrStat, ErrMsg, RoutineName ) - CLOSE ( WaveElevUnit ) - CALL CleanUp() - RETURN - END IF - - ! Copy the data to the appropriate places - WaveElevData%WaveTime(I) = TmpWaveElevRow(1) - WaveElevData%WaveElev(I) = TmpWaveElevRow(2) - - ENDDO - - CALL WrScr( ' Read in '//TRIM(Num2LStr(I))//' lines of wave elevation data from '//TRIM(WaveElevData%FileName)//'.' ) - - - CLOSE( WaveElevUnit ) - - - - ! We are going to be a little bit lazy here and blindly assume that the time is correct in the file - ! and that the timesteps are uniform throughout the file (if this isn't true, that isn't the problem - ! of the programmer, rather of the user). - - ! Set the value for WaveTMax using the difference betwee the last value read in and the fist - WaveElevData%WaveTMax = WaveElevData%WaveTime(WaveElevData%NStepWave) - WaveElevData%WaveTime(0) - - ! Set the value for WaveDT using the number of steps read in and the difference from first and last - WaveElevData%WaveDT = REAL( WaveElevData%WaveTMax / WaveElevData%NStepWave, DbKi ) - - - CONTAINS - - SUBROUTINE CleanUp - - IF (ALLOCATED( WaveElevData%WaveElev )) DEALLOCATE( WaveElevData%WaveElev, STAT=ErrStatTmp) - IF (ALLOCATED( WaveElevData%WaveTime )) DEALLOCATE( WaveElevData%WaveTime, STAT=ErrStatTmp) - - END SUBROUTINE CleanUp - - !------------------------------------------------------------------------------------------------------------------------------- - !> This subroutine looks at a file that has been opened and finds out how many header lines there are, how many periods - !! (frequencies) there are (first only if there are paired periods for second order), 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 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, Filename, NumDataColumns, NumDataLines, NumHeaderLines, ErrStat, ErrMsg) - - IMPLICIT NONE - - ! Passed variables - INTEGER(IntKi), INTENT(IN ) :: UnitDataFile !< Unit number of the file we are looking at. - CHARACTER(*), INTENT(IN ) :: Filename !< 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. - 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(SiKi) :: 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 - CHARACTER(*), PARAMETER :: RoutineName = 'GetFileLength' - - - - ! 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(SiKi). '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(FileName)// & - ' when real numbers were expected. There may be a problem with the file.', ErrStat, ErrMsg, RoutineName) - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp - 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 data file: '//TRIM(Filename)//'.'// & - ' 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 - CALL CleanUp - RETURN - ENDIF - ENDIF - ENDIF - ENDIF - - ENDDO - - IF ( NumDataLines < 2 ) THEN - CALL SetErrStat( ErrID_Fatal, ' The file '//TRIM(Filename)//' contains only '//TRIM(Num2LStr(NumDataLines))// & - ' lines of data. This does not appear to be a useful wave elevation file.', ErrStat, ErrMsg, RoutineName) - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp - RETURN - ENDIF - ENDIF - - 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(SiKi), 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(SiKi), 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 WaveElev_ReadFile - -!---------------------------------------------------------------------------------------------------------------------------------- - -FUNCTION is_numeric(string, x) - IMPLICIT NONE - CHARACTER(len=*), INTENT(IN) :: string - REAL(SiKi), INTENT(OUT) :: x - LOGICAL :: is_numeric - - INTEGER :: e,n - CHARACTER(len=12) :: fmt - x = 0.0_SiKi - n=LEN_TRIM(string) - WRITE(fmt,'("(F",I0,".0)")') n - READ(string,fmt,IOSTAT=e) x - is_numeric = e == 0 -END FUNCTION is_numeric - -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine initializes the wave kinematics based a set of user-supplied wave elevations -!! -!! NOTE: WaveDT in file must match given WaveDT in HydroDyn input file -!! Final timestep must match given WaveTMax in HydroDyn input file -!! NOTE: Wave frequency cutoffs can are applied to the read in wave elevation time series -!! -SUBROUTINE UserWaveElevations_Init ( InitInp, InitOut, ErrStat, ErrMsg ) -!---------------------------------------------------------------------------------------------------------------------------------- - TYPE(Waves_InitInputType), INTENT(IN ) :: InitInp !< Input data for initialization routine - TYPE(Waves_InitOutputType), INTENT(INOUT) :: InitOut !< Initialization outputs - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - - - ! Local Variables - TYPE(WaveElevInputDataFile) :: WaveElevData !< Wave elevation file data after changing NStepWave - REAL(SiKi), ALLOCATABLE :: TmpFFTWaveElev(:) !< Data for the FFT calculation - TYPE(FFT_DataType) :: FFT_Data !< the instance of the FFT module we're using - INTEGER(IntKi) :: I !< Generic counter - - - ! Temporary error handling variables - INTEGER(IntKi) :: ErrStatTmp !< Temporarary error status for procesing - CHARACTER(ErrMsgLen) :: ErrMsgTmp !< Temporary error message for processing - CHARACTER(*), PARAMETER :: RoutineName = 'UserWaveElevations_Init' - - ! Data verification: WaveDT in the HD file and in the .Elev file may be slightly different. We will allow - ! some slight differences due to rounding. If necessary, we could change this to a percentage allowable in the future. - REAL(SiKi), PARAMETER :: WaveDT_Tol = 0.001_SiKi !< Allowable difference in WaveDT values - - ! set error status information - ErrStat = ErrID_None - ErrMsg = '' - - - - ! Statement to user - CALL WrScr1 ( ' Reading in wave elevation data from wave kinematics files with root name "'//TRIM(InitInp%WvKinFile)//'".' ) - - ! Read in the wave elevation data - CALL WaveElev_ReadFile (InitInp, WaveElevData, ErrStatTmp, ErrMsgTmp ) - CALL SetErrStat(ErrStatTmp,ErrMsgTmp,ErrStat,ErrMsg,RoutineName) - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp() - RETURN - END IF - - - ! Check that the file timestep is the same as the HD file, and check that the WaveTMax value of the file is larger than that of HD. - IF ( InitInp%WaveTMax > WaveElevData%WaveTMax ) THEN - CALL SetErrStat(ErrID_Fatal,' HydroDyn requires a minimum of '//TRIM(Num2LStr(InitInp%WaveTMax))//', but '//TRIM(WaveElevData%FileName)// & - ' only contains a maximum time of '//TRIM(Num2LStr(WaveElevData%WaveTMax))//' (last line).',ErrStat,ErrMsg,RoutineName) - ENDIF - - ! Check that the values of WaveDT are the same or similar enough - IF ( ABS(InitInp%WaveDT - WaveElevData%WaveDT) > WaveDT_Tol ) THEN - CALL SetErrStat(ErrID_Fatal,' WaveDT from Hydrodyn ('//TRIM(Num2LStr(InitInp%WaveDT))//') and timestep size in wave elevation file '// & - TRIM(WaveElevData%FileName)//' (WaveDT = '//TRIM(Num2LStr(WaveElevData%WaveDT))//') do not match. These need to be within '// & - TRIM(Num2LStr(WaveDT_Tol))//' seconds of each other.',ErrStat,ErrMsg,RoutineName) - ENDIF - - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp() - RETURN - END IF - - - ! Set new value for NStepWave so that the FFT algorithms are efficient. We will use the values passed in rather than what is read from the file - ! NOTE: This method is what is used in the VariousWaves_Init routine in Waves.f90 - - InitOut%NStepWave = CEILING ( InitInp%WaveTMax/InitInp%WaveDT ) ! Set NStepWave to an even integer - IF ( MOD(InitOut%NStepWave,2) == 1 ) InitOut%NStepWave = InitOut%NStepWave + 1 ! larger or equal to WaveTMax/WaveDT. - InitOut%NStepWave2 = MAX( InitOut%NStepWave/2, 1 ) ! Make sure that NStepWave is an even product of small factors (PSF) that is - InitOut%NStepWave = 2*PSF ( InitOut%NStepWave2, 9 ) ! greater or equal to WaveTMax/WaveDT to ensure that the FFT is efficient. - InitOut%NStepWave2 = InitOut%NStepWave/2 ! Update the value of NStepWave2 based on the value needed for NStepWave. - InitOut%WaveTMax = InitOut%NStepWave*InitInp%WaveDT ! Update the value of WaveTMax based on the value needed for NStepWave. - InitOut%WaveDOmega = TwoPi/InitInp%WaveTMax ! Compute the frequency step for incident wave calculations. - - ! Give warning if the number of timesteps changed - IF ( WaveElevData%NStepWave /= InitOut%NStepWave ) THEN - CALL SetErrStat(ErrID_Warn, ' Changed number of timesteps from '//TRIM(Num2LStr(WaveElevData%NStepWave))//' to '// & - TRIM(Num2LStr(InitOut%NStepWave))//' in order to calculate the frequency information from the wave elevations. '// & - 'Wave elevations during additional time are padded with zero wave elevation.',ErrStat,ErrMsg,RoutineName) - ENDIF - - ! Allocate array to hold the wave elevations for calculation of FFT. - ALLOCATE ( TmpFFTWaveElev( 0:InitOut%NStepWave-1 ), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array TmpFFTWaveElev.',ErrStat,ErrMsg,RoutineName) - - ! Allocate frequency array for the wave elevation information in frequency space - ALLOCATE ( InitOut%WaveElevC0(2, 0:InitOut%NStepWave2 ), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array InitOut%WaveElevC0.',ErrStat,ErrMsg,RoutineName) - - - - ! Now check if all the allocations worked properly - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp() - RETURN - END IF - - ! Set the values - TmpFFTWaveElev = 0.0_SiKi - InitOut%WaveElevC0(:,:) = 0.0_SiKi - - - ! Copy values over - DO I=0,MIN(WaveElevData%NStepWave,InitOut%NStepWave-1) - TmpFFTWaveElev(I) = WaveElevData%WaveElev(I) - ENDDO - - ! Initialize the FFT - CALL InitFFT ( InitOut%NStepWave, FFT_Data, .FALSE., ErrStatTmp ) - CALL SetErrStat(ErrStatTmp,'Error occured while initializing the FFT.',ErrStat,ErrMsg,RoutineName) - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp() - RETURN - END IF - - ! Apply the forward FFT to get the real and imaginary parts of the frequency information. - CALL ApplyFFT_f ( TmpFFTWaveElev(:), FFT_Data, ErrStatTmp ) ! Note that the TmpFFTWaveElev now contains the real and imaginary bits. - CALL SetErrStat(ErrStatTmp,'Error occured while applying the forwards FFT to TmpFFTWaveElev array.',ErrStat,ErrMsg,RoutineName) - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp() - RETURN - END IF - - - ! Copy the resulting TmpFFTWaveElev(:) data over to the InitOut%WaveElevC0 array - DO I=1,InitOut%NStepWave2-1 - InitOut%WaveElevC0 (1,I) = TmpFFTWaveElev(2*I-1) - InitOut%WaveElevC0 (2,I) = TmpFFTWaveElev(2*I) - ENDDO - InitOut%WaveElevC0(:,InitOut%NStepWave2) = 0.0_SiKi - - CALL ExitFFT(FFT_Data, ErrStatTmp) - CALL SetErrStat(ErrStatTmp,'Error occured while cleaning up after the FFTs.', ErrStat,ErrMsg,RoutineName) - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp() - RETURN - END IF - - - IF (ALLOCATED( WaveElevData%WaveElev )) DEALLOCATE( WaveElevData%WaveElev, STAT=ErrStatTmp) - IF (ALLOCATED( TmpFFTWaveElev )) DEALLOCATE( TmpFFTWaveElev, STAT=ErrStatTmp) - - - - CONTAINS - - SUBROUTINE CleanUp - - IF (ALLOCATED( WaveElevData%WaveElev )) DEALLOCATE( WaveElevData%WaveElev, STAT=ErrStatTmp) - IF (ALLOCATED( WaveElevData%WaveTime )) DEALLOCATE( WaveElevData%WaveTime, STAT=ErrStatTmp) - IF (ALLOCATED( TmpFFTWaveElev )) DEALLOCATE( TmpFFTWaveElev, STAT=ErrStatTmp) - IF (ALLOCATED( InitOut%WaveElevC0 )) DEALLOCATE( InitOut%WaveElevC0, STAT=ErrStatTmp) - - END SUBROUTINE CleanUp - - -END SUBROUTINE UserWaveElevations_Init - - - -!---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE UserWaves_Init ( InitInp, InitOut, ErrStat, ErrMsg ) -! This routine initializes the wave kinematics based on user-supplied data -!---------------------------------------------------------------------------------------------------------------------------------- - TYPE(Waves_InitInputType), INTENT(IN ) :: InitInp ! Input data for initialization routine - TYPE(Waves_InitOutputType), INTENT(INOUT) :: InitOut ! Initialization outputs - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None - - - - INTEGER :: UnWv ! file unit for writing the various wave kinematics files - CHARACTER(1024) :: FileName ! complete filename for one of the output files - INTEGER :: I ! Generic index - INTEGER :: J ! Generic index - INTEGER :: iFile ! Generic index - CHARACTER(64) :: Frmt, Sfrmt - CHARACTER(10) :: Delim - CHARACTER(64), ALLOCATABLE :: WaveDataStr(:,:) - REAL(SiKi), ALLOCATABLE :: WaveData(:,:) - - ! Temporary error handling variables - INTEGER(IntKi) :: ErrStatTmp ! Temporarary error status for procesing - CHARACTER(ErrMsgLen) :: ErrMsgTmp ! Temporary error message for processing - LOGICAL :: isNumeric - CHARACTER(*), PARAMETER :: RoutineName = 'UserWaves_Init' - CHARACTER(5) :: extension(7) - - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - - extension = (/'.Vxi ','.Vyi ','.Vzi ','.Axi ','.Ayi ','.Azi ','.DynP'/) - Delim = '' - - - ! Tell our nice users what is about to happen that may take a while: - - CALL WrScr1 ( ' Reading in wave data from wave kinematics files with root name "'//TRIM(InitInp%WvKinFile)//'".' ) - - - - ! Perform some initialization computations including calculating the - ! total number of time steps in the incident wave and ALLOCATing the - ! arrays; initialize the unneeded values to zero: - InitOut%NStepWave = CEILING ( InitInp%WaveTMax/InitInp%WaveDT ) ! Set NStepWave to an even integer - IF (.NOT. (EqualRealNos( REAL(InitInp%WaveTMax, SiKi) - REAL(InitOut%NStepWave*InitInp%WaveDT, SiKi), 0.0_SiKi ) ) ) THEN - ErrMsg = 'For WaveMod = 5 or 6, WaveTMax must be a multiple of WaveDT' - ErrStat = ErrID_Fatal - RETURN - END IF - - InitOut%NStepWave2 = InitOut%NStepWave/2 - - ALLOCATE ( WaveDataStr (0:InitOut%NStepWave,InitInp%NWaveKin ) , STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveDataStr.', ErrStat,ErrMsg,RoutineName) - - ALLOCATE ( InitOut%nodeInWater (0:InitOut%NStepWave,InitInp%NWaveKin ) , STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array outOfWaterFlag.', ErrStat,ErrMsg,RoutineName) - InitOut%nodeInWater = 1 - - ALLOCATE ( WaveData (0:InitOut%NStepWave,InitInp%NWaveKin ) , STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveData.', ErrStat,ErrMsg,RoutineName) - WaveData = 0.0_SiKi - - ALLOCATE ( InitOut%WaveTime (0:InitOut%NStepWave ) , STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array InitOut%WaveTime.', ErrStat,ErrMsg,RoutineName) - - ALLOCATE ( InitOut%WaveElev (0:InitOut%NStepWave,InitInp%NWaveElev ) , STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array InitOut%WaveElev.', ErrStat,ErrMsg,RoutineName) - InitOut%WaveElev = 0.0_SiKi - - ALLOCATE ( InitOut%WaveDynP (0:InitOut%NStepWave,InitInp%NWaveKin ) , STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array InitOut%WaveDynP.', ErrStat,ErrMsg,RoutineName) - - ALLOCATE ( InitOut%WaveVel (0:InitOut%NStepWave,InitInp%NWaveKin,3) , STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array InitOut%WaveVel.', ErrStat,ErrMsg,RoutineName) - - ALLOCATE ( InitOut%WaveAcc (0:InitOut%NStepWave,InitInp%NWaveKin,3) , STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array InitOut%WaveAcc.', ErrStat,ErrMsg,RoutineName) - - - - ! Now check if all the allocations worked properly - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp() - RETURN - END IF - - - - - ! Read the first file and set the initial values of the - - CALL GetNewUnit( UnWv ) - - FileName = TRIM(InitInp%WvKinFile) // TRIM(extension(1)) - - CALL OpenFInpFile ( UnWv, FileName, ErrStat, ErrMsg ) - IF ( ErrStat /= 0 ) THEN - ErrStat = ErrID_Fatal - ErrMsg = 'Failed to open wave kinematics file, ' // TRIM(FileName) - RETURN - END IF - - - - CALL ReadCom( UnWv, FileName, 'HydroDyn wave kinematics file header line 1', ErrStatTmp, ErrMsgTmp ) - CALL SetErrStat( ErrStatTmp, ErrMsgTmp, ErrStat, ErrMsg, RoutineName ) - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF - - DO i = 0,InitOut%NStepWave-1 - ! Extract fields from current line - IF (.not. ExtractFields(UnWv, WaveDataStr(i,:), InitInp%NWaveKin)) THEN - call Cleanup() - RETURN - END IF - DO j = 1, InitInp%NWaveKin - - isNumeric = is_numeric(WaveDataStr(i,j), WaveData(i,j)) - IF (.NOT. isNumeric )THEN - InitOut%nodeInWater(i,j) = 0 - WaveData(i,j) = 0.0 - ELSE - InitOut%nodeInWater(i,j) = 1 - END IF - - - END DO - - END DO - - InitOut%WaveVel (:,:,1) = WaveData(:,:) - - ! Now read the remaining files and check that the elements are consistent with the first file - DO iFile = 2,7 - - CALL GetNewUnit( UnWv ) - - FileName = TRIM(InitInp%WvKinFile) // TRIM(extension(iFile)) - - CALL OpenFInpFile ( UnWv, FileName, ErrStat, ErrMsg ) - IF ( ErrStat /= 0 ) THEN - ErrStat = ErrID_Fatal - ErrMsg = 'Failed to open wave kinematics file, ' // TRIM(FileName) - RETURN - END IF - - - - CALL ReadCom( UnWv, FileName, 'HydroDyn wave kinematics file header line 1', ErrStatTmp, ErrMsgTmp ) - CALL SetErrStat( ErrStatTmp, ErrMsgTmp, ErrStat, ErrMsg, RoutineName ) - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF - - DO i = 0,InitOut%NStepWave-1 - ! Extract fields from current line - IF (.not. ExtractFields(UnWv, WaveDataStr(i,:), InitInp%NWaveKin)) THEN - call Cleanup() - RETURN - END IF - DO j = 1, InitInp%NWaveKin - isNumeric = is_numeric(WaveDataStr(i,j), WaveData(i,j)) - IF ( ( isNumeric .AND. (InitOut%nodeInWater(i,j) == 0) ) .OR. ( .NOT. isNumeric .AND. ( InitOut%nodeInWater(i,j) == 1 ) ) ) THEN - ErrStatTmp = ErrID_Fatal - ErrMsgTmp = 'Element of wave kinematics file must be numerical or non-numerical across all files. Problem was found in ' // TRIM(FileName) // ' on row ' // Num2LStr(i+1) // ' and column ' // Num2LStr(j) - CALL SetErrStat( ErrStatTmp, ErrMsgTmp, ErrStat, ErrMsg, RoutineName ) - CALL CleanUp() - RETURN - END IF - - IF (.NOT. isNumeric ) THEN - InitOut%nodeInWater(i,j) = 0 - WaveData(i,j) = 0.0 - ELSE - InitOut%nodeInWater(i,j) = 1 - END IF - END DO - - END DO - SELECT CASE (iFile) - CASE (1) - InitOut%WaveVel (:,:,1) = WaveData(:,:) - CASE (2) - InitOut%WaveVel (:,:,2) = WaveData(:,:) - CASE (3) - InitOut%WaveVel (:,:,3) = WaveData(:,:) - CASE (4) - InitOut%WaveAcc (:,:,1) = WaveData(:,:) - CASE (5) - InitOut%WaveAcc (:,:,2) = WaveData(:,:) - CASE (6) - InitOut%WaveAcc (:,:,3) = WaveData(:,:) - CASE (7) - InitOut%WaveDynP = WaveData - END SELECT - - CLOSE(UnWv) - END DO - - ! WaveTime - DO i = 0,InitOut%NStepWave - InitOut%WaveTime(i) = i*InitInp%WaveDT - END DO - - ! WaveElev - IF ( InitInp%NWaveElev > 0 ) THEN - CALL GetNewUnit( UnWv ) - - FileName = TRIM(InitInp%WvKinFile) // '.Elev' - - CALL OpenFInpFile ( UnWv, FileName, ErrStat, ErrMsg ) - IF ( ErrStat /= 0 ) THEN - ErrStat = ErrID_Fatal - ErrMsg = 'Failed to open wave elevations file, ' // TRIM(FileName) - RETURN - END IF - - Frmt = '('//TRIM(Int2LStr(InitInp%NWaveElev))//'(:,A,ES11.4e2))' - - CALL ReadCom( UnWv, FileName, 'HydroDyn wave elevations file header line 1', ErrStatTmp, ErrMsgTmp ) - CALL SetErrStat( ErrStatTmp, ErrMsgTmp, ErrStat, ErrMsg, RoutineName ) - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF - - DO i = 0,InitOut%NStepWave-1 - Read(UnWv,Frmt) ( Delim, InitOut%WaveElev(i,j) , j=1,InitInp%NWaveElev ) - END DO - CLOSE(UnWv) - END IF - CALL CleanUp( ) - - ! Need to append the first time step record to the end of each array for periodic waves - InitOut%WaveVel (InitOut%NStepWave,:,:) = InitOut%WaveVel (0,:,:) - InitOut%WaveAcc (InitOut%NStepWave,:,:) = InitOut%WaveAcc (0,:,:) - InitOut%WaveDynP(InitOut%NStepWave,:) = InitOut%WaveDynP(0,: ) - InitOut%WaveElev(InitOut%NStepWave,:) = InitOut%WaveElev(0,:) - InitOut%nodeInWater(InitOut%NStepWave,:) = InitOut%nodeInWater(0,:) - - - - ! For creating animations of the sea surface, the WaveElevXY array is passed in with a series of x,y coordinates - ! (index 1). The second index corresponds to the number of points passed in. A two dimensional time series - ! is created with the first index corresponding to the timestep, and second index corresponding to the second - ! index of the WaveElevXY array. - IF ( ALLOCATED(InitInp%WaveElevXY)) THEN - ALLOCATE ( InitOut%WaveElevSeries (0:InitOut%NStepWave, 1:SIZE(InitInp%WaveElevXY, DIM=2)) , STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) THEN - CALL SetErrStat(ErrID_Fatal,'Cannot allocate array InitOut%WaveElevSeries.',ErrStat,ErrMsg,'VariousWaves_Init') - RETURN - END IF - ! Calculate the wave elevation at all points requested in the array WaveElevXY - DO I = 0,InitOut%NStepWave - DO J = 1,SIZE(InitInp%WaveElevXY, DIM=2) - InitOut%WaveElevSeries(I,J) = 0.0_ReKi ! TODO, these values should be interpolated based on inputs - ENDDO - ENDDO - ENDIF - - -CONTAINS - - !> Sub function to extract n fields on the current line of the file unit FU - FUNCTION ExtractFields(FU, s, n) result(OK) - ! Arguments - INTEGER, INTENT(IN) :: FU !< Unit name - INTEGER, INTENT(IN) :: n !< Number of fields - CHARACTER(*), INTENT(OUT) :: s(n) !< Fields - LOGICAL :: OK - ! Local var - CHARACTER(65536) :: TextLine !< One line of text read from the file - OK=.TRUE. - - ! Read line - READ(FU, FMT='(A)', IOSTAT=ErrStat) TextLine - IF (ErrStat/=0) THEN - ErrStat = ErrID_Fatal - WRITE(ErrMsg,'(A,I0,A,I0,A)') 'Failed to read line ',I+2,' (out of ',InitOut%NStepWave+1,' expected lines) in file '//TRIM(FileName)//& - & '. Check that the number of lines (without header) is equal to WaveTMax/WaveDT. ' - OK=.FALSE. - RETURN - END IF - - ! Extract fields (ReadCAryFromStr is in NWTC_IO) - CALL ReadCAryFromStr ( TextLine, s, n, 'line', 'junk', ErrStat, ErrMsgTmp ) - IF (ErrStat/=0) THEN - ErrStat = ErrID_Fatal - write(ErrMsg,'(A,I0,A,I0,A)') 'Failed to extract fields from line ',I+2,' in file '//TRIM(FileName)//'. '//& - & trim(ErrMsgTmp)//' Check that the number of columns is correct and matches the number of internal HydroDyn nodes.'//& - &' (Typically twice the number of joints).' - OK=.FALSE. - RETURN - END IF - END FUNCTION ExtractFields - - SUBROUTINE CleanUp( ) - - IF (ALLOCATED( WaveDataStr )) DEALLOCATE( WaveDataStr, STAT=ErrStatTmp) - IF (ALLOCATED( WaveData )) DEALLOCATE( WaveData, STAT=ErrStatTmp) - !IF (ALLOCATED( outOfWaterFlag )) DEALLOCATE( outOfWaterFlag, STAT=ErrStatTmp) - !IF (ALLOCATED( GHWvDpth )) DEALLOCATE( GHWvDpth, STAT=ErrStatTmp) - !IF (ALLOCATED( WaveElev0 )) DEALLOCATE( WaveElev0, STAT=ErrStatTmp) - CLOSE(UnWv) - RETURN - END SUBROUTINE CleanUp - - END SUBROUTINE UserWaves_Init -END MODULE UserWaves diff --git a/modules/hydrodyn/src/WAMIT.f90 b/modules/hydrodyn/src/WAMIT.f90 index bce90bec42..d04c5a823b 100644 --- a/modules/hydrodyn/src/WAMIT.f90 +++ b/modules/hydrodyn/src/WAMIT.f90 @@ -25,11 +25,11 @@ MODULE WAMIT USE WAMIT_Types USE WAMIT_Interp USE NWTC_Library - ! USE Waves_Types USE Conv_Radiation USE SS_Radiation USE SS_Excitation USE NWTC_FFTPACK + USE YawOffset IMPLICIT NONE @@ -53,7 +53,11 @@ MODULE WAMIT PUBLIC :: WAMIT_CalcContStateDeriv ! Tight coupling routine for computing derivatives of continuous states PUBLIC :: WAMIT_UpdateDiscState ! Tight coupling routine for updating discrete states - + INTERFACE GetAngleInRange + MODULE PROCEDURE GetAngleInRangeR4 + MODULE PROCEDURE GetAngleInRangeR8 + END INTERFACE GetAngleInRange + CONTAINS !---------------------------------------------------------------------------------------------------------------------------------- @@ -95,7 +99,7 @@ end subroutine TransformWAMITMatrices !> 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 WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut, ErrStat, ErrMsg ) +SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, ErrStat, ErrMsg ) !.................................................................................................................................. TYPE(WAMIT_InitInputType), INTENT(INOUT) :: InitInp !< Input data for initialization routine. NOTE: we need INOUT because we may be moving the allocation of SS_Excitation data @@ -108,13 +112,12 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init TYPE(WAMIT_OutputType), INTENT( OUT) :: y !< Initial system outputs (outputs are not calculated; !! only the output mesh is initialized) TYPE(WAMIT_MiscVarType), INTENT( OUT) :: m !< Initial misc/optimization variables - REAL(DbKi), INTENT(INOUT) :: Interval !< Coupling interval in seconds: the rate that + REAL(DbKi), INTENT(IN ) :: Interval !< Coupling interval in seconds: the rate that !! (1) WAMIT_UpdateStates() is called in loose coupling & !! (2) WAMIT_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(WAMIT_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 @@ -135,7 +138,8 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init ! Local Variables REAL(DbKi) :: Interval_Sub ! Local timestep for the SS_Rad and SS_Exc modules, based on RdtnDT COMPLEX(SiKi), ALLOCATABLE :: HdroExctn (:,:,:) ! Frequency- and direction-dependent complex hydrodynamic wave excitation force per unit wave amplitude vector (kg/s^2, kg-m/s^2) - COMPLEX(SiKi), ALLOCATABLE :: WaveExctnC(:,:) ! Discrete Fourier transform of the instantaneous value of the total excitation force on the support platfrom from incident waves (N, N-m) + COMPLEX(SiKi), ALLOCATABLE :: WaveExctnC(:,:,:) ! Discrete Fourier transform of the instantaneous value of the total excitation force on the support platfrom from incident waves (N, N-m) + COMPLEX(SiKi), ALLOCATABLE :: WaveExctnCGrid(:,:,:,:) ! Discrete Fourier transform of the instantaneous value of the total excitation force on the grid points from incident waves (N, N-m) REAL(ReKi) :: DffrctDim (6) ! Matrix used to redimensionalize WAMIT hydrodynamic wave excitation force output (kg/s^2, kg-m/s^2 ) REAL(SiKi), ALLOCATABLE :: HdroAddMs (:,:,:) ! The frequency-dependent hydrodynamic added mass matrix from the radiation problem (kg , kg-m , kg-m^2 ) REAL(SiKi), ALLOCATABLE :: HdroDmpng (:,:,:) ! The frequency-dependent hydrodynamic damping matrix from the radiation problem (kg/s, kg-m/s, kg-m^2/s) @@ -143,6 +147,7 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init REAL(SiKi), ALLOCATABLE :: HdroWvDir (:) ! Incident wave propagation heading direction components inherent in the complex wave excitation force per unit wave amplitude vector (degrees) REAL(ReKi) :: HighFreq ! The highest frequency component in the WAMIT file, not counting infinity. REAL(SiKi) :: Omega ! Wave frequency (rad/s) + REAL(ReKi) :: PRPHdg ! Platform reference heading (rad) REAL(ReKi) :: PrvDir ! The value of TmpDir from the previous line (degrees) REAL(ReKi) :: PrvPer ! The value of TmpPer from the previous line (sec ) REAL(ReKi) :: SttcDim (6,6) ! Matrix used to redimensionalize WAMIT hydrostatic restoring output (kg/s^2, kg-m/s^2, kg-m^2/s^2) @@ -159,8 +164,7 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init REAL(ReKi), ALLOCATABLE :: WAMITPer (:) ! Period components as ordered in the WAMIT output files (sec ) REAL(ReKi), ALLOCATABLE :: WAMITWvDir(:) ! Wave direction components as ordered in the WAMIT output files (degrees) - INTEGER :: I ! Generic index - INTEGER :: Indx ! Cycles through the upper-triangular portion (diagonal and above) of the frequency-dependent hydrodynamic added mass and damping matrices from the radiation problem + INTEGER :: I,iGrid,iX,iY,iHdg,iBdy,iStp ! Generic index INTEGER :: InsertInd ! The lowest sorted index whose associated frequency component is higher than the current frequency component -- this is to sort the frequency components from lowest to highest INTEGER :: J ! Generic index INTEGER :: K ! Generic index @@ -181,21 +185,31 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init LOGICAL :: NewPer ! When .TRUE., indicates that the period has just changed. LOGICAL :: ZeroFreq ! When .TRUE., indicates that the zero -frequency limit of added mass is contained within the WAMIT output files. - CHARACTER(1024) :: Line ! String to temporarily hold the value of a line within a WAMIT output file. + CHARACTER(MaxFileInfoLineLen) :: Line ! String to temporarily hold the value of a line within a WAMIT output file. TYPE(FFT_DataType) :: FFT_Data ! the instance of the FFT module we're using integer(IntKi) :: iSub, jSub ! indices into the 6x6 sub-matrices used to redimensionalize the WAMIT data (Needed because NBodyMod=1 could have WAMIT matrices which are 6N x 6N) integer(IntKi) :: iBody ! WAMIT body index + real(ReKi) :: BdyPos0(3) ! Initial translational displacement of the WAMIT body real(R8Ki) :: orientation(3,3) ! Initial orientation of the WAMIT body real(R8Ki) :: theta(3) ! Euler angle rotations of the WAMIT body real(ReKi) :: WaveNmbr ! Frequency-dependent wave number COMPLEX(SiKi) :: Fxy ! Phase correction term for Wave excitation forces real(ReKi) :: tmpAngle ! Frequency and heading and platform offset dependent phase shift angle for Euler's Equation e^(-j*tmpAngle) - COMPLEX(SiKi), ALLOCATABLE :: HdroExctn_Local (:,:,:) ! Temporary Frequency- and direction-dependent complex hydrodynamic wave excitation force per unit wave amplitude vector (kg/s^2, kg-m/s^2) + real(SiKi) :: tmpVec3(3) + REAL(ReKi) :: RotateZdegOffset ! PtfmRefZtRot converted to degrees + REAL(SiKi) :: MinAllowedWvDir ! Minimum allowed wave heading in the global frame + REAL(SiKi) :: MaxAllowedWvDir ! Maximum allowed wave heading in the global frame + REAL(SiKi) :: unusedReal + REAL(SiKi) :: tmpDir2 + REAL(SiKi) :: AvgInpWvDirSpcg ! Average spacing of input wave directions used to check for potential gaps (deg) + LOGICAL :: dirInRange + REAL(SiKi), PARAMETER :: WvDirTol = 0.001 ! Tolerance for wave heading in degrees ! Error handling CHARACTER(ErrMsgLen) :: ErrMsg2 ! Temporary error message for calls INTEGER(IntKi) :: ErrStat2 ! Temporary error status for calls COMPLEX(SiKi) :: Ctmp1, Ctmp2, Ctmp4, Ctmp5 ! Temporary COMPLEX transformation terms + character(*), parameter :: RoutineName = 'WAMIT_Init' ! Initialize data @@ -215,41 +229,58 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init ErrStat = ErrID_None ErrMsg = "" - - ! Initialize the NWTC Subroutine Library (set pi constants) - - CALL NWTC_Init( ) - ! Copy Output Init data from Waves Module Init call - - p%NStepWave = InitInp%NStepWave - p%NumOuts = InitInp%NumOuts p%ExctnMod = InitInp%ExctnMod + p%ExctnDisp = InitInp%ExctnDisp + p%ExctnCutOff = InitInp%ExctnCutOff + p%NExctnHdg = InitInp%NExctnHdg p%NBodyMod = InitInp%NBodyMod p%NBody = InitInp%NBody ! In the context of this WAMIT object NBody is 1 if NBodyMod > 1 [there are NBody different WAMIT objects in this case] - + p%WaveField => InitInp%WaveField + p%PtfmYMod = InitInp%PtfmYMod + + ! Set up wave excitation grid - Can no longer use the WaveField parameters due to different headings + ! Copy WaveField grid parameters + call SeaSt_WaveField_CopyParam(p%WaveField%GridParams, p%ExctnGridParams, 0, ErrStat2, ErrMsg2); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if ( p%ExctnDisp == 0 ) then + p%ExctnGridParams%n(2:3) = 1_IntKi + p%ExctnGridParams%delta(2:3) = 0.0_SiKi + p%ExctnGridParams%pZero(2:3) = 0.0_SiKi + end if + ! Set the fourth index based on PRP heading + if ( InitInp%PtfmYMod .EQ. 0) then ! Constant reference yaw offset + p%NExctnHdg = 0_IntKi + p%ExctnGridParams%delta(4) = 0.0 + p%ExctnGridParams%pZero(4) = InitInp%PtfmRefY + else if ( InitInp%PtfmYMod .EQ. 1 ) then ! Drifting reference yaw offset + p%ExctnGridParams%delta(4) = TwoPi/Real(MAX(p%NExctnHdg,1_IntKi),ReKi) + p%ExctnGridParams%pZero(4) = -Pi + end if + p%ExctnGridParams%n(4) = p%NExctnHdg+1 + p%ExctnGridParams%Z_depth = -1.0 ! Set to Z_depth to a negative value to indicate uniform "z" grid for platform heading + ! This module's implementation requires that if NBodyMod = 2 or 3, then there is one instance of a WAMIT module for each body, therefore, HydroDyn may have NBody > 1, but this WAMIT module will have NBody = 1 if ( (p%NBodyMod > 1) .and. (p%NBody > 1) ) then - CALL SetErrStat( ErrID_Fatal, "DEVELOPER ERROR: If NBodyMod = 2 or 3, then NBody for the a WAMIT object must be equal to 1", ErrStat, ErrMsg, 'WAMIT_Init') + CALL SetErrStat( ErrID_Fatal, "DEVELOPER ERROR: If NBodyMod = 2 or 3, then NBody for the a WAMIT object must be equal to 1", ErrStat, ErrMsg, RoutineName) return end if ! Allocate misc var and parameter vectors/matrices - call AllocAry( p%F_HS_Moment_Offset, 6, p%NBody, 'p%F_HS_Moment_Offset', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'WAMIT_Init') - call AllocAry( m%F_HS , 6*p%NBody, 'm%F_HS' , ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'WAMIT_Init') - call AllocAry( m%F_Waves1 , 6*p%NBody, 'm%F_Waves1' , ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'WAMIT_Init') - call AllocAry( m%F_Rdtn , 6*p%NBody, 'm%F_Rdtn' , ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'WAMIT_Init') - call AllocAry( m%F_PtfmAM , 6*p%NBody, 'm%F_PtfmAM' , ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'WAMIT_Init') - call AllocAry( p%HdroAdMsI, 6*p%NBody,6*p%NBody, 'p%HdroAdMsI' , ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'WAMIT_Init') - call AllocAry( p%HdroSttc , 6*p%NBody,6*p%NBody, 'p%HdroSttc' , ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'WAMIT_Init') + call AllocAry( p%F_HS_Moment_Offset, 6, p%NBody, 'p%F_HS_Moment_Offset', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AllocAry( m%F_HS , 6*p%NBody, 'm%F_HS' , ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AllocAry( m%F_Waves1 , 6*p%NBody, 'm%F_Waves1' , ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AllocAry( m%F_Rdtn , 6*p%NBody, 'm%F_Rdtn' , ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AllocAry( m%F_PtfmAM , 6*p%NBody, 'm%F_PtfmAM' , ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AllocAry( p%HdroAdMsI, 6*p%NBody,6*p%NBody, 'p%HdroAdMsI' , ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AllocAry( p%HdroSttc , 6*p%NBody,6*p%NBody, 'p%HdroSttc' , ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) do iBody = 1, p%NBody p%F_HS_Moment_Offset(1,iBody) = 0.0_ReKi p%F_HS_Moment_Offset(2,iBody) = 0.0_ReKi - p%F_HS_Moment_Offset(3,iBody) = InitInp%RhoXg*InitInp%PtfmVol0(iBody) ! except for the hydrostatic buoyancy force from Archimede's Principle when the support platform is in its undisplaced position - p%F_HS_Moment_Offset(4,iBody) = InitInp%RhoXg*InitInp%PtfmVol0(iBody)*( InitInp%PtfmCOByt(iBody) - InitInp%PtfmRefyt(iBody) ) ! and the moment about X due to the COB being offset from the local WAMIT reference point - p%F_HS_Moment_Offset(5,iBody) = -InitInp%RhoXg*InitInp%PtfmVol0(iBody)*( InitInp%PtfmCOBxt(iBody) - InitInp%PtfmRefxt(iBody) ) ! and the moment about Y due to the COB being offset from the localWAMIT reference point + p%F_HS_Moment_Offset(3,iBody) = p%WaveField%RhoXg*InitInp%PtfmVol0(iBody) ! except for the hydrostatic buoyancy force from Archimede's Principle when the support platform is in its undisplaced position + p%F_HS_Moment_Offset(4,iBody) = p%WaveField%RhoXg*InitInp%PtfmVol0(iBody)*( InitInp%PtfmCOByt(iBody) - InitInp%PtfmRefyt(iBody) ) ! and the moment about X due to the COB being offset from the local WAMIT reference point + p%F_HS_Moment_Offset(5,iBody) = -p%WaveField%RhoXg*InitInp%PtfmVol0(iBody)*( InitInp%PtfmCOBxt(iBody) - InitInp%PtfmRefxt(iBody) ) ! and the moment about Y due to the COB being offset from the localWAMIT reference point p%F_HS_Moment_Offset(6,iBody) = 0.0_ReKi end do @@ -263,16 +294,16 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init ! element-by-element multiplication, instead of matrix-by-matrix ! multiplication: - SttcDim(1,1) = InitInp%RhoXg *InitInp%WAMITULEN**2 ! Force-translation - SttcDim(1,4) = InitInp%RhoXg *InitInp%WAMITULEN**3 ! Force-rotation/Moment-translation - Hydrostatic restoring - SttcDim(4,4) = InitInp%RhoXg *InitInp%WAMITULEN**4 ! Moment-rotation + SttcDim(1,1) = p%WaveField%RhoXg *InitInp%WAMITULEN**2 ! Force-translation + SttcDim(1,4) = p%WaveField%RhoXg *InitInp%WAMITULEN**3 ! Force-rotation/Moment-translation - Hydrostatic restoring + SttcDim(4,4) = p%WaveField%RhoXg *InitInp%WAMITULEN**4 ! Moment-rotation - RdtnDim(1,1) = InitInp%WtrDens*InitInp%WAMITULEN**3 ! Force-translation - RdtnDim(1,4) = InitInp%WtrDens*InitInp%WAMITULEN**4 ! Force-rotation/Moment-translation - Hydrodynamic added mass and damping - RdtnDim(4,4) = InitInp%WtrDens*InitInp%WAMITULEN**5 ! Moment-rotation + RdtnDim(1,1) = p%WaveField%WtrDens*InitInp%WAMITULEN**3 ! Force-translation + RdtnDim(1,4) = p%WaveField%WtrDens*InitInp%WAMITULEN**4 ! Force-rotation/Moment-translation - Hydrodynamic added mass and damping + RdtnDim(4,4) = p%WaveField%WtrDens*InitInp%WAMITULEN**5 ! Moment-rotation - DffrctDim(1) = InitInp%RhoXg *InitInp%WAMITULEN**2 ! Force-translation - Hydrodynamic wave excitation force - DffrctDim(4) = InitInp%RhoXg *InitInp%WAMITULEN**3 ! Moment-rotation + DffrctDim(1) = p%WaveField%RhoXg *InitInp%WAMITULEN**2 ! Force-translation - Hydrodynamic wave excitation force + DffrctDim(4) = p%WaveField%RhoXg *InitInp%WAMITULEN**3 ! Moment-rotation DO I = 1,3 ! Loop through all force-translation elements (rows) @@ -327,7 +358,7 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init ! Linear restoring from the hydrostatics problem: CALL OpenFInpFile ( UnWh, TRIM(InitInp%WAMITFile)//'.hst', ErrStat2, ErrMsg2 ) ! Open file. - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'WAMIT_Init') + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF ( ErrStat >= AbortErrLev ) THEN CALL Cleanup() RETURN @@ -367,7 +398,7 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init ! radiation problem: CALL OpenFInpFile ( UnW1, TRIM(InitInp%WAMITFile)//'.1', ErrStat2, ErrMsg2 ) ! Open file. - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'WAMIT_Init') + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF ( ErrStat >= AbortErrLev ) THEN CALL Cleanup() RETURN @@ -412,12 +443,12 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init ! to store the frequencies and frequency-dependent hydrodynamic added mass ! and damping matrices: - CALL AllocAry( WAMITFreq, NInpFreq, 'WAMITFreq', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'WAMIT_Init') - CALL AllocAry( WAMITPer, NInpFreq, 'WAMITPer', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'WAMIT_Init') - CALL AllocAry( SortFreqInd, NInpFreq, 'SortFreqInd', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'WAMIT_Init') - CALL AllocAry( HdroFreq, NInpFreq, 'HdroFreq', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'WAMIT_Init') - CALL AllocAry( HdroAddMs, NInpFreq, 6*p%NBody, 6*p%NBody, 'HdroAddMs', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'WAMIT_Init') - CALL AllocAry( HdroDmpng, NInpFreq, 6*p%NBody, 6*p%NBody, 'HdroDmpng', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'WAMIT_Init') + CALL AllocAry( WAMITFreq, NInpFreq, 'WAMITFreq', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL AllocAry( WAMITPer, NInpFreq, 'WAMITPer', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL AllocAry( SortFreqInd, NInpFreq, 'SortFreqInd', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL AllocAry( HdroFreq, NInpFreq, 'HdroFreq', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL AllocAry( HdroAddMs, NInpFreq, 6*p%NBody, 6*p%NBody, 'HdroAddMs', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL AllocAry( HdroDmpng, NInpFreq, 6*p%NBody, 6*p%NBody, 'HdroDmpng', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF ( ErrStat >= AbortErrLev ) THEN CALL Cleanup() @@ -529,7 +560,7 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init READ (Line,*,IOSTAT=Sttus) TmpPer, I, J, TmpData1 ! Read in the period, row index, column index, and nondimensional data from the WAMIT file IF ( Sttus /= 0 ) THEN - CALL SetErrStat( ErrID_Fatal, "Error reading line from WAMIT file", ErrStat, ErrMsg, 'WAMIT_Init') + CALL SetErrStat( ErrID_Fatal, "Error reading line from WAMIT file", ErrStat, ErrMsg, RoutineName) CALL Cleanup() RETURN END IF @@ -548,7 +579,7 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init READ (Line,*,IOSTAT=Sttus) TmpPer, I, J, TmpData1, TmpData2 ! Read in the period, row index, column index, and nondimensional data from the WAMIT file IF ( Sttus /= 0 ) THEN - CALL SetErrStat( ErrID_Fatal, "Error reading line from WAMIT file", ErrStat, ErrMsg, 'WAMIT_Init') + CALL SetErrStat( ErrID_Fatal, "Error reading line from WAMIT file", ErrStat, ErrMsg, RoutineName) CALL Cleanup() RETURN END IF @@ -591,7 +622,7 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init ! problem: CALL OpenFInpFile ( UnW3, TRIM(InitInp%WAMITFile)//'.3', ErrStat2, ErrMsg2 ) ! Open file. - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'WAMIT_Init') + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF ( ErrStat >= AbortErrLev ) THEN CALL Cleanup() RETURN @@ -653,9 +684,9 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init ! to store the directions and frequency- and direction-dependent complex wave ! excitation force per unit wave amplitude vector: - CALL AllocAry( WAMITWvDir, NInpWvDir, 'WAMITWvDir', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'WAMIT_Init') - CALL AllocAry( SortWvDirInd, NInpWvDir, 'SortWvDirInd', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'WAMIT_Init') - CALL AllocAry( HdroWvDir, NInpWvDir, 'HdroWvDir', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'WAMIT_Init') + CALL AllocAry( WAMITWvDir, NInpWvDir, 'WAMITWvDir', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL AllocAry( SortWvDirInd, NInpWvDir, 'SortWvDirInd', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL AllocAry( HdroWvDir, NInpWvDir, 'HdroWvDir', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF ( ErrStat >= AbortErrLev ) THEN CALL Cleanup() RETURN @@ -663,7 +694,7 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init ALLOCATE ( HdroExctn (NInpFreq,NInpWvDir,6*p%NBody) , STAT=ErrStat2 ) ! complex so we don't have a built in subroutine IF ( ErrStat2 /= 0 ) THEN - CALL SetErrStat( ErrID_Fatal, 'Error allocating space for HdroExctn array', ErrStat, ErrMsg, 'WAMIT_Init') + CALL SetErrStat( ErrID_Fatal, 'Error allocating space for HdroExctn array', ErrStat, ErrMsg, RoutineName) CALL Cleanup() RETURN END IF @@ -692,7 +723,7 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init READ (Line,*,IOSTAT=Sttus) TmpPer, TmpDir ! Read in only the period and direction from the WAMIT file IF ( Sttus /= 0 ) THEN - CALL SetErrStat( ErrID_Fatal, 'Error reading period and direction from WAMIT file.', ErrStat, ErrMsg, 'WAMIT_Init') + CALL SetErrStat( ErrID_Fatal, 'Error reading period and direction from WAMIT file.', ErrStat, ErrMsg, RoutineName) CALL Cleanup() RETURN END IF @@ -714,7 +745,7 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init ErrMsg2 = ' Other than zero and infinite frequencies, "' //TRIM(InitInp%WAMITFile)//'.3",' // & ' contains different frequency components than "'//TRIM(InitInp%WAMITFile)//'.1". '// & ' Both WAMIT output files must be generated from the same run.' - CALL SetErrStat( ErrID_Fatal, ErrMsg2, ErrStat, ErrMsg, 'WAMIT_Init') + CALL SetErrStat( ErrID_Fatal, ErrMsg2, ErrStat, ErrMsg, RoutineName) CALL Cleanup() RETURN END IF @@ -744,7 +775,7 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init ErrMsg2 = ' Not every frequency component in "'//TRIM(InitInp%WAMITFile)//'.3"'// & ' contains the same listing of direction angles. Check for' // & ' errors in the WAMIT output file.' - CALL SetErrStat( ErrID_Fatal, ErrMsg2, ErrStat, ErrMsg, 'WAMIT_Init') + CALL SetErrStat( ErrID_Fatal, ErrMsg2, ErrStat, ErrMsg, RoutineName) CALL Cleanup() RETURN END IF @@ -787,7 +818,7 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init READ (Line,*,IOSTAT=Sttus) TmpPer, TmpDir, I, TmpData1, TmpData2, TmpRe, TmpIm ! Read in the period, direction, row index, and nondimensional data from the WAMIT file IF ( Sttus /= 0 ) THEN - CALL SetErrStat( ErrID_Fatal, 'Error reading period and direction, row index, and nondimensional data from the WAMIT file.', ErrStat, ErrMsg, 'WAMIT_Init') + CALL SetErrStat( ErrID_Fatal, 'Error reading period and direction, row index, and nondimensional data from the WAMIT file.', ErrStat, ErrMsg, RoutineName) CALL Cleanup() RETURN END IF @@ -835,11 +866,8 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init END DO ! End loop through all rows in the file - - - CLOSE ( UnW3 ) ! Close file. - end if + CLOSE ( UnW3 ) ! Close file. ! For some reason, WAMIT computes the zero- and infinite- frequency limits for ! only the added mass. Based on hydrodynamic theory, the damping is zero at @@ -879,7 +907,7 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init IF ( .NOT. ( ZeroFreq .AND. InfFreq ) ) THEN ! .TRUE. if both the zero- and infinite-frequency limits of added mass are contained within the WAMIT file ErrMsg2 = ' "'//TRIM(InitInp%WAMITFile)// & '.1" must contain both the zero- and infinite-frequency limits of added mass.' - CALL SetErrStat( ErrID_Fatal, ErrMsg2, ErrStat, ErrMsg, 'WAMIT_Init') + CALL SetErrStat( ErrID_Fatal, ErrMsg2, ErrStat, ErrMsg, RoutineName) CALL Cleanup() RETURN END IF @@ -903,60 +931,57 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init if ( ( p%ExctnMod == 0 ) ) then - ! no need to allocate the p%WaveExctn array because it won't be used + ! no need to allocate the p%WaveExctnGrid array because it won't be used else ! Initialize the variables associated with the incident wave: - SELECT CASE ( InitInp%WaveMod ) ! Which incident wave kinematics model are we using? - CASE ( 0 ) ! No waves + SELECT CASE ( p%WaveField%WaveMod ) ! Which incident wave kinematics model are we using? + + CASE ( WaveMod_None ) ! No waves, NOTE: for this case we are forcing ExctnDisp = 0 if ( p%ExctnMod == 1 ) then ! Initialize everything to zero: - - ALLOCATE ( p%WaveExctn (0:InitInp%NStepWave,6*p%NBody) , STAT=ErrStat2 ) + ALLOCATE ( p%WaveExctnGrid (0:p%WaveField%NStepWave, p%ExctnGridParams%n(2),p%ExctnGridParams%n(3),p%ExctnGridParams%n(4),6*p%NBody) , STAT=ErrStat2 ) IF ( ErrStat2 /= 0 ) THEN - CALL SetErrStat( ErrID_Fatal, 'Error allocating memory for the WaveExctn array.', ErrStat, ErrMsg, 'WAMIT_Init') + CALL SetErrStat( ErrID_Fatal, 'Error allocating memory for the WaveExctnGrid array.', ErrStat, ErrMsg, RoutineName) CALL Cleanup() RETURN END IF - p%WaveExctn = 0.0 + p%WaveExctnGrid = 0.0 else if ( p%ExctnMod == 2 ) then Interval_Sub = InitInp%Conv_Rdtn%RdtnDT SS_Exctn_InitInp%InputFile = InitInp%WAMITFile - SS_Exctn_InitInp%WaveDir = InitInp%WaveDir - SS_Exctn_InitInp%NStepWave = p%NStepWave SS_Exctn_InitInp%NBody = InitInp%NBody SS_Exctn_InitInp%PtfmRefztRot = InitInp%PtfmRefztRot - - - ! No other modules need this WaveElev0 array so we will simply move the allocation over to the SS_Exctn module - IF (ALLOCATED(InitInp%WaveElev0)) CALL MOVE_ALLOC(InitInp%WaveElev0, SS_Exctn_InitInp%WaveElev0) + SS_Exctn_InitInp%ExctnDisp = InitInp%ExctnDisp !TODO: Verify what happens within SS_Exctn when we have no waves. - - ! We need the WaveTime array to stay intact for use in other modules, so we will make a copy instead of moving the allocation - ALLOCATE ( SS_Exctn_InitInp%WaveTime (0:InitInp%NStepWave) , STAT=ErrStat2 ) - IF ( ErrStat2 /= 0 ) THEN - CALL SetErrStat( ErrID_Fatal, 'Error allocating memory for the SS_Exctn_InitInp%WaveTime array.', ErrStat, ErrMsg, 'WAMIT_Init') - CALL Cleanup() - RETURN - END IF - SS_Exctn_InitInp%WaveTime = InitInp%WaveTime + SS_Exctn_InitInp%WaveField => p%WaveField call SS_Exc_Init(SS_Exctn_InitInp, m%SS_Exctn_u, p%SS_Exctn, x%SS_Exctn, xd%SS_Exctn, z%SS_Exctn, OtherState%SS_Exctn, & m%SS_Exctn_y, m%SS_Exctn, Interval_Sub, SS_Exctn_InitOut, ErrStat2, ErrMsg2) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'WAMIT_Init') + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if ( ErrStat >= AbortErrLev ) then call Cleanup() return end if end if - CASE ( 1, 2, 3, 4, 5, 10 ) ! Plane progressive (regular) wave, JONSWAP/Pierson-Moskowitz spectrum (irregular) wave, white-noise wave, or user-defined spectrum (irregular) wave. + + CASE ( WaveMod_ExtFull ) ! User wave data. + + CALL SetErrStat( ErrID_Fatal, 'User input wave data not applicable for floating platforms.', ErrStat, ErrMsg, RoutineName) + CALL Cleanup() + RETURN + CASE DEFAULT ! remaining cases: ( 1, 2, 3, 4, 5, 7, 10 ) ! Plane progressive (regular) wave, JONSWAP/Pierson-Moskowitz spectrum (irregular) wave, white-noise wave, or user-defined spectrum (irregular) wave. + + + if ( p%ExctnMod == 1 ) then + ! Abort if we have chosen a wave heading direction that is outside the range ! of directions where the complex wave excitation force per unit wave ! amplitude vector has been defined, else interpolate to find the complex @@ -965,30 +990,72 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init ! NOTE: we may end up inadvertantly aborting if the wave direction crosses ! the -Pi / Pi boundary (-180/180 degrees). - IF ( ( InitInp%WaveDirMin < HdroWvDir(1) ) .OR. ( InitInp%WaveDirMax > HdroWvDir(NInpWvDir) ) ) THEN - ErrMsg2 = 'All Wave directions must be within the wave heading angle range available in "' & - //TRIM(InitInp%WAMITFile)//'.3" (inclusive).' - CALL SetErrStat( ErrID_Fatal, ErrMsg2, ErrStat, ErrMsg, 'WAMIT_Init') - CALL Cleanup() - RETURN - END IF + ! First do some check on the input wave heading angles + IF ( (HdroWvDir(NInpWvDir)-HdroWvDir(1)) > (360.0+WvDirTol) ) THEN + CALL SetErrStat( ErrID_Fatal,' The difference between any pair of wave directions in '//TRIM(InitInp%WAMITFile)//'.3 should be less than or equal to 360 deg.',ErrStat,ErrMsg,RoutineName) + END IF + ! The input wave headings should cover a contiguous region of directions. Check for gaps and warn user. + IF (NInpWvDir>1) THEN + AvgInpWvDirSpcg = (HdroWvDir(NInpWvDir)-HdroWvDir(1))/REAL(NInpWvDir-1,SiKi) + DO I = 2,NInpWvDir + IF ( (HdroWvDir(I)-HdroWvDir(I-1)) > (3.0*AvgInpWvDirSpcg) ) THEN + CALL SetErrStat( ErrID_Warn,'The wave headings in '//TRIM(InitInp%WAMITFile)//'.3 is likely not contiguous with a gap between '//TRIM(Num2LStr(HdroWvDir(I-1)))//' and '//TRIM(Num2LStr(HdroWvDir(I)))//' degs.', & + ErrStat, ErrMsg, RoutineName) + END IF + END DO + END IF - if ( p%ExctnMod == 1 ) then - + ! Need to account for PtfmRefZtRot if NBodyMod=2 (NBody=1 in the case) + IF ( p%NBodyMod == 2 ) THEN + RotateZdegOffset = InitInp%PtfmRefztRot(1)*R2D + ELSE + RotateZdegOffset = 0.0 + END IF + IF ( InitInp%PtfmYMod == 0 ) THEN + ! Range of allowed wave headings in the global frame + MinAllowedWvDir = HdroWvDir(1) +RotateZdegOffset+InitInp%PtfmRefY*R2D + MaxAllowedWvDir = HdroWvDir(NInpWvDir)+RotateZdegOffset+InitInp%PtfmRefY*R2D + ! For robustness, check every single incident wave direction + DO I = 0,InitInp%WaveField%NStepWave2 + IF (.NOT. GetAngleInRange(InitInp%WaveField%WaveDirArr(I),MinAllowedWvDir,MaxAllowedWvDir,unusedReal)) THEN + CALL SetErrStat( ErrID_Fatal,TRIM(InitInp%WAMITFile)//'.3 does not cover the wave heading of '//TRIM(Num2LStr(InitInp%WaveField%WaveDirArr(I)))//' deg (in the global frame).', & + ErrStat, ErrMsg, RoutineName) + CALL Cleanup() + RETURN + END IF + END DO + ELSE IF ( InitInp%PtfmYMod == 1 ) THEN + IF ( (.not. EqualRealNos( HdroWvDir(1),REAL(-180,SiKi))) .OR. (.not. EqualRealNos( HdroWvDir(NInpWvDir),REAL(180,SiKi))) ) THEN + ErrMsg2 = 'With PtfmYMod=1, we need the lowest and highest wave headings to be exactly -180 deg and 180 deg, respectively, in "' & + //TRIM(InitInp%WAMITFile)//'.3" (inclusive).' + CALL SetErrStat( ErrID_Fatal, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL Cleanup() + RETURN + END IF + END IF ! Calculate the WaveExctn data from WAMIT data if ExctnMod = 1 ! ALLOCATE the arrays: - ALLOCATE ( WaveExctnC(0:InitInp%NStepWave2 ,6*p%NBody) , STAT=ErrStat2 ) + ALLOCATE ( WaveExctnC(0:p%WaveField%NStepWave2,p%NExctnHdg+1,6*p%NBody) , STAT=ErrStat2 ) IF ( ErrStat2 /= 0 ) THEN - CALL SetErrStat( ErrID_Fatal, 'Error allocating memory for the WaveExctnC array.', ErrStat, ErrMsg, 'WAMIT_Init') + CALL SetErrStat( ErrID_Fatal, 'Error allocating memory for the WaveExctnC array.', ErrStat, ErrMsg, RoutineName) CALL Cleanup() RETURN END IF - ALLOCATE ( p%WaveExctn (0:InitInp%NStepWave,6*p%NBody) , STAT=ErrStat2 ) + if (p%ExctnDisp > 0 ) then + ALLOCATE ( WaveExctnCGrid (0:p%WaveField%NStepWave2,p%ExctnGridParams%n(2)*p%ExctnGridParams%n(3),p%ExctnGridParams%n(4),6*p%NBody) , STAT=ErrStat2 ) + IF ( ErrStat2 /= 0 ) THEN + CALL SetErrStat( ErrID_Fatal, 'Error allocating memory for the WaveExctnCGrid array.', ErrStat, ErrMsg, RoutineName) + CALL Cleanup() + RETURN + END IF + end if + + ALLOCATE ( p%WaveExctnGrid (0:p%WaveField%NStepWave, p%ExctnGridParams%n(2),p%ExctnGridParams%n(3),p%ExctnGridParams%n(4),6*p%NBody) , STAT=ErrStat2 ) IF ( ErrStat2 /= 0 ) THEN - CALL SetErrStat( ErrID_Fatal, 'Error allocating memory for the WaveExctn array.', ErrStat, ErrMsg, 'WAMIT_Init') + CALL SetErrStat( ErrID_Fatal, 'Error allocating memory for the WaveExctnGrid array.', ErrStat, ErrMsg, RoutineName) CALL Cleanup() RETURN END IF @@ -1000,46 +1067,35 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init if ( p%NBodyMod == 2 ) then ! Since NBodyMod = 2, then NBody = 1 for this WAMIT object (this requirement is encoded at the HydroDyn module level) - - allocate ( HdroExctn_Local(NInpFreq, NInpWvDir, 6), STAT=ErrStat2 ) - IF ( ErrStat2 /= 0 ) THEN - CALL SetErrStat( ErrID_Fatal, 'Error allocating memory for the HdroExctn_Local array.', ErrStat, ErrMsg, 'WAMIT_Init') - CALL Cleanup() - RETURN - END IF - - do K = 1,6 ! Loop through all wave excitation forces and moments - do J = 1, NInpWvDir - TmpCoord(2) = HdroWvDir(J) - InitInp%PtfmRefztRot(1)*R2D ! apply locale Z rotation to heading angle (degrees) - do I = 1, NInpFreq - TmpCoord(1) = HdroFreq(I) - ! Iterpolate to find new coef - call WAMIT_Interp2D_Cplx( TmpCoord, HdroExctn(:,:,K), HdroFreq, HdroWvDir, LastInd2, HdroExctn_Local(I,J,K), ErrStat2, ErrMsg2 ) - end do - end do - end do - - ! Now apply rotation and phase shift + ! HdroWvDir from WAMIT is effectively in the body-local coordinate system. Need to offset HdroWvDir to be back in the global frame + HdroWvDir = HdroWvDir + InitInp%PtfmRefztRot(1)*R2D + ! Now apply rotation and phase shift do J = 1, NInpWvDir do I = 1, NInpFreq - ! Fxy = exp(-j * k(w) * ( X*cos(Beta(w)) + Y*sin(Beta(w)) ) - WaveNmbr = WaveNumber ( HdroFreq(I), InitInp%Gravity, InitInp%WtrDpth ) + ! Fxy = exp(-j * k(w) * ( X*cos(Beta(w)) + Y*sin(Beta(w)) ) + WaveNmbr = WaveNumber ( HdroFreq(I), InitInp%Gravity, p%WaveField%EffWtrDpth ) tmpAngle = WaveNmbr * ( InitInp%PtfmRefxt(1)*cos(HdroWvDir(J)*D2R) + InitInp%PtfmRefyt(1)*sin(HdroWvDir(J)*D2R) ) TmpRe = cos(tmpAngle) TmpIm = -sin(tmpAngle) Fxy = CMPLX( TmpRe, TmpIm ) - HdroExctn(I,J,1) = Fxy*( HdroExctn_Local(I,J,1)*cos(InitInp%PtfmRefztRot(1)) - HdroExctn_Local(I,J,2)*sin(InitInp%PtfmRefztRot(1)) ) - HdroExctn(I,J,2) = Fxy*( HdroExctn_Local(I,J,1)*sin(InitInp%PtfmRefztRot(1)) + HdroExctn_Local(I,J,2)*cos(InitInp%PtfmRefztRot(1)) ) - HdroExctn(I,J,3) = Fxy*( HdroExctn_Local(I,J,3) ) - HdroExctn(I,J,4) = Fxy*( HdroExctn_Local(I,J,4)*cos(InitInp%PtfmRefztRot(1)) - HdroExctn_Local(I,J,5)*sin(InitInp%PtfmRefztRot(1)) ) - HdroExctn(I,J,5) = Fxy*( HdroExctn_Local(I,J,4)*sin(InitInp%PtfmRefztRot(1)) + HdroExctn_Local(I,J,5)*cos(InitInp%PtfmRefztRot(1)) ) - HdroExctn(I,J,6) = Fxy*( HdroExctn_Local(I,J,6) ) + Ctmp1 = Fxy*( HdroExctn(I,J,1)*cos(InitInp%PtfmRefztRot(1)) - HdroExctn(I,J,2)*sin(InitInp%PtfmRefztRot(1)) ) + Ctmp2 = Fxy*( HdroExctn(I,J,1)*sin(InitInp%PtfmRefztRot(1)) + HdroExctn(I,J,2)*cos(InitInp%PtfmRefztRot(1)) ) + Ctmp4 = Fxy*( HdroExctn(I,J,4)*cos(InitInp%PtfmRefztRot(1)) - HdroExctn(I,J,5)*sin(InitInp%PtfmRefztRot(1)) ) + Ctmp5 = Fxy*( HdroExctn(I,J,4)*sin(InitInp%PtfmRefztRot(1)) + HdroExctn(I,J,5)*cos(InitInp%PtfmRefztRot(1)) ) + + HdroExctn(I,J,1) = Ctmp1 + HdroExctn(I,J,2) = Ctmp2 + HdroExctn(I,J,4) = Ctmp4 + HdroExctn(I,J,5) = Ctmp5 + + HdroExctn(I,J,3) = Fxy*( HdroExctn(I,J,3) ) + HdroExctn(I,J,6) = Fxy*( HdroExctn(I,J,6) ) end do end do - deallocate(HdroExctn_Local) + else ! Apply rotation only for NBodyMod = 1,3 @@ -1059,191 +1115,282 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init end do end if - + + if (p%ExctnDisp == 0 ) then ! Compute the positive-frequency components (including zero) of the discrete ! Fourier transform of the wave excitation force: - DO I = 0,InitInp%NStepWave2 ! Loop through the positive frequency components (including zero) of the discrete Fourier transform + DO I = 0,p%WaveField%NStepWave2 ! Loop through the positive frequency components (including zero) of the discrete Fourier transform - ! Compute the frequency of this component: - - Omega = I*InitInp%WaveDOmega - + ! Compute the frequency of this component: + Omega = I*p%WaveField%WaveDOmega + + DO iHdg = 1,p%NExctnHdg+1 + ! Compute the PRP heading angle + IF (p%PtfmYMod .EQ. 0) THEN + PRPHdg = InitInp%PtfmRefY + ELSE IF (p%PtfmYMod .EQ. 1) THEN + PRPHdg = -PI + (iHdg-1) * TwoPi/REAL(p%NExctnHdg,ReKi) + END IF ! Compute the discrete Fourier transform of the instantaneous value of the ! total excitation force on the support platfrom from incident waves: - + DO J = 1,6*p%NBody ! Loop through all wave excitation forces and moments + TmpCoord(1) = Omega + TmpCoord(2) = p%WaveField%WaveDirArr(I) - PRPHdg*R2D + dirInRange = GetAngleInRange(TmpCoord(2),HdroWvDir(1),HdroWvDir(NInpWvDir),tmpDir2); TmpCoord(2) = tmpDir2 + IF (.NOT. dirInRange) THEN ! Somewhat redundant check. Can be removed in the future. + CALL SetErrStat(ErrID_Fatal,' Wave heading out of range.', ErrStat, ErrMsg, RoutineName) + END IF + CALL WAMIT_Interp2D_Cplx( TmpCoord, HdroExctn(:,:,J), HdroFreq, HdroWvDir, LastInd2, WaveExctnC(I,iHdg,J), ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF ( ErrStat >= AbortErrLev ) THEN + CALL Cleanup() + RETURN + END IF + WaveExctnC(I,iHdg,J) = WaveExctnC(I,iHdg,J) * CMPLX(p%WaveField%WaveElevC0(1,I), p%WaveField%WaveElevC0(2,I)) + END DO ! J - All wave excitation forces and moments + END DO ! iHdg - All PRP heading + END DO ! I - The positive frequency components (including zero) of the discrete Fourier transform + ! Compute the inverse discrete Fourier transform to find the time-domain + ! representation of the wave excitation force: + CALL InitFFT ( p%WaveField%NStepWave, FFT_Data, .TRUE., ErrStat2 ) + CALL SetErrStat( ErrStat2, 'Error in call to InitFFT.', ErrStat, ErrMsg, RoutineName) + IF ( ErrStat >= AbortErrLev) THEN + CALL Cleanup() + RETURN + END IF + DO iHdg = 1,p%NExctnHdg+1 DO J = 1,6*p%NBody ! Loop through all wave excitation forces and moments - TmpCoord(1) = Omega - TmpCoord(2) = InitInp%WaveDirArr(I) - CALL WAMIT_Interp2D_Cplx( TmpCoord, HdroExctn(:,:,J), HdroFreq, HdroWvDir, LastInd2, WaveExctnC(I,J), ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'WAMIT_Init') - IF ( ErrStat >= AbortErrLev ) THEN + CALL ApplyFFT_cx ( p%WaveExctnGrid(0:p%WaveField%NStepWave-1,1_IntKi,1_IntKi,iHdg,J), WaveExctnC(:,iHdg,J), FFT_Data, ErrStat2 ) + CALL SetErrStat( ErrStat2, ' An error occured while applying an FFT to WaveExctnC.', ErrStat, ErrMsg, RoutineName) + IF ( ErrStat >= AbortErrLev) THEN CALL Cleanup() RETURN END IF - WaveExctnC(I,J) = WaveExctnC(I,J) * CMPLX(InitInp%WaveElevC0(1,I), InitInp%WaveElevC0(2,I)) + + ! Append first datpoint as the last as aid for repeated wave data + p%WaveExctnGrid(p%WaveField%NStepWave,1_IntKi,1_IntKi,iHdg,J) = p%WaveExctnGrid(0,1_IntKi,1_IntKi,iHdg,J) END DO ! J - All wave excitation forces and moments + END DO ! iHdg - All PRP headings + CALL ExitFFT(FFT_Data, ErrStat2) + CALL SetErrStat( ErrStat2, 'Error in call to ExitFFT.', ErrStat, ErrMsg, RoutineName) + IF ( ErrStat >= AbortErrLev) THEN + CALL Cleanup() + RETURN + END IF - END DO ! I - The positive frequency components (including zero) of the discrete Fourier transform - - + DO iHdg = 1,p%NExctnHdg+1 + ! Compute the PRP heading angle + IF (p%PtfmYMod .EQ. 0) THEN + PRPHdg = InitInp%PtfmRefY + ELSE IF (p%PtfmYMod .EQ. 1) THEN + PRPHdg = -PI + (iHdg-1) * TwoPi/REAL(p%NExctnHdg,ReKi) + END IF + DO J = 0,p%WaveField%NStepWave + DO iBdy = 1,p%NBody + call hiFrameTransform(h2i,PRPHdg,p%WaveExctnGrid(J,1_IntKi,1_IntKi,iHdg,(6*(iBdy-1)+1):(6*(iBdy-1)+3)),tmpVec3,ErrStat2,ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + p%WaveExctnGrid(J,1_IntKi,1_IntKi,iHdg,(6*(iBdy-1)+1):(6*(iBdy-1)+3)) = tmpVec3 + call hiFrameTransform(h2i,PRPHdg,p%WaveExctnGrid(J,1_IntKi,1_IntKi,iHdg,(6*(iBdy-1)+4):(6*(iBdy-1)+6)),tmpVec3,ErrStat2,ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + p%WaveExctnGrid(J,1_IntKi,1_IntKi,iHdg,(6*(iBdy-1)+4):(6*(iBdy-1)+6)) = tmpVec3 + END DO + END DO + END DO + else ! p%ExctnDisp > 0 + DO I = 0,p%WaveField%NStepWave2 ! Loop through the positive frequency components (including zero) of the discrete Fourier transform + + ! Compute the frequency of this component: + Omega = I*p%WaveField%WaveDOmega + + DO iHdg = 1,p%ExctnGridParams%n(4) + ! Compute the current PRP heading + IF (p%PtfmYMod .EQ. 0) THEN + PRPHdg = InitInp%PtfmRefY + ELSE IF (p%PtfmYMod .EQ. 1) THEN + PRPHdg = -PI + (iHdg-1) * TwoPi/REAL(p%NExctnHdg,ReKi) + END IF + ! Compute the discrete Fourier transform of the instantaneous value of the + ! total excitation force on the support platfrom from incident waves: + DO J = 1,6*p%NBody ! Loop through all wave excitation forces and moments + TmpCoord(1) = Omega + TmpCoord(2) = p%WaveField%WaveDirArr(I) - PRPHdg*R2D + dirInRange = GetAngleInRange(TmpCoord(2),HdroWvDir(1),HdroWvDir(NInpWvDir),tmpDir2); TmpCoord(2) = tmpDir2 + IF (.NOT. dirInRange) THEN ! Somewhat redundant check. Can be removed in the future. + CALL SetErrStat(ErrID_Fatal,' Wave heading out of range.', ErrStat, ErrMsg, RoutineName) + END IF + CALL WAMIT_Interp2D_Cplx( TmpCoord, HdroExctn(:,:,J), HdroFreq, HdroWvDir, LastInd2, WaveExctnC(I,iHdg,J), ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF ( ErrStat >= AbortErrLev ) THEN + CALL Cleanup() + RETURN + END IF + do iGrid = 1, p%ExctnGridParams%n(2)*p%ExctnGridParams%n(3) + WaveExctnCGrid(I,iGrid,iHdg,J) = WaveExctnC(I,iHdg,J) * CMPLX(p%WaveField%WaveElevC(1,I,iGrid), p%WaveField%WaveElevC(2,I,iGrid)) + end do + END DO ! J - All wave excitation forces and moments + END DO ! iHdg - All PRP headings + END DO ! I - The positive frequency components (including zero) of the discrete Fourier transform - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! Dump the HdroFreq variable to a file for debugging - ! Open and write header info to the HydroDyn Output File - !CALL OpenFOutFile ( 66, 'C:\Dev\NREL_SVN\HydroDyn\branches\HydroDyn_Modularization\Samples\NRELOffshrBsline5MW_OC3Hywind\HdroFreq_HD.txt', ErrStat ) ! Open motion file. - !DO K = 1, NInpFreq - ! WRITE ( 66, '(2(e20.9))', IOSTAT = ErrStat) REAL(K), HdroFreq(K) - !END DO - !CLOSE ( 66 ) - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! Dump the WaveElevCO variable to a file for debugging - ! Open and write header info to the HydroDyn Output File - !CALL OpenFOutFile ( 66, 'C:\Dev\NREL_SVN\HydroDyn\branches\HydroDyn_Modularization\Samples\NRELOffshrBsline5MW_OC3Hywind\WaveElevC0_HD.txt', ErrStat ) ! Open motion file. - !DO K = 0, InitInp%NStepWave2 - ! WRITE ( 66, '(2(e20.9))', IOSTAT = ErrStat) REAL(K), REAL(InitInp%WaveElevC0(K)) - !END DO - !CLOSE ( 66 ) - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! Dump the WaveExctnC variable to a file for debugging - ! Open and write header info to the HydroDyn Output File - !CALL OpenFOutFile ( 66, 'C:\Dev\NREL_SVN\HydroDyn\branches\HydroDyn_Modularization\Samples\NRELOffshrBsline5MW_OC3Hywind\WaveExctnC_HD.txt', ErrStat ) ! Open motion file. - !DO K = 0, InitInp%NStepWave2 - ! WRITE ( 66, '(7(e20.9))', IOSTAT = ErrStat) REAL(K), REAL(WaveExctnC(K,:)) - !END DO - !CLOSE ( 66 ) - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - ! Compute the inverse discrete Fourier transform to find the time-domain + ! Compute the inverse discrete Fourier transform to find the time-domain ! representation of the wave excitation force: - CALL InitFFT ( InitInp%NStepWave, FFT_Data, .TRUE., ErrStat2 ) - CALL SetErrStat( ErrStat2, 'Error in call to InitFFT.', ErrStat, ErrMsg, 'WAMIT_Init') + CALL InitFFT ( p%WaveField%NStepWave, FFT_Data, .TRUE., ErrStat2 ) + CALL SetErrStat( ErrStat2, 'Error in call to InitFFT.', ErrStat, ErrMsg, RoutineName) IF ( ErrStat >= AbortErrLev) THEN CALL Cleanup() RETURN END IF - DO J = 1,6*p%NBody ! Loop through all wave excitation forces and moments - CALL ApplyFFT_cx ( p%WaveExctn(0:InitInp%NStepWave-1,J), WaveExctnC(:,J), FFT_Data, ErrStat2 ) - CALL SetErrStat( ErrStat2, ' An error occured while applying an FFT to WaveExctnC.', ErrStat, ErrMsg, 'WAMIT_Init') - IF ( ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF - - ! Append first datpoint as the last as aid for repeated wave data - p%WaveExctn(InitInp%NStepWave,J) = p%WaveExctn(0,J) - END DO ! J - All wave excitation forces and moments + DO iHdg = 1,p%ExctnGridParams%n(4) + DO iGrid = 1, p%ExctnGridParams%n(2)*p%ExctnGridParams%n(3) + iX = mod(iGrid-1, p%ExctnGridParams%n(2)) + 1 ! 1st n index is time + iY = (iGrid-1) / p%ExctnGridParams%n(2) + 1 + DO J = 1,6*p%NBody ! Loop through all wave excitation forces and moments + CALL ApplyFFT_cx ( p%WaveExctnGrid(0:p%WaveField%NStepWave-1,iX,iY,iHdg,J), WaveExctnCGrid(:,iGrid,iHdg,J), FFT_Data, ErrStat2 ) + CALL SetErrStat( ErrStat2, ' An error occured while applying an FFT to WaveExctnC.', ErrStat, ErrMsg, RoutineName) + IF ( ErrStat >= AbortErrLev) THEN + CALL Cleanup() + RETURN + END IF + ! Append first datpoint as the last as aid for repeated wave data + p%WaveExctnGrid(p%WaveField%NStepWave,iX,iY,iHdg,J) = p%WaveExctnGrid(0,iX,iY,iHdg,J) + END DO ! J - All wave excitation forces and moments + END DO ! iGrid - All wave grid points + END DO ! iHdg - All wave heading CALL ExitFFT(FFT_Data, ErrStat2) - CALL SetErrStat( ErrStat2, 'Error in call to ExitFFT.', ErrStat, ErrMsg, 'WAMIT_Init') + CALL SetErrStat( ErrStat2, 'Error in call to ExitFFT.', ErrStat, ErrMsg, RoutineName) IF ( ErrStat >= AbortErrLev) THEN CALL Cleanup() RETURN END IF + + DO iHdg = 1,p%ExctnGridParams%n(4) + ! Compute the PRP heading angle + IF (p%PtfmYMod .EQ. 0) THEN + PRPHdg = InitInp%PtfmRefY + ELSE IF (p%PtfmYMod .EQ. 1) THEN + PRPHdg = -PI + (iHdg-1) * TwoPi/REAL(p%NExctnHdg,ReKi) + END IF + DO iGrid = 1, p%ExctnGridParams%n(2)*p%ExctnGridParams%n(3) + iX = mod(iGrid-1, p%ExctnGridParams%n(2)) + 1 ! 1st n index is time + iY = (iGrid-1) / p%ExctnGridParams%n(2) + 1 + DO J = 0,p%WaveField%NStepWave + DO iBdy = 1,p%NBody + call hiFrameTransform(h2i,PRPHdg,p%WaveExctnGrid(J,iX,iY,iHdg,(6*(iBdy-1)+1):(6*(iBdy-1)+3)),tmpVec3,ErrStat2,ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + p%WaveExctnGrid(J,iX,iY,iHdg,(6*(iBdy-1)+1):(6*(iBdy-1)+3)) = tmpVec3 + call hiFrameTransform(h2i,PRPHdg,p%WaveExctnGrid(J,iX,iY,iHdg,(6*(iBdy-1)+4):(6*(iBdy-1)+6)),tmpVec3,ErrStat2,ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + p%WaveExctnGrid(J,iX,iY,iHdg,(6*(iBdy-1)+4):(6*(iBdy-1)+6)) = tmpVec3 + END DO + END DO + END DO + END DO + + end if + + else if ( p%ExctnMod == 2 ) then Interval_Sub = InitInp%Conv_Rdtn%RdtnDT SS_Exctn_InitInp%InputFile = InitInp%WAMITFile - SS_Exctn_InitInp%WaveDir = InitInp%WaveDir - SS_Exctn_InitInp%NStepWave = p%NStepWave SS_Exctn_InitInp%NBody = InitInp%NBody SS_Exctn_InitInp%PtfmRefztRot = InitInp%PtfmRefztRot + SS_Exctn_InitInp%ExctnDisp = InitInp%ExctnDisp + + SS_Exctn_InitInp%WaveField => p%WaveField + + ! We have been passed a pointer to WaveElev0 for use by the State Space excitation module. + ! If the special case shown below is not used, then the state space model simply uses WaveElev0, as is. + ! however, if we are using the special case, then WaveElev0 will be modified. This is okay, because no one else + ! is using WaveElev0 data + if (p%ExctnDisp == 0 ) then + if (allocated(SS_Exctn_InitInp%WaveField%WaveElev0)) then !NOTE THIS OVERWRITES THE WAVEFIELD WaveElev0 data - - - - if (allocated(InitInp%WaveElev0)) then - - ! No other modules need this WaveElev0 array so we will simply move the allocation over to the SS_Exctn module - call MOVE_ALLOC(InitInp%WaveElev0, SS_Exctn_InitInp%WaveElev0) - - - ! Handle special case when NBodyMod=2 and (PtfmRefxt /= 0 or PtfmRefyt /= 0) : Need to phase shift the wave elevation data for the offset body - if ( p%NBodyMod==2 .and. (InitInp%PtfmRefxt(1) /= 0 .or. InitInp%PtfmRefyt(1) /= 0) ) then + ! Handle special case when NBodyMod=2 and (PtfmRefxt /= 0 or PtfmRefyt /= 0) : Need to phase shift the wave elevation data for the offset body + if ( p%NBodyMod==2 .and. (InitInp%PtfmRefxt(1) /= 0 .or. InitInp%PtfmRefyt(1) /= 0) ) then - ! Need to start with the DFT of the Wave Elevation data at the Platform reference point: InitInp%WaveElevC0 + ! Need to start with the DFT of the Wave Elevation data at the Platform reference point: InitInp%WaveElevC0 - ! Now apply the phase shift in the frequency space + ! Now apply the phase shift in the frequency space - do J = 1, NInpWvDir - do I = 0,InitInp%NStepWave2 ! Loop through the positive frequency components (including zero) of the discrete Fourier transform + do I = 0,p%WaveField%NStepWave2 ! Loop through the positive frequency components (including zero) of the discrete Fourier transform - ! Compute the frequency of this component: - - Omega = I*InitInp%WaveDOmega - ! Fxy = exp(-j * k(w) * ( X*cos(Beta(w)) + Y*sin(Beta(w)) ) - WaveNmbr = WaveNumber ( Omega, InitInp%Gravity, InitInp%WtrDpth ) - tmpAngle = WaveNmbr * ( InitInp%PtfmRefxt(1)*cos(HdroWvDir(J)*D2R) + InitInp%PtfmRefyt(1)*sin(HdroWvDir(J)*D2R) ) + ! Compute the phase shift of this component, Fxy = exp(-j * k(w) * ( X*cos(Beta(w)) + Y*sin(Beta(w)) ): + Omega = I*p%WaveField%WaveDOmega + WaveNmbr = WaveNumber ( Omega, InitInp%Gravity, p%WaveField%EffWtrDpth ) + tmpAngle = WaveNmbr * ( InitInp%PtfmRefxt(1)*cos(p%WaveField%WaveDirArr(I)*D2R) + InitInp%PtfmRefyt(1)*sin(p%WaveField%WaveDirArr(I)*D2R) ) TmpRe = cos(tmpAngle) TmpIm = -sin(tmpAngle) Fxy = CMPLX( TmpRe, TmpIm ) - tmpComplexArr(I) = Fxy*CMPLX(InitInp%WaveElevC0(1,I), InitInp%WaveElevC0(2,I)) - - - end do - end do + ! Apply phase shift + tmpComplexArr(I) = Fxy*CMPLX(p%WaveField%WaveElevC0(1,I), p%WaveField%WaveElevC0(2,I)) + end do - ! Compute the inverse discrete Fourier transforms to find the time-domain - ! representations of the wave kinematics without stretcing: + ! Compute the inverse discrete Fourier transforms to find the time-domain + ! representations of the wave kinematics without stretching: - CALL InitFFT ( InitInp%NStepWave, FFT_Data, .TRUE., ErrStat2 ) - CALL SetErrStat(ErrStat2,'Error occured while initializing the FFT.',ErrStat,ErrMsg,'WAMIT_Init') - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp() - RETURN - END IF + CALL InitFFT ( p%WaveField%NStepWave, FFT_Data, .TRUE., ErrStat2 ) + CALL SetErrStat(ErrStat2,'Error occured while initializing the FFT.',ErrStat,ErrMsg,RoutineName) + IF ( ErrStat >= AbortErrLev ) THEN + CALL CleanUp() + RETURN + END IF - ! We'll need the following for wave stretching once we implement it. - CALL ApplyFFT_cx ( SS_Exctn_InitInp%WaveElev0(0:InitInp%NStepWave-1), tmpComplexArr(: ), FFT_Data, ErrStat2 ) - CALL SetErrStat(ErrStat2,'Error occured while applying the FFT to WaveElev0.',ErrStat,ErrMsg,'WAMIT_Init') - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp() - RETURN - END IF - - CALL ExitFFT(FFT_Data, ErrStat2) - CALL SetErrStat( ErrStat2, 'Error in call to ExitFFT.', ErrStat, ErrMsg, 'WAMIT_Init') - IF ( ErrStat >= AbortErrLev) THEN - CALL Cleanup() + ! We'll need the following for wave stretching once we implement it. + ! NOTE THIS IS OVERWRITING THE WAVEFIELD WaveElev0 PARAMETER DATA + CALL ApplyFFT_cx ( SS_Exctn_InitInp%WaveField%WaveElev0(0:p%WaveField%NStepWave-1), tmpComplexArr(: ), FFT_Data, ErrStat2 ) + CALL SetErrStat(ErrStat2,'Error occured while applying the FFT to WaveElev0.',ErrStat,ErrMsg,RoutineName) + IF ( ErrStat >= AbortErrLev ) THEN + CALL CleanUp() RETURN END IF - - end if - ! We need the WaveTime array to stay intact for use in other modules, so we will make a copy instead of moving the allocation - ALLOCATE ( SS_Exctn_InitInp%WaveTime (0:InitInp%NStepWave) , STAT=ErrStat2 ) - IF ( ErrStat2 /= 0 ) THEN - CALL SetErrStat( ErrID_Fatal, 'Error allocating memory for the SS_Exctn_InitInp%WaveTime array.', ErrStat, ErrMsg, 'WAMIT_Init') - CALL Cleanup() - RETURN - END IF - SS_Exctn_InitInp%WaveTime = InitInp%WaveTime + CALL ExitFFT(FFT_Data, ErrStat2) + CALL SetErrStat( ErrStat2, 'Error in call to ExitFFT.', ErrStat, ErrMsg, RoutineName) + IF ( ErrStat >= AbortErrLev) THEN + CALL Cleanup() + RETURN + END IF + + end if + else + !TODO: Error message because we need WaveElev0 for ExctnDisp=0 + call SetErrStat( ErrID_Severe, 'SS Excitation does not contain WaveElev0 data.', ErrStat, ErrMsg, RoutineName ) + end if end if + call SS_Exc_Init(SS_Exctn_InitInp, m%SS_Exctn_u, p%SS_Exctn, x%SS_Exctn, xd%SS_Exctn, z%SS_Exctn, OtherState%SS_Exctn, & m%SS_Exctn_y, m%SS_Exctn, Interval_Sub, SS_Exctn_InitOut, ErrStat2, ErrMsg2) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'WAMIT_Init') + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if ( ErrStat >= AbortErrLev ) then call Cleanup() return end if end if - CASE ( 6 ) ! User wave data. - - CALL SetErrStat( ErrID_Fatal, 'User input wave data not applicable for floating platforms.', ErrStat, ErrMsg, 'WAMIT_Init') - CALL Cleanup() - RETURN + IF ( (p%ExctnMod>0) .AND. (p%ExctnDisp==2) ) THEN ! Allocate and initialize array for filtered potential-flow body positions + p%ExctnFiltConst = exp(-2.0*Pi*p%ExctnCutOff * Interval) + ALLOCATE ( xd%BdyPosFilt(1:2, 1:p%NBody, 1:3) , STAT=ErrStat2 ) + IF ( ErrStat2 /= 0 ) THEN + CALL SetErrStat( ErrID_Fatal, 'Error allocating memory for the BdyPosFilt array.', ErrStat, ErrMsg, RoutineName) + CALL Cleanup() + RETURN + END IF + orientation = EulerConstructZYX(InitInp%PlatformPos(4:6)); + DO iBdy = 1,p%NBody + ! Initial WAMIT body position + BdyPos0 = InitInp%PlatformPos(1:3) & + + matmul((/InitInp%PtfmRefxt(iBdy),InitInp%PtfmRefyt(iBdy),InitInp%PtfmRefzt(iBdy)/),orientation) & + - (/InitInp%PtfmRefxt(iBdy),InitInp%PtfmRefyt(iBdy),InitInp%PtfmRefzt(iBdy)/) + DO iStp = 1,3 + xd%BdyPosFilt(1:2,iBdy,iStp) = BdyPos0(1:2) + END DO + END DO + END IF ENDSELECT end if @@ -1258,26 +1405,29 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init if ( InitInp%RdtnMod == 1 ) THEN + ! this check used to occur with equivalent variables after calling Conv_Rdtn_Init + if (.not. EqualRealNos( InitInp%Conv_Rdtn%RdtnDT, Interval) ) then + call SetErrStat(ErrID_Fatal,'RdtnDT must be the same as the HD time step', ErrStat, ErrMsg, RoutineName) + call Cleanup() + return + end if + ! Set Initialization data for the Conv_Rdtn submodule - ! Would be nice if there were a copy InitInput function in the *_Types file - ! BJJ 6/25/2014: There is a copy InitInput function.... ??? - CALL MOVE_ALLOC( HdroFreq, Conv_Rdtn_InitInp%HdroFreq ) CALL MOVE_ALLOC( HdroAddMs, Conv_Rdtn_InitInp%HdroAddMs ) CALL MOVE_ALLOC( HdroDmpng, Conv_Rdtn_InitInp%HdroDmpng ) - Conv_Rdtn_InitInp%NBody = InitInp%NBody + Conv_Rdtn_InitInp%NBody = InitInp%NBody Conv_Rdtn_InitInp%RdtnTMax = InitInp%RdtnTMax - Conv_Rdtn_InitInp%RdtnDT = InitInp%Conv_Rdtn%RdtnDT - Conv_Rdtn_InitInp%HighFreq = HighFreq - Conv_Rdtn_InitInp%WAMITFile = InitInp%WAMITFile - Conv_Rdtn_InitInp%NInpFreq = NInpFreq - Conv_Rdtn_InitInp%UnSum = InitInp%Conv_Rdtn%UnSum + Conv_Rdtn_InitInp%RdtnDT = InitInp%Conv_Rdtn%RdtnDT + Conv_Rdtn_InitInp%HighFreq = HighFreq + Conv_Rdtn_InitInp%WAMITFile = InitInp%WAMITFile + Conv_Rdtn_InitInp%NInpFreq = NInpFreq CALL Conv_Rdtn_Init(Conv_Rdtn_InitInp, m%Conv_Rdtn_u, p%Conv_Rdtn, x%Conv_Rdtn, xd%Conv_Rdtn, z%Conv_Rdtn, OtherState%Conv_Rdtn, & - m%Conv_Rdtn_y, m%Conv_Rdtn, Interval, Conv_Rdtn_InitOut, ErrStat2, ErrMsg2) + m%Conv_Rdtn_y, m%Conv_Rdtn, Conv_Rdtn_InitOut, ErrStat2, ErrMsg2) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'WAMIT_Init') + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF ( ErrStat >= AbortErrLev ) THEN CALL Cleanup() RETURN @@ -1289,7 +1439,7 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init SS_Rdtn_InitInp%InputFile = InitInp%WAMITFile - call AllocAry(SS_Rdtn_InitInp%enabledDOFs, 6*p%NBody, 'SS_Rdtn_InitInp%enabledDOFs', ErrStat2, ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'WAMIT_Init') + call AllocAry(SS_Rdtn_InitInp%enabledDOFs, 6*p%NBody, 'SS_Rdtn_InitInp%enabledDOFs', ErrStat2, ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) IF ( ErrStat >= AbortErrLev ) THEN CALL Cleanup() RETURN @@ -1297,7 +1447,7 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init SS_Rdtn_InitInp%enabledDOFs = 1 ! Set to 1 (True) for all DOFs, meaning each DOF is to be used in the analysis. Interval_Sub = InitInp%Conv_Rdtn%RdtnDT SS_Rdtn_InitInp%NBody = InitInp%NBody - call AllocAry(SS_Rdtn_InitInp%PtfmRefztRot, p%NBody, 'SS_Rdtn_InitInp%PtfmRefztRot', ErrStat2, ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'WAMIT_Init') + call AllocAry(SS_Rdtn_InitInp%PtfmRefztRot, p%NBody, 'SS_Rdtn_InitInp%PtfmRefztRot', ErrStat2, ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) IF ( ErrStat >= AbortErrLev ) THEN CALL Cleanup() RETURN @@ -1306,7 +1456,7 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init CALL SS_Rad_Init(SS_Rdtn_InitInp, m%SS_Rdtn_u, p%SS_Rdtn, x%SS_Rdtn, xd%SS_Rdtn, z%SS_Rdtn, OtherState%SS_Rdtn, & m%SS_Rdtn_y, m%SS_Rdtn, Interval_Sub, SS_Rdtn_InitOut, ErrStat2, ErrMsg2) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'WAMIT_Init') + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF ( ErrStat >= AbortErrLev ) THEN CALL Cleanup() RETURN @@ -1354,7 +1504,7 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init ,TranslationAcc = .TRUE. & ,RotationAcc = .TRUE.) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'WAMIT_Init') + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF ( ErrStat >= AbortErrLev ) THEN CALL Cleanup() RETURN @@ -1375,7 +1525,7 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init , ErrMsg2 & , orientation ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'WAMIT_Init') + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ! Create the mesh element @@ -1385,14 +1535,14 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init , ErrMsg2 & , iBody & ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'WAMIT_Init') + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do CALL MeshCommit ( u%Mesh & , ErrStat2 & , ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'WAMIT_Init') + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF ( ErrStat >= AbortErrLev ) THEN CALL Cleanup() RETURN @@ -1407,7 +1557,7 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init ,Force = .TRUE. & ,Moment = .TRUE. ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'WAMIT_Init') + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF ( ErrStat >= AbortErrLev ) THEN CALL Cleanup() RETURN @@ -1439,8 +1589,8 @@ SUBROUTINE Cleanup() CALL SS_Rad_DestroyInitInput( SS_Rdtn_InitInp, ErrStat2, ErrMsg2 ) CALL SS_Rad_DestroyInitOutput( SS_Rdtn_InitOut, ErrStat2, ErrMsg2 ) - CALL SS_Exc_DestroyInitInput( SS_Exctn_InitInp, ErrStat2, ErrMsg2 ) - CALL SS_Exc_DestroyInitOutput( SS_Exctn_InitOut, ErrStat2, ErrMsg2 ) + CALL SS_Exc_DestroyInitInput( SS_Exctn_InitInp, ErrStat2, ErrMsg2 ) + CALL SS_Exc_DestroyInitOutput( SS_Exctn_InitOut, ErrStat2, ErrMsg2 ) ! destroy local variables that are allocatable arrays: @@ -1500,7 +1650,6 @@ SUBROUTINE WAMIT_End( u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) ! Destroy the parameter data: - CALL WAMIT_DestroyParam( p, ErrStat, ErrMsg ) @@ -1530,7 +1679,7 @@ SUBROUTINE WAMIT_UpdateStates( t, n, Inputs, InputTimes, p, x, xd, z, OtherState REAL(DbKi), INTENT(IN ) :: t !< Current simulation time in seconds INTEGER(IntKi), INTENT(IN ) :: n !< Current step of the simulation: t = n*Interval - TYPE(WAMIT_InputType), INTENT(IN ) :: Inputs(:) !< Inputs at InputTimes + TYPE(WAMIT_InputType), INTENT(INOUT) :: Inputs(:) !< Inputs at InputTimes REAL(DbKi), INTENT(IN ) :: InputTimes(:) !< Times in seconds associated with Inputs TYPE(WAMIT_ParameterType), INTENT(IN ) :: p !< Parameters TYPE(WAMIT_ContinuousStateType), INTENT(INOUT) :: x !< Input: Continuous states at t; @@ -1555,15 +1704,16 @@ SUBROUTINE WAMIT_UpdateStates( t, n, Inputs, InputTimes, p, x, xd, z, OtherState ! INTEGER(IntKi) :: ErrStat2 ! Error status of the operation (secondary error) ! CHARACTER(ErrMsgLen) :: ErrMsg2 ! Error message if ErrStat2 /= ErrID_None - - + REAL(ReKi) :: bodyPosition(2) + REAL(ReKi) :: tmpVec6(6) + ! Create dummy variables required by framework but which are not used by the module TYPE(Conv_Rdtn_InputType), ALLOCATABLE :: Conv_Rdtn_u(:) ! Inputs TYPE(SS_Rad_InputType), ALLOCATABLE :: SS_Rdtn_u(:) ! Inputs - TYPE(SS_Exc_InputType), ALLOCATABLE :: SS_Exctn_u(:) ! Inputs - + TYPE(SS_Exc_InputType), ALLOCATABLE :: SS_Exctn_u(:) ! Inputs + TYPE(WAMIT_InputType) :: WAMIT_u_t ! Initialize ErrStat @@ -1574,7 +1724,7 @@ SUBROUTINE WAMIT_UpdateStates( t, n, Inputs, InputTimes, p, x, xd, z, OtherState nTime = size(Inputs) - IF ( p%RdtnMod == 1 ) THEN ! Update the convolution radiation memory effect sub-module's state + IF ( p%RdtnMod == 1 ) THEN ! Update the convolution radiation memory effect sub-module's state ! Allocate array of Conv_Rdtn inputs @@ -1592,8 +1742,10 @@ SUBROUTINE WAMIT_UpdateStates( t, n, Inputs, InputTimes, p, x, xd, z, OtherState END IF do iBody=1,p%NBody indxStart = (iBody-1)*6+1 - indxEnd = indxStart+5 - Conv_Rdtn_u(I)%Velocity(indxStart:indxEnd) = (/Inputs(I)%Mesh%TranslationVel(:,iBody), Inputs(I)%Mesh%RotationVel(:,iBody)/) + indxEnd = indxStart+5 + call hiFrameTransform( i2h, Inputs(I)%PtfmRefY, Inputs(I)%Mesh%TranslationVel(:,iBody), tmpVec6(1:3), ErrStat, ErrMsg) + call hiFrameTransform( i2h, Inputs(I)%PtfmRefY, Inputs(I)%Mesh%RotationVel(:,iBody), tmpVec6(4:6), ErrStat, ErrMsg) + Conv_Rdtn_u(I)%Velocity(indxStart:indxEnd) = tmpVec6 end do END DO @@ -1619,10 +1771,10 @@ SUBROUTINE WAMIT_UpdateStates( t, n, Inputs, InputTimes, p, x, xd, z, OtherState RETURN END IF do iBody=1,p%NBody - indxStart = (iBody-1)*6+1 - SS_Rdtn_u(I)%dq(indxStart:indxStart+2) = Inputs(I)%Mesh%TranslationVel(:,iBody) - SS_Rdtn_u(I)%dq(indxStart+3:indxStart+5) = Inputs(I)%Mesh%RotationVel(:,iBody) - !SS_Rdtn_u(I)%dq = reshape((/Inputs(I)%Mesh%TranslationVel(:,1), Inputs(I)%Mesh%RotationVel(:,1)/), (/6,1/)) !reshape(u%Velocity, (/6,1/)) ! dq is a 6x1 matrix + indxStart = (iBody-1)*6+1 + call hiFrameTransform( i2h, Inputs(I)%PtfmRefY, Inputs(I)%Mesh%TranslationVel(:,iBody), tmpVec6(1:3), ErrStat, ErrMsg) + call hiFrameTransform( i2h, Inputs(I)%PtfmRefY, Inputs(I)%Mesh%RotationVel(:,iBody), tmpVec6(4:6), ErrStat, ErrMsg) + SS_Rdtn_u(I)%dq(indxStart:indxStart+5) = tmpVec6 end do END DO @@ -1632,7 +1784,23 @@ SUBROUTINE WAMIT_UpdateStates( t, n, Inputs, InputTimes, p, x, xd, z, OtherState END IF - if ( p%ExctnMod == 2 ) then ! Update the state-space wave excitation sub-module's states + IF ( (p%ExctnMod>0).AND.(p%ExctnDisp==2) ) THEN + ! Interpolate WAMIT input at time t+dt + CALL WAMIT_CopyInput(Inputs(1), WAMIT_u_t, MESH_NEWCOPY, ErrStat, ErrMsg) + CALL WAMIT_Input_ExtrapInterp(Inputs, InputTimes, WAMIT_u_t, t+p%dt, ErrStat, ErrMsg) + DO iBody = 1,p%NBody + ! Current unfiltered body position at time t+dt + bodyPosition(1) = WAMIT_u_t%Mesh%TranslationDisp(1,iBody) + bodyPosition(2) = WAMIT_u_t%Mesh%TranslationDisp(2,iBody) + ! Filtered body position + xd%BdyPosFilt(:,iBody,3) = xd%BdyPosFilt(:,iBody,2) + xd%BdyPosFilt(:,iBody,2) = xd%BdyPosFilt(:,iBody,1) + xd%BdyPosFilt(1,iBody,1) = p%ExctnFiltConst * xd%BdyPosFilt(1,iBody,1) + (1.0_ReKi - p%ExctnFiltConst) * bodyPosition(1) + xd%BdyPosFilt(2,iBody,1) = p%ExctnFiltConst * xd%BdyPosFilt(2,iBody,1) + (1.0_ReKi - p%ExctnFiltConst) * bodyPosition(2) + END DO + CALL WAMIT_DestroyInput( WAMIT_u_t, ErrStat, ErrMsg) + END IF + IF ( p%ExctnMod == 2 ) THEN ! Update the state-space wave excitation sub-module's states ! Allocate array of dummy SS_Excitation inputs for the framework @@ -1641,21 +1809,58 @@ SUBROUTINE WAMIT_UpdateStates( t, n, Inputs, InputTimes, p, x, xd, z, OtherState ErrMsg = ' Failed to allocate array SS_Exctn_u.' return end if + if (p%ExctnDisp == 1) then ! Use unfiltered position + DO I=1,nTime + ALLOCATE( SS_Exctn_u(I)%PtfmPos(3,p%NBody), STAT = ErrStat ) + IF (ErrStat /=0) THEN + ErrMsg = ' Failed to allocate array SS_Exctn_u(I)%PtfmPos.' + RETURN + END IF + if (p%NBodyMod == 2) then + do iBody=1,p%NBody + SS_Exctn_u(I)%PtfmPos(:,iBody) = Inputs(I)%Mesh%TranslationDisp(:,iBody) + Inputs(I)%Mesh%Position(:,iBody) + end do + else + do iBody=1,p%NBody + SS_Exctn_u(I)%PtfmPos(:,iBody) = Inputs(I)%Mesh%TranslationDisp(:,iBody) + end do + end if + + END DO + else if (p%ExctnDisp == 2) then ! Use filtered position (only need x and y coordinates) + DO I=1,nTime + ALLOCATE( SS_Exctn_u(I)%PtfmPos(3,p%NBody), STAT = ErrStat ) + IF (ErrStat /=0) THEN + ErrMsg = ' Failed to allocate array SS_Exctn_u(I)%PtfmPos.' + RETURN + END IF + if (p%NBodyMod == 2) then + do iBody=1,p%NBody + SS_Exctn_u(I)%PtfmPos(1:2,iBody) = xd%BdyPosFilt(:,iBody,I) + Inputs(I)%Mesh%Position(1:2,iBody) + end do + else + do iBody=1,p%NBody + SS_Exctn_u(I)%PtfmPos(1:2,iBody) = xd%BdyPosFilt(:,iBody,I) + end do + end if + + END DO + + end if call SS_Exc_UpdateStates( t, n, SS_Exctn_u, InputTimes, p%SS_Exctn, x%SS_Exctn, xd%SS_Exctn, z%SS_Exctn, OtherState%SS_Exctn, m%SS_Exctn, ErrStat, ErrMsg ) deallocate(SS_Exctn_u) - end if + END IF END SUBROUTINE WAMIT_UpdateStates !---------------------------------------------------------------------------------------------------------------------------------- !> Routine for computing outputs, used in both loose and tight coupling. -SUBROUTINE WAMIT_CalcOutput( Time, WaveTime, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) +SUBROUTINE WAMIT_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) !.................................................................................................................................. REAL(DbKi), INTENT(IN ) :: Time !< Current simulation time in seconds - real(SiKi), intent(in ) :: WaveTime(:) !< Array of wave kinematic time samples, (sec) TYPE(WAMIT_InputType), INTENT(IN ) :: u !< Inputs at Time TYPE(WAMIT_ParameterType), INTENT(IN ) :: p !< Parameters TYPE(WAMIT_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at Time @@ -1674,16 +1879,25 @@ SUBROUTINE WAMIT_CalcOutput( Time, WaveTime, u, p, x, xd, z, OtherState, y, m, E !REAL(ReKi) :: F_HS (6) ! Total load contribution from hydrostatics, including the effects of waterplane area and the center of buoyancy (N, N-m) !REAL(ReKi) :: F_Waves (6) ! Total load contribution from incident waves (i.e., the diffraction problem) (N, N-m) !REAL(ReKi) :: F_Rdtn (6) ! Total load contribution from wave radiation damping (i.e., the diffraction problem) (N, N-m) - INTEGER(IntKi) :: I ! Generic index - INTEGER(IntKi) :: J ! Generic index -! INTEGER(IntKi) :: K ! Generic index + INTEGER(IntKi) :: I,iStart ! Generic index REAL(ReKi) :: q(6*p%NBody), qdot(6*p%NBody), qdotdot(6*p%NBody) ! kinematics for all WAMIT bodies REAL(ReKi) :: rotdisp(3) ! small angle rotational displacements - REAL(ReKi) :: AllOuts(MaxWAMITOutputs) - integer(IntKi) :: iBody ! Counter for WAMIT bodies. If NBodyMod > 1 then NBody = 1, and hence iBody = 1 - integer(IntKi) :: indxStart, indxEnd ! Starting and ending indices for the iBody_th sub vector in an NBody long vector - - + INTEGER(IntKi) :: iBody ! Counter for WAMIT bodies. If NBodyMod > 1 then NBody = 1, and hence iBody = 1 + INTEGER(IntKi) :: indxStart, indxEnd ! Starting and ending indices for the iBody_th sub vector in an NBody long vector + REAL(ReKi) :: bodyPosition(3) ! x-y displaced location of a WAMIT body (relative to + REAL(ReKi) :: refBodyPosition(3) + REAL(ReKi) :: tmpVec3(3),tmpVec6(6) + REAL(ReKi), PARAMETER :: LrgAngle = 0.261799387799149 ! Threshold for platform roll and pitch rotation (15 deg). This is consistent with the ElastoDyn check. + + ! Error handling + CHARACTER(1024) :: ErrMsg2 ! Temporary error message for calls + INTEGER(IntKi) :: ErrStat2 ! Temporary error status for calls + CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT_Init' + + LOGICAL, SAVE :: FrstWarn_LrgR = .TRUE. + LOGICAL, SAVE :: FrstWarn_LrgP = .TRUE. + LOGICAL, SAVE :: FrstWarn_LrgY = .TRUE. + ! Initialize ErrStat ErrStat = ErrID_None @@ -1700,22 +1914,62 @@ SUBROUTINE WAMIT_CalcOutput( Time, WaveTime, u, p, x, xd, z, OtherState, y, m, E m%F_Waves1 = 0.0_ReKi else if ( p%ExctnMod == 1 ) then - - ! Abort if the wave excitation loads have not been computed yet: - IF ( .NOT. ALLOCATED ( p%WaveExctn ) ) THEN - ErrMsg = ' Routine WAMIT_Init() must be called before routine WAMIT_CalcOutput().' - ErrStat = ErrID_Fatal - RETURN - END IF - DO I = 1,6*p%NBody ! Loop through all wave excitation forces and moments - m%F_Waves1(I) = InterpWrappedStpReal ( REAL(Time, SiKi), WaveTime(:), p%WaveExctn(:,I), & - m%LastIndWave, p%NStepWave + 1 ) - END DO ! I - All wave excitation forces and moments + if ( p%ExctnDisp == 0 ) then + ! Abort if the wave excitation loads have not been computed yet: + IF ( .NOT. ALLOCATED ( p%WaveExctnGrid ) ) THEN + ErrMsg = ' Routine WAMIT_Init() must be called before routine WAMIT_CalcOutput().' + ErrStat = ErrID_Fatal + RETURN + END IF + + DO iBody = 1,p%NBody + bodyPosition(1) = 0.0 + bodyPosition(2) = 0.0 + bodyPosition(3) = WrapToPi(u%PtfmRefY) + iStart = (iBody-1)*6+1 + ! WaveExctnGrid dimensions are: 1st: wavetime, 2nd: X, 3rd: Y, 4th: PRP yaw offset, 5th: Force component for each WAMIT Body + m%F_Waves1(iStart:iStart+5) = WAMIT_ForceWaves_Interp( Time, bodyPosition, p%WaveExctnGrid(:,:,:,:,iStart:iStart+5), p%ExctnGridParams, m%WaveField_m, ErrStat2, ErrMsg2 ) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + + else ! p%ExctnDisp > 0 + IF ( .NOT. allocated ( p%WaveExctnGrid ) ) THEN + ErrMsg = ' Routine WAMIT_Init() must be called before routine WAMIT_CalcOutput().' + ErrStat = ErrID_Fatal + RETURN + END IF + ! We are using the displaced x,y location of the WAMIT bodies to determine the Wave Exication force + + DO iBody = 1,p%NBody + IF ( p%ExctnDisp == 1 ) THEN + ! Current unfiltered body position + bodyPosition(1) = u%Mesh%TranslationDisp(1,iBody) + bodyPosition(2) = u%Mesh%TranslationDisp(2,iBody) + ELSE IF ( p%ExctnDisp == 2 ) THEN + ! Use filtered body position + bodyPosition(1) = p%ExctnFiltConst * xd%BdyPosFilt(1,iBody,1) + (1.0_ReKi - p%ExctnFiltConst) * u%Mesh%TranslationDisp(1,iBody) + bodyPosition(2) = p%ExctnFiltConst * xd%BdyPosFilt(2,iBody,1) + (1.0_ReKi - p%ExctnFiltConst) * u%Mesh%TranslationDisp(2,iBody) + END IF + bodyPosition(3) = WrapToPi(u%PtfmRefY) + + ! Remove baseline displacement due to non-zero yaw orientation and body offset from PRP + CALL hiFrameTransform(h2i,u%PtfmRefY,u%Mesh%Position(1:3,iBody), refBodyPosition, ErrStat2, ErrMsg2 ) + bodyPosition(1) = bodyPosition(1) - (refBodyPosition(1) - u%Mesh%Position(1,iBody)) + bodyPosition(2) = bodyPosition(2) - (refBodyPosition(2) - u%Mesh%Position(2,iBody)) + + iStart = (iBody-1)*6+1 + ! WaveExctnGrid dimensions are: 1st: wavetime, 2nd: X, 3rd: Y, 4th: PRP yaw offset, 5th: Force component for each WAMIT Body + m%F_Waves1(iStart:iStart+5) = WAMIT_ForceWaves_Interp( Time, bodyPosition, p%WaveExctnGrid(:,:,:,:,iStart:iStart+5), p%ExctnGridParams, m%WaveField_m, ErrStat2, ErrMsg2 ) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + end if + else if ( p%ExctnMod == 2 ) then call SS_Exc_CalcOutput( Time, m%SS_Exctn_u, p%SS_Exctn, x%SS_Exctn, xd%SS_Exctn, & - z%SS_Exctn, OtherState%SS_Exctn, m%SS_Exctn_y, m%SS_Exctn, ErrStat, ErrMsg ) + z%SS_Exctn, OtherState%SS_Exctn, m%SS_Exctn_y, m%SS_Exctn, ErrStat2, ErrMsg2 ) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) m%F_Waves1 (:) = m%SS_Exctn_y%y end if @@ -1723,24 +1977,69 @@ SUBROUTINE WAMIT_CalcOutput( Time, WaveTime, u, p, x, xd, z, OtherState, y, m, E do iBody = 1, p%NBody - ! Determine the rotational angles from the direction-cosine matrix - rotdisp = GetSmllRotAngs ( u%Mesh%Orientation(:,:,iBody), ErrStat, ErrMsg ) + ! Determine the rotational angles from the direction-cosine matrix + ! rotdisp = GetRotAngs ( u%PtfmRefY, u%Mesh%Orientation(:,:,iBody), ErrStat, ErrMsg ) + ! rotdisp(3) = rotdisp(3) - u%PtfmRefY ! Remove the large yaw offset + rotdisp = EulerExtractZYX ( u%Mesh%Orientation(:,:,iBody) ) + IF ( (ABS(rotdisp(1)) > LrgAngle) .AND. FrstWarn_LrgR ) THEN + ErrStat2 = ErrID_Severe + ErrMsg2 = 'Roll angle of a potential-flow body violated the small angle assumption. The solution might be inaccurate. Simulation continuing, but future warnings will be suppressed.' + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + FrstWarn_LrgR = .FALSE. + END IF + IF ( (ABS(rotdisp(2)) > LrgAngle) .AND. FrstWarn_LrgP ) THEN + ErrStat2 = ErrID_Severe + ErrMsg2 = 'Pitch angle of a potential-flow body violated the small angle assumption. The solution might be inaccurate. Simulation continuing, but future warnings will be suppressed.' + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + FrstWarn_LrgP = .FALSE. + END IF + IF ( (ABS( WrapToPi(rotDisp(3)-u%PtfmRefY) ) > LrgAngle) .AND. FrstWarn_LrgY ) THEN + ErrStat2 = ErrID_Severe + ErrMsg2 = 'Yaw angle of a potential-flow body relative to the reference yaw position (PtfmRefY) violated the small angle assumption. The solution might be inaccurate. Consider using PtfmYMod=1 and adjust PtfmYCutoff. Simulation continuing, but future warnings will be suppressed.' + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + FrstWarn_LrgY = .FALSE. + END IF + indxStart = (iBody-1)*6+1 indxEnd = indxStart+5 - q (indxStart:indxEnd) = reshape((/real(u%Mesh%TranslationDisp(:,iBody),ReKi),rotdisp(:)/),(/6/)) - qdot (indxStart:indxEnd) = reshape((/u%Mesh%TranslationVel(:,iBody),u%Mesh%RotationVel(:,iBody)/),(/6/)) - qdotdot(indxStart:indxEnd) = reshape((/u%Mesh%TranslationAcc(:,iBody),u%Mesh%RotationAcc(:,iBody)/),(/6/)) + + ! Displacement with Tait-Bryan angles following the Z-Y-X convention + q(indxStart:indxEnd) = reshape((/real(u%Mesh%TranslationDisp(:,iBody),ReKi),rotdisp(:)/),(/6/)) + + ! Get velocity and acceleration in the heading frame + call hiFrameTransform( i2h, u%PtfmRefY, u%Mesh%TranslationVel(:,iBody), tmpVec6(1:3), ErrStat2, ErrMsg2) + call hiFrameTransform( i2h, u%PtfmRefY, u%Mesh%RotationVel(:,iBody), tmpVec6(4:6), ErrStat2, ErrMsg2) + qdot (indxStart:indxEnd) = tmpVec6 + call hiFrameTransform( i2h, u%PtfmRefY, u%Mesh%TranslationAcc(:,iBody), tmpVec6(1:3), ErrStat2, ErrMsg2) + call hiFrameTransform( i2h, u%PtfmRefY, u%Mesh%RotationAcc(:,iBody), tmpVec6(4:6), ErrStat2, ErrMsg2) + qdotdot(indxStart:indxEnd) = tmpVec6 end do - ! Compute the load contribution from hydrostatics: - - m%F_HS = -matmul(p%HdroSttc,q) - + ! Compute the load contribution from hydrostatics: + ! Hydrostatic load in the yaw-offset frame + ! m%F_HS = -matmul(p%HdroSttc,q) + m%F_HS = 0. do iBody = 1, p%NBody indxStart = (iBody-1)*6+1 indxEnd = indxStart+5 - m%F_HS(indxStart:indxEnd) = m%F_HS(indxStart:indxEnd) + p%F_HS_Moment_Offset(:,iBody) ! except for the hydrostatic buoyancy force from Archimede's Principle when the support platform is in its undisplaced position + m%F_HS((indxStart+2):(indxEnd-1)) = -matmul(p%HdroSttc((indxStart+2):(indxEnd-1),(indxStart+2):(indxEnd-1)),& + q((indxStart+2):(indxEnd-1))) + m%F_HS(indxStart:indxEnd) = m%F_HS(indxStart:indxEnd) + p%F_HS_Moment_Offset(:,iBody) + end do + + ! Transform hydrostatic loads back to the inertial frame + do iBody = 1, p%NBody + indxStart = (iBody-1)*6+1 + indxEnd = indxStart+2 + ! call hiFrameTransform( h2i, u%PtfmRefY, m%F_HS(indxStart:indxEnd), tmpVec3, ErrStat2, ErrMsg2 ) + call hiFrameTransform( h2i, q(iBody*6), m%F_HS(indxStart:indxEnd), tmpVec3, ErrStat2, ErrMsg2 ) + m%F_HS(indxStart:indxEnd) = tmpVec3 + indxStart = indxEnd+1 + indxEnd = indxStart+2 + ! call hiFrameTransform( h2i, u%PtfmRefY, m%F_HS(indxStart:indxEnd), tmpVec3, ErrStat2, ErrMsg2 ) + call hiFrameTransform( h2i, q(iBody*6), m%F_HS(indxStart:indxEnd), tmpVec3, ErrStat2, ErrMsg2 ) + m%F_HS(indxStart:indxEnd) = tmpVec3 end do @@ -1750,25 +2049,36 @@ SUBROUTINE WAMIT_CalcOutput( Time, WaveTime, u, p, x, xd, z, OtherState, y, m, E IF ( p%RdtnMod == 1 ) THEN ! .TRUE. when we will be modeling wave radiation damping. m%Conv_Rdtn_u%Velocity = qdot CALL Conv_Rdtn_CalcOutput( Time, m%Conv_Rdtn_u, p%Conv_Rdtn, x%Conv_Rdtn, xd%Conv_Rdtn, & - z%Conv_Rdtn, OtherState%Conv_Rdtn, m%Conv_Rdtn_y, m%Conv_Rdtn, ErrStat, ErrMsg ) + z%Conv_Rdtn, OtherState%Conv_Rdtn, m%Conv_Rdtn_y, m%Conv_Rdtn, ErrStat2, ErrMsg2 ) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) m%F_Rdtn (:) = m%Conv_Rdtn_y%F_Rdtn ELSE IF ( p%RdtnMod == 2 ) THEN m%SS_Rdtn_u%dq = qdot CALL SS_Rad_CalcOutput( Time, m%SS_Rdtn_u, p%SS_Rdtn, x%SS_Rdtn, xd%SS_Rdtn, & - z%SS_Rdtn, OtherState%SS_Rdtn, m%SS_Rdtn_y, m%SS_Rdtn, ErrStat, ErrMsg ) + z%SS_Rdtn, OtherState%SS_Rdtn, m%SS_Rdtn_y, m%SS_Rdtn, ErrStat2, ErrMsg2 ) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) m%F_Rdtn (:) = m%SS_Rdtn_y%y ELSE ! We must not be modeling wave radiation damping. - ! Set the total load contribution from radiation damping to zero: m%F_Rdtn (:) = 0.0 - END IF - + do iBody = 1, p%NBody + indxStart = (iBody-1)*6+1 + indxEnd = indxStart+2 + call hiFrameTransform( h2i, u%PtfmRefY, m%F_Rdtn(indxStart:indxEnd), tmpVec3, ErrStat2, ErrMsg2 ) + m%F_Rdtn(indxStart:indxEnd) = tmpVec3 + + indxStart = indxEnd+1 + indxEnd = indxStart+2 + call hiFrameTransform( h2i, u%PtfmRefY, m%F_Rdtn(indxStart:indxEnd), tmpVec3, ErrStat2, ErrMsg2 ) + m%F_Rdtn(indxStart:indxEnd) = tmpVec3 + end do + ! Compute Added Mass Forces ! Set the platform added mass matrix, PtfmAM, to be the infinite-frequency @@ -1777,9 +2087,18 @@ SUBROUTINE WAMIT_CalcOutput( Time, WaveTime, u, p, x, xd, z, OtherState, y, m, E !added mass: - m%F_PtfmAM = -matmul(p%HdroAdMsI, qdotdot) - - + m%F_PtfmAM = -matmul(p%HdroAdMsI, qdotdot) ! In h-frame + do iBody = 1, p%NBody + indxStart = (iBody-1)*6+1 + indxEnd = indxStart+2 + call hiFrameTransform( h2i, u%PtfmRefY, m%F_PtfmAM(indxStart:indxEnd), tmpVec3, ErrStat2, ErrMsg2 ) + m%F_PtfmAM(indxStart:indxEnd) = tmpVec3 + + indxStart = indxEnd+1 + indxEnd = indxStart+2 + call hiFrameTransform( h2i, u%PtfmRefY, m%F_PtfmAM(indxStart:indxEnd), tmpVec3, ErrStat2, ErrMsg2 ) + m%F_PtfmAM(indxStart:indxEnd) = tmpVec3 + end do ! Compute outputs here: do iBody = 1, p%NBody @@ -1796,8 +2115,9 @@ SUBROUTINE WAMIT_CalcOutput( Time, WaveTime, u, p, x, xd, z, OtherState, y, m, E ! Output channels will be dealt with by the HydroDyn module - END SUBROUTINE WAMIT_CalcOutput + + !---------------------------------------------------------------------------------------------------------------------------------- !> Tight coupling routine for computing derivatives of continuous states SUBROUTINE WAMIT_CalcContStateDeriv( Time, u, p, x, xd, z, OtherState, m, dxdt, ErrStat, ErrMsg ) @@ -1817,7 +2137,10 @@ SUBROUTINE WAMIT_CalcContStateDeriv( Time, u, p, x, xd, z, OtherState, m, dxdt, integer(IntKi) :: iBody ! WAMIT body index integer(IntKi) :: indxStart ! Starting and ending indices for the iBody_th sub vector in an NBody long vector - + real(SiKi) :: waveElev0(p%NBody) + real(ReKi) :: tmpVec6(6) + + ! Initialize ErrStat ErrStat = ErrID_None @@ -1828,8 +2151,9 @@ SUBROUTINE WAMIT_CalcContStateDeriv( Time, u, p, x, xd, z, OtherState, m, dxdt, if (p%RdtnMod == 2) then do iBody = 1, p%NBody indxStart = (iBody-1)*6+1 - m%SS_Rdtn_u%dq(indxStart:indxStart+2) = u%Mesh%TranslationVel(:,iBody) - m%SS_Rdtn_u%dq(indxStart+3:indxStart+5) = u%Mesh%RotationVel(:,iBody) + call hiFrameTransform( i2h, u%PtfmRefY, u%Mesh%TranslationVel(:,iBody), tmpVec6(1:3), ErrStat, ErrMsg) + call hiFrameTransform( i2h, u%PtfmRefY, u%Mesh%RotationVel(:,iBody), tmpVec6(4:6), ErrStat, ErrMsg) + m%SS_Rdtn_u%dq(indxStart:indxStart+5) = tmpVec6 end do CALL SS_Rad_CalcContStateDeriv( Time, m%SS_Rdtn_u, p%SS_Rdtn, x%SS_Rdtn, xd%SS_Rdtn, z%SS_Rdtn, OtherState%SS_Rdtn, m%SS_Rdtn, dxdt%SS_Rdtn, ErrStat, ErrMsg ) @@ -1838,7 +2162,8 @@ SUBROUTINE WAMIT_CalcContStateDeriv( Time, u, p, x, xd, z, OtherState, m, dxdt, ! NOTE: The input below (0.0) will only work as part of a linearization Get_OP call! If this routine (WAMIT_CalcContStateDeriv) is called in another context, then the following ! input needs to be implemented generically. As of Aug 10, 2020, this is only called for Get_OP related work. GJH if (p%ExctnMod == 2) then - CALL SS_Exc_CalcContStateDeriv( Time, 0.0_SiKi, p%SS_Exctn, x%SS_Exctn, xd%SS_Exctn, z%SS_Exctn, OtherState%SS_Exctn, m%SS_Exctn, dxdt%SS_Exctn, ErrStat, ErrMsg ) + waveElev0 = 0.0_SiKi + CALL SS_Exc_CalcContStateDeriv( Time, waveElev0, p%SS_Exctn, x%SS_Exctn, xd%SS_Exctn, z%SS_Exctn, OtherState%SS_Exctn, m%SS_Exctn, dxdt%SS_Exctn, ErrStat, ErrMsg ) end if END SUBROUTINE WAMIT_CalcContStateDeriv @@ -1863,6 +2188,8 @@ SUBROUTINE WAMIT_UpdateDiscState( Time, n, u, p, x, xd, z, OtherState, m, ErrSta integer(IntKi) :: iBody ! WAMIT body index integer(IntKi) :: indxStart, indxEnd ! Starting and ending indices for the iBody_th sub vector in an NBody long vector + REAL(ReKi) :: tmpVec6(6) + ! Initialize ErrStat ErrStat = ErrID_None @@ -1873,8 +2200,10 @@ SUBROUTINE WAMIT_UpdateDiscState( Time, n, u, p, x, xd, z, OtherState, m, ErrSta IF ( p%RdtnMod == 1 ) THEN ! .TRUE. when we will be modeling wave radiation damping. do iBody=1,p%NBody indxStart = (iBody-1)*6+1 - indxEnd = indxStart+5 - m%Conv_Rdtn_u%Velocity(indxStart:indxEnd) = (/u%Mesh%TranslationVel(:,iBody), u%Mesh%RotationVel(:,iBody)/) + indxEnd = indxStart+5 + call hiFrameTransform( i2h, u%PtfmRefY, u%Mesh%TranslationVel(:,iBody), tmpVec6(1:3), ErrStat, ErrMsg) + call hiFrameTransform( i2h, u%PtfmRefY, u%Mesh%RotationVel(:,iBody), tmpVec6(4:6), ErrStat, ErrMsg) + m%Conv_Rdtn_u%Velocity(indxStart:indxEnd) = tmpVec6 end do CALL Conv_Rdtn_UpdateDiscState( Time, n, m%Conv_Rdtn_u, p%Conv_Rdtn, x%Conv_Rdtn, xd%Conv_Rdtn, z%Conv_Rdtn, & OtherState%Conv_Rdtn, m%Conv_Rdtn, ErrStat, ErrMsg ) @@ -1913,5 +2242,59 @@ SUBROUTINE WAMIT_CalcConstrStateResidual( Time, u, p, x, xd, z, OtherState, m, z END SUBROUTINE WAMIT_CalcConstrStateResidual !---------------------------------------------------------------------------------------------------------------------------------- +!> Other supporting subroutines +!.................................................................................................................................. +FUNCTION GetAngleInRangeR8(inAngle,minAngle,maxAngle,outAngle) + REAL(R8Ki), INTENT(IN ) :: inAngle + REAL(R8Ki), INTENT(IN ) :: minAngle + REAL(R8Ki), INTENT(IN ) :: maxAngle + REAL(R8Ki), INTENT( OUT) :: outAngle + LOGICAL :: GetAngleInRangeR8 + REAL(R8Ki), PARAMETER :: Tol = 0.001 ! deg + + GetAngleInRangeR8 = .FALSE. + if ( ( inAngle > (minAngle-Tol) ) .AND. ( inAngle < (maxAngle+Tol) ) ) then + GetAngleInRangeR8 = .TRUE. + outAngle = inAngle + else if (inAngle < minAngle ) then + outAngle = inAngle + ceiling((minAngle-inAngle)/360.0)*360.0 + if ( outAngle < (maxAngle+Tol) ) then + GetAngleInRangeR8 = .TRUE. + end if + else ! inAngle > maxAngle + outAngle = inAngle - ceiling((inAngle-maxAngle)/360.0)*360.0 + if ( outAngle > (minAngle-Tol) ) then + GetAngleInRangeR8 = .TRUE. + end if + end if + +END FUNCTION GetAngleInRangeR8 + +FUNCTION GetAngleInRangeR4(inAngle,minAngle,maxAngle,outAngle) + REAL(SiKi), INTENT(IN ) :: inAngle + REAL(SiKi), INTENT(IN ) :: minAngle + REAL(SiKi), INTENT(IN ) :: maxAngle + REAL(SiKi), INTENT( OUT) :: outAngle + LOGICAL :: GetAngleInRangeR4 + REAL(SiKi), PARAMETER :: Tol = 0.001 ! deg + + GetAngleInRangeR4 = .FALSE. + if ( ( inAngle > (minAngle-Tol) ) .AND. ( inAngle < (maxAngle+Tol) ) ) then + GetAngleInRangeR4 = .TRUE. + outAngle = inAngle + else if (inAngle < minAngle ) then + outAngle = inAngle + ceiling((minAngle-inAngle)/360.0)*360.0 + if ( outAngle < (maxAngle+Tol) ) then + GetAngleInRangeR4 = .TRUE. + end if + else ! inAngle > maxAngle + outAngle = inAngle - ceiling((inAngle-maxAngle)/360.0)*360.0 + if ( outAngle > (minAngle-Tol) ) then + GetAngleInRangeR4 = .TRUE. + end if + end if + +END FUNCTION GetAngleInRangeR4 +!---------------------------------------------------------------------------------------------------------------------------------- END MODULE WAMIT !********************************************************************************************************************************** diff --git a/modules/hydrodyn/src/WAMIT.txt b/modules/hydrodyn/src/WAMIT.txt index 0317f50c9f..0d07cfe542 100644 --- a/modules/hydrodyn/src/WAMIT.txt +++ b/modules/hydrodyn/src/WAMIT.txt @@ -16,12 +16,11 @@ include Registry_NWTC_Library.txt usefrom Conv_Radiation.txt usefrom SS_Radiation.txt usefrom SS_Excitation.txt -usefrom Waves.txt -param WAMIT/WAMIT unused INTEGER MaxWAMITOutputs - 18 - "" - -typedef ^ InitInputType INTEGER NBody - - - "[>=1; only used when PotMod=1. If NBodyMod=1, the WAMIT data contains a vector of size 6*NBody x 1 and matrices of size 6*NBody x 6*NBody; if NBodyMod>1, there are NBody sets of WAMIT data each with a vector of size 6 x 1 and matrices of size 6 x 6]" - +usefrom SeaSt_WaveField.txt + +typedef WAMIT/WAMIT InitInputType INTEGER NBody - - - "[>=1; only used when PotMod=1. If NBodyMod=1, the WAMIT data contains a vector of size 6*NBody x 1 and matrices of size 6*NBody x 6*NBody; if NBodyMod>1, there are NBody sets of WAMIT data each with a vector of size 6 x 1 and matrices of size 6 x 6]" - typedef ^ ^ INTEGER NBodyMod - - - "Body coupling model {1: include coupling terms between each body and NBody in HydroDyn equals NBODY in WAMIT, 2: neglect coupling terms between each body and NBODY=1 with XBODY=0 in WAMIT, 3: Neglect coupling terms between each body and NBODY=1 with XBODY=/0 in WAMIT} (switch) [only used when PotMod=1]" - typedef ^ ^ ReKi Gravity - - - "Supplied by Driver: Gravitational acceleration" "(m/s^2)" -typedef ^ ^ SiKi WtrDpth - - - "Water depth (positive-valued)" m typedef ^ ^ ReKi PtfmVol0 {:} - - "" - typedef ^ ^ LOGICAL HasWAMIT - - - ".TRUE. if using WAMIT model, .FALSE. otherwise" - typedef ^ ^ ReKi WAMITULEN - - - "" - @@ -33,31 +32,20 @@ typedef ^ ^ ReKi typedef ^ ^ ReKi PtfmCOByt {:} - - "" - typedef ^ ^ INTEGER RdtnMod - - - "" - typedef ^ ^ INTEGER ExctnMod - - - "" - +typedef ^ ^ INTEGER ExctnDisp - - - "0: use undisplaced position, 1: use displaced position, 2: use low-pass filtered displaced position) [only used when PotMod=1 and ExctnMod>0]" - +typedef ^ ^ ReKi ExctnCutOff - - - "Cutoff (corner) frequency of the low-pass time-filtered displaced position (Hz) [>0.0] " Hz +typedef ^ ^ IntKi NExctnHdg - - - "Number of PRP headings/yaw offset evenly distributed over the region [-180, 180) deg to be used when precomputing the wave excitation [only used when PtfmYMod=1]" typedef ^ ^ DbKi RdtnTMax - - - "" - -typedef ^ ^ ReKi WaveDir - - - "" - typedef ^ ^ CHARACTER(1024) WAMITFile - - - "" - typedef ^ ^ Conv_Rdtn_InitInputType Conv_Rdtn - - - "" - -#typedef ^ ^ SS_Rad_InitInputType SS_Rdtn - - - "" - -#typedef ^ ^ SS_Exc_InitInputType SS_Excn - - - "" - -typedef ^ ^ ReKi Rhoxg - - - "" - -typedef ^ ^ INTEGER NStepWave - - - "" - -typedef ^ ^ INTEGER NStepWave2 - - - "" - -typedef ^ ^ ReKi WaveDOmega - - - "" - -typedef ^ ^ SiKi WaveElev0 {:} - - "Wave elevation time history at origin (needed for SS_Excitation module)" m -typedef ^ ^ SiKi WaveElevC0 {:}{:} - - "Discrete Fourier transform of the instantaneous elevation of incident waves at the platform reference point. First column is real part, second column is imaginary part" (meters) -typedef ^ ^ SiKi WaveTime {:} - - "" - -typedef ^ ^ INTEGER WaveMod - - - "" - -typedef ^ ^ ReKi WtrDens - - - "" - -typedef ^ ^ SiKi WaveDirArr {:} - - "Array of wave directions (one per frequency) from the Waves module" - -typedef ^ ^ SiKi WaveDirMin - - - "Minimum wave direction from Waves module" - -typedef ^ ^ SiKi WaveDirMax - - - "Maximum wave direction from Waves module" - -typedef ^ ^ CHARACTER(ChanLen) OutList {18} - - "This should really be dimensioned with MaxOutPts" - -typedef ^ ^ LOGICAL OutAll - - - "" - -typedef ^ ^ INTEGER NumOuts - - - "" - +typedef ^ ^ SeaSt_WaveFieldType *WaveField - - - "Pointer to wave field" +typedef ^ ^ INTEGER PtfmYMod - - - "Large yaw model" - +typedef ^ ^ ReKi PtfmRefY - - - "Initial reference yaw offset" (rad) +typedef ^ ^ ReKi PlatformPos {6} - - "Initial platform position (6 DOFs)" # # # Define outputs from the initialization routine here: -typedef ^ InitOutputType ReKi NULLVAL - - - "" - +#typedef ^ InitOutputType IntKi NULLVAL - - - "" - # # # ..... States .................................................................................................................... @@ -73,6 +61,7 @@ typedef ^ ^ Conv_Rdtn_C typedef ^ DiscreteStateType Conv_Rdtn_DiscreteStateType Conv_Rdtn - - - "discrete states from the convolution radiation module" - typedef ^ DiscreteStateType SS_Rad_DiscreteStateType SS_Rdtn - - - "placeholder" - typedef ^ DiscreteStateType SS_Exc_DiscreteStateType SS_Exctn - - - "placeholder" - +typedef ^ DiscreteStateType ReKi BdyPosFilt {:}{:}{:} - - "Low-pass filtered WAMIT body position at the current and previous steps used when ExctnDisp=2" # # # Define constraint states here: @@ -106,6 +95,7 @@ typedef ^ ^ SS_Exc_Outp typedef ^ ^ Conv_Rdtn_MiscVarType Conv_Rdtn - - - "" - typedef ^ ^ Conv_Rdtn_InputType Conv_Rdtn_u - - - "" - typedef ^ ^ Conv_Rdtn_OutputType Conv_Rdtn_y - - - "" - +typedef ^ ^ SeaSt_WaveField_MiscVarType WaveField_m - - - "misc var information from the SeaState Interpolation module" - # ..... Parameters ................................................................................................................ # Define parameters here: @@ -117,26 +107,27 @@ typedef ^ ^ ReKi typedef ^ ^ SiKi HdroAdMsI {:}{:} - - "" (sec) typedef ^ ^ SiKi HdroSttc {:}{:} - - "" - typedef ^ ^ INTEGER RdtnMod - - - "" - -typedef ^ ^ INTEGER ExctnMod - - - "" - -typedef ^ ^ SiKi WaveExctn {:}{:} - - "" - -typedef ^ ^ INTEGER NStepWave - - - "" - +typedef ^ ^ INTEGER ExctnMod - - - "" - +typedef ^ ^ INTEGER ExctnDisp - - - "0: use undisplaced position, 1: use displaced position, 2: use low-pass filtered displaced position) [only used when PotMod=1 and ExctnMod>0]" - +typedef ^ ^ ReKi ExctnCutOff - - - "Cutoff (corner) frequency of the low-pass time-filtered displaced position (Hz) [>0.0] " Hz +typedef ^ ^ IntKi NExctnHdg - - - "Number of PRP headings/yaw offset evenly distributed over the region [-180, 180) deg to be used when precomputing the wave excitation [only used when PtfmYMod=1]" +typedef ^ ^ ReKi ExctnFiltConst - - - "Low-pass time filter constant computed from ExctnCutOff" +typedef ^ ^ SiKi WaveExctn {:}{:}{:} - - "" - +typedef ^ ^ SiKi WaveExctnGrid {:}{:}{:}{:}{:} - - "WaveExctnGrid dimensions are: 1st: wavetime, 2nd: X, 3rd: Y, 4th: PRP Yaw, 5th: Force component for eac WAMIT Body" - typedef ^ ^ Conv_Rdtn_ParameterType Conv_Rdtn - - - "" - typedef ^ ^ SS_Rad_ParameterType SS_Rdtn - - - "" - typedef ^ ^ SS_Exc_ParameterType SS_Exctn - - - "" - typedef ^ ^ DbKi DT - - - "" - -typedef ^ ^ OutParmType OutParam {:} - - "" - -typedef ^ ^ INTEGER NumOuts - - - "" - -typedef ^ ^ INTEGER NumOutAll - - - "" - -typedef ^ ^ CHARACTER(20) OutFmt - - - "" - -typedef ^ ^ CHARACTER(20) OutSFmt - - - "" - -typedef ^ ^ CHARACTER(ChanLen) Delim - - - "" - -typedef ^ ^ INTEGER UnOutFile - - - "" - +typedef ^ ^ SeaSt_WaveFieldType *WaveField - - - "Pointer to wave field" +typedef ^ ^ INTEGER PtfmYMod - - - "Large yaw model" - +typedef ^ ^ SeaSt_WaveField_ParameterType ExctnGridParams - - - "Parameters of WaveExctnGrid" - # # # ..... Inputs .................................................................................................................... # Define inputs that are contained on the mesh here: # typedef ^ InputType MeshType Mesh - - - "Displacements at the WAMIT reference point in the inertial frame" - +typedef ^ ^ ReKi PtfmRefY - - - "Reference yaw offset" (rad) # # # ..... Outputs ................................................................................................................... diff --git a/modules/hydrodyn/src/WAMIT2.f90 b/modules/hydrodyn/src/WAMIT2.f90 index 8cfe1026b2..a1fe008229 100644 --- a/modules/hydrodyn/src/WAMIT2.f90 +++ b/modules/hydrodyn/src/WAMIT2.f90 @@ -56,6 +56,7 @@ MODULE WAMIT2 USE WAMIT_Interp USE NWTC_Library USE NWTC_FFTPACK + USE YawOffset IMPLICIT NONE @@ -71,28 +72,9 @@ MODULE WAMIT2 ! ..... Public Subroutines ................................................................................................... PUBLIC :: WAMIT2_Init !< Initialization routine - PUBLIC :: WAMIT2_End !< Ending routine (includes clean up) - PUBLIC :: WAMIT2_UpdateStates !< Loose coupling routine for solving for constraint states, integrating - !! continuous states, and updating discrete states PUBLIC :: WAMIT2_CalcOutput !< Routine for computing outputs - PUBLIC :: WAMIT2_CalcConstrStateResidual !< Tight coupling routine for returning the constraint state residual - PUBLIC :: WAMIT2_CalcContStateDeriv !< Tight coupling routine for computing derivatives of continuous states - PUBLIC :: WAMIT2_UpdateDiscState !< Tight coupling routine for updating discrete states - - !PUBLIC :: WAMIT2_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 :: WAMIT2_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 :: WAMIT2_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 :: WAMIT2_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) - ! Derived types for data storage. @@ -199,6 +181,20 @@ MODULE WAMIT2 TYPE(W2_InitData4D_Type) :: Data4D !< The 4D type from above END TYPE W2_SumData_Type + INTERFACE GetWAMIT2WvHdgRange + MODULE PROCEDURE GetWAMIT2WvHdgRangeDiffData + MODULE PROCEDURE GetWAMIT2WvHdgRangeSumData + END INTERFACE GetWAMIT2WvHdgRange + + INTERFACE CheckWamit2WvHdg + MODULE PROCEDURE CheckWAMIT2WvHdgDiffData + MODULE PROCEDURE CheckWAMIT2WvHdgSumData + END INTERFACE CheckWamit2WvHdg + + INTERFACE GetAngleInRange + MODULE PROCEDURE GetAngleInRangeR4 + MODULE PROCEDURE GetAngleInRangeR8 + END INTERFACE GetAngleInRange CONTAINS !---------------------------------------------------------------------------------------------------------------------------------- @@ -206,28 +202,21 @@ MODULE WAMIT2 !! This routine is called at the start of the simulation to perform initialization steps. !! The parameters that are set here are not changed during the simulation. !! The initial states and initial guess for the input are defined. -SUBROUTINE WAMIT2_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut, ErrStat, ErrMsg ) +SUBROUTINE WAMIT2_Init( InitInp, p, y, m, ErrStat, ErrMsg ) !.................................................................................................................................. TYPE(WAMIT2_InitInputType), INTENT(IN ) :: InitInp !< Input data for initialization routine - TYPE(WAMIT2_InputType), INTENT( OUT) :: u !< An initial guess for the input; input mesh must be defined TYPE(WAMIT2_ParameterType), INTENT( OUT) :: p !< Parameters - TYPE(WAMIT2_ContinuousStateType), INTENT( OUT) :: x !< Initial continuous states - TYPE(WAMIT2_DiscreteStateType), INTENT( OUT) :: xd !< Initial discrete states - TYPE(WAMIT2_ConstraintStateType), INTENT( OUT) :: z !< Initial guess of the constraint states - TYPE(WAMIT2_OtherStateType), INTENT( OUT) :: OtherState !< Initial other states TYPE(WAMIT2_OutputType), INTENT( OUT) :: y !< Initial system outputs (outputs are not calculated; only the output mesh is initialized) TYPE(WAMIT2_MiscVarType), INTENT( OUT) :: m !< Initial misc/optimization variables - REAL(DbKi), INTENT(INOUT) :: Interval !< Coupling interval in seconds: don't change it from the glue code provided value. - TYPE(WAMIT2_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) :: IBody !< Counter for current body + INTEGER(IntKi) :: iHdg !< Counter for platform heading INTEGER(IntKi) :: ThisDim !< Counter to currrent dimension - INTEGER(IntKi) :: J !< Generic counter INTEGER(IntKi) :: Idx !< Generic counter REAL(R8Ki) :: theta(3) !< rotation about z for the current body (0 about x,y) REAL(R8Ki) :: orientation(3,3) !< Orientation matrix for orientation of the current body @@ -241,10 +230,10 @@ SUBROUTINE WAMIT2_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Ini TYPE(W2_SumData_Type) :: SumQTFData !< Data storage for the full sum QTF method ! Force arrays - REAL(SiKi), ALLOCATABLE :: MnDriftForce(:) !< MnDrift force array. Constant for all time. First index is force component - REAL(SiKi), ALLOCATABLE :: NewmanAppForce(:,:) !< NewmanApp force array. Index 1: Time, Index 2: force component - REAL(SiKi), ALLOCATABLE :: DiffQTFForce(:,:) !< DiffQTF force array. Index 1: Time, Index 2: force component - REAL(SiKi), ALLOCATABLE :: SumQTFForce(:,:) !< SumQTF force array. Index 1: Time, Index 2: force component + REAL(SiKi), ALLOCATABLE :: MnDriftForce(:,:) !< MnDrift force array. Constant for all time. Index 1: platform heading, Index 2: force component + REAL(SiKi), ALLOCATABLE :: NewmanAppForce(:,:,:) !< NewmanApp force array. Index 1: Time, Index 2: platform heading, Index 3: force component + REAL(SiKi), ALLOCATABLE :: DiffQTFForce(:,:) !< DiffQTF force array. Index 1: Time, Index 2: force component + REAL(SiKi), ALLOCATABLE :: SumQTFForce(:,:) !< SumQTF force array. Index 1: Time, Index 2: force component ! Temporary error trapping variables INTEGER(IntKi) :: ErrStatTmp !< Temporary variable for holding the error status returned from a CALL statement @@ -257,9 +246,7 @@ SUBROUTINE WAMIT2_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Ini !> Initialize Error handling variables ErrStat = ErrID_None - ErrStatTmp = ErrID_None ErrMsg = "" - ErrMsgTmp = "" !> Initialize the data storage @@ -279,12 +266,6 @@ SUBROUTINE WAMIT2_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Ini SumQTFData%Filename = '' - !> Initialize the NWTC Subroutine Library and display the information about this module. - - CALL NWTC_Init() ! WAMIT2_ProgDesc%Name, '('//WAMIT2_ProgDesc%Ver//','//WAMIT2_ProgDesc%Date//')', EchoLibVer = .FALSE. ) - - - !----------------------------------------------------------------------------- !> Before attempting to do any real calculations, we first check what was !! passed in through _InitInp_ to make sure it makes sense. That routine will @@ -298,10 +279,10 @@ SUBROUTINE WAMIT2_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Ini !------------------------------------------------------------------------------------------------------------- !> 1. Check the data file related values (_MnDrift_, _MnDriftF_ etc). Also copy over important things from _InitInp_ to _p_ and _InitOut_. - CALL CheckInitInput( InitInp, Interval, InitOut, p, MnDriftData, NewmanAppData, DiffQTFData, SumQTFData, ErrStatTmp, ErrMsgTmp ) + CALL CheckInitInput( InitInp, p, MnDriftData, NewmanAppData, DiffQTFData, SumQTFData, ErrStatTmp, ErrMsgTmp ) CALL SetErrStat( ErrStatTmp, ErrMsgTmp, ErrStat, ErrMsg, RoutineName) IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp + CALL CleanUp() RETURN ENDIF @@ -325,7 +306,7 @@ SUBROUTINE WAMIT2_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Ini 'CheckInitInput subroutine.', ErrStat, ErrMsg, RoutineName ) ENDIF IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp + CALL CleanUp() RETURN ENDIF ENDIF @@ -345,7 +326,7 @@ SUBROUTINE WAMIT2_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Ini 'CheckInitInput subroutine.', ErrStat, ErrMsg, RoutineName ) ENDIF IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp + CALL CleanUp() RETURN ENDIF ENDIF @@ -367,7 +348,7 @@ SUBROUTINE WAMIT2_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Ini 'CheckInitInput subroutine.', ErrStat, ErrMsg, RoutineName ) ENDIF IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp + CALL CleanUp() RETURN ENDIF ENDIF @@ -384,7 +365,7 @@ SUBROUTINE WAMIT2_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Ini 'CheckInitInput subroutine.', ErrStat, ErrMsg, RoutineName ) ENDIF IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp + CALL CleanUp() RETURN ENDIF ENDIF @@ -423,7 +404,7 @@ SUBROUTINE WAMIT2_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Ini CALL SetErrStat( ErrID_Fatal, ' Programming error. MnDrift flag is set, but no data has been read in.',ErrStat,ErrMsg, RoutineName) ENDIF IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp + CALL CleanUp() RETURN ENDIF ENDIF @@ -457,7 +438,7 @@ SUBROUTINE WAMIT2_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Ini CALL SetErrStat( ErrID_Fatal, ' Programming error. NewmanApp flag is set, but no data has been read in.',ErrStat,ErrMsg, RoutineName) ENDIF IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp + CALL CleanUp() RETURN ENDIF ENDIF @@ -480,7 +461,7 @@ SUBROUTINE WAMIT2_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Ini CALL SetErrStat( ErrID_Fatal, ' Programming error. DiffQTF flag is set, but no data has been read in.',ErrStat,ErrMsg, RoutineName) ENDIF IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp + CALL CleanUp() RETURN ENDIF ENDIF @@ -503,7 +484,7 @@ SUBROUTINE WAMIT2_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Ini CALL SetErrStat( ErrID_Fatal, ' Programming error. SumQTF flag is set, but no data has been read in.',ErrStat,ErrMsg, RoutineName) ENDIF IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp + CALL CleanUp() RETURN ENDIF ENDIF @@ -547,7 +528,7 @@ SUBROUTINE WAMIT2_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Ini CALL MnDrift_InitCalc( InitInp, p, MnDriftData, MnDriftForce, ErrMsgTmp, ErrStatTmp ) CALL SetErrStat( ErrStatTmp, ErrMsgTmp, ErrStat, ErrMsg, RoutineName ) IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp + CALL CleanUp() RETURN ENDIF ENDIF @@ -561,7 +542,7 @@ SUBROUTINE WAMIT2_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Ini CALL NewmanApp_InitCalc( InitInp, p, NewmanAppData, NewmanAppForce, ErrMsgTmp, ErrStatTmp ) CALL SetErrStat( ErrStatTmp, ErrMsgTmp, ErrStat, ErrMsg, RoutineName ) IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp + CALL CleanUp() RETURN ENDIF ENDIF @@ -577,7 +558,7 @@ SUBROUTINE WAMIT2_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Ini CALL DiffQTF_InitCalc( InitInp, p, DiffQTFData, DiffQTFForce, ErrMsgTmp, ErrStatTmp ) CALL SetErrStat( ErrStatTmp, ErrMsgTmp, ErrStat, ErrMsg, RoutineName ) IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp + CALL CleanUp() RETURN ENDIF ENDIF @@ -591,7 +572,7 @@ SUBROUTINE WAMIT2_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Ini CALL SumQTF_InitCalc( InitInp, p, SumQTFData, SumQTFForce, ErrMsgTmp, ErrStatTmp ) CALL SetErrStat( ErrStatTmp, ErrMsgTmp, ErrStat, ErrMsg, RoutineName ) IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp + CALL CleanUp() RETURN ENDIF ENDIF @@ -601,40 +582,41 @@ SUBROUTINE WAMIT2_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Ini !> Copy output forces over to parameters as needed. !---------------------------------------------------------------------- - ! Initialize the second order force to zero. - p%WaveExctn2 = 0.0_SiKi + ! Initialize the second order force to zero. (Currently the second and third indices, x and y, are not used, but the dimensions are maintained for consistency with first-order wave excitation and future use.) + p%WaveExctn2Grid = 0.0_SiKi ! Difference method data. Only one difference method can be calculated at a time. IF ( p%MnDriftF ) THEN - - DO IBody=1,p%NBody ! Loop through load components. Set ones that are calculated. - DO ThisDim=1,6 - Idx = (IBody-1)*6+ThisDim - IF ( p%MnDriftDims(ThisDim) ) THEN - p%WaveExctn2(:,Idx) = MnDriftForce(Idx) - ENDIF + DO iHdg = 1,p%NExctnHdg+1 + DO IBody=1,p%NBody ! Loop through load components. Set ones that are calculated. + DO ThisDim=1,6 + Idx = (IBody-1)*6+ThisDim + IF ( p%MnDriftDims(ThisDim) ) THEN + p%WaveExctn2Grid(:,1,1,iHdg,Idx) = MnDriftForce(iHdg,Idx) + ENDIF + ENDDO ENDDO ENDDO ELSE IF ( p%NewmanAppF ) THEN - - DO IBody=1,p%NBody ! Loop through load components. Set ones that are calculated. - DO ThisDim=1,6 - Idx = (IBody-1)*6+ThisDim - IF ( p%NewmanAppDims(ThisDim) ) THEN - p%WaveExctn2(:,Idx) = NewmanAppForce(:,Idx) - ENDIF + DO iHdg = 1,p%NExctnHdg+1 + DO IBody=1,p%NBody ! Loop through load components. Set ones that are calculated. + DO ThisDim=1,6 + Idx = (IBody-1)*6+ThisDim + IF ( p%NewmanAppDims(ThisDim) ) THEN + p%WaveExctn2Grid(:,1,1,iHdg,Idx) = NewmanAppForce(:,iHdg,Idx) + ENDIF + ENDDO ENDDO ENDDO - ELSE IF ( p%DiffQTFF ) THEN - DO IBody=1,p%NBody ! Loop through load components. Set ones that are calculated. + DO IBody=1,p%NBody ! Loop through load components. Set ones that are calculated. Multiple headings not supported. DO ThisDim=1,6 Idx = (IBody-1)*6+ThisDim IF ( p%DiffQTFDims(ThisDim) ) THEN - p%WaveExctn2(:,Idx) = DiffQTFForce(:,Idx) + p%WaveExctn2Grid(:,1,1,1,Idx) = DiffQTFForce(:,Idx) ENDIF ENDDO ENDDO @@ -645,11 +627,11 @@ SUBROUTINE WAMIT2_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Ini ! Summation method IF ( p%SumQTFF ) THEN - DO IBody=1,p%NBody ! Loop through load components. Set ones that are calculated. + DO IBody=1,p%NBody ! Loop through load components. Set ones that are calculated. Multiple headings not supported. DO ThisDim=1,6 Idx = (IBody-1)*6+ThisDim IF ( p%SumQTFDims(ThisDim) ) THEN - p%WaveExctn2(:,Idx) = p%WaveExctn2(:,Idx) + SumQTFForce(:,Idx) + p%WaveExctn2Grid(:,1,1,1,Idx) = p%WaveExctn2Grid(:,1,1,1,Idx) + SumQTFForce(:,Idx) ENDIF ENDDO ENDDO @@ -659,6 +641,7 @@ SUBROUTINE WAMIT2_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Ini ! Deallocate the force arrays since we are done with them. Note that the MnDrift force array is ! not deallocated since it is not time dependent. + IF (ALLOCATED(MnDriftForce)) DEALLOCATE(MnDriftForce) IF (ALLOCATED(NewmanAppForce)) DEALLOCATE(NewmanAppForce) IF (ALLOCATED(DiffQTFForce)) DEALLOCATE(DiffQTFForce) IF (ALLOCATED(SumQTFForce)) DEALLOCATE(SumQTFForce) @@ -672,21 +655,17 @@ SUBROUTINE WAMIT2_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Ini !---------------------------------------------------------------------- ! Create the input and output meshes associated with lumped loads - CALL MeshCreate( BlankMesh = u%Mesh , & - IOS = COMPONENT_INPUT , & + CALL MeshCreate( BlankMesh = y%Mesh , & + IOS = COMPONENT_OUTPUT , & Nnodes = p%NBody , & ErrStat = ErrStatTmp , & ErrMess = ErrMsgTmp , & - TranslationDisp = .TRUE. , & - Orientation = .TRUE. , & - TranslationVel = .TRUE. , & - RotationVel = .TRUE. , & - TranslationAcc = .FALSE. , & - RotationAcc = .FALSE.) + Force = .TRUE. , & + Moment = .TRUE.) CALL SetErrStat( ErrStatTmp, ErrMsgTmp, ErrStat, ErrMsg, RoutineName) IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp + CALL CleanUp() RETURN END IF @@ -698,32 +677,22 @@ SUBROUTINE WAMIT2_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Ini XYZloc = (/InitInp%PtfmRefxt(IBody), InitInp%PtfmRefyt(IBody), InitInp%PtfmRefzt(IBody)/) ! Create the node on the mesh - CALL MeshPositionNode (u%Mesh, IBody, XYZloc, ErrStatTmp, ErrMsgTmp, orientation ) + CALL MeshPositionNode (y%Mesh, IBody, XYZloc, ErrStatTmp, ErrMsgTmp, orientation ) CALL SetErrStat( ErrStatTmp, ErrMsgTmp, ErrStat, ErrMsg, RoutineName) ! Create the mesh element - CALL MeshConstructElement ( u%Mesh, ELEMENT_POINT, ErrStatTmp, ErrMsgTmp, IBody ) + CALL MeshConstructElement ( y%Mesh, ELEMENT_POINT, ErrStatTmp, ErrMsgTmp, IBody ) CALL SetErrStat( ErrStatTmp, ErrMsgTmp, ErrStat, ErrMsg, RoutineName) ENDDO - CALL MeshCommit ( u%Mesh, ErrStatTmp, ErrMsgTmp ) - CALL SetErrStat( ErrStatTmp, ErrMsgTmp, ErrStat, ErrMsg, RoutineName) - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp - RETURN - END IF - - - CALL MeshCopy( SrcMesh=u%Mesh, DestMesh=y%Mesh, CtrlCode=MESH_SIBLING, IOS=COMPONENT_OUTPUT, & - ErrStat=ErrStatTmp, ErrMess=ErrMsgTmp, Force=.TRUE., Moment=.TRUE. ) + CALL MeshCommit ( y%Mesh, ErrStatTmp, ErrMsgTmp ) CALL SetErrStat( ErrStatTmp, ErrMsgTmp, ErrStat, ErrMsg, RoutineName) IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp + CALL CleanUp() RETURN END IF - u%Mesh%RemapFlag = .TRUE. y%Mesh%RemapFlag = .TRUE. @@ -731,19 +700,14 @@ SUBROUTINE WAMIT2_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Ini !> 6. Set zero values for unused outputs. This is mostly so that the !! compiler does not complain. Also set misc vars !---------------------------------------------------------------------- - x%DummyContState = 0.0_SiKi - xd%DummyDiscState = 0.0_SiKi - z%DummyConstrState = 0.0_SiKi CALL AllocAry( m%LastIndWave, p%NBody, 'm%LastIndWave', ErrStatTmp, ErrMsgTmp) CALL SetErrStat( ErrStatTmp, ErrMsgTmp, ErrStat, ErrMsg, RoutineName) m%LastIndWave = 1_IntKi call AllocAry(m%F_Waves2, 6*p%NBody, 'm%F_Waves2', ErrStatTmp, ErrMsgTmp) CALL SetErrStat( ErrStatTmp, ErrMsgTmp, ErrStat, ErrMsg, RoutineName) - OtherState%DummyOtherState = 0 - ! Cleanup remaining stuff - CALL CleanUp + CALL CleanUp() RETURN @@ -755,6 +719,11 @@ SUBROUTINE WAMIT2_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Ini !------------------------------------------------------------------------------------------------------------------------------- SUBROUTINE CleanUp() + IF (ALLOCATED(MnDriftForce)) DEALLOCATE(MnDriftForce) + IF (ALLOCATED(NewmanAppForce)) DEALLOCATE(NewmanAppForce) + IF (ALLOCATED(DiffQTFForce)) DEALLOCATE(DiffQTFForce) + IF (ALLOCATED(SumQTFForce)) DEALLOCATE(SumQTFForce) + CALL Destroy_InitData3D( MnDriftData%Data3D ) CALL Destroy_InitData4D( MnDriftData%Data4D ) CALL Destroy_InitData3D( NewmanAppData%Data3D ) @@ -765,7 +734,7 @@ SUBROUTINE CleanUp() END SUBROUTINE CleanUp - +END SUBROUTINE WAMIT2_Init !------------------------------------------------------------------------------------------------------------------------------- @@ -811,7 +780,7 @@ SUBROUTINE MnDrift_InitCalc( InitInp, p, MnDriftData, MnDriftForce, ErrMsg, ErrS TYPE(WAMIT2_InitInputType), INTENT(IN ) :: InitInp !< Input data for initialization routine TYPE(WAMIT2_ParameterType), INTENT(IN ) :: p !< Parameters TYPE(W2_DiffData_Type), INTENT(INOUT) :: MnDriftData !< Data storage for the MnDrift method. Set to INOUT in case we need to convert 4D to 3D - REAL(SiKi), ALLOCATABLE, INTENT( OUT) :: MnDriftForce(:) !< Force data. Index 1 is the force component. Constant for all time. + REAL(SiKi), ALLOCATABLE, INTENT( OUT) :: MnDriftForce(:,:) !< Force data. Index 1 is platform heading and Index 2 is the force component. Constant for all time. CHARACTER(*), INTENT( OUT) :: ErrMsg INTEGER(IntKi), INTENT( OUT) :: ErrStat @@ -826,6 +795,8 @@ SUBROUTINE MnDrift_InitCalc( InitInp, p, MnDriftData, MnDriftForce, ErrMsg, ErrS INTEGER(IntKi) :: Idx !< Index to the full set of 6*NBody INTEGER(IntKi) :: J !< Generic counter ! INTEGER(IntKi) :: K !< Generic counter + INTEGER(IntKi) :: iHdg !< Heading counter + REAL(ReKi) :: PRPHdg !< PRP heading angle CHARACTER(*), PARAMETER :: RoutineName = 'MnDrift_InitCalc' @@ -843,236 +814,68 @@ SUBROUTINE MnDrift_InitCalc( InitInp, p, MnDriftData, MnDriftForce, ErrMsg, ErrS REAL(SiKi) :: Coord4(4) !< The (omega1,omega2,beta1,beta2) coordinate we want in the 4D dataset COMPLEX(SiKi),ALLOCATABLE :: TmpData3D(:,:,:) !< Temporary 3D array we put the 3D data into (minus the load component indice) COMPLEX(SiKi),ALLOCATABLE :: TmpData4D(:,:,:,:) !< Temporary 4D array we put the 4D data into (minus the load component indice) - + REAL(SiKi) :: W2WvDir1Range(2) !< Range of the first wave heading in the WAMIT second-order files + REAL(SiKi) :: W2WvDir2Range(2) !< Range of the second wave heading in the WAMIT second-order files + REAL(SiKi) :: tmpDir + LOGICAL :: dirInRange ! Initialize a few things ErrMsg = '' - ErrMsgTmp = '' ErrStat = ErrID_None - ErrStatTmp = ErrID_None ! Initialize resulting forces - ALLOCATE( MnDriftForce(6*p%NBody), STAT=ErrStatTmp ) + ALLOCATE( MnDriftForce(p%NExctnHdg+1,6*p%NBody), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) THEN CALL SetErrStat(ErrID_Fatal,' Cannot allocate array for the resulting mean drift force '// & 'of the 2nd order force.',ErrStat, ErrMsg, RoutineName) RETURN ENDIF - MnDriftForce = 0.0_SiKi + MnDriftForce = 0.0_SiKi ! initialize this subroutine return value !> 1. Check the data to see if low cutoff on the difference frequency is 0. If it is above zero, that implies no mean drift !! term since \f$ \omega_1=\omega_2 \f$ - IF ( InitInp%WvLowCOffD > 0.0_SiKi ) THEN + IF ( InitInp%WaveField%WvLowCOffD > 0.0_SiKi ) THEN CALL SetErrStat( ErrID_Warn, ' WvLowCOffD > 0.0, so no mean drift term is calculated (the mean drift uses only the equal '//& 'frequency terms of the QTF). Setting the mean drift force to 0.',ErrStat,ErrMsg,RoutineName) - MnDriftForce = 0.0_SiKi RETURN ENDIF - - - !> 2. Check the data to see if the wave frequencies are present in the QTF data. Since the mean drift term only uses - !! frequencies where \f$ \omega_1=\omega_2 \f$, the data read in from the files must contain the full range of frequencies - !! present in the waves. - - IF ( MnDriftData%DataIs3D ) THEN - - ! Check the low frequency cutoff - IF ( MINVAL( MnDriftData%Data3D%WvFreq1 ) > InitInp%WvLowCOffD ) THEN - CALL SetErrStat( ErrID_Fatal,' The lowest frequency ( '//TRIM(Num2LStr(MINVAL(MnDriftData%Data3D%WvFreq1)))// & - ' rad/s for first wave period) data in '//TRIM(MnDriftData%Filename)// & - ' is above the low frequency cutoff set by WvLowCOffD.',ErrStat,ErrMsg,RoutineName) - ENDIF - - ! Check the high frequency cutoff -- using the Difference high frequency cutoff. The first order high frequency - ! cutoff is typically too high for this in most cases. - IF ( (MAXVAL(MnDriftData%Data3D%WvFreq1 ) < InitInp%WvHiCOffD) ) THEN - CALL SetErrStat( ErrID_Fatal,' The highest frequency ( '//TRIM(Num2LStr(MAXVAL(MnDriftData%Data3D%WvFreq1)))// & - ' rad/s for first wave period) data in '//TRIM(MnDriftData%Filename)// & - ' is below the high frequency cutoff set by WvHiCOffD.',ErrStat,ErrMsg,RoutineName) - ENDIF - - ELSE IF ( MnDriftData%DataIs4D ) THEN ! only check if not 3D data. If there is 3D data, we default to using it for calculations - - ! Check the low frequency cutoff - IF ( MINVAL( MnDriftData%Data4D%WvFreq1 ) > InitInp%WvLowCOffD ) THEN - CALL SetErrStat( ErrID_Fatal,' The lowest frequency ( '//TRIM(Num2LStr(MINVAL(MnDriftData%Data4D%WvFreq1)))// & - ' rad/s first wave period) data in '//TRIM(MnDriftData%Filename)// & - ' is above the low frequency cutoff set by WvLowCOff.',ErrStat,ErrMsg,RoutineName) - ENDIF - IF ( MINVAL( MnDriftData%Data4D%WvFreq2 ) > InitInp%WvLowCOff ) THEN - CALL SetErrStat( ErrID_Fatal,' The lowest frequency ( '//TRIM(Num2LStr(MINVAL(MnDriftData%Data4D%WvFreq2)))// & - ' rad/s for second wave period) data in '//TRIM(MnDriftData%Filename)// & - ' is above the low frequency cutoff set by WvLowCOffD.',ErrStat,ErrMsg,RoutineName) - ENDIF - - ! Check the high frequency cutoff -- using the Difference high frequency cutoff. The first order high frequency - ! cutoff is typically too high for this in most cases. - IF ( (MAXVAL(MnDriftData%Data4D%WvFreq1) < InitInp%WvHiCOffD) ) THEN - CALL SetErrStat( ErrID_Fatal,' The highest frequency ( '//TRIM(Num2LStr(MAXVAL(MnDriftData%Data4D%WvFreq1)))// & - ' rad/s for first wave period) data in '//TRIM(MnDriftData%Filename)// & - ' is below the high frequency cutoff set by WvHiCOffD.',ErrStat,ErrMsg,RoutineName) - ENDIF - IF ( (MAXVAL(MnDriftData%Data4D%WvFreq2) < InitInp%WvHiCOffD) ) THEN - CALL SetErrStat( ErrID_Fatal,' The highest frequency ( '//TRIM(Num2LStr(MAXVAL(MnDriftData%Data4D%WvFreq1)))// & - ' rad/s second wave period) data in '//TRIM(MnDriftData%Filename)// & - ' is below the high frequency cutoff set by WvHiCOffD.',ErrStat,ErrMsg,RoutineName) - ENDIF - - ELSE - ! This is a catastrophic issue. We should not have called this routine without data that is usable for the MnDrift calculation - CALL SetErrStat( ErrID_Fatal, ' Mean drift calculation called without data.',ErrStat,ErrMsg,RoutineName) - ENDIF - + CALL GetWAMIT2WvHdgRange(MnDriftData,W2WvDir1Range,W2WvDir2Range,ErrStatTmp,ErrMsgTmp) + CALL SetErrStat(ErrStatTmp,ErrMsgTmp,ErrStat,ErrMsg,RoutineName) IF ( ErrStat >= AbortErrLev ) RETURN - - - !> 3. Check the data to see if the wave directions are present. May need to adjust for the boundary at +/- PI - IF ( MnDriftData%DataIs3D ) THEN - - ! If we are using multidirectional waves, then we should have more than 1 wave direction in the WAMIT file. - IF ( InitInp%WaveMultiDir .AND. (MnDriftData%Data3D%NumWvDir1 == 1) ) THEN - CALL SetErrStat( ErrID_Fatal,' WAMIT output file '//TRIM(MnDriftData%Filename)//' only contains one wave '// & - 'direction at '//TRIM(Num2LStr(MnDriftData%Data3D%WvDir1(1)))//' degrees (first wave direction). '// & - 'It cannot be used with multidirectional waves. Set WvDirMod to 0 to use this file.', & - ErrStat,ErrMsg,RoutineName) - ELSE IF ( InitInp%WaveMultiDir .AND. (MnDriftData%Data3D%NumWvDir2 == 1) ) THEN - CALL SetErrStat( ErrID_Fatal,' WAMIT output file '//TRIM(MnDriftData%Filename)//' only contains one wave '// & - 'direction at '//TRIM(Num2LStr(MnDriftData%Data3D%WvDir2(1)))//' degrees (second wave direction). '// & - 'It cannot be used with multidirectional waves. Set WvDirMod to 0 to use this file.', & - ErrStat,ErrMsg,RoutineName) - ELSE - - ! See Known Issues #1 at the top of this file. There may be problems if the data spans the +/- Pi boundary. For - ! now (since time is limited) we will issue a warning if any of the wave directions for multidirectional waves - ! or data from the WAMIT file for the wavedirections is close to the +/-pi boundary (>150 degrees, <-150 degrees), - ! we will issue a warning. - IF ( (InitInp%WaveDirMin > 150.0_SiKi) .OR. (InitInp%WaveDirMax < -150.0_SiKi) .OR. & - (minval(MnDriftData%data3d%WvDir1) > 150.0_SiKi) .OR. (maxval(MnDriftData%data3d%WvDir1) < -150.0_SiKi) .OR. & - (minval(MnDriftData%data3d%WvDir2) > 150.0_SiKi) .OR. (maxval(MnDriftData%data3d%WvDir2) < -150.0_SiKi) ) THEN - CALL SetErrStat( ErrID_Warn,' There may be issues with how the wave direction data is handled when the wave '// & - 'direction of interest is near the +/- 180 direction. This is a known issue with '// & - 'the WAMIT2 module that has not yet been addressed.',ErrStat,ErrMsg,RoutineName) - ENDIF - - ! Now check the limits for the first wave direction - ! --> FIXME: sometime fix this to handle the above case. See Known Issue #1 at top of file. - IF ( InitInp%WaveDirMin < MINVAL(MnDriftData%Data3D%WvDir1) ) THEN - CALL SetErrStat( ErrID_Fatal,' Minimum wave direction required of '//TRIM(Num2LStr(InitInp%WaveDirMin))//' is not'//& - 'found in the WAMIT data file '//TRIM(MnDriftData%Filename)//' for the first wave direction.', & - ErrStat, ErrMsg, RoutineName) - ENDIF - IF ( InitInp%WaveDirMax > MAXVAL(MnDriftData%Data3D%WvDir1) ) THEN - CALL SetErrStat( ErrID_Fatal,' Maximum wave direction required of '//TRIM(Num2LStr(InitInp%WaveDirMax))//' is not'//& - 'found in the WAMIT data file '//TRIM(MnDriftData%Filename)//' for the first wave direction.', & - ErrStat, ErrMsg, RoutineName) - ENDIF - - - ! Now check the limits for the second wave direction - ! --> FIXME: sometime fix this to handle the above case. See Known Issue #1 at top of file. - IF ( InitInp%WaveDirMin < MINVAL(MnDriftData%Data3D%WvDir2) ) THEN - CALL SetErrStat( ErrID_Fatal,' Minimum wave direction required of '//TRIM(Num2LStr(InitInp%WaveDirMin))//' is not'//& - 'found in the WAMIT data file '//TRIM(MnDriftData%Filename)//' for the second wave direction.', & - ErrStat, ErrMsg, RoutineName) - ENDIF - IF ( InitInp%WaveDirMax > MAXVAL(MnDriftData%Data3D%WvDir2) ) THEN - CALL SetErrStat( ErrID_Fatal,' Maximum wave direction required of '//TRIM(Num2LStr(InitInp%WaveDirMax))//' is not'//& - 'found in the WAMIT data file '//TRIM(MnDriftData%Filename)//' for the second wave direction.', & - ErrStat, ErrMsg, RoutineName) - ENDIF - - ENDIF - - ELSEIF ( MnDriftData%DataIs4D ) THEN - - ! If we are using multidirectional waves, then we should have more than 1 wave direction in the WAMIT file. - IF ( InitInp%WaveMultiDir .AND. (MnDriftData%Data4D%NumWvDir1 == 1) ) THEN - CALL SetErrStat( ErrID_Fatal,' WAMIT output file '//TRIM(MnDriftData%Filename)//' only contains one wave '// & - 'direction at '//TRIM(Num2LStr(MnDriftData%Data4D%WvDir1(1)))//' degrees (first wave direction). '// & - 'It cannot be used with multidirectional waves. Set WvDirMod to 0 to use this file.', & - ErrStat,ErrMsg,RoutineName) - ELSE IF ( InitInp%WaveMultiDir .AND. (MnDriftData%Data4D%NumWvDir2 == 1) ) THEN - CALL SetErrStat( ErrID_Fatal,' WAMIT output file '//TRIM(MnDriftData%Filename)//' only contains one wave '// & - 'direction at '//TRIM(Num2LStr(MnDriftData%Data4D%WvDir2(1)))//' degrees (second wave direction). '// & - 'It cannot be used with multidirectional waves. Set WvDirMod to 0 to use this file.', & - ErrStat,ErrMsg,RoutineName) - ELSE - - ! See Known Issues #1 at the top of this file. There may be problems if the data spans the +/- Pi boundary. For - ! now (since time is limited) we will issue a warning if any of the wave directions for multidirectional waves - ! or data from the WAMIT file for the wavedirections is close to the +/-pi boundary (>150 degrees, <-150 degrees), - ! we will issue a warning. - IF ( (InitInp%WaveDirMin > 150.0_SiKi) .OR. (InitInp%WaveDirMax < -150.0_SiKi) .OR. & - (MINVAL(MnDriftData%Data4D%WvDir1) > 150.0_SiKi) .OR. (MAXVAL(MnDriftData%Data4D%WvDir1) < -150.0_SiKi) .OR. & - (MINVAL(MnDriftData%Data4D%WvDir2) > 150.0_SiKi) .OR. (MAXVAL(MnDriftData%Data4D%WvDir2) < -150.0_SiKi) ) THEN - CALL SetErrStat( ErrID_Warn,' There may be issues with how the wave direction data is handled when the wave '// & - 'direction of interest is near the +/- 180 direction. This is a known issue with '// & - 'the WAMIT2 module that has not yet been addressed.',ErrStat,ErrMsg,RoutineName) - ENDIF - - ! Now check the limits for the first wave direction - ! --> FIXME: sometime fix this to handle the above case. See Known Issue #1 at top of file. - ! --> FIXME: modify to allow shifting values by TwoPi before comparing - IF ( InitInp%WaveDirMin < MINVAL(MnDriftData%Data4D%WvDir1) ) THEN - CALL SetErrStat( ErrID_Fatal,' Minimum wave direction required of '//TRIM(Num2LStr(InitInp%WaveDirMin))//' is not'//& - 'found in the WAMIT data file '//TRIM(MnDriftData%Filename)//' for the first wave direction.', & - ErrStat, ErrMsg, RoutineName) - ENDIF - IF ( InitInp%WaveDirMax > MAXVAL(MnDriftData%Data4D%WvDir1) ) THEN - CALL SetErrStat( ErrID_Fatal,' Maximum wave direction required of '//TRIM(Num2LStr(InitInp%WaveDirMax))//' is not'//& - 'found in the WAMIT data file '//TRIM(MnDriftData%Filename)//' for the first wave direction.', & - ErrStat, ErrMsg, RoutineName) - ENDIF - - - ! Now check the limits for the second wave direction - ! --> FIXME: sometime fix this to handle the above case. See Known Issue #1 at top of file. - IF ( InitInp%WaveDirMin < MINVAL(MnDriftData%Data4D%WvDir2) ) THEN - CALL SetErrStat( ErrID_Fatal,' Minimum wave direction required of '//TRIM(Num2LStr(InitInp%WaveDirMin))//' is not'//& - 'found in the WAMIT data file '//TRIM(MnDriftData%Filename)//' for the second wave direction.', & - ErrStat, ErrMsg, RoutineName) - ENDIF - IF ( InitInp%WaveDirMax > MAXVAL(MnDriftData%Data4D%WvDir2) ) THEN - CALL SetErrStat( ErrID_Fatal,' Maximum wave direction required of '//TRIM(Num2LStr(InitInp%WaveDirMax))//' is not'//& - 'found in the WAMIT data file '//TRIM(MnDriftData%Filename)//' for the second wave direction.', & - ErrStat, ErrMsg, RoutineName) - ENDIF - - ENDIF - - ELSE - ! No data. This is a catastrophic issue. We should not have called this routine without data that is usable for the MnDrift calculation - CALL SetErrStat( ErrID_Fatal, ' Mean drift calculation called without data.',ErrStat,ErrMsg,RoutineName) - ENDIF - + CALL CheckWAMIT2WvHdg(InitInp,MnDriftData,ErrStatTmp,ErrMsgTmp) + CALL SetErrStat(ErrStatTmp,ErrMsgTmp,ErrStat,ErrMsg,RoutineName) IF ( ErrStat >= AbortErrLev ) RETURN - - - + !> 4. Check the data to see if we need to convert to 3D arrays before continuing (4D is sparse in any dimension we want and !! frequency diagonal is complete). Only check if we don't have 3D data. IF ( .NOT. MnDriftData%DataIs3D .AND. MnDriftData%Data4D%WvFreqDiagComplete ) THEN TmpFlag = .FALSE. ! if this goes true, then we need to convert to 3D data DO IBody=1,MnDriftData%Data4D%NumBodies + IF (TmpFlag) EXIT DO ThisDim=1,6 Idx = (IBody-1)*6+ThisDim IF ( p%MnDriftDims(IBody) ) THEN ! Flag indicating which dimension we are calculating for - IF ( MnDriftData%Data4D%DataIsSparse(Idx) .AND. MnDriftData%Data4D%LoadComponents(Idx) ) TmpFlag = .TRUE. + IF ( MnDriftData%Data4D%DataIsSparse(Idx) .AND. MnDriftData%Data4D%LoadComponents(Idx) ) THEN + TmpFlag = .TRUE. + EXIT ! inner DO + END IF ENDIF ENDDO ENDDO ! If we need to create the 3D data set, then - CALL Copy_InitData4Dto3D( MnDriftData%Data4D, MnDriftData%Data3D, ErrStatTmp, ErrMsgTmp ) - CALL SetErrStat(ErrStatTmp,ErrMsgTmp,ErrStat,ErrMsg,RoutineName) - IF (ErrStat >= AbortErrLev) RETURN + IF (TmpFlag) THEN + CALL Copy_InitData4Dto3D( MnDriftData%Data4D, MnDriftData%Data3D, ErrStatTmp, ErrMsgTmp ) + CALL SetErrStat(ErrStatTmp,ErrMsgTmp,ErrStat,ErrMsg,RoutineName) + IF (ErrStat >= AbortErrLev) RETURN - MnDriftData%DataIs3D = .TRUE. ! Set flag to indicate we now have the 3D data. + MnDriftData%DataIs3D = .TRUE. ! Set flag to indicate we now have the 3D data. + END IF ! TmpFlag ENDIF @@ -1086,16 +889,24 @@ SUBROUTINE MnDrift_InitCalc( InitInp, p, MnDriftData, MnDriftForce, ErrMsg, ErrS TmpFlag = .FALSE. IF ( MnDriftData%DataIs3D ) THEN DO IBody=1,MnDriftData%Data3D%NumBodies + IF (TmpFlag) EXIT DO ThisDim=1,6 Idx = (IBody-1)*6+ThisDim - IF ( MnDriftData%Data3D%DataIsSparse(Idx) .AND. MnDriftData%Data3D%LoadComponents(Idx) .AND. p%MnDriftDims(ThisDim) ) TmpFlag = .TRUE. + IF ( MnDriftData%Data3D%DataIsSparse(Idx) .AND. MnDriftData%Data3D%LoadComponents(Idx) .AND. p%MnDriftDims(ThisDim) ) THEN + TmpFlag = .TRUE. + EXIT + END IF ENDDO ENDDO ELSE ! must be 4D -- we checked that we had something at the start of this routine. DO IBody=1,MnDriftData%Data4D%NumBodies + IF (TmpFlag) EXIT DO ThisDim=1,6 Idx = (IBody-1)*6+ThisDim - IF ( MnDriftData%Data4D%DataIsSparse(Idx) .AND. MnDriftData%Data4D%LoadComponents(Idx) .AND. p%MnDriftDims(ThisDim) ) TmpFlag = .TRUE. + IF ( MnDriftData%Data4D%DataIsSparse(Idx) .AND. MnDriftData%Data4D%LoadComponents(Idx) .AND. p%MnDriftDims(ThisDim) ) THEN + TmpFlag = .TRUE. + EXIT + END IF ENDDO ENDDO ENDIF @@ -1127,34 +938,25 @@ SUBROUTINE MnDrift_InitCalc( InitInp, p, MnDriftData, MnDriftForce, ErrMsg, ErrS ! If something went wrong during allocation of the temporary arrays... IF ( ErrStat >= AbortErrLev ) THEN - IF (ALLOCATED(TmpData3D)) DEALLOCATE(TmpData3D,STAT=ErrStatTmp) - IF (ALLOCATED(TmpData4D)) DEALLOCATE(TmpData4D,STAT=ErrStatTmp) + call cleanup() RETURN ENDIF - ! Now loop through all the dimensions and perform the calculation + ! Now loop through all the dimensions and compute the mean-drift load for each body in the body-local coordinate system DO IBody=1,p%NBody - ! Heading correction, only applies to NBodyMod == 2 + ! Wave-heading correction, only applies to NBodyMod == 2 if (p%NBodyMod==2) then RotateZdegOffset = InitInp%PtfmRefztRot(IBody)*R2D else RotateZdegOffset = 0.0_SiKi endif - ! NOTE: RotateZMatrixT is the rotation from local to global. - RotateZMatrixT(:,1) = (/ cos(InitInp%PtfmRefztRot(IBody)), -sin(InitInp%PtfmRefztRot(IBody)) /) - RotateZMatrixT(:,2) = (/ sin(InitInp%PtfmRefztRot(IBody)), cos(InitInp%PtfmRefztRot(IBody)) /) - - DO ThisDim=1,6 Idx = (IBody-1)*6 + ThisDim - ! Set the MnDrift force to 0.0 (Even ones we don't calculate) - MnDriftForce(Idx) = 0.0_SiKi - IF (MnDriftData%DataIs3D) THEN TmpFlag = MnDriftData%Data3D%LoadComponents(Idx) ELSE @@ -1175,109 +977,139 @@ SUBROUTINE MnDrift_InitCalc( InitInp, p, MnDriftData, MnDriftForce, ErrMsg, ErrS TmpData4D = MnDriftData%Data4D%DataSet(:,:,:,:,Idx) END IF - - DO J=1,InitInp%NStepWave2 + DO iHdg = 1,p%NExctnHdg+1 + ! Compute the PRP heading angle + IF (p%PtfmYMod .EQ. 0) THEN + PRPHdg = InitInp%PtfmRefY + ELSE IF (p%PtfmYMod .EQ. 1) THEN + PRPHdg = -PI + (iHdg-1) * TwoPi/REAL(p%NExctnHdg,ReKi) + END IF + DO J=1,InitInp%WaveField%NStepWave2 ! NOTE: since the Mean Drift only returns a static time independent average value for the drift force, we do not ! need to account for any offset in the location of the WAMIT body (this term vanishes). ! First get the wave amplitude -- must be reconstructed from the WaveElevC0 array. First index is the real (1) or ! imaginary (2) part. Divide by NStepWave2 to remove the built in normalization in WaveElevC0. - aWaveElevC = CMPLX( InitInp%WaveElevC0(1,J), InitInp%WaveElevC0(2,J), SiKi) / InitInp%NStepWave2 + aWaveElevC = CMPLX( InitInp%WaveField%WaveElevC0(1,J), InitInp%WaveField%WaveElevC0(2,J), SiKi) / InitInp%WaveField%NStepWave2 ! Calculate the frequency - Omega1 = J * InitInp%WaveDOmega + Omega1 = J * InitInp%WaveField%WaveDOmega ! Only get a QTF value if within the range of frequencies we have wave amplitudes for (first order cutoffs). This - ! is done only for efficiency. - IF ( (Omega1 >= InitInp%WvLowCOff) .AND. (Omega1 <= InitInp%WvHiCOff) ) THEN + ! is done only for efficiency. + + IF ( (Omega1 >= InitInp%WaveField%WvLowCOff) .AND. (Omega1 <= InitInp%WaveField%WvHiCOff) ) THEN ! Now get the QTF value that corresponds to this frequency and wavedirection pair. - IF ( MnDriftData%DataIs3D ) THEN + IF ( MnDriftData%DataIs3D ) THEN ! Set the (omega1,beta1,beta2) point we are looking for. (angles in degrees here) - Coord3 = (/ REAL(Omega1,SiKi), InitInp%WaveDirArr(J), InitInp%WaveDirArr(J) /) + Coord3 = (/ REAL(Omega1,SiKi), InitInp%WaveField%WaveDirArr(J), InitInp%WaveField%WaveDirArr(J) /) ! Apply local Z rotation to heading angle (degrees) to put wave direction into the local (rotated) body frame - Coord3(2) = Coord3(2) - RotateZdegOffset - Coord3(3) = Coord3(3) - RotateZdegOffset + Coord3(2) = Coord3(2) - RotateZdegOffset - PRPHdg*R2D + Coord3(3) = Coord3(3) - RotateZdegOffset - PRPHdg*R2D + + ! Make sure the wave headings are in the correct range + dirInRange = GetAngleInRange(Coord3(2),W2WvDir1Range(1),W2WvDir1Range(2),tmpDir); Coord3(2) = tmpDir + dirInRange = GetAngleInRange(Coord3(3),W2WvDir2Range(1),W2WvDir2Range(2),tmpDir); Coord3(3) = tmpDir + IF (.NOT. dirInRange) THEN ! Somewhat redundant check. Can be removed in the future. + CALL SetErrStat(ErrID_Fatal,' Wave heading out of range.', ErrStat, ErrMsg, RoutineName) + END IF ! get the interpolated value for F(omega1,beta1,beta2) - CALL WAMIT_Interp3D_Cplx( Coord3, TmpData3D, MnDriftData%Data3D%WvFreq1, & + CALL WAMIT_Interp3D_Cplx( Coord3, TmpData3D, MnDriftData%Data3D%WvFreq1, & MnDriftData%Data3D%WvDir1, MnDriftData%Data3D%WvDir2, LastIndex3, QTF_Value, ErrStatTmp, ErrMsgTmp ) + CALL SetErrStat(ErrStatTmp, ErrMsgTmp, ErrStat, ErrMsg, RoutineName) - ELSE + ELSE ! Set the (omega1,omega2,beta1,beta2) point we are looking for. (angles in degrees here) - Coord4 = (/ REAL(Omega1,SiKi), REAL(Omega1,SiKi), InitInp%WaveDirArr(J), InitInp%WaveDirArr(J) /) + Coord4 = (/ REAL(Omega1,SiKi), REAL(Omega1,SiKi), InitInp%WaveField%WaveDirArr(J), InitInp%WaveField%WaveDirArr(J) /) ! Apply local Z rotation to heading angle (degrees) to put wave direction into the local (rotated) body frame - Coord4(3) = Coord4(3) - RotateZdegOffset - Coord4(4) = Coord4(4) - RotateZdegOffset + Coord4(3) = Coord4(3) - RotateZdegOffset - PRPHdg*R2D + Coord4(4) = Coord4(4) - RotateZdegOffset - PRPHdg*R2D + + ! Make sure the wave headings are in the correct range + dirInRange = GetAngleInRange(Coord4(3),W2WvDir1Range(1),W2WvDir1Range(2),tmpDir); Coord4(3) = tmpDir + dirInRange = GetAngleInRange(Coord4(4),W2WvDir2Range(1),W2WvDir2Range(2),tmpDir); Coord4(4) = tmpDir + IF (.NOT. dirInRange) THEN ! Somewhat redundant check. Can be removed in the future. + CALL SetErrStat(ErrID_Fatal,' Wave heading out of range.', ErrStat, ErrMsg, RoutineName) + END IF ! get the interpolated value for F(omega1,omega2,beta1,beta2) - CALL WAMIT_Interp4D_Cplx( Coord4, TmpData4D, MnDriftData%Data4D%WvFreq1, MnDriftData%Data4D%WvFreq2, & + CALL WAMIT_Interp4D_Cplx( Coord4, TmpData4D, MnDriftData%Data4D%WvFreq1, MnDriftData%Data4D%WvFreq2, & MnDriftData%Data4D%WvDir1, MnDriftData%Data4D%WvDir2, LastIndex4, QTF_Value, ErrStatTmp, ErrMsgTmp ) + CALL SetErrStat(ErrStatTmp, ErrMsgTmp, ErrStat, ErrMsg, RoutineName) - ENDIF !QTF value find + ENDIF !QTF value find - ELSE ! outside the frequency range + ELSE ! outside the frequency range - QTF_Value = CMPLX(0.0,0.0,SiKi) + QTF_Value = CMPLX(0.0,0.0,SiKi) - ENDIF ! frequency check + ENDIF ! frequency check ! Check and make sure nothing bombed in the interpolation that we need to be aware of - CALL SetErrStat(ErrStatTmp,ErrMsgTmp,ErrStat,ErrMsg,RoutineName) - IF ( ErrStat >= AbortErrLev ) THEN - IF (ALLOCATED(TmpData3D)) DEALLOCATE(TmpData3D,STAT=ErrStatTmp) - IF (ALLOCATED(TmpData4D)) DEALLOCATE(TmpData4D,STAT=ErrStatTmp) - RETURN - ENDIF + IF ( ErrStat >= AbortErrLev ) THEN + call cleanup() + RETURN + ENDIF ! Now we have the value of the QTF. These values should only be real for the omega1=omega2 case of the mean drift. ! However if the value came from the 4D interpolation routine, it might have some residual complex part to it. So ! we throw the complex part out. - QTF_Value = CMPLX(REAL(QTF_Value,SiKi),0.0,SiKi) + QTF_Value = CMPLX(REAL(QTF_Value,SiKi),0.0,SiKi) ! NOTE: any offset in platform location vanishes when the only the REAL part is kept (the offset resides in the ! phase shift, which is in the imaginary part) ! Now put it all together... note the frequency stepsize is multiplied after the summation - MnDriftForce(Idx) = MnDriftForce(Idx) + REAL(QTF_Value * aWaveElevC * CONJG(aWaveElevC)) !bjj: put QTF_Value first so that if it's zero, the rest gets set to zero (to hopefully avoid overflow issues) - - ENDDO ! NStepWave2 + MnDriftForce(iHdg,Idx) = MnDriftForce(iHdg,Idx) + REAL(QTF_Value * aWaveElevC * CONJG(aWaveElevC)) !bjj: put QTF_Value first so that if it's zero, the rest gets set to zero (to hopefully avoid overflow issues) + ENDDO ! NStepWave2 + ENDDO ! NExctnHdg ENDIF ! Load component to calculate - ENDDO ! ThisDim -- Load Component on body + ! Rotate the loads back to the i-frame + DO iHdg = 1,p%NExctnHdg+1 + ! Compute the PRP heading angle + IF (p%PtfmYMod .EQ. 0) THEN + PRPHdg = InitInp%PtfmRefY + ELSE IF (p%PtfmYMod .EQ. 1) THEN + PRPHdg = -PI + (iHdg-1) * TwoPi/REAL(p%NExctnHdg,ReKi) + END IF + ! Correct for body rotation (applies to all NBodyMod because WAMIT always output loads in the body frame) and heading change + ! NOTE: RotateZMatrixT is the rotation from local to global. + RotateZMatrixT(1,:) = (/ cos(InitInp%PtfmRefztRot(IBody)+PRPHdg), -sin(InitInp%PtfmRefztRot(IBody)+PRPHdg) /) + RotateZMatrixT(2,:) = (/ sin(InitInp%PtfmRefztRot(IBody)+PRPHdg), cos(InitInp%PtfmRefztRot(IBody)+PRPHdg) /) ! Now rotate the force components with platform orientation - MnDriftForce(1:2) = MATMUL( RotateZMatrixT, MnDriftForce(1:2) ) ! Fx and Fy, rotation about z - MnDriftForce(4:5) = MATMUL( RotateZMatrixT, MnDriftForce(4:5) ) ! Mx and My, rotation about z + Idx = (IBody-1)*6 + MnDriftForce(iHdg,(Idx+1):(Idx+2)) = MATMUL( RotateZMatrixT, MnDriftForce(iHdg,(Idx+1):(Idx+2)) ) ! Fx and Fy, rotation about z + MnDriftForce(iHdg,(Idx+4):(Idx+5)) = MATMUL( RotateZMatrixT, MnDriftForce(iHdg,(Idx+4):(Idx+5)) ) ! Mx and My, rotation about z + ENDDO ! NExctnHdg ENDDO ! IBody - - ! Cleanup - - IF (ALLOCATED(TmpData3D)) DEALLOCATE(TmpData3D,STAT=ErrStatTmp) - IF (ALLOCATED(TmpData4D)) DEALLOCATE(TmpData4D,STAT=ErrStatTmp) + call cleanup() + + CONTAINS + subroutine cleanup() + IF (ALLOCATED(TmpData3D)) DEALLOCATE(TmpData3D,STAT=ErrStatTmp) + IF (ALLOCATED(TmpData4D)) DEALLOCATE(TmpData4D,STAT=ErrStatTmp) + end subroutine cleanup END SUBROUTINE MnDrift_InitCalc - - - - - - !------------------------------------------------------------------------------------------------------------------------------- !> This subroutine calculates the force time series using the NewmanApp calculation. !! The data is stored in either 3D or 4D arrays depending on the file type used. @@ -1331,7 +1163,7 @@ SUBROUTINE NewmanApp_InitCalc( InitInp, p, NewmanAppData, NewmanAppForce, ErrMsg TYPE(WAMIT2_InitInputType), INTENT(IN ) :: InitInp !< Input data for initialization routine TYPE(WAMIT2_ParameterType), INTENT(IN ) :: p !< Parameters TYPE(W2_DiffData_Type), INTENT(INOUT) :: NewmanAppData !< Data storage for the NewmanApp method. Set to INOUT in case we need to convert 4D to 3D - REAL(SiKi), ALLOCATABLE, INTENT( OUT) :: NewmanAppForce(:,:) !< Force data. Index 1 is the timestep, index 2 is the load component. + REAL(SiKi), ALLOCATABLE, INTENT( OUT) :: NewmanAppForce(:,:,:) !< Force data. Index 1 is the timestep, index 2 is the platform heading, and index 3 is the load component. CHARACTER(*), INTENT( OUT) :: ErrMsg INTEGER(IntKi), INTENT( OUT) :: ErrStat @@ -1346,14 +1178,16 @@ SUBROUTINE NewmanApp_InitCalc( InitInp, p, NewmanAppData, NewmanAppForce, ErrMsg INTEGER(IntKi) :: Idx !< Index to the full set of 6*NBody INTEGER(IntKi) :: J !< Generic counter ! INTEGER(IntKi) :: K !< Generic counter + INTEGER(IntKi) :: iHdg !< Heading counter + REAL(ReKi) :: PRPHdg !< PRP heading angle TYPE(FFT_DataType) :: FFT_Data !< Temporary array for the FFT module we're using CHARACTER(*), PARAMETER :: RoutineName = 'NewmanApp_InitCalc' ! Wave information and QTF temporary COMPLEX(SiKi) :: QTF_Value !< Temporary complex number for QTF - COMPLEX(SiKi), ALLOCATABLE :: NewmanTerm1C(:,:) !< First term in the newman calculation, complex frequency space. All dimensions, this body. - COMPLEX(SiKi), ALLOCATABLE :: NewmanTerm2C(:,:) !< Second term in the newman calculation, complex frequency space. All dimensions, this body. + COMPLEX(SiKi), ALLOCATABLE :: NewmanTerm1C(:,:,:) !< First term in the newman calculation, complex frequency space. All dimensions, all headings, this body. + COMPLEX(SiKi), ALLOCATABLE :: NewmanTerm2C(:,:,:) !< Second term in the newman calculation, complex frequency space. All dimensions, all headings, this body. COMPLEX(SiKi), ALLOCATABLE :: NewmanTerm1t(:) !< First term in the newman calculation, time domain. Current load dimension. COMPLEX(SiKi), ALLOCATABLE :: NewmanTerm2t(:) !< Second term in the newman calculation, time domain. Current load dimension. COMPLEX(SiKi) :: aWaveElevC !< Wave elevation of current frequency component. NStepWave2 factor removed. @@ -1370,7 +1204,10 @@ SUBROUTINE NewmanApp_InitCalc( InitInp, p, NewmanAppData, NewmanAppForce, ErrMsg REAL(SiKi) :: WaveNmbr1 !< Wavenumber for this frequency COMPLEX(SiKi), ALLOCATABLE :: TmpData3D(:,:,:) !< Temporary 3D array we put the 3D data into (minus the load component indice) COMPLEX(SiKi), ALLOCATABLE :: TmpData4D(:,:,:,:) !< Temporary 4D array we put the 4D data into (minus the load component indice) - + REAL(SiKi) :: W2WvDir1Range(2) !< Range of the first wave heading in the WAMIT second-order files + REAL(SiKi) :: W2WvDir2Range(2) !< Range of the second wave heading in the WAMIT second-order files + REAL(SiKi) :: tmpDir + LOGICAL :: dirInRange ! Initialize a few things ErrMsg = '' @@ -1378,194 +1215,14 @@ SUBROUTINE NewmanApp_InitCalc( InitInp, p, NewmanAppData, NewmanAppForce, ErrMsg ErrStat = ErrID_None ErrStatTmp = ErrID_None - - - !> 1. Check the data to see if the wave frequencies are present in the QTF data. Since Newman's approximation only uses - !! frequencies where \f$ \omega_1=\omega_2 \f$, the data read in from the files must contain the full range of frequencies - !! present in the waves. - - IF ( NewmanAppData%DataIs3D ) THEN - - ! Check the low frequency cutoff - IF ( MINVAL( NewmanAppData%Data3D%WvFreq1 ) > InitInp%WvLowCOff ) THEN - CALL SetErrStat( ErrID_Fatal,' The lowest frequency ( '//TRIM(Num2LStr(MINVAL(NewmanAppData%Data3D%WvFreq1)))// & - ' rad/s for first wave period) data in '//TRIM(NewmanAppData%Filename)// & - ' is above the low frequency cutoff set by WvLowCOff.', & - ErrStat,ErrMsg,RoutineName) - ENDIF - - ! Check the high frequency cutoff -- using the Difference high frequency cutoff. The first order high frequency - ! cutoff is typically too high for this in most cases. - IF ( MAXVAL(NewmanAppData%Data3D%WvFreq1 ) < InitInp%WvHiCOff ) THEN - CALL SetErrStat( ErrID_Fatal,' The highest frequency ( '//TRIM(Num2LStr(MAXVAL(NewmanAppData%Data3D%WvFreq1)))// & - ' rad/s for first wave period) data in '//TRIM(NewmanAppData%Filename)// & - ' is below the high frequency cutoff set by WvHiCOff.', & - ErrStat,ErrMsg,RoutineName) - ENDIF - - ELSE IF ( NewmanAppData%DataIs4D ) THEN ! only check if not 3D data. If there is 3D data, we default to using it for calculations - - ! Check the low frequency cutoff - IF ( MINVAL( NewmanAppData%Data4D%WvFreq1 ) > InitInp%WvLowCOff ) THEN - CALL SetErrStat( ErrID_Fatal,' The lowest frequency ( '//TRIM(Num2LStr(MINVAL(NewmanAppData%Data4D%WvFreq1)))// & - ' rad/s first wave period) data in '//TRIM(NewmanAppData%Filename)// & - ' is above the low frequency cutoff set by WvLowCOff.', & - ErrStat,ErrMsg,RoutineName) - ENDIF - IF ( MINVAL( NewmanAppData%Data4D%WvFreq2 ) > InitInp%WvLowCOff ) THEN - CALL SetErrStat( ErrID_Fatal,' The lowest frequency ( '//TRIM(Num2LStr(MINVAL(NewmanAppData%Data4D%WvFreq2)))// & - ' rad/s for second wave period) data in '//TRIM(NewmanAppData%Filename)// & - ' is above the low frequency cutoff set by WvLowCOff.', & - ErrStat,ErrMsg,RoutineName) - ENDIF - - ! Check the high frequency cutoff -- using the Difference high frequency cutoff. The first order high frequency - ! cutoff is typically too high for this in most cases. - IF ( MAXVAL(NewmanAppData%Data4D%WvFreq1) < InitInp%WvHiCOff ) THEN - CALL SetErrStat( ErrID_Fatal,' The highest frequency ( '//TRIM(Num2LStr(MAXVAL(NewmanAppData%Data4D%WvFreq1)))// & - ' rad/s for first wave period) data in '//TRIM(NewmanAppData%Filename)// & - ' is below the high frequency cutoff set by WvHiCOff.', & - ErrStat,ErrMsg,RoutineName) - ENDIF - IF ( MAXVAL(NewmanAppData%Data4D%WvFreq2) < InitInp%WvHiCOff ) THEN - CALL SetErrStat( ErrID_Fatal,' The highest frequency ( '//TRIM(Num2LStr(MAXVAL(NewmanAppData%Data4D%WvFreq1)))// & - ' rad/s second wave period) data in '//TRIM(NewmanAppData%Filename)// & - ' is below the high frequency cutoff set by WvHiCOff.', & - ErrStat,ErrMsg,RoutineName) - ENDIF - - ELSE - ! This is a catastrophic issue. We should not have called this routine without data that is usable for the NewmanApp calculation - CALL SetErrStat( ErrID_Fatal, ' Newman approximation calculation called without data.',ErrStat,ErrMsg,RoutineName) - ENDIF - + CALL GetWAMIT2WvHdgRange(NewmanAppData,W2WvDir1Range,W2WvDir2Range,ErrStatTmp,ErrMsgTmp) + CALL SetErrStat(ErrStatTmp,ErrMsgTmp,ErrStat,ErrMsg,RoutineName) IF ( ErrStat >= AbortErrLev ) RETURN - - - !> 2. Check the data to see if the wave directions are present. May need to adjust for the boundary at +/- PI - IF ( NewmanAppData%DataIs3D ) THEN - - ! If we are using multidirectional waves, then we should have more than 1 wave direction in the WAMIT file. - IF ( InitInp%WaveMultiDir .AND. (NewmanAppData%Data3D%NumWvDir1 == 1) ) THEN - CALL SetErrStat( ErrID_Fatal,' WAMIT output file '//TRIM(NewmanAppData%Filename)//' only contains one wave '// & - 'direction at '//TRIM(Num2LStr(NewmanAppData%Data3D%WvDir1(1)))//' degrees (first wave direction). '// & - 'It cannot be used with multidirectional waves. Set WvDirMod to 0 to use this file.', & - ErrStat,ErrMsg,RoutineName) - ELSE IF ( InitInp%WaveMultiDir .AND. (NewmanAppData%Data3D%NumWvDir2 == 1) ) THEN - CALL SetErrStat( ErrID_Fatal,' WAMIT output file '//TRIM(NewmanAppData%Filename)//' only contains one wave '// & - 'direction at '//TRIM(Num2LStr(NewmanAppData%Data3D%WvDir2(1)))//' degrees (second wave direction). '// & - 'It cannot be used with multidirectional waves. Set WvDirMod to 0 to use this file.', & - ErrStat,ErrMsg,RoutineName) - ELSE - - ! See Known Issues #1 at the top of this file. There may be problems if the data spans the +/- Pi boundary. For - ! now (since time is limited) we will issue a warning if any of the wave directions for multidirectional waves - ! or data from the WAMIT file for the wavedirections is close to the +/-pi boundary (>150 degrees, <-150 degrees), - ! we will issue a warning. - IF ( (InitInp%WaveDirMin > 150.0_SiKi) .OR. (InitInp%WaveDirMax < -150.0_SiKi) .OR. & - (minval(NewmanAppData%data3d%WvDir1) > 150.0_SiKi) .OR. (maxval(NewmanAppData%data3d%WvDir1) < -150.0_SiKi) .OR. & - (minval(NewmanAppData%data3d%WvDir2) > 150.0_SiKi) .OR. (maxval(NewmanAppData%data3d%WvDir2) < -150.0_SiKi) ) THEN - CALL SetErrStat( ErrID_Warn,' There may be issues with how the wave direction data is handled when the wave '// & - 'direction of interest is near the +/- 180 direction. This is a known issue with '// & - 'the WAMIT2 module that has not yet been addressed.',ErrStat,ErrMsg,RoutineName) - ENDIF - - ! Now check the limits for the first wave direction - ! --> FIXME: sometime fix this to handle the above case. See Known Issue #1 at top of file. - IF ( InitInp%WaveDirMin < MINVAL(NewmanAppData%Data3D%WvDir1) ) THEN - CALL SetErrStat( ErrID_Fatal,' Minimum wave direction required of '//TRIM(Num2LStr(InitInp%WaveDirMin))//' is not'//& - 'found in the WAMIT data file '//TRIM(NewmanAppData%Filename)//' for the first wave direction.', & - ErrStat, ErrMsg, RoutineName) - ENDIF - IF ( InitInp%WaveDirMax > MAXVAL(NewmanAppData%Data3D%WvDir1) ) THEN - CALL SetErrStat( ErrID_Fatal,' Maximum wave direction required of '//TRIM(Num2LStr(InitInp%WaveDirMax))//' is not'//& - 'found in the WAMIT data file '//TRIM(NewmanAppData%Filename)//' for the first wave direction.', & - ErrStat, ErrMsg, RoutineName) - ENDIF - - - ! Now check the limits for the second wave direction - ! --> FIXME: sometime fix this to handle the above case. See Known Issue #1 at top of file. - IF ( InitInp%WaveDirMin < MINVAL(NewmanAppData%Data3D%WvDir2) ) THEN - CALL SetErrStat( ErrID_Fatal,' Minimum wave direction required of '//TRIM(Num2LStr(InitInp%WaveDirMin))//' is not'//& - 'found in the WAMIT data file '//TRIM(NewmanAppData%Filename)//' for the second wave direction.', & - ErrStat, ErrMsg, RoutineName) - ENDIF - IF ( InitInp%WaveDirMax > MAXVAL(NewmanAppData%Data3D%WvDir2) ) THEN - CALL SetErrStat( ErrID_Fatal,' Maximum wave direction required of '//TRIM(Num2LStr(InitInp%WaveDirMax))//' is not'//& - 'found in the WAMIT data file '//TRIM(NewmanAppData%Filename)//' for the second wave direction.', & - ErrStat, ErrMsg, RoutineName) - ENDIF - - ENDIF - - ELSEIF ( NewmanAppData%DataIs4D ) THEN - - ! If we are using multidirectional waves, then we should have more than 1 wave direction in the WAMIT file. - IF ( InitInp%WaveMultiDir .AND. (NewmanAppData%Data4D%NumWvDir1 == 1) ) THEN - CALL SetErrStat( ErrID_Fatal,' WAMIT output file '//TRIM(NewmanAppData%Filename)//' only contains one wave '// & - 'direction at '//TRIM(Num2LStr(NewmanAppData%Data4D%WvDir1(1)))//' degrees (first wave direction). '// & - 'It cannot be used with multidirectional waves. Set WvDirMod to 0 to use this file.', & - ErrStat,ErrMsg,RoutineName) - ELSE IF ( InitInp%WaveMultiDir .AND. (NewmanAppData%Data4D%NumWvDir2 == 1) ) THEN - CALL SetErrStat( ErrID_Fatal,' WAMIT output file '//TRIM(NewmanAppData%Filename)//' only contains one wave '// & - 'direction at '//TRIM(Num2LStr(NewmanAppData%Data4D%WvDir2(1)))//' degrees (second wave direction). '// & - 'It cannot be used with multidirectional waves. Set WvDirMod to 0 to use this file.', & - ErrStat,ErrMsg,RoutineName) - ELSE - - ! See Known Issues #1 at the top of this file. There may be problems if the data spans the +/- Pi boundary. For - ! now (since time is limited) we will issue a warning if any of the wave directions for multidirectional waves - ! or data from the WAMIT file for the wavedirections is close to the +/-pi boundary (>150 degrees, <-150 degrees), - ! we will issue a warning. - IF ( (InitInp%WaveDirMin > 150.0_SiKi) .OR. (InitInp%WaveDirMax < -150.0_SiKi) .OR. & - (MINVAL(NewmanAppData%Data4D%WvDir1) > 150.0_SiKi) .OR. (MAXVAL(NewmanAppData%Data4D%WvDir1) < -150.0_SiKi) .OR. & - (MINVAL(NewmanAppData%Data4D%WvDir2) > 150.0_SiKi) .OR. (MAXVAL(NewmanAppData%Data4D%WvDir2) < -150.0_SiKi) ) THEN - CALL SetErrStat( ErrID_Warn,' There may be issues with how the wave direction data is handled when the wave '// & - 'direction of interest is near the +/- 180 direction. This is a known issue with '// & - 'the WAMIT2 module that has not yet been addressed.',ErrStat,ErrMsg,RoutineName) - ENDIF - - ! Now check the limits for the first wave direction - ! --> FIXME: sometime fix this to handle the above case. See Known Issue #1 at top of file. - ! --> FIXME: modify to allow shifting values by TwoPi before comparing - IF ( InitInp%WaveDirMin < MINVAL(NewmanAppData%Data4D%WvDir1) ) THEN - CALL SetErrStat( ErrID_Fatal,' Minimum wave direction required of '//TRIM(Num2LStr(InitInp%WaveDirMin))//' is not'//& - 'found in the WAMIT data file '//TRIM(NewmanAppData%Filename)//' for the first wave direction.', & - ErrStat, ErrMsg, RoutineName) - ENDIF - IF ( InitInp%WaveDirMax > MAXVAL(NewmanAppData%Data4D%WvDir1) ) THEN - CALL SetErrStat( ErrID_Fatal,' Maximum wave direction required of '//TRIM(Num2LStr(InitInp%WaveDirMax))//' is not'//& - 'found in the WAMIT data file '//TRIM(NewmanAppData%Filename)//' for the first wave direction.', & - ErrStat, ErrMsg, RoutineName) - ENDIF - - - ! Now check the limits for the second wave direction - ! --> FIXME: sometime fix this to handle the above case. See Known Issue #1 at top of file. - IF ( InitInp%WaveDirMin < MINVAL(NewmanAppData%Data4D%WvDir2) ) THEN - CALL SetErrStat( ErrID_Fatal,' Minimum wave direction required of '//TRIM(Num2LStr(InitInp%WaveDirMin))//' is not'//& - 'found in the WAMIT data file '//TRIM(NewmanAppData%Filename)//' for the second wave direction.', & - ErrStat, ErrMsg, RoutineName) - ENDIF - IF ( InitInp%WaveDirMax > MAXVAL(NewmanAppData%Data4D%WvDir2) ) THEN - CALL SetErrStat( ErrID_Fatal,' Maximum wave direction required of '//TRIM(Num2LStr(InitInp%WaveDirMax))//' is not'//& - 'found in the WAMIT data file '//TRIM(NewmanAppData%Filename)//' for the second wave direction.', & - ErrStat, ErrMsg, RoutineName) - ENDIF - - ENDIF - - ELSE - ! No data. This is a catastrophic issue. We should not have called this routine without data that is usable for the NewmanApp calculation - CALL SetErrStat( ErrID_Fatal, ' Newman approximation calculation called without data.',ErrStat,ErrMsg,RoutineName) - ENDIF - + CALL CheckWAMIT2WvHdg(InitInp,NewmanAppData,ErrStatTmp,ErrMsgTmp) + CALL SetErrStat(ErrStatTmp,ErrMsgTmp,ErrStat,ErrMsg,RoutineName) IF ( ErrStat >= AbortErrLev ) RETURN - - !> 3. Check the data to see if we need to convert to 3D arrays before continuing (4D is sparse in any dimension we want and !! frequency diagonal is complete). Only check if we don't have 3D data. @@ -1645,19 +1302,19 @@ SUBROUTINE NewmanApp_InitCalc( InitInp, p, NewmanAppData, NewmanAppForce, ErrMsg ! Setup the arrays holding the Newman terms, both the complex frequency domain and real time domain pieces - ALLOCATE( NewmanTerm1t( 0:InitInp%NStepWave ), STAT=ErrStatTmp ) + ALLOCATE( NewmanTerm1t( 0:InitInp%WaveField%NStepWave ), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,' Cannot allocate array for calculating the first term of the Newmans '// & 'approximation in the time domain.',ErrStat, ErrMsg, RoutineName) - ALLOCATE( NewmanTerm2t( 0:InitInp%NStepWave ), STAT=ErrStatTmp ) + ALLOCATE( NewmanTerm2t( 0:InitInp%WaveField%NStepWave ), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,' Cannot allocate array for calculating the second term of the Newmans '// & 'approximation in the time domain.',ErrStat, ErrMsg, RoutineName) - ALLOCATE( NewmanTerm1C( 0:InitInp%NStepWave2, 6 ), STAT=ErrStatTmp ) + ALLOCATE( NewmanTerm1C( 0:InitInp%WaveField%NStepWave2, p%NExctnHdg+1, 6 ), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,' Cannot allocate array for calculating the first term of the Newmans '// & 'approximation in the frequency domain.',ErrStat, ErrMsg, RoutineName) - ALLOCATE( NewmanTerm2C( 0:InitInp%NStepWave2, 6 ), STAT=ErrStatTmp ) + ALLOCATE( NewmanTerm2C( 0:InitInp%WaveField%NStepWave2, p%NExctnHdg+1, 6 ), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,' Cannot allocate array for calculating the second term of the Newmans '// & 'approximation in the frequency domain.',ErrStat, ErrMsg, RoutineName) - ALLOCATE( NewmanAppForce( 0:InitInp%NStepWave, 6*p%NBody), STAT=ErrStatTmp ) + ALLOCATE( NewmanAppForce( 0:InitInp%WaveField%NStepWave, p%NExctnHdg+1, 6*p%NBody), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,' Cannot allocate array for the resulting Newmans '// & 'approximation of the 2nd order force.',ErrStat, ErrMsg, RoutineName) @@ -1681,7 +1338,7 @@ SUBROUTINE NewmanApp_InitCalc( InitInp, p, NewmanAppData, NewmanAppForce, ErrMsg ! Initialize the FFT library - CALL InitCFFT ( InitInp%NStepWave, FFT_Data, .FALSE., ErrStatTmp ) ! Complex result FFT initialize + CALL InitCFFT ( InitInp%WaveField%NStepWave, FFT_Data, .FALSE., ErrStatTmp ) ! Complex result FFT initialize CALL SetErrStat(ErrStatTmp,'Error occured while initializing the FFT.',ErrStat,ErrMsg,RoutineName) IF ( ErrStat >= AbortErrLev ) THEN IF (ALLOCATED(TmpData3D)) DEALLOCATE(TmpData3D,STAT=ErrStatTmp) @@ -1699,8 +1356,8 @@ SUBROUTINE NewmanApp_InitCalc( InitInp, p, NewmanAppData, NewmanAppForce, ErrMsg DO IBody=1,p%NBody ! set all frequency terms to zero to start - NewmanTerm1C(:,:) = CMPLX(0.0, 0.0, SiKi) - NewmanTerm2C(:,:) = CMPLX(0.0, 0.0, SiKi) + NewmanTerm1C(:,:,:) = CMPLX(0.0, 0.0, SiKi) + NewmanTerm2C(:,:,:) = CMPLX(0.0, 0.0, SiKi) ! Heading correction, only applies to NBodyMod == 2 @@ -1738,95 +1395,117 @@ SUBROUTINE NewmanApp_InitCalc( InitInp, p, NewmanAppData, NewmanAppForce, ErrMsg TmpData4D = NewmanAppData%Data4D%DataSet(:,:,:,:,Idx) END IF + DO iHdg = 1,p%NExctnHdg+1 + ! Compute the PRP heading angle + IF (p%PtfmYMod .EQ. 0) THEN + PRPHdg = InitInp%PtfmRefY + ELSE IF (p%PtfmYMod .EQ. 1) THEN + PRPHdg = -PI + (iHdg-1) * TwoPi/REAL(p%NExctnHdg,ReKi) + END IF - DO J=1,InitInp%NStepWave2 + DO J=1,InitInp%WaveField%NStepWave2 ! First get the wave amplitude -- must be reconstructed from the WaveElevC array. First index is the real (1) or ! imaginary (2) part. Divide by NStepWave2 so that the wave amplitude is of the same form as the paper. - aWaveElevC = CMPLX( InitInp%WaveElevC0(1,J), InitInp%WaveElevC0(2,J), SiKi) / InitInp%NStepWave2 + aWaveElevC = CMPLX( InitInp%WaveField%WaveElevC0(1,J), InitInp%WaveField%WaveElevC0(2,J), SiKi) / InitInp%WaveField%NStepWave2 ! Calculate the frequency - Omega1 = J * InitInp%WaveDOmega + Omega1 = J * InitInp%WaveField%WaveDOmega ! Only get a QTF value if within the range of frequencies between the cutoffs for the difference frequency - IF ( (Omega1 >= InitInp%WvLowCOff) .AND. (Omega1 <= InitInp%WvHiCOff) ) THEN + IF ( (Omega1 >= InitInp%WaveField%WvLowCOff) .AND. (Omega1 <= InitInp%WaveField%WvHiCOff) ) THEN ! Now get the QTF value that corresponds to this frequency and wavedirection pair. - IF ( NewmanAppData%DataIs3D ) THEN + IF ( NewmanAppData%DataIs3D ) THEN ! Set the (omega1,beta1,beta2) point we are looking for. - Coord3 = (/ REAL(Omega1,SiKi), InitInp%WaveDirArr(J), InitInp%WaveDirArr(J) /) + Coord3 = (/ REAL(Omega1,SiKi), InitInp%WaveField%WaveDirArr(J), InitInp%WaveField%WaveDirArr(J) /) ! Apply local Z rotation to heading angle (degrees) to put wave direction into the local (rotated) body frame - Coord3(2) = Coord3(2) - RotateZdegOffset - Coord3(3) = Coord3(3) - RotateZdegOffset + Coord3(2) = Coord3(2) - RotateZdegOffset - PRPHdg*R2D + Coord3(3) = Coord3(3) - RotateZdegOffset - PRPHdg*R2D + + ! Make sure the wave headings are in the correct range + dirInRange = GetAngleInRange(Coord3(2),W2WvDir1Range(1),W2WvDir1Range(2),tmpDir); Coord3(2) = tmpDir + dirInRange = GetAngleInRange(Coord3(3),W2WvDir2Range(1),W2WvDir2Range(2),tmpDir); Coord3(3) = tmpDir + IF (.NOT. dirInRange) THEN ! Somewhat redundant check. Can be removed in the future. + CALL SetErrStat(ErrID_Fatal,' Wave heading out of range.', ErrStat, ErrMsg, RoutineName) + END IF ! get the interpolated value for F(omega1,beta1,beta2) - CALL WAMIT_Interp3D_Cplx( Coord3, TmpData3D, NewmanAppData%Data3D%WvFreq1, & + CALL WAMIT_Interp3D_Cplx( Coord3, TmpData3D, NewmanAppData%Data3D%WvFreq1, & NewmanAppData%Data3D%WvDir1, NewmanAppData%Data3D%WvDir2, LastIndex3, QTF_Value, ErrStatTmp, ErrMsgTmp ) - ELSE + ELSE ! Set the (omega1,omega2,beta1,beta2) point we are looking for. - Coord4 = (/ REAL(Omega1,SiKi), REAL(Omega1,SiKi), InitInp%WaveDirArr(J), InitInp%WaveDirArr(J) /) + Coord4 = (/ REAL(Omega1,SiKi), REAL(Omega1,SiKi), InitInp%WaveField%WaveDirArr(J), InitInp%WaveField%WaveDirArr(J) /) ! Apply local Z rotation to heading angle (degrees) to put wave direction into the local (rotated) body frame - Coord4(3) = Coord4(3) - RotateZdegOffset - Coord4(4) = Coord4(4) - RotateZdegOffset + Coord4(3) = Coord4(3) - RotateZdegOffset - PRPHdg*R2D + Coord4(4) = Coord4(4) - RotateZdegOffset - PRPHdg*R2D + + ! Make sure the wave headings are in the correct range + dirInRange = GetAngleInRange(Coord4(3),W2WvDir1Range(1),W2WvDir1Range(2),tmpDir); Coord4(3) = tmpDir + dirInRange = GetAngleInRange(Coord4(4),W2WvDir2Range(1),W2WvDir2Range(2),tmpDir); Coord4(4) = tmpDir + IF (.NOT. dirInRange) THEN ! Somewhat redundant check. Can be removed in the future. + CALL SetErrStat(ErrID_Fatal,' Wave heading out of range.', ErrStat, ErrMsg, RoutineName) + END IF ! get the interpolated value for F(omega1,omega2,beta1,beta2) - CALL WAMIT_Interp4D_Cplx( Coord4, TmpData4D, NewmanAppData%Data4D%WvFreq1, NewmanAppData%Data4D%WvFreq2, & + CALL WAMIT_Interp4D_Cplx( Coord4, TmpData4D, NewmanAppData%Data4D%WvFreq1, NewmanAppData%Data4D%WvFreq2, & NewmanAppData%Data4D%WvDir1, NewmanAppData%Data4D%WvDir2, LastIndex4, QTF_Value, ErrStatTmp, ErrMsgTmp ) - ENDIF !QTF value find + ENDIF !QTF value find ! Now we have the value of the QTF. These values should only be real for the omega1=omega2 case of the approximation. ! However if the value came from the 4D interpolation routine, it might have some residual complex part to it. So ! we throw the complex part out. NOTE: the phase shift due to location will be added before the FFT. - QTF_Value = CMPLX(REAL(QTF_Value,SiKi),0.0,SiKi) + QTF_Value = CMPLX(REAL(QTF_Value,SiKi),0.0,SiKi) - ELSE ! outside the frequency range + ELSE ! outside the frequency range - QTF_Value = CMPLX(0.0,0.0,SiKi) + QTF_Value = CMPLX(0.0,0.0,SiKi) - ENDIF ! frequency check + ENDIF ! frequency check ! Check and make sure nothing bombed in the interpolation that we need to be aware of - CALL SetErrStat(ErrStatTmp,ErrMsgTmp,ErrStat,ErrMsg,RoutineName) - IF ( ErrStat >= AbortErrLev ) THEN - IF (ALLOCATED(TmpData3D)) DEALLOCATE(TmpData3D,STAT=ErrStatTmp) - IF (ALLOCATED(TmpData4D)) DEALLOCATE(TmpData4D,STAT=ErrStatTmp) - IF (ALLOCATED(NewmanTerm1t)) DEALLOCATE(NewmanTerm1t,STAT=ErrStatTmp) - IF (ALLOCATED(NewmanTerm2t)) DEALLOCATE(NewmanTerm2t,STAT=ErrStatTmp) - IF (ALLOCATED(NewmanTerm1C)) DEALLOCATE(NewmanTerm1C,STAT=ErrStatTmp) - IF (ALLOCATED(NewmanTerm2C)) DEALLOCATE(NewmanTerm2C,STAT=ErrStatTmp) - IF (ALLOCATED(NewmanAppForce)) DEALLOCATE(NewmanAppForce,STAT=ErrStatTmp) - RETURN - ENDIF + CALL SetErrStat(ErrStatTmp,ErrMsgTmp,ErrStat,ErrMsg,RoutineName) + IF ( ErrStat >= AbortErrLev ) THEN + IF (ALLOCATED(TmpData3D)) DEALLOCATE(TmpData3D,STAT=ErrStatTmp) + IF (ALLOCATED(TmpData4D)) DEALLOCATE(TmpData4D,STAT=ErrStatTmp) + IF (ALLOCATED(NewmanTerm1t)) DEALLOCATE(NewmanTerm1t,STAT=ErrStatTmp) + IF (ALLOCATED(NewmanTerm2t)) DEALLOCATE(NewmanTerm2t,STAT=ErrStatTmp) + IF (ALLOCATED(NewmanTerm1C)) DEALLOCATE(NewmanTerm1C,STAT=ErrStatTmp) + IF (ALLOCATED(NewmanTerm2C)) DEALLOCATE(NewmanTerm2C,STAT=ErrStatTmp) + IF (ALLOCATED(NewmanAppForce)) DEALLOCATE(NewmanAppForce,STAT=ErrStatTmp) + RETURN + ENDIF ! Now calculate the Newman terms - IF (REAL(QTF_Value) > 0.0_SiKi) THEN + IF (REAL(QTF_Value) > 0.0_SiKi) THEN - NewmanTerm1C(J,ThisDim) = aWaveElevC * (QTF_Value)**0.5_SiKi - NewmanTerm2C(J,ThisDim) = CMPLX(0.0_SiKi, 0.0_SiKi, SiKi) + NewmanTerm1C(J,iHdg,ThisDim) = aWaveElevC * (QTF_Value)**0.5_SiKi + NewmanTerm2C(J,iHdg,ThisDim) = CMPLX(0.0_SiKi, 0.0_SiKi, SiKi) - ELSE IF (REAL(QTF_Value) < 0.0_SiKi) THEN + ELSE IF (REAL(QTF_Value) < 0.0_SiKi) THEN - NewmanTerm1C(J,ThisDim) = CMPLX(0.0_SiKi, 0.0_SiKi, SiKi) - NewmanTerm2C(J,ThisDim) = aWaveElevC * (-QTF_Value)**0.5_SiKi + NewmanTerm1C(J,iHdg,ThisDim) = CMPLX(0.0_SiKi, 0.0_SiKi, SiKi) + NewmanTerm2C(J,iHdg,ThisDim) = aWaveElevC * (-QTF_Value)**0.5_SiKi - ELSE ! at 0 + ELSE ! at 0 - NewmanTerm1C(J,ThisDim) = CMPLX(0.0_SiKi, 0.0_SiKi, SiKi) - NewmanTerm2C(J,ThisDim) = CMPLX(0.0_SiKi, 0.0_SiKi, SiKi) + NewmanTerm1C(J,iHdg,ThisDim) = CMPLX(0.0_SiKi, 0.0_SiKi, SiKi) + NewmanTerm2C(J,iHdg,ThisDim) = CMPLX(0.0_SiKi, 0.0_SiKi, SiKi) - ENDIF + ENDIF - ENDDO ! J=1,InitInp%NStepWave2 + ENDDO ! J=1,InitInp%WaveField%NStepWave2 + ENDDO ! iHdg = 1,p%NExctnHdg ENDIF ! Load component to calculate @@ -1836,98 +1515,106 @@ SUBROUTINE NewmanApp_InitCalc( InitInp, p, NewmanAppData, NewmanAppForce, ErrMsg !---------------------------------------------------- ! Rotate back to global frame and phase shift and set the terms for the summation !---------------------------------------------------- - + DO iHdg = 1,p%NExctnHdg+1 + ! Compute the PRP heading angle + IF (p%PtfmYMod .EQ. 0) THEN + PRPHdg = InitInp%PtfmRefY + ELSE IF (p%PtfmYMod .EQ. 1) THEN + PRPHdg = -PI + (iHdg-1) * TwoPi/REAL(p%NExctnHdg,ReKi) + END IF ! Set rotation ! NOTE: RotateZMatrixT is the rotation from local to global. - RotateZMatrixT(:,1) = (/ cos(InitInp%PtfmRefztRot(IBody)), -sin(InitInp%PtfmRefztRot(IBody)) /) - RotateZMatrixT(:,2) = (/ sin(InitInp%PtfmRefztRot(IBody)), cos(InitInp%PtfmRefztRot(IBody)) /) + RotateZMatrixT(1,:) = (/ cos(InitInp%PtfmRefztRot(IBody)+PRPHdg), -sin(InitInp%PtfmRefztRot(IBody)+PRPHdg) /) + RotateZMatrixT(2,:) = (/ sin(InitInp%PtfmRefztRot(IBody)+PRPHdg), cos(InitInp%PtfmRefztRot(IBody)+PRPHdg) /) ! Loop through all the frequencies - DO J=1,InitInp%NStepWave2 + DO J=1,InitInp%WaveField%NStepWave2 ! Frequency - Omega1 = J * InitInp%WaveDOmega + Omega1 = J * InitInp%WaveField%WaveDOmega - !> Phase shift due to offset in location, only for NBodyMod==2 - if (p%NBodyMod == 2) then + !> Phase shift due to offset in location, only for NBodyMod==2 + if (p%NBodyMod == 2) then - !> The phase shift due to an (x,y) offset is of the form - !! \f$ exp[-\imath k(\omega) ( X cos(\beta(w)) + Y sin(\beta(w)) )] \f$ - ! NOTE: the phase shift applies to the aWaveElevC of the incoming wave. Including it here instead - ! of above is mathematically equivalent, but only because each frequency has only one wave - ! direction associated with it through the equal energy approach used in multidirectional waves. + !> The phase shift due to an (x,y) offset is of the form + !! \f$ exp[-\imath k(\omega) ( X cos(\beta(w)) + Y sin(\beta(w)) )] \f$ + ! NOTE: the phase shift applies to the aWaveElevC of the incoming wave. Including it here instead + ! of above is mathematically equivalent, but only because each frequency has only one wave + ! direction associated with it through the equal energy approach used in multidirectional waves. - WaveNmbr1 = WaveNumber ( REAL(Omega1,SiKi), InitInp%Gravity, InitInp%WtrDpth ) ! SiKi returned - TmpReal1 = WaveNmbr1 * ( InitInp%PtfmRefxt(1)*cos(InitInp%WaveDirArr(J)*D2R) + InitInp%PtfmRefyt(1)*sin(InitInp%WaveDirArr(J)*D2R) ) - PhaseShiftXY = CMPLX( cos(TmpReal1), -sin(TmpReal1) ) + WaveNmbr1 = WaveNumber ( REAL(Omega1,SiKi), InitInp%Gravity, InitInp%WaveField%EffWtrDpth ) ! SiKi returned + TmpReal1 = WaveNmbr1 * ( InitInp%PtfmRefxt(1)*cos(InitInp%WaveField%WaveDirArr(J)*D2R) + InitInp%PtfmRefyt(1)*sin(InitInp%WaveField%WaveDirArr(J)*D2R) ) + PhaseShiftXY = CMPLX( cos(TmpReal1), -sin(TmpReal1) ) - ! Apply the phase shift - DO ThisDim=1,6 - NewmanTerm1C(J,ThisDim) = NewmanTerm1C(J,ThisDim)*PhaseShiftXY ! Newman term 1 - NewmanTerm2C(J,ThisDim) = NewmanTerm2C(J,ThisDim)*PhaseShiftXY ! Newman term 2 - ENDDO - endif + ! Apply the phase shift + DO ThisDim=1,6 + NewmanTerm1C(J,iHdg,ThisDim) = NewmanTerm1C(J,iHdg,ThisDim)*PhaseShiftXY ! Newman term 1 + NewmanTerm2C(J,iHdg,ThisDim) = NewmanTerm2C(J,iHdg,ThisDim)*PhaseShiftXY ! Newman term 2 + ENDDO + endif ! Apply the rotation to get back to global frame -- Term 1 - NewmanTerm1C(J,1:2) = MATMUL(RotateZMatrixT, NewmanTerm1C(J,1:2)) - NewmanTerm1C(J,4:5) = MATMUL(RotateZMatrixT, NewmanTerm1C(J,4:5)) + NewmanTerm1C(J,iHdg,1:2) = MATMUL(RotateZMatrixT, NewmanTerm1C(J,iHdg,1:2)) + NewmanTerm1C(J,iHdg,4:5) = MATMUL(RotateZMatrixT, NewmanTerm1C(J,iHdg,4:5)) ! Apply the rotation to get back to global frame -- Term 2 - NewmanTerm2C(J,1:2) = MATMUL(RotateZMatrixT, NewmanTerm2C(J,1:2)) - NewmanTerm2C(J,4:5) = MATMUL(RotateZMatrixT, NewmanTerm2C(J,4:5)) + NewmanTerm2C(J,iHdg,1:2) = MATMUL(RotateZMatrixT, NewmanTerm2C(J,iHdg,1:2)) + NewmanTerm2C(J,iHdg,4:5) = MATMUL(RotateZMatrixT, NewmanTerm2C(J,iHdg,4:5)) - ENDDO ! J=1,InitInp%NStepWave2 + ENDDO ! J=1,InitInp%WaveField%NStepWave2 + ENDDO ! iHdg = 1,p%NExctnHdg+1 !---------------------------------------------------- ! Apply the FFT to get time domain results !---------------------------------------------------- + DO iHdg = 1,p%NExctnHdg+1 - DO ThisDim=1,6 ! Loop through all dimensions + DO ThisDim=1,6 ! Loop through all dimensions - Idx= (IBody-1)*6+ThisDim + Idx= (IBody-1)*6+ThisDim ! Now we apply the FFT to the first piece. - CALL ApplyCFFT( NewmanTerm1t(:), NewmanTerm1C(:,ThisDim), FFT_Data, ErrStatTmp ) - CALL SetErrStat(ErrStatTmp,ErrMsgTmp,ErrStat,ErrMsg,RoutineName) - IF ( ErrStat >= AbortErrLev ) THEN - IF (ALLOCATED(TmpData3D)) DEALLOCATE(TmpData3D,STAT=ErrStatTmp) - IF (ALLOCATED(TmpData4D)) DEALLOCATE(TmpData4D,STAT=ErrStatTmp) - IF (ALLOCATED(NewmanTerm1t)) DEALLOCATE(NewmanTerm1t,STAT=ErrStatTmp) - IF (ALLOCATED(NewmanTerm2t)) DEALLOCATE(NewmanTerm2t,STAT=ErrStatTmp) - IF (ALLOCATED(NewmanTerm1C)) DEALLOCATE(NewmanTerm1C,STAT=ErrStatTmp) - IF (ALLOCATED(NewmanTerm2C)) DEALLOCATE(NewmanTerm2C,STAT=ErrStatTmp) - IF (ALLOCATED(NewmanAppForce)) DEALLOCATE(NewmanAppForce,STAT=ErrStatTmp) - RETURN - END IF + CALL ApplyCFFT( NewmanTerm1t(:), NewmanTerm1C(:,iHdg,ThisDim), FFT_Data, ErrStatTmp ) + CALL SetErrStat(ErrStatTmp,ErrMsgTmp,ErrStat,ErrMsg,RoutineName) + IF ( ErrStat >= AbortErrLev ) THEN + IF (ALLOCATED(TmpData3D)) DEALLOCATE(TmpData3D,STAT=ErrStatTmp) + IF (ALLOCATED(TmpData4D)) DEALLOCATE(TmpData4D,STAT=ErrStatTmp) + IF (ALLOCATED(NewmanTerm1t)) DEALLOCATE(NewmanTerm1t,STAT=ErrStatTmp) + IF (ALLOCATED(NewmanTerm2t)) DEALLOCATE(NewmanTerm2t,STAT=ErrStatTmp) + IF (ALLOCATED(NewmanTerm1C)) DEALLOCATE(NewmanTerm1C,STAT=ErrStatTmp) + IF (ALLOCATED(NewmanTerm2C)) DEALLOCATE(NewmanTerm2C,STAT=ErrStatTmp) + IF (ALLOCATED(NewmanAppForce)) DEALLOCATE(NewmanAppForce,STAT=ErrStatTmp) + RETURN + END IF ! Now we apply the FFT to the second piece. - CALL ApplyCFFT( NewmanTerm2t(:), NewmanTerm2C(:,ThisDim), FFT_Data, ErrStatTmp ) - CALL SetErrStat(ErrStatTmp,ErrMsgTmp,ErrStat,ErrMsg,RoutineName) - IF ( ErrStat >= AbortErrLev ) THEN - IF (ALLOCATED(TmpData3D)) DEALLOCATE(TmpData3D,STAT=ErrStatTmp) - IF (ALLOCATED(TmpData4D)) DEALLOCATE(TmpData4D,STAT=ErrStatTmp) - IF (ALLOCATED(NewmanTerm1t)) DEALLOCATE(NewmanTerm1t,STAT=ErrStatTmp) - IF (ALLOCATED(NewmanTerm2t)) DEALLOCATE(NewmanTerm2t,STAT=ErrStatTmp) - IF (ALLOCATED(NewmanTerm1C)) DEALLOCATE(NewmanTerm1C,STAT=ErrStatTmp) - IF (ALLOCATED(NewmanTerm2C)) DEALLOCATE(NewmanTerm2C,STAT=ErrStatTmp) - IF (ALLOCATED(NewmanAppForce)) DEALLOCATE(NewmanAppForce,STAT=ErrStatTmp) - RETURN - ENDIF + CALL ApplyCFFT( NewmanTerm2t(:), NewmanTerm2C(:,iHdg,ThisDim), FFT_Data, ErrStatTmp ) + CALL SetErrStat(ErrStatTmp,ErrMsgTmp,ErrStat,ErrMsg,RoutineName) + IF ( ErrStat >= AbortErrLev ) THEN + IF (ALLOCATED(TmpData3D)) DEALLOCATE(TmpData3D,STAT=ErrStatTmp) + IF (ALLOCATED(TmpData4D)) DEALLOCATE(TmpData4D,STAT=ErrStatTmp) + IF (ALLOCATED(NewmanTerm1t)) DEALLOCATE(NewmanTerm1t,STAT=ErrStatTmp) + IF (ALLOCATED(NewmanTerm2t)) DEALLOCATE(NewmanTerm2t,STAT=ErrStatTmp) + IF (ALLOCATED(NewmanTerm1C)) DEALLOCATE(NewmanTerm1C,STAT=ErrStatTmp) + IF (ALLOCATED(NewmanTerm2C)) DEALLOCATE(NewmanTerm2C,STAT=ErrStatTmp) + IF (ALLOCATED(NewmanAppForce)) DEALLOCATE(NewmanAppForce,STAT=ErrStatTmp) + RETURN + ENDIF ! Now square the real part of the resulting time domain pieces and add them together to get the final force time series. - DO J=0,InitInp%NStepWave-1 - NewmanAppForce(J,Idx) = (abs(NewmanTerm1t(J)))**2 - (abs(NewmanTerm2t(J)))**2 - ENDDO + DO J=0,InitInp%WaveField%NStepWave-1 + NewmanAppForce(J,iHdg,Idx) = (abs(NewmanTerm1t(J)))**2 - (abs(NewmanTerm2t(J)))**2 + ENDDO ! Copy the last first term to the last so that it is cyclic - NewmanAppForce(InitInp%NStepWave,Idx) = NewmanAppForce(0,Idx) - - ENDDO ! ThisDim -- index to current dimension + NewmanAppForce(InitInp%WaveField%NStepWave,iHdg,Idx) = NewmanAppForce(0,iHdg,Idx) + ENDDO ! ThisDim -- index to current dimension + ENDDO ! iHdg -- current PRP heading ENDDO ! IBody -- current body @@ -2033,7 +1720,7 @@ SUBROUTINE DiffQTF_InitCalc( InitInp, p, DiffQTFData, DiffQTFForce, ErrMsg, ErrS REAL(SiKi), ALLOCATABLE :: TmpDiffQTFForce(:) !< The resulting diffQTF force for this load component REAL(ReKi) :: Omega1 !< First wave frequency REAL(ReKi) :: Omega2 !< Second wave frequency - REAL(SiKi), ALLOCATABLE :: MnDriftForce(:) !< Mean drift force (first term). MnDrift_InitCalc routine will return this. + REAL(SiKi), ALLOCATABLE :: MnDriftForce(:,:) !< Mean drift force (first term). MnDrift_InitCalc routine will return this. REAL(SiKi) :: RotateZdegOffset !< Offset to wave heading (NBodyMod==2 only) REAL(SiKi) :: RotateZMatrixT(2,2) !< The transpose of rotation in matrix form for rotation about z (from global to local) COMPLEX(SiKi) :: PhaseShiftXY !< The phase shift offset to apply to the body @@ -2044,7 +1731,10 @@ SUBROUTINE DiffQTF_InitCalc( InitInp, p, DiffQTFData, DiffQTFForce, ErrMsg, ErrS INTEGER(IntKi) :: LastIndex4(4) !< Last used index for searching in the interpolation algorithms. First wave freq REAL(SiKi) :: Coord4(4) !< The (omega1,omega2,beta1,beta2) coordinate we want in the 4D dataset. First wave freq. COMPLEX(SiKi), ALLOCATABLE :: TmpData4D(:,:,:,:) !< Temporary 4D array we put the 4D data into (minus the load component indice) - + REAL(SiKi) :: W2WvDir1Range(2) !< Range of the first wave heading in the WAMIT second-order files + REAL(SiKi) :: W2WvDir2Range(2) !< Range of the second wave heading in the WAMIT second-order files + REAL(SiKi) :: tmpDir + LOGICAL :: dirInRange ! Initialize a few things ErrMsg = '' @@ -2052,109 +1742,13 @@ SUBROUTINE DiffQTF_InitCalc( InitInp, p, DiffQTFData, DiffQTFForce, ErrMsg, ErrS ErrStat = ErrID_None ErrStatTmp = ErrID_None + CALL GetWAMIT2WvHdgRange(DiffQTFData,W2WvDir1Range,W2WvDir2Range,ErrStatTmp,ErrMsgTmp) + CALL SetErrStat(ErrStatTmp,ErrMsgTmp,ErrStat,ErrMsg,RoutineName) + IF ( ErrStat >= AbortErrLev ) RETURN - !> 1. Check the data to see if the wave frequencies are present in the QTF data. - - IF ( DiffQTFData%DataIs4D ) THEN ! We must have a 4D data set - - ! Check the low frequency cutoff - IF ( MINVAL( DiffQTFData%Data4D%WvFreq1 ) > InitInp%WvLowCOffD ) THEN - CALL SetErrStat( ErrID_Fatal,' The lowest frequency ( '//TRIM(Num2LStr(MINVAL(DiffQTFData%Data4D%WvFreq1)))// & - ' rad/s first wave period) data in '//TRIM(DiffQTFData%Filename)// & - ' is above the low frequency cutoff set by WvLowCOffD.', & - ErrStat,ErrMsg,RoutineName) - ENDIF - IF ( MINVAL( DiffQTFData%Data4D%WvFreq2 ) > InitInp%WvLowCOffD ) THEN - CALL SetErrStat( ErrID_Fatal,' The lowest frequency ( '//TRIM(Num2LStr(MINVAL(DiffQTFData%Data4D%WvFreq2)))// & - ' rad/s for second wave period) data in '//TRIM(DiffQTFData%Filename)// & - ' is above the low frequency cutoff set by WvLowCOffD.', & - ErrStat,ErrMsg,RoutineName) - ENDIF - - ! Check the high frequency cutoff -- using the Difference high frequency cutoff. The first order high frequency - ! cutoff is typically too high for this in most cases. - IF ( MAXVAL(DiffQTFData%Data4D%WvFreq1) < InitInp%WvHiCOffD ) THEN - CALL SetErrStat( ErrID_Fatal,' The highest frequency ( '//TRIM(Num2LStr(MAXVAL(DiffQTFData%Data4D%WvFreq1)))// & - ' rad/s for first wave period) data in '//TRIM(DiffQTFData%Filename)// & - ' is below the high frequency cutoff set by WvHiCOffD.', & - ErrStat,ErrMsg,RoutineName) - ENDIF - IF ( MAXVAL(DiffQTFData%Data4D%WvFreq2) < InitInp%WvHiCOffD ) THEN - CALL SetErrStat( ErrID_Fatal,' The highest frequency ( '//TRIM(Num2LStr(MAXVAL(DiffQTFData%Data4D%WvFreq1)))// & - ' rad/s second wave period) data in '//TRIM(DiffQTFData%Filename)// & - ' is below the high frequency cutoff set by WvHiCOffD.', & - ErrStat,ErrMsg,RoutineName) - ENDIF - - ELSE - ! This is a catastrophic issue. We should not have called this routine without data that is usable for the DiffQTF calculation - CALL SetErrStat( ErrID_Fatal, ' The full Difference QTF method requires 4D data, and was not passed any.',ErrStat,ErrMsg,RoutineName) - ENDIF - - IF ( ErrStat >= AbortErrLev ) RETURN - - - - - ! If we are using multidirectional waves, then we should have more than 1 wave direction in the WAMIT file. - IF ( InitInp%WaveMultiDir .AND. (DiffQTFData%Data4D%NumWvDir1 == 1) ) THEN - CALL SetErrStat( ErrID_Fatal,' WAMIT output file '//TRIM(DiffQTFData%Filename)//' only contains one wave '// & - 'direction at '//TRIM(Num2LStr(DiffQTFData%Data4D%WvDir1(1)))//' degrees (first wave direction). '// & - 'It cannot be used with multidirectional waves. Set WvDirMod to 0 to use this file.', & - ErrStat,ErrMsg,RoutineName) - ELSE IF ( InitInp%WaveMultiDir .AND. (DiffQTFData%Data4D%NumWvDir2 == 1) ) THEN - CALL SetErrStat( ErrID_Fatal,' WAMIT output file '//TRIM(DiffQTFData%Filename)//' only contains one wave '// & - 'direction at '//TRIM(Num2LStr(DiffQTFData%Data4D%WvDir2(1)))//' degrees (second wave direction). '// & - 'It cannot be used with multidirectional waves. Set WvDirMod to 0 to use this file.', & - ErrStat,ErrMsg,RoutineName) - ELSE - - ! See Known Issues #1 at the top of this file. There may be problems if the data spans the +/- Pi boundary. For - ! now (since time is limited) we will issue a warning if any of the wave directions for multidirectional waves - ! or data from the WAMIT file for the wavedirections is close to the +/-pi boundary (>150 degrees, <-150 degrees), - ! we will issue a warning. - IF ( (InitInp%WaveDirMin > 150.0_SiKi) .OR. (InitInp%WaveDirMax < -150.0_SiKi) .OR. & - (MINVAL(DiffQTFData%Data4D%WvDir1) > 150.0_SiKi) .OR. (MAXVAL(DiffQTFData%Data4D%WvDir1) < -150.0_SiKi) .OR. & - (MINVAL(DiffQTFData%Data4D%WvDir2) > 150.0_SiKi) .OR. (MAXVAL(DiffQTFData%Data4D%WvDir2) < -150.0_SiKi) ) THEN - CALL SetErrStat( ErrID_Warn,' There may be issues with how the wave direction data is handled when the wave '// & - 'direction of interest is near the +/- 180 direction. This is a known issue with '// & - 'the WAMIT2 module that has not yet been addressed.',ErrStat,ErrMsg,RoutineName) - ENDIF - - ! Now check the limits for the first wave direction - ! --> FIXME: sometime fix this to handle the above case. See Known Issue #1 at top of file. - ! --> FIXME: modify to allow shifting values by TwoPi before comparing - IF ( InitInp%WaveDirMin < MINVAL(DiffQTFData%Data4D%WvDir1) ) THEN - CALL SetErrStat( ErrID_Fatal,' Minimum wave direction required of '//TRIM(Num2LStr(InitInp%WaveDirMin))//' is not'//& - 'found in the WAMIT data file '//TRIM(DiffQTFData%Filename)//' for the first wave direction.', & - ErrStat, ErrMsg, RoutineName) - ENDIF - IF ( InitInp%WaveDirMax > MAXVAL(DiffQTFData%Data4D%WvDir1) ) THEN - CALL SetErrStat( ErrID_Fatal,' Maximum wave direction required of '//TRIM(Num2LStr(InitInp%WaveDirMax))//' is not'//& - 'found in the WAMIT data file '//TRIM(DiffQTFData%Filename)//' for the first wave direction.', & - ErrStat, ErrMsg, RoutineName) - ENDIF - - - ! Now check the limits for the second wave direction - ! --> FIXME: sometime fix this to handle the above case. See Known Issue #1 at top of file. - IF ( InitInp%WaveDirMin < MINVAL(DiffQTFData%Data4D%WvDir2) ) THEN - CALL SetErrStat( ErrID_Fatal,' Minimum wave direction required of '//TRIM(Num2LStr(InitInp%WaveDirMin))//' is not'//& - 'found in the WAMIT data file '//TRIM(DiffQTFData%Filename)//' for the second wave direction.', & - ErrStat, ErrMsg, RoutineName) - ENDIF - IF ( InitInp%WaveDirMax > MAXVAL(DiffQTFData%Data4D%WvDir2) ) THEN - CALL SetErrStat( ErrID_Fatal,' Maximum wave direction required of '//TRIM(Num2LStr(InitInp%WaveDirMax))//' is not'//& - 'found in the WAMIT data file '//TRIM(DiffQTFData%Filename)//' for the second wave direction.', & - ErrStat, ErrMsg, RoutineName) - ENDIF - - ENDIF - - IF ( ErrStat >= AbortErrLev ) RETURN - - - + CALL CheckWAMIT2WvHdg(InitInp,DiffQTFData,ErrStatTmp,ErrMsgTmp) + CALL SetErrStat(ErrStatTmp,ErrMsgTmp,ErrStat,ErrMsg,RoutineName) + IF ( ErrStat >= AbortErrLev ) RETURN !> 4. Now check to make sure we have data that will work. For the 4D data, it must not be sparse. !! To check this, we have to check the load components that we will use. So, we will loop through them @@ -2186,22 +1780,19 @@ SUBROUTINE DiffQTF_InitCalc( InitInp, p, DiffQTFData, DiffQTFForce, ErrMsg, ErrS ! Setup the arrays holding the DiffQTF terms, both the complex frequency domain and real time domain pieces - ALLOCATE( TmpDiffQTFForce( 0:InitInp%NStepWave), STAT=ErrStatTmp ) + ALLOCATE( TmpDiffQTFForce( 0:InitInp%WaveField%NStepWave), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,' Cannot allocate array for one load component of the full difference '// & 'QTF 2nd order force time series.',ErrStat, ErrMsg, RoutineName) - ALLOCATE( TmpComplexArr( 0:InitInp%NStepWave2, 6), STAT=ErrStatTmp ) + ALLOCATE( TmpComplexArr( 0:InitInp%WaveField%NStepWave2, 6), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,' Cannot allocate array for one load component of the full difference '// & 'QTF 2nd order force in the frequency domain.',ErrStat, ErrMsg, RoutineName) - ALLOCATE( DiffQTFForce( 0:InitInp%NStepWave, 6*p%NBody), STAT=ErrStatTmp ) + ALLOCATE( DiffQTFForce( 0:InitInp%WaveField%NStepWave, 6*p%NBody), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,' Cannot allocate array for the full difference '// & 'QTF 2nd order force time series.',ErrStat, ErrMsg, RoutineName) ! If something went wrong during allocation of the temporary arrays... IF ( ErrStat >= AbortErrLev ) THEN - IF (ALLOCATED(TmpData4D)) DEALLOCATE(TmpData4D,STAT=ErrStatTmp) - IF (ALLOCATED(DiffQTFForce)) DEALLOCATE(DiffQTFForce,STAT=ErrStatTmp) - IF (ALLOCATED(TmpDiffQTFForce)) DEALLOCATE(TmpDiffQTFForce,STAT=ErrStatTmp) - IF (ALLOCATED(TmpComplexArr)) DEALLOCATE(TmpComplexArr,STAT=ErrStatTmp) + call cleanup() RETURN ENDIF @@ -2211,13 +1802,10 @@ SUBROUTINE DiffQTF_InitCalc( InitInp, p, DiffQTFData, DiffQTFForce, ErrMsg, ErrS ! Initialize the FFT library. Do not apply normalization. - CALL InitFFT ( InitInp%NStepWave, FFT_Data, .FALSE., ErrStatTmp ) + CALL InitFFT ( InitInp%WaveField%NStepWave, FFT_Data, .FALSE., ErrStatTmp ) CALL SetErrStat(ErrStatTmp,'Error occured while initializing the FFT.',ErrStat,ErrMsg,RoutineName) IF ( ErrStat >= AbortErrLev ) THEN - IF (ALLOCATED(TmpData4D)) DEALLOCATE(TmpData4D,STAT=ErrStatTmp) - IF (ALLOCATED(DiffQTFForce)) DEALLOCATE(DiffQTFForce,STAT=ErrStatTmp) - IF (ALLOCATED(TmpDiffQTFForce)) DEALLOCATE(TmpDiffQTFForce,STAT=ErrStatTmp) - IF (ALLOCATED(TmpComplexArr)) DEALLOCATE(TmpComplexArr,STAT=ErrStatTmp) + call cleanup() RETURN END IF @@ -2229,10 +1817,7 @@ SUBROUTINE DiffQTF_InitCalc( InitInp, p, DiffQTFData, DiffQTFForce, ErrMsg, ErrS CALL MnDrift_InitCalc( InitInp, p, DiffQTFData, MnDriftForce, ErrMsgTmp, ErrStatTmp ) CALL SetErrStat( ErrStatTmp, ErrMsgTmp, ErrStat, ErrMsg, RoutineName ) IF ( ErrStat >= AbortErrLev ) THEN - IF (ALLOCATED(TmpData4D)) DEALLOCATE(TmpData4D,STAT=ErrStatTmp) - IF (ALLOCATED(DiffQTFForce)) DEALLOCATE(DiffQTFForce,STAT=ErrStatTmp) - IF (ALLOCATED(TmpDiffQTFForce)) DEALLOCATE(TmpDiffQTFForce,STAT=ErrStatTmp) - IF (ALLOCATED(TmpComplexArr)) DEALLOCATE(TmpComplexArr,STAT=ErrStatTmp) + call cleanup() RETURN ENDIF @@ -2246,10 +1831,7 @@ SUBROUTINE DiffQTF_InitCalc( InitInp, p, DiffQTFData, DiffQTFForce, ErrMsg, ErrS ErrStat,ErrMsg,RoutineName) ENDDO IF ( ErrStat >= AbortErrLev ) THEN - IF (ALLOCATED(TmpData4D)) DEALLOCATE(TmpData4D,STAT=ErrStatTmp) - IF (ALLOCATED(DiffQTFForce)) DEALLOCATE(DiffQTFForce,STAT=ErrStatTmp) - IF (ALLOCATED(TmpDiffQTFForce)) DEALLOCATE(TmpDiffQTFForce,STAT=ErrStatTmp) - IF (ALLOCATED(TmpComplexArr)) DEALLOCATE(TmpComplexArr,STAT=ErrStatTmp) + call cleanup() RETURN ENDIF @@ -2287,46 +1869,50 @@ SUBROUTINE DiffQTF_InitCalc( InitInp, p, DiffQTFData, DiffQTFForce, ErrMsg, ErrS TmpData4D = DiffQTFData%Data4D%DataSet(:,:,:,:,Idx) ! Outer loop to create the TmpComplexArr - DO J=1,InitInp%NStepWave2-1 + DO J=1,InitInp%WaveField%NStepWave2-1 ! Calculate the frequency -- This is the difference frequency. - OmegaDiff = J * InitInp%WaveDOmega + OmegaDiff = J * InitInp%WaveField%WaveDOmega ! Only perform calculations if the difference frequency is in the right range - IF ( (OmegaDiff >= InitInp%WvLowCOffD) .AND. (OmegaDiff <= InitInp%WvHiCOffD) ) THEN + IF ( (OmegaDiff >= InitInp%WaveField%WvLowCOffD) .AND. (OmegaDiff <= InitInp%WaveField%WvHiCOffD) ) THEN ! Set the \f$ H^- \f$ term to zero before we start TmpHMinusC = CMPLX(0.0_SiKi,0.0_SiKi,SiKi) ! Do the sum over H^- - DO K=1,InitInp%NStepWave2-J ! note the funny upper limit. This is because we are doing a summation on a triangular area. + DO K=1,InitInp%WaveField%NStepWave2-J ! note the funny upper limit. This is because we are doing a summation on a triangular area. ! set the two frequencies that the difference frequency comes from - Omega1 = (J + K) * InitInp%WaveDOmega ! the mth frequency -- \mu^- + n = m - Omega2 = K * InitInp%WaveDOmega ! the nth frequency + Omega1 = (J + K) * InitInp%WaveField%WaveDOmega ! the mth frequency -- \mu^- + n = m + Omega2 = K * InitInp%WaveField%WaveDOmega ! the nth frequency ! Find the Wave amplitudes 1 and 2 - aWaveElevC1 = CMPLX( InitInp%WaveElevC0(1,J+K), InitInp%WaveElevC0(2,J+K), SiKi) / InitInp%NStepWave2 - aWaveElevC2 = CMPLX( InitInp%WaveElevC0(1,K), InitInp%WaveElevC0(2,K), SiKi) / InitInp%NStepWave2 + aWaveElevC1 = CMPLX( InitInp%WaveField%WaveElevC0(1,J+K), InitInp%WaveField%WaveElevC0(2,J+K), SiKi) / InitInp%WaveField%NStepWave2 + aWaveElevC2 = CMPLX( InitInp%WaveField%WaveElevC0(1,K), InitInp%WaveField%WaveElevC0(2,K), SiKi) / InitInp%WaveField%NStepWave2 ! Set the (omega1,omega2,beta1,beta2) point we are looking for. - Coord4 = (/ REAL(Omega1,SiKi), REAL(Omega2,SiKi), InitInp%WaveDirArr(J+K), InitInp%WaveDirArr(K) /) + Coord4 = (/ REAL(Omega1,SiKi), REAL(Omega2,SiKi), InitInp%WaveField%WaveDirArr(J+K), InitInp%WaveField%WaveDirArr(K) /) ! Apply local Z rotation to heading angle (degrees) to put wave direction into the local (rotated) body frame - Coord4(3) = Coord4(3) - RotateZdegOffset - Coord4(4) = Coord4(4) - RotateZdegOffset + Coord4(3) = Coord4(3) - RotateZdegOffset - InitInp%PtfmRefY*R2D + Coord4(4) = Coord4(4) - RotateZdegOffset - InitInp%PtfmRefY*R2D + + ! Make sure the wave headings are in the correct range + dirInRange = GetAngleInRange(Coord4(3),W2WvDir1Range(1),W2WvDir1Range(2),tmpDir); Coord4(3) = tmpDir + dirInRange = GetAngleInRange(Coord4(4),W2WvDir2Range(1),W2WvDir2Range(2),tmpDir); Coord4(4) = tmpDir + IF (.NOT. dirInRange) THEN ! Somewhat redundant check. Can be removed in the future. + CALL SetErrStat(ErrID_Fatal,' Wave heading out of range.', ErrStat, ErrMsg, RoutineName) + END IF ! get the interpolated value for F(omega1,omega2,beta1,beta2) --> QTF_Value CALL WAMIT_Interp4D_Cplx( Coord4, TmpData4D, DiffQTFData%Data4D%WvFreq1, DiffQTFData%Data4D%WvFreq2, & DiffQTFData%Data4D%WvDir1, DiffQTFData%Data4D%WvDir2, LastIndex4, QTF_Value, ErrStatTmp, ErrMsgTmp ) CALL SetErrStat(ErrStatTmp,ErrMsgTmp,ErrStat,ErrMsg,RoutineName) IF (ErrStat >= AbortErrLev ) THEN - IF (ALLOCATED(TmpData4D)) DEALLOCATE(TmpData4D,STAT=ErrStatTmp) - IF (ALLOCATED(DiffQTFForce)) DEALLOCATE(DiffQTFForce,STAT=ErrStatTmp) - IF (ALLOCATED(TmpDiffQTFForce)) DEALLOCATE(TmpDiffQTFForce,STAT=ErrStatTmp) - IF (ALLOCATED(TmpComplexArr)) DEALLOCATE(TmpComplexArr,STAT=ErrStatTmp) + call cleanup() RETURN ENDIF @@ -2341,10 +1927,10 @@ SUBROUTINE DiffQTF_InitCalc( InitInp, p, DiffQTFData, DiffQTFForce, ErrMsg, ErrS ! of above is mathematically equivalent, but only because each frequency has only one wave ! direction associated with it through the equal energy approach used in multidirectional waves. - WaveNmbr1 = WaveNumber ( REAL(Omega1,SiKi), InitInp%Gravity, InitInp%WtrDpth ) ! SiKi returned - WaveNmbr2 = WaveNumber ( REAL(Omega2,SiKi), InitInp%Gravity, InitInp%WtrDpth ) ! SiKi returned - TmpReal1 = WaveNmbr1 * ( InitInp%PtfmRefxt(1)*cos(InitInp%WaveDirArr(J+K)*D2R) + InitInp%PtfmRefyt(1)*sin(InitInp%WaveDirArr(J+K)*D2R) ) - TmpReal2 = WaveNmbr2 * ( InitInp%PtfmRefxt(1)*cos(InitInp%WaveDirArr(K)*D2R) + InitInp%PtfmRefyt(1)*sin(InitInp%WaveDirArr(K)*D2R) ) + WaveNmbr1 = WaveNumber ( REAL(Omega1,SiKi), InitInp%Gravity, InitInp%WaveField%EffWtrDpth ) ! SiKi returned + WaveNmbr2 = WaveNumber ( REAL(Omega2,SiKi), InitInp%Gravity, InitInp%WaveField%EffWtrDpth ) ! SiKi returned + TmpReal1 = WaveNmbr1 * ( InitInp%PtfmRefxt(1)*cos(InitInp%WaveField%WaveDirArr(J+K)*D2R) + InitInp%PtfmRefyt(1)*sin(InitInp%WaveField%WaveDirArr(J+K)*D2R) ) + TmpReal2 = WaveNmbr2 * ( InitInp%PtfmRefxt(1)*cos(InitInp%WaveField%WaveDirArr(K)*D2R) + InitInp%PtfmRefyt(1)*sin(InitInp%WaveField%WaveDirArr(K)*D2R) ) ! Set the phase shift for the set of difference frequencies PhaseShiftXY = CMPLX( cos(TmpReal1 - TmpReal2), -sin(TmpReal1 - TmpReal2) ) @@ -2381,17 +1967,17 @@ SUBROUTINE DiffQTF_InitCalc( InitInp, p, DiffQTFData, DiffQTFForce, ErrMsg, ErrS ! Set rotation ! NOTE: RotateZMatrixT is the rotation from local to global. - RotateZMatrixT(:,1) = (/ cos(InitInp%PtfmRefztRot(IBody)), -sin(InitInp%PtfmRefztRot(IBody)) /) - RotateZMatrixT(:,2) = (/ sin(InitInp%PtfmRefztRot(IBody)), cos(InitInp%PtfmRefztRot(IBody)) /) + RotateZMatrixT(1,:) = (/ cos(InitInp%PtfmRefztRot(IBody)+InitInp%PtfmRefY), -sin(InitInp%PtfmRefztRot(IBody)+InitInp%PtfmRefY) /) + RotateZMatrixT(2,:) = (/ sin(InitInp%PtfmRefztRot(IBody)+InitInp%PtfmRefY), cos(InitInp%PtfmRefztRot(IBody)+InitInp%PtfmRefY) /) ! Loop through all the frequencies - DO J=1,InitInp%NStepWave2 + DO J=1,InitInp%WaveField%NStepWave2 ! Apply the rotation to get back to global frame TmpComplexArr(J,1:2) = MATMUL(RotateZMatrixT, TmpComplexArr(J,1:2)) TmpComplexArr(J,4:5) = MATMUL(RotateZMatrixT, TmpComplexArr(J,4:5)) - ENDDO ! J=1,InitInp%NStepWave2 + ENDDO ! J=1,InitInp%WaveField%NStepWave2 @@ -2407,23 +1993,20 @@ SUBROUTINE DiffQTF_InitCalc( InitInp, p, DiffQTFData, DiffQTFForce, ErrMsg, ErrS CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT to the second term of the difference QTF.', & ErrStat,ErrMsg,RoutineName) IF ( ErrStat >= AbortErrLev ) THEN - IF (ALLOCATED(TmpData4D)) DEALLOCATE(TmpData4D,STAT=ErrStatTmp) - IF (ALLOCATED(DiffQTFForce)) DEALLOCATE(DiffQTFForce,STAT=ErrStatTmp) - IF (ALLOCATED(TmpDiffQTFForce)) DEALLOCATE(TmpDiffQTFForce,STAT=ErrStatTmp) - IF (ALLOCATED(TmpComplexArr)) DEALLOCATE(TmpComplexArr,STAT=ErrStatTmp) + call cleanup() RETURN END IF ! Now we multiply the result by 2 and save it to the DiffQTFForce array and add the MnDrift term ! NOTE: phase shift and orientations on the MnDriftForce term have already been applied - ! NOTE: the "-1" since TmpDiffQTFForce(InitInp%NStepWave) is not set and DiffQTFForce(InitInp%NStepWave,Idx) gets overwritten - DO K=0,InitInp%NStepWave-1 - DiffQTFForce(K,Idx) = 2.0_SiKi * TmpDiffQTFForce(K) + MnDriftForce(Idx) + ! NOTE: the "-1" since TmpDiffQTFForce(InitInp%WaveField%NStepWave) is not set and DiffQTFForce(InitInp%WaveField%NStepWave,Idx) gets overwritten + DO K=0,InitInp%WaveField%NStepWave-1 + DiffQTFForce(K,Idx) = 2.0_SiKi * TmpDiffQTFForce(K) + MnDriftForce(1,Idx) ENDDO ! Copy the last first term to the first so that it is cyclic - DiffQTFForce(InitInp%NStepWave,Idx) = DiffQTFForce(0,Idx) + DiffQTFForce(InitInp%WaveField%NStepWave,Idx) = DiffQTFForce(0,Idx) ENDDO ! ThisDim -- The current dimension ENDDO ! IBody -- This WAMIT body @@ -2434,20 +2017,23 @@ SUBROUTINE DiffQTF_InitCalc( InitInp, p, DiffQTFData, DiffQTFForce, ErrMsg, ErrS CALL ExitFFT(FFT_Data, ErrStatTmp) CALL SetErrStat(ErrStatTmp,'Error occured while cleaning up after the FFTs.', ErrStat,ErrMsg,RoutineName) IF ( ErrStat >= AbortErrLev ) THEN - IF (ALLOCATED(TmpData4D)) DEALLOCATE(TmpData4D,STAT=ErrStatTmp) - IF (ALLOCATED(DiffQTFForce)) DEALLOCATE(DiffQTFForce,STAT=ErrStatTmp) - IF (ALLOCATED(TmpDiffQTFForce)) DEALLOCATE(TmpDiffQTFForce,STAT=ErrStatTmp) - IF (ALLOCATED(TmpComplexArr)) DEALLOCATE(TmpComplexArr,STAT=ErrStatTmp) + call cleanup() RETURN END IF - - ! Cleanup - IF (ALLOCATED(TmpData4D)) DEALLOCATE(TmpData4D,STAT=ErrStatTmp) - IF (ALLOCATED(TmpDiffQTFForce)) DEALLOCATE(TmpDiffQTFForce,STAT=ErrStatTmp) - IF (ALLOCATED(TmpComplexArr)) DEALLOCATE(TmpComplexArr,STAT=ErrStatTmp) - - + call cleanup() + + contains +!--------------------------------------------------- + subroutine cleanup() + + ! Cleanup + IF (ALLOCATED(MnDriftForce)) DEALLOCATE(MnDriftForce,STAT=ErrStatTmp) + IF (ALLOCATED(TmpData4D)) DEALLOCATE(TmpData4D,STAT=ErrStatTmp) + IF (ALLOCATED(TmpDiffQTFForce)) DEALLOCATE(TmpDiffQTFForce,STAT=ErrStatTmp) + IF (ALLOCATED(TmpComplexArr)) DEALLOCATE(TmpComplexArr,STAT=ErrStatTmp) + end subroutine cleanup +!--------------------------------------------------- END SUBROUTINE DiffQTF_InitCalc @@ -2566,7 +2152,10 @@ SUBROUTINE SumQTF_InitCalc( InitInp, p, SumQTFData, SumQTFForce, ErrMsg, ErrStat INTEGER(IntKi) :: LastIndex4(4) !< Last used index for searching in the interpolation algorithms. First wave freq REAL(SiKi) :: Coord4(4) !< The (omega1,omega2,beta1,beta2) coordinate we want in the 4D dataset. First wave freq. COMPLEX(SiKi), ALLOCATABLE :: TmpData4D(:,:,:,:) !< Temporary 4D array we put the 4D data into (minus the load component indice) - + REAL(SiKi) :: W2WvDir1Range(2) !< Range of the first wave heading in the WAMIT second-order files + REAL(SiKi) :: W2WvDir2Range(2) !< Range of the second wave heading in the WAMIT second-order files + REAL(SiKi) :: tmpDir + LOGICAL :: dirInRange ! Initialize a few things ErrMsg = '' @@ -2574,110 +2163,14 @@ SUBROUTINE SumQTF_InitCalc( InitInp, p, SumQTFData, SumQTFForce, ErrMsg, ErrStat ErrStat = ErrID_None ErrStatTmp = ErrID_None - - !> 1. Check the data to see if the wave frequencies are present in the QTF data. - - IF ( SumQTFData%DataIs4D ) THEN ! We must have a 4D data set - - ! Check the low frequency cutoff - IF ( MINVAL( SumQTFData%Data4D%WvFreq1 ) > InitInp%WvLowCOffS ) THEN - CALL SetErrStat( ErrID_Fatal,' The lowest frequency ( '//TRIM(Num2LStr(MINVAL(SumQTFData%Data4D%WvFreq1)))// & - ' rad/s first wave period) data in '//TRIM(SumQTFData%Filename)// & - ' is above the low frequency cutoff set by WvLowCOffS.', & - ErrStat,ErrMsg,RoutineName) - ENDIF - IF ( MINVAL( SumQTFData%Data4D%WvFreq2 ) > InitInp%WvLowCOffS ) THEN - CALL SetErrStat( ErrID_Fatal,' The lowest frequency ( '//TRIM(Num2LStr(MINVAL(SumQTFData%Data4D%WvFreq2)))// & - ' rad/s for second wave period) data in '//TRIM(SumQTFData%Filename)// & - ' is above the low frequency cutoff set by WvLowCOffS.', & - ErrStat,ErrMsg,RoutineName) - ENDIF - - ! Check the high frequency cutoff -- using the Difference high frequency cutoff. The first order high frequency - ! cutoff is typically too high for this in most cases. - IF ( MAXVAL(SumQTFData%Data4D%WvFreq1) < InitInp%WvHiCOffS ) THEN - CALL SetErrStat( ErrID_Fatal,' The highest frequency ( '//TRIM(Num2LStr(MAXVAL(SumQTFData%Data4D%WvFreq1)))// & - ' rad/s for first wave period) data in '//TRIM(SumQTFData%Filename)// & - ' is below the high frequency cutoff set by WvHiCOffS.', & - ErrStat,ErrMsg,RoutineName) - ENDIF - IF ( MAXVAL(SumQTFData%Data4D%WvFreq2) < InitInp%WvHiCOffS ) THEN - CALL SetErrStat( ErrID_Fatal,' The highest frequency ( '//TRIM(Num2LStr(MAXVAL(SumQTFData%Data4D%WvFreq1)))// & - ' rad/s second wave period) data in '//TRIM(SumQTFData%Filename)// & - ' is below the high frequency cutoff set by WvHiCOffS.', & - ErrStat,ErrMsg,RoutineName) - ENDIF - - ELSE - ! This is a catastrophic issue. We should not have called this routine without data that is usable for the SumQTF calculation - CALL SetErrStat( ErrID_Fatal, ' The full Sum QTF method requires 4D data, and was not passed any.',ErrStat,ErrMsg,RoutineName) - ENDIF - + CALL GetWAMIT2WvHdgRange(SumQTFData,W2WvDir1Range,W2WvDir2Range,ErrStatTmp,ErrMsgTmp) + CALL SetErrStat(ErrStatTmp,ErrMsgTmp,ErrStat,ErrMsg,RoutineName) IF ( ErrStat >= AbortErrLev ) RETURN - - - - ! If we are using multidirectional waves, then we should have more than 1 wave direction in the WAMIT file. - IF ( InitInp%WaveMultiDir .AND. (SumQTFData%Data4D%NumWvDir1 == 1) ) THEN - CALL SetErrStat( ErrID_Fatal,' WAMIT output file '//TRIM(SumQTFData%Filename)//' only contains one wave '// & - 'direction at '//TRIM(Num2LStr(SumQTFData%Data4D%WvDir1(1)))//' degrees (first wave direction). '// & - 'It cannot be used with multidirectional waves. Set WvDirMod to 0 to use this file.', & - ErrStat,ErrMsg,RoutineName) - ELSE IF ( InitInp%WaveMultiDir .AND. (SumQTFData%Data4D%NumWvDir2 == 1) ) THEN - CALL SetErrStat( ErrID_Fatal,' WAMIT output file '//TRIM(SumQTFData%Filename)//' only contains one wave '// & - 'direction at '//TRIM(Num2LStr(SumQTFData%Data4D%WvDir2(1)))//' degrees (second wave direction). '// & - 'It cannot be used with multidirectional waves. Set WvDirMod to 0 to use this file.', & - ErrStat,ErrMsg,RoutineName) - ELSE - - ! See Known Issues #1 at the top of this file. There may be problems if the data spans the +/- Pi boundary. For - ! now (since time is limited) we will issue a warning if any of the wave directions for multidirectional waves - ! or data from the WAMIT file for the wavedirections is close to the +/-pi boundary (>150 degrees, <-150 degrees), - ! we will issue a warning. - IF ( (InitInp%WaveDirMin > 150.0_SiKi) .OR. (InitInp%WaveDirMax < -150.0_SiKi) .OR. & - (MINVAL(SumQTFData%Data4D%WvDir1) > 150.0_SiKi) .OR. (MAXVAL(SumQTFData%Data4D%WvDir1) < -150.0_SiKi) .OR. & - (MINVAL(SumQTFData%Data4D%WvDir2) > 150.0_SiKi) .OR. (MAXVAL(SumQTFData%Data4D%WvDir2) < -150.0_SiKi) ) THEN - CALL SetErrStat( ErrID_Warn,' There may be issues with how the wave direction data is handled when the wave '// & - 'direction of interest is near the +/- 180 direction. This is a known issue with '// & - 'the WAMIT2 module that has not yet been addressed.',ErrStat,ErrMsg,RoutineName) - ENDIF - - ! Now check the limits for the first wave direction - ! --> FIXME: sometime fix this to handle the above case. See Known Issue #1 at top of file. - ! --> FIXME: modify to allow shifting values by TwoPi before comparing - IF ( InitInp%WaveDirMin < MINVAL(SumQTFData%Data4D%WvDir1) ) THEN - CALL SetErrStat( ErrID_Fatal,' Minimum wave direction required of '//TRIM(Num2LStr(InitInp%WaveDirMin))//' is not'//& - 'found in the WAMIT data file '//TRIM(SumQTFData%Filename)//' for the first wave direction.', & - ErrStat, ErrMsg, RoutineName) - ENDIF - IF ( InitInp%WaveDirMax > MAXVAL(SumQTFData%Data4D%WvDir1) ) THEN - CALL SetErrStat( ErrID_Fatal,' Maximum wave direction required of '//TRIM(Num2LStr(InitInp%WaveDirMax))//' is not'//& - 'found in the WAMIT data file '//TRIM(SumQTFData%Filename)//' for the first wave direction.', & - ErrStat, ErrMsg, RoutineName) - ENDIF - - - ! Now check the limits for the second wave direction - ! --> FIXME: sometime fix this to handle the above case. See Known Issue #1 at top of file. - IF ( InitInp%WaveDirMin < MINVAL(SumQTFData%Data4D%WvDir2) ) THEN - CALL SetErrStat( ErrID_Fatal,' Minimum wave direction required of '//TRIM(Num2LStr(InitInp%WaveDirMin))//' is not'//& - 'found in the WAMIT data file '//TRIM(SumQTFData%Filename)//' for the second wave direction.', & - ErrStat, ErrMsg, RoutineName) - ENDIF - IF ( InitInp%WaveDirMax > MAXVAL(SumQTFData%Data4D%WvDir2) ) THEN - CALL SetErrStat( ErrID_Fatal,' Maximum wave direction required of '//TRIM(Num2LStr(InitInp%WaveDirMax))//' is not'//& - 'found in the WAMIT data file '//TRIM(SumQTFData%Filename)//' for the second wave direction.', & - ErrStat, ErrMsg, RoutineName) - ENDIF - - ENDIF - + CALL CheckWAMIT2WvHdg(InitInp,SumQTFData,ErrStatTmp,ErrMsgTmp) + CALL SetErrStat(ErrStatTmp,ErrMsgTmp,ErrStat,ErrMsg,RoutineName) IF ( ErrStat >= AbortErrLev ) RETURN - - - !> 4. Now check to make sure we have data that will work. For the 4D data, it must not be sparse. !! To check this, we have to check the load components that we will use. So, we will loop through them !! and set the TmpFlag to true if there is a sparse matrix for one of them. @@ -2708,19 +2201,19 @@ SUBROUTINE SumQTF_InitCalc( InitInp, p, SumQTFData, SumQTFForce, ErrMsg, ErrStat ! Setup the arrays holding the SumQTF terms, both the complex frequency domain and real time domain pieces - ALLOCATE( Term1ArrayC( 0:InitInp%NStepWave2, 6), STAT=ErrStatTmp ) + ALLOCATE( Term1ArrayC( 0:InitInp%WaveField%NStepWave2, 6), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,' Cannot allocate array for the first term of one load component of the full sum '// & 'QTF 2nd order force in the frequency domain.',ErrStat, ErrMsg, RoutineName) - ALLOCATE( Term2ArrayC( 0:InitInp%NStepWave2, 6), STAT=ErrStatTmp ) + ALLOCATE( Term2ArrayC( 0:InitInp%WaveField%NStepWave2, 6), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,' Cannot allocate array for the second term of one load component of the full sum '// & 'QTF 2nd order force in the frequency domain.',ErrStat, ErrMsg, RoutineName) - ALLOCATE( Term1Array( 0:InitInp%NStepWave), STAT=ErrStatTmp ) + ALLOCATE( Term1Array( 0:InitInp%WaveField%NStepWave), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,' Cannot allocate array for the first term of one load component of the full sum '// & 'QTF 2nd order force in the time domain.',ErrStat, ErrMsg, RoutineName) - ALLOCATE( Term2Array( 0:InitInp%NStepWave), STAT=ErrStatTmp ) + ALLOCATE( Term2Array( 0:InitInp%WaveField%NStepWave), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,' Cannot allocate array for the second term of one load component of the full sum '// & 'QTF 2nd order force in the time domain.',ErrStat, ErrMsg, RoutineName) - ALLOCATE( SumQTFForce( 0:InitInp%NStepWave, 6*p%NBody), STAT=ErrStatTmp ) + ALLOCATE( SumQTFForce( 0:InitInp%WaveField%NStepWave, 6*p%NBody), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,' Cannot allocate array for the full difference '// & 'QTF 2nd order force time series.',ErrStat, ErrMsg, RoutineName) @@ -2740,7 +2233,7 @@ SUBROUTINE SumQTF_InitCalc( InitInp, p, SumQTFData, SumQTFForce, ErrMsg, ErrStat ! Initialize the FFT library. Normalization not required in this formulation. - CALL InitFFT ( InitInp%NStepWave, FFT_Data, .FALSE., ErrStatTmp ) ! FIXME: + CALL InitFFT ( InitInp%WaveField%NStepWave, FFT_Data, .FALSE., ErrStatTmp ) ! FIXME: CALL SetErrStat(ErrStatTmp,'Error occured while initializing the FFT.',ErrStat,ErrMsg,RoutineName) IF ( ErrStat >= AbortErrLev ) THEN IF (ALLOCATED(TmpData4D)) DEALLOCATE(TmpData4D,STAT=ErrStatTmp) @@ -2795,25 +2288,32 @@ SUBROUTINE SumQTF_InitCalc( InitInp, p, SumQTFData, SumQTFForce, ErrMsg, ErrStat ! The limits look a little funny. But remember we are placing the value in the 2*J location, ! so we cannot overun the end of the array, and the highest frequency must be zero. The ! floor function is just in case (NStepWave2 - 1) is an odd number - DO J=1,FLOOR(REAL(InitInp%NStepWave2-1)/2.0_SiKi) + DO J=1,FLOOR(REAL(InitInp%WaveField%NStepWave2-1)/2.0_SiKi) ! The frequency - Omega1 = REAL(J,ReKi) * InitInp%WaveDOmega + Omega1 = REAL(J,ReKi) * InitInp%WaveField%WaveDOmega OmegaSum = 2.0_SiKi * Omega1 ! the sum frequency ! Only perform calculations if the difference frequency is in the right range - IF ( (OmegaSum >= InitInp%WvLowCOffS) .AND. (OmegaSum <= InitInp%WvHiCOffS) ) THEN + IF ( (OmegaSum >= InitInp%WaveField%WvLowCOffS) .AND. (OmegaSum <= InitInp%WaveField%WvHiCOffS) ) THEN ! Find the wave amplitude at frequency omega - aWaveElevC1 = CMPLX( InitInp%WaveElevC0(1,J), InitInp%WaveElevC0(2,J), SiKi ) / InitInp%NStepWave2 + aWaveElevC1 = CMPLX( InitInp%WaveField%WaveElevC0(1,J), InitInp%WaveField%WaveElevC0(2,J), SiKi ) / InitInp%WaveField%NStepWave2 ! Set the (omega1,omega2,beta1,beta2) point we are looking for. - Coord4 = (/ REAL(Omega1,SiKi), REAL(Omega1,SiKi), InitInp%WaveDirArr(J), InitInp%WaveDirArr(J) /) + Coord4 = (/ REAL(Omega1,SiKi), REAL(Omega1,SiKi), InitInp%WaveField%WaveDirArr(J), InitInp%WaveField%WaveDirArr(J) /) ! Apply local Z rotation to heading angle (degrees) to put wave direction into the local (rotated) body frame - Coord4(3) = Coord4(3) - RotateZdegOffset - Coord4(4) = Coord4(4) - RotateZdegOffset + Coord4(3) = Coord4(3) - RotateZdegOffset - InitInp%PtfmRefY*R2D + Coord4(4) = Coord4(4) - RotateZdegOffset - InitInp%PtfmRefY*R2D + + ! Make sure the wave headings are in the correct range + dirInRange = GetAngleInRange(Coord4(3),W2WvDir1Range(1),W2WvDir1Range(2),tmpDir); Coord4(3) = tmpDir + dirInRange = GetAngleInRange(Coord4(4),W2WvDir2Range(1),W2WvDir2Range(2),tmpDir); Coord4(4) = tmpDir + IF (.NOT. dirInRange) THEN ! Somewhat redundant check. Can be removed in the future. + CALL SetErrStat(ErrID_Fatal,' Wave heading out of range.', ErrStat, ErrMsg, RoutineName) + END IF ! get the interpolated value for F(omega1,omega2,beta1,beta2) --> QTF_Value CALL WAMIT_Interp4D_Cplx( Coord4, TmpData4D, SumQTFData%Data4D%WvFreq1, SumQTFData%Data4D%WvFreq2, & @@ -2831,13 +2331,13 @@ SUBROUTINE SumQTF_InitCalc( InitInp, p, SumQTFData, SumQTFForce, ErrMsg, ErrStat !> The phase shift due to an (x,y) offset for second order difference frequencies is of the form !! \f$ exp[-\imath ( k(\omega_1) ( X cos(\beta(w_1)) + Y sin(\beta(w_1)) ) !! 1 k(\omega_2) ( X cos(\beta(w_2)) + Y sin(\beta(w_2)) ) ) ]\f$. - !! For the first term, \f$ \omega_1 = \omega_2 \$f. + !! For the first term, \f$ \omega_1 = \omega_2 \f$. ! NOTE: the phase shift applies to the aWaveElevC of the incoming wave. Including it here instead ! of above is mathematically equivalent, but only because each frequency has only one wave ! direction associated with it through the equal energy approach used in multidirectional waves. - WaveNmbr1 = WaveNumber ( REAL(Omega1,SiKi), InitInp%Gravity, InitInp%WtrDpth ) ! SiKi returned - TmpReal1 = WaveNmbr1 * ( InitInp%PtfmRefxt(1)*cos(InitInp%WaveDirArr(J)*D2R) + InitInp%PtfmRefyt(1)*sin(InitInp%WaveDirArr(J)*D2R) ) + WaveNmbr1 = WaveNumber ( REAL(Omega1,SiKi), InitInp%Gravity, InitInp%WaveField%EffWtrDpth ) ! SiKi returned + TmpReal1 = WaveNmbr1 * ( InitInp%PtfmRefxt(1)*cos(InitInp%WaveField%WaveDirArr(J)*D2R) + InitInp%PtfmRefyt(1)*sin(InitInp%WaveField%WaveDirArr(J)*D2R) ) ! Set the phase shift for the set of sum frequencies PhaseShiftXY = CMPLX( cos(TmpReal1 + TmpReal1), -sin(TmpReal1 + TmpReal1) ) @@ -2878,11 +2378,11 @@ SUBROUTINE SumQTF_InitCalc( InitInp, p, SumQTFData, SumQTFForce, ErrMsg, ErrStat ! so, we don't need a really small WaveDT !This section has been removed since it is kind of annoying. - ! IF ( InitInp%WvHiCOffS > InitInp%NStepWave2*InitInp%WaveDOmega ) THEN + ! IF ( InitInp%WvHiCOffS > InitInp%WaveField%NStepWave2*InitInp%WaveField%WaveDOmega ) THEN ! CALL SetErrStat( ErrID_Warn,' The high frequency cutoff for second order wave forces, WvHiCOffS, '// & ! 'is larger than the Nyquist frequency for the given time step of WaveDT. The Nyquist frequency '// & ! '(highest frequency) that can be computed is OmegaMax = PI/WaveDT = '// & - ! TRIM(Num2LStr(InitInp%NStepWave2*InitInp%WaveDOmega))// & + ! TRIM(Num2LStr(InitInp%WaveField%NStepWave2*InitInp%WaveField%WaveDOmega))// & ! ' radians/second. If you need those frequencies, decrease WaveDT. For reference, 2*PI '// & ! 'radians/second corresponds to a wavelength of ~1 meter.',& ! ErrStat,ErrMsg,RoutineName) @@ -2891,10 +2391,10 @@ SUBROUTINE SumQTF_InitCalc( InitInp, p, SumQTFData, SumQTFForce, ErrMsg, ErrStat ! Outer loop to create the Term2ArrayC. This is stepwise through the sum frequencies. - DO J=1,InitInp%NStepWave2 + DO J=1,InitInp%WaveField%NStepWave2 ! Calculate the frequency -- This is the sum frequency. - OmegaSum = J * InitInp%WaveDOmega + OmegaSum = J * InitInp%WaveField%WaveDOmega @@ -2903,7 +2403,7 @@ SUBROUTINE SumQTF_InitCalc( InitInp, p, SumQTFData, SumQTFForce, ErrMsg, ErrStat ! Only perform calculations if the difference frequency is in the right range - IF ( (OmegaSum >= InitInp%WvLowCOffS) .AND. (OmegaSum <= InitInp%WvHiCOffS) ) THEN + IF ( (OmegaSum >= InitInp%WaveField%WvLowCOffS) .AND. (OmegaSum <= InitInp%WaveField%WvHiCOffS) ) THEN !> Now do the inner sum. We are going to perform a sum up to the maximum frequency that we !! can support (Nyquist frequency) for the given WaveDOmega and NStepWave2 (WaveOmegaMax = @@ -2915,19 +2415,26 @@ SUBROUTINE SumQTF_InitCalc( InitInp, p, SumQTFData, SumQTFForce, ErrMsg, ErrStat DO K=0,FLOOR(Real(J-1)/2.0_SiKi) ! Calculate the frequency pair - Omega1 = K * InitInp%WaveDOmega - Omega2 = (J-K) * InitInp%WaveDOmega + Omega1 = K * InitInp%WaveField%WaveDOmega + Omega2 = (J-K) * InitInp%WaveField%WaveDOmega ! Find the wave amplitude at frequency omega. Remove the NStepWave2 normalization built into WaveElevC0 from Waves module - aWaveElevC1 = CMPLX( InitInp%WaveElevC0(1, K), InitInp%WaveElevC0(2, K), SiKi ) / InitInp%NStepWave2 - aWaveElevC2 = CMPLX( InitInp%WaveElevC0(1,J-K), InitInp%WaveElevC0(2,J-K), SiKi ) / InitInp%NStepWave2 + aWaveElevC1 = CMPLX( InitInp%WaveField%WaveElevC0(1, K), InitInp%WaveField%WaveElevC0(2, K), SiKi ) / InitInp%WaveField%NStepWave2 + aWaveElevC2 = CMPLX( InitInp%WaveField%WaveElevC0(1,J-K), InitInp%WaveField%WaveElevC0(2,J-K), SiKi ) / InitInp%WaveField%NStepWave2 ! Set the (omega1,omega2,beta1,beta2) point we are looking for. - Coord4 = (/ REAL(Omega1,SiKi), REAL(Omega2,SiKi), InitInp%WaveDirArr(K), InitInp%WaveDirArr(J-K) /) + Coord4 = (/ REAL(Omega1,SiKi), REAL(Omega2,SiKi), InitInp%WaveField%WaveDirArr(K), InitInp%WaveField%WaveDirArr(J-K) /) ! Apply local Z rotation to heading angle (degrees) to put wave direction into the local (rotated) body frame - Coord4(3) = Coord4(3) - RotateZdegOffset - Coord4(4) = Coord4(4) - RotateZdegOffset + Coord4(3) = Coord4(3) - RotateZdegOffset - InitInp%PtfmRefY*R2D + Coord4(4) = Coord4(4) - RotateZdegOffset - InitInp%PtfmRefY*R2D + + ! Make sure the wave headings are in the correct range + dirInRange = GetAngleInRange(Coord4(3),W2WvDir1Range(1),W2WvDir1Range(2),tmpDir); Coord4(3) = tmpDir + dirInRange = GetAngleInRange(Coord4(4),W2WvDir2Range(1),W2WvDir2Range(2),tmpDir); Coord4(4) = tmpDir + IF (.NOT. dirInRange) THEN ! Somewhat redundant check. Can be removed in the future. + CALL SetErrStat(ErrID_Fatal,' Wave heading out of range.', ErrStat, ErrMsg, RoutineName) + END IF ! get the interpolated value for F(omega1,omega2,beta1,beta2) --> QTF_Value CALL WAMIT_Interp4D_Cplx( Coord4, TmpData4D, SumQTFData%Data4D%WvFreq1, SumQTFData%Data4D%WvFreq2, & @@ -2949,10 +2456,10 @@ SUBROUTINE SumQTF_InitCalc( InitInp, p, SumQTFData, SumQTFForce, ErrMsg, ErrStat ! of above is mathematically equivalent, but only because each frequency has only one wave ! direction associated with it through the equal energy approach used in multidirectional waves. - WaveNmbr1 = WaveNumber ( REAL(Omega1,SiKi), InitInp%Gravity, InitInp%WtrDpth ) ! SiKi returned - WaveNmbr2 = WaveNumber ( REAL(Omega2,SiKi), InitInp%Gravity, InitInp%WtrDpth ) ! SiKi returned - TmpReal1 = WaveNmbr1 * ( InitInp%PtfmRefxt(1)*cos(InitInp%WaveDirArr(K)*D2R) + InitInp%PtfmRefyt(1)*sin(InitInp%WaveDirArr(K)*D2R) ) - TmpReal2 = WaveNmbr2 * ( InitInp%PtfmRefxt(1)*cos(InitInp%WaveDirArr(J-K)*D2R) + InitInp%PtfmRefyt(1)*sin(InitInp%WaveDirArr(J-K)*D2R) ) + WaveNmbr1 = WaveNumber ( REAL(Omega1,SiKi), InitInp%Gravity, InitInp%WaveField%EffWtrDpth ) ! SiKi returned + WaveNmbr2 = WaveNumber ( REAL(Omega2,SiKi), InitInp%Gravity, InitInp%WaveField%EffWtrDpth ) ! SiKi returned + TmpReal1 = WaveNmbr1 * ( InitInp%PtfmRefxt(1)*cos(InitInp%WaveField%WaveDirArr(K)*D2R) + InitInp%PtfmRefyt(1)*sin(InitInp%WaveField%WaveDirArr(K)*D2R) ) + TmpReal2 = WaveNmbr2 * ( InitInp%PtfmRefxt(1)*cos(InitInp%WaveField%WaveDirArr(J-K)*D2R) + InitInp%PtfmRefyt(1)*sin(InitInp%WaveField%WaveDirArr(J-K)*D2R) ) ! Set the phase shift for the set of sum frequencies PhaseShiftXY = CMPLX( cos(TmpReal1 + TmpReal2), -sin(TmpReal1 + TmpReal2) ) @@ -2982,11 +2489,11 @@ SUBROUTINE SumQTF_InitCalc( InitInp, p, SumQTFData, SumQTFForce, ErrMsg, ErrStat ! Set rotation ! NOTE: RotateZMatrixT is the rotation from local to global. - RotateZMatrixT(:,1) = (/ cos(InitInp%PtfmRefztRot(IBody)), -sin(InitInp%PtfmRefztRot(IBody)) /) - RotateZMatrixT(:,2) = (/ sin(InitInp%PtfmRefztRot(IBody)), cos(InitInp%PtfmRefztRot(IBody)) /) + RotateZMatrixT(1,:) = (/ cos(InitInp%PtfmRefztRot(IBody)+InitInp%PtfmRefY), -sin(InitInp%PtfmRefztRot(IBody)+InitInp%PtfmRefY) /) + RotateZMatrixT(2,:) = (/ sin(InitInp%PtfmRefztRot(IBody)+InitInp%PtfmRefY), cos(InitInp%PtfmRefztRot(IBody)+InitInp%PtfmRefY) /) ! Loop through all the frequencies - DO J=1,InitInp%NStepWave2 + DO J=1,InitInp%WaveField%NStepWave2 ! Apply the rotation to get back to global frame -- term 1 Term1ArrayC(J,1:2) = MATMUL(RotateZMatrixT, Term1ArrayC(J,1:2)) @@ -2996,7 +2503,7 @@ SUBROUTINE SumQTF_InitCalc( InitInp, p, SumQTFData, SumQTFForce, ErrMsg, ErrStat Term2ArrayC(J,1:2) = MATMUL(RotateZMatrixT, Term2ArrayC(J,1:2)) Term2ArrayC(J,4:5) = MATMUL(RotateZMatrixT, Term2ArrayC(J,4:5)) - ENDDO ! J=1,InitInp%NStepWave2 + ENDDO ! J=1,InitInp%WaveField%NStepWave2 @@ -3026,12 +2533,12 @@ SUBROUTINE SumQTF_InitCalc( InitInp, p, SumQTFData, SumQTFForce, ErrMsg, ErrStat ENDIF ! Now we add the two terms together. The 0.5 multiplier on is because the double sided FFT was used. - DO J=0,InitInp%NStepWave-1 !bjj: Term1Array and Term2Array don't set the last element, so we can get over-flow errors here. SumQTFForce(InitInp%NStepWave,Idx) gets overwritten later, so Idx'm setting the array bounds to be -1. + DO J=0,InitInp%WaveField%NStepWave-1 !bjj: Term1Array and Term2Array don't set the last element, so we can get overflow errors here. SumQTFForce(InitInp%WaveField%NStepWave,Idx) gets overwritten later, so I'm setting the array bounds to be InitInp%WaveField%NStepWave-1. SumQTFForce(J,Idx) = 0.5_SiKi*(REAL(Term1Array(J) + 2*Term2Array(J), SiKi)) ENDDO ! Copy the last first term to the first so that it is cyclic - SumQTFForce(InitInp%NStepWave,Idx) = SumQTFForce(0,Idx) + SumQTFForce(InitInp%WaveField%NStepWave,Idx) = SumQTFForce(0,Idx) ENDDO ! ThisDim -- current dimension @@ -3069,14 +2576,12 @@ END SUBROUTINE SumQTF_InitCalc !! !! This subroutine also populates the InitOut and creates the filenames for each of the calculation types. !! - SUBROUTINE CheckInitInput( InitInp, Interval, InitOut, p, MnDriftData, NewmanAppData, DiffQTFData, SumQTFData, ErrStat, ErrMsg ) + SUBROUTINE CheckInitInput( InitInp, p, MnDriftData, NewmanAppData, DiffQTFData, SumQTFData, ErrStat, ErrMsg ) IMPLICIT NONE ! Passed variables. TYPE(WAMIT2_InitInputType), INTENT(IN ) :: InitInp !< Input data for initialization routine - REAL(DbKi), INTENT(IN ) :: Interval !< Coupling interval in seconds: don't change it from the glue code provided value. - TYPE(WAMIT2_InitOutputType), INTENT(INOUT) :: InitOut !< The output from the init routine TYPE(WAMIT2_ParameterType), INTENT( OUT) :: p !< The parameters ! QTF storage -- from the data files that are read in @@ -3093,7 +2598,7 @@ SUBROUTINE CheckInitInput( InitInp, Interval, InitOut, p, MnDriftData, NewmanApp ! Temporary Error Variables INTEGER(IntKi) :: ErrStatTmp !< Temporary variable for the local error status -! CHARACTER(2048) :: ErrMsgTmp !< Temporary error message variable + CHARACTER(ErrMsgLen) :: ErrMsgTmp !< Temporary error message variable CHARACTER(*), PARAMETER :: RoutineName = 'CheckInitInput' !> ## Subroutine contents @@ -3104,9 +2609,7 @@ SUBROUTINE CheckInitInput( InitInp, Interval, InitOut, p, MnDriftData, NewmanApp !> 1. Initialize error variables ErrStat = ErrID_None - ErrStatTmp = ErrID_None ErrMsg = '' - ErrMsgTmp = '' !> 2. Initialize filenames MnDriftData%Filename = '' @@ -3138,6 +2641,28 @@ SUBROUTINE CheckInitInput( InitInp, Interval, InitOut, p, MnDriftData, NewmanApp !! for each method listing which dimensions to use. !! !-------------------------------------------------------------------------------- + ! Platform large yaw offset model + p%PtfmYMod = InitInp%PtfmYMod + + ! Set up 2nd-order wave excitation grid + ! Copy WaveField grid parameters + call SeaSt_WaveField_CopyParam(InitInp%WaveField%GridParams, p%Exctn2GridParams, 0, ErrStatTmp, ErrMsgTmp); CALL SetErrStat( ErrStatTmp, ErrMsgTmp, ErrStat, ErrMsg, RoutineName) + ! x and y grids are currently not used for second-order wave excitation + p%Exctn2GridParams%n(2:3) = 1_IntKi + p%Exctn2GridParams%delta(2:3) = 0.0_SiKi + p%Exctn2GridParams%pZero(2:3) = 0.0_SiKi + ! Set the fourth index based on PRP heading + if ( InitInp%PtfmYMod .EQ. 0) then ! Constant reference yaw offset + p%NExctnHdg = 0_IntKi + p%Exctn2GridParams%delta(4) = 0.0 + p%Exctn2GridParams%pZero(4) = InitInp%PtfmRefY + else if ( InitInp%PtfmYMod .EQ. 1 ) then ! Drifting reference yaw offset + p%NExctnHdg = InitInp%NExctnHdg + p%Exctn2GridParams%delta(4) = TwoPi/Real(MAX(p%NExctnHdg,1_IntKi),ReKi) + p%Exctn2GridParams%pZero(4) = -Pi + end if + p%Exctn2GridParams%n(4) = p%NExctnHdg+1 + p%Exctn2GridParams%Z_depth = -1.0 ! Set to Z_depth to a negative value to indicate uniform "z" grid for platform heading !> 1. Check that we only specified one of MnDrift, NewmanApp, or DiffQTF @@ -3147,11 +2672,8 @@ SUBROUTINE CheckInitInput( InitInp, Interval, InitOut, p, MnDriftData, NewmanApp ( InitInp%DiffQTF /= 0 .AND. InitInp%NewmanApp /= 0 ) .OR. & ( InitInp%MnDrift /= 0 .AND. InitInp%DiffQTF /= 0 ) ) THEN CALL SetErrStat( ErrID_Fatal, ' Only one of MnDrift, NewmanApp, or DiffQTF can be non-zero.', ErrStat, ErrMsg, RoutineName) + IF ( ErrStat >= AbortErrLev ) RETURN END IF - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp - RETURN - ENDIF !> 2. Check that we have a valid values for MnDrift, check flag status @@ -3177,10 +2699,8 @@ SUBROUTINE CheckInitInput( InitInp, Interval, InitOut, p, MnDriftData, NewmanApp ' MnDrift can only have values of 0, 7, 8, 9, 10, 11, or 12. '//NewLine// & ' --> This should have been checked by the calling program.', ErrStat, ErrMsg, RoutineName) END IF - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp - RETURN - ENDIF + IF ( ErrStat >= AbortErrLev ) RETURN + !> 3. Check that we have a valid values for NewmanApp, check flag status @@ -3205,10 +2725,7 @@ SUBROUTINE CheckInitInput( InitInp, Interval, InitOut, p, MnDriftData, NewmanApp ' NewmanApp can only have values of 0, 7, 8, 9, 10, 11, or 12. '//NewLine// & ' --> This should have been checked by the calling program.', ErrStat, ErrMsg, RoutineName) END IF - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp - RETURN - ENDIF + IF ( ErrStat >= AbortErrLev ) RETURN !> 4. Check that we have a valid values for DiffQTF, check flag status @@ -3230,10 +2747,7 @@ SUBROUTINE CheckInitInput( InitInp, Interval, InitOut, p, MnDriftData, NewmanApp ' DiffQTF can only have values of 0, 10, 11, or 12. '//NewLine// & ' --> This should have been checked by the calling program.', ErrStat, ErrMsg, RoutineName) END IF - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp - RETURN - ENDIF + IF ( ErrStat >= AbortErrLev ) RETURN !> 5. Check that we have a valid values for SumQTF, check flag status @@ -3255,45 +2769,7 @@ SUBROUTINE CheckInitInput( InitInp, Interval, InitOut, p, MnDriftData, NewmanApp ' SumQTF can only have values of 0, 10, 11, or 12. '//NewLine// & ' --> This should have been checked by the calling program.', ErrStat, ErrMsg, RoutineName) END IF - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp - RETURN - ENDIF - - - !-------------------------------------------------------------------------------- - !> ### Check the Min and Max frequencies for the full QTF cases - !! - !! -- these checks are performed based on the DiffQTFF and SumQTFF flags - !-------------------------------------------------------------------------------- - - - !> 1. Check that the min / max diff frequencies make sense if using DiffQTF - - IF ( InitInp%DiffQTFF .eqv. .TRUE. ) THEN - IF ( ( InitInp%WvHiCOffD < InitInp%WvLowCOffD ) .OR. ( InitInp%WvLowCOffD < 0.0 ) ) THEN - CALL SetErrStat( ErrID_Fatal, ' Programming Error in call to WAMIT2_Init: '//NewLine// & - ' WvHiCOffD must be larger than WvLowCOffD. Both must be positive.'// & - ' --> This should have been checked by the calling program.', ErrStat, ErrMsg, RoutineName) - CALL CleanUp - RETURN - END IF - END IF - - - !> 2. Check that the min / max diff frequencies make sense if using SumQTF - - IF ( InitInp%SumQTFF .eqv. .TRUE. ) THEN - IF ( ( InitInp%WvHiCOffS < InitInp%WvLowCOffS ) .OR. ( InitInp%WvLowCOffS < 0.0 ) ) THEN - CALL SetErrStat( ErrID_Fatal, ' Programming Error in call to WAMIT2_Init: '//NewLine// & - ' WvHiCOffS must be larger than WvLowCOffS. Both must be positive.'// & - ' --> This should have been checked by the calling program.', ErrStat, ErrMsg, RoutineName) - CALL CleanUp - RETURN - END IF - END IF - - + IF ( ErrStat >= AbortErrLev ) RETURN !-------------------------------------------------------------------------------- !> ### Assemble the names of the WAMIT data files we are using and verify existence @@ -3314,10 +2790,9 @@ SUBROUTINE CheckInitInput( InitInp, Interval, InitOut, p, MnDriftData, NewmanApp INQUIRE( file=TRIM(MnDriftData%Filename), exist=TmpFileExist ) MnDriftData%DataIs4D = .TRUE. ENDIF - IF ( TmpFileExist .eqv. .FALSE. ) THEN + IF ( .not. TmpFileExist ) THEN CALL SetErrStat( ErrID_Fatal, ' Cannot find the WAMIT file '//TRIM(MnDriftData%Filename)// & ' required by the MnDrift option.', ErrStat, ErrMsg, RoutineName) - CALL CLeanup RETURN END IF END IF @@ -3338,10 +2813,9 @@ SUBROUTINE CheckInitInput( InitInp, Interval, InitOut, p, MnDriftData, NewmanApp INQUIRE( file=TRIM(NewmanAppData%Filename), exist=TmpFileExist ) NewmanAppData%DataIs4D = .TRUE. ENDIF - IF ( TmpFileExist .eqv. .FALSE. ) THEN + IF ( .not. TmpFileExist ) THEN CALL SetErrStat( ErrID_Fatal, ' Cannot find the WAMIT file '//TRIM(NewmanAppData%Filename)// & ' required by the NewmanApp option.', ErrStat, ErrMsg, RoutineName) - CALL CleanUp RETURN END IF END IF @@ -3355,10 +2829,9 @@ SUBROUTINE CheckInitInput( InitInp, Interval, InitOut, p, MnDriftData, NewmanApp IF ( InitInp%DiffQTF /= 0) THEN DiffQTFData%Filename = TRIM(InitInp%WAMITFile)//'.'//TRIM(Num2LStr(InitInp%DiffQTF))//'d' INQUIRE( file=TRIM(DiffQTFData%Filename), exist=TmpFileExist ) - IF ( TmpFileExist .eqv. .FALSE. ) THEN + IF ( .not. TmpFileExist ) THEN CALL SetErrStat( ErrID_Fatal, ' Cannot find the WAMIT file '//TRIM(DiffQTFData%Filename)// & ' required by the DiffQTF option.', ErrStat, ErrMsg, RoutineName) - CALL CleanUp RETURN END IF DiffQTFData%DataIs4D = .TRUE. @@ -3375,7 +2848,6 @@ SUBROUTINE CheckInitInput( InitInp, Interval, InitOut, p, MnDriftData, NewmanApp IF ( .not. TmpFileExist ) THEN CALL SetErrStat( ErrID_Fatal, ' Cannot find the WAMIT file '//TRIM(SumQTFData%Filename)// & ' required by the SumQTF option.', ErrStat, ErrMsg, RoutineName) - CALL CleanUp RETURN END IF SumQTFData%DataIs4D = .TRUE. @@ -3389,12 +2861,11 @@ SUBROUTINE CheckInitInput( InitInp, Interval, InitOut, p, MnDriftData, NewmanApp !> 1. Check that WaveElevC0 is a 2x(NStepWave2+1) sized array (0 index start) - IF ( SIZE( InitInp%WaveElevC0, 2 ) /= (InitInp%NStepWave2 + 1) ) THEN ! Expect a 2x(0:NStepWave2) array + IF ( SIZE( InitInp%WaveField%WaveElevC0, 2 ) /= (InitInp%WaveField%NStepWave2 + 1) ) THEN ! Expect a 2x(0:NStepWave2) array CALL SetErrStat( ErrID_Fatal, ' Programming error in call to WAMIT2_Init:'//NewLine// & - ' --> Expected array for WaveElevC0 to be of size 2x'//TRIM(Num2LStr(InitInp%NStepWave2 + 1))// & + ' --> Expected array for WaveElevC0 to be of size 2x'//TRIM(Num2LStr(InitInp%WaveField%NStepWave2 + 1))// & ' (2x(NStepWave2+1)), but instead received array of size '// & - TRIM(Num2LStr(SIZE(InitInp%WaveElevC0,1)))//'x'//TRIM(Num2LStr(SIZE(InitInp%WaveElevC0,2)))//'.', ErrStat, ErrMsg, RoutineName) - CALL CleanUp + TRIM(Num2LStr(SIZE(InitInp%WaveField%WaveElevC0,1)))//'x'//TRIM(Num2LStr(SIZE(InitInp%WaveField%WaveElevC0,2)))//'.', ErrStat, ErrMsg, RoutineName) RETURN END IF @@ -3404,20 +2875,9 @@ SUBROUTINE CheckInitInput( InitInp, Interval, InitOut, p, MnDriftData, NewmanApp !-------------------------------------------------------------------------------- !> ### Now copy over things to parameters... !-------------------------------------------------------------------------------- - !> 1. Wave information we need to keep - !-------------------------------------------------------------------------------- - p%NStepWave = InitInp%NStepWave - - - !-------------------------------------------------------------------------------- - !> 2. Time related information - !-------------------------------------------------------------------------------- - - p%DT = Interval ! Timestep from calling program - !-------------------------------------------------------------------------------- - !> 3. WAMIT body related information + !> WAMIT body related information !-------------------------------------------------------------------------------- p%NBody = InitInp%NBody ! Number of bodies WAMIT2 sees @@ -3426,7 +2886,6 @@ SUBROUTINE CheckInitInput( InitInp, Interval, InitOut, p, MnDriftData, NewmanApp ! This module's implementation requires that if NBodyMod = 2 or 3, then there is one instance of a WAMIT module for each body, therefore, HydroDyn may have NBody > 1, but this WAMIT module will have NBody = 1 if ( (p%NBodyMod > 1) .and. (p%NBody > 1) ) then CALL SetErrStat( ErrID_Fatal, "DEVELOPER ERROR: If NBodyMod = 2 or 3, then NBody for the a WAMIT2 object must be equal to 1", ErrStat, ErrMsg, RoutineName) - CALL CleanUp return end if @@ -3535,8 +2994,8 @@ SUBROUTINE CheckInitInput( InitInp, Interval, InitOut, p, MnDriftData, NewmanApp !-------------------------------------------------------------------------------- ! Allocate array for the WaveExtcn2. - ALLOCATE( p%WaveExctn2(0:InitInp%NStepWave,6*p%NBody), STAT=ErrStatTmp) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array p%WaveExctn2 to store '// & + ALLOCATE( p%WaveExctn2Grid(0:InitInp%WaveField%NStepWave,1,1,p%NExctnHdg+1,6*p%NBody), STAT=ErrStatTmp) + IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array p%WaveExctn2Grid to store '// & 'the 2nd order force data.', ErrStat,ErrMsg,'CheckInitInp') IF (ErrStat >= AbortErrLev ) RETURN @@ -3600,7 +3059,7 @@ SUBROUTINE Read_DataFile3D( InitInp, Filename3D, Data3D, ErrStat, Errmsg ) ! File reading variables - CHARACTER(1024) :: TextLine !< One line of text read from the file + CHARACTER(MaxFileInfoLineLen) :: TextLine !< One line of text read from the file INTEGER(IntKi) :: LineLen !< The length of the line read in REAL(SiKi), ALLOCATABLE :: TmpRealArr(:) !< Temporary real array REAL(SiKi), ALLOCATABLE :: TmpDataRow(:) !< Single row of data @@ -3631,9 +3090,7 @@ SUBROUTINE Read_DataFile3D( InitInp, Filename3D, Data3D, ErrStat, Errmsg ) ! Initialize error variables ErrStat = ErrID_None - ErrStatTmp = ErrID_None ErrMsg = '' - ErrMsgTmp = '' HaveZeroFreq1 = .FALSE. ! If we find a zero frequency, we will set this to true @@ -3658,30 +3115,17 @@ SUBROUTINE Read_DataFile3D( InitInp, Filename3D, Data3D, ErrStat, Errmsg ) !$OMP end critical(fileopen) CALL SetErrStat( ErrStatTmp, ErrMsgTmp, ErrStat, ErrMsg, RoutineName) IF ( ErrStat >= AbortErrLev ) THEN - CLOSE( UnitDataFile ) - IF (ALLOCATED(TmpRealArr)) DEALLOCATE(TmpRealArr,STAT=ErrStatTmp) - IF (ALLOCATED(RawData3D)) DEALLOCATE(RawData3D,STAT=ErrStatTmp) - IF (ALLOCATED(RawData3DTmp)) DEALLOCATE(RawData3DTmp,STAT=ErrStatTmp) - IF (ALLOCATED(TmpDataRow)) DEALLOCATE(TmpDataRow,STAT=ErrStatTmp) - IF (ALLOCATED(TmpWvFreq1)) DEALLOCATE(TmpWvFreq1,STAT=ErrStatTmp) - CALL CleanUp + UnitDataFile = -1 + CALL CleanUp() RETURN ENDIF - REWIND( UnitDataFile ) - ! Do an initial readthrough and find out the length of the file, if there is a header line, and the number of columns in the file. - CALL GetFileLength( UnitDataFile, TRIM(Filename3D), NumDataColumns, NumDataLines, NumHeaderLines, ErrStat, ErrMsg) + CALL GetFileLength( UnitDataFile, TRIM(Filename3D), NumDataColumns, NumDataLines, NumHeaderLines, ErrStatTmp, ErrMsgTmp) CALL SetErrStat( ErrStatTmp, ErrMsgTmp, ErrStat, ErrMsg, RoutineName) IF ( ErrStat >= AbortErrLev ) THEN - CLOSE( UnitDataFile ) - IF (ALLOCATED(TmpRealArr)) DEALLOCATE(TmpRealArr,STAT=ErrStatTmp) - IF (ALLOCATED(RawData3D)) DEALLOCATE(RawData3D,STAT=ErrStatTmp) - IF (ALLOCATED(RawData3DTmp)) DEALLOCATE(RawData3DTmp,STAT=ErrStatTmp) - IF (ALLOCATED(TmpDataRow)) DEALLOCATE(TmpDataRow,STAT=ErrStatTmp) - IF (ALLOCATED(TmpWvFreq1)) DEALLOCATE(TmpWvFreq1,STAT=ErrStatTmp) - CALL CleanUp + CALL CleanUp() RETURN ENDIF @@ -3690,13 +3134,7 @@ SUBROUTINE Read_DataFile3D( InitInp, Filename3D, Data3D, ErrStat, Errmsg ) IF ( NumDataColumns /= 8 ) THEN CALL SetErrStat( ErrID_Fatal, ' The 2nd order WAMIT data file '//TRIM(Filename3D)//' has '//TRIM(Num2LStr(NumDataColumns))// & ' columns instead of the 8 columns expected.', ErrStat, ErrMsg, RoutineName) - CLOSE( UnitDataFile ) - IF (ALLOCATED(RawData3D)) DEALLOCATE(RawData3D,STAT=ErrStatTmp) - IF (ALLOCATED(RawData3DTmp)) DEALLOCATE(RawData3DTmp,STAT=ErrStatTmp) - IF (ALLOCATED(TmpRealArr)) DEALLOCATE(TmpRealArr,STAT=ErrStatTmp) - IF (ALLOCATED(TmpDataRow)) DEALLOCATE(TmpDataRow,STAT=ErrStatTmp) - IF (ALLOCATED(TmpWvFreq1)) DEALLOCATE(TmpWvFreq1,STAT=ErrStatTmp) - CALL CleanUp + CALL CleanUp() RETURN ENDIF @@ -3714,13 +3152,7 @@ SUBROUTINE Read_DataFile3D( InitInp, Filename3D, Data3D, ErrStat, Errmsg ) CALL AllocAry( RawData3DTmp, NumDataLines, NumDataColumns, ' Array for holding raw 3D data for 2nd order WAMIT files', ErrStatTmp, ErrMsgTmp ) CALL SetErrStat( ErrStatTmp, ErrMsgTmp, ErrStat, ErrMsg, RoutineName) IF ( ErrStat >= AbortErrLev ) THEN - CLOSE( UnitDataFile ) - IF (ALLOCATED(TmpRealArr)) DEALLOCATE(TmpRealArr,STAT=ErrStatTmp) - IF (ALLOCATED(RawData3D)) DEALLOCATE(RawData3D,STAT=ErrStatTmp) - IF (ALLOCATED(RawData3DTmp)) DEALLOCATE(RawData3DTmp,STAT=ErrStatTmp) - IF (ALLOCATED(TmpDataRow)) DEALLOCATE(TmpDataRow,STAT=ErrStatTmp) - IF (ALLOCATED(TmpWvFreq1)) DEALLOCATE(TmpWvFreq1,STAT=ErrStatTmp) - CALL CleanUp + CALL CleanUp() RETURN ENDIF @@ -3736,19 +3168,14 @@ SUBROUTINE Read_DataFile3D( InitInp, Filename3D, Data3D, ErrStat, Errmsg ) ErrStatTmp, ErrMsgTmp ) ! Note, not echoing this to anything. CALL SetErrStat( ErrStatTmp, ErrMsgTmp, ErrStat, ErrMsg, RoutineName) IF ( ErrStat >= AbortErrLev ) THEN - CLOSE( UnitDataFile ) - IF (ALLOCATED(TmpRealArr)) DEALLOCATE(TmpRealArr,STAT=ErrStatTmp) - IF (ALLOCATED(RawData3D)) DEALLOCATE(RawData3D,STAT=ErrStatTmp) - IF (ALLOCATED(RawData3DTmp)) DEALLOCATE(RawData3DTmp,STAT=ErrStatTmp) - IF (ALLOCATED(TmpDataRow)) DEALLOCATE(TmpDataRow,STAT=ErrStatTmp) - IF (ALLOCATED(TmpWvFreq1)) DEALLOCATE(TmpWvFreq1,STAT=ErrStatTmp) - CALL CleanUp + CALL CleanUp() RETURN ENDIF RawData3DTmp(I,:) = TmpDataRow ENDDO CLOSE( UnitDataFile ) + UnitDataFile = -1 !> Before continuing, we need to figure out how many actual lines of data we will @@ -3771,13 +3198,7 @@ SUBROUTINE Read_DataFile3D( InitInp, Filename3D, Data3D, ErrStat, Errmsg ) CALL AllocAry( RawData3D, NumDataLinesKeep, NumDataColumns, ' Array for holding raw 3D data for 2nd order WAMIT files', ErrStatTmp, ErrMsgTmp ) CALL SetErrStat( ErrStatTmp, ErrMsgTmp, ErrStat, ErrMsg, RoutineName) IF ( ErrStat >= AbortErrLev ) THEN - CLOSE( UnitDataFile ) - IF (ALLOCATED(TmpRealArr)) DEALLOCATE(TmpRealArr,STAT=ErrStatTmp) - IF (ALLOCATED(RawData3D)) DEALLOCATE(RawData3D,STAT=ErrStatTmp) - IF (ALLOCATED(RawData3DTmp)) DEALLOCATE(RawData3DTmp,STAT=ErrStatTmp) - IF (ALLOCATED(TmpDataRow)) DEALLOCATE(TmpDataRow,STAT=ErrStatTmp) - IF (ALLOCATED(TmpWvFreq1)) DEALLOCATE(TmpWvFreq1,STAT=ErrStatTmp) - CALL CleanUp + CALL CleanUp() RETURN ENDIF @@ -3881,12 +3302,7 @@ SUBROUTINE Read_DataFile3D( InitInp, Filename3D, Data3D, ErrStat, Errmsg ) CALL UniqueRealValues( RawData3D(:,1), TmpWvFreq1, Data3D%NumWvFreq1, ErrStatTmp, ErrMsgTmp ) CALL SetErrStat( ErrStatTmp, ErrMsgTmp, ErrStat, ErrMsg, RoutineName ) IF ( ErrStat >= AbortErrLev ) THEN - IF (ALLOCATED(TmpRealArr)) DEALLOCATE(TmpRealArr,STAT=ErrStatTmp) - IF (ALLOCATED(RawData3D)) DEALLOCATE(RawData3D,STAT=ErrStatTmp) - IF (ALLOCATED(RawData3DTmp)) DEALLOCATE(RawData3DTmp,STAT=ErrStatTmp) - IF (ALLOCATED(TmpDataRow)) DEALLOCATE(TmpDataRow,STAT=ErrStatTmp) - IF (ALLOCATED(TmpWvFreq1)) DEALLOCATE(TmpWvFreq1,STAT=ErrStatTmp) - CALL CleanUp + CALL CleanUp() RETURN ENDIF @@ -3894,12 +3310,7 @@ SUBROUTINE Read_DataFile3D( InitInp, Filename3D, Data3D, ErrStat, Errmsg ) CALL UniqueRealValues( RawData3D(:,2), Data3D%WvDir1, Data3D%NumWvDir1, ErrStatTmp, ErrMsgTmp ) CALL SetErrStat( ErrStatTmp, ErrMsgTmp, ErrStat, ErrMsg, RoutineName ) IF ( ErrStat >= AbortErrLev ) THEN - IF (ALLOCATED(TmpRealArr)) DEALLOCATE(TmpRealArr,STAT=ErrStatTmp) - IF (ALLOCATED(RawData3D)) DEALLOCATE(RawData3D,STAT=ErrStatTmp) - IF (ALLOCATED(RawData3DTmp)) DEALLOCATE(RawData3DTmp,STAT=ErrStatTmp) - IF (ALLOCATED(TmpDataRow)) DEALLOCATE(TmpDataRow,STAT=ErrStatTmp) - IF (ALLOCATED(TmpWvFreq1)) DEALLOCATE(TmpWvFreq1,STAT=ErrStatTmp) - CALL CleanUp + CALL CleanUp() RETURN ENDIF @@ -3907,12 +3318,7 @@ SUBROUTINE Read_DataFile3D( InitInp, Filename3D, Data3D, ErrStat, Errmsg ) CALL UniqueRealValues( RawData3D(:,3), Data3D%WvDir2, Data3D%NumWvDir2, ErrStatTmp, ErrMsgTmp ) CALL SetErrStat( ErrStatTmp, ErrMsgTmp, ErrStat, ErrMsg, RoutineName ) IF ( ErrStat >= AbortErrLev ) THEN - IF (ALLOCATED(TmpRealArr)) DEALLOCATE(TmpRealArr,STAT=ErrStatTmp) - IF (ALLOCATED(RawData3D)) DEALLOCATE(RawData3D,STAT=ErrStatTmp) - IF (ALLOCATED(RawData3DTmp)) DEALLOCATE(RawData3DTmp,STAT=ErrStatTmp) - IF (ALLOCATED(TmpDataRow)) DEALLOCATE(TmpDataRow,STAT=ErrStatTmp) - IF (ALLOCATED(TmpWvFreq1)) DEALLOCATE(TmpWvFreq1,STAT=ErrStatTmp) - CALL CleanUp + CALL CleanUp() RETURN ENDIF @@ -3930,12 +3336,7 @@ SUBROUTINE Read_DataFile3D( InitInp, Filename3D, Data3D, ErrStat, Errmsg ) IF ( Data3D%NumBodies > 1 ) CALL SetErrStat( ErrID_Info, ' Found data for '//TRIM(Num2LStr(Data3D%NumBodies))//' WAMIT bodies in '// & TRIM(Filename3D)//'.', ErrStat,ErrMsg,RoutineName ) IF ( ErrStat >= AbortErrLev ) THEN - IF (ALLOCATED(TmpRealArr)) DEALLOCATE(TmpRealArr,STAT=ErrStatTmp) - IF (ALLOCATED(RawData3D)) DEALLOCATE(RawData3D,STAT=ErrStatTmp) - IF (ALLOCATED(RawData3DTmp)) DEALLOCATE(RawData3DTmp,STAT=ErrStatTmp) - IF (ALLOCATED(TmpDataRow)) DEALLOCATE(TmpDataRow,STAT=ErrStatTmp) - IF (ALLOCATED(TmpWvFreq1)) DEALLOCATE(TmpWvFreq1,STAT=ErrStatTmp) - CALL CleanUp + CALL CleanUp() RETURN ENDIF @@ -3954,12 +3355,7 @@ SUBROUTINE Read_DataFile3D( InitInp, Filename3D, Data3D, ErrStat, Errmsg ) CALL SetErrStat( ErrID_Fatal, ' Load components listed in column 4 of '//TRIM(Filename3D)// & ' must be between 1 and '//TRIM(Num2LStr(6*Data3D%NumBodies))//' for '//TRIM(Num2LStr(Data3D%NumBodies))// & ' WAMIT bodies.', ErrStat,ErrMsg,RoutineName) - IF (ALLOCATED(TmpRealArr)) DEALLOCATE(TmpRealArr,STAT=ErrStatTmp) - IF (ALLOCATED(RawData3D)) DEALLOCATE(RawData3D,STAT=ErrStatTmp) - IF (ALLOCATED(RawData3DTmp)) DEALLOCATE(RawData3DTmp,STAT=ErrStatTmp) - IF (ALLOCATED(TmpDataRow)) DEALLOCATE(TmpDataRow,STAT=ErrStatTmp) - IF (ALLOCATED(TmpWvFreq1)) DEALLOCATE(TmpWvFreq1,STAT=ErrStatTmp) - CALL CleanUp + CALL CleanUp() RETURN ENDIF Data3D%LoadComponents(NINT(TmpRealArr(I))) = .TRUE. @@ -3993,12 +3389,7 @@ SUBROUTINE Read_DataFile3D( InitInp, Filename3D, Data3D, ErrStat, Errmsg ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array Data3D%WvFreq1 to store '// & 'the sorted 3D 2nd order WAMIT frequency data.', ErrStat,ErrMsg,RoutineName) IF ( ErrStat >= AbortErrLev ) THEN - IF (ALLOCATED(TmpRealArr)) DEALLOCATE(TmpRealArr,STAT=ErrStatTmp) - IF (ALLOCATED(RawData3D)) DEALLOCATE(RawData3D,STAT=ErrStatTmp) - IF (ALLOCATED(RawData3DTmp)) DEALLOCATE(RawData3DTmp,STAT=ErrStatTmp) - IF (ALLOCATED(TmpDataRow)) DEALLOCATE(TmpDataRow,STAT=ErrStatTmp) - IF (ALLOCATED(TmpWvFreq1)) DEALLOCATE(TmpWvFreq1,STAT=ErrStatTmp) - CALL CleanUp + CALL CleanUp() RETURN ENDIF @@ -4022,27 +3413,13 @@ SUBROUTINE Read_DataFile3D( InitInp, Filename3D, Data3D, ErrStat, Errmsg ) ALLOCATE( Data3D%DataSet( Data3D%NumWvFreq1, Data3D%NumWvDir1, Data3D%NumWvDir2, 6*Data3D%NumBodies ), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array Data3D%DataSet to store '// & 'the sorted 3D 2nd order WAMIT data.', ErrStat,ErrMsg,RoutineName) - IF ( ErrStat >= AbortErrLev ) THEN - IF (ALLOCATED(TmpRealArr)) DEALLOCATE(TmpRealArr,STAT=ErrStatTmp) - IF (ALLOCATED(RawData3D)) DEALLOCATE(RawData3D,STAT=ErrStatTmp) - IF (ALLOCATED(RawData3DTmp)) DEALLOCATE(RawData3DTmp,STAT=ErrStatTmp) - IF (ALLOCATED(TmpDataRow)) DEALLOCATE(TmpDataRow,STAT=ErrStatTmp) - IF (ALLOCATED(TmpWvFreq1)) DEALLOCATE(TmpWvFreq1,STAT=ErrStatTmp) - CALL CleanUp - RETURN - ENDIF ! Allocate the logical array for storing the mask for which points are valid. Set to .FALSE. ALLOCATE( Data3D%DataMask( Data3D%NumWvFreq1, Data3D%NumWvDir1, Data3D%NumWvDir2, 6*Data3D%NumBodies ), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array Data3D%DataMask to store '// & 'the sorted 3D 2nd order WAMIT data.', ErrStat,ErrMsg,RoutineName) IF ( ErrStat >= AbortErrLev ) THEN - IF (ALLOCATED(TmpRealArr)) DEALLOCATE(TmpRealArr,STAT=ErrStatTmp) - IF (ALLOCATED(RawData3D)) DEALLOCATE(RawData3D,STAT=ErrStatTmp) - IF (ALLOCATED(RawData3DTmp)) DEALLOCATE(RawData3DTmp,STAT=ErrStatTmp) - IF (ALLOCATED(TmpDataRow)) DEALLOCATE(TmpDataRow,STAT=ErrStatTmp) - IF (ALLOCATED(TmpWvFreq1)) DEALLOCATE(TmpWvFreq1,STAT=ErrStatTmp) - CALL CleanUp + CALL CleanUp() RETURN ENDIF @@ -4087,12 +3464,7 @@ SUBROUTINE Read_DataFile3D( InitInp, Filename3D, Data3D, ErrStat, Errmsg ) CALL LocateStp( RawData3D(I,1), TmpWvFreq1, TmpCoord(1), WvFreq1HiIdx - (WvFreq1LoIdx - 1) ) ! inclusive limits IF ( TmpCoord(1) == 0 .OR. ( RawData3D(I,1) > Data3D%WvFreq1(Data3D%NumWvFreq1)) ) THEN CALL SetErrStat( ErrID_Fatal, ' Programming error. Array data point not found in Data3D%WvFreq1 array.', ErrStat, ErrMsg, RoutineName) - IF (ALLOCATED(TmpRealArr)) DEALLOCATE(TmpRealArr,STAT=ErrStatTmp) - IF (ALLOCATED(RawData3D)) DEALLOCATE(RawData3D,STAT=ErrStatTmp) - IF (ALLOCATED(RawData3DTmp)) DEALLOCATE(RawData3DTmp,STAT=ErrStatTmp) - IF (ALLOCATED(TmpDataRow)) DEALLOCATE(TmpDataRow,STAT=ErrStatTmp) - IF (ALLOCATED(TmpWvFreq1)) DEALLOCATE(TmpWvFreq1,STAT=ErrStatTmp) - CALL CleanUp + CALL CleanUp() RETURN ENDIF TmpCoord(1) = TmpCoord(1) + ( WvFreq1LoIdx - 1 ) ! shift to the point in the Data3D%WvFreq1 array by adding the zero frequency step function @@ -4101,12 +3473,7 @@ SUBROUTINE Read_DataFile3D( InitInp, Filename3D, Data3D, ErrStat, Errmsg ) CALL LocateStp( RawData3D(I,2), Data3D%WvDir1, TmpCoord(2), Data3D%NumWvDir1 ) IF ( TmpCoord(2) == 0 .OR. ( RawData3D(I,2) > Data3D%WvDir1(Data3D%NumWvDir1)) ) THEN CALL SetErrStat( ErrID_Fatal, ' Programming error. Array data point not found in Data3D%WvDir1 array.', ErrStat, ErrMsg, RoutineName) - IF (ALLOCATED(TmpRealArr)) DEALLOCATE(TmpRealArr,STAT=ErrStatTmp) - IF (ALLOCATED(RawData3D)) DEALLOCATE(RawData3D,STAT=ErrStatTmp) - IF (ALLOCATED(RawData3DTmp)) DEALLOCATE(RawData3DTmp,STAT=ErrStatTmp) - IF (ALLOCATED(TmpDataRow)) DEALLOCATE(TmpDataRow,STAT=ErrStatTmp) - IF (ALLOCATED(TmpWvFreq1)) DEALLOCATE(TmpWvFreq1,STAT=ErrStatTmp) - CALL CleanUp + CALL CleanUp() RETURN ENDIF @@ -4114,12 +3481,7 @@ SUBROUTINE Read_DataFile3D( InitInp, Filename3D, Data3D, ErrStat, Errmsg ) CALL LocateStp( RawData3D(I,3), Data3D%WvDir2, TmpCoord(3), Data3D%NumWvDir2 ) IF ( TmpCoord(3) == 0 .OR. ( RawData3D(I,3) > Data3D%WvDir2(Data3D%NumWvDir2)) ) THEN CALL SetErrStat( ErrID_Fatal, ' Programming error. Array data point not found in Data3D%WvDir2 array.', ErrStat, ErrMsg, RoutineName) - IF (ALLOCATED(TmpRealArr)) DEALLOCATE(TmpRealArr,STAT=ErrStatTmp) - IF (ALLOCATED(RawData3D)) DEALLOCATE(RawData3D,STAT=ErrStatTmp) - IF (ALLOCATED(RawData3DTmp)) DEALLOCATE(RawData3DTmp,STAT=ErrStatTmp) - IF (ALLOCATED(TmpDataRow)) DEALLOCATE(TmpDataRow,STAT=ErrStatTmp) - IF (ALLOCATED(TmpWvFreq1)) DEALLOCATE(TmpWvFreq1,STAT=ErrStatTmp) - CALL CleanUp + CALL CleanUp() RETURN ENDIF @@ -4169,27 +3531,22 @@ SUBROUTINE Read_DataFile3D( InitInp, Filename3D, Data3D, ErrStat, Errmsg ) IF ( Data3D%DataMask( TmpCoord(1), TmpCoord(2), TmpCoord(3), TmpCoord(4) ) ) THEN IF ( .NOT. EqualRealNos(REAL(Data3D%DataSet( TmpCoord(1), TmpCoord(2), TmpCoord(3), TmpCoord(4) ),SiKi), & - REAL(InitInp%RhoXg * InitInp%WAMITULEN**K * RawData3D(I,7) ,SiKi)) .AND. & + REAL(InitInp%WaveField%RhoXg * InitInp%WAMITULEN**K * RawData3D(I,7) ,SiKi)) .AND. & .NOT. EqualRealNos( AIMAG(Data3D%DataSet( TmpCoord(1), TmpCoord(2), TmpCoord(3), TmpCoord(4) ) ), & - REAL(InitInp%RhoXg * InitInp%WAMITULEN**K * RawData3D(I,8) ,SiKi)) ) THEN + REAL(InitInp%WaveField%RhoXg * InitInp%WAMITULEN**K * RawData3D(I,8) ,SiKi)) ) THEN CALL SetErrStat( ErrID_Fatal, ' Line '//TRIM(Num2Lstr(NumHeaderLines+I))//' of '//TRIM(Filename3D)// & ' contains different values for the real and imaginary part (columns 7 and 8) than was '// & 'given earlier in the file for the same values of wave frequency and wave direction '// & '(force dimension = '//TRIM(Num2LStr(TmpCoord(4)))//').', & ErrStat, ErrMsg, RoutineName ) - IF (ALLOCATED(TmpRealArr)) DEALLOCATE(TmpRealArr,STAT=ErrStatTmp) - IF (ALLOCATED(RawData3D)) DEALLOCATE(RawData3D,STAT=ErrStatTmp) - IF (ALLOCATED(RawData3DTmp)) DEALLOCATE(RawData3DTmp,STAT=ErrStatTmp) - IF (ALLOCATED(TmpDataRow)) DEALLOCATE(TmpDataRow,STAT=ErrStatTmp) - IF (ALLOCATED(TmpWvFreq1)) DEALLOCATE(TmpWvFreq1,STAT=ErrStatTmp) - CALL CleanUp + CALL CleanUp() RETURN ENDIF ELSE ! Store the data after dimensionalizing Data3D%DataSet( TmpCoord(1), TmpCoord(2), TmpCoord(3), TmpCoord(4) ) = & - REAL(InitInp%RhoXg * InitInp%WAMITULEN**K,SiKi) * CMPLX(RawData3D(I,7),RawData3D(I,8),SiKi) + REAL(InitInp%WaveField%RhoXg * InitInp%WAMITULEN**K,SiKi) * CMPLX(RawData3D(I,7),RawData3D(I,8),SiKi) ! Set flag indicating that this value has been inserted. Data3D%DataMask( TmpCoord(1), TmpCoord(2), TmpCoord(3), TmpCoord(4) ) = .TRUE. @@ -4302,13 +3659,19 @@ SUBROUTINE Read_DataFile3D( InitInp, Filename3D, Data3D, ErrStat, Errmsg ) ! Clean up - IF (ALLOCATED(RawData3D)) DEALLOCATE(RawData3D,STAT=ErrStatTmp) - IF (ALLOCATED(RawData3DTmp)) DEALLOCATE(RawData3DTmp,STAT=ErrStatTmp) - IF (ALLOCATED(TmpRealArr)) DEALLOCATE(TmpRealArr,STAT=ErrStatTmp) - IF (ALLOCATED(TmpDataRow)) DEALLOCATE(TmpDataRow,STAT=ErrStatTmp) - IF (ALLOCATED(TmpWvFreq1)) DEALLOCATE(TmpWvFreq1,STAT=ErrStatTmp) - - + call cleanup() + + CONTAINS + subroutine cleanup() + + if (UnitDataFile > 0) CLOSE( UnitDataFile ) + + IF (ALLOCATED(RawData3D)) DEALLOCATE(RawData3D,STAT=ErrStatTmp) + IF (ALLOCATED(RawData3DTmp)) DEALLOCATE(RawData3DTmp,STAT=ErrStatTmp) + IF (ALLOCATED(TmpRealArr)) DEALLOCATE(TmpRealArr,STAT=ErrStatTmp) + IF (ALLOCATED(TmpDataRow)) DEALLOCATE(TmpDataRow,STAT=ErrStatTmp) + IF (ALLOCATED(TmpWvFreq1)) DEALLOCATE(TmpWvFreq1,STAT=ErrStatTmp) + end subroutine cleanup END SUBROUTINE Read_DataFile3D @@ -4363,7 +3726,7 @@ SUBROUTINE Read_DataFile4D( InitInp, Filename4D, Data4D, ErrStat, Errmsg ) ! File reading variables - CHARACTER(1024) :: TextLine !< One line of text read from the file + CHARACTER(MaxFileInfoLineLen) :: TextLine !< One line of text read from the file INTEGER(IntKi) :: LineLen !< The length of the line read in REAL(SiKi), ALLOCATABLE :: TmpRealArr(:) !< Temporary real array REAL(SiKi), ALLOCATABLE :: TmpDataRow(:) !< Single row of data @@ -4397,12 +3760,10 @@ SUBROUTINE Read_DataFile4D( InitInp, Filename4D, Data4D, ErrStat, Errmsg ) ! Initialize error variables ErrStat = ErrID_None - ErrStatTmp = ErrID_None ErrMsg = '' - ErrMsgTmp = '' HaveZeroFreq1 = .FALSE. ! If we find a zero frequency, we will set this to true HaveZeroFreq2 = .FALSE. ! If we find a zero frequency, we will set this to true - + UnitDataFile = -1 !-------------------------------------------------------------------------------- !> ### Check data file for consistency @@ -4420,34 +3781,22 @@ SUBROUTINE Read_DataFile4D( InitInp, Filename4D, Data4D, ErrStat, Errmsg ) CALL GetNewUnit(UnitDataFile,ErrStatTmp,ErrMsgTmp) if (ErrStatTmp < AbortErrLev) then ! Open the file - CALL OpenFInpFile( UnitDataFile, TRIM(Filename4D), ErrStat, ErrMsg ) ! Open file containing mean drift information + CALL OpenFInpFile( UnitDataFile, TRIM(Filename4D), ErrStatTmp, ErrMsgTmp ) ! Open file containing mean drift information endif !$OMP end critical(fileopen) CALL SetErrStat( ErrStatTmp, ErrMsgTmp, ErrStat, ErrMsg, RoutineName) IF ( ErrStat >= AbortErrLev ) THEN CLOSE( UnitDataFile ) - IF (ALLOCATED(RawData4D)) DEALLOCATE(RawData4D,STAT=ErrStatTmp) - IF (ALLOCATED(RawData4DTmp)) DEALLOCATE(RawData4DTmp,STAT=ErrStatTmp) - IF (ALLOCATED(TmpRealArr)) DEALLOCATE(TmpRealArr,STAT=ErrStatTmp) - IF (ALLOCATED(TmpDataRow)) DEALLOCATE(TmpDataRow,STAT=ErrStatTmp) - IF (ALLOCATED(TmpWvFreq1)) DEALLOCATE(TmpWvFreq1,STAT=ErrStatTmp) - IF (ALLOCATED(TmpWvFreq2)) DEALLOCATE(TmpWvFreq2,STAT=ErrStatTmp) - CALL CleanUp + CALL CleanUp() RETURN ENDIF ! Do an initial readthrough and find out the length of the file, if there is a header line, and the number of columns in the file. - CALL GetFileLength( UnitDataFile, TRIM(Filename4D), NumDataColumns, NumDataLines, NumHeaderLines, ErrStat, ErrMsg) + CALL GetFileLength( UnitDataFile, TRIM(Filename4D), NumDataColumns, NumDataLines, NumHeaderLines, ErrStatTmp, ErrMsgTmp) CALL SetErrStat( ErrStatTmp, ErrMsgTmp, ErrStat, ErrMsg, RoutineName) IF ( ErrStat >= AbortErrLev ) THEN CLOSE( UnitDataFile ) - IF (ALLOCATED(RawData4D)) DEALLOCATE(RawData4D,STAT=ErrStatTmp) - IF (ALLOCATED(RawData4DTmp)) DEALLOCATE(RawData4DTmp,STAT=ErrStatTmp) - IF (ALLOCATED(TmpRealArr)) DEALLOCATE(TmpRealArr,STAT=ErrStatTmp) - IF (ALLOCATED(TmpDataRow)) DEALLOCATE(TmpDataRow,STAT=ErrStatTmp) - IF (ALLOCATED(TmpWvFreq1)) DEALLOCATE(TmpWvFreq1,STAT=ErrStatTmp) - IF (ALLOCATED(TmpWvFreq2)) DEALLOCATE(TmpWvFreq2,STAT=ErrStatTmp) - CALL CleanUp + CALL CleanUp() RETURN ENDIF @@ -4460,13 +3809,7 @@ SUBROUTINE Read_DataFile4D( InitInp, Filename4D, Data4D, ErrStat, Errmsg ) CALL SetErrStat( ErrID_Fatal, ' The 2nd order WAMIT data file '//TRIM(Filename4D)//' has '//TRIM(Num2LStr(NumDataColumns))// & ' columns instead of the 9 columns expected.', ErrStat, ErrMsg, RoutineName) CLOSE( UnitDataFile ) - IF (ALLOCATED(RawData4D)) DEALLOCATE(RawData4D,STAT=ErrStatTmp) - IF (ALLOCATED(RawData4DTmp)) DEALLOCATE(RawData4DTmp,STAT=ErrStatTmp) - IF (ALLOCATED(TmpRealArr)) DEALLOCATE(TmpRealArr,STAT=ErrStatTmp) - IF (ALLOCATED(TmpDataRow)) DEALLOCATE(TmpDataRow,STAT=ErrStatTmp) - IF (ALLOCATED(TmpWvFreq1)) DEALLOCATE(TmpWvFreq1,STAT=ErrStatTmp) - IF (ALLOCATED(TmpWvFreq2)) DEALLOCATE(TmpWvFreq2,STAT=ErrStatTmp) - CALL CleanUp + CALL CleanUp() RETURN ENDIF @@ -4486,13 +3829,7 @@ SUBROUTINE Read_DataFile4D( InitInp, Filename4D, Data4D, ErrStat, Errmsg ) CALL SetErrStat( ErrStatTmp, ErrMsgTmp, ErrStat, ErrMsg, RoutineName) IF ( ErrStat >= AbortErrLev ) THEN CLOSE( UnitDataFile ) - IF (ALLOCATED(RawData4D)) DEALLOCATE(RawData4D,STAT=ErrStatTmp) - IF (ALLOCATED(RawData4DTmp)) DEALLOCATE(RawData4DTmp,STAT=ErrStatTmp) - IF (ALLOCATED(TmpRealArr)) DEALLOCATE(TmpRealArr,STAT=ErrStatTmp) - IF (ALLOCATED(TmpDataRow)) DEALLOCATE(TmpDataRow,STAT=ErrStatTmp) - IF (ALLOCATED(TmpWvFreq1)) DEALLOCATE(TmpWvFreq1,STAT=ErrStatTmp) - IF (ALLOCATED(TmpWvFreq2)) DEALLOCATE(TmpWvFreq2,STAT=ErrStatTmp) - CALL CleanUp + CALL CleanUp() RETURN ENDIF @@ -4509,13 +3846,7 @@ SUBROUTINE Read_DataFile4D( InitInp, Filename4D, Data4D, ErrStat, Errmsg ) CALL SetErrStat( ErrStatTmp, ErrMsgTmp, ErrStat, ErrMsg, RoutineName) IF ( ErrStat >= AbortErrLev ) THEN CLOSE( UnitDataFile ) - IF (ALLOCATED(RawData4D)) DEALLOCATE(RawData4D,STAT=ErrStatTmp) - IF (ALLOCATED(RawData4DTmp)) DEALLOCATE(RawData4DTmp,STAT=ErrStatTmp) - IF (ALLOCATED(TmpRealArr)) DEALLOCATE(TmpRealArr,STAT=ErrStatTmp) - IF (ALLOCATED(TmpDataRow)) DEALLOCATE(TmpDataRow,STAT=ErrStatTmp) - IF (ALLOCATED(TmpWvFreq1)) DEALLOCATE(TmpWvFreq1,STAT=ErrStatTmp) - IF (ALLOCATED(TmpWvFreq2)) DEALLOCATE(TmpWvFreq2,STAT=ErrStatTmp) - CALL CleanUp + CALL CleanUp() RETURN ENDIF RawData4DTmp(I,:) = TmpDataRow @@ -4545,12 +3876,7 @@ SUBROUTINE Read_DataFile4D( InitInp, Filename4D, Data4D, ErrStat, Errmsg ) CALL SetErrStat( ErrStatTmp, ErrMsgTmp, ErrStat, ErrMsg, RoutineName) IF ( ErrStat >= AbortErrLev ) THEN CLOSE( UnitDataFile ) - IF (ALLOCATED(TmpRealArr)) DEALLOCATE(TmpRealArr,STAT=ErrStatTmp) - IF (ALLOCATED(RawData4D)) DEALLOCATE(RawData4D,STAT=ErrStatTmp) - IF (ALLOCATED(RawData4DTmp)) DEALLOCATE(RawData4DTmp,STAT=ErrStatTmp) - IF (ALLOCATED(TmpDataRow)) DEALLOCATE(TmpDataRow,STAT=ErrStatTmp) - IF (ALLOCATED(TmpWvFreq1)) DEALLOCATE(TmpWvFreq1,STAT=ErrStatTmp) - CALL CleanUp + CALL CleanUp() RETURN ENDIF @@ -4663,13 +3989,7 @@ SUBROUTINE Read_DataFile4D( InitInp, Filename4D, Data4D, ErrStat, Errmsg ) CALL UniqueRealValues( RawData4D(:,1), TmpWvFreq1, Data4D%NumWvFreq1, ErrStatTmp, ErrMsgTmp ) CALL SetErrStat( ErrStatTmp, ErrMsgTmp, ErrStat, ErrMsg, RoutineName ) IF ( ErrStat >= AbortErrLev ) THEN - IF (ALLOCATED(RawData4D)) DEALLOCATE(RawData4D,STAT=ErrStatTmp) - IF (ALLOCATED(RawData4DTmp)) DEALLOCATE(RawData4DTmp,STAT=ErrStatTmp) - IF (ALLOCATED(TmpRealArr)) DEALLOCATE(TmpRealArr,STAT=ErrStatTmp) - IF (ALLOCATED(TmpDataRow)) DEALLOCATE(TmpDataRow,STAT=ErrStatTmp) - IF (ALLOCATED(TmpWvFreq1)) DEALLOCATE(TmpWvFreq1,STAT=ErrStatTmp) - IF (ALLOCATED(TmpWvFreq2)) DEALLOCATE(TmpWvFreq2,STAT=ErrStatTmp) - CALL CleanUp + CALL CleanUp() RETURN ENDIF @@ -4677,13 +3997,7 @@ SUBROUTINE Read_DataFile4D( InitInp, Filename4D, Data4D, ErrStat, Errmsg ) CALL UniqueRealValues( RawData4D(:,2), TmpWvFreq2, Data4D%NumWvFreq2, ErrStatTmp, ErrMsgTmp ) CALL SetErrStat( ErrStatTmp, ErrMsgTmp, ErrStat, ErrMsg, RoutineName ) IF ( ErrStat >= AbortErrLev ) THEN - IF (ALLOCATED(RawData4D)) DEALLOCATE(RawData4D,STAT=ErrStatTmp) - IF (ALLOCATED(RawData4DTmp)) DEALLOCATE(RawData4DTmp,STAT=ErrStatTmp) - IF (ALLOCATED(TmpRealArr)) DEALLOCATE(TmpRealArr,STAT=ErrStatTmp) - IF (ALLOCATED(TmpDataRow)) DEALLOCATE(TmpDataRow,STAT=ErrStatTmp) - IF (ALLOCATED(TmpWvFreq1)) DEALLOCATE(TmpWvFreq1,STAT=ErrStatTmp) - IF (ALLOCATED(TmpWvFreq2)) DEALLOCATE(TmpWvFreq2,STAT=ErrStatTmp) - CALL CleanUp + CALL CleanUp() RETURN ENDIF @@ -4691,13 +4005,7 @@ SUBROUTINE Read_DataFile4D( InitInp, Filename4D, Data4D, ErrStat, Errmsg ) CALL UniqueRealValues( RawData4D(:,3), Data4D%WvDir1, Data4D%NumWvDir1, ErrStatTmp, ErrMsgTmp ) CALL SetErrStat( ErrStatTmp, ErrMsgTmp, ErrStat, ErrMsg, RoutineName ) IF ( ErrStat >= AbortErrLev ) THEN - IF (ALLOCATED(RawData4D)) DEALLOCATE(RawData4D,STAT=ErrStatTmp) - IF (ALLOCATED(RawData4DTmp)) DEALLOCATE(RawData4DTmp,STAT=ErrStatTmp) - IF (ALLOCATED(TmpRealArr)) DEALLOCATE(TmpRealArr,STAT=ErrStatTmp) - IF (ALLOCATED(TmpDataRow)) DEALLOCATE(TmpDataRow,STAT=ErrStatTmp) - IF (ALLOCATED(TmpWvFreq1)) DEALLOCATE(TmpWvFreq1,STAT=ErrStatTmp) - IF (ALLOCATED(TmpWvFreq2)) DEALLOCATE(TmpWvFreq2,STAT=ErrStatTmp) - CALL CleanUp + CALL CleanUp() RETURN ENDIF @@ -4705,13 +4013,7 @@ SUBROUTINE Read_DataFile4D( InitInp, Filename4D, Data4D, ErrStat, Errmsg ) CALL UniqueRealValues( RawData4D(:,4), Data4D%WvDir2, Data4D%NumWvDir2, ErrStatTmp, ErrMsgTmp ) CALL SetErrStat( ErrStatTmp, ErrMsgTmp, ErrStat, ErrMsg, RoutineName ) IF ( ErrStat >= AbortErrLev ) THEN - IF (ALLOCATED(RawData4D)) DEALLOCATE(RawData4D,STAT=ErrStatTmp) - IF (ALLOCATED(RawData4DTmp)) DEALLOCATE(RawData4DTmp,STAT=ErrStatTmp) - IF (ALLOCATED(TmpRealArr)) DEALLOCATE(TmpRealArr,STAT=ErrStatTmp) - IF (ALLOCATED(TmpDataRow)) DEALLOCATE(TmpDataRow,STAT=ErrStatTmp) - IF (ALLOCATED(TmpWvFreq1)) DEALLOCATE(TmpWvFreq1,STAT=ErrStatTmp) - IF (ALLOCATED(TmpWvFreq2)) DEALLOCATE(TmpWvFreq2,STAT=ErrStatTmp) - CALL CleanUp + CALL CleanUp() RETURN ENDIF @@ -4728,12 +4030,7 @@ SUBROUTINE Read_DataFile4D( InitInp, Filename4D, Data4D, ErrStat, Errmsg ) IF ( Data4D%NumBodies > 1 ) CALL SetErrStat( ErrID_Info, ' Found data for '//TRIM(Num2LStr(Data4D%NumBodies))//' WAMIT bodies in '// & TRIM(Filename4D)//'.', ErrStat,ErrMsg,RoutineName ) IF ( ErrStat >= AbortErrLev ) THEN - IF (ALLOCATED(TmpRealArr)) DEALLOCATE(TmpRealArr,STAT=ErrStatTmp) - IF (ALLOCATED(RawData4D)) DEALLOCATE(RawData4D,STAT=ErrStatTmp) - IF (ALLOCATED(RawData4DTmp)) DEALLOCATE(RawData4DTmp,STAT=ErrStatTmp) - IF (ALLOCATED(TmpDataRow)) DEALLOCATE(TmpDataRow,STAT=ErrStatTmp) - IF (ALLOCATED(TmpWvFreq1)) DEALLOCATE(TmpWvFreq1,STAT=ErrStatTmp) - CALL CleanUp + CALL CleanUp() RETURN ENDIF @@ -4754,13 +4051,7 @@ SUBROUTINE Read_DataFile4D( InitInp, Filename4D, Data4D, ErrStat, Errmsg ) CALL SetErrStat( ErrID_Fatal, ' Load components listed in column 4 of '//TRIM(Filename4D)// & ' must be between 1 and '//TRIM(Num2LStr(6*Data4D%NumBodies))//' for '//TRIM(Num2LStr(Data4D%NumBodies))// & ' WAMIT bodies.', ErrStat,ErrMsg,RoutineName) - IF (ALLOCATED(RawData4D)) DEALLOCATE(RawData4D,STAT=ErrStatTmp) - IF (ALLOCATED(RawData4DTmp)) DEALLOCATE(RawData4DTmp,STAT=ErrStatTmp) - IF (ALLOCATED(TmpRealArr)) DEALLOCATE(TmpRealArr,STAT=ErrStatTmp) - IF (ALLOCATED(TmpDataRow)) DEALLOCATE(TmpDataRow,STAT=ErrStatTmp) - IF (ALLOCATED(TmpWvFreq1)) DEALLOCATE(TmpWvFreq1,STAT=ErrStatTmp) - IF (ALLOCATED(TmpWvFreq2)) DEALLOCATE(TmpWvFreq2,STAT=ErrStatTmp) - CALL CleanUp + CALL CleanUp() RETURN ENDIF Data4D%LoadComponents(NINT(TmpRealArr(I))) = .TRUE. @@ -4806,13 +4097,7 @@ SUBROUTINE Read_DataFile4D( InitInp, Filename4D, Data4D, ErrStat, Errmsg ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array Data4D%WvFreq1 to store '// & 'the sorted 4D 2nd order WAMIT frequency data.', ErrStat,ErrMsg,RoutineName) IF ( ErrStat >= AbortErrLev ) THEN - IF (ALLOCATED(TmpRealArr)) DEALLOCATE(TmpRealArr,STAT=ErrStatTmp) - IF (ALLOCATED(RawData4D)) DEALLOCATE(RawData4D,STAT=ErrStatTmp) - IF (ALLOCATED(RawData4DTmp)) DEALLOCATE(RawData4DTmp,STAT=ErrStatTmp) - IF (ALLOCATED(TmpDataRow)) DEALLOCATE(TmpDataRow,STAT=ErrStatTmp) - IF (ALLOCATED(TmpWvFreq1)) DEALLOCATE(TmpWvFreq1,STAT=ErrStatTmp) - IF (ALLOCATED(TmpWvFreq2)) DEALLOCATE(TmpWvFreq2,STAT=ErrStatTmp) - CALL CleanUp + CALL CleanUp() RETURN ENDIF @@ -4822,13 +4107,7 @@ SUBROUTINE Read_DataFile4D( InitInp, Filename4D, Data4D, ErrStat, Errmsg ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array Data4D%WvFreq2 to store '// & 'the sorted 4D 2nd order WAMIT frequency data.', ErrStat,ErrMsg,RoutineName) IF ( ErrStat >= AbortErrLev ) THEN - IF (ALLOCATED(TmpRealArr)) DEALLOCATE(TmpRealArr,STAT=ErrStatTmp) - IF (ALLOCATED(RawData4D)) DEALLOCATE(RawData4D,STAT=ErrStatTmp) - IF (ALLOCATED(RawData4DTmp)) DEALLOCATE(RawData4DTmp,STAT=ErrStatTmp) - IF (ALLOCATED(TmpDataRow)) DEALLOCATE(TmpDataRow,STAT=ErrStatTmp) - IF (ALLOCATED(TmpWvFreq1)) DEALLOCATE(TmpWvFreq1,STAT=ErrStatTmp) - IF (ALLOCATED(TmpWvFreq2)) DEALLOCATE(TmpWvFreq2,STAT=ErrStatTmp) - CALL CleanUp + CALL CleanUp() RETURN ENDIF @@ -4867,13 +4146,7 @@ SUBROUTINE Read_DataFile4D( InitInp, Filename4D, Data4D, ErrStat, Errmsg ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array Data4D%DataSet to store '// & 'the sorted 4D 2nd order WAMIT data.', ErrStat,ErrMsg,RoutineName) IF ( ErrStat >= AbortErrLev ) THEN - IF (ALLOCATED(RawData4D)) DEALLOCATE(RawData4D,STAT=ErrStatTmp) - IF (ALLOCATED(RawData4DTmp)) DEALLOCATE(RawData4DTmp,STAT=ErrStatTmp) - IF (ALLOCATED(TmpRealArr)) DEALLOCATE(TmpRealArr,STAT=ErrStatTmp) - IF (ALLOCATED(TmpDataRow)) DEALLOCATE(TmpDataRow,STAT=ErrStatTmp) - IF (ALLOCATED(TmpWvFreq1)) DEALLOCATE(TmpWvFreq1,STAT=ErrStatTmp) - IF (ALLOCATED(TmpWvFreq2)) DEALLOCATE(TmpWvFreq2,STAT=ErrStatTmp) - CALL CleanUp + CALL CleanUp() RETURN ENDIF @@ -4882,13 +4155,7 @@ SUBROUTINE Read_DataFile4D( InitInp, Filename4D, Data4D, ErrStat, Errmsg ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array Data4D%DataMask to store '// & 'the sorted 4D 2nd order WAMIT data.', ErrStat,ErrMsg,RoutineName) IF ( ErrStat >= AbortErrLev ) THEN - IF (ALLOCATED(RawData4D)) DEALLOCATE(RawData4D,STAT=ErrStatTmp) - IF (ALLOCATED(RawData4DTmp)) DEALLOCATE(RawData4DTmp,STAT=ErrStatTmp) - IF (ALLOCATED(TmpRealArr)) DEALLOCATE(TmpRealArr,STAT=ErrStatTmp) - IF (ALLOCATED(TmpDataRow)) DEALLOCATE(TmpDataRow,STAT=ErrStatTmp) - IF (ALLOCATED(TmpWvFreq1)) DEALLOCATE(TmpWvFreq1,STAT=ErrStatTmp) - IF (ALLOCATED(TmpWvFreq2)) DEALLOCATE(TmpWvFreq2,STAT=ErrStatTmp) - CALL CleanUp + CALL CleanUp() RETURN ENDIF @@ -4934,13 +4201,7 @@ SUBROUTINE Read_DataFile4D( InitInp, Filename4D, Data4D, ErrStat, Errmsg ) CALL LocateStp( RawData4D(I,1), TmpWvFreq1, TmpCoord(1), WvFreq1HiIdx - (WvFreq1LoIdx - 1) ) ! inclusive limits IF ( TmpCoord(1) == 0 .OR. ( RawData4D(I,1) > Data4D%WvFreq1(Data4D%NumWvFreq1)) ) THEN CALL SetErrStat( ErrID_Fatal, ' Programming error. Array data point not found in Data4D%WvFreq1 array.', ErrStat, ErrMsg, RoutineName) - IF (ALLOCATED(RawData4D)) DEALLOCATE(RawData4D,STAT=ErrStatTmp) - IF (ALLOCATED(RawData4DTmp)) DEALLOCATE(RawData4DTmp,STAT=ErrStatTmp) - IF (ALLOCATED(TmpRealArr)) DEALLOCATE(TmpRealArr,STAT=ErrStatTmp) - IF (ALLOCATED(TmpDataRow)) DEALLOCATE(TmpDataRow,STAT=ErrStatTmp) - IF (ALLOCATED(TmpWvFreq1)) DEALLOCATE(TmpWvFreq1,STAT=ErrStatTmp) - IF (ALLOCATED(TmpWvFreq2)) DEALLOCATE(TmpWvFreq2,STAT=ErrStatTmp) - CALL CleanUp + CALL CleanUp() RETURN ENDIF TmpCoord(1) = TmpCoord(1) + ( WvFreq1LoIdx - 1 ) ! shift to the point in the Data4D%WvFreq1 array by adding the zero frequency step function @@ -4950,13 +4211,7 @@ SUBROUTINE Read_DataFile4D( InitInp, Filename4D, Data4D, ErrStat, Errmsg ) CALL LocateStp( RawData4D(I,2), TmpWvFreq2, TmpCoord(2), WvFreq2HiIdx - (WvFreq2LoIdx - 1) ) ! inclusive limits IF ( TmpCoord(2) == 0 .OR. ( RawData4D(I,2) > Data4D%WvFreq2(Data4D%NumWvFreq2)) ) THEN CALL SetErrStat( ErrID_Fatal, ' Programming error. Array data point not found in Data4D%WvFreq2 array.', ErrStat, ErrMsg, RoutineName) - IF (ALLOCATED(RawData4D)) DEALLOCATE(RawData4D,STAT=ErrStatTmp) - IF (ALLOCATED(RawData4DTmp)) DEALLOCATE(RawData4DTmp,STAT=ErrStatTmp) - IF (ALLOCATED(TmpRealArr)) DEALLOCATE(TmpRealArr,STAT=ErrStatTmp) - IF (ALLOCATED(TmpDataRow)) DEALLOCATE(TmpDataRow,STAT=ErrStatTmp) - IF (ALLOCATED(TmpWvFreq1)) DEALLOCATE(TmpWvFreq1,STAT=ErrStatTmp) - IF (ALLOCATED(TmpWvFreq2)) DEALLOCATE(TmpWvFreq2,STAT=ErrStatTmp) - CALL CleanUp + CALL CleanUp() RETURN ENDIF TmpCoord(2) = TmpCoord(2) + ( WvFreq2LoIdx - 1 ) ! shift to the point in the Data4D%WvFreq2 array by adding the zero frequency step function @@ -4965,13 +4220,7 @@ SUBROUTINE Read_DataFile4D( InitInp, Filename4D, Data4D, ErrStat, Errmsg ) CALL LocateStp( RawData4D(I,3), Data4D%WvDir1, TmpCoord(3), Data4D%NumWvDir1 ) IF ( TmpCoord(3) == 0 .OR. ( RawData4D(I,3) > Data4D%WvDir1(Data4D%NumWvDir1)) ) THEN CALL SetErrStat( ErrID_Fatal, ' Programming error. Array data point not found in Data4D%WvDir1 array.', ErrStat, ErrMsg, RoutineName) - IF (ALLOCATED(RawData4D)) DEALLOCATE(RawData4D,STAT=ErrStatTmp) - IF (ALLOCATED(RawData4DTmp)) DEALLOCATE(RawData4DTmp,STAT=ErrStatTmp) - IF (ALLOCATED(TmpRealArr)) DEALLOCATE(TmpRealArr,STAT=ErrStatTmp) - IF (ALLOCATED(TmpDataRow)) DEALLOCATE(TmpDataRow,STAT=ErrStatTmp) - IF (ALLOCATED(TmpWvFreq1)) DEALLOCATE(TmpWvFreq1,STAT=ErrStatTmp) - IF (ALLOCATED(TmpWvFreq2)) DEALLOCATE(TmpWvFreq2,STAT=ErrStatTmp) - CALL CleanUp + CALL CleanUp() RETURN ENDIF @@ -4979,6 +4228,18 @@ SUBROUTINE Read_DataFile4D( InitInp, Filename4D, Data4D, ErrStat, Errmsg ) CALL LocateStp( RawData4D(I,4), Data4D%WvDir2, TmpCoord(4), Data4D%NumWvDir2 ) IF ( TmpCoord(4) == 0 .OR. ( RawData4D(I,4) > Data4D%WvDir2(Data4D%NumWvDir2)) ) THEN CALL SetErrStat( ErrID_Fatal, ' Programming error. Array data point not found in Data4D%WvDir2 array.', ErrStat, ErrMsg, RoutineName) + CALL CleanUp() + RETURN + ENDIF + + ! Find which force component this belongs to + TmpCoord(5) = NINT(RawData4D(I,5)) + ! Check that it is a valid force component + if (TmpCoord(5) < 1 .or. TmpCoord(5) > 6*Data4D%NumBodies) then + CALL SetErrStat( ErrID_Fatal, ' Line '//TRIM(Num2Lstr(NumHeaderLines+I))//' of '//TRIM(Filename4D)// & + ' contains force component '//TRIM(Num2LStr(TmpCoord(5)))//' which is outside the expected force '// & + ' range of 1 to '//TRIM(Num2Lstr(6*Data4D%NumBodies))//' for a '//TRIM(Num2LStr(Data4D%NumBodies))// & + ' body system.', ErrStat, ErrMsg, RoutineName) IF (ALLOCATED(RawData4D)) DEALLOCATE(RawData4D,STAT=ErrStatTmp) IF (ALLOCATED(RawData4DTmp)) DEALLOCATE(RawData4DTmp,STAT=ErrStatTmp) IF (ALLOCATED(TmpRealArr)) DEALLOCATE(TmpRealArr,STAT=ErrStatTmp) @@ -4987,10 +4248,8 @@ SUBROUTINE Read_DataFile4D( InitInp, Filename4D, Data4D, ErrStat, Errmsg ) IF (ALLOCATED(TmpWvFreq2)) DEALLOCATE(TmpWvFreq2,STAT=ErrStatTmp) CALL CleanUp RETURN - ENDIF + endif - ! Find which force component this belongs to - TmpCoord(5) = NINT(RawData4D(I,5)) ! Check that it is a valid force component if (TmpCoord(5) < 1 .or. TmpCoord(5) > 6*Data4D%NumBodies) then CALL SetErrStat( ErrID_Fatal, ' Line '//TRIM(Num2Lstr(NumHeaderLines+I))//' of '//TRIM(Filename4D)// & @@ -5007,7 +4266,6 @@ SUBROUTINE Read_DataFile4D( InitInp, Filename4D, Data4D, ErrStat, Errmsg ) RETURN endif - !> The data from the WAMIT file is non-dimensional, so we need to dimensionalize it here. This !! is a partial dimensionalization since the wave amplitudes are not included (this is done later !! in each of the calculation methods). To dimensionalize the data, the equation is for the @@ -5035,28 +4293,22 @@ SUBROUTINE Read_DataFile4D( InitInp, Filename4D, Data4D, ErrStat, Errmsg ) IF ( Data4D%DataMask( TmpCoord(1), TmpCoord(2), TmpCoord(3), TmpCoord(4), TmpCoord(5) ) ) THEN IF ( .NOT. EqualRealNos( REAL(Data4D%DataSet( TmpCoord(1), TmpCoord(2), TmpCoord(3), TmpCoord(4), TmpCoord(5) ),SiKi), & - REAL(InitInp%RhoXg * InitInp%WAMITULEN**K * RawData4D(I,8) ,SiKi)) .AND. & + REAL(InitInp%WaveField%RhoXg * InitInp%WAMITULEN**K * RawData4D(I,8) ,SiKi)) .AND. & .NOT. EqualRealNos(AIMAG(Data4D%DataSet( TmpCoord(1), TmpCoord(2), TmpCoord(3), TmpCoord(4), TmpCoord(5) )), & - REAL(InitInp%RhoXg * InitInp%WAMITULEN**K * RawData4D(I,9) ,SiKi))) THEN + REAL(InitInp%WaveField%RhoXg * InitInp%WAMITULEN**K * RawData4D(I,9) ,SiKi))) THEN CALL SetErrStat( ErrID_Fatal, ' Line '//TRIM(Num2Lstr(NumHeaderLines+I))//' of '//TRIM(Filename4D)// & ' contains different values for the real and imaginary part (columns 8 and 9) than was '// & 'given earlier in the file for the same values of wave frequency and wave direction '// & '(force dimension = '//TRIM(Num2LStr(TmpCoord(5)))//').', & ErrStat, ErrMsg, RoutineName ) - IF (ALLOCATED(RawData4D)) DEALLOCATE(RawData4D,STAT=ErrStatTmp) - IF (ALLOCATED(RawData4DTmp)) DEALLOCATE(RawData4DTmp,STAT=ErrStatTmp) - IF (ALLOCATED(TmpRealArr)) DEALLOCATE(TmpRealArr,STAT=ErrStatTmp) - IF (ALLOCATED(TmpDataRow)) DEALLOCATE(TmpDataRow,STAT=ErrStatTmp) - IF (ALLOCATED(TmpWvFreq1)) DEALLOCATE(TmpWvFreq1,STAT=ErrStatTmp) - IF (ALLOCATED(TmpWvFreq2)) DEALLOCATE(TmpWvFreq2,STAT=ErrStatTmp) - CALL CleanUp + CALL CleanUp() RETURN ENDIF ELSE ! Store the data after dimensionalizing Data4D%DataSet( TmpCoord(1), TmpCoord(2), TmpCoord(3), TmpCoord(4), TmpCoord(5) ) = & - REAL(InitInp%RhoXg * InitInp%WAMITULEN**K,SiKi) * CMPLX(RawData4D(I,8),RawData4D(I,9),SiKi) + REAL(InitInp%WaveField%RhoXg * InitInp%WAMITULEN**K,SiKi) * CMPLX(RawData4D(I,8),RawData4D(I,9),SiKi) ! Set flag indicating that this value has been inserted. Data4D%DataMask( TmpCoord(1), TmpCoord(2), TmpCoord(3), TmpCoord(4), TmpCoord(5) ) = .TRUE. @@ -5131,7 +4383,7 @@ SUBROUTINE Read_DataFile4D( InitInp, Filename4D, Data4D, ErrStat, Errmsg ) ! See if the diagonal mirror one (WvDir2,WvDir1) value is not filled, set it and its flag IF ( .NOT. Data4D%DataMask(TmpCoord(1), TmpCoord(2), TmpCoord(4), TmpCoord(3), TmpCoord(5)) ) THEN Data4D%DataSet(TmpCoord(1), TmpCoord(2), TmpCoord(4), TmpCoord(3), TmpCoord(5) ) = & - Data4D%DataSet(TmpCoord(1), TmpCoord(2), TmpCoord(3), TmpCoord(3), TmpCoord(5) ) + Data4D%DataSet(TmpCoord(1), TmpCoord(2), TmpCoord(3), TmpCoord(4), TmpCoord(5) ) Data4D%DataMask(TmpCoord(1), TmpCoord(2), TmpCoord(4), TmpCoord(3), TmpCoord(5) ) = .TRUE. ENDIF @@ -5256,16 +4508,21 @@ SUBROUTINE Read_DataFile4D( InitInp, Filename4D, Data4D, ErrStat, Errmsg ) Data4D%WvFreqDiagComplete = TmpDiagComplete + call cleanup() + + contains + subroutine cleanup() - - ! Clean up - IF (ALLOCATED(RawData4D)) DEALLOCATE(RawData4D,STAT=ErrStatTmp) - IF (ALLOCATED(RawData4DTmp)) DEALLOCATE(RawData4DTmp,STAT=ErrStatTmp) - IF (ALLOCATED(TmpRealArr)) DEALLOCATE(TmpRealArr,STAT=ErrStatTmp) - IF (ALLOCATED(TmpDataRow)) DEALLOCATE(TmpDataRow,STAT=ErrStatTmp) - IF (ALLOCATED(TmpWvFreq1)) DEALLOCATE(TmpWvFreq1,STAT=ErrStatTmp) - IF (ALLOCATED(TmpWvFreq2)) DEALLOCATE(TmpWvFreq2,STAT=ErrStatTmp) - + ! Clean up + IF (ALLOCATED(RawData4D)) DEALLOCATE(RawData4D,STAT=ErrStatTmp) + IF (ALLOCATED(RawData4DTmp)) DEALLOCATE(RawData4DTmp,STAT=ErrStatTmp) + IF (ALLOCATED(TmpRealArr)) DEALLOCATE(TmpRealArr,STAT=ErrStatTmp) + IF (ALLOCATED(TmpDataRow)) DEALLOCATE(TmpDataRow,STAT=ErrStatTmp) + IF (ALLOCATED(TmpWvFreq1)) DEALLOCATE(TmpWvFreq1,STAT=ErrStatTmp) + IF (ALLOCATED(TmpWvFreq2)) DEALLOCATE(TmpWvFreq2,STAT=ErrStatTmp) + + end subroutine cleanup + END SUBROUTINE Read_DataFile4D @@ -5300,16 +4557,14 @@ SUBROUTINE UniqueRealValues( DataArrayIn, DataArrayOut, NumUnique, ErrStat, ErrM ! Initialize things ErrStat = ErrID_None - ErrStatTmp = ErrID_None - ErrMsg = '' - ErrMsgTmp = '' + ErrMsg = "" ! Allocate the temporary array CALL AllocAry( TmpRealArray, SIZE(DataArrayIn,1), 'Temporary array for data sorting', ErrStatTmp, ErrMsgTmp ) CALL SetErrStat( ErrStatTmp, ErrMsgTmp, ErrStat, ErrMsg, RoutineName ) IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp + CALL CleanUp() RETURN ENDIF @@ -5369,14 +4624,20 @@ SUBROUTINE UniqueRealValues( DataArrayIn, DataArrayOut, NumUnique, ErrStat, ErrM CALL AllocAry( DataArrayOut, NumUnique, 'Return array with sorted values', ErrStatTmp, ErrMsgTmp ) CALL SetErrStat( ErrStatTmp, ErrMsgTmp, ErrStat, ErrMsg, RoutineName ) IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp + CALL CleanUp() RETURN ENDIF ! Copy the values over DataArrayOut = TmpRealArray(1:NumUnique) - + call cleanup() + + contains + subroutine cleanup() + if (allocated(TmpRealArray)) deallocate(TmpRealArray) + end subroutine cleanup + END SUBROUTINE UniqueRealValues @@ -5420,13 +4681,13 @@ SUBROUTINE GetFileLength(UnitDataFile, Filename, NumDataColumns, NumDataLines, N 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 + CHARACTER(MaxFileInfoLineLen) :: 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(SiKi) :: 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(1024) :: VarName !< Name of the variable we are trying to read from the file CHARACTER(NWTC_SizeOfNumWord) :: 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) :: 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. @@ -5502,10 +4763,7 @@ SUBROUTINE GetFileLength(UnitDataFile, Filename, NumDataColumns, NumDataLines, N CALL SetErrStat( ErrID_Fatal, ' Found text on line '//TRIM(Num2LStr(LineNumber))//' of '//TRIM(FileName)// & ' when real numbers were expected. There may be a problem with the 2nd order WAMIT file: '// & TRIM(Filename)//'.', ErrStat, ErrMsg, RoutineName) - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp - RETURN - ENDIF + RETURN ELSE NumHeaderLines = NumHeaderLines + 1 ENDIF @@ -5525,10 +4783,7 @@ SUBROUTINE GetFileLength(UnitDataFile, Filename, NumDataColumns, NumDataLines, N '('//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 - CALL CleanUp - RETURN - ENDIF + RETURN ENDIF ENDIF ENDIF @@ -5538,10 +4793,7 @@ SUBROUTINE GetFileLength(UnitDataFile, Filename, NumDataColumns, NumDataLines, N IF ( NumDataLines < 2 ) THEN CALL SetErrStat( ErrID_Fatal, ' 2nd order WAMIT file '//TRIM(Filename)//' contains only '//TRIM(Num2LStr(NumDataLines))// & ' lines of data. This does not appear to be a valid WAMIT file.', ErrStat, ErrMsg, RoutineName) - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp - RETURN - ENDIF + RETURN ENDIF REWIND( UnitDataFile ) @@ -5675,124 +4927,16 @@ END SUBROUTINE ReadRealNumber -END SUBROUTINE WAMIT2_Init - - - - - -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine is called at the end of the simulation. The purpose of this routine is to destroy any data that is leftover. If -!! we don't do this, we may leave memory tied up after the simulation ends. -!! To destroy the data, we call several routines that are generated by the FAST registry, so any issues with the destroy routines -!! should be addressed by the registry.exe which generates the WAMIT2_Types.f90 file. -!! -SUBROUTINE WAMIT2_End( u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) -!.................................................................................................................................. - - TYPE(WAMIT2_InputType), INTENT(INOUT) :: u !< System inputs - TYPE(WAMIT2_ParameterType), INTENT(INOUT) :: p !< Parameters - TYPE(WAMIT2_ContinuousStateType), INTENT(INOUT) :: x !< Continuous states - TYPE(WAMIT2_DiscreteStateType), INTENT(INOUT) :: xd !< Discrete states - TYPE(WAMIT2_ConstraintStateType), INTENT(INOUT) :: z !< Constraint states - TYPE(WAMIT2_OtherStateType), INTENT(INOUT) :: OtherState !< Other states - TYPE(WAMIT2_OutputType), INTENT(INOUT) :: y !< System outputs - TYPE(WAMIT2_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. For WAMIT2, most calculations are performed - !! during the initialization, so there are no final calculations that need to be performed. - - - !> Close files here. The only files that are opened for WAMIT2 take place during the initialization routine. They should - !! have been closed then. - !! @todo Check to make sure nothing is left open by this module. - - - !> Destroy the input data: - - CALL WAMIT2_DestroyInput( u, ErrStat, ErrMsg ) - - - !> Destroy the parameter data: - - CALL WAMIT2_DestroyParam( p, ErrStat, ErrMsg ) - - - !> Destroy the state data: - - CALL WAMIT2_DestroyContState( x, ErrStat, ErrMsg ) - CALL WAMIT2_DestroyDiscState( xd, ErrStat, ErrMsg ) - CALL WAMIT2_DestroyConstrState( z, ErrStat, ErrMsg ) - CALL WAMIT2_DestroyOtherState( OtherState, ErrStat, ErrMsg ) - - - !> Destroy the output data: - - CALL WAMIT2_DestroyOutput( y, ErrStat, ErrMsg ) - - -END SUBROUTINE WAMIT2_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 WAMIT2_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(WAMIT2_InputType), INTENT(IN ) :: Inputs(:) !< Inputs at InputTimes - REAL(DbKi), INTENT(IN ) :: InputTimes(:) !< Times in seconds associated with Inputs - TYPE(WAMIT2_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(WAMIT2_ContinuousStateType), INTENT(INOUT) :: x !< Input: Continuous states at t; - !!Output: Continuous states at t + Interval - TYPE(WAMIT2_DiscreteStateType), INTENT(INOUT) :: xd !< Input: Discrete states at t; - !!Output: Discrete states at t + Interval - TYPE(WAMIT2_ConstraintStateType), INTENT(INOUT) :: z !< Input: Constraint states at t; - !!Output: Constraint states at t + Interval - TYPE(WAMIT2_OtherStateType), INTENT(INOUT) :: OtherState !< Input: Other states at t; - !! Output: Other states at t + Interval - TYPE(WAMIT2_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 = "" - - -END SUBROUTINE WAMIT2_UpdateStates - - - !---------------------------------------------------------------------------------------------------------------------------------- !> Routine for computing outputs, used in both loose and tight coupling. -SUBROUTINE WAMIT2_CalcOutput( Time, WaveTime, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) +SUBROUTINE WAMIT2_CalcOutput( Time, PtfmRefY, WaveField, p, y, m, ErrStat, ErrMsg ) !.................................................................................................................................. REAL(DbKi), INTENT(IN ) :: Time !< Current simulation time in seconds - real(SiKi), intent(in ) :: WaveTime(:) !< Array of wave kinematic time samples, (sec) - TYPE(WAMIT2_InputType), INTENT(IN ) :: u !< Inputs at Time + REAL(ReKi), INTENT(IN ) :: PtfmRefY !< Platform reference yaw offset at Time + TYPE(SeaSt_WaveFieldType), INTENT(IN ) :: WaveField !< Wave data TYPE(WAMIT2_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(WAMIT2_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at Time - TYPE(WAMIT2_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at Time - TYPE(WAMIT2_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at Time - TYPE(WAMIT2_OtherStateType), INTENT(IN ) :: OtherState !< Other states TYPE(WAMIT2_OutputType), INTENT(INOUT) :: y !< Outputs computed at Time (Input only so that mesh !! connectivity information does not have to be recalculated) TYPE(WAMIT2_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables @@ -5803,8 +4947,13 @@ SUBROUTINE WAMIT2_CalcOutput( Time, WaveTime, u, p, x, xd, z, OtherState, y, m, ! Local Variables: INTEGER(IntKi) :: I ! Generic index - INTEGER(IntKi) :: IBody ! Index to body number - INTEGER(IntKi) :: indxStart ! Starting index + INTEGER(IntKi) :: iBody ! Index to body number + INTEGER(IntKi) :: iStart ! Starting index + REAL(ReKi) :: bodyPosition(3) + + INTEGER(IntKi) :: ErrStatTmp !< Temporary variable for the local error status + CHARACTER(ErrMsgLen) :: ErrMsgTmp !< Temporary error message variable + CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT2_CalcOutput' ! Initialize ErrStat @@ -5813,34 +4962,24 @@ SUBROUTINE WAMIT2_CalcOutput( Time, WaveTime, u, p, x, xd, z, OtherState, y, m, ErrMsg = "" - - - ! Abort if the wave excitation loads have not been computed yet: - - IF ( .NOT. ALLOCATED ( p%WaveExctn2 ) ) THEN - CALL SetErrStat(ErrID_Fatal,' Routine WAMIT2_Init() must be called before routine WAMIT2_CalcOutput().',ErrStat,ErrMsg,'WAMIT2_CalcOutput') - RETURN - END IF - - ! Compute the 2nd order load contribution from incident waves: do iBody = 1, p%NBody - indxStart = (iBody-1)*6 - - DO I = 1,6 ! Loop through all wave excitation forces and moments - m%F_Waves2(indxStart+I) = InterpWrappedStpReal ( REAL(Time, SiKi), WaveTime(:), p%WaveExctn2(:,indxStart+I), & - m%LastIndWave(IBody), p%NStepWave + 1 ) - END DO ! I - All wave excitation forces and moments - - + bodyPosition(1) = 0.0 + bodyPosition(2) = 0.0 + bodyPosition(3) = WrapToPi(PtfmRefY) + iStart = (iBody-1)*6+1 + ! WaveExctn2Grid dimensions are: 1st: wavetime, 2nd: X, 3rd: Y, 4th: PRP yaw offset, 5th: Force component for each WAMIT Body + m%F_Waves2(iStart:iStart+5) = WAMIT_ForceWaves_Interp( Time, bodyPosition, p%WaveExctn2Grid(:,:,:,:,iStart:iStart+5), p%Exctn2GridParams, m%WaveField_m, ErrStatTmp, ErrMsgTmp ) + call SetErrStat( ErrStatTmp, ErrMsgTmp, ErrStat, ErrMsg, RoutineName ) ! Copy results to the output point mesh + iStart = iStart - 1 DO I=1,3 - y%Mesh%Force(I,IBody) = m%F_Waves2(indxStart+I) + y%Mesh%Force(I,iBody) = m%F_Waves2(iStart+I) END DO DO I=1,3 - y%Mesh%Moment(I,IBody) = m%F_Waves2(indxStart+I+3) + y%Mesh%Moment(I,iBody) = m%F_Waves2(iStart+I+3) END DO enddo @@ -5851,118 +4990,6 @@ END SUBROUTINE WAMIT2_CalcOutput -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine is required for the FAST framework, but is not actually needed for this module. -!! In the framework, this routine calculates the derivative of the continuous states. -!! As this routine is not necessary in the WAMIT2 module, it simply issues a warning and returns. -!! @note A few values will be set so that compilers are happy, but nothing of value is done. -SUBROUTINE WAMIT2_CalcContStateDeriv( Time, u, p, x, xd, z, OtherState, m, dxdt, ErrStat, ErrMsg ) -!.................................................................................................................................. - - REAL(DbKi), INTENT(IN ) :: Time !< Current simulation time in seconds - TYPE(WAMIT2_InputType), INTENT(IN ) :: u !< Inputs at Time - TYPE(WAMIT2_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(WAMIT2_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at Time - TYPE(WAMIT2_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at Time - TYPE(WAMIT2_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at Time - TYPE(WAMIT2_OtherStateType), INTENT(IN ) :: OtherState !< Other states at Time - TYPE(WAMIT2_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables - TYPE(WAMIT2_ContinuousStateType), INTENT( OUT) :: dxdt !< Continuous state derivatives at Time - 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 = "Warning: No States to take derivative of in WAMIT2 module. *WAMIT2::CalcContStateDeriv was called. It "// & - "is not necessary in the WAMIT2 module, so it does nothing.*" - - - ! Compute the first time derivatives of the continuous states here: None to calculate, so no code here. - - ! Dummy output value for dxdt -- this is only here to prevent the compiler from complaining. - dxdt%DummyContState = 0.0_SiKi - - -END SUBROUTINE WAMIT2_CalcContStateDeriv - - - - -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine is required for the FAST framework, but is not actually needed for this module. -!! In the framework, this routine is used to update discrete states, by -!! So, this routine will simply issue a warning and return. -SUBROUTINE WAMIT2_UpdateDiscState( Time, n, u, p, x, xd, z, OtherState, m, ErrStat, ErrMsg ) -!.................................................................................................................................. - - REAL(DbKi), INTENT(IN ) :: Time !< Current simulation time in seconds - INTEGER(IntKi), INTENT(IN ) :: n !< Current step of the simulation: t = n*Interval - TYPE(WAMIT2_InputType), INTENT(IN ) :: u !< Inputs at Time - TYPE(WAMIT2_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(WAMIT2_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at Time - TYPE(WAMIT2_DiscreteStateType), INTENT(INOUT) :: xd !< Input: Discrete states at Time; - !! Output: Discrete states at Time + Interval - TYPE(WAMIT2_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at Time - TYPE(WAMIT2_OtherStateType), INTENT(IN ) :: OtherState !< Other states at Time - TYPE(WAMIT2_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 = "Warning: No Discrete States to update in WAMIT2 module. *WAMIT2::UpdateDiscState was called. It is not "// & - "necessary in the WAMIT2 module, so it does nothing.*" - - ! Code to update the discrete states would live here, but there are no discrete states to update, hence no code. - - -END SUBROUTINE WAMIT2_UpdateDiscState - - - - -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine is required for the FAST framework, but is not actually needed for this module. -!! In the framework, this is a tight coupling routine for solving for the residual of the constraint state equations -!! So, this routine will simply issue a warning and return. -!! @note A few values will be set so that compilers are happy, but nothing of value is done. -SUBROUTINE WAMIT2_CalcConstrStateResidual( Time, u, p, x, xd, z, OtherState, m, z_residual, ErrStat, ErrMsg ) -!.................................................................................................................................. - - REAL(DbKi), INTENT(IN ) :: Time !< Current simulation time in seconds - TYPE(WAMIT2_InputType), INTENT(IN ) :: u !< Inputs at Time - TYPE(WAMIT2_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(WAMIT2_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at Time - TYPE(WAMIT2_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at Time - TYPE(WAMIT2_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at Time (possibly a guess) - TYPE(WAMIT2_OtherStateType), INTENT(IN ) :: OtherState !< Other states at Time - TYPE(WAMIT2_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables - TYPE(WAMIT2_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 - - - ! Initialize ErrStat - - ErrStat = ErrID_None - ErrMsg = "Warning: No States in WAMIT2 module. *WAMIT2::CalcConstrStateResidual was called. It is not needed in "//& - "the WAMIT2 module, so it does nothing useful." - - - - ! Solve for the constraint states here: Since there are no constraint states to solve for in WAMIT2, there is no code here. - - z_residual%DummyConstrState = 0.0_SiKi ! This exists just so that we can make the compiler happy. - -END SUBROUTINE WAMIT2_CalcConstrStateResidual - - - !------------------------------------------------------------------------------- !> This subroutine copies data stored from a W2_InitData4D_Type to a W2_InitData3D_Type SUBROUTINE Copy_InitData4Dto3D( Data4D, Data3D, ErrStat, ErrMsg ) @@ -6112,6 +5139,10 @@ SUBROUTINE Destroy_InitData3D(Data3D) IMPLICIT NONE TYPE(W2_InitData3D_Type), INTENT(INOUT) :: Data3D INTEGER(IntKi) :: ErrStatTmp + + IF (ALLOCATED(Data3D%DataIsSparse)) DEALLOCATE(Data3D%DataIsSparse,STAT=ErrStatTmp) + IF (ALLOCATED(Data3D%LoadComponents)) DEALLOCATE(Data3D%LoadComponents,STAT=ErrStatTmp) + IF (ALLOCATED(Data3D%DataSet)) DEALLOCATE(Data3D%DataSet,STAT=ErrStatTmp) IF (ALLOCATED(Data3D%DataMask)) DEALLOCATE(Data3D%DataMask,STAT=ErrStatTmp) IF (ALLOCATED(Data3D%WvFreq1)) DEALLOCATE(Data3D%WvFreq1,STAT=ErrStatTmp) @@ -6125,15 +5156,345 @@ SUBROUTINE Destroy_InitData4D(Data4D) IMPLICIT NONE TYPE(W2_InitData4D_Type), INTENT(INOUT) :: Data4D INTEGER(IntKi) :: ErrStatTmp - IF (ALLOCATED(Data4D%DataSet)) DEALLOCATE(Data4D%DataSet,STAT=ErrStatTmp) - IF (ALLOCATED(Data4D%DataMask)) DEALLOCATE(Data4D%DataMask,STAT=ErrStatTmp) - IF (ALLOCATED(Data4D%WvFreq1)) DEALLOCATE(Data4D%WvFreq1,STAT=ErrStatTmp) - IF (ALLOCATED(Data4D%WvFreq2)) DEALLOCATE(Data4D%WvFreq2,STAT=ErrStatTmp) - IF (ALLOCATED(Data4D%WvDir1)) DEALLOCATE(Data4D%WvDir1,STAT=ErrStatTmp) - IF (ALLOCATED(Data4D%WvDir2)) DEALLOCATE(Data4D%WvDir2,STAT=ErrStatTmp) + + IF (ALLOCATED(Data4D%DataIsSparse)) DEALLOCATE(Data4D%DataIsSparse,STAT=ErrStatTmp) + IF (ALLOCATED(Data4D%LoadComponents)) DEALLOCATE(Data4D%LoadComponents,STAT=ErrStatTmp) + + IF (ALLOCATED(Data4D%DataSet)) DEALLOCATE(Data4D%DataSet,STAT=ErrStatTmp) + IF (ALLOCATED(Data4D%DataMask)) DEALLOCATE(Data4D%DataMask,STAT=ErrStatTmp) + IF (ALLOCATED(Data4D%WvFreq1)) DEALLOCATE(Data4D%WvFreq1,STAT=ErrStatTmp) + IF (ALLOCATED(Data4D%WvFreq2)) DEALLOCATE(Data4D%WvFreq2,STAT=ErrStatTmp) + IF (ALLOCATED(Data4D%WvDir1)) DEALLOCATE(Data4D%WvDir1,STAT=ErrStatTmp) + IF (ALLOCATED(Data4D%WvDir2)) DEALLOCATE(Data4D%WvDir2,STAT=ErrStatTmp) END SUBROUTINE Destroy_InitData4D +SUBROUTINE GetWAMIT2WvHdgRangeDiffData(W2Data,W2WvDir1Range,W2WvDir2Range,ErrStat,ErrMsg) + TYPE(W2_DiffData_Type), INTENT(IN ) :: W2Data + REAL(SiKi), INTENT( OUT) :: W2WvDir1Range(2) + REAL(SiKi), INTENT( OUT) :: W2WvDir2Range(2) + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + INTEGER(IntKi) :: NumWvDir1, NumWvDir2, I + REAL(SiKi) :: AvgInpWvDirSpcg + REAL(SiKi), PARAMETER :: Tol = 0.001 ! deg + CHARACTER(*), PARAMETER :: RoutineName = 'GetWAMIT2WvHdgRangeDiffData' + ErrStat = ErrID_None + ErrMsg = "" + + ! WvDir1 and WvDir2 should be the same, but treating them as potentially different for now + IF ( W2Data%DataIs3D) THEN + W2WvDir1Range(1) = MINVAL(W2Data%Data3D%WvDir1) + W2WvDir1Range(2) = MAXVAL(W2Data%Data3D%WvDir1) + W2WvDir2Range(1) = MINVAL(W2Data%Data3D%WvDir2) + W2WvDir2Range(2) = MAXVAL(W2Data%Data3D%WvDir2) + NumWvDir1 = W2Data%Data3D%NumWvDir1 + NumWvDir2 = W2Data%Data3D%NumWvDir2 + ELSE IF ( W2Data%DataIs4D) THEN + W2WvDir1Range(1) = MINVAL(W2Data%Data4D%WvDir1) + W2WvDir1Range(2) = MAXVAL(W2Data%Data4D%WvDir1) + W2WvDir2Range(1) = MINVAL(W2Data%Data4D%WvDir2) + W2WvDir2Range(2) = MAXVAL(W2Data%Data4D%WvDir2) + NumWvDir1 = W2Data%Data4D%NumWvDir1 + NumWvDir2 = W2Data%Data4D%NumWvDir2 + ELSE + ! No data. This is a catastrophic issue. We should not have called this routine without data that is usable for the MnDrift calculation + CALL SetErrStat( ErrID_Fatal, ' Second-order wave-load calculation called without data.',ErrStat,ErrMsg,RoutineName) + END IF + + IF ( (W2WvDir1Range(2)-W2WvDir1Range(1))>(360.0+Tol) ) THEN + CALL SetErrStat( ErrID_Fatal,' The difference between any pair of wave directions in '//TRIM(W2Data%Filename)//' should be less than or equal to 360 deg.',ErrStat,ErrMsg,RoutineName) + END IF + IF ( (W2WvDir2Range(2)-W2WvDir2Range(1))>(360.0+Tol) ) THEN + CALL SetErrStat( ErrID_Fatal,' The difference between any pair of wave directions in '//TRIM(W2Data%Filename)//' should be less than or equal to 360 deg.',ErrStat,ErrMsg,RoutineName) + END IF + + ! The input wave headings should cover a contiguous region of directions. Check for gaps and warn user. + IF ( W2Data%DataIs3D) THEN + IF (NumWvDir1>1) THEN + AvgInpWvDirSpcg = (W2WvDir1Range(2)-W2WvDir1Range(1))/REAL(NumWvDir1-1,SiKi) + DO I = 2,NumWvDir1 + IF ( (W2Data%Data3D%WvDir1(I)-W2Data%Data3D%WvDir1(I-1)) > (3.0*AvgInpWvDirSpcg) ) THEN + CALL SetErrStat( ErrID_Warn,'The wave headings in '//TRIM(W2Data%Filename)//' is likely not contiguous with a gap between '//TRIM(Num2LStr(W2Data%Data3D%WvDir1(I-1)))//' and '//TRIM(Num2LStr(W2Data%Data3D%WvDir1(I)))//' degs.', & + ErrStat, ErrMsg, RoutineName) + END IF + END DO + END IF + IF (NumWvDir2>1) THEN + AvgInpWvDirSpcg = (W2WvDir2Range(2)-W2WvDir2Range(1))/REAL(NumWvDir2-1,SiKi) + DO I = 2,NumWvDir2 + IF ( (W2Data%Data3D%WvDir2(I)-W2Data%Data3D%WvDir2(I-1)) > (3.0*AvgInpWvDirSpcg) ) THEN + CALL SetErrStat( ErrID_Warn,'The wave headings in '//TRIM(W2Data%Filename)//' is likely not contiguous with a gap between '//TRIM(Num2LStr(W2Data%Data3D%WvDir2(I-1)))//' and '//TRIM(Num2LStr(W2Data%Data3D%WvDir2(I)))//' degs.', & + ErrStat, ErrMsg, RoutineName) + END IF + END DO + END IF + ELSE IF ( W2Data%DataIs4D) THEN + IF (NumWvDir1>1) THEN + AvgInpWvDirSpcg = (W2WvDir1Range(2)-W2WvDir1Range(1))/REAL(NumWvDir1-1,SiKi) + DO I = 2,NumWvDir1 + IF ( (W2Data%Data4D%WvDir1(I)-W2Data%Data4D%WvDir1(I-1)) > (3.0*AvgInpWvDirSpcg) ) THEN + CALL SetErrStat( ErrID_Warn,'The wave headings in '//TRIM(W2Data%Filename)//' is likely not contiguous with a gap between '//TRIM(Num2LStr(W2Data%Data4D%WvDir1(I-1)))//' and '//TRIM(Num2LStr(W2Data%Data4D%WvDir1(I)))//' degs.', & + ErrStat, ErrMsg, RoutineName) + END IF + END DO + END IF + IF (NumWvDir2>1) THEN + AvgInpWvDirSpcg = (W2WvDir2Range(2)-W2WvDir2Range(1))/REAL(NumWvDir2-1,SiKi) + DO I = 2,NumWvDir2 + IF ( (W2Data%Data4D%WvDir2(I)-W2Data%Data4D%WvDir2(I-1)) > (3.0*AvgInpWvDirSpcg) ) THEN + CALL SetErrStat( ErrID_Warn,'The wave headings in '//TRIM(W2Data%Filename)//' is likely not contiguous with a gap between '//TRIM(Num2LStr(W2Data%Data4D%WvDir2(I-1)))//' and '//TRIM(Num2LStr(W2Data%Data4D%WvDir2(I)))//' degs.', & + ErrStat, ErrMsg, RoutineName) + END IF + END DO + END IF + END IF + +END SUBROUTINE GetWAMIT2WvHdgRangeDiffData + +SUBROUTINE GetWAMIT2WvHdgRangeSumData(W2Data,W2WvDir1Range,W2WvDir2Range,ErrStat,ErrMsg) + TYPE(W2_SumData_Type), INTENT(IN ) :: W2Data + REAL(SiKi), INTENT( OUT) :: W2WvDir1Range(2) + REAL(SiKi), INTENT( OUT) :: W2WvDir2Range(2) + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + INTEGER(IntKi) :: NumWvDir1, NumWvDir2, I + REAL(SiKi) :: AvgInpWvDirSpcg + REAL(SiKi), PARAMETER :: Tol = 0.001 ! deg + CHARACTER(*), PARAMETER :: RoutineName = 'GetWAMIT2WvHdgRangeSumData' + ErrStat = ErrID_None + ErrMsg = "" + + ! WvDir1 and WvDir2 should be the same, but treating them as potentially different for now + IF ( W2Data%DataIs4D) THEN + W2WvDir1Range(1) = MINVAL(W2Data%Data4D%WvDir1) + W2WvDir1Range(2) = MAXVAL(W2Data%Data4D%WvDir1) + W2WvDir2Range(1) = MINVAL(W2Data%Data4D%WvDir2) + W2WvDir2Range(2) = MAXVAL(W2Data%Data4D%WvDir2) + NumWvDir1 = W2Data%Data4D%NumWvDir1 + NumWvDir2 = W2Data%Data4D%NumWvDir2 + ELSE + ! No data. This is a catastrophic issue. We should not have called this routine without data that is usable for the MnDrift calculation + CALL SetErrStat( ErrID_Fatal, ' Second-order wave-load calculation called without data.',ErrStat,ErrMsg,RoutineName) + END IF + + IF ( (W2WvDir1Range(2)-W2WvDir1Range(1))>(360.0+Tol) ) THEN + CALL SetErrStat( ErrID_Fatal,' The difference between any pair of wave directions in '//TRIM(W2Data%Filename)//' should be less than or equal to 360 deg.',ErrStat,ErrMsg,RoutineName) + END IF + IF ( (W2WvDir2Range(2)-W2WvDir2Range(1))>(360.0+Tol) ) THEN + CALL SetErrStat( ErrID_Fatal,' The difference between any pair of wave directions in '//TRIM(W2Data%Filename)//' should be less than or equal to 360 deg.',ErrStat,ErrMsg,RoutineName) + END IF + + ! The input wave headings should cover a contiguous region of directions. Check for gaps and warn user. + IF ( W2Data%DataIs4D) THEN + IF (NumWvDir1>1) THEN + AvgInpWvDirSpcg = (W2WvDir1Range(2)-W2WvDir1Range(1))/REAL(NumWvDir1-1,SiKi) + DO I = 2,NumWvDir1 + IF ( (W2Data%Data4D%WvDir1(I)-W2Data%Data4D%WvDir1(I-1)) > (3.0*AvgInpWvDirSpcg) ) THEN + CALL SetErrStat( ErrID_Warn,'The wave headings in '//TRIM(W2Data%Filename)//' is likely not contiguous with a gap between '//TRIM(Num2LStr(W2Data%Data4D%WvDir1(I-1)))//' and '//TRIM(Num2LStr(W2Data%Data4D%WvDir1(I)))//' degs.', & + ErrStat, ErrMsg, RoutineName) + END IF + END DO + END IF + IF (NumWvDir2>1) THEN + AvgInpWvDirSpcg = (W2WvDir2Range(2)-W2WvDir2Range(1))/REAL(NumWvDir2-1,SiKi) + DO I = 2,NumWvDir2 + IF ( (W2Data%Data4D%WvDir2(I)-W2Data%Data4D%WvDir2(I-1)) > (3.0*AvgInpWvDirSpcg) ) THEN + CALL SetErrStat( ErrID_Warn,'The wave headings in '//TRIM(W2Data%Filename)//' is likely not contiguous with a gap between '//TRIM(Num2LStr(W2Data%Data4D%WvDir2(I-1)))//' and '//TRIM(Num2LStr(W2Data%Data4D%WvDir2(I)))//' degs.', & + ErrStat, ErrMsg, RoutineName) + END IF + END DO + END IF + END IF + +END SUBROUTINE GetWAMIT2WvHdgRangeSumData + +SUBROUTINE CheckWAMIT2WvHdgDiffData(InitInp,W2Data,ErrStat,ErrMsg) + TYPE(WAMIT2_InitInputType), INTENT(IN ) :: InitInp !< Input data for initialization routine + TYPE(W2_DiffData_Type), INTENT(IN ) :: W2Data + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + + CHARACTER(*), PARAMETER :: RoutineName = 'CheckWAMIT2WvHdgDiffData' + INTEGER(IntKi) :: ErrStatTmp + CHARACTER(ErrMsgLen) :: ErrMsgTmp + + ErrStat = ErrID_None + ErrMsg = "" + + IF ( InitInp%PtfmYMod == 1 ) THEN ! Need to cover -180 deg to 180 deg + IF ( W2Data%DataIs3D ) THEN + IF ( (.not. EqualRealNos( minval(W2Data%data3d%WvDir1),REAL(-180,SiKi))) .OR. (.not. EqualRealNos( maxval(W2Data%data3d%WvDir1),REAL(180,SiKi))) ) THEN + CALL SetErrStat( ErrID_Fatal,' Both wave directions in the WAMIT output file '//TRIM(W2Data%Filename)//' must go from exactly -180 deg to +180 deg.',ErrStat,ErrMsg,RoutineName) + END IF + IF ( (.not. EqualRealNos( minval(W2Data%data3d%WvDir2),REAL(-180,SiKi))) .OR. (.not. EqualRealNos( maxval(W2Data%data3d%WvDir2),REAL(180,SiKi))) ) THEN + CALL SetErrStat( ErrID_Fatal,' Both wave directions in the WAMIT output file '//TRIM(W2Data%Filename)//' must go from exactly -180 deg to +180 deg.',ErrStat,ErrMsg,RoutineName) + END IF + ELSE IF ( W2Data%DataIs4D ) THEN + IF ( (.not. EqualRealNos( minval(W2Data%data4d%WvDir1),REAL(-180,SiKi))) .OR. (.not. EqualRealNos( maxval(W2Data%data4d%WvDir1),REAL(180,SiKi))) ) THEN + CALL SetErrStat( ErrID_Fatal,' Both wave directions in the WAMIT output file '//TRIM(W2Data%Filename)//' must go from exactly -180 deg to +180 deg.',ErrStat,ErrMsg,RoutineName) + END IF + IF ( (.not. EqualRealNos( minval(W2Data%data4d%WvDir2),REAL(-180,SiKi))) .OR. (.not. EqualRealNos( maxval(W2Data%data4d%WvDir2),REAL(180,SiKi))) ) THEN + CALL SetErrStat( ErrID_Fatal,' Both wave directions in the WAMIT output file '//TRIM(W2Data%Filename)//' must go from exactly -180 deg to +180 deg.',ErrStat,ErrMsg,RoutineName) + END IF + ELSE + ! No data. This is a catastrophic issue. We should not have called this routine without data that is usable for the MnDrift calculation + CALL SetErrStat( ErrID_Fatal, ' Second-order wave-load calculation called without data.',ErrStat,ErrMsg,RoutineName) + END IF + ELSE IF ( InitInp%PtfmYMod == 0) THEN ! Only need to cover the range of incident wave headings + IF ( W2Data%DataIs3D ) THEN + CALL CheckWvHdg(InitInp,W2Data%Data3D%NumWvDir1,W2Data%data3d%WvDir1,'first',ErrStatTmp,ErrMsgTmp) + CALL SetErrStat(ErrStatTmp,' WAMIT output file '//TRIM(W2Data%Filename)//ErrMsgTmp,ErrStat,ErrMsg,RoutineName) + CALL CheckWvHdg(InitInp,W2Data%Data3D%NumWvDir2,W2Data%data3d%WvDir2,'second',ErrStatTmp,ErrMsgTmp) + CALL SetErrStat(ErrStatTmp,' WAMIT output file '//TRIM(W2Data%Filename)//ErrMsgTmp,ErrStat,ErrMsg,RoutineName) + ELSE IF ( W2Data%DataIs4D ) THEN + CALL CheckWvHdg(InitInp,W2Data%Data4D%NumWvDir1,W2Data%data4D%WvDir1,'first',ErrStatTmp,ErrMsgTmp) + CALL SetErrStat(ErrStatTmp,' WAMIT output file '//TRIM(W2Data%Filename)//ErrMsgTmp,ErrStat,ErrMsg,RoutineName) + CALL CheckWvHdg(InitInp,W2Data%Data4D%NumWvDir2,W2Data%data4D%WvDir2,'second',ErrStatTmp,ErrMsgTmp) + CALL SetErrStat(ErrStatTmp,' WAMIT output file '//TRIM(W2Data%Filename)//ErrMsgTmp,ErrStat,ErrMsg,RoutineName) + ELSE + ! No data. This is a catastrophic issue. We should not have called this routine without data that is usable for the MnDrift calculation + CALL SetErrStat( ErrID_Fatal, ' Second-order wave-load calculation called without data.',ErrStat,ErrMsg,RoutineName) + END IF + ENDIF + + RETURN + +END SUBROUTINE CheckWAMIT2WvHdgDiffData + +SUBROUTINE CheckWAMIT2WvHdgSumData(InitInp,W2Data,ErrStat,ErrMsg) + TYPE(WAMIT2_InitInputType), INTENT(IN ) :: InitInp !< Input data for initialization routine + TYPE(W2_SumData_Type), INTENT(IN ) :: W2Data + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + + CHARACTER(*), PARAMETER :: RoutineName = 'CheckWAMIT2WvHdgSumData' + INTEGER(IntKi) :: ErrStatTmp + CHARACTER(ErrMsgLen) :: ErrMsgTmp + + ErrStat = ErrID_None + ErrMsg = "" + + IF ( InitInp%PtfmYMod == 1 ) THEN ! Need to cover -180 deg to 180 deg + IF ( W2Data%DataIs4D ) THEN + IF ( (.not. EqualRealNos( minval(W2Data%data4d%WvDir1),REAL(-180,SiKi))) .OR. (.not. EqualRealNos( maxval(W2Data%data4d%WvDir1),REAL(180,SiKi))) ) THEN + CALL SetErrStat( ErrID_Fatal,' Both wave directions in the WAMIT output file '//TRIM(W2Data%Filename)//' must go from exactly -180 deg to +180 deg.',ErrStat,ErrMsg,RoutineName) + END IF + IF ( (.not. EqualRealNos( minval(W2Data%data4d%WvDir2),REAL(-180,SiKi))) .OR. (.not. EqualRealNos( maxval(W2Data%data4d%WvDir2),REAL(180,SiKi))) ) THEN + CALL SetErrStat( ErrID_Fatal,' Both wave directions in the WAMIT output file '//TRIM(W2Data%Filename)//' must go from exactly -180 deg to +180 deg.',ErrStat,ErrMsg,RoutineName) + END IF + ELSE + ! No data. This is a catastrophic issue. We should not have called this routine without data that is usable for the MnDrift calculation + CALL SetErrStat( ErrID_Fatal, ' Second-order wave-load calculation called without data.',ErrStat,ErrMsg,RoutineName) + END IF + ELSE IF ( InitInp%PtfmYMod == 0) THEN ! Only need to cover the range of incident wave headings + IF ( W2Data%DataIs4D ) THEN + CALL CheckWvHdg(InitInp,W2Data%Data4D%NumWvDir1,W2Data%data4D%WvDir1,'first',ErrStatTmp,ErrMsgTmp) + CALL SetErrStat(ErrStatTmp,' WAMIT output file '//TRIM(W2Data%Filename)//ErrMsgTmp,ErrStat,ErrMsg,RoutineName) + CALL CheckWvHdg(InitInp,W2Data%Data4D%NumWvDir2,W2Data%data4D%WvDir2,'second',ErrStatTmp,ErrMsgTmp) + CALL SetErrStat(ErrStatTmp,' WAMIT output file '//TRIM(W2Data%Filename)//ErrMsgTmp,ErrStat,ErrMsg,RoutineName) + ELSE + ! No data. This is a catastrophic issue. We should not have called this routine without data that is usable for the MnDrift calculation + CALL SetErrStat( ErrID_Fatal, ' Second-order wave-load calculation called without data.',ErrStat,ErrMsg,RoutineName) + END IF + END IF + + RETURN + +END SUBROUTINE CheckWAMIT2WvHdgSumData + +SUBROUTINE CheckWvHdg(InitInp,NumWAMITWvDir,WAMITWvDir,WvDirName,ErrStat,ErrMsg) + TYPE(WAMIT2_InitInputType), INTENT(IN ) :: InitInp + INTEGER(IntKi), INTENT(IN ) :: NumWAMITWvDir + REAL(SiKi), INTENT(IN ) :: WAMITWvDir(:) + CHARACTER(*), INTENT(IN ) :: WvDirName + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + REAL(SiKi) :: RotateZdegOffset,MinAllowedWvDir,MaxAllowedWvDir,unusedReal + INTEGER(IntKi) :: I + + ErrStat = ErrID_None + ErrMsg = "" + + ! If we are using multidirectional waves, then we should have more than 1 wave direction in the WAMIT file. + IF ( InitInp%WaveField%WaveMultiDir .AND. (NumWAMITWvDir == 1) ) THEN + CALL SetErrStat( ErrID_Fatal,' only contains one '//WvDirName//' wave direction at '//TRIM(Num2LStr(WAMITWvDir(1)))//' degrees'// & + 'It cannot be used with multidirectional waves. Set WaveDirMod to 0 to use this file.', & + ErrStat,ErrMsg,'') + ELSE + ! Need to account for PtfmRefztRot (the current WAMIT2 module can only contain one body in this case) + IF (InitInp%NBodyMod==2) THEN + RotateZdegOffset = InitInp%PtfmRefztRot(1)*R2D + ELSE + RotateZdegOffset = 0.0 + END IF + ! Allowed range of incident wave angles in the global frame + MinAllowedWvDir = MINVAL(WAMITWvDir)+RotateZdegOffset+InitInp%PtfmRefY*R2D + MaxAllowedWvDir = MAXVAL(WAMITWvDir)+RotateZdegOffset+InitInp%PtfmRefY*R2D + ! For robustness, check every single incident wave direction + DO I = 0,InitInp%WaveField%NStepWave2 + IF (.NOT. GetAngleInRange(InitInp%WaveField%WaveDirArr(I),MinAllowedWvDir,MaxAllowedWvDir,unusedReal)) THEN + CALL SetErrStat( ErrID_Fatal,' does not contain the range of wave directions covering '//TRIM(Num2LStr(InitInp%WaveField%WaveDirArr(I)))//' deg for the '//WvDirName//' wave direction.', & + ErrStat, ErrMsg, '') + RETURN + END IF + END DO + ENDIF + +END SUBROUTINE CheckWvHdg + +FUNCTION GetAngleInRangeR8(inAngle,minAngle,maxAngle,outAngle) + REAL(R8Ki), INTENT(IN ) :: inAngle + REAL(R8Ki), INTENT(IN ) :: minAngle + REAL(R8Ki), INTENT(IN ) :: maxAngle + REAL(R8Ki), INTENT( OUT) :: outAngle + LOGICAL :: GetAngleInRangeR8 + REAL(R8Ki), PARAMETER :: Tol = 0.001 ! deg + + GetAngleInRangeR8 = .FALSE. + if ( ( inAngle > (minAngle-Tol) ) .AND. ( inAngle < (maxAngle+Tol) ) ) then + GetAngleInRangeR8 = .TRUE. + outAngle = inAngle + else if (inAngle < minAngle ) then + outAngle = inAngle + ceiling((minAngle-inAngle)/360.0)*360.0 + if ( outAngle < (maxAngle+Tol) ) then + GetAngleInRangeR8 = .TRUE. + end if + else ! inAngle > maxAngle + outAngle = inAngle - ceiling((inAngle-maxAngle)/360.0)*360.0 + if ( outAngle > (minAngle-Tol) ) then + GetAngleInRangeR8 = .TRUE. + end if + end if + +END FUNCTION GetAngleInRangeR8 + +FUNCTION GetAngleInRangeR4(inAngle,minAngle,maxAngle,outAngle) + REAL(SiKi), INTENT(IN ) :: inAngle + REAL(SiKi), INTENT(IN ) :: minAngle + REAL(SiKi), INTENT(IN ) :: maxAngle + REAL(SiKi), INTENT( OUT) :: outAngle + LOGICAL :: GetAngleInRangeR4 + REAL(SiKi), PARAMETER :: Tol = 0.001 ! deg + + GetAngleInRangeR4 = .FALSE. + if ( ( inAngle > (minAngle-Tol) ) .AND. ( inAngle < (maxAngle+Tol) ) ) then + GetAngleInRangeR4 = .TRUE. + outAngle = inAngle + else if (inAngle < minAngle ) then + outAngle = inAngle + ceiling((minAngle-inAngle)/360.0)*360.0 + if ( outAngle < (maxAngle+Tol) ) then + GetAngleInRangeR4 = .TRUE. + end if + else ! inAngle > maxAngle + outAngle = inAngle - ceiling((inAngle-maxAngle)/360.0)*360.0 + if ( outAngle > (minAngle-Tol) ) then + GetAngleInRangeR4 = .TRUE. + end if + end if + +END FUNCTION GetAngleInRangeR4 + !---------------------------------------------------------------------------------------------------------------------------------- END MODULE WAMIT2 diff --git a/modules/hydrodyn/src/WAMIT2.txt b/modules/hydrodyn/src/WAMIT2.txt index 992093a69a..ad3ec0d6f3 100644 --- a/modules/hydrodyn/src/WAMIT2.txt +++ b/modules/hydrodyn/src/WAMIT2.txt @@ -13,13 +13,13 @@ # ...... Include files (definitions from NWTC Library) ............................................................................ # make sure that the file name does not have any trailing white spaces! include Registry_NWTC_Library.txt +usefrom SeaSt_WaveField.txt param WAMIT2/WAMIT2 unused INTEGER MaxWAMIT2Outputs - 6 - "" - #InitInputType -- used for passing stuff into the Init routine. typedef WAMIT2/WAMIT2 InitInputType LOGICAL HasWAMIT - - - ".TRUE. if using WAMIT model, .FALSE. otherwise" - typedef ^ ^ CHARACTER(1024) WAMITFile - - - "Root of the filename for WAMIT2 outputs" - -typedef ^ ^ INTEGER UnSum - - - "The unit number for the HydroDyn summary file" - typedef ^ ^ INTEGER NBody - - - "[>=1; only used when PotMod=1. If NBodyMod=1, the WAMIT data contains a vector of size 6*NBody x 1 and matrices of size 6*NBody x 6*NBody; if NBodyMod>1, there are NBody sets of WAMIT data each with a vector of size 6 x 1 and matrices of size 6 x 6]" - typedef ^ ^ INTEGER NBodyMod - - - "Body coupling model {1: include coupling terms between each body and NBody in HydroDyn equals NBODY in WAMIT, 2: neglect coupling terms between each body and NBODY=1 with XBODY=0 in WAMIT, 3: Neglect coupling terms between each body and NBODY=1 with XBODY=/0 in WAMIT} (switch) [only used when PotMod=1]" - typedef ^ ^ ReKi PtfmRefxt {:} - - "The xt offset of the body reference point(s) from (0,0,0) [1 to NBody; only used when PotMod=1; must be 0.0 if NBodyMod=2 ]" (m) @@ -28,23 +28,12 @@ typedef ^ ^ ReKi PtfmRefzt typedef ^ ^ R8Ki PtfmRefztRot {:} - - "The rotation about zt of the body reference frame(s) from xt/yt" radians typedef ^ ^ ReKi WAMITULEN - - - "WAMIT unit length scale" - -typedef ^ ^ ReKi RhoXg - - - "Density * Gravity -- from the Waves module." - -typedef ^ ^ INTEGER NStepWave - - - "Total number of frequency components = total number of time steps in the incident wave" - -typedef ^ ^ INTEGER NStepWave2 - - - "NStepWave / 2" - -typedef ^ ^ ReKi WaveDOmega - - - "Frequency step for incident wave calculations" (rad/s) -typedef ^ ^ ReKi WtrDens - - - "Water density" (kg/m^3) typedef ^ ^ ReKi Gravity - - - "Supplied by Driver: Gravitational acceleration" (m/s^2) -typedef ^ ^ SiKi WtrDpth - - - "Water depth (positive-valued)" (m) -typedef ^ ^ SiKi WaveElevC0 {:}{:} - - "Discrete Fourier transform of the instantaneous elevation of incident waves at the platform reference point. First column is real part, second column is imaginary part" (meters) -typedef ^ ^ SiKi WaveDir - - - "Mean incident wave propagation heading direction" (degrees) -typedef ^ ^ LOGICAL WaveMultiDir - - - "Indicates the waves are multidirectional -- set by HydroDyn_Input" - -typedef ^ ^ SiKi WaveDirArr {:} - - "Wave direction assigned to each frequency" (degrees) -typedef ^ ^ SiKi WaveDirMin - - - "Minimum wave direction from Waves module" - -typedef ^ ^ SiKi WaveDirMax - - - "Maximum wave direction from Waves module" - -typedef ^ ^ SiKi WaveTime {:} - - "Simulation times at which the instantaneous second order loads associated with the incident waves are determined" sec - -typedef ^ ^ INTEGER WaveMod - - - "The wave model to use. This is for error checking -- ideally this would be done in the main calling routine, not here." - +typedef ^ ^ SeaSt_WaveFieldType *WaveField - - - "Pointer to wave field" +typedef ^ ^ INTEGER PtfmYMod - - - "Large yaw model" - +typedef ^ ^ ReKi PtfmRefY - - - "Initial reference yaw offset" (rad) +typedef ^ ^ IntKi NExctnHdg - - - "Number of PRP headings/yaw offset evenly distributed over the region [-180, 180) deg to be used when precomputing the wave excitation [only used when PtfmYMod=1]" #[note: only one of MnDriff / NewmanApp / DiffQTF can be non-zero typedef ^ ^ INTEGER MnDrift - - - "Calculate the mean drift force {0: no mean drift; [7,8,9,10,11, or 12]: WAMIT file to use}" - @@ -55,56 +44,24 @@ typedef ^ ^ LOGICAL MnDriftF typedef ^ ^ LOGICAL NewmanAppF - - - "Flag indicating Newman approximation should be calculated" - typedef ^ ^ LOGICAL DiffQTFF - - - "Flag indicating the full difference QTF should be calculated" - typedef ^ ^ LOGICAL SumQTFF - - - "Flag indicating the full sum QTF should be calculated" - -typedef ^ ^ ReKi WvLowCOff - - - "Low cut-off frequency or lower frequency limit of the wave spectrum beyond which the wave spectrum is zeroed. [used only when WaveMod=2,3,4]" (rad/s) -typedef ^ ^ ReKi WvHiCOff - - - "High cut-off frequency or upper frequency limit of the wave spectrum beyond which the wave spectrum is zeroed. [used only when WaveMod=2,3,4]" (rad/s) -typedef ^ ^ ReKi WvLowCOffD - - - "Minimum frequency used in the difference methods [Ignored if all difference methods = 0]" (rad/s) -typedef ^ ^ ReKi WvHiCOffD - - - "Maximum frequency used in the difference methods [Ignored if all difference methods = 0]" (rad/s) -typedef ^ ^ ReKi WvLowCOffS - - - "Minimum frequency used in the sum-QTF method [Ignored if SumQTF = 0]" (rad/s) -typedef ^ ^ ReKi WvHiCOffS - - - "Maximum frequency used in the sum-QTF method [Ignored if SumQTF = 0]" (rad/s) - - -# Define outputs from the initialization routine here: -# -typedef ^ InitOutputType ReKi NULLVAL - - - "" - - - -# ..... States .................................................................................................................... -# Define continuous (differentiable) states here: -typedef ^ ContinuousStateType SiKi DummyContState - - - "Remove this variable if you have continuous states" - - - -# Define discrete (nondifferentiable) states here: -typedef ^ DiscreteStateType SiKi DummyDiscState - - - "Remove this variable if you have discrete states" - - - -# Define constraint states here: -typedef ^ ConstraintStateType SiKi DummyConstrState - - - "Remove this variable if you have constraint states" - - - -# Define any data that are 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 INTEGER LastIndWave : - - "Index for last interpolation step of 2nd order forces" - -typedef ^ ^ ReKi F_Waves2 {:} - - "2nd order force from this timestep" - - - +typedef ^ ^ ReKi F_Waves2 {:} - - "2nd order force from this timestep" - +typedef ^ ^ SeaSt_WaveField_MiscVarType WaveField_m - - - "misc var information from the SeaState Interpolation module" - # ..... 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 SiKi WaveTime {:} - - "Simulation times at which the instantaneous second order loads associated with the incident waves are determined" sec -typedef ^ ^ IntKi NStepWave - - - "Number of wave time steps" - -typedef ^ ^ DbKi DT - - - "" - -typedef ^ ^ INTEGER NBody - - - "[>=1; only used when PotMod=1. If NBodyMod=1, the WAMIT data contains a vector of size 6*NBody x 1 and matrices of size 6*NBody x 6*NBody; if NBodyMod>1, there are NBody sets of WAMIT data each with a vector of size 6 x 1 and matrices of size 6 x 6]" - +typedef ^ ParameterType INTEGER NBody - - - "[>=1; only used when PotMod=1. If NBodyMod=1, the WAMIT data contains a vector of size 6*NBody x 1 and matrices of size 6*NBody x 6*NBody; if NBodyMod>1, there are NBody sets of WAMIT data each with a vector of size 6 x 1 and matrices of size 6 x 6]" - typedef ^ ^ INTEGER NBodyMod - - - "Body coupling model {1: include coupling terms between each body and NBody in HydroDyn equals NBODY in WAMIT, 2: neglect coupling terms between each body and NBODY=1 with XBODY=0 in WAMIT, 3: Neglect coupling terms between each body and NBODY=1 with XBODY=/0 in WAMIT} (switch) [only used when PotMod=1]" - -#The 2nd order force time series -typedef ^ ^ SiKi WaveExctn2 {:}{:} - - "Time series of the resulting 2nd order force (first index is timestep, second index is load component)" (N) +#The 2nd order force time series grid +typedef ^ ^ SiKi WaveExctn2Grid {:}{:}{:}{:}{:} - - "Grid of time series of the resulting 2nd order force (Index 1: Time, Index 2: x, Index 3: y, Index 4: platform heading, and Index 5: load component)" (N) +typedef ^ ^ SeaSt_WaveField_ParameterType Exctn2GridParams - - - "Parameters of WaveExctn2Grid" - #Flags set for dimensions to use with each method (MnDrift, NewmanApp, etc). These are stored by method because .8 files that can be used in MnDrift or NewmanApp don't have some of the dimensions. typedef ^ ^ LOGICAL MnDriftDims {6} - - "Flags for which dimensions to calculate in MnDrift calculations" - @@ -116,24 +73,8 @@ typedef ^ ^ LOGICAL MnDriftF typedef ^ ^ LOGICAL NewmanAppF - - - "Flag indicating Newman approximation should be calculated" - typedef ^ ^ LOGICAL DiffQTFF - - - "Flag indicating the full difference QTF should be calculated" - typedef ^ ^ LOGICAL SumQTFF - - - "Flag indicating the full sum QTF should be calculated" - - -typedef ^ ^ OutParmType OutParam {:} - - "" - -typedef ^ ^ INTEGER NumOuts - - - "" - -typedef ^ ^ INTEGER NumOutAll - - - "" - -typedef ^ ^ CHARACTER(20) OutFmt - - - "" - -typedef ^ ^ CHARACTER(20) OutSFmt - - - "" - -typedef ^ ^ CHARACTER(ChanLen) Delim - - - "" - -typedef ^ ^ INTEGER UnOutFile - - - "" - - - - - -# ..... Inputs .................................................................................................................... -# Define inputs that are contained on the mesh here: -# -typedef ^ InputType MeshType Mesh - - - "Displacements at the platform reference point in the inertial frame" - - - +typedef ^ ^ INTEGER PtfmYMod - - - "Large yaw model" - +typedef ^ ^ INTEGER NExctnHdg - - - "Number of PRP headings/yaw offset evenly distributed over the region [-180, 180) deg to be used when precomputing the wave excitation [only used when PtfmYMod=1]" # ..... Outputs ................................................................................................................... # Define outputs that are contained on the mesh here: diff --git a/modules/hydrodyn/src/WAMIT2_Types.f90 b/modules/hydrodyn/src/WAMIT2_Types.f90 index d09382e26e..5f928caa56 100644 --- a/modules/hydrodyn/src/WAMIT2_Types.f90 +++ b/modules/hydrodyn/src/WAMIT2_Types.f90 @@ -31,2949 +31,546 @@ !! unpack routines associated with each defined data type. This code is automatically generated by the FAST Registry. MODULE WAMIT2_Types !--------------------------------------------------------------------------------------------------------------------------------- +USE SeaSt_WaveField_Types USE NWTC_Library IMPLICIT NONE INTEGER(IntKi), PUBLIC, PARAMETER :: MaxWAMIT2Outputs = 6 ! [-] ! ========= WAMIT2_InitInputType ======= TYPE, PUBLIC :: WAMIT2_InitInputType - LOGICAL :: HasWAMIT !< .TRUE. if using WAMIT model, .FALSE. otherwise [-] + LOGICAL :: HasWAMIT = .false. !< .TRUE. if using WAMIT model, .FALSE. otherwise [-] CHARACTER(1024) :: WAMITFile !< Root of the filename for WAMIT2 outputs [-] - INTEGER(IntKi) :: UnSum !< The unit number for the HydroDyn summary file [-] - INTEGER(IntKi) :: NBody !< [>=1; only used when PotMod=1. If NBodyMod=1, the WAMIT data contains a vector of size 6*NBody x 1 and matrices of size 6*NBody x 6*NBody; if NBodyMod>1, there are NBody sets of WAMIT data each with a vector of size 6 x 1 and matrices of size 6 x 6] [-] - INTEGER(IntKi) :: NBodyMod !< Body coupling model {1: include coupling terms between each body and NBody in HydroDyn equals NBODY in WAMIT, 2: neglect coupling terms between each body and NBODY=1 with XBODY=0 in WAMIT, 3: Neglect coupling terms between each body and NBODY=1 with XBODY=/0 in WAMIT} (switch) [only used when PotMod=1] [-] + INTEGER(IntKi) :: NBody = 0_IntKi !< [>=1; only used when PotMod=1. If NBodyMod=1, the WAMIT data contains a vector of size 6*NBody x 1 and matrices of size 6*NBody x 6*NBody; if NBodyMod>1, there are NBody sets of WAMIT data each with a vector of size 6 x 1 and matrices of size 6 x 6] [-] + INTEGER(IntKi) :: NBodyMod = 0_IntKi !< Body coupling model {1: include coupling terms between each body and NBody in HydroDyn equals NBODY in WAMIT, 2: neglect coupling terms between each body and NBODY=1 with XBODY=0 in WAMIT, 3: Neglect coupling terms between each body and NBODY=1 with XBODY=/0 in WAMIT} (switch) [only used when PotMod=1] [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: PtfmRefxt !< The xt offset of the body reference point(s) from (0,0,0) [1 to NBody; only used when PotMod=1; must be 0.0 if NBodyMod=2 ] [(m)] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: PtfmRefyt !< The yt offset of the body reference point(s) from (0,0,0) [1 to NBody; only used when PotMod=1; must be 0.0 if NBodyMod=2 ] [(m)] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: PtfmRefzt !< The zt offset of the body reference point(s) from (0,0,0) [1 to NBody; only used when PotMod=1; must be 0.0 if NBodyMod=2 ] [(m)] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: PtfmRefztRot !< The rotation about zt of the body reference frame(s) from xt/yt [radians] - REAL(ReKi) :: WAMITULEN !< WAMIT unit length scale [-] - REAL(ReKi) :: RhoXg !< Density * Gravity -- from the Waves module. [-] - INTEGER(IntKi) :: NStepWave !< Total number of frequency components = total number of time steps in the incident wave [-] - INTEGER(IntKi) :: NStepWave2 !< NStepWave / 2 [-] - REAL(ReKi) :: WaveDOmega !< Frequency step for incident wave calculations [(rad/s)] - REAL(ReKi) :: WtrDens !< Water density [(kg/m^3)] - REAL(ReKi) :: Gravity !< Supplied by Driver: Gravitational acceleration [(m/s^2)] - REAL(SiKi) :: WtrDpth !< Water depth (positive-valued) [(m)] - REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: WaveElevC0 !< Discrete Fourier transform of the instantaneous elevation of incident waves at the platform reference point. First column is real part, second column is imaginary part [(meters)] - REAL(SiKi) :: WaveDir !< Mean incident wave propagation heading direction [(degrees)] - LOGICAL :: WaveMultiDir !< Indicates the waves are multidirectional -- set by HydroDyn_Input [-] - REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveDirArr !< Wave direction assigned to each frequency [(degrees)] - REAL(SiKi) :: WaveDirMin !< Minimum wave direction from Waves module [-] - REAL(SiKi) :: WaveDirMax !< Maximum wave direction from Waves module [-] - REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveTime !< Simulation times at which the instantaneous second order loads associated with the incident waves are determined [sec] - INTEGER(IntKi) :: WaveMod !< The wave model to use. This is for error checking -- ideally this would be done in the main calling routine, not here. [-] - INTEGER(IntKi) :: MnDrift !< Calculate the mean drift force {0: no mean drift; [7,8,9,10,11, or 12]: WAMIT file to use} [-] - INTEGER(IntKi) :: NewmanApp !< Slow drift forces computed with Newman approximation from WAMIT file:{0: No slow drift; [7,8,9,10,11, or 12]: WAMIT file to use} [-] - INTEGER(IntKi) :: DiffQTF !< Full Difference-Frequency forces computed with full QTF's from WAMIT file: {0: No diff-QTF; [10,11, or 12]: WAMIT file to use} [-] - INTEGER(IntKi) :: SumQTF !< Full Sum-Frequency forces computed with full QTF's from WAMIT file: {0: No sum-QTF; [10,11, or 12]: WAMIT file to use} [-] - LOGICAL :: MnDriftF !< Flag indicating mean drift force should be calculated [-] - LOGICAL :: NewmanAppF !< Flag indicating Newman approximation should be calculated [-] - LOGICAL :: DiffQTFF !< Flag indicating the full difference QTF should be calculated [-] - LOGICAL :: SumQTFF !< Flag indicating the full sum QTF should be calculated [-] - REAL(ReKi) :: WvLowCOff !< Low cut-off frequency or lower frequency limit of the wave spectrum beyond which the wave spectrum is zeroed. [used only when WaveMod=2,3,4] [(rad/s)] - REAL(ReKi) :: WvHiCOff !< High cut-off frequency or upper frequency limit of the wave spectrum beyond which the wave spectrum is zeroed. [used only when WaveMod=2,3,4] [(rad/s)] - REAL(ReKi) :: WvLowCOffD !< Minimum frequency used in the difference methods [Ignored if all difference methods = 0] [(rad/s)] - REAL(ReKi) :: WvHiCOffD !< Maximum frequency used in the difference methods [Ignored if all difference methods = 0] [(rad/s)] - REAL(ReKi) :: WvLowCOffS !< Minimum frequency used in the sum-QTF method [Ignored if SumQTF = 0] [(rad/s)] - REAL(ReKi) :: WvHiCOffS !< Maximum frequency used in the sum-QTF method [Ignored if SumQTF = 0] [(rad/s)] + REAL(ReKi) :: WAMITULEN = 0.0_ReKi !< WAMIT unit length scale [-] + REAL(ReKi) :: Gravity = 0.0_ReKi !< Supplied by Driver: Gravitational acceleration [(m/s^2)] + TYPE(SeaSt_WaveFieldType) , POINTER :: WaveField => NULL() !< Pointer to wave field [-] + INTEGER(IntKi) :: PtfmYMod = 0_IntKi !< Large yaw model [-] + REAL(ReKi) :: PtfmRefY = 0.0_ReKi !< Initial reference yaw offset [(rad)] + INTEGER(IntKi) :: NExctnHdg = 0_IntKi !< Number of PRP headings/yaw offset evenly distributed over the region [-180, 180) deg to be used when precomputing the wave excitation [only used when PtfmYMod=1] [-] + INTEGER(IntKi) :: MnDrift = 0_IntKi !< Calculate the mean drift force {0: no mean drift; [7,8,9,10,11, or 12]: WAMIT file to use} [-] + INTEGER(IntKi) :: NewmanApp = 0_IntKi !< Slow drift forces computed with Newman approximation from WAMIT file:{0: No slow drift; [7,8,9,10,11, or 12]: WAMIT file to use} [-] + INTEGER(IntKi) :: DiffQTF = 0_IntKi !< Full Difference-Frequency forces computed with full QTF's from WAMIT file: {0: No diff-QTF; [10,11, or 12]: WAMIT file to use} [-] + INTEGER(IntKi) :: SumQTF = 0_IntKi !< Full Sum-Frequency forces computed with full QTF's from WAMIT file: {0: No sum-QTF; [10,11, or 12]: WAMIT file to use} [-] + LOGICAL :: MnDriftF = .false. !< Flag indicating mean drift force should be calculated [-] + LOGICAL :: NewmanAppF = .false. !< Flag indicating Newman approximation should be calculated [-] + LOGICAL :: DiffQTFF = .false. !< Flag indicating the full difference QTF should be calculated [-] + LOGICAL :: SumQTFF = .false. !< Flag indicating the full sum QTF should be calculated [-] END TYPE WAMIT2_InitInputType ! ======================= -! ========= WAMIT2_InitOutputType ======= - TYPE, PUBLIC :: WAMIT2_InitOutputType - REAL(ReKi) :: NULLVAL !< [-] - END TYPE WAMIT2_InitOutputType -! ======================= -! ========= WAMIT2_ContinuousStateType ======= - TYPE, PUBLIC :: WAMIT2_ContinuousStateType - REAL(SiKi) :: DummyContState !< Remove this variable if you have continuous states [-] - END TYPE WAMIT2_ContinuousStateType -! ======================= -! ========= WAMIT2_DiscreteStateType ======= - TYPE, PUBLIC :: WAMIT2_DiscreteStateType - REAL(SiKi) :: DummyDiscState !< Remove this variable if you have discrete states [-] - END TYPE WAMIT2_DiscreteStateType -! ======================= -! ========= WAMIT2_ConstraintStateType ======= - TYPE, PUBLIC :: WAMIT2_ConstraintStateType - REAL(SiKi) :: DummyConstrState !< Remove this variable if you have constraint states [-] - END TYPE WAMIT2_ConstraintStateType -! ======================= -! ========= WAMIT2_OtherStateType ======= - TYPE, PUBLIC :: WAMIT2_OtherStateType - INTEGER(IntKi) :: DummyOtherState !< Remove this variable if you have other states [-] - END TYPE WAMIT2_OtherStateType -! ======================= ! ========= WAMIT2_MiscVarType ======= TYPE, PUBLIC :: WAMIT2_MiscVarType INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: LastIndWave !< Index for last interpolation step of 2nd order forces [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: F_Waves2 !< 2nd order force from this timestep [-] + TYPE(SeaSt_WaveField_MiscVarType) :: WaveField_m !< misc var information from the SeaState Interpolation module [-] END TYPE WAMIT2_MiscVarType ! ======================= ! ========= WAMIT2_ParameterType ======= TYPE, PUBLIC :: WAMIT2_ParameterType - REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveTime !< Simulation times at which the instantaneous second order loads associated with the incident waves are determined [sec] - INTEGER(IntKi) :: NStepWave !< Number of wave time steps [-] - REAL(DbKi) :: DT !< [-] - INTEGER(IntKi) :: NBody !< [>=1; only used when PotMod=1. If NBodyMod=1, the WAMIT data contains a vector of size 6*NBody x 1 and matrices of size 6*NBody x 6*NBody; if NBodyMod>1, there are NBody sets of WAMIT data each with a vector of size 6 x 1 and matrices of size 6 x 6] [-] - INTEGER(IntKi) :: NBodyMod !< Body coupling model {1: include coupling terms between each body and NBody in HydroDyn equals NBODY in WAMIT, 2: neglect coupling terms between each body and NBODY=1 with XBODY=0 in WAMIT, 3: Neglect coupling terms between each body and NBODY=1 with XBODY=/0 in WAMIT} (switch) [only used when PotMod=1] [-] - REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: WaveExctn2 !< Time series of the resulting 2nd order force (first index is timestep, second index is load component) [(N)] - LOGICAL , DIMENSION(1:6) :: MnDriftDims !< Flags for which dimensions to calculate in MnDrift calculations [-] - LOGICAL , DIMENSION(1:6) :: NewmanAppDims !< Flags for which dimensions to calculate in NewmanApp calculations [-] - LOGICAL , DIMENSION(1:6) :: DiffQTFDims !< Flags for which dimensions to calculate in DiffQTF calculations [-] - LOGICAL , DIMENSION(1:6) :: SumQTFDims !< Flags for which dimensions to calculate in SumQTF calculations [-] - LOGICAL :: MnDriftF !< Flag indicating mean drift force should be calculated [-] - LOGICAL :: NewmanAppF !< Flag indicating Newman approximation should be calculated [-] - LOGICAL :: DiffQTFF !< Flag indicating the full difference QTF should be calculated [-] - LOGICAL :: SumQTFF !< Flag indicating the full sum QTF should be calculated [-] - TYPE(OutParmType) , DIMENSION(:), ALLOCATABLE :: OutParam !< [-] - INTEGER(IntKi) :: NumOuts !< [-] - INTEGER(IntKi) :: NumOutAll !< [-] - CHARACTER(20) :: OutFmt !< [-] - CHARACTER(20) :: OutSFmt !< [-] - CHARACTER(ChanLen) :: Delim !< [-] - INTEGER(IntKi) :: UnOutFile !< [-] + INTEGER(IntKi) :: NBody = 0_IntKi !< [>=1; only used when PotMod=1. If NBodyMod=1, the WAMIT data contains a vector of size 6*NBody x 1 and matrices of size 6*NBody x 6*NBody; if NBodyMod>1, there are NBody sets of WAMIT data each with a vector of size 6 x 1 and matrices of size 6 x 6] [-] + INTEGER(IntKi) :: NBodyMod = 0_IntKi !< Body coupling model {1: include coupling terms between each body and NBody in HydroDyn equals NBODY in WAMIT, 2: neglect coupling terms between each body and NBODY=1 with XBODY=0 in WAMIT, 3: Neglect coupling terms between each body and NBODY=1 with XBODY=/0 in WAMIT} (switch) [only used when PotMod=1] [-] + REAL(SiKi) , DIMENSION(:,:,:,:,:), ALLOCATABLE :: WaveExctn2Grid !< Grid of time series of the resulting 2nd order force (Index 1: Time, Index 2: x, Index 3: y, Index 4: platform heading, and Index 5: load component) [(N)] + TYPE(SeaSt_WaveField_ParameterType) :: Exctn2GridParams !< Parameters of WaveExctn2Grid [-] + LOGICAL , DIMENSION(1:6) :: MnDriftDims = .false. !< Flags for which dimensions to calculate in MnDrift calculations [-] + LOGICAL , DIMENSION(1:6) :: NewmanAppDims = .false. !< Flags for which dimensions to calculate in NewmanApp calculations [-] + LOGICAL , DIMENSION(1:6) :: DiffQTFDims = .false. !< Flags for which dimensions to calculate in DiffQTF calculations [-] + LOGICAL , DIMENSION(1:6) :: SumQTFDims = .false. !< Flags for which dimensions to calculate in SumQTF calculations [-] + LOGICAL :: MnDriftF = .false. !< Flag indicating mean drift force should be calculated [-] + LOGICAL :: NewmanAppF = .false. !< Flag indicating Newman approximation should be calculated [-] + LOGICAL :: DiffQTFF = .false. !< Flag indicating the full difference QTF should be calculated [-] + LOGICAL :: SumQTFF = .false. !< Flag indicating the full sum QTF should be calculated [-] + INTEGER(IntKi) :: PtfmYMod = 0_IntKi !< Large yaw model [-] + INTEGER(IntKi) :: NExctnHdg = 0_IntKi !< Number of PRP headings/yaw offset evenly distributed over the region [-180, 180) deg to be used when precomputing the wave excitation [only used when PtfmYMod=1] [-] END TYPE WAMIT2_ParameterType ! ======================= -! ========= WAMIT2_InputType ======= - TYPE, PUBLIC :: WAMIT2_InputType - TYPE(MeshType) :: Mesh !< Displacements at the platform reference point in the inertial frame [-] - END TYPE WAMIT2_InputType -! ======================= ! ========= WAMIT2_OutputType ======= TYPE, PUBLIC :: WAMIT2_OutputType TYPE(MeshType) :: Mesh !< Loads at the platform reference point in the inertial frame [-] END TYPE WAMIT2_OutputType ! ======================= CONTAINS - SUBROUTINE WAMIT2_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(WAMIT2_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(WAMIT2_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 = 'WAMIT2_CopyInitInput' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInitInputData%HasWAMIT = SrcInitInputData%HasWAMIT - DstInitInputData%WAMITFile = SrcInitInputData%WAMITFile - DstInitInputData%UnSum = SrcInitInputData%UnSum - DstInitInputData%NBody = SrcInitInputData%NBody - DstInitInputData%NBodyMod = SrcInitInputData%NBodyMod -IF (ALLOCATED(SrcInitInputData%PtfmRefxt)) THEN - i1_l = LBOUND(SrcInitInputData%PtfmRefxt,1) - i1_u = UBOUND(SrcInitInputData%PtfmRefxt,1) - IF (.NOT. ALLOCATED(DstInitInputData%PtfmRefxt)) THEN - ALLOCATE(DstInitInputData%PtfmRefxt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%PtfmRefxt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%PtfmRefxt = SrcInitInputData%PtfmRefxt -ENDIF -IF (ALLOCATED(SrcInitInputData%PtfmRefyt)) THEN - i1_l = LBOUND(SrcInitInputData%PtfmRefyt,1) - i1_u = UBOUND(SrcInitInputData%PtfmRefyt,1) - IF (.NOT. ALLOCATED(DstInitInputData%PtfmRefyt)) THEN - ALLOCATE(DstInitInputData%PtfmRefyt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%PtfmRefyt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%PtfmRefyt = SrcInitInputData%PtfmRefyt -ENDIF -IF (ALLOCATED(SrcInitInputData%PtfmRefzt)) THEN - i1_l = LBOUND(SrcInitInputData%PtfmRefzt,1) - i1_u = UBOUND(SrcInitInputData%PtfmRefzt,1) - IF (.NOT. ALLOCATED(DstInitInputData%PtfmRefzt)) THEN - ALLOCATE(DstInitInputData%PtfmRefzt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%PtfmRefzt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%PtfmRefzt = SrcInitInputData%PtfmRefzt -ENDIF -IF (ALLOCATED(SrcInitInputData%PtfmRefztRot)) THEN - i1_l = LBOUND(SrcInitInputData%PtfmRefztRot,1) - i1_u = UBOUND(SrcInitInputData%PtfmRefztRot,1) - IF (.NOT. ALLOCATED(DstInitInputData%PtfmRefztRot)) THEN - ALLOCATE(DstInitInputData%PtfmRefztRot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%PtfmRefztRot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%PtfmRefztRot = SrcInitInputData%PtfmRefztRot -ENDIF - DstInitInputData%WAMITULEN = SrcInitInputData%WAMITULEN - DstInitInputData%RhoXg = SrcInitInputData%RhoXg - DstInitInputData%NStepWave = SrcInitInputData%NStepWave - DstInitInputData%NStepWave2 = SrcInitInputData%NStepWave2 - DstInitInputData%WaveDOmega = SrcInitInputData%WaveDOmega - DstInitInputData%WtrDens = SrcInitInputData%WtrDens - DstInitInputData%Gravity = SrcInitInputData%Gravity - DstInitInputData%WtrDpth = SrcInitInputData%WtrDpth -IF (ALLOCATED(SrcInitInputData%WaveElevC0)) THEN - i1_l = LBOUND(SrcInitInputData%WaveElevC0,1) - i1_u = UBOUND(SrcInitInputData%WaveElevC0,1) - i2_l = LBOUND(SrcInitInputData%WaveElevC0,2) - i2_u = UBOUND(SrcInitInputData%WaveElevC0,2) - IF (.NOT. ALLOCATED(DstInitInputData%WaveElevC0)) THEN - ALLOCATE(DstInitInputData%WaveElevC0(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveElevC0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%WaveElevC0 = SrcInitInputData%WaveElevC0 -ENDIF - DstInitInputData%WaveDir = SrcInitInputData%WaveDir - DstInitInputData%WaveMultiDir = SrcInitInputData%WaveMultiDir -IF (ALLOCATED(SrcInitInputData%WaveDirArr)) THEN - i1_l = LBOUND(SrcInitInputData%WaveDirArr,1) - i1_u = UBOUND(SrcInitInputData%WaveDirArr,1) - IF (.NOT. ALLOCATED(DstInitInputData%WaveDirArr)) THEN - ALLOCATE(DstInitInputData%WaveDirArr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveDirArr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%WaveDirArr = SrcInitInputData%WaveDirArr -ENDIF - DstInitInputData%WaveDirMin = SrcInitInputData%WaveDirMin - DstInitInputData%WaveDirMax = SrcInitInputData%WaveDirMax -IF (ALLOCATED(SrcInitInputData%WaveTime)) THEN - i1_l = LBOUND(SrcInitInputData%WaveTime,1) - i1_u = UBOUND(SrcInitInputData%WaveTime,1) - IF (.NOT. ALLOCATED(DstInitInputData%WaveTime)) THEN - ALLOCATE(DstInitInputData%WaveTime(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveTime.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%WaveTime = SrcInitInputData%WaveTime -ENDIF - DstInitInputData%WaveMod = SrcInitInputData%WaveMod - DstInitInputData%MnDrift = SrcInitInputData%MnDrift - DstInitInputData%NewmanApp = SrcInitInputData%NewmanApp - DstInitInputData%DiffQTF = SrcInitInputData%DiffQTF - DstInitInputData%SumQTF = SrcInitInputData%SumQTF - DstInitInputData%MnDriftF = SrcInitInputData%MnDriftF - DstInitInputData%NewmanAppF = SrcInitInputData%NewmanAppF - DstInitInputData%DiffQTFF = SrcInitInputData%DiffQTFF - DstInitInputData%SumQTFF = SrcInitInputData%SumQTFF - DstInitInputData%WvLowCOff = SrcInitInputData%WvLowCOff - DstInitInputData%WvHiCOff = SrcInitInputData%WvHiCOff - DstInitInputData%WvLowCOffD = SrcInitInputData%WvLowCOffD - DstInitInputData%WvHiCOffD = SrcInitInputData%WvHiCOffD - DstInitInputData%WvLowCOffS = SrcInitInputData%WvLowCOffS - DstInitInputData%WvHiCOffS = SrcInitInputData%WvHiCOffS - END SUBROUTINE WAMIT2_CopyInitInput - - SUBROUTINE WAMIT2_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(WAMIT2_InitInputType), INTENT(INOUT) :: InitInputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT2_DestroyInitInput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(InitInputData%PtfmRefxt)) THEN - DEALLOCATE(InitInputData%PtfmRefxt) -ENDIF -IF (ALLOCATED(InitInputData%PtfmRefyt)) THEN - DEALLOCATE(InitInputData%PtfmRefyt) -ENDIF -IF (ALLOCATED(InitInputData%PtfmRefzt)) THEN - DEALLOCATE(InitInputData%PtfmRefzt) -ENDIF -IF (ALLOCATED(InitInputData%PtfmRefztRot)) THEN - DEALLOCATE(InitInputData%PtfmRefztRot) -ENDIF -IF (ALLOCATED(InitInputData%WaveElevC0)) THEN - DEALLOCATE(InitInputData%WaveElevC0) -ENDIF -IF (ALLOCATED(InitInputData%WaveDirArr)) THEN - DEALLOCATE(InitInputData%WaveDirArr) -ENDIF -IF (ALLOCATED(InitInputData%WaveTime)) THEN - DEALLOCATE(InitInputData%WaveTime) -ENDIF - END SUBROUTINE WAMIT2_DestroyInitInput - - SUBROUTINE WAMIT2_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(WAMIT2_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 = 'WAMIT2_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 ! HasWAMIT - Int_BufSz = Int_BufSz + 1*LEN(InData%WAMITFile) ! WAMITFile - Int_BufSz = Int_BufSz + 1 ! UnSum - Int_BufSz = Int_BufSz + 1 ! NBody - Int_BufSz = Int_BufSz + 1 ! NBodyMod - Int_BufSz = Int_BufSz + 1 ! PtfmRefxt allocated yes/no - IF ( ALLOCATED(InData%PtfmRefxt) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PtfmRefxt upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PtfmRefxt) ! PtfmRefxt - END IF - Int_BufSz = Int_BufSz + 1 ! PtfmRefyt allocated yes/no - IF ( ALLOCATED(InData%PtfmRefyt) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PtfmRefyt upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PtfmRefyt) ! PtfmRefyt - END IF - Int_BufSz = Int_BufSz + 1 ! PtfmRefzt allocated yes/no - IF ( ALLOCATED(InData%PtfmRefzt) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PtfmRefzt upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PtfmRefzt) ! PtfmRefzt - END IF - Int_BufSz = Int_BufSz + 1 ! PtfmRefztRot allocated yes/no - IF ( ALLOCATED(InData%PtfmRefztRot) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PtfmRefztRot upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%PtfmRefztRot) ! PtfmRefztRot - END IF - Re_BufSz = Re_BufSz + 1 ! WAMITULEN - Re_BufSz = Re_BufSz + 1 ! RhoXg - Int_BufSz = Int_BufSz + 1 ! NStepWave - Int_BufSz = Int_BufSz + 1 ! NStepWave2 - Re_BufSz = Re_BufSz + 1 ! WaveDOmega - Re_BufSz = Re_BufSz + 1 ! WtrDens - Re_BufSz = Re_BufSz + 1 ! Gravity - Re_BufSz = Re_BufSz + 1 ! WtrDpth - Int_BufSz = Int_BufSz + 1 ! WaveElevC0 allocated yes/no - IF ( ALLOCATED(InData%WaveElevC0) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! WaveElevC0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveElevC0) ! WaveElevC0 - END IF - Re_BufSz = Re_BufSz + 1 ! WaveDir - Int_BufSz = Int_BufSz + 1 ! WaveMultiDir - Int_BufSz = Int_BufSz + 1 ! WaveDirArr allocated yes/no - IF ( ALLOCATED(InData%WaveDirArr) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WaveDirArr upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveDirArr) ! WaveDirArr - END IF - Re_BufSz = Re_BufSz + 1 ! WaveDirMin - Re_BufSz = Re_BufSz + 1 ! WaveDirMax - Int_BufSz = Int_BufSz + 1 ! WaveTime allocated yes/no - IF ( ALLOCATED(InData%WaveTime) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WaveTime upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveTime) ! WaveTime - END IF - Int_BufSz = Int_BufSz + 1 ! WaveMod - Int_BufSz = Int_BufSz + 1 ! MnDrift - Int_BufSz = Int_BufSz + 1 ! NewmanApp - Int_BufSz = Int_BufSz + 1 ! DiffQTF - Int_BufSz = Int_BufSz + 1 ! SumQTF - Int_BufSz = Int_BufSz + 1 ! MnDriftF - Int_BufSz = Int_BufSz + 1 ! NewmanAppF - Int_BufSz = Int_BufSz + 1 ! DiffQTFF - Int_BufSz = Int_BufSz + 1 ! SumQTFF - Re_BufSz = Re_BufSz + 1 ! WvLowCOff - Re_BufSz = Re_BufSz + 1 ! WvHiCOff - Re_BufSz = Re_BufSz + 1 ! WvLowCOffD - Re_BufSz = Re_BufSz + 1 ! WvHiCOffD - Re_BufSz = Re_BufSz + 1 ! WvLowCOffS - Re_BufSz = Re_BufSz + 1 ! WvHiCOffS - 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%HasWAMIT, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%WAMITFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%WAMITFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = InData%UnSum - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NBody - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NBodyMod - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%PtfmRefxt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PtfmRefxt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PtfmRefxt,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PtfmRefxt,1), UBOUND(InData%PtfmRefxt,1) - ReKiBuf(Re_Xferred) = InData%PtfmRefxt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PtfmRefyt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PtfmRefyt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PtfmRefyt,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PtfmRefyt,1), UBOUND(InData%PtfmRefyt,1) - ReKiBuf(Re_Xferred) = InData%PtfmRefyt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PtfmRefzt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PtfmRefzt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PtfmRefzt,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PtfmRefzt,1), UBOUND(InData%PtfmRefzt,1) - ReKiBuf(Re_Xferred) = InData%PtfmRefzt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PtfmRefztRot) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PtfmRefztRot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PtfmRefztRot,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PtfmRefztRot,1), UBOUND(InData%PtfmRefztRot,1) - DbKiBuf(Db_Xferred) = InData%PtfmRefztRot(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%WAMITULEN - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RhoXg - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NStepWave - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NStepWave2 - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WaveDOmega - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WtrDens - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Gravity - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WtrDpth - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%WaveElevC0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevC0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevC0,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevC0,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevC0,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%WaveElevC0,2), UBOUND(InData%WaveElevC0,2) - DO i1 = LBOUND(InData%WaveElevC0,1), UBOUND(InData%WaveElevC0,1) - ReKiBuf(Re_Xferred) = InData%WaveElevC0(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - ReKiBuf(Re_Xferred) = InData%WaveDir - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%WaveMultiDir, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%WaveDirArr) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveDirArr,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDirArr,1) - Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WaveDirArr,1), UBOUND(InData%WaveDirArr,1) - ReKiBuf(Re_Xferred) = InData%WaveDirArr(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%WaveDirMin - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WaveDirMax - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%WaveTime) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveTime,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveTime,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WaveTime,1), UBOUND(InData%WaveTime,1) - ReKiBuf(Re_Xferred) = InData%WaveTime(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%WaveMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%MnDrift - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NewmanApp - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%DiffQTF - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%SumQTF - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%MnDriftF, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%NewmanAppF, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%DiffQTFF, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%SumQTFF, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WvLowCOff - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WvHiCOff - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WvLowCOffD - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WvHiCOffD - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WvLowCOffS - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WvHiCOffS - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE WAMIT2_PackInitInput - - SUBROUTINE WAMIT2_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(WAMIT2_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 = 'WAMIT2_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%HasWAMIT = TRANSFER(IntKiBuf(Int_Xferred), OutData%HasWAMIT) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%WAMITFile) - OutData%WAMITFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%UnSum = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NBody = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NBodyMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PtfmRefxt not allocated - Int_Xferred = Int_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%PtfmRefxt)) DEALLOCATE(OutData%PtfmRefxt) - ALLOCATE(OutData%PtfmRefxt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmRefxt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PtfmRefxt,1), UBOUND(OutData%PtfmRefxt,1) - OutData%PtfmRefxt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PtfmRefyt not allocated - Int_Xferred = Int_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%PtfmRefyt)) DEALLOCATE(OutData%PtfmRefyt) - ALLOCATE(OutData%PtfmRefyt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmRefyt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PtfmRefyt,1), UBOUND(OutData%PtfmRefyt,1) - OutData%PtfmRefyt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PtfmRefzt not allocated - Int_Xferred = Int_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%PtfmRefzt)) DEALLOCATE(OutData%PtfmRefzt) - ALLOCATE(OutData%PtfmRefzt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmRefzt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PtfmRefzt,1), UBOUND(OutData%PtfmRefzt,1) - OutData%PtfmRefzt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PtfmRefztRot not allocated - Int_Xferred = Int_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%PtfmRefztRot)) DEALLOCATE(OutData%PtfmRefztRot) - ALLOCATE(OutData%PtfmRefztRot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmRefztRot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PtfmRefztRot,1), UBOUND(OutData%PtfmRefztRot,1) - OutData%PtfmRefztRot(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - OutData%WAMITULEN = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RhoXg = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NStepWave = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NStepWave2 = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WaveDOmega = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%WtrDens = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Gravity = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%WtrDpth = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElevC0 not allocated - Int_Xferred = Int_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%WaveElevC0)) DEALLOCATE(OutData%WaveElevC0) - ALLOCATE(OutData%WaveElevC0(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevC0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%WaveElevC0,2), UBOUND(OutData%WaveElevC0,2) - DO i1 = LBOUND(OutData%WaveElevC0,1), UBOUND(OutData%WaveElevC0,1) - OutData%WaveElevC0(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%WaveDir = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WaveMultiDir = TRANSFER(IntKiBuf(Int_Xferred), OutData%WaveMultiDir) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveDirArr not allocated - Int_Xferred = Int_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%WaveDirArr)) DEALLOCATE(OutData%WaveDirArr) - ALLOCATE(OutData%WaveDirArr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDirArr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WaveDirArr,1), UBOUND(OutData%WaveDirArr,1) - OutData%WaveDirArr(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%WaveDirMin = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WaveDirMax = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveTime not allocated - Int_Xferred = Int_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%WaveTime)) DEALLOCATE(OutData%WaveTime) - ALLOCATE(OutData%WaveTime(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveTime.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WaveTime,1), UBOUND(OutData%WaveTime,1) - OutData%WaveTime(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%WaveMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%MnDrift = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NewmanApp = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%DiffQTF = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%SumQTF = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%MnDriftF = TRANSFER(IntKiBuf(Int_Xferred), OutData%MnDriftF) - Int_Xferred = Int_Xferred + 1 - OutData%NewmanAppF = TRANSFER(IntKiBuf(Int_Xferred), OutData%NewmanAppF) - Int_Xferred = Int_Xferred + 1 - OutData%DiffQTFF = TRANSFER(IntKiBuf(Int_Xferred), OutData%DiffQTFF) - Int_Xferred = Int_Xferred + 1 - OutData%SumQTFF = TRANSFER(IntKiBuf(Int_Xferred), OutData%SumQTFF) - Int_Xferred = Int_Xferred + 1 - OutData%WvLowCOff = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%WvHiCOff = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%WvLowCOffD = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%WvHiCOffD = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%WvLowCOffS = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%WvHiCOffS = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE WAMIT2_UnPackInitInput - - SUBROUTINE WAMIT2_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(WAMIT2_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(WAMIT2_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 = 'WAMIT2_CopyInitOutput' -! +subroutine WAMIT2_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) + type(WAMIT2_InitInputType), intent(in) :: SrcInitInputData + type(WAMIT2_InitInputType), intent(inout) :: DstInitInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'WAMIT2_CopyInitInput' ErrStat = ErrID_None - ErrMsg = "" - DstInitOutputData%NULLVAL = SrcInitOutputData%NULLVAL - END SUBROUTINE WAMIT2_CopyInitOutput - - SUBROUTINE WAMIT2_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(WAMIT2_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT2_DestroyInitOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE WAMIT2_DestroyInitOutput - - SUBROUTINE WAMIT2_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(WAMIT2_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 = 'WAMIT2_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 ! NULLVAL - 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%NULLVAL - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE WAMIT2_PackInitOutput - - SUBROUTINE WAMIT2_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(WAMIT2_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 = 'WAMIT2_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%NULLVAL = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE WAMIT2_UnPackInitOutput - - SUBROUTINE WAMIT2_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(WAMIT2_ContinuousStateType), INTENT(IN) :: SrcContStateData - TYPE(WAMIT2_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 = 'WAMIT2_CopyContState' -! + ErrMsg = '' + DstInitInputData%HasWAMIT = SrcInitInputData%HasWAMIT + DstInitInputData%WAMITFile = SrcInitInputData%WAMITFile + DstInitInputData%NBody = SrcInitInputData%NBody + DstInitInputData%NBodyMod = SrcInitInputData%NBodyMod + if (allocated(SrcInitInputData%PtfmRefxt)) then + LB(1:1) = lbound(SrcInitInputData%PtfmRefxt) + UB(1:1) = ubound(SrcInitInputData%PtfmRefxt) + if (.not. allocated(DstInitInputData%PtfmRefxt)) then + allocate(DstInitInputData%PtfmRefxt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%PtfmRefxt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%PtfmRefxt = SrcInitInputData%PtfmRefxt + end if + if (allocated(SrcInitInputData%PtfmRefyt)) then + LB(1:1) = lbound(SrcInitInputData%PtfmRefyt) + UB(1:1) = ubound(SrcInitInputData%PtfmRefyt) + if (.not. allocated(DstInitInputData%PtfmRefyt)) then + allocate(DstInitInputData%PtfmRefyt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%PtfmRefyt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%PtfmRefyt = SrcInitInputData%PtfmRefyt + end if + if (allocated(SrcInitInputData%PtfmRefzt)) then + LB(1:1) = lbound(SrcInitInputData%PtfmRefzt) + UB(1:1) = ubound(SrcInitInputData%PtfmRefzt) + if (.not. allocated(DstInitInputData%PtfmRefzt)) then + allocate(DstInitInputData%PtfmRefzt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%PtfmRefzt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%PtfmRefzt = SrcInitInputData%PtfmRefzt + end if + if (allocated(SrcInitInputData%PtfmRefztRot)) then + LB(1:1) = lbound(SrcInitInputData%PtfmRefztRot) + UB(1:1) = ubound(SrcInitInputData%PtfmRefztRot) + if (.not. allocated(DstInitInputData%PtfmRefztRot)) then + allocate(DstInitInputData%PtfmRefztRot(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%PtfmRefztRot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%PtfmRefztRot = SrcInitInputData%PtfmRefztRot + end if + DstInitInputData%WAMITULEN = SrcInitInputData%WAMITULEN + DstInitInputData%Gravity = SrcInitInputData%Gravity + DstInitInputData%WaveField => SrcInitInputData%WaveField + DstInitInputData%PtfmYMod = SrcInitInputData%PtfmYMod + DstInitInputData%PtfmRefY = SrcInitInputData%PtfmRefY + DstInitInputData%NExctnHdg = SrcInitInputData%NExctnHdg + DstInitInputData%MnDrift = SrcInitInputData%MnDrift + DstInitInputData%NewmanApp = SrcInitInputData%NewmanApp + DstInitInputData%DiffQTF = SrcInitInputData%DiffQTF + DstInitInputData%SumQTF = SrcInitInputData%SumQTF + DstInitInputData%MnDriftF = SrcInitInputData%MnDriftF + DstInitInputData%NewmanAppF = SrcInitInputData%NewmanAppF + DstInitInputData%DiffQTFF = SrcInitInputData%DiffQTFF + DstInitInputData%SumQTFF = SrcInitInputData%SumQTFF +end subroutine + +subroutine WAMIT2_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(WAMIT2_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'WAMIT2_DestroyInitInput' ErrStat = ErrID_None - ErrMsg = "" - DstContStateData%DummyContState = SrcContStateData%DummyContState - END SUBROUTINE WAMIT2_CopyContState - - SUBROUTINE WAMIT2_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(WAMIT2_ContinuousStateType), INTENT(INOUT) :: ContStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT2_DestroyContState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE WAMIT2_DestroyContState - - SUBROUTINE WAMIT2_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(WAMIT2_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 = 'WAMIT2_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 WAMIT2_PackContState - - SUBROUTINE WAMIT2_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(WAMIT2_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 = 'WAMIT2_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 = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE WAMIT2_UnPackContState - - SUBROUTINE WAMIT2_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(WAMIT2_DiscreteStateType), INTENT(IN) :: SrcDiscStateData - TYPE(WAMIT2_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 = 'WAMIT2_CopyDiscState' -! + ErrMsg = '' + if (allocated(InitInputData%PtfmRefxt)) then + deallocate(InitInputData%PtfmRefxt) + end if + if (allocated(InitInputData%PtfmRefyt)) then + deallocate(InitInputData%PtfmRefyt) + end if + if (allocated(InitInputData%PtfmRefzt)) then + deallocate(InitInputData%PtfmRefzt) + end if + if (allocated(InitInputData%PtfmRefztRot)) then + deallocate(InitInputData%PtfmRefztRot) + end if + nullify(InitInputData%WaveField) +end subroutine + +subroutine WAMIT2_PackInitInput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(WAMIT2_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'WAMIT2_PackInitInput' + logical :: PtrInIndex + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%HasWAMIT) + call RegPack(RF, InData%WAMITFile) + call RegPack(RF, InData%NBody) + call RegPack(RF, InData%NBodyMod) + call RegPackAlloc(RF, InData%PtfmRefxt) + call RegPackAlloc(RF, InData%PtfmRefyt) + call RegPackAlloc(RF, InData%PtfmRefzt) + call RegPackAlloc(RF, InData%PtfmRefztRot) + call RegPack(RF, InData%WAMITULEN) + call RegPack(RF, InData%Gravity) + call RegPack(RF, associated(InData%WaveField)) + if (associated(InData%WaveField)) then + call RegPackPointer(RF, c_loc(InData%WaveField), PtrInIndex) + if (.not. PtrInIndex) then + call SeaSt_WaveField_PackSeaSt_WaveFieldType(RF, InData%WaveField) + end if + end if + call RegPack(RF, InData%PtfmYMod) + call RegPack(RF, InData%PtfmRefY) + call RegPack(RF, InData%NExctnHdg) + call RegPack(RF, InData%MnDrift) + call RegPack(RF, InData%NewmanApp) + call RegPack(RF, InData%DiffQTF) + call RegPack(RF, InData%SumQTF) + call RegPack(RF, InData%MnDriftF) + call RegPack(RF, InData%NewmanAppF) + call RegPack(RF, InData%DiffQTFF) + call RegPack(RF, InData%SumQTFF) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine WAMIT2_UnPackInitInput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(WAMIT2_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'WAMIT2_UnPackInitInput' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(B8Ki) :: PtrIdx + type(c_ptr) :: Ptr + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%HasWAMIT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WAMITFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NBody); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NBodyMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PtfmRefxt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PtfmRefyt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PtfmRefzt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PtfmRefztRot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WAMITULEN); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Gravity); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%WaveField)) deallocate(OutData%WaveField) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackPointer(RF, Ptr, PtrIdx); if (RegCheckErr(RF, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveField) + else + allocate(OutData%WaveField,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveField.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + RF%Pointers(PtrIdx) = c_loc(OutData%WaveField) + call SeaSt_WaveField_UnpackSeaSt_WaveFieldType(RF, OutData%WaveField) ! WaveField + end if + else + OutData%WaveField => null() + end if + call RegUnpack(RF, OutData%PtfmYMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PtfmRefY); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NExctnHdg); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MnDrift); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NewmanApp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DiffQTF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SumQTF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MnDriftF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NewmanAppF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DiffQTFF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SumQTFF); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine WAMIT2_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(WAMIT2_MiscVarType), intent(in) :: SrcMiscData + type(WAMIT2_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'WAMIT2_CopyMisc' ErrStat = ErrID_None - ErrMsg = "" - DstDiscStateData%DummyDiscState = SrcDiscStateData%DummyDiscState - END SUBROUTINE WAMIT2_CopyDiscState - - SUBROUTINE WAMIT2_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(WAMIT2_DiscreteStateType), INTENT(INOUT) :: DiscStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT2_DestroyDiscState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE WAMIT2_DestroyDiscState - - SUBROUTINE WAMIT2_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(WAMIT2_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 = 'WAMIT2_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 WAMIT2_PackDiscState - - SUBROUTINE WAMIT2_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(WAMIT2_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 = 'WAMIT2_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 = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE WAMIT2_UnPackDiscState - - SUBROUTINE WAMIT2_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(WAMIT2_ConstraintStateType), INTENT(IN) :: SrcConstrStateData - TYPE(WAMIT2_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 = 'WAMIT2_CopyConstrState' -! + ErrMsg = '' + if (allocated(SrcMiscData%LastIndWave)) then + LB(1:1) = lbound(SrcMiscData%LastIndWave) + UB(1:1) = ubound(SrcMiscData%LastIndWave) + if (.not. allocated(DstMiscData%LastIndWave)) then + allocate(DstMiscData%LastIndWave(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%LastIndWave.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%LastIndWave = SrcMiscData%LastIndWave + end if + if (allocated(SrcMiscData%F_Waves2)) then + LB(1:1) = lbound(SrcMiscData%F_Waves2) + UB(1:1) = ubound(SrcMiscData%F_Waves2) + if (.not. allocated(DstMiscData%F_Waves2)) then + allocate(DstMiscData%F_Waves2(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_Waves2.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%F_Waves2 = SrcMiscData%F_Waves2 + end if + call SeaSt_WaveField_CopyMisc(SrcMiscData%WaveField_m, DstMiscData%WaveField_m, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine WAMIT2_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(WAMIT2_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'WAMIT2_DestroyMisc' ErrStat = ErrID_None - ErrMsg = "" - DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState - END SUBROUTINE WAMIT2_CopyConstrState - - SUBROUTINE WAMIT2_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(WAMIT2_ConstraintStateType), INTENT(INOUT) :: ConstrStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT2_DestroyConstrState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE WAMIT2_DestroyConstrState - - SUBROUTINE WAMIT2_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(WAMIT2_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 = 'WAMIT2_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 WAMIT2_PackConstrState - - SUBROUTINE WAMIT2_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(WAMIT2_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 = 'WAMIT2_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 = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE WAMIT2_UnPackConstrState - - SUBROUTINE WAMIT2_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(WAMIT2_OtherStateType), INTENT(IN) :: SrcOtherStateData - TYPE(WAMIT2_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 = 'WAMIT2_CopyOtherState' -! + ErrMsg = '' + if (allocated(MiscData%LastIndWave)) then + deallocate(MiscData%LastIndWave) + end if + if (allocated(MiscData%F_Waves2)) then + deallocate(MiscData%F_Waves2) + end if + call SeaSt_WaveField_DestroyMisc(MiscData%WaveField_m, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine WAMIT2_PackMisc(RF, Indata) + type(RegFile), intent(inout) :: RF + type(WAMIT2_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'WAMIT2_PackMisc' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%LastIndWave) + call RegPackAlloc(RF, InData%F_Waves2) + call SeaSt_WaveField_PackMisc(RF, InData%WaveField_m) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine WAMIT2_UnPackMisc(RF, OutData) + type(RegFile), intent(inout) :: RF + type(WAMIT2_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'WAMIT2_UnPackMisc' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%LastIndWave); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%F_Waves2); if (RegCheckErr(RF, RoutineName)) return + call SeaSt_WaveField_UnpackMisc(RF, OutData%WaveField_m) ! WaveField_m +end subroutine + +subroutine WAMIT2_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(WAMIT2_ParameterType), intent(in) :: SrcParamData + type(WAMIT2_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(5), UB(5) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'WAMIT2_CopyParam' ErrStat = ErrID_None - ErrMsg = "" - DstOtherStateData%DummyOtherState = SrcOtherStateData%DummyOtherState - END SUBROUTINE WAMIT2_CopyOtherState - - SUBROUTINE WAMIT2_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(WAMIT2_OtherStateType), INTENT(INOUT) :: OtherStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT2_DestroyOtherState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE WAMIT2_DestroyOtherState - - SUBROUTINE WAMIT2_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(WAMIT2_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 = 'WAMIT2_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) = InData%DummyOtherState - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE WAMIT2_PackOtherState - - SUBROUTINE WAMIT2_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(WAMIT2_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 = 'WAMIT2_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 WAMIT2_UnPackOtherState - - SUBROUTINE WAMIT2_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(WAMIT2_MiscVarType), INTENT(IN) :: SrcMiscData - TYPE(WAMIT2_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 = 'WAMIT2_CopyMisc' -! + ErrMsg = '' + DstParamData%NBody = SrcParamData%NBody + DstParamData%NBodyMod = SrcParamData%NBodyMod + if (allocated(SrcParamData%WaveExctn2Grid)) then + LB(1:5) = lbound(SrcParamData%WaveExctn2Grid) + UB(1:5) = ubound(SrcParamData%WaveExctn2Grid) + if (.not. allocated(DstParamData%WaveExctn2Grid)) then + allocate(DstParamData%WaveExctn2Grid(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WaveExctn2Grid.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%WaveExctn2Grid = SrcParamData%WaveExctn2Grid + end if + call SeaSt_WaveField_CopyParam(SrcParamData%Exctn2GridParams, DstParamData%Exctn2GridParams, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstParamData%MnDriftDims = SrcParamData%MnDriftDims + DstParamData%NewmanAppDims = SrcParamData%NewmanAppDims + DstParamData%DiffQTFDims = SrcParamData%DiffQTFDims + DstParamData%SumQTFDims = SrcParamData%SumQTFDims + DstParamData%MnDriftF = SrcParamData%MnDriftF + DstParamData%NewmanAppF = SrcParamData%NewmanAppF + DstParamData%DiffQTFF = SrcParamData%DiffQTFF + DstParamData%SumQTFF = SrcParamData%SumQTFF + DstParamData%PtfmYMod = SrcParamData%PtfmYMod + DstParamData%NExctnHdg = SrcParamData%NExctnHdg +end subroutine + +subroutine WAMIT2_DestroyParam(ParamData, ErrStat, ErrMsg) + type(WAMIT2_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'WAMIT2_DestroyParam' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcMiscData%LastIndWave)) THEN - i1_l = LBOUND(SrcMiscData%LastIndWave,1) - i1_u = UBOUND(SrcMiscData%LastIndWave,1) - IF (.NOT. ALLOCATED(DstMiscData%LastIndWave)) THEN - ALLOCATE(DstMiscData%LastIndWave(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%LastIndWave.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%LastIndWave = SrcMiscData%LastIndWave -ENDIF -IF (ALLOCATED(SrcMiscData%F_Waves2)) THEN - i1_l = LBOUND(SrcMiscData%F_Waves2,1) - i1_u = UBOUND(SrcMiscData%F_Waves2,1) - IF (.NOT. ALLOCATED(DstMiscData%F_Waves2)) THEN - ALLOCATE(DstMiscData%F_Waves2(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_Waves2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%F_Waves2 = SrcMiscData%F_Waves2 -ENDIF - END SUBROUTINE WAMIT2_CopyMisc - - SUBROUTINE WAMIT2_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(WAMIT2_MiscVarType), INTENT(INOUT) :: MiscData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT2_DestroyMisc' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(MiscData%LastIndWave)) THEN - DEALLOCATE(MiscData%LastIndWave) -ENDIF -IF (ALLOCATED(MiscData%F_Waves2)) THEN - DEALLOCATE(MiscData%F_Waves2) -ENDIF - END SUBROUTINE WAMIT2_DestroyMisc - - SUBROUTINE WAMIT2_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(WAMIT2_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 = 'WAMIT2_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 ! LastIndWave allocated yes/no - IF ( ALLOCATED(InData%LastIndWave) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LastIndWave upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%LastIndWave) ! LastIndWave - END IF - Int_BufSz = Int_BufSz + 1 ! F_Waves2 allocated yes/no - IF ( ALLOCATED(InData%F_Waves2) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! F_Waves2 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_Waves2) ! F_Waves2 - 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%LastIndWave) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LastIndWave,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LastIndWave,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LastIndWave,1), UBOUND(InData%LastIndWave,1) - IntKiBuf(Int_Xferred) = InData%LastIndWave(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%F_Waves2) ) THEN - 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_Waves2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_Waves2,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%F_Waves2,1), UBOUND(InData%F_Waves2,1) - ReKiBuf(Re_Xferred) = InData%F_Waves2(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE WAMIT2_PackMisc - - SUBROUTINE WAMIT2_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(WAMIT2_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 = 'WAMIT2_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 ! LastIndWave not allocated - Int_Xferred = Int_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%LastIndWave)) DEALLOCATE(OutData%LastIndWave) - ALLOCATE(OutData%LastIndWave(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LastIndWave.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LastIndWave,1), UBOUND(OutData%LastIndWave,1) - OutData%LastIndWave(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_Waves2 not allocated - Int_Xferred = Int_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_Waves2)) DEALLOCATE(OutData%F_Waves2) - ALLOCATE(OutData%F_Waves2(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_Waves2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%F_Waves2,1), UBOUND(OutData%F_Waves2,1) - OutData%F_Waves2(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE WAMIT2_UnPackMisc - - SUBROUTINE WAMIT2_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(WAMIT2_ParameterType), INTENT(IN) :: SrcParamData - TYPE(WAMIT2_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 = 'WAMIT2_CopyParam' -! + ErrMsg = '' + if (allocated(ParamData%WaveExctn2Grid)) then + deallocate(ParamData%WaveExctn2Grid) + end if + call SeaSt_WaveField_DestroyParam(ParamData%Exctn2GridParams, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine WAMIT2_PackParam(RF, Indata) + type(RegFile), intent(inout) :: RF + type(WAMIT2_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'WAMIT2_PackParam' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%NBody) + call RegPack(RF, InData%NBodyMod) + call RegPackAlloc(RF, InData%WaveExctn2Grid) + call SeaSt_WaveField_PackParam(RF, InData%Exctn2GridParams) + call RegPack(RF, InData%MnDriftDims) + call RegPack(RF, InData%NewmanAppDims) + call RegPack(RF, InData%DiffQTFDims) + call RegPack(RF, InData%SumQTFDims) + call RegPack(RF, InData%MnDriftF) + call RegPack(RF, InData%NewmanAppF) + call RegPack(RF, InData%DiffQTFF) + call RegPack(RF, InData%SumQTFF) + call RegPack(RF, InData%PtfmYMod) + call RegPack(RF, InData%NExctnHdg) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine WAMIT2_UnPackParam(RF, OutData) + type(RegFile), intent(inout) :: RF + type(WAMIT2_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'WAMIT2_UnPackParam' + integer(B4Ki) :: LB(5), UB(5) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%NBody); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NBodyMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WaveExctn2Grid); if (RegCheckErr(RF, RoutineName)) return + call SeaSt_WaveField_UnpackParam(RF, OutData%Exctn2GridParams) ! Exctn2GridParams + call RegUnpack(RF, OutData%MnDriftDims); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NewmanAppDims); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DiffQTFDims); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SumQTFDims); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MnDriftF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NewmanAppF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DiffQTFF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SumQTFF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PtfmYMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NExctnHdg); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine WAMIT2_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(WAMIT2_OutputType), intent(inout) :: SrcOutputData + type(WAMIT2_OutputType), intent(inout) :: DstOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'WAMIT2_CopyOutput' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcParamData%WaveTime)) THEN - i1_l = LBOUND(SrcParamData%WaveTime,1) - i1_u = UBOUND(SrcParamData%WaveTime,1) - IF (.NOT. ALLOCATED(DstParamData%WaveTime)) THEN - ALLOCATE(DstParamData%WaveTime(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WaveTime.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%WaveTime = SrcParamData%WaveTime -ENDIF - DstParamData%NStepWave = SrcParamData%NStepWave - DstParamData%DT = SrcParamData%DT - DstParamData%NBody = SrcParamData%NBody - DstParamData%NBodyMod = SrcParamData%NBodyMod -IF (ALLOCATED(SrcParamData%WaveExctn2)) THEN - i1_l = LBOUND(SrcParamData%WaveExctn2,1) - i1_u = UBOUND(SrcParamData%WaveExctn2,1) - i2_l = LBOUND(SrcParamData%WaveExctn2,2) - i2_u = UBOUND(SrcParamData%WaveExctn2,2) - IF (.NOT. ALLOCATED(DstParamData%WaveExctn2)) THEN - ALLOCATE(DstParamData%WaveExctn2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WaveExctn2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%WaveExctn2 = SrcParamData%WaveExctn2 -ENDIF - DstParamData%MnDriftDims = SrcParamData%MnDriftDims - DstParamData%NewmanAppDims = SrcParamData%NewmanAppDims - DstParamData%DiffQTFDims = SrcParamData%DiffQTFDims - DstParamData%SumQTFDims = SrcParamData%SumQTFDims - DstParamData%MnDriftF = SrcParamData%MnDriftF - DstParamData%NewmanAppF = SrcParamData%NewmanAppF - DstParamData%DiffQTFF = SrcParamData%DiffQTFF - DstParamData%SumQTFF = SrcParamData%SumQTFF -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%NumOuts = SrcParamData%NumOuts - DstParamData%NumOutAll = SrcParamData%NumOutAll - DstParamData%OutFmt = SrcParamData%OutFmt - DstParamData%OutSFmt = SrcParamData%OutSFmt - DstParamData%Delim = SrcParamData%Delim - DstParamData%UnOutFile = SrcParamData%UnOutFile - END SUBROUTINE WAMIT2_CopyParam - - SUBROUTINE WAMIT2_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(WAMIT2_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT2_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(ParamData%WaveTime)) THEN - DEALLOCATE(ParamData%WaveTime) -ENDIF -IF (ALLOCATED(ParamData%WaveExctn2)) THEN - DEALLOCATE(ParamData%WaveExctn2) -ENDIF -IF (ALLOCATED(ParamData%OutParam)) THEN -DO i1 = LBOUND(ParamData%OutParam,1), UBOUND(ParamData%OutParam,1) - CALL NWTC_Library_Destroyoutparmtype( ParamData%OutParam(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ParamData%OutParam) -ENDIF - END SUBROUTINE WAMIT2_DestroyParam - - SUBROUTINE WAMIT2_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(WAMIT2_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 = 'WAMIT2_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 ! WaveTime allocated yes/no - IF ( ALLOCATED(InData%WaveTime) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WaveTime upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveTime) ! WaveTime - END IF - Int_BufSz = Int_BufSz + 1 ! NStepWave - Db_BufSz = Db_BufSz + 1 ! DT - Int_BufSz = Int_BufSz + 1 ! NBody - Int_BufSz = Int_BufSz + 1 ! NBodyMod - Int_BufSz = Int_BufSz + 1 ! WaveExctn2 allocated yes/no - IF ( ALLOCATED(InData%WaveExctn2) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! WaveExctn2 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveExctn2) ! WaveExctn2 - END IF - Int_BufSz = Int_BufSz + SIZE(InData%MnDriftDims) ! MnDriftDims - Int_BufSz = Int_BufSz + SIZE(InData%NewmanAppDims) ! NewmanAppDims - Int_BufSz = Int_BufSz + SIZE(InData%DiffQTFDims) ! DiffQTFDims - Int_BufSz = Int_BufSz + SIZE(InData%SumQTFDims) ! SumQTFDims - Int_BufSz = Int_BufSz + 1 ! MnDriftF - Int_BufSz = Int_BufSz + 1 ! NewmanAppF - Int_BufSz = Int_BufSz + 1 ! DiffQTFF - Int_BufSz = Int_BufSz + 1 ! SumQTFF - 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 ! NumOuts - Int_BufSz = Int_BufSz + 1 ! NumOutAll - Int_BufSz = Int_BufSz + 1*LEN(InData%OutFmt) ! OutFmt - Int_BufSz = Int_BufSz + 1*LEN(InData%OutSFmt) ! OutSFmt - Int_BufSz = Int_BufSz + 1*LEN(InData%Delim) ! Delim - Int_BufSz = Int_BufSz + 1 ! UnOutFile - 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%WaveTime) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveTime,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveTime,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WaveTime,1), UBOUND(InData%WaveTime,1) - ReKiBuf(Re_Xferred) = InData%WaveTime(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NStepWave - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%DT - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NBody - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NBodyMod - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%WaveExctn2) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveExctn2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveExctn2,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveExctn2,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveExctn2,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%WaveExctn2,2), UBOUND(InData%WaveExctn2,2) - DO i1 = LBOUND(InData%WaveExctn2,1), UBOUND(InData%WaveExctn2,1) - ReKiBuf(Re_Xferred) = InData%WaveExctn2(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - DO i1 = LBOUND(InData%MnDriftDims,1), UBOUND(InData%MnDriftDims,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%MnDriftDims(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - DO i1 = LBOUND(InData%NewmanAppDims,1), UBOUND(InData%NewmanAppDims,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%NewmanAppDims(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - DO i1 = LBOUND(InData%DiffQTFDims,1), UBOUND(InData%DiffQTFDims,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%DiffQTFDims(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - DO i1 = LBOUND(InData%SumQTFDims,1), UBOUND(InData%SumQTFDims,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%SumQTFDims(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = TRANSFER(InData%MnDriftF, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%NewmanAppF, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%DiffQTFF, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%SumQTFF, IntKiBuf(1)) - 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 - IntKiBuf(Int_Xferred) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumOutAll - 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 - DO I = 1, LEN(InData%OutSFmt) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutSFmt(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - 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) = InData%UnOutFile - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE WAMIT2_PackParam - - SUBROUTINE WAMIT2_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(WAMIT2_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 = 'WAMIT2_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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveTime not allocated - Int_Xferred = Int_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%WaveTime)) DEALLOCATE(OutData%WaveTime) - ALLOCATE(OutData%WaveTime(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveTime.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WaveTime,1), UBOUND(OutData%WaveTime,1) - OutData%WaveTime(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%NStepWave = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%DT = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%NBody = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NBodyMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveExctn2 not allocated - Int_Xferred = Int_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%WaveExctn2)) DEALLOCATE(OutData%WaveExctn2) - ALLOCATE(OutData%WaveExctn2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveExctn2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%WaveExctn2,2), UBOUND(OutData%WaveExctn2,2) - DO i1 = LBOUND(OutData%WaveExctn2,1), UBOUND(OutData%WaveExctn2,1) - OutData%WaveExctn2(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - i1_l = LBOUND(OutData%MnDriftDims,1) - i1_u = UBOUND(OutData%MnDriftDims,1) - DO i1 = LBOUND(OutData%MnDriftDims,1), UBOUND(OutData%MnDriftDims,1) - OutData%MnDriftDims(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%MnDriftDims(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - i1_l = LBOUND(OutData%NewmanAppDims,1) - i1_u = UBOUND(OutData%NewmanAppDims,1) - DO i1 = LBOUND(OutData%NewmanAppDims,1), UBOUND(OutData%NewmanAppDims,1) - OutData%NewmanAppDims(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%NewmanAppDims(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - i1_l = LBOUND(OutData%DiffQTFDims,1) - i1_u = UBOUND(OutData%DiffQTFDims,1) - DO i1 = LBOUND(OutData%DiffQTFDims,1), UBOUND(OutData%DiffQTFDims,1) - OutData%DiffQTFDims(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%DiffQTFDims(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - i1_l = LBOUND(OutData%SumQTFDims,1) - i1_u = UBOUND(OutData%SumQTFDims,1) - DO i1 = LBOUND(OutData%SumQTFDims,1), UBOUND(OutData%SumQTFDims,1) - OutData%SumQTFDims(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%SumQTFDims(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - OutData%MnDriftF = TRANSFER(IntKiBuf(Int_Xferred), OutData%MnDriftF) - Int_Xferred = Int_Xferred + 1 - OutData%NewmanAppF = TRANSFER(IntKiBuf(Int_Xferred), OutData%NewmanAppF) - Int_Xferred = Int_Xferred + 1 - OutData%DiffQTFF = TRANSFER(IntKiBuf(Int_Xferred), OutData%DiffQTFF) - Int_Xferred = Int_Xferred + 1 - OutData%SumQTFF = TRANSFER(IntKiBuf(Int_Xferred), OutData%SumQTFF) - 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 - OutData%NumOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumOutAll = IntKiBuf(Int_Xferred) - 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 - DO I = 1, LEN(OutData%OutSFmt) - OutData%OutSFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%Delim) - OutData%Delim(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%UnOutFile = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE WAMIT2_UnPackParam - - SUBROUTINE WAMIT2_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(WAMIT2_InputType), INTENT(INOUT) :: SrcInputData - TYPE(WAMIT2_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 = 'WAMIT2_CopyInput' -! - ErrStat = ErrID_None - ErrMsg = "" - CALL MeshCopy( SrcInputData%Mesh, DstInputData%Mesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE WAMIT2_CopyInput - - SUBROUTINE WAMIT2_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(WAMIT2_InputType), INTENT(INOUT) :: InputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT2_DestroyInput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL MeshDestroy( InputData%Mesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE WAMIT2_DestroyInput - - SUBROUTINE WAMIT2_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(WAMIT2_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 = 'WAMIT2_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 ! Mesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%Mesh, 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 - 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%Mesh, 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 SUBROUTINE WAMIT2_PackInput - - SUBROUTINE WAMIT2_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(WAMIT2_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 = 'WAMIT2_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%Mesh, 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 SUBROUTINE WAMIT2_UnPackInput - - SUBROUTINE WAMIT2_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(WAMIT2_OutputType), INTENT(INOUT) :: SrcOutputData - TYPE(WAMIT2_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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT2_CopyOutput' -! + ErrMsg = '' + call MeshCopy(SrcOutputData%Mesh, DstOutputData%Mesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine WAMIT2_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(WAMIT2_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'WAMIT2_DestroyOutput' ErrStat = ErrID_None - ErrMsg = "" - CALL MeshCopy( SrcOutputData%Mesh, DstOutputData%Mesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE WAMIT2_CopyOutput - - SUBROUTINE WAMIT2_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(WAMIT2_OutputType), INTENT(INOUT) :: OutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT2_DestroyOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL MeshDestroy( OutputData%Mesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE WAMIT2_DestroyOutput - - SUBROUTINE WAMIT2_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(WAMIT2_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 = 'WAMIT2_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 ! Mesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%Mesh, 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 - 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%Mesh, 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 SUBROUTINE WAMIT2_PackOutput - - SUBROUTINE WAMIT2_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(WAMIT2_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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT2_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%Mesh, 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 SUBROUTINE WAMIT2_UnPackOutput - - - SUBROUTINE WAMIT2_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(WAMIT2_InputType), INTENT(INOUT) :: u(:) ! Input at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Inputs - TYPE(WAMIT2_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 = 'WAMIT2_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 WAMIT2_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL WAMIT2_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 WAMIT2_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 WAMIT2_Input_ExtrapInterp - - - SUBROUTINE WAMIT2_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(WAMIT2_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 - TYPE(WAMIT2_InputType), INTENT(INOUT) :: u2 ! Input at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs - TYPE(WAMIT2_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 + ErrMsg = '' + call MeshDestroy( OutputData%Mesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine WAMIT2_PackOutput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(WAMIT2_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'WAMIT2_PackOutput' + if (RF%ErrStat >= AbortErrLev) return + call MeshPack(RF, InData%Mesh) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine WAMIT2_UnPackOutput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(WAMIT2_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'WAMIT2_UnPackOutput' + if (RF%ErrStat /= ErrID_None) return + call MeshUnpack(RF, OutData%Mesh) ! Mesh +end subroutine + +subroutine WAMIT2_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(WAMIT2_OutputType), intent(inout) :: y(:) ! Output at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Outputs + type(WAMIT2_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 - REAL(DbKi) :: t(2) ! Times associated with the Inputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT2_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%Mesh, u2%Mesh, tin, u_out%Mesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - END SUBROUTINE WAMIT2_Input_ExtrapInterp1 - - - SUBROUTINE WAMIT2_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(WAMIT2_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 > t3 - TYPE(WAMIT2_InputType), INTENT(INOUT) :: u2 ! Input at t2 > t3 - TYPE(WAMIT2_InputType), INTENT(INOUT) :: u3 ! Input at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs - TYPE(WAMIT2_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 = 'WAMIT2_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%Mesh, u2%Mesh, u3%Mesh, tin, u_out%Mesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - END SUBROUTINE WAMIT2_Input_ExtrapInterp2 - - - SUBROUTINE WAMIT2_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(WAMIT2_OutputType), INTENT(INOUT) :: y(:) ! Output at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Outputs - TYPE(WAMIT2_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 = 'WAMIT2_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 WAMIT2_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL WAMIT2_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 WAMIT2_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 WAMIT2_Output_ExtrapInterp - - - SUBROUTINE WAMIT2_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'WAMIT2_Output_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(y)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(y)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(y) - 1 + select case (order) + case (0) + call WAMIT2_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call WAMIT2_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call WAMIT2_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(y) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE WAMIT2_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. @@ -2985,41 +582,42 @@ SUBROUTINE WAMIT2_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, Err ! !.................................................................................................................................. - TYPE(WAMIT2_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 - TYPE(WAMIT2_OutputType), INTENT(INOUT) :: y2 ! Output at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs - TYPE(WAMIT2_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 + TYPE(WAMIT2_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 + TYPE(WAMIT2_OutputType), INTENT(INOUT) :: y2 ! Output at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs + TYPE(WAMIT2_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 = 'WAMIT2_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 - ! 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 + REAL(DbKi) :: t(2) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT2_Output_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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 + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + CALL MeshExtrapInterp1(y1%Mesh, y2%Mesh, tin, y_out%Mesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) +END SUBROUTINE - ScaleFactor = t_out / t(2) - CALL MeshExtrapInterp1(y1%Mesh, y2%Mesh, tin, y_out%Mesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - END SUBROUTINE WAMIT2_Output_ExtrapInterp1 - - - SUBROUTINE WAMIT2_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) +SUBROUTINE WAMIT2_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. @@ -3033,47 +631,47 @@ SUBROUTINE WAMIT2_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ! !.................................................................................................................................. - TYPE(WAMIT2_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 > t3 - TYPE(WAMIT2_OutputType), INTENT(INOUT) :: y2 ! Output at t2 > t3 - TYPE(WAMIT2_OutputType), INTENT(INOUT) :: y3 ! Output at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs - TYPE(WAMIT2_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 + TYPE(WAMIT2_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 > t3 + TYPE(WAMIT2_OutputType), INTENT(INOUT) :: y2 ! Output at t2 > t3 + TYPE(WAMIT2_OutputType), INTENT(INOUT) :: y3 ! Output at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs + TYPE(WAMIT2_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 = 'WAMIT2_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) - + 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) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT2_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 + 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 + 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 + 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%Mesh, y2%Mesh, y3%Mesh, tin, y_out%Mesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - END SUBROUTINE WAMIT2_Output_ExtrapInterp2 - + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + CALL MeshExtrapInterp2(y1%Mesh, y2%Mesh, y3%Mesh, tin, y_out%Mesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) +END SUBROUTINE END MODULE WAMIT2_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/hydrodyn/src/WAMIT_Interp.f90 b/modules/hydrodyn/src/WAMIT_Interp.f90 index 7e7ce8cfaa..90a95e3432 100644 --- a/modules/hydrodyn/src/WAMIT_Interp.f90 +++ b/modules/hydrodyn/src/WAMIT_Interp.f90 @@ -29,6 +29,8 @@ MODULE WAMIT_Interp USE NWTC_Library + use SeaSt_WaveField_Types, only: SeaSt_WaveField_ParameterType, SeaSt_WaveField_MiscVarType + use SeaSt_WaveField, only: WaveField_Interp_Setup3D, WaveField_Interp_Setup4D IMPLICIT NONE PRIVATE @@ -37,8 +39,16 @@ MODULE WAMIT_Interp PUBLIC :: WAMIT_Interp2D_Cplx PUBLIC :: WAMIT_Interp3D_Cplx PUBLIC :: WAMIT_Interp4D_Cplx + public :: WAMIT_ForceWaves_Interp + + ! 3D and 4D interpolations using WaveField indexing + interface WAMIT_ForceWaves_Interp + module procedure WAMIT_ForceWaves_Interp_3D_vec6 + module procedure WAMIT_ForceWaves_Interp_4D_vec6 + end interface + CONTAINS !---------------------------------------------------------------------------------------------------------------------------------- @@ -48,7 +58,7 @@ MODULE WAMIT_Interp !! 1. It is complex valued. The values represent the second order wave force as calculated by WAMIT. !! 2. The dimenions of DataSet2D are Frequency1 (positive valued) and Wave Direction (degrees). !! 3. The wave direction requested might be between end points of wave direction dimension (ie. at 179 degrees when -!! WvDir1(1)=175, WvDir(Dims(3))=-175) +!! WvDir1(1)=175, WvDir(Dims(3))=-175) <- This is no longer the case. See comment below. !! 4. The arrays WvFreq1 and WvDir1 will give the values for each dimension that correspond to each index of DataSet2D. !! 5. The data is not necessarily equally spaced in any direction: ie. WvFreq1 may not have uniform spacing between points. !! 6. If a point is requested, it can be assumed that it lies within DataSet2D (this is checked before calling this subroutine) @@ -73,6 +83,7 @@ SUBROUTINE WAMIT_Interp2D_Cplx( InCoord, DataSet2D, WvFreq1, WvDir1, LastIndex, ! Local variables REAL(SiKi) :: Coords(2) !< coordinates with wave directions converted to range [-180, 180) + INTEGER(IntKi) :: i !< generic counter INTEGER(IntKi) :: n(2) !< number of points in WvFreq1 and WvDir1, and WvDir2 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)) @@ -96,10 +107,14 @@ SUBROUTINE WAMIT_Interp2D_Cplx( InCoord, DataSet2D, WvFreq1, WvDir1, LastIndex, ! find the indices into the arrays representing coordinates of each dimension: Coords = InCoord - - ! make sure these requested degrees fall in the range -180 <= Coords(2) < 180 - Coords(2) = MODULO( Coords(2), 360.0_SiKi ) - IF ( Coords(2) >= 180.0_SiKi ) Coords(2) = Coords(2) - 360.0_SiKi + + ! The periodic "looping" behavior of the wave direction interpolation has been commented out due to the potential for large error without warning. + ! With the WAMIT2 module updated to handle ranges of input wave directions crossing +/-180 deg, it is now the responsibility of the calling code + ! to make sure the wave heading interpolation point is strictly in range. + + ! ! make sure these requested degrees fall in the range -180 <= Coords(2) < 180 + ! Coords(2) = MODULO( Coords(2), 360.0_SiKi ) + ! IF ( Coords(2) >= 180.0_SiKi ) Coords(2) = Coords(2) - 360.0_SiKi CALL LocateStp( Coords(1), WvFreq1, LastIndex(1), n(1) ) CALL LocateStp( Coords(2), WvDir1, LastIndex(2), n(2) ) @@ -108,23 +123,24 @@ SUBROUTINE WAMIT_Interp2D_Cplx( InCoord, DataSet2D, WvFreq1, WvDir1, LastIndex, ! WvFreq1 (indx 1) - IF (Indx_Lo(1) == 0) THEN - Indx_Lo(1) = 1 - ELSEIF (Indx_Lo(1) == n(1) ) THEN - Indx_Lo(1) = max( n(1) - 1, 1 ) ! make sure it's a valid index - END IF - Indx_Hi(1) = min( Indx_Lo(1) + 1 , n(1) ) ! make sure it's a valid index - - - ! WvDir1 (indx 2) [use modular arithmetic] - IF (Indx_Lo(2) == 0) THEN - Indx_Hi(2) = 1 - Indx_Lo(2) = n(2) - ELSEIF (Indx_Lo(2) == n(2) ) THEN - Indx_Hi(2) = 1 - ELSE - Indx_Hi(2) = min( Indx_Lo(2) + 1, n(2) ) ! make sure it's a valid index - END IF + DO i = 1,2 + IF (Indx_Lo(i) == 0) THEN + Indx_Lo(i) = 1 + ELSEIF (Indx_Lo(i) == n(i) ) THEN + Indx_Lo(i) = max( n(i) - 1, 1 ) ! make sure it's a valid index + END IF + Indx_Hi(i) = min( Indx_Lo(i) + 1 , n(i) ) ! make sure it's a valid index + END DO + + ! ! WvDir1 (indx 2) [use modular arithmetic] + ! IF (Indx_Lo(2) == 0) THEN + ! Indx_Hi(2) = 1 + ! Indx_Lo(2) = n(2) + ! ELSEIF (Indx_Lo(2) == n(2) ) THEN + ! Indx_Hi(2) = 1 + ! ELSE + ! Indx_Hi(2) = min( Indx_Lo(2) + 1, n(2) ) ! make sure it's a valid index + ! END IF ! calculate the positions of all dimensions: @@ -135,14 +151,14 @@ SUBROUTINE WAMIT_Interp2D_Cplx( InCoord, DataSet2D, WvFreq1, WvDir1, LastIndex, pos_Hi(2) = WvDir1(Indx_Hi(2)) - ! angles have to be adjusted so that pos_Lo(2) <= Coords(2) <= pos_Hi(2) - IF ( Indx_Hi(2) == 1 .AND. n(2) > 1 ) THEN ! we're looping around the array [periodic] - IF ( pos_Lo(2) < Coords(2) ) THEN - pos_Hi(2) = pos_Hi(2) + 360.0_SiKi - ELSEIF ( pos_Lo(2) /= Coords(2) ) THEN !bjj: I think it's okay if we don't use equalRealNos here - pos_Lo(2) = pos_Lo(2) - 360.0_SiKi - END IF - END IF + ! ! angles have to be adjusted so that pos_Lo(2) <= Coords(2) <= pos_Hi(2) + ! IF ( Indx_Hi(2) == 1 .AND. n(2) > 1 ) THEN ! we're looping around the array [periodic] + ! IF ( pos_Lo(2) < Coords(2) ) THEN + ! pos_Hi(2) = pos_Hi(2) + 360.0_SiKi + ! ELSEIF ( pos_Lo(2) /= Coords(2) ) THEN !bjj: I think it's okay if we don't use equalRealNos here + ! pos_Lo(2) = pos_Lo(2) - 360.0_SiKi + ! END IF + ! END IF CALL Interp2D_withIndx_Cplx( Coords, DataSet2D, Indx_Lo, Indx_Hi, pos_Lo, pos_Hi, OutForce ) @@ -159,7 +175,7 @@ END SUBROUTINE WAMIT_Interp2D_Cplx !! 1. It is complex valued. The values represent the second order wave force as calculated by WAMIT. !! 2. The dimenions of DataSet3D are Frequency1 (positive valued), Wave Direction1 (degrees), and Wave Direction2 (degrees). !! 3. The wave direction requested might be between end points of wave direction dimension (ie. at 179 degrees when -!! WvDir1(1)=175, WvDir(Dims(3))=-175) +!! WvDir1(1)=175, WvDir(Dims(3))=-175) <- This is no longer the case. See comment below. !! 4. The arrays WvFreq1, WvDir1, and WvDir2, will give the values for each dimension that correspond to each index of DataSet3D. !! 5. The data is not necessarily equally spaced in any direction: ie. WvFreq1 may not have uniform spacing between points. !! 6. If a point is requested, it can be assumed that it lies within DataSet3D (this is checked before calling this subroutine) @@ -211,11 +227,15 @@ SUBROUTINE WAMIT_Interp3D_Cplx( InCoord, DataSet3D, WvFreq1, WvDir1, WvDir2, Las ! find the indices into the arrays representing coordinates of each dimension: Coords = InCoord - - DO i=2,3 ! make sure these requested degrees fall in the range -180 <= Coord(2:3) < 180 - Coords(i) = MODULO( Coords(i), 360.0_SiKi ) - IF ( Coords(i) >= 180.0_SiKi ) Coords(i) = Coords(i) - 360.0_SiKi - END DO + + ! The periodic "looping" behavior of the wave direction interpolation has been commented out due to the potential for large error without warning. + ! With the WAMIT2 module updated to handle ranges of input wave directions crossing +/-180 deg, it is now the responsibility of the calling code + ! to make sure the wave heading interpolation point is strictly in range. + + ! DO i=2,3 ! make sure these requested degrees fall in the range -180 <= Coord(2:3) < 180 + ! Coords(i) = MODULO( Coords(i), 360.0_SiKi ) + ! IF ( Coords(i) >= 180.0_SiKi ) Coords(i) = Coords(i) - 360.0_SiKi + ! END DO CALL LocateStp( Coords(1), WvFreq1, LastIndex(1), n(1) ) CALL LocateStp( Coords(2), WvDir1, LastIndex(2), n(2) ) @@ -225,25 +245,27 @@ SUBROUTINE WAMIT_Interp3D_Cplx( InCoord, DataSet3D, WvFreq1, WvDir1, WvDir2, Las ! WvFreq1 (indx 1) - IF (Indx_Lo(1) == 0) THEN - Indx_Lo(1) = 1 - ELSEIF (Indx_Lo(1) == n(1) ) THEN - Indx_Lo(1) = max( n(1) - 1, 1 ) ! make sure it's a valid index - END IF - Indx_Hi(1) = min( Indx_Lo(1) + 1 , n(1) ) ! make sure it's a valid index - - ! WvDir1, WvDir2 (indx 2,3) [use modular arithmetic] - DO i=2,3 + DO i = 1,3 IF (Indx_Lo(i) == 0) THEN - Indx_Hi(i) = 1 - Indx_Lo(i) = n(i) + Indx_Lo(i) = 1 ELSEIF (Indx_Lo(i) == n(i) ) THEN - Indx_Hi(i) = 1 - ELSE - Indx_Hi(i) = min( Indx_Lo(i) + 1, n(i) ) ! make sure it's a valid index - END IF + Indx_Lo(i) = max( n(i) - 1, 1 ) ! make sure it's a valid index + END IF + Indx_Hi(i) = min( Indx_Lo(i) + 1 , n(i) ) ! make sure it's a valid index END DO + + ! ! WvDir1, WvDir2 (indx 2,3) [use modular arithmetic] + ! DO i=2,3 + ! IF (Indx_Lo(i) == 0) THEN + ! Indx_Hi(i) = 1 + ! Indx_Lo(i) = n(i) + ! ELSEIF (Indx_Lo(i) == n(i) ) THEN + ! Indx_Hi(i) = 1 + ! ELSE + ! Indx_Hi(i) = min( Indx_Lo(i) + 1, n(i) ) ! make sure it's a valid index + ! END IF + ! END DO ! calculate the positions of all dimensions: @@ -257,15 +279,15 @@ SUBROUTINE WAMIT_Interp3D_Cplx( InCoord, DataSet3D, WvFreq1, WvDir1, WvDir2, Las pos_Hi(3) = WvDir2(Indx_Hi(3)) ! angles have to be adjusted so that pos_Lo(i) <= Coords(i) <= pos_Hi(i) - DO i=2,3 - IF ( Indx_Hi(i) == 1 .AND. n(i) > 1 ) THEN ! we're looping around the array [periodic] - IF ( pos_Lo(i) < Coords(i) ) THEN - pos_Hi(i) = pos_Hi(i) + 360.0_SiKi - ELSEIF ( pos_Lo(i) /= Coords(i) ) THEN !bjj: I think it's okay if we don't use equalRealNos here - pos_Lo(i) = pos_Lo(i) - 360.0_SiKi - END IF - END IF - END DO + ! DO i=2,3 + ! IF ( Indx_Hi(i) == 1 .AND. n(i) > 1 ) THEN ! we're looping around the array [periodic] + ! IF ( pos_Lo(i) < Coords(i) ) THEN + ! pos_Hi(i) = pos_Hi(i) + 360.0_SiKi + ! ELSEIF ( pos_Lo(i) /= Coords(i) ) THEN !bjj: I think it's okay if we don't use equalRealNos here + ! pos_Lo(i) = pos_Lo(i) - 360.0_SiKi + ! END IF + ! END IF + ! END DO @@ -283,7 +305,7 @@ END SUBROUTINE WAMIT_Interp3D_Cplx !! 2. The dimenions of DataSet4D are Frequency1 (positive valued), Frequency2 (positive valued), Wave Direction 1 (degrees), !! and Wave Direction 2 (degrees). !! 3. The wave direction requested might be between end points of wave direction dimension (ie. at 179 degrees when -!! WvDir1(1)=175, WvDir(Dims(3))=-175) +!! WvDir1(1)=175, WvDir(Dims(3))=-175) <- This is no longer the case. See comment below. !! 4. The arrays WvFreq1, WvFreq2, WvDir1, and WvDir2 will give the values for each dimension that correspond to !! each index of DataSet4D. !! 5. The data is not necessarily equally spaced in any direction: ie. WvFreq1 may not have uniform spacing between points. @@ -343,10 +365,14 @@ SUBROUTINE WAMIT_Interp4D_Cplx( InCoord, DataSet4D, WvFreq1, WvFreq2, WvDir1, Wv Coords = InCoord - DO i=3,4 ! make sure these requested degrees fall in the range -180 <= Coord(3:4) < 180 - Coords(i) = MODULO( Coords(i), 360.0_SiKi ) - IF ( Coords(i) >= 180.0_SiKi ) Coords(i) = Coords(i) - 360.0_SiKi - END DO + ! The periodic "looping" behavior of the wave direction interpolation has been commented out due to the potential for large error without warning. + ! With the WAMIT2 module updated to handle ranges of input wave directions crossing +/-180 deg, it is now the responsibility of the calling code + ! to make sure the wave heading interpolation point is strictly in range. + + ! DO i=3,4 ! make sure these requested degrees fall in the range -180 <= Coord(3:4) < 180 + ! Coords(i) = MODULO( Coords(i), 360.0_SiKi ) + ! IF ( Coords(i) >= 180.0_SiKi ) Coords(i) = Coords(i) - 360.0_SiKi + ! END DO CALL LocateStp( Coords(1), WvFreq1, LastIndex(1), n(1) ) CALL LocateStp( Coords(2), WvFreq2, LastIndex(2), n(2) ) @@ -357,7 +383,7 @@ SUBROUTINE WAMIT_Interp4D_Cplx( InCoord, DataSet4D, WvFreq1, WvFreq2, WvDir1, Wv ! WvFreq1, WvFreq2 (indx 1, 2) - DO i=1,2 + DO i=1,4 IF (Indx_Lo(i) == 0) THEN Indx_Lo(i) = 1 ELSEIF (Indx_Lo(i) == n(i) ) THEN @@ -368,16 +394,16 @@ SUBROUTINE WAMIT_Interp4D_Cplx( InCoord, DataSet4D, WvFreq1, WvFreq2, WvDir1, Wv ! WvDir1, WvDir2 (indx 3,4) [use modular arithmetic] - DO i=3,4 - IF (Indx_Lo(i) == 0) THEN - Indx_Hi(i) = 1 - Indx_Lo(i) = n(i) - ELSEIF (Indx_Lo(i) == n(i) ) THEN - Indx_Hi(i) = 1 - ELSE - Indx_Hi(i) = min( Indx_Lo(i) + 1, n(i) ) ! make sure it's a valid index - END IF - END DO + ! DO i=3,4 + ! IF (Indx_Lo(i) == 0) THEN + ! Indx_Hi(i) = 1 + ! Indx_Lo(i) = n(i) + ! ELSEIF (Indx_Lo(i) == n(i) ) THEN + ! Indx_Hi(i) = 1 + ! ELSE + ! Indx_Hi(i) = min( Indx_Lo(i) + 1, n(i) ) ! make sure it's a valid index + ! END IF + ! END DO ! calculate the positions of all dimensions: @@ -395,15 +421,15 @@ SUBROUTINE WAMIT_Interp4D_Cplx( InCoord, DataSet4D, WvFreq1, WvFreq2, WvDir1, Wv pos_Hi(4) = WvDir2(Indx_Hi(4)) ! angles have to be adjusted so that pos_Lo(i) <= Coords(i) <= pos_Hi(i) - DO i=3,4 - IF ( Indx_Hi(i) == 1 .AND. n(i) > 1 ) THEN ! we're looping around the array [periodic] - IF ( pos_Lo(i) < Coords(i) ) THEN - pos_Hi(i) = pos_Hi(i) + 360.0_SiKi - ELSEIF ( pos_Lo(i) /= Coords(i) ) THEN !bjj: I think it's okay if we don't use equalRealNos here - pos_Lo(i) = pos_Lo(i) - 360.0_SiKi - END IF - END IF - END DO + ! DO i=3,4 + ! IF ( Indx_Hi(i) == 1 .AND. n(i) > 1 ) THEN ! we're looping around the array [periodic] + ! IF ( pos_Lo(i) < Coords(i) ) THEN + ! pos_Hi(i) = pos_Hi(i) + 360.0_SiKi + ! ELSEIF ( pos_Lo(i) /= Coords(i) ) THEN !bjj: I think it's okay if we don't use equalRealNos here + ! pos_Lo(i) = pos_Lo(i) - 360.0_SiKi + ! END IF + ! END IF + ! END DO @@ -621,5 +647,80 @@ SUBROUTINE CalcIsoparCoords( InCoord, posLo, posHi, isopc ) END SUBROUTINE CalcIsoparCoords + +!> retrieve indices from the WaveField info, and do interpolation for this point. +!! NOTE: the WAMIT field passed in here through pKinXX is based on WaveField sizing, which is why we can do this. +function WAMIT_ForceWaves_Interp_3D_vec6(Time, pos, pKinXX, WF_p, WF_m, ErrStat3, ErrMsg3) + real(DbKi), intent(in ) :: Time + real(ReKi), intent(in ) :: pos(2) !< position + real(SiKi), intent(in ) :: pKinXX(0:,:,:,:) !< 3D Wave excitation data (SiKi for storage space reasons) + type(SeaSt_WaveField_ParameterType), intent(in ) :: WF_p !< wavefield parameters + type(SeaSt_WaveField_MiscVarType), intent(inout) :: WF_m !< wavefield misc/optimization variables + integer(IntKi), intent( out) :: ErrStat3 + character(*), intent( out) :: ErrMsg3 + + real(SiKi) :: WAMIT_ForceWaves_Interp_3D_vec6(6) + real(SiKi) :: u(8) + integer(IntKi) :: i + + ! get the bounding indices from the WaveField info (same indexing used in WAMIT) + call WaveField_Interp_Setup3D( Time, pos, WF_p, WF_m, ErrStat3, ErrMsg3 ) + + ! interpolate + do i = 1,6 + u(1) = pKinXX( WF_m%Indx_Hi(1), WF_m%Indx_Lo(2), WF_m%Indx_Lo(3), i ) + u(2) = pKinXX( WF_m%Indx_Hi(1), WF_m%Indx_Hi(2), WF_m%Indx_Lo(3), i ) + u(3) = pKinXX( WF_m%Indx_Lo(1), WF_m%Indx_Hi(2), WF_m%Indx_Lo(3), i ) + u(4) = pKinXX( WF_m%Indx_Lo(1), WF_m%Indx_Lo(2), WF_m%Indx_Lo(3), i ) + u(5) = pKinXX( WF_m%Indx_Hi(1), WF_m%Indx_Lo(2), WF_m%Indx_Hi(3), i ) + u(6) = pKinXX( WF_m%Indx_Hi(1), WF_m%Indx_Hi(2), WF_m%Indx_Hi(3), i ) + u(7) = pKinXX( WF_m%Indx_Lo(1), WF_m%Indx_Hi(2), WF_m%Indx_Hi(3), i ) + u(8) = pKinXX( WF_m%Indx_Lo(1), WF_m%Indx_Lo(2), WF_m%Indx_Hi(3), i ) + WAMIT_ForceWaves_Interp_3D_vec6(i) = SUM ( WF_m%N3D * u ) + end do +end function + + +!> retrieve indices from the WaveField info, and do interpolation for this point. This is for interpolating on 4D +!! NOTE: the WAMIT field passed in here through pKinXX is based on WaveField sizing, which is why we can do this. +function WAMIT_ForceWaves_Interp_4D_vec6(Time, pos, pKinXX, WF_p, WF_m, ErrStat3, ErrMsg3) + real(DbKi), intent(in ) :: Time + real(ReKi), intent(in ) :: pos(3) !< position + real(SiKi), intent(in ) :: pKinXX(0:,:,:,:,:) !< 4D Wave excitation data (SiKi for storage space reasons) + type(SeaSt_WaveField_ParameterType), intent(in ) :: WF_p !< wavefield parameters + type(SeaSt_WaveField_MiscVarType), intent(inout) :: WF_m !< wavefield misc/optimization variables + integer(IntKi), intent( out) :: ErrStat3 + character(*), intent( out) :: ErrMsg3 + + real(SiKi) :: WAMIT_ForceWaves_Interp_4D_vec6(6) + real(SiKi) :: u(16) + integer(IntKi) :: i + + ! get the bounding indices from the WaveField info (same indexing used in WAMIT) + call WaveField_Interp_Setup4D( Time, pos, WF_p, WF_m, ErrStat3, ErrMsg3 ) + + ! interpolate + do i = 1,6 + u( 1) = pKinXX( WF_m%Indx_Lo(1), WF_m%Indx_Lo(2), WF_m%Indx_Lo(3), WF_m%Indx_Lo(4), i ) + u( 2) = pKinXX( WF_m%Indx_Lo(1), WF_m%Indx_Lo(2), WF_m%Indx_Lo(3), WF_m%Indx_Hi(4), i ) + u( 3) = pKinXX( WF_m%Indx_Lo(1), WF_m%Indx_Lo(2), WF_m%Indx_Hi(3), WF_m%Indx_Lo(4), i ) + u( 4) = pKinXX( WF_m%Indx_Lo(1), WF_m%Indx_Lo(2), WF_m%Indx_Hi(3), WF_m%Indx_Hi(4), i ) + u( 5) = pKinXX( WF_m%Indx_Lo(1), WF_m%Indx_Hi(2), WF_m%Indx_Lo(3), WF_m%Indx_Lo(4), i ) + u( 6) = pKinXX( WF_m%Indx_Lo(1), WF_m%Indx_Hi(2), WF_m%Indx_Lo(3), WF_m%Indx_Hi(4), i ) + u( 7) = pKinXX( WF_m%Indx_Lo(1), WF_m%Indx_Hi(2), WF_m%Indx_Hi(3), WF_m%Indx_Lo(4), i ) + u( 8) = pKinXX( WF_m%Indx_Lo(1), WF_m%Indx_Hi(2), WF_m%Indx_Hi(3), WF_m%Indx_Hi(4), i ) + u( 9) = pKinXX( WF_m%Indx_Hi(1), WF_m%Indx_Lo(2), WF_m%Indx_Lo(3), WF_m%Indx_Lo(4), i ) + u(10) = pKinXX( WF_m%Indx_Hi(1), WF_m%Indx_Lo(2), WF_m%Indx_Lo(3), WF_m%Indx_Hi(4), i ) + u(11) = pKinXX( WF_m%Indx_Hi(1), WF_m%Indx_Lo(2), WF_m%Indx_Hi(3), WF_m%Indx_Lo(4), i ) + u(12) = pKinXX( WF_m%Indx_Hi(1), WF_m%Indx_Lo(2), WF_m%Indx_Hi(3), WF_m%Indx_Hi(4), i ) + u(13) = pKinXX( WF_m%Indx_Hi(1), WF_m%Indx_Hi(2), WF_m%Indx_Lo(3), WF_m%Indx_Lo(4), i ) + u(14) = pKinXX( WF_m%Indx_Hi(1), WF_m%Indx_Hi(2), WF_m%Indx_Lo(3), WF_m%Indx_Hi(4), i ) + u(15) = pKinXX( WF_m%Indx_Hi(1), WF_m%Indx_Hi(2), WF_m%Indx_Hi(3), WF_m%Indx_Lo(4), i ) + u(16) = pKinXX( WF_m%Indx_Hi(1), WF_m%Indx_Hi(2), WF_m%Indx_Hi(3), WF_m%Indx_Hi(4), i ) + WAMIT_ForceWaves_Interp_4D_vec6(i) = SUM ( WF_m%N4D * u ) + end do +end function + + !---------------------------------------------------------------------------------------------------------------------------------- END MODULE WAMIT_Interp diff --git a/modules/hydrodyn/src/WAMIT_Types.f90 b/modules/hydrodyn/src/WAMIT_Types.f90 index 4cdcbb6a88..cfa511e855 100644 --- a/modules/hydrodyn/src/WAMIT_Types.f90 +++ b/modules/hydrodyn/src/WAMIT_Types.f90 @@ -34,53 +34,36 @@ MODULE WAMIT_Types USE Conv_Radiation_Types USE SS_Radiation_Types USE SS_Excitation_Types -USE Waves_Types USE NWTC_Library IMPLICIT NONE - INTEGER(IntKi), PUBLIC, PARAMETER :: MaxWAMITOutputs = 18 ! [-] ! ========= WAMIT_InitInputType ======= TYPE, PUBLIC :: WAMIT_InitInputType - INTEGER(IntKi) :: NBody !< [>=1; only used when PotMod=1. If NBodyMod=1, the WAMIT data contains a vector of size 6*NBody x 1 and matrices of size 6*NBody x 6*NBody; if NBodyMod>1, there are NBody sets of WAMIT data each with a vector of size 6 x 1 and matrices of size 6 x 6] [-] - INTEGER(IntKi) :: NBodyMod !< Body coupling model {1: include coupling terms between each body and NBody in HydroDyn equals NBODY in WAMIT, 2: neglect coupling terms between each body and NBODY=1 with XBODY=0 in WAMIT, 3: Neglect coupling terms between each body and NBODY=1 with XBODY=/0 in WAMIT} (switch) [only used when PotMod=1] [-] - REAL(ReKi) :: Gravity !< Supplied by Driver: Gravitational acceleration [(m/s^2)] - REAL(SiKi) :: WtrDpth !< Water depth (positive-valued) [m] + INTEGER(IntKi) :: NBody = 0_IntKi !< [>=1; only used when PotMod=1. If NBodyMod=1, the WAMIT data contains a vector of size 6*NBody x 1 and matrices of size 6*NBody x 6*NBody; if NBodyMod>1, there are NBody sets of WAMIT data each with a vector of size 6 x 1 and matrices of size 6 x 6] [-] + INTEGER(IntKi) :: NBodyMod = 0_IntKi !< Body coupling model {1: include coupling terms between each body and NBody in HydroDyn equals NBODY in WAMIT, 2: neglect coupling terms between each body and NBODY=1 with XBODY=0 in WAMIT, 3: Neglect coupling terms between each body and NBODY=1 with XBODY=/0 in WAMIT} (switch) [only used when PotMod=1] [-] + REAL(ReKi) :: Gravity = 0.0_ReKi !< Supplied by Driver: Gravitational acceleration [(m/s^2)] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: PtfmVol0 !< [-] - LOGICAL :: HasWAMIT !< .TRUE. if using WAMIT model, .FALSE. otherwise [-] - REAL(ReKi) :: WAMITULEN !< [-] + LOGICAL :: HasWAMIT = .false. !< .TRUE. if using WAMIT model, .FALSE. otherwise [-] + REAL(ReKi) :: WAMITULEN = 0.0_ReKi !< [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: PtfmRefxt !< The xt offset of the body reference point(s) from (0,0,0) [1 to NBody; only used when PotMod=1 ] [(m)] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: PtfmRefyt !< The yt offset of the body reference point(s) from (0,0,0) [1 to NBody; only used when PotMod=1 ] [(m)] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: PtfmRefzt !< The zt offset of the body reference point(s) from (0,0,0) [1 to NBody; only used when PotMod=1; must be 0.0 if NBodyMod=2 ] [(m)] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: PtfmRefztRot !< The rotation about zt of the body reference frame(s) from xt/yt [radians] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: PtfmCOBxt !< [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: PtfmCOByt !< [-] - INTEGER(IntKi) :: RdtnMod !< [-] - INTEGER(IntKi) :: ExctnMod !< [-] - REAL(DbKi) :: RdtnTMax !< [-] - REAL(ReKi) :: WaveDir !< [-] + INTEGER(IntKi) :: RdtnMod = 0_IntKi !< [-] + INTEGER(IntKi) :: ExctnMod = 0_IntKi !< [-] + INTEGER(IntKi) :: ExctnDisp = 0_IntKi !< 0: use undisplaced position, 1: use displaced position, 2: use low-pass filtered displaced position) [only used when PotMod=1 and ExctnMod>0] [-] + REAL(ReKi) :: ExctnCutOff = 0.0_ReKi !< Cutoff (corner) frequency of the low-pass time-filtered displaced position (Hz) [>0.0] [Hz] + INTEGER(IntKi) :: NExctnHdg = 0_IntKi !< Number of PRP headings/yaw offset evenly distributed over the region [-180, 180) deg to be used when precomputing the wave excitation [only used when PtfmYMod=1] [-] + REAL(DbKi) :: RdtnTMax = 0.0_R8Ki !< [-] CHARACTER(1024) :: WAMITFile !< [-] TYPE(Conv_Rdtn_InitInputType) :: Conv_Rdtn !< [-] - REAL(ReKi) :: Rhoxg !< [-] - INTEGER(IntKi) :: NStepWave !< [-] - INTEGER(IntKi) :: NStepWave2 !< [-] - REAL(ReKi) :: WaveDOmega !< [-] - REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveElev0 !< Wave elevation time history at origin (needed for SS_Excitation module) [m] - REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: WaveElevC0 !< Discrete Fourier transform of the instantaneous elevation of incident waves at the platform reference point. First column is real part, second column is imaginary part [(meters)] - REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveTime !< [-] - INTEGER(IntKi) :: WaveMod !< [-] - REAL(ReKi) :: WtrDens !< [-] - REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveDirArr !< Array of wave directions (one per frequency) from the Waves module [-] - REAL(SiKi) :: WaveDirMin !< Minimum wave direction from Waves module [-] - REAL(SiKi) :: WaveDirMax !< Maximum wave direction from Waves module [-] - CHARACTER(ChanLen) , DIMENSION(1:18) :: OutList !< This should really be dimensioned with MaxOutPts [-] - LOGICAL :: OutAll !< [-] - INTEGER(IntKi) :: NumOuts !< [-] + TYPE(SeaSt_WaveFieldType) , POINTER :: WaveField => NULL() !< Pointer to wave field [-] + INTEGER(IntKi) :: PtfmYMod = 0_IntKi !< Large yaw model [-] + REAL(ReKi) :: PtfmRefY = 0.0_ReKi !< Initial reference yaw offset [(rad)] + REAL(ReKi) , DIMENSION(1:6) :: PlatformPos = 0.0_ReKi !< Initial platform position (6 DOFs) [-] END TYPE WAMIT_InitInputType ! ======================= -! ========= WAMIT_InitOutputType ======= - TYPE, PUBLIC :: WAMIT_InitOutputType - REAL(ReKi) :: NULLVAL !< [-] - END TYPE WAMIT_InitOutputType -! ======================= ! ========= WAMIT_ContinuousStateType ======= TYPE, PUBLIC :: WAMIT_ContinuousStateType TYPE(SS_Rad_ContinuousStateType) :: SS_Rdtn !< continuous states from the State Space radiation module [-] @@ -93,6 +76,7 @@ MODULE WAMIT_Types TYPE(Conv_Rdtn_DiscreteStateType) :: Conv_Rdtn !< discrete states from the convolution radiation module [-] TYPE(SS_Rad_DiscreteStateType) :: SS_Rdtn !< placeholder [-] TYPE(SS_Exc_DiscreteStateType) :: SS_Exctn !< placeholder [-] + REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: BdyPosFilt !< Low-pass filtered WAMIT body position at the current and previous steps used when ExctnDisp=2 [-] END TYPE WAMIT_DiscreteStateType ! ======================= ! ========= WAMIT_ConstraintStateType ======= @@ -111,7 +95,7 @@ MODULE WAMIT_Types ! ======================= ! ========= WAMIT_MiscVarType ======= TYPE, PUBLIC :: WAMIT_MiscVarType - INTEGER(IntKi) :: LastIndWave !< [-] + INTEGER(IntKi) :: LastIndWave = 0_IntKi !< [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: F_HS !< local variable in CalcOutput:Total load contribution from hydrostatics, including the effects of waterplane area and the center of buoyancy [(N, N-m)] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: F_Waves1 !< local variable in CalcOutput:Total load contribution from incident waves (i.e., the diffraction problem) [(N, N-m)] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: F_Rdtn !< local variable in CalcOutput:Total load contribution from wave radiation damping (i.e., the diffraction problem) [(N, N-m)] @@ -125,35 +109,37 @@ MODULE WAMIT_Types TYPE(Conv_Rdtn_MiscVarType) :: Conv_Rdtn !< [-] TYPE(Conv_Rdtn_InputType) :: Conv_Rdtn_u !< [-] TYPE(Conv_Rdtn_OutputType) :: Conv_Rdtn_y !< [-] + TYPE(SeaSt_WaveField_MiscVarType) :: WaveField_m !< misc var information from the SeaState Interpolation module [-] END TYPE WAMIT_MiscVarType ! ======================= ! ========= WAMIT_ParameterType ======= TYPE, PUBLIC :: WAMIT_ParameterType - INTEGER(IntKi) :: NBody !< [>=1; only used when PotMod=1. If NBodyMod=1, the WAMIT data contains a vector of size 6*NBody x 1 and matrices of size 6*NBody x 6*NBody; if NBodyMod>1, there are NBody sets of WAMIT data each with a vector of size 6 x 1 and matrices of size 6 x 6] [-] - INTEGER(IntKi) :: NBodyMod !< Body coupling model {1: include coupling terms between each body and NBody in HydroDyn equals NBODY in WAMIT, 2: neglect coupling terms between each body and NBODY=1 with XBODY=0 in WAMIT, 3: Neglect coupling terms between each body and NBODY=1 with XBODY=/0 in WAMIT} (switch) [only used when PotMod=1] [-] + INTEGER(IntKi) :: NBody = 0_IntKi !< [>=1; only used when PotMod=1. If NBodyMod=1, the WAMIT data contains a vector of size 6*NBody x 1 and matrices of size 6*NBody x 6*NBody; if NBodyMod>1, there are NBody sets of WAMIT data each with a vector of size 6 x 1 and matrices of size 6 x 6] [-] + INTEGER(IntKi) :: NBodyMod = 0_IntKi !< Body coupling model {1: include coupling terms between each body and NBody in HydroDyn equals NBODY in WAMIT, 2: neglect coupling terms between each body and NBODY=1 with XBODY=0 in WAMIT, 3: Neglect coupling terms between each body and NBODY=1 with XBODY=/0 in WAMIT} (switch) [only used when PotMod=1] [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: F_HS_Moment_Offset !< The offset moment due to the COB being offset from the WAMIT body's local location {matrix 3xNBody} [N-m] REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: HdroAdMsI !< [(sec)] REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: HdroSttc !< [-] - INTEGER(IntKi) :: RdtnMod !< [-] - INTEGER(IntKi) :: ExctnMod !< [-] - REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: WaveExctn !< [-] - INTEGER(IntKi) :: NStepWave !< [-] + INTEGER(IntKi) :: RdtnMod = 0_IntKi !< [-] + INTEGER(IntKi) :: ExctnMod = 0_IntKi !< [-] + INTEGER(IntKi) :: ExctnDisp = 0_IntKi !< 0: use undisplaced position, 1: use displaced position, 2: use low-pass filtered displaced position) [only used when PotMod=1 and ExctnMod>0] [-] + REAL(ReKi) :: ExctnCutOff = 0.0_ReKi !< Cutoff (corner) frequency of the low-pass time-filtered displaced position (Hz) [>0.0] [Hz] + INTEGER(IntKi) :: NExctnHdg = 0_IntKi !< Number of PRP headings/yaw offset evenly distributed over the region [-180, 180) deg to be used when precomputing the wave excitation [only used when PtfmYMod=1] [-] + REAL(ReKi) :: ExctnFiltConst = 0.0_ReKi !< Low-pass time filter constant computed from ExctnCutOff [-] + REAL(SiKi) , DIMENSION(:,:,:), ALLOCATABLE :: WaveExctn !< [-] + REAL(SiKi) , DIMENSION(:,:,:,:,:), ALLOCATABLE :: WaveExctnGrid !< WaveExctnGrid dimensions are: 1st: wavetime, 2nd: X, 3rd: Y, 4th: PRP Yaw, 5th: Force component for eac WAMIT Body [-] TYPE(Conv_Rdtn_ParameterType) :: Conv_Rdtn !< [-] TYPE(SS_Rad_ParameterType) :: SS_Rdtn !< [-] TYPE(SS_Exc_ParameterType) :: SS_Exctn !< [-] - REAL(DbKi) :: DT !< [-] - TYPE(OutParmType) , DIMENSION(:), ALLOCATABLE :: OutParam !< [-] - INTEGER(IntKi) :: NumOuts !< [-] - INTEGER(IntKi) :: NumOutAll !< [-] - CHARACTER(20) :: OutFmt !< [-] - CHARACTER(20) :: OutSFmt !< [-] - CHARACTER(ChanLen) :: Delim !< [-] - INTEGER(IntKi) :: UnOutFile !< [-] + REAL(DbKi) :: DT = 0.0_R8Ki !< [-] + TYPE(SeaSt_WaveFieldType) , POINTER :: WaveField => NULL() !< Pointer to wave field [-] + INTEGER(IntKi) :: PtfmYMod = 0_IntKi !< Large yaw model [-] + TYPE(SeaSt_WaveField_ParameterType) :: ExctnGridParams !< Parameters of WaveExctnGrid [-] END TYPE WAMIT_ParameterType ! ======================= ! ========= WAMIT_InputType ======= TYPE, PUBLIC :: WAMIT_InputType TYPE(MeshType) :: Mesh !< Displacements at the WAMIT reference point in the inertial frame [-] + REAL(ReKi) :: PtfmRefY = 0.0_ReKi !< Reference yaw offset [(rad)] END TYPE WAMIT_InputType ! ======================= ! ========= WAMIT_OutputType ======= @@ -162,5270 +148,1060 @@ MODULE WAMIT_Types END TYPE WAMIT_OutputType ! ======================= CONTAINS - SUBROUTINE WAMIT_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(WAMIT_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(WAMIT_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 = 'WAMIT_CopyInitInput' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInitInputData%NBody = SrcInitInputData%NBody - DstInitInputData%NBodyMod = SrcInitInputData%NBodyMod - DstInitInputData%Gravity = SrcInitInputData%Gravity - DstInitInputData%WtrDpth = SrcInitInputData%WtrDpth -IF (ALLOCATED(SrcInitInputData%PtfmVol0)) THEN - i1_l = LBOUND(SrcInitInputData%PtfmVol0,1) - i1_u = UBOUND(SrcInitInputData%PtfmVol0,1) - IF (.NOT. ALLOCATED(DstInitInputData%PtfmVol0)) THEN - ALLOCATE(DstInitInputData%PtfmVol0(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%PtfmVol0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%PtfmVol0 = SrcInitInputData%PtfmVol0 -ENDIF - DstInitInputData%HasWAMIT = SrcInitInputData%HasWAMIT - DstInitInputData%WAMITULEN = SrcInitInputData%WAMITULEN -IF (ALLOCATED(SrcInitInputData%PtfmRefxt)) THEN - i1_l = LBOUND(SrcInitInputData%PtfmRefxt,1) - i1_u = UBOUND(SrcInitInputData%PtfmRefxt,1) - IF (.NOT. ALLOCATED(DstInitInputData%PtfmRefxt)) THEN - ALLOCATE(DstInitInputData%PtfmRefxt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%PtfmRefxt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%PtfmRefxt = SrcInitInputData%PtfmRefxt -ENDIF -IF (ALLOCATED(SrcInitInputData%PtfmRefyt)) THEN - i1_l = LBOUND(SrcInitInputData%PtfmRefyt,1) - i1_u = UBOUND(SrcInitInputData%PtfmRefyt,1) - IF (.NOT. ALLOCATED(DstInitInputData%PtfmRefyt)) THEN - ALLOCATE(DstInitInputData%PtfmRefyt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%PtfmRefyt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%PtfmRefyt = SrcInitInputData%PtfmRefyt -ENDIF -IF (ALLOCATED(SrcInitInputData%PtfmRefzt)) THEN - i1_l = LBOUND(SrcInitInputData%PtfmRefzt,1) - i1_u = UBOUND(SrcInitInputData%PtfmRefzt,1) - IF (.NOT. ALLOCATED(DstInitInputData%PtfmRefzt)) THEN - ALLOCATE(DstInitInputData%PtfmRefzt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%PtfmRefzt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%PtfmRefzt = SrcInitInputData%PtfmRefzt -ENDIF -IF (ALLOCATED(SrcInitInputData%PtfmRefztRot)) THEN - i1_l = LBOUND(SrcInitInputData%PtfmRefztRot,1) - i1_u = UBOUND(SrcInitInputData%PtfmRefztRot,1) - IF (.NOT. ALLOCATED(DstInitInputData%PtfmRefztRot)) THEN - ALLOCATE(DstInitInputData%PtfmRefztRot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%PtfmRefztRot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%PtfmRefztRot = SrcInitInputData%PtfmRefztRot -ENDIF -IF (ALLOCATED(SrcInitInputData%PtfmCOBxt)) THEN - i1_l = LBOUND(SrcInitInputData%PtfmCOBxt,1) - i1_u = UBOUND(SrcInitInputData%PtfmCOBxt,1) - IF (.NOT. ALLOCATED(DstInitInputData%PtfmCOBxt)) THEN - ALLOCATE(DstInitInputData%PtfmCOBxt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%PtfmCOBxt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%PtfmCOBxt = SrcInitInputData%PtfmCOBxt -ENDIF -IF (ALLOCATED(SrcInitInputData%PtfmCOByt)) THEN - i1_l = LBOUND(SrcInitInputData%PtfmCOByt,1) - i1_u = UBOUND(SrcInitInputData%PtfmCOByt,1) - IF (.NOT. ALLOCATED(DstInitInputData%PtfmCOByt)) THEN - ALLOCATE(DstInitInputData%PtfmCOByt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%PtfmCOByt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%PtfmCOByt = SrcInitInputData%PtfmCOByt -ENDIF - DstInitInputData%RdtnMod = SrcInitInputData%RdtnMod - DstInitInputData%ExctnMod = SrcInitInputData%ExctnMod - DstInitInputData%RdtnTMax = SrcInitInputData%RdtnTMax - DstInitInputData%WaveDir = SrcInitInputData%WaveDir - DstInitInputData%WAMITFile = SrcInitInputData%WAMITFile - CALL Conv_Rdtn_CopyInitInput( SrcInitInputData%Conv_Rdtn, DstInitInputData%Conv_Rdtn, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstInitInputData%Rhoxg = SrcInitInputData%Rhoxg - DstInitInputData%NStepWave = SrcInitInputData%NStepWave - DstInitInputData%NStepWave2 = SrcInitInputData%NStepWave2 - DstInitInputData%WaveDOmega = SrcInitInputData%WaveDOmega -IF (ALLOCATED(SrcInitInputData%WaveElev0)) THEN - i1_l = LBOUND(SrcInitInputData%WaveElev0,1) - i1_u = UBOUND(SrcInitInputData%WaveElev0,1) - IF (.NOT. ALLOCATED(DstInitInputData%WaveElev0)) THEN - ALLOCATE(DstInitInputData%WaveElev0(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveElev0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%WaveElev0 = SrcInitInputData%WaveElev0 -ENDIF -IF (ALLOCATED(SrcInitInputData%WaveElevC0)) THEN - i1_l = LBOUND(SrcInitInputData%WaveElevC0,1) - i1_u = UBOUND(SrcInitInputData%WaveElevC0,1) - i2_l = LBOUND(SrcInitInputData%WaveElevC0,2) - i2_u = UBOUND(SrcInitInputData%WaveElevC0,2) - IF (.NOT. ALLOCATED(DstInitInputData%WaveElevC0)) THEN - ALLOCATE(DstInitInputData%WaveElevC0(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveElevC0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%WaveElevC0 = SrcInitInputData%WaveElevC0 -ENDIF -IF (ALLOCATED(SrcInitInputData%WaveTime)) THEN - i1_l = LBOUND(SrcInitInputData%WaveTime,1) - i1_u = UBOUND(SrcInitInputData%WaveTime,1) - IF (.NOT. ALLOCATED(DstInitInputData%WaveTime)) THEN - ALLOCATE(DstInitInputData%WaveTime(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveTime.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%WaveTime = SrcInitInputData%WaveTime -ENDIF - DstInitInputData%WaveMod = SrcInitInputData%WaveMod - DstInitInputData%WtrDens = SrcInitInputData%WtrDens -IF (ALLOCATED(SrcInitInputData%WaveDirArr)) THEN - i1_l = LBOUND(SrcInitInputData%WaveDirArr,1) - i1_u = UBOUND(SrcInitInputData%WaveDirArr,1) - IF (.NOT. ALLOCATED(DstInitInputData%WaveDirArr)) THEN - ALLOCATE(DstInitInputData%WaveDirArr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveDirArr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%WaveDirArr = SrcInitInputData%WaveDirArr -ENDIF - DstInitInputData%WaveDirMin = SrcInitInputData%WaveDirMin - DstInitInputData%WaveDirMax = SrcInitInputData%WaveDirMax - DstInitInputData%OutList = SrcInitInputData%OutList - DstInitInputData%OutAll = SrcInitInputData%OutAll - DstInitInputData%NumOuts = SrcInitInputData%NumOuts - END SUBROUTINE WAMIT_CopyInitInput - - SUBROUTINE WAMIT_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(WAMIT_InitInputType), INTENT(INOUT) :: InitInputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT_DestroyInitInput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(InitInputData%PtfmVol0)) THEN - DEALLOCATE(InitInputData%PtfmVol0) -ENDIF -IF (ALLOCATED(InitInputData%PtfmRefxt)) THEN - DEALLOCATE(InitInputData%PtfmRefxt) -ENDIF -IF (ALLOCATED(InitInputData%PtfmRefyt)) THEN - DEALLOCATE(InitInputData%PtfmRefyt) -ENDIF -IF (ALLOCATED(InitInputData%PtfmRefzt)) THEN - DEALLOCATE(InitInputData%PtfmRefzt) -ENDIF -IF (ALLOCATED(InitInputData%PtfmRefztRot)) THEN - DEALLOCATE(InitInputData%PtfmRefztRot) -ENDIF -IF (ALLOCATED(InitInputData%PtfmCOBxt)) THEN - DEALLOCATE(InitInputData%PtfmCOBxt) -ENDIF -IF (ALLOCATED(InitInputData%PtfmCOByt)) THEN - DEALLOCATE(InitInputData%PtfmCOByt) -ENDIF - CALL Conv_Rdtn_DestroyInitInput( InitInputData%Conv_Rdtn, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(InitInputData%WaveElev0)) THEN - DEALLOCATE(InitInputData%WaveElev0) -ENDIF -IF (ALLOCATED(InitInputData%WaveElevC0)) THEN - DEALLOCATE(InitInputData%WaveElevC0) -ENDIF -IF (ALLOCATED(InitInputData%WaveTime)) THEN - DEALLOCATE(InitInputData%WaveTime) -ENDIF -IF (ALLOCATED(InitInputData%WaveDirArr)) THEN - DEALLOCATE(InitInputData%WaveDirArr) -ENDIF - END SUBROUTINE WAMIT_DestroyInitInput - - SUBROUTINE WAMIT_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(WAMIT_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 = 'WAMIT_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 ! NBody - Int_BufSz = Int_BufSz + 1 ! NBodyMod - Re_BufSz = Re_BufSz + 1 ! Gravity - Re_BufSz = Re_BufSz + 1 ! WtrDpth - Int_BufSz = Int_BufSz + 1 ! PtfmVol0 allocated yes/no - IF ( ALLOCATED(InData%PtfmVol0) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PtfmVol0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PtfmVol0) ! PtfmVol0 - END IF - Int_BufSz = Int_BufSz + 1 ! HasWAMIT - Re_BufSz = Re_BufSz + 1 ! WAMITULEN - Int_BufSz = Int_BufSz + 1 ! PtfmRefxt allocated yes/no - IF ( ALLOCATED(InData%PtfmRefxt) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PtfmRefxt upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PtfmRefxt) ! PtfmRefxt - END IF - Int_BufSz = Int_BufSz + 1 ! PtfmRefyt allocated yes/no - IF ( ALLOCATED(InData%PtfmRefyt) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PtfmRefyt upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PtfmRefyt) ! PtfmRefyt - END IF - Int_BufSz = Int_BufSz + 1 ! PtfmRefzt allocated yes/no - IF ( ALLOCATED(InData%PtfmRefzt) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PtfmRefzt upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PtfmRefzt) ! PtfmRefzt - END IF - Int_BufSz = Int_BufSz + 1 ! PtfmRefztRot allocated yes/no - IF ( ALLOCATED(InData%PtfmRefztRot) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PtfmRefztRot upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%PtfmRefztRot) ! PtfmRefztRot - END IF - Int_BufSz = Int_BufSz + 1 ! PtfmCOBxt allocated yes/no - IF ( ALLOCATED(InData%PtfmCOBxt) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PtfmCOBxt upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PtfmCOBxt) ! PtfmCOBxt - END IF - Int_BufSz = Int_BufSz + 1 ! PtfmCOByt allocated yes/no - IF ( ALLOCATED(InData%PtfmCOByt) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PtfmCOByt upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PtfmCOByt) ! PtfmCOByt - END IF - Int_BufSz = Int_BufSz + 1 ! RdtnMod - Int_BufSz = Int_BufSz + 1 ! ExctnMod - Db_BufSz = Db_BufSz + 1 ! RdtnTMax - Re_BufSz = Re_BufSz + 1 ! WaveDir - Int_BufSz = Int_BufSz + 1*LEN(InData%WAMITFile) ! WAMITFile - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! Conv_Rdtn: size of buffers for each call to pack subtype - CALL Conv_Rdtn_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%Conv_Rdtn, ErrStat2, ErrMsg2, .TRUE. ) ! Conv_Rdtn - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! Conv_Rdtn - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Conv_Rdtn - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Conv_Rdtn - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Re_BufSz = Re_BufSz + 1 ! Rhoxg - Int_BufSz = Int_BufSz + 1 ! NStepWave - Int_BufSz = Int_BufSz + 1 ! NStepWave2 - Re_BufSz = Re_BufSz + 1 ! WaveDOmega - Int_BufSz = Int_BufSz + 1 ! WaveElev0 allocated yes/no - IF ( ALLOCATED(InData%WaveElev0) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WaveElev0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveElev0) ! WaveElev0 - END IF - Int_BufSz = Int_BufSz + 1 ! WaveElevC0 allocated yes/no - IF ( ALLOCATED(InData%WaveElevC0) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! WaveElevC0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveElevC0) ! WaveElevC0 - END IF - Int_BufSz = Int_BufSz + 1 ! WaveTime allocated yes/no - IF ( ALLOCATED(InData%WaveTime) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WaveTime upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveTime) ! WaveTime - END IF - Int_BufSz = Int_BufSz + 1 ! WaveMod - Re_BufSz = Re_BufSz + 1 ! WtrDens - Int_BufSz = Int_BufSz + 1 ! WaveDirArr allocated yes/no - IF ( ALLOCATED(InData%WaveDirArr) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WaveDirArr upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveDirArr) ! WaveDirArr - END IF - Re_BufSz = Re_BufSz + 1 ! WaveDirMin - Re_BufSz = Re_BufSz + 1 ! WaveDirMax - Int_BufSz = Int_BufSz + SIZE(InData%OutList)*LEN(InData%OutList) ! OutList - Int_BufSz = Int_BufSz + 1 ! OutAll - Int_BufSz = Int_BufSz + 1 ! NumOuts - 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%NBody - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NBodyMod - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Gravity - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WtrDpth - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%PtfmVol0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PtfmVol0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PtfmVol0,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PtfmVol0,1), UBOUND(InData%PtfmVol0,1) - ReKiBuf(Re_Xferred) = InData%PtfmVol0(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = TRANSFER(InData%HasWAMIT, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WAMITULEN - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%PtfmRefxt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PtfmRefxt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PtfmRefxt,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PtfmRefxt,1), UBOUND(InData%PtfmRefxt,1) - ReKiBuf(Re_Xferred) = InData%PtfmRefxt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PtfmRefyt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PtfmRefyt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PtfmRefyt,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PtfmRefyt,1), UBOUND(InData%PtfmRefyt,1) - ReKiBuf(Re_Xferred) = InData%PtfmRefyt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PtfmRefzt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PtfmRefzt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PtfmRefzt,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PtfmRefzt,1), UBOUND(InData%PtfmRefzt,1) - ReKiBuf(Re_Xferred) = InData%PtfmRefzt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PtfmRefztRot) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PtfmRefztRot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PtfmRefztRot,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PtfmRefztRot,1), UBOUND(InData%PtfmRefztRot,1) - DbKiBuf(Db_Xferred) = InData%PtfmRefztRot(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PtfmCOBxt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PtfmCOBxt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PtfmCOBxt,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PtfmCOBxt,1), UBOUND(InData%PtfmCOBxt,1) - ReKiBuf(Re_Xferred) = InData%PtfmCOBxt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PtfmCOByt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PtfmCOByt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PtfmCOByt,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PtfmCOByt,1), UBOUND(InData%PtfmCOByt,1) - ReKiBuf(Re_Xferred) = InData%PtfmCOByt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%RdtnMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%ExctnMod - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%RdtnTMax - Db_Xferred = Db_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WaveDir - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(InData%WAMITFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%WAMITFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - CALL Conv_Rdtn_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%Conv_Rdtn, ErrStat2, ErrMsg2, OnlySize ) ! Conv_Rdtn - 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 - ReKiBuf(Re_Xferred) = InData%Rhoxg - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NStepWave - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NStepWave2 - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WaveDOmega - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%WaveElev0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev0,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WaveElev0,1), UBOUND(InData%WaveElev0,1) - ReKiBuf(Re_Xferred) = InData%WaveElev0(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveElevC0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevC0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevC0,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevC0,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevC0,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%WaveElevC0,2), UBOUND(InData%WaveElevC0,2) - DO i1 = LBOUND(InData%WaveElevC0,1), UBOUND(InData%WaveElevC0,1) - ReKiBuf(Re_Xferred) = InData%WaveElevC0(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveTime) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveTime,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveTime,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WaveTime,1), UBOUND(InData%WaveTime,1) - ReKiBuf(Re_Xferred) = InData%WaveTime(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%WaveMod - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WtrDens - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%WaveDirArr) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveDirArr,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDirArr,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WaveDirArr,1), UBOUND(InData%WaveDirArr,1) - ReKiBuf(Re_Xferred) = InData%WaveDirArr(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%WaveDirMin - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WaveDirMax - Re_Xferred = Re_Xferred + 1 - 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 - IntKiBuf(Int_Xferred) = TRANSFER(InData%OutAll, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE WAMIT_PackInitInput - - SUBROUTINE WAMIT_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(WAMIT_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 = 'WAMIT_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%NBody = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NBodyMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%Gravity = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%WtrDpth = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PtfmVol0 not allocated - Int_Xferred = Int_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%PtfmVol0)) DEALLOCATE(OutData%PtfmVol0) - ALLOCATE(OutData%PtfmVol0(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmVol0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PtfmVol0,1), UBOUND(OutData%PtfmVol0,1) - OutData%PtfmVol0(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%HasWAMIT = TRANSFER(IntKiBuf(Int_Xferred), OutData%HasWAMIT) - Int_Xferred = Int_Xferred + 1 - OutData%WAMITULEN = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PtfmRefxt not allocated - Int_Xferred = Int_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%PtfmRefxt)) DEALLOCATE(OutData%PtfmRefxt) - ALLOCATE(OutData%PtfmRefxt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmRefxt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PtfmRefxt,1), UBOUND(OutData%PtfmRefxt,1) - OutData%PtfmRefxt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PtfmRefyt not allocated - Int_Xferred = Int_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%PtfmRefyt)) DEALLOCATE(OutData%PtfmRefyt) - ALLOCATE(OutData%PtfmRefyt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmRefyt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PtfmRefyt,1), UBOUND(OutData%PtfmRefyt,1) - OutData%PtfmRefyt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PtfmRefzt not allocated - Int_Xferred = Int_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%PtfmRefzt)) DEALLOCATE(OutData%PtfmRefzt) - ALLOCATE(OutData%PtfmRefzt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmRefzt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PtfmRefzt,1), UBOUND(OutData%PtfmRefzt,1) - OutData%PtfmRefzt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PtfmRefztRot not allocated - Int_Xferred = Int_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%PtfmRefztRot)) DEALLOCATE(OutData%PtfmRefztRot) - ALLOCATE(OutData%PtfmRefztRot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmRefztRot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PtfmRefztRot,1), UBOUND(OutData%PtfmRefztRot,1) - OutData%PtfmRefztRot(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PtfmCOBxt not allocated - Int_Xferred = Int_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%PtfmCOBxt)) DEALLOCATE(OutData%PtfmCOBxt) - ALLOCATE(OutData%PtfmCOBxt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmCOBxt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PtfmCOBxt,1), UBOUND(OutData%PtfmCOBxt,1) - OutData%PtfmCOBxt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PtfmCOByt not allocated - Int_Xferred = Int_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%PtfmCOByt)) DEALLOCATE(OutData%PtfmCOByt) - ALLOCATE(OutData%PtfmCOByt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmCOByt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PtfmCOByt,1), UBOUND(OutData%PtfmCOByt,1) - OutData%PtfmCOByt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%RdtnMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%ExctnMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%RdtnTMax = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%WaveDir = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(OutData%WAMITFile) - OutData%WAMITFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - 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 Conv_Rdtn_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%Conv_Rdtn, ErrStat2, ErrMsg2 ) ! Conv_Rdtn - 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%Rhoxg = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NStepWave = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NStepWave2 = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WaveDOmega = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElev0 not allocated - Int_Xferred = Int_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%WaveElev0)) DEALLOCATE(OutData%WaveElev0) - ALLOCATE(OutData%WaveElev0(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WaveElev0,1), UBOUND(OutData%WaveElev0,1) - OutData%WaveElev0(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElevC0 not allocated - Int_Xferred = Int_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%WaveElevC0)) DEALLOCATE(OutData%WaveElevC0) - ALLOCATE(OutData%WaveElevC0(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevC0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%WaveElevC0,2), UBOUND(OutData%WaveElevC0,2) - DO i1 = LBOUND(OutData%WaveElevC0,1), UBOUND(OutData%WaveElevC0,1) - OutData%WaveElevC0(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveTime not allocated - Int_Xferred = Int_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%WaveTime)) DEALLOCATE(OutData%WaveTime) - ALLOCATE(OutData%WaveTime(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveTime.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WaveTime,1), UBOUND(OutData%WaveTime,1) - OutData%WaveTime(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%WaveMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WtrDens = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveDirArr not allocated - Int_Xferred = Int_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%WaveDirArr)) DEALLOCATE(OutData%WaveDirArr) - ALLOCATE(OutData%WaveDirArr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDirArr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WaveDirArr,1), UBOUND(OutData%WaveDirArr,1) - OutData%WaveDirArr(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%WaveDirMin = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WaveDirMax = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%OutList,1) - i1_u = UBOUND(OutData%OutList,1) - 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 - OutData%OutAll = TRANSFER(IntKiBuf(Int_Xferred), OutData%OutAll) - Int_Xferred = Int_Xferred + 1 - OutData%NumOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE WAMIT_UnPackInitInput - - SUBROUTINE WAMIT_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(WAMIT_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(WAMIT_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 = 'WAMIT_CopyInitOutput' -! +subroutine WAMIT_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) + type(WAMIT_InitInputType), intent(in) :: SrcInitInputData + type(WAMIT_InitInputType), intent(inout) :: DstInitInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'WAMIT_CopyInitInput' ErrStat = ErrID_None - ErrMsg = "" - DstInitOutputData%NULLVAL = SrcInitOutputData%NULLVAL - END SUBROUTINE WAMIT_CopyInitOutput - - SUBROUTINE WAMIT_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(WAMIT_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT_DestroyInitOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE WAMIT_DestroyInitOutput - - SUBROUTINE WAMIT_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(WAMIT_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 = 'WAMIT_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 ! NULLVAL - 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%NULLVAL - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE WAMIT_PackInitOutput - - SUBROUTINE WAMIT_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(WAMIT_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 = 'WAMIT_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%NULLVAL = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE WAMIT_UnPackInitOutput - - SUBROUTINE WAMIT_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(WAMIT_ContinuousStateType), INTENT(IN) :: SrcContStateData - TYPE(WAMIT_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 = 'WAMIT_CopyContState' -! + ErrMsg = '' + DstInitInputData%NBody = SrcInitInputData%NBody + DstInitInputData%NBodyMod = SrcInitInputData%NBodyMod + DstInitInputData%Gravity = SrcInitInputData%Gravity + if (allocated(SrcInitInputData%PtfmVol0)) then + LB(1:1) = lbound(SrcInitInputData%PtfmVol0) + UB(1:1) = ubound(SrcInitInputData%PtfmVol0) + if (.not. allocated(DstInitInputData%PtfmVol0)) then + allocate(DstInitInputData%PtfmVol0(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%PtfmVol0.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%PtfmVol0 = SrcInitInputData%PtfmVol0 + end if + DstInitInputData%HasWAMIT = SrcInitInputData%HasWAMIT + DstInitInputData%WAMITULEN = SrcInitInputData%WAMITULEN + if (allocated(SrcInitInputData%PtfmRefxt)) then + LB(1:1) = lbound(SrcInitInputData%PtfmRefxt) + UB(1:1) = ubound(SrcInitInputData%PtfmRefxt) + if (.not. allocated(DstInitInputData%PtfmRefxt)) then + allocate(DstInitInputData%PtfmRefxt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%PtfmRefxt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%PtfmRefxt = SrcInitInputData%PtfmRefxt + end if + if (allocated(SrcInitInputData%PtfmRefyt)) then + LB(1:1) = lbound(SrcInitInputData%PtfmRefyt) + UB(1:1) = ubound(SrcInitInputData%PtfmRefyt) + if (.not. allocated(DstInitInputData%PtfmRefyt)) then + allocate(DstInitInputData%PtfmRefyt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%PtfmRefyt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%PtfmRefyt = SrcInitInputData%PtfmRefyt + end if + if (allocated(SrcInitInputData%PtfmRefzt)) then + LB(1:1) = lbound(SrcInitInputData%PtfmRefzt) + UB(1:1) = ubound(SrcInitInputData%PtfmRefzt) + if (.not. allocated(DstInitInputData%PtfmRefzt)) then + allocate(DstInitInputData%PtfmRefzt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%PtfmRefzt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%PtfmRefzt = SrcInitInputData%PtfmRefzt + end if + if (allocated(SrcInitInputData%PtfmRefztRot)) then + LB(1:1) = lbound(SrcInitInputData%PtfmRefztRot) + UB(1:1) = ubound(SrcInitInputData%PtfmRefztRot) + if (.not. allocated(DstInitInputData%PtfmRefztRot)) then + allocate(DstInitInputData%PtfmRefztRot(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%PtfmRefztRot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%PtfmRefztRot = SrcInitInputData%PtfmRefztRot + end if + if (allocated(SrcInitInputData%PtfmCOBxt)) then + LB(1:1) = lbound(SrcInitInputData%PtfmCOBxt) + UB(1:1) = ubound(SrcInitInputData%PtfmCOBxt) + if (.not. allocated(DstInitInputData%PtfmCOBxt)) then + allocate(DstInitInputData%PtfmCOBxt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%PtfmCOBxt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%PtfmCOBxt = SrcInitInputData%PtfmCOBxt + end if + if (allocated(SrcInitInputData%PtfmCOByt)) then + LB(1:1) = lbound(SrcInitInputData%PtfmCOByt) + UB(1:1) = ubound(SrcInitInputData%PtfmCOByt) + if (.not. allocated(DstInitInputData%PtfmCOByt)) then + allocate(DstInitInputData%PtfmCOByt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%PtfmCOByt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%PtfmCOByt = SrcInitInputData%PtfmCOByt + end if + DstInitInputData%RdtnMod = SrcInitInputData%RdtnMod + DstInitInputData%ExctnMod = SrcInitInputData%ExctnMod + DstInitInputData%ExctnDisp = SrcInitInputData%ExctnDisp + DstInitInputData%ExctnCutOff = SrcInitInputData%ExctnCutOff + DstInitInputData%NExctnHdg = SrcInitInputData%NExctnHdg + DstInitInputData%RdtnTMax = SrcInitInputData%RdtnTMax + DstInitInputData%WAMITFile = SrcInitInputData%WAMITFile + call Conv_Rdtn_CopyInitInput(SrcInitInputData%Conv_Rdtn, DstInitInputData%Conv_Rdtn, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstInitInputData%WaveField => SrcInitInputData%WaveField + DstInitInputData%PtfmYMod = SrcInitInputData%PtfmYMod + DstInitInputData%PtfmRefY = SrcInitInputData%PtfmRefY + DstInitInputData%PlatformPos = SrcInitInputData%PlatformPos +end subroutine + +subroutine WAMIT_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(WAMIT_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'WAMIT_DestroyInitInput' ErrStat = ErrID_None - ErrMsg = "" - CALL SS_Rad_CopyContState( SrcContStateData%SS_Rdtn, DstContStateData%SS_Rdtn, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SS_Exc_CopyContState( SrcContStateData%SS_Exctn, DstContStateData%SS_Exctn, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL Conv_Rdtn_CopyContState( SrcContStateData%Conv_Rdtn, DstContStateData%Conv_Rdtn, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE WAMIT_CopyContState - - SUBROUTINE WAMIT_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(WAMIT_ContinuousStateType), INTENT(INOUT) :: ContStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT_DestroyContState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL SS_Rad_DestroyContState( ContStateData%SS_Rdtn, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SS_Exc_DestroyContState( ContStateData%SS_Exctn, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL Conv_Rdtn_DestroyContState( ContStateData%Conv_Rdtn, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE WAMIT_DestroyContState - - SUBROUTINE WAMIT_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(WAMIT_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 = 'WAMIT_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 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! SS_Rdtn: size of buffers for each call to pack subtype - CALL SS_Rad_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%SS_Rdtn, ErrStat2, ErrMsg2, .TRUE. ) ! SS_Rdtn - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SS_Rdtn - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SS_Rdtn - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SS_Rdtn - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! SS_Exctn: size of buffers for each call to pack subtype - CALL SS_Exc_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%SS_Exctn, ErrStat2, ErrMsg2, .TRUE. ) ! SS_Exctn - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SS_Exctn - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SS_Exctn - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SS_Exctn - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! Conv_Rdtn: size of buffers for each call to pack subtype - CALL Conv_Rdtn_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%Conv_Rdtn, ErrStat2, ErrMsg2, .TRUE. ) ! Conv_Rdtn - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Conv_Rdtn - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Conv_Rdtn - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Conv_Rdtn - 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 SS_Rad_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%SS_Rdtn, ErrStat2, ErrMsg2, OnlySize ) ! SS_Rdtn - 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 SS_Exc_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%SS_Exctn, ErrStat2, ErrMsg2, OnlySize ) ! SS_Exctn - 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 Conv_Rdtn_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%Conv_Rdtn, ErrStat2, ErrMsg2, OnlySize ) ! Conv_Rdtn - 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 WAMIT_PackContState - - SUBROUTINE WAMIT_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(WAMIT_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 = 'WAMIT_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 - 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 SS_Rad_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%SS_Rdtn, ErrStat2, ErrMsg2 ) ! SS_Rdtn - 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 SS_Exc_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%SS_Exctn, ErrStat2, ErrMsg2 ) ! SS_Exctn - 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 Conv_Rdtn_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%Conv_Rdtn, ErrStat2, ErrMsg2 ) ! Conv_Rdtn - 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 WAMIT_UnPackContState - - SUBROUTINE WAMIT_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(WAMIT_DiscreteStateType), INTENT(IN) :: SrcDiscStateData - TYPE(WAMIT_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 = 'WAMIT_CopyDiscState' -! + ErrMsg = '' + if (allocated(InitInputData%PtfmVol0)) then + deallocate(InitInputData%PtfmVol0) + end if + if (allocated(InitInputData%PtfmRefxt)) then + deallocate(InitInputData%PtfmRefxt) + end if + if (allocated(InitInputData%PtfmRefyt)) then + deallocate(InitInputData%PtfmRefyt) + end if + if (allocated(InitInputData%PtfmRefzt)) then + deallocate(InitInputData%PtfmRefzt) + end if + if (allocated(InitInputData%PtfmRefztRot)) then + deallocate(InitInputData%PtfmRefztRot) + end if + if (allocated(InitInputData%PtfmCOBxt)) then + deallocate(InitInputData%PtfmCOBxt) + end if + if (allocated(InitInputData%PtfmCOByt)) then + deallocate(InitInputData%PtfmCOByt) + end if + call Conv_Rdtn_DestroyInitInput(InitInputData%Conv_Rdtn, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + nullify(InitInputData%WaveField) +end subroutine + +subroutine WAMIT_PackInitInput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(WAMIT_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'WAMIT_PackInitInput' + logical :: PtrInIndex + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%NBody) + call RegPack(RF, InData%NBodyMod) + call RegPack(RF, InData%Gravity) + call RegPackAlloc(RF, InData%PtfmVol0) + call RegPack(RF, InData%HasWAMIT) + call RegPack(RF, InData%WAMITULEN) + call RegPackAlloc(RF, InData%PtfmRefxt) + call RegPackAlloc(RF, InData%PtfmRefyt) + call RegPackAlloc(RF, InData%PtfmRefzt) + call RegPackAlloc(RF, InData%PtfmRefztRot) + call RegPackAlloc(RF, InData%PtfmCOBxt) + call RegPackAlloc(RF, InData%PtfmCOByt) + call RegPack(RF, InData%RdtnMod) + call RegPack(RF, InData%ExctnMod) + call RegPack(RF, InData%ExctnDisp) + call RegPack(RF, InData%ExctnCutOff) + call RegPack(RF, InData%NExctnHdg) + call RegPack(RF, InData%RdtnTMax) + call RegPack(RF, InData%WAMITFile) + call Conv_Rdtn_PackInitInput(RF, InData%Conv_Rdtn) + call RegPack(RF, associated(InData%WaveField)) + if (associated(InData%WaveField)) then + call RegPackPointer(RF, c_loc(InData%WaveField), PtrInIndex) + if (.not. PtrInIndex) then + call SeaSt_WaveField_PackSeaSt_WaveFieldType(RF, InData%WaveField) + end if + end if + call RegPack(RF, InData%PtfmYMod) + call RegPack(RF, InData%PtfmRefY) + call RegPack(RF, InData%PlatformPos) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine WAMIT_UnPackInitInput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(WAMIT_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'WAMIT_UnPackInitInput' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(B8Ki) :: PtrIdx + type(c_ptr) :: Ptr + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%NBody); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NBodyMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Gravity); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PtfmVol0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HasWAMIT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WAMITULEN); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PtfmRefxt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PtfmRefyt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PtfmRefzt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PtfmRefztRot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PtfmCOBxt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PtfmCOByt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RdtnMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ExctnMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ExctnDisp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ExctnCutOff); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NExctnHdg); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RdtnTMax); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WAMITFile); if (RegCheckErr(RF, RoutineName)) return + call Conv_Rdtn_UnpackInitInput(RF, OutData%Conv_Rdtn) ! Conv_Rdtn + if (associated(OutData%WaveField)) deallocate(OutData%WaveField) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackPointer(RF, Ptr, PtrIdx); if (RegCheckErr(RF, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveField) + else + allocate(OutData%WaveField,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveField.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + RF%Pointers(PtrIdx) = c_loc(OutData%WaveField) + call SeaSt_WaveField_UnpackSeaSt_WaveFieldType(RF, OutData%WaveField) ! WaveField + end if + else + OutData%WaveField => null() + end if + call RegUnpack(RF, OutData%PtfmYMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PtfmRefY); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PlatformPos); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine WAMIT_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) + type(WAMIT_ContinuousStateType), intent(in) :: SrcContStateData + type(WAMIT_ContinuousStateType), intent(inout) :: DstContStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'WAMIT_CopyContState' ErrStat = ErrID_None - ErrMsg = "" - CALL Conv_Rdtn_CopyDiscState( SrcDiscStateData%Conv_Rdtn, DstDiscStateData%Conv_Rdtn, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SS_Rad_CopyDiscState( SrcDiscStateData%SS_Rdtn, DstDiscStateData%SS_Rdtn, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SS_Exc_CopyDiscState( SrcDiscStateData%SS_Exctn, DstDiscStateData%SS_Exctn, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE WAMIT_CopyDiscState - - SUBROUTINE WAMIT_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(WAMIT_DiscreteStateType), INTENT(INOUT) :: DiscStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT_DestroyDiscState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL Conv_Rdtn_DestroyDiscState( DiscStateData%Conv_Rdtn, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SS_Rad_DestroyDiscState( DiscStateData%SS_Rdtn, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SS_Exc_DestroyDiscState( DiscStateData%SS_Exctn, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE WAMIT_DestroyDiscState - - SUBROUTINE WAMIT_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(WAMIT_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 = 'WAMIT_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 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! Conv_Rdtn: size of buffers for each call to pack subtype - CALL Conv_Rdtn_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%Conv_Rdtn, ErrStat2, ErrMsg2, .TRUE. ) ! Conv_Rdtn - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Conv_Rdtn - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Conv_Rdtn - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Conv_Rdtn - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! SS_Rdtn: size of buffers for each call to pack subtype - CALL SS_Rad_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%SS_Rdtn, ErrStat2, ErrMsg2, .TRUE. ) ! SS_Rdtn - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SS_Rdtn - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SS_Rdtn - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SS_Rdtn - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! SS_Exctn: size of buffers for each call to pack subtype - CALL SS_Exc_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%SS_Exctn, ErrStat2, ErrMsg2, .TRUE. ) ! SS_Exctn - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SS_Exctn - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SS_Exctn - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SS_Exctn - 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 Conv_Rdtn_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%Conv_Rdtn, ErrStat2, ErrMsg2, OnlySize ) ! Conv_Rdtn - 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 SS_Rad_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%SS_Rdtn, ErrStat2, ErrMsg2, OnlySize ) ! SS_Rdtn - 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 SS_Exc_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%SS_Exctn, ErrStat2, ErrMsg2, OnlySize ) ! SS_Exctn - 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 WAMIT_PackDiscState - - SUBROUTINE WAMIT_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(WAMIT_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 = 'WAMIT_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 - 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 Conv_Rdtn_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%Conv_Rdtn, ErrStat2, ErrMsg2 ) ! Conv_Rdtn - 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 SS_Rad_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%SS_Rdtn, ErrStat2, ErrMsg2 ) ! SS_Rdtn - 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 SS_Exc_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%SS_Exctn, ErrStat2, ErrMsg2 ) ! SS_Exctn - 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 WAMIT_UnPackDiscState - - SUBROUTINE WAMIT_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(WAMIT_ConstraintStateType), INTENT(IN) :: SrcConstrStateData - TYPE(WAMIT_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 = 'WAMIT_CopyConstrState' -! + ErrMsg = '' + call SS_Rad_CopyContState(SrcContStateData%SS_Rdtn, DstContStateData%SS_Rdtn, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SS_Exc_CopyContState(SrcContStateData%SS_Exctn, DstContStateData%SS_Exctn, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call Conv_Rdtn_CopyContState(SrcContStateData%Conv_Rdtn, DstContStateData%Conv_Rdtn, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine WAMIT_DestroyContState(ContStateData, ErrStat, ErrMsg) + type(WAMIT_ContinuousStateType), intent(inout) :: ContStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'WAMIT_DestroyContState' ErrStat = ErrID_None - ErrMsg = "" - CALL Conv_Rdtn_CopyConstrState( SrcConstrStateData%Conv_Rdtn, DstConstrStateData%Conv_Rdtn, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SS_Rad_CopyConstrState( SrcConstrStateData%SS_Rdtn, DstConstrStateData%SS_Rdtn, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SS_Exc_CopyConstrState( SrcConstrStateData%SS_Exctn, DstConstrStateData%SS_Exctn, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE WAMIT_CopyConstrState - - SUBROUTINE WAMIT_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(WAMIT_ConstraintStateType), INTENT(INOUT) :: ConstrStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT_DestroyConstrState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL Conv_Rdtn_DestroyConstrState( ConstrStateData%Conv_Rdtn, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SS_Rad_DestroyConstrState( ConstrStateData%SS_Rdtn, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SS_Exc_DestroyConstrState( ConstrStateData%SS_Exctn, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE WAMIT_DestroyConstrState - - SUBROUTINE WAMIT_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(WAMIT_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 = 'WAMIT_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 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! Conv_Rdtn: size of buffers for each call to pack subtype - CALL Conv_Rdtn_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%Conv_Rdtn, ErrStat2, ErrMsg2, .TRUE. ) ! Conv_Rdtn - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Conv_Rdtn - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Conv_Rdtn - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Conv_Rdtn - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! SS_Rdtn: size of buffers for each call to pack subtype - CALL SS_Rad_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%SS_Rdtn, ErrStat2, ErrMsg2, .TRUE. ) ! SS_Rdtn - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SS_Rdtn - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SS_Rdtn - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SS_Rdtn - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! SS_Exctn: size of buffers for each call to pack subtype - CALL SS_Exc_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%SS_Exctn, ErrStat2, ErrMsg2, .TRUE. ) ! SS_Exctn - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SS_Exctn - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SS_Exctn - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SS_Exctn - 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 Conv_Rdtn_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%Conv_Rdtn, ErrStat2, ErrMsg2, OnlySize ) ! Conv_Rdtn - 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 SS_Rad_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%SS_Rdtn, ErrStat2, ErrMsg2, OnlySize ) ! SS_Rdtn - 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 SS_Exc_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%SS_Exctn, ErrStat2, ErrMsg2, OnlySize ) ! SS_Exctn - 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 WAMIT_PackConstrState - - SUBROUTINE WAMIT_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(WAMIT_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 = 'WAMIT_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 - 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 Conv_Rdtn_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%Conv_Rdtn, ErrStat2, ErrMsg2 ) ! Conv_Rdtn - 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 SS_Rad_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%SS_Rdtn, ErrStat2, ErrMsg2 ) ! SS_Rdtn - 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 SS_Exc_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%SS_Exctn, ErrStat2, ErrMsg2 ) ! SS_Exctn - 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 WAMIT_UnPackConstrState - - SUBROUTINE WAMIT_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(WAMIT_OtherStateType), INTENT(IN) :: SrcOtherStateData - TYPE(WAMIT_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 = 'WAMIT_CopyOtherState' -! + ErrMsg = '' + call SS_Rad_DestroyContState(ContStateData%SS_Rdtn, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SS_Exc_DestroyContState(ContStateData%SS_Exctn, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call Conv_Rdtn_DestroyContState(ContStateData%Conv_Rdtn, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine WAMIT_PackContState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(WAMIT_ContinuousStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'WAMIT_PackContState' + if (RF%ErrStat >= AbortErrLev) return + call SS_Rad_PackContState(RF, InData%SS_Rdtn) + call SS_Exc_PackContState(RF, InData%SS_Exctn) + call Conv_Rdtn_PackContState(RF, InData%Conv_Rdtn) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine WAMIT_UnPackContState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(WAMIT_ContinuousStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'WAMIT_UnPackContState' + if (RF%ErrStat /= ErrID_None) return + call SS_Rad_UnpackContState(RF, OutData%SS_Rdtn) ! SS_Rdtn + call SS_Exc_UnpackContState(RF, OutData%SS_Exctn) ! SS_Exctn + call Conv_Rdtn_UnpackContState(RF, OutData%Conv_Rdtn) ! Conv_Rdtn +end subroutine + +subroutine WAMIT_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) + type(WAMIT_DiscreteStateType), intent(in) :: SrcDiscStateData + type(WAMIT_DiscreteStateType), intent(inout) :: DstDiscStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'WAMIT_CopyDiscState' ErrStat = ErrID_None - ErrMsg = "" - CALL SS_Rad_CopyOtherState( SrcOtherStateData%SS_Rdtn, DstOtherStateData%SS_Rdtn, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SS_Exc_CopyOtherState( SrcOtherStateData%SS_Exctn, DstOtherStateData%SS_Exctn, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL Conv_Rdtn_CopyOtherState( SrcOtherStateData%Conv_Rdtn, DstOtherStateData%Conv_Rdtn, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE WAMIT_CopyOtherState - - SUBROUTINE WAMIT_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(WAMIT_OtherStateType), INTENT(INOUT) :: OtherStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT_DestroyOtherState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL SS_Rad_DestroyOtherState( OtherStateData%SS_Rdtn, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SS_Exc_DestroyOtherState( OtherStateData%SS_Exctn, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL Conv_Rdtn_DestroyOtherState( OtherStateData%Conv_Rdtn, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE WAMIT_DestroyOtherState - - SUBROUTINE WAMIT_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(WAMIT_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 = 'WAMIT_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 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! SS_Rdtn: size of buffers for each call to pack subtype - CALL SS_Rad_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%SS_Rdtn, ErrStat2, ErrMsg2, .TRUE. ) ! SS_Rdtn - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SS_Rdtn - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SS_Rdtn - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SS_Rdtn - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! SS_Exctn: size of buffers for each call to pack subtype - CALL SS_Exc_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%SS_Exctn, ErrStat2, ErrMsg2, .TRUE. ) ! SS_Exctn - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SS_Exctn - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SS_Exctn - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SS_Exctn - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! Conv_Rdtn: size of buffers for each call to pack subtype - CALL Conv_Rdtn_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%Conv_Rdtn, ErrStat2, ErrMsg2, .TRUE. ) ! Conv_Rdtn - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Conv_Rdtn - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Conv_Rdtn - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Conv_Rdtn - 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 SS_Rad_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%SS_Rdtn, ErrStat2, ErrMsg2, OnlySize ) ! SS_Rdtn - 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 SS_Exc_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%SS_Exctn, ErrStat2, ErrMsg2, OnlySize ) ! SS_Exctn - 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 Conv_Rdtn_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%Conv_Rdtn, ErrStat2, ErrMsg2, OnlySize ) ! Conv_Rdtn - 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 WAMIT_PackOtherState - - SUBROUTINE WAMIT_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(WAMIT_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 = 'WAMIT_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 - 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 SS_Rad_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%SS_Rdtn, ErrStat2, ErrMsg2 ) ! SS_Rdtn - 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 SS_Exc_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%SS_Exctn, ErrStat2, ErrMsg2 ) ! SS_Exctn - 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 Conv_Rdtn_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%Conv_Rdtn, ErrStat2, ErrMsg2 ) ! Conv_Rdtn - 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 WAMIT_UnPackOtherState - - SUBROUTINE WAMIT_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(WAMIT_MiscVarType), INTENT(IN) :: SrcMiscData - TYPE(WAMIT_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 = 'WAMIT_CopyMisc' -! + ErrMsg = '' + call Conv_Rdtn_CopyDiscState(SrcDiscStateData%Conv_Rdtn, DstDiscStateData%Conv_Rdtn, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SS_Rad_CopyDiscState(SrcDiscStateData%SS_Rdtn, DstDiscStateData%SS_Rdtn, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SS_Exc_CopyDiscState(SrcDiscStateData%SS_Exctn, DstDiscStateData%SS_Exctn, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcDiscStateData%BdyPosFilt)) then + LB(1:3) = lbound(SrcDiscStateData%BdyPosFilt) + UB(1:3) = ubound(SrcDiscStateData%BdyPosFilt) + if (.not. allocated(DstDiscStateData%BdyPosFilt)) then + allocate(DstDiscStateData%BdyPosFilt(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%BdyPosFilt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%BdyPosFilt = SrcDiscStateData%BdyPosFilt + end if +end subroutine + +subroutine WAMIT_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) + type(WAMIT_DiscreteStateType), intent(inout) :: DiscStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'WAMIT_DestroyDiscState' ErrStat = ErrID_None - ErrMsg = "" - DstMiscData%LastIndWave = SrcMiscData%LastIndWave -IF (ALLOCATED(SrcMiscData%F_HS)) THEN - i1_l = LBOUND(SrcMiscData%F_HS,1) - i1_u = UBOUND(SrcMiscData%F_HS,1) - IF (.NOT. ALLOCATED(DstMiscData%F_HS)) THEN - ALLOCATE(DstMiscData%F_HS(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_HS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%F_HS = SrcMiscData%F_HS -ENDIF -IF (ALLOCATED(SrcMiscData%F_Waves1)) THEN - i1_l = LBOUND(SrcMiscData%F_Waves1,1) - i1_u = UBOUND(SrcMiscData%F_Waves1,1) - IF (.NOT. ALLOCATED(DstMiscData%F_Waves1)) THEN - ALLOCATE(DstMiscData%F_Waves1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_Waves1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%F_Waves1 = SrcMiscData%F_Waves1 -ENDIF -IF (ALLOCATED(SrcMiscData%F_Rdtn)) THEN - i1_l = LBOUND(SrcMiscData%F_Rdtn,1) - i1_u = UBOUND(SrcMiscData%F_Rdtn,1) - IF (.NOT. ALLOCATED(DstMiscData%F_Rdtn)) THEN - ALLOCATE(DstMiscData%F_Rdtn(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_Rdtn.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%F_Rdtn = SrcMiscData%F_Rdtn -ENDIF -IF (ALLOCATED(SrcMiscData%F_PtfmAM)) THEN - i1_l = LBOUND(SrcMiscData%F_PtfmAM,1) - i1_u = UBOUND(SrcMiscData%F_PtfmAM,1) - IF (.NOT. ALLOCATED(DstMiscData%F_PtfmAM)) THEN - ALLOCATE(DstMiscData%F_PtfmAM(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_PtfmAM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%F_PtfmAM = SrcMiscData%F_PtfmAM -ENDIF - CALL SS_Rad_CopyMisc( SrcMiscData%SS_Rdtn, DstMiscData%SS_Rdtn, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SS_Rad_CopyInput( SrcMiscData%SS_Rdtn_u, DstMiscData%SS_Rdtn_u, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SS_Rad_CopyOutput( SrcMiscData%SS_Rdtn_y, DstMiscData%SS_Rdtn_y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SS_Exc_CopyMisc( SrcMiscData%SS_Exctn, DstMiscData%SS_Exctn, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SS_Exc_CopyInput( SrcMiscData%SS_Exctn_u, DstMiscData%SS_Exctn_u, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SS_Exc_CopyOutput( SrcMiscData%SS_Exctn_y, DstMiscData%SS_Exctn_y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL Conv_Rdtn_CopyMisc( SrcMiscData%Conv_Rdtn, DstMiscData%Conv_Rdtn, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL Conv_Rdtn_CopyInput( SrcMiscData%Conv_Rdtn_u, DstMiscData%Conv_Rdtn_u, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL Conv_Rdtn_CopyOutput( SrcMiscData%Conv_Rdtn_y, DstMiscData%Conv_Rdtn_y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE WAMIT_CopyMisc - - SUBROUTINE WAMIT_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(WAMIT_MiscVarType), INTENT(INOUT) :: MiscData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT_DestroyMisc' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(MiscData%F_HS)) THEN - DEALLOCATE(MiscData%F_HS) -ENDIF -IF (ALLOCATED(MiscData%F_Waves1)) THEN - DEALLOCATE(MiscData%F_Waves1) -ENDIF -IF (ALLOCATED(MiscData%F_Rdtn)) THEN - DEALLOCATE(MiscData%F_Rdtn) -ENDIF -IF (ALLOCATED(MiscData%F_PtfmAM)) THEN - DEALLOCATE(MiscData%F_PtfmAM) -ENDIF - CALL SS_Rad_DestroyMisc( MiscData%SS_Rdtn, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SS_Rad_DestroyInput( MiscData%SS_Rdtn_u, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SS_Rad_DestroyOutput( MiscData%SS_Rdtn_y, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SS_Exc_DestroyMisc( MiscData%SS_Exctn, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SS_Exc_DestroyInput( MiscData%SS_Exctn_u, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SS_Exc_DestroyOutput( MiscData%SS_Exctn_y, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL Conv_Rdtn_DestroyMisc( MiscData%Conv_Rdtn, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL Conv_Rdtn_DestroyInput( MiscData%Conv_Rdtn_u, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL Conv_Rdtn_DestroyOutput( MiscData%Conv_Rdtn_y, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE WAMIT_DestroyMisc - - SUBROUTINE WAMIT_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(WAMIT_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 = 'WAMIT_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 ! LastIndWave - Int_BufSz = Int_BufSz + 1 ! F_HS allocated yes/no - IF ( ALLOCATED(InData%F_HS) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! F_HS upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_HS) ! F_HS - END IF - Int_BufSz = Int_BufSz + 1 ! F_Waves1 allocated yes/no - IF ( ALLOCATED(InData%F_Waves1) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! F_Waves1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_Waves1) ! F_Waves1 - END IF - Int_BufSz = Int_BufSz + 1 ! F_Rdtn allocated yes/no - IF ( ALLOCATED(InData%F_Rdtn) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! F_Rdtn upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_Rdtn) ! F_Rdtn - END IF - Int_BufSz = Int_BufSz + 1 ! F_PtfmAM allocated yes/no - IF ( ALLOCATED(InData%F_PtfmAM) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! F_PtfmAM upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_PtfmAM) ! F_PtfmAM - END IF - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! SS_Rdtn: size of buffers for each call to pack subtype - CALL SS_Rad_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%SS_Rdtn, ErrStat2, ErrMsg2, .TRUE. ) ! SS_Rdtn - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SS_Rdtn - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SS_Rdtn - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SS_Rdtn - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! SS_Rdtn_u: size of buffers for each call to pack subtype - CALL SS_Rad_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%SS_Rdtn_u, ErrStat2, ErrMsg2, .TRUE. ) ! SS_Rdtn_u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SS_Rdtn_u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SS_Rdtn_u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SS_Rdtn_u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! SS_Rdtn_y: size of buffers for each call to pack subtype - CALL SS_Rad_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%SS_Rdtn_y, ErrStat2, ErrMsg2, .TRUE. ) ! SS_Rdtn_y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SS_Rdtn_y - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SS_Rdtn_y - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SS_Rdtn_y - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! SS_Exctn: size of buffers for each call to pack subtype - CALL SS_Exc_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%SS_Exctn, ErrStat2, ErrMsg2, .TRUE. ) ! SS_Exctn - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SS_Exctn - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SS_Exctn - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SS_Exctn - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! SS_Exctn_u: size of buffers for each call to pack subtype - CALL SS_Exc_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%SS_Exctn_u, ErrStat2, ErrMsg2, .TRUE. ) ! SS_Exctn_u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SS_Exctn_u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SS_Exctn_u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SS_Exctn_u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! SS_Exctn_y: size of buffers for each call to pack subtype - CALL SS_Exc_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%SS_Exctn_y, ErrStat2, ErrMsg2, .TRUE. ) ! SS_Exctn_y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SS_Exctn_y - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SS_Exctn_y - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SS_Exctn_y - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! Conv_Rdtn: size of buffers for each call to pack subtype - CALL Conv_Rdtn_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%Conv_Rdtn, ErrStat2, ErrMsg2, .TRUE. ) ! Conv_Rdtn - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Conv_Rdtn - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Conv_Rdtn - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Conv_Rdtn - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! Conv_Rdtn_u: size of buffers for each call to pack subtype - CALL Conv_Rdtn_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Conv_Rdtn_u, ErrStat2, ErrMsg2, .TRUE. ) ! Conv_Rdtn_u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Conv_Rdtn_u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Conv_Rdtn_u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Conv_Rdtn_u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! Conv_Rdtn_y: size of buffers for each call to pack subtype - CALL Conv_Rdtn_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Conv_Rdtn_y, ErrStat2, ErrMsg2, .TRUE. ) ! Conv_Rdtn_y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Conv_Rdtn_y - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Conv_Rdtn_y - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Conv_Rdtn_y - 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 - - IntKiBuf(Int_Xferred) = InData%LastIndWave - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%F_HS) ) THEN - 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_HS,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_HS,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%F_HS,1), UBOUND(InData%F_HS,1) - ReKiBuf(Re_Xferred) = InData%F_HS(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%F_Waves1) ) THEN - 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_Waves1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_Waves1,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%F_Waves1,1), UBOUND(InData%F_Waves1,1) - ReKiBuf(Re_Xferred) = InData%F_Waves1(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%F_Rdtn) ) THEN - 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_Rdtn,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_Rdtn,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%F_Rdtn,1), UBOUND(InData%F_Rdtn,1) - ReKiBuf(Re_Xferred) = InData%F_Rdtn(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%F_PtfmAM) ) THEN - 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_PtfmAM,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_PtfmAM,1) - Int_Xferred = Int_Xferred + 2 - - 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 - END IF - CALL SS_Rad_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%SS_Rdtn, ErrStat2, ErrMsg2, OnlySize ) ! SS_Rdtn - 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 SS_Rad_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%SS_Rdtn_u, ErrStat2, ErrMsg2, OnlySize ) ! SS_Rdtn_u - 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 SS_Rad_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%SS_Rdtn_y, ErrStat2, ErrMsg2, OnlySize ) ! SS_Rdtn_y - 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 SS_Exc_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%SS_Exctn, ErrStat2, ErrMsg2, OnlySize ) ! SS_Exctn - 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 SS_Exc_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%SS_Exctn_u, ErrStat2, ErrMsg2, OnlySize ) ! SS_Exctn_u - 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 SS_Exc_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%SS_Exctn_y, ErrStat2, ErrMsg2, OnlySize ) ! SS_Exctn_y - 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 Conv_Rdtn_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%Conv_Rdtn, ErrStat2, ErrMsg2, OnlySize ) ! Conv_Rdtn - 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 Conv_Rdtn_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Conv_Rdtn_u, ErrStat2, ErrMsg2, OnlySize ) ! Conv_Rdtn_u - 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 Conv_Rdtn_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Conv_Rdtn_y, ErrStat2, ErrMsg2, OnlySize ) ! Conv_Rdtn_y - 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 WAMIT_PackMisc - - SUBROUTINE WAMIT_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(WAMIT_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 = 'WAMIT_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%LastIndWave = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_HS not allocated - Int_Xferred = Int_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_HS)) DEALLOCATE(OutData%F_HS) - ALLOCATE(OutData%F_HS(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_HS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%F_HS,1), UBOUND(OutData%F_HS,1) - OutData%F_HS(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_Waves1 not allocated - Int_Xferred = Int_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_Waves1)) DEALLOCATE(OutData%F_Waves1) - ALLOCATE(OutData%F_Waves1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_Waves1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%F_Waves1,1), UBOUND(OutData%F_Waves1,1) - OutData%F_Waves1(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_Rdtn not allocated - Int_Xferred = Int_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_Rdtn)) DEALLOCATE(OutData%F_Rdtn) - ALLOCATE(OutData%F_Rdtn(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_Rdtn.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%F_Rdtn,1), UBOUND(OutData%F_Rdtn,1) - OutData%F_Rdtn(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_PtfmAM not allocated - Int_Xferred = Int_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_PtfmAM)) DEALLOCATE(OutData%F_PtfmAM) - ALLOCATE(OutData%F_PtfmAM(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_PtfmAM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - 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 - 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 SS_Rad_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%SS_Rdtn, ErrStat2, ErrMsg2 ) ! SS_Rdtn - 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 SS_Rad_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%SS_Rdtn_u, ErrStat2, ErrMsg2 ) ! SS_Rdtn_u - 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 SS_Rad_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%SS_Rdtn_y, ErrStat2, ErrMsg2 ) ! SS_Rdtn_y - 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 SS_Exc_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%SS_Exctn, ErrStat2, ErrMsg2 ) ! SS_Exctn - 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 SS_Exc_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%SS_Exctn_u, ErrStat2, ErrMsg2 ) ! SS_Exctn_u - 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 SS_Exc_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%SS_Exctn_y, ErrStat2, ErrMsg2 ) ! SS_Exctn_y - 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 Conv_Rdtn_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%Conv_Rdtn, ErrStat2, ErrMsg2 ) ! Conv_Rdtn - 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 Conv_Rdtn_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Conv_Rdtn_u, ErrStat2, ErrMsg2 ) ! Conv_Rdtn_u - 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 Conv_Rdtn_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%Conv_Rdtn_y, ErrStat2, ErrMsg2 ) ! Conv_Rdtn_y - 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 WAMIT_UnPackMisc - - SUBROUTINE WAMIT_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(WAMIT_ParameterType), INTENT(IN) :: SrcParamData - TYPE(WAMIT_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 = 'WAMIT_CopyParam' -! + ErrMsg = '' + call Conv_Rdtn_DestroyDiscState(DiscStateData%Conv_Rdtn, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SS_Rad_DestroyDiscState(DiscStateData%SS_Rdtn, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SS_Exc_DestroyDiscState(DiscStateData%SS_Exctn, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(DiscStateData%BdyPosFilt)) then + deallocate(DiscStateData%BdyPosFilt) + end if +end subroutine + +subroutine WAMIT_PackDiscState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(WAMIT_DiscreteStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'WAMIT_PackDiscState' + if (RF%ErrStat >= AbortErrLev) return + call Conv_Rdtn_PackDiscState(RF, InData%Conv_Rdtn) + call SS_Rad_PackDiscState(RF, InData%SS_Rdtn) + call SS_Exc_PackDiscState(RF, InData%SS_Exctn) + call RegPackAlloc(RF, InData%BdyPosFilt) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine WAMIT_UnPackDiscState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(WAMIT_DiscreteStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'WAMIT_UnPackDiscState' + integer(B4Ki) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call Conv_Rdtn_UnpackDiscState(RF, OutData%Conv_Rdtn) ! Conv_Rdtn + call SS_Rad_UnpackDiscState(RF, OutData%SS_Rdtn) ! SS_Rdtn + call SS_Exc_UnpackDiscState(RF, OutData%SS_Exctn) ! SS_Exctn + call RegUnpackAlloc(RF, OutData%BdyPosFilt); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine WAMIT_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) + type(WAMIT_ConstraintStateType), intent(in) :: SrcConstrStateData + type(WAMIT_ConstraintStateType), intent(inout) :: DstConstrStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'WAMIT_CopyConstrState' ErrStat = ErrID_None - ErrMsg = "" - DstParamData%NBody = SrcParamData%NBody - DstParamData%NBodyMod = SrcParamData%NBodyMod -IF (ALLOCATED(SrcParamData%F_HS_Moment_Offset)) THEN - i1_l = LBOUND(SrcParamData%F_HS_Moment_Offset,1) - i1_u = UBOUND(SrcParamData%F_HS_Moment_Offset,1) - i2_l = LBOUND(SrcParamData%F_HS_Moment_Offset,2) - i2_u = UBOUND(SrcParamData%F_HS_Moment_Offset,2) - IF (.NOT. ALLOCATED(DstParamData%F_HS_Moment_Offset)) THEN - ALLOCATE(DstParamData%F_HS_Moment_Offset(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%F_HS_Moment_Offset.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%F_HS_Moment_Offset = SrcParamData%F_HS_Moment_Offset -ENDIF -IF (ALLOCATED(SrcParamData%HdroAdMsI)) THEN - i1_l = LBOUND(SrcParamData%HdroAdMsI,1) - i1_u = UBOUND(SrcParamData%HdroAdMsI,1) - i2_l = LBOUND(SrcParamData%HdroAdMsI,2) - i2_u = UBOUND(SrcParamData%HdroAdMsI,2) - IF (.NOT. ALLOCATED(DstParamData%HdroAdMsI)) THEN - ALLOCATE(DstParamData%HdroAdMsI(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%HdroAdMsI.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%HdroAdMsI = SrcParamData%HdroAdMsI -ENDIF -IF (ALLOCATED(SrcParamData%HdroSttc)) THEN - i1_l = LBOUND(SrcParamData%HdroSttc,1) - i1_u = UBOUND(SrcParamData%HdroSttc,1) - i2_l = LBOUND(SrcParamData%HdroSttc,2) - i2_u = UBOUND(SrcParamData%HdroSttc,2) - IF (.NOT. ALLOCATED(DstParamData%HdroSttc)) THEN - ALLOCATE(DstParamData%HdroSttc(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%HdroSttc.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%HdroSttc = SrcParamData%HdroSttc -ENDIF - DstParamData%RdtnMod = SrcParamData%RdtnMod - DstParamData%ExctnMod = SrcParamData%ExctnMod -IF (ALLOCATED(SrcParamData%WaveExctn)) THEN - i1_l = LBOUND(SrcParamData%WaveExctn,1) - i1_u = UBOUND(SrcParamData%WaveExctn,1) - i2_l = LBOUND(SrcParamData%WaveExctn,2) - i2_u = UBOUND(SrcParamData%WaveExctn,2) - IF (.NOT. ALLOCATED(DstParamData%WaveExctn)) THEN - ALLOCATE(DstParamData%WaveExctn(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WaveExctn.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%WaveExctn = SrcParamData%WaveExctn -ENDIF - DstParamData%NStepWave = SrcParamData%NStepWave - CALL Conv_Rdtn_CopyParam( SrcParamData%Conv_Rdtn, DstParamData%Conv_Rdtn, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SS_Rad_CopyParam( SrcParamData%SS_Rdtn, DstParamData%SS_Rdtn, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SS_Exc_CopyParam( SrcParamData%SS_Exctn, DstParamData%SS_Exctn, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstParamData%DT = SrcParamData%DT -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%NumOuts = SrcParamData%NumOuts - DstParamData%NumOutAll = SrcParamData%NumOutAll - DstParamData%OutFmt = SrcParamData%OutFmt - DstParamData%OutSFmt = SrcParamData%OutSFmt - DstParamData%Delim = SrcParamData%Delim - DstParamData%UnOutFile = SrcParamData%UnOutFile - END SUBROUTINE WAMIT_CopyParam - - SUBROUTINE WAMIT_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(WAMIT_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(ParamData%F_HS_Moment_Offset)) THEN - DEALLOCATE(ParamData%F_HS_Moment_Offset) -ENDIF -IF (ALLOCATED(ParamData%HdroAdMsI)) THEN - DEALLOCATE(ParamData%HdroAdMsI) -ENDIF -IF (ALLOCATED(ParamData%HdroSttc)) THEN - DEALLOCATE(ParamData%HdroSttc) -ENDIF -IF (ALLOCATED(ParamData%WaveExctn)) THEN - DEALLOCATE(ParamData%WaveExctn) -ENDIF - CALL Conv_Rdtn_DestroyParam( ParamData%Conv_Rdtn, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SS_Rad_DestroyParam( ParamData%SS_Rdtn, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SS_Exc_DestroyParam( ParamData%SS_Exctn, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(ParamData%OutParam)) THEN -DO i1 = LBOUND(ParamData%OutParam,1), UBOUND(ParamData%OutParam,1) - CALL NWTC_Library_Destroyoutparmtype( ParamData%OutParam(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ParamData%OutParam) -ENDIF - END SUBROUTINE WAMIT_DestroyParam - - SUBROUTINE WAMIT_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(WAMIT_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 = 'WAMIT_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 ! NBody - Int_BufSz = Int_BufSz + 1 ! NBodyMod - Int_BufSz = Int_BufSz + 1 ! F_HS_Moment_Offset allocated yes/no - IF ( ALLOCATED(InData%F_HS_Moment_Offset) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! F_HS_Moment_Offset upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_HS_Moment_Offset) ! F_HS_Moment_Offset - END IF - Int_BufSz = Int_BufSz + 1 ! HdroAdMsI allocated yes/no - IF ( ALLOCATED(InData%HdroAdMsI) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! HdroAdMsI upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%HdroAdMsI) ! HdroAdMsI - END IF - Int_BufSz = Int_BufSz + 1 ! HdroSttc allocated yes/no - IF ( ALLOCATED(InData%HdroSttc) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! HdroSttc upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%HdroSttc) ! HdroSttc - END IF - Int_BufSz = Int_BufSz + 1 ! RdtnMod - Int_BufSz = Int_BufSz + 1 ! ExctnMod - Int_BufSz = Int_BufSz + 1 ! WaveExctn allocated yes/no - IF ( ALLOCATED(InData%WaveExctn) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! WaveExctn upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveExctn) ! WaveExctn - END IF - Int_BufSz = Int_BufSz + 1 ! NStepWave - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! Conv_Rdtn: size of buffers for each call to pack subtype - CALL Conv_Rdtn_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%Conv_Rdtn, ErrStat2, ErrMsg2, .TRUE. ) ! Conv_Rdtn - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Conv_Rdtn - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Conv_Rdtn - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Conv_Rdtn - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! SS_Rdtn: size of buffers for each call to pack subtype - CALL SS_Rad_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%SS_Rdtn, ErrStat2, ErrMsg2, .TRUE. ) ! SS_Rdtn - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SS_Rdtn - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SS_Rdtn - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SS_Rdtn - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! SS_Exctn: size of buffers for each call to pack subtype - CALL SS_Exc_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%SS_Exctn, ErrStat2, ErrMsg2, .TRUE. ) ! SS_Exctn - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SS_Exctn - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SS_Exctn - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SS_Exctn - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Db_BufSz = Db_BufSz + 1 ! DT - 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 ! NumOuts - Int_BufSz = Int_BufSz + 1 ! NumOutAll - Int_BufSz = Int_BufSz + 1*LEN(InData%OutFmt) ! OutFmt - Int_BufSz = Int_BufSz + 1*LEN(InData%OutSFmt) ! OutSFmt - Int_BufSz = Int_BufSz + 1*LEN(InData%Delim) ! Delim - Int_BufSz = Int_BufSz + 1 ! UnOutFile - 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%NBody - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NBodyMod - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%F_HS_Moment_Offset) ) THEN - 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_HS_Moment_Offset,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_HS_Moment_Offset,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_HS_Moment_Offset,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_HS_Moment_Offset,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%F_HS_Moment_Offset,2), UBOUND(InData%F_HS_Moment_Offset,2) - DO i1 = LBOUND(InData%F_HS_Moment_Offset,1), UBOUND(InData%F_HS_Moment_Offset,1) - ReKiBuf(Re_Xferred) = InData%F_HS_Moment_Offset(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%HdroAdMsI) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%HdroAdMsI,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%HdroAdMsI,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%HdroAdMsI,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%HdroAdMsI,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%HdroAdMsI,2), UBOUND(InData%HdroAdMsI,2) - DO i1 = LBOUND(InData%HdroAdMsI,1), UBOUND(InData%HdroAdMsI,1) - ReKiBuf(Re_Xferred) = InData%HdroAdMsI(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%HdroSttc) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%HdroSttc,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%HdroSttc,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%HdroSttc,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%HdroSttc,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%HdroSttc,2), UBOUND(InData%HdroSttc,2) - DO i1 = LBOUND(InData%HdroSttc,1), UBOUND(InData%HdroSttc,1) - ReKiBuf(Re_Xferred) = InData%HdroSttc(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%RdtnMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%ExctnMod - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%WaveExctn) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveExctn,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveExctn,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveExctn,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveExctn,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%WaveExctn,2), UBOUND(InData%WaveExctn,2) - DO i1 = LBOUND(InData%WaveExctn,1), UBOUND(InData%WaveExctn,1) - ReKiBuf(Re_Xferred) = InData%WaveExctn(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NStepWave - Int_Xferred = Int_Xferred + 1 - CALL Conv_Rdtn_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%Conv_Rdtn, ErrStat2, ErrMsg2, OnlySize ) ! Conv_Rdtn - 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 SS_Rad_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%SS_Rdtn, ErrStat2, ErrMsg2, OnlySize ) ! SS_Rdtn - 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 SS_Exc_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%SS_Exctn, ErrStat2, ErrMsg2, OnlySize ) ! SS_Exctn - 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 - DbKiBuf(Db_Xferred) = InData%DT - Db_Xferred = Db_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 - IntKiBuf(Int_Xferred) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumOutAll - 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 - DO I = 1, LEN(InData%OutSFmt) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutSFmt(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - 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) = InData%UnOutFile - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE WAMIT_PackParam - - SUBROUTINE WAMIT_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(WAMIT_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 = 'WAMIT_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%NBody = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NBodyMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_HS_Moment_Offset not allocated - Int_Xferred = Int_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_HS_Moment_Offset)) DEALLOCATE(OutData%F_HS_Moment_Offset) - ALLOCATE(OutData%F_HS_Moment_Offset(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_HS_Moment_Offset.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%F_HS_Moment_Offset,2), UBOUND(OutData%F_HS_Moment_Offset,2) - DO i1 = LBOUND(OutData%F_HS_Moment_Offset,1), UBOUND(OutData%F_HS_Moment_Offset,1) - OutData%F_HS_Moment_Offset(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! HdroAdMsI not allocated - Int_Xferred = Int_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%HdroAdMsI)) DEALLOCATE(OutData%HdroAdMsI) - ALLOCATE(OutData%HdroAdMsI(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%HdroAdMsI.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%HdroAdMsI,2), UBOUND(OutData%HdroAdMsI,2) - DO i1 = LBOUND(OutData%HdroAdMsI,1), UBOUND(OutData%HdroAdMsI,1) - OutData%HdroAdMsI(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! HdroSttc not allocated - Int_Xferred = Int_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%HdroSttc)) DEALLOCATE(OutData%HdroSttc) - ALLOCATE(OutData%HdroSttc(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%HdroSttc.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%HdroSttc,2), UBOUND(OutData%HdroSttc,2) - DO i1 = LBOUND(OutData%HdroSttc,1), UBOUND(OutData%HdroSttc,1) - OutData%HdroSttc(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%RdtnMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%ExctnMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveExctn not allocated - Int_Xferred = Int_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%WaveExctn)) DEALLOCATE(OutData%WaveExctn) - ALLOCATE(OutData%WaveExctn(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveExctn.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%WaveExctn,2), UBOUND(OutData%WaveExctn,2) - DO i1 = LBOUND(OutData%WaveExctn,1), UBOUND(OutData%WaveExctn,1) - OutData%WaveExctn(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%NStepWave = IntKiBuf(Int_Xferred) - 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 Conv_Rdtn_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%Conv_Rdtn, ErrStat2, ErrMsg2 ) ! Conv_Rdtn - 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 SS_Rad_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%SS_Rdtn, ErrStat2, ErrMsg2 ) ! SS_Rdtn - 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 SS_Exc_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%SS_Exctn, ErrStat2, ErrMsg2 ) ! SS_Exctn - 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%DT = DbKiBuf(Db_Xferred) - Db_Xferred = Db_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 - OutData%NumOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumOutAll = IntKiBuf(Int_Xferred) - 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 - DO I = 1, LEN(OutData%OutSFmt) - OutData%OutSFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%Delim) - OutData%Delim(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%UnOutFile = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE WAMIT_UnPackParam - - SUBROUTINE WAMIT_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(WAMIT_InputType), INTENT(INOUT) :: SrcInputData - TYPE(WAMIT_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 = 'WAMIT_CopyInput' -! + ErrMsg = '' + call Conv_Rdtn_CopyConstrState(SrcConstrStateData%Conv_Rdtn, DstConstrStateData%Conv_Rdtn, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SS_Rad_CopyConstrState(SrcConstrStateData%SS_Rdtn, DstConstrStateData%SS_Rdtn, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SS_Exc_CopyConstrState(SrcConstrStateData%SS_Exctn, DstConstrStateData%SS_Exctn, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine WAMIT_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) + type(WAMIT_ConstraintStateType), intent(inout) :: ConstrStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'WAMIT_DestroyConstrState' ErrStat = ErrID_None - ErrMsg = "" - CALL MeshCopy( SrcInputData%Mesh, DstInputData%Mesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE WAMIT_CopyInput - - SUBROUTINE WAMIT_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(WAMIT_InputType), INTENT(INOUT) :: InputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT_DestroyInput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL MeshDestroy( InputData%Mesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE WAMIT_DestroyInput - - SUBROUTINE WAMIT_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(WAMIT_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 = 'WAMIT_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 ! Mesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%Mesh, 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 - 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%Mesh, 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 SUBROUTINE WAMIT_PackInput - - SUBROUTINE WAMIT_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(WAMIT_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 = 'WAMIT_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%Mesh, 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 SUBROUTINE WAMIT_UnPackInput - - SUBROUTINE WAMIT_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(WAMIT_OutputType), INTENT(INOUT) :: SrcOutputData - TYPE(WAMIT_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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT_CopyOutput' -! + ErrMsg = '' + call Conv_Rdtn_DestroyConstrState(ConstrStateData%Conv_Rdtn, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SS_Rad_DestroyConstrState(ConstrStateData%SS_Rdtn, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SS_Exc_DestroyConstrState(ConstrStateData%SS_Exctn, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine WAMIT_PackConstrState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(WAMIT_ConstraintStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'WAMIT_PackConstrState' + if (RF%ErrStat >= AbortErrLev) return + call Conv_Rdtn_PackConstrState(RF, InData%Conv_Rdtn) + call SS_Rad_PackConstrState(RF, InData%SS_Rdtn) + call SS_Exc_PackConstrState(RF, InData%SS_Exctn) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine WAMIT_UnPackConstrState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(WAMIT_ConstraintStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'WAMIT_UnPackConstrState' + if (RF%ErrStat /= ErrID_None) return + call Conv_Rdtn_UnpackConstrState(RF, OutData%Conv_Rdtn) ! Conv_Rdtn + call SS_Rad_UnpackConstrState(RF, OutData%SS_Rdtn) ! SS_Rdtn + call SS_Exc_UnpackConstrState(RF, OutData%SS_Exctn) ! SS_Exctn +end subroutine + +subroutine WAMIT_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) + type(WAMIT_OtherStateType), intent(in) :: SrcOtherStateData + type(WAMIT_OtherStateType), intent(inout) :: DstOtherStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'WAMIT_CopyOtherState' ErrStat = ErrID_None - ErrMsg = "" - CALL MeshCopy( SrcOutputData%Mesh, DstOutputData%Mesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE WAMIT_CopyOutput - - SUBROUTINE WAMIT_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(WAMIT_OutputType), INTENT(INOUT) :: OutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT_DestroyOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL MeshDestroy( OutputData%Mesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE WAMIT_DestroyOutput - - SUBROUTINE WAMIT_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(WAMIT_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 = 'WAMIT_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 ! Mesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%Mesh, 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 - 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%Mesh, 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 SUBROUTINE WAMIT_PackOutput - - SUBROUTINE WAMIT_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(WAMIT_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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT_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%Mesh, 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 SUBROUTINE WAMIT_UnPackOutput - - - SUBROUTINE WAMIT_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(WAMIT_InputType), INTENT(INOUT) :: u(:) ! Input at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Inputs - TYPE(WAMIT_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 + ErrMsg = '' + call SS_Rad_CopyOtherState(SrcOtherStateData%SS_Rdtn, DstOtherStateData%SS_Rdtn, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SS_Exc_CopyOtherState(SrcOtherStateData%SS_Exctn, DstOtherStateData%SS_Exctn, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call Conv_Rdtn_CopyOtherState(SrcOtherStateData%Conv_Rdtn, DstOtherStateData%Conv_Rdtn, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine WAMIT_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) + type(WAMIT_OtherStateType), intent(inout) :: OtherStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'WAMIT_DestroyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + call SS_Rad_DestroyOtherState(OtherStateData%SS_Rdtn, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SS_Exc_DestroyOtherState(OtherStateData%SS_Exctn, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call Conv_Rdtn_DestroyOtherState(OtherStateData%Conv_Rdtn, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine WAMIT_PackOtherState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(WAMIT_OtherStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'WAMIT_PackOtherState' + if (RF%ErrStat >= AbortErrLev) return + call SS_Rad_PackOtherState(RF, InData%SS_Rdtn) + call SS_Exc_PackOtherState(RF, InData%SS_Exctn) + call Conv_Rdtn_PackOtherState(RF, InData%Conv_Rdtn) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine WAMIT_UnPackOtherState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(WAMIT_OtherStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'WAMIT_UnPackOtherState' + if (RF%ErrStat /= ErrID_None) return + call SS_Rad_UnpackOtherState(RF, OutData%SS_Rdtn) ! SS_Rdtn + call SS_Exc_UnpackOtherState(RF, OutData%SS_Exctn) ! SS_Exctn + call Conv_Rdtn_UnpackOtherState(RF, OutData%Conv_Rdtn) ! Conv_Rdtn +end subroutine + +subroutine WAMIT_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(WAMIT_MiscVarType), intent(in) :: SrcMiscData + type(WAMIT_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'WAMIT_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + DstMiscData%LastIndWave = SrcMiscData%LastIndWave + if (allocated(SrcMiscData%F_HS)) then + LB(1:1) = lbound(SrcMiscData%F_HS) + UB(1:1) = ubound(SrcMiscData%F_HS) + if (.not. allocated(DstMiscData%F_HS)) then + allocate(DstMiscData%F_HS(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_HS.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%F_HS = SrcMiscData%F_HS + end if + if (allocated(SrcMiscData%F_Waves1)) then + LB(1:1) = lbound(SrcMiscData%F_Waves1) + UB(1:1) = ubound(SrcMiscData%F_Waves1) + if (.not. allocated(DstMiscData%F_Waves1)) then + allocate(DstMiscData%F_Waves1(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_Waves1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%F_Waves1 = SrcMiscData%F_Waves1 + end if + if (allocated(SrcMiscData%F_Rdtn)) then + LB(1:1) = lbound(SrcMiscData%F_Rdtn) + UB(1:1) = ubound(SrcMiscData%F_Rdtn) + if (.not. allocated(DstMiscData%F_Rdtn)) then + allocate(DstMiscData%F_Rdtn(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_Rdtn.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%F_Rdtn = SrcMiscData%F_Rdtn + end if + if (allocated(SrcMiscData%F_PtfmAM)) then + LB(1:1) = lbound(SrcMiscData%F_PtfmAM) + UB(1:1) = ubound(SrcMiscData%F_PtfmAM) + if (.not. allocated(DstMiscData%F_PtfmAM)) then + allocate(DstMiscData%F_PtfmAM(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_PtfmAM.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%F_PtfmAM = SrcMiscData%F_PtfmAM + end if + call SS_Rad_CopyMisc(SrcMiscData%SS_Rdtn, DstMiscData%SS_Rdtn, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SS_Rad_CopyInput(SrcMiscData%SS_Rdtn_u, DstMiscData%SS_Rdtn_u, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SS_Rad_CopyOutput(SrcMiscData%SS_Rdtn_y, DstMiscData%SS_Rdtn_y, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SS_Exc_CopyMisc(SrcMiscData%SS_Exctn, DstMiscData%SS_Exctn, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SS_Exc_CopyInput(SrcMiscData%SS_Exctn_u, DstMiscData%SS_Exctn_u, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SS_Exc_CopyOutput(SrcMiscData%SS_Exctn_y, DstMiscData%SS_Exctn_y, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call Conv_Rdtn_CopyMisc(SrcMiscData%Conv_Rdtn, DstMiscData%Conv_Rdtn, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call Conv_Rdtn_CopyInput(SrcMiscData%Conv_Rdtn_u, DstMiscData%Conv_Rdtn_u, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call Conv_Rdtn_CopyOutput(SrcMiscData%Conv_Rdtn_y, DstMiscData%Conv_Rdtn_y, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SeaSt_WaveField_CopyMisc(SrcMiscData%WaveField_m, DstMiscData%WaveField_m, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine WAMIT_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(WAMIT_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'WAMIT_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(MiscData%F_HS)) then + deallocate(MiscData%F_HS) + end if + if (allocated(MiscData%F_Waves1)) then + deallocate(MiscData%F_Waves1) + end if + if (allocated(MiscData%F_Rdtn)) then + deallocate(MiscData%F_Rdtn) + end if + if (allocated(MiscData%F_PtfmAM)) then + deallocate(MiscData%F_PtfmAM) + end if + call SS_Rad_DestroyMisc(MiscData%SS_Rdtn, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SS_Rad_DestroyInput(MiscData%SS_Rdtn_u, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SS_Rad_DestroyOutput(MiscData%SS_Rdtn_y, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SS_Exc_DestroyMisc(MiscData%SS_Exctn, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SS_Exc_DestroyInput(MiscData%SS_Exctn_u, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SS_Exc_DestroyOutput(MiscData%SS_Exctn_y, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call Conv_Rdtn_DestroyMisc(MiscData%Conv_Rdtn, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call Conv_Rdtn_DestroyInput(MiscData%Conv_Rdtn_u, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call Conv_Rdtn_DestroyOutput(MiscData%Conv_Rdtn_y, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SeaSt_WaveField_DestroyMisc(MiscData%WaveField_m, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine WAMIT_PackMisc(RF, Indata) + type(RegFile), intent(inout) :: RF + type(WAMIT_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'WAMIT_PackMisc' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%LastIndWave) + call RegPackAlloc(RF, InData%F_HS) + call RegPackAlloc(RF, InData%F_Waves1) + call RegPackAlloc(RF, InData%F_Rdtn) + call RegPackAlloc(RF, InData%F_PtfmAM) + call SS_Rad_PackMisc(RF, InData%SS_Rdtn) + call SS_Rad_PackInput(RF, InData%SS_Rdtn_u) + call SS_Rad_PackOutput(RF, InData%SS_Rdtn_y) + call SS_Exc_PackMisc(RF, InData%SS_Exctn) + call SS_Exc_PackInput(RF, InData%SS_Exctn_u) + call SS_Exc_PackOutput(RF, InData%SS_Exctn_y) + call Conv_Rdtn_PackMisc(RF, InData%Conv_Rdtn) + call Conv_Rdtn_PackInput(RF, InData%Conv_Rdtn_u) + call Conv_Rdtn_PackOutput(RF, InData%Conv_Rdtn_y) + call SeaSt_WaveField_PackMisc(RF, InData%WaveField_m) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine WAMIT_UnPackMisc(RF, OutData) + type(RegFile), intent(inout) :: RF + type(WAMIT_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'WAMIT_UnPackMisc' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%LastIndWave); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%F_HS); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%F_Waves1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%F_Rdtn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%F_PtfmAM); if (RegCheckErr(RF, RoutineName)) return + call SS_Rad_UnpackMisc(RF, OutData%SS_Rdtn) ! SS_Rdtn + call SS_Rad_UnpackInput(RF, OutData%SS_Rdtn_u) ! SS_Rdtn_u + call SS_Rad_UnpackOutput(RF, OutData%SS_Rdtn_y) ! SS_Rdtn_y + call SS_Exc_UnpackMisc(RF, OutData%SS_Exctn) ! SS_Exctn + call SS_Exc_UnpackInput(RF, OutData%SS_Exctn_u) ! SS_Exctn_u + call SS_Exc_UnpackOutput(RF, OutData%SS_Exctn_y) ! SS_Exctn_y + call Conv_Rdtn_UnpackMisc(RF, OutData%Conv_Rdtn) ! Conv_Rdtn + call Conv_Rdtn_UnpackInput(RF, OutData%Conv_Rdtn_u) ! Conv_Rdtn_u + call Conv_Rdtn_UnpackOutput(RF, OutData%Conv_Rdtn_y) ! Conv_Rdtn_y + call SeaSt_WaveField_UnpackMisc(RF, OutData%WaveField_m) ! WaveField_m +end subroutine + +subroutine WAMIT_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(WAMIT_ParameterType), intent(in) :: SrcParamData + type(WAMIT_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(5), UB(5) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'WAMIT_CopyParam' + ErrStat = ErrID_None + ErrMsg = '' + DstParamData%NBody = SrcParamData%NBody + DstParamData%NBodyMod = SrcParamData%NBodyMod + if (allocated(SrcParamData%F_HS_Moment_Offset)) then + LB(1:2) = lbound(SrcParamData%F_HS_Moment_Offset) + UB(1:2) = ubound(SrcParamData%F_HS_Moment_Offset) + if (.not. allocated(DstParamData%F_HS_Moment_Offset)) then + allocate(DstParamData%F_HS_Moment_Offset(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%F_HS_Moment_Offset.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%F_HS_Moment_Offset = SrcParamData%F_HS_Moment_Offset + end if + if (allocated(SrcParamData%HdroAdMsI)) then + LB(1:2) = lbound(SrcParamData%HdroAdMsI) + UB(1:2) = ubound(SrcParamData%HdroAdMsI) + if (.not. allocated(DstParamData%HdroAdMsI)) then + allocate(DstParamData%HdroAdMsI(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%HdroAdMsI.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%HdroAdMsI = SrcParamData%HdroAdMsI + end if + if (allocated(SrcParamData%HdroSttc)) then + LB(1:2) = lbound(SrcParamData%HdroSttc) + UB(1:2) = ubound(SrcParamData%HdroSttc) + if (.not. allocated(DstParamData%HdroSttc)) then + allocate(DstParamData%HdroSttc(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%HdroSttc.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%HdroSttc = SrcParamData%HdroSttc + end if + DstParamData%RdtnMod = SrcParamData%RdtnMod + DstParamData%ExctnMod = SrcParamData%ExctnMod + DstParamData%ExctnDisp = SrcParamData%ExctnDisp + DstParamData%ExctnCutOff = SrcParamData%ExctnCutOff + DstParamData%NExctnHdg = SrcParamData%NExctnHdg + DstParamData%ExctnFiltConst = SrcParamData%ExctnFiltConst + if (allocated(SrcParamData%WaveExctn)) then + LB(1:3) = lbound(SrcParamData%WaveExctn) + UB(1:3) = ubound(SrcParamData%WaveExctn) + if (.not. allocated(DstParamData%WaveExctn)) then + allocate(DstParamData%WaveExctn(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WaveExctn.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%WaveExctn = SrcParamData%WaveExctn + end if + if (allocated(SrcParamData%WaveExctnGrid)) then + LB(1:5) = lbound(SrcParamData%WaveExctnGrid) + UB(1:5) = ubound(SrcParamData%WaveExctnGrid) + if (.not. allocated(DstParamData%WaveExctnGrid)) then + allocate(DstParamData%WaveExctnGrid(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WaveExctnGrid.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%WaveExctnGrid = SrcParamData%WaveExctnGrid + end if + call Conv_Rdtn_CopyParam(SrcParamData%Conv_Rdtn, DstParamData%Conv_Rdtn, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SS_Rad_CopyParam(SrcParamData%SS_Rdtn, DstParamData%SS_Rdtn, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SS_Exc_CopyParam(SrcParamData%SS_Exctn, DstParamData%SS_Exctn, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstParamData%DT = SrcParamData%DT + DstParamData%WaveField => SrcParamData%WaveField + DstParamData%PtfmYMod = SrcParamData%PtfmYMod + call SeaSt_WaveField_CopyParam(SrcParamData%ExctnGridParams, DstParamData%ExctnGridParams, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine WAMIT_DestroyParam(ParamData, ErrStat, ErrMsg) + type(WAMIT_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'WAMIT_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ParamData%F_HS_Moment_Offset)) then + deallocate(ParamData%F_HS_Moment_Offset) + end if + if (allocated(ParamData%HdroAdMsI)) then + deallocate(ParamData%HdroAdMsI) + end if + if (allocated(ParamData%HdroSttc)) then + deallocate(ParamData%HdroSttc) + end if + if (allocated(ParamData%WaveExctn)) then + deallocate(ParamData%WaveExctn) + end if + if (allocated(ParamData%WaveExctnGrid)) then + deallocate(ParamData%WaveExctnGrid) + end if + call Conv_Rdtn_DestroyParam(ParamData%Conv_Rdtn, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SS_Rad_DestroyParam(ParamData%SS_Rdtn, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SS_Exc_DestroyParam(ParamData%SS_Exctn, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + nullify(ParamData%WaveField) + call SeaSt_WaveField_DestroyParam(ParamData%ExctnGridParams, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine WAMIT_PackParam(RF, Indata) + type(RegFile), intent(inout) :: RF + type(WAMIT_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'WAMIT_PackParam' + logical :: PtrInIndex + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%NBody) + call RegPack(RF, InData%NBodyMod) + call RegPackAlloc(RF, InData%F_HS_Moment_Offset) + call RegPackAlloc(RF, InData%HdroAdMsI) + call RegPackAlloc(RF, InData%HdroSttc) + call RegPack(RF, InData%RdtnMod) + call RegPack(RF, InData%ExctnMod) + call RegPack(RF, InData%ExctnDisp) + call RegPack(RF, InData%ExctnCutOff) + call RegPack(RF, InData%NExctnHdg) + call RegPack(RF, InData%ExctnFiltConst) + call RegPackAlloc(RF, InData%WaveExctn) + call RegPackAlloc(RF, InData%WaveExctnGrid) + call Conv_Rdtn_PackParam(RF, InData%Conv_Rdtn) + call SS_Rad_PackParam(RF, InData%SS_Rdtn) + call SS_Exc_PackParam(RF, InData%SS_Exctn) + call RegPack(RF, InData%DT) + call RegPack(RF, associated(InData%WaveField)) + if (associated(InData%WaveField)) then + call RegPackPointer(RF, c_loc(InData%WaveField), PtrInIndex) + if (.not. PtrInIndex) then + call SeaSt_WaveField_PackSeaSt_WaveFieldType(RF, InData%WaveField) + end if + end if + call RegPack(RF, InData%PtfmYMod) + call SeaSt_WaveField_PackParam(RF, InData%ExctnGridParams) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine WAMIT_UnPackParam(RF, OutData) + type(RegFile), intent(inout) :: RF + type(WAMIT_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'WAMIT_UnPackParam' + integer(B4Ki) :: LB(5), UB(5) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(B8Ki) :: PtrIdx + type(c_ptr) :: Ptr + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%NBody); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NBodyMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%F_HS_Moment_Offset); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%HdroAdMsI); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%HdroSttc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RdtnMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ExctnMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ExctnDisp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ExctnCutOff); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NExctnHdg); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ExctnFiltConst); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WaveExctn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WaveExctnGrid); if (RegCheckErr(RF, RoutineName)) return + call Conv_Rdtn_UnpackParam(RF, OutData%Conv_Rdtn) ! Conv_Rdtn + call SS_Rad_UnpackParam(RF, OutData%SS_Rdtn) ! SS_Rdtn + call SS_Exc_UnpackParam(RF, OutData%SS_Exctn) ! SS_Exctn + call RegUnpack(RF, OutData%DT); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%WaveField)) deallocate(OutData%WaveField) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackPointer(RF, Ptr, PtrIdx); if (RegCheckErr(RF, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveField) + else + allocate(OutData%WaveField,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveField.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + RF%Pointers(PtrIdx) = c_loc(OutData%WaveField) + call SeaSt_WaveField_UnpackSeaSt_WaveFieldType(RF, OutData%WaveField) ! WaveField + end if + else + OutData%WaveField => null() + end if + call RegUnpack(RF, OutData%PtfmYMod); if (RegCheckErr(RF, RoutineName)) return + call SeaSt_WaveField_UnpackParam(RF, OutData%ExctnGridParams) ! ExctnGridParams +end subroutine + +subroutine WAMIT_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) + type(WAMIT_InputType), intent(inout) :: SrcInputData + type(WAMIT_InputType), intent(inout) :: DstInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'WAMIT_CopyInput' + ErrStat = ErrID_None + ErrMsg = '' + call MeshCopy(SrcInputData%Mesh, DstInputData%Mesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstInputData%PtfmRefY = SrcInputData%PtfmRefY +end subroutine + +subroutine WAMIT_DestroyInput(InputData, ErrStat, ErrMsg) + type(WAMIT_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'WAMIT_DestroyInput' + ErrStat = ErrID_None + ErrMsg = '' + call MeshDestroy( InputData%Mesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine WAMIT_PackInput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(WAMIT_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'WAMIT_PackInput' + if (RF%ErrStat >= AbortErrLev) return + call MeshPack(RF, InData%Mesh) + call RegPack(RF, InData%PtfmRefY) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine WAMIT_UnPackInput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(WAMIT_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'WAMIT_UnPackInput' + if (RF%ErrStat /= ErrID_None) return + call MeshUnpack(RF, OutData%Mesh) ! Mesh + call RegUnpack(RF, OutData%PtfmRefY); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine WAMIT_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(WAMIT_OutputType), intent(inout) :: SrcOutputData + type(WAMIT_OutputType), intent(inout) :: DstOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'WAMIT_CopyOutput' + ErrStat = ErrID_None + ErrMsg = '' + call MeshCopy(SrcOutputData%Mesh, DstOutputData%Mesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine WAMIT_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(WAMIT_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'WAMIT_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' + call MeshDestroy( OutputData%Mesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine WAMIT_PackOutput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(WAMIT_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'WAMIT_PackOutput' + if (RF%ErrStat >= AbortErrLev) return + call MeshPack(RF, InData%Mesh) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine WAMIT_UnPackOutput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(WAMIT_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'WAMIT_UnPackOutput' + if (RF%ErrStat /= ErrID_None) return + call MeshUnpack(RF, OutData%Mesh) ! Mesh +end subroutine + +subroutine WAMIT_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(WAMIT_InputType), intent(inout) :: u(:) ! Input at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Inputs + type(WAMIT_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 = 'WAMIT_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 WAMIT_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL WAMIT_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 WAMIT_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 WAMIT_Input_ExtrapInterp - - - SUBROUTINE WAMIT_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'WAMIT_Input_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(u)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(u)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(u) - 1 + select case (order) + case (0) + call WAMIT_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call WAMIT_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call WAMIT_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(u) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE WAMIT_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. @@ -5437,41 +1213,43 @@ SUBROUTINE WAMIT_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMs ! !.................................................................................................................................. - TYPE(WAMIT_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 - TYPE(WAMIT_InputType), INTENT(INOUT) :: u2 ! Input at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs - TYPE(WAMIT_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 + TYPE(WAMIT_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 + TYPE(WAMIT_InputType), INTENT(INOUT) :: u2 ! Input at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs + TYPE(WAMIT_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 = 'WAMIT_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 + REAL(DbKi) :: t(2) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT_Input_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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%Mesh, u2%Mesh, tin, u_out%Mesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - END SUBROUTINE WAMIT_Input_ExtrapInterp1 - - - SUBROUTINE WAMIT_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + CALL MeshExtrapInterp1(u1%Mesh, u2%Mesh, tin, u_out%Mesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + u_out%PtfmRefY = a1*u1%PtfmRefY + a2*u2%PtfmRefY +END SUBROUTINE + +SUBROUTINE WAMIT_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. @@ -5485,101 +1263,103 @@ SUBROUTINE WAMIT_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, E ! !.................................................................................................................................. - TYPE(WAMIT_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 > t3 - TYPE(WAMIT_InputType), INTENT(INOUT) :: u2 ! Input at t2 > t3 - TYPE(WAMIT_InputType), INTENT(INOUT) :: u3 ! Input at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs - TYPE(WAMIT_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 + TYPE(WAMIT_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 > t3 + TYPE(WAMIT_InputType), INTENT(INOUT) :: u2 ! Input at t2 > t3 + TYPE(WAMIT_InputType), INTENT(INOUT) :: u3 ! Input at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs + TYPE(WAMIT_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 = 'WAMIT_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) - + 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) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT_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 + 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 + 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 + 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%Mesh, u2%Mesh, u3%Mesh, tin, u_out%Mesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - END SUBROUTINE WAMIT_Input_ExtrapInterp2 - - - SUBROUTINE WAMIT_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(WAMIT_OutputType), INTENT(INOUT) :: y(:) ! Output at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Outputs - TYPE(WAMIT_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 + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + CALL MeshExtrapInterp2(u1%Mesh, u2%Mesh, u3%Mesh, tin, u_out%Mesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + u_out%PtfmRefY = a1*u1%PtfmRefY + a2*u2%PtfmRefY + a3*u3%PtfmRefY +END SUBROUTINE + +subroutine WAMIT_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(WAMIT_OutputType), intent(inout) :: y(:) ! Output at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Outputs + type(WAMIT_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 = 'WAMIT_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 WAMIT_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL WAMIT_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 WAMIT_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 WAMIT_Output_ExtrapInterp - - - SUBROUTINE WAMIT_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'WAMIT_Output_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(y)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(y)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(y) - 1 + select case (order) + case (0) + call WAMIT_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call WAMIT_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call WAMIT_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(y) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE WAMIT_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. @@ -5591,41 +1371,42 @@ SUBROUTINE WAMIT_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrM ! !.................................................................................................................................. - TYPE(WAMIT_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 - TYPE(WAMIT_OutputType), INTENT(INOUT) :: y2 ! Output at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs - TYPE(WAMIT_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 + TYPE(WAMIT_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 + TYPE(WAMIT_OutputType), INTENT(INOUT) :: y2 ! Output at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs + TYPE(WAMIT_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 = 'WAMIT_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 - ! 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 + REAL(DbKi) :: t(2) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT_Output_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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(y1%Mesh, y2%Mesh, tin, y_out%Mesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - END SUBROUTINE WAMIT_Output_ExtrapInterp1 - - - SUBROUTINE WAMIT_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + CALL MeshExtrapInterp1(y1%Mesh, y2%Mesh, tin, y_out%Mesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) +END SUBROUTINE + +SUBROUTINE WAMIT_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. @@ -5639,47 +1420,47 @@ SUBROUTINE WAMIT_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ! !.................................................................................................................................. - TYPE(WAMIT_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 > t3 - TYPE(WAMIT_OutputType), INTENT(INOUT) :: y2 ! Output at t2 > t3 - TYPE(WAMIT_OutputType), INTENT(INOUT) :: y3 ! Output at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs - TYPE(WAMIT_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 + TYPE(WAMIT_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 > t3 + TYPE(WAMIT_OutputType), INTENT(INOUT) :: y2 ! Output at t2 > t3 + TYPE(WAMIT_OutputType), INTENT(INOUT) :: y3 ! Output at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs + TYPE(WAMIT_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 = 'WAMIT_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) - + 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) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT_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 + 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 + 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 + 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%Mesh, y2%Mesh, y3%Mesh, tin, y_out%Mesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - END SUBROUTINE WAMIT_Output_ExtrapInterp2 - + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + CALL MeshExtrapInterp2(y1%Mesh, y2%Mesh, y3%Mesh, tin, y_out%Mesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) +END SUBROUTINE END MODULE WAMIT_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/hydrodyn/src/Waves.f90 b/modules/hydrodyn/src/Waves.f90 deleted file mode 100644 index 8934278e16..0000000000 --- a/modules/hydrodyn/src/Waves.f90 +++ /dev/null @@ -1,2511 +0,0 @@ -!********************************************************************************************************************************** -! The Waves and Waves_Types modules make up a template for creating user-defined calculations in the FAST Modularization -! Framework. Waves_Types will be auto-generated based on a description of the variables for the module. -!.................................................................................................................................. -! LICENSING -! Copyright (C) 2013-2015 National Renewable Energy Laboratory -! -! This file is part of Waves. -! -! 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 Waves - - USE Waves_Types - USE UserWaves - USE NWTC_Library - USE NWTC_FFTPACK - USE NWTC_RandomNumber - - IMPLICIT NONE - - PRIVATE - - TYPE(ProgDesc), PARAMETER :: Waves_ProgDesc = ProgDesc( 'Waves', '', '' ) - - - ! ..... @mhall: Public variables for hard-coded wave kinematics grid (temporary solution) ........................... - - INTEGER, PUBLIC :: WaveGrid_n = 0 !150 Number of wave kinematics grid points = nx*ny*nz - ! - !REAL(SiKi), PUBLIC :: WaveGrid_x0 = -35.0 ! first grid point in x direction - !REAL(SiKi), PUBLIC :: WaveGrid_dx = 10.0 ! step size in x direction - !INTEGER, PUBLIC :: WaveGrid_nx = 10 ! Number of wave kinematics grid points in x - ! - !REAL(SiKi), PUBLIC :: WaveGrid_y0 = -35.0 ! same for y - !REAL(SiKi), PUBLIC :: WaveGrid_dy = 35.0 - !INTEGER, PUBLIC :: WaveGrid_ny = 3 - ! - !INTEGER, PUBLIC :: WaveGrid_nz = 5 ! Number of wave kinematics grid points in z (locations decided by 1.0 - 2.0**(WaveGrid_nz-I)) - - - ! ..... Public Subroutines ................................................................................................... - PUBLIC :: WavePkShpDefault ! Return the default value of the peak shape parameter of the incident wave spectrum - PUBLIC :: Waves_Init ! Initialization routine - PUBLIC :: Waves_End ! Ending routine (includes clean up) - - - PRIVATE:: WheelerStretching ! This FUNCTION applies the principle of Wheeler stretching to (1-Forward) find the elevation where the wave kinematics are to be applied using Wheeler stretching or (2-Backword) - PRIVATE:: BoxMuller - PRIVATE:: JONSWAP - PUBLIC :: WaveNumber - PRIVATE:: UserWaveSpctrm - PRIVATE:: StillWaterWaves_Init - PRIVATE:: VariousWaves_Init - ! PRIVATE:: WhiteNoiseWaves_Init - -CONTAINS - -!======================================================================= - - FUNCTION WavePkShpDefault ( Hs, Tp ) - - - ! This FUNCTION is used to return the default value of the peak shape - ! parameter of the incident wave spectrum, conditioned on significant - ! wave height and peak spectral period. - ! - ! There are several different versions of the JONSWAP spectrum - ! formula. This version is based on the one documented in the - ! IEC61400-3 wind turbine design standard for offshore wind turbines. - - - - IMPLICIT NONE - - - ! Passed Variables: - - REAL(SiKi), INTENT(IN ) :: Hs ! Significant wave height (meters) - REAL(SiKi), INTENT(IN ) :: Tp ! Peak spectral period (sec) - REAL(SiKi) :: WavePkShpDefault ! This function = default value of the peak shape parameter of the incident wave spectrum conditioned on significant wave height and peak spectral period (-) - - - ! Local Variables: - - REAL(SiKi) :: TpOvrSqrtHs ! = Tp/SQRT(Hs) (s/SQRT(m)) - - - - ! Compute the default peak shape parameter of the incident wave spectrum, - ! conditioned on significant wave height and peak spectral period: - - TpOvrSqrtHs = Tp/SQRT(Hs) - - IF ( TpOvrSqrtHs <= 3.6 ) THEN - WavePkShpDefault = 5.0 - ELSEIF ( TpOvrSqrtHs >= 5.0 ) THEN - WavePkShpDefault = 1.0 - ELSE - WavePkShpDefault = EXP( 5.75 - 1.15*TpOvrSqrtHs ) - END IF - - - - RETURN - END FUNCTION WavePkShpDefault - -!======================================================================= - FUNCTION BoxMuller ( RNGType, NDAmp, Phase ) - - ! This FUNCTION uses the Box-Muller method to turn two uniformly - ! distributed randoms into two unit normal randoms, which are - ! returned as real and imaginary components. - - IMPLICIT NONE - - COMPLEX(SiKi) :: BoxMuller ! This function - - ! Passed Variables: - - INTEGER, INTENT(IN) :: RNGType - LOGICAL, INTENT(IN) :: NDAmp ! Flag for normally-distributed amplitudes - REAL(SiKi), INTENT(IN), OPTIONAL :: Phase ! Optional phase to override random phase (radians) - - ! Local Variables: - - REAL(SiKi) :: C1 ! Intermediate variable - REAL(SiKi) :: C2 ! Intermediate variable - REAL(SiKi) :: U1(1) ! First uniformly distributed random - REAL(SiKi) :: U2(1) ! Second uniformly distributed random - - ! Compute the two uniformly distributed randoms: - ! NOTE: The first random, U1, cannot be zero else the LOG() function - ! below will blow up; there is no restriction on the value of the - ! second random, U2. - - U1 = 0.0 - DO WHILE ( U1(1) == 0.0 ) - CALL UniformRandomNumbers(RNGType, U1) - END DO - CALL UniformRandomNumbers(RNGType, U2) - - ! Compute intermediate variables: - - IF ( NDAmp ) THEN ! Normally-distributed amplitudes - C1 = SQRT( -2.0*LOG(U1(1)) ) - ELSE ! Constant amplitudes (ignore U1); therefore, C1 = SQRT( 2.0 ) = MEAN( SQRT( -2.0*LOG(U1) ) for a uniform distribution of U1 between 0 and 1 - C1 = SQRT( 2.0 ) - END IF - - IF ( PRESENT( Phase ) ) THEN ! Specified phase to replace random phase (ignore U2) - C2 = Phase - ELSE ! Uniformly-distributed phase - C2 = TwoPi*U2(1) - END IF - - ! Compute the unit normal randoms: - - BoxMuller = CMPLX( C1*COS(C2), C1*SIN(C2) ) - - RETURN - END FUNCTION BoxMuller -!======================================================================= - FUNCTION JONSWAP ( Omega, Hs, Tp, Gamma ) - - - ! This FUNCTION computes the JOint North Sea WAve Project - ! (JONSWAP) representation of the one-sided power spectral density - ! or wave spectrum given the frequency, Omega, peak shape - ! parameter, Gamma, significant wave height, Hs, and peak spectral - ! period, Tp, as inputs. If the value of Gamma is 1.0, the - ! Pierson-Moskowitz wave spectrum is returned. - ! - ! There are several different versions of the JONSWAP spectrum - ! formula. This version is based on the one documented in the - ! IEC61400-3 wind turbine design standard for offshore wind - ! turbines. - - - - - IMPLICIT NONE - - - ! Passed Variables: - - REAL(SiKi), INTENT(IN ) :: Gamma ! Peak shape parameter (-) - REAL(SiKi), INTENT(IN ) :: Hs ! Significant wave height (meters) - REAL(SiKi) :: JONSWAP ! This function = JONSWAP wave spectrum, S (m^2/(rad/s)) - REAL(SiKi), INTENT(IN ) :: Omega ! Wave frequency (rad/s) - REAL(SiKi), INTENT(IN ) :: Tp ! Peak spectral period (sec) - - - ! Local Variables: - - REAL(SiKi) :: Alpha ! Exponent on Gamma used in the spectral formulation (-) - REAL(SiKi) :: C ! Normalising factor used in the spectral formulation (-) - REAL(SiKi) :: f ! Wave frequency (Hz) - REAL(SiKi) :: fp ! Peak spectral frequency (Hz) - REAL(SiKi) :: fpOvrf4 ! (fp/f)^4 - REAL(SiKi) :: Sigma ! Scaling factor used in the spectral formulation (-) - - REAL(SiKi) :: Inv2Pi = 0.15915494 - - ! Compute the JONSWAP wave spectrum, unless Omega is zero, in which case, - ! return zero: - - IF ( EqualRealNos(Omega, 0.0_SiKi) ) THEN ! When .TRUE., the formulation below is ill-conditioned; thus, the known value of zero is returned. - - - JONSWAP = 0.0 - - - ELSE ! Omega > 0.0; forumulate the JONSWAP spectrum. - - - ! Compute the wave frequency and peak spectral frequency in Hz: - - f = Inv2Pi*Omega - fp = 1/Tp - fpOvrf4 = (fp/f)**4 - - - ! Compute the normalising factor: - - C = 1.0 - ( 0.287*LOG(GAMMA) ) - - - ! Compute Alpha: - - IF ( f <= fp ) THEN - Sigma = 0.07 - ELSE - Sigma = 0.09 - END IF - -!bjj: Alpha = EXP( ( -0.5*( ( (f/fp) - 1.0 )/Sigma )**2 ) ) - Alpha = EXP( ( -0.5*( ( (f*Tp) - 1.0 )/Sigma )**2 ) ) !this works even if Tp is 0 (but using f/fp doesn't) - - - ! Compute the wave spectrum: - - JONSWAP = Inv2Pi*C*( 0.3125*Hs*Hs*fpOvrf4/f )*EXP( ( -1.25*fpOvrf4 ) )*( GAMMA**Alpha ) - - - END IF - - - - RETURN - END FUNCTION JONSWAP - !======================================================================= -!JASON: MOVE THIS USER-DEFINED ROUTINE (UserWaveSpctrm) TO THE UserSubs.f90 OF HydroDyn WHEN THE PLATFORM LOADING FUNCTIONALITY HAS BEEN DOCUMENTED!!!!! - SUBROUTINE UserWaveSpctrm ( Omega, WaveDir, DirRoot, WaveS1Sdd ) - - - ! This is a dummy routine for holding the place of a user-specified - ! wave spectrum. Modify this code to create your own spectrum. - - - - IMPLICIT NONE - - - ! Passed Variables: - - REAL(SiKi), INTENT(IN ) :: Omega ! Wave frequency, rad/s. - REAL(SiKi), INTENT(IN ) :: WaveDir ! Incident wave propagation heading direction, degrees - REAL(SiKi), INTENT(OUT) :: WaveS1Sdd ! One-sided power spectral density of the wave spectrum per unit time for the current frequency component and heading direction, m^2/(rad/s). - - 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. - - - - WaveS1Sdd = 0.0 - - - - RETURN - END SUBROUTINE UserWaveSpctrm - !======================================================================= - FUNCTION WaveNumber ( Omega, g, h ) - - - ! This FUNCTION solves the finite depth dispersion relationship: - ! - ! k*tanh(k*h)=(Omega^2)/g - ! - ! for k, the wavenumber (WaveNumber) given the frequency, Omega, - ! gravitational constant, g, and water depth, h, as inputs. A - ! high order initial guess is used in conjunction with a quadratic - ! Newton's method for the solution with seven significant digits - ! accuracy using only one iteration pass. The method is due to - ! Professor J.N. Newman of M.I.T. as found in routine EIGVAL of - ! the SWIM-MOTION-LINES (SML) software package in source file - ! Solve.f of the SWIM module. - - - - IMPLICIT NONE - - - ! Passed Variables: - - REAL(ReKi), INTENT(IN ) :: g ! Gravitational acceleration (m/s^2) - REAL(SiKi), INTENT(IN ) :: h ! Water depth (meters) - REAL(SiKi), INTENT(IN ) :: Omega ! Wave frequency (rad/s) - REAL(SiKi) :: WaveNumber ! This function = wavenumber, k (1/m) - - - ! Local Variables: - - REAL(SiKi) :: A ! A temporary variable used in the solution. - REAL(SiKi) :: B ! A temporary variable used in the solution. - REAL(SiKi) :: C ! A temporary variable used in the solution. - REAL(SiKi) :: C2 ! A temporary variable used in the solution. - REAL(SiKi) :: CC ! A temporary variable used in the solution. - REAL(SiKi) :: E2 ! A temporary variable used in the solution. - REAL(SiKi) :: X0 ! A temporary variable used in the solution. - - - - ! Compute the wavenumber, unless Omega is zero, in which case, return - ! zero: - - IF ( Omega == 0.0 ) THEN ! When .TRUE., the formulation below is ill-conditioned; thus, the known value of zero is returned. - - - WaveNumber = 0.0 - - - ELSE ! Omega > 0.0; solve for the wavenumber as usual. - - - C = Omega*Omega*h/REAL(g,SiKi) - CC = C*C - - - ! Find X0: - - IF ( C <= 2.0 ) THEN - - X0 = SQRT(C)*( 1.0 + C*( 0.169 + (0.031*C) ) ) - - ELSE - - E2 = EXP(-2.0*C) - - X0 = C*( 1.0 + ( E2*( 2.0 - (12.0*E2) ) ) ) - - END IF - - - ! Find the WaveNumber: - - IF ( C <= 4.8 ) THEN - - C2 = CC - X0*X0 - A = 1.0/( C - C2 ) - B = A*( ( 0.5*LOG( ( X0 + C )/( X0 - C ) ) ) - X0 ) - - WaveNumber = ( X0 - ( B*C2*( 1.0 + (A*B*C*X0) ) ) )/h - - ELSE - - WaveNumber = X0/h - - END IF - - - END IF - - - - RETURN - END FUNCTION WaveNumber - - !======================================================================= - FUNCTION COSHNumOvrCOSHDen ( k, h, z ) - - - ! This FUNCTION computes the shallow water hyperbolic numerator - ! over denominator term in the wave kinematics expressions: - ! - ! COSH( k*( z + h ) )/COSH( k*h ) - ! - ! given the wave number, k, water depth, h, and elevation z, as - ! inputs. - - IMPLICIT NONE - - - ! Passed Variables: - - REAL(SiKi) :: COSHNumOvrCOSHDen ! This function = COSH( k*( z + h ) )/COSH( k*h ) (-) - REAL(SiKi), INTENT(IN ) :: h ! Water depth ( h > 0 ) (meters) - REAL(SiKi), INTENT(IN ) :: k ! Wave number ( k >= 0 ) (1/m) - REAL(SiKi), INTENT(IN ) :: z ! Elevation (-h <= z <= 0 ) (meters) - - - - ! Compute the hyperbolic numerator over denominator: - - IF ( k*h > 89.4_SiKi ) THEN ! When .TRUE., the shallow water formulation will trigger a floating point overflow error; however, COSH( k*( z + h ) )/COSH( k*h ) = EXP( k*z ) + EXP( -k*( z + 2*h ) ) for large k*h. This equals the deep water formulation, EXP( k*z ), except near z = -h, because h > 14.23*wavelength (since k = 2*Pi/wavelength) in this case. - - COSHNumOvrCOSHDen = EXP( k*z ) + EXP( -k*( z + 2.0_SiKi*h ) ) - - ELSE ! 0 < k*h <= 89.4; use the shallow water formulation. - - COSHNumOvrCOSHDen =REAL( COSH( k*( z + h ) ),R8Ki)/COSH( k*h ) - - END IF - - - - RETURN - END FUNCTION COSHNumOvrCOSHDen -!======================================================================= - FUNCTION COSHNumOvrSINHDen ( k, h, z ) - - - ! This FUNCTION computes the shallow water hyperbolic numerator - ! over denominator term in the wave kinematics expressions: - ! - ! COSH( k*( z + h ) )/SINH( k*h ) - ! - ! given the wave number, k, water depth, h, and elevation z, as - ! inputs. - - - - IMPLICIT NONE - - - ! Passed Variables: - - REAL(SiKi) :: COSHNumOvrSINHDen ! This function = COSH( k*( z + h ) )/SINH( k*h ) (-) - REAL(SiKi), INTENT(IN ) :: h ! Water depth ( h > 0 ) (meters) - REAL(SiKi), INTENT(IN ) :: k ! Wave number ( k >= 0 ) (1/m) - REAL(SiKi), INTENT(IN ) :: z ! Elevation (-h <= z <= 0 ) (meters) - - - - ! Compute the hyperbolic numerator over denominator: - - - IF ( k < EPSILON(0.0_SiKi) ) THEN ! When .TRUE., the shallow water formulation is ill-conditioned; thus, HUGE(k) is returned to approximate the known value of infinity. - - COSHNumOvrSINHDen = HUGE( k ) - - ELSEIF ( k*h > 89.4_SiKi ) THEN ! When .TRUE., the shallow water formulation will trigger a floating point overflow error; however, COSH( k*( z + h ) )/SINH( k*h ) = EXP( k*z ) + EXP( -k*( z + 2*h ) ) for large k*h. This equals the deep water formulation, EXP( k*z ), except near z = -h, because h > 14.23*wavelength (since k = 2*Pi/wavelength) in this case. - - COSHNumOvrSINHDen = EXP( k*z ) + EXP( -k*( z + 2*h ) ) - - ELSE ! 0 < k*h <= 89.4; use the shallow water formulation. - - COSHNumOvrSINHDen = COSH( k*( z + h ) )/SINH( k*h ) - - END IF - - - - RETURN - END FUNCTION COSHNumOvrSINHDen -!======================================================================= - FUNCTION COTH ( X ) - - - ! This FUNCTION computes the hyperbolic cotangent, - ! COSH(X)/SINH(X). - - - USE Precision - - - IMPLICIT NONE - - - ! Passed Variables: - - REAL(SiKi) :: COTH ! This function = COSH( X )/SINH( X ) (-) - REAL(SiKi), INTENT(IN ) :: X ! The argument (-) - - - - ! Compute the hyperbolic cotangent: - - IF ( X == 0.0_SiKi ) THEN ! When .TRUE., the formulation below is ill-conditioned; thus, HUGE(X) is returned to approximate the known value of infinity. - - COTH = HUGE( X ) - - ELSE ! X /= 0.0; use the numerically-stable computation of COTH(X) by means of TANH(X). - - COTH = 1.0_SiKi/TANH( X ) ! = COSH( X )/SINH( X ) - - END IF - - - - RETURN - END FUNCTION COTH - - !======================================================================= - FUNCTION SINHNumOvrSINHDen ( k, h, z ) - - - ! This FUNCTION computes the shallow water hyperbolic numerator - ! over denominator term in the wave kinematics expressions: - ! - ! SINH( k*( z + h ) )/SINH( k*h ) - ! - ! given the wave number, k, water depth, h, and elevation z, as - ! inputs. - - - IMPLICIT NONE - - - ! Passed Variables: - - REAL(SiKi) :: SINHNumOvrSINHDen ! This function = SINH( k*( z + h ) )/SINH( k*h ) (-) - REAL(SiKi), INTENT(IN ) :: h ! Water depth ( h > 0 ) (meters) - REAL(SiKi), INTENT(IN ) :: k ! Wave number ( k >= 0 ) (1/m) - REAL(SiKi), INTENT(IN ) :: z ! Elevation (-h <= z <= 0 ) (meters) - - - - ! Compute the hyperbolic numerator over denominator: - - IF ( k == 0.0_SiKi ) THEN ! When .TRUE., the shallow water formulation is ill-conditioned; thus, the known value of unity is returned. - - SINHNumOvrSINHDen = 1.0 - - ELSEIF ( k*h > 89.4_SiKi ) THEN ! When .TRUE., the shallow water formulation will trigger a floating point overflow error; however, SINH( k*( z + h ) )/SINH( k*h ) = EXP( k*z ) - EXP( -k*( z + 2*h ) ) for large k*h. This equals the deep water formulation, EXP( k*z ), except near z = -h, because h > 14.23*wavelength (since k = 2*Pi/wavelength) in this case. - - SINHNumOvrSINHDen = EXP( k*z ) - EXP( -k*( z + 2.0_SiKi*h ) ) - - ELSE ! 0 < k*h <= 89.4; use the shallow water formulation. - - SINHNumOvrSINHDen = SINH( k*( z + h ) )/SINH( k*h ) - - END IF - - - - RETURN - END FUNCTION SINHNumOvrSINHDen - - - -!---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE StillWaterWaves_Init ( InitInp, InitOut, ErrStat, ErrMsg ) -! This routine initializes the waves data for WaveMod = 0 , or still water waves option -!---------------------------------------------------------------------------------------------------------------------------------- - - - TYPE(Waves_InitInputType), INTENT(IN ) :: InitInp ! Input data for initialization routine - TYPE(Waves_InitOutputType), INTENT(INOUT) :: InitOut ! Initialization output data - 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 ! Generic index - INTEGER(IntKi) :: ErrStatTmp ! Temporary error status - - ! Initialize ErrStat - - ErrStat = ErrID_None - ErrStatTmp = ErrID_None - ErrMsg = "" - - - ! Initialize everything to zero: - - InitOut%NStepWave = 2 ! We must have at least two elements in order to interpolate later on - InitOut%NStepWave2 = 1 - - ALLOCATE ( InitOut%WaveTime (0:InitOut%NStepWave ) , STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array InitOut%WaveTime.', ErrStat,ErrMsg,'StillWaterWaves_Init') - ALLOCATE ( InitOut%WaveElev0 (0:InitOut%NStepWave ), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array InitOut%WaveElev0.', ErrStat,ErrMsg,'StillWaterWaves_Init') - ALLOCATE ( InitOut%WaveElevC0 (2, 0:InitOut%NStepWave2 ) , STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array InitOut%WaveElevC0.',ErrStat,ErrMsg,'StillWaterWaves_Init') - - ALLOCATE ( InitOut%WaveElev (0:InitOut%NStepWave,InitInp%NWaveElev ) , STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array InitOut%WaveElev.', ErrStat,ErrMsg,'StillWaterWaves_Init') - - ALLOCATE ( InitOut%WaveDynP (0:InitOut%NStepWave,InitInp%NWaveKin ) , STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array InitOut%WaveDynP.', ErrStat,ErrMsg,'StillWaterWaves_Init') - - ALLOCATE ( InitOut%WaveVel (0:InitOut%NStepWave,InitInp%NWaveKin,3) , STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array InitOut%WaveVel.', ErrStat,ErrMsg,'StillWaterWaves_Init') - - ALLOCATE ( InitOut%WaveAcc (0:InitOut%NStepWave,InitInp%NWaveKin,3) , STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array InitOut%WaveAcc.', ErrStat,ErrMsg,'StillWaterWaves_Init') - - ALLOCATE ( InitOut%PWaveDynP0 (0:InitOut%NStepWave,InitInp%NWaveKin ) , STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array InitOut%PWaveDynP0.', ErrStat,ErrMsg,'StillWaterWaves_Init') - - ALLOCATE ( InitOut%PWaveVel0 (0:InitOut%NStepWave,InitInp%NWaveKin,3) , STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array InitOut%PWaveVel0.', ErrStat,ErrMsg,'StillWaterWaves_Init') - - ALLOCATE ( InitOut%PWaveAcc0 (0:InitOut%NStepWave,InitInp%NWaveKin,3) , STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array InitOut%PWaveAcc0.', ErrStat,ErrMsg,'StillWaterWaves_Init') - - ALLOCATE ( InitOut%nodeInWater(0:InitOut%NStepWave,InitInp%NWaveKin ) , STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array InitOut%nodeInWater.', ErrStat,ErrMsg,'StillWaterWaves_Init') - - ALLOCATE ( InitOut%WaveDirArr (0:InitOut%NStepWave2 ) , STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array InitOut%WaveDirArr.',ErrStat,ErrMsg,'StillWaterWaves_Init') - - - IF ( ErrStat >= AbortErrLev ) RETURN - - InitOut%WaveDOmega = 0.0 - InitOut%WaveTime = (/ 0.0_DbKi, 1.0_DbKi, 2.0_DbKi /) ! We must have at least two different time steps in the interpolation - InitOut%WaveElev0 = 0.0 - InitOut%WaveElevC0 = 0.0 - InitOut%WaveElev = 0.0 - InitOut%PWaveDynP0 = 0.0 - InitOut%PWaveVel0 = 0.0 - InitOut%PWaveAcc0 = 0.0 - InitOut%WaveDynP = 0.0 - InitOut%WaveVel = 0.0 - InitOut%WaveAcc = 0.0 - InitOut%WaveDirArr = 0.0 - - ! For creating animations of the sea surface, the WaveElevXY array is passed in with a series of x,y coordinates - ! (index 1). The second index corresponds to the number of points passed in. A two dimensional time series - ! is created with the first index corresponding to the timestep, and second index corresponding to the second - ! index of the WaveElevXY array. - IF ( ALLOCATED(InitInp%WaveElevXY)) THEN - ALLOCATE ( InitOut%WaveElevSeries (0:InitOut%NStepWave, 1:SIZE(InitInp%WaveElevXY, DIM=2)) , STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) THEN - CALL SetErrStat(ErrID_Fatal,'Cannot allocate array InitOut%WaveElevSeries.',ErrStat,ErrMsg,'VariousWaves_Init') - RETURN - END IF - ! Calculate the wave elevation at all points requested in the array WaveElevXY - DO I = 0,InitOut%NStepWave - DO J = 1,SIZE(InitInp%WaveElevXY, DIM=2) - InitOut%WaveElevSeries(I,J) = 0.0_ReKi - ENDDO - ENDDO - ENDIF - - - ! Add the current velocities to the wave velocities: - - DO J = 1,InitInp%NWaveKin ! Loop through all Morison element nodes where the incident wave kinematics will be computed - - InitOut%WaveVel(:,J,1) = InitInp%CurrVxi(J) ! xi-direction - InitOut%WaveVel(:,J,2) = InitInp%CurrVyi(J) ! yi-direction - IF ( InitInp%WaveKinzi(J) >= -InitInp%WtrDpth .AND. InitInp%WaveKinzi(J) <= 0 ) THEN - - InitOut%nodeInWater(:, J) = 1 - ELSE - InitOut%nodeInWater(:, J) = 0 - END IF - END DO ! J - All points where the incident wave kinematics will be computed - -END SUBROUTINE StillWaterWaves_Init - - -!---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE VariousWaves_Init ( InitInp, InitOut, ErrStat, ErrMsg ) -! Compute the wave kinematics and related information for Plane progressive (regular) wave, JONSWAP/Pierson-Moskowitz spectrum -! (irregular) wave, or user-defined spectrum (irregular) wave. -!---------------------------------------------------------------------------------------------------------------------------------- - - TYPE(Waves_InitInputType), INTENT(IN ) :: InitInp ! Input data for initialization routine - TYPE(Waves_InitOutputType), INTENT(INOUT) :: InitOut ! Output data - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None - - - - ! Local Variables - COMPLEX(SiKi), PARAMETER :: ImagNmbr = (0.0,1.0) ! The imaginary number, SQRT(-1.0) - COMPLEX(SiKi) :: ImagOmega ! = ImagNmbr*Omega (rad/s) - ! REAL(SiKi), ALLOCATABLE :: WaveElev0 (:) ! Instantaneous elevation of incident waves at the platform reference point (meters) - !COMPLEX(SiKi), ALLOCATABLE :: PWaveAccC0HxiPz0 (:,:) ! Partial derivative of WaveAccC0Hxi(:) with respect to zi at zi = 0 (1/s^2) - !COMPLEX(SiKi), ALLOCATABLE :: PWaveAccC0HyiPz0 (:,:) ! Partial derivative of WaveAccC0Hyi(:) with respect to zi at zi = 0 (1/s^2) - !COMPLEX(SiKi), ALLOCATABLE :: PWaveAccC0VPz0 (:,:) ! Partial derivative of WaveAccC0V (:) with respect to zi at zi = 0 (1/s^2) - !COMPLEX(SiKi), ALLOCATABLE :: PWaveDynPC0BPz0(:,:) ! Partial derivative of WaveDynPC0B (:) with respect to zi at zi = 0 (N/m ) - !COMPLEX(SiKi), ALLOCATABLE :: PWaveVelC0HxiPz0 (:,:) ! Partial derivative of WaveVelC0Hxi(:) with respect to zi at zi = 0 (1/s ) - !COMPLEX(SiKi), ALLOCATABLE :: PWaveVelC0HyiPz0 (:,:) ! Partial derivative of WaveVelC0Hyi(:) with respect to zi at zi = 0 (1/s ) - !COMPLEX(SiKi), ALLOCATABLE :: PWaveVelC0VPz0 (:,:) ! Partial derivative of WaveVelC0V (:) with respect to zi at zi = 0 (1/s ) - COMPLEX(SiKi), ALLOCATABLE :: WaveAccC0Hxi(:,:) ! Discrete Fourier transform of the instantaneous horizontal acceleration in x-direction of incident waves before applying stretching at the zi-coordinates for points (m/s^2) - COMPLEX(SiKi), ALLOCATABLE :: WaveAccC0Hyi(:,:) ! Discrete Fourier transform of the instantaneous horizontal acceleration in y-direction of incident waves before applying stretching at the zi-coordinates for points (m/s^2) - COMPLEX(SiKi), ALLOCATABLE :: WaveAccC0V(:,:) ! Discrete Fourier transform of the instantaneous vertical acceleration of incident waves before applying stretching at the zi-coordinates for points (m/s^2) - COMPLEX(SiKi), ALLOCATABLE :: WaveDynPC0(:,:) ! Discrete Fourier transform of the instantaneous dynamic pressure of incident waves before applying stretching at the zi-coordinates for points (N/m^2) - COMPLEX(SiKi), ALLOCATABLE :: WaveElevC (:,:) ! Discrete Fourier transform of the instantaneous elevation of incident waves (meters) - COMPLEX(SiKi), ALLOCATABLE :: WaveVelC0Hxi(:,:) ! Discrete Fourier transform of the instantaneous horizontal velocity of incident waves before applying stretching at the zi-coordinates for points (m/s) - COMPLEX(SiKi), ALLOCATABLE :: WaveVelC0Hyi(:,:) ! Discrete Fourier transform of the instantaneous horizontal velocity in x-direction of incident waves before applying stretching at the zi-coordinates for points (m/s) - COMPLEX(SiKi), ALLOCATABLE :: WaveVelC0V(:,:) ! Discrete Fourier transform of the instantaneous vertical velocity in y-direction of incident waves before applying stretching at the zi-coordinates for points (m/s) - COMPLEX(SiKi) :: WGNC ! Discrete Fourier transform of the realization of a White Gaussian Noise (WGN) time series process with unit variance for the current frequency component (-) -! REAL(SiKi) :: CurrVxi ! xi-component of the current velocity at the instantaneous elevation (m/s) -! REAL(SiKi) :: CurrVyi ! yi-component of the current velocity at the instantaneous elevation (m/s) -! REAL(SiKi) :: CurrVxi0 ! xi-component of the current velocity at zi = 0.0 meters (m/s) -! REAL(SiKi) :: CurrVyi0 ! yi-component of the current velocity at zi = 0.0 meters (m/s) -! REAL(SiKi) :: CurrVxiS ! xi-component of the current velocity at zi = -SmllNmbr meters (m/s) -! REAL(SiKi) :: CurrVyiS ! yi-component of the current velocity at zi = -SmllNmbr meters (m/s) - REAL(SiKi), ALLOCATABLE :: CosWaveDir(:) ! COS( WaveDirArr(I) ) -- Each wave frequency has a unique wave direction. - REAL(SiKi), ALLOCATABLE :: GHWaveAcc (:,:) ! Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, at each of the GHNWvDpth vertical locations in GH Bladed wave data files (m/s^2) - REAL(SiKi), ALLOCATABLE :: GHWaveDynP(: ) ! Instantaneous dynamic pressure of incident waves at each of the GHNWvDpth vertical locations in GH Bladed wave data files (N/m^2) -! REAL(SiKi) :: GHWaveTime ! Instantaneous simulation times in GH Bladed wave data files (sec) - REAL(SiKi), ALLOCATABLE :: GHWaveVel (:,:) ! Instantaneous velocity of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, at each of the GHNWvDpth vertical locations in GH Bladed wave data files (m/s ) - REAL(SiKi), ALLOCATABLE :: GHWvDpth (:) ! Vertical locations in GH Bladed wave data files. -!UNUSED: !REAL(SiKi), PARAMETER :: n_Massel = 3.0 ! Factor used to the scale the peak spectral frequency in order to find the cut-off frequency based on the suggestion in: Massel, S. R., Ocean Surface Waves: Their Physics and Prediction, Advanced Series on Ocean Engineering - Vol. 11, World Scientific Publishing, Singapore - New Jersey - London - Hong Kong, 1996. This reference recommends n_Massel > 3.0 (higher for higher-order wave kinemetics); the ">" designation is accounted for by checking if ( Omega > OmegaCutOff ). - REAL(SiKi) :: Omega ! Wave frequency (rad/s) -!UNUSED: !REAL(SiKi) :: OmegaCutOff ! Cut-off frequency or upper frequency limit of the wave spectrum beyond which the wave spectrum is zeroed (rad/s) -!UNUSED: ! REAL(SiKi) :: PCurrVxiPz0 ! Partial derivative of CurrVxi with respect to zi at zi = 0 (1/s ) -!UNUSED: ! REAL(SiKi) :: PCurrVyiPz0 ! Partial derivative of CurrVyi with respect to zi at zi = 0 (1/s ) - !REAL(SiKi), ALLOCATABLE :: PWaveAcc0HxiPz0(:,:) ! Partial derivative of WaveAcc0Hxi(:) with respect to zi at zi = 0 (1/s^2) - !REAL(SiKi), ALLOCATABLE :: PWaveAcc0HyiPz0(:,:) ! Partial derivative of WaveAcc0Hyi(:) with respect to zi at zi = 0 (1/s^2) - !REAL(SiKi), ALLOCATABLE :: PWaveAcc0VPz0 (:,:) ! Partial derivative of WaveAcc0V (:) with respect to zi at zi = 0 (1/s^2) - !REAL(SiKi), ALLOCATABLE :: PWaveDynP0BPz0 (:,:) ! Partial derivative of WaveDynP0B (:) with respect to zi at zi = 0 (N/m ) - !REAL(SiKi), ALLOCATABLE :: PWaveVel0HxiPz0(:,:) ! Partial derivative of WaveVel0Hxi(:) with respect to zi at zi = 0 (1/s ) - !REAL(SiKi), ALLOCATABLE :: PWaveVel0HyiPz0(:,:) ! Partial derivative of WaveVel0Hyi(:) with respect to zi at zi = 0 (1/s ) - !REAL(SiKi), ALLOCATABLE :: PWaveVel0VPz0 (:,:) ! Partial derivative of WaveVel0V (:) with respect to zi at zi = 0 (1/s ) -! REAL(SiKi) :: Slope ! Miscellanous slope used in an interpolation (-) - REAL(SiKi), PARAMETER :: SmllNmbr = 9.999E-4 ! A small number representing epsilon for taking numerical derivatives. !bjj: how about using SQRT(EPSILON())? - REAL(SiKi) :: SQRTNStepWave2 ! SQRT( NStepWave/2 ) - REAL(SiKi), ALLOCATABLE :: SinWaveDir (:) ! SIN( WaveDirArr(I) ) - REAL(SiKi), ALLOCATABLE :: WaveAcc0Hxi (:,:) ! Instantaneous horizontal acceleration in x-direction of incident waves before applying stretching at the zi-coordinates for points (m/s^2) - REAL(SiKi), ALLOCATABLE :: WaveAcc0Hyi (:,:) ! Instantaneous horizontal acceleration in y-direction of incident waves before applying stretching at the zi-coordinates for points (m/s^2) -!UNUSED: for future wave stretching -! REAL(SiKi) :: WaveAcc0HxiExtrap ! Temporary value extrapolated from the WaveAcc0Hxi(:,:) array (m/s^2) -! REAL(SiKi) :: WaveAcc0HxiExtrap ! Temporary value extrapolated from the WaveAcc0Hxi(:,:) array (m/s^2) -! REAL(SiKi) :: WaveAcc0HyiInterp ! Temporary value interpolated from the WaveAcc0Hyi(:,:) array (m/s^2) -! REAL(SiKi) :: WaveAcc0HyiInterp ! Temporary value interpolated from the WaveAcc0Hyi(:,:) array (m/s^2) - REAL(SiKi), ALLOCATABLE :: WaveAcc0V (:,:) ! Instantaneous vertical acceleration of incident waves before applying stretching at the zi-coordinates for points (m/s^2) -!UNUSED: for future wave stretching -! REAL(SiKi) :: WaveAcc0VExtrap ! Temporary value extrapolated from the WaveAcc0V (:,:) array (m/s^2) -! REAL(SiKi) :: WaveAcc0VInterp ! Temporary value interpolated from the WaveAcc0V (:,:) array (m/s^2) - REAL(SiKi), ALLOCATABLE :: WaveDynP0B(:,:) ! Instantaneous dynamic pressure of incident waves before applying stretching at the zi-coordinates for points (N/m^2) -!UNUSED: for future wave stretching -! REAL(SiKi) :: WaveDynP0BExtrap ! Temporary value extrapolated from the WaveDynP0B (:,:) array (N/m^2) -! REAL(SiKi) :: WaveDynP0BInterp ! Temporary value interpolated from the WaveDynP0B (:,:) array (N/m^2) -! REAL(SiKi) :: WaveElev_Max ! Maximum expected value of the instantaneous elevation of incident waves (meters) -! REAL(SiKi) :: WaveElev_Min ! Minimum expected value of the instantaneous elevation of incident waves (meters) - COMPLEX(SiKi) :: WaveElevxiPrime0 - REAL(SiKi), ALLOCATABLE :: WaveKinzi0Prime(:) ! zi-coordinates for points where the incident wave kinematics will be computed before applying stretching; these are relative to the mean see level (meters) - INTEGER , ALLOCATABLE :: WaveKinPrimeMap(:) -! REAL(SiKi), ALLOCATABLE :: WaveKinzi0St (:) ! Array of elevations found by stretching the elevations in the WaveKinzi0Prime(:) array using the instantaneous wave elevation; these are relative to the mean see level (meters) - REAL(SiKi) :: WaveNmbr ! Wavenumber of the current frequency component (1/meter) - REAL(SiKi) :: WaveS1Sdd ! One-sided power spectral density of the wave spectrum per unit time for the current frequency component (m^2/(rad/s)) - REAL(SiKi) :: WaveS2Sdd ! Two-sided power spectral density of the wave spectrum per unit time for the current frequency component (m^2/(rad/s)) - REAL(DbKi) :: WaveTMax ! Analysis time for incident wave calculations (sec) - REAL(SiKi), ALLOCATABLE :: WaveVel0Hxi (:,:) ! Instantaneous xi-direction velocity of incident waves before applying stretching at the zi-coordinates for points (m/s ) -!UNUSED: for future wave stretching -! REAL(SiKi) :: WaveVel0HxiExtrap ! Temporary value extrapolated from the WaveVel0Hxi(:,:) array (m/s ) -! REAL(SiKi) :: WaveVel0HxiInterp ! Temporary value interpolated from the WaveVel0Hxi(:,:) array (m/s ) - REAL(SiKi), ALLOCATABLE :: WaveVel0Hyi (:,:) ! Instantaneous yi-direction velocity of incident waves before applying stretching at the zi-coordinates for points (m/s ) -!UNUSED: for future wave stretching -! REAL(SiKi) :: WaveVel0HyiExtrap ! Temporary value extrapolated from the WaveVel0Hyi(:,:) array (m/s ) -! REAL(SiKi) :: WaveVel0HyiInterp ! Temporary value interpolated from the WaveVel0Hyi(:,:) array (m/s ) - REAL(SiKi), ALLOCATABLE :: WaveVel0V (:,:) ! Instantaneous vertical velocity of incident waves before applying stretching at the zi-coordinates for points (m/s ) -!UNUSED: for future wave stretching -! REAL(SiKi) :: WaveVel0VExtrap ! Temporary value extrapolated from the WaveVel0V (:,:) array (m/s ) -! REAL(SiKi) :: WaveVel0VInterp ! Temporary value interpolated from the WaveVel0V (:,:) array (m/s ) -! REAL(SiKi) :: zi_Max ! Maximum elevation where the wave kinematics are to be applied using stretching to the instantaneous free surface (meters) -! REAL(SiKi) :: zi_Min ! Minimum elevation where the wave kinematics are to be applied using stretching to the instantaneous free surface (meters) -! REAL(SiKi) :: ziPrime_Max ! Maximum elevation where the wave kinematics are computed before applying stretching to the instantaneous free surface (meters) -! REAL(SiKi) :: ziPrime_Min ! Minimum elevation where the wave kinematics are computed before applying stretching to the instantaneous free surface (meters) - -! REAL(SiKi) :: WGNC_Fact -! INTEGER :: GHNStepWave ! Total number of time steps in the GH Bladed wave data files. -! INTEGER :: GHNWvDpth ! Number of vertical locations in GH Bladed wave data files. - INTEGER :: I ! Generic index -! INTEGER :: I_Orig ! The index of the time step from original (input) part of data - INTEGER :: I_WaveTp ! The index of the frequency component nearest to WaveTp - INTEGER :: J ! Generic index - INTEGER :: J_Min ! The minimum value of index J such that WaveKinzi(J) >= -WtrDpth - INTEGER :: K ! Generic index - INTEGER :: LastInd ! Index into the arrays saved from the last call as a starting point for this call - INTEGER :: nSeeds ! number of seeds required to initialize the intrinsic random number generator - INTEGER :: NWaveKin0Prime ! Number of points where the incident wave kinematics will be computed before applying stretching to the instantaneous free surface (-) - INTEGER, ALLOCATABLE :: TmpWaveSeeds (:) ! A temporary array used for portability. IVF/CVF use a random number generator initialized with 2 seeds; other platforms can use different implementations (e.g. gfortran needs 8 or 12 seeds) - COMPLEX(SiKi) :: tmpComplex ! A temporary varible to hold the complex value of the wave elevation before storing it into a REAL array - COMPLEX(SiKi),ALLOCATABLE :: tmpComplexArr(:) ! A temporary array (0:NStepWave2-1) for FFT use. - TYPE(FFT_DataType) :: FFT_Data ! the instance of the FFT module we're using - - ! Variables for mult-direction waves - INTEGER(IntKi) :: WaveNDirMax !< Maximum value we can change WaveNDir to (relative to original value passed in). Used in finding new WaveNDir value. - INTEGER(IntKi) :: WvSpreadNDir !< Number of wave spreading directions for intermediate calculations. Set later to be MAX(15*InitOut%WaveNDir,1000) - INTEGER(IntKi) :: WvSpreadFreqPerDir !< Number of wave frequencies per direction - REAL(SiKi), ALLOCATABLE :: WvSpreadCos2SArr(:) !< Wave spreading function results array. Used in equal energy wave spreading function. - REAL(SiKi) :: WvSpreadCos2SConst !< Normalization constant for wave spreading function. - REAL(SiKi), ALLOCATABLE :: WvSpreadIntegral(:) !< Cumulative integral of the wave spreading function. Used in finding equal energy wave directions. - REAL(SiKi) :: WvSpreadDTheta !< Wave direction step size for intermediate calculations. Used in finding equal energy wave directions. - REAL(SiKi), ALLOCATABLE :: WvSpreadThetas(:) !< Wave direction used in calculations and interpolations - REAL(SiKi), ALLOCATABLE :: WvSpreadThetaIdx(:) !< Indices for wave directions - REAL(SiKi), ALLOCATABLE :: WvTheta(:) !< Final set of wave directions (degrees) - REAL(SiKi) :: WvSpreadIntegralTmp !< Temporary variable for the interpolation - - - ! Variables for error handling - INTEGER(IntKi) :: ErrStatTmp !< Temporary error status - CHARACTER(ErrMsgLen) :: ErrMsgTmp !< Temporary error message - CHARACTER(ErrMsgLen) :: ErrMsgTmp2 !< Another temporary error message - - - - ! Initialize ErrStat - - ErrStat = ErrID_None - ErrStatTmp = ErrID_None - ErrMsg = "" - ErrMsgTmp = "" - - ! Set the WaveNDir information (number of wave directions). - ! -> Since this must be adjusted later, put it in InitOut first and adjust that later in the code. - InitOut%WaveNDir = InitInp%WaveNDir - InitOut%WaveDir = InitInp%WaveDir ! We may want this value later (I had a nasty surprise when this wasn't set) - WaveNDirMax = CEILING(InitOut%WaveNDir*1.25_SiKi) ! Value we allow WaveNDir to reach before aborting - - - - - - ! Tell our nice users what is about to happen that may take a while: - - CALL WrScr ( ' Generating incident wave kinematics and current time history.' ) - - - - ! Determine the number of, NWaveKin0Prime, and the zi-coordinates for, - ! WaveKinzi0Prime(:), points where the incident wave kinematics will be - ! computed before applying stretching to the instantaneous free surface. - ! The locations are relative to the mean see level. Also determine J_Min, - ! which is the minimum value of index J such that WaveKinzi(J) >= - ! -WtrDpth. These depend on which incident wave kinematics stretching - ! method is being used: - -!JASON: ADD OTHER STRETCHING METHODS HERE, SUCH AS: DELTA STRETCHING (SEE ISO 19901-1) OR CHAKRABARTI STRETCHING (SEE OWTES)??? -!JASON: APPLY STRETCHING TO THE DYNAMIC PRESSURE, IF YOU EVER COMPUTE THAT HERE!!! - -! SELECT CASE ( InitInp%WaveStMod ) ! Which model are we using to extrapolate the incident wave kinematics to the instantaneous free surface? - -! CASE ( 0 ) ! None=no stretching. - - - ! Since we have no stretching, NWaveKin0Prime and WaveKinzi0Prime(:) are - ! equal to the number of, and the zi-coordinates for, the points in the - ! WaveKinzi(:) array between, and including, -WtrDpth and 0.0. - - ! Determine J_Min and NWaveKin0Prime here: - - J_Min = 0 - NWaveKin0Prime = 0 - DO J = 1,InitInp%NWaveKin ! Loop through all mesh points where the incident wave kinematics will be computed - ! NOTE: We test to 0 instead of MSL2SWL because the locations of WaveKinzi and WtrDpth have already been adjusted using MSL2SWL - IF ( InitInp%WaveKinzi(J) >= -InitInp%WtrDpth .AND. InitInp%WaveKinzi(J) <= 0 ) THEN - NWaveKin0Prime = NWaveKin0Prime + 1 - END IF - END DO ! J - All Morison nodes where the incident wave kinematics will be computed - - - - ! ALLOCATE the WaveKinzi0Prime(:) array and compute its elements here: - - ALLOCATE ( WaveKinzi0Prime(NWaveKin0Prime) , STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveKinzi0Prime.',ErrStat,ErrMsg,'VariousWaves_Init') - - ALLOCATE ( WaveKinPrimeMap(NWaveKin0Prime) , STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveKinPrimeMap.',ErrStat,ErrMsg,'VariousWaves_Init') - - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp() - RETURN - END IF - - - I = 1 - - DO J = 1,InitInp%NWaveKin ! Loop through all points where the incident wave kinematics will be computed without stretching - ! NOTE: We test to 0 instead of MSL2SWL because the locations of WaveKinzi and WtrDpth have already been adjusted using MSL2SWL - IF ( InitInp%WaveKinzi(J) >= -InitInp%WtrDpth .AND. InitInp%WaveKinzi(J) <= 0 ) THEN - - WaveKinzi0Prime(I) = InitInp%WaveKinzi(J) - WaveKinPrimeMap(I) = J - I = I + 1 - - END IF - - END DO ! J - All points where the incident wave kinematics will be computed without stretching - - -! CASE ( 1, 2 ) ! Vertical stretching or extrapolation stretching. - - - ! Vertical stretching says that the wave kinematics above the mean sea level - ! equal the wave kinematics at the mean sea level. The wave kinematics - ! below the mean sea level are left unchanged. - ! - ! Extrapolation stretching uses a linear Taylor expansion of the wave - ! kinematics (and their partial derivatives with respect to z) at the mean - ! sea level to find the wave kinematics above the mean sea level. The - ! wave kinematics below the mean sea level are left unchanged. - ! - ! Vertical stretching and extrapolation stretching do not effect the wave - ! kinematics below the mean sea level; also, vertical stretching and - ! extrapolation stretching say the wave kinematics above the mean sea - ! level depend only on the mean sea level values. Consequently, - ! NWaveKin0Prime and WaveKinzi0Prime(:) are equal to the number of, and - ! the zi-coordinates for, the points in the WaveKinzi(:) array between, - ! and including, -WtrDpth and 0.0; the WaveKinzi0Prime(:) array must also - ! include 0.0 even if the WaveKinzi(:) array does not. - - - - -! CASE ( 3 ) ! Wheeler stretching. - - - ! Wheeler stretching says that wave kinematics calculated using Airy theory - ! at the mean sea level should actually be applied at the instantaneous - ! free surface and that Airy wave kinematics computed at locations between - ! the seabed and the mean sea level should be shifted vertically to new - ! locations in proportion to their elevation above the seabed. - ! - ! Thus, given a range of zi(:) where we want to know the wave kinematics - ! after applying Wheeler stretching, the required range of ziPrime(:) - ! where the wave kinematics need to be computed before applying - ! stretching, is as follows: - ! - ! ziPrime_Min <= ziPrime(:) <= ziPrime_Max - ! - ! ziPrime_Min = MAX{ ( zi_Min - WaveElev_Max )/( 1 + WaveElev_Max/WtrDpth ), -WtrDpth } - ! ziPrime_Max = MIN{ ( zi_Max - WaveElev_Min )/( 1 + WaveElev_Min/WtrDpth ), 0 } - ! - ! where, - ! zi_Max = maximum elevation where the wave kinematics are to be - ! applied using stretching to the instantaneous free - ! surface - ! zi_Min = minimum elevation where the wave kinematics are to be - ! applied using stretching to the instantaneous free - ! surface - ! ziPrime_Max = maximum elevation where the wave kinematics are computed - ! before applying stretching to the instantaneous free - ! surface - ! ziPrime_Min = minimum elevation where the wave kinematics are computed - ! before applying stretching to the instantaneous free - ! surface - ! WaveElev_Max = maximum expected value of the instantaneous elevation of - ! incident waves - ! WaveElev_Min = minimum expected value of the instantaneous elevation of - ! incident waves - ! - ! Thus, in order to account for Wheeler stretching when computing the wave - ! kinematics at each of the NWaveKin points along a vertical line passing - ! through the platform reference point [defined by the zi-coordinates - ! relative to the mean see level as specified in the WaveKinzi(:) array], - ! we must first compute the wave kinematics without stretching at - ! alternative elevations [indicated here by the NWaveKin0Prime-element - ! array WaveKinzi0Prime(:)]: - - - - - -! ENDSELECT - - - - - ! Perform some initialization computations including initializing the - ! pseudorandom number generator, calculating the total number of frequency - ! components = total number of time steps in the incident wave, - ! calculating the frequency step, calculating the index of the frequency - ! component nearest to WaveTp, and ALLOCATing the arrays: - ! NOTE: WaveDOmega = 2*Pi/WaveTMax since, in the FFT: - ! Omega = (K-1)*WaveDOmega - ! Time = (J-1)*WaveDT - ! and therefore: - ! Omega*Time = (K-1)*(J-1)*WaveDOmega*WaveDT - ! = (K-1)*(J-1)*2*Pi/NStepWave [see NWTC_FFTPACK] - ! or: - ! WaveDOmega = 2*Pi/(NStepWave*WaveDT) - ! = 2*Pi/WaveTMax - - CALL RANDOM_SEED ( SIZE = nSeeds ) - - IF ( nSeeds /= 2 ) THEN - ErrMsgTmp = ' The random number generator in use differs from the original code provided by NREL. This pRNG uses ' & - //TRIM(Int2LStr(nSeeds))//' seeds instead of the 2 in the HydroDyn input file.' - CALL SetErrStat(ErrID_Warn,ErrMsgTmp,ErrStat,ErrMsg,'VariousWaves_Init') - END IF - - ALLOCATE ( TmpWaveSeeds ( nSeeds ), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array TmpWaveSeeds.',ErrStat,ErrMsg,'VariousWaves_Init') - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp() - RETURN - END IF - - ! We'll just populate this with odd seeds = Seed(1) and even seeds = Seed(2) - DO I = 1,nSeeds,2 - TmpWaveSeeds(I) = InitInp%WaveSeed(1) - END DO - DO I = 2,nSeeds,2 - TmpWaveSeeds(I) = InitInp%WaveSeed(2) - END DO - - - CALL RANDOM_SEED ( PUT=TmpWaveSeeds ) - DEALLOCATE(TmpWaveSeeds, STAT=ErrStatTmp) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot deallocate array TmpWaveSeeds.',ErrStat,ErrMsg,'VariousWaves_Init') - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp() - RETURN - END IF - - - ! Set new value for NStepWave so that the FFT algorithms are efficient. Note that if this method is changed, the method - ! used to calculate the number of multidirectional wave directions (WaveNDir) and the UserWaveElevations_Init subroutine - ! will need to be updated. - - ! NOTE: For WaveMod = 5, NStepWave and several other things were already set in the UserWaveElevations_Init routine - ! using file information (an FFT was performed there, so the information was needed before now). - IF (InitInp%WaveMod /= 5 ) THEN - InitOut%NStepWave = CEILING ( InitInp%WaveTMax/InitInp%WaveDT ) ! Set NStepWave to an even integer - IF ( MOD(InitOut%NStepWave,2) == 1 ) InitOut%NStepWave = InitOut%NStepWave + 1 ! larger or equal to WaveTMax/WaveDT. - InitOut%NStepWave2 = MAX( InitOut%NStepWave/2, 1 ) ! Make sure that NStepWave is an even product of small factors (PSF) that is - InitOut%NStepWave = 2*PSF ( InitOut%NStepWave2, 9 ) ! greater or equal to WaveTMax/WaveDT to ensure that the FFT is efficient. - - InitOut%NStepWave2 = InitOut%NStepWave/2 ! Update the value of NStepWave2 based on the value needed for NStepWave. - WaveTMax = InitOut%NStepWave*InitInp%WaveDT ! Update the value of WaveTMax based on the value needed for NStepWave. - InitOut%WaveTMax = WaveTMax ! Update the value of WaveTMax in the output. Needed by glue code later. - InitOut%WaveDOmega = TwoPi/WaveTMax ! Compute the frequency step for incident wave calculations. - ELSE - WaveTMax = InitOut%WaveTMax - ENDIF - SQRTNStepWave2 = SQRT( REAL( InitOut%NStepWave2, SiKi ) ) ! Compute SQRT( NStepWave/2 ). - I_WaveTp = NINT ( TwoPi/(InitOut%WaveDOmega*InitInp%WaveTp) ) ! Compute the index of the frequency component nearest to WaveTp. - - - ! Allocate all the arrays we need. - - IF ( InitInp%WaveMod /= 5 ) THEN ! For WaveMod == 5, these are allocated and populated in UserWaveElevations_Init - ALLOCATE ( InitOut%WaveElevC0(2, 0:InitOut%NStepWave2 ), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array InitOut%WaveElevC0.',ErrStat,ErrMsg,'VariousWaves_Init') - ENDIF - - ALLOCATE ( InitOut%WaveTime (0:InitOut%NStepWave ), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array InitOut%WaveTime.', ErrStat,ErrMsg,'VariousWaves_Init') - - ALLOCATE ( tmpComplexArr(0:InitOut%NStepWave2 ), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array tmpComplexArr.', ErrStat,ErrMsg,'VariousWaves_Init') - - ALLOCATE ( WaveElevC (0:InitOut%NStepWave2 ,InitInp%NWaveElev), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveElevC.', ErrStat,ErrMsg,'VariousWaves_Init') - - ALLOCATE ( WaveDynPC0 (0:InitOut%NStepWave2 ,NWaveKin0Prime ), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveDynPC0.', ErrStat,ErrMsg,'VariousWaves_Init') - - ALLOCATE ( WaveVelC0Hxi (0:InitOut%NStepWave2 ,NWaveKin0Prime ), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveVelC0Hxi.', ErrStat,ErrMsg,'VariousWaves_Init') - - ALLOCATE ( WaveVelC0Hyi (0:InitOut%NStepWave2 ,NWaveKin0Prime ), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveVelC0Hyi.', ErrStat,ErrMsg,'VariousWaves_Init') - - ALLOCATE ( WaveVelC0V (0:InitOut%NStepWave2 ,NWaveKin0Prime ), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveVelC0V.', ErrStat,ErrMsg,'VariousWaves_Init') - - ALLOCATE ( WaveAccC0Hxi (0:InitOut%NStepWave2 ,NWaveKin0Prime ), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAccC0Hxi.', ErrStat,ErrMsg,'VariousWaves_Init') - - ALLOCATE ( WaveAccC0Hyi (0:InitOut%NStepWave2 ,NWaveKin0Prime ), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAccC0Hyi.', ErrStat,ErrMsg,'VariousWaves_Init') - - ALLOCATE ( WaveAccC0V (0:InitOut%NStepWave2 ,NWaveKin0Prime ), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAccC0V.', ErrStat,ErrMsg,'VariousWaves_Init') - - !ALLOCATE ( PWaveDynPC0BPz0 (0:InitOut%NStepWave2 ,InitInp%NWaveKin ), STAT=ErrStatTmp ) - !IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array PWaveDynPC0BPz0.', ErrStat,ErrMsg,'VariousWaves_Init') - ! - !ALLOCATE ( PWaveVelC0HxiPz0 (0:InitOut%NStepWave2 ,InitInp%NWaveKin ), STAT=ErrStatTmp ) - !IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array PWaveVelC0HxiPz0.', ErrStat,ErrMsg,'VariousWaves_Init') - ! - !ALLOCATE ( PWaveVelC0HyiPz0 (0:InitOut%NStepWave2 ,InitInp%NWaveKin ), STAT=ErrStatTmp ) - !IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array PWaveVelC0HyiPz0.', ErrStat,ErrMsg,'VariousWaves_Init') - ! - !ALLOCATE ( PWaveVelC0VPz0 (0:InitOut%NStepWave2 ,InitInp%NWaveKin ), STAT=ErrStatTmp ) - !IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array PWaveVelC0VPz0.', ErrStat,ErrMsg,'VariousWaves_Init') - ! - !ALLOCATE ( PWaveAccC0HxiPz0 (0:InitOut%NStepWave2 ,InitInp%NWaveKin ), STAT=ErrStatTmp ) - !IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array PWaveAccC0HxiPz0.', ErrStat,ErrMsg,'VariousWaves_Init') - ! - !ALLOCATE ( PWaveAccC0HyiPz0 (0:InitOut%NStepWave2 ,InitInp%NWaveKin ), STAT=ErrStatTmp ) - !IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array PWaveAccC0HyiPz0.', ErrStat,ErrMsg,'VariousWaves_Init') - ! - !ALLOCATE ( PWaveAccC0VPz0 (0:InitOut%NStepWave2 ,InitInp%NWaveKin ), STAT=ErrStatTmp ) - !IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array PWaveAccC0VPz0.', ErrStat,ErrMsg,'VariousWaves_Init') - - ALLOCATE ( InitOut%WaveElev0 (0:InitOut%NStepWave ), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveElev0.', ErrStat,ErrMsg,'VariousWaves_Init') - - ALLOCATE ( InitOut%WaveElev (0:InitOut%NStepWave,InitInp%NWaveElev ), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array InitOut%WaveElev.', ErrStat,ErrMsg,'VariousWaves_Init') - - ALLOCATE ( WaveDynP0B (0:InitOut%NStepWave-1,NWaveKin0Prime ), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveDynP0B.', ErrStat,ErrMsg,'VariousWaves_Init') - - ALLOCATE ( WaveVel0Hxi (0:InitOut%NStepWave-1,NWaveKin0Prime ), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveVel0Hxi.', ErrStat,ErrMsg,'VariousWaves_Init') - - ALLOCATE ( WaveVel0Hyi (0:InitOut%NStepWave-1,NWaveKin0Prime ), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveVel0Hyi.', ErrStat,ErrMsg,'VariousWaves_Init') - - ALLOCATE ( WaveVel0V (0:InitOut%NStepWave-1,NWaveKin0Prime ), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveVel0V.', ErrStat,ErrMsg,'VariousWaves_Init') - - ALLOCATE ( WaveAcc0Hxi (0:InitOut%NStepWave-1,NWaveKin0Prime ), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAcc0Hxi.', ErrStat,ErrMsg,'VariousWaves_Init') - - ALLOCATE ( WaveAcc0Hyi (0:InitOut%NStepWave-1,NWaveKin0Prime ), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAcc0Hyi.', ErrStat,ErrMsg,'VariousWaves_Init') - - ALLOCATE ( WaveAcc0V (0:InitOut%NStepWave-1,NWaveKin0Prime ), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAcc0V.', ErrStat,ErrMsg,'VariousWaves_Init') - - !ALLOCATE ( PWaveDynP0BPz0 (0:InitOut%NStepWave-1,InitInp%NWaveKin ), STAT=ErrStatTmp ) - !IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array PWaveDynP0BPz0.', ErrStat,ErrMsg,'VariousWaves_Init') - ! - !ALLOCATE ( PWaveVel0HxiPz0 (0:InitOut%NStepWave-1,InitInp%NWaveKin ), STAT=ErrStatTmp ) - !IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array PWaveVel0HxiPz0.', ErrStat,ErrMsg,'VariousWaves_Init') - ! - !ALLOCATE ( PWaveVel0HyiPz0 (0:InitOut%NStepWave-1,InitInp%NWaveKin ), STAT=ErrStatTmp ) - !IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array PWaveVel0HyiPz0.', ErrStat,ErrMsg,'VariousWaves_Init') - ! - !ALLOCATE ( PWaveVel0VPz0 (0:InitOut%NStepWave-1,InitInp%NWaveKin ), STAT=ErrStatTmp ) - !IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array PWaveVel0Pz0.', ErrStat,ErrMsg,'VariousWaves_Init') - ! - !ALLOCATE ( PWaveAcc0HxiPz0 (0:InitOut%NStepWave-1,InitInp%NWaveKin ), STAT=ErrStatTmp ) - !IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array PWaveAcc0HxiPz0.', ErrStat,ErrMsg,'VariousWaves_Init') - ! - !ALLOCATE ( PWaveAcc0HyiPz0 (0:InitOut%NStepWave-1,InitInp%NWaveKin ), STAT=ErrStatTmp ) - !IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array PWaveAcc0HyiPz0.', ErrStat,ErrMsg,'VariousWaves_Init') - ! - !ALLOCATE ( PWaveAcc0VPz0 (0:InitOut%NStepWave-1,InitInp%NWaveKin ), STAT=ErrStatTmp ) - !IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array PWaveAcc0VPz0.', ErrStat,ErrMsg,'VariousWaves_Init') - - ALLOCATE ( InitOut%WaveDynP (0:InitOut%NStepWave,InitInp%NWaveKin ), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array InitOut%WaveDynP.', ErrStat,ErrMsg,'VariousWaves_Init') - - ALLOCATE ( InitOut%WaveVel (0:InitOut%NStepWave,InitInp%NWaveKin,3), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array InitOut%WaveVel.', ErrStat,ErrMsg,'VariousWaves_Init') - - ALLOCATE ( InitOut%WaveAcc (0:InitOut%NStepWave,InitInp%NWaveKin,3), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array InitOut%WaveAcc.', ErrStat,ErrMsg,'VariousWaves_Init') - - ALLOCATE ( InitOut%PWaveDynP0 (0:InitOut%NStepWave,InitInp%NWaveKin ), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array InitOut%PWaveDynP0.', ErrStat,ErrMsg,'VariousWaves_Init') - - ALLOCATE ( InitOut%PWaveVel0 (0:InitOut%NStepWave,InitInp%NWaveKin,3), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array InitOut%PWaveVel0.', ErrStat,ErrMsg,'VariousWaves_Init') - - ALLOCATE ( InitOut%PWaveAcc0 (0:InitOut%NStepWave,InitInp%NWaveKin,3), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array InitOut%PWaveAcc0.', ErrStat,ErrMsg,'VariousWaves_Init') - - - - ALLOCATE ( InitOut%nodeInWater(0:InitOut%NStepWave,InitInp%NWaveKin ) , STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array InitOut%nodeInWater.', ErrStat,ErrMsg,'VariousWaves_Init') - - ! Wave direction associated with each frequency - ALLOCATE ( InitOut%WaveDirArr( 0:InitOut%NStepWave2 ), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array InitOut%WaveDirArr.',ErrStat,ErrMsg,'VariousWaves_Init') - - ! Arrays for the Sin and Cos of the wave direction for each frequency. Used in calculating wave elevation, velocity, acceleration etc. - ALLOCATE ( CosWaveDir( 0:InitOut%NStepWave2 ), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array CosWaveDir.', ErrStat,ErrMsg,'VariousWaves_Init') - - ALLOCATE ( SinWaveDir( 0:InitOut%NStepWave2 ), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array SinWaveDir.', ErrStat,ErrMsg,'VariousWaves_Init') - - - ! Now check if all the allocations worked properly - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp() - RETURN - END IF - - - - ! We now need to establish the nodeInWater flag values for all the simulation node for all timesteps, this is an extension which is needed to - ! support user input wave data. TODO: THIS ASSUMES NO WAVE STRETCHING!!!!!!!! GJH 18 Mar 2015 - DO J = 1,InitInp%NWaveKin ! Loop through all points where the incident wave kinematics will be computed without stretching - ! NOTE: We test to 0 instead of MSL2SWL because the locations of WaveKinzi and WtrDpth have already been adjusted using MSL2SWL - IF ( InitInp%WaveKinzi(J) >= -InitInp%WtrDpth .AND. InitInp%WaveKinzi(J) <= 0 ) THEN - - InitOut%nodeInWater(:, J) = 1 - ELSE - InitOut%nodeInWater(:, J) = 0 - END IF - - END DO ! J - All points where the incident wave kinematics will be computed without stretching - - -!FIXME: Is this piece still needed? If so, why is it commented out? - ! Calculate the factors needed by the discrete time inverse Fourier - ! transform in the calculations of the White Gaussian Noise (WGN) and - ! the two-sided power spectral density of the wave spectrum per unit time: - - ! This factor is needed by the discrete time inverse Fourier transform to ensure that the time series WGN - ! process has unit variance - ! WGNC_Fact = SQRT( Pi/(InitOut%WaveDOmega*InitInp%WaveDT) ) - - - - - - !-------------------------------------------------------------------------------- - !> # Multi Directional Waves - !> ## Adjust WaveNDir - !! - !! If multi-directional waves will be used, the value of WaveNDir may need to be adjusted. The reason is that - !! for the equal energy approach used here, the following condition must be met: - !! - !! CONDITION: (NStepWave2) / WaveNDir must be an integer - !! - !! If this is true, then an equal number of frequencies is assigned to each of the WaveNDir directions which - !! gives the proper wave direction distribution function. Otherwise, the energy distribution by direction - !! will not be correct. - !! - !! _WaveNDir_ could not be adjusted before _NStepWave2_ was finalized above. - !! - !! @note Use the value of WaveNDir stored in InitOut since InitInp cannot be changed. - !! - !! @note Originally, the criteria had been that (NStepWave2 - 1) / WaveNDir is an integer. This criteria - !! was relaxed by setting the direction for Omega = 0 (which has no amplitude) since it was found that - !! (NStepWave2 - 1) is often a prime number due to how NStepWave is calculated above to be a product - !! of smallish numbers. - - IF ( InitInp%WaveMultiDir ) THEN ! Multi-directional waves in use - - ! Check that the number of wave directions is a positive odd number. In theory this has been - ! done before the Waves module was called. We repeat it here in the event that the Waves module - ! gets used in some other code. - ! -> If it is less than 0, error out. - ! -> If it is even, we will increment it by 1. - IF ( InitOut%WaveNDir <= 0_IntKi ) THEN - ErrMsgTmp = 'WaveNDir must be an odd number greater than 0.' - ErrStatTmp = ErrID_Fatal - CALL SetErrStat(ErrStatTmp,ErrMsgTmp,ErrStat,ErrMsg,'VariousWaves_Init') - RETURN - END IF - - IF ( MODULO( InitOut%WaveNDir, 2_IntKi) == 0_IntKi ) THEN - InitOut%WaveNDir = InitOut%WaveNDir + 1 - ErrMsgTmp = 'WaveNDir must be odd. Changing the value to '//TRIM(Num2LStr(InitOut%WaveNDir)) - CALL SetErrStat(ErrID_Warn,ErrMsgTmp,ErrStat,ErrMsg,'VariousWaves_Init') - END IF - - ! Now adjust WaveNDir as necessary so that (NStepWave2) / WaveNDir is integer - IF ( .NOT. EqualRealNos(REAL(( InitOut%NStepWave2 )/ InitOut%WaveNDir), & - ((REAL(InitOut%NStepWave2))/REAL(InitOut%WaveNDir)) )) THEN - DO WHILE ( InitOut%WaveNDir <= WaveNDirMax ) - - InitOut%WaveNDir = InitOut%WaveNDir + 2.0_SiKi - IF ( EqualRealNos(REAL(( InitOut%NStepWave2 )/ InitOut%WaveNDir), & - ((REAL(InitOut%NStepWave2))/REAL(InitOut%WaveNDir)) )) THEN - ErrMsgTmp = 'Changed WaveNDir from '//TRIM(Num2LStr(InitInp%WaveNDir))//' to '// & - TRIM(Num2LStr(InitOut%WaveNDir))//' so that an equal number of frequencies are assigned to '// & - 'each direction.' - CALL SetErrStat(ErrID_Warn,ErrMsgTmp,ErrStat,ErrMsg,'VariousWaves_Init') - EXIT - END IF - END DO - END IF - - ! If we exited because we hit a limit (in which case the condition is not satisfied), then we cannot continue. - ! We warn the user that a value for WaveNDir was not found, and that they should try a different value, or try - ! a different value for WaveTMax. The reason for suggesting the latter is that NStepWave is derived from - ! WaveTMax and adjusted until it is a product of smallish numbers (most likely even, but not necessarily so). - ! So, there is a very small possibility then that NStepWave2 is a prime number, in which case we won't find a - ! value for WaveNDir, so we suggest that the user change WaveTMax. To make this a little easier for the user, - ! we will report the first 5 possible values for WaveNDir between their requested value and 1/4 of NStepWave2, - ! if there are any. - IF ( .NOT. EqualRealNos(REAL(( InitOut%NStepWave2 )/ InitOut%WaveNDir), & - ((REAL(InitOut%NStepWave2))/REAL(InitOut%WaveNDir)) )) THEN - ErrMsgTmp = 'Could not find value for WaveNDir between '//TRIM(Num2LStr(InitInp%WaveNDir))//' and '// & - TRIM(Num2LStr(WaveNDirMax))//' such that an equal number of frequencies are assigned to each '// & - 'direction.' - ErrStatTmp = ErrID_Fatal - - ! Now check for the possible values of WaveNDir so that we can tell the user about it. The variable 'I' contains - ! the count of the number of values of WaveNDir found. - I = 0 - ErrMsgTmp2 = 'The next values of WaveNDir that work with the selected values for WaveTMax and WaveDT:' - DO WHILE ( InitOut%WaveNDir <= INT(InitOut%NStepWave2/4.0) ) - IF ( EqualRealNos(REAL(( InitOut%NStepWave2 )/ InitOut%WaveNDir), & - ((REAL(InitOut%NStepWave2))/REAL(InitOut%WaveNDir)) )) THEN - ErrMsgTmp2 = TRIM(ErrMsgTmp2)//" "//TRIM(Num2LStr(InitOut%WaveNDir)) - I = I + 1 - END IF - - InitOut%WaveNDir = InitOut%WaveNDir + 2.0_SiKi - - IF ( I >= 5 ) EXIT - - END DO - - ! If there were no additional values for WaveNDir found, I will be 0, so we rewrite the error message. - IF ( I == 0 ) THEN - ErrMsgTmp2 = 'There are no values for WaveNDir between '//TRIM(Num2LStr(WaveNDirMax))//' and '// & - TRIM(Num2LStr(INT(InitOut%NStepWave2/4.0)))//' (4 frequencies per wave direction)'// & - ' that will work with the selected values for WaveTMax ('//TRIM(Num2Lstr(InitOut%WaveTMax))// & - ') and WaveDT ('//TRIM(Num2LStr(InitInp%WaveDT))//'). Change either'// & - ' WaveTMax or WaveDT.' - ELSE - ErrMsgTmp2 = TRIM(ErrMsgTmp2)//'.' - ENDIF - - ! Append the message about the possible values for WaveNDir (if any were found) and set the error status before - ! returning to the calling program. - ErrMsgTmp = TRIM(ErrMsgTmp)//NewLine//' '//TRIM(ErrMsgTmp2) - - CALL SetErrStat(ErrStatTmp,ErrMsgTmp,ErrStat,ErrMsg,'VariousWaves_Init') - RETURN - END IF - - ! Save the number of frequencies per direction so that we can use it later in assigning the directios. - WvSpreadFreqPerDir = (InitOut%NStepWave2)/InitOut%WaveNDir - - - !> ## Calculate the wave directions based on an equal energy approach. - !! - !! All the angles are supplied in degrees and are converted as needed. For the cosine function, - !! we could convert degrees to radians, but the conversion constant cancels out. - !! - !! | Variable | Fortran Name | Location | Units | Description | - !! | :----------------: | :-------------------: | :-------: | :--------: | :----------------------------------------------------- | - !! | \f$\bar\theta\f$ | _WaveDir_ | _InitInp_ | (degrees) | Mean direction heading (_WaveDir_) | - !! | \f$\Theta\f$ | _WaveNDir_ | _InitOut_ | (-) | Number of wave directions | - !! | \f$\delta\theta\f$ | _WaveDirRange_ | _InitInp_ | (degrees) | Full range of spreading function | - !! | \f$S\f$ | _WaveDirSpread_ | _InitInp_ | (-) | The spreading coefficient | - !! | | _WvSpreadNDir_ | local | (-) | Number of angles discretizing the spreading function | - !! | \f$C\f$ | _WvSpreadCos2SConst_ | local | (1/degrees) | The normalization coefficient | - !! | | _WvTheta_ | local | (degrees) | The interpolated wave directions to assign to | - !! | \f$\theta_i\f$ | _WvSpreadThetas_ | local | (degrees) | Array of wave directions associated with _WvSpreadIntegral_ | - !! | | _D2R_ | global | (rad/degree) | Constant from library to convert degrees to radians | - !! - !! The equal energy approach is used to set the wave directions such that each direction has the same - !! number of frequencies. To ensure that direction spreading function (Cosine^2S in this case) has - !! the correct overal energy distribution shape, the wave directions are adjusted. The spacing between - !! directions is closer near the central direction than in the tails of the spreading function. The - !! method distributes the wave directions so that the energy integral between wave directions is kept - !! constant. The following steps are taken: - !! - !! 1. Discretize the spreading function over the range _InitInp%WaveDirRange_ into _WvSpreadNDir_. - !! - !! 2. Calculate the spreading function, _WvSpreadCos2SArr_, in the range.\n - !! \f$ D(\theta) = C \left| \cos\left(\frac{\pi (\theta-\bar\theta)}{\delta\theta}\right)\right|^{2S} \f$\n - !! where\n - !! \f$ C = \frac{\sqrt{\pi} \: \Gamma(S+1)}{\delta\theta \: \Gamma(S+1/2)} \f$, - !! and - !! \f$ \Gamma \f$ is the gamma function. - !! - !! 3. Calculate the integral of WvSpreadCos2SArr up to the current angle, and save it as - !! WvSpreadIntegral. The integral can be written as:\n - !! \f$P(\theta) = \int\limits^{\theta}_{\bar\theta - \delta\theta/2} D(\theta') \: \mathrm{d}\theta'\f$ - !! - !! 4. Do a sanity check on the result of \f$P(\theta)\f$ over the range. - !! - !! 5. Divide the integrated area of _WvSpreadCos2SArr_ into _InitOut%WaveNDir_ directions (the final number - !! of wave directions that was solved for above). To do this, simply find the _1/WaveNDir_ values - !! of the integral and interpolate to find the values of the _WvSpreadThetas_ that match. These are the - !! new wave directions to use. These results are stored in the array _WvTheta_. - !! - !! 6. Cleanup - !! - - !> ### Code Implementation order - !! 1. Discretize the spreading function range and calculate the values of the wave spreading function - - ! Now that we have the value for _WaveNDir_ found above, we set the value of _WvSpreadNDir_ to be 15x as - ! large, or 1000 (whichever is larger). WvSpreadNDir is used only in discretization for later - ! interpolation of actual wave directions. - WvSpreadNDir = MAX(15*InitOut%WaveNDir,1000) - WvSpreadDTheta = InitInp%WaveDirRange/REAL(WvSpreadNDir,SiKi) - - ! Calculate the normalization constant for the wave spreading. - WvSpreadCos2SConst = sqrt(Pi)* (NWTC_GAMMA(InitInp%WaveDirSpread + 1.0_SiKi))/ & - (InitInp%WaveDirRange * NWTC_GAMMA(InitInp%WaveDirSpread + 0.5_SiKi)) - - ! Allocate arrays to use for storing the intermediate values - ALLOCATE( WvSpreadCos2SArr(0:WvSpreadNDir), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WvSpreadCos2SArr.', ErrStat,ErrMsg,'VariousWaves_Init') - - ALLOCATE( WvSpreadIntegral(0:WvSpreadNDir), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WvSpreadIntegral.', ErrStat,ErrMsg,'VariousWaves_Init') - - ALLOCATE( WvSpreadThetas(0:WvSpreadNDir), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WvSpreadThetas.', ErrStat,ErrMsg,'VariousWaves_Init') - - ALLOCATE( WvTheta(1:InitOut%WaveNDir), STAT=ErrStatTmp ) ! Dealocate this at very end of routine. - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WvTheta.', ErrStat,ErrMsg,'VariousWaves_Init') - - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp() - RETURN - END IF - - !> 2. Calculate the spreading function as a function of angle. Step through all _WvSpreadNDir_ steps. - DO I=0,WvSpreadNDir - ! The current angle as we step through the range - WvSpreadThetas(I) = I*WvSpreadDTheta + InitInp%WaveDir - InitInp%WaveDirRange/(2.0_SiKi) - - ! Calculate the wave spreading for the current value of WvSpreadThetas - WvSpreadCos2SArr(I) = WvSpreadCos2SConst*abs( cos(Pi*(WvSpreadThetas(I)-InitInp%WaveDir)/InitInp%WaveDirRange) ) & - **(2*InitInp%WaveDirSpread) - - !> 3. Calculate the integral of the spreading function up to the current angle and save it. - ! Remember that the first element can't refer to one before it. - IF (I == 0) THEN - WvSpreadIntegral(I) = WvSpreadCos2SArr(I) * WvSpreadDTheta - ELSE - WvSpreadIntegral(I) = WvSpreadCos2SArr(I) * WvSpreadDTheta + WvSpreadIntegral(I-1) - END IF - ENDDO - - - !> 4. Perform a quick sanity check. The last value of the integral table should be 1.0 exactly. - !! We will allow for a 1% deviation. If for some reason an error occurs, it may be due to the - !! GAMMA function calculation for the normalization constant, _WvSpreadCos2SConst_. - IF ( WvSpreadIntegral(WvSpreadNDir) < 0.99_SiKi .OR. WvSpreadIntegral(WvSpreadNDir) > 1.01_SiKi ) THEN - CALL SetErrStat(ErrID_Fatal,' Something went wrong in evaluating the multidirectional wave spreading function. '// & - 'Integral is '//TRIM(Num2LStr(WvSpreadIntegral(WvSpreadNDir))),ErrStat,ErrMsg,'VariousWaves_Init') - RETURN - END IF - - - !> 5. Set the wave directions using the results from the integral. - ! We will use the variable LastInd as a simple index for figuring out where in the array we are. First set to 0 - LastInd = 0_IntKi - DO I=1,InitOut%WaveNDir - WvSpreadIntegralTmp = (REAL(I)-0.5_SiKi)/REAL(InitOut%WaveNDir) - WvTheta(I) = InterpStp( WvSpreadIntegralTmp, WvSpreadIntegral, WvSpreadThetas, LastInd, WvSpreadNDir ) - ENDDO ! I=1,InitOut%WaveNDir - - ! Store the minimum and maximum wave directions - InitOut%WaveDirMin = MINVAL(WvTheta) - InitOut%WaveDirMax = MAXVAL(WvTheta) - - !> 6. Done with equal energy wavedirection calculations. Deallocate the arrays used during calculations. - IF(ALLOCATED( WvSpreadCos2SArr )) DEALLOCATE( WvSpreadCos2SArr, STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot deallocate array WvSpreadCos2SArr.', ErrStat,ErrMsg,'VariousWaves_Init') - IF(ALLOCATED( WvSpreadIntegral )) DEALLOCATE( WvSpreadIntegral, STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot deallocate array WvSpreadIntegral.', ErrStat,ErrMsg,'VariousWaves_Init') - IF(ALLOCATED( WvSpreadThetas )) DEALLOCATE( WvSpreadThetas, STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot deallocate array WvSpreadThetas.', ErrStat,ErrMsg,'VariousWaves_Init') - - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp() - RETURN - END IF - - ELSE ! Multi-directional waves not used - - InitOut%WaveDirMin = InitInp%WaveDir - InitOut%WaveDirMax = InitInp%WaveDir - - ENDIF ! Multi-directional waves in use (InitInp%WaveMultiDir == .TRUE.) - - - - ! JASON: IMPLEMENT EQUATIONS (2.12 - 2.13) IN MY DISSERTATION SO THAT ONE CAN READ IN EXTERNAL WAVE - ! DATA?<--BETTER YET, IMPLEMENT WaveElevC0 = DFT(WaveElev) WHERE WaveElev CAN BE READ IN AS - ! GH BLADED WAVE DATA. THAT IS, ADD AN OPTION TO READ IN WAVE DATA FOR FLOATERS! - - ! Compute the positive-frequency components (including zero) of the discrete - ! Fourier transforms of the wave kinematics: - - DO I = 0,InitOut%NStepWave2 ! Loop through the positive frequency components (including zero) of the discrete Fourier transforms - - - ! Compute the frequency of this component and its imaginary value: - - Omega = I* InitOut%WaveDOmega - ImagOmega = ImagNmbr*Omega - - - - ! Compute the discrete Fourier transform of the realization of a White - ! Gaussian Noise (WGN) time series process with unit variance: - ! - ! NOTE: For the time series process to be real with zero mean, the values at - ! Omega == 0.0 and Omega == NStepWave2*WaveDOmega (= WaveOmegaMax) - ! must be zero. - - IF ( ( I == 0 ) .OR. ( I == InitOut%NStepWave2 ) ) THEN ! .TRUE. if ( Omega == 0.0 ) or ( Omega == NStepWave2*WaveDOmega (= WaveOmegaMax) ) - WGNC = (0.0,0.0) - ELSEIF ( InitInp%WaveMod == 10 ) THEN ! .TRUE. for plane progressive (regular) waves with a specified phase - WGNC = BoxMuller ( InitInp%RNG%pRNG, InitInp%WaveNDAmp, InitInp%WavePhase ) - ! This scaling of WGNC is used to ensure that the Box-Muller method is only providing a random phase, - ! not a magnitude change, at the frequency of the plane progressive wave. The SQRT(2.0) is used to - ! ensure that the time series WGN process has unit variance (i.e. sinusoidal with amplitude SQRT(2.0)). - ! - ! NOTE: the denominator here will never equal zero since U1 cannot equal 1.0, and thus, C1 cannot be - ! 0.0 in the Box-Muller method. - IF ( ( I == I_WaveTp ) ) WGNC = WGNC*( SQRT(2.0)/ABS(WGNC) ) - ELSE ! All other Omega - WGNC = BoxMuller ( InitInp%RNG%pRNG, InitInp%WaveNDAmp ) - ! This scaling of WGNC is used to ensure that the Box-Muller method is only providing a random phase, - ! not a magnitude change, at the frequency of the plane progressive wave. The SQRT(2.0) is used to - ! ensure that the time series WGN process has unit variance (i.e. sinusoidal with amplitude SQRT(2.0)). - ! - ! NOTE: the denominator here will never equal zero since U1 cannot equal 1.0, and thus, C1 cannot be - ! 0.0 in the Box-Muller method. - IF ( ( InitInp%WaveMod == 1 ) .AND. ( I == I_WaveTp ) ) WGNC = WGNC*( SQRT(2.0)/ABS(WGNC) ) - END IF - - - ! Compute the one-sided power spectral density of the wave spectrum per unit - ! time; zero-out the wave spectrum above the cut-off frequency: - - SELECT CASE ( InitInp%WaveMod ) ! Which incident wave kinematics model are we using? - - CASE ( 1, 10 ) ! Plane progressive (regular) wave; the wave spectrum is an impulse function centered on frequency component closest to WaveTp. - IF ( I == I_WaveTp ) THEN ! .TRUE. if we are at the Omega closest to WaveTp. - WaveS1Sdd = 0.5*(InitInp%WaveHs/2.0)*(InitInp%WaveHs/2.0)/InitOut%WaveDOmega - ELSE ! All other Omega - WaveS1Sdd = 0.0 - END IF - - CASE ( 2 ) ! JONSWAP/Pierson-Moskowitz spectrum (irregular) wave. - ! Zero-out the wave spectrum above the cut-off frequency. We must cut-off the frequency in order to - ! void nonphysical wave forces. Waves that have wavelengths much smaller than the platform diameter - ! (high frequency) do not contribute to the net force because regions of positive and negative - ! velocity/acceleration are experienced by the platform at the same time and cancel out. - ! - ! JASON: OTHER FREQUENCY CUT-OFF CONDITIONS ARE USED THROUGHOUT THE INDUSTRY. SHOULD YOU USE ONE OF - ! THEM INSTEAD? SEE, FOR EXAMPLE, MY E-MAIL EXCHANGES WITH PAUL SCLAVOUNOS DATED 5/26/2006 OR: - ! "GH Bladed Thoery Manual" OR: Trumars, Jenny M. V.; Tarp-Johansen, Niels Jacob; Krogh, Thomas; - ! "The Effect of Wave Modelling on Offshore Wind Turbine Fatigue Loads," 2005 Copenhagen Offshore - ! Wind Conference and Exhibition, 26-28 October 2005, Copenhagen, Denmark [CD-ROM]. - IF ( Omega < InitInp%WvLowCOff .OR. Omega > InitInp%WvHiCOff ) THEN ! .TRUE. if Omega is above or below the cut-off frequency - WaveS1Sdd = 0.0 - ELSE ! All other Omega - WaveS1Sdd = JONSWAP ( Omega, InitInp%WaveHs, InitInp%WaveTp, InitInp%WavePkShp ) - END IF - CASE ( 3 ) ! White-noise - IF ( Omega < InitInp%WvLowCOff .OR. Omega > InitInp%WvHiCOff ) THEN ! .TRUE. if Omega is above or below the cut-off frequency - WaveS1Sdd = 0.0 - ELSE - WaveS1Sdd = InitInp%WaveHs * InitInp%WaveHs / ( 8.0 * (InitInp%WvHiCOff - InitInp%WvLowCOff) ) - END IF - CASE ( 4 ) ! User-defined spectrum (irregular) wave. - IF ( Omega < InitInp%WvLowCOff .OR. Omega > InitInp%WvHiCOff ) THEN ! .TRUE. if Omega is above or below the cut-off frequency - WaveS1Sdd = 0.0 - ELSE - CALL UserWaveSpctrm ( Omega, InitInp%WaveDir, InitInp%DirRoot, WaveS1Sdd ) - END IF - - ENDSELECT - - - IF ( InitInp%WaveMod == 5 ) THEN ! Wave Elevation data read in - - ! Apply limits to the existing WaveElevC0 arrays if outside frequency range - IF ( Omega < InitInp%WvLowCOff .OR. Omega > InitInp%WvHiCOff ) THEN - InitOut%WaveElevC0(:,I) = 0.0_SiKi - ENDIF - - ELSE ! All other wave cases - - ! Compute the two-sided power spectral density of the wave spectrum per unit - ! time: - - WaveS2Sdd = 0.5*WaveS1Sdd - - - ! Compute the discrete Fourier transform of the instantaneous elevation of - ! incident waves at the WAMIT reference point: - tmpComplex = SQRTNStepWave2*WGNC*SQRT( TwoPi*WaveS2Sdd/REAL(InitInp%WaveDT,SiKi) ) - InitOut%WaveElevC0 (1,I) = REAL( tmpComplex) - InitOut%WaveElevC0 (2,I) = AIMAG(tmpComplex) - - ENDIF - - END DO ! I - The positive frequency components (including zero) of the discrete Fourier transforms - - !-------------------------------------------------------------------------------- - !=== Multi-Directional Waves === - !> ## Assign Wave directions - !! For the equal energy approach to the multi-directional waves, we need to use the random number generator to - !! select which direction each wave frequency is assigned to. We also require that the phase and amplitudes - !! assigned to each frequency are the same regardless of whether or not multiple directions are used, we must - !! first finish assigning all the amplitudes and phases before using the random number generator again. For this - !! reason, the above do loop is completed, the multiple wave directions are computed, and then we run through the - !! all wave frequencies again to set up the remaining pieces. If we did not do this, we would change the seed - !! used by the random number generator before selecting the next amplitude and phase pair. - !! - !! The wave directions are assigned in groups of _WaveNDir_ frequencies such that each frequency is assigned to - !! one of the _WaveNDir_ unique wave directions. Each wave direction is used only once within each group of - !! frequencies. - !! - !! When complete, we deallocate the _WvSpreadThetas_ array that was used to store the assigned directions. - - IF ( InitInp%WaveMultiDir .AND. InitInp%WaveNDir > 1 ) THEN ! Multi-directional waves in use - - - ! Allocate the index array for each group of frequencies. This array is used to randomize the directions - ! within each WaveNDir sized group of frequencies. This is a REAL array used to hold the random numbers. - ALLOCATE( WvSpreadThetaIdx(1:InitOut%WaveNDir), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WvSpreadThetaIdx while assigning '// & - 'wave directions.',ErrStat,ErrMsg,'VariousWaves_Init') - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp() - RETURN - END IF - - - ! Reset the K so that we can use it to count the frequency index. - ! It should be exactly NStepWave2 when done assigning directions. The the Omega = 0 has - ! no amplitude, but gets a direction anyhow (to simplify the calculation of WaveNDir). - K = 0 - - - ! Work through the frequencies in groups of directions. - DO I = 1,WvSpreadFreqPerDir - - ! Populate the array with random numbers - CALL UniformRandomNumbers(InitInp%RNG%pRNG, WvSpreadThetaIdx) - - DO J = 1, InitOut%WaveNDir - - ! Find the index lowest value in the WvSpreadThetaIdx array. This is the index to - ! use for this wave direction. - LastInd = MINLOC( WvSpreadThetaIdx, DIM=1 ) - - ! Assign the direction for this frequency piece to the LastInd value. - InitOut%WaveDirArr(K) = WvTheta( LastInd ) - - ! Now make that element in the WvSpreadThetaIdx really big so we don't pick it again - WvSpreadThetaIdx( LastInd ) = HUGE(1.0_SiKi) - - K = K + 1 ! Increment the frequency index - - ENDDO - ENDDO - ! Filling last value since it is not reached by the loop above - CALL UniformRandomNumbers(InitInp%RNG%pRNG, WvSpreadThetaIdx) - LastInd = MINLOC( WvSpreadThetaIdx, DIM=1 ) - InitOut%WaveDirArr(K) = WvTheta( LastInd ) - - ! Perform a quick sanity check. We should have assigned all wave frequencies a direction, so K should be - ! K = NStepWave2 (K is incrimented afterwards). - IF ( K /= (InitOut%NStepWave2 ) ) CALL SetErrStat(ErrID_Fatal, & - 'Something went wrong while assigning wave directions.',ErrStat,ErrMsg,'VariousWaves_Init') - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp() - RETURN - END IF - - ! We are done with the indexing array, so deallocate it - IF(ALLOCATED( WvSpreadThetaIdx )) DEALLOCATE( WvSpreadThetaIdx ) - - ! This had been allocated above (calculation section of equal energy portion of multidirectional waves). - ! Deallocate it here after we have completed all the calculations involving it. - IF(ALLOCATED( WvTheta )) DEALLOCATE( WvTheta ) - - ELSE ! Not really multi-directional waves - - ! Since we do not have multi-directional waves, we must set the wave direction array to the single wave heading. - InitOut%WaveDirArr = InitInp%WaveDir - ENDIF ! Multi-directional waves in use. - - - ! Set the CosWaveDir and SinWaveDir arrays - CosWaveDir=COS(D2R*InitOut%WaveDirArr) - SinWaveDir=SIN(D2R*InitOut%WaveDirArr) - - - !-------------------------------------------------------------------------------- - !> ## Phase shift the discrete Fourier transform of wave elevations at the WRP - !> This changes the phasing of all wave kinematics and loads to reflect the turbine's - !! location in the larger farm, in the case of FAST.Farm simulations, based on - !! specified PtfmLocationX and PtfmLocationY. - - IF (InitInp%WaveFieldMod == 2) THEN ! case 2: adjust wave phases based on turbine offsets from farm origin - - CALL WrScr ( ' Adjusting incident wave kinematics for turbine offset from array origin.' ) - - DO I = 0,InitOut%NStepWave2 - - tmpComplex = CMPLX( InitOut%WaveElevC0(1,I), InitOut%WaveElevC0(2,I)) - - ! some redundant calculations with later, but insignificant - Omega = I*InitOut%WaveDOmega - WaveNmbr = WaveNumber ( Omega, InitInp%Gravity, InitInp%WtrDpth ) - - ! apply the phase shift - tmpComplex = tmpComplex * EXP( -ImagNmbr*WaveNmbr*( InitInp%PtfmLocationX*CosWaveDir(I) + InitInp%PtfmLocationY*SinWaveDir(I) )) - - ! put shifted complex amplitudes back into the array for use in the remainder of this module and other modules (Waves2, WAMIT, WAMIT2) - InitOut%WaveElevC0 (1,I) = REAL( tmpComplex) - InitOut%WaveElevC0 (2,I) = AIMAG(tmpComplex) - - END DO - END IF - - - !-------------------------------------------------------------------------------- - !> ## Compute IFFTs - !> Compute the discrete Fourier transform of the instantaneous elevation of - !! incident waves at each desired point on the still water level plane - !! where it can be output: - - DO I = 0,InitOut%NStepWave2 ! Loop through the positive frequency components (including zero) of the discrete Fourier transforms - - - ! Set tmpComplex to the Ith element of the WAveElevC0 array - - tmpComplex = CMPLX( InitOut%WaveElevC0(1,I), InitOut%WaveElevC0(2,I)) - - - ! Compute the frequency of this component and its imaginary value: - - Omega = I* InitOut%WaveDOmega - ImagOmega = ImagNmbr*Omega - - ! Compute the wavenumber: - - WaveNmbr = WaveNumber ( Omega, InitInp%Gravity, InitInp%WtrDpth ) - - - ! Compute the discrete Fourier transform of the incident wave kinematics - ! before applying stretching at the zi-coordinates for the WAMIT reference point, and all - ! points where are Morison loads will be calculated. - - DO J = 1,NWaveKin0Prime ! Loop through all points where the incident wave kinematics will be computed without stretching - - WaveElevxiPrime0 = EXP( -ImagNmbr*WaveNmbr*( InitInp%WaveKinxi(WaveKinPrimeMap(J))*CosWaveDir(I) + & - InitInp%WaveKinyi(WaveKinPrimeMap(J))*SinWaveDir(I) )) - - WaveDynPC0 (I,J) = InitOut%RhoXg*tmpComplex*WaveElevxiPrime0 * COSHNumOvrCOSHDen ( WaveNmbr, InitInp%WtrDpth, WaveKinzi0Prime(J) ) - - WaveVelC0Hxi (I,J) = CosWaveDir(I)*Omega*tmpComplex* WaveElevxiPrime0 * COSHNumOvrSINHDen ( WaveNmbr, InitInp%WtrDpth, WaveKinzi0Prime(J) ) - WaveVelC0Hyi (I,J) = SinWaveDir(I)*Omega*tmpComplex* WaveElevxiPrime0 * COSHNumOvrSINHDen ( WaveNmbr, InitInp%WtrDpth, WaveKinzi0Prime(J) ) - - WaveVelC0V (I,J) = ImagOmega*tmpComplex* WaveElevxiPrime0 * SINHNumOvrSINHDen ( WaveNmbr, InitInp%WtrDpth, WaveKinzi0Prime(J) ) - WaveAccC0Hxi (I,J) = ImagOmega* WaveVelC0Hxi (I,J) - - WaveAccC0Hyi (I,J) = ImagOmega* WaveVelC0Hyi (I,J) - WaveAccC0V (I,J) = ImagOmega* WaveVelC0V (I,J) - - - - - END DO ! J - All points where the incident wave kinematics will be computed without stretching - -!=================================== -! Wave stretching - ! DO J = 1,InitInp%NWaveKin - ! WaveElevxiPrime0 = EXP( -ImagNmbr*WaveNmbr*( InitInp%WaveKinxi(J)*CosWaveDir(I) + & - ! InitInp%WaveKinyi(J)*SinWaveDir(I) )) - !! Partial derivatives at zi = 0 - ! PWaveDynPC0BPz0 (I,J) = InitOut%RhoXg* tmpComplex*WaveElevxiPrime0*WaveNmbr*TANH ( WaveNmbr*InitInp%WtrDpth ) - ! PWaveVelC0HxiPz0(I,J) = CosWaveDir(I)*Omega*tmpComplex*WaveElevxiPrime0*WaveNmbr - ! PWaveVelC0HyiPz0(I,J) = SinWaveDir(I)*Omega*tmpComplex*WaveElevxiPrime0*WaveNmbr - ! PWaveVelC0VPz0 (I,J) = ImagOmega*tmpComplex*WaveElevxiPrime0*WaveNmbr*COTH ( WaveNmbr*InitInp%WtrDpth ) - ! PWaveAccC0HxiPz0(I,J) = ImagOmega*PWaveVelC0HxiPz0(I,J) - ! PWaveAccC0HyiPz0(I,J) = ImagOmega*PWaveVelC0HyiPz0(I,J) - ! PWaveAccC0VPz0 (I,J) = ImagOmega*PWaveVelC0VPz0 (I,J) - ! - ! - ! END DO ! J - All points where the incident wave kinematics will be computed without stretching -!=================================== - - END DO ! I - The positive frequency components (including zero) of the discrete Fourier transforms - - - - ! Calculate the array of simulation times at which the instantaneous - ! elevation of, velocity of, acceleration of, and loads associated with - ! the incident waves are to be determined: - - DO I = 0,InitOut%NStepWave ! Loop through all time steps - InitOut%WaveTime(I) = I*REAL(InitInp%WaveDT,SiKi) - END DO ! I - All time steps - - DO I = 0,InitOut%NStepWave2 ! Loop through the positive frequency components (including zero) of the discrete Fourier transform - tmpComplexArr(I) = CMPLX(InitOut%WaveElevC0(1,I), InitOut%WaveElevC0(2,I)) - END DO - - ! Compute the inverse discrete Fourier transforms to find the time-domain - ! representations of the wave kinematics without stretcing: - - CALL InitFFT ( InitOut%NStepWave, FFT_Data, .TRUE., ErrStatTmp ) - CALL SetErrStat(ErrStatTmp,'Error occured while initializing the FFT.',ErrStat,ErrMsg,'VariousWaves_Init') - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp() - RETURN - END IF - - ! We'll need the following for wave stretching once we implement it. - CALL ApplyFFT_cx ( InitOut%WaveElev0 (0:InitOut%NStepWave-1), tmpComplexArr (: ), FFT_Data, ErrStatTmp ) - CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT to WaveElev0.',ErrStat,ErrMsg,'VariousWaves_Init') - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp() - RETURN - END IF - - DO J = 1,InitInp%NWaveElev ! Loop through all points where the incident wave elevations can be output - ! This subroutine call applies the FFT at the correct location. - CALL WaveElevTimeSeriesAtXY( InitInp%WaveElevxi(J), InitInp%WaveElevyi(J), InitOut%WaveElev(:,J), ErrStatTmp, ErrMsgTmp ) - CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT to InitOut%WaveElev.',ErrStat,ErrMsg,'VariousWaves_Init') - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp() - RETURN - END IF - END DO ! J - All points where the incident wave elevations can be output - - ! :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: - !@mhall: hard-coding some additional wave elevation time series output for now - - !ALLOCATE ( InitOut%WaveElevMD (0:InitOut%NStepWave, WaveGrid_nx*WaveGrid_ny), STAT=ErrStatTmp ) - !IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array InitOut%WaveElevMD.', ErrStat,ErrMsg,'VariousWaves_Init') - ! - !DO J = 1,WaveGrid_ny !y = -60.0 + 20.0*J - ! DO K = 1,WaveGrid_nx !x = -60.0 + 20.0*K - ! - ! I = (J-1)*WaveGrid_nx + K ! index of actual node - ! - ! CALL WaveElevTimeSeriesAtXY( WaveGrid_x0 + WaveGrid_dx*(K-1), WaveGrid_y0 + WaveGrid_dy*(J-1), InitOut%WaveElevMD(:,I), ErrStatTmp, ErrMsgTmp ) - ! CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT to InitOut%WaveElevMD.',ErrStat,ErrMsg,'VariousWaves_Init') - ! IF ( ErrStat >= AbortErrLev ) THEN - ! CALL CleanUp() - ! RETURN - ! END IF - ! END DO - !END DO - - ! :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: - - - ! For creating animations of the sea surface, the WaveElevXY array is passed in with a series of x,y coordinates - ! (index 1). The second index corresponds to the number of points passed in. A two dimensional time series - ! is created with the first index corresponding to the timestep, and second index corresponding to the second - ! index of the WaveElevXY array. - IF ( ALLOCATED(InitInp%WaveElevXY)) THEN - ALLOCATE ( InitOut%WaveElevSeries (0:InitOut%NStepWave, 1:SIZE(InitInp%WaveElevXY, DIM=2)) , STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) THEN - CALL SetErrStat(ErrID_Fatal,'Cannot allocate array InitOut%WaveElevSeries.',ErrStat,ErrMsg,'VariousWaves_Init') - CALL CleanUp() - RETURN - END IF - ! Calculate the wave elevation at all points requested in the array WaveElevXY - DO J = 1,SIZE(InitInp%WaveElevXY, DIM=2) - ! This subroutine call applies the FFT at the correct location. - CALL WaveElevTimeSeriesAtXY( InitInp%WaveElevXY(1,J), InitInp%WaveElevXY(2,J), InitOut%WaveElevSeries(0:InitOut%NStepWave,J), ErrStatTmp, ErrMsgTmp ) - CALL SetErrStat(ErrStatTmp,ErrMsgTmp,ErrStat,ErrMsg,'VariousWaves_Init') - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp() - RETURN - END IF - ENDDO - ENDIF - - - ! User requested data points -- Do all the FFT calls first, then return if something failed. - DO J = 1,NWaveKin0Prime ! Loop through all points where the incident wave kinematics will be computed without stretching - CALL ApplyFFT_cx ( WaveDynP0B (:,J), WaveDynPC0 (:,J), FFT_Data, ErrStatTmp ) - CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT to WaveDynP0B.', ErrStat,ErrMsg,'VariousWaves_Init') - - CALL ApplyFFT_cx ( WaveVel0Hxi (:,J), WaveVelC0Hxi (:,J), FFT_Data, ErrStatTmp ) - CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT to WaveVel0Hxi.', ErrStat,ErrMsg,'VariousWaves_Init') - - CALL ApplyFFT_cx ( WaveVel0Hyi (:,J), WaveVelC0Hyi (:,J), FFT_Data, ErrStatTmp ) - CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT to WaveVel0Hyi.', ErrStat,ErrMsg,'VariousWaves_Init') - - CALL ApplyFFT_cx ( WaveVel0V (:,J), WaveVelC0V (:,J), FFT_Data, ErrStatTmp ) - CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT to WaveVel0V.', ErrStat,ErrMsg,'VariousWaves_Init') - - CALL ApplyFFT_cx ( WaveAcc0Hxi (:,J), WaveAccC0Hxi (:,J), FFT_Data, ErrStatTmp ) - CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT to WaveAcc0Hxi.', ErrStat,ErrMsg,'VariousWaves_Init') - - CALL ApplyFFT_cx ( WaveAcc0Hyi (:,J), WaveAccC0Hyi (:,J), FFT_Data, ErrStatTmp ) - CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT to WaveAcc0Hyi.', ErrStat,ErrMsg,'VariousWaves_Init') - - CALL ApplyFFT_cx ( WaveAcc0V (:,J), WaveAccC0V (:,J), FFT_Data, ErrStatTmp ) - CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT to WaveAcc0V.', ErrStat,ErrMsg,'VariousWaves_Init') - - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp() - RETURN - END IF - - END DO ! J - All points where the incident wave kinematics will be computed without stretching - -!=================================== - !DO J = 1,InitInp%NWaveKin ! Loop through all points where the incident wave kinematics will be computed without stretching - ! ! FFT's of the partial derivatives - ! CALL ApplyFFT_cx ( PWaveDynP0BPz0(:,J ), PWaveDynPC0BPz0(:,J ), FFT_Data, ErrStatTmp ) - ! CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT to PWaveDynP0BPz0.', ErrStat,ErrMsg,'VariousWaves_Init') - ! - ! CALL ApplyFFT_cx ( PWaveVel0HxiPz0 (:,J ), PWaveVelC0HxiPz0( :,J ),FFT_Data, ErrStatTmp ) - ! CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT to PWaveVel0HxiPz0.', ErrStat,ErrMsg,'VariousWaves_Init') - ! - ! CALL ApplyFFT_cx ( PWaveVel0HyiPz0 (:,J ), PWaveVelC0HyiPz0( :,J ),FFT_Data, ErrStatTmp ) - ! CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT to PWaveVel0HyiPz0.', ErrStat,ErrMsg,'VariousWaves_Init') - ! - ! CALL ApplyFFT_cx ( PWaveVel0VPz0 (:,J ), PWaveVelC0VPz0 (:,J ), FFT_Data, ErrStatTmp ) - ! CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT to PWaveVel0VPz0.', ErrStat,ErrMsg,'VariousWaves_Init') - ! - ! CALL ApplyFFT_cx ( PWaveAcc0HxiPz0 (:,J ), PWaveAccC0HxiPz0(:,J ),FFT_Data, ErrStatTmp ) - ! CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT to PWaveAcc0HxiPz0.', ErrStat,ErrMsg,'VariousWaves_Init') - ! - ! CALL ApplyFFT_cx ( PWaveAcc0HyiPz0 (:,J ), PWaveAccC0HyiPz0(:,J ),FFT_Data, ErrStatTmp ) - ! CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT to PWaveAcc0HyiPz0.', ErrStat,ErrMsg,'VariousWaves_Init') - ! - ! CALL ApplyFFT_cx ( PWaveAcc0VPz0 (:,J ), PWaveAccC0VPz0( :,J ), FFT_Data, ErrStatTmp ) - ! CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT to PWaveAcc0VPz0.', ErrStat,ErrMsg,'VariousWaves_Init') - ! - ! IF ( ErrStat >= AbortErrLev ) THEN - ! CALL CleanUp() - ! RETURN - ! END IF - ! - !END DO ! J - All points where the incident wave kinematics will be computed without stretching -!=================================== - - - CALL ExitFFT(FFT_Data, ErrStatTmp) - CALL SetErrStat(ErrStatTmp,'Error occured while cleaning up after the FFTs.', ErrStat,ErrMsg,'VariousWaves_Init') - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp() - RETURN - END IF - - - - ! Add the current velocities to the wave velocities: - ! NOTE: Both the horizontal velocities and the partial derivative of the - ! horizontal velocities with respect to zi at zi = 0 are found here. - ! - ! NOTE: The current module must be called prior to the waves module. If that was not done, then we - ! don't have a current to add to the wave velocity. So, check if the current velocity components - ! exist. - - - ! If there is a current, we need to add that (the current module was called prior to calling this module - - IF(ALLOCATED(InitInp%CurrVxi)) THEN - - DO J = 1,NWaveKin0Prime ! Loop through all points where the incident wave kinematics will be computed without stretching - - WaveVel0Hxi (:,J) = WaveVel0Hxi (:,J) + InitInp%CurrVxi(WaveKinPrimeMap(J)) ! xi-direction - WaveVel0Hyi (:,J) = WaveVel0Hyi (:,J) + InitInp%CurrVyi(WaveKinPrimeMap(J)) ! yi-direction - - END DO ! J - All points where the incident wave kinematics will be computed without stretching - - !PWaveVel0HxiPz0(: ) = PWaveVel0HxiPz0(: ) + InitInp%PCurrVxiPz0 ! xi-direction - !PWaveVel0HyiPz0(: ) = PWaveVel0HyiPz0(: ) + InitInp%PCurrVyiPz0 ! yi-direction - - ENDIF - - - ! Apply stretching to obtain the wave kinematics, WaveDynP0, WaveVel0, and - ! WaveAcc0, at the desired locations from the wave kinematics at - ! alternative locations, WaveDynP0B, WaveVel0Hxi, WaveVel0Hyi, WaveVel0V, - ! WaveAcc0Hxi, WaveAcc0Hyi, WaveAcc0V, if the elevation of the point defined by - ! WaveKinzi(J) lies between the seabed and the instantaneous free - ! surface, else set WaveDynP0, WaveVel0, and WaveAcc0 to zero. This - ! depends on which incident wave kinematics stretching method is being - ! used: - - ! SELECT CASE ( InitInp%WaveStMod ) ! Which model are we using to extrapolate the incident wave kinematics to the instantaneous free surface? - - ! CASE ( 0 ) ! None=no stretching. - - - ! Since we have no stretching, the wave kinematics between the seabed and - ! the mean sea level are left unchanged; below the seabed or above the - ! mean sea level, the wave kinematics are zero: - - InitOut%PWaveDynP0(:,:) = 0.0 - InitOut%PWaveVel0 (:,:,:) = 0.0 - InitOut%PWaveAcc0 (:,:,:) = 0.0 - K = 1 - DO J = 1,InitInp%NWaveKin ! Loop through all points where the incident wave kinematics will be computed - - IF ( ( InitInp%WaveKinzi(J) < -InitInp%WtrDpth ) .OR. ( InitInp%WaveKinzi(J) > 0.0 ) ) THEN - ! .TRUE. if the elevation of the point defined by WaveKinzi(J) lies below the seabed or above mean sea level (exclusive) - ! NOTE: We test to 0 instead of MSL2SWL because the locations of WaveKinzi and WtrDpth have already been adjusted using MSL2SWL - - InitOut%WaveDynP(:,J ) = 0.0 - InitOut%WaveVel (:,J,:) = 0.0 - InitOut%WaveAcc (:,J,:) = 0.0 - - ELSE - ! The elevation of the point defined by WaveKinzi(J) must lie between the seabed and the mean sea level (inclusive) - - InitOut%WaveDynP(0:InitOut%NStepWave-1,J ) = WaveDynP0B( 0:InitOut%NStepWave-1,K) - InitOut%WaveVel (0:InitOut%NStepWave-1,J,1) = WaveVel0Hxi(0:InitOut%NStepWave-1,K) - InitOut%WaveVel (0:InitOut%NStepWave-1,J,2) = WaveVel0Hyi(0:InitOut%NStepWave-1,K) - InitOut%WaveVel (0:InitOut%NStepWave-1,J,3) = WaveVel0V( 0:InitOut%NStepWave-1,K) - InitOut%WaveAcc (0:InitOut%NStepWave-1,J,1) = WaveAcc0Hxi(0:InitOut%NStepWave-1,K) - InitOut%WaveAcc (0:InitOut%NStepWave-1,J,2) = WaveAcc0Hyi(0:InitOut%NStepWave-1,K) - InitOut%WaveAcc (0:InitOut%NStepWave-1,J,3) = WaveAcc0V( 0:InitOut%NStepWave-1,K) - K = K + 1 - END IF - - END DO ! J - All points where the incident wave kinematics will be computed - - ! CASE ( 1 ) ! Vertical stretching. - - - ! Vertical stretching says that the wave kinematics above the mean sea level - ! equal the wave kinematics at the mean sea level. The wave kinematics - ! below the mean sea level are left unchanged: - - - - - - ! CASE ( 2 ) ! Extrapolation stretching. - - - ! Extrapolation stretching uses a linear Taylor expansion of the wave - ! kinematics (and their partial derivatives with respect to z) at the mean - ! sea level to find the wave kinematics above the mean sea level. The - ! wave kinematics below the mean sea level are left unchanged: - - - - - - ! CASE ( 3 ) ! Wheeler stretching. - - - ! Wheeler stretching says that wave kinematics calculated using Airy theory - ! at the mean sea level should actually be applied at the instantaneous - ! free surface and that Airy wave kinematics computed at locations between - ! the seabed and the mean sea level should be shifted vertically to new - ! locations in proportion to their elevation above the seabed. - ! - ! Computing the wave kinematics with Wheeler stretching requires that first - ! say that the wave kinematics we computed at the elevations defined by - ! the WaveKinzi0Prime(:) array are actual applied at the elevations found - ! by stretching the elevations in the WaveKinzi0Prime(:) array using the - ! instantaneous wave elevation--these new elevations are stored in the - ! WaveKinzi0St(:) array. Next, we interpolate the wave kinematics - ! computed without stretching to the desired elevations (defined in the - ! WaveKinzi(:) array) using the WaveKinzi0St(:) array: - - - - - ! ENDSELECT - - ! Set the ending timestep to the same as the first timestep - InitOut%WaveDynP(InitOut%NStepWave,: ) = InitOut%WaveDynP(0,: ) - InitOut%WaveVel (InitOut%NStepWave,:,:) = InitOut%WaveVel (0,:,:) - InitOut%WaveAcc (InitOut%NStepWave,:,:) = InitOut%WaveAcc (0,:,:) - InitOut%PWaveDynP0(InitOut%NStepWave,: ) = InitOut%PWaveDynP0(0,: ) - InitOut%PWaveVel0 (InitOut%NStepWave,:,:) = InitOut%PWaveVel0 (0,:,:) - InitOut%PWaveAcc0 (InitOut%NStepWave,:,:) = InitOut%PWaveAcc0 (0,:,:) - InitOut%WaveElev0 (InitOut%NStepWave) = InitOut%WaveElev0 (0 ) - - - - CALL CleanUp ( ) - - -CONTAINS - - - SUBROUTINE WaveElevTimeSeriesAtXY(Xcoord,Ycoord, WaveElevSeriesAtXY, ErrStatLcl, ErrMsgLcl ) - - REAL(SiKi), INTENT(IN ) :: Xcoord - REAL(SiKi), INTENT(IN ) :: Ycoord - REAL(SiKi), INTENT( OUT) :: WaveElevSeriesAtXY(0:InitOut%NStepWave) - INTEGER(IntKi), INTENT( OUT) :: ErrStatLcl - INTEGER(IntKi) :: ErrStatLcl2 - CHARACTER(*), INTENT( OUT) :: ErrMsgLcl - - ! This is probably poor programming practice, but we will use I, Omega, WaveNmbr, and tmpComplexArr from the calling routine here. - - ErrStatLcl = ErrID_None - - ! Zero out the temporary array. - tmpComplexArr = CMPLX(0.0_SiKi,0.0_SiKi) - - ! Loop through the positive frequency components (including zero). - DO I = 0,InitOut%NStepWave2 - - Omega = I* InitOut%WaveDOmega - WaveNmbr = WaveNumber ( Omega, InitInp%Gravity, InitInp%WtrDpth ) - tmpComplexArr(I) = CMPLX( InitOut%WaveElevC0(1,I), InitOut%WaveElevC0(2,I)) * & - EXP( -ImagNmbr*WaveNmbr*( Xcoord*CosWaveDir(I)+ & - Ycoord*SinWaveDir(I) ) ) - ENDDO - - CALL ApplyFFT_cx ( WaveElevSeriesAtXY(0:InitOut%NStepWave-1), tmpComplexArr, FFT_Data, ErrStatLcl2 ) - CALL SetErrStat(ErrStatLcl2,'Error occured while applying the FFT to InitOut%WaveElevSeries.',ErrStatLcl,ErrMsgLcl,'WaveElevTimeSeriesAtXY') - - ! Append first datpoint as the last as aid for repeated wave data - WaveElevSeriesAtXY(InitOut%NStepWave) = WaveElevSeriesAtXY(0) - - END SUBROUTINE WaveElevTimeSeriesAtXY - - - - SUBROUTINE CleanUp( ) - - IF (ALLOCATED( WaveKinPrimeMap )) DEALLOCATE( WaveKinPrimeMap, STAT=ErrStatTmp) - IF (ALLOCATED( WaveKinzi0Prime )) DEALLOCATE( WaveKinzi0Prime, STAT=ErrStatTmp) - IF (ALLOCATED( WvSpreadCos2SArr )) DEALLOCATE( WvSpreadCos2SArr, STAT=ErrStatTmp) - IF (ALLOCATED( WvSpreadIntegral )) DEALLOCATE( WvSpreadIntegral, STAT=ErrStatTmp) - IF (ALLOCATED( WvSpreadThetas )) DEALLOCATE( WvSpreadThetas, STAT=ErrStatTmp) - IF (ALLOCATED( TmpWaveSeeds )) DEALLOCATE( TmpWaveSeeds, STAT=ErrStatTmp) - IF (ALLOCATED( GHWaveAcc )) DEALLOCATE( GHWaveAcc, STAT=ErrStatTmp) - IF (ALLOCATED( GHWaveDynP )) DEALLOCATE( GHWaveDynP, STAT=ErrStatTmp) - IF (ALLOCATED( GHWaveVel )) DEALLOCATE( GHWaveVel, STAT=ErrStatTmp) - IF (ALLOCATED( GHWvDpth )) DEALLOCATE( GHWvDpth, STAT=ErrStatTmp) - !IF (ALLOCATED( PWaveAcc0HxiPz0 )) DEALLOCATE( PWaveAcc0HxiPz0, STAT=ErrStatTmp) - !IF (ALLOCATED( PWaveAcc0HyiPz0 )) DEALLOCATE( PWaveAcc0HyiPz0, STAT=ErrStatTmp) - !IF (ALLOCATED( PWaveAcc0VPz0 )) DEALLOCATE( PWaveAcc0VPz0, STAT=ErrStatTmp) - !IF (ALLOCATED( PWaveAccC0HxiPz0 )) DEALLOCATE( PWaveAccC0HxiPz0, STAT=ErrStatTmp) - !IF (ALLOCATED( PWaveAccC0HyiPz0 )) DEALLOCATE( PWaveAccC0HyiPz0, STAT=ErrStatTmp) - !IF (ALLOCATED( PWaveAccC0VPz0 )) DEALLOCATE( PWaveAccC0VPz0, STAT=ErrStatTmp) - !IF (ALLOCATED( PWaveDynP0BPz0 )) DEALLOCATE( PWaveDynP0BPz0, STAT=ErrStatTmp) - !IF (ALLOCATED( PWaveDynPC0BPz0 )) DEALLOCATE( PWaveDynPC0BPz0, STAT=ErrStatTmp) - !IF (ALLOCATED( PWaveVel0HxiPz0 )) DEALLOCATE( PWaveVel0HxiPz0, STAT=ErrStatTmp) - !IF (ALLOCATED( PWaveVel0HyiPz0 )) DEALLOCATE( PWaveVel0HyiPz0, STAT=ErrStatTmp) - !IF (ALLOCATED( PWaveVel0VPz0 )) DEALLOCATE( PWaveVel0VPz0, STAT=ErrStatTmp) - !IF (ALLOCATED( PWaveVelC0HxiPz0 )) DEALLOCATE( PWaveVelC0HxiPz0, STAT=ErrStatTmp) - !IF (ALLOCATED( PWaveVelC0HyiPz0 )) DEALLOCATE( PWaveVelC0HyiPz0, STAT=ErrStatTmp) - !IF (ALLOCATED( PWaveVelC0VPz0 )) DEALLOCATE( PWaveVelC0VPz0, STAT=ErrStatTmp) - IF (ALLOCATED( WaveAcc0Hxi )) DEALLOCATE( WaveAcc0Hxi, STAT=ErrStatTmp) - IF (ALLOCATED( WaveAcc0Hyi )) DEALLOCATE( WaveAcc0Hyi, STAT=ErrStatTmp) - IF (ALLOCATED( WaveAcc0V )) DEALLOCATE( WaveAcc0V, STAT=ErrStatTmp) - IF (ALLOCATED( WaveAccC0Hxi )) DEALLOCATE( WaveAccC0Hxi, STAT=ErrStatTmp) - IF (ALLOCATED( WaveAccC0Hyi )) DEALLOCATE( WaveAccC0Hyi, STAT=ErrStatTmp) - IF (ALLOCATED( WaveAccC0V )) DEALLOCATE( WaveAccC0V, STAT=ErrStatTmp) - IF (ALLOCATED( WaveDynP0B )) DEALLOCATE( WaveDynP0B, STAT=ErrStatTmp) - IF (ALLOCATED( WaveDynPC0 )) DEALLOCATE( WaveDynPC0, STAT=ErrStatTmp) - ! IF (ALLOCATED( WaveElev0 )) DEALLOCATE( WaveElev0, STAT=ErrStatTmp) - IF (ALLOCATED( WaveElevC )) DEALLOCATE( WaveElevC, STAT=ErrStatTmp) - IF (ALLOCATED( WaveVel0Hxi )) DEALLOCATE( WaveVel0Hxi, STAT=ErrStatTmp) - IF (ALLOCATED( WaveVel0Hyi )) DEALLOCATE( WaveVel0Hyi, STAT=ErrStatTmp) - IF (ALLOCATED( WaveVel0V )) DEALLOCATE( WaveVel0V, STAT=ErrStatTmp) - IF (ALLOCATED( WaveVelC0Hxi )) DEALLOCATE( WaveVelC0Hxi, STAT=ErrStatTmp) - IF (ALLOCATED( WaveVelC0Hyi )) DEALLOCATE( WaveVelC0Hyi, STAT=ErrStatTmp) - IF (ALLOCATED( WaveVelC0V )) DEALLOCATE( WaveVelC0V, STAT=ErrStatTmp) - IF (ALLOCATED( WvSpreadThetaIdx )) DEALLOCATE( WvSpreadThetaIdx, STAT=ErrStatTmp) - IF (ALLOCATED( tmpComplexArr )) DEALLOCATE( tmpComplexArr, STAT=ErrStatTmp) - RETURN - - END SUBROUTINE CleanUp - - -END SUBROUTINE VariousWaves_Init - - - - -!---------------------------------------------------------------------------------------------------------------------------------- -!> 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 Waves_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut, ErrStat, ErrMsg ) -!.................................................................................................................................. - - TYPE(Waves_InitInputType), INTENT(INOUT) :: InitInp !< Input data for initialization routine !NOTE: We are making this INOUT so that we can overwrite the WaveKinzi with zeros for wave stretching calculations - TYPE(Waves_InputType), INTENT( OUT) :: u !< An initial guess for the input; input mesh must be defined - TYPE(Waves_ParameterType), INTENT( OUT) :: p !< Parameters - TYPE(Waves_ContinuousStateType), INTENT( OUT) :: x !< Initial continuous states - TYPE(Waves_DiscreteStateType), INTENT( OUT) :: xd !< Initial discrete states - TYPE(Waves_ConstraintStateType), INTENT( OUT) :: z !< Initial guess of the constraint states - TYPE(Waves_OtherStateType), INTENT( OUT) :: OtherState !< Initial other states - TYPE(Waves_OutputType), INTENT( OUT) :: y !< Initial system outputs (outputs are not calculated; - !! only the output mesh is initialized) - TYPE(Waves_MiscVarType), INTENT( OUT) :: m !< Initial misc/optimization variables - REAL(DbKi), INTENT(INOUT) :: Interval !< Coupling interval in seconds: the rate that - !! (1) Waves_UpdateStates() is called in loose coupling & - !! (2) Waves_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(Waves_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) :: ErrStatTmp ! Temporary error status for processing - CHARACTER(ErrMsgLen) :: ErrMsgTmp ! Temporary error message for procesing -! REAL(ReKi), ALLOCATABLE :: tmpWaveKinzi(:) - -! TYPE(FFT_DataType) :: FFT_Data ! the instance of the FFT module we're using - - - - ! Initialize ErrStat - - ErrStat = ErrID_None - ErrStatTmp = ErrID_None - ErrMsg = "" - ErrMsgTmp = "" - - - ! Initialize the NWTC Subroutine Library - - CALL NWTC_Init( ) - - ! Initialize the pRNG - CALL RandNum_Init(InitInp%RNG, ErrStat, ErrMsg) - IF ( ErrStat >= AbortErrLev ) RETURN - - ! Define initialization-routine output here: - - !InitOut%WriteOutputHdr = (/ 'Time', 'Column2' /) - !InitOut%WriteOutputUnt = (/ '(s)', '(-)' /) - - InitOut%RhoXg = InitInp%WtrDens*InitInp%Gravity - - - ! Set the minimum and maximum wave directions to WaveDir. These are reset in the - ! subroutine calls as necessary. - InitOut%WaveDirMin = InitInp%WaveDir - InitOut%WaveDirMax = InitInp%WaveDir - InitOut%WaveDir = InitInp%WaveDir ! Not sure why there are so many copies of this variable, but InitOut%WaveDir must be set, and isn't in all cases otherwise. - - - ! Initialize the variables associated with the incident wave: - - SELECT CASE ( InitInp%WaveMod ) ! Which incident wave kinematics model are we using? - - - CASE ( 0 ) ! None=still water. - - CALL StillWaterWaves_Init( InitInp, InitOut, ErrStatTmp, ErrMsgTmp ) - CALL SetErrStat(ErrStatTmp,ErrMsgTmp,ErrStat,ErrMsg,'Waves_Init') - - !@mhall: :::: ensure all arrays needed for the wave grid to MoorDyn are allocated in the WaveMod=0 case too :::: - !ALLOCATE ( InitOut%WaveElevMD (0:InitOut%NStepWave, WaveGrid_nx*WaveGrid_ny), STAT=ErrStatTmp ) - !InitOut%WaveElevMD = 0.0_DbKi ! zero it - ! ::::: end ::::: - - IF ( ErrStat >= AbortErrLev ) RETURN - - - CASE ( 1, 2, 3, 4, 10 ) ! 1, 10: Plane progressive (regular) wave, 2: JONSWAP/Pierson-Moskowitz spectrum (irregular) wave, 3: white-noise, or 4: user-defined spectrum (irregular) wave. - - ! To correctly perform stretching we need wave kinematics at (xi,yi,0) for all nodes where kinematics are computed. - ! This could all be done with the same call to VariousWaves_Init, but then we would have to allocate double the number of temporary data - ! structures for this extra set of locations. - ! INSTEAD, to save memory (at the expense of time) we are going to call VariousWaves_Init, twice! Once for the (xi,yi,zi) locations - ! and then again for the (xi,yi,0) locations. - ! To accomplish this, we need to schuffle some of our data structures or create temporary copies - - ! ! Allocate the temporary storage array for the WvKinxi - !ALLOCATE ( tmpWaveKinzi(InitInp%NWaveKin), STAT = ErrStatTmp ) - !IF ( ErrStatTmp /= ErrID_None ) THEN - ! CALL SetErrStat( ErrID_Fatal,'Error allocating space for tmpWaveKinzi array.',ErrStat,ErrMsg,'Waves_Init') - ! RETURN - !END IF - !!DO I = 1,InitInp%NWaveKin - !! tmpWaveKinzi(I) = InitInp%WaveKinzi(I) - !! InitInp%WaveKinzi(I) = 0.0_ReKi ! Force all zi coordinates to 0.0 for this version of the Waves initialization - !! END DO - ! tmpWaveKinzi = InitInp%WaveKinzi - ! InitInp%WaveKinzi = 0.0_ReKi ! Force all zi coordinates to 0.0 for this version of the Waves initialization - ! - !CALL VariousWaves_Init( InitInp, InitOut, ErrStatTmp, ErrMsgTmp ) - ! CALL SetErrStat(ErrStatTmp,ErrMsgTmp,ErrStat,ErrMsg,'Waves_Init') - ! IF ( ErrStat >= AbortErrLev ) RETURN - ! - !ALLOCATE ( InitOut%WaveDynP0 (0:InitOut%NStepWave,InitInp%NWaveKin ), STAT=ErrStatTmp ) - !IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array InitOut%WaveDynP0.', ErrStat,ErrMsg,'Waves_Init') - ! - !ALLOCATE ( InitOut%WaveVel0 (0:InitOut%NStepWave,InitInp%NWaveKin,3), STAT=ErrStatTmp ) - !IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array InitOut%WaveVel0.', ErrStat,ErrMsg,'Waves_Init') - ! - !ALLOCATE ( InitOut%WaveAcc0 (0:InitOut%NStepWave,InitInp%NWaveKin,3), STAT=ErrStatTmp ) - !IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array InitOut%WaveAcc0.', ErrStat,ErrMsg,'Waves_Init') - ! - !IF ( ErrStat >= AbortErrLev ) RETURN - ! - ! ! Copy the init output arrays into the MSL versions - !InitOut%WaveDynP0 = InitOut%WaveDynP - !InitOut%WaveAcc0 = InitOut%WaveAcc - !InitOut%WaveVel0 = InitOut%WaveVel - ! - ! ! Reset the zi locations - !InitInp%WaveKinzi = tmpWaveKinzi - ! - ! ! Deallocate data which will be allocated again within the Init routine - !DEALLOCATE( InitOut%WaveDynP ) - !DEALLOCATE( InitOut%WaveAcc ) - !DEALLOCATE( InitOut%WaveVel ) - !DEALLOCATE( InitOut%WaveElevC0) - !DEALLOCATE( InitOut%WaveDirArr) - !DEALLOCATE( InitOut%WaveElev ) - !DEALLOCATE( InitOut%WaveTime ) - !DEALLOCATE( InitOut%NodeInWater ) - - ! Now call the init with all the zi locations for the Morrison member nodes - CALL VariousWaves_Init( InitInp, InitOut, ErrStatTmp, ErrMsgTmp ) - CALL SetErrStat(ErrStatTmp,ErrMsgTmp,ErrStat,ErrMsg,'Waves_Init') - IF ( ErrStat >= AbortErrLev ) RETURN - - - CASE ( 5 ) ! User-supplied wave elevation time history; HD derives full wave kinematics from this elevation time series data. - - ! Get the wave frequency information from the file (by FFT of the elevation) - CALL UserWaveElevations_Init( InitInp, InitOut, ErrStatTmp, ErrMsgTmp ) - CALL SetErrStat(ErrStatTmp,ErrMsgTmp,ErrStat,ErrMsg,'Waves_Init') - IF ( ErrStat >= AbortErrLev ) RETURN - - ! Now call VariousWaves to continue using the wave elevation and derived frequency information from the file - CALL VariousWaves_Init( InitInp, InitOut, ErrStatTmp, ErrMsgTmp ) - CALL SetErrStat(ErrStatTmp,ErrMsgTmp,ErrStat,ErrMsg,'Waves_Init') - IF ( ErrStat >= AbortErrLev ) RETURN - - - CASE ( 6 ) ! User-supplied wave kinematics data. - - CALL UserWaves_Init( InitInp, InitOut, ErrStatTmp, ErrMsgTmp ) - CALL SetErrStat(ErrStatTmp,ErrMsgTmp,ErrStat,ErrMsg,'Waves_Init') - IF ( ErrStat >= AbortErrLev ) RETURN - ENDSELECT - - - u%DummyInput = 0.0 - p%DT = Interval - p%WaveMultiDir = InitOut%WaveMultiDir ! Flag to indicate multidirectional waves - x%DummyContState = 0.0 - xd%DummyDiscState = 0.0 - z%DummyConstrState = 0.0 - OtherState%DummyOtherState = 0 - m%DummyMiscVar = 0 - y%DummyOutput = 0.0 - - - -END SUBROUTINE Waves_Init - - -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine is called at the end of the simulation. -SUBROUTINE Waves_End( u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) -!.................................................................................................................................. - - TYPE(Waves_InputType), INTENT(INOUT) :: u !< System inputs - TYPE(Waves_ParameterType), INTENT(INOUT) :: p !< Parameters - TYPE(Waves_ContinuousStateType), INTENT(INOUT) :: x !< Continuous states - TYPE(Waves_DiscreteStateType), INTENT(INOUT) :: xd !< Discrete states - TYPE(Waves_ConstraintStateType), INTENT(INOUT) :: z !< Constraint states - TYPE(Waves_OtherStateType), INTENT(INOUT) :: OtherState !< Other states - TYPE(Waves_OutputType), INTENT(INOUT) :: y !< System outputs - TYPE(Waves_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 error handling variables - INTEGER(IntKi) :: ErrStatTmp - CHARACTER(ErrMsgLen) :: ErrMsgTmp - CHARACTER(*), PARAMETER :: RoutineName = 'Waves_End' - - ! Initialize ErrStat - - ErrStat = ErrID_None - ErrMsg = "" - - - ! Place any last minute operations or calculations here: - - - ! Close files here: - - - - ! Destroy the input data: - - CALL Waves_DestroyInput( u, ErrStatTmp, ErrMsgTmp ) - CALL SetErrStat(ErrStatTmp,ErrMsgTmp,ErrStat,ErrMsg,RoutineName) - - - ! Destroy the parameter data: - - CALL Waves_DestroyParam( p, ErrStatTmp, ErrMsgTmp ) - CALL SetErrStat(ErrStatTmp,ErrMsgTmp,ErrStat,ErrMsg,RoutineName) - - - ! Destroy the state data: - - CALL Waves_DestroyContState( x, ErrStatTmp, ErrMsgTmp ) - CALL SetErrStat(ErrStatTmp,ErrMsgTmp,ErrStat,ErrMsg,RoutineName) - CALL Waves_DestroyDiscState( xd, ErrStatTmp, ErrMsgTmp ) - CALL SetErrStat(ErrStatTmp,ErrMsgTmp,ErrStat,ErrMsg,RoutineName) - CALL Waves_DestroyConstrState( z, ErrStatTmp, ErrMsgTmp ) - CALL SetErrStat(ErrStatTmp,ErrMsgTmp,ErrStat,ErrMsg,RoutineName) - CALL Waves_DestroyOtherState( OtherState, ErrStatTmp, ErrMsgTmp ) - CALL SetErrStat(ErrStatTmp,ErrMsgTmp,ErrStat,ErrMsg,RoutineName) - - CALL Waves_DestroyMisc( m, ErrStatTmp, ErrMsgTmp ) - CALL SetErrStat(ErrStatTmp,ErrMsgTmp,ErrStat,ErrMsg,RoutineName) - - - ! Destroy the output data: - - CALL Waves_DestroyOutput( y, ErrStatTmp, ErrMsgTmp ) - CALL SetErrStat(ErrStatTmp,ErrMsgTmp,ErrStat,ErrMsg,RoutineName) - - - - -END SUBROUTINE Waves_End -!---------------------------------------------------------------------------------------------------------------------------------- - -!======================================================================= -FUNCTION WheelerStretching ( zOrzPrime, Zeta, h, ForwardOrBackward, ErrStat, ErrMsg ) - - - ! This FUNCTION applies the principle of Wheeler stretching to - ! (1-Forward) find the elevation where the wave kinematics are to - ! be applied using Wheeler stretching or (2-Backword) find the - ! elevation where the wave kinematics are computed before applying - ! Wheeler stretching. Wheeler stretching says that wave - ! kinematics calculated using Airy theory at the mean sea level - ! should actually be applied at the instantaneous free surface and - ! that Airy wave kinematics computed at locations between the - ! seabed and the mean sea level should be shifted vertically to - ! new locations in proportion to their elevation above the seabed - ! as follows: - ! - ! Forward: z(zPrime,Zeta,h) = ( 1 + Zeta/h )*zPrime + Zeta - ! - ! or equivalently: - ! - ! Backword: zPrime(z,Zeta,h) = ( z - Zeta )/( 1 + Zeta/h ) - ! - ! where, - ! Zeta = instantaneous elevation of incident waves - ! h = water depth - ! z = elevations where the wave kinematics are to be - ! applied using Wheeler stretching - ! zPrime = elevations where the wave kinematics are computed - ! before applying Wheeler stretching - - - - IMPLICIT NONE - - - ! Passed Variables: - - REAL(SiKi), INTENT(IN ) :: h ! Water depth (meters) - REAL(SiKi) :: WheelerStretching ! This function = zPrime [forward] or z [backward] (meters) - REAL(SiKi), INTENT(IN ) :: Zeta ! Instantaneous elevation of incident waves (meters) - REAL(SiKi), INTENT(IN ) :: zOrzPrime ! Elevations where the wave kinematics are to be applied using Wheeler stretching, z, [forward] or elevations where the wave kinematics are computed before applying Wheeler stretching, zPrime, [backward] (meters) - CHARACTER(1), INTENT(IN ) :: ForwardOrBackWard ! A string holding the direction ('F'=Forward, 'B'=Backward) for applying Wheeler stretching. - 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 = "" - - ! Apply Wheeler stretching, depending on the direction: - - SELECT CASE ( ForwardOrBackWard ) - - CASE ( 'F' ) ! Forward - - WheelerStretching = ( 1.0 + Zeta/h )*zOrzPrime + Zeta - - - CASE ( 'B' ) ! Backward - - WheelerStretching = ( zOrzPrime - Zeta )/( 1.0 + Zeta/h ) - - - CASE DEFAULT - - WheelerStretching = 0.0_SiKi - - ErrMsg = 'The last argument in routine WheelerStretching() must be ''F'' or ''B''.' - ErrStat = ErrID_Fatal - RETURN - - - END SELECT - - - - RETURN -END FUNCTION WheelerStretching - -END MODULE Waves -!********************************************************************************************************************************** diff --git a/modules/hydrodyn/src/Waves.txt b/modules/hydrodyn/src/Waves.txt deleted file mode 100644 index 5469e8b88f..0000000000 --- a/modules/hydrodyn/src/Waves.txt +++ /dev/null @@ -1,142 +0,0 @@ -################################################################################################################################### -# Registry for Waves in the FAST Modularization Framework -# This Registry file is used to create MODULE Waves_Types which contains all of the user-defined types needed in Waves. -# It also contains copy, destroy, pack, and unpack routines associated with each defined data types. -# See 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) ............................................................................ -# make sure that the file name does not have any trailing white spaces! -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 Waves/Waves InitInputType CHARACTER(1024) InputFile - - - "Name of the input file" - -typedef ^ ^ CHARACTER(1024) DirRoot - - - "The name of the root file including the full path. 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." - -typedef ^ ^ CHARACTER(1024) WvKinFile - - - "The root name of user input wave kinematics files" - -typedef ^ ^ LOGICAL WriteWvKin - - - "Flag indicating whether we are going to write out kinematics files. [Must be FALSE if WaveMod = 5 or 6, if TRUE then WvKinFile must have a string value and this is the rootname for all the output files]" - -typedef ^ ^ INTEGER UnSum - - - "The unit number for the HydroDyn summary file" - -typedef ^ ^ ReKi Gravity - - - "Gravitational acceleration" (m/s^2) -typedef ^ ^ ReKi MSL2SWL - - - "Offset between still-water level and mean sea level [positive upward; must be zero if using WAMIT]" (meters) -typedef ^ ^ SiKi WvLowCOff - - - "Low cut-off frequency or lower frequency limit of the wave spectrum beyond which the wave spectrum is zeroed. [used only when WaveMod=2,3,4]" (rad/s) -typedef ^ ^ SiKi WvHiCOff - - - "High cut-off frequency or upper frequency limit of the wave spectrum beyond which the wave spectrum is zeroed. [used only when WaveMod=2,3,4]" (rad/s) -typedef ^ ^ SiKi WaveDir - - - "Mean incident wave propagation heading direction" (degrees) -typedef ^ ^ INTEGER WaveNDir - - - "Number of wave directions [only used if WaveDirMod = 1] [Must be an odd number -- will be adjusted within the waves module]" (-) -typedef ^ ^ LOGICAL WaveMultiDir - - - "Indicates the waves are multidirectional -- set by HydroDyn_Input" - -typedef ^ ^ INTEGER WaveDirMod - - - "Directional wave spreading function {0: none, 1: COS2S} [only used if WaveMod=6]" - -typedef ^ ^ SiKi WaveDirSpread - - - "Spreading coefficient [WaveMod=2,3,4 and WaveDirMod=1]" - -typedef ^ ^ SiKi WaveDirRange - - - "Range of wave directions (full range: WaveDir +/- WaveDirRange/2) [only used if WaveMod=6]" (degrees) -typedef ^ ^ DbKi WaveDT - - - "Time step for incident wave calculations" (sec) -typedef ^ ^ SiKi WaveHs - - - "Significant wave height of incident waves" (meters) -typedef ^ ^ INTEGER WaveMod - - - "Incident wave kinematics model {0: none=still water, 1: plane progressive (regular), 2: JONSWAP/Pierson-Moskowitz spectrum (irregular), 3: white-noise spectrum, 4: user-defind spectrum from routine UserWaveSpctrm (irregular), 5: GH BLADED }" - -typedef ^ ^ CHARACTER(80) WaveModChr - - - "String to temporarially hold the value of the wave kinematics input line" -typedef ^ ^ LOGICAL WaveNDAmp - - - "Flag for normally-distributed amplitudes in incident waves spectrum [flag]" - -typedef ^ ^ SiKi WavePhase - - - "Specified phase for regular waves" (radians) -typedef ^ ^ SiKi WavePkShp - - - "Peak shape parameter of incident wave spectrum [1.0 for Pierson-Moskowitz]" - -typedef ^ ^ CHARACTER(80) WavePkShpChr - - - "String to temporarially hold value of peak shape parameter input line" - -typedef ^ ^ INTEGER WaveSeed {2} - - "Random seeds of incident waves [-2147483648 to 2147483647]" - -typedef ^ ^ INTEGER WaveStMod - - - "Model for stretching incident wave kinematics to instantaneous free surface {0: none=no stretching, 1: vertical stretching, 2: extrapolation stretching, 3: Wheeler stretching}" - -typedef ^ ^ DbKi WaveTMax - - - "Analysis time for incident wave calculations; the actual analysis time may be larger than this value in order for the maintain an effecient FFT" (sec) -typedef ^ ^ SiKi WaveTp - - - "Peak spectral period of incident waves" (sec) -typedef ^ ^ SiKi WtrDens - - - "Water density" (kg/m^3) -typedef ^ ^ SiKi WtrDpth - - - "Water depth" (meters) -typedef ^ ^ INTEGER NWaveElev - - - "Number of points where the incident wave elevations can be output" - -typedef ^ ^ SiKi WaveElevxi {:} - - "xi-coordinates for points where the incident wave elevations can be output" (meters) -typedef ^ ^ SiKi WaveElevyi {:} - - "yi-coordinates for points where the incident wave elevations can be output" (meters) -typedef ^ ^ SiKi WaveElevXY {:}{:} - - "Supplied by Driver: X-Y locations for WaveElevation output (for visualization). Index 1 corresponds to X or Y coordinate. Index 2 corresponds to point number." - -typedef ^ ^ ReKi PtfmLocationX - - - "Copy of X coordinate of platform location in the wave field, used to offset/phase-shift all wave kinematics to account for location in the farm" "m" -typedef ^ ^ ReKi PtfmLocationY - - - "Copy of Y coordinate of platform location in the wave field, used to offset/phase-shift all wave kinematics to account for location in the farm" "m" -typedef ^ ^ INTEGER WaveFieldMod - - - "Wave field handling (-) (switch) 0: use individual HydroDyn inputs without adjustment, 1: adjust wave phases based on turbine offsets from farm origin" - -typedef ^ ^ INTEGER NWaveKin - - - "Number of points where the incident wave kinematics will be computed" - -typedef ^ ^ SiKi WaveKinxi {:} - - "xi-coordinates for points where the incident wave kinematics will be computed; these are relative to the mean sea level" (meters) -typedef ^ ^ SiKi WaveKinyi {:} - - "yi-coordinates for points where the incident wave kinematics will be computed; these are relative to the mean sea level" (meters) -typedef ^ ^ SiKi WaveKinzi {:} - - "zi-coordinates for points where the incident wave kinematics will be computed; these are relative to the mean sea level" (meters) -typedef ^ ^ SiKi CurrVxi {:} - - "xi-component of the current velocity at elevation i" (m/s) -typedef ^ ^ SiKi CurrVyi {:} - - "yi-component of the current velocity at elevation i" (m/s) -typedef ^ ^ SiKi PCurrVxiPz0 - - - "xi-component of the partial derivative of the current velocity at elevation near mean sea level" (m/s) -typedef ^ ^ SiKi PCurrVyiPz0 - - - "yi-component of the partial derivative of the current velocity at elevation near mean sea level" (m/s) -typedef ^ ^ NWTC_RandomNumber_ParameterType RNG - - - "Parameters for the pseudo random number generator" - - - -# Define outputs from the initialization routine here: -# -typedef ^ InitOutputType SiKi WaveElevC0 {:}{:} - - "Discrete Fourier transform of the instantaneous elevation of incident waves at the platform reference point. First column is real part, second column is imaginary part" (meters) -typedef ^ ^ SiKi WaveDirArr {:} - - "Wave direction array. Each frequency has a unique direction of WaveNDir > 1" (degrees) -typedef ^ ^ SiKi WaveDirMin - - - "Minimum wave direction." (degrees) -typedef ^ ^ SiKi WaveDirMax - - - "Maximum wave direction." (degrees) -typedef ^ ^ SiKi WaveDir - - - "Incident wave propagation heading direction" (degrees) -typedef ^ ^ INTEGER WaveNDir - - - "Number of wave directions [only used if WaveDirMod = 1] [Must be an odd number -- will be adjusted within the waves module]" (-) -typedef ^ ^ LOGICAL WaveMultiDir - - - "Indicates the waves are multidirectional -- set by HydroDyn_Input" - -typedef ^ ^ SiKi WaveDOmega - - - "Frequency step for incident wave calculations" (rad/s) -typedef ^ ^ SiKi WaveKinzi {:} - - "zi-coordinates for points where the incident wave kinematics will be computed; these are relative to the mean see level" (meters) -typedef ^ ^ SiKi PWaveDynP0 {:}{:} - - "Instantaneous dynamic pressure of incident waves , at the location (xi,yi,0), at each of the NWaveKin points where the incident wave kinematics will be computed" (N/m^2) -typedef ^ ^ SiKi WaveDynP {:}{:} - - "Instantaneous dynamic pressure of incident waves , accounting for stretching, at each of the NWaveKin points where the incident wave kinematics will be computed" (N/m^2) -typedef ^ ^ SiKi WaveAcc {:}{:}{:} - - "Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, accounting for stretching, at each of the NWaveKin points where the incident wave kinematics will be computed" (m/s^2) -typedef ^ ^ SiKi PWaveAcc0 {:}{:}{:} - - "Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, at the location (xi,yi,0), at each of the NWaveKin points where the incident wave kinematics will be computed" (m/s^2) -typedef ^ ^ SiKi WaveVel {:}{:}{:} - - "Instantaneous velocity of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, accounting for stretching, at each of the NWaveKin points where the incident wave kinematics will be computed (The values include both the velocity of incident waves and the velocity of current.)" (m/s) -typedef ^ ^ SiKi PWaveVel0 {:}{:}{:} - - "Instantaneous velocity of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, at the location (xi,yi,0), at each of the NWaveKin points where the incident wave kinematics will be computed (The values include both the velocity of incident waves and the velocity of current.)" (m/s) -typedef ^ ^ SiKi WaveElev {:}{:} - - "Instantaneous elevation time-series of incident waves at each of the NWaveElev points where the incident wave elevations can be output" (meters) -typedef ^ ^ SiKi WaveElev0 {:} - - "Instantaneous elevation time-series of incident waves at the platform reference point" (meters) - -typedef ^ ^ SiKi WaveElevMD {:}{:} - - "Instantaneous elevation time-series of incident waves at hard coded grid for temporary use in MoorDyn" (m) - -typedef ^ ^ SiKi WaveElevSeries {:}{:} - - "Instantaneous elevation time-series at each of the points given by WaveElevXY. Used for making movies of the waves. First index is the timestep. Second index is XY point number corresponding to second index of WaveElevXY." (m) - -typedef ^ ^ SiKi WaveTime {:} - - "Simulation times at which the instantaneous elevation of, velocity of, acceleration of, and loads associated with the incident waves are determined" (sec) -typedef ^ ^ DbKi WaveTMax - - - "Analysis time for incident wave calculations; the actual analysis time may be larger than this value in order for the maintain an effecient FFT" (sec) -typedef ^ ^ INTEGER nodeInWater {:}{:} - - "Logical flag indicating if the node at the given time step is in the water, and hence needs to have hydrodynamic forces calculated" - -typedef ^ ^ SiKi RhoXg - - - "= WtrDens*Gravity" - -typedef ^ ^ INTEGER NStepWave - - - "Total number of frequency components = total number of time steps in the incident wave" - -typedef ^ ^ INTEGER NStepWave2 - - - "NStepWave / 2" - - - -# ..... States .................................................................................................................... -# Define continuous (differentiable) states here: -typedef ^ ContinuousStateType SiKi DummyContState - - - "Remove this variable if you have continuous states" - - - -# Define discrete (nondifferentiable) states here: -typedef ^ DiscreteStateType SiKi DummyDiscState - - - "Remove this variable if you have discrete states" - - - -# Define constraint states here: -typedef ^ ConstraintStateType SiKi DummyConstrState - - - "Remove this variable if you have constraint states" - - - -# Define any other states, including integer or logical states here: -typedef ^ OtherStateType INTEGER 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 INTEGER 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 continuous state integration & discrete state update" seconds -typedef ^ ^ DbKi WaveTMax - - - "Analysis time for incident wave calculations; the actual analysis time may be larger than this value in order for the maintain an effecient FFT" (sec) -typedef ^ ^ INTEGER NStepWave - - - "Total number of frequency components = total number of time steps in the incident wave" - -typedef ^ ^ INTEGER WaveNDir - - - "Number of wave directions [only used if WaveDirMod = 1] [Must be an odd number -- will be adjusted within the waves module]" (-) -typedef ^ ^ LOGICAL WaveMultiDir - - - "Indicates the waves are multidirectional -- set by HydroDyn_Input" - - - -# ..... Inputs .................................................................................................................... -# Define inputs that are contained on the mesh here: -#typedef ^ InputType MeshType MeshedInput - - - "Meshed input data" - - -# Define inputs that are not on this mesh here: -typedef ^ InputType SiKi DummyInput - - - "Remove this variable if you have input data" - - - -# ..... Outputs ................................................................................................................... -# Define outputs that are not on this mesh here: -typedef ^ OutputType SiKi DummyOutput - - - "Remove this variable if you have output data" - diff --git a/modules/hydrodyn/src/Waves2.txt b/modules/hydrodyn/src/Waves2.txt deleted file mode 100644 index 71aa3c56ad..0000000000 --- a/modules/hydrodyn/src/Waves2.txt +++ /dev/null @@ -1,154 +0,0 @@ -################################################################################################################################### -# Registry for Waves2 in the FAST Modularization Framework -# This Registry file is used to create MODULE Waves2_Types which contains all of the user-defined types needed in Waves2. -# It also contains copy, destroy, pack, and unpack routines associated with each defined data types. -# See 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) ............................................................................ -# make sure that the file name does not have any trailing white spaces! -include Registry_NWTC_Library.txt - -param Waves2/Waves2 unused INTEGER MaxWaves2Outputs - 9 - "" - -# ..... 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 Waves2/Waves2 InitInputType INTEGER UnSum - - - "The unit number for the HydroDyn summary file" - - -typedef ^ ^ ReKi Gravity - - - "Gravitational acceleration" (m/s^2) -typedef ^ ^ ReKi WtrDens - - - "Water density" (kg/m^3) -typedef ^ ^ SiKi WtrDpth - - - "Water depth" (meters) - -typedef ^ ^ INTEGER NStepWave - - - "Total number of frequency components = total number of time steps in the incident wave" - -typedef ^ ^ INTEGER NStepWave2 - - - "NStepWave / 2" - -typedef ^ ^ SiKi WaveDOmega - - - "Frequency step for incident wave calculations" (rad/s) - -typedef ^ ^ INTEGER WaveStMod - - - "Model for stretching incident wave kinematics to instantaneous free surface {0: none=no stretching, 1: vertical stretching, 2: extrapolation stretching, 3: Wheeler stretching}" - - -typedef ^ ^ LOGICAL WaveMultiDir - - - "Indicates the waves are multidirectional -- set by HydroDyn_Input" - -typedef ^ ^ SiKi WaveDirArr {:} - - "Wave direction array. Each frequency has a unique direction of WaveNDir > 1" (degrees) -typedef ^ ^ SiKi WaveElevC0 {:}{:} - - "Discrete Fourier transform of the instantaneous elevation of incident waves at the platform reference point. First column is real part, second column is imaginary part" (meters) -typedef ^ ^ SiKi WaveTime {:} - - "Simulation times at which the instantaneous second order loads associated with the incident waves are determined" sec - -typedef ^ ^ INTEGER NWaveElev - - - "Number of points where the incident wave elevations can be output" - -typedef ^ ^ SiKi WaveElevxi {:} - - "xi-coordinates for points where the incident wave elevations can be output" (meters) -typedef ^ ^ SiKi WaveElevyi {:} - - "yi-coordinates for points where the incident wave elevations can be output" (meters) -typedef ^ ^ SiKi WaveElevXY {:}{:} - - "Supplied by Driver: X-Y locations for WaveElevation output (for visualization). Index 1 corresponds to X or Y coordinate. Index 2 corresponds to point number." - - -typedef ^ ^ INTEGER NWaveKin - - - "Number of points where the incident wave kinematics will be computed" - -typedef ^ ^ SiKi WaveKinxi {:} - - "xi-coordinates for points where the incident wave kinematics will be computed; these are relative to the mean sea level" (meters) -typedef ^ ^ SiKi WaveKinyi {:} - - "yi-coordinates for points where the incident wave kinematics will be computed; these are relative to the mean sea level" (meters) -typedef ^ ^ SiKi WaveKinzi {:} - - "zi-coordinates for points where the incident wave kinematics will be computed; these are relative to the mean sea level" (meters) - -typedef ^ ^ LOGICAL WvDiffQTFF - - - "Full difference QTF second order forces flag" (-) -typedef ^ ^ LOGICAL WvSumQTFF - - - "Full sum QTF second order forces flag" (-) - -typedef ^ ^ SiKi WvLowCOffD - - - "Minimum frequency used in the difference methods [Ignored if all difference methods = 0]" (rad/s) -typedef ^ ^ SiKi WvHiCOffD - - - "Maximum frequency used in the difference methods [Ignored if all difference methods = 0]" (rad/s) -typedef ^ ^ SiKi WvLowCOffS - - - "Minimum frequency used in the sum-QTF method [Ignored if SumQTF = 0]" (rad/s) -typedef ^ ^ SiKi WvHiCOffS - - - "Maximum frequency used in the sum-QTF method [Ignored if SumQTF = 0]" (rad/s) - -typedef ^ ^ CHARACTER(ChanLen) OutList {18} - - "This should really be dimensioned with MaxOutPts" - -typedef ^ ^ LOGICAL OutAll - - - "" - -typedef ^ ^ INTEGER NumOuts - - - "" - -typedef ^ ^ INTEGER NumOutAll - - - "" - - - -# Define outputs from the initialization routine here: -# -typedef ^ InitOutputType CHARACTER(ChanLen) WriteOutputHdr {:} - - "" - -typedef ^ ^ CHARACTER(ChanLen) WriteOutputUnt {:} - - "" - -typedef ^ ^ SiKi WaveElevSeries2 {:}{:} - - "" (m) -# "Instantaneous elevation time-series at each of the points given by WaveElevXY. Used for making movies of the waves. First index is the timestep. Second index is XY point number corresponding to second index of WaveElevXY." (m) -typedef ^ ^ SiKi WaveAcc2D {:}{:}{:} - - "" (m/s^2) -# "Instantaneous 2nd-order difference frequency correction for the acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, at each of the NWaveKin points where the incident wave kinematics will be computed" (m/s^2) -typedef ^ ^ SiKi WaveDynP2D {:}{:} - - "" (N/m^2) -# "Instantaneous 2nd-order difference frequency correction for the dynamic pressure of incident waves , at each of the NWaveKin points where the incident wave kinematics will be computed" (N/m^2) -typedef ^ ^ SiKi WaveAcc2S {:}{:}{:} - - "" (m/s^2) -# "Instantaneous 2nd-order sum frequency correction for the acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, at each of the NWaveKin points where the incident wave kinematics will be computed" (m/s^2) -typedef ^ ^ SiKi WaveDynP2S {:}{:} - - "" (N/m^2) -# "Instantaneous 2nd-order sum frequency correction for the dynamic pressure of incident waves , at each of the NWaveKin points where the incident wave kinematics will be computed" (N/m^2) -typedef ^ ^ SiKi WaveVel2D {:}{:}{:} - - "" (m/s) -# "Instantaneous 2nd-order difference frequency correction for the velocity of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, at each of the NWaveKin points where the incident wave kinematics will be computed (The values include both the velocity of incident waves and the velocity of current.)" (m/s) -typedef ^ ^ SiKi WaveVel2S {:}{:}{:} - - "" (m/s) -# "Instantaneous 2nd-order sum frequency correction for the velocity of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, at each of the NWaveKin points where the incident wave kinematics will be computed (The values include both the velocity of incident waves and the velocity of current.)" (m/s) -typedef ^ ^ SiKi WaveAcc2D0 {:}{:}{:} - - "" (m/s^2) -# "Instantaneous 2nd-order difference frequency correction for the acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, at the location (xi,yi,0), for each of the NWaveKin points where the incident wave kinematics will be computed" (m/s^2) -typedef ^ ^ SiKi WaveDynP2D0 {:}{:} - - "" (N/m^2) -# "Instantaneous 2nd-order difference frequency correction for the dynamic pressure of incident waves , at the location (xi,yi,0), for each of the NWaveKin points where the incident wave kinematics will be computed" (N/m^2) -typedef ^ ^ SiKi WaveAcc2S0 {:}{:}{:} - - "" (m/s^2) -# "Instantaneous 2nd-order sum frequency correction for the acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, at the location (xi,yi,0), for each of the NWaveKin points where the incident wave kinematics will be computed" (m/s^2) -typedef ^ ^ SiKi WaveDynP2S0 {:}{:} - - "" (N/m^2) -# "Instantaneous 2nd-order sum frequency correction for the dynamic pressure of incident waves , at the location (xi,yi,0), for each of the NWaveKin points where the incident wave kinematics will be computed" (N/m^2) -typedef ^ ^ SiKi WaveVel2D0 {:}{:}{:} - - "" (m/s) -# "Instantaneous 2nd-order difference frequency correction for the velocity of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, at the location (xi,yi,0), for each of the NWaveKin points where the incident wave kinematics will be computed (The values include both the velocity of incident waves and the velocity of current.)" (m/s) -typedef ^ ^ SiKi WaveVel2S0 {:}{:}{:} - - "" (m/s) -# "Instantaneous 2nd-order sum frequency correction for the velocity of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, at the location (xi,yi,0), for each of the NWaveKin points where the incident wave kinematics will be computed (The values include both the velocity of incident waves and the velocity of current.)" (m/s) - - - - -# ..... States .................................................................................................................... -# Define continuous (differentiable) states here: -typedef ^ ContinuousStateType SiKi DummyContState - - - "Remove this variable if you have continuous states" - - - -# Define discrete (nondifferentiable) states here: -typedef ^ DiscreteStateType SiKi DummyDiscState - - - "Remove this variable if you have discrete states" - - - -# Define constraint states here: -typedef ^ ConstraintStateType SiKi 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 INTEGER LastIndWave - - - "Index for last interpolation step of 2nd order forces" - - - -# ..... 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 ^ ^ LOGICAL WvDiffQTFF - - - "Full difference QTF second order forces flag" (-) -typedef ^ ^ LOGICAL WvSumQTFF - - - "Full sum QTF second order forces flag" (-) -typedef ^ ^ INTEGER NWaveElev - - - "Number of points where the incident wave elevations can be output" - -typedef ^ ^ INTEGER NStepWave - - - "Total number of frequency components = total number of time steps in the incident wave" - -typedef ^ ^ INTEGER NStepWave2 - - - "NStepWave / 2" - -typedef ^ ^ SiKi WaveTime {:} - - "Simulation times at which the instantaneous second order loads associated with the incident waves are determined" sec -typedef ^ ^ SiKi WaveElev2 {:}{:} - - "Instantaneous elevation time-series of incident waves at each of the NWaveElev points where the incident wave elevations can be output" (meters) -#typedef ^ ^ SiKi WaveElev2D {:}{:} - - "" (m) -# "Instantaneous 2nd-order difference frequency correction for the elevation time-series of incident waves at each of the NWaveElev points where the incident wave elevations can be output" (meters) -#typedef ^ ^ SiKi WaveElev2S {:}{:} - - "" (m) -# "Instantaneous 2nd-order sum frequency correction for the elevation time-series of incident waves at each of the NWaveElev points where the incident wave elevations can be output" (meters) -typedef ^ ^ OutParmType OutParam {:} - - "" - -typedef ^ ^ INTEGER NumOuts - - - "" - -typedef ^ ^ INTEGER NumOutAll - - - "" - -typedef ^ ^ CHARACTER(20) OutFmt - - - "" - -typedef ^ ^ CHARACTER(20) OutSFmt - - - "" - -typedef ^ ^ CHARACTER(ChanLen) Delim - - - "" - -typedef ^ ^ INTEGER UnOutFile - - - "" - - - - - - -# ..... Inputs .................................................................................................................... -# Define inputs that are contained on the mesh here: -typedef ^ InputType SiKi DummyInput - - - "Remove this variable if you have input data" - - - -# ..... Outputs ................................................................................................................... -# Define outputs that are contained on the mesh here: -typedef ^ OutputType ReKi WriteOutput {:} - - "" - diff --git a/modules/hydrodyn/src/Waves2_Output.f90 b/modules/hydrodyn/src/Waves2_Output.f90 deleted file mode 100644 index 0faee486ee..0000000000 --- a/modules/hydrodyn/src/Waves2_Output.f90 +++ /dev/null @@ -1,575 +0,0 @@ -!********************************************************************************************************************************** -! LICENSING -! Copyright (C) 2013-2015 National Renewable Energy Laboratory -! -! This file is part of HydroDyn. -! -! 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 Waves2_Output - - ! This MODULE stores variables used for output. - - USE NWTC_Library - USE Waves2_Types - !USE HydroDyn_Output_Types -! USE Waves - IMPLICIT NONE - - PRIVATE - - ! 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 - - - ! Waves2 Body Forces: - - INTEGER(IntKi), PARAMETER :: Wave1Elv2 = 1 - INTEGER(IntKi), PARAMETER :: Wave2Elv2 = 2 - INTEGER(IntKi), PARAMETER :: Wave3Elv2 = 3 - INTEGER(IntKi), PARAMETER :: Wave4Elv2 = 4 - INTEGER(IntKi), PARAMETER :: Wave5Elv2 = 5 - INTEGER(IntKi), PARAMETER :: Wave6Elv2 = 6 - INTEGER(IntKi), PARAMETER :: Wave7Elv2 = 7 - INTEGER(IntKi), PARAMETER :: Wave8Elv2 = 8 - INTEGER(IntKi), PARAMETER :: Wave9Elv2 = 9 - - - -!End of code generated by Matlab script - - - INTEGER(IntKi), PARAMETER :: WaveElevi2(9) = (/Wave1Elv2,Wave2Elv2,Wave3Elv2,Wave4Elv2,Wave5Elv2,Wave6Elv2,Wave7Elv2,Wave8Elv2,Wave9Elv2/) - - - -! This code was generated by hand. - CHARACTER(OutStrLenM1), PARAMETER :: ValidParamAry(9) = (/ & ! This lists the names of the allowed parameters, which must be sorted alphabetically - "WAVE1ELV2","WAVE2ELV2","WAVE3ELV2","WAVE4ELV2","WAVE5ELV2","WAVE6ELV2","WAVE7ELV2","WAVE8ELV2","WAVE9ELV2"/) - INTEGER(IntKi), PARAMETER :: ParamIndxAry(9) = (/ & ! This lists the index into AllOuts(:) of the allowed parameters ValidParamAry(:) - Wave1Elv2 , Wave2Elv2 , Wave3Elv2 , Wave4Elv2 , Wave5Elv2 , Wave6Elv2 , Wave7Elv2 , Wave8Elv2 , Wave9Elv2 /) - CHARACTER(ChanLen), PARAMETER :: ParamUnitsAry(9) = (/ & ! This lists the units corresponding to the allowed parameters - "(m) ","(m) ","(m) ","(m) ","(m) ","(m) ","(m) ","(m) ","(m) "/) - - - REAL(ReKi) :: AllOuts(MaxWaves2Outputs) ! Array of all possible outputs - - ! ..... Public Subroutines ................................................................................................... - PUBLIC :: Wvs2OUT_MapOutputs - PUBLIC :: Wvs2OUT_WriteOutputNames - PUBLIC :: Wvs2OUT_WriteOutputUnits - PUBLIC :: Wvs2OUT_WriteOutputs - PUBLIC :: Wvs2OUT_Init - PUBLIC :: Wvs2OUT_DestroyParam - PUBLIC :: GetWaves2Channels - -CONTAINS - - - - -!==================================================================================================== -SUBROUTINE Wvs2OUT_MapOutputs( CurrentTime, y, NWaveElev, WaveElev2, AllOuts, ErrStat, ErrMsg ) -! This subroutine writes the data stored in the y variable to the correct indexed postions in WriteOutput -! This is called by Waves2_CalcOutput() at each time step. -!---------------------------------------------------------------------------------------------------- - REAL(DbKi), INTENT( IN ) :: CurrentTime ! Current simulation time in seconds - TYPE(Waves2_OutputType), INTENT( INOUT ) :: y ! Waves2's output data - INTEGER, INTENT( IN ) :: NWaveElev ! Number of wave elevation locations to output - REAL(SiKi), INTENT( IN ) :: WaveElev2(:) ! Instantaneous second order correction to the elevation of incident waves at each of the NWaveElev points where the incident wave elevations can be output (meters) - REAL(ReKi), INTENT( OUT ) :: AllOuts(MaxWaves2Outputs) - INTEGER(IntKi), INTENT( OUT ) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT ) :: ErrMsg ! Error message if ErrStat /= ErrID_None - - INTEGER :: I - - ErrStat = ErrID_None - ErrMsg = "" - - - ! TODO: use y%mesh for the forces instead of individual parameters - - DO I=1,NWaveElev - AllOuts(WaveElevi2(I)) = WaveElev2(I) - END DO - - - -END SUBROUTINE Wvs2OUT_MapOutputs - - -!==================================================================================================== - -SUBROUTINE Wvs2OUT_WriteOutputNames( UnOutFile, p, ErrStat, ErrMsg ) - - INTEGER, INTENT( IN ) :: UnOutFile ! file unit for the output file - TYPE(Waves2_ParameterType), INTENT( IN ) :: p ! Waves2 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))//'(:,A,'//TRIM( p%OutSFmt )//'))' - - WRITE(UnOutFile,Frmt) 'Time', ( p%Delim, TRIM( p%OutParam(I)%Name ), I=1,p%NumOuts ) - -END SUBROUTINE Wvs2OUT_WriteOutputNames - -!==================================================================================================== - - -SUBROUTINE Wvs2OUT_WriteOutputUnits( UnOutFile, p, ErrStat, ErrMsg ) - - INTEGER, INTENT( IN ) :: UnOutFile ! file unit for the output file - TYPE(Waves2_ParameterType), INTENT( IN ) :: p ! Waves2 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))//'(:,A,'//TRIM( p%OutSFmt )//'))' - - WRITE(UnOutFile,Frmt) '(sec)', ( p%Delim, TRIM( p%OutParam(I)%Units ), I=1,p%NumOuts ) - -END SUBROUTINE Wvs2OUT_WriteOutputUnits - -!==================================================================================================== -SUBROUTINE Wvs2OUT_WriteOutputs( UnOutFile, Time, y, p, ErrStat, ErrMsg ) -! This subroutine writes the data stored in WriteOutputs (and indexed in OutParam) to the file -! opened in Wvs2OUT_Init() -!---------------------------------------------------------------------------------------------------- - - ! Passed variables - INTEGER , INTENT( IN ) :: UnOutFile - REAL(DbKi), INTENT( IN ) :: Time ! Time for this output - TYPE(Waves2_OutputType), INTENT( INOUT ) :: y ! Waves2's output data - TYPE(Waves2_ParameterType),INTENT( IN ) :: p ! Waves2 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 -! REAL(ReKi) :: OutData (0:p%NumOuts) ! an output array - INTEGER :: I ! Generic loop counter - CHARACTER(200) :: Frmt ! a string to hold a format statement - - - - ! Initialize ErrStat and determine if it makes any sense to write output - - IF ( .NOT. ALLOCATED( p%OutParam ) .OR. UnOutFile < 0 ) THEN - ErrMsg = ' No Waves2 outputs written. The OutParam array must be allocated and there must be a valid output file identifier before we can write outputs.' - ErrStat = ErrID_Warn - RETURN - ELSE - ErrStat = ErrID_None - ErrMsg = '' - END IF - - - - - - ! Write the output parameters to the file - - Frmt = '(F8.3,'//TRIM(Int2LStr(p%NumOuts))//'(:,A,'//TRIM( p%OutFmt )//'))' - !Frmt = '('//TRIM( p%OutFmt )//','//TRIM(Int2LStr(p%NumOuts))//'(:,A,'//TRIM( p%OutFmt )//'))' - - WRITE(UnOutFile,Frmt) Time, ( p%Delim, y%WriteOutput(I), I=1,p%NumOuts ) - - - RETURN - - -END SUBROUTINE Wvs2OUT_WriteOutputs - - - -!==================================================================================================== -SUBROUTINE Wvs2OUT_Init( InitInp, y, 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(Waves2_InitInputType ), INTENT( IN ) :: InitInp ! data needed to initialize the output module - TYPE(Waves2_OutputType), INTENT( INOUT ) :: y ! This module's internal data - TYPE(Waves2_ParameterType), INTENT( INOUT ) :: p - TYPE(Waves2_InitOutputType), INTENT( OUT ) :: 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 -! INTEGER :: J ! Generic loop counter -! INTEGER :: Indx ! Counts the current index into the WaveKinNd array -! CHARACTER(1024) :: OutFileName ! The name of the output file including the full path. -! CHARACTER(200) :: Frmt ! a string to hold a format statement - - CHARACTER(ErrMsgLen) :: ErrMsgTmp ! Temporary Error status - INTEGER(IntKi) :: ErrStatTmp ! Temporary Error message - - - !------------------------------------------------------------------------------------------------- - ! Initialize local variables - !------------------------------------------------------------------------------------------------- - - - ErrStat = ErrID_None - ErrStatTmp = ErrID_None - ErrMsg = "" - ErrMsgTmp = "" - - - - - !------------------------------------------------------------------------------------------------- - ! Check that the variables in OutList are valid - !------------------------------------------------------------------------------------------------- - - CALL Wvs2OUT_ChkOutLst( InitInp%OutList(1:p%NumOuts), y, p, ErrStatTmp, ErrMsg ) - CALL SetErrStat(ErrStatTmp,ErrMsgTmp,ErrStat,ErrMsg,'Wvs2OUT_Init') - IF (ErrStat >= AbortErrLev ) RETURN - - IF ( ALLOCATED( p%OutParam ) .AND. p%NumOuts > 0 ) THEN ! Output has been requested so let's open an output file - - ALLOCATE( y%WriteOutput( p%NumOuts ), STAT = ErrStatTmp ) - IF ( ErrStattmp /= ErrID_None ) THEN - CALL SetErrStat(ErrID_Fatal,' Error allocating space for WriteOutput array.',ErrStat,ErrMsg,'Wvs2OUT_Init') - IF (ErrStat >= AbortErrLev ) RETURN - RETURN - END IF - y%WriteOutput = 0.0_ReKi - - ALLOCATE ( InitOut%WriteOutputHdr(p%NumOuts), STAT = ErrStatTmp ) - IF ( ErrStattmp /= ErrID_None ) THEN - CALL SetErrStat(ErrID_Fatal,' Error allocating space for WriteOutputHdr array.',ErrStat,ErrMsg,'Wvs2OUT_Init') - IF (ErrStat >= AbortErrLev ) RETURN - RETURN - END IF - - ALLOCATE ( InitOut%WriteOutputUnt(p%NumOuts), STAT = ErrStatTmp ) - IF ( ErrStattmp /= ErrID_None ) THEN - CALL SetErrStat(ErrID_Fatal,' Error allocating space for WriteOutputUnt array.',ErrStat,ErrMsg,'Wvs2OUT_Init') - IF (ErrStat >= AbortErrLev ) RETURN - RETURN - END IF - - DO I = 1,p%NumOuts - - InitOut%WriteOutputHdr(I) = TRIM( p%OutParam(I)%Name ) - InitOut%WriteOutputUnt(I) = TRIM( p%OutParam(I)%Units ) - - END DO - - END IF ! there are any requested outputs - - RETURN - -END SUBROUTINE Wvs2OUT_Init - - -!==================================================================================================== -FUNCTION GetWaves2Channels ( NUserOutputs, UserOutputs, OutList, foundMask, ErrStat, ErrMsg ) -! This routine checks the names of inputted output channels, checks to see if they -! below to the list of available Waves2 channels. - -!---------------------------------------------------------------------------------------------------- - INTEGER, INTENT( IN ) :: NUserOutputs ! Number of user-specified output channels - CHARACTER(ChanLen), INTENT( IN ) :: UserOutputs (:) ! An array holding the names of the requested output channels. - CHARACTER(ChanLen), INTENT( OUT ) :: OutList (:) ! An array holding the names of the matched Waves2 output channels. - LOGICAL, INTENT( INOUT ) :: foundMask (:) ! A mask indicating whether a user requested channel belongs to a module's output channels. - INTEGER, INTENT( OUT ) :: ErrStat ! a non-zero value indicates an error occurred - CHARACTER(*), INTENT( OUT ) :: ErrMsg ! Error message if ErrStat /= ErrID_None - - INTEGER GetWaves2Channels ! The number of channels found in this module - - ! Local variables. - - INTEGER :: I ! Generic loop-counting index. - INTEGER :: count ! 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. -! LOGICAL :: InvalidOutput(MaxWaves2Outputs) ! This array determines if the output channel is valid for this configuration - LOGICAL :: CheckOutListAgain - - LOGICAL :: newFoundMask (NUserOutputs) ! A Mask indicating whether a user requested channel belongs to a modules output channels. - - ! Initialize ErrStat - - ErrStat = ErrID_None - ErrMsg = "" - GetWaves2Channels = 0 - - newFoundMask = .FALSE. - - - DO I = 1,NUserOutputs - IF (.NOT. foundMask(I) ) THEN - OutListTmp = UserOutputs(I) - - CheckOutListAgain = .FALSE. - - ! Reverse the sign (+/-) of the output channel if the user prefixed the - ! channel name with a '-', '_', 'm', or 'M' character indicating "minus". - - - - IF ( INDEX( '-_', OutListTmp(1:1) ) > 0 ) THEN - - 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. - - 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 - ! 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 - newFoundMask(I) = .TRUE. - foundMask(I) = .TRUE. - GetWaves2Channels = GetWaves2Channels + 1 - - !ELSE - ! foundMask(I) = .FALSE. - END IF - END IF -END DO - - -IF ( GetWaves2Channels > 0 ) THEN - - count = 1 - ! ! Test that num channels does not exceed max possible channels due to size of OutList - ! ALLOCATE ( OutList(GetWaves2Channels) , STAT=ErrStat ) - ! IF ( ErrStat /= 0 ) THEN - ! ErrMsg = ' Error allocating memory for the OutList array in the GetWaves2Channels function.' - ! ErrStat = ErrID_Fatal - ! RETURN - ! END IF - - DO I = 1,NUserOutputs - IF ( newFoundMask(I) ) THEN - OutList(count) = UserOutputs(I) - count = count + 1 - END IF - - END DO - -END IF - - -END FUNCTION GetWaves2Channels - - - - -!==================================================================================================== -SUBROUTINE Wvs2OUT_ChkOutLst( OutList, y, 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 that the Wamit module must be initialized prior to calling this function (if it -! is being used) so that it can correctly determine if the Lines outputs are valid. -!---------------------------------------------------------------------------------------------------- - - - - ! Passed variables - - TYPE(Waves2_OutputType), INTENT( INOUT ) :: y ! This module's internal data - TYPE(Waves2_ParameterType), INTENT( INOUT ) :: p ! parameter data for this instance of the Waves2 platform module - 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. - - CHARACTER(ErrMsgLen) :: ErrMsgTmp ! Temporary error message - INTEGER(IntKi) :: ErrStatTmp ! Temporary error status - - INTEGER :: I ! Generic loop-counting index. -! INTEGER :: J ! 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. - - - ! 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 09-Jan-2013 14:53:03. - - LOGICAL :: InvalidOutput(MaxWaves2Outputs) ! This array determines if the output channel is valid for this configuration - - LOGICAL :: CheckOutListAgain - - ! Initialize ErrStat - - ErrStat = ErrID_None - ErrStatTmp = ErrID_None - ErrMsg = "" - ErrMsgTmp = "" - - InvalidOutput = .FALSE. - -!End of code generated by Matlab script - - !------------------------------------------------------------------------------------------------- - ! ALLOCATE the OutParam array - !------------------------------------------------------------------------------------------------- - - - ALLOCATE ( p%OutParam(p%NumOuts) , STAT=ErrStatTmp ) - IF ( ErrStatTmp /= 0 ) CALL SetErrStat(ErrID_Fatal,' Error allocating memory for the OutParam array.',ErrStat,ErrMsg,'Wvs2OUT_ChkOutLst') - IF ( ErrStat >= AbortErrLev ) RETURN - - - - - 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)%Indx = 1 - 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 = 1 - p%OutParam(I)%SignM = 0 ! this will print all zeros - END IF - - END DO - - - RETURN -END SUBROUTINE Wvs2OUT_ChkOutLst - - -!==================================================================================================== -SUBROUTINE Wvs2OUT_DestroyParam ( p, ErrStat, ErrMsg ) -! This function cleans up after running the Waves2 output module. It closes the output file, -! releases memory, and resets the number of outputs requested to 0. -!---------------------------------------------------------------------------------------------------- - - ! Passed variables - - TYPE(Waves2_ParameterType), INTENT( INOUT ) :: p ! parameter data for this instance of the Waves2 module - INTEGER, INTENT( OUT ) :: ErrStat ! a non-zero value indicates an error occurred - CHARACTER(*), INTENT( OUT ) :: ErrMsg ! Error message if ErrStat /= ErrID_None - -! ! Internal variables - LOGICAL :: Err - - - !------------------------------------------------------------------------------------------------- - ! Initialize error information - !------------------------------------------------------------------------------------------------- - ErrStat = ErrID_None - ErrMsg = "" - Err = .FALSE. - - - - !------------------------------------------------------------------------------------------------- - ! Deallocate arrays - !------------------------------------------------------------------------------------------------- - IF ( ALLOCATED( p%OutParam ) ) DEALLOCATE ( p%OutParam, STAT=ErrStat ) - IF ( ErrStat /= 0 ) Err = .TRUE. - - !------------------------------------------------------------------------------------------------- - ! Reset number of outputs - !------------------------------------------------------------------------------------------------- - p%NumOuts = 0 - p%UnOutFile = -1 - - !p%WaveKinNd = -1 ! set this array to "invalid" - - !------------------------------------------------------------------------------------------------- - ! Make sure ErrStat is non-zero if an error occurred - !------------------------------------------------------------------------------------------------- - IF ( Err ) ErrStat = ErrID_Fatal - - RETURN - -END SUBROUTINE Wvs2OUT_DestroyParam -!==================================================================================================== - - -END MODULE Waves2_Output diff --git a/modules/hydrodyn/src/Waves2_Types.f90 b/modules/hydrodyn/src/Waves2_Types.f90 deleted file mode 100644 index c5c1afd7dc..0000000000 --- a/modules/hydrodyn/src/Waves2_Types.f90 +++ /dev/null @@ -1,3923 +0,0 @@ -!STARTOFREGISTRYGENERATEDFILE 'Waves2_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 -!********************************************************************************************************************************* -! Waves2_Types -!................................................................................................................................. -! This file is part of Waves2. -! -! 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 Waves2. 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 Waves2_Types -!--------------------------------------------------------------------------------------------------------------------------------- -USE NWTC_Library -IMPLICIT NONE - INTEGER(IntKi), PUBLIC, PARAMETER :: MaxWaves2Outputs = 9 ! [-] -! ========= Waves2_InitInputType ======= - TYPE, PUBLIC :: Waves2_InitInputType - INTEGER(IntKi) :: UnSum !< The unit number for the HydroDyn summary file [-] - REAL(ReKi) :: Gravity !< Gravitational acceleration [(m/s^2)] - REAL(ReKi) :: WtrDens !< Water density [(kg/m^3)] - REAL(SiKi) :: WtrDpth !< Water depth [(meters)] - INTEGER(IntKi) :: NStepWave !< Total number of frequency components = total number of time steps in the incident wave [-] - INTEGER(IntKi) :: NStepWave2 !< NStepWave / 2 [-] - REAL(SiKi) :: WaveDOmega !< Frequency step for incident wave calculations [(rad/s)] - INTEGER(IntKi) :: WaveStMod !< Model for stretching incident wave kinematics to instantaneous free surface {0: none=no stretching, 1: vertical stretching, 2: extrapolation stretching, 3: Wheeler stretching} [-] - LOGICAL :: WaveMultiDir !< Indicates the waves are multidirectional -- set by HydroDyn_Input [-] - REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveDirArr !< Wave direction array. Each frequency has a unique direction of WaveNDir > 1 [(degrees)] - REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: WaveElevC0 !< Discrete Fourier transform of the instantaneous elevation of incident waves at the platform reference point. First column is real part, second column is imaginary part [(meters)] - REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveTime !< Simulation times at which the instantaneous second order loads associated with the incident waves are determined [sec] - INTEGER(IntKi) :: NWaveElev !< Number of points where the incident wave elevations can be output [-] - REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveElevxi !< xi-coordinates for points where the incident wave elevations can be output [(meters)] - REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveElevyi !< yi-coordinates for points where the incident wave elevations can be output [(meters)] - REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: WaveElevXY !< Supplied by Driver: X-Y locations for WaveElevation output (for visualization). Index 1 corresponds to X or Y coordinate. Index 2 corresponds to point number. [-] - INTEGER(IntKi) :: NWaveKin !< Number of points where the incident wave kinematics will be computed [-] - REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveKinxi !< xi-coordinates for points where the incident wave kinematics will be computed; these are relative to the mean sea level [(meters)] - REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveKinyi !< yi-coordinates for points where the incident wave kinematics will be computed; these are relative to the mean sea level [(meters)] - REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveKinzi !< zi-coordinates for points where the incident wave kinematics will be computed; these are relative to the mean sea level [(meters)] - LOGICAL :: WvDiffQTFF !< Full difference QTF second order forces flag [(-)] - LOGICAL :: WvSumQTFF !< Full sum QTF second order forces flag [(-)] - REAL(SiKi) :: WvLowCOffD !< Minimum frequency used in the difference methods [Ignored if all difference methods = 0] [(rad/s)] - REAL(SiKi) :: WvHiCOffD !< Maximum frequency used in the difference methods [Ignored if all difference methods = 0] [(rad/s)] - REAL(SiKi) :: WvLowCOffS !< Minimum frequency used in the sum-QTF method [Ignored if SumQTF = 0] [(rad/s)] - REAL(SiKi) :: WvHiCOffS !< Maximum frequency used in the sum-QTF method [Ignored if SumQTF = 0] [(rad/s)] - CHARACTER(ChanLen) , DIMENSION(1:18) :: OutList !< This should really be dimensioned with MaxOutPts [-] - LOGICAL :: OutAll !< [-] - INTEGER(IntKi) :: NumOuts !< [-] - INTEGER(IntKi) :: NumOutAll !< [-] - END TYPE Waves2_InitInputType -! ======================= -! ========= Waves2_InitOutputType ======= - TYPE, PUBLIC :: Waves2_InitOutputType - CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputHdr !< [-] - CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputUnt !< [-] - REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: WaveElevSeries2 !< [(m)] - REAL(SiKi) , DIMENSION(:,:,:), ALLOCATABLE :: WaveAcc2D !< [(m/s^2)] - REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: WaveDynP2D !< [(N/m^2)] - REAL(SiKi) , DIMENSION(:,:,:), ALLOCATABLE :: WaveAcc2S !< [(m/s^2)] - REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: WaveDynP2S !< [(N/m^2)] - REAL(SiKi) , DIMENSION(:,:,:), ALLOCATABLE :: WaveVel2D !< [(m/s)] - REAL(SiKi) , DIMENSION(:,:,:), ALLOCATABLE :: WaveVel2S !< [(m/s)] - REAL(SiKi) , DIMENSION(:,:,:), ALLOCATABLE :: WaveAcc2D0 !< [(m/s^2)] - REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: WaveDynP2D0 !< [(N/m^2)] - REAL(SiKi) , DIMENSION(:,:,:), ALLOCATABLE :: WaveAcc2S0 !< [(m/s^2)] - REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: WaveDynP2S0 !< [(N/m^2)] - REAL(SiKi) , DIMENSION(:,:,:), ALLOCATABLE :: WaveVel2D0 !< [(m/s)] - REAL(SiKi) , DIMENSION(:,:,:), ALLOCATABLE :: WaveVel2S0 !< [(m/s)] - END TYPE Waves2_InitOutputType -! ======================= -! ========= Waves2_ContinuousStateType ======= - TYPE, PUBLIC :: Waves2_ContinuousStateType - REAL(SiKi) :: DummyContState !< Remove this variable if you have continuous states [-] - END TYPE Waves2_ContinuousStateType -! ======================= -! ========= Waves2_DiscreteStateType ======= - TYPE, PUBLIC :: Waves2_DiscreteStateType - REAL(SiKi) :: DummyDiscState !< Remove this variable if you have discrete states [-] - END TYPE Waves2_DiscreteStateType -! ======================= -! ========= Waves2_ConstraintStateType ======= - TYPE, PUBLIC :: Waves2_ConstraintStateType - REAL(SiKi) :: DummyConstrState !< Remove this variable if you have constraint states [-] - END TYPE Waves2_ConstraintStateType -! ======================= -! ========= Waves2_OtherStateType ======= - TYPE, PUBLIC :: Waves2_OtherStateType - INTEGER(IntKi) :: DummyOtherState !< Remove this variable if you have other states [-] - END TYPE Waves2_OtherStateType -! ======================= -! ========= Waves2_MiscVarType ======= - TYPE, PUBLIC :: Waves2_MiscVarType - INTEGER(IntKi) :: LastIndWave !< Index for last interpolation step of 2nd order forces [-] - END TYPE Waves2_MiscVarType -! ======================= -! ========= Waves2_ParameterType ======= - TYPE, PUBLIC :: Waves2_ParameterType - REAL(DbKi) :: DT !< Time step for continuous state integration & discrete state update [seconds] - LOGICAL :: WvDiffQTFF !< Full difference QTF second order forces flag [(-)] - LOGICAL :: WvSumQTFF !< Full sum QTF second order forces flag [(-)] - INTEGER(IntKi) :: NWaveElev !< Number of points where the incident wave elevations can be output [-] - INTEGER(IntKi) :: NStepWave !< Total number of frequency components = total number of time steps in the incident wave [-] - INTEGER(IntKi) :: NStepWave2 !< NStepWave / 2 [-] - REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveTime !< Simulation times at which the instantaneous second order loads associated with the incident waves are determined [sec] - REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: WaveElev2 !< Instantaneous elevation time-series of incident waves at each of the NWaveElev points where the incident wave elevations can be output [(meters)] - TYPE(OutParmType) , DIMENSION(:), ALLOCATABLE :: OutParam !< [-] - INTEGER(IntKi) :: NumOuts !< [-] - INTEGER(IntKi) :: NumOutAll !< [-] - CHARACTER(20) :: OutFmt !< [-] - CHARACTER(20) :: OutSFmt !< [-] - CHARACTER(ChanLen) :: Delim !< [-] - INTEGER(IntKi) :: UnOutFile !< [-] - END TYPE Waves2_ParameterType -! ======================= -! ========= Waves2_InputType ======= - TYPE, PUBLIC :: Waves2_InputType - REAL(SiKi) :: DummyInput !< Remove this variable if you have input data [-] - END TYPE Waves2_InputType -! ======================= -! ========= Waves2_OutputType ======= - TYPE, PUBLIC :: Waves2_OutputType - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: WriteOutput !< [-] - END TYPE Waves2_OutputType -! ======================= -CONTAINS - SUBROUTINE Waves2_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Waves2_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(Waves2_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 = 'Waves2_CopyInitInput' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInitInputData%UnSum = SrcInitInputData%UnSum - DstInitInputData%Gravity = SrcInitInputData%Gravity - DstInitInputData%WtrDens = SrcInitInputData%WtrDens - DstInitInputData%WtrDpth = SrcInitInputData%WtrDpth - DstInitInputData%NStepWave = SrcInitInputData%NStepWave - DstInitInputData%NStepWave2 = SrcInitInputData%NStepWave2 - DstInitInputData%WaveDOmega = SrcInitInputData%WaveDOmega - DstInitInputData%WaveStMod = SrcInitInputData%WaveStMod - DstInitInputData%WaveMultiDir = SrcInitInputData%WaveMultiDir -IF (ALLOCATED(SrcInitInputData%WaveDirArr)) THEN - i1_l = LBOUND(SrcInitInputData%WaveDirArr,1) - i1_u = UBOUND(SrcInitInputData%WaveDirArr,1) - IF (.NOT. ALLOCATED(DstInitInputData%WaveDirArr)) THEN - ALLOCATE(DstInitInputData%WaveDirArr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveDirArr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%WaveDirArr = SrcInitInputData%WaveDirArr -ENDIF -IF (ALLOCATED(SrcInitInputData%WaveElevC0)) THEN - i1_l = LBOUND(SrcInitInputData%WaveElevC0,1) - i1_u = UBOUND(SrcInitInputData%WaveElevC0,1) - i2_l = LBOUND(SrcInitInputData%WaveElevC0,2) - i2_u = UBOUND(SrcInitInputData%WaveElevC0,2) - IF (.NOT. ALLOCATED(DstInitInputData%WaveElevC0)) THEN - ALLOCATE(DstInitInputData%WaveElevC0(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveElevC0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%WaveElevC0 = SrcInitInputData%WaveElevC0 -ENDIF -IF (ALLOCATED(SrcInitInputData%WaveTime)) THEN - i1_l = LBOUND(SrcInitInputData%WaveTime,1) - i1_u = UBOUND(SrcInitInputData%WaveTime,1) - IF (.NOT. ALLOCATED(DstInitInputData%WaveTime)) THEN - ALLOCATE(DstInitInputData%WaveTime(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveTime.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%WaveTime = SrcInitInputData%WaveTime -ENDIF - DstInitInputData%NWaveElev = SrcInitInputData%NWaveElev -IF (ALLOCATED(SrcInitInputData%WaveElevxi)) THEN - i1_l = LBOUND(SrcInitInputData%WaveElevxi,1) - i1_u = UBOUND(SrcInitInputData%WaveElevxi,1) - IF (.NOT. ALLOCATED(DstInitInputData%WaveElevxi)) THEN - ALLOCATE(DstInitInputData%WaveElevxi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveElevxi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%WaveElevxi = SrcInitInputData%WaveElevxi -ENDIF -IF (ALLOCATED(SrcInitInputData%WaveElevyi)) THEN - i1_l = LBOUND(SrcInitInputData%WaveElevyi,1) - i1_u = UBOUND(SrcInitInputData%WaveElevyi,1) - IF (.NOT. ALLOCATED(DstInitInputData%WaveElevyi)) THEN - ALLOCATE(DstInitInputData%WaveElevyi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveElevyi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%WaveElevyi = SrcInitInputData%WaveElevyi -ENDIF -IF (ALLOCATED(SrcInitInputData%WaveElevXY)) THEN - i1_l = LBOUND(SrcInitInputData%WaveElevXY,1) - i1_u = UBOUND(SrcInitInputData%WaveElevXY,1) - i2_l = LBOUND(SrcInitInputData%WaveElevXY,2) - i2_u = UBOUND(SrcInitInputData%WaveElevXY,2) - IF (.NOT. ALLOCATED(DstInitInputData%WaveElevXY)) THEN - ALLOCATE(DstInitInputData%WaveElevXY(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveElevXY.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%WaveElevXY = SrcInitInputData%WaveElevXY -ENDIF - DstInitInputData%NWaveKin = SrcInitInputData%NWaveKin -IF (ALLOCATED(SrcInitInputData%WaveKinxi)) THEN - i1_l = LBOUND(SrcInitInputData%WaveKinxi,1) - i1_u = UBOUND(SrcInitInputData%WaveKinxi,1) - IF (.NOT. ALLOCATED(DstInitInputData%WaveKinxi)) THEN - ALLOCATE(DstInitInputData%WaveKinxi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveKinxi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%WaveKinxi = SrcInitInputData%WaveKinxi -ENDIF -IF (ALLOCATED(SrcInitInputData%WaveKinyi)) THEN - i1_l = LBOUND(SrcInitInputData%WaveKinyi,1) - i1_u = UBOUND(SrcInitInputData%WaveKinyi,1) - IF (.NOT. ALLOCATED(DstInitInputData%WaveKinyi)) THEN - ALLOCATE(DstInitInputData%WaveKinyi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveKinyi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%WaveKinyi = SrcInitInputData%WaveKinyi -ENDIF -IF (ALLOCATED(SrcInitInputData%WaveKinzi)) THEN - i1_l = LBOUND(SrcInitInputData%WaveKinzi,1) - i1_u = UBOUND(SrcInitInputData%WaveKinzi,1) - IF (.NOT. ALLOCATED(DstInitInputData%WaveKinzi)) THEN - ALLOCATE(DstInitInputData%WaveKinzi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveKinzi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%WaveKinzi = SrcInitInputData%WaveKinzi -ENDIF - DstInitInputData%WvDiffQTFF = SrcInitInputData%WvDiffQTFF - DstInitInputData%WvSumQTFF = SrcInitInputData%WvSumQTFF - DstInitInputData%WvLowCOffD = SrcInitInputData%WvLowCOffD - DstInitInputData%WvHiCOffD = SrcInitInputData%WvHiCOffD - DstInitInputData%WvLowCOffS = SrcInitInputData%WvLowCOffS - DstInitInputData%WvHiCOffS = SrcInitInputData%WvHiCOffS - DstInitInputData%OutList = SrcInitInputData%OutList - DstInitInputData%OutAll = SrcInitInputData%OutAll - DstInitInputData%NumOuts = SrcInitInputData%NumOuts - DstInitInputData%NumOutAll = SrcInitInputData%NumOutAll - END SUBROUTINE Waves2_CopyInitInput - - SUBROUTINE Waves2_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(Waves2_InitInputType), INTENT(INOUT) :: InitInputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_DestroyInitInput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(InitInputData%WaveDirArr)) THEN - DEALLOCATE(InitInputData%WaveDirArr) -ENDIF -IF (ALLOCATED(InitInputData%WaveElevC0)) THEN - DEALLOCATE(InitInputData%WaveElevC0) -ENDIF -IF (ALLOCATED(InitInputData%WaveTime)) THEN - DEALLOCATE(InitInputData%WaveTime) -ENDIF -IF (ALLOCATED(InitInputData%WaveElevxi)) THEN - DEALLOCATE(InitInputData%WaveElevxi) -ENDIF -IF (ALLOCATED(InitInputData%WaveElevyi)) THEN - DEALLOCATE(InitInputData%WaveElevyi) -ENDIF -IF (ALLOCATED(InitInputData%WaveElevXY)) THEN - DEALLOCATE(InitInputData%WaveElevXY) -ENDIF -IF (ALLOCATED(InitInputData%WaveKinxi)) THEN - DEALLOCATE(InitInputData%WaveKinxi) -ENDIF -IF (ALLOCATED(InitInputData%WaveKinyi)) THEN - DEALLOCATE(InitInputData%WaveKinyi) -ENDIF -IF (ALLOCATED(InitInputData%WaveKinzi)) THEN - DEALLOCATE(InitInputData%WaveKinzi) -ENDIF - END SUBROUTINE Waves2_DestroyInitInput - - SUBROUTINE Waves2_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(Waves2_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 = 'Waves2_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 ! UnSum - Re_BufSz = Re_BufSz + 1 ! Gravity - Re_BufSz = Re_BufSz + 1 ! WtrDens - Re_BufSz = Re_BufSz + 1 ! WtrDpth - Int_BufSz = Int_BufSz + 1 ! NStepWave - Int_BufSz = Int_BufSz + 1 ! NStepWave2 - Re_BufSz = Re_BufSz + 1 ! WaveDOmega - Int_BufSz = Int_BufSz + 1 ! WaveStMod - Int_BufSz = Int_BufSz + 1 ! WaveMultiDir - Int_BufSz = Int_BufSz + 1 ! WaveDirArr allocated yes/no - IF ( ALLOCATED(InData%WaveDirArr) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WaveDirArr upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveDirArr) ! WaveDirArr - END IF - Int_BufSz = Int_BufSz + 1 ! WaveElevC0 allocated yes/no - IF ( ALLOCATED(InData%WaveElevC0) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! WaveElevC0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveElevC0) ! WaveElevC0 - END IF - Int_BufSz = Int_BufSz + 1 ! WaveTime allocated yes/no - IF ( ALLOCATED(InData%WaveTime) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WaveTime upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveTime) ! WaveTime - END IF - Int_BufSz = Int_BufSz + 1 ! NWaveElev - Int_BufSz = Int_BufSz + 1 ! WaveElevxi allocated yes/no - IF ( ALLOCATED(InData%WaveElevxi) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WaveElevxi upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveElevxi) ! WaveElevxi - END IF - Int_BufSz = Int_BufSz + 1 ! WaveElevyi allocated yes/no - IF ( ALLOCATED(InData%WaveElevyi) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WaveElevyi upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveElevyi) ! WaveElevyi - END IF - Int_BufSz = Int_BufSz + 1 ! WaveElevXY allocated yes/no - IF ( ALLOCATED(InData%WaveElevXY) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! WaveElevXY upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveElevXY) ! WaveElevXY - END IF - Int_BufSz = Int_BufSz + 1 ! NWaveKin - Int_BufSz = Int_BufSz + 1 ! WaveKinxi allocated yes/no - IF ( ALLOCATED(InData%WaveKinxi) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WaveKinxi upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveKinxi) ! WaveKinxi - END IF - Int_BufSz = Int_BufSz + 1 ! WaveKinyi allocated yes/no - IF ( ALLOCATED(InData%WaveKinyi) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WaveKinyi upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveKinyi) ! WaveKinyi - END IF - Int_BufSz = Int_BufSz + 1 ! WaveKinzi allocated yes/no - IF ( ALLOCATED(InData%WaveKinzi) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WaveKinzi upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveKinzi) ! WaveKinzi - END IF - Int_BufSz = Int_BufSz + 1 ! WvDiffQTFF - Int_BufSz = Int_BufSz + 1 ! WvSumQTFF - Re_BufSz = Re_BufSz + 1 ! WvLowCOffD - Re_BufSz = Re_BufSz + 1 ! WvHiCOffD - Re_BufSz = Re_BufSz + 1 ! WvLowCOffS - Re_BufSz = Re_BufSz + 1 ! WvHiCOffS - Int_BufSz = Int_BufSz + SIZE(InData%OutList)*LEN(InData%OutList) ! OutList - Int_BufSz = Int_BufSz + 1 ! OutAll - Int_BufSz = Int_BufSz + 1 ! NumOuts - Int_BufSz = Int_BufSz + 1 ! NumOutAll - 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%UnSum - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Gravity - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WtrDens - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WtrDpth - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NStepWave - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NStepWave2 - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WaveDOmega - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%WaveStMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%WaveMultiDir, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%WaveDirArr) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveDirArr,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDirArr,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WaveDirArr,1), UBOUND(InData%WaveDirArr,1) - ReKiBuf(Re_Xferred) = InData%WaveDirArr(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveElevC0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevC0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevC0,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevC0,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevC0,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%WaveElevC0,2), UBOUND(InData%WaveElevC0,2) - DO i1 = LBOUND(InData%WaveElevC0,1), UBOUND(InData%WaveElevC0,1) - ReKiBuf(Re_Xferred) = InData%WaveElevC0(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveTime) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveTime,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveTime,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WaveTime,1), UBOUND(InData%WaveTime,1) - ReKiBuf(Re_Xferred) = InData%WaveTime(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NWaveElev - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%WaveElevxi) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevxi,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevxi,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WaveElevxi,1), UBOUND(InData%WaveElevxi,1) - ReKiBuf(Re_Xferred) = InData%WaveElevxi(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveElevyi) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevyi,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevyi,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WaveElevyi,1), UBOUND(InData%WaveElevyi,1) - ReKiBuf(Re_Xferred) = InData%WaveElevyi(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveElevXY) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevXY,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevXY,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevXY,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevXY,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%WaveElevXY,2), UBOUND(InData%WaveElevXY,2) - DO i1 = LBOUND(InData%WaveElevXY,1), UBOUND(InData%WaveElevXY,1) - ReKiBuf(Re_Xferred) = InData%WaveElevXY(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NWaveKin - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%WaveKinxi) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveKinxi,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveKinxi,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WaveKinxi,1), UBOUND(InData%WaveKinxi,1) - ReKiBuf(Re_Xferred) = InData%WaveKinxi(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveKinyi) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveKinyi,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveKinyi,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WaveKinyi,1), UBOUND(InData%WaveKinyi,1) - ReKiBuf(Re_Xferred) = InData%WaveKinyi(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveKinzi) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveKinzi,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveKinzi,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WaveKinzi,1), UBOUND(InData%WaveKinzi,1) - ReKiBuf(Re_Xferred) = InData%WaveKinzi(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = TRANSFER(InData%WvDiffQTFF, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%WvSumQTFF, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WvLowCOffD - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WvHiCOffD - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WvLowCOffS - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WvHiCOffS - Re_Xferred = Re_Xferred + 1 - 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 - IntKiBuf(Int_Xferred) = TRANSFER(InData%OutAll, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumOutAll - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Waves2_PackInitInput - - SUBROUTINE Waves2_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(Waves2_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 = 'Waves2_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%UnSum = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%Gravity = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%WtrDens = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%WtrDpth = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%NStepWave = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NStepWave2 = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WaveDOmega = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WaveStMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WaveMultiDir = TRANSFER(IntKiBuf(Int_Xferred), OutData%WaveMultiDir) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveDirArr not allocated - Int_Xferred = Int_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%WaveDirArr)) DEALLOCATE(OutData%WaveDirArr) - ALLOCATE(OutData%WaveDirArr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDirArr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WaveDirArr,1), UBOUND(OutData%WaveDirArr,1) - OutData%WaveDirArr(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElevC0 not allocated - Int_Xferred = Int_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%WaveElevC0)) DEALLOCATE(OutData%WaveElevC0) - ALLOCATE(OutData%WaveElevC0(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevC0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%WaveElevC0,2), UBOUND(OutData%WaveElevC0,2) - DO i1 = LBOUND(OutData%WaveElevC0,1), UBOUND(OutData%WaveElevC0,1) - OutData%WaveElevC0(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveTime not allocated - Int_Xferred = Int_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%WaveTime)) DEALLOCATE(OutData%WaveTime) - ALLOCATE(OutData%WaveTime(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveTime.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WaveTime,1), UBOUND(OutData%WaveTime,1) - OutData%WaveTime(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%NWaveElev = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElevxi not allocated - Int_Xferred = Int_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%WaveElevxi)) DEALLOCATE(OutData%WaveElevxi) - ALLOCATE(OutData%WaveElevxi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevxi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WaveElevxi,1), UBOUND(OutData%WaveElevxi,1) - OutData%WaveElevxi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElevyi not allocated - Int_Xferred = Int_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%WaveElevyi)) DEALLOCATE(OutData%WaveElevyi) - ALLOCATE(OutData%WaveElevyi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevyi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WaveElevyi,1), UBOUND(OutData%WaveElevyi,1) - OutData%WaveElevyi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElevXY not allocated - Int_Xferred = Int_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%WaveElevXY)) DEALLOCATE(OutData%WaveElevXY) - ALLOCATE(OutData%WaveElevXY(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevXY.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%WaveElevXY,2), UBOUND(OutData%WaveElevXY,2) - DO i1 = LBOUND(OutData%WaveElevXY,1), UBOUND(OutData%WaveElevXY,1) - OutData%WaveElevXY(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%NWaveKin = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveKinxi not allocated - Int_Xferred = Int_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%WaveKinxi)) DEALLOCATE(OutData%WaveKinxi) - ALLOCATE(OutData%WaveKinxi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveKinxi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WaveKinxi,1), UBOUND(OutData%WaveKinxi,1) - OutData%WaveKinxi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveKinyi not allocated - Int_Xferred = Int_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%WaveKinyi)) DEALLOCATE(OutData%WaveKinyi) - ALLOCATE(OutData%WaveKinyi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveKinyi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WaveKinyi,1), UBOUND(OutData%WaveKinyi,1) - OutData%WaveKinyi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveKinzi not allocated - Int_Xferred = Int_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%WaveKinzi)) DEALLOCATE(OutData%WaveKinzi) - ALLOCATE(OutData%WaveKinzi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveKinzi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WaveKinzi,1), UBOUND(OutData%WaveKinzi,1) - OutData%WaveKinzi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%WvDiffQTFF = TRANSFER(IntKiBuf(Int_Xferred), OutData%WvDiffQTFF) - Int_Xferred = Int_Xferred + 1 - OutData%WvSumQTFF = TRANSFER(IntKiBuf(Int_Xferred), OutData%WvSumQTFF) - Int_Xferred = Int_Xferred + 1 - OutData%WvLowCOffD = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WvHiCOffD = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WvLowCOffS = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WvHiCOffS = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%OutList,1) - i1_u = UBOUND(OutData%OutList,1) - 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 - OutData%OutAll = TRANSFER(IntKiBuf(Int_Xferred), OutData%OutAll) - Int_Xferred = Int_Xferred + 1 - OutData%NumOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumOutAll = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Waves2_UnPackInitInput - - SUBROUTINE Waves2_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Waves2_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(Waves2_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) :: 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 = 'Waves2_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 -IF (ALLOCATED(SrcInitOutputData%WaveElevSeries2)) THEN - i1_l = LBOUND(SrcInitOutputData%WaveElevSeries2,1) - i1_u = UBOUND(SrcInitOutputData%WaveElevSeries2,1) - i2_l = LBOUND(SrcInitOutputData%WaveElevSeries2,2) - i2_u = UBOUND(SrcInitOutputData%WaveElevSeries2,2) - IF (.NOT. ALLOCATED(DstInitOutputData%WaveElevSeries2)) THEN - ALLOCATE(DstInitOutputData%WaveElevSeries2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveElevSeries2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WaveElevSeries2 = SrcInitOutputData%WaveElevSeries2 -ENDIF -IF (ALLOCATED(SrcInitOutputData%WaveAcc2D)) THEN - i1_l = LBOUND(SrcInitOutputData%WaveAcc2D,1) - i1_u = UBOUND(SrcInitOutputData%WaveAcc2D,1) - i2_l = LBOUND(SrcInitOutputData%WaveAcc2D,2) - i2_u = UBOUND(SrcInitOutputData%WaveAcc2D,2) - i3_l = LBOUND(SrcInitOutputData%WaveAcc2D,3) - i3_u = UBOUND(SrcInitOutputData%WaveAcc2D,3) - IF (.NOT. ALLOCATED(DstInitOutputData%WaveAcc2D)) THEN - ALLOCATE(DstInitOutputData%WaveAcc2D(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveAcc2D.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WaveAcc2D = SrcInitOutputData%WaveAcc2D -ENDIF -IF (ALLOCATED(SrcInitOutputData%WaveDynP2D)) THEN - i1_l = LBOUND(SrcInitOutputData%WaveDynP2D,1) - i1_u = UBOUND(SrcInitOutputData%WaveDynP2D,1) - i2_l = LBOUND(SrcInitOutputData%WaveDynP2D,2) - i2_u = UBOUND(SrcInitOutputData%WaveDynP2D,2) - IF (.NOT. ALLOCATED(DstInitOutputData%WaveDynP2D)) THEN - ALLOCATE(DstInitOutputData%WaveDynP2D(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveDynP2D.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WaveDynP2D = SrcInitOutputData%WaveDynP2D -ENDIF -IF (ALLOCATED(SrcInitOutputData%WaveAcc2S)) THEN - i1_l = LBOUND(SrcInitOutputData%WaveAcc2S,1) - i1_u = UBOUND(SrcInitOutputData%WaveAcc2S,1) - i2_l = LBOUND(SrcInitOutputData%WaveAcc2S,2) - i2_u = UBOUND(SrcInitOutputData%WaveAcc2S,2) - i3_l = LBOUND(SrcInitOutputData%WaveAcc2S,3) - i3_u = UBOUND(SrcInitOutputData%WaveAcc2S,3) - IF (.NOT. ALLOCATED(DstInitOutputData%WaveAcc2S)) THEN - ALLOCATE(DstInitOutputData%WaveAcc2S(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveAcc2S.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WaveAcc2S = SrcInitOutputData%WaveAcc2S -ENDIF -IF (ALLOCATED(SrcInitOutputData%WaveDynP2S)) THEN - i1_l = LBOUND(SrcInitOutputData%WaveDynP2S,1) - i1_u = UBOUND(SrcInitOutputData%WaveDynP2S,1) - i2_l = LBOUND(SrcInitOutputData%WaveDynP2S,2) - i2_u = UBOUND(SrcInitOutputData%WaveDynP2S,2) - IF (.NOT. ALLOCATED(DstInitOutputData%WaveDynP2S)) THEN - ALLOCATE(DstInitOutputData%WaveDynP2S(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveDynP2S.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WaveDynP2S = SrcInitOutputData%WaveDynP2S -ENDIF -IF (ALLOCATED(SrcInitOutputData%WaveVel2D)) THEN - i1_l = LBOUND(SrcInitOutputData%WaveVel2D,1) - i1_u = UBOUND(SrcInitOutputData%WaveVel2D,1) - i2_l = LBOUND(SrcInitOutputData%WaveVel2D,2) - i2_u = UBOUND(SrcInitOutputData%WaveVel2D,2) - i3_l = LBOUND(SrcInitOutputData%WaveVel2D,3) - i3_u = UBOUND(SrcInitOutputData%WaveVel2D,3) - IF (.NOT. ALLOCATED(DstInitOutputData%WaveVel2D)) THEN - ALLOCATE(DstInitOutputData%WaveVel2D(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveVel2D.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WaveVel2D = SrcInitOutputData%WaveVel2D -ENDIF -IF (ALLOCATED(SrcInitOutputData%WaveVel2S)) THEN - i1_l = LBOUND(SrcInitOutputData%WaveVel2S,1) - i1_u = UBOUND(SrcInitOutputData%WaveVel2S,1) - i2_l = LBOUND(SrcInitOutputData%WaveVel2S,2) - i2_u = UBOUND(SrcInitOutputData%WaveVel2S,2) - i3_l = LBOUND(SrcInitOutputData%WaveVel2S,3) - i3_u = UBOUND(SrcInitOutputData%WaveVel2S,3) - IF (.NOT. ALLOCATED(DstInitOutputData%WaveVel2S)) THEN - ALLOCATE(DstInitOutputData%WaveVel2S(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveVel2S.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WaveVel2S = SrcInitOutputData%WaveVel2S -ENDIF -IF (ALLOCATED(SrcInitOutputData%WaveAcc2D0)) THEN - i1_l = LBOUND(SrcInitOutputData%WaveAcc2D0,1) - i1_u = UBOUND(SrcInitOutputData%WaveAcc2D0,1) - i2_l = LBOUND(SrcInitOutputData%WaveAcc2D0,2) - i2_u = UBOUND(SrcInitOutputData%WaveAcc2D0,2) - i3_l = LBOUND(SrcInitOutputData%WaveAcc2D0,3) - i3_u = UBOUND(SrcInitOutputData%WaveAcc2D0,3) - IF (.NOT. ALLOCATED(DstInitOutputData%WaveAcc2D0)) THEN - ALLOCATE(DstInitOutputData%WaveAcc2D0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveAcc2D0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WaveAcc2D0 = SrcInitOutputData%WaveAcc2D0 -ENDIF -IF (ALLOCATED(SrcInitOutputData%WaveDynP2D0)) THEN - i1_l = LBOUND(SrcInitOutputData%WaveDynP2D0,1) - i1_u = UBOUND(SrcInitOutputData%WaveDynP2D0,1) - i2_l = LBOUND(SrcInitOutputData%WaveDynP2D0,2) - i2_u = UBOUND(SrcInitOutputData%WaveDynP2D0,2) - IF (.NOT. ALLOCATED(DstInitOutputData%WaveDynP2D0)) THEN - ALLOCATE(DstInitOutputData%WaveDynP2D0(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveDynP2D0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WaveDynP2D0 = SrcInitOutputData%WaveDynP2D0 -ENDIF -IF (ALLOCATED(SrcInitOutputData%WaveAcc2S0)) THEN - i1_l = LBOUND(SrcInitOutputData%WaveAcc2S0,1) - i1_u = UBOUND(SrcInitOutputData%WaveAcc2S0,1) - i2_l = LBOUND(SrcInitOutputData%WaveAcc2S0,2) - i2_u = UBOUND(SrcInitOutputData%WaveAcc2S0,2) - i3_l = LBOUND(SrcInitOutputData%WaveAcc2S0,3) - i3_u = UBOUND(SrcInitOutputData%WaveAcc2S0,3) - IF (.NOT. ALLOCATED(DstInitOutputData%WaveAcc2S0)) THEN - ALLOCATE(DstInitOutputData%WaveAcc2S0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveAcc2S0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WaveAcc2S0 = SrcInitOutputData%WaveAcc2S0 -ENDIF -IF (ALLOCATED(SrcInitOutputData%WaveDynP2S0)) THEN - i1_l = LBOUND(SrcInitOutputData%WaveDynP2S0,1) - i1_u = UBOUND(SrcInitOutputData%WaveDynP2S0,1) - i2_l = LBOUND(SrcInitOutputData%WaveDynP2S0,2) - i2_u = UBOUND(SrcInitOutputData%WaveDynP2S0,2) - IF (.NOT. ALLOCATED(DstInitOutputData%WaveDynP2S0)) THEN - ALLOCATE(DstInitOutputData%WaveDynP2S0(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveDynP2S0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WaveDynP2S0 = SrcInitOutputData%WaveDynP2S0 -ENDIF -IF (ALLOCATED(SrcInitOutputData%WaveVel2D0)) THEN - i1_l = LBOUND(SrcInitOutputData%WaveVel2D0,1) - i1_u = UBOUND(SrcInitOutputData%WaveVel2D0,1) - i2_l = LBOUND(SrcInitOutputData%WaveVel2D0,2) - i2_u = UBOUND(SrcInitOutputData%WaveVel2D0,2) - i3_l = LBOUND(SrcInitOutputData%WaveVel2D0,3) - i3_u = UBOUND(SrcInitOutputData%WaveVel2D0,3) - IF (.NOT. ALLOCATED(DstInitOutputData%WaveVel2D0)) THEN - ALLOCATE(DstInitOutputData%WaveVel2D0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveVel2D0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WaveVel2D0 = SrcInitOutputData%WaveVel2D0 -ENDIF -IF (ALLOCATED(SrcInitOutputData%WaveVel2S0)) THEN - i1_l = LBOUND(SrcInitOutputData%WaveVel2S0,1) - i1_u = UBOUND(SrcInitOutputData%WaveVel2S0,1) - i2_l = LBOUND(SrcInitOutputData%WaveVel2S0,2) - i2_u = UBOUND(SrcInitOutputData%WaveVel2S0,2) - i3_l = LBOUND(SrcInitOutputData%WaveVel2S0,3) - i3_u = UBOUND(SrcInitOutputData%WaveVel2S0,3) - IF (.NOT. ALLOCATED(DstInitOutputData%WaveVel2S0)) THEN - ALLOCATE(DstInitOutputData%WaveVel2S0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveVel2S0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WaveVel2S0 = SrcInitOutputData%WaveVel2S0 -ENDIF - END SUBROUTINE Waves2_CopyInitOutput - - SUBROUTINE Waves2_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(Waves2_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_DestroyInitOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(InitOutputData%WriteOutputHdr)) THEN - DEALLOCATE(InitOutputData%WriteOutputHdr) -ENDIF -IF (ALLOCATED(InitOutputData%WriteOutputUnt)) THEN - DEALLOCATE(InitOutputData%WriteOutputUnt) -ENDIF -IF (ALLOCATED(InitOutputData%WaveElevSeries2)) THEN - DEALLOCATE(InitOutputData%WaveElevSeries2) -ENDIF -IF (ALLOCATED(InitOutputData%WaveAcc2D)) THEN - DEALLOCATE(InitOutputData%WaveAcc2D) -ENDIF -IF (ALLOCATED(InitOutputData%WaveDynP2D)) THEN - DEALLOCATE(InitOutputData%WaveDynP2D) -ENDIF -IF (ALLOCATED(InitOutputData%WaveAcc2S)) THEN - DEALLOCATE(InitOutputData%WaveAcc2S) -ENDIF -IF (ALLOCATED(InitOutputData%WaveDynP2S)) THEN - DEALLOCATE(InitOutputData%WaveDynP2S) -ENDIF -IF (ALLOCATED(InitOutputData%WaveVel2D)) THEN - DEALLOCATE(InitOutputData%WaveVel2D) -ENDIF -IF (ALLOCATED(InitOutputData%WaveVel2S)) THEN - DEALLOCATE(InitOutputData%WaveVel2S) -ENDIF -IF (ALLOCATED(InitOutputData%WaveAcc2D0)) THEN - DEALLOCATE(InitOutputData%WaveAcc2D0) -ENDIF -IF (ALLOCATED(InitOutputData%WaveDynP2D0)) THEN - DEALLOCATE(InitOutputData%WaveDynP2D0) -ENDIF -IF (ALLOCATED(InitOutputData%WaveAcc2S0)) THEN - DEALLOCATE(InitOutputData%WaveAcc2S0) -ENDIF -IF (ALLOCATED(InitOutputData%WaveDynP2S0)) THEN - DEALLOCATE(InitOutputData%WaveDynP2S0) -ENDIF -IF (ALLOCATED(InitOutputData%WaveVel2D0)) THEN - DEALLOCATE(InitOutputData%WaveVel2D0) -ENDIF -IF (ALLOCATED(InitOutputData%WaveVel2S0)) THEN - DEALLOCATE(InitOutputData%WaveVel2S0) -ENDIF - END SUBROUTINE Waves2_DestroyInitOutput - - SUBROUTINE Waves2_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(Waves2_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 = 'Waves2_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 - Int_BufSz = Int_BufSz + 1 ! WaveElevSeries2 allocated yes/no - IF ( ALLOCATED(InData%WaveElevSeries2) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! WaveElevSeries2 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveElevSeries2) ! WaveElevSeries2 - END IF - Int_BufSz = Int_BufSz + 1 ! WaveAcc2D allocated yes/no - IF ( ALLOCATED(InData%WaveAcc2D) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! WaveAcc2D upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveAcc2D) ! WaveAcc2D - END IF - Int_BufSz = Int_BufSz + 1 ! WaveDynP2D allocated yes/no - IF ( ALLOCATED(InData%WaveDynP2D) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! WaveDynP2D upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveDynP2D) ! WaveDynP2D - END IF - Int_BufSz = Int_BufSz + 1 ! WaveAcc2S allocated yes/no - IF ( ALLOCATED(InData%WaveAcc2S) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! WaveAcc2S upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveAcc2S) ! WaveAcc2S - END IF - Int_BufSz = Int_BufSz + 1 ! WaveDynP2S allocated yes/no - IF ( ALLOCATED(InData%WaveDynP2S) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! WaveDynP2S upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveDynP2S) ! WaveDynP2S - END IF - Int_BufSz = Int_BufSz + 1 ! WaveVel2D allocated yes/no - IF ( ALLOCATED(InData%WaveVel2D) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! WaveVel2D upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveVel2D) ! WaveVel2D - END IF - Int_BufSz = Int_BufSz + 1 ! WaveVel2S allocated yes/no - IF ( ALLOCATED(InData%WaveVel2S) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! WaveVel2S upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveVel2S) ! WaveVel2S - END IF - Int_BufSz = Int_BufSz + 1 ! WaveAcc2D0 allocated yes/no - IF ( ALLOCATED(InData%WaveAcc2D0) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! WaveAcc2D0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveAcc2D0) ! WaveAcc2D0 - END IF - Int_BufSz = Int_BufSz + 1 ! WaveDynP2D0 allocated yes/no - IF ( ALLOCATED(InData%WaveDynP2D0) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! WaveDynP2D0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveDynP2D0) ! WaveDynP2D0 - END IF - Int_BufSz = Int_BufSz + 1 ! WaveAcc2S0 allocated yes/no - IF ( ALLOCATED(InData%WaveAcc2S0) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! WaveAcc2S0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveAcc2S0) ! WaveAcc2S0 - END IF - Int_BufSz = Int_BufSz + 1 ! WaveDynP2S0 allocated yes/no - IF ( ALLOCATED(InData%WaveDynP2S0) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! WaveDynP2S0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveDynP2S0) ! WaveDynP2S0 - END IF - Int_BufSz = Int_BufSz + 1 ! WaveVel2D0 allocated yes/no - IF ( ALLOCATED(InData%WaveVel2D0) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! WaveVel2D0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveVel2D0) ! WaveVel2D0 - END IF - Int_BufSz = Int_BufSz + 1 ! WaveVel2S0 allocated yes/no - IF ( ALLOCATED(InData%WaveVel2S0) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! WaveVel2S0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveVel2S0) ! WaveVel2S0 - 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 - IF ( .NOT. ALLOCATED(InData%WaveElevSeries2) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevSeries2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevSeries2,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevSeries2,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevSeries2,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%WaveElevSeries2,2), UBOUND(InData%WaveElevSeries2,2) - DO i1 = LBOUND(InData%WaveElevSeries2,1), UBOUND(InData%WaveElevSeries2,1) - ReKiBuf(Re_Xferred) = InData%WaveElevSeries2(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveAcc2D) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc2D,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc2D,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc2D,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc2D,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc2D,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc2D,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%WaveAcc2D,3), UBOUND(InData%WaveAcc2D,3) - DO i2 = LBOUND(InData%WaveAcc2D,2), UBOUND(InData%WaveAcc2D,2) - DO i1 = LBOUND(InData%WaveAcc2D,1), UBOUND(InData%WaveAcc2D,1) - ReKiBuf(Re_Xferred) = InData%WaveAcc2D(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveDynP2D) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveDynP2D,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDynP2D,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveDynP2D,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDynP2D,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%WaveDynP2D,2), UBOUND(InData%WaveDynP2D,2) - DO i1 = LBOUND(InData%WaveDynP2D,1), UBOUND(InData%WaveDynP2D,1) - ReKiBuf(Re_Xferred) = InData%WaveDynP2D(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveAcc2S) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc2S,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc2S,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc2S,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc2S,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc2S,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc2S,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%WaveAcc2S,3), UBOUND(InData%WaveAcc2S,3) - DO i2 = LBOUND(InData%WaveAcc2S,2), UBOUND(InData%WaveAcc2S,2) - DO i1 = LBOUND(InData%WaveAcc2S,1), UBOUND(InData%WaveAcc2S,1) - ReKiBuf(Re_Xferred) = InData%WaveAcc2S(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveDynP2S) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveDynP2S,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDynP2S,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveDynP2S,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDynP2S,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%WaveDynP2S,2), UBOUND(InData%WaveDynP2S,2) - DO i1 = LBOUND(InData%WaveDynP2S,1), UBOUND(InData%WaveDynP2S,1) - ReKiBuf(Re_Xferred) = InData%WaveDynP2S(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveVel2D) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel2D,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel2D,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel2D,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel2D,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel2D,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel2D,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%WaveVel2D,3), UBOUND(InData%WaveVel2D,3) - DO i2 = LBOUND(InData%WaveVel2D,2), UBOUND(InData%WaveVel2D,2) - DO i1 = LBOUND(InData%WaveVel2D,1), UBOUND(InData%WaveVel2D,1) - ReKiBuf(Re_Xferred) = InData%WaveVel2D(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveVel2S) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel2S,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel2S,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel2S,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel2S,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel2S,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel2S,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%WaveVel2S,3), UBOUND(InData%WaveVel2S,3) - DO i2 = LBOUND(InData%WaveVel2S,2), UBOUND(InData%WaveVel2S,2) - DO i1 = LBOUND(InData%WaveVel2S,1), UBOUND(InData%WaveVel2S,1) - ReKiBuf(Re_Xferred) = InData%WaveVel2S(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveAcc2D0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc2D0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc2D0,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc2D0,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc2D0,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc2D0,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc2D0,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%WaveAcc2D0,3), UBOUND(InData%WaveAcc2D0,3) - DO i2 = LBOUND(InData%WaveAcc2D0,2), UBOUND(InData%WaveAcc2D0,2) - DO i1 = LBOUND(InData%WaveAcc2D0,1), UBOUND(InData%WaveAcc2D0,1) - ReKiBuf(Re_Xferred) = InData%WaveAcc2D0(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveDynP2D0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveDynP2D0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDynP2D0,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveDynP2D0,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDynP2D0,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%WaveDynP2D0,2), UBOUND(InData%WaveDynP2D0,2) - DO i1 = LBOUND(InData%WaveDynP2D0,1), UBOUND(InData%WaveDynP2D0,1) - ReKiBuf(Re_Xferred) = InData%WaveDynP2D0(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveAcc2S0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc2S0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc2S0,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc2S0,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc2S0,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc2S0,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc2S0,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%WaveAcc2S0,3), UBOUND(InData%WaveAcc2S0,3) - DO i2 = LBOUND(InData%WaveAcc2S0,2), UBOUND(InData%WaveAcc2S0,2) - DO i1 = LBOUND(InData%WaveAcc2S0,1), UBOUND(InData%WaveAcc2S0,1) - ReKiBuf(Re_Xferred) = InData%WaveAcc2S0(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveDynP2S0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveDynP2S0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDynP2S0,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveDynP2S0,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDynP2S0,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%WaveDynP2S0,2), UBOUND(InData%WaveDynP2S0,2) - DO i1 = LBOUND(InData%WaveDynP2S0,1), UBOUND(InData%WaveDynP2S0,1) - ReKiBuf(Re_Xferred) = InData%WaveDynP2S0(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveVel2D0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel2D0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel2D0,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel2D0,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel2D0,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel2D0,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel2D0,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%WaveVel2D0,3), UBOUND(InData%WaveVel2D0,3) - DO i2 = LBOUND(InData%WaveVel2D0,2), UBOUND(InData%WaveVel2D0,2) - DO i1 = LBOUND(InData%WaveVel2D0,1), UBOUND(InData%WaveVel2D0,1) - ReKiBuf(Re_Xferred) = InData%WaveVel2D0(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveVel2S0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel2S0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel2S0,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel2S0,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel2S0,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel2S0,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel2S0,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%WaveVel2S0,3), UBOUND(InData%WaveVel2S0,3) - DO i2 = LBOUND(InData%WaveVel2S0,2), UBOUND(InData%WaveVel2S0,2) - DO i1 = LBOUND(InData%WaveVel2S0,1), UBOUND(InData%WaveVel2S0,1) - ReKiBuf(Re_Xferred) = InData%WaveVel2S0(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - END SUBROUTINE Waves2_PackInitOutput - - SUBROUTINE Waves2_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(Waves2_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) :: 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 = 'Waves2_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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElevSeries2 not allocated - Int_Xferred = Int_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%WaveElevSeries2)) DEALLOCATE(OutData%WaveElevSeries2) - ALLOCATE(OutData%WaveElevSeries2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevSeries2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%WaveElevSeries2,2), UBOUND(OutData%WaveElevSeries2,2) - DO i1 = LBOUND(OutData%WaveElevSeries2,1), UBOUND(OutData%WaveElevSeries2,1) - OutData%WaveElevSeries2(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveAcc2D not allocated - Int_Xferred = Int_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%WaveAcc2D)) DEALLOCATE(OutData%WaveAcc2D) - ALLOCATE(OutData%WaveAcc2D(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%WaveAcc2D.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%WaveAcc2D,3), UBOUND(OutData%WaveAcc2D,3) - DO i2 = LBOUND(OutData%WaveAcc2D,2), UBOUND(OutData%WaveAcc2D,2) - DO i1 = LBOUND(OutData%WaveAcc2D,1), UBOUND(OutData%WaveAcc2D,1) - OutData%WaveAcc2D(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveDynP2D not allocated - Int_Xferred = Int_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%WaveDynP2D)) DEALLOCATE(OutData%WaveDynP2D) - ALLOCATE(OutData%WaveDynP2D(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDynP2D.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%WaveDynP2D,2), UBOUND(OutData%WaveDynP2D,2) - DO i1 = LBOUND(OutData%WaveDynP2D,1), UBOUND(OutData%WaveDynP2D,1) - OutData%WaveDynP2D(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveAcc2S not allocated - Int_Xferred = Int_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%WaveAcc2S)) DEALLOCATE(OutData%WaveAcc2S) - ALLOCATE(OutData%WaveAcc2S(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%WaveAcc2S.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%WaveAcc2S,3), UBOUND(OutData%WaveAcc2S,3) - DO i2 = LBOUND(OutData%WaveAcc2S,2), UBOUND(OutData%WaveAcc2S,2) - DO i1 = LBOUND(OutData%WaveAcc2S,1), UBOUND(OutData%WaveAcc2S,1) - OutData%WaveAcc2S(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveDynP2S not allocated - Int_Xferred = Int_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%WaveDynP2S)) DEALLOCATE(OutData%WaveDynP2S) - ALLOCATE(OutData%WaveDynP2S(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDynP2S.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%WaveDynP2S,2), UBOUND(OutData%WaveDynP2S,2) - DO i1 = LBOUND(OutData%WaveDynP2S,1), UBOUND(OutData%WaveDynP2S,1) - OutData%WaveDynP2S(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveVel2D not allocated - Int_Xferred = Int_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%WaveVel2D)) DEALLOCATE(OutData%WaveVel2D) - ALLOCATE(OutData%WaveVel2D(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%WaveVel2D.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%WaveVel2D,3), UBOUND(OutData%WaveVel2D,3) - DO i2 = LBOUND(OutData%WaveVel2D,2), UBOUND(OutData%WaveVel2D,2) - DO i1 = LBOUND(OutData%WaveVel2D,1), UBOUND(OutData%WaveVel2D,1) - OutData%WaveVel2D(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveVel2S not allocated - Int_Xferred = Int_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%WaveVel2S)) DEALLOCATE(OutData%WaveVel2S) - ALLOCATE(OutData%WaveVel2S(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%WaveVel2S.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%WaveVel2S,3), UBOUND(OutData%WaveVel2S,3) - DO i2 = LBOUND(OutData%WaveVel2S,2), UBOUND(OutData%WaveVel2S,2) - DO i1 = LBOUND(OutData%WaveVel2S,1), UBOUND(OutData%WaveVel2S,1) - OutData%WaveVel2S(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveAcc2D0 not allocated - Int_Xferred = Int_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%WaveAcc2D0)) DEALLOCATE(OutData%WaveAcc2D0) - ALLOCATE(OutData%WaveAcc2D0(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%WaveAcc2D0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%WaveAcc2D0,3), UBOUND(OutData%WaveAcc2D0,3) - DO i2 = LBOUND(OutData%WaveAcc2D0,2), UBOUND(OutData%WaveAcc2D0,2) - DO i1 = LBOUND(OutData%WaveAcc2D0,1), UBOUND(OutData%WaveAcc2D0,1) - OutData%WaveAcc2D0(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveDynP2D0 not allocated - Int_Xferred = Int_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%WaveDynP2D0)) DEALLOCATE(OutData%WaveDynP2D0) - ALLOCATE(OutData%WaveDynP2D0(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDynP2D0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%WaveDynP2D0,2), UBOUND(OutData%WaveDynP2D0,2) - DO i1 = LBOUND(OutData%WaveDynP2D0,1), UBOUND(OutData%WaveDynP2D0,1) - OutData%WaveDynP2D0(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveAcc2S0 not allocated - Int_Xferred = Int_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%WaveAcc2S0)) DEALLOCATE(OutData%WaveAcc2S0) - ALLOCATE(OutData%WaveAcc2S0(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%WaveAcc2S0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%WaveAcc2S0,3), UBOUND(OutData%WaveAcc2S0,3) - DO i2 = LBOUND(OutData%WaveAcc2S0,2), UBOUND(OutData%WaveAcc2S0,2) - DO i1 = LBOUND(OutData%WaveAcc2S0,1), UBOUND(OutData%WaveAcc2S0,1) - OutData%WaveAcc2S0(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveDynP2S0 not allocated - Int_Xferred = Int_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%WaveDynP2S0)) DEALLOCATE(OutData%WaveDynP2S0) - ALLOCATE(OutData%WaveDynP2S0(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDynP2S0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%WaveDynP2S0,2), UBOUND(OutData%WaveDynP2S0,2) - DO i1 = LBOUND(OutData%WaveDynP2S0,1), UBOUND(OutData%WaveDynP2S0,1) - OutData%WaveDynP2S0(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveVel2D0 not allocated - Int_Xferred = Int_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%WaveVel2D0)) DEALLOCATE(OutData%WaveVel2D0) - ALLOCATE(OutData%WaveVel2D0(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%WaveVel2D0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%WaveVel2D0,3), UBOUND(OutData%WaveVel2D0,3) - DO i2 = LBOUND(OutData%WaveVel2D0,2), UBOUND(OutData%WaveVel2D0,2) - DO i1 = LBOUND(OutData%WaveVel2D0,1), UBOUND(OutData%WaveVel2D0,1) - OutData%WaveVel2D0(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveVel2S0 not allocated - Int_Xferred = Int_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%WaveVel2S0)) DEALLOCATE(OutData%WaveVel2S0) - ALLOCATE(OutData%WaveVel2S0(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%WaveVel2S0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%WaveVel2S0,3), UBOUND(OutData%WaveVel2S0,3) - DO i2 = LBOUND(OutData%WaveVel2S0,2), UBOUND(OutData%WaveVel2S0,2) - DO i1 = LBOUND(OutData%WaveVel2S0,1), UBOUND(OutData%WaveVel2S0,1) - OutData%WaveVel2S0(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - END SUBROUTINE Waves2_UnPackInitOutput - - SUBROUTINE Waves2_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Waves2_ContinuousStateType), INTENT(IN) :: SrcContStateData - TYPE(Waves2_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 = 'Waves2_CopyContState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstContStateData%DummyContState = SrcContStateData%DummyContState - END SUBROUTINE Waves2_CopyContState - - SUBROUTINE Waves2_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(Waves2_ContinuousStateType), INTENT(INOUT) :: ContStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_DestroyContState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE Waves2_DestroyContState - - SUBROUTINE Waves2_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(Waves2_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 = 'Waves2_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 Waves2_PackContState - - SUBROUTINE Waves2_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(Waves2_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 = 'Waves2_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 = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Waves2_UnPackContState - - SUBROUTINE Waves2_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Waves2_DiscreteStateType), INTENT(IN) :: SrcDiscStateData - TYPE(Waves2_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 = 'Waves2_CopyDiscState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstDiscStateData%DummyDiscState = SrcDiscStateData%DummyDiscState - END SUBROUTINE Waves2_CopyDiscState - - SUBROUTINE Waves2_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(Waves2_DiscreteStateType), INTENT(INOUT) :: DiscStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_DestroyDiscState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE Waves2_DestroyDiscState - - SUBROUTINE Waves2_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(Waves2_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 = 'Waves2_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 Waves2_PackDiscState - - SUBROUTINE Waves2_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(Waves2_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 = 'Waves2_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 = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Waves2_UnPackDiscState - - SUBROUTINE Waves2_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Waves2_ConstraintStateType), INTENT(IN) :: SrcConstrStateData - TYPE(Waves2_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 = 'Waves2_CopyConstrState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState - END SUBROUTINE Waves2_CopyConstrState - - SUBROUTINE Waves2_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(Waves2_ConstraintStateType), INTENT(INOUT) :: ConstrStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_DestroyConstrState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE Waves2_DestroyConstrState - - SUBROUTINE Waves2_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(Waves2_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 = 'Waves2_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 Waves2_PackConstrState - - SUBROUTINE Waves2_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(Waves2_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 = 'Waves2_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 = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Waves2_UnPackConstrState - - SUBROUTINE Waves2_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Waves2_OtherStateType), INTENT(IN) :: SrcOtherStateData - TYPE(Waves2_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 = 'Waves2_CopyOtherState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstOtherStateData%DummyOtherState = SrcOtherStateData%DummyOtherState - END SUBROUTINE Waves2_CopyOtherState - - SUBROUTINE Waves2_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(Waves2_OtherStateType), INTENT(INOUT) :: OtherStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_DestroyOtherState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE Waves2_DestroyOtherState - - SUBROUTINE Waves2_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(Waves2_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 = 'Waves2_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) = InData%DummyOtherState - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Waves2_PackOtherState - - SUBROUTINE Waves2_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(Waves2_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 = 'Waves2_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 Waves2_UnPackOtherState - - SUBROUTINE Waves2_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Waves2_MiscVarType), INTENT(IN) :: SrcMiscData - TYPE(Waves2_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 = 'Waves2_CopyMisc' -! - ErrStat = ErrID_None - ErrMsg = "" - DstMiscData%LastIndWave = SrcMiscData%LastIndWave - END SUBROUTINE Waves2_CopyMisc - - SUBROUTINE Waves2_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(Waves2_MiscVarType), INTENT(INOUT) :: MiscData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_DestroyMisc' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE Waves2_DestroyMisc - - SUBROUTINE Waves2_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(Waves2_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 = 'Waves2_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 ! LastIndWave - 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%LastIndWave - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Waves2_PackMisc - - SUBROUTINE Waves2_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(Waves2_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 = 'Waves2_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%LastIndWave = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Waves2_UnPackMisc - - SUBROUTINE Waves2_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Waves2_ParameterType), INTENT(IN) :: SrcParamData - TYPE(Waves2_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 = 'Waves2_CopyParam' -! - ErrStat = ErrID_None - ErrMsg = "" - DstParamData%DT = SrcParamData%DT - DstParamData%WvDiffQTFF = SrcParamData%WvDiffQTFF - DstParamData%WvSumQTFF = SrcParamData%WvSumQTFF - DstParamData%NWaveElev = SrcParamData%NWaveElev - DstParamData%NStepWave = SrcParamData%NStepWave - DstParamData%NStepWave2 = SrcParamData%NStepWave2 -IF (ALLOCATED(SrcParamData%WaveTime)) THEN - i1_l = LBOUND(SrcParamData%WaveTime,1) - i1_u = UBOUND(SrcParamData%WaveTime,1) - IF (.NOT. ALLOCATED(DstParamData%WaveTime)) THEN - ALLOCATE(DstParamData%WaveTime(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WaveTime.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%WaveTime = SrcParamData%WaveTime -ENDIF -IF (ALLOCATED(SrcParamData%WaveElev2)) THEN - i1_l = LBOUND(SrcParamData%WaveElev2,1) - i1_u = UBOUND(SrcParamData%WaveElev2,1) - i2_l = LBOUND(SrcParamData%WaveElev2,2) - i2_u = UBOUND(SrcParamData%WaveElev2,2) - IF (.NOT. ALLOCATED(DstParamData%WaveElev2)) THEN - ALLOCATE(DstParamData%WaveElev2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WaveElev2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%WaveElev2 = SrcParamData%WaveElev2 -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%NumOuts = SrcParamData%NumOuts - DstParamData%NumOutAll = SrcParamData%NumOutAll - DstParamData%OutFmt = SrcParamData%OutFmt - DstParamData%OutSFmt = SrcParamData%OutSFmt - DstParamData%Delim = SrcParamData%Delim - DstParamData%UnOutFile = SrcParamData%UnOutFile - END SUBROUTINE Waves2_CopyParam - - SUBROUTINE Waves2_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(Waves2_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(ParamData%WaveTime)) THEN - DEALLOCATE(ParamData%WaveTime) -ENDIF -IF (ALLOCATED(ParamData%WaveElev2)) THEN - DEALLOCATE(ParamData%WaveElev2) -ENDIF -IF (ALLOCATED(ParamData%OutParam)) THEN -DO i1 = LBOUND(ParamData%OutParam,1), UBOUND(ParamData%OutParam,1) - CALL NWTC_Library_Destroyoutparmtype( ParamData%OutParam(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ParamData%OutParam) -ENDIF - END SUBROUTINE Waves2_DestroyParam - - SUBROUTINE Waves2_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(Waves2_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 = 'Waves2_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 ! WvDiffQTFF - Int_BufSz = Int_BufSz + 1 ! WvSumQTFF - Int_BufSz = Int_BufSz + 1 ! NWaveElev - Int_BufSz = Int_BufSz + 1 ! NStepWave - Int_BufSz = Int_BufSz + 1 ! NStepWave2 - Int_BufSz = Int_BufSz + 1 ! WaveTime allocated yes/no - IF ( ALLOCATED(InData%WaveTime) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WaveTime upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveTime) ! WaveTime - END IF - Int_BufSz = Int_BufSz + 1 ! WaveElev2 allocated yes/no - IF ( ALLOCATED(InData%WaveElev2) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! WaveElev2 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveElev2) ! WaveElev2 - 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 - ! 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 ! NumOuts - Int_BufSz = Int_BufSz + 1 ! NumOutAll - Int_BufSz = Int_BufSz + 1*LEN(InData%OutFmt) ! OutFmt - Int_BufSz = Int_BufSz + 1*LEN(InData%OutSFmt) ! OutSFmt - Int_BufSz = Int_BufSz + 1*LEN(InData%Delim) ! Delim - Int_BufSz = Int_BufSz + 1 ! UnOutFile - 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%WvDiffQTFF, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%WvSumQTFF, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NWaveElev - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NStepWave - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NStepWave2 - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%WaveTime) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveTime,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveTime,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WaveTime,1), UBOUND(InData%WaveTime,1) - ReKiBuf(Re_Xferred) = InData%WaveTime(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveElev2) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev2,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev2,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev2,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%WaveElev2,2), UBOUND(InData%WaveElev2,2) - DO i1 = LBOUND(InData%WaveElev2,1), UBOUND(InData%WaveElev2,1) - ReKiBuf(Re_Xferred) = InData%WaveElev2(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - 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) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumOutAll - 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 - DO I = 1, LEN(InData%OutSFmt) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutSFmt(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - 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) = InData%UnOutFile - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Waves2_PackParam - - SUBROUTINE Waves2_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(Waves2_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 = 'Waves2_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%WvDiffQTFF = TRANSFER(IntKiBuf(Int_Xferred), OutData%WvDiffQTFF) - Int_Xferred = Int_Xferred + 1 - OutData%WvSumQTFF = TRANSFER(IntKiBuf(Int_Xferred), OutData%WvSumQTFF) - Int_Xferred = Int_Xferred + 1 - OutData%NWaveElev = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NStepWave = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NStepWave2 = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveTime not allocated - Int_Xferred = Int_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%WaveTime)) DEALLOCATE(OutData%WaveTime) - ALLOCATE(OutData%WaveTime(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveTime.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WaveTime,1), UBOUND(OutData%WaveTime,1) - OutData%WaveTime(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElev2 not allocated - Int_Xferred = Int_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%WaveElev2)) DEALLOCATE(OutData%WaveElev2) - ALLOCATE(OutData%WaveElev2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%WaveElev2,2), UBOUND(OutData%WaveElev2,2) - DO i1 = LBOUND(OutData%WaveElev2,1), UBOUND(OutData%WaveElev2,1) - OutData%WaveElev2(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - 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%NumOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumOutAll = IntKiBuf(Int_Xferred) - 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 - DO I = 1, LEN(OutData%OutSFmt) - OutData%OutSFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%Delim) - OutData%Delim(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%UnOutFile = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Waves2_UnPackParam - - SUBROUTINE Waves2_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Waves2_InputType), INTENT(IN) :: SrcInputData - TYPE(Waves2_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 = 'Waves2_CopyInput' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInputData%DummyInput = SrcInputData%DummyInput - END SUBROUTINE Waves2_CopyInput - - SUBROUTINE Waves2_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(Waves2_InputType), INTENT(INOUT) :: InputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_DestroyInput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE Waves2_DestroyInput - - SUBROUTINE Waves2_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(Waves2_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 = 'Waves2_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) = InData%DummyInput - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Waves2_PackInput - - SUBROUTINE Waves2_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(Waves2_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 = 'Waves2_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 = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Waves2_UnPackInput - - SUBROUTINE Waves2_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Waves2_OutputType), INTENT(IN) :: SrcOutputData - TYPE(Waves2_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 = 'Waves2_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 - END SUBROUTINE Waves2_CopyOutput - - SUBROUTINE Waves2_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(Waves2_OutputType), INTENT(INOUT) :: OutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_DestroyOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(OutputData%WriteOutput)) THEN - DEALLOCATE(OutputData%WriteOutput) -ENDIF - END SUBROUTINE Waves2_DestroyOutput - - SUBROUTINE Waves2_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(Waves2_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 = 'Waves2_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 - 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 - END SUBROUTINE Waves2_PackOutput - - SUBROUTINE Waves2_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(Waves2_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 = 'Waves2_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 - END SUBROUTINE Waves2_UnPackOutput - - - SUBROUTINE Waves2_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(Waves2_InputType), INTENT(IN) :: u(:) ! Input at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Inputs - TYPE(Waves2_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 = 'Waves2_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 Waves2_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL Waves2_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 Waves2_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 Waves2_Input_ExtrapInterp - - - SUBROUTINE Waves2_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(Waves2_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 - TYPE(Waves2_InputType), INTENT(IN) :: u2 ! Input at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs - TYPE(Waves2_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 = 'Waves2_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) - b = -(u1%DummyInput - u2%DummyInput) - u_out%DummyInput = u1%DummyInput + b * ScaleFactor - END SUBROUTINE Waves2_Input_ExtrapInterp1 - - - SUBROUTINE Waves2_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(Waves2_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 > t3 - TYPE(Waves2_InputType), INTENT(IN) :: u2 ! Input at t2 > t3 - TYPE(Waves2_InputType), INTENT(IN) :: u3 ! Input at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs - TYPE(Waves2_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 = 'Waves2_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))) - b = (t(3)**2*(u1%DummyInput - u2%DummyInput) + t(2)**2*(-u1%DummyInput + u3%DummyInput))* scaleFactor - c = ( (t(2)-t(3))*u1%DummyInput + t(3)*u2%DummyInput - t(2)*u3%DummyInput ) * scaleFactor - u_out%DummyInput = u1%DummyInput + b + c * t_out - END SUBROUTINE Waves2_Input_ExtrapInterp2 - - - SUBROUTINE Waves2_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(Waves2_OutputType), INTENT(IN) :: y(:) ! Output at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Outputs - TYPE(Waves2_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 = 'Waves2_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 Waves2_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL Waves2_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 Waves2_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 Waves2_Output_ExtrapInterp - - - SUBROUTINE Waves2_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(Waves2_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 - TYPE(Waves2_OutputType), INTENT(IN) :: y2 ! Output at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs - TYPE(Waves2_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 = 'Waves2_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 - END SUBROUTINE Waves2_Output_ExtrapInterp1 - - - SUBROUTINE Waves2_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(Waves2_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 > t3 - TYPE(Waves2_OutputType), INTENT(IN) :: y2 ! Output at t2 > t3 - TYPE(Waves2_OutputType), INTENT(IN) :: y3 ! Output at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs - TYPE(Waves2_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 = 'Waves2_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 - END SUBROUTINE Waves2_Output_ExtrapInterp2 - -END MODULE Waves2_Types -!ENDOFREGISTRYGENERATEDFILE diff --git a/modules/hydrodyn/src/Waves_Types.f90 b/modules/hydrodyn/src/Waves_Types.f90 deleted file mode 100644 index 3c3a277d08..0000000000 --- a/modules/hydrodyn/src/Waves_Types.f90 +++ /dev/null @@ -1,3668 +0,0 @@ -!STARTOFREGISTRYGENERATEDFILE 'Waves_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 -!********************************************************************************************************************************* -! Waves_Types -!................................................................................................................................. -! This file is part of Waves. -! -! 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 Waves. 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 Waves_Types -!--------------------------------------------------------------------------------------------------------------------------------- -USE NWTC_Library -IMPLICIT NONE -! ========= Waves_InitInputType ======= - TYPE, PUBLIC :: Waves_InitInputType - CHARACTER(1024) :: InputFile !< Name of the input file [-] - CHARACTER(1024) :: DirRoot !< The name of the root file including the full path. 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. [-] - CHARACTER(1024) :: WvKinFile !< The root name of user input wave kinematics files [-] - LOGICAL :: WriteWvKin !< Flag indicating whether we are going to write out kinematics files. [Must be FALSE if WaveMod = 5 or 6, if TRUE then WvKinFile must have a string value and this is the rootname for all the output files] [-] - INTEGER(IntKi) :: UnSum !< The unit number for the HydroDyn summary file [-] - REAL(ReKi) :: Gravity !< Gravitational acceleration [(m/s^2)] - REAL(ReKi) :: MSL2SWL !< Offset between still-water level and mean sea level [positive upward; must be zero if using WAMIT] [(meters)] - REAL(SiKi) :: WvLowCOff !< Low cut-off frequency or lower frequency limit of the wave spectrum beyond which the wave spectrum is zeroed. [used only when WaveMod=2,3,4] [(rad/s)] - REAL(SiKi) :: WvHiCOff !< High cut-off frequency or upper frequency limit of the wave spectrum beyond which the wave spectrum is zeroed. [used only when WaveMod=2,3,4] [(rad/s)] - REAL(SiKi) :: WaveDir !< Mean incident wave propagation heading direction [(degrees)] - INTEGER(IntKi) :: WaveNDir !< Number of wave directions [only used if WaveDirMod = 1] [Must be an odd number -- will be adjusted within the waves module] [(-)] - LOGICAL :: WaveMultiDir !< Indicates the waves are multidirectional -- set by HydroDyn_Input [-] - INTEGER(IntKi) :: WaveDirMod !< Directional wave spreading function {0: none, 1: COS2S} [only used if WaveMod=6] [-] - REAL(SiKi) :: WaveDirSpread !< Spreading coefficient [WaveMod=2,3,4 and WaveDirMod=1] [-] - REAL(SiKi) :: WaveDirRange !< Range of wave directions (full range: WaveDir +/- WaveDirRange/2) [only used if WaveMod=6] [(degrees)] - REAL(DbKi) :: WaveDT !< Time step for incident wave calculations [(sec)] - REAL(SiKi) :: WaveHs !< Significant wave height of incident waves [(meters)] - INTEGER(IntKi) :: WaveMod !< Incident wave kinematics model {0: none=still water, 1: plane progressive (regular), 2: JONSWAP/Pierson-Moskowitz spectrum (irregular), 3: white-noise spectrum, 4: user-defind spectrum from routine UserWaveSpctrm (irregular), 5: GH BLADED } [-] - CHARACTER(80) :: WaveModChr !< String to temporarially hold the value of the wave kinematics input line [-] - LOGICAL :: WaveNDAmp !< Flag for normally-distributed amplitudes in incident waves spectrum [flag] [-] - REAL(SiKi) :: WavePhase !< Specified phase for regular waves [(radians)] - REAL(SiKi) :: WavePkShp !< Peak shape parameter of incident wave spectrum [1.0 for Pierson-Moskowitz] [-] - CHARACTER(80) :: WavePkShpChr !< String to temporarially hold value of peak shape parameter input line [-] - INTEGER(IntKi) , DIMENSION(1:2) :: WaveSeed !< Random seeds of incident waves [-2147483648 to 2147483647] [-] - INTEGER(IntKi) :: WaveStMod !< Model for stretching incident wave kinematics to instantaneous free surface {0: none=no stretching, 1: vertical stretching, 2: extrapolation stretching, 3: Wheeler stretching} [-] - REAL(DbKi) :: WaveTMax !< Analysis time for incident wave calculations; the actual analysis time may be larger than this value in order for the maintain an effecient FFT [(sec)] - REAL(SiKi) :: WaveTp !< Peak spectral period of incident waves [(sec)] - REAL(SiKi) :: WtrDens !< Water density [(kg/m^3)] - REAL(SiKi) :: WtrDpth !< Water depth [(meters)] - INTEGER(IntKi) :: NWaveElev !< Number of points where the incident wave elevations can be output [-] - REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveElevxi !< xi-coordinates for points where the incident wave elevations can be output [(meters)] - REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveElevyi !< yi-coordinates for points where the incident wave elevations can be output [(meters)] - REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: WaveElevXY !< Supplied by Driver: X-Y locations for WaveElevation output (for visualization). Index 1 corresponds to X or Y coordinate. Index 2 corresponds to point number. [-] - REAL(ReKi) :: PtfmLocationX !< Copy of X coordinate of platform location in the wave field, used to offset/phase-shift all wave kinematics to account for location in the farm [m] - REAL(ReKi) :: PtfmLocationY !< Copy of Y coordinate of platform location in the wave field, used to offset/phase-shift all wave kinematics to account for location in the farm [m] - INTEGER(IntKi) :: WaveFieldMod !< Wave field handling (-) (switch) 0: use individual HydroDyn inputs without adjustment, 1: adjust wave phases based on turbine offsets from farm origin [-] - INTEGER(IntKi) :: NWaveKin !< Number of points where the incident wave kinematics will be computed [-] - REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveKinxi !< xi-coordinates for points where the incident wave kinematics will be computed; these are relative to the mean sea level [(meters)] - REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveKinyi !< yi-coordinates for points where the incident wave kinematics will be computed; these are relative to the mean sea level [(meters)] - REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveKinzi !< zi-coordinates for points where the incident wave kinematics will be computed; these are relative to the mean sea level [(meters)] - REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: CurrVxi !< xi-component of the current velocity at elevation i [(m/s)] - REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: CurrVyi !< yi-component of the current velocity at elevation i [(m/s)] - REAL(SiKi) :: PCurrVxiPz0 !< xi-component of the partial derivative of the current velocity at elevation near mean sea level [(m/s)] - REAL(SiKi) :: PCurrVyiPz0 !< yi-component of the partial derivative of the current velocity at elevation near mean sea level [(m/s)] - TYPE(NWTC_RandomNumber_ParameterType) :: RNG !< Parameters for the pseudo random number generator [-] - END TYPE Waves_InitInputType -! ======================= -! ========= Waves_InitOutputType ======= - TYPE, PUBLIC :: Waves_InitOutputType - REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: WaveElevC0 !< Discrete Fourier transform of the instantaneous elevation of incident waves at the platform reference point. First column is real part, second column is imaginary part [(meters)] - REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveDirArr !< Wave direction array. Each frequency has a unique direction of WaveNDir > 1 [(degrees)] - REAL(SiKi) :: WaveDirMin !< Minimum wave direction. [(degrees)] - REAL(SiKi) :: WaveDirMax !< Maximum wave direction. [(degrees)] - REAL(SiKi) :: WaveDir !< Incident wave propagation heading direction [(degrees)] - INTEGER(IntKi) :: WaveNDir !< Number of wave directions [only used if WaveDirMod = 1] [Must be an odd number -- will be adjusted within the waves module] [(-)] - LOGICAL :: WaveMultiDir !< Indicates the waves are multidirectional -- set by HydroDyn_Input [-] - REAL(SiKi) :: WaveDOmega !< Frequency step for incident wave calculations [(rad/s)] - REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveKinzi !< zi-coordinates for points where the incident wave kinematics will be computed; these are relative to the mean see level [(meters)] - REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: PWaveDynP0 !< Instantaneous dynamic pressure of incident waves , at the location (xi,yi,0), at each of the NWaveKin points where the incident wave kinematics will be computed [(N/m^2)] - REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: WaveDynP !< Instantaneous dynamic pressure of incident waves , accounting for stretching, at each of the NWaveKin points where the incident wave kinematics will be computed [(N/m^2)] - REAL(SiKi) , DIMENSION(:,:,:), ALLOCATABLE :: WaveAcc !< Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, accounting for stretching, at each of the NWaveKin points where the incident wave kinematics will be computed [(m/s^2)] - REAL(SiKi) , DIMENSION(:,:,:), ALLOCATABLE :: PWaveAcc0 !< Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, at the location (xi,yi,0), at each of the NWaveKin points where the incident wave kinematics will be computed [(m/s^2)] - REAL(SiKi) , DIMENSION(:,:,:), ALLOCATABLE :: WaveVel !< Instantaneous velocity of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, accounting for stretching, at each of the NWaveKin points where the incident wave kinematics will be computed (The values include both the velocity of incident waves and the velocity of current.) [(m/s)] - REAL(SiKi) , DIMENSION(:,:,:), ALLOCATABLE :: PWaveVel0 !< Instantaneous velocity of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, at the location (xi,yi,0), at each of the NWaveKin points where the incident wave kinematics will be computed (The values include both the velocity of incident waves and the velocity of current.) [(m/s)] - REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: WaveElev !< Instantaneous elevation time-series of incident waves at each of the NWaveElev points where the incident wave elevations can be output [(meters)] - REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveElev0 !< Instantaneous elevation time-series of incident waves at the platform reference point [(meters)] - REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: WaveElevMD !< Instantaneous elevation time-series of incident waves at hard coded grid for temporary use in MoorDyn [(m)] - REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: WaveElevSeries !< Instantaneous elevation time-series at each of the points given by WaveElevXY. Used for making movies of the waves. First index is the timestep. Second index is XY point number corresponding to second index of WaveElevXY. [(m)] - REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveTime !< Simulation times at which the instantaneous elevation of, velocity of, acceleration of, and loads associated with the incident waves are determined [(sec)] - REAL(DbKi) :: WaveTMax !< Analysis time for incident wave calculations; the actual analysis time may be larger than this value in order for the maintain an effecient FFT [(sec)] - INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: nodeInWater !< Logical flag indicating if the node at the given time step is in the water, and hence needs to have hydrodynamic forces calculated [-] - REAL(SiKi) :: RhoXg !< = WtrDens*Gravity [-] - INTEGER(IntKi) :: NStepWave !< Total number of frequency components = total number of time steps in the incident wave [-] - INTEGER(IntKi) :: NStepWave2 !< NStepWave / 2 [-] - END TYPE Waves_InitOutputType -! ======================= -! ========= Waves_ContinuousStateType ======= - TYPE, PUBLIC :: Waves_ContinuousStateType - REAL(SiKi) :: DummyContState !< Remove this variable if you have continuous states [-] - END TYPE Waves_ContinuousStateType -! ======================= -! ========= Waves_DiscreteStateType ======= - TYPE, PUBLIC :: Waves_DiscreteStateType - REAL(SiKi) :: DummyDiscState !< Remove this variable if you have discrete states [-] - END TYPE Waves_DiscreteStateType -! ======================= -! ========= Waves_ConstraintStateType ======= - TYPE, PUBLIC :: Waves_ConstraintStateType - REAL(SiKi) :: DummyConstrState !< Remove this variable if you have constraint states [-] - END TYPE Waves_ConstraintStateType -! ======================= -! ========= Waves_OtherStateType ======= - TYPE, PUBLIC :: Waves_OtherStateType - INTEGER(IntKi) :: DummyOtherState !< Remove this variable if you have other states [-] - END TYPE Waves_OtherStateType -! ======================= -! ========= Waves_MiscVarType ======= - TYPE, PUBLIC :: Waves_MiscVarType - INTEGER(IntKi) :: DummyMiscVar !< Remove this variable if you have misc/optimization variables [-] - END TYPE Waves_MiscVarType -! ======================= -! ========= Waves_ParameterType ======= - TYPE, PUBLIC :: Waves_ParameterType - REAL(DbKi) :: DT !< Time step for continuous state integration & discrete state update [seconds] - REAL(DbKi) :: WaveTMax !< Analysis time for incident wave calculations; the actual analysis time may be larger than this value in order for the maintain an effecient FFT [(sec)] - INTEGER(IntKi) :: NStepWave !< Total number of frequency components = total number of time steps in the incident wave [-] - INTEGER(IntKi) :: WaveNDir !< Number of wave directions [only used if WaveDirMod = 1] [Must be an odd number -- will be adjusted within the waves module] [(-)] - LOGICAL :: WaveMultiDir !< Indicates the waves are multidirectional -- set by HydroDyn_Input [-] - END TYPE Waves_ParameterType -! ======================= -! ========= Waves_InputType ======= - TYPE, PUBLIC :: Waves_InputType - REAL(SiKi) :: DummyInput !< Remove this variable if you have input data [-] - END TYPE Waves_InputType -! ======================= -! ========= Waves_OutputType ======= - TYPE, PUBLIC :: Waves_OutputType - REAL(SiKi) :: DummyOutput !< Remove this variable if you have output data [-] - END TYPE Waves_OutputType -! ======================= -CONTAINS - SUBROUTINE Waves_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Waves_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(Waves_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 = 'Waves_CopyInitInput' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInitInputData%InputFile = SrcInitInputData%InputFile - DstInitInputData%DirRoot = SrcInitInputData%DirRoot - DstInitInputData%WvKinFile = SrcInitInputData%WvKinFile - DstInitInputData%WriteWvKin = SrcInitInputData%WriteWvKin - DstInitInputData%UnSum = SrcInitInputData%UnSum - DstInitInputData%Gravity = SrcInitInputData%Gravity - DstInitInputData%MSL2SWL = SrcInitInputData%MSL2SWL - DstInitInputData%WvLowCOff = SrcInitInputData%WvLowCOff - DstInitInputData%WvHiCOff = SrcInitInputData%WvHiCOff - DstInitInputData%WaveDir = SrcInitInputData%WaveDir - DstInitInputData%WaveNDir = SrcInitInputData%WaveNDir - DstInitInputData%WaveMultiDir = SrcInitInputData%WaveMultiDir - DstInitInputData%WaveDirMod = SrcInitInputData%WaveDirMod - DstInitInputData%WaveDirSpread = SrcInitInputData%WaveDirSpread - DstInitInputData%WaveDirRange = SrcInitInputData%WaveDirRange - DstInitInputData%WaveDT = SrcInitInputData%WaveDT - DstInitInputData%WaveHs = SrcInitInputData%WaveHs - DstInitInputData%WaveMod = SrcInitInputData%WaveMod - DstInitInputData%WaveModChr = SrcInitInputData%WaveModChr - DstInitInputData%WaveNDAmp = SrcInitInputData%WaveNDAmp - DstInitInputData%WavePhase = SrcInitInputData%WavePhase - DstInitInputData%WavePkShp = SrcInitInputData%WavePkShp - DstInitInputData%WavePkShpChr = SrcInitInputData%WavePkShpChr - DstInitInputData%WaveSeed = SrcInitInputData%WaveSeed - DstInitInputData%WaveStMod = SrcInitInputData%WaveStMod - DstInitInputData%WaveTMax = SrcInitInputData%WaveTMax - DstInitInputData%WaveTp = SrcInitInputData%WaveTp - DstInitInputData%WtrDens = SrcInitInputData%WtrDens - DstInitInputData%WtrDpth = SrcInitInputData%WtrDpth - DstInitInputData%NWaveElev = SrcInitInputData%NWaveElev -IF (ALLOCATED(SrcInitInputData%WaveElevxi)) THEN - i1_l = LBOUND(SrcInitInputData%WaveElevxi,1) - i1_u = UBOUND(SrcInitInputData%WaveElevxi,1) - IF (.NOT. ALLOCATED(DstInitInputData%WaveElevxi)) THEN - ALLOCATE(DstInitInputData%WaveElevxi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveElevxi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%WaveElevxi = SrcInitInputData%WaveElevxi -ENDIF -IF (ALLOCATED(SrcInitInputData%WaveElevyi)) THEN - i1_l = LBOUND(SrcInitInputData%WaveElevyi,1) - i1_u = UBOUND(SrcInitInputData%WaveElevyi,1) - IF (.NOT. ALLOCATED(DstInitInputData%WaveElevyi)) THEN - ALLOCATE(DstInitInputData%WaveElevyi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveElevyi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%WaveElevyi = SrcInitInputData%WaveElevyi -ENDIF -IF (ALLOCATED(SrcInitInputData%WaveElevXY)) THEN - i1_l = LBOUND(SrcInitInputData%WaveElevXY,1) - i1_u = UBOUND(SrcInitInputData%WaveElevXY,1) - i2_l = LBOUND(SrcInitInputData%WaveElevXY,2) - i2_u = UBOUND(SrcInitInputData%WaveElevXY,2) - IF (.NOT. ALLOCATED(DstInitInputData%WaveElevXY)) THEN - ALLOCATE(DstInitInputData%WaveElevXY(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveElevXY.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%WaveElevXY = SrcInitInputData%WaveElevXY -ENDIF - DstInitInputData%PtfmLocationX = SrcInitInputData%PtfmLocationX - DstInitInputData%PtfmLocationY = SrcInitInputData%PtfmLocationY - DstInitInputData%WaveFieldMod = SrcInitInputData%WaveFieldMod - DstInitInputData%NWaveKin = SrcInitInputData%NWaveKin -IF (ALLOCATED(SrcInitInputData%WaveKinxi)) THEN - i1_l = LBOUND(SrcInitInputData%WaveKinxi,1) - i1_u = UBOUND(SrcInitInputData%WaveKinxi,1) - IF (.NOT. ALLOCATED(DstInitInputData%WaveKinxi)) THEN - ALLOCATE(DstInitInputData%WaveKinxi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveKinxi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%WaveKinxi = SrcInitInputData%WaveKinxi -ENDIF -IF (ALLOCATED(SrcInitInputData%WaveKinyi)) THEN - i1_l = LBOUND(SrcInitInputData%WaveKinyi,1) - i1_u = UBOUND(SrcInitInputData%WaveKinyi,1) - IF (.NOT. ALLOCATED(DstInitInputData%WaveKinyi)) THEN - ALLOCATE(DstInitInputData%WaveKinyi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveKinyi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%WaveKinyi = SrcInitInputData%WaveKinyi -ENDIF -IF (ALLOCATED(SrcInitInputData%WaveKinzi)) THEN - i1_l = LBOUND(SrcInitInputData%WaveKinzi,1) - i1_u = UBOUND(SrcInitInputData%WaveKinzi,1) - IF (.NOT. ALLOCATED(DstInitInputData%WaveKinzi)) THEN - ALLOCATE(DstInitInputData%WaveKinzi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveKinzi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%WaveKinzi = SrcInitInputData%WaveKinzi -ENDIF -IF (ALLOCATED(SrcInitInputData%CurrVxi)) THEN - i1_l = LBOUND(SrcInitInputData%CurrVxi,1) - i1_u = UBOUND(SrcInitInputData%CurrVxi,1) - IF (.NOT. ALLOCATED(DstInitInputData%CurrVxi)) THEN - ALLOCATE(DstInitInputData%CurrVxi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%CurrVxi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%CurrVxi = SrcInitInputData%CurrVxi -ENDIF -IF (ALLOCATED(SrcInitInputData%CurrVyi)) THEN - i1_l = LBOUND(SrcInitInputData%CurrVyi,1) - i1_u = UBOUND(SrcInitInputData%CurrVyi,1) - IF (.NOT. ALLOCATED(DstInitInputData%CurrVyi)) THEN - ALLOCATE(DstInitInputData%CurrVyi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%CurrVyi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%CurrVyi = SrcInitInputData%CurrVyi -ENDIF - DstInitInputData%PCurrVxiPz0 = SrcInitInputData%PCurrVxiPz0 - DstInitInputData%PCurrVyiPz0 = SrcInitInputData%PCurrVyiPz0 - CALL NWTC_Library_Copynwtc_randomnumber_parametertype( SrcInitInputData%RNG, DstInitInputData%RNG, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE Waves_CopyInitInput - - SUBROUTINE Waves_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(Waves_InitInputType), INTENT(INOUT) :: InitInputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves_DestroyInitInput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(InitInputData%WaveElevxi)) THEN - DEALLOCATE(InitInputData%WaveElevxi) -ENDIF -IF (ALLOCATED(InitInputData%WaveElevyi)) THEN - DEALLOCATE(InitInputData%WaveElevyi) -ENDIF -IF (ALLOCATED(InitInputData%WaveElevXY)) THEN - DEALLOCATE(InitInputData%WaveElevXY) -ENDIF -IF (ALLOCATED(InitInputData%WaveKinxi)) THEN - DEALLOCATE(InitInputData%WaveKinxi) -ENDIF -IF (ALLOCATED(InitInputData%WaveKinyi)) THEN - DEALLOCATE(InitInputData%WaveKinyi) -ENDIF -IF (ALLOCATED(InitInputData%WaveKinzi)) THEN - DEALLOCATE(InitInputData%WaveKinzi) -ENDIF -IF (ALLOCATED(InitInputData%CurrVxi)) THEN - DEALLOCATE(InitInputData%CurrVxi) -ENDIF -IF (ALLOCATED(InitInputData%CurrVyi)) THEN - DEALLOCATE(InitInputData%CurrVyi) -ENDIF - CALL NWTC_Library_Destroynwtc_randomnumber_parametertype( InitInputData%RNG, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE Waves_DestroyInitInput - - SUBROUTINE Waves_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(Waves_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 = 'Waves_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%DirRoot) ! DirRoot - Int_BufSz = Int_BufSz + 1*LEN(InData%WvKinFile) ! WvKinFile - Int_BufSz = Int_BufSz + 1 ! WriteWvKin - Int_BufSz = Int_BufSz + 1 ! UnSum - Re_BufSz = Re_BufSz + 1 ! Gravity - Re_BufSz = Re_BufSz + 1 ! MSL2SWL - Re_BufSz = Re_BufSz + 1 ! WvLowCOff - Re_BufSz = Re_BufSz + 1 ! WvHiCOff - Re_BufSz = Re_BufSz + 1 ! WaveDir - Int_BufSz = Int_BufSz + 1 ! WaveNDir - Int_BufSz = Int_BufSz + 1 ! WaveMultiDir - Int_BufSz = Int_BufSz + 1 ! WaveDirMod - Re_BufSz = Re_BufSz + 1 ! WaveDirSpread - Re_BufSz = Re_BufSz + 1 ! WaveDirRange - Db_BufSz = Db_BufSz + 1 ! WaveDT - Re_BufSz = Re_BufSz + 1 ! WaveHs - Int_BufSz = Int_BufSz + 1 ! WaveMod - Int_BufSz = Int_BufSz + 1*LEN(InData%WaveModChr) ! WaveModChr - Int_BufSz = Int_BufSz + 1 ! WaveNDAmp - Re_BufSz = Re_BufSz + 1 ! WavePhase - Re_BufSz = Re_BufSz + 1 ! WavePkShp - Int_BufSz = Int_BufSz + 1*LEN(InData%WavePkShpChr) ! WavePkShpChr - Int_BufSz = Int_BufSz + SIZE(InData%WaveSeed) ! WaveSeed - Int_BufSz = Int_BufSz + 1 ! WaveStMod - Db_BufSz = Db_BufSz + 1 ! WaveTMax - Re_BufSz = Re_BufSz + 1 ! WaveTp - Re_BufSz = Re_BufSz + 1 ! WtrDens - Re_BufSz = Re_BufSz + 1 ! WtrDpth - Int_BufSz = Int_BufSz + 1 ! NWaveElev - Int_BufSz = Int_BufSz + 1 ! WaveElevxi allocated yes/no - IF ( ALLOCATED(InData%WaveElevxi) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WaveElevxi upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveElevxi) ! WaveElevxi - END IF - Int_BufSz = Int_BufSz + 1 ! WaveElevyi allocated yes/no - IF ( ALLOCATED(InData%WaveElevyi) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WaveElevyi upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveElevyi) ! WaveElevyi - END IF - Int_BufSz = Int_BufSz + 1 ! WaveElevXY allocated yes/no - IF ( ALLOCATED(InData%WaveElevXY) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! WaveElevXY upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveElevXY) ! WaveElevXY - END IF - Re_BufSz = Re_BufSz + 1 ! PtfmLocationX - Re_BufSz = Re_BufSz + 1 ! PtfmLocationY - Int_BufSz = Int_BufSz + 1 ! WaveFieldMod - Int_BufSz = Int_BufSz + 1 ! NWaveKin - Int_BufSz = Int_BufSz + 1 ! WaveKinxi allocated yes/no - IF ( ALLOCATED(InData%WaveKinxi) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WaveKinxi upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveKinxi) ! WaveKinxi - END IF - Int_BufSz = Int_BufSz + 1 ! WaveKinyi allocated yes/no - IF ( ALLOCATED(InData%WaveKinyi) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WaveKinyi upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveKinyi) ! WaveKinyi - END IF - Int_BufSz = Int_BufSz + 1 ! WaveKinzi allocated yes/no - IF ( ALLOCATED(InData%WaveKinzi) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WaveKinzi upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveKinzi) ! WaveKinzi - END IF - Int_BufSz = Int_BufSz + 1 ! CurrVxi allocated yes/no - IF ( ALLOCATED(InData%CurrVxi) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! CurrVxi upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CurrVxi) ! CurrVxi - END IF - Int_BufSz = Int_BufSz + 1 ! CurrVyi allocated yes/no - IF ( ALLOCATED(InData%CurrVyi) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! CurrVyi upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CurrVyi) ! CurrVyi - END IF - Re_BufSz = Re_BufSz + 1 ! PCurrVxiPz0 - Re_BufSz = Re_BufSz + 1 ! PCurrVyiPz0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! RNG: size of buffers for each call to pack subtype - CALL NWTC_Library_Packnwtc_randomnumber_parametertype( Re_Buf, Db_Buf, Int_Buf, InData%RNG, ErrStat2, ErrMsg2, .TRUE. ) ! RNG - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! RNG - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! RNG - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! RNG - 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%DirRoot) - IntKiBuf(Int_Xferred) = ICHAR(InData%DirRoot(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%WvKinFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%WvKinFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = TRANSFER(InData%WriteWvKin, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%UnSum - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Gravity - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MSL2SWL - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WvLowCOff - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WvHiCOff - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WaveDir - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%WaveNDir - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%WaveMultiDir, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%WaveDirMod - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WaveDirSpread - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WaveDirRange - Re_Xferred = Re_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%WaveDT - Db_Xferred = Db_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WaveHs - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%WaveMod - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%WaveModChr) - IntKiBuf(Int_Xferred) = ICHAR(InData%WaveModChr(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = TRANSFER(InData%WaveNDAmp, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WavePhase - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WavePkShp - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(InData%WavePkShpChr) - IntKiBuf(Int_Xferred) = ICHAR(InData%WavePkShpChr(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO i1 = LBOUND(InData%WaveSeed,1), UBOUND(InData%WaveSeed,1) - IntKiBuf(Int_Xferred) = InData%WaveSeed(i1) - Int_Xferred = Int_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%WaveStMod - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%WaveTMax - Db_Xferred = Db_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WaveTp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WtrDens - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WtrDpth - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NWaveElev - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%WaveElevxi) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevxi,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevxi,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WaveElevxi,1), UBOUND(InData%WaveElevxi,1) - ReKiBuf(Re_Xferred) = InData%WaveElevxi(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveElevyi) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevyi,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevyi,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WaveElevyi,1), UBOUND(InData%WaveElevyi,1) - ReKiBuf(Re_Xferred) = InData%WaveElevyi(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveElevXY) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevXY,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevXY,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevXY,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevXY,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%WaveElevXY,2), UBOUND(InData%WaveElevXY,2) - DO i1 = LBOUND(InData%WaveElevXY,1), UBOUND(InData%WaveElevXY,1) - ReKiBuf(Re_Xferred) = InData%WaveElevXY(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - ReKiBuf(Re_Xferred) = InData%PtfmLocationX - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PtfmLocationY - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%WaveFieldMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NWaveKin - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%WaveKinxi) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveKinxi,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveKinxi,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WaveKinxi,1), UBOUND(InData%WaveKinxi,1) - ReKiBuf(Re_Xferred) = InData%WaveKinxi(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveKinyi) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveKinyi,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveKinyi,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WaveKinyi,1), UBOUND(InData%WaveKinyi,1) - ReKiBuf(Re_Xferred) = InData%WaveKinyi(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveKinzi) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveKinzi,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveKinzi,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WaveKinzi,1), UBOUND(InData%WaveKinzi,1) - ReKiBuf(Re_Xferred) = InData%WaveKinzi(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CurrVxi) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CurrVxi,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CurrVxi,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%CurrVxi,1), UBOUND(InData%CurrVxi,1) - ReKiBuf(Re_Xferred) = InData%CurrVxi(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CurrVyi) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CurrVyi,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CurrVyi,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%CurrVyi,1), UBOUND(InData%CurrVyi,1) - ReKiBuf(Re_Xferred) = InData%CurrVyi(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%PCurrVxiPz0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PCurrVyiPz0 - Re_Xferred = Re_Xferred + 1 - CALL NWTC_Library_Packnwtc_randomnumber_parametertype( Re_Buf, Db_Buf, Int_Buf, InData%RNG, ErrStat2, ErrMsg2, OnlySize ) ! RNG - 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 Waves_PackInitInput - - SUBROUTINE Waves_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(Waves_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 = 'Waves_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%DirRoot) - OutData%DirRoot(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%WvKinFile) - OutData%WvKinFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%WriteWvKin = TRANSFER(IntKiBuf(Int_Xferred), OutData%WriteWvKin) - Int_Xferred = Int_Xferred + 1 - OutData%UnSum = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%Gravity = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MSL2SWL = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%WvLowCOff = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WvHiCOff = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WaveDir = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WaveNDir = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WaveMultiDir = TRANSFER(IntKiBuf(Int_Xferred), OutData%WaveMultiDir) - Int_Xferred = Int_Xferred + 1 - OutData%WaveDirMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WaveDirSpread = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WaveDirRange = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WaveDT = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%WaveHs = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WaveMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%WaveModChr) - OutData%WaveModChr(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%WaveNDAmp = TRANSFER(IntKiBuf(Int_Xferred), OutData%WaveNDAmp) - Int_Xferred = Int_Xferred + 1 - OutData%WavePhase = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WavePkShp = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(OutData%WavePkShpChr) - OutData%WavePkShpChr(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - i1_l = LBOUND(OutData%WaveSeed,1) - i1_u = UBOUND(OutData%WaveSeed,1) - DO i1 = LBOUND(OutData%WaveSeed,1), UBOUND(OutData%WaveSeed,1) - OutData%WaveSeed(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - OutData%WaveStMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WaveTMax = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%WaveTp = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WtrDens = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WtrDpth = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%NWaveElev = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElevxi not allocated - Int_Xferred = Int_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%WaveElevxi)) DEALLOCATE(OutData%WaveElevxi) - ALLOCATE(OutData%WaveElevxi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevxi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WaveElevxi,1), UBOUND(OutData%WaveElevxi,1) - OutData%WaveElevxi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElevyi not allocated - Int_Xferred = Int_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%WaveElevyi)) DEALLOCATE(OutData%WaveElevyi) - ALLOCATE(OutData%WaveElevyi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevyi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WaveElevyi,1), UBOUND(OutData%WaveElevyi,1) - OutData%WaveElevyi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElevXY not allocated - Int_Xferred = Int_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%WaveElevXY)) DEALLOCATE(OutData%WaveElevXY) - ALLOCATE(OutData%WaveElevXY(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevXY.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%WaveElevXY,2), UBOUND(OutData%WaveElevXY,2) - DO i1 = LBOUND(OutData%WaveElevXY,1), UBOUND(OutData%WaveElevXY,1) - OutData%WaveElevXY(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%PtfmLocationX = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmLocationY = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%WaveFieldMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NWaveKin = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveKinxi not allocated - Int_Xferred = Int_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%WaveKinxi)) DEALLOCATE(OutData%WaveKinxi) - ALLOCATE(OutData%WaveKinxi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveKinxi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WaveKinxi,1), UBOUND(OutData%WaveKinxi,1) - OutData%WaveKinxi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveKinyi not allocated - Int_Xferred = Int_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%WaveKinyi)) DEALLOCATE(OutData%WaveKinyi) - ALLOCATE(OutData%WaveKinyi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveKinyi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WaveKinyi,1), UBOUND(OutData%WaveKinyi,1) - OutData%WaveKinyi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveKinzi not allocated - Int_Xferred = Int_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%WaveKinzi)) DEALLOCATE(OutData%WaveKinzi) - ALLOCATE(OutData%WaveKinzi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveKinzi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WaveKinzi,1), UBOUND(OutData%WaveKinzi,1) - OutData%WaveKinzi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CurrVxi not allocated - Int_Xferred = Int_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%CurrVxi)) DEALLOCATE(OutData%CurrVxi) - ALLOCATE(OutData%CurrVxi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CurrVxi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%CurrVxi,1), UBOUND(OutData%CurrVxi,1) - OutData%CurrVxi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CurrVyi not allocated - Int_Xferred = Int_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%CurrVyi)) DEALLOCATE(OutData%CurrVyi) - ALLOCATE(OutData%CurrVyi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CurrVyi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%CurrVyi,1), UBOUND(OutData%CurrVyi,1) - OutData%CurrVyi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%PCurrVxiPz0 = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%PCurrVyiPz0 = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_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_Unpacknwtc_randomnumber_parametertype( Re_Buf, Db_Buf, Int_Buf, OutData%RNG, ErrStat2, ErrMsg2 ) ! RNG - 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 Waves_UnPackInitInput - - SUBROUTINE Waves_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Waves_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(Waves_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) :: 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 = 'Waves_CopyInitOutput' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcInitOutputData%WaveElevC0)) THEN - i1_l = LBOUND(SrcInitOutputData%WaveElevC0,1) - i1_u = UBOUND(SrcInitOutputData%WaveElevC0,1) - i2_l = LBOUND(SrcInitOutputData%WaveElevC0,2) - i2_u = UBOUND(SrcInitOutputData%WaveElevC0,2) - IF (.NOT. ALLOCATED(DstInitOutputData%WaveElevC0)) THEN - ALLOCATE(DstInitOutputData%WaveElevC0(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveElevC0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WaveElevC0 = SrcInitOutputData%WaveElevC0 -ENDIF -IF (ALLOCATED(SrcInitOutputData%WaveDirArr)) THEN - i1_l = LBOUND(SrcInitOutputData%WaveDirArr,1) - i1_u = UBOUND(SrcInitOutputData%WaveDirArr,1) - IF (.NOT. ALLOCATED(DstInitOutputData%WaveDirArr)) THEN - ALLOCATE(DstInitOutputData%WaveDirArr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveDirArr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WaveDirArr = SrcInitOutputData%WaveDirArr -ENDIF - DstInitOutputData%WaveDirMin = SrcInitOutputData%WaveDirMin - DstInitOutputData%WaveDirMax = SrcInitOutputData%WaveDirMax - DstInitOutputData%WaveDir = SrcInitOutputData%WaveDir - DstInitOutputData%WaveNDir = SrcInitOutputData%WaveNDir - DstInitOutputData%WaveMultiDir = SrcInitOutputData%WaveMultiDir - DstInitOutputData%WaveDOmega = SrcInitOutputData%WaveDOmega -IF (ALLOCATED(SrcInitOutputData%WaveKinzi)) THEN - i1_l = LBOUND(SrcInitOutputData%WaveKinzi,1) - i1_u = UBOUND(SrcInitOutputData%WaveKinzi,1) - IF (.NOT. ALLOCATED(DstInitOutputData%WaveKinzi)) THEN - ALLOCATE(DstInitOutputData%WaveKinzi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveKinzi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WaveKinzi = SrcInitOutputData%WaveKinzi -ENDIF -IF (ALLOCATED(SrcInitOutputData%PWaveDynP0)) THEN - i1_l = LBOUND(SrcInitOutputData%PWaveDynP0,1) - i1_u = UBOUND(SrcInitOutputData%PWaveDynP0,1) - i2_l = LBOUND(SrcInitOutputData%PWaveDynP0,2) - i2_u = UBOUND(SrcInitOutputData%PWaveDynP0,2) - IF (.NOT. ALLOCATED(DstInitOutputData%PWaveDynP0)) THEN - ALLOCATE(DstInitOutputData%PWaveDynP0(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%PWaveDynP0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%PWaveDynP0 = SrcInitOutputData%PWaveDynP0 -ENDIF -IF (ALLOCATED(SrcInitOutputData%WaveDynP)) THEN - i1_l = LBOUND(SrcInitOutputData%WaveDynP,1) - i1_u = UBOUND(SrcInitOutputData%WaveDynP,1) - i2_l = LBOUND(SrcInitOutputData%WaveDynP,2) - i2_u = UBOUND(SrcInitOutputData%WaveDynP,2) - IF (.NOT. ALLOCATED(DstInitOutputData%WaveDynP)) THEN - ALLOCATE(DstInitOutputData%WaveDynP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveDynP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WaveDynP = SrcInitOutputData%WaveDynP -ENDIF -IF (ALLOCATED(SrcInitOutputData%WaveAcc)) THEN - i1_l = LBOUND(SrcInitOutputData%WaveAcc,1) - i1_u = UBOUND(SrcInitOutputData%WaveAcc,1) - i2_l = LBOUND(SrcInitOutputData%WaveAcc,2) - i2_u = UBOUND(SrcInitOutputData%WaveAcc,2) - i3_l = LBOUND(SrcInitOutputData%WaveAcc,3) - i3_u = UBOUND(SrcInitOutputData%WaveAcc,3) - IF (.NOT. ALLOCATED(DstInitOutputData%WaveAcc)) THEN - ALLOCATE(DstInitOutputData%WaveAcc(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveAcc.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WaveAcc = SrcInitOutputData%WaveAcc -ENDIF -IF (ALLOCATED(SrcInitOutputData%PWaveAcc0)) THEN - i1_l = LBOUND(SrcInitOutputData%PWaveAcc0,1) - i1_u = UBOUND(SrcInitOutputData%PWaveAcc0,1) - i2_l = LBOUND(SrcInitOutputData%PWaveAcc0,2) - i2_u = UBOUND(SrcInitOutputData%PWaveAcc0,2) - i3_l = LBOUND(SrcInitOutputData%PWaveAcc0,3) - i3_u = UBOUND(SrcInitOutputData%PWaveAcc0,3) - IF (.NOT. ALLOCATED(DstInitOutputData%PWaveAcc0)) THEN - ALLOCATE(DstInitOutputData%PWaveAcc0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%PWaveAcc0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%PWaveAcc0 = SrcInitOutputData%PWaveAcc0 -ENDIF -IF (ALLOCATED(SrcInitOutputData%WaveVel)) THEN - i1_l = LBOUND(SrcInitOutputData%WaveVel,1) - i1_u = UBOUND(SrcInitOutputData%WaveVel,1) - i2_l = LBOUND(SrcInitOutputData%WaveVel,2) - i2_u = UBOUND(SrcInitOutputData%WaveVel,2) - i3_l = LBOUND(SrcInitOutputData%WaveVel,3) - i3_u = UBOUND(SrcInitOutputData%WaveVel,3) - IF (.NOT. ALLOCATED(DstInitOutputData%WaveVel)) THEN - ALLOCATE(DstInitOutputData%WaveVel(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveVel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WaveVel = SrcInitOutputData%WaveVel -ENDIF -IF (ALLOCATED(SrcInitOutputData%PWaveVel0)) THEN - i1_l = LBOUND(SrcInitOutputData%PWaveVel0,1) - i1_u = UBOUND(SrcInitOutputData%PWaveVel0,1) - i2_l = LBOUND(SrcInitOutputData%PWaveVel0,2) - i2_u = UBOUND(SrcInitOutputData%PWaveVel0,2) - i3_l = LBOUND(SrcInitOutputData%PWaveVel0,3) - i3_u = UBOUND(SrcInitOutputData%PWaveVel0,3) - IF (.NOT. ALLOCATED(DstInitOutputData%PWaveVel0)) THEN - ALLOCATE(DstInitOutputData%PWaveVel0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%PWaveVel0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%PWaveVel0 = SrcInitOutputData%PWaveVel0 -ENDIF -IF (ALLOCATED(SrcInitOutputData%WaveElev)) THEN - i1_l = LBOUND(SrcInitOutputData%WaveElev,1) - i1_u = UBOUND(SrcInitOutputData%WaveElev,1) - i2_l = LBOUND(SrcInitOutputData%WaveElev,2) - i2_u = UBOUND(SrcInitOutputData%WaveElev,2) - IF (.NOT. ALLOCATED(DstInitOutputData%WaveElev)) THEN - ALLOCATE(DstInitOutputData%WaveElev(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveElev.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WaveElev = SrcInitOutputData%WaveElev -ENDIF -IF (ALLOCATED(SrcInitOutputData%WaveElev0)) THEN - i1_l = LBOUND(SrcInitOutputData%WaveElev0,1) - i1_u = UBOUND(SrcInitOutputData%WaveElev0,1) - IF (.NOT. ALLOCATED(DstInitOutputData%WaveElev0)) THEN - ALLOCATE(DstInitOutputData%WaveElev0(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveElev0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WaveElev0 = SrcInitOutputData%WaveElev0 -ENDIF -IF (ALLOCATED(SrcInitOutputData%WaveElevMD)) THEN - i1_l = LBOUND(SrcInitOutputData%WaveElevMD,1) - i1_u = UBOUND(SrcInitOutputData%WaveElevMD,1) - i2_l = LBOUND(SrcInitOutputData%WaveElevMD,2) - i2_u = UBOUND(SrcInitOutputData%WaveElevMD,2) - IF (.NOT. ALLOCATED(DstInitOutputData%WaveElevMD)) THEN - ALLOCATE(DstInitOutputData%WaveElevMD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveElevMD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WaveElevMD = SrcInitOutputData%WaveElevMD -ENDIF -IF (ALLOCATED(SrcInitOutputData%WaveElevSeries)) THEN - i1_l = LBOUND(SrcInitOutputData%WaveElevSeries,1) - i1_u = UBOUND(SrcInitOutputData%WaveElevSeries,1) - i2_l = LBOUND(SrcInitOutputData%WaveElevSeries,2) - i2_u = UBOUND(SrcInitOutputData%WaveElevSeries,2) - IF (.NOT. ALLOCATED(DstInitOutputData%WaveElevSeries)) THEN - ALLOCATE(DstInitOutputData%WaveElevSeries(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveElevSeries.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WaveElevSeries = SrcInitOutputData%WaveElevSeries -ENDIF -IF (ALLOCATED(SrcInitOutputData%WaveTime)) THEN - i1_l = LBOUND(SrcInitOutputData%WaveTime,1) - i1_u = UBOUND(SrcInitOutputData%WaveTime,1) - IF (.NOT. ALLOCATED(DstInitOutputData%WaveTime)) THEN - ALLOCATE(DstInitOutputData%WaveTime(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveTime.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WaveTime = SrcInitOutputData%WaveTime -ENDIF - DstInitOutputData%WaveTMax = SrcInitOutputData%WaveTMax -IF (ALLOCATED(SrcInitOutputData%nodeInWater)) THEN - i1_l = LBOUND(SrcInitOutputData%nodeInWater,1) - i1_u = UBOUND(SrcInitOutputData%nodeInWater,1) - i2_l = LBOUND(SrcInitOutputData%nodeInWater,2) - i2_u = UBOUND(SrcInitOutputData%nodeInWater,2) - IF (.NOT. ALLOCATED(DstInitOutputData%nodeInWater)) THEN - ALLOCATE(DstInitOutputData%nodeInWater(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%nodeInWater.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%nodeInWater = SrcInitOutputData%nodeInWater -ENDIF - DstInitOutputData%RhoXg = SrcInitOutputData%RhoXg - DstInitOutputData%NStepWave = SrcInitOutputData%NStepWave - DstInitOutputData%NStepWave2 = SrcInitOutputData%NStepWave2 - END SUBROUTINE Waves_CopyInitOutput - - SUBROUTINE Waves_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(Waves_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves_DestroyInitOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(InitOutputData%WaveElevC0)) THEN - DEALLOCATE(InitOutputData%WaveElevC0) -ENDIF -IF (ALLOCATED(InitOutputData%WaveDirArr)) THEN - DEALLOCATE(InitOutputData%WaveDirArr) -ENDIF -IF (ALLOCATED(InitOutputData%WaveKinzi)) THEN - DEALLOCATE(InitOutputData%WaveKinzi) -ENDIF -IF (ALLOCATED(InitOutputData%PWaveDynP0)) THEN - DEALLOCATE(InitOutputData%PWaveDynP0) -ENDIF -IF (ALLOCATED(InitOutputData%WaveDynP)) THEN - DEALLOCATE(InitOutputData%WaveDynP) -ENDIF -IF (ALLOCATED(InitOutputData%WaveAcc)) THEN - DEALLOCATE(InitOutputData%WaveAcc) -ENDIF -IF (ALLOCATED(InitOutputData%PWaveAcc0)) THEN - DEALLOCATE(InitOutputData%PWaveAcc0) -ENDIF -IF (ALLOCATED(InitOutputData%WaveVel)) THEN - DEALLOCATE(InitOutputData%WaveVel) -ENDIF -IF (ALLOCATED(InitOutputData%PWaveVel0)) THEN - DEALLOCATE(InitOutputData%PWaveVel0) -ENDIF -IF (ALLOCATED(InitOutputData%WaveElev)) THEN - DEALLOCATE(InitOutputData%WaveElev) -ENDIF -IF (ALLOCATED(InitOutputData%WaveElev0)) THEN - DEALLOCATE(InitOutputData%WaveElev0) -ENDIF -IF (ALLOCATED(InitOutputData%WaveElevMD)) THEN - DEALLOCATE(InitOutputData%WaveElevMD) -ENDIF -IF (ALLOCATED(InitOutputData%WaveElevSeries)) THEN - DEALLOCATE(InitOutputData%WaveElevSeries) -ENDIF -IF (ALLOCATED(InitOutputData%WaveTime)) THEN - DEALLOCATE(InitOutputData%WaveTime) -ENDIF -IF (ALLOCATED(InitOutputData%nodeInWater)) THEN - DEALLOCATE(InitOutputData%nodeInWater) -ENDIF - END SUBROUTINE Waves_DestroyInitOutput - - SUBROUTINE Waves_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(Waves_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 = 'Waves_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 ! WaveElevC0 allocated yes/no - IF ( ALLOCATED(InData%WaveElevC0) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! WaveElevC0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveElevC0) ! WaveElevC0 - END IF - Int_BufSz = Int_BufSz + 1 ! WaveDirArr allocated yes/no - IF ( ALLOCATED(InData%WaveDirArr) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WaveDirArr upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveDirArr) ! WaveDirArr - END IF - Re_BufSz = Re_BufSz + 1 ! WaveDirMin - Re_BufSz = Re_BufSz + 1 ! WaveDirMax - Re_BufSz = Re_BufSz + 1 ! WaveDir - Int_BufSz = Int_BufSz + 1 ! WaveNDir - Int_BufSz = Int_BufSz + 1 ! WaveMultiDir - Re_BufSz = Re_BufSz + 1 ! WaveDOmega - Int_BufSz = Int_BufSz + 1 ! WaveKinzi allocated yes/no - IF ( ALLOCATED(InData%WaveKinzi) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WaveKinzi upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveKinzi) ! WaveKinzi - END IF - Int_BufSz = Int_BufSz + 1 ! PWaveDynP0 allocated yes/no - IF ( ALLOCATED(InData%PWaveDynP0) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PWaveDynP0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PWaveDynP0) ! PWaveDynP0 - END IF - Int_BufSz = Int_BufSz + 1 ! WaveDynP allocated yes/no - IF ( ALLOCATED(InData%WaveDynP) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! WaveDynP upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveDynP) ! WaveDynP - END IF - Int_BufSz = Int_BufSz + 1 ! WaveAcc allocated yes/no - IF ( ALLOCATED(InData%WaveAcc) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! WaveAcc upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveAcc) ! WaveAcc - END IF - Int_BufSz = Int_BufSz + 1 ! PWaveAcc0 allocated yes/no - IF ( ALLOCATED(InData%PWaveAcc0) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! PWaveAcc0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PWaveAcc0) ! PWaveAcc0 - END IF - Int_BufSz = Int_BufSz + 1 ! WaveVel allocated yes/no - IF ( ALLOCATED(InData%WaveVel) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! WaveVel upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveVel) ! WaveVel - END IF - Int_BufSz = Int_BufSz + 1 ! PWaveVel0 allocated yes/no - IF ( ALLOCATED(InData%PWaveVel0) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! PWaveVel0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PWaveVel0) ! PWaveVel0 - END IF - Int_BufSz = Int_BufSz + 1 ! WaveElev allocated yes/no - IF ( ALLOCATED(InData%WaveElev) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! WaveElev upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveElev) ! WaveElev - END IF - Int_BufSz = Int_BufSz + 1 ! WaveElev0 allocated yes/no - IF ( ALLOCATED(InData%WaveElev0) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WaveElev0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveElev0) ! WaveElev0 - END IF - Int_BufSz = Int_BufSz + 1 ! WaveElevMD allocated yes/no - IF ( ALLOCATED(InData%WaveElevMD) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! WaveElevMD upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveElevMD) ! WaveElevMD - END IF - Int_BufSz = Int_BufSz + 1 ! WaveElevSeries allocated yes/no - IF ( ALLOCATED(InData%WaveElevSeries) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! WaveElevSeries upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveElevSeries) ! WaveElevSeries - END IF - Int_BufSz = Int_BufSz + 1 ! WaveTime allocated yes/no - IF ( ALLOCATED(InData%WaveTime) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WaveTime upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveTime) ! WaveTime - END IF - Db_BufSz = Db_BufSz + 1 ! WaveTMax - Int_BufSz = Int_BufSz + 1 ! nodeInWater allocated yes/no - IF ( ALLOCATED(InData%nodeInWater) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! nodeInWater upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%nodeInWater) ! nodeInWater - END IF - Re_BufSz = Re_BufSz + 1 ! RhoXg - Int_BufSz = Int_BufSz + 1 ! NStepWave - Int_BufSz = Int_BufSz + 1 ! NStepWave2 - 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%WaveElevC0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevC0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevC0,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevC0,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevC0,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%WaveElevC0,2), UBOUND(InData%WaveElevC0,2) - DO i1 = LBOUND(InData%WaveElevC0,1), UBOUND(InData%WaveElevC0,1) - ReKiBuf(Re_Xferred) = InData%WaveElevC0(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveDirArr) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveDirArr,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDirArr,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WaveDirArr,1), UBOUND(InData%WaveDirArr,1) - ReKiBuf(Re_Xferred) = InData%WaveDirArr(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%WaveDirMin - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WaveDirMax - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WaveDir - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%WaveNDir - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%WaveMultiDir, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WaveDOmega - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%WaveKinzi) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveKinzi,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveKinzi,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WaveKinzi,1), UBOUND(InData%WaveKinzi,1) - ReKiBuf(Re_Xferred) = InData%WaveKinzi(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PWaveDynP0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveDynP0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveDynP0,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveDynP0,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveDynP0,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PWaveDynP0,2), UBOUND(InData%PWaveDynP0,2) - DO i1 = LBOUND(InData%PWaveDynP0,1), UBOUND(InData%PWaveDynP0,1) - ReKiBuf(Re_Xferred) = InData%PWaveDynP0(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveDynP) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveDynP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDynP,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveDynP,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDynP,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%WaveDynP,2), UBOUND(InData%WaveDynP,2) - DO i1 = LBOUND(InData%WaveDynP,1), UBOUND(InData%WaveDynP,1) - ReKiBuf(Re_Xferred) = InData%WaveDynP(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveAcc) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%WaveAcc,3), UBOUND(InData%WaveAcc,3) - DO i2 = LBOUND(InData%WaveAcc,2), UBOUND(InData%WaveAcc,2) - DO i1 = LBOUND(InData%WaveAcc,1), UBOUND(InData%WaveAcc,1) - ReKiBuf(Re_Xferred) = InData%WaveAcc(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PWaveAcc0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveAcc0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveAcc0,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveAcc0,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveAcc0,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveAcc0,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveAcc0,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%PWaveAcc0,3), UBOUND(InData%PWaveAcc0,3) - DO i2 = LBOUND(InData%PWaveAcc0,2), UBOUND(InData%PWaveAcc0,2) - DO i1 = LBOUND(InData%PWaveAcc0,1), UBOUND(InData%PWaveAcc0,1) - ReKiBuf(Re_Xferred) = InData%PWaveAcc0(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveVel) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%WaveVel,3), UBOUND(InData%WaveVel,3) - DO i2 = LBOUND(InData%WaveVel,2), UBOUND(InData%WaveVel,2) - DO i1 = LBOUND(InData%WaveVel,1), UBOUND(InData%WaveVel,1) - ReKiBuf(Re_Xferred) = InData%WaveVel(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PWaveVel0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveVel0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveVel0,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveVel0,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveVel0,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveVel0,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveVel0,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%PWaveVel0,3), UBOUND(InData%PWaveVel0,3) - DO i2 = LBOUND(InData%PWaveVel0,2), UBOUND(InData%PWaveVel0,2) - DO i1 = LBOUND(InData%PWaveVel0,1), UBOUND(InData%PWaveVel0,1) - ReKiBuf(Re_Xferred) = InData%PWaveVel0(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveElev) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%WaveElev,2), UBOUND(InData%WaveElev,2) - DO i1 = LBOUND(InData%WaveElev,1), UBOUND(InData%WaveElev,1) - ReKiBuf(Re_Xferred) = InData%WaveElev(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveElev0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev0,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WaveElev0,1), UBOUND(InData%WaveElev0,1) - ReKiBuf(Re_Xferred) = InData%WaveElev0(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveElevMD) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevMD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevMD,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevMD,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevMD,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%WaveElevMD,2), UBOUND(InData%WaveElevMD,2) - DO i1 = LBOUND(InData%WaveElevMD,1), UBOUND(InData%WaveElevMD,1) - ReKiBuf(Re_Xferred) = InData%WaveElevMD(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveElevSeries) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevSeries,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevSeries,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevSeries,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevSeries,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%WaveElevSeries,2), UBOUND(InData%WaveElevSeries,2) - DO i1 = LBOUND(InData%WaveElevSeries,1), UBOUND(InData%WaveElevSeries,1) - ReKiBuf(Re_Xferred) = InData%WaveElevSeries(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveTime) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveTime,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveTime,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WaveTime,1), UBOUND(InData%WaveTime,1) - ReKiBuf(Re_Xferred) = InData%WaveTime(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - DbKiBuf(Db_Xferred) = InData%WaveTMax - Db_Xferred = Db_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%nodeInWater) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%nodeInWater,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%nodeInWater,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%nodeInWater,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%nodeInWater,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%nodeInWater,2), UBOUND(InData%nodeInWater,2) - DO i1 = LBOUND(InData%nodeInWater,1), UBOUND(InData%nodeInWater,1) - IntKiBuf(Int_Xferred) = InData%nodeInWater(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - ReKiBuf(Re_Xferred) = InData%RhoXg - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NStepWave - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NStepWave2 - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Waves_PackInitOutput - - SUBROUTINE Waves_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(Waves_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) :: 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 = 'Waves_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 ! WaveElevC0 not allocated - Int_Xferred = Int_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%WaveElevC0)) DEALLOCATE(OutData%WaveElevC0) - ALLOCATE(OutData%WaveElevC0(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevC0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%WaveElevC0,2), UBOUND(OutData%WaveElevC0,2) - DO i1 = LBOUND(OutData%WaveElevC0,1), UBOUND(OutData%WaveElevC0,1) - OutData%WaveElevC0(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveDirArr not allocated - Int_Xferred = Int_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%WaveDirArr)) DEALLOCATE(OutData%WaveDirArr) - ALLOCATE(OutData%WaveDirArr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDirArr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WaveDirArr,1), UBOUND(OutData%WaveDirArr,1) - OutData%WaveDirArr(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%WaveDirMin = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WaveDirMax = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WaveDir = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WaveNDir = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WaveMultiDir = TRANSFER(IntKiBuf(Int_Xferred), OutData%WaveMultiDir) - Int_Xferred = Int_Xferred + 1 - OutData%WaveDOmega = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveKinzi not allocated - Int_Xferred = Int_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%WaveKinzi)) DEALLOCATE(OutData%WaveKinzi) - ALLOCATE(OutData%WaveKinzi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveKinzi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WaveKinzi,1), UBOUND(OutData%WaveKinzi,1) - OutData%WaveKinzi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PWaveDynP0 not allocated - Int_Xferred = Int_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%PWaveDynP0)) DEALLOCATE(OutData%PWaveDynP0) - ALLOCATE(OutData%PWaveDynP0(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PWaveDynP0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PWaveDynP0,2), UBOUND(OutData%PWaveDynP0,2) - DO i1 = LBOUND(OutData%PWaveDynP0,1), UBOUND(OutData%PWaveDynP0,1) - OutData%PWaveDynP0(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveDynP not allocated - Int_Xferred = Int_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%WaveDynP)) DEALLOCATE(OutData%WaveDynP) - ALLOCATE(OutData%WaveDynP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDynP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%WaveDynP,2), UBOUND(OutData%WaveDynP,2) - DO i1 = LBOUND(OutData%WaveDynP,1), UBOUND(OutData%WaveDynP,1) - OutData%WaveDynP(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveAcc not allocated - Int_Xferred = Int_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%WaveAcc)) DEALLOCATE(OutData%WaveAcc) - ALLOCATE(OutData%WaveAcc(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%WaveAcc.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%WaveAcc,3), UBOUND(OutData%WaveAcc,3) - DO i2 = LBOUND(OutData%WaveAcc,2), UBOUND(OutData%WaveAcc,2) - DO i1 = LBOUND(OutData%WaveAcc,1), UBOUND(OutData%WaveAcc,1) - OutData%WaveAcc(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PWaveAcc0 not allocated - Int_Xferred = Int_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%PWaveAcc0)) DEALLOCATE(OutData%PWaveAcc0) - ALLOCATE(OutData%PWaveAcc0(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%PWaveAcc0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%PWaveAcc0,3), UBOUND(OutData%PWaveAcc0,3) - DO i2 = LBOUND(OutData%PWaveAcc0,2), UBOUND(OutData%PWaveAcc0,2) - DO i1 = LBOUND(OutData%PWaveAcc0,1), UBOUND(OutData%PWaveAcc0,1) - OutData%PWaveAcc0(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveVel not allocated - Int_Xferred = Int_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%WaveVel)) DEALLOCATE(OutData%WaveVel) - ALLOCATE(OutData%WaveVel(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%WaveVel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%WaveVel,3), UBOUND(OutData%WaveVel,3) - DO i2 = LBOUND(OutData%WaveVel,2), UBOUND(OutData%WaveVel,2) - DO i1 = LBOUND(OutData%WaveVel,1), UBOUND(OutData%WaveVel,1) - OutData%WaveVel(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PWaveVel0 not allocated - Int_Xferred = Int_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%PWaveVel0)) DEALLOCATE(OutData%PWaveVel0) - ALLOCATE(OutData%PWaveVel0(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%PWaveVel0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%PWaveVel0,3), UBOUND(OutData%PWaveVel0,3) - DO i2 = LBOUND(OutData%PWaveVel0,2), UBOUND(OutData%PWaveVel0,2) - DO i1 = LBOUND(OutData%PWaveVel0,1), UBOUND(OutData%PWaveVel0,1) - OutData%PWaveVel0(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElev not allocated - Int_Xferred = Int_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%WaveElev)) DEALLOCATE(OutData%WaveElev) - ALLOCATE(OutData%WaveElev(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%WaveElev,2), UBOUND(OutData%WaveElev,2) - DO i1 = LBOUND(OutData%WaveElev,1), UBOUND(OutData%WaveElev,1) - OutData%WaveElev(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElev0 not allocated - Int_Xferred = Int_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%WaveElev0)) DEALLOCATE(OutData%WaveElev0) - ALLOCATE(OutData%WaveElev0(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WaveElev0,1), UBOUND(OutData%WaveElev0,1) - OutData%WaveElev0(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElevMD not allocated - Int_Xferred = Int_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%WaveElevMD)) DEALLOCATE(OutData%WaveElevMD) - ALLOCATE(OutData%WaveElevMD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevMD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%WaveElevMD,2), UBOUND(OutData%WaveElevMD,2) - DO i1 = LBOUND(OutData%WaveElevMD,1), UBOUND(OutData%WaveElevMD,1) - OutData%WaveElevMD(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElevSeries not allocated - Int_Xferred = Int_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%WaveElevSeries)) DEALLOCATE(OutData%WaveElevSeries) - ALLOCATE(OutData%WaveElevSeries(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevSeries.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%WaveElevSeries,2), UBOUND(OutData%WaveElevSeries,2) - DO i1 = LBOUND(OutData%WaveElevSeries,1), UBOUND(OutData%WaveElevSeries,1) - OutData%WaveElevSeries(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveTime not allocated - Int_Xferred = Int_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%WaveTime)) DEALLOCATE(OutData%WaveTime) - ALLOCATE(OutData%WaveTime(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveTime.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WaveTime,1), UBOUND(OutData%WaveTime,1) - OutData%WaveTime(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%WaveTMax = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! nodeInWater not allocated - Int_Xferred = Int_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%nodeInWater)) DEALLOCATE(OutData%nodeInWater) - ALLOCATE(OutData%nodeInWater(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%nodeInWater.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%nodeInWater,2), UBOUND(OutData%nodeInWater,2) - DO i1 = LBOUND(OutData%nodeInWater,1), UBOUND(OutData%nodeInWater,1) - OutData%nodeInWater(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - OutData%RhoXg = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%NStepWave = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NStepWave2 = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Waves_UnPackInitOutput - - SUBROUTINE Waves_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Waves_ContinuousStateType), INTENT(IN) :: SrcContStateData - TYPE(Waves_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 = 'Waves_CopyContState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstContStateData%DummyContState = SrcContStateData%DummyContState - END SUBROUTINE Waves_CopyContState - - SUBROUTINE Waves_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(Waves_ContinuousStateType), INTENT(INOUT) :: ContStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves_DestroyContState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE Waves_DestroyContState - - SUBROUTINE Waves_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(Waves_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 = 'Waves_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 Waves_PackContState - - SUBROUTINE Waves_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(Waves_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 = 'Waves_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 = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Waves_UnPackContState - - SUBROUTINE Waves_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Waves_DiscreteStateType), INTENT(IN) :: SrcDiscStateData - TYPE(Waves_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 = 'Waves_CopyDiscState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstDiscStateData%DummyDiscState = SrcDiscStateData%DummyDiscState - END SUBROUTINE Waves_CopyDiscState - - SUBROUTINE Waves_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(Waves_DiscreteStateType), INTENT(INOUT) :: DiscStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves_DestroyDiscState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE Waves_DestroyDiscState - - SUBROUTINE Waves_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(Waves_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 = 'Waves_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 Waves_PackDiscState - - SUBROUTINE Waves_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(Waves_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 = 'Waves_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 = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Waves_UnPackDiscState - - SUBROUTINE Waves_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Waves_ConstraintStateType), INTENT(IN) :: SrcConstrStateData - TYPE(Waves_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 = 'Waves_CopyConstrState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState - END SUBROUTINE Waves_CopyConstrState - - SUBROUTINE Waves_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(Waves_ConstraintStateType), INTENT(INOUT) :: ConstrStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves_DestroyConstrState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE Waves_DestroyConstrState - - SUBROUTINE Waves_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(Waves_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 = 'Waves_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 Waves_PackConstrState - - SUBROUTINE Waves_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(Waves_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 = 'Waves_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 = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Waves_UnPackConstrState - - SUBROUTINE Waves_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Waves_OtherStateType), INTENT(IN) :: SrcOtherStateData - TYPE(Waves_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 = 'Waves_CopyOtherState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstOtherStateData%DummyOtherState = SrcOtherStateData%DummyOtherState - END SUBROUTINE Waves_CopyOtherState - - SUBROUTINE Waves_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(Waves_OtherStateType), INTENT(INOUT) :: OtherStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves_DestroyOtherState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE Waves_DestroyOtherState - - SUBROUTINE Waves_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(Waves_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 = 'Waves_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) = InData%DummyOtherState - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Waves_PackOtherState - - SUBROUTINE Waves_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(Waves_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 = 'Waves_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 Waves_UnPackOtherState - - SUBROUTINE Waves_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Waves_MiscVarType), INTENT(IN) :: SrcMiscData - TYPE(Waves_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 = 'Waves_CopyMisc' -! - ErrStat = ErrID_None - ErrMsg = "" - DstMiscData%DummyMiscVar = SrcMiscData%DummyMiscVar - END SUBROUTINE Waves_CopyMisc - - SUBROUTINE Waves_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(Waves_MiscVarType), INTENT(INOUT) :: MiscData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves_DestroyMisc' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE Waves_DestroyMisc - - SUBROUTINE Waves_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(Waves_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 = 'Waves_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 ! 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 - - IntKiBuf(Int_Xferred) = InData%DummyMiscVar - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Waves_PackMisc - - SUBROUTINE Waves_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(Waves_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 = 'Waves_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 = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Waves_UnPackMisc - - SUBROUTINE Waves_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Waves_ParameterType), INTENT(IN) :: SrcParamData - TYPE(Waves_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 = 'Waves_CopyParam' -! - ErrStat = ErrID_None - ErrMsg = "" - DstParamData%DT = SrcParamData%DT - DstParamData%WaveTMax = SrcParamData%WaveTMax - DstParamData%NStepWave = SrcParamData%NStepWave - DstParamData%WaveNDir = SrcParamData%WaveNDir - DstParamData%WaveMultiDir = SrcParamData%WaveMultiDir - END SUBROUTINE Waves_CopyParam - - SUBROUTINE Waves_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(Waves_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE Waves_DestroyParam - - SUBROUTINE Waves_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(Waves_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 = 'Waves_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 ! WaveTMax - Int_BufSz = Int_BufSz + 1 ! NStepWave - Int_BufSz = Int_BufSz + 1 ! WaveNDir - Int_BufSz = Int_BufSz + 1 ! WaveMultiDir - 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%WaveTMax - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NStepWave - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%WaveNDir - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%WaveMultiDir, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Waves_PackParam - - SUBROUTINE Waves_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(Waves_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 = 'Waves_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%WaveTMax = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%NStepWave = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WaveNDir = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WaveMultiDir = TRANSFER(IntKiBuf(Int_Xferred), OutData%WaveMultiDir) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Waves_UnPackParam - - SUBROUTINE Waves_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Waves_InputType), INTENT(IN) :: SrcInputData - TYPE(Waves_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 = 'Waves_CopyInput' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInputData%DummyInput = SrcInputData%DummyInput - END SUBROUTINE Waves_CopyInput - - SUBROUTINE Waves_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(Waves_InputType), INTENT(INOUT) :: InputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves_DestroyInput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE Waves_DestroyInput - - SUBROUTINE Waves_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(Waves_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 = 'Waves_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) = InData%DummyInput - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Waves_PackInput - - SUBROUTINE Waves_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(Waves_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 = 'Waves_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 = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Waves_UnPackInput - - SUBROUTINE Waves_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Waves_OutputType), INTENT(IN) :: SrcOutputData - TYPE(Waves_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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves_CopyOutput' -! - ErrStat = ErrID_None - ErrMsg = "" - DstOutputData%DummyOutput = SrcOutputData%DummyOutput - END SUBROUTINE Waves_CopyOutput - - SUBROUTINE Waves_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(Waves_OutputType), INTENT(INOUT) :: OutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves_DestroyOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE Waves_DestroyOutput - - SUBROUTINE Waves_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(Waves_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 = 'Waves_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 - 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%DummyOutput - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Waves_PackOutput - - SUBROUTINE Waves_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(Waves_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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves_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 = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Waves_UnPackOutput - - - SUBROUTINE Waves_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(Waves_InputType), INTENT(IN) :: u(:) ! Input at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Inputs - TYPE(Waves_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 = 'Waves_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 Waves_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL Waves_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 Waves_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 Waves_Input_ExtrapInterp - - - SUBROUTINE Waves_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(Waves_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 - TYPE(Waves_InputType), INTENT(IN) :: u2 ! Input at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs - TYPE(Waves_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 = 'Waves_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) - b = -(u1%DummyInput - u2%DummyInput) - u_out%DummyInput = u1%DummyInput + b * ScaleFactor - END SUBROUTINE Waves_Input_ExtrapInterp1 - - - SUBROUTINE Waves_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(Waves_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 > t3 - TYPE(Waves_InputType), INTENT(IN) :: u2 ! Input at t2 > t3 - TYPE(Waves_InputType), INTENT(IN) :: u3 ! Input at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs - TYPE(Waves_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 = 'Waves_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))) - b = (t(3)**2*(u1%DummyInput - u2%DummyInput) + t(2)**2*(-u1%DummyInput + u3%DummyInput))* scaleFactor - c = ( (t(2)-t(3))*u1%DummyInput + t(3)*u2%DummyInput - t(2)*u3%DummyInput ) * scaleFactor - u_out%DummyInput = u1%DummyInput + b + c * t_out - END SUBROUTINE Waves_Input_ExtrapInterp2 - - - SUBROUTINE Waves_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(Waves_OutputType), INTENT(IN) :: y(:) ! Output at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Outputs - TYPE(Waves_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 = 'Waves_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 Waves_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL Waves_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 Waves_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 Waves_Output_ExtrapInterp - - - SUBROUTINE Waves_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(Waves_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 - TYPE(Waves_OutputType), INTENT(IN) :: y2 ! Output at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs - TYPE(Waves_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 = 'Waves_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 - ! 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) - b = -(y1%DummyOutput - y2%DummyOutput) - y_out%DummyOutput = y1%DummyOutput + b * ScaleFactor - END SUBROUTINE Waves_Output_ExtrapInterp1 - - - SUBROUTINE Waves_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(Waves_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 > t3 - TYPE(Waves_OutputType), INTENT(IN) :: y2 ! Output at t2 > t3 - TYPE(Waves_OutputType), INTENT(IN) :: y3 ! Output at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs - TYPE(Waves_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 = 'Waves_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 - - ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) - b = (t(3)**2*(y1%DummyOutput - y2%DummyOutput) + t(2)**2*(-y1%DummyOutput + y3%DummyOutput))* scaleFactor - c = ( (t(2)-t(3))*y1%DummyOutput + t(3)*y2%DummyOutput - t(2)*y3%DummyOutput ) * scaleFactor - y_out%DummyOutput = y1%DummyOutput + b + c * t_out - END SUBROUTINE Waves_Output_ExtrapInterp2 - -END MODULE Waves_Types -!ENDOFREGISTRYGENERATEDFILE diff --git a/modules/hydrodyn/src/YawOffset.f90 b/modules/hydrodyn/src/YawOffset.f90 new file mode 100644 index 0000000000..aeb78d8665 --- /dev/null +++ b/modules/hydrodyn/src/YawOffset.f90 @@ -0,0 +1,269 @@ +MODULE YawOffset + +USE NWTC_LIBRARY + +IMPLICIT NONE + +INTEGER(IntKi), PARAMETER :: i2h = 1_IntKi +INTEGER(IntKi), PARAMETER :: h2i = 2_IntKi + +INTERFACE hiFrameTransform + MODULE PROCEDURE hiFrameTransformVec3R8 + MODULE PROCEDURE hiFrameTransformVec3R4 + MODULE PROCEDURE hiFrameTransformMat +END INTERFACE hiFrameTransform + +INTERFACE GetRotAngs + MODULE PROCEDURE GetRotAngsR + MODULE PROCEDURE GetRotAngsD +END INTERFACE GetRotAngs + +INTERFACE WrapToPi ! See NWTC_Num.f90:: mpi2pi() + MODULE PROCEDURE WrapToPiR + MODULE PROCEDURE WrapToPiD +END INTERFACE WrapToPi + +INTERFACE WrapTo180 + MODULE PROCEDURE WrapTo180R + MODULE PROCEDURE WrapTo180D +END INTERFACE WrapTo180 + +CONTAINS + +SUBROUTINE GetPtfmRefYOrient(PtfmRefY, Orient, ErrStat, ErrMsg) + + REAL(ReKi), INTENT(IN ) :: PtfmRefY + REAL(ReKi), INTENT( OUT) :: Orient(3,3) + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + + REAL(ReKi) :: cosRefY + REAL(ReKi) :: sinRefY + + ErrStat = ErrID_None + ErrMsg = '' + + call Eye(Orient, ErrStat, ErrMsg) + cosRefY = cos(PtfmRefY) + sinRefY = sin(PtfmRefY) + Orient(1,1) = cosRefY + Orient(1,2) = sinRefY + Orient(2,1) = -sinRefY + Orient(2,2) = cosRefY + +END SUBROUTINE GetPtfmRefYOrient + +SUBROUTINE RotTrans(RotationType,PtfmRefY,Rotation,Orientation,ErrTxt,ErrStat,ErrMsg) + ! Compute the orientation matrix with potentially large reference yaw offset + ! This subroutine essentially extends SmllRotTrans to accommodate a large yaw offset + CHARACTER(*), INTENT(IN ) :: RotationType + REAL(ReKi), INTENT(IN ) :: PtfmRefY + REAL(R8Ki), INTENT(IN ) :: Rotation(3) + REAL(R8Ki), INTENT( OUT) :: Orientation(3,3) + CHARACTER(*), INTENT(IN ) :: ErrTxt + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + + REAL(ReKi) :: PtfmRefYOrient(3,3) + REAL(R8Ki) :: SmllOMat(3,3) + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'RotTrans' + + ErrStat = ErrID_None + ErrMsg = '' + + ! Orientation matrix associated with large reference yaw offset + call GetPtfmRefYOrient(PtfmRefY, PtfmRefYOrient, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + ! Orientation matrix for the remaining small rotation from the large reference yaw offset + call SmllRotTrans( RotationType, Rotation(1), Rotation(2), Rotation(3)-REAL(PtfmRefY,R8Ki), SmllOMat, ErrTxt, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + ! Combine the contributions + Orientation = matmul(SmllOMat,PtfmRefYOrient) + +END SUBROUTINE RotTrans + + +FUNCTION GetRotAngsR(PtfmRefY, DCMat, ErrStat, ErrMsg) + ! Compute the intrinsic Tait-Bryan angles (yaw first, pitch second, roll last) based on large yaw offset + ! The subroutine essentially extends GetSmllRotAngs to accommodate a large yaw offset + REAL(ReKi), INTENT(IN ) :: PtfmRefY + REAL(SiKi), INTENT(IN ) :: DCMat(3,3) + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + + REAL(SiKi) :: GetRotAngsR( 3 ) + + REAL(ReKi) :: PtfmRefYOrient(3,3) + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'GetRotAngs' + + ErrStat = ErrID_None + ErrMsg = '' + + ! Orientation matrix associated with large reference yaw offset + call GetPtfmRefYOrient(PtfmRefY, PtfmRefYOrient, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + GetRotAngsR = GetSmllRotAngsR ( matmul(DCMat,transpose(REAL(PtfmRefYOrient,SiKi))), ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + GetRotAngsR(3) = GetRotAngsR(3) + PtfmRefY + +END FUNCTION GetRotAngsR + +FUNCTION GetRotAngsD(PtfmRefY, DCMat, ErrStat, ErrMsg) + ! Compute the intrinsic Tait-Bryan angles (yaw first, pitch second, roll last) based on large yaw offset + ! The subroutine essentially extends GetSmllRotAngs to accommodate a large yaw offset + REAL(ReKi), INTENT(IN ) :: PtfmRefY + REAL(DbKi), INTENT(IN ) :: DCMat(3,3) + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + + REAL(DbKi) :: GetRotAngsD( 3 ) + + REAL(ReKi) :: PtfmRefYOrient(3,3) + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'GetRotAngs' + + ErrStat = ErrID_None + ErrMsg = '' + + ! Orientation matrix associated with large reference yaw offset + call GetPtfmRefYOrient(PtfmRefY, PtfmRefYOrient, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + GetRotAngsD = GetSmllRotAngsD ( matmul(DCMat,transpose(REAL(PtfmRefYOrient,DbKi))), ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + GetRotAngsD(3) = GetRotAngsD(3) + PtfmRefY + +END FUNCTION GetRotAngsD + + +SUBROUTINE hiFrameTransformVec3R8(Mode,PtfmRefY,VecIn,VecOut,ErrStat,ErrMsg) + INTEGER(IntKi), INTENT(IN ) :: Mode + REAL(ReKi), INTENT(IN ) :: PtfmRefY + REAL(R8Ki), INTENT(IN ) :: VecIn(3) + REAL(R8Ki), INTENT( OUT) :: VecOut(3) + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + + REAL(ReKi) :: PtfmRefYOrient(3,3) + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + + CHARACTER(*), PARAMETER :: RoutineName = 'hiFrameTransformVec3' + + ErrStat = ErrID_None + ErrMsg = '' + + call GetPtfmRefYOrient(PtfmRefY, PtfmRefYOrient, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + if (Mode .EQ. i2h) then ! i-frame to h-frame + VecOut = matmul(PtfmRefYOrient,VecIn) + else if (Mode .EQ. h2i) then ! h-frame to i-frame + VecOut = matmul(transpose(PtfmRefYOrient),VecIn) + else + call SetErrStat(ErrID_Fatal, "Mode must be 1 or 2", ErrStat, ErrMsg, RoutineName) + end if + +END SUBROUTINE hiFrameTransformVec3R8 + +SUBROUTINE hiFrameTransformVec3R4(Mode,PtfmRefY,VecIn,VecOut,ErrStat,ErrMsg) + INTEGER(IntKi), INTENT(IN ) :: Mode + REAL(ReKi), INTENT(IN ) :: PtfmRefY + REAL(SiKi), INTENT(IN ) :: VecIn(3) + REAL(SiKi), INTENT( OUT) :: VecOut(3) + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + + REAL(ReKi) :: PtfmRefYOrient(3,3) + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + + CHARACTER(*), PARAMETER :: RoutineName = 'hiFrameTransformVec3' + + ErrStat = ErrID_None + ErrMsg = '' + + call GetPtfmRefYOrient(PtfmRefY, PtfmRefYOrient, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + if (Mode .EQ. i2h) then ! i-frame to h-frame + VecOut = matmul(PtfmRefYOrient,VecIn) + else if (Mode .EQ. h2i) then ! h-frame to i-frame + VecOut = matmul(transpose(PtfmRefYOrient),VecIn) + else + call SetErrStat(ErrID_Fatal, "Mode must be 1 or 2", ErrStat, ErrMsg, RoutineName) + end if + +END SUBROUTINE hiFrameTransformVec3R4 + +SUBROUTINE hiFrameTransformMat(Mode,PtfmRefY,MatIn,MatOut,ErrStat,ErrMsg) + INTEGER(IntKi), INTENT(IN ) :: Mode + REAL(ReKi), INTENT(IN ) :: PtfmRefY + REAL(ReKi), INTENT(IN ) :: MatIn(3,3) + REAL(ReKi), INTENT( OUT) :: MatOut(3,3) + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + + REAL(ReKi) :: PtfmRefYOrient(3,3) + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + + CHARACTER(*), PARAMETER :: RoutineName = 'hiFrameTransformMat' + + ErrStat = ErrID_None + ErrMsg = '' + + call GetPtfmRefYOrient(PtfmRefY, PtfmRefYOrient, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + if (Mode .EQ. i2h) then ! i-frame to h-frame + MatOut = matmul(matmul(PtfmRefYOrient,MatIn),transpose(PtfmRefYOrient)) + else if (Mode .EQ. h2i) then ! h-frame to i-frame + MatOut = matmul(matmul(transpose(PtfmRefYOrient),MatIn),PtfmRefYOrient) + else + call SetErrStat(ErrID_Fatal, "Mode must be 1 or 2", ErrStat, ErrMsg, RoutineName) + end if + +END SUBROUTINE hiFrameTransformMat + +FUNCTION WrapTo180R(angle) + + REAL(SiKi), INTENT(IN) :: angle + REAL(SiKi) :: WrapTo180R + WrapTo180R = modulo(angle + 180.0_SiKi, 360.0_SiKi) - 180.0_SiKi + +END FUNCTION WrapTo180R + +FUNCTION WrapTo180D(angle) + + REAL(R8Ki), INTENT(IN) :: angle + REAL(R8Ki) :: WrapTo180D + WrapTo180D = modulo(angle + 180.0_R8Ki, 360.0_R8Ki) - 180.0_R8Ki + +END FUNCTION WrapTo180D + +FUNCTION WrapToPiR(angle) + + REAL(SiKi), INTENT(IN) :: angle + REAL(SiKi) :: WrapToPiR + WrapToPiR = modulo(angle + Pi_R4, TwoPi_R4) - Pi_R4 + +END FUNCTION WrapToPiR + +FUNCTION WrapToPiD(angle) + + REAL(R8Ki), INTENT(IN) :: angle + REAL(R8Ki) :: WrapToPiD + WrapToPiD = modulo(angle + Pi_R8, TwoPi_R8) - Pi_R8 + +END FUNCTION WrapToPiD + +END MODULE YawOffset \ No newline at end of file diff --git a/modules/icedyn/CMakeLists.txt b/modules/icedyn/CMakeLists.txt index 77f4d42949..cfbd2e9d72 100644 --- a/modules/icedyn/CMakeLists.txt +++ b/modules/icedyn/CMakeLists.txt @@ -18,7 +18,7 @@ if (GENERATE_TYPES) generate_f90_types(src/Registry_IceDyn.txt ${CMAKE_CURRENT_LIST_DIR}/src/IceDyn_Types.f90) endif() -add_library(icedynlib +add_library(icedynlib STATIC src/IceDyn.f90 src/IceDyn_Types.f90 ) diff --git a/modules/icedyn/src/IceDyn_Types.f90 b/modules/icedyn/src/IceDyn_Types.f90 index f3c98e47c4..30d8c26097 100644 --- a/modules/icedyn/src/IceDyn_Types.f90 +++ b/modules/icedyn/src/IceDyn_Types.f90 @@ -35,182 +35,182 @@ MODULE IceDyn_Types IMPLICIT NONE ! ========= IceD_InputFile ======= TYPE, PUBLIC :: IceD_InputFile - INTEGER(IntKi) :: IceModel !< The current ice model number [-] - INTEGER(IntKi) :: IceSubModel !< The current ice sub-model number [-] - REAL(ReKi) :: h !< Ice thickness [m] - REAL(ReKi) :: v !< Ice velocity [m/s] - REAL(ReKi) :: InitLoc !< Ice sheet initial location [m] - REAL(ReKi) :: t0 !< Ice load starting time [s] - REAL(ReKi) :: rhow !< Water mass density [kg/m^3] - REAL(ReKi) :: rhoi !< Ice mass density [kg/m^3] - INTEGER(IntKi) :: Seed1 !< Random seed 1 [-] - INTEGER(IntKi) :: Seed2 !< Random seed 2 [-] - INTEGER(IntKi) :: NumLegs !< Number of support structure legs in ice [-] + INTEGER(IntKi) :: IceModel = 0_IntKi !< The current ice model number [-] + INTEGER(IntKi) :: IceSubModel = 0_IntKi !< The current ice sub-model number [-] + REAL(ReKi) :: h = 0.0_ReKi !< Ice thickness [m] + REAL(ReKi) :: v = 0.0_ReKi !< Ice velocity [m/s] + REAL(ReKi) :: InitLoc = 0.0_ReKi !< Ice sheet initial location [m] + REAL(ReKi) :: t0 = 0.0_ReKi !< Ice load starting time [s] + REAL(ReKi) :: rhow = 0.0_ReKi !< Water mass density [kg/m^3] + REAL(ReKi) :: rhoi = 0.0_ReKi !< Ice mass density [kg/m^3] + INTEGER(IntKi) :: Seed1 = 0_IntKi !< Random seed 1 [-] + INTEGER(IntKi) :: Seed2 = 0_IntKi !< Random seed 2 [-] + INTEGER(IntKi) :: NumLegs = 0_IntKi !< Number of support structure legs in ice [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: LegPosX !< global X position of legs 1-NumLegs [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: LegPosY !< global Y position of legs 1-NumLegs [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: StrWd !< The width of the leg (structure) [m] - REAL(ReKi) :: Ikm !< Indentation factor [-] - REAL(ReKi) :: Ag !< Ice crystal type factor [MPa^-3s^-1] - REAL(ReKi) :: Qg !< Activation energy [kJ] - REAL(ReKi) :: Rg !< Universal gas constant [J] - REAL(ReKi) :: Tice !< Ice temperature [K] - REAL(ReKi) :: nu !< Poison ratio of ice [-] - REAL(ReKi) :: phi !< Ice wedge angle [degree] - REAL(ReKi) :: SigNm !< Nominal ice strength [MPa] - REAL(ReKi) :: Eice !< Elastic modulus of ice [GPa] - REAL(ReKi) :: IceStr2 !< Ice tooth brittle strength [MPa] - REAL(ReKi) :: Delmax2 !< Ice tooth maximum elastic deformation for model 2 [m] - REAL(ReKi) :: Pitch !< Distance between sequential ice teeth for model 2 [m] - REAL(ReKi) :: miuh !< Mean value of random ice thickness [m] - REAL(ReKi) :: varh !< Variance of random ice thicknesss [m^2] - REAL(ReKi) :: miuv !< Mean value of random ice velocity [m/s] - REAL(ReKi) :: varv !< Variance of random ice velocity [m^2/s^2] - REAL(ReKi) :: miut !< Mean value of ice loading event duration time [s] - REAL(ReKi) :: miubr !< Mean value of random ice brittle strength [MPa] - REAL(ReKi) :: varbr !< Variance of random ice brittle strength [MPa^2] - REAL(ReKi) :: miuDelm !< Mean value of random random maximum ice tooth tip displacement [MPa] - REAL(ReKi) :: varDelm !< Variance of random random maximum ice tooth tip displacement [MPa^2] - REAL(ReKi) :: miuP !< Mean value of random distance between sequential ice teeth [m] - REAL(ReKi) :: varP !< Variance of random distance between sequential ice teeth [m^2] - INTEGER(IntKi) :: Zn1 !< Number of failure zones along contact width [-] - INTEGER(IntKi) :: Zn2 !< Number of failure zones along contact height/thickness [-] - REAL(ReKi) :: ZonePitch !< Distance between sequential ice teeth [m] - REAL(ReKi) :: PrflMean !< Ice structure contact profile mean value [m] - REAL(ReKi) :: PrflSig !< Ice structure contact profile standard deviation [m] - REAL(ReKi) :: IceStr !< Ice failure strength [MPa] - REAL(ReKi) :: Delmax !< Ice teeth maximum elastic deformation [m] - REAL(ReKi) :: alpha !< slope angle of the cone [degree] - REAL(ReKi) :: Dwl !< cone waterline diameter [m] - REAL(ReKi) :: Dtp !< cone top diameter [m] - REAL(ReKi) :: hr !< ride-up ice thickness [m] - REAL(ReKi) :: mu !< friction coefficient between structure and ice [-] - REAL(ReKi) :: sigf !< flexural strength of ice [MPa] - REAL(ReKi) :: StrLim !< limit strain [-] - REAL(ReKi) :: StrRtLim !< limit strain rate [s^-1] - INTEGER(IntKi) :: UorD !< flag that indicates upward or downward breaking cone: 0,upward, 1,downward. [-] - REAL(ReKi) :: Ll !< Ice floe length [m] - REAL(ReKi) :: Lw !< Ice floe width [m] - REAL(ReKi) :: Cpa !< ice crushing strength pressure-area relation constant [-] - REAL(ReKi) :: dpa !< ice crushing strength pressure-area relation order [-] - REAL(ReKi) :: Fdr !< Constant external driving force [MN] - REAL(ReKi) :: Kic !< Fracture toughness of ice [kNm^(-3/2)] - REAL(ReKi) :: FspN !< Non-dimensional splitting load [-] + REAL(ReKi) :: Ikm = 0.0_ReKi !< Indentation factor [-] + REAL(ReKi) :: Ag = 0.0_ReKi !< Ice crystal type factor [MPa^-3s^-1] + REAL(ReKi) :: Qg = 0.0_ReKi !< Activation energy [kJ] + REAL(ReKi) :: Rg = 0.0_ReKi !< Universal gas constant [J] + REAL(ReKi) :: Tice = 0.0_ReKi !< Ice temperature [K] + REAL(ReKi) :: nu = 0.0_ReKi !< Poison ratio of ice [-] + REAL(ReKi) :: phi = 0.0_ReKi !< Ice wedge angle [degree] + REAL(ReKi) :: SigNm = 0.0_ReKi !< Nominal ice strength [MPa] + REAL(ReKi) :: Eice = 0.0_ReKi !< Elastic modulus of ice [GPa] + REAL(ReKi) :: IceStr2 = 0.0_ReKi !< Ice tooth brittle strength [MPa] + REAL(ReKi) :: Delmax2 = 0.0_ReKi !< Ice tooth maximum elastic deformation for model 2 [m] + REAL(ReKi) :: Pitch = 0.0_ReKi !< Distance between sequential ice teeth for model 2 [m] + REAL(ReKi) :: miuh = 0.0_ReKi !< Mean value of random ice thickness [m] + REAL(ReKi) :: varh = 0.0_ReKi !< Variance of random ice thicknesss [m^2] + REAL(ReKi) :: miuv = 0.0_ReKi !< Mean value of random ice velocity [m/s] + REAL(ReKi) :: varv = 0.0_ReKi !< Variance of random ice velocity [m^2/s^2] + REAL(ReKi) :: miut = 0.0_ReKi !< Mean value of ice loading event duration time [s] + REAL(ReKi) :: miubr = 0.0_ReKi !< Mean value of random ice brittle strength [MPa] + REAL(ReKi) :: varbr = 0.0_ReKi !< Variance of random ice brittle strength [MPa^2] + REAL(ReKi) :: miuDelm = 0.0_ReKi !< Mean value of random random maximum ice tooth tip displacement [MPa] + REAL(ReKi) :: varDelm = 0.0_ReKi !< Variance of random random maximum ice tooth tip displacement [MPa^2] + REAL(ReKi) :: miuP = 0.0_ReKi !< Mean value of random distance between sequential ice teeth [m] + REAL(ReKi) :: varP = 0.0_ReKi !< Variance of random distance between sequential ice teeth [m^2] + INTEGER(IntKi) :: Zn1 = 0_IntKi !< Number of failure zones along contact width [-] + INTEGER(IntKi) :: Zn2 = 0_IntKi !< Number of failure zones along contact height/thickness [-] + REAL(ReKi) :: ZonePitch = 0.0_ReKi !< Distance between sequential ice teeth [m] + REAL(ReKi) :: PrflMean = 0.0_ReKi !< Ice structure contact profile mean value [m] + REAL(ReKi) :: PrflSig = 0.0_ReKi !< Ice structure contact profile standard deviation [m] + REAL(ReKi) :: IceStr = 0.0_ReKi !< Ice failure strength [MPa] + REAL(ReKi) :: Delmax = 0.0_ReKi !< Ice teeth maximum elastic deformation [m] + REAL(ReKi) :: alpha = 0.0_ReKi !< slope angle of the cone [degree] + REAL(ReKi) :: Dwl = 0.0_ReKi !< cone waterline diameter [m] + REAL(ReKi) :: Dtp = 0.0_ReKi !< cone top diameter [m] + REAL(ReKi) :: hr = 0.0_ReKi !< ride-up ice thickness [m] + REAL(ReKi) :: mu = 0.0_ReKi !< friction coefficient between structure and ice [-] + REAL(ReKi) :: sigf = 0.0_ReKi !< flexural strength of ice [MPa] + REAL(ReKi) :: StrLim = 0.0_ReKi !< limit strain [-] + REAL(ReKi) :: StrRtLim = 0.0_ReKi !< limit strain rate [s^-1] + INTEGER(IntKi) :: UorD = 0_IntKi !< flag that indicates upward or downward breaking cone: 0,upward, 1,downward. [-] + REAL(ReKi) :: Ll = 0.0_ReKi !< Ice floe length [m] + REAL(ReKi) :: Lw = 0.0_ReKi !< Ice floe width [m] + REAL(ReKi) :: Cpa = 0.0_ReKi !< ice crushing strength pressure-area relation constant [-] + REAL(ReKi) :: dpa = 0.0_ReKi !< ice crushing strength pressure-area relation order [-] + REAL(ReKi) :: Fdr = 0.0_ReKi !< Constant external driving force [MN] + REAL(ReKi) :: Kic = 0.0_ReKi !< Fracture toughness of ice [kNm^(-3/2)] + REAL(ReKi) :: FspN = 0.0_ReKi !< Non-dimensional splitting load [-] END TYPE IceD_InputFile ! ======================= ! ========= IceD_InitInputType ======= TYPE, PUBLIC :: IceD_InitInputType CHARACTER(1024) :: InputFile !< Name of the input file; remove if there is no file [-] CHARACTER(1024) :: RootName !< Root name of the output file [-] - REAL(ReKi) :: MSL2SWL !< Offset between still-water level and mean sea level [m] - REAL(ReKi) :: WtrDens !< Density of water [kg/m^3] - REAL(ReKi) :: gravity !< Gravitational acceleration [m/s^2] - INTEGER(IntKi) :: LegNum !< Which number of legs on the turbine this is being initialized for [m] - REAL(DbKi) :: TMax !< Total simulation time [s] + REAL(ReKi) :: MSL2SWL = 0.0_ReKi !< Offset between still-water level and mean sea level [m] + REAL(ReKi) :: WtrDens = 0.0_ReKi !< Density of water [kg/m^3] + REAL(ReKi) :: gravity = 0.0_ReKi !< Gravitational acceleration [m/s^2] + INTEGER(IntKi) :: LegNum = 0_IntKi !< Which number of legs on the turbine this is being initialized for [m] + REAL(DbKi) :: TMax = 0.0_R8Ki !< Total simulation time [s] END TYPE IceD_InitInputType ! ======================= ! ========= IceD_InitOutputType ======= TYPE, PUBLIC :: IceD_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 [-] - INTEGER(IntKi) :: numLegs !< Number of legs on the structure [-] + INTEGER(IntKi) :: numLegs = 0_IntKi !< Number of legs on the structure [-] TYPE(ProgDesc) :: Ver !< This module's name, version, and date [-] END TYPE IceD_InitOutputType ! ======================= ! ========= IceD_ContinuousStateType ======= TYPE, PUBLIC :: IceD_ContinuousStateType - REAL(ReKi) :: q !< q - displacement of ice mass [m] - REAL(ReKi) :: dqdt !< dqdt - velocity of ice mass [m/s] + REAL(ReKi) :: q = 0.0_ReKi !< q - displacement of ice mass [m] + REAL(ReKi) :: dqdt = 0.0_ReKi !< dqdt - velocity of ice mass [m/s] END TYPE IceD_ContinuousStateType ! ======================= ! ========= IceD_DiscreteStateType ======= TYPE, PUBLIC :: IceD_DiscreteStateType - REAL(SiKi) :: DummyDiscState !< A variable, Replace if you have discrete states [-] + REAL(SiKi) :: DummyDiscState = 0.0_R4Ki !< A variable, Replace if you have discrete states [-] END TYPE IceD_DiscreteStateType ! ======================= ! ========= IceD_ConstraintStateType ======= TYPE, PUBLIC :: IceD_ConstraintStateType - REAL(SiKi) :: DummyConstrState !< A variable, Replace if you have constraint states [-] + REAL(SiKi) :: DummyConstrState = 0.0_R4Ki !< A variable, Replace if you have constraint states [-] END TYPE IceD_ConstraintStateType ! ======================= ! ========= IceD_OtherStateType ======= TYPE, PUBLIC :: IceD_OtherStateType - INTEGER(IntKi) :: IceTthNo2 !< Ice tooth number of the current ice tooth, for model 2 (updated in UpdateStates; used in CalcOutput) [-] + INTEGER(IntKi) :: IceTthNo2 = 0_IntKi !< Ice tooth number of the current ice tooth, for model 2 (updated in UpdateStates; used in CalcOutput) [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: Nc !< Number of the current ice tooths number (time series) [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Psum !< The sum of pitches of all broken ice teeth (time series) [m] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: IceTthNo !< IceTthNo - the current numbers of ice teeth of each zone [-] - REAL(ReKi) :: Beta !< angle between broken ice sheet and level waterline [rad] - REAL(DbKi) :: Tinit !< Initial time of the current load cycle [s] - INTEGER(IntKi) :: Splitf !< flag to indicate if the ice floe has split (0 not splitted, 1 splitted) [-] - REAL(ReKi) :: dxc !< crushed depth of ice [m] + REAL(ReKi) :: Beta = 0.0_ReKi !< angle between broken ice sheet and level waterline [rad] + REAL(DbKi) :: Tinit = 0.0_R8Ki !< Initial time of the current load cycle [s] + INTEGER(IntKi) :: Splitf = 0_IntKi !< flag to indicate if the ice floe has split (0 not splitted, 1 splitted) [-] + REAL(ReKi) :: dxc = 0.0_ReKi !< crushed depth of ice [m] TYPE(IceD_ContinuousStateType) , DIMENSION(:), ALLOCATABLE :: xdot !< previous state deriv for multi-step [m] - INTEGER(IntKi) :: n !< tracks time step for which OtherState was updated [-] + INTEGER(IntKi) :: n = 0_IntKi !< tracks time step for which OtherState was updated [-] END TYPE IceD_OtherStateType ! ======================= ! ========= IceD_MiscVarType ======= TYPE, PUBLIC :: IceD_MiscVarType - INTEGER(IntKi) :: DummyMiscVar !< Remove this variable if you have misc/optimization variables [-] + INTEGER(IntKi) :: DummyMiscVar = 0_IntKi !< Remove this variable if you have misc/optimization variables [-] END TYPE IceD_MiscVarType ! ======================= ! ========= IceD_ParameterType ======= TYPE, PUBLIC :: IceD_ParameterType - REAL(ReKi) :: h !< Ice thickness [m] - REAL(ReKi) :: v !< Ice velocity [m/s] - REAL(ReKi) :: t0 !< Ice load starting time [s] - REAL(ReKi) :: StrWd !< The width of the structure [m] - REAL(ReKi) :: dt !< Time interval for integration within the module [s] - REAL(ReKi) :: InitLoc !< Ice sheet initial location [m] - REAL(ReKi) :: tolerance !< Tolerance when calculating ice breaking force, etc. [-] - REAL(ReKi) :: Tmax !< Total simulation time [s] - INTEGER(IntKi) :: verif !< flag to indicate if verification is being peformed [-] - INTEGER(IntKi) :: ModNo !< The current ice model number [-] - INTEGER(IntKi) :: SubModNo !< The current ice sub-model number [-] - INTEGER(IntKi) :: NumOuts !< The number of output channels [-] - INTEGER(IntKi) :: method !< integration method: 1-RK4, 2-AB4, 3-ABM4 [-] - INTEGER(IntKi) :: TmStep !< Total time step [-] + REAL(ReKi) :: h = 0.0_ReKi !< Ice thickness [m] + REAL(ReKi) :: v = 0.0_ReKi !< Ice velocity [m/s] + REAL(ReKi) :: t0 = 0.0_ReKi !< Ice load starting time [s] + REAL(ReKi) :: StrWd = 0.0_ReKi !< The width of the structure [m] + REAL(ReKi) :: dt = 0.0_ReKi !< Time interval for integration within the module [s] + REAL(ReKi) :: InitLoc = 0.0_ReKi !< Ice sheet initial location [m] + REAL(ReKi) :: tolerance = 0.0_ReKi !< Tolerance when calculating ice breaking force, etc. [-] + REAL(ReKi) :: Tmax = 0.0_ReKi !< Total simulation time [s] + INTEGER(IntKi) :: verif = 0_IntKi !< flag to indicate if verification is being peformed [-] + INTEGER(IntKi) :: ModNo = 0_IntKi !< The current ice model number [-] + INTEGER(IntKi) :: SubModNo = 0_IntKi !< The current ice sub-model number [-] + INTEGER(IntKi) :: NumOuts = 0_IntKi !< The number of output channels [-] + INTEGER(IntKi) :: method = 0_IntKi !< integration method: 1-RK4, 2-AB4, 3-ABM4 [-] + INTEGER(IntKi) :: TmStep = 0_IntKi !< Total time step [-] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: OutName !< Names of all requested output parameters [-] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: OutUnit !< Units of all requested output parameters [-] CHARACTER(1024) :: RootName !< Rootname [-] - REAL(ReKi) :: tm1a !< Time for the maximum force to be reached for model 1a [s] - REAL(ReKi) :: tm1b !< Time for the maximum force to be reached for model 1b [s] - REAL(ReKi) :: tm1c !< Time for the maximum force to be reached for model 1c [s] - REAL(ReKi) :: Fmax1a !< Maximum ice force of model 1a [N] - REAL(ReKi) :: Fmax1b !< Maximum ice force of model 1b [N] - REAL(ReKi) :: Fmax1c !< Maximum ice force of model 1c [N] - REAL(ReKi) :: Ikm !< Indentation factor [-] - REAL(ReKi) :: Cstr !< Constant when calculating creeping stresss [Pa*s^(-1/3)] - REAL(ReKi) :: EiPa !< Elastic modulus of ice [Pa] - REAL(ReKi) :: Delmax2 !< Ice tooth maximum elastic deformation for model 2 [m] - REAL(ReKi) :: Pitch !< Distance between sequential ice teeth [m] - REAL(ReKi) :: Kice2 !< Stiffness of ice teeth for model 2 [N/m] + REAL(ReKi) :: tm1a = 0.0_ReKi !< Time for the maximum force to be reached for model 1a [s] + REAL(ReKi) :: tm1b = 0.0_ReKi !< Time for the maximum force to be reached for model 1b [s] + REAL(ReKi) :: tm1c = 0.0_ReKi !< Time for the maximum force to be reached for model 1c [s] + REAL(ReKi) :: Fmax1a = 0.0_ReKi !< Maximum ice force of model 1a [N] + REAL(ReKi) :: Fmax1b = 0.0_ReKi !< Maximum ice force of model 1b [N] + REAL(ReKi) :: Fmax1c = 0.0_ReKi !< Maximum ice force of model 1c [N] + REAL(ReKi) :: Ikm = 0.0_ReKi !< Indentation factor [-] + REAL(ReKi) :: Cstr = 0.0_ReKi !< Constant when calculating creeping stresss [Pa*s^(-1/3)] + REAL(ReKi) :: EiPa = 0.0_ReKi !< Elastic modulus of ice [Pa] + REAL(ReKi) :: Delmax2 = 0.0_ReKi !< Ice tooth maximum elastic deformation for model 2 [m] + REAL(ReKi) :: Pitch = 0.0_ReKi !< Distance between sequential ice teeth [m] + REAL(ReKi) :: Kice2 = 0.0_ReKi !< Stiffness of ice teeth for model 2 [N/m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: rdmFm !< Random maximum ice force time series [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: rdmt0 !< Random ice loading event starting time [s] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: rdmtm !< Random time when the maximum force is reached [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: rdmDm !< Random maximum ice tooth tip displacement time series [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: rdmP !< Random distance between sequential ice teeth [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: rdmKi !< Random ice teeth stiffness [N/m] - REAL(ReKi) :: ZonePitch !< Distance between sequential ice teeth [m] - REAL(ReKi) :: Kice !< Stiffness of ice teeth [N/m] - REAL(ReKi) :: Delmax !< Ice teeth maximum elastic deformation [m] + REAL(ReKi) :: ZonePitch = 0.0_ReKi !< Distance between sequential ice teeth [m] + REAL(ReKi) :: Kice = 0.0_ReKi !< Stiffness of ice teeth [N/m] + REAL(ReKi) :: Delmax = 0.0_ReKi !< Ice teeth maximum elastic deformation [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Y0 !< Ice structure contact profile initial location [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: ContPrfl !< Ice structure contact profile [m] - INTEGER(IntKi) :: Zn !< Number of failure zones [-] - REAL(ReKi) :: rhoi !< Ice mass density [kg/m^3] - REAL(ReKi) :: rhow !< Water mass density [kg/m^3] - REAL(ReKi) :: alphaR !< Slope angle of the cone [rad] - REAL(ReKi) :: Dwl !< Cone waterline diameter [m] - REAL(ReKi) :: Zr !< Ice ride-up height [m] - REAL(ReKi) :: RHbr !< Horizontal breaking force [N] - REAL(ReKi) :: RVbr !< Vertical breaking force [N] - REAL(ReKi) :: Lbr !< Ice sheet breaking length [m] - REAL(ReKi) :: LovR !< Ratio of ice breaking length over cone radius [-] - REAL(ReKi) :: mu !< Friction coefficient between structure and ice [-] - REAL(ReKi) :: Wri !< Initial ride-up ice weight [kg] - REAL(ReKi) :: WL !< Broken ice piece weight [kg] - REAL(ReKi) :: Cpa !< ice crushing strength pressure-area relation constant [-] - REAL(ReKi) :: dpa !< ice crushing strength pressure-area relation order [-] - REAL(ReKi) :: FdrN !< Constant external driving force [N] - REAL(ReKi) :: Mice !< Ice floe mass [kg] - REAL(ReKi) :: Fsp !< Ice floe splitting force [N] + INTEGER(IntKi) :: Zn = 0_IntKi !< Number of failure zones [-] + REAL(ReKi) :: rhoi = 0.0_ReKi !< Ice mass density [kg/m^3] + REAL(ReKi) :: rhow = 0.0_ReKi !< Water mass density [kg/m^3] + REAL(ReKi) :: alphaR = 0.0_ReKi !< Slope angle of the cone [rad] + REAL(ReKi) :: Dwl = 0.0_ReKi !< Cone waterline diameter [m] + REAL(ReKi) :: Zr = 0.0_ReKi !< Ice ride-up height [m] + REAL(ReKi) :: RHbr = 0.0_ReKi !< Horizontal breaking force [N] + REAL(ReKi) :: RVbr = 0.0_ReKi !< Vertical breaking force [N] + REAL(ReKi) :: Lbr = 0.0_ReKi !< Ice sheet breaking length [m] + REAL(ReKi) :: LovR = 0.0_ReKi !< Ratio of ice breaking length over cone radius [-] + REAL(ReKi) :: mu = 0.0_ReKi !< Friction coefficient between structure and ice [-] + REAL(ReKi) :: Wri = 0.0_ReKi !< Initial ride-up ice weight [kg] + REAL(ReKi) :: WL = 0.0_ReKi !< Broken ice piece weight [kg] + REAL(ReKi) :: Cpa = 0.0_ReKi !< ice crushing strength pressure-area relation constant [-] + REAL(ReKi) :: dpa = 0.0_ReKi !< ice crushing strength pressure-area relation order [-] + REAL(ReKi) :: FdrN = 0.0_ReKi !< Constant external driving force [N] + REAL(ReKi) :: Mice = 0.0_ReKi !< Ice floe mass [kg] + REAL(ReKi) :: Fsp = 0.0_ReKi !< Ice floe splitting force [N] END TYPE IceD_ParameterType ! ======================= ! ========= IceD_InputType ======= @@ -225,3706 +225,1252 @@ MODULE IceDyn_Types END TYPE IceD_OutputType ! ======================= CONTAINS - SUBROUTINE IceD_CopyInputFile( SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg ) - TYPE(IceD_InputFile), INTENT(IN) :: SrcInputFileData - TYPE(IceD_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 = 'IceD_CopyInputFile' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInputFileData%IceModel = SrcInputFileData%IceModel - DstInputFileData%IceSubModel = SrcInputFileData%IceSubModel - DstInputFileData%h = SrcInputFileData%h - DstInputFileData%v = SrcInputFileData%v - DstInputFileData%InitLoc = SrcInputFileData%InitLoc - DstInputFileData%t0 = SrcInputFileData%t0 - DstInputFileData%rhow = SrcInputFileData%rhow - DstInputFileData%rhoi = SrcInputFileData%rhoi - DstInputFileData%Seed1 = SrcInputFileData%Seed1 - DstInputFileData%Seed2 = SrcInputFileData%Seed2 - DstInputFileData%NumLegs = SrcInputFileData%NumLegs -IF (ALLOCATED(SrcInputFileData%LegPosX)) THEN - i1_l = LBOUND(SrcInputFileData%LegPosX,1) - i1_u = UBOUND(SrcInputFileData%LegPosX,1) - IF (.NOT. ALLOCATED(DstInputFileData%LegPosX)) THEN - ALLOCATE(DstInputFileData%LegPosX(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%LegPosX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%LegPosX = SrcInputFileData%LegPosX -ENDIF -IF (ALLOCATED(SrcInputFileData%LegPosY)) THEN - i1_l = LBOUND(SrcInputFileData%LegPosY,1) - i1_u = UBOUND(SrcInputFileData%LegPosY,1) - IF (.NOT. ALLOCATED(DstInputFileData%LegPosY)) THEN - ALLOCATE(DstInputFileData%LegPosY(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%LegPosY.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%LegPosY = SrcInputFileData%LegPosY -ENDIF -IF (ALLOCATED(SrcInputFileData%StrWd)) THEN - i1_l = LBOUND(SrcInputFileData%StrWd,1) - i1_u = UBOUND(SrcInputFileData%StrWd,1) - IF (.NOT. ALLOCATED(DstInputFileData%StrWd)) THEN - ALLOCATE(DstInputFileData%StrWd(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%StrWd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%StrWd = SrcInputFileData%StrWd -ENDIF - DstInputFileData%Ikm = SrcInputFileData%Ikm - DstInputFileData%Ag = SrcInputFileData%Ag - DstInputFileData%Qg = SrcInputFileData%Qg - DstInputFileData%Rg = SrcInputFileData%Rg - DstInputFileData%Tice = SrcInputFileData%Tice - DstInputFileData%nu = SrcInputFileData%nu - DstInputFileData%phi = SrcInputFileData%phi - DstInputFileData%SigNm = SrcInputFileData%SigNm - DstInputFileData%Eice = SrcInputFileData%Eice - DstInputFileData%IceStr2 = SrcInputFileData%IceStr2 - DstInputFileData%Delmax2 = SrcInputFileData%Delmax2 - DstInputFileData%Pitch = SrcInputFileData%Pitch - DstInputFileData%miuh = SrcInputFileData%miuh - DstInputFileData%varh = SrcInputFileData%varh - DstInputFileData%miuv = SrcInputFileData%miuv - DstInputFileData%varv = SrcInputFileData%varv - DstInputFileData%miut = SrcInputFileData%miut - DstInputFileData%miubr = SrcInputFileData%miubr - DstInputFileData%varbr = SrcInputFileData%varbr - DstInputFileData%miuDelm = SrcInputFileData%miuDelm - DstInputFileData%varDelm = SrcInputFileData%varDelm - DstInputFileData%miuP = SrcInputFileData%miuP - DstInputFileData%varP = SrcInputFileData%varP - DstInputFileData%Zn1 = SrcInputFileData%Zn1 - DstInputFileData%Zn2 = SrcInputFileData%Zn2 - DstInputFileData%ZonePitch = SrcInputFileData%ZonePitch - DstInputFileData%PrflMean = SrcInputFileData%PrflMean - DstInputFileData%PrflSig = SrcInputFileData%PrflSig - DstInputFileData%IceStr = SrcInputFileData%IceStr - DstInputFileData%Delmax = SrcInputFileData%Delmax - DstInputFileData%alpha = SrcInputFileData%alpha - DstInputFileData%Dwl = SrcInputFileData%Dwl - DstInputFileData%Dtp = SrcInputFileData%Dtp - DstInputFileData%hr = SrcInputFileData%hr - DstInputFileData%mu = SrcInputFileData%mu - DstInputFileData%sigf = SrcInputFileData%sigf - DstInputFileData%StrLim = SrcInputFileData%StrLim - DstInputFileData%StrRtLim = SrcInputFileData%StrRtLim - DstInputFileData%UorD = SrcInputFileData%UorD - DstInputFileData%Ll = SrcInputFileData%Ll - DstInputFileData%Lw = SrcInputFileData%Lw - DstInputFileData%Cpa = SrcInputFileData%Cpa - DstInputFileData%dpa = SrcInputFileData%dpa - DstInputFileData%Fdr = SrcInputFileData%Fdr - DstInputFileData%Kic = SrcInputFileData%Kic - DstInputFileData%FspN = SrcInputFileData%FspN - END SUBROUTINE IceD_CopyInputFile - - SUBROUTINE IceD_DestroyInputFile( InputFileData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(IceD_InputFile), INTENT(INOUT) :: InputFileData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IceD_DestroyInputFile' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(InputFileData%LegPosX)) THEN - DEALLOCATE(InputFileData%LegPosX) -ENDIF -IF (ALLOCATED(InputFileData%LegPosY)) THEN - DEALLOCATE(InputFileData%LegPosY) -ENDIF -IF (ALLOCATED(InputFileData%StrWd)) THEN - DEALLOCATE(InputFileData%StrWd) -ENDIF - END SUBROUTINE IceD_DestroyInputFile - - SUBROUTINE IceD_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(IceD_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 = 'IceD_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 ! IceModel - Int_BufSz = Int_BufSz + 1 ! IceSubModel - Re_BufSz = Re_BufSz + 1 ! h - Re_BufSz = Re_BufSz + 1 ! v - Re_BufSz = Re_BufSz + 1 ! InitLoc - Re_BufSz = Re_BufSz + 1 ! t0 - Re_BufSz = Re_BufSz + 1 ! rhow - Re_BufSz = Re_BufSz + 1 ! rhoi - Int_BufSz = Int_BufSz + 1 ! Seed1 - Int_BufSz = Int_BufSz + 1 ! Seed2 - Int_BufSz = Int_BufSz + 1 ! NumLegs - Int_BufSz = Int_BufSz + 1 ! LegPosX allocated yes/no - IF ( ALLOCATED(InData%LegPosX) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LegPosX upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%LegPosX) ! LegPosX - END IF - Int_BufSz = Int_BufSz + 1 ! LegPosY allocated yes/no - IF ( ALLOCATED(InData%LegPosY) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LegPosY upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%LegPosY) ! LegPosY - END IF - Int_BufSz = Int_BufSz + 1 ! StrWd allocated yes/no - IF ( ALLOCATED(InData%StrWd) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! StrWd upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%StrWd) ! StrWd - END IF - Re_BufSz = Re_BufSz + 1 ! Ikm - Re_BufSz = Re_BufSz + 1 ! Ag - Re_BufSz = Re_BufSz + 1 ! Qg - Re_BufSz = Re_BufSz + 1 ! Rg - Re_BufSz = Re_BufSz + 1 ! Tice - Re_BufSz = Re_BufSz + 1 ! nu - Re_BufSz = Re_BufSz + 1 ! phi - Re_BufSz = Re_BufSz + 1 ! SigNm - Re_BufSz = Re_BufSz + 1 ! Eice - Re_BufSz = Re_BufSz + 1 ! IceStr2 - Re_BufSz = Re_BufSz + 1 ! Delmax2 - Re_BufSz = Re_BufSz + 1 ! Pitch - Re_BufSz = Re_BufSz + 1 ! miuh - Re_BufSz = Re_BufSz + 1 ! varh - Re_BufSz = Re_BufSz + 1 ! miuv - Re_BufSz = Re_BufSz + 1 ! varv - Re_BufSz = Re_BufSz + 1 ! miut - Re_BufSz = Re_BufSz + 1 ! miubr - Re_BufSz = Re_BufSz + 1 ! varbr - Re_BufSz = Re_BufSz + 1 ! miuDelm - Re_BufSz = Re_BufSz + 1 ! varDelm - Re_BufSz = Re_BufSz + 1 ! miuP - Re_BufSz = Re_BufSz + 1 ! varP - Int_BufSz = Int_BufSz + 1 ! Zn1 - Int_BufSz = Int_BufSz + 1 ! Zn2 - Re_BufSz = Re_BufSz + 1 ! ZonePitch - Re_BufSz = Re_BufSz + 1 ! PrflMean - Re_BufSz = Re_BufSz + 1 ! PrflSig - Re_BufSz = Re_BufSz + 1 ! IceStr - Re_BufSz = Re_BufSz + 1 ! Delmax - Re_BufSz = Re_BufSz + 1 ! alpha - Re_BufSz = Re_BufSz + 1 ! Dwl - Re_BufSz = Re_BufSz + 1 ! Dtp - Re_BufSz = Re_BufSz + 1 ! hr - Re_BufSz = Re_BufSz + 1 ! mu - Re_BufSz = Re_BufSz + 1 ! sigf - Re_BufSz = Re_BufSz + 1 ! StrLim - Re_BufSz = Re_BufSz + 1 ! StrRtLim - Int_BufSz = Int_BufSz + 1 ! UorD - Re_BufSz = Re_BufSz + 1 ! Ll - Re_BufSz = Re_BufSz + 1 ! Lw - Re_BufSz = Re_BufSz + 1 ! Cpa - Re_BufSz = Re_BufSz + 1 ! dpa - Re_BufSz = Re_BufSz + 1 ! Fdr - Re_BufSz = Re_BufSz + 1 ! Kic - Re_BufSz = Re_BufSz + 1 ! FspN - 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%IceModel - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%IceSubModel - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%h - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%v - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%InitLoc - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%t0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%rhow - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%rhoi - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%Seed1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%Seed2 - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumLegs - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%LegPosX) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LegPosX,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LegPosX,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LegPosX,1), UBOUND(InData%LegPosX,1) - ReKiBuf(Re_Xferred) = InData%LegPosX(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LegPosY) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LegPosY,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LegPosY,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LegPosY,1), UBOUND(InData%LegPosY,1) - ReKiBuf(Re_Xferred) = InData%LegPosY(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%StrWd) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StrWd,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StrWd,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%StrWd,1), UBOUND(InData%StrWd,1) - ReKiBuf(Re_Xferred) = InData%StrWd(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%Ikm - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Ag - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Qg - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Rg - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Tice - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%nu - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%phi - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%SigNm - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Eice - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%IceStr2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Delmax2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Pitch - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%miuh - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%varh - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%miuv - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%varv - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%miut - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%miubr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%varbr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%miuDelm - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%varDelm - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%miuP - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%varP - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%Zn1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%Zn2 - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%ZonePitch - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PrflMean - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PrflSig - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%IceStr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Delmax - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%alpha - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Dwl - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Dtp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%hr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%mu - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%sigf - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StrLim - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StrRtLim - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%UorD - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Ll - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Lw - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Cpa - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%dpa - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Fdr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Kic - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%FspN - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE IceD_PackInputFile - SUBROUTINE IceD_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(IceD_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 = 'IceD_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%IceModel = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%IceSubModel = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%h = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%v = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%InitLoc = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%t0 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%rhow = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%rhoi = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Seed1 = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%Seed2 = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumLegs = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LegPosX not allocated - Int_Xferred = Int_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%LegPosX)) DEALLOCATE(OutData%LegPosX) - ALLOCATE(OutData%LegPosX(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LegPosX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LegPosX,1), UBOUND(OutData%LegPosX,1) - OutData%LegPosX(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LegPosY not allocated - Int_Xferred = Int_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%LegPosY)) DEALLOCATE(OutData%LegPosY) - ALLOCATE(OutData%LegPosY(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LegPosY.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LegPosY,1), UBOUND(OutData%LegPosY,1) - OutData%LegPosY(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StrWd not allocated - Int_Xferred = Int_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%StrWd)) DEALLOCATE(OutData%StrWd) - ALLOCATE(OutData%StrWd(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StrWd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%StrWd,1), UBOUND(OutData%StrWd,1) - OutData%StrWd(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%Ikm = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Ag = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Qg = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Rg = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Tice = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%nu = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%phi = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SigNm = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Eice = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%IceStr2 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Delmax2 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Pitch = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%miuh = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%varh = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%miuv = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%varv = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%miut = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%miubr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%varbr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%miuDelm = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%varDelm = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%miuP = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%varP = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Zn1 = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%Zn2 = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%ZonePitch = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PrflMean = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PrflSig = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%IceStr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Delmax = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%alpha = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Dwl = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Dtp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%hr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%mu = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%sigf = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StrLim = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StrRtLim = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%UorD = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%Ll = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Lw = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Cpa = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%dpa = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Fdr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Kic = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%FspN = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE IceD_UnPackInputFile - - SUBROUTINE IceD_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(IceD_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(IceD_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 = 'IceD_CopyInitInput' -! +subroutine IceD_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg) + type(IceD_InputFile), intent(in) :: SrcInputFileData + type(IceD_InputFile), intent(inout) :: DstInputFileData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'IceD_CopyInputFile' ErrStat = ErrID_None - ErrMsg = "" - DstInitInputData%InputFile = SrcInitInputData%InputFile - DstInitInputData%RootName = SrcInitInputData%RootName - DstInitInputData%MSL2SWL = SrcInitInputData%MSL2SWL - DstInitInputData%WtrDens = SrcInitInputData%WtrDens - DstInitInputData%gravity = SrcInitInputData%gravity - DstInitInputData%LegNum = SrcInitInputData%LegNum - DstInitInputData%TMax = SrcInitInputData%TMax - END SUBROUTINE IceD_CopyInitInput - - SUBROUTINE IceD_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(IceD_InitInputType), INTENT(INOUT) :: InitInputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IceD_DestroyInitInput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE IceD_DestroyInitInput - - SUBROUTINE IceD_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(IceD_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 = 'IceD_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 ! MSL2SWL - Re_BufSz = Re_BufSz + 1 ! WtrDens - Re_BufSz = Re_BufSz + 1 ! gravity - Int_BufSz = Int_BufSz + 1 ! LegNum - Db_BufSz = Db_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%MSL2SWL - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WtrDens - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%gravity - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%LegNum - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%TMax - Db_Xferred = Db_Xferred + 1 - END SUBROUTINE IceD_PackInitInput - - SUBROUTINE IceD_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(IceD_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 = 'IceD_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%MSL2SWL = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%WtrDens = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%gravity = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%LegNum = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TMax = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END SUBROUTINE IceD_UnPackInitInput - - SUBROUTINE IceD_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(IceD_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(IceD_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 = 'IceD_CopyInitOutput' -! + ErrMsg = '' + DstInputFileData%IceModel = SrcInputFileData%IceModel + DstInputFileData%IceSubModel = SrcInputFileData%IceSubModel + DstInputFileData%h = SrcInputFileData%h + DstInputFileData%v = SrcInputFileData%v + DstInputFileData%InitLoc = SrcInputFileData%InitLoc + DstInputFileData%t0 = SrcInputFileData%t0 + DstInputFileData%rhow = SrcInputFileData%rhow + DstInputFileData%rhoi = SrcInputFileData%rhoi + DstInputFileData%Seed1 = SrcInputFileData%Seed1 + DstInputFileData%Seed2 = SrcInputFileData%Seed2 + DstInputFileData%NumLegs = SrcInputFileData%NumLegs + if (allocated(SrcInputFileData%LegPosX)) then + LB(1:1) = lbound(SrcInputFileData%LegPosX) + UB(1:1) = ubound(SrcInputFileData%LegPosX) + if (.not. allocated(DstInputFileData%LegPosX)) then + allocate(DstInputFileData%LegPosX(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%LegPosX.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%LegPosX = SrcInputFileData%LegPosX + end if + if (allocated(SrcInputFileData%LegPosY)) then + LB(1:1) = lbound(SrcInputFileData%LegPosY) + UB(1:1) = ubound(SrcInputFileData%LegPosY) + if (.not. allocated(DstInputFileData%LegPosY)) then + allocate(DstInputFileData%LegPosY(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%LegPosY.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%LegPosY = SrcInputFileData%LegPosY + end if + if (allocated(SrcInputFileData%StrWd)) then + LB(1:1) = lbound(SrcInputFileData%StrWd) + UB(1:1) = ubound(SrcInputFileData%StrWd) + if (.not. allocated(DstInputFileData%StrWd)) then + allocate(DstInputFileData%StrWd(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%StrWd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%StrWd = SrcInputFileData%StrWd + end if + DstInputFileData%Ikm = SrcInputFileData%Ikm + DstInputFileData%Ag = SrcInputFileData%Ag + DstInputFileData%Qg = SrcInputFileData%Qg + DstInputFileData%Rg = SrcInputFileData%Rg + DstInputFileData%Tice = SrcInputFileData%Tice + DstInputFileData%nu = SrcInputFileData%nu + DstInputFileData%phi = SrcInputFileData%phi + DstInputFileData%SigNm = SrcInputFileData%SigNm + DstInputFileData%Eice = SrcInputFileData%Eice + DstInputFileData%IceStr2 = SrcInputFileData%IceStr2 + DstInputFileData%Delmax2 = SrcInputFileData%Delmax2 + DstInputFileData%Pitch = SrcInputFileData%Pitch + DstInputFileData%miuh = SrcInputFileData%miuh + DstInputFileData%varh = SrcInputFileData%varh + DstInputFileData%miuv = SrcInputFileData%miuv + DstInputFileData%varv = SrcInputFileData%varv + DstInputFileData%miut = SrcInputFileData%miut + DstInputFileData%miubr = SrcInputFileData%miubr + DstInputFileData%varbr = SrcInputFileData%varbr + DstInputFileData%miuDelm = SrcInputFileData%miuDelm + DstInputFileData%varDelm = SrcInputFileData%varDelm + DstInputFileData%miuP = SrcInputFileData%miuP + DstInputFileData%varP = SrcInputFileData%varP + DstInputFileData%Zn1 = SrcInputFileData%Zn1 + DstInputFileData%Zn2 = SrcInputFileData%Zn2 + DstInputFileData%ZonePitch = SrcInputFileData%ZonePitch + DstInputFileData%PrflMean = SrcInputFileData%PrflMean + DstInputFileData%PrflSig = SrcInputFileData%PrflSig + DstInputFileData%IceStr = SrcInputFileData%IceStr + DstInputFileData%Delmax = SrcInputFileData%Delmax + DstInputFileData%alpha = SrcInputFileData%alpha + DstInputFileData%Dwl = SrcInputFileData%Dwl + DstInputFileData%Dtp = SrcInputFileData%Dtp + DstInputFileData%hr = SrcInputFileData%hr + DstInputFileData%mu = SrcInputFileData%mu + DstInputFileData%sigf = SrcInputFileData%sigf + DstInputFileData%StrLim = SrcInputFileData%StrLim + DstInputFileData%StrRtLim = SrcInputFileData%StrRtLim + DstInputFileData%UorD = SrcInputFileData%UorD + DstInputFileData%Ll = SrcInputFileData%Ll + DstInputFileData%Lw = SrcInputFileData%Lw + DstInputFileData%Cpa = SrcInputFileData%Cpa + DstInputFileData%dpa = SrcInputFileData%dpa + DstInputFileData%Fdr = SrcInputFileData%Fdr + DstInputFileData%Kic = SrcInputFileData%Kic + DstInputFileData%FspN = SrcInputFileData%FspN +end subroutine + +subroutine IceD_DestroyInputFile(InputFileData, ErrStat, ErrMsg) + type(IceD_InputFile), intent(inout) :: InputFileData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'IceD_DestroyInputFile' 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 - DstInitOutputData%numLegs = SrcInitOutputData%numLegs - CALL NWTC_Library_Copyprogdesc( SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE IceD_CopyInitOutput - - SUBROUTINE IceD_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(IceD_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IceD_DestroyInitOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(InitOutputData%WriteOutputHdr)) THEN - DEALLOCATE(InitOutputData%WriteOutputHdr) -ENDIF -IF (ALLOCATED(InitOutputData%WriteOutputUnt)) THEN - DEALLOCATE(InitOutputData%WriteOutputUnt) -ENDIF - CALL NWTC_Library_Destroyprogdesc( InitOutputData%Ver, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE IceD_DestroyInitOutput - - SUBROUTINE IceD_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(IceD_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 = 'IceD_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 - Int_BufSz = Int_BufSz + 1 ! numLegs - ! 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 - IntKiBuf(Int_Xferred) = InData%numLegs - Int_Xferred = 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 IceD_PackInitOutput - - SUBROUTINE IceD_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(IceD_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 = 'IceD_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 - OutData%numLegs = IntKiBuf(Int_Xferred) - 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_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 IceD_UnPackInitOutput - - SUBROUTINE IceD_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(IceD_ContinuousStateType), INTENT(IN) :: SrcContStateData - TYPE(IceD_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 = 'IceD_CopyContState' -! + ErrMsg = '' + if (allocated(InputFileData%LegPosX)) then + deallocate(InputFileData%LegPosX) + end if + if (allocated(InputFileData%LegPosY)) then + deallocate(InputFileData%LegPosY) + end if + if (allocated(InputFileData%StrWd)) then + deallocate(InputFileData%StrWd) + end if +end subroutine + +subroutine IceD_PackInputFile(RF, Indata) + type(RegFile), intent(inout) :: RF + type(IceD_InputFile), intent(in) :: InData + character(*), parameter :: RoutineName = 'IceD_PackInputFile' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%IceModel) + call RegPack(RF, InData%IceSubModel) + call RegPack(RF, InData%h) + call RegPack(RF, InData%v) + call RegPack(RF, InData%InitLoc) + call RegPack(RF, InData%t0) + call RegPack(RF, InData%rhow) + call RegPack(RF, InData%rhoi) + call RegPack(RF, InData%Seed1) + call RegPack(RF, InData%Seed2) + call RegPack(RF, InData%NumLegs) + call RegPackAlloc(RF, InData%LegPosX) + call RegPackAlloc(RF, InData%LegPosY) + call RegPackAlloc(RF, InData%StrWd) + call RegPack(RF, InData%Ikm) + call RegPack(RF, InData%Ag) + call RegPack(RF, InData%Qg) + call RegPack(RF, InData%Rg) + call RegPack(RF, InData%Tice) + call RegPack(RF, InData%nu) + call RegPack(RF, InData%phi) + call RegPack(RF, InData%SigNm) + call RegPack(RF, InData%Eice) + call RegPack(RF, InData%IceStr2) + call RegPack(RF, InData%Delmax2) + call RegPack(RF, InData%Pitch) + call RegPack(RF, InData%miuh) + call RegPack(RF, InData%varh) + call RegPack(RF, InData%miuv) + call RegPack(RF, InData%varv) + call RegPack(RF, InData%miut) + call RegPack(RF, InData%miubr) + call RegPack(RF, InData%varbr) + call RegPack(RF, InData%miuDelm) + call RegPack(RF, InData%varDelm) + call RegPack(RF, InData%miuP) + call RegPack(RF, InData%varP) + call RegPack(RF, InData%Zn1) + call RegPack(RF, InData%Zn2) + call RegPack(RF, InData%ZonePitch) + call RegPack(RF, InData%PrflMean) + call RegPack(RF, InData%PrflSig) + call RegPack(RF, InData%IceStr) + call RegPack(RF, InData%Delmax) + call RegPack(RF, InData%alpha) + call RegPack(RF, InData%Dwl) + call RegPack(RF, InData%Dtp) + call RegPack(RF, InData%hr) + call RegPack(RF, InData%mu) + call RegPack(RF, InData%sigf) + call RegPack(RF, InData%StrLim) + call RegPack(RF, InData%StrRtLim) + call RegPack(RF, InData%UorD) + call RegPack(RF, InData%Ll) + call RegPack(RF, InData%Lw) + call RegPack(RF, InData%Cpa) + call RegPack(RF, InData%dpa) + call RegPack(RF, InData%Fdr) + call RegPack(RF, InData%Kic) + call RegPack(RF, InData%FspN) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine IceD_UnPackInputFile(RF, OutData) + type(RegFile), intent(inout) :: RF + type(IceD_InputFile), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'IceD_UnPackInputFile' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%IceModel); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%IceSubModel); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%h); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%v); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%InitLoc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%t0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rhow); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rhoi); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Seed1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Seed2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumLegs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LegPosX); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LegPosY); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%StrWd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Ikm); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Ag); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Qg); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Rg); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Tice); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nu); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%phi); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SigNm); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Eice); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%IceStr2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Delmax2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Pitch); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%miuh); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%varh); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%miuv); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%varv); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%miut); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%miubr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%varbr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%miuDelm); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%varDelm); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%miuP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%varP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Zn1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Zn2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ZonePitch); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PrflMean); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PrflSig); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%IceStr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Delmax); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%alpha); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Dwl); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Dtp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%hr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%mu); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%sigf); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StrLim); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StrRtLim); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UorD); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Ll); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Lw); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Cpa); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%dpa); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Fdr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Kic); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FspN); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine IceD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) + type(IceD_InitInputType), intent(in) :: SrcInitInputData + type(IceD_InitInputType), intent(inout) :: DstInitInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'IceD_CopyInitInput' ErrStat = ErrID_None - ErrMsg = "" - DstContStateData%q = SrcContStateData%q - DstContStateData%dqdt = SrcContStateData%dqdt - END SUBROUTINE IceD_CopyContState - - SUBROUTINE IceD_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(IceD_ContinuousStateType), INTENT(INOUT) :: ContStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IceD_DestroyContState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE IceD_DestroyContState - - SUBROUTINE IceD_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(IceD_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 = 'IceD_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 ! q - Re_BufSz = Re_BufSz + 1 ! dqdt - 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%q - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%dqdt - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE IceD_PackContState - - SUBROUTINE IceD_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(IceD_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 = 'IceD_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%q = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%dqdt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE IceD_UnPackContState - - SUBROUTINE IceD_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(IceD_DiscreteStateType), INTENT(IN) :: SrcDiscStateData - TYPE(IceD_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 = 'IceD_CopyDiscState' -! + ErrMsg = '' + DstInitInputData%InputFile = SrcInitInputData%InputFile + DstInitInputData%RootName = SrcInitInputData%RootName + DstInitInputData%MSL2SWL = SrcInitInputData%MSL2SWL + DstInitInputData%WtrDens = SrcInitInputData%WtrDens + DstInitInputData%gravity = SrcInitInputData%gravity + DstInitInputData%LegNum = SrcInitInputData%LegNum + DstInitInputData%TMax = SrcInitInputData%TMax +end subroutine + +subroutine IceD_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(IceD_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'IceD_DestroyInitInput' ErrStat = ErrID_None - ErrMsg = "" - DstDiscStateData%DummyDiscState = SrcDiscStateData%DummyDiscState - END SUBROUTINE IceD_CopyDiscState - - SUBROUTINE IceD_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(IceD_DiscreteStateType), INTENT(INOUT) :: DiscStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IceD_DestroyDiscState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE IceD_DestroyDiscState - - SUBROUTINE IceD_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(IceD_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 = 'IceD_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 IceD_PackDiscState - - SUBROUTINE IceD_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(IceD_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 = 'IceD_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 = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE IceD_UnPackDiscState - - SUBROUTINE IceD_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(IceD_ConstraintStateType), INTENT(IN) :: SrcConstrStateData - TYPE(IceD_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 = 'IceD_CopyConstrState' -! + ErrMsg = '' +end subroutine + +subroutine IceD_PackInitInput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(IceD_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'IceD_PackInitInput' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%InputFile) + call RegPack(RF, InData%RootName) + call RegPack(RF, InData%MSL2SWL) + call RegPack(RF, InData%WtrDens) + call RegPack(RF, InData%gravity) + call RegPack(RF, InData%LegNum) + call RegPack(RF, InData%TMax) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine IceD_UnPackInitInput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(IceD_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'IceD_UnPackInitInput' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%InputFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RootName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MSL2SWL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WtrDens); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%gravity); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LegNum); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TMax); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine IceD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) + type(IceD_InitOutputType), intent(in) :: SrcInitOutputData + type(IceD_InitOutputType), intent(inout) :: DstInitOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'IceD_CopyInitOutput' ErrStat = ErrID_None - ErrMsg = "" - DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState - END SUBROUTINE IceD_CopyConstrState - - SUBROUTINE IceD_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(IceD_ConstraintStateType), INTENT(INOUT) :: ConstrStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IceD_DestroyConstrState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE IceD_DestroyConstrState - - SUBROUTINE IceD_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(IceD_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 = 'IceD_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 IceD_PackConstrState - - SUBROUTINE IceD_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(IceD_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 = 'IceD_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 = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE IceD_UnPackConstrState - - SUBROUTINE IceD_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(IceD_OtherStateType), INTENT(IN) :: SrcOtherStateData - TYPE(IceD_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 = 'IceD_CopyOtherState' -! + ErrMsg = '' + if (allocated(SrcInitOutputData%WriteOutputHdr)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) + if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then + allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitOutputData%WriteOutputUnt)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) + if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then + allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), 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 + end if + DstInitOutputData%numLegs = SrcInitOutputData%numLegs + call NWTC_Library_CopyProgDesc(SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine IceD_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(IceD_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'IceD_DestroyInitOutput' ErrStat = ErrID_None - ErrMsg = "" - DstOtherStateData%IceTthNo2 = SrcOtherStateData%IceTthNo2 -IF (ALLOCATED(SrcOtherStateData%Nc)) THEN - i1_l = LBOUND(SrcOtherStateData%Nc,1) - i1_u = UBOUND(SrcOtherStateData%Nc,1) - IF (.NOT. ALLOCATED(DstOtherStateData%Nc)) THEN - ALLOCATE(DstOtherStateData%Nc(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%Nc.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOtherStateData%Nc = SrcOtherStateData%Nc -ENDIF -IF (ALLOCATED(SrcOtherStateData%Psum)) THEN - i1_l = LBOUND(SrcOtherStateData%Psum,1) - i1_u = UBOUND(SrcOtherStateData%Psum,1) - IF (.NOT. ALLOCATED(DstOtherStateData%Psum)) THEN - ALLOCATE(DstOtherStateData%Psum(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%Psum.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOtherStateData%Psum = SrcOtherStateData%Psum -ENDIF -IF (ALLOCATED(SrcOtherStateData%IceTthNo)) THEN - i1_l = LBOUND(SrcOtherStateData%IceTthNo,1) - i1_u = UBOUND(SrcOtherStateData%IceTthNo,1) - IF (.NOT. ALLOCATED(DstOtherStateData%IceTthNo)) THEN - ALLOCATE(DstOtherStateData%IceTthNo(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%IceTthNo.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOtherStateData%IceTthNo = SrcOtherStateData%IceTthNo -ENDIF - DstOtherStateData%Beta = SrcOtherStateData%Beta - DstOtherStateData%Tinit = SrcOtherStateData%Tinit - DstOtherStateData%Splitf = SrcOtherStateData%Splitf - DstOtherStateData%dxc = SrcOtherStateData%dxc -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 IceD_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 IceD_CopyOtherState - - SUBROUTINE IceD_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(IceD_OtherStateType), INTENT(INOUT) :: OtherStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IceD_DestroyOtherState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(OtherStateData%Nc)) THEN - DEALLOCATE(OtherStateData%Nc) -ENDIF -IF (ALLOCATED(OtherStateData%Psum)) THEN - DEALLOCATE(OtherStateData%Psum) -ENDIF -IF (ALLOCATED(OtherStateData%IceTthNo)) THEN - DEALLOCATE(OtherStateData%IceTthNo) -ENDIF -IF (ALLOCATED(OtherStateData%xdot)) THEN -DO i1 = LBOUND(OtherStateData%xdot,1), UBOUND(OtherStateData%xdot,1) - CALL IceD_DestroyContState( OtherStateData%xdot(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(OtherStateData%xdot) -ENDIF - END SUBROUTINE IceD_DestroyOtherState - - SUBROUTINE IceD_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(IceD_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 = 'IceD_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 ! IceTthNo2 - Int_BufSz = Int_BufSz + 1 ! Nc allocated yes/no - IF ( ALLOCATED(InData%Nc) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Nc upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Nc) ! Nc - END IF - Int_BufSz = Int_BufSz + 1 ! Psum allocated yes/no - IF ( ALLOCATED(InData%Psum) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Psum upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Psum) ! Psum - END IF - Int_BufSz = Int_BufSz + 1 ! IceTthNo allocated yes/no - IF ( ALLOCATED(InData%IceTthNo) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! IceTthNo upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%IceTthNo) ! IceTthNo - END IF - Re_BufSz = Re_BufSz + 1 ! Beta - Db_BufSz = Db_BufSz + 1 ! Tinit - Int_BufSz = Int_BufSz + 1 ! Splitf - Re_BufSz = Re_BufSz + 1 ! dxc - 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 IceD_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 - - IntKiBuf(Int_Xferred) = InData%IceTthNo2 - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%Nc) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Nc,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Nc,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Nc,1), UBOUND(InData%Nc,1) - IntKiBuf(Int_Xferred) = InData%Nc(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Psum) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Psum,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Psum,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Psum,1), UBOUND(InData%Psum,1) - ReKiBuf(Re_Xferred) = InData%Psum(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%IceTthNo) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%IceTthNo,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IceTthNo,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%IceTthNo,1), UBOUND(InData%IceTthNo,1) - IntKiBuf(Int_Xferred) = InData%IceTthNo(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%Beta - Re_Xferred = Re_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%Tinit - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%Splitf - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%dxc - Re_Xferred = Re_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 IceD_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 IceD_PackOtherState - - SUBROUTINE IceD_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(IceD_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 = 'IceD_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%IceTthNo2 = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Nc not allocated - Int_Xferred = Int_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%Nc)) DEALLOCATE(OutData%Nc) - ALLOCATE(OutData%Nc(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Nc.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Nc,1), UBOUND(OutData%Nc,1) - OutData%Nc(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Psum not allocated - Int_Xferred = Int_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%Psum)) DEALLOCATE(OutData%Psum) - ALLOCATE(OutData%Psum(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Psum.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Psum,1), UBOUND(OutData%Psum,1) - OutData%Psum(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IceTthNo not allocated - Int_Xferred = Int_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%IceTthNo)) DEALLOCATE(OutData%IceTthNo) - ALLOCATE(OutData%IceTthNo(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IceTthNo.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%IceTthNo,1), UBOUND(OutData%IceTthNo,1) - OutData%IceTthNo(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - OutData%Beta = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Tinit = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%Splitf = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%dxc = ReKiBuf(Re_Xferred) - Re_Xferred = Re_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 IceD_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 IceD_UnPackOtherState - - SUBROUTINE IceD_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(IceD_MiscVarType), INTENT(IN) :: SrcMiscData - TYPE(IceD_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 = 'IceD_CopyMisc' -! + ErrMsg = '' + if (allocated(InitOutputData%WriteOutputHdr)) then + deallocate(InitOutputData%WriteOutputHdr) + end if + if (allocated(InitOutputData%WriteOutputUnt)) then + deallocate(InitOutputData%WriteOutputUnt) + end if + call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine IceD_PackInitOutput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(IceD_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'IceD_PackInitOutput' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%WriteOutputHdr) + call RegPackAlloc(RF, InData%WriteOutputUnt) + call RegPack(RF, InData%numLegs) + call NWTC_Library_PackProgDesc(RF, InData%Ver) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine IceD_UnPackInitOutput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(IceD_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'IceD_UnPackInitOutput' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%WriteOutputHdr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WriteOutputUnt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%numLegs); if (RegCheckErr(RF, RoutineName)) return + call NWTC_Library_UnpackProgDesc(RF, OutData%Ver) ! Ver +end subroutine + +subroutine IceD_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) + type(IceD_ContinuousStateType), intent(in) :: SrcContStateData + type(IceD_ContinuousStateType), intent(inout) :: DstContStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'IceD_CopyContState' ErrStat = ErrID_None - ErrMsg = "" - DstMiscData%DummyMiscVar = SrcMiscData%DummyMiscVar - END SUBROUTINE IceD_CopyMisc - - SUBROUTINE IceD_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(IceD_MiscVarType), INTENT(INOUT) :: MiscData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IceD_DestroyMisc' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE IceD_DestroyMisc - - SUBROUTINE IceD_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(IceD_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 = 'IceD_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 ! 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 - - IntKiBuf(Int_Xferred) = InData%DummyMiscVar - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE IceD_PackMisc - - SUBROUTINE IceD_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(IceD_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 = 'IceD_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 = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE IceD_UnPackMisc - - SUBROUTINE IceD_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(IceD_ParameterType), INTENT(IN) :: SrcParamData - TYPE(IceD_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 = 'IceD_CopyParam' -! + ErrMsg = '' + DstContStateData%q = SrcContStateData%q + DstContStateData%dqdt = SrcContStateData%dqdt +end subroutine + +subroutine IceD_DestroyContState(ContStateData, ErrStat, ErrMsg) + type(IceD_ContinuousStateType), intent(inout) :: ContStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'IceD_DestroyContState' ErrStat = ErrID_None - ErrMsg = "" - DstParamData%h = SrcParamData%h - DstParamData%v = SrcParamData%v - DstParamData%t0 = SrcParamData%t0 - DstParamData%StrWd = SrcParamData%StrWd - DstParamData%dt = SrcParamData%dt - DstParamData%InitLoc = SrcParamData%InitLoc - DstParamData%tolerance = SrcParamData%tolerance - DstParamData%Tmax = SrcParamData%Tmax - DstParamData%verif = SrcParamData%verif - DstParamData%ModNo = SrcParamData%ModNo - DstParamData%SubModNo = SrcParamData%SubModNo - DstParamData%NumOuts = SrcParamData%NumOuts - DstParamData%method = SrcParamData%method - DstParamData%TmStep = SrcParamData%TmStep -IF (ALLOCATED(SrcParamData%OutName)) THEN - i1_l = LBOUND(SrcParamData%OutName,1) - i1_u = UBOUND(SrcParamData%OutName,1) - IF (.NOT. ALLOCATED(DstParamData%OutName)) THEN - ALLOCATE(DstParamData%OutName(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutName.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%OutName = SrcParamData%OutName -ENDIF -IF (ALLOCATED(SrcParamData%OutUnit)) THEN - i1_l = LBOUND(SrcParamData%OutUnit,1) - i1_u = UBOUND(SrcParamData%OutUnit,1) - IF (.NOT. ALLOCATED(DstParamData%OutUnit)) THEN - ALLOCATE(DstParamData%OutUnit(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutUnit.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%OutUnit = SrcParamData%OutUnit -ENDIF - DstParamData%RootName = SrcParamData%RootName - DstParamData%tm1a = SrcParamData%tm1a - DstParamData%tm1b = SrcParamData%tm1b - DstParamData%tm1c = SrcParamData%tm1c - DstParamData%Fmax1a = SrcParamData%Fmax1a - DstParamData%Fmax1b = SrcParamData%Fmax1b - DstParamData%Fmax1c = SrcParamData%Fmax1c - DstParamData%Ikm = SrcParamData%Ikm - DstParamData%Cstr = SrcParamData%Cstr - DstParamData%EiPa = SrcParamData%EiPa - DstParamData%Delmax2 = SrcParamData%Delmax2 - DstParamData%Pitch = SrcParamData%Pitch - DstParamData%Kice2 = SrcParamData%Kice2 -IF (ALLOCATED(SrcParamData%rdmFm)) THEN - i1_l = LBOUND(SrcParamData%rdmFm,1) - i1_u = UBOUND(SrcParamData%rdmFm,1) - IF (.NOT. ALLOCATED(DstParamData%rdmFm)) THEN - ALLOCATE(DstParamData%rdmFm(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rdmFm.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%rdmFm = SrcParamData%rdmFm -ENDIF -IF (ALLOCATED(SrcParamData%rdmt0)) THEN - i1_l = LBOUND(SrcParamData%rdmt0,1) - i1_u = UBOUND(SrcParamData%rdmt0,1) - IF (.NOT. ALLOCATED(DstParamData%rdmt0)) THEN - ALLOCATE(DstParamData%rdmt0(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rdmt0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%rdmt0 = SrcParamData%rdmt0 -ENDIF -IF (ALLOCATED(SrcParamData%rdmtm)) THEN - i1_l = LBOUND(SrcParamData%rdmtm,1) - i1_u = UBOUND(SrcParamData%rdmtm,1) - IF (.NOT. ALLOCATED(DstParamData%rdmtm)) THEN - ALLOCATE(DstParamData%rdmtm(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rdmtm.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%rdmtm = SrcParamData%rdmtm -ENDIF -IF (ALLOCATED(SrcParamData%rdmDm)) THEN - i1_l = LBOUND(SrcParamData%rdmDm,1) - i1_u = UBOUND(SrcParamData%rdmDm,1) - IF (.NOT. ALLOCATED(DstParamData%rdmDm)) THEN - ALLOCATE(DstParamData%rdmDm(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rdmDm.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%rdmDm = SrcParamData%rdmDm -ENDIF -IF (ALLOCATED(SrcParamData%rdmP)) THEN - i1_l = LBOUND(SrcParamData%rdmP,1) - i1_u = UBOUND(SrcParamData%rdmP,1) - IF (.NOT. ALLOCATED(DstParamData%rdmP)) THEN - ALLOCATE(DstParamData%rdmP(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rdmP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%rdmP = SrcParamData%rdmP -ENDIF -IF (ALLOCATED(SrcParamData%rdmKi)) THEN - i1_l = LBOUND(SrcParamData%rdmKi,1) - i1_u = UBOUND(SrcParamData%rdmKi,1) - IF (.NOT. ALLOCATED(DstParamData%rdmKi)) THEN - ALLOCATE(DstParamData%rdmKi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rdmKi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%rdmKi = SrcParamData%rdmKi -ENDIF - DstParamData%ZonePitch = SrcParamData%ZonePitch - DstParamData%Kice = SrcParamData%Kice - DstParamData%Delmax = SrcParamData%Delmax -IF (ALLOCATED(SrcParamData%Y0)) THEN - i1_l = LBOUND(SrcParamData%Y0,1) - i1_u = UBOUND(SrcParamData%Y0,1) - IF (.NOT. ALLOCATED(DstParamData%Y0)) THEN - ALLOCATE(DstParamData%Y0(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Y0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Y0 = SrcParamData%Y0 -ENDIF -IF (ALLOCATED(SrcParamData%ContPrfl)) THEN - i1_l = LBOUND(SrcParamData%ContPrfl,1) - i1_u = UBOUND(SrcParamData%ContPrfl,1) - IF (.NOT. ALLOCATED(DstParamData%ContPrfl)) THEN - ALLOCATE(DstParamData%ContPrfl(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ContPrfl.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%ContPrfl = SrcParamData%ContPrfl -ENDIF - DstParamData%Zn = SrcParamData%Zn - DstParamData%rhoi = SrcParamData%rhoi - DstParamData%rhow = SrcParamData%rhow - DstParamData%alphaR = SrcParamData%alphaR - DstParamData%Dwl = SrcParamData%Dwl - DstParamData%Zr = SrcParamData%Zr - DstParamData%RHbr = SrcParamData%RHbr - DstParamData%RVbr = SrcParamData%RVbr - DstParamData%Lbr = SrcParamData%Lbr - DstParamData%LovR = SrcParamData%LovR - DstParamData%mu = SrcParamData%mu - DstParamData%Wri = SrcParamData%Wri - DstParamData%WL = SrcParamData%WL - DstParamData%Cpa = SrcParamData%Cpa - DstParamData%dpa = SrcParamData%dpa - DstParamData%FdrN = SrcParamData%FdrN - DstParamData%Mice = SrcParamData%Mice - DstParamData%Fsp = SrcParamData%Fsp - END SUBROUTINE IceD_CopyParam - - SUBROUTINE IceD_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(IceD_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IceD_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(ParamData%OutName)) THEN - DEALLOCATE(ParamData%OutName) -ENDIF -IF (ALLOCATED(ParamData%OutUnit)) THEN - DEALLOCATE(ParamData%OutUnit) -ENDIF -IF (ALLOCATED(ParamData%rdmFm)) THEN - DEALLOCATE(ParamData%rdmFm) -ENDIF -IF (ALLOCATED(ParamData%rdmt0)) THEN - DEALLOCATE(ParamData%rdmt0) -ENDIF -IF (ALLOCATED(ParamData%rdmtm)) THEN - DEALLOCATE(ParamData%rdmtm) -ENDIF -IF (ALLOCATED(ParamData%rdmDm)) THEN - DEALLOCATE(ParamData%rdmDm) -ENDIF -IF (ALLOCATED(ParamData%rdmP)) THEN - DEALLOCATE(ParamData%rdmP) -ENDIF -IF (ALLOCATED(ParamData%rdmKi)) THEN - DEALLOCATE(ParamData%rdmKi) -ENDIF -IF (ALLOCATED(ParamData%Y0)) THEN - DEALLOCATE(ParamData%Y0) -ENDIF -IF (ALLOCATED(ParamData%ContPrfl)) THEN - DEALLOCATE(ParamData%ContPrfl) -ENDIF - END SUBROUTINE IceD_DestroyParam - - SUBROUTINE IceD_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(IceD_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 = 'IceD_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 ! h - Re_BufSz = Re_BufSz + 1 ! v - Re_BufSz = Re_BufSz + 1 ! t0 - Re_BufSz = Re_BufSz + 1 ! StrWd - Re_BufSz = Re_BufSz + 1 ! dt - Re_BufSz = Re_BufSz + 1 ! InitLoc - Re_BufSz = Re_BufSz + 1 ! tolerance - Re_BufSz = Re_BufSz + 1 ! Tmax - Int_BufSz = Int_BufSz + 1 ! verif - Int_BufSz = Int_BufSz + 1 ! ModNo - Int_BufSz = Int_BufSz + 1 ! SubModNo - Int_BufSz = Int_BufSz + 1 ! NumOuts - Int_BufSz = Int_BufSz + 1 ! method - Int_BufSz = Int_BufSz + 1 ! TmStep - Int_BufSz = Int_BufSz + 1 ! OutName allocated yes/no - IF ( ALLOCATED(InData%OutName) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OutName upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%OutName)*LEN(InData%OutName) ! OutName - END IF - Int_BufSz = Int_BufSz + 1 ! OutUnit allocated yes/no - IF ( ALLOCATED(InData%OutUnit) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OutUnit upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%OutUnit)*LEN(InData%OutUnit) ! OutUnit - END IF - Int_BufSz = Int_BufSz + 1*LEN(InData%RootName) ! RootName - Re_BufSz = Re_BufSz + 1 ! tm1a - Re_BufSz = Re_BufSz + 1 ! tm1b - Re_BufSz = Re_BufSz + 1 ! tm1c - Re_BufSz = Re_BufSz + 1 ! Fmax1a - Re_BufSz = Re_BufSz + 1 ! Fmax1b - Re_BufSz = Re_BufSz + 1 ! Fmax1c - Re_BufSz = Re_BufSz + 1 ! Ikm - Re_BufSz = Re_BufSz + 1 ! Cstr - Re_BufSz = Re_BufSz + 1 ! EiPa - Re_BufSz = Re_BufSz + 1 ! Delmax2 - Re_BufSz = Re_BufSz + 1 ! Pitch - Re_BufSz = Re_BufSz + 1 ! Kice2 - Int_BufSz = Int_BufSz + 1 ! rdmFm allocated yes/no - IF ( ALLOCATED(InData%rdmFm) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! rdmFm upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%rdmFm) ! rdmFm - END IF - Int_BufSz = Int_BufSz + 1 ! rdmt0 allocated yes/no - IF ( ALLOCATED(InData%rdmt0) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! rdmt0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%rdmt0) ! rdmt0 - END IF - Int_BufSz = Int_BufSz + 1 ! rdmtm allocated yes/no - IF ( ALLOCATED(InData%rdmtm) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! rdmtm upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%rdmtm) ! rdmtm - END IF - Int_BufSz = Int_BufSz + 1 ! rdmDm allocated yes/no - IF ( ALLOCATED(InData%rdmDm) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! rdmDm upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%rdmDm) ! rdmDm - END IF - Int_BufSz = Int_BufSz + 1 ! rdmP allocated yes/no - IF ( ALLOCATED(InData%rdmP) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! rdmP upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%rdmP) ! rdmP - END IF - Int_BufSz = Int_BufSz + 1 ! rdmKi allocated yes/no - IF ( ALLOCATED(InData%rdmKi) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! rdmKi upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%rdmKi) ! rdmKi - END IF - Re_BufSz = Re_BufSz + 1 ! ZonePitch - Re_BufSz = Re_BufSz + 1 ! Kice - Re_BufSz = Re_BufSz + 1 ! Delmax - Int_BufSz = Int_BufSz + 1 ! Y0 allocated yes/no - IF ( ALLOCATED(InData%Y0) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Y0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Y0) ! Y0 - END IF - Int_BufSz = Int_BufSz + 1 ! ContPrfl allocated yes/no - IF ( ALLOCATED(InData%ContPrfl) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ContPrfl upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%ContPrfl) ! ContPrfl - END IF - Int_BufSz = Int_BufSz + 1 ! Zn - Re_BufSz = Re_BufSz + 1 ! rhoi - Re_BufSz = Re_BufSz + 1 ! rhow - Re_BufSz = Re_BufSz + 1 ! alphaR - Re_BufSz = Re_BufSz + 1 ! Dwl - Re_BufSz = Re_BufSz + 1 ! Zr - Re_BufSz = Re_BufSz + 1 ! RHbr - Re_BufSz = Re_BufSz + 1 ! RVbr - Re_BufSz = Re_BufSz + 1 ! Lbr - Re_BufSz = Re_BufSz + 1 ! LovR - Re_BufSz = Re_BufSz + 1 ! mu - Re_BufSz = Re_BufSz + 1 ! Wri - Re_BufSz = Re_BufSz + 1 ! WL - Re_BufSz = Re_BufSz + 1 ! Cpa - Re_BufSz = Re_BufSz + 1 ! dpa - Re_BufSz = Re_BufSz + 1 ! FdrN - Re_BufSz = Re_BufSz + 1 ! Mice - Re_BufSz = Re_BufSz + 1 ! Fsp - 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%h - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%v - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%t0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StrWd - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%dt - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%InitLoc - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%tolerance - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Tmax - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%verif - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%ModNo - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%SubModNo - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%method - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%TmStep - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%OutName) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OutName,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutName,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%OutName,1), UBOUND(InData%OutName,1) - DO I = 1, LEN(InData%OutName) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutName(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%OutUnit) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OutUnit,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutUnit,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%OutUnit,1), UBOUND(InData%OutUnit,1) - DO I = 1, LEN(InData%OutUnit) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutUnit(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - 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%tm1a - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%tm1b - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%tm1c - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Fmax1a - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Fmax1b - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Fmax1c - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Ikm - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Cstr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%EiPa - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Delmax2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Pitch - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Kice2 - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%rdmFm) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rdmFm,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rdmFm,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%rdmFm,1), UBOUND(InData%rdmFm,1) - ReKiBuf(Re_Xferred) = InData%rdmFm(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%rdmt0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rdmt0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rdmt0,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%rdmt0,1), UBOUND(InData%rdmt0,1) - ReKiBuf(Re_Xferred) = InData%rdmt0(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%rdmtm) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rdmtm,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rdmtm,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%rdmtm,1), UBOUND(InData%rdmtm,1) - ReKiBuf(Re_Xferred) = InData%rdmtm(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%rdmDm) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rdmDm,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rdmDm,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%rdmDm,1), UBOUND(InData%rdmDm,1) - ReKiBuf(Re_Xferred) = InData%rdmDm(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%rdmP) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rdmP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rdmP,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%rdmP,1), UBOUND(InData%rdmP,1) - ReKiBuf(Re_Xferred) = InData%rdmP(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%rdmKi) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rdmKi,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rdmKi,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%rdmKi,1), UBOUND(InData%rdmKi,1) - ReKiBuf(Re_Xferred) = InData%rdmKi(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%ZonePitch - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Kice - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Delmax - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%Y0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Y0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Y0,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Y0,1), UBOUND(InData%Y0,1) - ReKiBuf(Re_Xferred) = InData%Y0(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ContPrfl) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ContPrfl,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ContPrfl,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ContPrfl,1), UBOUND(InData%ContPrfl,1) - ReKiBuf(Re_Xferred) = InData%ContPrfl(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%Zn - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%rhoi - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%rhow - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%alphaR - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Dwl - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Zr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RHbr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RVbr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Lbr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%LovR - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%mu - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Wri - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WL - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Cpa - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%dpa - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%FdrN - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Mice - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Fsp - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE IceD_PackParam - - SUBROUTINE IceD_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(IceD_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 = 'IceD_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%h = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%v = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%t0 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StrWd = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%dt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%InitLoc = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%tolerance = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Tmax = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%verif = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%ModNo = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%SubModNo = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%method = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TmStep = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutName not allocated - Int_Xferred = Int_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%OutName)) DEALLOCATE(OutData%OutName) - ALLOCATE(OutData%OutName(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutName.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%OutName,1), UBOUND(OutData%OutName,1) - DO I = 1, LEN(OutData%OutName) - OutData%OutName(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 ! OutUnit not allocated - Int_Xferred = Int_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%OutUnit)) DEALLOCATE(OutData%OutUnit) - ALLOCATE(OutData%OutUnit(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutUnit.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%OutUnit,1), UBOUND(OutData%OutUnit,1) - DO I = 1, LEN(OutData%OutUnit) - OutData%OutUnit(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%tm1a = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%tm1b = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%tm1c = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Fmax1a = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Fmax1b = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Fmax1c = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Ikm = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Cstr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%EiPa = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Delmax2 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Pitch = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Kice2 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rdmFm not allocated - Int_Xferred = Int_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%rdmFm)) DEALLOCATE(OutData%rdmFm) - ALLOCATE(OutData%rdmFm(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rdmFm.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%rdmFm,1), UBOUND(OutData%rdmFm,1) - OutData%rdmFm(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rdmt0 not allocated - Int_Xferred = Int_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%rdmt0)) DEALLOCATE(OutData%rdmt0) - ALLOCATE(OutData%rdmt0(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rdmt0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%rdmt0,1), UBOUND(OutData%rdmt0,1) - OutData%rdmt0(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rdmtm not allocated - Int_Xferred = Int_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%rdmtm)) DEALLOCATE(OutData%rdmtm) - ALLOCATE(OutData%rdmtm(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rdmtm.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%rdmtm,1), UBOUND(OutData%rdmtm,1) - OutData%rdmtm(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rdmDm not allocated - Int_Xferred = Int_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%rdmDm)) DEALLOCATE(OutData%rdmDm) - ALLOCATE(OutData%rdmDm(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rdmDm.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%rdmDm,1), UBOUND(OutData%rdmDm,1) - OutData%rdmDm(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rdmP not allocated - Int_Xferred = Int_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%rdmP)) DEALLOCATE(OutData%rdmP) - ALLOCATE(OutData%rdmP(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rdmP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%rdmP,1), UBOUND(OutData%rdmP,1) - OutData%rdmP(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rdmKi not allocated - Int_Xferred = Int_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%rdmKi)) DEALLOCATE(OutData%rdmKi) - ALLOCATE(OutData%rdmKi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rdmKi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%rdmKi,1), UBOUND(OutData%rdmKi,1) - OutData%rdmKi(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%ZonePitch = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Kice = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Delmax = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Y0 not allocated - Int_Xferred = Int_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%Y0)) DEALLOCATE(OutData%Y0) - ALLOCATE(OutData%Y0(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Y0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Y0,1), UBOUND(OutData%Y0,1) - OutData%Y0(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ContPrfl not allocated - Int_Xferred = Int_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%ContPrfl)) DEALLOCATE(OutData%ContPrfl) - ALLOCATE(OutData%ContPrfl(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ContPrfl.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ContPrfl,1), UBOUND(OutData%ContPrfl,1) - OutData%ContPrfl(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%Zn = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%rhoi = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%rhow = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%alphaR = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Dwl = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Zr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RHbr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RVbr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Lbr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%LovR = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%mu = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Wri = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%WL = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Cpa = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%dpa = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%FdrN = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Mice = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Fsp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE IceD_UnPackParam - - SUBROUTINE IceD_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(IceD_InputType), INTENT(INOUT) :: SrcInputData - TYPE(IceD_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 = 'IceD_CopyInput' -! + ErrMsg = '' +end subroutine + +subroutine IceD_PackContState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(IceD_ContinuousStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'IceD_PackContState' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%q) + call RegPack(RF, InData%dqdt) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine IceD_UnPackContState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(IceD_ContinuousStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'IceD_UnPackContState' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%q); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%dqdt); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine IceD_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) + type(IceD_DiscreteStateType), intent(in) :: SrcDiscStateData + type(IceD_DiscreteStateType), intent(inout) :: DstDiscStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'IceD_CopyDiscState' ErrStat = ErrID_None - ErrMsg = "" - CALL MeshCopy( SrcInputData%PointMesh, DstInputData%PointMesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE IceD_CopyInput - - SUBROUTINE IceD_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(IceD_InputType), INTENT(INOUT) :: InputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IceD_DestroyInput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL MeshDestroy( InputData%PointMesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE IceD_DestroyInput - - SUBROUTINE IceD_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(IceD_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 = 'IceD_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 ! PointMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%PointMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! PointMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! PointMesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! PointMesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! PointMesh - 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%PointMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! PointMesh - 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 IceD_PackInput - - SUBROUTINE IceD_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(IceD_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 = 'IceD_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%PointMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! PointMesh - 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 IceD_UnPackInput - - SUBROUTINE IceD_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(IceD_OutputType), INTENT(INOUT) :: SrcOutputData - TYPE(IceD_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 = 'IceD_CopyOutput' -! + ErrMsg = '' + DstDiscStateData%DummyDiscState = SrcDiscStateData%DummyDiscState +end subroutine + +subroutine IceD_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) + type(IceD_DiscreteStateType), intent(inout) :: DiscStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'IceD_DestroyDiscState' ErrStat = ErrID_None - ErrMsg = "" - CALL MeshCopy( SrcOutputData%PointMesh, DstOutputData%PointMesh, 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 IceD_CopyOutput - - SUBROUTINE IceD_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(IceD_OutputType), INTENT(INOUT) :: OutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IceD_DestroyOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL MeshDestroy( OutputData%PointMesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(OutputData%WriteOutput)) THEN - DEALLOCATE(OutputData%WriteOutput) -ENDIF - END SUBROUTINE IceD_DestroyOutput - - SUBROUTINE IceD_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(IceD_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 = 'IceD_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 ! PointMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%PointMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! PointMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! PointMesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! PointMesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! PointMesh - 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%PointMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! PointMesh - 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 IceD_PackOutput - - SUBROUTINE IceD_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(IceD_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 = 'IceD_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%PointMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! PointMesh - 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 IceD_UnPackOutput - - - SUBROUTINE IceD_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(IceD_InputType), INTENT(INOUT) :: u(:) ! Input at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Inputs - TYPE(IceD_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 + ErrMsg = '' +end subroutine + +subroutine IceD_PackDiscState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(IceD_DiscreteStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'IceD_PackDiscState' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyDiscState) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine IceD_UnPackDiscState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(IceD_DiscreteStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'IceD_UnPackDiscState' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyDiscState); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine IceD_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) + type(IceD_ConstraintStateType), intent(in) :: SrcConstrStateData + type(IceD_ConstraintStateType), intent(inout) :: DstConstrStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'IceD_CopyConstrState' + ErrStat = ErrID_None + ErrMsg = '' + DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState +end subroutine + +subroutine IceD_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) + type(IceD_ConstraintStateType), intent(inout) :: ConstrStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'IceD_DestroyConstrState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine IceD_PackConstrState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(IceD_ConstraintStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'IceD_PackConstrState' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyConstrState) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine IceD_UnPackConstrState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(IceD_ConstraintStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'IceD_UnPackConstrState' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyConstrState); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine IceD_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) + type(IceD_OtherStateType), intent(in) :: SrcOtherStateData + type(IceD_OtherStateType), intent(inout) :: DstOtherStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'IceD_CopyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + DstOtherStateData%IceTthNo2 = SrcOtherStateData%IceTthNo2 + if (allocated(SrcOtherStateData%Nc)) then + LB(1:1) = lbound(SrcOtherStateData%Nc) + UB(1:1) = ubound(SrcOtherStateData%Nc) + if (.not. allocated(DstOtherStateData%Nc)) then + allocate(DstOtherStateData%Nc(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%Nc.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOtherStateData%Nc = SrcOtherStateData%Nc + end if + if (allocated(SrcOtherStateData%Psum)) then + LB(1:1) = lbound(SrcOtherStateData%Psum) + UB(1:1) = ubound(SrcOtherStateData%Psum) + if (.not. allocated(DstOtherStateData%Psum)) then + allocate(DstOtherStateData%Psum(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%Psum.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOtherStateData%Psum = SrcOtherStateData%Psum + end if + if (allocated(SrcOtherStateData%IceTthNo)) then + LB(1:1) = lbound(SrcOtherStateData%IceTthNo) + UB(1:1) = ubound(SrcOtherStateData%IceTthNo) + if (.not. allocated(DstOtherStateData%IceTthNo)) then + allocate(DstOtherStateData%IceTthNo(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%IceTthNo.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOtherStateData%IceTthNo = SrcOtherStateData%IceTthNo + end if + DstOtherStateData%Beta = SrcOtherStateData%Beta + DstOtherStateData%Tinit = SrcOtherStateData%Tinit + DstOtherStateData%Splitf = SrcOtherStateData%Splitf + DstOtherStateData%dxc = SrcOtherStateData%dxc + if (allocated(SrcOtherStateData%xdot)) then + LB(1:1) = lbound(SrcOtherStateData%xdot) + UB(1:1) = ubound(SrcOtherStateData%xdot) + if (.not. allocated(DstOtherStateData%xdot)) then + allocate(DstOtherStateData%xdot(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%xdot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call IceD_CopyContState(SrcOtherStateData%xdot(i1), DstOtherStateData%xdot(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + DstOtherStateData%n = SrcOtherStateData%n +end subroutine + +subroutine IceD_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) + type(IceD_OtherStateType), intent(inout) :: OtherStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'IceD_DestroyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OtherStateData%Nc)) then + deallocate(OtherStateData%Nc) + end if + if (allocated(OtherStateData%Psum)) then + deallocate(OtherStateData%Psum) + end if + if (allocated(OtherStateData%IceTthNo)) then + deallocate(OtherStateData%IceTthNo) + end if + if (allocated(OtherStateData%xdot)) then + LB(1:1) = lbound(OtherStateData%xdot) + UB(1:1) = ubound(OtherStateData%xdot) + do i1 = LB(1), UB(1) + call IceD_DestroyContState(OtherStateData%xdot(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(OtherStateData%xdot) + end if +end subroutine + +subroutine IceD_PackOtherState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(IceD_OtherStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'IceD_PackOtherState' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%IceTthNo2) + call RegPackAlloc(RF, InData%Nc) + call RegPackAlloc(RF, InData%Psum) + call RegPackAlloc(RF, InData%IceTthNo) + call RegPack(RF, InData%Beta) + call RegPack(RF, InData%Tinit) + call RegPack(RF, InData%Splitf) + call RegPack(RF, InData%dxc) + call RegPack(RF, allocated(InData%xdot)) + if (allocated(InData%xdot)) then + call RegPackBounds(RF, 1, lbound(InData%xdot), ubound(InData%xdot)) + LB(1:1) = lbound(InData%xdot) + UB(1:1) = ubound(InData%xdot) + do i1 = LB(1), UB(1) + call IceD_PackContState(RF, InData%xdot(i1)) + end do + end if + call RegPack(RF, InData%n) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine IceD_UnPackOtherState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(IceD_OtherStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'IceD_UnPackOtherState' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%IceTthNo2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Nc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Psum); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%IceTthNo); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Beta); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Tinit); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Splitf); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%dxc); if (RegCheckErr(RF, RoutineName)) return + if (allocated(OutData%xdot)) deallocate(OutData%xdot) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%xdot(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xdot.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call IceD_UnpackContState(RF, OutData%xdot(i1)) ! xdot + end do + end if + call RegUnpack(RF, OutData%n); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine IceD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(IceD_MiscVarType), intent(in) :: SrcMiscData + type(IceD_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'IceD_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + DstMiscData%DummyMiscVar = SrcMiscData%DummyMiscVar +end subroutine + +subroutine IceD_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(IceD_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'IceD_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine IceD_PackMisc(RF, Indata) + type(RegFile), intent(inout) :: RF + type(IceD_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'IceD_PackMisc' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyMiscVar) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine IceD_UnPackMisc(RF, OutData) + type(RegFile), intent(inout) :: RF + type(IceD_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'IceD_UnPackMisc' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyMiscVar); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine IceD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(IceD_ParameterType), intent(in) :: SrcParamData + type(IceD_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'IceD_CopyParam' + ErrStat = ErrID_None + ErrMsg = '' + DstParamData%h = SrcParamData%h + DstParamData%v = SrcParamData%v + DstParamData%t0 = SrcParamData%t0 + DstParamData%StrWd = SrcParamData%StrWd + DstParamData%dt = SrcParamData%dt + DstParamData%InitLoc = SrcParamData%InitLoc + DstParamData%tolerance = SrcParamData%tolerance + DstParamData%Tmax = SrcParamData%Tmax + DstParamData%verif = SrcParamData%verif + DstParamData%ModNo = SrcParamData%ModNo + DstParamData%SubModNo = SrcParamData%SubModNo + DstParamData%NumOuts = SrcParamData%NumOuts + DstParamData%method = SrcParamData%method + DstParamData%TmStep = SrcParamData%TmStep + if (allocated(SrcParamData%OutName)) then + LB(1:1) = lbound(SrcParamData%OutName) + UB(1:1) = ubound(SrcParamData%OutName) + if (.not. allocated(DstParamData%OutName)) then + allocate(DstParamData%OutName(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutName.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%OutName = SrcParamData%OutName + end if + if (allocated(SrcParamData%OutUnit)) then + LB(1:1) = lbound(SrcParamData%OutUnit) + UB(1:1) = ubound(SrcParamData%OutUnit) + if (.not. allocated(DstParamData%OutUnit)) then + allocate(DstParamData%OutUnit(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutUnit.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%OutUnit = SrcParamData%OutUnit + end if + DstParamData%RootName = SrcParamData%RootName + DstParamData%tm1a = SrcParamData%tm1a + DstParamData%tm1b = SrcParamData%tm1b + DstParamData%tm1c = SrcParamData%tm1c + DstParamData%Fmax1a = SrcParamData%Fmax1a + DstParamData%Fmax1b = SrcParamData%Fmax1b + DstParamData%Fmax1c = SrcParamData%Fmax1c + DstParamData%Ikm = SrcParamData%Ikm + DstParamData%Cstr = SrcParamData%Cstr + DstParamData%EiPa = SrcParamData%EiPa + DstParamData%Delmax2 = SrcParamData%Delmax2 + DstParamData%Pitch = SrcParamData%Pitch + DstParamData%Kice2 = SrcParamData%Kice2 + if (allocated(SrcParamData%rdmFm)) then + LB(1:1) = lbound(SrcParamData%rdmFm) + UB(1:1) = ubound(SrcParamData%rdmFm) + if (.not. allocated(DstParamData%rdmFm)) then + allocate(DstParamData%rdmFm(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rdmFm.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%rdmFm = SrcParamData%rdmFm + end if + if (allocated(SrcParamData%rdmt0)) then + LB(1:1) = lbound(SrcParamData%rdmt0) + UB(1:1) = ubound(SrcParamData%rdmt0) + if (.not. allocated(DstParamData%rdmt0)) then + allocate(DstParamData%rdmt0(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rdmt0.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%rdmt0 = SrcParamData%rdmt0 + end if + if (allocated(SrcParamData%rdmtm)) then + LB(1:1) = lbound(SrcParamData%rdmtm) + UB(1:1) = ubound(SrcParamData%rdmtm) + if (.not. allocated(DstParamData%rdmtm)) then + allocate(DstParamData%rdmtm(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rdmtm.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%rdmtm = SrcParamData%rdmtm + end if + if (allocated(SrcParamData%rdmDm)) then + LB(1:1) = lbound(SrcParamData%rdmDm) + UB(1:1) = ubound(SrcParamData%rdmDm) + if (.not. allocated(DstParamData%rdmDm)) then + allocate(DstParamData%rdmDm(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rdmDm.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%rdmDm = SrcParamData%rdmDm + end if + if (allocated(SrcParamData%rdmP)) then + LB(1:1) = lbound(SrcParamData%rdmP) + UB(1:1) = ubound(SrcParamData%rdmP) + if (.not. allocated(DstParamData%rdmP)) then + allocate(DstParamData%rdmP(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rdmP.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%rdmP = SrcParamData%rdmP + end if + if (allocated(SrcParamData%rdmKi)) then + LB(1:1) = lbound(SrcParamData%rdmKi) + UB(1:1) = ubound(SrcParamData%rdmKi) + if (.not. allocated(DstParamData%rdmKi)) then + allocate(DstParamData%rdmKi(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rdmKi.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%rdmKi = SrcParamData%rdmKi + end if + DstParamData%ZonePitch = SrcParamData%ZonePitch + DstParamData%Kice = SrcParamData%Kice + DstParamData%Delmax = SrcParamData%Delmax + if (allocated(SrcParamData%Y0)) then + LB(1:1) = lbound(SrcParamData%Y0) + UB(1:1) = ubound(SrcParamData%Y0) + if (.not. allocated(DstParamData%Y0)) then + allocate(DstParamData%Y0(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Y0.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Y0 = SrcParamData%Y0 + end if + if (allocated(SrcParamData%ContPrfl)) then + LB(1:1) = lbound(SrcParamData%ContPrfl) + UB(1:1) = ubound(SrcParamData%ContPrfl) + if (.not. allocated(DstParamData%ContPrfl)) then + allocate(DstParamData%ContPrfl(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ContPrfl.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%ContPrfl = SrcParamData%ContPrfl + end if + DstParamData%Zn = SrcParamData%Zn + DstParamData%rhoi = SrcParamData%rhoi + DstParamData%rhow = SrcParamData%rhow + DstParamData%alphaR = SrcParamData%alphaR + DstParamData%Dwl = SrcParamData%Dwl + DstParamData%Zr = SrcParamData%Zr + DstParamData%RHbr = SrcParamData%RHbr + DstParamData%RVbr = SrcParamData%RVbr + DstParamData%Lbr = SrcParamData%Lbr + DstParamData%LovR = SrcParamData%LovR + DstParamData%mu = SrcParamData%mu + DstParamData%Wri = SrcParamData%Wri + DstParamData%WL = SrcParamData%WL + DstParamData%Cpa = SrcParamData%Cpa + DstParamData%dpa = SrcParamData%dpa + DstParamData%FdrN = SrcParamData%FdrN + DstParamData%Mice = SrcParamData%Mice + DstParamData%Fsp = SrcParamData%Fsp +end subroutine + +subroutine IceD_DestroyParam(ParamData, ErrStat, ErrMsg) + type(IceD_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'IceD_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ParamData%OutName)) then + deallocate(ParamData%OutName) + end if + if (allocated(ParamData%OutUnit)) then + deallocate(ParamData%OutUnit) + end if + if (allocated(ParamData%rdmFm)) then + deallocate(ParamData%rdmFm) + end if + if (allocated(ParamData%rdmt0)) then + deallocate(ParamData%rdmt0) + end if + if (allocated(ParamData%rdmtm)) then + deallocate(ParamData%rdmtm) + end if + if (allocated(ParamData%rdmDm)) then + deallocate(ParamData%rdmDm) + end if + if (allocated(ParamData%rdmP)) then + deallocate(ParamData%rdmP) + end if + if (allocated(ParamData%rdmKi)) then + deallocate(ParamData%rdmKi) + end if + if (allocated(ParamData%Y0)) then + deallocate(ParamData%Y0) + end if + if (allocated(ParamData%ContPrfl)) then + deallocate(ParamData%ContPrfl) + end if +end subroutine + +subroutine IceD_PackParam(RF, Indata) + type(RegFile), intent(inout) :: RF + type(IceD_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'IceD_PackParam' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%h) + call RegPack(RF, InData%v) + call RegPack(RF, InData%t0) + call RegPack(RF, InData%StrWd) + call RegPack(RF, InData%dt) + call RegPack(RF, InData%InitLoc) + call RegPack(RF, InData%tolerance) + call RegPack(RF, InData%Tmax) + call RegPack(RF, InData%verif) + call RegPack(RF, InData%ModNo) + call RegPack(RF, InData%SubModNo) + call RegPack(RF, InData%NumOuts) + call RegPack(RF, InData%method) + call RegPack(RF, InData%TmStep) + call RegPackAlloc(RF, InData%OutName) + call RegPackAlloc(RF, InData%OutUnit) + call RegPack(RF, InData%RootName) + call RegPack(RF, InData%tm1a) + call RegPack(RF, InData%tm1b) + call RegPack(RF, InData%tm1c) + call RegPack(RF, InData%Fmax1a) + call RegPack(RF, InData%Fmax1b) + call RegPack(RF, InData%Fmax1c) + call RegPack(RF, InData%Ikm) + call RegPack(RF, InData%Cstr) + call RegPack(RF, InData%EiPa) + call RegPack(RF, InData%Delmax2) + call RegPack(RF, InData%Pitch) + call RegPack(RF, InData%Kice2) + call RegPackAlloc(RF, InData%rdmFm) + call RegPackAlloc(RF, InData%rdmt0) + call RegPackAlloc(RF, InData%rdmtm) + call RegPackAlloc(RF, InData%rdmDm) + call RegPackAlloc(RF, InData%rdmP) + call RegPackAlloc(RF, InData%rdmKi) + call RegPack(RF, InData%ZonePitch) + call RegPack(RF, InData%Kice) + call RegPack(RF, InData%Delmax) + call RegPackAlloc(RF, InData%Y0) + call RegPackAlloc(RF, InData%ContPrfl) + call RegPack(RF, InData%Zn) + call RegPack(RF, InData%rhoi) + call RegPack(RF, InData%rhow) + call RegPack(RF, InData%alphaR) + call RegPack(RF, InData%Dwl) + call RegPack(RF, InData%Zr) + call RegPack(RF, InData%RHbr) + call RegPack(RF, InData%RVbr) + call RegPack(RF, InData%Lbr) + call RegPack(RF, InData%LovR) + call RegPack(RF, InData%mu) + call RegPack(RF, InData%Wri) + call RegPack(RF, InData%WL) + call RegPack(RF, InData%Cpa) + call RegPack(RF, InData%dpa) + call RegPack(RF, InData%FdrN) + call RegPack(RF, InData%Mice) + call RegPack(RF, InData%Fsp) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine IceD_UnPackParam(RF, OutData) + type(RegFile), intent(inout) :: RF + type(IceD_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'IceD_UnPackParam' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%h); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%v); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%t0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StrWd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%dt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%InitLoc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%tolerance); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Tmax); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%verif); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ModNo); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SubModNo); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumOuts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%method); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TmStep); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%OutName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%OutUnit); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RootName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%tm1a); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%tm1b); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%tm1c); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Fmax1a); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Fmax1b); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Fmax1c); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Ikm); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Cstr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%EiPa); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Delmax2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Pitch); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Kice2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%rdmFm); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%rdmt0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%rdmtm); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%rdmDm); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%rdmP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%rdmKi); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ZonePitch); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Kice); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Delmax); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Y0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ContPrfl); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Zn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rhoi); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rhow); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%alphaR); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Dwl); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Zr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RHbr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RVbr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Lbr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LovR); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%mu); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Wri); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Cpa); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%dpa); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FdrN); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Mice); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Fsp); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine IceD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) + type(IceD_InputType), intent(inout) :: SrcInputData + type(IceD_InputType), intent(inout) :: DstInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'IceD_CopyInput' + ErrStat = ErrID_None + ErrMsg = '' + call MeshCopy(SrcInputData%PointMesh, DstInputData%PointMesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine IceD_DestroyInput(InputData, ErrStat, ErrMsg) + type(IceD_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'IceD_DestroyInput' + ErrStat = ErrID_None + ErrMsg = '' + call MeshDestroy( InputData%PointMesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine IceD_PackInput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(IceD_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'IceD_PackInput' + if (RF%ErrStat >= AbortErrLev) return + call MeshPack(RF, InData%PointMesh) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine IceD_UnPackInput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(IceD_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'IceD_UnPackInput' + if (RF%ErrStat /= ErrID_None) return + call MeshUnpack(RF, OutData%PointMesh) ! PointMesh +end subroutine + +subroutine IceD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(IceD_OutputType), intent(inout) :: SrcOutputData + type(IceD_OutputType), intent(inout) :: DstOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'IceD_CopyOutput' + ErrStat = ErrID_None + ErrMsg = '' + call MeshCopy(SrcOutputData%PointMesh, DstOutputData%PointMesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcOutputData%WriteOutput)) then + LB(1:1) = lbound(SrcOutputData%WriteOutput) + UB(1:1) = ubound(SrcOutputData%WriteOutput) + if (.not. allocated(DstOutputData%WriteOutput)) then + allocate(DstOutputData%WriteOutput(LB(1):UB(1)), 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 + end if +end subroutine + +subroutine IceD_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(IceD_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'IceD_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' + call MeshDestroy( OutputData%PointMesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(OutputData%WriteOutput)) then + deallocate(OutputData%WriteOutput) + end if +end subroutine + +subroutine IceD_PackOutput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(IceD_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'IceD_PackOutput' + if (RF%ErrStat >= AbortErrLev) return + call MeshPack(RF, InData%PointMesh) + call RegPackAlloc(RF, InData%WriteOutput) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine IceD_UnPackOutput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(IceD_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'IceD_UnPackOutput' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call MeshUnpack(RF, OutData%PointMesh) ! PointMesh + call RegUnpackAlloc(RF, OutData%WriteOutput); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine IceD_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(IceD_InputType), intent(inout) :: u(:) ! Input at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Inputs + type(IceD_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 = 'IceD_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 IceD_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL IceD_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 IceD_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 IceD_Input_ExtrapInterp - - - SUBROUTINE IceD_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'IceD_Input_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(u)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(u)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(u) - 1 + select case (order) + case (0) + call IceD_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call IceD_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call IceD_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(u) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE IceD_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. @@ -3936,41 +1482,42 @@ SUBROUTINE IceD_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ! !.................................................................................................................................. - TYPE(IceD_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 - TYPE(IceD_InputType), INTENT(INOUT) :: u2 ! Input at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs - TYPE(IceD_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 + TYPE(IceD_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 + TYPE(IceD_InputType), INTENT(INOUT) :: u2 ! Input at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs + TYPE(IceD_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 = 'IceD_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 + REAL(DbKi) :: t(2) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'IceD_Input_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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%PointMesh, u2%PointMesh, tin, u_out%PointMesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - END SUBROUTINE IceD_Input_ExtrapInterp1 - - - SUBROUTINE IceD_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + CALL MeshExtrapInterp1(u1%PointMesh, u2%PointMesh, tin, u_out%PointMesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) +END SUBROUTINE + +SUBROUTINE IceD_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. @@ -3984,101 +1531,102 @@ SUBROUTINE IceD_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Er ! !.................................................................................................................................. - TYPE(IceD_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 > t3 - TYPE(IceD_InputType), INTENT(INOUT) :: u2 ! Input at t2 > t3 - TYPE(IceD_InputType), INTENT(INOUT) :: u3 ! Input at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs - TYPE(IceD_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 + TYPE(IceD_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 > t3 + TYPE(IceD_InputType), INTENT(INOUT) :: u2 ! Input at t2 > t3 + TYPE(IceD_InputType), INTENT(INOUT) :: u3 ! Input at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs + TYPE(IceD_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 = 'IceD_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) - + 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) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'IceD_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 + 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 + 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 + 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%PointMesh, u2%PointMesh, u3%PointMesh, tin, u_out%PointMesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - END SUBROUTINE IceD_Input_ExtrapInterp2 - - - SUBROUTINE IceD_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(IceD_OutputType), INTENT(INOUT) :: y(:) ! Output at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Outputs - TYPE(IceD_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 + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + CALL MeshExtrapInterp2(u1%PointMesh, u2%PointMesh, u3%PointMesh, tin, u_out%PointMesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) +END SUBROUTINE + +subroutine IceD_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(IceD_OutputType), intent(inout) :: y(:) ! Output at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Outputs + type(IceD_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 = 'IceD_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 IceD_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL IceD_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 IceD_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 IceD_Output_ExtrapInterp - - - SUBROUTINE IceD_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'IceD_Output_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(y)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(y)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(y) - 1 + select case (order) + case (0) + call IceD_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call IceD_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call IceD_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(y) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE IceD_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. @@ -4090,49 +1638,47 @@ SUBROUTINE IceD_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMs ! !.................................................................................................................................. - TYPE(IceD_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 - TYPE(IceD_OutputType), INTENT(INOUT) :: y2 ! Output at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs - TYPE(IceD_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 + TYPE(IceD_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 + TYPE(IceD_OutputType), INTENT(INOUT) :: y2 ! Output at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs + TYPE(IceD_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 = 'IceD_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 + REAL(DbKi) :: t(2) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'IceD_Output_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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%PointMesh, y2%PointMesh, tin, y_out%PointMesh, 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 IceD_Output_ExtrapInterp1 - - - SUBROUTINE IceD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + CALL MeshExtrapInterp1(y1%PointMesh, y2%PointMesh, tin, y_out%PointMesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + END IF ! check if allocated +END SUBROUTINE + +SUBROUTINE IceD_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. @@ -4146,56 +1692,52 @@ SUBROUTINE IceD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, E ! !.................................................................................................................................. - TYPE(IceD_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 > t3 - TYPE(IceD_OutputType), INTENT(INOUT) :: y2 ! Output at t2 > t3 - TYPE(IceD_OutputType), INTENT(INOUT) :: y3 ! Output at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs - TYPE(IceD_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 + TYPE(IceD_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 > t3 + TYPE(IceD_OutputType), INTENT(INOUT) :: y2 ! Output at t2 > t3 + TYPE(IceD_OutputType), INTENT(INOUT) :: y3 ! Output at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs + TYPE(IceD_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 = 'IceD_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) - + 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) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'IceD_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 + 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 + 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 + 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%PointMesh, y2%PointMesh, y3%PointMesh, tin, y_out%PointMesh, 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 IceD_Output_ExtrapInterp2 - + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + CALL MeshExtrapInterp2(y1%PointMesh, y2%PointMesh, y3%PointMesh, tin, y_out%PointMesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + a3*y3%WriteOutput + END IF ! check if allocated +END SUBROUTINE END MODULE IceDyn_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/icefloe/CMakeLists.txt b/modules/icefloe/CMakeLists.txt index 8bba15450a..0cd33d9af1 100644 --- a/modules/icefloe/CMakeLists.txt +++ b/modules/icefloe/CMakeLists.txt @@ -18,7 +18,7 @@ if (GENERATE_TYPES) generate_f90_types(src/interfaces/FAST/IceFloe_FASTRegistry.inp ${CMAKE_CURRENT_LIST_DIR}/src/icefloe/IceFloe_Types.f90) endif() -add_library(icefloelib +add_library(icefloelib STATIC src/icefloe/IceFlexBase.F90 src/icefloe/IceFlexIEC.f90 src/icefloe/IceFlexISO.f90 diff --git a/modules/icefloe/src/icefloe/IceFlexISO.f90 b/modules/icefloe/src/icefloe/IceFlexISO.f90 index bc1844f3dd..aeb4e9f25d 100644 --- a/modules/icefloe/src/icefloe/IceFlexISO.f90 +++ b/modules/icefloe/src/icefloe/IceFlexISO.f90 @@ -282,7 +282,7 @@ subroutine randomFlexLoadTimeSeries (myIceParams, iceLog, maxLoad) ! Period is time from no load up to peak, down, then dwell at minimum (normal distribution) CALL RndNorm( period, meanPeriod, inParams%periodCOV*meanPeriod ) ! Period has to be limited to +/- 50% of the mean period - period = min(1.5*meanPeriod, max(0.5*meanPeriod, period)) + period = min(1.5_ReKi*meanPeriod, max(0.5_ReKi*meanPeriod, period)) ! sub period is the fraction of a period: time for load to go up then down (uniform distribution) CALL RanLux ( tau ) diff --git a/modules/icefloe/src/icefloe/IceFloe_Types.f90 b/modules/icefloe/src/icefloe/IceFloe_Types.f90 index 1fea1d5380..28befef3c4 100644 --- a/modules/icefloe/src/icefloe/IceFloe_Types.f90 +++ b/modules/icefloe/src/icefloe/IceFloe_Types.f90 @@ -36,9 +36,9 @@ MODULE IceFloe_Types ! ========= IceFloe_InitInputType ======= TYPE, PUBLIC :: IceFloe_InitInputType CHARACTER(1024) :: InputFile !< Name of the input file [-] - REAL(ReKi) :: simLength !< Duration of simulation [sec] - REAL(ReKi) :: MSL2SWL !< Offset between still-water level and mean sea level [m] - REAL(ReKi) :: gravity !< Gravitational acceleration [m/s^2] + REAL(ReKi) :: simLength = 0.0_ReKi !< Duration of simulation [sec] + REAL(ReKi) :: MSL2SWL = 0.0_ReKi !< Offset between still-water level and mean sea level [m] + REAL(ReKi) :: gravity = 0.0_ReKi !< Gravitational acceleration [m/s^2] character(1024) :: RootName !< Output file root name [-] END TYPE IceFloe_InitInputType ! ======================= @@ -51,50 +51,50 @@ MODULE IceFloe_Types ! ======================= ! ========= IceFloe_ContinuousStateType ======= TYPE, PUBLIC :: IceFloe_ContinuousStateType - REAL(SiKi) :: DummyContStateVar !< None currently used [-] + REAL(SiKi) :: DummyContStateVar = 0.0_R4Ki !< None currently used [-] END TYPE IceFloe_ContinuousStateType ! ======================= ! ========= IceFloe_DiscreteStateType ======= TYPE, PUBLIC :: IceFloe_DiscreteStateType - REAL(SiKi) :: DummyDiscStateVar !< None currently used [-] + REAL(SiKi) :: DummyDiscStateVar = 0.0_R4Ki !< None currently used [-] END TYPE IceFloe_DiscreteStateType ! ======================= ! ========= IceFloe_ConstraintStateType ======= TYPE, PUBLIC :: IceFloe_ConstraintStateType - REAL(SiKi) :: DummyConstrStateVar !< None currently used [-] + REAL(SiKi) :: DummyConstrStateVar = 0.0_R4Ki !< None currently used [-] END TYPE IceFloe_ConstraintStateType ! ======================= ! ========= IceFloe_OtherStateType ======= TYPE, PUBLIC :: IceFloe_OtherStateType - INTEGER(IntKi) :: DummyOtherState !< Remove this variable if you have other states [-] + INTEGER(IntKi) :: DummyOtherState = 0_IntKi !< Remove this variable if you have other states [-] END TYPE IceFloe_OtherStateType ! ======================= ! ========= IceFloe_MiscVarType ======= TYPE, PUBLIC :: IceFloe_MiscVarType - INTEGER(IntKi) :: DummyMiscVar !< Remove this variable if you have misc/optimization variables [-] + INTEGER(IntKi) :: DummyMiscVar = 0_IntKi !< Remove this variable if you have misc/optimization variables [-] END TYPE IceFloe_MiscVarType ! ======================= ! ========= IceFloe_ParameterType ======= TYPE, PUBLIC :: IceFloe_ParameterType REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: loadSeries !< - [precalculated time series of ice loads for each leg] - REAL(ReKi) :: iceVel !< ice floe velocity [m/s] - REAL(ReKi) :: iceDirection !< ice floe direction [degrees] - REAL(ReKi) :: minStrength !< minimum dynamic ice strength [Pa] - REAL(ReKi) :: minStrengthNegVel !< minimum dynamic ice strength for negative velocity [Pa] - REAL(ReKi) :: defaultArea !< structure width to use in cpld crushin [m] - REAL(ReKi) :: crushArea !< cross sectional area of ice against tower [m^2] - REAL(ReKi) :: coeffStressRate !< coefficient to calc stress rate from relative vellocity [Pa/m] - REAL(ReKi) :: C(4) !< coefficient of cubic transition curve for negative stress rates [-] - REAL(ReKi) :: dt !< time step [sec] - REAL(ReKi) :: rampTime !< load ramp up time [sec] + REAL(ReKi) :: iceVel = 0.0_ReKi !< ice floe velocity [m/s] + REAL(ReKi) :: iceDirection = 0.0_ReKi !< ice floe direction [degrees] + REAL(ReKi) :: minStrength = 0.0_ReKi !< minimum dynamic ice strength [Pa] + REAL(ReKi) :: minStrengthNegVel = 0.0_ReKi !< minimum dynamic ice strength for negative velocity [Pa] + REAL(ReKi) :: defaultArea = 0.0_ReKi !< structure width to use in cpld crushin [m] + REAL(ReKi) :: crushArea = 0.0_ReKi !< cross sectional area of ice against tower [m^2] + REAL(ReKi) :: coeffStressRate = 0.0_ReKi !< coefficient to calc stress rate from relative vellocity [Pa/m] + REAL(ReKi) :: C(4) = 0.0_ReKi !< coefficient of cubic transition curve for negative stress rates [-] + REAL(ReKi) :: dt = 0.0_ReKi !< time step [sec] + REAL(ReKi) :: rampTime = 0.0_ReKi !< load ramp up time [sec] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: legX !< - [x position of each leg relative to structure center] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: legY !< - [y position of each leg relative to structure center] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: ks !< - [shelter factor due to upstream leg] - INTEGER(IntKi) :: numLegs !< Number of tower legs (=1 for monopile) [-] - INTEGER(IntKi) :: iceType !< Type of ice Floe: flex, crush, etc. [-] - INTEGER(IntKi) :: logUnitNum !< Unit number for log file [-] - LOGICAL :: singleLoad !< Flag for load application at single point vs multiple legs [-] - LOGICAL :: initFlag !< Flag for successful initialization [-] + INTEGER(IntKi) :: numLegs = 0_IntKi !< Number of tower legs (=1 for monopile) [-] + INTEGER(IntKi) :: iceType = 0_IntKi !< Type of ice Floe: flex, crush, etc. [-] + INTEGER(IntKi) :: logUnitNum = 0_IntKi !< Unit number for log file [-] + LOGICAL :: singleLoad = .false. !< Flag for load application at single point vs multiple legs [-] + LOGICAL :: initFlag = .false. !< Flag for successful initialization [-] END TYPE IceFloe_ParameterType ! ======================= ! ========= IceFloe_InputType ======= @@ -109,2203 +109,650 @@ MODULE IceFloe_Types END TYPE IceFloe_OutputType ! ======================= CONTAINS - SUBROUTINE IceFloe_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(IceFloe_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(IceFloe_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 = 'IceFloe_CopyInitInput' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInitInputData%InputFile = SrcInitInputData%InputFile - DstInitInputData%simLength = SrcInitInputData%simLength - DstInitInputData%MSL2SWL = SrcInitInputData%MSL2SWL - DstInitInputData%gravity = SrcInitInputData%gravity - DstInitInputData%RootName = SrcInitInputData%RootName - END SUBROUTINE IceFloe_CopyInitInput - - SUBROUTINE IceFloe_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(IceFloe_InitInputType), INTENT(INOUT) :: InitInputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_DestroyInitInput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE IceFloe_DestroyInitInput - - SUBROUTINE IceFloe_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(IceFloe_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 = 'IceFloe_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 - Re_BufSz = Re_BufSz + 1 ! simLength - Re_BufSz = Re_BufSz + 1 ! MSL2SWL - Re_BufSz = Re_BufSz + 1 ! gravity - Int_BufSz = Int_BufSz + 1*LEN(InData%RootName) ! RootName - 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 - ReKiBuf(Re_Xferred) = InData%simLength - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MSL2SWL - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%gravity - Re_Xferred = Re_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 - END SUBROUTINE IceFloe_PackInitInput - - SUBROUTINE IceFloe_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(IceFloe_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 = 'IceFloe_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%simLength = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MSL2SWL = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%gravity = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END SUBROUTINE IceFloe_UnPackInitInput - - SUBROUTINE IceFloe_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(IceFloe_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(IceFloe_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 = 'IceFloe_CopyInitOutput' -! +subroutine IceFloe_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) + type(IceFloe_InitInputType), intent(in) :: SrcInitInputData + type(IceFloe_InitInputType), intent(inout) :: DstInitInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'IceFloe_CopyInitInput' 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 IceFloe_CopyInitOutput - - SUBROUTINE IceFloe_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(IceFloe_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_DestroyInitOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(InitOutputData%WriteOutputHdr)) THEN - DEALLOCATE(InitOutputData%WriteOutputHdr) -ENDIF -IF (ALLOCATED(InitOutputData%WriteOutputUnt)) THEN - DEALLOCATE(InitOutputData%WriteOutputUnt) -ENDIF - CALL NWTC_Library_Destroyprogdesc( InitOutputData%Ver, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE IceFloe_DestroyInitOutput - - SUBROUTINE IceFloe_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(IceFloe_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 = 'IceFloe_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 IceFloe_PackInitOutput - - SUBROUTINE IceFloe_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(IceFloe_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 = 'IceFloe_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 IceFloe_UnPackInitOutput - - SUBROUTINE IceFloe_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(IceFloe_ContinuousStateType), INTENT(IN) :: SrcContStateData - TYPE(IceFloe_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 = 'IceFloe_CopyContState' -! + ErrMsg = '' + DstInitInputData%InputFile = SrcInitInputData%InputFile + DstInitInputData%simLength = SrcInitInputData%simLength + DstInitInputData%MSL2SWL = SrcInitInputData%MSL2SWL + DstInitInputData%gravity = SrcInitInputData%gravity + DstInitInputData%RootName = SrcInitInputData%RootName +end subroutine + +subroutine IceFloe_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(IceFloe_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'IceFloe_DestroyInitInput' ErrStat = ErrID_None - ErrMsg = "" - DstContStateData%DummyContStateVar = SrcContStateData%DummyContStateVar - END SUBROUTINE IceFloe_CopyContState - - SUBROUTINE IceFloe_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(IceFloe_ContinuousStateType), INTENT(INOUT) :: ContStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_DestroyContState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE IceFloe_DestroyContState - - SUBROUTINE IceFloe_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(IceFloe_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 = 'IceFloe_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 ! DummyContStateVar - 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%DummyContStateVar - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE IceFloe_PackContState - - SUBROUTINE IceFloe_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(IceFloe_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 = 'IceFloe_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%DummyContStateVar = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE IceFloe_UnPackContState - - SUBROUTINE IceFloe_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(IceFloe_DiscreteStateType), INTENT(IN) :: SrcDiscStateData - TYPE(IceFloe_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 = 'IceFloe_CopyDiscState' -! + ErrMsg = '' +end subroutine + +subroutine IceFloe_PackInitInput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(IceFloe_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'IceFloe_PackInitInput' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%InputFile) + call RegPack(RF, InData%simLength) + call RegPack(RF, InData%MSL2SWL) + call RegPack(RF, InData%gravity) + call RegPack(RF, InData%RootName) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine IceFloe_UnPackInitInput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(IceFloe_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'IceFloe_UnPackInitInput' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%InputFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%simLength); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MSL2SWL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%gravity); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RootName); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine IceFloe_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) + type(IceFloe_InitOutputType), intent(in) :: SrcInitOutputData + type(IceFloe_InitOutputType), intent(inout) :: DstInitOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'IceFloe_CopyInitOutput' ErrStat = ErrID_None - ErrMsg = "" - DstDiscStateData%DummyDiscStateVar = SrcDiscStateData%DummyDiscStateVar - END SUBROUTINE IceFloe_CopyDiscState - - SUBROUTINE IceFloe_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(IceFloe_DiscreteStateType), INTENT(INOUT) :: DiscStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_DestroyDiscState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE IceFloe_DestroyDiscState - - SUBROUTINE IceFloe_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(IceFloe_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 = 'IceFloe_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 ! DummyDiscStateVar - 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%DummyDiscStateVar - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE IceFloe_PackDiscState - - SUBROUTINE IceFloe_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(IceFloe_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 = 'IceFloe_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%DummyDiscStateVar = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE IceFloe_UnPackDiscState - - SUBROUTINE IceFloe_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(IceFloe_ConstraintStateType), INTENT(IN) :: SrcConstrStateData - TYPE(IceFloe_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 = 'IceFloe_CopyConstrState' -! + ErrMsg = '' + if (allocated(SrcInitOutputData%WriteOutputHdr)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) + if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then + allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitOutputData%WriteOutputUnt)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) + if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then + allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), 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 + end if + call NWTC_Library_CopyProgDesc(SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine IceFloe_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(IceFloe_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'IceFloe_DestroyInitOutput' ErrStat = ErrID_None - ErrMsg = "" - DstConstrStateData%DummyConstrStateVar = SrcConstrStateData%DummyConstrStateVar - END SUBROUTINE IceFloe_CopyConstrState - - SUBROUTINE IceFloe_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(IceFloe_ConstraintStateType), INTENT(INOUT) :: ConstrStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_DestroyConstrState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE IceFloe_DestroyConstrState - - SUBROUTINE IceFloe_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(IceFloe_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 = 'IceFloe_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 ! DummyConstrStateVar - 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%DummyConstrStateVar - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE IceFloe_PackConstrState - - SUBROUTINE IceFloe_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(IceFloe_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 = 'IceFloe_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%DummyConstrStateVar = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE IceFloe_UnPackConstrState - - SUBROUTINE IceFloe_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(IceFloe_OtherStateType), INTENT(IN) :: SrcOtherStateData - TYPE(IceFloe_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 = 'IceFloe_CopyOtherState' -! + ErrMsg = '' + if (allocated(InitOutputData%WriteOutputHdr)) then + deallocate(InitOutputData%WriteOutputHdr) + end if + if (allocated(InitOutputData%WriteOutputUnt)) then + deallocate(InitOutputData%WriteOutputUnt) + end if + call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine IceFloe_PackInitOutput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(IceFloe_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'IceFloe_PackInitOutput' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%WriteOutputHdr) + call RegPackAlloc(RF, InData%WriteOutputUnt) + call NWTC_Library_PackProgDesc(RF, InData%Ver) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine IceFloe_UnPackInitOutput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(IceFloe_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'IceFloe_UnPackInitOutput' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%WriteOutputHdr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WriteOutputUnt); if (RegCheckErr(RF, RoutineName)) return + call NWTC_Library_UnpackProgDesc(RF, OutData%Ver) ! Ver +end subroutine + +subroutine IceFloe_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) + type(IceFloe_ContinuousStateType), intent(in) :: SrcContStateData + type(IceFloe_ContinuousStateType), intent(inout) :: DstContStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'IceFloe_CopyContState' ErrStat = ErrID_None - ErrMsg = "" - DstOtherStateData%DummyOtherState = SrcOtherStateData%DummyOtherState - END SUBROUTINE IceFloe_CopyOtherState - - SUBROUTINE IceFloe_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(IceFloe_OtherStateType), INTENT(INOUT) :: OtherStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_DestroyOtherState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE IceFloe_DestroyOtherState - - SUBROUTINE IceFloe_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(IceFloe_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 = 'IceFloe_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) = InData%DummyOtherState - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE IceFloe_PackOtherState - - SUBROUTINE IceFloe_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(IceFloe_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 = 'IceFloe_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 IceFloe_UnPackOtherState - - SUBROUTINE IceFloe_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(IceFloe_MiscVarType), INTENT(IN) :: SrcMiscData - TYPE(IceFloe_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 = 'IceFloe_CopyMisc' -! + ErrMsg = '' + DstContStateData%DummyContStateVar = SrcContStateData%DummyContStateVar +end subroutine + +subroutine IceFloe_DestroyContState(ContStateData, ErrStat, ErrMsg) + type(IceFloe_ContinuousStateType), intent(inout) :: ContStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'IceFloe_DestroyContState' ErrStat = ErrID_None - ErrMsg = "" - DstMiscData%DummyMiscVar = SrcMiscData%DummyMiscVar - END SUBROUTINE IceFloe_CopyMisc - - SUBROUTINE IceFloe_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(IceFloe_MiscVarType), INTENT(INOUT) :: MiscData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_DestroyMisc' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE IceFloe_DestroyMisc - - SUBROUTINE IceFloe_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(IceFloe_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 = 'IceFloe_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 ! 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 - - IntKiBuf(Int_Xferred) = InData%DummyMiscVar - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE IceFloe_PackMisc - - SUBROUTINE IceFloe_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(IceFloe_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 = 'IceFloe_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 = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE IceFloe_UnPackMisc - - SUBROUTINE IceFloe_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(IceFloe_ParameterType), INTENT(IN) :: SrcParamData - TYPE(IceFloe_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 = 'IceFloe_CopyParam' -! + ErrMsg = '' +end subroutine + +subroutine IceFloe_PackContState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(IceFloe_ContinuousStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'IceFloe_PackContState' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyContStateVar) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine IceFloe_UnPackContState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(IceFloe_ContinuousStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'IceFloe_UnPackContState' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyContStateVar); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine IceFloe_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) + type(IceFloe_DiscreteStateType), intent(in) :: SrcDiscStateData + type(IceFloe_DiscreteStateType), intent(inout) :: DstDiscStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'IceFloe_CopyDiscState' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcParamData%loadSeries)) THEN - i1_l = LBOUND(SrcParamData%loadSeries,1) - i1_u = UBOUND(SrcParamData%loadSeries,1) - i2_l = LBOUND(SrcParamData%loadSeries,2) - i2_u = UBOUND(SrcParamData%loadSeries,2) - IF (.NOT. ALLOCATED(DstParamData%loadSeries)) THEN - ALLOCATE(DstParamData%loadSeries(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%loadSeries.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%loadSeries = SrcParamData%loadSeries -ENDIF - DstParamData%iceVel = SrcParamData%iceVel - DstParamData%iceDirection = SrcParamData%iceDirection - DstParamData%minStrength = SrcParamData%minStrength - DstParamData%minStrengthNegVel = SrcParamData%minStrengthNegVel - DstParamData%defaultArea = SrcParamData%defaultArea - DstParamData%crushArea = SrcParamData%crushArea - DstParamData%coeffStressRate = SrcParamData%coeffStressRate - DstParamData%C(4) = SrcParamData%C(4) - DstParamData%dt = SrcParamData%dt - DstParamData%rampTime = SrcParamData%rampTime -IF (ALLOCATED(SrcParamData%legX)) THEN - i1_l = LBOUND(SrcParamData%legX,1) - i1_u = UBOUND(SrcParamData%legX,1) - IF (.NOT. ALLOCATED(DstParamData%legX)) THEN - ALLOCATE(DstParamData%legX(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%legX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%legX = SrcParamData%legX -ENDIF -IF (ALLOCATED(SrcParamData%legY)) THEN - i1_l = LBOUND(SrcParamData%legY,1) - i1_u = UBOUND(SrcParamData%legY,1) - IF (.NOT. ALLOCATED(DstParamData%legY)) THEN - ALLOCATE(DstParamData%legY(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%legY.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%legY = SrcParamData%legY -ENDIF -IF (ALLOCATED(SrcParamData%ks)) THEN - i1_l = LBOUND(SrcParamData%ks,1) - i1_u = UBOUND(SrcParamData%ks,1) - IF (.NOT. ALLOCATED(DstParamData%ks)) THEN - ALLOCATE(DstParamData%ks(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ks.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%ks = SrcParamData%ks -ENDIF - DstParamData%numLegs = SrcParamData%numLegs - DstParamData%iceType = SrcParamData%iceType - DstParamData%logUnitNum = SrcParamData%logUnitNum - DstParamData%singleLoad = SrcParamData%singleLoad - DstParamData%initFlag = SrcParamData%initFlag - END SUBROUTINE IceFloe_CopyParam - - SUBROUTINE IceFloe_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(IceFloe_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(ParamData%loadSeries)) THEN - DEALLOCATE(ParamData%loadSeries) -ENDIF -IF (ALLOCATED(ParamData%legX)) THEN - DEALLOCATE(ParamData%legX) -ENDIF -IF (ALLOCATED(ParamData%legY)) THEN - DEALLOCATE(ParamData%legY) -ENDIF -IF (ALLOCATED(ParamData%ks)) THEN - DEALLOCATE(ParamData%ks) -ENDIF - END SUBROUTINE IceFloe_DestroyParam - - SUBROUTINE IceFloe_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(IceFloe_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 = 'IceFloe_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 ! loadSeries allocated yes/no - IF ( ALLOCATED(InData%loadSeries) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! loadSeries upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%loadSeries) ! loadSeries - END IF - Re_BufSz = Re_BufSz + 1 ! iceVel - Re_BufSz = Re_BufSz + 1 ! iceDirection - Re_BufSz = Re_BufSz + 1 ! minStrength - Re_BufSz = Re_BufSz + 1 ! minStrengthNegVel - Re_BufSz = Re_BufSz + 1 ! defaultArea - Re_BufSz = Re_BufSz + 1 ! crushArea - Re_BufSz = Re_BufSz + 1 ! coeffStressRate - Re_BufSz = Re_BufSz + 1 ! C(4) - Re_BufSz = Re_BufSz + 1 ! dt - Re_BufSz = Re_BufSz + 1 ! rampTime - Int_BufSz = Int_BufSz + 1 ! legX allocated yes/no - IF ( ALLOCATED(InData%legX) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! legX upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%legX) ! legX - END IF - Int_BufSz = Int_BufSz + 1 ! legY allocated yes/no - IF ( ALLOCATED(InData%legY) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! legY upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%legY) ! legY - END IF - Int_BufSz = Int_BufSz + 1 ! ks allocated yes/no - IF ( ALLOCATED(InData%ks) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ks upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%ks) ! ks - END IF - Int_BufSz = Int_BufSz + 1 ! numLegs - Int_BufSz = Int_BufSz + 1 ! iceType - Int_BufSz = Int_BufSz + 1 ! logUnitNum - Int_BufSz = Int_BufSz + 1 ! singleLoad - Int_BufSz = Int_BufSz + 1 ! initFlag - 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%loadSeries) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%loadSeries,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%loadSeries,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%loadSeries,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%loadSeries,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%loadSeries,2), UBOUND(InData%loadSeries,2) - DO i1 = LBOUND(InData%loadSeries,1), UBOUND(InData%loadSeries,1) - ReKiBuf(Re_Xferred) = InData%loadSeries(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - ReKiBuf(Re_Xferred) = InData%iceVel - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%iceDirection - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%minStrength - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%minStrengthNegVel - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%defaultArea - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%crushArea - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%coeffStressRate - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%C(4) - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%dt - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%rampTime - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%legX) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%legX,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%legX,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%legX,1), UBOUND(InData%legX,1) - ReKiBuf(Re_Xferred) = InData%legX(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%legY) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%legY,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%legY,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%legY,1), UBOUND(InData%legY,1) - ReKiBuf(Re_Xferred) = InData%legY(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ks) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ks,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ks,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ks,1), UBOUND(InData%ks,1) - ReKiBuf(Re_Xferred) = InData%ks(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%numLegs - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%iceType - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%logUnitNum - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%singleLoad, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%initFlag, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE IceFloe_PackParam - - SUBROUTINE IceFloe_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(IceFloe_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 = 'IceFloe_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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! loadSeries not allocated - Int_Xferred = Int_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%loadSeries)) DEALLOCATE(OutData%loadSeries) - ALLOCATE(OutData%loadSeries(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%loadSeries.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%loadSeries,2), UBOUND(OutData%loadSeries,2) - DO i1 = LBOUND(OutData%loadSeries,1), UBOUND(OutData%loadSeries,1) - OutData%loadSeries(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%iceVel = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%iceDirection = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%minStrength = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%minStrengthNegVel = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%defaultArea = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%crushArea = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%coeffStressRate = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C(4) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%dt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%rampTime = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! legX not allocated - Int_Xferred = Int_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%legX)) DEALLOCATE(OutData%legX) - ALLOCATE(OutData%legX(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%legX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%legX,1), UBOUND(OutData%legX,1) - OutData%legX(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! legY not allocated - Int_Xferred = Int_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%legY)) DEALLOCATE(OutData%legY) - ALLOCATE(OutData%legY(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%legY.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%legY,1), UBOUND(OutData%legY,1) - OutData%legY(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ks not allocated - Int_Xferred = Int_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%ks)) DEALLOCATE(OutData%ks) - ALLOCATE(OutData%ks(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ks.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ks,1), UBOUND(OutData%ks,1) - OutData%ks(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%numLegs = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%iceType = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%logUnitNum = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%singleLoad = TRANSFER(IntKiBuf(Int_Xferred), OutData%singleLoad) - Int_Xferred = Int_Xferred + 1 - OutData%initFlag = TRANSFER(IntKiBuf(Int_Xferred), OutData%initFlag) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE IceFloe_UnPackParam - - SUBROUTINE IceFloe_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(IceFloe_InputType), INTENT(INOUT) :: SrcInputData - TYPE(IceFloe_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 = 'IceFloe_CopyInput' -! + ErrMsg = '' + DstDiscStateData%DummyDiscStateVar = SrcDiscStateData%DummyDiscStateVar +end subroutine + +subroutine IceFloe_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) + type(IceFloe_DiscreteStateType), intent(inout) :: DiscStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'IceFloe_DestroyDiscState' ErrStat = ErrID_None - ErrMsg = "" - CALL MeshCopy( SrcInputData%iceMesh, DstInputData%iceMesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE IceFloe_CopyInput - - SUBROUTINE IceFloe_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(IceFloe_InputType), INTENT(INOUT) :: InputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_DestroyInput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL MeshDestroy( InputData%iceMesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE IceFloe_DestroyInput - - SUBROUTINE IceFloe_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(IceFloe_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 = 'IceFloe_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 ! iceMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%iceMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! iceMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! iceMesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! iceMesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! iceMesh - 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%iceMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! iceMesh - 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 IceFloe_PackInput - - SUBROUTINE IceFloe_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(IceFloe_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 = 'IceFloe_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%iceMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! iceMesh - 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 IceFloe_UnPackInput - - SUBROUTINE IceFloe_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(IceFloe_OutputType), INTENT(INOUT) :: SrcOutputData - TYPE(IceFloe_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 = 'IceFloe_CopyOutput' -! + ErrMsg = '' +end subroutine + +subroutine IceFloe_PackDiscState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(IceFloe_DiscreteStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'IceFloe_PackDiscState' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyDiscStateVar) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine IceFloe_UnPackDiscState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(IceFloe_DiscreteStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'IceFloe_UnPackDiscState' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyDiscStateVar); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine IceFloe_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) + type(IceFloe_ConstraintStateType), intent(in) :: SrcConstrStateData + type(IceFloe_ConstraintStateType), intent(inout) :: DstConstrStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'IceFloe_CopyConstrState' ErrStat = ErrID_None - ErrMsg = "" - CALL MeshCopy( SrcOutputData%iceMesh, DstOutputData%iceMesh, 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 IceFloe_CopyOutput - - SUBROUTINE IceFloe_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(IceFloe_OutputType), INTENT(INOUT) :: OutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_DestroyOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL MeshDestroy( OutputData%iceMesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(OutputData%WriteOutput)) THEN - DEALLOCATE(OutputData%WriteOutput) -ENDIF - END SUBROUTINE IceFloe_DestroyOutput - - SUBROUTINE IceFloe_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(IceFloe_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 = 'IceFloe_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 ! iceMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%iceMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! iceMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! iceMesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! iceMesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! iceMesh - 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%iceMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! iceMesh - 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 IceFloe_PackOutput - - SUBROUTINE IceFloe_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(IceFloe_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 = 'IceFloe_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%iceMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! iceMesh - 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 IceFloe_UnPackOutput - - - SUBROUTINE IceFloe_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(IceFloe_InputType), INTENT(INOUT) :: u(:) ! Input at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Inputs - TYPE(IceFloe_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 + ErrMsg = '' + DstConstrStateData%DummyConstrStateVar = SrcConstrStateData%DummyConstrStateVar +end subroutine + +subroutine IceFloe_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) + type(IceFloe_ConstraintStateType), intent(inout) :: ConstrStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'IceFloe_DestroyConstrState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine IceFloe_PackConstrState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(IceFloe_ConstraintStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'IceFloe_PackConstrState' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyConstrStateVar) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine IceFloe_UnPackConstrState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(IceFloe_ConstraintStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'IceFloe_UnPackConstrState' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyConstrStateVar); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine IceFloe_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) + type(IceFloe_OtherStateType), intent(in) :: SrcOtherStateData + type(IceFloe_OtherStateType), intent(inout) :: DstOtherStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'IceFloe_CopyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + DstOtherStateData%DummyOtherState = SrcOtherStateData%DummyOtherState +end subroutine + +subroutine IceFloe_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) + type(IceFloe_OtherStateType), intent(inout) :: OtherStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'IceFloe_DestroyOtherState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine IceFloe_PackOtherState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(IceFloe_OtherStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'IceFloe_PackOtherState' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyOtherState) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine IceFloe_UnPackOtherState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(IceFloe_OtherStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'IceFloe_UnPackOtherState' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyOtherState); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine IceFloe_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(IceFloe_MiscVarType), intent(in) :: SrcMiscData + type(IceFloe_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'IceFloe_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + DstMiscData%DummyMiscVar = SrcMiscData%DummyMiscVar +end subroutine + +subroutine IceFloe_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(IceFloe_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'IceFloe_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine IceFloe_PackMisc(RF, Indata) + type(RegFile), intent(inout) :: RF + type(IceFloe_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'IceFloe_PackMisc' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyMiscVar) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine IceFloe_UnPackMisc(RF, OutData) + type(RegFile), intent(inout) :: RF + type(IceFloe_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'IceFloe_UnPackMisc' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyMiscVar); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine IceFloe_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(IceFloe_ParameterType), intent(in) :: SrcParamData + type(IceFloe_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'IceFloe_CopyParam' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcParamData%loadSeries)) then + LB(1:2) = lbound(SrcParamData%loadSeries) + UB(1:2) = ubound(SrcParamData%loadSeries) + if (.not. allocated(DstParamData%loadSeries)) then + allocate(DstParamData%loadSeries(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%loadSeries.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%loadSeries = SrcParamData%loadSeries + end if + DstParamData%iceVel = SrcParamData%iceVel + DstParamData%iceDirection = SrcParamData%iceDirection + DstParamData%minStrength = SrcParamData%minStrength + DstParamData%minStrengthNegVel = SrcParamData%minStrengthNegVel + DstParamData%defaultArea = SrcParamData%defaultArea + DstParamData%crushArea = SrcParamData%crushArea + DstParamData%coeffStressRate = SrcParamData%coeffStressRate + DstParamData%C(4) = SrcParamData%C(4) + DstParamData%dt = SrcParamData%dt + DstParamData%rampTime = SrcParamData%rampTime + if (allocated(SrcParamData%legX)) then + LB(1:1) = lbound(SrcParamData%legX) + UB(1:1) = ubound(SrcParamData%legX) + if (.not. allocated(DstParamData%legX)) then + allocate(DstParamData%legX(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%legX.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%legX = SrcParamData%legX + end if + if (allocated(SrcParamData%legY)) then + LB(1:1) = lbound(SrcParamData%legY) + UB(1:1) = ubound(SrcParamData%legY) + if (.not. allocated(DstParamData%legY)) then + allocate(DstParamData%legY(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%legY.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%legY = SrcParamData%legY + end if + if (allocated(SrcParamData%ks)) then + LB(1:1) = lbound(SrcParamData%ks) + UB(1:1) = ubound(SrcParamData%ks) + if (.not. allocated(DstParamData%ks)) then + allocate(DstParamData%ks(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ks.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%ks = SrcParamData%ks + end if + DstParamData%numLegs = SrcParamData%numLegs + DstParamData%iceType = SrcParamData%iceType + DstParamData%logUnitNum = SrcParamData%logUnitNum + DstParamData%singleLoad = SrcParamData%singleLoad + DstParamData%initFlag = SrcParamData%initFlag +end subroutine + +subroutine IceFloe_DestroyParam(ParamData, ErrStat, ErrMsg) + type(IceFloe_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'IceFloe_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ParamData%loadSeries)) then + deallocate(ParamData%loadSeries) + end if + if (allocated(ParamData%legX)) then + deallocate(ParamData%legX) + end if + if (allocated(ParamData%legY)) then + deallocate(ParamData%legY) + end if + if (allocated(ParamData%ks)) then + deallocate(ParamData%ks) + end if +end subroutine + +subroutine IceFloe_PackParam(RF, Indata) + type(RegFile), intent(inout) :: RF + type(IceFloe_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'IceFloe_PackParam' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%loadSeries) + call RegPack(RF, InData%iceVel) + call RegPack(RF, InData%iceDirection) + call RegPack(RF, InData%minStrength) + call RegPack(RF, InData%minStrengthNegVel) + call RegPack(RF, InData%defaultArea) + call RegPack(RF, InData%crushArea) + call RegPack(RF, InData%coeffStressRate) + call RegPack(RF, InData%C(4)) + call RegPack(RF, InData%dt) + call RegPack(RF, InData%rampTime) + call RegPackAlloc(RF, InData%legX) + call RegPackAlloc(RF, InData%legY) + call RegPackAlloc(RF, InData%ks) + call RegPack(RF, InData%numLegs) + call RegPack(RF, InData%iceType) + call RegPack(RF, InData%logUnitNum) + call RegPack(RF, InData%singleLoad) + call RegPack(RF, InData%initFlag) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine IceFloe_UnPackParam(RF, OutData) + type(RegFile), intent(inout) :: RF + type(IceFloe_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'IceFloe_UnPackParam' + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%loadSeries); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iceVel); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iceDirection); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%minStrength); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%minStrengthNegVel); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%defaultArea); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%crushArea); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%coeffStressRate); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%C(4)); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%dt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rampTime); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%legX); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%legY); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ks); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%numLegs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iceType); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%logUnitNum); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%singleLoad); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%initFlag); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine IceFloe_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) + type(IceFloe_InputType), intent(inout) :: SrcInputData + type(IceFloe_InputType), intent(inout) :: DstInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'IceFloe_CopyInput' + ErrStat = ErrID_None + ErrMsg = '' + call MeshCopy(SrcInputData%iceMesh, DstInputData%iceMesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine IceFloe_DestroyInput(InputData, ErrStat, ErrMsg) + type(IceFloe_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'IceFloe_DestroyInput' + ErrStat = ErrID_None + ErrMsg = '' + call MeshDestroy( InputData%iceMesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine IceFloe_PackInput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(IceFloe_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'IceFloe_PackInput' + if (RF%ErrStat >= AbortErrLev) return + call MeshPack(RF, InData%iceMesh) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine IceFloe_UnPackInput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(IceFloe_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'IceFloe_UnPackInput' + if (RF%ErrStat /= ErrID_None) return + call MeshUnpack(RF, OutData%iceMesh) ! iceMesh +end subroutine + +subroutine IceFloe_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(IceFloe_OutputType), intent(inout) :: SrcOutputData + type(IceFloe_OutputType), intent(inout) :: DstOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'IceFloe_CopyOutput' + ErrStat = ErrID_None + ErrMsg = '' + call MeshCopy(SrcOutputData%iceMesh, DstOutputData%iceMesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcOutputData%WriteOutput)) then + LB(1:1) = lbound(SrcOutputData%WriteOutput) + UB(1:1) = ubound(SrcOutputData%WriteOutput) + if (.not. allocated(DstOutputData%WriteOutput)) then + allocate(DstOutputData%WriteOutput(LB(1):UB(1)), 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 + end if +end subroutine + +subroutine IceFloe_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(IceFloe_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'IceFloe_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' + call MeshDestroy( OutputData%iceMesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(OutputData%WriteOutput)) then + deallocate(OutputData%WriteOutput) + end if +end subroutine + +subroutine IceFloe_PackOutput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(IceFloe_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'IceFloe_PackOutput' + if (RF%ErrStat >= AbortErrLev) return + call MeshPack(RF, InData%iceMesh) + call RegPackAlloc(RF, InData%WriteOutput) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine IceFloe_UnPackOutput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(IceFloe_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'IceFloe_UnPackOutput' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call MeshUnpack(RF, OutData%iceMesh) ! iceMesh + call RegUnpackAlloc(RF, OutData%WriteOutput); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine IceFloe_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(IceFloe_InputType), intent(inout) :: u(:) ! Input at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Inputs + type(IceFloe_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 = 'IceFloe_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 IceFloe_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL IceFloe_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 IceFloe_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 IceFloe_Input_ExtrapInterp - - - SUBROUTINE IceFloe_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'IceFloe_Input_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(u)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(u)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(u) - 1 + select case (order) + case (0) + call IceFloe_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call IceFloe_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call IceFloe_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(u) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE IceFloe_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. @@ -2317,41 +764,42 @@ SUBROUTINE IceFloe_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, Err ! !.................................................................................................................................. - TYPE(IceFloe_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 - TYPE(IceFloe_InputType), INTENT(INOUT) :: u2 ! Input at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs - TYPE(IceFloe_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 + TYPE(IceFloe_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 + TYPE(IceFloe_InputType), INTENT(INOUT) :: u2 ! Input at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs + TYPE(IceFloe_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 = 'IceFloe_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 + REAL(DbKi) :: t(2) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_Input_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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%iceMesh, u2%iceMesh, tin, u_out%iceMesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - END SUBROUTINE IceFloe_Input_ExtrapInterp1 - - - SUBROUTINE IceFloe_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + CALL MeshExtrapInterp1(u1%iceMesh, u2%iceMesh, tin, u_out%iceMesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) +END SUBROUTINE + +SUBROUTINE IceFloe_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. @@ -2365,101 +813,102 @@ SUBROUTINE IceFloe_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ! !.................................................................................................................................. - TYPE(IceFloe_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 > t3 - TYPE(IceFloe_InputType), INTENT(INOUT) :: u2 ! Input at t2 > t3 - TYPE(IceFloe_InputType), INTENT(INOUT) :: u3 ! Input at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs - TYPE(IceFloe_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 + TYPE(IceFloe_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 > t3 + TYPE(IceFloe_InputType), INTENT(INOUT) :: u2 ! Input at t2 > t3 + TYPE(IceFloe_InputType), INTENT(INOUT) :: u3 ! Input at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs + TYPE(IceFloe_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 = 'IceFloe_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) - + 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) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_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 + 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 + 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 + 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%iceMesh, u2%iceMesh, u3%iceMesh, tin, u_out%iceMesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - END SUBROUTINE IceFloe_Input_ExtrapInterp2 - - - SUBROUTINE IceFloe_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(IceFloe_OutputType), INTENT(INOUT) :: y(:) ! Output at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Outputs - TYPE(IceFloe_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 + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + CALL MeshExtrapInterp2(u1%iceMesh, u2%iceMesh, u3%iceMesh, tin, u_out%iceMesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) +END SUBROUTINE + +subroutine IceFloe_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(IceFloe_OutputType), intent(inout) :: y(:) ! Output at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Outputs + type(IceFloe_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 = 'IceFloe_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 IceFloe_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL IceFloe_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 IceFloe_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 IceFloe_Output_ExtrapInterp - - - SUBROUTINE IceFloe_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'IceFloe_Output_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(y)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(y)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(y) - 1 + select case (order) + case (0) + call IceFloe_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call IceFloe_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call IceFloe_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(y) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE IceFloe_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. @@ -2471,49 +920,47 @@ SUBROUTINE IceFloe_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, Er ! !.................................................................................................................................. - TYPE(IceFloe_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 - TYPE(IceFloe_OutputType), INTENT(INOUT) :: y2 ! Output at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs - TYPE(IceFloe_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 + TYPE(IceFloe_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 + TYPE(IceFloe_OutputType), INTENT(INOUT) :: y2 ! Output at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs + TYPE(IceFloe_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 = 'IceFloe_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 + REAL(DbKi) :: t(2) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_Output_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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%iceMesh, y2%iceMesh, tin, y_out%iceMesh, 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 IceFloe_Output_ExtrapInterp1 - - - SUBROUTINE IceFloe_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + CALL MeshExtrapInterp1(y1%iceMesh, y2%iceMesh, tin, y_out%iceMesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + END IF ! check if allocated +END SUBROUTINE + +SUBROUTINE IceFloe_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. @@ -2527,56 +974,52 @@ SUBROUTINE IceFloe_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat ! !.................................................................................................................................. - TYPE(IceFloe_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 > t3 - TYPE(IceFloe_OutputType), INTENT(INOUT) :: y2 ! Output at t2 > t3 - TYPE(IceFloe_OutputType), INTENT(INOUT) :: y3 ! Output at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs - TYPE(IceFloe_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 + TYPE(IceFloe_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 > t3 + TYPE(IceFloe_OutputType), INTENT(INOUT) :: y2 ! Output at t2 > t3 + TYPE(IceFloe_OutputType), INTENT(INOUT) :: y3 ! Output at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs + TYPE(IceFloe_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 = 'IceFloe_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) - + 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) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_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 + 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 + 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 + 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%iceMesh, y2%iceMesh, y3%iceMesh, tin, y_out%iceMesh, 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 IceFloe_Output_ExtrapInterp2 - + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + CALL MeshExtrapInterp2(y1%iceMesh, y2%iceMesh, y3%iceMesh, tin, y_out%iceMesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + a3*y3%WriteOutput + END IF ! check if allocated +END SUBROUTINE END MODULE IceFloe_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/inflowwind/CMakeLists.txt b/modules/inflowwind/CMakeLists.txt index 7e7005d9b3..1e9b3a3063 100644 --- a/modules/inflowwind/CMakeLists.txt +++ b/modules/inflowwind/CMakeLists.txt @@ -19,10 +19,11 @@ if (GENERATE_TYPES) generate_f90_types(src/InflowWind_IO.txt ${CMAKE_CURRENT_LIST_DIR}/src/InflowWind_IO_Types.f90 -noextrap) generate_f90_types(src/Lidar.txt ${CMAKE_CURRENT_LIST_DIR}/src/Lidar_Types.f90) generate_f90_types(src/InflowWind.txt ${CMAKE_CURRENT_LIST_DIR}/src/InflowWind_Types.f90) + generate_f90_types(src/InflowWind_Driver_Registry.txt ${CMAKE_CURRENT_LIST_DIR}/src/InflowWind_Driver_Types.f90 -noextrap) endif() # InflowWind object library -add_library(ifwlib +add_library(ifwlib STATIC src/IfW_FlowField_Types.f90 src/IfW_FlowField.f90 src/InflowWind_IO_Types.f90 diff --git a/modules/inflowwind/python-lib/inflowwind_library.py b/modules/inflowwind/python-lib/inflowwind_library.py index 26e6eb599a..bc741443e8 100644 --- a/modules/inflowwind/python-lib/inflowwind_library.py +++ b/modules/inflowwind/python-lib/inflowwind_library.py @@ -52,6 +52,10 @@ class InflowWindLib(CDLL): # here. error_msg_c_len = 1025 + # NOTE: the length of the name used for any output file written by the + # IfW Fortran code is 1025. + default_str_c_len = 1025 + def __init__(self, library_path): super().__init__(library_path) self.library_path = library_path @@ -59,6 +63,9 @@ def __init__(self, library_path): self._initialize_routines() self.ended = False # For error handling at end + # Input file handling + self.IfWinputPass = 1 # Assume passing of input file as a string + # Create buffers for class data self.abort_error_level = 4 self.error_status_c = c_int(0) @@ -84,18 +91,27 @@ def __init__(self, library_path): self.numChannels = 0 # Number of channels returned + # flags + self.debuglevel = 0 # 0-4 levels + + # OutRootName + # If HD writes a file (echo, summary, or other), use this for the + # root of the file name. + self.outRootName = "Output_ifwlib_default" + def _initialize_routines(self): """ Initialize the Python handles to necessary routines in the InflowWind library. """ self.IfW_C_Init.argtypes = [ + POINTER(c_int), # IfW input file passed as string POINTER(c_char_p), # input file string POINTER(c_int), # input file string length - POINTER(c_char_p), # uniform file string - POINTER(c_int), # uniform file string length + POINTER(c_char), # OutRootName POINTER(c_int), # numWindPts POINTER(c_double), # dt + POINTER(c_int), # debuglevel POINTER(c_int), # number of channels POINTER(c_char), # output channel names POINTER(c_char), # output channel units @@ -121,29 +137,29 @@ def _initialize_routines(self): self.IfW_C_End.restype = c_int - def ifw_init(self, input_string_array, uniform_string_array): + def ifw_init(self, IfW_input_string_array): """ Call the initialization routine in the InflowWind library. """ # Set up inputs: Pass single NULL joined string - input_string = '\x00'.join(input_string_array) - input_string = input_string.encode('utf-8') - input_string_length = len(input_string) - - uniform_string = '\x00'.join(uniform_string_array) - uniform_string = uniform_string.encode('utf-8') - uniform_string_length = len(uniform_string) - + IfW_input_string = '\x00'.join(IfW_input_string_array) + IfW_input_string = IfW_input_string.encode('utf-8') + IfW_input_string_length = len(IfW_input_string) + + # Rootname for ADI output files (echo etc). + _outRootName_c = create_string_buffer((self.outRootName.ljust(self.default_str_c_len)).encode('utf-8')) + self._numChannels_c = c_int(0) self.IfW_C_Init( - c_char_p(input_string), # IN: input file string - byref(c_int(input_string_length)), # IN: input file string length - c_char_p(uniform_string), # IN: uniform file string - byref(c_int(uniform_string_length)), # IN: uniform file string length + byref(c_int(self.IfWinputPass)), # IN: IfW input file is passed + c_char_p(IfW_input_string), # IN: input file string + byref(c_int(IfW_input_string_length)), # IN: input file string length + _outRootName_c, # IN: rootname for ADI file writing byref(c_int(self.numWindPts)), # IN: number of wind points byref(c_double(self.dt)), # IN: time step (dt) + byref(c_int(self.debuglevel)), # IN: debuglevel byref(self._numChannels_c), # OUT: number of channels self._channel_names_c, # OUT: output channel names as c_char self._channel_units_c, # OUT: output channel units as c_char diff --git a/modules/inflowwind/src/IfW_C_Binding.f90 b/modules/inflowwind/src/IfW_C_Binding.f90 index fe02e36f40..8299d6010f 100644 --- a/modules/inflowwind/src/IfW_C_Binding.f90 +++ b/modules/inflowwind/src/IfW_C_Binding.f90 @@ -32,26 +32,39 @@ MODULE InflowWind_C_BINDING PUBLIC :: IfW_C_CalcOutput PUBLIC :: IfW_C_End + !------------------------------------------------------------------------------------ ! Version info for display type(ProgDesc), parameter :: version = ProgDesc( 'InflowWind library', '', '' ) - ! Accessible to all routines inside module - TYPE(InflowWind_InputType) , SAVE :: InputData !< Inputs to InflowWind - TYPE(InflowWind_InitInputType) , SAVE :: InitInp - TYPE(InflowWind_InitOutputType) , SAVE :: InitOutData !< Initial output data -- Names, units, and version info. - TYPE(InflowWind_ParameterType) , SAVE :: p !< Parameters - TYPE(InflowWind_ContinuousStateType) , SAVE :: ContStates !< Initial continuous states - TYPE(InflowWind_DiscreteStateType) , SAVE :: DiscStates !< Initial discrete states - TYPE(InflowWind_ConstraintStateType) , SAVE :: ConstrStates !< Constraint states at Time - TYPE(InflowWind_OtherStateType) , SAVE :: OtherStates !< Initial other/optimization states - TYPE(InflowWind_OutputType) , SAVE :: y !< Initial output (outputs are not calculated; only the output mesh is initialized) - TYPE(InflowWind_MiscVarType) , SAVE :: m !< Misc variables for optimization (not copied in glue code) - - ! This must exactly match the value in the Python interface. We are not using the variable 'ErrMsgLen' - ! so that we avoid issues if ErrMsgLen changes in the NWTC Library. If the value of ErrMsgLen does change - ! in the NWTC Library, ErrMsgLen_C (and the equivalent value in the Python interface) can be updated - ! to be equivalent to ErrMsgLen + 1, but the logic exists to correctly handle different lengths of the strings - integer(IntKi), parameter :: ErrMsgLen_C=1025 ! Numerical equivalent of ErrMsgLen + 1 + !------------------------------------------------------------------------------------ + ! Debugging: DebugLevel -- passed at PreInit + ! 0 - none + ! 1 - some summary info + ! 2 - above + all position/orientation info + ! 3 - above + input files (if direct passed) + ! 4 - above + meshes + integer(IntKi) :: DebugLevel = 0 + + !------------------------------------------------------------------------------------ + ! Primary IfW data derived types + type(InflowWind_InputType) :: InputData !< Inputs to InflowWind + type(InflowWind_InitInputType) :: InitInp + type(InflowWind_InitOutputType) :: InitOutData !< Initial output data -- Names, units, and version info. + type(InflowWind_ParameterType) :: p !< Parameters + type(InflowWind_ContinuousStateType) :: ContStates !< Initial continuous states + type(InflowWind_DiscreteStateType) :: DiscStates !< Initial discrete states + type(InflowWind_ConstraintStateType) :: ConstrStates !< Constraint states at Time + type(InflowWind_OtherStateType) :: OtherStates !< Initial other/optimization states + type(InflowWind_OutputType) :: y !< Initial output (outputs are not calculated; only the output mesh is initialized) + type(InflowWind_MiscVarType) :: m !< Misc variables for optimization (not copied in glue code) + + !------------------------------------------------------------------------------------ + ! Error handling + ! This must exactly match the value in the python-lib. If ErrMsgLen changes at + ! some point in the nwtc-library, this should be updated, but the logic exists + ! to correctly handle different lengths of the strings + integer(IntKi), parameter :: ErrMsgLen_C = 1025 + integer(IntKi), parameter :: IntfStrLen = 1025 ! length of other strings through the C interface @@ -78,35 +91,39 @@ end subroutine SetErr !=============================================================================================================== !--------------------------------------------- IFW INIT -------------------------------------------------------- !=============================================================================================================== -SUBROUTINE IfW_C_Init(InputFileString_C, InputFileStringLength_C, InputUniformString_C, InputUniformStringLength_C, NumWindPts_C, DT_C, NumChannels_C, OutputChannelNames_C, OutputChannelUnits_C, ErrStat_C, ErrMsg_C) BIND (C, NAME='IfW_C_Init') +SUBROUTINE IfW_C_Init(IfWinputFilePassed, IfWinputFileString_C, IfWinputFileStringLength_C, OutRootName_C, & + NumWindPts_C, DT_C, DebugLevel_in, NumChannels_C, OutputChannelNames_C, OutputChannelUnits_C, & + ErrStat_C, ErrMsg_C) BIND (C, NAME='IfW_C_Init') IMPLICIT NONE #ifndef IMPLICIT_DLLEXPORT !DEC$ ATTRIBUTES DLLEXPORT :: IfW_C_Init !GCC$ ATTRIBUTES DLLEXPORT :: IfW_C_Init #endif - TYPE(C_PTR) , INTENT(IN ) :: InputFileString_C - INTEGER(C_INT) , INTENT(IN ) :: InputFileStringLength_C - TYPE(C_PTR) , INTENT(IN ) :: InputUniformString_C - INTEGER(C_INT) , INTENT(IN ) :: InputUniformStringLength_C - INTEGER(C_INT) , INTENT(IN ) :: NumWindPts_C - REAL(C_DOUBLE) , INTENT(IN ) :: DT_C - INTEGER(C_INT) , INTENT( OUT) :: NumChannels_C - CHARACTER(KIND=C_CHAR) , INTENT( OUT) :: OutputChannelNames_C(ChanLen*MaxOutPts+1) - CHARACTER(KIND=C_CHAR) , INTENT( OUT) :: OutputChannelUnits_C(ChanLen*MaxOutPts+1) - INTEGER(C_INT) , INTENT( OUT) :: ErrStat_C - CHARACTER(KIND=C_CHAR) , INTENT( OUT) :: ErrMsg_C(ErrMsgLen_C) - - ! Local Variables - CHARACTER(kind=C_char, len=InputFileStringLength_C), POINTER :: InputFileString !< Input file as a single string with NULL chracter separating lines - CHARACTER(kind=C_char, len=InputUniformStringLength_C), POINTER :: UniformFileString !< Input file as a single string with NULL chracter separating lines -- Uniform wind file - - REAL(DbKi) :: TimeInterval - INTEGER :: ErrStat !< aggregated error message - CHARACTER(ErrMsgLen) :: ErrMsg !< aggregated error message - INTEGER :: ErrStat2 !< temporary error status from a call - CHARACTER(ErrMsgLen) :: ErrMsg2 !< temporary error message from a call - INTEGER :: i,j,k - character(*), parameter :: RoutineName = 'IfW_C_Init' !< for error handling + integer(c_int), intent(in ) :: IfWinputFilePassed !< Write VTK outputs [0: none, 1: init only, 2: animation] + type(c_ptr), intent(in ) :: IfWinputFileString_C !< Input file as a single string with lines deliniated by C_NULL_CHAR + integer(c_int), intent(in ) :: IfWinputFileStringLength_C !< lenght of the input file string + character(kind=c_char), intent(in ) :: OutRootName_C(IntfStrLen) !< Root name to use for echo files and other + integer(c_int), intent(in ) :: NumWindPts_C + real(c_double), intent(in ) :: DT_C + integer(c_int), intent(in ) :: DebugLevel_in + integer(c_int), intent( out) :: NumChannels_C + character(kind=c_char), intent( out) :: OutputChannelNames_C(ChanLen*MaxOutPts+1) + character(kind=c_char), intent( out) :: OutputChannelUnits_C(ChanLen*MaxOutPts+1) + integer(c_int), intent( out) :: ErrStat_C + character(kind=c_char), intent( out) :: ErrMsg_C(ErrMsgLen_C) + + ! local variables + character(IntfStrLen) :: OutRootName !< Root name to use for echo files and other + character(IntfStrLen) :: TmpFileName !< Temporary file name if not passing AD or IfW input file contents directly + character(kind=c_char, len=IfWinputFileStringLength_C), pointer :: IfWinputFileString !< Input file as a single string with NULL chracter separating lines + + real(DbKi) :: TimeInterval + integer :: ErrStat !< aggregated error message + character(ErrMsgLen) :: ErrMsg !< aggregated error message + integer :: ErrStat2 !< temporary error status from a call + character(ErrMsgLen) :: ErrMsg2 !< temporary error message from a call + integer :: i,j,k + character(*), parameter :: RoutineName = 'IfW_C_Init' !< for error handling ! Initialize error handling ErrStat = ErrID_None @@ -116,26 +133,65 @@ SUBROUTINE IfW_C_Init(InputFileString_C, InputFileStringLength_C, InputUniformSt CALL DispCopyrightLicense( version%Name ) CALL DispCompileRuntimeInfo( version%Name ) + + ! interface debugging + DebugLevel = int(DebugLevel_in,IntKi) + + ! Input files + OutRootName = TRANSFER( OutRootName_C, OutRootName ) + i = INDEX(OutRootName,C_NULL_CHAR) - 1 ! if this has a c null character at the end... + if ( i > 0 ) OutRootName = OutRootName(1:I) ! remove it + + ! if non-zero, show all passed data here. Then check valid values + if (DebugLevel /= 0_IntKi) then + call WrScr(" Interface debugging level "//trim(Num2Lstr(DebugLevel))//" requested.") + call ShowPassedData() + endif + ! check valid debug level + if (DebugLevel < 0_IntKi) then + ErrStat2 = ErrID_Fatal + ErrMsg2 = "Interface debug level must be 0 or greater"//NewLine// & + " 0 - none"//NewLine// & + " 1 - some summary info and variables passed through interface"//NewLine// & + " 2 - above + all position/orientation info"//NewLine// & + " 3 - above + input files (if direct passed)"//NewLine// & + " 4 - above + meshes" + if (Failed()) return; + endif + + ! For debugging the interface: + if (DebugLevel > 0) then + call ShowPassedData() + endif + ! Get fortran pointer to C_NULL_CHAR deliniated input file as a string - CALL C_F_pointer(InputFileString_C, InputFileString) - CALL C_F_pointer(InputUniformString_C, UniformFileString) - - ! Store string-inputs as type FileInfoType within InflowWind_InitInputType - CALL InitFileInfo(InputFileString, InitInp%PassedFileData, ErrStat2, ErrMsg2); if (Failed()) return - InitInp%UseInputFile = .FALSE. - - ! store Uniform File strings if they are non-zero sized - if (len(UniformFileString) > 1) then - CALL InitFileInfo(UniformFileString, InitInp%WindType2Data, ErrStat2, ErrMsg2); if (Failed()) return - InitInp%WindType2UseInputFile = .FALSE. - else ! Default to reading from disk - InitInp%WindType2UseInputFile = .TRUE. + CALL C_F_pointer(IfWinputFileString_C, IfWinputFileString) + + ! Format IfW input file contents + if (IfWinputFilePassed==1_c_int) then + InitInp%FilePassingMethod = 1_IntKi ! Don't try to read an input -- use passed data instead (blades and AF tables not passed) using FileInfoType + InitInp%InputFileName = "passed_ifw_file" ! not actually used + call InitFileInfo(IfWinputFileString, InitInp%PassedFileInfo, ErrStat2, ErrMsg2); if (Failed()) return + else + InitInp%FilePassingMethod = 0_IntKi ! Read input info from a primary input file + i = min(IntfStrLen,IfWinputFileStringLength_C) + TmpFileName = '' + TmpFileName(1:i) = IfWinputFileString(1:i) + i = INDEX(TmpFileName,C_NULL_CHAR) - 1 ! if this has a c null character at the end... + if ( i > 0 ) TmpFileName = TmpFileName(1:I) ! remove it + InitInp%InputFileName = TmpFileName + endif + + ! For diagnostic purposes, the following can be used to display the contents + ! of the InFileInfo data structure. + ! CU is the screen -- system dependent. + if (DebugLevel >= 3) then + if (IfWinputFilePassed==1_c_int) call Print_FileInfo_Struct( CU, InitInp%PassedFileInfo ) endif ! Set other inputs for calling InflowWind_Init - InitInp%NumWindPoints = NumWindPts_C - InitInp%InputFileName = "passed_ifw_file" ! dummy - InitInp%RootName = "ifwRoot" ! used for making echo files + InitInp%NumWindPoints = int(NumWindPts_C, IntKi) + InitInp%RootName = OutRootName ! used for making echo files TimeInterval = REAL(DT_C, DbKi) ! Call the main subroutine InflowWind_Init - only need InitInp and TimeInterval as inputs, the rest are set by InflowWind_Init @@ -174,6 +230,30 @@ logical function Failed() end function Failed subroutine Cleanup() ! NOTE: we are ignoring any error reporting from here end subroutine Cleanup + + !> This subroutine prints out all the variables that are passed in. Use this only + !! for debugging the interface on the Fortran side. + subroutine ShowPassedData() + character(1) :: TmpFlag + integer :: i,j + call WrSCr("") + call WrScr("-----------------------------------------------------------") + call WrScr("Interface debugging: Variables passed in through interface") + call WrScr(" ADI_C_Init") + call WrScr(" --------------------------------------------------------") + call WrScr(" FileInfo") + TmpFlag="F"; if (IfWinputFilePassed==1_c_int) TmpFlag="T" + call WrScr(" IfWinputFilePassed_C "//TmpFlag ) + call WrScr(" IfWinputFileString_C (ptr addr)"//trim(Num2LStr(LOC(IfWinputFileString_C))) ) + call WrScr(" IfWinputFileStringLength_C "//trim(Num2LStr( IfWinputFileStringLength_C )) ) + call WrScr(" OutRootName "//trim(OutRootName) ) + call WrScr(" Input variables") + call WrScr(" NumWindPts_C "//trim(Num2LStr( NumWindPts_C)) ) + call WrScr(" Time variables") + call WrScr(" DT_C "//trim(Num2LStr( DT_C )) ) + call WrScr("-----------------------------------------------------------") + end subroutine ShowPassedData + END SUBROUTINE IfW_C_Init !=============================================================================================================== diff --git a/modules/inflowwind/src/IfW_FlowField.f90 b/modules/inflowwind/src/IfW_FlowField.f90 index d20e1815d5..546359d16e 100644 --- a/modules/inflowwind/src/IfW_FlowField.f90 +++ b/modules/inflowwind/src/IfW_FlowField.f90 @@ -26,7 +26,7 @@ module IfW_FlowField public IfW_FlowField_GetVelAcc public IfW_UniformField_CalcAccel, IfW_Grid3DField_CalcAccel -public IfW_UniformWind_GetOP +public IfW_UniformWind_GetOP, IfW_UniformWind_Perturb ! for linearization public Grid3D_to_Uniform, Uniform_to_Grid3D integer(IntKi), parameter :: WindProfileType_None = -1 !< don't add wind profile; already included in input @@ -40,7 +40,7 @@ module IfW_FlowField !> IfW_FlowField_GetVelAcc gets the velocities (and accelerations) at the given point positions. !! Accelerations are only calculated if the AccelUVW array is allocated. -subroutine IfW_FlowField_GetVelAcc(FF, IStart, Time, PositionXYZ, VelocityUVW, AccelUVW, ErrStat, ErrMsg) +subroutine IfW_FlowField_GetVelAcc(FF, IStart, Time, PositionXYZ, VelocityUVW, AccelUVW, ErrStat, ErrMsg, BoxExceedAllow, PosOffset) type(FlowFieldType), intent(in) :: FF !< FlowField data structure integer(IntKi), intent(in) :: IStart !< Start index for returning velocities for external field @@ -50,22 +50,25 @@ subroutine IfW_FlowField_GetVelAcc(FF, IStart, Time, PositionXYZ, VelocityUVW, A real(ReKi), allocatable, intent(inout) :: AccelUVW(:, :) !< Array of acceleration outputs integer(IntKi), intent(out) :: ErrStat !< Error status character(*), intent(out) :: ErrMsg !< Error message + logical, optional, intent(in) :: BoxExceedAllow !< Flag to allow wind box to be exceeded (Lidar & OLAF) + real(ReKi), optional, intent(in) :: PosOffset(3) !< XYZ offset to position array character(*), parameter :: RoutineName = "IfW_FlowField_GetVelAcc" - integer(IntKi) :: i - integer(IntKi) :: NumPoints - logical :: OutputAccel, AddMeanAfterInterp - real(ReKi), allocatable :: Position(:, :) - integer(IntKi) :: Grid3D_AccelInterp integer(IntKi) :: TmpErrStat character(ErrMsgLen) :: TmpErrMsg + ! All Wind Types + real(ReKi), allocatable :: Position(:, :) + real(ReKi) :: PosOffset_Local(3) + logical :: OutputAccel, AddMeanAfterInterp + integer(IntKi) :: i, NumPoints, IEnd + ! Uniform Field type(UniformField_Interp) :: UFopVel, UFopAcc - + ! Grid3D Field - real(ReKi) :: Xi(3) - real(ReKi) :: VelCell(8, 3), AccCell(8, 3) + real(ReKi) :: Xi(3), VelCell(8, 3), AccCell(8, 3) + integer(IntKi) :: Grid3D_AccelInterp logical :: Is3D logical :: GridExceedAllow ! is this point allowed to exceed bounds of wind grid @@ -107,10 +110,18 @@ subroutine IfW_FlowField_GetVelAcc(FF, IStart, Time, PositionXYZ, VelocityUVW, A ! Copy positions or transform based on wind box rotation if (FF%RotateWindBox) then - do i = 1, NumPoints - Position(:, i) = GetPrimePosition(PositionXYZ(:, i)) - end do - else + if (present(PosOffset)) then + do i = 1, NumPoints + Position(:, i) = GetPrimePosition(PositionXYZ(:, i) + PosOffset) + end do + else + do i = 1, NumPoints + Position(:, i) = GetPrimePosition(PositionXYZ(:, i)) + end do + end if + else if (present(PosOffset)) then + Position = PositionXYZ + spread(PosOffset, 2, NumPoints) + else Position = PositionXYZ end if @@ -166,6 +177,7 @@ subroutine IfW_FlowField_GetVelAcc(FF, IStart, Time, PositionXYZ, VelocityUVW, A VelocityUVW(:, i) = 0.0_ReKi end if end do + end if case (Grid3D_FieldType) @@ -193,6 +205,15 @@ subroutine IfW_FlowField_GetVelAcc(FF, IStart, Time, PositionXYZ, VelocityUVW, A ! Store flag value since it doesn't change during loop AddMeanAfterInterp = FF%Grid3D%AddMeanAfterInterp + ! Points can exceed grid limits + if (present(BoxExceedAllow)) then + GridExceedAllow = FF%Grid3D%BoxExceedAllow .and. BoxExceedAllow + else if (FF%Grid3D%BoxExceedAllowDrv) then + GridExceedAllow = .true. + else + GridExceedAllow = .false. + end if + ! Loop through points do i = 1, NumPoints @@ -203,9 +224,6 @@ subroutine IfW_FlowField_GetVelAcc(FF, IStart, Time, PositionXYZ, VelocityUVW, A cycle end if - ! Is this point allowed beyond the bounds of the wind box? - GridExceedAllow = FF%Grid3D%BoxExceedAllowF .and. (i >= FF%Grid3D%BoxExceedAllowIdx) - ! Calculate grid cells for interpolation, returns velocity and acceleration ! components at corners of grid cell containing time and position. Also ! returns interpolation values Xi. @@ -247,7 +265,7 @@ subroutine IfW_FlowField_GetVelAcc(FF, IStart, Time, PositionXYZ, VelocityUVW, A !------------------------------------------------------------------------- ! If field is not allocated, return error - if (.not. allocated(FF%Grid4D%Vel)) then + if (.not. associated(FF%Grid4D%Vel)) then call SetErrStat(ErrID_Fatal, "Grid4D Field not allocated", ErrStat, ErrMsg, RoutineName) return end if @@ -255,17 +273,16 @@ subroutine IfW_FlowField_GetVelAcc(FF, IStart, Time, PositionXYZ, VelocityUVW, A ! Loop through points do i = 1, NumPoints - ! If height less than or equal to zero, set velocity to zero - if (Position(3, i) <= 0.0_ReKi) then - VelocityUVW(:, i) = 0.0_ReKi - cycle - end if - + ! If height greater than zero, calculate velocity, otherwise zero + if (Position(3, i) > 0.0_ReKi) then call Grid4DField_GetVel(FF%Grid4D, Time, Position(:, i), VelocityUVW(:, i), TmpErrStat, TmpErrMsg) if (TmpErrStat >= AbortErrLev) then call SetErrStat(TmpErrStat, TmpErrMsg, ErrStat, ErrMsg, RoutineName) return end if + else + VelocityUVW(:, i) = 0.0_ReKi + end if end do case (Point_FieldType) @@ -280,8 +297,15 @@ subroutine IfW_FlowField_GetVelAcc(FF, IStart, Time, PositionXYZ, VelocityUVW, A return end if - ! Set velocities directly from velocity array - VelocityUVW = FF%Points%Vel(:, IStart:IStart + NumPoints - 1) + ! Calculate end index + IEnd = IStart + NumPoints - 1 + + ! If start and end indices are valid, copy velocities, otherwise zero + if (IStart >= 1 .and. IEnd < size(FF%Points%Vel)) then + VelocityUVW = FF%Points%Vel(:, IStart:IEnd) + else + VelocityUVW = 0.0_ReKi + end if case (User_FieldType) @@ -289,7 +313,7 @@ subroutine IfW_FlowField_GetVelAcc(FF, IStart, Time, PositionXYZ, VelocityUVW, A ! User Flow Field !------------------------------------------------------------------------- - call SetErrStat(ErrID_Fatal, "User Field not to be implemented", ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, "User Field not implemented", ErrStat, ErrMsg, RoutineName) return case default @@ -692,7 +716,7 @@ subroutine IfW_UniformWind_GetOP(UF, t, InterpCubic, OP_out) type(UniformFieldType), intent(IN) :: UF !< Parameters real(DbKi), intent(IN) :: t !< Current simulation time in seconds logical, intent(in) :: InterpCubic !< flag for using cubic interpolation - real(ReKi), intent(OUT) :: OP_out(2) !< operating point (HWindSpeed and PLexp + real(ReKi), intent(OUT) :: OP_out(3) !< operating point (HWindSpeed, PLexp, and AngleH) type(UniformField_Interp) :: op ! interpolated values of InterpParams @@ -705,9 +729,22 @@ subroutine IfW_UniformWind_GetOP(UF, t, InterpCubic, OP_out) OP_out(1) = op%VelH OP_out(2) = op%ShrV + OP_out(3) = op%AngleH +end subroutine + +!> Routine to perturb the wind extended outputs (needed by AeroDyn) +!! NOTE: we are not passing the pointer here, but doing pass by reference to the FlowField since +!! this can only be used with linearization, and linearization requires using Uniform winds. +subroutine IfW_UniformWind_Perturb(FF_perturb, du) + type(FlowFieldType), intent(INOUT) :: FF_perturb !< Parameters to be modified + real(R8Ki), intent(IN ) :: du(3) !< perturbations to apply + FF_perturb%Uniform%VelH(:) = FF_perturb%Uniform%VelH(:) + du(1) + FF_perturb%Uniform%ShrV(:) = FF_perturb%Uniform%ShrV(:) + du(2) + FF_perturb%PropagationDir = FF_perturb%PropagationDir + du(3) end subroutine + subroutine Grid3DField_GetCell(G3D, Time, Position, CalcAccel, AllowExtrap, & VelCell, AccCell, Xi, Is3D, ErrStat, ErrMsg) @@ -1638,6 +1675,8 @@ subroutine Grid4DField_GetVel(G4D, Time, Position, Velocity, ErrStat, ErrMsg) end if Indx_Hi(i) = min(Indx_Lo(i) + 1, G4D%n(i)) ! make sure it's a valid index end do + Indx_Lo = Indx_Lo-1 + Indx_Hi = Indx_Hi-1 !---------------------------------------------------------------------------- ! Clamp isopc to [-1, 1] so we don't extrapolate (effectively nearest neighbor) diff --git a/modules/inflowwind/src/IfW_FlowField.txt b/modules/inflowwind/src/IfW_FlowField.txt index dafaa1871f..28d1fc208d 100644 --- a/modules/inflowwind/src/IfW_FlowField.txt +++ b/modules/inflowwind/src/IfW_FlowField.txt @@ -88,17 +88,15 @@ typedef ^ ^ ReKi PLExp typedef ^ ^ ReKi Z0 - 0 - "Surface roughness length (used for LOG wind profile type only)" - typedef ^ ^ ReKi VLinShr - 0 - "Vertical linear wind shear coefficient (used for vertical linear wind profile type only)" - typedef ^ ^ ReKi HLinShr - 0 - "Horizontal linear wind shear coefficient (used for horizontal wind profile type only)" - -typedef ^ ^ LOGICAL BoxExceedAllowF - .FALSE. - "Flag to allow Extrapolation winds outside box starting at this index (for OLAF wakes and LidarSim)" - -typedef ^ ^ IntKi BoxExceedAllowIdx - -1 - "Extrapolate winds outside box starting at this index (for OLAF wakes and LidarSim)" - -typedef ^ ^ LOGICAL BoxExceedWarned - .FALSE. - "Has a warning been issued for points extrapolated beyond FFWind grid" - - +typedef ^ ^ LOGICAL BoxExceedAllow - .FALSE. - "Flag to allow Extrapolation winds outside box starting at this index (for OLAF wakes and LidarSim)" - +typedef ^ ^ LOGICAL BoxExceedAllowDrv - .FALSE. - "Flag to allow Extrapolation winds outside box set by driver" - #---------------------------------------------------------------------------------------------------------------------------------- typedef ^ Grid4DFieldType IntKi n 4 - - "number of evenly-spaced grid points in the x, y, z, and t directions" - typedef ^ ^ DbKi delta 4 - - "size between 2 consecutive grid points in each grid direction" "m,m,m,s" typedef ^ ^ ReKi pZero 3 - - "fixed position of the XYZ grid (i.e., XYZ coordinates of m%V(:,1,1,1,:))" "m" -typedef ^ ^ SiKi Vel ::::: - - "this is the 4-d velocity field for each wind component [{uvw},nx,ny,nz,nt]" - -typedef ^ ^ DbKi TimeStart - - - "this is the time where the first time grid in m%V starts (i.e, the time associated with m%V(:,:,:,:,1))" s +typedef ^ ^ SiKi *Vel ::::: - - "this is the 4-d velocity field for each wind component [{uvw},nx,ny,nz,nt]" - +typedef ^ ^ ReKi TimeStart - - - "this is the time where the first time grid in m%V starts (i.e, the time associated with m%V(:,:,:,:,1))" s typedef ^ ^ ReKi RefHeight - - - "reference height; used to center the wind" meters #---------------------------------------------------------------------------------------------------------------------------------- @@ -110,13 +108,13 @@ typedef ^ UserFieldType ReKi RefHeight #---------------------------------------------------------------------------------------------------------------------------------- typedef ^ FlowFieldType IntKi FieldType - 0 - "Switch for flow field type {1=Uniform, 2=Grid, 3=User, 4=External}" - typedef ^ ^ ReKi RefPosition 3 0.0_ReKi - "Reference position (point where box is rotated)" meters -typedef ^ ^ ReKi PropagationDir - - - "Direction of wind propagation" radians -typedef ^ ^ ReKi VFlowAngle - - - "Vertical (upflow) angle" radians +typedef ^ ^ ReKi PropagationDir - 0.0_ReKi - "Direction of wind propagation" radians +typedef ^ ^ ReKi VFlowAngle - 0.0_ReKi - "Vertical (upflow) angle" radians typedef ^ ^ logical VelInterpCubic - .false. - "Velocity interpolation order in time (1=linear; 3=cubic) [Used with WindType=2,3,4,5,7]" - typedef ^ ^ logical RotateWindBox - .false. - "flag indicating if the wind will be rotated" - typedef ^ ^ logical AccFieldValid - .false. - "flag indicating that acceleration field has been calculated" - -typedef ^ ^ ReKi RotToWind {3}{3} - - "Rotation matrix for rotating from the global XYZ coordinate system to the wind coordinate system (wind along X')" - -typedef ^ ^ ReKi RotFromWind {3}{3} - - "Rotation matrix for rotating from the wind coordinate system (wind along X') back to the global XYZ coordinate system. Equal to TRANSPOSE(RotToWind)" - +typedef ^ ^ ReKi RotToWind {3}{3} 0.0_ReKi - "Rotation matrix for rotating from the global XYZ coordinate system to the wind coordinate system (wind along X')" - +typedef ^ ^ ReKi RotFromWind {3}{3} 0.0_ReKi - "Rotation matrix for rotating from the wind coordinate system (wind along X') back to the global XYZ coordinate system. Equal to TRANSPOSE(RotToWind)" - typedef ^ ^ UniformFieldType Uniform - - - "Uniform Flow Data" typedef ^ ^ Grid3DFieldType Grid3D - - - "Grid Field Wind Data" typedef ^ ^ Grid4DFieldType Grid4D - - - "External Grid Flow Data" diff --git a/modules/inflowwind/src/IfW_FlowField_Types.f90 b/modules/inflowwind/src/IfW_FlowField_Types.f90 index 9ae7a192f6..5ffe11616d 100644 --- a/modules/inflowwind/src/IfW_FlowField_Types.f90 +++ b/modules/inflowwind/src/IfW_FlowField_Types.f90 @@ -41,9 +41,9 @@ MODULE IfW_FlowField_Types INTEGER(IntKi), PUBLIC, PARAMETER :: User_FieldType = 5 ! User FieldType configured by the user [-] ! ========= UniformFieldType ======= TYPE, PUBLIC :: UniformFieldType - REAL(ReKi) :: RefHeight !< reference height; used to center the wind [meters] - REAL(ReKi) :: RefLength !< reference length used to scale the linear shear [meters] - INTEGER(IntKi) :: DataSize !< size of data in HH file [-] + REAL(ReKi) :: RefHeight = 0.0_ReKi !< reference height; used to center the wind [meters] + REAL(ReKi) :: RefLength = 0.0_ReKi !< reference length used to scale the linear shear [meters] + INTEGER(IntKi) :: DataSize = 0_IntKi !< size of data in HH file [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Time !< HH time array [seconds] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: VelH !< HH horizontal wind speed [meters/sec] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: VelHDot !< Derivative of HH horizontal wind speed wrt time [meters/sec] @@ -65,31 +65,31 @@ MODULE IfW_FlowField_Types ! ======================= ! ========= UniformField_Interp ======= TYPE, PUBLIC :: UniformField_Interp - REAL(ReKi) :: VelH !< HH horizontal wind speed [meters/sec] - REAL(ReKi) :: VelHDot !< derivative of HH horizontal wind speed wrt Time [meters/sec] - REAL(ReKi) :: VelV !< HH vertical wind speed, including tower shadow [meters/sec] - REAL(ReKi) :: VelVDot !< derivative of HH vertical wind speed wrt Time [meters/sec] - REAL(ReKi) :: VelGust !< HH wind gust speed [-] - REAL(ReKi) :: VelGustDot !< derivative of HH wind gust speed wrt Time [-] - REAL(ReKi) :: AngleH !< HH wind direction angle [degrees] - REAL(ReKi) :: AngleHDot !< derivative of HH wind direction angle wrt Time [degrees] - REAL(ReKi) :: AngleV !< HH upflow angle [degrees] - REAL(ReKi) :: AngleVDot !< derivative of HH upflow angle wrt Time [degrees] - REAL(ReKi) :: ShrH !< HH horizontal linear shear [-] - REAL(ReKi) :: ShrHDot !< derivative of HH horizontal linear shear wrt Time [-] - REAL(ReKi) :: ShrV !< HH vertical shear exponent [-] - REAL(ReKi) :: ShrVDot !< derivative of HH vertical shear exponent wrt Time [-] - REAL(ReKi) :: LinShrV !< HH vertical linear shear [seconds] - REAL(ReKi) :: LinShrVDot !< derivative of HH vertical linear shear wrt Time [seconds] - REAL(ReKi) :: CosAngleH !< Horizontal angle components [-] - REAL(ReKi) :: SinAngleH !< Horizontal angle components [-] - REAL(ReKi) :: CosAngleV !< Vertical angle components [-] - REAL(ReKi) :: SinAngleV !< Vertical angle components [-] + REAL(ReKi) :: VelH = 0.0_ReKi !< HH horizontal wind speed [meters/sec] + REAL(ReKi) :: VelHDot = 0.0_ReKi !< derivative of HH horizontal wind speed wrt Time [meters/sec] + REAL(ReKi) :: VelV = 0.0_ReKi !< HH vertical wind speed, including tower shadow [meters/sec] + REAL(ReKi) :: VelVDot = 0.0_ReKi !< derivative of HH vertical wind speed wrt Time [meters/sec] + REAL(ReKi) :: VelGust = 0.0_ReKi !< HH wind gust speed [-] + REAL(ReKi) :: VelGustDot = 0.0_ReKi !< derivative of HH wind gust speed wrt Time [-] + REAL(ReKi) :: AngleH = 0.0_ReKi !< HH wind direction angle [degrees] + REAL(ReKi) :: AngleHDot = 0.0_ReKi !< derivative of HH wind direction angle wrt Time [degrees] + REAL(ReKi) :: AngleV = 0.0_ReKi !< HH upflow angle [degrees] + REAL(ReKi) :: AngleVDot = 0.0_ReKi !< derivative of HH upflow angle wrt Time [degrees] + REAL(ReKi) :: ShrH = 0.0_ReKi !< HH horizontal linear shear [-] + REAL(ReKi) :: ShrHDot = 0.0_ReKi !< derivative of HH horizontal linear shear wrt Time [-] + REAL(ReKi) :: ShrV = 0.0_ReKi !< HH vertical shear exponent [-] + REAL(ReKi) :: ShrVDot = 0.0_ReKi !< derivative of HH vertical shear exponent wrt Time [-] + REAL(ReKi) :: LinShrV = 0.0_ReKi !< HH vertical linear shear [seconds] + REAL(ReKi) :: LinShrVDot = 0.0_ReKi !< derivative of HH vertical linear shear wrt Time [seconds] + REAL(ReKi) :: CosAngleH = 0.0_ReKi !< Horizontal angle components [-] + REAL(ReKi) :: SinAngleH = 0.0_ReKi !< Horizontal angle components [-] + REAL(ReKi) :: CosAngleV = 0.0_ReKi !< Vertical angle components [-] + REAL(ReKi) :: SinAngleV = 0.0_ReKi !< Vertical angle components [-] END TYPE UniformField_Interp ! ======================= ! ========= Grid3DFieldType ======= TYPE, PUBLIC :: Grid3DFieldType - INTEGER(IntKi) :: WindFileFormat !< Binary file format description number [-] + INTEGER(IntKi) :: WindFileFormat = 0_IntKi !< Binary file format description number [-] INTEGER(IntKi) :: WindProfileType = -1 !< Wind profile type (0=constant;1=logarithmic;2=power law) [-] LOGICAL :: Periodic = .false. !< Flag to indicate if the wind file is periodic [-] LOGICAL :: InterpTower = .false. !< Flag to indicate if we should interpolate wind speeds below the tower [-] @@ -122,19 +122,18 @@ MODULE IfW_FlowField_Types REAL(ReKi) :: Z0 = 0 !< Surface roughness length (used for LOG wind profile type only) [-] REAL(ReKi) :: VLinShr = 0 !< Vertical linear wind shear coefficient (used for vertical linear wind profile type only) [-] REAL(ReKi) :: HLinShr = 0 !< Horizontal linear wind shear coefficient (used for horizontal wind profile type only) [-] - LOGICAL :: BoxExceedAllowF = .FALSE. !< Flag to allow Extrapolation winds outside box starting at this index (for OLAF wakes and LidarSim) [-] - INTEGER(IntKi) :: BoxExceedAllowIdx = -1 !< Extrapolate winds outside box starting at this index (for OLAF wakes and LidarSim) [-] - LOGICAL :: BoxExceedWarned = .FALSE. !< Has a warning been issued for points extrapolated beyond FFWind grid [-] + LOGICAL :: BoxExceedAllow = .FALSE. !< Flag to allow Extrapolation winds outside box starting at this index (for OLAF wakes and LidarSim) [-] + LOGICAL :: BoxExceedAllowDrv = .FALSE. !< Flag to allow Extrapolation winds outside box set by driver [-] END TYPE Grid3DFieldType ! ======================= ! ========= Grid4DFieldType ======= TYPE, PUBLIC :: Grid4DFieldType - INTEGER(IntKi) , DIMENSION(1:4) :: n !< number of evenly-spaced grid points in the x, y, z, and t directions [-] - REAL(DbKi) , DIMENSION(1:4) :: delta !< size between 2 consecutive grid points in each grid direction [m,m,m,s] - REAL(ReKi) , DIMENSION(1:3) :: pZero !< fixed position of the XYZ grid (i.e., XYZ coordinates of m%V(:,1,1,1,:)) [m] - REAL(SiKi) , DIMENSION(:,:,:,:,:), ALLOCATABLE :: Vel !< this is the 4-d velocity field for each wind component [{uvw},nx,ny,nz,nt] [-] - REAL(DbKi) :: TimeStart !< this is the time where the first time grid in m%V starts (i.e, the time associated with m%V(:,:,:,:,1)) [s] - REAL(ReKi) :: RefHeight !< reference height; used to center the wind [meters] + INTEGER(IntKi) , DIMENSION(1:4) :: n = 0_IntKi !< number of evenly-spaced grid points in the x, y, z, and t directions [-] + REAL(DbKi) , DIMENSION(1:4) :: delta = 0.0_R8Ki !< size between 2 consecutive grid points in each grid direction [m,m,m,s] + REAL(ReKi) , DIMENSION(1:3) :: pZero = 0.0_ReKi !< fixed position of the XYZ grid (i.e., XYZ coordinates of m%V(:,1,1,1,:)) [m] + REAL(SiKi) , DIMENSION(:,:,:,:,:), POINTER :: Vel => NULL() !< this is the 4-d velocity field for each wind component [{uvw},nx,ny,nz,nt] [-] + REAL(ReKi) :: TimeStart = 0.0_ReKi !< this is the time where the first time grid in m%V starts (i.e, the time associated with m%V(:,:,:,:,1)) [s] + REAL(ReKi) :: RefHeight = 0.0_ReKi !< reference height; used to center the wind [meters] END TYPE Grid4DFieldType ! ======================= ! ========= PointsFieldType ======= @@ -144,20 +143,20 @@ MODULE IfW_FlowField_Types ! ======================= ! ========= UserFieldType ======= TYPE, PUBLIC :: UserFieldType - REAL(ReKi) :: RefHeight !< reference height; used to center the wind [meters] + REAL(ReKi) :: RefHeight = 0.0_ReKi !< reference height; used to center the wind [meters] END TYPE UserFieldType ! ======================= ! ========= FlowFieldType ======= TYPE, PUBLIC :: FlowFieldType INTEGER(IntKi) :: FieldType = 0 !< Switch for flow field type {1=Uniform, 2=Grid, 3=User, 4=External} [-] - REAL(ReKi) , DIMENSION(1:3) :: RefPosition !< Reference position (point where box is rotated) [meters] - REAL(ReKi) :: PropagationDir !< Direction of wind propagation [radians] - REAL(ReKi) :: VFlowAngle !< Vertical (upflow) angle [radians] + REAL(ReKi) , DIMENSION(1:3) :: RefPosition = 0.0_ReKi !< Reference position (point where box is rotated) [meters] + REAL(ReKi) :: PropagationDir = 0.0_ReKi !< Direction of wind propagation [radians] + REAL(ReKi) :: VFlowAngle = 0.0_ReKi !< Vertical (upflow) angle [radians] LOGICAL :: VelInterpCubic = .false. !< Velocity interpolation order in time (1=linear; 3=cubic) [Used with WindType=2,3,4,5,7] [-] LOGICAL :: RotateWindBox = .false. !< flag indicating if the wind will be rotated [-] LOGICAL :: AccFieldValid = .false. !< flag indicating that acceleration field has been calculated [-] - REAL(ReKi) , DIMENSION(1:3,1:3) :: RotToWind !< Rotation matrix for rotating from the global XYZ coordinate system to the wind coordinate system (wind along X') [-] - REAL(ReKi) , DIMENSION(1:3,1:3) :: RotFromWind !< Rotation matrix for rotating from the wind coordinate system (wind along X') back to the global XYZ coordinate system. Equal to TRANSPOSE(RotToWind) [-] + REAL(ReKi) , DIMENSION(1:3,1:3) :: RotToWind = 0.0_ReKi !< Rotation matrix for rotating from the global XYZ coordinate system to the wind coordinate system (wind along X') [-] + REAL(ReKi) , DIMENSION(1:3,1:3) :: RotFromWind = 0.0_ReKi !< Rotation matrix for rotating from the wind coordinate system (wind along X') back to the global XYZ coordinate system. Equal to TRANSPOSE(RotToWind) [-] TYPE(UniformFieldType) :: Uniform !< Uniform Flow Data [-] TYPE(Grid3DFieldType) :: Grid3D !< Grid Field Wind Data [-] TYPE(Grid4DFieldType) :: Grid4D !< External Grid Flow Data [-] @@ -166,3418 +165,925 @@ MODULE IfW_FlowField_Types END TYPE FlowFieldType ! ======================= CONTAINS - SUBROUTINE IfW_FlowField_CopyUniformFieldType( SrcUniformFieldTypeData, DstUniformFieldTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(UniformFieldType), INTENT(IN) :: SrcUniformFieldTypeData - TYPE(UniformFieldType), INTENT(INOUT) :: DstUniformFieldTypeData - 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) :: i5, i5_l, i5_u ! bounds (upper/lower) for an array dimension 5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IfW_FlowField_CopyUniformFieldType' -! - ErrStat = ErrID_None - ErrMsg = "" - DstUniformFieldTypeData%RefHeight = SrcUniformFieldTypeData%RefHeight - DstUniformFieldTypeData%RefLength = SrcUniformFieldTypeData%RefLength - DstUniformFieldTypeData%DataSize = SrcUniformFieldTypeData%DataSize -IF (ALLOCATED(SrcUniformFieldTypeData%Time)) THEN - i1_l = LBOUND(SrcUniformFieldTypeData%Time,1) - i1_u = UBOUND(SrcUniformFieldTypeData%Time,1) - IF (.NOT. ALLOCATED(DstUniformFieldTypeData%Time)) THEN - ALLOCATE(DstUniformFieldTypeData%Time(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstUniformFieldTypeData%Time.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstUniformFieldTypeData%Time = SrcUniformFieldTypeData%Time -ENDIF -IF (ALLOCATED(SrcUniformFieldTypeData%VelH)) THEN - i1_l = LBOUND(SrcUniformFieldTypeData%VelH,1) - i1_u = UBOUND(SrcUniformFieldTypeData%VelH,1) - IF (.NOT. ALLOCATED(DstUniformFieldTypeData%VelH)) THEN - ALLOCATE(DstUniformFieldTypeData%VelH(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstUniformFieldTypeData%VelH.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstUniformFieldTypeData%VelH = SrcUniformFieldTypeData%VelH -ENDIF -IF (ALLOCATED(SrcUniformFieldTypeData%VelHDot)) THEN - i1_l = LBOUND(SrcUniformFieldTypeData%VelHDot,1) - i1_u = UBOUND(SrcUniformFieldTypeData%VelHDot,1) - IF (.NOT. ALLOCATED(DstUniformFieldTypeData%VelHDot)) THEN - ALLOCATE(DstUniformFieldTypeData%VelHDot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstUniformFieldTypeData%VelHDot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstUniformFieldTypeData%VelHDot = SrcUniformFieldTypeData%VelHDot -ENDIF -IF (ALLOCATED(SrcUniformFieldTypeData%VelV)) THEN - i1_l = LBOUND(SrcUniformFieldTypeData%VelV,1) - i1_u = UBOUND(SrcUniformFieldTypeData%VelV,1) - IF (.NOT. ALLOCATED(DstUniformFieldTypeData%VelV)) THEN - ALLOCATE(DstUniformFieldTypeData%VelV(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstUniformFieldTypeData%VelV.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstUniformFieldTypeData%VelV = SrcUniformFieldTypeData%VelV -ENDIF -IF (ALLOCATED(SrcUniformFieldTypeData%VelVDot)) THEN - i1_l = LBOUND(SrcUniformFieldTypeData%VelVDot,1) - i1_u = UBOUND(SrcUniformFieldTypeData%VelVDot,1) - IF (.NOT. ALLOCATED(DstUniformFieldTypeData%VelVDot)) THEN - ALLOCATE(DstUniformFieldTypeData%VelVDot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstUniformFieldTypeData%VelVDot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstUniformFieldTypeData%VelVDot = SrcUniformFieldTypeData%VelVDot -ENDIF -IF (ALLOCATED(SrcUniformFieldTypeData%VelGust)) THEN - i1_l = LBOUND(SrcUniformFieldTypeData%VelGust,1) - i1_u = UBOUND(SrcUniformFieldTypeData%VelGust,1) - IF (.NOT. ALLOCATED(DstUniformFieldTypeData%VelGust)) THEN - ALLOCATE(DstUniformFieldTypeData%VelGust(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstUniformFieldTypeData%VelGust.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstUniformFieldTypeData%VelGust = SrcUniformFieldTypeData%VelGust -ENDIF -IF (ALLOCATED(SrcUniformFieldTypeData%VelGustDot)) THEN - i1_l = LBOUND(SrcUniformFieldTypeData%VelGustDot,1) - i1_u = UBOUND(SrcUniformFieldTypeData%VelGustDot,1) - IF (.NOT. ALLOCATED(DstUniformFieldTypeData%VelGustDot)) THEN - ALLOCATE(DstUniformFieldTypeData%VelGustDot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstUniformFieldTypeData%VelGustDot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstUniformFieldTypeData%VelGustDot = SrcUniformFieldTypeData%VelGustDot -ENDIF -IF (ALLOCATED(SrcUniformFieldTypeData%AngleH)) THEN - i1_l = LBOUND(SrcUniformFieldTypeData%AngleH,1) - i1_u = UBOUND(SrcUniformFieldTypeData%AngleH,1) - IF (.NOT. ALLOCATED(DstUniformFieldTypeData%AngleH)) THEN - ALLOCATE(DstUniformFieldTypeData%AngleH(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstUniformFieldTypeData%AngleH.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstUniformFieldTypeData%AngleH = SrcUniformFieldTypeData%AngleH -ENDIF -IF (ALLOCATED(SrcUniformFieldTypeData%AngleHDot)) THEN - i1_l = LBOUND(SrcUniformFieldTypeData%AngleHDot,1) - i1_u = UBOUND(SrcUniformFieldTypeData%AngleHDot,1) - IF (.NOT. ALLOCATED(DstUniformFieldTypeData%AngleHDot)) THEN - ALLOCATE(DstUniformFieldTypeData%AngleHDot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstUniformFieldTypeData%AngleHDot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstUniformFieldTypeData%AngleHDot = SrcUniformFieldTypeData%AngleHDot -ENDIF -IF (ALLOCATED(SrcUniformFieldTypeData%AngleV)) THEN - i1_l = LBOUND(SrcUniformFieldTypeData%AngleV,1) - i1_u = UBOUND(SrcUniformFieldTypeData%AngleV,1) - IF (.NOT. ALLOCATED(DstUniformFieldTypeData%AngleV)) THEN - ALLOCATE(DstUniformFieldTypeData%AngleV(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstUniformFieldTypeData%AngleV.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstUniformFieldTypeData%AngleV = SrcUniformFieldTypeData%AngleV -ENDIF -IF (ALLOCATED(SrcUniformFieldTypeData%AngleVDot)) THEN - i1_l = LBOUND(SrcUniformFieldTypeData%AngleVDot,1) - i1_u = UBOUND(SrcUniformFieldTypeData%AngleVDot,1) - IF (.NOT. ALLOCATED(DstUniformFieldTypeData%AngleVDot)) THEN - ALLOCATE(DstUniformFieldTypeData%AngleVDot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstUniformFieldTypeData%AngleVDot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstUniformFieldTypeData%AngleVDot = SrcUniformFieldTypeData%AngleVDot -ENDIF -IF (ALLOCATED(SrcUniformFieldTypeData%ShrH)) THEN - i1_l = LBOUND(SrcUniformFieldTypeData%ShrH,1) - i1_u = UBOUND(SrcUniformFieldTypeData%ShrH,1) - IF (.NOT. ALLOCATED(DstUniformFieldTypeData%ShrH)) THEN - ALLOCATE(DstUniformFieldTypeData%ShrH(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstUniformFieldTypeData%ShrH.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstUniformFieldTypeData%ShrH = SrcUniformFieldTypeData%ShrH -ENDIF -IF (ALLOCATED(SrcUniformFieldTypeData%ShrHDot)) THEN - i1_l = LBOUND(SrcUniformFieldTypeData%ShrHDot,1) - i1_u = UBOUND(SrcUniformFieldTypeData%ShrHDot,1) - IF (.NOT. ALLOCATED(DstUniformFieldTypeData%ShrHDot)) THEN - ALLOCATE(DstUniformFieldTypeData%ShrHDot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstUniformFieldTypeData%ShrHDot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstUniformFieldTypeData%ShrHDot = SrcUniformFieldTypeData%ShrHDot -ENDIF -IF (ALLOCATED(SrcUniformFieldTypeData%ShrV)) THEN - i1_l = LBOUND(SrcUniformFieldTypeData%ShrV,1) - i1_u = UBOUND(SrcUniformFieldTypeData%ShrV,1) - IF (.NOT. ALLOCATED(DstUniformFieldTypeData%ShrV)) THEN - ALLOCATE(DstUniformFieldTypeData%ShrV(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstUniformFieldTypeData%ShrV.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstUniformFieldTypeData%ShrV = SrcUniformFieldTypeData%ShrV -ENDIF -IF (ALLOCATED(SrcUniformFieldTypeData%ShrVDot)) THEN - i1_l = LBOUND(SrcUniformFieldTypeData%ShrVDot,1) - i1_u = UBOUND(SrcUniformFieldTypeData%ShrVDot,1) - IF (.NOT. ALLOCATED(DstUniformFieldTypeData%ShrVDot)) THEN - ALLOCATE(DstUniformFieldTypeData%ShrVDot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstUniformFieldTypeData%ShrVDot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstUniformFieldTypeData%ShrVDot = SrcUniformFieldTypeData%ShrVDot -ENDIF -IF (ALLOCATED(SrcUniformFieldTypeData%LinShrV)) THEN - i1_l = LBOUND(SrcUniformFieldTypeData%LinShrV,1) - i1_u = UBOUND(SrcUniformFieldTypeData%LinShrV,1) - IF (.NOT. ALLOCATED(DstUniformFieldTypeData%LinShrV)) THEN - ALLOCATE(DstUniformFieldTypeData%LinShrV(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstUniformFieldTypeData%LinShrV.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstUniformFieldTypeData%LinShrV = SrcUniformFieldTypeData%LinShrV -ENDIF -IF (ALLOCATED(SrcUniformFieldTypeData%LinShrVDot)) THEN - i1_l = LBOUND(SrcUniformFieldTypeData%LinShrVDot,1) - i1_u = UBOUND(SrcUniformFieldTypeData%LinShrVDot,1) - IF (.NOT. ALLOCATED(DstUniformFieldTypeData%LinShrVDot)) THEN - ALLOCATE(DstUniformFieldTypeData%LinShrVDot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstUniformFieldTypeData%LinShrVDot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstUniformFieldTypeData%LinShrVDot = SrcUniformFieldTypeData%LinShrVDot -ENDIF - END SUBROUTINE IfW_FlowField_CopyUniformFieldType - - SUBROUTINE IfW_FlowField_DestroyUniformFieldType( UniformFieldTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(UniformFieldType), INTENT(INOUT) :: UniformFieldTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IfW_FlowField_DestroyUniformFieldType' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(UniformFieldTypeData%Time)) THEN - DEALLOCATE(UniformFieldTypeData%Time) -ENDIF -IF (ALLOCATED(UniformFieldTypeData%VelH)) THEN - DEALLOCATE(UniformFieldTypeData%VelH) -ENDIF -IF (ALLOCATED(UniformFieldTypeData%VelHDot)) THEN - DEALLOCATE(UniformFieldTypeData%VelHDot) -ENDIF -IF (ALLOCATED(UniformFieldTypeData%VelV)) THEN - DEALLOCATE(UniformFieldTypeData%VelV) -ENDIF -IF (ALLOCATED(UniformFieldTypeData%VelVDot)) THEN - DEALLOCATE(UniformFieldTypeData%VelVDot) -ENDIF -IF (ALLOCATED(UniformFieldTypeData%VelGust)) THEN - DEALLOCATE(UniformFieldTypeData%VelGust) -ENDIF -IF (ALLOCATED(UniformFieldTypeData%VelGustDot)) THEN - DEALLOCATE(UniformFieldTypeData%VelGustDot) -ENDIF -IF (ALLOCATED(UniformFieldTypeData%AngleH)) THEN - DEALLOCATE(UniformFieldTypeData%AngleH) -ENDIF -IF (ALLOCATED(UniformFieldTypeData%AngleHDot)) THEN - DEALLOCATE(UniformFieldTypeData%AngleHDot) -ENDIF -IF (ALLOCATED(UniformFieldTypeData%AngleV)) THEN - DEALLOCATE(UniformFieldTypeData%AngleV) -ENDIF -IF (ALLOCATED(UniformFieldTypeData%AngleVDot)) THEN - DEALLOCATE(UniformFieldTypeData%AngleVDot) -ENDIF -IF (ALLOCATED(UniformFieldTypeData%ShrH)) THEN - DEALLOCATE(UniformFieldTypeData%ShrH) -ENDIF -IF (ALLOCATED(UniformFieldTypeData%ShrHDot)) THEN - DEALLOCATE(UniformFieldTypeData%ShrHDot) -ENDIF -IF (ALLOCATED(UniformFieldTypeData%ShrV)) THEN - DEALLOCATE(UniformFieldTypeData%ShrV) -ENDIF -IF (ALLOCATED(UniformFieldTypeData%ShrVDot)) THEN - DEALLOCATE(UniformFieldTypeData%ShrVDot) -ENDIF -IF (ALLOCATED(UniformFieldTypeData%LinShrV)) THEN - DEALLOCATE(UniformFieldTypeData%LinShrV) -ENDIF -IF (ALLOCATED(UniformFieldTypeData%LinShrVDot)) THEN - DEALLOCATE(UniformFieldTypeData%LinShrVDot) -ENDIF - END SUBROUTINE IfW_FlowField_DestroyUniformFieldType - - SUBROUTINE IfW_FlowField_PackUniformFieldType( 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(UniformFieldType), 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 = 'IfW_FlowField_PackUniformFieldType' - ! 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 ! RefHeight - Re_BufSz = Re_BufSz + 1 ! RefLength - Int_BufSz = Int_BufSz + 1 ! DataSize - Int_BufSz = Int_BufSz + 1 ! Time allocated yes/no - IF ( ALLOCATED(InData%Time) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Time upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Time) ! Time - END IF - Int_BufSz = Int_BufSz + 1 ! VelH allocated yes/no - IF ( ALLOCATED(InData%VelH) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! VelH upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%VelH) ! VelH - END IF - Int_BufSz = Int_BufSz + 1 ! VelHDot allocated yes/no - IF ( ALLOCATED(InData%VelHDot) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! VelHDot upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%VelHDot) ! VelHDot - END IF - Int_BufSz = Int_BufSz + 1 ! VelV allocated yes/no - IF ( ALLOCATED(InData%VelV) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! VelV upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%VelV) ! VelV - END IF - Int_BufSz = Int_BufSz + 1 ! VelVDot allocated yes/no - IF ( ALLOCATED(InData%VelVDot) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! VelVDot upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%VelVDot) ! VelVDot - END IF - Int_BufSz = Int_BufSz + 1 ! VelGust allocated yes/no - IF ( ALLOCATED(InData%VelGust) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! VelGust upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%VelGust) ! VelGust - END IF - Int_BufSz = Int_BufSz + 1 ! VelGustDot allocated yes/no - IF ( ALLOCATED(InData%VelGustDot) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! VelGustDot upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%VelGustDot) ! VelGustDot - END IF - Int_BufSz = Int_BufSz + 1 ! AngleH allocated yes/no - IF ( ALLOCATED(InData%AngleH) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! AngleH upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AngleH) ! AngleH - END IF - Int_BufSz = Int_BufSz + 1 ! AngleHDot allocated yes/no - IF ( ALLOCATED(InData%AngleHDot) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! AngleHDot upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AngleHDot) ! AngleHDot - END IF - Int_BufSz = Int_BufSz + 1 ! AngleV allocated yes/no - IF ( ALLOCATED(InData%AngleV) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! AngleV upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AngleV) ! AngleV - END IF - Int_BufSz = Int_BufSz + 1 ! AngleVDot allocated yes/no - IF ( ALLOCATED(InData%AngleVDot) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! AngleVDot upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AngleVDot) ! AngleVDot - END IF - Int_BufSz = Int_BufSz + 1 ! ShrH allocated yes/no - IF ( ALLOCATED(InData%ShrH) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ShrH upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%ShrH) ! ShrH - END IF - Int_BufSz = Int_BufSz + 1 ! ShrHDot allocated yes/no - IF ( ALLOCATED(InData%ShrHDot) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ShrHDot upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%ShrHDot) ! ShrHDot - END IF - Int_BufSz = Int_BufSz + 1 ! ShrV allocated yes/no - IF ( ALLOCATED(InData%ShrV) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ShrV upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%ShrV) ! ShrV - END IF - Int_BufSz = Int_BufSz + 1 ! ShrVDot allocated yes/no - IF ( ALLOCATED(InData%ShrVDot) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ShrVDot upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%ShrVDot) ! ShrVDot - END IF - Int_BufSz = Int_BufSz + 1 ! LinShrV allocated yes/no - IF ( ALLOCATED(InData%LinShrV) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LinShrV upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%LinShrV) ! LinShrV - END IF - Int_BufSz = Int_BufSz + 1 ! LinShrVDot allocated yes/no - IF ( ALLOCATED(InData%LinShrVDot) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LinShrVDot upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%LinShrVDot) ! LinShrVDot - 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%RefHeight - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RefLength - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%DataSize - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%Time) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Time,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Time,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Time,1), UBOUND(InData%Time,1) - ReKiBuf(Re_Xferred) = InData%Time(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%VelH) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%VelH,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VelH,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%VelH,1), UBOUND(InData%VelH,1) - ReKiBuf(Re_Xferred) = InData%VelH(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%VelHDot) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%VelHDot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VelHDot,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%VelHDot,1), UBOUND(InData%VelHDot,1) - ReKiBuf(Re_Xferred) = InData%VelHDot(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%VelV) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%VelV,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VelV,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%VelV,1), UBOUND(InData%VelV,1) - ReKiBuf(Re_Xferred) = InData%VelV(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%VelVDot) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%VelVDot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VelVDot,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%VelVDot,1), UBOUND(InData%VelVDot,1) - ReKiBuf(Re_Xferred) = InData%VelVDot(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%VelGust) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%VelGust,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VelGust,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%VelGust,1), UBOUND(InData%VelGust,1) - ReKiBuf(Re_Xferred) = InData%VelGust(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%VelGustDot) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%VelGustDot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VelGustDot,1) - Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%VelGustDot,1), UBOUND(InData%VelGustDot,1) - ReKiBuf(Re_Xferred) = InData%VelGustDot(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AngleH) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AngleH,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AngleH,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%AngleH,1), UBOUND(InData%AngleH,1) - ReKiBuf(Re_Xferred) = InData%AngleH(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AngleHDot) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AngleHDot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AngleHDot,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%AngleHDot,1), UBOUND(InData%AngleHDot,1) - ReKiBuf(Re_Xferred) = InData%AngleHDot(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AngleV) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AngleV,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AngleV,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%AngleV,1), UBOUND(InData%AngleV,1) - ReKiBuf(Re_Xferred) = InData%AngleV(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AngleVDot) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AngleVDot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AngleVDot,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%AngleVDot,1), UBOUND(InData%AngleVDot,1) - ReKiBuf(Re_Xferred) = InData%AngleVDot(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ShrH) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ShrH,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ShrH,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ShrH,1), UBOUND(InData%ShrH,1) - ReKiBuf(Re_Xferred) = InData%ShrH(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ShrHDot) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ShrHDot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ShrHDot,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ShrHDot,1), UBOUND(InData%ShrHDot,1) - ReKiBuf(Re_Xferred) = InData%ShrHDot(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ShrV) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ShrV,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ShrV,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ShrV,1), UBOUND(InData%ShrV,1) - ReKiBuf(Re_Xferred) = InData%ShrV(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ShrVDot) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ShrVDot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ShrVDot,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ShrVDot,1), UBOUND(InData%ShrVDot,1) - ReKiBuf(Re_Xferred) = InData%ShrVDot(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LinShrV) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LinShrV,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinShrV,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LinShrV,1), UBOUND(InData%LinShrV,1) - ReKiBuf(Re_Xferred) = InData%LinShrV(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LinShrVDot) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LinShrVDot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinShrVDot,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LinShrVDot,1), UBOUND(InData%LinShrVDot,1) - ReKiBuf(Re_Xferred) = InData%LinShrVDot(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE IfW_FlowField_PackUniformFieldType - - SUBROUTINE IfW_FlowField_UnPackUniformFieldType( 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(UniformFieldType), 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) :: i5, i5_l, i5_u ! bounds (upper/lower) for an array dimension 5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IfW_FlowField_UnPackUniformFieldType' - ! 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%RefHeight = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RefLength = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%DataSize = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Time not allocated - Int_Xferred = Int_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%Time)) DEALLOCATE(OutData%Time) - ALLOCATE(OutData%Time(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Time.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Time,1), UBOUND(OutData%Time,1) - OutData%Time(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! VelH not allocated - Int_Xferred = Int_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%VelH)) DEALLOCATE(OutData%VelH) - ALLOCATE(OutData%VelH(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%VelH.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%VelH,1), UBOUND(OutData%VelH,1) - OutData%VelH(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! VelHDot not allocated - Int_Xferred = Int_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%VelHDot)) DEALLOCATE(OutData%VelHDot) - ALLOCATE(OutData%VelHDot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%VelHDot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%VelHDot,1), UBOUND(OutData%VelHDot,1) - OutData%VelHDot(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! VelV not allocated - Int_Xferred = Int_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%VelV)) DEALLOCATE(OutData%VelV) - ALLOCATE(OutData%VelV(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%VelV.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%VelV,1), UBOUND(OutData%VelV,1) - OutData%VelV(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! VelVDot not allocated - Int_Xferred = Int_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%VelVDot)) DEALLOCATE(OutData%VelVDot) - ALLOCATE(OutData%VelVDot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%VelVDot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%VelVDot,1), UBOUND(OutData%VelVDot,1) - OutData%VelVDot(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! VelGust not allocated - Int_Xferred = Int_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%VelGust)) DEALLOCATE(OutData%VelGust) - ALLOCATE(OutData%VelGust(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%VelGust.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%VelGust,1), UBOUND(OutData%VelGust,1) - OutData%VelGust(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! VelGustDot not allocated - Int_Xferred = Int_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%VelGustDot)) DEALLOCATE(OutData%VelGustDot) - ALLOCATE(OutData%VelGustDot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%VelGustDot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%VelGustDot,1), UBOUND(OutData%VelGustDot,1) - OutData%VelGustDot(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AngleH not allocated - Int_Xferred = Int_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%AngleH)) DEALLOCATE(OutData%AngleH) - ALLOCATE(OutData%AngleH(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AngleH.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%AngleH,1), UBOUND(OutData%AngleH,1) - OutData%AngleH(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AngleHDot not allocated - Int_Xferred = Int_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%AngleHDot)) DEALLOCATE(OutData%AngleHDot) - ALLOCATE(OutData%AngleHDot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AngleHDot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%AngleHDot,1), UBOUND(OutData%AngleHDot,1) - OutData%AngleHDot(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AngleV not allocated - Int_Xferred = Int_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%AngleV)) DEALLOCATE(OutData%AngleV) - ALLOCATE(OutData%AngleV(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AngleV.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%AngleV,1), UBOUND(OutData%AngleV,1) - OutData%AngleV(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AngleVDot not allocated - Int_Xferred = Int_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%AngleVDot)) DEALLOCATE(OutData%AngleVDot) - ALLOCATE(OutData%AngleVDot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AngleVDot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%AngleVDot,1), UBOUND(OutData%AngleVDot,1) - OutData%AngleVDot(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ShrH not allocated - Int_Xferred = Int_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%ShrH)) DEALLOCATE(OutData%ShrH) - ALLOCATE(OutData%ShrH(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ShrH.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ShrH,1), UBOUND(OutData%ShrH,1) - OutData%ShrH(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ShrHDot not allocated - Int_Xferred = Int_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%ShrHDot)) DEALLOCATE(OutData%ShrHDot) - ALLOCATE(OutData%ShrHDot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ShrHDot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ShrHDot,1), UBOUND(OutData%ShrHDot,1) - OutData%ShrHDot(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ShrV not allocated - Int_Xferred = Int_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%ShrV)) DEALLOCATE(OutData%ShrV) - ALLOCATE(OutData%ShrV(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ShrV.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ShrV,1), UBOUND(OutData%ShrV,1) - OutData%ShrV(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ShrVDot not allocated - Int_Xferred = Int_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%ShrVDot)) DEALLOCATE(OutData%ShrVDot) - ALLOCATE(OutData%ShrVDot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ShrVDot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ShrVDot,1), UBOUND(OutData%ShrVDot,1) - OutData%ShrVDot(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinShrV not allocated - Int_Xferred = Int_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%LinShrV)) DEALLOCATE(OutData%LinShrV) - ALLOCATE(OutData%LinShrV(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinShrV.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LinShrV,1), UBOUND(OutData%LinShrV,1) - OutData%LinShrV(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinShrVDot not allocated - Int_Xferred = Int_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%LinShrVDot)) DEALLOCATE(OutData%LinShrVDot) - ALLOCATE(OutData%LinShrVDot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinShrVDot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LinShrVDot,1), UBOUND(OutData%LinShrVDot,1) - OutData%LinShrVDot(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE IfW_FlowField_UnPackUniformFieldType - - SUBROUTINE IfW_FlowField_CopyUniformField_Interp( SrcUniformField_InterpData, DstUniformField_InterpData, CtrlCode, ErrStat, ErrMsg ) - TYPE(UniformField_Interp), INTENT(IN) :: SrcUniformField_InterpData - TYPE(UniformField_Interp), INTENT(INOUT) :: DstUniformField_InterpData - 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 = 'IfW_FlowField_CopyUniformField_Interp' -! +subroutine IfW_FlowField_CopyUniformFieldType(SrcUniformFieldTypeData, DstUniformFieldTypeData, CtrlCode, ErrStat, ErrMsg) + type(UniformFieldType), intent(in) :: SrcUniformFieldTypeData + type(UniformFieldType), intent(inout) :: DstUniformFieldTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'IfW_FlowField_CopyUniformFieldType' ErrStat = ErrID_None - ErrMsg = "" - DstUniformField_InterpData%VelH = SrcUniformField_InterpData%VelH - DstUniformField_InterpData%VelHDot = SrcUniformField_InterpData%VelHDot - DstUniformField_InterpData%VelV = SrcUniformField_InterpData%VelV - DstUniformField_InterpData%VelVDot = SrcUniformField_InterpData%VelVDot - DstUniformField_InterpData%VelGust = SrcUniformField_InterpData%VelGust - DstUniformField_InterpData%VelGustDot = SrcUniformField_InterpData%VelGustDot - DstUniformField_InterpData%AngleH = SrcUniformField_InterpData%AngleH - DstUniformField_InterpData%AngleHDot = SrcUniformField_InterpData%AngleHDot - DstUniformField_InterpData%AngleV = SrcUniformField_InterpData%AngleV - DstUniformField_InterpData%AngleVDot = SrcUniformField_InterpData%AngleVDot - DstUniformField_InterpData%ShrH = SrcUniformField_InterpData%ShrH - DstUniformField_InterpData%ShrHDot = SrcUniformField_InterpData%ShrHDot - DstUniformField_InterpData%ShrV = SrcUniformField_InterpData%ShrV - DstUniformField_InterpData%ShrVDot = SrcUniformField_InterpData%ShrVDot - DstUniformField_InterpData%LinShrV = SrcUniformField_InterpData%LinShrV - DstUniformField_InterpData%LinShrVDot = SrcUniformField_InterpData%LinShrVDot - DstUniformField_InterpData%CosAngleH = SrcUniformField_InterpData%CosAngleH - DstUniformField_InterpData%SinAngleH = SrcUniformField_InterpData%SinAngleH - DstUniformField_InterpData%CosAngleV = SrcUniformField_InterpData%CosAngleV - DstUniformField_InterpData%SinAngleV = SrcUniformField_InterpData%SinAngleV - END SUBROUTINE IfW_FlowField_CopyUniformField_Interp - - SUBROUTINE IfW_FlowField_DestroyUniformField_Interp( UniformField_InterpData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(UniformField_Interp), INTENT(INOUT) :: UniformField_InterpData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IfW_FlowField_DestroyUniformField_Interp' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE IfW_FlowField_DestroyUniformField_Interp - - SUBROUTINE IfW_FlowField_PackUniformField_Interp( 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(UniformField_Interp), 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 = 'IfW_FlowField_PackUniformField_Interp' - ! 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 ! VelH - Re_BufSz = Re_BufSz + 1 ! VelHDot - Re_BufSz = Re_BufSz + 1 ! VelV - Re_BufSz = Re_BufSz + 1 ! VelVDot - Re_BufSz = Re_BufSz + 1 ! VelGust - Re_BufSz = Re_BufSz + 1 ! VelGustDot - Re_BufSz = Re_BufSz + 1 ! AngleH - Re_BufSz = Re_BufSz + 1 ! AngleHDot - Re_BufSz = Re_BufSz + 1 ! AngleV - Re_BufSz = Re_BufSz + 1 ! AngleVDot - Re_BufSz = Re_BufSz + 1 ! ShrH - Re_BufSz = Re_BufSz + 1 ! ShrHDot - Re_BufSz = Re_BufSz + 1 ! ShrV - Re_BufSz = Re_BufSz + 1 ! ShrVDot - Re_BufSz = Re_BufSz + 1 ! LinShrV - Re_BufSz = Re_BufSz + 1 ! LinShrVDot - Re_BufSz = Re_BufSz + 1 ! CosAngleH - Re_BufSz = Re_BufSz + 1 ! SinAngleH - Re_BufSz = Re_BufSz + 1 ! CosAngleV - Re_BufSz = Re_BufSz + 1 ! SinAngleV - 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%VelH - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%VelHDot - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%VelV - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%VelVDot - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%VelGust - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%VelGustDot - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%AngleH - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%AngleHDot - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%AngleV - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%AngleVDot - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%ShrH - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%ShrHDot - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%ShrV - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%ShrVDot - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%LinShrV - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%LinShrVDot - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%CosAngleH - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%SinAngleH - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%CosAngleV - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%SinAngleV - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE IfW_FlowField_PackUniformField_Interp - - SUBROUTINE IfW_FlowField_UnPackUniformField_Interp( 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(UniformField_Interp), 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 = 'IfW_FlowField_UnPackUniformField_Interp' - ! 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%VelH = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%VelHDot = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%VelV = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%VelVDot = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%VelGust = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%VelGustDot = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%AngleH = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%AngleHDot = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%AngleV = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%AngleVDot = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%ShrH = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%ShrHDot = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%ShrV = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%ShrVDot = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%LinShrV = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%LinShrVDot = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%CosAngleH = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SinAngleH = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%CosAngleV = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SinAngleV = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE IfW_FlowField_UnPackUniformField_Interp - - SUBROUTINE IfW_FlowField_CopyGrid3DFieldType( SrcGrid3DFieldTypeData, DstGrid3DFieldTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Grid3DFieldType), INTENT(IN) :: SrcGrid3DFieldTypeData - TYPE(Grid3DFieldType), INTENT(INOUT) :: DstGrid3DFieldTypeData - 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 = 'IfW_FlowField_CopyGrid3DFieldType' -! + ErrMsg = '' + DstUniformFieldTypeData%RefHeight = SrcUniformFieldTypeData%RefHeight + DstUniformFieldTypeData%RefLength = SrcUniformFieldTypeData%RefLength + DstUniformFieldTypeData%DataSize = SrcUniformFieldTypeData%DataSize + if (allocated(SrcUniformFieldTypeData%Time)) then + LB(1:1) = lbound(SrcUniformFieldTypeData%Time) + UB(1:1) = ubound(SrcUniformFieldTypeData%Time) + if (.not. allocated(DstUniformFieldTypeData%Time)) then + allocate(DstUniformFieldTypeData%Time(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstUniformFieldTypeData%Time.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstUniformFieldTypeData%Time = SrcUniformFieldTypeData%Time + end if + if (allocated(SrcUniformFieldTypeData%VelH)) then + LB(1:1) = lbound(SrcUniformFieldTypeData%VelH) + UB(1:1) = ubound(SrcUniformFieldTypeData%VelH) + if (.not. allocated(DstUniformFieldTypeData%VelH)) then + allocate(DstUniformFieldTypeData%VelH(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstUniformFieldTypeData%VelH.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstUniformFieldTypeData%VelH = SrcUniformFieldTypeData%VelH + end if + if (allocated(SrcUniformFieldTypeData%VelHDot)) then + LB(1:1) = lbound(SrcUniformFieldTypeData%VelHDot) + UB(1:1) = ubound(SrcUniformFieldTypeData%VelHDot) + if (.not. allocated(DstUniformFieldTypeData%VelHDot)) then + allocate(DstUniformFieldTypeData%VelHDot(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstUniformFieldTypeData%VelHDot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstUniformFieldTypeData%VelHDot = SrcUniformFieldTypeData%VelHDot + end if + if (allocated(SrcUniformFieldTypeData%VelV)) then + LB(1:1) = lbound(SrcUniformFieldTypeData%VelV) + UB(1:1) = ubound(SrcUniformFieldTypeData%VelV) + if (.not. allocated(DstUniformFieldTypeData%VelV)) then + allocate(DstUniformFieldTypeData%VelV(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstUniformFieldTypeData%VelV.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstUniformFieldTypeData%VelV = SrcUniformFieldTypeData%VelV + end if + if (allocated(SrcUniformFieldTypeData%VelVDot)) then + LB(1:1) = lbound(SrcUniformFieldTypeData%VelVDot) + UB(1:1) = ubound(SrcUniformFieldTypeData%VelVDot) + if (.not. allocated(DstUniformFieldTypeData%VelVDot)) then + allocate(DstUniformFieldTypeData%VelVDot(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstUniformFieldTypeData%VelVDot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstUniformFieldTypeData%VelVDot = SrcUniformFieldTypeData%VelVDot + end if + if (allocated(SrcUniformFieldTypeData%VelGust)) then + LB(1:1) = lbound(SrcUniformFieldTypeData%VelGust) + UB(1:1) = ubound(SrcUniformFieldTypeData%VelGust) + if (.not. allocated(DstUniformFieldTypeData%VelGust)) then + allocate(DstUniformFieldTypeData%VelGust(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstUniformFieldTypeData%VelGust.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstUniformFieldTypeData%VelGust = SrcUniformFieldTypeData%VelGust + end if + if (allocated(SrcUniformFieldTypeData%VelGustDot)) then + LB(1:1) = lbound(SrcUniformFieldTypeData%VelGustDot) + UB(1:1) = ubound(SrcUniformFieldTypeData%VelGustDot) + if (.not. allocated(DstUniformFieldTypeData%VelGustDot)) then + allocate(DstUniformFieldTypeData%VelGustDot(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstUniformFieldTypeData%VelGustDot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstUniformFieldTypeData%VelGustDot = SrcUniformFieldTypeData%VelGustDot + end if + if (allocated(SrcUniformFieldTypeData%AngleH)) then + LB(1:1) = lbound(SrcUniformFieldTypeData%AngleH) + UB(1:1) = ubound(SrcUniformFieldTypeData%AngleH) + if (.not. allocated(DstUniformFieldTypeData%AngleH)) then + allocate(DstUniformFieldTypeData%AngleH(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstUniformFieldTypeData%AngleH.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstUniformFieldTypeData%AngleH = SrcUniformFieldTypeData%AngleH + end if + if (allocated(SrcUniformFieldTypeData%AngleHDot)) then + LB(1:1) = lbound(SrcUniformFieldTypeData%AngleHDot) + UB(1:1) = ubound(SrcUniformFieldTypeData%AngleHDot) + if (.not. allocated(DstUniformFieldTypeData%AngleHDot)) then + allocate(DstUniformFieldTypeData%AngleHDot(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstUniformFieldTypeData%AngleHDot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstUniformFieldTypeData%AngleHDot = SrcUniformFieldTypeData%AngleHDot + end if + if (allocated(SrcUniformFieldTypeData%AngleV)) then + LB(1:1) = lbound(SrcUniformFieldTypeData%AngleV) + UB(1:1) = ubound(SrcUniformFieldTypeData%AngleV) + if (.not. allocated(DstUniformFieldTypeData%AngleV)) then + allocate(DstUniformFieldTypeData%AngleV(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstUniformFieldTypeData%AngleV.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstUniformFieldTypeData%AngleV = SrcUniformFieldTypeData%AngleV + end if + if (allocated(SrcUniformFieldTypeData%AngleVDot)) then + LB(1:1) = lbound(SrcUniformFieldTypeData%AngleVDot) + UB(1:1) = ubound(SrcUniformFieldTypeData%AngleVDot) + if (.not. allocated(DstUniformFieldTypeData%AngleVDot)) then + allocate(DstUniformFieldTypeData%AngleVDot(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstUniformFieldTypeData%AngleVDot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstUniformFieldTypeData%AngleVDot = SrcUniformFieldTypeData%AngleVDot + end if + if (allocated(SrcUniformFieldTypeData%ShrH)) then + LB(1:1) = lbound(SrcUniformFieldTypeData%ShrH) + UB(1:1) = ubound(SrcUniformFieldTypeData%ShrH) + if (.not. allocated(DstUniformFieldTypeData%ShrH)) then + allocate(DstUniformFieldTypeData%ShrH(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstUniformFieldTypeData%ShrH.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstUniformFieldTypeData%ShrH = SrcUniformFieldTypeData%ShrH + end if + if (allocated(SrcUniformFieldTypeData%ShrHDot)) then + LB(1:1) = lbound(SrcUniformFieldTypeData%ShrHDot) + UB(1:1) = ubound(SrcUniformFieldTypeData%ShrHDot) + if (.not. allocated(DstUniformFieldTypeData%ShrHDot)) then + allocate(DstUniformFieldTypeData%ShrHDot(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstUniformFieldTypeData%ShrHDot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstUniformFieldTypeData%ShrHDot = SrcUniformFieldTypeData%ShrHDot + end if + if (allocated(SrcUniformFieldTypeData%ShrV)) then + LB(1:1) = lbound(SrcUniformFieldTypeData%ShrV) + UB(1:1) = ubound(SrcUniformFieldTypeData%ShrV) + if (.not. allocated(DstUniformFieldTypeData%ShrV)) then + allocate(DstUniformFieldTypeData%ShrV(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstUniformFieldTypeData%ShrV.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstUniformFieldTypeData%ShrV = SrcUniformFieldTypeData%ShrV + end if + if (allocated(SrcUniformFieldTypeData%ShrVDot)) then + LB(1:1) = lbound(SrcUniformFieldTypeData%ShrVDot) + UB(1:1) = ubound(SrcUniformFieldTypeData%ShrVDot) + if (.not. allocated(DstUniformFieldTypeData%ShrVDot)) then + allocate(DstUniformFieldTypeData%ShrVDot(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstUniformFieldTypeData%ShrVDot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstUniformFieldTypeData%ShrVDot = SrcUniformFieldTypeData%ShrVDot + end if + if (allocated(SrcUniformFieldTypeData%LinShrV)) then + LB(1:1) = lbound(SrcUniformFieldTypeData%LinShrV) + UB(1:1) = ubound(SrcUniformFieldTypeData%LinShrV) + if (.not. allocated(DstUniformFieldTypeData%LinShrV)) then + allocate(DstUniformFieldTypeData%LinShrV(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstUniformFieldTypeData%LinShrV.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstUniformFieldTypeData%LinShrV = SrcUniformFieldTypeData%LinShrV + end if + if (allocated(SrcUniformFieldTypeData%LinShrVDot)) then + LB(1:1) = lbound(SrcUniformFieldTypeData%LinShrVDot) + UB(1:1) = ubound(SrcUniformFieldTypeData%LinShrVDot) + if (.not. allocated(DstUniformFieldTypeData%LinShrVDot)) then + allocate(DstUniformFieldTypeData%LinShrVDot(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstUniformFieldTypeData%LinShrVDot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstUniformFieldTypeData%LinShrVDot = SrcUniformFieldTypeData%LinShrVDot + end if +end subroutine + +subroutine IfW_FlowField_DestroyUniformFieldType(UniformFieldTypeData, ErrStat, ErrMsg) + type(UniformFieldType), intent(inout) :: UniformFieldTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'IfW_FlowField_DestroyUniformFieldType' ErrStat = ErrID_None - ErrMsg = "" - DstGrid3DFieldTypeData%WindFileFormat = SrcGrid3DFieldTypeData%WindFileFormat - DstGrid3DFieldTypeData%WindProfileType = SrcGrid3DFieldTypeData%WindProfileType - DstGrid3DFieldTypeData%Periodic = SrcGrid3DFieldTypeData%Periodic - DstGrid3DFieldTypeData%InterpTower = SrcGrid3DFieldTypeData%InterpTower - DstGrid3DFieldTypeData%AddMeanAfterInterp = SrcGrid3DFieldTypeData%AddMeanAfterInterp - DstGrid3DFieldTypeData%RefHeight = SrcGrid3DFieldTypeData%RefHeight - DstGrid3DFieldTypeData%RefLength = SrcGrid3DFieldTypeData%RefLength -IF (ALLOCATED(SrcGrid3DFieldTypeData%Vel)) THEN - i1_l = LBOUND(SrcGrid3DFieldTypeData%Vel,1) - i1_u = UBOUND(SrcGrid3DFieldTypeData%Vel,1) - i2_l = LBOUND(SrcGrid3DFieldTypeData%Vel,2) - i2_u = UBOUND(SrcGrid3DFieldTypeData%Vel,2) - i3_l = LBOUND(SrcGrid3DFieldTypeData%Vel,3) - i3_u = UBOUND(SrcGrid3DFieldTypeData%Vel,3) - i4_l = LBOUND(SrcGrid3DFieldTypeData%Vel,4) - i4_u = UBOUND(SrcGrid3DFieldTypeData%Vel,4) - IF (.NOT. ALLOCATED(DstGrid3DFieldTypeData%Vel)) THEN - ALLOCATE(DstGrid3DFieldTypeData%Vel(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 DstGrid3DFieldTypeData%Vel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstGrid3DFieldTypeData%Vel = SrcGrid3DFieldTypeData%Vel -ENDIF -IF (ALLOCATED(SrcGrid3DFieldTypeData%Acc)) THEN - i1_l = LBOUND(SrcGrid3DFieldTypeData%Acc,1) - i1_u = UBOUND(SrcGrid3DFieldTypeData%Acc,1) - i2_l = LBOUND(SrcGrid3DFieldTypeData%Acc,2) - i2_u = UBOUND(SrcGrid3DFieldTypeData%Acc,2) - i3_l = LBOUND(SrcGrid3DFieldTypeData%Acc,3) - i3_u = UBOUND(SrcGrid3DFieldTypeData%Acc,3) - i4_l = LBOUND(SrcGrid3DFieldTypeData%Acc,4) - i4_u = UBOUND(SrcGrid3DFieldTypeData%Acc,4) - IF (.NOT. ALLOCATED(DstGrid3DFieldTypeData%Acc)) THEN - ALLOCATE(DstGrid3DFieldTypeData%Acc(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 DstGrid3DFieldTypeData%Acc.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstGrid3DFieldTypeData%Acc = SrcGrid3DFieldTypeData%Acc -ENDIF -IF (ALLOCATED(SrcGrid3DFieldTypeData%VelTower)) THEN - i1_l = LBOUND(SrcGrid3DFieldTypeData%VelTower,1) - i1_u = UBOUND(SrcGrid3DFieldTypeData%VelTower,1) - i2_l = LBOUND(SrcGrid3DFieldTypeData%VelTower,2) - i2_u = UBOUND(SrcGrid3DFieldTypeData%VelTower,2) - i3_l = LBOUND(SrcGrid3DFieldTypeData%VelTower,3) - i3_u = UBOUND(SrcGrid3DFieldTypeData%VelTower,3) - IF (.NOT. ALLOCATED(DstGrid3DFieldTypeData%VelTower)) THEN - ALLOCATE(DstGrid3DFieldTypeData%VelTower(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstGrid3DFieldTypeData%VelTower.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstGrid3DFieldTypeData%VelTower = SrcGrid3DFieldTypeData%VelTower -ENDIF -IF (ALLOCATED(SrcGrid3DFieldTypeData%AccTower)) THEN - i1_l = LBOUND(SrcGrid3DFieldTypeData%AccTower,1) - i1_u = UBOUND(SrcGrid3DFieldTypeData%AccTower,1) - i2_l = LBOUND(SrcGrid3DFieldTypeData%AccTower,2) - i2_u = UBOUND(SrcGrid3DFieldTypeData%AccTower,2) - i3_l = LBOUND(SrcGrid3DFieldTypeData%AccTower,3) - i3_u = UBOUND(SrcGrid3DFieldTypeData%AccTower,3) - IF (.NOT. ALLOCATED(DstGrid3DFieldTypeData%AccTower)) THEN - ALLOCATE(DstGrid3DFieldTypeData%AccTower(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstGrid3DFieldTypeData%AccTower.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstGrid3DFieldTypeData%AccTower = SrcGrid3DFieldTypeData%AccTower -ENDIF -IF (ALLOCATED(SrcGrid3DFieldTypeData%VelAvg)) THEN - i1_l = LBOUND(SrcGrid3DFieldTypeData%VelAvg,1) - i1_u = UBOUND(SrcGrid3DFieldTypeData%VelAvg,1) - i2_l = LBOUND(SrcGrid3DFieldTypeData%VelAvg,2) - i2_u = UBOUND(SrcGrid3DFieldTypeData%VelAvg,2) - i3_l = LBOUND(SrcGrid3DFieldTypeData%VelAvg,3) - i3_u = UBOUND(SrcGrid3DFieldTypeData%VelAvg,3) - IF (.NOT. ALLOCATED(DstGrid3DFieldTypeData%VelAvg)) THEN - ALLOCATE(DstGrid3DFieldTypeData%VelAvg(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstGrid3DFieldTypeData%VelAvg.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstGrid3DFieldTypeData%VelAvg = SrcGrid3DFieldTypeData%VelAvg -ENDIF -IF (ALLOCATED(SrcGrid3DFieldTypeData%AccAvg)) THEN - i1_l = LBOUND(SrcGrid3DFieldTypeData%AccAvg,1) - i1_u = UBOUND(SrcGrid3DFieldTypeData%AccAvg,1) - i2_l = LBOUND(SrcGrid3DFieldTypeData%AccAvg,2) - i2_u = UBOUND(SrcGrid3DFieldTypeData%AccAvg,2) - i3_l = LBOUND(SrcGrid3DFieldTypeData%AccAvg,3) - i3_u = UBOUND(SrcGrid3DFieldTypeData%AccAvg,3) - IF (.NOT. ALLOCATED(DstGrid3DFieldTypeData%AccAvg)) THEN - ALLOCATE(DstGrid3DFieldTypeData%AccAvg(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstGrid3DFieldTypeData%AccAvg.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstGrid3DFieldTypeData%AccAvg = SrcGrid3DFieldTypeData%AccAvg -ENDIF - DstGrid3DFieldTypeData%DTime = SrcGrid3DFieldTypeData%DTime - DstGrid3DFieldTypeData%Rate = SrcGrid3DFieldTypeData%Rate - DstGrid3DFieldTypeData%YHWid = SrcGrid3DFieldTypeData%YHWid - DstGrid3DFieldTypeData%ZHWid = SrcGrid3DFieldTypeData%ZHWid - DstGrid3DFieldTypeData%GridBase = SrcGrid3DFieldTypeData%GridBase - DstGrid3DFieldTypeData%InitXPosition = SrcGrid3DFieldTypeData%InitXPosition - DstGrid3DFieldTypeData%InvDY = SrcGrid3DFieldTypeData%InvDY - DstGrid3DFieldTypeData%InvDZ = SrcGrid3DFieldTypeData%InvDZ - DstGrid3DFieldTypeData%MeanWS = SrcGrid3DFieldTypeData%MeanWS - DstGrid3DFieldTypeData%InvMWS = SrcGrid3DFieldTypeData%InvMWS - DstGrid3DFieldTypeData%TotalTime = SrcGrid3DFieldTypeData%TotalTime - DstGrid3DFieldTypeData%NComp = SrcGrid3DFieldTypeData%NComp - DstGrid3DFieldTypeData%NYGrids = SrcGrid3DFieldTypeData%NYGrids - DstGrid3DFieldTypeData%NZGrids = SrcGrid3DFieldTypeData%NZGrids - DstGrid3DFieldTypeData%NTGrids = SrcGrid3DFieldTypeData%NTGrids - DstGrid3DFieldTypeData%NSteps = SrcGrid3DFieldTypeData%NSteps - DstGrid3DFieldTypeData%PLExp = SrcGrid3DFieldTypeData%PLExp - DstGrid3DFieldTypeData%Z0 = SrcGrid3DFieldTypeData%Z0 - DstGrid3DFieldTypeData%VLinShr = SrcGrid3DFieldTypeData%VLinShr - DstGrid3DFieldTypeData%HLinShr = SrcGrid3DFieldTypeData%HLinShr - DstGrid3DFieldTypeData%BoxExceedAllowF = SrcGrid3DFieldTypeData%BoxExceedAllowF - DstGrid3DFieldTypeData%BoxExceedAllowIdx = SrcGrid3DFieldTypeData%BoxExceedAllowIdx - DstGrid3DFieldTypeData%BoxExceedWarned = SrcGrid3DFieldTypeData%BoxExceedWarned - END SUBROUTINE IfW_FlowField_CopyGrid3DFieldType - - SUBROUTINE IfW_FlowField_DestroyGrid3DFieldType( Grid3DFieldTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(Grid3DFieldType), INTENT(INOUT) :: Grid3DFieldTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IfW_FlowField_DestroyGrid3DFieldType' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(Grid3DFieldTypeData%Vel)) THEN - DEALLOCATE(Grid3DFieldTypeData%Vel) -ENDIF -IF (ALLOCATED(Grid3DFieldTypeData%Acc)) THEN - DEALLOCATE(Grid3DFieldTypeData%Acc) -ENDIF -IF (ALLOCATED(Grid3DFieldTypeData%VelTower)) THEN - DEALLOCATE(Grid3DFieldTypeData%VelTower) -ENDIF -IF (ALLOCATED(Grid3DFieldTypeData%AccTower)) THEN - DEALLOCATE(Grid3DFieldTypeData%AccTower) -ENDIF -IF (ALLOCATED(Grid3DFieldTypeData%VelAvg)) THEN - DEALLOCATE(Grid3DFieldTypeData%VelAvg) -ENDIF -IF (ALLOCATED(Grid3DFieldTypeData%AccAvg)) THEN - DEALLOCATE(Grid3DFieldTypeData%AccAvg) -ENDIF - END SUBROUTINE IfW_FlowField_DestroyGrid3DFieldType - - SUBROUTINE IfW_FlowField_PackGrid3DFieldType( 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(Grid3DFieldType), 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 = 'IfW_FlowField_PackGrid3DFieldType' - ! 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 ! WindFileFormat - Int_BufSz = Int_BufSz + 1 ! WindProfileType - Int_BufSz = Int_BufSz + 1 ! Periodic - Int_BufSz = Int_BufSz + 1 ! InterpTower - Int_BufSz = Int_BufSz + 1 ! AddMeanAfterInterp - Re_BufSz = Re_BufSz + 1 ! RefHeight - Re_BufSz = Re_BufSz + 1 ! RefLength - Int_BufSz = Int_BufSz + 1 ! Vel allocated yes/no - IF ( ALLOCATED(InData%Vel) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! Vel upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vel) ! Vel - END IF - Int_BufSz = Int_BufSz + 1 ! Acc allocated yes/no - IF ( ALLOCATED(InData%Acc) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! Acc upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Acc) ! Acc - END IF - Int_BufSz = Int_BufSz + 1 ! VelTower allocated yes/no - IF ( ALLOCATED(InData%VelTower) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! VelTower upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%VelTower) ! VelTower - END IF - Int_BufSz = Int_BufSz + 1 ! AccTower allocated yes/no - IF ( ALLOCATED(InData%AccTower) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! AccTower upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AccTower) ! AccTower - END IF - Int_BufSz = Int_BufSz + 1 ! VelAvg allocated yes/no - IF ( ALLOCATED(InData%VelAvg) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! VelAvg upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%VelAvg) ! VelAvg - END IF - Int_BufSz = Int_BufSz + 1 ! AccAvg allocated yes/no - IF ( ALLOCATED(InData%AccAvg) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! AccAvg upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AccAvg) ! AccAvg - END IF - Re_BufSz = Re_BufSz + 1 ! DTime - Re_BufSz = Re_BufSz + 1 ! Rate - Re_BufSz = Re_BufSz + 1 ! YHWid - Re_BufSz = Re_BufSz + 1 ! ZHWid - Re_BufSz = Re_BufSz + 1 ! GridBase - Re_BufSz = Re_BufSz + 1 ! InitXPosition - Re_BufSz = Re_BufSz + 1 ! InvDY - Re_BufSz = Re_BufSz + 1 ! InvDZ - Re_BufSz = Re_BufSz + 1 ! MeanWS - Re_BufSz = Re_BufSz + 1 ! InvMWS - Re_BufSz = Re_BufSz + 1 ! TotalTime - Int_BufSz = Int_BufSz + 1 ! NComp - Int_BufSz = Int_BufSz + 1 ! NYGrids - Int_BufSz = Int_BufSz + 1 ! NZGrids - Int_BufSz = Int_BufSz + 1 ! NTGrids - Int_BufSz = Int_BufSz + 1 ! NSteps - Re_BufSz = Re_BufSz + 1 ! PLExp - Re_BufSz = Re_BufSz + 1 ! Z0 - Re_BufSz = Re_BufSz + 1 ! VLinShr - Re_BufSz = Re_BufSz + 1 ! HLinShr - Int_BufSz = Int_BufSz + 1 ! BoxExceedAllowF - Int_BufSz = Int_BufSz + 1 ! BoxExceedAllowIdx - Int_BufSz = Int_BufSz + 1 ! BoxExceedWarned - 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%WindFileFormat - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%WindProfileType - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%Periodic, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%InterpTower, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%AddMeanAfterInterp, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RefHeight - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RefLength - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%Vel) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vel,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vel,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vel,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vel,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vel,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vel,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vel,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vel,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%Vel,4), UBOUND(InData%Vel,4) - DO i3 = LBOUND(InData%Vel,3), UBOUND(InData%Vel,3) - DO i2 = LBOUND(InData%Vel,2), UBOUND(InData%Vel,2) - DO i1 = LBOUND(InData%Vel,1), UBOUND(InData%Vel,1) - ReKiBuf(Re_Xferred) = InData%Vel(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - 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 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Acc,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Acc,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Acc,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Acc,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%Acc,4), UBOUND(InData%Acc,4) - DO i3 = LBOUND(InData%Acc,3), UBOUND(InData%Acc,3) - 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,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%VelTower) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%VelTower,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VelTower,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%VelTower,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VelTower,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%VelTower,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VelTower,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%VelTower,3), UBOUND(InData%VelTower,3) - DO i2 = LBOUND(InData%VelTower,2), UBOUND(InData%VelTower,2) - DO i1 = LBOUND(InData%VelTower,1), UBOUND(InData%VelTower,1) - ReKiBuf(Re_Xferred) = InData%VelTower(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AccTower) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AccTower,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AccTower,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AccTower,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AccTower,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AccTower,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AccTower,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%AccTower,3), UBOUND(InData%AccTower,3) - DO i2 = LBOUND(InData%AccTower,2), UBOUND(InData%AccTower,2) - DO i1 = LBOUND(InData%AccTower,1), UBOUND(InData%AccTower,1) - ReKiBuf(Re_Xferred) = InData%AccTower(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%VelAvg) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%VelAvg,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VelAvg,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%VelAvg,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VelAvg,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%VelAvg,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VelAvg,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%VelAvg,3), UBOUND(InData%VelAvg,3) - DO i2 = LBOUND(InData%VelAvg,2), UBOUND(InData%VelAvg,2) - DO i1 = LBOUND(InData%VelAvg,1), UBOUND(InData%VelAvg,1) - ReKiBuf(Re_Xferred) = InData%VelAvg(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AccAvg) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AccAvg,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AccAvg,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AccAvg,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AccAvg,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AccAvg,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AccAvg,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%AccAvg,3), UBOUND(InData%AccAvg,3) - DO i2 = LBOUND(InData%AccAvg,2), UBOUND(InData%AccAvg,2) - DO i1 = LBOUND(InData%AccAvg,1), UBOUND(InData%AccAvg,1) - ReKiBuf(Re_Xferred) = InData%AccAvg(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - ReKiBuf(Re_Xferred) = InData%DTime - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Rate - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%YHWid - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%ZHWid - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%GridBase - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%InitXPosition - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%InvDY - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%InvDZ - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MeanWS - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%InvMWS - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TotalTime - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NComp - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NYGrids - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NZGrids - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NTGrids - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NSteps - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PLExp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Z0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%VLinShr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%HLinShr - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%BoxExceedAllowF, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%BoxExceedAllowIdx - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%BoxExceedWarned, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE IfW_FlowField_PackGrid3DFieldType - - SUBROUTINE IfW_FlowField_UnPackGrid3DFieldType( 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(Grid3DFieldType), 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 = 'IfW_FlowField_UnPackGrid3DFieldType' - ! 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%WindFileFormat = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WindProfileType = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%Periodic = TRANSFER(IntKiBuf(Int_Xferred), OutData%Periodic) - Int_Xferred = Int_Xferred + 1 - OutData%InterpTower = TRANSFER(IntKiBuf(Int_Xferred), OutData%InterpTower) - Int_Xferred = Int_Xferred + 1 - OutData%AddMeanAfterInterp = TRANSFER(IntKiBuf(Int_Xferred), OutData%AddMeanAfterInterp) - Int_Xferred = Int_Xferred + 1 - OutData%RefHeight = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RefLength = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vel not allocated - Int_Xferred = Int_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%Vel)) DEALLOCATE(OutData%Vel) - ALLOCATE(OutData%Vel(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%Vel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%Vel,4), UBOUND(OutData%Vel,4) - DO i3 = LBOUND(OutData%Vel,3), UBOUND(OutData%Vel,3) - DO i2 = LBOUND(OutData%Vel,2), UBOUND(OutData%Vel,2) - DO i1 = LBOUND(OutData%Vel,1), UBOUND(OutData%Vel,1) - OutData%Vel(i1,i2,i3,i4) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - 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 - 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%Acc)) DEALLOCATE(OutData%Acc) - ALLOCATE(OutData%Acc(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%Acc.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%Acc,4), UBOUND(OutData%Acc,4) - DO i3 = LBOUND(OutData%Acc,3), UBOUND(OutData%Acc,3) - DO i2 = LBOUND(OutData%Acc,2), UBOUND(OutData%Acc,2) - DO i1 = LBOUND(OutData%Acc,1), UBOUND(OutData%Acc,1) - OutData%Acc(i1,i2,i3,i4) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! VelTower not allocated - Int_Xferred = Int_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%VelTower)) DEALLOCATE(OutData%VelTower) - ALLOCATE(OutData%VelTower(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%VelTower.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%VelTower,3), UBOUND(OutData%VelTower,3) - DO i2 = LBOUND(OutData%VelTower,2), UBOUND(OutData%VelTower,2) - DO i1 = LBOUND(OutData%VelTower,1), UBOUND(OutData%VelTower,1) - OutData%VelTower(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AccTower not allocated - Int_Xferred = Int_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%AccTower)) DEALLOCATE(OutData%AccTower) - ALLOCATE(OutData%AccTower(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%AccTower.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%AccTower,3), UBOUND(OutData%AccTower,3) - DO i2 = LBOUND(OutData%AccTower,2), UBOUND(OutData%AccTower,2) - DO i1 = LBOUND(OutData%AccTower,1), UBOUND(OutData%AccTower,1) - OutData%AccTower(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! VelAvg not allocated - Int_Xferred = Int_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%VelAvg)) DEALLOCATE(OutData%VelAvg) - ALLOCATE(OutData%VelAvg(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%VelAvg.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%VelAvg,3), UBOUND(OutData%VelAvg,3) - DO i2 = LBOUND(OutData%VelAvg,2), UBOUND(OutData%VelAvg,2) - DO i1 = LBOUND(OutData%VelAvg,1), UBOUND(OutData%VelAvg,1) - OutData%VelAvg(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AccAvg not allocated - Int_Xferred = Int_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%AccAvg)) DEALLOCATE(OutData%AccAvg) - ALLOCATE(OutData%AccAvg(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%AccAvg.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%AccAvg,3), UBOUND(OutData%AccAvg,3) - DO i2 = LBOUND(OutData%AccAvg,2), UBOUND(OutData%AccAvg,2) - DO i1 = LBOUND(OutData%AccAvg,1), UBOUND(OutData%AccAvg,1) - OutData%AccAvg(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - OutData%DTime = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Rate = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%YHWid = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%ZHWid = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%GridBase = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%InitXPosition = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%InvDY = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%InvDZ = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MeanWS = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%InvMWS = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TotalTime = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NComp = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NYGrids = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NZGrids = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NTGrids = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NSteps = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%PLExp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Z0 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%VLinShr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%HLinShr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%BoxExceedAllowF = TRANSFER(IntKiBuf(Int_Xferred), OutData%BoxExceedAllowF) - Int_Xferred = Int_Xferred + 1 - OutData%BoxExceedAllowIdx = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%BoxExceedWarned = TRANSFER(IntKiBuf(Int_Xferred), OutData%BoxExceedWarned) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE IfW_FlowField_UnPackGrid3DFieldType - - SUBROUTINE IfW_FlowField_CopyGrid4DFieldType( SrcGrid4DFieldTypeData, DstGrid4DFieldTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Grid4DFieldType), INTENT(IN) :: SrcGrid4DFieldTypeData - TYPE(Grid4DFieldType), INTENT(INOUT) :: DstGrid4DFieldTypeData - 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) :: i5, i5_l, i5_u ! bounds (upper/lower) for an array dimension 5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IfW_FlowField_CopyGrid4DFieldType' -! + ErrMsg = '' + if (allocated(UniformFieldTypeData%Time)) then + deallocate(UniformFieldTypeData%Time) + end if + if (allocated(UniformFieldTypeData%VelH)) then + deallocate(UniformFieldTypeData%VelH) + end if + if (allocated(UniformFieldTypeData%VelHDot)) then + deallocate(UniformFieldTypeData%VelHDot) + end if + if (allocated(UniformFieldTypeData%VelV)) then + deallocate(UniformFieldTypeData%VelV) + end if + if (allocated(UniformFieldTypeData%VelVDot)) then + deallocate(UniformFieldTypeData%VelVDot) + end if + if (allocated(UniformFieldTypeData%VelGust)) then + deallocate(UniformFieldTypeData%VelGust) + end if + if (allocated(UniformFieldTypeData%VelGustDot)) then + deallocate(UniformFieldTypeData%VelGustDot) + end if + if (allocated(UniformFieldTypeData%AngleH)) then + deallocate(UniformFieldTypeData%AngleH) + end if + if (allocated(UniformFieldTypeData%AngleHDot)) then + deallocate(UniformFieldTypeData%AngleHDot) + end if + if (allocated(UniformFieldTypeData%AngleV)) then + deallocate(UniformFieldTypeData%AngleV) + end if + if (allocated(UniformFieldTypeData%AngleVDot)) then + deallocate(UniformFieldTypeData%AngleVDot) + end if + if (allocated(UniformFieldTypeData%ShrH)) then + deallocate(UniformFieldTypeData%ShrH) + end if + if (allocated(UniformFieldTypeData%ShrHDot)) then + deallocate(UniformFieldTypeData%ShrHDot) + end if + if (allocated(UniformFieldTypeData%ShrV)) then + deallocate(UniformFieldTypeData%ShrV) + end if + if (allocated(UniformFieldTypeData%ShrVDot)) then + deallocate(UniformFieldTypeData%ShrVDot) + end if + if (allocated(UniformFieldTypeData%LinShrV)) then + deallocate(UniformFieldTypeData%LinShrV) + end if + if (allocated(UniformFieldTypeData%LinShrVDot)) then + deallocate(UniformFieldTypeData%LinShrVDot) + end if +end subroutine + +subroutine IfW_FlowField_PackUniformFieldType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(UniformFieldType), intent(in) :: InData + character(*), parameter :: RoutineName = 'IfW_FlowField_PackUniformFieldType' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%RefHeight) + call RegPack(RF, InData%RefLength) + call RegPack(RF, InData%DataSize) + call RegPackAlloc(RF, InData%Time) + call RegPackAlloc(RF, InData%VelH) + call RegPackAlloc(RF, InData%VelHDot) + call RegPackAlloc(RF, InData%VelV) + call RegPackAlloc(RF, InData%VelVDot) + call RegPackAlloc(RF, InData%VelGust) + call RegPackAlloc(RF, InData%VelGustDot) + call RegPackAlloc(RF, InData%AngleH) + call RegPackAlloc(RF, InData%AngleHDot) + call RegPackAlloc(RF, InData%AngleV) + call RegPackAlloc(RF, InData%AngleVDot) + call RegPackAlloc(RF, InData%ShrH) + call RegPackAlloc(RF, InData%ShrHDot) + call RegPackAlloc(RF, InData%ShrV) + call RegPackAlloc(RF, InData%ShrVDot) + call RegPackAlloc(RF, InData%LinShrV) + call RegPackAlloc(RF, InData%LinShrVDot) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine IfW_FlowField_UnPackUniformFieldType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(UniformFieldType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'IfW_FlowField_UnPackUniformFieldType' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%RefHeight); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RefLength); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DataSize); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Time); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%VelH); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%VelHDot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%VelV); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%VelVDot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%VelGust); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%VelGustDot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AngleH); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AngleHDot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AngleV); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AngleVDot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ShrH); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ShrHDot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ShrV); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ShrVDot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LinShrV); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LinShrVDot); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine IfW_FlowField_CopyUniformField_Interp(SrcUniformField_InterpData, DstUniformField_InterpData, CtrlCode, ErrStat, ErrMsg) + type(UniformField_Interp), intent(in) :: SrcUniformField_InterpData + type(UniformField_Interp), intent(inout) :: DstUniformField_InterpData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'IfW_FlowField_CopyUniformField_Interp' ErrStat = ErrID_None - ErrMsg = "" - DstGrid4DFieldTypeData%n = SrcGrid4DFieldTypeData%n - DstGrid4DFieldTypeData%delta = SrcGrid4DFieldTypeData%delta - DstGrid4DFieldTypeData%pZero = SrcGrid4DFieldTypeData%pZero -IF (ALLOCATED(SrcGrid4DFieldTypeData%Vel)) THEN - i1_l = LBOUND(SrcGrid4DFieldTypeData%Vel,1) - i1_u = UBOUND(SrcGrid4DFieldTypeData%Vel,1) - i2_l = LBOUND(SrcGrid4DFieldTypeData%Vel,2) - i2_u = UBOUND(SrcGrid4DFieldTypeData%Vel,2) - i3_l = LBOUND(SrcGrid4DFieldTypeData%Vel,3) - i3_u = UBOUND(SrcGrid4DFieldTypeData%Vel,3) - i4_l = LBOUND(SrcGrid4DFieldTypeData%Vel,4) - i4_u = UBOUND(SrcGrid4DFieldTypeData%Vel,4) - i5_l = LBOUND(SrcGrid4DFieldTypeData%Vel,5) - i5_u = UBOUND(SrcGrid4DFieldTypeData%Vel,5) - IF (.NOT. ALLOCATED(DstGrid4DFieldTypeData%Vel)) THEN - ALLOCATE(DstGrid4DFieldTypeData%Vel(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u,i5_l:i5_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstGrid4DFieldTypeData%Vel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstGrid4DFieldTypeData%Vel = SrcGrid4DFieldTypeData%Vel -ENDIF - DstGrid4DFieldTypeData%TimeStart = SrcGrid4DFieldTypeData%TimeStart - DstGrid4DFieldTypeData%RefHeight = SrcGrid4DFieldTypeData%RefHeight - END SUBROUTINE IfW_FlowField_CopyGrid4DFieldType - - SUBROUTINE IfW_FlowField_DestroyGrid4DFieldType( Grid4DFieldTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(Grid4DFieldType), INTENT(INOUT) :: Grid4DFieldTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IfW_FlowField_DestroyGrid4DFieldType' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(Grid4DFieldTypeData%Vel)) THEN - DEALLOCATE(Grid4DFieldTypeData%Vel) -ENDIF - END SUBROUTINE IfW_FlowField_DestroyGrid4DFieldType - - SUBROUTINE IfW_FlowField_PackGrid4DFieldType( 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(Grid4DFieldType), 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 = 'IfW_FlowField_PackGrid4DFieldType' - ! 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 + SIZE(InData%n) ! n - Db_BufSz = Db_BufSz + SIZE(InData%delta) ! delta - Re_BufSz = Re_BufSz + SIZE(InData%pZero) ! pZero - Int_BufSz = Int_BufSz + 1 ! Vel allocated yes/no - IF ( ALLOCATED(InData%Vel) ) THEN - Int_BufSz = Int_BufSz + 2*5 ! Vel upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vel) ! Vel - END IF - Db_BufSz = Db_BufSz + 1 ! TimeStart - Re_BufSz = Re_BufSz + 1 ! RefHeight - 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%n,1), UBOUND(InData%n,1) - IntKiBuf(Int_Xferred) = InData%n(i1) - Int_Xferred = Int_Xferred + 1 - END DO - DO i1 = LBOUND(InData%delta,1), UBOUND(InData%delta,1) - DbKiBuf(Db_Xferred) = InData%delta(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%pZero,1), UBOUND(InData%pZero,1) - ReKiBuf(Re_Xferred) = InData%pZero(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%Vel) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vel,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vel,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vel,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vel,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vel,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vel,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vel,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vel,4) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vel,5) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vel,5) - Int_Xferred = Int_Xferred + 2 - - DO i5 = LBOUND(InData%Vel,5), UBOUND(InData%Vel,5) - DO i4 = LBOUND(InData%Vel,4), UBOUND(InData%Vel,4) - DO i3 = LBOUND(InData%Vel,3), UBOUND(InData%Vel,3) - DO i2 = LBOUND(InData%Vel,2), UBOUND(InData%Vel,2) - DO i1 = LBOUND(InData%Vel,1), UBOUND(InData%Vel,1) - ReKiBuf(Re_Xferred) = InData%Vel(i1,i2,i3,i4,i5) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END DO - END IF - DbKiBuf(Db_Xferred) = InData%TimeStart - Db_Xferred = Db_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RefHeight - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE IfW_FlowField_PackGrid4DFieldType - - SUBROUTINE IfW_FlowField_UnPackGrid4DFieldType( 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(Grid4DFieldType), 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) :: i5, i5_l, i5_u ! bounds (upper/lower) for an array dimension 5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IfW_FlowField_UnPackGrid4DFieldType' - ! 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%n,1) - i1_u = UBOUND(OutData%n,1) - DO i1 = LBOUND(OutData%n,1), UBOUND(OutData%n,1) - OutData%n(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - i1_l = LBOUND(OutData%delta,1) - i1_u = UBOUND(OutData%delta,1) - DO i1 = LBOUND(OutData%delta,1), UBOUND(OutData%delta,1) - OutData%delta(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%pZero,1) - i1_u = UBOUND(OutData%pZero,1) - DO i1 = LBOUND(OutData%pZero,1), UBOUND(OutData%pZero,1) - OutData%pZero(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vel not allocated - Int_Xferred = Int_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 - i5_l = IntKiBuf( Int_Xferred ) - i5_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Vel)) DEALLOCATE(OutData%Vel) - ALLOCATE(OutData%Vel(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u,i5_l:i5_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i5 = LBOUND(OutData%Vel,5), UBOUND(OutData%Vel,5) - DO i4 = LBOUND(OutData%Vel,4), UBOUND(OutData%Vel,4) - DO i3 = LBOUND(OutData%Vel,3), UBOUND(OutData%Vel,3) - DO i2 = LBOUND(OutData%Vel,2), UBOUND(OutData%Vel,2) - DO i1 = LBOUND(OutData%Vel,1), UBOUND(OutData%Vel,1) - OutData%Vel(i1,i2,i3,i4,i5) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END DO - END IF - OutData%TimeStart = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%RefHeight = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE IfW_FlowField_UnPackGrid4DFieldType - - SUBROUTINE IfW_FlowField_CopyPointsFieldType( SrcPointsFieldTypeData, DstPointsFieldTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(PointsFieldType), INTENT(IN) :: SrcPointsFieldTypeData - TYPE(PointsFieldType), INTENT(INOUT) :: DstPointsFieldTypeData - 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 = 'IfW_FlowField_CopyPointsFieldType' -! + ErrMsg = '' + DstUniformField_InterpData%VelH = SrcUniformField_InterpData%VelH + DstUniformField_InterpData%VelHDot = SrcUniformField_InterpData%VelHDot + DstUniformField_InterpData%VelV = SrcUniformField_InterpData%VelV + DstUniformField_InterpData%VelVDot = SrcUniformField_InterpData%VelVDot + DstUniformField_InterpData%VelGust = SrcUniformField_InterpData%VelGust + DstUniformField_InterpData%VelGustDot = SrcUniformField_InterpData%VelGustDot + DstUniformField_InterpData%AngleH = SrcUniformField_InterpData%AngleH + DstUniformField_InterpData%AngleHDot = SrcUniformField_InterpData%AngleHDot + DstUniformField_InterpData%AngleV = SrcUniformField_InterpData%AngleV + DstUniformField_InterpData%AngleVDot = SrcUniformField_InterpData%AngleVDot + DstUniformField_InterpData%ShrH = SrcUniformField_InterpData%ShrH + DstUniformField_InterpData%ShrHDot = SrcUniformField_InterpData%ShrHDot + DstUniformField_InterpData%ShrV = SrcUniformField_InterpData%ShrV + DstUniformField_InterpData%ShrVDot = SrcUniformField_InterpData%ShrVDot + DstUniformField_InterpData%LinShrV = SrcUniformField_InterpData%LinShrV + DstUniformField_InterpData%LinShrVDot = SrcUniformField_InterpData%LinShrVDot + DstUniformField_InterpData%CosAngleH = SrcUniformField_InterpData%CosAngleH + DstUniformField_InterpData%SinAngleH = SrcUniformField_InterpData%SinAngleH + DstUniformField_InterpData%CosAngleV = SrcUniformField_InterpData%CosAngleV + DstUniformField_InterpData%SinAngleV = SrcUniformField_InterpData%SinAngleV +end subroutine + +subroutine IfW_FlowField_DestroyUniformField_Interp(UniformField_InterpData, ErrStat, ErrMsg) + type(UniformField_Interp), intent(inout) :: UniformField_InterpData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'IfW_FlowField_DestroyUniformField_Interp' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcPointsFieldTypeData%Vel)) THEN - i1_l = LBOUND(SrcPointsFieldTypeData%Vel,1) - i1_u = UBOUND(SrcPointsFieldTypeData%Vel,1) - i2_l = LBOUND(SrcPointsFieldTypeData%Vel,2) - i2_u = UBOUND(SrcPointsFieldTypeData%Vel,2) - IF (.NOT. ALLOCATED(DstPointsFieldTypeData%Vel)) THEN - ALLOCATE(DstPointsFieldTypeData%Vel(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstPointsFieldTypeData%Vel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstPointsFieldTypeData%Vel = SrcPointsFieldTypeData%Vel -ENDIF - END SUBROUTINE IfW_FlowField_CopyPointsFieldType - - SUBROUTINE IfW_FlowField_DestroyPointsFieldType( PointsFieldTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(PointsFieldType), INTENT(INOUT) :: PointsFieldTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IfW_FlowField_DestroyPointsFieldType' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(PointsFieldTypeData%Vel)) THEN - DEALLOCATE(PointsFieldTypeData%Vel) -ENDIF - END SUBROUTINE IfW_FlowField_DestroyPointsFieldType - - SUBROUTINE IfW_FlowField_PackPointsFieldType( 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(PointsFieldType), 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 = 'IfW_FlowField_PackPointsFieldType' - ! 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 ! Vel allocated yes/no - IF ( ALLOCATED(InData%Vel) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Vel upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vel) ! Vel - 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%Vel) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vel,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vel,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vel,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vel,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Vel,2), UBOUND(InData%Vel,2) - DO i1 = LBOUND(InData%Vel,1), UBOUND(InData%Vel,1) - ReKiBuf(Re_Xferred) = InData%Vel(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE IfW_FlowField_PackPointsFieldType - - SUBROUTINE IfW_FlowField_UnPackPointsFieldType( 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(PointsFieldType), 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 = 'IfW_FlowField_UnPackPointsFieldType' - ! 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 ! Vel not allocated - Int_Xferred = Int_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%Vel)) DEALLOCATE(OutData%Vel) - ALLOCATE(OutData%Vel(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Vel,2), UBOUND(OutData%Vel,2) - DO i1 = LBOUND(OutData%Vel,1), UBOUND(OutData%Vel,1) - OutData%Vel(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE IfW_FlowField_UnPackPointsFieldType - - SUBROUTINE IfW_FlowField_CopyUserFieldType( SrcUserFieldTypeData, DstUserFieldTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(UserFieldType), INTENT(IN) :: SrcUserFieldTypeData - TYPE(UserFieldType), INTENT(INOUT) :: DstUserFieldTypeData - 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 = 'IfW_FlowField_CopyUserFieldType' -! + ErrMsg = '' +end subroutine + +subroutine IfW_FlowField_PackUniformField_Interp(RF, Indata) + type(RegFile), intent(inout) :: RF + type(UniformField_Interp), intent(in) :: InData + character(*), parameter :: RoutineName = 'IfW_FlowField_PackUniformField_Interp' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%VelH) + call RegPack(RF, InData%VelHDot) + call RegPack(RF, InData%VelV) + call RegPack(RF, InData%VelVDot) + call RegPack(RF, InData%VelGust) + call RegPack(RF, InData%VelGustDot) + call RegPack(RF, InData%AngleH) + call RegPack(RF, InData%AngleHDot) + call RegPack(RF, InData%AngleV) + call RegPack(RF, InData%AngleVDot) + call RegPack(RF, InData%ShrH) + call RegPack(RF, InData%ShrHDot) + call RegPack(RF, InData%ShrV) + call RegPack(RF, InData%ShrVDot) + call RegPack(RF, InData%LinShrV) + call RegPack(RF, InData%LinShrVDot) + call RegPack(RF, InData%CosAngleH) + call RegPack(RF, InData%SinAngleH) + call RegPack(RF, InData%CosAngleV) + call RegPack(RF, InData%SinAngleV) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine IfW_FlowField_UnPackUniformField_Interp(RF, OutData) + type(RegFile), intent(inout) :: RF + type(UniformField_Interp), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'IfW_FlowField_UnPackUniformField_Interp' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%VelH); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VelHDot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VelV); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VelVDot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VelGust); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VelGustDot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AngleH); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AngleHDot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AngleV); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AngleVDot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ShrH); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ShrHDot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ShrV); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ShrVDot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LinShrV); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LinShrVDot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CosAngleH); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SinAngleH); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CosAngleV); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SinAngleV); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine IfW_FlowField_CopyGrid3DFieldType(SrcGrid3DFieldTypeData, DstGrid3DFieldTypeData, CtrlCode, ErrStat, ErrMsg) + type(Grid3DFieldType), intent(in) :: SrcGrid3DFieldTypeData + type(Grid3DFieldType), intent(inout) :: DstGrid3DFieldTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(4), UB(4) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'IfW_FlowField_CopyGrid3DFieldType' ErrStat = ErrID_None - ErrMsg = "" - DstUserFieldTypeData%RefHeight = SrcUserFieldTypeData%RefHeight - END SUBROUTINE IfW_FlowField_CopyUserFieldType - - SUBROUTINE IfW_FlowField_DestroyUserFieldType( UserFieldTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(UserFieldType), INTENT(INOUT) :: UserFieldTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IfW_FlowField_DestroyUserFieldType' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE IfW_FlowField_DestroyUserFieldType - - SUBROUTINE IfW_FlowField_PackUserFieldType( 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(UserFieldType), 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 = 'IfW_FlowField_PackUserFieldType' - ! 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 ! RefHeight - 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%RefHeight - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE IfW_FlowField_PackUserFieldType - - SUBROUTINE IfW_FlowField_UnPackUserFieldType( 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(UserFieldType), 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 = 'IfW_FlowField_UnPackUserFieldType' - ! 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%RefHeight = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE IfW_FlowField_UnPackUserFieldType - - SUBROUTINE IfW_FlowField_CopyFlowFieldType( SrcFlowFieldTypeData, DstFlowFieldTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FlowFieldType), INTENT(IN) :: SrcFlowFieldTypeData - TYPE(FlowFieldType), INTENT(INOUT) :: DstFlowFieldTypeData - 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 = 'IfW_FlowField_CopyFlowFieldType' -! + ErrMsg = '' + DstGrid3DFieldTypeData%WindFileFormat = SrcGrid3DFieldTypeData%WindFileFormat + DstGrid3DFieldTypeData%WindProfileType = SrcGrid3DFieldTypeData%WindProfileType + DstGrid3DFieldTypeData%Periodic = SrcGrid3DFieldTypeData%Periodic + DstGrid3DFieldTypeData%InterpTower = SrcGrid3DFieldTypeData%InterpTower + DstGrid3DFieldTypeData%AddMeanAfterInterp = SrcGrid3DFieldTypeData%AddMeanAfterInterp + DstGrid3DFieldTypeData%RefHeight = SrcGrid3DFieldTypeData%RefHeight + DstGrid3DFieldTypeData%RefLength = SrcGrid3DFieldTypeData%RefLength + if (allocated(SrcGrid3DFieldTypeData%Vel)) then + LB(1:4) = lbound(SrcGrid3DFieldTypeData%Vel) + UB(1:4) = ubound(SrcGrid3DFieldTypeData%Vel) + if (.not. allocated(DstGrid3DFieldTypeData%Vel)) then + allocate(DstGrid3DFieldTypeData%Vel(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstGrid3DFieldTypeData%Vel.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstGrid3DFieldTypeData%Vel = SrcGrid3DFieldTypeData%Vel + end if + if (allocated(SrcGrid3DFieldTypeData%Acc)) then + LB(1:4) = lbound(SrcGrid3DFieldTypeData%Acc) + UB(1:4) = ubound(SrcGrid3DFieldTypeData%Acc) + if (.not. allocated(DstGrid3DFieldTypeData%Acc)) then + allocate(DstGrid3DFieldTypeData%Acc(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstGrid3DFieldTypeData%Acc.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstGrid3DFieldTypeData%Acc = SrcGrid3DFieldTypeData%Acc + end if + if (allocated(SrcGrid3DFieldTypeData%VelTower)) then + LB(1:3) = lbound(SrcGrid3DFieldTypeData%VelTower) + UB(1:3) = ubound(SrcGrid3DFieldTypeData%VelTower) + if (.not. allocated(DstGrid3DFieldTypeData%VelTower)) then + allocate(DstGrid3DFieldTypeData%VelTower(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstGrid3DFieldTypeData%VelTower.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstGrid3DFieldTypeData%VelTower = SrcGrid3DFieldTypeData%VelTower + end if + if (allocated(SrcGrid3DFieldTypeData%AccTower)) then + LB(1:3) = lbound(SrcGrid3DFieldTypeData%AccTower) + UB(1:3) = ubound(SrcGrid3DFieldTypeData%AccTower) + if (.not. allocated(DstGrid3DFieldTypeData%AccTower)) then + allocate(DstGrid3DFieldTypeData%AccTower(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstGrid3DFieldTypeData%AccTower.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstGrid3DFieldTypeData%AccTower = SrcGrid3DFieldTypeData%AccTower + end if + if (allocated(SrcGrid3DFieldTypeData%VelAvg)) then + LB(1:3) = lbound(SrcGrid3DFieldTypeData%VelAvg) + UB(1:3) = ubound(SrcGrid3DFieldTypeData%VelAvg) + if (.not. allocated(DstGrid3DFieldTypeData%VelAvg)) then + allocate(DstGrid3DFieldTypeData%VelAvg(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstGrid3DFieldTypeData%VelAvg.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstGrid3DFieldTypeData%VelAvg = SrcGrid3DFieldTypeData%VelAvg + end if + if (allocated(SrcGrid3DFieldTypeData%AccAvg)) then + LB(1:3) = lbound(SrcGrid3DFieldTypeData%AccAvg) + UB(1:3) = ubound(SrcGrid3DFieldTypeData%AccAvg) + if (.not. allocated(DstGrid3DFieldTypeData%AccAvg)) then + allocate(DstGrid3DFieldTypeData%AccAvg(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstGrid3DFieldTypeData%AccAvg.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstGrid3DFieldTypeData%AccAvg = SrcGrid3DFieldTypeData%AccAvg + end if + DstGrid3DFieldTypeData%DTime = SrcGrid3DFieldTypeData%DTime + DstGrid3DFieldTypeData%Rate = SrcGrid3DFieldTypeData%Rate + DstGrid3DFieldTypeData%YHWid = SrcGrid3DFieldTypeData%YHWid + DstGrid3DFieldTypeData%ZHWid = SrcGrid3DFieldTypeData%ZHWid + DstGrid3DFieldTypeData%GridBase = SrcGrid3DFieldTypeData%GridBase + DstGrid3DFieldTypeData%InitXPosition = SrcGrid3DFieldTypeData%InitXPosition + DstGrid3DFieldTypeData%InvDY = SrcGrid3DFieldTypeData%InvDY + DstGrid3DFieldTypeData%InvDZ = SrcGrid3DFieldTypeData%InvDZ + DstGrid3DFieldTypeData%MeanWS = SrcGrid3DFieldTypeData%MeanWS + DstGrid3DFieldTypeData%InvMWS = SrcGrid3DFieldTypeData%InvMWS + DstGrid3DFieldTypeData%TotalTime = SrcGrid3DFieldTypeData%TotalTime + DstGrid3DFieldTypeData%NComp = SrcGrid3DFieldTypeData%NComp + DstGrid3DFieldTypeData%NYGrids = SrcGrid3DFieldTypeData%NYGrids + DstGrid3DFieldTypeData%NZGrids = SrcGrid3DFieldTypeData%NZGrids + DstGrid3DFieldTypeData%NTGrids = SrcGrid3DFieldTypeData%NTGrids + DstGrid3DFieldTypeData%NSteps = SrcGrid3DFieldTypeData%NSteps + DstGrid3DFieldTypeData%PLExp = SrcGrid3DFieldTypeData%PLExp + DstGrid3DFieldTypeData%Z0 = SrcGrid3DFieldTypeData%Z0 + DstGrid3DFieldTypeData%VLinShr = SrcGrid3DFieldTypeData%VLinShr + DstGrid3DFieldTypeData%HLinShr = SrcGrid3DFieldTypeData%HLinShr + DstGrid3DFieldTypeData%BoxExceedAllow = SrcGrid3DFieldTypeData%BoxExceedAllow + DstGrid3DFieldTypeData%BoxExceedAllowDrv = SrcGrid3DFieldTypeData%BoxExceedAllowDrv +end subroutine + +subroutine IfW_FlowField_DestroyGrid3DFieldType(Grid3DFieldTypeData, ErrStat, ErrMsg) + type(Grid3DFieldType), intent(inout) :: Grid3DFieldTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'IfW_FlowField_DestroyGrid3DFieldType' ErrStat = ErrID_None - ErrMsg = "" - DstFlowFieldTypeData%FieldType = SrcFlowFieldTypeData%FieldType - DstFlowFieldTypeData%RefPosition = SrcFlowFieldTypeData%RefPosition - DstFlowFieldTypeData%PropagationDir = SrcFlowFieldTypeData%PropagationDir - DstFlowFieldTypeData%VFlowAngle = SrcFlowFieldTypeData%VFlowAngle - DstFlowFieldTypeData%VelInterpCubic = SrcFlowFieldTypeData%VelInterpCubic - DstFlowFieldTypeData%RotateWindBox = SrcFlowFieldTypeData%RotateWindBox - DstFlowFieldTypeData%AccFieldValid = SrcFlowFieldTypeData%AccFieldValid - DstFlowFieldTypeData%RotToWind = SrcFlowFieldTypeData%RotToWind - DstFlowFieldTypeData%RotFromWind = SrcFlowFieldTypeData%RotFromWind - CALL IfW_FlowField_Copyuniformfieldtype( SrcFlowFieldTypeData%Uniform, DstFlowFieldTypeData%Uniform, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL IfW_FlowField_Copygrid3dfieldtype( SrcFlowFieldTypeData%Grid3D, DstFlowFieldTypeData%Grid3D, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL IfW_FlowField_Copygrid4dfieldtype( SrcFlowFieldTypeData%Grid4D, DstFlowFieldTypeData%Grid4D, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL IfW_FlowField_Copypointsfieldtype( SrcFlowFieldTypeData%Points, DstFlowFieldTypeData%Points, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL IfW_FlowField_Copyuserfieldtype( SrcFlowFieldTypeData%User, DstFlowFieldTypeData%User, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE IfW_FlowField_CopyFlowFieldType - - SUBROUTINE IfW_FlowField_DestroyFlowFieldType( FlowFieldTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(FlowFieldType), INTENT(INOUT) :: FlowFieldTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IfW_FlowField_DestroyFlowFieldType' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL IfW_FlowField_Destroyuniformfieldtype( FlowFieldTypeData%Uniform, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL IfW_FlowField_Destroygrid3dfieldtype( FlowFieldTypeData%Grid3D, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL IfW_FlowField_Destroygrid4dfieldtype( FlowFieldTypeData%Grid4D, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL IfW_FlowField_Destroypointsfieldtype( FlowFieldTypeData%Points, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL IfW_FlowField_Destroyuserfieldtype( FlowFieldTypeData%User, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE IfW_FlowField_DestroyFlowFieldType - - SUBROUTINE IfW_FlowField_PackFlowFieldType( 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(FlowFieldType), 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 = 'IfW_FlowField_PackFlowFieldType' - ! 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 ! FieldType - Re_BufSz = Re_BufSz + SIZE(InData%RefPosition) ! RefPosition - Re_BufSz = Re_BufSz + 1 ! PropagationDir - Re_BufSz = Re_BufSz + 1 ! VFlowAngle - Int_BufSz = Int_BufSz + 1 ! VelInterpCubic - Int_BufSz = Int_BufSz + 1 ! RotateWindBox - Int_BufSz = Int_BufSz + 1 ! AccFieldValid - Re_BufSz = Re_BufSz + SIZE(InData%RotToWind) ! RotToWind - Re_BufSz = Re_BufSz + SIZE(InData%RotFromWind) ! RotFromWind - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! Uniform: size of buffers for each call to pack subtype - CALL IfW_FlowField_Packuniformfieldtype( Re_Buf, Db_Buf, Int_Buf, InData%Uniform, ErrStat2, ErrMsg2, .TRUE. ) ! Uniform - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Uniform - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Uniform - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Uniform - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! Grid3D: size of buffers for each call to pack subtype - CALL IfW_FlowField_Packgrid3dfieldtype( Re_Buf, Db_Buf, Int_Buf, InData%Grid3D, ErrStat2, ErrMsg2, .TRUE. ) ! Grid3D - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Grid3D - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Grid3D - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Grid3D - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! Grid4D: size of buffers for each call to pack subtype - CALL IfW_FlowField_Packgrid4dfieldtype( Re_Buf, Db_Buf, Int_Buf, InData%Grid4D, ErrStat2, ErrMsg2, .TRUE. ) ! Grid4D - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Grid4D - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Grid4D - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Grid4D - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! Points: size of buffers for each call to pack subtype - CALL IfW_FlowField_Packpointsfieldtype( Re_Buf, Db_Buf, Int_Buf, InData%Points, ErrStat2, ErrMsg2, .TRUE. ) ! Points - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Points - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Points - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Points - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! User: size of buffers for each call to pack subtype - CALL IfW_FlowField_Packuserfieldtype( Re_Buf, Db_Buf, Int_Buf, InData%User, ErrStat2, ErrMsg2, .TRUE. ) ! User - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! User - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! User - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! User - 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 - - IntKiBuf(Int_Xferred) = InData%FieldType - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%RefPosition,1), UBOUND(InData%RefPosition,1) - ReKiBuf(Re_Xferred) = InData%RefPosition(i1) - Re_Xferred = Re_Xferred + 1 - END DO - ReKiBuf(Re_Xferred) = InData%PropagationDir - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%VFlowAngle - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%VelInterpCubic, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%RotateWindBox, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%AccFieldValid, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - DO i2 = LBOUND(InData%RotToWind,2), UBOUND(InData%RotToWind,2) - DO i1 = LBOUND(InData%RotToWind,1), UBOUND(InData%RotToWind,1) - ReKiBuf(Re_Xferred) = InData%RotToWind(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - DO i2 = LBOUND(InData%RotFromWind,2), UBOUND(InData%RotFromWind,2) - DO i1 = LBOUND(InData%RotFromWind,1), UBOUND(InData%RotFromWind,1) - ReKiBuf(Re_Xferred) = InData%RotFromWind(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - CALL IfW_FlowField_Packuniformfieldtype( Re_Buf, Db_Buf, Int_Buf, InData%Uniform, ErrStat2, ErrMsg2, OnlySize ) ! Uniform - 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 IfW_FlowField_Packgrid3dfieldtype( Re_Buf, Db_Buf, Int_Buf, InData%Grid3D, ErrStat2, ErrMsg2, OnlySize ) ! Grid3D - 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 IfW_FlowField_Packgrid4dfieldtype( Re_Buf, Db_Buf, Int_Buf, InData%Grid4D, ErrStat2, ErrMsg2, OnlySize ) ! Grid4D - 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 IfW_FlowField_Packpointsfieldtype( Re_Buf, Db_Buf, Int_Buf, InData%Points, ErrStat2, ErrMsg2, OnlySize ) ! Points - 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 IfW_FlowField_Packuserfieldtype( Re_Buf, Db_Buf, Int_Buf, InData%User, ErrStat2, ErrMsg2, OnlySize ) ! User - 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 IfW_FlowField_PackFlowFieldType - - SUBROUTINE IfW_FlowField_UnPackFlowFieldType( 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(FlowFieldType), 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 = 'IfW_FlowField_UnPackFlowFieldType' - ! 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%FieldType = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%RefPosition,1) - i1_u = UBOUND(OutData%RefPosition,1) - DO i1 = LBOUND(OutData%RefPosition,1), UBOUND(OutData%RefPosition,1) - OutData%RefPosition(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%PropagationDir = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%VFlowAngle = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%VelInterpCubic = TRANSFER(IntKiBuf(Int_Xferred), OutData%VelInterpCubic) - Int_Xferred = Int_Xferred + 1 - OutData%RotateWindBox = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotateWindBox) - Int_Xferred = Int_Xferred + 1 - OutData%AccFieldValid = TRANSFER(IntKiBuf(Int_Xferred), OutData%AccFieldValid) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%RotToWind,1) - i1_u = UBOUND(OutData%RotToWind,1) - i2_l = LBOUND(OutData%RotToWind,2) - i2_u = UBOUND(OutData%RotToWind,2) - DO i2 = LBOUND(OutData%RotToWind,2), UBOUND(OutData%RotToWind,2) - DO i1 = LBOUND(OutData%RotToWind,1), UBOUND(OutData%RotToWind,1) - OutData%RotToWind(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%RotFromWind,1) - i1_u = UBOUND(OutData%RotFromWind,1) - i2_l = LBOUND(OutData%RotFromWind,2) - i2_u = UBOUND(OutData%RotFromWind,2) - DO i2 = LBOUND(OutData%RotFromWind,2), UBOUND(OutData%RotFromWind,2) - DO i1 = LBOUND(OutData%RotFromWind,1), UBOUND(OutData%RotFromWind,1) - OutData%RotFromWind(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - 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 IfW_FlowField_Unpackuniformfieldtype( Re_Buf, Db_Buf, Int_Buf, OutData%Uniform, ErrStat2, ErrMsg2 ) ! Uniform - 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 IfW_FlowField_Unpackgrid3dfieldtype( Re_Buf, Db_Buf, Int_Buf, OutData%Grid3D, ErrStat2, ErrMsg2 ) ! Grid3D - 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 IfW_FlowField_Unpackgrid4dfieldtype( Re_Buf, Db_Buf, Int_Buf, OutData%Grid4D, ErrStat2, ErrMsg2 ) ! Grid4D - 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 IfW_FlowField_Unpackpointsfieldtype( Re_Buf, Db_Buf, Int_Buf, OutData%Points, ErrStat2, ErrMsg2 ) ! Points - 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 IfW_FlowField_Unpackuserfieldtype( Re_Buf, Db_Buf, Int_Buf, OutData%User, ErrStat2, ErrMsg2 ) ! User - 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 IfW_FlowField_UnPackFlowFieldType - + ErrMsg = '' + if (allocated(Grid3DFieldTypeData%Vel)) then + deallocate(Grid3DFieldTypeData%Vel) + end if + if (allocated(Grid3DFieldTypeData%Acc)) then + deallocate(Grid3DFieldTypeData%Acc) + end if + if (allocated(Grid3DFieldTypeData%VelTower)) then + deallocate(Grid3DFieldTypeData%VelTower) + end if + if (allocated(Grid3DFieldTypeData%AccTower)) then + deallocate(Grid3DFieldTypeData%AccTower) + end if + if (allocated(Grid3DFieldTypeData%VelAvg)) then + deallocate(Grid3DFieldTypeData%VelAvg) + end if + if (allocated(Grid3DFieldTypeData%AccAvg)) then + deallocate(Grid3DFieldTypeData%AccAvg) + end if +end subroutine + +subroutine IfW_FlowField_PackGrid3DFieldType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Grid3DFieldType), intent(in) :: InData + character(*), parameter :: RoutineName = 'IfW_FlowField_PackGrid3DFieldType' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%WindFileFormat) + call RegPack(RF, InData%WindProfileType) + call RegPack(RF, InData%Periodic) + call RegPack(RF, InData%InterpTower) + call RegPack(RF, InData%AddMeanAfterInterp) + call RegPack(RF, InData%RefHeight) + call RegPack(RF, InData%RefLength) + call RegPackAlloc(RF, InData%Vel) + call RegPackAlloc(RF, InData%Acc) + call RegPackAlloc(RF, InData%VelTower) + call RegPackAlloc(RF, InData%AccTower) + call RegPackAlloc(RF, InData%VelAvg) + call RegPackAlloc(RF, InData%AccAvg) + call RegPack(RF, InData%DTime) + call RegPack(RF, InData%Rate) + call RegPack(RF, InData%YHWid) + call RegPack(RF, InData%ZHWid) + call RegPack(RF, InData%GridBase) + call RegPack(RF, InData%InitXPosition) + call RegPack(RF, InData%InvDY) + call RegPack(RF, InData%InvDZ) + call RegPack(RF, InData%MeanWS) + call RegPack(RF, InData%InvMWS) + call RegPack(RF, InData%TotalTime) + call RegPack(RF, InData%NComp) + call RegPack(RF, InData%NYGrids) + call RegPack(RF, InData%NZGrids) + call RegPack(RF, InData%NTGrids) + call RegPack(RF, InData%NSteps) + call RegPack(RF, InData%PLExp) + call RegPack(RF, InData%Z0) + call RegPack(RF, InData%VLinShr) + call RegPack(RF, InData%HLinShr) + call RegPack(RF, InData%BoxExceedAllow) + call RegPack(RF, InData%BoxExceedAllowDrv) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine IfW_FlowField_UnPackGrid3DFieldType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Grid3DFieldType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'IfW_FlowField_UnPackGrid3DFieldType' + integer(B4Ki) :: LB(4), UB(4) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%WindFileFormat); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WindProfileType); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Periodic); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%InterpTower); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AddMeanAfterInterp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RefHeight); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RefLength); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Vel); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Acc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%VelTower); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AccTower); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%VelAvg); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AccAvg); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DTime); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Rate); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YHWid); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ZHWid); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GridBase); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%InitXPosition); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%InvDY); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%InvDZ); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MeanWS); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%InvMWS); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TotalTime); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NComp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NYGrids); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NZGrids); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NTGrids); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NSteps); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PLExp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Z0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VLinShr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HLinShr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BoxExceedAllow); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BoxExceedAllowDrv); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine IfW_FlowField_CopyGrid4DFieldType(SrcGrid4DFieldTypeData, DstGrid4DFieldTypeData, CtrlCode, ErrStat, ErrMsg) + type(Grid4DFieldType), intent(in) :: SrcGrid4DFieldTypeData + type(Grid4DFieldType), intent(inout) :: DstGrid4DFieldTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(5), UB(5) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'IfW_FlowField_CopyGrid4DFieldType' + ErrStat = ErrID_None + ErrMsg = '' + DstGrid4DFieldTypeData%n = SrcGrid4DFieldTypeData%n + DstGrid4DFieldTypeData%delta = SrcGrid4DFieldTypeData%delta + DstGrid4DFieldTypeData%pZero = SrcGrid4DFieldTypeData%pZero + DstGrid4DFieldTypeData%Vel => SrcGrid4DFieldTypeData%Vel + DstGrid4DFieldTypeData%TimeStart = SrcGrid4DFieldTypeData%TimeStart + DstGrid4DFieldTypeData%RefHeight = SrcGrid4DFieldTypeData%RefHeight +end subroutine + +subroutine IfW_FlowField_DestroyGrid4DFieldType(Grid4DFieldTypeData, ErrStat, ErrMsg) + type(Grid4DFieldType), intent(inout) :: Grid4DFieldTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'IfW_FlowField_DestroyGrid4DFieldType' + ErrStat = ErrID_None + ErrMsg = '' + nullify(Grid4DFieldTypeData%Vel) +end subroutine + +subroutine IfW_FlowField_PackGrid4DFieldType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Grid4DFieldType), intent(in) :: InData + character(*), parameter :: RoutineName = 'IfW_FlowField_PackGrid4DFieldType' + logical :: PtrInIndex + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%n) + call RegPack(RF, InData%delta) + call RegPack(RF, InData%pZero) + call RegPackPtr(RF, InData%Vel) + call RegPack(RF, InData%TimeStart) + call RegPack(RF, InData%RefHeight) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine IfW_FlowField_UnPackGrid4DFieldType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Grid4DFieldType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'IfW_FlowField_UnPackGrid4DFieldType' + integer(B4Ki) :: LB(5), UB(5) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(B8Ki) :: PtrIdx + type(c_ptr) :: Ptr + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%n); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%delta); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%pZero); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackPtr(RF, OutData%Vel, LB, UB); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TimeStart); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RefHeight); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine IfW_FlowField_CopyPointsFieldType(SrcPointsFieldTypeData, DstPointsFieldTypeData, CtrlCode, ErrStat, ErrMsg) + type(PointsFieldType), intent(in) :: SrcPointsFieldTypeData + type(PointsFieldType), intent(inout) :: DstPointsFieldTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'IfW_FlowField_CopyPointsFieldType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcPointsFieldTypeData%Vel)) then + LB(1:2) = lbound(SrcPointsFieldTypeData%Vel) + UB(1:2) = ubound(SrcPointsFieldTypeData%Vel) + if (.not. allocated(DstPointsFieldTypeData%Vel)) then + allocate(DstPointsFieldTypeData%Vel(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstPointsFieldTypeData%Vel.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstPointsFieldTypeData%Vel = SrcPointsFieldTypeData%Vel + end if +end subroutine + +subroutine IfW_FlowField_DestroyPointsFieldType(PointsFieldTypeData, ErrStat, ErrMsg) + type(PointsFieldType), intent(inout) :: PointsFieldTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'IfW_FlowField_DestroyPointsFieldType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(PointsFieldTypeData%Vel)) then + deallocate(PointsFieldTypeData%Vel) + end if +end subroutine + +subroutine IfW_FlowField_PackPointsFieldType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(PointsFieldType), intent(in) :: InData + character(*), parameter :: RoutineName = 'IfW_FlowField_PackPointsFieldType' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%Vel) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine IfW_FlowField_UnPackPointsFieldType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(PointsFieldType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'IfW_FlowField_UnPackPointsFieldType' + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%Vel); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine IfW_FlowField_CopyUserFieldType(SrcUserFieldTypeData, DstUserFieldTypeData, CtrlCode, ErrStat, ErrMsg) + type(UserFieldType), intent(in) :: SrcUserFieldTypeData + type(UserFieldType), intent(inout) :: DstUserFieldTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'IfW_FlowField_CopyUserFieldType' + ErrStat = ErrID_None + ErrMsg = '' + DstUserFieldTypeData%RefHeight = SrcUserFieldTypeData%RefHeight +end subroutine + +subroutine IfW_FlowField_DestroyUserFieldType(UserFieldTypeData, ErrStat, ErrMsg) + type(UserFieldType), intent(inout) :: UserFieldTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'IfW_FlowField_DestroyUserFieldType' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine IfW_FlowField_PackUserFieldType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(UserFieldType), intent(in) :: InData + character(*), parameter :: RoutineName = 'IfW_FlowField_PackUserFieldType' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%RefHeight) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine IfW_FlowField_UnPackUserFieldType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(UserFieldType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'IfW_FlowField_UnPackUserFieldType' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%RefHeight); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine IfW_FlowField_CopyFlowFieldType(SrcFlowFieldTypeData, DstFlowFieldTypeData, CtrlCode, ErrStat, ErrMsg) + type(FlowFieldType), intent(in) :: SrcFlowFieldTypeData + type(FlowFieldType), intent(inout) :: DstFlowFieldTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'IfW_FlowField_CopyFlowFieldType' + ErrStat = ErrID_None + ErrMsg = '' + DstFlowFieldTypeData%FieldType = SrcFlowFieldTypeData%FieldType + DstFlowFieldTypeData%RefPosition = SrcFlowFieldTypeData%RefPosition + DstFlowFieldTypeData%PropagationDir = SrcFlowFieldTypeData%PropagationDir + DstFlowFieldTypeData%VFlowAngle = SrcFlowFieldTypeData%VFlowAngle + DstFlowFieldTypeData%VelInterpCubic = SrcFlowFieldTypeData%VelInterpCubic + DstFlowFieldTypeData%RotateWindBox = SrcFlowFieldTypeData%RotateWindBox + DstFlowFieldTypeData%AccFieldValid = SrcFlowFieldTypeData%AccFieldValid + DstFlowFieldTypeData%RotToWind = SrcFlowFieldTypeData%RotToWind + DstFlowFieldTypeData%RotFromWind = SrcFlowFieldTypeData%RotFromWind + call IfW_FlowField_CopyUniformFieldType(SrcFlowFieldTypeData%Uniform, DstFlowFieldTypeData%Uniform, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call IfW_FlowField_CopyGrid3DFieldType(SrcFlowFieldTypeData%Grid3D, DstFlowFieldTypeData%Grid3D, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call IfW_FlowField_CopyGrid4DFieldType(SrcFlowFieldTypeData%Grid4D, DstFlowFieldTypeData%Grid4D, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call IfW_FlowField_CopyPointsFieldType(SrcFlowFieldTypeData%Points, DstFlowFieldTypeData%Points, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call IfW_FlowField_CopyUserFieldType(SrcFlowFieldTypeData%User, DstFlowFieldTypeData%User, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine IfW_FlowField_DestroyFlowFieldType(FlowFieldTypeData, ErrStat, ErrMsg) + type(FlowFieldType), intent(inout) :: FlowFieldTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'IfW_FlowField_DestroyFlowFieldType' + ErrStat = ErrID_None + ErrMsg = '' + call IfW_FlowField_DestroyUniformFieldType(FlowFieldTypeData%Uniform, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call IfW_FlowField_DestroyGrid3DFieldType(FlowFieldTypeData%Grid3D, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call IfW_FlowField_DestroyGrid4DFieldType(FlowFieldTypeData%Grid4D, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call IfW_FlowField_DestroyPointsFieldType(FlowFieldTypeData%Points, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call IfW_FlowField_DestroyUserFieldType(FlowFieldTypeData%User, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine IfW_FlowField_PackFlowFieldType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(FlowFieldType), intent(in) :: InData + character(*), parameter :: RoutineName = 'IfW_FlowField_PackFlowFieldType' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%FieldType) + call RegPack(RF, InData%RefPosition) + call RegPack(RF, InData%PropagationDir) + call RegPack(RF, InData%VFlowAngle) + call RegPack(RF, InData%VelInterpCubic) + call RegPack(RF, InData%RotateWindBox) + call RegPack(RF, InData%AccFieldValid) + call RegPack(RF, InData%RotToWind) + call RegPack(RF, InData%RotFromWind) + call IfW_FlowField_PackUniformFieldType(RF, InData%Uniform) + call IfW_FlowField_PackGrid3DFieldType(RF, InData%Grid3D) + call IfW_FlowField_PackGrid4DFieldType(RF, InData%Grid4D) + call IfW_FlowField_PackPointsFieldType(RF, InData%Points) + call IfW_FlowField_PackUserFieldType(RF, InData%User) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine IfW_FlowField_UnPackFlowFieldType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(FlowFieldType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'IfW_FlowField_UnPackFlowFieldType' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%FieldType); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RefPosition); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PropagationDir); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VFlowAngle); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VelInterpCubic); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RotateWindBox); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AccFieldValid); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RotToWind); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RotFromWind); if (RegCheckErr(RF, RoutineName)) return + call IfW_FlowField_UnpackUniformFieldType(RF, OutData%Uniform) ! Uniform + call IfW_FlowField_UnpackGrid3DFieldType(RF, OutData%Grid3D) ! Grid3D + call IfW_FlowField_UnpackGrid4DFieldType(RF, OutData%Grid4D) ! Grid4D + call IfW_FlowField_UnpackPointsFieldType(RF, OutData%Points) ! Points + call IfW_FlowField_UnpackUserFieldType(RF, OutData%User) ! User +end subroutine END MODULE IfW_FlowField_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/inflowwind/src/InflowWind.f90 b/modules/inflowwind/src/InflowWind.f90 index a0ddc5e713..de2d713a3b 100644 --- a/modules/inflowwind/src/InflowWind.f90 +++ b/modules/inflowwind/src/InflowWind.f90 @@ -1,19 +1,3 @@ -!********************************************************************************************************************************** -!! This module is used to read and process the (undisturbed) inflow winds. It must be initialized -!! using InflowWind_Init() with the name of the file, the file type, and possibly reference height and -!! width (depending on the type of wind file being used). This module calls appropriate routines -!! in the wind modules so that the type of wind becomes seamless to the user. InflowWind_End() -!! should be called when the program has finshed. -!! -!! Data are assumed to be in units of meters and seconds. Z is measured from the ground (NOT the hub!). -!! -!! 7 Oct 2009 Initial Release with AeroDyn 13.00.00 B. Jonkman, NREL/NWTC -!! 14 Nov 2011 v1.00.01b-bjj B. Jonkman -!! 1 Aug 2012 v1.01.00a-bjj B. Jonkman -!! 10 Aug 2012 v1.01.00b-bjj B. Jonkman -!! Feb 2013 v2.00.00a-adp conversion to Framework A. Platt -!! Sep 2015 v3.00.00a-adb added separate input file A. Platt -! !.................................................................................................................................. ! Files with this module: ! InflowWind_Subs.f90 @@ -38,9 +22,16 @@ ! limitations under the License. ! !********************************************************************************************************************************** +!> InflowWind is used to read and process the (undisturbed) inflow winds. It must be initialized +!! using InflowWind_Init() with the name of the file, the file type, and possibly reference height and +!! width (depending on the type of wind file being used). This module calls appropriate routines +!! in the wind modules so that the type of wind becomes seamless to the user. InflowWind_End() +!! should be called when the program has finshed. +!! +!! Data are assumed to be in units of meters and seconds. Z is measured from the ground (NOT the hub!). +!! MODULE InflowWind - USE NWTC_Library USE InflowWind_Types USE InflowWind_Subs @@ -54,39 +45,19 @@ MODULE InflowWind PRIVATE TYPE(ProgDesc), PARAMETER :: IfW_Ver = ProgDesc( 'InflowWind', '', '' ) - integer, parameter :: NumExtendedInputs = 3 !: V, VShr, PropDir - - - - - ! ..... Public Subroutines ................................................................................................... + integer, parameter :: NumExtendedIO = 3 ! Number of extended inputs or outputs (same set): HWindSpeed, PlExp, PropDir + ! ..... Public Subroutines ................................................................................................... PUBLIC :: InflowWind_Init !< Initialization routine PUBLIC :: InflowWind_CalcOutput !< Calculate the wind velocities PUBLIC :: InflowWind_End !< Ending routine (includes clean up) - ! These routines satisfy the framework, but do nothing at present. - PUBLIC :: InflowWind_UpdateStates !< Loose coupling routine for solving for constraint states, integrating continuous states, and updating discrete states - PUBLIC :: InflowWind_CalcConstrStateResidual !< Tight coupling routine for returning the constraint state residual - PUBLIC :: InflowWind_CalcContStateDeriv !< Tight coupling routine for computing derivatives of continuous states - PUBLIC :: InflowWind_UpdateDiscState !< Tight coupling routine for updating discrete states - - - ! These routines compute Jacobians; only dYdu is defined. - PUBLIC :: InflowWind_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 :: InflowWind_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 :: InflowWind_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 :: InflowWind_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 :: InflowWind_GetOP !< Routine to pack the operating point values (for linearization) into arrays - - + ! These routines compute Jacobians; only dYdu is defined. + PUBLIC :: InflowWind_JacobianPInput + PUBLIC :: InflowWind_JacobianPContState + PUBLIC :: InflowWind_JacobianPDiscState + PUBLIC :: InflowWind_JacobianPConstrState + PUBLIC :: InflowWind_GetOP CONTAINS !==================================================================================================== @@ -170,37 +141,26 @@ SUBROUTINE InflowWind_Init( InitInp, InputGuess, p, ContStates, DiscStates, Cons EchoFileName = TRIM(p%RootFileName)//".ech" SumFileName = TRIM(p%RootFileName)//".sum" + IF ( InitInp%FilePassingMethod == 0_IntKi ) THEN ! Normal calling with an input file + CALL GetPath( InitInp%InputFileName, PriPath ) + CALL ProcessComFile( InitInp%InputFileName, InFileInfo, TmpErrStat, TmpErrMsg ); if (Failed()) return + ! For diagnostic purposes, the following can be used to display the contents + ! of the InFileInfo data structure. + ! call Print_FileInfo_Struct( CU, InFileInfo ) ! CU is the screen -- different number on different systems. + CALL InflowWind_ParseInputFileInfo( InputFileData, InFileInfo, PriPath, InitInp%InputFileName, EchoFileName, InitInp%FixedWindFileRootName, InitInp%TurbineID, TmpErrStat, TmpErrMsg ); if (Failed()) return + ELSEIF ( InitInp%FilePassingMethod == 1_IntKi ) THEN ! passing the FileInfoType structure + CALL GetPath( InitInp%InputFileName, PriPath ) ! in case a summary file is written + CALL NWTC_Library_CopyFileInfoType( InitInp%PassedFileInfo, InFileInfo, MESH_NEWCOPY, TmpErrStat, TmpErrMsg ); if (Failed()) return + CALL InflowWind_ParseInputFileInfo( InputFileData, InFileInfo, PriPath, InitInp%InputFileName, EchoFileName, InitInp%FixedWindFileRootName, InitInp%TurbineID, TmpErrStat, TmpErrMsg ); if (Failed()) return + ELSEIF ( InitInp%FilePassingMethod == 2_IntKi ) THEN ! passing the InputFileData structure - ! Parse all the InflowWind related input files and populate the *_InitDataType derived types - CALL GetPath( InitInp%InputFileName, PriPath ) - - IF ( InitInp%UseInputFile ) THEN - CALL ProcessComFile( InitInp%InputFileName, InFileInfo, TmpErrStat, TmpErrMsg ) - CALL SetErrStat(TmpErrStat,TmpErrMsg,ErrStat,ErrMsg,RoutineName) - IF ( ErrStat >= AbortErrLev ) THEN - CALL Cleanup() - RETURN - ENDIF - ELSE - CALL NWTC_Library_CopyFileInfoType( InitInp%PassedFileData, InFileInfo, MESH_NEWCOPY, TmpErrStat, TmpErrMsg ) - CALL SetErrStat(TmpErrStat,TmpErrMsg,ErrStat,ErrMsg,RoutineName) - IF ( ErrStat >= AbortErrLev ) THEN - CALL Cleanup() - RETURN - ENDIF - ENDIF + CALL InflowWind_CopyInputFile( InitInp%PassedFileData, InputFileData, MESH_NEWCOPY, TmpErrStat, TmpErrMsg ); if (Failed()) return - CALL InflowWind_ParseInputFileInfo( InputFileData, InFileInfo, PriPath, InitInp%InputFileName, EchoFileName, & - InitInp%FixedWindFileRootName, InitInp%TurbineID, TmpErrStat, TmpErrMsg ) - CALL SetErrStat(TmpErrStat,TmpErrMsg,ErrStat,ErrMsg,RoutineName) - IF ( ErrStat >= AbortErrLev ) THEN - CALL Cleanup() - RETURN ENDIF ! If wind is Grid4D from FAST.Farm, set input file values @@ -211,20 +171,11 @@ SUBROUTINE InflowWind_Init( InitInp, InputGuess, p, ContStates, DiscStates, Cons InputFileData%VelInterpCubic = .false. END IF - ! initialize sensor data: - p%lidar%NumBeam = InputFileData%NumBeam - p%lidar%RotorApexOffsetPos = InputFileData%RotorApexOffsetPos - p%lidar%SensorType = InputFileData%SensorType - p%lidar%LidRadialVel = InputFileData%LidRadialVel - p%lidar%NumPulseGate = InputFileData%NumPulseGate - p%lidar%FocalDistanceX = InputFileData%FocalDistanceX - p%lidar%FocalDistanceY = InputFileData%FocalDistanceY - p%lidar%FocalDistanceZ = InputFileData%FocalDistanceZ - p%lidar%MeasurementInterval = InputFileData%MeasurementInterval - p%lidar%PulseSpacing = InputFileData%PulseSpacing - p%lidar%URefLid = InputFileData%URefLid - p%lidar%ConsiderHubMotion = InputFileData%ConsiderHubMotion + ! Validate the InflowWind input file information. + CALL InflowWind_ValidateInput( InitInp, InputFileData, TmpErrStat, TmpErrMsg ); if (Failed()) return + + ! Disable Lidar if not allowed (FAST.Farm doesn't allow this) if (.not. InitInp%LidarEnabled) then if (p%lidar%SensorType /= SensorType_None) then @@ -234,62 +185,47 @@ SUBROUTINE InflowWind_Init( InitInp, InputGuess, p, ContStates, DiscStates, Cons end if endif - - CALL Lidar_Init( InitInp, InputGuess, p, ContStates, DiscStates, ConstrStateGuess, OtherStates, & - y, m, TimeInterval, InitOutData, TmpErrStat, TmpErrMsg ) - CALL SetErrStat( TmpErrStat, TmpErrMsg, ErrStat, ErrMsg, RoutineName ) - - - ! Validate the InflowWind input file information. - - CALL InflowWind_ValidateInput( InitInp, InputFileData, TmpErrStat, TmpErrMsg ) - CALL SetErrStat(TmpErrStat,TmpErrMsg,ErrStat,ErrMsg,RoutineName) - - IF ( ErrStat>= AbortErrLev ) THEN - CALL Cleanup() - RETURN - ENDIF - + ! initialize sensor data: + p%lidar%SensorType = InputFileData%SensorType + IF (InputFileData%SensorType /= SensorType_None) THEN + p%lidar%NumBeam = InputFileData%NumBeam + p%lidar%RotorApexOffsetPos = InputFileData%RotorApexOffsetPos + p%lidar%LidRadialVel = InputFileData%LidRadialVel + p%lidar%NumPulseGate = InputFileData%NumPulseGate + p%lidar%FocalDistanceX = InputFileData%FocalDistanceX ! these are allocatable. Should allocate then copy + p%lidar%FocalDistanceY = InputFileData%FocalDistanceY + p%lidar%FocalDistanceZ = InputFileData%FocalDistanceZ + p%lidar%MeasurementInterval= InputFileData%MeasurementInterval + p%lidar%PulseSpacing = InputFileData%PulseSpacing + p%lidar%URefLid = InputFileData%URefLid + p%lidar%ConsiderHubMotion = InputFileData%ConsiderHubMotion + + CALL Lidar_Init( InitInp, InputGuess, p, ContStates, DiscStates, ConstrStateGuess, OtherStates, & + y, m, TimeInterval, InitOutData, TmpErrStat, TmpErrMsg ); if (Failed()) return + endif - ! If a summary file was requested, open it. IF ( InputFileData%SumPrint ) THEN ! Open the summary file and write some preliminary info to it - CALL InflowWind_OpenSumFile( SumFileUnit, SumFileName, IfW_Ver, InputFileData%WindType, TmpErrStat, TmpErrMsg ) - CALL SetErrStat(TmpErrStat,TmpErrMsg,ErrStat,ErrMsg,RoutineName) - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - ENDIF + CALL InflowWind_OpenSumFile( SumFileUnit, SumFileName, IfW_Ver, InputFileData%WindType, TmpErrStat, TmpErrMsg ); if (Failed()) return ELSE SumFileUnit = -1_IntKi ! So that we don't try to write to something. Used as indicator in submodules. ENDIF ! Allocate the array for passing points - CALL AllocAry( InputGuess%PositionXYZ, 3, InitInp%NumWindPoints, "Array of positions at which to find wind velocities", TmpErrStat, TmpErrMsg ) - CALL SetErrStat(TmpErrStat,TmpErrMsg,ErrStat,ErrMsg,RoutineName) + CALL AllocAry( InputGuess%PositionXYZ, 3, InitInp%NumWindPoints, "Array of positions at which to find wind velocities", TmpErrStat, TmpErrMsg ); if (Failed()) return InputGuess%PositionXYZ = 0.0_ReKi InputGuess%HubPosition = 0.0_ReKi - CALL Eye(InputGuess%HubOrientation,TmpErrStat,TmpErrMsg) + CALL Eye(InputGuess%HubOrientation,TmpErrStat,TmpErrMsg); if (Failed()) return ! Allocate the array for passing velocities out - CALL AllocAry( y%VelocityUVW, 3, InitInp%NumWindPoints, "Array of wind velocities returned by InflowWind", TmpErrStat, TmpErrMsg ) - CALL SetErrStat(TmpErrStat,TmpErrMsg,ErrStat,ErrMsg,RoutineName) - IF (ErrStat>= AbortErrLev) THEN - CALL Cleanup() - RETURN - ENDIF + CALL AllocAry( y%VelocityUVW, 3, InitInp%NumWindPoints, "Array of wind velocities returned by InflowWind", TmpErrStat, TmpErrMsg ); if (Failed()) return y%VelocityUVW = 0.0_ReKi ! If requested, allocate the array for passing accelerations out IF ( InitInp%OutputAccel ) THEN - CALL AllocAry( y%AccelUVW, 3, InitInp%NumWindPoints, "Array of wind accelerations returned by InflowWind", TmpErrStat, TmpErrMsg ) - CALL SetErrStat(TmpErrStat,TmpErrMsg,ErrStat,ErrMsg,RoutineName) - IF (ErrStat>= AbortErrLev) THEN - CALL Cleanup() - RETURN - ENDIF + CALL AllocAry( y%AccelUVW, 3, InitInp%NumWindPoints, "Array of wind accelerations returned by InflowWind", TmpErrStat, TmpErrMsg ); if (Failed()) return y%AccelUVW = 0.0_ReKi ENDIF @@ -297,8 +233,17 @@ SUBROUTINE InflowWind_Init( InitInp, InputGuess, p, ContStates, DiscStates, Cons ! Set flow field input data based on wind type !---------------------------------------------------------------------------- + ! If flowfield is allocated, deallocate and allocate again to clear old data + if (associated(p%FlowField)) deallocate(p%FlowField) + allocate(p%FlowField) + + ! Associate initialization output to flow field + InitOutData%FlowField => p%FlowField + + ! Initialize mean wind speed to a very large number InitOutData%WindFileInfo%MWS = HUGE(InitOutData%WindFileInfo%MWS) + ! Switch based on the wind type specified in the input file select case(InputFileData%WindType) case (Steady_WindNumber) @@ -308,32 +253,20 @@ SUBROUTINE InflowWind_Init( InitInp, InputGuess, p, ContStates, DiscStates, Cons Steady_InitInput%PLExp = InputFileData%Steady_PLexp p%FlowField%FieldType = Uniform_FieldType - call IfW_SteadyWind_Init(Steady_InitInput, SumFileUnit, p%FlowField%Uniform, InitOutData%WindFileInfo, TmpErrStat, TmpErrMsg) - call SetErrStat(TmpErrStat, TmpErrMsg, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) then - call Cleanup() - return - endif + call IfW_SteadyWind_Init(Steady_InitInput, SumFileUnit, p%FlowField%Uniform, InitOutData%WindFileInfo, TmpErrStat, TmpErrMsg); if (Failed()) return ! Set reference position for wind rotation p%FlowField%RefPosition = [0.0_ReKi, 0.0_ReKi, p%FlowField%Uniform%RefHeight] case (Uniform_WindNumber) - Uniform_InitInput%WindFileName = InputFileData%Uniform_FileName - Uniform_InitInput%RefHt = InputFileData%Uniform_RefHt - Uniform_InitInput%RefLength = InputFileData%Uniform_RefLength + Uniform_InitInput%WindFileName = InputFileData%Uniform_FileName + Uniform_InitInput%RefHt = InputFileData%Uniform_RefHt + Uniform_InitInput%RefLength = InputFileData%Uniform_RefLength Uniform_InitInput%PropagationDir = InputFileData%PropagationDir - Uniform_InitInput%UseInputFile = InitInp%WindType2UseInputFile - Uniform_InitInput%PassedFileData = InitInp%WindType2Data p%FlowField%FieldType = Uniform_FieldType - call IfW_UniformWind_Init(Uniform_InitInput, SumFileUnit, p%FlowField%Uniform, InitOutData%WindFileInfo, TmpErrStat, TmpErrMsg) - call SetErrStat(TmpErrStat, TmpErrMsg, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) then - call Cleanup() - return - endif + call IfW_UniformWind_Init(Uniform_InitInput, SumFileUnit, p%FlowField%Uniform, InitOutData%WindFileInfo, TmpErrStat, TmpErrMsg); if (Failed()) return ! Set reference position for wind rotation p%FlowField%RefPosition = [0.0_ReKi, 0.0_ReKi, p%FlowField%Uniform%RefHeight] @@ -343,12 +276,7 @@ SUBROUTINE InflowWind_Init( InitInp, InputGuess, p, ContStates, DiscStates, Cons TurbSim_InitInput%WindFileName = InputFileData%TSFF_FileName p%FlowField%FieldType = Grid3D_FieldType - call IfW_TurbSim_Init(TurbSim_InitInput, SumFileUnit, p%FlowField%Grid3D, InitOutData%WindFileInfo, TmpErrStat, TmpErrMsg) - call SetErrStat(TmpErrStat, TmpErrMsg, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) then - call Cleanup() - return - endif + call IfW_TurbSim_Init(TurbSim_InitInput, SumFileUnit, p%FlowField%Grid3D, InitOutData%WindFileInfo, TmpErrStat, TmpErrMsg); if (Failed()) return ! Set reference position for wind rotation p%FlowField%RefPosition = [0.0_ReKi, 0.0_ReKi, p%FlowField%Grid3D%RefHeight] @@ -369,12 +297,7 @@ SUBROUTINE InflowWind_Init( InitInp, InputGuess, p, ContStates, DiscStates, Cons Bladed_InitInput%NativeBladedFmt = .false. p%FlowField%FieldType = Grid3D_FieldType - call IfW_Bladed_Init(Bladed_InitInput, SumFileUnit, Bladed_InitOutput, p%FlowField%Grid3D, InitOutData%WindFileInfo, TmpErrStat, TmpErrMsg) - call SetErrStat(TmpErrStat, TmpErrMsg, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) then - call Cleanup() - return - endif + call IfW_Bladed_Init(Bladed_InitInput, SumFileUnit, Bladed_InitOutput, p%FlowField%Grid3D, InitOutData%WindFileInfo, TmpErrStat, TmpErrMsg); if (Failed()) return ! Set reference position for wind rotation p%FlowField%RefPosition = [0.0_ReKi, 0.0_ReKi, p%FlowField%Grid3D%RefHeight] @@ -388,12 +311,7 @@ SUBROUTINE InflowWind_Init( InitInp, InputGuess, p, ContStates, DiscStates, Cons Bladed_InitInput%NativeBladedFmt = .true. p%FlowField%FieldType = Grid3D_FieldType - call IfW_Bladed_Init(Bladed_InitInput, SumFileUnit, Bladed_InitOutput, p%FlowField%Grid3D, InitOutData%WindFileInfo, TmpErrStat, TmpErrMsg) - call SetErrStat(TmpErrStat, TmpErrMsg, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) then - call Cleanup() - return - endif + call IfW_Bladed_Init(Bladed_InitInput, SumFileUnit, Bladed_InitOutput, p%FlowField%Grid3D, InitOutData%WindFileInfo, TmpErrStat, TmpErrMsg); if (Failed()) return ! Overwrite the values of PropagationDir and VFlowAngle with values from the native Bladed file InputFileData%PropagationDir = Bladed_InitOutput%PropagationDir @@ -424,12 +342,7 @@ SUBROUTINE InflowWind_Init( InitInp, InputGuess, p, ContStates, DiscStates, Cons HAWC_InitInput%G3D%XOffset = InputFileData%FF%XOffset p%FlowField%FieldType = Grid3D_FieldType - call IfW_HAWC_Init(HAWC_InitInput, SumFileUnit, p%FlowField%Grid3D, InitOutData%WindFileInfo, TmpErrStat, TmpErrMsg) - call SetErrStat(TmpErrStat, TmpErrMsg, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) then - call Cleanup() - return - endif + call IfW_HAWC_Init(HAWC_InitInput, SumFileUnit, p%FlowField%Grid3D, InitOutData%WindFileInfo, TmpErrStat, TmpErrMsg); if (Failed()) return ! Set reference position for wind rotation p%FlowField%RefPosition = [0.0_ReKi, 0.0_ReKi, p%FlowField%Grid3D%RefHeight] @@ -437,12 +350,7 @@ SUBROUTINE InflowWind_Init( InitInp, InputGuess, p, ContStates, DiscStates, Cons case (User_WindNumber) p%FlowField%FieldType = User_FieldType - call IfW_User_Init(User_InitInput, SumFileUnit, p%FlowField%User, InitOutData%WindFileInfo, TmpErrStat, TmpErrMsg) - call SetErrStat(TmpErrStat, TmpErrMsg, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) then - call Cleanup() - return - endif + call IfW_User_Init(User_InitInput, SumFileUnit, p%FlowField%User, InitOutData%WindFileInfo, TmpErrStat, TmpErrMsg); if (Failed()) return ! Set reference position for wind rotation p%FlowField%RefPosition = [0.0_ReKi, 0.0_ReKi, p%FlowField%User%RefHeight] @@ -450,11 +358,7 @@ SUBROUTINE InflowWind_Init( InitInp, InputGuess, p, ContStates, DiscStates, Cons case (FDext_WindNumber) p%FlowField%FieldType = Grid4D_FieldType - call IfW_Grid4D_Init(InitInp%FDext, p%FlowField%Grid4D, TmpErrStat, TmpErrMsg) - if (ErrStat >= AbortErrLev) then - call Cleanup() - return - endif + call IfW_Grid4D_Init(InitInp%FDext, p%FlowField%Grid4D, TmpErrStat, TmpErrMsg); if (Failed()) return ! Set reference position for wind rotation p%FlowField%RefPosition = [0.0_ReKi, 0.0_ReKi, p%FlowField%Grid4D%RefHeight] @@ -463,11 +367,7 @@ SUBROUTINE InflowWind_Init( InitInp, InputGuess, p, ContStates, DiscStates, Cons p%FlowField%FieldType = Point_FieldType Points_InitInput%NumWindPoints = InitInp%NumWindPoints - call IfW_Points_Init(Points_InitInput, p%FlowField%Points, TmpErrStat, TmpErrMsg) - if (ErrStat >= AbortErrLev) then - call Cleanup() - return - endif + call IfW_Points_Init(Points_InitInput, p%FlowField%Points, TmpErrStat, TmpErrMsg); if (Failed()) return ! Set reference position for wind rotation p%FlowField%RefPosition = 0.0_ReKi @@ -495,22 +395,13 @@ SUBROUTINE InflowWind_Init( InitInp, InputGuess, p, ContStates, DiscStates, Cons p%FlowField%VelInterpCubic = .false. end if - ! Set box exceed flag and index - p%FlowField%Grid3D%BoxExceedAllowF = InitInp%BoxExceedAllowF - p%FlowField%Grid3D%BoxExceedAllowIdx = huge(1_IntKi) - if (InitInp%BoxExceedAllowF .and. (InitInp%BoxExceedAllowIdx <= InitInp%NumWindPoints)) then - p%FlowField%Grid3D%BoxExceedAllowIdx = InitInp%BoxExceedAllowIdx - end if - ! Select based on field type select case (p%FlowField%FieldType) case (Uniform_FieldType) if (InitInp%OutputAccel .or. p%FlowField%VelInterpCubic) then - call IfW_UniformField_CalcAccel(p%FlowField%Uniform, TmpErrStat, TmpErrMsg) - call SetErrStat(TmpErrStat, TmpErrMsg, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return + call IfW_UniformField_CalcAccel(p%FlowField%Uniform, TmpErrStat, TmpErrMsg); if (Failed()) return p%FlowField%AccFieldValid = .true. end if @@ -518,17 +409,18 @@ SUBROUTINE InflowWind_Init( InitInp, InputGuess, p, ContStates, DiscStates, Cons ! Calculate acceleration if (InitInp%OutputAccel .or. p%FlowField%VelInterpCubic) then - call IfW_Grid3DField_CalcAccel(p%FlowField%Grid3D, TmpErrStat, TmpErrMsg) - call SetErrStat(TmpErrStat, TmpErrMsg, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return + call IfW_Grid3DField_CalcAccel(p%FlowField%Grid3D, TmpErrStat, TmpErrMsg); if (Failed()) return p%FlowField%AccFieldValid = .true. end if + ! If input requested points to exceed box or if lidar is enabled, + ! set flag to allow box to be exceeded + p%FlowField%Grid3D%BoxExceedAllow = & + InitInp%BoxExceedAllow .or. (p%lidar%SensorType /= SensorType_None) + ! Calculate field average if box is allowed to be exceeded - if (p%FlowField%Grid3D%BoxExceedAllowF) then - call IfW_Grid3DField_CalcVelAvgProfile(p%FlowField%Grid3D, p%FlowField%AccFieldValid, TmpErrStat, TmpErrMsg) - call SetErrStat(TmpErrStat, TmpErrMsg, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return + if (p%FlowField%Grid3D%BoxExceedAllow) then + call IfW_Grid3DField_CalcVelAvgProfile(p%FlowField%Grid3D, p%FlowField%AccFieldValid, TmpErrStat, TmpErrMsg); if (Failed()) return end if case default @@ -552,35 +444,14 @@ SUBROUTINE InflowWind_Init( InitInp, InputGuess, p, ContStates, DiscStates, Cons ! and VFlowAng from native-Bladed files !---------------------------------------------------------------------------- - CALL InflowWind_SetParameters( InitInp, InputFileData, p, m, TmpErrStat, TmpErrMsg ) - CALL SetErrStat(TmpErrStat,TmpErrMsg,ErrStat,ErrMsg,RoutineName) - IF ( ErrStat>= AbortErrLev ) THEN - CALL Cleanup() - RETURN - ENDIF + CALL InflowWind_SetParameters( InitInp, InputFileData, p, m, TmpErrStat, TmpErrMsg ); if (Failed()) return ! Allocate arrays for the WriteOutput - CALL AllocAry( y%WriteOutput, p%NumOuts, 'WriteOutput', TmpErrStat, TmpErrMsg ) - CALL SetErrStat(TmpErrStat,TmpErrMsg,ErrStat,ErrMsg,RoutineName) - IF ( ErrStat>= AbortErrLev ) THEN - CALL Cleanup() - RETURN - ENDIF + CALL AllocAry( y%WriteOutput, p%NumOuts, 'WriteOutput', TmpErrStat, TmpErrMsg ); if (Failed()) return y%WriteOutput = 0.0_ReKi - CALL AllocAry( InitOutData%WriteOutputHdr, p%NumOuts, 'WriteOutputHdr', TmpErrStat, TmpErrMsg ) - CALL SetErrStat(TmpErrStat,TmpErrMsg,ErrStat,ErrMsg,RoutineName) - IF ( ErrStat>= AbortErrLev ) THEN - CALL Cleanup() - RETURN - ENDIF - - CALL AllocAry( InitOutData%WriteOutputUnt, p%NumOuts, 'WriteOutputUnt', TmpErrStat, TmpErrMsg ) - CALL SetErrStat(TmpErrStat,TmpErrMsg,ErrStat,ErrMsg,RoutineName) - IF ( ErrStat>= AbortErrLev ) THEN - CALL Cleanup() - RETURN - ENDIF + CALL AllocAry( InitOutData%WriteOutputHdr, p%NumOuts, 'WriteOutputHdr', TmpErrStat, TmpErrMsg ); if (Failed()) return + CALL AllocAry( InitOutData%WriteOutputUnt, p%NumOuts, 'WriteOutputUnt', TmpErrStat, TmpErrMsg ); if (Failed()) return InitOutData%WriteOutputHdr = p%OutParam(1:p%NumOuts)%Name InitOutData%WriteOutputUnt = p%OutParam(1:p%NumOuts)%Units @@ -603,58 +474,36 @@ SUBROUTINE InflowWind_Init( InitInp, InputGuess, p, ContStates, DiscStates, Cons end if ! also need to add InputGuess%HubOrientation to the u%Linear items - CALL AllocAry(InitOutData%LinNames_u, InitInp%NumWindPoints*3 + size(InputGuess%HubPosition) + 3 + NumExtendedInputs, 'LinNames_u', TmpErrStat, TmpErrMsg) ! add hub position, orientation(3) + extended inputs - CALL SetErrStat(TmpErrStat,TmpErrMsg,ErrStat,ErrMsg,RoutineName) - CALL AllocAry(InitOutData%RotFrame_u, InitInp%NumWindPoints*3 + size(InputGuess%HubPosition) + 3 + NumExtendedInputs, 'RotFrame_u', TmpErrStat, TmpErrMsg) - CALL SetErrStat(TmpErrStat,TmpErrMsg,ErrStat,ErrMsg,RoutineName) - CALL AllocAry(InitOutData%IsLoad_u, InitInp%NumWindPoints*3 + size(InputGuess%HubPosition) + 3 + NumExtendedInputs, 'IsLoad_u', TmpErrStat, TmpErrMsg) - CALL SetErrStat(TmpErrStat,TmpErrMsg,ErrStat,ErrMsg,RoutineName) - CALL AllocAry(InitOutData%LinNames_y, InitInp%NumWindPoints*3 + size(y%DiskVel) + p%NumOuts, 'LinNames_y', TmpErrStat, TmpErrMsg) - CALL SetErrStat(TmpErrStat,TmpErrMsg,ErrStat,ErrMsg,RoutineName) - CALL AllocAry(InitOutData%RotFrame_y, InitInp%NumWindPoints*3 + size(y%DiskVel) + p%NumOuts, 'RotFrame_y', TmpErrStat, TmpErrMsg) - CALL SetErrStat(TmpErrStat,TmpErrMsg,ErrStat,ErrMsg,RoutineName) - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - ENDIF - - do i=1,InitInp%NumWindPoints - do j=1,3 - InitOutData%LinNames_y((i-1)*3+j) = UVW(j)//'-component inflow velocity at node '//trim(num2lstr(i))//', m/s' - InitOutData%LinNames_u((i-1)*3+j) = XYZ(j)//'-component position of node '//trim(num2lstr(i))//', m' - end do - end do - - ! hub position - Lin_Indx = InitInp%NumWindPoints*3 - do j=1,3 - InitOutData%LinNames_y(Lin_Indx+j) = 'average '//UVW(j)//'-component rotor-disk velocity, m/s' - InitOutData%LinNames_u(Lin_Indx+j) = XYZ(j)//'-component position of moving hub, m' - end do - Lin_Indx = Lin_Indx + 3 - - ! hub orientation angles - do j=1,3 - InitOutData%LinNames_u(Lin_Indx+j) = XYZ(j)//' orientation of moving hub, rad' - end do - Lin_Indx = Lin_Indx + 3 + CALL AllocAry(InitOutData%LinNames_u, NumExtendedIO, 'LinNames_u', TmpErrStat, TmpErrMsg); if (Failed()) return + CALL AllocAry(InitOutData%RotFrame_u, NumExtendedIO, 'RotFrame_u', TmpErrStat, TmpErrMsg); if (Failed()) return + CALL AllocAry(InitOutData%IsLoad_u, NumExtendedIO, 'IsLoad_u', TmpErrStat, TmpErrMsg); if (Failed()) return + CALL AllocAry(InitOutData%LinNames_y, NumExtendedIO + p%NumOuts, 'LinNames_y', TmpErrStat, TmpErrMsg); if (Failed()) return + CALL AllocAry(InitOutData%RotFrame_y, NumExtendedIO + p%NumOuts, 'RotFrame_y', TmpErrStat, TmpErrMsg); if (Failed()) return + ! Extended Inputs + Lin_Indx = 0 InitOutData%LinNames_u(Lin_Indx + 1) = 'Extended input: horizontal wind speed (steady/uniform wind), m/s' InitOutData%LinNames_u(Lin_Indx + 2) = 'Extended input: vertical power-law shear exponent, -' - InitOutData%LinNames_u(Lin_Indx + 3) = 'Extended input: propagation direction, rad' - + InitOutData%LinNames_u(Lin_Indx + 3) = 'Extended input: propagation direction, rad' + + ! Extended Outputs + Lin_Indx = 0 + InitOutData%LinNames_y(Lin_Indx + 1) = 'Extended output: horizontal wind speed (steady/uniform wind), m/s' + InitOutData%LinNames_y(Lin_Indx + 2) = 'Extended output: vertical power-law shear exponent, -' + InitOutData%LinNames_y(Lin_Indx + 3) = 'Extended output: propagation direction, rad' + + ! Outputs do i=1,p%NumOuts - InitOutData%LinNames_y(i+3*InitInp%NumWindPoints+size(y%DiskVel)) = trim(p%OutParam(i)%Name)//', '//p%OutParam(i)%Units + InitOutData%LinNames_y(i+NumExtendedIO) = trim(p%OutParam(i)%Name)//', '//p%OutParam(i)%Units end do ! IfW inputs and outputs are in the global, not rotating frame - InitOutData%RotFrame_u = .false. - InitOutData%RotFrame_y = .false. + InitOutData%RotFrame_u = .false. + InitOutData%RotFrame_y = .false. + InitOutData%IsLoad_u = .false. ! IfW inputs for linearization are not loads - InitOutData%IsLoad_u = .false. ! IfW inputs for linearization are not loads - end if - + ! Set the version information in InitOutData InitOutData%Ver = IfW_Ver @@ -680,6 +529,12 @@ SUBROUTINE CleanUp() END SUBROUTINE CleanUp + + logical function Failed() + CALL SetErrStat( TmpErrStat, TmpErrMsg, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + if (Failed) call CleanUp() + end function Failed END SUBROUTINE InflowWind_Init @@ -746,7 +601,7 @@ SUBROUTINE InflowWind_CalcOutput( Time, InputData, p, & !----------------------------- ! Output: OutputData%DiskVel !----------------------------- - CALL InflowWind_GetSpatialAverage( Time, InputData, p, ContStates, DiscStates, ConstrStates, & + CALL InflowWind_GetRotorSpatialAverage( Time, InputData, p, ContStates, DiscStates, ConstrStates, & OtherStates, m, OutputData%DiskVel, TmpErrStat, TmpErrMsg ) CALL SetErrStat( TmpErrStat, TmpErrMsg, ErrStat, ErrMsg, RoutineName ) @@ -811,12 +666,9 @@ SUBROUTINE InflowWind_End( InputData, p, ContStates, DiscStates, ConstrStateGues ErrStat = ErrID_None ErrMsg = "" - ! Reset the wind type so that the initialization routine must be called - p%WindType = Undef_WindNumber - ! Destroy all inflow wind derived types CALL InflowWind_DestroyInput( InputData, ErrStat, ErrMsg ) - CALL InflowWind_DestroyParam( p, ErrStat, ErrMsg, DeallocatePointers=.true. ) + CALL InflowWind_DestroyParam( p, ErrStat, ErrMsg ) CALL InflowWind_DestroyContState( ContStates, ErrStat, ErrMsg ) CALL InflowWind_DestroyDiscState( DiscStates, ErrStat, ErrMsg ) CALL InflowWind_DestroyConstrState( ConstrStateGuess, ErrStat, ErrMsg ) @@ -827,134 +679,6 @@ SUBROUTINE InflowWind_End( InputData, p, ContStates, DiscStates, ConstrStateGues END SUBROUTINE InflowWind_End -!==================================================================================================== -! The following routines were added to satisfy the framework, but do nothing useful. -!==================================================================================================== -!> 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 InflowWind_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(InflowWind_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(InflowWind_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(InflowWind_ContinuousStateType), INTENT(INOUT) :: x !< Input: Continuous states at t; - !! Output: Continuous states at t + Interval - TYPE(InflowWind_DiscreteStateType), INTENT(INOUT) :: xd !< Input: Discrete states at t; - !! Output: Discrete states at t + Interval - TYPE(InflowWind_ConstraintStateType), INTENT(INOUT) :: z !< Input: Constraint states at t; - !! Output: Constraint states at t + Interval - TYPE(InflowWind_OtherStateType), INTENT(INOUT) :: OtherState !< Other states: Other states at t; - !! Output: Other states at t + Interval - TYPE(InflowWind_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 = "" - - x%DummyContState = 0.0_ReKi - xd%DummyDiscState = 0.0_ReKi - z%DummyConstrState = 0.0_ReKi - - RETURN - - -END SUBROUTINE InflowWind_UpdateStates - -!---------------------------------------------------------------------------------------------------------------------------------- -!> Tight coupling routine for computing derivatives of continuous states -SUBROUTINE InflowWind_CalcContStateDeriv( Time, u, p, x, xd, z, OtherState, m, dxdt, ErrStat, ErrMsg ) -!.................................................................................................................................. - - REAL(DbKi), INTENT(IN ) :: Time !< Current simulation time in seconds - TYPE(InflowWind_InputType), INTENT(IN ) :: u !< Inputs at Time - TYPE(InflowWind_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(InflowWind_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at Time - TYPE(InflowWind_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at Time - TYPE(InflowWind_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at Time - TYPE(InflowWind_OtherStateType), INTENT(IN ) :: OtherState !< Other states at Time - TYPE(InflowWind_MiscVarType), INTENT(INOUT) :: m !< Misc variables for optimization (not copied in glue code) - TYPE(InflowWind_ContinuousStateType), INTENT( OUT) :: dxdt !< Continuous state derivatives at Time - 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 InflowWind_CalcContStateDeriv - -!---------------------------------------------------------------------------------------------------------------------------------- -!> Tight coupling routine for updating discrete states -SUBROUTINE InflowWind_UpdateDiscState( Time, u, p, x, xd, z, OtherState, m, ErrStat, ErrMsg ) - - REAL(DbKi), INTENT(IN ) :: Time !< Current simulation time in seconds - TYPE(InflowWind_InputType), INTENT(IN ) :: u !< Inputs at Time - TYPE(InflowWind_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(InflowWind_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at Time - TYPE(InflowWind_DiscreteStateType), INTENT(INOUT) :: xd !< Input: Discrete states at Time; - !! Output: Discrete states at Time + Interval - TYPE(InflowWind_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at Time - TYPE(InflowWind_OtherStateType), INTENT(IN ) :: OtherState !< Other states at Time - TYPE(InflowWind_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: - - ! StateData%DiscState = - -END SUBROUTINE InflowWind_UpdateDiscState - -!---------------------------------------------------------------------------------------------------------------------------------- -!> Tight coupling routine for solving for the residual of the constraint state equations -SUBROUTINE InflowWind_CalcConstrStateResidual( Time, u, p, x, xd, z, OtherState, m, z_residual, ErrStat, ErrMsg ) - - REAL(DbKi), INTENT(IN ) :: Time !< Current simulation time in seconds - TYPE(InflowWind_InputType), INTENT(IN ) :: u !< Inputs at Time - TYPE(InflowWind_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(InflowWind_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at Time - TYPE(InflowWind_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at Time - TYPE(InflowWind_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at Time (possibly a guess) - TYPE(InflowWind_OtherStateType), INTENT(IN ) :: OtherState !< Other states at Time - TYPE(InflowWind_MiscVarType), INTENT(INOUT) :: m !< Misc variables for optimization (not copied in glue code) - TYPE(InflowWind_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 - - - ! Initialize ErrStat - - ErrStat = ErrID_None - ErrMsg = "" - - - ! Solve for the constraint states here: - - z_residual%DummyConstrState = 0 - -END SUBROUTINE InflowWind_CalcConstrStateResidual !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ! ###### The following four routines are Jacobian routines for linearization capabilities ####### @@ -963,8 +687,6 @@ END SUBROUTINE InflowWind_CalcConstrStateResidual !> 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 InflowWind_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(InflowWind_InputType), INTENT(IN ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) TYPE(InflowWind_ParameterType), INTENT(IN ) :: p !< Parameters @@ -972,133 +694,71 @@ SUBROUTINE InflowWind_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrSt TYPE(InflowWind_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point TYPE(InflowWind_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point TYPE(InflowWind_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point - TYPE(InflowWind_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(InflowWind_OutputType), INTENT(IN ) :: y !< Output TYPE(InflowWind_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 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: INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary error message CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_JacobianPInput' - - - REAL(R8Ki) :: local_dYdu(3,3+NumExtendedInputs) - integer :: i, n + REAL(R8Ki) :: local_dYdu(3,NumExtendedIO) + integer :: i,j, n integer :: i_start, i_end ! indices for input/output start and end integer :: node, comp - integer :: n_inputs - integer :: n_outputs - integer :: i_ExtendedInput_start - integer :: i_WriteOutput - ! Initialize ErrStat - ErrStat = ErrID_None ErrMsg = '' - IF ( PRESENT( dYdu ) ) THEN - n_outputs = SIZE(u%PositionXYZ)+p%NumOuts + size(y%DiskVel) - n_inputs = SIZE(u%PositionXYZ)+size(u%HubPosition) + 3 + NumExtendedInputs ! need to add 3 for u%HubOrientation - i_ExtendedInput_start = n_inputs - NumExtendedInputs + 1 ! index for extended inputs starts 2 from end (encompasses 3 values: V, VShr, PropDir) - i_WriteOutput = n_outputs - p%NumOuts ! index for where write outputs begin is i_WriteOutput + 1 - + ! If dYdu is allocated, make sure it is the correct size + if (allocated(dYdu)) then + if (size(dYdu,1) /= NumExtendedIO + p%NumOuts) deallocate (dYdu) + if (size(dYdu,2) /= NumExtendedIO) deallocate (dYdu) + endif + ! Calculate the partial derivative of the output functions (Y) with respect to the inputs (u) here: - - ! outputs are all velocities at all positions plus the WriteOutput values - ! + ! - inputs are extended inputs only + ! - outputs are the extended outputs and the WriteOutput values if (.not. ALLOCATED(dYdu)) then - CALL AllocAry( dYdu, n_outputs, n_inputs, 'dYdu', ErrStat2, ErrMsg2 ) + CALL AllocAry( dYdu, NumExtendedIO + p%NumOuts, NumExtendedIO, 'dYdu', ErrStat2, ErrMsg2 ) call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + if (ErrStat >= AbortErrLev) return end if - SELECT CASE ( p%WindType ) - CASE (Steady_WindNumber, Uniform_WindNumber) - - ! note that we are including the propagation direction in the analytical derivative calculated - ! inside IfW_UniformWind_JacobianPInput, so no need to transform input position vectors first - + SELECT CASE ( p%FlowField%FieldType ) + CASE (Uniform_FieldType) dYdu = 0.0_R8Ki ! initialize all non-diagonal entries to zero (position of node effects the output of only that node) - - n = SIZE(u%PositionXYZ,2) - ! these are the positions used in the module coupling - do i=1,n - ! note that p%FlowField%RotToWind(1,1) = cos(p%PropagationDir) and p%FlowField%RotToWind(2,1) = sin(p%PropagationDir), which are the - ! values we need to compute the jacobian. -!!!FIX ME with the propagation values!!!! - call IfW_UniformWind_JacobianPInput( p%FlowField%Uniform, t, u%PositionXYZ(:,i), p%FlowField%RotToWind(1,1), p%FlowField%RotToWind(2,1), local_dYdu ) - - i_end = 3*i - i_start= i_end - 2 - - dYdu(i_start:i_end,i_start:i_end) = local_dYdu(:,1:3) - - dYdu(i_start:i_end, i_ExtendedInput_start:) = local_dYdu(:,4:6) ! extended inputs - - end do - - - ! see InflowWind_GetSpatialAverage(): - - ! location of y%DiskAvg - i_start = 3*n + 1 - i_end = i_start + 2 - - dYdu(i_start:i_end,:) = 0.0_R8Ki ! initialize because we're going to create averages - - do i=1,IfW_NumPtsAvg - m%u_Avg%PositionXYZ(:,i) = matmul(u%HubOrientation,p%PositionAvg(:,i)) + u%HubPosition -!!!FIX ME with the propagation values!!!! - call IfW_UniformWind_JacobianPInput( p%FlowField%Uniform, t, m%u_Avg%PositionXYZ(:,i), p%FlowField%RotToWind(1,1), p%FlowField%RotToWind(2,1), local_dYdu ) - - ! y%DiskAvg has the same index as u%HubPosition - ! Also note that partial_(m%u_Avg%PositionXYZ) / partial_(u%HubPosition) is identity, so we can skip that part of the chain rule for these derivatives: - dYdu(i_start:i_end,i_start:i_end) = dYdu(i_start:i_end, i_start:i_end) + local_dYdu(:,1:3) - dYdu(i_start:i_end, i_ExtendedInput_start:) = dYdu(i_start:i_end, i_ExtendedInput_start:) + local_dYdu(:,4:6) ! extended inputs - end do - dYdu(i_start:i_end,i_start:i_end) = dYdu(i_start:i_end, i_start:i_end) / REAL(IfW_NumPtsAvg,R8Ki) - dYdu(i_start:i_end,i_ExtendedInput_start:) = dYdu(i_start:i_end, i_ExtendedInput_start:) / REAL(IfW_NumPtsAvg,R8Ki) -!FIX ME: - ! need to calculate dXYZdHubOrient = partial_(m%u_Avg%PositionXYZ) / partial_(u%HubOrientation) - !dYdu(i_start:i_end,(i_start+3):(i_end+3)) = matmul( dYdu(i_start:i_end,i_start:i_end), dXYZdHubOrient ) + ! Extended inputs to extended outputs (direct pass-through) + do i=1,NumExtendedIO + dYdu(i,i) = 1.0_R8Ki + enddo - ! these are the InflowWind WriteOutput velocities (and note that we may not have all of the components of each point) - ! they do not depend on the inputs, so the derivatives w.r.t. X, Y, Z are all zero + ! WriteOutput velocities (note: may not have all of the components of each point) do i=1, p%NumOuts node = p%OutParamLinIndx(1,i) ! output node comp = p%OutParamLinIndx(2,i) ! component of output node if (node > 0) then -!!!FIX ME with the propagation values!!!! call IfW_UniformWind_JacobianPInput( p%FlowField%Uniform, t, p%WindViXYZ(:,node), p%FlowField%RotToWind(1,1), p%FlowField%RotToWind(2,1), local_dYdu ) else local_dYdu = 0.0_R8Ki comp = 1 end if - - dYdu(i_WriteOutput+i, i_ExtendedInput_start:) = p%OutParam(i)%SignM * local_dYdu( comp , 4:6) + dYdu(NumExtendedIO+i, 1:NumExtendedIO) = p%OutParam(i)%SignM * local_dYdu( comp , 1:NumExtendedIO) end do CASE DEFAULT - END SELECT - END IF IF ( PRESENT( dXdu ) ) THEN @@ -1112,9 +772,9 @@ SUBROUTINE InflowWind_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrSt IF ( PRESENT( dZdu ) ) THEN if (allocated(dZdu)) deallocate(dZdu) END IF +END SUBROUTINE InflowWind_JacobianPInput -END SUBROUTINE InflowWind_JacobianPInput !.................................................................................................................................. !> Routine to compute the Jacobians of the output (Y) function with respect to the inputs (u). The partial !! derivative dY/du is returned. This submodule does not follow the modularization framework. @@ -1126,19 +786,16 @@ SUBROUTINE IfW_UniformWind_JacobianPInput(UF, t, Position, CosPropDir, SinPropDi REAL(ReKi), INTENT(IN ) :: Position(3) !< XYZ Position at which to find velocity (operating point) REAL(ReKi), INTENT(IN ) :: CosPropDir !< cosine of InflowWind propagation direction REAL(ReKi), INTENT(IN ) :: SinPropDir !< sine of InflowWind propagation direction - REAL(R8Ki), INTENT(INOUT) :: dYdu(3,6) !< Partial derivatives of output functions (Y) with respect to the inputs (u) + REAL(R8Ki), INTENT(INOUT) :: dYdu(3,NumExtendedIO) !< Partial derivatives of output functions (Y) with respect to the inputs (u) TYPE(UniformField_Interp) :: op ! interpolated values of InterpParams REAL(R8Ki) :: RotatePosition(3) !< rotated position - REAL(R8Ki) :: dVhdx ! temporary value to hold partial v_h partial X - REAL(R8Ki) :: dVhdy ! temporary value to hold partial v_h partial Y - REAL(R8Ki) :: dVhdz ! temporary value to hold partial v_h partial Z - REAL(R8Ki) :: tmp_du ! temporary value to hold calculations that are part of multiple components - REAL(R8Ki) :: tmp_dv ! temporary value to hold calculations that are part of multiple components + REAL(R8Ki) :: tmp_du ! temporary value to hold calculations that are part of multiple components + REAL(R8Ki) :: tmp_dv ! temporary value to hold calculations that are part of multiple components REAL(R8Ki) :: dVhdPD ! temporary value to hold partial v_h partial propagation direction - REAL(R8Ki) :: dVhdV ! temporary value to hold partial v_h partial V - REAL(R8Ki) :: Vh ! temporary value to hold v_h - REAL(R8Ki) :: dVhdVShr ! temporary value to hold partial v_h partial VShr + REAL(R8Ki) :: dVhdV ! temporary value to hold partial v_h partial V + REAL(R8Ki) :: Vh ! temporary value to hold v_h + REAL(R8Ki) :: dVhdVShr ! temporary value to hold partial v_h partial VShr REAL(R8Ki) :: zr if ( Position(3) < 0.0_ReKi .or. EqualRealNos(Position(3), 0.0_ReKi)) then @@ -1158,17 +815,13 @@ SUBROUTINE IfW_UniformWind_JacobianPInput(UF, t, Position, CosPropDir, SinPropDi !------------------------------------------------------------------------------------------------- !> 2. Calculate \f$ \frac{\partial Y_{Output \, Equations}}{\partial u_{inputs}} = \begin{bmatrix} - !! \frac{\partial Vt_u}{\partial X} & \frac{\partial Vt_u}{\partial Y} & \frac{\partial Vt_u}{\partial Z} \\ - !! \frac{\partial Vt_v}{\partial X} & \frac{\partial Vt_v}{\partial Y} & \frac{\partial Vt_v}{\partial Z} \\ - !! \frac{\partial Vt_w}{\partial X} & \frac{\partial Vt_w}{\partial Y} & \frac{\partial Vt_w}{\partial Z} \\ + !! \frac{\partial Vt_u}{\partial V} & \frac{\partial Vt_u}{\partial VShr} & \frac{\partial Vt_u}{\partial PropDir} \\ + !! \frac{\partial Vt_v}{\partial V} & \frac{\partial Vt_v}{\partial VShr} & \frac{\partial Vt_v}{\partial PropDir} \\ + !! \frac{\partial Vt_w}{\partial V} & \frac{\partial Vt_w}{\partial VShr} & \frac{\partial Vt_w}{\partial PropDir} \\ !! \end{bmatrix} \f$ !------------------------------------------------------------------------------------------------- zr = RotatePosition(3)/UF%RefHeight - tmp_du = op%VelH * op%ShrH / UF%RefLength * CosPropDir - dVhdx = tmp_du * op%SinAngleH - dVhdy = tmp_du * op%CosAngleH - dVhdz = op%VelH * ( op%ShrV / UF%RefHeight * zr**(op%ShrV-1.0_R8Ki) + op%LinShrV/UF%RefLength) dVhdV = ( ( RotatePosition(3)/UF%RefHeight ) ** op%ShrV & ! power-law wind shear + ( op%ShrH * ( RotatePosition(2) * op%CosAngleH + RotatePosition(1) * op%SinAngleH ) & ! horizontal linear shear @@ -1181,61 +834,33 @@ SUBROUTINE IfW_UniformWind_JacobianPInput(UF, t, Position, CosPropDir, SinPropDi tmp_du = CosPropDir*op%CosAngleH - SinPropDir*op%SinAngleH tmp_dv = -SinPropDir*op%CosAngleH - CosPropDir*op%SinAngleH - !> \f$ \frac{\partial Vt_u}{\partial X} = \left[\cos(PropagationDir)\cos(Delta) - \sin(PropagationDir)\sin(Delta) \right] - !! V \, \frac{H_{LinShr}}{RefWid} \, \sin(Delta) \cos(PropagationDir) \f$ - dYdu(1,1) = tmp_du*dVhdx - !> \f$ \frac{\partial Vt_v}{\partial X} = \left[-\sin(PropagationDir)\cos(Delta) - \cos(PropagationDir)\sin(Delta) \right] - !! V \, \frac{H_{LinShr}}{RefWid} \, \sin(Delta) \cos(PropagationDir) \f$ - dYdu(2,1) = tmp_dv*dVhdx - !> \f$ \frac{\partial Vt_w}{\partial X} = 0 \f$ - dYdu(3,1) = 0.0_R8Ki - - !> \f$ \frac{\partial Vt_u}{\partial Y} = \left[\cos(PropagationDir)\cos(Delta) - \sin(PropagationDir)\sin(Delta) \right] - !! V \, \frac{H_{LinShr}}{RefWid} \, \cos(Delta) \cos(PropagationDir) \f$ - dYdu(1,2) = tmp_du*dVhdy - !> \f$ \frac{\partial Vt_v}{\partial Y} = \left[-\sin(PropagationDir)\cos(Delta) - \cos(PropagationDir)\sin(Delta) \right] - !! V \, \frac{H_{LinShr}}{RefWid} \, \cos(Delta) \cos(PropagationDir) \f$ - dYdu(2,2) = tmp_dv*dVhdy - !> \f$ \frac{\partial Vt_w}{\partial Y} = 0 \f$ - dYdu(3,2) = 0.0_R8Ki - - !> \f$ \frac{\partial Vt_u}{\partial Z} = \left[\cos(PropagationDir)\cos(Delta) - \sin(PropagationDir)\sin(Delta) \right] - !! V \, \left[ \frac{V_{shr}}{Z_{ref}} \left( \frac{Z}{Z_{ref}} \right) ^ {V_{shr}-1} + \frac{V_{LinShr}}{RefWid} \right] \f$ - dYdu(1,3) = tmp_du*dVhdz - !> \f$ \frac{\partial Vt_v}{\partial Z} = \left[-\sin(PropagationDir)\cos(Delta) - \cos(PropagationDir)\sin(Delta) \right] - !! V \, \left[ \frac{V_{shr}}{Z_{ref}} \left( \frac{Z}{Z_{ref}} \right) ^ {V_{shr}-1} + \frac{V_{LinShr}}{RefWid} \right] \f$ - dYdu(2,3) = tmp_dv*dVhdz - !> \f$ \frac{\partial Vt_w}{\partial Z} = 0 \f$ - dYdu(3,3) = 0.0_R8Ki - ! \f$ \frac{\partial Vt_u}{\partial V} = \f$ - dYdu(1,4) = tmp_du*dVhdV + dYdu(1,1) = tmp_du*dVhdV ! \f$ \frac{\partial Vt_v}{\partial V} = \f$ - dYdu(2,4) = tmp_dv*dVhdV + dYdu(2,1) = tmp_dv*dVhdV !> \f$ \frac{\partial Vt_w}{\partial V} = 0 \f$ - dYdu(3,4) = 0.0_R8Ki + dYdu(3,1) = 0.0_R8Ki ! \f$ \frac{\partial Vt_u}{\partial VShr} = \f$ - dYdu(1,5) = tmp_du*dVhdVShr + dYdu(1,2) = tmp_du*dVhdVShr ! \f$ \frac{\partial Vt_v}{\partial VShr} = \f$ - dYdu(2,5) = tmp_dv*dVhdVShr + dYdu(2,2) = tmp_dv*dVhdVShr !> \f$ \frac{\partial Vt_w}{\partial VShr} = 0 \f$ - dYdu(3,5) = 0.0_R8Ki + dYdu(3,2) = 0.0_R8Ki ! \f$ \frac{\partial Vt_u}{\partial PropDir} = \f$ - dYdu(1,6) = tmp_dv*Vh + tmp_du*dVhdPD + dYdu(1,3) = tmp_dv*Vh + tmp_du*dVhdPD ! \f$ \frac{\partial Vt_v}{\partial PropDir} = \f$ - dYdu(2,6) = -tmp_du*Vh + tmp_dv*dVhdPD + dYdu(2,3) = -tmp_du*Vh + tmp_dv*dVhdPD !> \f$ \frac{\partial Vt_w}{\partial PropDir} = 0 \f$ - dYdu(3,6) = 0.0_R8Ki + dYdu(3,3) = 0.0_R8Ki END SUBROUTINE IfW_UniformWind_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: there are no states, so this routine is simply a placeholder to satisfy the framework and automate some glue code SUBROUTINE InflowWind_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(InflowWind_InputType), INTENT(IN ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) TYPE(InflowWind_ParameterType), INTENT(IN ) :: p !< Parameters @@ -1244,74 +869,33 @@ SUBROUTINE InflowWind_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, E TYPE(InflowWind_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point TYPE(InflowWind_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point TYPE(InflowWind_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(InflowWind_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 - - + return +! IF ( PRESENT( dYdx ) ) THEN +! END IF +! IF ( PRESENT( dXdx ) ) THEN +! END IF +! IF ( PRESENT( dXddx ) ) THEN +! END IF +! IF ( PRESENT( dZdx ) ) THEN +! END IF END SUBROUTINE InflowWind_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: there are no states, so this routine is simply a placeholder to satisfy the framework and automate some glue code SUBROUTINE InflowWind_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(InflowWind_InputType), INTENT(IN ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) TYPE(InflowWind_ParameterType), INTENT(IN ) :: p !< Parameters @@ -1320,72 +904,34 @@ SUBROUTINE InflowWind_JacobianPDiscState( t, u, p, x, xd, z, OtherState, y, m, E TYPE(InflowWind_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point TYPE(InflowWind_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point TYPE(InflowWind_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(InflowWind_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 = '' + return - 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 - - +! 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 InflowWind_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: there are no states, so this routine is simply a placeholder to satisfy the framework and automate some glue code SUBROUTINE InflowWind_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(InflowWind_InputType), INTENT(IN ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) TYPE(InflowWind_ParameterType), INTENT(IN ) :: p !< Parameters @@ -1394,69 +940,32 @@ SUBROUTINE InflowWind_JacobianPConstrState( t, u, p, x, xd, z, OtherState, y, m, TYPE(InflowWind_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point TYPE(InflowWind_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point TYPE(InflowWind_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(InflowWind_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 - + return +! IF ( PRESENT( dYdz ) ) THEN +! END IF +! IF ( PRESENT( dXdz ) ) THEN +! END IF +! IF ( PRESENT( dXddz ) ) THEN +! END IF +! IF ( PRESENT( dZdz ) ) THEN +! END IF END SUBROUTINE InflowWind_JacobianPConstrState !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ !> Routine to pack the data structures representing the operating points into arrays for linearization. SUBROUTINE InflowWind_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(InflowWind_InputType), INTENT(IN ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) TYPE(InflowWind_ParameterType), INTENT(IN ) :: p !< Parameters @@ -1475,89 +984,57 @@ SUBROUTINE InflowWind_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMs 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) :: index, i, j + INTEGER(IntKi) :: i + real(ReKi) :: tmp_op(NumExtendedIO) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_GetOP' ! Initialize ErrStat - ErrStat = ErrID_None ErrMsg = '' - IF ( PRESENT( u_op ) ) THEN + ! Since both u_op and y_op need this, calculate it up front + if (present(u_op) .or. present(y_op)) then + call IfW_UniformWind_GetOP( p%FlowField%Uniform, t, p%FlowField%VelInterpCubic, tmp_op ) + tmp_op(3) = p%FlowField%PropagationDir + tmp_op(3) ! include the AngleH from Uniform Wind input files + endif + + if ( PRESENT( u_op ) ) then if (.not. allocated(u_op)) then - call AllocAry(u_op, size(u%PositionXYZ) + size(u%HubPosition) + 3 + NumExtendedInputs, 'u_op', ErrStat2, ErrMsg2) + call AllocAry(u_op, NumExtendedIO, 'u_op', ErrStat2, ErrMsg2) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) if (ErrStat >= AbortErrLev) return end if - - - index = 0 - do i=1,size(u%PositionXYZ,2) - do j=1,size(u%PositionXYZ,1) - index = index + 1 !(i-1)*size(u%PositionXYZ,1)+j - u_op(index) = u%PositionXYZ(j,i) - end do - end do - - do i=1,3 - index = index + 1 - u_op(index) = u%HubPosition(i) - end do - - u_op((index+1):(index+3)) = EulerExtract(u%HubOrientation) - index = index + 3 - - call IfW_UniformWind_GetOP( p%FlowField%Uniform, t, p%FlowField%VelInterpCubic, u_op(index+1:index+2) ) - u_op(index + 3) = p%FlowField%PropagationDir - - END IF - IF ( PRESENT( y_op ) ) THEN + u_op(1:NumExtendedIO) = tmp_op(1:NumExtendedIO) + + end if + + if ( PRESENT( y_op ) ) then if (.not. allocated(y_op)) then - call AllocAry(y_op, size(u%PositionXYZ)+p%NumOuts+3, 'y_op', ErrStat2, ErrMsg2) + call AllocAry(y_op, NumExtendedIO + p%NumOuts, 'y_op', ErrStat2, ErrMsg2) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) if (ErrStat >= AbortErrLev) return end if - - index = 0 - do i=1,size(u%PositionXYZ,2) - do j=1,size(u%PositionXYZ,1) - index = index + 1 !(i-1)*size(u%PositionXYZ,1)+j - y_op(index) = y%VelocityUVW(j,i) - end do - end do - - do j=1,size(y%DiskVel) - index = index + 1 - y_op(index) = y%DiskVel(j) - end do - + + y_op(1:NumExtendedIO) = tmp_op(1:NumExtendedIO) do i=1,p%NumOuts - y_op(i+index) = y%WriteOutput( i ) + y_op(NumExtendedIO + i) = 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 IF + return +! 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 InflowWind_GetOP END MODULE InflowWind diff --git a/modules/inflowwind/src/InflowWind.txt b/modules/inflowwind/src/InflowWind.txt index c4ea6c56e3..924573b8f5 100644 --- a/modules/inflowwind/src/InflowWind.txt +++ b/modules/inflowwind/src/InflowWind.txt @@ -87,21 +87,19 @@ typedef ^ ^ LOGICAL Use4Dext typedef ^ ^ IntKi NumWindPoints - - - "Number of wind velocity points expected" - typedef ^ ^ IntKi TurbineID - 0 - "Wind turbine ID number in the fixed (DEFAULT) file name when FixedWindFileRootName = .TRUE. (used by FAST.Farm)" - typedef ^ ^ LOGICAL FixedWindFileRootName - .FALSE. - "Do the wind data files have a fixed (DEFAULT) file name? (used by FAST.Farm)" - -typedef ^ ^ LOGICAL UseInputFile - .TRUE. - "Should we read everthing from an input file, or do we get it some other way" - typedef ^ ^ CHARACTER(1024) RootName - - - "RootName for writing output files" -typedef ^ ^ FileInfoType PassedFileData - - - "If we don't use the input file, pass everything through this" - -typedef ^ ^ LOGICAL WindType2UseInputFile - .TRUE. - "Flag for toggling file based IO in wind type 2." - -typedef ^ ^ FileInfoType WindType2Data - - - "Optional slot for wind type 2 data if file IO is not used." - -typedef ^ ^ LOGICAL OutputAccel - .FALSE. - "Flag to output wind acceleration" - +typedef ^ ^ IntKi FilePassingMethod - 0 - "Method for file passing {0: None (read from file), 1: as FileInfoType to parse, 2: as InputFileType already parsed}" - +typedef ^ ^ FileInfoType PassedFileInfo - - - "If we don't use the input file, pass everything through this [FilePassingMethod = 1]" - +typedef ^ ^ InflowWind_InputFile PassedFileData - - - "If we don't use the input file, pass everything through this [FilePassingMethod = 2]" - +typedef ^ ^ LOGICAL OutputAccel - .FALSE. - "Flag to output wind acceleration" - typedef ^ ^ Lidar_InitInputType lidar - - - "InitInput for lidar data" - typedef ^ ^ Grid4D_InitInputType FDext - - - "InitInput for 4D external wind data" - typedef ^ ^ ReKi RadAvg - - - "Radius (from hub) used for averaging wind speed" - typedef ^ ^ IntKi MHK - - - "MHK turbine type switch" - typedef ^ ^ ReKi WtrDpth - - - "Water depth" m typedef ^ ^ ReKi MSL2SWL - - - "Mean sea level to still water level" m -typedef ^ ^ IntKi BoxExceedAllowIdx - -1 - "Extrapolate winds outside box starting at this index (for OLAF wakes and LidarSim)" - -typedef ^ ^ LOGICAL BoxExceedAllowF - .FALSE. - "Flag to allow Extrapolation winds outside box starting at this index (for OLAF wakes and LidarSim)" - -typedef ^ ^ LOGICAL LidarEnabled - .false. - "Enable LiDAR for this instance of InflowWind? (FAST.Farm, ADI, and InflowWind driver/library are not compatible)" - +typedef ^ ^ LOGICAL BoxExceedAllow - .FALSE. - "Flag to allow Extrapolation winds outside box starting at this index (for OLAF wakes and LidarSim)" - +typedef ^ ^ LOGICAL LidarEnabled - .false. - "Enable LiDAR for this instance of InflowWind? (FAST.Farm, ADI, and InflowWind driver/library are not compatible)" - # Init Output @@ -109,23 +107,23 @@ typedef ^ InitOutputType CHARACTER(ChanLen) WriteO typedef ^ ^ CHARACTER(ChanLen) WriteOutputUnt : - - "Units of output-to-file channels" - typedef ^ ^ ProgDesc Ver - - - "Version information of InflowWind module" - typedef ^ ^ WindFileDat WindFileInfo - - - "Meta data from the wind file" - -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)" - - +typedef ^ ^ CHARACTER(LinChanLen) LinNames_y {:} - - "Names of the outputs used in linearization" - +typedef ^ ^ CHARACTER(LinChanLen) LinNames_u {:} - - "Names of the inputs used in linearization" - +typedef ^ ^ LOGICAL RotFrame_y {:} - - "Flag that tells FAST/MBC3 if the outputs used in linearization are in the rotating frame" - +typedef ^ ^ LOGICAL RotFrame_u {:} - - "Flag that tells FAST/MBC3 if the inputs used in linearization are in the rotating frame" - +typedef ^ ^ LOGICAL IsLoad_u {:} - - "Flag that tells FAST if the inputs used in linearization are loads (for preconditioning matrix)" - +typedef ^ ^ FlowFieldType *FlowField - - - "Flow field data to represent all wind types" - # ..... 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 CHARACTER(1024) RootFileName - - - "Root of the InflowWind input filename" - -typedef ^ ^ IntKi WindType - 0 - "Type of wind -- set to Undef_Wind initially" - typedef ^ ^ DbKi DT - - - "Time step for cont. state integration & disc. state update" seconds typedef ^ ^ ReKi WindViXYZprime :: - - "List of XYZ coordinates for velocity measurements, translated to the wind coordinate system (prime coordinates). This equals MATMUL( RotToWind, ParamData%WindViXYZ )" meters typedef ^ ^ ReKi WindViXYZ :: - - "List of XYZ coordinates for wind velocity measurements, 3xNWindVel" meters -typedef ^ ^ FlowFieldType FlowField - - - "Parameters from Full-Field" - +typedef ^ ^ FlowFieldType &FlowField - - - "Flow field data to represent all wind types" - +#FIXME: PositionAvg is used for DiskVel. However DiskVel does not appear to be used anymore, so this could be removed. ADP-2024.08.01 typedef ^ ^ ReKi PositionAvg :: - - "(non-rotated) positions of points used for averaging wind speed" meters typedef ^ ^ IntKi NWindVel - - - "Number of points in the wind velocity list" - typedef ^ ^ IntKi NumOuts - 0 - "Number of parameters in the output list (number of outputs requested)" - @@ -148,6 +146,7 @@ typedef ^ ^ ReKi HubOrientat typedef ^ OutputType ReKi VelocityUVW :: - - "Array holding the U,V,W velocity for a given timestep" meters/sec typedef ^ OutputType ReKi AccelUVW :: - - "Array holding the U,V,W acceleration for a given timestep" meters/sec typedef ^ OutputType ReKi WriteOutput : - - "Array with values to output to file" - +#FIXME: is DiskVel still used? ADP-2024.08.01 typedef ^ ^ ReKi DiskVel {3} - - "Vector holding the U,V,W average velocity of the disk" meters/sec typedef ^ ^ ReKi HubVel {3} - - "Vector holding the U,V,W velocity at the hub" meters/sec typedef ^ ^ lidar_OutputType lidar - - - "Lidar data" - diff --git a/modules/inflowwind/src/InflowWind_Driver.f90 b/modules/inflowwind/src/InflowWind_Driver.f90 index a2c83478b9..42b29d1d11 100644 --- a/modules/inflowwind/src/InflowWind_Driver.f90 +++ b/modules/inflowwind/src/InflowWind_Driver.f90 @@ -39,6 +39,9 @@ PROGRAM InflowWind_Driver TYPE( ProgDesc ), PARAMETER :: ProgInfo = ProgDesc("InflowWind_Driver","","") INTEGER(IntKi) :: IfWDriver_Verbose = 5 ! Verbose level. 0 = none, 5 = some, 10 = lots + ! output paths hard coded + CHARACTER(*), PARAMETER :: VTKsliceDir = "vtk" ! Directory to place the output VTK slices + ! Types needed here (from InflowWind module) TYPE(InflowWind_InitInputType) :: InflowWind_InitInp ! Data for initialization -- this is where the input info goes TYPE(InflowWind_InputType) :: InflowWind_u1 ! input -- contains xyz coords of interest -- set 1 @@ -116,8 +119,23 @@ PROGRAM InflowWind_Driver CALL CPU_TIME( Timer(1) ) ! Set some CLSettings to null/default values - CLSettings%ProgInfo = ProgInfo - Settings%ProgInfo = ProgInfo + CLSettings%ProgInfo = ProgInfo + Settings%ProgInfo = ProgInfo + ! Set the filenames to empty strings -- otherwise prints garbage with the -vv option + CLSettings%DvrIptFileName = '' + CLSettings%IfWIptFileName = '' + CLSettings%SummaryFileName = '' + CLSettings%PointsFileName = '' + CLSettings%WindGridOutput%Name = '' + CLSettings%FFTOutput%Name = '' + CLSettings%PointsVelOutput%Name = '' + Settings%DvrIptFileName = '' + Settings%IfWIptFileName = '' + Settings%SummaryFileName = '' + Settings%PointsFileName = '' + Settings%WindGridOutput%Name = '' + Settings%FFTOutput%Name = '' + Settings%PointsVelOutput%Name = '' !-------------------------------------------------------------------------------------------------------------------------------- !-=-=- Parse the command line inputs -=-=- @@ -395,7 +413,7 @@ PROGRAM InflowWind_Driver ! Some other settings InflowWind_InitInp%InputFileName = Settings%IfWIptFileName ! For now, IfW cannot work without an input file. !InflowWind_InitInp%DT = Settings%DT - InflowWind_InitInp%UseInputFile = .TRUE. + InflowWind_InitInp%FilePassingMethod = 0_IntKi IF ( SettingsFlags%DvrIptFile ) THEN CALL GetRoot( Settings%DvrIptFileName, InflowWind_InitInp%RootName ) ELSE @@ -404,8 +422,7 @@ PROGRAM InflowWind_Driver END IF InflowWind_InitInp%RootName = trim(InflowWind_InitInp%RootName)//'.IfW' InflowWind_InitInp%RadAvg = -1.0_ReKi ! let the IfW code guess what to use - InflowWind_InitInp%BoxExceedAllowF = SettingsFlags%BoxExceedAllowF ! Set flag for allowing points outside the wind box (alternate interpolation method for FF) - if (InflowWind_InitInp%BoxExceedAllowF) InflowWind_InitInp%BoxExceedAllowIdx = 1_IntKi + InflowWind_InitInp%BoxExceedAllow = SettingsFlags%BoxExceedAllowF ! Set flag for allowing points outside the wind box (alternate interpolation method for FF) IF ( IfWDriver_Verbose >= 5_IntKi ) CALL WrScr('Calling InflowWind_Init...') @@ -416,93 +433,65 @@ PROGRAM InflowWind_Driver InflowWind_x, InflowWind_xd, InflowWind_z, InflowWind_OtherState, & InflowWind_y1, InflowWind_MiscVars, Settings%DT, InflowWind_InitOut, ErrStat, ErrMsg ) + if (InflowWind_InitInp%BoxExceedAllow) then + InflowWind_p%FlowField%Grid3D%BoxExceedAllowDrv = .true. + end if - ! 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 ) THEN - IF ( IfWDriver_Verbose >= 7_IntKi ) THEN - CALL WrScr(NewLine//' InflowWind_Init returned: ErrStat: '//TRIM(Num2LStr(ErrStat))// & - NewLine//' ErrMsg: '//TRIM(ErrMsg)//NewLine) - ELSEIF ( ErrStat >= ErrID_Warn ) THEN - CALL ProgWarn( ErrMsg ) - ELSE - CALL WrScr(TRIM(ErrMsg)) - ENDIF - ENDIF - - + call CheckCallErr('InflowWind_Init') - ! Let user know we returned from the InflowWind code if verbose - IF ( IfWDriver_Verbose >= 5_IntKi ) CALL WrScr(NewLine//'InflowWind_Init CALL returned without errors.'//NewLine) ! Convert InflowWind file to HAWC format IF (SettingsFlags%WrHAWC) THEN CALL IfW_WriteHAWC( InflowWind_p%FlowField, InflowWind_InitInp%RootName, ErrStat, ErrMsg ) - IF (ErrStat > ErrID_None) THEN - CALL WrScr( TRIM(ErrMsg) ) - IF ( ErrStat >= AbortErrLev ) THEN - CALL DriverCleanup() - CALL ProgAbort( ErrMsg ) - ELSEIF ( IfWDriver_Verbose >= 7_IntKi ) THEN - CALL WrScr(NewLine//' IfW_WriteHAWC returned: ErrStat: '//TRIM(Num2LStr(ErrStat))) - END IF - ELSE IF ( IfWDriver_Verbose >= 5_IntKi ) THEN - CALL WrScr(NewLine//'IfW_WriteHAWC CALL returned without errors.'//NewLine) - END IF + call CheckCallErr('IfW_WriteHAWC') END IF ! Convert InflowWind file to Native Bladed format IF (SettingsFlags%WrBladed) THEN CALL IfW_WriteBladed( InflowWind_p%FlowField, InflowWind_InitInp%RootName, ErrStat, ErrMsg ) - IF (ErrStat > ErrID_None) THEN - CALL WrScr( TRIM(ErrMsg) ) - IF ( ErrStat >= AbortErrLev ) THEN - CALL DriverCleanup() - CALL ProgAbort( ErrMsg ) - ELSEIF ( IfWDriver_Verbose >= 7_IntKi ) THEN - CALL WrScr(NewLine//' InflowWind_Convert2Bladed returned: ErrStat: '//TRIM(Num2LStr(ErrStat))) - END IF - ELSE IF ( IfWDriver_Verbose >= 5_IntKi ) THEN - CALL WrScr(NewLine//'InflowWind_Convert2Bladed CALL returned without errors.'//NewLine) - END IF + call CheckCallErr('IfW_WriteBladed') END IF + IF (SettingsFlags%WrVTK) THEN CALL IfW_WriteVTK( InflowWind_p%FlowField, InflowWind_InitInp%RootName, ErrStat, ErrMsg ) - IF (ErrStat > ErrID_None) THEN - CALL WrScr( TRIM(ErrMsg) ) - IF ( ErrStat >= AbortErrLev ) THEN - CALL DriverCleanup() - CALL ProgAbort( ErrMsg ) - ELSEIF ( IfWDriver_Verbose >= 7_IntKi ) THEN - CALL WrScr(NewLine//' IfW_WriteVTK returned: ErrStat: '//TRIM(Num2LStr(ErrStat))) - END IF - ELSE IF ( IfWDriver_Verbose >= 5_IntKi ) THEN - CALL WrScr(NewLine//'IfW_WriteVTK CALL returned without errors.'//NewLine) - END IF - + call CheckCallErr('IfW_WriteVTK') END IF IF (SettingsFlags%WrUniform) THEN CALL IfW_WriteUniform( InflowWind_p%FlowField, InflowWind_InitInp%RootName, ErrStat, ErrMsg ) - IF (ErrStat > ErrID_None) THEN - CALL WrScr( TRIM(ErrMsg) ) - IF ( ErrStat >= AbortErrLev ) THEN - CALL DriverCleanup() - CALL ProgAbort( ErrMsg ) - ELSEIF ( IfWDriver_Verbose >= 7_IntKi ) THEN - CALL WrScr(NewLine//' IfW_WriteUniform returned: ErrStat: '//TRIM(Num2LStr(ErrStat))) - END IF - ELSE IF ( IfWDriver_Verbose >= 5_IntKi ) THEN - CALL WrScr(NewLine//'IfW_WriteUniform CALL returned without errors.'//NewLine) - END IF + call CheckCallErr('IfW_WriteUniform') END IF + + IF (Settings%NOutWindXY>0) THEN + do i=1,Settings%NOutWindXY + CALL IfW_WriteXYslice( InflowWind_p%FlowField, InflowWind_InitInp%RootName, VTKsliceDir, Settings%OutWindZ(i), ErrStat, ErrMsg ) + call CheckCallErr('IfW_WriteXYslice'//trim(Num2LStr(i))) + enddo + END IF + + +!FIXME: future developent +! IF (Settings%NOutWindXZ>0) THEN +! do i=1,Settings%NOutWindXZ +! CALL IfW_WriteXZslice( InflowWind_p%FlowField, InflowWind_InitInp%RootName, VTKsliceDir, Settings%OutWindY(i), ErrStat, ErrMsg ) +! call CheckCallErr('IfW_WriteXZslice'//trim(Num2LStr(i))) +! enddo +! END IF + + +! IF (Settings%NOutWindYZ>0) THEN +! do i=1,Settings%NOutWindYZ +! CALL IfW_WriteYZslice( InflowWind_p%FlowField, InflowWind_InitInp%RootName, VTKsliceDir, Settings%OutWindX(i), ErrStat, ErrMsg ) +! call CheckCallErr('IfW_WriteYZslice'//trim(Num2LStr(i))) +! enddo +! END IF + + !-------------------------------------------------------------------------------------------------------------------------------- !-=-=- Other Setup -=-=- !-------------------------------------------------------------------------------------------------------------------------------- @@ -861,8 +850,6 @@ PROGRAM InflowWind_Driver !FFT calculations occur here. Output to file. - - !-------------------------------------------------------------------------------------------------------------------------------- !-=-=- We are done, so close everything down -=-=- !-------------------------------------------------------------------------------------------------------------------------------- @@ -924,8 +911,6 @@ PROGRAM InflowWind_Driver CALL WrScr(' InflowWind_End call 3 of 3: ok') ENDIF - - CALL DriverCleanup() CONTAINS @@ -944,6 +929,21 @@ SUBROUTINE DriverCleanup() END SUBROUTINE DriverCleanup + subroutine CheckCallErr(RoutineName) + character(*), intent(in) :: RoutineName + if (ErrStat > ErrID_None) then + call WrScr( trim(ErrMsg) ) + if ( ErrStat >= AbortErrLev ) then + call DriverCleanup() + call ProgAbort( ErrMsg ) + elseif ( IfWDriver_Verbose >= 7_IntKi ) then + call WrScr(NewLine//' '//trim(RoutineName)//' returned: ErrStat: '//TRIM(Num2LStr(ErrStat))) + endif + elseif ( IfWDriver_Verbose >= 5_IntKi ) then + CALL WrScr(NewLine//trim(RoutineName)//' CALL returned without errors.'//NewLine) + endif + end subroutine CheckCallErr + END PROGRAM InflowWind_Driver diff --git a/modules/inflowwind/src/InflowWind_Driver_Registry.txt b/modules/inflowwind/src/InflowWind_Driver_Registry.txt new file mode 100644 index 0000000000..3863019d77 --- /dev/null +++ b/modules/inflowwind/src/InflowWind_Driver_Registry.txt @@ -0,0 +1,91 @@ +#---------------------------------------------------------------------------------------------------------------------------------- +# Registry for IfW_Interp, creates MODULE IfW_Interp_Types +# Module IfW_Interp_Types contains all of the user-defined types needed in IfW_FF. It also contains copy, destroy, pack, and +# unpack routines associated with each defined data types. +#---------------------------------------------------------------------------------------------------------------------------------- +# keyword +#---------------------------------------------------------------------------------------------------------------------------------- + +include Registry_NWTC_Library.txt + +#---------------------------------------------------------------------------------------------------------------------------------- +typedef InflowWind_Driver OutputFile character(1024) Name - "" - "Filename for output from points read in from points file" - +typedef ^ ^ integer Unit - -1 - "Unit number for the output file for the Points file output" - +typedef ^ ^ logical Initialized - .false. - "Flag indicating that file has been initialized" - + +# 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 InflowWind input file. +#---------------------------------------------------------------------------------------------------------------------------------- +typedef InflowWind_Driver IfWDriver_Flags logical DvrIptFile - .false. - "Was an input file name given on the command line?" - +typedef ^ ^ logical IfWIptFile - .false. - "Was an InflowWind input file requested?" - +typedef ^ ^ logical Summary - .false. - "create a summary at command line? (data extents in the wind file)" - +typedef ^ ^ logical SummaryFile - .false. - "create a summary file of the output?" - +typedef ^ ^ logical TStart - .false. - "specified a start time" - +typedef ^ ^ logical NumTimeSteps - .false. - "specified a number of timesteps to process" - +typedef ^ ^ logical NumTimeStepsDefault - .false. - "specified a 'DEFAULT' for number of timesteps to process" - +typedef ^ ^ logical DT - .false. - "specified a resolution in time" - +typedef ^ ^ logical DTDefault - .false. - "specified a 'DEFAULT' for the time resolution" - + +typedef ^ ^ logical FFTcalc - .false. - "do an FFT" - + +typedef ^ ^ logical WindGrid - .false. - "Requested output of wind data on a grid -- input file option only" - +typedef ^ ^ logical XRange - .false. - "specified a range of x -- command line option only -- stored as GridCtrCoord and GridDelta" - +typedef ^ ^ logical YRange - .false. - "specified a range of y -- command line option only -- stored as GridCtrCoord and GridDelta" - +typedef ^ ^ logical ZRange - .false. - "specified a range of z -- command line option only -- stored as GridCtrCoord and GridDelta" - +typedef ^ ^ logical Dx - .false. - "specified a resolution in x -- command line option only, 0.0 otherwise" - +typedef ^ ^ logical Dy - .false. - "speficied a resolution in y" - +typedef ^ ^ logical Dz - .false. - "specified a resolution in z" - + +typedef ^ ^ logical PointsFile - .false. - "points filename to read in" - +typedef ^ ^ logical OutputAccel - .false. - "flag to calculate and output wind acceleration in addition to velocity" - + +typedef ^ ^ logical Verbose - .false. - "Verbose error reporting" - +typedef ^ ^ logical VVerbose - .false. - "Very Verbose error reporting" - +typedef ^ ^ logical BoxExceedAllowF - .false. - "set flag to allow exceeding wind box boundaries for FF files (for diagnostic purposes)" - + +typedef ^ ^ logical WrHAWC - .false. - "Requested file conversion to HAWC2 format?" - +typedef ^ ^ logical WrBladed - .false. - "Requested file conversion to Bladed format?" - +typedef ^ ^ logical WrVTK - .false. - "Requested file output as VTK?" - +typedef ^ ^ logical WrUniform - .false. - "Requested file output as Uniform wind format?" - + +typedef ^ ^ logical XYslice - .false. - "Take XY slice at one elevation" - + + + +# This contains all the settings (possible passed in arguments). +#---------------------------------------------------------------------------------------------------------------------------------- +typedef InflowWind_Driver IfWDriver_Settings character(1024) DvrIptFileName - "" - "Driver input file name" - +typedef ^ ^ character(1024) IfWIptFileName - "" - "Filename of InflowWind input file to read (if no driver input file)" - +typedef ^ ^ character(1024) SummaryFileName - "" - "Filename for the summary information output" - + +typedef ^ ^ character(1024) PointsFileName - "" - "Filename of points file to read in" - + +typedef ^ ^ IntKi NumTimeSteps - 0 - "Number of timesteps" - +typedef ^ ^ DbKi DT - 0.0_DbKi - "resolution of time" s +typedef ^ ^ DbKi TStart - 0.0_DbKi - "range of time -- end time converted from TRange (command line option only)" s + +typedef ^ ^ ReKi FFTcoord(1:3) - 0.0_ReKi - "(x,y,z) coordinate to do an FFT at" (m) + +typedef ^ ^ ReKi GridDelta(1:3) - 0.0_ReKi - "(GridDx,GridDy,GridDz) -- grid point spacing" (m) +typedef ^ ^ IntKi GridN(1:3) - 1_IntKi - "(GridNx,GridNy,GridNz) -- number of grid points" - + +typedef ^ ^ ReKi XRange(1:2) - 0.0_ReKi - "Range in the x-direction for the gridded data" (m) +typedef ^ ^ ReKi YRange(1:2) - 0.0_ReKi - "Range in the y-direction for the gridded data" (m) +typedef ^ ^ ReKi ZRange(1:2) - 0.0_ReKi - "Range in the z-direction for the gridded data" (m) + +typedef ^ ^ ProgDesc ProgInfo - - - "Program info" - +typedef ^ ^ OutputFile WindGridOutput - - - "Wind grid file handling" - +typedef ^ ^ OutputFile FFTOutput - - - "FFT file handling" - +typedef ^ ^ OutputFile PointsVelOutput - - - "Points output velocity file handling" - + +typedef ^ ^ IntKi NOutWindXY - 0 - "Number of XY planes for output .XY.t.vtk [0 to 9]" - +typedef ^ ^ ReKi OutWindZ : - - "Z coordinates of XY planes for output [1 to NOutWindXY] [unused for NOutWindXY=0]" (m) +typedef ^ ^ IntKi NOutWindXZ - 0 - "Number of YZ planes for output .YZ.t.vtk [0 to 9]" - +typedef ^ ^ ReKi OutWindY : - - "Y coordinates of YZ planes for output [1 to NOutWindYZ] [unused for NOutWindYZ=0]" (m) +typedef ^ ^ IntKi NOutWindYZ - 0 - "Number of YZ planes for output .YZ.t.vtk [0 to 9]" - +typedef ^ ^ ReKi OutWindX : - - "X coordinates of YZ planes for output [1 to NOutWindYZ] [unused for NOutWindYZ=0]" (m) diff --git a/modules/inflowwind/src/InflowWind_Driver_Subs.f90 b/modules/inflowwind/src/InflowWind_Driver_Subs.f90 index 186b3435df..98d7fdf293 100644 --- a/modules/inflowwind/src/InflowWind_Driver_Subs.f90 +++ b/modules/inflowwind/src/InflowWind_Driver_Subs.f90 @@ -734,18 +734,12 @@ SUBROUTINE ReadDvrIptFile( DvrFileName, DvrFlags, DvrSettings, ProgInfo, ErrStat ! 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) + ErrStat = ErrID_None + ErrMsg = "" CALL GetNewUnit( UnIn ) - CALL OpenFInpFile( UnIn, FileName, ErrStatTmp, ErrMsgTmp ) - IF ( ErrStatTmp /= ErrID_None ) THEN - CALL SetErrStat(ErrID_Fatal,' Failed to open InflowWind Driver input file: '//FileName, & - ErrStat,ErrMsg,RoutineName) - CLOSE( UnIn ) - RETURN - ENDIF - + CALL OpenFInpFile( UnIn, FileName, ErrStatTmp, ErrMsgTmp ); if (Failed()) return CALL WrScr( 'Opening InflowWind Driver input file: '//FileName ) @@ -754,30 +748,9 @@ SUBROUTINE ReadDvrIptFile( DvrFileName, DvrFlags, DvrSettings, ProgInfo, ErrStat !------------------------------------------------------------------------------------------------- ! File header !------------------------------------------------------------------------------------------------- - - CALL ReadCom( UnIn, FileName,' InflowWind 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, 'InflowWind 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 + CALL ReadCom( UnIn, FileName,' InflowWind Driver input file header line 1', ErrStatTmp, ErrMsgTmp ); if (Failed()) return + CALL ReadCom( UnIn, FileName, 'InflowWind Driver input file header line 2', ErrStatTmp, ErrMsgTmp ); if (Failed()) return + CALL ReadVar ( UnIn, FileName, EchoFileContents, 'Echo', 'Echo Input', ErrStatTmp, ErrMsgTmp ); if (Failed()) return ! If we are Echoing the input then we should re-read the first three lines so that we can echo them @@ -788,44 +761,15 @@ SUBROUTINE ReadDvrIptFile( DvrFileName, DvrFlags, DvrSettings, ProgInfo, ErrStat 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 - + CALL OpenEcho ( UnEchoLocal, EchoFileName, ErrStatTmp, ErrMsgTmp, ProgInfo ); if (Failed()) return REWIND(UnIn) ! Reread and echo - CALL ReadCom( UnIn, FileName,' InflowWind 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, 'InflowWind 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 + CALL ReadCom( UnIn, FileName,' InflowWind Driver input file header line 1', ErrStatTmp, ErrMsgTmp, UnEchoLocal ); if (Failed()) return + CALL ReadCom( UnIn, FileName, 'InflowWind Driver input file header line 2', ErrStatTmp, ErrMsgTmp, UnEchoLocal ); if (Failed()) return + CALL ReadVar ( UnIn, FileName, EchoFileContents, 'Echo', 'Echo Input', ErrStatTmp, ErrMsgTmp, UnEchoLocal ); if (Failed()) return @@ -835,78 +779,30 @@ SUBROUTINE ReadDvrIptFile( DvrFileName, DvrFlags, DvrSettings, ProgInfo, ErrStat !------------------------------------------------------------------------------------------------- ! Driver setup section !------------------------------------------------------------------------------------------------- - - ! Header - CALL ReadCom( UnIn, FileName,' Driver 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 - + CALL ReadCom( UnIn, FileName,' Driver setup section, comment line', ErrStatTmp, ErrMsgTmp, UnEchoLocal ); if (Failed()) return ! Name of InflowWind input file - CALL ReadVar( UnIn, FileName,DvrSettings%IfWIptFileName,'IfWIptFileName',' InflowWind 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%IfWIptFile = .TRUE. - ENDIF - + CALL ReadVar( UnIn, FileName,DvrSettings%IfWIptFileName,'IfWIptFileName',' InflowWind input filename', ErrStatTmp,ErrMsgTmp, UnEchoLocal ); if (Failed()) return + DvrFlags%IfWIptFile = .TRUE. IF ( PathIsRelative( DvrSettings%IfWIptFileName ) ) DvrSettings%IfWIptFileName = TRIM(PriPath)//TRIM(DvrSettings%IfWIptFileName) !------------------------------------------------------------------------------------------------- ! File Conversion Options section !------------------------------------------------------------------------------------------------- - - ! Header - CALL ReadCom( UnIn, FileName,'File Conversion Options Section Header', ErrStatTmp, ErrMsgTmp, UnEchoLocal ) - CALL SetErrStat(ErrStatTmp, ErrMsgTmp,ErrStat,ErrMsg,RoutineName) - - ! WrHAWC - CALL ReadVar( UnIn, FileName, DvrFlags%WrHAWC, 'WrHAWC', 'Convert wind data to HAWC2 format?', ErrStatTmp, ErrMsgTmp, UnEchoLocal ) - CALL SetErrStat(ErrStatTmp, ErrMsgTmp,ErrStat,ErrMsg,RoutineName) + CALL ReadCom( UnIn, FileName,'File Conversion Options Section Header', ErrStatTmp, ErrMsgTmp, UnEchoLocal ); if (Failed()) return + CALL ReadVar( UnIn, FileName, DvrFlags%WrHAWC, 'WrHAWC', 'Convert wind data to HAWC2 format?', ErrStatTmp, ErrMsgTmp, UnEchoLocal ); if (Failed()) return + CALL ReadVar( UnIn, FileName, DvrFlags%WrBladed, 'WrBladed', 'Convert wind data to Bladed format?', ErrStatTmp, ErrMsgTmp, UnEchoLocal ); if (Failed()) return + CALL ReadVar( UnIn, FileName, DvrFlags%WrVTK, 'WrVTK', 'Convert wind data to VTK format?', ErrStatTmp, ErrMsgTmp, UnEchoLocal ); if (Failed()) return + CALL ReadVar( UnIn, FileName, DvrFlags%WrUniform, 'WrUniform','Convert wind data to Uniform Wind format?', ErrStatTmp, ErrMsgTmp, UnEchoLocal ); if (Failed()) return - ! WrBladed - CALL ReadVar( UnIn, FileName, DvrFlags%WrBladed, 'WrBladed', 'Convert wind data to Bladed format?', ErrStatTmp, ErrMsgTmp, UnEchoLocal ) - CALL SetErrStat(ErrStatTmp, ErrMsgTmp,ErrStat,ErrMsg,RoutineName) - - ! WrVTK - CALL ReadVar( UnIn, FileName, DvrFlags%WrVTK, 'WrVTK', 'Convert wind data to VTK format?', ErrStatTmp, ErrMsgTmp, UnEchoLocal ) - CALL SetErrStat(ErrStatTmp, ErrMsgTmp,ErrStat,ErrMsg,RoutineName) - - ! WrUniform - CALL ReadVar( UnIn, FileName, DvrFlags%WrUniform, 'WrUniform', 'Convert wind data to Uniform Wind format?', ErrStatTmp, ErrMsgTmp, UnEchoLocal ) - CALL SetErrStat(ErrStatTmp, ErrMsgTmp,ErrStat,ErrMsg,RoutineName) - - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanupEchoFile( EchoFileContents, UnEchoLocal ) - CLOSE( UnIn ) - RETURN - ENDIF - !------------------------------------------------------------------------------------------------- ! Tests of Interpolation Options section !------------------------------------------------------------------------------------------------- - CALL ReadCom( UnIn, FileName,'Tests of Interpolation Options Section Header', ErrStatTmp, ErrMsgTmp, UnEchoLocal ) - CALL SetErrStat(ErrStatTmp, ErrMsgTmp,ErrStat,ErrMsg,RoutineName) - + CALL ReadCom( UnIn, FileName,'Tests of Interpolation Options Section Header', ErrStatTmp, ErrMsgTmp, UnEchoLocal ); if (Failed()) return ! Number of timesteps - CALL ReadVar( UnIn, FileName,NumTimeStepsChr,'NumTimeStepsChr',' Character string for number of timesteps to read.', & - 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 ReadVar( UnIn, FileName,NumTimeStepsChr,'NumTimeStepsChr',' Number of timesteps to read.', ErrStatTmp,ErrMsgTmp, UnEchoLocal ); if (Failed()) return ! Check if we asked for the DEFAULT (use what is in the file) CALL Conv2UC( NumTimeStepsChr ) @@ -918,8 +814,7 @@ SUBROUTINE ReadDvrIptFile( DvrFileName, DvrFlags, DvrSettings, ProgInfo, ErrStat ! make sure that it was appropriately interpretted. READ (NumTimeStepsChr,*,IOSTAT=IOS) DvrSettings%NumTimeSteps IF ( IOS /= 0 ) THEN ! problem in the read, so parse the error. - CALL CheckIOS ( IOS, '', 'NumTimeSteps',NumType, ErrStatTmp, ErrMsgTmp ) - RETURN + CALL CheckIOS ( IOS, '', 'NumTimeSteps',NumType, ErrStatTmp, ErrMsgTmp ); if (Failed()) return ELSE ! Was ok, so set the flags DvrFlags%NumTimeSteps = .TRUE. DvrFlags%NumTimeStepsDefault = .FALSE. @@ -928,27 +823,11 @@ SUBROUTINE ReadDvrIptFile( DvrFileName, DvrFlags, DvrSettings, ProgInfo, ErrStat ! TStart -- start time - CALL ReadVar( UnIn, FileName,DvrSettings%TStart,'TStart',' Time in wind file to start parsing.', & - 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%TStart = .TRUE. - ENDIF - + CALL ReadVar( UnIn, FileName,DvrSettings%TStart,'TStart',' Time in wind file to start parsing.', ErrStatTmp,ErrMsgTmp, UnEchoLocal ); if (Failed()) return + DvrFlags%TStart = .TRUE. ! 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 + CALL ReadVar( UnIn, FileName,DTChr,'DTChr',' Character string for Timestep', ErrStatTmp,ErrMsgTmp, UnEchoLocal ); if (Failed()) return ! Check if we asked for the DEFAULT (use what is in the file) CALL Conv2UC( DTChr ) @@ -960,8 +839,7 @@ SUBROUTINE ReadDvrIptFile( DvrFileName, DvrFlags, DvrSettings, ProgInfo, ErrStat ! make sure that it was appropriately interpretted. READ (DTChr,*,IOSTAT=IOS) DvrSettings%DT IF ( IOS /= 0 ) THEN ! problem in the read, so parse the error. - CALL CheckIOS ( IOS, '', 'DT',NumType, ErrStatTmp, ErrMsgTmp ) - RETURN + CALL CheckIOS ( IOS, '', 'DT',NumType, ErrStatTmp, ErrMsgTmp ); if (Failed()) return ELSE ! Was ok, so set the flags DvrFlags%DT = .TRUE. DvrFlags%DTDefault = .FALSE. @@ -969,213 +847,75 @@ SUBROUTINE ReadDvrIptFile( DvrFileName, DvrFlags, DvrSettings, ProgInfo, ErrStat ENDIF - ! Summarize the extents in the windfile - CALL ReadVar( UnIn, FileName,DvrFlags%Summary,'Summary',' Summarize data extents in the windfile', & - 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%Summary = .TRUE. - ENDIF - - - ! Summarize everything in a summary file/ - CALL ReadVar( UnIn, FileName,DvrFlags%SummaryFile,'SummaryFile',' Summarize the results in a .sum 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%SummaryFile = .TRUE. - ENDIF + ! Summary info + CALL ReadVar( UnIn, FileName,DvrFlags%Summary, 'Summary', ' Summarize data extents in the windfile', ErrStatTmp,ErrMsgTmp, UnEchoLocal ); if (Failed()) return + CALL ReadVar( UnIn, FileName,DvrFlags%SummaryFile,'SummaryFile',' Summarize the results in a .sum file', ErrStatTmp,ErrMsgTmp, UnEchoLocal ); if (Failed()) return ! Flag to allow sampling outside grid - CALL ReadVar( UnIn, FileName,DvrFlags%BoxExceedAllowF,'BoxExceedAllow',' Allow point sampling outside grid', & - 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 ReadVar( UnIn, FileName,DvrFlags%BoxExceedAllowF,'BoxExceedAllow',' Allow point sampling outside grid', ErrStatTmp,ErrMsgTmp, UnEchoLocal ); if (Failed()) return + #ifdef UNUSED_INPUTFILE_LINES !------------------------------------------------------------------------------------------------- ! FFT calculations !------------------------------------------------------------------------------------------------- - - ! Header - CALL ReadCom( UnIn, FileName,' FFT calculations, 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 - - - ! FFTcalc -- FFTcalc of the windfield needed. - CALL ReadVar( UnIn, FileName,DvrFlags%FFTcalc,'FFTcalc',' Perform an FFT?', & - 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,' FFT calculations, comment line', ErrStatTmp, ErrMsgTmp, UnEchoLocal ); if (Failed()) return + CALL ReadVar( UnIn, FileName,DvrFlags%FFTcalc,'FFTcalc',' Perform an FFT?', ErrStatTmp,ErrMsgTmp, UnEchoLocal ); if (Failed()) return ! Read the coordinate for the FFT if the flag is set, otherwise skip the line IF ( DvrFlags%FFTcalc ) THEN ! FFTcoord -- The coordinates to perform the FFT at - CALL ReadAry ( UnIn, FileName, DvrSettings%FFTcoord, 3, 'FFTcoord', & - 'FFT 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 + CALL ReadAry ( UnIn, FileName, DvrSettings%FFTcoord, 3, 'FFTcoord', 'FFT coordinate', ErrStatTmp, ErrMsgTmp, UnEchoLocal); if (Failed()) return ELSE - CALL ReadCom( UnIn, FileName,' Skipping the FFT coordinate since not doint an FFT.', 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 FFT coordinate since not doint an FFT.', ErrStatTmp, ErrMsgTmp, UnEchoLocal ); if (Failed()) 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 - - - ! Points input file (unused if .not. DvrFlags%PointsFile) - 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 - + CALL ReadCom( UnIn, FileName,' Points file input, comment line', ErrStatTmp, ErrMsgTmp, UnEchoLocal ); if (Failed()) return + CALL ReadVar( UnIn, FileName,DvrFlags%PointsFile, 'PointsFile', ' Read a points file?', ErrStatTmp,ErrMsgTmp, UnEchoLocal ); if (Failed()) return + CALL ReadVar( UnIn, FileName,DvrSettings%PointsFileName,'PointsFileName',' Points file input filename', ErrStatTmp,ErrMsgTmp, UnEchoLocal ); if (Failed()) return IF ( PathIsRelative( DvrSettings%PointsFileName ) ) DvrSettings%PointsFileName = TRIM(PriPath)//TRIM(DvrSettings%PointsFileName) ! CalcAccel - calculate wind acceleration (unused if .not. DvrFlags%PointsFile) - CALL ReadVar( UnIn, FileName,DvrFlags%OutputAccel, 'CalcAccel', ' Calc and output wind acceleration', & - 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 ReadVar( UnIn, FileName,DvrFlags%OutputAccel, 'CalcAccel', ' Calc and output wind acceleration', ErrStatTmp,ErrMsgTmp, UnEchoLocal ); if (Failed()) return + !------------------------------------------------------------------------------------------------- ! gridded data output !------------------------------------------------------------------------------------------------- - - ! Header - CALL ReadCom( UnIn, FileName,' Gridded data output, 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 - + CALL ReadCom( UnIn, FileName,' Gridded data output, comment line', ErrStatTmp, ErrMsgTmp, UnEchoLocal ); if (Failed()) return ! WindGrid -- Gridded data output - CALL ReadVar( UnIn, FileName,DvrFlags%WindGrid,'WindGrid',' Output a grid of data?', & - 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 ReadVar( UnIn, FileName,DvrFlags%WindGrid,'WindGrid',' Output a grid of data?', ErrStatTmp,ErrMsgTmp, UnEchoLocal ); if (Failed()) return - ! Read the coordinate for the FFT if the flag is set, otherwise skip the line + ! Read the coordinate for the WindGrid if the flag is set, otherwise skip the line IF ( DvrFlags%WindGrid ) THEN ! GridCtrCoord -- The coordinates to center the gridded data at - CALL ReadAry ( UnIn, FileName, GridCtrCoord, 3, 'GridCtrCoord', & - 'Coordinate of the center of the gridded data', ErrStatTmp, ErrMsgTmp, UnEchoLocal) - IF ( ErrStat /= ErrID_None ) THEN - CALL SetErrStat( ErrID_Fatal,ErrMsgTmp,ErrStat,ErrMsg,RoutineName) - CALL CleanupEchoFile( EchoFileContents, UnEchoLocal ) - CLOSE( UnIn ) - RETURN - ENDIF + CALL ReadAry ( UnIn, FileName, GridCtrCoord, 3, 'GridCtrCoord', 'Coordinate of the center of the gridded data', ErrStatTmp, ErrMsgTmp, UnEchoLocal); if (Failed()) return ! Read the DY and DZ stepsize - CALL ReadAry ( UnIn, FileName, TmpRealAr3, 3, 'GridDX, GridDY, GridDZ', & - 'GridDX, GridDY, GridDZ', ErrStatTmp, ErrMsgTmp, UnEchoLocal) - IF ( ErrStat /= ErrID_None ) THEN - CALL SetErrStat( ErrID_Fatal,ErrMsgTmp,ErrStat,ErrMsg,RoutineName) - CALL CleanupEchoFile( EchoFileContents, UnEchoLocal ) - CLOSE( UnIn ) - RETURN - ENDIF + CALL ReadAry ( UnIn, FileName, TmpRealAr3, 3, 'GridDX, GridDY, GridDZ', 'GridDX, GridDY, GridDZ', ErrStatTmp, ErrMsgTmp, UnEchoLocal); if (Failed()) return ! Save the DY and DZ values - DvrSettings%GridDelta(1) = abs(TmpRealAr3(1)) ! X direction - DvrSettings%GridDelta(2) = abs(TmpRealAr3(2)) ! Y direction - DvrSettings%GridDelta(3) = abs(TmpRealAr3(3)) ! Z direction + DvrSettings%GridDelta(1:3) = abs(TmpRealAr3(1:3)) DvrFlags%Dx = .TRUE. ! read in value for the X direction gridding DvrFlags%Dy = .TRUE. ! read in value for the Y direction gridding DvrFlags%Dz = .TRUE. ! read in value for the Z direction gridding ! Read the number of points in the Y and Z directions - CALL ReadAry ( UnIn, FileName, TmpIntAr3, 3, 'GridNx, GridNY, GridNZ', & - 'GridNx, GridNY, GridNZ', ErrStatTmp, ErrMsgTmp, UnEchoLocal) - IF ( ErrStat /= ErrID_None ) THEN - CALL SetErrStat( ErrID_Fatal,ErrMsgTmp,ErrStat,ErrMsg,RoutineName) - CALL CleanupEchoFile( EchoFileContents, UnEchoLocal ) - CLOSE( UnIn ) - RETURN - ENDIF + CALL ReadAry ( UnIn, FileName, DvrSettings%GridN, 3, 'GridNx, GridNY, GridNZ', 'GridNx, GridNY, GridNZ', ErrStatTmp, ErrMsgTmp, UnEchoLocal ); if (Failed()) return ! Save the GridNY and GridNZ values - DvrSettings%GridN(1) = TmpIntAr3(1) ! X direction - DvrSettings%GridN(2) = TmpIntAr3(2) ! Y direction - DvrSettings%GridN(3) = TmpIntAr3(3) ! Z direction - DvrFlags%XRange = .TRUE. ! read in value for the X direction gridding - DvrFlags%YRange = .TRUE. ! read in value for the Y direction gridding - DvrFlags%ZRange = .TRUE. ! read in value for the Z direction gridding - + DvrFlags%XRange = .TRUE. ! read in value for the X direction gridding + DvrFlags%YRange = .TRUE. ! read in value for the Y direction gridding + DvrFlags%ZRange = .TRUE. ! read in value for the Z direction gridding ! Check that valid values of Dx, Dy, and Dz were read in. @@ -1269,10 +1009,8 @@ SUBROUTINE ReadDvrIptFile( DvrFileName, DvrFlags, DvrSettings, ProgInfo, ErrStat DvrFlags%ZRange = .TRUE. ENDIF - ELSE ! read these lines as comments (actually, we don't need to read them) - DvrSettings%GridDelta = 0.0_ReKi DvrFlags%Dx = .FALSE. DvrFlags%Dy = .FALSE. @@ -1284,34 +1022,48 @@ SUBROUTINE ReadDvrIptFile( DvrFileName, DvrFlags, DvrSettings, ProgInfo, ErrStat DvrFlags%ZRange = .FALSE. ! Skip the next three entries of the gridded data section. - CALL ReadCom( UnIn, FileName,' Skipping the gridded data section since not calculating 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 - CALL ReadCom( UnIn, FileName,' Skipping the gridded data section since not calculating 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 - CALL ReadCom( UnIn, FileName,' Skipping the gridded data section since not calculating 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 + CALL ReadCom( UnIn, FileName,' Skipping the gridded data section since not calculating it.', ErrStatTmp, ErrMsgTmp, UnEchoLocal ); if (Failed()) return + CALL ReadCom( UnIn, FileName,' Skipping the gridded data section since not calculating it.', ErrStatTmp, ErrMsgTmp, UnEchoLocal ); if (Failed()) return + CALL ReadCom( UnIn, FileName,' Skipping the gridded data section since not calculating it.', ErrStatTmp, ErrMsgTmp, UnEchoLocal ); if (Failed()) return ENDIF + !------------------------------------------------------------------------------------------------- + ! VTK output slices + !------------------------------------------------------------------------------------------------- + CALL ReadCom( UnIn, FileName,' VTK output slices, comment line', ErrStatTmp, ErrMsgTmp, UnEchoLocal ); if (Failed()) return + + ! NOutWindXY -- Number of XY planes for output .XY.t.vtk (-) [0 to 9] + CALL ReadVar( UnIn, FileName,DvrSettings%NOutWindXY, 'NOutWindXY','Number of VTK slices in XY?', ErrStatTmp,ErrMsgTmp, UnEchoLocal ); if (Failed()) return + if (DvrSettings%NOutWindXY > 0_IntKi) then + CALL AllocAry( DvrSettings%OutWindZ, DvrSettings%NOutWindXY, "Z coordinates of XY planes for output", ErrStatTmp,ErrMsgTmp ); if (Failed()) return + CALL ReadAry( UnIn, FileName,DvrSettings%OutWindZ,DvrSettings%NOutWindXY,'OutWindZ','Z coordinates', ErrStatTmp,ErrMsgTmp, UnEchoLocal ); if (Failed()) return + else + CALL ReadCom( UnIn, FileName,' Skipping OutWindZ', ErrStatTmp,ErrMsgTmp,UnEchoLocal); if (Failed()) return + endif + +!FIXME: future development +! ! NOutWindXZ -- Number of XZ planes for output .XZ.t.vtk (-) [0 to 9] +! CALL ReadVar( UnIn, FileName,DvrSettings%NOutWindXZ, 'NOutWindXZ','Number of VTK slices in XZ?', ErrStatTmp,ErrMsgTmp, UnEchoLocal ); if (Failed()) return +! if (DvrSettings%NOutWindXZ > 0_IntKi) then +! CALL AllocAry( DvrSettings%OutWindY, DvrSettings%NOutWindXZ, "Y coordinates of XZ planes for output",ErrStatTmp,ErrMsgTmp ); if (Failed()) return +! CALL ReadAry( UnIn, FileName,DvrSettings%OutWindY,DvrSettings%NOutWindXZ,'OutWindY','Y coordinates' ,ErrStatTmp,ErrMsgTmp, UnEchoLocal ); if (Failed()) return +! else +! CALL ReadCom( UnIn, FileName,' Skipping OutWindY', ErrStatTmp,ErrMsgTmp,UnEchoLocal); if (Failed()) return +! endif +! +! ! NOutWindYZ -- Number of YZ planes for output .YZ.t.vtk (-) [0 to 9] +! CALL ReadVar( UnIn, FileName,DvrSettings%NOutWindYZ, 'NOutWindYZ','Number of VTK slices in YZ?', ErrStatTmp,ErrMsgTmp, UnEchoLocal ); if (Failed()) return +! if (DvrSettings%NOutWindYZ > 0_IntKi) then +! CALL AllocAry( DvrSettings%OutWindX, DvrSettings%NOutWindYZ, "X coordinates of YZ planes for output", ErrStatTmp,ErrMsgTmp ); if (Failed()) return +! CALL ReadAry( UnIn, FileName,DvrSettings%OutWindX,DvrSettings%NOutWindYZ,'OutWindX','X coordinates', ErrStatTmp,ErrMsgTmp, UnEchoLocal ); if (Failed()) return +! else +! CALL ReadCom( UnIn, FileName,' Skipping OutWindX', ErrStatTmp,ErrMsgTmp,UnEchoLocal); if (Failed()) return +! endif + ! Close the echo and input file - CALL CleanupEchoFile( EchoFileContents, UnEchoLocal ) - CLOSE( UnIn ) + CALL Cleanup() CONTAINS @@ -1319,17 +1071,19 @@ SUBROUTINE ReadDvrIptFile( DvrFileName, DvrFlags, DvrSettings, ProgInfo, ErrStat !---------------------------------------------------------------------------------------------------- !> 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) + subroutine Cleanup() + ! Close this module's echo file + IF ( EchoFileContents ) THEN + CLOSE(UnEchoLocal) ENDIF - END SUBROUTINE CleanupEchoFile - - + if (UnIn > 1) close(UnIn) + end subroutine Cleanup + !------------------------------------------------------------------------------------------------- + logical function Failed() + CALL SetErrStat( ErrStatTmp, ErrMsgTmp, ErrStat, ErrMsg, RoutineName ) + Failed = ErrStat >= AbortErrLev + if (Failed) CALL Cleanup() + end function Failed END SUBROUTINE ReadDvrIptFile @@ -2623,6 +2377,50 @@ subroutine IfW_WriteVTK(FF, FileRootName, ErrStat, ErrMsg) end subroutine IfW_WriteVTK +subroutine IfW_WriteXYslice(FF, FileRootName, vtk_dir, XYslice_height, ErrStat, ErrMsg) + type(FlowFieldType), intent(in ) :: FF !< Parameters + character(*), intent(in ) :: FileRootName !< RootName for output files + character(*), intent(in ) :: vtk_dir !< Directory for vtk slice outputs + real(ReKi), intent(in ) :: XYslice_height + integer(IntKi), intent( out) :: ErrStat !< Error status of the operation + character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + character(*), parameter :: RoutineName = "IfW_WriteXYslice" + type(Grid3DFieldType) :: G3D + integer(IntKi) :: unit + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + + ErrStat = ErrID_None + ErrMsg = "" + + ! Get new unit for writing file + call GetNewUnit(unit, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + + ! Switch based on field type + select case (FF%FieldType) + + case (Uniform_FieldType) + call Uniform_to_Grid3D(FF%Uniform, FF%VelInterpCubic, G3D, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat < AbortErrLev) then + call Grid3D_WriteVTKsliceXY(G3D, FileRootName, vtk_dir, XYslice_height, unit, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end if + + case (Grid3D_FieldType) + call Grid3D_WriteVTKsliceXY(FF%Grid3D, FileRootName, vtk_dir, XYslice_height, unit, ErrStat, ErrMsg) + + case default + ErrStat = ErrID_Warn + ErrMsg = RoutineName//': Field type '//TRIM(Num2LStr(FF%FieldType))// & + ' cannot be converted to VTK format.' + end select +end subroutine IfW_WriteXYslice + + !> 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 @@ -2671,6 +2469,25 @@ SUBROUTINE printSettings( DvrFlags, DvrSettings ) CALL WrScr(' FFTOutputInit: '//FLAG(DvrSettings%FFTOutput%Initialized)// ' Unit #: '//TRIM(Num2LStr(DvrSettings%FFTOutput%Unit))) CALL WrScr(' PointsVelOutputInit: '//FLAG(DvrSettings%PointsVelOutput%Initialized)// ' Unit #: '//TRIM(Num2LStr(DvrSettings%PointsVelOutput%Unit))) CALL WrScr(' PointsAccOutputInit: '//FLAG(DvrSettings%PointsVelOutput%Initialized)// ' Unit #: '//TRIM(Num2LStr(DvrSettings%PointsVelOutput%Unit))) + call WrScr(' NOutWindXY: '//trim(Num2LStr(DvrSettings%NOutWindXY))) + if (DvrSettings%NOutWindXY>0) then + do i=1,DvrSettings%NOutWindXY + call WrScr(' z location '//trim(Num2LStr(i))//': '//trim(Num2LStr(DvrSettings%OutWindZ(i)))) + enddo + endif + call WrScr(' NOutWindXZ: '//trim(Num2LStr(DvrSettings%NOutWindXZ))) + if (DvrSettings%NOutWindXZ>0) then + do i=1,DvrSettings%NOutWindXZ + call WrScr(' y location '//trim(Num2LStr(i))//': '//trim(Num2LStr(DvrSettings%OutWindY(i)))) + enddo + endif + call WrScr(' NOutWindYZ: '//trim(Num2LStr(DvrSettings%NOutWindYZ))) + if (DvrSettings%NOutWindYZ>0) then + do i=1,DvrSettings%NOutWindYZ + call WrScr(' x location '//trim(Num2LStr(i))//': '//trim(Num2LStr(DvrSettings%OutWindX(i)))) + enddo + endif + END SUBROUTINE printSettings diff --git a/modules/inflowwind/src/InflowWind_Driver_Types.f90 b/modules/inflowwind/src/InflowWind_Driver_Types.f90 index 669303cf60..6768f63819 100644 --- a/modules/inflowwind/src/InflowWind_Driver_Types.f90 +++ b/modules/inflowwind/src/InflowWind_Driver_Types.f90 @@ -1,111 +1,433 @@ -!********************************************************************************************************************************** +!STARTOFREGISTRYGENERATEDFILE 'InflowWind_Driver_Types.f90' ! -! MODULE: IfW_Driver_Types - This module contains types used by the InflowWind Driver program to store arguments passed in +! WARNING This file is generated automatically by the FAST registry. +! Do not edit. Your changes to this file will be lost. ! -! The types listed here are used within the InflowWind Driver program to store the settings. These settings are read in as -! command line arguments, then stored within these types. +! FAST Registry +!********************************************************************************************************************************* +! InflowWind_Driver_Types +!................................................................................................................................. +! This file is part of InflowWind_Driver. ! -!********************************************************************************************************************************** +! Copyright (C) 2012-2016 National Renewable Energy Laboratory ! -!.................................................................................................................................. -! LICENSING -! Copyright (C) 2015 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 ! -! This file is part of InflowWind. +! http://www.apache.org/licenses/LICENSE-2.0 ! -! InflowWind 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. +! 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 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 InflowWind. -! If not, see . +! 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 InflowWind_Driver. 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 InflowWind_Driver_Types +!--------------------------------------------------------------------------------------------------------------------------------- +USE NWTC_Library +IMPLICIT NONE +! ========= OutputFile ======= + TYPE, PUBLIC :: OutputFile + character(1024) :: Name !< Filename for output from points read in from points file [-] + INTEGER(IntKi) :: Unit = -1 !< Unit number for the output file for the Points file output [-] + LOGICAL :: Initialized = .false. !< Flag indicating that file has been initialized [-] + END TYPE OutputFile +! ======================= +! ========= IfWDriver_Flags ======= + TYPE, PUBLIC :: IfWDriver_Flags + LOGICAL :: DvrIptFile = .false. !< Was an input file name given on the command line? [-] + LOGICAL :: IfWIptFile = .false. !< Was an InflowWind input file requested? [-] + LOGICAL :: Summary = .false. !< create a summary at command line? (data extents in the wind file) [-] + LOGICAL :: SummaryFile = .false. !< create a summary file of the output? [-] + LOGICAL :: TStart = .false. !< specified a start time [-] + LOGICAL :: NumTimeSteps = .false. !< specified a number of timesteps to process [-] + LOGICAL :: NumTimeStepsDefault = .false. !< specified a 'DEFAULT' for number of timesteps to process [-] + LOGICAL :: DT = .false. !< specified a resolution in time [-] + LOGICAL :: DTDefault = .false. !< specified a 'DEFAULT' for the time resolution [-] + LOGICAL :: FFTcalc = .false. !< do an FFT [-] + LOGICAL :: WindGrid = .false. !< Requested output of wind data on a grid -- input file option only [-] + LOGICAL :: XRange = .false. !< specified a range of x -- command line option only -- stored as GridCtrCoord and GridDelta [-] + LOGICAL :: YRange = .false. !< specified a range of y -- command line option only -- stored as GridCtrCoord and GridDelta [-] + LOGICAL :: ZRange = .false. !< specified a range of z -- command line option only -- stored as GridCtrCoord and GridDelta [-] + LOGICAL :: Dx = .false. !< specified a resolution in x -- command line option only, 0.0 otherwise [-] + LOGICAL :: Dy = .false. !< speficied a resolution in y [-] + LOGICAL :: Dz = .false. !< specified a resolution in z [-] + LOGICAL :: PointsFile = .false. !< points filename to read in [-] + LOGICAL :: OutputAccel = .false. !< flag to calculate and output wind acceleration in addition to velocity [-] + LOGICAL :: Verbose = .false. !< Verbose error reporting [-] + LOGICAL :: VVerbose = .false. !< Very Verbose error reporting [-] + LOGICAL :: BoxExceedAllowF = .false. !< set flag to allow exceeding wind box boundaries for FF files (for diagnostic purposes) [-] + LOGICAL :: WrHAWC = .false. !< Requested file conversion to HAWC2 format? [-] + LOGICAL :: WrBladed = .false. !< Requested file conversion to Bladed format? [-] + LOGICAL :: WrVTK = .false. !< Requested file output as VTK? [-] + LOGICAL :: WrUniform = .false. !< Requested file output as Uniform wind format? [-] + LOGICAL :: XYslice = .false. !< Take XY slice at one elevation [-] + END TYPE IfWDriver_Flags +! ======================= +! ========= IfWDriver_Settings ======= + TYPE, PUBLIC :: IfWDriver_Settings + character(1024) :: DvrIptFileName !< Driver input file name [-] + character(1024) :: IfWIptFileName !< Filename of InflowWind input file to read (if no driver input file) [-] + character(1024) :: SummaryFileName !< Filename for the summary information output [-] + character(1024) :: PointsFileName !< Filename of points file to read in [-] + INTEGER(IntKi) :: NumTimeSteps = 0 !< Number of timesteps [-] + REAL(DbKi) :: DT = 0.0_DbKi !< resolution of time [s] + REAL(DbKi) :: TStart = 0.0_DbKi !< range of time -- end time converted from TRange (command line option only) [s] + REAL(ReKi) :: FFTcoord(1:3) = 0.0_ReKi !< (x,y,z) coordinate to do an FFT at [(m)] + REAL(ReKi) :: GridDelta(1:3) = 0.0_ReKi !< (GridDx,GridDy,GridDz) -- grid point spacing [(m)] + INTEGER(IntKi) :: GridN(1:3) = 1_IntKi !< (GridNx,GridNy,GridNz) -- number of grid points [-] + REAL(ReKi) :: XRange(1:2) = 0.0_ReKi !< Range in the x-direction for the gridded data [(m)] + REAL(ReKi) :: YRange(1:2) = 0.0_ReKi !< Range in the y-direction for the gridded data [(m)] + REAL(ReKi) :: ZRange(1:2) = 0.0_ReKi !< Range in the z-direction for the gridded data [(m)] + TYPE(ProgDesc) :: ProgInfo !< Program info [-] + TYPE(OutputFile) :: WindGridOutput !< Wind grid file handling [-] + TYPE(OutputFile) :: FFTOutput !< FFT file handling [-] + TYPE(OutputFile) :: PointsVelOutput !< Points output velocity file handling [-] + INTEGER(IntKi) :: NOutWindXY = 0 !< Number of XY planes for output .XY.t.vtk [0 to 9] [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: OutWindZ !< Z coordinates of XY planes for output [1 to NOutWindXY] [unused for NOutWindXY=0] [(m)] + INTEGER(IntKi) :: NOutWindXZ = 0 !< Number of YZ planes for output .YZ.t.vtk [0 to 9] [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: OutWindY !< Y coordinates of YZ planes for output [1 to NOutWindYZ] [unused for NOutWindYZ=0] [(m)] + INTEGER(IntKi) :: NOutWindYZ = 0 !< Number of YZ planes for output .YZ.t.vtk [0 to 9] [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: OutWindX !< X coordinates of YZ planes for output [1 to NOutWindYZ] [unused for NOutWindYZ=0] [(m)] + END TYPE IfWDriver_Settings +! ======================= +CONTAINS - USE NWTC_Library - USE InflowWind_Types - - IMPLICIT NONE - - TYPE OutputFile - LOGICAL :: Initialized = .FALSE. !< Flag indicating that file has been initialized - CHARACTER(1024) :: Name = "" !< Filename for output from points read in from points file - INTEGER(IntKi) :: Unit = -1 !< Unit number for the output file for the Points file output - END TYPE - - !> 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 InflowWind input file. - TYPE :: IfWDriver_Flags - LOGICAL :: DvrIptFile = .FALSE. !< Was an input file name given on the command line? - LOGICAL :: IfWIptFile = .FALSE. !< Was an InflowWind input file requested? - LOGICAL :: Summary = .FALSE. !< create a summary at command line? (data extents in the wind file) - LOGICAL :: SummaryFile = .FALSE. !< create a summary file of the output? - LOGICAL :: TStart = .FALSE. !< specified a start time - LOGICAL :: NumTimeSteps = .FALSE. !< specified a number of timesteps to process - LOGICAL :: NumTimeStepsDefault = .FALSE. !< specified a 'DEFAULT' for number of timesteps to process - LOGICAL :: DT = .FALSE. !< specified a resolution in time - LOGICAL :: DTDefault = .FALSE. !< specified a 'DEFAULT' for the time resolution - - LOGICAL :: FFTcalc = .FALSE. !< do an FFT - - LOGICAL :: WindGrid = .FALSE. !< Requested output of wind data on a grid -- input file option only - LOGICAL :: XRange = .FALSE. !< specified a range of x -- command line option only -- stored as GridCtrCoord and GridDelta - LOGICAL :: YRange = .FALSE. !< specified a range of y -- command line option only -- stored as GridCtrCoord and GridDelta - LOGICAL :: ZRange = .FALSE. !< specified a range of z -- command line option only -- stored as GridCtrCoord and GridDelta - LOGICAL :: Dx = .FALSE. !< specified a resolution in x -- command line option only, 0.0 otherwise - LOGICAL :: Dy = .FALSE. !< speficied a resolution in y - LOGICAL :: Dz = .FALSE. !< specified a resolution in z - - LOGICAL :: PointsFile = .FALSE. !< points filename to read in - LOGICAL :: OutputAccel = .FALSE. !< flag to calculate and output wind acceleration in addition to velocity - - LOGICAL :: Verbose = .FALSE. !< Verbose error reporting - LOGICAL :: VVerbose = .FALSE. !< Very Verbose error reporting - LOGICAL :: BoxExceedAllowF = .FALSE. !< set flag to allow exceeding wind box boundaries for FF files (for diagnostic purposes) +subroutine InflowWind_Driver_CopyOutputFile(SrcOutputFileData, DstOutputFileData, CtrlCode, ErrStat, ErrMsg) + type(OutputFile), intent(in) :: SrcOutputFileData + type(OutputFile), intent(inout) :: DstOutputFileData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'InflowWind_Driver_CopyOutputFile' + ErrStat = ErrID_None + ErrMsg = '' + DstOutputFileData%Name = SrcOutputFileData%Name + DstOutputFileData%Unit = SrcOutputFileData%Unit + DstOutputFileData%Initialized = SrcOutputFileData%Initialized +end subroutine - LOGICAL :: WrHAWC = .FALSE. !< Requested file conversion to HAWC2 format? - LOGICAL :: WrBladed = .FALSE. !< Requested file conversion to Bladed format? - LOGICAL :: WrVTK = .FALSE. !< Requested file output as VTK? - LOGICAL :: WrUniform = .FALSE. !< Requested file output as Uniform wind format? - END TYPE IfWDriver_Flags +subroutine InflowWind_Driver_DestroyOutputFile(OutputFileData, ErrStat, ErrMsg) + type(OutputFile), intent(inout) :: OutputFileData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'InflowWind_Driver_DestroyOutputFile' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine +subroutine InflowWind_Driver_PackOutputFile(RF, Indata) + type(RegFile), intent(inout) :: RF + type(OutputFile), intent(in) :: InData + character(*), parameter :: RoutineName = 'InflowWind_Driver_PackOutputFile' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%Name) + call RegPack(RF, InData%Unit) + call RegPack(RF, InData%Initialized) + if (RegCheckErr(RF, RoutineName)) return +end subroutine - ! This contains all the settings (possible passed in arguments). - TYPE :: IfWDriver_Settings - CHARACTER(1024) :: DvrIptFileName = "" !< Driver input file name - CHARACTER(1024) :: IfWIptFileName = "" !< Filename of InflowWind input file to read (if no driver input file) - CHARACTER(1024) :: SummaryFileName = "" !< Filename for the summary information output +subroutine InflowWind_Driver_UnPackOutputFile(RF, OutData) + type(RegFile), intent(inout) :: RF + type(OutputFile), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'InflowWind_Driver_UnPackOutputFile' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%Name); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Unit); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Initialized); if (RegCheckErr(RF, RoutineName)) return +end subroutine - CHARACTER(1024) :: PointsFileName = "" !< Filename of points file to read in - - INTEGER(IntKi) :: NumTimeSteps = 0 !< Number of timesteps - REAL(DbKi) :: DT = 0.0_DbKi !< resolution of time - REAL(DbKi) :: TStart = 0.0_DbKi !< range of time -- end time converted from TRange (command line option only) +subroutine InflowWind_Driver_CopyIfWDriver_Flags(SrcIfWDriver_FlagsData, DstIfWDriver_FlagsData, CtrlCode, ErrStat, ErrMsg) + type(IfWDriver_Flags), intent(in) :: SrcIfWDriver_FlagsData + type(IfWDriver_Flags), intent(inout) :: DstIfWDriver_FlagsData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'InflowWind_Driver_CopyIfWDriver_Flags' + ErrStat = ErrID_None + ErrMsg = '' + DstIfWDriver_FlagsData%DvrIptFile = SrcIfWDriver_FlagsData%DvrIptFile + DstIfWDriver_FlagsData%IfWIptFile = SrcIfWDriver_FlagsData%IfWIptFile + DstIfWDriver_FlagsData%Summary = SrcIfWDriver_FlagsData%Summary + DstIfWDriver_FlagsData%SummaryFile = SrcIfWDriver_FlagsData%SummaryFile + DstIfWDriver_FlagsData%TStart = SrcIfWDriver_FlagsData%TStart + DstIfWDriver_FlagsData%NumTimeSteps = SrcIfWDriver_FlagsData%NumTimeSteps + DstIfWDriver_FlagsData%NumTimeStepsDefault = SrcIfWDriver_FlagsData%NumTimeStepsDefault + DstIfWDriver_FlagsData%DT = SrcIfWDriver_FlagsData%DT + DstIfWDriver_FlagsData%DTDefault = SrcIfWDriver_FlagsData%DTDefault + DstIfWDriver_FlagsData%FFTcalc = SrcIfWDriver_FlagsData%FFTcalc + DstIfWDriver_FlagsData%WindGrid = SrcIfWDriver_FlagsData%WindGrid + DstIfWDriver_FlagsData%XRange = SrcIfWDriver_FlagsData%XRange + DstIfWDriver_FlagsData%YRange = SrcIfWDriver_FlagsData%YRange + DstIfWDriver_FlagsData%ZRange = SrcIfWDriver_FlagsData%ZRange + DstIfWDriver_FlagsData%Dx = SrcIfWDriver_FlagsData%Dx + DstIfWDriver_FlagsData%Dy = SrcIfWDriver_FlagsData%Dy + DstIfWDriver_FlagsData%Dz = SrcIfWDriver_FlagsData%Dz + DstIfWDriver_FlagsData%PointsFile = SrcIfWDriver_FlagsData%PointsFile + DstIfWDriver_FlagsData%OutputAccel = SrcIfWDriver_FlagsData%OutputAccel + DstIfWDriver_FlagsData%Verbose = SrcIfWDriver_FlagsData%Verbose + DstIfWDriver_FlagsData%VVerbose = SrcIfWDriver_FlagsData%VVerbose + DstIfWDriver_FlagsData%BoxExceedAllowF = SrcIfWDriver_FlagsData%BoxExceedAllowF + DstIfWDriver_FlagsData%WrHAWC = SrcIfWDriver_FlagsData%WrHAWC + DstIfWDriver_FlagsData%WrBladed = SrcIfWDriver_FlagsData%WrBladed + DstIfWDriver_FlagsData%WrVTK = SrcIfWDriver_FlagsData%WrVTK + DstIfWDriver_FlagsData%WrUniform = SrcIfWDriver_FlagsData%WrUniform + DstIfWDriver_FlagsData%XYslice = SrcIfWDriver_FlagsData%XYslice +end subroutine - REAL(ReKi) :: FFTcoord(1:3) = 0.0_ReKi !< (x,y,z) coordinate to do an FFT at +subroutine InflowWind_Driver_DestroyIfWDriver_Flags(IfWDriver_FlagsData, ErrStat, ErrMsg) + type(IfWDriver_Flags), intent(inout) :: IfWDriver_FlagsData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'InflowWind_Driver_DestroyIfWDriver_Flags' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine - REAL(ReKi) :: GridDelta(1:3) = 0.0_ReKi !< (GridDx,GridDy,GridDz) -- grid point spacing - INTEGER(IntKi) :: GridN(1:3) = 1_IntKi !< (GridNx,GridNy,GridNz) -- number of grid points +subroutine InflowWind_Driver_PackIfWDriver_Flags(RF, Indata) + type(RegFile), intent(inout) :: RF + type(IfWDriver_Flags), intent(in) :: InData + character(*), parameter :: RoutineName = 'InflowWind_Driver_PackIfWDriver_Flags' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DvrIptFile) + call RegPack(RF, InData%IfWIptFile) + call RegPack(RF, InData%Summary) + call RegPack(RF, InData%SummaryFile) + call RegPack(RF, InData%TStart) + call RegPack(RF, InData%NumTimeSteps) + call RegPack(RF, InData%NumTimeStepsDefault) + call RegPack(RF, InData%DT) + call RegPack(RF, InData%DTDefault) + call RegPack(RF, InData%FFTcalc) + call RegPack(RF, InData%WindGrid) + call RegPack(RF, InData%XRange) + call RegPack(RF, InData%YRange) + call RegPack(RF, InData%ZRange) + call RegPack(RF, InData%Dx) + call RegPack(RF, InData%Dy) + call RegPack(RF, InData%Dz) + call RegPack(RF, InData%PointsFile) + call RegPack(RF, InData%OutputAccel) + call RegPack(RF, InData%Verbose) + call RegPack(RF, InData%VVerbose) + call RegPack(RF, InData%BoxExceedAllowF) + call RegPack(RF, InData%WrHAWC) + call RegPack(RF, InData%WrBladed) + call RegPack(RF, InData%WrVTK) + call RegPack(RF, InData%WrUniform) + call RegPack(RF, InData%XYslice) + if (RegCheckErr(RF, RoutineName)) return +end subroutine - REAL(ReKi) :: XRange(1:2) = 0.0_ReKi !< Range in the x-direction for the gridded data - REAL(ReKi) :: YRange(1:2) = 0.0_ReKi !< Range in the y-direction for the gridded data - REAL(ReKi) :: ZRange(1:2) = 0.0_ReKi !< Range in the z-direction for the gridded data +subroutine InflowWind_Driver_UnPackIfWDriver_Flags(RF, OutData) + type(RegFile), intent(inout) :: RF + type(IfWDriver_Flags), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'InflowWind_Driver_UnPackIfWDriver_Flags' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DvrIptFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%IfWIptFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Summary); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SummaryFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TStart); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumTimeSteps); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumTimeStepsDefault); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DTDefault); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FFTcalc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WindGrid); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%XRange); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YRange); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ZRange); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Dx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Dy); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Dz); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PointsFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutputAccel); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Verbose); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VVerbose); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BoxExceedAllowF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WrHAWC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WrBladed); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WrVTK); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WrUniform); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%XYslice); if (RegCheckErr(RF, RoutineName)) return +end subroutine - TYPE(ProgDesc) :: ProgInfo !< Program info - TYPE(OutputFile) :: WindGridOutput - TYPE(OutputFile) :: FFTOutput - TYPE(OutputFile) :: PointsVelOutput +subroutine InflowWind_Driver_CopyIfWDriver_Settings(SrcIfWDriver_SettingsData, DstIfWDriver_SettingsData, CtrlCode, ErrStat, ErrMsg) + type(IfWDriver_Settings), intent(in) :: SrcIfWDriver_SettingsData + type(IfWDriver_Settings), intent(inout) :: DstIfWDriver_SettingsData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'InflowWind_Driver_CopyIfWDriver_Settings' + ErrStat = ErrID_None + ErrMsg = '' + DstIfWDriver_SettingsData%DvrIptFileName = SrcIfWDriver_SettingsData%DvrIptFileName + DstIfWDriver_SettingsData%IfWIptFileName = SrcIfWDriver_SettingsData%IfWIptFileName + DstIfWDriver_SettingsData%SummaryFileName = SrcIfWDriver_SettingsData%SummaryFileName + DstIfWDriver_SettingsData%PointsFileName = SrcIfWDriver_SettingsData%PointsFileName + DstIfWDriver_SettingsData%NumTimeSteps = SrcIfWDriver_SettingsData%NumTimeSteps + DstIfWDriver_SettingsData%DT = SrcIfWDriver_SettingsData%DT + DstIfWDriver_SettingsData%TStart = SrcIfWDriver_SettingsData%TStart + DstIfWDriver_SettingsData%FFTcoord(1:3) = SrcIfWDriver_SettingsData%FFTcoord(1:3) + DstIfWDriver_SettingsData%GridDelta(1:3) = SrcIfWDriver_SettingsData%GridDelta(1:3) + DstIfWDriver_SettingsData%GridN(1:3) = SrcIfWDriver_SettingsData%GridN(1:3) + DstIfWDriver_SettingsData%XRange(1:2) = SrcIfWDriver_SettingsData%XRange(1:2) + DstIfWDriver_SettingsData%YRange(1:2) = SrcIfWDriver_SettingsData%YRange(1:2) + DstIfWDriver_SettingsData%ZRange(1:2) = SrcIfWDriver_SettingsData%ZRange(1:2) + call NWTC_Library_CopyProgDesc(SrcIfWDriver_SettingsData%ProgInfo, DstIfWDriver_SettingsData%ProgInfo, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call InflowWind_Driver_CopyOutputFile(SrcIfWDriver_SettingsData%WindGridOutput, DstIfWDriver_SettingsData%WindGridOutput, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call InflowWind_Driver_CopyOutputFile(SrcIfWDriver_SettingsData%FFTOutput, DstIfWDriver_SettingsData%FFTOutput, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call InflowWind_Driver_CopyOutputFile(SrcIfWDriver_SettingsData%PointsVelOutput, DstIfWDriver_SettingsData%PointsVelOutput, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstIfWDriver_SettingsData%NOutWindXY = SrcIfWDriver_SettingsData%NOutWindXY + if (allocated(SrcIfWDriver_SettingsData%OutWindZ)) then + LB(1:1) = lbound(SrcIfWDriver_SettingsData%OutWindZ) + UB(1:1) = ubound(SrcIfWDriver_SettingsData%OutWindZ) + if (.not. allocated(DstIfWDriver_SettingsData%OutWindZ)) then + allocate(DstIfWDriver_SettingsData%OutWindZ(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstIfWDriver_SettingsData%OutWindZ.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstIfWDriver_SettingsData%OutWindZ = SrcIfWDriver_SettingsData%OutWindZ + end if + DstIfWDriver_SettingsData%NOutWindXZ = SrcIfWDriver_SettingsData%NOutWindXZ + if (allocated(SrcIfWDriver_SettingsData%OutWindY)) then + LB(1:1) = lbound(SrcIfWDriver_SettingsData%OutWindY) + UB(1:1) = ubound(SrcIfWDriver_SettingsData%OutWindY) + if (.not. allocated(DstIfWDriver_SettingsData%OutWindY)) then + allocate(DstIfWDriver_SettingsData%OutWindY(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstIfWDriver_SettingsData%OutWindY.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstIfWDriver_SettingsData%OutWindY = SrcIfWDriver_SettingsData%OutWindY + end if + DstIfWDriver_SettingsData%NOutWindYZ = SrcIfWDriver_SettingsData%NOutWindYZ + if (allocated(SrcIfWDriver_SettingsData%OutWindX)) then + LB(1:1) = lbound(SrcIfWDriver_SettingsData%OutWindX) + UB(1:1) = ubound(SrcIfWDriver_SettingsData%OutWindX) + if (.not. allocated(DstIfWDriver_SettingsData%OutWindX)) then + allocate(DstIfWDriver_SettingsData%OutWindX(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstIfWDriver_SettingsData%OutWindX.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstIfWDriver_SettingsData%OutWindX = SrcIfWDriver_SettingsData%OutWindX + end if +end subroutine - END TYPE IfWDriver_Settings +subroutine InflowWind_Driver_DestroyIfWDriver_Settings(IfWDriver_SettingsData, ErrStat, ErrMsg) + type(IfWDriver_Settings), intent(inout) :: IfWDriver_SettingsData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'InflowWind_Driver_DestroyIfWDriver_Settings' + ErrStat = ErrID_None + ErrMsg = '' + call NWTC_Library_DestroyProgDesc(IfWDriver_SettingsData%ProgInfo, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call InflowWind_Driver_DestroyOutputFile(IfWDriver_SettingsData%WindGridOutput, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call InflowWind_Driver_DestroyOutputFile(IfWDriver_SettingsData%FFTOutput, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call InflowWind_Driver_DestroyOutputFile(IfWDriver_SettingsData%PointsVelOutput, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(IfWDriver_SettingsData%OutWindZ)) then + deallocate(IfWDriver_SettingsData%OutWindZ) + end if + if (allocated(IfWDriver_SettingsData%OutWindY)) then + deallocate(IfWDriver_SettingsData%OutWindY) + end if + if (allocated(IfWDriver_SettingsData%OutWindX)) then + deallocate(IfWDriver_SettingsData%OutWindX) + end if +end subroutine +subroutine InflowWind_Driver_PackIfWDriver_Settings(RF, Indata) + type(RegFile), intent(inout) :: RF + type(IfWDriver_Settings), intent(in) :: InData + character(*), parameter :: RoutineName = 'InflowWind_Driver_PackIfWDriver_Settings' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DvrIptFileName) + call RegPack(RF, InData%IfWIptFileName) + call RegPack(RF, InData%SummaryFileName) + call RegPack(RF, InData%PointsFileName) + call RegPack(RF, InData%NumTimeSteps) + call RegPack(RF, InData%DT) + call RegPack(RF, InData%TStart) + call RegPack(RF, InData%FFTcoord(1:3)) + call RegPack(RF, InData%GridDelta(1:3)) + call RegPack(RF, InData%GridN(1:3)) + call RegPack(RF, InData%XRange(1:2)) + call RegPack(RF, InData%YRange(1:2)) + call RegPack(RF, InData%ZRange(1:2)) + call NWTC_Library_PackProgDesc(RF, InData%ProgInfo) + call InflowWind_Driver_PackOutputFile(RF, InData%WindGridOutput) + call InflowWind_Driver_PackOutputFile(RF, InData%FFTOutput) + call InflowWind_Driver_PackOutputFile(RF, InData%PointsVelOutput) + call RegPack(RF, InData%NOutWindXY) + call RegPackAlloc(RF, InData%OutWindZ) + call RegPack(RF, InData%NOutWindXZ) + call RegPackAlloc(RF, InData%OutWindY) + call RegPack(RF, InData%NOutWindYZ) + call RegPackAlloc(RF, InData%OutWindX) + if (RegCheckErr(RF, RoutineName)) return +end subroutine +subroutine InflowWind_Driver_UnPackIfWDriver_Settings(RF, OutData) + type(RegFile), intent(inout) :: RF + type(IfWDriver_Settings), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'InflowWind_Driver_UnPackIfWDriver_Settings' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DvrIptFileName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%IfWIptFileName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SummaryFileName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PointsFileName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumTimeSteps); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TStart); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FFTcoord(1:3)); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GridDelta(1:3)); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GridN(1:3)); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%XRange(1:2)); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YRange(1:2)); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ZRange(1:2)); if (RegCheckErr(RF, RoutineName)) return + call NWTC_Library_UnpackProgDesc(RF, OutData%ProgInfo) ! ProgInfo + call InflowWind_Driver_UnpackOutputFile(RF, OutData%WindGridOutput) ! WindGridOutput + call InflowWind_Driver_UnpackOutputFile(RF, OutData%FFTOutput) ! FFTOutput + call InflowWind_Driver_UnpackOutputFile(RF, OutData%PointsVelOutput) ! PointsVelOutput + call RegUnpack(RF, OutData%NOutWindXY); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%OutWindZ); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NOutWindXZ); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%OutWindY); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NOutWindYZ); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%OutWindX); if (RegCheckErr(RF, RoutineName)) return +end subroutine END MODULE InflowWind_Driver_Types +!ENDOFREGISTRYGENERATEDFILE diff --git a/modules/inflowwind/src/InflowWind_IO.f90 b/modules/inflowwind/src/InflowWind_IO.f90 index b74a2e5143..afd7281002 100644 --- a/modules/inflowwind/src/InflowWind_IO.f90 +++ b/modules/inflowwind/src/InflowWind_IO.f90 @@ -39,7 +39,8 @@ module InflowWind_IO public :: Uniform_WriteHH, & Grid3D_WriteBladed, & Grid3D_WriteHAWC, & - Grid3D_WriteVTK + Grid3D_WriteVTK, & + Grid3D_WriteVTKsliceXY type(ProgDesc), parameter :: InflowWind_IO_Ver = ProgDesc('InflowWind_IO', '', '') @@ -181,12 +182,8 @@ subroutine IfW_UniformWind_Init(InitInp, SumFileUnit, UF, FileDat, ErrStat, ErrM UF%RefHeight = InitInp%RefHt UF%RefLength = InitInp%RefLength - ! Read wind data from file or init input data - if (InitInp%UseInputFile) then - call ProcessComFile(InitInp%WindFileName, WindFileInfo, TmpErrStat, TmpErrMsg) - else - call NWTC_Library_CopyFileInfoType(InitInp%PassedFileData, WindFileInfo, MESH_NEWCOPY, TmpErrStat, TmpErrMsg) - end if + ! Read wind data from file + call ProcessComFile(InitInp%WindFileName, WindFileInfo, TmpErrStat, TmpErrMsg) call SetErrStat(TmpErrStat, TmpErrMsg, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return @@ -256,6 +253,7 @@ subroutine IfW_UniformWind_Init(InitInp, SumFileUnit, UF, FileDat, ErrStat, ErrM call SetErrStat(ErrID_Fatal, TmpErrMsg, ErrStat, ErrMsg, RoutineName) end if end do + if (ErrStat >= AbortErrLev) return !---------------------------------------------------------------------------- ! Find out information on the timesteps and range @@ -277,6 +275,24 @@ subroutine IfW_UniformWind_Init(InitInp, SumFileUnit, UF, FileDat, ErrStat, ErrM WindFileDT = 0.0_ReKi end if + !---------------------------------------------------------------------------- + ! Check that time is always increasing + !---------------------------------------------------------------------------- + + ! Check that last timestep is always increasing + if (UF%DataSize > 2) then + do I = 2, UF%DataSize + if (UF%Time(I)<=UF%Time(I-1)) then + TmpErrMsg = ' Time vector must always increase in the uniform wind file. Error around wind step ' & + //TRIM(Num2LStr(I))//' at time '//TRIM(Num2LStr(UF%Time(I)))//' in wind file ' & + //TRIM(InitInp%WindFileName)//'.' + call SetErrStat(ErrID_Fatal, TmpErrMsg, ErrStat, ErrMsg, RoutineName) + exit + endif + end do + if (ErrStat >= AbortErrLev) return + endif + !---------------------------------------------------------------------------- ! Store wind file metadata !---------------------------------------------------------------------------- @@ -748,7 +764,7 @@ subroutine IfW_TurbSim_Init(InitInp, SumFileUnit, G3D, FileDat, ErrStat, ErrMsg) TRIM(Num2LStr(G3D%RefHeight - G3D%ZHWid))//' : '//TRIM(Num2LStr(G3D%RefHeight + G3D%ZHWid))//' ]' end if - if (G3D%BoxExceedAllowF) then + if (G3D%BoxExceedAllow) then write (SumFileUnit, '(A)') ' Wind grid exceedence allowed: '// & 'True -- Only for points requested by OLAF free vortex wake, or LidarSim module' write (SumFileUnit, '(A)') ' '// & @@ -972,7 +988,7 @@ subroutine IfW_HAWC_Init(InitInp, SumFileUnit, G3D, FileDat, ErrStat, ErrMsg) write (SumFileUnit, '(A)') ' Z range (m): [ '// & TRIM(Num2LStr(G3D%GridBase))//' : '//TRIM(Num2LStr(G3D%GridBase + G3D%ZHWid*2.0))//' ]' - if (G3D%BoxExceedAllowF) then + if (G3D%BoxExceedAllow) then write (SumFileUnit, '(A)') ' Wind grid exceedence allowed: '// & 'True -- Only for points requested by OLAF free vortex wake, or LidarSim module' write (SumFileUnit, '(A)') ' '// & @@ -1025,8 +1041,6 @@ subroutine IfW_Grid4D_Init(InitInp, G4D, ErrStat, ErrMsg) character(*), intent(out) :: ErrMsg character(*), parameter :: RoutineName = "IfW_Grid4D_Init" - integer(IntKi) :: TmpErrStat - character(ErrMsgLen) :: TmpErrMsg ErrStat = ErrID_None ErrMsg = "" @@ -1037,15 +1051,7 @@ subroutine IfW_Grid4D_Init(InitInp, G4D, ErrStat, ErrMsg) G4D%pZero = InitInp%pZero G4D%TimeStart = 0.0_ReKi G4D%RefHeight = InitInp%pZero(3) + (InitInp%n(3)/2) * InitInp%delta(3) - - ! uvw velocity components at x,y,z,t coordinates - call AllocAry(G4D%Vel, 3, G4D%n(1), G4D%n(2), G4D%n(3), G4D%n(4), & - 'External Grid Velocity', TmpErrStat, TmpErrMsg) - call SetErrStat(ErrStat, ErrMsg, TmpErrStat, TmpErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - - ! Initialize velocities to zero - G4D%Vel = 0.0_SiKi + G4D%Vel => InitInp%Vel end subroutine @@ -1403,7 +1409,7 @@ subroutine IfW_Bladed_Init(InitInp, SumFileUnit, InitOut, G3D, FileDat, ErrStat, TRIM(Num2LStr(G3D%RefHeight - G3D%ZHWid))//' : '//TRIM(Num2LStr(G3D%RefHeight + G3D%ZHWid))//' ]' end if - if (G3D%BoxExceedAllowF) then + if (G3D%BoxExceedAllow) then write (SumFileUnit, '(A)') ' Wind grid exceedence allowed: '// & 'True -- Only for points requested by OLAF free vortex wake, or LidarSim module' write (SumFileUnit, '(A)') ' '// & @@ -2409,7 +2415,7 @@ subroutine Grid3D_PopulateWindFileDat(Grid3DField, FileName, WindType, HasTower, if (HasTower) then FileDat%ZRange = [0.0_Reki, Grid3DField%RefHeight + Grid3DField%ZHWid] else - FileDat%ZRange = [Grid3DField%GridBase, Grid3DField%GridBase + Grid3DField%ZHWid*2.0] + FileDat%ZRange = [Grid3DField%GridBase, Grid3DField%GridBase + Grid3DField%ZHWid*2.0_ReKi] end if FileDat%ZRange_Limited = .true. @@ -2938,4 +2944,87 @@ subroutine Grid3D_WriteHAWC(G3D, FileRootName, unit, ErrStat, ErrMsg) end subroutine Grid3D_WriteHAWC + +!> This subroutine writes a VTK slice in the XY plane at a designated height (rounds to nearest point) +!! This feature is mostly useful for testing when a grid is needed for comparison elsewhere +subroutine Grid3D_WriteVTKsliceXY(G3D, FileRootName, vtk_dir, XYslice_height, unit, ErrStat, ErrMsg) + type(Grid3DFieldType), intent(in ) :: G3D !< Parameters + character(*), intent(in ) :: FileRootName !< RootName for output files + character(*), intent(in ) :: vtk_dir !< directory for vtk file for output files + real(ReKi), intent(in ) :: XYslice_height + integer(IntKi), intent(in ) :: unit !< Error status of the operation + integer(IntKi), intent( out) :: ErrStat !< Error status of the operation + character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + character(*), parameter :: RoutineName = 'Grid3D_WriteVTKsliceXY' + character(1024) :: RootPathName + character(1024) :: FileName + character(3) :: ht_str + character(8) :: t_str, t_fmt + integer :: it, ix, iy, iz, twidth + real(ReKi) :: time !< time for this slice + real(ReKi) :: ht !< nearest grid slice elevation + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + + ErrStat = ErrID_None + ErrMsg = "" + + call GetPath(FileRootName, RootPathName) + RootPathName = trim(RootPathName)//PathSep//vtk_dir + call MkDir(trim(RootPathName)) ! make this directory if it doesn't already exist + + ! get indices for this slice + iz = nint((G3D%GridBase + XYslice_height)*G3D%InvDZ) + ht = real(iz,ReKi) / G3D%InvDZ + G3D%GridBase ! nearest height index + write(ht_str,'(i0.3)') nint(ht) + + ! get width of string for time + twidth=ceiling(log10(real(G3D%NSteps))) + t_fmt='(i0.'//trim(Num2LStr(twidth))//')' + + ! check for errors in slice height + if (iz <= 0_IntKi .or. iz > G3D%NZGrids) then + call SetErrStat(ErrID_Warn,"No grid points near XY slice height of "//trim(num2lstr(XYslice_height))//". Skipping writing slice file.",ErrStat,ErrMsg,RoutineName) + return + endif + + ! Loop through time steps + do it = 1, G3D%NSteps + time = real(it - 1, ReKi)*G3D%DTime + + ! time string + write(t_str,t_fmt) it + + ! Create the output vtk file with naming /vtk/DisYZ.t.vtk + FileName = trim(RootPathName)//PathSep//"DisXY.Z"//ht_str//".t"//trim(t_str)//".vtp" + + ! see WrVTK_SP_header + call OpenFOutFile(unit, TRIM(FileName), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + + write (unit, '(A)') '# vtk DataFile Version 3.0' + write (unit, '(A)') "InflowWind XY Slice at T= "//trim(num2lstr(time))//" s" + write (unit, '(A)') 'ASCII' + write (unit, '(A)') 'DATASET STRUCTURED_POINTS' + + ! Note: gridVals must be stored such that the left-most dimension is X + ! and the right-most dimension is Z (see WrVTK_SP_vectors3D) + write (unit, '(A,3(i5,1X))') 'DIMENSIONS ', G3D%NSteps, G3D%NYGrids, 1 + write (unit, '(A,3(f10.2,1X))') 'ORIGIN ', G3D%InitXPosition+time*G3D%MeanWS, -G3D%YHWid, ht + write (unit, '(A,3(f10.2,1X))') 'SPACING ', -G3D%Dtime*G3D%MeanWS, 1.0_ReKi/G3D%InvDY, 0.0_ReKi + write (unit, '(A,i9)') 'POINT_DATA ', G3D%NSteps*G3D%NYGrids + write (unit, '(A)') 'VECTORS DisXY float' + + do iy = 1, G3D%NYGrids + do ix = 1, G3D%NSteps ! time and X are interchangeable + write (unit, '(3(f10.2,1X))') G3D%Vel(:, iy, iz, ix) + end do + end do + + close (unit) + enddo +end subroutine Grid3D_WriteVTKsliceXY + end module InflowWind_IO diff --git a/modules/inflowwind/src/InflowWind_IO.txt b/modules/inflowwind/src/InflowWind_IO.txt index 5d6c60e59b..ca305a2212 100644 --- a/modules/inflowwind/src/InflowWind_IO.txt +++ b/modules/inflowwind/src/InflowWind_IO.txt @@ -40,7 +40,6 @@ typedef ^ ^ ReKi RefHt typedef ^ ^ ReKi RefLength - - - "Reference length for linear horizontal and vertical sheer" - typedef ^ ^ ReKi PropagationDir - - - "Direction of wind propagation" radians typedef ^ ^ logical UseInputFile - .true. - "Flag for toggling file based IO in wind type 2." - -typedef ^ ^ FileInfoType PassedFileData - - - "Optional slot for wind type 2 data if file IO is not used." - #---------------------------------------------------------------------------------------------------------------------------------- typedef ^ Grid3D_InitInputType IntKi ScaleMethod - 0 - "Turbulence scaling method [0=none, 1=direct scaling, 2= calculate scaling factor based on a desired standard deviation]" - @@ -87,6 +86,7 @@ typedef ^ User_InitInputType SiKi Dummy typedef ^ Grid4D_InitInputType IntKi n 4 - - "number of grid points in the x, y, z, and t directions" - typedef ^ ^ ReKi delta 4 - - "size between 2 consecutive grid points in each grid direction" "m,m,m,s" typedef ^ ^ ReKi pZero 3 - - "fixed position of the XYZ grid (i.e., XYZ coordinates of m%V(:,1,1,1,:))" "m" +typedef ^ ^ SiKi *Vel ::::: - - "pointer to 4D grid velocity data" "m/s" #---------------------------------------------------------------------------------------------------------------------------------- typedef ^ Points_InitInputType IntKi NumWindPoints - - - "Number of points where wind components will be provided" - diff --git a/modules/inflowwind/src/InflowWind_IO_Types.f90 b/modules/inflowwind/src/InflowWind_IO_Types.f90 index 4409b9804d..7d88b26c34 100644 --- a/modules/inflowwind/src/InflowWind_IO_Types.f90 +++ b/modules/inflowwind/src/InflowWind_IO_Types.f90 @@ -38,46 +38,45 @@ MODULE InflowWind_IO_Types TYPE, PUBLIC :: WindFileDat character(1024) :: FileName !< Name of the windfile retrieved [-] INTEGER(IntKi) :: WindType = 0 !< Type of the windfile [-] - REAL(ReKi) :: RefHt !< Reference height given in file [meters] - LOGICAL :: RefHt_Set !< Reference height was given in file [-] - REAL(DbKi) :: DT !< TimeStep of the wind file -- zero value for none [seconds] - INTEGER(IntKi) :: NumTSteps !< Number of timesteps in the time range of wind file [-] - LOGICAL :: ConstantDT !< Timesteps are the same throughout file [-] - REAL(ReKi) , DIMENSION(1:2) :: TRange !< Time range of the wind file [seconds] - LOGICAL :: TRange_Limited !< TRange limits strictly enforced [-] - REAL(ReKi) , DIMENSION(1:2) :: YRange !< Range in y direction [meters] - LOGICAL :: YRange_Limited !< YRange limits strictly enforced [-] - REAL(ReKi) , DIMENSION(1:2) :: ZRange !< Range in z direction [meters] - LOGICAL :: ZRange_Limited !< ZRange limits strictly enforced [-] - INTEGER(IntKi) :: BinaryFormat !< Binary format identifier [-] - LOGICAL :: IsBinary !< Windfile is a binary file [-] - REAL(ReKi) , DIMENSION(1:3) :: TI !< Turbulence intensity (U,V,W) [-] - LOGICAL :: TI_listed !< Turbulence intesity given in file [-] - REAL(ReKi) :: MWS !< Approximate mean wind speed [-] + REAL(ReKi) :: RefHt = 0.0_ReKi !< Reference height given in file [meters] + LOGICAL :: RefHt_Set = .false. !< Reference height was given in file [-] + REAL(DbKi) :: DT = 0.0_R8Ki !< TimeStep of the wind file -- zero value for none [seconds] + INTEGER(IntKi) :: NumTSteps = 0_IntKi !< Number of timesteps in the time range of wind file [-] + LOGICAL :: ConstantDT = .false. !< Timesteps are the same throughout file [-] + REAL(ReKi) , DIMENSION(1:2) :: TRange = 0.0_ReKi !< Time range of the wind file [seconds] + LOGICAL :: TRange_Limited = .false. !< TRange limits strictly enforced [-] + REAL(ReKi) , DIMENSION(1:2) :: YRange = 0.0_ReKi !< Range in y direction [meters] + LOGICAL :: YRange_Limited = .false. !< YRange limits strictly enforced [-] + REAL(ReKi) , DIMENSION(1:2) :: ZRange = 0.0_ReKi !< Range in z direction [meters] + LOGICAL :: ZRange_Limited = .false. !< ZRange limits strictly enforced [-] + INTEGER(IntKi) :: BinaryFormat = 0_IntKi !< Binary format identifier [-] + LOGICAL :: IsBinary = .false. !< Windfile is a binary file [-] + REAL(ReKi) , DIMENSION(1:3) :: TI = 0.0_ReKi !< Turbulence intensity (U,V,W) [-] + LOGICAL :: TI_listed = .false. !< Turbulence intesity given in file [-] + REAL(ReKi) :: MWS = 0.0_ReKi !< Approximate mean wind speed [-] END TYPE WindFileDat ! ======================= ! ========= Steady_InitInputType ======= TYPE, PUBLIC :: Steady_InitInputType - REAL(ReKi) :: HWindSpeed !< Horizontal wind speed [m/s] - REAL(ReKi) :: RefHt !< Reference height for horizontal wind speed [meters] - REAL(ReKi) :: PLExp !< Power law exponent [-] + REAL(ReKi) :: HWindSpeed = 0.0_ReKi !< Horizontal wind speed [m/s] + REAL(ReKi) :: RefHt = 0.0_ReKi !< Reference height for horizontal wind speed [meters] + REAL(ReKi) :: PLExp = 0.0_ReKi !< Power law exponent [-] END TYPE Steady_InitInputType ! ======================= ! ========= Uniform_InitInputType ======= TYPE, PUBLIC :: Uniform_InitInputType character(1024) :: WindFileName !< Name of the wind file to use [-] - REAL(ReKi) :: RefHt !< Reference height for horizontal wind speed [meters] - REAL(ReKi) :: RefLength !< Reference length for linear horizontal and vertical sheer [-] - REAL(ReKi) :: PropagationDir !< Direction of wind propagation [radians] + REAL(ReKi) :: RefHt = 0.0_ReKi !< Reference height for horizontal wind speed [meters] + REAL(ReKi) :: RefLength = 0.0_ReKi !< Reference length for linear horizontal and vertical sheer [-] + REAL(ReKi) :: PropagationDir = 0.0_ReKi !< Direction of wind propagation [radians] LOGICAL :: UseInputFile = .true. !< Flag for toggling file based IO in wind type 2. [-] - TYPE(FileInfoType) :: PassedFileData !< Optional slot for wind type 2 data if file IO is not used. [-] END TYPE Uniform_InitInputType ! ======================= ! ========= Grid3D_InitInputType ======= TYPE, PUBLIC :: Grid3D_InitInputType INTEGER(IntKi) :: ScaleMethod = 0 !< Turbulence scaling method [0=none, 1=direct scaling, 2= calculate scaling factor based on a desired standard deviation] [-] - REAL(ReKi) , DIMENSION(1:3) :: SF !< Turbulence scaling factor for each direction [ScaleMethod=1] [-] - REAL(ReKi) , DIMENSION(1:3) :: SigmaF !< Turbulence standard deviation to calculate scaling from in each direction [ScaleMethod=2] [-] + REAL(ReKi) , DIMENSION(1:3) :: SF = 0 !< Turbulence scaling factor for each direction [ScaleMethod=1] [-] + REAL(ReKi) , DIMENSION(1:3) :: SigmaF = 0 !< Turbulence standard deviation to calculate scaling from in each direction [ScaleMethod=2] [-] INTEGER(IntKi) :: WindProfileType = -1 !< Wind profile type (0=constant;1=logarithmic;2=power law) [-] REAL(ReKi) :: RefHt = 0 !< Reference (hub) height of the grid [meters] REAL(ReKi) :: URef = 0 !< Mean u-component wind speed at the reference height [meters] @@ -97,17 +96,17 @@ MODULE InflowWind_IO_Types ! ========= Bladed_InitInputType ======= TYPE, PUBLIC :: Bladed_InitInputType character(1024) :: WindFileName !< Root filename [-] - INTEGER(IntKi) :: WindType !< Whether this is native Bladed (needs wind profile and TI scaling) or not [-] - LOGICAL :: NativeBladedFmt !< Whether this is native Bladed (needs wind profile and TI scaling) or not [-] - LOGICAL :: TowerFileExist !< Tower file exists [-] + INTEGER(IntKi) :: WindType = 0_IntKi !< Whether this is native Bladed (needs wind profile and TI scaling) or not [-] + LOGICAL :: NativeBladedFmt = .false. !< Whether this is native Bladed (needs wind profile and TI scaling) or not [-] + LOGICAL :: TowerFileExist = .false. !< Tower file exists [-] INTEGER(IntKi) :: TurbineID = 0 !< Wind turbine ID number in the fixed (DEFAULT) file name when FixedWindFileRootName = .TRUE. (used by FAST.Farm) [-] LOGICAL :: FixedWindFileRootName = .false. !< Do the wind data files have a fixed (DEFAULT) file name? (used by FAST.Farm) [-] END TYPE Bladed_InitInputType ! ======================= ! ========= Bladed_InitOutputType ======= TYPE, PUBLIC :: Bladed_InitOutputType - REAL(ReKi) :: PropagationDir !< Propogation direction from native Bladed format [degrees] - REAL(ReKi) :: VFlowAngle !< Vertical flow angle from native Bladed format [degrees] + REAL(ReKi) :: PropagationDir = 0.0_ReKi !< Propogation direction from native Bladed format [degrees] + REAL(ReKi) :: VFlowAngle = 0.0_ReKi !< Vertical flow angle from native Bladed format [degrees] END TYPE Bladed_InitOutputType ! ======================= ! ========= HAWC_InitInputType ======= @@ -124,2086 +123,607 @@ MODULE InflowWind_IO_Types ! ======================= ! ========= User_InitInputType ======= TYPE, PUBLIC :: User_InitInputType - REAL(SiKi) :: Dummy !< User field initialization input dummy value [-] + REAL(SiKi) :: Dummy = 0.0_R4Ki !< User field initialization input dummy value [-] END TYPE User_InitInputType ! ======================= ! ========= Grid4D_InitInputType ======= TYPE, PUBLIC :: Grid4D_InitInputType - INTEGER(IntKi) , DIMENSION(1:4) :: n !< number of grid points in the x, y, z, and t directions [-] - REAL(ReKi) , DIMENSION(1:4) :: delta !< size between 2 consecutive grid points in each grid direction [m,m,m,s] - REAL(ReKi) , DIMENSION(1:3) :: pZero !< fixed position of the XYZ grid (i.e., XYZ coordinates of m%V(:,1,1,1,:)) [m] + INTEGER(IntKi) , DIMENSION(1:4) :: n = 0_IntKi !< number of grid points in the x, y, z, and t directions [-] + REAL(ReKi) , DIMENSION(1:4) :: delta = 0.0_ReKi !< size between 2 consecutive grid points in each grid direction [m,m,m,s] + REAL(ReKi) , DIMENSION(1:3) :: pZero = 0.0_ReKi !< fixed position of the XYZ grid (i.e., XYZ coordinates of m%V(:,1,1,1,:)) [m] + REAL(SiKi) , DIMENSION(:,:,:,:,:), POINTER :: Vel => NULL() !< pointer to 4D grid velocity data [m/s] END TYPE Grid4D_InitInputType ! ======================= ! ========= Points_InitInputType ======= TYPE, PUBLIC :: Points_InitInputType - INTEGER(IntKi) :: NumWindPoints !< Number of points where wind components will be provided [-] + INTEGER(IntKi) :: NumWindPoints = 0_IntKi !< Number of points where wind components will be provided [-] END TYPE Points_InitInputType ! ======================= CONTAINS - SUBROUTINE InflowWind_IO_CopyWindFileDat( SrcWindFileDatData, DstWindFileDatData, CtrlCode, ErrStat, ErrMsg ) - TYPE(WindFileDat), INTENT(IN) :: SrcWindFileDatData - TYPE(WindFileDat), INTENT(INOUT) :: DstWindFileDatData - 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 = 'InflowWind_IO_CopyWindFileDat' -! - ErrStat = ErrID_None - ErrMsg = "" - DstWindFileDatData%FileName = SrcWindFileDatData%FileName - DstWindFileDatData%WindType = SrcWindFileDatData%WindType - DstWindFileDatData%RefHt = SrcWindFileDatData%RefHt - DstWindFileDatData%RefHt_Set = SrcWindFileDatData%RefHt_Set - DstWindFileDatData%DT = SrcWindFileDatData%DT - DstWindFileDatData%NumTSteps = SrcWindFileDatData%NumTSteps - DstWindFileDatData%ConstantDT = SrcWindFileDatData%ConstantDT - DstWindFileDatData%TRange = SrcWindFileDatData%TRange - DstWindFileDatData%TRange_Limited = SrcWindFileDatData%TRange_Limited - DstWindFileDatData%YRange = SrcWindFileDatData%YRange - DstWindFileDatData%YRange_Limited = SrcWindFileDatData%YRange_Limited - DstWindFileDatData%ZRange = SrcWindFileDatData%ZRange - DstWindFileDatData%ZRange_Limited = SrcWindFileDatData%ZRange_Limited - DstWindFileDatData%BinaryFormat = SrcWindFileDatData%BinaryFormat - DstWindFileDatData%IsBinary = SrcWindFileDatData%IsBinary - DstWindFileDatData%TI = SrcWindFileDatData%TI - DstWindFileDatData%TI_listed = SrcWindFileDatData%TI_listed - DstWindFileDatData%MWS = SrcWindFileDatData%MWS - END SUBROUTINE InflowWind_IO_CopyWindFileDat - - SUBROUTINE InflowWind_IO_DestroyWindFileDat( WindFileDatData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(WindFileDat), INTENT(INOUT) :: WindFileDatData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_IO_DestroyWindFileDat' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE InflowWind_IO_DestroyWindFileDat - - SUBROUTINE InflowWind_IO_PackWindFileDat( 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(WindFileDat), 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 = 'InflowWind_IO_PackWindFileDat' - ! 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%FileName) ! FileName - Int_BufSz = Int_BufSz + 1 ! WindType - Re_BufSz = Re_BufSz + 1 ! RefHt - Int_BufSz = Int_BufSz + 1 ! RefHt_Set - Db_BufSz = Db_BufSz + 1 ! DT - Int_BufSz = Int_BufSz + 1 ! NumTSteps - Int_BufSz = Int_BufSz + 1 ! ConstantDT - Re_BufSz = Re_BufSz + SIZE(InData%TRange) ! TRange - Int_BufSz = Int_BufSz + 1 ! TRange_Limited - Re_BufSz = Re_BufSz + SIZE(InData%YRange) ! YRange - Int_BufSz = Int_BufSz + 1 ! YRange_Limited - Re_BufSz = Re_BufSz + SIZE(InData%ZRange) ! ZRange - Int_BufSz = Int_BufSz + 1 ! ZRange_Limited - Int_BufSz = Int_BufSz + 1 ! BinaryFormat - Int_BufSz = Int_BufSz + 1 ! IsBinary - Re_BufSz = Re_BufSz + SIZE(InData%TI) ! TI - Int_BufSz = Int_BufSz + 1 ! TI_listed - Re_BufSz = Re_BufSz + 1 ! MWS - 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%FileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%FileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = InData%WindType - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RefHt - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%RefHt_Set, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%DT - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumTSteps - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%ConstantDT, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%TRange,1), UBOUND(InData%TRange,1) - ReKiBuf(Re_Xferred) = InData%TRange(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = TRANSFER(InData%TRange_Limited, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%YRange,1), UBOUND(InData%YRange,1) - ReKiBuf(Re_Xferred) = InData%YRange(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = TRANSFER(InData%YRange_Limited, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%ZRange,1), UBOUND(InData%ZRange,1) - ReKiBuf(Re_Xferred) = InData%ZRange(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = TRANSFER(InData%ZRange_Limited, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%BinaryFormat - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%IsBinary, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%TI,1), UBOUND(InData%TI,1) - ReKiBuf(Re_Xferred) = InData%TI(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = TRANSFER(InData%TI_listed, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MWS - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE InflowWind_IO_PackWindFileDat - SUBROUTINE InflowWind_IO_UnPackWindFileDat( 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(WindFileDat), 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 = 'InflowWind_IO_UnPackWindFileDat' - ! 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%FileName) - OutData%FileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%WindType = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%RefHt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RefHt_Set = TRANSFER(IntKiBuf(Int_Xferred), OutData%RefHt_Set) - Int_Xferred = Int_Xferred + 1 - OutData%DT = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%NumTSteps = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%ConstantDT = TRANSFER(IntKiBuf(Int_Xferred), OutData%ConstantDT) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%TRange,1) - i1_u = UBOUND(OutData%TRange,1) - DO i1 = LBOUND(OutData%TRange,1), UBOUND(OutData%TRange,1) - OutData%TRange(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%TRange_Limited = TRANSFER(IntKiBuf(Int_Xferred), OutData%TRange_Limited) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%YRange,1) - i1_u = UBOUND(OutData%YRange,1) - DO i1 = LBOUND(OutData%YRange,1), UBOUND(OutData%YRange,1) - OutData%YRange(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%YRange_Limited = TRANSFER(IntKiBuf(Int_Xferred), OutData%YRange_Limited) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%ZRange,1) - i1_u = UBOUND(OutData%ZRange,1) - DO i1 = LBOUND(OutData%ZRange,1), UBOUND(OutData%ZRange,1) - OutData%ZRange(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%ZRange_Limited = TRANSFER(IntKiBuf(Int_Xferred), OutData%ZRange_Limited) - Int_Xferred = Int_Xferred + 1 - OutData%BinaryFormat = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%IsBinary = TRANSFER(IntKiBuf(Int_Xferred), OutData%IsBinary) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%TI,1) - i1_u = UBOUND(OutData%TI,1) - DO i1 = LBOUND(OutData%TI,1), UBOUND(OutData%TI,1) - OutData%TI(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%TI_listed = TRANSFER(IntKiBuf(Int_Xferred), OutData%TI_listed) - Int_Xferred = Int_Xferred + 1 - OutData%MWS = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE InflowWind_IO_UnPackWindFileDat - - SUBROUTINE InflowWind_IO_CopySteady_InitInputType( SrcSteady_InitInputTypeData, DstSteady_InitInputTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Steady_InitInputType), INTENT(IN) :: SrcSteady_InitInputTypeData - TYPE(Steady_InitInputType), INTENT(INOUT) :: DstSteady_InitInputTypeData - 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 = 'InflowWind_IO_CopySteady_InitInputType' -! +subroutine InflowWind_IO_CopyWindFileDat(SrcWindFileDatData, DstWindFileDatData, CtrlCode, ErrStat, ErrMsg) + type(WindFileDat), intent(in) :: SrcWindFileDatData + type(WindFileDat), intent(inout) :: DstWindFileDatData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'InflowWind_IO_CopyWindFileDat' ErrStat = ErrID_None - ErrMsg = "" - DstSteady_InitInputTypeData%HWindSpeed = SrcSteady_InitInputTypeData%HWindSpeed - DstSteady_InitInputTypeData%RefHt = SrcSteady_InitInputTypeData%RefHt - DstSteady_InitInputTypeData%PLExp = SrcSteady_InitInputTypeData%PLExp - END SUBROUTINE InflowWind_IO_CopySteady_InitInputType - - SUBROUTINE InflowWind_IO_DestroySteady_InitInputType( Steady_InitInputTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(Steady_InitInputType), INTENT(INOUT) :: Steady_InitInputTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_IO_DestroySteady_InitInputType' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE InflowWind_IO_DestroySteady_InitInputType - - SUBROUTINE InflowWind_IO_PackSteady_InitInputType( 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(Steady_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 = 'InflowWind_IO_PackSteady_InitInputType' - ! 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 ! HWindSpeed - Re_BufSz = Re_BufSz + 1 ! RefHt - Re_BufSz = Re_BufSz + 1 ! PLExp - 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%HWindSpeed - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RefHt - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PLExp - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE InflowWind_IO_PackSteady_InitInputType - - SUBROUTINE InflowWind_IO_UnPackSteady_InitInputType( 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(Steady_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 = 'InflowWind_IO_UnPackSteady_InitInputType' - ! 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%HWindSpeed = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RefHt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PLExp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE InflowWind_IO_UnPackSteady_InitInputType - - SUBROUTINE InflowWind_IO_CopyUniform_InitInputType( SrcUniform_InitInputTypeData, DstUniform_InitInputTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Uniform_InitInputType), INTENT(IN) :: SrcUniform_InitInputTypeData - TYPE(Uniform_InitInputType), INTENT(INOUT) :: DstUniform_InitInputTypeData - 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 = 'InflowWind_IO_CopyUniform_InitInputType' -! + ErrMsg = '' + DstWindFileDatData%FileName = SrcWindFileDatData%FileName + DstWindFileDatData%WindType = SrcWindFileDatData%WindType + DstWindFileDatData%RefHt = SrcWindFileDatData%RefHt + DstWindFileDatData%RefHt_Set = SrcWindFileDatData%RefHt_Set + DstWindFileDatData%DT = SrcWindFileDatData%DT + DstWindFileDatData%NumTSteps = SrcWindFileDatData%NumTSteps + DstWindFileDatData%ConstantDT = SrcWindFileDatData%ConstantDT + DstWindFileDatData%TRange = SrcWindFileDatData%TRange + DstWindFileDatData%TRange_Limited = SrcWindFileDatData%TRange_Limited + DstWindFileDatData%YRange = SrcWindFileDatData%YRange + DstWindFileDatData%YRange_Limited = SrcWindFileDatData%YRange_Limited + DstWindFileDatData%ZRange = SrcWindFileDatData%ZRange + DstWindFileDatData%ZRange_Limited = SrcWindFileDatData%ZRange_Limited + DstWindFileDatData%BinaryFormat = SrcWindFileDatData%BinaryFormat + DstWindFileDatData%IsBinary = SrcWindFileDatData%IsBinary + DstWindFileDatData%TI = SrcWindFileDatData%TI + DstWindFileDatData%TI_listed = SrcWindFileDatData%TI_listed + DstWindFileDatData%MWS = SrcWindFileDatData%MWS +end subroutine + +subroutine InflowWind_IO_DestroyWindFileDat(WindFileDatData, ErrStat, ErrMsg) + type(WindFileDat), intent(inout) :: WindFileDatData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'InflowWind_IO_DestroyWindFileDat' ErrStat = ErrID_None - ErrMsg = "" - DstUniform_InitInputTypeData%WindFileName = SrcUniform_InitInputTypeData%WindFileName - DstUniform_InitInputTypeData%RefHt = SrcUniform_InitInputTypeData%RefHt - DstUniform_InitInputTypeData%RefLength = SrcUniform_InitInputTypeData%RefLength - DstUniform_InitInputTypeData%PropagationDir = SrcUniform_InitInputTypeData%PropagationDir - DstUniform_InitInputTypeData%UseInputFile = SrcUniform_InitInputTypeData%UseInputFile - CALL NWTC_Library_Copyfileinfotype( SrcUniform_InitInputTypeData%PassedFileData, DstUniform_InitInputTypeData%PassedFileData, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE InflowWind_IO_CopyUniform_InitInputType - - SUBROUTINE InflowWind_IO_DestroyUniform_InitInputType( Uniform_InitInputTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(Uniform_InitInputType), INTENT(INOUT) :: Uniform_InitInputTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_IO_DestroyUniform_InitInputType' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL NWTC_Library_Destroyfileinfotype( Uniform_InitInputTypeData%PassedFileData, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE InflowWind_IO_DestroyUniform_InitInputType - - SUBROUTINE InflowWind_IO_PackUniform_InitInputType( 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(Uniform_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 = 'InflowWind_IO_PackUniform_InitInputType' - ! 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%WindFileName) ! WindFileName - Re_BufSz = Re_BufSz + 1 ! RefHt - Re_BufSz = Re_BufSz + 1 ! RefLength - Re_BufSz = Re_BufSz + 1 ! PropagationDir - Int_BufSz = Int_BufSz + 1 ! UseInputFile - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! PassedFileData: size of buffers for each call to pack subtype - CALL NWTC_Library_Packfileinfotype( Re_Buf, Db_Buf, Int_Buf, InData%PassedFileData, ErrStat2, ErrMsg2, .TRUE. ) ! PassedFileData - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! PassedFileData - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! PassedFileData - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! PassedFileData - 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%WindFileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%WindFileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - ReKiBuf(Re_Xferred) = InData%RefHt - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RefLength - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PropagationDir - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%UseInputFile, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - CALL NWTC_Library_Packfileinfotype( Re_Buf, Db_Buf, Int_Buf, InData%PassedFileData, ErrStat2, ErrMsg2, OnlySize ) ! PassedFileData - 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 InflowWind_IO_PackUniform_InitInputType - - SUBROUTINE InflowWind_IO_UnPackUniform_InitInputType( 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(Uniform_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 = 'InflowWind_IO_UnPackUniform_InitInputType' - ! 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%WindFileName) - OutData%WindFileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%RefHt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RefLength = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PropagationDir = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - 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%PassedFileData, ErrStat2, ErrMsg2 ) ! PassedFileData - 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 InflowWind_IO_UnPackUniform_InitInputType - - SUBROUTINE InflowWind_IO_CopyGrid3D_InitInputType( SrcGrid3D_InitInputTypeData, DstGrid3D_InitInputTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Grid3D_InitInputType), INTENT(IN) :: SrcGrid3D_InitInputTypeData - TYPE(Grid3D_InitInputType), INTENT(INOUT) :: DstGrid3D_InitInputTypeData - 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 = 'InflowWind_IO_CopyGrid3D_InitInputType' -! + ErrMsg = '' +end subroutine + +subroutine InflowWind_IO_PackWindFileDat(RF, Indata) + type(RegFile), intent(inout) :: RF + type(WindFileDat), intent(in) :: InData + character(*), parameter :: RoutineName = 'InflowWind_IO_PackWindFileDat' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%FileName) + call RegPack(RF, InData%WindType) + call RegPack(RF, InData%RefHt) + call RegPack(RF, InData%RefHt_Set) + call RegPack(RF, InData%DT) + call RegPack(RF, InData%NumTSteps) + call RegPack(RF, InData%ConstantDT) + call RegPack(RF, InData%TRange) + call RegPack(RF, InData%TRange_Limited) + call RegPack(RF, InData%YRange) + call RegPack(RF, InData%YRange_Limited) + call RegPack(RF, InData%ZRange) + call RegPack(RF, InData%ZRange_Limited) + call RegPack(RF, InData%BinaryFormat) + call RegPack(RF, InData%IsBinary) + call RegPack(RF, InData%TI) + call RegPack(RF, InData%TI_listed) + call RegPack(RF, InData%MWS) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine InflowWind_IO_UnPackWindFileDat(RF, OutData) + type(RegFile), intent(inout) :: RF + type(WindFileDat), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'InflowWind_IO_UnPackWindFileDat' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%FileName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WindType); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RefHt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RefHt_Set); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumTSteps); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ConstantDT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TRange); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TRange_Limited); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YRange); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YRange_Limited); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ZRange); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ZRange_Limited); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BinaryFormat); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%IsBinary); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TI); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TI_listed); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MWS); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine InflowWind_IO_CopySteady_InitInputType(SrcSteady_InitInputTypeData, DstSteady_InitInputTypeData, CtrlCode, ErrStat, ErrMsg) + type(Steady_InitInputType), intent(in) :: SrcSteady_InitInputTypeData + type(Steady_InitInputType), intent(inout) :: DstSteady_InitInputTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'InflowWind_IO_CopySteady_InitInputType' ErrStat = ErrID_None - ErrMsg = "" - DstGrid3D_InitInputTypeData%ScaleMethod = SrcGrid3D_InitInputTypeData%ScaleMethod - DstGrid3D_InitInputTypeData%SF = SrcGrid3D_InitInputTypeData%SF - DstGrid3D_InitInputTypeData%SigmaF = SrcGrid3D_InitInputTypeData%SigmaF - DstGrid3D_InitInputTypeData%WindProfileType = SrcGrid3D_InitInputTypeData%WindProfileType - DstGrid3D_InitInputTypeData%RefHt = SrcGrid3D_InitInputTypeData%RefHt - DstGrid3D_InitInputTypeData%URef = SrcGrid3D_InitInputTypeData%URef - DstGrid3D_InitInputTypeData%PLExp = SrcGrid3D_InitInputTypeData%PLExp - DstGrid3D_InitInputTypeData%VLinShr = SrcGrid3D_InitInputTypeData%VLinShr - DstGrid3D_InitInputTypeData%HLinShr = SrcGrid3D_InitInputTypeData%HLinShr - DstGrid3D_InitInputTypeData%RefLength = SrcGrid3D_InitInputTypeData%RefLength - DstGrid3D_InitInputTypeData%Z0 = SrcGrid3D_InitInputTypeData%Z0 - DstGrid3D_InitInputTypeData%XOffset = SrcGrid3D_InitInputTypeData%XOffset - END SUBROUTINE InflowWind_IO_CopyGrid3D_InitInputType - - SUBROUTINE InflowWind_IO_DestroyGrid3D_InitInputType( Grid3D_InitInputTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(Grid3D_InitInputType), INTENT(INOUT) :: Grid3D_InitInputTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_IO_DestroyGrid3D_InitInputType' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE InflowWind_IO_DestroyGrid3D_InitInputType - - SUBROUTINE InflowWind_IO_PackGrid3D_InitInputType( 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(Grid3D_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 = 'InflowWind_IO_PackGrid3D_InitInputType' - ! 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 ! ScaleMethod - Re_BufSz = Re_BufSz + SIZE(InData%SF) ! SF - Re_BufSz = Re_BufSz + SIZE(InData%SigmaF) ! SigmaF - Int_BufSz = Int_BufSz + 1 ! WindProfileType - Re_BufSz = Re_BufSz + 1 ! RefHt - Re_BufSz = Re_BufSz + 1 ! URef - Re_BufSz = Re_BufSz + 1 ! PLExp - Re_BufSz = Re_BufSz + 1 ! VLinShr - Re_BufSz = Re_BufSz + 1 ! HLinShr - Re_BufSz = Re_BufSz + 1 ! RefLength - Re_BufSz = Re_BufSz + 1 ! Z0 - Re_BufSz = Re_BufSz + 1 ! XOffset - 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%ScaleMethod - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%SF,1), UBOUND(InData%SF,1) - ReKiBuf(Re_Xferred) = InData%SF(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%SigmaF,1), UBOUND(InData%SigmaF,1) - ReKiBuf(Re_Xferred) = InData%SigmaF(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%WindProfileType - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RefHt - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%URef - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PLExp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%VLinShr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%HLinShr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RefLength - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Z0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%XOffset - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE InflowWind_IO_PackGrid3D_InitInputType - - SUBROUTINE InflowWind_IO_UnPackGrid3D_InitInputType( 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(Grid3D_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 = 'InflowWind_IO_UnPackGrid3D_InitInputType' - ! 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%ScaleMethod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%SF,1) - i1_u = UBOUND(OutData%SF,1) - DO i1 = LBOUND(OutData%SF,1), UBOUND(OutData%SF,1) - OutData%SF(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%SigmaF,1) - i1_u = UBOUND(OutData%SigmaF,1) - DO i1 = LBOUND(OutData%SigmaF,1), UBOUND(OutData%SigmaF,1) - OutData%SigmaF(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%WindProfileType = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%RefHt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%URef = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PLExp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%VLinShr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%HLinShr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RefLength = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Z0 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%XOffset = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE InflowWind_IO_UnPackGrid3D_InitInputType - - SUBROUTINE InflowWind_IO_CopyTurbSim_InitInputType( SrcTurbSim_InitInputTypeData, DstTurbSim_InitInputTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(TurbSim_InitInputType), INTENT(IN) :: SrcTurbSim_InitInputTypeData - TYPE(TurbSim_InitInputType), INTENT(INOUT) :: DstTurbSim_InitInputTypeData - 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 = 'InflowWind_IO_CopyTurbSim_InitInputType' -! + ErrMsg = '' + DstSteady_InitInputTypeData%HWindSpeed = SrcSteady_InitInputTypeData%HWindSpeed + DstSteady_InitInputTypeData%RefHt = SrcSteady_InitInputTypeData%RefHt + DstSteady_InitInputTypeData%PLExp = SrcSteady_InitInputTypeData%PLExp +end subroutine + +subroutine InflowWind_IO_DestroySteady_InitInputType(Steady_InitInputTypeData, ErrStat, ErrMsg) + type(Steady_InitInputType), intent(inout) :: Steady_InitInputTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'InflowWind_IO_DestroySteady_InitInputType' ErrStat = ErrID_None - ErrMsg = "" - DstTurbSim_InitInputTypeData%WindFileName = SrcTurbSim_InitInputTypeData%WindFileName - END SUBROUTINE InflowWind_IO_CopyTurbSim_InitInputType - - SUBROUTINE InflowWind_IO_DestroyTurbSim_InitInputType( TurbSim_InitInputTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(TurbSim_InitInputType), INTENT(INOUT) :: TurbSim_InitInputTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_IO_DestroyTurbSim_InitInputType' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE InflowWind_IO_DestroyTurbSim_InitInputType - - SUBROUTINE InflowWind_IO_PackTurbSim_InitInputType( 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(TurbSim_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 = 'InflowWind_IO_PackTurbSim_InitInputType' - ! 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%WindFileName) ! WindFileName - 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%WindFileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%WindFileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END SUBROUTINE InflowWind_IO_PackTurbSim_InitInputType - - SUBROUTINE InflowWind_IO_UnPackTurbSim_InitInputType( 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(TurbSim_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 = 'InflowWind_IO_UnPackTurbSim_InitInputType' - ! 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%WindFileName) - OutData%WindFileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END SUBROUTINE InflowWind_IO_UnPackTurbSim_InitInputType - - SUBROUTINE InflowWind_IO_CopyBladed_InitInputType( SrcBladed_InitInputTypeData, DstBladed_InitInputTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Bladed_InitInputType), INTENT(IN) :: SrcBladed_InitInputTypeData - TYPE(Bladed_InitInputType), INTENT(INOUT) :: DstBladed_InitInputTypeData - 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 = 'InflowWind_IO_CopyBladed_InitInputType' -! + ErrMsg = '' +end subroutine + +subroutine InflowWind_IO_PackSteady_InitInputType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Steady_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'InflowWind_IO_PackSteady_InitInputType' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%HWindSpeed) + call RegPack(RF, InData%RefHt) + call RegPack(RF, InData%PLExp) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine InflowWind_IO_UnPackSteady_InitInputType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Steady_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'InflowWind_IO_UnPackSteady_InitInputType' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%HWindSpeed); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RefHt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PLExp); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine InflowWind_IO_CopyUniform_InitInputType(SrcUniform_InitInputTypeData, DstUniform_InitInputTypeData, CtrlCode, ErrStat, ErrMsg) + type(Uniform_InitInputType), intent(in) :: SrcUniform_InitInputTypeData + type(Uniform_InitInputType), intent(inout) :: DstUniform_InitInputTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'InflowWind_IO_CopyUniform_InitInputType' ErrStat = ErrID_None - ErrMsg = "" - DstBladed_InitInputTypeData%WindFileName = SrcBladed_InitInputTypeData%WindFileName - DstBladed_InitInputTypeData%WindType = SrcBladed_InitInputTypeData%WindType - DstBladed_InitInputTypeData%NativeBladedFmt = SrcBladed_InitInputTypeData%NativeBladedFmt - DstBladed_InitInputTypeData%TowerFileExist = SrcBladed_InitInputTypeData%TowerFileExist - DstBladed_InitInputTypeData%TurbineID = SrcBladed_InitInputTypeData%TurbineID - DstBladed_InitInputTypeData%FixedWindFileRootName = SrcBladed_InitInputTypeData%FixedWindFileRootName - END SUBROUTINE InflowWind_IO_CopyBladed_InitInputType - - SUBROUTINE InflowWind_IO_DestroyBladed_InitInputType( Bladed_InitInputTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(Bladed_InitInputType), INTENT(INOUT) :: Bladed_InitInputTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_IO_DestroyBladed_InitInputType' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE InflowWind_IO_DestroyBladed_InitInputType - - SUBROUTINE InflowWind_IO_PackBladed_InitInputType( 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(Bladed_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 = 'InflowWind_IO_PackBladed_InitInputType' - ! 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%WindFileName) ! WindFileName - Int_BufSz = Int_BufSz + 1 ! WindType - Int_BufSz = Int_BufSz + 1 ! NativeBladedFmt - Int_BufSz = Int_BufSz + 1 ! TowerFileExist - Int_BufSz = Int_BufSz + 1 ! TurbineID - Int_BufSz = Int_BufSz + 1 ! FixedWindFileRootName - 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%WindFileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%WindFileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = InData%WindType - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%NativeBladedFmt, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%TowerFileExist, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%TurbineID - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%FixedWindFileRootName, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE InflowWind_IO_PackBladed_InitInputType - - SUBROUTINE InflowWind_IO_UnPackBladed_InitInputType( 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(Bladed_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 = 'InflowWind_IO_UnPackBladed_InitInputType' - ! 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%WindFileName) - OutData%WindFileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%WindType = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NativeBladedFmt = TRANSFER(IntKiBuf(Int_Xferred), OutData%NativeBladedFmt) - Int_Xferred = Int_Xferred + 1 - OutData%TowerFileExist = TRANSFER(IntKiBuf(Int_Xferred), OutData%TowerFileExist) - Int_Xferred = Int_Xferred + 1 - OutData%TurbineID = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%FixedWindFileRootName = TRANSFER(IntKiBuf(Int_Xferred), OutData%FixedWindFileRootName) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE InflowWind_IO_UnPackBladed_InitInputType - - SUBROUTINE InflowWind_IO_CopyBladed_InitOutputType( SrcBladed_InitOutputTypeData, DstBladed_InitOutputTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Bladed_InitOutputType), INTENT(IN) :: SrcBladed_InitOutputTypeData - TYPE(Bladed_InitOutputType), INTENT(INOUT) :: DstBladed_InitOutputTypeData - 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 = 'InflowWind_IO_CopyBladed_InitOutputType' -! + ErrMsg = '' + DstUniform_InitInputTypeData%WindFileName = SrcUniform_InitInputTypeData%WindFileName + DstUniform_InitInputTypeData%RefHt = SrcUniform_InitInputTypeData%RefHt + DstUniform_InitInputTypeData%RefLength = SrcUniform_InitInputTypeData%RefLength + DstUniform_InitInputTypeData%PropagationDir = SrcUniform_InitInputTypeData%PropagationDir + DstUniform_InitInputTypeData%UseInputFile = SrcUniform_InitInputTypeData%UseInputFile +end subroutine + +subroutine InflowWind_IO_DestroyUniform_InitInputType(Uniform_InitInputTypeData, ErrStat, ErrMsg) + type(Uniform_InitInputType), intent(inout) :: Uniform_InitInputTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'InflowWind_IO_DestroyUniform_InitInputType' ErrStat = ErrID_None - ErrMsg = "" - DstBladed_InitOutputTypeData%PropagationDir = SrcBladed_InitOutputTypeData%PropagationDir - DstBladed_InitOutputTypeData%VFlowAngle = SrcBladed_InitOutputTypeData%VFlowAngle - END SUBROUTINE InflowWind_IO_CopyBladed_InitOutputType - - SUBROUTINE InflowWind_IO_DestroyBladed_InitOutputType( Bladed_InitOutputTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(Bladed_InitOutputType), INTENT(INOUT) :: Bladed_InitOutputTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_IO_DestroyBladed_InitOutputType' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE InflowWind_IO_DestroyBladed_InitOutputType - - SUBROUTINE InflowWind_IO_PackBladed_InitOutputType( 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(Bladed_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 = 'InflowWind_IO_PackBladed_InitOutputType' - ! 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 ! PropagationDir - Re_BufSz = Re_BufSz + 1 ! VFlowAngle - 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%PropagationDir - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%VFlowAngle - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE InflowWind_IO_PackBladed_InitOutputType - - SUBROUTINE InflowWind_IO_UnPackBladed_InitOutputType( 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(Bladed_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 = 'InflowWind_IO_UnPackBladed_InitOutputType' - ! 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%PropagationDir = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%VFlowAngle = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE InflowWind_IO_UnPackBladed_InitOutputType - - SUBROUTINE InflowWind_IO_CopyHAWC_InitInputType( SrcHAWC_InitInputTypeData, DstHAWC_InitInputTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(HAWC_InitInputType), INTENT(IN) :: SrcHAWC_InitInputTypeData - TYPE(HAWC_InitInputType), INTENT(INOUT) :: DstHAWC_InitInputTypeData - 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 = 'InflowWind_IO_CopyHAWC_InitInputType' -! + ErrMsg = '' +end subroutine + +subroutine InflowWind_IO_PackUniform_InitInputType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Uniform_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'InflowWind_IO_PackUniform_InitInputType' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%WindFileName) + call RegPack(RF, InData%RefHt) + call RegPack(RF, InData%RefLength) + call RegPack(RF, InData%PropagationDir) + call RegPack(RF, InData%UseInputFile) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine InflowWind_IO_UnPackUniform_InitInputType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Uniform_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'InflowWind_IO_UnPackUniform_InitInputType' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%WindFileName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RefHt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RefLength); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PropagationDir); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UseInputFile); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine InflowWind_IO_CopyGrid3D_InitInputType(SrcGrid3D_InitInputTypeData, DstGrid3D_InitInputTypeData, CtrlCode, ErrStat, ErrMsg) + type(Grid3D_InitInputType), intent(in) :: SrcGrid3D_InitInputTypeData + type(Grid3D_InitInputType), intent(inout) :: DstGrid3D_InitInputTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'InflowWind_IO_CopyGrid3D_InitInputType' ErrStat = ErrID_None - ErrMsg = "" - DstHAWC_InitInputTypeData%WindFileName = SrcHAWC_InitInputTypeData%WindFileName - DstHAWC_InitInputTypeData%nx = SrcHAWC_InitInputTypeData%nx - DstHAWC_InitInputTypeData%ny = SrcHAWC_InitInputTypeData%ny - DstHAWC_InitInputTypeData%nz = SrcHAWC_InitInputTypeData%nz - DstHAWC_InitInputTypeData%dx = SrcHAWC_InitInputTypeData%dx - DstHAWC_InitInputTypeData%dy = SrcHAWC_InitInputTypeData%dy - DstHAWC_InitInputTypeData%dz = SrcHAWC_InitInputTypeData%dz - CALL InflowWind_IO_Copygrid3d_initinputtype( SrcHAWC_InitInputTypeData%G3D, DstHAWC_InitInputTypeData%G3D, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE InflowWind_IO_CopyHAWC_InitInputType - - SUBROUTINE InflowWind_IO_DestroyHAWC_InitInputType( HAWC_InitInputTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(HAWC_InitInputType), INTENT(INOUT) :: HAWC_InitInputTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_IO_DestroyHAWC_InitInputType' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL InflowWind_IO_Destroygrid3d_initinputtype( HAWC_InitInputTypeData%G3D, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE InflowWind_IO_DestroyHAWC_InitInputType - - SUBROUTINE InflowWind_IO_PackHAWC_InitInputType( 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(HAWC_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 = 'InflowWind_IO_PackHAWC_InitInputType' - ! 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 + SIZE(InData%WindFileName)*LEN(InData%WindFileName) ! WindFileName - Int_BufSz = Int_BufSz + 1 ! nx - Int_BufSz = Int_BufSz + 1 ! ny - Int_BufSz = Int_BufSz + 1 ! nz - Re_BufSz = Re_BufSz + 1 ! dx - Re_BufSz = Re_BufSz + 1 ! dy - Re_BufSz = Re_BufSz + 1 ! dz - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! G3D: size of buffers for each call to pack subtype - CALL InflowWind_IO_Packgrid3d_initinputtype( Re_Buf, Db_Buf, Int_Buf, InData%G3D, ErrStat2, ErrMsg2, .TRUE. ) ! G3D - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! G3D - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! G3D - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! G3D - 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 i1 = LBOUND(InData%WindFileName,1), UBOUND(InData%WindFileName,1) - DO I = 1, LEN(InData%WindFileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%WindFileName(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - IntKiBuf(Int_Xferred) = InData%nx - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%ny - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nz - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%dx - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%dy - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%dz - Re_Xferred = Re_Xferred + 1 - CALL InflowWind_IO_Packgrid3d_initinputtype( Re_Buf, Db_Buf, Int_Buf, InData%G3D, ErrStat2, ErrMsg2, OnlySize ) ! G3D - 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 InflowWind_IO_PackHAWC_InitInputType - - SUBROUTINE InflowWind_IO_UnPackHAWC_InitInputType( 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(HAWC_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 = 'InflowWind_IO_UnPackHAWC_InitInputType' - ! 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%WindFileName,1) - i1_u = UBOUND(OutData%WindFileName,1) - DO i1 = LBOUND(OutData%WindFileName,1), UBOUND(OutData%WindFileName,1) - DO I = 1, LEN(OutData%WindFileName) - OutData%WindFileName(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - OutData%nx = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%ny = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nz = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%dx = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%dy = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%dz = ReKiBuf(Re_Xferred) - Re_Xferred = Re_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 InflowWind_IO_Unpackgrid3d_initinputtype( Re_Buf, Db_Buf, Int_Buf, OutData%G3D, ErrStat2, ErrMsg2 ) ! G3D - 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 InflowWind_IO_UnPackHAWC_InitInputType - - SUBROUTINE InflowWind_IO_CopyUser_InitInputType( SrcUser_InitInputTypeData, DstUser_InitInputTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(User_InitInputType), INTENT(IN) :: SrcUser_InitInputTypeData - TYPE(User_InitInputType), INTENT(INOUT) :: DstUser_InitInputTypeData - 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 = 'InflowWind_IO_CopyUser_InitInputType' -! + ErrMsg = '' + DstGrid3D_InitInputTypeData%ScaleMethod = SrcGrid3D_InitInputTypeData%ScaleMethod + DstGrid3D_InitInputTypeData%SF = SrcGrid3D_InitInputTypeData%SF + DstGrid3D_InitInputTypeData%SigmaF = SrcGrid3D_InitInputTypeData%SigmaF + DstGrid3D_InitInputTypeData%WindProfileType = SrcGrid3D_InitInputTypeData%WindProfileType + DstGrid3D_InitInputTypeData%RefHt = SrcGrid3D_InitInputTypeData%RefHt + DstGrid3D_InitInputTypeData%URef = SrcGrid3D_InitInputTypeData%URef + DstGrid3D_InitInputTypeData%PLExp = SrcGrid3D_InitInputTypeData%PLExp + DstGrid3D_InitInputTypeData%VLinShr = SrcGrid3D_InitInputTypeData%VLinShr + DstGrid3D_InitInputTypeData%HLinShr = SrcGrid3D_InitInputTypeData%HLinShr + DstGrid3D_InitInputTypeData%RefLength = SrcGrid3D_InitInputTypeData%RefLength + DstGrid3D_InitInputTypeData%Z0 = SrcGrid3D_InitInputTypeData%Z0 + DstGrid3D_InitInputTypeData%XOffset = SrcGrid3D_InitInputTypeData%XOffset +end subroutine + +subroutine InflowWind_IO_DestroyGrid3D_InitInputType(Grid3D_InitInputTypeData, ErrStat, ErrMsg) + type(Grid3D_InitInputType), intent(inout) :: Grid3D_InitInputTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'InflowWind_IO_DestroyGrid3D_InitInputType' ErrStat = ErrID_None - ErrMsg = "" - DstUser_InitInputTypeData%Dummy = SrcUser_InitInputTypeData%Dummy - END SUBROUTINE InflowWind_IO_CopyUser_InitInputType - - SUBROUTINE InflowWind_IO_DestroyUser_InitInputType( User_InitInputTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(User_InitInputType), INTENT(INOUT) :: User_InitInputTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_IO_DestroyUser_InitInputType' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE InflowWind_IO_DestroyUser_InitInputType - - SUBROUTINE InflowWind_IO_PackUser_InitInputType( 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(User_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 = 'InflowWind_IO_PackUser_InitInputType' - ! 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 InflowWind_IO_PackUser_InitInputType - - SUBROUTINE InflowWind_IO_UnPackUser_InitInputType( 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(User_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 = 'InflowWind_IO_UnPackUser_InitInputType' - ! 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 - END SUBROUTINE InflowWind_IO_UnPackUser_InitInputType - - SUBROUTINE InflowWind_IO_CopyGrid4D_InitInputType( SrcGrid4D_InitInputTypeData, DstGrid4D_InitInputTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Grid4D_InitInputType), INTENT(IN) :: SrcGrid4D_InitInputTypeData - TYPE(Grid4D_InitInputType), INTENT(INOUT) :: DstGrid4D_InitInputTypeData - 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 = 'InflowWind_IO_CopyGrid4D_InitInputType' -! + ErrMsg = '' +end subroutine + +subroutine InflowWind_IO_PackGrid3D_InitInputType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Grid3D_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'InflowWind_IO_PackGrid3D_InitInputType' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%ScaleMethod) + call RegPack(RF, InData%SF) + call RegPack(RF, InData%SigmaF) + call RegPack(RF, InData%WindProfileType) + call RegPack(RF, InData%RefHt) + call RegPack(RF, InData%URef) + call RegPack(RF, InData%PLExp) + call RegPack(RF, InData%VLinShr) + call RegPack(RF, InData%HLinShr) + call RegPack(RF, InData%RefLength) + call RegPack(RF, InData%Z0) + call RegPack(RF, InData%XOffset) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine InflowWind_IO_UnPackGrid3D_InitInputType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Grid3D_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'InflowWind_IO_UnPackGrid3D_InitInputType' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%ScaleMethod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SigmaF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WindProfileType); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RefHt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%URef); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PLExp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VLinShr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HLinShr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RefLength); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Z0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%XOffset); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine InflowWind_IO_CopyTurbSim_InitInputType(SrcTurbSim_InitInputTypeData, DstTurbSim_InitInputTypeData, CtrlCode, ErrStat, ErrMsg) + type(TurbSim_InitInputType), intent(in) :: SrcTurbSim_InitInputTypeData + type(TurbSim_InitInputType), intent(inout) :: DstTurbSim_InitInputTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'InflowWind_IO_CopyTurbSim_InitInputType' ErrStat = ErrID_None - ErrMsg = "" - DstGrid4D_InitInputTypeData%n = SrcGrid4D_InitInputTypeData%n - DstGrid4D_InitInputTypeData%delta = SrcGrid4D_InitInputTypeData%delta - DstGrid4D_InitInputTypeData%pZero = SrcGrid4D_InitInputTypeData%pZero - END SUBROUTINE InflowWind_IO_CopyGrid4D_InitInputType - - SUBROUTINE InflowWind_IO_DestroyGrid4D_InitInputType( Grid4D_InitInputTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(Grid4D_InitInputType), INTENT(INOUT) :: Grid4D_InitInputTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_IO_DestroyGrid4D_InitInputType' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE InflowWind_IO_DestroyGrid4D_InitInputType - - SUBROUTINE InflowWind_IO_PackGrid4D_InitInputType( 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(Grid4D_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 = 'InflowWind_IO_PackGrid4D_InitInputType' - ! 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 + SIZE(InData%n) ! n - Re_BufSz = Re_BufSz + SIZE(InData%delta) ! delta - Re_BufSz = Re_BufSz + SIZE(InData%pZero) ! pZero - 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%n,1), UBOUND(InData%n,1) - IntKiBuf(Int_Xferred) = InData%n(i1) - Int_Xferred = Int_Xferred + 1 - END DO - DO i1 = LBOUND(InData%delta,1), UBOUND(InData%delta,1) - ReKiBuf(Re_Xferred) = InData%delta(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%pZero,1), UBOUND(InData%pZero,1) - ReKiBuf(Re_Xferred) = InData%pZero(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END SUBROUTINE InflowWind_IO_PackGrid4D_InitInputType - - SUBROUTINE InflowWind_IO_UnPackGrid4D_InitInputType( 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(Grid4D_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 = 'InflowWind_IO_UnPackGrid4D_InitInputType' - ! 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%n,1) - i1_u = UBOUND(OutData%n,1) - DO i1 = LBOUND(OutData%n,1), UBOUND(OutData%n,1) - OutData%n(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - i1_l = LBOUND(OutData%delta,1) - i1_u = UBOUND(OutData%delta,1) - DO i1 = LBOUND(OutData%delta,1), UBOUND(OutData%delta,1) - OutData%delta(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%pZero,1) - i1_u = UBOUND(OutData%pZero,1) - DO i1 = LBOUND(OutData%pZero,1), UBOUND(OutData%pZero,1) - OutData%pZero(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END SUBROUTINE InflowWind_IO_UnPackGrid4D_InitInputType - - SUBROUTINE InflowWind_IO_CopyPoints_InitInputType( SrcPoints_InitInputTypeData, DstPoints_InitInputTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Points_InitInputType), INTENT(IN) :: SrcPoints_InitInputTypeData - TYPE(Points_InitInputType), INTENT(INOUT) :: DstPoints_InitInputTypeData - 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 = 'InflowWind_IO_CopyPoints_InitInputType' -! + ErrMsg = '' + DstTurbSim_InitInputTypeData%WindFileName = SrcTurbSim_InitInputTypeData%WindFileName +end subroutine + +subroutine InflowWind_IO_DestroyTurbSim_InitInputType(TurbSim_InitInputTypeData, ErrStat, ErrMsg) + type(TurbSim_InitInputType), intent(inout) :: TurbSim_InitInputTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'InflowWind_IO_DestroyTurbSim_InitInputType' ErrStat = ErrID_None - ErrMsg = "" - DstPoints_InitInputTypeData%NumWindPoints = SrcPoints_InitInputTypeData%NumWindPoints - END SUBROUTINE InflowWind_IO_CopyPoints_InitInputType - - SUBROUTINE InflowWind_IO_DestroyPoints_InitInputType( Points_InitInputTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(Points_InitInputType), INTENT(INOUT) :: Points_InitInputTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_IO_DestroyPoints_InitInputType' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE InflowWind_IO_DestroyPoints_InitInputType - - SUBROUTINE InflowWind_IO_PackPoints_InitInputType( 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(Points_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 = 'InflowWind_IO_PackPoints_InitInputType' - ! 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 ! NumWindPoints - 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%NumWindPoints - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE InflowWind_IO_PackPoints_InitInputType - - SUBROUTINE InflowWind_IO_UnPackPoints_InitInputType( 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(Points_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 = 'InflowWind_IO_UnPackPoints_InitInputType' - ! 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%NumWindPoints = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE InflowWind_IO_UnPackPoints_InitInputType - + ErrMsg = '' +end subroutine + +subroutine InflowWind_IO_PackTurbSim_InitInputType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(TurbSim_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'InflowWind_IO_PackTurbSim_InitInputType' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%WindFileName) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine InflowWind_IO_UnPackTurbSim_InitInputType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(TurbSim_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'InflowWind_IO_UnPackTurbSim_InitInputType' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%WindFileName); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine InflowWind_IO_CopyBladed_InitInputType(SrcBladed_InitInputTypeData, DstBladed_InitInputTypeData, CtrlCode, ErrStat, ErrMsg) + type(Bladed_InitInputType), intent(in) :: SrcBladed_InitInputTypeData + type(Bladed_InitInputType), intent(inout) :: DstBladed_InitInputTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'InflowWind_IO_CopyBladed_InitInputType' + ErrStat = ErrID_None + ErrMsg = '' + DstBladed_InitInputTypeData%WindFileName = SrcBladed_InitInputTypeData%WindFileName + DstBladed_InitInputTypeData%WindType = SrcBladed_InitInputTypeData%WindType + DstBladed_InitInputTypeData%NativeBladedFmt = SrcBladed_InitInputTypeData%NativeBladedFmt + DstBladed_InitInputTypeData%TowerFileExist = SrcBladed_InitInputTypeData%TowerFileExist + DstBladed_InitInputTypeData%TurbineID = SrcBladed_InitInputTypeData%TurbineID + DstBladed_InitInputTypeData%FixedWindFileRootName = SrcBladed_InitInputTypeData%FixedWindFileRootName +end subroutine + +subroutine InflowWind_IO_DestroyBladed_InitInputType(Bladed_InitInputTypeData, ErrStat, ErrMsg) + type(Bladed_InitInputType), intent(inout) :: Bladed_InitInputTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'InflowWind_IO_DestroyBladed_InitInputType' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine InflowWind_IO_PackBladed_InitInputType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Bladed_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'InflowWind_IO_PackBladed_InitInputType' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%WindFileName) + call RegPack(RF, InData%WindType) + call RegPack(RF, InData%NativeBladedFmt) + call RegPack(RF, InData%TowerFileExist) + call RegPack(RF, InData%TurbineID) + call RegPack(RF, InData%FixedWindFileRootName) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine InflowWind_IO_UnPackBladed_InitInputType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Bladed_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'InflowWind_IO_UnPackBladed_InitInputType' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%WindFileName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WindType); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NativeBladedFmt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TowerFileExist); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TurbineID); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FixedWindFileRootName); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine InflowWind_IO_CopyBladed_InitOutputType(SrcBladed_InitOutputTypeData, DstBladed_InitOutputTypeData, CtrlCode, ErrStat, ErrMsg) + type(Bladed_InitOutputType), intent(in) :: SrcBladed_InitOutputTypeData + type(Bladed_InitOutputType), intent(inout) :: DstBladed_InitOutputTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'InflowWind_IO_CopyBladed_InitOutputType' + ErrStat = ErrID_None + ErrMsg = '' + DstBladed_InitOutputTypeData%PropagationDir = SrcBladed_InitOutputTypeData%PropagationDir + DstBladed_InitOutputTypeData%VFlowAngle = SrcBladed_InitOutputTypeData%VFlowAngle +end subroutine + +subroutine InflowWind_IO_DestroyBladed_InitOutputType(Bladed_InitOutputTypeData, ErrStat, ErrMsg) + type(Bladed_InitOutputType), intent(inout) :: Bladed_InitOutputTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'InflowWind_IO_DestroyBladed_InitOutputType' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine InflowWind_IO_PackBladed_InitOutputType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Bladed_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'InflowWind_IO_PackBladed_InitOutputType' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%PropagationDir) + call RegPack(RF, InData%VFlowAngle) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine InflowWind_IO_UnPackBladed_InitOutputType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Bladed_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'InflowWind_IO_UnPackBladed_InitOutputType' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%PropagationDir); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VFlowAngle); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine InflowWind_IO_CopyHAWC_InitInputType(SrcHAWC_InitInputTypeData, DstHAWC_InitInputTypeData, CtrlCode, ErrStat, ErrMsg) + type(HAWC_InitInputType), intent(in) :: SrcHAWC_InitInputTypeData + type(HAWC_InitInputType), intent(inout) :: DstHAWC_InitInputTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'InflowWind_IO_CopyHAWC_InitInputType' + ErrStat = ErrID_None + ErrMsg = '' + DstHAWC_InitInputTypeData%WindFileName = SrcHAWC_InitInputTypeData%WindFileName + DstHAWC_InitInputTypeData%nx = SrcHAWC_InitInputTypeData%nx + DstHAWC_InitInputTypeData%ny = SrcHAWC_InitInputTypeData%ny + DstHAWC_InitInputTypeData%nz = SrcHAWC_InitInputTypeData%nz + DstHAWC_InitInputTypeData%dx = SrcHAWC_InitInputTypeData%dx + DstHAWC_InitInputTypeData%dy = SrcHAWC_InitInputTypeData%dy + DstHAWC_InitInputTypeData%dz = SrcHAWC_InitInputTypeData%dz + call InflowWind_IO_CopyGrid3D_InitInputType(SrcHAWC_InitInputTypeData%G3D, DstHAWC_InitInputTypeData%G3D, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine InflowWind_IO_DestroyHAWC_InitInputType(HAWC_InitInputTypeData, ErrStat, ErrMsg) + type(HAWC_InitInputType), intent(inout) :: HAWC_InitInputTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'InflowWind_IO_DestroyHAWC_InitInputType' + ErrStat = ErrID_None + ErrMsg = '' + call InflowWind_IO_DestroyGrid3D_InitInputType(HAWC_InitInputTypeData%G3D, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine InflowWind_IO_PackHAWC_InitInputType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(HAWC_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'InflowWind_IO_PackHAWC_InitInputType' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%WindFileName) + call RegPack(RF, InData%nx) + call RegPack(RF, InData%ny) + call RegPack(RF, InData%nz) + call RegPack(RF, InData%dx) + call RegPack(RF, InData%dy) + call RegPack(RF, InData%dz) + call InflowWind_IO_PackGrid3D_InitInputType(RF, InData%G3D) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine InflowWind_IO_UnPackHAWC_InitInputType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(HAWC_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'InflowWind_IO_UnPackHAWC_InitInputType' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%WindFileName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ny); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nz); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%dx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%dy); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%dz); if (RegCheckErr(RF, RoutineName)) return + call InflowWind_IO_UnpackGrid3D_InitInputType(RF, OutData%G3D) ! G3D +end subroutine + +subroutine InflowWind_IO_CopyUser_InitInputType(SrcUser_InitInputTypeData, DstUser_InitInputTypeData, CtrlCode, ErrStat, ErrMsg) + type(User_InitInputType), intent(in) :: SrcUser_InitInputTypeData + type(User_InitInputType), intent(inout) :: DstUser_InitInputTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'InflowWind_IO_CopyUser_InitInputType' + ErrStat = ErrID_None + ErrMsg = '' + DstUser_InitInputTypeData%Dummy = SrcUser_InitInputTypeData%Dummy +end subroutine + +subroutine InflowWind_IO_DestroyUser_InitInputType(User_InitInputTypeData, ErrStat, ErrMsg) + type(User_InitInputType), intent(inout) :: User_InitInputTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'InflowWind_IO_DestroyUser_InitInputType' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine InflowWind_IO_PackUser_InitInputType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(User_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'InflowWind_IO_PackUser_InitInputType' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%Dummy) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine InflowWind_IO_UnPackUser_InitInputType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(User_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'InflowWind_IO_UnPackUser_InitInputType' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%Dummy); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine InflowWind_IO_CopyGrid4D_InitInputType(SrcGrid4D_InitInputTypeData, DstGrid4D_InitInputTypeData, CtrlCode, ErrStat, ErrMsg) + type(Grid4D_InitInputType), intent(in) :: SrcGrid4D_InitInputTypeData + type(Grid4D_InitInputType), intent(inout) :: DstGrid4D_InitInputTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(5), UB(5) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'InflowWind_IO_CopyGrid4D_InitInputType' + ErrStat = ErrID_None + ErrMsg = '' + DstGrid4D_InitInputTypeData%n = SrcGrid4D_InitInputTypeData%n + DstGrid4D_InitInputTypeData%delta = SrcGrid4D_InitInputTypeData%delta + DstGrid4D_InitInputTypeData%pZero = SrcGrid4D_InitInputTypeData%pZero + DstGrid4D_InitInputTypeData%Vel => SrcGrid4D_InitInputTypeData%Vel +end subroutine + +subroutine InflowWind_IO_DestroyGrid4D_InitInputType(Grid4D_InitInputTypeData, ErrStat, ErrMsg) + type(Grid4D_InitInputType), intent(inout) :: Grid4D_InitInputTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'InflowWind_IO_DestroyGrid4D_InitInputType' + ErrStat = ErrID_None + ErrMsg = '' + nullify(Grid4D_InitInputTypeData%Vel) +end subroutine + +subroutine InflowWind_IO_PackGrid4D_InitInputType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Grid4D_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'InflowWind_IO_PackGrid4D_InitInputType' + logical :: PtrInIndex + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%n) + call RegPack(RF, InData%delta) + call RegPack(RF, InData%pZero) + call RegPackPtr(RF, InData%Vel) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine InflowWind_IO_UnPackGrid4D_InitInputType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Grid4D_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'InflowWind_IO_UnPackGrid4D_InitInputType' + integer(B4Ki) :: LB(5), UB(5) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(B8Ki) :: PtrIdx + type(c_ptr) :: Ptr + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%n); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%delta); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%pZero); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackPtr(RF, OutData%Vel, LB, UB); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine InflowWind_IO_CopyPoints_InitInputType(SrcPoints_InitInputTypeData, DstPoints_InitInputTypeData, CtrlCode, ErrStat, ErrMsg) + type(Points_InitInputType), intent(in) :: SrcPoints_InitInputTypeData + type(Points_InitInputType), intent(inout) :: DstPoints_InitInputTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'InflowWind_IO_CopyPoints_InitInputType' + ErrStat = ErrID_None + ErrMsg = '' + DstPoints_InitInputTypeData%NumWindPoints = SrcPoints_InitInputTypeData%NumWindPoints +end subroutine + +subroutine InflowWind_IO_DestroyPoints_InitInputType(Points_InitInputTypeData, ErrStat, ErrMsg) + type(Points_InitInputType), intent(inout) :: Points_InitInputTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'InflowWind_IO_DestroyPoints_InitInputType' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine InflowWind_IO_PackPoints_InitInputType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Points_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'InflowWind_IO_PackPoints_InitInputType' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%NumWindPoints) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine InflowWind_IO_UnPackPoints_InitInputType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Points_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'InflowWind_IO_UnPackPoints_InitInputType' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%NumWindPoints); if (RegCheckErr(RF, RoutineName)) return +end subroutine END MODULE InflowWind_IO_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/inflowwind/src/InflowWind_Subs.f90 b/modules/inflowwind/src/InflowWind_Subs.f90 index 305ff5c990..39e95f239b 100644 --- a/modules/inflowwind/src/InflowWind_Subs.f90 +++ b/modules/inflowwind/src/InflowWind_Subs.f90 @@ -490,22 +490,18 @@ SUBROUTINE InflowWind_ParseInputFileInfo( InputFileData, InFileInfo, PriPath, In ! LIDAR Sensor Type CALL ParseVar( InFileInfo, CurLine, "SensorType", InputFileData%SensorType, TmpErrStat, TmpErrMsg, UnEc ) - CALL SetErrStat( TmpErrStat, TmpErrMsg, ErrStat, ErrMsg, RoutineName ) IF (Failed()) RETURN ! Number of Range Gates CALL ParseVar( InFileInfo, CurLine, "NumPulseGate", InputFileData%NumPulseGate, TmpErrStat, TmpErrMsg, UnEc ) - CALL SetErrStat( TmpErrStat, TmpErrMsg, ErrStat, ErrMsg, RoutineName ) IF (Failed()) RETURN ! Pulse Gate Spacing CALL ParseVar( InFileInfo, CurLine, "PulseSpacing", InputFileData%PulseSpacing, TmpErrStat, TmpErrMsg, UnEc ) - CALL SetErrStat( TmpErrStat, TmpErrMsg, ErrStat, ErrMsg, RoutineName ) IF (Failed()) RETURN ! NumBeam: Number of points to output the lidar measured wind velocity (1 to 5) CALL ParseVar( InFileInfo, CurLine, "NumBeam", InputFileData%NumBeam, TmpErrStat, TmpErrMsg, UnEc ) - CALL SetErrStat( TmpErrStat, TmpErrMsg, ErrStat, ErrMsg, RoutineName ) if (Failed()) return ! Before proceeding, make sure that NumBeam makes sense @@ -515,53 +511,42 @@ SUBROUTINE InflowWind_ParseInputFileInfo( InputFileData, InFileInfo, PriPath, In RETURN ELSE ! Allocate space for the output location arrays: - CALL AllocAry( InputFileData%FocalDistanceX, InputFileData%NumBeam, 'NumBeam', TmpErrStat, TmpErrMsg ) - CALL SetErrStat( TmpErrStat, TmpErrMsg, ErrStat, ErrMsg, RoutineName ) - CALL AllocAry( InputFileData%FocalDistanceY, InputFileData%NumBeam, 'NumBeam', TmpErrStat, TmpErrMsg ) - CALL SetErrStat( TmpErrStat, TmpErrMsg, ErrStat, ErrMsg, RoutineName ) - CALL AllocAry( InputFileData%FocalDistanceZ, InputFileData%NumBeam, 'NumBeam', TmpErrStat, TmpErrMsg ) - CALL SetErrStat( TmpErrStat, TmpErrMsg, ErrStat, ErrMsg, RoutineName ) + CALL AllocAry( InputFileData%FocalDistanceX, InputFileData%NumBeam, 'FocalDistanceX', TmpErrStat, TmpErrMsg ); CALL SetErrStat( TmpErrStat, TmpErrMsg, ErrStat, ErrMsg, RoutineName ) + CALL AllocAry( InputFileData%FocalDistanceY, InputFileData%NumBeam, 'FocalDistanceY', TmpErrStat, TmpErrMsg ); CALL SetErrStat( TmpErrStat, TmpErrMsg, ErrStat, ErrMsg, RoutineName ) + CALL AllocAry( InputFileData%FocalDistanceZ, InputFileData%NumBeam, 'FocalDistanceZ', TmpErrStat, TmpErrMsg ); CALL SetErrStat( TmpErrStat, TmpErrMsg, ErrStat, ErrMsg, RoutineName ) if (Failed()) return ENDIF ! Focal Distance X CALL ParseAry( InFileInfo, CurLine, 'FocalDistanceX', InputFileData%FocalDistanceX, InputFileData%NumBeam, TmpErrStat, TmpErrMsg, UnEc ) - CALL SetErrStat( TmpErrStat, TmpErrMsg, ErrStat, ErrMsg, RoutineName ) if (Failed()) return ! Focal Distance Y CALL ParseAry( InFileInfo, CurLine, 'FocalDistanceY', InputFileData%FocalDistanceY, InputFileData%NumBeam, TmpErrStat, TmpErrMsg, UnEc ) - CALL SetErrStat( TmpErrStat, TmpErrMsg, ErrStat, ErrMsg, RoutineName ) if (Failed()) return ! Focal Distance Z CALL ParseAry( InFileInfo, CurLine, 'FocalDistanceZ', InputFileData%FocalDistanceZ, InputFileData%NumBeam, TmpErrStat, TmpErrMsg, UnEc ) - CALL SetErrStat( TmpErrStat, TmpErrMsg, ErrStat, ErrMsg, RoutineName ) if (Failed()) return ! Rotor Apex Offset Position - CALL ParseAry( InFileInfo, CurLine, "RotorApexOffsetPos", InputFileData%RotorApexOffsetPos, 1, TmpErrStat, TmpErrMsg, UnEc ) - CALL SetErrStat( TmpErrStat, TmpErrMsg, ErrStat, ErrMsg, RoutineName ) + CALL ParseAry( InFileInfo, CurLine, "RotorApexOffsetPos", InputFileData%RotorApexOffsetPos, size(InputFileData%RotorApexOffsetPos), TmpErrStat, TmpErrMsg, UnEc ) IF (Failed()) RETURN ! URefIni CALL ParseVar( InFileInfo, CurLine, "URefLid", InputFileData%URefLid, TmpErrStat, TmpErrMsg, UnEc ) - CALL SetErrStat( TmpErrStat, TmpErrMsg, ErrStat, ErrMsg, RoutineName ) IF (Failed()) RETURN ! Measurement Interval CALL ParseVar( InFileInfo, CurLine, "MeasurementInterval", InputFileData%MeasurementInterval, TmpErrStat, TmpErrMsg, UnEc ) - CALL SetErrStat( TmpErrStat, TmpErrMsg, ErrStat, ErrMsg, RoutineName ) IF (Failed()) RETURN ! Lidar Radial Vel - CALL ParseLoVar( InFileInfo, CurLine, "LidRadialVel", InputFileData%LidRadialVel, TmpErrStat, TmpErrMsg, UnEc ) - CALL SetErrStat( TmpErrStat, TmpErrMsg, ErrStat, ErrMsg, RoutineName ) + CALL ParseVar( InFileInfo, CurLine, "LidRadialVel", InputFileData%LidRadialVel, TmpErrStat, TmpErrMsg, UnEc ) IF (Failed()) RETURN ! Consider Hub Motion CALL ParseVar( InFileInfo, CurLine, "ConsiderHubMotion", InputFileData%ConsiderHubMotion, TmpErrStat, TmpErrMsg, UnEc ) - CALL SetErrStat( TmpErrStat, TmpErrMsg, ErrStat, ErrMsg, RoutineName ) IF (Failed()) RETURN @@ -679,7 +664,7 @@ SUBROUTINE InflowWind_ValidateInput( InitInp, InputFileData, ErrStat, ErrMsg ) ! make sure that all values for WindVzi are above ground. Set to 0 otherwise. - IF ( InitInp%MHK == 1 .or. InitInp%MHK == 2 ) THEN + IF ( InitInp%MHK /= MHK_None ) THEN DO I = 1, InputFileData%NWindVel IF ( InputFileData%WindVziList(I) >= InitInp%WtrDpth + InitInp%MSL2SWL ) THEN CALL SetErrStat( ErrID_Warn, ' Requested wind velocity at point ( '// & @@ -714,7 +699,7 @@ SUBROUTINE InflowWind_ValidateInput( InitInp, InputFileData, ErrStat, ErrMsg ) CALL Steady_ValidateInput() CASE ( Uniform_WindNumber ) - IF ( InitInp%WindType2UseInputFile ) CALL Uniform_ValidateInput() + CALL Uniform_ValidateInput() CASE ( TSFF_WindNumber ) CALL TSFF_ValidateInput() @@ -984,9 +969,6 @@ SUBROUTINE InflowWind_SetParameters( InitInp, InputFileData, p, m, ErrStat, ErrM !----------------------------------------------------------------- ! Copy over the general information that applies to everything !----------------------------------------------------------------- - - ! Copy the WindType over. - p%WindType = InputFileData%WindType ! Convert the PropagationDir to radians and store this. For simplicity, we will shift it to be between -pi and pi p%FlowField%PropagationDir = D2R * InputFileData%PropagationDir @@ -1306,15 +1288,17 @@ SUBROUTINE SetOutParam(OutList, p, ErrStat, ErrMsg ) InvalidOutput(WindAccZ) = .TRUE. end if - IF (p%lidar%SensorType == SensorType_SinglePoint) THEN - DO I=p%lidar%NumBeam+1,5 - InvalidOutput( WindMeas(I) ) = .TRUE. - END DO - ELSE - DO I=p%lidar%NumPulseGate+1,5 - InvalidOutput( WindMeas(I) ) = .TRUE. - END DO - END IF + if (p%lidar%SensorType /= SensorType_None) then + IF (p%lidar%SensorType == SensorType_SinglePoint) THEN + DO I=p%lidar%NumBeam+1,5 + InvalidOutput( WindMeas(I) ) = .TRUE. + END DO + ELSE + DO I=p%lidar%NumPulseGate+1,5 + InvalidOutput( WindMeas(I) ) = .TRUE. + END DO + END IF + endif ! ................. End of validity checking ................. @@ -1537,16 +1521,17 @@ SUBROUTINE SetAllOuts( p, y, m, ErrStat, ErrMsg ) !FIXME: Add in Wind1Dir etc. -- although those can be derived outside of FAST. - -IF ( p%lidar%SensorType == SensorType_SinglePoint) THEN - DO I = 1,MIN(5, p%lidar%NumBeam ) - m%AllOuts( WindMeas(I) ) = y%lidar%LidSpeed(I) - END DO - ELSE - DO I = 1,MIN(5, p%lidar%NumPulseGate ) - m%AllOuts( WindMeas(I) ) = y%lidar%LidSpeed(I) - END DO - END IF + if (p%lidar%SensorType /= SensorType_None) then + IF ( p%lidar%SensorType == SensorType_SinglePoint) THEN + DO I = 1,MIN(5, p%lidar%NumBeam ) + m%AllOuts( WindMeas(I) ) = y%lidar%LidSpeed(I) + END DO + ELSE + DO I = 1,MIN(5, p%lidar%NumPulseGate ) + m%AllOuts( WindMeas(I) ) = y%lidar%LidSpeed(I) + END DO + END IF + endif END SUBROUTINE SetAllOuts @@ -1647,12 +1632,9 @@ SUBROUTINE CalculateOutput( Time, InputData, p, x, xd, z, OtherStates, y, m, Fil CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None CHARACTER(*), PARAMETER :: RoutineName="CalculateOutput" - - ! Temporary variables for error handling INTEGER(IntKi) :: TmpErrStat CHARACTER(ErrMsgLen) :: TmpErrMsg ! temporary error message - ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -1660,7 +1642,6 @@ SUBROUTINE CalculateOutput( Time, InputData, p, x, xd, z, OtherStates, y, m, Fil CALL IfW_FlowField_GetVelAcc(p%FlowField, 0, Time, InputData%PositionXYZ, & y%VelocityUVW, y%AccelUVW, TmpErrStat, TmpErrMsg) CALL SetErrStat(TmpErrStat, TmpErrMsg, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev) RETURN ! Get velocities and accelerations for OutList variables, no error check IF ( p%NWindVel >= 1_IntKi .AND. FillWrOut ) THEN @@ -1671,16 +1652,9 @@ SUBROUTINE CalculateOutput( Time, InputData, p, x, xd, z, OtherStates, y, m, Fil END SUBROUTINE CalculateOutput !==================================================================================================== +!FIXME: is this routine necessary anymore? !> this routine calculates a rotor-averaged mean velocity, DiskVel -SUBROUTINE InflowWind_GetSpatialAverage( Time, InputData, p, x, xd, z, OtherStates, m, MeanVelocity, ErrStat, ErrMsg ) - - - IMPLICIT NONE - - CHARACTER(*), PARAMETER :: RoutineName="InflowWind_GetSpatialAverage" - - - ! Inputs / Outputs +SUBROUTINE InflowWind_GetRotorSpatialAverage( Time, InputData, p, x, xd, z, OtherStates, m, MeanVelocity, ErrStat, ErrMsg ) REAL(DbKi), INTENT(IN ) :: Time !< Current simulation time in seconds TYPE(InflowWind_InputType), INTENT(IN ) :: InputData !< Inputs at Time @@ -1690,63 +1664,50 @@ SUBROUTINE InflowWind_GetSpatialAverage( Time, InputData, p, x, xd, z, OtherStat TYPE(InflowWind_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at Time TYPE(InflowWind_OtherStateType), INTENT(IN ) :: OtherStates !< Other states at Time TYPE(InflowWind_MiscVarType), INTENT(INOUT) :: m !< misc/optimization variables - REAL(ReKi), INTENT( OUT) :: MeanVelocity(3) !< at InputPosition - + REAL(ReKi), INTENT( OUT) :: MeanVelocity(3) !< at InputPosition INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + CHARACTER(*),PARAMETER :: RoutineName = "InflowWind_GetRotorSpatialAverage" + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + INTEGER(IntKi) :: I + REAL(ReKi), ALLOCATABLE :: acc(:,:) ! acceleration, unallocated so it won't be calculated - - ! Local variables - INTEGER(IntKi) :: I !< Generic counters - - - ! Temporary variables for error handling - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary error message - LOGICAL, PARAMETER :: FillWrOut = .false. - - - - ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" MeanVelocity = 0.0_ReKi - !----------------------------------------------------------------------- - ! Points coordinate transforms from to global to aligned with hub orientation - !----------------------------------------------------------------------- + !---------------------------------------------------------------------------- + ! Points coordinate transforms from to global to aligned with hub orientation + !---------------------------------------------------------------------------- + m%u_Avg%HubPosition = InputData%HubPosition m%u_Avg%HubOrientation = InputData%HubOrientation do i=1,size(m%u_Avg%PositionXYZ,DIM=2) - m%u_Avg%PositionXYZ(:,i) = matmul(InputData%HubOrientation,p%PositionAvg(:,i)) + InputData%HubPosition + m%u_Avg%PositionXYZ(:,i) = InputData%HubPosition + & + matmul(InputData%HubOrientation,p%PositionAvg(:,i)) end do - CALL CalculateOutput( Time, m%u_Avg, p, x, xd, z, OtherStates, m%y_Avg, m, FillWrOut, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + !---------------------------------------------------------------------------- + ! Calculate wind velocities at average positions + !---------------------------------------------------------------------------- - do i=1,size(m%u_Avg%PositionXYZ,DIM=2) - MeanVelocity = MeanVelocity + m%y_Avg%VelocityUVW(:,i) - end do - MeanVelocity = MeanVelocity / REAL(size(m%u_Avg%PositionXYZ,DIM=2),ReKi) - - - RETURN + CALL IfW_FlowField_GetVelAcc(p%FlowField, 0, Time, m%u_Avg%PositionXYZ, & + m%y_Avg%VelocityUVW, acc, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) -!............................ -END SUBROUTINE InflowWind_GetSpatialAverage + !---------------------------------------------------------------------------- + ! Calculate average velocity over all positions + !---------------------------------------------------------------------------- + + MeanVelocity = sum(m%y_Avg%VelocityUVW, dim=2) / REAL(IfW_NumPtsAvg,ReKi) + +END SUBROUTINE InflowWind_GetRotorSpatialAverage !==================================================================================================== !> this routine calculates a rotor-averaged mean velocity, DiskVel SUBROUTINE InflowWind_GetHubValues( Time, InputData, p, x, xd, z, OtherStates, m, Velocity, ErrStat, ErrMsg ) - - - IMPLICIT NONE - - CHARACTER(*), PARAMETER :: RoutineName="InflowWind_GetHubValues" - - - ! Inputs / Outputs - REAL(DbKi), INTENT(IN ) :: Time !< Current simulation time in seconds TYPE(InflowWind_InputType), INTENT(IN ) :: InputData !< Inputs at Time TYPE(InflowWind_ParameterType), INTENT(IN ) :: p !< Parameters @@ -1756,42 +1717,27 @@ SUBROUTINE InflowWind_GetHubValues( Time, InputData, p, x, xd, z, OtherStates, m TYPE(InflowWind_OtherStateType), INTENT(IN ) :: OtherStates !< Other states at Time TYPE(InflowWind_MiscVarType), INTENT(INOUT) :: m !< misc/optimization variables REAL(ReKi), INTENT( OUT) :: Velocity(3) !< at InputPosition - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + CHARACTER(*),PARAMETER :: RoutineName="InflowWind_GetHubValues" + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary error message + REAL(ReKi), ALLOCATABLE :: acc(:,:) ! acceleration, unallocated so it won't be calculated - - ! Local variables - INTEGER(IntKi) :: I !< Generic counters - - - ! Temporary variables for error handling - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary error message - LOGICAL, PARAMETER :: FillWrOut = .false. - - - - ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" - !----------------------------------------------------------------------- - ! Calculate values at the hub: - !----------------------------------------------------------------------- m%u_Hub%HubPosition = InputData%HubPosition m%u_Hub%HubOrientation = InputData%HubOrientation - m%u_Hub%PositionXYZ(:,1) = InputData%HubPosition - - CALL CalculateOutput( Time, m%u_Hub, p, x, xd, z, OtherStates, m%y_Hub, m, FillWrOut, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - + + CALL IfW_FlowField_GetVelAcc(p%FlowField, 0, Time, m%u_Hub%PositionXYZ, & + m%y_Hub%VelocityUVW, acc, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + Velocity = m%y_Hub%VelocityUVW(:,1) - - RETURN -!............................ END SUBROUTINE InflowWind_GetHubValues !==================================================================================================== !> this routine calculates the mean wind speed diff --git a/modules/inflowwind/src/InflowWind_Types.f90 b/modules/inflowwind/src/InflowWind_Types.f90 index a4384becf7..646d366064 100644 --- a/modules/inflowwind/src/InflowWind_Types.f90 +++ b/modules/inflowwind/src/InflowWind_Types.f90 @@ -31,6 +31,7 @@ !! unpack routines associated with each defined data type. This code is automatically generated by the FAST Registry. MODULE InflowWind_Types !--------------------------------------------------------------------------------------------------------------------------------- +USE IfW_FlowField_Types USE InflowWind_IO_Types USE Lidar_Types USE NWTC_Library @@ -49,51 +50,51 @@ MODULE InflowWind_Types INTEGER(IntKi), PUBLIC, PARAMETER :: IfW_NumPtsAvg = 144 ! Number of points averaged for rotor-average wind speed [-] ! ========= InflowWind_InputFile ======= TYPE, PUBLIC :: InflowWind_InputFile - LOGICAL :: EchoFlag !< Echo the input file [-] + LOGICAL :: EchoFlag = .false. !< Echo the input file [-] INTEGER(IntKi) :: WindType = 0 !< Type of windfile [-] - REAL(ReKi) :: PropagationDir !< Direction of wind propagation (meteorological direction) [(degrees)] - REAL(ReKi) :: VFlowAngle !< Vertical (upflow) angle [degrees] + REAL(ReKi) :: PropagationDir = 0.0_ReKi !< Direction of wind propagation (meteorological direction) [(degrees)] + REAL(ReKi) :: VFlowAngle = 0.0_ReKi !< Vertical (upflow) angle [degrees] LOGICAL :: VelInterpCubic = .FALSE. !< Use cubic interpolation for velocity in time (false=linear, true=cubic) [Used with WindType=2,3,4,5,7] [-] - INTEGER(IntKi) :: NWindVel !< Number of points to output the wind velocity (0 to 9) [-] + INTEGER(IntKi) :: NWindVel = 0_IntKi !< Number of points to output the wind velocity (0 to 9) [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: WindVxiList !< List of X coordinates for wind velocity measurements [meters] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: WindVyiList !< List of Y coordinates for wind velocity measurements [meters] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: WindVziList !< List of Z coordinates for wind velocity measurements [meters] - REAL(ReKi) :: Steady_HWindSpeed !< Steady wind -- horizontal windspeed [meters/s] - REAL(ReKi) :: Steady_RefHt !< Steady wind -- reference height [meters] - REAL(ReKi) :: Steady_PLexp !< Steady wind -- power law exponent [-] + REAL(ReKi) :: Steady_HWindSpeed = 0.0_ReKi !< Steady wind -- horizontal windspeed [meters/s] + REAL(ReKi) :: Steady_RefHt = 0.0_ReKi !< Steady wind -- reference height [meters] + REAL(ReKi) :: Steady_PLexp = 0.0_ReKi !< Steady wind -- power law exponent [-] CHARACTER(1024) :: Uniform_FileName !< Uniform wind -- filename [-] - REAL(ReKi) :: Uniform_RefHt !< Uniform wind -- reference height [meters] - REAL(ReKi) :: Uniform_RefLength !< Uniform wind -- reference length [meters] + REAL(ReKi) :: Uniform_RefHt = 0.0_ReKi !< Uniform wind -- reference height [meters] + REAL(ReKi) :: Uniform_RefLength = 0.0_ReKi !< Uniform wind -- reference length [meters] CHARACTER(1024) :: TSFF_FileName !< TurbSim Full-Field -- filename [-] CHARACTER(1024) :: BladedFF_FileName !< Bladed-style Full-Field -- filename [-] - LOGICAL :: BladedFF_TowerFile !< Bladed-style Full-Field -- tower file exists [-] + LOGICAL :: BladedFF_TowerFile = .false. !< Bladed-style Full-Field -- tower file exists [-] LOGICAL :: CTTS_CoherentTurb = .FALSE. !< Coherent turbulence data exists [-] CHARACTER(1024) :: CTTS_FileName !< Name of coherent turbulence file [-] CHARACTER(1024) :: CTTS_Path !< Path to coherent turbulence binary data files [-] CHARACTER(1024) :: HAWC_FileName_u !< HAWC -- u component binary data file name [-] CHARACTER(1024) :: HAWC_FileName_v !< HAWC -- v component binary data file name [-] CHARACTER(1024) :: HAWC_FileName_w !< HAWC -- w component binary data file name [-] - INTEGER(IntKi) :: HAWC_nx !< HAWC -- number of grids in x direction [-] - INTEGER(IntKi) :: HAWC_ny !< HAWC -- number of grids in y direction [-] - INTEGER(IntKi) :: HAWC_nz !< HAWC -- number of grids in z direction [-] - REAL(ReKi) :: HAWC_dx !< HAWC -- distance between points in x direction [meters] - REAL(ReKi) :: HAWC_dy !< HAWC -- distance between points in y direction [meters] - REAL(ReKi) :: HAWC_dz !< HAWC -- distance between points in z direction [meters] - LOGICAL :: SumPrint !< Write summary info to a file .IfW.Sum [-] - INTEGER(IntKi) :: NumOuts !< Number of parameters in the output list (number of outputs requested) [-] + INTEGER(IntKi) :: HAWC_nx = 0_IntKi !< HAWC -- number of grids in x direction [-] + INTEGER(IntKi) :: HAWC_ny = 0_IntKi !< HAWC -- number of grids in y direction [-] + INTEGER(IntKi) :: HAWC_nz = 0_IntKi !< HAWC -- number of grids in z direction [-] + REAL(ReKi) :: HAWC_dx = 0.0_ReKi !< HAWC -- distance between points in x direction [meters] + REAL(ReKi) :: HAWC_dy = 0.0_ReKi !< HAWC -- distance between points in y direction [meters] + REAL(ReKi) :: HAWC_dz = 0.0_ReKi !< HAWC -- distance between points in z direction [meters] + LOGICAL :: SumPrint = .false. !< Write summary info to a file .IfW.Sum [-] + INTEGER(IntKi) :: NumOuts = 0_IntKi !< Number of parameters in the output list (number of outputs requested) [-] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: OutList !< List of user-requested output channels [-] - INTEGER(IntKi) :: SensorType !< Sensor type (for lidar/sensor module) [-] - INTEGER(IntKi) :: NumBeam !< Number of lidar beams [-] - INTEGER(IntKi) :: NumPulseGate !< The number of range gates to return wind speeds at [-] - REAL(ReKi) , DIMENSION(1:3) :: RotorApexOffsetPos !< Position of the lidar unit relative to the rotor apex of rotation [m] + INTEGER(IntKi) :: SensorType = 0_IntKi !< Sensor type (for lidar/sensor module) [-] + INTEGER(IntKi) :: NumBeam = 0_IntKi !< Number of lidar beams [-] + INTEGER(IntKi) :: NumPulseGate = 0_IntKi !< The number of range gates to return wind speeds at [-] + REAL(ReKi) , DIMENSION(1:3) :: RotorApexOffsetPos = 0.0_ReKi !< Position of the lidar unit relative to the rotor apex of rotation [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: FocalDistanceX !< LIDAR LOS focal distance co-ordinates in the x direction [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: FocalDistanceY !< LIDAR LOS focal distance co-ordinates in the y direction [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: FocalDistanceZ !< LIDAR LOS focal distance co-ordinates in the z direction [m] - REAL(ReKi) :: PulseSpacing !< Distance between range gates [m] - REAL(ReKi) :: MeasurementInterval !< Time between each measurement [s] - REAL(ReKi) :: URefLid !< Reference average wind speed for the lidar [m/s] - LOGICAL :: LidRadialVel !< TRUE => return radial component, FALSE => return 'x' direction estimate [-] - INTEGER(IntKi) :: ConsiderHubMotion !< Flag whether or not the hub motion's impact on the Lidar measurement will be considered [0 for no, 1 for yes] [-] + REAL(ReKi) :: PulseSpacing = 0.0_ReKi !< Distance between range gates [m] + REAL(ReKi) :: MeasurementInterval = 0.0_ReKi !< Time between each measurement [s] + REAL(ReKi) :: URefLid = 0.0_ReKi !< Reference average wind speed for the lidar [m/s] + LOGICAL :: LidRadialVel = .false. !< TRUE => return radial component, FALSE => return 'x' direction estimate [-] + INTEGER(IntKi) :: ConsiderHubMotion = 0_IntKi !< Flag whether or not the hub motion's impact on the Lidar measurement will be considered [0 for no, 1 for yes] [-] TYPE(Grid3D_InitInputType) :: FF !< scaling data [-] END TYPE InflowWind_InputFile ! ======================= @@ -102,23 +103,21 @@ MODULE InflowWind_Types CHARACTER(1024) :: InputFileName !< Name of the InflowWind input file to use [-] LOGICAL :: Linearize = .FALSE. !< Flag that tells this module if the glue code wants to linearize. [-] LOGICAL :: Use4Dext = .FALSE. !< Flag that tells this module if an external module will pass it 4-D velocity grids. [-] - INTEGER(IntKi) :: NumWindPoints !< Number of wind velocity points expected [-] + INTEGER(IntKi) :: NumWindPoints = 0_IntKi !< Number of wind velocity points expected [-] INTEGER(IntKi) :: TurbineID = 0 !< Wind turbine ID number in the fixed (DEFAULT) file name when FixedWindFileRootName = .TRUE. (used by FAST.Farm) [-] LOGICAL :: FixedWindFileRootName = .FALSE. !< Do the wind data files have a fixed (DEFAULT) file name? (used by FAST.Farm) [-] - LOGICAL :: UseInputFile = .TRUE. !< Should we read everthing from an input file, or do we get it some other way [-] CHARACTER(1024) :: RootName !< RootName for writing output files [-] - TYPE(FileInfoType) :: PassedFileData !< If we don't use the input file, pass everything through this [-] - LOGICAL :: WindType2UseInputFile = .TRUE. !< Flag for toggling file based IO in wind type 2. [-] - TYPE(FileInfoType) :: WindType2Data !< Optional slot for wind type 2 data if file IO is not used. [-] + INTEGER(IntKi) :: FilePassingMethod = 0 !< Method for file passing {0: None (read from file), 1: as FileInfoType to parse, 2: as InputFileType already parsed} [-] + TYPE(FileInfoType) :: PassedFileInfo !< If we don't use the input file, pass everything through this [FilePassingMethod = 1] [-] + TYPE(InflowWind_InputFile) :: PassedFileData !< If we don't use the input file, pass everything through this [FilePassingMethod = 2] [-] LOGICAL :: OutputAccel = .FALSE. !< Flag to output wind acceleration [-] TYPE(Lidar_InitInputType) :: lidar !< InitInput for lidar data [-] TYPE(Grid4D_InitInputType) :: FDext !< InitInput for 4D external wind data [-] - REAL(ReKi) :: RadAvg !< Radius (from hub) used for averaging wind speed [-] - INTEGER(IntKi) :: MHK !< MHK turbine type switch [-] - REAL(ReKi) :: WtrDpth !< Water depth [m] - REAL(ReKi) :: MSL2SWL !< Mean sea level to still water level [m] - INTEGER(IntKi) :: BoxExceedAllowIdx = -1 !< Extrapolate winds outside box starting at this index (for OLAF wakes and LidarSim) [-] - LOGICAL :: BoxExceedAllowF = .FALSE. !< Flag to allow Extrapolation winds outside box starting at this index (for OLAF wakes and LidarSim) [-] + REAL(ReKi) :: RadAvg = 0.0_ReKi !< Radius (from hub) used for averaging wind speed [-] + INTEGER(IntKi) :: MHK = 0_IntKi !< MHK turbine type switch [-] + REAL(ReKi) :: WtrDpth = 0.0_ReKi !< Water depth [m] + REAL(ReKi) :: MSL2SWL = 0.0_ReKi !< Mean sea level to still water level [m] + LOGICAL :: BoxExceedAllow = .FALSE. !< Flag to allow Extrapolation winds outside box starting at this index (for OLAF wakes and LidarSim) [-] LOGICAL :: LidarEnabled = .false. !< Enable LiDAR for this instance of InflowWind? (FAST.Farm, ADI, and InflowWind driver/library are not compatible) [-] END TYPE InflowWind_InitInputType ! ======================= @@ -133,18 +132,18 @@ MODULE InflowWind_Types 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) [-] + TYPE(FlowFieldType) , POINTER :: FlowField => NULL() !< Flow field data to represent all wind types [-] END TYPE InflowWind_InitOutputType ! ======================= ! ========= InflowWind_ParameterType ======= TYPE, PUBLIC :: InflowWind_ParameterType CHARACTER(1024) :: RootFileName !< Root of the InflowWind input filename [-] - INTEGER(IntKi) :: WindType = 0 !< Type of wind -- set to Undef_Wind initially [-] - REAL(DbKi) :: DT !< Time step for cont. state integration & disc. state update [seconds] + REAL(DbKi) :: DT = 0.0_R8Ki !< Time step for cont. state integration & disc. state update [seconds] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: WindViXYZprime !< List of XYZ coordinates for velocity measurements, translated to the wind coordinate system (prime coordinates). This equals MATMUL( RotToWind, ParamData%WindViXYZ ) [meters] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: WindViXYZ !< List of XYZ coordinates for wind velocity measurements, 3xNWindVel [meters] - TYPE(FlowFieldType) :: FlowField !< Parameters from Full-Field [-] + TYPE(FlowFieldType) , POINTER :: FlowField => NULL() !< Flow field data to represent all wind types [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PositionAvg !< (non-rotated) positions of points used for averaging wind speed [meters] - INTEGER(IntKi) :: NWindVel !< Number of points in the wind velocity list [-] + INTEGER(IntKi) :: NWindVel = 0_IntKi !< Number of points in the wind velocity list [-] 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 [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: OutParamLinIndx !< Index into WriteOutput for WindViXYZ in linearization analysis [-] @@ -156,8 +155,8 @@ MODULE InflowWind_Types TYPE, PUBLIC :: InflowWind_InputType REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PositionXYZ !< Array holding the input positions at a given timestep [meters] TYPE(Lidar_InputType) :: lidar !< Lidar data [-] - REAL(ReKi) , DIMENSION(1:3) :: HubPosition !< position of the hub (inertial frame) [m] - REAL(ReKi) , DIMENSION(1:3,1:3) :: HubOrientation !< orientation of the hub (direction cosine matrix) [-] + REAL(ReKi) , DIMENSION(1:3) :: HubPosition = 0.0_ReKi !< position of the hub (inertial frame) [m] + REAL(ReKi) , DIMENSION(1:3,1:3) :: HubOrientation = 0.0_ReKi !< orientation of the hub (direction cosine matrix) [-] END TYPE InflowWind_InputType ! ======================= ! ========= InflowWind_OutputType ======= @@ -165,29 +164,29 @@ MODULE InflowWind_Types REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: VelocityUVW !< Array holding the U,V,W velocity for a given timestep [meters/sec] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: AccelUVW !< Array holding the U,V,W acceleration for a given timestep [meters/sec] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: WriteOutput !< Array with values to output to file [-] - REAL(ReKi) , DIMENSION(1:3) :: DiskVel !< Vector holding the U,V,W average velocity of the disk [meters/sec] - REAL(ReKi) , DIMENSION(1:3) :: HubVel !< Vector holding the U,V,W velocity at the hub [meters/sec] + REAL(ReKi) , DIMENSION(1:3) :: DiskVel = 0.0_ReKi !< Vector holding the U,V,W average velocity of the disk [meters/sec] + REAL(ReKi) , DIMENSION(1:3) :: HubVel = 0.0_ReKi !< Vector holding the U,V,W velocity at the hub [meters/sec] TYPE(Lidar_OutputType) :: lidar !< Lidar data [-] END TYPE InflowWind_OutputType ! ======================= ! ========= InflowWind_ContinuousStateType ======= TYPE, PUBLIC :: InflowWind_ContinuousStateType - REAL(ReKi) :: DummyContState !< Remove this variable if you have continuous states [-] + REAL(ReKi) :: DummyContState = 0.0_ReKi !< Remove this variable if you have continuous states [-] END TYPE InflowWind_ContinuousStateType ! ======================= ! ========= InflowWind_DiscreteStateType ======= TYPE, PUBLIC :: InflowWind_DiscreteStateType - REAL(ReKi) :: DummyDiscState !< Remove this variable if you have discrete states [-] + REAL(ReKi) :: DummyDiscState = 0.0_ReKi !< Remove this variable if you have discrete states [-] END TYPE InflowWind_DiscreteStateType ! ======================= ! ========= InflowWind_ConstraintStateType ======= TYPE, PUBLIC :: InflowWind_ConstraintStateType - REAL(ReKi) :: DummyConstrState !< Remove this variable if you have constraint states [-] + REAL(ReKi) :: DummyConstrState = 0.0_ReKi !< Remove this variable if you have constraint states [-] END TYPE InflowWind_ConstraintStateType ! ======================= ! ========= InflowWind_OtherStateType ======= TYPE, PUBLIC :: InflowWind_OtherStateType - REAL(ReKi) :: DummyOtherState !< Remove this variable if you have other states [-] + REAL(ReKi) :: DummyOtherState = 0.0_ReKi !< Remove this variable if you have other states [-] END TYPE InflowWind_OtherStateType ! ======================= ! ========= InflowWind_MiscVarType ======= @@ -202,4969 +201,1347 @@ MODULE InflowWind_Types END TYPE InflowWind_MiscVarType ! ======================= CONTAINS - SUBROUTINE InflowWind_CopyInputFile( SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg ) - TYPE(InflowWind_InputFile), INTENT(IN) :: SrcInputFileData - TYPE(InflowWind_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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_CopyInputFile' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInputFileData%EchoFlag = SrcInputFileData%EchoFlag - DstInputFileData%WindType = SrcInputFileData%WindType - DstInputFileData%PropagationDir = SrcInputFileData%PropagationDir - DstInputFileData%VFlowAngle = SrcInputFileData%VFlowAngle - DstInputFileData%VelInterpCubic = SrcInputFileData%VelInterpCubic - DstInputFileData%NWindVel = SrcInputFileData%NWindVel -IF (ALLOCATED(SrcInputFileData%WindVxiList)) THEN - i1_l = LBOUND(SrcInputFileData%WindVxiList,1) - i1_u = UBOUND(SrcInputFileData%WindVxiList,1) - IF (.NOT. ALLOCATED(DstInputFileData%WindVxiList)) THEN - ALLOCATE(DstInputFileData%WindVxiList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%WindVxiList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%WindVxiList = SrcInputFileData%WindVxiList -ENDIF -IF (ALLOCATED(SrcInputFileData%WindVyiList)) THEN - i1_l = LBOUND(SrcInputFileData%WindVyiList,1) - i1_u = UBOUND(SrcInputFileData%WindVyiList,1) - IF (.NOT. ALLOCATED(DstInputFileData%WindVyiList)) THEN - ALLOCATE(DstInputFileData%WindVyiList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%WindVyiList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%WindVyiList = SrcInputFileData%WindVyiList -ENDIF -IF (ALLOCATED(SrcInputFileData%WindVziList)) THEN - i1_l = LBOUND(SrcInputFileData%WindVziList,1) - i1_u = UBOUND(SrcInputFileData%WindVziList,1) - IF (.NOT. ALLOCATED(DstInputFileData%WindVziList)) THEN - ALLOCATE(DstInputFileData%WindVziList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%WindVziList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%WindVziList = SrcInputFileData%WindVziList -ENDIF - DstInputFileData%Steady_HWindSpeed = SrcInputFileData%Steady_HWindSpeed - DstInputFileData%Steady_RefHt = SrcInputFileData%Steady_RefHt - DstInputFileData%Steady_PLexp = SrcInputFileData%Steady_PLexp - DstInputFileData%Uniform_FileName = SrcInputFileData%Uniform_FileName - DstInputFileData%Uniform_RefHt = SrcInputFileData%Uniform_RefHt - DstInputFileData%Uniform_RefLength = SrcInputFileData%Uniform_RefLength - DstInputFileData%TSFF_FileName = SrcInputFileData%TSFF_FileName - DstInputFileData%BladedFF_FileName = SrcInputFileData%BladedFF_FileName - DstInputFileData%BladedFF_TowerFile = SrcInputFileData%BladedFF_TowerFile - DstInputFileData%CTTS_CoherentTurb = SrcInputFileData%CTTS_CoherentTurb - DstInputFileData%CTTS_FileName = SrcInputFileData%CTTS_FileName - DstInputFileData%CTTS_Path = SrcInputFileData%CTTS_Path - DstInputFileData%HAWC_FileName_u = SrcInputFileData%HAWC_FileName_u - DstInputFileData%HAWC_FileName_v = SrcInputFileData%HAWC_FileName_v - DstInputFileData%HAWC_FileName_w = SrcInputFileData%HAWC_FileName_w - DstInputFileData%HAWC_nx = SrcInputFileData%HAWC_nx - DstInputFileData%HAWC_ny = SrcInputFileData%HAWC_ny - DstInputFileData%HAWC_nz = SrcInputFileData%HAWC_nz - DstInputFileData%HAWC_dx = SrcInputFileData%HAWC_dx - DstInputFileData%HAWC_dy = SrcInputFileData%HAWC_dy - DstInputFileData%HAWC_dz = SrcInputFileData%HAWC_dz - DstInputFileData%SumPrint = SrcInputFileData%SumPrint - 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%SensorType = SrcInputFileData%SensorType - DstInputFileData%NumBeam = SrcInputFileData%NumBeam - DstInputFileData%NumPulseGate = SrcInputFileData%NumPulseGate - DstInputFileData%RotorApexOffsetPos = SrcInputFileData%RotorApexOffsetPos -IF (ALLOCATED(SrcInputFileData%FocalDistanceX)) THEN - i1_l = LBOUND(SrcInputFileData%FocalDistanceX,1) - i1_u = UBOUND(SrcInputFileData%FocalDistanceX,1) - IF (.NOT. ALLOCATED(DstInputFileData%FocalDistanceX)) THEN - ALLOCATE(DstInputFileData%FocalDistanceX(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%FocalDistanceX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%FocalDistanceX = SrcInputFileData%FocalDistanceX -ENDIF -IF (ALLOCATED(SrcInputFileData%FocalDistanceY)) THEN - i1_l = LBOUND(SrcInputFileData%FocalDistanceY,1) - i1_u = UBOUND(SrcInputFileData%FocalDistanceY,1) - IF (.NOT. ALLOCATED(DstInputFileData%FocalDistanceY)) THEN - ALLOCATE(DstInputFileData%FocalDistanceY(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%FocalDistanceY.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%FocalDistanceY = SrcInputFileData%FocalDistanceY -ENDIF -IF (ALLOCATED(SrcInputFileData%FocalDistanceZ)) THEN - i1_l = LBOUND(SrcInputFileData%FocalDistanceZ,1) - i1_u = UBOUND(SrcInputFileData%FocalDistanceZ,1) - IF (.NOT. ALLOCATED(DstInputFileData%FocalDistanceZ)) THEN - ALLOCATE(DstInputFileData%FocalDistanceZ(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%FocalDistanceZ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%FocalDistanceZ = SrcInputFileData%FocalDistanceZ -ENDIF - DstInputFileData%PulseSpacing = SrcInputFileData%PulseSpacing - DstInputFileData%MeasurementInterval = SrcInputFileData%MeasurementInterval - DstInputFileData%URefLid = SrcInputFileData%URefLid - DstInputFileData%LidRadialVel = SrcInputFileData%LidRadialVel - DstInputFileData%ConsiderHubMotion = SrcInputFileData%ConsiderHubMotion - CALL InflowWind_IO_Copygrid3d_initinputtype( SrcInputFileData%FF, DstInputFileData%FF, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE InflowWind_CopyInputFile - - SUBROUTINE InflowWind_DestroyInputFile( InputFileData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(InflowWind_InputFile), INTENT(INOUT) :: InputFileData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_DestroyInputFile' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(InputFileData%WindVxiList)) THEN - DEALLOCATE(InputFileData%WindVxiList) -ENDIF -IF (ALLOCATED(InputFileData%WindVyiList)) THEN - DEALLOCATE(InputFileData%WindVyiList) -ENDIF -IF (ALLOCATED(InputFileData%WindVziList)) THEN - DEALLOCATE(InputFileData%WindVziList) -ENDIF -IF (ALLOCATED(InputFileData%OutList)) THEN - DEALLOCATE(InputFileData%OutList) -ENDIF -IF (ALLOCATED(InputFileData%FocalDistanceX)) THEN - DEALLOCATE(InputFileData%FocalDistanceX) -ENDIF -IF (ALLOCATED(InputFileData%FocalDistanceY)) THEN - DEALLOCATE(InputFileData%FocalDistanceY) -ENDIF -IF (ALLOCATED(InputFileData%FocalDistanceZ)) THEN - DEALLOCATE(InputFileData%FocalDistanceZ) -ENDIF - CALL InflowWind_IO_Destroygrid3d_initinputtype( InputFileData%FF, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE InflowWind_DestroyInputFile - - SUBROUTINE InflowWind_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(InflowWind_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 = 'InflowWind_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 ! EchoFlag - Int_BufSz = Int_BufSz + 1 ! WindType - Re_BufSz = Re_BufSz + 1 ! PropagationDir - Re_BufSz = Re_BufSz + 1 ! VFlowAngle - Int_BufSz = Int_BufSz + 1 ! VelInterpCubic - Int_BufSz = Int_BufSz + 1 ! NWindVel - Int_BufSz = Int_BufSz + 1 ! WindVxiList allocated yes/no - IF ( ALLOCATED(InData%WindVxiList) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WindVxiList upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WindVxiList) ! WindVxiList - END IF - Int_BufSz = Int_BufSz + 1 ! WindVyiList allocated yes/no - IF ( ALLOCATED(InData%WindVyiList) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WindVyiList upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WindVyiList) ! WindVyiList - END IF - Int_BufSz = Int_BufSz + 1 ! WindVziList allocated yes/no - IF ( ALLOCATED(InData%WindVziList) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WindVziList upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WindVziList) ! WindVziList - END IF - Re_BufSz = Re_BufSz + 1 ! Steady_HWindSpeed - Re_BufSz = Re_BufSz + 1 ! Steady_RefHt - Re_BufSz = Re_BufSz + 1 ! Steady_PLexp - Int_BufSz = Int_BufSz + 1*LEN(InData%Uniform_FileName) ! Uniform_FileName - Re_BufSz = Re_BufSz + 1 ! Uniform_RefHt - Re_BufSz = Re_BufSz + 1 ! Uniform_RefLength - Int_BufSz = Int_BufSz + 1*LEN(InData%TSFF_FileName) ! TSFF_FileName - Int_BufSz = Int_BufSz + 1*LEN(InData%BladedFF_FileName) ! BladedFF_FileName - Int_BufSz = Int_BufSz + 1 ! BladedFF_TowerFile - Int_BufSz = Int_BufSz + 1 ! CTTS_CoherentTurb - Int_BufSz = Int_BufSz + 1*LEN(InData%CTTS_FileName) ! CTTS_FileName - Int_BufSz = Int_BufSz + 1*LEN(InData%CTTS_Path) ! CTTS_Path - Int_BufSz = Int_BufSz + 1*LEN(InData%HAWC_FileName_u) ! HAWC_FileName_u - Int_BufSz = Int_BufSz + 1*LEN(InData%HAWC_FileName_v) ! HAWC_FileName_v - Int_BufSz = Int_BufSz + 1*LEN(InData%HAWC_FileName_w) ! HAWC_FileName_w - Int_BufSz = Int_BufSz + 1 ! HAWC_nx - Int_BufSz = Int_BufSz + 1 ! HAWC_ny - Int_BufSz = Int_BufSz + 1 ! HAWC_nz - Re_BufSz = Re_BufSz + 1 ! HAWC_dx - Re_BufSz = Re_BufSz + 1 ! HAWC_dy - Re_BufSz = Re_BufSz + 1 ! HAWC_dz - Int_BufSz = Int_BufSz + 1 ! SumPrint - 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 ! SensorType - Int_BufSz = Int_BufSz + 1 ! NumBeam - Int_BufSz = Int_BufSz + 1 ! NumPulseGate - Re_BufSz = Re_BufSz + SIZE(InData%RotorApexOffsetPos) ! RotorApexOffsetPos - Int_BufSz = Int_BufSz + 1 ! FocalDistanceX allocated yes/no - IF ( ALLOCATED(InData%FocalDistanceX) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! FocalDistanceX upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%FocalDistanceX) ! FocalDistanceX - END IF - Int_BufSz = Int_BufSz + 1 ! FocalDistanceY allocated yes/no - IF ( ALLOCATED(InData%FocalDistanceY) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! FocalDistanceY upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%FocalDistanceY) ! FocalDistanceY - END IF - Int_BufSz = Int_BufSz + 1 ! FocalDistanceZ allocated yes/no - IF ( ALLOCATED(InData%FocalDistanceZ) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! FocalDistanceZ upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%FocalDistanceZ) ! FocalDistanceZ - END IF - Re_BufSz = Re_BufSz + 1 ! PulseSpacing - Re_BufSz = Re_BufSz + 1 ! MeasurementInterval - Re_BufSz = Re_BufSz + 1 ! URefLid - Int_BufSz = Int_BufSz + 1 ! LidRadialVel - Int_BufSz = Int_BufSz + 1 ! ConsiderHubMotion - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! FF: size of buffers for each call to pack subtype - CALL InflowWind_IO_Packgrid3d_initinputtype( Re_Buf, Db_Buf, Int_Buf, InData%FF, ErrStat2, ErrMsg2, .TRUE. ) ! FF - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! FF - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! FF - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! FF - 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 - - IntKiBuf(Int_Xferred) = TRANSFER(InData%EchoFlag, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%WindType - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PropagationDir - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%VFlowAngle - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%VelInterpCubic, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NWindVel - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%WindVxiList) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WindVxiList,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WindVxiList,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WindVxiList,1), UBOUND(InData%WindVxiList,1) - ReKiBuf(Re_Xferred) = InData%WindVxiList(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WindVyiList) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WindVyiList,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WindVyiList,1) - Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WindVyiList,1), UBOUND(InData%WindVyiList,1) - ReKiBuf(Re_Xferred) = InData%WindVyiList(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WindVziList) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WindVziList,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WindVziList,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WindVziList,1), UBOUND(InData%WindVziList,1) - ReKiBuf(Re_Xferred) = InData%WindVziList(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%Steady_HWindSpeed - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Steady_RefHt - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Steady_PLexp - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(InData%Uniform_FileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%Uniform_FileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - ReKiBuf(Re_Xferred) = InData%Uniform_RefHt - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Uniform_RefLength - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(InData%TSFF_FileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%TSFF_FileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%BladedFF_FileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%BladedFF_FileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = TRANSFER(InData%BladedFF_TowerFile, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%CTTS_CoherentTurb, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%CTTS_FileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%CTTS_FileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%CTTS_Path) - IntKiBuf(Int_Xferred) = ICHAR(InData%CTTS_Path(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%HAWC_FileName_u) - IntKiBuf(Int_Xferred) = ICHAR(InData%HAWC_FileName_u(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%HAWC_FileName_v) - IntKiBuf(Int_Xferred) = ICHAR(InData%HAWC_FileName_v(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%HAWC_FileName_w) - IntKiBuf(Int_Xferred) = ICHAR(InData%HAWC_FileName_w(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = InData%HAWC_nx - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%HAWC_ny - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%HAWC_nz - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%HAWC_dx - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%HAWC_dy - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%HAWC_dz - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%SumPrint, IntKiBuf(1)) - Int_Xferred = Int_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 - IntKiBuf(Int_Xferred) = InData%SensorType - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumBeam - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumPulseGate - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%RotorApexOffsetPos,1), UBOUND(InData%RotorApexOffsetPos,1) - ReKiBuf(Re_Xferred) = InData%RotorApexOffsetPos(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%FocalDistanceX) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FocalDistanceX,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FocalDistanceX,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%FocalDistanceX,1), UBOUND(InData%FocalDistanceX,1) - ReKiBuf(Re_Xferred) = InData%FocalDistanceX(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%FocalDistanceY) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FocalDistanceY,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FocalDistanceY,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%FocalDistanceY,1), UBOUND(InData%FocalDistanceY,1) - ReKiBuf(Re_Xferred) = InData%FocalDistanceY(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%FocalDistanceZ) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FocalDistanceZ,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FocalDistanceZ,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%FocalDistanceZ,1), UBOUND(InData%FocalDistanceZ,1) - ReKiBuf(Re_Xferred) = InData%FocalDistanceZ(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%PulseSpacing - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MeasurementInterval - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%URefLid - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%LidRadialVel, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%ConsiderHubMotion - Int_Xferred = Int_Xferred + 1 - CALL InflowWind_IO_Packgrid3d_initinputtype( Re_Buf, Db_Buf, Int_Buf, InData%FF, ErrStat2, ErrMsg2, OnlySize ) ! FF - 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 InflowWind_PackInputFile - - SUBROUTINE InflowWind_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(InflowWind_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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_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%EchoFlag = TRANSFER(IntKiBuf(Int_Xferred), OutData%EchoFlag) - Int_Xferred = Int_Xferred + 1 - OutData%WindType = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%PropagationDir = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%VFlowAngle = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%VelInterpCubic = TRANSFER(IntKiBuf(Int_Xferred), OutData%VelInterpCubic) - Int_Xferred = Int_Xferred + 1 - OutData%NWindVel = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WindVxiList not allocated - Int_Xferred = Int_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%WindVxiList)) DEALLOCATE(OutData%WindVxiList) - ALLOCATE(OutData%WindVxiList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WindVxiList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WindVxiList,1), UBOUND(OutData%WindVxiList,1) - OutData%WindVxiList(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WindVyiList not allocated - Int_Xferred = Int_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%WindVyiList)) DEALLOCATE(OutData%WindVyiList) - ALLOCATE(OutData%WindVyiList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WindVyiList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WindVyiList,1), UBOUND(OutData%WindVyiList,1) - OutData%WindVyiList(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WindVziList not allocated - Int_Xferred = Int_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%WindVziList)) DEALLOCATE(OutData%WindVziList) - ALLOCATE(OutData%WindVziList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WindVziList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WindVziList,1), UBOUND(OutData%WindVziList,1) - OutData%WindVziList(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%Steady_HWindSpeed = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Steady_RefHt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Steady_PLexp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(OutData%Uniform_FileName) - OutData%Uniform_FileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%Uniform_RefHt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Uniform_RefLength = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(OutData%TSFF_FileName) - OutData%TSFF_FileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%BladedFF_FileName) - OutData%BladedFF_FileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%BladedFF_TowerFile = TRANSFER(IntKiBuf(Int_Xferred), OutData%BladedFF_TowerFile) - Int_Xferred = Int_Xferred + 1 - OutData%CTTS_CoherentTurb = TRANSFER(IntKiBuf(Int_Xferred), OutData%CTTS_CoherentTurb) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%CTTS_FileName) - OutData%CTTS_FileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%CTTS_Path) - OutData%CTTS_Path(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%HAWC_FileName_u) - OutData%HAWC_FileName_u(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%HAWC_FileName_v) - OutData%HAWC_FileName_v(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%HAWC_FileName_w) - OutData%HAWC_FileName_w(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%HAWC_nx = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%HAWC_ny = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%HAWC_nz = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%HAWC_dx = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%HAWC_dy = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%HAWC_dz = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SumPrint = TRANSFER(IntKiBuf(Int_Xferred), OutData%SumPrint) - Int_Xferred = Int_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 - OutData%SensorType = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumBeam = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumPulseGate = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%RotorApexOffsetPos,1) - i1_u = UBOUND(OutData%RotorApexOffsetPos,1) - DO i1 = LBOUND(OutData%RotorApexOffsetPos,1), UBOUND(OutData%RotorApexOffsetPos,1) - OutData%RotorApexOffsetPos(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FocalDistanceX not allocated - Int_Xferred = Int_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%FocalDistanceX)) DEALLOCATE(OutData%FocalDistanceX) - ALLOCATE(OutData%FocalDistanceX(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FocalDistanceX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%FocalDistanceX,1), UBOUND(OutData%FocalDistanceX,1) - OutData%FocalDistanceX(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FocalDistanceY not allocated - Int_Xferred = Int_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%FocalDistanceY)) DEALLOCATE(OutData%FocalDistanceY) - ALLOCATE(OutData%FocalDistanceY(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FocalDistanceY.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%FocalDistanceY,1), UBOUND(OutData%FocalDistanceY,1) - OutData%FocalDistanceY(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FocalDistanceZ not allocated - Int_Xferred = Int_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%FocalDistanceZ)) DEALLOCATE(OutData%FocalDistanceZ) - ALLOCATE(OutData%FocalDistanceZ(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FocalDistanceZ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%FocalDistanceZ,1), UBOUND(OutData%FocalDistanceZ,1) - OutData%FocalDistanceZ(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%PulseSpacing = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MeasurementInterval = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%URefLid = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%LidRadialVel = TRANSFER(IntKiBuf(Int_Xferred), OutData%LidRadialVel) - Int_Xferred = Int_Xferred + 1 - OutData%ConsiderHubMotion = IntKiBuf(Int_Xferred) - 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 InflowWind_IO_Unpackgrid3d_initinputtype( Re_Buf, Db_Buf, Int_Buf, OutData%FF, ErrStat2, ErrMsg2 ) ! FF - 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 InflowWind_UnPackInputFile - - SUBROUTINE InflowWind_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(InflowWind_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(InflowWind_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 = 'InflowWind_CopyInitInput' -! +subroutine InflowWind_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg) + type(InflowWind_InputFile), intent(in) :: SrcInputFileData + type(InflowWind_InputFile), intent(inout) :: DstInputFileData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'InflowWind_CopyInputFile' ErrStat = ErrID_None - ErrMsg = "" - DstInitInputData%InputFileName = SrcInitInputData%InputFileName - DstInitInputData%Linearize = SrcInitInputData%Linearize - DstInitInputData%Use4Dext = SrcInitInputData%Use4Dext - DstInitInputData%NumWindPoints = SrcInitInputData%NumWindPoints - DstInitInputData%TurbineID = SrcInitInputData%TurbineID - DstInitInputData%FixedWindFileRootName = SrcInitInputData%FixedWindFileRootName - DstInitInputData%UseInputFile = SrcInitInputData%UseInputFile - DstInitInputData%RootName = SrcInitInputData%RootName - CALL NWTC_Library_Copyfileinfotype( SrcInitInputData%PassedFileData, DstInitInputData%PassedFileData, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstInitInputData%WindType2UseInputFile = SrcInitInputData%WindType2UseInputFile - CALL NWTC_Library_Copyfileinfotype( SrcInitInputData%WindType2Data, DstInitInputData%WindType2Data, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstInitInputData%OutputAccel = SrcInitInputData%OutputAccel - CALL Lidar_CopyInitInput( SrcInitInputData%lidar, DstInitInputData%lidar, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL InflowWind_IO_Copygrid4d_initinputtype( SrcInitInputData%FDext, DstInitInputData%FDext, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstInitInputData%RadAvg = SrcInitInputData%RadAvg - DstInitInputData%MHK = SrcInitInputData%MHK - DstInitInputData%WtrDpth = SrcInitInputData%WtrDpth - DstInitInputData%MSL2SWL = SrcInitInputData%MSL2SWL - DstInitInputData%BoxExceedAllowIdx = SrcInitInputData%BoxExceedAllowIdx - DstInitInputData%BoxExceedAllowF = SrcInitInputData%BoxExceedAllowF - DstInitInputData%LidarEnabled = SrcInitInputData%LidarEnabled - END SUBROUTINE InflowWind_CopyInitInput - - SUBROUTINE InflowWind_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(InflowWind_InitInputType), INTENT(INOUT) :: InitInputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_DestroyInitInput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL NWTC_Library_Destroyfileinfotype( InitInputData%PassedFileData, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL NWTC_Library_Destroyfileinfotype( InitInputData%WindType2Data, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL Lidar_DestroyInitInput( InitInputData%lidar, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL InflowWind_IO_Destroygrid4d_initinputtype( InitInputData%FDext, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE InflowWind_DestroyInitInput - - SUBROUTINE InflowWind_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(InflowWind_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 = 'InflowWind_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%InputFileName) ! InputFileName - Int_BufSz = Int_BufSz + 1 ! Linearize - Int_BufSz = Int_BufSz + 1 ! Use4Dext - Int_BufSz = Int_BufSz + 1 ! NumWindPoints - Int_BufSz = Int_BufSz + 1 ! TurbineID - Int_BufSz = Int_BufSz + 1 ! FixedWindFileRootName - Int_BufSz = Int_BufSz + 1 ! UseInputFile - Int_BufSz = Int_BufSz + 1*LEN(InData%RootName) ! RootName - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! PassedFileData: size of buffers for each call to pack subtype - CALL NWTC_Library_Packfileinfotype( Re_Buf, Db_Buf, Int_Buf, InData%PassedFileData, ErrStat2, ErrMsg2, .TRUE. ) ! PassedFileData - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! PassedFileData - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! PassedFileData - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! PassedFileData - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! WindType2UseInputFile - Int_BufSz = Int_BufSz + 3 ! WindType2Data: size of buffers for each call to pack subtype - CALL NWTC_Library_Packfileinfotype( Re_Buf, Db_Buf, Int_Buf, InData%WindType2Data, ErrStat2, ErrMsg2, .TRUE. ) ! WindType2Data - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! WindType2Data - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! WindType2Data - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! WindType2Data - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! OutputAccel - Int_BufSz = Int_BufSz + 3 ! lidar: size of buffers for each call to pack subtype - CALL Lidar_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%lidar, ErrStat2, ErrMsg2, .TRUE. ) ! lidar - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! lidar - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! lidar - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! lidar - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! FDext: size of buffers for each call to pack subtype - CALL InflowWind_IO_Packgrid4d_initinputtype( Re_Buf, Db_Buf, Int_Buf, InData%FDext, ErrStat2, ErrMsg2, .TRUE. ) ! FDext - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! FDext - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! FDext - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! FDext - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Re_BufSz = Re_BufSz + 1 ! RadAvg - Int_BufSz = Int_BufSz + 1 ! MHK - Re_BufSz = Re_BufSz + 1 ! WtrDpth - Re_BufSz = Re_BufSz + 1 ! MSL2SWL - Int_BufSz = Int_BufSz + 1 ! BoxExceedAllowIdx - Int_BufSz = Int_BufSz + 1 ! BoxExceedAllowF - Int_BufSz = Int_BufSz + 1 ! LidarEnabled - 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%InputFileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%InputFileName(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) = TRANSFER(InData%Use4Dext, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumWindPoints - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%TurbineID - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%FixedWindFileRootName, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%UseInputFile, IntKiBuf(1)) - 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 - CALL NWTC_Library_Packfileinfotype( Re_Buf, Db_Buf, Int_Buf, InData%PassedFileData, ErrStat2, ErrMsg2, OnlySize ) ! PassedFileData - 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%WindType2UseInputFile, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - CALL NWTC_Library_Packfileinfotype( Re_Buf, Db_Buf, Int_Buf, InData%WindType2Data, ErrStat2, ErrMsg2, OnlySize ) ! WindType2Data - 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%OutputAccel, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - CALL Lidar_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%lidar, ErrStat2, ErrMsg2, OnlySize ) ! lidar - 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 InflowWind_IO_Packgrid4d_initinputtype( Re_Buf, Db_Buf, Int_Buf, InData%FDext, ErrStat2, ErrMsg2, OnlySize ) ! FDext - 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 - ReKiBuf(Re_Xferred) = InData%RadAvg - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%MHK - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WtrDpth - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MSL2SWL - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%BoxExceedAllowIdx - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%BoxExceedAllowF, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%LidarEnabled, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE InflowWind_PackInitInput - - SUBROUTINE InflowWind_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(InflowWind_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 = 'InflowWind_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%InputFileName) - OutData%InputFileName(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%Use4Dext = TRANSFER(IntKiBuf(Int_Xferred), OutData%Use4Dext) - Int_Xferred = Int_Xferred + 1 - OutData%NumWindPoints = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TurbineID = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%FixedWindFileRootName = TRANSFER(IntKiBuf(Int_Xferred), OutData%FixedWindFileRootName) - Int_Xferred = Int_Xferred + 1 - OutData%UseInputFile = TRANSFER(IntKiBuf(Int_Xferred), OutData%UseInputFile) - 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 - 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%PassedFileData, ErrStat2, ErrMsg2 ) ! PassedFileData - 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%WindType2UseInputFile = TRANSFER(IntKiBuf(Int_Xferred), OutData%WindType2UseInputFile) - 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%WindType2Data, ErrStat2, ErrMsg2 ) ! WindType2Data - 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%OutputAccel = TRANSFER(IntKiBuf(Int_Xferred), OutData%OutputAccel) - 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 Lidar_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%lidar, ErrStat2, ErrMsg2 ) ! lidar - 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 InflowWind_IO_Unpackgrid4d_initinputtype( Re_Buf, Db_Buf, Int_Buf, OutData%FDext, ErrStat2, ErrMsg2 ) ! FDext - 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%RadAvg = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MHK = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WtrDpth = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MSL2SWL = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%BoxExceedAllowIdx = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%BoxExceedAllowF = TRANSFER(IntKiBuf(Int_Xferred), OutData%BoxExceedAllowF) - Int_Xferred = Int_Xferred + 1 - OutData%LidarEnabled = TRANSFER(IntKiBuf(Int_Xferred), OutData%LidarEnabled) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE InflowWind_UnPackInitInput - - SUBROUTINE InflowWind_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(InflowWind_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(InflowWind_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 = 'InflowWind_CopyInitOutput' -! + ErrMsg = '' + DstInputFileData%EchoFlag = SrcInputFileData%EchoFlag + DstInputFileData%WindType = SrcInputFileData%WindType + DstInputFileData%PropagationDir = SrcInputFileData%PropagationDir + DstInputFileData%VFlowAngle = SrcInputFileData%VFlowAngle + DstInputFileData%VelInterpCubic = SrcInputFileData%VelInterpCubic + DstInputFileData%NWindVel = SrcInputFileData%NWindVel + if (allocated(SrcInputFileData%WindVxiList)) then + LB(1:1) = lbound(SrcInputFileData%WindVxiList) + UB(1:1) = ubound(SrcInputFileData%WindVxiList) + if (.not. allocated(DstInputFileData%WindVxiList)) then + allocate(DstInputFileData%WindVxiList(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%WindVxiList.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%WindVxiList = SrcInputFileData%WindVxiList + end if + if (allocated(SrcInputFileData%WindVyiList)) then + LB(1:1) = lbound(SrcInputFileData%WindVyiList) + UB(1:1) = ubound(SrcInputFileData%WindVyiList) + if (.not. allocated(DstInputFileData%WindVyiList)) then + allocate(DstInputFileData%WindVyiList(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%WindVyiList.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%WindVyiList = SrcInputFileData%WindVyiList + end if + if (allocated(SrcInputFileData%WindVziList)) then + LB(1:1) = lbound(SrcInputFileData%WindVziList) + UB(1:1) = ubound(SrcInputFileData%WindVziList) + if (.not. allocated(DstInputFileData%WindVziList)) then + allocate(DstInputFileData%WindVziList(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%WindVziList.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%WindVziList = SrcInputFileData%WindVziList + end if + DstInputFileData%Steady_HWindSpeed = SrcInputFileData%Steady_HWindSpeed + DstInputFileData%Steady_RefHt = SrcInputFileData%Steady_RefHt + DstInputFileData%Steady_PLexp = SrcInputFileData%Steady_PLexp + DstInputFileData%Uniform_FileName = SrcInputFileData%Uniform_FileName + DstInputFileData%Uniform_RefHt = SrcInputFileData%Uniform_RefHt + DstInputFileData%Uniform_RefLength = SrcInputFileData%Uniform_RefLength + DstInputFileData%TSFF_FileName = SrcInputFileData%TSFF_FileName + DstInputFileData%BladedFF_FileName = SrcInputFileData%BladedFF_FileName + DstInputFileData%BladedFF_TowerFile = SrcInputFileData%BladedFF_TowerFile + DstInputFileData%CTTS_CoherentTurb = SrcInputFileData%CTTS_CoherentTurb + DstInputFileData%CTTS_FileName = SrcInputFileData%CTTS_FileName + DstInputFileData%CTTS_Path = SrcInputFileData%CTTS_Path + DstInputFileData%HAWC_FileName_u = SrcInputFileData%HAWC_FileName_u + DstInputFileData%HAWC_FileName_v = SrcInputFileData%HAWC_FileName_v + DstInputFileData%HAWC_FileName_w = SrcInputFileData%HAWC_FileName_w + DstInputFileData%HAWC_nx = SrcInputFileData%HAWC_nx + DstInputFileData%HAWC_ny = SrcInputFileData%HAWC_ny + DstInputFileData%HAWC_nz = SrcInputFileData%HAWC_nz + DstInputFileData%HAWC_dx = SrcInputFileData%HAWC_dx + DstInputFileData%HAWC_dy = SrcInputFileData%HAWC_dy + DstInputFileData%HAWC_dz = SrcInputFileData%HAWC_dz + DstInputFileData%SumPrint = SrcInputFileData%SumPrint + DstInputFileData%NumOuts = SrcInputFileData%NumOuts + if (allocated(SrcInputFileData%OutList)) then + LB(1:1) = lbound(SrcInputFileData%OutList) + UB(1:1) = ubound(SrcInputFileData%OutList) + if (.not. allocated(DstInputFileData%OutList)) then + allocate(DstInputFileData%OutList(LB(1):UB(1)), 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 + end if + DstInputFileData%SensorType = SrcInputFileData%SensorType + DstInputFileData%NumBeam = SrcInputFileData%NumBeam + DstInputFileData%NumPulseGate = SrcInputFileData%NumPulseGate + DstInputFileData%RotorApexOffsetPos = SrcInputFileData%RotorApexOffsetPos + if (allocated(SrcInputFileData%FocalDistanceX)) then + LB(1:1) = lbound(SrcInputFileData%FocalDistanceX) + UB(1:1) = ubound(SrcInputFileData%FocalDistanceX) + if (.not. allocated(DstInputFileData%FocalDistanceX)) then + allocate(DstInputFileData%FocalDistanceX(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%FocalDistanceX.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%FocalDistanceX = SrcInputFileData%FocalDistanceX + end if + if (allocated(SrcInputFileData%FocalDistanceY)) then + LB(1:1) = lbound(SrcInputFileData%FocalDistanceY) + UB(1:1) = ubound(SrcInputFileData%FocalDistanceY) + if (.not. allocated(DstInputFileData%FocalDistanceY)) then + allocate(DstInputFileData%FocalDistanceY(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%FocalDistanceY.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%FocalDistanceY = SrcInputFileData%FocalDistanceY + end if + if (allocated(SrcInputFileData%FocalDistanceZ)) then + LB(1:1) = lbound(SrcInputFileData%FocalDistanceZ) + UB(1:1) = ubound(SrcInputFileData%FocalDistanceZ) + if (.not. allocated(DstInputFileData%FocalDistanceZ)) then + allocate(DstInputFileData%FocalDistanceZ(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%FocalDistanceZ.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%FocalDistanceZ = SrcInputFileData%FocalDistanceZ + end if + DstInputFileData%PulseSpacing = SrcInputFileData%PulseSpacing + DstInputFileData%MeasurementInterval = SrcInputFileData%MeasurementInterval + DstInputFileData%URefLid = SrcInputFileData%URefLid + DstInputFileData%LidRadialVel = SrcInputFileData%LidRadialVel + DstInputFileData%ConsiderHubMotion = SrcInputFileData%ConsiderHubMotion + call InflowWind_IO_CopyGrid3D_InitInputType(SrcInputFileData%FF, DstInputFileData%FF, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine InflowWind_DestroyInputFile(InputFileData, ErrStat, ErrMsg) + type(InflowWind_InputFile), intent(inout) :: InputFileData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'InflowWind_DestroyInputFile' 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 - CALL InflowWind_IO_Copywindfiledat( SrcInitOutputData%WindFileInfo, DstInitOutputData%WindFileInfo, 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_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 InflowWind_CopyInitOutput - - SUBROUTINE InflowWind_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(InflowWind_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_DestroyInitOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(InitOutputData%WriteOutputHdr)) THEN - DEALLOCATE(InitOutputData%WriteOutputHdr) -ENDIF -IF (ALLOCATED(InitOutputData%WriteOutputUnt)) THEN - DEALLOCATE(InitOutputData%WriteOutputUnt) -ENDIF - CALL NWTC_Library_Destroyprogdesc( InitOutputData%Ver, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL InflowWind_IO_Destroywindfiledat( InitOutputData%WindFileInfo, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -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 InflowWind_DestroyInitOutput - - SUBROUTINE InflowWind_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(InflowWind_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 = 'InflowWind_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 + 3 ! WindFileInfo: size of buffers for each call to pack subtype - CALL InflowWind_IO_Packwindfiledat( Re_Buf, Db_Buf, Int_Buf, InData%WindFileInfo, ErrStat2, ErrMsg2, .TRUE. ) ! WindFileInfo - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! WindFileInfo - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! WindFileInfo - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! WindFileInfo - 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_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 - CALL InflowWind_IO_Packwindfiledat( Re_Buf, Db_Buf, Int_Buf, InData%WindFileInfo, ErrStat2, ErrMsg2, OnlySize ) ! WindFileInfo - 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_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 InflowWind_PackInitOutput - - SUBROUTINE InflowWind_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(InflowWind_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 = 'InflowWind_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) - 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 InflowWind_IO_Unpackwindfiledat( Re_Buf, Db_Buf, Int_Buf, OutData%WindFileInfo, ErrStat2, ErrMsg2 ) ! WindFileInfo - 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_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 InflowWind_UnPackInitOutput - - SUBROUTINE InflowWind_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(InflowWind_ParameterType), INTENT(IN) :: SrcParamData - TYPE(InflowWind_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 = 'InflowWind_CopyParam' -! + ErrMsg = '' + if (allocated(InputFileData%WindVxiList)) then + deallocate(InputFileData%WindVxiList) + end if + if (allocated(InputFileData%WindVyiList)) then + deallocate(InputFileData%WindVyiList) + end if + if (allocated(InputFileData%WindVziList)) then + deallocate(InputFileData%WindVziList) + end if + if (allocated(InputFileData%OutList)) then + deallocate(InputFileData%OutList) + end if + if (allocated(InputFileData%FocalDistanceX)) then + deallocate(InputFileData%FocalDistanceX) + end if + if (allocated(InputFileData%FocalDistanceY)) then + deallocate(InputFileData%FocalDistanceY) + end if + if (allocated(InputFileData%FocalDistanceZ)) then + deallocate(InputFileData%FocalDistanceZ) + end if + call InflowWind_IO_DestroyGrid3D_InitInputType(InputFileData%FF, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine InflowWind_PackInputFile(RF, Indata) + type(RegFile), intent(inout) :: RF + type(InflowWind_InputFile), intent(in) :: InData + character(*), parameter :: RoutineName = 'InflowWind_PackInputFile' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%EchoFlag) + call RegPack(RF, InData%WindType) + call RegPack(RF, InData%PropagationDir) + call RegPack(RF, InData%VFlowAngle) + call RegPack(RF, InData%VelInterpCubic) + call RegPack(RF, InData%NWindVel) + call RegPackAlloc(RF, InData%WindVxiList) + call RegPackAlloc(RF, InData%WindVyiList) + call RegPackAlloc(RF, InData%WindVziList) + call RegPack(RF, InData%Steady_HWindSpeed) + call RegPack(RF, InData%Steady_RefHt) + call RegPack(RF, InData%Steady_PLexp) + call RegPack(RF, InData%Uniform_FileName) + call RegPack(RF, InData%Uniform_RefHt) + call RegPack(RF, InData%Uniform_RefLength) + call RegPack(RF, InData%TSFF_FileName) + call RegPack(RF, InData%BladedFF_FileName) + call RegPack(RF, InData%BladedFF_TowerFile) + call RegPack(RF, InData%CTTS_CoherentTurb) + call RegPack(RF, InData%CTTS_FileName) + call RegPack(RF, InData%CTTS_Path) + call RegPack(RF, InData%HAWC_FileName_u) + call RegPack(RF, InData%HAWC_FileName_v) + call RegPack(RF, InData%HAWC_FileName_w) + call RegPack(RF, InData%HAWC_nx) + call RegPack(RF, InData%HAWC_ny) + call RegPack(RF, InData%HAWC_nz) + call RegPack(RF, InData%HAWC_dx) + call RegPack(RF, InData%HAWC_dy) + call RegPack(RF, InData%HAWC_dz) + call RegPack(RF, InData%SumPrint) + call RegPack(RF, InData%NumOuts) + call RegPackAlloc(RF, InData%OutList) + call RegPack(RF, InData%SensorType) + call RegPack(RF, InData%NumBeam) + call RegPack(RF, InData%NumPulseGate) + call RegPack(RF, InData%RotorApexOffsetPos) + call RegPackAlloc(RF, InData%FocalDistanceX) + call RegPackAlloc(RF, InData%FocalDistanceY) + call RegPackAlloc(RF, InData%FocalDistanceZ) + call RegPack(RF, InData%PulseSpacing) + call RegPack(RF, InData%MeasurementInterval) + call RegPack(RF, InData%URefLid) + call RegPack(RF, InData%LidRadialVel) + call RegPack(RF, InData%ConsiderHubMotion) + call InflowWind_IO_PackGrid3D_InitInputType(RF, InData%FF) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine InflowWind_UnPackInputFile(RF, OutData) + type(RegFile), intent(inout) :: RF + type(InflowWind_InputFile), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'InflowWind_UnPackInputFile' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%EchoFlag); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WindType); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PropagationDir); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VFlowAngle); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VelInterpCubic); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NWindVel); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WindVxiList); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WindVyiList); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WindVziList); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Steady_HWindSpeed); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Steady_RefHt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Steady_PLexp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Uniform_FileName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Uniform_RefHt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Uniform_RefLength); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TSFF_FileName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BladedFF_FileName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BladedFF_TowerFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CTTS_CoherentTurb); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CTTS_FileName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CTTS_Path); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HAWC_FileName_u); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HAWC_FileName_v); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HAWC_FileName_w); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HAWC_nx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HAWC_ny); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HAWC_nz); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HAWC_dx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HAWC_dy); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HAWC_dz); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SumPrint); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumOuts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%OutList); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SensorType); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumBeam); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumPulseGate); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RotorApexOffsetPos); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%FocalDistanceX); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%FocalDistanceY); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%FocalDistanceZ); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PulseSpacing); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MeasurementInterval); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%URefLid); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LidRadialVel); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ConsiderHubMotion); if (RegCheckErr(RF, RoutineName)) return + call InflowWind_IO_UnpackGrid3D_InitInputType(RF, OutData%FF) ! FF +end subroutine + +subroutine InflowWind_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) + type(InflowWind_InitInputType), intent(in) :: SrcInitInputData + type(InflowWind_InitInputType), intent(inout) :: DstInitInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'InflowWind_CopyInitInput' ErrStat = ErrID_None - ErrMsg = "" - DstParamData%RootFileName = SrcParamData%RootFileName - DstParamData%WindType = SrcParamData%WindType - DstParamData%DT = SrcParamData%DT -IF (ALLOCATED(SrcParamData%WindViXYZprime)) THEN - i1_l = LBOUND(SrcParamData%WindViXYZprime,1) - i1_u = UBOUND(SrcParamData%WindViXYZprime,1) - i2_l = LBOUND(SrcParamData%WindViXYZprime,2) - i2_u = UBOUND(SrcParamData%WindViXYZprime,2) - IF (.NOT. ALLOCATED(DstParamData%WindViXYZprime)) THEN - ALLOCATE(DstParamData%WindViXYZprime(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WindViXYZprime.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%WindViXYZprime = SrcParamData%WindViXYZprime -ENDIF -IF (ALLOCATED(SrcParamData%WindViXYZ)) THEN - i1_l = LBOUND(SrcParamData%WindViXYZ,1) - i1_u = UBOUND(SrcParamData%WindViXYZ,1) - i2_l = LBOUND(SrcParamData%WindViXYZ,2) - i2_u = UBOUND(SrcParamData%WindViXYZ,2) - IF (.NOT. ALLOCATED(DstParamData%WindViXYZ)) THEN - ALLOCATE(DstParamData%WindViXYZ(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WindViXYZ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%WindViXYZ = SrcParamData%WindViXYZ -ENDIF - CALL IfW_FlowField_Copyflowfieldtype( SrcParamData%FlowField, DstParamData%FlowField, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcParamData%PositionAvg)) THEN - i1_l = LBOUND(SrcParamData%PositionAvg,1) - i1_u = UBOUND(SrcParamData%PositionAvg,1) - i2_l = LBOUND(SrcParamData%PositionAvg,2) - i2_u = UBOUND(SrcParamData%PositionAvg,2) - IF (.NOT. ALLOCATED(DstParamData%PositionAvg)) THEN - ALLOCATE(DstParamData%PositionAvg(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%PositionAvg.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%PositionAvg = SrcParamData%PositionAvg -ENDIF - DstParamData%NWindVel = SrcParamData%NWindVel - 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 -IF (ALLOCATED(SrcParamData%OutParamLinIndx)) THEN - i1_l = LBOUND(SrcParamData%OutParamLinIndx,1) - i1_u = UBOUND(SrcParamData%OutParamLinIndx,1) - i2_l = LBOUND(SrcParamData%OutParamLinIndx,2) - i2_u = UBOUND(SrcParamData%OutParamLinIndx,2) - IF (.NOT. ALLOCATED(DstParamData%OutParamLinIndx)) THEN - ALLOCATE(DstParamData%OutParamLinIndx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutParamLinIndx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%OutParamLinIndx = SrcParamData%OutParamLinIndx -ENDIF - CALL Lidar_CopyParam( SrcParamData%lidar, DstParamData%lidar, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstParamData%OutputAccel = SrcParamData%OutputAccel - END SUBROUTINE InflowWind_CopyParam - - SUBROUTINE InflowWind_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(InflowWind_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(ParamData%WindViXYZprime)) THEN - DEALLOCATE(ParamData%WindViXYZprime) -ENDIF -IF (ALLOCATED(ParamData%WindViXYZ)) THEN - DEALLOCATE(ParamData%WindViXYZ) -ENDIF - CALL IfW_FlowField_Destroyflowfieldtype( ParamData%FlowField, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(ParamData%PositionAvg)) THEN - DEALLOCATE(ParamData%PositionAvg) -ENDIF -IF (ALLOCATED(ParamData%OutParam)) THEN -DO i1 = LBOUND(ParamData%OutParam,1), UBOUND(ParamData%OutParam,1) - CALL NWTC_Library_Destroyoutparmtype( ParamData%OutParam(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ParamData%OutParam) -ENDIF -IF (ALLOCATED(ParamData%OutParamLinIndx)) THEN - DEALLOCATE(ParamData%OutParamLinIndx) -ENDIF - CALL Lidar_DestroyParam( ParamData%lidar, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE InflowWind_DestroyParam - - SUBROUTINE InflowWind_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(InflowWind_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 = 'InflowWind_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*LEN(InData%RootFileName) ! RootFileName - Int_BufSz = Int_BufSz + 1 ! WindType - Db_BufSz = Db_BufSz + 1 ! DT - Int_BufSz = Int_BufSz + 1 ! WindViXYZprime allocated yes/no - IF ( ALLOCATED(InData%WindViXYZprime) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! WindViXYZprime upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WindViXYZprime) ! WindViXYZprime - END IF - Int_BufSz = Int_BufSz + 1 ! WindViXYZ allocated yes/no - IF ( ALLOCATED(InData%WindViXYZ) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! WindViXYZ upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WindViXYZ) ! WindViXYZ - END IF - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! FlowField: size of buffers for each call to pack subtype - CALL IfW_FlowField_Packflowfieldtype( Re_Buf, Db_Buf, Int_Buf, InData%FlowField, ErrStat2, ErrMsg2, .TRUE. ) ! FlowField - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! FlowField - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! FlowField - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! FlowField - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! PositionAvg allocated yes/no - IF ( ALLOCATED(InData%PositionAvg) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PositionAvg upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PositionAvg) ! PositionAvg - END IF - Int_BufSz = Int_BufSz + 1 ! NWindVel - 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 - Int_BufSz = Int_BufSz + 1 ! OutParamLinIndx allocated yes/no - IF ( ALLOCATED(InData%OutParamLinIndx) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! OutParamLinIndx upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%OutParamLinIndx) ! OutParamLinIndx - END IF - Int_BufSz = Int_BufSz + 3 ! lidar: size of buffers for each call to pack subtype - CALL Lidar_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%lidar, ErrStat2, ErrMsg2, .TRUE. ) ! lidar - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! lidar - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! lidar - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! lidar - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! OutputAccel - 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%RootFileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootFileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = InData%WindType - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%DT - Db_Xferred = Db_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%WindViXYZprime) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WindViXYZprime,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WindViXYZprime,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WindViXYZprime,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WindViXYZprime,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%WindViXYZprime,2), UBOUND(InData%WindViXYZprime,2) - DO i1 = LBOUND(InData%WindViXYZprime,1), UBOUND(InData%WindViXYZprime,1) - ReKiBuf(Re_Xferred) = InData%WindViXYZprime(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WindViXYZ) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WindViXYZ,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WindViXYZ,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WindViXYZ,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WindViXYZ,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%WindViXYZ,2), UBOUND(InData%WindViXYZ,2) - DO i1 = LBOUND(InData%WindViXYZ,1), UBOUND(InData%WindViXYZ,1) - ReKiBuf(Re_Xferred) = InData%WindViXYZ(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - CALL IfW_FlowField_Packflowfieldtype( Re_Buf, Db_Buf, Int_Buf, InData%FlowField, ErrStat2, ErrMsg2, OnlySize ) ! FlowField - 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%PositionAvg) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PositionAvg,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PositionAvg,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PositionAvg,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PositionAvg,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PositionAvg,2), UBOUND(InData%PositionAvg,2) - DO i1 = LBOUND(InData%PositionAvg,1), UBOUND(InData%PositionAvg,1) - ReKiBuf(Re_Xferred) = InData%PositionAvg(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NWindVel - 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 - IF ( .NOT. ALLOCATED(InData%OutParamLinIndx) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OutParamLinIndx,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutParamLinIndx,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OutParamLinIndx,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutParamLinIndx,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%OutParamLinIndx,2), UBOUND(InData%OutParamLinIndx,2) - DO i1 = LBOUND(InData%OutParamLinIndx,1), UBOUND(InData%OutParamLinIndx,1) - IntKiBuf(Int_Xferred) = InData%OutParamLinIndx(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - CALL Lidar_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%lidar, ErrStat2, ErrMsg2, OnlySize ) ! lidar - 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%OutputAccel, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE InflowWind_PackParam - - SUBROUTINE InflowWind_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(InflowWind_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 = 'InflowWind_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 - DO I = 1, LEN(OutData%RootFileName) - OutData%RootFileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%WindType = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%DT = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WindViXYZprime not allocated - Int_Xferred = Int_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%WindViXYZprime)) DEALLOCATE(OutData%WindViXYZprime) - ALLOCATE(OutData%WindViXYZprime(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WindViXYZprime.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%WindViXYZprime,2), UBOUND(OutData%WindViXYZprime,2) - DO i1 = LBOUND(OutData%WindViXYZprime,1), UBOUND(OutData%WindViXYZprime,1) - OutData%WindViXYZprime(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WindViXYZ not allocated - Int_Xferred = Int_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%WindViXYZ)) DEALLOCATE(OutData%WindViXYZ) - ALLOCATE(OutData%WindViXYZ(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WindViXYZ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%WindViXYZ,2), UBOUND(OutData%WindViXYZ,2) - DO i1 = LBOUND(OutData%WindViXYZ,1), UBOUND(OutData%WindViXYZ,1) - OutData%WindViXYZ(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - 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 IfW_FlowField_Unpackflowfieldtype( Re_Buf, Db_Buf, Int_Buf, OutData%FlowField, ErrStat2, ErrMsg2 ) ! FlowField - 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 ! PositionAvg not allocated - Int_Xferred = Int_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%PositionAvg)) DEALLOCATE(OutData%PositionAvg) - ALLOCATE(OutData%PositionAvg(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PositionAvg.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PositionAvg,2), UBOUND(OutData%PositionAvg,2) - DO i1 = LBOUND(OutData%PositionAvg,1), UBOUND(OutData%PositionAvg,1) - OutData%PositionAvg(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%NWindVel = 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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutParamLinIndx not allocated - Int_Xferred = Int_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%OutParamLinIndx)) DEALLOCATE(OutData%OutParamLinIndx) - ALLOCATE(OutData%OutParamLinIndx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParamLinIndx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%OutParamLinIndx,2), UBOUND(OutData%OutParamLinIndx,2) - DO i1 = LBOUND(OutData%OutParamLinIndx,1), UBOUND(OutData%OutParamLinIndx,1) - OutData%OutParamLinIndx(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - 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 Lidar_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%lidar, ErrStat2, ErrMsg2 ) ! lidar - 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%OutputAccel = TRANSFER(IntKiBuf(Int_Xferred), OutData%OutputAccel) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE InflowWind_UnPackParam - - SUBROUTINE InflowWind_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(InflowWind_InputType), INTENT(IN) :: SrcInputData - TYPE(InflowWind_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 = 'InflowWind_CopyInput' -! + ErrMsg = '' + DstInitInputData%InputFileName = SrcInitInputData%InputFileName + DstInitInputData%Linearize = SrcInitInputData%Linearize + DstInitInputData%Use4Dext = SrcInitInputData%Use4Dext + DstInitInputData%NumWindPoints = SrcInitInputData%NumWindPoints + DstInitInputData%TurbineID = SrcInitInputData%TurbineID + DstInitInputData%FixedWindFileRootName = SrcInitInputData%FixedWindFileRootName + DstInitInputData%RootName = SrcInitInputData%RootName + DstInitInputData%FilePassingMethod = SrcInitInputData%FilePassingMethod + call NWTC_Library_CopyFileInfoType(SrcInitInputData%PassedFileInfo, DstInitInputData%PassedFileInfo, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call InflowWind_CopyInputFile(SrcInitInputData%PassedFileData, DstInitInputData%PassedFileData, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstInitInputData%OutputAccel = SrcInitInputData%OutputAccel + call Lidar_CopyInitInput(SrcInitInputData%lidar, DstInitInputData%lidar, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call InflowWind_IO_CopyGrid4D_InitInputType(SrcInitInputData%FDext, DstInitInputData%FDext, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstInitInputData%RadAvg = SrcInitInputData%RadAvg + DstInitInputData%MHK = SrcInitInputData%MHK + DstInitInputData%WtrDpth = SrcInitInputData%WtrDpth + DstInitInputData%MSL2SWL = SrcInitInputData%MSL2SWL + DstInitInputData%BoxExceedAllow = SrcInitInputData%BoxExceedAllow + DstInitInputData%LidarEnabled = SrcInitInputData%LidarEnabled +end subroutine + +subroutine InflowWind_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(InflowWind_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'InflowWind_DestroyInitInput' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcInputData%PositionXYZ)) THEN - i1_l = LBOUND(SrcInputData%PositionXYZ,1) - i1_u = UBOUND(SrcInputData%PositionXYZ,1) - i2_l = LBOUND(SrcInputData%PositionXYZ,2) - i2_u = UBOUND(SrcInputData%PositionXYZ,2) - IF (.NOT. ALLOCATED(DstInputData%PositionXYZ)) THEN - ALLOCATE(DstInputData%PositionXYZ(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%PositionXYZ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%PositionXYZ = SrcInputData%PositionXYZ -ENDIF - CALL Lidar_CopyInput( SrcInputData%lidar, DstInputData%lidar, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstInputData%HubPosition = SrcInputData%HubPosition - DstInputData%HubOrientation = SrcInputData%HubOrientation - END SUBROUTINE InflowWind_CopyInput - - SUBROUTINE InflowWind_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(InflowWind_InputType), INTENT(INOUT) :: InputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_DestroyInput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(InputData%PositionXYZ)) THEN - DEALLOCATE(InputData%PositionXYZ) -ENDIF - CALL Lidar_DestroyInput( InputData%lidar, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE InflowWind_DestroyInput - - SUBROUTINE InflowWind_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(InflowWind_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 = 'InflowWind_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 ! PositionXYZ allocated yes/no - IF ( ALLOCATED(InData%PositionXYZ) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PositionXYZ upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PositionXYZ) ! PositionXYZ - END IF - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! lidar: size of buffers for each call to pack subtype - CALL Lidar_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%lidar, ErrStat2, ErrMsg2, .TRUE. ) ! lidar - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! lidar - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! lidar - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! lidar - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Re_BufSz = Re_BufSz + SIZE(InData%HubPosition) ! HubPosition - Re_BufSz = Re_BufSz + SIZE(InData%HubOrientation) ! HubOrientation - 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%PositionXYZ) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PositionXYZ,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PositionXYZ,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PositionXYZ,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PositionXYZ,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PositionXYZ,2), UBOUND(InData%PositionXYZ,2) - DO i1 = LBOUND(InData%PositionXYZ,1), UBOUND(InData%PositionXYZ,1) - ReKiBuf(Re_Xferred) = InData%PositionXYZ(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - CALL Lidar_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%lidar, ErrStat2, ErrMsg2, OnlySize ) ! lidar - 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 i1 = LBOUND(InData%HubPosition,1), UBOUND(InData%HubPosition,1) - ReKiBuf(Re_Xferred) = InData%HubPosition(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i2 = LBOUND(InData%HubOrientation,2), UBOUND(InData%HubOrientation,2) - DO i1 = LBOUND(InData%HubOrientation,1), UBOUND(InData%HubOrientation,1) - ReKiBuf(Re_Xferred) = InData%HubOrientation(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END SUBROUTINE InflowWind_PackInput - - SUBROUTINE InflowWind_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(InflowWind_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 = 'InflowWind_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 ! PositionXYZ not allocated - Int_Xferred = Int_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%PositionXYZ)) DEALLOCATE(OutData%PositionXYZ) - ALLOCATE(OutData%PositionXYZ(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PositionXYZ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PositionXYZ,2), UBOUND(OutData%PositionXYZ,2) - DO i1 = LBOUND(OutData%PositionXYZ,1), UBOUND(OutData%PositionXYZ,1) - OutData%PositionXYZ(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - 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 Lidar_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%lidar, ErrStat2, ErrMsg2 ) ! lidar - 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) - i1_l = LBOUND(OutData%HubPosition,1) - i1_u = UBOUND(OutData%HubPosition,1) - DO i1 = LBOUND(OutData%HubPosition,1), UBOUND(OutData%HubPosition,1) - OutData%HubPosition(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%HubOrientation,1) - i1_u = UBOUND(OutData%HubOrientation,1) - i2_l = LBOUND(OutData%HubOrientation,2) - i2_u = UBOUND(OutData%HubOrientation,2) - DO i2 = LBOUND(OutData%HubOrientation,2), UBOUND(OutData%HubOrientation,2) - DO i1 = LBOUND(OutData%HubOrientation,1), UBOUND(OutData%HubOrientation,1) - OutData%HubOrientation(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END SUBROUTINE InflowWind_UnPackInput - - SUBROUTINE InflowWind_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(InflowWind_OutputType), INTENT(IN) :: SrcOutputData - TYPE(InflowWind_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 = 'InflowWind_CopyOutput' -! + ErrMsg = '' + call NWTC_Library_DestroyFileInfoType(InitInputData%PassedFileInfo, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call InflowWind_DestroyInputFile(InitInputData%PassedFileData, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call Lidar_DestroyInitInput(InitInputData%lidar, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call InflowWind_IO_DestroyGrid4D_InitInputType(InitInputData%FDext, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine InflowWind_PackInitInput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(InflowWind_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'InflowWind_PackInitInput' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%InputFileName) + call RegPack(RF, InData%Linearize) + call RegPack(RF, InData%Use4Dext) + call RegPack(RF, InData%NumWindPoints) + call RegPack(RF, InData%TurbineID) + call RegPack(RF, InData%FixedWindFileRootName) + call RegPack(RF, InData%RootName) + call RegPack(RF, InData%FilePassingMethod) + call NWTC_Library_PackFileInfoType(RF, InData%PassedFileInfo) + call InflowWind_PackInputFile(RF, InData%PassedFileData) + call RegPack(RF, InData%OutputAccel) + call Lidar_PackInitInput(RF, InData%lidar) + call InflowWind_IO_PackGrid4D_InitInputType(RF, InData%FDext) + call RegPack(RF, InData%RadAvg) + call RegPack(RF, InData%MHK) + call RegPack(RF, InData%WtrDpth) + call RegPack(RF, InData%MSL2SWL) + call RegPack(RF, InData%BoxExceedAllow) + call RegPack(RF, InData%LidarEnabled) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine InflowWind_UnPackInitInput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(InflowWind_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'InflowWind_UnPackInitInput' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%InputFileName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Linearize); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Use4Dext); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumWindPoints); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TurbineID); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FixedWindFileRootName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RootName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FilePassingMethod); if (RegCheckErr(RF, RoutineName)) return + call NWTC_Library_UnpackFileInfoType(RF, OutData%PassedFileInfo) ! PassedFileInfo + call InflowWind_UnpackInputFile(RF, OutData%PassedFileData) ! PassedFileData + call RegUnpack(RF, OutData%OutputAccel); if (RegCheckErr(RF, RoutineName)) return + call Lidar_UnpackInitInput(RF, OutData%lidar) ! lidar + call InflowWind_IO_UnpackGrid4D_InitInputType(RF, OutData%FDext) ! FDext + call RegUnpack(RF, OutData%RadAvg); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MHK); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WtrDpth); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MSL2SWL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BoxExceedAllow); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LidarEnabled); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine InflowWind_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) + type(InflowWind_InitOutputType), intent(in) :: SrcInitOutputData + type(InflowWind_InitOutputType), intent(inout) :: DstInitOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'InflowWind_CopyInitOutput' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcOutputData%VelocityUVW)) THEN - i1_l = LBOUND(SrcOutputData%VelocityUVW,1) - i1_u = UBOUND(SrcOutputData%VelocityUVW,1) - i2_l = LBOUND(SrcOutputData%VelocityUVW,2) - i2_u = UBOUND(SrcOutputData%VelocityUVW,2) - IF (.NOT. ALLOCATED(DstOutputData%VelocityUVW)) THEN - ALLOCATE(DstOutputData%VelocityUVW(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%VelocityUVW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%VelocityUVW = SrcOutputData%VelocityUVW -ENDIF -IF (ALLOCATED(SrcOutputData%AccelUVW)) THEN - i1_l = LBOUND(SrcOutputData%AccelUVW,1) - i1_u = UBOUND(SrcOutputData%AccelUVW,1) - i2_l = LBOUND(SrcOutputData%AccelUVW,2) - i2_u = UBOUND(SrcOutputData%AccelUVW,2) - IF (.NOT. ALLOCATED(DstOutputData%AccelUVW)) THEN - ALLOCATE(DstOutputData%AccelUVW(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%AccelUVW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%AccelUVW = SrcOutputData%AccelUVW -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 - DstOutputData%DiskVel = SrcOutputData%DiskVel - DstOutputData%HubVel = SrcOutputData%HubVel - CALL Lidar_CopyOutput( SrcOutputData%lidar, DstOutputData%lidar, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE InflowWind_CopyOutput - - SUBROUTINE InflowWind_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(InflowWind_OutputType), INTENT(INOUT) :: OutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_DestroyOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(OutputData%VelocityUVW)) THEN - DEALLOCATE(OutputData%VelocityUVW) -ENDIF -IF (ALLOCATED(OutputData%AccelUVW)) THEN - DEALLOCATE(OutputData%AccelUVW) -ENDIF -IF (ALLOCATED(OutputData%WriteOutput)) THEN - DEALLOCATE(OutputData%WriteOutput) -ENDIF - CALL Lidar_DestroyOutput( OutputData%lidar, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE InflowWind_DestroyOutput - - SUBROUTINE InflowWind_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(InflowWind_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 = 'InflowWind_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 ! VelocityUVW allocated yes/no - IF ( ALLOCATED(InData%VelocityUVW) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! VelocityUVW upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%VelocityUVW) ! VelocityUVW - END IF - Int_BufSz = Int_BufSz + 1 ! AccelUVW allocated yes/no - IF ( ALLOCATED(InData%AccelUVW) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! AccelUVW upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AccelUVW) ! AccelUVW - 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 - Re_BufSz = Re_BufSz + SIZE(InData%DiskVel) ! DiskVel - Re_BufSz = Re_BufSz + SIZE(InData%HubVel) ! HubVel - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! lidar: size of buffers for each call to pack subtype - CALL Lidar_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%lidar, ErrStat2, ErrMsg2, .TRUE. ) ! lidar - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! lidar - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! lidar - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! lidar - 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%VelocityUVW) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%VelocityUVW,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VelocityUVW,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%VelocityUVW,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VelocityUVW,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%VelocityUVW,2), UBOUND(InData%VelocityUVW,2) - DO i1 = LBOUND(InData%VelocityUVW,1), UBOUND(InData%VelocityUVW,1) - ReKiBuf(Re_Xferred) = InData%VelocityUVW(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AccelUVW) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AccelUVW,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AccelUVW,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AccelUVW,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AccelUVW,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%AccelUVW,2), UBOUND(InData%AccelUVW,2) - DO i1 = LBOUND(InData%AccelUVW,1), UBOUND(InData%AccelUVW,1) - ReKiBuf(Re_Xferred) = InData%AccelUVW(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - 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 - DO i1 = LBOUND(InData%DiskVel,1), UBOUND(InData%DiskVel,1) - ReKiBuf(Re_Xferred) = InData%DiskVel(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%HubVel,1), UBOUND(InData%HubVel,1) - ReKiBuf(Re_Xferred) = InData%HubVel(i1) - Re_Xferred = Re_Xferred + 1 - END DO - CALL Lidar_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%lidar, ErrStat2, ErrMsg2, OnlySize ) ! lidar - 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 InflowWind_PackOutput - - SUBROUTINE InflowWind_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(InflowWind_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 = 'InflowWind_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 ! VelocityUVW not allocated - Int_Xferred = Int_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%VelocityUVW)) DEALLOCATE(OutData%VelocityUVW) - ALLOCATE(OutData%VelocityUVW(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%VelocityUVW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%VelocityUVW,2), UBOUND(OutData%VelocityUVW,2) - DO i1 = LBOUND(OutData%VelocityUVW,1), UBOUND(OutData%VelocityUVW,1) - OutData%VelocityUVW(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AccelUVW not allocated - Int_Xferred = Int_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%AccelUVW)) DEALLOCATE(OutData%AccelUVW) - ALLOCATE(OutData%AccelUVW(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AccelUVW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%AccelUVW,2), UBOUND(OutData%AccelUVW,2) - DO i1 = LBOUND(OutData%AccelUVW,1), UBOUND(OutData%AccelUVW,1) - OutData%AccelUVW(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - 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 - i1_l = LBOUND(OutData%DiskVel,1) - i1_u = UBOUND(OutData%DiskVel,1) - DO i1 = LBOUND(OutData%DiskVel,1), UBOUND(OutData%DiskVel,1) - OutData%DiskVel(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%HubVel,1) - i1_u = UBOUND(OutData%HubVel,1) - DO i1 = LBOUND(OutData%HubVel,1), UBOUND(OutData%HubVel,1) - OutData%HubVel(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - 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 Lidar_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%lidar, ErrStat2, ErrMsg2 ) ! lidar - 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 InflowWind_UnPackOutput - - SUBROUTINE InflowWind_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(InflowWind_ContinuousStateType), INTENT(IN) :: SrcContStateData - TYPE(InflowWind_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 = 'InflowWind_CopyContState' -! + ErrMsg = '' + if (allocated(SrcInitOutputData%WriteOutputHdr)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) + if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then + allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitOutputData%WriteOutputUnt)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) + if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then + allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), 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 + end if + call NWTC_Library_CopyProgDesc(SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call InflowWind_IO_CopyWindFileDat(SrcInitOutputData%WindFileInfo, DstInitOutputData%WindFileInfo, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcInitOutputData%LinNames_y)) then + LB(1:1) = lbound(SrcInitOutputData%LinNames_y) + UB(1:1) = ubound(SrcInitOutputData%LinNames_y) + if (.not. allocated(DstInitOutputData%LinNames_y)) then + allocate(DstInitOutputData%LinNames_y(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitOutputData%LinNames_u)) then + LB(1:1) = lbound(SrcInitOutputData%LinNames_u) + UB(1:1) = ubound(SrcInitOutputData%LinNames_u) + if (.not. allocated(DstInitOutputData%LinNames_u)) then + allocate(DstInitOutputData%LinNames_u(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitOutputData%RotFrame_y)) then + LB(1:1) = lbound(SrcInitOutputData%RotFrame_y) + UB(1:1) = ubound(SrcInitOutputData%RotFrame_y) + if (.not. allocated(DstInitOutputData%RotFrame_y)) then + allocate(DstInitOutputData%RotFrame_y(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitOutputData%RotFrame_u)) then + LB(1:1) = lbound(SrcInitOutputData%RotFrame_u) + UB(1:1) = ubound(SrcInitOutputData%RotFrame_u) + if (.not. allocated(DstInitOutputData%RotFrame_u)) then + allocate(DstInitOutputData%RotFrame_u(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitOutputData%IsLoad_u)) then + LB(1:1) = lbound(SrcInitOutputData%IsLoad_u) + UB(1:1) = ubound(SrcInitOutputData%IsLoad_u) + if (.not. allocated(DstInitOutputData%IsLoad_u)) then + allocate(DstInitOutputData%IsLoad_u(LB(1):UB(1)), 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 + end if + DstInitOutputData%FlowField => SrcInitOutputData%FlowField +end subroutine + +subroutine InflowWind_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(InflowWind_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'InflowWind_DestroyInitOutput' ErrStat = ErrID_None - ErrMsg = "" - DstContStateData%DummyContState = SrcContStateData%DummyContState - END SUBROUTINE InflowWind_CopyContState - - SUBROUTINE InflowWind_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(InflowWind_ContinuousStateType), INTENT(INOUT) :: ContStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_DestroyContState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE InflowWind_DestroyContState - - SUBROUTINE InflowWind_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(InflowWind_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 = 'InflowWind_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 InflowWind_PackContState - - SUBROUTINE InflowWind_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(InflowWind_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 = 'InflowWind_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 InflowWind_UnPackContState - - SUBROUTINE InflowWind_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(InflowWind_DiscreteStateType), INTENT(IN) :: SrcDiscStateData - TYPE(InflowWind_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 = 'InflowWind_CopyDiscState' -! + ErrMsg = '' + if (allocated(InitOutputData%WriteOutputHdr)) then + deallocate(InitOutputData%WriteOutputHdr) + end if + if (allocated(InitOutputData%WriteOutputUnt)) then + deallocate(InitOutputData%WriteOutputUnt) + end if + call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call InflowWind_IO_DestroyWindFileDat(InitOutputData%WindFileInfo, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(InitOutputData%LinNames_y)) then + deallocate(InitOutputData%LinNames_y) + end if + if (allocated(InitOutputData%LinNames_u)) then + deallocate(InitOutputData%LinNames_u) + end if + if (allocated(InitOutputData%RotFrame_y)) then + deallocate(InitOutputData%RotFrame_y) + end if + if (allocated(InitOutputData%RotFrame_u)) then + deallocate(InitOutputData%RotFrame_u) + end if + if (allocated(InitOutputData%IsLoad_u)) then + deallocate(InitOutputData%IsLoad_u) + end if + nullify(InitOutputData%FlowField) +end subroutine + +subroutine InflowWind_PackInitOutput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(InflowWind_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'InflowWind_PackInitOutput' + logical :: PtrInIndex + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%WriteOutputHdr) + call RegPackAlloc(RF, InData%WriteOutputUnt) + call NWTC_Library_PackProgDesc(RF, InData%Ver) + call InflowWind_IO_PackWindFileDat(RF, InData%WindFileInfo) + call RegPackAlloc(RF, InData%LinNames_y) + call RegPackAlloc(RF, InData%LinNames_u) + call RegPackAlloc(RF, InData%RotFrame_y) + call RegPackAlloc(RF, InData%RotFrame_u) + call RegPackAlloc(RF, InData%IsLoad_u) + call RegPack(RF, associated(InData%FlowField)) + if (associated(InData%FlowField)) then + call RegPackPointer(RF, c_loc(InData%FlowField), PtrInIndex) + if (.not. PtrInIndex) then + call IfW_FlowField_PackFlowFieldType(RF, InData%FlowField) + end if + end if + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine InflowWind_UnPackInitOutput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(InflowWind_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'InflowWind_UnPackInitOutput' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(B8Ki) :: PtrIdx + type(c_ptr) :: Ptr + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%WriteOutputHdr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WriteOutputUnt); if (RegCheckErr(RF, RoutineName)) return + call NWTC_Library_UnpackProgDesc(RF, OutData%Ver) ! Ver + call InflowWind_IO_UnpackWindFileDat(RF, OutData%WindFileInfo) ! WindFileInfo + call RegUnpackAlloc(RF, OutData%LinNames_y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LinNames_u); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%RotFrame_y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%RotFrame_u); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%IsLoad_u); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%FlowField)) deallocate(OutData%FlowField) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackPointer(RF, Ptr, PtrIdx); if (RegCheckErr(RF, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%FlowField) + else + allocate(OutData%FlowField,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FlowField.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + RF%Pointers(PtrIdx) = c_loc(OutData%FlowField) + call IfW_FlowField_UnpackFlowFieldType(RF, OutData%FlowField) ! FlowField + end if + else + OutData%FlowField => null() + end if +end subroutine + +subroutine InflowWind_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(InflowWind_ParameterType), intent(in) :: SrcParamData + type(InflowWind_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'InflowWind_CopyParam' ErrStat = ErrID_None - ErrMsg = "" - DstDiscStateData%DummyDiscState = SrcDiscStateData%DummyDiscState - END SUBROUTINE InflowWind_CopyDiscState - - SUBROUTINE InflowWind_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(InflowWind_DiscreteStateType), INTENT(INOUT) :: DiscStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_DestroyDiscState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE InflowWind_DestroyDiscState - - SUBROUTINE InflowWind_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(InflowWind_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 = 'InflowWind_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 InflowWind_PackDiscState - - SUBROUTINE InflowWind_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(InflowWind_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 = 'InflowWind_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 InflowWind_UnPackDiscState - - SUBROUTINE InflowWind_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(InflowWind_ConstraintStateType), INTENT(IN) :: SrcConstrStateData - TYPE(InflowWind_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 = 'InflowWind_CopyConstrState' -! + ErrMsg = '' + DstParamData%RootFileName = SrcParamData%RootFileName + DstParamData%DT = SrcParamData%DT + if (allocated(SrcParamData%WindViXYZprime)) then + LB(1:2) = lbound(SrcParamData%WindViXYZprime) + UB(1:2) = ubound(SrcParamData%WindViXYZprime) + if (.not. allocated(DstParamData%WindViXYZprime)) then + allocate(DstParamData%WindViXYZprime(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WindViXYZprime.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%WindViXYZprime = SrcParamData%WindViXYZprime + end if + if (allocated(SrcParamData%WindViXYZ)) then + LB(1:2) = lbound(SrcParamData%WindViXYZ) + UB(1:2) = ubound(SrcParamData%WindViXYZ) + if (.not. allocated(DstParamData%WindViXYZ)) then + allocate(DstParamData%WindViXYZ(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WindViXYZ.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%WindViXYZ = SrcParamData%WindViXYZ + end if + if (associated(SrcParamData%FlowField)) then + if (.not. associated(DstParamData%FlowField)) then + allocate(DstParamData%FlowField, stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%FlowField.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + call IfW_FlowField_CopyFlowFieldType(SrcParamData%FlowField, DstParamData%FlowField, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end if + if (allocated(SrcParamData%PositionAvg)) then + LB(1:2) = lbound(SrcParamData%PositionAvg) + UB(1:2) = ubound(SrcParamData%PositionAvg) + if (.not. allocated(DstParamData%PositionAvg)) then + allocate(DstParamData%PositionAvg(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%PositionAvg.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%PositionAvg = SrcParamData%PositionAvg + end if + DstParamData%NWindVel = SrcParamData%NWindVel + DstParamData%NumOuts = SrcParamData%NumOuts + if (allocated(SrcParamData%OutParam)) then + LB(1:1) = lbound(SrcParamData%OutParam) + UB(1:1) = ubound(SrcParamData%OutParam) + if (.not. allocated(DstParamData%OutParam)) then + allocate(DstParamData%OutParam(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutParam.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyOutParmType(SrcParamData%OutParam(i1), DstParamData%OutParam(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcParamData%OutParamLinIndx)) then + LB(1:2) = lbound(SrcParamData%OutParamLinIndx) + UB(1:2) = ubound(SrcParamData%OutParamLinIndx) + if (.not. allocated(DstParamData%OutParamLinIndx)) then + allocate(DstParamData%OutParamLinIndx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutParamLinIndx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%OutParamLinIndx = SrcParamData%OutParamLinIndx + end if + call Lidar_CopyParam(SrcParamData%lidar, DstParamData%lidar, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstParamData%OutputAccel = SrcParamData%OutputAccel +end subroutine + +subroutine InflowWind_DestroyParam(ParamData, ErrStat, ErrMsg) + type(InflowWind_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'InflowWind_DestroyParam' ErrStat = ErrID_None - ErrMsg = "" - DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState - END SUBROUTINE InflowWind_CopyConstrState - - SUBROUTINE InflowWind_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(InflowWind_ConstraintStateType), INTENT(INOUT) :: ConstrStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_DestroyConstrState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE InflowWind_DestroyConstrState - - SUBROUTINE InflowWind_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(InflowWind_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 = 'InflowWind_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 InflowWind_PackConstrState - - SUBROUTINE InflowWind_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(InflowWind_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 = 'InflowWind_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 InflowWind_UnPackConstrState - - SUBROUTINE InflowWind_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(InflowWind_OtherStateType), INTENT(IN) :: SrcOtherStateData - TYPE(InflowWind_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 = 'InflowWind_CopyOtherState' -! + ErrMsg = '' + if (allocated(ParamData%WindViXYZprime)) then + deallocate(ParamData%WindViXYZprime) + end if + if (allocated(ParamData%WindViXYZ)) then + deallocate(ParamData%WindViXYZ) + end if + if (associated(ParamData%FlowField)) then + call IfW_FlowField_DestroyFlowFieldType(ParamData%FlowField, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + deallocate(ParamData%FlowField) + ParamData%FlowField => null() + end if + if (allocated(ParamData%PositionAvg)) then + deallocate(ParamData%PositionAvg) + end if + if (allocated(ParamData%OutParam)) then + LB(1:1) = lbound(ParamData%OutParam) + UB(1:1) = ubound(ParamData%OutParam) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyOutParmType(ParamData%OutParam(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%OutParam) + end if + if (allocated(ParamData%OutParamLinIndx)) then + deallocate(ParamData%OutParamLinIndx) + end if + call Lidar_DestroyParam(ParamData%lidar, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine InflowWind_PackParam(RF, Indata) + type(RegFile), intent(inout) :: RF + type(InflowWind_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'InflowWind_PackParam' + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + logical :: PtrInIndex + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%RootFileName) + call RegPack(RF, InData%DT) + call RegPackAlloc(RF, InData%WindViXYZprime) + call RegPackAlloc(RF, InData%WindViXYZ) + call RegPack(RF, associated(InData%FlowField)) + if (associated(InData%FlowField)) then + call RegPackPointer(RF, c_loc(InData%FlowField), PtrInIndex) + if (.not. PtrInIndex) then + call IfW_FlowField_PackFlowFieldType(RF, InData%FlowField) + end if + end if + call RegPackAlloc(RF, InData%PositionAvg) + call RegPack(RF, InData%NWindVel) + call RegPack(RF, InData%NumOuts) + call RegPack(RF, allocated(InData%OutParam)) + if (allocated(InData%OutParam)) then + call RegPackBounds(RF, 1, lbound(InData%OutParam), ubound(InData%OutParam)) + LB(1:1) = lbound(InData%OutParam) + UB(1:1) = ubound(InData%OutParam) + do i1 = LB(1), UB(1) + call NWTC_Library_PackOutParmType(RF, InData%OutParam(i1)) + end do + end if + call RegPackAlloc(RF, InData%OutParamLinIndx) + call Lidar_PackParam(RF, InData%lidar) + call RegPack(RF, InData%OutputAccel) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine InflowWind_UnPackParam(RF, OutData) + type(RegFile), intent(inout) :: RF + type(InflowWind_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'InflowWind_UnPackParam' + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(B8Ki) :: PtrIdx + type(c_ptr) :: Ptr + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%RootFileName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WindViXYZprime); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WindViXYZ); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%FlowField)) deallocate(OutData%FlowField) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackPointer(RF, Ptr, PtrIdx); if (RegCheckErr(RF, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%FlowField) + else + allocate(OutData%FlowField,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FlowField.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + RF%Pointers(PtrIdx) = c_loc(OutData%FlowField) + call IfW_FlowField_UnpackFlowFieldType(RF, OutData%FlowField) ! FlowField + end if + else + OutData%FlowField => null() + end if + call RegUnpackAlloc(RF, OutData%PositionAvg); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NWindVel); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumOuts); if (RegCheckErr(RF, RoutineName)) return + if (allocated(OutData%OutParam)) deallocate(OutData%OutParam) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%OutParam(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackOutParmType(RF, OutData%OutParam(i1)) ! OutParam + end do + end if + call RegUnpackAlloc(RF, OutData%OutParamLinIndx); if (RegCheckErr(RF, RoutineName)) return + call Lidar_UnpackParam(RF, OutData%lidar) ! lidar + call RegUnpack(RF, OutData%OutputAccel); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine InflowWind_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) + type(InflowWind_InputType), intent(in) :: SrcInputData + type(InflowWind_InputType), intent(inout) :: DstInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'InflowWind_CopyInput' ErrStat = ErrID_None - ErrMsg = "" - DstOtherStateData%DummyOtherState = SrcOtherStateData%DummyOtherState - END SUBROUTINE InflowWind_CopyOtherState - - SUBROUTINE InflowWind_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(InflowWind_OtherStateType), INTENT(INOUT) :: OtherStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_DestroyOtherState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE InflowWind_DestroyOtherState - - SUBROUTINE InflowWind_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(InflowWind_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 = 'InflowWind_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 InflowWind_PackOtherState - - SUBROUTINE InflowWind_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(InflowWind_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 = 'InflowWind_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 InflowWind_UnPackOtherState - - SUBROUTINE InflowWind_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(InflowWind_MiscVarType), INTENT(IN) :: SrcMiscData - TYPE(InflowWind_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 = 'InflowWind_CopyMisc' -! + ErrMsg = '' + if (allocated(SrcInputData%PositionXYZ)) then + LB(1:2) = lbound(SrcInputData%PositionXYZ) + UB(1:2) = ubound(SrcInputData%PositionXYZ) + if (.not. allocated(DstInputData%PositionXYZ)) then + allocate(DstInputData%PositionXYZ(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%PositionXYZ.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%PositionXYZ = SrcInputData%PositionXYZ + end if + call Lidar_CopyInput(SrcInputData%lidar, DstInputData%lidar, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstInputData%HubPosition = SrcInputData%HubPosition + DstInputData%HubOrientation = SrcInputData%HubOrientation +end subroutine + +subroutine InflowWind_DestroyInput(InputData, ErrStat, ErrMsg) + type(InflowWind_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'InflowWind_DestroyInput' ErrStat = ErrID_None - ErrMsg = "" -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 -IF (ALLOCATED(SrcMiscData%WindViUVW)) THEN - i1_l = LBOUND(SrcMiscData%WindViUVW,1) - i1_u = UBOUND(SrcMiscData%WindViUVW,1) - i2_l = LBOUND(SrcMiscData%WindViUVW,2) - i2_u = UBOUND(SrcMiscData%WindViUVW,2) - IF (.NOT. ALLOCATED(DstMiscData%WindViUVW)) THEN - ALLOCATE(DstMiscData%WindViUVW(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%WindViUVW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%WindViUVW = SrcMiscData%WindViUVW -ENDIF -IF (ALLOCATED(SrcMiscData%WindAiUVW)) THEN - i1_l = LBOUND(SrcMiscData%WindAiUVW,1) - i1_u = UBOUND(SrcMiscData%WindAiUVW,1) - i2_l = LBOUND(SrcMiscData%WindAiUVW,2) - i2_u = UBOUND(SrcMiscData%WindAiUVW,2) - IF (.NOT. ALLOCATED(DstMiscData%WindAiUVW)) THEN - ALLOCATE(DstMiscData%WindAiUVW(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%WindAiUVW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%WindAiUVW = SrcMiscData%WindAiUVW -ENDIF - CALL InflowWind_CopyInput( SrcMiscData%u_Avg, DstMiscData%u_Avg, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL InflowWind_CopyOutput( SrcMiscData%y_Avg, DstMiscData%y_Avg, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL InflowWind_CopyInput( SrcMiscData%u_Hub, DstMiscData%u_Hub, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL InflowWind_CopyOutput( SrcMiscData%y_Hub, DstMiscData%y_Hub, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE InflowWind_CopyMisc - - SUBROUTINE InflowWind_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(InflowWind_MiscVarType), INTENT(INOUT) :: MiscData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_DestroyMisc' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(MiscData%AllOuts)) THEN - DEALLOCATE(MiscData%AllOuts) -ENDIF -IF (ALLOCATED(MiscData%WindViUVW)) THEN - DEALLOCATE(MiscData%WindViUVW) -ENDIF -IF (ALLOCATED(MiscData%WindAiUVW)) THEN - DEALLOCATE(MiscData%WindAiUVW) -ENDIF - CALL InflowWind_DestroyInput( MiscData%u_Avg, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL InflowWind_DestroyOutput( MiscData%y_Avg, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL InflowWind_DestroyInput( MiscData%u_Hub, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL InflowWind_DestroyOutput( MiscData%y_Hub, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE InflowWind_DestroyMisc - - SUBROUTINE InflowWind_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(InflowWind_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 = 'InflowWind_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 ! 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 - Int_BufSz = Int_BufSz + 1 ! WindViUVW allocated yes/no - IF ( ALLOCATED(InData%WindViUVW) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! WindViUVW upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WindViUVW) ! WindViUVW - END IF - Int_BufSz = Int_BufSz + 1 ! WindAiUVW allocated yes/no - IF ( ALLOCATED(InData%WindAiUVW) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! WindAiUVW upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WindAiUVW) ! WindAiUVW - END IF - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! u_Avg: size of buffers for each call to pack subtype - CALL InflowWind_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_Avg, ErrStat2, ErrMsg2, .TRUE. ) ! u_Avg - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_Avg - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_Avg - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_Avg - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! y_Avg: size of buffers for each call to pack subtype - CALL InflowWind_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_Avg, ErrStat2, ErrMsg2, .TRUE. ) ! y_Avg - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y_Avg - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y_Avg - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y_Avg - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! u_Hub: size of buffers for each call to pack subtype - CALL InflowWind_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_Hub, ErrStat2, ErrMsg2, .TRUE. ) ! u_Hub - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_Hub - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_Hub - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_Hub - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! y_Hub: size of buffers for each call to pack subtype - CALL InflowWind_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_Hub, ErrStat2, ErrMsg2, .TRUE. ) ! y_Hub - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y_Hub - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y_Hub - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y_Hub - 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%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 - IF ( .NOT. ALLOCATED(InData%WindViUVW) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WindViUVW,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WindViUVW,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WindViUVW,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WindViUVW,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%WindViUVW,2), UBOUND(InData%WindViUVW,2) - DO i1 = LBOUND(InData%WindViUVW,1), UBOUND(InData%WindViUVW,1) - ReKiBuf(Re_Xferred) = InData%WindViUVW(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WindAiUVW) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WindAiUVW,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WindAiUVW,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WindAiUVW,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WindAiUVW,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%WindAiUVW,2), UBOUND(InData%WindAiUVW,2) - DO i1 = LBOUND(InData%WindAiUVW,1), UBOUND(InData%WindAiUVW,1) - ReKiBuf(Re_Xferred) = InData%WindAiUVW(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - CALL InflowWind_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_Avg, ErrStat2, ErrMsg2, OnlySize ) ! u_Avg - 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 InflowWind_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_Avg, ErrStat2, ErrMsg2, OnlySize ) ! y_Avg - 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 InflowWind_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_Hub, ErrStat2, ErrMsg2, OnlySize ) ! u_Hub - 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 InflowWind_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_Hub, ErrStat2, ErrMsg2, OnlySize ) ! y_Hub - 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 InflowWind_PackMisc - - SUBROUTINE InflowWind_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(InflowWind_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 = 'InflowWind_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 ! 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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WindViUVW not allocated - Int_Xferred = Int_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%WindViUVW)) DEALLOCATE(OutData%WindViUVW) - ALLOCATE(OutData%WindViUVW(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WindViUVW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%WindViUVW,2), UBOUND(OutData%WindViUVW,2) - DO i1 = LBOUND(OutData%WindViUVW,1), UBOUND(OutData%WindViUVW,1) - OutData%WindViUVW(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WindAiUVW not allocated - Int_Xferred = Int_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%WindAiUVW)) DEALLOCATE(OutData%WindAiUVW) - ALLOCATE(OutData%WindAiUVW(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WindAiUVW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%WindAiUVW,2), UBOUND(OutData%WindAiUVW,2) - DO i1 = LBOUND(OutData%WindAiUVW,1), UBOUND(OutData%WindAiUVW,1) - OutData%WindAiUVW(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - 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 InflowWind_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u_Avg, ErrStat2, ErrMsg2 ) ! u_Avg - 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 InflowWind_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y_Avg, ErrStat2, ErrMsg2 ) ! y_Avg - 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 InflowWind_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u_Hub, ErrStat2, ErrMsg2 ) ! u_Hub - 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 InflowWind_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y_Hub, ErrStat2, ErrMsg2 ) ! y_Hub - 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 InflowWind_UnPackMisc - - - SUBROUTINE InflowWind_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(InflowWind_InputType), INTENT(IN) :: u(:) ! Input at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Inputs - TYPE(InflowWind_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 + ErrMsg = '' + if (allocated(InputData%PositionXYZ)) then + deallocate(InputData%PositionXYZ) + end if + call Lidar_DestroyInput(InputData%lidar, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine InflowWind_PackInput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(InflowWind_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'InflowWind_PackInput' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%PositionXYZ) + call Lidar_PackInput(RF, InData%lidar) + call RegPack(RF, InData%HubPosition) + call RegPack(RF, InData%HubOrientation) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine InflowWind_UnPackInput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(InflowWind_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'InflowWind_UnPackInput' + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%PositionXYZ); if (RegCheckErr(RF, RoutineName)) return + call Lidar_UnpackInput(RF, OutData%lidar) ! lidar + call RegUnpack(RF, OutData%HubPosition); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HubOrientation); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine InflowWind_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(InflowWind_OutputType), intent(in) :: SrcOutputData + type(InflowWind_OutputType), intent(inout) :: DstOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'InflowWind_CopyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcOutputData%VelocityUVW)) then + LB(1:2) = lbound(SrcOutputData%VelocityUVW) + UB(1:2) = ubound(SrcOutputData%VelocityUVW) + if (.not. allocated(DstOutputData%VelocityUVW)) then + allocate(DstOutputData%VelocityUVW(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%VelocityUVW.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%VelocityUVW = SrcOutputData%VelocityUVW + end if + if (allocated(SrcOutputData%AccelUVW)) then + LB(1:2) = lbound(SrcOutputData%AccelUVW) + UB(1:2) = ubound(SrcOutputData%AccelUVW) + if (.not. allocated(DstOutputData%AccelUVW)) then + allocate(DstOutputData%AccelUVW(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%AccelUVW.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%AccelUVW = SrcOutputData%AccelUVW + end if + if (allocated(SrcOutputData%WriteOutput)) then + LB(1:1) = lbound(SrcOutputData%WriteOutput) + UB(1:1) = ubound(SrcOutputData%WriteOutput) + if (.not. allocated(DstOutputData%WriteOutput)) then + allocate(DstOutputData%WriteOutput(LB(1):UB(1)), 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 + end if + DstOutputData%DiskVel = SrcOutputData%DiskVel + DstOutputData%HubVel = SrcOutputData%HubVel + call Lidar_CopyOutput(SrcOutputData%lidar, DstOutputData%lidar, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine InflowWind_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(InflowWind_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'InflowWind_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OutputData%VelocityUVW)) then + deallocate(OutputData%VelocityUVW) + end if + if (allocated(OutputData%AccelUVW)) then + deallocate(OutputData%AccelUVW) + end if + if (allocated(OutputData%WriteOutput)) then + deallocate(OutputData%WriteOutput) + end if + call Lidar_DestroyOutput(OutputData%lidar, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine InflowWind_PackOutput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(InflowWind_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'InflowWind_PackOutput' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%VelocityUVW) + call RegPackAlloc(RF, InData%AccelUVW) + call RegPackAlloc(RF, InData%WriteOutput) + call RegPack(RF, InData%DiskVel) + call RegPack(RF, InData%HubVel) + call Lidar_PackOutput(RF, InData%lidar) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine InflowWind_UnPackOutput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(InflowWind_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'InflowWind_UnPackOutput' + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%VelocityUVW); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AccelUVW); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WriteOutput); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DiskVel); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HubVel); if (RegCheckErr(RF, RoutineName)) return + call Lidar_UnpackOutput(RF, OutData%lidar) ! lidar +end subroutine + +subroutine InflowWind_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) + type(InflowWind_ContinuousStateType), intent(in) :: SrcContStateData + type(InflowWind_ContinuousStateType), intent(inout) :: DstContStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'InflowWind_CopyContState' + ErrStat = ErrID_None + ErrMsg = '' + DstContStateData%DummyContState = SrcContStateData%DummyContState +end subroutine + +subroutine InflowWind_DestroyContState(ContStateData, ErrStat, ErrMsg) + type(InflowWind_ContinuousStateType), intent(inout) :: ContStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'InflowWind_DestroyContState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine InflowWind_PackContState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(InflowWind_ContinuousStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'InflowWind_PackContState' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyContState) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine InflowWind_UnPackContState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(InflowWind_ContinuousStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'InflowWind_UnPackContState' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyContState); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine InflowWind_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) + type(InflowWind_DiscreteStateType), intent(in) :: SrcDiscStateData + type(InflowWind_DiscreteStateType), intent(inout) :: DstDiscStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'InflowWind_CopyDiscState' + ErrStat = ErrID_None + ErrMsg = '' + DstDiscStateData%DummyDiscState = SrcDiscStateData%DummyDiscState +end subroutine + +subroutine InflowWind_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) + type(InflowWind_DiscreteStateType), intent(inout) :: DiscStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'InflowWind_DestroyDiscState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine InflowWind_PackDiscState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(InflowWind_DiscreteStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'InflowWind_PackDiscState' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyDiscState) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine InflowWind_UnPackDiscState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(InflowWind_DiscreteStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'InflowWind_UnPackDiscState' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyDiscState); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine InflowWind_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) + type(InflowWind_ConstraintStateType), intent(in) :: SrcConstrStateData + type(InflowWind_ConstraintStateType), intent(inout) :: DstConstrStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'InflowWind_CopyConstrState' + ErrStat = ErrID_None + ErrMsg = '' + DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState +end subroutine + +subroutine InflowWind_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) + type(InflowWind_ConstraintStateType), intent(inout) :: ConstrStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'InflowWind_DestroyConstrState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine InflowWind_PackConstrState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(InflowWind_ConstraintStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'InflowWind_PackConstrState' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyConstrState) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine InflowWind_UnPackConstrState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(InflowWind_ConstraintStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'InflowWind_UnPackConstrState' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyConstrState); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine InflowWind_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) + type(InflowWind_OtherStateType), intent(in) :: SrcOtherStateData + type(InflowWind_OtherStateType), intent(inout) :: DstOtherStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'InflowWind_CopyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + DstOtherStateData%DummyOtherState = SrcOtherStateData%DummyOtherState +end subroutine + +subroutine InflowWind_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) + type(InflowWind_OtherStateType), intent(inout) :: OtherStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'InflowWind_DestroyOtherState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine InflowWind_PackOtherState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(InflowWind_OtherStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'InflowWind_PackOtherState' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyOtherState) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine InflowWind_UnPackOtherState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(InflowWind_OtherStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'InflowWind_UnPackOtherState' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyOtherState); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine InflowWind_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(InflowWind_MiscVarType), intent(in) :: SrcMiscData + type(InflowWind_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'InflowWind_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcMiscData%AllOuts)) then + LB(1:1) = lbound(SrcMiscData%AllOuts) + UB(1:1) = ubound(SrcMiscData%AllOuts) + if (.not. allocated(DstMiscData%AllOuts)) then + allocate(DstMiscData%AllOuts(LB(1):UB(1)), 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 + end if + if (allocated(SrcMiscData%WindViUVW)) then + LB(1:2) = lbound(SrcMiscData%WindViUVW) + UB(1:2) = ubound(SrcMiscData%WindViUVW) + if (.not. allocated(DstMiscData%WindViUVW)) then + allocate(DstMiscData%WindViUVW(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%WindViUVW.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%WindViUVW = SrcMiscData%WindViUVW + end if + if (allocated(SrcMiscData%WindAiUVW)) then + LB(1:2) = lbound(SrcMiscData%WindAiUVW) + UB(1:2) = ubound(SrcMiscData%WindAiUVW) + if (.not. allocated(DstMiscData%WindAiUVW)) then + allocate(DstMiscData%WindAiUVW(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%WindAiUVW.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%WindAiUVW = SrcMiscData%WindAiUVW + end if + call InflowWind_CopyInput(SrcMiscData%u_Avg, DstMiscData%u_Avg, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call InflowWind_CopyOutput(SrcMiscData%y_Avg, DstMiscData%y_Avg, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call InflowWind_CopyInput(SrcMiscData%u_Hub, DstMiscData%u_Hub, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call InflowWind_CopyOutput(SrcMiscData%y_Hub, DstMiscData%y_Hub, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine InflowWind_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(InflowWind_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'InflowWind_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(MiscData%AllOuts)) then + deallocate(MiscData%AllOuts) + end if + if (allocated(MiscData%WindViUVW)) then + deallocate(MiscData%WindViUVW) + end if + if (allocated(MiscData%WindAiUVW)) then + deallocate(MiscData%WindAiUVW) + end if + call InflowWind_DestroyInput(MiscData%u_Avg, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call InflowWind_DestroyOutput(MiscData%y_Avg, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call InflowWind_DestroyInput(MiscData%u_Hub, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call InflowWind_DestroyOutput(MiscData%y_Hub, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine InflowWind_PackMisc(RF, Indata) + type(RegFile), intent(inout) :: RF + type(InflowWind_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'InflowWind_PackMisc' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%AllOuts) + call RegPackAlloc(RF, InData%WindViUVW) + call RegPackAlloc(RF, InData%WindAiUVW) + call InflowWind_PackInput(RF, InData%u_Avg) + call InflowWind_PackOutput(RF, InData%y_Avg) + call InflowWind_PackInput(RF, InData%u_Hub) + call InflowWind_PackOutput(RF, InData%y_Hub) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine InflowWind_UnPackMisc(RF, OutData) + type(RegFile), intent(inout) :: RF + type(InflowWind_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'InflowWind_UnPackMisc' + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%AllOuts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WindViUVW); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WindAiUVW); if (RegCheckErr(RF, RoutineName)) return + call InflowWind_UnpackInput(RF, OutData%u_Avg) ! u_Avg + call InflowWind_UnpackOutput(RF, OutData%y_Avg) ! y_Avg + call InflowWind_UnpackInput(RF, OutData%u_Hub) ! u_Hub + call InflowWind_UnpackOutput(RF, OutData%y_Hub) ! y_Hub +end subroutine + +subroutine InflowWind_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(InflowWind_InputType), intent(in) :: u(:) ! Input at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Inputs + type(InflowWind_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 = 'InflowWind_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 InflowWind_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL InflowWind_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 InflowWind_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 InflowWind_Input_ExtrapInterp - - - SUBROUTINE InflowWind_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'InflowWind_Input_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(u)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(u)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(u) - 1 + select case (order) + case (0) + call InflowWind_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call InflowWind_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call InflowWind_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(u) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE InflowWind_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. @@ -5176,63 +1553,51 @@ SUBROUTINE InflowWind_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ! !.................................................................................................................................. - TYPE(InflowWind_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 - TYPE(InflowWind_InputType), INTENT(IN) :: u2 ! Input at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs - TYPE(InflowWind_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 + TYPE(InflowWind_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 + TYPE(InflowWind_InputType), INTENT(IN) :: u2 ! Input at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs + TYPE(InflowWind_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 = 'InflowWind_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 :: i02 ! dim2 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - INTEGER :: i2 ! dim2 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 + REAL(DbKi) :: t(2) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_Input_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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 :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 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%PositionXYZ) .AND. ALLOCATED(u1%PositionXYZ)) THEN - DO i2 = LBOUND(u_out%PositionXYZ,2),UBOUND(u_out%PositionXYZ,2) - DO i1 = LBOUND(u_out%PositionXYZ,1),UBOUND(u_out%PositionXYZ,1) - b = -(u1%PositionXYZ(i1,i2) - u2%PositionXYZ(i1,i2)) - u_out%PositionXYZ(i1,i2) = u1%PositionXYZ(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated - CALL Lidar_Input_ExtrapInterp1( u1%lidar, u2%lidar, tin, u_out%lidar, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - DO i1 = LBOUND(u_out%HubPosition,1),UBOUND(u_out%HubPosition,1) - b = -(u1%HubPosition(i1) - u2%HubPosition(i1)) - u_out%HubPosition(i1) = u1%HubPosition(i1) + b * ScaleFactor - END DO - DO i2 = LBOUND(u_out%HubOrientation,2),UBOUND(u_out%HubOrientation,2) - DO i1 = LBOUND(u_out%HubOrientation,1),UBOUND(u_out%HubOrientation,1) - b = -(u1%HubOrientation(i1,i2) - u2%HubOrientation(i1,i2)) - u_out%HubOrientation(i1,i2) = u1%HubOrientation(i1,i2) + b * ScaleFactor - END DO - END DO - END SUBROUTINE InflowWind_Input_ExtrapInterp1 - - - SUBROUTINE InflowWind_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + IF (ALLOCATED(u_out%PositionXYZ) .AND. ALLOCATED(u1%PositionXYZ)) THEN + u_out%PositionXYZ = a1*u1%PositionXYZ + a2*u2%PositionXYZ + END IF ! check if allocated + CALL Lidar_Input_ExtrapInterp1( u1%lidar, u2%lidar, tin, u_out%lidar, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + u_out%HubPosition = a1*u1%HubPosition + a2*u2%HubPosition + u_out%HubOrientation = a1*u1%HubOrientation + a2*u2%HubOrientation +END SUBROUTINE + +SUBROUTINE InflowWind_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. @@ -5246,126 +1611,111 @@ SUBROUTINE InflowWind_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrSt ! !.................................................................................................................................. - TYPE(InflowWind_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 > t3 - TYPE(InflowWind_InputType), INTENT(IN) :: u2 ! Input at t2 > t3 - TYPE(InflowWind_InputType), INTENT(IN) :: u3 ! Input at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs - TYPE(InflowWind_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 + TYPE(InflowWind_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 > t3 + TYPE(InflowWind_InputType), INTENT(IN) :: u2 ! Input at t2 > t3 + TYPE(InflowWind_InputType), INTENT(IN) :: u3 ! Input at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs + TYPE(InflowWind_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 = 'InflowWind_Input_ExtrapInterp2' - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - INTEGER :: i2 ! dim2 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) - + 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) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_Input_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 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 + 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 + 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 + 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%PositionXYZ) .AND. ALLOCATED(u1%PositionXYZ)) THEN - DO i2 = LBOUND(u_out%PositionXYZ,2),UBOUND(u_out%PositionXYZ,2) - DO i1 = LBOUND(u_out%PositionXYZ,1),UBOUND(u_out%PositionXYZ,1) - b = (t(3)**2*(u1%PositionXYZ(i1,i2) - u2%PositionXYZ(i1,i2)) + t(2)**2*(-u1%PositionXYZ(i1,i2) + u3%PositionXYZ(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*u1%PositionXYZ(i1,i2) + t(3)*u2%PositionXYZ(i1,i2) - t(2)*u3%PositionXYZ(i1,i2) ) * scaleFactor - u_out%PositionXYZ(i1,i2) = u1%PositionXYZ(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated - CALL Lidar_Input_ExtrapInterp2( u1%lidar, u2%lidar, u3%lidar, tin, u_out%lidar, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - DO i1 = LBOUND(u_out%HubPosition,1),UBOUND(u_out%HubPosition,1) - b = (t(3)**2*(u1%HubPosition(i1) - u2%HubPosition(i1)) + t(2)**2*(-u1%HubPosition(i1) + u3%HubPosition(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%HubPosition(i1) + t(3)*u2%HubPosition(i1) - t(2)*u3%HubPosition(i1) ) * scaleFactor - u_out%HubPosition(i1) = u1%HubPosition(i1) + b + c * t_out - END DO - DO i2 = LBOUND(u_out%HubOrientation,2),UBOUND(u_out%HubOrientation,2) - DO i1 = LBOUND(u_out%HubOrientation,1),UBOUND(u_out%HubOrientation,1) - b = (t(3)**2*(u1%HubOrientation(i1,i2) - u2%HubOrientation(i1,i2)) + t(2)**2*(-u1%HubOrientation(i1,i2) + u3%HubOrientation(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*u1%HubOrientation(i1,i2) + t(3)*u2%HubOrientation(i1,i2) - t(2)*u3%HubOrientation(i1,i2) ) * scaleFactor - u_out%HubOrientation(i1,i2) = u1%HubOrientation(i1,i2) + b + c * t_out - END DO - END DO - END SUBROUTINE InflowWind_Input_ExtrapInterp2 - - - SUBROUTINE InflowWind_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(InflowWind_OutputType), INTENT(IN) :: y(:) ! Output at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Outputs - TYPE(InflowWind_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 + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + IF (ALLOCATED(u_out%PositionXYZ) .AND. ALLOCATED(u1%PositionXYZ)) THEN + u_out%PositionXYZ = a1*u1%PositionXYZ + a2*u2%PositionXYZ + a3*u3%PositionXYZ + END IF ! check if allocated + CALL Lidar_Input_ExtrapInterp2( u1%lidar, u2%lidar, u3%lidar, tin, u_out%lidar, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + u_out%HubPosition = a1*u1%HubPosition + a2*u2%HubPosition + a3*u3%HubPosition + u_out%HubOrientation = a1*u1%HubOrientation + a2*u2%HubOrientation + a3*u3%HubOrientation +END SUBROUTINE + +subroutine InflowWind_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(InflowWind_OutputType), intent(in) :: y(:) ! Output at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Outputs + type(InflowWind_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 = 'InflowWind_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 InflowWind_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL InflowWind_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 InflowWind_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 InflowWind_Output_ExtrapInterp - - - SUBROUTINE InflowWind_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'InflowWind_Output_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(y)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(y)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(y) - 1 + select case (order) + case (0) + call InflowWind_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call InflowWind_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call InflowWind_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(y) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE InflowWind_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. @@ -5377,75 +1727,57 @@ SUBROUTINE InflowWind_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ! !.................................................................................................................................. - TYPE(InflowWind_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 - TYPE(InflowWind_OutputType), INTENT(IN) :: y2 ! Output at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs - TYPE(InflowWind_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 + TYPE(InflowWind_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 + TYPE(InflowWind_OutputType), INTENT(IN) :: y2 ! Output at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs + TYPE(InflowWind_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 = 'InflowWind_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 :: i02 ! dim2 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - INTEGER :: i2 ! dim2 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 + REAL(DbKi) :: t(2) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_Output_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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 :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 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%VelocityUVW) .AND. ALLOCATED(y1%VelocityUVW)) THEN - DO i2 = LBOUND(y_out%VelocityUVW,2),UBOUND(y_out%VelocityUVW,2) - DO i1 = LBOUND(y_out%VelocityUVW,1),UBOUND(y_out%VelocityUVW,1) - b = -(y1%VelocityUVW(i1,i2) - y2%VelocityUVW(i1,i2)) - y_out%VelocityUVW(i1,i2) = y1%VelocityUVW(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%AccelUVW) .AND. ALLOCATED(y1%AccelUVW)) THEN - DO i2 = LBOUND(y_out%AccelUVW,2),UBOUND(y_out%AccelUVW,2) - DO i1 = LBOUND(y_out%AccelUVW,1),UBOUND(y_out%AccelUVW,1) - b = -(y1%AccelUVW(i1,i2) - y2%AccelUVW(i1,i2)) - y_out%AccelUVW(i1,i2) = y1%AccelUVW(i1,i2) + b * ScaleFactor - END DO - 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 - DO i1 = LBOUND(y_out%DiskVel,1),UBOUND(y_out%DiskVel,1) - b = -(y1%DiskVel(i1) - y2%DiskVel(i1)) - y_out%DiskVel(i1) = y1%DiskVel(i1) + b * ScaleFactor - END DO - DO i1 = LBOUND(y_out%HubVel,1),UBOUND(y_out%HubVel,1) - b = -(y1%HubVel(i1) - y2%HubVel(i1)) - y_out%HubVel(i1) = y1%HubVel(i1) + b * ScaleFactor - END DO - CALL Lidar_Output_ExtrapInterp1( y1%lidar, y2%lidar, tin, y_out%lidar, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - END SUBROUTINE InflowWind_Output_ExtrapInterp1 - - - SUBROUTINE InflowWind_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + IF (ALLOCATED(y_out%VelocityUVW) .AND. ALLOCATED(y1%VelocityUVW)) THEN + y_out%VelocityUVW = a1*y1%VelocityUVW + a2*y2%VelocityUVW + END IF ! check if allocated + IF (ALLOCATED(y_out%AccelUVW) .AND. ALLOCATED(y1%AccelUVW)) THEN + y_out%AccelUVW = a1*y1%AccelUVW + a2*y2%AccelUVW + END IF ! check if allocated + IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + END IF ! check if allocated + y_out%DiskVel = a1*y1%DiskVel + a2*y2%DiskVel + y_out%HubVel = a1*y1%HubVel + a2*y2%HubVel + CALL Lidar_Output_ExtrapInterp1( y1%lidar, y2%lidar, tin, y_out%lidar, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) +END SUBROUTINE + +SUBROUTINE InflowWind_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. @@ -5459,86 +1791,62 @@ SUBROUTINE InflowWind_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrS ! !.................................................................................................................................. - TYPE(InflowWind_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 > t3 - TYPE(InflowWind_OutputType), INTENT(IN) :: y2 ! Output at t2 > t3 - TYPE(InflowWind_OutputType), INTENT(IN) :: y3 ! Output at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs - TYPE(InflowWind_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 + TYPE(InflowWind_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 > t3 + TYPE(InflowWind_OutputType), INTENT(IN) :: y2 ! Output at t2 > t3 + TYPE(InflowWind_OutputType), INTENT(IN) :: y3 ! Output at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs + TYPE(InflowWind_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 = 'InflowWind_Output_ExtrapInterp2' - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - INTEGER :: i2 ! dim2 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) - + 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) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 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 + 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 + 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 + 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%VelocityUVW) .AND. ALLOCATED(y1%VelocityUVW)) THEN - DO i2 = LBOUND(y_out%VelocityUVW,2),UBOUND(y_out%VelocityUVW,2) - DO i1 = LBOUND(y_out%VelocityUVW,1),UBOUND(y_out%VelocityUVW,1) - b = (t(3)**2*(y1%VelocityUVW(i1,i2) - y2%VelocityUVW(i1,i2)) + t(2)**2*(-y1%VelocityUVW(i1,i2) + y3%VelocityUVW(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*y1%VelocityUVW(i1,i2) + t(3)*y2%VelocityUVW(i1,i2) - t(2)*y3%VelocityUVW(i1,i2) ) * scaleFactor - y_out%VelocityUVW(i1,i2) = y1%VelocityUVW(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%AccelUVW) .AND. ALLOCATED(y1%AccelUVW)) THEN - DO i2 = LBOUND(y_out%AccelUVW,2),UBOUND(y_out%AccelUVW,2) - DO i1 = LBOUND(y_out%AccelUVW,1),UBOUND(y_out%AccelUVW,1) - b = (t(3)**2*(y1%AccelUVW(i1,i2) - y2%AccelUVW(i1,i2)) + t(2)**2*(-y1%AccelUVW(i1,i2) + y3%AccelUVW(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*y1%AccelUVW(i1,i2) + t(3)*y2%AccelUVW(i1,i2) - t(2)*y3%AccelUVW(i1,i2) ) * scaleFactor - y_out%AccelUVW(i1,i2) = y1%AccelUVW(i1,i2) + b + c * t_out - END DO - 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 - DO i1 = LBOUND(y_out%DiskVel,1),UBOUND(y_out%DiskVel,1) - b = (t(3)**2*(y1%DiskVel(i1) - y2%DiskVel(i1)) + t(2)**2*(-y1%DiskVel(i1) + y3%DiskVel(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%DiskVel(i1) + t(3)*y2%DiskVel(i1) - t(2)*y3%DiskVel(i1) ) * scaleFactor - y_out%DiskVel(i1) = y1%DiskVel(i1) + b + c * t_out - END DO - DO i1 = LBOUND(y_out%HubVel,1),UBOUND(y_out%HubVel,1) - b = (t(3)**2*(y1%HubVel(i1) - y2%HubVel(i1)) + t(2)**2*(-y1%HubVel(i1) + y3%HubVel(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%HubVel(i1) + t(3)*y2%HubVel(i1) - t(2)*y3%HubVel(i1) ) * scaleFactor - y_out%HubVel(i1) = y1%HubVel(i1) + b + c * t_out - END DO - CALL Lidar_Output_ExtrapInterp2( y1%lidar, y2%lidar, y3%lidar, tin, y_out%lidar, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - END SUBROUTINE InflowWind_Output_ExtrapInterp2 - + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + IF (ALLOCATED(y_out%VelocityUVW) .AND. ALLOCATED(y1%VelocityUVW)) THEN + y_out%VelocityUVW = a1*y1%VelocityUVW + a2*y2%VelocityUVW + a3*y3%VelocityUVW + END IF ! check if allocated + IF (ALLOCATED(y_out%AccelUVW) .AND. ALLOCATED(y1%AccelUVW)) THEN + y_out%AccelUVW = a1*y1%AccelUVW + a2*y2%AccelUVW + a3*y3%AccelUVW + END IF ! check if allocated + IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + a3*y3%WriteOutput + END IF ! check if allocated + y_out%DiskVel = a1*y1%DiskVel + a2*y2%DiskVel + a3*y3%DiskVel + y_out%HubVel = a1*y1%HubVel + a2*y2%HubVel + a3*y3%HubVel + CALL Lidar_Output_ExtrapInterp2( y1%lidar, y2%lidar, y3%lidar, tin, y_out%lidar, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) +END SUBROUTINE END MODULE InflowWind_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/inflowwind/src/Lidar.f90 b/modules/inflowwind/src/Lidar.f90 index 9a83c4ce9b..ddb5861b0e 100644 --- a/modules/inflowwind/src/Lidar.f90 +++ b/modules/inflowwind/src/Lidar.f90 @@ -336,15 +336,14 @@ SUBROUTINE Lidar_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMs REAL(ReKi) :: Distance(3) ! distance vector between input measurement and lidar positions - TYPE(InflowWind_InputType) :: Input ! position where wind speed should be returned - TYPE(InflowWind_OutputType) :: Output ! velocity at Input%Position - REAL(ReKi) :: LidPosition(3) ! Lidar Position - REAL(ReKi) :: LidPosition_N(3) !Transformed Lidar Position - REAL(ReKi) :: LidarMsrPosition(3) !Transformed Lidar Position - REAL(ReKi) :: MeasurementCurrentStep + REAL(ReKi) :: LidPosition(3) ! Lidar Position + REAL(ReKi) :: LidarMsrPosition(3) !Transformed Lidar Position + REAL(ReKi) :: MeasurementCurrentStep - REAL(ReKi) :: OutputVelocity(3) + REAL(ReKi) :: PositionXYZ(3,2) + REAL(ReKi) :: VelocityUVW(3,2) + REAL(ReKi), allocatable :: AccelUVW(:,:) INTEGER(IntKi) :: IBeam INTEGER(IntKi) :: IRangeGt @@ -359,56 +358,45 @@ SUBROUTINE Lidar_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMs ErrStat = ErrID_None ErrMsg = "" - MeasurementCurrentStep = INT(t / p%lidar%MeasurementInterval) + MeasurementCurrentStep = INT(t / p%lidar%MeasurementInterval) IF ( (p%lidar%MeasurementInterval * MeasurementCurrentStep) /= t ) THEN -!This isn't returned, so don't set it. -! Output%VelocityUVW(:,1) = 0 - RETURN + VelocityUVW(:,1) = 0 + RETURN ENDIF - IF (p%lidar%ConsiderHubMotion == 1) THEN - LidPosition_N = (/ u%lidar%HubDisplacementX, u%lidar%HubDisplacementY, u%lidar%HubDisplacementZ /) & ! rotor apex position (absolute) - + p%lidar%RotorApexOffsetPos ! lidar offset-from-rotor-apex position - LidPosition = p%lidar%LidPosition + LidPosition_N - ELSE - LidPosition_N = p%lidar%RotorApexOffsetPos - LidPosition = p%lidar%LidPosition + LidPosition_N - END IF + LidPosition = p%lidar%LidPosition + p%lidar%RotorApexOffsetPos ! lidar offset-from-rotor-apex position + IF (p%lidar%ConsiderHubMotion == 1) THEN + LidPosition = LidPosition + (/ u%lidar%HubDisplacementX, u%lidar%HubDisplacementY, u%lidar%HubDisplacementZ /) ! rotor apex position (absolute) + END IF IF (p%lidar%SensorType == SensorType_None) RETURN - ! allocate arrays to compute outputs - CALL AllocAry(Input%PositionXYZ, 3,1, 'Input%PositionXYZ',ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - CALL AllocAry(Output%VelocityUVW, 3,1, 'Output%VelocityUVW',ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF - !............................................................................................................................... ! Compute the outputs !............................................................................................................................... + ! Initialize position to zero in case no all values are set + PositionXYZ = 0.0_ReKi IF (p%lidar%SensorType == SensorType_SinglePoint) THEN + DO IBeam = 1,p%lidar%NumBeam - !get lidar speed at the focal point to see if it is out of bounds - Input%PositionXYZ(:,1) = LidPosition + p%lidar%MsrPosition(:,IBeam) - CALL CalculateOutput( t, Input, p, x, xd, z, OtherState, Output, m, .FALSE., ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - y%lidar%LidSpeed(IBeam) = SQRT( DOT_PRODUCT(Output%VelocityUVW(:,1), Output%VelocityUVW(:,1)) ) - y%lidar%WtTrunc = 1.0_ReKi - - y%lidar%MsrPositionsX(IBeam) = Input%PositionXYZ(1,1) - y%lidar%MsrPositionsY(IBeam) = Input%PositionXYZ(2,1) - y%lidar%MsrPositionsZ(IBeam) = Input%PositionXYZ(3,1) - + + !get lidar speed at the focal point to see if it is out of bounds + PositionXYZ(:,1) = LidPosition + p%lidar%MsrPosition(:,IBeam) + + call IfW_FlowField_GetVelAcc(p%FlowField, 0, t, PositionXYZ, VelocityUVW, & + AccelUVW, ErrStat2, ErrMsg2, BoxExceedAllow=.true.) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + y%lidar%LidSpeed(IBeam) = SQRT( DOT_PRODUCT(VelocityUVW(:,1), VelocityUVW(:,1)) ) + y%lidar%WtTrunc = 1.0_ReKi + + y%lidar%MsrPositionsX(IBeam) = PositionXYZ(1,1) + y%lidar%MsrPositionsY(IBeam) = PositionXYZ(2,1) + y%lidar%MsrPositionsZ(IBeam) = PositionXYZ(3,1) + END DO ELSEIF (p%lidar%SensorType == SensorType_ContinuousLidar) THEN @@ -422,7 +410,6 @@ SUBROUTINE Lidar_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMs y%lidar%LidSpeed = -99.0 y%lidar%WtTrunc = 0.0 CALL SetErrStat(ErrID_Fatal,"Measurement position cannot be the same as the lidar position.", ErrStat, ErrMsg, RoutineName) - CALL Cleanup() RETURN END IF @@ -442,24 +429,24 @@ SUBROUTINE Lidar_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMs LidWtRatio = 1.0_ReKi !LidWt/LidWtMax !get lidar speed at the focal point to see if it is out of bounds - Input%PositionXYZ(:,1) = LidPosition + p%lidar%MsrPosition(:,1) + PositionXYZ(:,1) = LidPosition + p%lidar%MsrPosition(:,1) y%lidar%MsrPositionsX(1) = LidPosition(1) + p%lidar%MsrPosition(1,1) y%lidar%MsrPositionsY(1) = LidPosition(2) + p%lidar%MsrPosition(2,1) y%lidar%MsrPositionsZ(1) = LidPosition(3) + p%lidar%MsrPosition(3,1) - - CALL CalculateOutput( t, Input, p, x, xd, z, OtherState, Output, m, .FALSE., ErrStat2, ErrMsg2 ) + + CALL IfW_FlowField_GetVelAcc(p%FlowField, 0, t, PositionXYZ, VelocityUVW, & + AccelUVW, ErrStat2, ErrMsg2, BoxExceedAllow=.true.) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) !if out of bounds IF (ErrStat >= AbortErrLev) THEN !y%lidar%LidErr = 1 y%lidar%LidSpeed = -99.0 - CALL Cleanup() RETURN !escape function ENDIF - y%lidar%LidSpeed = LidWt*DOT_PRODUCT(-1*LidDirUnVec,Output%VelocityUVW(:,1)) + y%lidar%LidSpeed = LidWt*DOT_PRODUCT(-1*LidDirUnVec,VelocityUVW(:,1)) WtFuncSum = LidWt y%lidar%WtTrunc = p%lidar%WtFnTrunc @@ -467,8 +454,6 @@ SUBROUTINE Lidar_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMs !initialize lidar range LidRange = 0. - - !calculate the weighted lidar returns DO @@ -496,40 +481,27 @@ SUBROUTINE Lidar_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMs !calculate points to scan for current beam point - Input%PositionXYZ(3,1) = LidPosition(3) + SIN(LidPhi)*(LidRange + FocDist) - Input%PositionXYZ(1,1) = LidPosition(1) - COS(LidTheta)*COS(LidPhi)*(LidRange + FocDist) - Input%PositionXYZ(2,1) = LidPosition(2) + SIN(LidTheta)*COS(LidPhi)*(LidRange + FocDist) + PositionXYZ(3,1) = LidPosition(3) + SIN(LidPhi)*(LidRange + FocDist) + PositionXYZ(1,1) = LidPosition(1) - COS(LidTheta)*COS(LidPhi)*(LidRange + FocDist) + PositionXYZ(2,1) = LidPosition(2) + SIN(LidTheta)*COS(LidPhi)*(LidRange + FocDist) + + !calculate points to scan for current beam point + PositionXYZ(3,2) = LidPosition(3) + SIN(LidPhi)*(FocDist - LidRange) + PositionXYZ(1,2) = LidPosition(1) - COS(LidTheta)*COS(LidPhi)*(FocDist - LidRange) + PositionXYZ(2,2) = LidPosition(2) + SIN(LidTheta)*COS(LidPhi)*(FocDist - LidRange) - CALL CalculateOutput( t, Input, p, x, xd, z, OtherState, Output, m, .FALSE., ErrStat2, ErrMsg2 ) - IF (ErrStat2 >= AbortErrLev ) THEN !out of bounds - IF (NWTC_VerboseLevel == NWTC_Verbose) & - CALL SetErrStat( ErrID_Warn, "Lidar speed truncated. Truncation ratio is "//trim(num2lstr(LidWtRatio))//".", ErrStat, ErrMsg, RoutineName ) - !y%LidErr = 2 + CALL IfW_FlowField_GetVelAcc(p%FlowField, 0, t, PositionXYZ, VelocityUVW, & + AccelUVW, ErrStat2, ErrMsg2, BoxExceedAllow=.true.) + IF (ErrStat2 >= AbortErrLev) THEN !out of bounds + IF (NWTC_VerboseLevel == NWTC_Verbose) & + CALL SetErrStat( ErrID_Warn, "Lidar speed truncated. Truncation ratio is "//trim(num2lstr(LidWtRatio))//".", ErrStat, ErrMsg, RoutineName ) + !y%LidErr = 2 y%lidar%WtTrunc = LidWtRatio - EXIT - ENDIF + EXIT + ENDIF - OutputVelocity = Output%VelocityUVW(:,1) - - - !calculate points to scan for current beam point - Input%PositionXYZ(3,1) = LidPosition(3) + SIN(LidPhi)*(FocDist - LidRange) - Input%PositionXYZ(1,1) = LidPosition(1) - COS(LidTheta)*COS(LidPhi)*(FocDist - LidRange) - Input%PositionXYZ(2,1) = LidPosition(2) + SIN(LidTheta)*COS(LidPhi)*(FocDist - LidRange) - - CALL CalculateOutput( t, Input, p, x, xd, z, OtherState, Output, m, .FALSE., ErrStat2, ErrMsg2 ) - IF (ErrStat2 >= AbortErrLev) THEN !out of bounds - IF (NWTC_VerboseLevel == NWTC_Verbose) & - CALL SetErrStat( ErrID_Warn, "Lidar speed truncated. Truncation ratio is "//trim(num2lstr(LidWtRatio))//".", ErrStat, ErrMsg, RoutineName ) - !y%lidar%LidErr = 2 - y%lidar%WtTrunc = LidWtRatio - EXIT - ENDIF - - - y%lidar%LidSpeed = y%lidar%LidSpeed + LidWt*DOT_PRODUCT(-1*LidDirUnVec, OutputVelocity + Output%VelocityUVW(:,1)) + y%lidar%LidSpeed = y%lidar%LidSpeed + LidWt*DOT_PRODUCT(-1*LidDirUnVec, VelocityUVW(:,1) + VelocityUVW(:,2)) WtFuncSum = WtFuncSum + 2*LidWt - END DO @@ -560,13 +532,14 @@ SUBROUTINE Lidar_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMs LidPosition(3) = LidPosition(3) + p%lidar%MsrPosition(3,1) !get lidar speed at the focal point to see if it is out of bounds - Input%PositionXYZ(:,1) = LidPosition + LidDirUnVec*(-p%lidar%MsrPosition(1,1) - (IRangeGt-1)*p%lidar%PulseSpacing) + PositionXYZ(:,1) = LidPosition + LidDirUnVec*(-p%lidar%MsrPosition(1,1) - (IRangeGt-1)*p%lidar%PulseSpacing) y%lidar%MsrPositionsX(IRangeGt) = LidPosition(1) + LidDirUnVec(1)*(-p%lidar%MsrPosition(1,1) - (IRangeGt-1)*p%lidar%PulseSpacing) y%lidar%MsrPositionsY(IRangeGt) = LidPosition(2) + p%lidar%MsrPosition(2,1) y%lidar%MsrPositionsZ(IRangeGt) = LidPosition(3) + p%lidar%MsrPosition(3,1) - CALL CalculateOutput( t, Input, p, x, xd, z, OtherState, Output, m, .FALSE., ErrStat2, ErrMsg2 ) + CALL IfW_FlowField_GetVelAcc(p%FlowField, 0, t, PositionXYZ, VelocityUVW, & + AccelUVW, ErrStat2, ErrMsg2, BoxExceedAllow=.true.) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) LidWt = NWTC_ERF((p%lidar%PulseSpacing/2)/p%lidar%r_p)/p%lidar%PulseSpacing @@ -578,11 +551,10 @@ SUBROUTINE Lidar_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMs IF (ErrStat2 >= AbortErrLev) THEN !y%LidErr(IRangeGt) = 1 y%lidar%LidSpeed(IRangeGt) = -99 - CALL Cleanup() RETURN !escape function ENDIF - y%lidar%LidSpeed(IRangeGt) = LidWt*DOT_PRODUCT(-1*LidDirUnVec,Output%VelocityUVW(:,1)) + y%lidar%LidSpeed(IRangeGt) = LidWt*DOT_PRODUCT(-1*LidDirUnVec,VelocityUVW(:,1)) WtFuncSum = LidWt y%lidar%WtTrunc(IRangeGt) = p%lidar%WtFnTrunc @@ -615,8 +587,10 @@ SUBROUTINE Lidar_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMs !calculate points to scan for current beam point - Input%PositionXYZ(:,1) = LidPosition + LidDirUnVec*(-p%lidar%MsrPosition(1,1) - (IRangeGt-1)*p%lidar%PulseSpacing + LidRange) - CALL CalculateOutput( t, Input, p, x, xd, z, OtherState, Output, m, .FALSE., ErrStat2, ErrMsg2 ) + PositionXYZ(:,1) = LidPosition + LidDirUnVec*(-p%lidar%MsrPosition(1,1) - (IRangeGt-1)*p%lidar%PulseSpacing + LidRange) + PositionXYZ(:,2) = LidPosition + LidDirUnVec*(-p%lidar%MsrPosition(1,1) - (IRangeGt-1)*p%lidar%PulseSpacing - LidRange) + CALL IfW_FlowField_GetVelAcc(p%FlowField, 0, t, PositionXYZ, VelocityUVW, & + AccelUVW, ErrStat2, ErrMsg2, BoxExceedAllow=.true.) IF (ErrStat2 >= AbortErrLev) THEN !out of bounds IF (NWTC_VerboseLevel == NWTC_Verbose) & CALL SetErrStat( ErrID_Warn, "Lidar speed at gate "//trim(num2lstr(IRangeGt))//" truncated. Truncation ratio is "//trim(num2lstr(LidWtRatio))//".", ErrStat, ErrMsg, RoutineName ) @@ -624,21 +598,8 @@ SUBROUTINE Lidar_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMs y%lidar%WtTrunc(IRangeGt) = LidWtRatio EXIT ENDIF - OutputVelocity = Output%VelocityUVW(:,1) - - !calculate points to scan for current beam point - Input%PositionXYZ(:,1) = LidPosition + LidDirUnVec*(-p%lidar%MsrPosition(1,1) - (IRangeGt-1)*p%lidar%PulseSpacing - LidRange) - CALL CalculateOutput( t, Input, p, x, xd, z, OtherState, Output, m, .FALSE., ErrStat2, ErrMsg2 ) - IF (ErrStat2 >= AbortErrLev) THEN !out of bounds - IF (NWTC_VerboseLevel == NWTC_Verbose) & - CALL SetErrStat( ErrID_Warn, "Lidar speed at gate "//trim(num2lstr(IRangeGt))//" truncated. Truncation ratio is "//trim(num2lstr(LidWtRatio))//".", ErrStat, ErrMsg, RoutineName ) - !y%lidar%LidErr(IRangeGt) = 2 - y%lidar%WtTrunc(IRangeGt) = LidWtRatio - EXIT - ENDIF - - y%lidar%LidSpeed(IRangeGt) = y%lidar%LidSpeed(IRangeGt) + LidWt*DOT_PRODUCT(-1*LidDirUnVec,Output%VelocityUVW(:,1) + OutputVelocity) + y%lidar%LidSpeed(IRangeGt) = y%lidar%LidSpeed(IRangeGt) + LidWt*DOT_PRODUCT(-1*LidDirUnVec,VelocityUVW(:,1) + VelocityUVW(:,2)) WtFuncSum = WtFuncSum + 2*LidWt END DO @@ -655,17 +616,6 @@ SUBROUTINE Lidar_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMs END DO END IF - - CALL Cleanup() - - RETURN -CONTAINS - SUBROUTINE Cleanup() - - IF (ALLOCATED(Input%PositionXYZ)) DEALLOCATE(Input%PositionXYZ) - IF (ALLOCATED(Output%VelocityUVW)) DEALLOCATE(Output%VelocityUVW) - - END SUBROUTINE Cleanup END SUBROUTINE Lidar_CalcOutput !---------------------------------------------------------------------------------------------------------------------------------- diff --git a/modules/inflowwind/src/Lidar_Types.f90 b/modules/inflowwind/src/Lidar_Types.f90 index f95da86717..8277eb6a54 100644 --- a/modules/inflowwind/src/Lidar_Types.f90 +++ b/modules/inflowwind/src/Lidar_Types.f90 @@ -33,85 +33,85 @@ MODULE Lidar_Types !--------------------------------------------------------------------------------------------------------------------------------- USE NWTC_Library IMPLICIT NONE - INTEGER(IntKi), PUBLIC, PARAMETER :: SensorType_None = 0 - INTEGER(IntKi), PUBLIC, PARAMETER :: SensorType_SinglePoint = 1 - INTEGER(IntKi), PUBLIC, PARAMETER :: SensorType_ContinuousLidar = 2 - INTEGER(IntKi), PUBLIC, PARAMETER :: SensorType_PulsedLidar = 3 + INTEGER(IntKi), PUBLIC, PARAMETER :: SensorType_None = 0 + INTEGER(IntKi), PUBLIC, PARAMETER :: SensorType_SinglePoint = 1 + INTEGER(IntKi), PUBLIC, PARAMETER :: SensorType_ContinuousLidar = 2 + INTEGER(IntKi), PUBLIC, PARAMETER :: SensorType_PulsedLidar = 3 ! ========= Lidar_InitInputType ======= TYPE, PUBLIC :: Lidar_InitInputType INTEGER(IntKi) :: SensorType = SensorType_None !< SensorType_* parameter [-] - REAL(DbKi) :: Tmax !< the length of the simulation [s] - REAL(ReKi) , DIMENSION(1:3) :: RotorApexOffsetPos !< position of the lidar unit relative to the rotor apex of rotation [m] - REAL(ReKi) , DIMENSION(1:3) :: HubPosition !< initial position of the hub (lidar mounted on hub) [0,0,HubHeight] [m] - INTEGER(IntKi) :: NumPulseGate !< the number of range gates to return wind speeds at [-] - LOGICAL :: LidRadialVel !< TRUE => return radial component, FALSE => return 'x' direction estimate [-] + REAL(DbKi) :: Tmax = 0.0_R8Ki !< the length of the simulation [s] + REAL(ReKi) , DIMENSION(1:3) :: RotorApexOffsetPos = 0.0_ReKi !< position of the lidar unit relative to the rotor apex of rotation [m] + REAL(ReKi) , DIMENSION(1:3) :: HubPosition = 0.0_ReKi !< initial position of the hub (lidar mounted on hub) [0,0,HubHeight] [m] + INTEGER(IntKi) :: NumPulseGate = 0_IntKi !< the number of range gates to return wind speeds at [-] + LOGICAL :: LidRadialVel = .false. !< TRUE => return radial component, FALSE => return 'x' direction estimate [-] END TYPE Lidar_InitInputType ! ======================= ! ========= Lidar_InitOutputType ======= TYPE, PUBLIC :: Lidar_InitOutputType - REAL(ReKi) :: DummyInitOut + REAL(ReKi) :: DummyInitOut = 0.0_ReKi END TYPE Lidar_InitOutputType ! ======================= ! ========= Lidar_ParameterType ======= TYPE, PUBLIC :: Lidar_ParameterType - INTEGER(IntKi) :: NumPulseGate !< the number of range gates to return wind speeds at; pulsed lidar only [-] - REAL(ReKi) , DIMENSION(1:3) :: RotorApexOffsetPos !< position of the lidar unit relative to the rotor apex of rotation [m] - REAL(ReKi) :: RayRangeSq !< Rayleigh Range Squared [-] - REAL(ReKi) :: SpatialRes !< spatial sampling distance of weighting function (1/2)*(avg ws)*dt [-] - INTEGER(IntKi) :: SensorType !< SensorType_* parameter [-] - REAL(ReKi) :: WtFnTrunc !< Percentage of the peak value at which to truncate weighting function [-] - REAL(ReKi) :: PulseRangeOne !< the range to the closest range gate [m] - REAL(ReKi) :: DeltaP !< the distance between range gates [m] - REAL(ReKi) :: DeltaR !< the FWHM width of the pulse [-] - REAL(ReKi) :: r_p - LOGICAL :: LidRadialVel !< TRUE => return radial component, FALSE => return 'x' direction estimate [-] - REAL(ReKi) :: DisplacementLidarX !< Displacement of the lidar system from the focal measurement point [m] - REAL(ReKi) :: DisplacementLidarY !< Displacement of the lidar system from the focal measurement point [m] - REAL(ReKi) :: DisplacementLidarZ !< Displacement of the lidar system from the focal measurement point [m] - INTEGER(IntKi) :: NumBeam !< Number of lidar beams [-] + INTEGER(IntKi) :: NumPulseGate = 0_IntKi !< the number of range gates to return wind speeds at; pulsed lidar only [-] + REAL(ReKi) , DIMENSION(1:3) :: RotorApexOffsetPos = 0.0_ReKi !< position of the lidar unit relative to the rotor apex of rotation [m] + REAL(ReKi) :: RayRangeSq = 0.0_ReKi !< Rayleigh Range Squared [-] + REAL(ReKi) :: SpatialRes = 0.0_ReKi !< spatial sampling distance of weighting function (1/2)*(avg ws)*dt [-] + INTEGER(IntKi) :: SensorType = 0_IntKi !< SensorType_* parameter [-] + REAL(ReKi) :: WtFnTrunc = 0.0_ReKi !< Percentage of the peak value at which to truncate weighting function [-] + REAL(ReKi) :: PulseRangeOne = 0.0_ReKi !< the range to the closest range gate [m] + REAL(ReKi) :: DeltaP = 0.0_ReKi !< the distance between range gates [m] + REAL(ReKi) :: DeltaR = 0.0_ReKi !< the FWHM width of the pulse [-] + REAL(ReKi) :: r_p = 0.0_ReKi + LOGICAL :: LidRadialVel = .false. !< TRUE => return radial component, FALSE => return 'x' direction estimate [-] + REAL(ReKi) :: DisplacementLidarX = 0.0_ReKi !< Displacement of the lidar system from the focal measurement point [m] + REAL(ReKi) :: DisplacementLidarY = 0.0_ReKi !< Displacement of the lidar system from the focal measurement point [m] + REAL(ReKi) :: DisplacementLidarZ = 0.0_ReKi !< Displacement of the lidar system from the focal measurement point [m] + INTEGER(IntKi) :: NumBeam = 0_IntKi !< Number of lidar beams [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: FocalDistanceX !< LIDAR LOS focal distance co-ordinates in the x direction [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: FocalDistanceY !< LIDAR LOS focal distance co-ordinates in the y direction [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: FocalDistanceZ !< LIDAR LOS focal distance co-ordinates in the z direction [m] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: MsrPosition !< Position of the desired wind measurement (was XMsrPt, YMsrPt, ZMsrPt) [m] - REAL(ReKi) :: PulseSpacing !< Distance between range gates [m] - REAL(ReKi) :: URefLid !< Reference average wind speed for the lidar [m/s] - INTEGER(IntKi) :: ConsiderHubMotion !< Flag whether to consider the hub motion's impact on the Lidar measurement [-] - REAL(ReKi) :: MeasurementInterval !< Time steps between lidar measurements [s] - REAL(ReKi) , DIMENSION(1:3) :: LidPosition !< Position of the Lidar unit (was XLidPt, YLidPt, ZLidPt) [m] + REAL(ReKi) :: PulseSpacing = 0.0_ReKi !< Distance between range gates [m] + REAL(ReKi) :: URefLid = 0.0_ReKi !< Reference average wind speed for the lidar [m/s] + INTEGER(IntKi) :: ConsiderHubMotion = 0_IntKi !< Flag whether to consider the hub motion's impact on the Lidar measurement [-] + REAL(ReKi) :: MeasurementInterval = 0.0_ReKi !< Time steps between lidar measurements [s] + REAL(ReKi) , DIMENSION(1:3) :: LidPosition = 0.0_ReKi !< Position of the Lidar unit (was XLidPt, YLidPt, ZLidPt) [m] END TYPE Lidar_ParameterType ! ======================= ! ========= Lidar_ContinuousStateType ======= TYPE, PUBLIC :: Lidar_ContinuousStateType - REAL(ReKi) :: DummyContState !< Remove this variable if you have continuous states [-] + REAL(ReKi) :: DummyContState = 0.0_ReKi !< Remove this variable if you have continuous states [-] END TYPE Lidar_ContinuousStateType ! ======================= ! ========= Lidar_DiscreteStateType ======= TYPE, PUBLIC :: Lidar_DiscreteStateType - REAL(ReKi) :: DummyDiscState !< Remove this variable if you have discrete states [-] + REAL(ReKi) :: DummyDiscState = 0.0_ReKi !< Remove this variable if you have discrete states [-] END TYPE Lidar_DiscreteStateType ! ======================= ! ========= Lidar_ConstraintStateType ======= TYPE, PUBLIC :: Lidar_ConstraintStateType - REAL(ReKi) :: DummyConstrState !< Remove this variable if you have constraint states [-] + REAL(ReKi) :: DummyConstrState = 0.0_ReKi !< Remove this variable if you have constraint states [-] END TYPE Lidar_ConstraintStateType ! ======================= ! ========= Lidar_OtherStateType ======= TYPE, PUBLIC :: Lidar_OtherStateType - REAL(ReKi) :: DummyOtherState + REAL(ReKi) :: DummyOtherState = 0.0_ReKi END TYPE Lidar_OtherStateType ! ======================= ! ========= Lidar_MiscVarType ======= TYPE, PUBLIC :: Lidar_MiscVarType - REAL(ReKi) :: DummyMiscVar !< Remove this variable if you have misc variables [-] + REAL(ReKi) :: DummyMiscVar = 0.0_ReKi !< Remove this variable if you have misc variables [-] END TYPE Lidar_MiscVarType ! ======================= ! ========= Lidar_InputType ======= TYPE, PUBLIC :: Lidar_InputType - REAL(ReKi) :: PulseLidEl !< the angle off of the x axis that the lidar is aimed (0 would be staring directly upwind, pi/2 would be staring perpendicular to the x axis) [-] - REAL(ReKi) :: PulseLidAz !< the angle in the YZ plane that the lidar is staring (if PulseLidEl is set to pi/2, then 0 would be aligned with the positive z axis, pi/2 would be aligned with the positive y axis) [-] - REAL(ReKi) :: HubDisplacementX !< X direction hub displacement of the lidar (from ElastoDyn) [m] - REAL(ReKi) :: HubDisplacementY !< Y direction hub displacement of the lidar (from ElastoDyn) [m] - REAL(ReKi) :: HubDisplacementZ !< Z direction hub displacement of the lidar (from ElastoDyn) [m] + REAL(ReKi) :: PulseLidEl = 0.0_ReKi !< the angle off of the x axis that the lidar is aimed (0 would be staring directly upwind, pi/2 would be staring perpendicular to the x axis) [-] + REAL(ReKi) :: PulseLidAz = 0.0_ReKi !< the angle in the YZ plane that the lidar is staring (if PulseLidEl is set to pi/2, then 0 would be aligned with the positive z axis, pi/2 would be aligned with the positive y axis) [-] + REAL(ReKi) :: HubDisplacementX = 0.0_ReKi !< X direction hub displacement of the lidar (from ElastoDyn) [m] + REAL(ReKi) :: HubDisplacementY = 0.0_ReKi !< Y direction hub displacement of the lidar (from ElastoDyn) [m] + REAL(ReKi) :: HubDisplacementZ = 0.0_ReKi !< Z direction hub displacement of the lidar (from ElastoDyn) [m] END TYPE Lidar_InputType ! ======================= ! ========= Lidar_OutputType ======= @@ -124,2114 +124,684 @@ MODULE Lidar_Types END TYPE Lidar_OutputType ! ======================= CONTAINS - SUBROUTINE Lidar_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Lidar_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(Lidar_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 = 'Lidar_CopyInitInput' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInitInputData%SensorType = SrcInitInputData%SensorType - DstInitInputData%Tmax = SrcInitInputData%Tmax - DstInitInputData%RotorApexOffsetPos = SrcInitInputData%RotorApexOffsetPos - DstInitInputData%HubPosition = SrcInitInputData%HubPosition - DstInitInputData%NumPulseGate = SrcInitInputData%NumPulseGate - DstInitInputData%LidRadialVel = SrcInitInputData%LidRadialVel - END SUBROUTINE Lidar_CopyInitInput - - SUBROUTINE Lidar_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(Lidar_InitInputType), INTENT(INOUT) :: InitInputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_DestroyInitInput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE Lidar_DestroyInitInput - - SUBROUTINE Lidar_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(Lidar_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 = 'Lidar_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 ! SensorType - Db_BufSz = Db_BufSz + 1 ! Tmax - Re_BufSz = Re_BufSz + SIZE(InData%RotorApexOffsetPos) ! RotorApexOffsetPos - Re_BufSz = Re_BufSz + SIZE(InData%HubPosition) ! HubPosition - Int_BufSz = Int_BufSz + 1 ! NumPulseGate - Int_BufSz = Int_BufSz + 1 ! LidRadialVel - 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%SensorType - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%Tmax - Db_Xferred = Db_Xferred + 1 - DO i1 = LBOUND(InData%RotorApexOffsetPos,1), UBOUND(InData%RotorApexOffsetPos,1) - ReKiBuf(Re_Xferred) = InData%RotorApexOffsetPos(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%HubPosition,1), UBOUND(InData%HubPosition,1) - ReKiBuf(Re_Xferred) = InData%HubPosition(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%NumPulseGate - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%LidRadialVel, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Lidar_PackInitInput - - SUBROUTINE Lidar_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(Lidar_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 = 'Lidar_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%SensorType = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%Tmax = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - i1_l = LBOUND(OutData%RotorApexOffsetPos,1) - i1_u = UBOUND(OutData%RotorApexOffsetPos,1) - DO i1 = LBOUND(OutData%RotorApexOffsetPos,1), UBOUND(OutData%RotorApexOffsetPos,1) - OutData%RotorApexOffsetPos(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%HubPosition,1) - i1_u = UBOUND(OutData%HubPosition,1) - DO i1 = LBOUND(OutData%HubPosition,1), UBOUND(OutData%HubPosition,1) - OutData%HubPosition(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%NumPulseGate = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%LidRadialVel = TRANSFER(IntKiBuf(Int_Xferred), OutData%LidRadialVel) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Lidar_UnPackInitInput - - SUBROUTINE Lidar_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Lidar_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(Lidar_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 = 'Lidar_CopyInitOutput' -! +subroutine Lidar_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) + type(Lidar_InitInputType), intent(in) :: SrcInitInputData + type(Lidar_InitInputType), intent(inout) :: DstInitInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Lidar_CopyInitInput' ErrStat = ErrID_None - ErrMsg = "" - DstInitOutputData%DummyInitOut = SrcInitOutputData%DummyInitOut - END SUBROUTINE Lidar_CopyInitOutput - - SUBROUTINE Lidar_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(Lidar_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_DestroyInitOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE Lidar_DestroyInitOutput - - SUBROUTINE Lidar_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(Lidar_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 = 'Lidar_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 Lidar_PackInitOutput - - SUBROUTINE Lidar_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(Lidar_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 = 'Lidar_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 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Lidar_UnPackInitOutput - - SUBROUTINE Lidar_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Lidar_ParameterType), INTENT(IN) :: SrcParamData - TYPE(Lidar_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 = 'Lidar_CopyParam' -! + ErrMsg = '' + DstInitInputData%SensorType = SrcInitInputData%SensorType + DstInitInputData%Tmax = SrcInitInputData%Tmax + DstInitInputData%RotorApexOffsetPos = SrcInitInputData%RotorApexOffsetPos + DstInitInputData%HubPosition = SrcInitInputData%HubPosition + DstInitInputData%NumPulseGate = SrcInitInputData%NumPulseGate + DstInitInputData%LidRadialVel = SrcInitInputData%LidRadialVel +end subroutine + +subroutine Lidar_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(Lidar_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Lidar_DestroyInitInput' ErrStat = ErrID_None - ErrMsg = "" - DstParamData%NumPulseGate = SrcParamData%NumPulseGate - DstParamData%RotorApexOffsetPos = SrcParamData%RotorApexOffsetPos - DstParamData%RayRangeSq = SrcParamData%RayRangeSq - DstParamData%SpatialRes = SrcParamData%SpatialRes - DstParamData%SensorType = SrcParamData%SensorType - DstParamData%WtFnTrunc = SrcParamData%WtFnTrunc - DstParamData%PulseRangeOne = SrcParamData%PulseRangeOne - DstParamData%DeltaP = SrcParamData%DeltaP - DstParamData%DeltaR = SrcParamData%DeltaR - DstParamData%r_p = SrcParamData%r_p - DstParamData%LidRadialVel = SrcParamData%LidRadialVel - DstParamData%DisplacementLidarX = SrcParamData%DisplacementLidarX - DstParamData%DisplacementLidarY = SrcParamData%DisplacementLidarY - DstParamData%DisplacementLidarZ = SrcParamData%DisplacementLidarZ - DstParamData%NumBeam = SrcParamData%NumBeam -IF (ALLOCATED(SrcParamData%FocalDistanceX)) THEN - i1_l = LBOUND(SrcParamData%FocalDistanceX,1) - i1_u = UBOUND(SrcParamData%FocalDistanceX,1) - IF (.NOT. ALLOCATED(DstParamData%FocalDistanceX)) THEN - ALLOCATE(DstParamData%FocalDistanceX(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%FocalDistanceX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%FocalDistanceX = SrcParamData%FocalDistanceX -ENDIF -IF (ALLOCATED(SrcParamData%FocalDistanceY)) THEN - i1_l = LBOUND(SrcParamData%FocalDistanceY,1) - i1_u = UBOUND(SrcParamData%FocalDistanceY,1) - IF (.NOT. ALLOCATED(DstParamData%FocalDistanceY)) THEN - ALLOCATE(DstParamData%FocalDistanceY(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%FocalDistanceY.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%FocalDistanceY = SrcParamData%FocalDistanceY -ENDIF -IF (ALLOCATED(SrcParamData%FocalDistanceZ)) THEN - i1_l = LBOUND(SrcParamData%FocalDistanceZ,1) - i1_u = UBOUND(SrcParamData%FocalDistanceZ,1) - IF (.NOT. ALLOCATED(DstParamData%FocalDistanceZ)) THEN - ALLOCATE(DstParamData%FocalDistanceZ(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%FocalDistanceZ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%FocalDistanceZ = SrcParamData%FocalDistanceZ -ENDIF -IF (ALLOCATED(SrcParamData%MsrPosition)) THEN - i1_l = LBOUND(SrcParamData%MsrPosition,1) - i1_u = UBOUND(SrcParamData%MsrPosition,1) - i2_l = LBOUND(SrcParamData%MsrPosition,2) - i2_u = UBOUND(SrcParamData%MsrPosition,2) - IF (.NOT. ALLOCATED(DstParamData%MsrPosition)) THEN - ALLOCATE(DstParamData%MsrPosition(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%MsrPosition.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%MsrPosition = SrcParamData%MsrPosition -ENDIF - DstParamData%PulseSpacing = SrcParamData%PulseSpacing - DstParamData%URefLid = SrcParamData%URefLid - DstParamData%ConsiderHubMotion = SrcParamData%ConsiderHubMotion - DstParamData%MeasurementInterval = SrcParamData%MeasurementInterval - DstParamData%LidPosition = SrcParamData%LidPosition - END SUBROUTINE Lidar_CopyParam - - SUBROUTINE Lidar_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(Lidar_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(ParamData%FocalDistanceX)) THEN - DEALLOCATE(ParamData%FocalDistanceX) -ENDIF -IF (ALLOCATED(ParamData%FocalDistanceY)) THEN - DEALLOCATE(ParamData%FocalDistanceY) -ENDIF -IF (ALLOCATED(ParamData%FocalDistanceZ)) THEN - DEALLOCATE(ParamData%FocalDistanceZ) -ENDIF -IF (ALLOCATED(ParamData%MsrPosition)) THEN - DEALLOCATE(ParamData%MsrPosition) -ENDIF - END SUBROUTINE Lidar_DestroyParam - - SUBROUTINE Lidar_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(Lidar_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 = 'Lidar_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 ! NumPulseGate - Re_BufSz = Re_BufSz + SIZE(InData%RotorApexOffsetPos) ! RotorApexOffsetPos - Re_BufSz = Re_BufSz + 1 ! RayRangeSq - Re_BufSz = Re_BufSz + 1 ! SpatialRes - Int_BufSz = Int_BufSz + 1 ! SensorType - Re_BufSz = Re_BufSz + 1 ! WtFnTrunc - Re_BufSz = Re_BufSz + 1 ! PulseRangeOne - Re_BufSz = Re_BufSz + 1 ! DeltaP - Re_BufSz = Re_BufSz + 1 ! DeltaR - Re_BufSz = Re_BufSz + 1 ! r_p - Int_BufSz = Int_BufSz + 1 ! LidRadialVel - Re_BufSz = Re_BufSz + 1 ! DisplacementLidarX - Re_BufSz = Re_BufSz + 1 ! DisplacementLidarY - Re_BufSz = Re_BufSz + 1 ! DisplacementLidarZ - Int_BufSz = Int_BufSz + 1 ! NumBeam - Int_BufSz = Int_BufSz + 1 ! FocalDistanceX allocated yes/no - IF ( ALLOCATED(InData%FocalDistanceX) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! FocalDistanceX upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%FocalDistanceX) ! FocalDistanceX - END IF - Int_BufSz = Int_BufSz + 1 ! FocalDistanceY allocated yes/no - IF ( ALLOCATED(InData%FocalDistanceY) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! FocalDistanceY upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%FocalDistanceY) ! FocalDistanceY - END IF - Int_BufSz = Int_BufSz + 1 ! FocalDistanceZ allocated yes/no - IF ( ALLOCATED(InData%FocalDistanceZ) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! FocalDistanceZ upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%FocalDistanceZ) ! FocalDistanceZ - END IF - Int_BufSz = Int_BufSz + 1 ! MsrPosition allocated yes/no - IF ( ALLOCATED(InData%MsrPosition) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! MsrPosition upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%MsrPosition) ! MsrPosition - END IF - Re_BufSz = Re_BufSz + 1 ! PulseSpacing - Re_BufSz = Re_BufSz + 1 ! URefLid - Int_BufSz = Int_BufSz + 1 ! ConsiderHubMotion - Re_BufSz = Re_BufSz + 1 ! MeasurementInterval - Re_BufSz = Re_BufSz + SIZE(InData%LidPosition) ! LidPosition - 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%NumPulseGate - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%RotorApexOffsetPos,1), UBOUND(InData%RotorApexOffsetPos,1) - ReKiBuf(Re_Xferred) = InData%RotorApexOffsetPos(i1) - Re_Xferred = Re_Xferred + 1 - END DO - ReKiBuf(Re_Xferred) = InData%RayRangeSq - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%SpatialRes - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%SensorType - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WtFnTrunc - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PulseRangeOne - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%DeltaP - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%DeltaR - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%r_p - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%LidRadialVel, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%DisplacementLidarX - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%DisplacementLidarY - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%DisplacementLidarZ - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumBeam - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%FocalDistanceX) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FocalDistanceX,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FocalDistanceX,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%FocalDistanceX,1), UBOUND(InData%FocalDistanceX,1) - ReKiBuf(Re_Xferred) = InData%FocalDistanceX(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%FocalDistanceY) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FocalDistanceY,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FocalDistanceY,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%FocalDistanceY,1), UBOUND(InData%FocalDistanceY,1) - ReKiBuf(Re_Xferred) = InData%FocalDistanceY(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%FocalDistanceZ) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FocalDistanceZ,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FocalDistanceZ,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%FocalDistanceZ,1), UBOUND(InData%FocalDistanceZ,1) - ReKiBuf(Re_Xferred) = InData%FocalDistanceZ(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%MsrPosition) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MsrPosition,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MsrPosition,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MsrPosition,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MsrPosition,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%MsrPosition,2), UBOUND(InData%MsrPosition,2) - DO i1 = LBOUND(InData%MsrPosition,1), UBOUND(InData%MsrPosition,1) - ReKiBuf(Re_Xferred) = InData%MsrPosition(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - ReKiBuf(Re_Xferred) = InData%PulseSpacing - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%URefLid - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%ConsiderHubMotion - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MeasurementInterval - Re_Xferred = Re_Xferred + 1 - DO i1 = LBOUND(InData%LidPosition,1), UBOUND(InData%LidPosition,1) - ReKiBuf(Re_Xferred) = InData%LidPosition(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END SUBROUTINE Lidar_PackParam - - SUBROUTINE Lidar_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(Lidar_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 = 'Lidar_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%NumPulseGate = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%RotorApexOffsetPos,1) - i1_u = UBOUND(OutData%RotorApexOffsetPos,1) - DO i1 = LBOUND(OutData%RotorApexOffsetPos,1), UBOUND(OutData%RotorApexOffsetPos,1) - OutData%RotorApexOffsetPos(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%RayRangeSq = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SpatialRes = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SensorType = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WtFnTrunc = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PulseRangeOne = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%DeltaP = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%DeltaR = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%r_p = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%LidRadialVel = TRANSFER(IntKiBuf(Int_Xferred), OutData%LidRadialVel) - Int_Xferred = Int_Xferred + 1 - OutData%DisplacementLidarX = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%DisplacementLidarY = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%DisplacementLidarZ = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NumBeam = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FocalDistanceX not allocated - Int_Xferred = Int_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%FocalDistanceX)) DEALLOCATE(OutData%FocalDistanceX) - ALLOCATE(OutData%FocalDistanceX(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FocalDistanceX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%FocalDistanceX,1), UBOUND(OutData%FocalDistanceX,1) - OutData%FocalDistanceX(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FocalDistanceY not allocated - Int_Xferred = Int_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%FocalDistanceY)) DEALLOCATE(OutData%FocalDistanceY) - ALLOCATE(OutData%FocalDistanceY(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FocalDistanceY.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%FocalDistanceY,1), UBOUND(OutData%FocalDistanceY,1) - OutData%FocalDistanceY(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FocalDistanceZ not allocated - Int_Xferred = Int_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%FocalDistanceZ)) DEALLOCATE(OutData%FocalDistanceZ) - ALLOCATE(OutData%FocalDistanceZ(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FocalDistanceZ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%FocalDistanceZ,1), UBOUND(OutData%FocalDistanceZ,1) - OutData%FocalDistanceZ(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MsrPosition not allocated - Int_Xferred = Int_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%MsrPosition)) DEALLOCATE(OutData%MsrPosition) - ALLOCATE(OutData%MsrPosition(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MsrPosition.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%MsrPosition,2), UBOUND(OutData%MsrPosition,2) - DO i1 = LBOUND(OutData%MsrPosition,1), UBOUND(OutData%MsrPosition,1) - OutData%MsrPosition(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%PulseSpacing = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%URefLid = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%ConsiderHubMotion = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%MeasurementInterval = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%LidPosition,1) - i1_u = UBOUND(OutData%LidPosition,1) - DO i1 = LBOUND(OutData%LidPosition,1), UBOUND(OutData%LidPosition,1) - OutData%LidPosition(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END SUBROUTINE Lidar_UnPackParam - - SUBROUTINE Lidar_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Lidar_ContinuousStateType), INTENT(IN) :: SrcContStateData - TYPE(Lidar_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 = 'Lidar_CopyContState' -! + ErrMsg = '' +end subroutine + +subroutine Lidar_PackInitInput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Lidar_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Lidar_PackInitInput' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%SensorType) + call RegPack(RF, InData%Tmax) + call RegPack(RF, InData%RotorApexOffsetPos) + call RegPack(RF, InData%HubPosition) + call RegPack(RF, InData%NumPulseGate) + call RegPack(RF, InData%LidRadialVel) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Lidar_UnPackInitInput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Lidar_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Lidar_UnPackInitInput' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%SensorType); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Tmax); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RotorApexOffsetPos); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HubPosition); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumPulseGate); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LidRadialVel); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Lidar_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) + type(Lidar_InitOutputType), intent(in) :: SrcInitOutputData + type(Lidar_InitOutputType), intent(inout) :: DstInitOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Lidar_CopyInitOutput' ErrStat = ErrID_None - ErrMsg = "" - DstContStateData%DummyContState = SrcContStateData%DummyContState - END SUBROUTINE Lidar_CopyContState - - SUBROUTINE Lidar_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(Lidar_ContinuousStateType), INTENT(INOUT) :: ContStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_DestroyContState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE Lidar_DestroyContState - - SUBROUTINE Lidar_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(Lidar_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 = 'Lidar_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 Lidar_PackContState - - SUBROUTINE Lidar_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(Lidar_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 = 'Lidar_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 Lidar_UnPackContState - - SUBROUTINE Lidar_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Lidar_DiscreteStateType), INTENT(IN) :: SrcDiscStateData - TYPE(Lidar_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 = 'Lidar_CopyDiscState' -! + ErrMsg = '' + DstInitOutputData%DummyInitOut = SrcInitOutputData%DummyInitOut +end subroutine + +subroutine Lidar_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(Lidar_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Lidar_DestroyInitOutput' ErrStat = ErrID_None - ErrMsg = "" - DstDiscStateData%DummyDiscState = SrcDiscStateData%DummyDiscState - END SUBROUTINE Lidar_CopyDiscState - - SUBROUTINE Lidar_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(Lidar_DiscreteStateType), INTENT(INOUT) :: DiscStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_DestroyDiscState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE Lidar_DestroyDiscState - - SUBROUTINE Lidar_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(Lidar_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 = 'Lidar_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 Lidar_PackDiscState - - SUBROUTINE Lidar_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(Lidar_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 = 'Lidar_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 Lidar_UnPackDiscState - - SUBROUTINE Lidar_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Lidar_ConstraintStateType), INTENT(IN) :: SrcConstrStateData - TYPE(Lidar_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 = 'Lidar_CopyConstrState' -! + ErrMsg = '' +end subroutine + +subroutine Lidar_PackInitOutput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Lidar_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Lidar_PackInitOutput' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyInitOut) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Lidar_UnPackInitOutput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Lidar_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Lidar_UnPackInitOutput' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyInitOut); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Lidar_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(Lidar_ParameterType), intent(in) :: SrcParamData + type(Lidar_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'Lidar_CopyParam' ErrStat = ErrID_None - ErrMsg = "" - DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState - END SUBROUTINE Lidar_CopyConstrState - - SUBROUTINE Lidar_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(Lidar_ConstraintStateType), INTENT(INOUT) :: ConstrStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_DestroyConstrState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE Lidar_DestroyConstrState - - SUBROUTINE Lidar_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(Lidar_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 = 'Lidar_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 Lidar_PackConstrState - - SUBROUTINE Lidar_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(Lidar_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 = 'Lidar_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 Lidar_UnPackConstrState - - SUBROUTINE Lidar_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Lidar_OtherStateType), INTENT(IN) :: SrcOtherStateData - TYPE(Lidar_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 = 'Lidar_CopyOtherState' -! + ErrMsg = '' + DstParamData%NumPulseGate = SrcParamData%NumPulseGate + DstParamData%RotorApexOffsetPos = SrcParamData%RotorApexOffsetPos + DstParamData%RayRangeSq = SrcParamData%RayRangeSq + DstParamData%SpatialRes = SrcParamData%SpatialRes + DstParamData%SensorType = SrcParamData%SensorType + DstParamData%WtFnTrunc = SrcParamData%WtFnTrunc + DstParamData%PulseRangeOne = SrcParamData%PulseRangeOne + DstParamData%DeltaP = SrcParamData%DeltaP + DstParamData%DeltaR = SrcParamData%DeltaR + DstParamData%r_p = SrcParamData%r_p + DstParamData%LidRadialVel = SrcParamData%LidRadialVel + DstParamData%DisplacementLidarX = SrcParamData%DisplacementLidarX + DstParamData%DisplacementLidarY = SrcParamData%DisplacementLidarY + DstParamData%DisplacementLidarZ = SrcParamData%DisplacementLidarZ + DstParamData%NumBeam = SrcParamData%NumBeam + if (allocated(SrcParamData%FocalDistanceX)) then + LB(1:1) = lbound(SrcParamData%FocalDistanceX) + UB(1:1) = ubound(SrcParamData%FocalDistanceX) + if (.not. allocated(DstParamData%FocalDistanceX)) then + allocate(DstParamData%FocalDistanceX(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%FocalDistanceX.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%FocalDistanceX = SrcParamData%FocalDistanceX + end if + if (allocated(SrcParamData%FocalDistanceY)) then + LB(1:1) = lbound(SrcParamData%FocalDistanceY) + UB(1:1) = ubound(SrcParamData%FocalDistanceY) + if (.not. allocated(DstParamData%FocalDistanceY)) then + allocate(DstParamData%FocalDistanceY(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%FocalDistanceY.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%FocalDistanceY = SrcParamData%FocalDistanceY + end if + if (allocated(SrcParamData%FocalDistanceZ)) then + LB(1:1) = lbound(SrcParamData%FocalDistanceZ) + UB(1:1) = ubound(SrcParamData%FocalDistanceZ) + if (.not. allocated(DstParamData%FocalDistanceZ)) then + allocate(DstParamData%FocalDistanceZ(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%FocalDistanceZ.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%FocalDistanceZ = SrcParamData%FocalDistanceZ + end if + if (allocated(SrcParamData%MsrPosition)) then + LB(1:2) = lbound(SrcParamData%MsrPosition) + UB(1:2) = ubound(SrcParamData%MsrPosition) + if (.not. allocated(DstParamData%MsrPosition)) then + allocate(DstParamData%MsrPosition(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%MsrPosition.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%MsrPosition = SrcParamData%MsrPosition + end if + DstParamData%PulseSpacing = SrcParamData%PulseSpacing + DstParamData%URefLid = SrcParamData%URefLid + DstParamData%ConsiderHubMotion = SrcParamData%ConsiderHubMotion + DstParamData%MeasurementInterval = SrcParamData%MeasurementInterval + DstParamData%LidPosition = SrcParamData%LidPosition +end subroutine + +subroutine Lidar_DestroyParam(ParamData, ErrStat, ErrMsg) + type(Lidar_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Lidar_DestroyParam' ErrStat = ErrID_None - ErrMsg = "" - DstOtherStateData%DummyOtherState = SrcOtherStateData%DummyOtherState - END SUBROUTINE Lidar_CopyOtherState - - SUBROUTINE Lidar_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(Lidar_OtherStateType), INTENT(INOUT) :: OtherStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_DestroyOtherState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE Lidar_DestroyOtherState - - SUBROUTINE Lidar_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(Lidar_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 = 'Lidar_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 Lidar_PackOtherState - - SUBROUTINE Lidar_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(Lidar_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 = 'Lidar_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 Lidar_UnPackOtherState - - SUBROUTINE Lidar_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Lidar_MiscVarType), INTENT(IN) :: SrcMiscData - TYPE(Lidar_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 = 'Lidar_CopyMisc' -! + ErrMsg = '' + if (allocated(ParamData%FocalDistanceX)) then + deallocate(ParamData%FocalDistanceX) + end if + if (allocated(ParamData%FocalDistanceY)) then + deallocate(ParamData%FocalDistanceY) + end if + if (allocated(ParamData%FocalDistanceZ)) then + deallocate(ParamData%FocalDistanceZ) + end if + if (allocated(ParamData%MsrPosition)) then + deallocate(ParamData%MsrPosition) + end if +end subroutine + +subroutine Lidar_PackParam(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Lidar_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Lidar_PackParam' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%NumPulseGate) + call RegPack(RF, InData%RotorApexOffsetPos) + call RegPack(RF, InData%RayRangeSq) + call RegPack(RF, InData%SpatialRes) + call RegPack(RF, InData%SensorType) + call RegPack(RF, InData%WtFnTrunc) + call RegPack(RF, InData%PulseRangeOne) + call RegPack(RF, InData%DeltaP) + call RegPack(RF, InData%DeltaR) + call RegPack(RF, InData%r_p) + call RegPack(RF, InData%LidRadialVel) + call RegPack(RF, InData%DisplacementLidarX) + call RegPack(RF, InData%DisplacementLidarY) + call RegPack(RF, InData%DisplacementLidarZ) + call RegPack(RF, InData%NumBeam) + call RegPackAlloc(RF, InData%FocalDistanceX) + call RegPackAlloc(RF, InData%FocalDistanceY) + call RegPackAlloc(RF, InData%FocalDistanceZ) + call RegPackAlloc(RF, InData%MsrPosition) + call RegPack(RF, InData%PulseSpacing) + call RegPack(RF, InData%URefLid) + call RegPack(RF, InData%ConsiderHubMotion) + call RegPack(RF, InData%MeasurementInterval) + call RegPack(RF, InData%LidPosition) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Lidar_UnPackParam(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Lidar_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Lidar_UnPackParam' + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%NumPulseGate); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RotorApexOffsetPos); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RayRangeSq); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SpatialRes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SensorType); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WtFnTrunc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PulseRangeOne); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DeltaP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DeltaR); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%r_p); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LidRadialVel); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DisplacementLidarX); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DisplacementLidarY); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DisplacementLidarZ); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumBeam); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%FocalDistanceX); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%FocalDistanceY); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%FocalDistanceZ); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%MsrPosition); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PulseSpacing); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%URefLid); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ConsiderHubMotion); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MeasurementInterval); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LidPosition); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Lidar_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) + type(Lidar_ContinuousStateType), intent(in) :: SrcContStateData + type(Lidar_ContinuousStateType), intent(inout) :: DstContStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Lidar_CopyContState' ErrStat = ErrID_None - ErrMsg = "" - DstMiscData%DummyMiscVar = SrcMiscData%DummyMiscVar - END SUBROUTINE Lidar_CopyMisc - - SUBROUTINE Lidar_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(Lidar_MiscVarType), INTENT(INOUT) :: MiscData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_DestroyMisc' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE Lidar_DestroyMisc - - SUBROUTINE Lidar_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(Lidar_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 = 'Lidar_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) = InData%DummyMiscVar - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Lidar_PackMisc - - SUBROUTINE Lidar_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(Lidar_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 = 'Lidar_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 Lidar_UnPackMisc - - SUBROUTINE Lidar_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Lidar_InputType), INTENT(IN) :: SrcInputData - TYPE(Lidar_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 = 'Lidar_CopyInput' -! + ErrMsg = '' + DstContStateData%DummyContState = SrcContStateData%DummyContState +end subroutine + +subroutine Lidar_DestroyContState(ContStateData, ErrStat, ErrMsg) + type(Lidar_ContinuousStateType), intent(inout) :: ContStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Lidar_DestroyContState' ErrStat = ErrID_None - ErrMsg = "" - DstInputData%PulseLidEl = SrcInputData%PulseLidEl - DstInputData%PulseLidAz = SrcInputData%PulseLidAz - DstInputData%HubDisplacementX = SrcInputData%HubDisplacementX - DstInputData%HubDisplacementY = SrcInputData%HubDisplacementY - DstInputData%HubDisplacementZ = SrcInputData%HubDisplacementZ - END SUBROUTINE Lidar_CopyInput - - SUBROUTINE Lidar_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(Lidar_InputType), INTENT(INOUT) :: InputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_DestroyInput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE Lidar_DestroyInput - - SUBROUTINE Lidar_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(Lidar_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 = 'Lidar_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 ! PulseLidEl - Re_BufSz = Re_BufSz + 1 ! PulseLidAz - Re_BufSz = Re_BufSz + 1 ! HubDisplacementX - Re_BufSz = Re_BufSz + 1 ! HubDisplacementY - Re_BufSz = Re_BufSz + 1 ! HubDisplacementZ - 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%PulseLidEl - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PulseLidAz - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%HubDisplacementX - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%HubDisplacementY - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%HubDisplacementZ - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Lidar_PackInput - - SUBROUTINE Lidar_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(Lidar_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 = 'Lidar_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%PulseLidEl = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PulseLidAz = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%HubDisplacementX = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%HubDisplacementY = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%HubDisplacementZ = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Lidar_UnPackInput - - SUBROUTINE Lidar_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Lidar_OutputType), INTENT(IN) :: SrcOutputData - TYPE(Lidar_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 = 'Lidar_CopyOutput' -! + ErrMsg = '' +end subroutine + +subroutine Lidar_PackContState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Lidar_ContinuousStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Lidar_PackContState' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyContState) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Lidar_UnPackContState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Lidar_ContinuousStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Lidar_UnPackContState' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyContState); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Lidar_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) + type(Lidar_DiscreteStateType), intent(in) :: SrcDiscStateData + type(Lidar_DiscreteStateType), intent(inout) :: DstDiscStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Lidar_CopyDiscState' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcOutputData%LidSpeed)) THEN - i1_l = LBOUND(SrcOutputData%LidSpeed,1) - i1_u = UBOUND(SrcOutputData%LidSpeed,1) - IF (.NOT. ALLOCATED(DstOutputData%LidSpeed)) THEN - ALLOCATE(DstOutputData%LidSpeed(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%LidSpeed.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%LidSpeed = SrcOutputData%LidSpeed -ENDIF -IF (ALLOCATED(SrcOutputData%WtTrunc)) THEN - i1_l = LBOUND(SrcOutputData%WtTrunc,1) - i1_u = UBOUND(SrcOutputData%WtTrunc,1) - IF (.NOT. ALLOCATED(DstOutputData%WtTrunc)) THEN - ALLOCATE(DstOutputData%WtTrunc(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WtTrunc.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%WtTrunc = SrcOutputData%WtTrunc -ENDIF -IF (ALLOCATED(SrcOutputData%MsrPositionsX)) THEN - i1_l = LBOUND(SrcOutputData%MsrPositionsX,1) - i1_u = UBOUND(SrcOutputData%MsrPositionsX,1) - IF (.NOT. ALLOCATED(DstOutputData%MsrPositionsX)) THEN - ALLOCATE(DstOutputData%MsrPositionsX(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%MsrPositionsX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%MsrPositionsX = SrcOutputData%MsrPositionsX -ENDIF -IF (ALLOCATED(SrcOutputData%MsrPositionsY)) THEN - i1_l = LBOUND(SrcOutputData%MsrPositionsY,1) - i1_u = UBOUND(SrcOutputData%MsrPositionsY,1) - IF (.NOT. ALLOCATED(DstOutputData%MsrPositionsY)) THEN - ALLOCATE(DstOutputData%MsrPositionsY(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%MsrPositionsY.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%MsrPositionsY = SrcOutputData%MsrPositionsY -ENDIF -IF (ALLOCATED(SrcOutputData%MsrPositionsZ)) THEN - i1_l = LBOUND(SrcOutputData%MsrPositionsZ,1) - i1_u = UBOUND(SrcOutputData%MsrPositionsZ,1) - IF (.NOT. ALLOCATED(DstOutputData%MsrPositionsZ)) THEN - ALLOCATE(DstOutputData%MsrPositionsZ(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%MsrPositionsZ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%MsrPositionsZ = SrcOutputData%MsrPositionsZ -ENDIF - END SUBROUTINE Lidar_CopyOutput - - SUBROUTINE Lidar_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(Lidar_OutputType), INTENT(INOUT) :: OutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_DestroyOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(OutputData%LidSpeed)) THEN - DEALLOCATE(OutputData%LidSpeed) -ENDIF -IF (ALLOCATED(OutputData%WtTrunc)) THEN - DEALLOCATE(OutputData%WtTrunc) -ENDIF -IF (ALLOCATED(OutputData%MsrPositionsX)) THEN - DEALLOCATE(OutputData%MsrPositionsX) -ENDIF -IF (ALLOCATED(OutputData%MsrPositionsY)) THEN - DEALLOCATE(OutputData%MsrPositionsY) -ENDIF -IF (ALLOCATED(OutputData%MsrPositionsZ)) THEN - DEALLOCATE(OutputData%MsrPositionsZ) -ENDIF - END SUBROUTINE Lidar_DestroyOutput - - SUBROUTINE Lidar_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(Lidar_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 = 'Lidar_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 ! LidSpeed allocated yes/no - IF ( ALLOCATED(InData%LidSpeed) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LidSpeed upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%LidSpeed) ! LidSpeed - END IF - Int_BufSz = Int_BufSz + 1 ! WtTrunc allocated yes/no - IF ( ALLOCATED(InData%WtTrunc) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WtTrunc upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WtTrunc) ! WtTrunc - END IF - Int_BufSz = Int_BufSz + 1 ! MsrPositionsX allocated yes/no - IF ( ALLOCATED(InData%MsrPositionsX) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! MsrPositionsX upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%MsrPositionsX) ! MsrPositionsX - END IF - Int_BufSz = Int_BufSz + 1 ! MsrPositionsY allocated yes/no - IF ( ALLOCATED(InData%MsrPositionsY) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! MsrPositionsY upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%MsrPositionsY) ! MsrPositionsY - END IF - Int_BufSz = Int_BufSz + 1 ! MsrPositionsZ allocated yes/no - IF ( ALLOCATED(InData%MsrPositionsZ) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! MsrPositionsZ upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%MsrPositionsZ) ! MsrPositionsZ - 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%LidSpeed) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LidSpeed,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LidSpeed,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LidSpeed,1), UBOUND(InData%LidSpeed,1) - ReKiBuf(Re_Xferred) = InData%LidSpeed(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WtTrunc) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WtTrunc,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WtTrunc,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WtTrunc,1), UBOUND(InData%WtTrunc,1) - ReKiBuf(Re_Xferred) = InData%WtTrunc(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%MsrPositionsX) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MsrPositionsX,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MsrPositionsX,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%MsrPositionsX,1), UBOUND(InData%MsrPositionsX,1) - ReKiBuf(Re_Xferred) = InData%MsrPositionsX(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%MsrPositionsY) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MsrPositionsY,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MsrPositionsY,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%MsrPositionsY,1), UBOUND(InData%MsrPositionsY,1) - ReKiBuf(Re_Xferred) = InData%MsrPositionsY(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%MsrPositionsZ) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MsrPositionsZ,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MsrPositionsZ,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%MsrPositionsZ,1), UBOUND(InData%MsrPositionsZ,1) - ReKiBuf(Re_Xferred) = InData%MsrPositionsZ(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE Lidar_PackOutput - - SUBROUTINE Lidar_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(Lidar_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 = 'Lidar_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 ! LidSpeed not allocated - Int_Xferred = Int_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%LidSpeed)) DEALLOCATE(OutData%LidSpeed) - ALLOCATE(OutData%LidSpeed(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LidSpeed.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LidSpeed,1), UBOUND(OutData%LidSpeed,1) - OutData%LidSpeed(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WtTrunc not allocated - Int_Xferred = Int_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%WtTrunc)) DEALLOCATE(OutData%WtTrunc) - ALLOCATE(OutData%WtTrunc(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WtTrunc.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WtTrunc,1), UBOUND(OutData%WtTrunc,1) - OutData%WtTrunc(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MsrPositionsX not allocated - Int_Xferred = Int_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%MsrPositionsX)) DEALLOCATE(OutData%MsrPositionsX) - ALLOCATE(OutData%MsrPositionsX(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MsrPositionsX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%MsrPositionsX,1), UBOUND(OutData%MsrPositionsX,1) - OutData%MsrPositionsX(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MsrPositionsY not allocated - Int_Xferred = Int_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%MsrPositionsY)) DEALLOCATE(OutData%MsrPositionsY) - ALLOCATE(OutData%MsrPositionsY(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MsrPositionsY.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%MsrPositionsY,1), UBOUND(OutData%MsrPositionsY,1) - OutData%MsrPositionsY(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MsrPositionsZ not allocated - Int_Xferred = Int_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%MsrPositionsZ)) DEALLOCATE(OutData%MsrPositionsZ) - ALLOCATE(OutData%MsrPositionsZ(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MsrPositionsZ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%MsrPositionsZ,1), UBOUND(OutData%MsrPositionsZ,1) - OutData%MsrPositionsZ(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE Lidar_UnPackOutput - - - SUBROUTINE Lidar_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(Lidar_InputType), INTENT(IN) :: u(:) ! Input at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Inputs - TYPE(Lidar_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 + ErrMsg = '' + DstDiscStateData%DummyDiscState = SrcDiscStateData%DummyDiscState +end subroutine + +subroutine Lidar_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) + type(Lidar_DiscreteStateType), intent(inout) :: DiscStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Lidar_DestroyDiscState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine Lidar_PackDiscState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Lidar_DiscreteStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Lidar_PackDiscState' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyDiscState) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Lidar_UnPackDiscState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Lidar_DiscreteStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Lidar_UnPackDiscState' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyDiscState); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Lidar_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) + type(Lidar_ConstraintStateType), intent(in) :: SrcConstrStateData + type(Lidar_ConstraintStateType), intent(inout) :: DstConstrStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Lidar_CopyConstrState' + ErrStat = ErrID_None + ErrMsg = '' + DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState +end subroutine + +subroutine Lidar_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) + type(Lidar_ConstraintStateType), intent(inout) :: ConstrStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Lidar_DestroyConstrState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine Lidar_PackConstrState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Lidar_ConstraintStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Lidar_PackConstrState' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyConstrState) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Lidar_UnPackConstrState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Lidar_ConstraintStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Lidar_UnPackConstrState' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyConstrState); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Lidar_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) + type(Lidar_OtherStateType), intent(in) :: SrcOtherStateData + type(Lidar_OtherStateType), intent(inout) :: DstOtherStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Lidar_CopyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + DstOtherStateData%DummyOtherState = SrcOtherStateData%DummyOtherState +end subroutine + +subroutine Lidar_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) + type(Lidar_OtherStateType), intent(inout) :: OtherStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Lidar_DestroyOtherState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine Lidar_PackOtherState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Lidar_OtherStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Lidar_PackOtherState' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyOtherState) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Lidar_UnPackOtherState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Lidar_OtherStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Lidar_UnPackOtherState' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyOtherState); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Lidar_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(Lidar_MiscVarType), intent(in) :: SrcMiscData + type(Lidar_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Lidar_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + DstMiscData%DummyMiscVar = SrcMiscData%DummyMiscVar +end subroutine + +subroutine Lidar_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(Lidar_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Lidar_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine Lidar_PackMisc(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Lidar_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Lidar_PackMisc' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyMiscVar) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Lidar_UnPackMisc(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Lidar_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Lidar_UnPackMisc' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyMiscVar); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Lidar_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) + type(Lidar_InputType), intent(in) :: SrcInputData + type(Lidar_InputType), intent(inout) :: DstInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Lidar_CopyInput' + ErrStat = ErrID_None + ErrMsg = '' + DstInputData%PulseLidEl = SrcInputData%PulseLidEl + DstInputData%PulseLidAz = SrcInputData%PulseLidAz + DstInputData%HubDisplacementX = SrcInputData%HubDisplacementX + DstInputData%HubDisplacementY = SrcInputData%HubDisplacementY + DstInputData%HubDisplacementZ = SrcInputData%HubDisplacementZ +end subroutine + +subroutine Lidar_DestroyInput(InputData, ErrStat, ErrMsg) + type(Lidar_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Lidar_DestroyInput' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine Lidar_PackInput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Lidar_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Lidar_PackInput' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%PulseLidEl) + call RegPack(RF, InData%PulseLidAz) + call RegPack(RF, InData%HubDisplacementX) + call RegPack(RF, InData%HubDisplacementY) + call RegPack(RF, InData%HubDisplacementZ) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Lidar_UnPackInput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Lidar_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Lidar_UnPackInput' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%PulseLidEl); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PulseLidAz); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HubDisplacementX); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HubDisplacementY); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HubDisplacementZ); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Lidar_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(Lidar_OutputType), intent(in) :: SrcOutputData + type(Lidar_OutputType), intent(inout) :: DstOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'Lidar_CopyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcOutputData%LidSpeed)) then + LB(1:1) = lbound(SrcOutputData%LidSpeed) + UB(1:1) = ubound(SrcOutputData%LidSpeed) + if (.not. allocated(DstOutputData%LidSpeed)) then + allocate(DstOutputData%LidSpeed(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%LidSpeed.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%LidSpeed = SrcOutputData%LidSpeed + end if + if (allocated(SrcOutputData%WtTrunc)) then + LB(1:1) = lbound(SrcOutputData%WtTrunc) + UB(1:1) = ubound(SrcOutputData%WtTrunc) + if (.not. allocated(DstOutputData%WtTrunc)) then + allocate(DstOutputData%WtTrunc(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WtTrunc.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%WtTrunc = SrcOutputData%WtTrunc + end if + if (allocated(SrcOutputData%MsrPositionsX)) then + LB(1:1) = lbound(SrcOutputData%MsrPositionsX) + UB(1:1) = ubound(SrcOutputData%MsrPositionsX) + if (.not. allocated(DstOutputData%MsrPositionsX)) then + allocate(DstOutputData%MsrPositionsX(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%MsrPositionsX.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%MsrPositionsX = SrcOutputData%MsrPositionsX + end if + if (allocated(SrcOutputData%MsrPositionsY)) then + LB(1:1) = lbound(SrcOutputData%MsrPositionsY) + UB(1:1) = ubound(SrcOutputData%MsrPositionsY) + if (.not. allocated(DstOutputData%MsrPositionsY)) then + allocate(DstOutputData%MsrPositionsY(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%MsrPositionsY.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%MsrPositionsY = SrcOutputData%MsrPositionsY + end if + if (allocated(SrcOutputData%MsrPositionsZ)) then + LB(1:1) = lbound(SrcOutputData%MsrPositionsZ) + UB(1:1) = ubound(SrcOutputData%MsrPositionsZ) + if (.not. allocated(DstOutputData%MsrPositionsZ)) then + allocate(DstOutputData%MsrPositionsZ(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%MsrPositionsZ.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%MsrPositionsZ = SrcOutputData%MsrPositionsZ + end if +end subroutine + +subroutine Lidar_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(Lidar_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Lidar_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OutputData%LidSpeed)) then + deallocate(OutputData%LidSpeed) + end if + if (allocated(OutputData%WtTrunc)) then + deallocate(OutputData%WtTrunc) + end if + if (allocated(OutputData%MsrPositionsX)) then + deallocate(OutputData%MsrPositionsX) + end if + if (allocated(OutputData%MsrPositionsY)) then + deallocate(OutputData%MsrPositionsY) + end if + if (allocated(OutputData%MsrPositionsZ)) then + deallocate(OutputData%MsrPositionsZ) + end if +end subroutine + +subroutine Lidar_PackOutput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Lidar_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Lidar_PackOutput' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%LidSpeed) + call RegPackAlloc(RF, InData%WtTrunc) + call RegPackAlloc(RF, InData%MsrPositionsX) + call RegPackAlloc(RF, InData%MsrPositionsY) + call RegPackAlloc(RF, InData%MsrPositionsZ) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Lidar_UnPackOutput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Lidar_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Lidar_UnPackOutput' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%LidSpeed); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WtTrunc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%MsrPositionsX); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%MsrPositionsY); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%MsrPositionsZ); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Lidar_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(Lidar_InputType), intent(in) :: u(:) ! Input at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Inputs + type(Lidar_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 = 'Lidar_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 Lidar_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL Lidar_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 Lidar_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 Lidar_Input_ExtrapInterp - - - SUBROUTINE Lidar_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'Lidar_Input_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(u)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(u)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(u) - 1 + select case (order) + case (0) + call Lidar_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call Lidar_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call Lidar_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(u) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE Lidar_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. @@ -2243,49 +813,45 @@ SUBROUTINE Lidar_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMs ! !.................................................................................................................................. - TYPE(Lidar_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 - TYPE(Lidar_InputType), INTENT(IN) :: u2 ! Input at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs - TYPE(Lidar_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 + TYPE(Lidar_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 + TYPE(Lidar_InputType), INTENT(IN) :: u2 ! Input at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs + TYPE(Lidar_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 = 'Lidar_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 + REAL(DbKi) :: t(2) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_Input_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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) - b = -(u1%PulseLidEl - u2%PulseLidEl) - u_out%PulseLidEl = u1%PulseLidEl + b * ScaleFactor - b = -(u1%PulseLidAz - u2%PulseLidAz) - u_out%PulseLidAz = u1%PulseLidAz + b * ScaleFactor - b = -(u1%HubDisplacementX - u2%HubDisplacementX) - u_out%HubDisplacementX = u1%HubDisplacementX + b * ScaleFactor - b = -(u1%HubDisplacementY - u2%HubDisplacementY) - u_out%HubDisplacementY = u1%HubDisplacementY + b * ScaleFactor - b = -(u1%HubDisplacementZ - u2%HubDisplacementZ) - u_out%HubDisplacementZ = u1%HubDisplacementZ + b * ScaleFactor - END SUBROUTINE Lidar_Input_ExtrapInterp1 - - - SUBROUTINE Lidar_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + u_out%PulseLidEl = a1*u1%PulseLidEl + a2*u2%PulseLidEl + u_out%PulseLidAz = a1*u1%PulseLidAz + a2*u2%PulseLidAz + u_out%HubDisplacementX = a1*u1%HubDisplacementX + a2*u2%HubDisplacementX + u_out%HubDisplacementY = a1*u1%HubDisplacementY + a2*u2%HubDisplacementY + u_out%HubDisplacementZ = a1*u1%HubDisplacementZ + a2*u2%HubDisplacementZ +END SUBROUTINE + +SUBROUTINE Lidar_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. @@ -2299,114 +865,105 @@ SUBROUTINE Lidar_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, E ! !.................................................................................................................................. - TYPE(Lidar_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 > t3 - TYPE(Lidar_InputType), INTENT(IN) :: u2 ! Input at t2 > t3 - TYPE(Lidar_InputType), INTENT(IN) :: u3 ! Input at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs - TYPE(Lidar_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 + TYPE(Lidar_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 > t3 + TYPE(Lidar_InputType), INTENT(IN) :: u2 ! Input at t2 > t3 + TYPE(Lidar_InputType), INTENT(IN) :: u3 ! Input at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs + TYPE(Lidar_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 = 'Lidar_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) - + 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) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_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 + 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 + 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 + 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))) - b = (t(3)**2*(u1%PulseLidEl - u2%PulseLidEl) + t(2)**2*(-u1%PulseLidEl + u3%PulseLidEl))* scaleFactor - c = ( (t(2)-t(3))*u1%PulseLidEl + t(3)*u2%PulseLidEl - t(2)*u3%PulseLidEl ) * scaleFactor - u_out%PulseLidEl = u1%PulseLidEl + b + c * t_out - b = (t(3)**2*(u1%PulseLidAz - u2%PulseLidAz) + t(2)**2*(-u1%PulseLidAz + u3%PulseLidAz))* scaleFactor - c = ( (t(2)-t(3))*u1%PulseLidAz + t(3)*u2%PulseLidAz - t(2)*u3%PulseLidAz ) * scaleFactor - u_out%PulseLidAz = u1%PulseLidAz + b + c * t_out - b = (t(3)**2*(u1%HubDisplacementX - u2%HubDisplacementX) + t(2)**2*(-u1%HubDisplacementX + u3%HubDisplacementX))* scaleFactor - c = ( (t(2)-t(3))*u1%HubDisplacementX + t(3)*u2%HubDisplacementX - t(2)*u3%HubDisplacementX ) * scaleFactor - u_out%HubDisplacementX = u1%HubDisplacementX + b + c * t_out - b = (t(3)**2*(u1%HubDisplacementY - u2%HubDisplacementY) + t(2)**2*(-u1%HubDisplacementY + u3%HubDisplacementY))* scaleFactor - c = ( (t(2)-t(3))*u1%HubDisplacementY + t(3)*u2%HubDisplacementY - t(2)*u3%HubDisplacementY ) * scaleFactor - u_out%HubDisplacementY = u1%HubDisplacementY + b + c * t_out - b = (t(3)**2*(u1%HubDisplacementZ - u2%HubDisplacementZ) + t(2)**2*(-u1%HubDisplacementZ + u3%HubDisplacementZ))* scaleFactor - c = ( (t(2)-t(3))*u1%HubDisplacementZ + t(3)*u2%HubDisplacementZ - t(2)*u3%HubDisplacementZ ) * scaleFactor - u_out%HubDisplacementZ = u1%HubDisplacementZ + b + c * t_out - END SUBROUTINE Lidar_Input_ExtrapInterp2 - - - SUBROUTINE Lidar_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(Lidar_OutputType), INTENT(IN) :: y(:) ! Output at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Outputs - TYPE(Lidar_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 + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + u_out%PulseLidEl = a1*u1%PulseLidEl + a2*u2%PulseLidEl + a3*u3%PulseLidEl + u_out%PulseLidAz = a1*u1%PulseLidAz + a2*u2%PulseLidAz + a3*u3%PulseLidAz + u_out%HubDisplacementX = a1*u1%HubDisplacementX + a2*u2%HubDisplacementX + a3*u3%HubDisplacementX + u_out%HubDisplacementY = a1*u1%HubDisplacementY + a2*u2%HubDisplacementY + a3*u3%HubDisplacementY + u_out%HubDisplacementZ = a1*u1%HubDisplacementZ + a2*u2%HubDisplacementZ + a3*u3%HubDisplacementZ +END SUBROUTINE + +subroutine Lidar_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(Lidar_OutputType), intent(in) :: y(:) ! Output at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Outputs + type(Lidar_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 = 'Lidar_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 Lidar_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL Lidar_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 Lidar_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 Lidar_Output_ExtrapInterp - - - SUBROUTINE Lidar_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'Lidar_Output_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(y)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(y)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(y) - 1 + select case (order) + case (0) + call Lidar_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call Lidar_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call Lidar_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(y) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE Lidar_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. @@ -2418,71 +975,57 @@ SUBROUTINE Lidar_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrM ! !.................................................................................................................................. - TYPE(Lidar_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 - TYPE(Lidar_OutputType), INTENT(IN) :: y2 ! Output at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs - TYPE(Lidar_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 + TYPE(Lidar_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 + TYPE(Lidar_OutputType), INTENT(IN) :: y2 ! Output at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs + TYPE(Lidar_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 = 'Lidar_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 + REAL(DbKi) :: t(2) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_Output_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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%LidSpeed) .AND. ALLOCATED(y1%LidSpeed)) THEN - DO i1 = LBOUND(y_out%LidSpeed,1),UBOUND(y_out%LidSpeed,1) - b = -(y1%LidSpeed(i1) - y2%LidSpeed(i1)) - y_out%LidSpeed(i1) = y1%LidSpeed(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%WtTrunc) .AND. ALLOCATED(y1%WtTrunc)) THEN - DO i1 = LBOUND(y_out%WtTrunc,1),UBOUND(y_out%WtTrunc,1) - b = -(y1%WtTrunc(i1) - y2%WtTrunc(i1)) - y_out%WtTrunc(i1) = y1%WtTrunc(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%MsrPositionsX) .AND. ALLOCATED(y1%MsrPositionsX)) THEN - DO i1 = LBOUND(y_out%MsrPositionsX,1),UBOUND(y_out%MsrPositionsX,1) - b = -(y1%MsrPositionsX(i1) - y2%MsrPositionsX(i1)) - y_out%MsrPositionsX(i1) = y1%MsrPositionsX(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%MsrPositionsY) .AND. ALLOCATED(y1%MsrPositionsY)) THEN - DO i1 = LBOUND(y_out%MsrPositionsY,1),UBOUND(y_out%MsrPositionsY,1) - b = -(y1%MsrPositionsY(i1) - y2%MsrPositionsY(i1)) - y_out%MsrPositionsY(i1) = y1%MsrPositionsY(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%MsrPositionsZ) .AND. ALLOCATED(y1%MsrPositionsZ)) THEN - DO i1 = LBOUND(y_out%MsrPositionsZ,1),UBOUND(y_out%MsrPositionsZ,1) - b = -(y1%MsrPositionsZ(i1) - y2%MsrPositionsZ(i1)) - y_out%MsrPositionsZ(i1) = y1%MsrPositionsZ(i1) + b * ScaleFactor - END DO -END IF ! check if allocated - END SUBROUTINE Lidar_Output_ExtrapInterp1 - - - SUBROUTINE Lidar_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + IF (ALLOCATED(y_out%LidSpeed) .AND. ALLOCATED(y1%LidSpeed)) THEN + y_out%LidSpeed = a1*y1%LidSpeed + a2*y2%LidSpeed + END IF ! check if allocated + IF (ALLOCATED(y_out%WtTrunc) .AND. ALLOCATED(y1%WtTrunc)) THEN + y_out%WtTrunc = a1*y1%WtTrunc + a2*y2%WtTrunc + END IF ! check if allocated + IF (ALLOCATED(y_out%MsrPositionsX) .AND. ALLOCATED(y1%MsrPositionsX)) THEN + y_out%MsrPositionsX = a1*y1%MsrPositionsX + a2*y2%MsrPositionsX + END IF ! check if allocated + IF (ALLOCATED(y_out%MsrPositionsY) .AND. ALLOCATED(y1%MsrPositionsY)) THEN + y_out%MsrPositionsY = a1*y1%MsrPositionsY + a2*y2%MsrPositionsY + END IF ! check if allocated + IF (ALLOCATED(y_out%MsrPositionsZ) .AND. ALLOCATED(y1%MsrPositionsZ)) THEN + y_out%MsrPositionsZ = a1*y1%MsrPositionsZ + a2*y2%MsrPositionsZ + END IF ! check if allocated +END SUBROUTINE + +SUBROUTINE Lidar_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. @@ -2496,82 +1039,62 @@ SUBROUTINE Lidar_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ! !.................................................................................................................................. - TYPE(Lidar_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 > t3 - TYPE(Lidar_OutputType), INTENT(IN) :: y2 ! Output at t2 > t3 - TYPE(Lidar_OutputType), INTENT(IN) :: y3 ! Output at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs - TYPE(Lidar_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 + TYPE(Lidar_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 > t3 + TYPE(Lidar_OutputType), INTENT(IN) :: y2 ! Output at t2 > t3 + TYPE(Lidar_OutputType), INTENT(IN) :: y3 ! Output at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs + TYPE(Lidar_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 = 'Lidar_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) - + 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) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_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 + 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 + 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 + 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%LidSpeed) .AND. ALLOCATED(y1%LidSpeed)) THEN - DO i1 = LBOUND(y_out%LidSpeed,1),UBOUND(y_out%LidSpeed,1) - b = (t(3)**2*(y1%LidSpeed(i1) - y2%LidSpeed(i1)) + t(2)**2*(-y1%LidSpeed(i1) + y3%LidSpeed(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%LidSpeed(i1) + t(3)*y2%LidSpeed(i1) - t(2)*y3%LidSpeed(i1) ) * scaleFactor - y_out%LidSpeed(i1) = y1%LidSpeed(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%WtTrunc) .AND. ALLOCATED(y1%WtTrunc)) THEN - DO i1 = LBOUND(y_out%WtTrunc,1),UBOUND(y_out%WtTrunc,1) - b = (t(3)**2*(y1%WtTrunc(i1) - y2%WtTrunc(i1)) + t(2)**2*(-y1%WtTrunc(i1) + y3%WtTrunc(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%WtTrunc(i1) + t(3)*y2%WtTrunc(i1) - t(2)*y3%WtTrunc(i1) ) * scaleFactor - y_out%WtTrunc(i1) = y1%WtTrunc(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%MsrPositionsX) .AND. ALLOCATED(y1%MsrPositionsX)) THEN - DO i1 = LBOUND(y_out%MsrPositionsX,1),UBOUND(y_out%MsrPositionsX,1) - b = (t(3)**2*(y1%MsrPositionsX(i1) - y2%MsrPositionsX(i1)) + t(2)**2*(-y1%MsrPositionsX(i1) + y3%MsrPositionsX(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%MsrPositionsX(i1) + t(3)*y2%MsrPositionsX(i1) - t(2)*y3%MsrPositionsX(i1) ) * scaleFactor - y_out%MsrPositionsX(i1) = y1%MsrPositionsX(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%MsrPositionsY) .AND. ALLOCATED(y1%MsrPositionsY)) THEN - DO i1 = LBOUND(y_out%MsrPositionsY,1),UBOUND(y_out%MsrPositionsY,1) - b = (t(3)**2*(y1%MsrPositionsY(i1) - y2%MsrPositionsY(i1)) + t(2)**2*(-y1%MsrPositionsY(i1) + y3%MsrPositionsY(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%MsrPositionsY(i1) + t(3)*y2%MsrPositionsY(i1) - t(2)*y3%MsrPositionsY(i1) ) * scaleFactor - y_out%MsrPositionsY(i1) = y1%MsrPositionsY(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%MsrPositionsZ) .AND. ALLOCATED(y1%MsrPositionsZ)) THEN - DO i1 = LBOUND(y_out%MsrPositionsZ,1),UBOUND(y_out%MsrPositionsZ,1) - b = (t(3)**2*(y1%MsrPositionsZ(i1) - y2%MsrPositionsZ(i1)) + t(2)**2*(-y1%MsrPositionsZ(i1) + y3%MsrPositionsZ(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%MsrPositionsZ(i1) + t(3)*y2%MsrPositionsZ(i1) - t(2)*y3%MsrPositionsZ(i1) ) * scaleFactor - y_out%MsrPositionsZ(i1) = y1%MsrPositionsZ(i1) + b + c * t_out - END DO -END IF ! check if allocated - END SUBROUTINE Lidar_Output_ExtrapInterp2 - + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + IF (ALLOCATED(y_out%LidSpeed) .AND. ALLOCATED(y1%LidSpeed)) THEN + y_out%LidSpeed = a1*y1%LidSpeed + a2*y2%LidSpeed + a3*y3%LidSpeed + END IF ! check if allocated + IF (ALLOCATED(y_out%WtTrunc) .AND. ALLOCATED(y1%WtTrunc)) THEN + y_out%WtTrunc = a1*y1%WtTrunc + a2*y2%WtTrunc + a3*y3%WtTrunc + END IF ! check if allocated + IF (ALLOCATED(y_out%MsrPositionsX) .AND. ALLOCATED(y1%MsrPositionsX)) THEN + y_out%MsrPositionsX = a1*y1%MsrPositionsX + a2*y2%MsrPositionsX + a3*y3%MsrPositionsX + END IF ! check if allocated + IF (ALLOCATED(y_out%MsrPositionsY) .AND. ALLOCATED(y1%MsrPositionsY)) THEN + y_out%MsrPositionsY = a1*y1%MsrPositionsY + a2*y2%MsrPositionsY + a3*y3%MsrPositionsY + END IF ! check if allocated + IF (ALLOCATED(y_out%MsrPositionsZ) .AND. ALLOCATED(y1%MsrPositionsZ)) THEN + y_out%MsrPositionsZ = a1*y1%MsrPositionsZ + a2*y2%MsrPositionsZ + a3*y3%MsrPositionsZ + END IF ! check if allocated +END SUBROUTINE END MODULE Lidar_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/inflowwind/tests/ifw_test_tools.F90 b/modules/inflowwind/tests/ifw_test_tools.F90 index 109fd36f77..62ede38903 100644 --- a/modules/inflowwind/tests/ifw_test_tools.F90 +++ b/modules/inflowwind/tests/ifw_test_tools.F90 @@ -40,9 +40,9 @@ function getInputFileData() '"unused" FilenameRoot - Rootname of the full-field wind file to use (.wnd, .sum) ', & 'False TowerFile - Have tower file (.twr) (flag) ', & '================== Parameters for HAWC-format binary files [Only used with WindType = 5] ===================== ', & - '"wasp\Output\basic_5u.bin" FileName_u - name of the file containing the u-component fluctuating wind (.bin) ', & - '"wasp\Output\basic_5v.bin" FileName_v - name of the file containing the v-component fluctuating wind (.bin) ', & - '"wasp\Output\basic_5w.bin" FileName_w - name of the file containing the w-component fluctuating wind (.bin) ', & + '"wasp/Output/basic_5u.bin" FileName_u - name of the file containing the u-component fluctuating wind (.bin) ', & + '"wasp/Output/basic_5v.bin" FileName_v - name of the file containing the v-component fluctuating wind (.bin) ', & + '"wasp/Output/basic_5w.bin" FileName_w - name of the file containing the w-component fluctuating wind (.bin) ', & ' 64 nx - number of grids in the x direction (in the 3 files above) (-) ', & ' 32 ny - number of grids in the y direction (in the 3 files above) (-) ', & ' 32 nz - number of grids in the z direction (in the 3 files above) (-) ', & @@ -121,9 +121,9 @@ function getInputFileDataWindType2() '"unused" FilenameRoot - Rootname of the full-field wind file to use (.wnd, .sum) ', & 'False TowerFile - Have tower file (.twr) (flag) ', & '================== Parameters for HAWC-format binary files [Only used with WindType = 5] ===================== ', & - '"wasp\Output\basic_5u.bin" FileName_u - name of the file containing the u-component fluctuating wind (.bin) ', & - '"wasp\Output\basic_5v.bin" FileName_v - name of the file containing the v-component fluctuating wind (.bin) ', & - '"wasp\Output\basic_5w.bin" FileName_w - name of the file containing the w-component fluctuating wind (.bin) ', & + '"wasp/Output/basic_5u.bin" FileName_u - name of the file containing the u-component fluctuating wind (.bin) ', & + '"wasp/Output/basic_5v.bin" FileName_v - name of the file containing the v-component fluctuating wind (.bin) ', & + '"wasp/Output/basic_5w.bin" FileName_w - name of the file containing the w-component fluctuating wind (.bin) ', & ' 64 nx - number of grids in the x direction (in the 3 files above) (-) ', & ' 32 ny - number of grids in the y direction (in the 3 files above) (-) ', & ' 32 nz - number of grids in the z direction (in the 3 files above) (-) ', & diff --git a/modules/inflowwind/tests/inflowwind_utest.F90 b/modules/inflowwind/tests/inflowwind_utest.F90 new file mode 100644 index 0000000000..83bf35405b --- /dev/null +++ b/modules/inflowwind/tests/inflowwind_utest.F90 @@ -0,0 +1,43 @@ +program inflowwind_utest +use, intrinsic :: iso_fortran_env, only: error_unit +use testdrive, only: run_testsuite, new_testsuite, testsuite_type + +use test_bladed_wind, only: test_bladed_wind_suite +use test_hawc_wind, only: test_hawc_wind_suite +use test_outputs, only: test_outputs_suite +use test_steady_wind, only: test_steady_wind_suite +use test_turbsim_wind, only: test_turbsim_wind_suite +use test_uniform_wind, only: test_uniform_wind_suite +use NWTC_Num + +implicit none +integer :: stat, is +type(testsuite_type), allocatable :: testsuites(:) +character(len=*), parameter :: fmt = '("#", *(1x, a))' + +stat = 0 + +call SetConstants() + +testsuites = [ & + new_testsuite("Bladed Wind", test_bladed_wind_suite), & + new_testsuite("HAWC Wind", test_hawc_wind_suite), & + new_testsuite("Outputs", test_outputs_suite), & + new_testsuite("Steady Wind", test_steady_wind_suite), & + new_testsuite("Turbsim Wind", test_turbsim_wind_suite), & + new_testsuite("Uniform Wind", test_uniform_wind_suite) & + ] + +do is = 1, size(testsuites) + write (error_unit, fmt) "Testing:", testsuites(is)%name + call run_testsuite(testsuites(is)%collect, error_unit, stat) +end do + +if (stat > 0) then + write (error_unit, '(i0, 1x, a)') stat, "test(s) failed!" + error stop +end if + +write (error_unit, fmt) "All tests PASSED" + +end program diff --git a/modules/inflowwind/tests/test_bladed_wind.F90 b/modules/inflowwind/tests/test_bladed_wind.F90 index 5dd860e139..3d3bd45134 100644 --- a/modules/inflowwind/tests/test_bladed_wind.F90 +++ b/modules/inflowwind/tests/test_bladed_wind.F90 @@ -1,35 +1,44 @@ module test_bladed_wind - use pFUnit_mod - use ifw_test_tools - use InflowWind_Subs - use InflowWind_Types +use testdrive, only: new_unittest, unittest_type, error_type, check +use ifw_test_tools +use InflowWind_Subs +use InflowWind_Types - implicit none +implicit none + +private +public :: test_bladed_wind_suite contains - @test - subroutine test_bladed_wind_input() +!> Collect all exported unit tests +subroutine test_bladed_wind_suite(testsuite) + type(unittest_type), allocatable, intent(out) :: testsuite(:) + testsuite = [new_unittest("test_bladed_wind_input", test_bladed_wind_input)] +end subroutine + +subroutine test_bladed_wind_input(error) + type(error_type), allocatable, intent(out) :: error - TYPE(FileInfoType) :: InFileInfo - TYPE(InflowWind_InputFile) :: InputFileData - CHARACTER(1024) :: PriPath - INTEGER(IntKi) :: TmpErrStat - CHARACTER(ErrMsgLen) :: TmpErrMsg + type(FileInfoType) :: InFileInfo + type(InflowWind_InputFile) :: InputFileData + character(1024) :: PriPath + integer(IntKi) :: TmpErrStat + character(ErrMsgLen) :: TmpErrMsg - CHARACTER(16) :: expected + character(16) :: expected - expected = "unused" - PriPath = "" + expected = "unused" + PriPath = "" - InFileInfo = getInputFileData() - CALL InflowWind_ParseInputFileInfo(InputFileData , InFileInfo, PriPath, "inputFile.inp", "test.ech", .false., -1, TmpErrStat, TmpErrMsg) + InFileInfo = getInputFileData() + call InflowWind_ParseInputFileInfo(InputFileData, InFileInfo, PriPath, "inputFile.inp", "test.ech", .false., -1, TmpErrStat, TmpErrMsg) - @assertEqual(0, TmpErrStat, message='Error message: '//trim(TmpErrMsg)//NewLine//'ErrStat: ') - @assertEqual(trim(expected), InputFileData%BladedFF_FileName) - @assertEqual(.FALSE., InputFileData%BladedFF_TowerFile) + call check(error, TmpErrStat, 0, message='Error message: '//trim(TmpErrMsg)//NewLine//'ErrStat: '); if (allocated(error)) return + call check(error, InputFileData%BladedFF_FileName, trim(expected)); if (allocated(error)) return + call check(error, InputFileData%BladedFF_TowerFile, .false.); if (allocated(error)) return - end subroutine +end subroutine end module diff --git a/modules/inflowwind/tests/test_hawc_wind.F90 b/modules/inflowwind/tests/test_hawc_wind.F90 index 2e2e1a0b7c..e1b89efb95 100644 --- a/modules/inflowwind/tests/test_hawc_wind.F90 +++ b/modules/inflowwind/tests/test_hawc_wind.F90 @@ -1,62 +1,70 @@ module test_hawc_wind - use pFUnit_mod - use ifw_test_tools - use InflowWind_Subs - use InflowWind_Types +use testdrive, only: new_unittest, unittest_type, error_type, check +use ifw_test_tools +use InflowWind_Subs +use InflowWind_Types - implicit none +implicit none +private +public :: test_hawc_wind_suite contains - @test - subroutine test_hawc_wind_input() - - TYPE(FileInfoType) :: InFileInfo - TYPE(InflowWind_InputFile) :: InputFileData - CHARACTER(1024) :: PriPath - INTEGER(IntKi) :: TmpErrStat - CHARACTER(ErrMsgLen) :: TmpErrMsg - - CHARACTER(32) :: expected_fnu - CHARACTER(32) :: expected_fnv - CHARACTER(32) :: expected_fnw - - PriPath = "" - expected_fnu = "wasp\Output\basic_5u.bin" - expected_fnv = "wasp\Output\basic_5v.bin" - expected_fnw = "wasp\Output\basic_5w.bin" - - InFileInfo = getInputFileData() - CALL InflowWind_ParseInputFileInfo(InputFileData , InFileInfo, PriPath, "inputFile.inp", "test.ech", .false., -1, TmpErrStat, TmpErrMsg) - - @assertEqual(0, TmpErrStat, message='Error message: '//trim(TmpErrMsg)//NewLine//'ErrStat: ') - - @assertEqual(trim(expected_fnu), InputFileData%HAWC_FileName_u) - @assertEqual(trim(expected_fnv), InputFileData%HAWC_FileName_v) - @assertEqual(trim(expected_fnw), InputFileData%HAWC_FileName_w) - @assertEqual(64, InputFileData%HAWC_nx) - @assertEqual(32, InputFileData%HAWC_ny) - @assertEqual(32, InputFileData%HAWC_nz) - @assertEqual(16, InputFileData%HAWC_dx) - @assertEqual(3, InputFileData%HAWC_dy) - @assertEqual(3, InputFileData%HAWC_dz) - @assertEqual(90, InputFileData%FF%RefHt) - - @assertEqual(1, InputFileData%FF%ScaleMethod) - @assertEqual(1, InputFileData%FF%SF(1)) - @assertEqual(1, InputFileData%FF%SF(2)) - @assertEqual(1, InputFileData%FF%SF(3)) - @assertEqual(12, InputFileData%FF%SigmaF(1)) - @assertEqual(8, InputFileData%FF%SigmaF(2)) - @assertEqual(2, InputFileData%FF%SigmaF(3)) - - @assertEqual(5, InputFileData%FF%URef) - @assertEqual(2, InputFileData%FF%WindProfileType) - @assertEqual(0, InputFileData%FF%PLExp) - @assertEqual(0.03, InputFileData%FF%Z0) - @assertEqual(0, InputFileData%FF%XOffset) - - end subroutine +!> Collect all exported unit tests +subroutine test_hawc_wind_suite(testsuite) + type(unittest_type), allocatable, intent(out) :: testsuite(:) + testsuite = [new_unittest("test_hawc_wind_input", test_hawc_wind_input)] +end subroutine + +subroutine test_hawc_wind_input(error) + type(error_type), allocatable, intent(out) :: error + + type(FileInfoType) :: InFileInfo + type(InflowWind_InputFile) :: InputFileData + character(1024) :: PriPath + integer(IntKi) :: TmpErrStat + character(ErrMsgLen) :: TmpErrMsg + + character(32) :: expected_fnu + character(32) :: expected_fnv + character(32) :: expected_fnw + + PriPath = "" + expected_fnu = "wasp/Output/basic_5u.bin" + expected_fnv = "wasp/Output/basic_5v.bin" + expected_fnw = "wasp/Output/basic_5w.bin" + + InFileInfo = getInputFileData() + call InflowWind_ParseInputFileInfo(InputFileData, InFileInfo, PriPath, "inputFile.inp", "test.ech", .false., -1, TmpErrStat, TmpErrMsg) + + call check(error, TmpErrStat, ErrID_None, message='Error message: '//trim(TmpErrMsg)//NewLine//'ErrStat: '); if (allocated(error)) return + + call check(error, InputFileData%HAWC_FileName_u, trim(expected_fnu)); if (allocated(error)) return + call check(error, InputFileData%HAWC_FileName_v, trim(expected_fnv)); if (allocated(error)) return + call check(error, InputFileData%HAWC_FileName_w, trim(expected_fnw)); if (allocated(error)) return + call check(error, InputFileData%HAWC_nx, 64); if (allocated(error)) return + call check(error, InputFileData%HAWC_ny, 32); if (allocated(error)) return + call check(error, InputFileData%HAWC_nz, 32); if (allocated(error)) return + call check(error, InputFileData%HAWC_dx, 16.0_ReKi); if (allocated(error)) return + call check(error, InputFileData%HAWC_dy, 3.0_ReKi); if (allocated(error)) return + call check(error, InputFileData%HAWC_dz, 3.0_ReKi); if (allocated(error)) return + call check(error, InputFileData%FF%RefHt, 90.0_ReKi); if (allocated(error)) return + + call check(error, InputFileData%FF%ScaleMethod, 1); if (allocated(error)) return + call check(error, InputFileData%FF%SF(1), 1.0_ReKi); if (allocated(error)) return + call check(error, InputFileData%FF%SF(2), 1.0_ReKi); if (allocated(error)) return + call check(error, InputFileData%FF%SF(3), 1.0_ReKi); if (allocated(error)) return + call check(error, InputFileData%FF%SigmaF(1), 12.0_ReKi); if (allocated(error)) return + call check(error, InputFileData%FF%SigmaF(2), 8.0_ReKi); if (allocated(error)) return + call check(error, InputFileData%FF%SigmaF(3), 2.0_ReKi); if (allocated(error)) return + + call check(error, InputFileData%FF%URef, 5.0_ReKi); if (allocated(error)) return + call check(error, InputFileData%FF%WindProfileType, 2); if (allocated(error)) return + call check(error, InputFileData%FF%PLExp, 0.0_ReKi); if (allocated(error)) return + call check(error, InputFileData%FF%Z0, 0.03_ReKi); if (allocated(error)) return + call check(error, InputFileData%FF%XOffset, 0.0_ReKi); if (allocated(error)) return + +end subroutine end module diff --git a/modules/inflowwind/tests/test_outputs.F90 b/modules/inflowwind/tests/test_outputs.F90 index a5acd741c5..9ecce090f0 100644 --- a/modules/inflowwind/tests/test_outputs.F90 +++ b/modules/inflowwind/tests/test_outputs.F90 @@ -1,62 +1,68 @@ module test_outputs - use pFUnit_mod - use ifw_test_tools - use InflowWind_Subs - use InflowWind_Types +use testdrive, only: new_unittest, unittest_type, error_type, check +use ifw_test_tools +use InflowWind_Subs +use InflowWind_Types - implicit none +implicit none +private +public :: test_outputs_suite contains - @test - subroutine test_outputs_parsing() - - TYPE(FileInfoType) :: InFileInfo - TYPE(InflowWind_InputFile) :: InputFileData - CHARACTER(1024) :: PriPath - INTEGER(IntKi) :: TmpErrStat - CHARACTER(ErrMsgLen) :: TmpErrMsg - - PriPath = "" - - InFileInfo = getInputFileData() - CALL InflowWind_ParseInputFileInfo(InputFileData , InFileInfo, PriPath, "inputFile.inp", "test.ech", .false., -1, TmpErrStat, TmpErrMsg) - - @assertEqual(0, TmpErrStat, message='Error message: '//trim(TmpErrMsg)//NewLine//'ErrStat: ') - @assertEqual(.FALSE., InputFileData%SumPrint) - @assertEqual("Wind1VelX", InputFileData%OutList(1)) - @assertEqual("Wind1VelY", InputFileData%OutList(2)) - @assertEqual("Wind1VelZ", InputFileData%OutList(3)) - - end subroutine - - - @test - subroutine test_outputs_parsing_alternate() - - TYPE(FileInfoType) :: InFileInfo - TYPE(InflowWind_InputFile) :: InputFileData - CHARACTER(1024) :: PriPath - INTEGER(IntKi) :: TmpErrStat - CHARACTER(ErrMsgLen) :: TmpErrMsg - - PriPath = "" - - InFileInfo = getInputFileData() - InFileInfo%Lines(65:67) = (/ & - 'True SumPrint - Print summary data to .IfW.sum (flag) ', & - ' OutList - The next line(s) contains a list of output parameters. See OutListParameters.xlsx for a listing of available output channels, (-)', & - '"Wind1VelX,Wind1VelY" - Wind velocity at point WindVxiList(1),WindVyiList(1),WindVziList(1). X, Y, and Z direction components. ' & - /) - - CALL InflowWind_ParseInputFileInfo(InputFileData , InFileInfo, PriPath, "inputFile.inp", "test.ech", .false., -1, TmpErrStat, TmpErrMsg) - - @assertEqual(0, TmpErrStat, message='Error message: '//trim(TmpErrMsg)//NewLine//'ErrStat: ') - @assertEqual(.TRUE., InputFileData%SumPrint) - @assertEqual("Wind1VelX", InputFileData%OutList(1)) - @assertEqual("Wind1VelY", InputFileData%OutList(2)) - - end subroutine +!> Collect all exported unit tests +subroutine test_outputs_suite(testsuite) + type(unittest_type), allocatable, intent(out) :: testsuite(:) + testsuite = [ & + new_unittest("test_outputs_parsing", test_outputs_parsing), & + new_unittest("test_outputs_parsing_alternate", test_outputs_parsing_alternate) & + ] +end subroutine + +subroutine test_outputs_parsing(error) + type(error_type), allocatable, intent(out) :: error + type(FileInfoType) :: InFileInfo + type(InflowWind_InputFile) :: InputFileData + character(1024) :: PriPath + integer(IntKi) :: TmpErrStat + character(ErrMsgLen) :: TmpErrMsg + + PriPath = "" + + InFileInfo = getInputFileData() + call InflowWind_ParseInputFileInfo(InputFileData, InFileInfo, PriPath, "inputFile.inp", "test.ech", .false., -1, TmpErrStat, TmpErrMsg) + + call check(error, TmpErrStat, ErrID_None, message='Error message: '//trim(TmpErrMsg)//NewLine//'ErrStat: '); if (allocated(error)) return + call check(error, InputFileData%SumPrint, .false.); if (allocated(error)) return + call check(error, InputFileData%OutList(1), "Wind1VelX"); if (allocated(error)) return + call check(error, InputFileData%OutList(2), "Wind1VelY"); if (allocated(error)) return + call check(error, InputFileData%OutList(3), "Wind1VelZ"); if (allocated(error)) return +end subroutine + +subroutine test_outputs_parsing_alternate(error) + type(error_type), allocatable, intent(out) :: error + type(FileInfoType) :: InFileInfo + type(InflowWind_InputFile) :: InputFileData + character(1024) :: PriPath + integer(IntKi) :: TmpErrStat + character(ErrMsgLen) :: TmpErrMsg + + PriPath = "" + + InFileInfo = getInputFileData() + InFileInfo%Lines(65:67) = [ & + 'True SumPrint - Print summary data to .IfW.sum (flag) ', & + ' OutList - The next line(s) contains a list of output parameters. See OutListParameters.xlsx for a listing of available output channels, (-)', & + '"Wind1VelX,Wind1VelY" - Wind velocity at point WindVxiList(1),WindVyiList(1),WindVziList(1). X, Y, and Z direction components. ' & + ] + + call InflowWind_ParseInputFileInfo(InputFileData, InFileInfo, PriPath, "inputFile.inp", "test.ech", .false., -1, TmpErrStat, TmpErrMsg) + + call check(error, TmpErrStat, ErrID_None, message='Error message: '//trim(TmpErrMsg)//NewLine//'ErrStat: '); if (allocated(error)) return + call check(error, InputFileData%SumPrint, .true.); if (allocated(error)) return + call check(error, InputFileData%OutList(1), "Wind1VelX"); if (allocated(error)) return + call check(error, InputFileData%OutList(2), "Wind1VelY"); if (allocated(error)) return +end subroutine end module diff --git a/modules/inflowwind/tests/test_steady_wind.F90 b/modules/inflowwind/tests/test_steady_wind.F90 index 6b0578402e..ab611cfcc6 100644 --- a/modules/inflowwind/tests/test_steady_wind.F90 +++ b/modules/inflowwind/tests/test_steady_wind.F90 @@ -1,63 +1,71 @@ module test_steady_wind - use pFUnit_mod - use ifw_test_tools - use InflowWind_Subs - use InflowWind_Types +use testdrive, only: new_unittest, unittest_type, error_type, check +use ifw_test_tools +use InflowWind_Subs +use InflowWind_Types - implicit none +implicit none +private +public :: test_steady_wind_suite contains - @test - subroutine test_steady_wind_input_single_height() - - TYPE(FileInfoType) :: InFileInfo - TYPE(InflowWind_InputFile) :: InputFileData - CHARACTER(1024) :: PriPath - INTEGER(IntKi) :: TmpErrStat - CHARACTER(ErrMsgLen) :: TmpErrMsg - - PriPath = "" - - InFileInfo = getInputFileData() - CALL InflowWind_ParseInputFileInfo(InputFileData , InFileInfo, PriPath, "inputFile.inp", "test.ech", .false., -1, TmpErrStat, TmpErrMsg) - - @assertEqual(0, TmpErrStat, message='Error message: '//trim(TmpErrMsg)//NewLine//'ErrStat: ') - @assertEqual(1, InputFileData%WindType) - @assertEqual(1, InputFileData%NWindVel) - @assertEqual(90, InputFileData%WindVziList(1)) - - end subroutine - - - @test - subroutine test_steady_wind_input_mult_heights() - - TYPE(FileInfoType) :: InFileInfo - TYPE(InflowWind_InputFile) :: InputFileData - CHARACTER(1024) :: PriPath - INTEGER(IntKi) :: TmpErrStat - CHARACTER(ErrMsgLen) :: TmpErrMsg - - PriPath = "" - - InFileInfo = getInputFileData() - InFileInfo%Lines(9:12) = (/ & - ' 2 NWindVel - Number of points to output the wind velocity (0 to 9) ', & - ' 0,0 WindVxiList - List of coordinates in the inertial X direction (m) ', & - ' 0,0 WindVyiList - List of coordinates in the inertial Y direction (m) ', & - ' 80,100 WindVziList - List of coordinates in the inertial Z direction (m) ' & - /) - - CALL InflowWind_ParseInputFileInfo(InputFileData , InFileInfo, PriPath, "inputFile.inp", "test.ech", .false., -1, TmpErrStat, TmpErrMsg) - - @assertEqual(0, TmpErrStat, message='Error message: '//trim(TmpErrMsg)//NewLine//'ErrStat: ') - @assertEqual(1, InputFileData%WindType) - @assertEqual(2, InputFileData%NWindVel) - @assertEqual(80, InputFileData%WindVziList(1)) - @assertEqual(100, InputFileData%WindVziList(2)) - - end subroutine +!> Collect all exported unit tests +subroutine test_steady_wind_suite(testsuite) + type(unittest_type), allocatable, intent(out) :: testsuite(:) + testsuite = [ & + new_unittest("test_steady_wind_input_single_height", test_steady_wind_input_single_height), & + new_unittest("test_steady_wind_input_mult_heights", test_steady_wind_input_mult_heights) & + ] +end subroutine + +subroutine test_steady_wind_input_single_height(error) + type(error_type), allocatable, intent(out) :: error + type(FileInfoType) :: InFileInfo + type(InflowWind_InputFile) :: InputFileData + character(1024) :: PriPath + integer(IntKi) :: TmpErrStat + character(ErrMsgLen) :: TmpErrMsg + + PriPath = "" + + InFileInfo = getInputFileData() + call InflowWind_ParseInputFileInfo(InputFileData, InFileInfo, PriPath, "inputFile.inp", "test.ech", .false., -1, TmpErrStat, TmpErrMsg) + + call check(error, TmpErrStat, ErrID_None, message='Error message: '//trim(TmpErrMsg)//NewLine//'ErrStat: '); if (allocated(error)) return + call check(error, InputFileData%WindType, 1); if (allocated(error)) return + call check(error, InputFileData%NWindVel, 1); if (allocated(error)) return + call check(error, InputFileData%WindVziList(1), 90.0_ReKi); if (allocated(error)) return + +end subroutine + +subroutine test_steady_wind_input_mult_heights(error) + type(error_type), allocatable, intent(out) :: error + type(FileInfoType) :: InFileInfo + type(InflowWind_InputFile) :: InputFileData + character(1024) :: PriPath + integer(IntKi) :: TmpErrStat + character(ErrMsgLen) :: TmpErrMsg + + PriPath = "" + + InFileInfo = getInputFileData() + InFileInfo%Lines(9:12) = [ & + ' 2 NWindVel - Number of points to output the wind velocity (0 to 9) ', & + ' 0,0 WindVxiList - List of coordinates in the inertial X direction (m) ', & + ' 0,0 WindVyiList - List of coordinates in the inertial Y direction (m) ', & + ' 80,100 WindVziList - List of coordinates in the inertial Z direction (m) ' & + ] + + call InflowWind_ParseInputFileInfo(InputFileData, InFileInfo, PriPath, "inputFile.inp", "test.ech", .false., -1, TmpErrStat, TmpErrMsg) + + call check(error, TmpErrStat, ErrID_None, message='Error message: '//trim(TmpErrMsg)//NewLine//'ErrStat: '); if (allocated(error)) return + call check(error, InputFileData%WindType, 1); if (allocated(error)) return + call check(error, InputFileData%NWindVel, 2); if (allocated(error)) return + call check(error, InputFileData%WindVziList(1), 80.0_ReKi); if (allocated(error)) return + call check(error, InputFileData%WindVziList(2), 100.0_ReKi); if (allocated(error)) return + +end subroutine end module diff --git a/modules/inflowwind/tests/test_turbsim_wind.F90 b/modules/inflowwind/tests/test_turbsim_wind.F90 index 854b8497f4..58c4fcd910 100644 --- a/modules/inflowwind/tests/test_turbsim_wind.F90 +++ b/modules/inflowwind/tests/test_turbsim_wind.F90 @@ -1,34 +1,44 @@ module test_turbsim_wind - use pFUnit_mod - use ifw_test_tools - use InflowWind_Subs - use InflowWind_Types +use testdrive, only: new_unittest, unittest_type, error_type, check +use ifw_test_tools +use InflowWind_Subs +use InflowWind_Types - implicit none +implicit none +private +public :: test_turbsim_wind_suite contains - @test - subroutine test_steady_wind_input_single_height() +!> Collect all exported unit tests +subroutine test_turbsim_wind_suite(testsuite) + type(unittest_type), allocatable, intent(out) :: testsuite(:) + testsuite = [ & + new_unittest("test_turbsim_wind_parse", test_turbsim_wind_parse) & + ] +end subroutine - TYPE(FileInfoType) :: InFileInfo - TYPE(InflowWind_InputFile) :: InputFileData - CHARACTER(1024) :: PriPath - INTEGER(IntKi) :: TmpErrStat - CHARACTER(ErrMsgLen) :: TmpErrMsg +subroutine test_turbsim_wind_parse(error) + type(error_type), allocatable, intent(out) :: error - CHARACTER(16) :: expected + type(FileInfoType) :: InFileInfo + type(InflowWind_InputFile) :: InputFileData + character(1024) :: PriPath + integer(IntKi) :: TmpErrStat + character(ErrMsgLen) :: TmpErrMsg - expected = "Wind/08ms.wnd" - PriPath = "" + character(16) :: expected - InFileInfo = getInputFileData() - CALL InflowWind_ParseInputFileInfo(InputFileData , InFileInfo, PriPath, "inputFile.inp", "test.ech", .false., -1, TmpErrStat, TmpErrMsg) + expected = "Wind/08ms.wnd" + PriPath = "" - @assertEqual(0, TmpErrStat, message='Error message: '//trim(TmpErrMsg)//NewLine//'ErrStat: ') - @assertEqual(trim(expected), InputFileData%TSFF_FileName) + InFileInfo = getInputFileData() + call InflowWind_ParseInputFileInfo(InputFileData, InFileInfo, PriPath, "inputFile.inp", "test.ech", .false., -1, TmpErrStat, TmpErrMsg) - end subroutine + call check(error, 0, TmpErrStat, message='Error message: '//trim(TmpErrMsg)//NewLine//'ErrStat: '); if (allocated(error)) return + call check(error, trim(expected), InputFileData%TSFF_FileName); if (allocated(error)) return + +end subroutine end module diff --git a/modules/inflowwind/tests/test_uniform_wind.F90 b/modules/inflowwind/tests/test_uniform_wind.F90 index 13421e5da4..4294396b00 100644 --- a/modules/inflowwind/tests/test_uniform_wind.F90 +++ b/modules/inflowwind/tests/test_uniform_wind.F90 @@ -1,103 +1,47 @@ module test_uniform_wind - use pFUnit_mod - use ifw_test_tools - use InflowWind - use InflowWind_Subs - use InflowWind_Types +use testdrive, only: new_unittest, unittest_type, error_type, check +use ifw_test_tools +use InflowWind +use InflowWind_Subs +use InflowWind_Types - implicit none +implicit none +private +public :: test_uniform_wind_suite contains - @test - subroutine test_uniform_wind_input() +!> Collect all exported unit tests +subroutine test_uniform_wind_suite(testsuite) + type(unittest_type), allocatable, intent(out) :: testsuite(:) + testsuite = [ & + new_unittest("test_uniform_wind_input", test_uniform_wind_input) & + ] +end subroutine - TYPE(FileInfoType) :: InFileInfo - TYPE(InflowWind_InputFile) :: InputFileData - CHARACTER(1024) :: PriPath - INTEGER(IntKi) :: TmpErrStat - CHARACTER(ErrMsgLen) :: TmpErrMsg +subroutine test_uniform_wind_input(error) + type(error_type), allocatable, intent(out) :: error + type(FileInfoType) :: InFileInfo + type(InflowWind_InputFile) :: InputFileData + character(1024) :: PriPath + integer(IntKi) :: TmpErrStat + character(ErrMsgLen) :: TmpErrMsg - CHARACTER(16) :: expected + character(16) :: expected - expected = "Wind/08ms.wnd" - PriPath = "" + expected = "Wind/08ms.wnd" + PriPath = "" - InFileInfo = getInputFileData() - CALL InflowWind_ParseInputFileInfo(InputFileData , InFileInfo, PriPath, "inputFile.inp", "test.ech", .false., -1, TmpErrStat, TmpErrMsg) + InFileInfo = getInputFileData() + call InflowWind_ParseInputFileInfo(InputFileData, InFileInfo, PriPath, "inputFile.inp", "test.ech", .false., -1, TmpErrStat, TmpErrMsg) - @assertEqual(0, TmpErrStat, message='Error message: '//trim(TmpErrMsg)//NewLine//'ErrStat: ') - @assertEqual(trim(expected), InputFileData%Uniform_FileName) - @assertEqual(90, InputFileData%Uniform_RefHt) - @assertEqual(125.88, InputFileData%Uniform_RefLength) + call check(error, TmpErrStat, ErrID_None, message='Error message: '//trim(TmpErrMsg)//NewLine//'ErrStat: '); if (allocated(error)) return + call check(error, InputFileData%Uniform_FileName, trim(expected)); if (allocated(error)) return + call check(error, InputFileData%Uniform_RefHt, 90.0_ReKi); if (allocated(error)) return + call check(error, InputFileData%Uniform_RefLength, 125.88_ReKi); if (allocated(error)) return - end subroutine +end subroutine - @test - subroutine test_uniform_wind_direct_data() - - ! Types for setting up module - TYPE(InflowWind_InitInputType) :: InitInp !< Input data for initialization - TYPE(InflowWind_InputType) :: InputGuess !< An initial guess for the input; the input mesh must be defined - TYPE(InflowWind_ParameterType) :: p !< Parameters - TYPE(InflowWind_ContinuousStateType) :: ContStates !< Initial continuous states - TYPE(InflowWind_DiscreteStateType) :: DiscStates !< Initial discrete states - TYPE(InflowWind_ConstraintStateType) :: ConstrStateGuess !< Initial guess of the constraint states - TYPE(InflowWind_OtherStateType) :: OtherStates !< Initial other/optimization states - TYPE(InflowWind_OutputType) :: y !< Initial output (outputs are not calculated; only the output mesh is initialized) - TYPE(InflowWind_MiscVarType) :: m !< Misc variables for optimization (not copied in glue code) - REAL(DbKi) :: TimeInterval !< Coupling time interval in seconds: InflowWind does not change this. - TYPE(InflowWind_InitOutputType) :: InitOutData - - ! Variables for testing - INTEGER :: ErrStat - CHARACTER(ErrMsgLen) :: ErrMsg - TYPE(FileInfoType) :: InFileInfo - TYPE(FileInfoType) :: WindType2Data - CHARACTER(1024), DIMENSION(6) :: data = (/ & - '! Wind file for sheared 18 m/s wind with 30 degree direction. ', & - '! Time Wind Wind Vert. Horiz. Vert. LinV Gust ', & - '! Speed Dir Speed Shear Shear Shear Speed ', & - ' 0.0 12.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 ', & - ' 0.1 12.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 ', & - ' 999.9 12.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 ' & - /) - - ! Error handling - INTEGER(IntKi) :: TmpErrStat - CHARACTER(ErrMsgLen) :: TmpErrMsg !< temporary error message - - InFileInfo = getInputFileDataWindType2() - CALL InitFileInfo(data, WindType2Data, ErrStat, ErrMsg) - - ! For diagnostic purposes, the following can be used to display the contents - ! of the InFileInfo data structure. - ! call Print_FileInfo_Struct( CU, InFileInfo ) ! CU is the screen -- different number on different systems. - - ! Variable definitions - InitInp%InputFileName = "" - InitInp%NumWindPoints = 5 - InitInp%UseInputFile = .FALSE. - InitInp%RootName = "" - InitInp%PassedFileData = InFileInfo - InitInp%WindType2UseInputFile = .FALSE. - InitInp%WindType2Data = WindType2Data - - CALL InflowWind_Init( InitInp, InputGuess, p, ContStates, DiscStates, & - ConstrStateGuess, OtherStates, y, m, TimeInterval, & - InitOutData, TmpErrStat, TmpErrMsg) - - ! Results - @assertEqual(0, TmpErrStat, message='Error message: '//trim(TmpErrMsg)//NewLine//'ErrStat: ') - @assertEqual(0.0, p%FlowField%Uniform%Time(1)) - @assertEqual(0.1, p%FlowField%Uniform%Time(2)) - @assertEqual(999.9, p%FlowField%Uniform%Time(3)) - - @assertEqual(12.0, p%FlowField%Uniform%VelH(1)) - @assertEqual(12.0, p%FlowField%Uniform%VelH(2)) - @assertEqual(12.0, p%FlowField%Uniform%VelH(3)) - - end subroutine end module diff --git a/modules/lindyn/CMakeLists.txt b/modules/lindyn/CMakeLists.txt new file mode 100644 index 0000000000..4e010d16e5 --- /dev/null +++ b/modules/lindyn/CMakeLists.txt @@ -0,0 +1,32 @@ +# +# 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/LinDyn_Registry.txt ${CMAKE_CURRENT_LIST_DIR}/src/LinDyn_Types.f90) +endif() + +add_library(lindynlib + src/LinDyn.f90 + src/LinDyn_Types.f90 +) +target_link_libraries(lindynlib nwtclibs) + +install(TARGETS lindynlib + EXPORT "${CMAKE_PROJECT_NAME}Libraries" + RUNTIME DESTINATION bin + LIBRARY DESTINATION lib + ARCHIVE DESTINATION lib +) diff --git a/modules/lindyn/README.md b/modules/lindyn/README.md new file mode 100644 index 0000000000..564ae516eb --- /dev/null +++ b/modules/lindyn/README.md @@ -0,0 +1,4 @@ +# LinDyn Module + +## Overview +A module for linear dynamics (m, c, k, f) in OpenFAST diff --git a/modules/lindyn/src/LinDyn.f90 b/modules/lindyn/src/LinDyn.f90 new file mode 100644 index 0000000000..3bb9f0f292 --- /dev/null +++ b/modules/lindyn/src/LinDyn.f90 @@ -0,0 +1,941 @@ +!********************************************************************************************************************************** +!> LinDyn, module for a second order linear dynamical system with mass, stiffness and damping matrix +!! +!! The state is q = [x; xdot], of shape nq = 2*nx +!! The input is F_ext of shape nx +!! The equation of motion is: +!! +!! qdot = [xdot ] = [ 0 I ] [ x ] + [ 0 ] F_ext +!! [xddot] [-M^{-1} K -M^{-1} C ] [ xdot] + [M^{-1}] +!! +!! .................................................................................................................................. +!! ## Licensing +!! Copyright (C) 2012-2013, 2015-2016 National Renewable Energy Laboratory +!! +!! This file is part of LinDyn. +!! +!! 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 LinDyn + + use LinDyn_Types + use NWTC_Library + USE NWTC_LAPACK +! + implicit none + + type(ProgDesc), parameter :: LD_Ver = ProgDesc( 'LinDyn', '', '' ) + + private + + public :: LD_Init ! Initialization routine + public :: LD_InitInputData ! Set default values and allocations for init + public :: LD_End ! Ending routine (includes clean up) + public :: LD_UpdateStates ! Loose coupling routine for solving for constraint states, integrating continuous states, and updating discrete states + public :: LD_CalcOutput ! Routine for computing outputs + public :: LD_CalcContStateDeriv ! Tight coupling routine for computing derivatives of continuous states + public :: LD_JacobianPInput ! Jacobians of (y, x, xd, z) with respect to the inputs (u) + public :: LD_JacobianPContState ! Jacobians of (y, x, xd, z) with respect to the continuous (x) + public :: LD_GetOP ! Routine to get the operating-point values for linearization (from data structures to arrays) +! +contains + +subroutine LD_Init(InitInp, u, p, x, xd, z, OtherState, y, m, InitOut, errStat, errMsg) + type(LD_InitInputType), intent(in ) :: InitInp !< Input data for initialization routine + type(LD_InputType), intent(out) :: u !< An initial guess for the input; input mesh must be defined + type(LD_ParameterType), intent(out) :: p !< Parameters + type(LD_ContinuousStateType), intent(out) :: x !< Initial continuous states + type(LD_DiscreteStateType), intent(out) :: xd !< Initial discrete states + type(LD_ConstraintStateType), intent(out) :: z !< Initial guess of the constraint states + type(LD_OtherStateType), intent(out) :: OtherState !< Initial other states (logical, etc) + type(LD_OutputType), intent(out) :: y !< Initial system outputs (outputs are not calculated; + type(LD_MiscVarType), intent(out) :: m !< Misc variables for optimization (not copied in glue code) + type(LD_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 + integer(IntKi) :: errStat2 ! Status of error message + character(1024) :: errMsg2 ! Error message if ErrStat /= ErrID_None + ! Misc Init + errStat = ErrID_None + errMsg = "" + call NWTC_Init( ) ! Initialize the NWTC Subroutine Library + call DispNVD( LD_Ver ) ! Display the module information + + ! --- Setting Params from InitInp + p%nx = size(InitInp%MM,1) + p%nq = 2*p%nx + call AllocAry(p%MM , p%nx, p%nx, 'MM', errStat2, errMsg2); if(Failed()) return + call AllocAry(p%CC , p%nx, p%nx, 'CC', errStat2, errMsg2); if(Failed()) return + call AllocAry(p%KK , p%nx, p%nx, 'KK', errStat2, errMsg2); if(Failed()) return + call AllocAry(p%activeDOFs, p%nx , 'activeDOFs', errStat2, errMsg2); if(Failed()) return + p%dt = InitInp%dt + p%IntMethod = InitInp%IntMethod + p%MM = InitInp%MM + p%CC = InitInp%CC + p%KK = InitInp%KK + p%activeDOFs = InitInp%activeDOFs + ! Prescribed motion + if (len_trim(InitInp%PrescribedMotionFile)>0) then + if( count(p%activeDOFs)/=0) then + errStat2 = errID_Fatal + errMsg2 = 'Currently, prescribed motion is only allowed if all degrees of freedom are turned off' + if(Failed()) return + endif + call WrScr(' Using prescribed motion.') + call ReadDelimFile(InitInp%PrescribedMotionFile, (p%nx*3+1), p%PrescribedValues, errStat2, errMsg2); if(Failed()) return + else + if (allocated(p%PrescribedValues)) deallocate(p%PrescribedValues) + endif + call StateMatrices(p%MM, p%CC, p%KK, p%AA, p%BB, errStat2, errMsg2); if(Failed()) return + + ! --- Misc + call allocAry(m%qPrescribed, 3*p%nx, 'qPrescribed', errStat2, errMsg2); if(Failed()) return + m%qPrescribed = 0.0_ReKi ! NOTE: will be updated by LD_SetInitialConditions + + ! --- Allocate States + call AllocAry( x%q , p%nq, 'DOFs', errStat, errMsg); if(Failed()) return + call LD_SetInitialConditions(x, InitInp%x0, InitInp%xd0, p, OtherState, m, errStat, errMsg); if(Failed()) return + if ( ( p%IntMethod .eq. 2) .OR. ( p%IntMethod .eq. 3)) then !Multi-step methods + allocate( OtherState%xdot(4), STAT=errStat2); errMsg2='Error allocating OtherState%xdot' + if(Failed()) return + endif + + ! --- Guess inputs + call AllocAry(u%Fext, p%nx, 'Fext', errStat2, errMsg2); if(Failed()) return + u%Fext=0.0_ReKi + + ! --- Outputs & Write Outputs + call Init_Outputs(p, m, y, InitInp, InitOut, errStat, errMsg); if(Failed()) return + InitOut%Ver = LD_Ver + + ! --- Linearization + if (InitInp%Linearize) then + call Init_Lin(p, InitOut, errStat, errMsg); if(Failed()) return + endif +! +! ! --- Summary file +! if (InputFileData%SumPrint) then +! TODO use yaml +! print*,'' +! print*,'M',p%MM(1,:) +! print*,'M',p%MM(2,:) +! print*,'M',p%MM(3,:) +! print*,'' +! print*,'C',p%CC(1,:) +! print*,'C',p%CC(2,:) +! print*,'C',p%CC(3,:) +! print*,'' +! print*,'K',p%KK(1,:) +! print*,'K',p%KK(2,:) +! print*,'K',p%KK(3,:) +! print*,'' +! +! print*,'' +! print*,'A',p%AA(1,:) +! print*,'A',p%AA(2,:) +! print*,'A',p%AA(3,:) +! print*,'A',p%AA(4,:) +! print*,'A',p%AA(5,:) +! print*,'A',p%AA(6,:) +! print*,'' +! print*,'B',p%BB(1,:) +! print*,'B',p%BB(2,:) +! print*,'B',p%BB(3,:) +! print*,'B',p%BB(4,:) +! print*,'B',p%BB(5,:) +! print*,'B',p%BB(6,:) +! endif +! +contains + logical function Failed() + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'LD_Init' ) + Failed = ErrStat >= AbortErrLev + if (Failed) call CleanUp() + end function Failed + subroutine CleanUp() + end subroutine CleanUp +end subroutine LD_Init +!---------------------------------------------------------------------------------------------------------------------------------- +subroutine LD_SetInitialConditions(x, x0, xd0, p, OtherState, m, errStat, errMsg) + type(LD_ContinuousStateType), intent(inout) :: x !< Initial continuous states + real(ReKi), intent(in) :: x0(:) !< Values of the positions at t=0 + real(ReKi), intent(in) :: xd0(:) !< Velocity values at t=0 + type(LD_ParameterType), intent(in ) :: p !< Parameters + type(LD_OtherStateType), intent(inout) :: OtherState !< Other states + type(LD_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 + integer :: nx + nx = int(size(x%q)/2) + errStat = ErrID_Fatal + if (size(x0)/=size(xd0)) then + errMsg ='Shape of x0 and xd0 should match when setting intial conditions'; return + endif + if (size(x0)/=nx) then + errMsg ='Shape of x0 should match nx when setting intial conditions'; return + endif + errMsg = '' + errStat = ErrID_None + + if (allocated(p%PrescribedValues)) then + call interpTimeValue(p%PrescribedValues, 0.0_DbKi, OtherState%iMotionInterpLast, m%qPrescribed(:)) + ! TODO the code below will need to be updated if a subset of the DOFs are active + x%q(1:p%nq) = m%qPrescribed(1:p%nq) + else + x%q( 1:nx) = x0 + x%q(nx+1:2*nx) = xd0 + endif +end subroutine LD_SetInitialConditions +!---------------------------------------------------------------------------------------------------------------------------------- +!> Allocate init input data for module based on number of degrees of freedom +subroutine LD_InitInputData(nx, InitInp, errStat, errMsg) + integer(IntKi), intent(in ) :: nx !< Number of degrees of freedom + type(LD_InitInputType), intent(out) :: 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 + integer(IntKi) :: iDOF + integer(IntKi) :: errStat2 ! Status of error message + character(1024) :: errMsg2 ! Error message if ErrStat /= ErrID_None + ! Initialize errStat + errStat = ErrID_None ! no error has occurred + errMsg = "" + call AllocAry(InitInp%MM , nx, nx, 'MM' , errStat2, errMsg2); if(Failed()) return + call AllocAry(InitInp%CC , nx, nx, 'CC' , errStat2, errMsg2); if(Failed()) return + call AllocAry(InitInp%KK , nx, nx, 'KK' , errStat2, errMsg2); if(Failed()) return + call AllocAry(InitInp%x0 , nx , 'x0' , errStat2, errMsg2); if(Failed()) return + call AllocAry(InitInp%xd0 , nx , 'xd0', errStat2, errMsg2); if(Failed()) return + call AllocAry(InitInp%activeDOFs, nx , 'activeDOFs', errStat2, errMsg2); if(Failed()) return + call AllocAry(InitInp%DOFsNames , nx , 'DOFsNames' , errStat2, errMsg2); if(Failed()) return + call AllocAry(InitInp%DOFsUnits , nx , 'DOFsUnits' , errStat2, errMsg2); if(Failed()) return + InitInp%MM = 0.0_ReKi + InitInp%CC = 0.0_ReKi + InitInp%KK = 0.0_ReKi + InitInp%x0 = 0.0_ReKi + InitInp%xd0 = 0.0_ReKi + InitInp%activeDOFs = .True. + ! Default DOFs Names and Units + do iDOF=1,nx + InitInp%DOFsNames(iDOF)='x'//trim(num2lstr(iDOF)) + InitInp%DOFsUnits(iDOF)='-' + enddo + +contains + logical function Failed() + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'LD_Init' ) + Failed = ErrStat >= AbortErrLev + end function Failed +end subroutine LD_InitInputData +!---------------------------------------------------------------------------------------------------------------------------------- +!> Compute A and B state matrices for a linear mechanical system +!! NOTE: Generic function (no derived types), keep it that way +!! A = [ 0 I ] B = [ 0 ] +!! [-M^{-1}K -M^{-1}C ] = [ M^{-1} ] +subroutine StateMatrices(MM, CC, KK, AA, BB, errStat, errMsg) + real(ReKi), intent(in ) :: MM(:,:) + real(ReKi), intent(in ) :: CC(:,:) + real(ReKi), intent(in ) :: KK(:,:) + real(ReKi), allocatable, intent(out) :: AA(:,:) + real(ReKi), allocatable, intent(out) :: BB(:,:) + integer(IntKi), intent(out) :: errStat !< Error status of the operation + character(*), intent(out) :: errMsg !< Error message if errStat /= ErrID_None + integer(IntKi) :: errStat2 ! Status of error message + character(1024) :: errMsg2 ! Error message if ErrStat /= ErrID_None + integer :: nx, nq, i + + real(ReKi), dimension(:,:), allocatable :: MLU ! LU factorization of M matrix + real(ReKi), dimension(:,:), allocatable :: MinvX ! Tmp array to store either: M^{-1} C, M^{-1} K , or M^{-1} + real(ReKi), dimension(:) , allocatable :: WORK ! LAPACK variable + integer, allocatable :: IPIV(:) ! LAPACK variable + integer :: LWORK ! LAPACK variable + ! Initialize errStat + errStat = ErrID_None + errMsg = "" + + ! --- Init A and B matrix + nx = size(MM,1) + nq = 2*nx + call AllocAry(AA, nq, nq, 'AA', errStat2, errMsg2); if(Failed()) return + call AllocAry(BB, nq, nx, 'BB', errStat2, errMsg2); if(Failed()) return + AA(:,:) = 0.0_ReKi + BB(:,:) = 0.0_ReKi + do i=1,nx ; AA(i,i+nx)=1; enddo ! Identity matrix for upper right block + + ! --- Compute misc inverse of M and put in A and B matrices + call AllocAry(IPIV , nx , 'IPIV' , errStat2, errMsg2); if(Failed()) return + call AllocAry(MinvX , nx, nx, 'MinvX', errStat2, errMsg2); if(Failed()) return + call AllocAry(MLU , nx, nx, 'MLU' , errStat2, errMsg2); if(Failed()) return + + ! LU Factorization of M + MLU = MM ! temp copy + call LAPACK_getrf(nx, nx, MLU, IPIV, errStat2, errMsg2); if(Failed()) return + + ! M^-1 C + MinvX = CC + call LAPACK_getrs('n', nx, MLU, IPIV, MinvX, errStat2, errMsg2); if(Failed()) return + AA(nx+1:nq,nx+1:nq) = -MinvX + + ! M^-1 K + MinvX = KK + call LAPACK_getrs('n', nx, MLU, IPIV, MinvX, errStat2, errMsg2); if(Failed()) return + AA(nx+1:nq, 1:nx) = -MinvX + + ! Inverse of M + MinvX = MLU + LWORK=nx*nx ! Somehow LWORK = -1 does not work + call AllocAry(WORK, LWORk, 'WORK', errStat2, errMsg2); if(Failed()) return + call LAPACK_getri(nx, MinvX, IPIV, WORK, LWORK, errStat2, errMsg2); if(Failed()) return + BB(nx+1:nq, : ) = MinvX + + 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(MLU)) deallocate(MLU) + if (allocated(IPIV)) deallocate(IPIV) + if (allocated(WORK )) deallocate(WORK) + if (allocated(MinvX)) deallocate(MinvX) + end subroutine CleanUp +end subroutine StateMatrices +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine is called at the end of the simulation. +subroutine LD_End( u, p, x, xd, z, OtherState, y, m, errStat, errMsg ) + type(LD_InputType), intent(inout) :: u !< System inputs + type(LD_ParameterType), intent(inout) :: p !< Parameters + type(LD_ContinuousStateType), intent(inout) :: x !< Continuous states + type(LD_DiscreteStateType), intent(inout) :: xd !< Discrete states + type(LD_ConstraintStateType), intent(inout) :: z !< Constraint states + type(LD_OtherStateType), intent(inout) :: OtherState !< Other states + type(LD_OutputType), intent(inout) :: y !< System outputs + type(LD_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 ! no error has occurred + errMsg = "" + call LD_DestroyInput (u ,errStat,errMsg) + call LD_DestroyParam (p ,errStat,errMsg) + call LD_DestroyContState (x ,errStat,errMsg) + call LD_DestroyDiscState (xd ,errStat,errMsg) + call LD_DestroyConstrState(z ,errStat,errMsg) + call LD_DestroyOtherState (OtherState,errStat,errMsg) + call LD_DestroyOutput (y ,errStat,errMsg) + call LD_DestroyMisc (m ,errStat,errMsg) +end subroutine LD_End +!---------------------------------------------------------------------------------------------------------------------------------- +!> Fourth-order Adams-Bashforth Method (RK4) for numerically integration (see ElastoDyn.f9) +subroutine LD_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(LD_InputType), intent(inout) :: u(:) !< Inputs at t + real(DbKi), intent(in ) :: utimes(:) !< times of input + type(LD_ParameterType), intent(in ) :: p !< Parameters + type(LD_ContinuousStateType), intent(inout) :: x !< Continuous states at t on input at t + dt on output + type(LD_DiscreteStateType), intent(in ) :: xd !< Discrete states at t + type(LD_ConstraintStateType), intent(in ) :: z !< Constraint states at t (possibly a guess) + type(LD_OtherStateType), intent(inout) :: OtherState !< Other states at t on input at t + dt on output + type(LD_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(LD_ContinuousStateType) :: xdot ! Continuous state derivs at t + type(LD_InputType) :: u_interp + ! Initialize errStat + errStat = ErrID_None + errMsg = "" + + ! need xdot at t + call LD_CopyInput(u(1), u_interp, MESH_NEWCOPY, errStat, errMsg ) ! we need to allocate input arrays/meshes before calling ExtrapInterp... + call LD_Input_ExtrapInterp(u, utimes, u_interp, t, errStat, errMsg) + call LD_CalcContStateDeriv( t, u_interp, p, x, xd, z, OtherState, m, xdot, errStat, errMsg ) ! initializes xdot + call LD_DestroyInput( u_interp, errStat, errMsg) ! we don't need this local copy anymore + if (n .le. 2) then + OtherState%n = n + call LD_CopyContState(xdot, OtherState%xdot(3-n), MESH_UPDATECOPY, errStat, errMsg ) + call LD_RK4(t, n, u, utimes, p, x, xd, z, OtherState, m, errStat, errMsg ) + else + if (OtherState%n .lt. n) then + OtherState%n = n + call LD_CopyContState(OtherState%xdot(3), OtherState%xdot(4), MESH_UPDATECOPY, errStat, errMsg ) + call LD_CopyContState(OtherState%xdot(2), OtherState%xdot(3), MESH_UPDATECOPY, errStat, errMsg ) + call LD_CopyContState(OtherState%xdot(1), OtherState%xdot(2), MESH_UPDATECOPY, errStat, errMsg ) + elseif (OtherState%n .gt. n) then + errStat = ErrID_Fatal + errMsg = ' Backing up in time is not supported with a multistep method ' + return + endif + call LD_CopyContState( xdot, OtherState%xdot ( 1 ), MESH_UPDATECOPY, errStat, errMsg ) + !OtherState%xdot ( 1 ) = xdot ! make sure this is most up to date + x%q = x%q + (p%dt / 24._ReKi) * (55._ReKi*OtherState%xdot(1)%q - 59._ReKi*OtherState%xdot(2)%q + 37._ReKi*OtherState%xdot(3)%q - 9._ReKi * OtherState%xdot(4)%q) + endif + call LD_DestroyContState(xdot, errStat, errMsg) + call LD_DestroyInput(u_interp, errStat, errMsg) +end subroutine LD_AB4 +!---------------------------------------------------------------------------------------------------------------------------------- +!> Fourth-order Adams-Bashforth-Moulton Method (RK4) for numerically integrating (see ElastoDyn.f90) +subroutine LD_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(LD_InputType), intent(inout) :: u(:) !< Inputs at t + real(DbKi), intent(in ) :: utimes(:) !< times of input + type(LD_ParameterType), intent(in ) :: p !< Parameters + type(LD_ContinuousStateType), intent(inout) :: x !< Continuous states at t on input at t + dt on output ! TODO TODO TODO in + type(LD_DiscreteStateType), intent(in ) :: xd !< Discrete states at t + type(LD_ConstraintStateType), intent(in ) :: z !< Constraint states at t (possibly a guess) + type(LD_OtherStateType), intent(inout) :: OtherState !< Other states at t on input at t + dt on output + type(LD_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(LD_InputType) :: u_interp ! Continuous states at t + type(LD_ContinuousStateType) :: x_pred ! Continuous states at t + type(LD_ContinuousStateType) :: xdot_pred ! Continuous states at t + ! Initialize errStat + errStat = ErrID_None + errMsg = "" + call LD_CopyContState(x, x_pred, MESH_NEWCOPY, errStat, errMsg) !initialize x_pred + call LD_AB4( t, n, u, utimes, p, x_pred, xd, z, OtherState, m, errStat, errMsg ) + if (n .gt. 2) then + call LD_CopyInput( u(1), u_interp, MESH_NEWCOPY, errStat, errMsg) ! make copy so that arrays/meshes get initialized/allocated for ExtrapInterp + call LD_Input_ExtrapInterp(u, utimes, u_interp, t + p%dt, errStat, errMsg) + call LD_CalcContStateDeriv(t + p%dt, u_interp, p, x_pred, xd, z, OtherState, m, xdot_pred, errStat, errMsg ) ! initializes xdot_pred + call LD_DestroyInput( u_interp, errStat, errMsg) ! local copy no longer needed + + x%q = x%q + (p%dt / 24.) * ( 9. * xdot_pred%q + 19. * OtherState%xdot(1)%q - 5. * OtherState%xdot(2)%q + 1. * OtherState%xdot(3)%q ) + call LD_DestroyContState( xdot_pred, errStat, errMsg) ! local copy no longer needed + else + x%q = x_pred%q + endif + call LD_DestroyContState( x_pred, errStat, errMsg) ! local copy no longer needed +end subroutine LD_ABM4 +!---------------------------------------------------------------------------------------------------------------------------------- +!> Fourth-order Runge-Kutta Method (RK4) for numerically integration (see ElastoDyn.f90) +subroutine LD_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(LD_InputType), intent(inout) :: u(:) !< Inputs at t + real(DbKi), intent(in ) :: utimes(:) !< times of input + type(LD_ParameterType), intent(in ) :: p !< Parameters + type(LD_ContinuousStateType), intent(inout) :: x !< Continuous states at t on input at t + dt on output + type(LD_DiscreteStateType), intent(in ) :: xd !< Discrete states at t + type(LD_ConstraintStateType), intent(in ) :: z !< Constraint states at t (possibly a guess) + type(LD_OtherStateType), intent(inout) :: OtherState !< Other states at t on input at t + dt on output + type(LD_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(LD_ContinuousStateType) :: xdot ! time derivatives of continuous states + type(LD_ContinuousStateType) :: k1 ! RK4 constant; see above + type(LD_ContinuousStateType) :: k2 ! RK4 constant; see above + type(LD_ContinuousStateType) :: k3 ! RK4 constant; see above + type(LD_ContinuousStateType) :: k4 ! RK4 constant; see above + type(LD_ContinuousStateType) :: x_tmp ! Holds temporary modification to x + type(LD_InputType) :: u_interp ! interpolated value of inputs + ! Initialize errStat + errStat = ErrID_None + errMsg = "" + + ! Initialize interim vars + call LD_CopyContState( x, k1, MESH_NEWCOPY, errStat, errMsg ) + call LD_CopyContState( x, k2, MESH_NEWCOPY, errStat, errMsg ) + call LD_CopyContState( x, k3, MESH_NEWCOPY, errStat, errMsg ) + call LD_CopyContState( x, k4, MESH_NEWCOPY, errStat, errMsg ) + call LD_CopyContState( x, x_tmp, MESH_NEWCOPY, errStat, errMsg ) + + ! interpolate u to find u_interp = u(t) + call LD_CopyInput(u(1), u_interp, MESH_NEWCOPY, errStat, errMsg ) ! we need to allocate input arrays/meshes before calling ExtrapInterp... + call LD_Input_ExtrapInterp( u, utimes, u_interp, t, errStat, errMsg ) + + ! find xdot at t + call LD_CalcContStateDeriv( t, u_interp, p, x, xd, z, OtherState, m, xdot, errStat, errMsg ) !initializes xdot + + k1%q = p%dt * xdot%q + x_tmp%q = x%q + 0.5_ReKi * k1%q + + ! interpolate u to find u_interp = u(t + dt/2) + call LD_Input_ExtrapInterp(u, utimes, u_interp, t+0.5_ReKi*p%dt, errStat, errMsg) + + ! find xdot at t + dt/2 + call LD_CalcContStateDeriv( t + 0.5_ReKi*p%dt, u_interp, p, x_tmp, xd, z, OtherState, m, xdot, errStat, errMsg ) + + k2%q = p%dt * xdot%q + x_tmp%q = x%q + 0.5_ReKi * k2%q + + ! find xdot at t + dt/2 + call LD_CalcContStateDeriv( t + 0.5_ReKi*p%dt, u_interp, p, x_tmp, xd, z, OtherState, m, xdot, errStat, errMsg ) + + k3%q = p%dt * xdot%q + x_tmp%q = x%q + k3%q + + ! interpolate u to find u_interp = u(t + dt) + call LD_Input_ExtrapInterp(u, utimes, u_interp, t + p%dt, errStat, errMsg) + + ! find xdot at t + dt + call LD_CalcContStateDeriv( t + p%dt, u_interp, p, x_tmp, xd, z, OtherState, m, xdot, errStat, errMsg ) + k4%q = p%dt * xdot%q + x%q = x%q + ( k1%q + 2._ReKi * k2%q + 2._ReKi * k3%q + k4%q ) / 6._ReKi + call CleanUp() +contains + subroutine CleanUp() + integer(IntKi) :: errStat3 ! The error identifier (errStat) + character(1024) :: errMsg3 ! The error message (errMsg) + call LD_DestroyContState( xdot, errStat3, errMsg3 ) + call LD_DestroyContState( k1, errStat3, errMsg3 ) + call LD_DestroyContState( k2, errStat3, errMsg3 ) + call LD_DestroyContState( k3, errStat3, errMsg3 ) + call LD_DestroyContState( k4, errStat3, errMsg3 ) + call LD_DestroyContState( x_tmp, errStat3, errMsg3 ) + call LD_DestroyInput( u_interp, errStat3, errMsg3 ) + end subroutine CleanUp +end subroutine LD_RK4 +!---------------------------------------------------------------------------------------------------------------------------------- +!> Loose coupling routine for solving states at t+dt +subroutine LD_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*dt + type(LD_InputType), intent(inout) :: Inputs(:) !< Inputs at InputTimes (output from this routine only + real(DbKi), intent(in ) :: InputTimes(:) !< Times in seconds associated with Inputs + type(LD_ParameterType), intent(in ) :: p !< Parameters + type(LD_ContinuousStateType), intent(inout) :: x !< Input: Continuous states at t; Output: at t+dt + type(LD_DiscreteStateType), intent(inout) :: xd !< Input: Discrete states at t; Output: at t+dt + type(LD_ConstraintStateType), intent(inout) :: z !< Input: Constraint states at t; Output: at t+dt + type(LD_OtherStateType), intent(inout) :: OtherState !< Other states: Other states at t;Output: at t+dt + type(LD_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 variables + errStat = ErrID_None ! no error has occurred + errMsg = "" + if (allocated(p%PrescribedValues)) then + call interpTimeValue(p%PrescribedValues, t+p%dt, OtherState%iMotionInterpLast, m%qPrescribed(:)) + x%q(1:p%nq) = m%qPrescribed(1:p%nq) + endif + if ( p%nq == 0) return + if (p%IntMethod .eq. 1) then + call LD_RK4( t, n, Inputs, InputTimes, p, x, xd, z, OtherState, m, errStat, errMsg ) + elseif (p%IntMethod .eq. 2) then + call LD_AB4( t, n, Inputs, InputTimes, p, x, xd, z, OtherState, m, errStat, errMsg ) + elseif (p%IntMethod .eq. 3) then + call LD_ABM4( t, n, Inputs, InputTimes, p, x, xd, z, OtherState, m, errStat, errMsg ) + else + call SeterrStat(ErrID_Fatal,'Invalid time integration method:'//Num2LStr(p%IntMethod),errStat,errMsg,'LD_UpdateState') + end if +end subroutine LD_UpdateStates +!---------------------------------------------------------------------------------------------------------------------------------- +!> This is a routine for computing outputs, used in both loose and tight coupling. +subroutine LD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, errStat, errMsg ) + real(DbKi), intent(in ) :: t !< Current simulation time in seconds + type(LD_InputType), intent(in ) :: u !< Inputs at t + type(LD_ParameterType), intent(in ) :: p !< Parameters + type(LD_ContinuousStateType), intent(in ) :: x !< Continuous states at t + type(LD_DiscreteStateType), intent(in ) :: xd !< Discrete states at t + type(LD_ConstraintStateType), intent(in ) :: z !< Constraint states at t + type(LD_OtherStateType), intent(in ) :: OtherState !< Other states at t + type(LD_MiscVarType), intent(inout) :: m !< Misc variables for optimization (not copied in glue code) + type(LD_OutputType), intent(inout) :: y !< Outputs computed at t (Input only so that mesh con- + integer(IntKi), intent(out) :: errStat !< Error status of the operation + character(*), intent(out) :: errMsg !< Error message if errStat /= ErrID_None + type(LD_ContinuousStateType) :: dxdt !< + integer(IntKi) :: errStat2 ! Status of error message + character(1024) :: errMsg2 ! Error message if ErrStat /= ErrID_None + errStat = ErrID_None ! no error has occurred + errMsg = "" + + ! --- Compute accelerations + if (allocated(p%PrescribedValues)) then + y%xdd(1:p%nx) = m%qPrescribed(p%nq+1:p%nq+p%nx) + else + call LD_CalcContStateDeriv(t, u, p, x, xd, z, OtherState, m, dxdt, errStat2, errMsg2) + y%xdd(1:p%nx) = dxdt%q(p%nx+1:p%nq) + endif + + !--- Computing outputs: y = Cx + Du (optional) + + ! --- Write Outputs + y%WriteOutput(1:2*p%nx) = x%q(1:p%nq) ! Positions and velocities + y%WriteOutput(2*p%nx+1:3*p%nx) = y%xdd(1:p%nx) ! Accelerations + y%WriteOutput(3*p%nx+1:4*p%nx) = u%Fext(1:p%nx) ! Forces + +contains + logical function Failed() + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'LD_CalcOutput' ) + Failed = errStat >= AbortErrLev + end function Failed +end subroutine LD_CalcOutput +!---------------------------------------------------------------------------------------------------------------------------------- +!> Tight coupling routine for computing derivatives of continuous states. +subroutine LD_CalcContStateDeriv( t, u, p, x, xd, z, OtherState, m, dxdt, errStat, errMsg ) + real(DbKi), intent(in ) :: t !< Current simulation time in seconds + type(LD_InputType), intent(in ) :: u !< Inputs at t + type(LD_ParameterType), intent(in ) :: p !< Parameters + type(LD_ContinuousStateType), intent(in ) :: x !< Continuous states at t + type(LD_DiscreteStateType), intent(in ) :: xd !< Discrete states at t + type(LD_ConstraintStateType), intent(in ) :: z !< Constraint states at t + type(LD_OtherStateType), intent(in ) :: OtherState !< Other states at t + type(LD_MiscVarType), intent(inout) :: m !< Misc variables for optimization (not copied in glue code) + type(LD_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 + ! Local variables + integer(IntKi) :: iDOF + integer(IntKi) :: errStat2 ! Status of error message + character(1024) :: errMsg2 ! Error message if ErrStat /= ErrID_None + ! Initialize variables + errStat = ErrID_None ! no error has occurred + errMsg = "" + ! Allocation of output dxdt (since intent(out)) + call AllocAry(dxdt%q, p%nq, 'dxdt%q', errStat2, errMsg2); if(Failed()) return + if ( p%nq == 0 ) return + + ! --- Computation of dq + ! >>> MATMUL IMPLEMENTATION + dxdt%q = matmul(p%AA,x%q) + matmul(p%BB,u%Fext) + ! >>> BLAS IMPLEMENTATION + ! COPY( N , X , inCX, Y , inCY) + !call LAPACK_COPY(p%nCB, x%qmdot , 1 , dxdt%qm , 1 ) ! qmdot=qmdot + !! GEMV(TRS, M , N , alpha , A , LDA , X ,inCX, Beta , Y , IncY) + !call LAPACK_GEMV('n', p%nq, p%nq , 1.0_ReKi, p%AA, p%nq, x%q , 1 , 1.0_ReKi, dxdt%qmdot, 1 ) ! - K22 x2 + !call LAPACK_GEMV('n', p%nq, p%nx , 1.0_ReKi, p%BB, p%nq, u%Fext, 1 , 1.0_ReKi, dxdt%qmdot, 1 ) ! - M21 \ddot{x1} + ! --- Desactivating Constant DOFs + do iDOF = 1,p%nx + if (.not. p%activeDOFs(iDOF)) then + dxdt%q(iDOF ) = 0.0_ReKi + dxdt%q(iDOF+p%nx) = 0.0_ReKi + endif + enddo + +contains + logical function Failed() + call SetErrStat( errStat2, errMsg2, errStat, errMsg, 'LD_CalcContStateDeriv' ) + Failed = errStat >= AbortErrLev + end function Failed +end subroutine LD_CalcContStateDeriv +!---------------------------------------------------------------------------------------------------------------------------------- +!> Setup outputs +subroutine Init_Outputs(p, m, y, InitInp, InitOut, errStat, errMsg) + ! character(ChanLen), intent(in) :: OutList(:) !< list of user-requested outputs + type(LD_ParameterType), intent(inout) :: p !< module parameters + type(LD_MiscVarType), intent(inout) :: m !< module misc + type(LD_OutputType), intent(inout) :: y !< module outputs + type(LD_InitInputType), intent(in ) :: InitInp !< module init inputs + type(LD_InitOutputType),intent(inout) :: InitOut !< module init outputs + integer(intki), intent(out) :: errStat !< error status code + character(*), intent(out) :: errMsg !< error message, if an error occurred + integer :: errStat2 ! temporary (local) error status + character(1024) :: errMsg2 ! Error message if ErrStat /= ErrID_None + integer :: i, iOut + errStat = ErrID_None + errMsg = "" + + ! --- Regular outputs + call AllocAry(y%xdd, p%nx, 'qd', errStat2, errMsg2); if(Failed()) return + y%xdd = 0.0_ReKi + + ! --- Write Outputs + p%NumOuts = (p%nx) * (1 + 1 + 1 + 1) ! Pos, Vel, Acc, Force + + !call AllocAry(m%AllOuts, p%NumOuts, "LinDyn AllOut", errStat,errMsg ); if(Failed()) return; m%AllOuts(:) = 0.0_ReKi + call AllocAry(y%WriteOutput, p%NumOuts,'WriteOutput', errStat,errMsg); if(Failed()) return + call AllocAry(InitOut%WriteOutputHdr,p%NumOuts,'WriteOutputHdr',errStat,errMsg); if(Failed()) return + call AllocAry(InitOut%WriteOutputUnt,p%NumOuts,'WriteOutputUnt',errStat,errMsg); if(Failed()) return + y%WriteOutput(1:p%NumOuts) = 0.0 + + ! Sanity checks + if (.not. allocated(InitInp%DOFsNames)) then + errStat2 = errID_Fatal; errMsg2='DOFs Names not allocated'; if(Failed()) return + else + if(size(InitInp%DOFsNames)/=p%nx) then + errStat2 = errID_Fatal; errMsg2='Shape of DOFs Names incorrect'; if(Failed()) return + endif + if (.not.allocated(InitInp%DOFsUnits)) then + errStat2 = errID_Fatal; errMsg2='DOFs Units should be allocated if Names are provided'; if(Failed()) return + endif + if(size(InitInp%DOFsUnits)/=p%nx) then + errStat2 = errID_Fatal; errMsg2='Shape of DOFs Units incorrect'; if(Failed()) return + endif + endif + + iOut = 0 ! Cumulative counter + call SetWriteOutputsForDOFs('' ) ! Positions + call SetWriteOutputsForDOFs('d' ) ! Velocities + call SetWriteOutputsForDOFs('dd') ! Accelerations + call SetWriteOutputsForDOFs('f' ) ! Forces + + ! If using OutParam instead + !InitOut%WriteOutputHdr(1:p%NumOuts) = p%OutParam(1:p%NumOuts)%Name + !InitOut%WriteOutputUnt(1:p%NumOuts) = p%OutParam(1:p%NumOuts)%Units + ! Debug output to screen + !do i = 1,p%NumOuts + ! print*,i, InitOut%WriteOutputHdr(i), InitOut%WriteOutputUnt(i) + !enddo + +contains + subroutine SetWriteOutputsForDOFs(sPrefix) + character(len=*) :: sPrefix + do i = 1, p%nx + iOut = iOut+1 + InitOut%WriteOutputHdr(iOut) = trim(InitInp%prefix)//trim(sPrefix)//trim(InitInp%DOFsNames(i)) + ! Units + if (sPrefix == '') InitOut%WriteOutputUnt(iOut) ='('//trim(InitInp%DOFsUnits(i))//')' + if (sPrefix == 'd') InitOut%WriteOutputUnt(iOut) ='('//trim(InitInp%DOFsUnits(i))//'/s)' + if (sPrefix == 'dd') InitOut%WriteOutputUnt(iOut) ='('//trim(InitInp%DOFsUnits(i))//'/s^2)' + if (sPrefix == 'f') then + if (InitInp%DOFsUnits(i)=='m') then; InitOut%WriteOutputUnt(iOut) ='(N)' ; + elseif (InitInp%DOFsUnits(i)=='rad') then; InitOut%WriteOutputUnt(iOut) ='(Nm)' ; + else; InitOut%WriteOutputUnt(iOut) ='(-)' + endif + endif + enddo + endsubroutine + + logical function Failed() + call SetErrStat( errStat2, errMsg2, errStat, errMsg, 'Init_Outputs' ) + Failed = errStat >= AbortErrLev + end function Failed +end subroutine Init_Outputs +!---------------------------------------------------------------------------------------------------------------------------------- +!> Setup Linearization data +subroutine Init_Lin(p, InitOut, errStat, errMsg) + type(LD_ParameterType), intent(in ) :: p !< module parameters + type(LD_InitOutputType),intent(inout) :: InitOut !< module init outputs + integer(intki), intent(out) :: errStat !< error status code + character(*), intent(out) :: errMsg !< error message, if an error occurred + integer :: errStat2 ! temporary (local) error status + character(1024) :: errMsg2 ! Error message if ErrStat /= ErrID_None + integer :: i, nu + errStat = ErrID_None + errMsg = "" + nu = p%nx + +! LinNames_y {:} - - "Names of the outputs used in linearization" - +! LinNames_x {:} - - "Names of the continuous states used in linearization" - +! LinNames_u {:} - - "Names of the inputs used in linearization" - +! RotFrame_y {:} - - "Flag that tells FAST/MBC3 if the outputs used in linearization are in the rotating frame" - +! RotFrame_x {:} - - "Flag that tells FAST/MBC3 if the continuous states used in linearization are in the rotating frame" - +! RotFrame_u {:} - - "Flag that tells FAST/MBC3 if the inputs used in linearization are in the rotating frame" - +! IsLoad_u {:} - - "Flag that tells FAST if the inputs used in linearization are loads (for preconditioning matrix)" - +! DerivOrder_x {:} - - "Integer that tells FAST/MBC3 the maximum derivative order of continuous states used in linearization" - + !Appropriate Jacobian row/column names and rotating-frame flags here: + call AllocAry(InitOut%LinNames_y , p%NumOuts , 'LinNames_y', errStat, errMsg); if(Failed()) return + call AllocAry(InitOut%RotFrame_y , p%NumOuts , 'RotFrame_y', errStat, errMsg); if(Failed()) return + call AllocAry(InitOut%LinNames_x , p%nq , 'LinNames_x', errStat, errMsg); if(Failed()) return + call AllocAry(InitOut%RotFrame_x , p%nq , 'RotFrame_x', errStat, errMsg); if(Failed()) return + call AllocAry(InitOut%DerivOrder_x, p%nq , 'DerivOrd_x', errStat, errMsg); if(Failed()) return + call AllocAry(InitOut%LinNames_u , nu , 'LinNames_u', errStat, errMsg); if(Failed()) return + call AllocAry(InitOut%RotFrame_u , nu , 'RotFrame_u', errStat, errMsg); if(Failed()) return + call AllocAry(InitOut%IsLoad_u , nu , 'IsLoad_u' , errStat, errMsg); if(Failed()) return + InitOut%DerivOrder_x(:)=2 + ! LinNames_y + do i=1, p%NumOuts + InitOut%LinNames_y(i) = trim(InitOut%WriteOutputHdr(i))//', '//trim(InitOut%WriteOutputUnt(i)) + print*,'y',i, trim(InitOut%LinNames_y(i)) + enddo + ! LinNames_u + do i=1, p%nx + InitOut%LinNames_u(i) = trim(InitOut%WriteOutputHdr(3*p%nx+ i))//', '//trim(InitOut%WriteOutputUnt(3*p%nx+i)) + print*,'u',i, trim(InitOut%LinNames_u(i)) + enddo + ! LinNames_x + do I=1,p%nq; + InitOut%LinNames_x(I) = trim(InitOut%WriteOutputHdr(i))//', '//trim(InitOut%WriteOutputUnt(i)) + print*,'x',i, trim(InitOut%LinNames_x(i)) + enddo + InitOut%RotFrame_x = .false. + InitOut%RotFrame_y = .false. + InitOut%RotFrame_u = .false. + InitOut%IsLoad_u = .true. + ! +contains + logical function Failed() + if (errStat >= AbortErrLev) errMsg = 'LD_JacobianLin:'//trim(errMsg) + Failed = errStat >= AbortErrLev + end function Failed +end subroutine Init_Lin + +!---------------------------------------------------------------------------------------------------------------------------------- +!> Jacobians with respect to inputs (u) +subroutine LD_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(LD_InputType), intent(in ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) + type(LD_ParameterType), intent(in ) :: p !< Parameters + type(LD_ContinuousStateType), intent(in ) :: x !< Continuous states at operating point + type(LD_DiscreteStateType), intent(in ) :: xd !< Discrete states at operating point + type(LD_ConstraintStateType), intent(in ) :: z !< Constraint states at operating point + type(LD_OtherStateType), intent(in ) :: OtherState !< Other states at operating point + type(LD_OutputType), intent(in ) :: y !< Output (change to inout if a mesh copy is required); + type(LD_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(:,:) !< Jacobians of output functions (Y) with respect to (u) + real(R8Ki), allocatable, optional, intent(inout) :: dXdu(:,:) !< Jacobians of continuous state functions (X) with respect to (u) + real(R8Ki), allocatable, optional, intent(inout) :: dXddu(:,:) !< Jacobians of discrete state functions (Xd) with respect to (u) + real(R8Ki), allocatable, optional, intent(inout) :: dZdu(:,:) !< Jacobians of constraint state functions (Z) with respect to (u) + integer(IntKi) :: i, nu ! Loop index + ! Initialize errStat + errStat = ErrID_None + errMsg = '' + nu = p%nx + if (present(dYdu)) then + if (.not. allocated(dYdu)) then + call AllocAry(dYdu, p%NumOuts, nu, 'dYdu', errStat, errMsg); if(Failed()) return + dYdu(:,:) = 0.0_ReKi + end if + !dYdu(1 : p%nx, :) = 0.0_ReKi ! Positions + dYdu( p%nx+1 : 3*p%nx, :) = p%BB ! Velocities and accelerations + do i=1, p%nx ; dYdu(3*p%nx+i, i) = 1.0_ReKi; enddo ! Forces (which are inputs) + end if + if (present(dXdu)) then + if (.not. allocated(dXdu)) then + call AllocAry(dXdu, p%nq, nu, 'dXdu', errStat, errMsg); if(Failed()) return + dXdu(:,:) = 0.0_ReKi + end if + dXdu = p%BB + end if + if (present(dXddu)) then + end if + if (present(dZdu)) then + end if +contains + logical function Failed() + if (errStat >= AbortErrLev) errMsg = 'LD_JacobianPInput:'//trim(errMsg) + Failed = errStat >= AbortErrLev + end function Failed +end subroutine LD_JacobianPInput +!---------------------------------------------------------------------------------------------------------------------------------- +!> Jacobians with respect to continuous states (x) +subroutine LD_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(LD_InputType), intent(in ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) + type(LD_ParameterType), intent(in ) :: p !< Parameters + type(LD_ContinuousStateType), intent(in ) :: x !< Continuous states at operating point + type(LD_DiscreteStateType), intent(in ) :: xd !< Discrete states at operating point + type(LD_ConstraintStateType), intent(in ) :: z !< Constraint states at operating point + type(LD_OtherStateType), intent(in ) :: OtherState !< Other states at operating point + type(LD_OutputType), intent(in ) :: y !< Output (change to inout if a mesh copy is required); + type(LD_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(:,:) !< Jacobians of output functions (Y) with respect to (x) + real(R8Ki), allocatable, optional, intent(inout) :: dXdx(:,:) !< Jacobians of continuous state functions (X) with respect to (x) + real(R8Ki), allocatable, optional, intent(inout) :: dXddx(:,:) !< Jacobians of discrete state functions (Xd) with respect to (x) + real(R8Ki), allocatable, optional, intent(inout) :: dZdx(:,:) !< Jacobians of constraint state functions (Z) with respect to (x) + integer(IntKi) :: i ! Loop index + ! Initialize errStat + errStat = ErrID_None + errMsg = '' + if (present(dYdx)) then + ! allocate and set dYdx + if (.not. allocated(dYdx)) then + call AllocAry(dYdx, p%NumOuts, p%nq, 'dYdx', errStat, errMsg); if(Failed()) return + dYdx(:,:) = 0.0_ReKi + end if + do i=1,p%nx; dYdx(i,i) = 1.0_ReKi; enddo ! Position + dYdx(p%nx+1:3*p%nx,: ) = p%AA ! Velocity and acceleration + !dYdx(3*p%nx+1:,:) = 0 ! Forces + end if + if (present(dXdx)) then + ! allocate and set dXdx + if (.not. allocated(dXdx)) then + call AllocAry(dXdx, p%nq, p%nq, 'dXdx', errStat, errMsg); if(Failed()) return + dXdx(:,:) = 0.0_ReKi + end if + dXdx = p%AA + end if + if (present(dXddx)) then + end if + if (present(dZdx)) then + end if +contains + logical function Failed() + if (errStat >= AbortErrLev) errMsg = 'LD_JacobianPContState:'//trim(errMsg) + Failed = errStat >= AbortErrLev + end function Failed +end subroutine LD_JacobianPContState +!---------------------------------------------------------------------------------------------------------------------------------- +!> Routine to pack the data structures representing the operating points into arrays for linearization. +subroutine LD_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(LD_InputType), intent(in ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) + type(LD_ParameterType), intent(in ) :: p !< Parameters + type(LD_ContinuousStateType), intent(in ) :: x !< Continuous states at operating point + type(LD_DiscreteStateType), intent(in ) :: xd !< Discrete states at operating point + type(LD_ConstraintStateType), intent(in ) :: z !< Constraint states at operating point + type(LD_OtherStateType), intent(in ) :: OtherState !< Other states at operating point + type(LD_OutputType), intent(in ) :: y !< Output at operating point + type(LD_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, nu + type(LD_ContinuousStateType) :: dx !< derivative of continuous states at operating point + ! Initialize errStat + errStat = ErrID_None + errMsg = '' + nu = p%nx + + if ( present( u_op ) ) then + if (.not. allocated(u_op)) then + call AllocAry(u_op, nu, 'u_op', errStat, errMsg); if(Failed())return + endif + u_op(:) = u%Fext + end if + + if ( present( y_op ) ) then + if (.not. allocated(y_op)) then + call AllocAry(y_op, p%NumOuts, 'y_op', errStat, errMsg); if(Failed())return + endif + ! Update the output mesh + do i=1,p%NumOuts + y_op(i) = y%WriteOutput(i) + end do + end if + + if ( present( x_op ) ) then + if (.not. allocated(x_op)) then + call AllocAry(x_op, p%nq, 'x_op', errStat, errMsg); if (Failed())return + endif + x_op = x%q + end if + + if ( present( dx_op ) ) then + if (.not. allocated(dx_op)) then + call AllocAry(dx_op, p%nq, 'dx_op', errStat, errMsg); if (Failed())return + endif + call LD_CalcContStateDeriv(t, u, p, x, xd, z, OtherState, m, dx, errStat, errMsg); if(Failed()) return + dx_op = dx%q + end if + + if ( present( xd_op ) ) then + end if + + if ( present( z_op ) ) then + end if + +contains + logical function Failed() + if (errStat >= AbortErrLev) errMsg = 'LD_GetOP:'//trim(errMsg) + Failed = errStat >= AbortErrLev + end function Failed +end subroutine LD_GetOP + +end module LinDyn +!********************************************************************************************************************************** diff --git a/modules/lindyn/src/LinDyn_Registry.txt b/modules/lindyn/src/LinDyn_Registry.txt new file mode 100644 index 0000000000..6140a54fab --- /dev/null +++ b/modules/lindyn/src/LinDyn_Registry.txt @@ -0,0 +1,82 @@ +################################################################################################################################### +# Registry for Linear Dynamics Module +################################################################################################################################### +include Registry_NWTC_Library.txt + +#param ElasticSection/ES - INTEGER ES_Baseline - 1 - "UAMod = 1 [Baseline model (Original)]" - + +# ..... Initialization data ....................................................................................................... +# Initialization inputs +typedef LinDyn/LD InitInputType DbKi dt - - - "time step" s +typedef ^ ^ IntKi IntMethod - - - "Identifier for integration method (1 [RK4], 2 [AB4], or 3 [ABM4])" - +typedef ^ ^ ReKi MM {:}{:} - - "Mass matrix" - +typedef ^ ^ ReKi CC {:}{:} - - "Damping matrix" - +typedef ^ ^ ReKi KK {:}{:} - - "Stiffness matrix" - +typedef ^ ^ ReKi x0 {:} 0 - "Degrees of freedom initial conditions - shape nx" - +typedef ^ ^ ReKi xd0 {:} 0 - "Velocities initial conditions - shape nx" - +typedef ^ ^ logical activeDOFs {:} .true. - "Degrees of freedom that are active - shape nx" - +typedef ^ ^ character(8) prefix - "" - "Prefix for degrees of freedom write outputs" - +typedef ^ ^ character(8) DOFsNames {:} "" - "Names of degrees of freedom for write outputs" - +typedef ^ ^ character(8) DOFsUnits {:} "" - "Units of degrees of freedom for write outputs" - +typedef ^ ^ logical Linearize - .false. - "Flag that tells this module if the glue code wants to linearize." - +typedef ^ ^ character(2048) PrescribedMotionFile - "" - "Input file for prescribed motion" - + +# Initialization outputs +typedef LinDyn/LD InitOutputType ProgDesc Ver - - - "This module's name, version, and date" - +typedef ^ InitOutputType character(ChanLen) WriteOutputHdr {:} - - "The is the list of all output channel header strings (includes all sub-module channels)" - +typedef ^ ^ character(ChanLen) WriteOutputUnt {:} - - "The is the list of all output channel unit strings (includes all sub-module channels)" - +typedef ^ ^ character(LinChanLen) LinNames_y {:} - - "Names of the outputs used in linearization" - +typedef ^ ^ character(LinChanLen) LinNames_x {:} - - "Names of the continuous states used in linearization" - +typedef ^ ^ character(LinChanLen) LinNames_u {:} - - "Names of the inputs used in linearization" - +typedef ^ ^ logical RotFrame_y {:} - - "Flag that tells FAST/MBC3 if the outputs used in linearization are in the rotating frame" - +typedef ^ ^ logical RotFrame_x {:} - - "Flag that tells FAST/MBC3 if the continuous states used in linearization are in the rotating frame" - +typedef ^ ^ logical RotFrame_u {:} - - "Flag that tells FAST/MBC3 if the inputs used in linearization are in the rotating frame" - +typedef ^ ^ logical IsLoad_u {:} - - "Flag that tells FAST if the inputs used in linearization are loads (for preconditioning matrix)" - +typedef ^ ^ IntKi DerivOrder_x {:} - - "Integer that tells FAST/MBC3 the maximum derivative order of continuous states used in linearization" - + +# ..... States .................................................................................................................... +# Continuous states +typedef ^ ContinuousStateType ReKi q {:} - - "Continuous states q =(x,xdot)" "-" + +# Discrete (non-differentiable) states: +typedef ^ DiscreteStateType SiKi Dummy - - - "" - + +# Constraint states: +typedef ^ ConstraintStateType SiKi Dummy - - - "" - + +# Other states: +typedef ^ OtherStateType LD_ContinuousStateType xdot {:} - - "Previous state derivs for m-step time integrator" +typedef ^ ^ IntKi n - - - "Tracks time step for which OtherState was updated last" +typedef ^ ^ IntKi iMotionInterpLast - 1 - "Last index used to interpolate the presribed motion time series" - + +# ..... Misc/Optimization variables................................................................................................. +typedef ^ MiscVarType Logical Dummy - - - "" - +typedef ^ ^ ReKi qPrescribed {:} - - "Prescribed motion/velocity/accelerations for all degrees of freedom at a given time" - + + +# ..... Parameters ................................................................................................................ +typedef ^ ParameterType DbKi dt - - - "time step" s +typedef ^ ^ IntKi IntMethod - - - "Identifier for integration method (1 [RK4], 2 [AB4], or 3 [ABM4])" - +typedef ^ ^ IntKi nx - - - "Number of degrees of freedom (size of M)" - +typedef ^ ^ IntKi nq - - - "nq=2*nx" - +typedef ^ ^ ReKi MM {:}{:} - - "Mass Matrix - shape (nx x nx)" - +typedef ^ ^ ReKi CC {:}{:} - - "Damping Matrix - shape (nx x nx)" - +typedef ^ ^ ReKi KK {:}{:} - - "Stiffness Matrix - shape (nx x nx)" - +typedef ^ ^ ReKi Minv {:}{:} - - "Inverse of Mass matrix" - +typedef ^ ^ Logical activeDOFs {:} - - "Degrees of freedom that are active" - +typedef ^ ^ ReKi AA {:}{:} - - "State matrix A - shape (nq x nq) " - +typedef ^ ^ ReKi BB {:}{:} - - "State matrix B - shape (nq x nx) " - +typedef ^ ^ IntKi NumOuts - - - "Number of values in WriteOutput" - +typedef ^ ^ OutParmType OutParam {:} - - "Names and units (and other characteristics) of all requested output parameters" - +typedef ^ ^ IntKi OutParamLinIndx {:}{:} - - "Index into WriteOutput for linearization analysis" - +typedef ^ ^ ReKi PrescribedValues {:}{:} - - "Prescribed motion for all degrees of freedom" - + + + +# ..... Inputs .................................................................................................................... +typedef ^ InputType ReKi Fext : - - "External loads - shape nx" + +# ..... Outputs ................................................................................................................... +typedef ^ OutputType ReKi xdd {:} - "Time derivative of continuous states" - +typedef ^ ^ ReKi WriteOutput {:} - - "outputs to be written to a file" - + diff --git a/modules/lindyn/src/LinDyn_Types.f90 b/modules/lindyn/src/LinDyn_Types.f90 new file mode 100644 index 0000000000..b5d08e8d49 --- /dev/null +++ b/modules/lindyn/src/LinDyn_Types.f90 @@ -0,0 +1,1559 @@ +!STARTOFREGISTRYGENERATEDFILE 'LinDyn_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 +!********************************************************************************************************************************* +! LinDyn_Types +!................................................................................................................................. +! This file is part of LinDyn. +! +! 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 LinDyn. 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 LinDyn_Types +!--------------------------------------------------------------------------------------------------------------------------------- +USE NWTC_Library +IMPLICIT NONE +! ========= LD_InitInputType ======= + TYPE, PUBLIC :: LD_InitInputType + REAL(DbKi) :: dt = 0.0_R8Ki !< time step [s] + INTEGER(IntKi) :: IntMethod = 0_IntKi !< Identifier for integration method (1 [RK4], 2 [AB4], or 3 [ABM4]) [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: MM !< Mass matrix [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: CC !< Damping matrix [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: KK !< Stiffness matrix [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: x0 !< Degrees of freedom initial conditions - shape nx [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: xd0 !< Velocities initial conditions - shape nx [-] + LOGICAL , DIMENSION(:), ALLOCATABLE :: activeDOFs !< Degrees of freedom that are active - shape nx [-] + character(8) :: prefix !< Prefix for degrees of freedom write outputs [-] + character(8) , DIMENSION(:), ALLOCATABLE :: DOFsNames !< Names of degrees of freedom for write outputs [-] + character(8) , DIMENSION(:), ALLOCATABLE :: DOFsUnits !< Units of degrees of freedom for write outputs [-] + LOGICAL :: Linearize = .false. !< Flag that tells this module if the glue code wants to linearize. [-] + character(2048) :: PrescribedMotionFile !< Input file for prescribed motion [-] + END TYPE LD_InitInputType +! ======================= +! ========= LD_InitOutputType ======= + TYPE, PUBLIC :: LD_InitOutputType + TYPE(ProgDesc) :: Ver !< This module's name, version, and date [-] + character(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputHdr !< The is the list of all output channel header strings (includes all sub-module channels) [-] + character(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputUnt !< The is the list of all output channel unit strings (includes all sub-module channels) [-] + 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 [-] + 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 LD_InitOutputType +! ======================= +! ========= LD_ContinuousStateType ======= + TYPE, PUBLIC :: LD_ContinuousStateType + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: q !< Continuous states q =(x,xdot) [-] + END TYPE LD_ContinuousStateType +! ======================= +! ========= LD_DiscreteStateType ======= + TYPE, PUBLIC :: LD_DiscreteStateType + REAL(SiKi) :: Dummy = 0.0_R4Ki !< [-] + END TYPE LD_DiscreteStateType +! ======================= +! ========= LD_ConstraintStateType ======= + TYPE, PUBLIC :: LD_ConstraintStateType + REAL(SiKi) :: Dummy = 0.0_R4Ki !< [-] + END TYPE LD_ConstraintStateType +! ======================= +! ========= LD_OtherStateType ======= + TYPE, PUBLIC :: LD_OtherStateType + TYPE(LD_ContinuousStateType) , DIMENSION(:), ALLOCATABLE :: xdot !< Previous state derivs for m-step time integrator [-] + INTEGER(IntKi) :: n = 0_IntKi !< Tracks time step for which OtherState was updated last [-] + INTEGER(IntKi) :: iMotionInterpLast = 1 !< Last index used to interpolate the presribed motion time series [-] + END TYPE LD_OtherStateType +! ======================= +! ========= LD_MiscVarType ======= + TYPE, PUBLIC :: LD_MiscVarType + LOGICAL :: Dummy = .false. !< [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: qPrescribed !< Prescribed motion/velocity/accelerations for all degrees of freedom at a given time [-] + END TYPE LD_MiscVarType +! ======================= +! ========= LD_ParameterType ======= + TYPE, PUBLIC :: LD_ParameterType + REAL(DbKi) :: dt = 0.0_R8Ki !< time step [s] + INTEGER(IntKi) :: IntMethod = 0_IntKi !< Identifier for integration method (1 [RK4], 2 [AB4], or 3 [ABM4]) [-] + INTEGER(IntKi) :: nx = 0_IntKi !< Number of degrees of freedom (size of M) [-] + INTEGER(IntKi) :: nq = 0_IntKi !< nq=2*nx [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: MM !< Mass Matrix - shape (nx x nx) [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: CC !< Damping Matrix - shape (nx x nx) [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: KK !< Stiffness Matrix - shape (nx x nx) [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Minv !< Inverse of Mass matrix [-] + LOGICAL , DIMENSION(:), ALLOCATABLE :: activeDOFs !< Degrees of freedom that are active [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: AA !< State matrix A - shape (nq x nq) [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BB !< State matrix B - shape (nq x nx) [-] + INTEGER(IntKi) :: NumOuts = 0_IntKi !< Number of values in WriteOutput [-] + TYPE(OutParmType) , DIMENSION(:), ALLOCATABLE :: OutParam !< Names and units (and other characteristics) of all requested output parameters [-] + INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: OutParamLinIndx !< Index into WriteOutput for linearization analysis [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PrescribedValues !< Prescribed motion for all degrees of freedom [-] + END TYPE LD_ParameterType +! ======================= +! ========= LD_InputType ======= + TYPE, PUBLIC :: LD_InputType + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Fext !< External loads - shape nx [-] + END TYPE LD_InputType +! ======================= +! ========= LD_OutputType ======= + TYPE, PUBLIC :: LD_OutputType + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: xdd + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: WriteOutput !< outputs to be written to a file [-] + END TYPE LD_OutputType +! ======================= +CONTAINS + +subroutine LD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) + type(LD_InitInputType), intent(in) :: SrcInitInputData + type(LD_InitInputType), intent(inout) :: DstInitInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'LD_CopyInitInput' + ErrStat = ErrID_None + ErrMsg = '' + DstInitInputData%dt = SrcInitInputData%dt + DstInitInputData%IntMethod = SrcInitInputData%IntMethod + if (allocated(SrcInitInputData%MM)) then + LB(1:2) = lbound(SrcInitInputData%MM) + UB(1:2) = ubound(SrcInitInputData%MM) + if (.not. allocated(DstInitInputData%MM)) then + allocate(DstInitInputData%MM(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%MM.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%MM = SrcInitInputData%MM + end if + if (allocated(SrcInitInputData%CC)) then + LB(1:2) = lbound(SrcInitInputData%CC) + UB(1:2) = ubound(SrcInitInputData%CC) + if (.not. allocated(DstInitInputData%CC)) then + allocate(DstInitInputData%CC(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%CC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%CC = SrcInitInputData%CC + end if + if (allocated(SrcInitInputData%KK)) then + LB(1:2) = lbound(SrcInitInputData%KK) + UB(1:2) = ubound(SrcInitInputData%KK) + if (.not. allocated(DstInitInputData%KK)) then + allocate(DstInitInputData%KK(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%KK.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%KK = SrcInitInputData%KK + end if + if (allocated(SrcInitInputData%x0)) then + LB(1:1) = lbound(SrcInitInputData%x0) + UB(1:1) = ubound(SrcInitInputData%x0) + if (.not. allocated(DstInitInputData%x0)) then + allocate(DstInitInputData%x0(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%x0.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%x0 = SrcInitInputData%x0 + end if + if (allocated(SrcInitInputData%xd0)) then + LB(1:1) = lbound(SrcInitInputData%xd0) + UB(1:1) = ubound(SrcInitInputData%xd0) + if (.not. allocated(DstInitInputData%xd0)) then + allocate(DstInitInputData%xd0(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%xd0.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%xd0 = SrcInitInputData%xd0 + end if + if (allocated(SrcInitInputData%activeDOFs)) then + LB(1:1) = lbound(SrcInitInputData%activeDOFs) + UB(1:1) = ubound(SrcInitInputData%activeDOFs) + if (.not. allocated(DstInitInputData%activeDOFs)) then + allocate(DstInitInputData%activeDOFs(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%activeDOFs.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%activeDOFs = SrcInitInputData%activeDOFs + end if + DstInitInputData%prefix = SrcInitInputData%prefix + if (allocated(SrcInitInputData%DOFsNames)) then + LB(1:1) = lbound(SrcInitInputData%DOFsNames) + UB(1:1) = ubound(SrcInitInputData%DOFsNames) + if (.not. allocated(DstInitInputData%DOFsNames)) then + allocate(DstInitInputData%DOFsNames(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%DOFsNames.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%DOFsNames = SrcInitInputData%DOFsNames + end if + if (allocated(SrcInitInputData%DOFsUnits)) then + LB(1:1) = lbound(SrcInitInputData%DOFsUnits) + UB(1:1) = ubound(SrcInitInputData%DOFsUnits) + if (.not. allocated(DstInitInputData%DOFsUnits)) then + allocate(DstInitInputData%DOFsUnits(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%DOFsUnits.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%DOFsUnits = SrcInitInputData%DOFsUnits + end if + DstInitInputData%Linearize = SrcInitInputData%Linearize + DstInitInputData%PrescribedMotionFile = SrcInitInputData%PrescribedMotionFile +end subroutine + +subroutine LD_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(LD_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'LD_DestroyInitInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InitInputData%MM)) then + deallocate(InitInputData%MM) + end if + if (allocated(InitInputData%CC)) then + deallocate(InitInputData%CC) + end if + if (allocated(InitInputData%KK)) then + deallocate(InitInputData%KK) + end if + if (allocated(InitInputData%x0)) then + deallocate(InitInputData%x0) + end if + if (allocated(InitInputData%xd0)) then + deallocate(InitInputData%xd0) + end if + if (allocated(InitInputData%activeDOFs)) then + deallocate(InitInputData%activeDOFs) + end if + if (allocated(InitInputData%DOFsNames)) then + deallocate(InitInputData%DOFsNames) + end if + if (allocated(InitInputData%DOFsUnits)) then + deallocate(InitInputData%DOFsUnits) + end if +end subroutine + +subroutine LD_PackInitInput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(LD_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'LD_PackInitInput' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%dt) + call RegPack(RF, InData%IntMethod) + call RegPackAlloc(RF, InData%MM) + call RegPackAlloc(RF, InData%CC) + call RegPackAlloc(RF, InData%KK) + call RegPackAlloc(RF, InData%x0) + call RegPackAlloc(RF, InData%xd0) + call RegPackAlloc(RF, InData%activeDOFs) + call RegPack(RF, InData%prefix) + call RegPackAlloc(RF, InData%DOFsNames) + call RegPackAlloc(RF, InData%DOFsUnits) + call RegPack(RF, InData%Linearize) + call RegPack(RF, InData%PrescribedMotionFile) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine LD_UnPackInitInput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(LD_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'LD_UnPackInitInput' + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%dt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%IntMethod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%MM); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%CC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%KK); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%x0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%xd0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%activeDOFs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%prefix); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%DOFsNames); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%DOFsUnits); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Linearize); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PrescribedMotionFile); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine LD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) + type(LD_InitOutputType), intent(in) :: SrcInitOutputData + type(LD_InitOutputType), intent(inout) :: DstInitOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'LD_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 + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) + if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then + allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitOutputData%WriteOutputUnt)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) + if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then + allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitOutputData%LinNames_y)) then + LB(1:1) = lbound(SrcInitOutputData%LinNames_y) + UB(1:1) = ubound(SrcInitOutputData%LinNames_y) + if (.not. allocated(DstInitOutputData%LinNames_y)) then + allocate(DstInitOutputData%LinNames_y(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitOutputData%LinNames_x)) then + LB(1:1) = lbound(SrcInitOutputData%LinNames_x) + UB(1:1) = ubound(SrcInitOutputData%LinNames_x) + if (.not. allocated(DstInitOutputData%LinNames_x)) then + allocate(DstInitOutputData%LinNames_x(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitOutputData%LinNames_u)) then + LB(1:1) = lbound(SrcInitOutputData%LinNames_u) + UB(1:1) = ubound(SrcInitOutputData%LinNames_u) + if (.not. allocated(DstInitOutputData%LinNames_u)) then + allocate(DstInitOutputData%LinNames_u(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitOutputData%RotFrame_y)) then + LB(1:1) = lbound(SrcInitOutputData%RotFrame_y) + UB(1:1) = ubound(SrcInitOutputData%RotFrame_y) + if (.not. allocated(DstInitOutputData%RotFrame_y)) then + allocate(DstInitOutputData%RotFrame_y(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitOutputData%RotFrame_x)) then + LB(1:1) = lbound(SrcInitOutputData%RotFrame_x) + UB(1:1) = ubound(SrcInitOutputData%RotFrame_x) + if (.not. allocated(DstInitOutputData%RotFrame_x)) then + allocate(DstInitOutputData%RotFrame_x(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitOutputData%RotFrame_u)) then + LB(1:1) = lbound(SrcInitOutputData%RotFrame_u) + UB(1:1) = ubound(SrcInitOutputData%RotFrame_u) + if (.not. allocated(DstInitOutputData%RotFrame_u)) then + allocate(DstInitOutputData%RotFrame_u(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitOutputData%IsLoad_u)) then + LB(1:1) = lbound(SrcInitOutputData%IsLoad_u) + UB(1:1) = ubound(SrcInitOutputData%IsLoad_u) + if (.not. allocated(DstInitOutputData%IsLoad_u)) then + allocate(DstInitOutputData%IsLoad_u(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitOutputData%DerivOrder_x)) then + LB(1:1) = lbound(SrcInitOutputData%DerivOrder_x) + UB(1:1) = ubound(SrcInitOutputData%DerivOrder_x) + if (.not. allocated(DstInitOutputData%DerivOrder_x)) then + allocate(DstInitOutputData%DerivOrder_x(LB(1):UB(1)), 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 + end if +end subroutine + +subroutine LD_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(LD_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'LD_DestroyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(InitOutputData%WriteOutputHdr)) then + deallocate(InitOutputData%WriteOutputHdr) + end if + if (allocated(InitOutputData%WriteOutputUnt)) then + deallocate(InitOutputData%WriteOutputUnt) + end if + if (allocated(InitOutputData%LinNames_y)) then + deallocate(InitOutputData%LinNames_y) + end if + if (allocated(InitOutputData%LinNames_x)) then + deallocate(InitOutputData%LinNames_x) + end if + if (allocated(InitOutputData%LinNames_u)) then + deallocate(InitOutputData%LinNames_u) + end if + if (allocated(InitOutputData%RotFrame_y)) then + deallocate(InitOutputData%RotFrame_y) + end if + if (allocated(InitOutputData%RotFrame_x)) then + deallocate(InitOutputData%RotFrame_x) + end if + if (allocated(InitOutputData%RotFrame_u)) then + deallocate(InitOutputData%RotFrame_u) + end if + if (allocated(InitOutputData%IsLoad_u)) then + deallocate(InitOutputData%IsLoad_u) + end if + if (allocated(InitOutputData%DerivOrder_x)) then + deallocate(InitOutputData%DerivOrder_x) + end if +end subroutine + +subroutine LD_PackInitOutput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(LD_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'LD_PackInitOutput' + if (RF%ErrStat >= AbortErrLev) return + call NWTC_Library_PackProgDesc(RF, InData%Ver) + call RegPackAlloc(RF, InData%WriteOutputHdr) + call RegPackAlloc(RF, InData%WriteOutputUnt) + call RegPackAlloc(RF, InData%LinNames_y) + call RegPackAlloc(RF, InData%LinNames_x) + call RegPackAlloc(RF, InData%LinNames_u) + call RegPackAlloc(RF, InData%RotFrame_y) + call RegPackAlloc(RF, InData%RotFrame_x) + call RegPackAlloc(RF, InData%RotFrame_u) + call RegPackAlloc(RF, InData%IsLoad_u) + call RegPackAlloc(RF, InData%DerivOrder_x) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine LD_UnPackInitOutput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(LD_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'LD_UnPackInitOutput' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call NWTC_Library_UnpackProgDesc(RF, OutData%Ver) ! Ver + call RegUnpackAlloc(RF, OutData%WriteOutputHdr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WriteOutputUnt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LinNames_y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LinNames_x); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LinNames_u); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%RotFrame_y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%RotFrame_x); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%RotFrame_u); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%IsLoad_u); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%DerivOrder_x); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine LD_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) + type(LD_ContinuousStateType), intent(in) :: SrcContStateData + type(LD_ContinuousStateType), intent(inout) :: DstContStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'LD_CopyContState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcContStateData%q)) then + LB(1:1) = lbound(SrcContStateData%q) + UB(1:1) = ubound(SrcContStateData%q) + if (.not. allocated(DstContStateData%q)) then + allocate(DstContStateData%q(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%q.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstContStateData%q = SrcContStateData%q + end if +end subroutine + +subroutine LD_DestroyContState(ContStateData, ErrStat, ErrMsg) + type(LD_ContinuousStateType), intent(inout) :: ContStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'LD_DestroyContState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ContStateData%q)) then + deallocate(ContStateData%q) + end if +end subroutine + +subroutine LD_PackContState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(LD_ContinuousStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'LD_PackContState' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%q) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine LD_UnPackContState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(LD_ContinuousStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'LD_UnPackContState' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%q); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine LD_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) + type(LD_DiscreteStateType), intent(in) :: SrcDiscStateData + type(LD_DiscreteStateType), intent(inout) :: DstDiscStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'LD_CopyDiscState' + ErrStat = ErrID_None + ErrMsg = '' + DstDiscStateData%Dummy = SrcDiscStateData%Dummy +end subroutine + +subroutine LD_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) + type(LD_DiscreteStateType), intent(inout) :: DiscStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'LD_DestroyDiscState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine LD_PackDiscState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(LD_DiscreteStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'LD_PackDiscState' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%Dummy) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine LD_UnPackDiscState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(LD_DiscreteStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'LD_UnPackDiscState' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%Dummy); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine LD_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) + type(LD_ConstraintStateType), intent(in) :: SrcConstrStateData + type(LD_ConstraintStateType), intent(inout) :: DstConstrStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'LD_CopyConstrState' + ErrStat = ErrID_None + ErrMsg = '' + DstConstrStateData%Dummy = SrcConstrStateData%Dummy +end subroutine + +subroutine LD_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) + type(LD_ConstraintStateType), intent(inout) :: ConstrStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'LD_DestroyConstrState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine LD_PackConstrState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(LD_ConstraintStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'LD_PackConstrState' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%Dummy) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine LD_UnPackConstrState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(LD_ConstraintStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'LD_UnPackConstrState' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%Dummy); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine LD_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) + type(LD_OtherStateType), intent(in) :: SrcOtherStateData + type(LD_OtherStateType), intent(inout) :: DstOtherStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'LD_CopyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcOtherStateData%xdot)) then + LB(1:1) = lbound(SrcOtherStateData%xdot) + UB(1:1) = ubound(SrcOtherStateData%xdot) + if (.not. allocated(DstOtherStateData%xdot)) then + allocate(DstOtherStateData%xdot(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%xdot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call LD_CopyContState(SrcOtherStateData%xdot(i1), DstOtherStateData%xdot(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + DstOtherStateData%n = SrcOtherStateData%n + DstOtherStateData%iMotionInterpLast = SrcOtherStateData%iMotionInterpLast +end subroutine + +subroutine LD_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) + type(LD_OtherStateType), intent(inout) :: OtherStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'LD_DestroyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OtherStateData%xdot)) then + LB(1:1) = lbound(OtherStateData%xdot) + UB(1:1) = ubound(OtherStateData%xdot) + do i1 = LB(1), UB(1) + call LD_DestroyContState(OtherStateData%xdot(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(OtherStateData%xdot) + end if +end subroutine + +subroutine LD_PackOtherState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(LD_OtherStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'LD_PackOtherState' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%xdot)) + if (allocated(InData%xdot)) then + call RegPackBounds(RF, 1, lbound(InData%xdot), ubound(InData%xdot)) + LB(1:1) = lbound(InData%xdot) + UB(1:1) = ubound(InData%xdot) + do i1 = LB(1), UB(1) + call LD_PackContState(RF, InData%xdot(i1)) + end do + end if + call RegPack(RF, InData%n) + call RegPack(RF, InData%iMotionInterpLast) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine LD_UnPackOtherState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(LD_OtherStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'LD_UnPackOtherState' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + if (allocated(OutData%xdot)) deallocate(OutData%xdot) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%xdot(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xdot.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call LD_UnpackContState(RF, OutData%xdot(i1)) ! xdot + end do + end if + call RegUnpack(RF, OutData%n); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iMotionInterpLast); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine LD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(LD_MiscVarType), intent(in) :: SrcMiscData + type(LD_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'LD_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + DstMiscData%Dummy = SrcMiscData%Dummy + if (allocated(SrcMiscData%qPrescribed)) then + LB(1:1) = lbound(SrcMiscData%qPrescribed) + UB(1:1) = ubound(SrcMiscData%qPrescribed) + if (.not. allocated(DstMiscData%qPrescribed)) then + allocate(DstMiscData%qPrescribed(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%qPrescribed.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%qPrescribed = SrcMiscData%qPrescribed + end if +end subroutine + +subroutine LD_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(LD_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'LD_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(MiscData%qPrescribed)) then + deallocate(MiscData%qPrescribed) + end if +end subroutine + +subroutine LD_PackMisc(RF, Indata) + type(RegFile), intent(inout) :: RF + type(LD_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'LD_PackMisc' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%Dummy) + call RegPackAlloc(RF, InData%qPrescribed) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine LD_UnPackMisc(RF, OutData) + type(RegFile), intent(inout) :: RF + type(LD_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'LD_UnPackMisc' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%Dummy); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%qPrescribed); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine LD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(LD_ParameterType), intent(in) :: SrcParamData + type(LD_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'LD_CopyParam' + ErrStat = ErrID_None + ErrMsg = '' + DstParamData%dt = SrcParamData%dt + DstParamData%IntMethod = SrcParamData%IntMethod + DstParamData%nx = SrcParamData%nx + DstParamData%nq = SrcParamData%nq + if (allocated(SrcParamData%MM)) then + LB(1:2) = lbound(SrcParamData%MM) + UB(1:2) = ubound(SrcParamData%MM) + if (.not. allocated(DstParamData%MM)) then + allocate(DstParamData%MM(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%MM.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%MM = SrcParamData%MM + end if + if (allocated(SrcParamData%CC)) then + LB(1:2) = lbound(SrcParamData%CC) + UB(1:2) = ubound(SrcParamData%CC) + if (.not. allocated(DstParamData%CC)) then + allocate(DstParamData%CC(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%CC = SrcParamData%CC + end if + if (allocated(SrcParamData%KK)) then + LB(1:2) = lbound(SrcParamData%KK) + UB(1:2) = ubound(SrcParamData%KK) + if (.not. allocated(DstParamData%KK)) then + allocate(DstParamData%KK(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%KK.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%KK = SrcParamData%KK + end if + if (allocated(SrcParamData%Minv)) then + LB(1:2) = lbound(SrcParamData%Minv) + UB(1:2) = ubound(SrcParamData%Minv) + if (.not. allocated(DstParamData%Minv)) then + allocate(DstParamData%Minv(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Minv.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Minv = SrcParamData%Minv + end if + if (allocated(SrcParamData%activeDOFs)) then + LB(1:1) = lbound(SrcParamData%activeDOFs) + UB(1:1) = ubound(SrcParamData%activeDOFs) + if (.not. allocated(DstParamData%activeDOFs)) then + allocate(DstParamData%activeDOFs(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%activeDOFs.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%activeDOFs = SrcParamData%activeDOFs + end if + if (allocated(SrcParamData%AA)) then + LB(1:2) = lbound(SrcParamData%AA) + UB(1:2) = ubound(SrcParamData%AA) + if (.not. allocated(DstParamData%AA)) then + allocate(DstParamData%AA(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AA.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%AA = SrcParamData%AA + end if + if (allocated(SrcParamData%BB)) then + LB(1:2) = lbound(SrcParamData%BB) + UB(1:2) = ubound(SrcParamData%BB) + if (.not. allocated(DstParamData%BB)) then + allocate(DstParamData%BB(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BB.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%BB = SrcParamData%BB + end if + DstParamData%NumOuts = SrcParamData%NumOuts + if (allocated(SrcParamData%OutParam)) then + LB(1:1) = lbound(SrcParamData%OutParam) + UB(1:1) = ubound(SrcParamData%OutParam) + if (.not. allocated(DstParamData%OutParam)) then + allocate(DstParamData%OutParam(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutParam.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyOutParmType(SrcParamData%OutParam(i1), DstParamData%OutParam(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcParamData%OutParamLinIndx)) then + LB(1:2) = lbound(SrcParamData%OutParamLinIndx) + UB(1:2) = ubound(SrcParamData%OutParamLinIndx) + if (.not. allocated(DstParamData%OutParamLinIndx)) then + allocate(DstParamData%OutParamLinIndx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutParamLinIndx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%OutParamLinIndx = SrcParamData%OutParamLinIndx + end if + if (allocated(SrcParamData%PrescribedValues)) then + LB(1:2) = lbound(SrcParamData%PrescribedValues) + UB(1:2) = ubound(SrcParamData%PrescribedValues) + if (.not. allocated(DstParamData%PrescribedValues)) then + allocate(DstParamData%PrescribedValues(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%PrescribedValues.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%PrescribedValues = SrcParamData%PrescribedValues + end if +end subroutine + +subroutine LD_DestroyParam(ParamData, ErrStat, ErrMsg) + type(LD_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'LD_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ParamData%MM)) then + deallocate(ParamData%MM) + end if + if (allocated(ParamData%CC)) then + deallocate(ParamData%CC) + end if + if (allocated(ParamData%KK)) then + deallocate(ParamData%KK) + end if + if (allocated(ParamData%Minv)) then + deallocate(ParamData%Minv) + end if + if (allocated(ParamData%activeDOFs)) then + deallocate(ParamData%activeDOFs) + end if + if (allocated(ParamData%AA)) then + deallocate(ParamData%AA) + end if + if (allocated(ParamData%BB)) then + deallocate(ParamData%BB) + end if + if (allocated(ParamData%OutParam)) then + LB(1:1) = lbound(ParamData%OutParam) + UB(1:1) = ubound(ParamData%OutParam) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyOutParmType(ParamData%OutParam(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%OutParam) + end if + if (allocated(ParamData%OutParamLinIndx)) then + deallocate(ParamData%OutParamLinIndx) + end if + if (allocated(ParamData%PrescribedValues)) then + deallocate(ParamData%PrescribedValues) + end if +end subroutine + +subroutine LD_PackParam(RF, Indata) + type(RegFile), intent(inout) :: RF + type(LD_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'LD_PackParam' + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%dt) + call RegPack(RF, InData%IntMethod) + call RegPack(RF, InData%nx) + call RegPack(RF, InData%nq) + call RegPackAlloc(RF, InData%MM) + call RegPackAlloc(RF, InData%CC) + call RegPackAlloc(RF, InData%KK) + call RegPackAlloc(RF, InData%Minv) + call RegPackAlloc(RF, InData%activeDOFs) + call RegPackAlloc(RF, InData%AA) + call RegPackAlloc(RF, InData%BB) + call RegPack(RF, InData%NumOuts) + call RegPack(RF, allocated(InData%OutParam)) + if (allocated(InData%OutParam)) then + call RegPackBounds(RF, 1, lbound(InData%OutParam), ubound(InData%OutParam)) + LB(1:1) = lbound(InData%OutParam) + UB(1:1) = ubound(InData%OutParam) + do i1 = LB(1), UB(1) + call NWTC_Library_PackOutParmType(RF, InData%OutParam(i1)) + end do + end if + call RegPackAlloc(RF, InData%OutParamLinIndx) + call RegPackAlloc(RF, InData%PrescribedValues) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine LD_UnPackParam(RF, OutData) + type(RegFile), intent(inout) :: RF + type(LD_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'LD_UnPackParam' + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%dt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%IntMethod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nq); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%MM); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%CC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%KK); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Minv); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%activeDOFs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AA); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BB); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumOuts); if (RegCheckErr(RF, RoutineName)) return + if (allocated(OutData%OutParam)) deallocate(OutData%OutParam) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%OutParam(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackOutParmType(RF, OutData%OutParam(i1)) ! OutParam + end do + end if + call RegUnpackAlloc(RF, OutData%OutParamLinIndx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PrescribedValues); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine LD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) + type(LD_InputType), intent(in) :: SrcInputData + type(LD_InputType), intent(inout) :: DstInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'LD_CopyInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcInputData%Fext)) then + LB(1:1) = lbound(SrcInputData%Fext) + UB(1:1) = ubound(SrcInputData%Fext) + if (.not. allocated(DstInputData%Fext)) then + allocate(DstInputData%Fext(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%Fext.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%Fext = SrcInputData%Fext + end if +end subroutine + +subroutine LD_DestroyInput(InputData, ErrStat, ErrMsg) + type(LD_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'LD_DestroyInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InputData%Fext)) then + deallocate(InputData%Fext) + end if +end subroutine + +subroutine LD_PackInput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(LD_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'LD_PackInput' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%Fext) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine LD_UnPackInput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(LD_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'LD_UnPackInput' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%Fext); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine LD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(LD_OutputType), intent(in) :: SrcOutputData + type(LD_OutputType), intent(inout) :: DstOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'LD_CopyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcOutputData%xdd)) then + LB(1:1) = lbound(SrcOutputData%xdd) + UB(1:1) = ubound(SrcOutputData%xdd) + if (.not. allocated(DstOutputData%xdd)) then + allocate(DstOutputData%xdd(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%xdd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%xdd = SrcOutputData%xdd + end if + if (allocated(SrcOutputData%WriteOutput)) then + LB(1:1) = lbound(SrcOutputData%WriteOutput) + UB(1:1) = ubound(SrcOutputData%WriteOutput) + if (.not. allocated(DstOutputData%WriteOutput)) then + allocate(DstOutputData%WriteOutput(LB(1):UB(1)), 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 + end if +end subroutine + +subroutine LD_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(LD_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'LD_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OutputData%xdd)) then + deallocate(OutputData%xdd) + end if + if (allocated(OutputData%WriteOutput)) then + deallocate(OutputData%WriteOutput) + end if +end subroutine + +subroutine LD_PackOutput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(LD_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'LD_PackOutput' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%xdd) + call RegPackAlloc(RF, InData%WriteOutput) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine LD_UnPackOutput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(LD_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'LD_UnPackOutput' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%xdd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WriteOutput); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine LD_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(LD_InputType), intent(in) :: u(:) ! Input at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Inputs + type(LD_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 = 'LD_Input_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(u)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(u)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(u) - 1 + select case (order) + case (0) + call LD_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call LD_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call LD_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(u) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE LD_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(LD_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 + TYPE(LD_InputType), INTENT(IN) :: u2 ! Input at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs + TYPE(LD_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 = 'LD_Input_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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 + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + IF (ALLOCATED(u_out%Fext) .AND. ALLOCATED(u1%Fext)) THEN + u_out%Fext = a1*u1%Fext + a2*u2%Fext + END IF ! check if allocated +END SUBROUTINE + +SUBROUTINE LD_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(LD_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 > t3 + TYPE(LD_InputType), INTENT(IN) :: u2 ! Input at t2 > t3 + TYPE(LD_InputType), INTENT(IN) :: u3 ! Input at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs + TYPE(LD_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) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'LD_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 + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + IF (ALLOCATED(u_out%Fext) .AND. ALLOCATED(u1%Fext)) THEN + u_out%Fext = a1*u1%Fext + a2*u2%Fext + a3*u3%Fext + END IF ! check if allocated +END SUBROUTINE + +subroutine LD_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(LD_OutputType), intent(in) :: y(:) ! Output at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Outputs + type(LD_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 = 'LD_Output_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(y)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(y)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(y) - 1 + select case (order) + case (0) + call LD_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call LD_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call LD_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(y) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE LD_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(LD_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 + TYPE(LD_OutputType), INTENT(IN) :: y2 ! Output at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs + TYPE(LD_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 = 'LD_Output_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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 + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + IF (ALLOCATED(y_out%xdd) .AND. ALLOCATED(y1%xdd)) THEN + y_out%xdd = a1*y1%xdd + a2*y2%xdd + END IF ! check if allocated + IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + END IF ! check if allocated +END SUBROUTINE + +SUBROUTINE LD_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(LD_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 > t3 + TYPE(LD_OutputType), INTENT(IN) :: y2 ! Output at t2 > t3 + TYPE(LD_OutputType), INTENT(IN) :: y3 ! Output at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs + TYPE(LD_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) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'LD_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 + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + IF (ALLOCATED(y_out%xdd) .AND. ALLOCATED(y1%xdd)) THEN + y_out%xdd = a1*y1%xdd + a2*y2%xdd + a3*y3%xdd + END IF ! check if allocated + IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + a3*y3%WriteOutput + END IF ! check if allocated +END SUBROUTINE +END MODULE LinDyn_Types +!ENDOFREGISTRYGENERATEDFILE diff --git a/modules/map/CMakeLists.txt b/modules/map/CMakeLists.txt index b69312b4db..5f82519a62 100644 --- a/modules/map/CMakeLists.txt +++ b/modules/map/CMakeLists.txt @@ -33,26 +33,39 @@ endif() file(GLOB MAP_CLIB_SOURCES src/*.c src/*.cc src/*/*.c src/*/*.cc) file(GLOB MAP_C_HEADERS src/*.h src/*/*.h) -add_library(maplib +add_library(mappplib STATIC src/map.f90 src/MAP_Types.f90 src/MAP_Fortran_Types.f90 ${MAP_CLIB_SOURCES} ) -target_link_libraries(maplib nwtclibs) -target_include_directories(maplib PUBLIC +target_sources( + mappplib + PUBLIC + $/include/mappp/MAP_Types.h> + $ + $/include/mappp/mapsys.h> + $ + $/include/mappp/maperror.h> + $ + $/include/mappp/mapapi.h> + $ +) +target_link_libraries(mappplib nwtclibs) +target_include_directories(mappplib PUBLIC $ $ $ $ $ ) -set_target_properties(maplib PROPERTIES PUBLIC_HEADER src/MAP_Types.h) +get_target_property(MAPPP_PUBLIC_HEADERS mappplib INTERFACE_SOURCES) +set_target_properties(mappplib PROPERTIES PUBLIC_HEADER "${MAPPP_PUBLIC_HEADERS}") -install(TARGETS maplib +install(TARGETS mappplib EXPORT "${CMAKE_PROJECT_NAME}Libraries" RUNTIME DESTINATION bin ARCHIVE DESTINATION lib LIBRARY DESTINATION lib - PUBLIC_HEADER DESTINATION include + PUBLIC_HEADER DESTINATION include/mappp ) diff --git a/modules/map/src/MAP_Fortran_Types.f90 b/modules/map/src/MAP_Fortran_Types.f90 index 4bed537cd2..ced2d55d68 100644 --- a/modules/map/src/MAP_Fortran_Types.f90 +++ b/modules/map/src/MAP_Fortran_Types.f90 @@ -48,663 +48,202 @@ MODULE MAP_Fortran_Types ! ========= Lin_ParamType ======= TYPE, PUBLIC :: Lin_ParamType INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: Jac_u_indx !< matrix to help fill/pack the u vector in computing the jacobian (fortran-only) [-] - REAL(R8Ki) :: du !< determines size of the translational displacement perturbation for u (inputs) (fortran-only) [-] - INTEGER(IntKi) :: Jac_ny !< number of outputs in jacobian matrix (fortran-only) [-] + REAL(R8Ki) :: du = 0.0_R8Ki !< determines size of the translational displacement perturbation for u (inputs) (fortran-only) [-] + INTEGER(IntKi) :: Jac_ny = 0_IntKi !< number of outputs in jacobian matrix (fortran-only) [-] END TYPE Lin_ParamType ! ======================= CONTAINS - SUBROUTINE MAP_Fortran_CopyLin_InitInputType( SrcLin_InitInputTypeData, DstLin_InitInputTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Lin_InitInputType), INTENT(IN) :: SrcLin_InitInputTypeData - TYPE(Lin_InitInputType), INTENT(INOUT) :: DstLin_InitInputTypeData - 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 = 'MAP_Fortran_CopyLin_InitInputType' -! - ErrStat = ErrID_None - ErrMsg = "" - DstLin_InitInputTypeData%linearize = SrcLin_InitInputTypeData%linearize - END SUBROUTINE MAP_Fortran_CopyLin_InitInputType - - SUBROUTINE MAP_Fortran_DestroyLin_InitInputType( Lin_InitInputTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(Lin_InitInputType), INTENT(INOUT) :: Lin_InitInputTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MAP_Fortran_DestroyLin_InitInputType' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE MAP_Fortran_DestroyLin_InitInputType - - SUBROUTINE MAP_Fortran_PackLin_InitInputType( 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(Lin_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 = 'MAP_Fortran_PackLin_InitInputType' - ! 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 ! 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 - - IntKiBuf(Int_Xferred) = TRANSFER(InData%linearize, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE MAP_Fortran_PackLin_InitInputType - - SUBROUTINE MAP_Fortran_UnPackLin_InitInputType( 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(Lin_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 = 'MAP_Fortran_UnPackLin_InitInputType' - ! 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%linearize = TRANSFER(IntKiBuf(Int_Xferred), OutData%linearize) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE MAP_Fortran_UnPackLin_InitInputType - SUBROUTINE MAP_Fortran_CopyLin_InitOutputType( SrcLin_InitOutputTypeData, DstLin_InitOutputTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Lin_InitOutputType), INTENT(IN) :: SrcLin_InitOutputTypeData - TYPE(Lin_InitOutputType), INTENT(INOUT) :: DstLin_InitOutputTypeData - 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 = 'MAP_Fortran_CopyLin_InitOutputType' -! +subroutine MAP_Fortran_CopyLin_InitInputType(SrcLin_InitInputTypeData, DstLin_InitInputTypeData, CtrlCode, ErrStat, ErrMsg) + type(Lin_InitInputType), intent(in) :: SrcLin_InitInputTypeData + type(Lin_InitInputType), intent(inout) :: DstLin_InitInputTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'MAP_Fortran_CopyLin_InitInputType' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcLin_InitOutputTypeData%LinNames_y)) THEN - i1_l = LBOUND(SrcLin_InitOutputTypeData%LinNames_y,1) - i1_u = UBOUND(SrcLin_InitOutputTypeData%LinNames_y,1) - IF (.NOT. ALLOCATED(DstLin_InitOutputTypeData%LinNames_y)) THEN - ALLOCATE(DstLin_InitOutputTypeData%LinNames_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLin_InitOutputTypeData%LinNames_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLin_InitOutputTypeData%LinNames_y = SrcLin_InitOutputTypeData%LinNames_y -ENDIF -IF (ALLOCATED(SrcLin_InitOutputTypeData%LinNames_u)) THEN - i1_l = LBOUND(SrcLin_InitOutputTypeData%LinNames_u,1) - i1_u = UBOUND(SrcLin_InitOutputTypeData%LinNames_u,1) - IF (.NOT. ALLOCATED(DstLin_InitOutputTypeData%LinNames_u)) THEN - ALLOCATE(DstLin_InitOutputTypeData%LinNames_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLin_InitOutputTypeData%LinNames_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLin_InitOutputTypeData%LinNames_u = SrcLin_InitOutputTypeData%LinNames_u -ENDIF -IF (ALLOCATED(SrcLin_InitOutputTypeData%IsLoad_u)) THEN - i1_l = LBOUND(SrcLin_InitOutputTypeData%IsLoad_u,1) - i1_u = UBOUND(SrcLin_InitOutputTypeData%IsLoad_u,1) - IF (.NOT. ALLOCATED(DstLin_InitOutputTypeData%IsLoad_u)) THEN - ALLOCATE(DstLin_InitOutputTypeData%IsLoad_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLin_InitOutputTypeData%IsLoad_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLin_InitOutputTypeData%IsLoad_u = SrcLin_InitOutputTypeData%IsLoad_u -ENDIF - END SUBROUTINE MAP_Fortran_CopyLin_InitOutputType - - SUBROUTINE MAP_Fortran_DestroyLin_InitOutputType( Lin_InitOutputTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(Lin_InitOutputType), INTENT(INOUT) :: Lin_InitOutputTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MAP_Fortran_DestroyLin_InitOutputType' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(Lin_InitOutputTypeData%LinNames_y)) THEN - DEALLOCATE(Lin_InitOutputTypeData%LinNames_y) -ENDIF -IF (ALLOCATED(Lin_InitOutputTypeData%LinNames_u)) THEN - DEALLOCATE(Lin_InitOutputTypeData%LinNames_u) -ENDIF -IF (ALLOCATED(Lin_InitOutputTypeData%IsLoad_u)) THEN - DEALLOCATE(Lin_InitOutputTypeData%IsLoad_u) -ENDIF - END SUBROUTINE MAP_Fortran_DestroyLin_InitOutputType - - SUBROUTINE MAP_Fortran_PackLin_InitOutputType( 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(Lin_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 = 'MAP_Fortran_PackLin_InitOutputType' - ! 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 ! 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 ! 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%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%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 MAP_Fortran_PackLin_InitOutputType - - SUBROUTINE MAP_Fortran_UnPackLin_InitOutputType( 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(Lin_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 = 'MAP_Fortran_UnPackLin_InitOutputType' - ! 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 ! 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 ! 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 MAP_Fortran_UnPackLin_InitOutputType - - SUBROUTINE MAP_Fortran_CopyLin_ParamType( SrcLin_ParamTypeData, DstLin_ParamTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Lin_ParamType), INTENT(IN) :: SrcLin_ParamTypeData - TYPE(Lin_ParamType), INTENT(INOUT) :: DstLin_ParamTypeData - 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 = 'MAP_Fortran_CopyLin_ParamType' -! + ErrMsg = '' + DstLin_InitInputTypeData%linearize = SrcLin_InitInputTypeData%linearize +end subroutine + +subroutine MAP_Fortran_DestroyLin_InitInputType(Lin_InitInputTypeData, ErrStat, ErrMsg) + type(Lin_InitInputType), intent(inout) :: Lin_InitInputTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'MAP_Fortran_DestroyLin_InitInputType' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcLin_ParamTypeData%Jac_u_indx)) THEN - i1_l = LBOUND(SrcLin_ParamTypeData%Jac_u_indx,1) - i1_u = UBOUND(SrcLin_ParamTypeData%Jac_u_indx,1) - i2_l = LBOUND(SrcLin_ParamTypeData%Jac_u_indx,2) - i2_u = UBOUND(SrcLin_ParamTypeData%Jac_u_indx,2) - IF (.NOT. ALLOCATED(DstLin_ParamTypeData%Jac_u_indx)) THEN - ALLOCATE(DstLin_ParamTypeData%Jac_u_indx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLin_ParamTypeData%Jac_u_indx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLin_ParamTypeData%Jac_u_indx = SrcLin_ParamTypeData%Jac_u_indx -ENDIF - DstLin_ParamTypeData%du = SrcLin_ParamTypeData%du - DstLin_ParamTypeData%Jac_ny = SrcLin_ParamTypeData%Jac_ny - END SUBROUTINE MAP_Fortran_CopyLin_ParamType - - SUBROUTINE MAP_Fortran_DestroyLin_ParamType( Lin_ParamTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(Lin_ParamType), INTENT(INOUT) :: Lin_ParamTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MAP_Fortran_DestroyLin_ParamType' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(Lin_ParamTypeData%Jac_u_indx)) THEN - DEALLOCATE(Lin_ParamTypeData%Jac_u_indx) -ENDIF - END SUBROUTINE MAP_Fortran_DestroyLin_ParamType - - SUBROUTINE MAP_Fortran_PackLin_ParamType( 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(Lin_ParamType), 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 = 'MAP_Fortran_PackLin_ParamType' - ! 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 ! 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 - Db_BufSz = Db_BufSz + 1 ! du - Int_BufSz = Int_BufSz + 1 ! Jac_ny - 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%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 - DbKiBuf(Db_Xferred) = InData%du - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%Jac_ny - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE MAP_Fortran_PackLin_ParamType - - SUBROUTINE MAP_Fortran_UnPackLin_ParamType( 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(Lin_ParamType), 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 = 'MAP_Fortran_UnPackLin_ParamType' - ! 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 ! 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 - OutData%du = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%Jac_ny = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE MAP_Fortran_UnPackLin_ParamType - + ErrMsg = '' +end subroutine + +subroutine MAP_Fortran_PackLin_InitInputType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Lin_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'MAP_Fortran_PackLin_InitInputType' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%linearize) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine MAP_Fortran_UnPackLin_InitInputType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Lin_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'MAP_Fortran_UnPackLin_InitInputType' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%linearize); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine MAP_Fortran_CopyLin_InitOutputType(SrcLin_InitOutputTypeData, DstLin_InitOutputTypeData, CtrlCode, ErrStat, ErrMsg) + type(Lin_InitOutputType), intent(in) :: SrcLin_InitOutputTypeData + type(Lin_InitOutputType), intent(inout) :: DstLin_InitOutputTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'MAP_Fortran_CopyLin_InitOutputType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcLin_InitOutputTypeData%LinNames_y)) then + LB(1:1) = lbound(SrcLin_InitOutputTypeData%LinNames_y) + UB(1:1) = ubound(SrcLin_InitOutputTypeData%LinNames_y) + if (.not. allocated(DstLin_InitOutputTypeData%LinNames_y)) then + allocate(DstLin_InitOutputTypeData%LinNames_y(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLin_InitOutputTypeData%LinNames_y.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLin_InitOutputTypeData%LinNames_y = SrcLin_InitOutputTypeData%LinNames_y + end if + if (allocated(SrcLin_InitOutputTypeData%LinNames_u)) then + LB(1:1) = lbound(SrcLin_InitOutputTypeData%LinNames_u) + UB(1:1) = ubound(SrcLin_InitOutputTypeData%LinNames_u) + if (.not. allocated(DstLin_InitOutputTypeData%LinNames_u)) then + allocate(DstLin_InitOutputTypeData%LinNames_u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLin_InitOutputTypeData%LinNames_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLin_InitOutputTypeData%LinNames_u = SrcLin_InitOutputTypeData%LinNames_u + end if + if (allocated(SrcLin_InitOutputTypeData%IsLoad_u)) then + LB(1:1) = lbound(SrcLin_InitOutputTypeData%IsLoad_u) + UB(1:1) = ubound(SrcLin_InitOutputTypeData%IsLoad_u) + if (.not. allocated(DstLin_InitOutputTypeData%IsLoad_u)) then + allocate(DstLin_InitOutputTypeData%IsLoad_u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLin_InitOutputTypeData%IsLoad_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLin_InitOutputTypeData%IsLoad_u = SrcLin_InitOutputTypeData%IsLoad_u + end if +end subroutine + +subroutine MAP_Fortran_DestroyLin_InitOutputType(Lin_InitOutputTypeData, ErrStat, ErrMsg) + type(Lin_InitOutputType), intent(inout) :: Lin_InitOutputTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'MAP_Fortran_DestroyLin_InitOutputType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(Lin_InitOutputTypeData%LinNames_y)) then + deallocate(Lin_InitOutputTypeData%LinNames_y) + end if + if (allocated(Lin_InitOutputTypeData%LinNames_u)) then + deallocate(Lin_InitOutputTypeData%LinNames_u) + end if + if (allocated(Lin_InitOutputTypeData%IsLoad_u)) then + deallocate(Lin_InitOutputTypeData%IsLoad_u) + end if +end subroutine + +subroutine MAP_Fortran_PackLin_InitOutputType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Lin_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'MAP_Fortran_PackLin_InitOutputType' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%LinNames_y) + call RegPackAlloc(RF, InData%LinNames_u) + call RegPackAlloc(RF, InData%IsLoad_u) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine MAP_Fortran_UnPackLin_InitOutputType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Lin_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'MAP_Fortran_UnPackLin_InitOutputType' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%LinNames_y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LinNames_u); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%IsLoad_u); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine MAP_Fortran_CopyLin_ParamType(SrcLin_ParamTypeData, DstLin_ParamTypeData, CtrlCode, ErrStat, ErrMsg) + type(Lin_ParamType), intent(in) :: SrcLin_ParamTypeData + type(Lin_ParamType), intent(inout) :: DstLin_ParamTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'MAP_Fortran_CopyLin_ParamType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcLin_ParamTypeData%Jac_u_indx)) then + LB(1:2) = lbound(SrcLin_ParamTypeData%Jac_u_indx) + UB(1:2) = ubound(SrcLin_ParamTypeData%Jac_u_indx) + if (.not. allocated(DstLin_ParamTypeData%Jac_u_indx)) then + allocate(DstLin_ParamTypeData%Jac_u_indx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLin_ParamTypeData%Jac_u_indx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLin_ParamTypeData%Jac_u_indx = SrcLin_ParamTypeData%Jac_u_indx + end if + DstLin_ParamTypeData%du = SrcLin_ParamTypeData%du + DstLin_ParamTypeData%Jac_ny = SrcLin_ParamTypeData%Jac_ny +end subroutine + +subroutine MAP_Fortran_DestroyLin_ParamType(Lin_ParamTypeData, ErrStat, ErrMsg) + type(Lin_ParamType), intent(inout) :: Lin_ParamTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'MAP_Fortran_DestroyLin_ParamType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(Lin_ParamTypeData%Jac_u_indx)) then + deallocate(Lin_ParamTypeData%Jac_u_indx) + end if +end subroutine + +subroutine MAP_Fortran_PackLin_ParamType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Lin_ParamType), intent(in) :: InData + character(*), parameter :: RoutineName = 'MAP_Fortran_PackLin_ParamType' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%Jac_u_indx) + call RegPack(RF, InData%du) + call RegPack(RF, InData%Jac_ny) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine MAP_Fortran_UnPackLin_ParamType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Lin_ParamType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'MAP_Fortran_UnPackLin_ParamType' + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%Jac_u_indx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%du); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Jac_ny); if (RegCheckErr(RF, RoutineName)) return +end subroutine END MODULE MAP_Fortran_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/map/src/MAP_Types.f90 b/modules/map/src/MAP_Types.f90 index d179fa96e9..c83fae8198 100644 --- a/modules/map/src/MAP_Types.f90 +++ b/modules/map/src/MAP_Types.f90 @@ -32,7 +32,6 @@ MODULE MAP_Types !--------------------------------------------------------------------------------------------------------------------------------- USE MAP_Fortran_Types -!USE, INTRINSIC :: ISO_C_Binding USE NWTC_Library IMPLICIT NONE ! ========= MAP_InitInputType_C ======= @@ -91,7 +90,7 @@ MODULE MAP_Types END TYPE MAP_ContinuousStateType_C TYPE, PUBLIC :: MAP_ContinuousStateType TYPE( MAP_ContinuousStateType_C ) :: C_obj - REAL(R8Ki) :: dummy !< Remove this variable if you have continuous states [-] + REAL(R8Ki) :: dummy = 0.0_R8Ki !< Remove this variable if you have continuous states [-] END TYPE MAP_ContinuousStateType ! ======================= ! ========= MAP_DiscreteStateType_C ======= @@ -101,7 +100,7 @@ MODULE MAP_Types END TYPE MAP_DiscreteStateType_C TYPE, PUBLIC :: MAP_DiscreteStateType TYPE( MAP_DiscreteStateType_C ) :: C_obj - REAL(R8Ki) :: dummy !< Remove this variable if you have discrete states [-] + REAL(R8Ki) :: dummy = 0.0_R8Ki !< Remove this variable if you have discrete states [-] END TYPE MAP_DiscreteStateType ! ======================= ! ========= MAP_OtherStateType_C ======= @@ -194,10 +193,10 @@ MODULE MAP_Types END TYPE MAP_ParameterType_C TYPE, PUBLIC :: MAP_ParameterType TYPE( MAP_ParameterType_C ) :: C_obj - REAL(R8Ki) :: g !< gravitational constant [[kg/m^2]] - REAL(R8Ki) :: depth !< distance to seabed [[m]] - REAL(R8Ki) :: rho_sea !< density of seawater [[m]] - REAL(R8Ki) :: dt !< time step coupling interval [[sec]] + REAL(R8Ki) :: g = 0.0_R8Ki !< gravitational constant [[kg/m^2]] + REAL(R8Ki) :: depth = 0.0_R8Ki !< distance to seabed [[m]] + REAL(R8Ki) :: rho_sea = 0.0_R8Ki !< density of seawater [[m]] + REAL(R8Ki) :: dt = 0.0_R8Ki !< time step coupling interval [[sec]] CHARACTER(255) , DIMENSION(1:500) :: InputLines !< input file line for restart [-] CHARACTER(1) , DIMENSION(1:500) :: InputLineType !< input file line type for restart [-] INTEGER(IntKi) :: numOuts = 0 !< Number of write outputs [-] @@ -247,4898 +246,2347 @@ MODULE MAP_Types END TYPE MAP_OutputType ! ======================= CONTAINS - SUBROUTINE MAP_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MAP_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(MAP_InitInputType), INTENT(INOUT) :: DstInitInputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode + +subroutine MAP_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) + type(MAP_InitInputType), intent(in) :: SrcInitInputData + type(MAP_InitInputType), intent(inout) :: DstInitInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'MAP_CopyInitInput' + ErrStat = ErrID_None + ErrMsg = '' + DstInitInputData%gravity = SrcInitInputData%gravity + DstInitInputData%C_obj%gravity = SrcInitInputData%C_obj%gravity + DstInitInputData%sea_density = SrcInitInputData%sea_density + DstInitInputData%C_obj%sea_density = SrcInitInputData%C_obj%sea_density + DstInitInputData%depth = SrcInitInputData%depth + DstInitInputData%C_obj%depth = SrcInitInputData%C_obj%depth + DstInitInputData%file_name = SrcInitInputData%file_name + DstInitInputData%C_obj%file_name = SrcInitInputData%C_obj%file_name + DstInitInputData%summary_file_name = SrcInitInputData%summary_file_name + DstInitInputData%C_obj%summary_file_name = SrcInitInputData%C_obj%summary_file_name + DstInitInputData%library_input_str = SrcInitInputData%library_input_str + DstInitInputData%C_obj%library_input_str = SrcInitInputData%C_obj%library_input_str + DstInitInputData%node_input_str = SrcInitInputData%node_input_str + DstInitInputData%C_obj%node_input_str = SrcInitInputData%C_obj%node_input_str + DstInitInputData%line_input_str = SrcInitInputData%line_input_str + DstInitInputData%C_obj%line_input_str = SrcInitInputData%C_obj%line_input_str + DstInitInputData%option_input_str = SrcInitInputData%option_input_str + DstInitInputData%C_obj%option_input_str = SrcInitInputData%C_obj%option_input_str + call MAP_Fortran_CopyLin_InitInputType(SrcInitInputData%LinInitInp, DstInitInputData%LinInitInp, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine MAP_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(MAP_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'MAP_DestroyInitInput' + ErrStat = ErrID_None + ErrMsg = '' + call MAP_Fortran_DestroyLin_InitInputType(InitInputData%LinInitInp, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine MAP_PackInitInput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(MAP_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'MAP_PackInitInput' + if (RF%ErrStat >= AbortErrLev) return + if (c_associated(InData%C_obj%object)) then + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + call RegPack(RF, InData%gravity) + call RegPack(RF, InData%sea_density) + call RegPack(RF, InData%depth) + call RegPack(RF, InData%file_name) + call RegPack(RF, InData%summary_file_name) + call RegPack(RF, InData%library_input_str) + call RegPack(RF, InData%node_input_str) + call RegPack(RF, InData%line_input_str) + call RegPack(RF, InData%option_input_str) + call MAP_Fortran_PackLin_InitInputType(RF, InData%LinInitInp) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine MAP_UnPackInitInput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(MAP_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'MAP_UnPackInitInput' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%gravity); if (RegCheckErr(RF, RoutineName)) return + OutData%C_obj%gravity = OutData%gravity + call RegUnpack(RF, OutData%sea_density); if (RegCheckErr(RF, RoutineName)) return + OutData%C_obj%sea_density = OutData%sea_density + call RegUnpack(RF, OutData%depth); if (RegCheckErr(RF, RoutineName)) return + OutData%C_obj%depth = OutData%depth + call RegUnpack(RF, OutData%file_name); if (RegCheckErr(RF, RoutineName)) return + OutData%C_obj%file_name = transfer(OutData%file_name, OutData%C_obj%file_name ) + call RegUnpack(RF, OutData%summary_file_name); if (RegCheckErr(RF, RoutineName)) return + OutData%C_obj%summary_file_name = transfer(OutData%summary_file_name, OutData%C_obj%summary_file_name ) + call RegUnpack(RF, OutData%library_input_str); if (RegCheckErr(RF, RoutineName)) return + OutData%C_obj%library_input_str = transfer(OutData%library_input_str, OutData%C_obj%library_input_str ) + call RegUnpack(RF, OutData%node_input_str); if (RegCheckErr(RF, RoutineName)) return + OutData%C_obj%node_input_str = transfer(OutData%node_input_str, OutData%C_obj%node_input_str ) + call RegUnpack(RF, OutData%line_input_str); if (RegCheckErr(RF, RoutineName)) return + OutData%C_obj%line_input_str = transfer(OutData%line_input_str, OutData%C_obj%line_input_str ) + call RegUnpack(RF, OutData%option_input_str); if (RegCheckErr(RF, RoutineName)) return + OutData%C_obj%option_input_str = transfer(OutData%option_input_str, OutData%C_obj%option_input_str ) + call MAP_Fortran_UnpackLin_InitInputType(RF, OutData%LinInitInp) ! LinInitInp +end subroutine + +SUBROUTINE MAP_C2Fary_CopyInitInput(InitInputData, ErrStat, ErrMsg, SkipPointers) + TYPE(MAP_InitInputType), INTENT(INOUT) :: InitInputData 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 = 'MAP_CopyInitInput' -! + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local ErrStat = ErrID_None ErrMsg = "" - DstInitInputData%gravity = SrcInitInputData%gravity - DstInitInputData%C_obj%gravity = SrcInitInputData%C_obj%gravity - DstInitInputData%sea_density = SrcInitInputData%sea_density - DstInitInputData%C_obj%sea_density = SrcInitInputData%C_obj%sea_density - DstInitInputData%depth = SrcInitInputData%depth - DstInitInputData%C_obj%depth = SrcInitInputData%C_obj%depth - DstInitInputData%file_name = SrcInitInputData%file_name - DstInitInputData%C_obj%file_name = SrcInitInputData%C_obj%file_name - DstInitInputData%summary_file_name = SrcInitInputData%summary_file_name - DstInitInputData%C_obj%summary_file_name = SrcInitInputData%C_obj%summary_file_name - DstInitInputData%library_input_str = SrcInitInputData%library_input_str - DstInitInputData%C_obj%library_input_str = SrcInitInputData%C_obj%library_input_str - DstInitInputData%node_input_str = SrcInitInputData%node_input_str - DstInitInputData%C_obj%node_input_str = SrcInitInputData%C_obj%node_input_str - DstInitInputData%line_input_str = SrcInitInputData%line_input_str - DstInitInputData%C_obj%line_input_str = SrcInitInputData%C_obj%line_input_str - DstInitInputData%option_input_str = SrcInitInputData%option_input_str - DstInitInputData%C_obj%option_input_str = SrcInitInputData%C_obj%option_input_str - CALL MAP_Fortran_Copylin_initinputtype( SrcInitInputData%LinInitInp, DstInitInputData%LinInitInp, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE MAP_CopyInitInput - - SUBROUTINE MAP_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(MAP_InitInputType), INTENT(INOUT) :: InitInputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MAP_DestroyInitInput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL MAP_Fortran_Destroylin_initinputtype( InitInputData%LinInitInp, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE MAP_DestroyInitInput + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + InitInputData%gravity = InitInputData%C_obj%gravity + InitInputData%sea_density = InitInputData%C_obj%sea_density + InitInputData%depth = InitInputData%C_obj%depth + InitInputData%file_name = TRANSFER(InitInputData%C_obj%file_name, InitInputData%file_name ) + InitInputData%summary_file_name = TRANSFER(InitInputData%C_obj%summary_file_name, InitInputData%summary_file_name ) + InitInputData%library_input_str = TRANSFER(InitInputData%C_obj%library_input_str, InitInputData%library_input_str ) + InitInputData%node_input_str = TRANSFER(InitInputData%C_obj%node_input_str, InitInputData%node_input_str ) + InitInputData%line_input_str = TRANSFER(InitInputData%C_obj%line_input_str, InitInputData%line_input_str ) + InitInputData%option_input_str = TRANSFER(InitInputData%C_obj%option_input_str, InitInputData%option_input_str ) +END SUBROUTINE + +SUBROUTINE MAP_F2C_CopyInitInput( InitInputData, ErrStat, ErrMsg, SkipPointers ) + TYPE(MAP_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%gravity = InitInputData%gravity + InitInputData%C_obj%sea_density = InitInputData%sea_density + InitInputData%C_obj%depth = InitInputData%depth + InitInputData%C_obj%file_name = TRANSFER(InitInputData%file_name, InitInputData%C_obj%file_name) + InitInputData%C_obj%summary_file_name = TRANSFER(InitInputData%summary_file_name, InitInputData%C_obj%summary_file_name) + InitInputData%C_obj%library_input_str = TRANSFER(InitInputData%library_input_str, InitInputData%C_obj%library_input_str) + InitInputData%C_obj%node_input_str = TRANSFER(InitInputData%node_input_str, InitInputData%C_obj%node_input_str) + InitInputData%C_obj%line_input_str = TRANSFER(InitInputData%line_input_str, InitInputData%C_obj%line_input_str) + InitInputData%C_obj%option_input_str = TRANSFER(InitInputData%option_input_str, InitInputData%C_obj%option_input_str) +END SUBROUTINE + +subroutine MAP_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) + type(MAP_InitOutputType), intent(in) :: SrcInitOutputData + type(MAP_InitOutputType), intent(inout) :: DstInitOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'MAP_CopyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + DstInitOutputData%progName = SrcInitOutputData%progName + DstInitOutputData%C_obj%progName = SrcInitOutputData%C_obj%progName + DstInitOutputData%version = SrcInitOutputData%version + DstInitOutputData%C_obj%version = SrcInitOutputData%C_obj%version + DstInitOutputData%compilingData = SrcInitOutputData%compilingData + DstInitOutputData%C_obj%compilingData = SrcInitOutputData%C_obj%compilingData + if (allocated(SrcInitOutputData%writeOutputHdr)) then + LB(1:1) = lbound(SrcInitOutputData%writeOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%writeOutputHdr) + if (.not. allocated(DstInitOutputData%writeOutputHdr)) then + allocate(DstInitOutputData%writeOutputHdr(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitOutputData%writeOutputUnt)) then + LB(1:1) = lbound(SrcInitOutputData%writeOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%writeOutputUnt) + if (.not. allocated(DstInitOutputData%writeOutputUnt)) then + allocate(DstInitOutputData%writeOutputUnt(LB(1):UB(1)), 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 + end if + call NWTC_Library_CopyProgDesc(SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MAP_Fortran_CopyLin_InitOutputType(SrcInitOutputData%LinInitOut, DstInitOutputData%LinInitOut, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine MAP_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(MAP_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'MAP_DestroyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InitOutputData%writeOutputHdr)) then + deallocate(InitOutputData%writeOutputHdr) + end if + if (allocated(InitOutputData%writeOutputUnt)) then + deallocate(InitOutputData%writeOutputUnt) + end if + call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MAP_Fortran_DestroyLin_InitOutputType(InitOutputData%LinInitOut, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine MAP_PackInitOutput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(MAP_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'MAP_PackInitOutput' + if (RF%ErrStat >= AbortErrLev) return + if (c_associated(InData%C_obj%object)) then + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + call RegPack(RF, InData%progName) + call RegPack(RF, InData%version) + call RegPack(RF, InData%compilingData) + call RegPackAlloc(RF, InData%writeOutputHdr) + call RegPackAlloc(RF, InData%writeOutputUnt) + call NWTC_Library_PackProgDesc(RF, InData%Ver) + call MAP_Fortran_PackLin_InitOutputType(RF, InData%LinInitOut) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine MAP_UnPackInitOutput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(MAP_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'MAP_UnPackInitOutput' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%progName); if (RegCheckErr(RF, RoutineName)) return + OutData%C_obj%progName = transfer(OutData%progName, OutData%C_obj%progName ) + call RegUnpack(RF, OutData%version); if (RegCheckErr(RF, RoutineName)) return + OutData%C_obj%version = transfer(OutData%version, OutData%C_obj%version ) + call RegUnpack(RF, OutData%compilingData); if (RegCheckErr(RF, RoutineName)) return + OutData%C_obj%compilingData = transfer(OutData%compilingData, OutData%C_obj%compilingData ) + call RegUnpackAlloc(RF, OutData%writeOutputHdr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%writeOutputUnt); if (RegCheckErr(RF, RoutineName)) return + call NWTC_Library_UnpackProgDesc(RF, OutData%Ver) ! Ver + call MAP_Fortran_UnpackLin_InitOutputType(RF, OutData%LinInitOut) ! LinInitOut +end subroutine + +SUBROUTINE MAP_C2Fary_CopyInitOutput(InitOutputData, ErrStat, ErrMsg, SkipPointers) + TYPE(MAP_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%progName = TRANSFER(InitOutputData%C_obj%progName, InitOutputData%progName ) + InitOutputData%version = TRANSFER(InitOutputData%C_obj%version, InitOutputData%version ) + InitOutputData%compilingData = TRANSFER(InitOutputData%C_obj%compilingData, InitOutputData%compilingData ) +END SUBROUTINE - SUBROUTINE MAP_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(MAP_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 = 'MAP_PackInitInput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) +SUBROUTINE MAP_F2C_CopyInitOutput( InitOutputData, ErrStat, ErrMsg, SkipPointers ) + TYPE(MAP_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%progName = TRANSFER(InitOutputData%progName, InitOutputData%C_obj%progName) + InitOutputData%C_obj%version = TRANSFER(InitOutputData%version, InitOutputData%C_obj%version) + InitOutputData%C_obj%compilingData = TRANSFER(InitOutputData%compilingData, InitOutputData%C_obj%compilingData) +END SUBROUTINE + +subroutine MAP_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) + type(MAP_ContinuousStateType), intent(in) :: SrcContStateData + type(MAP_ContinuousStateType), intent(inout) :: DstContStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'MAP_CopyContState' + ErrStat = ErrID_None + ErrMsg = '' + DstContStateData%dummy = SrcContStateData%dummy + DstContStateData%C_obj%dummy = SrcContStateData%C_obj%dummy +end subroutine + +subroutine MAP_DestroyContState(ContStateData, ErrStat, ErrMsg) + type(MAP_ContinuousStateType), intent(inout) :: ContStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'MAP_DestroyContState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine MAP_PackContState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(MAP_ContinuousStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'MAP_PackContState' + if (RF%ErrStat >= AbortErrLev) return + if (c_associated(InData%C_obj%object)) then + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + call RegPack(RF, InData%dummy) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine MAP_UnPackContState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(MAP_ContinuousStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'MAP_UnPackContState' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%dummy); if (RegCheckErr(RF, RoutineName)) return + OutData%C_obj%dummy = OutData%dummy +end subroutine + +SUBROUTINE MAP_C2Fary_CopyContState(ContStateData, ErrStat, ErrMsg, SkipPointers) + TYPE(MAP_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 - 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 ! gravity - Db_BufSz = Db_BufSz + 1 ! sea_density - Db_BufSz = Db_BufSz + 1 ! depth - Int_BufSz = Int_BufSz + 1*LEN(InData%file_name) ! file_name - Int_BufSz = Int_BufSz + 1*LEN(InData%summary_file_name) ! summary_file_name - Int_BufSz = Int_BufSz + 1*LEN(InData%library_input_str) ! library_input_str - Int_BufSz = Int_BufSz + 1*LEN(InData%node_input_str) ! node_input_str - Int_BufSz = Int_BufSz + 1*LEN(InData%line_input_str) ! line_input_str - Int_BufSz = Int_BufSz + 1*LEN(InData%option_input_str) ! option_input_str - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! LinInitInp: size of buffers for each call to pack subtype - CALL MAP_Fortran_Packlin_initinputtype( Re_Buf, Db_Buf, Int_Buf, InData%LinInitInp, ErrStat2, ErrMsg2, .TRUE. ) ! LinInitInp - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN +SUBROUTINE MAP_F2C_CopyContState( ContStateData, ErrStat, ErrMsg, SkipPointers ) + TYPE(MAP_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 + +subroutine MAP_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) + type(MAP_DiscreteStateType), intent(in) :: SrcDiscStateData + type(MAP_DiscreteStateType), intent(inout) :: DstDiscStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'MAP_CopyDiscState' + ErrStat = ErrID_None + ErrMsg = '' + DstDiscStateData%dummy = SrcDiscStateData%dummy + DstDiscStateData%C_obj%dummy = SrcDiscStateData%C_obj%dummy +end subroutine + +subroutine MAP_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) + type(MAP_DiscreteStateType), intent(inout) :: DiscStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'MAP_DestroyDiscState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine MAP_PackDiscState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(MAP_DiscreteStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'MAP_PackDiscState' + if (RF%ErrStat >= AbortErrLev) return + if (c_associated(InData%C_obj%object)) then + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + call RegPack(RF, InData%dummy) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine MAP_UnPackDiscState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(MAP_DiscreteStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'MAP_UnPackDiscState' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%dummy); if (RegCheckErr(RF, RoutineName)) return + OutData%C_obj%dummy = OutData%dummy +end subroutine + +SUBROUTINE MAP_C2Fary_CopyDiscState(DiscStateData, ErrStat, ErrMsg, SkipPointers) + TYPE(MAP_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 + DiscStateData%dummy = DiscStateData%C_obj%dummy +END SUBROUTINE - IF(ALLOCATED(Re_Buf)) THEN ! LinInitInp - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) +SUBROUTINE MAP_F2C_CopyDiscState( DiscStateData, ErrStat, ErrMsg, SkipPointers ) + TYPE(MAP_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 + DiscStateData%C_obj%dummy = DiscStateData%dummy +END SUBROUTINE + +subroutine MAP_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) + type(MAP_OtherStateType), intent(in) :: SrcOtherStateData + type(MAP_OtherStateType), intent(inout) :: DstOtherStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'MAP_CopyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + if (associated(SrcOtherStateData%H)) then + LB(1:1) = lbound(SrcOtherStateData%H) + UB(1:1) = ubound(SrcOtherStateData%H) + if (.not. associated(DstOtherStateData%H)) then + allocate(DstOtherStateData%H(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%H.', ErrStat, ErrMsg, RoutineName) + return + end if + DstOtherStateData%C_obj%H_Len = size(DstOtherStateData%H) + if (DstOtherStateData%C_obj%H_Len > 0) & + DstOtherStateData%C_obj%H = c_loc(DstOtherStateData%H(LB(1))) + end if + DstOtherStateData%H = SrcOtherStateData%H + end if + if (associated(SrcOtherStateData%V)) then + LB(1:1) = lbound(SrcOtherStateData%V) + UB(1:1) = ubound(SrcOtherStateData%V) + if (.not. associated(DstOtherStateData%V)) then + allocate(DstOtherStateData%V(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%V.', ErrStat, ErrMsg, RoutineName) + return + end if + DstOtherStateData%C_obj%V_Len = size(DstOtherStateData%V) + if (DstOtherStateData%C_obj%V_Len > 0) & + DstOtherStateData%C_obj%V = c_loc(DstOtherStateData%V(LB(1))) + end if + DstOtherStateData%V = SrcOtherStateData%V + end if + if (associated(SrcOtherStateData%Ha)) then + LB(1:1) = lbound(SrcOtherStateData%Ha) + UB(1:1) = ubound(SrcOtherStateData%Ha) + if (.not. associated(DstOtherStateData%Ha)) then + allocate(DstOtherStateData%Ha(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%Ha.', ErrStat, ErrMsg, RoutineName) + return + end if + DstOtherStateData%C_obj%Ha_Len = size(DstOtherStateData%Ha) + if (DstOtherStateData%C_obj%Ha_Len > 0) & + DstOtherStateData%C_obj%Ha = c_loc(DstOtherStateData%Ha(LB(1))) + end if + DstOtherStateData%Ha = SrcOtherStateData%Ha + end if + if (associated(SrcOtherStateData%Va)) then + LB(1:1) = lbound(SrcOtherStateData%Va) + UB(1:1) = ubound(SrcOtherStateData%Va) + if (.not. associated(DstOtherStateData%Va)) then + allocate(DstOtherStateData%Va(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%Va.', ErrStat, ErrMsg, RoutineName) + return + end if + DstOtherStateData%C_obj%Va_Len = size(DstOtherStateData%Va) + if (DstOtherStateData%C_obj%Va_Len > 0) & + DstOtherStateData%C_obj%Va = c_loc(DstOtherStateData%Va(LB(1))) + end if + DstOtherStateData%Va = SrcOtherStateData%Va + end if + if (associated(SrcOtherStateData%x)) then + LB(1:1) = lbound(SrcOtherStateData%x) + UB(1:1) = ubound(SrcOtherStateData%x) + if (.not. associated(DstOtherStateData%x)) then + allocate(DstOtherStateData%x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%x.', ErrStat, ErrMsg, RoutineName) + return + end if + DstOtherStateData%C_obj%x_Len = size(DstOtherStateData%x) + if (DstOtherStateData%C_obj%x_Len > 0) & + DstOtherStateData%C_obj%x = c_loc(DstOtherStateData%x(LB(1))) + end if + DstOtherStateData%x = SrcOtherStateData%x + end if + if (associated(SrcOtherStateData%y)) then + LB(1:1) = lbound(SrcOtherStateData%y) + UB(1:1) = ubound(SrcOtherStateData%y) + if (.not. associated(DstOtherStateData%y)) then + allocate(DstOtherStateData%y(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%y.', ErrStat, ErrMsg, RoutineName) + return + end if + DstOtherStateData%C_obj%y_Len = size(DstOtherStateData%y) + if (DstOtherStateData%C_obj%y_Len > 0) & + DstOtherStateData%C_obj%y = c_loc(DstOtherStateData%y(LB(1))) + end if + DstOtherStateData%y = SrcOtherStateData%y + end if + if (associated(SrcOtherStateData%z)) then + LB(1:1) = lbound(SrcOtherStateData%z) + UB(1:1) = ubound(SrcOtherStateData%z) + if (.not. associated(DstOtherStateData%z)) then + allocate(DstOtherStateData%z(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%z.', ErrStat, ErrMsg, RoutineName) + return + end if + DstOtherStateData%C_obj%z_Len = size(DstOtherStateData%z) + if (DstOtherStateData%C_obj%z_Len > 0) & + DstOtherStateData%C_obj%z = c_loc(DstOtherStateData%z(LB(1))) + end if + DstOtherStateData%z = SrcOtherStateData%z + end if + if (associated(SrcOtherStateData%xa)) then + LB(1:1) = lbound(SrcOtherStateData%xa) + UB(1:1) = ubound(SrcOtherStateData%xa) + if (.not. associated(DstOtherStateData%xa)) then + allocate(DstOtherStateData%xa(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%xa.', ErrStat, ErrMsg, RoutineName) + return + end if + DstOtherStateData%C_obj%xa_Len = size(DstOtherStateData%xa) + if (DstOtherStateData%C_obj%xa_Len > 0) & + DstOtherStateData%C_obj%xa = c_loc(DstOtherStateData%xa(LB(1))) + end if + DstOtherStateData%xa = SrcOtherStateData%xa + end if + if (associated(SrcOtherStateData%ya)) then + LB(1:1) = lbound(SrcOtherStateData%ya) + UB(1:1) = ubound(SrcOtherStateData%ya) + if (.not. associated(DstOtherStateData%ya)) then + allocate(DstOtherStateData%ya(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%ya.', ErrStat, ErrMsg, RoutineName) + return + end if + DstOtherStateData%C_obj%ya_Len = size(DstOtherStateData%ya) + if (DstOtherStateData%C_obj%ya_Len > 0) & + DstOtherStateData%C_obj%ya = c_loc(DstOtherStateData%ya(LB(1))) + end if + DstOtherStateData%ya = SrcOtherStateData%ya + end if + if (associated(SrcOtherStateData%za)) then + LB(1:1) = lbound(SrcOtherStateData%za) + UB(1:1) = ubound(SrcOtherStateData%za) + if (.not. associated(DstOtherStateData%za)) then + allocate(DstOtherStateData%za(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%za.', ErrStat, ErrMsg, RoutineName) + return + end if + DstOtherStateData%C_obj%za_Len = size(DstOtherStateData%za) + if (DstOtherStateData%C_obj%za_Len > 0) & + DstOtherStateData%C_obj%za = c_loc(DstOtherStateData%za(LB(1))) + end if + DstOtherStateData%za = SrcOtherStateData%za + end if + if (associated(SrcOtherStateData%Fx_connect)) then + LB(1:1) = lbound(SrcOtherStateData%Fx_connect) + UB(1:1) = ubound(SrcOtherStateData%Fx_connect) + if (.not. associated(DstOtherStateData%Fx_connect)) then + allocate(DstOtherStateData%Fx_connect(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%Fx_connect.', ErrStat, ErrMsg, RoutineName) + return + end if + DstOtherStateData%C_obj%Fx_connect_Len = size(DstOtherStateData%Fx_connect) + if (DstOtherStateData%C_obj%Fx_connect_Len > 0) & + DstOtherStateData%C_obj%Fx_connect = c_loc(DstOtherStateData%Fx_connect(LB(1))) + end if + DstOtherStateData%Fx_connect = SrcOtherStateData%Fx_connect + end if + if (associated(SrcOtherStateData%Fy_connect)) then + LB(1:1) = lbound(SrcOtherStateData%Fy_connect) + UB(1:1) = ubound(SrcOtherStateData%Fy_connect) + if (.not. associated(DstOtherStateData%Fy_connect)) then + allocate(DstOtherStateData%Fy_connect(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%Fy_connect.', ErrStat, ErrMsg, RoutineName) + return + end if + DstOtherStateData%C_obj%Fy_connect_Len = size(DstOtherStateData%Fy_connect) + if (DstOtherStateData%C_obj%Fy_connect_Len > 0) & + DstOtherStateData%C_obj%Fy_connect = c_loc(DstOtherStateData%Fy_connect(LB(1))) + end if + DstOtherStateData%Fy_connect = SrcOtherStateData%Fy_connect + end if + if (associated(SrcOtherStateData%Fz_connect)) then + LB(1:1) = lbound(SrcOtherStateData%Fz_connect) + UB(1:1) = ubound(SrcOtherStateData%Fz_connect) + if (.not. associated(DstOtherStateData%Fz_connect)) then + allocate(DstOtherStateData%Fz_connect(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%Fz_connect.', ErrStat, ErrMsg, RoutineName) + return + end if + DstOtherStateData%C_obj%Fz_connect_Len = size(DstOtherStateData%Fz_connect) + if (DstOtherStateData%C_obj%Fz_connect_Len > 0) & + DstOtherStateData%C_obj%Fz_connect = c_loc(DstOtherStateData%Fz_connect(LB(1))) + end if + DstOtherStateData%Fz_connect = SrcOtherStateData%Fz_connect + end if + if (associated(SrcOtherStateData%Fx_anchor)) then + LB(1:1) = lbound(SrcOtherStateData%Fx_anchor) + UB(1:1) = ubound(SrcOtherStateData%Fx_anchor) + if (.not. associated(DstOtherStateData%Fx_anchor)) then + allocate(DstOtherStateData%Fx_anchor(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%Fx_anchor.', ErrStat, ErrMsg, RoutineName) + return + end if + DstOtherStateData%C_obj%Fx_anchor_Len = size(DstOtherStateData%Fx_anchor) + if (DstOtherStateData%C_obj%Fx_anchor_Len > 0) & + DstOtherStateData%C_obj%Fx_anchor = c_loc(DstOtherStateData%Fx_anchor(LB(1))) + end if + DstOtherStateData%Fx_anchor = SrcOtherStateData%Fx_anchor + end if + if (associated(SrcOtherStateData%Fy_anchor)) then + LB(1:1) = lbound(SrcOtherStateData%Fy_anchor) + UB(1:1) = ubound(SrcOtherStateData%Fy_anchor) + if (.not. associated(DstOtherStateData%Fy_anchor)) then + allocate(DstOtherStateData%Fy_anchor(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%Fy_anchor.', ErrStat, ErrMsg, RoutineName) + return + end if + DstOtherStateData%C_obj%Fy_anchor_Len = size(DstOtherStateData%Fy_anchor) + if (DstOtherStateData%C_obj%Fy_anchor_Len > 0) & + DstOtherStateData%C_obj%Fy_anchor = c_loc(DstOtherStateData%Fy_anchor(LB(1))) + end if + DstOtherStateData%Fy_anchor = SrcOtherStateData%Fy_anchor + end if + if (associated(SrcOtherStateData%Fz_anchor)) then + LB(1:1) = lbound(SrcOtherStateData%Fz_anchor) + UB(1:1) = ubound(SrcOtherStateData%Fz_anchor) + if (.not. associated(DstOtherStateData%Fz_anchor)) then + allocate(DstOtherStateData%Fz_anchor(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%Fz_anchor.', ErrStat, ErrMsg, RoutineName) + return + end if + DstOtherStateData%C_obj%Fz_anchor_Len = size(DstOtherStateData%Fz_anchor) + if (DstOtherStateData%C_obj%Fz_anchor_Len > 0) & + DstOtherStateData%C_obj%Fz_anchor = c_loc(DstOtherStateData%Fz_anchor(LB(1))) + end if + DstOtherStateData%Fz_anchor = SrcOtherStateData%Fz_anchor + end if +end subroutine + +subroutine MAP_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) + type(MAP_OtherStateType), intent(inout) :: OtherStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'MAP_DestroyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + if (associated(OtherStateData%H)) then + deallocate(OtherStateData%H) + OtherStateData%H => null() + OtherStateData%C_obj%H = c_null_ptr + OtherStateData%C_obj%H_Len = 0 + end if + if (associated(OtherStateData%V)) then + deallocate(OtherStateData%V) + OtherStateData%V => null() + OtherStateData%C_obj%V = c_null_ptr + OtherStateData%C_obj%V_Len = 0 + end if + if (associated(OtherStateData%Ha)) then + deallocate(OtherStateData%Ha) + OtherStateData%Ha => null() + OtherStateData%C_obj%Ha = c_null_ptr + OtherStateData%C_obj%Ha_Len = 0 + end if + if (associated(OtherStateData%Va)) then + deallocate(OtherStateData%Va) + OtherStateData%Va => null() + OtherStateData%C_obj%Va = c_null_ptr + OtherStateData%C_obj%Va_Len = 0 + end if + if (associated(OtherStateData%x)) then + deallocate(OtherStateData%x) + OtherStateData%x => null() + OtherStateData%C_obj%x = c_null_ptr + OtherStateData%C_obj%x_Len = 0 + end if + if (associated(OtherStateData%y)) then + deallocate(OtherStateData%y) + OtherStateData%y => null() + OtherStateData%C_obj%y = c_null_ptr + OtherStateData%C_obj%y_Len = 0 + end if + if (associated(OtherStateData%z)) then + deallocate(OtherStateData%z) + OtherStateData%z => null() + OtherStateData%C_obj%z = c_null_ptr + OtherStateData%C_obj%z_Len = 0 + end if + if (associated(OtherStateData%xa)) then + deallocate(OtherStateData%xa) + OtherStateData%xa => null() + OtherStateData%C_obj%xa = c_null_ptr + OtherStateData%C_obj%xa_Len = 0 + end if + if (associated(OtherStateData%ya)) then + deallocate(OtherStateData%ya) + OtherStateData%ya => null() + OtherStateData%C_obj%ya = c_null_ptr + OtherStateData%C_obj%ya_Len = 0 + end if + if (associated(OtherStateData%za)) then + deallocate(OtherStateData%za) + OtherStateData%za => null() + OtherStateData%C_obj%za = c_null_ptr + OtherStateData%C_obj%za_Len = 0 + end if + if (associated(OtherStateData%Fx_connect)) then + deallocate(OtherStateData%Fx_connect) + OtherStateData%Fx_connect => null() + OtherStateData%C_obj%Fx_connect = c_null_ptr + OtherStateData%C_obj%Fx_connect_Len = 0 + end if + if (associated(OtherStateData%Fy_connect)) then + deallocate(OtherStateData%Fy_connect) + OtherStateData%Fy_connect => null() + OtherStateData%C_obj%Fy_connect = c_null_ptr + OtherStateData%C_obj%Fy_connect_Len = 0 + end if + if (associated(OtherStateData%Fz_connect)) then + deallocate(OtherStateData%Fz_connect) + OtherStateData%Fz_connect => null() + OtherStateData%C_obj%Fz_connect = c_null_ptr + OtherStateData%C_obj%Fz_connect_Len = 0 + end if + if (associated(OtherStateData%Fx_anchor)) then + deallocate(OtherStateData%Fx_anchor) + OtherStateData%Fx_anchor => null() + OtherStateData%C_obj%Fx_anchor = c_null_ptr + OtherStateData%C_obj%Fx_anchor_Len = 0 + end if + if (associated(OtherStateData%Fy_anchor)) then + deallocate(OtherStateData%Fy_anchor) + OtherStateData%Fy_anchor => null() + OtherStateData%C_obj%Fy_anchor = c_null_ptr + OtherStateData%C_obj%Fy_anchor_Len = 0 + end if + if (associated(OtherStateData%Fz_anchor)) then + deallocate(OtherStateData%Fz_anchor) + OtherStateData%Fz_anchor => null() + OtherStateData%C_obj%Fz_anchor = c_null_ptr + OtherStateData%C_obj%Fz_anchor_Len = 0 + end if +end subroutine + +subroutine MAP_PackOtherState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(MAP_OtherStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'MAP_PackOtherState' + logical :: PtrInIndex + if (RF%ErrStat >= AbortErrLev) return + if (c_associated(InData%C_obj%object)) then + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + call RegPackPtr(RF, InData%H) + call RegPackPtr(RF, InData%V) + call RegPackPtr(RF, InData%Ha) + call RegPackPtr(RF, InData%Va) + call RegPackPtr(RF, InData%x) + call RegPackPtr(RF, InData%y) + call RegPackPtr(RF, InData%z) + call RegPackPtr(RF, InData%xa) + call RegPackPtr(RF, InData%ya) + call RegPackPtr(RF, InData%za) + call RegPackPtr(RF, InData%Fx_connect) + call RegPackPtr(RF, InData%Fy_connect) + call RegPackPtr(RF, InData%Fz_connect) + call RegPackPtr(RF, InData%Fx_anchor) + call RegPackPtr(RF, InData%Fy_anchor) + call RegPackPtr(RF, InData%Fz_anchor) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine MAP_UnPackOtherState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(MAP_OtherStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'MAP_UnPackOtherState' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(B8Ki) :: PtrIdx + type(c_ptr) :: Ptr + if (RF%ErrStat /= ErrID_None) return + call RegUnpackPtr(RF, OutData%H, LB, UB); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%H)) then + OutData%C_obj%H_Len = size(OutData%H) + if (OutData%C_obj%H_Len > 0) OutData%C_obj%H = c_loc(OutData%H(LB(1))) + end if + call RegUnpackPtr(RF, OutData%V, LB, UB); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%V)) then + OutData%C_obj%V_Len = size(OutData%V) + if (OutData%C_obj%V_Len > 0) OutData%C_obj%V = c_loc(OutData%V(LB(1))) + end if + call RegUnpackPtr(RF, OutData%Ha, LB, UB); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%Ha)) then + OutData%C_obj%Ha_Len = size(OutData%Ha) + if (OutData%C_obj%Ha_Len > 0) OutData%C_obj%Ha = c_loc(OutData%Ha(LB(1))) + end if + call RegUnpackPtr(RF, OutData%Va, LB, UB); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%Va)) then + OutData%C_obj%Va_Len = size(OutData%Va) + if (OutData%C_obj%Va_Len > 0) OutData%C_obj%Va = c_loc(OutData%Va(LB(1))) + end if + call RegUnpackPtr(RF, OutData%x, LB, UB); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%x)) then + OutData%C_obj%x_Len = size(OutData%x) + if (OutData%C_obj%x_Len > 0) OutData%C_obj%x = c_loc(OutData%x(LB(1))) + end if + call RegUnpackPtr(RF, OutData%y, LB, UB); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%y)) then + OutData%C_obj%y_Len = size(OutData%y) + if (OutData%C_obj%y_Len > 0) OutData%C_obj%y = c_loc(OutData%y(LB(1))) + end if + call RegUnpackPtr(RF, OutData%z, LB, UB); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%z)) then + OutData%C_obj%z_Len = size(OutData%z) + if (OutData%C_obj%z_Len > 0) OutData%C_obj%z = c_loc(OutData%z(LB(1))) + end if + call RegUnpackPtr(RF, OutData%xa, LB, UB); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%xa)) then + OutData%C_obj%xa_Len = size(OutData%xa) + if (OutData%C_obj%xa_Len > 0) OutData%C_obj%xa = c_loc(OutData%xa(LB(1))) + end if + call RegUnpackPtr(RF, OutData%ya, LB, UB); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%ya)) then + OutData%C_obj%ya_Len = size(OutData%ya) + if (OutData%C_obj%ya_Len > 0) OutData%C_obj%ya = c_loc(OutData%ya(LB(1))) + end if + call RegUnpackPtr(RF, OutData%za, LB, UB); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%za)) then + OutData%C_obj%za_Len = size(OutData%za) + if (OutData%C_obj%za_Len > 0) OutData%C_obj%za = c_loc(OutData%za(LB(1))) + end if + call RegUnpackPtr(RF, OutData%Fx_connect, LB, UB); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%Fx_connect)) then + OutData%C_obj%Fx_connect_Len = size(OutData%Fx_connect) + if (OutData%C_obj%Fx_connect_Len > 0) OutData%C_obj%Fx_connect = c_loc(OutData%Fx_connect(LB(1))) + end if + call RegUnpackPtr(RF, OutData%Fy_connect, LB, UB); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%Fy_connect)) then + OutData%C_obj%Fy_connect_Len = size(OutData%Fy_connect) + if (OutData%C_obj%Fy_connect_Len > 0) OutData%C_obj%Fy_connect = c_loc(OutData%Fy_connect(LB(1))) + end if + call RegUnpackPtr(RF, OutData%Fz_connect, LB, UB); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%Fz_connect)) then + OutData%C_obj%Fz_connect_Len = size(OutData%Fz_connect) + if (OutData%C_obj%Fz_connect_Len > 0) OutData%C_obj%Fz_connect = c_loc(OutData%Fz_connect(LB(1))) + end if + call RegUnpackPtr(RF, OutData%Fx_anchor, LB, UB); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%Fx_anchor)) then + OutData%C_obj%Fx_anchor_Len = size(OutData%Fx_anchor) + if (OutData%C_obj%Fx_anchor_Len > 0) OutData%C_obj%Fx_anchor = c_loc(OutData%Fx_anchor(LB(1))) + end if + call RegUnpackPtr(RF, OutData%Fy_anchor, LB, UB); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%Fy_anchor)) then + OutData%C_obj%Fy_anchor_Len = size(OutData%Fy_anchor) + if (OutData%C_obj%Fy_anchor_Len > 0) OutData%C_obj%Fy_anchor = c_loc(OutData%Fy_anchor(LB(1))) + end if + call RegUnpackPtr(RF, OutData%Fz_anchor, LB, UB); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%Fz_anchor)) then + OutData%C_obj%Fz_anchor_Len = size(OutData%Fz_anchor) + if (OutData%C_obj%Fz_anchor_Len > 0) OutData%C_obj%Fz_anchor = c_loc(OutData%Fz_anchor(LB(1))) + end if +end subroutine + +SUBROUTINE MAP_C2Fary_CopyOtherState(OtherStateData, ErrStat, ErrMsg, SkipPointers) + TYPE(MAP_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 + + ! -- H OtherState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%H ) ) THEN + NULLIFY( OtherStateData%H ) + ELSE + CALL C_F_POINTER(OtherStateData%C_obj%H, OtherStateData%H, [OtherStateData%C_obj%H_Len]) END IF - IF(ALLOCATED(Db_Buf)) THEN ! LinInitInp - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) + END IF + + ! -- V OtherState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%V ) ) THEN + NULLIFY( OtherStateData%V ) + ELSE + CALL C_F_POINTER(OtherStateData%C_obj%V, OtherStateData%V, [OtherStateData%C_obj%V_Len]) END IF - IF(ALLOCATED(Int_Buf)) THEN ! LinInitInp - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) + END IF + + ! -- Ha OtherState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%Ha ) ) THEN + NULLIFY( OtherStateData%Ha ) + ELSE + CALL C_F_POINTER(OtherStateData%C_obj%Ha, OtherStateData%Ha, [OtherStateData%C_obj%Ha_Len]) 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%gravity - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%sea_density - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%depth - Db_Xferred = Db_Xferred + 1 - DO I = 1, LEN(InData%file_name) - IntKiBuf(Int_Xferred) = ICHAR(InData%file_name(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%summary_file_name) - IntKiBuf(Int_Xferred) = ICHAR(InData%summary_file_name(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%library_input_str) - IntKiBuf(Int_Xferred) = ICHAR(InData%library_input_str(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%node_input_str) - IntKiBuf(Int_Xferred) = ICHAR(InData%node_input_str(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%line_input_str) - IntKiBuf(Int_Xferred) = ICHAR(InData%line_input_str(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%option_input_str) - IntKiBuf(Int_Xferred) = ICHAR(InData%option_input_str(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - CALL MAP_Fortran_Packlin_initinputtype( Re_Buf, Db_Buf, Int_Buf, InData%LinInitInp, ErrStat2, ErrMsg2, OnlySize ) ! LinInitInp - 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) + END IF + + ! -- Va OtherState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%Va ) ) THEN + NULLIFY( OtherStateData%Va ) 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) + CALL C_F_POINTER(OtherStateData%C_obj%Va, OtherStateData%Va, [OtherStateData%C_obj%Va_Len]) + END IF + END IF + + ! -- x OtherState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%x ) ) THEN + NULLIFY( OtherStateData%x ) 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) + CALL C_F_POINTER(OtherStateData%C_obj%x, OtherStateData%x, [OtherStateData%C_obj%x_Len]) + END IF + END IF + + ! -- y OtherState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%y ) ) THEN + NULLIFY( OtherStateData%y ) ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END SUBROUTINE MAP_PackInitInput - - SUBROUTINE MAP_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(MAP_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 = 'MAP_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%gravity = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%C_obj%gravity = OutData%gravity - OutData%sea_density = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%C_obj%sea_density = OutData%sea_density - OutData%depth = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%C_obj%depth = OutData%depth - DO I = 1, LEN(OutData%file_name) - OutData%file_name(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%C_obj%file_name = TRANSFER(OutData%file_name, OutData%C_obj%file_name ) - DO I = 1, LEN(OutData%summary_file_name) - OutData%summary_file_name(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%C_obj%summary_file_name = TRANSFER(OutData%summary_file_name, OutData%C_obj%summary_file_name ) - DO I = 1, LEN(OutData%library_input_str) - OutData%library_input_str(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%C_obj%library_input_str = TRANSFER(OutData%library_input_str, OutData%C_obj%library_input_str ) - DO I = 1, LEN(OutData%node_input_str) - OutData%node_input_str(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%C_obj%node_input_str = TRANSFER(OutData%node_input_str, OutData%C_obj%node_input_str ) - DO I = 1, LEN(OutData%line_input_str) - OutData%line_input_str(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%C_obj%line_input_str = TRANSFER(OutData%line_input_str, OutData%C_obj%line_input_str ) - DO I = 1, LEN(OutData%option_input_str) - OutData%option_input_str(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%C_obj%option_input_str = TRANSFER(OutData%option_input_str, OutData%C_obj%option_input_str ) - 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 + CALL C_F_POINTER(OtherStateData%C_obj%y, OtherStateData%y, [OtherStateData%C_obj%y_Len]) 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 + + ! -- z OtherState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%z ) ) THEN + NULLIFY( OtherStateData%z ) + ELSE + CALL C_F_POINTER(OtherStateData%C_obj%z, OtherStateData%z, [OtherStateData%C_obj%z_Len]) 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 + + ! -- xa OtherState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%xa ) ) THEN + NULLIFY( OtherStateData%xa ) + ELSE + CALL C_F_POINTER(OtherStateData%C_obj%xa, OtherStateData%xa, [OtherStateData%C_obj%xa_Len]) END IF - CALL MAP_Fortran_Unpacklin_initinputtype( Re_Buf, Db_Buf, Int_Buf, OutData%LinInitInp, ErrStat2, ErrMsg2 ) ! LinInitInp - 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 MAP_UnPackInitInput - - SUBROUTINE MAP_C2Fary_CopyInitInput( InitInputData, ErrStat, ErrMsg, SkipPointers ) - TYPE(MAP_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%gravity = InitInputData%C_obj%gravity - InitInputData%sea_density = InitInputData%C_obj%sea_density - InitInputData%depth = InitInputData%C_obj%depth - InitInputData%file_name = TRANSFER(InitInputData%C_obj%file_name, InitInputData%file_name ) - InitInputData%summary_file_name = TRANSFER(InitInputData%C_obj%summary_file_name, InitInputData%summary_file_name ) - InitInputData%library_input_str = TRANSFER(InitInputData%C_obj%library_input_str, InitInputData%library_input_str ) - InitInputData%node_input_str = TRANSFER(InitInputData%C_obj%node_input_str, InitInputData%node_input_str ) - InitInputData%line_input_str = TRANSFER(InitInputData%C_obj%line_input_str, InitInputData%line_input_str ) - InitInputData%option_input_str = TRANSFER(InitInputData%C_obj%option_input_str, InitInputData%option_input_str ) - END SUBROUTINE MAP_C2Fary_CopyInitInput - - SUBROUTINE MAP_F2C_CopyInitInput( InitInputData, ErrStat, ErrMsg, SkipPointers ) - TYPE(MAP_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%gravity = InitInputData%gravity - InitInputData%C_obj%sea_density = InitInputData%sea_density - InitInputData%C_obj%depth = InitInputData%depth - InitInputData%C_obj%file_name = TRANSFER(InitInputData%file_name, InitInputData%C_obj%file_name ) - InitInputData%C_obj%summary_file_name = TRANSFER(InitInputData%summary_file_name, InitInputData%C_obj%summary_file_name ) - InitInputData%C_obj%library_input_str = TRANSFER(InitInputData%library_input_str, InitInputData%C_obj%library_input_str ) - InitInputData%C_obj%node_input_str = TRANSFER(InitInputData%node_input_str, InitInputData%C_obj%node_input_str ) - InitInputData%C_obj%line_input_str = TRANSFER(InitInputData%line_input_str, InitInputData%C_obj%line_input_str ) - InitInputData%C_obj%option_input_str = TRANSFER(InitInputData%option_input_str, InitInputData%C_obj%option_input_str ) - END SUBROUTINE MAP_F2C_CopyInitInput + END IF + + ! -- ya OtherState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%ya ) ) THEN + NULLIFY( OtherStateData%ya ) + ELSE + CALL C_F_POINTER(OtherStateData%C_obj%ya, OtherStateData%ya, [OtherStateData%C_obj%ya_Len]) + END IF + END IF + + ! -- za OtherState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%za ) ) THEN + NULLIFY( OtherStateData%za ) + ELSE + CALL C_F_POINTER(OtherStateData%C_obj%za, OtherStateData%za, [OtherStateData%C_obj%za_Len]) + END IF + END IF + + ! -- Fx_connect OtherState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%Fx_connect ) ) THEN + NULLIFY( OtherStateData%Fx_connect ) + ELSE + CALL C_F_POINTER(OtherStateData%C_obj%Fx_connect, OtherStateData%Fx_connect, [OtherStateData%C_obj%Fx_connect_Len]) + END IF + END IF + + ! -- Fy_connect OtherState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%Fy_connect ) ) THEN + NULLIFY( OtherStateData%Fy_connect ) + ELSE + CALL C_F_POINTER(OtherStateData%C_obj%Fy_connect, OtherStateData%Fy_connect, [OtherStateData%C_obj%Fy_connect_Len]) + END IF + END IF + + ! -- Fz_connect OtherState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%Fz_connect ) ) THEN + NULLIFY( OtherStateData%Fz_connect ) + ELSE + CALL C_F_POINTER(OtherStateData%C_obj%Fz_connect, OtherStateData%Fz_connect, [OtherStateData%C_obj%Fz_connect_Len]) + END IF + END IF + + ! -- Fx_anchor OtherState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%Fx_anchor ) ) THEN + NULLIFY( OtherStateData%Fx_anchor ) + ELSE + CALL C_F_POINTER(OtherStateData%C_obj%Fx_anchor, OtherStateData%Fx_anchor, [OtherStateData%C_obj%Fx_anchor_Len]) + END IF + END IF + + ! -- Fy_anchor OtherState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%Fy_anchor ) ) THEN + NULLIFY( OtherStateData%Fy_anchor ) + ELSE + CALL C_F_POINTER(OtherStateData%C_obj%Fy_anchor, OtherStateData%Fy_anchor, [OtherStateData%C_obj%Fy_anchor_Len]) + END IF + END IF + + ! -- Fz_anchor OtherState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%Fz_anchor ) ) THEN + NULLIFY( OtherStateData%Fz_anchor ) + ELSE + CALL C_F_POINTER(OtherStateData%C_obj%Fz_anchor, OtherStateData%Fz_anchor, [OtherStateData%C_obj%Fz_anchor_Len]) + END IF + END IF +END SUBROUTINE - SUBROUTINE MAP_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MAP_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(MAP_InitOutputType), INTENT(INOUT) :: DstInitOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode +SUBROUTINE MAP_F2C_CopyOtherState( OtherStateData, ErrStat, ErrMsg, SkipPointers ) + TYPE(MAP_OtherStateType), INTENT(INOUT) :: OtherStateData 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 = 'MAP_CopyInitOutput' -! + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local ErrStat = ErrID_None - ErrMsg = "" - DstInitOutputData%progName = SrcInitOutputData%progName - DstInitOutputData%C_obj%progName = SrcInitOutputData%C_obj%progName - DstInitOutputData%version = SrcInitOutputData%version - DstInitOutputData%C_obj%version = SrcInitOutputData%C_obj%version - DstInitOutputData%compilingData = SrcInitOutputData%compilingData - DstInitOutputData%C_obj%compilingData = SrcInitOutputData%C_obj%compilingData -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 - CALL MAP_Fortran_Copylin_initoutputtype( SrcInitOutputData%LinInitOut, DstInitOutputData%LinInitOut, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE MAP_CopyInitOutput - - SUBROUTINE MAP_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(MAP_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MAP_DestroyInitOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(InitOutputData%writeOutputHdr)) THEN - DEALLOCATE(InitOutputData%writeOutputHdr) -ENDIF -IF (ALLOCATED(InitOutputData%writeOutputUnt)) THEN - DEALLOCATE(InitOutputData%writeOutputUnt) -ENDIF - CALL NWTC_Library_Destroyprogdesc( InitOutputData%Ver, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MAP_Fortran_Destroylin_initoutputtype( InitOutputData%LinInitOut, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE MAP_DestroyInitOutput - - SUBROUTINE MAP_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(MAP_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 = 'MAP_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*LEN(InData%progName) ! progName - Int_BufSz = Int_BufSz + 1*LEN(InData%version) ! version - Int_BufSz = Int_BufSz + 1*LEN(InData%compilingData) ! compilingData - 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) + ErrMsg = '' + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + + ! -- H OtherState Data fields + IF (.NOT. SkipPointers_local ) THEN + IF (.NOT. ASSOCIATED(OtherStateData%H)) THEN + OtherStateData%C_obj%H_Len = 0 + OtherStateData%C_obj%H = C_NULL_PTR + ELSE + OtherStateData%C_obj%H_Len = SIZE(OtherStateData%H) + IF (OtherStateData%C_obj%H_Len > 0) & + OtherStateData%C_obj%H = C_LOC(OtherStateData%H(lbound(OtherStateData%H,1))) END IF - IF(ALLOCATED(Int_Buf)) THEN ! Ver - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) + END IF + + ! -- V OtherState Data fields + IF (.NOT. SkipPointers_local ) THEN + IF (.NOT. ASSOCIATED(OtherStateData%V)) THEN + OtherStateData%C_obj%V_Len = 0 + OtherStateData%C_obj%V = C_NULL_PTR + ELSE + OtherStateData%C_obj%V_Len = SIZE(OtherStateData%V) + IF (OtherStateData%C_obj%V_Len > 0) & + OtherStateData%C_obj%V = C_LOC(OtherStateData%V(lbound(OtherStateData%V,1))) END IF - Int_BufSz = Int_BufSz + 3 ! LinInitOut: size of buffers for each call to pack subtype - CALL MAP_Fortran_Packlin_initoutputtype( Re_Buf, Db_Buf, Int_Buf, InData%LinInitOut, ErrStat2, ErrMsg2, .TRUE. ) ! LinInitOut - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! LinInitOut - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) + END IF + + ! -- Ha OtherState Data fields + IF (.NOT. SkipPointers_local ) THEN + IF (.NOT. ASSOCIATED(OtherStateData%Ha)) THEN + OtherStateData%C_obj%Ha_Len = 0 + OtherStateData%C_obj%Ha = C_NULL_PTR + ELSE + OtherStateData%C_obj%Ha_Len = SIZE(OtherStateData%Ha) + IF (OtherStateData%C_obj%Ha_Len > 0) & + OtherStateData%C_obj%Ha = C_LOC(OtherStateData%Ha(lbound(OtherStateData%Ha,1))) END IF - IF(ALLOCATED(Db_Buf)) THEN ! LinInitOut - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) + END IF + + ! -- Va OtherState Data fields + IF (.NOT. SkipPointers_local ) THEN + IF (.NOT. ASSOCIATED(OtherStateData%Va)) THEN + OtherStateData%C_obj%Va_Len = 0 + OtherStateData%C_obj%Va = C_NULL_PTR + ELSE + OtherStateData%C_obj%Va_Len = SIZE(OtherStateData%Va) + IF (OtherStateData%C_obj%Va_Len > 0) & + OtherStateData%C_obj%Va = C_LOC(OtherStateData%Va(lbound(OtherStateData%Va,1))) END IF - IF(ALLOCATED(Int_Buf)) THEN ! LinInitOut - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) + END IF + + ! -- x OtherState Data fields + IF (.NOT. SkipPointers_local ) THEN + IF (.NOT. ASSOCIATED(OtherStateData%x)) THEN + OtherStateData%C_obj%x_Len = 0 + OtherStateData%C_obj%x = C_NULL_PTR + ELSE + OtherStateData%C_obj%x_Len = SIZE(OtherStateData%x) + IF (OtherStateData%C_obj%x_Len > 0) & + OtherStateData%C_obj%x = C_LOC(OtherStateData%x(lbound(OtherStateData%x,1))) 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 - - DO I = 1, LEN(InData%progName) - IntKiBuf(Int_Xferred) = ICHAR(InData%progName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%version) - IntKiBuf(Int_Xferred) = ICHAR(InData%version(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%compilingData) - IntKiBuf(Int_Xferred) = ICHAR(InData%compilingData(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - 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) + END IF + + ! -- y OtherState Data fields + IF (.NOT. SkipPointers_local ) THEN + IF (.NOT. ASSOCIATED(OtherStateData%y)) THEN + OtherStateData%C_obj%y_Len = 0 + OtherStateData%C_obj%y = C_NULL_PTR 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) + OtherStateData%C_obj%y_Len = SIZE(OtherStateData%y) + IF (OtherStateData%C_obj%y_Len > 0) & + OtherStateData%C_obj%y = C_LOC(OtherStateData%y(lbound(OtherStateData%y,1))) + END IF + END IF + + ! -- z OtherState Data fields + IF (.NOT. SkipPointers_local ) THEN + IF (.NOT. ASSOCIATED(OtherStateData%z)) THEN + OtherStateData%C_obj%z_Len = 0 + OtherStateData%C_obj%z = C_NULL_PTR 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) + OtherStateData%C_obj%z_Len = SIZE(OtherStateData%z) + IF (OtherStateData%C_obj%z_Len > 0) & + OtherStateData%C_obj%z = C_LOC(OtherStateData%z(lbound(OtherStateData%z,1))) + END IF + END IF + + ! -- xa OtherState Data fields + IF (.NOT. SkipPointers_local ) THEN + IF (.NOT. ASSOCIATED(OtherStateData%xa)) THEN + OtherStateData%C_obj%xa_Len = 0 + OtherStateData%C_obj%xa = C_NULL_PTR ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL MAP_Fortran_Packlin_initoutputtype( Re_Buf, Db_Buf, Int_Buf, InData%LinInitOut, ErrStat2, ErrMsg2, OnlySize ) ! LinInitOut - 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) + OtherStateData%C_obj%xa_Len = SIZE(OtherStateData%xa) + IF (OtherStateData%C_obj%xa_Len > 0) & + OtherStateData%C_obj%xa = C_LOC(OtherStateData%xa(lbound(OtherStateData%xa,1))) + END IF + END IF + + ! -- ya OtherState Data fields + IF (.NOT. SkipPointers_local ) THEN + IF (.NOT. ASSOCIATED(OtherStateData%ya)) THEN + OtherStateData%C_obj%ya_Len = 0 + OtherStateData%C_obj%ya = C_NULL_PTR 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) + OtherStateData%C_obj%ya_Len = SIZE(OtherStateData%ya) + IF (OtherStateData%C_obj%ya_Len > 0) & + OtherStateData%C_obj%ya = C_LOC(OtherStateData%ya(lbound(OtherStateData%ya,1))) + END IF + END IF + + ! -- za OtherState Data fields + IF (.NOT. SkipPointers_local ) THEN + IF (.NOT. ASSOCIATED(OtherStateData%za)) THEN + OtherStateData%C_obj%za_Len = 0 + OtherStateData%C_obj%za = C_NULL_PTR 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) + OtherStateData%C_obj%za_Len = SIZE(OtherStateData%za) + IF (OtherStateData%C_obj%za_Len > 0) & + OtherStateData%C_obj%za = C_LOC(OtherStateData%za(lbound(OtherStateData%za,1))) + END IF + END IF + + ! -- Fx_connect OtherState Data fields + IF (.NOT. SkipPointers_local ) THEN + IF (.NOT. ASSOCIATED(OtherStateData%Fx_connect)) THEN + OtherStateData%C_obj%Fx_connect_Len = 0 + OtherStateData%C_obj%Fx_connect = C_NULL_PTR ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END SUBROUTINE MAP_PackInitOutput - - SUBROUTINE MAP_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(MAP_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 = 'MAP_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 - DO I = 1, LEN(OutData%progName) - OutData%progName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%C_obj%progName = TRANSFER(OutData%progName, OutData%C_obj%progName ) - DO I = 1, LEN(OutData%version) - OutData%version(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%C_obj%version = TRANSFER(OutData%version, OutData%C_obj%version ) - DO I = 1, LEN(OutData%compilingData) - OutData%compilingData(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%C_obj%compilingData = TRANSFER(OutData%compilingData, OutData%C_obj%compilingData ) - 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 + OtherStateData%C_obj%Fx_connect_Len = SIZE(OtherStateData%Fx_connect) + IF (OtherStateData%C_obj%Fx_connect_Len > 0) & + OtherStateData%C_obj%Fx_connect = C_LOC(OtherStateData%Fx_connect(lbound(OtherStateData%Fx_connect,1))) 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 + + ! -- Fy_connect OtherState Data fields + IF (.NOT. SkipPointers_local ) THEN + IF (.NOT. ASSOCIATED(OtherStateData%Fy_connect)) THEN + OtherStateData%C_obj%Fy_connect_Len = 0 + OtherStateData%C_obj%Fy_connect = C_NULL_PTR + ELSE + OtherStateData%C_obj%Fy_connect_Len = SIZE(OtherStateData%Fy_connect) + IF (OtherStateData%C_obj%Fy_connect_Len > 0) & + OtherStateData%C_obj%Fy_connect = C_LOC(OtherStateData%Fy_connect(lbound(OtherStateData%Fy_connect,1))) 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 + + ! -- Fz_connect OtherState Data fields + IF (.NOT. SkipPointers_local ) THEN + IF (.NOT. ASSOCIATED(OtherStateData%Fz_connect)) THEN + OtherStateData%C_obj%Fz_connect_Len = 0 + OtherStateData%C_obj%Fz_connect = C_NULL_PTR + ELSE + OtherStateData%C_obj%Fz_connect_Len = SIZE(OtherStateData%Fz_connect) + IF (OtherStateData%C_obj%Fz_connect_Len > 0) & + OtherStateData%C_obj%Fz_connect = C_LOC(OtherStateData%Fz_connect(lbound(OtherStateData%Fz_connect,1))) 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) - 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 + + ! -- Fx_anchor OtherState Data fields + IF (.NOT. SkipPointers_local ) THEN + IF (.NOT. ASSOCIATED(OtherStateData%Fx_anchor)) THEN + OtherStateData%C_obj%Fx_anchor_Len = 0 + OtherStateData%C_obj%Fx_anchor = C_NULL_PTR + ELSE + OtherStateData%C_obj%Fx_anchor_Len = SIZE(OtherStateData%Fx_anchor) + IF (OtherStateData%C_obj%Fx_anchor_Len > 0) & + OtherStateData%C_obj%Fx_anchor = C_LOC(OtherStateData%Fx_anchor(lbound(OtherStateData%Fx_anchor,1))) 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 + + ! -- Fy_anchor OtherState Data fields + IF (.NOT. SkipPointers_local ) THEN + IF (.NOT. ASSOCIATED(OtherStateData%Fy_anchor)) THEN + OtherStateData%C_obj%Fy_anchor_Len = 0 + OtherStateData%C_obj%Fy_anchor = C_NULL_PTR + ELSE + OtherStateData%C_obj%Fy_anchor_Len = SIZE(OtherStateData%Fy_anchor) + IF (OtherStateData%C_obj%Fy_anchor_Len > 0) & + OtherStateData%C_obj%Fy_anchor = C_LOC(OtherStateData%Fy_anchor(lbound(OtherStateData%Fy_anchor,1))) 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 + + ! -- Fz_anchor OtherState Data fields + IF (.NOT. SkipPointers_local ) THEN + IF (.NOT. ASSOCIATED(OtherStateData%Fz_anchor)) THEN + OtherStateData%C_obj%Fz_anchor_Len = 0 + OtherStateData%C_obj%Fz_anchor = C_NULL_PTR + ELSE + OtherStateData%C_obj%Fz_anchor_Len = SIZE(OtherStateData%Fz_anchor) + IF (OtherStateData%C_obj%Fz_anchor_Len > 0) & + OtherStateData%C_obj%Fz_anchor = C_LOC(OtherStateData%Fz_anchor(lbound(OtherStateData%Fz_anchor,1))) END IF - CALL MAP_Fortran_Unpacklin_initoutputtype( Re_Buf, Db_Buf, Int_Buf, OutData%LinInitOut, ErrStat2, ErrMsg2 ) ! LinInitOut - 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 MAP_UnPackInitOutput - - SUBROUTINE MAP_C2Fary_CopyInitOutput( InitOutputData, ErrStat, ErrMsg, SkipPointers ) - TYPE(MAP_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%progName = TRANSFER(InitOutputData%C_obj%progName, InitOutputData%progName ) - InitOutputData%version = TRANSFER(InitOutputData%C_obj%version, InitOutputData%version ) - InitOutputData%compilingData = TRANSFER(InitOutputData%C_obj%compilingData, InitOutputData%compilingData ) - END SUBROUTINE MAP_C2Fary_CopyInitOutput - - SUBROUTINE MAP_F2C_CopyInitOutput( InitOutputData, ErrStat, ErrMsg, SkipPointers ) - TYPE(MAP_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%progName = TRANSFER(InitOutputData%progName, InitOutputData%C_obj%progName ) - InitOutputData%C_obj%version = TRANSFER(InitOutputData%version, InitOutputData%C_obj%version ) - InitOutputData%C_obj%compilingData = TRANSFER(InitOutputData%compilingData, InitOutputData%C_obj%compilingData ) - END SUBROUTINE MAP_F2C_CopyInitOutput - - SUBROUTINE MAP_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MAP_ContinuousStateType), INTENT(IN) :: SrcContStateData - TYPE(MAP_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 = 'MAP_CopyContState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstContStateData%dummy = SrcContStateData%dummy - DstContStateData%C_obj%dummy = SrcContStateData%C_obj%dummy - END SUBROUTINE MAP_CopyContState - - SUBROUTINE MAP_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(MAP_ContinuousStateType), INTENT(INOUT) :: ContStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MAP_DestroyContState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE MAP_DestroyContState - - SUBROUTINE MAP_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(MAP_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 = 'MAP_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 - Db_BufSz = Db_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 - - DbKiBuf(Db_Xferred) = InData%dummy - Db_Xferred = Db_Xferred + 1 - END SUBROUTINE MAP_PackContState - - SUBROUTINE MAP_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(MAP_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 = 'MAP_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(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%C_obj%dummy = OutData%dummy - END SUBROUTINE MAP_UnPackContState - - SUBROUTINE MAP_C2Fary_CopyContState( ContStateData, ErrStat, ErrMsg, SkipPointers ) - TYPE(MAP_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 MAP_C2Fary_CopyContState - - SUBROUTINE MAP_F2C_CopyContState( ContStateData, ErrStat, ErrMsg, SkipPointers ) - TYPE(MAP_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 MAP_F2C_CopyContState - - SUBROUTINE MAP_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MAP_DiscreteStateType), INTENT(IN) :: SrcDiscStateData - TYPE(MAP_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 = 'MAP_CopyDiscState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstDiscStateData%dummy = SrcDiscStateData%dummy - DstDiscStateData%C_obj%dummy = SrcDiscStateData%C_obj%dummy - END SUBROUTINE MAP_CopyDiscState - - SUBROUTINE MAP_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(MAP_DiscreteStateType), INTENT(INOUT) :: DiscStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MAP_DestroyDiscState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE MAP_DestroyDiscState - - SUBROUTINE MAP_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(MAP_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 = 'MAP_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 - Db_BufSz = Db_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 - - DbKiBuf(Db_Xferred) = InData%dummy - Db_Xferred = Db_Xferred + 1 - END SUBROUTINE MAP_PackDiscState - - SUBROUTINE MAP_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(MAP_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 = 'MAP_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 = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%C_obj%dummy = OutData%dummy - END SUBROUTINE MAP_UnPackDiscState - - SUBROUTINE MAP_C2Fary_CopyDiscState( DiscStateData, ErrStat, ErrMsg, SkipPointers ) - TYPE(MAP_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 - DiscStateData%dummy = DiscStateData%C_obj%dummy - END SUBROUTINE MAP_C2Fary_CopyDiscState - - SUBROUTINE MAP_F2C_CopyDiscState( DiscStateData, ErrStat, ErrMsg, SkipPointers ) - TYPE(MAP_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 - DiscStateData%C_obj%dummy = DiscStateData%dummy - END SUBROUTINE MAP_F2C_CopyDiscState - - SUBROUTINE MAP_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MAP_OtherStateType), INTENT(IN) :: SrcOtherStateData - TYPE(MAP_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 = 'MAP_CopyOtherState' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ASSOCIATED(SrcOtherStateData%H)) THEN - i1_l = LBOUND(SrcOtherStateData%H,1) - i1_u = UBOUND(SrcOtherStateData%H,1) - IF (.NOT. ASSOCIATED(DstOtherStateData%H)) THEN - ALLOCATE(DstOtherStateData%H(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%H.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstOtherStateData%c_obj%H_Len = SIZE(DstOtherStateData%H) - IF (DstOtherStateData%c_obj%H_Len > 0) & - DstOtherStateData%c_obj%H = C_LOC( DstOtherStateData%H( i1_l ) ) - END IF - DstOtherStateData%H = SrcOtherStateData%H -ENDIF -IF (ASSOCIATED(SrcOtherStateData%V)) THEN - i1_l = LBOUND(SrcOtherStateData%V,1) - i1_u = UBOUND(SrcOtherStateData%V,1) - IF (.NOT. ASSOCIATED(DstOtherStateData%V)) THEN - ALLOCATE(DstOtherStateData%V(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%V.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstOtherStateData%c_obj%V_Len = SIZE(DstOtherStateData%V) - IF (DstOtherStateData%c_obj%V_Len > 0) & - DstOtherStateData%c_obj%V = C_LOC( DstOtherStateData%V( i1_l ) ) - END IF - DstOtherStateData%V = SrcOtherStateData%V -ENDIF -IF (ASSOCIATED(SrcOtherStateData%Ha)) THEN - i1_l = LBOUND(SrcOtherStateData%Ha,1) - i1_u = UBOUND(SrcOtherStateData%Ha,1) - IF (.NOT. ASSOCIATED(DstOtherStateData%Ha)) THEN - ALLOCATE(DstOtherStateData%Ha(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%Ha.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstOtherStateData%c_obj%Ha_Len = SIZE(DstOtherStateData%Ha) - IF (DstOtherStateData%c_obj%Ha_Len > 0) & - DstOtherStateData%c_obj%Ha = C_LOC( DstOtherStateData%Ha( i1_l ) ) - END IF - DstOtherStateData%Ha = SrcOtherStateData%Ha -ENDIF -IF (ASSOCIATED(SrcOtherStateData%Va)) THEN - i1_l = LBOUND(SrcOtherStateData%Va,1) - i1_u = UBOUND(SrcOtherStateData%Va,1) - IF (.NOT. ASSOCIATED(DstOtherStateData%Va)) THEN - ALLOCATE(DstOtherStateData%Va(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%Va.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstOtherStateData%c_obj%Va_Len = SIZE(DstOtherStateData%Va) - IF (DstOtherStateData%c_obj%Va_Len > 0) & - DstOtherStateData%c_obj%Va = C_LOC( DstOtherStateData%Va( i1_l ) ) - END IF - DstOtherStateData%Va = SrcOtherStateData%Va -ENDIF -IF (ASSOCIATED(SrcOtherStateData%x)) THEN - i1_l = LBOUND(SrcOtherStateData%x,1) - i1_u = UBOUND(SrcOtherStateData%x,1) - IF (.NOT. ASSOCIATED(DstOtherStateData%x)) THEN - ALLOCATE(DstOtherStateData%x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstOtherStateData%c_obj%x_Len = SIZE(DstOtherStateData%x) - IF (DstOtherStateData%c_obj%x_Len > 0) & - DstOtherStateData%c_obj%x = C_LOC( DstOtherStateData%x( i1_l ) ) - END IF - DstOtherStateData%x = SrcOtherStateData%x -ENDIF -IF (ASSOCIATED(SrcOtherStateData%y)) THEN - i1_l = LBOUND(SrcOtherStateData%y,1) - i1_u = UBOUND(SrcOtherStateData%y,1) - IF (.NOT. ASSOCIATED(DstOtherStateData%y)) THEN - ALLOCATE(DstOtherStateData%y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstOtherStateData%c_obj%y_Len = SIZE(DstOtherStateData%y) - IF (DstOtherStateData%c_obj%y_Len > 0) & - DstOtherStateData%c_obj%y = C_LOC( DstOtherStateData%y( i1_l ) ) - END IF - DstOtherStateData%y = SrcOtherStateData%y -ENDIF -IF (ASSOCIATED(SrcOtherStateData%z)) THEN - i1_l = LBOUND(SrcOtherStateData%z,1) - i1_u = UBOUND(SrcOtherStateData%z,1) - IF (.NOT. ASSOCIATED(DstOtherStateData%z)) THEN - ALLOCATE(DstOtherStateData%z(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%z.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstOtherStateData%c_obj%z_Len = SIZE(DstOtherStateData%z) - IF (DstOtherStateData%c_obj%z_Len > 0) & - DstOtherStateData%c_obj%z = C_LOC( DstOtherStateData%z( i1_l ) ) - END IF - DstOtherStateData%z = SrcOtherStateData%z -ENDIF -IF (ASSOCIATED(SrcOtherStateData%xa)) THEN - i1_l = LBOUND(SrcOtherStateData%xa,1) - i1_u = UBOUND(SrcOtherStateData%xa,1) - IF (.NOT. ASSOCIATED(DstOtherStateData%xa)) THEN - ALLOCATE(DstOtherStateData%xa(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%xa.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstOtherStateData%c_obj%xa_Len = SIZE(DstOtherStateData%xa) - IF (DstOtherStateData%c_obj%xa_Len > 0) & - DstOtherStateData%c_obj%xa = C_LOC( DstOtherStateData%xa( i1_l ) ) - END IF - DstOtherStateData%xa = SrcOtherStateData%xa -ENDIF -IF (ASSOCIATED(SrcOtherStateData%ya)) THEN - i1_l = LBOUND(SrcOtherStateData%ya,1) - i1_u = UBOUND(SrcOtherStateData%ya,1) - IF (.NOT. ASSOCIATED(DstOtherStateData%ya)) THEN - ALLOCATE(DstOtherStateData%ya(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%ya.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstOtherStateData%c_obj%ya_Len = SIZE(DstOtherStateData%ya) - IF (DstOtherStateData%c_obj%ya_Len > 0) & - DstOtherStateData%c_obj%ya = C_LOC( DstOtherStateData%ya( i1_l ) ) - END IF - DstOtherStateData%ya = SrcOtherStateData%ya -ENDIF -IF (ASSOCIATED(SrcOtherStateData%za)) THEN - i1_l = LBOUND(SrcOtherStateData%za,1) - i1_u = UBOUND(SrcOtherStateData%za,1) - IF (.NOT. ASSOCIATED(DstOtherStateData%za)) THEN - ALLOCATE(DstOtherStateData%za(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%za.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstOtherStateData%c_obj%za_Len = SIZE(DstOtherStateData%za) - IF (DstOtherStateData%c_obj%za_Len > 0) & - DstOtherStateData%c_obj%za = C_LOC( DstOtherStateData%za( i1_l ) ) - END IF - DstOtherStateData%za = SrcOtherStateData%za -ENDIF -IF (ASSOCIATED(SrcOtherStateData%Fx_connect)) THEN - i1_l = LBOUND(SrcOtherStateData%Fx_connect,1) - i1_u = UBOUND(SrcOtherStateData%Fx_connect,1) - IF (.NOT. ASSOCIATED(DstOtherStateData%Fx_connect)) THEN - ALLOCATE(DstOtherStateData%Fx_connect(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%Fx_connect.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstOtherStateData%c_obj%Fx_connect_Len = SIZE(DstOtherStateData%Fx_connect) - IF (DstOtherStateData%c_obj%Fx_connect_Len > 0) & - DstOtherStateData%c_obj%Fx_connect = C_LOC( DstOtherStateData%Fx_connect( i1_l ) ) - END IF - DstOtherStateData%Fx_connect = SrcOtherStateData%Fx_connect -ENDIF -IF (ASSOCIATED(SrcOtherStateData%Fy_connect)) THEN - i1_l = LBOUND(SrcOtherStateData%Fy_connect,1) - i1_u = UBOUND(SrcOtherStateData%Fy_connect,1) - IF (.NOT. ASSOCIATED(DstOtherStateData%Fy_connect)) THEN - ALLOCATE(DstOtherStateData%Fy_connect(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%Fy_connect.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstOtherStateData%c_obj%Fy_connect_Len = SIZE(DstOtherStateData%Fy_connect) - IF (DstOtherStateData%c_obj%Fy_connect_Len > 0) & - DstOtherStateData%c_obj%Fy_connect = C_LOC( DstOtherStateData%Fy_connect( i1_l ) ) - END IF - DstOtherStateData%Fy_connect = SrcOtherStateData%Fy_connect -ENDIF -IF (ASSOCIATED(SrcOtherStateData%Fz_connect)) THEN - i1_l = LBOUND(SrcOtherStateData%Fz_connect,1) - i1_u = UBOUND(SrcOtherStateData%Fz_connect,1) - IF (.NOT. ASSOCIATED(DstOtherStateData%Fz_connect)) THEN - ALLOCATE(DstOtherStateData%Fz_connect(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%Fz_connect.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstOtherStateData%c_obj%Fz_connect_Len = SIZE(DstOtherStateData%Fz_connect) - IF (DstOtherStateData%c_obj%Fz_connect_Len > 0) & - DstOtherStateData%c_obj%Fz_connect = C_LOC( DstOtherStateData%Fz_connect( i1_l ) ) - END IF - DstOtherStateData%Fz_connect = SrcOtherStateData%Fz_connect -ENDIF -IF (ASSOCIATED(SrcOtherStateData%Fx_anchor)) THEN - i1_l = LBOUND(SrcOtherStateData%Fx_anchor,1) - i1_u = UBOUND(SrcOtherStateData%Fx_anchor,1) - IF (.NOT. ASSOCIATED(DstOtherStateData%Fx_anchor)) THEN - ALLOCATE(DstOtherStateData%Fx_anchor(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%Fx_anchor.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstOtherStateData%c_obj%Fx_anchor_Len = SIZE(DstOtherStateData%Fx_anchor) - IF (DstOtherStateData%c_obj%Fx_anchor_Len > 0) & - DstOtherStateData%c_obj%Fx_anchor = C_LOC( DstOtherStateData%Fx_anchor( i1_l ) ) - END IF - DstOtherStateData%Fx_anchor = SrcOtherStateData%Fx_anchor -ENDIF -IF (ASSOCIATED(SrcOtherStateData%Fy_anchor)) THEN - i1_l = LBOUND(SrcOtherStateData%Fy_anchor,1) - i1_u = UBOUND(SrcOtherStateData%Fy_anchor,1) - IF (.NOT. ASSOCIATED(DstOtherStateData%Fy_anchor)) THEN - ALLOCATE(DstOtherStateData%Fy_anchor(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%Fy_anchor.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstOtherStateData%c_obj%Fy_anchor_Len = SIZE(DstOtherStateData%Fy_anchor) - IF (DstOtherStateData%c_obj%Fy_anchor_Len > 0) & - DstOtherStateData%c_obj%Fy_anchor = C_LOC( DstOtherStateData%Fy_anchor( i1_l ) ) - END IF - DstOtherStateData%Fy_anchor = SrcOtherStateData%Fy_anchor -ENDIF -IF (ASSOCIATED(SrcOtherStateData%Fz_anchor)) THEN - i1_l = LBOUND(SrcOtherStateData%Fz_anchor,1) - i1_u = UBOUND(SrcOtherStateData%Fz_anchor,1) - IF (.NOT. ASSOCIATED(DstOtherStateData%Fz_anchor)) THEN - ALLOCATE(DstOtherStateData%Fz_anchor(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%Fz_anchor.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstOtherStateData%c_obj%Fz_anchor_Len = SIZE(DstOtherStateData%Fz_anchor) - IF (DstOtherStateData%c_obj%Fz_anchor_Len > 0) & - DstOtherStateData%c_obj%Fz_anchor = C_LOC( DstOtherStateData%Fz_anchor( i1_l ) ) - END IF - DstOtherStateData%Fz_anchor = SrcOtherStateData%Fz_anchor -ENDIF - END SUBROUTINE MAP_CopyOtherState - - SUBROUTINE MAP_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(MAP_OtherStateType), INTENT(INOUT) :: OtherStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MAP_DestroyOtherState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ASSOCIATED(OtherStateData%H)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(OtherStateData%H) - OtherStateData%H => NULL() - OtherStateData%C_obj%H = C_NULL_PTR - OtherStateData%C_obj%H_Len = 0 -ENDIF -IF (ASSOCIATED(OtherStateData%V)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(OtherStateData%V) - OtherStateData%V => NULL() - OtherStateData%C_obj%V = C_NULL_PTR - OtherStateData%C_obj%V_Len = 0 -ENDIF -IF (ASSOCIATED(OtherStateData%Ha)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(OtherStateData%Ha) - OtherStateData%Ha => NULL() - OtherStateData%C_obj%Ha = C_NULL_PTR - OtherStateData%C_obj%Ha_Len = 0 -ENDIF -IF (ASSOCIATED(OtherStateData%Va)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(OtherStateData%Va) - OtherStateData%Va => NULL() - OtherStateData%C_obj%Va = C_NULL_PTR - OtherStateData%C_obj%Va_Len = 0 -ENDIF -IF (ASSOCIATED(OtherStateData%x)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(OtherStateData%x) - OtherStateData%x => NULL() - OtherStateData%C_obj%x = C_NULL_PTR - OtherStateData%C_obj%x_Len = 0 -ENDIF -IF (ASSOCIATED(OtherStateData%y)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(OtherStateData%y) - OtherStateData%y => NULL() - OtherStateData%C_obj%y = C_NULL_PTR - OtherStateData%C_obj%y_Len = 0 -ENDIF -IF (ASSOCIATED(OtherStateData%z)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(OtherStateData%z) - OtherStateData%z => NULL() - OtherStateData%C_obj%z = C_NULL_PTR - OtherStateData%C_obj%z_Len = 0 -ENDIF -IF (ASSOCIATED(OtherStateData%xa)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(OtherStateData%xa) - OtherStateData%xa => NULL() - OtherStateData%C_obj%xa = C_NULL_PTR - OtherStateData%C_obj%xa_Len = 0 -ENDIF -IF (ASSOCIATED(OtherStateData%ya)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(OtherStateData%ya) - OtherStateData%ya => NULL() - OtherStateData%C_obj%ya = C_NULL_PTR - OtherStateData%C_obj%ya_Len = 0 -ENDIF -IF (ASSOCIATED(OtherStateData%za)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(OtherStateData%za) - OtherStateData%za => NULL() - OtherStateData%C_obj%za = C_NULL_PTR - OtherStateData%C_obj%za_Len = 0 -ENDIF -IF (ASSOCIATED(OtherStateData%Fx_connect)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(OtherStateData%Fx_connect) - OtherStateData%Fx_connect => NULL() - OtherStateData%C_obj%Fx_connect = C_NULL_PTR - OtherStateData%C_obj%Fx_connect_Len = 0 -ENDIF -IF (ASSOCIATED(OtherStateData%Fy_connect)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(OtherStateData%Fy_connect) - OtherStateData%Fy_connect => NULL() - OtherStateData%C_obj%Fy_connect = C_NULL_PTR - OtherStateData%C_obj%Fy_connect_Len = 0 -ENDIF -IF (ASSOCIATED(OtherStateData%Fz_connect)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(OtherStateData%Fz_connect) - OtherStateData%Fz_connect => NULL() - OtherStateData%C_obj%Fz_connect = C_NULL_PTR - OtherStateData%C_obj%Fz_connect_Len = 0 -ENDIF -IF (ASSOCIATED(OtherStateData%Fx_anchor)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(OtherStateData%Fx_anchor) - OtherStateData%Fx_anchor => NULL() - OtherStateData%C_obj%Fx_anchor = C_NULL_PTR - OtherStateData%C_obj%Fx_anchor_Len = 0 -ENDIF -IF (ASSOCIATED(OtherStateData%Fy_anchor)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(OtherStateData%Fy_anchor) - OtherStateData%Fy_anchor => NULL() - OtherStateData%C_obj%Fy_anchor = C_NULL_PTR - OtherStateData%C_obj%Fy_anchor_Len = 0 -ENDIF -IF (ASSOCIATED(OtherStateData%Fz_anchor)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(OtherStateData%Fz_anchor) - OtherStateData%Fz_anchor => NULL() - OtherStateData%C_obj%Fz_anchor = C_NULL_PTR - OtherStateData%C_obj%Fz_anchor_Len = 0 -ENDIF - END SUBROUTINE MAP_DestroyOtherState - - SUBROUTINE MAP_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(MAP_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 = 'MAP_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 ! H allocated yes/no - IF ( ASSOCIATED(InData%H) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! H upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%H) ! H - 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 - Db_BufSz = Db_BufSz + SIZE(InData%V) ! V - END IF - Int_BufSz = Int_BufSz + 1 ! Ha allocated yes/no - IF ( ASSOCIATED(InData%Ha) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Ha upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Ha) ! Ha - END IF - Int_BufSz = Int_BufSz + 1 ! Va allocated yes/no - IF ( ASSOCIATED(InData%Va) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Va upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Va) ! Va - END IF - Int_BufSz = Int_BufSz + 1 ! x allocated yes/no - IF ( ASSOCIATED(InData%x) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! x upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%x) ! x - END IF - Int_BufSz = Int_BufSz + 1 ! y allocated yes/no - IF ( ASSOCIATED(InData%y) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! y upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%y) ! y - END IF - Int_BufSz = Int_BufSz + 1 ! z allocated yes/no - IF ( ASSOCIATED(InData%z) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! z upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%z) ! z - END IF - Int_BufSz = Int_BufSz + 1 ! xa allocated yes/no - IF ( ASSOCIATED(InData%xa) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! xa upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%xa) ! xa - END IF - Int_BufSz = Int_BufSz + 1 ! ya allocated yes/no - IF ( ASSOCIATED(InData%ya) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ya upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%ya) ! ya - END IF - Int_BufSz = Int_BufSz + 1 ! za allocated yes/no - IF ( ASSOCIATED(InData%za) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! za upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%za) ! za - END IF - Int_BufSz = Int_BufSz + 1 ! Fx_connect allocated yes/no - IF ( ASSOCIATED(InData%Fx_connect) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Fx_connect upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Fx_connect) ! Fx_connect - END IF - Int_BufSz = Int_BufSz + 1 ! Fy_connect allocated yes/no - IF ( ASSOCIATED(InData%Fy_connect) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Fy_connect upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Fy_connect) ! Fy_connect - END IF - Int_BufSz = Int_BufSz + 1 ! Fz_connect allocated yes/no - IF ( ASSOCIATED(InData%Fz_connect) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Fz_connect upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Fz_connect) ! Fz_connect - END IF - Int_BufSz = Int_BufSz + 1 ! Fx_anchor allocated yes/no - IF ( ASSOCIATED(InData%Fx_anchor) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Fx_anchor upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Fx_anchor) ! Fx_anchor - END IF - Int_BufSz = Int_BufSz + 1 ! Fy_anchor allocated yes/no - IF ( ASSOCIATED(InData%Fy_anchor) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Fy_anchor upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Fy_anchor) ! Fy_anchor - END IF - Int_BufSz = Int_BufSz + 1 ! Fz_anchor allocated yes/no - IF ( ASSOCIATED(InData%Fz_anchor) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Fz_anchor upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Fz_anchor) ! Fz_anchor - 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%H) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%H,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%H,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%H,1), UBOUND(InData%H,1) - DbKiBuf(Db_Xferred) = InData%H(i1) - Db_Xferred = Db_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) - DbKiBuf(Db_Xferred) = InData%V(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%Ha) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Ha,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Ha,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Ha,1), UBOUND(InData%Ha,1) - DbKiBuf(Db_Xferred) = InData%Ha(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%Va) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Va,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Va,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Va,1), UBOUND(InData%Va,1) - DbKiBuf(Db_Xferred) = InData%Va(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%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%x,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - DbKiBuf(Db_Xferred) = InData%x(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%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%y,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%y,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%y,1), UBOUND(InData%y,1) - DbKiBuf(Db_Xferred) = InData%y(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%z) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%z,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - DbKiBuf(Db_Xferred) = InData%z(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%xa) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%xa,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xa,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%xa,1), UBOUND(InData%xa,1) - DbKiBuf(Db_Xferred) = InData%xa(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%ya) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ya,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ya,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ya,1), UBOUND(InData%ya,1) - DbKiBuf(Db_Xferred) = InData%ya(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%za) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%za,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%za,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%za,1), UBOUND(InData%za,1) - DbKiBuf(Db_Xferred) = InData%za(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%Fx_connect) ) THEN - 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_connect,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fx_connect,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Fx_connect,1), UBOUND(InData%Fx_connect,1) - DbKiBuf(Db_Xferred) = InData%Fx_connect(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%Fy_connect) ) THEN - 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_connect,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fy_connect,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Fy_connect,1), UBOUND(InData%Fy_connect,1) - DbKiBuf(Db_Xferred) = InData%Fy_connect(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%Fz_connect) ) THEN - 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_connect,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fz_connect,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Fz_connect,1), UBOUND(InData%Fz_connect,1) - DbKiBuf(Db_Xferred) = InData%Fz_connect(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%Fx_anchor) ) THEN - 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_anchor,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fx_anchor,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Fx_anchor,1), UBOUND(InData%Fx_anchor,1) - DbKiBuf(Db_Xferred) = InData%Fx_anchor(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%Fy_anchor) ) THEN - 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_anchor,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fy_anchor,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Fy_anchor,1), UBOUND(InData%Fy_anchor,1) - DbKiBuf(Db_Xferred) = InData%Fy_anchor(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%Fz_anchor) ) THEN - 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_anchor,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fz_anchor,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Fz_anchor,1), UBOUND(InData%Fz_anchor,1) - DbKiBuf(Db_Xferred) = InData%Fz_anchor(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE MAP_PackOtherState - - SUBROUTINE MAP_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(MAP_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 = 'MAP_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 ! H not allocated - Int_Xferred = Int_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%H)) DEALLOCATE(OutData%H) - ALLOCATE(OutData%H(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%H.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%c_obj%H_Len = SIZE(OutData%H) - IF (OutData%c_obj%H_Len > 0) & - OutData%c_obj%H = C_LOC( OutData%H( i1_l ) ) - DO i1 = LBOUND(OutData%H,1), UBOUND(OutData%H,1) - OutData%H(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) - Db_Xferred = Db_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(DbKiBuf(Db_Xferred), C_DOUBLE) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Ha not allocated - Int_Xferred = Int_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%Ha)) DEALLOCATE(OutData%Ha) - ALLOCATE(OutData%Ha(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Ha.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%c_obj%Ha_Len = SIZE(OutData%Ha) - IF (OutData%c_obj%Ha_Len > 0) & - OutData%c_obj%Ha = C_LOC( OutData%Ha( i1_l ) ) - DO i1 = LBOUND(OutData%Ha,1), UBOUND(OutData%Ha,1) - OutData%Ha(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Va not allocated - Int_Xferred = Int_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%Va)) DEALLOCATE(OutData%Va) - ALLOCATE(OutData%Va(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Va.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%c_obj%Va_Len = SIZE(OutData%Va) - IF (OutData%c_obj%Va_Len > 0) & - OutData%c_obj%Va = C_LOC( OutData%Va( i1_l ) ) - DO i1 = LBOUND(OutData%Va,1), UBOUND(OutData%Va,1) - OutData%Va(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! 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 (ASSOCIATED(OutData%x)) DEALLOCATE(OutData%x) - ALLOCATE(OutData%x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%c_obj%x_Len = SIZE(OutData%x) - IF (OutData%c_obj%x_Len > 0) & - OutData%c_obj%x = C_LOC( OutData%x( i1_l ) ) - DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,1) - OutData%x(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! 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 (ASSOCIATED(OutData%y)) DEALLOCATE(OutData%y) - ALLOCATE(OutData%y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%c_obj%y_Len = SIZE(OutData%y) - IF (OutData%c_obj%y_Len > 0) & - OutData%c_obj%y = C_LOC( OutData%y( i1_l ) ) - DO i1 = LBOUND(OutData%y,1), UBOUND(OutData%y,1) - OutData%y(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! z not allocated - Int_Xferred = Int_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%z)) DEALLOCATE(OutData%z) - ALLOCATE(OutData%z(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%z.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%c_obj%z_Len = SIZE(OutData%z) - IF (OutData%c_obj%z_Len > 0) & - OutData%c_obj%z = C_LOC( OutData%z( i1_l ) ) - DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,1) - OutData%z(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! xa not allocated - Int_Xferred = Int_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%xa)) DEALLOCATE(OutData%xa) - ALLOCATE(OutData%xa(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xa.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%c_obj%xa_Len = SIZE(OutData%xa) - IF (OutData%c_obj%xa_Len > 0) & - OutData%c_obj%xa = C_LOC( OutData%xa( i1_l ) ) - DO i1 = LBOUND(OutData%xa,1), UBOUND(OutData%xa,1) - OutData%xa(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ya not allocated - Int_Xferred = Int_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%ya)) DEALLOCATE(OutData%ya) - ALLOCATE(OutData%ya(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ya.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%c_obj%ya_Len = SIZE(OutData%ya) - IF (OutData%c_obj%ya_Len > 0) & - OutData%c_obj%ya = C_LOC( OutData%ya( i1_l ) ) - DO i1 = LBOUND(OutData%ya,1), UBOUND(OutData%ya,1) - OutData%ya(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! za not allocated - Int_Xferred = Int_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%za)) DEALLOCATE(OutData%za) - ALLOCATE(OutData%za(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%za.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%c_obj%za_Len = SIZE(OutData%za) - IF (OutData%c_obj%za_Len > 0) & - OutData%c_obj%za = C_LOC( OutData%za( i1_l ) ) - DO i1 = LBOUND(OutData%za,1), UBOUND(OutData%za,1) - OutData%za(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Fx_connect not allocated - Int_Xferred = Int_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_connect)) DEALLOCATE(OutData%Fx_connect) - ALLOCATE(OutData%Fx_connect(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fx_connect.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%c_obj%Fx_connect_Len = SIZE(OutData%Fx_connect) - IF (OutData%c_obj%Fx_connect_Len > 0) & - OutData%c_obj%Fx_connect = C_LOC( OutData%Fx_connect( i1_l ) ) - DO i1 = LBOUND(OutData%Fx_connect,1), UBOUND(OutData%Fx_connect,1) - OutData%Fx_connect(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Fy_connect not allocated - Int_Xferred = Int_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_connect)) DEALLOCATE(OutData%Fy_connect) - ALLOCATE(OutData%Fy_connect(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fy_connect.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%c_obj%Fy_connect_Len = SIZE(OutData%Fy_connect) - IF (OutData%c_obj%Fy_connect_Len > 0) & - OutData%c_obj%Fy_connect = C_LOC( OutData%Fy_connect( i1_l ) ) - DO i1 = LBOUND(OutData%Fy_connect,1), UBOUND(OutData%Fy_connect,1) - OutData%Fy_connect(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Fz_connect not allocated - Int_Xferred = Int_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_connect)) DEALLOCATE(OutData%Fz_connect) - ALLOCATE(OutData%Fz_connect(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fz_connect.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%c_obj%Fz_connect_Len = SIZE(OutData%Fz_connect) - IF (OutData%c_obj%Fz_connect_Len > 0) & - OutData%c_obj%Fz_connect = C_LOC( OutData%Fz_connect( i1_l ) ) - DO i1 = LBOUND(OutData%Fz_connect,1), UBOUND(OutData%Fz_connect,1) - OutData%Fz_connect(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Fx_anchor not allocated - Int_Xferred = Int_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_anchor)) DEALLOCATE(OutData%Fx_anchor) - ALLOCATE(OutData%Fx_anchor(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fx_anchor.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%c_obj%Fx_anchor_Len = SIZE(OutData%Fx_anchor) - IF (OutData%c_obj%Fx_anchor_Len > 0) & - OutData%c_obj%Fx_anchor = C_LOC( OutData%Fx_anchor( i1_l ) ) - DO i1 = LBOUND(OutData%Fx_anchor,1), UBOUND(OutData%Fx_anchor,1) - OutData%Fx_anchor(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Fy_anchor not allocated - Int_Xferred = Int_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_anchor)) DEALLOCATE(OutData%Fy_anchor) - ALLOCATE(OutData%Fy_anchor(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fy_anchor.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%c_obj%Fy_anchor_Len = SIZE(OutData%Fy_anchor) - IF (OutData%c_obj%Fy_anchor_Len > 0) & - OutData%c_obj%Fy_anchor = C_LOC( OutData%Fy_anchor( i1_l ) ) - DO i1 = LBOUND(OutData%Fy_anchor,1), UBOUND(OutData%Fy_anchor,1) - OutData%Fy_anchor(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Fz_anchor not allocated - Int_Xferred = Int_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_anchor)) DEALLOCATE(OutData%Fz_anchor) - ALLOCATE(OutData%Fz_anchor(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fz_anchor.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%c_obj%Fz_anchor_Len = SIZE(OutData%Fz_anchor) - IF (OutData%c_obj%Fz_anchor_Len > 0) & - OutData%c_obj%Fz_anchor = C_LOC( OutData%Fz_anchor( i1_l ) ) - DO i1 = LBOUND(OutData%Fz_anchor,1), UBOUND(OutData%Fz_anchor,1) - OutData%Fz_anchor(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE MAP_UnPackOtherState - - SUBROUTINE MAP_C2Fary_CopyOtherState( OtherStateData, ErrStat, ErrMsg, SkipPointers ) - TYPE(MAP_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 - - ! -- H OtherState Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%H ) ) THEN - NULLIFY( OtherStateData%H ) - ELSE - CALL C_F_POINTER(OtherStateData%C_obj%H, OtherStateData%H, (/OtherStateData%C_obj%H_Len/)) - END IF - END IF - - ! -- V OtherState Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%V ) ) THEN - NULLIFY( OtherStateData%V ) - ELSE - CALL C_F_POINTER(OtherStateData%C_obj%V, OtherStateData%V, (/OtherStateData%C_obj%V_Len/)) - END IF - END IF - - ! -- Ha OtherState Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%Ha ) ) THEN - NULLIFY( OtherStateData%Ha ) - ELSE - CALL C_F_POINTER(OtherStateData%C_obj%Ha, OtherStateData%Ha, (/OtherStateData%C_obj%Ha_Len/)) - END IF - END IF - - ! -- Va OtherState Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%Va ) ) THEN - NULLIFY( OtherStateData%Va ) - ELSE - CALL C_F_POINTER(OtherStateData%C_obj%Va, OtherStateData%Va, (/OtherStateData%C_obj%Va_Len/)) - END IF - END IF - - ! -- x OtherState Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%x ) ) THEN - NULLIFY( OtherStateData%x ) - ELSE - CALL C_F_POINTER(OtherStateData%C_obj%x, OtherStateData%x, (/OtherStateData%C_obj%x_Len/)) - END IF - END IF - - ! -- y OtherState Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%y ) ) THEN - NULLIFY( OtherStateData%y ) - ELSE - CALL C_F_POINTER(OtherStateData%C_obj%y, OtherStateData%y, (/OtherStateData%C_obj%y_Len/)) - END IF - END IF - - ! -- z OtherState Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%z ) ) THEN - NULLIFY( OtherStateData%z ) - ELSE - CALL C_F_POINTER(OtherStateData%C_obj%z, OtherStateData%z, (/OtherStateData%C_obj%z_Len/)) - END IF - END IF - - ! -- xa OtherState Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%xa ) ) THEN - NULLIFY( OtherStateData%xa ) - ELSE - CALL C_F_POINTER(OtherStateData%C_obj%xa, OtherStateData%xa, (/OtherStateData%C_obj%xa_Len/)) - END IF - END IF - - ! -- ya OtherState Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%ya ) ) THEN - NULLIFY( OtherStateData%ya ) - ELSE - CALL C_F_POINTER(OtherStateData%C_obj%ya, OtherStateData%ya, (/OtherStateData%C_obj%ya_Len/)) - END IF - END IF - - ! -- za OtherState Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%za ) ) THEN - NULLIFY( OtherStateData%za ) - ELSE - CALL C_F_POINTER(OtherStateData%C_obj%za, OtherStateData%za, (/OtherStateData%C_obj%za_Len/)) - END IF - END IF - - ! -- Fx_connect OtherState Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%Fx_connect ) ) THEN - NULLIFY( OtherStateData%Fx_connect ) - ELSE - CALL C_F_POINTER(OtherStateData%C_obj%Fx_connect, OtherStateData%Fx_connect, (/OtherStateData%C_obj%Fx_connect_Len/)) - END IF - END IF - - ! -- Fy_connect OtherState Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%Fy_connect ) ) THEN - NULLIFY( OtherStateData%Fy_connect ) - ELSE - CALL C_F_POINTER(OtherStateData%C_obj%Fy_connect, OtherStateData%Fy_connect, (/OtherStateData%C_obj%Fy_connect_Len/)) - END IF - END IF - - ! -- Fz_connect OtherState Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%Fz_connect ) ) THEN - NULLIFY( OtherStateData%Fz_connect ) - ELSE - CALL C_F_POINTER(OtherStateData%C_obj%Fz_connect, OtherStateData%Fz_connect, (/OtherStateData%C_obj%Fz_connect_Len/)) - END IF - END IF - - ! -- Fx_anchor OtherState Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%Fx_anchor ) ) THEN - NULLIFY( OtherStateData%Fx_anchor ) - ELSE - CALL C_F_POINTER(OtherStateData%C_obj%Fx_anchor, OtherStateData%Fx_anchor, (/OtherStateData%C_obj%Fx_anchor_Len/)) - END IF - END IF - - ! -- Fy_anchor OtherState Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%Fy_anchor ) ) THEN - NULLIFY( OtherStateData%Fy_anchor ) - ELSE - CALL C_F_POINTER(OtherStateData%C_obj%Fy_anchor, OtherStateData%Fy_anchor, (/OtherStateData%C_obj%Fy_anchor_Len/)) - END IF - END IF - - ! -- Fz_anchor OtherState Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%Fz_anchor ) ) THEN - NULLIFY( OtherStateData%Fz_anchor ) - ELSE - CALL C_F_POINTER(OtherStateData%C_obj%Fz_anchor, OtherStateData%Fz_anchor, (/OtherStateData%C_obj%Fz_anchor_Len/)) - END IF - END IF - END SUBROUTINE MAP_C2Fary_CopyOtherState - - SUBROUTINE MAP_F2C_CopyOtherState( OtherStateData, ErrStat, ErrMsg, SkipPointers ) - TYPE(MAP_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 - - ! -- H OtherState Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(OtherStateData%H)) THEN - OtherStateData%c_obj%H_Len = 0 - OtherStateData%c_obj%H = C_NULL_PTR - ELSE - OtherStateData%c_obj%H_Len = SIZE(OtherStateData%H) - IF (OtherStateData%c_obj%H_Len > 0) & - OtherStateData%c_obj%H = C_LOC( OtherStateData%H( LBOUND(OtherStateData%H,1) ) ) - END IF - END IF - - ! -- V OtherState Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(OtherStateData%V)) THEN - OtherStateData%c_obj%V_Len = 0 - OtherStateData%c_obj%V = C_NULL_PTR - ELSE - OtherStateData%c_obj%V_Len = SIZE(OtherStateData%V) - IF (OtherStateData%c_obj%V_Len > 0) & - OtherStateData%c_obj%V = C_LOC( OtherStateData%V( LBOUND(OtherStateData%V,1) ) ) - END IF - END IF - - ! -- Ha OtherState Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(OtherStateData%Ha)) THEN - OtherStateData%c_obj%Ha_Len = 0 - OtherStateData%c_obj%Ha = C_NULL_PTR - ELSE - OtherStateData%c_obj%Ha_Len = SIZE(OtherStateData%Ha) - IF (OtherStateData%c_obj%Ha_Len > 0) & - OtherStateData%c_obj%Ha = C_LOC( OtherStateData%Ha( LBOUND(OtherStateData%Ha,1) ) ) - END IF - END IF - - ! -- Va OtherState Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(OtherStateData%Va)) THEN - OtherStateData%c_obj%Va_Len = 0 - OtherStateData%c_obj%Va = C_NULL_PTR - ELSE - OtherStateData%c_obj%Va_Len = SIZE(OtherStateData%Va) - IF (OtherStateData%c_obj%Va_Len > 0) & - OtherStateData%c_obj%Va = C_LOC( OtherStateData%Va( LBOUND(OtherStateData%Va,1) ) ) - END IF - END IF - - ! -- x OtherState Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(OtherStateData%x)) THEN - OtherStateData%c_obj%x_Len = 0 - OtherStateData%c_obj%x = C_NULL_PTR - ELSE - OtherStateData%c_obj%x_Len = SIZE(OtherStateData%x) - IF (OtherStateData%c_obj%x_Len > 0) & - OtherStateData%c_obj%x = C_LOC( OtherStateData%x( LBOUND(OtherStateData%x,1) ) ) - END IF - END IF - - ! -- y OtherState Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(OtherStateData%y)) THEN - OtherStateData%c_obj%y_Len = 0 - OtherStateData%c_obj%y = C_NULL_PTR - ELSE - OtherStateData%c_obj%y_Len = SIZE(OtherStateData%y) - IF (OtherStateData%c_obj%y_Len > 0) & - OtherStateData%c_obj%y = C_LOC( OtherStateData%y( LBOUND(OtherStateData%y,1) ) ) - END IF - END IF - - ! -- z OtherState Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(OtherStateData%z)) THEN - OtherStateData%c_obj%z_Len = 0 - OtherStateData%c_obj%z = C_NULL_PTR - ELSE - OtherStateData%c_obj%z_Len = SIZE(OtherStateData%z) - IF (OtherStateData%c_obj%z_Len > 0) & - OtherStateData%c_obj%z = C_LOC( OtherStateData%z( LBOUND(OtherStateData%z,1) ) ) - END IF - END IF - - ! -- xa OtherState Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(OtherStateData%xa)) THEN - OtherStateData%c_obj%xa_Len = 0 - OtherStateData%c_obj%xa = C_NULL_PTR - ELSE - OtherStateData%c_obj%xa_Len = SIZE(OtherStateData%xa) - IF (OtherStateData%c_obj%xa_Len > 0) & - OtherStateData%c_obj%xa = C_LOC( OtherStateData%xa( LBOUND(OtherStateData%xa,1) ) ) - END IF - END IF - - ! -- ya OtherState Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(OtherStateData%ya)) THEN - OtherStateData%c_obj%ya_Len = 0 - OtherStateData%c_obj%ya = C_NULL_PTR - ELSE - OtherStateData%c_obj%ya_Len = SIZE(OtherStateData%ya) - IF (OtherStateData%c_obj%ya_Len > 0) & - OtherStateData%c_obj%ya = C_LOC( OtherStateData%ya( LBOUND(OtherStateData%ya,1) ) ) - END IF - END IF - - ! -- za OtherState Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(OtherStateData%za)) THEN - OtherStateData%c_obj%za_Len = 0 - OtherStateData%c_obj%za = C_NULL_PTR - ELSE - OtherStateData%c_obj%za_Len = SIZE(OtherStateData%za) - IF (OtherStateData%c_obj%za_Len > 0) & - OtherStateData%c_obj%za = C_LOC( OtherStateData%za( LBOUND(OtherStateData%za,1) ) ) - END IF - END IF - - ! -- Fx_connect OtherState Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(OtherStateData%Fx_connect)) THEN - OtherStateData%c_obj%Fx_connect_Len = 0 - OtherStateData%c_obj%Fx_connect = C_NULL_PTR - ELSE - OtherStateData%c_obj%Fx_connect_Len = SIZE(OtherStateData%Fx_connect) - IF (OtherStateData%c_obj%Fx_connect_Len > 0) & - OtherStateData%c_obj%Fx_connect = C_LOC( OtherStateData%Fx_connect( LBOUND(OtherStateData%Fx_connect,1) ) ) - END IF - END IF - - ! -- Fy_connect OtherState Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(OtherStateData%Fy_connect)) THEN - OtherStateData%c_obj%Fy_connect_Len = 0 - OtherStateData%c_obj%Fy_connect = C_NULL_PTR - ELSE - OtherStateData%c_obj%Fy_connect_Len = SIZE(OtherStateData%Fy_connect) - IF (OtherStateData%c_obj%Fy_connect_Len > 0) & - OtherStateData%c_obj%Fy_connect = C_LOC( OtherStateData%Fy_connect( LBOUND(OtherStateData%Fy_connect,1) ) ) - END IF - END IF - - ! -- Fz_connect OtherState Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(OtherStateData%Fz_connect)) THEN - OtherStateData%c_obj%Fz_connect_Len = 0 - OtherStateData%c_obj%Fz_connect = C_NULL_PTR - ELSE - OtherStateData%c_obj%Fz_connect_Len = SIZE(OtherStateData%Fz_connect) - IF (OtherStateData%c_obj%Fz_connect_Len > 0) & - OtherStateData%c_obj%Fz_connect = C_LOC( OtherStateData%Fz_connect( LBOUND(OtherStateData%Fz_connect,1) ) ) - END IF - END IF - - ! -- Fx_anchor OtherState Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(OtherStateData%Fx_anchor)) THEN - OtherStateData%c_obj%Fx_anchor_Len = 0 - OtherStateData%c_obj%Fx_anchor = C_NULL_PTR - ELSE - OtherStateData%c_obj%Fx_anchor_Len = SIZE(OtherStateData%Fx_anchor) - IF (OtherStateData%c_obj%Fx_anchor_Len > 0) & - OtherStateData%c_obj%Fx_anchor = C_LOC( OtherStateData%Fx_anchor( LBOUND(OtherStateData%Fx_anchor,1) ) ) - END IF - END IF - - ! -- Fy_anchor OtherState Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(OtherStateData%Fy_anchor)) THEN - OtherStateData%c_obj%Fy_anchor_Len = 0 - OtherStateData%c_obj%Fy_anchor = C_NULL_PTR - ELSE - OtherStateData%c_obj%Fy_anchor_Len = SIZE(OtherStateData%Fy_anchor) - IF (OtherStateData%c_obj%Fy_anchor_Len > 0) & - OtherStateData%c_obj%Fy_anchor = C_LOC( OtherStateData%Fy_anchor( LBOUND(OtherStateData%Fy_anchor,1) ) ) - END IF - END IF - - ! -- Fz_anchor OtherState Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(OtherStateData%Fz_anchor)) THEN - OtherStateData%c_obj%Fz_anchor_Len = 0 - OtherStateData%c_obj%Fz_anchor = C_NULL_PTR - ELSE - OtherStateData%c_obj%Fz_anchor_Len = SIZE(OtherStateData%Fz_anchor) - IF (OtherStateData%c_obj%Fz_anchor_Len > 0) & - OtherStateData%c_obj%Fz_anchor = C_LOC( OtherStateData%Fz_anchor( LBOUND(OtherStateData%Fz_anchor,1) ) ) - END IF - END IF - END SUBROUTINE MAP_F2C_CopyOtherState - - SUBROUTINE MAP_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MAP_ConstraintStateType), INTENT(IN) :: SrcConstrStateData - TYPE(MAP_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 = 'MAP_CopyConstrState' -! + END IF +END SUBROUTINE + +subroutine MAP_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) + type(MAP_ConstraintStateType), intent(in) :: SrcConstrStateData + type(MAP_ConstraintStateType), intent(inout) :: DstConstrStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'MAP_CopyConstrState' ErrStat = ErrID_None - ErrMsg = "" -IF (ASSOCIATED(SrcConstrStateData%H)) THEN - i1_l = LBOUND(SrcConstrStateData%H,1) - i1_u = UBOUND(SrcConstrStateData%H,1) - IF (.NOT. ASSOCIATED(DstConstrStateData%H)) THEN - ALLOCATE(DstConstrStateData%H(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstConstrStateData%H.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstConstrStateData%c_obj%H_Len = SIZE(DstConstrStateData%H) - IF (DstConstrStateData%c_obj%H_Len > 0) & - DstConstrStateData%c_obj%H = C_LOC( DstConstrStateData%H( i1_l ) ) - END IF - DstConstrStateData%H = SrcConstrStateData%H -ENDIF -IF (ASSOCIATED(SrcConstrStateData%V)) THEN - i1_l = LBOUND(SrcConstrStateData%V,1) - i1_u = UBOUND(SrcConstrStateData%V,1) - IF (.NOT. ASSOCIATED(DstConstrStateData%V)) THEN - ALLOCATE(DstConstrStateData%V(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstConstrStateData%V.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstConstrStateData%c_obj%V_Len = SIZE(DstConstrStateData%V) - IF (DstConstrStateData%c_obj%V_Len > 0) & - DstConstrStateData%c_obj%V = C_LOC( DstConstrStateData%V( i1_l ) ) - END IF - DstConstrStateData%V = SrcConstrStateData%V -ENDIF -IF (ASSOCIATED(SrcConstrStateData%x)) THEN - i1_l = LBOUND(SrcConstrStateData%x,1) - i1_u = UBOUND(SrcConstrStateData%x,1) - IF (.NOT. ASSOCIATED(DstConstrStateData%x)) THEN - ALLOCATE(DstConstrStateData%x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstConstrStateData%x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstConstrStateData%c_obj%x_Len = SIZE(DstConstrStateData%x) - IF (DstConstrStateData%c_obj%x_Len > 0) & - DstConstrStateData%c_obj%x = C_LOC( DstConstrStateData%x( i1_l ) ) - END IF - DstConstrStateData%x = SrcConstrStateData%x -ENDIF -IF (ASSOCIATED(SrcConstrStateData%y)) THEN - i1_l = LBOUND(SrcConstrStateData%y,1) - i1_u = UBOUND(SrcConstrStateData%y,1) - IF (.NOT. ASSOCIATED(DstConstrStateData%y)) THEN - ALLOCATE(DstConstrStateData%y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstConstrStateData%y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstConstrStateData%c_obj%y_Len = SIZE(DstConstrStateData%y) - IF (DstConstrStateData%c_obj%y_Len > 0) & - DstConstrStateData%c_obj%y = C_LOC( DstConstrStateData%y( i1_l ) ) - END IF - DstConstrStateData%y = SrcConstrStateData%y -ENDIF -IF (ASSOCIATED(SrcConstrStateData%z)) THEN - i1_l = LBOUND(SrcConstrStateData%z,1) - i1_u = UBOUND(SrcConstrStateData%z,1) - IF (.NOT. ASSOCIATED(DstConstrStateData%z)) THEN - ALLOCATE(DstConstrStateData%z(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstConstrStateData%z.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstConstrStateData%c_obj%z_Len = SIZE(DstConstrStateData%z) - IF (DstConstrStateData%c_obj%z_Len > 0) & - DstConstrStateData%c_obj%z = C_LOC( DstConstrStateData%z( i1_l ) ) - END IF - DstConstrStateData%z = SrcConstrStateData%z -ENDIF - END SUBROUTINE MAP_CopyConstrState - - SUBROUTINE MAP_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(MAP_ConstraintStateType), INTENT(INOUT) :: ConstrStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MAP_DestroyConstrState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ASSOCIATED(ConstrStateData%H)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(ConstrStateData%H) - ConstrStateData%H => NULL() - ConstrStateData%C_obj%H = C_NULL_PTR - ConstrStateData%C_obj%H_Len = 0 -ENDIF -IF (ASSOCIATED(ConstrStateData%V)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(ConstrStateData%V) - ConstrStateData%V => NULL() - ConstrStateData%C_obj%V = C_NULL_PTR - ConstrStateData%C_obj%V_Len = 0 -ENDIF -IF (ASSOCIATED(ConstrStateData%x)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(ConstrStateData%x) - ConstrStateData%x => NULL() - ConstrStateData%C_obj%x = C_NULL_PTR - ConstrStateData%C_obj%x_Len = 0 -ENDIF -IF (ASSOCIATED(ConstrStateData%y)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(ConstrStateData%y) - ConstrStateData%y => NULL() - ConstrStateData%C_obj%y = C_NULL_PTR - ConstrStateData%C_obj%y_Len = 0 -ENDIF -IF (ASSOCIATED(ConstrStateData%z)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(ConstrStateData%z) - ConstrStateData%z => NULL() - ConstrStateData%C_obj%z = C_NULL_PTR - ConstrStateData%C_obj%z_Len = 0 -ENDIF - END SUBROUTINE MAP_DestroyConstrState - - SUBROUTINE MAP_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(MAP_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 = 'MAP_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 - Int_BufSz = Int_BufSz + 1 ! H allocated yes/no - IF ( ASSOCIATED(InData%H) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! H upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%H) ! H - 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 - Db_BufSz = Db_BufSz + SIZE(InData%V) ! V - END IF - Int_BufSz = Int_BufSz + 1 ! x allocated yes/no - IF ( ASSOCIATED(InData%x) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! x upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%x) ! x - END IF - Int_BufSz = Int_BufSz + 1 ! y allocated yes/no - IF ( ASSOCIATED(InData%y) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! y upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%y) ! y - END IF - Int_BufSz = Int_BufSz + 1 ! z allocated yes/no - IF ( ASSOCIATED(InData%z) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! z upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%z) ! z - 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%H) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%H,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%H,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%H,1), UBOUND(InData%H,1) - DbKiBuf(Db_Xferred) = InData%H(i1) - Db_Xferred = Db_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) - DbKiBuf(Db_Xferred) = InData%V(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%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%x,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - DbKiBuf(Db_Xferred) = InData%x(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%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%y,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%y,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%y,1), UBOUND(InData%y,1) - DbKiBuf(Db_Xferred) = InData%y(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%z) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%z,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - DbKiBuf(Db_Xferred) = InData%z(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE MAP_PackConstrState - - SUBROUTINE MAP_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(MAP_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 = 'MAP_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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! H not allocated - Int_Xferred = Int_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%H)) DEALLOCATE(OutData%H) - ALLOCATE(OutData%H(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%H.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%c_obj%H_Len = SIZE(OutData%H) - IF (OutData%c_obj%H_Len > 0) & - OutData%c_obj%H = C_LOC( OutData%H( i1_l ) ) - DO i1 = LBOUND(OutData%H,1), UBOUND(OutData%H,1) - OutData%H(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) - Db_Xferred = Db_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(DbKiBuf(Db_Xferred), C_DOUBLE) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! 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 (ASSOCIATED(OutData%x)) DEALLOCATE(OutData%x) - ALLOCATE(OutData%x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%c_obj%x_Len = SIZE(OutData%x) - IF (OutData%c_obj%x_Len > 0) & - OutData%c_obj%x = C_LOC( OutData%x( i1_l ) ) - DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,1) - OutData%x(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! 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 (ASSOCIATED(OutData%y)) DEALLOCATE(OutData%y) - ALLOCATE(OutData%y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%c_obj%y_Len = SIZE(OutData%y) - IF (OutData%c_obj%y_Len > 0) & - OutData%c_obj%y = C_LOC( OutData%y( i1_l ) ) - DO i1 = LBOUND(OutData%y,1), UBOUND(OutData%y,1) - OutData%y(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! z not allocated - Int_Xferred = Int_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%z)) DEALLOCATE(OutData%z) - ALLOCATE(OutData%z(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%z.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%c_obj%z_Len = SIZE(OutData%z) - IF (OutData%c_obj%z_Len > 0) & - OutData%c_obj%z = C_LOC( OutData%z( i1_l ) ) - DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,1) - OutData%z(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE MAP_UnPackConstrState - - SUBROUTINE MAP_C2Fary_CopyConstrState( ConstrStateData, ErrStat, ErrMsg, SkipPointers ) - TYPE(MAP_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 - - ! -- H ConstrState Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( ConstrStateData%C_obj%H ) ) THEN - NULLIFY( ConstrStateData%H ) - ELSE - CALL C_F_POINTER(ConstrStateData%C_obj%H, ConstrStateData%H, (/ConstrStateData%C_obj%H_Len/)) - END IF - END IF - - ! -- V ConstrState Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( ConstrStateData%C_obj%V ) ) THEN - NULLIFY( ConstrStateData%V ) - ELSE - CALL C_F_POINTER(ConstrStateData%C_obj%V, ConstrStateData%V, (/ConstrStateData%C_obj%V_Len/)) - END IF - END IF - - ! -- x ConstrState Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( ConstrStateData%C_obj%x ) ) THEN - NULLIFY( ConstrStateData%x ) - ELSE - CALL C_F_POINTER(ConstrStateData%C_obj%x, ConstrStateData%x, (/ConstrStateData%C_obj%x_Len/)) - END IF - END IF - - ! -- y ConstrState Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( ConstrStateData%C_obj%y ) ) THEN - NULLIFY( ConstrStateData%y ) - ELSE - CALL C_F_POINTER(ConstrStateData%C_obj%y, ConstrStateData%y, (/ConstrStateData%C_obj%y_Len/)) - END IF - END IF - - ! -- z ConstrState Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( ConstrStateData%C_obj%z ) ) THEN - NULLIFY( ConstrStateData%z ) - ELSE - CALL C_F_POINTER(ConstrStateData%C_obj%z, ConstrStateData%z, (/ConstrStateData%C_obj%z_Len/)) - END IF - END IF - END SUBROUTINE MAP_C2Fary_CopyConstrState - - SUBROUTINE MAP_F2C_CopyConstrState( ConstrStateData, ErrStat, ErrMsg, SkipPointers ) - TYPE(MAP_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 - - ! -- H ConstrState Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(ConstrStateData%H)) THEN - ConstrStateData%c_obj%H_Len = 0 - ConstrStateData%c_obj%H = C_NULL_PTR - ELSE - ConstrStateData%c_obj%H_Len = SIZE(ConstrStateData%H) - IF (ConstrStateData%c_obj%H_Len > 0) & - ConstrStateData%c_obj%H = C_LOC( ConstrStateData%H( LBOUND(ConstrStateData%H,1) ) ) - END IF - END IF - - ! -- V ConstrState Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(ConstrStateData%V)) THEN - ConstrStateData%c_obj%V_Len = 0 - ConstrStateData%c_obj%V = C_NULL_PTR - ELSE - ConstrStateData%c_obj%V_Len = SIZE(ConstrStateData%V) - IF (ConstrStateData%c_obj%V_Len > 0) & - ConstrStateData%c_obj%V = C_LOC( ConstrStateData%V( LBOUND(ConstrStateData%V,1) ) ) - END IF - END IF - - ! -- x ConstrState Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(ConstrStateData%x)) THEN - ConstrStateData%c_obj%x_Len = 0 - ConstrStateData%c_obj%x = C_NULL_PTR - ELSE - ConstrStateData%c_obj%x_Len = SIZE(ConstrStateData%x) - IF (ConstrStateData%c_obj%x_Len > 0) & - ConstrStateData%c_obj%x = C_LOC( ConstrStateData%x( LBOUND(ConstrStateData%x,1) ) ) - END IF - END IF - - ! -- y ConstrState Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(ConstrStateData%y)) THEN - ConstrStateData%c_obj%y_Len = 0 - ConstrStateData%c_obj%y = C_NULL_PTR - ELSE - ConstrStateData%c_obj%y_Len = SIZE(ConstrStateData%y) - IF (ConstrStateData%c_obj%y_Len > 0) & - ConstrStateData%c_obj%y = C_LOC( ConstrStateData%y( LBOUND(ConstrStateData%y,1) ) ) - END IF - END IF - - ! -- z ConstrState Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(ConstrStateData%z)) THEN - ConstrStateData%c_obj%z_Len = 0 - ConstrStateData%c_obj%z = C_NULL_PTR - ELSE - ConstrStateData%c_obj%z_Len = SIZE(ConstrStateData%z) - IF (ConstrStateData%c_obj%z_Len > 0) & - ConstrStateData%c_obj%z = C_LOC( ConstrStateData%z( LBOUND(ConstrStateData%z,1) ) ) - END IF - END IF - END SUBROUTINE MAP_F2C_CopyConstrState - - SUBROUTINE MAP_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MAP_ParameterType), INTENT(IN) :: SrcParamData - TYPE(MAP_ParameterType), INTENT(INOUT) :: DstParamData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode + ErrMsg = '' + if (associated(SrcConstrStateData%H)) then + LB(1:1) = lbound(SrcConstrStateData%H) + UB(1:1) = ubound(SrcConstrStateData%H) + if (.not. associated(DstConstrStateData%H)) then + allocate(DstConstrStateData%H(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstConstrStateData%H.', ErrStat, ErrMsg, RoutineName) + return + end if + DstConstrStateData%C_obj%H_Len = size(DstConstrStateData%H) + if (DstConstrStateData%C_obj%H_Len > 0) & + DstConstrStateData%C_obj%H = c_loc(DstConstrStateData%H(LB(1))) + end if + DstConstrStateData%H = SrcConstrStateData%H + end if + if (associated(SrcConstrStateData%V)) then + LB(1:1) = lbound(SrcConstrStateData%V) + UB(1:1) = ubound(SrcConstrStateData%V) + if (.not. associated(DstConstrStateData%V)) then + allocate(DstConstrStateData%V(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstConstrStateData%V.', ErrStat, ErrMsg, RoutineName) + return + end if + DstConstrStateData%C_obj%V_Len = size(DstConstrStateData%V) + if (DstConstrStateData%C_obj%V_Len > 0) & + DstConstrStateData%C_obj%V = c_loc(DstConstrStateData%V(LB(1))) + end if + DstConstrStateData%V = SrcConstrStateData%V + end if + if (associated(SrcConstrStateData%x)) then + LB(1:1) = lbound(SrcConstrStateData%x) + UB(1:1) = ubound(SrcConstrStateData%x) + if (.not. associated(DstConstrStateData%x)) then + allocate(DstConstrStateData%x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstConstrStateData%x.', ErrStat, ErrMsg, RoutineName) + return + end if + DstConstrStateData%C_obj%x_Len = size(DstConstrStateData%x) + if (DstConstrStateData%C_obj%x_Len > 0) & + DstConstrStateData%C_obj%x = c_loc(DstConstrStateData%x(LB(1))) + end if + DstConstrStateData%x = SrcConstrStateData%x + end if + if (associated(SrcConstrStateData%y)) then + LB(1:1) = lbound(SrcConstrStateData%y) + UB(1:1) = ubound(SrcConstrStateData%y) + if (.not. associated(DstConstrStateData%y)) then + allocate(DstConstrStateData%y(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstConstrStateData%y.', ErrStat, ErrMsg, RoutineName) + return + end if + DstConstrStateData%C_obj%y_Len = size(DstConstrStateData%y) + if (DstConstrStateData%C_obj%y_Len > 0) & + DstConstrStateData%C_obj%y = c_loc(DstConstrStateData%y(LB(1))) + end if + DstConstrStateData%y = SrcConstrStateData%y + end if + if (associated(SrcConstrStateData%z)) then + LB(1:1) = lbound(SrcConstrStateData%z) + UB(1:1) = ubound(SrcConstrStateData%z) + if (.not. associated(DstConstrStateData%z)) then + allocate(DstConstrStateData%z(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstConstrStateData%z.', ErrStat, ErrMsg, RoutineName) + return + end if + DstConstrStateData%C_obj%z_Len = size(DstConstrStateData%z) + if (DstConstrStateData%C_obj%z_Len > 0) & + DstConstrStateData%C_obj%z = c_loc(DstConstrStateData%z(LB(1))) + end if + DstConstrStateData%z = SrcConstrStateData%z + end if +end subroutine + +subroutine MAP_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) + type(MAP_ConstraintStateType), intent(inout) :: ConstrStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'MAP_DestroyConstrState' + ErrStat = ErrID_None + ErrMsg = '' + if (associated(ConstrStateData%H)) then + deallocate(ConstrStateData%H) + ConstrStateData%H => null() + ConstrStateData%C_obj%H = c_null_ptr + ConstrStateData%C_obj%H_Len = 0 + end if + if (associated(ConstrStateData%V)) then + deallocate(ConstrStateData%V) + ConstrStateData%V => null() + ConstrStateData%C_obj%V = c_null_ptr + ConstrStateData%C_obj%V_Len = 0 + end if + if (associated(ConstrStateData%x)) then + deallocate(ConstrStateData%x) + ConstrStateData%x => null() + ConstrStateData%C_obj%x = c_null_ptr + ConstrStateData%C_obj%x_Len = 0 + end if + if (associated(ConstrStateData%y)) then + deallocate(ConstrStateData%y) + ConstrStateData%y => null() + ConstrStateData%C_obj%y = c_null_ptr + ConstrStateData%C_obj%y_Len = 0 + end if + if (associated(ConstrStateData%z)) then + deallocate(ConstrStateData%z) + ConstrStateData%z => null() + ConstrStateData%C_obj%z = c_null_ptr + ConstrStateData%C_obj%z_Len = 0 + end if +end subroutine + +subroutine MAP_PackConstrState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(MAP_ConstraintStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'MAP_PackConstrState' + logical :: PtrInIndex + if (RF%ErrStat >= AbortErrLev) return + if (c_associated(InData%C_obj%object)) then + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + call RegPackPtr(RF, InData%H) + call RegPackPtr(RF, InData%V) + call RegPackPtr(RF, InData%x) + call RegPackPtr(RF, InData%y) + call RegPackPtr(RF, InData%z) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine MAP_UnPackConstrState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(MAP_ConstraintStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'MAP_UnPackConstrState' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(B8Ki) :: PtrIdx + type(c_ptr) :: Ptr + if (RF%ErrStat /= ErrID_None) return + call RegUnpackPtr(RF, OutData%H, LB, UB); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%H)) then + OutData%C_obj%H_Len = size(OutData%H) + if (OutData%C_obj%H_Len > 0) OutData%C_obj%H = c_loc(OutData%H(LB(1))) + end if + call RegUnpackPtr(RF, OutData%V, LB, UB); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%V)) then + OutData%C_obj%V_Len = size(OutData%V) + if (OutData%C_obj%V_Len > 0) OutData%C_obj%V = c_loc(OutData%V(LB(1))) + end if + call RegUnpackPtr(RF, OutData%x, LB, UB); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%x)) then + OutData%C_obj%x_Len = size(OutData%x) + if (OutData%C_obj%x_Len > 0) OutData%C_obj%x = c_loc(OutData%x(LB(1))) + end if + call RegUnpackPtr(RF, OutData%y, LB, UB); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%y)) then + OutData%C_obj%y_Len = size(OutData%y) + if (OutData%C_obj%y_Len > 0) OutData%C_obj%y = c_loc(OutData%y(LB(1))) + end if + call RegUnpackPtr(RF, OutData%z, LB, UB); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%z)) then + OutData%C_obj%z_Len = size(OutData%z) + if (OutData%C_obj%z_Len > 0) OutData%C_obj%z = c_loc(OutData%z(LB(1))) + end if +end subroutine + +SUBROUTINE MAP_C2Fary_CopyConstrState(ConstrStateData, ErrStat, ErrMsg, SkipPointers) + TYPE(MAP_ConstraintStateType), INTENT(INOUT) :: ConstrStateData 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 = 'MAP_CopyParam' -! + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local ErrStat = ErrID_None ErrMsg = "" - DstParamData%g = SrcParamData%g - DstParamData%C_obj%g = SrcParamData%C_obj%g - DstParamData%depth = SrcParamData%depth - DstParamData%C_obj%depth = SrcParamData%C_obj%depth - DstParamData%rho_sea = SrcParamData%rho_sea - DstParamData%C_obj%rho_sea = SrcParamData%C_obj%rho_sea - DstParamData%dt = SrcParamData%dt - DstParamData%C_obj%dt = SrcParamData%C_obj%dt - DstParamData%InputLines = SrcParamData%InputLines - DstParamData%InputLineType = SrcParamData%InputLineType - DstParamData%numOuts = SrcParamData%numOuts - DstParamData%C_obj%numOuts = SrcParamData%C_obj%numOuts - CALL MAP_Fortran_Copylin_paramtype( SrcParamData%LinParams, DstParamData%LinParams, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE MAP_CopyParam - - SUBROUTINE MAP_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(MAP_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MAP_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL MAP_Fortran_Destroylin_paramtype( ParamData%LinParams, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE MAP_DestroyParam - - SUBROUTINE MAP_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(MAP_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 = 'MAP_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 ! g - Db_BufSz = Db_BufSz + 1 ! depth - Db_BufSz = Db_BufSz + 1 ! rho_sea - Db_BufSz = Db_BufSz + 1 ! dt - Int_BufSz = Int_BufSz + SIZE(InData%InputLines)*LEN(InData%InputLines) ! InputLines - Int_BufSz = Int_BufSz + SIZE(InData%InputLineType)*LEN(InData%InputLineType) ! InputLineType - Int_BufSz = Int_BufSz + 1 ! numOuts - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! LinParams: size of buffers for each call to pack subtype - CALL MAP_Fortran_Packlin_paramtype( Re_Buf, Db_Buf, Int_Buf, InData%LinParams, ErrStat2, ErrMsg2, .TRUE. ) ! LinParams - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! LinParams - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + + ! -- H ConstrState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( ConstrStateData%C_obj%H ) ) THEN + NULLIFY( ConstrStateData%H ) + ELSE + CALL C_F_POINTER(ConstrStateData%C_obj%H, ConstrStateData%H, [ConstrStateData%C_obj%H_Len]) + END IF + END IF + + ! -- V ConstrState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( ConstrStateData%C_obj%V ) ) THEN + NULLIFY( ConstrStateData%V ) + ELSE + CALL C_F_POINTER(ConstrStateData%C_obj%V, ConstrStateData%V, [ConstrStateData%C_obj%V_Len]) END IF - IF(ALLOCATED(Db_Buf)) THEN ! LinParams - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) + END IF + + ! -- x ConstrState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( ConstrStateData%C_obj%x ) ) THEN + NULLIFY( ConstrStateData%x ) + ELSE + CALL C_F_POINTER(ConstrStateData%C_obj%x, ConstrStateData%x, [ConstrStateData%C_obj%x_Len]) END IF - IF(ALLOCATED(Int_Buf)) THEN ! LinParams - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) + END IF + + ! -- y ConstrState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( ConstrStateData%C_obj%y ) ) THEN + NULLIFY( ConstrStateData%y ) + ELSE + CALL C_F_POINTER(ConstrStateData%C_obj%y, ConstrStateData%y, [ConstrStateData%C_obj%y_Len]) 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%g - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%depth - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%rho_sea - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%dt - Db_Xferred = Db_Xferred + 1 - DO i1 = LBOUND(InData%InputLines,1), UBOUND(InData%InputLines,1) - DO I = 1, LEN(InData%InputLines) - IntKiBuf(Int_Xferred) = ICHAR(InData%InputLines(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - DO i1 = LBOUND(InData%InputLineType,1), UBOUND(InData%InputLineType,1) - DO I = 1, LEN(InData%InputLineType) - IntKiBuf(Int_Xferred) = ICHAR(InData%InputLineType(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - IntKiBuf(Int_Xferred) = InData%numOuts - Int_Xferred = Int_Xferred + 1 - CALL MAP_Fortran_Packlin_paramtype( Re_Buf, Db_Buf, Int_Buf, InData%LinParams, ErrStat2, ErrMsg2, OnlySize ) ! LinParams - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN + END IF + + ! -- z ConstrState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( ConstrStateData%C_obj%z ) ) THEN + NULLIFY( ConstrStateData%z ) + ELSE + CALL C_F_POINTER(ConstrStateData%C_obj%z, ConstrStateData%z, [ConstrStateData%C_obj%z_Len]) + END IF + END IF +END SUBROUTINE - 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) +SUBROUTINE MAP_F2C_CopyConstrState( ConstrStateData, ErrStat, ErrMsg, SkipPointers ) + TYPE(MAP_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 + + ! -- H ConstrState Data fields + IF (.NOT. SkipPointers_local ) THEN + IF (.NOT. ASSOCIATED(ConstrStateData%H)) THEN + ConstrStateData%C_obj%H_Len = 0 + ConstrStateData%C_obj%H = C_NULL_PTR 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) + ConstrStateData%C_obj%H_Len = SIZE(ConstrStateData%H) + IF (ConstrStateData%C_obj%H_Len > 0) & + ConstrStateData%C_obj%H = C_LOC(ConstrStateData%H(lbound(ConstrStateData%H,1))) + END IF + END IF + + ! -- V ConstrState Data fields + IF (.NOT. SkipPointers_local ) THEN + IF (.NOT. ASSOCIATED(ConstrStateData%V)) THEN + ConstrStateData%C_obj%V_Len = 0 + ConstrStateData%C_obj%V = C_NULL_PTR 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) + ConstrStateData%C_obj%V_Len = SIZE(ConstrStateData%V) + IF (ConstrStateData%C_obj%V_Len > 0) & + ConstrStateData%C_obj%V = C_LOC(ConstrStateData%V(lbound(ConstrStateData%V,1))) + END IF + END IF + + ! -- x ConstrState Data fields + IF (.NOT. SkipPointers_local ) THEN + IF (.NOT. ASSOCIATED(ConstrStateData%x)) THEN + ConstrStateData%C_obj%x_Len = 0 + ConstrStateData%C_obj%x = C_NULL_PTR ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END SUBROUTINE MAP_PackParam - - SUBROUTINE MAP_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(MAP_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 = 'MAP_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%g = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%C_obj%g = OutData%g - OutData%depth = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%C_obj%depth = OutData%depth - OutData%rho_sea = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%C_obj%rho_sea = OutData%rho_sea - OutData%dt = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%C_obj%dt = OutData%dt - i1_l = LBOUND(OutData%InputLines,1) - i1_u = UBOUND(OutData%InputLines,1) - DO i1 = LBOUND(OutData%InputLines,1), UBOUND(OutData%InputLines,1) - DO I = 1, LEN(OutData%InputLines) - OutData%InputLines(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - i1_l = LBOUND(OutData%InputLineType,1) - i1_u = UBOUND(OutData%InputLineType,1) - DO i1 = LBOUND(OutData%InputLineType,1), UBOUND(OutData%InputLineType,1) - DO I = 1, LEN(OutData%InputLineType) - OutData%InputLineType(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - OutData%numOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%C_obj%numOuts = OutData%numOuts - 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 + ConstrStateData%C_obj%x_Len = SIZE(ConstrStateData%x) + IF (ConstrStateData%C_obj%x_Len > 0) & + ConstrStateData%C_obj%x = C_LOC(ConstrStateData%x(lbound(ConstrStateData%x,1))) 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 + + ! -- y ConstrState Data fields + IF (.NOT. SkipPointers_local ) THEN + IF (.NOT. ASSOCIATED(ConstrStateData%y)) THEN + ConstrStateData%C_obj%y_Len = 0 + ConstrStateData%C_obj%y = C_NULL_PTR + ELSE + ConstrStateData%C_obj%y_Len = SIZE(ConstrStateData%y) + IF (ConstrStateData%C_obj%y_Len > 0) & + ConstrStateData%C_obj%y = C_LOC(ConstrStateData%y(lbound(ConstrStateData%y,1))) 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 + + ! -- z ConstrState Data fields + IF (.NOT. SkipPointers_local ) THEN + IF (.NOT. ASSOCIATED(ConstrStateData%z)) THEN + ConstrStateData%C_obj%z_Len = 0 + ConstrStateData%C_obj%z = C_NULL_PTR + ELSE + ConstrStateData%C_obj%z_Len = SIZE(ConstrStateData%z) + IF (ConstrStateData%C_obj%z_Len > 0) & + ConstrStateData%C_obj%z = C_LOC(ConstrStateData%z(lbound(ConstrStateData%z,1))) END IF - CALL MAP_Fortran_Unpacklin_paramtype( Re_Buf, Db_Buf, Int_Buf, OutData%LinParams, ErrStat2, ErrMsg2 ) ! LinParams - 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 MAP_UnPackParam - - SUBROUTINE MAP_C2Fary_CopyParam( ParamData, ErrStat, ErrMsg, SkipPointers ) - TYPE(MAP_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%g = ParamData%C_obj%g - ParamData%depth = ParamData%C_obj%depth - ParamData%rho_sea = ParamData%C_obj%rho_sea - ParamData%dt = ParamData%C_obj%dt - ParamData%numOuts = ParamData%C_obj%numOuts - END SUBROUTINE MAP_C2Fary_CopyParam - - SUBROUTINE MAP_F2C_CopyParam( ParamData, ErrStat, ErrMsg, SkipPointers ) - TYPE(MAP_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%g = ParamData%g - ParamData%C_obj%depth = ParamData%depth - ParamData%C_obj%rho_sea = ParamData%rho_sea - ParamData%C_obj%dt = ParamData%dt - ParamData%C_obj%numOuts = ParamData%numOuts - END SUBROUTINE MAP_F2C_CopyParam - - SUBROUTINE MAP_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MAP_InputType), INTENT(INOUT) :: SrcInputData - TYPE(MAP_InputType), INTENT(INOUT) :: DstInputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode + END IF +END SUBROUTINE + +subroutine MAP_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(MAP_ParameterType), intent(in) :: SrcParamData + type(MAP_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'MAP_CopyParam' + ErrStat = ErrID_None + ErrMsg = '' + DstParamData%g = SrcParamData%g + DstParamData%C_obj%g = SrcParamData%C_obj%g + DstParamData%depth = SrcParamData%depth + DstParamData%C_obj%depth = SrcParamData%C_obj%depth + DstParamData%rho_sea = SrcParamData%rho_sea + DstParamData%C_obj%rho_sea = SrcParamData%C_obj%rho_sea + DstParamData%dt = SrcParamData%dt + DstParamData%C_obj%dt = SrcParamData%C_obj%dt + DstParamData%InputLines = SrcParamData%InputLines + DstParamData%InputLineType = SrcParamData%InputLineType + DstParamData%numOuts = SrcParamData%numOuts + DstParamData%C_obj%numOuts = SrcParamData%C_obj%numOuts + call MAP_Fortran_CopyLin_ParamType(SrcParamData%LinParams, DstParamData%LinParams, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine MAP_DestroyParam(ParamData, ErrStat, ErrMsg) + type(MAP_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'MAP_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' + call MAP_Fortran_DestroyLin_ParamType(ParamData%LinParams, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine MAP_PackParam(RF, Indata) + type(RegFile), intent(inout) :: RF + type(MAP_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'MAP_PackParam' + if (RF%ErrStat >= AbortErrLev) return + if (c_associated(InData%C_obj%object)) then + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + call RegPack(RF, InData%g) + call RegPack(RF, InData%depth) + call RegPack(RF, InData%rho_sea) + call RegPack(RF, InData%dt) + call RegPack(RF, InData%InputLines) + call RegPack(RF, InData%InputLineType) + call RegPack(RF, InData%numOuts) + call MAP_Fortran_PackLin_ParamType(RF, InData%LinParams) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine MAP_UnPackParam(RF, OutData) + type(RegFile), intent(inout) :: RF + type(MAP_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'MAP_UnPackParam' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%g); if (RegCheckErr(RF, RoutineName)) return + OutData%C_obj%g = OutData%g + call RegUnpack(RF, OutData%depth); if (RegCheckErr(RF, RoutineName)) return + OutData%C_obj%depth = OutData%depth + call RegUnpack(RF, OutData%rho_sea); if (RegCheckErr(RF, RoutineName)) return + OutData%C_obj%rho_sea = OutData%rho_sea + call RegUnpack(RF, OutData%dt); if (RegCheckErr(RF, RoutineName)) return + OutData%C_obj%dt = OutData%dt + call RegUnpack(RF, OutData%InputLines); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%InputLineType); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%numOuts); if (RegCheckErr(RF, RoutineName)) return + OutData%C_obj%numOuts = OutData%numOuts + call MAP_Fortran_UnpackLin_ParamType(RF, OutData%LinParams) ! LinParams +end subroutine + +SUBROUTINE MAP_C2Fary_CopyParam(ParamData, ErrStat, ErrMsg, SkipPointers) + TYPE(MAP_ParameterType), INTENT(INOUT) :: ParamData 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 = 'MAP_CopyInput' -! + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local ErrStat = ErrID_None ErrMsg = "" -IF (ASSOCIATED(SrcInputData%x)) THEN - i1_l = LBOUND(SrcInputData%x,1) - i1_u = UBOUND(SrcInputData%x,1) - IF (.NOT. ASSOCIATED(DstInputData%x)) THEN - ALLOCATE(DstInputData%x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstInputData%c_obj%x_Len = SIZE(DstInputData%x) - IF (DstInputData%c_obj%x_Len > 0) & - DstInputData%c_obj%x = C_LOC( DstInputData%x( i1_l ) ) - END IF - DstInputData%x = SrcInputData%x -ENDIF -IF (ASSOCIATED(SrcInputData%y)) THEN - i1_l = LBOUND(SrcInputData%y,1) - i1_u = UBOUND(SrcInputData%y,1) - IF (.NOT. ASSOCIATED(DstInputData%y)) THEN - ALLOCATE(DstInputData%y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstInputData%c_obj%y_Len = SIZE(DstInputData%y) - IF (DstInputData%c_obj%y_Len > 0) & - DstInputData%c_obj%y = C_LOC( DstInputData%y( i1_l ) ) - END IF - DstInputData%y = SrcInputData%y -ENDIF -IF (ASSOCIATED(SrcInputData%z)) THEN - i1_l = LBOUND(SrcInputData%z,1) - i1_u = UBOUND(SrcInputData%z,1) - IF (.NOT. ASSOCIATED(DstInputData%z)) THEN - ALLOCATE(DstInputData%z(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%z.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstInputData%c_obj%z_Len = SIZE(DstInputData%z) - IF (DstInputData%c_obj%z_Len > 0) & - DstInputData%c_obj%z = C_LOC( DstInputData%z( i1_l ) ) - END IF - DstInputData%z = SrcInputData%z -ENDIF - CALL MeshCopy( SrcInputData%PtFairDisplacement, DstInputData%PtFairDisplacement, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE MAP_CopyInput - - SUBROUTINE MAP_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(MAP_InputType), INTENT(INOUT) :: InputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MAP_DestroyInput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ASSOCIATED(InputData%x)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(InputData%x) - InputData%x => NULL() - InputData%C_obj%x = C_NULL_PTR - InputData%C_obj%x_Len = 0 -ENDIF -IF (ASSOCIATED(InputData%y)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(InputData%y) - InputData%y => NULL() - InputData%C_obj%y = C_NULL_PTR - InputData%C_obj%y_Len = 0 -ENDIF -IF (ASSOCIATED(InputData%z)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(InputData%z) - InputData%z => NULL() - InputData%C_obj%z = C_NULL_PTR - InputData%C_obj%z_Len = 0 -ENDIF - CALL MeshDestroy( InputData%PtFairDisplacement, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE MAP_DestroyInput - - SUBROUTINE MAP_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(MAP_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 = 'MAP_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 ! x allocated yes/no - IF ( ASSOCIATED(InData%x) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! x upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%x) ! x - END IF - Int_BufSz = Int_BufSz + 1 ! y allocated yes/no - IF ( ASSOCIATED(InData%y) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! y upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%y) ! y - END IF - Int_BufSz = Int_BufSz + 1 ! z allocated yes/no - IF ( ASSOCIATED(InData%z) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! z upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%z) ! z - END IF - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! PtFairDisplacement: size of buffers for each call to pack subtype - CALL MeshPack( InData%PtFairDisplacement, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! PtFairDisplacement - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! PtFairDisplacement - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + ParamData%g = ParamData%C_obj%g + ParamData%depth = ParamData%C_obj%depth + ParamData%rho_sea = ParamData%C_obj%rho_sea + ParamData%dt = ParamData%C_obj%dt + ParamData%numOuts = ParamData%C_obj%numOuts +END SUBROUTINE + +SUBROUTINE MAP_F2C_CopyParam( ParamData, ErrStat, ErrMsg, SkipPointers ) + TYPE(MAP_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%g = ParamData%g + ParamData%C_obj%depth = ParamData%depth + ParamData%C_obj%rho_sea = ParamData%rho_sea + ParamData%C_obj%dt = ParamData%dt + ParamData%C_obj%numOuts = ParamData%numOuts +END SUBROUTINE + +subroutine MAP_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) + type(MAP_InputType), intent(inout) :: SrcInputData + type(MAP_InputType), intent(inout) :: DstInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'MAP_CopyInput' + ErrStat = ErrID_None + ErrMsg = '' + if (associated(SrcInputData%x)) then + LB(1:1) = lbound(SrcInputData%x) + UB(1:1) = ubound(SrcInputData%x) + if (.not. associated(DstInputData%x)) then + allocate(DstInputData%x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%x.', ErrStat, ErrMsg, RoutineName) + return + end if + DstInputData%C_obj%x_Len = size(DstInputData%x) + if (DstInputData%C_obj%x_Len > 0) & + DstInputData%C_obj%x = c_loc(DstInputData%x(LB(1))) + end if + DstInputData%x = SrcInputData%x + end if + if (associated(SrcInputData%y)) then + LB(1:1) = lbound(SrcInputData%y) + UB(1:1) = ubound(SrcInputData%y) + if (.not. associated(DstInputData%y)) then + allocate(DstInputData%y(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%y.', ErrStat, ErrMsg, RoutineName) + return + end if + DstInputData%C_obj%y_Len = size(DstInputData%y) + if (DstInputData%C_obj%y_Len > 0) & + DstInputData%C_obj%y = c_loc(DstInputData%y(LB(1))) + end if + DstInputData%y = SrcInputData%y + end if + if (associated(SrcInputData%z)) then + LB(1:1) = lbound(SrcInputData%z) + UB(1:1) = ubound(SrcInputData%z) + if (.not. associated(DstInputData%z)) then + allocate(DstInputData%z(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%z.', ErrStat, ErrMsg, RoutineName) + return + end if + DstInputData%C_obj%z_Len = size(DstInputData%z) + if (DstInputData%C_obj%z_Len > 0) & + DstInputData%C_obj%z = c_loc(DstInputData%z(LB(1))) + end if + DstInputData%z = SrcInputData%z + end if + call MeshCopy(SrcInputData%PtFairDisplacement, DstInputData%PtFairDisplacement, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine MAP_DestroyInput(InputData, ErrStat, ErrMsg) + type(MAP_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'MAP_DestroyInput' + ErrStat = ErrID_None + ErrMsg = '' + if (associated(InputData%x)) then + deallocate(InputData%x) + InputData%x => null() + InputData%C_obj%x = c_null_ptr + InputData%C_obj%x_Len = 0 + end if + if (associated(InputData%y)) then + deallocate(InputData%y) + InputData%y => null() + InputData%C_obj%y = c_null_ptr + InputData%C_obj%y_Len = 0 + end if + if (associated(InputData%z)) then + deallocate(InputData%z) + InputData%z => null() + InputData%C_obj%z = c_null_ptr + InputData%C_obj%z_Len = 0 + end if + call MeshDestroy( InputData%PtFairDisplacement, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine MAP_PackInput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(MAP_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'MAP_PackInput' + logical :: PtrInIndex + if (RF%ErrStat >= AbortErrLev) return + if (c_associated(InData%C_obj%object)) then + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + call RegPackPtr(RF, InData%x) + call RegPackPtr(RF, InData%y) + call RegPackPtr(RF, InData%z) + call MeshPack(RF, InData%PtFairDisplacement) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine MAP_UnPackInput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(MAP_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'MAP_UnPackInput' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(B8Ki) :: PtrIdx + type(c_ptr) :: Ptr + if (RF%ErrStat /= ErrID_None) return + call RegUnpackPtr(RF, OutData%x, LB, UB); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%x)) then + OutData%C_obj%x_Len = size(OutData%x) + if (OutData%C_obj%x_Len > 0) OutData%C_obj%x = c_loc(OutData%x(LB(1))) + end if + call RegUnpackPtr(RF, OutData%y, LB, UB); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%y)) then + OutData%C_obj%y_Len = size(OutData%y) + if (OutData%C_obj%y_Len > 0) OutData%C_obj%y = c_loc(OutData%y(LB(1))) + end if + call RegUnpackPtr(RF, OutData%z, LB, UB); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%z)) then + OutData%C_obj%z_Len = size(OutData%z) + if (OutData%C_obj%z_Len > 0) OutData%C_obj%z = c_loc(OutData%z(LB(1))) + end if + call MeshUnpack(RF, OutData%PtFairDisplacement) ! PtFairDisplacement +end subroutine + +SUBROUTINE MAP_C2Fary_CopyInput(InputData, ErrStat, ErrMsg, SkipPointers) + TYPE(MAP_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 + + ! -- x Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%x ) ) THEN + NULLIFY( InputData%x ) + ELSE + CALL C_F_POINTER(InputData%C_obj%x, InputData%x, [InputData%C_obj%x_Len]) END IF - IF(ALLOCATED(Db_Buf)) THEN ! PtFairDisplacement - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) + END IF + + ! -- y Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%y ) ) THEN + NULLIFY( InputData%y ) + ELSE + CALL C_F_POINTER(InputData%C_obj%y, InputData%y, [InputData%C_obj%y_Len]) END IF - IF(ALLOCATED(Int_Buf)) THEN ! PtFairDisplacement - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) + END IF + + ! -- z Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%z ) ) THEN + NULLIFY( InputData%z ) + ELSE + CALL C_F_POINTER(InputData%C_obj%z, InputData%z, [InputData%C_obj%z_Len]) 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%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%x,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - DbKiBuf(Db_Xferred) = InData%x(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%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%y,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%y,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%y,1), UBOUND(InData%y,1) - DbKiBuf(Db_Xferred) = InData%y(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%z) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%z,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - DbKiBuf(Db_Xferred) = InData%z(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - CALL MeshPack( InData%PtFairDisplacement, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! PtFairDisplacement - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN + END IF +END SUBROUTINE - 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) +SUBROUTINE MAP_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) + TYPE(MAP_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 + + ! -- x Input Data fields + IF (.NOT. SkipPointers_local ) THEN + IF (.NOT. ASSOCIATED(InputData%x)) THEN + InputData%C_obj%x_Len = 0 + InputData%C_obj%x = C_NULL_PTR ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END SUBROUTINE MAP_PackInput - - SUBROUTINE MAP_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(MAP_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 = 'MAP_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 ! 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 (ASSOCIATED(OutData%x)) DEALLOCATE(OutData%x) - ALLOCATE(OutData%x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%c_obj%x_Len = SIZE(OutData%x) - IF (OutData%c_obj%x_Len > 0) & - OutData%c_obj%x = C_LOC( OutData%x( i1_l ) ) - DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,1) - OutData%x(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! 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 (ASSOCIATED(OutData%y)) DEALLOCATE(OutData%y) - ALLOCATE(OutData%y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%c_obj%y_Len = SIZE(OutData%y) - IF (OutData%c_obj%y_Len > 0) & - OutData%c_obj%y = C_LOC( OutData%y( i1_l ) ) - DO i1 = LBOUND(OutData%y,1), UBOUND(OutData%y,1) - OutData%y(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! z not allocated - Int_Xferred = Int_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%z)) DEALLOCATE(OutData%z) - ALLOCATE(OutData%z(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%z.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%c_obj%z_Len = SIZE(OutData%z) - IF (OutData%c_obj%z_Len > 0) & - OutData%c_obj%z = C_LOC( OutData%z( i1_l ) ) - DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,1) - OutData%z(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) - Db_Xferred = Db_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 + InputData%C_obj%x_Len = SIZE(InputData%x) + IF (InputData%C_obj%x_Len > 0) & + InputData%C_obj%x = C_LOC(InputData%x(lbound(InputData%x,1))) 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 + + ! -- y Input Data fields + IF (.NOT. SkipPointers_local ) THEN + IF (.NOT. ASSOCIATED(InputData%y)) THEN + InputData%C_obj%y_Len = 0 + InputData%C_obj%y = C_NULL_PTR + ELSE + InputData%C_obj%y_Len = SIZE(InputData%y) + IF (InputData%C_obj%y_Len > 0) & + InputData%C_obj%y = C_LOC(InputData%y(lbound(InputData%y,1))) 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 + + ! -- z Input Data fields + IF (.NOT. SkipPointers_local ) THEN + IF (.NOT. ASSOCIATED(InputData%z)) THEN + InputData%C_obj%z_Len = 0 + InputData%C_obj%z = C_NULL_PTR + ELSE + InputData%C_obj%z_Len = SIZE(InputData%z) + IF (InputData%C_obj%z_Len > 0) & + InputData%C_obj%z = C_LOC(InputData%z(lbound(InputData%z,1))) END IF - CALL MeshUnpack( OutData%PtFairDisplacement, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! PtFairDisplacement - 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 MAP_UnPackInput - - SUBROUTINE MAP_C2Fary_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) - TYPE(MAP_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 - - ! -- x Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%x ) ) THEN - NULLIFY( InputData%x ) - ELSE - CALL C_F_POINTER(InputData%C_obj%x, InputData%x, (/InputData%C_obj%x_Len/)) - END IF - END IF - - ! -- y Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%y ) ) THEN - NULLIFY( InputData%y ) - ELSE - CALL C_F_POINTER(InputData%C_obj%y, InputData%y, (/InputData%C_obj%y_Len/)) - END IF - END IF - - ! -- z Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%z ) ) THEN - NULLIFY( InputData%z ) - ELSE - CALL C_F_POINTER(InputData%C_obj%z, InputData%z, (/InputData%C_obj%z_Len/)) - END IF - END IF - END SUBROUTINE MAP_C2Fary_CopyInput - - SUBROUTINE MAP_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) - TYPE(MAP_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 - - ! -- x Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(InputData%x)) THEN - InputData%c_obj%x_Len = 0 - InputData%c_obj%x = C_NULL_PTR - ELSE - InputData%c_obj%x_Len = SIZE(InputData%x) - IF (InputData%c_obj%x_Len > 0) & - InputData%c_obj%x = C_LOC( InputData%x( LBOUND(InputData%x,1) ) ) - END IF - END IF - - ! -- y Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(InputData%y)) THEN - InputData%c_obj%y_Len = 0 - InputData%c_obj%y = C_NULL_PTR - ELSE - InputData%c_obj%y_Len = SIZE(InputData%y) - IF (InputData%c_obj%y_Len > 0) & - InputData%c_obj%y = C_LOC( InputData%y( LBOUND(InputData%y,1) ) ) - END IF - END IF - - ! -- z Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(InputData%z)) THEN - InputData%c_obj%z_Len = 0 - InputData%c_obj%z = C_NULL_PTR - ELSE - InputData%c_obj%z_Len = SIZE(InputData%z) - IF (InputData%c_obj%z_Len > 0) & - InputData%c_obj%z = C_LOC( InputData%z( LBOUND(InputData%z,1) ) ) - END IF - END IF - END SUBROUTINE MAP_F2C_CopyInput - - SUBROUTINE MAP_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MAP_OutputType), INTENT(INOUT) :: SrcOutputData - TYPE(MAP_OutputType), INTENT(INOUT) :: DstOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode + END IF +END SUBROUTINE + +subroutine MAP_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(MAP_OutputType), intent(inout) :: SrcOutputData + type(MAP_OutputType), intent(inout) :: DstOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'MAP_CopyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (associated(SrcOutputData%Fx)) then + LB(1:1) = lbound(SrcOutputData%Fx) + UB(1:1) = ubound(SrcOutputData%Fx) + if (.not. associated(DstOutputData%Fx)) then + allocate(DstOutputData%Fx(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Fx.', ErrStat, ErrMsg, RoutineName) + return + end if + DstOutputData%C_obj%Fx_Len = size(DstOutputData%Fx) + if (DstOutputData%C_obj%Fx_Len > 0) & + DstOutputData%C_obj%Fx = c_loc(DstOutputData%Fx(LB(1))) + end if + DstOutputData%Fx = SrcOutputData%Fx + end if + if (associated(SrcOutputData%Fy)) then + LB(1:1) = lbound(SrcOutputData%Fy) + UB(1:1) = ubound(SrcOutputData%Fy) + if (.not. associated(DstOutputData%Fy)) then + allocate(DstOutputData%Fy(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Fy.', ErrStat, ErrMsg, RoutineName) + return + end if + DstOutputData%C_obj%Fy_Len = size(DstOutputData%Fy) + if (DstOutputData%C_obj%Fy_Len > 0) & + DstOutputData%C_obj%Fy = c_loc(DstOutputData%Fy(LB(1))) + end if + DstOutputData%Fy = SrcOutputData%Fy + end if + if (associated(SrcOutputData%Fz)) then + LB(1:1) = lbound(SrcOutputData%Fz) + UB(1:1) = ubound(SrcOutputData%Fz) + if (.not. associated(DstOutputData%Fz)) then + allocate(DstOutputData%Fz(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Fz.', ErrStat, ErrMsg, RoutineName) + return + end if + DstOutputData%C_obj%Fz_Len = size(DstOutputData%Fz) + if (DstOutputData%C_obj%Fz_Len > 0) & + DstOutputData%C_obj%Fz = c_loc(DstOutputData%Fz(LB(1))) + end if + DstOutputData%Fz = SrcOutputData%Fz + end if + if (allocated(SrcOutputData%WriteOutput)) then + LB(1:1) = lbound(SrcOutputData%WriteOutput) + UB(1:1) = ubound(SrcOutputData%WriteOutput) + if (.not. allocated(DstOutputData%WriteOutput)) then + allocate(DstOutputData%WriteOutput(LB(1):UB(1)), 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 + end if + if (associated(SrcOutputData%wrtOutput)) then + LB(1:1) = lbound(SrcOutputData%wrtOutput) + UB(1:1) = ubound(SrcOutputData%wrtOutput) + if (.not. associated(DstOutputData%wrtOutput)) then + allocate(DstOutputData%wrtOutput(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%wrtOutput.', ErrStat, ErrMsg, RoutineName) + return + end if + DstOutputData%C_obj%wrtOutput_Len = size(DstOutputData%wrtOutput) + if (DstOutputData%C_obj%wrtOutput_Len > 0) & + DstOutputData%C_obj%wrtOutput = c_loc(DstOutputData%wrtOutput(LB(1))) + end if + DstOutputData%wrtOutput = SrcOutputData%wrtOutput + end if + call MeshCopy(SrcOutputData%ptFairleadLoad, DstOutputData%ptFairleadLoad, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine MAP_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(MAP_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'MAP_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (associated(OutputData%Fx)) then + deallocate(OutputData%Fx) + OutputData%Fx => null() + OutputData%C_obj%Fx = c_null_ptr + OutputData%C_obj%Fx_Len = 0 + end if + if (associated(OutputData%Fy)) then + deallocate(OutputData%Fy) + OutputData%Fy => null() + OutputData%C_obj%Fy = c_null_ptr + OutputData%C_obj%Fy_Len = 0 + end if + if (associated(OutputData%Fz)) then + deallocate(OutputData%Fz) + OutputData%Fz => null() + OutputData%C_obj%Fz = c_null_ptr + OutputData%C_obj%Fz_Len = 0 + end if + if (allocated(OutputData%WriteOutput)) then + deallocate(OutputData%WriteOutput) + end if + if (associated(OutputData%wrtOutput)) then + deallocate(OutputData%wrtOutput) + OutputData%wrtOutput => null() + OutputData%C_obj%wrtOutput = c_null_ptr + OutputData%C_obj%wrtOutput_Len = 0 + end if + call MeshDestroy( OutputData%ptFairleadLoad, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine MAP_PackOutput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(MAP_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'MAP_PackOutput' + logical :: PtrInIndex + if (RF%ErrStat >= AbortErrLev) return + if (c_associated(InData%C_obj%object)) then + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + call RegPackPtr(RF, InData%Fx) + call RegPackPtr(RF, InData%Fy) + call RegPackPtr(RF, InData%Fz) + call RegPackAlloc(RF, InData%WriteOutput) + call RegPackPtr(RF, InData%wrtOutput) + call MeshPack(RF, InData%ptFairleadLoad) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine MAP_UnPackOutput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(MAP_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'MAP_UnPackOutput' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(B8Ki) :: PtrIdx + type(c_ptr) :: Ptr + if (RF%ErrStat /= ErrID_None) return + call RegUnpackPtr(RF, OutData%Fx, LB, UB); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%Fx)) then + OutData%C_obj%Fx_Len = size(OutData%Fx) + if (OutData%C_obj%Fx_Len > 0) OutData%C_obj%Fx = c_loc(OutData%Fx(LB(1))) + end if + call RegUnpackPtr(RF, OutData%Fy, LB, UB); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%Fy)) then + OutData%C_obj%Fy_Len = size(OutData%Fy) + if (OutData%C_obj%Fy_Len > 0) OutData%C_obj%Fy = c_loc(OutData%Fy(LB(1))) + end if + call RegUnpackPtr(RF, OutData%Fz, LB, UB); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%Fz)) then + OutData%C_obj%Fz_Len = size(OutData%Fz) + if (OutData%C_obj%Fz_Len > 0) OutData%C_obj%Fz = c_loc(OutData%Fz(LB(1))) + end if + call RegUnpackAlloc(RF, OutData%WriteOutput); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackPtr(RF, OutData%wrtOutput, LB, UB); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%wrtOutput)) then + OutData%C_obj%wrtOutput_Len = size(OutData%wrtOutput) + if (OutData%C_obj%wrtOutput_Len > 0) OutData%C_obj%wrtOutput = c_loc(OutData%wrtOutput(LB(1))) + end if + call MeshUnpack(RF, OutData%ptFairleadLoad) ! ptFairleadLoad +end subroutine + +SUBROUTINE MAP_C2Fary_CopyOutput(OutputData, ErrStat, ErrMsg, SkipPointers) + TYPE(MAP_OutputType), INTENT(INOUT) :: OutputData 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 = 'MAP_CopyOutput' -! + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local ErrStat = ErrID_None ErrMsg = "" -IF (ASSOCIATED(SrcOutputData%Fx)) THEN - i1_l = LBOUND(SrcOutputData%Fx,1) - i1_u = UBOUND(SrcOutputData%Fx,1) - IF (.NOT. ASSOCIATED(DstOutputData%Fx)) THEN - ALLOCATE(DstOutputData%Fx(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Fx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstOutputData%c_obj%Fx_Len = SIZE(DstOutputData%Fx) - IF (DstOutputData%c_obj%Fx_Len > 0) & - DstOutputData%c_obj%Fx = C_LOC( DstOutputData%Fx( i1_l ) ) - END IF - DstOutputData%Fx = SrcOutputData%Fx -ENDIF -IF (ASSOCIATED(SrcOutputData%Fy)) THEN - i1_l = LBOUND(SrcOutputData%Fy,1) - i1_u = UBOUND(SrcOutputData%Fy,1) - IF (.NOT. ASSOCIATED(DstOutputData%Fy)) THEN - ALLOCATE(DstOutputData%Fy(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Fy.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstOutputData%c_obj%Fy_Len = SIZE(DstOutputData%Fy) - IF (DstOutputData%c_obj%Fy_Len > 0) & - DstOutputData%c_obj%Fy = C_LOC( DstOutputData%Fy( i1_l ) ) - END IF - DstOutputData%Fy = SrcOutputData%Fy -ENDIF -IF (ASSOCIATED(SrcOutputData%Fz)) THEN - i1_l = LBOUND(SrcOutputData%Fz,1) - i1_u = UBOUND(SrcOutputData%Fz,1) - IF (.NOT. ASSOCIATED(DstOutputData%Fz)) THEN - ALLOCATE(DstOutputData%Fz(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Fz.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstOutputData%c_obj%Fz_Len = SIZE(DstOutputData%Fz) - IF (DstOutputData%c_obj%Fz_Len > 0) & - DstOutputData%c_obj%Fz = C_LOC( DstOutputData%Fz( i1_l ) ) - END IF - DstOutputData%Fz = SrcOutputData%Fz -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 -IF (ASSOCIATED(SrcOutputData%wrtOutput)) THEN - i1_l = LBOUND(SrcOutputData%wrtOutput,1) - i1_u = UBOUND(SrcOutputData%wrtOutput,1) - IF (.NOT. ASSOCIATED(DstOutputData%wrtOutput)) THEN - ALLOCATE(DstOutputData%wrtOutput(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%wrtOutput.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstOutputData%c_obj%wrtOutput_Len = SIZE(DstOutputData%wrtOutput) - IF (DstOutputData%c_obj%wrtOutput_Len > 0) & - DstOutputData%c_obj%wrtOutput = C_LOC( DstOutputData%wrtOutput( i1_l ) ) - END IF - DstOutputData%wrtOutput = SrcOutputData%wrtOutput -ENDIF - CALL MeshCopy( SrcOutputData%ptFairleadLoad, DstOutputData%ptFairleadLoad, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE MAP_CopyOutput - - SUBROUTINE MAP_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(MAP_OutputType), INTENT(INOUT) :: OutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MAP_DestroyOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ASSOCIATED(OutputData%Fx)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(OutputData%Fx) - OutputData%Fx => NULL() - OutputData%C_obj%Fx = C_NULL_PTR - OutputData%C_obj%Fx_Len = 0 -ENDIF -IF (ASSOCIATED(OutputData%Fy)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(OutputData%Fy) - OutputData%Fy => NULL() - OutputData%C_obj%Fy = C_NULL_PTR - OutputData%C_obj%Fy_Len = 0 -ENDIF -IF (ASSOCIATED(OutputData%Fz)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(OutputData%Fz) - OutputData%Fz => NULL() - OutputData%C_obj%Fz = C_NULL_PTR - OutputData%C_obj%Fz_Len = 0 -ENDIF -IF (ALLOCATED(OutputData%WriteOutput)) THEN - DEALLOCATE(OutputData%WriteOutput) -ENDIF -IF (ASSOCIATED(OutputData%wrtOutput)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(OutputData%wrtOutput) - OutputData%wrtOutput => NULL() - OutputData%C_obj%wrtOutput = C_NULL_PTR - OutputData%C_obj%wrtOutput_Len = 0 -ENDIF - CALL MeshDestroy( OutputData%ptFairleadLoad, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE MAP_DestroyOutput - - SUBROUTINE MAP_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(MAP_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 = 'MAP_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 ! Fx allocated yes/no - IF ( ASSOCIATED(InData%Fx) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Fx upper/lower bounds for each dimension - Db_BufSz = Db_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 - Db_BufSz = Db_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 - Db_BufSz = Db_BufSz + SIZE(InData%Fz) ! Fz - 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 - Int_BufSz = Int_BufSz + 1 ! wrtOutput allocated yes/no - IF ( ASSOCIATED(InData%wrtOutput) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! wrtOutput upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%wrtOutput) ! wrtOutput - END IF - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! ptFairleadLoad: size of buffers for each call to pack subtype - CALL MeshPack( InData%ptFairleadLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! ptFairleadLoad - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! ptFairleadLoad - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + + ! -- Fx Output Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OutputData%C_obj%Fx ) ) THEN + NULLIFY( OutputData%Fx ) + ELSE + CALL C_F_POINTER(OutputData%C_obj%Fx, OutputData%Fx, [OutputData%C_obj%Fx_Len]) END IF - IF(ALLOCATED(Db_Buf)) THEN ! ptFairleadLoad - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) + END IF + + ! -- Fy Output Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OutputData%C_obj%Fy ) ) THEN + NULLIFY( OutputData%Fy ) + ELSE + CALL C_F_POINTER(OutputData%C_obj%Fy, OutputData%Fy, [OutputData%C_obj%Fy_Len]) END IF - IF(ALLOCATED(Int_Buf)) THEN ! ptFairleadLoad - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) + END IF + + ! -- Fz Output Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OutputData%C_obj%Fz ) ) THEN + NULLIFY( OutputData%Fz ) + ELSE + CALL C_F_POINTER(OutputData%C_obj%Fz, OutputData%Fz, [OutputData%C_obj%Fz_Len]) 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%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) - DbKiBuf(Db_Xferred) = InData%Fx(i1) - Db_Xferred = Db_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) - DbKiBuf(Db_Xferred) = InData%Fy(i1) - Db_Xferred = Db_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) - DbKiBuf(Db_Xferred) = InData%Fz(i1) - Db_Xferred = Db_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 - IF ( .NOT. ASSOCIATED(InData%wrtOutput) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%wrtOutput,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%wrtOutput,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%wrtOutput,1), UBOUND(InData%wrtOutput,1) - DbKiBuf(Db_Xferred) = InData%wrtOutput(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - CALL MeshPack( InData%ptFairleadLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! ptFairleadLoad - 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) + END IF + + ! -- wrtOutput Output Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OutputData%C_obj%wrtOutput ) ) THEN + NULLIFY( OutputData%wrtOutput ) 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) + CALL C_F_POINTER(OutputData%C_obj%wrtOutput, OutputData%wrtOutput, [OutputData%C_obj%wrtOutput_Len]) + END IF + END IF +END SUBROUTINE + +SUBROUTINE MAP_F2C_CopyOutput( OutputData, ErrStat, ErrMsg, SkipPointers ) + TYPE(MAP_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 + + ! -- Fx Output Data fields + IF (.NOT. SkipPointers_local ) THEN + IF (.NOT. ASSOCIATED(OutputData%Fx)) THEN + OutputData%C_obj%Fx_Len = 0 + OutputData%C_obj%Fx = C_NULL_PTR 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) + OutputData%C_obj%Fx_Len = SIZE(OutputData%Fx) + IF (OutputData%C_obj%Fx_Len > 0) & + OutputData%C_obj%Fx = C_LOC(OutputData%Fx(lbound(OutputData%Fx,1))) + END IF + END IF + + ! -- Fy Output Data fields + IF (.NOT. SkipPointers_local ) THEN + IF (.NOT. ASSOCIATED(OutputData%Fy)) THEN + OutputData%C_obj%Fy_Len = 0 + OutputData%C_obj%Fy = C_NULL_PTR ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END SUBROUTINE MAP_PackOutput - - SUBROUTINE MAP_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(MAP_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 = 'MAP_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 ! 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(DbKiBuf(Db_Xferred), C_DOUBLE) - Db_Xferred = Db_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(DbKiBuf(Db_Xferred), C_DOUBLE) - Db_Xferred = Db_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(DbKiBuf(Db_Xferred), C_DOUBLE) - Db_Xferred = Db_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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! wrtOutput not allocated - Int_Xferred = Int_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%wrtOutput)) DEALLOCATE(OutData%wrtOutput) - ALLOCATE(OutData%wrtOutput(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%wrtOutput.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%c_obj%wrtOutput_Len = SIZE(OutData%wrtOutput) - IF (OutData%c_obj%wrtOutput_Len > 0) & - OutData%c_obj%wrtOutput = C_LOC( OutData%wrtOutput( i1_l ) ) - DO i1 = LBOUND(OutData%wrtOutput,1), UBOUND(OutData%wrtOutput,1) - OutData%wrtOutput(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) - Db_Xferred = Db_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 + OutputData%C_obj%Fy_Len = SIZE(OutputData%Fy) + IF (OutputData%C_obj%Fy_Len > 0) & + OutputData%C_obj%Fy = C_LOC(OutputData%Fy(lbound(OutputData%Fy,1))) 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 + + ! -- Fz Output Data fields + IF (.NOT. SkipPointers_local ) THEN + IF (.NOT. ASSOCIATED(OutputData%Fz)) THEN + OutputData%C_obj%Fz_Len = 0 + OutputData%C_obj%Fz = C_NULL_PTR + ELSE + OutputData%C_obj%Fz_Len = SIZE(OutputData%Fz) + IF (OutputData%C_obj%Fz_Len > 0) & + OutputData%C_obj%Fz = C_LOC(OutputData%Fz(lbound(OutputData%Fz,1))) 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 + + ! -- wrtOutput Output Data fields + IF (.NOT. SkipPointers_local ) THEN + IF (.NOT. ASSOCIATED(OutputData%wrtOutput)) THEN + OutputData%C_obj%wrtOutput_Len = 0 + OutputData%C_obj%wrtOutput = C_NULL_PTR + ELSE + OutputData%C_obj%wrtOutput_Len = SIZE(OutputData%wrtOutput) + IF (OutputData%C_obj%wrtOutput_Len > 0) & + OutputData%C_obj%wrtOutput = C_LOC(OutputData%wrtOutput(lbound(OutputData%wrtOutput,1))) END IF - CALL MeshUnpack( OutData%ptFairleadLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! ptFairleadLoad - 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 MAP_UnPackOutput - - SUBROUTINE MAP_C2Fary_CopyOutput( OutputData, ErrStat, ErrMsg, SkipPointers ) - TYPE(MAP_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 - - ! -- Fx Output Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( OutputData%C_obj%Fx ) ) THEN - NULLIFY( OutputData%Fx ) - ELSE - CALL C_F_POINTER(OutputData%C_obj%Fx, OutputData%Fx, (/OutputData%C_obj%Fx_Len/)) - END IF - END IF - - ! -- Fy Output Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( OutputData%C_obj%Fy ) ) THEN - NULLIFY( OutputData%Fy ) - ELSE - CALL C_F_POINTER(OutputData%C_obj%Fy, OutputData%Fy, (/OutputData%C_obj%Fy_Len/)) - END IF - END IF - - ! -- Fz Output Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( OutputData%C_obj%Fz ) ) THEN - NULLIFY( OutputData%Fz ) - ELSE - CALL C_F_POINTER(OutputData%C_obj%Fz, OutputData%Fz, (/OutputData%C_obj%Fz_Len/)) - END IF - END IF - - ! -- wrtOutput Output Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( OutputData%C_obj%wrtOutput ) ) THEN - NULLIFY( OutputData%wrtOutput ) - ELSE - CALL C_F_POINTER(OutputData%C_obj%wrtOutput, OutputData%wrtOutput, (/OutputData%C_obj%wrtOutput_Len/)) - END IF - END IF - END SUBROUTINE MAP_C2Fary_CopyOutput - - SUBROUTINE MAP_F2C_CopyOutput( OutputData, ErrStat, ErrMsg, SkipPointers ) - TYPE(MAP_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 - - ! -- Fx Output Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(OutputData%Fx)) THEN - OutputData%c_obj%Fx_Len = 0 - OutputData%c_obj%Fx = C_NULL_PTR - ELSE - OutputData%c_obj%Fx_Len = SIZE(OutputData%Fx) - IF (OutputData%c_obj%Fx_Len > 0) & - OutputData%c_obj%Fx = C_LOC( OutputData%Fx( LBOUND(OutputData%Fx,1) ) ) - END IF - END IF - - ! -- Fy Output Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(OutputData%Fy)) THEN - OutputData%c_obj%Fy_Len = 0 - OutputData%c_obj%Fy = C_NULL_PTR - ELSE - OutputData%c_obj%Fy_Len = SIZE(OutputData%Fy) - IF (OutputData%c_obj%Fy_Len > 0) & - OutputData%c_obj%Fy = C_LOC( OutputData%Fy( LBOUND(OutputData%Fy,1) ) ) - END IF - END IF - - ! -- Fz Output Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(OutputData%Fz)) THEN - OutputData%c_obj%Fz_Len = 0 - OutputData%c_obj%Fz = C_NULL_PTR - ELSE - OutputData%c_obj%Fz_Len = SIZE(OutputData%Fz) - IF (OutputData%c_obj%Fz_Len > 0) & - OutputData%c_obj%Fz = C_LOC( OutputData%Fz( LBOUND(OutputData%Fz,1) ) ) - END IF - END IF - - ! -- wrtOutput Output Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(OutputData%wrtOutput)) THEN - OutputData%c_obj%wrtOutput_Len = 0 - OutputData%c_obj%wrtOutput = C_NULL_PTR - ELSE - OutputData%c_obj%wrtOutput_Len = SIZE(OutputData%wrtOutput) - IF (OutputData%c_obj%wrtOutput_Len > 0) & - OutputData%c_obj%wrtOutput = C_LOC( OutputData%wrtOutput( LBOUND(OutputData%wrtOutput,1) ) ) - END IF - END IF - END SUBROUTINE MAP_F2C_CopyOutput - - - SUBROUTINE MAP_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(MAP_InputType), INTENT(INOUT) :: u(:) ! Input at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Inputs - TYPE(MAP_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 + END IF +END SUBROUTINE + +subroutine MAP_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(MAP_InputType), intent(inout) :: u(:) ! Input at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Inputs + type(MAP_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 = 'MAP_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 MAP_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL MAP_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 MAP_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 MAP_Input_ExtrapInterp - - - SUBROUTINE MAP_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'MAP_Input_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(u)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(u)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(u) - 1 + select case (order) + case (0) + call MAP_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call MAP_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call MAP_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(u) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE MAP_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. @@ -5150,61 +2598,53 @@ SUBROUTINE MAP_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ! !.................................................................................................................................. - TYPE(MAP_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 - TYPE(MAP_InputType), INTENT(INOUT) :: u2 ! Input at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs - TYPE(MAP_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 + TYPE(MAP_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 + TYPE(MAP_InputType), INTENT(INOUT) :: u2 ! Input at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs + TYPE(MAP_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 = 'MAP_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 + REAL(DbKi) :: t(2) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'MAP_Input_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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%x) .AND. ASSOCIATED(u1%x)) THEN - DO i1 = LBOUND(u_out%x,1),UBOUND(u_out%x,1) - b = -(u1%x(i1) - u2%x(i1)) - u_out%x(i1) = u1%x(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%y) .AND. ASSOCIATED(u1%y)) THEN - DO i1 = LBOUND(u_out%y,1),UBOUND(u_out%y,1) - b = -(u1%y(i1) - u2%y(i1)) - u_out%y(i1) = u1%y(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%z) .AND. ASSOCIATED(u1%z)) THEN - DO i1 = LBOUND(u_out%z,1),UBOUND(u_out%z,1) - b = -(u1%z(i1) - u2%z(i1)) - u_out%z(i1) = u1%z(i1) + b * ScaleFactor - END DO -END IF ! check if allocated - CALL MeshExtrapInterp1(u1%PtFairDisplacement, u2%PtFairDisplacement, tin, u_out%PtFairDisplacement, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - END SUBROUTINE MAP_Input_ExtrapInterp1 - - - SUBROUTINE MAP_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + IF (ASSOCIATED(u_out%x) .AND. ASSOCIATED(u1%x)) THEN + u_out%x = a1*u1%x + a2*u2%x + END IF ! check if allocated + IF (ASSOCIATED(u_out%y) .AND. ASSOCIATED(u1%y)) THEN + u_out%y = a1*u1%y + a2*u2%y + END IF ! check if allocated + IF (ASSOCIATED(u_out%z) .AND. ASSOCIATED(u1%z)) THEN + u_out%z = a1*u1%z + a2*u2%z + END IF ! check if allocated + CALL MeshExtrapInterp1(u1%PtFairDisplacement, u2%PtFairDisplacement, tin, u_out%PtFairDisplacement, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) +END SUBROUTINE + +SUBROUTINE MAP_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. @@ -5218,124 +2658,113 @@ SUBROUTINE MAP_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Err ! !.................................................................................................................................. - TYPE(MAP_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 > t3 - TYPE(MAP_InputType), INTENT(INOUT) :: u2 ! Input at t2 > t3 - TYPE(MAP_InputType), INTENT(INOUT) :: u3 ! Input at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs - TYPE(MAP_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 + TYPE(MAP_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 > t3 + TYPE(MAP_InputType), INTENT(INOUT) :: u2 ! Input at t2 > t3 + TYPE(MAP_InputType), INTENT(INOUT) :: u3 ! Input at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs + TYPE(MAP_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 = 'MAP_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) - + 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) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'MAP_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 + 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 + 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 + 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%x) .AND. ASSOCIATED(u1%x)) THEN - DO i1 = LBOUND(u_out%x,1),UBOUND(u_out%x,1) - b = (t(3)**2*(u1%x(i1) - u2%x(i1)) + t(2)**2*(-u1%x(i1) + u3%x(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%x(i1) + t(3)*u2%x(i1) - t(2)*u3%x(i1) ) * scaleFactor - u_out%x(i1) = u1%x(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%y) .AND. ASSOCIATED(u1%y)) THEN - DO i1 = LBOUND(u_out%y,1),UBOUND(u_out%y,1) - b = (t(3)**2*(u1%y(i1) - u2%y(i1)) + t(2)**2*(-u1%y(i1) + u3%y(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%y(i1) + t(3)*u2%y(i1) - t(2)*u3%y(i1) ) * scaleFactor - u_out%y(i1) = u1%y(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%z) .AND. ASSOCIATED(u1%z)) THEN - DO i1 = LBOUND(u_out%z,1),UBOUND(u_out%z,1) - b = (t(3)**2*(u1%z(i1) - u2%z(i1)) + t(2)**2*(-u1%z(i1) + u3%z(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%z(i1) + t(3)*u2%z(i1) - t(2)*u3%z(i1) ) * scaleFactor - u_out%z(i1) = u1%z(i1) + b + c * t_out - END DO -END IF ! check if allocated - CALL MeshExtrapInterp2(u1%PtFairDisplacement, u2%PtFairDisplacement, u3%PtFairDisplacement, tin, u_out%PtFairDisplacement, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - END SUBROUTINE MAP_Input_ExtrapInterp2 - - - SUBROUTINE MAP_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(MAP_OutputType), INTENT(INOUT) :: y(:) ! Output at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Outputs - TYPE(MAP_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 + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + IF (ASSOCIATED(u_out%x) .AND. ASSOCIATED(u1%x)) THEN + u_out%x = a1*u1%x + a2*u2%x + a3*u3%x + END IF ! check if allocated + IF (ASSOCIATED(u_out%y) .AND. ASSOCIATED(u1%y)) THEN + u_out%y = a1*u1%y + a2*u2%y + a3*u3%y + END IF ! check if allocated + IF (ASSOCIATED(u_out%z) .AND. ASSOCIATED(u1%z)) THEN + u_out%z = a1*u1%z + a2*u2%z + a3*u3%z + END IF ! check if allocated + CALL MeshExtrapInterp2(u1%PtFairDisplacement, u2%PtFairDisplacement, u3%PtFairDisplacement, tin, u_out%PtFairDisplacement, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) +END SUBROUTINE + +subroutine MAP_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(MAP_OutputType), intent(inout) :: y(:) ! Output at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Outputs + type(MAP_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 = 'MAP_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 MAP_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL MAP_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 MAP_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 MAP_Output_ExtrapInterp - - - SUBROUTINE MAP_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'MAP_Output_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(y)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(y)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(y) - 1 + select case (order) + case (0) + call MAP_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call MAP_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call MAP_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(y) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE MAP_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. @@ -5347,73 +2776,59 @@ SUBROUTINE MAP_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ! !.................................................................................................................................. - TYPE(MAP_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 - TYPE(MAP_OutputType), INTENT(INOUT) :: y2 ! Output at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs - TYPE(MAP_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 + TYPE(MAP_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 + TYPE(MAP_OutputType), INTENT(INOUT) :: y2 ! Output at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs + TYPE(MAP_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 = 'MAP_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 + REAL(DbKi) :: t(2) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'MAP_Output_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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%Fx) .AND. ASSOCIATED(y1%Fx)) THEN - DO i1 = LBOUND(y_out%Fx,1),UBOUND(y_out%Fx,1) - b = -(y1%Fx(i1) - y2%Fx(i1)) - y_out%Fx(i1) = y1%Fx(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ASSOCIATED(y_out%Fy) .AND. ASSOCIATED(y1%Fy)) THEN - DO i1 = LBOUND(y_out%Fy,1),UBOUND(y_out%Fy,1) - b = -(y1%Fy(i1) - y2%Fy(i1)) - y_out%Fy(i1) = y1%Fy(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ASSOCIATED(y_out%Fz) .AND. ASSOCIATED(y1%Fz)) THEN - DO i1 = LBOUND(y_out%Fz,1),UBOUND(y_out%Fz,1) - b = -(y1%Fz(i1) - y2%Fz(i1)) - y_out%Fz(i1) = y1%Fz(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 -IF (ASSOCIATED(y_out%wrtOutput) .AND. ASSOCIATED(y1%wrtOutput)) THEN - DO i1 = LBOUND(y_out%wrtOutput,1),UBOUND(y_out%wrtOutput,1) - b = -(y1%wrtOutput(i1) - y2%wrtOutput(i1)) - y_out%wrtOutput(i1) = y1%wrtOutput(i1) + b * ScaleFactor - END DO -END IF ! check if allocated - CALL MeshExtrapInterp1(y1%ptFairleadLoad, y2%ptFairleadLoad, tin, y_out%ptFairleadLoad, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - END SUBROUTINE MAP_Output_ExtrapInterp1 - - - SUBROUTINE MAP_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + IF (ASSOCIATED(y_out%Fx) .AND. ASSOCIATED(y1%Fx)) THEN + y_out%Fx = a1*y1%Fx + a2*y2%Fx + END IF ! check if allocated + IF (ASSOCIATED(y_out%Fy) .AND. ASSOCIATED(y1%Fy)) THEN + y_out%Fy = a1*y1%Fy + a2*y2%Fy + END IF ! check if allocated + IF (ASSOCIATED(y_out%Fz) .AND. ASSOCIATED(y1%Fz)) THEN + y_out%Fz = a1*y1%Fz + a2*y2%Fz + END IF ! check if allocated + IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + END IF ! check if allocated + IF (ASSOCIATED(y_out%wrtOutput) .AND. ASSOCIATED(y1%wrtOutput)) THEN + y_out%wrtOutput = a1*y1%wrtOutput + a2*y2%wrtOutput + END IF ! check if allocated + CALL MeshExtrapInterp1(y1%ptFairleadLoad, y2%ptFairleadLoad, tin, y_out%ptFairleadLoad, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) +END SUBROUTINE + +SUBROUTINE MAP_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. @@ -5427,84 +2842,64 @@ SUBROUTINE MAP_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Er ! !.................................................................................................................................. - TYPE(MAP_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 > t3 - TYPE(MAP_OutputType), INTENT(INOUT) :: y2 ! Output at t2 > t3 - TYPE(MAP_OutputType), INTENT(INOUT) :: y3 ! Output at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs - TYPE(MAP_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 + TYPE(MAP_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 > t3 + TYPE(MAP_OutputType), INTENT(INOUT) :: y2 ! Output at t2 > t3 + TYPE(MAP_OutputType), INTENT(INOUT) :: y3 ! Output at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs + TYPE(MAP_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 = 'MAP_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) - + 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) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'MAP_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 + 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 + 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 + 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%Fx) .AND. ASSOCIATED(y1%Fx)) THEN - DO i1 = LBOUND(y_out%Fx,1),UBOUND(y_out%Fx,1) - b = (t(3)**2*(y1%Fx(i1) - y2%Fx(i1)) + t(2)**2*(-y1%Fx(i1) + y3%Fx(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%Fx(i1) + t(3)*y2%Fx(i1) - t(2)*y3%Fx(i1) ) * scaleFactor - y_out%Fx(i1) = y1%Fx(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ASSOCIATED(y_out%Fy) .AND. ASSOCIATED(y1%Fy)) THEN - DO i1 = LBOUND(y_out%Fy,1),UBOUND(y_out%Fy,1) - b = (t(3)**2*(y1%Fy(i1) - y2%Fy(i1)) + t(2)**2*(-y1%Fy(i1) + y3%Fy(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%Fy(i1) + t(3)*y2%Fy(i1) - t(2)*y3%Fy(i1) ) * scaleFactor - y_out%Fy(i1) = y1%Fy(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ASSOCIATED(y_out%Fz) .AND. ASSOCIATED(y1%Fz)) THEN - DO i1 = LBOUND(y_out%Fz,1),UBOUND(y_out%Fz,1) - b = (t(3)**2*(y1%Fz(i1) - y2%Fz(i1)) + t(2)**2*(-y1%Fz(i1) + y3%Fz(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%Fz(i1) + t(3)*y2%Fz(i1) - t(2)*y3%Fz(i1) ) * scaleFactor - y_out%Fz(i1) = y1%Fz(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 -IF (ASSOCIATED(y_out%wrtOutput) .AND. ASSOCIATED(y1%wrtOutput)) THEN - DO i1 = LBOUND(y_out%wrtOutput,1),UBOUND(y_out%wrtOutput,1) - b = (t(3)**2*(y1%wrtOutput(i1) - y2%wrtOutput(i1)) + t(2)**2*(-y1%wrtOutput(i1) + y3%wrtOutput(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%wrtOutput(i1) + t(3)*y2%wrtOutput(i1) - t(2)*y3%wrtOutput(i1) ) * scaleFactor - y_out%wrtOutput(i1) = y1%wrtOutput(i1) + b + c * t_out - END DO -END IF ! check if allocated - CALL MeshExtrapInterp2(y1%ptFairleadLoad, y2%ptFairleadLoad, y3%ptFairleadLoad, tin, y_out%ptFairleadLoad, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - END SUBROUTINE MAP_Output_ExtrapInterp2 - + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + IF (ASSOCIATED(y_out%Fx) .AND. ASSOCIATED(y1%Fx)) THEN + y_out%Fx = a1*y1%Fx + a2*y2%Fx + a3*y3%Fx + END IF ! check if allocated + IF (ASSOCIATED(y_out%Fy) .AND. ASSOCIATED(y1%Fy)) THEN + y_out%Fy = a1*y1%Fy + a2*y2%Fy + a3*y3%Fy + END IF ! check if allocated + IF (ASSOCIATED(y_out%Fz) .AND. ASSOCIATED(y1%Fz)) THEN + y_out%Fz = a1*y1%Fz + a2*y2%Fz + a3*y3%Fz + END IF ! check if allocated + IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + a3*y3%WriteOutput + END IF ! check if allocated + IF (ASSOCIATED(y_out%wrtOutput) .AND. ASSOCIATED(y1%wrtOutput)) THEN + y_out%wrtOutput = a1*y1%wrtOutput + a2*y2%wrtOutput + a3*y3%wrtOutput + END IF ! check if allocated + CALL MeshExtrapInterp2(y1%ptFairleadLoad, y2%ptFairleadLoad, y3%ptFairleadLoad, tin, y_out%ptFairleadLoad, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) +END SUBROUTINE END MODULE MAP_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/map/src/MAP_Types.h b/modules/map/src/MAP_Types.h index 737caea111..9040c07793 100644 --- a/modules/map/src/MAP_Types.h +++ b/modules/map/src/MAP_Types.h @@ -7,117 +7,115 @@ #ifndef _MAP_TYPES_H #define _MAP_TYPES_H - #ifdef _WIN32 //define something for Windows (32-bit) -# include "stdbool.h" -# define CALL __declspec( dllexport ) + #include "stdbool.h" + #define CALL __declspec(dllexport) #elif _WIN64 //define something for Windows (64-bit) -# include "stdbool.h" -# define CALL __declspec( dllexport ) + #include "stdbool.h" + #define CALL __declspec(dllexport) #else -# include -# define CALL + #include + #define CALL #endif - - typedef struct MAP_InitInputType { - void * object ; - double gravity ; - double sea_density ; - double depth ; - char file_name[255] ; - char summary_file_name[255] ; - char library_input_str[255] ; - char node_input_str[255] ; - char line_input_str[255] ; - char option_input_str[255] ; - - } MAP_InitInputType_t ; - typedef struct MAP_InitOutputType { - void * object ; - char progName[99] ; - char version[99] ; - char compilingData[24] ; - char * writeOutputHdr ; int writeOutputHdr_Len ; - char * writeOutputUnt ; int writeOutputUnt_Len ; - - - } MAP_InitOutputType_t ; - typedef struct MAP_ContinuousStateType { - void * object ; - double dummy ; - } MAP_ContinuousStateType_t ; - typedef struct MAP_DiscreteStateType { - void * object ; - double dummy ; - } MAP_DiscreteStateType_t ; - typedef struct MAP_OtherStateType { - void * object ; - double * H ; int H_Len ; - double * V ; int V_Len ; - double * Ha ; int Ha_Len ; - double * Va ; int Va_Len ; - double * x ; int x_Len ; - double * y ; int y_Len ; - double * z ; int z_Len ; - double * xa ; int xa_Len ; - double * ya ; int ya_Len ; - double * za ; int za_Len ; - double * Fx_connect ; int Fx_connect_Len ; - double * Fy_connect ; int Fy_connect_Len ; - double * Fz_connect ; int Fz_connect_Len ; - double * Fx_anchor ; int Fx_anchor_Len ; - double * Fy_anchor ; int Fy_anchor_Len ; - double * Fz_anchor ; int Fz_anchor_Len ; - } MAP_OtherStateType_t ; - typedef struct MAP_ConstraintStateType { - void * object ; - double * H ; int H_Len ; - double * V ; int V_Len ; - double * x ; int x_Len ; - double * y ; int y_Len ; - double * z ; int z_Len ; - } MAP_ConstraintStateType_t ; - typedef struct MAP_ParameterType { - void * object ; - double g ; - double depth ; - double rho_sea ; - double dt ; - - - int numOuts ; - - } MAP_ParameterType_t ; - typedef struct MAP_InputType { - void * object ; - double * x ; int x_Len ; - double * y ; int y_Len ; - double * z ; int z_Len ; - - } MAP_InputType_t ; - typedef struct MAP_OutputType { - void * object ; - double * Fx ; int Fx_Len ; - double * Fy ; int Fy_Len ; - double * Fz ; int Fz_Len ; - float * WriteOutput ; int WriteOutput_Len ; - double * wrtOutput ; int wrtOutput_Len ; - - } MAP_OutputType_t ; - typedef struct MAP_UserData { - MAP_InitInputType_t MAP_InitInput ; - MAP_InitOutputType_t MAP_InitOutput ; - MAP_ContinuousStateType_t MAP_ContState ; - MAP_DiscreteStateType_t MAP_DiscState ; - MAP_OtherStateType_t MAP_OtherState ; - MAP_ConstraintStateType_t MAP_ConstrState ; - MAP_ParameterType_t MAP_Param ; - MAP_InputType_t MAP_Input ; - MAP_OutputType_t MAP_Output ; - } MAP_t ; +typedef struct MAP_InitInputType { + void *object; + double gravity; + double sea_density; + double depth; + char file_name[255]; + char summary_file_name[255]; + char library_input_str[255]; + char node_input_str[255]; + char line_input_str[255]; + char option_input_str[255]; +} MAP_InitInputType_t; + +typedef struct MAP_InitOutputType { + void *object; + char progName[99]; + char version[99]; + char compilingData[24]; + char *writeOutputHdr; int writeOutputHdr_Len; + char *writeOutputUnt; int writeOutputUnt_Len; +} MAP_InitOutputType_t; + +typedef struct MAP_ContinuousStateType { + void *object; + double dummy; +} MAP_ContinuousStateType_t; + +typedef struct MAP_DiscreteStateType { + void *object; + double dummy; +} MAP_DiscreteStateType_t; + +typedef struct MAP_OtherStateType { + void *object; + double *H; int H_Len; + double *V; int V_Len; + double *Ha; int Ha_Len; + double *Va; int Va_Len; + double *x; int x_Len; + double *y; int y_Len; + double *z; int z_Len; + double *xa; int xa_Len; + double *ya; int ya_Len; + double *za; int za_Len; + double *Fx_connect; int Fx_connect_Len; + double *Fy_connect; int Fy_connect_Len; + double *Fz_connect; int Fz_connect_Len; + double *Fx_anchor; int Fx_anchor_Len; + double *Fy_anchor; int Fy_anchor_Len; + double *Fz_anchor; int Fz_anchor_Len; +} MAP_OtherStateType_t; + +typedef struct MAP_ConstraintStateType { + void *object; + double *H; int H_Len; + double *V; int V_Len; + double *x; int x_Len; + double *y; int y_Len; + double *z; int z_Len; +} MAP_ConstraintStateType_t; + +typedef struct MAP_ParameterType { + void *object; + double g; + double depth; + double rho_sea; + double dt; + int numOuts; +} MAP_ParameterType_t; + +typedef struct MAP_InputType { + void *object; + double *x; int x_Len; + double *y; int y_Len; + double *z; int z_Len; +} MAP_InputType_t; + +typedef struct MAP_OutputType { + void *object; + double *Fx; int Fx_Len; + double *Fy; int Fy_Len; + double *Fz; int Fz_Len; + float *WriteOutput; int WriteOutput_Len; + double *wrtOutput; int wrtOutput_Len; +} MAP_OutputType_t; + +typedef struct MAP_UserData { + MAP_InitInputType_t MAP_InitInput; + MAP_InitOutputType_t MAP_InitOutput; + MAP_ContinuousStateType_t MAP_ContState; + MAP_DiscreteStateType_t MAP_DiscState; + MAP_OtherStateType_t MAP_OtherState; + MAP_ConstraintStateType_t MAP_ConstrState; + MAP_ParameterType_t MAP_Param; + MAP_InputType_t MAP_Input; + MAP_OutputType_t MAP_Output; +} MAP_t; #endif // _MAP_TYPES_H - //!ENDOFREGISTRYGENERATEDFILE diff --git a/modules/map/src/bstring/bstraux.c b/modules/map/src/bstring/bstraux.c index be75254f74..d5ce35a0ff 100644 --- a/modules/map/src/bstring/bstraux.c +++ b/modules/map/src/bstring/bstraux.c @@ -35,7 +35,7 @@ #include "config.h" #endif -#ifdef _MSC_VER +#if defined _MSC_VER && !defined _CRT_SECURE_NO_WARNINGS #define _CRT_SECURE_NO_WARNINGS #endif diff --git a/modules/map/src/bstring/bstrlib.c b/modules/map/src/bstring/bstrlib.c index 3dde95324f..9f32a5a9ab 100644 --- a/modules/map/src/bstring/bstrlib.c +++ b/modules/map/src/bstring/bstrlib.c @@ -39,7 +39,7 @@ #include "config.h" #endif -#if defined (_MSC_VER) +#if defined _MSC_VER && !defined _CRT_SECURE_NO_WARNINGS /* These warnings from MSVC++ are totally pointless. */ # define _CRT_SECURE_NO_WARNINGS #endif diff --git a/modules/map/src/map.f90 b/modules/map/src/map.f90 index fbad83037e..d116bdd5cd 100644 --- a/modules/map/src/map.f90 +++ b/modules/map/src/map.f90 @@ -404,7 +404,7 @@ SUBROUTINE MAP_Restart( u, p, x, xd, z, other, y, ErrStat, ErrMsg ) CHARACTER(KIND=C_CHAR), DIMENSION(1024) :: message_from_MAP INTEGER(IntKi) :: ErrStat2 ! Error status of the operation - CHARACTER(1024) :: ErrMsg2 ! Error message if ErrStat /= ErrID_None + CHARACTER(ErrMsgLen) :: ErrMsg2 ! Error message if ErrStat /= ErrID_None CHARACTER(*), PARAMETER :: RoutineName = 'MAP_Restart' @@ -517,7 +517,7 @@ SUBROUTINE MAP_Init( InitInp, u, p, x, xd, z, other, y, Interval, InitOut, ErrSt CHARACTER(KIND=C_CHAR), DIMENSION(1024) :: message_from_MAP INTEGER(IntKi) :: ErrStat2 ! Error status of the operation - CHARACTER(1024) :: ErrMsg2 ! Error message if ErrStat /= ErrID_None + CHARACTER(ErrMsgLen) :: ErrMsg2 ! Error message if ErrStat /= ErrID_None CHARACTER(*), PARAMETER :: RoutineName = 'MAP_Init' INTEGER(IntKi) :: i @@ -722,7 +722,7 @@ SUBROUTINE MAP_UpdateStates( t, n, u, utimes, p, x, xd, z, O, ErrStat, ErrMsg) TYPE(MAP_InputType) :: u_interp ! Inputs at t INTEGER(IntKi) :: ErrStat2 ! Error status of the operation - CHARACTER(1024) :: ErrMsg2 ! Error message if ErrStat /= ErrID_None + CHARACTER(ErrMsgLen) :: ErrMsg2 ! Error message if ErrStat /= ErrID_None CHARACTER(*), PARAMETER :: RoutineName = 'MAP_UpdateStates' ErrStat = ErrID_None @@ -796,7 +796,7 @@ SUBROUTINE MAP_CalcOutput( t, u, p, x, xd, z, O, y, ErrStat, ErrMsg ) integer :: i INTEGER(IntKi) :: ErrStat2 ! Error status of the operation - CHARACTER(1024) :: ErrMsg2 ! Error message if ErrStat /= ErrID_None + CHARACTER(ErrMsgLen) :: ErrMsg2 ! Error message if ErrStat /= ErrID_None CHARACTER(*), PARAMETER :: RoutineName = 'MAP_CalcOutput' @@ -859,7 +859,7 @@ SUBROUTINE MAP_End(u, p, x, xd, z, other, y, ErrStat , ErrMsg) ! INTEGER(IntKi) :: i=0 INTEGER(IntKi) :: ErrStat2 ! Error status of the operation - CHARACTER(1024) :: ErrMsg2 ! Error message if ErrStat /= ErrID_None + CHARACTER(ErrMsgLen) :: ErrMsg2 ! Error message if ErrStat /= ErrID_None CHARACTER(*), PARAMETER :: RoutineName = 'MAP_End' @@ -920,7 +920,7 @@ SUBROUTINE map_read_input_file_contents(file, InitInp, p, ErrStat) CHARACTER(255) :: line INTEGER :: Un - CHARACTER(1024) :: ErrMsg + CHARACTER(ErrMsgLen) :: ErrMsg CHARACTER(*), PARAMETER :: RoutineName = 'map_read_input_file_contents' ErrStat = ErrID_None @@ -1495,22 +1495,6 @@ SUBROUTINE MAP_GetOP( t, u, p, x, xd, z, OtherState, y, ErrStat, ErrMsg, u_op, y END SUBROUTINE MAP_GetOP !========================================================================================================== - - ! ========== MAP_ERROR ====== <-------------------------------------------------------------------+ - ! ! | - ! this is different from MAP_ERROR_CHECKER. MAP_ERROR check internal fortran errors, whereas - ! the former checks errors in the MAP DLL. - SUBROUTINE MAP_ERROR(ErrMsg, ErrStat, string) - CHARACTER(1024), INTENT(INOUT) :: ErrMsg - INTEGER(IntKi), INTENT(INOUT) :: ErrStat - CHARACTER(*), INTENT(IN ) :: string - - IF (ErrStat.NE.ErrID_None) THEN - ErrMsg = TRIM(ErrMsg)//string - END IF - END SUBROUTINE MAP_ERROR ! -------+ - !========================================================================================================== - ! ========== MAP_ERROR_CHECKER ====== <-----------------------------------------------------------+ ! ! | diff --git a/modules/map/src/mapapi.c b/modules/map/src/mapapi.c index 22584e85a0..ec86d8402a 100644 --- a/modules/map/src/mapapi.c +++ b/modules/map/src/mapapi.c @@ -21,10 +21,9 @@ ****************************************************************/ +#include "mapapi.h" #include "map.h" -#include "maperror.h" #include "MAP_Types.h" -#include "mapapi.h" #include "lineroutines.h" #include "freedata.h" #include "mapinit.h" @@ -32,6 +31,7 @@ #include "numeric.h" #include "jacobian.h" #include "residual.h" +#include MAP_EXTERNCALL void map_initialize_msqs_base(MAP_InputType_t* u_type, @@ -1162,6 +1162,12 @@ MAP_EXTERNCALL void map_set_gravity(MAP_ParameterType_t* p_type, const double gr p_type->g = gravity; }; +MAP_EXTERNCALL void map_set_input_text(MAP_InitInputType_t* init_type, const char* input_txt_line) +{ + MAP_STRNCPY(init_type->library_input_str, input_txt_line, 254); + init_type->library_input_str[254] = '\0'; +} + MAP_EXTERNCALL void map_add_cable_library_input_text(MAP_InitInputType_t* init_type) { diff --git a/modules/map/src/mapapi.h b/modules/map/src/mapapi.h index 0bd60fbf6b..5d7134b1bf 100644 --- a/modules/map/src/mapapi.h +++ b/modules/map/src/mapapi.h @@ -25,6 +25,36 @@ #define _MAPAPI_H +// MAP_EXTERNCALL +#include "mapsys.h" +// MAP_ERROR_CODE +#include "maperror.h" + +#ifdef __cplusplus +extern "C" +{ +#endif + +#if defined _MSC_VER && !defined _CRT_SECURE_NO_WARNINGS +#define _CRT_SECURE_NO_WARNINGS +#endif + +// Some redefinitions from MAP_Types.h, so the API does not need to exposes the +// internal data structures. +typedef struct MAP_InputType* MAP_Input_t; +typedef struct MAP_ParameterType* MAP_Parameter_t; +typedef struct MAP_ContinuousStateType* MAP_ContinuousState_t; +typedef struct MAP_DiscreteStateType* MAP_DiscreteState_t; +typedef struct MAP_ConstraintStateType* MAP_ConstraintState_t; +typedef struct MAP_OtherStateType* MAP_OtherState_t; +typedef struct MAP_OutputType* MAP_Output_t; +typedef struct MAP_InitOutputType* MAP_InitOutput_t; +typedef struct MAP_InitInputType* MAP_InitInput_t; +// Same with map.h +typedef struct InitializationData_t* MAP_InitializationData_t; +typedef struct Domain_t* MAP_Domain_t; + + /** * @brief Initalizes all MAP base types (including some internal state) * @details The idea is to set variables to zero and null to prevent seg-faults in the case of @@ -34,25 +64,26 @@ * @see map_init() * @return Size of CableLibrary structure */ -MAP_EXTERNCALL void map_initialize_msqs_base(MAP_InputType_t* u_type, MAP_ParameterType_t* p_type, MAP_ContinuousStateType_t* x_type, MAP_ConstraintStateType_t* z_type, MAP_OtherStateType_t* other_type, MAP_OutputType_t* y_type, MAP_InitOutputType_t* io_type); - - -MAP_EXTERNCALL void set_init_to_null(MAP_InitInputType_t* init_type, char* map_msg, MAP_ERROR_CODE* ierr); -MAP_EXTERNCALL void map_add_cable_library_input_text(MAP_InitInputType_t* init_type); -MAP_EXTERNCALL void map_add_node_input_text(MAP_InitInputType_t* init_type); -MAP_EXTERNCALL void map_add_line_input_text(MAP_InitInputType_t* init_type); -MAP_EXTERNCALL void map_add_options_input_text(MAP_InitInputType_t* init_type); -MAP_EXTERNCALL double* map_plot_x_array(MAP_OtherStateType_t* other_type, int i, int num_points, char* map_msg, MAP_ERROR_CODE* ierr); -MAP_EXTERNCALL double* map_plot_y_array(MAP_OtherStateType_t* other_type, int i, int num_points, char* map_msg, MAP_ERROR_CODE* ierr); -MAP_EXTERNCALL double* map_plot_z_array(MAP_OtherStateType_t* other_type, int i, int num_points, char* map_msg, MAP_ERROR_CODE* ierr); +MAP_EXTERNCALL void map_initialize_msqs_base(MAP_Input_t u_type, MAP_Parameter_t p_type, MAP_ContinuousState_t x_type, MAP_ConstraintState_t z_type, MAP_OtherState_t other_type, MAP_Output_t y_type, MAP_InitOutput_t io_type); + + +MAP_EXTERNCALL void set_init_to_null(MAP_InitInput_t init_type, char* map_msg, MAP_ERROR_CODE* ierr); +MAP_EXTERNCALL void map_set_input_text(MAP_InitInput_t init_type, const char* input_txt_line); +MAP_EXTERNCALL void map_add_cable_library_input_text(MAP_InitInput_t init_type); +MAP_EXTERNCALL void map_add_node_input_text(MAP_InitInput_t init_type); +MAP_EXTERNCALL void map_add_line_input_text(MAP_InitInput_t init_type); +MAP_EXTERNCALL void map_add_options_input_text(MAP_InitInput_t init_type); +MAP_EXTERNCALL double* map_plot_x_array(MAP_OtherState_t other_type, int i, int num_points, char* map_msg, MAP_ERROR_CODE* ierr); +MAP_EXTERNCALL double* map_plot_y_array(MAP_OtherState_t other_type, int i, int num_points, char* map_msg, MAP_ERROR_CODE* ierr); +MAP_EXTERNCALL double* map_plot_z_array(MAP_OtherState_t other_type, int i, int num_points, char* map_msg, MAP_ERROR_CODE* ierr); MAP_EXTERNCALL void map_plot_array_free(double* array) ; -MAP_EXTERNCALL double map_residual_function_length(MAP_OtherStateType_t* other_type, int i, char* map_msg, MAP_ERROR_CODE* ierr); -MAP_EXTERNCALL double map_residual_function_height(MAP_OtherStateType_t* other_type, int i, char* map_msg, MAP_ERROR_CODE* ierr); -MAP_EXTERNCALL double map_jacobian_dxdh(MAP_OtherStateType_t* other_type, int i, char* map_msg, MAP_ERROR_CODE* ierr); -MAP_EXTERNCALL double map_jacobian_dxdv(MAP_OtherStateType_t* other_type, int i, char* map_msg, MAP_ERROR_CODE* ierr); -MAP_EXTERNCALL double map_jacobian_dzdh(MAP_OtherStateType_t* other_type, int i, char* map_msg, MAP_ERROR_CODE* ierr); -MAP_EXTERNCALL double map_jacobian_dzdv(MAP_OtherStateType_t* other_type, int i, char* map_msg, MAP_ERROR_CODE* ierr); -MAP_EXTERNCALL int map_size_lines(MAP_OtherStateType_t* other_type, MAP_ERROR_CODE* ierr, char* map_msg); +MAP_EXTERNCALL double map_residual_function_length(MAP_OtherState_t other_type, int i, char* map_msg, MAP_ERROR_CODE* ierr); +MAP_EXTERNCALL double map_residual_function_height(MAP_OtherState_t other_type, int i, char* map_msg, MAP_ERROR_CODE* ierr); +MAP_EXTERNCALL double map_jacobian_dxdh(MAP_OtherState_t other_type, int i, char* map_msg, MAP_ERROR_CODE* ierr); +MAP_EXTERNCALL double map_jacobian_dxdv(MAP_OtherState_t other_type, int i, char* map_msg, MAP_ERROR_CODE* ierr); +MAP_EXTERNCALL double map_jacobian_dzdh(MAP_OtherState_t other_type, int i, char* map_msg, MAP_ERROR_CODE* ierr); +MAP_EXTERNCALL double map_jacobian_dzdv(MAP_OtherState_t other_type, int i, char* map_msg, MAP_ERROR_CODE* ierr); +MAP_EXTERNCALL int map_size_lines(MAP_OtherState_t other_type, MAP_ERROR_CODE* ierr, char* map_msg); /** @@ -63,7 +94,7 @@ MAP_EXTERNCALL int map_size_lines(MAP_OtherStateType_t* other_type, MAP_ERROR_CO * @return MAP_SAFE if it completes successfully * @see {@link map_init()} */ -MAP_EXTERNCALL int free_init_data (InitializationData* init, char* map_msg, MAP_ERROR_CODE* ierr); +MAP_EXTERNCALL int free_init_data (MAP_InitializationData_t init, char* map_msg, MAP_ERROR_CODE* ierr); /** * @brief Set the water depth. Should be called before {@link map_init()} @@ -87,7 +118,7 @@ MAP_EXTERNCALL int free_init_data (InitializationData* init, char* map_msg, MAP_ * CALL mapextern_set_depth(p%C_obj, depth) * @endcode */ -MAP_EXTERNCALL void map_set_sea_depth(MAP_ParameterType_t* p_type, const double depth); +MAP_EXTERNCALL void map_set_sea_depth(MAP_Parameter_t p_type, const double depth); /** @@ -112,7 +143,7 @@ MAP_EXTERNCALL void map_set_sea_depth(MAP_ParameterType_t* p_type, const double * CALL mapextern_set_density(p%C_obj, rho) * @endcode */ -MAP_EXTERNCALL void map_set_sea_density(MAP_ParameterType_t* p_type, const double rho); +MAP_EXTERNCALL void map_set_sea_density(MAP_Parameter_t p_type, const double rho); /** @@ -137,7 +168,7 @@ MAP_EXTERNCALL void map_set_sea_density(MAP_ParameterType_t* p_type, const doubl * CALL mapextern_map_set_gravity(p%C_obj, g) * @endcode */ -MAP_EXTERNCALL void map_set_gravity(MAP_ParameterType_t* p_type, const double gravity); +MAP_EXTERNCALL void map_set_gravity(MAP_Parameter_t p_type, const double gravity); /** @@ -151,7 +182,7 @@ MAP_EXTERNCALL void map_set_gravity(MAP_ParameterType_t* p_type, const double gr * @param ierr, error code * @see */ -MAP_EXTERNCALL void map_get_fairlead_force_2d(double* H, double* V, MAP_OtherStateType_t* other_type, int index, char* map_msg, MAP_ERROR_CODE* ierr); +MAP_EXTERNCALL void map_get_fairlead_force_2d(double* H, double* V, MAP_OtherState_t other_type, int index, char* map_msg, MAP_ERROR_CODE* ierr); /** @@ -166,7 +197,7 @@ MAP_EXTERNCALL void map_get_fairlead_force_2d(double* H, double* V, MAP_OtherSta * @param ierr, error code * @see */ -MAP_EXTERNCALL void map_get_fairlead_force_3d(double* fx, double* fy, double* fz, MAP_OtherStateType_t* other_type, int index, char* map_msg, MAP_ERROR_CODE* ierr); +MAP_EXTERNCALL void map_get_fairlead_force_3d(double* fx, double* fy, double* fz, MAP_OtherState_t other_type, int index, char* map_msg, MAP_ERROR_CODE* ierr); /** @@ -192,13 +223,13 @@ MAP_EXTERNCALL void map_get_fairlead_force_3d(double* fx, double* fy, double* fz * global | * local */ -MAP_EXTERNCALL void map_offset_vessel(MAP_OtherStateType_t* other_type, MAP_InputType_t* u_type, double x, double y, double z, double phi, double the, double psi, char* map_msg, MAP_ERROR_CODE* ierr); +MAP_EXTERNCALL void map_offset_vessel(MAP_OtherState_t other_type, MAP_Input_t u_type, double x, double y, double z, double phi, double the, double psi, char* map_msg, MAP_ERROR_CODE* ierr); /** * lib.linearize_matrix.argtypes = [MapInput_Type, MapData_Type, MapOutnput_Type, c_double, c_char_p, POINTER(c_int)] */ -MAP_EXTERNCALL double** map_linearize_matrix(MAP_InputType_t* u_type, MAP_ParameterType_t* p_type, MAP_OtherStateType_t* other_type, MAP_OutputType_t* y_type, MAP_ConstraintStateType_t* z_type, double epsilon, MAP_ERROR_CODE* ierr, char* map_msg); +MAP_EXTERNCALL double** map_linearize_matrix(MAP_Input_t u_type, MAP_Parameter_t p_type, MAP_OtherState_t other_type, MAP_Output_t y_type, MAP_ConstraintState_t z_type, double epsilon, MAP_ERROR_CODE* ierr, char* map_msg); /** @@ -209,7 +240,7 @@ MAP_EXTERNCALL void map_free_linearize_matrix(double** array); /** * lib.map_f_op.argtypes = [MapInput_Type, MapData_Type, MapOutnput_Type, c_double, c_char_p, POINTER(c_int)] */ -MAP_EXTERNCALL double* map_f_op(MAP_InputType_t* u_type, MAP_ParameterType_t* p_type, MAP_OtherStateType_t* other_type, MAP_OutputType_t* y_type, MAP_ConstraintStateType_t* z_type, MAP_ERROR_CODE* ierr, char* map_msg); +MAP_EXTERNCALL double* map_f_op(MAP_Input_t u_type, MAP_Parameter_t p_type, MAP_OtherState_t other_type, MAP_Output_t y_type, MAP_ConstraintState_t z_type, MAP_ERROR_CODE* ierr, char* map_msg); /** * lib.map_free_f_op.argtypes = [POINTER(c_double)] @@ -232,15 +263,15 @@ MAP_EXTERNCALL void map_free_f_op(double* array); * @param ierr error code * @param map_msg error string */ -MAP_EXTERNCALL void map_init(MAP_InitInputType_t* init_type, - MAP_InputType_t* u_type, - MAP_ParameterType_t* p_type, - MAP_ContinuousStateType_t* x_type, - MAP_DiscreteStateType_t* xd_type, - MAP_ConstraintStateType_t* z_type, - MAP_OtherStateType_t* other_type, - MAP_OutputType_t* y_type, - MAP_InitOutputType_t* ioType, +MAP_EXTERNCALL void map_init(MAP_InitInput_t init_type, + MAP_Input_t u_type, + MAP_Parameter_t p_type, + MAP_ContinuousState_t x_type, + MAP_DiscreteState_t xd_type, + MAP_ConstraintState_t z_type, + MAP_OtherState_t other_type, + MAP_Output_t y_type, + MAP_InitOutput_t ioType, MAP_ERROR_CODE* ierr, char* map_msg); @@ -270,12 +301,12 @@ MAP_EXTERNCALL void map_init(MAP_InitInputType_t* init_type, */ MAP_EXTERNCALL void map_update_states(float t, int interval, - MAP_InputType_t* u_type, - MAP_ParameterType_t* p_type, - MAP_ContinuousStateType_t* x_type, - MAP_DiscreteStateType_t* xd_type, - MAP_ConstraintStateType_t* z_type, - MAP_OtherStateType_t* other_type, + MAP_Input_t u_type, + MAP_Parameter_t p_type, + MAP_ContinuousState_t x_type, + MAP_DiscreteState_t xd_type, + MAP_ConstraintState_t z_type, + MAP_OtherState_t other_type, MAP_ERROR_CODE* ierr, char* map_msg); @@ -296,13 +327,13 @@ MAP_EXTERNCALL void map_update_states(float t, * @see {@link map_update_states()} */ MAP_EXTERNCALL void map_calc_output(float t, - MAP_InputType_t* u_type, - MAP_ParameterType_t* p_type, - MAP_ContinuousStateType_t* x_type, - MAP_DiscreteStateType_t* xd_type, - MAP_ConstraintStateType_t* z_type, - MAP_OtherStateType_t* other_type, - MAP_OutputType_t* y_type, + MAP_Input_t u_type, + MAP_Parameter_t p_type, + MAP_ContinuousState_t x_type, + MAP_DiscreteState_t xd_type, + MAP_ConstraintState_t z_type, + MAP_OtherState_t other_type, + MAP_Output_t y_type, MAP_ERROR_CODE* ierr, char* map_msg); @@ -320,13 +351,13 @@ MAP_EXTERNCALL void map_calc_output(float t, * @param map_msg error string * @see {@link map_update_states()} */ -MAP_EXTERNCALL void map_end(MAP_InputType_t* u_type, - MAP_ParameterType_t* p_type, - MAP_ContinuousStateType_t* x_type, - MAP_DiscreteStateType_t* xd_type, - MAP_ConstraintStateType_t* z_type, - MAP_OtherStateType_t* other_type, - MAP_OutputType_t* y_type, +MAP_EXTERNCALL void map_end(MAP_Input_t u_type, + MAP_Parameter_t p_type, + MAP_ContinuousState_t x_type, + MAP_DiscreteState_t xd_type, + MAP_ConstraintState_t z_type, + MAP_OtherState_t other_type, + MAP_Output_t y_type, MAP_ERROR_CODE* ierr, char* map_msg); @@ -357,7 +388,7 @@ MAP_EXTERNCALL void map_end(MAP_InputType_t* u_type, * @endcode * @todo: need to free summary_file_name. This is done in delete_all_init_data(...), should be called in Fortran routines */ -MAP_EXTERNCALL void map_set_summary_file_name(MAP_InitInputType_t* init_type, char* map_msg, MAP_ERROR_CODE* ierr); +MAP_EXTERNCALL void map_set_summary_file_name(MAP_InitInput_t init_type, char* map_msg, MAP_ERROR_CODE* ierr); /** @@ -390,7 +421,7 @@ MAP_EXTERNCALL void map_set_summary_file_name(MAP_InitInputType_t* init_type, ch * @endcode * @todo this should raise and error when count!=n */ -MAP_EXTERNCALL void map_get_header_string(int* n, char** str_array, MAP_OtherStateType_t* other_type); +MAP_EXTERNCALL void map_get_header_string(int* n, char** str_array, MAP_OtherState_t other_type); /** @@ -421,7 +452,7 @@ MAP_EXTERNCALL void map_get_header_string(int* n, char** str_array, MAP_OtherSta * @endcode * @todo this should raise and error when count!=n */ -MAP_EXTERNCALL void map_get_unit_string(int* n, char** str_array ,MAP_OtherStateType_t* other_type); +MAP_EXTERNCALL void map_get_unit_string(int* n, char** str_array ,MAP_OtherState_t other_type); /** @@ -438,7 +469,7 @@ MAP_EXTERNCALL void map_get_unit_string(int* n, char** str_array ,MAP_OtherState * @param ierr, error code * @return instance of the packed initialization strings (different from the FAST-required derived types) */ -MAP_EXTERNCALL InitializationData* MAP_InitInput_Create(char* map_msg, MAP_ERROR_CODE* ierr); +MAP_EXTERNCALL MAP_InitializationData_t MAP_InitInput_Create(char* map_msg, MAP_ERROR_CODE* ierr); /** @@ -453,7 +484,7 @@ MAP_EXTERNCALL InitializationData* MAP_InitInput_Create(char* map_msg, MAP_ERROR * @param ierr, error code * @return initialization input type (equivalent C binding struct) */ -MAP_EXTERNCALL MAP_InitInputType_t* map_create_init_type(char* map_msg, MAP_ERROR_CODE* ierr); +MAP_EXTERNCALL MAP_InitInput_t map_create_init_type(char* map_msg, MAP_ERROR_CODE* ierr); /** @@ -470,7 +501,7 @@ MAP_EXTERNCALL MAP_InitInputType_t* map_create_init_type(char* map_msg, MAP_ERRO * @see map_create_other_type() * @return instance of the interal model struct (different from the FAST-required derived types) */ -MAP_EXTERNCALL Domain* MAP_OtherState_Create(char* map_msg, MAP_ERROR_CODE* ierr); +MAP_EXTERNCALL MAP_Domain_t MAP_OtherState_Create(char* map_msg, MAP_ERROR_CODE* ierr); /** @@ -482,7 +513,7 @@ MAP_EXTERNCALL Domain* MAP_OtherState_Create(char* map_msg, MAP_ERROR_CODE* ierr * @param ierr, error code * @return other state type (equivalent C binding struct) */ -MAP_EXTERNCALL MAP_OtherStateType_t* map_create_other_type(char* map_msg, MAP_ERROR_CODE* ierr); +MAP_EXTERNCALL MAP_OtherState_t map_create_other_type(char* map_msg, MAP_ERROR_CODE* ierr); /** @@ -496,7 +527,7 @@ MAP_EXTERNCALL MAP_OtherStateType_t* map_create_other_type(char* map_msg, MAP_ER * @param ierr, error code * @return initialization output type (equivalent C binding struct) */ -MAP_EXTERNCALL MAP_InitOutputType_t* map_create_initout_type(char* map_msg, MAP_ERROR_CODE* ierr); +MAP_EXTERNCALL MAP_InitOutput_t map_create_initout_type(char* map_msg, MAP_ERROR_CODE* ierr); /** @@ -510,7 +541,7 @@ MAP_EXTERNCALL MAP_InitOutputType_t* map_create_initout_type(char* map_msg, MAP_ * @param ierr, error code * @return input type (equivalent C binding struct) */ -MAP_EXTERNCALL MAP_InputType_t* map_create_input_type(char* map_msg, MAP_ERROR_CODE* ierr); +MAP_EXTERNCALL MAP_Input_t map_create_input_type(char* map_msg, MAP_ERROR_CODE* ierr); /** @@ -524,7 +555,7 @@ MAP_EXTERNCALL MAP_InputType_t* map_create_input_type(char* map_msg, MAP_ERROR_C * @param ierr, error code * @return parameter type (equivalent C binding struct) */ -MAP_EXTERNCALL MAP_ParameterType_t* map_create_parameter_type(char* map_msg, MAP_ERROR_CODE* ierr); +MAP_EXTERNCALL MAP_Parameter_t map_create_parameter_type(char* map_msg, MAP_ERROR_CODE* ierr); /** @@ -538,7 +569,7 @@ MAP_EXTERNCALL MAP_ParameterType_t* map_create_parameter_type(char* map_msg, MAP * @param ierr, error code * @return constraint type (equivalent C binding struct) */ -MAP_EXTERNCALL MAP_ConstraintStateType_t* map_create_constraint_type(char* map_msg, MAP_ERROR_CODE* ierr); +MAP_EXTERNCALL MAP_ConstraintState_t map_create_constraint_type(char* map_msg, MAP_ERROR_CODE* ierr); /** @@ -552,7 +583,7 @@ MAP_EXTERNCALL MAP_ConstraintStateType_t* map_create_constraint_type(char* map_m * @param ierr, error code * @return output type (equivalent C binding struct) */ -MAP_EXTERNCALL MAP_OutputType_t* map_create_output_type(char* map_msg, MAP_ERROR_CODE* ierr); +MAP_EXTERNCALL MAP_Output_t map_create_output_type(char* map_msg, MAP_ERROR_CODE* ierr); /** @@ -563,7 +594,10 @@ MAP_EXTERNCALL MAP_OutputType_t* map_create_output_type(char* map_msg, MAP_ERROR * @param ierr, error code * @return continuous type (equivalent C binding struct) */ -MAP_EXTERNCALL MAP_ContinuousStateType_t* map_create_continuous_type(char* map_msg, MAP_ERROR_CODE* ierr); +MAP_EXTERNCALL MAP_ContinuousState_t map_create_continuous_type(char* map_msg, MAP_ERROR_CODE* ierr); +#ifdef __cplusplus +} +#endif #endif /* _MAPAPI_H */ diff --git a/modules/map/src/maperror.h b/modules/map/src/maperror.h index bdcd60c11b..33503501bd 100644 --- a/modules/map/src/maperror.h +++ b/modules/map/src/maperror.h @@ -25,7 +25,6 @@ #define _MAPERROR_H -#include "map.h" #include diff --git a/modules/map/src/mapinit.c b/modules/map/src/mapinit.c index b3a29f0191..feb867ad68 100644 --- a/modules/map/src/mapinit.c +++ b/modules/map/src/mapinit.c @@ -2681,7 +2681,6 @@ void log_initialization_information(MAP_InitInputType_t* init_type, MAP_Paramete success = write_summary_file(init_data, p_type, domain, map_msg, ierr); CHECKERRQ(MAP_FATAL_37); } - success = write_summary_file(init_data, p_type, domain, map_msg, ierr); CHECKERRQ(MAP_FATAL_37); success = get_iteration_output_stream(y_type, other_type, map_msg, ierr); // @todo CHECKERRQ() MAP_END_ERROR_LOG; }; diff --git a/modules/map/src/mapsys.h b/modules/map/src/mapsys.h index 2f6291c4d7..e062fb162b 100644 --- a/modules/map/src/mapsys.h +++ b/modules/map/src/mapsys.h @@ -33,7 +33,7 @@ #if defined(_WIN32) || defined(_WIN64) -# include +# include # include #else # include @@ -69,11 +69,13 @@ # define map_snprintf _snprintf # define map_strcat(a,b,c) strcat_s(a,b,c) # define MAP_STRCPY(a,b,c) strcpy_s(a,b,c) +# define MAP_STRNCPY(a,b,c) strncpy_s(a,c,b,c) #else # include # define map_snprintf snprintf # define map_strcat(a,b,c) strncat(a,c,b) # define MAP_STRCPY(a,b,c) strcpy(a,c) +# define MAP_STRNCPY(a,b,c) strncpy(a,b,c) #endif diff --git a/modules/moordyn/CMakeLists.txt b/modules/moordyn/CMakeLists.txt index ec15a3f329..7cb0cf82e5 100644 --- a/modules/moordyn/CMakeLists.txt +++ b/modules/moordyn/CMakeLists.txt @@ -18,7 +18,7 @@ if (GENERATE_TYPES) generate_f90_types(src/MoorDyn_Registry.txt ${CMAKE_CURRENT_LIST_DIR}/src/MoorDyn_Types.f90) endif() -add_library(moordynlib +add_library(moordynlib STATIC src/MoorDyn.f90 src/MoorDyn_Body.f90 src/MoorDyn_IO.f90 diff --git a/modules/moordyn/src/MoorDyn.f90 b/modules/moordyn/src/MoorDyn.f90 index 2bc70eedc2..fdc69610ba 100644 --- a/modules/moordyn/src/MoorDyn.f90 +++ b/modules/moordyn/src/MoorDyn.f90 @@ -29,13 +29,12 @@ MODULE MoorDyn USE MoorDyn_Body USE MoorDyn_Misc - !USE WAVES, only: WaveGrid_n, WaveGrid_x0, WaveGrid_dx, WaveGrid_nx, WaveGrid_y0, WaveGrid_dy, WaveGrid_ny, WaveGrid_nz ! seeing if I can get waves data here directly... IMPLICIT NONE PRIVATE - TYPE(ProgDesc), PARAMETER :: MD_ProgDesc = ProgDesc( 'MoorDyn', 'v2.0.0', '2023-09-18' ) + TYPE(ProgDesc), PARAMETER :: MD_ProgDesc = ProgDesc( 'MoorDyn', 'v2.2.2', '2024-01-16' ) INTEGER(IntKi), PARAMETER :: wordy = 0 ! verbosity level. >1 = more console output @@ -77,6 +76,9 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er ! CHARACTER(1024) :: priPath ! The path to the primary MoorDyn input file REAL(DbKi) :: t ! instantaneous time, to be used during IC generation INTEGER(IntKi) :: l ! index + INTEGER(IntKi) :: il ! index + INTEGER(IntKi) :: iil ! index + INTEGER(IntKi) :: Success ! flag for checking whether line is attached to failure point INTEGER(IntKi) :: I ! Current line number of input file INTEGER(IntKi) :: J ! index INTEGER(IntKi) :: K ! index @@ -84,18 +86,18 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er INTEGER(IntKi) :: iTurb ! index for turbine in FAST.Farm applications INTEGER(IntKi) :: Converged ! flag indicating whether the dynamic relaxation has converged INTEGER(IntKi) :: N ! convenience integer for readability: number of segments in the line - REAL(ReKi) :: rPos(3) ! array for setting fairlead reference positions in mesh +! REAL(ReKi) :: rPos(3) ! array for setting fairlead reference positions in mesh REAL(ReKi) :: OrMat(3,3) ! rotation matrix for setting fairlead positions correctly if there is initial platform rotation REAL(ReKi) :: OrMat2(3,3) REAL(R8Ki) :: OrMatRef(3,3) - REAL(DbKi), ALLOCATABLE :: FairTensIC(:,:)! array of size nCpldPoints, 10 latest fairlead tensions of each line - CHARACTER(20) :: TempString ! temporary string for incidental use + REAL(DbKi), ALLOCATABLE :: FairTensIC(:,:)! array of size nCpldCons, 3 to store three latest fairlead tensions of each line +! CHARACTER(20) :: TempString ! temporary string for incidental use INTEGER(IntKi) :: ErrStat2 ! Error status of the operation CHARACTER(ErrMsgLen) :: ErrMsg2 ! Error message if ErrStat2 /= ErrID_None REAL(DbKi) :: dtM ! actual mooring dynamics time step INTEGER(IntKi) :: NdtM ! number of time steps to integrate through with RK2 - INTEGER(IntKi) :: ntWave ! number of time steps of wave data +! INTEGER(IntKi) :: ntWave ! number of time steps of wave data TYPE(MD_InputType) :: u_array(1) ! a size-one array for u to make call to TimeStep happy REAL(DbKi) :: t_array(1) ! a size-one array saying time is 0 to make call to TimeStep happy @@ -107,10 +109,10 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er ! Local variables for reading file input (Previously in MDIO_ReadInput) INTEGER(IntKi) :: UnEc ! The local unit number for this module's echo file - INTEGER(IntKi) :: UnOut ! for outputing wave kinematics data - CHARACTER(200) :: Frmt ! a string to hold a format statement +! INTEGER(IntKi) :: UnOut ! for outputing wave kinematics data +! CHARACTER(200) :: Frmt ! a string to hold a format statement - CHARACTER(1024) :: EchoFile ! Name of MoorDyn echo file +! CHARACTER(1024) :: EchoFile ! Name of MoorDyn echo file CHARACTER(1024) :: Line ! String to temporarially hold value of read line CHARACTER(20) :: LineOutString ! String to temporarially hold characters specifying line output options CHARACTER(20) :: OptString ! String to temporarially hold name of option variable @@ -124,7 +126,8 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er CHARACTER(40) :: TempString4 ! CHARACTER(40) :: TempString5 ! CHARACTER(40) :: TempStrings(6) ! Array of 6 strings used when parsing comma-separated items - CHARACTER(1024) :: FileName ! +! CHARACTER(1024) :: FileName ! + REAL(DbKi) :: depth ! local water depth interpolated from bathymetry grid [m] Real(DbKi) :: nvec(3) ! local seabed surface normal vector (positive out) @@ -164,7 +167,7 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er InitOut%Ver = MD_ProgDesc CALL WrScr(' This is MoorDyn v2, with significant input file changes from v1.') - CALL WrScr(' Copyright: (C) 2023 National Renewable Energy Laboratory, (C) 2019 Matt Hall') + CALL DispCopyrightLicense( MD_ProgDesc%Name) !--------------------------------------------------------------------------------------------- @@ -201,14 +204,12 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er m%PtfmInit = InitInp%PtfmInit(:,1) ! is this copying necssary in case this is an individual instance in FAST.Farm? - - ! Check if this MoorDyn instance is being run from FAST.Farm (indicated by FarmSize > 0) if (InitInp%FarmSize > 0) then CALL WrScr(' >>> MoorDyn is running in array mode <<< ') ! could make sure the size of this is right: SIZE(InitInp%FarmCoupledKinematics) p%nTurbines = InitInp%FarmSize - else ! FarmSize==0 indicates normal, FAST module mode + else ! FarmSize==0 indicates normal, FAST module mode p%nTurbines = 1 ! if a regular FAST module mode, we treat it like a nTurbine=1 farm case END IF @@ -245,29 +246,29 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er ! ----------------------------------------------------------------- ! Read the primary MoorDyn input file, or copy from passed input - if (InitInp%UsePrimaryInputFile) then - ! Read the entire input file, minus any comment lines, into the FileInfo_In - ! data structure in memory for further processing. - call ProcessComFile( InitInp%FileName, FileInfo_In, ErrStat2, ErrMsg2 ) - CALL GetPath( InitInp%FileName, p%PriPath ) ! Input files will be relative to the path where the primary input file is located. - else - call NWTC_Library_CopyFileInfoType( InitInp%PassedPrimaryInputData, FileInfo_In, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) - p%PriPath = "" - 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. + if (InitInp%UsePrimaryInputFile) then + ! Read the entire input file, minus any comment lines, into the FileInfo_In + ! data structure in memory for further processing. + call ProcessComFile( InitInp%FileName, FileInfo_In, ErrStat2, ErrMsg2 ) + CALL GetPath( InitInp%FileName, p%PriPath ) ! Input files will be relative to the path where the primary input file is located. + else + call NWTC_Library_CopyFileInfoType( InitInp%PassedPrimaryInputData, FileInfo_In, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) + p%PriPath = "" + 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 ParsePrimaryFileInfo_BuildModel( PriPath, InitInp, FileInfo_In, InputFileDat, p, m, UnEc, ErrStat2, ErrMsg2 ) -! if (Failed()) return; + ! CALL ParsePrimaryFileInfo_BuildModel( PriPath, InitInp, FileInfo_In, InputFileDat, p, m, UnEc, ErrStat2, ErrMsg2 ) + ! if (Failed()) return; -!NOTE: This could be split into a separate routine for easier to read code + !NOTE: This could be split into a separate routine for easier to read code !------------------------------------------------------------------------------------------------- ! Parsing of input file from the FileInfo_In data structure ! - FileInfo_Type is essentially a string array with some metadata. @@ -425,6 +426,7 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er END IF write(p%UnLog,'(A)', IOSTAT=ErrStat2) "MoorDyn v2 log file with output level "//TRIM(Num2LStr(p%writeLog)) write(p%UnLog,'(A)', IOSTAT=ErrStat2) "Note: options above the writeLog line in the input file will not be recorded." + write(p%UnLog,'(A)', IOSTAT=ErrStat2) " Input File Summary:" end if else if ( OptString == 'DTM') THEN read (OptValue,*) p%dtM0 @@ -458,14 +460,38 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er read (OptValue,*) p%mc else if ( OptString == 'CV') then read (OptValue,*) p%cv + else if ( OptString == 'INERTIALF') then + read (OptValue,*) p%inertialF + else if ( OptString == 'INERTIALF_RAMPT') then + read (OptValue,*) p%inertialF_rampT else CALL SetErrStat( ErrID_Warn, 'Unable to interpret input '//trim(OptString)//' in OPTIONS section.', ErrStat, ErrMsg, RoutineName ) end if nOpts = nOpts + 1 Line = NextLine(i) + END DO + if (p%writeLog > 1) then + write(p%UnLog, '(A)' ) " - Options List:" + write(p%UnLog, '(A17,f12.4)') " dtm : ", p%dtM0 + write(p%UnLog, '(A17,f12.4)') " g : ", p%g + write(p%UnLog, '(A17,f12.4)') " rhoW : ", p%rhoW + write(p%UnLog, '(A17,A)' ) " Depth : ", DepthValue ! water depth input read in as a string to be processed by setupBathymetry + write(p%UnLog, '(A17,f12.4)') " kBot : ", p%kBot + write(p%UnLog, '(A17,f12.4)') " cBot : ", p%cBot + write(p%UnLog, '(A17,f12.4)') " dtIC : ", InputFileDat%dtIC + write(p%UnLog, '(A17,f12.4)') " TMaxIC : ", InputFileDat%TMaxIC + write(p%UnLog, '(A17,f12.4)') " CdScaleIC: ", InputFileDat%CdScaleIC + write(p%UnLog, '(A17,f12.4)') " threshIC : ", InputFileDat%threshIC + write(p%UnLog, '(A17,A)' ) " WaterKin : ", WaterKinValue + write(p%UnLog, '(A17,f12.4)') " dtOut : ", p%dtOut + write(p%UnLog, '(A17,f12.4)') " mu_kT : ", p%mu_kT + write(p%UnLog, '(A17,f12.4)') " mu_kA : ", p%mu_kA + write(p%UnLog, '(A17,f12.4)') " mc : ", p%mc + write(p%UnLog, '(A17,f12.4)') " cv : ", p%cv + end if else if (INDEX(Line, "OUTPUT") > 0) then ! if output header @@ -536,7 +562,7 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er ALLOCATE(m%BodyList( p%nBodies ), STAT = ErrStat2 ); if(AllocateFailed("BodyList" )) return ALLOCATE(m%RodList( p%nRods ), STAT = ErrStat2 ); if(AllocateFailed("RodList" )) return - ALLOCATE(m%PointList( p%nPoints ), STAT = ErrStat2 ); if(AllocateFailed("PointList" )) return + ALLOCATE(m%PointList( p%nPointsExtra), STAT = ErrStat2 ); if(AllocateFailed("PointList" )) return ALLOCATE(m%LineList( p%nLines ), STAT = ErrStat2 ); if(AllocateFailed("LineList" )) return ALLOCATE(m%FailList( p%nFails ), STAT = ErrStat2 ); if(AllocateFailed("FailList" )) return @@ -545,16 +571,16 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er ! Allocate associated index arrays (note: some are allocated larger than will be used, for simplicity) ALLOCATE(m%BodyStateIs1(p%nBodies ), m%BodyStateIsN(p%nBodies ), STAT=ErrStat2); if(AllocateFailed("BodyStateIs1/N")) return ALLOCATE(m%RodStateIs1(p%nRods ), m%RodStateIsN(p%nRods ), STAT=ErrStat2); if(AllocateFailed("RodStateIs1/N" )) return - ALLOCATE(m%PointStateIs1(p%nPoints), m%PointStateIsN(p%nPoints), STAT=ErrStat2); if(AllocateFailed("PointStateIs1/N" )) return + ALLOCATE(m%PointStateIs1(p%nPointsExtra), m%PointStateIsN(p%nPointsExtra), STAT=ErrStat2); if(AllocateFailed("PointStateIs1/N" )) return ALLOCATE(m%LineStateIs1(p%nLines) , m%LineStateIsN(p%nLines) , STAT=ErrStat2); if(AllocateFailed("LineStateIs1/N")) return ALLOCATE(m%FreeBodyIs( p%nBodies ), STAT=ErrStat2); if(AllocateFailed("FreeBodyIs")) return ALLOCATE(m%FreeRodIs( p%nRods ), STAT=ErrStat2); if(AllocateFailed("FreeRodIs")) return - ALLOCATE(m%FreePointIs( p%nPoints), STAT=ErrStat2); if(AllocateFailed("FreePointIs")) return + ALLOCATE(m%FreePointIs(p%nPointsExtra), STAT=ErrStat2); if(AllocateFailed("FreePointIs")) return ALLOCATE(m%CpldBodyIs(p%nBodies , p%nTurbines), STAT=ErrStat2); if(AllocateFailed("CpldBodyIs")) return ALLOCATE(m%CpldRodIs( p%nRods , p%nTurbines), STAT=ErrStat2); if(AllocateFailed("CpldRodIs")) return - ALLOCATE(m%CpldPointIs(p%nPoints, p%nTurbines), STAT=ErrStat2); if(AllocateFailed("CpldPointIs")) return + ALLOCATE(m%CpldPointIs(p%nPointsExtra, p%nTurbines), STAT=ErrStat2); if(AllocateFailed("CpldPointIs")) return ! ---------------------- now go through again and process file contents -------------------- @@ -584,8 +610,8 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er Line = NextLine(i) Line = NextLine(i) - ! process each line - DO l = 1,p%nLineTypes + ! process each line + DO l = 1,p%nLineTypes !read into a line Line = NextLine(i) @@ -612,10 +638,14 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er ! process stiffness coefficients CALL SplitByBars(tempString1, N, tempStrings) - if (N > 2) then - CALL SetErrStat( ErrID_Fatal, 'A line type EA entry can have at most 2 (comma-separated) values.', ErrStat, ErrMsg, RoutineName ) + if (N > 3) then + CALL SetErrStat( ErrID_Fatal, 'A line type EA entry can have at most 3 (bar-separated) values.', ErrStat, ErrMsg, RoutineName ) CALL CleanUp() - else if (N==2) then ! visco-elastic case! + else if (N==3) then ! visco-elastic case, load dependent dynamic stiffness! + m%LineTypeList(l)%ElasticMod = 3 + read(tempStrings(2), *) m%LineTypeList(l)%alphaMBL + read(tempStrings(3), *) m%LineTypeList(l)%vbeta + else if (N==2) then ! visco-elastic case, constant dynamic stiffness! m%LineTypeList(l)%ElasticMod = 2 read(tempStrings(2), *) m%LineTypeList(l)%EA_D else @@ -631,12 +661,15 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er ! process damping coefficients CALL SplitByBars(tempString2, N, tempStrings) if (N > m%LineTypeList(l)%ElasticMod) then - CALL SetErrStat( ErrID_Fatal, 'A line type BA entry cannot have more (comma-separated) values its EA entry.', ErrStat, ErrMsg, RoutineName ) + CALL SetErrStat( ErrID_Fatal, 'A line type BA entry cannot have more (bar-separated) values than its EA entry.', ErrStat, ErrMsg, RoutineName ) CALL CleanUp() else if (N==2) then ! visco-elastic case when two BA values provided read(tempStrings(2), *) m%LineTypeList(l)%BA_D - else if (m%LineTypeList(l)%ElasticMod == 2) then ! case where there is no dynamic damping for viscoelastic model (will it work)? + else if (m%LineTypeList(l)%ElasticMod > 1) then ! case where there is no dynamic damping for viscoelastic model (will it work)? CALL WrScr("Warning, viscoelastic model being used with zero damping on the dynamic stiffness.") + if (p%writeLog > 0) then + write(p%UnLog,'(A)') "Warning, viscoelastic model being used with zero damping on the dynamic stiffness." + end if end if ! get the regular/static coefficient or relation in all cases (can be from a lookup table?) CALL getCoefficientOrCurve(tempStrings(1), m%LineTypeList(l)%BA, & @@ -654,16 +687,16 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er m%LineTypeList(l)%IdNum = l ! write lineType information to log file - if (p%writeLog > 1) then - write(p%UnLog, '(A12,A20)' ) " LineType"//trim(num2lstr(l))//":" - write(p%UnLog, '(A12,A20)' ) " name: ", m%LineTypeList(l)%name - write(p%UnLog, '(A12,f12.4)') " d : ", m%LineTypeList(l)%d - write(p%UnLog, '(A12,f12.4)') " w : ", m%LineTypeList(l)%w - write(p%UnLog, '(A12,f12.4)') " Cdn : ", m%LineTypeList(l)%Cdn - write(p%UnLog, '(A12,f12.4)') " Can : ", m%LineTypeList(l)%Can - write(p%UnLog, '(A12,f12.4)') " Cdt : ", m%LineTypeList(l)%Cdt - write(p%UnLog, '(A12,f12.4)') " Cat : ", m%LineTypeList(l)%Cat - end if + if (p%writeLog > 1) then + write(p%UnLog, '(A)' ) " - LineType"//trim(num2lstr(l))//":" + write(p%UnLog, '(A12,A)' ) " name: ", trim(m%LineTypeList(l)%name) + write(p%UnLog, '(A12,f12.4)') " d : ", m%LineTypeList(l)%d + write(p%UnLog, '(A12,f12.4)') " w : ", m%LineTypeList(l)%w + write(p%UnLog, '(A12,f12.4)') " Cdn : ", m%LineTypeList(l)%Cdn + write(p%UnLog, '(A12,f12.4)') " Can : ", m%LineTypeList(l)%Can + write(p%UnLog, '(A12,f12.4)') " Cdt : ", m%LineTypeList(l)%Cdt + write(p%UnLog, '(A12,f12.4)') " Cat : ", m%LineTypeList(l)%Cat + end if IF ( ErrStat2 /= ErrID_None ) THEN CALL SetErrStat( ErrID_Fatal, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -689,35 +722,48 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er !read into a line Line = NextLine(i) - ! check for correct number of columns in current line - IF ( CountWords( Line ) /= 7 ) THEN + ! check for correct number of columns in current line (bjj: I'm not going to throw an error if there are extra columns in this line, e.g. comments) + IF ( CountWords( Line ) < 7 ) THEN CALL SetErrStat( ErrID_Fatal, ' Unable to parse Rod Type '//trim(Num2LStr(l))//' on row '//trim(Num2LStr(i))//' in input file. Row has wrong number of columns. Must be 7 columns.', ErrStat, ErrMsg, RoutineName ) CALL CleanUp() RETURN END IF - ! parse out entries: Name Diam MassDen Cd Ca CdEnd CaEnd + ! parse out entries: Name Diam MassDen Cd Ca CdEnd CaEnd LinDamp IF (ErrStat2 == 0) THEN READ(Line,*,IOSTAT=ErrStat2) m%RodTypeList(l)%name, m%RodTypeList(l)%d, m%RodTypeList(l)%w, & - m%RodTypeList(l)%Cdn, m%RodTypeList(l)%Can, m%RodTypeList(l)%CdEnd, m%RodTypeList(l)%CaEnd - + m%RodTypeList(l)%Cdn, m%RodTypeList(l)%Can, m%RodTypeList(l)%CdEnd, m%RodTypeList(l)%CaEnd,& + m%RodTypeList(l)%LinDamp ! Linear damping coefficient + + if (ErrStat2 == 0) then + m%RodTypeList(l)%isLinDamp = .TRUE. ! linear damping was read + else ! Linear damping not present, so reread the line without it + READ(Line,*,IOSTAT=ErrStat2) m%RodTypeList(l)%name, m%RodTypeList(l)%d, m%RodTypeList(l)%w, & + m%RodTypeList(l)%Cdn, m%RodTypeList(l)%Can, m%RodTypeList(l)%CdEnd, m%RodTypeList(l)%CaEnd + + m%RodTypeList(l)%LinDamp = 0.0 + m%RodTypeList(l)%isLinDamp = .FALSE. + end if + + m%RodTypeList(l)%Cdt = 0.0_DbKi ! not used m%RodTypeList(l)%Cat = 0.0_DbKi ! not used + END IF ! specify IdNum of rod type for error checking m%RodTypeList(l)%IdNum = l - ! write lineType information to log file + ! write rodType information to log file if (p%writeLog > 1) then - write(p%UnLog, '(A12,A20)' ) " RodType"//trim(num2lstr(l))//":" - write(p%UnLog, '(A12,A20)' ) " name: ", m%RodTypeList(l)%name - write(p%UnLog, '(A12,f12.4)') " d : ", m%RodTypeList(l)%d - write(p%UnLog, '(A12,f12.4)') " w : ", m%RodTypeList(l)%w - write(p%UnLog, '(A12,f12.4)') " Cdn : ", m%RodTypeList(l)%Cdn - write(p%UnLog, '(A12,f12.4)') " Can : ", m%RodTypeList(l)%Can - write(p%UnLog, '(A12,f12.4)') " Cdt : ", m%RodTypeList(l)%CdEnd - write(p%UnLog, '(A12,f12.4)') " Cat : ", m%RodTypeList(l)%CaEnd + write(p%UnLog, '(A)' ) " - RodType"//trim(num2lstr(l))//":" + write(p%UnLog, '(A14,A)' ) " name: ", trim(m%RodTypeList(l)%name) + write(p%UnLog, '(A14,f12.4)') " d : ", m%RodTypeList(l)%d + write(p%UnLog, '(A14,f12.4)') " w : ", m%RodTypeList(l)%w + write(p%UnLog, '(A14,f12.4)') " Cdn : ", m%RodTypeList(l)%Cdn + write(p%UnLog, '(A14,f12.4)') " Can : ", m%RodTypeList(l)%Can + write(p%UnLog, '(A14,f12.4)') " CdEnd : ", m%RodTypeList(l)%CdEnd + write(p%UnLog, '(A14,f12.4)') " CaEnd : ", m%RodTypeList(l)%CaEnd end if IF ( ErrStat2 /= ErrID_None ) THEN @@ -769,7 +815,7 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er else CALL SetErrStat( ErrID_Fatal, 'Body '//trim(Num2LStr(l))//' CG entry (col 10) must have 1 or 3 numbers.' , ErrStat, ErrMsg, RoutineName ) end if - ! process mements of inertia + ! process moments of inertia CALL SplitByBars(tempString3, N, tempStrings) if (N == 1) then ! if only one entry, use it for all directions READ(tempString3, *) m%BodyList(l)%BodyI(1) @@ -788,10 +834,30 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er READ(tempString4, *) m%BodyList(l)%BodyCdA(1) m%BodyList(l)%BodyCdA(2) = m%BodyList(l)%BodyCdA(1) m%BodyList(l)%BodyCdA(3) = m%BodyList(l)%BodyCdA(1) + m%BodyList(l)%BodyCdA(4) = m%BodyList(l)%BodyCdA(1) + m%BodyList(l)%BodyCdA(5) = m%BodyList(l)%BodyCdA(1) + m%BodyList(l)%BodyCdA(6) = m%BodyList(l)%BodyCdA(1) + else if (N ==2) then + READ(tempStrings(1), *) m%BodyList(l)%BodyCdA(1) + READ(tempStrings(4), *) m%BodyList(l)%BodyCdA(4) + m%BodyList(l)%BodyCdA(2) = m%BodyList(l)%BodyCdA(1) + m%BodyList(l)%BodyCdA(3) = m%BodyList(l)%BodyCdA(1) + m%BodyList(l)%BodyCdA(5) = m%BodyList(l)%BodyCdA(4) + m%BodyList(l)%BodyCdA(6) = m%BodyList(l)%BodyCdA(4) else if (N==3) then ! all three coordinates provided READ(tempStrings(1), *) m%BodyList(l)%BodyCdA(1) READ(tempStrings(2), *) m%BodyList(l)%BodyCdA(2) READ(tempStrings(3), *) m%BodyList(l)%BodyCdA(3) + READ(tempStrings(1), *) m%BodyList(l)%BodyCdA(4) + READ(tempStrings(2), *) m%BodyList(l)%BodyCdA(5) + READ(tempStrings(3), *) m%BodyList(l)%BodyCdA(6) + else if (N==6) then + READ(tempStrings(1), *) m%BodyList(l)%BodyCdA(1) + READ(tempStrings(2), *) m%BodyList(l)%BodyCdA(2) + READ(tempStrings(3), *) m%BodyList(l)%BodyCdA(3) + READ(tempStrings(4), *) m%BodyList(l)%BodyCdA(4) + READ(tempStrings(5), *) m%BodyList(l)%BodyCdA(5) + READ(tempStrings(6), *) m%BodyList(l)%BodyCdA(6) else CALL SetErrStat( ErrID_Fatal, 'Body '//trim(Num2LStr(l))//' CdA entry (col 13) must have 1 or 3 numbers.' , ErrStat, ErrMsg, RoutineName ) end if @@ -814,6 +880,10 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er CALL WrScr(' Unable to parse Body '//trim(Num2LStr(l))//' on row '//trim(Num2LStr(i))//' in input file.') ! Specific screen output because errors likely CALL WrScr(' Ensure row has all 13 columns needed in MDv2 input file (13th Dec 2021).') CALL SetErrStat( ErrID_Fatal, 'Failed to read bodies.' , ErrStat, ErrMsg, RoutineName ) + if (p%writeLog > 0) then + write(p%UnLog,'(A)') ' Unable to parse Body '//trim(Num2LStr(l))//' on row '//trim(Num2LStr(i))//' in input file.' + write(p%UnLog,'(A)') ' Ensure row has all 13 columns needed in MDv2 input file (13th Dec 2021).' + end if CALL CleanUp() RETURN END IF @@ -835,8 +905,44 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er m%CpldBodyIs(p%nCpldBodies(1),1) = l ! body initial position due to coupling will be adjusted later + + else if ((let1 == "VESSELPINNED") .or. (let1 == "VESPIN") .or. (let1 == "COUPLEDPINNED") .or. (let1 == "CPLDPIN")) then ! if a pinned coupled body, add to list and add + m%BodyList(l)%typeNum = 2 + + p%nCpldBodies(1)=p%nCpldBodies(1)+1 ! add + p%nFreeBodies =p%nFreeBodies+1 ! add this pinned body to the free list because it is half free + + m%BodyStateIs1(p%nFreeBodies) = Nx+1 + m%BodyStateIsN(p%nFreeBodies) = Nx+6 + Nx = Nx + 6 ! add 6 state variables for each pinned body - ! TODO: add option for body coupling to different turbines in FAST.Farm <<< + m%CpldBodyIs(p%nCpldBodies(1),1) = l + m%FreeBodyIs(p%nFreeBodies) = l + + + else if ((let1 == "TURBINE") .or. (let1 == "T")) then ! turbine-coupled in FAST.Farm case + + if (len_trim(num1) > 0) then + READ(num1, *) J ! convert to int, representing turbine index + + if ((J <= p%nTurbines) .and. (J > 0)) then + + m%BodyList(l)%typeNum = -1 ! set as coupled type + p%nCpldBodies(J)=p%nCpldBodies(J)+1 ! increment counter for the appropriate turbine + m%CpldBodyIs(p%nCpldBodies(J),J) = l + CALL WrScr(' added Body '//TRIM(int2lstr(l))//' for turbine '//trim(int2lstr(J))) + if (p%writeLog > 0) then + write(p%UnLog,'(A)') ' Added Body '//TRIM(int2lstr(l))//' for turbine '//trim(int2lstr(J)) + end if + + else + CALL SetErrStat( ErrID_Fatal, "Turbine ID out of bounds for Body "//trim(Num2LStr(l))//".", ErrStat, ErrMsg, RoutineName ) + return + end if + else + CALL SetErrStat( ErrID_Fatal, "No number provided for Body "//trim(Num2LStr(l))//" Turbine attachment.", ErrStat, ErrMsg, RoutineName ) + return + end if else if (let1 == "FREE") then ! if a free body m%BodyList(l)%typeNum = 0 @@ -875,6 +981,19 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er CALL CleanUp() RETURN END IF + + ! write body information to log file + if (p%writeLog > 1) then + write(p%UnLog, '(A)' ) " - Body"//trim(num2lstr(l))//":" + write(p%UnLog, '(A14,I2)' ) " id : ", m%BodyList(l)%IdNum + write(p%UnLog, '(A14,A)' ) " attach: ", trim(tempString1) + write(p%UnLog, '(A14,f12.4)') " v : ", m%BodyList(l)%bodyV + write(p%UnLog, '(A14,f12.4)') " m : ", m%BodyList(l)%bodyM + write(p%UnLog, '(A14,A)' ) " I : ", trim(num2lstr(m%BodyList(l)%BodyI(1)))//", "//trim(num2lstr(m%BodyList(l)%BodyI(2)))//", "//trim(num2lstr(m%BodyList(l)%BodyI(3))) + write(p%UnLog, '(A14,A)' ) " rCG : ", trim(num2lstr(m%BodyList(l)%rCG(1)))//", "//trim(num2lstr(m%BodyList(l)%rCG(2)))//", "//trim(num2lstr(m%BodyList(l)%rCG(3))) + write(p%UnLog, '(A14,A)' ) " CdA : ", trim(num2lstr(m%BodyList(l)%BodyCdA(1)))//", "//trim(num2lstr(m%BodyList(l)%BodyCdA(2)))//", "//trim(num2lstr(m%BodyList(l)%BodyCdA(3)))//", "//trim(num2lstr(m%BodyList(l)%BodyCdA(4)))//", "//trim(num2lstr(m%BodyList(l)%BodyCdA(5)))//", "//trim(num2lstr(m%BodyList(l)%BodyCdA(6))) + write(p%UnLog, '(A14,A)' ) " Ca : ", trim(num2lstr(m%BodyList(l)%BodyCa(1)))//", "//trim(num2lstr(m%BodyList(l)%BodyCa(2)))//", "//trim(num2lstr(m%BodyList(l)%BodyCa(3)))//", "//trim(num2lstr(m%BodyList(l)%BodyCa(4)))//", "//trim(num2lstr(m%BodyList(l)%BodyCa(5)))//", "//trim(num2lstr(m%BodyList(l)%BodyCa(6))) + end if IF (wordy > 1) print *, "Set up body ", l, " of type ", m%BodyList(l)%typeNum @@ -1004,12 +1123,33 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er m%CpldRodIs(p%nCpldRods(1),1) = l m%FreeRodIs(p%nFreeRods) = l - ! TODO: add option for body coupling to different turbines in FAST.Farm <<< + else if ((let1 == "TURBINE") .or. (let1 == "T")) then ! turbine-coupled in FAST.Farm case + + if (len_trim(num1) > 0) then + READ(num1, *) J ! convert to int, representing turbine index + + if ((J <= p%nTurbines) .and. (J > 0)) then + m%RodList(l)%typeNum = -2 ! set as coupled type + p%nCpldRods(J)=p%nCpldRods(J)+1 ! increment counter for the appropriate turbine + m%CpldRodIs(p%nCpldRods(J),J) = l + CALL WrScr(' added Rod '//TRIM(int2lstr(l))//' for turbine '//trim(int2lstr(J))) + if (p%writeLog > 0) then + write(p%UnLog,'(A)') ' Added Rod '//TRIM(int2lstr(l))//' for turbine '//trim(int2lstr(J)) + end if + + else + CALL SetErrStat( ErrID_Fatal, "Turbine ID out of bounds for Rod "//trim(Num2LStr(l))//".", ErrStat, ErrMsg, RoutineName ) + return + end if + else + CALL SetErrStat( ErrID_Fatal, "No number provided for Rod "//trim(Num2LStr(l))//" Turbine attachment.", ErrStat, ErrMsg, RoutineName ) + return + end if - else if ((let1 == "CONNECT") .or. (let1 == "CON") .or. (let1 == "FREE")) then + else if ((let1 == "ROD") .or. (let1 == "R") .or. (let1 == "FREE")) then m%RodList(l)%typeNum = 0 - p%nFreeRods=p%nFreeRods+1 ! add this pinned rod to the free list because it is half free + p%nFreeRods=p%nFreeRods+1 m%RodStateIs1(p%nFreeRods) = Nx+1 m%RodStateIsN(p%nFreeRods) = Nx+12 @@ -1051,6 +1191,14 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er ! specify IdNum of line for error checking m%RodList(l)%IdNum = l + if (p%writeLog > 1) then + write(p%UnLog, '(A)' ) " - Rod"//trim(num2lstr(m%RodList(l)%IdNum))//":" + write(p%UnLog, '(A15,I2)' ) " ID : ", m%RodList(l)%IdNum + write(p%UnLog, '(A15,A)' ) " Type : ", trim(m%RodTypeList(m%RodList(l)%PropsIdNum)%name) + write(p%UnLog, '(A15,A)' ) " Attach : ", trim(tempString2) + write(p%UnLog, '(A15,I2)' ) " NumSegs: ", m%RodList(l)%N + end if + ! check for sequential IdNums IF ( m%RodList(l)%IdNum .NE. l ) THEN CALL SetErrStat( ErrID_Fatal, 'Line numbers must be sequential starting from 1.', ErrStat, ErrMsg, RoutineName ) @@ -1106,6 +1254,9 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er if ((INDEX(tempString4, "SEABED") > 0 ) .or. (INDEX(tempString4, "GROUND") > 0 ) .or. (INDEX(tempString4, "FLOOR") > 0 )) then ! if keyword used CALL WrScr('Point '//trim(Num2LStr(l))//' depth set to be on the seabed; finding z location based on depth/bathymetry') ! interpret the anchor depth value as a 'seabed' input + if (p%writeLog > 0) then + write(p%UnLog,'(A)') 'Point '//trim(Num2LStr(l))//' depth set to be on the seabed; finding z location based on depth/bathymetry' + end if CALL getDepthFromBathymetry(m%BathymetryGrid, m%BathGrid_Xs, m%BathGrid_Ys, tempArray(1), tempArray(2), depth, nvec) ! meaning the anchor should be at the depth of the local bathymetry tempArray(3) = -depth else ! if the anchor depth input isn't one of the supported keywords, @@ -1125,6 +1276,10 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er CALL WrScr(' Unable to parse Point '//trim(Num2LStr(l))//' row in input file.') ! Specific screen output because errors likely CALL WrScr(' Ensure row has all 9 columns, including CdA and Ca.') ! to be caused by non-updated input file formats. CALL SetErrStat( ErrID_Fatal, 'Failed to read points.' , ErrStat, ErrMsg, RoutineName ) ! would be nice to specify which line <<<<<<<<< + if (p%writeLog > 0) then + write(p%UnLog,'(A)') ' Unable to parse Point '//trim(Num2LStr(l))//' row in input file.' + write(p%UnLog,'(A)') ' Ensure row has all 9 columns, including CdA and Ca.' + end if CALL CleanUp() RETURN END IF @@ -1189,6 +1344,9 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er p%nCpldPoints(J) = p%nCpldPoints(J) + 1 ! increment counter for the appropriate turbine m%CpldPointIs(p%nCpldPoints(J),J) = l CALL WrScr(' added point '//TRIM(int2lstr(l))//' as fairlead for turbine '//trim(int2lstr(J))) + if (p%writeLog > 0) then + write(p%UnLog,'(A)') ' added point '//TRIM(int2lstr(l))//' as fairlead for turbine '//trim(int2lstr(J)) + end if else @@ -1213,6 +1371,16 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er !also set number of attached lines to zero initially m%PointList(l)%nAttached = 0 + ! write body information to log file + if (p%writeLog > 1) then + write(p%UnLog, '(A)' ) " - Point"//trim(num2lstr(l))//":" + write(p%UnLog, '(A12,I2)' ) " id : ", m%PointList(l)%IdNum + write(p%UnLog, '(A12,I2)' ) " type: ", m%PointList(l)%typeNum + write(p%UnLog, '(A12,f12.4)') " v : ", m%PointList(l)%pointV + write(p%UnLog, '(A12,f12.4)') " m : ", m%PointList(l)%pointM + write(p%UnLog, '(A12,f12.4)') " CdA : ", m%PointList(l)%pointCdA + write(p%UnLog, '(A12,f12.4)') " Ca : ", m%PointList(l)%pointCa + end if ! check for sequential IdNums IF ( m%PointList(l)%IdNum .NE. l ) THEN @@ -1247,8 +1415,8 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er !read into a line Line = NextLine(i) - ! check for correct number of columns in current line - IF ( CountWords( Line ) /= 7 ) THEN + ! check for correct number of columns in current line (bjj: I'm not going to throw an error if there are extra columns in this line, e.g. comments) + IF ( CountWords( Line ) < 7 ) THEN CALL SetErrStat( ErrID_Fatal, ' Unable to parse Line '//trim(Num2LStr(l))//' on row '//trim(Num2LStr(i))//' in input file. Row has wrong number of columns. Must be 7 columns.', ErrStat, ErrMsg, RoutineName ) CALL CleanUp() RETURN @@ -1274,7 +1442,7 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er ! account for states of line m%LineStateIs1(l) = Nx + 1 - if (m%LineTypeList(m%LineList(l)%PropsIdNum)%ElasticMod == 2) then + if (m%LineTypeList(m%LineList(l)%PropsIdNum)%ElasticMod > 1) then ! todo add an error check here? or change to 2 or 3? Nx = Nx + 7*m%LineList(l)%N - 6 ! if using viscoelastic model, need one more state per segment m%LineStateIsN(l) = Nx else @@ -1308,7 +1476,7 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er return end if else - CALL SetErrStat( ErrID_Fatal, "Error: rod point ID out of bounds for line "//trim(Num2LStr(l))//" end A attachment.", ErrStat, ErrMsg, RoutineName ) + CALL SetErrStat( ErrID_Fatal, " Rod ID out of bounds for line "//trim(Num2LStr(l))//" end A attachment.", ErrStat, ErrMsg, RoutineName ) return end if @@ -1349,7 +1517,7 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er return end if else - CALL SetErrStat( ErrID_Fatal, "Error: rod connection ID out of bounds for line "//trim(Num2LStr(l))//" end B attachment.", ErrStat, ErrMsg, RoutineName ) + CALL SetErrStat( ErrID_Fatal, " Rod ID out of bounds for line "//trim(Num2LStr(l))//" end B attachment.", ErrStat, ErrMsg, RoutineName ) return end if @@ -1391,6 +1559,15 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er ! specify IdNum of line for error checking m%LineList(l)%IdNum = l + if (p%writeLog > 1) then + write(p%UnLog, '(A)' ) " - Line"//trim(num2lstr(m%LineList(l)%IdNum))//":" + write(p%UnLog, '(A15,I2)' ) " ID : ", m%LineList(l)%IdNum + write(p%UnLog, '(A15,A)' ) " Type : ", trim(m%LineTypeList(m%LineList(l)%PropsIdNum)%name) + write(p%UnLog, '(A15,f12.4)') " Len : ", m%LineList(l)%UnstrLen + write(p%UnLog, '(A15,A)' ) " Node A : ", " "//tempString2 + write(p%UnLog, '(A15,A)' ) " Node B : ", " "//tempString3 + write(p%UnLog, '(A15,I2)' ) " NumSegs: ", m%LineList(l)%N + end if ! check for sequential IdNums IF ( m%LineList(l)%IdNum .NE. l ) THEN @@ -1435,6 +1612,13 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er ! count commas to determine how many line IDs specified for this channel N = count(transfer(Line, 'a', len(Line)) == ",") + 1 ! number of line IDs given + + ! check for correct number of columns in current line (CountWords splits by comma and space, so 2 columns means number of line ID's plus one more for the control channel) + IF ( CountWords( Line ) /= N+1 ) THEN + CALL SetErrStat( ErrID_Fatal, ' Unable to parse controls '//trim(Num2LStr(l))//' on row '//trim(Num2LStr(i))//' in input file. Row has wrong number of columns. Must be 2 columns.', ErrStat, ErrMsg, RoutineName ) + CALL CleanUp() + RETURN + END IF ! parse out entries: CtrlChan, LineIdNums read(Line, *) Itemp, TempIDnums(1:N) ! parse out each line ID @@ -1444,11 +1628,18 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er if (m%LineList( TempIDnums(J) )%CtrlChan == 0) then ! ensure line doesn't already have a CtrlChan assigned m%LineList( TempIDnums(J) )%CtrlChan = Itemp CALL WrScr('Assigned Line '//TRIM(Int2LStr(TempIDnums(J)))//' to control channel '//TRIM(Int2LStr(Itemp))) + if (p%writeLog > 0) then + write(p%UnLog,'(A)') 'Assigned Line '//TRIM(Int2LStr(TempIDnums(J)))//' to control channel '//TRIM(Int2LStr(Itemp)) + end if else - CALL WrScr('Error: Line '//TRIM(Int2LStr(TempIDnums(J)))//' already is assigned to control channel '//TRIM(Int2LStr(m%LineList( TempIDnums(J) )%CtrlChan))//' so cannot also be assigned to channel '//TRIM(Int2LStr(Itemp))) + CALL SetErrStat( ErrID_Fatal, ' Line '//TRIM(Int2LStr(TempIDnums(J)))//' already is assigned to control channel '//TRIM(Int2LStr(m%LineList( TempIDnums(J) )%CtrlChan))//' so cannot also be assigned to channel '//TRIM(Int2LStr(Itemp)), ErrStat, ErrMsg, RoutineName ) + CALL CleanUp() + return end if else - CALL WrScr('Error: Line ID '//TRIM(Int2LStr(TempIDnums(J)))//' of CtrlChan '//TRIM(Int2LStr(Itemp))//' is out of range') + CALL SetErrStat( ErrID_Fatal, ' Line ID '//TRIM(Int2LStr(TempIDnums(J)))//' of CtrlChan '//TRIM(Int2LStr(Itemp))//' is out of range', ErrStat, ErrMsg, RoutineName ) + CALL CleanUp() + return end if END DO @@ -1458,9 +1649,14 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er !------------------------------------------------------------------------------------------- else if (INDEX(Line, "FAILURE") > 0) then ! if failure conditions header - - CALL WrScr(" Warning: Failure capabilities are not yet implemented in MoorDyn.") + IF (wordy > 0) then + CALL WrScr(" Reading failure inputs") + endif + + ! TODO: allocate fail list size (we need to do this before though right?) + + ! skip following two lines (label line and unit line) Line = NextLine(i) Line = NextLine(i) @@ -1470,13 +1666,169 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er !read into a line Line = NextLine(i) + + ! count commas to determine how many line IDs specified for this channel + N = count(transfer(Line, 'a', len(Line)) == ",") + 1 ! number of line IDs given + ! check for correct number of columns in current line (CountWords splits by comma and space, so 2 columns means number of line ID's plus 4 more for the other 4 channels) - ! TODO: Failure capabilities still need to be completed - READ(Line,*,IOSTAT=ErrStat2) m%LineList(l)%IdNum, tempString1, m%LineList(l)%UnstrLen, & - m%LineList(l)%N, tempString2, tempString3, LineOutString - - END DO - + IF ( CountWords( Line ) /= N+4 ) THEN + CALL SetErrStat( ErrID_Fatal, ' Unable to parse line failure '//trim(Num2LStr(l))//' on row '//trim(Num2LStr(i))//' in input file. Row has wrong number of columns. Must be 5 columns.', ErrStat, ErrMsg, RoutineName ) + CALL CleanUp() + RETURN + END IF + + ! parse out entries: FailID Point Lines FailTime FailTen + IF (ErrStat2 == 0) THEN + + READ(Line,*,IOSTAT=ErrStat2) m%FailList(l)%IdNum, TempString1, TempIDnums(1:N), m%FailList(l)%failTime, m%FailList(l)%failTen + + ! check for duplicate failure ID's + ! check for sequential IdNums + IF ( m%FailList(l)%IdNum .NE. l ) THEN + CALL SetErrStat( ErrID_Fatal, 'Failure ID numbers must be sequential starting from 1.', ErrStat, ErrMsg, RoutineName ) + CALL CleanUp() + RETURN + END IF + + CALL Conv2UC(TempString1) ! convert to uppercase so that matching is not case-sensitive + + call DecomposeString(TempString1, let1, num1, let2, num2, let3) ! divided failPoint into letters and numbers + + if (len_trim(num1)<1) then + CALL SetErrStat( ErrID_Fatal, "Error: no point number provided for line failure "//trim(Num2LStr(l))//".", ErrStat, ErrMsg, RoutineName ) + CALL CleanUp() + return + end if + + READ(num1, *) m%FailList(l)%attachID ! convert to int + + ! if id starts with an "R" or "Rod" + if ((let1 == "R") .OR. (let1 == "ROD")) then + if ((m%FailList(l)%attachID <= p%nRods) .AND. (m%FailList(l)%attachID > 0)) then + if (let2 == "A") then + m%FailList(l)%isRod = 1 + else if (let2 == "B") then + m%FailList(l)%isRod = 2 + else + CALL SetErrStat( ErrID_Fatal, ' Unable to parse line failure '//trim(Num2LStr(l))//'. Rod end must be A or B.', ErrStat, ErrMsg, RoutineName ) + CALL CleanUp() + return + endif + else + CALL SetErrStat( ErrID_Fatal, ' Unable to parse line failure '//trim(Num2LStr(l))//'. Rod number out of bounds.', ErrStat, ErrMsg, RoutineName ) + CALL CleanUp() + return + endif + + endif + + if ((len_trim(let1)<1) .OR. (let1 == "P") .OR. (let1 == "POINT")) then + if ((m%FailList(l)%attachID <= p%nPoints) .AND. (m%FailList(l)%attachID > 0)) then + m%FailList(l)%isRod = 0 + else + CALL SetErrStat( ErrID_Fatal, ' Unable to parse line failure '//trim(Num2LStr(l))//'. Point number out of bounds.', ErrStat, ErrMsg, RoutineName ) + CALL CleanUp() + return + endif + + endif + + ! get lines + m%FailList(l)%nLinesToDetach = N + + DO il = 1, m%FailList(l)%nLinesToDetach + if (TempIDnums(il) <= p%nLines) then ! ensure line ID is in range + m%FailList(l)%lineIDs(il) = TempIDnums(il) + else + CALL SetErrStat( ErrID_Fatal, ' Unable to parse line failure '//trim(Num2LStr(l))//'. Line number '//TRIM(Int2LStr(TempIDnums(il)))//' out of bounds.', ErrStat, ErrMsg, RoutineName ) + CALL CleanUp() + return + endif + + ! check whether line is attached to fail point at fairlead or anchor and assing line tops + if (m%FailList(l)%isRod == 0) then ! point + + Success = 0 + DO iil = 1, m%PointList(m%FailList(l)%attachID)%nAttached ! find index of line + if (m%PointList(m%FailList(l)%attachID)%Attached(iil) == m%FailList(l)%lineIDs(il)) then + m%FailList(l)%lineTops(il) = m%PointList(m%FailList(l)%attachID)%Top(iil) + Success = 1 + exit + endif + ENDDO + + if (Success == 0) then + CALL SetErrStat( ErrID_Fatal, " Line "//trim(num2lstr(m%FailList(l)%lineIDs(il)))//" not attached to point "//trim(num2lstr(m%FailList(l)%attachID))//" for failure "//trim(num2lstr(m%FailList(l)%IdNum)), ErrStat, ErrMsg, RoutineName ) + CALL CleanUp() + return + endif + + elseif (m%FailList(l)%isRod == 1) then ! Rod end A + + Success = 0 + DO iil = 1, m%RodList(m%FailList(l)%attachID)%nAttachedA ! find index of line + if (m%RodList(m%FailList(l)%attachID)%AttachedA(iil) == m%FailList(l)%lineIDs(il)) then + m%FailList(l)%lineTops(il) = m%RodList(m%FailList(l)%attachID)%TopA(iil) + Success = 1 + exit + endif + ENDDO + + if (Success == 0) then + CALL SetErrStat( ErrID_Fatal, " Line "//trim(num2lstr(m%FailList(l)%lineIDs(il)))//" not attached to R"//trim(num2lstr(m%FailList(l)%attachID))//"A for failure "//trim(num2lstr(m%FailList(l)%IdNum)), ErrStat, ErrMsg, RoutineName ) + CALL CleanUp() + return + endif + + elseif (m%FailList(l)%isRod == 2) then ! Rod end B + + Success = 0 + DO iil = 1, m%RodList(m%FailList(l)%attachID)%nAttachedB ! find index of line + if (m%RodList(m%FailList(l)%attachID)%AttachedB(iil) == m%FailList(l)%lineIDs(il)) then + m%FailList(l)%lineTops(il) = m%RodList(m%FailList(l)%attachID)%TopB(iil) + Success = 1 + exit + endif + ENDDO + + if (Success == 0) then + CALL SetErrStat( ErrID_Fatal, " Line "//trim(num2lstr(m%FailList(l)%lineIDs(il)))//" not attached to R"//trim(num2lstr(m%FailList(l)%attachID))//"B for failure "//trim(num2lstr(m%FailList(l)%IdNum)), ErrStat, ErrMsg, RoutineName ) + CALL CleanUp() + return + endif + + else + CALL SetErrStat( ErrID_Fatal, " isRod out of range for failure "//trim(num2lstr(m%FailList(l)%IdNum)), ErrStat, ErrMsg, RoutineName ) + CALL CleanUp() + return + endif + ENDDO + + ! cant have both time and tension conditions, time is prioritized + if ((m%FailList(l)%failTime > 0) .AND. (m%FailList(l)%failTen > 0)) then + CALL SetErrStat( ErrID_Info, ' MoorDyn failure condition checks time before tension. If time reached before tension, failure '//trim(Num2LStr(m%FailList(l)%IdNum))//' will trigger.', ErrStat, ErrMsg, RoutineName ) + endif + + if ((m%PointList(m%FailList(l)%attachID)%typeNum == 0) .AND. (m%PointList(m%FailList(l)%attachID)%nAttached == m%FailList(l)%nLinesToDetach)) then + + ! if X lines called to fail from a free point with only X lines attached + Call SetErrStat(ErrID_Warn, trim(num2lstr(m%FailList(l)%nLinesToDetach))//" lines called to fail from a free point with only "//trim(num2lstr(m%FailList(l)%nLinesToDetach))//" lines attached. Failure "//trim(num2lstr(l))//" ignored.", ErrStat, ErrMsg, RoutineName ) + m%FailList(l)%failStatus = 2 + + elseif ((m%FailList(l)%failTime == 0) .AND. (m%FailList(l)%failTen == 0)) then + + CALL SetErrStat( ErrID_Warn, ' MoorDyn failure condition must have non-zero time or tension. Failure condition '//trim(Num2LStr(m%FailList(l)%IdNum))//' ignored.', ErrStat, ErrMsg, RoutineName ) + m%FailList(l)%failStatus = 2 + + else + + m%FailList(l)%failStatus = 0; ! initialize as unfailed + + endif + + endif + enddo + !------------------------------------------------------------------------------------------- else if (INDEX(Line, "OUTPUT") > 0) then ! if output header @@ -1535,7 +1887,12 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er CALL CheckError( ErrStat2, ErrMsg2 ) IF (ErrStat >= AbortErrLev) RETURN - + if (p%writeLog > 1) then + write(p%UnLog, '(A)' ) " - Outputs List:" + DO J = 1, p%NumOuts + write(p%UnLog, '(A)' ) " "//OutList(J) + END DO + end if !------------------------------------------------------------------------------------------- else ! otherwise ignore this line that isn't a recognized header line and read the next line Line = NextLine(i) @@ -1574,7 +1931,10 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er ! p%NAnchs = 0 ! this is the number of "fixed" type Points. <<<<<<<<<<<<<< CALL WrScr(trim(Num2LStr(p%nLines))//' lines, '//trim(Num2LStr(p%NPoints))//' points, '//trim(Num2LStr(p%nRods))//' rods, '//trim(Num2LStr(p%nBodies))//' bodies.') - + if (p%writeLog > 0) then + write(p%UnLog, '(A)') NewLine + write(p%UnLog, '(A)') ' Created mooring system: '//trim(Num2LStr(p%nLines))//' lines, '//trim(Num2LStr(p%NPoints))//' points, '//trim(Num2LStr(p%nRods))//' rods, '//trim(Num2LStr(p%nBodies))//' bodies.' + end if @@ -1615,7 +1975,7 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er ! write system description to log file if (p%writeLog > 1) then - write(p%UnLog, '(A)') "----- MoorDyn Model Summary (to be written) -----" + write(p%UnLog, '(A)') "----- MoorDyn Model Summary (unfinished) -----" end if @@ -1677,13 +2037,14 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er ! prepare state vector etc. !------------------------------------------------------------------------------------ - ! the number of states is Nx + ! the number of states is Nx and Nxtra includes additional states for potential line failures m%Nx = Nx + m%Nxtra = m%Nx + 6*2*p%nLines - IF (wordy > 0) print *, "allocating state vectors to size ", Nx + IF (wordy > 0) print *, "allocating state vectors to size ", m%Nxtra ! allocate state vector and temporary state vectors based on size just calculated - ALLOCATE ( x%states(m%Nx), m%xTemp%states(m%Nx), m%xdTemp%states(m%Nx), STAT = ErrStat2 ) + ALLOCATE ( x%states(m%Nxtra), m%xTemp%states(m%Nxtra), m%xdTemp%states(m%Nxtra), STAT = ErrStat2 ) IF ( ErrStat2 /= ErrID_None ) THEN ErrMsg = ' Error allocating state vectors.' !CALL CleanUp() @@ -1735,9 +2096,10 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er DO iTurb = 1,p%nTurbines ! calculate rotation matrix OrMat for the initial orientation provided for this turbine - CALL SmllRotTrans('PtfmInit', InitInp%PtfmInit(4,iTurb),InitInp%PtfmInit(5,iTurb),InitInp%PtfmInit(6,iTurb), OrMat, '', ErrStat2, ErrMsg2) - CALL CheckError( ErrStat2, ErrMsg2 ) - IF (ErrStat >= AbortErrLev) RETURN + ! CALL SmllRotTrans('PtfmInit', InitInp%PtfmInit(4,iTurb),InitInp%PtfmInit(5,iTurb),InitInp%PtfmInit(6,iTurb), OrMat, '', ErrStat2, ErrMsg2) + ! CALL CheckError( ErrStat2, ErrMsg2 ) + ! IF (ErrStat >= AbortErrLev) RETURN + OrMat = EulerConstructZYX((/InitInp%PtfmInit(4,iTurb),InitInp%PtfmInit(5,iTurb),InitInp%PtfmInit(6,iTurb)/)) ! count number of coupling nodes needed for the mesh of this turbine K = p%nCpldBodies(iTurb) + p%nCpldRods(iTurb) + p%nCpldPoints(iTurb) @@ -1754,30 +2116,35 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er CALL CheckError( ErrStat2, ErrMsg2 ) IF (ErrStat >= AbortErrLev) RETURN - ! note: in MoorDyn-F v2, the points in the mesh correspond in order to all the coupled bodies, then rods, then points - ! >>> make sure all coupled objects have been offset correctly by the PtfmInit values, including if it's a farm situation -- below or where the objects are first created <<<< + ! Note: in MoorDyn-F v2, the points in the mesh correspond in order to + ! all the coupled bodies, then rods, then points. The below code makes + ! sure all coupled objects have been offset correctly by the PtfmInit + ! values (initial platform pose), including if using FAST.Farm. + ! rRef and OrMatRef or the position and orientation matrix of the + ! coupled object relative to the platform, based on the input file. + ! They are used to set the "reference" pose of each coupled mesh + ! entry before the intial offsets from PtfmInit are applied. J = 0 ! this is the counter through the mesh points for each turbine DO l = 1,p%nCpldBodies(iTurb) J = J + 1 - rRef = m%BodyList(m%CpldBodyIs(l,iTurb))%r6 ! for now set reference position as per input file <<< - !OrMatRef = - - CALL MeshPositionNode(u%CoupledKinematics(iTurb), J, rRef(1:3), ErrStat2, ErrMsg2) ! defaults to identity orientation matrix - !TODO: >>> should also maybe set reference orientation (which might make part of a couple lines down redundant) <<< - - ! calculate initial point relative position, adjusted due to initial platform translations - u%CoupledKinematics(iTurb)%TranslationDisp(:,J) = InitInp%PtfmInit(1:3,iTurb) - rRef(1:3) - - OrMat2 = MATMUL(OrMat, TRANSPOSE( EulerConstruct( rRef(4:6)))) ! combine the Body's relative orientation with the turbine's initial orientation - u%CoupledKinematics(iTurb)%Orientation(:,:,J) = OrMat2 ! set the result as the current orientation of the body <<< + rRef = m%BodyList(m%CpldBodyIs(l,iTurb))%r6 ! set reference position as per input file + OrMatRef = ( m%BodyList(m%CpldBodyIs(l,iTurb))%OrMat ) ! set reference orientation as per input file + CALL MeshPositionNode(u%CoupledKinematics(iTurb), J, rRef(1:3), ErrStat2, ErrMsg2, OrMatRef) - ! set absolute initial positions in MoorDyn + ! set absolute initial positions in MoorDyn + OrMat2 = MATMUL(OrMat, OrMatRef) ! combine the Body's relative orientation with the turbine's initial orientation + u%CoupledKinematics(iTurb)%Orientation(:,:,J) = OrMat2 ! set the result as the current orientation of the body + + ! calculate initial body relative position, adjusted due to initial platform translations + u%CoupledKinematics(iTurb)%TranslationDisp(1,J) = InitInp%PtfmInit(1,iTurb) + OrMat(1,1)*rRef(1) + OrMat(2,1)*rRef(2) + OrMat(3,1)*rRef(3) - rRef(1) + u%CoupledKinematics(iTurb)%TranslationDisp(2,J) = InitInp%PtfmInit(2,iTurb) + OrMat(1,2)*rRef(1) + OrMat(2,2)*rRef(2) + OrMat(3,2)*rRef(3) - rRef(2) + u%CoupledKinematics(iTurb)%TranslationDisp(3,J) = InitInp%PtfmInit(3,iTurb) + OrMat(1,3)*rRef(1) + OrMat(2,3)*rRef(2) + OrMat(3,3)*rRef(3) - rRef(3) m%BodyList(m%CpldBodyIs(l,iTurb))%r6(1:3) = u%CoupledKinematics(iTurb)%Position(:,J) + u%CoupledKinematics(iTurb)%TranslationDisp(:,J) + p%TurbineRefPos(:,iTurb) - m%BodyList(m%CpldBodyIs(l,iTurb))%r6(4:6) = EulerExtract(MATMUL(OrMat, TRANSPOSE( EulerConstruct( rRef(4:6))))) ! apply rotation from PtfmInit onto input file's body orientation to get its true initial orientation + m%BodyList(m%CpldBodyIs(l,iTurb))%r6(4:6) = EulerExtract( TRANSPOSE(OrMat2) ) ! apply rotation from PtfmInit onto input file's body orientation to get its true initial orientation CALL MeshConstructElement(u%CoupledKinematics(iTurb), ELEMENT_POINT, ErrStat2, ErrMsg2, J) ! set node as point element @@ -1790,23 +2157,22 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er J = J + 1 rRef = m%RodList(m%CpldRodIs(l,iTurb))%r6 ! for now set reference position as per input file <<< - OrMatRef = TRANSPOSE( m%RodList(m%CpldRodIs(l,iTurb))%OrMat ) ! for now set reference orientation as per input file <<< + + ! set absolute initial positions in MoorDyn + OrMatRef = ( m%RodList(m%CpldRodIs(l,iTurb))%OrMat ) ! set reference orientation as per input file CALL MeshPositionNode(u%CoupledKinematics(iTurb), J, rRef(1:3), ErrStat2, ErrMsg2, OrMatRef) ! assign the reference position and orientation + OrMat2 = MATMUL(OrMat, OrMatRef) ! combine the Rod's relative orientation with the turbine's initial orientation + u%CoupledKinematics(iTurb)%Orientation(:,:,J) = OrMat2 ! set the result as the current orientation of the rod <<< - ! calculate initial point relative position, adjusted due to initial platform rotations and translations <<< could convert to array math + ! calculate initial rod relative position, adjusted due to initial platform rotations and translations <<< could convert to array math u%CoupledKinematics(iTurb)%TranslationDisp(1,J) = InitInp%PtfmInit(1,iTurb) + OrMat(1,1)*rRef(1) + OrMat(2,1)*rRef(2) + OrMat(3,1)*rRef(3) - rRef(1) u%CoupledKinematics(iTurb)%TranslationDisp(2,J) = InitInp%PtfmInit(2,iTurb) + OrMat(1,2)*rRef(1) + OrMat(2,2)*rRef(2) + OrMat(3,2)*rRef(3) - rRef(2) u%CoupledKinematics(iTurb)%TranslationDisp(3,J) = InitInp%PtfmInit(3,iTurb) + OrMat(1,3)*rRef(1) + OrMat(2,3)*rRef(2) + OrMat(3,3)*rRef(3) - rRef(3) - - OrMat2 = MATMUL(OrMat, TRANSPOSE( EulerConstruct( rRef(4:6)))) ! combine the Rod's relative orientation with the turbine's initial orientation - u%CoupledKinematics(iTurb)%Orientation(:,:,J) = OrMat2 ! set the result as the current orientation of the rod <<< - - ! set absolute initial positions in MoorDyn m%RodList(m%CpldRodIs(l,iTurb))%r6(1:3) = u%CoupledKinematics(iTurb)%Position(:,J) + u%CoupledKinematics(iTurb)%TranslationDisp(:,J) + p%TurbineRefPos(:,iTurb) - m%RodList(m%CpldRodIs(l,iTurb))%r6(4:6) = EulerExtract(MATMUL(OrMat, OrMatRef)) ! apply rotation from PtfmInit onto input file's rod orientation to get its true initial orientation + m%RodList(m%CpldRodIs(l,iTurb))%r6(4:6) = MATMUL(OrMat2 , (/0.0, 0.0, 1.0/) ) ! apply rotation from PtfmInit onto input file's rod orientation to get its true initial orientation ! >>> still need to set Rod initial orientations accounting for PtfmInit rotation <<< - + CALL MeshConstructElement(u%CoupledKinematics(iTurb), ELEMENT_POINT, ErrStat2, ErrMsg2, J) ! lastly, do this to set the attached line endpoint positions: @@ -1818,16 +2184,14 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er ! set reference position as per input file <<< what about turbine positions in array? rRef(1:3) = m%PointList(m%CpldPointIs(l,iTurb))%r + + ! set absolute initial positions in MoorDyn CALL MeshPositionNode(u%CoupledKinematics(iTurb), J, rRef(1:3), ErrStat2, ErrMsg2) - ! calculate initial point relative position, adjusted due to initial platform rotations and translations <<< could convert to array math u%CoupledKinematics(iTurb)%TranslationDisp(1,J) = InitInp%PtfmInit(1,iTurb) + OrMat(1,1)*rRef(1) + OrMat(2,1)*rRef(2) + OrMat(3,1)*rRef(3) - rRef(1) u%CoupledKinematics(iTurb)%TranslationDisp(2,J) = InitInp%PtfmInit(2,iTurb) + OrMat(1,2)*rRef(1) + OrMat(2,2)*rRef(2) + OrMat(3,2)*rRef(3) - rRef(2) - u%CoupledKinematics(iTurb)%TranslationDisp(3,J) = InitInp%PtfmInit(3,iTurb) + OrMat(1,3)*rRef(1) + OrMat(2,3)*rRef(2) + OrMat(3,3)*rRef(3) - rRef(3) - - ! set absolute initial positions in MoorDyn + u%CoupledKinematics(iTurb)%TranslationDisp(3,J) = InitInp%PtfmInit(3,iTurb) + OrMat(1,3)*rRef(1) + OrMat(2,3)*rRef(2) + OrMat(3,3)*rRef(3) - rRef(3) m%PointList(m%CpldPointIs(l,iTurb))%r = u%CoupledKinematics(iTurb)%Position(:,J) + u%CoupledKinematics(iTurb)%TranslationDisp(:,J) + p%TurbineRefPos(:,iTurb) - CALL MeshConstructElement(u%CoupledKinematics(iTurb), ELEMENT_POINT, ErrStat2, ErrMsg2, J) ! lastly, do this to set the attached line endpoint positions: @@ -1943,7 +2307,7 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er ! >>> maybe this should be skipped <<<< - ! Go through Bodys and write the coordinates to the state vector + ! Go through free Bodys (including pinned) and write the coordinates to the state vector DO l = 1,p%nFreeBodies CALL Body_Initialize(m%BodyList(m%FreeBodyIs(l)), x%states(m%BodyStateIs1(l) : m%BodyStateIsN(l)), m) END DO @@ -2036,7 +2400,7 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er ! if log file, compute and write some object properties ! ------------------------------------------------------------------- if (p%writeLog > 1) then - + write(p%UnLog, '(A)' ) "Values after intialization before dynamic relaxation" write(p%UnLog, '(A)' ) " Bodies:" DO l = 1,p%nBodies write(p%UnLog, '(A)' ) " Body"//trim(num2lstr(l))//":" @@ -2046,21 +2410,21 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er write(p%UnLog, '(A)' ) " Rods:" DO l = 1,p%nRods write(p%UnLog, '(A)' ) " Rod"//trim(num2lstr(l))//":" - ! m%RodList(l) + write(p%UnLog, '(A12, f12.4)') " mass: ", m%RodList(l)%M6net(1,1) + write(p%UnLog, '(A17, A)') " direction: ", trim(num2lstr(m%RodList(l)%q(1)))//", "//trim(num2lstr(m%RodList(l)%q(2)))//", "//trim(num2lstr(m%RodList(l)%q(3))) END DO write(p%UnLog, '(A)' ) " Points:" DO l = 1,p%nFreePoints write(p%UnLog, '(A)' ) " Point"//trim(num2lstr(l))//":" - ! m%PointList(l) + write(p%UnLog, '(A12, f12.4)') " mass: ", m%PointList(l)%M END DO write(p%UnLog, '(A)' ) " Lines:" DO l = 1,p%nLines write(p%UnLog, '(A)' ) " Line"//trim(num2lstr(l))//":" - ! m%LineList(l) END DO - + write(p%UnLog, '(A)') "--------- End of Model Summary --------- "//NewLine end if @@ -2072,6 +2436,9 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er if (InputFileDat%TMaxIC > 0.0_DbKi) then CALL WrScr(" Finalizing initial conditions using dynamic relaxation."//NewLine) ! newline because next line writes over itself + if (p%writeLog > 0) then + write(p%UnLog,'(A)') "Finalizing initial conditions using dynamic relaxation."//NewLine + end if ! boost drag coefficient of each line type <<<<<<<< does this actually do anything or do lines hold these coefficients??? DO I = 1, p%nLines @@ -2140,6 +2507,10 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er IF (ErrStat == ErrID_Fatal) THEN CALL WrScr("NaN detected at time "//TRIM(Num2LStr(t))//" during MoorDyn's dynamic relaxation process.") + if (p%writeLog > 0) then + write(p%UnLog,'(A)') "NaN detected at time "//TRIM(Num2LStr(t))//" during MoorDyn's dynamic relaxation process."//NewLine + end if + IF (wordy > 1) THEN print *, "Here is the state vector: " print *, x%states @@ -2191,11 +2562,18 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er END DO IF (Converged == 1) THEN ! if we made it with all cases satisfying the threshold - CALL WrScr('') ! serves as line break from write over command in previous printed line CALL WrScr(' Fairlead tensions converged to '//trim(Num2LStr(100.0*InputFileDat%threshIC))//'% after '//trim(Num2LStr(t))//' seconds.') + if (p%writeLog > 0) then + write(p%UnLog,'(A)') '' + write(p%UnLog,'(A)') ' Fairlead tensions converged to '//trim(Num2LStr(100.0*InputFileDat%threshIC))//'% after '//trim(Num2LStr(t))//' seconds.'//NewLine + end if DO l = 1, p%nLines CALL WrScr(' Fairlead tension: '//trim(Num2LStr(FairTensIC(l,1)))) CALL WrScr(' Fairlead forces: '//trim(Num2LStr(m%LineList(l)%Fnet(1, m%LineList(l)%N)))//', '//trim(Num2LStr(m%LineList(l)%Fnet(2, m%LineList(l)%N)))//', '//trim(Num2LStr(m%LineList(l)%Fnet(3, m%LineList(l)%N)))) + if (p%writeLog > 0) then + write(p%UnLog,'(A)') ' Fairlead tension: '//trim(Num2LStr(FairTensIC(l,1))) + write(p%UnLog,'(A)') ' Fairlead forces: '//trim(Num2LStr(m%LineList(l)%Fnet(1, m%LineList(l)%N)))//', '//trim(Num2LStr(m%LineList(l)%Fnet(2, m%LineList(l)%N)))//', '//trim(Num2LStr(m%LineList(l)%Fnet(3, m%LineList(l)%N))) + end if ENDDO EXIT ! break out of the time stepping loop END IF @@ -2204,6 +2582,11 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er IF (I == ceiling(InputFileDat%TMaxIC/InputFileDat%dtIC) ) THEN CALL WrScr('') ! serves as line break from write over command in previous printed line CALL WrScr(' Fairlead tensions did not converge within TMaxIC='//trim(Num2LStr(InputFileDat%TMaxIC))//' seconds.') + if (p%writeLog > 0) then + write(p%UnLog,'(A)') '' + write(p%UnLog,'(A)') ' Fairlead tensions did not converge within TMaxIC='//trim(Num2LStr(InputFileDat%TMaxIC))//' seconds.' + end if + !ErrStat = ErrID_Warn !ErrMsg = ' MD_Init: ran dynamic convergence to TMaxIC without convergence' END IF @@ -2248,6 +2631,14 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er endif CALL WrScr(' MoorDyn initialization completed.') + if (p%writeLog > 0) then + write(p%UnLog, '(A)') NewLine//"MoorDyn initialization completed."//NewLine + if (ErrStat /= ErrID_None) then + write(p%UnLog, '(A34)') "Initalization Errors and Warnings:" + write(p%UnLog, '(A)' ) ErrMsg + end if + write(p%UnLog, '(A)') NewLine + end if m%LastOutTime = -1.0_DbKi ! set to nonzero to ensure that output happens at the start of simulation at t=0 @@ -2329,7 +2720,6 @@ END SUBROUTINE CheckError SUBROUTINE CleanUp() ! ErrStat = ErrID_Fatal call MD_DestroyInputFileType( InputFileDat, ErrStat2, ErrMsg2 ) ! Ignore any error messages from this - IF (p%UnLog > 0_IntKi) CLOSE( p%UnLog ) ! Remove this when the log file is kept open during the full simulation END SUBROUTINE !> If for some reason the file is truncated, it is possible to get into an infinite loop @@ -2359,7 +2749,7 @@ SUBROUTINE MD_UpdateStates( t, n, u, t_array, p, x, xd, z, other, m, ErrStat, Er INTEGER(IntKi) , INTENT(IN ) :: n TYPE(MD_InputType) , INTENT(INOUT) :: u(:) ! INTENT(INOUT) ! had to change this to INOUT REAL(DbKi) , INTENT(IN ) :: t_array(:) - TYPE(MD_ParameterType) , INTENT(IN ) :: p ! INTENT(IN ) + TYPE(MD_ParameterType) , INTENT(INOUT) :: p ! INTENT(IN ) TYPE(MD_ContinuousStateType) , INTENT(INOUT) :: x ! INTENT(INOUT) TYPE(MD_DiscreteStateType) , INTENT(INOUT) :: xd ! INTENT(INOUT) TYPE(MD_ConstraintStateType) , INTENT(INOUT) :: z ! INTENT(INOUT) @@ -2381,6 +2771,8 @@ SUBROUTINE MD_UpdateStates( t, n, u, t_array, p, x, xd, z, other, m, ErrStat, Er INTEGER(IntKi) :: NdtM ! number of time steps to integrate through with RK2 INTEGER(IntKi) :: I INTEGER(IntKi) :: J + INTEGER(IntKi) :: l, li, lii, il ! index + INTEGER(IntKi) :: tension ! tension at line attachment to failure point nTime = size(u) ! the number of times of input data provided? <<<<<<< not used @@ -2435,19 +2827,15 @@ SUBROUTINE MD_UpdateStates( t, n, u, t_array, p, x, xd, z, other, m, ErrStat, Er IF (Is_NaN(x%states(J))) THEN ErrStat = ErrID_Fatal ErrMsg = ' NaN state detected.' + IF (wordy > 1) THEN + print *, ". Here is the state vector: " + print *, x%states + END IF + CALL CheckError(ErrStat, ErrMsg) EXIT END IF END DO - IF (ErrStat == ErrID_Fatal) THEN - CALL WrScr("NaN detected at time "//TRIM(Num2LStr(t2))//" in MoorDyn.") - IF (wordy > 1) THEN - print *, ". Here is the state vector: " - print *, x%states - END IF - EXIT - END IF - END DO ! I time steps @@ -2457,6 +2845,7 @@ SUBROUTINE MD_UpdateStates( t, n, u, t_array, p, x, xd, z, other, m, ErrStat, Er CALL MD_DestroyInput(u_interp, ErrStat, ErrMsg) IF ( ErrStat /= ErrID_None ) THEN ErrMsg = ' Error destroying dxdt or x2.' + CALL CheckError(ErrStat, ErrMsg) END IF ! CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'MD_UpdateStates') @@ -2466,20 +2855,181 @@ SUBROUTINE MD_UpdateStates( t, n, u, t_array, p, x, xd, z, other, m, ErrStat, Er IF (Is_NaN(x%states(J))) THEN ErrStat = ErrID_Fatal ErrMsg = ' NaN state detected.' + IF (wordy > 1) THEN + print *, ". Here is the state vector: " + print *, x%states + END IF + CALL CheckError(ErrStat, ErrMsg) EXIT END IF END DO - - IF (ErrStat == ErrID_Fatal) THEN - CALL WrScr("NaN detected at time "//TRIM(Num2LStr(t2))//" in MoorDyn.") - IF (wordy > 1) THEN - print *, ". Here is the state vector: " - print *, x%states - END IF - END IF + + ! do we want to check failures here (at the coupling step level? Or at the dtM level?) + ! --------------- check for line failures (detachments!) ---------------- + DO l= 1,p%nFails + + if (m%FailList(l)%failStatus == 0) then + + if ((t >= m%FailList(l)%failTime) .AND. (m%FailList(l)%failTime .NE. 0.0)) then + + ! step 1: check for time-triggered failures + + CALL WrScr("Failure number "//trim(Num2LStr(l))//" triggered by t = "//trim(Num2LStr(t))) + if (p%writeLog > 0) then + write(p%UnLog,'(A)') "Failure number "//trim(Num2LStr(l))//" triggered by t = "//trim(Num2LStr(t)) + end if + + m%FailList(l)%failStatus = 1; ! set status to failed so it's not checked again + CALL DetachLines(m%FailList(l)%attachID, m%FailList(l)%isRod, m%FailList(l)%lineIDs, m%FailList(l)%lineTops, m%FailList(l)%nLinesToDetach, t) + + elseif (m%FailList(l)%failTen .NE. 0.0) then + + ! step 2: check for tension-triggered failures (this will require specifying max tension things) + + DO il = 1,m%FailList(l)%nLinesToDetach ! for each line in the failure, check the tension at the attachment + + ! check line ID is right + if (m%FailList(l)%lineIDs(il) .NE. m%LineList(m%FailList(l)%lineIDs(il))%IdNum) then + CALL CheckError(ErrID_Fatal, " Line ID's dont match for failure "//trim(num2lstr(m%FailList(l)%IdNum))) + endif + + ! if fairlead else anchor + if (m%FailList(l)%lineTops(il) == 1) then + tension = Line_GetNodeTen(m%LineList(m%FailList(l)%lineIDs(il)), m%LineList(m%FailList(l)%lineIDs(il))%N) + else + tension = Line_GetNodeTen(m%LineList(m%FailList(l)%lineIDs(il)), 0) + endif + + if (tension >= m%FailList(l)%failTen) then + CALL WrScr("Failure number "//trim(Num2LStr(l))//" triggered by line "//trim(num2lstr(m%FailList(l)%lineIDs(il)))//" tension = "//trim(Num2LStr(tension))//" at time = "//trim(Num2LStr(t))) + if (p%writeLog > 0) then + write(p%UnLog,'(A)') "Failure number "//trim(Num2LStr(l))//" triggered by line "//trim(num2lstr(m%FailList(l)%lineIDs(il)))//" tension = "//trim(Num2LStr(tension))//" at time = "//trim(Num2LStr(t)) + end if + + m%FailList(l)%failStatus = 1; ! set status to failed so it's not checked again + CALL DetachLines(m%FailList(l)%attachID, m%FailList(l)%isRod, m%FailList(l)%lineIDs, m%FailList(l)%lineTops, m%FailList(l)%nLinesToDetach, t) + exit ! dont need to check the other lines becasue failure already detected + + endif + + ENDDO ! il = 1,m%FailList(l)%nLinesToDetach + + endif ! end checking time and tension thresholds non-zero + + if (m%FailList(l)%failStatus == 1) then + + ! if a failure is triggered, remove all lines from that failure from all other failures + DO li = 1, p%nFails + if (m%FailList(li)%IdNum .NE. m%FailList(l)%IdNum) then ! if not this failure + if ((m%FailList(l)%attachID == m%FailList(li)%attachID) .AND. (m%FailList(l)%isRod == m%FailList(li)%isRod)) then ! if failures are for the same point + + DO il = 1, m%FailList(l)%nLinesToDetach ! loop through lines of this failure + DO lii = 1, m%FailList(li)%nLinesToDetach ! loop through lines of the other failure + + if (m%FailList(l)%lineIDs(il) == m%FailList(li)%lineIDs(lii)) then ! if this failure's line IDs are found in any of the other failure's line IDs + + m%FailList(li)%nLinesToDetach = m%FailList(li)%nLinesToDetach - 1 ! reduce the size of nLinesToDetach of the other failure + m%FailList(li)%lineIDs(lii) = m%FailList(li)%lineIDs(lii+1) ! move subsequent line ID's forward one spot in the list to eliminate this line ID + CALL CheckError(ErrID_Warn, " Line "//trim(num2lstr(m%FailList(l)%lineIDs(il)))//" removed from Failure "//trim(num2lstr(li))//" becasue it already failed by Failure "//trim(num2lstr(l))) + + endif + + ENDDO + ENDDO + + if (m%FailList(li)%nLinesToDetach == 0) then + ! invalid failure + m%FailList(li)%failStatus = 2 + CALL CheckError (ErrID_Warn, " Failure "//trim(num2lstr(li))//" is a duplicate of Failure "//trim(num2lstr(l))//" and will be ignored.") + endif + + endif + endif + ENDDO !li = 1, p%nFails + endif ! m%FailList(l)%failStatus == 1 + + endif ! m%FailList(l)%failStatus == 0 + + ENDDO ! l= 0,nFails CONTAINS + SUBROUTINE DetachLines (attachID, isRod, lineIDs, lineTops, nLinesToDetach, time) + INTEGER(IntKi), INTENT(IN) :: attachID + INTEGER(IntKi), INTENT(IN) :: isRod + INTEGER(IntKi), INTENT(IN ) :: lineIDs(:) + INTEGER(IntKi), INTENT( OUT) :: lineTops(:) + INTEGER(IntKi), INTENT(IN) :: nLinesToDetach + REAL(DbKi), INTENT(IN ) :: time + INTEGER(IntKi) :: k ! index + REAL(DbKi) :: dummyPointState(6) = 0.0_DbKi ! dummy state array to hold kinematics of old attachment point (format in terms of part of point state vector: r[J] = X[3 + J]; rd[J] = X[J]; ) + + ! add point to list of free ones and add states for it + p%nPoints = p%nPoints + 1 ! add 1 to the number of points (this is now the number of the new point) + p%nFreePoints=p%nFreePoints+1 + m%FreePointIs(p%nFreePoints) = p%nPoints + m%PointStateIs1(p%nFreePoints) = m%Nx+1 ! assign start index of this point's states + m%PointStateIsN(p%nFreePoints) = m%Nx+6 + m%Nx = m%Nx + 6 ! add 6 state variables for each point + + ! note: for the DetachLines subroutine, p%nPoints == m%FreePointIs(p%nFreePoints) and can be used interchangeably for indexing. p%nPoints is used to make things easier to read + + ! check to make sure we haven't gone beyond the extra size allotted to the state arrays or the points list <<<< really should throw an error here + if (p%nPoints > p%nPointsExtra) then + CALL CheckError(ErrID_Fatal, " DetachLines: p%nPoints > p%nPointsExtra") + endif + if (m%Nx > m%Nxtra) then + CALL CheckError(ErrID_Fatal, " DetachLines: nX > m%Nx") + endif + + ! create new massless point for detached end(s) of line(s) + m%PointList(p%nPoints)%IdNum = p%nPoints + m%PointList(p%nPoints)%r = 0.0_DbKi ! will be set by Point_SetState + m%PointList(p%nPoints)%rd = 0.0_DbKi ! will be set by Point_SetState + m%PointList(p%nPoints)%pointM = 0.0_DbKi + m%PointList(p%nPoints)%pointV = 0.0_DbKi + m%PointList(p%nPoints)%pointCa = 0.0_DbKi + m%PointList(p%nPoints)%pointCda = 0.0_DbKi + m%PointList(p%nPoints)%typeNum = 0_IntKi ! free point + ! not used + m%PointList(p%nPoints)%pointFX = 0.0_DbKi + m%PointList(p%nPoints)%pointFY = 0.0_DbKi + m%PointList(p%nPoints)%pointFZ = 0.0_DbKi + CALL Point_Initialize(m%PointList(p%nPoints), x%states(m%PointStateIs1(p%nFreePoints) : m%pointStateIsN(p%nFreePoints)), m) + + ! detach lines from old Rod or Point, and get kinematics of the old attachment point + + DO k=1,nLinesToDetach + + if (isRod==1) then ! end A + CALL Rod_RemoveLine(m%RodList(attachID), lineIDs(k), lineTops(k), 0, dummyPointState(4:6), dummyPointState(1:3)) + elseif (isRod==2) then ! end B + CALL Rod_RemoveLine(m%RodList(attachID), lineIDs(k), lineTops(k), 1, dummyPointState(4:6), dummyPointState(1:3)) + elseif (isRod==0) then + CALL Point_RemoveLine(m%PointList(attachID), lineIDs(k), lineTops(k), dummyPointState(4:6), dummyPointState(1:3)) + else + CALL CheckError(ErrID_Fatal, " DetachLines: Failure doesn't have a valid isRod value of 0, 1, or 2.") + endif + + ENDDO + + ! attach lines to new point + DO k=1,nLinesToDetach ! for each relevant line + CALL Point_AddLine(m%PointList(p%nPoints), lineIDs(k), lineTops(k)) + ENDDO + + ! update point kinematics to match old line attachment point kinematics and set positions of attached line ends + CALL Point_SetState(m%PointList(p%nPoints),dummyPointState, time, m) + + ! now make the state vector up to date! + DO k=1,6 + x%states(m%PointStateIs1(p%nFreePoints)+(k-1)) = dummyPointState(k) + ENDDO + + IF (wordy > 0) print *, "Set up new Point ", p%nPoints, " of type ", m%PointList(p%nPoints)%typeNum + + END SUBROUTINE DetachLines + SUBROUTINE CheckError(ErrId, Msg) ! This subroutine sets the error message and level and cleans up if the error is >= AbortErrLev @@ -2493,11 +3043,16 @@ SUBROUTINE CheckError(ErrId, Msg) ErrMsg = TRIM(ErrMsg)//' MD_UpdateStates:'//TRIM(Msg) ! add current error message ErrStat = MAX(ErrStat, ErrID) - CALL WrScr( ErrMsg ) ! do this always or only if warning level? + ! if (ErrStat <= ErrID_Warn) then + ! CALL WrScr( ErrMsg ) ! do this always or only if warning level? + ! endif IF( ErrStat > ErrID_Warn ) THEN + if (p%writeLog > 0) then + write(p%UnLog,'(A)') ErrMsg + end if ! CALL MD_DestroyInput( u_interp, ErrStat, ErrMsg ) - RETURN + RETURN END IF END IF @@ -2606,14 +3161,14 @@ SUBROUTINE MD_CalcOutput( t, u, p, x, xd, z, other, y, m, ErrStat, ErrMsg ) J = 0 ! mesh index DO l = 1,p%nCpldBodies(iTurb) J = J + 1 - CALL Body_GetCoupledForce(m%BodyList(m%CpldBodyIs(l,iTurb)), F6net, m, p) + CALL Body_GetCoupledForce(t, m%BodyList(m%CpldBodyIs(l,iTurb)), F6net, m, p) y%CoupledLoads(iTurb)%Force( :,J) = F6net(1:3) y%CoupledLoads(iTurb)%Moment(:,J) = F6net(4:6) END DO DO l = 1,p%nCpldRods(iTurb) J = J + 1 - CALL Rod_GetCoupledForce(m%RodList(m%CpldRodIs(l,iTurb)), F6net, m, p) + CALL Rod_GetCoupledForce(t, m%RodList(m%CpldRodIs(l,iTurb)), F6net, m, p) y%CoupledLoads(iTurb)%Force( :,J) = F6net(1:3) y%CoupledLoads(iTurb)%Moment(:,J) = F6net(4:6) END DO @@ -2698,6 +3253,9 @@ SUBROUTINE CheckError(ErrId, Msg) ErrStat = MAX(ErrStat, ErrID) CALL WrScr( ErrMsg ) ! do this always or only if warning level? <<<<<<<<<<<<<<<<<<<<<< probably should remove all instances + if (p%writeLog > 0) then + write(p%UnLog,'(A)') ErrMsg + end if ! IF( ErrStat > ErrID_Warn ) THEN ! CALL MD_DestroyContState( dxdt, ErrStat2, ErrMsg2) @@ -2733,10 +3291,10 @@ SUBROUTINE MD_CalcContStateDeriv( t, u, p, x, xd, z, other, m, dxdt, ErrStat, Er INTEGER(IntKi) :: J ! index INTEGER(IntKi) :: K ! index INTEGER(IntKi) :: iTurb ! index - INTEGER(IntKi) :: Istart ! start index of line/point in state vector - INTEGER(IntKi) :: Iend ! end index of line/point in state vector +! INTEGER(IntKi) :: Istart ! start index of line/point in state vector +! INTEGER(IntKi) :: Iend ! end index of line/point in state vector - REAL(DbKi) :: temp(3) ! temporary for passing kinematics +! REAL(DbKi) :: temp(3) ! temporary for passing kinematics REAL(DbKi) :: r6_in(6) ! temporary for passing kinematics REAL(DbKi) :: v6_in(6) ! temporary for passing kinematics @@ -2791,8 +3349,7 @@ SUBROUTINE MD_CalcContStateDeriv( t, u, p, x, xd, z, other, m, dxdt, ErrStat, Er DO l = 1,p%nCpldBodies(iTurb) J = J + 1 r6_in(1:3) = u%CoupledKinematics(iTurb)%Position(:,J) + u%CoupledKinematics(iTurb)%TranslationDisp(:,J) + p%TurbineRefPos(:,iTurb) - !r6_in(4:6) = EulerExtract( TRANSPOSE( u%CoupledKinematics(iTurb)%Orientation(:,:,J) ) ) - r6_in(4:6) = EulerExtract( u%CoupledKinematics(iTurb)%Orientation(:,:,J) ) ! <<< changing back + r6_in(4:6) = EulerExtract( u%CoupledKinematics(iTurb)%Orientation(:,:,J) ) ! No Transpose becasue these are extrinsic v6_in(1:3) = u%CoupledKinematics(iTurb)%TranslationVel(:,J) v6_in(4:6) = u%CoupledKinematics(iTurb)%RotationVel(:,J) a6_in(1:3) = u%CoupledKinematics(iTurb)%TranslationAcc(:,J) @@ -2850,6 +3407,9 @@ SUBROUTINE MD_CalcContStateDeriv( t, u, p, x, xd, z, other, m, dxdt, ErrStat, Er ErrStat = ErrID_Fatal ErrMsg = ' Active tension command will make a segment longer than the limit of twice its original length.' call WrScr(trim(Num2LStr(u%DeltaL(m%LineList(L)%CtrlChan)))//" is an increase of more than "//trim(Num2LStr(m%LineList(L)%UnstrLen / m%LineList(L)%N))) + if (p%writeLog > 0) then + write(p%UnLog,'(A)') trim(Num2LStr(u%DeltaL(m%LineList(L)%CtrlChan)))//" is an increase of more than "//trim(Num2LStr(m%LineList(L)%UnstrLen / m%LineList(L)%N)) + end if IF (wordy > 0) print *, u%DeltaL IF (wordy > 0) print*, m%LineList(L)%CtrlChan RETURN @@ -2858,6 +3418,9 @@ SUBROUTINE MD_CalcContStateDeriv( t, u, p, x, xd, z, other, m, dxdt, ErrStat, Er ErrStat = ErrID_Fatal ErrMsg = ' Active tension command will make a segment shorter than the limit of half its original length.' call WrScr(trim(Num2LStr(u%DeltaL(m%LineList(L)%CtrlChan)))//" is a reduction of more than half of "//trim(Num2LStr(m%LineList(L)%UnstrLen / m%LineList(L)%N))) + if (p%writeLog > 0) then + write(p%UnLog,'(A)') trim(Num2LStr(u%DeltaL(m%LineList(L)%CtrlChan)))//" is a reduction of more than half of "//trim(Num2LStr(m%LineList(L)%UnstrLen / m%LineList(L)%N)) + end if IF (wordy > 0) print *, u%DeltaL IF (wordy > 0) print*, m%LineList(L)%CtrlChan RETURN @@ -2939,7 +3502,10 @@ SUBROUTINE MD_CalcContStateDeriv( t, u, p, x, xd, z, other, m, dxdt, ErrStat, Er ! calculate line dynamics (and calculate line forces and masses attributed to points) DO l = 1,p%nLines - CALL Line_GetStateDeriv(m%LineList(l), dxdt%states(m%LineStateIs1(l):m%LineStateIsN(l)), m, p) !dt might also be passed for fancy friction models + CALL Line_GetStateDeriv(m%LineList(l), dxdt%states(m%LineStateIs1(l):m%LineStateIsN(l)), m, p, ErrStat, ErrMsg) !dt might also be passed for fancy friction models + if (ErrStat == ErrID_Fatal) then + return + endif END DO ! calculate point dynamics (including contributions from attached lines @@ -2966,19 +3532,23 @@ SUBROUTINE MD_CalcContStateDeriv( t, u, p, x, xd, z, other, m, dxdt, ErrStat, Er DO iTurb = 1,p%nTurbines DO l = 1,p%nCpldPoints(iTurb) - ! >>>>>>>> here we should pass along accelerations and include inertial loads in the calculation!!! <<>>>>>>> here we should pass along accelerations and include inertial loads in the calculation!!! << 0) then + write(p%UnLog,'(A)') ErrMsg + end if END IF @@ -3442,12 +4015,12 @@ SUBROUTINE MD_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, do i=1,p%Jac_nx ! index into dx dimension ! get x_op + delta x call MD_CopyContState( x, x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call MD_perturb_x(p, p%dxIdx_map2_xStateIdx(i), 1, x_perturb, delta ) + call MD_perturb_x(p, i, 1, x_perturb, delta ) ! compute y at x_op + delta x call MD_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 MD_CopyContState( x, x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call MD_perturb_x(p, p%dxIdx_map2_xStateIdx(i), -1, x_perturb, delta ) + call MD_perturb_x(p, i, -1, x_perturb, delta ) ! compute y at x_op - delta x call MD_CalcOutput( t, u, p, x_perturb, xd, z, OtherState, y_m, m, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! get central difference: @@ -3467,12 +4040,12 @@ SUBROUTINE MD_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, do i=1,p%Jac_nx ! index into dx dimension ! get x_op + delta x call MD_CopyContState( x, x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call MD_perturb_x(p, p%dxIdx_map2_xStateIdx(i), 1, x_perturb, delta ) + call MD_perturb_x(p, i, 1, x_perturb, delta ) ! compute x at x_op + delta x call MD_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 MD_CopyContState( x, x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call MD_perturb_x(p, p%dxIdx_map2_xStateIdx(i), -1, x_perturb, delta ) + call MD_perturb_x(p, i, -1, x_perturb, delta ) ! compute x at x_op - delta x call MD_CalcContStateDeriv( t, u, p, x_perturb, xd, z, OtherState, m, x_m, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) if(Failed()) return @@ -3700,7 +4273,7 @@ SUBROUTINE MD_Init_Jacobian(Init, p, u, y, m, InitOut, ErrStat, ErrMsg) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SD_Init_Jacobian' - real(ReKi) :: dx, dy, dz, maxDim +! real(ReKi) :: dx, dy, dz, maxDim INTEGER(IntKi) :: l, I real(ReKi) :: dl_slack ! how much a given line segment is stretched [m] @@ -3802,27 +4375,39 @@ SUBROUTINE Init_Jacobian_x() idx = 0 ! Free bodies DO l = 1,p%nFreeBodies ! Body m%BodyList(m%FreeBodyIs(l)) - p%dx(idx+1:idx+3) = dl_slack_min ! body displacement [m] - p%dx(idx+4:idx+6) = 0.02 ! body rotation [rad] - ! corresponds to state indices: (m%BodyStateIs1(l)+6:m%BodyStateIs1(l)+11) - InitOut%LinNames_x(idx+1) = 'Body '//trim(num2lstr(m%FreeBodyIs(l)))//' Px, m' - InitOut%LinNames_x(idx+2) = 'Body '//trim(num2lstr(m%FreeBodyIs(l)))//' Py, m' - InitOut%LinNames_x(idx+3) = 'Body '//trim(num2lstr(m%FreeBodyIs(l)))//' Pz, m' - InitOut%LinNames_x(idx+4) = 'Body '//trim(num2lstr(m%FreeBodyIs(l)))//' rot_x, rad' - InitOut%LinNames_x(idx+5) = 'Body '//trim(num2lstr(m%FreeBodyIs(l)))//' rot_y, rad' - InitOut%LinNames_x(idx+6) = 'Body '//trim(num2lstr(m%FreeBodyIs(l)))//' rot_z, rad' - p%dxIdx_map2_xStateIdx(idx+1) = m%BodyStateIs1(l)+6 ! x%state index for Px - p%dxIdx_map2_xStateIdx(idx+2) = m%BodyStateIs1(l)+7 ! x%state index for Py - p%dxIdx_map2_xStateIdx(idx+3) = m%BodyStateIs1(l)+8 ! x%state index for Pz - p%dxIdx_map2_xStateIdx(idx+4) = m%BodyStateIs1(l)+9 ! x%state index for rot_x - p%dxIdx_map2_xStateIdx(idx+5) = m%BodyStateIs1(l)+10 ! x%state index for rot_y - p%dxIdx_map2_xStateIdx(idx+6) = m%BodyStateIs1(l)+11 ! x%state index for rot_z - idx = idx + 6 + if (m%BodyList(m%FreeBodyIs(l))%typeNum == 2) then ! Coupled pinned body + p%dx(idx+4:idx+6) = 0.02 ! body rotation [rad] + ! corresponds to state indices: (m%BodyStateIs1(l)+6:m%BodyStateIs1(l)+8) + InitOut%LinNames_x(idx+1) = 'Body '//trim(num2lstr(m%FreeBodyIs(l)))//' rot_x, rad' + InitOut%LinNames_x(idx+2) = 'Body '//trim(num2lstr(m%FreeBodyIs(l)))//' rot_y, rad' + InitOut%LinNames_x(idx+3) = 'Body '//trim(num2lstr(m%FreeBodyIs(l)))//' rot_z, rad' + p%dxIdx_map2_xStateIdx(idx+4) = m%BodyStateIs1(l)+3 ! x%state index for rot_x + p%dxIdx_map2_xStateIdx(idx+5) = m%BodyStateIs1(l)+4 ! x%state index for rot_y + p%dxIdx_map2_xStateIdx(idx+6) = m%BodyStateIs1(l)+5 ! x%state index for rot_z + idx = idx + 3 + else ! free body + p%dx(idx+1:idx+3) = dl_slack_min ! body displacement [m] + p%dx(idx+4:idx+6) = 0.02 ! body rotation [rad] + ! corresponds to state indices: (m%BodyStateIs1(l)+6:m%BodyStateIs1(l)+11) + InitOut%LinNames_x(idx+1) = 'Body '//trim(num2lstr(m%FreeBodyIs(l)))//' Px, m' + InitOut%LinNames_x(idx+2) = 'Body '//trim(num2lstr(m%FreeBodyIs(l)))//' Py, m' + InitOut%LinNames_x(idx+3) = 'Body '//trim(num2lstr(m%FreeBodyIs(l)))//' Pz, m' + InitOut%LinNames_x(idx+4) = 'Body '//trim(num2lstr(m%FreeBodyIs(l)))//' rot_x, rad' + InitOut%LinNames_x(idx+5) = 'Body '//trim(num2lstr(m%FreeBodyIs(l)))//' rot_y, rad' + InitOut%LinNames_x(idx+6) = 'Body '//trim(num2lstr(m%FreeBodyIs(l)))//' rot_z, rad' + p%dxIdx_map2_xStateIdx(idx+1) = m%BodyStateIs1(l)+6 ! x%state index for Px + p%dxIdx_map2_xStateIdx(idx+2) = m%BodyStateIs1(l)+7 ! x%state index for Py + p%dxIdx_map2_xStateIdx(idx+3) = m%BodyStateIs1(l)+8 ! x%state index for Pz + p%dxIdx_map2_xStateIdx(idx+4) = m%BodyStateIs1(l)+9 ! x%state index for rot_x + p%dxIdx_map2_xStateIdx(idx+5) = m%BodyStateIs1(l)+10 ! x%state index for rot_y + p%dxIdx_map2_xStateIdx(idx+6) = m%BodyStateIs1(l)+11 ! x%state index for rot_z + idx = idx + 6 + endif END DO ! Rods DO l = 1,p%nFreeRods ! Rod m%RodList(m%FreeRodIs(l)) - if (m%RodList(m%FreeRodIs(l))%typeNum == 1) then ! pinned rod + if (abs(m%RodList(m%FreeRodIs(l))%typeNum) == 1) then ! pinned rod p%dx(idx+1:idx+3) = 0.02 ! rod rotation [rad] ! corresponds to state indices: (m%RodStateIs1(l)+3:m%RodStateIs1(l)+5) InitOut%LinNames_x(idx+1) = 'Rod '//trim(num2lstr(m%FreeRodIs(l)))//' rot_x, rad' @@ -3886,27 +4471,39 @@ SUBROUTINE Init_Jacobian_x() !----------------- ! Free bodies DO l = 1,p%nFreeBodies ! Body m%BodyList(m%FreeBodyIs(l)) - ! corresponds to state indices: (m%BodyStateIs1(l):m%BodyStateIs1(l)+5) - p%dx(idx+1:idx+3) = 0.1 ! body translational velocity [m/s] - p%dx(idx+4:idx+6) = 0.1 ! body rotational velocity [rad/s] - InitOut%LinNames_x(idx+1) = 'Body '//trim(num2lstr(m%FreeBodyIs(l)))//' Vx, m/s' - InitOut%LinNames_x(idx+2) = 'Body '//trim(num2lstr(m%FreeBodyIs(l)))//' Vy, m/s' - InitOut%LinNames_x(idx+3) = 'Body '//trim(num2lstr(m%FreeBodyIs(l)))//' Vz, m/s' - InitOut%LinNames_x(idx+4) = 'Body '//trim(num2lstr(m%FreeBodyIs(l)))//' omega_x, rad/s' - InitOut%LinNames_x(idx+5) = 'Body '//trim(num2lstr(m%FreeBodyIs(l)))//' omega_y, rad/s' - InitOut%LinNames_x(idx+6) = 'Body '//trim(num2lstr(m%FreeBodyIs(l)))//' omega_z, rad/s' - p%dxIdx_map2_xStateIdx(idx+1) = m%BodyStateIs1(l)+0 ! x%state index for Rx - p%dxIdx_map2_xStateIdx(idx+2) = m%BodyStateIs1(l)+1 ! x%state index for Ry - p%dxIdx_map2_xStateIdx(idx+3) = m%BodyStateIs1(l)+2 ! x%state index for Rz - p%dxIdx_map2_xStateIdx(idx+4) = m%BodyStateIs1(l)+3 ! x%state index for omega_x - p%dxIdx_map2_xStateIdx(idx+5) = m%BodyStateIs1(l)+4 ! x%state index for omega_y - p%dxIdx_map2_xStateIdx(idx+6) = m%BodyStateIs1(l)+5 ! x%state index for omega_z - idx = idx + 6 + if (m%BodyList(m%FreeBodyIs(l))%typeNum == 2) then ! Coupled pinned body + ! corresponds to state indices: (m%BodyStateIs1(l):m%BodyStateIs1(l)+5) + p%dx(idx+1:idx+3) = 0.1 ! body rotational velocity [rad/s] + InitOut%LinNames_x(idx+1) = 'Body '//trim(num2lstr(m%FreeBodyIs(l)))//' omega_x, rad/s' + InitOut%LinNames_x(idx+2) = 'Body '//trim(num2lstr(m%FreeBodyIs(l)))//' omega_y, rad/s' + InitOut%LinNames_x(idx+3) = 'Body '//trim(num2lstr(m%FreeBodyIs(l)))//' omega_z, rad/s' + p%dxIdx_map2_xStateIdx(idx+1) = m%BodyStateIs1(l)+0 ! x%state index for omega_x + p%dxIdx_map2_xStateIdx(idx+2) = m%BodyStateIs1(l)+1 ! x%state index for omega_y + p%dxIdx_map2_xStateIdx(idx+3) = m%BodyStateIs1(l)+2 ! x%state index for omega_z + idx = idx + 3 + else !Free body + ! corresponds to state indices: (m%BodyStateIs1(l):m%BodyStateIs1(l)+5) + p%dx(idx+1:idx+3) = 0.1 ! body translational velocity [m/s] + p%dx(idx+4:idx+6) = 0.1 ! body rotational velocity [rad/s] + InitOut%LinNames_x(idx+1) = 'Body '//trim(num2lstr(m%FreeBodyIs(l)))//' Vx, m/s' + InitOut%LinNames_x(idx+2) = 'Body '//trim(num2lstr(m%FreeBodyIs(l)))//' Vy, m/s' + InitOut%LinNames_x(idx+3) = 'Body '//trim(num2lstr(m%FreeBodyIs(l)))//' Vz, m/s' + InitOut%LinNames_x(idx+4) = 'Body '//trim(num2lstr(m%FreeBodyIs(l)))//' omega_x, rad/s' + InitOut%LinNames_x(idx+5) = 'Body '//trim(num2lstr(m%FreeBodyIs(l)))//' omega_y, rad/s' + InitOut%LinNames_x(idx+6) = 'Body '//trim(num2lstr(m%FreeBodyIs(l)))//' omega_z, rad/s' + p%dxIdx_map2_xStateIdx(idx+1) = m%BodyStateIs1(l)+0 ! x%state index for Rx + p%dxIdx_map2_xStateIdx(idx+2) = m%BodyStateIs1(l)+1 ! x%state index for Ry + p%dxIdx_map2_xStateIdx(idx+3) = m%BodyStateIs1(l)+2 ! x%state index for Rz + p%dxIdx_map2_xStateIdx(idx+4) = m%BodyStateIs1(l)+3 ! x%state index for omega_x + p%dxIdx_map2_xStateIdx(idx+5) = m%BodyStateIs1(l)+4 ! x%state index for omega_y + p%dxIdx_map2_xStateIdx(idx+6) = m%BodyStateIs1(l)+5 ! x%state index for omega_z + idx = idx + 6 + endif END DO ! Rods DO l = 1,p%nFreeRods ! Rod m%RodList(m%FreeRodIs(l)) - if (m%RodList(m%FreeRodIs(l))%typeNum == 1) then ! pinned rod + if (abs(m%RodList(m%FreeRodIs(l))%typeNum) == 1) then ! pinned rod ! corresponds to state indices: (m%RodStateIs1(l):m%RodStateIs1(l)+2) p%dx(idx+1:idx+3) = 0.1 ! body rotational velocity [rad/s] InitOut%LinNames_x(idx+1) = 'Rod '//trim(num2lstr(m%FreeRodIs(l)))//' omega_x, rad/s' @@ -4085,7 +4682,7 @@ SUBROUTINE MD_Perturb_u( p, n, perturb_sign, u, du ) CASE ( 1) u%CoupledKinematics(1)%TranslationDisp( fieldIndx,node) = u%CoupledKinematics(1)%TranslationDisp( fieldIndx,node) + du * perturb_sign CASE ( 2) - CALL PerturbOrientationMatrix( u%CoupledKinematics(1)%Orientation(:,:,node), du * perturb_sign, fieldIndx, UseSmlAngle=.true. ) + CALL PerturbOrientationMatrix( u%CoupledKinematics(1)%Orientation(:,:,node), du * perturb_sign, fieldIndx, UseSmlAngle=.false. ) CASE ( 3) u%CoupledKinematics(1)%TranslationVel( fieldIndx,node) = u%CoupledKinematics(1)%TranslationVel( fieldIndx,node) + du * perturb_sign CASE ( 4) @@ -4129,9 +4726,10 @@ SUBROUTINE MD_Perturb_x( p, i, perturb_sign, x, dx ) INTEGER( IntKi ) , INTENT(IN ) :: perturb_sign !< +1 or -1 (value to multiply perturbation by; positive or negative difference) TYPE(MD_ContinuousStateType), INTENT(INOUT) :: x !< perturbed MD states REAL( R8Ki ) , INTENT( OUT) :: dx !< amount that specific state was perturbed - - dx=p%dx(i) - x%states(i) = x%states(i) + dx * perturb_sign + integer(IntKi) :: j + dx = p%dx(i) + j = p%dxIdx_map2_xStateIdx(i) + x%states(j) = x%states(j) + dx * perturb_sign END SUBROUTINE MD_Perturb_x !---------------------------------------------------------------------------------------------------------------------------------- !> This routine uses values of two output types to compute an array of differences. diff --git a/modules/moordyn/src/MoorDyn_Body.f90 b/modules/moordyn/src/MoorDyn_Body.f90 index 879ac52ec3..dbbfee898a 100644 --- a/modules/moordyn/src/MoorDyn_Body.f90 +++ b/modules/moordyn/src/MoorDyn_Body.f90 @@ -60,10 +60,13 @@ SUBROUTINE Body_Setup( Body, tempArray, p, ErrStat, ErrMsg) CHARACTER(*), INTENT(INOUT ) :: ErrMsg ! Error message if ErrStat /= ErrID_None INTEGER(4) :: J ! Generic index - INTEGER(4) :: K ! Generic index - INTEGER(IntKi) :: N +! INTEGER(4) :: K ! Generic index +! INTEGER(IntKi) :: N - REAL(DbKi) :: Mtemp(6,6) + REAL(DbKi) :: Mtemp(6,6) = 0.0_DbKi ! temporary mass matrix + + ErrStat = ErrID_None + ErrMsg = "" ! set initial velocity to zero Body%v6 = 0.0_DbKi @@ -152,12 +155,25 @@ SUBROUTINE Body_Initialize(Body, states, m) INTEGER(IntKi) :: l ! index of segments or nodes along line REAL(DbKi) :: dummyStates(12) ! dummy vector to mimic states when initializing a rigidly attached rod - - ! assign initial body kinematics to state vector - states(7:12) = Body%r6 - states(1:6 ) = Body%v6 - + IF (wordy > 0) print *, "initializing Body ", Body%idNum + + ! the r6 and v6 vectors should have already been set + ! r and rd of ends have already been set by setup function or by parent object <<<<< right? <<<<< + + if (Body%typeNum == 0) then ! free body type + + ! assign initial body kinematics to state vector + states(1:6 ) = Body%v6 ! zero velocities for initialization (set to 0 in Body_Setup) + states(7:12) = Body%r6 + + else if (Body%typeNum ==2 ) then ! pinned rod type (coupled or attached to something previously via setPinKin) + + states(1:3) = Body%v6(4:6) ! zero velocities for initialization (set to 0 in Body_Setup) + states(4:6) = Body%r6(4:6) ! body orentations + + end if + ! set positions of any dependent points and rods now (before they are initialized) CALL Body_SetDependentKin(Body, 0.0_DbKi, m) @@ -200,41 +216,39 @@ END SUBROUTINE Body_InitializeUnfree ! set kinematics for Bodies if they are coupled (or ground) !-------------------------------------------------------------- - SUBROUTINE Body_SetKinematics(Body, r_in, v_in, a_in, t, m) + SUBROUTINE Body_SetKinematics(Body, r6_in, v6_in, a6_in, t, m) Type(MD_Body), INTENT(INOUT) :: Body ! the Body object - Real(DbKi), INTENT(IN ) :: r_in(6) ! 6-DOF position - Real(DbKi), INTENT(IN ) :: v_in(6) ! 6-DOF velocity - Real(DbKi), INTENT(IN ) :: a_in(6) ! 6-DOF acceleration (only used for coupled rods) + Real(DbKi), INTENT(IN ) :: r6_in(6) ! 6-DOF position + Real(DbKi), INTENT(IN ) :: v6_in(6) ! 6-DOF velocity + Real(DbKi), INTENT(IN ) :: a6_in(6) ! 6-DOF acceleration Real(DbKi), INTENT(IN ) :: t ! instantaneous time TYPE(MD_MiscVarType), INTENT(INOUT) :: m ! passing along all mooring objects (for simplicity, since Bodies deal with Rods and Points) - INTEGER(IntKi) :: l +! INTEGER(IntKi) :: l ! store current time Body%time = t - ! if (abs(Body%typeNum) == 2) then ! body coupled in 6 DOF, or ground - Body%r6 = r_in - Body%v6 = v_in - Body%a6 = a_in + if (Body%typeNum == 2) then ! body pinned to coupling point + + ! set Body translational kinematics based on BCs (linear model for now) + Body%r6(1:3) = r6_in(1:3) + Body%v6(1:3) = v6_in(1:3) + Body%a6(1:3) = a6_in(1:3) + + ! Body rotations are left alone and will be handled, along with passing kinematics to dependent objects, by separate call to setState + + else ! body rigidly coupled to coupling point + Body%r6 = r6_in + Body%v6 = v6_in + Body%a6 = a6_in ! since this body has no states and all DOFs have been set, pass its kinematics to dependent attachments CALL Body_SetDependentKin(Body, t, m) - - ! else if (abs(Body%typeNum) == 1) then ! body pinned at reference point - ! - ! ! set Body *end A only* kinematics based on BCs (linear model for now) - ! Body%r6(1:3) = r_in(1:3) - ! Body%v6(1:3) = v_in(1:3) - ! - ! ! Body is pinned so only ref point posiiton is specified, rotations are left alone and will be - ! ! handled, along with passing kinematics to attached objects, by separate call to setState - ! - ! else - ! print *, "Error: Body_SetKinematics called for a free Body." ! <<< - ! end if + + end if END SUBROUTINE Body_SetKinematics !-------------------------------------------------------------- @@ -248,20 +262,32 @@ SUBROUTINE Body_SetState(Body, X, t, m) Real(DbKi), INTENT(IN ) :: t ! instantaneous time TYPE(MD_MiscVarType), INTENT(INOUT) :: m ! passing along all mooring objects - INTEGER(IntKi) :: l ! index of segments or nodes along line - INTEGER(IntKi) :: J ! index +! INTEGER(IntKi) :: l ! index of segments or nodes along line +! INTEGER(IntKi) :: J ! index ! store current time Body%time = t + if (Body%typeNum == 0) then ! free Body type - - Body%r6 = X(7:12) ! get positions - Body%v6 = X(1:6) ! get velocities - + Body%r6 = X(7:12) ! get positions + Body%v6 = X(1:6) ! get velocities + + ! set positions of any dependent points and rods + CALL Body_SetDependentKin(Body, t, m) - ! set positions of any dependent points and rods - CALL Body_SetDependentKin(Body, t, m) + else if (Body%typeNum == 2) then + + Body%r6(4:6) = X(4:6) ! get positions + Body%v6(4:6) = X(1:3) ! get velocities + + + ! set positions of any dependent points and rods + CALL Body_SetDependentKin(Body, t, m) + + else + Call WrScr("Error: Body::setState called for a non-free Body type in MoorDyn") ! <<< + end if END SUBROUTINE Body_SetState !-------------------------------------------------------------- @@ -333,6 +359,8 @@ SUBROUTINE Body_GetStateDeriv(Body, Xd, m, p) INTEGER(IntKi) :: J ! index + Real(DbKi) :: Fnet (6) ! net force and moment about reference point + Real(DbKi) :: acc(6) ! 6DOF acceleration vector Real(DbKi) :: y_temp (6) ! temporary vector for LU decomposition @@ -346,20 +374,40 @@ SUBROUTINE Body_GetStateDeriv(Body, Xd, m, p) CALL Body_DoRHS(Body, m, p) - ! solve for accelerations in [M]{a}={f} using LU decomposition - CALL LUsolve(6, Body%M, LU_temp, Body%F6net, y_temp, acc) + IF (Body%typeNum == 0) THEN ! Free body + + ! solve for accelerations in [M]{a}={f} using LU decomposition + CALL LUsolve(6, Body%M, LU_temp, Body%F6net, y_temp, acc) + + ! fill in state derivatives + Xd(7:12) = Body%v6 ! dxdt = V (velocities) + Xd(1:6) = acc ! dVdt = a (accelerations) + + ! store accelerations in case they're useful as output + Body%a6 = acc + + ELSE ! Pinned Body, 3 states (rotational only) - ! fill in state derivatives - Xd(7:12) = Body%v6 ! dxdt = V (velocities) - Xd(1:6) = acc ! dVdt = a (accelerations) + ! Account for moment response due to inertial coupling + Fnet = Body%F6net + Fnet(4:6) = Fnet(4:6) - MATMUL(Body%M(4:6,1:3), Body%a6(1:3)) - ! store accelerations in case they're useful as output - Body%a6 = acc + ! solve for accelerations in [M]{a}={f} using LU decomposition + CALL LUsolve(3, Body%M(4:6,4:6), LU_temp(4:6,4:6), Fnet(4:6), y_temp(4:6), acc(4:6)) + + ! fill in state derivatives + Xd(4:6) = Body%v6(4:6) ! dxdt = V (velocities) + Xd(1:3) = acc(4:6) ! dVdt = a (accelerations) + + ! store accelerations in case they're useful as output + Body%a6(4:6) = acc(4:6) + + ENDIF ! check for NaNs (should check all state derivatives, not just first 6) DO J = 1, 6 IF (Is_NaN(Xd(J))) THEN - CALL WrScr("NaN detected at time "//trim(Num2LStr(Body%time))//" in Body "//trim(Int2LStr(Body%IdNum))//"in MoorDyn,") + CALL WrScr("NaN detected at time "//trim(Num2LStr(Body%time))//" in Body "//trim(Int2LStr(Body%IdNum))//" in MoorDyn,") IF (wordy > 0) print *, "state derivatives:" IF (wordy > 0) print *, Xd EXIT @@ -380,17 +428,21 @@ SUBROUTINE Body_DoRHS(Body, m, p) !TYPE(MD_MiscVarType), INTENT(INOUT) :: m ! misc/optimization variables INTEGER(IntKi) :: l ! index of attached lines - INTEGER(IntKi) :: I ! index - INTEGER(IntKi) :: J ! index - INTEGER(IntKi) :: K ! index Real(DbKi) :: Fgrav(3) ! body weight force Real(DbKi) :: body_rCGrotated(3) ! instantaneous vector from body ref point to CG Real(DbKi) :: U(3) ! water velocity - zero for now - Real(DbKi) :: Ud(3) ! water acceleration- zero for now +! Real(DbKi) :: Ud(3) ! water acceleration- zero for now Real(DbKi) :: vi(6) ! relative water velocity (last 3 terms are rotatonal and will be set to zero Real(DbKi) :: F6_i(6) ! net force and moments from an attached object Real(DbKi) :: M6_i(6,6) ! mass and inertia from an attached object + Real(DbKi) :: cda(6) ! body drag coefficients + Real(DbKi) :: cda_t(3,3) = 0.0 ! matrix with translational drag coefficients as diagonals + Real(DbKi) :: cda_r(3,3) = 0.0 ! matrix with rotational drag coefficients as diagonals + Real(DbKi) :: w(3) ! body angular velocity vector + Real(DbKi) :: Fcentripetal(3) ! centripetal force + Real(DbKi) :: Mcentripetal(3) ! centripetal moment + ! Initialize variables U = 0.0_DbKi ! Set to zero for now @@ -408,6 +460,13 @@ SUBROUTINE Body_DoRHS(Body, m, p) body_rCGrotated = MATMUL(Body%OrMat, Body%rCG) ! rotateVector3(body_rCG, OrMat, body_rCGrotated); ! relative vector to body CG in inertial orientation CALL translateForce3to6DOF(body_rCGrotated, Fgrav, Body%F6net) ! gravity forces and moments about body ref point given CG location + ! Centripetal force and moment due to COM not being at body origin plus gyroscopic moment + w = Body%v6(4:6) + Fcentripetal = - MATMUL(Body%M(1:3,1:3), CROSS_PRODUCT(w, CROSS_PRODUCT(w, body_rCGrotated))) + Mcentripetal = - CROSS_PRODUCT(w, MATMUL(Body%M(4:6,4:6), w)) + + Body%F6net(1:3) = Body%F6net(1:3) + Fcentripetal + Body%F6net(4:6) = Body%F6net(4:6) + Mcentripetal ! --------------------------------- apply wave kinematics ------------------------------------ !env->waves->getU(r6, t, U); ! call generic function to get water velocities <<<<<<<<< all needs updating @@ -420,8 +479,18 @@ SUBROUTINE Body_DoRHS(Body, m, p) vi(1:3) = U - Body%v6(1:3) ! relative flow velocity over body ref point vi(4:6) = - Body%v6(4:6) ! for rotation, this is just the negative of the body's rotation for now (not allowing flow rotation) - Body%F6net = Body%F6net + 0.5*p%rhoW * vi * abs(vi) * Body%bodyCdA - ! <<< NOTE, for body this should be fixed to account for orientation!! <<< what about drag in rotational DOFs??? <<<<<<<<<<<<<< + cda_t(1,1) = Body%bodyCdA(1) + cda_t(2,2) = Body%bodyCdA(2) + cda_t(3,3) = Body%bodyCdA(3) + cda_r(1,1) = Body%bodyCdA(4) + cda_r(2,2) = Body%bodyCdA(5) + cda_r(3,3) = Body%bodyCdA(6) + + cda(1:3) = MATMUL( MATMUL( MATMUL(Body%OrMat,cda_t) , transpose(Body%OrMat) ) , vi(1:3) * norm2(vi(1:3)) ); + cda(4:6) = MATMUL( MATMUL( MATMUL(Body%OrMat,cda_r) , transpose(Body%OrMat) ) , vi(4:6) * norm2(vi(4:6)) ); + Body%F6net = Body%F6net + 0.5*p%rhoW*cda + + @@ -429,10 +498,10 @@ SUBROUTINE Body_DoRHS(Body, m, p) do l = 1,Body%nAttachedC ! get net force and mass from Point on body ref point (global orientation) - CALL Point_GetNetForceAndMass( m%PointList(Body%attachedC(l)), Body%r6(1:3), F6_i, M6_i, m, p) + CALL Point_GetNetForceAndMass( m%PointList(Body%attachedC(l)), Body%r6(1:3), Body%v6(4:6), F6_i, M6_i, m, p) if (ABS(F6_i(5)) > 1.0E12) then - print *, "Warning: extreme pitch moment from body-attached Point ", l + Call WrScr( "Warning: extreme pitch moment from body-attached Point "//trim(num2lstr(l))) end if ! sum quantitites @@ -444,10 +513,10 @@ SUBROUTINE Body_DoRHS(Body, m, p) do l=1,Body%nAttachedR ! get net force and mass from Rod on body ref point (global orientation) - CALL Rod_GetNetForceAndMass(m%RodList(Body%attachedR(l)), Body%r6(1:3), F6_i, M6_i, m, p) + CALL Rod_GetNetForceAndMass(m%RodList(Body%attachedR(l)), Body%r6(1:3), Body%v6(4:6), F6_i, M6_i, m, p) if (ABS(F6_i(5)) > 1.0E12) then - print *, "Warning: extreme pitch moment from body-attached Rod ", l + Call WrScr("Warning: extreme pitch moment from body-attached Rod "//trim(num2lstr(l))) end if ! sum quantitites @@ -462,8 +531,8 @@ END SUBROUTINE Body_DoRHS ! calculate the aggregate 3/6DOF rigid-body loads of a coupled rod including inertial loads !-------------------------------------------------------------- - SUBROUTINE Body_GetCoupledForce(Body, Fnet_out, m, p) - + SUBROUTINE Body_GetCoupledForce(t, Body, Fnet_out, m, p) + real(R8Ki), intent(in ) :: t ! time - for ramping inertial loading Type(MD_Body), INTENT(INOUT) :: Body ! the Body object Real(DbKi), INTENT( OUT) :: Fnet_out(6) ! force and moment vector TYPE(MD_MiscVarType), INTENT(INOUT) :: m ! passing along all mooring objects @@ -477,11 +546,37 @@ SUBROUTINE Body_GetCoupledForce(Body, Fnet_out, m, p) ! add inertial loads as appropriate if (Body%typeNum == -1) then - F6_iner = 0.0_DbKi !-MATMUL(Body%M, Body%a6) <<<<<<<< why does including F6_iner cause instability??? - Fnet_out = Body%F6net + F6_iner ! add inertial loads + if (p%inertialF == 1) then ! include inertial components + F6_iner = -MATMUL(Body%M, Body%a6) ! unstable in OpenFAST v4 and below becasue of loose coupling with ED and SD. Transients in acceleration can cause issues + elseif (p%inertialF == 2) then ! include inertial components, but ramp up load + F6_iner = -MATMUL(Body%M, Body%a6) + if (t < p%inertialF_rampT) F6_iner = F6_iner * t / p%inertialF_rampT + else + ! When OpenFAST v5 is released w/ tight coupling, remove this hack and just use the inertial term above + F6_iner = 0.0 + endif + + Body%F6net = Body%F6net + F6_iner ! add inertial loads + Fnet_out = Body%F6net + + else if (Body%typeNum == 2) then ! pinned coupled body + + if (p%inertialF == 1) then ! include inertial components + ! inertial loads ... from input translational ... and solved rotational ... acceleration + F6_iner(1:3) = -MATMUL(Body%M(1:3,1:3), Body%a6(1:3)) - MATMUL(Body%M(1:3,4:6), Body%a6(4:6)) + elseif (p%inertialF == 2) then + F6_iner(1:3) = -MATMUL(Body%M(1:3,1:3), Body%a6(1:3)) - MATMUL(Body%M(1:3,4:6), Body%a6(4:6)) + if (t < p%inertialF_rampT) F6_iner = F6_iner * t / p%inertialF_rampT + else + F6_iner(1:3) = 0.0 + endif + Body%F6net(1:3) = Body%F6net(1:3) + F6_iner(1:3) ! add translational inertial loads + Body%F6net(4:6) = 0.0_DbKi + Fnet_out = Body%F6net + else - print *, "ERROR, Body_GetCoupledForce called for wrong (non-coupled) body type in MoorDyn!" + Call WrScr( "ERROR, Body_GetCoupledForce called for wrong (non-coupled) body type in MoorDyn!") end if END SUBROUTINE Body_GetCoupledForce @@ -505,7 +600,7 @@ SUBROUTINE Body_AddPoint(Body, pointID, coords) Body%AttachedC(Body%nAttachedC) = pointID Body%rPointRel(:,Body%nAttachedC) = coords ! store relative position of point on body ELSE - Print*, "too many Points attached to Body ", Body%IdNum, " in MoorDyn!" + call WrScr("too many Points attached to Body "//trim(num2lstr(Body%IdNum))//" in MoorDyn!") END IF END SUBROUTINE Body_AddPoint @@ -536,7 +631,7 @@ SUBROUTINE Body_AddRod(Body, rodID, coords) Body%r6RodRel(4:6, Body%nAttachedR) = tempUnitVec ELSE - Print*, "too many rods attached to Body ", Body%IdNum, " in MoorDyn" + call WrScr("too many rods attached to Body "//trim(num2lstr(Body%IdNum))//" in MoorDyn") END IF END SUBROUTINE Body_AddRod diff --git a/modules/moordyn/src/MoorDyn_C_Binding.f90 b/modules/moordyn/src/MoorDyn_C_Binding.f90 index 28c8e0bcac..c4220322da 100644 --- a/modules/moordyn/src/MoorDyn_C_Binding.f90 +++ b/modules/moordyn/src/MoorDyn_C_Binding.f90 @@ -397,7 +397,7 @@ SUBROUTINE MD_C_UpdateStates(Time_C, TimeNext_C, POSITIONS_C, VELOCITIES_C, ACCE END DO ! Transfer motions to input meshes - CALL Set_MotionMesh( ErrStat2, ErrMsg2 ); IF (Failed()) RETURN + CALL Set_MotionMesh() CALL MD_SetInputMotion( u(INPUT_PRED), ErrStat2, ErrMsg2 ); IF (Failed()) RETURN ! Set copy the current state over to the predicted state for sending to UpdateStates @@ -484,7 +484,7 @@ SUBROUTINE MD_C_CalcOutput(Time_C, POSITIONS_C, VELOCITIES_C, ACCELERATIONS_C, F END DO ! Transfer motions to input meshes - CALL Set_MotionMesh(ErrStat2, ErrMsg2 ); if (Failed()) return; + CALL Set_MotionMesh() ! transfer input motion mesh to u(1) meshes CALL MD_SetInputMotion( u(1), ErrStat2, ErrMsg2 ); if (Failed()) return; @@ -624,7 +624,8 @@ SUBROUTINE SetMotionLoadsInterfaceMeshes(ErrStat,ErrMsg) ! initial position and orientation of node InitPos = tmpPositions(1:3,1) theta = REAL(tmpPositions(4:6,1),DbKi) ! convert ReKi to DbKi to avoid roundoff - CALL SmllRotTrans( 'InputRotation', theta(1), theta(2), theta(3), Orient, 'Orient', ErrStat, ErrMsg ) + ! CALL SmllRotTrans( 'InputRotation', theta(1), theta(2), theta(3), Orient, 'Orient', ErrStat, ErrMsg ) + Orient = EulerConstructZYX((/theta(1), theta(2), theta(3)/)) CALL MeshPositionNode( MD_MotionMesh , & 1 , & InitPos , & ! position @@ -678,14 +679,13 @@ END SUBROUTINE SetMotionLoadsInterfaceMeshes !--------------------------------------------------------------------------------------------------------------- !> This routine is operating on module level data, hence few inputs -SUBROUTINE Set_MotionMesh(ErrStat, ErrMsg) +SUBROUTINE Set_MotionMesh() REAL(R8Ki) :: theta(3) REAL(R8Ki) :: Orient(3,3) - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(ErrMsgLen), INTENT( OUT) :: ErrMsg ! Set mesh corresponding to input motions theta = REAL(tmpPositions(4:6,1),DbKi) ! convert ReKi to DbKi to avoid roundoff - CALL SmllRotTrans( 'InputRotation', theta(1), theta(2), theta(3), Orient, 'Orient', ErrStat, ErrMsg ) + ! CALL SmllRotTrans( 'InputRotation', theta(1), theta(2), theta(3), Orient, 'Orient', ErrStat, ErrMsg ) + Orient = EulerConstructZYX((/theta(1), theta(2), theta(3)/)) MD_MotionMesh%TranslationDisp(1:3,1) = tmpPositions(1:3,1) - MD_MotionMesh%Position(1:3,1) ! relative displacement only MD_MotionMesh%Orientation(1:3,1:3,1) = Orient MD_MotionMesh%TranslationVel( 1:3,1) = tmpVelocities(1:3,1) diff --git a/modules/moordyn/src/MoorDyn_Driver.f90 b/modules/moordyn/src/MoorDyn_Driver.f90 index 83e2e5e65b..1e7e5950f7 100644 --- a/modules/moordyn/src/MoorDyn_Driver.f90 +++ b/modules/moordyn/src/MoorDyn_Driver.f90 @@ -28,7 +28,7 @@ PROGRAM MoorDyn_Driver IMPLICIT NONE TYPE MD_Drvr_InitInput - LOGICAL :: Echo + ! LOGICAL :: Echo REAL(DbKi) :: Gravity REAL(DbKi) :: rhoW REAL(DbKi) :: WtrDepth @@ -57,7 +57,6 @@ PROGRAM MoorDyn_Driver TYPE(MD_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 - TYPE (MD_InitInputType) :: MD_InitInp TYPE (MD_ParameterType) :: MD_p @@ -91,7 +90,7 @@ PROGRAM MoorDyn_Driver INTEGER(IntKi) :: nt ! number of coupling time steps to use in simulation REAL(DbKi) :: t ! current time (s) - REAL(DbKi) :: tMax ! sim end time (s) + REAL(DbKi) :: TMax ! sim end time (s) REAL(DbKi) :: dtC ! fixed/constant global time step REAL(DbKi) :: frac ! fraction used in interpolation @@ -102,7 +101,7 @@ PROGRAM MoorDyn_Driver Integer(IntKi) :: iTurb Integer(IntKi) :: nTurbines Integer(IntKi) :: iIn - integer(intKi) :: Un + !integer(intKi) :: Un ! data for SimStatus/RunTimes: REAL(DbKi) :: PrevSimTime !< Previous time message was written to screen (s > 0) @@ -115,13 +114,13 @@ PROGRAM MoorDyn_Driver CHARACTER(20) :: FlagArg ! flag argument from command line CHARACTER(200) :: git_commit ! String containing the current git commit hash - TYPE(ProgDesc), PARAMETER :: version = ProgDesc( 'MoorDyn Driver', '', '' ) + TYPE(ProgDesc), PARAMETER :: version = ProgDesc( 'MoorDyn Driver', '', '2024-01-18' ) ErrMsg = "" ErrStat = ErrID_None - UnEcho=-1 + UnEcho=-1 ! set to -1 as echo is no longer used by MD UnIn =-1 ! TODO: Sort out error handling (two sets of flags currently used) @@ -132,8 +131,8 @@ PROGRAM MoorDyn_Driver CALL CheckArgs( MD_InitInp%FileName, Arg2=drvrInitInp%InputsFile, Flag=FlagArg ) IF ( LEN( TRIM(FlagArg) ) > 0 ) CALL NormStop() - ! Display the copyright notice - CALL DispCopyrightLicense( version%Name, 'Copyright (C) 2021 NREL, 2019 Matt Hall' ) + ! ! Display the copyright notice + ! CALL DispCopyrightLicense( version%Name, ' Copyright (C) 2019 Matt Hall' ) ! Obtain OpenFAST git commit hash git_commit = QueryGitVersion() ! Tell our users what they're running @@ -145,7 +144,7 @@ PROGRAM MoorDyn_Driver CALL CPU_TIME ( ProgStrtCPU ) ! Initial time (this zeros the start time when used as a MATLAB function) - CALL WrScr( ' MD Driver updated 2022-01-12') + CALL WrScr('MD Driver last updated '//TRIM( version%Date )) ! Parse the driver input file and run the simulation based on that file CALL get_command_argument(1, drvrFilename) @@ -163,7 +162,7 @@ PROGRAM MoorDyn_Driver MD_InitInp%RootName = drvrInitInp%OutRootName MD_InitInp%UsePrimaryInputFile = .TRUE. !MD_InitInp%PassedPrimaryInputData = - MD_InitInp%Echo = drvrInitInp%Echo + ! MD_InitInp%Echo = drvrInitInp%Echo !MD_InitInp%OutList = <<<< never used? MD_InitInp%Linearize = .FALSE. @@ -176,7 +175,7 @@ PROGRAM MoorDyn_Driver if (drvrInitInp%FarmSize > 0) then ! Check if this MoorDyn instance is being run from FAST.Farm (indicated by FarmSize > 0) nTurbines = drvrInitInp%FarmSize - else ! FarmSize==0 indicates normal, FAST module mode + else ! FarmSize==0 indicates normal, FAST module mode nTurbines = 1 ! if a regular FAST module mode, we treat it like a nTurbine=1 farm case end if @@ -214,29 +213,29 @@ PROGRAM MoorDyn_Driver ! -------------------------------- ----------------------------------- ! fill in the hydrodynamics data - ALLOCATE( MD_InitInp%WaveVel (2,200,3)) - ALLOCATE( MD_InitInp%WaveAcc (2,200,3)) - ALLOCATE( MD_InitInp%WavePDyn(2,200) ) - ALLOCATE( MD_InitInp%WaveElev(2,200) ) - ALLOCATE( MD_InitInp%WaveTime(2) ) - MD_InitInp%WaveVel = 0.0_ReKi - MD_InitInp%WaveAcc = 0.0_ReKi - MD_InitInp%WavePDyn = 0.0_ReKi - MD_InitInp%WaveElev = 0.0_ReKi - MD_InitInp%WaveTime = 0.0_ReKi - DO I = 1,SIZE(MD_InitInp%WaveTime) - MD_InitInp%WaveTime(I) = 600.0*I - END DO + !ALLOCATE( MD_InitInp%WaveVel (2,200,3)) + !ALLOCATE( MD_InitInp%WaveAcc (2,200,3)) + !ALLOCATE( MD_InitInp%WavePDyn(2,200) ) + !ALLOCATE( MD_InitInp%WaveElev(2,200) ) + !ALLOCATE( MD_InitInp%WaveTime(2) ) + !MD_InitInp%WaveVel = 0.0_ReKi + !MD_InitInp%WaveAcc = 0.0_ReKi + !MD_InitInp%WavePDyn = 0.0_ReKi + !MD_InitInp%WaveElev = 0.0_ReKi + !MD_InitInp%WaveTime = 0.0_ReKi + !DO I = 1,SIZE(MD_InitInp%WaveTime) + ! MD_InitInp%WaveTime(I) = 600.0*I + !END DO ! open driver output file >>> not yet used <<< !CALL GetNewUnit( Un ) !OPEN(Unit=Un,FILE='MD.out',STATUS='UNKNOWN') ! call the initialization routine - CALL MD_Init( MD_InitInp, MD_u(1), MD_p, MD_x , MD_xd, MD_xc, MD_xo, MD_y, MD_m, dtC, MD_InitOut, ErrStat, ErrMsg2 ); call AbortIfFailed() + CALL MD_Init( MD_InitInp, MD_u(1), MD_p, MD_x , MD_xd, MD_xc, MD_xo, MD_y, MD_m, dtC, MD_InitOut, ErrStat2, ErrMsg2 ); call AbortIfFailed() - CALL MD_DestroyInitInput ( MD_InitInp , ErrStat, ErrMsg ); call AbortIfFailed() - CALL MD_DestroyInitOutput ( MD_InitOut , ErrStat, ErrMsg ); call AbortIfFailed() + CALL MD_DestroyInitInput ( MD_InitInp , ErrStat2, ErrMsg2 ); call AbortIfFailed() + CALL MD_DestroyInitOutput ( MD_InitOut , ErrStat2, ErrMsg2 ); call AbortIfFailed() CALL DispNVD( MD_InitOut%Ver ) @@ -259,8 +258,8 @@ PROGRAM MoorDyn_Driver if (drvrInitInp%InputsMod == 1 ) then if ( LEN( TRIM(drvrInitInp%InputsFile) ) < 1 ) then - ErrStat = ErrID_Fatal - ErrMsg = ' ERROR: MoorDyn Driver InputFile cannot be empty if InputsMode is 1.' + ErrStat2 = ErrID_Fatal + ErrMsg2 = ' ERROR: MoorDyn Driver InputFile cannot be empty if InputsMode is 1.' CALL AbortIfFailed() end if @@ -301,14 +300,14 @@ PROGRAM MoorDyn_Driver ! specify stepping details - nt = tMax/dtC - 1 ! number of coupling time steps + nt = TMax/dtC - 1 ! number of coupling time steps ! allocate space for processed motion array ALLOCATE ( r_in(nt, ncIn), r_in2(nt, ncIn), rd_in(nt, ncIn), rd_in2(nt, ncIn), rdd_in(nt, ncIn), rdd_in2(nt, ncIn), STAT=ErrStat2) IF ( ErrStat2 /= ErrID_None ) THEN ErrStat2 = ErrID_Fatal - ErrMsg = ' Error allocating space for r_in or rd_in array.' + ErrMsg2 = ' Error allocating space for r_in or rd_in array.' call AbortIfFailed() END IF @@ -448,11 +447,11 @@ PROGRAM MoorDyn_Driver else - nt = tMax/dtC - 1 ! number of coupling time steps + nt = TMax/dtC - 1 ! number of coupling time steps end if CALL WrScr(" ") - call WrScr("Tmax - "//trim(Num2LStr(tMax))//" and nt="//trim(Num2LStr(nt))) + call WrScr("Tmax - "//trim(Num2LStr(TMax))//" and nt="//trim(Num2LStr(nt))) CALL WrScr(" ") @@ -491,9 +490,10 @@ PROGRAM MoorDyn_Driver i = 1 ! read first timestep data K = 1 ! the index of the coupling points in the input mesh CoupledKinematics J = 1 ! the starting index of the relevant DOFs in the input array + ! any coupled bodies (type -1) DO l = 1,MD_p%nCpldBodies(iTurb) - MD_u(1)%CoupledKinematics(iTurb)%TranslationDisp(:,K) = r_in(i, J:J+2) - MD_u(1)%CoupledKinematics(iTurb)%Position(:,K) - MD_p%TurbineRefPos(:,iTurb) + MD_u(1)%CoupledKinematics(iTurb)%TranslationDisp(:,K) = r_in(i, J:J+2) - MD_u(1)%CoupledKinematics(iTurb)%Position(:,K) - MD_p%TurbineRefPos(:,iTurb) MD_u(1)%CoupledKinematics(iTurb)%Orientation( :,:,K) = EulerConstruct( r_in(i, J+3:J+5) ) ! full Euler angle approach MD_u(1)%CoupledKinematics(iTurb)%TranslationVel( :,K) = rd_in(i, J:J+2) MD_u(1)%CoupledKinematics(iTurb)%RotationVel( :,K) = rd_in(i, J+3:J+5) @@ -506,8 +506,7 @@ PROGRAM MoorDyn_Driver ! any coupled rods (type -1 or -2) >>> need to make rotations ignored if it's a pinned rod <<< DO l = 1,MD_p%nCpldRods(iTurb) - - MD_u(1)%CoupledKinematics(iTurb)%TranslationDisp(:,K) = r_in(i, J:J+2) - MD_u(1)%CoupledKinematics(iTurb)%Position(:,K) - MD_p%TurbineRefPos(:,iTurb) + MD_u(1)%CoupledKinematics(iTurb)%TranslationDisp(:,K) = r_in(i, J:J+2) - MD_u(1)%CoupledKinematics(iTurb)%Position(:,K) - MD_p%TurbineRefPos(:,iTurb) MD_u(1)%CoupledKinematics(iTurb)%Orientation( :,:,K) = EulerConstruct( r_in(i, J+3:J+5) ) MD_u(1)%CoupledKinematics(iTurb)%TranslationVel( :,K) = rd_in(i, J:J+2) MD_u(1)%CoupledKinematics(iTurb)%RotationVel( :,K) = rd_in(i, J+3:J+5) @@ -520,8 +519,7 @@ PROGRAM MoorDyn_Driver ! any coupled points (type -1) DO l = 1, MD_p%nCpldPoints(iTurb) - - MD_u(1)%CoupledKinematics(iTurb)%TranslationDisp(:,K) = r_in(i, J:J+2) - MD_u(1)%CoupledKinematics(iTurb)%Position(:,K) - MD_p%TurbineRefPos(:,iTurb) + MD_u(1)%CoupledKinematics(iTurb)%TranslationDisp(:,K) = r_in(i, J:J+2) - MD_u(1)%CoupledKinematics(iTurb)%Position(:,K) - MD_p%TurbineRefPos(:,iTurb) MD_u(1)%CoupledKinematics(iTurb)%TranslationVel( :,K) = rd_in(i, J:J+2) MD_u(1)%CoupledKinematics(iTurb)%TranslationAcc( :,K) = 0.0_DbKi !rdd_in(i, J:J+2) @@ -554,7 +552,7 @@ PROGRAM MoorDyn_Driver call WrScr("Doing time marching now...") - CALL SimStatus_FirstTime( PrevSimTime, PrevClockTime, SimStrtTime, SimStrtCPU, t, tMax ) + CALL SimStatus_FirstTime( PrevSimTime, PrevClockTime, SimStrtTime, SimStrtCPU, t, TMax ) DO i = 1,nt @@ -564,7 +562,7 @@ PROGRAM MoorDyn_Driver if ( MOD( i, 20 ) == 0 ) THEN - CALL SimStatus( PrevSimTime, PrevClockTime, t, tMax ) + CALL SimStatus( PrevSimTime, PrevClockTime, t, TMax ) end if ! shift older inputs back in the buffer @@ -573,16 +571,17 @@ PROGRAM MoorDyn_Driver MD_uTimes(2) = MD_uTimes(1) - dtC !MD_uTimes(3) = MD_uTimes(2) - dtC - ! update coupled object kinematics iff we're reading input time series + ! update coupled object kinematics if we're reading input time series if (drvrInitInp%InputsMod == 1 ) then DO iTurb = 1, MD_p%nTurbines K = 1 ! the index of the coupling points in the input mesh CoupledKinematics J = 1 ! the starting index of the relevant DOFs in the input array + ! any coupled bodies (type -1) DO l = 1,MD_p%nCpldBodies(iTurb) - MD_u(1)%CoupledKinematics(iTurb)%TranslationDisp(:,K) = r_in(i, J:J+2) - MD_u(1)%CoupledKinematics(iTurb)%Position(:,K) - MD_p%TurbineRefPos(:,iTurb) + MD_u(1)%CoupledKinematics(iTurb)%TranslationDisp(:,K) = r_in(i, J:J+2) - MD_u(1)%CoupledKinematics(iTurb)%Position(:,K) - MD_p%TurbineRefPos(:,iTurb) MD_u(1)%CoupledKinematics(iTurb)%Orientation( :,:,K) = EulerConstruct( r_in(i, J+3:J+5) ) ! full Euler angle approach MD_u(1)%CoupledKinematics(iTurb)%TranslationVel( :,K) = rd_in(i, J:J+2) MD_u(1)%CoupledKinematics(iTurb)%RotationVel( :,K) = rd_in(i, J+3:J+5) @@ -595,8 +594,7 @@ PROGRAM MoorDyn_Driver ! any coupled rods (type -1 or -2) >>> need to make rotations ignored if it's a pinned rod <<< DO l = 1,MD_p%nCpldRods(iTurb) - - MD_u(1)%CoupledKinematics(iTurb)%TranslationDisp(:,K) = r_in(i, J:J+2) - MD_u(1)%CoupledKinematics(iTurb)%Position(:,K) - MD_p%TurbineRefPos(:,iTurb) + MD_u(1)%CoupledKinematics(iTurb)%TranslationDisp(:,K) = r_in(i, J:J+2) - MD_u(1)%CoupledKinematics(iTurb)%Position(:,K) - MD_p%TurbineRefPos(:,iTurb) MD_u(1)%CoupledKinematics(iTurb)%Orientation( :,:,K) = EulerConstruct( r_in(i, J+3:J+5) ) MD_u(1)%CoupledKinematics(iTurb)%TranslationVel( :,K) = rd_in(i, J:J+2) MD_u(1)%CoupledKinematics(iTurb)%RotationVel( :,K) = rd_in(i, J+3:J+5) @@ -609,8 +607,7 @@ PROGRAM MoorDyn_Driver ! any coupled points (type -1) DO l = 1, MD_p%nCpldPoints(iTurb) - - MD_u(1)%CoupledKinematics(iTurb)%TranslationDisp(:,K) = r_in(i, J:J+2) - MD_u(1)%CoupledKinematics(iTurb)%Position(:,K) - MD_p%TurbineRefPos(:,iTurb) + MD_u(1)%CoupledKinematics(iTurb)%TranslationDisp(:,K) = r_in(i, J:J+2) - MD_u(1)%CoupledKinematics(iTurb)%Position(:,K) - MD_p%TurbineRefPos(:,iTurb) MD_u(1)%CoupledKinematics(iTurb)%TranslationVel( :,K) = rd_in(i, J:J+2) MD_u(1)%CoupledKinematics(iTurb)%TranslationAcc( :,K) = 0.0_DbKi !rdd_in(i, J:J+2) @@ -635,7 +632,19 @@ PROGRAM MoorDyn_Driver end if ! InputsMod == 1 ! >>> otherwise, mesh kinematics should all still be zero ... maybe worth checking <<< - + + ! ! set free body state for kinematics debugging + ! if (i==1) then + ! DO l = 1,MD_p%nFreeBodies + ! IF (l==1) THEN + ! MD_x%states(MD_m%BodyStateIs1(l):MD_m%BodyStateIsN(l)) = [0.0, 0.0, 0.0, 0.2, 0.0, 0.0, 0.0, 0.0, -2.0, 0.0, 0.0, 0.0] + ! print*, "vel set for body1" + ! ELSEIF (l==2) THEN + ! MD_x%states(MD_m%BodyStateIs1(l):MD_m%BodyStateIsN(l)) = [0.0, 0.0, 10.0*0.2, 0.2, 0.0, 0.0, 0.0, 10.0, -2.0, 0.0, 0.0, 0.0] + ! print*, "vel set for body2" + ! ENDIF + ! ENDDO + ! endif ! --------------------------------- update states --------------------------------- CALL MD_UpdateStates( t, nt, MD_u, MD_uTimes, MD_p, MD_x, MD_xd, MD_xc, MD_xo, MD_m, ErrStat2, ErrMsg2 ); call AbortIfFailed() @@ -667,43 +676,46 @@ PROGRAM MoorDyn_Driver CALL MD_End( MD_u(1), MD_p, MD_x, MD_xd, MD_xc , MD_xo, MD_y, MD_m, ErrStat2, ErrMsg2 ); call AbortIfFailed() do j = 2,MD_interp_order+1 - call MD_DestroyInput( MD_u(j), ErrStat, ErrMsg) + call MD_DestroyInput( MD_u(j), ErrStat2, ErrMsg2) end do - - DEALLOCATE(MD_u) - DEALLOCATE(MD_uTimes) - - IF (ALLOCATED(r_in) ) DEALLOCATE(r_in ) - IF (ALLOCATED(PtfmMotIn)) DEALLOCATE(PtfmMotIn) - - CALL WrScr( "Program has ended" ) - close (un) + + if ( ErrStat /= ErrID_None ) THEN ! Display all errors + CALL WrScr1( "Errors: " ) + CALL WrScr( trim(GetErrStr(ErrStat))//': '//trim(ErrMsg) ) + endif + + !close (un) + call CleanUp() + CALL NormStop() CONTAINS SUBROUTINE AbortIfFailed() - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'MoorDyn_Driver') - IF ( ErrStat /= ErrID_None ) THEN - CALL WrScr( "Local error: "//ErrMsg2 ) - CALL WrScr( "Full error messages: "//ErrMsg ) - END IF + + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'MoorDyn_Driver') + if (ErrStat >= AbortErrLev) then call CleanUp() - STOP - endif + Call ProgAbort(trim(ErrMsg)) + elseif ( ErrStat2 /= ErrID_None ) THEN + CALL WrScr1( trim(GetErrStr(ErrStat2))//': '//trim(ErrMsg2)//NewLine) + end if END SUBROUTINE AbortIfFailed - LOGICAL FUNCTION Failed() - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'OutSummary') - Failed = ErrStat >= AbortErrLev - if (Failed) call CleanUp() - END FUNCTION Failed - SUBROUTINE CleanUp() - if(UnEcho>0) CLOSE(UnEcho) - if(UnEcho>0) CLOSE( UnIn) - if(allocated(MD_u)) deallocate(MD_u) + if(UnEcho >0) CLOSE( UnEcho ) + if(UnIn >0) CLOSE( UnIn ) + + IF (ALLOCATED(MD_u )) DEALLOCATE(MD_u ) + IF (ALLOCATED(MD_uTimes)) DEALLOCATE(MD_uTimes) + IF (ALLOCATED(PtfmMotIn)) DEALLOCATE(PtfmMotIn) + IF (ALLOCATED(r_in )) DEALLOCATE(r_in ) + IF (ALLOCATED(r_in2 )) DEALLOCATE(r_in2 ) + IF (ALLOCATED(rd_in )) DEALLOCATE(rd_in ) + IF (ALLOCATED(rd_in2 )) DEALLOCATE(rd_in2 ) + IF (ALLOCATED(rdd_in )) DEALLOCATE(rdd_in ) + IF (ALLOCATED(rdd_in2 )) DEALLOCATE(rdd_in2 ) END SUBROUTINE CleanUp !------------------------------------------------------------------------------------------------------------------------------- @@ -711,16 +723,11 @@ SUBROUTINE ReadDriverInputFile( inputFile, InitInp) CHARACTER(*), INTENT( IN ) :: inputFile TYPE(MD_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 MoorDyn 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) :: EchoFile ! Name of MoorDyn echo file CHARACTER(1024) :: FileName ! Name of MoorDyn input file - CHARACTER(1024) :: FilePath ! Path Name of MoorDyn input file + CHARACTER(1024) :: FilePath ! Name of path to MoorDyn input file UnEcho=-1 UnIn =-1 @@ -736,17 +743,17 @@ SUBROUTINE ReadDriverInputFile( inputFile, InitInp) ! Read until "echo" CALL ReadCom( UnIn, FileName, 'MoorDyn Driver input file header line 1', ErrStat2, ErrMsg2); call AbortIfFailed() CALL ReadCom( UnIn, FileName, 'MoorDyn 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, 'MoorDyn Driver input file header line 1', ErrStat2, ErrMsg2, UnEcho); call AbortIfFailed() - CALL ReadCom( UnIn, FileName, 'MoorDyn 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 + ! 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, ErrStat2, ErrMsg2 ); call AbortIfFailed() + ! REWIND(UnIn) + ! CALL ReadCom( UnIn, FileName, 'MoorDyn Driver input file header line 1', ErrStat2, ErrMsg2, UnEcho); call AbortIfFailed() + ! CALL ReadCom( UnIn, FileName, 'MoorDyn 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() @@ -772,17 +779,23 @@ SUBROUTINE ReadDriverInputFile( inputFile, InitInp) if(UnEcho>0) CLOSE( UnEcho ) if(UnIn>0) CLOSE( UnIn ) + UnEcho = -1 + UnIn = -1 + ! Perform input checks and triggers - !CALL GetPath( FileName, FilePath ) - !IF ( PathIsRelative( InitInp%MDInputFile ) ) then - ! InitInp%MDInputFile = TRIM(FilePath)//TRIM(InitInp%MDInputFile) - !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 + CALL GetPath( FileName, FilePath ) + + IF ( PathIsRelative( InitInp%MDInputFile ) ) then + InitInp%MDInputFile = TRIM(FilePath)//TRIM(InitInp%MDInputFile) + 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 diff --git a/modules/moordyn/src/MoorDyn_IO.f90 b/modules/moordyn/src/MoorDyn_IO.f90 index caad8b3b15..82ec10f977 100644 --- a/modules/moordyn/src/MoorDyn_IO.f90 +++ b/modules/moordyn/src/MoorDyn_IO.f90 @@ -118,6 +118,7 @@ MODULE MoorDyn_IO PUBLIC :: MDIO_CloseOutput PUBLIC :: MDIO_ProcessOutList PUBLIC :: MDIO_WriteOutputs + PUBLIC :: Line_GetNodeTen CONTAINS @@ -226,7 +227,7 @@ SUBROUTINE getCoefficientOrCurve(inputString, LineProp_c, LineProp_npoints, Line INTEGER(IntKi), INTENT( OUT) :: ErrStat3 ! Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg3 ! Error message if ErrStat /= ErrID_None - INTEGER(IntKi) :: nC, I + INTEGER(IntKi) :: I INTEGER(IntKi) :: UnCoef ! unit number for coefficient input file @@ -242,8 +243,7 @@ SUBROUTINE getCoefficientOrCurve(inputString, LineProp_c, LineProp_npoints, Line LineProp_npoints = 0; else ! otherwise interpet the input as a file name to load stress-strain lookup data from - - CALL WrScr("found A letter in the line coefficient value so will try to load the filename.") + CALL WrScr1(" Found a letter in the line EA coefficient value so will try to load the filename.") LineProp_c = 0.0 @@ -251,8 +251,13 @@ SUBROUTINE getCoefficientOrCurve(inputString, LineProp_c, LineProp_npoints, Line CALL GetNewUnit( UnCoef ) CALL OpenFInpFile( UnCoef, TRIM(inputString), ErrStat4, ErrMsg4 ) ! add error handling? + IF (ErrStat4 == ErrID_Fatal) then + ErrStat3 = ErrStat4 + ErrMsg3 = ErrMsg4 + RETURN + ENDIF - READ(UnCoef,'(A)',IOSTAT=ErrStat4) Line2 ! skip the first two lines (title, names, and units) then parse + READ(UnCoef,'(A)',IOSTAT=ErrStat4) Line2 ! skip the first three lines (title, names, and units) then parse READ(UnCoef,'(A)',IOSTAT=ErrStat4) Line2 READ(UnCoef,'(A)',IOSTAT=ErrStat4) Line2 @@ -294,7 +299,7 @@ SUBROUTINE SplitByBars(instring, n, outstrings) INTEGER(IntKi), INTENT( OUT) :: n CHARACTER(40), INTENT(INOUT) :: outstrings(6) ! array of output strings. Up to 6 strings can be read - INTEGER :: pos1, pos2, i + INTEGER :: pos1, pos2 n = 0 pos1=1 @@ -329,13 +334,13 @@ SUBROUTINE DecomposeString(outWord, let1, num1, let2, num2, let3) ! INTEGER(IntKi), INTENT( OUT) :: num2 CHARACTER(25), INTENT( OUT) :: let3 - INTEGER(IntKi) :: I ! Generic loop-counting index +! INTEGER(IntKi) :: I ! Generic loop-counting index - CHARACTER(ChanLen) :: OutListTmp ! A string to temporarily hold OutList(I), the name of each output channel - CHARACTER(ChanLen) :: qVal ! quantity type string to match to list of valid options +! CHARACTER(ChanLen) :: OutListTmp ! A string to temporarily hold OutList(I), the name of each output channel +! CHARACTER(ChanLen) :: qVal ! quantity type string to match to list of valid options - INTEGER :: oID ! ID number of point or line object - INTEGER :: nID ! ID number of node object +! INTEGER :: oID ! ID number of connect or line object +! INTEGER :: nID ! ID number of node object INTEGER :: i1 = 0 ! indices of start of numbers or letters in OutListTmp string, for parsing INTEGER :: i2 = 0 INTEGER :: i3 = 0 @@ -428,7 +433,7 @@ SUBROUTINE MDIO_ProcessOutList(OutList, p, m, y, InitOut, ErrStat, ErrMsg ) INTEGER :: oID ! ID number of point or line object INTEGER :: nID ! ID number of node object - INTEGER :: i1,i2,i3,i4 ! indices of start of numbers or letters in OutListTmp string, for parsing +! INTEGER :: i1,i2,i3,i4 ! indices of start of numbers or letters in OutListTmp string, for parsing CHARACTER(25) :: let1 ! strings used for splitting and parsing identifiers CHARACTER(25) :: num1 @@ -852,7 +857,7 @@ SUBROUTINE MDIO_OpenOutput( MD_ProgDesc, p, m, InitOut, ErrStat, ErrMsg ) INTEGER :: I ! Generic loop counter INTEGER :: J ! Generic loop counter CHARACTER(1024) :: OutFileName ! The name of the output file including the full path. - INTEGER :: L ! counter for index in LineWrOutput +! INTEGER :: L ! counter for index in LineWrOutput INTEGER :: LineNumOuts ! number of entries in LineWrOutput for each line INTEGER :: RodNumOuts ! for Rods ... redundant <<< CHARACTER(200) :: Frmt ! a string to hold a format statement @@ -1361,11 +1366,11 @@ SUBROUTINE MDIO_WriteOutputs( Time, p, m, y, ErrStat, ErrMsg ) CASE (FZ) y%WriteOutput(I) = m%LineList(p%OutParam(I)%ObjID)%Fnet(3,p%OutParam(I)%NodeID) ! node force in z CASE (Ten) - y%WriteOutput(I) = Line_GetNodeTen(m%LineList(p%OutParam(I)%ObjID), p%OutParam(I)%NodeID, p) ! this is actually the segment tension ( 1 < NodeID < N ) Should deal with properly! + y%WriteOutput(I) = Line_GetNodeTen(m%LineList(p%OutParam(I)%ObjID), p%OutParam(I)%NodeID) ! this is actually the segment tension ( 1 < NodeID < N ) Should deal with properly! CASE (TenA) - y%WriteOutput(I) = Line_GetNodeTen(m%LineList(p%OutParam(I)%ObjID), 0, p) + y%WriteOutput(I) = Line_GetNodeTen(m%LineList(p%OutParam(I)%ObjID), 0) CASE (TenB) - y%WriteOutput(I) = Line_GetNodeTen(m%LineList(p%OutParam(I)%ObjID), m%LineList(p%OutParam(I)%ObjID)%N, p) + y%WriteOutput(I) = Line_GetNodeTen(m%LineList(p%OutParam(I)%ObjID), m%LineList(p%OutParam(I)%ObjID)%N) CASE DEFAULT y%WriteOutput(I) = 0.0_ReKi ErrStat = ErrID_Warn @@ -1882,11 +1887,10 @@ END SUBROUTINE MDIO_WriteOutputs ! get tension at any node including fairlead or anchor (accounting for weight in these latter cases) !-------------------------------------------------------------- - FUNCTION Line_GetNodeTen(Line, i, p) result(NodeTen) + FUNCTION Line_GetNodeTen(Line, i) result(NodeTen) TYPE(MD_Line), INTENT(IN ) :: Line ! label for the current line, for convenience INTEGER(IntKi), INTENT(IN ) :: i ! node index to get tension at - TYPE(MD_ParameterType), INTENT(IN ) :: p ! Parameters REAL(DbKi) :: NodeTen ! returned calculation of tension at node INTEGER(IntKi) :: J diff --git a/modules/moordyn/src/MoorDyn_Line.f90 b/modules/moordyn/src/MoorDyn_Line.f90 index 21cd2d71ef..fe1131f32e 100644 --- a/modules/moordyn/src/MoorDyn_Line.f90 +++ b/modules/moordyn/src/MoorDyn_Line.f90 @@ -57,7 +57,7 @@ SUBROUTINE SetupLine (Line, LineProp, p, ErrStat, ErrMsg) INTEGER, INTENT( INOUT ) :: ErrStat ! returns a non-zero value when an error occurs CHARACTER(*), INTENT( INOUT ) :: ErrMsg ! Error message if ErrStat /= ErrID_None - INTEGER(4) :: I, J, K ! Generic index + INTEGER(4) :: I, J ! Generic index INTEGER(IntKi) :: N REAL(DbKi) :: temp @@ -69,11 +69,13 @@ SUBROUTINE SetupLine (Line, LineProp, p, ErrStat, ErrMsg) Line%d = LineProp%d Line%rho = LineProp%w/(Pi/4.0 * Line%d * Line%d) - Line%EA = LineProp%EA + Line%EA = LineProp%EA ! note: Line%BA is set later - Line%EA_D = LineProp%EA_D - Line%BA_D = LineProp%BA_D - Line%EI = LineProp%EI !<<< for bending stiffness + Line%EA_D = LineProp%EA_D + Line%alphaMBL = LineProp%alphaMBL + Line%vbeta = LineProp%vbeta + Line%BA_D = LineProp%BA_D + Line%EI = LineProp%EI !<<< for bending stiffness Line%Can = LineProp%Can Line%Cat = LineProp%Cat @@ -82,6 +84,12 @@ SUBROUTINE SetupLine (Line, LineProp, p, ErrStat, ErrMsg) ! copy over elasticity data Line%ElasticMod = LineProp%ElasticMod + + if (Line%ElasticMod > 3) then + ErrStat = ErrID_Fatal + ErrMsg = "Line ElasticMod > 3. This is not possible." + RETURN + endif Line%nEApoints = LineProp%nEApoints DO I = 1,Line%nEApoints @@ -141,7 +149,7 @@ SUBROUTINE SetupLine (Line, LineProp, p, ErrStat, ErrMsg) END IF ! if using viscoelastic model, allocate additional state quantities - if (Line%ElasticMod == 2) then + if (Line%ElasticMod > 1) then ALLOCATE ( Line%dl_1(N), STAT = ErrStat ) IF ( ErrStat /= ErrID_None ) THEN ErrMsg = ' Error allocating dl_1 array.' @@ -161,7 +169,7 @@ SUBROUTINE SetupLine (Line, LineProp, p, ErrStat, ErrMsg) END IF ! allocate segment scalar quantities - ALLOCATE ( Line%l(N), Line%ld(N), Line%lstr(N), Line%lstrd(N), Line%Kurv(0:N), Line%V(N), STAT = ErrStat ) + ALLOCATE ( Line%l(N), Line%ld(N), Line%lstr(N), Line%lstrd(N), Line%Kurv(0:N), Line%V(N), Line%F(N), STAT = ErrStat ) IF ( ErrStat /= ErrID_None ) THEN ErrMsg = ' Error allocating segment scalar quantity arrays.' !CALL CleanUp() @@ -213,25 +221,6 @@ SUBROUTINE SetupLine (Line, LineProp, p, ErrStat, ErrMsg) RETURN END IF - - if (p%writeLog > 1) then - write(p%UnLog, '(A)') " - Line"//trim(num2lstr(Line%IdNum)) - write(p%UnLog, '(A)') " ID: "//trim(num2lstr(Line%IdNum)) - write(p%UnLog, '(A)') " UnstrLen: "//trim(num2lstr(Line%UnstrLen)) - write(p%UnLog, '(A)') " N : "//trim(num2lstr(Line%N )) - write(p%UnLog, '(A)') " d : "//trim(num2lstr(Line%d )) - write(p%UnLog, '(A)') " rho : "//trim(num2lstr(Line%rho )) - write(p%UnLog, '(A)') " E : "//trim(num2lstr(Line%EA )) - write(p%UnLog, '(A)') " EI : "//trim(num2lstr(Line%EI )) - !write(p%UnLog, '(A)') " BAin: "//trim(num2lstr(Line%BAin)) - write(p%UnLog, '(A)') " Can : "//trim(num2lstr(Line%Can )) - write(p%UnLog, '(A)') " Cat : "//trim(num2lstr(Line%Cat )) - write(p%UnLog, '(A)') " Cdn : "//trim(num2lstr(Line%Cdn )) - write(p%UnLog, '(A)') " Cdt : "//trim(num2lstr(Line%Cdt )) - !write(p%UnLog, '(A)') " ww_l: " << ( (rho - env->rho_w)*(pi/4.*d*d) )*9.81 << endl; - end if - - ! need to add cleanup sub <<< @@ -376,12 +365,8 @@ SUBROUTINE Line_Initialize (Line, LineProp, p, ErrStat, ErrMsg) Line%r(2,J) = Line%r(2,0) + (Line%r(2,N) - Line%r(2,0))*REAL(J, DbKi)/REAL(N, DbKi) Line%r(3,J) = Line%r(3,0) + (Line%r(3,N) - Line%r(3,0))*REAL(J, DbKi)/REAL(N, DbKi) - ! print*, Line%r(:,J) ENDDO - ! print*,"FYI line end A and B node coords are" - ! print*, Line%r(:,0) - ! print*, Line%r(:,N) ENDIF ENDIF @@ -949,7 +934,7 @@ SUBROUTINE Catenary ( XF_In, ZF_In, L_In , EA_In, & IF (reverseFlag) THEN - ! Follows process of MoorPy catenary.py + ! Follows process of MoorPy catenary.py s = s( size(s):1:-1 ) X = X( size(X):1:-1 ) Z = Z( size(Z):1:-1 ) @@ -1014,7 +999,7 @@ SUBROUTINE Line_SetState(Line, X, t) END DO ! if using viscoelastic model, also set the static stiffness stretch - if (Line%ElasticMod == 2) then + if (Line%ElasticMod > 1) then do I=1,Line%N Line%dl_1(I) = X( 6*Line%N-6 + I) ! these will be the last N entries in the state vector end do @@ -1024,12 +1009,15 @@ END SUBROUTINE Line_SetState !-------------------------------------------------------------- !-------------------------------------------------------------- - SUBROUTINE Line_GetStateDeriv(Line, Xd, m, p) !, FairFtot, FairMtot, AnchFtot, AnchMtot) + SUBROUTINE Line_GetStateDeriv(Line, Xd, m, p, ErrStat, ErrMsg) !, FairFtot, FairMtot, AnchFtot, AnchMtot) TYPE(MD_Line), INTENT(INOUT) :: Line ! the current Line object Real(DbKi), INTENT(INOUT) :: Xd(:) ! state derivative vector section for this line TYPE(MD_MiscVarType), INTENT(INOUT) :: m ! passing along all mooring objects TYPE(MD_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(DbKi), INTENT( IN ) :: X(:) ! state vector, provided ! Real(DbKi), INTENT( INOUT ) :: Xd(:) ! derivative of state vector, returned ! cahnged to INOUT @@ -1055,6 +1043,8 @@ SUBROUTINE Line_GetStateDeriv(Line, Xd, m, p) !, FairFtot, FairMtot, AnchFtot, Real(DbKi) :: Vi(3) ! relative water velocity at a given node Real(DbKi) :: Vp(3) ! transverse relative water velocity component at a given node Real(DbKi) :: Vq(3) ! tangential relative water velocity component at a given node + Real(DbKi) :: ap(3) ! transverse fluid acceleration component at a given node + Real(DbKi) :: aq(3) ! tangential fluid acceleration component at a given node Real(DbKi) :: SumSqVp ! Real(DbKi) :: SumSqVq ! Real(DbKi) :: MagVp ! @@ -1065,7 +1055,17 @@ SUBROUTINE Line_GetStateDeriv(Line, Xd, m, p) !, FairFtot, FairMtot, AnchFtot, Real(DbKi) :: Yi ! used in interpolating from lookup table Real(DbKi) :: dl ! stretch of a segment [m] Real(DbKi) :: ld_1 ! rate of change of static stiffness portion of segment [m/s] - Real(DbKi) :: EA_1 ! stiffness of 'static stiffness' portion of segment, combines with dynamic stiffness to give static stiffnes [m/s] + Real(DbKi) :: EA_1 ! stiffness of 'slow' portion of segment, combines with dynamic stiffness to give static stiffnes [m/s] + Real(DbKi) :: EA_D ! stiffness of 'fast' portion of segment, combines with EA_1 stiffness to give static stiffnes [m/s] + + REAL(DbKi) :: surface_height ! Average the surface heights at the two nodes + REAL(DbKi) :: firstNodeZ ! Difference of first node depth from surface height + REAL(DbKi) :: secondNodeZ ! Difference of second node depth from surface height + REAL(DbKi) :: lowerEnd(3) ! XYZ location of lower segment end + REAL(DbKi) :: upperEnd(3) ! XYZ location of upper segment end + REAL(DbKi) :: segmentAxis(3) ! Vector from segment lower end to upper end + REAL(DbKi) :: upVec(3) ! Universal up unit vector = (0,0,1) + REAL(DbKi) :: normVec(3) ! Normal vector to segment Real(DbKi) :: Kurvi ! temporary curvature value [1/m] Real(DbKi) :: pvec(3) ! the p vector used in bending stiffness calcs @@ -1145,18 +1145,80 @@ SUBROUTINE Line_GetStateDeriv(Line, Xd, m, p) !, FairFtot, FairMtot, AnchFtot, CALL getWaterKin(p, Line%r(1,i), Line%r(2,i), Line%r(3,i), Line%time, m%WaveTi, Line%U(:,i), Line%Ud(:,i), Line%zeta(i), Line%PDyn(i)) END DO + ! --------- calculate line partial submergence (Line::calcSubSeg from MD-C) --------- + DO i=1,N + + Line%F(i) = 1.0_DbKi + + ! TODO: Is the below the right way to handle partial submergence + + ! ! TODO - figure out the best math to do here + ! ! Averaging the surface heights at the two nodes is probably never + ! ! correct + ! surface_height = 0.5 * (Line%zeta(i-1) + Line%zeta(i)) + + ! ! The below could also be made an inline function with surface height and node indicies as inputs, same as MD-C + ! firstNodeZ = Line%r(3,i-1) - surface_height + ! secondNodeZ = Line%r(3,i) - surface_height + ! if ((firstNodeZ <= 0.0) .AND. (secondNodeZ < 0.0)) then + ! Line%F(i) = 1.0 ! Both nodes below water; segment must be too + ! else if ((firstNodeZ > 0.0) .AND. (secondNodeZ > 0.0)) then + ! Line%F(i) = 0.0 ! Both nodes above water; segment must be too + ! else if (firstNodeZ == -secondNodeZ) then + ! Line%F(i) = 0.5 ! Segment halfway submerged + ! else + ! ! Segment partially submerged - figure out which node is above water + ! if (firstNodeZ < 0.0) then + ! lowerEnd = Line%r(:,i-1) + ! else + ! lowerEnd = Line%r(:,i) + ! endif + ! if (firstNodeZ < 0.0) then + ! upperEnd = Line%r(:,i) + ! else + ! upperEnd = Line%r(:,i-1) + + ! endif + ! lowerEnd(3) = lowerEnd(3) - surface_height + ! upperEnd(3) = upperEnd(3) - surface_height + + ! ! segment submergence is calculated by calculating submergence of + ! ! hypotenuse across segment from upper corner to lower corner + ! ! To calculate this, we need the coordinates of these corners. + ! ! first step is to get vector from lowerEnd to upperEnd + ! segmentAxis = upperEnd - lowerEnd + + ! ! Next, find normal vector in z-plane, i.e. the normal vecto that + ! ! points "up" the most. See the following stackexchange: + ! ! https://math.stackexchange.com/questions/2283842/ + ! upVec = (/0.0_DbKi, 0.0_DbKi, 1.0_DbKi/) ! the global up-unit vector + ! normVec = Cross_Product(segmentAxis, (Cross_Product(upVec, segmentAxis))) + ! normVec = normVec / SQRT(normVec(1)**2+normVec(2)**2+normVec(3)**2) ! normalize + + ! ! make sure normal vector has length equal to radius of segment + ! call scalevector(normVec, Line%d / 2, normVec) + + ! ! Calculate and return submerged ratio: + ! lowerEnd = lowerEnd - normVec + ! upperEnd = upperEnd + normVec + + ! Line%F(i) = abs(lowerEnd(3)) / (abs(lowerEnd(3)) + upperEnd(3)) + + ! endif + + END DO ! --------------- calculate mass (including added mass) matrix for each node ----------------- DO I = 0, N IF (I==0) THEN m_i = Pi/8.0 *d*d*Line%l(1)*rho - v_i = 0.5 *Line%V(1) + v_i = 0.5 * Line%F(1) * Line%V(1) ELSE IF (I==N) THEN m_i = pi/8.0 *d*d*Line%l(N)*rho; - v_i = 0.5*Line%V(N) + v_i = 0.5 * Line%F(N) * Line%V(N) ELSE m_i = pi/8.0 * d*d*rho*(Line%l(I) + Line%l(I+1)) - v_i = 0.5 *(Line%V(I) + Line%V(I+1)) + v_i = 0.5 *(Line%F(I) * Line%V(I) + Line%F(I+1) * Line%V(I+1)) END IF DO J=1,3 @@ -1218,21 +1280,49 @@ SUBROUTINE Line_GetStateDeriv(Line, Xd, m, p) !, FairFtot, FairMtot, AnchFtot, else MagT = 0.0_DbKi ! cable can't "push" end if + ! line internal damping force based on line-specific BA value, including possibility of dynamic length changes in l and ld terms MagTd = Line%BA* ( Line%lstrd(I) - Line%lstr(I)*Line%ld(I)/Line%l(I) )/Line%l(I) - ! viscoelastic model - else if (Line%ElasticMod == 2) then + ! viscoelastic model from https://asmedigitalcollection.asme.org/OMAE/proceedings/IOWTC2023/87578/V001T01A029/1195018 + else if (Line%ElasticMod > 1) then + + if (Line%ElasticMod == 3) then + if (Line%dl_1(I) >= 0.0) then + ! Mean load dependent dynamic stiffness: from combining eqn. 2 and eqn. 10 from original MD viscoelastic paper, taking mean load = k1 delta_L1 / MBL, and solving for k_D using WolframAlpha with following conditions: k_D > k_s, (MBL,alpha,beta,unstrLen,delta_L1) > 0 + EA_D = 0.5 * ((Line%alphaMBL) + (Line%vbeta*Line%dl_1(I)*(Line%EA / Line%l(I))) + Line%EA + sqrt((Line%alphaMBL * Line%alphaMBL) + (2*Line%alphaMBL*(Line%EA / Line%l(I)) * (Line%vbeta*Line%dl_1(I) - Line%l(I))) + ((Line%EA / Line%l(I))*(Line%EA / Line%l(I)) * (Line%vbeta*Line%dl_1(I) + Line%l(I))*(Line%vbeta*Line%dl_1(I) + Line%l(I))))) + else + EA_D = Line%alphaMBL ! mean load is considered to be 0 in this case. The second term in the above equation is not valid for delta_L1 < 0. + endif + + else if (Line%ElasticMod == 2) then + ! constant dynamic stiffness + EA_D = Line%EA_D + endif + + if (EA_D == 0.0) then ! Make sure EA != EA_D or else nans, also make sure EA_D != 0 or else nans. + ErrStat = ErrID_Fatal + ErrMsg = "Viscoelastic model: Dynamic stiffness cannot equal zero" + return + else if (EA_D == Line%EA) then + ErrStat = ErrID_Fatal + ErrMsg = "Viscoelastic model: Dynamic stiffness cannot equal static stiffness" + return + endif - EA_1 = Line%EA_D*Line%EA/(Line%EA_D - Line%EA)! calculated EA_1 which is the stiffness in series with EA_D that will result in the desired static stiffness of EA_S + EA_1 = EA_D*Line%EA/(EA_D - Line%EA)! calculated EA_1 which is the stiffness in series with EA_D that will result in the desired static stiffness of EA_S. dl = Line%lstr(I) - Line%l(I) ! delta l of this segment - ld_1 = (Line%EA_D*dl - (Line%EA_D + EA_1)*Line%dl_1(I) + Line%BA_D*Line%lstrd(I)) /( Line%BA_D + Line%BA) ! rate of change of static stiffness portion [m/s] - - !MagT = (Line%EA*Line%dl_S(I) + Line%BA*ld_S)/ Line%l(I) ! compute tension based on static portion (dynamic portion would give same) - MagT = EA_1*Line%dl_1(I)/ Line%l(I) - MagTd = Line%BA*ld_1 / Line%l(I) + ld_1 = (EA_D*dl - (EA_D + EA_1)*Line%dl_1(I) + Line%BA_D*Line%lstrd(I)) /( Line%BA_D + Line%BA) ! rate of change of static stiffness portion [m/s] + + if (dl >= 0.0) then ! if both spring 1 (the spring dashpot in parallel) and the whole segment are not in compression + MagT = EA_1*Line%dl_1(I) / Line%l(I) ! compute tension based on static portion (dynamic portion would give same). See eqn. 14 in paper + else + MagT = 0.0_DbKi ! cable can't "push" + endif + + MagTd = Line%BA*ld_1 / Line%l(I) ! compute tension based on static portion (dynamic portion would give same). See eqn. 14 in paper ! update state derivative for static stiffness stretch (last N entries in the state vector) Xd( 6*N-6 + I) = ld_1 @@ -1338,11 +1428,11 @@ SUBROUTINE Line_GetStateDeriv(Line, Xd, m, p) !, FairFtot, FairMtot, AnchFtot, !submerged weight (including buoyancy) IF (I==0) THEN - Line%W(3,I) = Pi/8.0*d*d* Line%l(1)*(rho - p%rhoW) *(-p%g) ! assuming g is positive + Line%W(3,I) = Pi/8.0*d*d* Line%l(1)*(rho - Line%F(1) * p%rhoW) *(-p%g) ! assuming g is positive ELSE IF (i==N) THEN - Line%W(3,I) = pi/8.0*d*d* Line%l(N)*(rho - p%rhoW) *(-p%g) + Line%W(3,I) = pi/8.0*d*d* Line%l(N)*(rho - Line%F(N) * p%rhoW) *(-p%g) ELSE - Line%W(3,I) = pi/8.0*d*d* (Line%l(I)*(rho - p%rhoW) + Line%l(I+1)*(rho - p%rhoW) )*(-p%g) ! left in this form for future free surface handling + Line%W(3,I) = pi/8.0*d*d* (Line%l(I)*(rho - Line%F(I) * p%rhoW) + Line%l(I+1)*(rho - Line%F(I+1) * p%rhoW) )*(-p%g) ! left in this form for future free surface handling END IF ! relative flow velocities @@ -1364,17 +1454,32 @@ SUBROUTINE Line_GetStateDeriv(Line, Xd, m, p) !, FairFtot, FairMtot, AnchFtot, ! transverse and tangenential drag IF (I==0) THEN - Line%Dp(:,I) = 0.25*p%rhoW*Line%Cdn* d*Line%l(1) * MagVp * Vp - Line%Dq(:,I) = 0.25*p%rhoW*Line%Cdt* Pi*d*Line%l(1) * MagVq * Vq + Line%Dp(:,I) = 0.25*p%rhoW*Line%Cdn* d*Line%F(1)*Line%l(1) * MagVp * Vp + Line%Dq(:,I) = 0.25*p%rhoW*Line%Cdt* Pi*d*Line%F(1)*Line%l(1) * MagVq * Vq ELSE IF (I==N) THEN - Line%Dp(:,I) = 0.25*p%rhoW*Line%Cdn* d*Line%l(N) * MagVp * Vp - Line%Dq(:,I) = 0.25*p%rhoW*Line%Cdt* Pi*d*Line%l(N) * MagVq * Vq + Line%Dp(:,I) = 0.25*p%rhoW*Line%Cdn* d*Line%F(N)*Line%l(N) * MagVp * Vp + Line%Dq(:,I) = 0.25*p%rhoW*Line%Cdt* Pi*d*Line%F(N)*Line%l(N) * MagVq * Vq ELSE - Line%Dp(:,I) = 0.25*p%rhoW*Line%Cdn* d*(Line%l(I) + Line%l(I+1)) * MagVp * vp - Line%Dq(:,I) = 0.25*p%rhoW*Line%Cdt* Pi*d*(Line%l(I) + Line%l(I+1)) * MagVq * vq + Line%Dp(:,I) = 0.25*p%rhoW*Line%Cdn* d*(Line%F(I)*Line%l(I) + Line%F(I+1)*Line%l(I+1)) * MagVp * Vp + Line%Dq(:,I) = 0.25*p%rhoW*Line%Cdt* Pi*d*(Line%F(I)*Line%l(I) + Line%F(I+1)*Line%l(I+1)) * MagVq * Vq END IF - ! F-K force from fluid acceleration not implemented yet + ! ------ fluid acceleration components for current node (from MD-C) ------ + DO J = 1, 3 + aq(J) = DOT_PRODUCT( Line%Ud(:,I) , Line%q(:,I) ) * Line%q(J,I); ! tangential fluid acceleration component + ap(J) = Line%Ud(J,I) - aq(J) ! transverse fluid acceleration component + ENDDO + + if (I == 0) then + Line%Ap(:,I) = p%rhoW * (1. + Line%Can) * 0.5 * (Line%F(1)* Line%V(1)) * ap + Line%Aq(:,I) = p%rhoW * (1. + Line%Cat) * 0.5 * (Line%F(1)* Line%V(1)) * aq + else if (I == N) then + Line%Ap(:,I) = p%rhoW * (1. + Line%Can) * 0.5 * (Line%F(N)* Line%V(N)) * ap + Line%Aq(:,I) = p%rhoW * (1. + Line%Cat) * 0.5 * (Line%F(N)* Line%V(N)) * aq + else + Line%Ap(:,I) = p%rhoW * (1. + Line%Can) * 0.5 * (Line%F(I)* Line%V(I) + Line%F(I+1)* Line%V(I+1)) * ap + Line%Aq(:,I) = p%rhoW * (1. + Line%Cat) * 0.5 * (Line%F(I)* Line%V(I) + Line%F(I+1)* Line%V(I+1)) * aq + endif ! bottom contact (stiffness and damping, vertical-only for now) - updated Nov 24 for general case where anchor and fairlead ends may deal with bottom contact forces ! bottom contact - updated throughout October 2021 for seabed bathymetry and friction models @@ -1453,11 +1558,11 @@ SUBROUTINE Line_GetStateDeriv(Line, Xd, m, p) !, FairFtot, FairMtot, AnchFtot, ! total forces IF (I==0) THEN - Line%Fnet(:,I) = Line%T(:,1) + Line%Td(:,1) + Line%W(:,I) + Line%Dp(:,I) + Line%Dq(:,I) + Line%B(:,I) + Line%Bs(:,I) + Line%Fnet(:,I) = Line%T(:,1) + Line%Td(:,1) + Line%W(:,I) + Line%Dp(:,I) + Line%Dq(:,I) + Line%Ap(:,I) + Line%Aq(:,I) + Line%B(:,I) + Line%Bs(:,I) ELSE IF (I==N) THEN - Line%Fnet(:,I) = -Line%T(:,N) - Line%Td(:,N) + Line%W(:,I) + Line%Dp(:,I) + Line%Dq(:,I) + Line%B(:,I) + Line%Bs(:,I) + Line%Fnet(:,I) = -Line%T(:,N) - Line%Td(:,N) + Line%W(:,I) + Line%Dp(:,I) + Line%Dq(:,I) + Line%Ap(:,I) + Line%Aq(:,I) + Line%B(:,I) + Line%Bs(:,I) ELSE - Line%Fnet(:,I) = Line%T(:,I+1) - Line%T(:,I) + Line%Td(:,I+1) - Line%Td(:,I) + Line%W(:,I) + Line%Dp(:,I) + Line%Dq(:,I) + Line%B(:,I) + Line%Bs(:,I) + Line%Fnet(:,I) = Line%T(:,I+1) - Line%T(:,I) + Line%Td(:,I+1) - Line%Td(:,I) + Line%W(:,I) + Line%Dp(:,I) + Line%Dq(:,I) + Line%Ap(:,I) + Line%Aq(:,I) + Line%B(:,I) + Line%Bs(:,I) END IF END DO ! I - done looping through nodes @@ -1483,7 +1588,7 @@ SUBROUTINE Line_GetStateDeriv(Line, Xd, m, p) !, FairFtot, FairMtot, AnchFtot, ! check for NaNs DO J = 1, 6*(N-1) IF (Is_NaN(Xd(J))) THEN - print *, "NaN detected at time ", Line%time, " in Line ", Line%IdNum, " in MoorDyn." + Call WrScr( "NaN detected at time "//trim(num2lstr(Line%time))//" in Line "//trim(num2lstr(Line%IdNum))//" in MoorDyn.") IF (wordy > 1) THEN print *, "state derivatives:" print *, Xd @@ -1542,7 +1647,7 @@ SUBROUTINE Line_SetEndKinematics(Line, r_in, rd_in, t, topOfLine) Real(DbKi), INTENT(IN ) :: t ! instantaneous time INTEGER(IntKi), INTENT(IN ) :: topOfLine ! 0 for end A (Node 0), 1 for end B (node N) - Integer(IntKi) :: I,J + Integer(IntKi) :: J INTEGER(IntKi) :: inode IF (topOfLine==1) THEN @@ -1582,8 +1687,8 @@ SUBROUTINE Line_GetEndStuff(Line, Fnet_out, Moment_out, M_out, topOfLine) REAL(DbKi), INTENT( OUT) :: M_out(3,3) ! mass matrix of end node INTEGER(IntKi), INTENT(IN ) :: topOfLine ! 0 for end A (Node 0), 1 for end B (node N) - Integer(IntKi) :: I,J - INTEGER(IntKi) :: inode + Integer(IntKi) :: J +! INTEGER(IntKi) :: inode IF (topOfLine==1) THEN ! end B of line Fnet_out = Line%Fnet(:, Line%N) diff --git a/modules/moordyn/src/MoorDyn_Misc.f90 b/modules/moordyn/src/MoorDyn_Misc.f90 index 82252d1258..bf26a7ab1b 100644 --- a/modules/moordyn/src/MoorDyn_Misc.f90 +++ b/modules/moordyn/src/MoorDyn_Misc.f90 @@ -151,8 +151,10 @@ subroutine GetOrientationAngles(vec, phi, sinPhi, cosPhi, tanPhi, beta, sinBeta, vecLen = SQRT(Dot_Product(vec,vec)) vecLen2D = SQRT(vec(1)**2+vec(2)**2) if ( vecLen < 0.000001 ) then - print *, "ERROR in GetOrientationAngles in MoorDyn. Supplied vector is near zero" - print *, vec + if (wordy > 0) then + print *, "ERROR in GetOrientationAngles in MoorDyn. Supplied vector is near zero" + print *, vec + endif k_hat = NaN ! 1.0/0.0 else k_hat = vec / vecLen @@ -236,10 +238,10 @@ SUBROUTINE TransformKinematicsA(rRelBody, r_in, TransMat, v_in, a_in, r_out, v_o REAL(DbKi), INTENT( OUT) :: a_out(3) ! acceleration of point REAL(DbKi) :: rRel(3) - REAL(DbKi) :: rRel2(3) +! REAL(DbKi) :: rRel2(3) - REAL(DbKi) :: r_out2(3) - REAL(DbKi) :: rd_out2(3) +! REAL(DbKi) :: r_out2(3) +! REAL(DbKi) :: rd_out2(3) REAL(DbKi) :: H(3,3) ! rd_in should be in global orientation frame @@ -322,10 +324,10 @@ SUBROUTINE TranslateMass3to6DOF(dx, Min, Mout) REAL(DbKi), INTENT( OUT) :: Mout(6,6) ! resultant mass and inertia matrix about ref point REAL(DbKi) :: H( 3,3) ! "anti-symmetric tensor components" from Sadeghi and Incecik - REAL(DbKi) :: tempM( 3,3) - REAL(DbKi) :: tempM2(3,3) - REAL(DbKi) :: Htrans(3,3) - Integer(IntKi) :: I,J +! REAL(DbKi) :: tempM( 3,3) +! REAL(DbKi) :: tempM2(3,3) +! REAL(DbKi) :: Htrans(3,3) +! Integer(IntKi) :: I ! sub-matrix definitions are accordint to | m J | ! | J^T I | @@ -444,8 +446,8 @@ FUNCTION CalcOrientation(phi, beta, gamma) result(R) REAL(DbKi), INTENT ( IN ) :: gamma ! member twist angle REAL(DbKi) :: R(3,3) ! rotation matrix - INTEGER(IntKi) :: errStat - CHARACTER(100) :: errMsg +! INTEGER(IntKi) :: errStat +! CHARACTER(100) :: errMsg REAL(DbKi) :: s1, c1, s2, c2, s3, c3 @@ -920,7 +922,7 @@ SUBROUTINE getWaterKin(p, x, y, z, t, tindex, U, Ud, zeta, PDyn) INTEGER(IntKi) :: ix, iy, iz, it ! indices for interpolation INTEGER(IntKi) :: iz0, iz1 ! special indices for currrent interpolation - INTEGER(IntKi) :: N ! number of rod elements for convenience +! INTEGER(IntKi) :: N ! number of rod elements for convenience Real(SiKi) :: fx, fy, fz, ft ! interpolation fractions Real(DbKi) :: zp ! zprime coordinate used for Wheeler stretching @@ -980,114 +982,114 @@ SUBROUTINE getWaterKin(p, x, y, z, t, tindex, U, Ud, zeta, PDyn) END SUBROUTINE getWaterKin - ! unused routine with old code for taking wave kinematic grid inputs from HydroDyn - SUBROUTINE CopyWaterKinFromHydroDyn(p, InitInp) - - TYPE(MD_InitInputType), INTENT(IN ) :: InitInp ! INTENT(INOUT) : Input data for initialization routine - TYPE(MD_ParameterType), INTENT( OUT) :: p ! INTENT( OUT) : Parameters - - INTEGER(IntKi) :: I, J, K, Itemp - - - ! ----------------------------- Arrays for wave kinematics ----------------------------- - - - ! :::::::::::::: BELOW WILL BE USED EVENTUALLY WHEN WAVE INFO IS AN INPUT :::::::::::::::::: - ! ! The rAll array contains all nodes or reference points in the system - ! ! (x,y,z global coordinates for each) in the order of bodies, rods, points, internal line nodes. - ! - ! ! count the number of nodes to use for passing wave kinematics - ! J=0 - ! ! Body reference point coordinates - ! J = J + p%nBodies - ! ! Rod node coordinates (including ends) - ! DO l = 1, p%nRods - ! J = J + (m%RodList(l)%N + 1) - ! END DO - ! ! Point reference point coordinates - ! J = J + p%nPoints - ! ! Line internal node coordinates - ! DO l = 1, p%nLines - ! J = J + (m%LineList(l)%N - 1) - ! END DO - ! - ! ! allocate all relevant arrays - ! ! allocate state vector and temporary state vectors based on size just calculated - ! ALLOCATE ( y%rAll(3,J), u%U(3,J), u%Ud(3,J), u%zeta(J), u%PDyn(J), STAT = ErrStat ) - ! IF ( ErrStat /= ErrID_None ) THEN - ! ErrMsg = ' Error allocating wave kinematics vectors.' - ! RETURN - ! END IF - ! - ! - ! ! go through the nodes and fill in the data (this should maybe be turned into a global function) - ! J=0 - ! ! Body reference point coordinates - ! DO I = 1, p%nBodies - ! J = J + 1 - ! y%rAll(:,J) = m%BodyList(I)%r6(1:3) - ! END DO - ! ! Rod node coordinates - ! DO I = 1, p%nRods - ! DO K = 0,m%RodList(I)%N - ! J = J + 1 - ! y%rAll(:,J) = m%RodList(I)%r(:,K) - ! END DO - ! END DO - ! ! Point reference point coordinates - ! DO I = 1, p%nPoints - ! J = J + 1 - ! y%rAll(:,J) = m%PointList(I)%r - ! END DO - ! ! Line internal node coordinates - ! DO I = 1, p%nLines - ! DO K = 1,m%LineList(I)%N-1 - ! J = J + 1 - ! y%rAll(:,J) = m%LineList(I)%r(:,K) - ! END DO - ! END DO - ! :::::::::::::::: the above might be used eventually. For now, let's store wave info grids within this module ::::::::::::::::: - - - ! ----- copy wave grid data over from HydroDyn (as was done in USFLOWT branch) ----- - - ! get grid and time info (currently this is hard-coded to match what's in HydroDyn_Input - ! DO I=1,p%nzWave - ! p%pz(I) = 1.0 - 2.0**(p%nzWave-I) ! -127, -63, -31, -15, -7, -3, -1, 0 - ! END DO - ! DO J = 1,p%nyWave - ! p%py(J) = WaveGrid_y0 + WaveGrid_dy*(J-1) - ! END DO - ! DO K = 1,p%nxWave - ! p%px(K) = WaveGrid_x0 + WaveGrid_dx*(K-1) - ! END DO - ! - ! p%tWave = InitInp%WaveTime - - DO I=1,p%nzWave - DO J = 1,p%nyWave - DO K = 1,p%nxWave - Itemp = (I-1)*p%nxWave*p%nyWave + (J-1)*p%nxWave + K ! index of actual node on 3D grid - - p%uxWave (:,I,J,K) = InitInp%WaveVel( :,Itemp,1) ! note: indices are t, z, y, x - p%uyWave (:,I,J,K) = InitInp%WaveVel( :,Itemp,2) - p%uzWave (:,I,J,K) = InitInp%WaveVel( :,Itemp,3) - p%axWave (:,I,J,K) = InitInp%WaveAcc( :,Itemp,1) - p%ayWave (:,I,J,K) = InitInp%WaveAcc( :,Itemp,2) - p%azWave (:,I,J,K) = InitInp%WaveAcc( :,Itemp,3) - p%PDyn( :,I,J,K) = InitInp%WavePDyn(:,Itemp) - END DO - END DO - END DO - - DO J = 1,p%nyWave - DO K = 1,p%nxWave - Itemp = (J-1)*p%nxWave + K ! index of actual node on surface 2D grid - p%zeta(:,J,K) = InitInp%WaveElev(:,Itemp) - END DO - END DO - - END SUBROUTINE CopyWaterKinFromHydroDyn + !! ! unused routine with old code for taking wave kinematic grid inputs from HydroDyn + !! SUBROUTINE CopyWaterKinFromHydroDyn(p, InitInp) + !! + !! TYPE(MD_InitInputType), INTENT(IN ) :: InitInp ! INTENT(INOUT) : Input data for initialization routine + !! TYPE(MD_ParameterType), INTENT( OUT) :: p ! INTENT( OUT) : Parameters + !! + !! INTEGER(IntKi) :: I, J, K, Itemp + !! + !! + !! ! ----------------------------- Arrays for wave kinematics ----------------------------- + !! + !! + !!! :::::::::::::: BELOW WILL BE USED EVENTUALLY WHEN WAVE INFO IS AN INPUT :::::::::::::::::: + !!! ! The rAll array contains all nodes or reference points in the system + !!! ! (x,y,z global coordinates for each) in the order of bodies, rods, points, internal line nodes. + !!! + !!! ! count the number of nodes to use for passing wave kinematics + !!! J=0 + !!! ! Body reference point coordinates + !!! J = J + p%nBodies + !!! ! Rod node coordinates (including ends) + !!! DO l = 1, p%nRods + !!! J = J + (m%RodList(l)%N + 1) + !!! END DO + !!! ! Point reference point coordinates + !!! J = J + p%nConnects + !!! ! Line internal node coordinates + !!! DO l = 1, p%nLines + !!! J = J + (m%LineList(l)%N - 1) + !!! END DO + !!! + !!! ! allocate all relevant arrays + !!! ! allocate state vector and temporary state vectors based on size just calculated + !!! ALLOCATE ( y%rAll(3,J), u%U(3,J), u%Ud(3,J), u%zeta(J), u%PDyn(J), STAT = ErrStat ) + !!! IF ( ErrStat /= ErrID_None ) THEN + !!! ErrMsg = ' Error allocating wave kinematics vectors.' + !!! RETURN + !!! END IF + !!! + !!! + !!! ! go through the nodes and fill in the data (this should maybe be turned into a global function) + !!! J=0 + !!! ! Body reference point coordinates + !!! DO I = 1, p%nBodies + !!! J = J + 1 + !!! y%rAll(:,J) = m%BodyList(I)%r6(1:3) + !!! END DO + !!! ! Rod node coordinates + !!! DO I = 1, p%nRods + !!! DO K = 0,m%RodList(I)%N + !!! J = J + 1 + !!! y%rAll(:,J) = m%RodList(I)%r(:,K) + !!! END DO + !!! END DO + !!! ! Point reference point coordinates + !!! DO I = 1, p%nConnects + !!! J = J + 1 + !!! y%rAll(:,J) = m%ConnectList(I)%r + !!! END DO + !!! ! Line internal node coordinates + !!! DO I = 1, p%nLines + !!! DO K = 1,m%LineList(I)%N-1 + !!! J = J + 1 + !!! y%rAll(:,J) = m%LineList(I)%r(:,K) + !!! END DO + !!! END DO + !! ! :::::::::::::::: the above might be used eventually. For now, let's store wave info grids within this module ::::::::::::::::: + !! + !! + !! ! ----- copy wave grid data over from HydroDyn (as was done in USFLOWT branch) ----- + !! + !! ! get grid and time info (currently this is hard-coded to match what's in HydroDyn_Input + !! ! DO I=1,p%nzWave + !! ! p%pz(I) = 1.0 - 2.0**(p%nzWave-I) ! -127, -63, -31, -15, -7, -3, -1, 0 + !! ! END DO + !! ! DO J = 1,p%nyWave + !! ! p%py(J) = WaveGrid_y0 + WaveGrid_dy*(J-1) + !! ! END DO + !! ! DO K = 1,p%nxWave + !! ! p%px(K) = WaveGrid_x0 + WaveGrid_dx*(K-1) + !! ! END DO + !! ! + !! ! p%tWave = InitInp%WaveTime + !! + !! DO I=1,p%nzWave + !! DO J = 1,p%nyWave + !! DO K = 1,p%nxWave + !! Itemp = (I-1)*p%nxWave*p%nyWave + (J-1)*p%nxWave + K ! index of actual node on 3D grid + !! + !! p%uxWave (:,I,J,K) = InitInp%WaveVel( :,Itemp,1) ! note: indices are t, z, y, x + !! p%uyWave (:,I,J,K) = InitInp%WaveVel( :,Itemp,2) + !! p%uzWave (:,I,J,K) = InitInp%WaveVel( :,Itemp,3) + !! p%axWave (:,I,J,K) = InitInp%WaveAcc( :,Itemp,1) + !! p%ayWave (:,I,J,K) = InitInp%WaveAcc( :,Itemp,2) + !! p%azWave (:,I,J,K) = InitInp%WaveAcc( :,Itemp,3) + !! p%PDyn( :,I,J,K) = InitInp%WavePDyn(:,Itemp) + !! END DO + !! END DO + !! END DO + !! + !! DO J = 1,p%nyWave + !! DO K = 1,p%nxWave + !! Itemp = (J-1)*p%nxWave + K ! index of actual node on surface 2D grid + !! p%zeta(:,J,K) = InitInp%WaveElev(:,Itemp) + !! END DO + !! END DO + !! + !! END SUBROUTINE CopyWaterKinFromHydroDyn ! ----- write wave grid spacing to output file ----- @@ -1099,7 +1101,7 @@ SUBROUTINE WriteWaveGrid(p, ErrStat, ErrMsg) CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None INTEGER(IntKi) :: ErrStat2 - CHARACTER(120) :: ErrMsg2 +! CHARACTER(120) :: ErrMsg2 CHARACTER(120) :: Frmt INTEGER(IntKi) :: UnOut ! for outputing wave kinematics data @@ -1131,8 +1133,9 @@ SUBROUTINE WriteWaveGrid(p, ErrStat, ErrMsg) Frmt = '('//TRIM(Int2LStr(8))//'(A1,e10.4))' WRITE(UnOut,*, IOSTAT=ErrStat2) ( " ", TRIM(Num2LStr(p%pzWave(I))), I=1,p%nzWave ) - CLOSE(UnOut, IOSTAT = ErrStat ) - IF ( ErrStat /= 0 ) THEN + CLOSE(UnOut, IOSTAT = ErrStat2 ) + IF ( ErrStat2 /= 0 ) THEN + ErrStat = ErrID_Severe ErrMsg = 'Error closing wave grid file' END IF @@ -1148,7 +1151,7 @@ SUBROUTINE WriteWaveData(p, ErrStat, ErrMsg) CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None INTEGER(IntKi) :: ErrStat2 - CHARACTER(120) :: ErrMsg2 +! CHARACTER(120) :: ErrMsg2 INTEGER(IntKi) :: UnOut ! for outputing wave kinematics data INTEGER(IntKi) :: I,J,K, l, Itemp @@ -1280,7 +1283,7 @@ SUBROUTINE setupWaterKin(WaterKinString, p, Tmax, ErrStat, ErrMsg) INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None - INTEGER(IntKi) :: I, iIn, ix, iy, iz + INTEGER(IntKi) :: I, iIn, ix, iy, iz, numHdrLn INTEGER(IntKi) :: ntIn ! number of time series inputs from file INTEGER(IntKi) :: UnIn ! unit number for coefficient input file INTEGER(IntKi) :: UnEcho @@ -1299,6 +1302,7 @@ SUBROUTINE setupWaterKin(WaterKinString, p, Tmax, ErrStat, ErrMsg) CHARACTER(120) :: Line CHARACTER(4096) :: entries2 INTEGER(IntKi) :: coordtype + LOGICAL :: dataBegin INTEGER(IntKi) :: NStepWave ! INTEGER(IntKi) :: NStepWave2 ! @@ -1310,7 +1314,7 @@ SUBROUTINE setupWaterKin(WaterKinString, p, Tmax, ErrStat, ErrMsg) REAL(SiKi), ALLOCATABLE :: TmpFFTWaveElev(:) ! Data for the FFT calculation TYPE(FFT_DataType) :: FFT_Data ! the instance of the FFT module we're using - + REAL(SiKi) :: tmpReal ! A temporary real number COMPLEX(SiKi),ALLOCATABLE :: tmpComplex(:) ! A temporary array (0:NStepWave2-1) for FFT use. REAL(SiKi) :: Omega ! Wave frequency (rad/s) @@ -1326,7 +1330,7 @@ SUBROUTINE setupWaterKin(WaterKinString, p, Tmax, ErrStat, ErrMsg) COMPLEX(SiKi), ALLOCATABLE :: WaveVelCHx(:) ! Discrete Fourier transform of the instantaneous horizontal velocity of incident waves before applying stretching at the zi-coordinates for points (m/s) COMPLEX(SiKi), ALLOCATABLE :: WaveVelCHy(:) ! Discrete Fourier transform of the instantaneous horizontal velocity in x-direction of incident waves before applying stretching at the zi-coordinates for points (m/s) COMPLEX(SiKi), ALLOCATABLE :: WaveVelCV( :) ! Discrete Fourier transform of the instantaneous vertical velocity in y-direction of incident waves before applying stretching at the zi-coordinates for points (m/s) - COMPLEX(SiKi) :: WGNC ! Discrete Fourier transform of the realization of a White Gaussian Noise (WGN) time series process with unit variance for the current frequency component (-) +! COMPLEX(SiKi) :: WGNC ! Discrete Fourier transform of the realization of a White Gaussian Noise (WGN) time series process with unit variance for the current frequency component (-) INTEGER(IntKi) :: ErrStatTmp INTEGER(IntKi) :: ErrStat2 @@ -1346,7 +1350,7 @@ SUBROUTINE setupWaterKin(WaterKinString, p, Tmax, ErrStat, ErrMsg) ELSE IF (SCAN(WaterKinString, "abcdfghijklmnopqrstuvwxyzABCDFGHIJKLMNOPQRSTUVWXYZ") == 0) THEN ! If the input has no letters, let's assume it's a number - print *, "ERROR WaveKin option does not currently support numeric entries. It must be a filename." + call WrScr( "ERROR WaveKin option does not currently support numeric entries. It must be a filename." ) p%WaveKin = 0 p%Current = 0 return @@ -1354,7 +1358,7 @@ SUBROUTINE setupWaterKin(WaterKinString, p, Tmax, ErrStat, ErrMsg) ! otherwise interpret the input as a file name to load the bathymetry lookup data from - print *, " The waterKin input contains letters so will load a water kinematics input file" + call WrScr( " The waterKin input contains letters so will load a water kinematics input file" ) ! -------- load water kinematics input file ------------- @@ -1385,14 +1389,17 @@ SUBROUTINE setupWaterKin(WaterKinString, p, Tmax, ErrStat, ErrMsg) READ(UnIn,*, IOSTAT=ErrStat2) coordtype ! get the entry type READ(UnIn,'(A)', IOSTAT=ErrStat2) entries2 ! get entries as string to be processed CALL gridAxisCoords(coordtype, entries2, p%pxWave, p%nxWave, ErrStat2, ErrMsg2) + Call SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, 'MD_getWaterKin') ! Y grid points READ(UnIn,*, IOSTAT=ErrStat2) coordtype ! get the entry type READ(UnIn,'(A)', IOSTAT=ErrStat2) entries2 ! get entries as string to be processed CALL gridAxisCoords(coordtype, entries2, p%pyWave, p%nyWave, ErrStat2, ErrMsg2) + Call SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, 'MD_getWaterKin') ! Z grid points READ(UnIn,*, IOSTAT=ErrStat2) coordtype ! get the entry type READ(UnIn,'(A)', IOSTAT=ErrStat2) entries2 ! get entries as string to be processed CALL gridAxisCoords(coordtype, entries2, p%pzWave, p%nzWave, ErrStat2, ErrMsg2) + Call SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, 'MD_getWaterKin') ! ----- current ----- CALL ReadCom( UnIn, FileName, 'current header', ErrStat2, ErrMsg2, UnEcho); if(Failed()) return CALL ReadVar( UnIn, FileName, p%Current, 'CurrentMod', 'CurrentMod', ErrStat2, ErrMsg2, UnEcho); if(Failed()) return @@ -1406,7 +1413,7 @@ SUBROUTINE setupWaterKin(WaterKinString, p, Tmax, ErrStat, ErrMsg) EXIT ! break out of the loop if it couldn't read the line (i.e. if at end of file) end if if (i == 100) then - print*,"WARNING: MD can handle a maximum of 100 current profile points" + call WrScr("WARNING: MD can handle a maximum of 100 current profile points") exit end if END DO @@ -1442,7 +1449,7 @@ SUBROUTINE setupWaterKin(WaterKinString, p, Tmax, ErrStat, ErrMsg) ! --------------------- set from inputted wave elevation time series, grid approach ------------------- if (p%WaveKin == 3) then - print *, 'Setting up WaveKin 3 option: read wave elevation time series from file' + call WrScr( 'Setting up WaveKin 3 option: read wave elevation time series from file' ) IF ( LEN_TRIM( WaveKinFile ) == 0 ) THEN CALL SetErrStat( ErrID_Fatal,'WaveKinFile must not be an empty string.',ErrStat, ErrMsg, RoutineName); return @@ -1460,20 +1467,31 @@ SUBROUTINE setupWaterKin(WaterKinString, p, Tmax, ErrStat, ErrMsg) CALL OpenFInpFile ( UnElev, WaveKinFile, ErrStat2, ErrMsg2 ); if(Failed()) return - print *, 'Reading wave elevation data from ', trim(WaveKinFile) + call WrScr( 'Reading wave elevation data from '//trim(WaveKinFile) ) ! Read through length of file to find its length - i = 1 ! start counter + i = 0 ! start line counter + numHdrLn = 0 ! start header-line counter + dataBegin = .FALSE. ! started reading the data section DO READ(UnElev,'(A)',IOSTAT=ErrStat2) Line !read into a line IF (ErrStat2 /= 0) EXIT ! break out of the loop if it couldn't read the line (i.e. if at end of file) i = i+1 + READ(Line,*,IOSTAT=ErrStatTmp) tmpReal + IF (ErrStatTmp/=0) THEN ! Not a number + IF (dataBegin) THEN + CALL SetErrStat( ErrID_Fatal,' Non-data line detected in WaveKinFile past the header lines.',ErrStat, ErrMsg, RoutineName); return + END IF + numHdrLn = numHdrLn + 1 + ELSE + dataBegin = .TRUE. + END IF END DO ! rewind to start of input file to re-read things now that we know how long it is REWIND(UnElev) - ntIn = i-3 ! save number of lines of file + ntIn = i-numHdrLn ! save number of lines of file ! allocate space for input wave elevation array (including time column) @@ -1481,8 +1499,9 @@ SUBROUTINE setupWaterKin(WaterKinString, p, Tmax, ErrStat, ErrMsg) CALL AllocAry(WaveElevIn, ntIn, 'WaveElevIn', ErrStat2, ErrMsg2 ); if(Failed()) return ! read the data in from the file - READ(UnElev,'(A)',IOSTAT=ErrStat2) Line ! skip the first two lines as headers - READ(UnElev,'(A)',IOSTAT=ErrStat2) Line ! + DO i = 1, numHdrLn + READ(UnElev,'(A)',IOSTAT=ErrStat2) Line ! skip header lines + END DO DO i = 1, ntIn READ (UnElev, *, IOSTAT=ErrStat2) WaveTimeIn(i), WaveElevIn(i) @@ -1494,8 +1513,12 @@ SUBROUTINE setupWaterKin(WaterKinString, p, Tmax, ErrStat, ErrMsg) ! Close the inputs file CLOSE ( UnElev ) + + IF (WaveTimeIn(1) .NE. 0.0) THEN + CALL SetErrStat( ErrID_Fatal, ' MoorDyn WaveElev time series should start at t = 0 seconds.',ErrStat, ErrMsg, RoutineName); return + ENDIF - print *, "Read ", ntIn, " time steps from input file." + call WrScr( "Read "//trim(num2lstr(ntIn))//" time steps from input file." ) ! if (WaveTimeIn(ntIn) < TMax) then <<<< need to handle if time series is too short? @@ -1705,49 +1728,58 @@ SUBROUTINE gridAxisCoords(coordtype, entries, coordarray, n, ErrStat, ErrMsg) REAL(ReKi) :: tempArray (100) REAL(ReKi) :: dx INTEGER(IntKi) :: nEntries, I - - ! get array of coordinate entries - CALL stringToArray(entries, nEntries, tempArray) - - ! set number of coordinates - if ( coordtype==0) then ! 0: not used - make one grid point at zero - n = 1; - else if (coordtype==1) then ! 1: list values in ascending order - n = nEntries - else if (coordtype==2) then ! 2: uniform specified by -xlim, xlim, num - n = int(tempArray(3)) - else - print *, "Error: invalid coordinate type specified to gridAxisCoords" - end if - - ! allocate coordinate array - CALL AllocAry(coordarray, n, 'x,y, or z grid points' , ErrStat, ErrMsg) - !ALLOCATE ( coordarray(n), STAT=ErrStat) - - ! fill in coordinates - if ( coordtype==0) then - coordarray(1) = 0.0_ReKi - - else if (coordtype==1) then - coordarray(1:n) = tempArray(1:n) - - else if (coordtype==2) then - coordarray(1) = tempArray(1) - coordarray(n) = tempArray(2) - dx = (coordarray(n)-coordarray(0))/REAL(n-1) - do i=2,n-1 - coordarray(i) = coordarray(1) + REAL(i)*dx - end do - - else - print *, "Error: invalid coordinate type specified to gridAxisCoords" - end if - - print *, "Set water grid coordinates to :" - DO i=1,n - print *, " ", coordarray(i) - end do - + + IF (len(trim(entries)) == len(entries)) THEN + call WrScr("Warning: Only 120 characters read from wave grid coordinates") + END IF + + IF (entries(len(entries):len(entries)) == ',') THEN + ErrStat = ErrID_Fatal + ErrMsg = 'Last character of wave grid coordinate list cannot be comma' + ELSE + ! get array of coordinate entries + CALL stringToArray(entries, nEntries, tempArray) + + ! set number of coordinates + if ( coordtype==0) then ! 0: not used - make one grid point at zero + n = 1; + else if (coordtype==1) then ! 1: list values in ascending order + n = nEntries + else if (coordtype==2) then ! 2: uniform specified by -xlim, xlim, num + n = int(tempArray(3)) + else + call WrScr("Error: invalid coordinate type specified to gridAxisCoords") + end if + + ! allocate coordinate array + CALL AllocAry(coordarray, n, 'x,y, or z grid points' , ErrStat, ErrMsg) + !ALLOCATE ( coordarray(n), STAT=ErrStat) + + ! fill in coordinates + if ( coordtype==0) then + coordarray(1) = 0.0_ReKi + + else if (coordtype==1) then + coordarray(1:n) = tempArray(1:n) + + else if (coordtype==2) then + coordarray(1) = tempArray(1) + coordarray(n) = tempArray(2) + dx = (coordarray(n)-coordarray(1))/REAL(n-1) + do i=2,n + coordarray(i) = coordarray(i-1) + dx + end do + + else + call WrScr("Error: invalid coordinate type specified to gridAxisCoords") + end if + + ! print *, "Set water grid coordinates to :" + ! DO i=1,n + ! print *, " ", coordarray(i) + ! end do + END IF + END SUBROUTINE gridAxisCoords @@ -1775,7 +1807,7 @@ SUBROUTINE stringToArray(instring, n, outarray) END IF n = n + 1 if (n > 100) then - print *, "ERROR - stringToArray cannot do more than 100 entries" + call WrScr( "ERROR - stringToArray cannot do more than 100 entries") end if READ(instring(pos1:pos1+pos2-2), *) outarray(n) diff --git a/modules/moordyn/src/MoorDyn_Point.f90 b/modules/moordyn/src/MoorDyn_Point.f90 index 771b3a0cbf..c304c242ca 100644 --- a/modules/moordyn/src/MoorDyn_Point.f90 +++ b/modules/moordyn/src/MoorDyn_Point.f90 @@ -97,24 +97,18 @@ SUBROUTINE Point_SetKinematics(Point, r_in, rd_in, a_in, t, m) Point%time = t - ! if (Point%typeNum==0) THEN ! anchor ( <<< to be changed/expanded) ... in MoorDyn F also used for coupled points - - ! set position and velocity - Point%r = r_in - Point%rd = rd_in - Point%a = a_in - - ! pass latest kinematics to any attached lines - DO l=1,Point%nAttached - CALL Line_SetEndKinematics(m%LineList(Point%attached(l)), Point%r, Point%rd, t, Point%Top(l)) - END DO - - ! else - ! - ! PRINT*,"Error: setKinematics called for wrong Point type. Point ", Point%IdNum, " type ", Point%typeNum - - ! END IF - + + ! set position and velocity + Point%r = r_in + Point%rd = rd_in + Point%a = a_in + + ! pass latest kinematics to any attached lines + DO l=1,Point%nAttached + CALL Line_SetEndKinematics(m%LineList(Point%attached(l)), Point%r, Point%rd, t, Point%Top(l)) + END DO + + END SUBROUTINE Point_SetKinematics !-------------------------------------------------------------- @@ -161,8 +155,8 @@ SUBROUTINE Point_GetStateDeriv(Point, Xd, m, p) !INTEGER(IntKi) :: l ! index of attached lines INTEGER(IntKi) :: J ! index - INTEGER(IntKi) :: K ! index - Real(DbKi) :: Sum1 ! for adding things +! INTEGER(IntKi) :: K ! index +! Real(DbKi) :: Sum1 ! for adding things Real(DbKi) :: S(3,3) ! inverse mass matrix @@ -215,9 +209,9 @@ SUBROUTINE Point_DoRHS(Point, m, p) !TYPE(MD_MiscVarType), INTENT(INOUT) :: m ! misc/optimization variables INTEGER(IntKi) :: l ! index of attached lines - INTEGER(IntKi) :: I ! index +! INTEGER(IntKi) :: I ! index INTEGER(IntKi) :: J ! index - INTEGER(IntKi) :: K ! index +! INTEGER(IntKi) :: K ! index Real(DbKi) :: Fnet_i(3) ! force from an attached line Real(DbKi) :: Moment_dummy(3) ! dummy vector to hold unused line end moments @@ -320,16 +314,19 @@ END SUBROUTINE Point_GetCoupledForce ! calculate the force and mass contributions of the point on the parent body (only for type 3 points?) !-------------------------------------------------------------- - SUBROUTINE Point_GetNetForceAndMass(Point, rRef, Fnet_out, M_out, m, p) + SUBROUTINE Point_GetNetForceAndMass(Point, rRef, wRef, Fnet_out, M_out, m, p) Type(MD_Point), INTENT(INOUT) :: Point ! the Point object Real(DbKi), INTENT(IN ) :: rRef(3) ! global coordinates of reference point (i.e. the parent body) + Real(DbKi), INTENT(IN ) :: wRef(3) ! global angular velocities of reference point (i.e. the parent body) Real(DbKi), INTENT( OUT) :: Fnet_out(6) ! force and moment vector about rRef Real(DbKi), INTENT( OUT) :: M_out(6,6) ! mass and inertia matrix about rRef TYPE(MD_MiscVarType), INTENT(INOUT) :: m ! passing along all mooring objects TYPE(MD_ParameterType),INTENT(IN ) :: p ! Parameters Real(DbKi) :: rRel( 3) ! position of point relative to the body reference point (global orientation frame) + Real(DbKi) :: Fcentripetal(3) ! centripetal force + Real(DbKi) :: Mcentripetal(3) ! centripetal moment CALL Point_DoRHS(Point, m, p) @@ -338,10 +335,17 @@ SUBROUTINE Point_GetNetForceAndMass(Point, rRef, Fnet_out, M_out, m, p) ! convert net force into 6dof force about body ref point CALL translateForce3to6DOF(rRel, Point%Fnet, Fnet_out) - + ! convert mass matrix to 6by6 mass matrix about body ref point CALL translateMass3to6DOF(rRel, Point%M, M_out) + ! add in the centripetal force and moment on the body. If rRel is zero there will be no translational centripetal component + Fcentripetal = - MATMUL(M_out(1:3,1:3), CROSS_PRODUCT(wRef, CROSS_PRODUCT(wRef,rRel))) + Mcentripetal = - CROSS_PRODUCT(wRef, MATMUL(M_out(4:6,4:6), wRef)) + + Fnet_out(1:3) = Fnet_out(1:3) + Fcentripetal + Fnet_out(4:6) = Fnet_out(4:6) + Mcentripetal + END SUBROUTINE Point_GetNetForceAndMass @@ -362,7 +366,7 @@ SUBROUTINE Point_AddLine(Point, lineID, TopOfLine) Point%Attached(Point%nAttached) = lineID Point%Top(Point%nAttached) = TopOfLine ! attached to line ... 1 = top/fairlead(end B), 0 = bottom/anchor(end A) ELSE - Print*, "Too many lines connected to Point ", Point%IdNum, " in MoorDyn!" + call WrScr("Too many lines connected to Point "//trim(num2lstr(Point%IdNum))//" in MoorDyn!") END IF END SUBROUTINE Point_AddLine @@ -379,6 +383,9 @@ SUBROUTINE Point_RemoveLine(Point, lineID, TopOfLine, rEnd, rdEnd) REAL(DbKi), INTENT(INOUT) :: rdEnd(3) Integer(IntKi) :: l,m,J + logical :: found + + found = .false. DO l = 1,Point%nAttached ! look through attached lines @@ -386,7 +393,7 @@ SUBROUTINE Point_RemoveLine(Point, lineID, TopOfLine, rEnd, rdEnd) TopOfLine = Point%Top(l); ! record which end of the line was attached - DO m = l,Point%nAttached-1 + DO m = l,Point%nAttached Point%Attached(m) = Point%Attached(m+1) ! move subsequent line links forward one spot in the list to eliminate this line link Point%Top( m) = Point%Top(m+1) @@ -399,18 +406,20 @@ SUBROUTINE Point_RemoveLine(Point, lineID, TopOfLine, rEnd, rdEnd) rdEnd(J) = Point%rd(J) END DO - print*, "Detached line ", lineID, " from Point ", Point%IdNum + call WrScr( "Detached line "//trim(num2lstr(lineID))//" from Point "//trim(num2lstr(Point%IdNum))) EXIT END DO - IF (l == Point%nAttached) THEN ! detect if line not found - print *, "Error: failed to find line to remove during removeLineFromPoint call to point ", Point%IdNum, ". Line ", lineID - END IF + found = .true. END IF END DO + + IF (.not. found) THEN ! detect if line not found TODO: fix this, its wrong. If pointNnattached is oprginally 2, then it will be 1 after one run of the loop and l will also be 1 + CALL WrScr("Error: failed to find line to remove during RemoveLine call to Point "//trim(num2lstr(Point%IdNum))//". Line "//trim(num2lstr(lineID))) + END IF END SUBROUTINE Point_RemoveLine diff --git a/modules/moordyn/src/MoorDyn_Registry.txt b/modules/moordyn/src/MoorDyn_Registry.txt index 7965106d56..7f9011f9c7 100644 --- a/modules/moordyn/src/MoorDyn_Registry.txt +++ b/modules/moordyn/src/MoorDyn_Registry.txt @@ -41,12 +41,6 @@ typedef ^ ^ Logical VisMeshes - .FA #typedef ^ ^ DbKi zetaGrid {:}{:} - - "water surface elevations time series at each grid point" - #typedef ^ ^ DbKi PDynGrid {:}{:} - - "water dynamic pressure time series at each grid point" - -typedef ^ ^ ReKi WaveVel {:}{:}{:} - - "" - -typedef ^ ^ ReKi WaveAcc {:}{:}{:} - - "" - -typedef ^ ^ ReKi WavePDyn {:}{:} - - "" - -typedef ^ ^ ReKi WaveElev {:}{:} - - "" - -typedef ^ ^ DbKi WaveTime {:} - - "Should this be double precision?" - - # nvm # Farm-level simulation inputs - these are passed by FAST.Farm - the arrays are populated from the individual turbine-level MoorDyn instances # nvm typedef ^ ^ MeshType FarmCoupledKinematics {:} - - "array of input kinematics meshes from each of the turbine-level MoorDyn instances" "[m, m/s]" # nvm typedef ^ ^ IntKi FarmNCpldBodies {:} - - "" "" @@ -61,6 +55,8 @@ typedef ^ ^ DbKi d - typedef ^ ^ DbKi w - - - "per-length weight in air" "[kg/m]" typedef ^ ^ DbKi EA - - - "axial stiffness" "[N]" typedef ^ ^ DbKi EA_D - - - "axial stiffness" "[N]" +typedef ^ ^ DbKi alphaMBL - - - "dynamic stiffness constant: Krd alpha term x MBL" "[N]" +typedef ^ ^ DbKi vbeta - - - "dynamic stiffness Lm slope: Krd beta term (to be multiplied by mean load)" "[N]" typedef ^ ^ DbKi BA - - - "internal damping coefficient times area" "[N-s]" typedef ^ ^ DbKi BA_D - - - "internal damping coefficient times area" "[N-s]" typedef ^ ^ DbKi EI - - - "bending stiffness" "[N-m]" @@ -68,14 +64,14 @@ typedef ^ ^ DbKi Can - typedef ^ ^ DbKi Cat - - - "tangential added mass coefficient" typedef ^ ^ DbKi Cdn - - - "transverse drag coefficient" typedef ^ ^ DbKi Cdt - - - "tangential drag coefficient" -typedef ^ ^ IntKi ElasticMod - - - "Which elasticity model to use: {0 basic, 1 viscoelastic, 2 future SYCOM} " - -typedef ^ ^ IntKi nEApoints - 0 - "number of values in stress-strain lookup table (0 means using constant E)" +typedef ^ ^ IntKi ElasticMod - - - "Which elasticity model to use: {1 basic, 2 viscoelastic, 3 viscoelastic+meanload} " - +typedef ^ ^ IntKi nEApoints - - - "number of values in stress-strain lookup table (0 means using constant E)" typedef ^ ^ DbKi stiffXs {30} - - "x array for stress-strain lookup table (up to nCoef)" typedef ^ ^ DbKi stiffYs {30} - - "y array for stress-strain lookup table" -typedef ^ ^ IntKi nBApoints - 0 - "number of values in stress-strainrate lookup table (0 means using constant c)" +typedef ^ ^ IntKi nBApoints - - - "number of values in stress-strainrate lookup table (0 means using constant c)" typedef ^ ^ DbKi dampXs {30} - - "x array for stress-strainrate lookup table (up to nCoef)" -typedef ^ ^ DbKi dampYs {30} - - "y array for stress-strainrate lookup table " -typedef ^ ^ IntKi nEIpoints - 0 - "number of values in bending stress-strain lookup table (0 means using constant E)" +typedef ^ ^ DbKi dampYs {30} - - "y array for stress-strainrate lookup table" +typedef ^ ^ IntKi nEIpoints - - - "number of values in bending stress-strain lookup table (0 means using constant E)" typedef ^ ^ DbKi bstiffXs {30} - - "x array for stress-strain lookup table (up to nCoef)" typedef ^ ^ DbKi bstiffYs {30} - - "y array for stress-strain lookup table" @@ -90,14 +86,16 @@ typedef ^ ^ DbKi Cdn - typedef ^ ^ DbKi Cdt - - - "tangential drag coefficient" typedef ^ ^ DbKi CdEnd - - - "drag coefficient for rod end" "[-]" typedef ^ ^ DbKi CaEnd - - - "added mass coefficient for rod end" "[-]" +typedef ^ ^ DbKi LinDamp - - - "Linear damping, transverse damping for body element" "[N/(m/s)/m]" +typedef ^ ^ LOGICAL isLinDamp - - - "Linear damping, transverse damping for body element is used" "-" # this is the Body type, which holds data for each body object typedef ^ MD_Body IntKi IdNum - - - "integer identifier of this Point" -typedef ^ ^ IntKi typeNum - - - "integer identifying the type. 0=free, 1=fixed, -1=vessel" +typedef ^ ^ IntKi typeNum - - - "integer identifying the type. 0=free, 1=fixed, -1=coupled, 2=coupledpinned" typedef ^ ^ IntKi AttachedC {30} - - "list of IdNums of points attached to this body" typedef ^ ^ IntKi AttachedR {30} - - "list of IdNums of rods attached to this body" -typedef ^ ^ IntKi nAttachedC - 0 - "number of attached points" -typedef ^ ^ IntKi nAttachedR - 0 - "number of attached rods" +typedef ^ ^ IntKi nAttachedC - - - "number of attached points" +typedef ^ ^ IntKi nAttachedR - - - "number of attached rods" typedef ^ ^ DbKi rPointRel {3}{30} - - "relative position of point on body" typedef ^ ^ DbKi r6RodRel {6}{30} - - "relative position and orientation of rod on body" typedef ^ ^ DbKi bodyM - - - "body mass (seperate from attached objects)" "[kg]" @@ -122,10 +120,10 @@ typedef ^ ^ DbKi rCG {3} # this is the Point type, which holds data for each point object typedef ^ MD_Point IntKi IdNum - - - "integer identifier of this point" typedef ^ ^ CHARACTER(10) type - - - "type of point: fix, vessel, point" -typedef ^ ^ IntKi typeNum - - - "integer identifying the type. 1=fixed, -1=vessel, 0=free" +typedef ^ ^ IntKi typeNum - - - "integer identifying the type. 1=fixed, -1=coupled, 0=free" typedef ^ ^ IntKi Attached {10} - - "list of IdNums of lines attached to this point node" typedef ^ ^ IntKi Top {10} - - "list of ints specifying whether each line is attached at 1 = top/fairlead(end B), 0 = bottom/anchor(end A)" -typedef ^ ^ IntKi nAttached - 0 - "number of attached lines" +typedef ^ ^ IntKi nAttached - - - "number of attached lines" typedef ^ ^ DbKi pointM - - - "point mass" "[kg]" typedef ^ ^ DbKi pointV - - - "point volume" "[m^3]" typedef ^ ^ DbKi pointFX - - - "" @@ -148,13 +146,13 @@ typedef ^ ^ DbKi M {3}{3} typedef ^ MD_Rod IntKi IdNum - - - "integer identifier of this Line" typedef ^ ^ CHARACTER(10) type - - - "type of Rod. should match one of RodProp names" typedef ^ ^ IntKi PropsIdNum - - - "the IdNum of the associated rod properties" - -typedef ^ ^ IntKi typeNum - - - "integer identifying the type. 0=fixed, 1=vessel, 2=point" +typedef ^ ^ IntKi typeNum - - - "integer identifying the type. 0=free, 1=pinned, 2=fixed, -1=coupledpinned, -2=coupled" typedef ^ ^ IntKi AttachedA {10} - - "list of IdNums of lines attached to end A" typedef ^ ^ IntKi AttachedB {10} - - "list of IdNums of lines attached to end B" typedef ^ ^ IntKi TopA {10} - - "list of ints specifying whether each line is attached at 1 = top/fairlead(end B), 0 = bottom/anchor(end A)" typedef ^ ^ IntKi TopB {10} - - "list of ints specifying whether each line is attached at 1 = top/fairlead(end B), 0 = bottom/anchor(end A)" -typedef ^ ^ IntKi nAttachedA - 0 - "number of attached lines to Rod end A" -typedef ^ ^ IntKi nAttachedB - 0 - "number of attached lines to Rod end B" +typedef ^ ^ IntKi nAttachedA - - - "number of attached lines to Rod end A" +typedef ^ ^ IntKi nAttachedB - - - "number of attached lines to Rod end B" typedef ^ ^ IntKi OutFlagList {20} - - "array specifying what line quantities should be output (1 vs 0)" - typedef ^ ^ IntKi N - - - "The number of elements in the line" - typedef ^ ^ IntKi endTypeA - - - "type of point at end A: 0=pinned to Point, 1=cantilevered to Rod." - @@ -169,6 +167,8 @@ typedef ^ ^ DbKi Cdn - typedef ^ ^ DbKi Cdt - - - "" "[-]" typedef ^ ^ DbKi CdEnd - - - "drag coefficient for rod end" "[-]" typedef ^ ^ DbKi CaEnd - - - "added mass coefficient for rod end" "[-]" +typedef ^ ^ DbKi LinDamp - - - "Linear damping, transverse damping for rod element" "[N/(m/s)/m]" +typedef ^ ^ LOGICAL isLinDamp - - - "Linear damping, transverse damping for rod element is used" "-" typedef ^ ^ DbKi time - - - "current time" "[s]" typedef ^ ^ DbKi roll - - - "roll relative to vertical" "[rad]" typedef ^ ^ DbKi pitch - - - "pitch relative to vertical" "[rad]" @@ -200,6 +200,7 @@ typedef ^ ^ DbKi v6 {6} typedef ^ ^ DbKi a6 {6} - - "6 DOF acceleration vector (only used for coupled Rods)" - typedef ^ ^ DbKi F6net {6} - - "total force and moment about end A (excluding inertial loads) that Rod may exert on whatever it's attached to" typedef ^ ^ DbKi M6net {6}{6} - - "total mass matrix about end A of Rod and any attached Points" +typedef ^ ^ DbKi Imat {3}{3} - - "inertia about CG in global frame" typedef ^ ^ DbKi OrMat {3}{3} - - "DCM for body orientation" typedef ^ ^ IntKi RodUnOut - - - "unit number of rod output file" typedef ^ ^ DbKi RodWrOutput {:} - - "one row of output data for this rod" @@ -211,7 +212,7 @@ typedef ^ MD_Line IntKi IdNum - typedef ^ ^ IntKi PropsIdNum - - - "the IdNum of the associated line properties" - typedef ^ ^ IntKi ElasticMod - - - "Which elasticity model to use: {0 basic, 1 viscoelastic, 2 future SYCOM} " - typedef ^ ^ IntKi OutFlagList {20} - - "array specifying what line quantities should be output (1 vs 0)" - -typedef ^ ^ IntKi CtrlChan - 0 - "index of control channel that will drive line active tensioning (0 for none)" - +typedef ^ ^ IntKi CtrlChan - - - "index of control channel that will drive line active tensioning (0 for none)" - typedef ^ ^ IntKi FairPoint - - - "IdNum of Point at fairlead" typedef ^ ^ IntKi AnchPoint - - - "IdNum of Point at anchor" typedef ^ ^ IntKi N - - - "The number of elements in the line" - @@ -220,22 +221,24 @@ typedef ^ ^ IntKi endTypeB - typedef ^ ^ DbKi UnstrLen - - - "unstretched length of the line" - typedef ^ ^ DbKi rho - - - "density" "[kg/m3]" typedef ^ ^ DbKi d - - - "volume-equivalent diameter" "[m]" -typedef ^ ^ DbKi EA - 0 - "stiffness" "[N]" -typedef ^ ^ DbKi EA_D - 0 - "dynamic stiffness when using viscoelastic model" "[N]" -typedef ^ ^ DbKi BA - 0 - "internal damping coefficient times area for this line only" "[N-s]" -typedef ^ ^ DbKi BA_D - 0 - "dynamic internal damping coefficient times area when using viscoelastic model" "[N-s]" -typedef ^ ^ DbKi EI - 0 - "bending stiffness" "[N-m]" +typedef ^ ^ DbKi EA - - - "stiffness" "[N]" +typedef ^ ^ DbKi EA_D - - - "constant dynamic stiffness when using viscoelastic model" "[N]" +typedef ^ ^ DbKi alphaMBL - - - "load dependent dynamic stiffness constant: Krd alpha term x MBL" "[N]" +typedef ^ ^ DbKi vbeta - - - "load dependent dynamic stiffness Lm slope: Krd beta term (to be multiplied by mean load)" "[N]" +typedef ^ ^ DbKi BA - - - "internal damping coefficient times area for this line only" "[N-s]" +typedef ^ ^ DbKi BA_D - - - "dynamic internal damping coefficient times area when using viscoelastic model" "[N-s]" +typedef ^ ^ DbKi EI - - - "bending stiffness" "[N-m]" typedef ^ ^ DbKi Can - - - "" "[-]" typedef ^ ^ DbKi Cat - - - "" "[-]" typedef ^ ^ DbKi Cdn - - - "" "[-]" typedef ^ ^ DbKi Cdt - - - "" "[-]" -typedef ^ ^ IntKi nEApoints - 0 - "number of values in stress-strain lookup table (0 means using constant E)" +typedef ^ ^ IntKi nEApoints - - - "number of values in stress-strain lookup table (0 means using constant E)" typedef ^ ^ DbKi stiffXs {30} - - "x array for stress-strain lookup table (up to nCoef)" typedef ^ ^ DbKi stiffYs {30} - - "y array for stress-strain lookup table" -typedef ^ ^ IntKi nBApoints - 0 - "number of values in stress-strainrate lookup table (0 means using constant c)" +typedef ^ ^ IntKi nBApoints - - - "number of values in stress-strainrate lookup table (0 means using constant c)" typedef ^ ^ DbKi dampXs {30} - - "x array for stress-strainrate lookup table (up to nCoef)" -typedef ^ ^ DbKi dampYs {30} - - "y array for stress-strainrate lookup table " -typedef ^ ^ IntKi nEIpoints - 0 - "number of values in bending stress-strain lookup table (0 means using constant E)" +typedef ^ ^ DbKi dampYs {30} - - "y array for stress-strainrate lookup table" +typedef ^ ^ IntKi nEIpoints - - - "number of values in bending stress-strain lookup table (0 means using constant E)" typedef ^ ^ DbKi bstiffXs {30} - - "x array for stress-strain lookup table (up to nCoef)" typedef ^ ^ DbKi bstiffYs {30} - - "y array for stress-strain lookup table" typedef ^ ^ DbKi time - - - "current time" "[s]" @@ -250,6 +253,7 @@ typedef ^ ^ DbKi lstrd {:} typedef ^ ^ DbKi Kurv {:} - - "curvature at each node point" "[1/m]" typedef ^ ^ DbKi dl_1 {:} - - "segment stretch attributed to static stiffness portion" "[m]" typedef ^ ^ DbKi V {:} - - "segment volume" "[m^3]" +typedef ^ ^ DbKi F {:} - - "VOF scalar for each segment (1 = fully submerged, 0 = out of water)" typedef ^ ^ DbKi U {:}{:} - - "water velocity at node" "[m/s]" typedef ^ ^ DbKi Ud {:}{:} - - "water acceleration at node" "[m/s^2]" typedef ^ ^ DbKi zeta {:} - - "water surface elevation above node" "[m]" @@ -271,9 +275,16 @@ typedef ^ ^ DbKi EndMomentB {3} typedef ^ ^ IntKi LineUnOut - - - "unit number of line output file" typedef ^ ^ DbKi LineWrOutput {:} - - "one row of output data for this line" -# this is the Fail type, which holds data for possible line failure descriptors TO BE FILLED IN LATER -typedef ^ MD_Fail IntKi IdNum - - - "integer identifier of this failure" - +# this is the Fail type, which holds data for possible line failure descriptors +typedef ^ MD_Fail IntKi IdNum - - - "integer identifier of this failure" "-" +typedef ^ ^ IntKi attachID - - - "ID of connection or Rod the lines are attached to" "-" +typedef ^ ^ IntKi isRod - - - "1 Rod end A, 2 Rod end B, 0 if point" "-" +typedef ^ ^ IntKi lineIDs {30} - - "array of one or more lines to detach (starting from 1...)" "-" +typedef ^ ^ IntKi lineTops {30} - - "an array that will be FILLED IN to return which end of each line was disconnected ... 1 = top/fairlead(end B), 0 = bottom/anchor(end A)" "-" +typedef ^ ^ IntKi nLinesToDetach - - - "how many lines to dettach" "-" +typedef ^ ^ DbKi failTime - - - "time of failure" "s" +typedef ^ ^ DbKi failTen - - - "tension threshold of failure" "N" +typedef ^ ^ IntKi failStatus - - - "0 not failed yet, 1 failed, 2 invalid" "-" # this is the MDOutParmType - a less literal alternative of the NWTC OutParmType for MoorDyn (to avoid huge lists of possible output channel permutations) typedef ^ MD_OutParmType CHARACTER(10) Name - - - "name of output channel" @@ -339,6 +350,7 @@ typedef ^ ^ IntKi RodStateIsN {:} typedef ^ ^ IntKi BodyStateIs1 {:} - - "starting index of each body's states in state vector" "" typedef ^ ^ IntKi BodyStateIsN {:} - - "ending index of each body's states in state vector" "" typedef ^ ^ IntKi Nx - - - "number of states and size of state vector" "" +typedef ^ ^ IntKi Nxtra - - - "number of states and size of state vector including points for potential line failures" "" typedef ^ ^ IntKi WaveTi - - - "current interpolation index for wave time series data" "" typedef ^ ^ MD_ContinuousStateType xTemp - - - "contains temporary state vector used in integration (put here so it's only allocated once)" typedef ^ ^ MD_ContinuousStateType xdTemp - - - "contains temporary state derivative vector used in integration (put here so it's only allocated once)" @@ -396,6 +408,8 @@ typedef ^ ^ DbKi mu_kT - typedef ^ ^ DbKi mu_kA - - - "axial kinetic friction coefficient" "(-)" typedef ^ ^ DbKi mc - - - "ratio of the static friction coefficient to the kinetic friction coefficient" "(-)" typedef ^ ^ DbKi cv - - - "saturated damping coefficient" "(-)" +typedef ^ ^ IntKi inertialF - 0 - "Indicates MoorDyn returning inertial moments for coupled 6DOF objects. 0: no, 1: yes, 2: yes with ramp to inertialF_rampT" - +typedef ^ ^ R8Ki inertialF_rampT - 30 - "Ramp time for inertial forces" - # --- parameters for wave and current --- typedef ^ ^ IntKi nxWave - - - "number of x wave grid points" - typedef ^ ^ IntKi nyWave - - - "number of y wave grid points" - diff --git a/modules/moordyn/src/MoorDyn_Rod.f90 b/modules/moordyn/src/MoorDyn_Rod.f90 index f7f25e4d93..685f421886 100644 --- a/modules/moordyn/src/MoorDyn_Rod.f90 +++ b/modules/moordyn/src/MoorDyn_Rod.f90 @@ -61,7 +61,7 @@ SUBROUTINE Rod_Setup(Rod, RodProp, endCoords, p, ErrStat, ErrMsg) CHARACTER(*), INTENT( INOUT ) :: ErrMsg ! Error message if ErrStat /= ErrID_None INTEGER(4) :: i ! Generic index - INTEGER(4) :: K ! Generic index +! INTEGER(4) :: K ! Generic index INTEGER(IntKi) :: N Real(DbKi) :: phi, beta, sinPhi, cosPhi, tanPhi, sinBeta, cosBeta ! various orientation things @@ -82,7 +82,8 @@ SUBROUTINE Rod_Setup(Rod, RodProp, endCoords, p, ErrStat, ErrMsg) Rod%Cdt = RodProp%Cdt Rod%CaEnd = RodProp%CaEnd Rod%CdEnd = RodProp%CdEnd - + Rod%linDamp = RodProp%linDamp + Rod%islinDamp = RodProp%islinDamp ! allocate node positions and velocities (NOTE: these arrays start at ZERO) ALLOCATE(Rod%r(3, 0:N), Rod%rd(3, 0:N), STAT=ErrStat2); if(AllocateFailed("")) return @@ -151,24 +152,6 @@ SUBROUTINE Rod_Setup(Rod, RodProp, endCoords, p, ErrStat, ErrMsg) IF (wordy > 0) print *, "Set up Rod ",Rod%IdNum, ", type ", Rod%typeNum - - if (p%writeLog > 1) then - write(p%UnLog, '(A)') " - Rod "//trim(num2lstr(Rod%IdNum)) - write(p%UnLog, '(A)') " ID: "//trim(num2lstr(Rod%IdNum)) - write(p%UnLog, '(A)') " UnstrLen: "//trim(num2lstr(Rod%UnstrLen)) - write(p%UnLog, '(A)') " N : "//trim(num2lstr(Rod%N )) - write(p%UnLog, '(A)') " d : "//trim(num2lstr(Rod%d )) - write(p%UnLog, '(A)') " rho : "//trim(num2lstr(Rod%rho )) - write(p%UnLog, '(A)') " Can : "//trim(num2lstr(Rod%Can )) - write(p%UnLog, '(A)') " Cat : "//trim(num2lstr(Rod%Cat )) - write(p%UnLog, '(A)') " CaEnd: "//trim(num2lstr(Rod%CaEnd )) - write(p%UnLog, '(A)') " Cdn : "//trim(num2lstr(Rod%Cdn )) - write(p%UnLog, '(A)') " Cdt : "//trim(num2lstr(Rod%Cdt )) - write(p%UnLog, '(A)') " CdEnd: "//trim(num2lstr(Rod%CdEnd )) - !write(p%UnLog, '(A)') " ww_l: " << ( (rho - env->rho_w)*(pi/4.*d*d) )*9.81 << endl; - end if - - ! need to add cleanup sub <<< @@ -199,9 +182,9 @@ SUBROUTINE Rod_Initialize(Rod, states, m) TYPE(MD_MiscVarType), INTENT(INOUT) :: m ! passing along all mooring objects - INTEGER(IntKi) :: l ! index of segments or nodes along line - REAL(DbKi) :: rRef(3) ! reference position of mesh node - REAL(DbKi) :: OrMat(3,3) ! DCM for body orientation based on r6_in +! INTEGER(IntKi) :: l ! index of segments or nodes along line +! REAL(DbKi) :: rRef(3) ! reference position of mesh node +! REAL(DbKi) :: OrMat(3,3) ! DCM for body orientation based on r6_in IF (wordy > 0) print *, "initializing Rod ", Rod%idNum @@ -250,7 +233,7 @@ SUBROUTINE Rod_SetKinematics(Rod, r6_in, v6_in, a6_in, t, m) Real(DbKi), INTENT(IN ) :: t ! instantaneous time TYPE(MD_MiscVarType), INTENT(INOUT) :: m ! passing along all mooring objects - INTEGER(IntKi) :: l +! INTEGER(IntKi) :: l Rod%time = t ! store current time @@ -277,7 +260,7 @@ SUBROUTINE Rod_SetKinematics(Rod, r6_in, v6_in, a6_in, t, m) ! handled, along with passing kinematics to dependent lines, by separate call to setState else - print *, "Error: Rod_SetKinematics called for a free Rod in MoorDyn." ! <<< + Call WrScr("Error: Rod_SetKinematics called for a free Rod in MoorDyn. Rod number"//trim(num2lstr(Rod%IdNum))) ! <<< end if @@ -298,7 +281,7 @@ SUBROUTINE Rod_SetState(Rod, X, t, m) Real(DbKi), INTENT(IN ) :: t ! instantaneous time TYPE(MD_MiscVarType), INTENT(INOUT) :: m ! passing along all mooring objects - INTEGER(IntKi) :: J ! index +! INTEGER(IntKi) :: J ! index ! for a free Rod, there are 12 states: @@ -342,7 +325,7 @@ SUBROUTINE Rod_SetState(Rod, X, t, m) CALL Rod_SetDependentKin(Rod, t, m, .FALSE.) else - print *, "Error: Rod::setState called for a non-free rod type in MoorDyn" ! <<< + Call WrScr("Error: Rod::setState called for a non-free rod type in MoorDyn") ! <<< end if ! update Rod direction unit vector (simply equal to last three entries of r6) @@ -363,13 +346,13 @@ SUBROUTINE Rod_SetDependentKin(Rod, t, m, initial) LOGICAL, INTENT(IN ) :: initial ! true if this is the call during initialization (in which case avoid calling any Lines yet) INTEGER(IntKi) :: l ! index of segments or nodes along line - INTEGER(IntKi) :: J ! index +! INTEGER(IntKi) :: J ! index INTEGER(IntKi) :: N ! number of segments - REAL(DbKi) :: qEnd(3) ! unit vector of attached line end segment, following same direction convention as Rod's q vector +! REAL(DbKi) :: qEnd(3) ! unit vector of attached line end segment, following same direction convention as Rod's q vector REAL(DbKi) :: q_EI_dl(3) ! <<<< add description - REAL(DbKi) :: EIend ! bending stiffness of attached line end segment - REAL(DbKi) :: dlEnd ! stretched length of attached line end segment +! REAL(DbKi) :: EIend ! bending stiffness of attached line end segment +! REAL(DbKi) :: dlEnd ! stretched length of attached line end segment REAL(DbKi) :: qMomentSum(3) ! summation of qEnd*EI/dl_stretched (with correct sign) for each attached line @@ -454,7 +437,7 @@ SUBROUTINE Rod_GetStateDeriv(Rod, Xd, m, p) Real(DbKi) :: acc(6) ! 6DOF acceleration vector about reference point - Real(DbKi) :: Mcpl(3) ! moment in response to end A acceleration due to inertial coupling +! Real(DbKi) :: Mcpl(3) ! moment in response to end A acceleration due to inertial coupling Real(DbKi) :: y_temp (6) ! temporary vector for LU decomposition Real(DbKi) :: LU_temp(6,6) ! temporary matrix for LU decomposition @@ -464,7 +447,7 @@ SUBROUTINE Rod_GetStateDeriv(Rod, Xd, m, p) ! FIXME: should LU_temp be set to M_out before calling LUsolve????? LU_temp = 0.0_DbKi - CALL Rod_GetNetForceAndMass(Rod, Rod%r(:,0), Fnet, M_out, m, p) + CALL Rod_GetNetForceAndMass(Rod, Rod%r(:,0), Rod%v6(4:6), Fnet, M_out, m, p) @@ -491,8 +474,7 @@ SUBROUTINE Rod_GetStateDeriv(Rod, Xd, m, p) ELSE ! pinned rod, 6 states (rotational only) ! account for moment in response to end A acceleration due to inertial coupling (off-diagonal sub-matrix terms) - !Fnet(4:6) = Fnet(4:6) - MATMUL(M_out(4:6,1:3), Rod%a6(1:3)) ! <<>> some of the kinematics parts of this could potentially be moved to a different routine <<< Rod%OrMat = CalcOrientation(phi, beta, 0.0_DbKi) ! get rotation matrix to put things in global rather than rod-axis orientations - Imat = RotateM3(Imat_l, Rod%OrMat) ! rotate to give inertia matrix about CG in global frame + Rod%Imat = RotateM3(Imat_l, Rod%OrMat) ! rotate to give inertia matrix about CG in global frame ! these supplementary inertias can then be added the matrix (these are the terms ASIDE from the parallel axis terms) - Rod%M6net(4:6,4:6) = Rod%M6net(4:6,4:6) + Imat + Rod%M6net(4:6,4:6) = Rod%M6net(4:6,4:6) + Rod%Imat ! now add centripetal and gyroscopic forces/moments, and that should be everything @@ -981,9 +974,9 @@ SUBROUTINE Rod_DoRHS(Rod, m, p) r_c = h_c*Rod%q ! vector to center of mass ! note that Rod%v6(4:6) is the rotational velocity vector, omega - Fcentripetal = 0.0_DbKi !<< 0.0) THEN ! In the case where rRel is zero, this is called at rod end A where the centriptal forces about that point have been accounted for in doRHS + ! Add in the centripetal force and moment on the body. These are valid when referring to the rods COG, hence the reference vector is r_c+rRel. + ! Note that this is centripetal force/moment and gyroscopic term from the rods COG to body while the rod mass and f6 are from end A to body. + h_c = 0.5*Rod%UnstrLen ! distance to center of mass + r_c = h_c*Rod%q ! vector to center of mass + CALL TranslateMass3to6DOF(r_c+rRel, Rod%Imat, I_out) ! translate the COG inertia matrix (no parallel axis terms) about the body ref point + + Fcentripetal = - MATMUL(Rod%M6net(1:3,1:3), CROSS_PRODUCT(wRef, CROSS_PRODUCT(wRef,r_c+rRel))) + Mcentripetal = - CROSS_PRODUCT(wRef, MATMUL(I_out(4:6,4:6), wRef)) + + Fnet_out(1:3) = Fnet_out(1:3) + Fcentripetal + Fnet_out(4:6) = Fnet_out(4:6) + Mcentripetal + ENDIF ! >>> do we need to ensure zero moment is passed if it's pinned? <<< !if (abs(Rod%typeNum)==1) then @@ -1089,7 +1119,7 @@ SUBROUTINE Rod_AddLine(Rod, lineID, TopOfLine, endB) Rod%AttachedB(Rod%nAttachedB) = lineID Rod%TopB(Rod%nAttachedB) = TopOfLine ! attached to line ... 1 = top/fairlead(end B), 0 = bottom/anchor(end A) ELSE - Print*, "too many lines connected to Rod ", Rod%IdNum, " in MoorDyn!" + call WrScr("too many lines connected to Rod "//trim(num2lstr(Rod%IdNum))//" in MoorDyn!") END IF else ! attaching to end A @@ -1101,7 +1131,7 @@ SUBROUTINE Rod_AddLine(Rod, lineID, TopOfLine, endB) Rod%AttachedA(Rod%nAttachedA) = lineID Rod%TopA(Rod%nAttachedA) = TopOfLine ! attached to line ... 1 = top/fairlead(end B), 0 = bottom/anchor(end A) ELSE - Print*, "too many lines connected to Rod ", Rod%IdNum, " in MoorDyn!" + call WrScr("too many lines connected to Rod "//trim(num2lstr(Rod%IdNum))//" in MoorDyn!") END IF end if @@ -1121,6 +1151,7 @@ SUBROUTINE Rod_RemoveLine(Rod, lineID, TopOfLine, endB, rEnd, rdEnd) REAL(DbKi), INTENT(INOUT) :: rdEnd(3) Integer(IntKi) :: l,m,J + Integer(IntKi) :: foundA, foundB = 0 if (endB==1) then ! attaching to end B @@ -1130,7 +1161,7 @@ SUBROUTINE Rod_RemoveLine(Rod, lineID, TopOfLine, endB, rEnd, rdEnd) TopOfLine = Rod%TopB(l); ! record which end of the line was attached - DO m = l,Rod%nAttachedB-1 + DO m = l,Rod%nAttachedB Rod%AttachedB(m) = Rod%AttachedB(m+1) ! move subsequent line links forward one spot in the list to eliminate this line link Rod%TopB( m) = Rod%TopB(m+1) @@ -1143,17 +1174,19 @@ SUBROUTINE Rod_RemoveLine(Rod, lineID, TopOfLine, endB, rEnd, rdEnd) rdEnd(J) = Rod%rd(J,Rod%N) END DO - print*, "Detached line ", lineID, " from Rod ", Rod%IdNum, " end B" + CALL WrScr( "Detached line "//trim(num2lstr(lineID))//" from Rod "//trim(num2lstr(Rod%IdNum))//" end B") EXIT END DO - - IF (l == Rod%nAttachedB) THEN ! detect if line not found - print *, "Error: failed to find line to remove during RemoveLine call to Rod ", Rod%IdNum, ". Line ", lineID - END IF + + foundB = 1 + END IF END DO - + IF (foundB == 0) THEN ! detect if line not found + CALL WrScr("Error: failed to find line to remove during RemoveLine call to Rod "//trim(num2lstr(Rod%IdNum))//" end B. Line "//trim(num2lstr(lineID))) + END IF + else ! attaching to end A DO l = 1,Rod%nAttachedA ! look through attached lines @@ -1162,7 +1195,7 @@ SUBROUTINE Rod_RemoveLine(Rod, lineID, TopOfLine, endB, rEnd, rdEnd) TopOfLine = Rod%TopA(l); ! record which end of the line was attached - DO m = l,Rod%nAttachedA-1 + DO m = l,Rod%nAttachedA Rod%AttachedA(m) = Rod%AttachedA(m+1) ! move subsequent line links forward one spot in the list to eliminate this line link Rod%TopA( m) = Rod%TopA(m+1) @@ -1175,16 +1208,19 @@ SUBROUTINE Rod_RemoveLine(Rod, lineID, TopOfLine, endB, rEnd, rdEnd) rdEnd(J) = Rod%rd(J,0) END DO - print*, "Detached line ", lineID, " from Rod ", Rod%IdNum, " end A" + CALL WrScr( "Detached line "//trim(num2lstr(lineID))//" from Rod "//trim(num2lstr(Rod%IdNum))//" end A") EXIT END DO - - IF (l == Rod%nAttachedA) THEN ! detect if line not found - print *, "Error: failed to find line to remove during RemoveLine call to Rod ", Rod%IdNum, ". Line ", lineID - END IF + + foundA = 1 + END IF END DO + + IF (foundA == 0) THEN ! detect if line not found + CALL WrScr("Error: failed to find line to remove during RemoveLine call to Rod "//trim(num2lstr(Rod%IdNum))//" end A. Line "//trim(num2lstr(lineID))) + END IF end if diff --git a/modules/moordyn/src/MoorDyn_Types.f90 b/modules/moordyn/src/MoorDyn_Types.f90 index debf2292ca..f263cd131f 100644 --- a/modules/moordyn/src/MoorDyn_Types.f90 +++ b/modules/moordyn/src/MoorDyn_Types.f90 @@ -49,153 +49,154 @@ MODULE MoorDyn_Types REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PtfmInit !< initial position of platform(s) shape: 6, nTurbines [-] INTEGER(IntKi) :: FarmSize = 0 !< Indicates normal FAST module mode if 0, FAST.Farm coupled mode and =nTurbines if >0 [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: TurbineRefPos !< reference position of turbines in farm, shape: 3, nTurbines [-] - REAL(ReKi) :: Tmax !< simulation duration [[s]] + REAL(ReKi) :: Tmax = 0.0_ReKi !< simulation duration [[s]] CHARACTER(1024) :: FileName !< MoorDyn input file [-] CHARACTER(1024) :: RootName !< RootName for writing output files [-] LOGICAL :: UsePrimaryInputFile = .TRUE. !< Read input file instead of passed data [-] TYPE(FileInfoType) :: PassedPrimaryInputData !< Primary input file as FileInfoType (set by driver/glue code) -- String array with metadata [-] - LOGICAL :: Echo !< echo parameter - do we want to echo the header line describing the input file? [-] + LOGICAL :: Echo = .false. !< echo parameter - do we want to echo the header line describing the input file? [-] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: OutList !< string containing list of output channels requested in input file [-] LOGICAL :: Linearize = .FALSE. !< Flag that tells this module if the glue code wants to linearize. [-] LOGICAL :: VisMeshes = .FALSE. !< Glue code requesting visualization meshes [-] - REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: WaveVel !< [-] - REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: WaveAcc !< [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: WavePDyn !< [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: WaveElev !< [-] - REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: WaveTime !< Should this be double precision? [-] END TYPE MD_InitInputType ! ======================= ! ========= MD_LineProp ======= TYPE, PUBLIC :: MD_LineProp - INTEGER(IntKi) :: IdNum !< integer identifier of this set of line properties [-] + INTEGER(IntKi) :: IdNum = 0_IntKi !< integer identifier of this set of line properties [-] CHARACTER(20) :: name !< name/identifier of this set of line properties [-] - REAL(DbKi) :: d !< volume-equivalent diameter [[m]] - REAL(DbKi) :: w !< per-length weight in air [[kg/m]] - REAL(DbKi) :: EA !< axial stiffness [[N]] - REAL(DbKi) :: EA_D !< axial stiffness [[N]] - REAL(DbKi) :: BA !< internal damping coefficient times area [[N-s]] - REAL(DbKi) :: BA_D !< internal damping coefficient times area [[N-s]] - REAL(DbKi) :: EI !< bending stiffness [[N-m]] - REAL(DbKi) :: Can !< transverse added mass coefficient [-] - REAL(DbKi) :: Cat !< tangential added mass coefficient [-] - REAL(DbKi) :: Cdn !< transverse drag coefficient [-] - REAL(DbKi) :: Cdt !< tangential drag coefficient [-] - INTEGER(IntKi) :: ElasticMod !< Which elasticity model to use: {0 basic, 1 viscoelastic, 2 future SYCOM} [-] - INTEGER(IntKi) :: nEApoints = 0 !< number of values in stress-strain lookup table (0 means using constant E) [-] - REAL(DbKi) , DIMENSION(1:30) :: stiffXs !< x array for stress-strain lookup table (up to nCoef) [-] - REAL(DbKi) , DIMENSION(1:30) :: stiffYs !< y array for stress-strain lookup table [-] - INTEGER(IntKi) :: nBApoints = 0 !< number of values in stress-strainrate lookup table (0 means using constant c) [-] - REAL(DbKi) , DIMENSION(1:30) :: dampXs !< x array for stress-strainrate lookup table (up to nCoef) [-] - REAL(DbKi) , DIMENSION(1:30) :: dampYs !< y array for stress-strainrate lookup table [-] - INTEGER(IntKi) :: nEIpoints = 0 !< number of values in bending stress-strain lookup table (0 means using constant E) [-] - REAL(DbKi) , DIMENSION(1:30) :: bstiffXs !< x array for stress-strain lookup table (up to nCoef) [-] - REAL(DbKi) , DIMENSION(1:30) :: bstiffYs !< y array for stress-strain lookup table [-] + REAL(DbKi) :: d = 0.0_R8Ki !< volume-equivalent diameter [[m]] + REAL(DbKi) :: w = 0.0_R8Ki !< per-length weight in air [[kg/m]] + REAL(DbKi) :: EA = 0.0_R8Ki !< axial stiffness [[N]] + REAL(DbKi) :: EA_D = 0.0_R8Ki !< axial stiffness [[N]] + REAL(DbKi) :: alphaMBL = 0.0_R8Ki !< dynamic stiffness constant: Krd alpha term x MBL [[N]] + REAL(DbKi) :: vbeta = 0.0_R8Ki !< dynamic stiffness Lm slope: Krd beta term (to be multiplied by mean load) [[N]] + REAL(DbKi) :: BA = 0.0_R8Ki !< internal damping coefficient times area [[N-s]] + REAL(DbKi) :: BA_D = 0.0_R8Ki !< internal damping coefficient times area [[N-s]] + REAL(DbKi) :: EI = 0.0_R8Ki !< bending stiffness [[N-m]] + REAL(DbKi) :: Can = 0.0_R8Ki !< transverse added mass coefficient [-] + REAL(DbKi) :: Cat = 0.0_R8Ki !< tangential added mass coefficient [-] + REAL(DbKi) :: Cdn = 0.0_R8Ki !< transverse drag coefficient [-] + REAL(DbKi) :: Cdt = 0.0_R8Ki !< tangential drag coefficient [-] + INTEGER(IntKi) :: ElasticMod = 0_IntKi !< Which elasticity model to use: {1 basic, 2 viscoelastic, 3 viscoelastic+meanload} [-] + INTEGER(IntKi) :: nEApoints = 0_IntKi !< number of values in stress-strain lookup table (0 means using constant E) [-] + REAL(DbKi) , DIMENSION(1:30) :: stiffXs = 0.0_R8Ki !< x array for stress-strain lookup table (up to nCoef) [-] + REAL(DbKi) , DIMENSION(1:30) :: stiffYs = 0.0_R8Ki !< y array for stress-strain lookup table [-] + INTEGER(IntKi) :: nBApoints = 0_IntKi !< number of values in stress-strainrate lookup table (0 means using constant c) [-] + REAL(DbKi) , DIMENSION(1:30) :: dampXs = 0.0_R8Ki !< x array for stress-strainrate lookup table (up to nCoef) [-] + REAL(DbKi) , DIMENSION(1:30) :: dampYs = 0.0_R8Ki !< y array for stress-strainrate lookup table [-] + INTEGER(IntKi) :: nEIpoints = 0_IntKi !< number of values in bending stress-strain lookup table (0 means using constant E) [-] + REAL(DbKi) , DIMENSION(1:30) :: bstiffXs = 0.0_R8Ki !< x array for stress-strain lookup table (up to nCoef) [-] + REAL(DbKi) , DIMENSION(1:30) :: bstiffYs = 0.0_R8Ki !< y array for stress-strain lookup table [-] END TYPE MD_LineProp ! ======================= ! ========= MD_RodProp ======= TYPE, PUBLIC :: MD_RodProp - INTEGER(IntKi) :: IdNum !< integer identifier of this set of rod properties [-] + INTEGER(IntKi) :: IdNum = 0_IntKi !< integer identifier of this set of rod properties [-] CHARACTER(10) :: name !< name/identifier of this set of rod properties [-] - REAL(DbKi) :: d !< volume-equivalent diameter [[m]] - REAL(DbKi) :: w !< per-length weight in air [[kg/m]] - REAL(DbKi) :: Can !< transverse added mass coefficient [-] - REAL(DbKi) :: Cat !< tangential added mass coefficient [-] - REAL(DbKi) :: Cdn !< transverse drag coefficient [-] - REAL(DbKi) :: Cdt !< tangential drag coefficient [-] - REAL(DbKi) :: CdEnd !< drag coefficient for rod end [[-]] - REAL(DbKi) :: CaEnd !< added mass coefficient for rod end [[-]] + REAL(DbKi) :: d = 0.0_R8Ki !< volume-equivalent diameter [[m]] + REAL(DbKi) :: w = 0.0_R8Ki !< per-length weight in air [[kg/m]] + REAL(DbKi) :: Can = 0.0_R8Ki !< transverse added mass coefficient [-] + REAL(DbKi) :: Cat = 0.0_R8Ki !< tangential added mass coefficient [-] + REAL(DbKi) :: Cdn = 0.0_R8Ki !< transverse drag coefficient [-] + REAL(DbKi) :: Cdt = 0.0_R8Ki !< tangential drag coefficient [-] + REAL(DbKi) :: CdEnd = 0.0_R8Ki !< drag coefficient for rod end [[-]] + REAL(DbKi) :: CaEnd = 0.0_R8Ki !< added mass coefficient for rod end [[-]] + REAL(DbKi) :: LinDamp = 0.0_R8Ki !< Linear damping, transverse damping for body element [[N/(m/s)/m]] + LOGICAL :: isLinDamp = .false. !< Linear damping, transverse damping for body element is used [-] END TYPE MD_RodProp ! ======================= ! ========= MD_Body ======= TYPE, PUBLIC :: MD_Body - INTEGER(IntKi) :: IdNum !< integer identifier of this Point [-] - INTEGER(IntKi) :: typeNum !< integer identifying the type. 0=free, 1=fixed, -1=vessel [-] - INTEGER(IntKi) , DIMENSION(1:30) :: AttachedC !< list of IdNums of points attached to this body [-] - INTEGER(IntKi) , DIMENSION(1:30) :: AttachedR !< list of IdNums of rods attached to this body [-] - INTEGER(IntKi) :: nAttachedC = 0 !< number of attached points [-] - INTEGER(IntKi) :: nAttachedR = 0 !< number of attached rods [-] - REAL(DbKi) , DIMENSION(1:3,1:30) :: rPointRel !< relative position of point on body [-] - REAL(DbKi) , DIMENSION(1:6,1:30) :: r6RodRel !< relative position and orientation of rod on body [-] - REAL(DbKi) :: bodyM !< body mass (seperate from attached objects) [[kg]] - REAL(DbKi) :: bodyV !< body volume (for buoyancy calculation) [[m^3]] - REAL(DbKi) , DIMENSION(1:3) :: bodyI !< body 3x3 inertia matrix diagonals [[kg-m^2]] - REAL(DbKi) , DIMENSION(1:6) :: bodyCdA !< product of drag force and frontal area of body [[m^2]] - REAL(DbKi) , DIMENSION(1:6) :: bodyCa !< added mass coefficient of body [-] - REAL(DbKi) :: time !< current time [[s]] - REAL(DbKi) , DIMENSION(1:6) :: r6 !< position [-] - REAL(DbKi) , DIMENSION(1:6) :: v6 !< velocity [-] - REAL(DbKi) , DIMENSION(1:6) :: a6 !< acceleration (only used for coupled bodies) [-] - REAL(DbKi) , DIMENSION(1:3) :: U !< water velocity at ref point [[m/s]] - REAL(DbKi) , DIMENSION(1:3) :: Ud !< water acceleration at ref point [[m/s^2]] - REAL(DbKi) :: zeta !< water surface elevation above ref point [[m]] - REAL(DbKi) , DIMENSION(1:6) :: F6net !< total force and moment on body (excluding inertial loads) [-] - REAL(DbKi) , DIMENSION(1:6,1:6) :: M6net !< total mass matrix of Body and any attached objects [-] - REAL(DbKi) , DIMENSION(1:6,1:6) :: M !< rotated body 6-dof mass and inertia matrix in global orientation [-] - REAL(DbKi) , DIMENSION(1:6,1:6) :: M0 !< body 6-dof mass and inertia matrix in its own frame [-] - REAL(DbKi) , DIMENSION(1:3,1:3) :: OrMat !< DCM for body orientation [-] - REAL(DbKi) , DIMENSION(1:3) :: rCG !< vector in body frame from ref point to CG (before rods etc..) [-] + INTEGER(IntKi) :: IdNum = 0_IntKi !< integer identifier of this Point [-] + INTEGER(IntKi) :: typeNum = 0_IntKi !< integer identifying the type. 0=free, 1=fixed, -1=coupled, 2=coupledpinned [-] + INTEGER(IntKi) , DIMENSION(1:30) :: AttachedC = 0_IntKi !< list of IdNums of points attached to this body [-] + INTEGER(IntKi) , DIMENSION(1:30) :: AttachedR = 0_IntKi !< list of IdNums of rods attached to this body [-] + INTEGER(IntKi) :: nAttachedC = 0_IntKi !< number of attached points [-] + INTEGER(IntKi) :: nAttachedR = 0_IntKi !< number of attached rods [-] + REAL(DbKi) , DIMENSION(1:3,1:30) :: rPointRel = 0.0_R8Ki !< relative position of point on body [-] + REAL(DbKi) , DIMENSION(1:6,1:30) :: r6RodRel = 0.0_R8Ki !< relative position and orientation of rod on body [-] + REAL(DbKi) :: bodyM = 0.0_R8Ki !< body mass (seperate from attached objects) [[kg]] + REAL(DbKi) :: bodyV = 0.0_R8Ki !< body volume (for buoyancy calculation) [[m^3]] + REAL(DbKi) , DIMENSION(1:3) :: bodyI = 0.0_R8Ki !< body 3x3 inertia matrix diagonals [[kg-m^2]] + REAL(DbKi) , DIMENSION(1:6) :: bodyCdA = 0.0_R8Ki !< product of drag force and frontal area of body [[m^2]] + REAL(DbKi) , DIMENSION(1:6) :: bodyCa = 0.0_R8Ki !< added mass coefficient of body [-] + REAL(DbKi) :: time = 0.0_R8Ki !< current time [[s]] + REAL(DbKi) , DIMENSION(1:6) :: r6 = 0.0_R8Ki !< position [-] + REAL(DbKi) , DIMENSION(1:6) :: v6 = 0.0_R8Ki !< velocity [-] + REAL(DbKi) , DIMENSION(1:6) :: a6 = 0.0_R8Ki !< acceleration (only used for coupled bodies) [-] + REAL(DbKi) , DIMENSION(1:3) :: U = 0.0_R8Ki !< water velocity at ref point [[m/s]] + REAL(DbKi) , DIMENSION(1:3) :: Ud = 0.0_R8Ki !< water acceleration at ref point [[m/s^2]] + REAL(DbKi) :: zeta = 0.0_R8Ki !< water surface elevation above ref point [[m]] + REAL(DbKi) , DIMENSION(1:6) :: F6net = 0.0_R8Ki !< total force and moment on body (excluding inertial loads) [-] + REAL(DbKi) , DIMENSION(1:6,1:6) :: M6net = 0.0_R8Ki !< total mass matrix of Body and any attached objects [-] + REAL(DbKi) , DIMENSION(1:6,1:6) :: M = 0.0_R8Ki !< rotated body 6-dof mass and inertia matrix in global orientation [-] + REAL(DbKi) , DIMENSION(1:6,1:6) :: M0 = 0.0_R8Ki !< body 6-dof mass and inertia matrix in its own frame [-] + REAL(DbKi) , DIMENSION(1:3,1:3) :: OrMat = 0.0_R8Ki !< DCM for body orientation [-] + REAL(DbKi) , DIMENSION(1:3) :: rCG = 0.0_R8Ki !< vector in body frame from ref point to CG (before rods etc..) [-] END TYPE MD_Body ! ======================= ! ========= MD_Point ======= TYPE, PUBLIC :: MD_Point - INTEGER(IntKi) :: IdNum !< integer identifier of this point [-] + INTEGER(IntKi) :: IdNum = 0_IntKi !< integer identifier of this point [-] CHARACTER(10) :: type !< type of point: fix, vessel, point [-] - INTEGER(IntKi) :: typeNum !< integer identifying the type. 1=fixed, -1=vessel, 0=free [-] - INTEGER(IntKi) , DIMENSION(1:10) :: Attached !< list of IdNums of lines attached to this point node [-] - INTEGER(IntKi) , DIMENSION(1:10) :: Top !< list of ints specifying whether each line is attached at 1 = top/fairlead(end B), 0 = bottom/anchor(end A) [-] - INTEGER(IntKi) :: nAttached = 0 !< number of attached lines [-] - REAL(DbKi) :: pointM !< point mass [[kg]] - REAL(DbKi) :: pointV !< point volume [[m^3]] - REAL(DbKi) :: pointFX !< [-] - REAL(DbKi) :: pointFY !< [-] - REAL(DbKi) :: pointFZ !< [-] - REAL(DbKi) :: pointCa !< added mass coefficient of point [-] - REAL(DbKi) :: pointCdA !< product of drag force and frontal area of point [[m^2]] - REAL(DbKi) :: time !< current time [[s]] - REAL(DbKi) , DIMENSION(1:3) :: r !< position [-] - REAL(DbKi) , DIMENSION(1:3) :: rd !< velocity [-] - REAL(DbKi) , DIMENSION(1:3) :: a !< acceleration (only used for coupled points) [-] - REAL(DbKi) , DIMENSION(1:3) :: U !< water velocity at node [[m/s]] - REAL(DbKi) , DIMENSION(1:3) :: Ud !< water acceleration at node [[m/s^2]] - REAL(DbKi) :: zeta !< water surface elevation above node [[m]] + INTEGER(IntKi) :: typeNum = 0_IntKi !< integer identifying the type. 1=fixed, -1=coupled, 0=free [-] + INTEGER(IntKi) , DIMENSION(1:10) :: Attached = 0_IntKi !< list of IdNums of lines attached to this point node [-] + INTEGER(IntKi) , DIMENSION(1:10) :: Top = 0_IntKi !< list of ints specifying whether each line is attached at 1 = top/fairlead(end B), 0 = bottom/anchor(end A) [-] + INTEGER(IntKi) :: nAttached = 0_IntKi !< number of attached lines [-] + REAL(DbKi) :: pointM = 0.0_R8Ki !< point mass [[kg]] + REAL(DbKi) :: pointV = 0.0_R8Ki !< point volume [[m^3]] + REAL(DbKi) :: pointFX = 0.0_R8Ki !< [-] + REAL(DbKi) :: pointFY = 0.0_R8Ki !< [-] + REAL(DbKi) :: pointFZ = 0.0_R8Ki !< [-] + REAL(DbKi) :: pointCa = 0.0_R8Ki !< added mass coefficient of point [-] + REAL(DbKi) :: pointCdA = 0.0_R8Ki !< product of drag force and frontal area of point [[m^2]] + REAL(DbKi) :: time = 0.0_R8Ki !< current time [[s]] + REAL(DbKi) , DIMENSION(1:3) :: r = 0.0_R8Ki !< position [-] + REAL(DbKi) , DIMENSION(1:3) :: rd = 0.0_R8Ki !< velocity [-] + REAL(DbKi) , DIMENSION(1:3) :: a = 0.0_R8Ki !< acceleration (only used for coupled points) [-] + REAL(DbKi) , DIMENSION(1:3) :: U = 0.0_R8Ki !< water velocity at node [[m/s]] + REAL(DbKi) , DIMENSION(1:3) :: Ud = 0.0_R8Ki !< water acceleration at node [[m/s^2]] + REAL(DbKi) :: zeta = 0.0_R8Ki !< water surface elevation above node [[m]] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: PDyn !< water dynamic pressure at node [[Pa]] - REAL(DbKi) , DIMENSION(1:3) :: Fnet !< total force on node (excluding inertial loads) [-] - REAL(DbKi) , DIMENSION(1:3,1:3) :: M !< node mass matrix, from attached lines [-] + REAL(DbKi) , DIMENSION(1:3) :: Fnet = 0.0_R8Ki !< total force on node (excluding inertial loads) [-] + REAL(DbKi) , DIMENSION(1:3,1:3) :: M = 0.0_R8Ki !< node mass matrix, from attached lines [-] END TYPE MD_Point ! ======================= ! ========= MD_Rod ======= TYPE, PUBLIC :: MD_Rod - INTEGER(IntKi) :: IdNum !< integer identifier of this Line [-] + INTEGER(IntKi) :: IdNum = 0_IntKi !< integer identifier of this Line [-] CHARACTER(10) :: type !< type of Rod. should match one of RodProp names [-] - INTEGER(IntKi) :: PropsIdNum !< the IdNum of the associated rod properties [-] - INTEGER(IntKi) :: typeNum !< integer identifying the type. 0=fixed, 1=vessel, 2=point [-] - INTEGER(IntKi) , DIMENSION(1:10) :: AttachedA !< list of IdNums of lines attached to end A [-] - INTEGER(IntKi) , DIMENSION(1:10) :: AttachedB !< list of IdNums of lines attached to end B [-] - INTEGER(IntKi) , DIMENSION(1:10) :: TopA !< list of ints specifying whether each line is attached at 1 = top/fairlead(end B), 0 = bottom/anchor(end A) [-] - INTEGER(IntKi) , DIMENSION(1:10) :: TopB !< list of ints specifying whether each line is attached at 1 = top/fairlead(end B), 0 = bottom/anchor(end A) [-] - INTEGER(IntKi) :: nAttachedA = 0 !< number of attached lines to Rod end A [-] - INTEGER(IntKi) :: nAttachedB = 0 !< number of attached lines to Rod end B [-] - INTEGER(IntKi) , DIMENSION(1:20) :: OutFlagList !< array specifying what line quantities should be output (1 vs 0) [-] - INTEGER(IntKi) :: N !< The number of elements in the line [-] - INTEGER(IntKi) :: endTypeA !< type of point at end A: 0=pinned to Point, 1=cantilevered to Rod. [-] - INTEGER(IntKi) :: endTypeB !< type of point at end B: 0=pinned to Point, 1=cantilevered to Rod. [-] - REAL(DbKi) :: UnstrLen !< length of the rod [[m]] - REAL(DbKi) :: mass !< mass of the rod [[kg]] - REAL(DbKi) :: rho !< density [[kg/m3]] - REAL(DbKi) :: d !< volume-equivalent diameter [[m]] - REAL(DbKi) :: Can !< [[-]] - REAL(DbKi) :: Cat !< [[-]] - REAL(DbKi) :: Cdn !< [[-]] - REAL(DbKi) :: Cdt !< [[-]] - REAL(DbKi) :: CdEnd !< drag coefficient for rod end [[-]] - REAL(DbKi) :: CaEnd !< added mass coefficient for rod end [[-]] - REAL(DbKi) :: time !< current time [[s]] - REAL(DbKi) :: roll !< roll relative to vertical [[rad]] - REAL(DbKi) :: pitch !< pitch relative to vertical [[rad]] - REAL(DbKi) :: h0 !< submerged length of rod axis, distance along rod centerline from end A to the waterplane (0 <= h0 <= L) [m] + INTEGER(IntKi) :: PropsIdNum = 0_IntKi !< the IdNum of the associated rod properties [-] + INTEGER(IntKi) :: typeNum = 0_IntKi !< integer identifying the type. 0=free, 1=pinned, 2=fixed, -1=coupledpinned, -2=coupled [-] + INTEGER(IntKi) , DIMENSION(1:10) :: AttachedA = 0_IntKi !< list of IdNums of lines attached to end A [-] + INTEGER(IntKi) , DIMENSION(1:10) :: AttachedB = 0_IntKi !< list of IdNums of lines attached to end B [-] + INTEGER(IntKi) , DIMENSION(1:10) :: TopA = 0_IntKi !< list of ints specifying whether each line is attached at 1 = top/fairlead(end B), 0 = bottom/anchor(end A) [-] + INTEGER(IntKi) , DIMENSION(1:10) :: TopB = 0_IntKi !< list of ints specifying whether each line is attached at 1 = top/fairlead(end B), 0 = bottom/anchor(end A) [-] + INTEGER(IntKi) :: nAttachedA = 0_IntKi !< number of attached lines to Rod end A [-] + INTEGER(IntKi) :: nAttachedB = 0_IntKi !< number of attached lines to Rod end B [-] + INTEGER(IntKi) , DIMENSION(1:20) :: OutFlagList = 0_IntKi !< array specifying what line quantities should be output (1 vs 0) [-] + INTEGER(IntKi) :: N = 0_IntKi !< The number of elements in the line [-] + INTEGER(IntKi) :: endTypeA = 0_IntKi !< type of point at end A: 0=pinned to Point, 1=cantilevered to Rod. [-] + INTEGER(IntKi) :: endTypeB = 0_IntKi !< type of point at end B: 0=pinned to Point, 1=cantilevered to Rod. [-] + REAL(DbKi) :: UnstrLen = 0.0_R8Ki !< length of the rod [[m]] + REAL(DbKi) :: mass = 0.0_R8Ki !< mass of the rod [[kg]] + REAL(DbKi) :: rho = 0.0_R8Ki !< density [[kg/m3]] + REAL(DbKi) :: d = 0.0_R8Ki !< volume-equivalent diameter [[m]] + REAL(DbKi) :: Can = 0.0_R8Ki !< [[-]] + REAL(DbKi) :: Cat = 0.0_R8Ki !< [[-]] + REAL(DbKi) :: Cdn = 0.0_R8Ki !< [[-]] + REAL(DbKi) :: Cdt = 0.0_R8Ki !< [[-]] + REAL(DbKi) :: CdEnd = 0.0_R8Ki !< drag coefficient for rod end [[-]] + REAL(DbKi) :: CaEnd = 0.0_R8Ki !< added mass coefficient for rod end [[-]] + REAL(DbKi) :: LinDamp = 0.0_R8Ki !< Linear damping, transverse damping for rod element [[N/(m/s)/m]] + LOGICAL :: isLinDamp = .false. !< Linear damping, transverse damping for rod element is used [-] + REAL(DbKi) :: time = 0.0_R8Ki !< current time [[s]] + REAL(DbKi) :: roll = 0.0_R8Ki !< roll relative to vertical [[rad]] + REAL(DbKi) :: pitch = 0.0_R8Ki !< pitch relative to vertical [[rad]] + REAL(DbKi) :: h0 = 0.0_R8Ki !< submerged length of rod axis, distance along rod centerline from end A to the waterplane (0 <= h0 <= L) [m] REAL(DbKi) , DIMENSION(:,:), ALLOCATABLE :: r !< node positions [-] REAL(DbKi) , DIMENSION(:,:), ALLOCATABLE :: rd !< node velocities [-] - REAL(DbKi) , DIMENSION(1:3) :: q !< tangent vector for rod as a whole [-] + REAL(DbKi) , DIMENSION(1:3) :: q = 0.0_R8Ki !< tangent vector for rod as a whole [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: l !< segment unstretched length [[m]] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: V !< segment volume [[m^3]] REAL(DbKi) , DIMENSION(:,:), ALLOCATABLE :: U !< water velocity at node [[m/s]] @@ -212,53 +213,56 @@ MODULE MoorDyn_Types REAL(DbKi) , DIMENSION(:,:), ALLOCATABLE :: B !< node bottom contact force [[N]] REAL(DbKi) , DIMENSION(:,:), ALLOCATABLE :: Fnet !< total force on node [[N]] REAL(DbKi) , DIMENSION(:,:,:), ALLOCATABLE :: M !< node mass matrix [[kg]] - REAL(DbKi) , DIMENSION(1:3) :: FextA !< external forces from attached lines on/about end A [-] - REAL(DbKi) , DIMENSION(1:3) :: FextB !< external forces from attached lines on/about end A [-] - REAL(DbKi) , DIMENSION(1:3) :: Mext !< external moment vector holding sum of any externally applied moments i.e. bending lines [-] - REAL(DbKi) , DIMENSION(1:6) :: r6 !< 6 DOF position vector [-] - REAL(DbKi) , DIMENSION(1:6) :: v6 !< 6 DOF velocity vector [-] - REAL(DbKi) , DIMENSION(1:6) :: a6 !< 6 DOF acceleration vector (only used for coupled Rods) [-] - REAL(DbKi) , DIMENSION(1:6) :: F6net !< total force and moment about end A (excluding inertial loads) that Rod may exert on whatever it's attached to [-] - REAL(DbKi) , DIMENSION(1:6,1:6) :: M6net !< total mass matrix about end A of Rod and any attached Points [-] - REAL(DbKi) , DIMENSION(1:3,1:3) :: OrMat !< DCM for body orientation [-] - INTEGER(IntKi) :: RodUnOut !< unit number of rod output file [-] + REAL(DbKi) , DIMENSION(1:3) :: FextA = 0.0_R8Ki !< external forces from attached lines on/about end A [-] + REAL(DbKi) , DIMENSION(1:3) :: FextB = 0.0_R8Ki !< external forces from attached lines on/about end A [-] + REAL(DbKi) , DIMENSION(1:3) :: Mext = 0.0_R8Ki !< external moment vector holding sum of any externally applied moments i.e. bending lines [-] + REAL(DbKi) , DIMENSION(1:6) :: r6 = 0.0_R8Ki !< 6 DOF position vector [-] + REAL(DbKi) , DIMENSION(1:6) :: v6 = 0.0_R8Ki !< 6 DOF velocity vector [-] + REAL(DbKi) , DIMENSION(1:6) :: a6 = 0.0_R8Ki !< 6 DOF acceleration vector (only used for coupled Rods) [-] + REAL(DbKi) , DIMENSION(1:6) :: F6net = 0.0_R8Ki !< total force and moment about end A (excluding inertial loads) that Rod may exert on whatever it's attached to [-] + REAL(DbKi) , DIMENSION(1:6,1:6) :: M6net = 0.0_R8Ki !< total mass matrix about end A of Rod and any attached Points [-] + REAL(DbKi) , DIMENSION(1:3,1:3) :: Imat = 0.0_R8Ki !< inertia about CG in global frame [-] + REAL(DbKi) , DIMENSION(1:3,1:3) :: OrMat = 0.0_R8Ki !< DCM for body orientation [-] + INTEGER(IntKi) :: RodUnOut = 0_IntKi !< unit number of rod output file [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: RodWrOutput !< one row of output data for this rod [-] END TYPE MD_Rod ! ======================= ! ========= MD_Line ======= TYPE, PUBLIC :: MD_Line - INTEGER(IntKi) :: IdNum !< integer identifier of this Line [-] - INTEGER(IntKi) :: PropsIdNum !< the IdNum of the associated line properties [-] - INTEGER(IntKi) :: ElasticMod !< Which elasticity model to use: {0 basic, 1 viscoelastic, 2 future SYCOM} [-] - INTEGER(IntKi) , DIMENSION(1:20) :: OutFlagList !< array specifying what line quantities should be output (1 vs 0) [-] - INTEGER(IntKi) :: CtrlChan = 0 !< index of control channel that will drive line active tensioning (0 for none) [-] - INTEGER(IntKi) :: FairPoint !< IdNum of Point at fairlead [-] - INTEGER(IntKi) :: AnchPoint !< IdNum of Point at anchor [-] - INTEGER(IntKi) :: N !< The number of elements in the line [-] - INTEGER(IntKi) :: endTypeA !< type of connection at end A: 0=pinned to Point, 1=cantilevered to Rod. [-] - INTEGER(IntKi) :: endTypeB !< type of connection at end B: 0=pinned to Point, 1=cantilevered to Rod. [-] - REAL(DbKi) :: UnstrLen !< unstretched length of the line [-] - REAL(DbKi) :: rho !< density [[kg/m3]] - REAL(DbKi) :: d !< volume-equivalent diameter [[m]] - REAL(DbKi) :: EA = 0 !< stiffness [[N]] - REAL(DbKi) :: EA_D = 0 !< dynamic stiffness when using viscoelastic model [[N]] - REAL(DbKi) :: BA = 0 !< internal damping coefficient times area for this line only [[N-s]] - REAL(DbKi) :: BA_D = 0 !< dynamic internal damping coefficient times area when using viscoelastic model [[N-s]] - REAL(DbKi) :: EI = 0 !< bending stiffness [[N-m]] - REAL(DbKi) :: Can !< [[-]] - REAL(DbKi) :: Cat !< [[-]] - REAL(DbKi) :: Cdn !< [[-]] - REAL(DbKi) :: Cdt !< [[-]] - INTEGER(IntKi) :: nEApoints = 0 !< number of values in stress-strain lookup table (0 means using constant E) [-] - REAL(DbKi) , DIMENSION(1:30) :: stiffXs !< x array for stress-strain lookup table (up to nCoef) [-] - REAL(DbKi) , DIMENSION(1:30) :: stiffYs !< y array for stress-strain lookup table [-] - INTEGER(IntKi) :: nBApoints = 0 !< number of values in stress-strainrate lookup table (0 means using constant c) [-] - REAL(DbKi) , DIMENSION(1:30) :: dampXs !< x array for stress-strainrate lookup table (up to nCoef) [-] - REAL(DbKi) , DIMENSION(1:30) :: dampYs !< y array for stress-strainrate lookup table [-] - INTEGER(IntKi) :: nEIpoints = 0 !< number of values in bending stress-strain lookup table (0 means using constant E) [-] - REAL(DbKi) , DIMENSION(1:30) :: bstiffXs !< x array for stress-strain lookup table (up to nCoef) [-] - REAL(DbKi) , DIMENSION(1:30) :: bstiffYs !< y array for stress-strain lookup table [-] - REAL(DbKi) :: time !< current time [[s]] + INTEGER(IntKi) :: IdNum = 0_IntKi !< integer identifier of this Line [-] + INTEGER(IntKi) :: PropsIdNum = 0_IntKi !< the IdNum of the associated line properties [-] + INTEGER(IntKi) :: ElasticMod = 0_IntKi !< Which elasticity model to use: {0 basic, 1 viscoelastic, 2 future SYCOM} [-] + INTEGER(IntKi) , DIMENSION(1:20) :: OutFlagList = 0_IntKi !< array specifying what line quantities should be output (1 vs 0) [-] + INTEGER(IntKi) :: CtrlChan = 0_IntKi !< index of control channel that will drive line active tensioning (0 for none) [-] + INTEGER(IntKi) :: FairPoint = 0_IntKi !< IdNum of Point at fairlead [-] + INTEGER(IntKi) :: AnchPoint = 0_IntKi !< IdNum of Point at anchor [-] + INTEGER(IntKi) :: N = 0_IntKi !< The number of elements in the line [-] + INTEGER(IntKi) :: endTypeA = 0_IntKi !< type of connection at end A: 0=pinned to Point, 1=cantilevered to Rod. [-] + INTEGER(IntKi) :: endTypeB = 0_IntKi !< type of connection at end B: 0=pinned to Point, 1=cantilevered to Rod. [-] + REAL(DbKi) :: UnstrLen = 0.0_R8Ki !< unstretched length of the line [-] + REAL(DbKi) :: rho = 0.0_R8Ki !< density [[kg/m3]] + REAL(DbKi) :: d = 0.0_R8Ki !< volume-equivalent diameter [[m]] + REAL(DbKi) :: EA = 0.0_R8Ki !< stiffness [[N]] + REAL(DbKi) :: EA_D = 0.0_R8Ki !< constant dynamic stiffness when using viscoelastic model [[N]] + REAL(DbKi) :: alphaMBL = 0.0_R8Ki !< load dependent dynamic stiffness constant: Krd alpha term x MBL [[N]] + REAL(DbKi) :: vbeta = 0.0_R8Ki !< load dependent dynamic stiffness Lm slope: Krd beta term (to be multiplied by mean load) [[N]] + REAL(DbKi) :: BA = 0.0_R8Ki !< internal damping coefficient times area for this line only [[N-s]] + REAL(DbKi) :: BA_D = 0.0_R8Ki !< dynamic internal damping coefficient times area when using viscoelastic model [[N-s]] + REAL(DbKi) :: EI = 0.0_R8Ki !< bending stiffness [[N-m]] + REAL(DbKi) :: Can = 0.0_R8Ki !< [[-]] + REAL(DbKi) :: Cat = 0.0_R8Ki !< [[-]] + REAL(DbKi) :: Cdn = 0.0_R8Ki !< [[-]] + REAL(DbKi) :: Cdt = 0.0_R8Ki !< [[-]] + INTEGER(IntKi) :: nEApoints = 0_IntKi !< number of values in stress-strain lookup table (0 means using constant E) [-] + REAL(DbKi) , DIMENSION(1:30) :: stiffXs = 0.0_R8Ki !< x array for stress-strain lookup table (up to nCoef) [-] + REAL(DbKi) , DIMENSION(1:30) :: stiffYs = 0.0_R8Ki !< y array for stress-strain lookup table [-] + INTEGER(IntKi) :: nBApoints = 0_IntKi !< number of values in stress-strainrate lookup table (0 means using constant c) [-] + REAL(DbKi) , DIMENSION(1:30) :: dampXs = 0.0_R8Ki !< x array for stress-strainrate lookup table (up to nCoef) [-] + REAL(DbKi) , DIMENSION(1:30) :: dampYs = 0.0_R8Ki !< y array for stress-strainrate lookup table [-] + INTEGER(IntKi) :: nEIpoints = 0_IntKi !< number of values in bending stress-strain lookup table (0 means using constant E) [-] + REAL(DbKi) , DIMENSION(1:30) :: bstiffXs = 0.0_R8Ki !< x array for stress-strain lookup table (up to nCoef) [-] + REAL(DbKi) , DIMENSION(1:30) :: bstiffYs = 0.0_R8Ki !< y array for stress-strain lookup table [-] + REAL(DbKi) :: time = 0.0_R8Ki !< current time [[s]] REAL(DbKi) , DIMENSION(:,:), ALLOCATABLE :: r !< node positions [-] REAL(DbKi) , DIMENSION(:,:), ALLOCATABLE :: rd !< node velocities [-] REAL(DbKi) , DIMENSION(:,:), ALLOCATABLE :: q !< node tangent vectors [-] @@ -270,6 +274,7 @@ MODULE MoorDyn_Types REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: Kurv !< curvature at each node point [[1/m]] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: dl_1 !< segment stretch attributed to static stiffness portion [[m]] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: V !< segment volume [[m^3]] + REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: F !< VOF scalar for each segment (1 = fully submerged, 0 = out of water) [-] REAL(DbKi) , DIMENSION(:,:), ALLOCATABLE :: U !< water velocity at node [[m/s]] REAL(DbKi) , DIMENSION(:,:), ALLOCATABLE :: Ud !< water acceleration at node [[m/s^2]] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: zeta !< water surface elevation above node [[m]] @@ -286,25 +291,33 @@ MODULE MoorDyn_Types REAL(DbKi) , DIMENSION(:,:), ALLOCATABLE :: Fnet !< total force on node [[N]] REAL(DbKi) , DIMENSION(:,:,:), ALLOCATABLE :: S !< node inverse mass matrix [[kg]] REAL(DbKi) , DIMENSION(:,:,:), ALLOCATABLE :: M !< node mass matrix [[kg]] - REAL(DbKi) , DIMENSION(1:3) :: EndMomentA !< vector of end moments due to bending at line end A [[N-m]] - REAL(DbKi) , DIMENSION(1:3) :: EndMomentB !< vector of end moments due to bending at line end B [[N-m]] - INTEGER(IntKi) :: LineUnOut !< unit number of line output file [-] + REAL(DbKi) , DIMENSION(1:3) :: EndMomentA = 0.0_R8Ki !< vector of end moments due to bending at line end A [[N-m]] + REAL(DbKi) , DIMENSION(1:3) :: EndMomentB = 0.0_R8Ki !< vector of end moments due to bending at line end B [[N-m]] + INTEGER(IntKi) :: LineUnOut = 0_IntKi !< unit number of line output file [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: LineWrOutput !< one row of output data for this line [-] END TYPE MD_Line ! ======================= ! ========= MD_Fail ======= TYPE, PUBLIC :: MD_Fail - INTEGER(IntKi) :: IdNum !< integer identifier of this failure [-] + INTEGER(IntKi) :: IdNum = 0_IntKi !< integer identifier of this failure [-] + INTEGER(IntKi) :: attachID = 0_IntKi !< ID of connection or Rod the lines are attached to [-] + INTEGER(IntKi) :: isRod = 0_IntKi !< 1 Rod end A, 2 Rod end B, 0 if point [-] + INTEGER(IntKi) , DIMENSION(1:30) :: lineIDs = 0_IntKi !< array of one or more lines to detach (starting from 1...) [-] + INTEGER(IntKi) , DIMENSION(1:30) :: lineTops = 0_IntKi !< an array that will be FILLED IN to return which end of each line was disconnected ... 1 = top/fairlead(end B), 0 = bottom/anchor(end A) [-] + INTEGER(IntKi) :: nLinesToDetach = 0_IntKi !< how many lines to dettach [-] + REAL(DbKi) :: failTime = 0.0_R8Ki !< time of failure [s] + REAL(DbKi) :: failTen = 0.0_R8Ki !< tension threshold of failure [N] + INTEGER(IntKi) :: failStatus = 0_IntKi !< 0 not failed yet, 1 failed, 2 invalid [-] END TYPE MD_Fail ! ======================= ! ========= MD_OutParmType ======= TYPE, PUBLIC :: MD_OutParmType CHARACTER(10) :: Name !< name of output channel [-] CHARACTER(10) :: Units !< units string [-] - INTEGER(IntKi) :: QType !< type of quantity - 0=tension, 1=x, 2=y, 3=z... [-] - INTEGER(IntKi) :: OType !< type of object - 0=line, 1=point [-] - INTEGER(IntKi) :: NodeID !< node number if OType=0. 0=anchor, -1=whole object [-] - INTEGER(IntKi) :: ObjID !< number of Point or Line object [-] + INTEGER(IntKi) :: QType = 0_IntKi !< type of quantity - 0=tension, 1=x, 2=y, 3=z... [-] + INTEGER(IntKi) :: OType = 0_IntKi !< type of object - 0=line, 1=point [-] + INTEGER(IntKi) :: NodeID = 0_IntKi !< node number if OType=0. 0=anchor, -1=whole object [-] + INTEGER(IntKi) :: ObjID = 0_IntKi !< number of Point or Line object [-] END TYPE MD_OutParmType ! ======================= ! ========= VisDiam ======= @@ -335,17 +348,17 @@ MODULE MoorDyn_Types ! ======================= ! ========= MD_DiscreteStateType ======= TYPE, PUBLIC :: MD_DiscreteStateType - REAL(SiKi) :: dummy !< Remove this variable if you have discrete states [-] + REAL(SiKi) :: dummy = 0.0_R4Ki !< Remove this variable if you have discrete states [-] END TYPE MD_DiscreteStateType ! ======================= ! ========= MD_ConstraintStateType ======= TYPE, PUBLIC :: MD_ConstraintStateType - REAL(SiKi) :: dummy !< Remove this variable if you have constraint states [-] + REAL(SiKi) :: dummy = 0.0_R4Ki !< Remove this variable if you have constraint states [-] END TYPE MD_ConstraintStateType ! ======================= ! ========= MD_OtherStateType ======= TYPE, PUBLIC :: MD_OtherStateType - REAL(SiKi) :: dummy !< Remove this variable if you have other states [-] + REAL(SiKi) :: dummy = 0.0_R4Ki !< Remove this variable if you have other states [-] END TYPE MD_OtherStateType ! ======================= ! ========= MD_MiscVarType ======= @@ -372,14 +385,15 @@ MODULE MoorDyn_Types INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: RodStateIsN !< ending index of each rod's states in state vector [] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: BodyStateIs1 !< starting index of each body's states in state vector [] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: BodyStateIsN !< ending index of each body's states in state vector [] - INTEGER(IntKi) :: Nx !< number of states and size of state vector [] - INTEGER(IntKi) :: WaveTi !< current interpolation index for wave time series data [] + INTEGER(IntKi) :: Nx = 0_IntKi !< number of states and size of state vector [] + INTEGER(IntKi) :: Nxtra = 0_IntKi !< number of states and size of state vector including points for potential line failures [] + INTEGER(IntKi) :: WaveTi = 0_IntKi !< current interpolation index for wave time series data [] TYPE(MD_ContinuousStateType) :: xTemp !< contains temporary state vector used in integration (put here so it's only allocated once) [-] TYPE(MD_ContinuousStateType) :: xdTemp !< contains temporary state derivative vector used in integration (put here so it's only allocated once) [-] - REAL(DbKi) , DIMENSION(1:6) :: zeros6 !< array of zeros for convenience [-] + REAL(DbKi) , DIMENSION(1:6) :: zeros6 = 0.0_R8Ki !< array of zeros for convenience [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: MDWrOutput !< Data from time step to be written to a MoorDyn output file [-] - REAL(DbKi) :: LastOutTime !< Time of last writing to MD output files [-] - REAL(ReKi) , DIMENSION(1:6) :: PtfmInit !< initial position of platform for an individual (non-farm) MD instance [-] + REAL(DbKi) :: LastOutTime = 0.0_R8Ki !< Time of last writing to MD output files [-] + REAL(ReKi) , DIMENSION(1:6) :: PtfmInit = 0.0_ReKi !< initial position of platform for an individual (non-farm) MD instance [-] REAL(DbKi) , DIMENSION(:,:), ALLOCATABLE :: BathymetryGrid !< matrix describing the bathymetry in a grid of x's and y's [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: BathGrid_Xs !< array of x-coordinates in the bathymetry grid [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: BathGrid_Ys !< array of y-coordinates in the bathymetry grid [-] @@ -405,39 +419,41 @@ MODULE MoorDyn_Types INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: nCpldPoints !< number of coupled points (for FAST.Farm, size>1 with an entry for each turbine) [] INTEGER(IntKi) :: NConns = 0 !< number of Connect type Points - not to be confused with NPoints [] INTEGER(IntKi) :: NAnchs = 0 !< number of Anchor type Points [] - REAL(DbKi) :: Tmax !< simulation duration [[s]] + REAL(DbKi) :: Tmax = 0.0_R8Ki !< simulation duration [[s]] REAL(DbKi) :: g = 9.81 !< gravitational constant (positive) [[m/s^2]] REAL(DbKi) :: rhoW = 1025 !< density of seawater [[kg/m^3]] - REAL(DbKi) :: WtrDpth !< water depth [[m]] - REAL(DbKi) :: kBot !< bottom stiffness [[Pa/m]] - REAL(DbKi) :: cBot !< bottom damping [[Pa-s/m]] - REAL(DbKi) :: dtM0 !< desired mooring model time step [[s]] - REAL(DbKi) :: dtCoupling !< coupling time step that MoorDyn should expect [[s]] - INTEGER(IntKi) :: NumOuts !< Number of parameters in the output list (number of outputs requested) [-] - REAL(DbKi) :: dtOut !< interval for writing output file lines [[s]] + REAL(DbKi) :: WtrDpth = 0.0_R8Ki !< water depth [[m]] + REAL(DbKi) :: kBot = 0.0_R8Ki !< bottom stiffness [[Pa/m]] + REAL(DbKi) :: cBot = 0.0_R8Ki !< bottom damping [[Pa-s/m]] + REAL(DbKi) :: dtM0 = 0.0_R8Ki !< desired mooring model time step [[s]] + REAL(DbKi) :: dtCoupling = 0.0_R8Ki !< coupling time step that MoorDyn should expect [[s]] + INTEGER(IntKi) :: NumOuts = 0_IntKi !< Number of parameters in the output list (number of outputs requested) [-] + REAL(DbKi) :: dtOut = 0.0_R8Ki !< interval for writing output file lines [[s]] CHARACTER(1024) :: RootName !< RootName for writing output files [-] TYPE(MD_OutParmType) , DIMENSION(:), ALLOCATABLE :: OutParam !< Names and units (and other characteristics) of all requested output parameters [-] CHARACTER(1) :: Delim !< Column delimiter for output text files [-] - INTEGER(IntKi) :: MDUnOut !< Unit number of main output file [-] + INTEGER(IntKi) :: MDUnOut = 0_IntKi !< Unit number of main output file [-] CHARACTER(1024) :: PriPath !< The path to the primary MoorDyn input file, used if looking for additional input files [-] INTEGER(IntKi) :: writeLog = -1 !< Switch for level of log file output [-] INTEGER(IntKi) :: UnLog = -1 !< Unit number of log file [-] - INTEGER(IntKi) :: WaveKin !< Flag for whether or how to consider water kinematics [-] - INTEGER(IntKi) :: Current !< Flag for whether or how to consider water kinematics [-] - INTEGER(IntKi) :: nTurbines !< Number of turbines if MoorDyn is performing an array-level simulation with FAST.Farm, otherwise 0 [-] + INTEGER(IntKi) :: WaveKin = 0_IntKi !< Flag for whether or how to consider water kinematics [-] + INTEGER(IntKi) :: Current = 0_IntKi !< Flag for whether or how to consider water kinematics [-] + INTEGER(IntKi) :: nTurbines = 0_IntKi !< Number of turbines if MoorDyn is performing an array-level simulation with FAST.Farm, otherwise 0 [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: TurbineRefPos !< reference position of turbines in farm, shape: 3, nTurbines [-] - REAL(DbKi) :: mu_kT !< transverse kinetic friction coefficient [(-)] - REAL(DbKi) :: mu_kA !< axial kinetic friction coefficient [(-)] - REAL(DbKi) :: mc !< ratio of the static friction coefficient to the kinetic friction coefficient [(-)] - REAL(DbKi) :: cv !< saturated damping coefficient [(-)] - INTEGER(IntKi) :: nxWave !< number of x wave grid points [-] - INTEGER(IntKi) :: nyWave !< number of y wave grid points [-] - INTEGER(IntKi) :: nzWave !< number of z wave grid points [-] - INTEGER(IntKi) :: ntWave !< number of wave time steps [-] + REAL(DbKi) :: mu_kT = 0.0_R8Ki !< transverse kinetic friction coefficient [(-)] + REAL(DbKi) :: mu_kA = 0.0_R8Ki !< axial kinetic friction coefficient [(-)] + REAL(DbKi) :: mc = 0.0_R8Ki !< ratio of the static friction coefficient to the kinetic friction coefficient [(-)] + REAL(DbKi) :: cv = 0.0_R8Ki !< saturated damping coefficient [(-)] + INTEGER(IntKi) :: inertialF = 0 !< Indicates MoorDyn returning inertial moments for coupled 6DOF objects. 0: no, 1: yes, 2: yes with ramp to inertialF_rampT [-] + REAL(R8Ki) :: inertialF_rampT = 30 !< Ramp time for inertial forces [-] + INTEGER(IntKi) :: nxWave = 0_IntKi !< number of x wave grid points [-] + INTEGER(IntKi) :: nyWave = 0_IntKi !< number of y wave grid points [-] + INTEGER(IntKi) :: nzWave = 0_IntKi !< number of z wave grid points [-] + INTEGER(IntKi) :: ntWave = 0_IntKi !< number of wave time steps [-] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: pxWave !< x location of wave grid points [-] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: pyWave !< y location of wave grid points [-] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: pzWave !< z location of wave grid points [-] - REAL(SiKi) :: dtWave !< wave data time step [-] + REAL(SiKi) :: dtWave = 0.0_R4Ki !< wave data time step [-] REAL(SiKi) , DIMENSION(:,:,:,:), ALLOCATABLE :: uxWave !< wave velocities time series at each grid point [-] REAL(SiKi) , DIMENSION(:,:,:,:), ALLOCATABLE :: uyWave !< wave velocities time series at each grid point [-] REAL(SiKi) , DIMENSION(:,:,:,:), ALLOCATABLE :: uzWave !< wave velocities time series at each grid point [-] @@ -446,18 +462,18 @@ MODULE MoorDyn_Types REAL(SiKi) , DIMENSION(:,:,:,:), ALLOCATABLE :: azWave !< wave accelerations time series at each grid point [-] REAL(SiKi) , DIMENSION(:,:,:,:), ALLOCATABLE :: PDyn !< wave dynamic pressure time series at each grid point [-] REAL(SiKi) , DIMENSION(:,:,:), ALLOCATABLE :: zeta !< wave surface elevations time series at each surface grid point [-] - INTEGER(IntKi) :: nzCurrent !< number of z current grid points [-] + INTEGER(IntKi) :: nzCurrent = 0_IntKi !< number of z current grid points [-] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: pzCurrent !< z location of current grid points [-] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: uxCurrent !< current velocities time series at each grid point [-] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: uyCurrent !< current velocities time series at each grid point [-] - INTEGER(IntKi) :: Nx0 !< copy of initial size of system state vector, for linearization routines [-] + INTEGER(IntKi) :: Nx0 = 0_IntKi !< copy of initial size of system state vector, for linearization routines [-] 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(:), ALLOCATABLE :: 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 !< number of continuous states in jacobian matrix [-] + INTEGER(IntKi) :: Jac_ny = 0_IntKi !< number of outputs in jacobian matrix [-] + INTEGER(IntKi) :: Jac_nx = 0_IntKi !< number of continuous states in jacobian matrix [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: dxIdx_map2_xStateIdx !< Mapping array from index of dX array to corresponding state index [-] - LOGICAL :: VisMeshes !< Using visualization meshes as requested by glue code [-] + LOGICAL :: VisMeshes = .false. !< Using visualization meshes as requested by glue code [-] TYPE(VisDiam) , DIMENSION(:), ALLOCATABLE :: VisRodsDiam !< Diameters for visualization of rods [-] END TYPE MD_ParameterType ! ======================= @@ -479,14059 +495,4206 @@ MODULE MoorDyn_Types END TYPE MD_OutputType ! ======================= CONTAINS - SUBROUTINE MD_CopyInputFileType( SrcInputFileTypeData, DstInputFileTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MD_InputFileType), INTENT(IN) :: SrcInputFileTypeData - TYPE(MD_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) :: 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 = 'MD_CopyInputFileType' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInputFileTypeData%DTIC = SrcInputFileTypeData%DTIC - DstInputFileTypeData%TMaxIC = SrcInputFileTypeData%TMaxIC - DstInputFileTypeData%CdScaleIC = SrcInputFileTypeData%CdScaleIC - DstInputFileTypeData%threshIC = SrcInputFileTypeData%threshIC - END SUBROUTINE MD_CopyInputFileType - - SUBROUTINE MD_DestroyInputFileType( InputFileTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(MD_InputFileType), INTENT(INOUT) :: InputFileTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_DestroyInputFileType' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE MD_DestroyInputFileType - - SUBROUTINE MD_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(MD_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 = 'MD_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 - Db_BufSz = Db_BufSz + 1 ! DTIC - Db_BufSz = Db_BufSz + 1 ! TMaxIC - Re_BufSz = Re_BufSz + 1 ! CdScaleIC - Re_BufSz = Re_BufSz + 1 ! threshIC - 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%DTIC - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%TMaxIC - Db_Xferred = Db_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%CdScaleIC - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%threshIC - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE MD_PackInputFileType - - SUBROUTINE MD_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(MD_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) :: 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 = 'MD_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%DTIC = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%TMaxIC = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%CdScaleIC = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%threshIC = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE MD_UnPackInputFileType - - SUBROUTINE MD_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MD_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(MD_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 = 'MD_CopyInitInput' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInitInputData%g = SrcInitInputData%g - DstInitInputData%rhoW = SrcInitInputData%rhoW - DstInitInputData%WtrDepth = SrcInitInputData%WtrDepth -IF (ALLOCATED(SrcInitInputData%PtfmInit)) THEN - i1_l = LBOUND(SrcInitInputData%PtfmInit,1) - i1_u = UBOUND(SrcInitInputData%PtfmInit,1) - i2_l = LBOUND(SrcInitInputData%PtfmInit,2) - i2_u = UBOUND(SrcInitInputData%PtfmInit,2) - IF (.NOT. ALLOCATED(DstInitInputData%PtfmInit)) THEN - ALLOCATE(DstInitInputData%PtfmInit(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%PtfmInit.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%PtfmInit = SrcInitInputData%PtfmInit -ENDIF - DstInitInputData%FarmSize = SrcInitInputData%FarmSize -IF (ALLOCATED(SrcInitInputData%TurbineRefPos)) THEN - i1_l = LBOUND(SrcInitInputData%TurbineRefPos,1) - i1_u = UBOUND(SrcInitInputData%TurbineRefPos,1) - i2_l = LBOUND(SrcInitInputData%TurbineRefPos,2) - i2_u = UBOUND(SrcInitInputData%TurbineRefPos,2) - IF (.NOT. ALLOCATED(DstInitInputData%TurbineRefPos)) THEN - ALLOCATE(DstInitInputData%TurbineRefPos(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%TurbineRefPos.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%TurbineRefPos = SrcInitInputData%TurbineRefPos -ENDIF - DstInitInputData%Tmax = SrcInitInputData%Tmax - DstInitInputData%FileName = SrcInitInputData%FileName - DstInitInputData%RootName = SrcInitInputData%RootName - DstInitInputData%UsePrimaryInputFile = SrcInitInputData%UsePrimaryInputFile - CALL NWTC_Library_Copyfileinfotype( SrcInitInputData%PassedPrimaryInputData, DstInitInputData%PassedPrimaryInputData, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstInitInputData%Echo = SrcInitInputData%Echo -IF (ALLOCATED(SrcInitInputData%OutList)) THEN - i1_l = LBOUND(SrcInitInputData%OutList,1) - i1_u = UBOUND(SrcInitInputData%OutList,1) - IF (.NOT. ALLOCATED(DstInitInputData%OutList)) THEN - ALLOCATE(DstInitInputData%OutList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%OutList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%OutList = SrcInitInputData%OutList -ENDIF - DstInitInputData%Linearize = SrcInitInputData%Linearize - DstInitInputData%VisMeshes = SrcInitInputData%VisMeshes -IF (ALLOCATED(SrcInitInputData%WaveVel)) THEN - i1_l = LBOUND(SrcInitInputData%WaveVel,1) - i1_u = UBOUND(SrcInitInputData%WaveVel,1) - i2_l = LBOUND(SrcInitInputData%WaveVel,2) - i2_u = UBOUND(SrcInitInputData%WaveVel,2) - i3_l = LBOUND(SrcInitInputData%WaveVel,3) - i3_u = UBOUND(SrcInitInputData%WaveVel,3) - IF (.NOT. ALLOCATED(DstInitInputData%WaveVel)) THEN - ALLOCATE(DstInitInputData%WaveVel(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%WaveVel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%WaveVel = SrcInitInputData%WaveVel -ENDIF -IF (ALLOCATED(SrcInitInputData%WaveAcc)) THEN - i1_l = LBOUND(SrcInitInputData%WaveAcc,1) - i1_u = UBOUND(SrcInitInputData%WaveAcc,1) - i2_l = LBOUND(SrcInitInputData%WaveAcc,2) - i2_u = UBOUND(SrcInitInputData%WaveAcc,2) - i3_l = LBOUND(SrcInitInputData%WaveAcc,3) - i3_u = UBOUND(SrcInitInputData%WaveAcc,3) - IF (.NOT. ALLOCATED(DstInitInputData%WaveAcc)) THEN - ALLOCATE(DstInitInputData%WaveAcc(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%WaveAcc.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%WaveAcc = SrcInitInputData%WaveAcc -ENDIF -IF (ALLOCATED(SrcInitInputData%WavePDyn)) THEN - i1_l = LBOUND(SrcInitInputData%WavePDyn,1) - i1_u = UBOUND(SrcInitInputData%WavePDyn,1) - i2_l = LBOUND(SrcInitInputData%WavePDyn,2) - i2_u = UBOUND(SrcInitInputData%WavePDyn,2) - IF (.NOT. ALLOCATED(DstInitInputData%WavePDyn)) THEN - ALLOCATE(DstInitInputData%WavePDyn(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WavePDyn.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%WavePDyn = SrcInitInputData%WavePDyn -ENDIF -IF (ALLOCATED(SrcInitInputData%WaveElev)) THEN - i1_l = LBOUND(SrcInitInputData%WaveElev,1) - i1_u = UBOUND(SrcInitInputData%WaveElev,1) - i2_l = LBOUND(SrcInitInputData%WaveElev,2) - i2_u = UBOUND(SrcInitInputData%WaveElev,2) - IF (.NOT. ALLOCATED(DstInitInputData%WaveElev)) THEN - ALLOCATE(DstInitInputData%WaveElev(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveElev.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%WaveElev = SrcInitInputData%WaveElev -ENDIF -IF (ALLOCATED(SrcInitInputData%WaveTime)) THEN - i1_l = LBOUND(SrcInitInputData%WaveTime,1) - i1_u = UBOUND(SrcInitInputData%WaveTime,1) - IF (.NOT. ALLOCATED(DstInitInputData%WaveTime)) THEN - ALLOCATE(DstInitInputData%WaveTime(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveTime.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%WaveTime = SrcInitInputData%WaveTime -ENDIF - END SUBROUTINE MD_CopyInitInput - - SUBROUTINE MD_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(MD_InitInputType), INTENT(INOUT) :: InitInputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_DestroyInitInput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(InitInputData%PtfmInit)) THEN - DEALLOCATE(InitInputData%PtfmInit) -ENDIF -IF (ALLOCATED(InitInputData%TurbineRefPos)) THEN - DEALLOCATE(InitInputData%TurbineRefPos) -ENDIF - CALL NWTC_Library_Destroyfileinfotype( InitInputData%PassedPrimaryInputData, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(InitInputData%OutList)) THEN - DEALLOCATE(InitInputData%OutList) -ENDIF -IF (ALLOCATED(InitInputData%WaveVel)) THEN - DEALLOCATE(InitInputData%WaveVel) -ENDIF -IF (ALLOCATED(InitInputData%WaveAcc)) THEN - DEALLOCATE(InitInputData%WaveAcc) -ENDIF -IF (ALLOCATED(InitInputData%WavePDyn)) THEN - DEALLOCATE(InitInputData%WavePDyn) -ENDIF -IF (ALLOCATED(InitInputData%WaveElev)) THEN - DEALLOCATE(InitInputData%WaveElev) -ENDIF -IF (ALLOCATED(InitInputData%WaveTime)) THEN - DEALLOCATE(InitInputData%WaveTime) -ENDIF - END SUBROUTINE MD_DestroyInitInput - - SUBROUTINE MD_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(MD_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 = 'MD_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 - Re_BufSz = Re_BufSz + 1 ! g - Re_BufSz = Re_BufSz + 1 ! rhoW - Re_BufSz = Re_BufSz + 1 ! WtrDepth - Int_BufSz = Int_BufSz + 1 ! PtfmInit allocated yes/no - IF ( ALLOCATED(InData%PtfmInit) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PtfmInit upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PtfmInit) ! PtfmInit - END IF - Int_BufSz = Int_BufSz + 1 ! FarmSize - Int_BufSz = Int_BufSz + 1 ! TurbineRefPos allocated yes/no - IF ( ALLOCATED(InData%TurbineRefPos) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! TurbineRefPos upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TurbineRefPos) ! TurbineRefPos - END IF - Re_BufSz = Re_BufSz + 1 ! Tmax - Int_BufSz = Int_BufSz + 1*LEN(InData%FileName) ! FileName - Int_BufSz = Int_BufSz + 1*LEN(InData%RootName) ! RootName - Int_BufSz = Int_BufSz + 1 ! UsePrimaryInputFile - ! 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 ! Echo - 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 ! Linearize - Int_BufSz = Int_BufSz + 1 ! VisMeshes - Int_BufSz = Int_BufSz + 1 ! WaveVel allocated yes/no - IF ( ALLOCATED(InData%WaveVel) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! WaveVel upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveVel) ! WaveVel - END IF - Int_BufSz = Int_BufSz + 1 ! WaveAcc allocated yes/no - IF ( ALLOCATED(InData%WaveAcc) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! WaveAcc upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveAcc) ! WaveAcc - END IF - Int_BufSz = Int_BufSz + 1 ! WavePDyn allocated yes/no - IF ( ALLOCATED(InData%WavePDyn) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! WavePDyn upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WavePDyn) ! WavePDyn - END IF - Int_BufSz = Int_BufSz + 1 ! WaveElev allocated yes/no - IF ( ALLOCATED(InData%WaveElev) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! WaveElev upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveElev) ! WaveElev - END IF - Int_BufSz = Int_BufSz + 1 ! WaveTime allocated yes/no - IF ( ALLOCATED(InData%WaveTime) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WaveTime upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%WaveTime) ! WaveTime - 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%g - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%rhoW - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WtrDepth - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%PtfmInit) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PtfmInit,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PtfmInit,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PtfmInit,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PtfmInit,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PtfmInit,2), UBOUND(InData%PtfmInit,2) - DO i1 = LBOUND(InData%PtfmInit,1), UBOUND(InData%PtfmInit,1) - ReKiBuf(Re_Xferred) = InData%PtfmInit(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%FarmSize - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%TurbineRefPos) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TurbineRefPos,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TurbineRefPos,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TurbineRefPos,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TurbineRefPos,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%TurbineRefPos,2), UBOUND(InData%TurbineRefPos,2) - DO i1 = LBOUND(InData%TurbineRefPos,1), UBOUND(InData%TurbineRefPos,1) - ReKiBuf(Re_Xferred) = InData%TurbineRefPos(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - ReKiBuf(Re_Xferred) = InData%Tmax - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(InData%FileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%FileName(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 - IntKiBuf(Int_Xferred) = TRANSFER(InData%UsePrimaryInputFile, 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%Echo, IntKiBuf(1)) - 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 - IntKiBuf(Int_Xferred) = TRANSFER(InData%Linearize, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%VisMeshes, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%WaveVel) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%WaveVel,3), UBOUND(InData%WaveVel,3) - DO i2 = LBOUND(InData%WaveVel,2), UBOUND(InData%WaveVel,2) - DO i1 = LBOUND(InData%WaveVel,1), UBOUND(InData%WaveVel,1) - ReKiBuf(Re_Xferred) = InData%WaveVel(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveAcc) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%WaveAcc,3), UBOUND(InData%WaveAcc,3) - DO i2 = LBOUND(InData%WaveAcc,2), UBOUND(InData%WaveAcc,2) - DO i1 = LBOUND(InData%WaveAcc,1), UBOUND(InData%WaveAcc,1) - ReKiBuf(Re_Xferred) = InData%WaveAcc(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WavePDyn) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WavePDyn,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WavePDyn,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WavePDyn,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WavePDyn,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%WavePDyn,2), UBOUND(InData%WavePDyn,2) - DO i1 = LBOUND(InData%WavePDyn,1), UBOUND(InData%WavePDyn,1) - ReKiBuf(Re_Xferred) = InData%WavePDyn(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveElev) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%WaveElev,2), UBOUND(InData%WaveElev,2) - DO i1 = LBOUND(InData%WaveElev,1), UBOUND(InData%WaveElev,1) - ReKiBuf(Re_Xferred) = InData%WaveElev(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveTime) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveTime,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveTime,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WaveTime,1), UBOUND(InData%WaveTime,1) - DbKiBuf(Db_Xferred) = InData%WaveTime(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE MD_PackInitInput - - SUBROUTINE MD_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(MD_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 = 'MD_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%g = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%rhoW = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%WtrDepth = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PtfmInit not allocated - Int_Xferred = Int_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%PtfmInit)) DEALLOCATE(OutData%PtfmInit) - ALLOCATE(OutData%PtfmInit(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmInit.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PtfmInit,2), UBOUND(OutData%PtfmInit,2) - DO i1 = LBOUND(OutData%PtfmInit,1), UBOUND(OutData%PtfmInit,1) - OutData%PtfmInit(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%FarmSize = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TurbineRefPos not allocated - Int_Xferred = Int_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%TurbineRefPos)) DEALLOCATE(OutData%TurbineRefPos) - ALLOCATE(OutData%TurbineRefPos(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TurbineRefPos.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%TurbineRefPos,2), UBOUND(OutData%TurbineRefPos,2) - DO i1 = LBOUND(OutData%TurbineRefPos,1), UBOUND(OutData%TurbineRefPos,1) - OutData%TurbineRefPos(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%Tmax = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(OutData%FileName) - OutData%FileName(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%UsePrimaryInputFile = TRANSFER(IntKiBuf(Int_Xferred), OutData%UsePrimaryInputFile) - 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%Echo = TRANSFER(IntKiBuf(Int_Xferred), OutData%Echo) - 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 - OutData%Linearize = TRANSFER(IntKiBuf(Int_Xferred), OutData%Linearize) - Int_Xferred = Int_Xferred + 1 - OutData%VisMeshes = TRANSFER(IntKiBuf(Int_Xferred), OutData%VisMeshes) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveVel not allocated - Int_Xferred = Int_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%WaveVel)) DEALLOCATE(OutData%WaveVel) - ALLOCATE(OutData%WaveVel(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%WaveVel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%WaveVel,3), UBOUND(OutData%WaveVel,3) - DO i2 = LBOUND(OutData%WaveVel,2), UBOUND(OutData%WaveVel,2) - DO i1 = LBOUND(OutData%WaveVel,1), UBOUND(OutData%WaveVel,1) - OutData%WaveVel(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 ! WaveAcc not allocated - Int_Xferred = Int_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%WaveAcc)) DEALLOCATE(OutData%WaveAcc) - ALLOCATE(OutData%WaveAcc(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%WaveAcc.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%WaveAcc,3), UBOUND(OutData%WaveAcc,3) - DO i2 = LBOUND(OutData%WaveAcc,2), UBOUND(OutData%WaveAcc,2) - DO i1 = LBOUND(OutData%WaveAcc,1), UBOUND(OutData%WaveAcc,1) - OutData%WaveAcc(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 ! WavePDyn not allocated - Int_Xferred = Int_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%WavePDyn)) DEALLOCATE(OutData%WavePDyn) - ALLOCATE(OutData%WavePDyn(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WavePDyn.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%WavePDyn,2), UBOUND(OutData%WavePDyn,2) - DO i1 = LBOUND(OutData%WavePDyn,1), UBOUND(OutData%WavePDyn,1) - OutData%WavePDyn(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElev not allocated - Int_Xferred = Int_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%WaveElev)) DEALLOCATE(OutData%WaveElev) - ALLOCATE(OutData%WaveElev(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%WaveElev,2), UBOUND(OutData%WaveElev,2) - DO i1 = LBOUND(OutData%WaveElev,1), UBOUND(OutData%WaveElev,1) - OutData%WaveElev(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveTime not allocated - Int_Xferred = Int_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%WaveTime)) DEALLOCATE(OutData%WaveTime) - ALLOCATE(OutData%WaveTime(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveTime.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WaveTime,1), UBOUND(OutData%WaveTime,1) - OutData%WaveTime(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE MD_UnPackInitInput - - SUBROUTINE MD_CopyLineProp( SrcLinePropData, DstLinePropData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MD_LineProp), INTENT(IN) :: SrcLinePropData - TYPE(MD_LineProp), INTENT(INOUT) :: DstLinePropData - 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 = 'MD_CopyLineProp' -! - ErrStat = ErrID_None - ErrMsg = "" - DstLinePropData%IdNum = SrcLinePropData%IdNum - DstLinePropData%name = SrcLinePropData%name - DstLinePropData%d = SrcLinePropData%d - DstLinePropData%w = SrcLinePropData%w - DstLinePropData%EA = SrcLinePropData%EA - DstLinePropData%EA_D = SrcLinePropData%EA_D - DstLinePropData%BA = SrcLinePropData%BA - DstLinePropData%BA_D = SrcLinePropData%BA_D - DstLinePropData%EI = SrcLinePropData%EI - DstLinePropData%Can = SrcLinePropData%Can - DstLinePropData%Cat = SrcLinePropData%Cat - DstLinePropData%Cdn = SrcLinePropData%Cdn - DstLinePropData%Cdt = SrcLinePropData%Cdt - DstLinePropData%ElasticMod = SrcLinePropData%ElasticMod - DstLinePropData%nEApoints = SrcLinePropData%nEApoints - DstLinePropData%stiffXs = SrcLinePropData%stiffXs - DstLinePropData%stiffYs = SrcLinePropData%stiffYs - DstLinePropData%nBApoints = SrcLinePropData%nBApoints - DstLinePropData%dampXs = SrcLinePropData%dampXs - DstLinePropData%dampYs = SrcLinePropData%dampYs - DstLinePropData%nEIpoints = SrcLinePropData%nEIpoints - DstLinePropData%bstiffXs = SrcLinePropData%bstiffXs - DstLinePropData%bstiffYs = SrcLinePropData%bstiffYs - END SUBROUTINE MD_CopyLineProp - - SUBROUTINE MD_DestroyLineProp( LinePropData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(MD_LineProp), INTENT(INOUT) :: LinePropData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_DestroyLineProp' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE MD_DestroyLineProp - - SUBROUTINE MD_PackLineProp( 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(MD_LineProp), 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 = 'MD_PackLineProp' - ! 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 ! IdNum - Int_BufSz = Int_BufSz + 1*LEN(InData%name) ! name - Db_BufSz = Db_BufSz + 1 ! d - Db_BufSz = Db_BufSz + 1 ! w - Db_BufSz = Db_BufSz + 1 ! EA - Db_BufSz = Db_BufSz + 1 ! EA_D - Db_BufSz = Db_BufSz + 1 ! BA - Db_BufSz = Db_BufSz + 1 ! BA_D - Db_BufSz = Db_BufSz + 1 ! EI - Db_BufSz = Db_BufSz + 1 ! Can - Db_BufSz = Db_BufSz + 1 ! Cat - Db_BufSz = Db_BufSz + 1 ! Cdn - Db_BufSz = Db_BufSz + 1 ! Cdt - Int_BufSz = Int_BufSz + 1 ! ElasticMod - Int_BufSz = Int_BufSz + 1 ! nEApoints - Db_BufSz = Db_BufSz + SIZE(InData%stiffXs) ! stiffXs - Db_BufSz = Db_BufSz + SIZE(InData%stiffYs) ! stiffYs - Int_BufSz = Int_BufSz + 1 ! nBApoints - Db_BufSz = Db_BufSz + SIZE(InData%dampXs) ! dampXs - Db_BufSz = Db_BufSz + SIZE(InData%dampYs) ! dampYs - Int_BufSz = Int_BufSz + 1 ! nEIpoints - Db_BufSz = Db_BufSz + SIZE(InData%bstiffXs) ! bstiffXs - Db_BufSz = Db_BufSz + SIZE(InData%bstiffYs) ! bstiffYs - 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%IdNum - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%name) - IntKiBuf(Int_Xferred) = ICHAR(InData%name(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DbKiBuf(Db_Xferred) = InData%d - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%w - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%EA - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%EA_D - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%BA - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%BA_D - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%EI - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%Can - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%Cat - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%Cdn - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%Cdt - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%ElasticMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nEApoints - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%stiffXs,1), UBOUND(InData%stiffXs,1) - DbKiBuf(Db_Xferred) = InData%stiffXs(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%stiffYs,1), UBOUND(InData%stiffYs,1) - DbKiBuf(Db_Xferred) = InData%stiffYs(i1) - Db_Xferred = Db_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%nBApoints - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%dampXs,1), UBOUND(InData%dampXs,1) - DbKiBuf(Db_Xferred) = InData%dampXs(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%dampYs,1), UBOUND(InData%dampYs,1) - DbKiBuf(Db_Xferred) = InData%dampYs(i1) - Db_Xferred = Db_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%nEIpoints - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%bstiffXs,1), UBOUND(InData%bstiffXs,1) - DbKiBuf(Db_Xferred) = InData%bstiffXs(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%bstiffYs,1), UBOUND(InData%bstiffYs,1) - DbKiBuf(Db_Xferred) = InData%bstiffYs(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END SUBROUTINE MD_PackLineProp - - SUBROUTINE MD_UnPackLineProp( 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(MD_LineProp), 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 = 'MD_UnPackLineProp' - ! 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%IdNum = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%name) - OutData%name(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%d = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%w = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%EA = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%EA_D = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%BA = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%BA_D = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%EI = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%Can = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%Cat = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%Cdn = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%Cdt = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%ElasticMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nEApoints = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%stiffXs,1) - i1_u = UBOUND(OutData%stiffXs,1) - DO i1 = LBOUND(OutData%stiffXs,1), UBOUND(OutData%stiffXs,1) - OutData%stiffXs(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%stiffYs,1) - i1_u = UBOUND(OutData%stiffYs,1) - DO i1 = LBOUND(OutData%stiffYs,1), UBOUND(OutData%stiffYs,1) - OutData%stiffYs(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - OutData%nBApoints = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%dampXs,1) - i1_u = UBOUND(OutData%dampXs,1) - DO i1 = LBOUND(OutData%dampXs,1), UBOUND(OutData%dampXs,1) - OutData%dampXs(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%dampYs,1) - i1_u = UBOUND(OutData%dampYs,1) - DO i1 = LBOUND(OutData%dampYs,1), UBOUND(OutData%dampYs,1) - OutData%dampYs(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - OutData%nEIpoints = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%bstiffXs,1) - i1_u = UBOUND(OutData%bstiffXs,1) - DO i1 = LBOUND(OutData%bstiffXs,1), UBOUND(OutData%bstiffXs,1) - OutData%bstiffXs(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%bstiffYs,1) - i1_u = UBOUND(OutData%bstiffYs,1) - DO i1 = LBOUND(OutData%bstiffYs,1), UBOUND(OutData%bstiffYs,1) - OutData%bstiffYs(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END SUBROUTINE MD_UnPackLineProp - - SUBROUTINE MD_CopyRodProp( SrcRodPropData, DstRodPropData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MD_RodProp), INTENT(IN) :: SrcRodPropData - TYPE(MD_RodProp), INTENT(INOUT) :: DstRodPropData - 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 = 'MD_CopyRodProp' -! - ErrStat = ErrID_None - ErrMsg = "" - DstRodPropData%IdNum = SrcRodPropData%IdNum - DstRodPropData%name = SrcRodPropData%name - DstRodPropData%d = SrcRodPropData%d - DstRodPropData%w = SrcRodPropData%w - DstRodPropData%Can = SrcRodPropData%Can - DstRodPropData%Cat = SrcRodPropData%Cat - DstRodPropData%Cdn = SrcRodPropData%Cdn - DstRodPropData%Cdt = SrcRodPropData%Cdt - DstRodPropData%CdEnd = SrcRodPropData%CdEnd - DstRodPropData%CaEnd = SrcRodPropData%CaEnd - END SUBROUTINE MD_CopyRodProp - - SUBROUTINE MD_DestroyRodProp( RodPropData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(MD_RodProp), INTENT(INOUT) :: RodPropData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_DestroyRodProp' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE MD_DestroyRodProp - - SUBROUTINE MD_PackRodProp( 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(MD_RodProp), 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 = 'MD_PackRodProp' - ! 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 ! IdNum - Int_BufSz = Int_BufSz + 1*LEN(InData%name) ! name - Db_BufSz = Db_BufSz + 1 ! d - Db_BufSz = Db_BufSz + 1 ! w - Db_BufSz = Db_BufSz + 1 ! Can - Db_BufSz = Db_BufSz + 1 ! Cat - Db_BufSz = Db_BufSz + 1 ! Cdn - Db_BufSz = Db_BufSz + 1 ! Cdt - Db_BufSz = Db_BufSz + 1 ! CdEnd - Db_BufSz = Db_BufSz + 1 ! CaEnd - 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%IdNum - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%name) - IntKiBuf(Int_Xferred) = ICHAR(InData%name(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DbKiBuf(Db_Xferred) = InData%d - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%w - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%Can - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%Cat - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%Cdn - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%Cdt - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%CdEnd - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%CaEnd - Db_Xferred = Db_Xferred + 1 - END SUBROUTINE MD_PackRodProp - - SUBROUTINE MD_UnPackRodProp( 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(MD_RodProp), 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 = 'MD_UnPackRodProp' - ! 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%IdNum = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%name) - OutData%name(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%d = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%w = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%Can = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%Cat = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%Cdn = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%Cdt = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%CdEnd = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%CaEnd = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END SUBROUTINE MD_UnPackRodProp - - SUBROUTINE MD_CopyBody( SrcBodyData, DstBodyData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MD_Body), INTENT(IN) :: SrcBodyData - TYPE(MD_Body), INTENT(INOUT) :: DstBodyData - 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 = 'MD_CopyBody' -! - ErrStat = ErrID_None - ErrMsg = "" - DstBodyData%IdNum = SrcBodyData%IdNum - DstBodyData%typeNum = SrcBodyData%typeNum - DstBodyData%AttachedC = SrcBodyData%AttachedC - DstBodyData%AttachedR = SrcBodyData%AttachedR - DstBodyData%nAttachedC = SrcBodyData%nAttachedC - DstBodyData%nAttachedR = SrcBodyData%nAttachedR - DstBodyData%rPointRel = SrcBodyData%rPointRel - DstBodyData%r6RodRel = SrcBodyData%r6RodRel - DstBodyData%bodyM = SrcBodyData%bodyM - DstBodyData%bodyV = SrcBodyData%bodyV - DstBodyData%bodyI = SrcBodyData%bodyI - DstBodyData%bodyCdA = SrcBodyData%bodyCdA - DstBodyData%bodyCa = SrcBodyData%bodyCa - DstBodyData%time = SrcBodyData%time - DstBodyData%r6 = SrcBodyData%r6 - DstBodyData%v6 = SrcBodyData%v6 - DstBodyData%a6 = SrcBodyData%a6 - DstBodyData%U = SrcBodyData%U - DstBodyData%Ud = SrcBodyData%Ud - DstBodyData%zeta = SrcBodyData%zeta - DstBodyData%F6net = SrcBodyData%F6net - DstBodyData%M6net = SrcBodyData%M6net - DstBodyData%M = SrcBodyData%M - DstBodyData%M0 = SrcBodyData%M0 - DstBodyData%OrMat = SrcBodyData%OrMat - DstBodyData%rCG = SrcBodyData%rCG - END SUBROUTINE MD_CopyBody - - SUBROUTINE MD_DestroyBody( BodyData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(MD_Body), INTENT(INOUT) :: BodyData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_DestroyBody' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE MD_DestroyBody - - SUBROUTINE MD_PackBody( 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(MD_Body), 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 = 'MD_PackBody' - ! 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 ! IdNum - Int_BufSz = Int_BufSz + 1 ! typeNum - Int_BufSz = Int_BufSz + SIZE(InData%AttachedC) ! AttachedC - Int_BufSz = Int_BufSz + SIZE(InData%AttachedR) ! AttachedR - Int_BufSz = Int_BufSz + 1 ! nAttachedC - Int_BufSz = Int_BufSz + 1 ! nAttachedR - Db_BufSz = Db_BufSz + SIZE(InData%rPointRel) ! rPointRel - Db_BufSz = Db_BufSz + SIZE(InData%r6RodRel) ! r6RodRel - Db_BufSz = Db_BufSz + 1 ! bodyM - Db_BufSz = Db_BufSz + 1 ! bodyV - Db_BufSz = Db_BufSz + SIZE(InData%bodyI) ! bodyI - Db_BufSz = Db_BufSz + SIZE(InData%bodyCdA) ! bodyCdA - Db_BufSz = Db_BufSz + SIZE(InData%bodyCa) ! bodyCa - Db_BufSz = Db_BufSz + 1 ! time - Db_BufSz = Db_BufSz + SIZE(InData%r6) ! r6 - Db_BufSz = Db_BufSz + SIZE(InData%v6) ! v6 - Db_BufSz = Db_BufSz + SIZE(InData%a6) ! a6 - Db_BufSz = Db_BufSz + SIZE(InData%U) ! U - Db_BufSz = Db_BufSz + SIZE(InData%Ud) ! Ud - Db_BufSz = Db_BufSz + 1 ! zeta - Db_BufSz = Db_BufSz + SIZE(InData%F6net) ! F6net - Db_BufSz = Db_BufSz + SIZE(InData%M6net) ! M6net - Db_BufSz = Db_BufSz + SIZE(InData%M) ! M - Db_BufSz = Db_BufSz + SIZE(InData%M0) ! M0 - Db_BufSz = Db_BufSz + SIZE(InData%OrMat) ! OrMat - Db_BufSz = Db_BufSz + SIZE(InData%rCG) ! rCG - 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%IdNum - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%typeNum - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%AttachedC,1), UBOUND(InData%AttachedC,1) - IntKiBuf(Int_Xferred) = InData%AttachedC(i1) - Int_Xferred = Int_Xferred + 1 - END DO - DO i1 = LBOUND(InData%AttachedR,1), UBOUND(InData%AttachedR,1) - IntKiBuf(Int_Xferred) = InData%AttachedR(i1) - Int_Xferred = Int_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%nAttachedC - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nAttachedR - Int_Xferred = Int_Xferred + 1 - DO i2 = LBOUND(InData%rPointRel,2), UBOUND(InData%rPointRel,2) - DO i1 = LBOUND(InData%rPointRel,1), UBOUND(InData%rPointRel,1) - DbKiBuf(Db_Xferred) = InData%rPointRel(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - DO i2 = LBOUND(InData%r6RodRel,2), UBOUND(InData%r6RodRel,2) - DO i1 = LBOUND(InData%r6RodRel,1), UBOUND(InData%r6RodRel,1) - DbKiBuf(Db_Xferred) = InData%r6RodRel(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - DbKiBuf(Db_Xferred) = InData%bodyM - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%bodyV - Db_Xferred = Db_Xferred + 1 - DO i1 = LBOUND(InData%bodyI,1), UBOUND(InData%bodyI,1) - DbKiBuf(Db_Xferred) = InData%bodyI(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%bodyCdA,1), UBOUND(InData%bodyCdA,1) - DbKiBuf(Db_Xferred) = InData%bodyCdA(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%bodyCa,1), UBOUND(InData%bodyCa,1) - DbKiBuf(Db_Xferred) = InData%bodyCa(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DbKiBuf(Db_Xferred) = InData%time - Db_Xferred = Db_Xferred + 1 - DO i1 = LBOUND(InData%r6,1), UBOUND(InData%r6,1) - DbKiBuf(Db_Xferred) = InData%r6(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%v6,1), UBOUND(InData%v6,1) - DbKiBuf(Db_Xferred) = InData%v6(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%a6,1), UBOUND(InData%a6,1) - DbKiBuf(Db_Xferred) = InData%a6(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%U,1), UBOUND(InData%U,1) - DbKiBuf(Db_Xferred) = InData%U(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%Ud,1), UBOUND(InData%Ud,1) - DbKiBuf(Db_Xferred) = InData%Ud(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DbKiBuf(Db_Xferred) = InData%zeta - Db_Xferred = Db_Xferred + 1 - DO i1 = LBOUND(InData%F6net,1), UBOUND(InData%F6net,1) - DbKiBuf(Db_Xferred) = InData%F6net(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i2 = LBOUND(InData%M6net,2), UBOUND(InData%M6net,2) - DO i1 = LBOUND(InData%M6net,1), UBOUND(InData%M6net,1) - DbKiBuf(Db_Xferred) = InData%M6net(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - 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 - DO i2 = LBOUND(InData%M0,2), UBOUND(InData%M0,2) - DO i1 = LBOUND(InData%M0,1), UBOUND(InData%M0,1) - DbKiBuf(Db_Xferred) = InData%M0(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - DO i2 = LBOUND(InData%OrMat,2), UBOUND(InData%OrMat,2) - DO i1 = LBOUND(InData%OrMat,1), UBOUND(InData%OrMat,1) - DbKiBuf(Db_Xferred) = InData%OrMat(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - DO i1 = LBOUND(InData%rCG,1), UBOUND(InData%rCG,1) - DbKiBuf(Db_Xferred) = InData%rCG(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END SUBROUTINE MD_PackBody - - SUBROUTINE MD_UnPackBody( 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(MD_Body), 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 = 'MD_UnPackBody' - ! 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%IdNum = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%typeNum = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%AttachedC,1) - i1_u = UBOUND(OutData%AttachedC,1) - DO i1 = LBOUND(OutData%AttachedC,1), UBOUND(OutData%AttachedC,1) - OutData%AttachedC(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - i1_l = LBOUND(OutData%AttachedR,1) - i1_u = UBOUND(OutData%AttachedR,1) - DO i1 = LBOUND(OutData%AttachedR,1), UBOUND(OutData%AttachedR,1) - OutData%AttachedR(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - OutData%nAttachedC = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nAttachedR = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%rPointRel,1) - i1_u = UBOUND(OutData%rPointRel,1) - i2_l = LBOUND(OutData%rPointRel,2) - i2_u = UBOUND(OutData%rPointRel,2) - DO i2 = LBOUND(OutData%rPointRel,2), UBOUND(OutData%rPointRel,2) - DO i1 = LBOUND(OutData%rPointRel,1), UBOUND(OutData%rPointRel,1) - OutData%rPointRel(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%r6RodRel,1) - i1_u = UBOUND(OutData%r6RodRel,1) - i2_l = LBOUND(OutData%r6RodRel,2) - i2_u = UBOUND(OutData%r6RodRel,2) - DO i2 = LBOUND(OutData%r6RodRel,2), UBOUND(OutData%r6RodRel,2) - DO i1 = LBOUND(OutData%r6RodRel,1), UBOUND(OutData%r6RodRel,1) - OutData%r6RodRel(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - OutData%bodyM = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%bodyV = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - i1_l = LBOUND(OutData%bodyI,1) - i1_u = UBOUND(OutData%bodyI,1) - DO i1 = LBOUND(OutData%bodyI,1), UBOUND(OutData%bodyI,1) - OutData%bodyI(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%bodyCdA,1) - i1_u = UBOUND(OutData%bodyCdA,1) - DO i1 = LBOUND(OutData%bodyCdA,1), UBOUND(OutData%bodyCdA,1) - OutData%bodyCdA(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%bodyCa,1) - i1_u = UBOUND(OutData%bodyCa,1) - DO i1 = LBOUND(OutData%bodyCa,1), UBOUND(OutData%bodyCa,1) - OutData%bodyCa(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - OutData%time = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - i1_l = LBOUND(OutData%r6,1) - i1_u = UBOUND(OutData%r6,1) - DO i1 = LBOUND(OutData%r6,1), UBOUND(OutData%r6,1) - OutData%r6(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%v6,1) - i1_u = UBOUND(OutData%v6,1) - DO i1 = LBOUND(OutData%v6,1), UBOUND(OutData%v6,1) - OutData%v6(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%a6,1) - i1_u = UBOUND(OutData%a6,1) - DO i1 = LBOUND(OutData%a6,1), UBOUND(OutData%a6,1) - OutData%a6(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%U,1) - i1_u = UBOUND(OutData%U,1) - DO i1 = LBOUND(OutData%U,1), UBOUND(OutData%U,1) - OutData%U(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%Ud,1) - i1_u = UBOUND(OutData%Ud,1) - DO i1 = LBOUND(OutData%Ud,1), UBOUND(OutData%Ud,1) - OutData%Ud(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - OutData%zeta = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - i1_l = LBOUND(OutData%F6net,1) - i1_u = UBOUND(OutData%F6net,1) - DO i1 = LBOUND(OutData%F6net,1), UBOUND(OutData%F6net,1) - OutData%F6net(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%M6net,1) - i1_u = UBOUND(OutData%M6net,1) - i2_l = LBOUND(OutData%M6net,2) - i2_u = UBOUND(OutData%M6net,2) - DO i2 = LBOUND(OutData%M6net,2), UBOUND(OutData%M6net,2) - DO i1 = LBOUND(OutData%M6net,1), UBOUND(OutData%M6net,1) - OutData%M6net(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%M,1) - i1_u = UBOUND(OutData%M,1) - i2_l = LBOUND(OutData%M,2) - i2_u = UBOUND(OutData%M,2) - DO i2 = LBOUND(OutData%M,2), UBOUND(OutData%M,2) - DO i1 = LBOUND(OutData%M,1), UBOUND(OutData%M,1) - OutData%M(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%M0,1) - i1_u = UBOUND(OutData%M0,1) - i2_l = LBOUND(OutData%M0,2) - i2_u = UBOUND(OutData%M0,2) - DO i2 = LBOUND(OutData%M0,2), UBOUND(OutData%M0,2) - DO i1 = LBOUND(OutData%M0,1), UBOUND(OutData%M0,1) - OutData%M0(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%OrMat,1) - i1_u = UBOUND(OutData%OrMat,1) - i2_l = LBOUND(OutData%OrMat,2) - i2_u = UBOUND(OutData%OrMat,2) - DO i2 = LBOUND(OutData%OrMat,2), UBOUND(OutData%OrMat,2) - DO i1 = LBOUND(OutData%OrMat,1), UBOUND(OutData%OrMat,1) - OutData%OrMat(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%rCG,1) - i1_u = UBOUND(OutData%rCG,1) - DO i1 = LBOUND(OutData%rCG,1), UBOUND(OutData%rCG,1) - OutData%rCG(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END SUBROUTINE MD_UnPackBody - - SUBROUTINE MD_CopyPoint( SrcPointData, DstPointData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MD_Point), INTENT(IN) :: SrcPointData - TYPE(MD_Point), INTENT(INOUT) :: DstPointData - 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 = 'MD_CopyPoint' -! - ErrStat = ErrID_None - ErrMsg = "" - DstPointData%IdNum = SrcPointData%IdNum - DstPointData%type = SrcPointData%type - DstPointData%typeNum = SrcPointData%typeNum - DstPointData%Attached = SrcPointData%Attached - DstPointData%Top = SrcPointData%Top - DstPointData%nAttached = SrcPointData%nAttached - DstPointData%pointM = SrcPointData%pointM - DstPointData%pointV = SrcPointData%pointV - DstPointData%pointFX = SrcPointData%pointFX - DstPointData%pointFY = SrcPointData%pointFY - DstPointData%pointFZ = SrcPointData%pointFZ - DstPointData%pointCa = SrcPointData%pointCa - DstPointData%pointCdA = SrcPointData%pointCdA - DstPointData%time = SrcPointData%time - DstPointData%r = SrcPointData%r - DstPointData%rd = SrcPointData%rd - DstPointData%a = SrcPointData%a - DstPointData%U = SrcPointData%U - DstPointData%Ud = SrcPointData%Ud - DstPointData%zeta = SrcPointData%zeta -IF (ALLOCATED(SrcPointData%PDyn)) THEN - i1_l = LBOUND(SrcPointData%PDyn,1) - i1_u = UBOUND(SrcPointData%PDyn,1) - IF (.NOT. ALLOCATED(DstPointData%PDyn)) THEN - ALLOCATE(DstPointData%PDyn(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstPointData%PDyn.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstPointData%PDyn = SrcPointData%PDyn -ENDIF - DstPointData%Fnet = SrcPointData%Fnet - DstPointData%M = SrcPointData%M - END SUBROUTINE MD_CopyPoint - - SUBROUTINE MD_DestroyPoint( PointData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(MD_Point), INTENT(INOUT) :: PointData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_DestroyPoint' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(PointData%PDyn)) THEN - DEALLOCATE(PointData%PDyn) -ENDIF - END SUBROUTINE MD_DestroyPoint - - SUBROUTINE MD_PackPoint( 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(MD_Point), 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 = 'MD_PackPoint' - ! 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 ! IdNum - Int_BufSz = Int_BufSz + 1*LEN(InData%type) ! type - Int_BufSz = Int_BufSz + 1 ! typeNum - Int_BufSz = Int_BufSz + SIZE(InData%Attached) ! Attached - Int_BufSz = Int_BufSz + SIZE(InData%Top) ! Top - Int_BufSz = Int_BufSz + 1 ! nAttached - Db_BufSz = Db_BufSz + 1 ! pointM - Db_BufSz = Db_BufSz + 1 ! pointV - Db_BufSz = Db_BufSz + 1 ! pointFX - Db_BufSz = Db_BufSz + 1 ! pointFY - Db_BufSz = Db_BufSz + 1 ! pointFZ - Db_BufSz = Db_BufSz + 1 ! pointCa - Db_BufSz = Db_BufSz + 1 ! pointCdA - Db_BufSz = Db_BufSz + 1 ! time - Db_BufSz = Db_BufSz + SIZE(InData%r) ! r - Db_BufSz = Db_BufSz + SIZE(InData%rd) ! rd - Db_BufSz = Db_BufSz + SIZE(InData%a) ! a - Db_BufSz = Db_BufSz + SIZE(InData%U) ! U - Db_BufSz = Db_BufSz + SIZE(InData%Ud) ! Ud - Db_BufSz = Db_BufSz + 1 ! zeta - Int_BufSz = Int_BufSz + 1 ! PDyn allocated yes/no - IF ( ALLOCATED(InData%PDyn) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PDyn upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%PDyn) ! PDyn - END IF - Db_BufSz = Db_BufSz + SIZE(InData%Fnet) ! Fnet - Db_BufSz = Db_BufSz + SIZE(InData%M) ! M - 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%IdNum - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%type) - IntKiBuf(Int_Xferred) = ICHAR(InData%type(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = InData%typeNum - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%Attached,1), UBOUND(InData%Attached,1) - IntKiBuf(Int_Xferred) = InData%Attached(i1) - Int_Xferred = Int_Xferred + 1 - END DO - DO i1 = LBOUND(InData%Top,1), UBOUND(InData%Top,1) - IntKiBuf(Int_Xferred) = InData%Top(i1) - Int_Xferred = Int_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%nAttached - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%pointM - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%pointV - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%pointFX - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%pointFY - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%pointFZ - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%pointCa - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%pointCdA - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%time - Db_Xferred = Db_Xferred + 1 - DO i1 = LBOUND(InData%r,1), UBOUND(InData%r,1) - DbKiBuf(Db_Xferred) = InData%r(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%rd,1), UBOUND(InData%rd,1) - DbKiBuf(Db_Xferred) = InData%rd(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%a,1), UBOUND(InData%a,1) - DbKiBuf(Db_Xferred) = InData%a(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%U,1), UBOUND(InData%U,1) - DbKiBuf(Db_Xferred) = InData%U(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%Ud,1), UBOUND(InData%Ud,1) - DbKiBuf(Db_Xferred) = InData%Ud(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DbKiBuf(Db_Xferred) = InData%zeta - Db_Xferred = Db_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%PDyn) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PDyn,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PDyn,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PDyn,1), UBOUND(InData%PDyn,1) - DbKiBuf(Db_Xferred) = InData%PDyn(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - DO i1 = LBOUND(InData%Fnet,1), UBOUND(InData%Fnet,1) - DbKiBuf(Db_Xferred) = InData%Fnet(i1) - Db_Xferred = Db_Xferred + 1 - END DO - 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 SUBROUTINE MD_PackPoint - - SUBROUTINE MD_UnPackPoint( 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(MD_Point), 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 = 'MD_UnPackPoint' - ! 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%IdNum = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%type) - OutData%type(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%typeNum = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%Attached,1) - i1_u = UBOUND(OutData%Attached,1) - DO i1 = LBOUND(OutData%Attached,1), UBOUND(OutData%Attached,1) - OutData%Attached(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - i1_l = LBOUND(OutData%Top,1) - i1_u = UBOUND(OutData%Top,1) - DO i1 = LBOUND(OutData%Top,1), UBOUND(OutData%Top,1) - OutData%Top(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - OutData%nAttached = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%pointM = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%pointV = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%pointFX = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%pointFY = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%pointFZ = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%pointCa = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%pointCdA = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%time = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - i1_l = LBOUND(OutData%r,1) - i1_u = UBOUND(OutData%r,1) - DO i1 = LBOUND(OutData%r,1), UBOUND(OutData%r,1) - OutData%r(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%rd,1) - i1_u = UBOUND(OutData%rd,1) - DO i1 = LBOUND(OutData%rd,1), UBOUND(OutData%rd,1) - OutData%rd(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%a,1) - i1_u = UBOUND(OutData%a,1) - DO i1 = LBOUND(OutData%a,1), UBOUND(OutData%a,1) - OutData%a(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%U,1) - i1_u = UBOUND(OutData%U,1) - DO i1 = LBOUND(OutData%U,1), UBOUND(OutData%U,1) - OutData%U(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%Ud,1) - i1_u = UBOUND(OutData%Ud,1) - DO i1 = LBOUND(OutData%Ud,1), UBOUND(OutData%Ud,1) - OutData%Ud(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - OutData%zeta = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PDyn not allocated - Int_Xferred = Int_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%PDyn)) DEALLOCATE(OutData%PDyn) - ALLOCATE(OutData%PDyn(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PDyn.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PDyn,1), UBOUND(OutData%PDyn,1) - OutData%PDyn(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - i1_l = LBOUND(OutData%Fnet,1) - i1_u = UBOUND(OutData%Fnet,1) - DO i1 = LBOUND(OutData%Fnet,1), UBOUND(OutData%Fnet,1) - OutData%Fnet(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%M,1) - i1_u = UBOUND(OutData%M,1) - i2_l = LBOUND(OutData%M,2) - i2_u = UBOUND(OutData%M,2) - DO i2 = LBOUND(OutData%M,2), UBOUND(OutData%M,2) - DO i1 = LBOUND(OutData%M,1), UBOUND(OutData%M,1) - OutData%M(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END SUBROUTINE MD_UnPackPoint - - SUBROUTINE MD_CopyRod( SrcRodData, DstRodData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MD_Rod), INTENT(IN) :: SrcRodData - TYPE(MD_Rod), INTENT(INOUT) :: DstRodData - 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 = 'MD_CopyRod' -! - ErrStat = ErrID_None - ErrMsg = "" - DstRodData%IdNum = SrcRodData%IdNum - DstRodData%type = SrcRodData%type - DstRodData%PropsIdNum = SrcRodData%PropsIdNum - DstRodData%typeNum = SrcRodData%typeNum - DstRodData%AttachedA = SrcRodData%AttachedA - DstRodData%AttachedB = SrcRodData%AttachedB - DstRodData%TopA = SrcRodData%TopA - DstRodData%TopB = SrcRodData%TopB - DstRodData%nAttachedA = SrcRodData%nAttachedA - DstRodData%nAttachedB = SrcRodData%nAttachedB - DstRodData%OutFlagList = SrcRodData%OutFlagList - DstRodData%N = SrcRodData%N - DstRodData%endTypeA = SrcRodData%endTypeA - DstRodData%endTypeB = SrcRodData%endTypeB - DstRodData%UnstrLen = SrcRodData%UnstrLen - DstRodData%mass = SrcRodData%mass - DstRodData%rho = SrcRodData%rho - DstRodData%d = SrcRodData%d - DstRodData%Can = SrcRodData%Can - DstRodData%Cat = SrcRodData%Cat - DstRodData%Cdn = SrcRodData%Cdn - DstRodData%Cdt = SrcRodData%Cdt - DstRodData%CdEnd = SrcRodData%CdEnd - DstRodData%CaEnd = SrcRodData%CaEnd - DstRodData%time = SrcRodData%time - DstRodData%roll = SrcRodData%roll - DstRodData%pitch = SrcRodData%pitch - DstRodData%h0 = SrcRodData%h0 -IF (ALLOCATED(SrcRodData%r)) THEN - i1_l = LBOUND(SrcRodData%r,1) - i1_u = UBOUND(SrcRodData%r,1) - i2_l = LBOUND(SrcRodData%r,2) - i2_u = UBOUND(SrcRodData%r,2) - IF (.NOT. ALLOCATED(DstRodData%r)) THEN - ALLOCATE(DstRodData%r(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%r.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRodData%r = SrcRodData%r -ENDIF -IF (ALLOCATED(SrcRodData%rd)) THEN - i1_l = LBOUND(SrcRodData%rd,1) - i1_u = UBOUND(SrcRodData%rd,1) - i2_l = LBOUND(SrcRodData%rd,2) - i2_u = UBOUND(SrcRodData%rd,2) - IF (.NOT. ALLOCATED(DstRodData%rd)) THEN - ALLOCATE(DstRodData%rd(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%rd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRodData%rd = SrcRodData%rd -ENDIF - DstRodData%q = SrcRodData%q -IF (ALLOCATED(SrcRodData%l)) THEN - i1_l = LBOUND(SrcRodData%l,1) - i1_u = UBOUND(SrcRodData%l,1) - IF (.NOT. ALLOCATED(DstRodData%l)) THEN - ALLOCATE(DstRodData%l(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%l.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRodData%l = SrcRodData%l -ENDIF -IF (ALLOCATED(SrcRodData%V)) THEN - i1_l = LBOUND(SrcRodData%V,1) - i1_u = UBOUND(SrcRodData%V,1) - IF (.NOT. ALLOCATED(DstRodData%V)) THEN - ALLOCATE(DstRodData%V(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%V.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRodData%V = SrcRodData%V -ENDIF -IF (ALLOCATED(SrcRodData%U)) THEN - i1_l = LBOUND(SrcRodData%U,1) - i1_u = UBOUND(SrcRodData%U,1) - i2_l = LBOUND(SrcRodData%U,2) - i2_u = UBOUND(SrcRodData%U,2) - IF (.NOT. ALLOCATED(DstRodData%U)) THEN - ALLOCATE(DstRodData%U(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%U.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRodData%U = SrcRodData%U -ENDIF -IF (ALLOCATED(SrcRodData%Ud)) THEN - i1_l = LBOUND(SrcRodData%Ud,1) - i1_u = UBOUND(SrcRodData%Ud,1) - i2_l = LBOUND(SrcRodData%Ud,2) - i2_u = UBOUND(SrcRodData%Ud,2) - IF (.NOT. ALLOCATED(DstRodData%Ud)) THEN - ALLOCATE(DstRodData%Ud(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%Ud.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRodData%Ud = SrcRodData%Ud -ENDIF -IF (ALLOCATED(SrcRodData%zeta)) THEN - i1_l = LBOUND(SrcRodData%zeta,1) - i1_u = UBOUND(SrcRodData%zeta,1) - IF (.NOT. ALLOCATED(DstRodData%zeta)) THEN - ALLOCATE(DstRodData%zeta(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%zeta.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRodData%zeta = SrcRodData%zeta -ENDIF -IF (ALLOCATED(SrcRodData%PDyn)) THEN - i1_l = LBOUND(SrcRodData%PDyn,1) - i1_u = UBOUND(SrcRodData%PDyn,1) - IF (.NOT. ALLOCATED(DstRodData%PDyn)) THEN - ALLOCATE(DstRodData%PDyn(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%PDyn.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRodData%PDyn = SrcRodData%PDyn -ENDIF -IF (ALLOCATED(SrcRodData%W)) THEN - i1_l = LBOUND(SrcRodData%W,1) - i1_u = UBOUND(SrcRodData%W,1) - i2_l = LBOUND(SrcRodData%W,2) - i2_u = UBOUND(SrcRodData%W,2) - IF (.NOT. ALLOCATED(DstRodData%W)) THEN - ALLOCATE(DstRodData%W(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%W.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRodData%W = SrcRodData%W -ENDIF -IF (ALLOCATED(SrcRodData%Bo)) THEN - i1_l = LBOUND(SrcRodData%Bo,1) - i1_u = UBOUND(SrcRodData%Bo,1) - i2_l = LBOUND(SrcRodData%Bo,2) - i2_u = UBOUND(SrcRodData%Bo,2) - IF (.NOT. ALLOCATED(DstRodData%Bo)) THEN - ALLOCATE(DstRodData%Bo(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%Bo.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRodData%Bo = SrcRodData%Bo -ENDIF -IF (ALLOCATED(SrcRodData%Pd)) THEN - i1_l = LBOUND(SrcRodData%Pd,1) - i1_u = UBOUND(SrcRodData%Pd,1) - i2_l = LBOUND(SrcRodData%Pd,2) - i2_u = UBOUND(SrcRodData%Pd,2) - IF (.NOT. ALLOCATED(DstRodData%Pd)) THEN - ALLOCATE(DstRodData%Pd(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%Pd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRodData%Pd = SrcRodData%Pd -ENDIF -IF (ALLOCATED(SrcRodData%Dp)) THEN - i1_l = LBOUND(SrcRodData%Dp,1) - i1_u = UBOUND(SrcRodData%Dp,1) - i2_l = LBOUND(SrcRodData%Dp,2) - i2_u = UBOUND(SrcRodData%Dp,2) - IF (.NOT. ALLOCATED(DstRodData%Dp)) THEN - ALLOCATE(DstRodData%Dp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%Dp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRodData%Dp = SrcRodData%Dp -ENDIF -IF (ALLOCATED(SrcRodData%Dq)) THEN - i1_l = LBOUND(SrcRodData%Dq,1) - i1_u = UBOUND(SrcRodData%Dq,1) - i2_l = LBOUND(SrcRodData%Dq,2) - i2_u = UBOUND(SrcRodData%Dq,2) - IF (.NOT. ALLOCATED(DstRodData%Dq)) THEN - ALLOCATE(DstRodData%Dq(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%Dq.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRodData%Dq = SrcRodData%Dq -ENDIF -IF (ALLOCATED(SrcRodData%Ap)) THEN - i1_l = LBOUND(SrcRodData%Ap,1) - i1_u = UBOUND(SrcRodData%Ap,1) - i2_l = LBOUND(SrcRodData%Ap,2) - i2_u = UBOUND(SrcRodData%Ap,2) - IF (.NOT. ALLOCATED(DstRodData%Ap)) THEN - ALLOCATE(DstRodData%Ap(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%Ap.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRodData%Ap = SrcRodData%Ap -ENDIF -IF (ALLOCATED(SrcRodData%Aq)) THEN - i1_l = LBOUND(SrcRodData%Aq,1) - i1_u = UBOUND(SrcRodData%Aq,1) - i2_l = LBOUND(SrcRodData%Aq,2) - i2_u = UBOUND(SrcRodData%Aq,2) - IF (.NOT. ALLOCATED(DstRodData%Aq)) THEN - ALLOCATE(DstRodData%Aq(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%Aq.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRodData%Aq = SrcRodData%Aq -ENDIF -IF (ALLOCATED(SrcRodData%B)) THEN - i1_l = LBOUND(SrcRodData%B,1) - i1_u = UBOUND(SrcRodData%B,1) - i2_l = LBOUND(SrcRodData%B,2) - i2_u = UBOUND(SrcRodData%B,2) - IF (.NOT. ALLOCATED(DstRodData%B)) THEN - ALLOCATE(DstRodData%B(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%B.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRodData%B = SrcRodData%B -ENDIF -IF (ALLOCATED(SrcRodData%Fnet)) THEN - i1_l = LBOUND(SrcRodData%Fnet,1) - i1_u = UBOUND(SrcRodData%Fnet,1) - i2_l = LBOUND(SrcRodData%Fnet,2) - i2_u = UBOUND(SrcRodData%Fnet,2) - IF (.NOT. ALLOCATED(DstRodData%Fnet)) THEN - ALLOCATE(DstRodData%Fnet(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%Fnet.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRodData%Fnet = SrcRodData%Fnet -ENDIF -IF (ALLOCATED(SrcRodData%M)) THEN - i1_l = LBOUND(SrcRodData%M,1) - i1_u = UBOUND(SrcRodData%M,1) - i2_l = LBOUND(SrcRodData%M,2) - i2_u = UBOUND(SrcRodData%M,2) - i3_l = LBOUND(SrcRodData%M,3) - i3_u = UBOUND(SrcRodData%M,3) - IF (.NOT. ALLOCATED(DstRodData%M)) THEN - ALLOCATE(DstRodData%M(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%M.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRodData%M = SrcRodData%M -ENDIF - DstRodData%FextA = SrcRodData%FextA - DstRodData%FextB = SrcRodData%FextB - DstRodData%Mext = SrcRodData%Mext - DstRodData%r6 = SrcRodData%r6 - DstRodData%v6 = SrcRodData%v6 - DstRodData%a6 = SrcRodData%a6 - DstRodData%F6net = SrcRodData%F6net - DstRodData%M6net = SrcRodData%M6net - DstRodData%OrMat = SrcRodData%OrMat - DstRodData%RodUnOut = SrcRodData%RodUnOut -IF (ALLOCATED(SrcRodData%RodWrOutput)) THEN - i1_l = LBOUND(SrcRodData%RodWrOutput,1) - i1_u = UBOUND(SrcRodData%RodWrOutput,1) - IF (.NOT. ALLOCATED(DstRodData%RodWrOutput)) THEN - ALLOCATE(DstRodData%RodWrOutput(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%RodWrOutput.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRodData%RodWrOutput = SrcRodData%RodWrOutput -ENDIF - END SUBROUTINE MD_CopyRod - - SUBROUTINE MD_DestroyRod( RodData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(MD_Rod), INTENT(INOUT) :: RodData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_DestroyRod' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(RodData%r)) THEN - DEALLOCATE(RodData%r) -ENDIF -IF (ALLOCATED(RodData%rd)) THEN - DEALLOCATE(RodData%rd) -ENDIF -IF (ALLOCATED(RodData%l)) THEN - DEALLOCATE(RodData%l) -ENDIF -IF (ALLOCATED(RodData%V)) THEN - DEALLOCATE(RodData%V) -ENDIF -IF (ALLOCATED(RodData%U)) THEN - DEALLOCATE(RodData%U) -ENDIF -IF (ALLOCATED(RodData%Ud)) THEN - DEALLOCATE(RodData%Ud) -ENDIF -IF (ALLOCATED(RodData%zeta)) THEN - DEALLOCATE(RodData%zeta) -ENDIF -IF (ALLOCATED(RodData%PDyn)) THEN - DEALLOCATE(RodData%PDyn) -ENDIF -IF (ALLOCATED(RodData%W)) THEN - DEALLOCATE(RodData%W) -ENDIF -IF (ALLOCATED(RodData%Bo)) THEN - DEALLOCATE(RodData%Bo) -ENDIF -IF (ALLOCATED(RodData%Pd)) THEN - DEALLOCATE(RodData%Pd) -ENDIF -IF (ALLOCATED(RodData%Dp)) THEN - DEALLOCATE(RodData%Dp) -ENDIF -IF (ALLOCATED(RodData%Dq)) THEN - DEALLOCATE(RodData%Dq) -ENDIF -IF (ALLOCATED(RodData%Ap)) THEN - DEALLOCATE(RodData%Ap) -ENDIF -IF (ALLOCATED(RodData%Aq)) THEN - DEALLOCATE(RodData%Aq) -ENDIF -IF (ALLOCATED(RodData%B)) THEN - DEALLOCATE(RodData%B) -ENDIF -IF (ALLOCATED(RodData%Fnet)) THEN - DEALLOCATE(RodData%Fnet) -ENDIF -IF (ALLOCATED(RodData%M)) THEN - DEALLOCATE(RodData%M) -ENDIF -IF (ALLOCATED(RodData%RodWrOutput)) THEN - DEALLOCATE(RodData%RodWrOutput) -ENDIF - END SUBROUTINE MD_DestroyRod - - SUBROUTINE MD_PackRod( 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(MD_Rod), 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 = 'MD_PackRod' - ! 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 ! IdNum - Int_BufSz = Int_BufSz + 1*LEN(InData%type) ! type - Int_BufSz = Int_BufSz + 1 ! PropsIdNum - Int_BufSz = Int_BufSz + 1 ! typeNum - Int_BufSz = Int_BufSz + SIZE(InData%AttachedA) ! AttachedA - Int_BufSz = Int_BufSz + SIZE(InData%AttachedB) ! AttachedB - Int_BufSz = Int_BufSz + SIZE(InData%TopA) ! TopA - Int_BufSz = Int_BufSz + SIZE(InData%TopB) ! TopB - Int_BufSz = Int_BufSz + 1 ! nAttachedA - Int_BufSz = Int_BufSz + 1 ! nAttachedB - Int_BufSz = Int_BufSz + SIZE(InData%OutFlagList) ! OutFlagList - Int_BufSz = Int_BufSz + 1 ! N - Int_BufSz = Int_BufSz + 1 ! endTypeA - Int_BufSz = Int_BufSz + 1 ! endTypeB - Db_BufSz = Db_BufSz + 1 ! UnstrLen - Db_BufSz = Db_BufSz + 1 ! mass - Db_BufSz = Db_BufSz + 1 ! rho - Db_BufSz = Db_BufSz + 1 ! d - Db_BufSz = Db_BufSz + 1 ! Can - Db_BufSz = Db_BufSz + 1 ! Cat - Db_BufSz = Db_BufSz + 1 ! Cdn - Db_BufSz = Db_BufSz + 1 ! Cdt - Db_BufSz = Db_BufSz + 1 ! CdEnd - Db_BufSz = Db_BufSz + 1 ! CaEnd - Db_BufSz = Db_BufSz + 1 ! time - Db_BufSz = Db_BufSz + 1 ! roll - Db_BufSz = Db_BufSz + 1 ! pitch - Db_BufSz = Db_BufSz + 1 ! h0 - Int_BufSz = Int_BufSz + 1 ! r allocated yes/no - IF ( ALLOCATED(InData%r) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! r upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%r) ! r - END IF - Int_BufSz = Int_BufSz + 1 ! rd allocated yes/no - IF ( ALLOCATED(InData%rd) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! rd upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%rd) ! rd - END IF - Db_BufSz = Db_BufSz + SIZE(InData%q) ! q - Int_BufSz = Int_BufSz + 1 ! l allocated yes/no - IF ( ALLOCATED(InData%l) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! l upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%l) ! l - END IF - Int_BufSz = Int_BufSz + 1 ! V allocated yes/no - IF ( ALLOCATED(InData%V) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! V upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%V) ! V - END IF - Int_BufSz = Int_BufSz + 1 ! U allocated yes/no - IF ( ALLOCATED(InData%U) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! U upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%U) ! U - END IF - Int_BufSz = Int_BufSz + 1 ! Ud allocated yes/no - IF ( ALLOCATED(InData%Ud) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Ud upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Ud) ! Ud - END IF - Int_BufSz = Int_BufSz + 1 ! zeta allocated yes/no - IF ( ALLOCATED(InData%zeta) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! zeta upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%zeta) ! zeta - END IF - Int_BufSz = Int_BufSz + 1 ! PDyn allocated yes/no - IF ( ALLOCATED(InData%PDyn) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PDyn upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%PDyn) ! PDyn - END IF - Int_BufSz = Int_BufSz + 1 ! W allocated yes/no - IF ( ALLOCATED(InData%W) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! W upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%W) ! W - END IF - Int_BufSz = Int_BufSz + 1 ! Bo allocated yes/no - IF ( ALLOCATED(InData%Bo) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Bo upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Bo) ! Bo - END IF - Int_BufSz = Int_BufSz + 1 ! Pd allocated yes/no - IF ( ALLOCATED(InData%Pd) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Pd upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Pd) ! Pd - END IF - Int_BufSz = Int_BufSz + 1 ! Dp allocated yes/no - IF ( ALLOCATED(InData%Dp) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Dp upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Dp) ! Dp - END IF - Int_BufSz = Int_BufSz + 1 ! Dq allocated yes/no - IF ( ALLOCATED(InData%Dq) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Dq upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Dq) ! Dq - END IF - Int_BufSz = Int_BufSz + 1 ! Ap allocated yes/no - IF ( ALLOCATED(InData%Ap) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Ap upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Ap) ! Ap - END IF - Int_BufSz = Int_BufSz + 1 ! Aq allocated yes/no - IF ( ALLOCATED(InData%Aq) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Aq upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Aq) ! Aq - END IF - Int_BufSz = Int_BufSz + 1 ! B allocated yes/no - IF ( ALLOCATED(InData%B) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! B upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%B) ! B - END IF - Int_BufSz = Int_BufSz + 1 ! Fnet allocated yes/no - IF ( ALLOCATED(InData%Fnet) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Fnet upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Fnet) ! Fnet - END IF - Int_BufSz = Int_BufSz + 1 ! M allocated yes/no - IF ( ALLOCATED(InData%M) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! M upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%M) ! M - END IF - Db_BufSz = Db_BufSz + SIZE(InData%FextA) ! FextA - Db_BufSz = Db_BufSz + SIZE(InData%FextB) ! FextB - Db_BufSz = Db_BufSz + SIZE(InData%Mext) ! Mext - Db_BufSz = Db_BufSz + SIZE(InData%r6) ! r6 - Db_BufSz = Db_BufSz + SIZE(InData%v6) ! v6 - Db_BufSz = Db_BufSz + SIZE(InData%a6) ! a6 - Db_BufSz = Db_BufSz + SIZE(InData%F6net) ! F6net - Db_BufSz = Db_BufSz + SIZE(InData%M6net) ! M6net - Db_BufSz = Db_BufSz + SIZE(InData%OrMat) ! OrMat - Int_BufSz = Int_BufSz + 1 ! RodUnOut - Int_BufSz = Int_BufSz + 1 ! RodWrOutput allocated yes/no - IF ( ALLOCATED(InData%RodWrOutput) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! RodWrOutput upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%RodWrOutput) ! RodWrOutput - 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%IdNum - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%type) - IntKiBuf(Int_Xferred) = ICHAR(InData%type(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = InData%PropsIdNum - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%typeNum - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%AttachedA,1), UBOUND(InData%AttachedA,1) - IntKiBuf(Int_Xferred) = InData%AttachedA(i1) - Int_Xferred = Int_Xferred + 1 - END DO - DO i1 = LBOUND(InData%AttachedB,1), UBOUND(InData%AttachedB,1) - IntKiBuf(Int_Xferred) = InData%AttachedB(i1) - Int_Xferred = Int_Xferred + 1 - END DO - DO i1 = LBOUND(InData%TopA,1), UBOUND(InData%TopA,1) - IntKiBuf(Int_Xferred) = InData%TopA(i1) - Int_Xferred = Int_Xferred + 1 - END DO - DO i1 = LBOUND(InData%TopB,1), UBOUND(InData%TopB,1) - IntKiBuf(Int_Xferred) = InData%TopB(i1) - Int_Xferred = Int_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%nAttachedA - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nAttachedB - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%OutFlagList,1), UBOUND(InData%OutFlagList,1) - IntKiBuf(Int_Xferred) = InData%OutFlagList(i1) - Int_Xferred = Int_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%N - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%endTypeA - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%endTypeB - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%UnstrLen - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%mass - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%rho - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%d - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%Can - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%Cat - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%Cdn - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%Cdt - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%CdEnd - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%CaEnd - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%time - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%roll - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%pitch - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%h0 - Db_Xferred = Db_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 - IntKiBuf( Int_Xferred ) = LBOUND(InData%r,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%r,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%r,2), UBOUND(InData%r,2) - DO i1 = LBOUND(InData%r,1), UBOUND(InData%r,1) - DbKiBuf(Db_Xferred) = InData%r(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%rd) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rd,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rd,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rd,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rd,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%rd,2), UBOUND(InData%rd,2) - DO i1 = LBOUND(InData%rd,1), UBOUND(InData%rd,1) - DbKiBuf(Db_Xferred) = InData%rd(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - DO i1 = LBOUND(InData%q,1), UBOUND(InData%q,1) - DbKiBuf(Db_Xferred) = InData%q(i1) - Db_Xferred = Db_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%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%l,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%l,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%l,1), UBOUND(InData%l,1) - DbKiBuf(Db_Xferred) = InData%l(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(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) - DbKiBuf(Db_Xferred) = InData%V(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(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 - IntKiBuf( Int_Xferred ) = LBOUND(InData%U,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%U,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%U,2), UBOUND(InData%U,2) - DO i1 = LBOUND(InData%U,1), UBOUND(InData%U,1) - DbKiBuf(Db_Xferred) = InData%U(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Ud) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Ud,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Ud,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Ud,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Ud,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Ud,2), UBOUND(InData%Ud,2) - DO i1 = LBOUND(InData%Ud,1), UBOUND(InData%Ud,1) - DbKiBuf(Db_Xferred) = InData%Ud(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%zeta) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%zeta,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%zeta,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%zeta,1), UBOUND(InData%zeta,1) - DbKiBuf(Db_Xferred) = InData%zeta(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PDyn) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PDyn,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PDyn,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PDyn,1), UBOUND(InData%PDyn,1) - DbKiBuf(Db_Xferred) = InData%PDyn(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(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 - IntKiBuf( Int_Xferred ) = LBOUND(InData%W,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%W,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%W,2), UBOUND(InData%W,2) - DO i1 = LBOUND(InData%W,1), UBOUND(InData%W,1) - DbKiBuf(Db_Xferred) = InData%W(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Bo) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Bo,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Bo,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Bo,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Bo,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Bo,2), UBOUND(InData%Bo,2) - DO i1 = LBOUND(InData%Bo,1), UBOUND(InData%Bo,1) - DbKiBuf(Db_Xferred) = InData%Bo(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Pd) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Pd,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Pd,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Pd,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Pd,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Pd,2), UBOUND(InData%Pd,2) - DO i1 = LBOUND(InData%Pd,1), UBOUND(InData%Pd,1) - DbKiBuf(Db_Xferred) = InData%Pd(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Dp) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Dp,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Dp,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Dp,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Dp,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Dp,2), UBOUND(InData%Dp,2) - DO i1 = LBOUND(InData%Dp,1), UBOUND(InData%Dp,1) - DbKiBuf(Db_Xferred) = InData%Dp(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Dq) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Dq,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Dq,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Dq,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Dq,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Dq,2), UBOUND(InData%Dq,2) - DO i1 = LBOUND(InData%Dq,1), UBOUND(InData%Dq,1) - DbKiBuf(Db_Xferred) = InData%Dq(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Ap) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Ap,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Ap,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Ap,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Ap,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Ap,2), UBOUND(InData%Ap,2) - DO i1 = LBOUND(InData%Ap,1), UBOUND(InData%Ap,1) - DbKiBuf(Db_Xferred) = InData%Ap(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Aq) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Aq,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Aq,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Aq,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Aq,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Aq,2), UBOUND(InData%Aq,2) - DO i1 = LBOUND(InData%Aq,1), UBOUND(InData%Aq,1) - DbKiBuf(Db_Xferred) = InData%Aq(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - 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 - IntKiBuf( Int_Xferred ) = LBOUND(InData%B,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%B,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%B,2), UBOUND(InData%B,2) - DO i1 = LBOUND(InData%B,1), UBOUND(InData%B,1) - DbKiBuf(Db_Xferred) = InData%B(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Fnet) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Fnet,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fnet,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Fnet,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fnet,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Fnet,2), UBOUND(InData%Fnet,2) - DO i1 = LBOUND(InData%Fnet,1), UBOUND(InData%Fnet,1) - DbKiBuf(Db_Xferred) = InData%Fnet(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 - IntKiBuf( Int_Xferred ) = LBOUND(InData%M,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%M,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%M,3), UBOUND(InData%M,3) - 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,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - DO i1 = LBOUND(InData%FextA,1), UBOUND(InData%FextA,1) - DbKiBuf(Db_Xferred) = InData%FextA(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%FextB,1), UBOUND(InData%FextB,1) - DbKiBuf(Db_Xferred) = InData%FextB(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%Mext,1), UBOUND(InData%Mext,1) - DbKiBuf(Db_Xferred) = InData%Mext(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%r6,1), UBOUND(InData%r6,1) - DbKiBuf(Db_Xferred) = InData%r6(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%v6,1), UBOUND(InData%v6,1) - DbKiBuf(Db_Xferred) = InData%v6(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%a6,1), UBOUND(InData%a6,1) - DbKiBuf(Db_Xferred) = InData%a6(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%F6net,1), UBOUND(InData%F6net,1) - DbKiBuf(Db_Xferred) = InData%F6net(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i2 = LBOUND(InData%M6net,2), UBOUND(InData%M6net,2) - DO i1 = LBOUND(InData%M6net,1), UBOUND(InData%M6net,1) - DbKiBuf(Db_Xferred) = InData%M6net(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - DO i2 = LBOUND(InData%OrMat,2), UBOUND(InData%OrMat,2) - DO i1 = LBOUND(InData%OrMat,1), UBOUND(InData%OrMat,1) - DbKiBuf(Db_Xferred) = InData%OrMat(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - IntKiBuf(Int_Xferred) = InData%RodUnOut - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%RodWrOutput) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RodWrOutput,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RodWrOutput,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%RodWrOutput,1), UBOUND(InData%RodWrOutput,1) - DbKiBuf(Db_Xferred) = InData%RodWrOutput(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE MD_PackRod - - SUBROUTINE MD_UnPackRod( 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(MD_Rod), 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 = 'MD_UnPackRod' - ! 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%IdNum = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%type) - OutData%type(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%PropsIdNum = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%typeNum = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%AttachedA,1) - i1_u = UBOUND(OutData%AttachedA,1) - DO i1 = LBOUND(OutData%AttachedA,1), UBOUND(OutData%AttachedA,1) - OutData%AttachedA(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - i1_l = LBOUND(OutData%AttachedB,1) - i1_u = UBOUND(OutData%AttachedB,1) - DO i1 = LBOUND(OutData%AttachedB,1), UBOUND(OutData%AttachedB,1) - OutData%AttachedB(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - i1_l = LBOUND(OutData%TopA,1) - i1_u = UBOUND(OutData%TopA,1) - DO i1 = LBOUND(OutData%TopA,1), UBOUND(OutData%TopA,1) - OutData%TopA(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - i1_l = LBOUND(OutData%TopB,1) - i1_u = UBOUND(OutData%TopB,1) - DO i1 = LBOUND(OutData%TopB,1), UBOUND(OutData%TopB,1) - OutData%TopB(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - OutData%nAttachedA = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nAttachedB = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%OutFlagList,1) - i1_u = UBOUND(OutData%OutFlagList,1) - DO i1 = LBOUND(OutData%OutFlagList,1), UBOUND(OutData%OutFlagList,1) - OutData%OutFlagList(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - OutData%N = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%endTypeA = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%endTypeB = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%UnstrLen = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%mass = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%rho = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%d = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%Can = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%Cat = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%Cdn = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%Cdt = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%CdEnd = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%CaEnd = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%time = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%roll = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%pitch = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%h0 = DbKiBuf(Db_Xferred) - Db_Xferred = Db_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 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%r)) DEALLOCATE(OutData%r) - ALLOCATE(OutData%r(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%r.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%r,2), UBOUND(OutData%r,2) - DO i1 = LBOUND(OutData%r,1), UBOUND(OutData%r,1) - OutData%r(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rd not allocated - Int_Xferred = Int_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%rd)) DEALLOCATE(OutData%rd) - ALLOCATE(OutData%rd(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%rd,2), UBOUND(OutData%rd,2) - DO i1 = LBOUND(OutData%rd,1), UBOUND(OutData%rd,1) - OutData%rd(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - i1_l = LBOUND(OutData%q,1) - i1_u = UBOUND(OutData%q,1) - DO i1 = LBOUND(OutData%q,1), UBOUND(OutData%q,1) - OutData%q(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! 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%l)) DEALLOCATE(OutData%l) - ALLOCATE(OutData%l(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%l.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%l,1), UBOUND(OutData%l,1) - OutData%l(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_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 (ALLOCATED(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 - DO i1 = LBOUND(OutData%V,1), UBOUND(OutData%V,1) - OutData%V(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - 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 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%U)) DEALLOCATE(OutData%U) - ALLOCATE(OutData%U(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%U.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%U,2), UBOUND(OutData%U,2) - DO i1 = LBOUND(OutData%U,1), UBOUND(OutData%U,1) - OutData%U(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Ud not allocated - Int_Xferred = Int_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%Ud)) DEALLOCATE(OutData%Ud) - ALLOCATE(OutData%Ud(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Ud.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Ud,2), UBOUND(OutData%Ud,2) - DO i1 = LBOUND(OutData%Ud,1), UBOUND(OutData%Ud,1) - OutData%Ud(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! zeta not allocated - Int_Xferred = Int_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%zeta)) DEALLOCATE(OutData%zeta) - ALLOCATE(OutData%zeta(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%zeta.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%zeta,1), UBOUND(OutData%zeta,1) - OutData%zeta(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PDyn not allocated - Int_Xferred = Int_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%PDyn)) DEALLOCATE(OutData%PDyn) - ALLOCATE(OutData%PDyn(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PDyn.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PDyn,1), UBOUND(OutData%PDyn,1) - OutData%PDyn(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_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 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%W)) DEALLOCATE(OutData%W) - ALLOCATE(OutData%W(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%W.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%W,2), UBOUND(OutData%W,2) - DO i1 = LBOUND(OutData%W,1), UBOUND(OutData%W,1) - OutData%W(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Bo not allocated - Int_Xferred = Int_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%Bo)) DEALLOCATE(OutData%Bo) - ALLOCATE(OutData%Bo(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Bo.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Bo,2), UBOUND(OutData%Bo,2) - DO i1 = LBOUND(OutData%Bo,1), UBOUND(OutData%Bo,1) - OutData%Bo(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Pd not allocated - Int_Xferred = Int_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%Pd)) DEALLOCATE(OutData%Pd) - ALLOCATE(OutData%Pd(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Pd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Pd,2), UBOUND(OutData%Pd,2) - DO i1 = LBOUND(OutData%Pd,1), UBOUND(OutData%Pd,1) - OutData%Pd(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Dp not allocated - Int_Xferred = Int_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%Dp)) DEALLOCATE(OutData%Dp) - ALLOCATE(OutData%Dp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Dp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Dp,2), UBOUND(OutData%Dp,2) - DO i1 = LBOUND(OutData%Dp,1), UBOUND(OutData%Dp,1) - OutData%Dp(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Dq not allocated - Int_Xferred = Int_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%Dq)) DEALLOCATE(OutData%Dq) - ALLOCATE(OutData%Dq(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Dq.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Dq,2), UBOUND(OutData%Dq,2) - DO i1 = LBOUND(OutData%Dq,1), UBOUND(OutData%Dq,1) - OutData%Dq(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Ap not allocated - Int_Xferred = Int_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%Ap)) DEALLOCATE(OutData%Ap) - ALLOCATE(OutData%Ap(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Ap.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Ap,2), UBOUND(OutData%Ap,2) - DO i1 = LBOUND(OutData%Ap,1), UBOUND(OutData%Ap,1) - OutData%Ap(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Aq not allocated - Int_Xferred = Int_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%Aq)) DEALLOCATE(OutData%Aq) - ALLOCATE(OutData%Aq(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Aq.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Aq,2), UBOUND(OutData%Aq,2) - DO i1 = LBOUND(OutData%Aq,1), UBOUND(OutData%Aq,1) - OutData%Aq(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - 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 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%B)) DEALLOCATE(OutData%B) - ALLOCATE(OutData%B(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%B.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%B,2), UBOUND(OutData%B,2) - DO i1 = LBOUND(OutData%B,1), UBOUND(OutData%B,1) - OutData%B(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Fnet not allocated - Int_Xferred = Int_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%Fnet)) DEALLOCATE(OutData%Fnet) - ALLOCATE(OutData%Fnet(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fnet.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Fnet,2), UBOUND(OutData%Fnet,2) - DO i1 = LBOUND(OutData%Fnet,1), UBOUND(OutData%Fnet,1) - OutData%Fnet(i1,i2) = DbKiBuf(Db_Xferred) - 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 - i3_l = IntKiBuf( Int_Xferred ) - i3_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,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%M.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%M,3), UBOUND(OutData%M,3) - DO i2 = LBOUND(OutData%M,2), UBOUND(OutData%M,2) - DO i1 = LBOUND(OutData%M,1), UBOUND(OutData%M,1) - OutData%M(i1,i2,i3) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - i1_l = LBOUND(OutData%FextA,1) - i1_u = UBOUND(OutData%FextA,1) - DO i1 = LBOUND(OutData%FextA,1), UBOUND(OutData%FextA,1) - OutData%FextA(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%FextB,1) - i1_u = UBOUND(OutData%FextB,1) - DO i1 = LBOUND(OutData%FextB,1), UBOUND(OutData%FextB,1) - OutData%FextB(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%Mext,1) - i1_u = UBOUND(OutData%Mext,1) - DO i1 = LBOUND(OutData%Mext,1), UBOUND(OutData%Mext,1) - OutData%Mext(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%r6,1) - i1_u = UBOUND(OutData%r6,1) - DO i1 = LBOUND(OutData%r6,1), UBOUND(OutData%r6,1) - OutData%r6(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%v6,1) - i1_u = UBOUND(OutData%v6,1) - DO i1 = LBOUND(OutData%v6,1), UBOUND(OutData%v6,1) - OutData%v6(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%a6,1) - i1_u = UBOUND(OutData%a6,1) - DO i1 = LBOUND(OutData%a6,1), UBOUND(OutData%a6,1) - OutData%a6(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%F6net,1) - i1_u = UBOUND(OutData%F6net,1) - DO i1 = LBOUND(OutData%F6net,1), UBOUND(OutData%F6net,1) - OutData%F6net(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%M6net,1) - i1_u = UBOUND(OutData%M6net,1) - i2_l = LBOUND(OutData%M6net,2) - i2_u = UBOUND(OutData%M6net,2) - DO i2 = LBOUND(OutData%M6net,2), UBOUND(OutData%M6net,2) - DO i1 = LBOUND(OutData%M6net,1), UBOUND(OutData%M6net,1) - OutData%M6net(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%OrMat,1) - i1_u = UBOUND(OutData%OrMat,1) - i2_l = LBOUND(OutData%OrMat,2) - i2_u = UBOUND(OutData%OrMat,2) - DO i2 = LBOUND(OutData%OrMat,2), UBOUND(OutData%OrMat,2) - DO i1 = LBOUND(OutData%OrMat,1), UBOUND(OutData%OrMat,1) - OutData%OrMat(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - OutData%RodUnOut = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RodWrOutput not allocated - Int_Xferred = Int_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%RodWrOutput)) DEALLOCATE(OutData%RodWrOutput) - ALLOCATE(OutData%RodWrOutput(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RodWrOutput.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%RodWrOutput,1), UBOUND(OutData%RodWrOutput,1) - OutData%RodWrOutput(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE MD_UnPackRod - - SUBROUTINE MD_CopyLine( SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MD_Line), INTENT(IN) :: SrcLineData - TYPE(MD_Line), INTENT(INOUT) :: DstLineData - 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 = 'MD_CopyLine' -! - ErrStat = ErrID_None - ErrMsg = "" - DstLineData%IdNum = SrcLineData%IdNum - DstLineData%PropsIdNum = SrcLineData%PropsIdNum - DstLineData%ElasticMod = SrcLineData%ElasticMod - DstLineData%OutFlagList = SrcLineData%OutFlagList - DstLineData%CtrlChan = SrcLineData%CtrlChan - DstLineData%FairPoint = SrcLineData%FairPoint - DstLineData%AnchPoint = SrcLineData%AnchPoint - DstLineData%N = SrcLineData%N - DstLineData%endTypeA = SrcLineData%endTypeA - DstLineData%endTypeB = SrcLineData%endTypeB - DstLineData%UnstrLen = SrcLineData%UnstrLen - DstLineData%rho = SrcLineData%rho - DstLineData%d = SrcLineData%d - DstLineData%EA = SrcLineData%EA - DstLineData%EA_D = SrcLineData%EA_D - DstLineData%BA = SrcLineData%BA - DstLineData%BA_D = SrcLineData%BA_D - DstLineData%EI = SrcLineData%EI - DstLineData%Can = SrcLineData%Can - DstLineData%Cat = SrcLineData%Cat - DstLineData%Cdn = SrcLineData%Cdn - DstLineData%Cdt = SrcLineData%Cdt - DstLineData%nEApoints = SrcLineData%nEApoints - DstLineData%stiffXs = SrcLineData%stiffXs - DstLineData%stiffYs = SrcLineData%stiffYs - DstLineData%nBApoints = SrcLineData%nBApoints - DstLineData%dampXs = SrcLineData%dampXs - DstLineData%dampYs = SrcLineData%dampYs - DstLineData%nEIpoints = SrcLineData%nEIpoints - DstLineData%bstiffXs = SrcLineData%bstiffXs - DstLineData%bstiffYs = SrcLineData%bstiffYs - DstLineData%time = SrcLineData%time -IF (ALLOCATED(SrcLineData%r)) THEN - i1_l = LBOUND(SrcLineData%r,1) - i1_u = UBOUND(SrcLineData%r,1) - i2_l = LBOUND(SrcLineData%r,2) - i2_u = UBOUND(SrcLineData%r,2) - IF (.NOT. ALLOCATED(DstLineData%r)) THEN - ALLOCATE(DstLineData%r(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%r.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLineData%r = SrcLineData%r -ENDIF -IF (ALLOCATED(SrcLineData%rd)) THEN - i1_l = LBOUND(SrcLineData%rd,1) - i1_u = UBOUND(SrcLineData%rd,1) - i2_l = LBOUND(SrcLineData%rd,2) - i2_u = UBOUND(SrcLineData%rd,2) - IF (.NOT. ALLOCATED(DstLineData%rd)) THEN - ALLOCATE(DstLineData%rd(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%rd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLineData%rd = SrcLineData%rd -ENDIF -IF (ALLOCATED(SrcLineData%q)) THEN - i1_l = LBOUND(SrcLineData%q,1) - i1_u = UBOUND(SrcLineData%q,1) - i2_l = LBOUND(SrcLineData%q,2) - i2_u = UBOUND(SrcLineData%q,2) - IF (.NOT. ALLOCATED(DstLineData%q)) THEN - ALLOCATE(DstLineData%q(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%q.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLineData%q = SrcLineData%q -ENDIF -IF (ALLOCATED(SrcLineData%qs)) THEN - i1_l = LBOUND(SrcLineData%qs,1) - i1_u = UBOUND(SrcLineData%qs,1) - i2_l = LBOUND(SrcLineData%qs,2) - i2_u = UBOUND(SrcLineData%qs,2) - IF (.NOT. ALLOCATED(DstLineData%qs)) THEN - ALLOCATE(DstLineData%qs(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%qs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLineData%qs = SrcLineData%qs -ENDIF -IF (ALLOCATED(SrcLineData%l)) THEN - i1_l = LBOUND(SrcLineData%l,1) - i1_u = UBOUND(SrcLineData%l,1) - IF (.NOT. ALLOCATED(DstLineData%l)) THEN - ALLOCATE(DstLineData%l(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%l.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLineData%l = SrcLineData%l -ENDIF -IF (ALLOCATED(SrcLineData%ld)) THEN - i1_l = LBOUND(SrcLineData%ld,1) - i1_u = UBOUND(SrcLineData%ld,1) - IF (.NOT. ALLOCATED(DstLineData%ld)) THEN - ALLOCATE(DstLineData%ld(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%ld.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLineData%ld = SrcLineData%ld -ENDIF -IF (ALLOCATED(SrcLineData%lstr)) THEN - i1_l = LBOUND(SrcLineData%lstr,1) - i1_u = UBOUND(SrcLineData%lstr,1) - IF (.NOT. ALLOCATED(DstLineData%lstr)) THEN - ALLOCATE(DstLineData%lstr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%lstr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLineData%lstr = SrcLineData%lstr -ENDIF -IF (ALLOCATED(SrcLineData%lstrd)) THEN - i1_l = LBOUND(SrcLineData%lstrd,1) - i1_u = UBOUND(SrcLineData%lstrd,1) - IF (.NOT. ALLOCATED(DstLineData%lstrd)) THEN - ALLOCATE(DstLineData%lstrd(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%lstrd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLineData%lstrd = SrcLineData%lstrd -ENDIF -IF (ALLOCATED(SrcLineData%Kurv)) THEN - i1_l = LBOUND(SrcLineData%Kurv,1) - i1_u = UBOUND(SrcLineData%Kurv,1) - IF (.NOT. ALLOCATED(DstLineData%Kurv)) THEN - ALLOCATE(DstLineData%Kurv(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%Kurv.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLineData%Kurv = SrcLineData%Kurv -ENDIF -IF (ALLOCATED(SrcLineData%dl_1)) THEN - i1_l = LBOUND(SrcLineData%dl_1,1) - i1_u = UBOUND(SrcLineData%dl_1,1) - IF (.NOT. ALLOCATED(DstLineData%dl_1)) THEN - ALLOCATE(DstLineData%dl_1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%dl_1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLineData%dl_1 = SrcLineData%dl_1 -ENDIF -IF (ALLOCATED(SrcLineData%V)) THEN - i1_l = LBOUND(SrcLineData%V,1) - i1_u = UBOUND(SrcLineData%V,1) - IF (.NOT. ALLOCATED(DstLineData%V)) THEN - ALLOCATE(DstLineData%V(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%V.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLineData%V = SrcLineData%V -ENDIF -IF (ALLOCATED(SrcLineData%U)) THEN - i1_l = LBOUND(SrcLineData%U,1) - i1_u = UBOUND(SrcLineData%U,1) - i2_l = LBOUND(SrcLineData%U,2) - i2_u = UBOUND(SrcLineData%U,2) - IF (.NOT. ALLOCATED(DstLineData%U)) THEN - ALLOCATE(DstLineData%U(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%U.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLineData%U = SrcLineData%U -ENDIF -IF (ALLOCATED(SrcLineData%Ud)) THEN - i1_l = LBOUND(SrcLineData%Ud,1) - i1_u = UBOUND(SrcLineData%Ud,1) - i2_l = LBOUND(SrcLineData%Ud,2) - i2_u = UBOUND(SrcLineData%Ud,2) - IF (.NOT. ALLOCATED(DstLineData%Ud)) THEN - ALLOCATE(DstLineData%Ud(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%Ud.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLineData%Ud = SrcLineData%Ud -ENDIF -IF (ALLOCATED(SrcLineData%zeta)) THEN - i1_l = LBOUND(SrcLineData%zeta,1) - i1_u = UBOUND(SrcLineData%zeta,1) - IF (.NOT. ALLOCATED(DstLineData%zeta)) THEN - ALLOCATE(DstLineData%zeta(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%zeta.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLineData%zeta = SrcLineData%zeta -ENDIF -IF (ALLOCATED(SrcLineData%PDyn)) THEN - i1_l = LBOUND(SrcLineData%PDyn,1) - i1_u = UBOUND(SrcLineData%PDyn,1) - IF (.NOT. ALLOCATED(DstLineData%PDyn)) THEN - ALLOCATE(DstLineData%PDyn(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%PDyn.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLineData%PDyn = SrcLineData%PDyn -ENDIF -IF (ALLOCATED(SrcLineData%T)) THEN - i1_l = LBOUND(SrcLineData%T,1) - i1_u = UBOUND(SrcLineData%T,1) - i2_l = LBOUND(SrcLineData%T,2) - i2_u = UBOUND(SrcLineData%T,2) - IF (.NOT. ALLOCATED(DstLineData%T)) THEN - ALLOCATE(DstLineData%T(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%T.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLineData%T = SrcLineData%T -ENDIF -IF (ALLOCATED(SrcLineData%Td)) THEN - i1_l = LBOUND(SrcLineData%Td,1) - i1_u = UBOUND(SrcLineData%Td,1) - i2_l = LBOUND(SrcLineData%Td,2) - i2_u = UBOUND(SrcLineData%Td,2) - IF (.NOT. ALLOCATED(DstLineData%Td)) THEN - ALLOCATE(DstLineData%Td(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%Td.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLineData%Td = SrcLineData%Td -ENDIF -IF (ALLOCATED(SrcLineData%W)) THEN - i1_l = LBOUND(SrcLineData%W,1) - i1_u = UBOUND(SrcLineData%W,1) - i2_l = LBOUND(SrcLineData%W,2) - i2_u = UBOUND(SrcLineData%W,2) - IF (.NOT. ALLOCATED(DstLineData%W)) THEN - ALLOCATE(DstLineData%W(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%W.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLineData%W = SrcLineData%W -ENDIF -IF (ALLOCATED(SrcLineData%Dp)) THEN - i1_l = LBOUND(SrcLineData%Dp,1) - i1_u = UBOUND(SrcLineData%Dp,1) - i2_l = LBOUND(SrcLineData%Dp,2) - i2_u = UBOUND(SrcLineData%Dp,2) - IF (.NOT. ALLOCATED(DstLineData%Dp)) THEN - ALLOCATE(DstLineData%Dp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%Dp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLineData%Dp = SrcLineData%Dp -ENDIF -IF (ALLOCATED(SrcLineData%Dq)) THEN - i1_l = LBOUND(SrcLineData%Dq,1) - i1_u = UBOUND(SrcLineData%Dq,1) - i2_l = LBOUND(SrcLineData%Dq,2) - i2_u = UBOUND(SrcLineData%Dq,2) - IF (.NOT. ALLOCATED(DstLineData%Dq)) THEN - ALLOCATE(DstLineData%Dq(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%Dq.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLineData%Dq = SrcLineData%Dq -ENDIF -IF (ALLOCATED(SrcLineData%Ap)) THEN - i1_l = LBOUND(SrcLineData%Ap,1) - i1_u = UBOUND(SrcLineData%Ap,1) - i2_l = LBOUND(SrcLineData%Ap,2) - i2_u = UBOUND(SrcLineData%Ap,2) - IF (.NOT. ALLOCATED(DstLineData%Ap)) THEN - ALLOCATE(DstLineData%Ap(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%Ap.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLineData%Ap = SrcLineData%Ap -ENDIF -IF (ALLOCATED(SrcLineData%Aq)) THEN - i1_l = LBOUND(SrcLineData%Aq,1) - i1_u = UBOUND(SrcLineData%Aq,1) - i2_l = LBOUND(SrcLineData%Aq,2) - i2_u = UBOUND(SrcLineData%Aq,2) - IF (.NOT. ALLOCATED(DstLineData%Aq)) THEN - ALLOCATE(DstLineData%Aq(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%Aq.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLineData%Aq = SrcLineData%Aq -ENDIF -IF (ALLOCATED(SrcLineData%B)) THEN - i1_l = LBOUND(SrcLineData%B,1) - i1_u = UBOUND(SrcLineData%B,1) - i2_l = LBOUND(SrcLineData%B,2) - i2_u = UBOUND(SrcLineData%B,2) - IF (.NOT. ALLOCATED(DstLineData%B)) THEN - ALLOCATE(DstLineData%B(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%B.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLineData%B = SrcLineData%B -ENDIF -IF (ALLOCATED(SrcLineData%Bs)) THEN - i1_l = LBOUND(SrcLineData%Bs,1) - i1_u = UBOUND(SrcLineData%Bs,1) - i2_l = LBOUND(SrcLineData%Bs,2) - i2_u = UBOUND(SrcLineData%Bs,2) - IF (.NOT. ALLOCATED(DstLineData%Bs)) THEN - ALLOCATE(DstLineData%Bs(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%Bs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLineData%Bs = SrcLineData%Bs -ENDIF -IF (ALLOCATED(SrcLineData%Fnet)) THEN - i1_l = LBOUND(SrcLineData%Fnet,1) - i1_u = UBOUND(SrcLineData%Fnet,1) - i2_l = LBOUND(SrcLineData%Fnet,2) - i2_u = UBOUND(SrcLineData%Fnet,2) - IF (.NOT. ALLOCATED(DstLineData%Fnet)) THEN - ALLOCATE(DstLineData%Fnet(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%Fnet.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLineData%Fnet = SrcLineData%Fnet -ENDIF -IF (ALLOCATED(SrcLineData%S)) THEN - i1_l = LBOUND(SrcLineData%S,1) - i1_u = UBOUND(SrcLineData%S,1) - i2_l = LBOUND(SrcLineData%S,2) - i2_u = UBOUND(SrcLineData%S,2) - i3_l = LBOUND(SrcLineData%S,3) - i3_u = UBOUND(SrcLineData%S,3) - IF (.NOT. ALLOCATED(DstLineData%S)) THEN - ALLOCATE(DstLineData%S(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%S.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLineData%S = SrcLineData%S -ENDIF -IF (ALLOCATED(SrcLineData%M)) THEN - i1_l = LBOUND(SrcLineData%M,1) - i1_u = UBOUND(SrcLineData%M,1) - i2_l = LBOUND(SrcLineData%M,2) - i2_u = UBOUND(SrcLineData%M,2) - i3_l = LBOUND(SrcLineData%M,3) - i3_u = UBOUND(SrcLineData%M,3) - IF (.NOT. ALLOCATED(DstLineData%M)) THEN - ALLOCATE(DstLineData%M(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%M.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLineData%M = SrcLineData%M -ENDIF - DstLineData%EndMomentA = SrcLineData%EndMomentA - DstLineData%EndMomentB = SrcLineData%EndMomentB - DstLineData%LineUnOut = SrcLineData%LineUnOut -IF (ALLOCATED(SrcLineData%LineWrOutput)) THEN - i1_l = LBOUND(SrcLineData%LineWrOutput,1) - i1_u = UBOUND(SrcLineData%LineWrOutput,1) - IF (.NOT. ALLOCATED(DstLineData%LineWrOutput)) THEN - ALLOCATE(DstLineData%LineWrOutput(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%LineWrOutput.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLineData%LineWrOutput = SrcLineData%LineWrOutput -ENDIF - END SUBROUTINE MD_CopyLine - - SUBROUTINE MD_DestroyLine( LineData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(MD_Line), INTENT(INOUT) :: LineData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_DestroyLine' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(LineData%r)) THEN - DEALLOCATE(LineData%r) -ENDIF -IF (ALLOCATED(LineData%rd)) THEN - DEALLOCATE(LineData%rd) -ENDIF -IF (ALLOCATED(LineData%q)) THEN - DEALLOCATE(LineData%q) -ENDIF -IF (ALLOCATED(LineData%qs)) THEN - DEALLOCATE(LineData%qs) -ENDIF -IF (ALLOCATED(LineData%l)) THEN - DEALLOCATE(LineData%l) -ENDIF -IF (ALLOCATED(LineData%ld)) THEN - DEALLOCATE(LineData%ld) -ENDIF -IF (ALLOCATED(LineData%lstr)) THEN - DEALLOCATE(LineData%lstr) -ENDIF -IF (ALLOCATED(LineData%lstrd)) THEN - DEALLOCATE(LineData%lstrd) -ENDIF -IF (ALLOCATED(LineData%Kurv)) THEN - DEALLOCATE(LineData%Kurv) -ENDIF -IF (ALLOCATED(LineData%dl_1)) THEN - DEALLOCATE(LineData%dl_1) -ENDIF -IF (ALLOCATED(LineData%V)) THEN - DEALLOCATE(LineData%V) -ENDIF -IF (ALLOCATED(LineData%U)) THEN - DEALLOCATE(LineData%U) -ENDIF -IF (ALLOCATED(LineData%Ud)) THEN - DEALLOCATE(LineData%Ud) -ENDIF -IF (ALLOCATED(LineData%zeta)) THEN - DEALLOCATE(LineData%zeta) -ENDIF -IF (ALLOCATED(LineData%PDyn)) THEN - DEALLOCATE(LineData%PDyn) -ENDIF -IF (ALLOCATED(LineData%T)) THEN - DEALLOCATE(LineData%T) -ENDIF -IF (ALLOCATED(LineData%Td)) THEN - DEALLOCATE(LineData%Td) -ENDIF -IF (ALLOCATED(LineData%W)) THEN - DEALLOCATE(LineData%W) -ENDIF -IF (ALLOCATED(LineData%Dp)) THEN - DEALLOCATE(LineData%Dp) -ENDIF -IF (ALLOCATED(LineData%Dq)) THEN - DEALLOCATE(LineData%Dq) -ENDIF -IF (ALLOCATED(LineData%Ap)) THEN - DEALLOCATE(LineData%Ap) -ENDIF -IF (ALLOCATED(LineData%Aq)) THEN - DEALLOCATE(LineData%Aq) -ENDIF -IF (ALLOCATED(LineData%B)) THEN - DEALLOCATE(LineData%B) -ENDIF -IF (ALLOCATED(LineData%Bs)) THEN - DEALLOCATE(LineData%Bs) -ENDIF -IF (ALLOCATED(LineData%Fnet)) THEN - DEALLOCATE(LineData%Fnet) -ENDIF -IF (ALLOCATED(LineData%S)) THEN - DEALLOCATE(LineData%S) -ENDIF -IF (ALLOCATED(LineData%M)) THEN - DEALLOCATE(LineData%M) -ENDIF -IF (ALLOCATED(LineData%LineWrOutput)) THEN - DEALLOCATE(LineData%LineWrOutput) -ENDIF - END SUBROUTINE MD_DestroyLine - - SUBROUTINE MD_PackLine( 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(MD_Line), 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 = 'MD_PackLine' - ! 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 ! IdNum - Int_BufSz = Int_BufSz + 1 ! PropsIdNum - Int_BufSz = Int_BufSz + 1 ! ElasticMod - Int_BufSz = Int_BufSz + SIZE(InData%OutFlagList) ! OutFlagList - Int_BufSz = Int_BufSz + 1 ! CtrlChan - Int_BufSz = Int_BufSz + 1 ! FairPoint - Int_BufSz = Int_BufSz + 1 ! AnchPoint - Int_BufSz = Int_BufSz + 1 ! N - Int_BufSz = Int_BufSz + 1 ! endTypeA - Int_BufSz = Int_BufSz + 1 ! endTypeB - Db_BufSz = Db_BufSz + 1 ! UnstrLen - Db_BufSz = Db_BufSz + 1 ! rho - Db_BufSz = Db_BufSz + 1 ! d - Db_BufSz = Db_BufSz + 1 ! EA - Db_BufSz = Db_BufSz + 1 ! EA_D - Db_BufSz = Db_BufSz + 1 ! BA - Db_BufSz = Db_BufSz + 1 ! BA_D - Db_BufSz = Db_BufSz + 1 ! EI - Db_BufSz = Db_BufSz + 1 ! Can - Db_BufSz = Db_BufSz + 1 ! Cat - Db_BufSz = Db_BufSz + 1 ! Cdn - Db_BufSz = Db_BufSz + 1 ! Cdt - Int_BufSz = Int_BufSz + 1 ! nEApoints - Db_BufSz = Db_BufSz + SIZE(InData%stiffXs) ! stiffXs - Db_BufSz = Db_BufSz + SIZE(InData%stiffYs) ! stiffYs - Int_BufSz = Int_BufSz + 1 ! nBApoints - Db_BufSz = Db_BufSz + SIZE(InData%dampXs) ! dampXs - Db_BufSz = Db_BufSz + SIZE(InData%dampYs) ! dampYs - Int_BufSz = Int_BufSz + 1 ! nEIpoints - Db_BufSz = Db_BufSz + SIZE(InData%bstiffXs) ! bstiffXs - Db_BufSz = Db_BufSz + SIZE(InData%bstiffYs) ! bstiffYs - Db_BufSz = Db_BufSz + 1 ! time - Int_BufSz = Int_BufSz + 1 ! r allocated yes/no - IF ( ALLOCATED(InData%r) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! r upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%r) ! r - END IF - Int_BufSz = Int_BufSz + 1 ! rd allocated yes/no - IF ( ALLOCATED(InData%rd) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! rd upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%rd) ! rd - END IF - Int_BufSz = Int_BufSz + 1 ! q allocated yes/no - IF ( ALLOCATED(InData%q) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! q upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%q) ! q - END IF - Int_BufSz = Int_BufSz + 1 ! qs allocated yes/no - IF ( ALLOCATED(InData%qs) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! qs upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%qs) ! qs - END IF - Int_BufSz = Int_BufSz + 1 ! l allocated yes/no - IF ( ALLOCATED(InData%l) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! l upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%l) ! l - END IF - Int_BufSz = Int_BufSz + 1 ! ld allocated yes/no - IF ( ALLOCATED(InData%ld) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ld upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%ld) ! ld - END IF - Int_BufSz = Int_BufSz + 1 ! lstr allocated yes/no - IF ( ALLOCATED(InData%lstr) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! lstr upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%lstr) ! lstr - END IF - Int_BufSz = Int_BufSz + 1 ! lstrd allocated yes/no - IF ( ALLOCATED(InData%lstrd) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! lstrd upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%lstrd) ! lstrd - END IF - Int_BufSz = Int_BufSz + 1 ! Kurv allocated yes/no - IF ( ALLOCATED(InData%Kurv) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Kurv upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Kurv) ! Kurv - END IF - Int_BufSz = Int_BufSz + 1 ! dl_1 allocated yes/no - IF ( ALLOCATED(InData%dl_1) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! dl_1 upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%dl_1) ! dl_1 - END IF - Int_BufSz = Int_BufSz + 1 ! V allocated yes/no - IF ( ALLOCATED(InData%V) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! V upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%V) ! V - END IF - Int_BufSz = Int_BufSz + 1 ! U allocated yes/no - IF ( ALLOCATED(InData%U) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! U upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%U) ! U - END IF - Int_BufSz = Int_BufSz + 1 ! Ud allocated yes/no - IF ( ALLOCATED(InData%Ud) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Ud upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Ud) ! Ud - END IF - Int_BufSz = Int_BufSz + 1 ! zeta allocated yes/no - IF ( ALLOCATED(InData%zeta) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! zeta upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%zeta) ! zeta - END IF - Int_BufSz = Int_BufSz + 1 ! PDyn allocated yes/no - IF ( ALLOCATED(InData%PDyn) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PDyn upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%PDyn) ! PDyn - END IF - Int_BufSz = Int_BufSz + 1 ! T allocated yes/no - IF ( ALLOCATED(InData%T) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! T upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%T) ! T - END IF - Int_BufSz = Int_BufSz + 1 ! Td allocated yes/no - IF ( ALLOCATED(InData%Td) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Td upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Td) ! Td - END IF - Int_BufSz = Int_BufSz + 1 ! W allocated yes/no - IF ( ALLOCATED(InData%W) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! W upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%W) ! W - END IF - Int_BufSz = Int_BufSz + 1 ! Dp allocated yes/no - IF ( ALLOCATED(InData%Dp) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Dp upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Dp) ! Dp - END IF - Int_BufSz = Int_BufSz + 1 ! Dq allocated yes/no - IF ( ALLOCATED(InData%Dq) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Dq upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Dq) ! Dq - END IF - Int_BufSz = Int_BufSz + 1 ! Ap allocated yes/no - IF ( ALLOCATED(InData%Ap) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Ap upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Ap) ! Ap - END IF - Int_BufSz = Int_BufSz + 1 ! Aq allocated yes/no - IF ( ALLOCATED(InData%Aq) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Aq upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Aq) ! Aq - END IF - Int_BufSz = Int_BufSz + 1 ! B allocated yes/no - IF ( ALLOCATED(InData%B) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! B upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%B) ! B - END IF - Int_BufSz = Int_BufSz + 1 ! Bs allocated yes/no - IF ( ALLOCATED(InData%Bs) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Bs upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Bs) ! Bs - END IF - Int_BufSz = Int_BufSz + 1 ! Fnet allocated yes/no - IF ( ALLOCATED(InData%Fnet) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Fnet upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Fnet) ! Fnet - END IF - Int_BufSz = Int_BufSz + 1 ! S allocated yes/no - IF ( ALLOCATED(InData%S) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! S upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%S) ! S - END IF - Int_BufSz = Int_BufSz + 1 ! M allocated yes/no - IF ( ALLOCATED(InData%M) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! M upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%M) ! M - END IF - Db_BufSz = Db_BufSz + SIZE(InData%EndMomentA) ! EndMomentA - Db_BufSz = Db_BufSz + SIZE(InData%EndMomentB) ! EndMomentB - Int_BufSz = Int_BufSz + 1 ! LineUnOut - Int_BufSz = Int_BufSz + 1 ! LineWrOutput allocated yes/no - IF ( ALLOCATED(InData%LineWrOutput) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LineWrOutput upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%LineWrOutput) ! LineWrOutput - 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%IdNum - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%PropsIdNum - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%ElasticMod - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%OutFlagList,1), UBOUND(InData%OutFlagList,1) - IntKiBuf(Int_Xferred) = InData%OutFlagList(i1) - Int_Xferred = Int_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%CtrlChan - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%FairPoint - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%AnchPoint - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%N - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%endTypeA - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%endTypeB - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%UnstrLen - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%rho - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%d - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%EA - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%EA_D - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%BA - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%BA_D - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%EI - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%Can - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%Cat - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%Cdn - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%Cdt - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nEApoints - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%stiffXs,1), UBOUND(InData%stiffXs,1) - DbKiBuf(Db_Xferred) = InData%stiffXs(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%stiffYs,1), UBOUND(InData%stiffYs,1) - DbKiBuf(Db_Xferred) = InData%stiffYs(i1) - Db_Xferred = Db_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%nBApoints - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%dampXs,1), UBOUND(InData%dampXs,1) - DbKiBuf(Db_Xferred) = InData%dampXs(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%dampYs,1), UBOUND(InData%dampYs,1) - DbKiBuf(Db_Xferred) = InData%dampYs(i1) - Db_Xferred = Db_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%nEIpoints - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%bstiffXs,1), UBOUND(InData%bstiffXs,1) - DbKiBuf(Db_Xferred) = InData%bstiffXs(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%bstiffYs,1), UBOUND(InData%bstiffYs,1) - DbKiBuf(Db_Xferred) = InData%bstiffYs(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DbKiBuf(Db_Xferred) = InData%time - Db_Xferred = Db_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 - IntKiBuf( Int_Xferred ) = LBOUND(InData%r,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%r,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%r,2), UBOUND(InData%r,2) - DO i1 = LBOUND(InData%r,1), UBOUND(InData%r,1) - DbKiBuf(Db_Xferred) = InData%r(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%rd) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rd,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rd,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rd,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rd,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%rd,2), UBOUND(InData%rd,2) - DO i1 = LBOUND(InData%rd,1), UBOUND(InData%rd,1) - DbKiBuf(Db_Xferred) = InData%rd(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%q) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%q,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%q,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%q,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%q,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%q,2), UBOUND(InData%q,2) - DO i1 = LBOUND(InData%q,1), UBOUND(InData%q,1) - DbKiBuf(Db_Xferred) = InData%q(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%qs) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%qs,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%qs,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%qs,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%qs,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%qs,2), UBOUND(InData%qs,2) - DO i1 = LBOUND(InData%qs,1), UBOUND(InData%qs,1) - DbKiBuf(Db_Xferred) = InData%qs(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%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%l,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%l,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%l,1), UBOUND(InData%l,1) - DbKiBuf(Db_Xferred) = InData%l(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ld) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ld,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ld,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ld,1), UBOUND(InData%ld,1) - DbKiBuf(Db_Xferred) = InData%ld(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%lstr) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%lstr,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%lstr,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%lstr,1), UBOUND(InData%lstr,1) - DbKiBuf(Db_Xferred) = InData%lstr(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%lstrd) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%lstrd,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%lstrd,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%lstrd,1), UBOUND(InData%lstrd,1) - DbKiBuf(Db_Xferred) = InData%lstrd(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Kurv) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Kurv,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Kurv,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Kurv,1), UBOUND(InData%Kurv,1) - DbKiBuf(Db_Xferred) = InData%Kurv(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%dl_1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%dl_1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dl_1,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%dl_1,1), UBOUND(InData%dl_1,1) - DbKiBuf(Db_Xferred) = InData%dl_1(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(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) - DbKiBuf(Db_Xferred) = InData%V(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(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 - IntKiBuf( Int_Xferred ) = LBOUND(InData%U,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%U,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%U,2), UBOUND(InData%U,2) - DO i1 = LBOUND(InData%U,1), UBOUND(InData%U,1) - DbKiBuf(Db_Xferred) = InData%U(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Ud) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Ud,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Ud,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Ud,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Ud,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Ud,2), UBOUND(InData%Ud,2) - DO i1 = LBOUND(InData%Ud,1), UBOUND(InData%Ud,1) - DbKiBuf(Db_Xferred) = InData%Ud(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%zeta) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%zeta,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%zeta,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%zeta,1), UBOUND(InData%zeta,1) - DbKiBuf(Db_Xferred) = InData%zeta(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PDyn) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PDyn,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PDyn,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PDyn,1), UBOUND(InData%PDyn,1) - DbKiBuf(Db_Xferred) = InData%PDyn(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%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,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%T,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%T,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%T,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%T,2), UBOUND(InData%T,2) - DO i1 = LBOUND(InData%T,1), UBOUND(InData%T,1) - DbKiBuf(Db_Xferred) = InData%T(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Td) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Td,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Td,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Td,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Td,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Td,2), UBOUND(InData%Td,2) - DO i1 = LBOUND(InData%Td,1), UBOUND(InData%Td,1) - DbKiBuf(Db_Xferred) = InData%Td(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(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 - IntKiBuf( Int_Xferred ) = LBOUND(InData%W,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%W,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%W,2), UBOUND(InData%W,2) - DO i1 = LBOUND(InData%W,1), UBOUND(InData%W,1) - DbKiBuf(Db_Xferred) = InData%W(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Dp) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Dp,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Dp,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Dp,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Dp,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Dp,2), UBOUND(InData%Dp,2) - DO i1 = LBOUND(InData%Dp,1), UBOUND(InData%Dp,1) - DbKiBuf(Db_Xferred) = InData%Dp(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Dq) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Dq,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Dq,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Dq,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Dq,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Dq,2), UBOUND(InData%Dq,2) - DO i1 = LBOUND(InData%Dq,1), UBOUND(InData%Dq,1) - DbKiBuf(Db_Xferred) = InData%Dq(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Ap) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Ap,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Ap,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Ap,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Ap,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Ap,2), UBOUND(InData%Ap,2) - DO i1 = LBOUND(InData%Ap,1), UBOUND(InData%Ap,1) - DbKiBuf(Db_Xferred) = InData%Ap(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Aq) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Aq,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Aq,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Aq,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Aq,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Aq,2), UBOUND(InData%Aq,2) - DO i1 = LBOUND(InData%Aq,1), UBOUND(InData%Aq,1) - DbKiBuf(Db_Xferred) = InData%Aq(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - 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 - IntKiBuf( Int_Xferred ) = LBOUND(InData%B,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%B,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%B,2), UBOUND(InData%B,2) - DO i1 = LBOUND(InData%B,1), UBOUND(InData%B,1) - DbKiBuf(Db_Xferred) = InData%B(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Bs) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Bs,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Bs,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Bs,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Bs,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Bs,2), UBOUND(InData%Bs,2) - DO i1 = LBOUND(InData%Bs,1), UBOUND(InData%Bs,1) - DbKiBuf(Db_Xferred) = InData%Bs(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Fnet) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Fnet,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fnet,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Fnet,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fnet,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Fnet,2), UBOUND(InData%Fnet,2) - DO i1 = LBOUND(InData%Fnet,1), UBOUND(InData%Fnet,1) - DbKiBuf(Db_Xferred) = InData%Fnet(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%S) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%S,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%S,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%S,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%S,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%S,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%S,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%S,3), UBOUND(InData%S,3) - DO i2 = LBOUND(InData%S,2), UBOUND(InData%S,2) - DO i1 = LBOUND(InData%S,1), UBOUND(InData%S,1) - DbKiBuf(Db_Xferred) = InData%S(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - 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 - IntKiBuf( Int_Xferred ) = LBOUND(InData%M,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%M,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%M,3), UBOUND(InData%M,3) - 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,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - DO i1 = LBOUND(InData%EndMomentA,1), UBOUND(InData%EndMomentA,1) - DbKiBuf(Db_Xferred) = InData%EndMomentA(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%EndMomentB,1), UBOUND(InData%EndMomentB,1) - DbKiBuf(Db_Xferred) = InData%EndMomentB(i1) - Db_Xferred = Db_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%LineUnOut - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%LineWrOutput) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LineWrOutput,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LineWrOutput,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LineWrOutput,1), UBOUND(InData%LineWrOutput,1) - DbKiBuf(Db_Xferred) = InData%LineWrOutput(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE MD_PackLine - - SUBROUTINE MD_UnPackLine( 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(MD_Line), 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 = 'MD_UnPackLine' - ! 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%IdNum = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%PropsIdNum = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%ElasticMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%OutFlagList,1) - i1_u = UBOUND(OutData%OutFlagList,1) - DO i1 = LBOUND(OutData%OutFlagList,1), UBOUND(OutData%OutFlagList,1) - OutData%OutFlagList(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - OutData%CtrlChan = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%FairPoint = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%AnchPoint = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%N = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%endTypeA = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%endTypeB = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%UnstrLen = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%rho = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%d = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%EA = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%EA_D = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%BA = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%BA_D = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%EI = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%Can = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%Cat = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%Cdn = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%Cdt = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%nEApoints = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%stiffXs,1) - i1_u = UBOUND(OutData%stiffXs,1) - DO i1 = LBOUND(OutData%stiffXs,1), UBOUND(OutData%stiffXs,1) - OutData%stiffXs(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%stiffYs,1) - i1_u = UBOUND(OutData%stiffYs,1) - DO i1 = LBOUND(OutData%stiffYs,1), UBOUND(OutData%stiffYs,1) - OutData%stiffYs(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - OutData%nBApoints = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%dampXs,1) - i1_u = UBOUND(OutData%dampXs,1) - DO i1 = LBOUND(OutData%dampXs,1), UBOUND(OutData%dampXs,1) - OutData%dampXs(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%dampYs,1) - i1_u = UBOUND(OutData%dampYs,1) - DO i1 = LBOUND(OutData%dampYs,1), UBOUND(OutData%dampYs,1) - OutData%dampYs(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - OutData%nEIpoints = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%bstiffXs,1) - i1_u = UBOUND(OutData%bstiffXs,1) - DO i1 = LBOUND(OutData%bstiffXs,1), UBOUND(OutData%bstiffXs,1) - OutData%bstiffXs(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%bstiffYs,1) - i1_u = UBOUND(OutData%bstiffYs,1) - DO i1 = LBOUND(OutData%bstiffYs,1), UBOUND(OutData%bstiffYs,1) - OutData%bstiffYs(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - OutData%time = DbKiBuf(Db_Xferred) - Db_Xferred = Db_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 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%r)) DEALLOCATE(OutData%r) - ALLOCATE(OutData%r(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%r.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%r,2), UBOUND(OutData%r,2) - DO i1 = LBOUND(OutData%r,1), UBOUND(OutData%r,1) - OutData%r(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rd not allocated - Int_Xferred = Int_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%rd)) DEALLOCATE(OutData%rd) - ALLOCATE(OutData%rd(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%rd,2), UBOUND(OutData%rd,2) - DO i1 = LBOUND(OutData%rd,1), UBOUND(OutData%rd,1) - OutData%rd(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! q not allocated - Int_Xferred = Int_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%q)) DEALLOCATE(OutData%q) - ALLOCATE(OutData%q(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%q.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%q,2), UBOUND(OutData%q,2) - DO i1 = LBOUND(OutData%q,1), UBOUND(OutData%q,1) - OutData%q(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! qs not allocated - Int_Xferred = Int_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%qs)) DEALLOCATE(OutData%qs) - ALLOCATE(OutData%qs(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%qs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%qs,2), UBOUND(OutData%qs,2) - DO i1 = LBOUND(OutData%qs,1), UBOUND(OutData%qs,1) - OutData%qs(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! 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%l)) DEALLOCATE(OutData%l) - ALLOCATE(OutData%l(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%l.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%l,1), UBOUND(OutData%l,1) - OutData%l(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ld not allocated - Int_Xferred = Int_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%ld)) DEALLOCATE(OutData%ld) - ALLOCATE(OutData%ld(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ld.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ld,1), UBOUND(OutData%ld,1) - OutData%ld(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! lstr not allocated - Int_Xferred = Int_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%lstr)) DEALLOCATE(OutData%lstr) - ALLOCATE(OutData%lstr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%lstr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%lstr,1), UBOUND(OutData%lstr,1) - OutData%lstr(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! lstrd not allocated - Int_Xferred = Int_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%lstrd)) DEALLOCATE(OutData%lstrd) - ALLOCATE(OutData%lstrd(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%lstrd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%lstrd,1), UBOUND(OutData%lstrd,1) - OutData%lstrd(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Kurv not allocated - Int_Xferred = Int_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%Kurv)) DEALLOCATE(OutData%Kurv) - ALLOCATE(OutData%Kurv(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Kurv.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Kurv,1), UBOUND(OutData%Kurv,1) - OutData%Kurv(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! dl_1 not allocated - Int_Xferred = Int_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%dl_1)) DEALLOCATE(OutData%dl_1) - ALLOCATE(OutData%dl_1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%dl_1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%dl_1,1), UBOUND(OutData%dl_1,1) - OutData%dl_1(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_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 (ALLOCATED(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 - DO i1 = LBOUND(OutData%V,1), UBOUND(OutData%V,1) - OutData%V(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - 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 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%U)) DEALLOCATE(OutData%U) - ALLOCATE(OutData%U(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%U.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%U,2), UBOUND(OutData%U,2) - DO i1 = LBOUND(OutData%U,1), UBOUND(OutData%U,1) - OutData%U(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Ud not allocated - Int_Xferred = Int_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%Ud)) DEALLOCATE(OutData%Ud) - ALLOCATE(OutData%Ud(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Ud.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Ud,2), UBOUND(OutData%Ud,2) - DO i1 = LBOUND(OutData%Ud,1), UBOUND(OutData%Ud,1) - OutData%Ud(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! zeta not allocated - Int_Xferred = Int_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%zeta)) DEALLOCATE(OutData%zeta) - ALLOCATE(OutData%zeta(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%zeta.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%zeta,1), UBOUND(OutData%zeta,1) - OutData%zeta(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PDyn not allocated - Int_Xferred = Int_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%PDyn)) DEALLOCATE(OutData%PDyn) - ALLOCATE(OutData%PDyn(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PDyn.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PDyn,1), UBOUND(OutData%PDyn,1) - OutData%PDyn(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! 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)) DEALLOCATE(OutData%T) - ALLOCATE(OutData%T(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%T.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%T,2), UBOUND(OutData%T,2) - DO i1 = LBOUND(OutData%T,1), UBOUND(OutData%T,1) - OutData%T(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Td not allocated - Int_Xferred = Int_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%Td)) DEALLOCATE(OutData%Td) - ALLOCATE(OutData%Td(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Td.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Td,2), UBOUND(OutData%Td,2) - DO i1 = LBOUND(OutData%Td,1), UBOUND(OutData%Td,1) - OutData%Td(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - 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 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%W)) DEALLOCATE(OutData%W) - ALLOCATE(OutData%W(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%W.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%W,2), UBOUND(OutData%W,2) - DO i1 = LBOUND(OutData%W,1), UBOUND(OutData%W,1) - OutData%W(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Dp not allocated - Int_Xferred = Int_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%Dp)) DEALLOCATE(OutData%Dp) - ALLOCATE(OutData%Dp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Dp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Dp,2), UBOUND(OutData%Dp,2) - DO i1 = LBOUND(OutData%Dp,1), UBOUND(OutData%Dp,1) - OutData%Dp(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Dq not allocated - Int_Xferred = Int_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%Dq)) DEALLOCATE(OutData%Dq) - ALLOCATE(OutData%Dq(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Dq.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Dq,2), UBOUND(OutData%Dq,2) - DO i1 = LBOUND(OutData%Dq,1), UBOUND(OutData%Dq,1) - OutData%Dq(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Ap not allocated - Int_Xferred = Int_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%Ap)) DEALLOCATE(OutData%Ap) - ALLOCATE(OutData%Ap(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Ap.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Ap,2), UBOUND(OutData%Ap,2) - DO i1 = LBOUND(OutData%Ap,1), UBOUND(OutData%Ap,1) - OutData%Ap(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Aq not allocated - Int_Xferred = Int_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%Aq)) DEALLOCATE(OutData%Aq) - ALLOCATE(OutData%Aq(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Aq.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Aq,2), UBOUND(OutData%Aq,2) - DO i1 = LBOUND(OutData%Aq,1), UBOUND(OutData%Aq,1) - OutData%Aq(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - 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 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%B)) DEALLOCATE(OutData%B) - ALLOCATE(OutData%B(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%B.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%B,2), UBOUND(OutData%B,2) - DO i1 = LBOUND(OutData%B,1), UBOUND(OutData%B,1) - OutData%B(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Bs not allocated - Int_Xferred = Int_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%Bs)) DEALLOCATE(OutData%Bs) - ALLOCATE(OutData%Bs(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Bs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Bs,2), UBOUND(OutData%Bs,2) - DO i1 = LBOUND(OutData%Bs,1), UBOUND(OutData%Bs,1) - OutData%Bs(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Fnet not allocated - Int_Xferred = Int_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%Fnet)) DEALLOCATE(OutData%Fnet) - ALLOCATE(OutData%Fnet(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fnet.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Fnet,2), UBOUND(OutData%Fnet,2) - DO i1 = LBOUND(OutData%Fnet,1), UBOUND(OutData%Fnet,1) - OutData%Fnet(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! S not allocated - Int_Xferred = Int_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%S)) DEALLOCATE(OutData%S) - ALLOCATE(OutData%S(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%S.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%S,3), UBOUND(OutData%S,3) - DO i2 = LBOUND(OutData%S,2), UBOUND(OutData%S,2) - DO i1 = LBOUND(OutData%S,1), UBOUND(OutData%S,1) - OutData%S(i1,i2,i3) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - 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 - i3_l = IntKiBuf( Int_Xferred ) - i3_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,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%M.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%M,3), UBOUND(OutData%M,3) - DO i2 = LBOUND(OutData%M,2), UBOUND(OutData%M,2) - DO i1 = LBOUND(OutData%M,1), UBOUND(OutData%M,1) - OutData%M(i1,i2,i3) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - i1_l = LBOUND(OutData%EndMomentA,1) - i1_u = UBOUND(OutData%EndMomentA,1) - DO i1 = LBOUND(OutData%EndMomentA,1), UBOUND(OutData%EndMomentA,1) - OutData%EndMomentA(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%EndMomentB,1) - i1_u = UBOUND(OutData%EndMomentB,1) - DO i1 = LBOUND(OutData%EndMomentB,1), UBOUND(OutData%EndMomentB,1) - OutData%EndMomentB(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - OutData%LineUnOut = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LineWrOutput not allocated - Int_Xferred = Int_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%LineWrOutput)) DEALLOCATE(OutData%LineWrOutput) - ALLOCATE(OutData%LineWrOutput(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LineWrOutput.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LineWrOutput,1), UBOUND(OutData%LineWrOutput,1) - OutData%LineWrOutput(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE MD_UnPackLine - - SUBROUTINE MD_CopyFail( SrcFailData, DstFailData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MD_Fail), INTENT(IN) :: SrcFailData - TYPE(MD_Fail), INTENT(INOUT) :: DstFailData - 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 = 'MD_CopyFail' -! - ErrStat = ErrID_None - ErrMsg = "" - DstFailData%IdNum = SrcFailData%IdNum - END SUBROUTINE MD_CopyFail - - SUBROUTINE MD_DestroyFail( FailData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(MD_Fail), INTENT(INOUT) :: FailData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_DestroyFail' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE MD_DestroyFail - - SUBROUTINE MD_PackFail( 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(MD_Fail), 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 = 'MD_PackFail' - ! 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 ! IdNum - 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%IdNum - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE MD_PackFail - - SUBROUTINE MD_UnPackFail( 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(MD_Fail), 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 = 'MD_UnPackFail' - ! 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%IdNum = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE MD_UnPackFail - - SUBROUTINE MD_CopyOutParmType( SrcOutParmTypeData, DstOutParmTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MD_OutParmType), INTENT(IN) :: SrcOutParmTypeData - TYPE(MD_OutParmType), INTENT(INOUT) :: DstOutParmTypeData - 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 = 'MD_CopyOutParmType' -! - ErrStat = ErrID_None - ErrMsg = "" - DstOutParmTypeData%Name = SrcOutParmTypeData%Name - DstOutParmTypeData%Units = SrcOutParmTypeData%Units - DstOutParmTypeData%QType = SrcOutParmTypeData%QType - DstOutParmTypeData%OType = SrcOutParmTypeData%OType - DstOutParmTypeData%NodeID = SrcOutParmTypeData%NodeID - DstOutParmTypeData%ObjID = SrcOutParmTypeData%ObjID - END SUBROUTINE MD_CopyOutParmType - - SUBROUTINE MD_DestroyOutParmType( OutParmTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(MD_OutParmType), INTENT(INOUT) :: OutParmTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_DestroyOutParmType' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE MD_DestroyOutParmType - - SUBROUTINE MD_PackOutParmType( 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(MD_OutParmType), 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 = 'MD_PackOutParmType' - ! 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%Name) ! Name - Int_BufSz = Int_BufSz + 1*LEN(InData%Units) ! Units - Int_BufSz = Int_BufSz + 1 ! QType - Int_BufSz = Int_BufSz + 1 ! OType - Int_BufSz = Int_BufSz + 1 ! NodeID - Int_BufSz = Int_BufSz + 1 ! ObjID - 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%Name) - IntKiBuf(Int_Xferred) = ICHAR(InData%Name(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%Units) - IntKiBuf(Int_Xferred) = ICHAR(InData%Units(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = InData%QType - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%OType - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NodeID - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%ObjID - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE MD_PackOutParmType - - SUBROUTINE MD_UnPackOutParmType( 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(MD_OutParmType), 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 = 'MD_UnPackOutParmType' - ! 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%Name) - OutData%Name(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%Units) - OutData%Units(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%QType = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%OType = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NodeID = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%ObjID = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE MD_UnPackOutParmType - - SUBROUTINE MD_CopyVisDiam( SrcVisDiamData, DstVisDiamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(VisDiam), INTENT(IN) :: SrcVisDiamData - TYPE(VisDiam), INTENT(INOUT) :: DstVisDiamData - 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 = 'MD_CopyVisDiam' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcVisDiamData%Diam)) THEN - i1_l = LBOUND(SrcVisDiamData%Diam,1) - i1_u = UBOUND(SrcVisDiamData%Diam,1) - IF (.NOT. ALLOCATED(DstVisDiamData%Diam)) THEN - ALLOCATE(DstVisDiamData%Diam(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstVisDiamData%Diam.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstVisDiamData%Diam = SrcVisDiamData%Diam -ENDIF - END SUBROUTINE MD_CopyVisDiam - - SUBROUTINE MD_DestroyVisDiam( VisDiamData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(VisDiam), INTENT(INOUT) :: VisDiamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_DestroyVisDiam' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(VisDiamData%Diam)) THEN - DEALLOCATE(VisDiamData%Diam) -ENDIF - END SUBROUTINE MD_DestroyVisDiam - - SUBROUTINE MD_PackVisDiam( 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(VisDiam), 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 = 'MD_PackVisDiam' - ! 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 ! Diam allocated yes/no - IF ( ALLOCATED(InData%Diam) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Diam upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Diam) ! Diam - 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%Diam) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Diam,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Diam,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Diam,1), UBOUND(InData%Diam,1) - ReKiBuf(Re_Xferred) = InData%Diam(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE MD_PackVisDiam - - SUBROUTINE MD_UnPackVisDiam( 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(VisDiam), 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 = 'MD_UnPackVisDiam' - ! 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 ! Diam not allocated - Int_Xferred = Int_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%Diam)) DEALLOCATE(OutData%Diam) - ALLOCATE(OutData%Diam(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Diam.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Diam,1), UBOUND(OutData%Diam,1) - OutData%Diam(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE MD_UnPackVisDiam - - SUBROUTINE MD_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MD_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(MD_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 = 'MD_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%CableCChanRqst)) THEN - i1_l = LBOUND(SrcInitOutputData%CableCChanRqst,1) - i1_u = UBOUND(SrcInitOutputData%CableCChanRqst,1) - IF (.NOT. ALLOCATED(DstInitOutputData%CableCChanRqst)) THEN - ALLOCATE(DstInitOutputData%CableCChanRqst(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%CableCChanRqst.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%CableCChanRqst = SrcInitOutputData%CableCChanRqst -ENDIF -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 MD_CopyInitOutput - - SUBROUTINE MD_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(MD_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_DestroyInitOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(InitOutputData%writeOutputHdr)) THEN - DEALLOCATE(InitOutputData%writeOutputHdr) -ENDIF -IF (ALLOCATED(InitOutputData%writeOutputUnt)) THEN - DEALLOCATE(InitOutputData%writeOutputUnt) -ENDIF - CALL NWTC_Library_Destroyprogdesc( InitOutputData%Ver, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(InitOutputData%CableCChanRqst)) THEN - DEALLOCATE(InitOutputData%CableCChanRqst) -ENDIF -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 MD_DestroyInitOutput - - SUBROUTINE MD_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(MD_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 = 'MD_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 ! CableCChanRqst allocated yes/no - IF ( ALLOCATED(InData%CableCChanRqst) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! CableCChanRqst upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%CableCChanRqst) ! CableCChanRqst - 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%CableCChanRqst) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CableCChanRqst,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CableCChanRqst,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%CableCChanRqst,1), UBOUND(InData%CableCChanRqst,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%CableCChanRqst(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - 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 MD_PackInitOutput - - SUBROUTINE MD_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(MD_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 = 'MD_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 ! CableCChanRqst not allocated - Int_Xferred = Int_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%CableCChanRqst)) DEALLOCATE(OutData%CableCChanRqst) - ALLOCATE(OutData%CableCChanRqst(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CableCChanRqst.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%CableCChanRqst,1), UBOUND(OutData%CableCChanRqst,1) - OutData%CableCChanRqst(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%CableCChanRqst(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - 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 MD_UnPackInitOutput - - SUBROUTINE MD_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MD_ContinuousStateType), INTENT(IN) :: SrcContStateData - TYPE(MD_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 = 'MD_CopyContState' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcContStateData%states)) THEN - i1_l = LBOUND(SrcContStateData%states,1) - i1_u = UBOUND(SrcContStateData%states,1) - IF (.NOT. ALLOCATED(DstContStateData%states)) THEN - ALLOCATE(DstContStateData%states(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%states.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstContStateData%states = SrcContStateData%states -ENDIF - END SUBROUTINE MD_CopyContState - - SUBROUTINE MD_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(MD_ContinuousStateType), INTENT(INOUT) :: ContStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_DestroyContState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(ContStateData%states)) THEN - DEALLOCATE(ContStateData%states) -ENDIF - END SUBROUTINE MD_DestroyContState - - SUBROUTINE MD_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(MD_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 = 'MD_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 ! states allocated yes/no - IF ( ALLOCATED(InData%states) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! states upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%states) ! states - 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%states) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%states,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%states,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%states,1), UBOUND(InData%states,1) - DbKiBuf(Db_Xferred) = InData%states(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE MD_PackContState - - SUBROUTINE MD_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(MD_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 = 'MD_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 ! states not allocated - Int_Xferred = Int_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%states)) DEALLOCATE(OutData%states) - ALLOCATE(OutData%states(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%states.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%states,1), UBOUND(OutData%states,1) - OutData%states(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE MD_UnPackContState - - SUBROUTINE MD_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MD_DiscreteStateType), INTENT(IN) :: SrcDiscStateData - TYPE(MD_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 = 'MD_CopyDiscState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstDiscStateData%dummy = SrcDiscStateData%dummy - END SUBROUTINE MD_CopyDiscState - - SUBROUTINE MD_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(MD_DiscreteStateType), INTENT(INOUT) :: DiscStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_DestroyDiscState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE MD_DestroyDiscState - - SUBROUTINE MD_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(MD_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 = 'MD_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 MD_PackDiscState - - SUBROUTINE MD_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(MD_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 = 'MD_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 = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE MD_UnPackDiscState - - SUBROUTINE MD_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MD_ConstraintStateType), INTENT(IN) :: SrcConstrStateData - TYPE(MD_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 = 'MD_CopyConstrState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstConstrStateData%dummy = SrcConstrStateData%dummy - END SUBROUTINE MD_CopyConstrState - - SUBROUTINE MD_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(MD_ConstraintStateType), INTENT(INOUT) :: ConstrStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_DestroyConstrState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE MD_DestroyConstrState - - SUBROUTINE MD_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(MD_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 = 'MD_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) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%dummy - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE MD_PackConstrState - - SUBROUTINE MD_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(MD_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 = 'MD_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 - END SUBROUTINE MD_UnPackConstrState - - SUBROUTINE MD_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MD_OtherStateType), INTENT(IN) :: SrcOtherStateData - TYPE(MD_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 = 'MD_CopyOtherState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstOtherStateData%dummy = SrcOtherStateData%dummy - END SUBROUTINE MD_CopyOtherState - - SUBROUTINE MD_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(MD_OtherStateType), INTENT(INOUT) :: OtherStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_DestroyOtherState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE MD_DestroyOtherState - - SUBROUTINE MD_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(MD_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 = 'MD_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 ! 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 MD_PackOtherState - - SUBROUTINE MD_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(MD_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 = 'MD_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 = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE MD_UnPackOtherState - - SUBROUTINE MD_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MD_MiscVarType), INTENT(IN) :: SrcMiscData - TYPE(MD_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 = 'MD_CopyMisc' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcMiscData%LineTypeList)) THEN - i1_l = LBOUND(SrcMiscData%LineTypeList,1) - i1_u = UBOUND(SrcMiscData%LineTypeList,1) - IF (.NOT. ALLOCATED(DstMiscData%LineTypeList)) THEN - ALLOCATE(DstMiscData%LineTypeList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%LineTypeList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%LineTypeList,1), UBOUND(SrcMiscData%LineTypeList,1) - CALL MD_Copylineprop( SrcMiscData%LineTypeList(i1), DstMiscData%LineTypeList(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcMiscData%RodTypeList)) THEN - i1_l = LBOUND(SrcMiscData%RodTypeList,1) - i1_u = UBOUND(SrcMiscData%RodTypeList,1) - IF (.NOT. ALLOCATED(DstMiscData%RodTypeList)) THEN - ALLOCATE(DstMiscData%RodTypeList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%RodTypeList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%RodTypeList,1), UBOUND(SrcMiscData%RodTypeList,1) - CALL MD_Copyrodprop( SrcMiscData%RodTypeList(i1), DstMiscData%RodTypeList(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL MD_Copybody( SrcMiscData%GroundBody, DstMiscData%GroundBody, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcMiscData%BodyList)) THEN - i1_l = LBOUND(SrcMiscData%BodyList,1) - i1_u = UBOUND(SrcMiscData%BodyList,1) - IF (.NOT. ALLOCATED(DstMiscData%BodyList)) THEN - ALLOCATE(DstMiscData%BodyList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BodyList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%BodyList,1), UBOUND(SrcMiscData%BodyList,1) - CALL MD_Copybody( SrcMiscData%BodyList(i1), DstMiscData%BodyList(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcMiscData%RodList)) THEN - i1_l = LBOUND(SrcMiscData%RodList,1) - i1_u = UBOUND(SrcMiscData%RodList,1) - IF (.NOT. ALLOCATED(DstMiscData%RodList)) THEN - ALLOCATE(DstMiscData%RodList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%RodList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%RodList,1), UBOUND(SrcMiscData%RodList,1) - CALL MD_Copyrod( SrcMiscData%RodList(i1), DstMiscData%RodList(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcMiscData%PointList)) THEN - i1_l = LBOUND(SrcMiscData%PointList,1) - i1_u = UBOUND(SrcMiscData%PointList,1) - IF (.NOT. ALLOCATED(DstMiscData%PointList)) THEN - ALLOCATE(DstMiscData%PointList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%PointList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%PointList,1), UBOUND(SrcMiscData%PointList,1) - CALL MD_Copypoint( SrcMiscData%PointList(i1), DstMiscData%PointList(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcMiscData%LineList)) THEN - i1_l = LBOUND(SrcMiscData%LineList,1) - i1_u = UBOUND(SrcMiscData%LineList,1) - IF (.NOT. ALLOCATED(DstMiscData%LineList)) THEN - ALLOCATE(DstMiscData%LineList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%LineList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%LineList,1), UBOUND(SrcMiscData%LineList,1) - CALL MD_Copyline( SrcMiscData%LineList(i1), DstMiscData%LineList(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcMiscData%FailList)) THEN - i1_l = LBOUND(SrcMiscData%FailList,1) - i1_u = UBOUND(SrcMiscData%FailList,1) - IF (.NOT. ALLOCATED(DstMiscData%FailList)) THEN - ALLOCATE(DstMiscData%FailList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FailList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%FailList,1), UBOUND(SrcMiscData%FailList,1) - CALL MD_Copyfail( SrcMiscData%FailList(i1), DstMiscData%FailList(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcMiscData%FreePointIs)) THEN - i1_l = LBOUND(SrcMiscData%FreePointIs,1) - i1_u = UBOUND(SrcMiscData%FreePointIs,1) - IF (.NOT. ALLOCATED(DstMiscData%FreePointIs)) THEN - ALLOCATE(DstMiscData%FreePointIs(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FreePointIs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%FreePointIs = SrcMiscData%FreePointIs -ENDIF -IF (ALLOCATED(SrcMiscData%CpldPointIs)) THEN - i1_l = LBOUND(SrcMiscData%CpldPointIs,1) - i1_u = UBOUND(SrcMiscData%CpldPointIs,1) - i2_l = LBOUND(SrcMiscData%CpldPointIs,2) - i2_u = UBOUND(SrcMiscData%CpldPointIs,2) - IF (.NOT. ALLOCATED(DstMiscData%CpldPointIs)) THEN - ALLOCATE(DstMiscData%CpldPointIs(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%CpldPointIs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%CpldPointIs = SrcMiscData%CpldPointIs -ENDIF -IF (ALLOCATED(SrcMiscData%FreeRodIs)) THEN - i1_l = LBOUND(SrcMiscData%FreeRodIs,1) - i1_u = UBOUND(SrcMiscData%FreeRodIs,1) - IF (.NOT. ALLOCATED(DstMiscData%FreeRodIs)) THEN - ALLOCATE(DstMiscData%FreeRodIs(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FreeRodIs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%FreeRodIs = SrcMiscData%FreeRodIs -ENDIF -IF (ALLOCATED(SrcMiscData%CpldRodIs)) THEN - i1_l = LBOUND(SrcMiscData%CpldRodIs,1) - i1_u = UBOUND(SrcMiscData%CpldRodIs,1) - i2_l = LBOUND(SrcMiscData%CpldRodIs,2) - i2_u = UBOUND(SrcMiscData%CpldRodIs,2) - IF (.NOT. ALLOCATED(DstMiscData%CpldRodIs)) THEN - ALLOCATE(DstMiscData%CpldRodIs(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%CpldRodIs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%CpldRodIs = SrcMiscData%CpldRodIs -ENDIF -IF (ALLOCATED(SrcMiscData%FreeBodyIs)) THEN - i1_l = LBOUND(SrcMiscData%FreeBodyIs,1) - i1_u = UBOUND(SrcMiscData%FreeBodyIs,1) - IF (.NOT. ALLOCATED(DstMiscData%FreeBodyIs)) THEN - ALLOCATE(DstMiscData%FreeBodyIs(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FreeBodyIs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%FreeBodyIs = SrcMiscData%FreeBodyIs -ENDIF -IF (ALLOCATED(SrcMiscData%CpldBodyIs)) THEN - i1_l = LBOUND(SrcMiscData%CpldBodyIs,1) - i1_u = UBOUND(SrcMiscData%CpldBodyIs,1) - i2_l = LBOUND(SrcMiscData%CpldBodyIs,2) - i2_u = UBOUND(SrcMiscData%CpldBodyIs,2) - IF (.NOT. ALLOCATED(DstMiscData%CpldBodyIs)) THEN - ALLOCATE(DstMiscData%CpldBodyIs(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%CpldBodyIs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%CpldBodyIs = SrcMiscData%CpldBodyIs -ENDIF -IF (ALLOCATED(SrcMiscData%LineStateIs1)) THEN - i1_l = LBOUND(SrcMiscData%LineStateIs1,1) - i1_u = UBOUND(SrcMiscData%LineStateIs1,1) - IF (.NOT. ALLOCATED(DstMiscData%LineStateIs1)) THEN - ALLOCATE(DstMiscData%LineStateIs1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%LineStateIs1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%LineStateIs1 = SrcMiscData%LineStateIs1 -ENDIF -IF (ALLOCATED(SrcMiscData%LineStateIsN)) THEN - i1_l = LBOUND(SrcMiscData%LineStateIsN,1) - i1_u = UBOUND(SrcMiscData%LineStateIsN,1) - IF (.NOT. ALLOCATED(DstMiscData%LineStateIsN)) THEN - ALLOCATE(DstMiscData%LineStateIsN(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%LineStateIsN.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%LineStateIsN = SrcMiscData%LineStateIsN -ENDIF -IF (ALLOCATED(SrcMiscData%PointStateIs1)) THEN - i1_l = LBOUND(SrcMiscData%PointStateIs1,1) - i1_u = UBOUND(SrcMiscData%PointStateIs1,1) - IF (.NOT. ALLOCATED(DstMiscData%PointStateIs1)) THEN - ALLOCATE(DstMiscData%PointStateIs1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%PointStateIs1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%PointStateIs1 = SrcMiscData%PointStateIs1 -ENDIF -IF (ALLOCATED(SrcMiscData%PointStateIsN)) THEN - i1_l = LBOUND(SrcMiscData%PointStateIsN,1) - i1_u = UBOUND(SrcMiscData%PointStateIsN,1) - IF (.NOT. ALLOCATED(DstMiscData%PointStateIsN)) THEN - ALLOCATE(DstMiscData%PointStateIsN(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%PointStateIsN.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%PointStateIsN = SrcMiscData%PointStateIsN -ENDIF -IF (ALLOCATED(SrcMiscData%RodStateIs1)) THEN - i1_l = LBOUND(SrcMiscData%RodStateIs1,1) - i1_u = UBOUND(SrcMiscData%RodStateIs1,1) - IF (.NOT. ALLOCATED(DstMiscData%RodStateIs1)) THEN - ALLOCATE(DstMiscData%RodStateIs1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%RodStateIs1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%RodStateIs1 = SrcMiscData%RodStateIs1 -ENDIF -IF (ALLOCATED(SrcMiscData%RodStateIsN)) THEN - i1_l = LBOUND(SrcMiscData%RodStateIsN,1) - i1_u = UBOUND(SrcMiscData%RodStateIsN,1) - IF (.NOT. ALLOCATED(DstMiscData%RodStateIsN)) THEN - ALLOCATE(DstMiscData%RodStateIsN(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%RodStateIsN.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%RodStateIsN = SrcMiscData%RodStateIsN -ENDIF -IF (ALLOCATED(SrcMiscData%BodyStateIs1)) THEN - i1_l = LBOUND(SrcMiscData%BodyStateIs1,1) - i1_u = UBOUND(SrcMiscData%BodyStateIs1,1) - IF (.NOT. ALLOCATED(DstMiscData%BodyStateIs1)) THEN - ALLOCATE(DstMiscData%BodyStateIs1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BodyStateIs1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%BodyStateIs1 = SrcMiscData%BodyStateIs1 -ENDIF -IF (ALLOCATED(SrcMiscData%BodyStateIsN)) THEN - i1_l = LBOUND(SrcMiscData%BodyStateIsN,1) - i1_u = UBOUND(SrcMiscData%BodyStateIsN,1) - IF (.NOT. ALLOCATED(DstMiscData%BodyStateIsN)) THEN - ALLOCATE(DstMiscData%BodyStateIsN(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BodyStateIsN.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%BodyStateIsN = SrcMiscData%BodyStateIsN -ENDIF - DstMiscData%Nx = SrcMiscData%Nx - DstMiscData%WaveTi = SrcMiscData%WaveTi - CALL MD_CopyContState( SrcMiscData%xTemp, DstMiscData%xTemp, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MD_CopyContState( SrcMiscData%xdTemp, DstMiscData%xdTemp, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstMiscData%zeros6 = SrcMiscData%zeros6 -IF (ALLOCATED(SrcMiscData%MDWrOutput)) THEN - i1_l = LBOUND(SrcMiscData%MDWrOutput,1) - i1_u = UBOUND(SrcMiscData%MDWrOutput,1) - IF (.NOT. ALLOCATED(DstMiscData%MDWrOutput)) THEN - ALLOCATE(DstMiscData%MDWrOutput(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%MDWrOutput.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%MDWrOutput = SrcMiscData%MDWrOutput -ENDIF - DstMiscData%LastOutTime = SrcMiscData%LastOutTime - DstMiscData%PtfmInit = SrcMiscData%PtfmInit -IF (ALLOCATED(SrcMiscData%BathymetryGrid)) THEN - i1_l = LBOUND(SrcMiscData%BathymetryGrid,1) - i1_u = UBOUND(SrcMiscData%BathymetryGrid,1) - i2_l = LBOUND(SrcMiscData%BathymetryGrid,2) - i2_u = UBOUND(SrcMiscData%BathymetryGrid,2) - IF (.NOT. ALLOCATED(DstMiscData%BathymetryGrid)) THEN - ALLOCATE(DstMiscData%BathymetryGrid(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BathymetryGrid.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%BathymetryGrid = SrcMiscData%BathymetryGrid -ENDIF -IF (ALLOCATED(SrcMiscData%BathGrid_Xs)) THEN - i1_l = LBOUND(SrcMiscData%BathGrid_Xs,1) - i1_u = UBOUND(SrcMiscData%BathGrid_Xs,1) - IF (.NOT. ALLOCATED(DstMiscData%BathGrid_Xs)) THEN - ALLOCATE(DstMiscData%BathGrid_Xs(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BathGrid_Xs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%BathGrid_Xs = SrcMiscData%BathGrid_Xs -ENDIF -IF (ALLOCATED(SrcMiscData%BathGrid_Ys)) THEN - i1_l = LBOUND(SrcMiscData%BathGrid_Ys,1) - i1_u = UBOUND(SrcMiscData%BathGrid_Ys,1) - IF (.NOT. ALLOCATED(DstMiscData%BathGrid_Ys)) THEN - ALLOCATE(DstMiscData%BathGrid_Ys(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BathGrid_Ys.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%BathGrid_Ys = SrcMiscData%BathGrid_Ys -ENDIF -IF (ALLOCATED(SrcMiscData%BathGrid_npoints)) THEN - i1_l = LBOUND(SrcMiscData%BathGrid_npoints,1) - i1_u = UBOUND(SrcMiscData%BathGrid_npoints,1) - IF (.NOT. ALLOCATED(DstMiscData%BathGrid_npoints)) THEN - ALLOCATE(DstMiscData%BathGrid_npoints(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BathGrid_npoints.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%BathGrid_npoints = SrcMiscData%BathGrid_npoints -ENDIF - END SUBROUTINE MD_CopyMisc - - SUBROUTINE MD_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(MD_MiscVarType), INTENT(INOUT) :: MiscData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_DestroyMisc' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(MiscData%LineTypeList)) THEN -DO i1 = LBOUND(MiscData%LineTypeList,1), UBOUND(MiscData%LineTypeList,1) - CALL MD_Destroylineprop( MiscData%LineTypeList(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MiscData%LineTypeList) -ENDIF -IF (ALLOCATED(MiscData%RodTypeList)) THEN -DO i1 = LBOUND(MiscData%RodTypeList,1), UBOUND(MiscData%RodTypeList,1) - CALL MD_Destroyrodprop( MiscData%RodTypeList(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MiscData%RodTypeList) -ENDIF - CALL MD_Destroybody( MiscData%GroundBody, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(MiscData%BodyList)) THEN -DO i1 = LBOUND(MiscData%BodyList,1), UBOUND(MiscData%BodyList,1) - CALL MD_Destroybody( MiscData%BodyList(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MiscData%BodyList) -ENDIF -IF (ALLOCATED(MiscData%RodList)) THEN -DO i1 = LBOUND(MiscData%RodList,1), UBOUND(MiscData%RodList,1) - CALL MD_Destroyrod( MiscData%RodList(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MiscData%RodList) -ENDIF -IF (ALLOCATED(MiscData%PointList)) THEN -DO i1 = LBOUND(MiscData%PointList,1), UBOUND(MiscData%PointList,1) - CALL MD_Destroypoint( MiscData%PointList(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MiscData%PointList) -ENDIF -IF (ALLOCATED(MiscData%LineList)) THEN -DO i1 = LBOUND(MiscData%LineList,1), UBOUND(MiscData%LineList,1) - CALL MD_Destroyline( MiscData%LineList(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MiscData%LineList) -ENDIF -IF (ALLOCATED(MiscData%FailList)) THEN -DO i1 = LBOUND(MiscData%FailList,1), UBOUND(MiscData%FailList,1) - CALL MD_Destroyfail( MiscData%FailList(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MiscData%FailList) -ENDIF -IF (ALLOCATED(MiscData%FreePointIs)) THEN - DEALLOCATE(MiscData%FreePointIs) -ENDIF -IF (ALLOCATED(MiscData%CpldPointIs)) THEN - DEALLOCATE(MiscData%CpldPointIs) -ENDIF -IF (ALLOCATED(MiscData%FreeRodIs)) THEN - DEALLOCATE(MiscData%FreeRodIs) -ENDIF -IF (ALLOCATED(MiscData%CpldRodIs)) THEN - DEALLOCATE(MiscData%CpldRodIs) -ENDIF -IF (ALLOCATED(MiscData%FreeBodyIs)) THEN - DEALLOCATE(MiscData%FreeBodyIs) -ENDIF -IF (ALLOCATED(MiscData%CpldBodyIs)) THEN - DEALLOCATE(MiscData%CpldBodyIs) -ENDIF -IF (ALLOCATED(MiscData%LineStateIs1)) THEN - DEALLOCATE(MiscData%LineStateIs1) -ENDIF -IF (ALLOCATED(MiscData%LineStateIsN)) THEN - DEALLOCATE(MiscData%LineStateIsN) -ENDIF -IF (ALLOCATED(MiscData%PointStateIs1)) THEN - DEALLOCATE(MiscData%PointStateIs1) -ENDIF -IF (ALLOCATED(MiscData%PointStateIsN)) THEN - DEALLOCATE(MiscData%PointStateIsN) -ENDIF -IF (ALLOCATED(MiscData%RodStateIs1)) THEN - DEALLOCATE(MiscData%RodStateIs1) -ENDIF -IF (ALLOCATED(MiscData%RodStateIsN)) THEN - DEALLOCATE(MiscData%RodStateIsN) -ENDIF -IF (ALLOCATED(MiscData%BodyStateIs1)) THEN - DEALLOCATE(MiscData%BodyStateIs1) -ENDIF -IF (ALLOCATED(MiscData%BodyStateIsN)) THEN - DEALLOCATE(MiscData%BodyStateIsN) -ENDIF - CALL MD_DestroyContState( MiscData%xTemp, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MD_DestroyContState( MiscData%xdTemp, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(MiscData%MDWrOutput)) THEN - DEALLOCATE(MiscData%MDWrOutput) -ENDIF -IF (ALLOCATED(MiscData%BathymetryGrid)) THEN - DEALLOCATE(MiscData%BathymetryGrid) -ENDIF -IF (ALLOCATED(MiscData%BathGrid_Xs)) THEN - DEALLOCATE(MiscData%BathGrid_Xs) -ENDIF -IF (ALLOCATED(MiscData%BathGrid_Ys)) THEN - DEALLOCATE(MiscData%BathGrid_Ys) -ENDIF -IF (ALLOCATED(MiscData%BathGrid_npoints)) THEN - DEALLOCATE(MiscData%BathGrid_npoints) -ENDIF - END SUBROUTINE MD_DestroyMisc - - SUBROUTINE MD_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(MD_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 = 'MD_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 ! LineTypeList allocated yes/no - IF ( ALLOCATED(InData%LineTypeList) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LineTypeList upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%LineTypeList,1), UBOUND(InData%LineTypeList,1) - Int_BufSz = Int_BufSz + 3 ! LineTypeList: size of buffers for each call to pack subtype - CALL MD_Packlineprop( Re_Buf, Db_Buf, Int_Buf, InData%LineTypeList(i1), ErrStat2, ErrMsg2, .TRUE. ) ! LineTypeList - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! LineTypeList - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! LineTypeList - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! LineTypeList - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! RodTypeList allocated yes/no - IF ( ALLOCATED(InData%RodTypeList) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! RodTypeList upper/lower bounds for each dimension - DO i1 = LBOUND(InData%RodTypeList,1), UBOUND(InData%RodTypeList,1) - Int_BufSz = Int_BufSz + 3 ! RodTypeList: size of buffers for each call to pack subtype - CALL MD_Packrodprop( Re_Buf, Db_Buf, Int_Buf, InData%RodTypeList(i1), ErrStat2, ErrMsg2, .TRUE. ) ! RodTypeList - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! RodTypeList - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! RodTypeList - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! RodTypeList - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! GroundBody: size of buffers for each call to pack subtype - CALL MD_Packbody( Re_Buf, Db_Buf, Int_Buf, InData%GroundBody, ErrStat2, ErrMsg2, .TRUE. ) ! GroundBody - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! GroundBody - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! GroundBody - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! GroundBody - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! BodyList allocated yes/no - IF ( ALLOCATED(InData%BodyList) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BodyList upper/lower bounds for each dimension - DO i1 = LBOUND(InData%BodyList,1), UBOUND(InData%BodyList,1) - Int_BufSz = Int_BufSz + 3 ! BodyList: size of buffers for each call to pack subtype - CALL MD_Packbody( Re_Buf, Db_Buf, Int_Buf, InData%BodyList(i1), ErrStat2, ErrMsg2, .TRUE. ) ! BodyList - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BodyList - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BodyList - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BodyList - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! RodList allocated yes/no - IF ( ALLOCATED(InData%RodList) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! RodList upper/lower bounds for each dimension - DO i1 = LBOUND(InData%RodList,1), UBOUND(InData%RodList,1) - Int_BufSz = Int_BufSz + 3 ! RodList: size of buffers for each call to pack subtype - CALL MD_Packrod( Re_Buf, Db_Buf, Int_Buf, InData%RodList(i1), ErrStat2, ErrMsg2, .TRUE. ) ! RodList - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! RodList - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! RodList - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! RodList - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! PointList allocated yes/no - IF ( ALLOCATED(InData%PointList) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PointList upper/lower bounds for each dimension - DO i1 = LBOUND(InData%PointList,1), UBOUND(InData%PointList,1) - Int_BufSz = Int_BufSz + 3 ! PointList: size of buffers for each call to pack subtype - CALL MD_Packpoint( Re_Buf, Db_Buf, Int_Buf, InData%PointList(i1), ErrStat2, ErrMsg2, .TRUE. ) ! PointList - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! PointList - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! PointList - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! PointList - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! LineList allocated yes/no - IF ( ALLOCATED(InData%LineList) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LineList upper/lower bounds for each dimension - DO i1 = LBOUND(InData%LineList,1), UBOUND(InData%LineList,1) - Int_BufSz = Int_BufSz + 3 ! LineList: size of buffers for each call to pack subtype - CALL MD_Packline( Re_Buf, Db_Buf, Int_Buf, InData%LineList(i1), ErrStat2, ErrMsg2, .TRUE. ) ! LineList - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! LineList - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! LineList - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! LineList - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! FailList allocated yes/no - IF ( ALLOCATED(InData%FailList) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! FailList upper/lower bounds for each dimension - DO i1 = LBOUND(InData%FailList,1), UBOUND(InData%FailList,1) - Int_BufSz = Int_BufSz + 3 ! FailList: size of buffers for each call to pack subtype - CALL MD_Packfail( Re_Buf, Db_Buf, Int_Buf, InData%FailList(i1), ErrStat2, ErrMsg2, .TRUE. ) ! FailList - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! FailList - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! FailList - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! FailList - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! FreePointIs allocated yes/no - IF ( ALLOCATED(InData%FreePointIs) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! FreePointIs upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%FreePointIs) ! FreePointIs - END IF - Int_BufSz = Int_BufSz + 1 ! CpldPointIs allocated yes/no - IF ( ALLOCATED(InData%CpldPointIs) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! CpldPointIs upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%CpldPointIs) ! CpldPointIs - END IF - Int_BufSz = Int_BufSz + 1 ! FreeRodIs allocated yes/no - IF ( ALLOCATED(InData%FreeRodIs) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! FreeRodIs upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%FreeRodIs) ! FreeRodIs - END IF - Int_BufSz = Int_BufSz + 1 ! CpldRodIs allocated yes/no - IF ( ALLOCATED(InData%CpldRodIs) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! CpldRodIs upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%CpldRodIs) ! CpldRodIs - END IF - Int_BufSz = Int_BufSz + 1 ! FreeBodyIs allocated yes/no - IF ( ALLOCATED(InData%FreeBodyIs) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! FreeBodyIs upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%FreeBodyIs) ! FreeBodyIs - END IF - Int_BufSz = Int_BufSz + 1 ! CpldBodyIs allocated yes/no - IF ( ALLOCATED(InData%CpldBodyIs) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! CpldBodyIs upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%CpldBodyIs) ! CpldBodyIs - END IF - Int_BufSz = Int_BufSz + 1 ! LineStateIs1 allocated yes/no - IF ( ALLOCATED(InData%LineStateIs1) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LineStateIs1 upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%LineStateIs1) ! LineStateIs1 - END IF - Int_BufSz = Int_BufSz + 1 ! LineStateIsN allocated yes/no - IF ( ALLOCATED(InData%LineStateIsN) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LineStateIsN upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%LineStateIsN) ! LineStateIsN - END IF - Int_BufSz = Int_BufSz + 1 ! PointStateIs1 allocated yes/no - IF ( ALLOCATED(InData%PointStateIs1) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PointStateIs1 upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%PointStateIs1) ! PointStateIs1 - END IF - Int_BufSz = Int_BufSz + 1 ! PointStateIsN allocated yes/no - IF ( ALLOCATED(InData%PointStateIsN) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PointStateIsN upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%PointStateIsN) ! PointStateIsN - END IF - Int_BufSz = Int_BufSz + 1 ! RodStateIs1 allocated yes/no - IF ( ALLOCATED(InData%RodStateIs1) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! RodStateIs1 upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%RodStateIs1) ! RodStateIs1 - END IF - Int_BufSz = Int_BufSz + 1 ! RodStateIsN allocated yes/no - IF ( ALLOCATED(InData%RodStateIsN) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! RodStateIsN upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%RodStateIsN) ! RodStateIsN - END IF - Int_BufSz = Int_BufSz + 1 ! BodyStateIs1 allocated yes/no - IF ( ALLOCATED(InData%BodyStateIs1) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BodyStateIs1 upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%BodyStateIs1) ! BodyStateIs1 - END IF - Int_BufSz = Int_BufSz + 1 ! BodyStateIsN allocated yes/no - IF ( ALLOCATED(InData%BodyStateIsN) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BodyStateIsN upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%BodyStateIsN) ! BodyStateIsN - END IF - Int_BufSz = Int_BufSz + 1 ! Nx - Int_BufSz = Int_BufSz + 1 ! WaveTi - Int_BufSz = Int_BufSz + 3 ! xTemp: size of buffers for each call to pack subtype - CALL MD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%xTemp, ErrStat2, ErrMsg2, .TRUE. ) ! xTemp - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xTemp - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xTemp - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xTemp - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! xdTemp: size of buffers for each call to pack subtype - CALL MD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%xdTemp, ErrStat2, ErrMsg2, .TRUE. ) ! xdTemp - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xdTemp - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xdTemp - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xdTemp - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Db_BufSz = Db_BufSz + SIZE(InData%zeros6) ! zeros6 - Int_BufSz = Int_BufSz + 1 ! MDWrOutput allocated yes/no - IF ( ALLOCATED(InData%MDWrOutput) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! MDWrOutput upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%MDWrOutput) ! MDWrOutput - END IF - Db_BufSz = Db_BufSz + 1 ! LastOutTime - Re_BufSz = Re_BufSz + SIZE(InData%PtfmInit) ! PtfmInit - Int_BufSz = Int_BufSz + 1 ! BathymetryGrid allocated yes/no - IF ( ALLOCATED(InData%BathymetryGrid) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BathymetryGrid upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%BathymetryGrid) ! BathymetryGrid - END IF - Int_BufSz = Int_BufSz + 1 ! BathGrid_Xs allocated yes/no - IF ( ALLOCATED(InData%BathGrid_Xs) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BathGrid_Xs upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%BathGrid_Xs) ! BathGrid_Xs - END IF - Int_BufSz = Int_BufSz + 1 ! BathGrid_Ys allocated yes/no - IF ( ALLOCATED(InData%BathGrid_Ys) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BathGrid_Ys upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%BathGrid_Ys) ! BathGrid_Ys - END IF - Int_BufSz = Int_BufSz + 1 ! BathGrid_npoints allocated yes/no - IF ( ALLOCATED(InData%BathGrid_npoints) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BathGrid_npoints upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%BathGrid_npoints) ! BathGrid_npoints - 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%LineTypeList) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LineTypeList,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LineTypeList,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LineTypeList,1), UBOUND(InData%LineTypeList,1) - CALL MD_Packlineprop( Re_Buf, Db_Buf, Int_Buf, InData%LineTypeList(i1), ErrStat2, ErrMsg2, OnlySize ) ! LineTypeList - 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%RodTypeList) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RodTypeList,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RodTypeList,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%RodTypeList,1), UBOUND(InData%RodTypeList,1) - CALL MD_Packrodprop( Re_Buf, Db_Buf, Int_Buf, InData%RodTypeList(i1), ErrStat2, ErrMsg2, OnlySize ) ! RodTypeList - 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 - CALL MD_Packbody( Re_Buf, Db_Buf, Int_Buf, InData%GroundBody, ErrStat2, ErrMsg2, OnlySize ) ! GroundBody - 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%BodyList) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BodyList,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BodyList,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BodyList,1), UBOUND(InData%BodyList,1) - CALL MD_Packbody( Re_Buf, Db_Buf, Int_Buf, InData%BodyList(i1), ErrStat2, ErrMsg2, OnlySize ) ! BodyList - 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%RodList) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RodList,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RodList,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%RodList,1), UBOUND(InData%RodList,1) - CALL MD_Packrod( Re_Buf, Db_Buf, Int_Buf, InData%RodList(i1), ErrStat2, ErrMsg2, OnlySize ) ! RodList - 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%PointList) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PointList,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PointList,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PointList,1), UBOUND(InData%PointList,1) - CALL MD_Packpoint( Re_Buf, Db_Buf, Int_Buf, InData%PointList(i1), ErrStat2, ErrMsg2, OnlySize ) ! PointList - 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%LineList) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LineList,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LineList,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LineList,1), UBOUND(InData%LineList,1) - CALL MD_Packline( Re_Buf, Db_Buf, Int_Buf, InData%LineList(i1), ErrStat2, ErrMsg2, OnlySize ) ! LineList - 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%FailList) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FailList,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FailList,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%FailList,1), UBOUND(InData%FailList,1) - CALL MD_Packfail( Re_Buf, Db_Buf, Int_Buf, InData%FailList(i1), ErrStat2, ErrMsg2, OnlySize ) ! FailList - 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%FreePointIs) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FreePointIs,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FreePointIs,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%FreePointIs,1), UBOUND(InData%FreePointIs,1) - IntKiBuf(Int_Xferred) = InData%FreePointIs(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CpldPointIs) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CpldPointIs,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CpldPointIs,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CpldPointIs,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CpldPointIs,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%CpldPointIs,2), UBOUND(InData%CpldPointIs,2) - DO i1 = LBOUND(InData%CpldPointIs,1), UBOUND(InData%CpldPointIs,1) - IntKiBuf(Int_Xferred) = InData%CpldPointIs(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%FreeRodIs) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FreeRodIs,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FreeRodIs,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%FreeRodIs,1), UBOUND(InData%FreeRodIs,1) - IntKiBuf(Int_Xferred) = InData%FreeRodIs(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CpldRodIs) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CpldRodIs,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CpldRodIs,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CpldRodIs,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CpldRodIs,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%CpldRodIs,2), UBOUND(InData%CpldRodIs,2) - DO i1 = LBOUND(InData%CpldRodIs,1), UBOUND(InData%CpldRodIs,1) - IntKiBuf(Int_Xferred) = InData%CpldRodIs(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%FreeBodyIs) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FreeBodyIs,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FreeBodyIs,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%FreeBodyIs,1), UBOUND(InData%FreeBodyIs,1) - IntKiBuf(Int_Xferred) = InData%FreeBodyIs(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CpldBodyIs) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CpldBodyIs,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CpldBodyIs,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CpldBodyIs,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CpldBodyIs,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%CpldBodyIs,2), UBOUND(InData%CpldBodyIs,2) - DO i1 = LBOUND(InData%CpldBodyIs,1), UBOUND(InData%CpldBodyIs,1) - IntKiBuf(Int_Xferred) = InData%CpldBodyIs(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LineStateIs1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LineStateIs1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LineStateIs1,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LineStateIs1,1), UBOUND(InData%LineStateIs1,1) - IntKiBuf(Int_Xferred) = InData%LineStateIs1(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LineStateIsN) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LineStateIsN,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LineStateIsN,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LineStateIsN,1), UBOUND(InData%LineStateIsN,1) - IntKiBuf(Int_Xferred) = InData%LineStateIsN(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PointStateIs1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PointStateIs1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PointStateIs1,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PointStateIs1,1), UBOUND(InData%PointStateIs1,1) - IntKiBuf(Int_Xferred) = InData%PointStateIs1(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PointStateIsN) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PointStateIsN,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PointStateIsN,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PointStateIsN,1), UBOUND(InData%PointStateIsN,1) - IntKiBuf(Int_Xferred) = InData%PointStateIsN(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%RodStateIs1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RodStateIs1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RodStateIs1,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%RodStateIs1,1), UBOUND(InData%RodStateIs1,1) - IntKiBuf(Int_Xferred) = InData%RodStateIs1(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%RodStateIsN) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RodStateIsN,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RodStateIsN,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%RodStateIsN,1), UBOUND(InData%RodStateIsN,1) - IntKiBuf(Int_Xferred) = InData%RodStateIsN(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BodyStateIs1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BodyStateIs1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BodyStateIs1,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BodyStateIs1,1), UBOUND(InData%BodyStateIs1,1) - IntKiBuf(Int_Xferred) = InData%BodyStateIs1(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BodyStateIsN) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BodyStateIsN,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BodyStateIsN,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BodyStateIsN,1), UBOUND(InData%BodyStateIsN,1) - IntKiBuf(Int_Xferred) = InData%BodyStateIsN(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%Nx - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%WaveTi - Int_Xferred = Int_Xferred + 1 - CALL MD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%xTemp, ErrStat2, ErrMsg2, OnlySize ) ! xTemp - 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 MD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%xdTemp, ErrStat2, ErrMsg2, OnlySize ) ! xdTemp - 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 i1 = LBOUND(InData%zeros6,1), UBOUND(InData%zeros6,1) - DbKiBuf(Db_Xferred) = InData%zeros6(i1) - Db_Xferred = Db_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%MDWrOutput) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MDWrOutput,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MDWrOutput,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%MDWrOutput,1), UBOUND(InData%MDWrOutput,1) - DbKiBuf(Db_Xferred) = InData%MDWrOutput(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - DbKiBuf(Db_Xferred) = InData%LastOutTime - Db_Xferred = Db_Xferred + 1 - DO i1 = LBOUND(InData%PtfmInit,1), UBOUND(InData%PtfmInit,1) - ReKiBuf(Re_Xferred) = InData%PtfmInit(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%BathymetryGrid) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BathymetryGrid,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BathymetryGrid,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BathymetryGrid,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BathymetryGrid,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%BathymetryGrid,2), UBOUND(InData%BathymetryGrid,2) - DO i1 = LBOUND(InData%BathymetryGrid,1), UBOUND(InData%BathymetryGrid,1) - DbKiBuf(Db_Xferred) = InData%BathymetryGrid(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BathGrid_Xs) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BathGrid_Xs,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BathGrid_Xs,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BathGrid_Xs,1), UBOUND(InData%BathGrid_Xs,1) - DbKiBuf(Db_Xferred) = InData%BathGrid_Xs(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BathGrid_Ys) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BathGrid_Ys,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BathGrid_Ys,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BathGrid_Ys,1), UBOUND(InData%BathGrid_Ys,1) - DbKiBuf(Db_Xferred) = InData%BathGrid_Ys(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BathGrid_npoints) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BathGrid_npoints,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BathGrid_npoints,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BathGrid_npoints,1), UBOUND(InData%BathGrid_npoints,1) - IntKiBuf(Int_Xferred) = InData%BathGrid_npoints(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - END SUBROUTINE MD_PackMisc - - SUBROUTINE MD_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(MD_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 = 'MD_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 ! LineTypeList not allocated - Int_Xferred = Int_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%LineTypeList)) DEALLOCATE(OutData%LineTypeList) - ALLOCATE(OutData%LineTypeList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LineTypeList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LineTypeList,1), UBOUND(OutData%LineTypeList,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 MD_Unpacklineprop( Re_Buf, Db_Buf, Int_Buf, OutData%LineTypeList(i1), ErrStat2, ErrMsg2 ) ! LineTypeList - 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 ! RodTypeList not allocated - Int_Xferred = Int_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%RodTypeList)) DEALLOCATE(OutData%RodTypeList) - ALLOCATE(OutData%RodTypeList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RodTypeList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%RodTypeList,1), UBOUND(OutData%RodTypeList,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 MD_Unpackrodprop( Re_Buf, Db_Buf, Int_Buf, OutData%RodTypeList(i1), ErrStat2, ErrMsg2 ) ! RodTypeList - 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 - 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 MD_Unpackbody( Re_Buf, Db_Buf, Int_Buf, OutData%GroundBody, ErrStat2, ErrMsg2 ) ! GroundBody - 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 ! BodyList not allocated - Int_Xferred = Int_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%BodyList)) DEALLOCATE(OutData%BodyList) - ALLOCATE(OutData%BodyList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BodyList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BodyList,1), UBOUND(OutData%BodyList,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 MD_Unpackbody( Re_Buf, Db_Buf, Int_Buf, OutData%BodyList(i1), ErrStat2, ErrMsg2 ) ! BodyList - 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 ! RodList not allocated - Int_Xferred = Int_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%RodList)) DEALLOCATE(OutData%RodList) - ALLOCATE(OutData%RodList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RodList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%RodList,1), UBOUND(OutData%RodList,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 MD_Unpackrod( Re_Buf, Db_Buf, Int_Buf, OutData%RodList(i1), ErrStat2, ErrMsg2 ) ! RodList - 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 ! PointList not allocated - Int_Xferred = Int_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%PointList)) DEALLOCATE(OutData%PointList) - ALLOCATE(OutData%PointList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PointList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PointList,1), UBOUND(OutData%PointList,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 MD_Unpackpoint( Re_Buf, Db_Buf, Int_Buf, OutData%PointList(i1), ErrStat2, ErrMsg2 ) ! PointList - 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 ! LineList not allocated - Int_Xferred = Int_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%LineList)) DEALLOCATE(OutData%LineList) - ALLOCATE(OutData%LineList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LineList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LineList,1), UBOUND(OutData%LineList,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 MD_Unpackline( Re_Buf, Db_Buf, Int_Buf, OutData%LineList(i1), ErrStat2, ErrMsg2 ) ! LineList - 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 ! FailList not allocated - Int_Xferred = Int_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%FailList)) DEALLOCATE(OutData%FailList) - ALLOCATE(OutData%FailList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FailList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%FailList,1), UBOUND(OutData%FailList,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 MD_Unpackfail( Re_Buf, Db_Buf, Int_Buf, OutData%FailList(i1), ErrStat2, ErrMsg2 ) ! FailList - 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 ! FreePointIs not allocated - Int_Xferred = Int_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%FreePointIs)) DEALLOCATE(OutData%FreePointIs) - ALLOCATE(OutData%FreePointIs(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FreePointIs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%FreePointIs,1), UBOUND(OutData%FreePointIs,1) - OutData%FreePointIs(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CpldPointIs not allocated - Int_Xferred = Int_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%CpldPointIs)) DEALLOCATE(OutData%CpldPointIs) - ALLOCATE(OutData%CpldPointIs(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CpldPointIs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%CpldPointIs,2), UBOUND(OutData%CpldPointIs,2) - DO i1 = LBOUND(OutData%CpldPointIs,1), UBOUND(OutData%CpldPointIs,1) - OutData%CpldPointIs(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FreeRodIs not allocated - Int_Xferred = Int_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%FreeRodIs)) DEALLOCATE(OutData%FreeRodIs) - ALLOCATE(OutData%FreeRodIs(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FreeRodIs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%FreeRodIs,1), UBOUND(OutData%FreeRodIs,1) - OutData%FreeRodIs(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CpldRodIs not allocated - Int_Xferred = Int_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%CpldRodIs)) DEALLOCATE(OutData%CpldRodIs) - ALLOCATE(OutData%CpldRodIs(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CpldRodIs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%CpldRodIs,2), UBOUND(OutData%CpldRodIs,2) - DO i1 = LBOUND(OutData%CpldRodIs,1), UBOUND(OutData%CpldRodIs,1) - OutData%CpldRodIs(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FreeBodyIs not allocated - Int_Xferred = Int_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%FreeBodyIs)) DEALLOCATE(OutData%FreeBodyIs) - ALLOCATE(OutData%FreeBodyIs(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FreeBodyIs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%FreeBodyIs,1), UBOUND(OutData%FreeBodyIs,1) - OutData%FreeBodyIs(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CpldBodyIs not allocated - Int_Xferred = Int_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%CpldBodyIs)) DEALLOCATE(OutData%CpldBodyIs) - ALLOCATE(OutData%CpldBodyIs(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CpldBodyIs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%CpldBodyIs,2), UBOUND(OutData%CpldBodyIs,2) - DO i1 = LBOUND(OutData%CpldBodyIs,1), UBOUND(OutData%CpldBodyIs,1) - OutData%CpldBodyIs(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LineStateIs1 not allocated - Int_Xferred = Int_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%LineStateIs1)) DEALLOCATE(OutData%LineStateIs1) - ALLOCATE(OutData%LineStateIs1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LineStateIs1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LineStateIs1,1), UBOUND(OutData%LineStateIs1,1) - OutData%LineStateIs1(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LineStateIsN not allocated - Int_Xferred = Int_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%LineStateIsN)) DEALLOCATE(OutData%LineStateIsN) - ALLOCATE(OutData%LineStateIsN(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LineStateIsN.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LineStateIsN,1), UBOUND(OutData%LineStateIsN,1) - OutData%LineStateIsN(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PointStateIs1 not allocated - Int_Xferred = Int_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%PointStateIs1)) DEALLOCATE(OutData%PointStateIs1) - ALLOCATE(OutData%PointStateIs1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PointStateIs1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PointStateIs1,1), UBOUND(OutData%PointStateIs1,1) - OutData%PointStateIs1(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PointStateIsN not allocated - Int_Xferred = Int_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%PointStateIsN)) DEALLOCATE(OutData%PointStateIsN) - ALLOCATE(OutData%PointStateIsN(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PointStateIsN.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PointStateIsN,1), UBOUND(OutData%PointStateIsN,1) - OutData%PointStateIsN(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RodStateIs1 not allocated - Int_Xferred = Int_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%RodStateIs1)) DEALLOCATE(OutData%RodStateIs1) - ALLOCATE(OutData%RodStateIs1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RodStateIs1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%RodStateIs1,1), UBOUND(OutData%RodStateIs1,1) - OutData%RodStateIs1(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RodStateIsN not allocated - Int_Xferred = Int_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%RodStateIsN)) DEALLOCATE(OutData%RodStateIsN) - ALLOCATE(OutData%RodStateIsN(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RodStateIsN.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%RodStateIsN,1), UBOUND(OutData%RodStateIsN,1) - OutData%RodStateIsN(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BodyStateIs1 not allocated - Int_Xferred = Int_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%BodyStateIs1)) DEALLOCATE(OutData%BodyStateIs1) - ALLOCATE(OutData%BodyStateIs1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BodyStateIs1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BodyStateIs1,1), UBOUND(OutData%BodyStateIs1,1) - OutData%BodyStateIs1(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BodyStateIsN not allocated - Int_Xferred = Int_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%BodyStateIsN)) DEALLOCATE(OutData%BodyStateIsN) - ALLOCATE(OutData%BodyStateIsN(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BodyStateIsN.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BodyStateIsN,1), UBOUND(OutData%BodyStateIsN,1) - OutData%BodyStateIsN(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - OutData%Nx = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WaveTi = IntKiBuf(Int_Xferred) - 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 MD_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%xTemp, ErrStat2, ErrMsg2 ) ! xTemp - 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 MD_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%xdTemp, ErrStat2, ErrMsg2 ) ! xdTemp - 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) - i1_l = LBOUND(OutData%zeros6,1) - i1_u = UBOUND(OutData%zeros6,1) - DO i1 = LBOUND(OutData%zeros6,1), UBOUND(OutData%zeros6,1) - OutData%zeros6(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MDWrOutput not allocated - Int_Xferred = Int_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%MDWrOutput)) DEALLOCATE(OutData%MDWrOutput) - ALLOCATE(OutData%MDWrOutput(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MDWrOutput.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%MDWrOutput,1), UBOUND(OutData%MDWrOutput,1) - OutData%MDWrOutput(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - OutData%LastOutTime = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - i1_l = LBOUND(OutData%PtfmInit,1) - i1_u = UBOUND(OutData%PtfmInit,1) - DO i1 = LBOUND(OutData%PtfmInit,1), UBOUND(OutData%PtfmInit,1) - OutData%PtfmInit(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BathymetryGrid not allocated - Int_Xferred = Int_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%BathymetryGrid)) DEALLOCATE(OutData%BathymetryGrid) - ALLOCATE(OutData%BathymetryGrid(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BathymetryGrid.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%BathymetryGrid,2), UBOUND(OutData%BathymetryGrid,2) - DO i1 = LBOUND(OutData%BathymetryGrid,1), UBOUND(OutData%BathymetryGrid,1) - OutData%BathymetryGrid(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BathGrid_Xs not allocated - Int_Xferred = Int_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%BathGrid_Xs)) DEALLOCATE(OutData%BathGrid_Xs) - ALLOCATE(OutData%BathGrid_Xs(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BathGrid_Xs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BathGrid_Xs,1), UBOUND(OutData%BathGrid_Xs,1) - OutData%BathGrid_Xs(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BathGrid_Ys not allocated - Int_Xferred = Int_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%BathGrid_Ys)) DEALLOCATE(OutData%BathGrid_Ys) - ALLOCATE(OutData%BathGrid_Ys(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BathGrid_Ys.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BathGrid_Ys,1), UBOUND(OutData%BathGrid_Ys,1) - OutData%BathGrid_Ys(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BathGrid_npoints not allocated - Int_Xferred = Int_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%BathGrid_npoints)) DEALLOCATE(OutData%BathGrid_npoints) - ALLOCATE(OutData%BathGrid_npoints(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BathGrid_npoints.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BathGrid_npoints,1), UBOUND(OutData%BathGrid_npoints,1) - OutData%BathGrid_npoints(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - END SUBROUTINE MD_UnPackMisc - - SUBROUTINE MD_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MD_ParameterType), INTENT(IN) :: SrcParamData - TYPE(MD_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) :: 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 = 'MD_CopyParam' -! - ErrStat = ErrID_None - ErrMsg = "" - DstParamData%nLineTypes = SrcParamData%nLineTypes - DstParamData%nRodTypes = SrcParamData%nRodTypes - DstParamData%nPoints = SrcParamData%nPoints - DstParamData%nPointsExtra = SrcParamData%nPointsExtra - DstParamData%nBodies = SrcParamData%nBodies - DstParamData%nRods = SrcParamData%nRods - DstParamData%nLines = SrcParamData%nLines - DstParamData%nCtrlChans = SrcParamData%nCtrlChans - DstParamData%nFails = SrcParamData%nFails - DstParamData%nFreeBodies = SrcParamData%nFreeBodies - DstParamData%nFreeRods = SrcParamData%nFreeRods - DstParamData%nFreePoints = SrcParamData%nFreePoints -IF (ALLOCATED(SrcParamData%nCpldBodies)) THEN - i1_l = LBOUND(SrcParamData%nCpldBodies,1) - i1_u = UBOUND(SrcParamData%nCpldBodies,1) - IF (.NOT. ALLOCATED(DstParamData%nCpldBodies)) THEN - ALLOCATE(DstParamData%nCpldBodies(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%nCpldBodies.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%nCpldBodies = SrcParamData%nCpldBodies -ENDIF -IF (ALLOCATED(SrcParamData%nCpldRods)) THEN - i1_l = LBOUND(SrcParamData%nCpldRods,1) - i1_u = UBOUND(SrcParamData%nCpldRods,1) - IF (.NOT. ALLOCATED(DstParamData%nCpldRods)) THEN - ALLOCATE(DstParamData%nCpldRods(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%nCpldRods.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%nCpldRods = SrcParamData%nCpldRods -ENDIF -IF (ALLOCATED(SrcParamData%nCpldPoints)) THEN - i1_l = LBOUND(SrcParamData%nCpldPoints,1) - i1_u = UBOUND(SrcParamData%nCpldPoints,1) - IF (.NOT. ALLOCATED(DstParamData%nCpldPoints)) THEN - ALLOCATE(DstParamData%nCpldPoints(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%nCpldPoints.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%nCpldPoints = SrcParamData%nCpldPoints -ENDIF - DstParamData%NConns = SrcParamData%NConns - DstParamData%NAnchs = SrcParamData%NAnchs - DstParamData%Tmax = SrcParamData%Tmax - DstParamData%g = SrcParamData%g - DstParamData%rhoW = SrcParamData%rhoW - DstParamData%WtrDpth = SrcParamData%WtrDpth - DstParamData%kBot = SrcParamData%kBot - DstParamData%cBot = SrcParamData%cBot - DstParamData%dtM0 = SrcParamData%dtM0 - DstParamData%dtCoupling = SrcParamData%dtCoupling - DstParamData%NumOuts = SrcParamData%NumOuts - DstParamData%dtOut = SrcParamData%dtOut - 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 MD_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%MDUnOut = SrcParamData%MDUnOut - DstParamData%PriPath = SrcParamData%PriPath - DstParamData%writeLog = SrcParamData%writeLog - DstParamData%UnLog = SrcParamData%UnLog - DstParamData%WaveKin = SrcParamData%WaveKin - DstParamData%Current = SrcParamData%Current - DstParamData%nTurbines = SrcParamData%nTurbines -IF (ALLOCATED(SrcParamData%TurbineRefPos)) THEN - i1_l = LBOUND(SrcParamData%TurbineRefPos,1) - i1_u = UBOUND(SrcParamData%TurbineRefPos,1) - i2_l = LBOUND(SrcParamData%TurbineRefPos,2) - i2_u = UBOUND(SrcParamData%TurbineRefPos,2) - IF (.NOT. ALLOCATED(DstParamData%TurbineRefPos)) THEN - ALLOCATE(DstParamData%TurbineRefPos(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TurbineRefPos.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%TurbineRefPos = SrcParamData%TurbineRefPos -ENDIF - DstParamData%mu_kT = SrcParamData%mu_kT - DstParamData%mu_kA = SrcParamData%mu_kA - DstParamData%mc = SrcParamData%mc - DstParamData%cv = SrcParamData%cv - DstParamData%nxWave = SrcParamData%nxWave - DstParamData%nyWave = SrcParamData%nyWave - DstParamData%nzWave = SrcParamData%nzWave - DstParamData%ntWave = SrcParamData%ntWave -IF (ALLOCATED(SrcParamData%pxWave)) THEN - i1_l = LBOUND(SrcParamData%pxWave,1) - i1_u = UBOUND(SrcParamData%pxWave,1) - IF (.NOT. ALLOCATED(DstParamData%pxWave)) THEN - ALLOCATE(DstParamData%pxWave(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%pxWave.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%pxWave = SrcParamData%pxWave -ENDIF -IF (ALLOCATED(SrcParamData%pyWave)) THEN - i1_l = LBOUND(SrcParamData%pyWave,1) - i1_u = UBOUND(SrcParamData%pyWave,1) - IF (.NOT. ALLOCATED(DstParamData%pyWave)) THEN - ALLOCATE(DstParamData%pyWave(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%pyWave.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%pyWave = SrcParamData%pyWave -ENDIF -IF (ALLOCATED(SrcParamData%pzWave)) THEN - i1_l = LBOUND(SrcParamData%pzWave,1) - i1_u = UBOUND(SrcParamData%pzWave,1) - IF (.NOT. ALLOCATED(DstParamData%pzWave)) THEN - ALLOCATE(DstParamData%pzWave(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%pzWave.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%pzWave = SrcParamData%pzWave -ENDIF - DstParamData%dtWave = SrcParamData%dtWave -IF (ALLOCATED(SrcParamData%uxWave)) THEN - i1_l = LBOUND(SrcParamData%uxWave,1) - i1_u = UBOUND(SrcParamData%uxWave,1) - i2_l = LBOUND(SrcParamData%uxWave,2) - i2_u = UBOUND(SrcParamData%uxWave,2) - i3_l = LBOUND(SrcParamData%uxWave,3) - i3_u = UBOUND(SrcParamData%uxWave,3) - i4_l = LBOUND(SrcParamData%uxWave,4) - i4_u = UBOUND(SrcParamData%uxWave,4) - IF (.NOT. ALLOCATED(DstParamData%uxWave)) THEN - ALLOCATE(DstParamData%uxWave(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 DstParamData%uxWave.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%uxWave = SrcParamData%uxWave -ENDIF -IF (ALLOCATED(SrcParamData%uyWave)) THEN - i1_l = LBOUND(SrcParamData%uyWave,1) - i1_u = UBOUND(SrcParamData%uyWave,1) - i2_l = LBOUND(SrcParamData%uyWave,2) - i2_u = UBOUND(SrcParamData%uyWave,2) - i3_l = LBOUND(SrcParamData%uyWave,3) - i3_u = UBOUND(SrcParamData%uyWave,3) - i4_l = LBOUND(SrcParamData%uyWave,4) - i4_u = UBOUND(SrcParamData%uyWave,4) - IF (.NOT. ALLOCATED(DstParamData%uyWave)) THEN - ALLOCATE(DstParamData%uyWave(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 DstParamData%uyWave.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%uyWave = SrcParamData%uyWave -ENDIF -IF (ALLOCATED(SrcParamData%uzWave)) THEN - i1_l = LBOUND(SrcParamData%uzWave,1) - i1_u = UBOUND(SrcParamData%uzWave,1) - i2_l = LBOUND(SrcParamData%uzWave,2) - i2_u = UBOUND(SrcParamData%uzWave,2) - i3_l = LBOUND(SrcParamData%uzWave,3) - i3_u = UBOUND(SrcParamData%uzWave,3) - i4_l = LBOUND(SrcParamData%uzWave,4) - i4_u = UBOUND(SrcParamData%uzWave,4) - IF (.NOT. ALLOCATED(DstParamData%uzWave)) THEN - ALLOCATE(DstParamData%uzWave(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 DstParamData%uzWave.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%uzWave = SrcParamData%uzWave -ENDIF -IF (ALLOCATED(SrcParamData%axWave)) THEN - i1_l = LBOUND(SrcParamData%axWave,1) - i1_u = UBOUND(SrcParamData%axWave,1) - i2_l = LBOUND(SrcParamData%axWave,2) - i2_u = UBOUND(SrcParamData%axWave,2) - i3_l = LBOUND(SrcParamData%axWave,3) - i3_u = UBOUND(SrcParamData%axWave,3) - i4_l = LBOUND(SrcParamData%axWave,4) - i4_u = UBOUND(SrcParamData%axWave,4) - IF (.NOT. ALLOCATED(DstParamData%axWave)) THEN - ALLOCATE(DstParamData%axWave(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 DstParamData%axWave.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%axWave = SrcParamData%axWave -ENDIF -IF (ALLOCATED(SrcParamData%ayWave)) THEN - i1_l = LBOUND(SrcParamData%ayWave,1) - i1_u = UBOUND(SrcParamData%ayWave,1) - i2_l = LBOUND(SrcParamData%ayWave,2) - i2_u = UBOUND(SrcParamData%ayWave,2) - i3_l = LBOUND(SrcParamData%ayWave,3) - i3_u = UBOUND(SrcParamData%ayWave,3) - i4_l = LBOUND(SrcParamData%ayWave,4) - i4_u = UBOUND(SrcParamData%ayWave,4) - IF (.NOT. ALLOCATED(DstParamData%ayWave)) THEN - ALLOCATE(DstParamData%ayWave(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 DstParamData%ayWave.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%ayWave = SrcParamData%ayWave -ENDIF -IF (ALLOCATED(SrcParamData%azWave)) THEN - i1_l = LBOUND(SrcParamData%azWave,1) - i1_u = UBOUND(SrcParamData%azWave,1) - i2_l = LBOUND(SrcParamData%azWave,2) - i2_u = UBOUND(SrcParamData%azWave,2) - i3_l = LBOUND(SrcParamData%azWave,3) - i3_u = UBOUND(SrcParamData%azWave,3) - i4_l = LBOUND(SrcParamData%azWave,4) - i4_u = UBOUND(SrcParamData%azWave,4) - IF (.NOT. ALLOCATED(DstParamData%azWave)) THEN - ALLOCATE(DstParamData%azWave(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 DstParamData%azWave.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%azWave = SrcParamData%azWave -ENDIF -IF (ALLOCATED(SrcParamData%PDyn)) THEN - i1_l = LBOUND(SrcParamData%PDyn,1) - i1_u = UBOUND(SrcParamData%PDyn,1) - i2_l = LBOUND(SrcParamData%PDyn,2) - i2_u = UBOUND(SrcParamData%PDyn,2) - i3_l = LBOUND(SrcParamData%PDyn,3) - i3_u = UBOUND(SrcParamData%PDyn,3) - i4_l = LBOUND(SrcParamData%PDyn,4) - i4_u = UBOUND(SrcParamData%PDyn,4) - IF (.NOT. ALLOCATED(DstParamData%PDyn)) THEN - ALLOCATE(DstParamData%PDyn(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 DstParamData%PDyn.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%PDyn = SrcParamData%PDyn -ENDIF -IF (ALLOCATED(SrcParamData%zeta)) THEN - i1_l = LBOUND(SrcParamData%zeta,1) - i1_u = UBOUND(SrcParamData%zeta,1) - i2_l = LBOUND(SrcParamData%zeta,2) - i2_u = UBOUND(SrcParamData%zeta,2) - i3_l = LBOUND(SrcParamData%zeta,3) - i3_u = UBOUND(SrcParamData%zeta,3) - IF (.NOT. ALLOCATED(DstParamData%zeta)) THEN - ALLOCATE(DstParamData%zeta(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%zeta.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%zeta = SrcParamData%zeta -ENDIF - DstParamData%nzCurrent = SrcParamData%nzCurrent -IF (ALLOCATED(SrcParamData%pzCurrent)) THEN - i1_l = LBOUND(SrcParamData%pzCurrent,1) - i1_u = UBOUND(SrcParamData%pzCurrent,1) - IF (.NOT. ALLOCATED(DstParamData%pzCurrent)) THEN - ALLOCATE(DstParamData%pzCurrent(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%pzCurrent.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%pzCurrent = SrcParamData%pzCurrent -ENDIF -IF (ALLOCATED(SrcParamData%uxCurrent)) THEN - i1_l = LBOUND(SrcParamData%uxCurrent,1) - i1_u = UBOUND(SrcParamData%uxCurrent,1) - IF (.NOT. ALLOCATED(DstParamData%uxCurrent)) THEN - ALLOCATE(DstParamData%uxCurrent(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%uxCurrent.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%uxCurrent = SrcParamData%uxCurrent -ENDIF -IF (ALLOCATED(SrcParamData%uyCurrent)) THEN - i1_l = LBOUND(SrcParamData%uyCurrent,1) - i1_u = UBOUND(SrcParamData%uyCurrent,1) - IF (.NOT. ALLOCATED(DstParamData%uyCurrent)) THEN - ALLOCATE(DstParamData%uyCurrent(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%uyCurrent.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%uyCurrent = SrcParamData%uyCurrent -ENDIF - DstParamData%Nx0 = SrcParamData%Nx0 -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 -IF (ALLOCATED(SrcParamData%dx)) THEN - i1_l = LBOUND(SrcParamData%dx,1) - i1_u = UBOUND(SrcParamData%dx,1) - IF (.NOT. ALLOCATED(DstParamData%dx)) THEN - ALLOCATE(DstParamData%dx(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%dx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%dx = SrcParamData%dx -ENDIF - DstParamData%Jac_ny = SrcParamData%Jac_ny - DstParamData%Jac_nx = SrcParamData%Jac_nx -IF (ALLOCATED(SrcParamData%dxIdx_map2_xStateIdx)) THEN - i1_l = LBOUND(SrcParamData%dxIdx_map2_xStateIdx,1) - i1_u = UBOUND(SrcParamData%dxIdx_map2_xStateIdx,1) - IF (.NOT. ALLOCATED(DstParamData%dxIdx_map2_xStateIdx)) THEN - ALLOCATE(DstParamData%dxIdx_map2_xStateIdx(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%dxIdx_map2_xStateIdx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%dxIdx_map2_xStateIdx = SrcParamData%dxIdx_map2_xStateIdx -ENDIF - DstParamData%VisMeshes = SrcParamData%VisMeshes -IF (ALLOCATED(SrcParamData%VisRodsDiam)) THEN - i1_l = LBOUND(SrcParamData%VisRodsDiam,1) - i1_u = UBOUND(SrcParamData%VisRodsDiam,1) - IF (.NOT. ALLOCATED(DstParamData%VisRodsDiam)) THEN - ALLOCATE(DstParamData%VisRodsDiam(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%VisRodsDiam.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcParamData%VisRodsDiam,1), UBOUND(SrcParamData%VisRodsDiam,1) - CALL MD_Copyvisdiam( SrcParamData%VisRodsDiam(i1), DstParamData%VisRodsDiam(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - END SUBROUTINE MD_CopyParam - - SUBROUTINE MD_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(MD_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(ParamData%nCpldBodies)) THEN - DEALLOCATE(ParamData%nCpldBodies) -ENDIF -IF (ALLOCATED(ParamData%nCpldRods)) THEN - DEALLOCATE(ParamData%nCpldRods) -ENDIF -IF (ALLOCATED(ParamData%nCpldPoints)) THEN - DEALLOCATE(ParamData%nCpldPoints) -ENDIF -IF (ALLOCATED(ParamData%OutParam)) THEN -DO i1 = LBOUND(ParamData%OutParam,1), UBOUND(ParamData%OutParam,1) - CALL MD_Destroyoutparmtype( ParamData%OutParam(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ParamData%OutParam) -ENDIF -IF (ALLOCATED(ParamData%TurbineRefPos)) THEN - DEALLOCATE(ParamData%TurbineRefPos) -ENDIF -IF (ALLOCATED(ParamData%pxWave)) THEN - DEALLOCATE(ParamData%pxWave) -ENDIF -IF (ALLOCATED(ParamData%pyWave)) THEN - DEALLOCATE(ParamData%pyWave) -ENDIF -IF (ALLOCATED(ParamData%pzWave)) THEN - DEALLOCATE(ParamData%pzWave) -ENDIF -IF (ALLOCATED(ParamData%uxWave)) THEN - DEALLOCATE(ParamData%uxWave) -ENDIF -IF (ALLOCATED(ParamData%uyWave)) THEN - DEALLOCATE(ParamData%uyWave) -ENDIF -IF (ALLOCATED(ParamData%uzWave)) THEN - DEALLOCATE(ParamData%uzWave) -ENDIF -IF (ALLOCATED(ParamData%axWave)) THEN - DEALLOCATE(ParamData%axWave) -ENDIF -IF (ALLOCATED(ParamData%ayWave)) THEN - DEALLOCATE(ParamData%ayWave) -ENDIF -IF (ALLOCATED(ParamData%azWave)) THEN - DEALLOCATE(ParamData%azWave) -ENDIF -IF (ALLOCATED(ParamData%PDyn)) THEN - DEALLOCATE(ParamData%PDyn) -ENDIF -IF (ALLOCATED(ParamData%zeta)) THEN - DEALLOCATE(ParamData%zeta) -ENDIF -IF (ALLOCATED(ParamData%pzCurrent)) THEN - DEALLOCATE(ParamData%pzCurrent) -ENDIF -IF (ALLOCATED(ParamData%uxCurrent)) THEN - DEALLOCATE(ParamData%uxCurrent) -ENDIF -IF (ALLOCATED(ParamData%uyCurrent)) THEN - DEALLOCATE(ParamData%uyCurrent) -ENDIF -IF (ALLOCATED(ParamData%Jac_u_indx)) THEN - DEALLOCATE(ParamData%Jac_u_indx) -ENDIF -IF (ALLOCATED(ParamData%du)) THEN - DEALLOCATE(ParamData%du) -ENDIF -IF (ALLOCATED(ParamData%dx)) THEN - DEALLOCATE(ParamData%dx) -ENDIF -IF (ALLOCATED(ParamData%dxIdx_map2_xStateIdx)) THEN - DEALLOCATE(ParamData%dxIdx_map2_xStateIdx) -ENDIF -IF (ALLOCATED(ParamData%VisRodsDiam)) THEN -DO i1 = LBOUND(ParamData%VisRodsDiam,1), UBOUND(ParamData%VisRodsDiam,1) - CALL MD_Destroyvisdiam( ParamData%VisRodsDiam(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ParamData%VisRodsDiam) -ENDIF - END SUBROUTINE MD_DestroyParam - - SUBROUTINE MD_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(MD_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 = 'MD_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 ! nLineTypes - Int_BufSz = Int_BufSz + 1 ! nRodTypes - Int_BufSz = Int_BufSz + 1 ! nPoints - Int_BufSz = Int_BufSz + 1 ! nPointsExtra - Int_BufSz = Int_BufSz + 1 ! nBodies - Int_BufSz = Int_BufSz + 1 ! nRods - Int_BufSz = Int_BufSz + 1 ! nLines - Int_BufSz = Int_BufSz + 1 ! nCtrlChans - Int_BufSz = Int_BufSz + 1 ! nFails - Int_BufSz = Int_BufSz + 1 ! nFreeBodies - Int_BufSz = Int_BufSz + 1 ! nFreeRods - Int_BufSz = Int_BufSz + 1 ! nFreePoints - Int_BufSz = Int_BufSz + 1 ! nCpldBodies allocated yes/no - IF ( ALLOCATED(InData%nCpldBodies) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! nCpldBodies upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%nCpldBodies) ! nCpldBodies - END IF - Int_BufSz = Int_BufSz + 1 ! nCpldRods allocated yes/no - IF ( ALLOCATED(InData%nCpldRods) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! nCpldRods upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%nCpldRods) ! nCpldRods - END IF - Int_BufSz = Int_BufSz + 1 ! nCpldPoints allocated yes/no - IF ( ALLOCATED(InData%nCpldPoints) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! nCpldPoints upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%nCpldPoints) ! nCpldPoints - END IF - Int_BufSz = Int_BufSz + 1 ! NConns - Int_BufSz = Int_BufSz + 1 ! NAnchs - Db_BufSz = Db_BufSz + 1 ! Tmax - Db_BufSz = Db_BufSz + 1 ! g - Db_BufSz = Db_BufSz + 1 ! rhoW - Db_BufSz = Db_BufSz + 1 ! WtrDpth - Db_BufSz = Db_BufSz + 1 ! kBot - Db_BufSz = Db_BufSz + 1 ! cBot - Db_BufSz = Db_BufSz + 1 ! dtM0 - Db_BufSz = Db_BufSz + 1 ! dtCoupling - Int_BufSz = Int_BufSz + 1 ! NumOuts - Db_BufSz = Db_BufSz + 1 ! dtOut - 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 MD_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 ! MDUnOut - Int_BufSz = Int_BufSz + 1*LEN(InData%PriPath) ! PriPath - Int_BufSz = Int_BufSz + 1 ! writeLog - Int_BufSz = Int_BufSz + 1 ! UnLog - Int_BufSz = Int_BufSz + 1 ! WaveKin - Int_BufSz = Int_BufSz + 1 ! Current - Int_BufSz = Int_BufSz + 1 ! nTurbines - Int_BufSz = Int_BufSz + 1 ! TurbineRefPos allocated yes/no - IF ( ALLOCATED(InData%TurbineRefPos) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! TurbineRefPos upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TurbineRefPos) ! TurbineRefPos - END IF - Db_BufSz = Db_BufSz + 1 ! mu_kT - Db_BufSz = Db_BufSz + 1 ! mu_kA - Db_BufSz = Db_BufSz + 1 ! mc - Db_BufSz = Db_BufSz + 1 ! cv - Int_BufSz = Int_BufSz + 1 ! nxWave - Int_BufSz = Int_BufSz + 1 ! nyWave - Int_BufSz = Int_BufSz + 1 ! nzWave - Int_BufSz = Int_BufSz + 1 ! ntWave - Int_BufSz = Int_BufSz + 1 ! pxWave allocated yes/no - IF ( ALLOCATED(InData%pxWave) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! pxWave upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%pxWave) ! pxWave - END IF - Int_BufSz = Int_BufSz + 1 ! pyWave allocated yes/no - IF ( ALLOCATED(InData%pyWave) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! pyWave upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%pyWave) ! pyWave - END IF - Int_BufSz = Int_BufSz + 1 ! pzWave allocated yes/no - IF ( ALLOCATED(InData%pzWave) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! pzWave upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%pzWave) ! pzWave - END IF - Re_BufSz = Re_BufSz + 1 ! dtWave - Int_BufSz = Int_BufSz + 1 ! uxWave allocated yes/no - IF ( ALLOCATED(InData%uxWave) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! uxWave upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%uxWave) ! uxWave - END IF - Int_BufSz = Int_BufSz + 1 ! uyWave allocated yes/no - IF ( ALLOCATED(InData%uyWave) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! uyWave upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%uyWave) ! uyWave - END IF - Int_BufSz = Int_BufSz + 1 ! uzWave allocated yes/no - IF ( ALLOCATED(InData%uzWave) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! uzWave upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%uzWave) ! uzWave - END IF - Int_BufSz = Int_BufSz + 1 ! axWave allocated yes/no - IF ( ALLOCATED(InData%axWave) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! axWave upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%axWave) ! axWave - END IF - Int_BufSz = Int_BufSz + 1 ! ayWave allocated yes/no - IF ( ALLOCATED(InData%ayWave) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! ayWave upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%ayWave) ! ayWave - END IF - Int_BufSz = Int_BufSz + 1 ! azWave allocated yes/no - IF ( ALLOCATED(InData%azWave) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! azWave upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%azWave) ! azWave - END IF - Int_BufSz = Int_BufSz + 1 ! PDyn allocated yes/no - IF ( ALLOCATED(InData%PDyn) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! PDyn upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PDyn) ! PDyn - END IF - Int_BufSz = Int_BufSz + 1 ! zeta allocated yes/no - IF ( ALLOCATED(InData%zeta) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! zeta upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%zeta) ! zeta - END IF - Int_BufSz = Int_BufSz + 1 ! nzCurrent - Int_BufSz = Int_BufSz + 1 ! pzCurrent allocated yes/no - IF ( ALLOCATED(InData%pzCurrent) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! pzCurrent upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%pzCurrent) ! pzCurrent - END IF - Int_BufSz = Int_BufSz + 1 ! uxCurrent allocated yes/no - IF ( ALLOCATED(InData%uxCurrent) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! uxCurrent upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%uxCurrent) ! uxCurrent - END IF - Int_BufSz = Int_BufSz + 1 ! uyCurrent allocated yes/no - IF ( ALLOCATED(InData%uyCurrent) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! uyCurrent upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%uyCurrent) ! uyCurrent - END IF - Int_BufSz = Int_BufSz + 1 ! Nx0 - 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 - Int_BufSz = Int_BufSz + 1 ! dx allocated yes/no - IF ( ALLOCATED(InData%dx) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! dx upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%dx) ! dx - END IF - Int_BufSz = Int_BufSz + 1 ! Jac_ny - Int_BufSz = Int_BufSz + 1 ! Jac_nx - Int_BufSz = Int_BufSz + 1 ! dxIdx_map2_xStateIdx allocated yes/no - IF ( ALLOCATED(InData%dxIdx_map2_xStateIdx) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! dxIdx_map2_xStateIdx upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%dxIdx_map2_xStateIdx) ! dxIdx_map2_xStateIdx - END IF - Int_BufSz = Int_BufSz + 1 ! VisMeshes - Int_BufSz = Int_BufSz + 1 ! VisRodsDiam allocated yes/no - IF ( ALLOCATED(InData%VisRodsDiam) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! VisRodsDiam upper/lower bounds for each dimension - DO i1 = LBOUND(InData%VisRodsDiam,1), UBOUND(InData%VisRodsDiam,1) - Int_BufSz = Int_BufSz + 3 ! VisRodsDiam: size of buffers for each call to pack subtype - CALL MD_Packvisdiam( Re_Buf, Db_Buf, Int_Buf, InData%VisRodsDiam(i1), ErrStat2, ErrMsg2, .TRUE. ) ! VisRodsDiam - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! VisRodsDiam - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! VisRodsDiam - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! VisRodsDiam - 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 - - IntKiBuf(Int_Xferred) = InData%nLineTypes - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nRodTypes - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nPoints - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nPointsExtra - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nBodies - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nRods - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nLines - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nCtrlChans - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nFails - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nFreeBodies - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nFreeRods - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nFreePoints - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%nCpldBodies) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%nCpldBodies,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%nCpldBodies,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%nCpldBodies,1), UBOUND(InData%nCpldBodies,1) - IntKiBuf(Int_Xferred) = InData%nCpldBodies(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%nCpldRods) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%nCpldRods,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%nCpldRods,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%nCpldRods,1), UBOUND(InData%nCpldRods,1) - IntKiBuf(Int_Xferred) = InData%nCpldRods(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%nCpldPoints) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%nCpldPoints,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%nCpldPoints,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%nCpldPoints,1), UBOUND(InData%nCpldPoints,1) - IntKiBuf(Int_Xferred) = InData%nCpldPoints(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NConns - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NAnchs - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%Tmax - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%g - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%rhoW - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%WtrDpth - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%kBot - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%cBot - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%dtM0 - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%dtCoupling - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%dtOut - 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 - 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 MD_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) = InData%MDUnOut - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%PriPath) - IntKiBuf(Int_Xferred) = ICHAR(InData%PriPath(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = InData%writeLog - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%UnLog - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%WaveKin - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%Current - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nTurbines - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%TurbineRefPos) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TurbineRefPos,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TurbineRefPos,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TurbineRefPos,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TurbineRefPos,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%TurbineRefPos,2), UBOUND(InData%TurbineRefPos,2) - DO i1 = LBOUND(InData%TurbineRefPos,1), UBOUND(InData%TurbineRefPos,1) - ReKiBuf(Re_Xferred) = InData%TurbineRefPos(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - DbKiBuf(Db_Xferred) = InData%mu_kT - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%mu_kA - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%mc - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%cv - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nxWave - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nyWave - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nzWave - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%ntWave - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%pxWave) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%pxWave,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%pxWave,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%pxWave,1), UBOUND(InData%pxWave,1) - ReKiBuf(Re_Xferred) = InData%pxWave(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%pyWave) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%pyWave,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%pyWave,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%pyWave,1), UBOUND(InData%pyWave,1) - ReKiBuf(Re_Xferred) = InData%pyWave(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%pzWave) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%pzWave,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%pzWave,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%pzWave,1), UBOUND(InData%pzWave,1) - ReKiBuf(Re_Xferred) = InData%pzWave(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%dtWave - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%uxWave) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%uxWave,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uxWave,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%uxWave,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uxWave,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%uxWave,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uxWave,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%uxWave,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uxWave,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%uxWave,4), UBOUND(InData%uxWave,4) - DO i3 = LBOUND(InData%uxWave,3), UBOUND(InData%uxWave,3) - DO i2 = LBOUND(InData%uxWave,2), UBOUND(InData%uxWave,2) - DO i1 = LBOUND(InData%uxWave,1), UBOUND(InData%uxWave,1) - ReKiBuf(Re_Xferred) = InData%uxWave(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%uyWave) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%uyWave,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uyWave,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%uyWave,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uyWave,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%uyWave,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uyWave,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%uyWave,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uyWave,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%uyWave,4), UBOUND(InData%uyWave,4) - DO i3 = LBOUND(InData%uyWave,3), UBOUND(InData%uyWave,3) - DO i2 = LBOUND(InData%uyWave,2), UBOUND(InData%uyWave,2) - DO i1 = LBOUND(InData%uyWave,1), UBOUND(InData%uyWave,1) - ReKiBuf(Re_Xferred) = InData%uyWave(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%uzWave) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%uzWave,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uzWave,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%uzWave,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uzWave,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%uzWave,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uzWave,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%uzWave,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uzWave,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%uzWave,4), UBOUND(InData%uzWave,4) - DO i3 = LBOUND(InData%uzWave,3), UBOUND(InData%uzWave,3) - DO i2 = LBOUND(InData%uzWave,2), UBOUND(InData%uzWave,2) - DO i1 = LBOUND(InData%uzWave,1), UBOUND(InData%uzWave,1) - ReKiBuf(Re_Xferred) = InData%uzWave(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%axWave) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%axWave,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%axWave,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%axWave,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%axWave,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%axWave,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%axWave,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%axWave,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%axWave,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%axWave,4), UBOUND(InData%axWave,4) - DO i3 = LBOUND(InData%axWave,3), UBOUND(InData%axWave,3) - DO i2 = LBOUND(InData%axWave,2), UBOUND(InData%axWave,2) - DO i1 = LBOUND(InData%axWave,1), UBOUND(InData%axWave,1) - ReKiBuf(Re_Xferred) = InData%axWave(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ayWave) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ayWave,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ayWave,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ayWave,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ayWave,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ayWave,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ayWave,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ayWave,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ayWave,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%ayWave,4), UBOUND(InData%ayWave,4) - DO i3 = LBOUND(InData%ayWave,3), UBOUND(InData%ayWave,3) - DO i2 = LBOUND(InData%ayWave,2), UBOUND(InData%ayWave,2) - DO i1 = LBOUND(InData%ayWave,1), UBOUND(InData%ayWave,1) - ReKiBuf(Re_Xferred) = InData%ayWave(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%azWave) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%azWave,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%azWave,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%azWave,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%azWave,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%azWave,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%azWave,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%azWave,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%azWave,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%azWave,4), UBOUND(InData%azWave,4) - DO i3 = LBOUND(InData%azWave,3), UBOUND(InData%azWave,3) - DO i2 = LBOUND(InData%azWave,2), UBOUND(InData%azWave,2) - DO i1 = LBOUND(InData%azWave,1), UBOUND(InData%azWave,1) - ReKiBuf(Re_Xferred) = InData%azWave(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PDyn) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PDyn,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PDyn,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PDyn,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PDyn,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PDyn,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PDyn,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PDyn,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PDyn,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%PDyn,4), UBOUND(InData%PDyn,4) - DO i3 = LBOUND(InData%PDyn,3), UBOUND(InData%PDyn,3) - DO i2 = LBOUND(InData%PDyn,2), UBOUND(InData%PDyn,2) - DO i1 = LBOUND(InData%PDyn,1), UBOUND(InData%PDyn,1) - ReKiBuf(Re_Xferred) = InData%PDyn(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%zeta) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%zeta,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%zeta,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%zeta,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%zeta,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%zeta,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%zeta,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%zeta,3), UBOUND(InData%zeta,3) - DO i2 = LBOUND(InData%zeta,2), UBOUND(InData%zeta,2) - DO i1 = LBOUND(InData%zeta,1), UBOUND(InData%zeta,1) - ReKiBuf(Re_Xferred) = InData%zeta(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%nzCurrent - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%pzCurrent) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%pzCurrent,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%pzCurrent,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%pzCurrent,1), UBOUND(InData%pzCurrent,1) - ReKiBuf(Re_Xferred) = InData%pzCurrent(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%uxCurrent) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%uxCurrent,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uxCurrent,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%uxCurrent,1), UBOUND(InData%uxCurrent,1) - ReKiBuf(Re_Xferred) = InData%uxCurrent(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%uyCurrent) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%uyCurrent,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uyCurrent,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%uyCurrent,1), UBOUND(InData%uyCurrent,1) - ReKiBuf(Re_Xferred) = InData%uyCurrent(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%Nx0 - 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 - IF ( .NOT. ALLOCATED(InData%dx) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%dx,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dx,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%dx,1), UBOUND(InData%dx,1) - DbKiBuf(Db_Xferred) = InData%dx(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%Jac_ny - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%Jac_nx - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%dxIdx_map2_xStateIdx) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%dxIdx_map2_xStateIdx,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dxIdx_map2_xStateIdx,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%dxIdx_map2_xStateIdx,1), UBOUND(InData%dxIdx_map2_xStateIdx,1) - IntKiBuf(Int_Xferred) = InData%dxIdx_map2_xStateIdx(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = TRANSFER(InData%VisMeshes, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%VisRodsDiam) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%VisRodsDiam,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VisRodsDiam,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%VisRodsDiam,1), UBOUND(InData%VisRodsDiam,1) - CALL MD_Packvisdiam( Re_Buf, Db_Buf, Int_Buf, InData%VisRodsDiam(i1), ErrStat2, ErrMsg2, OnlySize ) ! VisRodsDiam - 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 MD_PackParam - - SUBROUTINE MD_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(MD_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) :: 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 = 'MD_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%nLineTypes = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nRodTypes = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nPoints = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nPointsExtra = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nBodies = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nRods = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nLines = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nCtrlChans = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nFails = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nFreeBodies = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nFreeRods = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nFreePoints = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! nCpldBodies not allocated - Int_Xferred = Int_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%nCpldBodies)) DEALLOCATE(OutData%nCpldBodies) - ALLOCATE(OutData%nCpldBodies(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%nCpldBodies.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%nCpldBodies,1), UBOUND(OutData%nCpldBodies,1) - OutData%nCpldBodies(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! nCpldRods not allocated - Int_Xferred = Int_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%nCpldRods)) DEALLOCATE(OutData%nCpldRods) - ALLOCATE(OutData%nCpldRods(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%nCpldRods.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%nCpldRods,1), UBOUND(OutData%nCpldRods,1) - OutData%nCpldRods(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! nCpldPoints not allocated - Int_Xferred = Int_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%nCpldPoints)) DEALLOCATE(OutData%nCpldPoints) - ALLOCATE(OutData%nCpldPoints(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%nCpldPoints.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%nCpldPoints,1), UBOUND(OutData%nCpldPoints,1) - OutData%nCpldPoints(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - OutData%NConns = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NAnchs = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%Tmax = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%g = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%rhoW = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%WtrDpth = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%kBot = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%cBot = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%dtM0 = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%dtCoupling = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%NumOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%dtOut = 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 - 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 MD_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%MDUnOut = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%PriPath) - OutData%PriPath(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%writeLog = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%UnLog = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WaveKin = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%Current = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nTurbines = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TurbineRefPos not allocated - Int_Xferred = Int_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%TurbineRefPos)) DEALLOCATE(OutData%TurbineRefPos) - ALLOCATE(OutData%TurbineRefPos(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TurbineRefPos.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%TurbineRefPos,2), UBOUND(OutData%TurbineRefPos,2) - DO i1 = LBOUND(OutData%TurbineRefPos,1), UBOUND(OutData%TurbineRefPos,1) - OutData%TurbineRefPos(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%mu_kT = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%mu_kA = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%mc = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%cv = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%nxWave = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nyWave = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nzWave = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%ntWave = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! pxWave not allocated - Int_Xferred = Int_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%pxWave)) DEALLOCATE(OutData%pxWave) - ALLOCATE(OutData%pxWave(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%pxWave.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%pxWave,1), UBOUND(OutData%pxWave,1) - OutData%pxWave(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! pyWave not allocated - Int_Xferred = Int_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%pyWave)) DEALLOCATE(OutData%pyWave) - ALLOCATE(OutData%pyWave(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%pyWave.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%pyWave,1), UBOUND(OutData%pyWave,1) - OutData%pyWave(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! pzWave not allocated - Int_Xferred = Int_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%pzWave)) DEALLOCATE(OutData%pzWave) - ALLOCATE(OutData%pzWave(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%pzWave.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%pzWave,1), UBOUND(OutData%pzWave,1) - OutData%pzWave(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%dtWave = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! uxWave not allocated - Int_Xferred = Int_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%uxWave)) DEALLOCATE(OutData%uxWave) - ALLOCATE(OutData%uxWave(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%uxWave.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%uxWave,4), UBOUND(OutData%uxWave,4) - DO i3 = LBOUND(OutData%uxWave,3), UBOUND(OutData%uxWave,3) - DO i2 = LBOUND(OutData%uxWave,2), UBOUND(OutData%uxWave,2) - DO i1 = LBOUND(OutData%uxWave,1), UBOUND(OutData%uxWave,1) - OutData%uxWave(i1,i2,i3,i4) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! uyWave not allocated - Int_Xferred = Int_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%uyWave)) DEALLOCATE(OutData%uyWave) - ALLOCATE(OutData%uyWave(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%uyWave.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%uyWave,4), UBOUND(OutData%uyWave,4) - DO i3 = LBOUND(OutData%uyWave,3), UBOUND(OutData%uyWave,3) - DO i2 = LBOUND(OutData%uyWave,2), UBOUND(OutData%uyWave,2) - DO i1 = LBOUND(OutData%uyWave,1), UBOUND(OutData%uyWave,1) - OutData%uyWave(i1,i2,i3,i4) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! uzWave not allocated - Int_Xferred = Int_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%uzWave)) DEALLOCATE(OutData%uzWave) - ALLOCATE(OutData%uzWave(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%uzWave.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%uzWave,4), UBOUND(OutData%uzWave,4) - DO i3 = LBOUND(OutData%uzWave,3), UBOUND(OutData%uzWave,3) - DO i2 = LBOUND(OutData%uzWave,2), UBOUND(OutData%uzWave,2) - DO i1 = LBOUND(OutData%uzWave,1), UBOUND(OutData%uzWave,1) - OutData%uzWave(i1,i2,i3,i4) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! axWave not allocated - Int_Xferred = Int_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%axWave)) DEALLOCATE(OutData%axWave) - ALLOCATE(OutData%axWave(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%axWave.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%axWave,4), UBOUND(OutData%axWave,4) - DO i3 = LBOUND(OutData%axWave,3), UBOUND(OutData%axWave,3) - DO i2 = LBOUND(OutData%axWave,2), UBOUND(OutData%axWave,2) - DO i1 = LBOUND(OutData%axWave,1), UBOUND(OutData%axWave,1) - OutData%axWave(i1,i2,i3,i4) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ayWave not allocated - Int_Xferred = Int_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%ayWave)) DEALLOCATE(OutData%ayWave) - ALLOCATE(OutData%ayWave(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%ayWave.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%ayWave,4), UBOUND(OutData%ayWave,4) - DO i3 = LBOUND(OutData%ayWave,3), UBOUND(OutData%ayWave,3) - DO i2 = LBOUND(OutData%ayWave,2), UBOUND(OutData%ayWave,2) - DO i1 = LBOUND(OutData%ayWave,1), UBOUND(OutData%ayWave,1) - OutData%ayWave(i1,i2,i3,i4) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! azWave not allocated - Int_Xferred = Int_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%azWave)) DEALLOCATE(OutData%azWave) - ALLOCATE(OutData%azWave(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%azWave.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%azWave,4), UBOUND(OutData%azWave,4) - DO i3 = LBOUND(OutData%azWave,3), UBOUND(OutData%azWave,3) - DO i2 = LBOUND(OutData%azWave,2), UBOUND(OutData%azWave,2) - DO i1 = LBOUND(OutData%azWave,1), UBOUND(OutData%azWave,1) - OutData%azWave(i1,i2,i3,i4) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PDyn not allocated - Int_Xferred = Int_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%PDyn)) DEALLOCATE(OutData%PDyn) - ALLOCATE(OutData%PDyn(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%PDyn.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%PDyn,4), UBOUND(OutData%PDyn,4) - DO i3 = LBOUND(OutData%PDyn,3), UBOUND(OutData%PDyn,3) - DO i2 = LBOUND(OutData%PDyn,2), UBOUND(OutData%PDyn,2) - DO i1 = LBOUND(OutData%PDyn,1), UBOUND(OutData%PDyn,1) - OutData%PDyn(i1,i2,i3,i4) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! zeta not allocated - Int_Xferred = Int_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%zeta)) DEALLOCATE(OutData%zeta) - ALLOCATE(OutData%zeta(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%zeta.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%zeta,3), UBOUND(OutData%zeta,3) - DO i2 = LBOUND(OutData%zeta,2), UBOUND(OutData%zeta,2) - DO i1 = LBOUND(OutData%zeta,1), UBOUND(OutData%zeta,1) - OutData%zeta(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - OutData%nzCurrent = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! pzCurrent not allocated - Int_Xferred = Int_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%pzCurrent)) DEALLOCATE(OutData%pzCurrent) - ALLOCATE(OutData%pzCurrent(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%pzCurrent.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%pzCurrent,1), UBOUND(OutData%pzCurrent,1) - OutData%pzCurrent(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! uxCurrent not allocated - Int_Xferred = Int_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%uxCurrent)) DEALLOCATE(OutData%uxCurrent) - ALLOCATE(OutData%uxCurrent(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%uxCurrent.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%uxCurrent,1), UBOUND(OutData%uxCurrent,1) - OutData%uxCurrent(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! uyCurrent not allocated - Int_Xferred = Int_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%uyCurrent)) DEALLOCATE(OutData%uyCurrent) - ALLOCATE(OutData%uyCurrent(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%uyCurrent.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%uyCurrent,1), UBOUND(OutData%uyCurrent,1) - OutData%uyCurrent(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%Nx0 = 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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! dx not allocated - Int_Xferred = Int_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%dx)) DEALLOCATE(OutData%dx) - ALLOCATE(OutData%dx(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%dx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - 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 - END IF - OutData%Jac_ny = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%Jac_nx = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! dxIdx_map2_xStateIdx not allocated - Int_Xferred = Int_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%dxIdx_map2_xStateIdx)) DEALLOCATE(OutData%dxIdx_map2_xStateIdx) - ALLOCATE(OutData%dxIdx_map2_xStateIdx(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%dxIdx_map2_xStateIdx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%dxIdx_map2_xStateIdx,1), UBOUND(OutData%dxIdx_map2_xStateIdx,1) - OutData%dxIdx_map2_xStateIdx(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - OutData%VisMeshes = TRANSFER(IntKiBuf(Int_Xferred), OutData%VisMeshes) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! VisRodsDiam not allocated - Int_Xferred = Int_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%VisRodsDiam)) DEALLOCATE(OutData%VisRodsDiam) - ALLOCATE(OutData%VisRodsDiam(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%VisRodsDiam.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%VisRodsDiam,1), UBOUND(OutData%VisRodsDiam,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 MD_Unpackvisdiam( Re_Buf, Db_Buf, Int_Buf, OutData%VisRodsDiam(i1), ErrStat2, ErrMsg2 ) ! VisRodsDiam - 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 MD_UnPackParam - SUBROUTINE MD_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MD_InputType), INTENT(INOUT) :: SrcInputData - TYPE(MD_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 = 'MD_CopyInput' -! +subroutine MD_CopyInputFileType(SrcInputFileTypeData, DstInputFileTypeData, CtrlCode, ErrStat, ErrMsg) + type(MD_InputFileType), intent(in) :: SrcInputFileTypeData + type(MD_InputFileType), intent(inout) :: DstInputFileTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'MD_CopyInputFileType' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcInputData%CoupledKinematics)) THEN - i1_l = LBOUND(SrcInputData%CoupledKinematics,1) - i1_u = UBOUND(SrcInputData%CoupledKinematics,1) - IF (.NOT. ALLOCATED(DstInputData%CoupledKinematics)) THEN - ALLOCATE(DstInputData%CoupledKinematics(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%CoupledKinematics.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcInputData%CoupledKinematics,1), UBOUND(SrcInputData%CoupledKinematics,1) - CALL MeshCopy( SrcInputData%CoupledKinematics(i1), DstInputData%CoupledKinematics(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcInputData%DeltaL)) THEN - i1_l = LBOUND(SrcInputData%DeltaL,1) - i1_u = UBOUND(SrcInputData%DeltaL,1) - IF (.NOT. ALLOCATED(DstInputData%DeltaL)) THEN - ALLOCATE(DstInputData%DeltaL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%DeltaL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%DeltaL = SrcInputData%DeltaL -ENDIF -IF (ALLOCATED(SrcInputData%DeltaLdot)) THEN - i1_l = LBOUND(SrcInputData%DeltaLdot,1) - i1_u = UBOUND(SrcInputData%DeltaLdot,1) - IF (.NOT. ALLOCATED(DstInputData%DeltaLdot)) THEN - ALLOCATE(DstInputData%DeltaLdot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%DeltaLdot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%DeltaLdot = SrcInputData%DeltaLdot -ENDIF - END SUBROUTINE MD_CopyInput - - SUBROUTINE MD_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(MD_InputType), INTENT(INOUT) :: InputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_DestroyInput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(InputData%CoupledKinematics)) THEN -DO i1 = LBOUND(InputData%CoupledKinematics,1), UBOUND(InputData%CoupledKinematics,1) - CALL MeshDestroy( InputData%CoupledKinematics(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(InputData%CoupledKinematics) -ENDIF -IF (ALLOCATED(InputData%DeltaL)) THEN - DEALLOCATE(InputData%DeltaL) -ENDIF -IF (ALLOCATED(InputData%DeltaLdot)) THEN - DEALLOCATE(InputData%DeltaLdot) -ENDIF - END SUBROUTINE MD_DestroyInput - - SUBROUTINE MD_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(MD_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 = 'MD_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 ! CoupledKinematics allocated yes/no - IF ( ALLOCATED(InData%CoupledKinematics) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! CoupledKinematics upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%CoupledKinematics,1), UBOUND(InData%CoupledKinematics,1) - Int_BufSz = Int_BufSz + 3 ! CoupledKinematics: size of buffers for each call to pack subtype - CALL MeshPack( InData%CoupledKinematics(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! CoupledKinematics - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! CoupledKinematics - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! CoupledKinematics - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! CoupledKinematics - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! DeltaL allocated yes/no - IF ( ALLOCATED(InData%DeltaL) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! DeltaL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%DeltaL) ! DeltaL - END IF - Int_BufSz = Int_BufSz + 1 ! DeltaLdot allocated yes/no - IF ( ALLOCATED(InData%DeltaLdot) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! DeltaLdot upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%DeltaLdot) ! DeltaLdot - 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%CoupledKinematics) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CoupledKinematics,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CoupledKinematics,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%CoupledKinematics,1), UBOUND(InData%CoupledKinematics,1) - CALL MeshPack( InData%CoupledKinematics(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! CoupledKinematics - 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%DeltaL) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DeltaL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DeltaL,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%DeltaL,1), UBOUND(InData%DeltaL,1) - ReKiBuf(Re_Xferred) = InData%DeltaL(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%DeltaLdot) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DeltaLdot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DeltaLdot,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%DeltaLdot,1), UBOUND(InData%DeltaLdot,1) - ReKiBuf(Re_Xferred) = InData%DeltaLdot(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE MD_PackInput - - SUBROUTINE MD_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(MD_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 = 'MD_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 ! CoupledKinematics not allocated - Int_Xferred = Int_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%CoupledKinematics)) DEALLOCATE(OutData%CoupledKinematics) - ALLOCATE(OutData%CoupledKinematics(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CoupledKinematics.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%CoupledKinematics,1), UBOUND(OutData%CoupledKinematics,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%CoupledKinematics(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! CoupledKinematics - 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 ! DeltaL not allocated - Int_Xferred = Int_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%DeltaL)) DEALLOCATE(OutData%DeltaL) - ALLOCATE(OutData%DeltaL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DeltaL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%DeltaL,1), UBOUND(OutData%DeltaL,1) - OutData%DeltaL(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DeltaLdot not allocated - Int_Xferred = Int_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%DeltaLdot)) DEALLOCATE(OutData%DeltaLdot) - ALLOCATE(OutData%DeltaLdot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DeltaLdot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%DeltaLdot,1), UBOUND(OutData%DeltaLdot,1) - OutData%DeltaLdot(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE MD_UnPackInput - - SUBROUTINE MD_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MD_OutputType), INTENT(INOUT) :: SrcOutputData - TYPE(MD_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 = 'MD_CopyOutput' -! + ErrMsg = '' + DstInputFileTypeData%DTIC = SrcInputFileTypeData%DTIC + DstInputFileTypeData%TMaxIC = SrcInputFileTypeData%TMaxIC + DstInputFileTypeData%CdScaleIC = SrcInputFileTypeData%CdScaleIC + DstInputFileTypeData%threshIC = SrcInputFileTypeData%threshIC +end subroutine + +subroutine MD_DestroyInputFileType(InputFileTypeData, ErrStat, ErrMsg) + type(MD_InputFileType), intent(inout) :: InputFileTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'MD_DestroyInputFileType' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcOutputData%CoupledLoads)) THEN - i1_l = LBOUND(SrcOutputData%CoupledLoads,1) - i1_u = UBOUND(SrcOutputData%CoupledLoads,1) - IF (.NOT. ALLOCATED(DstOutputData%CoupledLoads)) THEN - ALLOCATE(DstOutputData%CoupledLoads(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%CoupledLoads.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcOutputData%CoupledLoads,1), UBOUND(SrcOutputData%CoupledLoads,1) - CALL MeshCopy( SrcOutputData%CoupledLoads(i1), DstOutputData%CoupledLoads(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -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 -IF (ALLOCATED(SrcOutputData%VisLinesMesh)) THEN - i1_l = LBOUND(SrcOutputData%VisLinesMesh,1) - i1_u = UBOUND(SrcOutputData%VisLinesMesh,1) - IF (.NOT. ALLOCATED(DstOutputData%VisLinesMesh)) THEN - ALLOCATE(DstOutputData%VisLinesMesh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%VisLinesMesh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcOutputData%VisLinesMesh,1), UBOUND(SrcOutputData%VisLinesMesh,1) - CALL MeshCopy( SrcOutputData%VisLinesMesh(i1), DstOutputData%VisLinesMesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcOutputData%VisRodsMesh)) THEN - i1_l = LBOUND(SrcOutputData%VisRodsMesh,1) - i1_u = UBOUND(SrcOutputData%VisRodsMesh,1) - IF (.NOT. ALLOCATED(DstOutputData%VisRodsMesh)) THEN - ALLOCATE(DstOutputData%VisRodsMesh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%VisRodsMesh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcOutputData%VisRodsMesh,1), UBOUND(SrcOutputData%VisRodsMesh,1) - CALL MeshCopy( SrcOutputData%VisRodsMesh(i1), DstOutputData%VisRodsMesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcOutputData%VisBodiesMesh)) THEN - i1_l = LBOUND(SrcOutputData%VisBodiesMesh,1) - i1_u = UBOUND(SrcOutputData%VisBodiesMesh,1) - IF (.NOT. ALLOCATED(DstOutputData%VisBodiesMesh)) THEN - ALLOCATE(DstOutputData%VisBodiesMesh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%VisBodiesMesh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcOutputData%VisBodiesMesh,1), UBOUND(SrcOutputData%VisBodiesMesh,1) - CALL MeshCopy( SrcOutputData%VisBodiesMesh(i1), DstOutputData%VisBodiesMesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcOutputData%VisAnchsMesh)) THEN - i1_l = LBOUND(SrcOutputData%VisAnchsMesh,1) - i1_u = UBOUND(SrcOutputData%VisAnchsMesh,1) - IF (.NOT. ALLOCATED(DstOutputData%VisAnchsMesh)) THEN - ALLOCATE(DstOutputData%VisAnchsMesh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%VisAnchsMesh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcOutputData%VisAnchsMesh,1), UBOUND(SrcOutputData%VisAnchsMesh,1) - CALL MeshCopy( SrcOutputData%VisAnchsMesh(i1), DstOutputData%VisAnchsMesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - END SUBROUTINE MD_CopyOutput - - SUBROUTINE MD_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(MD_OutputType), INTENT(INOUT) :: OutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_DestroyOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(OutputData%CoupledLoads)) THEN -DO i1 = LBOUND(OutputData%CoupledLoads,1), UBOUND(OutputData%CoupledLoads,1) - CALL MeshDestroy( OutputData%CoupledLoads(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(OutputData%CoupledLoads) -ENDIF -IF (ALLOCATED(OutputData%WriteOutput)) THEN - DEALLOCATE(OutputData%WriteOutput) -ENDIF -IF (ALLOCATED(OutputData%VisLinesMesh)) THEN -DO i1 = LBOUND(OutputData%VisLinesMesh,1), UBOUND(OutputData%VisLinesMesh,1) - CALL MeshDestroy( OutputData%VisLinesMesh(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(OutputData%VisLinesMesh) -ENDIF -IF (ALLOCATED(OutputData%VisRodsMesh)) THEN -DO i1 = LBOUND(OutputData%VisRodsMesh,1), UBOUND(OutputData%VisRodsMesh,1) - CALL MeshDestroy( OutputData%VisRodsMesh(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(OutputData%VisRodsMesh) -ENDIF -IF (ALLOCATED(OutputData%VisBodiesMesh)) THEN -DO i1 = LBOUND(OutputData%VisBodiesMesh,1), UBOUND(OutputData%VisBodiesMesh,1) - CALL MeshDestroy( OutputData%VisBodiesMesh(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(OutputData%VisBodiesMesh) -ENDIF -IF (ALLOCATED(OutputData%VisAnchsMesh)) THEN -DO i1 = LBOUND(OutputData%VisAnchsMesh,1), UBOUND(OutputData%VisAnchsMesh,1) - CALL MeshDestroy( OutputData%VisAnchsMesh(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(OutputData%VisAnchsMesh) -ENDIF - END SUBROUTINE MD_DestroyOutput - - SUBROUTINE MD_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(MD_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 = 'MD_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 ! CoupledLoads allocated yes/no - IF ( ALLOCATED(InData%CoupledLoads) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! CoupledLoads upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%CoupledLoads,1), UBOUND(InData%CoupledLoads,1) - Int_BufSz = Int_BufSz + 3 ! CoupledLoads: size of buffers for each call to pack subtype - CALL MeshPack( InData%CoupledLoads(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! CoupledLoads - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! CoupledLoads - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! CoupledLoads - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! CoupledLoads - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - 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 - Int_BufSz = Int_BufSz + 1 ! VisLinesMesh allocated yes/no - IF ( ALLOCATED(InData%VisLinesMesh) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! VisLinesMesh upper/lower bounds for each dimension - DO i1 = LBOUND(InData%VisLinesMesh,1), UBOUND(InData%VisLinesMesh,1) - Int_BufSz = Int_BufSz + 3 ! VisLinesMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%VisLinesMesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! VisLinesMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! VisLinesMesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! VisLinesMesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! VisLinesMesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! VisRodsMesh allocated yes/no - IF ( ALLOCATED(InData%VisRodsMesh) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! VisRodsMesh upper/lower bounds for each dimension - DO i1 = LBOUND(InData%VisRodsMesh,1), UBOUND(InData%VisRodsMesh,1) - Int_BufSz = Int_BufSz + 3 ! VisRodsMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%VisRodsMesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! VisRodsMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! VisRodsMesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! VisRodsMesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! VisRodsMesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! VisBodiesMesh allocated yes/no - IF ( ALLOCATED(InData%VisBodiesMesh) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! VisBodiesMesh upper/lower bounds for each dimension - DO i1 = LBOUND(InData%VisBodiesMesh,1), UBOUND(InData%VisBodiesMesh,1) - Int_BufSz = Int_BufSz + 3 ! VisBodiesMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%VisBodiesMesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! VisBodiesMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! VisBodiesMesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! VisBodiesMesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! VisBodiesMesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! VisAnchsMesh allocated yes/no - IF ( ALLOCATED(InData%VisAnchsMesh) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! VisAnchsMesh upper/lower bounds for each dimension - DO i1 = LBOUND(InData%VisAnchsMesh,1), UBOUND(InData%VisAnchsMesh,1) - Int_BufSz = Int_BufSz + 3 ! VisAnchsMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%VisAnchsMesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! VisAnchsMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! VisAnchsMesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! VisAnchsMesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! VisAnchsMesh - 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%CoupledLoads) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CoupledLoads,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CoupledLoads,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%CoupledLoads,1), UBOUND(InData%CoupledLoads,1) - CALL MeshPack( InData%CoupledLoads(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! CoupledLoads - 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%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%VisLinesMesh) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%VisLinesMesh,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VisLinesMesh,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%VisLinesMesh,1), UBOUND(InData%VisLinesMesh,1) - CALL MeshPack( InData%VisLinesMesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! VisLinesMesh - 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%VisRodsMesh) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%VisRodsMesh,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VisRodsMesh,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%VisRodsMesh,1), UBOUND(InData%VisRodsMesh,1) - CALL MeshPack( InData%VisRodsMesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! VisRodsMesh - 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%VisBodiesMesh) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%VisBodiesMesh,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VisBodiesMesh,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%VisBodiesMesh,1), UBOUND(InData%VisBodiesMesh,1) - CALL MeshPack( InData%VisBodiesMesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! VisBodiesMesh - 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%VisAnchsMesh) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%VisAnchsMesh,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VisAnchsMesh,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%VisAnchsMesh,1), UBOUND(InData%VisAnchsMesh,1) - CALL MeshPack( InData%VisAnchsMesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! VisAnchsMesh - 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 MD_PackOutput - - SUBROUTINE MD_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(MD_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 = 'MD_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 ! CoupledLoads not allocated - Int_Xferred = Int_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%CoupledLoads)) DEALLOCATE(OutData%CoupledLoads) - ALLOCATE(OutData%CoupledLoads(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CoupledLoads.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%CoupledLoads,1), UBOUND(OutData%CoupledLoads,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%CoupledLoads(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! CoupledLoads - 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 ! 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 ! VisLinesMesh not allocated - Int_Xferred = Int_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%VisLinesMesh)) DEALLOCATE(OutData%VisLinesMesh) - ALLOCATE(OutData%VisLinesMesh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%VisLinesMesh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%VisLinesMesh,1), UBOUND(OutData%VisLinesMesh,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%VisLinesMesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! VisLinesMesh - 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 ! VisRodsMesh not allocated - Int_Xferred = Int_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%VisRodsMesh)) DEALLOCATE(OutData%VisRodsMesh) - ALLOCATE(OutData%VisRodsMesh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%VisRodsMesh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%VisRodsMesh,1), UBOUND(OutData%VisRodsMesh,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%VisRodsMesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! VisRodsMesh - 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 ! VisBodiesMesh not allocated - Int_Xferred = Int_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%VisBodiesMesh)) DEALLOCATE(OutData%VisBodiesMesh) - ALLOCATE(OutData%VisBodiesMesh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%VisBodiesMesh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%VisBodiesMesh,1), UBOUND(OutData%VisBodiesMesh,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%VisBodiesMesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! VisBodiesMesh - 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 ! VisAnchsMesh not allocated - Int_Xferred = Int_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%VisAnchsMesh)) DEALLOCATE(OutData%VisAnchsMesh) - ALLOCATE(OutData%VisAnchsMesh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%VisAnchsMesh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%VisAnchsMesh,1), UBOUND(OutData%VisAnchsMesh,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%VisAnchsMesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! VisAnchsMesh - 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 MD_UnPackOutput - - - SUBROUTINE MD_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(MD_InputType), INTENT(INOUT) :: u(:) ! Input at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Inputs - TYPE(MD_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 + ErrMsg = '' +end subroutine + +subroutine MD_PackInputFileType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(MD_InputFileType), intent(in) :: InData + character(*), parameter :: RoutineName = 'MD_PackInputFileType' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DTIC) + call RegPack(RF, InData%TMaxIC) + call RegPack(RF, InData%CdScaleIC) + call RegPack(RF, InData%threshIC) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine MD_UnPackInputFileType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(MD_InputFileType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'MD_UnPackInputFileType' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DTIC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TMaxIC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CdScaleIC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%threshIC); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine MD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) + type(MD_InitInputType), intent(in) :: SrcInitInputData + type(MD_InitInputType), intent(inout) :: DstInitInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'MD_CopyInitInput' + ErrStat = ErrID_None + ErrMsg = '' + DstInitInputData%g = SrcInitInputData%g + DstInitInputData%rhoW = SrcInitInputData%rhoW + DstInitInputData%WtrDepth = SrcInitInputData%WtrDepth + if (allocated(SrcInitInputData%PtfmInit)) then + LB(1:2) = lbound(SrcInitInputData%PtfmInit) + UB(1:2) = ubound(SrcInitInputData%PtfmInit) + if (.not. allocated(DstInitInputData%PtfmInit)) then + allocate(DstInitInputData%PtfmInit(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%PtfmInit.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%PtfmInit = SrcInitInputData%PtfmInit + end if + DstInitInputData%FarmSize = SrcInitInputData%FarmSize + if (allocated(SrcInitInputData%TurbineRefPos)) then + LB(1:2) = lbound(SrcInitInputData%TurbineRefPos) + UB(1:2) = ubound(SrcInitInputData%TurbineRefPos) + if (.not. allocated(DstInitInputData%TurbineRefPos)) then + allocate(DstInitInputData%TurbineRefPos(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%TurbineRefPos.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%TurbineRefPos = SrcInitInputData%TurbineRefPos + end if + DstInitInputData%Tmax = SrcInitInputData%Tmax + DstInitInputData%FileName = SrcInitInputData%FileName + DstInitInputData%RootName = SrcInitInputData%RootName + DstInitInputData%UsePrimaryInputFile = SrcInitInputData%UsePrimaryInputFile + call NWTC_Library_CopyFileInfoType(SrcInitInputData%PassedPrimaryInputData, DstInitInputData%PassedPrimaryInputData, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstInitInputData%Echo = SrcInitInputData%Echo + if (allocated(SrcInitInputData%OutList)) then + LB(1:1) = lbound(SrcInitInputData%OutList) + UB(1:1) = ubound(SrcInitInputData%OutList) + if (.not. allocated(DstInitInputData%OutList)) then + allocate(DstInitInputData%OutList(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%OutList.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%OutList = SrcInitInputData%OutList + end if + DstInitInputData%Linearize = SrcInitInputData%Linearize + DstInitInputData%VisMeshes = SrcInitInputData%VisMeshes +end subroutine + +subroutine MD_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(MD_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'MD_DestroyInitInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InitInputData%PtfmInit)) then + deallocate(InitInputData%PtfmInit) + end if + if (allocated(InitInputData%TurbineRefPos)) then + deallocate(InitInputData%TurbineRefPos) + end if + call NWTC_Library_DestroyFileInfoType(InitInputData%PassedPrimaryInputData, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(InitInputData%OutList)) then + deallocate(InitInputData%OutList) + end if +end subroutine + +subroutine MD_PackInitInput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(MD_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'MD_PackInitInput' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%g) + call RegPack(RF, InData%rhoW) + call RegPack(RF, InData%WtrDepth) + call RegPackAlloc(RF, InData%PtfmInit) + call RegPack(RF, InData%FarmSize) + call RegPackAlloc(RF, InData%TurbineRefPos) + call RegPack(RF, InData%Tmax) + call RegPack(RF, InData%FileName) + call RegPack(RF, InData%RootName) + call RegPack(RF, InData%UsePrimaryInputFile) + call NWTC_Library_PackFileInfoType(RF, InData%PassedPrimaryInputData) + call RegPack(RF, InData%Echo) + call RegPackAlloc(RF, InData%OutList) + call RegPack(RF, InData%Linearize) + call RegPack(RF, InData%VisMeshes) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine MD_UnPackInitInput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(MD_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'MD_UnPackInitInput' + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%g); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rhoW); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WtrDepth); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PtfmInit); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FarmSize); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TurbineRefPos); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Tmax); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FileName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RootName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UsePrimaryInputFile); if (RegCheckErr(RF, RoutineName)) return + call NWTC_Library_UnpackFileInfoType(RF, OutData%PassedPrimaryInputData) ! PassedPrimaryInputData + call RegUnpack(RF, OutData%Echo); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%OutList); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Linearize); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VisMeshes); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine MD_CopyLineProp(SrcLinePropData, DstLinePropData, CtrlCode, ErrStat, ErrMsg) + type(MD_LineProp), intent(in) :: SrcLinePropData + type(MD_LineProp), intent(inout) :: DstLinePropData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'MD_CopyLineProp' + ErrStat = ErrID_None + ErrMsg = '' + DstLinePropData%IdNum = SrcLinePropData%IdNum + DstLinePropData%name = SrcLinePropData%name + DstLinePropData%d = SrcLinePropData%d + DstLinePropData%w = SrcLinePropData%w + DstLinePropData%EA = SrcLinePropData%EA + DstLinePropData%EA_D = SrcLinePropData%EA_D + DstLinePropData%alphaMBL = SrcLinePropData%alphaMBL + DstLinePropData%vbeta = SrcLinePropData%vbeta + DstLinePropData%BA = SrcLinePropData%BA + DstLinePropData%BA_D = SrcLinePropData%BA_D + DstLinePropData%EI = SrcLinePropData%EI + DstLinePropData%Can = SrcLinePropData%Can + DstLinePropData%Cat = SrcLinePropData%Cat + DstLinePropData%Cdn = SrcLinePropData%Cdn + DstLinePropData%Cdt = SrcLinePropData%Cdt + DstLinePropData%ElasticMod = SrcLinePropData%ElasticMod + DstLinePropData%nEApoints = SrcLinePropData%nEApoints + DstLinePropData%stiffXs = SrcLinePropData%stiffXs + DstLinePropData%stiffYs = SrcLinePropData%stiffYs + DstLinePropData%nBApoints = SrcLinePropData%nBApoints + DstLinePropData%dampXs = SrcLinePropData%dampXs + DstLinePropData%dampYs = SrcLinePropData%dampYs + DstLinePropData%nEIpoints = SrcLinePropData%nEIpoints + DstLinePropData%bstiffXs = SrcLinePropData%bstiffXs + DstLinePropData%bstiffYs = SrcLinePropData%bstiffYs +end subroutine + +subroutine MD_DestroyLineProp(LinePropData, ErrStat, ErrMsg) + type(MD_LineProp), intent(inout) :: LinePropData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'MD_DestroyLineProp' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine MD_PackLineProp(RF, Indata) + type(RegFile), intent(inout) :: RF + type(MD_LineProp), intent(in) :: InData + character(*), parameter :: RoutineName = 'MD_PackLineProp' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%IdNum) + call RegPack(RF, InData%name) + call RegPack(RF, InData%d) + call RegPack(RF, InData%w) + call RegPack(RF, InData%EA) + call RegPack(RF, InData%EA_D) + call RegPack(RF, InData%alphaMBL) + call RegPack(RF, InData%vbeta) + call RegPack(RF, InData%BA) + call RegPack(RF, InData%BA_D) + call RegPack(RF, InData%EI) + call RegPack(RF, InData%Can) + call RegPack(RF, InData%Cat) + call RegPack(RF, InData%Cdn) + call RegPack(RF, InData%Cdt) + call RegPack(RF, InData%ElasticMod) + call RegPack(RF, InData%nEApoints) + call RegPack(RF, InData%stiffXs) + call RegPack(RF, InData%stiffYs) + call RegPack(RF, InData%nBApoints) + call RegPack(RF, InData%dampXs) + call RegPack(RF, InData%dampYs) + call RegPack(RF, InData%nEIpoints) + call RegPack(RF, InData%bstiffXs) + call RegPack(RF, InData%bstiffYs) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine MD_UnPackLineProp(RF, OutData) + type(RegFile), intent(inout) :: RF + type(MD_LineProp), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'MD_UnPackLineProp' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%IdNum); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%name); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%d); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%w); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%EA); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%EA_D); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%alphaMBL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%vbeta); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BA); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BA_D); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%EI); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Can); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Cat); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Cdn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Cdt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ElasticMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nEApoints); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%stiffXs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%stiffYs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nBApoints); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%dampXs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%dampYs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nEIpoints); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%bstiffXs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%bstiffYs); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine MD_CopyRodProp(SrcRodPropData, DstRodPropData, CtrlCode, ErrStat, ErrMsg) + type(MD_RodProp), intent(in) :: SrcRodPropData + type(MD_RodProp), intent(inout) :: DstRodPropData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'MD_CopyRodProp' + ErrStat = ErrID_None + ErrMsg = '' + DstRodPropData%IdNum = SrcRodPropData%IdNum + DstRodPropData%name = SrcRodPropData%name + DstRodPropData%d = SrcRodPropData%d + DstRodPropData%w = SrcRodPropData%w + DstRodPropData%Can = SrcRodPropData%Can + DstRodPropData%Cat = SrcRodPropData%Cat + DstRodPropData%Cdn = SrcRodPropData%Cdn + DstRodPropData%Cdt = SrcRodPropData%Cdt + DstRodPropData%CdEnd = SrcRodPropData%CdEnd + DstRodPropData%CaEnd = SrcRodPropData%CaEnd + DstRodPropData%LinDamp = SrcRodPropData%LinDamp + DstRodPropData%isLinDamp = SrcRodPropData%isLinDamp +end subroutine + +subroutine MD_DestroyRodProp(RodPropData, ErrStat, ErrMsg) + type(MD_RodProp), intent(inout) :: RodPropData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'MD_DestroyRodProp' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine MD_PackRodProp(RF, Indata) + type(RegFile), intent(inout) :: RF + type(MD_RodProp), intent(in) :: InData + character(*), parameter :: RoutineName = 'MD_PackRodProp' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%IdNum) + call RegPack(RF, InData%name) + call RegPack(RF, InData%d) + call RegPack(RF, InData%w) + call RegPack(RF, InData%Can) + call RegPack(RF, InData%Cat) + call RegPack(RF, InData%Cdn) + call RegPack(RF, InData%Cdt) + call RegPack(RF, InData%CdEnd) + call RegPack(RF, InData%CaEnd) + call RegPack(RF, InData%LinDamp) + call RegPack(RF, InData%isLinDamp) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine MD_UnPackRodProp(RF, OutData) + type(RegFile), intent(inout) :: RF + type(MD_RodProp), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'MD_UnPackRodProp' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%IdNum); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%name); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%d); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%w); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Can); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Cat); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Cdn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Cdt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CdEnd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CaEnd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LinDamp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%isLinDamp); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine MD_CopyBody(SrcBodyData, DstBodyData, CtrlCode, ErrStat, ErrMsg) + type(MD_Body), intent(in) :: SrcBodyData + type(MD_Body), intent(inout) :: DstBodyData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'MD_CopyBody' + ErrStat = ErrID_None + ErrMsg = '' + DstBodyData%IdNum = SrcBodyData%IdNum + DstBodyData%typeNum = SrcBodyData%typeNum + DstBodyData%AttachedC = SrcBodyData%AttachedC + DstBodyData%AttachedR = SrcBodyData%AttachedR + DstBodyData%nAttachedC = SrcBodyData%nAttachedC + DstBodyData%nAttachedR = SrcBodyData%nAttachedR + DstBodyData%rPointRel = SrcBodyData%rPointRel + DstBodyData%r6RodRel = SrcBodyData%r6RodRel + DstBodyData%bodyM = SrcBodyData%bodyM + DstBodyData%bodyV = SrcBodyData%bodyV + DstBodyData%bodyI = SrcBodyData%bodyI + DstBodyData%bodyCdA = SrcBodyData%bodyCdA + DstBodyData%bodyCa = SrcBodyData%bodyCa + DstBodyData%time = SrcBodyData%time + DstBodyData%r6 = SrcBodyData%r6 + DstBodyData%v6 = SrcBodyData%v6 + DstBodyData%a6 = SrcBodyData%a6 + DstBodyData%U = SrcBodyData%U + DstBodyData%Ud = SrcBodyData%Ud + DstBodyData%zeta = SrcBodyData%zeta + DstBodyData%F6net = SrcBodyData%F6net + DstBodyData%M6net = SrcBodyData%M6net + DstBodyData%M = SrcBodyData%M + DstBodyData%M0 = SrcBodyData%M0 + DstBodyData%OrMat = SrcBodyData%OrMat + DstBodyData%rCG = SrcBodyData%rCG +end subroutine + +subroutine MD_DestroyBody(BodyData, ErrStat, ErrMsg) + type(MD_Body), intent(inout) :: BodyData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'MD_DestroyBody' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine MD_PackBody(RF, Indata) + type(RegFile), intent(inout) :: RF + type(MD_Body), intent(in) :: InData + character(*), parameter :: RoutineName = 'MD_PackBody' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%IdNum) + call RegPack(RF, InData%typeNum) + call RegPack(RF, InData%AttachedC) + call RegPack(RF, InData%AttachedR) + call RegPack(RF, InData%nAttachedC) + call RegPack(RF, InData%nAttachedR) + call RegPack(RF, InData%rPointRel) + call RegPack(RF, InData%r6RodRel) + call RegPack(RF, InData%bodyM) + call RegPack(RF, InData%bodyV) + call RegPack(RF, InData%bodyI) + call RegPack(RF, InData%bodyCdA) + call RegPack(RF, InData%bodyCa) + call RegPack(RF, InData%time) + call RegPack(RF, InData%r6) + call RegPack(RF, InData%v6) + call RegPack(RF, InData%a6) + call RegPack(RF, InData%U) + call RegPack(RF, InData%Ud) + call RegPack(RF, InData%zeta) + call RegPack(RF, InData%F6net) + call RegPack(RF, InData%M6net) + call RegPack(RF, InData%M) + call RegPack(RF, InData%M0) + call RegPack(RF, InData%OrMat) + call RegPack(RF, InData%rCG) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine MD_UnPackBody(RF, OutData) + type(RegFile), intent(inout) :: RF + type(MD_Body), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'MD_UnPackBody' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%IdNum); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%typeNum); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AttachedC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AttachedR); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nAttachedC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nAttachedR); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rPointRel); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%r6RodRel); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%bodyM); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%bodyV); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%bodyI); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%bodyCdA); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%bodyCa); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%time); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%r6); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%v6); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%a6); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%U); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Ud); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%zeta); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%F6net); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%M6net); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%M); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%M0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OrMat); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rCG); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine MD_CopyPoint(SrcPointData, DstPointData, CtrlCode, ErrStat, ErrMsg) + type(MD_Point), intent(in) :: SrcPointData + type(MD_Point), intent(inout) :: DstPointData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'MD_CopyPoint' + ErrStat = ErrID_None + ErrMsg = '' + DstPointData%IdNum = SrcPointData%IdNum + DstPointData%type = SrcPointData%type + DstPointData%typeNum = SrcPointData%typeNum + DstPointData%Attached = SrcPointData%Attached + DstPointData%Top = SrcPointData%Top + DstPointData%nAttached = SrcPointData%nAttached + DstPointData%pointM = SrcPointData%pointM + DstPointData%pointV = SrcPointData%pointV + DstPointData%pointFX = SrcPointData%pointFX + DstPointData%pointFY = SrcPointData%pointFY + DstPointData%pointFZ = SrcPointData%pointFZ + DstPointData%pointCa = SrcPointData%pointCa + DstPointData%pointCdA = SrcPointData%pointCdA + DstPointData%time = SrcPointData%time + DstPointData%r = SrcPointData%r + DstPointData%rd = SrcPointData%rd + DstPointData%a = SrcPointData%a + DstPointData%U = SrcPointData%U + DstPointData%Ud = SrcPointData%Ud + DstPointData%zeta = SrcPointData%zeta + if (allocated(SrcPointData%PDyn)) then + LB(1:1) = lbound(SrcPointData%PDyn) + UB(1:1) = ubound(SrcPointData%PDyn) + if (.not. allocated(DstPointData%PDyn)) then + allocate(DstPointData%PDyn(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstPointData%PDyn.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstPointData%PDyn = SrcPointData%PDyn + end if + DstPointData%Fnet = SrcPointData%Fnet + DstPointData%M = SrcPointData%M +end subroutine + +subroutine MD_DestroyPoint(PointData, ErrStat, ErrMsg) + type(MD_Point), intent(inout) :: PointData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'MD_DestroyPoint' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(PointData%PDyn)) then + deallocate(PointData%PDyn) + end if +end subroutine + +subroutine MD_PackPoint(RF, Indata) + type(RegFile), intent(inout) :: RF + type(MD_Point), intent(in) :: InData + character(*), parameter :: RoutineName = 'MD_PackPoint' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%IdNum) + call RegPack(RF, InData%type) + call RegPack(RF, InData%typeNum) + call RegPack(RF, InData%Attached) + call RegPack(RF, InData%Top) + call RegPack(RF, InData%nAttached) + call RegPack(RF, InData%pointM) + call RegPack(RF, InData%pointV) + call RegPack(RF, InData%pointFX) + call RegPack(RF, InData%pointFY) + call RegPack(RF, InData%pointFZ) + call RegPack(RF, InData%pointCa) + call RegPack(RF, InData%pointCdA) + call RegPack(RF, InData%time) + call RegPack(RF, InData%r) + call RegPack(RF, InData%rd) + call RegPack(RF, InData%a) + call RegPack(RF, InData%U) + call RegPack(RF, InData%Ud) + call RegPack(RF, InData%zeta) + call RegPackAlloc(RF, InData%PDyn) + call RegPack(RF, InData%Fnet) + call RegPack(RF, InData%M) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine MD_UnPackPoint(RF, OutData) + type(RegFile), intent(inout) :: RF + type(MD_Point), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'MD_UnPackPoint' + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%IdNum); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%type); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%typeNum); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Attached); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Top); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nAttached); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%pointM); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%pointV); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%pointFX); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%pointFY); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%pointFZ); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%pointCa); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%pointCdA); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%time); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%r); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%a); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%U); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Ud); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%zeta); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PDyn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Fnet); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%M); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine MD_CopyRod(SrcRodData, DstRodData, CtrlCode, ErrStat, ErrMsg) + type(MD_Rod), intent(in) :: SrcRodData + type(MD_Rod), intent(inout) :: DstRodData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'MD_CopyRod' + ErrStat = ErrID_None + ErrMsg = '' + DstRodData%IdNum = SrcRodData%IdNum + DstRodData%type = SrcRodData%type + DstRodData%PropsIdNum = SrcRodData%PropsIdNum + DstRodData%typeNum = SrcRodData%typeNum + DstRodData%AttachedA = SrcRodData%AttachedA + DstRodData%AttachedB = SrcRodData%AttachedB + DstRodData%TopA = SrcRodData%TopA + DstRodData%TopB = SrcRodData%TopB + DstRodData%nAttachedA = SrcRodData%nAttachedA + DstRodData%nAttachedB = SrcRodData%nAttachedB + DstRodData%OutFlagList = SrcRodData%OutFlagList + DstRodData%N = SrcRodData%N + DstRodData%endTypeA = SrcRodData%endTypeA + DstRodData%endTypeB = SrcRodData%endTypeB + DstRodData%UnstrLen = SrcRodData%UnstrLen + DstRodData%mass = SrcRodData%mass + DstRodData%rho = SrcRodData%rho + DstRodData%d = SrcRodData%d + DstRodData%Can = SrcRodData%Can + DstRodData%Cat = SrcRodData%Cat + DstRodData%Cdn = SrcRodData%Cdn + DstRodData%Cdt = SrcRodData%Cdt + DstRodData%CdEnd = SrcRodData%CdEnd + DstRodData%CaEnd = SrcRodData%CaEnd + DstRodData%LinDamp = SrcRodData%LinDamp + DstRodData%isLinDamp = SrcRodData%isLinDamp + DstRodData%time = SrcRodData%time + DstRodData%roll = SrcRodData%roll + DstRodData%pitch = SrcRodData%pitch + DstRodData%h0 = SrcRodData%h0 + if (allocated(SrcRodData%r)) then + LB(1:2) = lbound(SrcRodData%r) + UB(1:2) = ubound(SrcRodData%r) + if (.not. allocated(DstRodData%r)) then + allocate(DstRodData%r(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%r.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRodData%r = SrcRodData%r + end if + if (allocated(SrcRodData%rd)) then + LB(1:2) = lbound(SrcRodData%rd) + UB(1:2) = ubound(SrcRodData%rd) + if (.not. allocated(DstRodData%rd)) then + allocate(DstRodData%rd(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%rd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRodData%rd = SrcRodData%rd + end if + DstRodData%q = SrcRodData%q + if (allocated(SrcRodData%l)) then + LB(1:1) = lbound(SrcRodData%l) + UB(1:1) = ubound(SrcRodData%l) + if (.not. allocated(DstRodData%l)) then + allocate(DstRodData%l(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%l.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRodData%l = SrcRodData%l + end if + if (allocated(SrcRodData%V)) then + LB(1:1) = lbound(SrcRodData%V) + UB(1:1) = ubound(SrcRodData%V) + if (.not. allocated(DstRodData%V)) then + allocate(DstRodData%V(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%V.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRodData%V = SrcRodData%V + end if + if (allocated(SrcRodData%U)) then + LB(1:2) = lbound(SrcRodData%U) + UB(1:2) = ubound(SrcRodData%U) + if (.not. allocated(DstRodData%U)) then + allocate(DstRodData%U(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%U.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRodData%U = SrcRodData%U + end if + if (allocated(SrcRodData%Ud)) then + LB(1:2) = lbound(SrcRodData%Ud) + UB(1:2) = ubound(SrcRodData%Ud) + if (.not. allocated(DstRodData%Ud)) then + allocate(DstRodData%Ud(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%Ud.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRodData%Ud = SrcRodData%Ud + end if + if (allocated(SrcRodData%zeta)) then + LB(1:1) = lbound(SrcRodData%zeta) + UB(1:1) = ubound(SrcRodData%zeta) + if (.not. allocated(DstRodData%zeta)) then + allocate(DstRodData%zeta(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%zeta.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRodData%zeta = SrcRodData%zeta + end if + if (allocated(SrcRodData%PDyn)) then + LB(1:1) = lbound(SrcRodData%PDyn) + UB(1:1) = ubound(SrcRodData%PDyn) + if (.not. allocated(DstRodData%PDyn)) then + allocate(DstRodData%PDyn(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%PDyn.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRodData%PDyn = SrcRodData%PDyn + end if + if (allocated(SrcRodData%W)) then + LB(1:2) = lbound(SrcRodData%W) + UB(1:2) = ubound(SrcRodData%W) + if (.not. allocated(DstRodData%W)) then + allocate(DstRodData%W(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%W.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRodData%W = SrcRodData%W + end if + if (allocated(SrcRodData%Bo)) then + LB(1:2) = lbound(SrcRodData%Bo) + UB(1:2) = ubound(SrcRodData%Bo) + if (.not. allocated(DstRodData%Bo)) then + allocate(DstRodData%Bo(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%Bo.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRodData%Bo = SrcRodData%Bo + end if + if (allocated(SrcRodData%Pd)) then + LB(1:2) = lbound(SrcRodData%Pd) + UB(1:2) = ubound(SrcRodData%Pd) + if (.not. allocated(DstRodData%Pd)) then + allocate(DstRodData%Pd(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%Pd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRodData%Pd = SrcRodData%Pd + end if + if (allocated(SrcRodData%Dp)) then + LB(1:2) = lbound(SrcRodData%Dp) + UB(1:2) = ubound(SrcRodData%Dp) + if (.not. allocated(DstRodData%Dp)) then + allocate(DstRodData%Dp(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%Dp.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRodData%Dp = SrcRodData%Dp + end if + if (allocated(SrcRodData%Dq)) then + LB(1:2) = lbound(SrcRodData%Dq) + UB(1:2) = ubound(SrcRodData%Dq) + if (.not. allocated(DstRodData%Dq)) then + allocate(DstRodData%Dq(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%Dq.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRodData%Dq = SrcRodData%Dq + end if + if (allocated(SrcRodData%Ap)) then + LB(1:2) = lbound(SrcRodData%Ap) + UB(1:2) = ubound(SrcRodData%Ap) + if (.not. allocated(DstRodData%Ap)) then + allocate(DstRodData%Ap(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%Ap.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRodData%Ap = SrcRodData%Ap + end if + if (allocated(SrcRodData%Aq)) then + LB(1:2) = lbound(SrcRodData%Aq) + UB(1:2) = ubound(SrcRodData%Aq) + if (.not. allocated(DstRodData%Aq)) then + allocate(DstRodData%Aq(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%Aq.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRodData%Aq = SrcRodData%Aq + end if + if (allocated(SrcRodData%B)) then + LB(1:2) = lbound(SrcRodData%B) + UB(1:2) = ubound(SrcRodData%B) + if (.not. allocated(DstRodData%B)) then + allocate(DstRodData%B(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%B.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRodData%B = SrcRodData%B + end if + if (allocated(SrcRodData%Fnet)) then + LB(1:2) = lbound(SrcRodData%Fnet) + UB(1:2) = ubound(SrcRodData%Fnet) + if (.not. allocated(DstRodData%Fnet)) then + allocate(DstRodData%Fnet(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%Fnet.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRodData%Fnet = SrcRodData%Fnet + end if + if (allocated(SrcRodData%M)) then + LB(1:3) = lbound(SrcRodData%M) + UB(1:3) = ubound(SrcRodData%M) + if (.not. allocated(DstRodData%M)) then + allocate(DstRodData%M(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%M.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRodData%M = SrcRodData%M + end if + DstRodData%FextA = SrcRodData%FextA + DstRodData%FextB = SrcRodData%FextB + DstRodData%Mext = SrcRodData%Mext + DstRodData%r6 = SrcRodData%r6 + DstRodData%v6 = SrcRodData%v6 + DstRodData%a6 = SrcRodData%a6 + DstRodData%F6net = SrcRodData%F6net + DstRodData%M6net = SrcRodData%M6net + DstRodData%Imat = SrcRodData%Imat + DstRodData%OrMat = SrcRodData%OrMat + DstRodData%RodUnOut = SrcRodData%RodUnOut + if (allocated(SrcRodData%RodWrOutput)) then + LB(1:1) = lbound(SrcRodData%RodWrOutput) + UB(1:1) = ubound(SrcRodData%RodWrOutput) + if (.not. allocated(DstRodData%RodWrOutput)) then + allocate(DstRodData%RodWrOutput(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%RodWrOutput.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRodData%RodWrOutput = SrcRodData%RodWrOutput + end if +end subroutine + +subroutine MD_DestroyRod(RodData, ErrStat, ErrMsg) + type(MD_Rod), intent(inout) :: RodData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'MD_DestroyRod' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(RodData%r)) then + deallocate(RodData%r) + end if + if (allocated(RodData%rd)) then + deallocate(RodData%rd) + end if + if (allocated(RodData%l)) then + deallocate(RodData%l) + end if + if (allocated(RodData%V)) then + deallocate(RodData%V) + end if + if (allocated(RodData%U)) then + deallocate(RodData%U) + end if + if (allocated(RodData%Ud)) then + deallocate(RodData%Ud) + end if + if (allocated(RodData%zeta)) then + deallocate(RodData%zeta) + end if + if (allocated(RodData%PDyn)) then + deallocate(RodData%PDyn) + end if + if (allocated(RodData%W)) then + deallocate(RodData%W) + end if + if (allocated(RodData%Bo)) then + deallocate(RodData%Bo) + end if + if (allocated(RodData%Pd)) then + deallocate(RodData%Pd) + end if + if (allocated(RodData%Dp)) then + deallocate(RodData%Dp) + end if + if (allocated(RodData%Dq)) then + deallocate(RodData%Dq) + end if + if (allocated(RodData%Ap)) then + deallocate(RodData%Ap) + end if + if (allocated(RodData%Aq)) then + deallocate(RodData%Aq) + end if + if (allocated(RodData%B)) then + deallocate(RodData%B) + end if + if (allocated(RodData%Fnet)) then + deallocate(RodData%Fnet) + end if + if (allocated(RodData%M)) then + deallocate(RodData%M) + end if + if (allocated(RodData%RodWrOutput)) then + deallocate(RodData%RodWrOutput) + end if +end subroutine + +subroutine MD_PackRod(RF, Indata) + type(RegFile), intent(inout) :: RF + type(MD_Rod), intent(in) :: InData + character(*), parameter :: RoutineName = 'MD_PackRod' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%IdNum) + call RegPack(RF, InData%type) + call RegPack(RF, InData%PropsIdNum) + call RegPack(RF, InData%typeNum) + call RegPack(RF, InData%AttachedA) + call RegPack(RF, InData%AttachedB) + call RegPack(RF, InData%TopA) + call RegPack(RF, InData%TopB) + call RegPack(RF, InData%nAttachedA) + call RegPack(RF, InData%nAttachedB) + call RegPack(RF, InData%OutFlagList) + call RegPack(RF, InData%N) + call RegPack(RF, InData%endTypeA) + call RegPack(RF, InData%endTypeB) + call RegPack(RF, InData%UnstrLen) + call RegPack(RF, InData%mass) + call RegPack(RF, InData%rho) + call RegPack(RF, InData%d) + call RegPack(RF, InData%Can) + call RegPack(RF, InData%Cat) + call RegPack(RF, InData%Cdn) + call RegPack(RF, InData%Cdt) + call RegPack(RF, InData%CdEnd) + call RegPack(RF, InData%CaEnd) + call RegPack(RF, InData%LinDamp) + call RegPack(RF, InData%isLinDamp) + call RegPack(RF, InData%time) + call RegPack(RF, InData%roll) + call RegPack(RF, InData%pitch) + call RegPack(RF, InData%h0) + call RegPackAlloc(RF, InData%r) + call RegPackAlloc(RF, InData%rd) + call RegPack(RF, InData%q) + call RegPackAlloc(RF, InData%l) + call RegPackAlloc(RF, InData%V) + call RegPackAlloc(RF, InData%U) + call RegPackAlloc(RF, InData%Ud) + call RegPackAlloc(RF, InData%zeta) + call RegPackAlloc(RF, InData%PDyn) + call RegPackAlloc(RF, InData%W) + call RegPackAlloc(RF, InData%Bo) + call RegPackAlloc(RF, InData%Pd) + call RegPackAlloc(RF, InData%Dp) + call RegPackAlloc(RF, InData%Dq) + call RegPackAlloc(RF, InData%Ap) + call RegPackAlloc(RF, InData%Aq) + call RegPackAlloc(RF, InData%B) + call RegPackAlloc(RF, InData%Fnet) + call RegPackAlloc(RF, InData%M) + call RegPack(RF, InData%FextA) + call RegPack(RF, InData%FextB) + call RegPack(RF, InData%Mext) + call RegPack(RF, InData%r6) + call RegPack(RF, InData%v6) + call RegPack(RF, InData%a6) + call RegPack(RF, InData%F6net) + call RegPack(RF, InData%M6net) + call RegPack(RF, InData%Imat) + call RegPack(RF, InData%OrMat) + call RegPack(RF, InData%RodUnOut) + call RegPackAlloc(RF, InData%RodWrOutput) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine MD_UnPackRod(RF, OutData) + type(RegFile), intent(inout) :: RF + type(MD_Rod), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'MD_UnPackRod' + integer(B4Ki) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%IdNum); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%type); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PropsIdNum); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%typeNum); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AttachedA); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AttachedB); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TopA); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TopB); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nAttachedA); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nAttachedB); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutFlagList); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%N); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%endTypeA); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%endTypeB); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UnstrLen); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%mass); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rho); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%d); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Can); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Cat); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Cdn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Cdt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CdEnd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CaEnd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LinDamp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%isLinDamp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%time); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%roll); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%pitch); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%h0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%r); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%rd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%q); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%l); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%V); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%U); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Ud); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%zeta); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PDyn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%W); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Bo); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Pd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Dp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Dq); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Ap); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Aq); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%B); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Fnet); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%M); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FextA); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FextB); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Mext); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%r6); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%v6); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%a6); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%F6net); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%M6net); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Imat); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OrMat); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RodUnOut); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%RodWrOutput); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) + type(MD_Line), intent(in) :: SrcLineData + type(MD_Line), intent(inout) :: DstLineData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'MD_CopyLine' + ErrStat = ErrID_None + ErrMsg = '' + DstLineData%IdNum = SrcLineData%IdNum + DstLineData%PropsIdNum = SrcLineData%PropsIdNum + DstLineData%ElasticMod = SrcLineData%ElasticMod + DstLineData%OutFlagList = SrcLineData%OutFlagList + DstLineData%CtrlChan = SrcLineData%CtrlChan + DstLineData%FairPoint = SrcLineData%FairPoint + DstLineData%AnchPoint = SrcLineData%AnchPoint + DstLineData%N = SrcLineData%N + DstLineData%endTypeA = SrcLineData%endTypeA + DstLineData%endTypeB = SrcLineData%endTypeB + DstLineData%UnstrLen = SrcLineData%UnstrLen + DstLineData%rho = SrcLineData%rho + DstLineData%d = SrcLineData%d + DstLineData%EA = SrcLineData%EA + DstLineData%EA_D = SrcLineData%EA_D + DstLineData%alphaMBL = SrcLineData%alphaMBL + DstLineData%vbeta = SrcLineData%vbeta + DstLineData%BA = SrcLineData%BA + DstLineData%BA_D = SrcLineData%BA_D + DstLineData%EI = SrcLineData%EI + DstLineData%Can = SrcLineData%Can + DstLineData%Cat = SrcLineData%Cat + DstLineData%Cdn = SrcLineData%Cdn + DstLineData%Cdt = SrcLineData%Cdt + DstLineData%nEApoints = SrcLineData%nEApoints + DstLineData%stiffXs = SrcLineData%stiffXs + DstLineData%stiffYs = SrcLineData%stiffYs + DstLineData%nBApoints = SrcLineData%nBApoints + DstLineData%dampXs = SrcLineData%dampXs + DstLineData%dampYs = SrcLineData%dampYs + DstLineData%nEIpoints = SrcLineData%nEIpoints + DstLineData%bstiffXs = SrcLineData%bstiffXs + DstLineData%bstiffYs = SrcLineData%bstiffYs + DstLineData%time = SrcLineData%time + if (allocated(SrcLineData%r)) then + LB(1:2) = lbound(SrcLineData%r) + UB(1:2) = ubound(SrcLineData%r) + if (.not. allocated(DstLineData%r)) then + allocate(DstLineData%r(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%r.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLineData%r = SrcLineData%r + end if + if (allocated(SrcLineData%rd)) then + LB(1:2) = lbound(SrcLineData%rd) + UB(1:2) = ubound(SrcLineData%rd) + if (.not. allocated(DstLineData%rd)) then + allocate(DstLineData%rd(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%rd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLineData%rd = SrcLineData%rd + end if + if (allocated(SrcLineData%q)) then + LB(1:2) = lbound(SrcLineData%q) + UB(1:2) = ubound(SrcLineData%q) + if (.not. allocated(DstLineData%q)) then + allocate(DstLineData%q(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%q.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLineData%q = SrcLineData%q + end if + if (allocated(SrcLineData%qs)) then + LB(1:2) = lbound(SrcLineData%qs) + UB(1:2) = ubound(SrcLineData%qs) + if (.not. allocated(DstLineData%qs)) then + allocate(DstLineData%qs(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%qs.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLineData%qs = SrcLineData%qs + end if + if (allocated(SrcLineData%l)) then + LB(1:1) = lbound(SrcLineData%l) + UB(1:1) = ubound(SrcLineData%l) + if (.not. allocated(DstLineData%l)) then + allocate(DstLineData%l(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%l.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLineData%l = SrcLineData%l + end if + if (allocated(SrcLineData%ld)) then + LB(1:1) = lbound(SrcLineData%ld) + UB(1:1) = ubound(SrcLineData%ld) + if (.not. allocated(DstLineData%ld)) then + allocate(DstLineData%ld(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%ld.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLineData%ld = SrcLineData%ld + end if + if (allocated(SrcLineData%lstr)) then + LB(1:1) = lbound(SrcLineData%lstr) + UB(1:1) = ubound(SrcLineData%lstr) + if (.not. allocated(DstLineData%lstr)) then + allocate(DstLineData%lstr(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%lstr.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLineData%lstr = SrcLineData%lstr + end if + if (allocated(SrcLineData%lstrd)) then + LB(1:1) = lbound(SrcLineData%lstrd) + UB(1:1) = ubound(SrcLineData%lstrd) + if (.not. allocated(DstLineData%lstrd)) then + allocate(DstLineData%lstrd(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%lstrd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLineData%lstrd = SrcLineData%lstrd + end if + if (allocated(SrcLineData%Kurv)) then + LB(1:1) = lbound(SrcLineData%Kurv) + UB(1:1) = ubound(SrcLineData%Kurv) + if (.not. allocated(DstLineData%Kurv)) then + allocate(DstLineData%Kurv(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%Kurv.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLineData%Kurv = SrcLineData%Kurv + end if + if (allocated(SrcLineData%dl_1)) then + LB(1:1) = lbound(SrcLineData%dl_1) + UB(1:1) = ubound(SrcLineData%dl_1) + if (.not. allocated(DstLineData%dl_1)) then + allocate(DstLineData%dl_1(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%dl_1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLineData%dl_1 = SrcLineData%dl_1 + end if + if (allocated(SrcLineData%V)) then + LB(1:1) = lbound(SrcLineData%V) + UB(1:1) = ubound(SrcLineData%V) + if (.not. allocated(DstLineData%V)) then + allocate(DstLineData%V(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%V.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLineData%V = SrcLineData%V + end if + if (allocated(SrcLineData%F)) then + LB(1:1) = lbound(SrcLineData%F) + UB(1:1) = ubound(SrcLineData%F) + if (.not. allocated(DstLineData%F)) then + allocate(DstLineData%F(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%F.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLineData%F = SrcLineData%F + end if + if (allocated(SrcLineData%U)) then + LB(1:2) = lbound(SrcLineData%U) + UB(1:2) = ubound(SrcLineData%U) + if (.not. allocated(DstLineData%U)) then + allocate(DstLineData%U(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%U.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLineData%U = SrcLineData%U + end if + if (allocated(SrcLineData%Ud)) then + LB(1:2) = lbound(SrcLineData%Ud) + UB(1:2) = ubound(SrcLineData%Ud) + if (.not. allocated(DstLineData%Ud)) then + allocate(DstLineData%Ud(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%Ud.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLineData%Ud = SrcLineData%Ud + end if + if (allocated(SrcLineData%zeta)) then + LB(1:1) = lbound(SrcLineData%zeta) + UB(1:1) = ubound(SrcLineData%zeta) + if (.not. allocated(DstLineData%zeta)) then + allocate(DstLineData%zeta(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%zeta.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLineData%zeta = SrcLineData%zeta + end if + if (allocated(SrcLineData%PDyn)) then + LB(1:1) = lbound(SrcLineData%PDyn) + UB(1:1) = ubound(SrcLineData%PDyn) + if (.not. allocated(DstLineData%PDyn)) then + allocate(DstLineData%PDyn(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%PDyn.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLineData%PDyn = SrcLineData%PDyn + end if + if (allocated(SrcLineData%T)) then + LB(1:2) = lbound(SrcLineData%T) + UB(1:2) = ubound(SrcLineData%T) + if (.not. allocated(DstLineData%T)) then + allocate(DstLineData%T(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%T.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLineData%T = SrcLineData%T + end if + if (allocated(SrcLineData%Td)) then + LB(1:2) = lbound(SrcLineData%Td) + UB(1:2) = ubound(SrcLineData%Td) + if (.not. allocated(DstLineData%Td)) then + allocate(DstLineData%Td(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%Td.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLineData%Td = SrcLineData%Td + end if + if (allocated(SrcLineData%W)) then + LB(1:2) = lbound(SrcLineData%W) + UB(1:2) = ubound(SrcLineData%W) + if (.not. allocated(DstLineData%W)) then + allocate(DstLineData%W(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%W.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLineData%W = SrcLineData%W + end if + if (allocated(SrcLineData%Dp)) then + LB(1:2) = lbound(SrcLineData%Dp) + UB(1:2) = ubound(SrcLineData%Dp) + if (.not. allocated(DstLineData%Dp)) then + allocate(DstLineData%Dp(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%Dp.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLineData%Dp = SrcLineData%Dp + end if + if (allocated(SrcLineData%Dq)) then + LB(1:2) = lbound(SrcLineData%Dq) + UB(1:2) = ubound(SrcLineData%Dq) + if (.not. allocated(DstLineData%Dq)) then + allocate(DstLineData%Dq(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%Dq.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLineData%Dq = SrcLineData%Dq + end if + if (allocated(SrcLineData%Ap)) then + LB(1:2) = lbound(SrcLineData%Ap) + UB(1:2) = ubound(SrcLineData%Ap) + if (.not. allocated(DstLineData%Ap)) then + allocate(DstLineData%Ap(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%Ap.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLineData%Ap = SrcLineData%Ap + end if + if (allocated(SrcLineData%Aq)) then + LB(1:2) = lbound(SrcLineData%Aq) + UB(1:2) = ubound(SrcLineData%Aq) + if (.not. allocated(DstLineData%Aq)) then + allocate(DstLineData%Aq(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%Aq.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLineData%Aq = SrcLineData%Aq + end if + if (allocated(SrcLineData%B)) then + LB(1:2) = lbound(SrcLineData%B) + UB(1:2) = ubound(SrcLineData%B) + if (.not. allocated(DstLineData%B)) then + allocate(DstLineData%B(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%B.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLineData%B = SrcLineData%B + end if + if (allocated(SrcLineData%Bs)) then + LB(1:2) = lbound(SrcLineData%Bs) + UB(1:2) = ubound(SrcLineData%Bs) + if (.not. allocated(DstLineData%Bs)) then + allocate(DstLineData%Bs(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%Bs.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLineData%Bs = SrcLineData%Bs + end if + if (allocated(SrcLineData%Fnet)) then + LB(1:2) = lbound(SrcLineData%Fnet) + UB(1:2) = ubound(SrcLineData%Fnet) + if (.not. allocated(DstLineData%Fnet)) then + allocate(DstLineData%Fnet(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%Fnet.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLineData%Fnet = SrcLineData%Fnet + end if + if (allocated(SrcLineData%S)) then + LB(1:3) = lbound(SrcLineData%S) + UB(1:3) = ubound(SrcLineData%S) + if (.not. allocated(DstLineData%S)) then + allocate(DstLineData%S(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%S.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLineData%S = SrcLineData%S + end if + if (allocated(SrcLineData%M)) then + LB(1:3) = lbound(SrcLineData%M) + UB(1:3) = ubound(SrcLineData%M) + if (.not. allocated(DstLineData%M)) then + allocate(DstLineData%M(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%M.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLineData%M = SrcLineData%M + end if + DstLineData%EndMomentA = SrcLineData%EndMomentA + DstLineData%EndMomentB = SrcLineData%EndMomentB + DstLineData%LineUnOut = SrcLineData%LineUnOut + if (allocated(SrcLineData%LineWrOutput)) then + LB(1:1) = lbound(SrcLineData%LineWrOutput) + UB(1:1) = ubound(SrcLineData%LineWrOutput) + if (.not. allocated(DstLineData%LineWrOutput)) then + allocate(DstLineData%LineWrOutput(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%LineWrOutput.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLineData%LineWrOutput = SrcLineData%LineWrOutput + end if +end subroutine + +subroutine MD_DestroyLine(LineData, ErrStat, ErrMsg) + type(MD_Line), intent(inout) :: LineData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'MD_DestroyLine' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(LineData%r)) then + deallocate(LineData%r) + end if + if (allocated(LineData%rd)) then + deallocate(LineData%rd) + end if + if (allocated(LineData%q)) then + deallocate(LineData%q) + end if + if (allocated(LineData%qs)) then + deallocate(LineData%qs) + end if + if (allocated(LineData%l)) then + deallocate(LineData%l) + end if + if (allocated(LineData%ld)) then + deallocate(LineData%ld) + end if + if (allocated(LineData%lstr)) then + deallocate(LineData%lstr) + end if + if (allocated(LineData%lstrd)) then + deallocate(LineData%lstrd) + end if + if (allocated(LineData%Kurv)) then + deallocate(LineData%Kurv) + end if + if (allocated(LineData%dl_1)) then + deallocate(LineData%dl_1) + end if + if (allocated(LineData%V)) then + deallocate(LineData%V) + end if + if (allocated(LineData%F)) then + deallocate(LineData%F) + end if + if (allocated(LineData%U)) then + deallocate(LineData%U) + end if + if (allocated(LineData%Ud)) then + deallocate(LineData%Ud) + end if + if (allocated(LineData%zeta)) then + deallocate(LineData%zeta) + end if + if (allocated(LineData%PDyn)) then + deallocate(LineData%PDyn) + end if + if (allocated(LineData%T)) then + deallocate(LineData%T) + end if + if (allocated(LineData%Td)) then + deallocate(LineData%Td) + end if + if (allocated(LineData%W)) then + deallocate(LineData%W) + end if + if (allocated(LineData%Dp)) then + deallocate(LineData%Dp) + end if + if (allocated(LineData%Dq)) then + deallocate(LineData%Dq) + end if + if (allocated(LineData%Ap)) then + deallocate(LineData%Ap) + end if + if (allocated(LineData%Aq)) then + deallocate(LineData%Aq) + end if + if (allocated(LineData%B)) then + deallocate(LineData%B) + end if + if (allocated(LineData%Bs)) then + deallocate(LineData%Bs) + end if + if (allocated(LineData%Fnet)) then + deallocate(LineData%Fnet) + end if + if (allocated(LineData%S)) then + deallocate(LineData%S) + end if + if (allocated(LineData%M)) then + deallocate(LineData%M) + end if + if (allocated(LineData%LineWrOutput)) then + deallocate(LineData%LineWrOutput) + end if +end subroutine + +subroutine MD_PackLine(RF, Indata) + type(RegFile), intent(inout) :: RF + type(MD_Line), intent(in) :: InData + character(*), parameter :: RoutineName = 'MD_PackLine' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%IdNum) + call RegPack(RF, InData%PropsIdNum) + call RegPack(RF, InData%ElasticMod) + call RegPack(RF, InData%OutFlagList) + call RegPack(RF, InData%CtrlChan) + call RegPack(RF, InData%FairPoint) + call RegPack(RF, InData%AnchPoint) + call RegPack(RF, InData%N) + call RegPack(RF, InData%endTypeA) + call RegPack(RF, InData%endTypeB) + call RegPack(RF, InData%UnstrLen) + call RegPack(RF, InData%rho) + call RegPack(RF, InData%d) + call RegPack(RF, InData%EA) + call RegPack(RF, InData%EA_D) + call RegPack(RF, InData%alphaMBL) + call RegPack(RF, InData%vbeta) + call RegPack(RF, InData%BA) + call RegPack(RF, InData%BA_D) + call RegPack(RF, InData%EI) + call RegPack(RF, InData%Can) + call RegPack(RF, InData%Cat) + call RegPack(RF, InData%Cdn) + call RegPack(RF, InData%Cdt) + call RegPack(RF, InData%nEApoints) + call RegPack(RF, InData%stiffXs) + call RegPack(RF, InData%stiffYs) + call RegPack(RF, InData%nBApoints) + call RegPack(RF, InData%dampXs) + call RegPack(RF, InData%dampYs) + call RegPack(RF, InData%nEIpoints) + call RegPack(RF, InData%bstiffXs) + call RegPack(RF, InData%bstiffYs) + call RegPack(RF, InData%time) + call RegPackAlloc(RF, InData%r) + call RegPackAlloc(RF, InData%rd) + call RegPackAlloc(RF, InData%q) + call RegPackAlloc(RF, InData%qs) + call RegPackAlloc(RF, InData%l) + call RegPackAlloc(RF, InData%ld) + call RegPackAlloc(RF, InData%lstr) + call RegPackAlloc(RF, InData%lstrd) + call RegPackAlloc(RF, InData%Kurv) + call RegPackAlloc(RF, InData%dl_1) + call RegPackAlloc(RF, InData%V) + call RegPackAlloc(RF, InData%F) + call RegPackAlloc(RF, InData%U) + call RegPackAlloc(RF, InData%Ud) + call RegPackAlloc(RF, InData%zeta) + call RegPackAlloc(RF, InData%PDyn) + call RegPackAlloc(RF, InData%T) + call RegPackAlloc(RF, InData%Td) + call RegPackAlloc(RF, InData%W) + call RegPackAlloc(RF, InData%Dp) + call RegPackAlloc(RF, InData%Dq) + call RegPackAlloc(RF, InData%Ap) + call RegPackAlloc(RF, InData%Aq) + call RegPackAlloc(RF, InData%B) + call RegPackAlloc(RF, InData%Bs) + call RegPackAlloc(RF, InData%Fnet) + call RegPackAlloc(RF, InData%S) + call RegPackAlloc(RF, InData%M) + call RegPack(RF, InData%EndMomentA) + call RegPack(RF, InData%EndMomentB) + call RegPack(RF, InData%LineUnOut) + call RegPackAlloc(RF, InData%LineWrOutput) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine MD_UnPackLine(RF, OutData) + type(RegFile), intent(inout) :: RF + type(MD_Line), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'MD_UnPackLine' + integer(B4Ki) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%IdNum); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PropsIdNum); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ElasticMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutFlagList); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CtrlChan); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FairPoint); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AnchPoint); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%N); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%endTypeA); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%endTypeB); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UnstrLen); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rho); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%d); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%EA); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%EA_D); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%alphaMBL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%vbeta); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BA); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BA_D); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%EI); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Can); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Cat); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Cdn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Cdt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nEApoints); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%stiffXs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%stiffYs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nBApoints); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%dampXs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%dampYs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nEIpoints); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%bstiffXs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%bstiffYs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%time); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%r); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%rd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%q); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%qs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%l); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ld); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%lstr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%lstrd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Kurv); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dl_1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%V); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%F); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%U); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Ud); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%zeta); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PDyn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%T); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Td); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%W); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Dp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Dq); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Ap); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Aq); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%B); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Bs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Fnet); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%S); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%M); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%EndMomentA); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%EndMomentB); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LineUnOut); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LineWrOutput); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine MD_CopyFail(SrcFailData, DstFailData, CtrlCode, ErrStat, ErrMsg) + type(MD_Fail), intent(in) :: SrcFailData + type(MD_Fail), intent(inout) :: DstFailData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'MD_CopyFail' + ErrStat = ErrID_None + ErrMsg = '' + DstFailData%IdNum = SrcFailData%IdNum + DstFailData%attachID = SrcFailData%attachID + DstFailData%isRod = SrcFailData%isRod + DstFailData%lineIDs = SrcFailData%lineIDs + DstFailData%lineTops = SrcFailData%lineTops + DstFailData%nLinesToDetach = SrcFailData%nLinesToDetach + DstFailData%failTime = SrcFailData%failTime + DstFailData%failTen = SrcFailData%failTen + DstFailData%failStatus = SrcFailData%failStatus +end subroutine + +subroutine MD_DestroyFail(FailData, ErrStat, ErrMsg) + type(MD_Fail), intent(inout) :: FailData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'MD_DestroyFail' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine MD_PackFail(RF, Indata) + type(RegFile), intent(inout) :: RF + type(MD_Fail), intent(in) :: InData + character(*), parameter :: RoutineName = 'MD_PackFail' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%IdNum) + call RegPack(RF, InData%attachID) + call RegPack(RF, InData%isRod) + call RegPack(RF, InData%lineIDs) + call RegPack(RF, InData%lineTops) + call RegPack(RF, InData%nLinesToDetach) + call RegPack(RF, InData%failTime) + call RegPack(RF, InData%failTen) + call RegPack(RF, InData%failStatus) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine MD_UnPackFail(RF, OutData) + type(RegFile), intent(inout) :: RF + type(MD_Fail), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'MD_UnPackFail' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%IdNum); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%attachID); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%isRod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%lineIDs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%lineTops); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nLinesToDetach); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%failTime); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%failTen); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%failStatus); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine MD_CopyOutParmType(SrcOutParmTypeData, DstOutParmTypeData, CtrlCode, ErrStat, ErrMsg) + type(MD_OutParmType), intent(in) :: SrcOutParmTypeData + type(MD_OutParmType), intent(inout) :: DstOutParmTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'MD_CopyOutParmType' + ErrStat = ErrID_None + ErrMsg = '' + DstOutParmTypeData%Name = SrcOutParmTypeData%Name + DstOutParmTypeData%Units = SrcOutParmTypeData%Units + DstOutParmTypeData%QType = SrcOutParmTypeData%QType + DstOutParmTypeData%OType = SrcOutParmTypeData%OType + DstOutParmTypeData%NodeID = SrcOutParmTypeData%NodeID + DstOutParmTypeData%ObjID = SrcOutParmTypeData%ObjID +end subroutine + +subroutine MD_DestroyOutParmType(OutParmTypeData, ErrStat, ErrMsg) + type(MD_OutParmType), intent(inout) :: OutParmTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'MD_DestroyOutParmType' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine MD_PackOutParmType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(MD_OutParmType), intent(in) :: InData + character(*), parameter :: RoutineName = 'MD_PackOutParmType' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%Name) + call RegPack(RF, InData%Units) + call RegPack(RF, InData%QType) + call RegPack(RF, InData%OType) + call RegPack(RF, InData%NodeID) + call RegPack(RF, InData%ObjID) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine MD_UnPackOutParmType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(MD_OutParmType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'MD_UnPackOutParmType' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%Name); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Units); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%QType); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OType); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NodeID); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ObjID); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine MD_CopyVisDiam(SrcVisDiamData, DstVisDiamData, CtrlCode, ErrStat, ErrMsg) + type(VisDiam), intent(in) :: SrcVisDiamData + type(VisDiam), intent(inout) :: DstVisDiamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'MD_CopyVisDiam' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcVisDiamData%Diam)) then + LB(1:1) = lbound(SrcVisDiamData%Diam) + UB(1:1) = ubound(SrcVisDiamData%Diam) + if (.not. allocated(DstVisDiamData%Diam)) then + allocate(DstVisDiamData%Diam(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstVisDiamData%Diam.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstVisDiamData%Diam = SrcVisDiamData%Diam + end if +end subroutine + +subroutine MD_DestroyVisDiam(VisDiamData, ErrStat, ErrMsg) + type(VisDiam), intent(inout) :: VisDiamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'MD_DestroyVisDiam' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(VisDiamData%Diam)) then + deallocate(VisDiamData%Diam) + end if +end subroutine + +subroutine MD_PackVisDiam(RF, Indata) + type(RegFile), intent(inout) :: RF + type(VisDiam), intent(in) :: InData + character(*), parameter :: RoutineName = 'MD_PackVisDiam' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%Diam) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine MD_UnPackVisDiam(RF, OutData) + type(RegFile), intent(inout) :: RF + type(VisDiam), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'MD_UnPackVisDiam' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%Diam); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine MD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) + type(MD_InitOutputType), intent(in) :: SrcInitOutputData + type(MD_InitOutputType), intent(inout) :: DstInitOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'MD_CopyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcInitOutputData%writeOutputHdr)) then + LB(1:1) = lbound(SrcInitOutputData%writeOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%writeOutputHdr) + if (.not. allocated(DstInitOutputData%writeOutputHdr)) then + allocate(DstInitOutputData%writeOutputHdr(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitOutputData%writeOutputUnt)) then + LB(1:1) = lbound(SrcInitOutputData%writeOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%writeOutputUnt) + if (.not. allocated(DstInitOutputData%writeOutputUnt)) then + allocate(DstInitOutputData%writeOutputUnt(LB(1):UB(1)), 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 + end if + 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%CableCChanRqst)) then + LB(1:1) = lbound(SrcInitOutputData%CableCChanRqst) + UB(1:1) = ubound(SrcInitOutputData%CableCChanRqst) + if (.not. allocated(DstInitOutputData%CableCChanRqst)) then + allocate(DstInitOutputData%CableCChanRqst(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%CableCChanRqst.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%CableCChanRqst = SrcInitOutputData%CableCChanRqst + end if + if (allocated(SrcInitOutputData%LinNames_y)) then + LB(1:1) = lbound(SrcInitOutputData%LinNames_y) + UB(1:1) = ubound(SrcInitOutputData%LinNames_y) + if (.not. allocated(DstInitOutputData%LinNames_y)) then + allocate(DstInitOutputData%LinNames_y(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitOutputData%LinNames_x)) then + LB(1:1) = lbound(SrcInitOutputData%LinNames_x) + UB(1:1) = ubound(SrcInitOutputData%LinNames_x) + if (.not. allocated(DstInitOutputData%LinNames_x)) then + allocate(DstInitOutputData%LinNames_x(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitOutputData%LinNames_u)) then + LB(1:1) = lbound(SrcInitOutputData%LinNames_u) + UB(1:1) = ubound(SrcInitOutputData%LinNames_u) + if (.not. allocated(DstInitOutputData%LinNames_u)) then + allocate(DstInitOutputData%LinNames_u(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitOutputData%RotFrame_y)) then + LB(1:1) = lbound(SrcInitOutputData%RotFrame_y) + UB(1:1) = ubound(SrcInitOutputData%RotFrame_y) + if (.not. allocated(DstInitOutputData%RotFrame_y)) then + allocate(DstInitOutputData%RotFrame_y(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitOutputData%RotFrame_x)) then + LB(1:1) = lbound(SrcInitOutputData%RotFrame_x) + UB(1:1) = ubound(SrcInitOutputData%RotFrame_x) + if (.not. allocated(DstInitOutputData%RotFrame_x)) then + allocate(DstInitOutputData%RotFrame_x(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitOutputData%RotFrame_u)) then + LB(1:1) = lbound(SrcInitOutputData%RotFrame_u) + UB(1:1) = ubound(SrcInitOutputData%RotFrame_u) + if (.not. allocated(DstInitOutputData%RotFrame_u)) then + allocate(DstInitOutputData%RotFrame_u(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitOutputData%IsLoad_u)) then + LB(1:1) = lbound(SrcInitOutputData%IsLoad_u) + UB(1:1) = ubound(SrcInitOutputData%IsLoad_u) + if (.not. allocated(DstInitOutputData%IsLoad_u)) then + allocate(DstInitOutputData%IsLoad_u(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitOutputData%DerivOrder_x)) then + LB(1:1) = lbound(SrcInitOutputData%DerivOrder_x) + UB(1:1) = ubound(SrcInitOutputData%DerivOrder_x) + if (.not. allocated(DstInitOutputData%DerivOrder_x)) then + allocate(DstInitOutputData%DerivOrder_x(LB(1):UB(1)), 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 + end if +end subroutine + +subroutine MD_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(MD_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'MD_DestroyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InitOutputData%writeOutputHdr)) then + deallocate(InitOutputData%writeOutputHdr) + end if + if (allocated(InitOutputData%writeOutputUnt)) then + deallocate(InitOutputData%writeOutputUnt) + end if + call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(InitOutputData%CableCChanRqst)) then + deallocate(InitOutputData%CableCChanRqst) + end if + if (allocated(InitOutputData%LinNames_y)) then + deallocate(InitOutputData%LinNames_y) + end if + if (allocated(InitOutputData%LinNames_x)) then + deallocate(InitOutputData%LinNames_x) + end if + if (allocated(InitOutputData%LinNames_u)) then + deallocate(InitOutputData%LinNames_u) + end if + if (allocated(InitOutputData%RotFrame_y)) then + deallocate(InitOutputData%RotFrame_y) + end if + if (allocated(InitOutputData%RotFrame_x)) then + deallocate(InitOutputData%RotFrame_x) + end if + if (allocated(InitOutputData%RotFrame_u)) then + deallocate(InitOutputData%RotFrame_u) + end if + if (allocated(InitOutputData%IsLoad_u)) then + deallocate(InitOutputData%IsLoad_u) + end if + if (allocated(InitOutputData%DerivOrder_x)) then + deallocate(InitOutputData%DerivOrder_x) + end if +end subroutine + +subroutine MD_PackInitOutput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(MD_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'MD_PackInitOutput' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%writeOutputHdr) + call RegPackAlloc(RF, InData%writeOutputUnt) + call NWTC_Library_PackProgDesc(RF, InData%Ver) + call RegPackAlloc(RF, InData%CableCChanRqst) + call RegPackAlloc(RF, InData%LinNames_y) + call RegPackAlloc(RF, InData%LinNames_x) + call RegPackAlloc(RF, InData%LinNames_u) + call RegPackAlloc(RF, InData%RotFrame_y) + call RegPackAlloc(RF, InData%RotFrame_x) + call RegPackAlloc(RF, InData%RotFrame_u) + call RegPackAlloc(RF, InData%IsLoad_u) + call RegPackAlloc(RF, InData%DerivOrder_x) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine MD_UnPackInitOutput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(MD_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'MD_UnPackInitOutput' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%writeOutputHdr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%writeOutputUnt); if (RegCheckErr(RF, RoutineName)) return + call NWTC_Library_UnpackProgDesc(RF, OutData%Ver) ! Ver + call RegUnpackAlloc(RF, OutData%CableCChanRqst); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LinNames_y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LinNames_x); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LinNames_u); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%RotFrame_y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%RotFrame_x); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%RotFrame_u); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%IsLoad_u); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%DerivOrder_x); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine MD_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) + type(MD_ContinuousStateType), intent(in) :: SrcContStateData + type(MD_ContinuousStateType), intent(inout) :: DstContStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'MD_CopyContState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcContStateData%states)) then + LB(1:1) = lbound(SrcContStateData%states) + UB(1:1) = ubound(SrcContStateData%states) + if (.not. allocated(DstContStateData%states)) then + allocate(DstContStateData%states(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%states.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstContStateData%states = SrcContStateData%states + end if +end subroutine + +subroutine MD_DestroyContState(ContStateData, ErrStat, ErrMsg) + type(MD_ContinuousStateType), intent(inout) :: ContStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'MD_DestroyContState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ContStateData%states)) then + deallocate(ContStateData%states) + end if +end subroutine + +subroutine MD_PackContState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(MD_ContinuousStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'MD_PackContState' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%states) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine MD_UnPackContState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(MD_ContinuousStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'MD_UnPackContState' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%states); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine MD_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) + type(MD_DiscreteStateType), intent(in) :: SrcDiscStateData + type(MD_DiscreteStateType), intent(inout) :: DstDiscStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'MD_CopyDiscState' + ErrStat = ErrID_None + ErrMsg = '' + DstDiscStateData%dummy = SrcDiscStateData%dummy +end subroutine + +subroutine MD_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) + type(MD_DiscreteStateType), intent(inout) :: DiscStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'MD_DestroyDiscState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine MD_PackDiscState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(MD_DiscreteStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'MD_PackDiscState' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%dummy) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine MD_UnPackDiscState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(MD_DiscreteStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'MD_UnPackDiscState' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%dummy); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine MD_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) + type(MD_ConstraintStateType), intent(in) :: SrcConstrStateData + type(MD_ConstraintStateType), intent(inout) :: DstConstrStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'MD_CopyConstrState' + ErrStat = ErrID_None + ErrMsg = '' + DstConstrStateData%dummy = SrcConstrStateData%dummy +end subroutine + +subroutine MD_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) + type(MD_ConstraintStateType), intent(inout) :: ConstrStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'MD_DestroyConstrState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine MD_PackConstrState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(MD_ConstraintStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'MD_PackConstrState' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%dummy) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine MD_UnPackConstrState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(MD_ConstraintStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'MD_UnPackConstrState' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%dummy); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine MD_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) + type(MD_OtherStateType), intent(in) :: SrcOtherStateData + type(MD_OtherStateType), intent(inout) :: DstOtherStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'MD_CopyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + DstOtherStateData%dummy = SrcOtherStateData%dummy +end subroutine + +subroutine MD_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) + type(MD_OtherStateType), intent(inout) :: OtherStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'MD_DestroyOtherState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine MD_PackOtherState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(MD_OtherStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'MD_PackOtherState' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%dummy) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine MD_UnPackOtherState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(MD_OtherStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'MD_UnPackOtherState' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%dummy); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine MD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(MD_MiscVarType), intent(in) :: SrcMiscData + type(MD_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'MD_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcMiscData%LineTypeList)) then + LB(1:1) = lbound(SrcMiscData%LineTypeList) + UB(1:1) = ubound(SrcMiscData%LineTypeList) + if (.not. allocated(DstMiscData%LineTypeList)) then + allocate(DstMiscData%LineTypeList(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%LineTypeList.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MD_CopyLineProp(SrcMiscData%LineTypeList(i1), DstMiscData%LineTypeList(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcMiscData%RodTypeList)) then + LB(1:1) = lbound(SrcMiscData%RodTypeList) + UB(1:1) = ubound(SrcMiscData%RodTypeList) + if (.not. allocated(DstMiscData%RodTypeList)) then + allocate(DstMiscData%RodTypeList(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%RodTypeList.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MD_CopyRodProp(SrcMiscData%RodTypeList(i1), DstMiscData%RodTypeList(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call MD_CopyBody(SrcMiscData%GroundBody, DstMiscData%GroundBody, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcMiscData%BodyList)) then + LB(1:1) = lbound(SrcMiscData%BodyList) + UB(1:1) = ubound(SrcMiscData%BodyList) + if (.not. allocated(DstMiscData%BodyList)) then + allocate(DstMiscData%BodyList(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BodyList.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MD_CopyBody(SrcMiscData%BodyList(i1), DstMiscData%BodyList(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcMiscData%RodList)) then + LB(1:1) = lbound(SrcMiscData%RodList) + UB(1:1) = ubound(SrcMiscData%RodList) + if (.not. allocated(DstMiscData%RodList)) then + allocate(DstMiscData%RodList(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%RodList.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MD_CopyRod(SrcMiscData%RodList(i1), DstMiscData%RodList(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcMiscData%PointList)) then + LB(1:1) = lbound(SrcMiscData%PointList) + UB(1:1) = ubound(SrcMiscData%PointList) + if (.not. allocated(DstMiscData%PointList)) then + allocate(DstMiscData%PointList(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%PointList.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MD_CopyPoint(SrcMiscData%PointList(i1), DstMiscData%PointList(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcMiscData%LineList)) then + LB(1:1) = lbound(SrcMiscData%LineList) + UB(1:1) = ubound(SrcMiscData%LineList) + if (.not. allocated(DstMiscData%LineList)) then + allocate(DstMiscData%LineList(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%LineList.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MD_CopyLine(SrcMiscData%LineList(i1), DstMiscData%LineList(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcMiscData%FailList)) then + LB(1:1) = lbound(SrcMiscData%FailList) + UB(1:1) = ubound(SrcMiscData%FailList) + if (.not. allocated(DstMiscData%FailList)) then + allocate(DstMiscData%FailList(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FailList.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MD_CopyFail(SrcMiscData%FailList(i1), DstMiscData%FailList(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcMiscData%FreePointIs)) then + LB(1:1) = lbound(SrcMiscData%FreePointIs) + UB(1:1) = ubound(SrcMiscData%FreePointIs) + if (.not. allocated(DstMiscData%FreePointIs)) then + allocate(DstMiscData%FreePointIs(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FreePointIs.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%FreePointIs = SrcMiscData%FreePointIs + end if + if (allocated(SrcMiscData%CpldPointIs)) then + LB(1:2) = lbound(SrcMiscData%CpldPointIs) + UB(1:2) = ubound(SrcMiscData%CpldPointIs) + if (.not. allocated(DstMiscData%CpldPointIs)) then + allocate(DstMiscData%CpldPointIs(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%CpldPointIs.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%CpldPointIs = SrcMiscData%CpldPointIs + end if + if (allocated(SrcMiscData%FreeRodIs)) then + LB(1:1) = lbound(SrcMiscData%FreeRodIs) + UB(1:1) = ubound(SrcMiscData%FreeRodIs) + if (.not. allocated(DstMiscData%FreeRodIs)) then + allocate(DstMiscData%FreeRodIs(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FreeRodIs.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%FreeRodIs = SrcMiscData%FreeRodIs + end if + if (allocated(SrcMiscData%CpldRodIs)) then + LB(1:2) = lbound(SrcMiscData%CpldRodIs) + UB(1:2) = ubound(SrcMiscData%CpldRodIs) + if (.not. allocated(DstMiscData%CpldRodIs)) then + allocate(DstMiscData%CpldRodIs(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%CpldRodIs.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%CpldRodIs = SrcMiscData%CpldRodIs + end if + if (allocated(SrcMiscData%FreeBodyIs)) then + LB(1:1) = lbound(SrcMiscData%FreeBodyIs) + UB(1:1) = ubound(SrcMiscData%FreeBodyIs) + if (.not. allocated(DstMiscData%FreeBodyIs)) then + allocate(DstMiscData%FreeBodyIs(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FreeBodyIs.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%FreeBodyIs = SrcMiscData%FreeBodyIs + end if + if (allocated(SrcMiscData%CpldBodyIs)) then + LB(1:2) = lbound(SrcMiscData%CpldBodyIs) + UB(1:2) = ubound(SrcMiscData%CpldBodyIs) + if (.not. allocated(DstMiscData%CpldBodyIs)) then + allocate(DstMiscData%CpldBodyIs(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%CpldBodyIs.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%CpldBodyIs = SrcMiscData%CpldBodyIs + end if + if (allocated(SrcMiscData%LineStateIs1)) then + LB(1:1) = lbound(SrcMiscData%LineStateIs1) + UB(1:1) = ubound(SrcMiscData%LineStateIs1) + if (.not. allocated(DstMiscData%LineStateIs1)) then + allocate(DstMiscData%LineStateIs1(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%LineStateIs1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%LineStateIs1 = SrcMiscData%LineStateIs1 + end if + if (allocated(SrcMiscData%LineStateIsN)) then + LB(1:1) = lbound(SrcMiscData%LineStateIsN) + UB(1:1) = ubound(SrcMiscData%LineStateIsN) + if (.not. allocated(DstMiscData%LineStateIsN)) then + allocate(DstMiscData%LineStateIsN(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%LineStateIsN.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%LineStateIsN = SrcMiscData%LineStateIsN + end if + if (allocated(SrcMiscData%PointStateIs1)) then + LB(1:1) = lbound(SrcMiscData%PointStateIs1) + UB(1:1) = ubound(SrcMiscData%PointStateIs1) + if (.not. allocated(DstMiscData%PointStateIs1)) then + allocate(DstMiscData%PointStateIs1(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%PointStateIs1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%PointStateIs1 = SrcMiscData%PointStateIs1 + end if + if (allocated(SrcMiscData%PointStateIsN)) then + LB(1:1) = lbound(SrcMiscData%PointStateIsN) + UB(1:1) = ubound(SrcMiscData%PointStateIsN) + if (.not. allocated(DstMiscData%PointStateIsN)) then + allocate(DstMiscData%PointStateIsN(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%PointStateIsN.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%PointStateIsN = SrcMiscData%PointStateIsN + end if + if (allocated(SrcMiscData%RodStateIs1)) then + LB(1:1) = lbound(SrcMiscData%RodStateIs1) + UB(1:1) = ubound(SrcMiscData%RodStateIs1) + if (.not. allocated(DstMiscData%RodStateIs1)) then + allocate(DstMiscData%RodStateIs1(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%RodStateIs1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%RodStateIs1 = SrcMiscData%RodStateIs1 + end if + if (allocated(SrcMiscData%RodStateIsN)) then + LB(1:1) = lbound(SrcMiscData%RodStateIsN) + UB(1:1) = ubound(SrcMiscData%RodStateIsN) + if (.not. allocated(DstMiscData%RodStateIsN)) then + allocate(DstMiscData%RodStateIsN(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%RodStateIsN.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%RodStateIsN = SrcMiscData%RodStateIsN + end if + if (allocated(SrcMiscData%BodyStateIs1)) then + LB(1:1) = lbound(SrcMiscData%BodyStateIs1) + UB(1:1) = ubound(SrcMiscData%BodyStateIs1) + if (.not. allocated(DstMiscData%BodyStateIs1)) then + allocate(DstMiscData%BodyStateIs1(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BodyStateIs1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%BodyStateIs1 = SrcMiscData%BodyStateIs1 + end if + if (allocated(SrcMiscData%BodyStateIsN)) then + LB(1:1) = lbound(SrcMiscData%BodyStateIsN) + UB(1:1) = ubound(SrcMiscData%BodyStateIsN) + if (.not. allocated(DstMiscData%BodyStateIsN)) then + allocate(DstMiscData%BodyStateIsN(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BodyStateIsN.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%BodyStateIsN = SrcMiscData%BodyStateIsN + end if + DstMiscData%Nx = SrcMiscData%Nx + DstMiscData%Nxtra = SrcMiscData%Nxtra + DstMiscData%WaveTi = SrcMiscData%WaveTi + call MD_CopyContState(SrcMiscData%xTemp, DstMiscData%xTemp, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MD_CopyContState(SrcMiscData%xdTemp, DstMiscData%xdTemp, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstMiscData%zeros6 = SrcMiscData%zeros6 + if (allocated(SrcMiscData%MDWrOutput)) then + LB(1:1) = lbound(SrcMiscData%MDWrOutput) + UB(1:1) = ubound(SrcMiscData%MDWrOutput) + if (.not. allocated(DstMiscData%MDWrOutput)) then + allocate(DstMiscData%MDWrOutput(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%MDWrOutput.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%MDWrOutput = SrcMiscData%MDWrOutput + end if + DstMiscData%LastOutTime = SrcMiscData%LastOutTime + DstMiscData%PtfmInit = SrcMiscData%PtfmInit + if (allocated(SrcMiscData%BathymetryGrid)) then + LB(1:2) = lbound(SrcMiscData%BathymetryGrid) + UB(1:2) = ubound(SrcMiscData%BathymetryGrid) + if (.not. allocated(DstMiscData%BathymetryGrid)) then + allocate(DstMiscData%BathymetryGrid(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BathymetryGrid.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%BathymetryGrid = SrcMiscData%BathymetryGrid + end if + if (allocated(SrcMiscData%BathGrid_Xs)) then + LB(1:1) = lbound(SrcMiscData%BathGrid_Xs) + UB(1:1) = ubound(SrcMiscData%BathGrid_Xs) + if (.not. allocated(DstMiscData%BathGrid_Xs)) then + allocate(DstMiscData%BathGrid_Xs(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BathGrid_Xs.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%BathGrid_Xs = SrcMiscData%BathGrid_Xs + end if + if (allocated(SrcMiscData%BathGrid_Ys)) then + LB(1:1) = lbound(SrcMiscData%BathGrid_Ys) + UB(1:1) = ubound(SrcMiscData%BathGrid_Ys) + if (.not. allocated(DstMiscData%BathGrid_Ys)) then + allocate(DstMiscData%BathGrid_Ys(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BathGrid_Ys.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%BathGrid_Ys = SrcMiscData%BathGrid_Ys + end if + if (allocated(SrcMiscData%BathGrid_npoints)) then + LB(1:1) = lbound(SrcMiscData%BathGrid_npoints) + UB(1:1) = ubound(SrcMiscData%BathGrid_npoints) + if (.not. allocated(DstMiscData%BathGrid_npoints)) then + allocate(DstMiscData%BathGrid_npoints(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BathGrid_npoints.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%BathGrid_npoints = SrcMiscData%BathGrid_npoints + end if +end subroutine + +subroutine MD_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(MD_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'MD_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(MiscData%LineTypeList)) then + LB(1:1) = lbound(MiscData%LineTypeList) + UB(1:1) = ubound(MiscData%LineTypeList) + do i1 = LB(1), UB(1) + call MD_DestroyLineProp(MiscData%LineTypeList(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%LineTypeList) + end if + if (allocated(MiscData%RodTypeList)) then + LB(1:1) = lbound(MiscData%RodTypeList) + UB(1:1) = ubound(MiscData%RodTypeList) + do i1 = LB(1), UB(1) + call MD_DestroyRodProp(MiscData%RodTypeList(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%RodTypeList) + end if + call MD_DestroyBody(MiscData%GroundBody, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(MiscData%BodyList)) then + LB(1:1) = lbound(MiscData%BodyList) + UB(1:1) = ubound(MiscData%BodyList) + do i1 = LB(1), UB(1) + call MD_DestroyBody(MiscData%BodyList(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%BodyList) + end if + if (allocated(MiscData%RodList)) then + LB(1:1) = lbound(MiscData%RodList) + UB(1:1) = ubound(MiscData%RodList) + do i1 = LB(1), UB(1) + call MD_DestroyRod(MiscData%RodList(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%RodList) + end if + if (allocated(MiscData%PointList)) then + LB(1:1) = lbound(MiscData%PointList) + UB(1:1) = ubound(MiscData%PointList) + do i1 = LB(1), UB(1) + call MD_DestroyPoint(MiscData%PointList(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%PointList) + end if + if (allocated(MiscData%LineList)) then + LB(1:1) = lbound(MiscData%LineList) + UB(1:1) = ubound(MiscData%LineList) + do i1 = LB(1), UB(1) + call MD_DestroyLine(MiscData%LineList(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%LineList) + end if + if (allocated(MiscData%FailList)) then + LB(1:1) = lbound(MiscData%FailList) + UB(1:1) = ubound(MiscData%FailList) + do i1 = LB(1), UB(1) + call MD_DestroyFail(MiscData%FailList(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%FailList) + end if + if (allocated(MiscData%FreePointIs)) then + deallocate(MiscData%FreePointIs) + end if + if (allocated(MiscData%CpldPointIs)) then + deallocate(MiscData%CpldPointIs) + end if + if (allocated(MiscData%FreeRodIs)) then + deallocate(MiscData%FreeRodIs) + end if + if (allocated(MiscData%CpldRodIs)) then + deallocate(MiscData%CpldRodIs) + end if + if (allocated(MiscData%FreeBodyIs)) then + deallocate(MiscData%FreeBodyIs) + end if + if (allocated(MiscData%CpldBodyIs)) then + deallocate(MiscData%CpldBodyIs) + end if + if (allocated(MiscData%LineStateIs1)) then + deallocate(MiscData%LineStateIs1) + end if + if (allocated(MiscData%LineStateIsN)) then + deallocate(MiscData%LineStateIsN) + end if + if (allocated(MiscData%PointStateIs1)) then + deallocate(MiscData%PointStateIs1) + end if + if (allocated(MiscData%PointStateIsN)) then + deallocate(MiscData%PointStateIsN) + end if + if (allocated(MiscData%RodStateIs1)) then + deallocate(MiscData%RodStateIs1) + end if + if (allocated(MiscData%RodStateIsN)) then + deallocate(MiscData%RodStateIsN) + end if + if (allocated(MiscData%BodyStateIs1)) then + deallocate(MiscData%BodyStateIs1) + end if + if (allocated(MiscData%BodyStateIsN)) then + deallocate(MiscData%BodyStateIsN) + end if + call MD_DestroyContState(MiscData%xTemp, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MD_DestroyContState(MiscData%xdTemp, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(MiscData%MDWrOutput)) then + deallocate(MiscData%MDWrOutput) + end if + if (allocated(MiscData%BathymetryGrid)) then + deallocate(MiscData%BathymetryGrid) + end if + if (allocated(MiscData%BathGrid_Xs)) then + deallocate(MiscData%BathGrid_Xs) + end if + if (allocated(MiscData%BathGrid_Ys)) then + deallocate(MiscData%BathGrid_Ys) + end if + if (allocated(MiscData%BathGrid_npoints)) then + deallocate(MiscData%BathGrid_npoints) + end if +end subroutine + +subroutine MD_PackMisc(RF, Indata) + type(RegFile), intent(inout) :: RF + type(MD_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'MD_PackMisc' + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%LineTypeList)) + if (allocated(InData%LineTypeList)) then + call RegPackBounds(RF, 1, lbound(InData%LineTypeList), ubound(InData%LineTypeList)) + LB(1:1) = lbound(InData%LineTypeList) + UB(1:1) = ubound(InData%LineTypeList) + do i1 = LB(1), UB(1) + call MD_PackLineProp(RF, InData%LineTypeList(i1)) + end do + end if + call RegPack(RF, allocated(InData%RodTypeList)) + if (allocated(InData%RodTypeList)) then + call RegPackBounds(RF, 1, lbound(InData%RodTypeList), ubound(InData%RodTypeList)) + LB(1:1) = lbound(InData%RodTypeList) + UB(1:1) = ubound(InData%RodTypeList) + do i1 = LB(1), UB(1) + call MD_PackRodProp(RF, InData%RodTypeList(i1)) + end do + end if + call MD_PackBody(RF, InData%GroundBody) + call RegPack(RF, allocated(InData%BodyList)) + if (allocated(InData%BodyList)) then + call RegPackBounds(RF, 1, lbound(InData%BodyList), ubound(InData%BodyList)) + LB(1:1) = lbound(InData%BodyList) + UB(1:1) = ubound(InData%BodyList) + do i1 = LB(1), UB(1) + call MD_PackBody(RF, InData%BodyList(i1)) + end do + end if + call RegPack(RF, allocated(InData%RodList)) + if (allocated(InData%RodList)) then + call RegPackBounds(RF, 1, lbound(InData%RodList), ubound(InData%RodList)) + LB(1:1) = lbound(InData%RodList) + UB(1:1) = ubound(InData%RodList) + do i1 = LB(1), UB(1) + call MD_PackRod(RF, InData%RodList(i1)) + end do + end if + call RegPack(RF, allocated(InData%PointList)) + if (allocated(InData%PointList)) then + call RegPackBounds(RF, 1, lbound(InData%PointList), ubound(InData%PointList)) + LB(1:1) = lbound(InData%PointList) + UB(1:1) = ubound(InData%PointList) + do i1 = LB(1), UB(1) + call MD_PackPoint(RF, InData%PointList(i1)) + end do + end if + call RegPack(RF, allocated(InData%LineList)) + if (allocated(InData%LineList)) then + call RegPackBounds(RF, 1, lbound(InData%LineList), ubound(InData%LineList)) + LB(1:1) = lbound(InData%LineList) + UB(1:1) = ubound(InData%LineList) + do i1 = LB(1), UB(1) + call MD_PackLine(RF, InData%LineList(i1)) + end do + end if + call RegPack(RF, allocated(InData%FailList)) + if (allocated(InData%FailList)) then + call RegPackBounds(RF, 1, lbound(InData%FailList), ubound(InData%FailList)) + LB(1:1) = lbound(InData%FailList) + UB(1:1) = ubound(InData%FailList) + do i1 = LB(1), UB(1) + call MD_PackFail(RF, InData%FailList(i1)) + end do + end if + call RegPackAlloc(RF, InData%FreePointIs) + call RegPackAlloc(RF, InData%CpldPointIs) + call RegPackAlloc(RF, InData%FreeRodIs) + call RegPackAlloc(RF, InData%CpldRodIs) + call RegPackAlloc(RF, InData%FreeBodyIs) + call RegPackAlloc(RF, InData%CpldBodyIs) + call RegPackAlloc(RF, InData%LineStateIs1) + call RegPackAlloc(RF, InData%LineStateIsN) + call RegPackAlloc(RF, InData%PointStateIs1) + call RegPackAlloc(RF, InData%PointStateIsN) + call RegPackAlloc(RF, InData%RodStateIs1) + call RegPackAlloc(RF, InData%RodStateIsN) + call RegPackAlloc(RF, InData%BodyStateIs1) + call RegPackAlloc(RF, InData%BodyStateIsN) + call RegPack(RF, InData%Nx) + call RegPack(RF, InData%Nxtra) + call RegPack(RF, InData%WaveTi) + call MD_PackContState(RF, InData%xTemp) + call MD_PackContState(RF, InData%xdTemp) + call RegPack(RF, InData%zeros6) + call RegPackAlloc(RF, InData%MDWrOutput) + call RegPack(RF, InData%LastOutTime) + call RegPack(RF, InData%PtfmInit) + call RegPackAlloc(RF, InData%BathymetryGrid) + call RegPackAlloc(RF, InData%BathGrid_Xs) + call RegPackAlloc(RF, InData%BathGrid_Ys) + call RegPackAlloc(RF, InData%BathGrid_npoints) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine MD_UnPackMisc(RF, OutData) + type(RegFile), intent(inout) :: RF + type(MD_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'MD_UnPackMisc' + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + if (allocated(OutData%LineTypeList)) deallocate(OutData%LineTypeList) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%LineTypeList(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LineTypeList.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MD_UnpackLineProp(RF, OutData%LineTypeList(i1)) ! LineTypeList + end do + end if + if (allocated(OutData%RodTypeList)) deallocate(OutData%RodTypeList) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%RodTypeList(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RodTypeList.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MD_UnpackRodProp(RF, OutData%RodTypeList(i1)) ! RodTypeList + end do + end if + call MD_UnpackBody(RF, OutData%GroundBody) ! GroundBody + if (allocated(OutData%BodyList)) deallocate(OutData%BodyList) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%BodyList(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BodyList.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MD_UnpackBody(RF, OutData%BodyList(i1)) ! BodyList + end do + end if + if (allocated(OutData%RodList)) deallocate(OutData%RodList) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%RodList(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RodList.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MD_UnpackRod(RF, OutData%RodList(i1)) ! RodList + end do + end if + if (allocated(OutData%PointList)) deallocate(OutData%PointList) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%PointList(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PointList.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MD_UnpackPoint(RF, OutData%PointList(i1)) ! PointList + end do + end if + if (allocated(OutData%LineList)) deallocate(OutData%LineList) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%LineList(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LineList.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MD_UnpackLine(RF, OutData%LineList(i1)) ! LineList + end do + end if + if (allocated(OutData%FailList)) deallocate(OutData%FailList) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%FailList(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FailList.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MD_UnpackFail(RF, OutData%FailList(i1)) ! FailList + end do + end if + call RegUnpackAlloc(RF, OutData%FreePointIs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%CpldPointIs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%FreeRodIs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%CpldRodIs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%FreeBodyIs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%CpldBodyIs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LineStateIs1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LineStateIsN); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PointStateIs1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PointStateIsN); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%RodStateIs1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%RodStateIsN); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BodyStateIs1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BodyStateIsN); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Nx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Nxtra); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WaveTi); if (RegCheckErr(RF, RoutineName)) return + call MD_UnpackContState(RF, OutData%xTemp) ! xTemp + call MD_UnpackContState(RF, OutData%xdTemp) ! xdTemp + call RegUnpack(RF, OutData%zeros6); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%MDWrOutput); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LastOutTime); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PtfmInit); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BathymetryGrid); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BathGrid_Xs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BathGrid_Ys); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BathGrid_npoints); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine MD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(MD_ParameterType), intent(in) :: SrcParamData + type(MD_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2, i3, i4 + integer(B4Ki) :: LB(4), UB(4) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'MD_CopyParam' + ErrStat = ErrID_None + ErrMsg = '' + DstParamData%nLineTypes = SrcParamData%nLineTypes + DstParamData%nRodTypes = SrcParamData%nRodTypes + DstParamData%nPoints = SrcParamData%nPoints + DstParamData%nPointsExtra = SrcParamData%nPointsExtra + DstParamData%nBodies = SrcParamData%nBodies + DstParamData%nRods = SrcParamData%nRods + DstParamData%nLines = SrcParamData%nLines + DstParamData%nCtrlChans = SrcParamData%nCtrlChans + DstParamData%nFails = SrcParamData%nFails + DstParamData%nFreeBodies = SrcParamData%nFreeBodies + DstParamData%nFreeRods = SrcParamData%nFreeRods + DstParamData%nFreePoints = SrcParamData%nFreePoints + if (allocated(SrcParamData%nCpldBodies)) then + LB(1:1) = lbound(SrcParamData%nCpldBodies) + UB(1:1) = ubound(SrcParamData%nCpldBodies) + if (.not. allocated(DstParamData%nCpldBodies)) then + allocate(DstParamData%nCpldBodies(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%nCpldBodies.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%nCpldBodies = SrcParamData%nCpldBodies + end if + if (allocated(SrcParamData%nCpldRods)) then + LB(1:1) = lbound(SrcParamData%nCpldRods) + UB(1:1) = ubound(SrcParamData%nCpldRods) + if (.not. allocated(DstParamData%nCpldRods)) then + allocate(DstParamData%nCpldRods(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%nCpldRods.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%nCpldRods = SrcParamData%nCpldRods + end if + if (allocated(SrcParamData%nCpldPoints)) then + LB(1:1) = lbound(SrcParamData%nCpldPoints) + UB(1:1) = ubound(SrcParamData%nCpldPoints) + if (.not. allocated(DstParamData%nCpldPoints)) then + allocate(DstParamData%nCpldPoints(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%nCpldPoints.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%nCpldPoints = SrcParamData%nCpldPoints + end if + DstParamData%NConns = SrcParamData%NConns + DstParamData%NAnchs = SrcParamData%NAnchs + DstParamData%Tmax = SrcParamData%Tmax + DstParamData%g = SrcParamData%g + DstParamData%rhoW = SrcParamData%rhoW + DstParamData%WtrDpth = SrcParamData%WtrDpth + DstParamData%kBot = SrcParamData%kBot + DstParamData%cBot = SrcParamData%cBot + DstParamData%dtM0 = SrcParamData%dtM0 + DstParamData%dtCoupling = SrcParamData%dtCoupling + DstParamData%NumOuts = SrcParamData%NumOuts + DstParamData%dtOut = SrcParamData%dtOut + DstParamData%RootName = SrcParamData%RootName + if (allocated(SrcParamData%OutParam)) then + LB(1:1) = lbound(SrcParamData%OutParam) + UB(1:1) = ubound(SrcParamData%OutParam) + if (.not. allocated(DstParamData%OutParam)) then + allocate(DstParamData%OutParam(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutParam.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MD_CopyOutParmType(SrcParamData%OutParam(i1), DstParamData%OutParam(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + DstParamData%Delim = SrcParamData%Delim + DstParamData%MDUnOut = SrcParamData%MDUnOut + DstParamData%PriPath = SrcParamData%PriPath + DstParamData%writeLog = SrcParamData%writeLog + DstParamData%UnLog = SrcParamData%UnLog + DstParamData%WaveKin = SrcParamData%WaveKin + DstParamData%Current = SrcParamData%Current + DstParamData%nTurbines = SrcParamData%nTurbines + if (allocated(SrcParamData%TurbineRefPos)) then + LB(1:2) = lbound(SrcParamData%TurbineRefPos) + UB(1:2) = ubound(SrcParamData%TurbineRefPos) + if (.not. allocated(DstParamData%TurbineRefPos)) then + allocate(DstParamData%TurbineRefPos(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TurbineRefPos.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%TurbineRefPos = SrcParamData%TurbineRefPos + end if + DstParamData%mu_kT = SrcParamData%mu_kT + DstParamData%mu_kA = SrcParamData%mu_kA + DstParamData%mc = SrcParamData%mc + DstParamData%cv = SrcParamData%cv + DstParamData%inertialF = SrcParamData%inertialF + DstParamData%inertialF_rampT = SrcParamData%inertialF_rampT + DstParamData%nxWave = SrcParamData%nxWave + DstParamData%nyWave = SrcParamData%nyWave + DstParamData%nzWave = SrcParamData%nzWave + DstParamData%ntWave = SrcParamData%ntWave + if (allocated(SrcParamData%pxWave)) then + LB(1:1) = lbound(SrcParamData%pxWave) + UB(1:1) = ubound(SrcParamData%pxWave) + if (.not. allocated(DstParamData%pxWave)) then + allocate(DstParamData%pxWave(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%pxWave.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%pxWave = SrcParamData%pxWave + end if + if (allocated(SrcParamData%pyWave)) then + LB(1:1) = lbound(SrcParamData%pyWave) + UB(1:1) = ubound(SrcParamData%pyWave) + if (.not. allocated(DstParamData%pyWave)) then + allocate(DstParamData%pyWave(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%pyWave.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%pyWave = SrcParamData%pyWave + end if + if (allocated(SrcParamData%pzWave)) then + LB(1:1) = lbound(SrcParamData%pzWave) + UB(1:1) = ubound(SrcParamData%pzWave) + if (.not. allocated(DstParamData%pzWave)) then + allocate(DstParamData%pzWave(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%pzWave.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%pzWave = SrcParamData%pzWave + end if + DstParamData%dtWave = SrcParamData%dtWave + if (allocated(SrcParamData%uxWave)) then + LB(1:4) = lbound(SrcParamData%uxWave) + UB(1:4) = ubound(SrcParamData%uxWave) + if (.not. allocated(DstParamData%uxWave)) then + allocate(DstParamData%uxWave(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%uxWave.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%uxWave = SrcParamData%uxWave + end if + if (allocated(SrcParamData%uyWave)) then + LB(1:4) = lbound(SrcParamData%uyWave) + UB(1:4) = ubound(SrcParamData%uyWave) + if (.not. allocated(DstParamData%uyWave)) then + allocate(DstParamData%uyWave(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%uyWave.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%uyWave = SrcParamData%uyWave + end if + if (allocated(SrcParamData%uzWave)) then + LB(1:4) = lbound(SrcParamData%uzWave) + UB(1:4) = ubound(SrcParamData%uzWave) + if (.not. allocated(DstParamData%uzWave)) then + allocate(DstParamData%uzWave(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%uzWave.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%uzWave = SrcParamData%uzWave + end if + if (allocated(SrcParamData%axWave)) then + LB(1:4) = lbound(SrcParamData%axWave) + UB(1:4) = ubound(SrcParamData%axWave) + if (.not. allocated(DstParamData%axWave)) then + allocate(DstParamData%axWave(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%axWave.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%axWave = SrcParamData%axWave + end if + if (allocated(SrcParamData%ayWave)) then + LB(1:4) = lbound(SrcParamData%ayWave) + UB(1:4) = ubound(SrcParamData%ayWave) + if (.not. allocated(DstParamData%ayWave)) then + allocate(DstParamData%ayWave(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ayWave.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%ayWave = SrcParamData%ayWave + end if + if (allocated(SrcParamData%azWave)) then + LB(1:4) = lbound(SrcParamData%azWave) + UB(1:4) = ubound(SrcParamData%azWave) + if (.not. allocated(DstParamData%azWave)) then + allocate(DstParamData%azWave(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%azWave.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%azWave = SrcParamData%azWave + end if + if (allocated(SrcParamData%PDyn)) then + LB(1:4) = lbound(SrcParamData%PDyn) + UB(1:4) = ubound(SrcParamData%PDyn) + if (.not. allocated(DstParamData%PDyn)) then + allocate(DstParamData%PDyn(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%PDyn.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%PDyn = SrcParamData%PDyn + end if + if (allocated(SrcParamData%zeta)) then + LB(1:3) = lbound(SrcParamData%zeta) + UB(1:3) = ubound(SrcParamData%zeta) + if (.not. allocated(DstParamData%zeta)) then + allocate(DstParamData%zeta(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%zeta.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%zeta = SrcParamData%zeta + end if + DstParamData%nzCurrent = SrcParamData%nzCurrent + if (allocated(SrcParamData%pzCurrent)) then + LB(1:1) = lbound(SrcParamData%pzCurrent) + UB(1:1) = ubound(SrcParamData%pzCurrent) + if (.not. allocated(DstParamData%pzCurrent)) then + allocate(DstParamData%pzCurrent(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%pzCurrent.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%pzCurrent = SrcParamData%pzCurrent + end if + if (allocated(SrcParamData%uxCurrent)) then + LB(1:1) = lbound(SrcParamData%uxCurrent) + UB(1:1) = ubound(SrcParamData%uxCurrent) + if (.not. allocated(DstParamData%uxCurrent)) then + allocate(DstParamData%uxCurrent(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%uxCurrent.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%uxCurrent = SrcParamData%uxCurrent + end if + if (allocated(SrcParamData%uyCurrent)) then + LB(1:1) = lbound(SrcParamData%uyCurrent) + UB(1:1) = ubound(SrcParamData%uyCurrent) + if (.not. allocated(DstParamData%uyCurrent)) then + allocate(DstParamData%uyCurrent(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%uyCurrent.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%uyCurrent = SrcParamData%uyCurrent + end if + DstParamData%Nx0 = SrcParamData%Nx0 + if (allocated(SrcParamData%Jac_u_indx)) then + LB(1:2) = lbound(SrcParamData%Jac_u_indx) + UB(1:2) = ubound(SrcParamData%Jac_u_indx) + if (.not. allocated(DstParamData%Jac_u_indx)) then + allocate(DstParamData%Jac_u_indx(LB(1):UB(1),LB(2):UB(2)), 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 + end if + if (allocated(SrcParamData%du)) then + LB(1:1) = lbound(SrcParamData%du) + UB(1:1) = ubound(SrcParamData%du) + if (.not. allocated(DstParamData%du)) then + allocate(DstParamData%du(LB(1):UB(1)), 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 + end if + if (allocated(SrcParamData%dx)) then + LB(1:1) = lbound(SrcParamData%dx) + UB(1:1) = ubound(SrcParamData%dx) + if (.not. allocated(DstParamData%dx)) then + allocate(DstParamData%dx(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%dx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%dx = SrcParamData%dx + end if + DstParamData%Jac_ny = SrcParamData%Jac_ny + DstParamData%Jac_nx = SrcParamData%Jac_nx + if (allocated(SrcParamData%dxIdx_map2_xStateIdx)) then + LB(1:1) = lbound(SrcParamData%dxIdx_map2_xStateIdx) + UB(1:1) = ubound(SrcParamData%dxIdx_map2_xStateIdx) + if (.not. allocated(DstParamData%dxIdx_map2_xStateIdx)) then + allocate(DstParamData%dxIdx_map2_xStateIdx(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%dxIdx_map2_xStateIdx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%dxIdx_map2_xStateIdx = SrcParamData%dxIdx_map2_xStateIdx + end if + DstParamData%VisMeshes = SrcParamData%VisMeshes + if (allocated(SrcParamData%VisRodsDiam)) then + LB(1:1) = lbound(SrcParamData%VisRodsDiam) + UB(1:1) = ubound(SrcParamData%VisRodsDiam) + if (.not. allocated(DstParamData%VisRodsDiam)) then + allocate(DstParamData%VisRodsDiam(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%VisRodsDiam.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MD_CopyVisDiam(SrcParamData%VisRodsDiam(i1), DstParamData%VisRodsDiam(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if +end subroutine + +subroutine MD_DestroyParam(ParamData, ErrStat, ErrMsg) + type(MD_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2, i3, i4 + integer(B4Ki) :: LB(4), UB(4) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'MD_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ParamData%nCpldBodies)) then + deallocate(ParamData%nCpldBodies) + end if + if (allocated(ParamData%nCpldRods)) then + deallocate(ParamData%nCpldRods) + end if + if (allocated(ParamData%nCpldPoints)) then + deallocate(ParamData%nCpldPoints) + end if + if (allocated(ParamData%OutParam)) then + LB(1:1) = lbound(ParamData%OutParam) + UB(1:1) = ubound(ParamData%OutParam) + do i1 = LB(1), UB(1) + call MD_DestroyOutParmType(ParamData%OutParam(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%OutParam) + end if + if (allocated(ParamData%TurbineRefPos)) then + deallocate(ParamData%TurbineRefPos) + end if + if (allocated(ParamData%pxWave)) then + deallocate(ParamData%pxWave) + end if + if (allocated(ParamData%pyWave)) then + deallocate(ParamData%pyWave) + end if + if (allocated(ParamData%pzWave)) then + deallocate(ParamData%pzWave) + end if + if (allocated(ParamData%uxWave)) then + deallocate(ParamData%uxWave) + end if + if (allocated(ParamData%uyWave)) then + deallocate(ParamData%uyWave) + end if + if (allocated(ParamData%uzWave)) then + deallocate(ParamData%uzWave) + end if + if (allocated(ParamData%axWave)) then + deallocate(ParamData%axWave) + end if + if (allocated(ParamData%ayWave)) then + deallocate(ParamData%ayWave) + end if + if (allocated(ParamData%azWave)) then + deallocate(ParamData%azWave) + end if + if (allocated(ParamData%PDyn)) then + deallocate(ParamData%PDyn) + end if + if (allocated(ParamData%zeta)) then + deallocate(ParamData%zeta) + end if + if (allocated(ParamData%pzCurrent)) then + deallocate(ParamData%pzCurrent) + end if + if (allocated(ParamData%uxCurrent)) then + deallocate(ParamData%uxCurrent) + end if + if (allocated(ParamData%uyCurrent)) then + deallocate(ParamData%uyCurrent) + end if + if (allocated(ParamData%Jac_u_indx)) then + deallocate(ParamData%Jac_u_indx) + end if + if (allocated(ParamData%du)) then + deallocate(ParamData%du) + end if + if (allocated(ParamData%dx)) then + deallocate(ParamData%dx) + end if + if (allocated(ParamData%dxIdx_map2_xStateIdx)) then + deallocate(ParamData%dxIdx_map2_xStateIdx) + end if + if (allocated(ParamData%VisRodsDiam)) then + LB(1:1) = lbound(ParamData%VisRodsDiam) + UB(1:1) = ubound(ParamData%VisRodsDiam) + do i1 = LB(1), UB(1) + call MD_DestroyVisDiam(ParamData%VisRodsDiam(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%VisRodsDiam) + end if +end subroutine + +subroutine MD_PackParam(RF, Indata) + type(RegFile), intent(inout) :: RF + type(MD_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'MD_PackParam' + integer(B4Ki) :: i1, i2, i3, i4 + integer(B4Ki) :: LB(4), UB(4) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%nLineTypes) + call RegPack(RF, InData%nRodTypes) + call RegPack(RF, InData%nPoints) + call RegPack(RF, InData%nPointsExtra) + call RegPack(RF, InData%nBodies) + call RegPack(RF, InData%nRods) + call RegPack(RF, InData%nLines) + call RegPack(RF, InData%nCtrlChans) + call RegPack(RF, InData%nFails) + call RegPack(RF, InData%nFreeBodies) + call RegPack(RF, InData%nFreeRods) + call RegPack(RF, InData%nFreePoints) + call RegPackAlloc(RF, InData%nCpldBodies) + call RegPackAlloc(RF, InData%nCpldRods) + call RegPackAlloc(RF, InData%nCpldPoints) + call RegPack(RF, InData%NConns) + call RegPack(RF, InData%NAnchs) + call RegPack(RF, InData%Tmax) + call RegPack(RF, InData%g) + call RegPack(RF, InData%rhoW) + call RegPack(RF, InData%WtrDpth) + call RegPack(RF, InData%kBot) + call RegPack(RF, InData%cBot) + call RegPack(RF, InData%dtM0) + call RegPack(RF, InData%dtCoupling) + call RegPack(RF, InData%NumOuts) + call RegPack(RF, InData%dtOut) + call RegPack(RF, InData%RootName) + call RegPack(RF, allocated(InData%OutParam)) + if (allocated(InData%OutParam)) then + call RegPackBounds(RF, 1, lbound(InData%OutParam), ubound(InData%OutParam)) + LB(1:1) = lbound(InData%OutParam) + UB(1:1) = ubound(InData%OutParam) + do i1 = LB(1), UB(1) + call MD_PackOutParmType(RF, InData%OutParam(i1)) + end do + end if + call RegPack(RF, InData%Delim) + call RegPack(RF, InData%MDUnOut) + call RegPack(RF, InData%PriPath) + call RegPack(RF, InData%writeLog) + call RegPack(RF, InData%UnLog) + call RegPack(RF, InData%WaveKin) + call RegPack(RF, InData%Current) + call RegPack(RF, InData%nTurbines) + call RegPackAlloc(RF, InData%TurbineRefPos) + call RegPack(RF, InData%mu_kT) + call RegPack(RF, InData%mu_kA) + call RegPack(RF, InData%mc) + call RegPack(RF, InData%cv) + call RegPack(RF, InData%inertialF) + call RegPack(RF, InData%inertialF_rampT) + call RegPack(RF, InData%nxWave) + call RegPack(RF, InData%nyWave) + call RegPack(RF, InData%nzWave) + call RegPack(RF, InData%ntWave) + call RegPackAlloc(RF, InData%pxWave) + call RegPackAlloc(RF, InData%pyWave) + call RegPackAlloc(RF, InData%pzWave) + call RegPack(RF, InData%dtWave) + call RegPackAlloc(RF, InData%uxWave) + call RegPackAlloc(RF, InData%uyWave) + call RegPackAlloc(RF, InData%uzWave) + call RegPackAlloc(RF, InData%axWave) + call RegPackAlloc(RF, InData%ayWave) + call RegPackAlloc(RF, InData%azWave) + call RegPackAlloc(RF, InData%PDyn) + call RegPackAlloc(RF, InData%zeta) + call RegPack(RF, InData%nzCurrent) + call RegPackAlloc(RF, InData%pzCurrent) + call RegPackAlloc(RF, InData%uxCurrent) + call RegPackAlloc(RF, InData%uyCurrent) + call RegPack(RF, InData%Nx0) + call RegPackAlloc(RF, InData%Jac_u_indx) + call RegPackAlloc(RF, InData%du) + call RegPackAlloc(RF, InData%dx) + call RegPack(RF, InData%Jac_ny) + call RegPack(RF, InData%Jac_nx) + call RegPackAlloc(RF, InData%dxIdx_map2_xStateIdx) + call RegPack(RF, InData%VisMeshes) + call RegPack(RF, allocated(InData%VisRodsDiam)) + if (allocated(InData%VisRodsDiam)) then + call RegPackBounds(RF, 1, lbound(InData%VisRodsDiam), ubound(InData%VisRodsDiam)) + LB(1:1) = lbound(InData%VisRodsDiam) + UB(1:1) = ubound(InData%VisRodsDiam) + do i1 = LB(1), UB(1) + call MD_PackVisDiam(RF, InData%VisRodsDiam(i1)) + end do + end if + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine MD_UnPackParam(RF, OutData) + type(RegFile), intent(inout) :: RF + type(MD_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'MD_UnPackParam' + integer(B4Ki) :: i1, i2, i3, i4 + integer(B4Ki) :: LB(4), UB(4) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%nLineTypes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nRodTypes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nPoints); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nPointsExtra); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nBodies); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nRods); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nLines); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nCtrlChans); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nFails); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nFreeBodies); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nFreeRods); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nFreePoints); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%nCpldBodies); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%nCpldRods); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%nCpldPoints); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NConns); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NAnchs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Tmax); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%g); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rhoW); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WtrDpth); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%kBot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%cBot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%dtM0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%dtCoupling); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumOuts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%dtOut); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RootName); if (RegCheckErr(RF, RoutineName)) return + if (allocated(OutData%OutParam)) deallocate(OutData%OutParam) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%OutParam(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MD_UnpackOutParmType(RF, OutData%OutParam(i1)) ! OutParam + end do + end if + call RegUnpack(RF, OutData%Delim); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MDUnOut); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PriPath); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%writeLog); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UnLog); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WaveKin); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Current); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nTurbines); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TurbineRefPos); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%mu_kT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%mu_kA); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%mc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%cv); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%inertialF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%inertialF_rampT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nxWave); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nyWave); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nzWave); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ntWave); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%pxWave); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%pyWave); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%pzWave); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%dtWave); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%uxWave); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%uyWave); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%uzWave); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%axWave); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ayWave); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%azWave); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PDyn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%zeta); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nzCurrent); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%pzCurrent); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%uxCurrent); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%uyCurrent); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Nx0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Jac_u_indx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%du); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Jac_ny); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Jac_nx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dxIdx_map2_xStateIdx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VisMeshes); if (RegCheckErr(RF, RoutineName)) return + if (allocated(OutData%VisRodsDiam)) deallocate(OutData%VisRodsDiam) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%VisRodsDiam(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%VisRodsDiam.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MD_UnpackVisDiam(RF, OutData%VisRodsDiam(i1)) ! VisRodsDiam + end do + end if +end subroutine + +subroutine MD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) + type(MD_InputType), intent(inout) :: SrcInputData + type(MD_InputType), intent(inout) :: DstInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'MD_CopyInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcInputData%CoupledKinematics)) then + LB(1:1) = lbound(SrcInputData%CoupledKinematics) + UB(1:1) = ubound(SrcInputData%CoupledKinematics) + if (.not. allocated(DstInputData%CoupledKinematics)) then + allocate(DstInputData%CoupledKinematics(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%CoupledKinematics.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MeshCopy(SrcInputData%CoupledKinematics(i1), DstInputData%CoupledKinematics(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcInputData%DeltaL)) then + LB(1:1) = lbound(SrcInputData%DeltaL) + UB(1:1) = ubound(SrcInputData%DeltaL) + if (.not. allocated(DstInputData%DeltaL)) then + allocate(DstInputData%DeltaL(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%DeltaL.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%DeltaL = SrcInputData%DeltaL + end if + if (allocated(SrcInputData%DeltaLdot)) then + LB(1:1) = lbound(SrcInputData%DeltaLdot) + UB(1:1) = ubound(SrcInputData%DeltaLdot) + if (.not. allocated(DstInputData%DeltaLdot)) then + allocate(DstInputData%DeltaLdot(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%DeltaLdot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%DeltaLdot = SrcInputData%DeltaLdot + end if +end subroutine + +subroutine MD_DestroyInput(InputData, ErrStat, ErrMsg) + type(MD_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'MD_DestroyInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InputData%CoupledKinematics)) then + LB(1:1) = lbound(InputData%CoupledKinematics) + UB(1:1) = ubound(InputData%CoupledKinematics) + do i1 = LB(1), UB(1) + call MeshDestroy( InputData%CoupledKinematics(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InputData%CoupledKinematics) + end if + if (allocated(InputData%DeltaL)) then + deallocate(InputData%DeltaL) + end if + if (allocated(InputData%DeltaLdot)) then + deallocate(InputData%DeltaLdot) + end if +end subroutine + +subroutine MD_PackInput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(MD_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'MD_PackInput' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%CoupledKinematics)) + if (allocated(InData%CoupledKinematics)) then + call RegPackBounds(RF, 1, lbound(InData%CoupledKinematics), ubound(InData%CoupledKinematics)) + LB(1:1) = lbound(InData%CoupledKinematics) + UB(1:1) = ubound(InData%CoupledKinematics) + do i1 = LB(1), UB(1) + call MeshPack(RF, InData%CoupledKinematics(i1)) + end do + end if + call RegPackAlloc(RF, InData%DeltaL) + call RegPackAlloc(RF, InData%DeltaLdot) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine MD_UnPackInput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(MD_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'MD_UnPackInput' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + if (allocated(OutData%CoupledKinematics)) deallocate(OutData%CoupledKinematics) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%CoupledKinematics(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CoupledKinematics.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(RF, OutData%CoupledKinematics(i1)) ! CoupledKinematics + end do + end if + call RegUnpackAlloc(RF, OutData%DeltaL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%DeltaLdot); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine MD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(MD_OutputType), intent(inout) :: SrcOutputData + type(MD_OutputType), intent(inout) :: DstOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'MD_CopyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcOutputData%CoupledLoads)) then + LB(1:1) = lbound(SrcOutputData%CoupledLoads) + UB(1:1) = ubound(SrcOutputData%CoupledLoads) + if (.not. allocated(DstOutputData%CoupledLoads)) then + allocate(DstOutputData%CoupledLoads(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%CoupledLoads.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MeshCopy(SrcOutputData%CoupledLoads(i1), DstOutputData%CoupledLoads(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcOutputData%WriteOutput)) then + LB(1:1) = lbound(SrcOutputData%WriteOutput) + UB(1:1) = ubound(SrcOutputData%WriteOutput) + if (.not. allocated(DstOutputData%WriteOutput)) then + allocate(DstOutputData%WriteOutput(LB(1):UB(1)), 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 + end if + if (allocated(SrcOutputData%VisLinesMesh)) then + LB(1:1) = lbound(SrcOutputData%VisLinesMesh) + UB(1:1) = ubound(SrcOutputData%VisLinesMesh) + if (.not. allocated(DstOutputData%VisLinesMesh)) then + allocate(DstOutputData%VisLinesMesh(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%VisLinesMesh.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MeshCopy(SrcOutputData%VisLinesMesh(i1), DstOutputData%VisLinesMesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcOutputData%VisRodsMesh)) then + LB(1:1) = lbound(SrcOutputData%VisRodsMesh) + UB(1:1) = ubound(SrcOutputData%VisRodsMesh) + if (.not. allocated(DstOutputData%VisRodsMesh)) then + allocate(DstOutputData%VisRodsMesh(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%VisRodsMesh.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MeshCopy(SrcOutputData%VisRodsMesh(i1), DstOutputData%VisRodsMesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcOutputData%VisBodiesMesh)) then + LB(1:1) = lbound(SrcOutputData%VisBodiesMesh) + UB(1:1) = ubound(SrcOutputData%VisBodiesMesh) + if (.not. allocated(DstOutputData%VisBodiesMesh)) then + allocate(DstOutputData%VisBodiesMesh(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%VisBodiesMesh.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MeshCopy(SrcOutputData%VisBodiesMesh(i1), DstOutputData%VisBodiesMesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcOutputData%VisAnchsMesh)) then + LB(1:1) = lbound(SrcOutputData%VisAnchsMesh) + UB(1:1) = ubound(SrcOutputData%VisAnchsMesh) + if (.not. allocated(DstOutputData%VisAnchsMesh)) then + allocate(DstOutputData%VisAnchsMesh(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%VisAnchsMesh.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MeshCopy(SrcOutputData%VisAnchsMesh(i1), DstOutputData%VisAnchsMesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if +end subroutine + +subroutine MD_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(MD_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'MD_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OutputData%CoupledLoads)) then + LB(1:1) = lbound(OutputData%CoupledLoads) + UB(1:1) = ubound(OutputData%CoupledLoads) + do i1 = LB(1), UB(1) + call MeshDestroy( OutputData%CoupledLoads(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(OutputData%CoupledLoads) + end if + if (allocated(OutputData%WriteOutput)) then + deallocate(OutputData%WriteOutput) + end if + if (allocated(OutputData%VisLinesMesh)) then + LB(1:1) = lbound(OutputData%VisLinesMesh) + UB(1:1) = ubound(OutputData%VisLinesMesh) + do i1 = LB(1), UB(1) + call MeshDestroy( OutputData%VisLinesMesh(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(OutputData%VisLinesMesh) + end if + if (allocated(OutputData%VisRodsMesh)) then + LB(1:1) = lbound(OutputData%VisRodsMesh) + UB(1:1) = ubound(OutputData%VisRodsMesh) + do i1 = LB(1), UB(1) + call MeshDestroy( OutputData%VisRodsMesh(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(OutputData%VisRodsMesh) + end if + if (allocated(OutputData%VisBodiesMesh)) then + LB(1:1) = lbound(OutputData%VisBodiesMesh) + UB(1:1) = ubound(OutputData%VisBodiesMesh) + do i1 = LB(1), UB(1) + call MeshDestroy( OutputData%VisBodiesMesh(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(OutputData%VisBodiesMesh) + end if + if (allocated(OutputData%VisAnchsMesh)) then + LB(1:1) = lbound(OutputData%VisAnchsMesh) + UB(1:1) = ubound(OutputData%VisAnchsMesh) + do i1 = LB(1), UB(1) + call MeshDestroy( OutputData%VisAnchsMesh(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(OutputData%VisAnchsMesh) + end if +end subroutine + +subroutine MD_PackOutput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(MD_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'MD_PackOutput' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%CoupledLoads)) + if (allocated(InData%CoupledLoads)) then + call RegPackBounds(RF, 1, lbound(InData%CoupledLoads), ubound(InData%CoupledLoads)) + LB(1:1) = lbound(InData%CoupledLoads) + UB(1:1) = ubound(InData%CoupledLoads) + do i1 = LB(1), UB(1) + call MeshPack(RF, InData%CoupledLoads(i1)) + end do + end if + call RegPackAlloc(RF, InData%WriteOutput) + call RegPack(RF, allocated(InData%VisLinesMesh)) + if (allocated(InData%VisLinesMesh)) then + call RegPackBounds(RF, 1, lbound(InData%VisLinesMesh), ubound(InData%VisLinesMesh)) + LB(1:1) = lbound(InData%VisLinesMesh) + UB(1:1) = ubound(InData%VisLinesMesh) + do i1 = LB(1), UB(1) + call MeshPack(RF, InData%VisLinesMesh(i1)) + end do + end if + call RegPack(RF, allocated(InData%VisRodsMesh)) + if (allocated(InData%VisRodsMesh)) then + call RegPackBounds(RF, 1, lbound(InData%VisRodsMesh), ubound(InData%VisRodsMesh)) + LB(1:1) = lbound(InData%VisRodsMesh) + UB(1:1) = ubound(InData%VisRodsMesh) + do i1 = LB(1), UB(1) + call MeshPack(RF, InData%VisRodsMesh(i1)) + end do + end if + call RegPack(RF, allocated(InData%VisBodiesMesh)) + if (allocated(InData%VisBodiesMesh)) then + call RegPackBounds(RF, 1, lbound(InData%VisBodiesMesh), ubound(InData%VisBodiesMesh)) + LB(1:1) = lbound(InData%VisBodiesMesh) + UB(1:1) = ubound(InData%VisBodiesMesh) + do i1 = LB(1), UB(1) + call MeshPack(RF, InData%VisBodiesMesh(i1)) + end do + end if + call RegPack(RF, allocated(InData%VisAnchsMesh)) + if (allocated(InData%VisAnchsMesh)) then + call RegPackBounds(RF, 1, lbound(InData%VisAnchsMesh), ubound(InData%VisAnchsMesh)) + LB(1:1) = lbound(InData%VisAnchsMesh) + UB(1:1) = ubound(InData%VisAnchsMesh) + do i1 = LB(1), UB(1) + call MeshPack(RF, InData%VisAnchsMesh(i1)) + end do + end if + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine MD_UnPackOutput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(MD_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'MD_UnPackOutput' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + if (allocated(OutData%CoupledLoads)) deallocate(OutData%CoupledLoads) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%CoupledLoads(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CoupledLoads.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(RF, OutData%CoupledLoads(i1)) ! CoupledLoads + end do + end if + call RegUnpackAlloc(RF, OutData%WriteOutput); if (RegCheckErr(RF, RoutineName)) return + if (allocated(OutData%VisLinesMesh)) deallocate(OutData%VisLinesMesh) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%VisLinesMesh(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%VisLinesMesh.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(RF, OutData%VisLinesMesh(i1)) ! VisLinesMesh + end do + end if + if (allocated(OutData%VisRodsMesh)) deallocate(OutData%VisRodsMesh) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%VisRodsMesh(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%VisRodsMesh.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(RF, OutData%VisRodsMesh(i1)) ! VisRodsMesh + end do + end if + if (allocated(OutData%VisBodiesMesh)) deallocate(OutData%VisBodiesMesh) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%VisBodiesMesh(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%VisBodiesMesh.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(RF, OutData%VisBodiesMesh(i1)) ! VisBodiesMesh + end do + end if + if (allocated(OutData%VisAnchsMesh)) deallocate(OutData%VisAnchsMesh) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%VisAnchsMesh(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%VisAnchsMesh.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(RF, OutData%VisAnchsMesh(i1)) ! VisAnchsMesh + end do + end if +end subroutine + +subroutine MD_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(MD_InputType), intent(inout) :: u(:) ! Input at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Inputs + type(MD_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 = 'MD_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 MD_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL MD_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 MD_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 MD_Input_ExtrapInterp - - - SUBROUTINE MD_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'MD_Input_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(u)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(u)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(u) - 1 + select case (order) + case (0) + call MD_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call MD_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call MD_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(u) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE MD_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. @@ -14543,59 +4706,54 @@ SUBROUTINE MD_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) ! !.................................................................................................................................. - TYPE(MD_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 - TYPE(MD_InputType), INTENT(INOUT) :: u2 ! Input at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs - TYPE(MD_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 + TYPE(MD_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 + TYPE(MD_InputType), INTENT(INOUT) :: u2 ! Input at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs + TYPE(MD_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 = 'MD_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 + REAL(DbKi) :: t(2) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'MD_Input_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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%CoupledKinematics) .AND. ALLOCATED(u1%CoupledKinematics)) THEN - DO i1 = LBOUND(u_out%CoupledKinematics,1),UBOUND(u_out%CoupledKinematics,1) - CALL MeshExtrapInterp1(u1%CoupledKinematics(i1), u2%CoupledKinematics(i1), tin, u_out%CoupledKinematics(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated -IF (ALLOCATED(u_out%DeltaL) .AND. ALLOCATED(u1%DeltaL)) THEN - DO i1 = LBOUND(u_out%DeltaL,1),UBOUND(u_out%DeltaL,1) - b = -(u1%DeltaL(i1) - u2%DeltaL(i1)) - u_out%DeltaL(i1) = u1%DeltaL(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%DeltaLdot) .AND. ALLOCATED(u1%DeltaLdot)) THEN - DO i1 = LBOUND(u_out%DeltaLdot,1),UBOUND(u_out%DeltaLdot,1) - b = -(u1%DeltaLdot(i1) - u2%DeltaLdot(i1)) - u_out%DeltaLdot(i1) = u1%DeltaLdot(i1) + b * ScaleFactor - END DO -END IF ! check if allocated - END SUBROUTINE MD_Input_ExtrapInterp1 - - - SUBROUTINE MD_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + IF (ALLOCATED(u_out%CoupledKinematics) .AND. ALLOCATED(u1%CoupledKinematics)) THEN + do i1 = lbound(u_out%CoupledKinematics,1),ubound(u_out%CoupledKinematics,1) + CALL MeshExtrapInterp1(u1%CoupledKinematics(i1), u2%CoupledKinematics(i1), tin, u_out%CoupledKinematics(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + IF (ALLOCATED(u_out%DeltaL) .AND. ALLOCATED(u1%DeltaL)) THEN + u_out%DeltaL = a1*u1%DeltaL + a2*u2%DeltaL + END IF ! check if allocated + IF (ALLOCATED(u_out%DeltaLdot) .AND. ALLOCATED(u1%DeltaLdot)) THEN + u_out%DeltaLdot = a1*u1%DeltaLdot + a2*u2%DeltaLdot + END IF ! check if allocated +END SUBROUTINE + +SUBROUTINE MD_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. @@ -14609,121 +4767,114 @@ SUBROUTINE MD_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrM ! !.................................................................................................................................. - TYPE(MD_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 > t3 - TYPE(MD_InputType), INTENT(INOUT) :: u2 ! Input at t2 > t3 - TYPE(MD_InputType), INTENT(INOUT) :: u3 ! Input at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs - TYPE(MD_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 + TYPE(MD_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 > t3 + TYPE(MD_InputType), INTENT(INOUT) :: u2 ! Input at t2 > t3 + TYPE(MD_InputType), INTENT(INOUT) :: u3 ! Input at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs + TYPE(MD_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 = 'MD_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) - + 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) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'MD_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 + 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 + 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 + 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%CoupledKinematics) .AND. ALLOCATED(u1%CoupledKinematics)) THEN - DO i1 = LBOUND(u_out%CoupledKinematics,1),UBOUND(u_out%CoupledKinematics,1) - CALL MeshExtrapInterp2(u1%CoupledKinematics(i1), u2%CoupledKinematics(i1), u3%CoupledKinematics(i1), tin, u_out%CoupledKinematics(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated -IF (ALLOCATED(u_out%DeltaL) .AND. ALLOCATED(u1%DeltaL)) THEN - DO i1 = LBOUND(u_out%DeltaL,1),UBOUND(u_out%DeltaL,1) - b = (t(3)**2*(u1%DeltaL(i1) - u2%DeltaL(i1)) + t(2)**2*(-u1%DeltaL(i1) + u3%DeltaL(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%DeltaL(i1) + t(3)*u2%DeltaL(i1) - t(2)*u3%DeltaL(i1) ) * scaleFactor - u_out%DeltaL(i1) = u1%DeltaL(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%DeltaLdot) .AND. ALLOCATED(u1%DeltaLdot)) THEN - DO i1 = LBOUND(u_out%DeltaLdot,1),UBOUND(u_out%DeltaLdot,1) - b = (t(3)**2*(u1%DeltaLdot(i1) - u2%DeltaLdot(i1)) + t(2)**2*(-u1%DeltaLdot(i1) + u3%DeltaLdot(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%DeltaLdot(i1) + t(3)*u2%DeltaLdot(i1) - t(2)*u3%DeltaLdot(i1) ) * scaleFactor - u_out%DeltaLdot(i1) = u1%DeltaLdot(i1) + b + c * t_out - END DO -END IF ! check if allocated - END SUBROUTINE MD_Input_ExtrapInterp2 - - - SUBROUTINE MD_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(MD_OutputType), INTENT(INOUT) :: y(:) ! Output at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Outputs - TYPE(MD_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 + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + IF (ALLOCATED(u_out%CoupledKinematics) .AND. ALLOCATED(u1%CoupledKinematics)) THEN + do i1 = lbound(u_out%CoupledKinematics,1),ubound(u_out%CoupledKinematics,1) + CALL MeshExtrapInterp2(u1%CoupledKinematics(i1), u2%CoupledKinematics(i1), u3%CoupledKinematics(i1), tin, u_out%CoupledKinematics(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + IF (ALLOCATED(u_out%DeltaL) .AND. ALLOCATED(u1%DeltaL)) THEN + u_out%DeltaL = a1*u1%DeltaL + a2*u2%DeltaL + a3*u3%DeltaL + END IF ! check if allocated + IF (ALLOCATED(u_out%DeltaLdot) .AND. ALLOCATED(u1%DeltaLdot)) THEN + u_out%DeltaLdot = a1*u1%DeltaLdot + a2*u2%DeltaLdot + a3*u3%DeltaLdot + END IF ! check if allocated +END SUBROUTINE + +subroutine MD_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(MD_OutputType), intent(inout) :: y(:) ! Output at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Outputs + type(MD_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 = 'MD_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 MD_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL MD_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 MD_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 MD_Output_ExtrapInterp - - - SUBROUTINE MD_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'MD_Output_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(y)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(y)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(y) - 1 + select case (order) + case (0) + call MD_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call MD_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call MD_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(y) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE MD_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. @@ -14735,77 +4886,75 @@ SUBROUTINE MD_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ! !.................................................................................................................................. - TYPE(MD_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 - TYPE(MD_OutputType), INTENT(INOUT) :: y2 ! Output at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs - TYPE(MD_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 + TYPE(MD_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 + TYPE(MD_OutputType), INTENT(INOUT) :: y2 ! Output at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs + TYPE(MD_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 = 'MD_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 + REAL(DbKi) :: t(2) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'MD_Output_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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%CoupledLoads) .AND. ALLOCATED(y1%CoupledLoads)) THEN - DO i1 = LBOUND(y_out%CoupledLoads,1),UBOUND(y_out%CoupledLoads,1) - CALL MeshExtrapInterp1(y1%CoupledLoads(i1), y2%CoupledLoads(i1), tin, y_out%CoupledLoads(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -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 -IF (ALLOCATED(y_out%VisLinesMesh) .AND. ALLOCATED(y1%VisLinesMesh)) THEN - DO i1 = LBOUND(y_out%VisLinesMesh,1),UBOUND(y_out%VisLinesMesh,1) - CALL MeshExtrapInterp1(y1%VisLinesMesh(i1), y2%VisLinesMesh(i1), tin, y_out%VisLinesMesh(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated -IF (ALLOCATED(y_out%VisRodsMesh) .AND. ALLOCATED(y1%VisRodsMesh)) THEN - DO i1 = LBOUND(y_out%VisRodsMesh,1),UBOUND(y_out%VisRodsMesh,1) - CALL MeshExtrapInterp1(y1%VisRodsMesh(i1), y2%VisRodsMesh(i1), tin, y_out%VisRodsMesh(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated -IF (ALLOCATED(y_out%VisBodiesMesh) .AND. ALLOCATED(y1%VisBodiesMesh)) THEN - DO i1 = LBOUND(y_out%VisBodiesMesh,1),UBOUND(y_out%VisBodiesMesh,1) - CALL MeshExtrapInterp1(y1%VisBodiesMesh(i1), y2%VisBodiesMesh(i1), tin, y_out%VisBodiesMesh(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated -IF (ALLOCATED(y_out%VisAnchsMesh) .AND. ALLOCATED(y1%VisAnchsMesh)) THEN - DO i1 = LBOUND(y_out%VisAnchsMesh,1),UBOUND(y_out%VisAnchsMesh,1) - CALL MeshExtrapInterp1(y1%VisAnchsMesh(i1), y2%VisAnchsMesh(i1), tin, y_out%VisAnchsMesh(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated - END SUBROUTINE MD_Output_ExtrapInterp1 - - - SUBROUTINE MD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + IF (ALLOCATED(y_out%CoupledLoads) .AND. ALLOCATED(y1%CoupledLoads)) THEN + do i1 = lbound(y_out%CoupledLoads,1),ubound(y_out%CoupledLoads,1) + CALL MeshExtrapInterp1(y1%CoupledLoads(i1), y2%CoupledLoads(i1), tin, y_out%CoupledLoads(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + END IF ! check if allocated + IF (ALLOCATED(y_out%VisLinesMesh) .AND. ALLOCATED(y1%VisLinesMesh)) THEN + do i1 = lbound(y_out%VisLinesMesh,1),ubound(y_out%VisLinesMesh,1) + CALL MeshExtrapInterp1(y1%VisLinesMesh(i1), y2%VisLinesMesh(i1), tin, y_out%VisLinesMesh(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + IF (ALLOCATED(y_out%VisRodsMesh) .AND. ALLOCATED(y1%VisRodsMesh)) THEN + do i1 = lbound(y_out%VisRodsMesh,1),ubound(y_out%VisRodsMesh,1) + CALL MeshExtrapInterp1(y1%VisRodsMesh(i1), y2%VisRodsMesh(i1), tin, y_out%VisRodsMesh(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + IF (ALLOCATED(y_out%VisBodiesMesh) .AND. ALLOCATED(y1%VisBodiesMesh)) THEN + do i1 = lbound(y_out%VisBodiesMesh,1),ubound(y_out%VisBodiesMesh,1) + CALL MeshExtrapInterp1(y1%VisBodiesMesh(i1), y2%VisBodiesMesh(i1), tin, y_out%VisBodiesMesh(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + IF (ALLOCATED(y_out%VisAnchsMesh) .AND. ALLOCATED(y1%VisAnchsMesh)) THEN + do i1 = lbound(y_out%VisAnchsMesh,1),ubound(y_out%VisAnchsMesh,1) + CALL MeshExtrapInterp1(y1%VisAnchsMesh(i1), y2%VisAnchsMesh(i1), tin, y_out%VisAnchsMesh(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated +END SUBROUTINE + +SUBROUTINE MD_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. @@ -14819,84 +4968,80 @@ SUBROUTINE MD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Err ! !.................................................................................................................................. - TYPE(MD_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 > t3 - TYPE(MD_OutputType), INTENT(INOUT) :: y2 ! Output at t2 > t3 - TYPE(MD_OutputType), INTENT(INOUT) :: y3 ! Output at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs - TYPE(MD_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 + TYPE(MD_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 > t3 + TYPE(MD_OutputType), INTENT(INOUT) :: y2 ! Output at t2 > t3 + TYPE(MD_OutputType), INTENT(INOUT) :: y3 ! Output at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs + TYPE(MD_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 = 'MD_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) - + 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) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'MD_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 + 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 + 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 + 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%CoupledLoads) .AND. ALLOCATED(y1%CoupledLoads)) THEN - DO i1 = LBOUND(y_out%CoupledLoads,1),UBOUND(y_out%CoupledLoads,1) - CALL MeshExtrapInterp2(y1%CoupledLoads(i1), y2%CoupledLoads(i1), y3%CoupledLoads(i1), tin, y_out%CoupledLoads(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -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 -IF (ALLOCATED(y_out%VisLinesMesh) .AND. ALLOCATED(y1%VisLinesMesh)) THEN - DO i1 = LBOUND(y_out%VisLinesMesh,1),UBOUND(y_out%VisLinesMesh,1) - CALL MeshExtrapInterp2(y1%VisLinesMesh(i1), y2%VisLinesMesh(i1), y3%VisLinesMesh(i1), tin, y_out%VisLinesMesh(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated -IF (ALLOCATED(y_out%VisRodsMesh) .AND. ALLOCATED(y1%VisRodsMesh)) THEN - DO i1 = LBOUND(y_out%VisRodsMesh,1),UBOUND(y_out%VisRodsMesh,1) - CALL MeshExtrapInterp2(y1%VisRodsMesh(i1), y2%VisRodsMesh(i1), y3%VisRodsMesh(i1), tin, y_out%VisRodsMesh(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated -IF (ALLOCATED(y_out%VisBodiesMesh) .AND. ALLOCATED(y1%VisBodiesMesh)) THEN - DO i1 = LBOUND(y_out%VisBodiesMesh,1),UBOUND(y_out%VisBodiesMesh,1) - CALL MeshExtrapInterp2(y1%VisBodiesMesh(i1), y2%VisBodiesMesh(i1), y3%VisBodiesMesh(i1), tin, y_out%VisBodiesMesh(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated -IF (ALLOCATED(y_out%VisAnchsMesh) .AND. ALLOCATED(y1%VisAnchsMesh)) THEN - DO i1 = LBOUND(y_out%VisAnchsMesh,1),UBOUND(y_out%VisAnchsMesh,1) - CALL MeshExtrapInterp2(y1%VisAnchsMesh(i1), y2%VisAnchsMesh(i1), y3%VisAnchsMesh(i1), tin, y_out%VisAnchsMesh(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated - END SUBROUTINE MD_Output_ExtrapInterp2 - + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + IF (ALLOCATED(y_out%CoupledLoads) .AND. ALLOCATED(y1%CoupledLoads)) THEN + do i1 = lbound(y_out%CoupledLoads,1),ubound(y_out%CoupledLoads,1) + CALL MeshExtrapInterp2(y1%CoupledLoads(i1), y2%CoupledLoads(i1), y3%CoupledLoads(i1), tin, y_out%CoupledLoads(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + a3*y3%WriteOutput + END IF ! check if allocated + IF (ALLOCATED(y_out%VisLinesMesh) .AND. ALLOCATED(y1%VisLinesMesh)) THEN + do i1 = lbound(y_out%VisLinesMesh,1),ubound(y_out%VisLinesMesh,1) + CALL MeshExtrapInterp2(y1%VisLinesMesh(i1), y2%VisLinesMesh(i1), y3%VisLinesMesh(i1), tin, y_out%VisLinesMesh(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + IF (ALLOCATED(y_out%VisRodsMesh) .AND. ALLOCATED(y1%VisRodsMesh)) THEN + do i1 = lbound(y_out%VisRodsMesh,1),ubound(y_out%VisRodsMesh,1) + CALL MeshExtrapInterp2(y1%VisRodsMesh(i1), y2%VisRodsMesh(i1), y3%VisRodsMesh(i1), tin, y_out%VisRodsMesh(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + IF (ALLOCATED(y_out%VisBodiesMesh) .AND. ALLOCATED(y1%VisBodiesMesh)) THEN + do i1 = lbound(y_out%VisBodiesMesh,1),ubound(y_out%VisBodiesMesh,1) + CALL MeshExtrapInterp2(y1%VisBodiesMesh(i1), y2%VisBodiesMesh(i1), y3%VisBodiesMesh(i1), tin, y_out%VisBodiesMesh(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + IF (ALLOCATED(y_out%VisAnchsMesh) .AND. ALLOCATED(y1%VisAnchsMesh)) THEN + do i1 = lbound(y_out%VisAnchsMesh,1),ubound(y_out%VisAnchsMesh,1) + CALL MeshExtrapInterp2(y1%VisAnchsMesh(i1), y2%VisAnchsMesh(i1), y3%VisAnchsMesh(i1), tin, y_out%VisAnchsMesh(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated +END SUBROUTINE END MODULE MoorDyn_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/moordyn/src/MoorDyn_bathymetry.txt b/modules/moordyn/src/MoorDyn_bathymetry.txt deleted file mode 100644 index bfe4ffbbbd..0000000000 --- a/modules/moordyn/src/MoorDyn_bathymetry.txt +++ /dev/null @@ -1,8 +0,0 @@ ---- MoorDyn Bathymetry Input File --- -nGridX 4 -nGridY 4 - -800 -10 10 800 --800 400 400 500 500 - -10 400 400 500 500 - 10 600 600 600 600 - 800 600 600 600 600 \ No newline at end of file diff --git a/modules/nwtc-library/CMakeLists.txt b/modules/nwtc-library/CMakeLists.txt index 080d1c391a..4c1e05e892 100644 --- a/modules/nwtc-library/CMakeLists.txt +++ b/modules/nwtc-library/CMakeLists.txt @@ -14,6 +14,18 @@ # limitations under the License. # +if (GENERATE_TYPES) + generate_f90_types(src/Registry_NWTC_Library_base.txt ${CMAKE_CURRENT_SOURCE_DIR}/src/NWTC_Library_Types.f90 -noextrap) + generate_f90_types(src/Registry_NWTC_Library_mesh.txt ${CMAKE_CURRENT_SOURCE_DIR}/src/NWTC_Library_IncSubs.f90 -incsubs -noextrap) + # Generate Registry_NWTC_Library.txt by concatenating _base.txt and _mesh.txt + set_property(DIRECTORY APPEND PROPERTY CMAKE_CONFIGURE_DEPENDS + src/Registry_NWTC_Library_mesh.txt + src/Registry_NWTC_Library_base.txt) # if these files change, rerun configure + file(READ src/Registry_NWTC_Library_base.txt BASE_CONTENTS) + file(READ src/Registry_NWTC_Library_mesh.txt MESH_CONTENTS) + file(WRITE src/Registry_NWTC_Library.txt "${BASE_CONTENTS}\n${MESH_CONTENTS}") +endif() + #------------------------------------------------------------------------------- # NWTC System File #------------------------------------------------------------------------------- @@ -55,6 +67,7 @@ set(NWTCLIBS_SOURCES src/NWTC_Base.f90 src/SingPrec.f90 + src/ModReg.f90 src/ModMesh.f90 src/ModMesh_Mapping.f90 @@ -63,6 +76,7 @@ set(NWTCLIBS_SOURCES src/NWTC_IO.f90 src/NWTC_Library.f90 src/NWTC_Num.f90 + src/NWTC_Str.f90 src/NWTC_RandomNumber.f90 src/NWTC_Library_Types.f90 @@ -135,8 +149,14 @@ if (CMAKE_BUILD_TYPE MATCHES Debug) endif() endif() +add_custom_target(nwtc_library_inc_subs DEPENDS ${CMAKE_CURRENT_SOURCE_DIR}/src/NWTC_Library_IncSubs.f90) + # Create NWTC Library -add_library(nwtclibs ${NWTC_SYS_FILE} ${NWTCLIBS_SOURCES}) +add_library(nwtclibs STATIC + ${NWTC_SYS_FILE} + ${NWTCLIBS_SOURCES} +) +add_dependencies(nwtclibs nwtc_library_inc_subs) target_link_libraries(nwtclibs PUBLIC ${LAPACK_LIBRARIES} ${CMAKE_DL_LIBS} diff --git a/modules/nwtc-library/ModRegGen.py b/modules/nwtc-library/ModRegGen.py new file mode 100644 index 0000000000..7ab8753a63 --- /dev/null +++ b/modules/nwtc-library/ModRegGen.py @@ -0,0 +1,555 @@ + +import textwrap +import itertools +from itertools import product + +type_map = { + 'C1': 'character(*)', + 'L1': 'logical', + 'I4': 'integer(B4Ki)', + 'I8': 'integer(B8Ki)', + 'R4': 'real(R4Ki)', + 'R8': 'real(R8Ki)', +} + +num_ranks = 5 + +module_header = ''' +!STARTOFGENERATEDFILE 'ModReg.f90' +! +! WARNING This file is generated automatically by ModRegGen.py. +! Do not edit. Your changes to this file will be lost. +! +! FAST Registry +!********************************************************************************************************************************** +! LICENSING +! Copyright (C) 2024 National Renewable Energy Laboratory +! +! 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. +!********************************************************************************************************************************** + +!> This module contains routines for packing and unpacking data from a registry data file. +module ModReg + use NWTC_Base + implicit none + + private + public :: RegFile + public :: OpenRegFile, InitRegFile, CloseRegFile, RegCheckErr + public :: RegPackBounds, RegUnpackBounds + public :: RegPackPointer, RegUnpackPointer + public :: RegPack, RegUnpack + public :: RegPackAlloc, RegUnpackAlloc + public :: RegPackPtr, RegUnpackPtr + + type :: RegFile + integer(IntKi) :: Unit + integer(IntKi) :: Offset + type(c_ptr), allocatable :: Pointers(:) + integer(B8Ki) :: NumData + integer(B8Ki) :: NumPointers + integer(IntKi) :: ErrStat = ErrID_Fatal + character(ErrMsgLen) :: ErrMsg = 'RegFile not initialized' + end type + {ifc_lines} + +contains + + subroutine InitRegFile(RF, Unit, ErrStat, ErrMsg) + type(RegFile), intent(inout) :: RF + integer(IntKi), intent(in) :: Unit + integer(IntKi), intent(out) :: ErrStat + character(ErrMsgLen), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = "InitRegFile" + integer(B8Ki), parameter :: NumPointersInit = 128 + integer(IntKi) :: stat + + ErrStat = ErrID_None + ErrMsg = "" + + RF%ErrStat = ErrID_None + RF%ErrMsg = "" + RF%NumData = 0 + RF%NumPointers = 0 + RF%Unit = Unit + + ! Get current position in the file in case anything has been written to it + inquire(Unit, POS=RF%Offset) + + ! Write invalid number of pointers at the beginning of file so we can + ! check if the file if the file has been finalized and closed + write (Unit, iostat=stat) -1_B8Ki + if (stat /= 0) then + ErrStat = ErrID_Fatal + write (ErrMsg, *) 'InitRegFile: Unable to write offset at beginning of file' + return + end if + + ! If pointers have not been allocated, allocate with initial size + if (.not. allocated(RF%Pointers)) then + allocate (RF%Pointers(NumPointersInit), stat=stat) + if (stat /= 0) then + ErrStat = ErrID_Fatal + write (ErrMsg, *) 'InitRegFile: Unable to init pointer index to with size of', NumPointersInit + return + end if + end if + + ! Reset all pointers to null + RF%Pointers = c_null_ptr + end subroutine + + subroutine CloseRegFile(RF, ErrStat, ErrMsg) + type(RegFile), intent(inout) :: RF + integer(IntKi), intent(out) :: ErrStat + character(ErrMsgLen), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = "CloseRegFile" + integer(IntKi) :: stat + + ErrStat = ErrID_None + ErrMsg = "" + + ! Check if there have been any errors while writing to the file + if (RF%ErrStat /= ErrID_None) then + call SetErrStat(RF%ErrStat, RF%ErrMsg, ErrStat, ErrMsg, RoutineName) + return + end if + + ! Write the actual number of pointers + write (RF%Unit, POS=RF%Offset, iostat=stat) RF%NumPointers + if (stat /= 0) then + ErrStat = ErrID_Fatal + write (ErrMsg, *) 'CloseRegFile: Unable to write offset at beginning of file' + return + end if + + ! Close the file + close (RF%Unit) + + ! Deallocate pointer array + if (allocated(RF%Pointers)) deallocate (RF%Pointers) + end subroutine + + subroutine OpenRegFile(RF, Unit, ErrStat, ErrMsg) + type(RegFile), intent(inout) :: RF + integer(IntKi), intent(in) :: Unit + integer(IntKi), intent(out) :: ErrStat + character(ErrMsgLen), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = "ReadRegFile" + integer(IntKi) :: iostat + + ErrStat = ErrID_None + ErrMsg = '' + + ! Save unit + RF%Unit = Unit + + ! Read number of pointers + read (Unit, iostat=iostat) RF%NumPointers + if (iostat /= 0) then + call SetErrStat(ErrID_Fatal, "Error reading number of pointers", ErrStat, ErrMsg, RoutineName) + return + end if + + ! If pointers are allocated, deallocate + if (allocated(RF%Pointers)) deallocate (RF%Pointers) + + ! Allocate pointer index and initialize pointers to null + allocate (RF%Pointers(1:RF%NumPointers), stat=ErrStat) + RF%Pointers = c_null_ptr + + ! initialize the number of data + RF%NumData = 0 + + ! Clear error + RF%ErrStat = ErrID_None + RF%ErrMsg = '' + end subroutine + + function RegCheckErr(RF, RoutineName) result(Err) + type(RegFile), intent(inout) :: RF + character(*), intent(in) :: RoutineName + logical :: Err + Err = RF%ErrStat /= ErrID_None + if (Err) RF%ErrMsg = trim(RoutineName)//": "//trim(RF%ErrMsg) + end function + + elemental function LogicalToByte(b) result(i) + logical, intent(in) :: b + integer(B1Ki) :: i + if (b) then + i = 1_B1Ki + else + i = 0_B1Ki + end if + end function + + elemental function ByteToLogical(i) result(b) + integer(B1Ki), intent(in) :: i + logical :: b + if (i == 0) then + b = .false. + else + b = .true. + end if + end function + + subroutine RegPackPointer(RF, Ptr, Found) + type(RegFile), intent(inout) :: RF + type(c_ptr), intent(in) :: Ptr + logical, intent(out) :: Found + + type(c_ptr), allocatable :: PointersTmp(:) + integer(B8Ki) :: NewSize + integer(B8Ki) :: i + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Look for pointer in index, if found, pack pointer index and return + do i = 1, RF%NumPointers + if (c_associated(Ptr, RF%Pointers(i))) then + call RegPack(RF, i) + Found = .true. + return + end if + end do + + ! Pointer was not found in index + Found = .false. + + ! If pointer index is full, grow pointer index + if (RF%NumPointers == size(RF%Pointers)) then + NewSize = int(1.5_R8Ki*real(RF%NumPointers, R8Ki), B8Ki) + call move_alloc(RF%Pointers, PointersTmp) + allocate (RF%Pointers(NewSize), stat=RF%ErrStat) + if (RF%ErrStat /= ErrID_None) then + RF%ErrStat = ErrID_Fatal + write (RF%ErrMsg, *) 'RegPackPointer: Unable to allocate pointer index to', NewSize, 'bytes' + return + end if + RF%Pointers(1:size(PointersTmp)) = PointersTmp + RF%Pointers(size(PointersTmp) + 1:) = c_null_ptr + end if + + ! Increment number of pointers, add new pointer to index + RF%NumPointers = RF%NumPointers + 1 + RF%Pointers(RF%NumPointers) = Ptr + + ! Pack pointer index + call RegPack(RF, RF%NumPointers) + end subroutine + + subroutine RegUnpackPointer(RF, Ptr, Idx) + type(RegFile), intent(inout) :: RF + type(c_ptr), intent(out) :: Ptr + integer(B8Ki), intent(out) :: Idx + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Unpack pointer index + call RegUnpack(RF, Idx) + + ! Get pointer from index + Ptr = RF%Pointers(Idx) + end subroutine + + subroutine RegPackBounds(RF, R, LB, UB) + type(RegFile), intent(inout) :: RF + integer(B4Ki), intent(in) :: R + integer(B4Ki), intent(in) :: LB(:), UB(:) + + ! If has an error, return + if (RF%ErrStat /= ErrID_None) return + + ! Pack lower and upper bounds + call RegPack(RF, LB(1:R)) + call RegPack(RF, UB(1:R)) + if (RegCheckErr(RF, "RegPackBounds")) return + end subroutine + + subroutine RegUnpackBounds(RF, R, LB, UB) + type(RegFile), intent(inout) :: RF + integer(B4Ki), intent(in) :: R + integer(B4Ki), intent(out) :: LB(:), UB(:) + + ! If has an error, return + if (RF%ErrStat /= ErrID_None) return + + ! Unpack lower and upper bounds + call RegUnpack(RF, LB(1:R)) + call RegUnpack(RF, UB(1:R)) + if (RegCheckErr(RF, "RegUnpackBounds")) return + end subroutine + + function DataNumValid(RF) result(match) + type(RegFile), intent(inout) :: RF + logical :: match + integer(B8Ki) :: DataNum + + ! Increment the data number to be read + RF%NumData = RF%NumData + 1 + + ! Read the data number from the file + read(RF%Unit) DataNum + + ! If data number from file does not match expected number, set match false + ! and create error message; otherwise, set match to true + if (DataNum /= RF%NumData) then + match = .false. + RF%ErrStat = ErrID_Fatal + write(RF%ErrMsg, *) "Read data number", DataNum, "expected", RF%NumData + else + match = .true. + end if + end function +''' + + +def gen_pack(w, dt, decl, rank): + dims = '' if rank == 0 else '('+','.join([':']*rank)+')' + name = f'Pack_{dt}' if rank == 0 else f'Pack_{dt}_Rank{rank}' + w.write(f'\n\n subroutine {name}(RF, Data)') + w.write(f'\n type(RegFile), intent(inout) :: RF') + w.write(f'\n {decl+", intent(in)":<35s} :: Data{dims}') + w.write(f'\n') + w.write(f'\n ! If error, return') + w.write(f'\n if (RF%ErrStat /= ErrID_None) return') + w.write(f'\n') + w.write(f'\n ! Increment data number and write to file') + w.write(f'\n RF%NumData = RF%NumData + 1') + w.write(f'\n write(RF%Unit) RF%NumData') + w.write(f'\n') + w.write(f'\n ! Write data to file') + w.write(f'\n write(RF%Unit) Data') + w.write(f'\n end subroutine') + + +def gen_unpack(w, dt, decl, rank): + dims = '' if rank == 0 else '('+','.join([':']*rank)+')' + name = f'Unpack_{dt}' if rank == 0 else f'Unpack_{dt}_Rank{rank}' + w.write(f'\n') + w.write(f'\n subroutine {name}(RF, Data)') + w.write(f'\n type(RegFile), intent(inout) :: RF') + w.write(f'\n {decl+", intent(out)":<35s} :: Data{dims}') + w.write(f'\n') + w.write(f'\n ! If error, return') + w.write(f'\n if (RF%ErrStat /= ErrID_None) return') + w.write(f'\n') + w.write(f'\n ! Read data number, return if invalid') + w.write(f'\n if (.not. DataNumValid(RF)) return') + w.write(f'\n') + w.write(f'\n ! Read data from file') + w.write(f'\n read(RF%Unit) Data') + w.write(f'\n end subroutine') + +def gen_pack_alloc(w, dt, decl, rank): + dims = '' if rank == 0 else '('+','.join([':']*rank)+')' + name = f'PackAlloc_{dt}' + ("" if rank == 0 else f'_Rank{rank}') + w.write(f'\n') + w.write(f'\n subroutine {name}(RF, Data)') + w.write(f'\n type(RegFile), intent(inout) :: RF') + w.write(f'\n {decl+", allocatable, intent(in)":<35s} :: Data{dims}') + w.write(f'\n') + w.write(f'\n ! If error, return') + w.write(f'\n if (RF%ErrStat /= ErrID_None) return') + w.write(f'\n') + w.write(f'\n ! Write if allocated') + w.write(f'\n call RegPack(RF, allocated(Data))') + w.write(f'\n if (RegCheckErr(RF, "{name}")) return') + w.write(f'\n if (.not. allocated(Data)) return') + w.write(f'\n') + if rank > 0: + w.write(f'\n ! Write array bounds') + w.write(f'\n call RegPackBounds(RF, {rank}, lbound(Data), ubound(Data))') + w.write(f'\n') + w.write(f'\n ! Write data to file') + w.write(f'\n call RegPack(RF, Data)') + w.write(f'\n if (RegCheckErr(RF, "{name}")) return') + w.write(f'\n end subroutine') + + +def gen_unpack_alloc(w, dt, decl, rank): + dims = '' if rank == 0 else '('+','.join([':']*rank)+')' + name = f'UnpackAlloc_{dt}' + ("" if rank == 0 else f'_Rank{rank}') + w.write(f'\n') + w.write(f'\n subroutine {name}(RF, Data)') + w.write(f'\n type(RegFile), intent(inout) :: RF') + w.write(f'\n {decl+", allocatable, intent(out)":<35s} :: Data{dims}') + w.write(f'\n integer(IntKi) :: stat') + w.write(f'\n logical :: IsAllocated') + if rank > 0: + w.write(f'\n integer(B4Ki) :: LB({rank}), UB({rank})') + w.write(f'\n') + w.write(f'\n ! If error, return') + w.write(f'\n if (RF%ErrStat /= ErrID_None) return') + w.write(f'\n') + w.write(f'\n ! Deallocate if allocated') + w.write(f'\n if (allocated(Data)) deallocate(Data)') + w.write(f'\n') + w.write(f'\n ! Read value to see if it was allocated, return if not') + w.write(f'\n call RegUnpack(RF, IsAllocated)') + w.write(f'\n if (RegCheckErr(RF, "{name}")) return') + w.write(f'\n if (.not. IsAllocated) return') + w.write(f'\n') + alloc_dims = '' + if rank > 0: + w.write(f'\n ! Read array bounds') + w.write(f'\n call RegUnpackBounds(RF, {rank}, LB, UB)') + w.write(f'\n if (RegCheckErr(RF, "{name}")) return') + alloc_dims = '(' + ','.join([f'LB({d+1}):UB({d+1})' for d in range(rank)]) + ')' + w.write(f'\n') + w.write(f'\n ! Allocate data') + w.write(f'\n allocate(Data{alloc_dims}, stat=stat)') + w.write(f'\n if (stat /= 0) then') + w.write(f'\n RF%ErrStat = ErrID_Fatal') + w.write(f'\n RF%ErrMsg = "{name}: error allocating data"') + w.write(f'\n return') + w.write(f'\n end if') + w.write(f'\n') + w.write(f'\n ! Read data') + w.write(f'\n call RegUnpack(RF, Data)') + w.write(f'\n if (RegCheckErr(RF, "{name}")) return') + w.write(f'\n end subroutine') + + +def gen_pack_ptr(w, dt, decl, rank): + dims = '' if rank == 0 else '('+','.join([':']*rank)+')' + name = f'PackPtr_{dt}' + if rank > 0: name += f'_Rank{rank}' + w.write(f'\n') + w.write(f'\n subroutine {name}(RF, Data)') + w.write(f'\n type(RegFile), intent(inout) :: RF') + w.write(f'\n {decl+", pointer, intent(in)":<35s} :: Data{dims}') + w.write(f'\n logical :: PtrInIndex') + w.write(f'\n') + w.write(f'\n ! If error, return') + w.write(f'\n if (RF%ErrStat /= ErrID_None) return') + w.write(f'\n') + w.write(f'\n ! Write if associated') + w.write(f'\n call RegPack(RF, associated(Data))') + w.write(f'\n if (RegCheckErr(RF, "{name}")) return') + w.write(f'\n if (.not. associated(Data)) return') + if rank > 0: + w.write(f'\n') + w.write(f'\n ! Write array bounds') + w.write(f'\n call RegPackBounds(RF, {rank}, lbound(Data), ubound(Data))') + w.write(f'\n') + w.write(f'\n ! Write pointer info') + w.write(f'\n call RegPackPointer(RF, c_loc(Data), PtrInIndex)') + w.write(f'\n if (RegCheckErr(RF, "{name}")) return') + w.write(f'\n if (PtrInIndex) return') + w.write(f'\n') + w.write(f'\n ! Write data to file') + w.write(f'\n call RegPack(RF, Data)') + w.write(f'\n if (RegCheckErr(RF, "{name}")) return') + w.write(f'\n end subroutine') + +def gen_unpack_ptr(w, dt, decl, rank): + dims = '' if rank == 0 else '('+','.join([':']*rank)+')' + dt_size = int(dt[-1]) + name = f'UnpackPtr_{dt}' if rank == 0 else f'UnpackPtr_{dt}_Rank{rank}' + w.write(f'\n') + if rank == 0: + w.write(f'\n subroutine {name}(RF, Data)') + else: + w.write(f'\n subroutine {name}(RF, Data, LB, UB)') + w.write(f'\n type(RegFile), intent(inout) :: RF') + w.write(f'\n {decl+", pointer, intent(out)":<36s} :: Data{dims}') + if rank > 0: + w.write(f'\n integer(B4Ki), intent(out) :: LB(:), UB(:)') + w.write(f'\n integer(IntKi) :: stat') + w.write(f'\n integer(B8Ki) :: PtrIdx') + w.write(f'\n logical :: IsAssociated') + w.write(f'\n type(c_ptr) :: Ptr') + w.write(f'\n') + w.write(f'\n ! If error, return') + w.write(f'\n if (RF%ErrStat /= ErrID_None) return') + w.write(f'\n') + w.write(f'\n ! If associated, deallocate and nullify') + w.write(f'\n if (associated(Data)) then') + w.write(f'\n deallocate(Data)') + w.write(f'\n nullify(Data)') + w.write(f'\n end if') + w.write(f'\n') + w.write(f'\n ! Read value to see if it was associated, return if not') + w.write(f'\n call RegUnpack(RF, IsAssociated)') + w.write(f'\n if (RegCheckErr(RF, "{name}")) return') + w.write(f'\n if (.not. IsAssociated) return') + if rank > 0: + w.write(f'\n') + w.write(f'\n ! Read array bounds') + w.write(f'\n call RegUnpackBounds(RF, {rank}, LB, UB)') + w.write(f'\n if (RegCheckErr(RF, "{name}")) return') + w.write(f'\n') + w.write(f'\n ! Unpack pointer inf') + w.write(f'\n call RegUnpackPointer(RF, Ptr, PtrIdx)') + w.write(f'\n if (RegCheckErr(RF, "{name}")) return') + w.write(f'\n') + w.write(f'\n ! If pointer was in index, associate data with pointer, return') + w.write(f'\n if (c_associated(Ptr)) then') + if rank == 0: + alloc_dims = '' + w.write(f'\n call c_f_pointer(Ptr, Data)') + else: + alloc_dims = '(' + ','.join([f'LB({d+1}):UB({d+1})' for d in range(rank)]) + ')' + remap_dims = ",".join([f'LB({d+1}):' for d in range(rank)]) + w.write(f'\n call c_f_pointer(Ptr, Data, UB - LB)') # Specify shape + w.write(f'\n Data({remap_dims}) => Data') # Remap bounds + w.write(f'\n return') + w.write(f'\n end if') + w.write(f'\n') + w.write(f'\n ! Allocate data') + w.write(f'\n allocate(Data{alloc_dims}, stat=stat)') + w.write(f'\n if (stat /= 0) then') + w.write(f'\n RF%ErrStat = ErrID_Fatal') + w.write(f'\n RF%ErrMsg = "{name}: error allocating data"') + w.write(f'\n return') + w.write(f'\n end if') + w.write(f'\n') + w.write(f'\n ! Read data') + w.write(f'\n call RegUnpack(RF, Data)') + w.write(f'\n if (RegCheckErr(RF, "{name}")) return') + w.write(f'\n end subroutine') + +# Registry interface +groups = ['Pack', 'Unpack', 'PackAlloc', 'UnpackAlloc', 'PackPtr', 'UnpackPtr'] +ifc_lines = '' +ranks = [''] + [f'_Rank{r}' for r in range(1,num_ranks+1)] +for attr, punp in product([''], groups): + ifc_lines += f'\n\n interface Reg{punp}{attr}' + funcs = [f'{punp}{attr}_{dt}{rank}'for dt, rank in product(type_map.keys(), ranks)] + lines = textwrap.wrap('module procedure ' + ', '.join(funcs), 80, + initial_indent=" "*6, subsequent_indent=' '*9,break_long_words=False) + ifc_lines += '\n' + ' &\n'.join(lines) + ifc_lines += '\n end interface' + +with open('src/ModReg.f90', 'w') as w: + w.write(module_header.format(ifc_lines=ifc_lines, maxrank=num_ranks)) + + # Loop through data types and ranks + for (dt,decl), rank in product(type_map.items(), range(num_ranks+1)): + gen_pack(w, dt, decl, rank) + gen_unpack(w, dt, decl, rank) + gen_pack_alloc(w, dt, decl, rank) + gen_unpack_alloc(w, dt, decl, rank) + gen_pack_ptr(w, dt, decl, rank) + gen_unpack_ptr(w, dt, decl, rank) + + w.write('\nend module') diff --git a/modules/nwtc-library/Old_test/Test_ChkRealFmtStr/makefile b/modules/nwtc-library/Old_test/Test_ChkRealFmtStr/makefile index a860779ef4..d9f08f6b99 100644 --- a/modules/nwtc-library/Old_test/Test_ChkRealFmtStr/makefile +++ b/modules/nwtc-library/Old_test/Test_ChkRealFmtStr/makefile @@ -60,6 +60,7 @@ LIB_SOURCES = \ $(SYS_FILE).f90 \ NWTC_IO.f90 \ NWTC_Num.f90 \ + NWTC_Str.f90 \ ModMesh.f90 \ NWTC_Aero.f90 \ NWTC_Library.f90 diff --git a/modules/nwtc-library/Old_test/Test_FileSize/makefile b/modules/nwtc-library/Old_test/Test_FileSize/makefile index 4f80a02b5b..ed11ecbb70 100644 --- a/modules/nwtc-library/Old_test/Test_FileSize/makefile +++ b/modules/nwtc-library/Old_test/Test_FileSize/makefile @@ -83,6 +83,7 @@ LIB_SOURCES = \ $(SYS_FILE).f90 \ NWTC_IO.f90 \ NWTC_Num.f90 \ + NWTC_Str.f90 \ ModMesh_Types.f90 \ ModMesh.f90 \ NWTC_Aero.f90 \ diff --git a/modules/nwtc-library/Old_test/Test_MeshMapping/Makefile b/modules/nwtc-library/Old_test/Test_MeshMapping/Makefile index b05f1e0384..7f140ed1bb 100644 --- a/modules/nwtc-library/Old_test/Test_MeshMapping/Makefile +++ b/modules/nwtc-library/Old_test/Test_MeshMapping/Makefile @@ -89,6 +89,7 @@ LIB_SOURCES = \ NWTC_Base.f90 \ $(SYS_FILE).f90 \ NWTC_IO.f90 \ + NWTC_Str.f90 \ NWTC_Library_Types.f90 \ ModMesh_Types.f90 \ ModMesh.f90 \ diff --git a/modules/nwtc-library/Old_test/Test_OpenCon_GnuWin/makefile b/modules/nwtc-library/Old_test/Test_OpenCon_GnuWin/makefile index b13650471d..2db544c819 100644 --- a/modules/nwtc-library/Old_test/Test_OpenCon_GnuWin/makefile +++ b/modules/nwtc-library/Old_test/Test_OpenCon_GnuWin/makefile @@ -60,6 +60,7 @@ LIB_SOURCES = \ $(SYS_FILE).f90 \ NWTC_IO.f90 \ NWTC_Num.f90 \ + NWTC_Str.f90 \ ModMesh.f90 \ NWTC_Aero.f90 \ NWTC_Library.f90 diff --git a/modules/nwtc-library/Old_test/Test_ReadComFile/makefile b/modules/nwtc-library/Old_test/Test_ReadComFile/makefile index 86dde6dcf2..c79e6d1036 100644 --- a/modules/nwtc-library/Old_test/Test_ReadComFile/makefile +++ b/modules/nwtc-library/Old_test/Test_ReadComFile/makefile @@ -80,6 +80,7 @@ LIB_SOURCES = \ $(SYS_FILE).f90 \ NWTC_IO.f90 \ NWTC_Num.f90 \ + NWTC_Str.f90 \ ModMesh_Types.f90 \ ModMesh.f90 \ NWTC_Library.f90 diff --git a/modules/nwtc-library/src/Generate_NWTC_Library_Types.bat b/modules/nwtc-library/src/Generate_NWTC_Library_Types.bat index d6c0ef77f4..772880fca3 100644 --- a/modules/nwtc-library/src/Generate_NWTC_Library_Types.bat +++ b/modules/nwtc-library/src/Generate_NWTC_Library_Types.bat @@ -13,11 +13,13 @@ REM ---------------- RUN THE REGISTRY TO AUTO-GENERATE FILES ------------------- REM ---------------------------------------------------------------------------- ECHO on :mesh -%REGISTRY% Registry_NWTC_Library_typedef_mesh.txt -noextrap +%REGISTRY% Registry_NWTC_Library_mesh.txt -noextrap -incsubs +type Registry_NWTC_Library_base.txt Registry_NWTC_Library_mesh.txt > Registry_NWTC_Library.txt goto end :nomesh -%REGISTRY% Registry_NWTC_Library_typedef_nomesh.txt -noextrap +%REGISTRY% Registry_NWTC_Library_base.txt -noextrap +type Registry_NWTC_Library_base.txt Registry_NWTC_Library_mesh.txt > Registry_NWTC_Library.txt :end diff --git a/modules/nwtc-library/src/ModMesh.f90 b/modules/nwtc-library/src/ModMesh.f90 index 7ede50f626..5a34676be6 100644 --- a/modules/nwtc-library/src/ModMesh.f90 +++ b/modules/nwtc-library/src/ModMesh.f90 @@ -35,7 +35,7 @@ !! See https://nwtc.nrel.gov/FAST-Developers and https://nwtc.nrel.gov/system/files/ProgrammingHandbook_Mod20130717.pdf MODULE ModMesh use VTK, only: WrVTK_header, WrVTK_footer - + USE ModReg USE ModMesh_Types IMPLICIT NONE ! INTEGER :: DEBUG_UNIT = 74 @@ -1507,230 +1507,77 @@ END SUBROUTINE MeshDestroy !! buffers when they are no longer needed. For sibling meshes, MeshPack should be called !! separately for each sibling, because the fields allocated with the siblings are separate !! and unique to each sibling. - SUBROUTINE MeshPack ( Mesh, ReKiBuf, DbKiBuf, IntKiBuf , ErrStat, ErrMess, SizeOnly ) - - TYPE(MeshType), INTENT(IN ) :: Mesh ! Mesh being packed - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) ! Real buffer - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) ! Double buffer - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) ! Int buffer - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMess - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - - ! Local - INTEGER(IntKi) :: Re_BufSz ! number of reals in the buffer - INTEGER(IntKi) :: Re_Xferred ! number of reals transferred - INTEGER(IntKi) :: Db_BufSz ! number of doubles in the buffer - INTEGER(IntKi) :: Db_Xferred ! number of doubles transferred - INTEGER(IntKi) :: Int_BufSz ! number of integers in the buffer - INTEGER(IntKi) :: Int_Xferred ! number of integers transferred - - - INTEGER i,j, nelemnodes - LOGICAL OnlySize - INTEGER(IntKi) :: ErrStat2 - !CHARACTER(1024) :: ErrMess2 - CHARACTER(*), PARAMETER :: RoutineName = "MeshPack" + subroutine MeshPack (Buf, Mesh) + type(RegFile), intent(inout) :: Buf + type(MeshType), intent(in) :: Mesh ! Mesh being packed + + integer :: i,j, nelemnodes + character(*), parameter :: RoutineName = "MeshPack" + ! bjj: figure out what to do about sibling meshes... (for now, I'm going to ignore them) + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return - ErrStat = ErrID_None - ErrMess = "" - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) OnlySize = SizeOnly + ! Pack if mesh is initialized + call RegPack(Buf, Mesh%Initialized) + ! If mesh is not initialized, return + if (.not. Mesh%Initialized) return - ! bjj: figure out what to do about sibling meshes... (for now, I'm going to ignore them) - - !......................................... - ! get number of integer values - !......................................... - IF (.NOT. Mesh%Initialized) THEN ! we don't need to store any data; it's a blank mesh - Int_BufSz = 1 - ELSE ! initialized, may or may not be committed - Int_BufSz = 3 & ! number of logicals in MeshType (initialized, committed, RemapFlag) - + FIELDMASK_SIZE & ! number of logicals in MeshType (fieldmask) - + 5 ! number of non-pointer integers (ios, nnodes, nextelem, nscalars, refNode) - - !...... - ! we'll store the element structure (and call MeshCommit on Unpack if necessary to get the remaining fields like det_jac) - !...... - DO i = 1, NELEMKINDS + ! Mesh is initialized, but may or may not be committed - Int_BufSz = Int_BufSz+1 ! Mesh%ElemTable(i)%nelem - if (Mesh%ElemTable(i)%nelem > 0) Int_BufSz = Int_BufSz+1 ! number of nodes in this kind of element - - DO j = 1, Mesh%ElemTable(i)%nelem - !Int_BufSz = Int_BufSz+1 ! which kind of element - !Int_BufSz = Int_BufSz+1 ! skip Nneighbors until that's implemented (as well as neighbor list) - Int_BufSz = Int_BufSz + SIZE( Mesh%ElemTable(i)%Elements(j)%ElemNodes ) ! nodes in this element - END DO - - END DO - - END IF - - !......................................... - ! get number of real values - !......................................... - Re_BufSz = 0 - IF (Mesh%Initialized) THEN - Re_BufSz = Re_BufSz + Mesh%Nnodes * 3 ! Position - !Re_BufSz = Re_BufSz + Mesh%Nnodes * 9 ! RefOrientation - IF ( Mesh%FieldMask(MASKID_FORCE) ) Re_BufSz = Re_BufSz + Mesh%Nnodes * 3 - IF ( Mesh%FieldMask(MASKID_MOMENT) ) Re_BufSz = Re_BufSz + Mesh%Nnodes * 3 - !IF ( Mesh%FieldMask(MASKID_ORIENTATION) ) Re_BufSz = Re_BufSz + Mesh%Nnodes * 9 - !IF ( Mesh%FieldMask(MASKID_TRANSLATIONDISP) ) Re_BufSz = Re_BufSz + Mesh%Nnodes * 3 - IF ( Mesh%FieldMask(MASKID_ROTATIONVEL) ) Re_BufSz = Re_BufSz + Mesh%Nnodes * 3 - IF ( Mesh%FieldMask(MASKID_TRANSLATIONVEL) ) Re_BufSz = Re_BufSz + Mesh%Nnodes * 3 - IF ( Mesh%FieldMask(MASKID_ROTATIONACC) ) Re_BufSz = Re_BufSz + Mesh%Nnodes * 3 - IF ( Mesh%FieldMask(MASKID_TRANSLATIONACC) ) Re_BufSz = Re_BufSz + Mesh%Nnodes * 3 - IF ( Mesh%nScalars .GT. 0 ) Re_BufSz = Re_BufSz + Mesh%Nnodes * Mesh%nScalars - END IF - - !......................................... - ! get number of double values (none now) - !......................................... - Db_BufSz = 0 - IF (Mesh%Initialized) THEN - Db_BufSz = Db_BufSz + Mesh%Nnodes * 9 ! RefOrientation - IF ( Mesh%FieldMask(MASKID_ORIENTATION) ) Db_BufSz = Db_BufSz + Mesh%Nnodes * 9 - IF ( Mesh%FieldMask(MASKID_TRANSLATIONDISP) ) Db_BufSz = Db_BufSz + Mesh%Nnodes * 3 - END IF - - !......................................... - ! allocate buffer arrays - !......................................... - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMess,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, ErrMess,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, ErrMess,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + ! Logicals + call RegPack(Buf, Mesh%committed) + call RegPack(Buf, Mesh%fieldmask) + call RegPack(Buf, Mesh%RemapFlag) - - !......................................... - ! store data in buffer arrays - !......................................... - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ! ..... fill IntKiBuf ..... - - IF (.NOT. Mesh%Initialized) THEN ! we don't need to store any data; it's a blank mesh - IntKiBuf(Int_Xferred) = 0; ; Int_Xferred = Int_Xferred + 1 - ELSE ! initialized, may or may not be committed - ! transfer the logicals - IntKiBuf(Int_Xferred) = 1; Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER( Mesh%committed, IntKiBuf(1) ); Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred:Int_Xferred+FIELDMASK_SIZE-1) = TRANSFER( Mesh%fieldmask, IntKiBuf(Int_Xferred:Int_Xferred+FIELDMASK_SIZE-1) ); Int_Xferred = Int_Xferred + FIELDMASK_SIZE - IntKiBuf(Int_Xferred) = TRANSFER( Mesh%RemapFlag, IntKiBuf(1) ); Int_Xferred = Int_Xferred + 1 - ! integers - IntKiBuf(Int_Xferred) = Mesh%ios; Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = Mesh%nnodes; Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = Mesh%refnode; Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = Mesh%nextelem; Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = Mesh%nscalars; Int_Xferred = Int_Xferred + 1 + ! Integers + call RegPack(Buf, Mesh%ios) + call RegPack(Buf, Mesh%nnodes) + call RegPack(Buf, Mesh%refnode) + call RegPack(Buf, Mesh%ID) + call RegPack(Buf, Mesh%nextelem) + call RegPack(Buf, Mesh%nscalars) + + ! Loop through element kinds + do i = 1, NELEMKINDS - ! element structure - DO i = 1, NELEMKINDS - - IntKiBuf(Int_Xferred) = Mesh%ElemTable(i)%nelem; Int_Xferred = Int_Xferred + 1 ! number of elements + ! Number of elements of this kind + call RegPack(Buf, Mesh%ElemTable(i)%nelem) + + ! If there are elements of this kind + if (Mesh%ElemTable(i)%nelem > 0) then - if (Mesh%ElemTable(i)%nelem > 0) then - nelemnodes = SIZE( Mesh%ElemTable(i)%Elements(1)%ElemNodes ); - IntKiBuf(Int_Xferred) = nelemnodes; Int_Xferred = Int_Xferred + 1 ! nodes per element - - ! nodes in this element - DO j = 1, Mesh%ElemTable(i)%nelem - IntKiBuf(Int_Xferred:Int_Xferred+nelemnodes-1) = Mesh%ElemTable(i)%Elements(j)%ElemNodes; Int_Xferred = Int_Xferred + nelemnodes - END DO - end if - - END DO - - END IF - - ! ..... fill ReKiBuf and DbKiBuf ..... - IF (Mesh%Initialized) THEN - DO i = 1, Mesh%Nnodes ! Position - ReKiBuf(Re_Xferred:Re_Xferred+2) = Mesh%Position(:,i); Re_Xferred = Re_Xferred + 3 - END DO - DO i = 1, Mesh%Nnodes ! RefOrientation - DO j = 1,3 - DbKiBuf(Db_Xferred:Db_Xferred+2) = Mesh%RefOrientation(:,j,i); Db_Xferred = Db_Xferred + 3 - ENDDO - END DO - - IF ( Mesh%FieldMask(MASKID_FORCE) ) THEN ! Force - DO i = 1, Mesh%Nnodes - ReKiBuf(Re_Xferred:Re_Xferred+2) = Mesh%Force(:,i); Re_Xferred = Re_Xferred + 3 - ENDDO - ENDIF - IF ( Mesh%FieldMask(MASKID_MOMENT) ) THEN ! Moment - DO i = 1, Mesh%Nnodes - ReKiBuf(Re_Xferred:Re_Xferred+2) = Mesh%Moment(:,i); Re_Xferred = Re_Xferred + 3 - ENDDO - ENDIF - IF ( Mesh%FieldMask(MASKID_ORIENTATION) ) THEN ! Orientation - DO i = 1, Mesh%Nnodes - DO j = 1,3 - DbKiBuf(Db_Xferred:Db_Xferred+2) = Mesh%Orientation(:,j,i); Db_Xferred = Db_Xferred + 3 - ENDDO - END DO - ENDIF - IF ( Mesh%FieldMask(MASKID_TRANSLATIONDISP) ) THEN ! TranslationDisp - DO i = 1, Mesh%Nnodes - DbKiBuf(Db_Xferred:Db_Xferred+2) = Mesh%TranslationDisp(:,i); Db_Xferred = Db_Xferred + 3 - ENDDO - ENDIF - IF ( Mesh%FieldMask(MASKID_ROTATIONVEL) ) THEN ! RotationVel - DO i = 1, Mesh%Nnodes - ReKiBuf(Re_Xferred:Re_Xferred+2) = Mesh%RotationVel(:,i); Re_Xferred = Re_Xferred + 3 - ENDDO - ENDIF - IF ( Mesh%FieldMask(MASKID_TRANSLATIONVEL) ) THEN ! TranslationVel - DO i = 1, Mesh%Nnodes - ReKiBuf(Re_Xferred:Re_Xferred+2) = Mesh%TranslationVel(:,i); Re_Xferred = Re_Xferred + 3 - ENDDO - ENDIF - IF ( Mesh%FieldMask(MASKID_ROTATIONACC) ) THEN ! RotationAcc - DO i = 1, Mesh%Nnodes - ReKiBuf(Re_Xferred:Re_Xferred+2) = Mesh%RotationAcc(:,i); Re_Xferred = Re_Xferred + 3 - ENDDO - ENDIF - IF ( Mesh%FieldMask(MASKID_TRANSLATIONACC) ) THEN ! TranslationAcc - DO i = 1, Mesh%Nnodes - ReKiBuf(Re_Xferred:Re_Xferred+2) = Mesh%TranslationAcc(:,i); Re_Xferred = Re_Xferred + 3 - ENDDO - ENDIF - - IF ( Mesh%nScalars .GT. 0 ) THEN ! n_re = n_re + Mesh%Nnodes * Mesh%nScalar - DO i = 1, Mesh%Nnodes - ReKiBuf(Re_Xferred:Re_Xferred+Mesh%nScalars-1) = Mesh%Scalars(:,i); Re_Xferred = Re_Xferred + Mesh%nScalars - ENDDO - ENDIF - - END IF - - !bjj: where are we keeping track of which ones are siblings so that we can unpack them (set pointers) properly for restart? + ! Store number of nodes per element + nelemnodes = size(Mesh%ElemTable(i)%Elements(1)%ElemNodes); + call RegPack(Buf, nelemnodes) + + ! Loop through nodes of this element type + do j = 1, Mesh%ElemTable(i)%nelem + call RegPack(Buf, Mesh%ElemTable(i)%Elements(j)%ElemNodes) + end do + end if + end do + + call RegPack(Buf, Mesh%Position) + call RegPack(Buf, Mesh%RefOrientation) + + if (Mesh%fieldmask(MASKID_FORCE)) call RegPack(Buf, Mesh%Force) + if (Mesh%fieldmask(MASKID_MOMENT)) call RegPack(Buf, Mesh%Moment) + if (Mesh%fieldmask(MASKID_ORIENTATION)) call RegPack(Buf, Mesh%Orientation) + if (Mesh%fieldmask(MASKID_TRANSLATIONDISP)) call RegPack(Buf, Mesh%TranslationDisp) + if (Mesh%fieldmask(MASKID_ROTATIONVEL)) call RegPack(Buf, Mesh%RotationVel) + if (Mesh%fieldmask(MASKID_TRANSLATIONVEL)) call RegPack(Buf, Mesh%TranslationVel) + if (Mesh%fieldmask(MASKID_TRANSLATIONACC)) call RegPack(Buf, Mesh%TranslationAcc) + if (Mesh%fieldmask(MASKID_ROTATIONACC)) call RegPack(Buf, Mesh%RotationAcc) + if (Mesh%nScalars > 0) call RegPack(Buf, Mesh%Scalars) + + !bjj: where are we keeping track of which ones are siblings so that we can unpack them (set pointers) properly for restart? + + ! If buffer error, return + if (RegCheckErr(Buf, RoutineName)) return + END SUBROUTINE MeshPack !---------------------------------------------------------------------------------------------------------------------------------- @@ -1739,221 +1586,145 @@ END SUBROUTINE MeshPack !! recreate a mesh after reading in the buffers on a restart of the program. The sense !! of the name is "unpack the mesh from buffers." The resulting mesh will be returned !! in the exact state as when the data in the buffers was packed using MeshPack. - SUBROUTINE MeshUnpack( Mesh, ReKiBuf, DbKiBuf, IntKiBuf, ErrStat, ErrMess ) + SUBROUTINE MeshUnpack(Buf, Mesh) + type(RegFile), intent(inout) :: Buf + type(MeshType), intent(inout) :: Mesh ! Mesh being packed + ! bjj: not implemented yet: ! If the mesh has an already recreated sibling mesh from a previous call to MeshUnpack, specify ! the existing sibling as an optional argument so that the sibling relationship is also recreated. - TYPE(MeshType), INTENT(INOUT) :: Mesh - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMess - - ! Local LOGICAL committed, RemapFlag, fieldmask(FIELDMASK_SIZE) - INTEGER nScalars, ios, nnodes, nextelem, nelemnodes, nelem, refnode + INTEGER nScalars, ios, nnodes, nextelem, nelemnodes, nelem, refnode, id INTEGER i,j - - INTEGER(IntKi) :: Re_Xferred ! number of reals transferred - INTEGER(IntKi) :: Db_Xferred ! number of doubles transferred - INTEGER(IntKi) :: Int_Xferred ! number of integers transferred - - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMess2 - CHARACTER(*), PARAMETER :: RoutineName = "MeshUnpack" - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 + integer(IntKi) :: EN(20) ! Element nodes - ErrStat = ErrID_None - ErrMess = "" + CHARACTER(*), PARAMETER :: RoutineName = "MeshUnpack" + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Read if mesh was initialized + call RegUnpack(Buf, Mesh%initialized) - IF (IntKiBuf(Int_Xferred) == 0 ) THEN ! this is a blank mesh - CALL MeshDestroy( Mesh, ErrStat2, ErrMess2, .TRUE. ) - CALL SetErrStat(ErrStat2,ErrMess2,ErrStat,ErrMess,RoutineName) - RETURN - END IF - - - ! initialized, may or may not be committed - - Mesh%initialized = .true.; Int_Xferred = Int_Xferred + 1 - committed = TRANSFER( IntKiBuf(Int_Xferred), Mesh%committed ); Int_Xferred = Int_Xferred + 1 - fieldmask = TRANSFER( IntKiBuf(Int_Xferred:Int_Xferred+FIELDMASK_SIZE-1), fieldmask ); Int_Xferred = Int_Xferred + FIELDMASK_SIZE - RemapFlag = TRANSFER( IntKiBuf(Int_Xferred), Mesh%RemapFlag ); Int_Xferred = Int_Xferred + 1 - ! integers - ios = IntKiBuf(Int_Xferred) ; Int_Xferred = Int_Xferred + 1 - nnodes = IntKiBuf(Int_Xferred) ; Int_Xferred = Int_Xferred + 1 - refnode = IntKiBuf(Int_Xferred) ; Int_Xferred = Int_Xferred + 1 - nextelem = IntKiBuf(Int_Xferred) ; Int_Xferred = Int_Xferred + 1 - nscalars = IntKiBuf(Int_Xferred) ; Int_Xferred = Int_Xferred + 1 - - - CALL MeshCreate( Mesh, ios, nnodes & - ,ErrStat=ErrStat2, ErrMess=ErrMess2 & - ,Force =fieldmask(MASKID_FORCE) & - ,Moment =fieldmask(MASKID_MOMENT) & - ,Orientation =fieldmask(MASKID_ORIENTATION) & - ,TranslationDisp=fieldmask(MASKID_TRANSLATIONDISP) & - ,TranslationVel =fieldmask(MASKID_TRANSLATIONVEL ) & - ,RotationVel =fieldmask(MASKID_ROTATIONVEL ) & - ,TranslationAcc =fieldmask(MASKID_TRANSLATIONACC ) & - ,RotationAcc =fieldmask(MASKID_ROTATIONACC ) & - ,nScalars = nScalars & + ! If mesh was not initialized, this is a blank mesh, destroy and return + if (.not. Mesh%initialized) THEN + call MeshDestroy( Mesh, Buf%ErrStat, Buf%ErrMsg, .TRUE. ) + return + end if + + ! Logicals + call RegUnpack(Buf, committed) + call RegUnpack(Buf, fieldmask) + call RegUnpack(Buf, RemapFlag) + + ! Integers + call RegUnpack(Buf, ios) + call RegUnpack(Buf, nnodes) + call RegUnpack(Buf, refnode) + call RegUnpack(Buf, id) + call RegUnpack(Buf, nextelem) + call RegUnpack(Buf, nscalars) + + ! If buffer error, return + if (RegCheckErr(Buf, RoutineName)) return + + ! Create mesh + call MeshCreate(Mesh, ios, nnodes & + ,ErrStat=Buf%ErrStat, ErrMess=Buf%ErrMsg & + ,Force = fieldmask(MASKID_FORCE) & + ,Moment = fieldmask(MASKID_MOMENT) & + ,Orientation = fieldmask(MASKID_ORIENTATION) & + ,TranslationDisp = fieldmask(MASKID_TRANSLATIONDISP) & + ,TranslationVel = fieldmask(MASKID_TRANSLATIONVEL) & + ,RotationVel = fieldmask(MASKID_ROTATIONVEL) & + ,TranslationAcc = fieldmask(MASKID_TRANSLATIONACC) & + ,RotationAcc = fieldmask(MASKID_ROTATIONACC) & + ,nScalars = nScalars & ) - CALL SetErrStat(ErrStat2, ErrMess2, ErrStat, ErrMess, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN + if (Buf%ErrStat >= AbortErrLev) return Mesh%RefNode = refnode + Mesh%ID = id Mesh%RemapFlag = RemapFlag Mesh%nextelem = nextelem - ! element structure - DO i = 1, NELEMKINDS - nelem = IntKiBuf(Int_Xferred); Int_Xferred = Int_Xferred + 1 ! number of elements - + ! element structure + DO i = 1, NELEMKINDS + + ! number of elements + call RegUnpack(Buf, nelem) + if (RegCheckErr(Buf, RoutineName)) return + + ! If there are elements of this kind if (nelem > 0) then - nelemnodes = IntKiBuf(Int_Xferred); Int_Xferred = Int_Xferred + 1 ! nodes per element + + ! Get number of nodes per element + call RegUnpack(Buf, nelemnodes) + if (RegCheckErr(Buf, RoutineName)) return - ! nodes in this element - DO j = 1,nelem - - SELECT CASE (nelemnodes) - CASE (1) - CALL MeshConstructElement( Mesh, i, ErrStat, ErrMess & - , P1 =IntKiBuf(Int_Xferred ) & - ) - CASE (2) - CALL MeshConstructElement( Mesh, i, ErrStat, ErrMess & - , P1 =IntKiBuf(Int_Xferred ),P2 =IntKiBuf(Int_Xferred+ 1) & - ) - CASE (3) - CALL MeshConstructElement( Mesh, i, ErrStat, ErrMess & - , P1 =IntKiBuf(Int_Xferred ),P2 =IntKiBuf(Int_Xferred+ 1),P3 =IntKiBuf(Int_Xferred+ 2) & - ) - CASE (4) - CALL MeshConstructElement( Mesh, i, ErrStat, ErrMess & - , P1 =IntKiBuf(Int_Xferred ),P2 =IntKiBuf(Int_Xferred+ 1),P3 =IntKiBuf(Int_Xferred+ 2) & - , P4 =IntKiBuf(Int_Xferred+ 3) & - ) - CASE (6) - CALL MeshConstructElement( Mesh, i, ErrStat, ErrMess & - , P1 =IntKiBuf(Int_Xferred ),P2 =IntKiBuf(Int_Xferred+ 1),P3 =IntKiBuf(Int_Xferred+ 2) & - , P4 =IntKiBuf(Int_Xferred+ 3),P5 =IntKiBuf(Int_Xferred+ 4),P6 =IntKiBuf(Int_Xferred+ 5) & - ) - CASE (8) - CALL MeshConstructElement( Mesh, i, ErrStat2, ErrMess2 & - , P1 =IntKiBuf(Int_Xferred ),P2 =IntKiBuf(Int_Xferred+ 1),P3 =IntKiBuf(Int_Xferred+ 2) & - , P4 =IntKiBuf(Int_Xferred+ 3),P5 =IntKiBuf(Int_Xferred+ 4),P6 =IntKiBuf(Int_Xferred+ 5) & - , P7 =IntKiBuf(Int_Xferred+ 6),P8 =IntKiBuf(Int_Xferred+ 7) & - ) - CASE (10) - CALL MeshConstructElement( Mesh, i, ErrStat, ErrMess & - , P1 =IntKiBuf(Int_Xferred ),P2 =IntKiBuf(Int_Xferred+ 1),P3 =IntKiBuf(Int_Xferred+ 2) & - , P4 =IntKiBuf(Int_Xferred+ 3),P5 =IntKiBuf(Int_Xferred+ 4),P6 =IntKiBuf(Int_Xferred+ 5) & - , P7 =IntKiBuf(Int_Xferred+ 6),P8 =IntKiBuf(Int_Xferred+ 7),P9 =IntKiBuf(Int_Xferred+ 8) & - , P10=IntKiBuf(Int_Xferred+ 9) & - ) - CASE (15) - CALL MeshConstructElement( Mesh, i, ErrStat, ErrMess & - , P1 =IntKiBuf(Int_Xferred ),P2 =IntKiBuf(Int_Xferred+ 1),P3 =IntKiBuf(Int_Xferred+ 2) & - , P4 =IntKiBuf(Int_Xferred+ 3),P5 =IntKiBuf(Int_Xferred+ 4),P6 =IntKiBuf(Int_Xferred+ 5) & - , P7 =IntKiBuf(Int_Xferred+ 6),P8 =IntKiBuf(Int_Xferred+ 7),P9 =IntKiBuf(Int_Xferred+ 8) & - , P10=IntKiBuf(Int_Xferred+ 9),P11=IntKiBuf(Int_Xferred+10),P12=IntKiBuf(Int_Xferred+11) & - , P13=IntKiBuf(Int_Xferred+12),P14=IntKiBuf(Int_Xferred+13),P15=IntKiBuf(Int_Xferred+14) & - ) - CASE (20) - CALL MeshConstructElement( Mesh, i, ErrStat, ErrMess & - , P1 =IntKiBuf(Int_Xferred ),P2 =IntKiBuf(Int_Xferred+ 1),P3 =IntKiBuf(Int_Xferred+ 2) & - , P4 =IntKiBuf(Int_Xferred+ 3),P5 =IntKiBuf(Int_Xferred+ 4),P6 =IntKiBuf(Int_Xferred+ 5) & - , P7 =IntKiBuf(Int_Xferred+ 6),P8 =IntKiBuf(Int_Xferred+ 7),P9 =IntKiBuf(Int_Xferred+ 8) & - , P10=IntKiBuf(Int_Xferred+ 9),P11=IntKiBuf(Int_Xferred+10),P12=IntKiBuf(Int_Xferred+11) & - , P13=IntKiBuf(Int_Xferred+12),P14=IntKiBuf(Int_Xferred+13),P15=IntKiBuf(Int_Xferred+14) & - , P16=IntKiBuf(Int_Xferred+15),P17=IntKiBuf(Int_Xferred+16),P18=IntKiBuf(Int_Xferred+17) & - , P19=IntKiBuf(Int_Xferred+18),P20=IntKiBuf(Int_Xferred+19) & - ) - CASE DEFAULT - CALL SetErrStat(ErrID_Fatal,"No such element. Probably manged buffer.",ErrStat,ErrMess,RoutineName) - RETURN - END SELECT - Int_Xferred = Int_Xferred + nelemnodes - END DO ! Elements of this kind - end if ! if there are any elements of this kind - - END DO ! kinds of elements - - ! ..... fill ReKiBuf ..... - DO i = 1, Mesh%Nnodes ! Position - Mesh%Position(:,i) = ReKiBuf(Re_Xferred:Re_Xferred+2); Re_Xferred = Re_Xferred + 3 - END DO - DO i = 1, Mesh%Nnodes ! RefOrientation - DO j = 1,3 - Mesh%RefOrientation(:,j,i) = DbKiBuf(Db_Xferred:Db_Xferred+2); Db_Xferred = Db_Xferred + 3 - ENDDO - END DO - - IF ( FieldMask(MASKID_FORCE) ) THEN ! Force - DO i = 1, Mesh%Nnodes - Mesh%Force(:,i) = ReKiBuf(Re_Xferred:Re_Xferred+2); Re_Xferred = Re_Xferred + 3 - ENDDO - ENDIF - IF ( FieldMask(MASKID_MOMENT) ) THEN ! Moment - DO i = 1, Mesh%Nnodes - Mesh%Moment(:,i) = ReKiBuf(Re_Xferred:Re_Xferred+2); Re_Xferred = Re_Xferred + 3 - ENDDO - ENDIF - IF ( FieldMask(MASKID_ORIENTATION) ) THEN ! Orientation - DO i = 1, Mesh%Nnodes - DO j = 1,3 - Mesh%Orientation(:,j,i) = DbKiBuf(Db_Xferred:Db_Xferred+2); Db_Xferred = Db_Xferred + 3 - ENDDO - END DO - ENDIF - IF ( FieldMask(MASKID_TRANSLATIONDISP) ) THEN ! TranslationDisp - DO i = 1, Mesh%Nnodes - Mesh%TranslationDisp(:,i) = DbKiBuf(Db_Xferred:Db_Xferred+2); Db_Xferred = Db_Xferred + 3 - ENDDO - ENDIF - IF ( FieldMask(MASKID_ROTATIONVEL) ) THEN ! RotationVel - DO i = 1, Mesh%Nnodes - Mesh%RotationVel(:,i) = ReKiBuf(Re_Xferred:Re_Xferred+2); Re_Xferred = Re_Xferred + 3 - ENDDO - ENDIF - IF ( FieldMask(MASKID_TRANSLATIONVEL) ) THEN ! TranslationVel - DO i = 1, Mesh%Nnodes - Mesh%TranslationVel(:,i) = ReKiBuf(Re_Xferred:Re_Xferred+2); Re_Xferred = Re_Xferred + 3 - ENDDO - ENDIF - IF ( FieldMask(MASKID_ROTATIONACC) ) THEN ! RotationAcc - DO i = 1, Mesh%Nnodes - Mesh%RotationAcc(:,i) = ReKiBuf(Re_Xferred:Re_Xferred+2); Re_Xferred = Re_Xferred + 3 - ENDDO - ENDIF - IF ( FieldMask(MASKID_TRANSLATIONACC) ) THEN ! TranslationAcc - DO i = 1, Mesh%Nnodes - Mesh%TranslationAcc(:,i) = ReKiBuf(Re_Xferred:Re_Xferred+2); Re_Xferred = Re_Xferred + 3 - ENDDO - ENDIF - - IF ( Mesh%nScalars .GT. 0 ) THEN ! n_re = n_re + Mesh%Nnodes * Mesh%nScalar - DO i = 1, Mesh%Nnodes - Mesh%Scalars(:,i) = ReKiBuf(Re_Xferred:Re_Xferred+Mesh%nScalars-1); Re_Xferred = Re_Xferred + Mesh%nScalars - ENDDO - ENDIF + ! Nodes in this element + do j = 1, nelem + + ! Read nodes for this element + call RegUnpack(Buf, EN(1:nelemnodes)) + + select case (nelemnodes) + case (1) + call MeshConstructElement(Mesh, i, Buf%ErrStat, Buf%ErrMsg, P1=EN(1)) + case (2) + call MeshConstructElement(Mesh, i, Buf%ErrStat, Buf%ErrMsg, P1=EN(1), P2=EN(2)) + case (3) + call MeshConstructElement(Mesh, i, Buf%ErrStat, Buf%ErrMsg, P1=EN(1), P2=EN(2), P3=EN(3)) + case (4) + call MeshConstructElement(Mesh, i, Buf%ErrStat, Buf%ErrMsg, P1=EN(1), P2=EN(2), P3=EN(3), P4=EN(4)) + case (6) + call MeshConstructElement(Mesh, i, Buf%ErrStat, Buf%ErrMsg, P1=EN(1), P2=EN(2), P3=EN(3), & + P4=EN(4), P5=EN(5), P6=EN(6)) + case (8) + call MeshConstructElement(Mesh, i, Buf%ErrStat, Buf%ErrMsg, P1=EN(1), P2=EN(2), P3=EN(3), & + P4=EN(4), P5=EN(5), P6=EN(6), P7=EN(7), P8=EN(8)) + case (10) + call MeshConstructElement(Mesh, i, Buf%ErrStat, Buf%ErrMsg, P1=EN(1), P2=EN(2), P3=EN(3), & + P4=EN(4), P5=EN(5), P6=EN(6), P7=EN(7), P8=EN(8), P9=EN(9), P10=EN(10)) + case (15) + call MeshConstructElement(Mesh, i, Buf%ErrStat, Buf%ErrMsg, P1=EN(1), P2=EN(2), P3=EN(3), & + P4=EN(4), P5=EN(5), P6=EN(6), P7=EN(7), P8=EN(8), P9=EN(9), & + P10=EN(10), P11=EN(11), P12=EN(12), P13=EN(13), P14=EN(14), P15=EN(15)) + case (20) + call MeshConstructElement(Mesh, i, Buf%ErrStat, Buf%ErrMsg, P1=EN(1), P2=EN(2), P3=EN(3), & + P4=EN(4), P5=EN(5), P6=EN(6), P7=EN(7), P8=EN(8), P9=EN(9), & + P10=EN(10), P11=EN(11), P12=EN(12), P13=EN(13), P14=EN(14), & + P15=EN(15), P16=EN(16), P17=EN(17), P18=EN(18), P19=EN(19), P20=EN(20)) + case default + call SetErrStat(ErrID_Fatal,"No such element. Probably mangled buffer.", Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end select + end do + end if + end do + + call RegUnpack(Buf, Mesh%Position) + call RegUnpack(Buf, Mesh%RefOrientation) + + if (FieldMask(MASKID_FORCE)) call RegUnpack(Buf, Mesh%Force) + if (FieldMask(MASKID_MOMENT)) call RegUnpack(Buf, Mesh%Moment) + if (FieldMask(MASKID_ORIENTATION)) call RegUnpack(Buf, Mesh%Orientation) + if (FieldMask(MASKID_TRANSLATIONDISP)) call RegUnpack(Buf, Mesh%TranslationDisp) + if (FieldMask(MASKID_ROTATIONVEL)) call RegUnpack(Buf, Mesh%RotationVel) + if (FieldMask(MASKID_TRANSLATIONVEL)) call RegUnpack(Buf, Mesh%TranslationVel) + if (FieldMask(MASKID_TRANSLATIONACC)) call RegUnpack(Buf, Mesh%TranslationAcc) + if (FieldMask(MASKID_ROTATIONACC)) call RegUnpack(Buf, Mesh%RotationAcc) + if (nScalars > 0) call RegUnpack(Buf, Mesh%Scalars) + + ! If buffer error, return + if (RegCheckErr(Buf, RoutineName)) return - ! commit the mesh - IF (committed) THEN - CALL MeshCommit(Mesh, ErrStat2, ErrMess2) - CALL SetErrStat(ErrStat2, ErrMess2, ErrStat, ErrMess, RoutineName) - END IF - - RETURN + ! Commit the mesh + if (committed) call MeshCommit(Mesh, Buf%ErrStat, Buf%ErrMsg) - END SUBROUTINE MeshUnpack + end subroutine !---------------------------------------------------------------------------------------------------------------------------------- !> Given an existing mesh and a destination mesh, create a completely new copy, a sibling, or @@ -2235,7 +2006,8 @@ SUBROUTINE MeshCopy( SrcMesh, DestMesh, CtrlCode, ErrStat , ErrMess & DestMesh%Initialized = SrcMesh%Initialized DestMesh%Committed = SrcMesh%Committed - DestMesh%refNode = SrcMesh%refNode + DestMesh%refNode = SrcMesh%refNode + DestMesh%ID = SrcMesh%ID IF ( ALLOCATED(SrcMesh%Force ) .AND. ALLOCATED(DestMesh%Force ) ) DestMesh%Force = SrcMesh%Force IF ( ALLOCATED(SrcMesh%Moment ) .AND. ALLOCATED(DestMesh%Moment ) ) DestMesh%Moment = SrcMesh%Moment IF ( ALLOCATED(SrcMesh%Orientation ) .AND. ALLOCATED(DestMesh%Orientation ) ) DestMesh%Orientation = SrcMesh%Orientation @@ -3351,7 +3123,7 @@ SUBROUTINE MeshExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) REAL(DbKi) :: t(SIZE(tin)) ! Times associated with the inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - REAL(DbKi) :: scaleFactor ! temporary for extrapolation/interpolation + REAL(DbKi) :: a1, a2 ! temporary for extrapolation/interpolation REAL(DbKi) :: tensor(3, order+1) ! for extrapolation of orientations REAL(DbKi) :: tensor_interp(3) ! for extrapolation of orientations REAL(DbKi) :: Orient(3,3) ! for extrapolation of orientations @@ -3381,39 +3153,43 @@ SUBROUTINE MeshExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) RETURN END IF + ! Calculate interpolation coefficients, t(1) = 0 + + a1 = (t_out - t(2))/(t(1) - t(2)) + a2 = (t_out - t(1))/(t(2) - t(1)) + ! now let's interpolate/extrapolate the fields: - scaleFactor = t_out / t(2) IF ( ALLOCATED(u1%Force) ) THEN - u_out%Force = u1%Force + (u2%Force - u1%Force) * scaleFactor + u_out%Force = a1*u1%Force + a2*u2%Force END IF IF ( ALLOCATED(u1%Moment) ) THEN - u_out%Moment = u1%Moment + (u2%Moment - u1%Moment) * scaleFactor + u_out%Moment = a1*u1%Moment + a2*u2%Moment END IF IF ( ALLOCATED(u1%TranslationDisp) ) THEN - u_out%TranslationDisp = u1%TranslationDisp + (u2%TranslationDisp - u1%TranslationDisp) * scaleFactor + u_out%TranslationDisp = a1*u1%TranslationDisp + a2*u2%TranslationDisp END IF IF ( ALLOCATED(u1%RotationVel) ) THEN - u_out%RotationVel = u1%RotationVel + (u2%RotationVel - u1%RotationVel) * scaleFactor + u_out%RotationVel = a1*u1%RotationVel + a2*u2%RotationVel END IF IF ( ALLOCATED(u1%TranslationVel) ) THEN - u_out%TranslationVel = u1%TranslationVel + (u2%TranslationVel - u1%TranslationVel) * scaleFactor + u_out%TranslationVel = a1*u1%TranslationVel + a2*u2%TranslationVel END IF IF ( ALLOCATED(u1%RotationAcc) ) THEN - u_out%RotationAcc = u1%RotationAcc + (u2%RotationAcc - u1%RotationAcc) * scaleFactor + u_out%RotationAcc = a1*u1%RotationAcc + a2*u2%RotationAcc END IF IF ( ALLOCATED(u1%TranslationAcc) ) THEN - u_out%TranslationAcc = u1%TranslationAcc + (u2%TranslationAcc - u1%TranslationAcc) * scaleFactor + u_out%TranslationAcc = a1*u1%TranslationAcc + a2*u2%TranslationAcc END IF IF ( ALLOCATED(u1%Scalars) ) THEN - u_out%Scalars = u1%Scalars + (u2%Scalars - u1%Scalars) * scaleFactor + u_out%Scalars = a1*u1%Scalars + a2*u2%Scalars END IF IF ( ALLOCATED(u1%Orientation) ) THEN @@ -3442,7 +3218,7 @@ SUBROUTINE MeshExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) CALL DCM_SetLogMapForInterp( tensor ) - tensor_interp = tensor(:,1) + (tensor(:,2) - tensor(:,1)) * scaleFactor + tensor_interp = a1*tensor(:,1) + a2*tensor(:,2) u_out%Orientation(:,:,node) = DCM_exp( tensor_interp ) @@ -3473,7 +3249,7 @@ SUBROUTINE MeshExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) REAL(DbKi) :: t(SIZE(tin)) ! Times associated with the inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - REAL(DbKi) :: scaleFactor ! temporary for extrapolation/interpolation + REAL(DbKi) :: a1, a2, a3 ! temporary for extrapolation/interpolation REAL(DbKi) :: tensor(3, order+1) ! for extrapolation of orientations REAL(DbKi) :: tensor_interp(3) ! for extrapolation of orientations REAL(DbKi) :: Orient(3,3) ! for extrapolation of orientations @@ -3517,63 +3293,44 @@ SUBROUTINE MeshExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) RETURN END IF - ! Now let's interpolate/extrapolate: + ! Calculate interpolation coefficients, t(1) = 0 - scaleFactor = t_out / ( t(2) * t(3) * (t(2) - t(3)) ) + a1 = (t_out - t(2))*(t_out - t(3))/(t(2)*t(3)) + a2 = t_out*(t_out - t(3))/(t(2)*(t(2) - t(3))) + a3 = t_out*(t_out - t(2))/(t(3)*(t(3) - t(2))) - IF ( ALLOCATED(u1%Force) ) THEN - - u_out%Force = u1%Force & - + ( t(3)**2 * (u1%Force - u2%Force) + t(2)**2*(-u1%Force + u3%Force) ) * scaleFactor & - + ( (t(2)-t(3))*u1%Force + t(3)*u2%Force - t(2)*u3%Force ) *scaleFactor * t_out + ! Now let's interpolate/extrapolate: + IF ( ALLOCATED(u1%Force) ) THEN + u_out%Force = a1*u1%Force + a2*u2%Force + a3*u3%Force END IF + IF ( ALLOCATED(u1%Moment) ) THEN - u_out%Moment = u1%Moment & - + ( t(3)**2 * (u1%Moment - u2%Moment) + t(2)**2*(-u1%Moment + u3%Moment) ) * scaleFactor & - + ( (t(2)-t(3))*u1%Moment + t(3)*u2%Moment - t(2)*u3%Moment ) *scaleFactor * t_out + u_out%Moment = a1*u1%Moment + a2*u2%Moment + a3*u3%Moment END IF IF ( ALLOCATED(u1%TranslationDisp) ) THEN - u_out%TranslationDisp = u1%TranslationDisp & - + ( t(3)**2 * ( u1%TranslationDisp - u2%TranslationDisp) & - + t(2)**2 * (-u1%TranslationDisp + u3%TranslationDisp) ) * scaleFactor & - + ( (t(2)-t(3))*u1%TranslationDisp + t(3)*u2%TranslationDisp & - - t(2)*u3%TranslationDisp )*scaleFactor*t_out + u_out%TranslationDisp = a1*u1%TranslationDisp + a2*u2%TranslationDisp + a3*u3%TranslationDisp END IF IF ( ALLOCATED(u1%RotationVel) ) THEN - u_out%RotationVel = u1%RotationVel & - + ( t(3)**2 * ( u1%RotationVel - u2%RotationVel) & - + t(2)**2 * (-u1%RotationVel + u3%RotationVel) ) * scaleFactor & - + ( (t(2)-t(3))*u1%RotationVel + t(3)*u2%RotationVel - t(2)*u3%RotationVel )*scaleFactor*t_out + u_out%RotationVel = a1*u1%RotationVel + a2*u2%RotationVel + a3*u3%RotationVel END IF IF ( ALLOCATED(u1%TranslationVel) ) THEN - u_out%TranslationVel = u1%TranslationVel & - +( t(3)**2 * ( u1%TranslationVel - u2%TranslationVel) & - + t(2)**2 * (-u1%TranslationVel + u3%TranslationVel) ) * scaleFactor & - +( (t(2)-t(3))*u1%TranslationVel + t(3)*u2%TranslationVel - t(2)*u3%TranslationVel)*scaleFactor*t_out + u_out%TranslationVel = a1*u1%TranslationVel + a2*u2%TranslationVel + a3*u3%TranslationVel END IF IF ( ALLOCATED(u1%RotationAcc) ) THEN - u_out%RotationAcc = u1%RotationAcc & - + ( t(3)**2 * ( u1%RotationAcc - u2%RotationAcc) & - + t(2)**2 * (-u1%RotationAcc + u3%RotationAcc) ) * scaleFactor & - + ( (t(2)-t(3))*u1%RotationAcc + t(3)*u2%RotationAcc - t(2)*u3%RotationAcc )*scaleFactor*t_out + u_out%RotationAcc = a1*u1%RotationAcc + a2*u2%RotationAcc + a3*u3%RotationAcc END IF IF ( ALLOCATED(u1%TranslationAcc) ) THEN - u_out%TranslationAcc = u1%TranslationAcc & - +( t(3)**2 * ( u1%TranslationAcc - u2%TranslationAcc) & - + t(2)**2 * (-u1%TranslationAcc + u3%TranslationAcc) ) * scaleFactor & - +( (t(2)-t(3))*u1%TranslationAcc + t(3)*u2%TranslationAcc - t(2)*u3%TranslationAcc)*scaleFactor*t_out + u_out%TranslationAcc = a1*u1%TranslationAcc + a2*u2%TranslationAcc + a3*u3%TranslationAcc END IF IF ( ALLOCATED(u1%Scalars) ) THEN - u_out%Scalars = u1%Scalars & - + ( t(3)**2 * (u1%Scalars - u2%Scalars) + t(2)**2*(-u1%Scalars + u3%Scalars) )*scaleFactor & - + ( (t(2)-t(3))*u1%Scalars + t(3)*u2%Scalars - t(2)*u3%Scalars )*scaleFactor * t_out + u_out%Scalars = a1*u1%Scalars + a2*u2%Scalars + a3*u3%Scalars END IF IF ( ALLOCATED(u1%Orientation) ) THEN @@ -3610,9 +3367,7 @@ SUBROUTINE MeshExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) CALL DCM_SetLogMapForInterp( tensor ) - tensor_interp = tensor(:,1) & - + ( t(3)**2 * (tensor(:,1) - tensor(:,2)) + t(2)**2*(-tensor(:,1) + tensor(:,3)) )*scaleFactor & - + ( (t(2)-t(3))*tensor(:,1) + t(3)*tensor(:,2) - t(2)*tensor(:,3) )*scaleFactor * t_out + tensor_interp = a1*tensor(:,1) + a2*tensor(:,2) + a3*tensor(:,3) u_out%Orientation(:,:,node) = DCM_exp( tensor_interp ) END DO @@ -3624,21 +3379,25 @@ SUBROUTINE MeshExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) END SUBROUTINE MeshExtrapInterp2 !............................................................................................................................... -!> High level function to easily create a point mesh with one node and one element - SUBROUTINE CreatePointMesh(mesh, posInit, orientInit, errStat, errMsg, hasMotion, hasLoads, hasAcc) +!> High level function to easily create an input point mesh with one node and one element + SUBROUTINE CreateInputPointMesh(mesh, posInit, orientInit, errStat, errMsg, hasMotion, hasLoads, hasAcc) type(MeshType), intent(inout) :: mesh !< Mesh to be created real(ReKi), intent(in ) :: PosInit(3) !< Xi,Yi,Zi, coordinates of node real(R8Ki), intent(in ) :: orientInit(3,3) !< Orientation (direction cosine matrix) of node; identity by default logical, intent(in ) :: hasMotion !< include displacements in mesh logical, intent(in ) :: hasLoads !< include loads in mesh - logical, optional, intent(in ) :: hasAcc !< include acceleration (default is true) + logical, optional, intent(in ) :: hasAcc !< include acceleration (default is true) integer(IntKi) , intent(out) :: errStat ! Status of error message character(*) , intent(out) :: errMsg ! Error message if ErrStat /= ErrID_None - logical :: hasAcc_loc !< include acceleration - integer(IntKi) :: errStat2 ! local status of error message - character(ErrMsgLen) :: errMsg2 ! local error message if ErrStat /= ErrID_None + logical :: hasAcc_loc !< include acceleration + + integer(IntKi) :: errStat2 ! local status of error message + character(ErrMsgLen) :: errMsg2 ! local error message if ErrStat /= ErrID_None + character(*), parameter :: RoutineName = 'CreateInputPointMesh' + errStat = ErrID_None errMsg = '' + hasAcc_loc = .true. if (present(hasAcc)) hasAcc_loc=hasAcc @@ -3646,18 +3405,20 @@ SUBROUTINE CreatePointMesh(mesh, posInit, orientInit, errStat, errMsg, hasMotion Orientation=hasMotion, TranslationDisp=hasMotion, TranslationVel=hasMotion, RotationVel=hasMotion, & TranslationAcc=hasAcc_loc, RotationAcc=hasAcc_loc, & Force = hasLoads, Moment = hasLoads) - call SetErrStat(errStat2, errMsg2, errStat, errMsg, 'CreatePointMesh') + call SetErrStat(errStat2, errMsg2, errStat, errMsg, RoutineName) if (ErrStat >= AbortErrLev) return call MeshPositionNode(mesh, 1, posInit, errStat2, errMsg2, orientInit); - call SetErrStat(errStat2, errMsg2, errStat, errMsg, 'CreatePointMesh') + call SetErrStat(errStat2, errMsg2, errStat, errMsg, RoutineName) call MeshConstructElement(mesh, ELEMENT_POINT, errStat2, errMsg2, p1=1); - call SetErrStat(errStat2, errMsg2, errStat, errMsg, 'CreatePointMesh') + call SetErrStat(errStat2, errMsg2, errStat, errMsg, RoutineName) call MeshCommit(mesh, errStat2, errMsg2); - call SetErrStat(errStat2, errMsg2, errStat, errMsg, 'CreatePointMesh') + call SetErrStat(errStat2, errMsg2, errStat, errMsg, RoutineName) + + ! bjj: this initialization in done in MeshCreate already... ! Initialize fields if (hasLoads) then mesh%Force = 0.0_ReKi @@ -3665,7 +3426,7 @@ SUBROUTINE CreatePointMesh(mesh, posInit, orientInit, errStat, errMsg, hasMotion endif if (hasMotion) then mesh%Orientation = mesh%RefOrientation - mesh%TranslationDisp = 0.0_ReKi + mesh%TranslationDisp = 0.0_R8Ki mesh%TranslationVel = 0.0_ReKi mesh%RotationVel = 0.0_ReKi endif @@ -3674,7 +3435,7 @@ SUBROUTINE CreatePointMesh(mesh, posInit, orientInit, errStat, errMsg, hasMotion mesh%RotationAcc = 0.0_ReKi endif - END SUBROUTINE CreatePointMesh + END SUBROUTINE CreateInputPointMesh !---------------------------------------------------------------------------------------------------------------------------------- END MODULE ModMesh diff --git a/modules/nwtc-library/src/ModMesh_Mapping.f90 b/modules/nwtc-library/src/ModMesh_Mapping.f90 index 6d9a7325d1..fd63f374f3 100644 --- a/modules/nwtc-library/src/ModMesh_Mapping.f90 +++ b/modules/nwtc-library/src/ModMesh_Mapping.f90 @@ -27,6 +27,7 @@ !********************************************************************************************************************************** MODULE ModMesh_Mapping + USE ModReg USE ModMesh USE NWTC_LAPACK @@ -5749,2203 +5750,8 @@ SUBROUTINE WriteMappingTransferToFile(Mesh1_I,Mesh1_O,Mesh2_I,Mesh2_O,Map_Mod1_M END SUBROUTINE WriteMappingTransferToFile !---------------------------------------------------------------------------------------------------------------------------------- -!================================================================================================================================== -!bjj: these routines require the use of ModMesh.f90, thus they cannot be part of NWTC_Library_Types.f90: -!STARTOFREGISTRYGENERATEDFILE 'NWTC_Library_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 -!********************************************************************************************************************************* - SUBROUTINE NWTC_Library_CopyMapType( SrcMapTypeData, DstMapTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MapType), INTENT(IN) :: SrcMapTypeData - TYPE(MapType), INTENT(INOUT) :: DstMapTypeData - 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 = 'NWTC_Library_CopyMapType' -! - ErrStat = ErrID_None - ErrMsg = "" - DstMapTypeData%OtherMesh_Element = SrcMapTypeData%OtherMesh_Element - DstMapTypeData%distance = SrcMapTypeData%distance - DstMapTypeData%couple_arm = SrcMapTypeData%couple_arm - DstMapTypeData%shape_fn = SrcMapTypeData%shape_fn - END SUBROUTINE NWTC_Library_CopyMapType - - SUBROUTINE NWTC_Library_DestroyMapType( MapTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(MapType), INTENT(INOUT) :: MapTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'NWTC_Library_DestroyMapType' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE NWTC_Library_DestroyMapType - - SUBROUTINE NWTC_Library_PackMapType( 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(MapType), 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 = 'NWTC_Library_PackMapType' - ! 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 ! OtherMesh_Element - Db_BufSz = Db_BufSz + 1 ! distance - Db_BufSz = Db_BufSz + SIZE(InData%couple_arm) ! couple_arm - Db_BufSz = Db_BufSz + SIZE(InData%shape_fn) ! shape_fn - 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%OtherMesh_Element - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%distance - Db_Xferred = Db_Xferred + 1 - DO i1 = LBOUND(InData%couple_arm,1), UBOUND(InData%couple_arm,1) - DbKiBuf(Db_Xferred) = InData%couple_arm(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%shape_fn,1), UBOUND(InData%shape_fn,1) - DbKiBuf(Db_Xferred) = InData%shape_fn(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END SUBROUTINE NWTC_Library_PackMapType - - SUBROUTINE NWTC_Library_UnPackMapType( 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(MapType), 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 = 'NWTC_Library_UnPackMapType' - ! 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%OtherMesh_Element = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%distance = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - i1_l = LBOUND(OutData%couple_arm,1) - i1_u = UBOUND(OutData%couple_arm,1) - DO i1 = LBOUND(OutData%couple_arm,1), UBOUND(OutData%couple_arm,1) - OutData%couple_arm(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%shape_fn,1) - i1_u = UBOUND(OutData%shape_fn,1) - DO i1 = LBOUND(OutData%shape_fn,1), UBOUND(OutData%shape_fn,1) - OutData%shape_fn(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END SUBROUTINE NWTC_Library_UnPackMapType - - SUBROUTINE NWTC_Library_CopyMeshMapLinearizationType( SrcMeshMapLinearizationTypeData, DstMeshMapLinearizationTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MeshMapLinearizationType), INTENT(IN) :: SrcMeshMapLinearizationTypeData - TYPE(MeshMapLinearizationType), INTENT(INOUT) :: DstMeshMapLinearizationTypeData - 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 = 'NWTC_Library_CopyMeshMapLinearizationType' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcMeshMapLinearizationTypeData%mi)) THEN - i1_l = LBOUND(SrcMeshMapLinearizationTypeData%mi,1) - i1_u = UBOUND(SrcMeshMapLinearizationTypeData%mi,1) - i2_l = LBOUND(SrcMeshMapLinearizationTypeData%mi,2) - i2_u = UBOUND(SrcMeshMapLinearizationTypeData%mi,2) - IF (.NOT. ALLOCATED(DstMeshMapLinearizationTypeData%mi)) THEN - ALLOCATE(DstMeshMapLinearizationTypeData%mi(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapLinearizationTypeData%mi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMeshMapLinearizationTypeData%mi = SrcMeshMapLinearizationTypeData%mi -ENDIF -IF (ALLOCATED(SrcMeshMapLinearizationTypeData%fx_p)) THEN - i1_l = LBOUND(SrcMeshMapLinearizationTypeData%fx_p,1) - i1_u = UBOUND(SrcMeshMapLinearizationTypeData%fx_p,1) - i2_l = LBOUND(SrcMeshMapLinearizationTypeData%fx_p,2) - i2_u = UBOUND(SrcMeshMapLinearizationTypeData%fx_p,2) - IF (.NOT. ALLOCATED(DstMeshMapLinearizationTypeData%fx_p)) THEN - ALLOCATE(DstMeshMapLinearizationTypeData%fx_p(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapLinearizationTypeData%fx_p.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMeshMapLinearizationTypeData%fx_p = SrcMeshMapLinearizationTypeData%fx_p -ENDIF -IF (ALLOCATED(SrcMeshMapLinearizationTypeData%tv_uD)) THEN - i1_l = LBOUND(SrcMeshMapLinearizationTypeData%tv_uD,1) - i1_u = UBOUND(SrcMeshMapLinearizationTypeData%tv_uD,1) - i2_l = LBOUND(SrcMeshMapLinearizationTypeData%tv_uD,2) - i2_u = UBOUND(SrcMeshMapLinearizationTypeData%tv_uD,2) - IF (.NOT. ALLOCATED(DstMeshMapLinearizationTypeData%tv_uD)) THEN - ALLOCATE(DstMeshMapLinearizationTypeData%tv_uD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapLinearizationTypeData%tv_uD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMeshMapLinearizationTypeData%tv_uD = SrcMeshMapLinearizationTypeData%tv_uD -ENDIF -IF (ALLOCATED(SrcMeshMapLinearizationTypeData%tv_uS)) THEN - i1_l = LBOUND(SrcMeshMapLinearizationTypeData%tv_uS,1) - i1_u = UBOUND(SrcMeshMapLinearizationTypeData%tv_uS,1) - i2_l = LBOUND(SrcMeshMapLinearizationTypeData%tv_uS,2) - i2_u = UBOUND(SrcMeshMapLinearizationTypeData%tv_uS,2) - IF (.NOT. ALLOCATED(DstMeshMapLinearizationTypeData%tv_uS)) THEN - ALLOCATE(DstMeshMapLinearizationTypeData%tv_uS(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapLinearizationTypeData%tv_uS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMeshMapLinearizationTypeData%tv_uS = SrcMeshMapLinearizationTypeData%tv_uS -ENDIF -IF (ALLOCATED(SrcMeshMapLinearizationTypeData%ta_uD)) THEN - i1_l = LBOUND(SrcMeshMapLinearizationTypeData%ta_uD,1) - i1_u = UBOUND(SrcMeshMapLinearizationTypeData%ta_uD,1) - i2_l = LBOUND(SrcMeshMapLinearizationTypeData%ta_uD,2) - i2_u = UBOUND(SrcMeshMapLinearizationTypeData%ta_uD,2) - IF (.NOT. ALLOCATED(DstMeshMapLinearizationTypeData%ta_uD)) THEN - ALLOCATE(DstMeshMapLinearizationTypeData%ta_uD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapLinearizationTypeData%ta_uD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMeshMapLinearizationTypeData%ta_uD = SrcMeshMapLinearizationTypeData%ta_uD -ENDIF -IF (ALLOCATED(SrcMeshMapLinearizationTypeData%ta_uS)) THEN - i1_l = LBOUND(SrcMeshMapLinearizationTypeData%ta_uS,1) - i1_u = UBOUND(SrcMeshMapLinearizationTypeData%ta_uS,1) - i2_l = LBOUND(SrcMeshMapLinearizationTypeData%ta_uS,2) - i2_u = UBOUND(SrcMeshMapLinearizationTypeData%ta_uS,2) - IF (.NOT. ALLOCATED(DstMeshMapLinearizationTypeData%ta_uS)) THEN - ALLOCATE(DstMeshMapLinearizationTypeData%ta_uS(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapLinearizationTypeData%ta_uS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMeshMapLinearizationTypeData%ta_uS = SrcMeshMapLinearizationTypeData%ta_uS -ENDIF -IF (ALLOCATED(SrcMeshMapLinearizationTypeData%ta_rv)) THEN - i1_l = LBOUND(SrcMeshMapLinearizationTypeData%ta_rv,1) - i1_u = UBOUND(SrcMeshMapLinearizationTypeData%ta_rv,1) - i2_l = LBOUND(SrcMeshMapLinearizationTypeData%ta_rv,2) - i2_u = UBOUND(SrcMeshMapLinearizationTypeData%ta_rv,2) - IF (.NOT. ALLOCATED(DstMeshMapLinearizationTypeData%ta_rv)) THEN - ALLOCATE(DstMeshMapLinearizationTypeData%ta_rv(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapLinearizationTypeData%ta_rv.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMeshMapLinearizationTypeData%ta_rv = SrcMeshMapLinearizationTypeData%ta_rv -ENDIF -IF (ALLOCATED(SrcMeshMapLinearizationTypeData%li)) THEN - i1_l = LBOUND(SrcMeshMapLinearizationTypeData%li,1) - i1_u = UBOUND(SrcMeshMapLinearizationTypeData%li,1) - i2_l = LBOUND(SrcMeshMapLinearizationTypeData%li,2) - i2_u = UBOUND(SrcMeshMapLinearizationTypeData%li,2) - IF (.NOT. ALLOCATED(DstMeshMapLinearizationTypeData%li)) THEN - ALLOCATE(DstMeshMapLinearizationTypeData%li(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapLinearizationTypeData%li.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMeshMapLinearizationTypeData%li = SrcMeshMapLinearizationTypeData%li -ENDIF -IF (ALLOCATED(SrcMeshMapLinearizationTypeData%M_uS)) THEN - i1_l = LBOUND(SrcMeshMapLinearizationTypeData%M_uS,1) - i1_u = UBOUND(SrcMeshMapLinearizationTypeData%M_uS,1) - i2_l = LBOUND(SrcMeshMapLinearizationTypeData%M_uS,2) - i2_u = UBOUND(SrcMeshMapLinearizationTypeData%M_uS,2) - IF (.NOT. ALLOCATED(DstMeshMapLinearizationTypeData%M_uS)) THEN - ALLOCATE(DstMeshMapLinearizationTypeData%M_uS(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapLinearizationTypeData%M_uS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMeshMapLinearizationTypeData%M_uS = SrcMeshMapLinearizationTypeData%M_uS -ENDIF -IF (ALLOCATED(SrcMeshMapLinearizationTypeData%M_uD)) THEN - i1_l = LBOUND(SrcMeshMapLinearizationTypeData%M_uD,1) - i1_u = UBOUND(SrcMeshMapLinearizationTypeData%M_uD,1) - i2_l = LBOUND(SrcMeshMapLinearizationTypeData%M_uD,2) - i2_u = UBOUND(SrcMeshMapLinearizationTypeData%M_uD,2) - IF (.NOT. ALLOCATED(DstMeshMapLinearizationTypeData%M_uD)) THEN - ALLOCATE(DstMeshMapLinearizationTypeData%M_uD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapLinearizationTypeData%M_uD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMeshMapLinearizationTypeData%M_uD = SrcMeshMapLinearizationTypeData%M_uD -ENDIF -IF (ALLOCATED(SrcMeshMapLinearizationTypeData%M_f)) THEN - i1_l = LBOUND(SrcMeshMapLinearizationTypeData%M_f,1) - i1_u = UBOUND(SrcMeshMapLinearizationTypeData%M_f,1) - i2_l = LBOUND(SrcMeshMapLinearizationTypeData%M_f,2) - i2_u = UBOUND(SrcMeshMapLinearizationTypeData%M_f,2) - IF (.NOT. ALLOCATED(DstMeshMapLinearizationTypeData%M_f)) THEN - ALLOCATE(DstMeshMapLinearizationTypeData%M_f(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapLinearizationTypeData%M_f.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMeshMapLinearizationTypeData%M_f = SrcMeshMapLinearizationTypeData%M_f -ENDIF - END SUBROUTINE NWTC_Library_CopyMeshMapLinearizationType - - SUBROUTINE NWTC_Library_DestroyMeshMapLinearizationType( MeshMapLinearizationTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(MeshMapLinearizationType), INTENT(INOUT) :: MeshMapLinearizationTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'NWTC_Library_DestroyMeshMapLinearizationType' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(MeshMapLinearizationTypeData%mi)) THEN - DEALLOCATE(MeshMapLinearizationTypeData%mi) -ENDIF -IF (ALLOCATED(MeshMapLinearizationTypeData%fx_p)) THEN - DEALLOCATE(MeshMapLinearizationTypeData%fx_p) -ENDIF -IF (ALLOCATED(MeshMapLinearizationTypeData%tv_uD)) THEN - DEALLOCATE(MeshMapLinearizationTypeData%tv_uD) -ENDIF -IF (ALLOCATED(MeshMapLinearizationTypeData%tv_uS)) THEN - DEALLOCATE(MeshMapLinearizationTypeData%tv_uS) -ENDIF -IF (ALLOCATED(MeshMapLinearizationTypeData%ta_uD)) THEN - DEALLOCATE(MeshMapLinearizationTypeData%ta_uD) -ENDIF -IF (ALLOCATED(MeshMapLinearizationTypeData%ta_uS)) THEN - DEALLOCATE(MeshMapLinearizationTypeData%ta_uS) -ENDIF -IF (ALLOCATED(MeshMapLinearizationTypeData%ta_rv)) THEN - DEALLOCATE(MeshMapLinearizationTypeData%ta_rv) -ENDIF -IF (ALLOCATED(MeshMapLinearizationTypeData%li)) THEN - DEALLOCATE(MeshMapLinearizationTypeData%li) -ENDIF -IF (ALLOCATED(MeshMapLinearizationTypeData%M_uS)) THEN - DEALLOCATE(MeshMapLinearizationTypeData%M_uS) -ENDIF -IF (ALLOCATED(MeshMapLinearizationTypeData%M_uD)) THEN - DEALLOCATE(MeshMapLinearizationTypeData%M_uD) -ENDIF -IF (ALLOCATED(MeshMapLinearizationTypeData%M_f)) THEN - DEALLOCATE(MeshMapLinearizationTypeData%M_f) -ENDIF - END SUBROUTINE NWTC_Library_DestroyMeshMapLinearizationType - - SUBROUTINE NWTC_Library_PackMeshMapLinearizationType( 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(MeshMapLinearizationType), 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 = 'NWTC_Library_PackMeshMapLinearizationType' - ! 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 ! mi allocated yes/no - IF ( ALLOCATED(InData%mi) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! mi upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%mi) ! mi - END IF - Int_BufSz = Int_BufSz + 1 ! fx_p allocated yes/no - IF ( ALLOCATED(InData%fx_p) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! fx_p upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%fx_p) ! fx_p - END IF - Int_BufSz = Int_BufSz + 1 ! tv_uD allocated yes/no - IF ( ALLOCATED(InData%tv_uD) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! tv_uD upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%tv_uD) ! tv_uD - END IF - Int_BufSz = Int_BufSz + 1 ! tv_uS allocated yes/no - IF ( ALLOCATED(InData%tv_uS) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! tv_uS upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%tv_uS) ! tv_uS - END IF - Int_BufSz = Int_BufSz + 1 ! ta_uD allocated yes/no - IF ( ALLOCATED(InData%ta_uD) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! ta_uD upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%ta_uD) ! ta_uD - END IF - Int_BufSz = Int_BufSz + 1 ! ta_uS allocated yes/no - IF ( ALLOCATED(InData%ta_uS) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! ta_uS upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%ta_uS) ! ta_uS - END IF - Int_BufSz = Int_BufSz + 1 ! ta_rv allocated yes/no - IF ( ALLOCATED(InData%ta_rv) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! ta_rv upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%ta_rv) ! ta_rv - END IF - Int_BufSz = Int_BufSz + 1 ! li allocated yes/no - IF ( ALLOCATED(InData%li) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! li upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%li) ! li - END IF - Int_BufSz = Int_BufSz + 1 ! M_uS allocated yes/no - IF ( ALLOCATED(InData%M_uS) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! M_uS upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%M_uS) ! M_uS - END IF - Int_BufSz = Int_BufSz + 1 ! M_uD allocated yes/no - IF ( ALLOCATED(InData%M_uD) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! M_uD upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%M_uD) ! M_uD - END IF - Int_BufSz = Int_BufSz + 1 ! M_f allocated yes/no - IF ( ALLOCATED(InData%M_f) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! M_f upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%M_f) ! M_f - 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%mi) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%mi,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%mi,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%mi,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%mi,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%mi,2), UBOUND(InData%mi,2) - DO i1 = LBOUND(InData%mi,1), UBOUND(InData%mi,1) - DbKiBuf(Db_Xferred) = InData%mi(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%fx_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%fx_p,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fx_p,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%fx_p,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fx_p,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%fx_p,2), UBOUND(InData%fx_p,2) - DO i1 = LBOUND(InData%fx_p,1), UBOUND(InData%fx_p,1) - DbKiBuf(Db_Xferred) = InData%fx_p(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%tv_uD) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%tv_uD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%tv_uD,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%tv_uD,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%tv_uD,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%tv_uD,2), UBOUND(InData%tv_uD,2) - DO i1 = LBOUND(InData%tv_uD,1), UBOUND(InData%tv_uD,1) - DbKiBuf(Db_Xferred) = InData%tv_uD(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%tv_uS) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%tv_uS,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%tv_uS,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%tv_uS,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%tv_uS,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%tv_uS,2), UBOUND(InData%tv_uS,2) - DO i1 = LBOUND(InData%tv_uS,1), UBOUND(InData%tv_uS,1) - DbKiBuf(Db_Xferred) = InData%tv_uS(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ta_uD) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ta_uD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ta_uD,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ta_uD,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ta_uD,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%ta_uD,2), UBOUND(InData%ta_uD,2) - DO i1 = LBOUND(InData%ta_uD,1), UBOUND(InData%ta_uD,1) - DbKiBuf(Db_Xferred) = InData%ta_uD(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ta_uS) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ta_uS,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ta_uS,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ta_uS,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ta_uS,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%ta_uS,2), UBOUND(InData%ta_uS,2) - DO i1 = LBOUND(InData%ta_uS,1), UBOUND(InData%ta_uS,1) - DbKiBuf(Db_Xferred) = InData%ta_uS(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ta_rv) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ta_rv,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ta_rv,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ta_rv,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ta_rv,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%ta_rv,2), UBOUND(InData%ta_rv,2) - DO i1 = LBOUND(InData%ta_rv,1), UBOUND(InData%ta_rv,1) - DbKiBuf(Db_Xferred) = InData%ta_rv(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%li) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%li,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%li,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%li,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%li,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%li,2), UBOUND(InData%li,2) - DO i1 = LBOUND(InData%li,1), UBOUND(InData%li,1) - DbKiBuf(Db_Xferred) = InData%li(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%M_uS) ) THEN - 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_uS,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%M_uS,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%M_uS,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%M_uS,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%M_uS,2), UBOUND(InData%M_uS,2) - DO i1 = LBOUND(InData%M_uS,1), UBOUND(InData%M_uS,1) - DbKiBuf(Db_Xferred) = InData%M_uS(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%M_uD) ) THEN - 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_uD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%M_uD,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%M_uD,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%M_uD,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%M_uD,2), UBOUND(InData%M_uD,2) - DO i1 = LBOUND(InData%M_uD,1), UBOUND(InData%M_uD,1) - DbKiBuf(Db_Xferred) = InData%M_uD(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%M_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%M_f,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%M_f,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%M_f,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%M_f,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%M_f,2), UBOUND(InData%M_f,2) - DO i1 = LBOUND(InData%M_f,1), UBOUND(InData%M_f,1) - DbKiBuf(Db_Xferred) = InData%M_f(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE NWTC_Library_PackMeshMapLinearizationType - - SUBROUTINE NWTC_Library_UnPackMeshMapLinearizationType( 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(MeshMapLinearizationType), 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 = 'NWTC_Library_UnPackMeshMapLinearizationType' - ! 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 ! mi not allocated - Int_Xferred = Int_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%mi)) DEALLOCATE(OutData%mi) - ALLOCATE(OutData%mi(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%mi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%mi,2), UBOUND(OutData%mi,2) - DO i1 = LBOUND(OutData%mi,1), UBOUND(OutData%mi,1) - OutData%mi(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! fx_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%fx_p)) DEALLOCATE(OutData%fx_p) - ALLOCATE(OutData%fx_p(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%fx_p.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%fx_p,2), UBOUND(OutData%fx_p,2) - DO i1 = LBOUND(OutData%fx_p,1), UBOUND(OutData%fx_p,1) - OutData%fx_p(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! tv_uD not allocated - Int_Xferred = Int_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%tv_uD)) DEALLOCATE(OutData%tv_uD) - ALLOCATE(OutData%tv_uD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%tv_uD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%tv_uD,2), UBOUND(OutData%tv_uD,2) - DO i1 = LBOUND(OutData%tv_uD,1), UBOUND(OutData%tv_uD,1) - OutData%tv_uD(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! tv_uS not allocated - Int_Xferred = Int_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%tv_uS)) DEALLOCATE(OutData%tv_uS) - ALLOCATE(OutData%tv_uS(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%tv_uS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%tv_uS,2), UBOUND(OutData%tv_uS,2) - DO i1 = LBOUND(OutData%tv_uS,1), UBOUND(OutData%tv_uS,1) - OutData%tv_uS(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ta_uD not allocated - Int_Xferred = Int_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%ta_uD)) DEALLOCATE(OutData%ta_uD) - ALLOCATE(OutData%ta_uD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ta_uD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%ta_uD,2), UBOUND(OutData%ta_uD,2) - DO i1 = LBOUND(OutData%ta_uD,1), UBOUND(OutData%ta_uD,1) - OutData%ta_uD(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ta_uS not allocated - Int_Xferred = Int_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%ta_uS)) DEALLOCATE(OutData%ta_uS) - ALLOCATE(OutData%ta_uS(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ta_uS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%ta_uS,2), UBOUND(OutData%ta_uS,2) - DO i1 = LBOUND(OutData%ta_uS,1), UBOUND(OutData%ta_uS,1) - OutData%ta_uS(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ta_rv not allocated - Int_Xferred = Int_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%ta_rv)) DEALLOCATE(OutData%ta_rv) - ALLOCATE(OutData%ta_rv(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ta_rv.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%ta_rv,2), UBOUND(OutData%ta_rv,2) - DO i1 = LBOUND(OutData%ta_rv,1), UBOUND(OutData%ta_rv,1) - OutData%ta_rv(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! li not allocated - Int_Xferred = Int_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%li)) DEALLOCATE(OutData%li) - ALLOCATE(OutData%li(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%li.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%li,2), UBOUND(OutData%li,2) - DO i1 = LBOUND(OutData%li,1), UBOUND(OutData%li,1) - OutData%li(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_uS not allocated - Int_Xferred = Int_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_uS)) DEALLOCATE(OutData%M_uS) - ALLOCATE(OutData%M_uS(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%M_uS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%M_uS,2), UBOUND(OutData%M_uS,2) - DO i1 = LBOUND(OutData%M_uS,1), UBOUND(OutData%M_uS,1) - OutData%M_uS(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_uD not allocated - Int_Xferred = Int_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_uD)) DEALLOCATE(OutData%M_uD) - ALLOCATE(OutData%M_uD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%M_uD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%M_uD,2), UBOUND(OutData%M_uD,2) - DO i1 = LBOUND(OutData%M_uD,1), UBOUND(OutData%M_uD,1) - OutData%M_uD(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_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 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%M_f)) DEALLOCATE(OutData%M_f) - ALLOCATE(OutData%M_f(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%M_f.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%M_f,2), UBOUND(OutData%M_f,2) - DO i1 = LBOUND(OutData%M_f,1), UBOUND(OutData%M_f,1) - OutData%M_f(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE NWTC_Library_UnPackMeshMapLinearizationType - - SUBROUTINE NWTC_Library_CopyMeshMapType( SrcMeshMapTypeData, DstMeshMapTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MeshMapType), INTENT(INOUT) :: SrcMeshMapTypeData - TYPE(MeshMapType), INTENT(INOUT) :: DstMeshMapTypeData - 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 = 'NWTC_Library_CopyMeshMapType' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcMeshMapTypeData%MapLoads)) THEN - i1_l = LBOUND(SrcMeshMapTypeData%MapLoads,1) - i1_u = UBOUND(SrcMeshMapTypeData%MapLoads,1) - IF (.NOT. ALLOCATED(DstMeshMapTypeData%MapLoads)) THEN - ALLOCATE(DstMeshMapTypeData%MapLoads(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapTypeData%MapLoads.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMeshMapTypeData%MapLoads,1), UBOUND(SrcMeshMapTypeData%MapLoads,1) - CALL NWTC_Library_Copymaptype( SrcMeshMapTypeData%MapLoads(i1), DstMeshMapTypeData%MapLoads(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcMeshMapTypeData%MapMotions)) THEN - i1_l = LBOUND(SrcMeshMapTypeData%MapMotions,1) - i1_u = UBOUND(SrcMeshMapTypeData%MapMotions,1) - IF (.NOT. ALLOCATED(DstMeshMapTypeData%MapMotions)) THEN - ALLOCATE(DstMeshMapTypeData%MapMotions(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapTypeData%MapMotions.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMeshMapTypeData%MapMotions,1), UBOUND(SrcMeshMapTypeData%MapMotions,1) - CALL NWTC_Library_Copymaptype( SrcMeshMapTypeData%MapMotions(i1), DstMeshMapTypeData%MapMotions(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcMeshMapTypeData%MapSrcToAugmt)) THEN - i1_l = LBOUND(SrcMeshMapTypeData%MapSrcToAugmt,1) - i1_u = UBOUND(SrcMeshMapTypeData%MapSrcToAugmt,1) - IF (.NOT. ALLOCATED(DstMeshMapTypeData%MapSrcToAugmt)) THEN - ALLOCATE(DstMeshMapTypeData%MapSrcToAugmt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapTypeData%MapSrcToAugmt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMeshMapTypeData%MapSrcToAugmt,1), UBOUND(SrcMeshMapTypeData%MapSrcToAugmt,1) - CALL NWTC_Library_Copymaptype( SrcMeshMapTypeData%MapSrcToAugmt(i1), DstMeshMapTypeData%MapSrcToAugmt(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL MeshCopy( SrcMeshMapTypeData%Augmented_Ln2_Src, DstMeshMapTypeData%Augmented_Ln2_Src, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcMeshMapTypeData%Lumped_Points_Src, DstMeshMapTypeData%Lumped_Points_Src, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcMeshMapTypeData%LoadLn2_A_Mat_Piv)) THEN - i1_l = LBOUND(SrcMeshMapTypeData%LoadLn2_A_Mat_Piv,1) - i1_u = UBOUND(SrcMeshMapTypeData%LoadLn2_A_Mat_Piv,1) - IF (.NOT. ALLOCATED(DstMeshMapTypeData%LoadLn2_A_Mat_Piv)) THEN - ALLOCATE(DstMeshMapTypeData%LoadLn2_A_Mat_Piv(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapTypeData%LoadLn2_A_Mat_Piv.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMeshMapTypeData%LoadLn2_A_Mat_Piv = SrcMeshMapTypeData%LoadLn2_A_Mat_Piv -ENDIF -IF (ALLOCATED(SrcMeshMapTypeData%DisplacedPosition)) THEN - i1_l = LBOUND(SrcMeshMapTypeData%DisplacedPosition,1) - i1_u = UBOUND(SrcMeshMapTypeData%DisplacedPosition,1) - i2_l = LBOUND(SrcMeshMapTypeData%DisplacedPosition,2) - i2_u = UBOUND(SrcMeshMapTypeData%DisplacedPosition,2) - i3_l = LBOUND(SrcMeshMapTypeData%DisplacedPosition,3) - i3_u = UBOUND(SrcMeshMapTypeData%DisplacedPosition,3) - IF (.NOT. ALLOCATED(DstMeshMapTypeData%DisplacedPosition)) THEN - ALLOCATE(DstMeshMapTypeData%DisplacedPosition(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapTypeData%DisplacedPosition.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMeshMapTypeData%DisplacedPosition = SrcMeshMapTypeData%DisplacedPosition -ENDIF -IF (ALLOCATED(SrcMeshMapTypeData%LoadLn2_A_Mat)) THEN - i1_l = LBOUND(SrcMeshMapTypeData%LoadLn2_A_Mat,1) - i1_u = UBOUND(SrcMeshMapTypeData%LoadLn2_A_Mat,1) - i2_l = LBOUND(SrcMeshMapTypeData%LoadLn2_A_Mat,2) - i2_u = UBOUND(SrcMeshMapTypeData%LoadLn2_A_Mat,2) - IF (.NOT. ALLOCATED(DstMeshMapTypeData%LoadLn2_A_Mat)) THEN - ALLOCATE(DstMeshMapTypeData%LoadLn2_A_Mat(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapTypeData%LoadLn2_A_Mat.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMeshMapTypeData%LoadLn2_A_Mat = SrcMeshMapTypeData%LoadLn2_A_Mat -ENDIF -IF (ALLOCATED(SrcMeshMapTypeData%LoadLn2_F)) THEN - i1_l = LBOUND(SrcMeshMapTypeData%LoadLn2_F,1) - i1_u = UBOUND(SrcMeshMapTypeData%LoadLn2_F,1) - i2_l = LBOUND(SrcMeshMapTypeData%LoadLn2_F,2) - i2_u = UBOUND(SrcMeshMapTypeData%LoadLn2_F,2) - IF (.NOT. ALLOCATED(DstMeshMapTypeData%LoadLn2_F)) THEN - ALLOCATE(DstMeshMapTypeData%LoadLn2_F(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapTypeData%LoadLn2_F.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMeshMapTypeData%LoadLn2_F = SrcMeshMapTypeData%LoadLn2_F -ENDIF -IF (ALLOCATED(SrcMeshMapTypeData%LoadLn2_M)) THEN - i1_l = LBOUND(SrcMeshMapTypeData%LoadLn2_M,1) - i1_u = UBOUND(SrcMeshMapTypeData%LoadLn2_M,1) - i2_l = LBOUND(SrcMeshMapTypeData%LoadLn2_M,2) - i2_u = UBOUND(SrcMeshMapTypeData%LoadLn2_M,2) - IF (.NOT. ALLOCATED(DstMeshMapTypeData%LoadLn2_M)) THEN - ALLOCATE(DstMeshMapTypeData%LoadLn2_M(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapTypeData%LoadLn2_M.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMeshMapTypeData%LoadLn2_M = SrcMeshMapTypeData%LoadLn2_M -ENDIF - CALL NWTC_Library_Copymeshmaplinearizationtype( SrcMeshMapTypeData%dM, DstMeshMapTypeData%dM, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE NWTC_Library_CopyMeshMapType - - SUBROUTINE NWTC_Library_DestroyMeshMapType( MeshMapTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(MeshMapType), INTENT(INOUT) :: MeshMapTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'NWTC_Library_DestroyMeshMapType' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(MeshMapTypeData%MapLoads)) THEN -DO i1 = LBOUND(MeshMapTypeData%MapLoads,1), UBOUND(MeshMapTypeData%MapLoads,1) - CALL NWTC_Library_Destroymaptype( MeshMapTypeData%MapLoads(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MeshMapTypeData%MapLoads) -ENDIF -IF (ALLOCATED(MeshMapTypeData%MapMotions)) THEN -DO i1 = LBOUND(MeshMapTypeData%MapMotions,1), UBOUND(MeshMapTypeData%MapMotions,1) - CALL NWTC_Library_Destroymaptype( MeshMapTypeData%MapMotions(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MeshMapTypeData%MapMotions) -ENDIF -IF (ALLOCATED(MeshMapTypeData%MapSrcToAugmt)) THEN -DO i1 = LBOUND(MeshMapTypeData%MapSrcToAugmt,1), UBOUND(MeshMapTypeData%MapSrcToAugmt,1) - CALL NWTC_Library_Destroymaptype( MeshMapTypeData%MapSrcToAugmt(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MeshMapTypeData%MapSrcToAugmt) -ENDIF - CALL MeshDestroy( MeshMapTypeData%Augmented_Ln2_Src, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( MeshMapTypeData%Lumped_Points_Src, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(MeshMapTypeData%LoadLn2_A_Mat_Piv)) THEN - DEALLOCATE(MeshMapTypeData%LoadLn2_A_Mat_Piv) -ENDIF -IF (ALLOCATED(MeshMapTypeData%DisplacedPosition)) THEN - DEALLOCATE(MeshMapTypeData%DisplacedPosition) -ENDIF -IF (ALLOCATED(MeshMapTypeData%LoadLn2_A_Mat)) THEN - DEALLOCATE(MeshMapTypeData%LoadLn2_A_Mat) -ENDIF -IF (ALLOCATED(MeshMapTypeData%LoadLn2_F)) THEN - DEALLOCATE(MeshMapTypeData%LoadLn2_F) -ENDIF -IF (ALLOCATED(MeshMapTypeData%LoadLn2_M)) THEN - DEALLOCATE(MeshMapTypeData%LoadLn2_M) -ENDIF - CALL NWTC_Library_Destroymeshmaplinearizationtype( MeshMapTypeData%dM, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE NWTC_Library_DestroyMeshMapType - - SUBROUTINE NWTC_Library_PackMeshMapType( 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(MeshMapType), 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 = 'NWTC_Library_PackMeshMapType' - ! 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 ! MapLoads allocated yes/no - IF ( ALLOCATED(InData%MapLoads) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! MapLoads upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%MapLoads,1), UBOUND(InData%MapLoads,1) - Int_BufSz = Int_BufSz + 3 ! MapLoads: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmaptype( Re_Buf, Db_Buf, Int_Buf, InData%MapLoads(i1), ErrStat2, ErrMsg2, .TRUE. ) ! MapLoads - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! MapLoads - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! MapLoads - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! MapLoads - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! MapMotions allocated yes/no - IF ( ALLOCATED(InData%MapMotions) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! MapMotions upper/lower bounds for each dimension - DO i1 = LBOUND(InData%MapMotions,1), UBOUND(InData%MapMotions,1) - Int_BufSz = Int_BufSz + 3 ! MapMotions: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmaptype( Re_Buf, Db_Buf, Int_Buf, InData%MapMotions(i1), ErrStat2, ErrMsg2, .TRUE. ) ! MapMotions - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! MapMotions - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! MapMotions - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! MapMotions - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! MapSrcToAugmt allocated yes/no - IF ( ALLOCATED(InData%MapSrcToAugmt) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! MapSrcToAugmt upper/lower bounds for each dimension - DO i1 = LBOUND(InData%MapSrcToAugmt,1), UBOUND(InData%MapSrcToAugmt,1) - Int_BufSz = Int_BufSz + 3 ! MapSrcToAugmt: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmaptype( Re_Buf, Db_Buf, Int_Buf, InData%MapSrcToAugmt(i1), ErrStat2, ErrMsg2, .TRUE. ) ! MapSrcToAugmt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! MapSrcToAugmt - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! MapSrcToAugmt - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! MapSrcToAugmt - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! Augmented_Ln2_Src: size of buffers for each call to pack subtype - CALL MeshPack( InData%Augmented_Ln2_Src, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! Augmented_Ln2_Src - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Augmented_Ln2_Src - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Augmented_Ln2_Src - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Augmented_Ln2_Src - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! Lumped_Points_Src: size of buffers for each call to pack subtype - CALL MeshPack( InData%Lumped_Points_Src, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! Lumped_Points_Src - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Lumped_Points_Src - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Lumped_Points_Src - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Lumped_Points_Src - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! LoadLn2_A_Mat_Piv allocated yes/no - IF ( ALLOCATED(InData%LoadLn2_A_Mat_Piv) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LoadLn2_A_Mat_Piv upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%LoadLn2_A_Mat_Piv) ! LoadLn2_A_Mat_Piv - END IF - Int_BufSz = Int_BufSz + 1 ! DisplacedPosition allocated yes/no - IF ( ALLOCATED(InData%DisplacedPosition) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! DisplacedPosition upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%DisplacedPosition) ! DisplacedPosition - END IF - Int_BufSz = Int_BufSz + 1 ! LoadLn2_A_Mat allocated yes/no - IF ( ALLOCATED(InData%LoadLn2_A_Mat) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! LoadLn2_A_Mat upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%LoadLn2_A_Mat) ! LoadLn2_A_Mat - END IF - Int_BufSz = Int_BufSz + 1 ! LoadLn2_F allocated yes/no - IF ( ALLOCATED(InData%LoadLn2_F) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! LoadLn2_F upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%LoadLn2_F) ! LoadLn2_F - END IF - Int_BufSz = Int_BufSz + 1 ! LoadLn2_M allocated yes/no - IF ( ALLOCATED(InData%LoadLn2_M) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! LoadLn2_M upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%LoadLn2_M) ! LoadLn2_M - END IF - Int_BufSz = Int_BufSz + 3 ! dM: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaplinearizationtype( Re_Buf, Db_Buf, Int_Buf, InData%dM, ErrStat2, ErrMsg2, .TRUE. ) ! dM - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! dM - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! dM - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! dM - 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%MapLoads) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MapLoads,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MapLoads,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%MapLoads,1), UBOUND(InData%MapLoads,1) - CALL NWTC_Library_Packmaptype( Re_Buf, Db_Buf, Int_Buf, InData%MapLoads(i1), ErrStat2, ErrMsg2, OnlySize ) ! MapLoads - 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%MapMotions) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MapMotions,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MapMotions,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%MapMotions,1), UBOUND(InData%MapMotions,1) - CALL NWTC_Library_Packmaptype( Re_Buf, Db_Buf, Int_Buf, InData%MapMotions(i1), ErrStat2, ErrMsg2, OnlySize ) ! MapMotions - 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%MapSrcToAugmt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MapSrcToAugmt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MapSrcToAugmt,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%MapSrcToAugmt,1), UBOUND(InData%MapSrcToAugmt,1) - CALL NWTC_Library_Packmaptype( Re_Buf, Db_Buf, Int_Buf, InData%MapSrcToAugmt(i1), ErrStat2, ErrMsg2, OnlySize ) ! MapSrcToAugmt - 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 - CALL MeshPack( InData%Augmented_Ln2_Src, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! Augmented_Ln2_Src - 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%Lumped_Points_Src, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! Lumped_Points_Src - 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%LoadLn2_A_Mat_Piv) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LoadLn2_A_Mat_Piv,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LoadLn2_A_Mat_Piv,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LoadLn2_A_Mat_Piv,1), UBOUND(InData%LoadLn2_A_Mat_Piv,1) - IntKiBuf(Int_Xferred) = InData%LoadLn2_A_Mat_Piv(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%DisplacedPosition) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DisplacedPosition,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DisplacedPosition,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DisplacedPosition,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DisplacedPosition,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DisplacedPosition,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DisplacedPosition,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%DisplacedPosition,3), UBOUND(InData%DisplacedPosition,3) - DO i2 = LBOUND(InData%DisplacedPosition,2), UBOUND(InData%DisplacedPosition,2) - DO i1 = LBOUND(InData%DisplacedPosition,1), UBOUND(InData%DisplacedPosition,1) - DbKiBuf(Db_Xferred) = InData%DisplacedPosition(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LoadLn2_A_Mat) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LoadLn2_A_Mat,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LoadLn2_A_Mat,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LoadLn2_A_Mat,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LoadLn2_A_Mat,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%LoadLn2_A_Mat,2), UBOUND(InData%LoadLn2_A_Mat,2) - DO i1 = LBOUND(InData%LoadLn2_A_Mat,1), UBOUND(InData%LoadLn2_A_Mat,1) - DbKiBuf(Db_Xferred) = InData%LoadLn2_A_Mat(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LoadLn2_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%LoadLn2_F,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LoadLn2_F,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LoadLn2_F,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LoadLn2_F,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%LoadLn2_F,2), UBOUND(InData%LoadLn2_F,2) - DO i1 = LBOUND(InData%LoadLn2_F,1), UBOUND(InData%LoadLn2_F,1) - DbKiBuf(Db_Xferred) = InData%LoadLn2_F(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LoadLn2_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%LoadLn2_M,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LoadLn2_M,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LoadLn2_M,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LoadLn2_M,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%LoadLn2_M,2), UBOUND(InData%LoadLn2_M,2) - DO i1 = LBOUND(InData%LoadLn2_M,1), UBOUND(InData%LoadLn2_M,1) - DbKiBuf(Db_Xferred) = InData%LoadLn2_M(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - CALL NWTC_Library_Packmeshmaplinearizationtype( Re_Buf, Db_Buf, Int_Buf, InData%dM, ErrStat2, ErrMsg2, OnlySize ) ! dM - 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 NWTC_Library_PackMeshMapType - - SUBROUTINE NWTC_Library_UnPackMeshMapType( 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(MeshMapType), 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 = 'NWTC_Library_UnPackMeshMapType' - ! 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 ! MapLoads not allocated - Int_Xferred = Int_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%MapLoads)) DEALLOCATE(OutData%MapLoads) - ALLOCATE(OutData%MapLoads(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MapLoads.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%MapLoads,1), UBOUND(OutData%MapLoads,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_Unpackmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%MapLoads(i1), ErrStat2, ErrMsg2 ) ! MapLoads - 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 ! MapMotions not allocated - Int_Xferred = Int_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%MapMotions)) DEALLOCATE(OutData%MapMotions) - ALLOCATE(OutData%MapMotions(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MapMotions.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%MapMotions,1), UBOUND(OutData%MapMotions,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_Unpackmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%MapMotions(i1), ErrStat2, ErrMsg2 ) ! MapMotions - 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 ! MapSrcToAugmt not allocated - Int_Xferred = Int_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%MapSrcToAugmt)) DEALLOCATE(OutData%MapSrcToAugmt) - ALLOCATE(OutData%MapSrcToAugmt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MapSrcToAugmt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%MapSrcToAugmt,1), UBOUND(OutData%MapSrcToAugmt,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_Unpackmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%MapSrcToAugmt(i1), ErrStat2, ErrMsg2 ) ! MapSrcToAugmt - 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 - 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%Augmented_Ln2_Src, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! Augmented_Ln2_Src - 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%Lumped_Points_Src, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! Lumped_Points_Src - 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 ! LoadLn2_A_Mat_Piv not allocated - Int_Xferred = Int_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%LoadLn2_A_Mat_Piv)) DEALLOCATE(OutData%LoadLn2_A_Mat_Piv) - ALLOCATE(OutData%LoadLn2_A_Mat_Piv(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LoadLn2_A_Mat_Piv.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LoadLn2_A_Mat_Piv,1), UBOUND(OutData%LoadLn2_A_Mat_Piv,1) - OutData%LoadLn2_A_Mat_Piv(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DisplacedPosition not allocated - Int_Xferred = Int_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%DisplacedPosition)) DEALLOCATE(OutData%DisplacedPosition) - ALLOCATE(OutData%DisplacedPosition(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%DisplacedPosition.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%DisplacedPosition,3), UBOUND(OutData%DisplacedPosition,3) - DO i2 = LBOUND(OutData%DisplacedPosition,2), UBOUND(OutData%DisplacedPosition,2) - DO i1 = LBOUND(OutData%DisplacedPosition,1), UBOUND(OutData%DisplacedPosition,1) - OutData%DisplacedPosition(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LoadLn2_A_Mat not allocated - Int_Xferred = Int_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%LoadLn2_A_Mat)) DEALLOCATE(OutData%LoadLn2_A_Mat) - ALLOCATE(OutData%LoadLn2_A_Mat(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LoadLn2_A_Mat.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%LoadLn2_A_Mat,2), UBOUND(OutData%LoadLn2_A_Mat,2) - DO i1 = LBOUND(OutData%LoadLn2_A_Mat,1), UBOUND(OutData%LoadLn2_A_Mat,1) - OutData%LoadLn2_A_Mat(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LoadLn2_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 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%LoadLn2_F)) DEALLOCATE(OutData%LoadLn2_F) - ALLOCATE(OutData%LoadLn2_F(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LoadLn2_F.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%LoadLn2_F,2), UBOUND(OutData%LoadLn2_F,2) - DO i1 = LBOUND(OutData%LoadLn2_F,1), UBOUND(OutData%LoadLn2_F,1) - OutData%LoadLn2_F(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LoadLn2_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%LoadLn2_M)) DEALLOCATE(OutData%LoadLn2_M) - ALLOCATE(OutData%LoadLn2_M(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LoadLn2_M.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%LoadLn2_M,2), UBOUND(OutData%LoadLn2_M,2) - DO i1 = LBOUND(OutData%LoadLn2_M,1), UBOUND(OutData%LoadLn2_M,1) - OutData%LoadLn2_M(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - 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 NWTC_Library_Unpackmeshmaplinearizationtype( Re_Buf, Db_Buf, Int_Buf, OutData%dM, ErrStat2, ErrMsg2 ) ! dM - 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 NWTC_Library_UnPackMeshMapType - -!********************************************************************************************************************************* -!ENDOFREGISTRYGENERATEDFILE - +! Include the registry generated subroutines for mesh types +include "NWTC_Library_IncSubs.f90" !---------------------------------------------------------------------------------------------------------------------------------- END MODULE ModMesh_Mapping diff --git a/modules/nwtc-library/src/ModMesh_Types.f90 b/modules/nwtc-library/src/ModMesh_Types.f90 index 1bca2c98a9..b50ab5d997 100644 --- a/modules/nwtc-library/src/ModMesh_Types.f90 +++ b/modules/nwtc-library/src/ModMesh_Types.f90 @@ -107,6 +107,7 @@ MODULE ModMesh_Types INTEGER :: ios !< Mesh type: input (1), output(2), or state(3) INTEGER :: refNode = 0 !< optional reference node (informational only) INTEGER :: Nnodes = 0 !< Number of nodes (vertices) in mesh + INTEGER :: ID = 0 !< Mesh identifier (used during init) ! Mesh elements TYPE(ElemTabType), POINTER :: ElemTable(:) => NULL() !< A table of all elements in the mesh, by type diff --git a/modules/nwtc-library/src/ModReg.f90 b/modules/nwtc-library/src/ModReg.f90 new file mode 100644 index 0000000000..48c664fe7d --- /dev/null +++ b/modules/nwtc-library/src/ModReg.f90 @@ -0,0 +1,6096 @@ + +!STARTOFGENERATEDFILE 'ModReg.f90' +! +! WARNING This file is generated automatically by ModRegGen.py. +! Do not edit. Your changes to this file will be lost. +! +! FAST Registry +!********************************************************************************************************************************** +! LICENSING +! Copyright (C) 2024 National Renewable Energy Laboratory +! +! 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. +!********************************************************************************************************************************** + +!> This module contains routines for packing and unpacking data from a registry data file. +module ModReg + use NWTC_Base + implicit none + + private + public :: RegFile + public :: OpenRegFile, InitRegFile, CloseRegFile, RegCheckErr + public :: RegPackBounds, RegUnpackBounds + public :: RegPackPointer, RegUnpackPointer + public :: RegPack, RegUnpack + public :: RegPackAlloc, RegUnpackAlloc + public :: RegPackPtr, RegUnpackPtr + + type :: RegFile + integer(IntKi) :: Unit + integer(IntKi) :: Offset + type(c_ptr), allocatable :: Pointers(:) + integer(B8Ki) :: NumData + integer(B8Ki) :: NumPointers + integer(IntKi) :: ErrStat = ErrID_Fatal + character(ErrMsgLen) :: ErrMsg = 'RegFile not initialized' + end type + + + interface RegPack + module procedure Pack_C1, Pack_C1_Rank1, Pack_C1_Rank2, Pack_C1_Rank3, & + Pack_C1_Rank4, Pack_C1_Rank5, Pack_L1, Pack_L1_Rank1, Pack_L1_Rank2, & + Pack_L1_Rank3, Pack_L1_Rank4, Pack_L1_Rank5, Pack_I4, Pack_I4_Rank1, & + Pack_I4_Rank2, Pack_I4_Rank3, Pack_I4_Rank4, Pack_I4_Rank5, Pack_I8, & + Pack_I8_Rank1, Pack_I8_Rank2, Pack_I8_Rank3, Pack_I8_Rank4, & + Pack_I8_Rank5, Pack_R4, Pack_R4_Rank1, Pack_R4_Rank2, Pack_R4_Rank3, & + Pack_R4_Rank4, Pack_R4_Rank5, Pack_R8, Pack_R8_Rank1, Pack_R8_Rank2, & + Pack_R8_Rank3, Pack_R8_Rank4, Pack_R8_Rank5 + end interface + + interface RegUnpack + module procedure Unpack_C1, Unpack_C1_Rank1, Unpack_C1_Rank2, & + Unpack_C1_Rank3, Unpack_C1_Rank4, Unpack_C1_Rank5, Unpack_L1, & + Unpack_L1_Rank1, Unpack_L1_Rank2, Unpack_L1_Rank3, Unpack_L1_Rank4, & + Unpack_L1_Rank5, Unpack_I4, Unpack_I4_Rank1, Unpack_I4_Rank2, & + Unpack_I4_Rank3, Unpack_I4_Rank4, Unpack_I4_Rank5, Unpack_I8, & + Unpack_I8_Rank1, Unpack_I8_Rank2, Unpack_I8_Rank3, Unpack_I8_Rank4, & + Unpack_I8_Rank5, Unpack_R4, Unpack_R4_Rank1, Unpack_R4_Rank2, & + Unpack_R4_Rank3, Unpack_R4_Rank4, Unpack_R4_Rank5, Unpack_R8, & + Unpack_R8_Rank1, Unpack_R8_Rank2, Unpack_R8_Rank3, Unpack_R8_Rank4, & + Unpack_R8_Rank5 + end interface + + interface RegPackAlloc + module procedure PackAlloc_C1, PackAlloc_C1_Rank1, PackAlloc_C1_Rank2, & + PackAlloc_C1_Rank3, PackAlloc_C1_Rank4, PackAlloc_C1_Rank5, & + PackAlloc_L1, PackAlloc_L1_Rank1, PackAlloc_L1_Rank2, & + PackAlloc_L1_Rank3, PackAlloc_L1_Rank4, PackAlloc_L1_Rank5, & + PackAlloc_I4, PackAlloc_I4_Rank1, PackAlloc_I4_Rank2, & + PackAlloc_I4_Rank3, PackAlloc_I4_Rank4, PackAlloc_I4_Rank5, & + PackAlloc_I8, PackAlloc_I8_Rank1, PackAlloc_I8_Rank2, & + PackAlloc_I8_Rank3, PackAlloc_I8_Rank4, PackAlloc_I8_Rank5, & + PackAlloc_R4, PackAlloc_R4_Rank1, PackAlloc_R4_Rank2, & + PackAlloc_R4_Rank3, PackAlloc_R4_Rank4, PackAlloc_R4_Rank5, & + PackAlloc_R8, PackAlloc_R8_Rank1, PackAlloc_R8_Rank2, & + PackAlloc_R8_Rank3, PackAlloc_R8_Rank4, PackAlloc_R8_Rank5 + end interface + + interface RegUnpackAlloc + module procedure UnpackAlloc_C1, UnpackAlloc_C1_Rank1, & + UnpackAlloc_C1_Rank2, UnpackAlloc_C1_Rank3, UnpackAlloc_C1_Rank4, & + UnpackAlloc_C1_Rank5, UnpackAlloc_L1, UnpackAlloc_L1_Rank1, & + UnpackAlloc_L1_Rank2, UnpackAlloc_L1_Rank3, UnpackAlloc_L1_Rank4, & + UnpackAlloc_L1_Rank5, UnpackAlloc_I4, UnpackAlloc_I4_Rank1, & + UnpackAlloc_I4_Rank2, UnpackAlloc_I4_Rank3, UnpackAlloc_I4_Rank4, & + UnpackAlloc_I4_Rank5, UnpackAlloc_I8, UnpackAlloc_I8_Rank1, & + UnpackAlloc_I8_Rank2, UnpackAlloc_I8_Rank3, UnpackAlloc_I8_Rank4, & + UnpackAlloc_I8_Rank5, UnpackAlloc_R4, UnpackAlloc_R4_Rank1, & + UnpackAlloc_R4_Rank2, UnpackAlloc_R4_Rank3, UnpackAlloc_R4_Rank4, & + UnpackAlloc_R4_Rank5, UnpackAlloc_R8, UnpackAlloc_R8_Rank1, & + UnpackAlloc_R8_Rank2, UnpackAlloc_R8_Rank3, UnpackAlloc_R8_Rank4, & + UnpackAlloc_R8_Rank5 + end interface + + interface RegPackPtr + module procedure PackPtr_C1, PackPtr_C1_Rank1, PackPtr_C1_Rank2, & + PackPtr_C1_Rank3, PackPtr_C1_Rank4, PackPtr_C1_Rank5, PackPtr_L1, & + PackPtr_L1_Rank1, PackPtr_L1_Rank2, PackPtr_L1_Rank3, PackPtr_L1_Rank4, & + PackPtr_L1_Rank5, PackPtr_I4, PackPtr_I4_Rank1, PackPtr_I4_Rank2, & + PackPtr_I4_Rank3, PackPtr_I4_Rank4, PackPtr_I4_Rank5, PackPtr_I8, & + PackPtr_I8_Rank1, PackPtr_I8_Rank2, PackPtr_I8_Rank3, PackPtr_I8_Rank4, & + PackPtr_I8_Rank5, PackPtr_R4, PackPtr_R4_Rank1, PackPtr_R4_Rank2, & + PackPtr_R4_Rank3, PackPtr_R4_Rank4, PackPtr_R4_Rank5, PackPtr_R8, & + PackPtr_R8_Rank1, PackPtr_R8_Rank2, PackPtr_R8_Rank3, PackPtr_R8_Rank4, & + PackPtr_R8_Rank5 + end interface + + interface RegUnpackPtr + module procedure UnpackPtr_C1, UnpackPtr_C1_Rank1, UnpackPtr_C1_Rank2, & + UnpackPtr_C1_Rank3, UnpackPtr_C1_Rank4, UnpackPtr_C1_Rank5, & + UnpackPtr_L1, UnpackPtr_L1_Rank1, UnpackPtr_L1_Rank2, & + UnpackPtr_L1_Rank3, UnpackPtr_L1_Rank4, UnpackPtr_L1_Rank5, & + UnpackPtr_I4, UnpackPtr_I4_Rank1, UnpackPtr_I4_Rank2, & + UnpackPtr_I4_Rank3, UnpackPtr_I4_Rank4, UnpackPtr_I4_Rank5, & + UnpackPtr_I8, UnpackPtr_I8_Rank1, UnpackPtr_I8_Rank2, & + UnpackPtr_I8_Rank3, UnpackPtr_I8_Rank4, UnpackPtr_I8_Rank5, & + UnpackPtr_R4, UnpackPtr_R4_Rank1, UnpackPtr_R4_Rank2, & + UnpackPtr_R4_Rank3, UnpackPtr_R4_Rank4, UnpackPtr_R4_Rank5, & + UnpackPtr_R8, UnpackPtr_R8_Rank1, UnpackPtr_R8_Rank2, & + UnpackPtr_R8_Rank3, UnpackPtr_R8_Rank4, UnpackPtr_R8_Rank5 + end interface + +contains + + subroutine InitRegFile(RF, Unit, ErrStat, ErrMsg) + type(RegFile), intent(inout) :: RF + integer(IntKi), intent(in) :: Unit + integer(IntKi), intent(out) :: ErrStat + character(ErrMsgLen), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = "InitRegFile" + integer(B8Ki), parameter :: NumPointersInit = 128 + integer(IntKi) :: stat + + ErrStat = ErrID_None + ErrMsg = "" + + RF%ErrStat = ErrID_None + RF%ErrMsg = "" + RF%NumData = 0 + RF%NumPointers = 0 + RF%Unit = Unit + + ! Get current position in the file in case anything has been written to it + inquire(Unit, POS=RF%Offset) + + ! Write invalid number of pointers at the beginning of file so we can + ! check if the file if the file has been finalized and closed + write (Unit, iostat=stat) -1_B8Ki + if (stat /= 0) then + ErrStat = ErrID_Fatal + write (ErrMsg, *) 'InitRegFile: Unable to write offset at beginning of file' + return + end if + + ! If pointers have not been allocated, allocate with initial size + if (.not. allocated(RF%Pointers)) then + allocate (RF%Pointers(NumPointersInit), stat=stat) + if (stat /= 0) then + ErrStat = ErrID_Fatal + write (ErrMsg, *) 'InitRegFile: Unable to init pointer index to with size of', NumPointersInit + return + end if + end if + + ! Reset all pointers to null + RF%Pointers = c_null_ptr + end subroutine + + subroutine CloseRegFile(RF, ErrStat, ErrMsg) + type(RegFile), intent(inout) :: RF + integer(IntKi), intent(out) :: ErrStat + character(ErrMsgLen), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = "CloseRegFile" + integer(IntKi) :: stat + + ErrStat = ErrID_None + ErrMsg = "" + + ! Check if there have been any errors while writing to the file + if (RF%ErrStat /= ErrID_None) then + call SetErrStat(RF%ErrStat, RF%ErrMsg, ErrStat, ErrMsg, RoutineName) + return + end if + + ! Write the actual number of pointers + write (RF%Unit, POS=RF%Offset, iostat=stat) RF%NumPointers + if (stat /= 0) then + ErrStat = ErrID_Fatal + write (ErrMsg, *) 'CloseRegFile: Unable to write offset at beginning of file' + return + end if + + ! Close the file + close (RF%Unit) + + ! Deallocate pointer array + if (allocated(RF%Pointers)) deallocate (RF%Pointers) + end subroutine + + subroutine OpenRegFile(RF, Unit, ErrStat, ErrMsg) + type(RegFile), intent(inout) :: RF + integer(IntKi), intent(in) :: Unit + integer(IntKi), intent(out) :: ErrStat + character(ErrMsgLen), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = "ReadRegFile" + integer(IntKi) :: iostat + + ErrStat = ErrID_None + ErrMsg = '' + + ! Save unit + RF%Unit = Unit + + ! Read number of pointers + read (Unit, iostat=iostat) RF%NumPointers + if (iostat /= 0) then + call SetErrStat(ErrID_Fatal, "Error reading number of pointers", ErrStat, ErrMsg, RoutineName) + return + end if + + ! If pointers are allocated, deallocate + if (allocated(RF%Pointers)) deallocate (RF%Pointers) + + ! Allocate pointer index and initialize pointers to null + allocate (RF%Pointers(1:RF%NumPointers), stat=ErrStat) + RF%Pointers = c_null_ptr + + ! initialize the number of data + RF%NumData = 0 + + ! Clear error + RF%ErrStat = ErrID_None + RF%ErrMsg = '' + end subroutine + + function RegCheckErr(RF, RoutineName) result(Err) + type(RegFile), intent(inout) :: RF + character(*), intent(in) :: RoutineName + logical :: Err + Err = RF%ErrStat /= ErrID_None + if (Err) RF%ErrMsg = trim(RoutineName)//": "//trim(RF%ErrMsg) + end function + + elemental function LogicalToByte(b) result(i) + logical, intent(in) :: b + integer(B1Ki) :: i + if (b) then + i = 1_B1Ki + else + i = 0_B1Ki + end if + end function + + elemental function ByteToLogical(i) result(b) + integer(B1Ki), intent(in) :: i + logical :: b + if (i == 0) then + b = .false. + else + b = .true. + end if + end function + + subroutine RegPackPointer(RF, Ptr, Found) + type(RegFile), intent(inout) :: RF + type(c_ptr), intent(in) :: Ptr + logical, intent(out) :: Found + + type(c_ptr), allocatable :: PointersTmp(:) + integer(B8Ki) :: NewSize + integer(B8Ki) :: i + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Look for pointer in index, if found, pack pointer index and return + do i = 1, RF%NumPointers + if (c_associated(Ptr, RF%Pointers(i))) then + call RegPack(RF, i) + Found = .true. + return + end if + end do + + ! Pointer was not found in index + Found = .false. + + ! If pointer index is full, grow pointer index + if (RF%NumPointers == size(RF%Pointers)) then + NewSize = int(1.5_R8Ki*real(RF%NumPointers, R8Ki), B8Ki) + call move_alloc(RF%Pointers, PointersTmp) + allocate (RF%Pointers(NewSize), stat=RF%ErrStat) + if (RF%ErrStat /= ErrID_None) then + RF%ErrStat = ErrID_Fatal + write (RF%ErrMsg, *) 'RegPackPointer: Unable to allocate pointer index to', NewSize, 'bytes' + return + end if + RF%Pointers(1:size(PointersTmp)) = PointersTmp + RF%Pointers(size(PointersTmp) + 1:) = c_null_ptr + end if + + ! Increment number of pointers, add new pointer to index + RF%NumPointers = RF%NumPointers + 1 + RF%Pointers(RF%NumPointers) = Ptr + + ! Pack pointer index + call RegPack(RF, RF%NumPointers) + end subroutine + + subroutine RegUnpackPointer(RF, Ptr, Idx) + type(RegFile), intent(inout) :: RF + type(c_ptr), intent(out) :: Ptr + integer(B8Ki), intent(out) :: Idx + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Unpack pointer index + call RegUnpack(RF, Idx) + + ! Get pointer from index + Ptr = RF%Pointers(Idx) + end subroutine + + subroutine RegPackBounds(RF, R, LB, UB) + type(RegFile), intent(inout) :: RF + integer(B4Ki), intent(in) :: R + integer(B4Ki), intent(in) :: LB(:), UB(:) + + ! If has an error, return + if (RF%ErrStat /= ErrID_None) return + + ! Pack lower and upper bounds + call RegPack(RF, LB(1:R)) + call RegPack(RF, UB(1:R)) + if (RegCheckErr(RF, "RegPackBounds")) return + end subroutine + + subroutine RegUnpackBounds(RF, R, LB, UB) + type(RegFile), intent(inout) :: RF + integer(B4Ki), intent(in) :: R + integer(B4Ki), intent(out) :: LB(:), UB(:) + + ! If has an error, return + if (RF%ErrStat /= ErrID_None) return + + ! Unpack lower and upper bounds + call RegUnpack(RF, LB(1:R)) + call RegUnpack(RF, UB(1:R)) + if (RegCheckErr(RF, "RegUnpackBounds")) return + end subroutine + + function DataNumValid(RF) result(match) + type(RegFile), intent(inout) :: RF + logical :: match + integer(B8Ki) :: DataNum + + ! Increment the data number to be read + RF%NumData = RF%NumData + 1 + + ! Read the data number from the file + read(RF%Unit) DataNum + + ! If data number from file does not match expected number, set match false + ! and create error message; otherwise, set match to true + if (DataNum /= RF%NumData) then + match = .false. + RF%ErrStat = ErrID_Fatal + write(RF%ErrMsg, *) "Read data number", DataNum, "expected", RF%NumData + else + match = .true. + end if + end function + + + subroutine Pack_C1(RF, Data) + type(RegFile), intent(inout) :: RF + character(*), intent(in) :: Data + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Increment data number and write to file + RF%NumData = RF%NumData + 1 + write(RF%Unit) RF%NumData + + ! Write data to file + write(RF%Unit) Data + end subroutine + + subroutine Unpack_C1(RF, Data) + type(RegFile), intent(inout) :: RF + character(*), intent(out) :: Data + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Read data number, return if invalid + if (.not. DataNumValid(RF)) return + + ! Read data from file + read(RF%Unit) Data + end subroutine + + subroutine PackAlloc_C1(RF, Data) + type(RegFile), intent(inout) :: RF + character(*), allocatable, intent(in) :: Data + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if allocated + call RegPack(RF, allocated(Data)) + if (RegCheckErr(RF, "PackAlloc_C1")) return + if (.not. allocated(Data)) return + + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackAlloc_C1")) return + end subroutine + + subroutine UnpackAlloc_C1(RF, Data) + type(RegFile), intent(inout) :: RF + character(*), allocatable, intent(out) :: Data + integer(IntKi) :: stat + logical :: IsAllocated + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Deallocate if allocated + if (allocated(Data)) deallocate(Data) + + ! Read value to see if it was allocated, return if not + call RegUnpack(RF, IsAllocated) + if (RegCheckErr(RF, "UnpackAlloc_C1")) return + if (.not. IsAllocated) return + + + ! Allocate data + allocate(Data, stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackAlloc_C1: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackAlloc_C1")) return + end subroutine + + subroutine PackPtr_C1(RF, Data) + type(RegFile), intent(inout) :: RF + character(*), pointer, intent(in) :: Data + logical :: PtrInIndex + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if associated + call RegPack(RF, associated(Data)) + if (RegCheckErr(RF, "PackPtr_C1")) return + if (.not. associated(Data)) return + + ! Write pointer info + call RegPackPointer(RF, c_loc(Data), PtrInIndex) + if (RegCheckErr(RF, "PackPtr_C1")) return + if (PtrInIndex) return + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackPtr_C1")) return + end subroutine + + subroutine UnpackPtr_C1(RF, Data) + type(RegFile), intent(inout) :: RF + character(*), pointer, intent(out) :: Data + integer(IntKi) :: stat + integer(B8Ki) :: PtrIdx + logical :: IsAssociated + type(c_ptr) :: Ptr + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! If associated, deallocate and nullify + if (associated(Data)) then + deallocate(Data) + nullify(Data) + end if + + ! Read value to see if it was associated, return if not + call RegUnpack(RF, IsAssociated) + if (RegCheckErr(RF, "UnpackPtr_C1")) return + if (.not. IsAssociated) return + + ! Unpack pointer inf + call RegUnpackPointer(RF, Ptr, PtrIdx) + if (RegCheckErr(RF, "UnpackPtr_C1")) return + + ! If pointer was in index, associate data with pointer, return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, Data) + return + end if + + ! Allocate data + allocate(Data, stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackPtr_C1: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackPtr_C1")) return + end subroutine + + subroutine Pack_C1_Rank1(RF, Data) + type(RegFile), intent(inout) :: RF + character(*), intent(in) :: Data(:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Increment data number and write to file + RF%NumData = RF%NumData + 1 + write(RF%Unit) RF%NumData + + ! Write data to file + write(RF%Unit) Data + end subroutine + + subroutine Unpack_C1_Rank1(RF, Data) + type(RegFile), intent(inout) :: RF + character(*), intent(out) :: Data(:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Read data number, return if invalid + if (.not. DataNumValid(RF)) return + + ! Read data from file + read(RF%Unit) Data + end subroutine + + subroutine PackAlloc_C1_Rank1(RF, Data) + type(RegFile), intent(inout) :: RF + character(*), allocatable, intent(in) :: Data(:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if allocated + call RegPack(RF, allocated(Data)) + if (RegCheckErr(RF, "PackAlloc_C1_Rank1")) return + if (.not. allocated(Data)) return + + ! Write array bounds + call RegPackBounds(RF, 1, lbound(Data), ubound(Data)) + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackAlloc_C1_Rank1")) return + end subroutine + + subroutine UnpackAlloc_C1_Rank1(RF, Data) + type(RegFile), intent(inout) :: RF + character(*), allocatable, intent(out) :: Data(:) + integer(IntKi) :: stat + logical :: IsAllocated + integer(B4Ki) :: LB(1), UB(1) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Deallocate if allocated + if (allocated(Data)) deallocate(Data) + + ! Read value to see if it was allocated, return if not + call RegUnpack(RF, IsAllocated) + if (RegCheckErr(RF, "UnpackAlloc_C1_Rank1")) return + if (.not. IsAllocated) return + + ! Read array bounds + call RegUnpackBounds(RF, 1, LB, UB) + if (RegCheckErr(RF, "UnpackAlloc_C1_Rank1")) return + + ! Allocate data + allocate(Data(LB(1):UB(1)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackAlloc_C1_Rank1: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackAlloc_C1_Rank1")) return + end subroutine + + subroutine PackPtr_C1_Rank1(RF, Data) + type(RegFile), intent(inout) :: RF + character(*), pointer, intent(in) :: Data(:) + logical :: PtrInIndex + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if associated + call RegPack(RF, associated(Data)) + if (RegCheckErr(RF, "PackPtr_C1_Rank1")) return + if (.not. associated(Data)) return + + ! Write array bounds + call RegPackBounds(RF, 1, lbound(Data), ubound(Data)) + + ! Write pointer info + call RegPackPointer(RF, c_loc(Data), PtrInIndex) + if (RegCheckErr(RF, "PackPtr_C1_Rank1")) return + if (PtrInIndex) return + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackPtr_C1_Rank1")) return + end subroutine + + subroutine UnpackPtr_C1_Rank1(RF, Data, LB, UB) + type(RegFile), intent(inout) :: RF + character(*), pointer, intent(out) :: Data(:) + integer(B4Ki), intent(out) :: LB(:), UB(:) + integer(IntKi) :: stat + integer(B8Ki) :: PtrIdx + logical :: IsAssociated + type(c_ptr) :: Ptr + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! If associated, deallocate and nullify + if (associated(Data)) then + deallocate(Data) + nullify(Data) + end if + + ! Read value to see if it was associated, return if not + call RegUnpack(RF, IsAssociated) + if (RegCheckErr(RF, "UnpackPtr_C1_Rank1")) return + if (.not. IsAssociated) return + + ! Read array bounds + call RegUnpackBounds(RF, 1, LB, UB) + if (RegCheckErr(RF, "UnpackPtr_C1_Rank1")) return + + ! Unpack pointer inf + call RegUnpackPointer(RF, Ptr, PtrIdx) + if (RegCheckErr(RF, "UnpackPtr_C1_Rank1")) return + + ! If pointer was in index, associate data with pointer, return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, Data, UB - LB) + Data(LB(1):) => Data + return + end if + + ! Allocate data + allocate(Data(LB(1):UB(1)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackPtr_C1_Rank1: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackPtr_C1_Rank1")) return + end subroutine + + subroutine Pack_C1_Rank2(RF, Data) + type(RegFile), intent(inout) :: RF + character(*), intent(in) :: Data(:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Increment data number and write to file + RF%NumData = RF%NumData + 1 + write(RF%Unit) RF%NumData + + ! Write data to file + write(RF%Unit) Data + end subroutine + + subroutine Unpack_C1_Rank2(RF, Data) + type(RegFile), intent(inout) :: RF + character(*), intent(out) :: Data(:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Read data number, return if invalid + if (.not. DataNumValid(RF)) return + + ! Read data from file + read(RF%Unit) Data + end subroutine + + subroutine PackAlloc_C1_Rank2(RF, Data) + type(RegFile), intent(inout) :: RF + character(*), allocatable, intent(in) :: Data(:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if allocated + call RegPack(RF, allocated(Data)) + if (RegCheckErr(RF, "PackAlloc_C1_Rank2")) return + if (.not. allocated(Data)) return + + ! Write array bounds + call RegPackBounds(RF, 2, lbound(Data), ubound(Data)) + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackAlloc_C1_Rank2")) return + end subroutine + + subroutine UnpackAlloc_C1_Rank2(RF, Data) + type(RegFile), intent(inout) :: RF + character(*), allocatable, intent(out) :: Data(:,:) + integer(IntKi) :: stat + logical :: IsAllocated + integer(B4Ki) :: LB(2), UB(2) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Deallocate if allocated + if (allocated(Data)) deallocate(Data) + + ! Read value to see if it was allocated, return if not + call RegUnpack(RF, IsAllocated) + if (RegCheckErr(RF, "UnpackAlloc_C1_Rank2")) return + if (.not. IsAllocated) return + + ! Read array bounds + call RegUnpackBounds(RF, 2, LB, UB) + if (RegCheckErr(RF, "UnpackAlloc_C1_Rank2")) return + + ! Allocate data + allocate(Data(LB(1):UB(1),LB(2):UB(2)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackAlloc_C1_Rank2: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackAlloc_C1_Rank2")) return + end subroutine + + subroutine PackPtr_C1_Rank2(RF, Data) + type(RegFile), intent(inout) :: RF + character(*), pointer, intent(in) :: Data(:,:) + logical :: PtrInIndex + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if associated + call RegPack(RF, associated(Data)) + if (RegCheckErr(RF, "PackPtr_C1_Rank2")) return + if (.not. associated(Data)) return + + ! Write array bounds + call RegPackBounds(RF, 2, lbound(Data), ubound(Data)) + + ! Write pointer info + call RegPackPointer(RF, c_loc(Data), PtrInIndex) + if (RegCheckErr(RF, "PackPtr_C1_Rank2")) return + if (PtrInIndex) return + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackPtr_C1_Rank2")) return + end subroutine + + subroutine UnpackPtr_C1_Rank2(RF, Data, LB, UB) + type(RegFile), intent(inout) :: RF + character(*), pointer, intent(out) :: Data(:,:) + integer(B4Ki), intent(out) :: LB(:), UB(:) + integer(IntKi) :: stat + integer(B8Ki) :: PtrIdx + logical :: IsAssociated + type(c_ptr) :: Ptr + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! If associated, deallocate and nullify + if (associated(Data)) then + deallocate(Data) + nullify(Data) + end if + + ! Read value to see if it was associated, return if not + call RegUnpack(RF, IsAssociated) + if (RegCheckErr(RF, "UnpackPtr_C1_Rank2")) return + if (.not. IsAssociated) return + + ! Read array bounds + call RegUnpackBounds(RF, 2, LB, UB) + if (RegCheckErr(RF, "UnpackPtr_C1_Rank2")) return + + ! Unpack pointer inf + call RegUnpackPointer(RF, Ptr, PtrIdx) + if (RegCheckErr(RF, "UnpackPtr_C1_Rank2")) return + + ! If pointer was in index, associate data with pointer, return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, Data, UB - LB) + Data(LB(1):,LB(2):) => Data + return + end if + + ! Allocate data + allocate(Data(LB(1):UB(1),LB(2):UB(2)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackPtr_C1_Rank2: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackPtr_C1_Rank2")) return + end subroutine + + subroutine Pack_C1_Rank3(RF, Data) + type(RegFile), intent(inout) :: RF + character(*), intent(in) :: Data(:,:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Increment data number and write to file + RF%NumData = RF%NumData + 1 + write(RF%Unit) RF%NumData + + ! Write data to file + write(RF%Unit) Data + end subroutine + + subroutine Unpack_C1_Rank3(RF, Data) + type(RegFile), intent(inout) :: RF + character(*), intent(out) :: Data(:,:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Read data number, return if invalid + if (.not. DataNumValid(RF)) return + + ! Read data from file + read(RF%Unit) Data + end subroutine + + subroutine PackAlloc_C1_Rank3(RF, Data) + type(RegFile), intent(inout) :: RF + character(*), allocatable, intent(in) :: Data(:,:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if allocated + call RegPack(RF, allocated(Data)) + if (RegCheckErr(RF, "PackAlloc_C1_Rank3")) return + if (.not. allocated(Data)) return + + ! Write array bounds + call RegPackBounds(RF, 3, lbound(Data), ubound(Data)) + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackAlloc_C1_Rank3")) return + end subroutine + + subroutine UnpackAlloc_C1_Rank3(RF, Data) + type(RegFile), intent(inout) :: RF + character(*), allocatable, intent(out) :: Data(:,:,:) + integer(IntKi) :: stat + logical :: IsAllocated + integer(B4Ki) :: LB(3), UB(3) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Deallocate if allocated + if (allocated(Data)) deallocate(Data) + + ! Read value to see if it was allocated, return if not + call RegUnpack(RF, IsAllocated) + if (RegCheckErr(RF, "UnpackAlloc_C1_Rank3")) return + if (.not. IsAllocated) return + + ! Read array bounds + call RegUnpackBounds(RF, 3, LB, UB) + if (RegCheckErr(RF, "UnpackAlloc_C1_Rank3")) return + + ! Allocate data + allocate(Data(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackAlloc_C1_Rank3: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackAlloc_C1_Rank3")) return + end subroutine + + subroutine PackPtr_C1_Rank3(RF, Data) + type(RegFile), intent(inout) :: RF + character(*), pointer, intent(in) :: Data(:,:,:) + logical :: PtrInIndex + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if associated + call RegPack(RF, associated(Data)) + if (RegCheckErr(RF, "PackPtr_C1_Rank3")) return + if (.not. associated(Data)) return + + ! Write array bounds + call RegPackBounds(RF, 3, lbound(Data), ubound(Data)) + + ! Write pointer info + call RegPackPointer(RF, c_loc(Data), PtrInIndex) + if (RegCheckErr(RF, "PackPtr_C1_Rank3")) return + if (PtrInIndex) return + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackPtr_C1_Rank3")) return + end subroutine + + subroutine UnpackPtr_C1_Rank3(RF, Data, LB, UB) + type(RegFile), intent(inout) :: RF + character(*), pointer, intent(out) :: Data(:,:,:) + integer(B4Ki), intent(out) :: LB(:), UB(:) + integer(IntKi) :: stat + integer(B8Ki) :: PtrIdx + logical :: IsAssociated + type(c_ptr) :: Ptr + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! If associated, deallocate and nullify + if (associated(Data)) then + deallocate(Data) + nullify(Data) + end if + + ! Read value to see if it was associated, return if not + call RegUnpack(RF, IsAssociated) + if (RegCheckErr(RF, "UnpackPtr_C1_Rank3")) return + if (.not. IsAssociated) return + + ! Read array bounds + call RegUnpackBounds(RF, 3, LB, UB) + if (RegCheckErr(RF, "UnpackPtr_C1_Rank3")) return + + ! Unpack pointer inf + call RegUnpackPointer(RF, Ptr, PtrIdx) + if (RegCheckErr(RF, "UnpackPtr_C1_Rank3")) return + + ! If pointer was in index, associate data with pointer, return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, Data, UB - LB) + Data(LB(1):,LB(2):,LB(3):) => Data + return + end if + + ! Allocate data + allocate(Data(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackPtr_C1_Rank3: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackPtr_C1_Rank3")) return + end subroutine + + subroutine Pack_C1_Rank4(RF, Data) + type(RegFile), intent(inout) :: RF + character(*), intent(in) :: Data(:,:,:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Increment data number and write to file + RF%NumData = RF%NumData + 1 + write(RF%Unit) RF%NumData + + ! Write data to file + write(RF%Unit) Data + end subroutine + + subroutine Unpack_C1_Rank4(RF, Data) + type(RegFile), intent(inout) :: RF + character(*), intent(out) :: Data(:,:,:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Read data number, return if invalid + if (.not. DataNumValid(RF)) return + + ! Read data from file + read(RF%Unit) Data + end subroutine + + subroutine PackAlloc_C1_Rank4(RF, Data) + type(RegFile), intent(inout) :: RF + character(*), allocatable, intent(in) :: Data(:,:,:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if allocated + call RegPack(RF, allocated(Data)) + if (RegCheckErr(RF, "PackAlloc_C1_Rank4")) return + if (.not. allocated(Data)) return + + ! Write array bounds + call RegPackBounds(RF, 4, lbound(Data), ubound(Data)) + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackAlloc_C1_Rank4")) return + end subroutine + + subroutine UnpackAlloc_C1_Rank4(RF, Data) + type(RegFile), intent(inout) :: RF + character(*), allocatable, intent(out) :: Data(:,:,:,:) + integer(IntKi) :: stat + logical :: IsAllocated + integer(B4Ki) :: LB(4), UB(4) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Deallocate if allocated + if (allocated(Data)) deallocate(Data) + + ! Read value to see if it was allocated, return if not + call RegUnpack(RF, IsAllocated) + if (RegCheckErr(RF, "UnpackAlloc_C1_Rank4")) return + if (.not. IsAllocated) return + + ! Read array bounds + call RegUnpackBounds(RF, 4, LB, UB) + if (RegCheckErr(RF, "UnpackAlloc_C1_Rank4")) return + + ! Allocate data + allocate(Data(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackAlloc_C1_Rank4: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackAlloc_C1_Rank4")) return + end subroutine + + subroutine PackPtr_C1_Rank4(RF, Data) + type(RegFile), intent(inout) :: RF + character(*), pointer, intent(in) :: Data(:,:,:,:) + logical :: PtrInIndex + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if associated + call RegPack(RF, associated(Data)) + if (RegCheckErr(RF, "PackPtr_C1_Rank4")) return + if (.not. associated(Data)) return + + ! Write array bounds + call RegPackBounds(RF, 4, lbound(Data), ubound(Data)) + + ! Write pointer info + call RegPackPointer(RF, c_loc(Data), PtrInIndex) + if (RegCheckErr(RF, "PackPtr_C1_Rank4")) return + if (PtrInIndex) return + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackPtr_C1_Rank4")) return + end subroutine + + subroutine UnpackPtr_C1_Rank4(RF, Data, LB, UB) + type(RegFile), intent(inout) :: RF + character(*), pointer, intent(out) :: Data(:,:,:,:) + integer(B4Ki), intent(out) :: LB(:), UB(:) + integer(IntKi) :: stat + integer(B8Ki) :: PtrIdx + logical :: IsAssociated + type(c_ptr) :: Ptr + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! If associated, deallocate and nullify + if (associated(Data)) then + deallocate(Data) + nullify(Data) + end if + + ! Read value to see if it was associated, return if not + call RegUnpack(RF, IsAssociated) + if (RegCheckErr(RF, "UnpackPtr_C1_Rank4")) return + if (.not. IsAssociated) return + + ! Read array bounds + call RegUnpackBounds(RF, 4, LB, UB) + if (RegCheckErr(RF, "UnpackPtr_C1_Rank4")) return + + ! Unpack pointer inf + call RegUnpackPointer(RF, Ptr, PtrIdx) + if (RegCheckErr(RF, "UnpackPtr_C1_Rank4")) return + + ! If pointer was in index, associate data with pointer, return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, Data, UB - LB) + Data(LB(1):,LB(2):,LB(3):,LB(4):) => Data + return + end if + + ! Allocate data + allocate(Data(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackPtr_C1_Rank4: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackPtr_C1_Rank4")) return + end subroutine + + subroutine Pack_C1_Rank5(RF, Data) + type(RegFile), intent(inout) :: RF + character(*), intent(in) :: Data(:,:,:,:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Increment data number and write to file + RF%NumData = RF%NumData + 1 + write(RF%Unit) RF%NumData + + ! Write data to file + write(RF%Unit) Data + end subroutine + + subroutine Unpack_C1_Rank5(RF, Data) + type(RegFile), intent(inout) :: RF + character(*), intent(out) :: Data(:,:,:,:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Read data number, return if invalid + if (.not. DataNumValid(RF)) return + + ! Read data from file + read(RF%Unit) Data + end subroutine + + subroutine PackAlloc_C1_Rank5(RF, Data) + type(RegFile), intent(inout) :: RF + character(*), allocatable, intent(in) :: Data(:,:,:,:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if allocated + call RegPack(RF, allocated(Data)) + if (RegCheckErr(RF, "PackAlloc_C1_Rank5")) return + if (.not. allocated(Data)) return + + ! Write array bounds + call RegPackBounds(RF, 5, lbound(Data), ubound(Data)) + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackAlloc_C1_Rank5")) return + end subroutine + + subroutine UnpackAlloc_C1_Rank5(RF, Data) + type(RegFile), intent(inout) :: RF + character(*), allocatable, intent(out) :: Data(:,:,:,:,:) + integer(IntKi) :: stat + logical :: IsAllocated + integer(B4Ki) :: LB(5), UB(5) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Deallocate if allocated + if (allocated(Data)) deallocate(Data) + + ! Read value to see if it was allocated, return if not + call RegUnpack(RF, IsAllocated) + if (RegCheckErr(RF, "UnpackAlloc_C1_Rank5")) return + if (.not. IsAllocated) return + + ! Read array bounds + call RegUnpackBounds(RF, 5, LB, UB) + if (RegCheckErr(RF, "UnpackAlloc_C1_Rank5")) return + + ! Allocate data + allocate(Data(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackAlloc_C1_Rank5: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackAlloc_C1_Rank5")) return + end subroutine + + subroutine PackPtr_C1_Rank5(RF, Data) + type(RegFile), intent(inout) :: RF + character(*), pointer, intent(in) :: Data(:,:,:,:,:) + logical :: PtrInIndex + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if associated + call RegPack(RF, associated(Data)) + if (RegCheckErr(RF, "PackPtr_C1_Rank5")) return + if (.not. associated(Data)) return + + ! Write array bounds + call RegPackBounds(RF, 5, lbound(Data), ubound(Data)) + + ! Write pointer info + call RegPackPointer(RF, c_loc(Data), PtrInIndex) + if (RegCheckErr(RF, "PackPtr_C1_Rank5")) return + if (PtrInIndex) return + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackPtr_C1_Rank5")) return + end subroutine + + subroutine UnpackPtr_C1_Rank5(RF, Data, LB, UB) + type(RegFile), intent(inout) :: RF + character(*), pointer, intent(out) :: Data(:,:,:,:,:) + integer(B4Ki), intent(out) :: LB(:), UB(:) + integer(IntKi) :: stat + integer(B8Ki) :: PtrIdx + logical :: IsAssociated + type(c_ptr) :: Ptr + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! If associated, deallocate and nullify + if (associated(Data)) then + deallocate(Data) + nullify(Data) + end if + + ! Read value to see if it was associated, return if not + call RegUnpack(RF, IsAssociated) + if (RegCheckErr(RF, "UnpackPtr_C1_Rank5")) return + if (.not. IsAssociated) return + + ! Read array bounds + call RegUnpackBounds(RF, 5, LB, UB) + if (RegCheckErr(RF, "UnpackPtr_C1_Rank5")) return + + ! Unpack pointer inf + call RegUnpackPointer(RF, Ptr, PtrIdx) + if (RegCheckErr(RF, "UnpackPtr_C1_Rank5")) return + + ! If pointer was in index, associate data with pointer, return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, Data, UB - LB) + Data(LB(1):,LB(2):,LB(3):,LB(4):,LB(5):) => Data + return + end if + + ! Allocate data + allocate(Data(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackPtr_C1_Rank5: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackPtr_C1_Rank5")) return + end subroutine + + subroutine Pack_L1(RF, Data) + type(RegFile), intent(inout) :: RF + logical, intent(in) :: Data + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Increment data number and write to file + RF%NumData = RF%NumData + 1 + write(RF%Unit) RF%NumData + + ! Write data to file + write(RF%Unit) Data + end subroutine + + subroutine Unpack_L1(RF, Data) + type(RegFile), intent(inout) :: RF + logical, intent(out) :: Data + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Read data number, return if invalid + if (.not. DataNumValid(RF)) return + + ! Read data from file + read(RF%Unit) Data + end subroutine + + subroutine PackAlloc_L1(RF, Data) + type(RegFile), intent(inout) :: RF + logical, allocatable, intent(in) :: Data + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if allocated + call RegPack(RF, allocated(Data)) + if (RegCheckErr(RF, "PackAlloc_L1")) return + if (.not. allocated(Data)) return + + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackAlloc_L1")) return + end subroutine + + subroutine UnpackAlloc_L1(RF, Data) + type(RegFile), intent(inout) :: RF + logical, allocatable, intent(out) :: Data + integer(IntKi) :: stat + logical :: IsAllocated + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Deallocate if allocated + if (allocated(Data)) deallocate(Data) + + ! Read value to see if it was allocated, return if not + call RegUnpack(RF, IsAllocated) + if (RegCheckErr(RF, "UnpackAlloc_L1")) return + if (.not. IsAllocated) return + + + ! Allocate data + allocate(Data, stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackAlloc_L1: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackAlloc_L1")) return + end subroutine + + subroutine PackPtr_L1(RF, Data) + type(RegFile), intent(inout) :: RF + logical, pointer, intent(in) :: Data + logical :: PtrInIndex + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if associated + call RegPack(RF, associated(Data)) + if (RegCheckErr(RF, "PackPtr_L1")) return + if (.not. associated(Data)) return + + ! Write pointer info + call RegPackPointer(RF, c_loc(Data), PtrInIndex) + if (RegCheckErr(RF, "PackPtr_L1")) return + if (PtrInIndex) return + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackPtr_L1")) return + end subroutine + + subroutine UnpackPtr_L1(RF, Data) + type(RegFile), intent(inout) :: RF + logical, pointer, intent(out) :: Data + integer(IntKi) :: stat + integer(B8Ki) :: PtrIdx + logical :: IsAssociated + type(c_ptr) :: Ptr + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! If associated, deallocate and nullify + if (associated(Data)) then + deallocate(Data) + nullify(Data) + end if + + ! Read value to see if it was associated, return if not + call RegUnpack(RF, IsAssociated) + if (RegCheckErr(RF, "UnpackPtr_L1")) return + if (.not. IsAssociated) return + + ! Unpack pointer inf + call RegUnpackPointer(RF, Ptr, PtrIdx) + if (RegCheckErr(RF, "UnpackPtr_L1")) return + + ! If pointer was in index, associate data with pointer, return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, Data) + return + end if + + ! Allocate data + allocate(Data, stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackPtr_L1: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackPtr_L1")) return + end subroutine + + subroutine Pack_L1_Rank1(RF, Data) + type(RegFile), intent(inout) :: RF + logical, intent(in) :: Data(:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Increment data number and write to file + RF%NumData = RF%NumData + 1 + write(RF%Unit) RF%NumData + + ! Write data to file + write(RF%Unit) Data + end subroutine + + subroutine Unpack_L1_Rank1(RF, Data) + type(RegFile), intent(inout) :: RF + logical, intent(out) :: Data(:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Read data number, return if invalid + if (.not. DataNumValid(RF)) return + + ! Read data from file + read(RF%Unit) Data + end subroutine + + subroutine PackAlloc_L1_Rank1(RF, Data) + type(RegFile), intent(inout) :: RF + logical, allocatable, intent(in) :: Data(:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if allocated + call RegPack(RF, allocated(Data)) + if (RegCheckErr(RF, "PackAlloc_L1_Rank1")) return + if (.not. allocated(Data)) return + + ! Write array bounds + call RegPackBounds(RF, 1, lbound(Data), ubound(Data)) + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackAlloc_L1_Rank1")) return + end subroutine + + subroutine UnpackAlloc_L1_Rank1(RF, Data) + type(RegFile), intent(inout) :: RF + logical, allocatable, intent(out) :: Data(:) + integer(IntKi) :: stat + logical :: IsAllocated + integer(B4Ki) :: LB(1), UB(1) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Deallocate if allocated + if (allocated(Data)) deallocate(Data) + + ! Read value to see if it was allocated, return if not + call RegUnpack(RF, IsAllocated) + if (RegCheckErr(RF, "UnpackAlloc_L1_Rank1")) return + if (.not. IsAllocated) return + + ! Read array bounds + call RegUnpackBounds(RF, 1, LB, UB) + if (RegCheckErr(RF, "UnpackAlloc_L1_Rank1")) return + + ! Allocate data + allocate(Data(LB(1):UB(1)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackAlloc_L1_Rank1: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackAlloc_L1_Rank1")) return + end subroutine + + subroutine PackPtr_L1_Rank1(RF, Data) + type(RegFile), intent(inout) :: RF + logical, pointer, intent(in) :: Data(:) + logical :: PtrInIndex + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if associated + call RegPack(RF, associated(Data)) + if (RegCheckErr(RF, "PackPtr_L1_Rank1")) return + if (.not. associated(Data)) return + + ! Write array bounds + call RegPackBounds(RF, 1, lbound(Data), ubound(Data)) + + ! Write pointer info + call RegPackPointer(RF, c_loc(Data), PtrInIndex) + if (RegCheckErr(RF, "PackPtr_L1_Rank1")) return + if (PtrInIndex) return + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackPtr_L1_Rank1")) return + end subroutine + + subroutine UnpackPtr_L1_Rank1(RF, Data, LB, UB) + type(RegFile), intent(inout) :: RF + logical, pointer, intent(out) :: Data(:) + integer(B4Ki), intent(out) :: LB(:), UB(:) + integer(IntKi) :: stat + integer(B8Ki) :: PtrIdx + logical :: IsAssociated + type(c_ptr) :: Ptr + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! If associated, deallocate and nullify + if (associated(Data)) then + deallocate(Data) + nullify(Data) + end if + + ! Read value to see if it was associated, return if not + call RegUnpack(RF, IsAssociated) + if (RegCheckErr(RF, "UnpackPtr_L1_Rank1")) return + if (.not. IsAssociated) return + + ! Read array bounds + call RegUnpackBounds(RF, 1, LB, UB) + if (RegCheckErr(RF, "UnpackPtr_L1_Rank1")) return + + ! Unpack pointer inf + call RegUnpackPointer(RF, Ptr, PtrIdx) + if (RegCheckErr(RF, "UnpackPtr_L1_Rank1")) return + + ! If pointer was in index, associate data with pointer, return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, Data, UB - LB) + Data(LB(1):) => Data + return + end if + + ! Allocate data + allocate(Data(LB(1):UB(1)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackPtr_L1_Rank1: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackPtr_L1_Rank1")) return + end subroutine + + subroutine Pack_L1_Rank2(RF, Data) + type(RegFile), intent(inout) :: RF + logical, intent(in) :: Data(:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Increment data number and write to file + RF%NumData = RF%NumData + 1 + write(RF%Unit) RF%NumData + + ! Write data to file + write(RF%Unit) Data + end subroutine + + subroutine Unpack_L1_Rank2(RF, Data) + type(RegFile), intent(inout) :: RF + logical, intent(out) :: Data(:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Read data number, return if invalid + if (.not. DataNumValid(RF)) return + + ! Read data from file + read(RF%Unit) Data + end subroutine + + subroutine PackAlloc_L1_Rank2(RF, Data) + type(RegFile), intent(inout) :: RF + logical, allocatable, intent(in) :: Data(:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if allocated + call RegPack(RF, allocated(Data)) + if (RegCheckErr(RF, "PackAlloc_L1_Rank2")) return + if (.not. allocated(Data)) return + + ! Write array bounds + call RegPackBounds(RF, 2, lbound(Data), ubound(Data)) + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackAlloc_L1_Rank2")) return + end subroutine + + subroutine UnpackAlloc_L1_Rank2(RF, Data) + type(RegFile), intent(inout) :: RF + logical, allocatable, intent(out) :: Data(:,:) + integer(IntKi) :: stat + logical :: IsAllocated + integer(B4Ki) :: LB(2), UB(2) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Deallocate if allocated + if (allocated(Data)) deallocate(Data) + + ! Read value to see if it was allocated, return if not + call RegUnpack(RF, IsAllocated) + if (RegCheckErr(RF, "UnpackAlloc_L1_Rank2")) return + if (.not. IsAllocated) return + + ! Read array bounds + call RegUnpackBounds(RF, 2, LB, UB) + if (RegCheckErr(RF, "UnpackAlloc_L1_Rank2")) return + + ! Allocate data + allocate(Data(LB(1):UB(1),LB(2):UB(2)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackAlloc_L1_Rank2: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackAlloc_L1_Rank2")) return + end subroutine + + subroutine PackPtr_L1_Rank2(RF, Data) + type(RegFile), intent(inout) :: RF + logical, pointer, intent(in) :: Data(:,:) + logical :: PtrInIndex + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if associated + call RegPack(RF, associated(Data)) + if (RegCheckErr(RF, "PackPtr_L1_Rank2")) return + if (.not. associated(Data)) return + + ! Write array bounds + call RegPackBounds(RF, 2, lbound(Data), ubound(Data)) + + ! Write pointer info + call RegPackPointer(RF, c_loc(Data), PtrInIndex) + if (RegCheckErr(RF, "PackPtr_L1_Rank2")) return + if (PtrInIndex) return + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackPtr_L1_Rank2")) return + end subroutine + + subroutine UnpackPtr_L1_Rank2(RF, Data, LB, UB) + type(RegFile), intent(inout) :: RF + logical, pointer, intent(out) :: Data(:,:) + integer(B4Ki), intent(out) :: LB(:), UB(:) + integer(IntKi) :: stat + integer(B8Ki) :: PtrIdx + logical :: IsAssociated + type(c_ptr) :: Ptr + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! If associated, deallocate and nullify + if (associated(Data)) then + deallocate(Data) + nullify(Data) + end if + + ! Read value to see if it was associated, return if not + call RegUnpack(RF, IsAssociated) + if (RegCheckErr(RF, "UnpackPtr_L1_Rank2")) return + if (.not. IsAssociated) return + + ! Read array bounds + call RegUnpackBounds(RF, 2, LB, UB) + if (RegCheckErr(RF, "UnpackPtr_L1_Rank2")) return + + ! Unpack pointer inf + call RegUnpackPointer(RF, Ptr, PtrIdx) + if (RegCheckErr(RF, "UnpackPtr_L1_Rank2")) return + + ! If pointer was in index, associate data with pointer, return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, Data, UB - LB) + Data(LB(1):,LB(2):) => Data + return + end if + + ! Allocate data + allocate(Data(LB(1):UB(1),LB(2):UB(2)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackPtr_L1_Rank2: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackPtr_L1_Rank2")) return + end subroutine + + subroutine Pack_L1_Rank3(RF, Data) + type(RegFile), intent(inout) :: RF + logical, intent(in) :: Data(:,:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Increment data number and write to file + RF%NumData = RF%NumData + 1 + write(RF%Unit) RF%NumData + + ! Write data to file + write(RF%Unit) Data + end subroutine + + subroutine Unpack_L1_Rank3(RF, Data) + type(RegFile), intent(inout) :: RF + logical, intent(out) :: Data(:,:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Read data number, return if invalid + if (.not. DataNumValid(RF)) return + + ! Read data from file + read(RF%Unit) Data + end subroutine + + subroutine PackAlloc_L1_Rank3(RF, Data) + type(RegFile), intent(inout) :: RF + logical, allocatable, intent(in) :: Data(:,:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if allocated + call RegPack(RF, allocated(Data)) + if (RegCheckErr(RF, "PackAlloc_L1_Rank3")) return + if (.not. allocated(Data)) return + + ! Write array bounds + call RegPackBounds(RF, 3, lbound(Data), ubound(Data)) + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackAlloc_L1_Rank3")) return + end subroutine + + subroutine UnpackAlloc_L1_Rank3(RF, Data) + type(RegFile), intent(inout) :: RF + logical, allocatable, intent(out) :: Data(:,:,:) + integer(IntKi) :: stat + logical :: IsAllocated + integer(B4Ki) :: LB(3), UB(3) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Deallocate if allocated + if (allocated(Data)) deallocate(Data) + + ! Read value to see if it was allocated, return if not + call RegUnpack(RF, IsAllocated) + if (RegCheckErr(RF, "UnpackAlloc_L1_Rank3")) return + if (.not. IsAllocated) return + + ! Read array bounds + call RegUnpackBounds(RF, 3, LB, UB) + if (RegCheckErr(RF, "UnpackAlloc_L1_Rank3")) return + + ! Allocate data + allocate(Data(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackAlloc_L1_Rank3: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackAlloc_L1_Rank3")) return + end subroutine + + subroutine PackPtr_L1_Rank3(RF, Data) + type(RegFile), intent(inout) :: RF + logical, pointer, intent(in) :: Data(:,:,:) + logical :: PtrInIndex + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if associated + call RegPack(RF, associated(Data)) + if (RegCheckErr(RF, "PackPtr_L1_Rank3")) return + if (.not. associated(Data)) return + + ! Write array bounds + call RegPackBounds(RF, 3, lbound(Data), ubound(Data)) + + ! Write pointer info + call RegPackPointer(RF, c_loc(Data), PtrInIndex) + if (RegCheckErr(RF, "PackPtr_L1_Rank3")) return + if (PtrInIndex) return + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackPtr_L1_Rank3")) return + end subroutine + + subroutine UnpackPtr_L1_Rank3(RF, Data, LB, UB) + type(RegFile), intent(inout) :: RF + logical, pointer, intent(out) :: Data(:,:,:) + integer(B4Ki), intent(out) :: LB(:), UB(:) + integer(IntKi) :: stat + integer(B8Ki) :: PtrIdx + logical :: IsAssociated + type(c_ptr) :: Ptr + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! If associated, deallocate and nullify + if (associated(Data)) then + deallocate(Data) + nullify(Data) + end if + + ! Read value to see if it was associated, return if not + call RegUnpack(RF, IsAssociated) + if (RegCheckErr(RF, "UnpackPtr_L1_Rank3")) return + if (.not. IsAssociated) return + + ! Read array bounds + call RegUnpackBounds(RF, 3, LB, UB) + if (RegCheckErr(RF, "UnpackPtr_L1_Rank3")) return + + ! Unpack pointer inf + call RegUnpackPointer(RF, Ptr, PtrIdx) + if (RegCheckErr(RF, "UnpackPtr_L1_Rank3")) return + + ! If pointer was in index, associate data with pointer, return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, Data, UB - LB) + Data(LB(1):,LB(2):,LB(3):) => Data + return + end if + + ! Allocate data + allocate(Data(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackPtr_L1_Rank3: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackPtr_L1_Rank3")) return + end subroutine + + subroutine Pack_L1_Rank4(RF, Data) + type(RegFile), intent(inout) :: RF + logical, intent(in) :: Data(:,:,:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Increment data number and write to file + RF%NumData = RF%NumData + 1 + write(RF%Unit) RF%NumData + + ! Write data to file + write(RF%Unit) Data + end subroutine + + subroutine Unpack_L1_Rank4(RF, Data) + type(RegFile), intent(inout) :: RF + logical, intent(out) :: Data(:,:,:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Read data number, return if invalid + if (.not. DataNumValid(RF)) return + + ! Read data from file + read(RF%Unit) Data + end subroutine + + subroutine PackAlloc_L1_Rank4(RF, Data) + type(RegFile), intent(inout) :: RF + logical, allocatable, intent(in) :: Data(:,:,:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if allocated + call RegPack(RF, allocated(Data)) + if (RegCheckErr(RF, "PackAlloc_L1_Rank4")) return + if (.not. allocated(Data)) return + + ! Write array bounds + call RegPackBounds(RF, 4, lbound(Data), ubound(Data)) + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackAlloc_L1_Rank4")) return + end subroutine + + subroutine UnpackAlloc_L1_Rank4(RF, Data) + type(RegFile), intent(inout) :: RF + logical, allocatable, intent(out) :: Data(:,:,:,:) + integer(IntKi) :: stat + logical :: IsAllocated + integer(B4Ki) :: LB(4), UB(4) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Deallocate if allocated + if (allocated(Data)) deallocate(Data) + + ! Read value to see if it was allocated, return if not + call RegUnpack(RF, IsAllocated) + if (RegCheckErr(RF, "UnpackAlloc_L1_Rank4")) return + if (.not. IsAllocated) return + + ! Read array bounds + call RegUnpackBounds(RF, 4, LB, UB) + if (RegCheckErr(RF, "UnpackAlloc_L1_Rank4")) return + + ! Allocate data + allocate(Data(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackAlloc_L1_Rank4: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackAlloc_L1_Rank4")) return + end subroutine + + subroutine PackPtr_L1_Rank4(RF, Data) + type(RegFile), intent(inout) :: RF + logical, pointer, intent(in) :: Data(:,:,:,:) + logical :: PtrInIndex + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if associated + call RegPack(RF, associated(Data)) + if (RegCheckErr(RF, "PackPtr_L1_Rank4")) return + if (.not. associated(Data)) return + + ! Write array bounds + call RegPackBounds(RF, 4, lbound(Data), ubound(Data)) + + ! Write pointer info + call RegPackPointer(RF, c_loc(Data), PtrInIndex) + if (RegCheckErr(RF, "PackPtr_L1_Rank4")) return + if (PtrInIndex) return + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackPtr_L1_Rank4")) return + end subroutine + + subroutine UnpackPtr_L1_Rank4(RF, Data, LB, UB) + type(RegFile), intent(inout) :: RF + logical, pointer, intent(out) :: Data(:,:,:,:) + integer(B4Ki), intent(out) :: LB(:), UB(:) + integer(IntKi) :: stat + integer(B8Ki) :: PtrIdx + logical :: IsAssociated + type(c_ptr) :: Ptr + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! If associated, deallocate and nullify + if (associated(Data)) then + deallocate(Data) + nullify(Data) + end if + + ! Read value to see if it was associated, return if not + call RegUnpack(RF, IsAssociated) + if (RegCheckErr(RF, "UnpackPtr_L1_Rank4")) return + if (.not. IsAssociated) return + + ! Read array bounds + call RegUnpackBounds(RF, 4, LB, UB) + if (RegCheckErr(RF, "UnpackPtr_L1_Rank4")) return + + ! Unpack pointer inf + call RegUnpackPointer(RF, Ptr, PtrIdx) + if (RegCheckErr(RF, "UnpackPtr_L1_Rank4")) return + + ! If pointer was in index, associate data with pointer, return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, Data, UB - LB) + Data(LB(1):,LB(2):,LB(3):,LB(4):) => Data + return + end if + + ! Allocate data + allocate(Data(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackPtr_L1_Rank4: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackPtr_L1_Rank4")) return + end subroutine + + subroutine Pack_L1_Rank5(RF, Data) + type(RegFile), intent(inout) :: RF + logical, intent(in) :: Data(:,:,:,:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Increment data number and write to file + RF%NumData = RF%NumData + 1 + write(RF%Unit) RF%NumData + + ! Write data to file + write(RF%Unit) Data + end subroutine + + subroutine Unpack_L1_Rank5(RF, Data) + type(RegFile), intent(inout) :: RF + logical, intent(out) :: Data(:,:,:,:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Read data number, return if invalid + if (.not. DataNumValid(RF)) return + + ! Read data from file + read(RF%Unit) Data + end subroutine + + subroutine PackAlloc_L1_Rank5(RF, Data) + type(RegFile), intent(inout) :: RF + logical, allocatable, intent(in) :: Data(:,:,:,:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if allocated + call RegPack(RF, allocated(Data)) + if (RegCheckErr(RF, "PackAlloc_L1_Rank5")) return + if (.not. allocated(Data)) return + + ! Write array bounds + call RegPackBounds(RF, 5, lbound(Data), ubound(Data)) + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackAlloc_L1_Rank5")) return + end subroutine + + subroutine UnpackAlloc_L1_Rank5(RF, Data) + type(RegFile), intent(inout) :: RF + logical, allocatable, intent(out) :: Data(:,:,:,:,:) + integer(IntKi) :: stat + logical :: IsAllocated + integer(B4Ki) :: LB(5), UB(5) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Deallocate if allocated + if (allocated(Data)) deallocate(Data) + + ! Read value to see if it was allocated, return if not + call RegUnpack(RF, IsAllocated) + if (RegCheckErr(RF, "UnpackAlloc_L1_Rank5")) return + if (.not. IsAllocated) return + + ! Read array bounds + call RegUnpackBounds(RF, 5, LB, UB) + if (RegCheckErr(RF, "UnpackAlloc_L1_Rank5")) return + + ! Allocate data + allocate(Data(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackAlloc_L1_Rank5: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackAlloc_L1_Rank5")) return + end subroutine + + subroutine PackPtr_L1_Rank5(RF, Data) + type(RegFile), intent(inout) :: RF + logical, pointer, intent(in) :: Data(:,:,:,:,:) + logical :: PtrInIndex + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if associated + call RegPack(RF, associated(Data)) + if (RegCheckErr(RF, "PackPtr_L1_Rank5")) return + if (.not. associated(Data)) return + + ! Write array bounds + call RegPackBounds(RF, 5, lbound(Data), ubound(Data)) + + ! Write pointer info + call RegPackPointer(RF, c_loc(Data), PtrInIndex) + if (RegCheckErr(RF, "PackPtr_L1_Rank5")) return + if (PtrInIndex) return + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackPtr_L1_Rank5")) return + end subroutine + + subroutine UnpackPtr_L1_Rank5(RF, Data, LB, UB) + type(RegFile), intent(inout) :: RF + logical, pointer, intent(out) :: Data(:,:,:,:,:) + integer(B4Ki), intent(out) :: LB(:), UB(:) + integer(IntKi) :: stat + integer(B8Ki) :: PtrIdx + logical :: IsAssociated + type(c_ptr) :: Ptr + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! If associated, deallocate and nullify + if (associated(Data)) then + deallocate(Data) + nullify(Data) + end if + + ! Read value to see if it was associated, return if not + call RegUnpack(RF, IsAssociated) + if (RegCheckErr(RF, "UnpackPtr_L1_Rank5")) return + if (.not. IsAssociated) return + + ! Read array bounds + call RegUnpackBounds(RF, 5, LB, UB) + if (RegCheckErr(RF, "UnpackPtr_L1_Rank5")) return + + ! Unpack pointer inf + call RegUnpackPointer(RF, Ptr, PtrIdx) + if (RegCheckErr(RF, "UnpackPtr_L1_Rank5")) return + + ! If pointer was in index, associate data with pointer, return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, Data, UB - LB) + Data(LB(1):,LB(2):,LB(3):,LB(4):,LB(5):) => Data + return + end if + + ! Allocate data + allocate(Data(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackPtr_L1_Rank5: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackPtr_L1_Rank5")) return + end subroutine + + subroutine Pack_I4(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B4Ki), intent(in) :: Data + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Increment data number and write to file + RF%NumData = RF%NumData + 1 + write(RF%Unit) RF%NumData + + ! Write data to file + write(RF%Unit) Data + end subroutine + + subroutine Unpack_I4(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B4Ki), intent(out) :: Data + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Read data number, return if invalid + if (.not. DataNumValid(RF)) return + + ! Read data from file + read(RF%Unit) Data + end subroutine + + subroutine PackAlloc_I4(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B4Ki), allocatable, intent(in) :: Data + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if allocated + call RegPack(RF, allocated(Data)) + if (RegCheckErr(RF, "PackAlloc_I4")) return + if (.not. allocated(Data)) return + + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackAlloc_I4")) return + end subroutine + + subroutine UnpackAlloc_I4(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B4Ki), allocatable, intent(out) :: Data + integer(IntKi) :: stat + logical :: IsAllocated + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Deallocate if allocated + if (allocated(Data)) deallocate(Data) + + ! Read value to see if it was allocated, return if not + call RegUnpack(RF, IsAllocated) + if (RegCheckErr(RF, "UnpackAlloc_I4")) return + if (.not. IsAllocated) return + + + ! Allocate data + allocate(Data, stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackAlloc_I4: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackAlloc_I4")) return + end subroutine + + subroutine PackPtr_I4(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B4Ki), pointer, intent(in) :: Data + logical :: PtrInIndex + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if associated + call RegPack(RF, associated(Data)) + if (RegCheckErr(RF, "PackPtr_I4")) return + if (.not. associated(Data)) return + + ! Write pointer info + call RegPackPointer(RF, c_loc(Data), PtrInIndex) + if (RegCheckErr(RF, "PackPtr_I4")) return + if (PtrInIndex) return + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackPtr_I4")) return + end subroutine + + subroutine UnpackPtr_I4(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B4Ki), pointer, intent(out) :: Data + integer(IntKi) :: stat + integer(B8Ki) :: PtrIdx + logical :: IsAssociated + type(c_ptr) :: Ptr + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! If associated, deallocate and nullify + if (associated(Data)) then + deallocate(Data) + nullify(Data) + end if + + ! Read value to see if it was associated, return if not + call RegUnpack(RF, IsAssociated) + if (RegCheckErr(RF, "UnpackPtr_I4")) return + if (.not. IsAssociated) return + + ! Unpack pointer inf + call RegUnpackPointer(RF, Ptr, PtrIdx) + if (RegCheckErr(RF, "UnpackPtr_I4")) return + + ! If pointer was in index, associate data with pointer, return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, Data) + return + end if + + ! Allocate data + allocate(Data, stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackPtr_I4: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackPtr_I4")) return + end subroutine + + subroutine Pack_I4_Rank1(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B4Ki), intent(in) :: Data(:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Increment data number and write to file + RF%NumData = RF%NumData + 1 + write(RF%Unit) RF%NumData + + ! Write data to file + write(RF%Unit) Data + end subroutine + + subroutine Unpack_I4_Rank1(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B4Ki), intent(out) :: Data(:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Read data number, return if invalid + if (.not. DataNumValid(RF)) return + + ! Read data from file + read(RF%Unit) Data + end subroutine + + subroutine PackAlloc_I4_Rank1(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B4Ki), allocatable, intent(in) :: Data(:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if allocated + call RegPack(RF, allocated(Data)) + if (RegCheckErr(RF, "PackAlloc_I4_Rank1")) return + if (.not. allocated(Data)) return + + ! Write array bounds + call RegPackBounds(RF, 1, lbound(Data), ubound(Data)) + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackAlloc_I4_Rank1")) return + end subroutine + + subroutine UnpackAlloc_I4_Rank1(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B4Ki), allocatable, intent(out) :: Data(:) + integer(IntKi) :: stat + logical :: IsAllocated + integer(B4Ki) :: LB(1), UB(1) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Deallocate if allocated + if (allocated(Data)) deallocate(Data) + + ! Read value to see if it was allocated, return if not + call RegUnpack(RF, IsAllocated) + if (RegCheckErr(RF, "UnpackAlloc_I4_Rank1")) return + if (.not. IsAllocated) return + + ! Read array bounds + call RegUnpackBounds(RF, 1, LB, UB) + if (RegCheckErr(RF, "UnpackAlloc_I4_Rank1")) return + + ! Allocate data + allocate(Data(LB(1):UB(1)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackAlloc_I4_Rank1: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackAlloc_I4_Rank1")) return + end subroutine + + subroutine PackPtr_I4_Rank1(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B4Ki), pointer, intent(in) :: Data(:) + logical :: PtrInIndex + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if associated + call RegPack(RF, associated(Data)) + if (RegCheckErr(RF, "PackPtr_I4_Rank1")) return + if (.not. associated(Data)) return + + ! Write array bounds + call RegPackBounds(RF, 1, lbound(Data), ubound(Data)) + + ! Write pointer info + call RegPackPointer(RF, c_loc(Data), PtrInIndex) + if (RegCheckErr(RF, "PackPtr_I4_Rank1")) return + if (PtrInIndex) return + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackPtr_I4_Rank1")) return + end subroutine + + subroutine UnpackPtr_I4_Rank1(RF, Data, LB, UB) + type(RegFile), intent(inout) :: RF + integer(B4Ki), pointer, intent(out) :: Data(:) + integer(B4Ki), intent(out) :: LB(:), UB(:) + integer(IntKi) :: stat + integer(B8Ki) :: PtrIdx + logical :: IsAssociated + type(c_ptr) :: Ptr + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! If associated, deallocate and nullify + if (associated(Data)) then + deallocate(Data) + nullify(Data) + end if + + ! Read value to see if it was associated, return if not + call RegUnpack(RF, IsAssociated) + if (RegCheckErr(RF, "UnpackPtr_I4_Rank1")) return + if (.not. IsAssociated) return + + ! Read array bounds + call RegUnpackBounds(RF, 1, LB, UB) + if (RegCheckErr(RF, "UnpackPtr_I4_Rank1")) return + + ! Unpack pointer inf + call RegUnpackPointer(RF, Ptr, PtrIdx) + if (RegCheckErr(RF, "UnpackPtr_I4_Rank1")) return + + ! If pointer was in index, associate data with pointer, return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, Data, UB - LB) + Data(LB(1):) => Data + return + end if + + ! Allocate data + allocate(Data(LB(1):UB(1)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackPtr_I4_Rank1: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackPtr_I4_Rank1")) return + end subroutine + + subroutine Pack_I4_Rank2(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B4Ki), intent(in) :: Data(:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Increment data number and write to file + RF%NumData = RF%NumData + 1 + write(RF%Unit) RF%NumData + + ! Write data to file + write(RF%Unit) Data + end subroutine + + subroutine Unpack_I4_Rank2(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B4Ki), intent(out) :: Data(:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Read data number, return if invalid + if (.not. DataNumValid(RF)) return + + ! Read data from file + read(RF%Unit) Data + end subroutine + + subroutine PackAlloc_I4_Rank2(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B4Ki), allocatable, intent(in) :: Data(:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if allocated + call RegPack(RF, allocated(Data)) + if (RegCheckErr(RF, "PackAlloc_I4_Rank2")) return + if (.not. allocated(Data)) return + + ! Write array bounds + call RegPackBounds(RF, 2, lbound(Data), ubound(Data)) + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackAlloc_I4_Rank2")) return + end subroutine + + subroutine UnpackAlloc_I4_Rank2(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B4Ki), allocatable, intent(out) :: Data(:,:) + integer(IntKi) :: stat + logical :: IsAllocated + integer(B4Ki) :: LB(2), UB(2) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Deallocate if allocated + if (allocated(Data)) deallocate(Data) + + ! Read value to see if it was allocated, return if not + call RegUnpack(RF, IsAllocated) + if (RegCheckErr(RF, "UnpackAlloc_I4_Rank2")) return + if (.not. IsAllocated) return + + ! Read array bounds + call RegUnpackBounds(RF, 2, LB, UB) + if (RegCheckErr(RF, "UnpackAlloc_I4_Rank2")) return + + ! Allocate data + allocate(Data(LB(1):UB(1),LB(2):UB(2)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackAlloc_I4_Rank2: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackAlloc_I4_Rank2")) return + end subroutine + + subroutine PackPtr_I4_Rank2(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B4Ki), pointer, intent(in) :: Data(:,:) + logical :: PtrInIndex + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if associated + call RegPack(RF, associated(Data)) + if (RegCheckErr(RF, "PackPtr_I4_Rank2")) return + if (.not. associated(Data)) return + + ! Write array bounds + call RegPackBounds(RF, 2, lbound(Data), ubound(Data)) + + ! Write pointer info + call RegPackPointer(RF, c_loc(Data), PtrInIndex) + if (RegCheckErr(RF, "PackPtr_I4_Rank2")) return + if (PtrInIndex) return + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackPtr_I4_Rank2")) return + end subroutine + + subroutine UnpackPtr_I4_Rank2(RF, Data, LB, UB) + type(RegFile), intent(inout) :: RF + integer(B4Ki), pointer, intent(out) :: Data(:,:) + integer(B4Ki), intent(out) :: LB(:), UB(:) + integer(IntKi) :: stat + integer(B8Ki) :: PtrIdx + logical :: IsAssociated + type(c_ptr) :: Ptr + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! If associated, deallocate and nullify + if (associated(Data)) then + deallocate(Data) + nullify(Data) + end if + + ! Read value to see if it was associated, return if not + call RegUnpack(RF, IsAssociated) + if (RegCheckErr(RF, "UnpackPtr_I4_Rank2")) return + if (.not. IsAssociated) return + + ! Read array bounds + call RegUnpackBounds(RF, 2, LB, UB) + if (RegCheckErr(RF, "UnpackPtr_I4_Rank2")) return + + ! Unpack pointer inf + call RegUnpackPointer(RF, Ptr, PtrIdx) + if (RegCheckErr(RF, "UnpackPtr_I4_Rank2")) return + + ! If pointer was in index, associate data with pointer, return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, Data, UB - LB) + Data(LB(1):,LB(2):) => Data + return + end if + + ! Allocate data + allocate(Data(LB(1):UB(1),LB(2):UB(2)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackPtr_I4_Rank2: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackPtr_I4_Rank2")) return + end subroutine + + subroutine Pack_I4_Rank3(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B4Ki), intent(in) :: Data(:,:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Increment data number and write to file + RF%NumData = RF%NumData + 1 + write(RF%Unit) RF%NumData + + ! Write data to file + write(RF%Unit) Data + end subroutine + + subroutine Unpack_I4_Rank3(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B4Ki), intent(out) :: Data(:,:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Read data number, return if invalid + if (.not. DataNumValid(RF)) return + + ! Read data from file + read(RF%Unit) Data + end subroutine + + subroutine PackAlloc_I4_Rank3(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B4Ki), allocatable, intent(in) :: Data(:,:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if allocated + call RegPack(RF, allocated(Data)) + if (RegCheckErr(RF, "PackAlloc_I4_Rank3")) return + if (.not. allocated(Data)) return + + ! Write array bounds + call RegPackBounds(RF, 3, lbound(Data), ubound(Data)) + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackAlloc_I4_Rank3")) return + end subroutine + + subroutine UnpackAlloc_I4_Rank3(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B4Ki), allocatable, intent(out) :: Data(:,:,:) + integer(IntKi) :: stat + logical :: IsAllocated + integer(B4Ki) :: LB(3), UB(3) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Deallocate if allocated + if (allocated(Data)) deallocate(Data) + + ! Read value to see if it was allocated, return if not + call RegUnpack(RF, IsAllocated) + if (RegCheckErr(RF, "UnpackAlloc_I4_Rank3")) return + if (.not. IsAllocated) return + + ! Read array bounds + call RegUnpackBounds(RF, 3, LB, UB) + if (RegCheckErr(RF, "UnpackAlloc_I4_Rank3")) return + + ! Allocate data + allocate(Data(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackAlloc_I4_Rank3: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackAlloc_I4_Rank3")) return + end subroutine + + subroutine PackPtr_I4_Rank3(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B4Ki), pointer, intent(in) :: Data(:,:,:) + logical :: PtrInIndex + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if associated + call RegPack(RF, associated(Data)) + if (RegCheckErr(RF, "PackPtr_I4_Rank3")) return + if (.not. associated(Data)) return + + ! Write array bounds + call RegPackBounds(RF, 3, lbound(Data), ubound(Data)) + + ! Write pointer info + call RegPackPointer(RF, c_loc(Data), PtrInIndex) + if (RegCheckErr(RF, "PackPtr_I4_Rank3")) return + if (PtrInIndex) return + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackPtr_I4_Rank3")) return + end subroutine + + subroutine UnpackPtr_I4_Rank3(RF, Data, LB, UB) + type(RegFile), intent(inout) :: RF + integer(B4Ki), pointer, intent(out) :: Data(:,:,:) + integer(B4Ki), intent(out) :: LB(:), UB(:) + integer(IntKi) :: stat + integer(B8Ki) :: PtrIdx + logical :: IsAssociated + type(c_ptr) :: Ptr + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! If associated, deallocate and nullify + if (associated(Data)) then + deallocate(Data) + nullify(Data) + end if + + ! Read value to see if it was associated, return if not + call RegUnpack(RF, IsAssociated) + if (RegCheckErr(RF, "UnpackPtr_I4_Rank3")) return + if (.not. IsAssociated) return + + ! Read array bounds + call RegUnpackBounds(RF, 3, LB, UB) + if (RegCheckErr(RF, "UnpackPtr_I4_Rank3")) return + + ! Unpack pointer inf + call RegUnpackPointer(RF, Ptr, PtrIdx) + if (RegCheckErr(RF, "UnpackPtr_I4_Rank3")) return + + ! If pointer was in index, associate data with pointer, return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, Data, UB - LB) + Data(LB(1):,LB(2):,LB(3):) => Data + return + end if + + ! Allocate data + allocate(Data(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackPtr_I4_Rank3: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackPtr_I4_Rank3")) return + end subroutine + + subroutine Pack_I4_Rank4(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B4Ki), intent(in) :: Data(:,:,:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Increment data number and write to file + RF%NumData = RF%NumData + 1 + write(RF%Unit) RF%NumData + + ! Write data to file + write(RF%Unit) Data + end subroutine + + subroutine Unpack_I4_Rank4(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B4Ki), intent(out) :: Data(:,:,:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Read data number, return if invalid + if (.not. DataNumValid(RF)) return + + ! Read data from file + read(RF%Unit) Data + end subroutine + + subroutine PackAlloc_I4_Rank4(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B4Ki), allocatable, intent(in) :: Data(:,:,:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if allocated + call RegPack(RF, allocated(Data)) + if (RegCheckErr(RF, "PackAlloc_I4_Rank4")) return + if (.not. allocated(Data)) return + + ! Write array bounds + call RegPackBounds(RF, 4, lbound(Data), ubound(Data)) + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackAlloc_I4_Rank4")) return + end subroutine + + subroutine UnpackAlloc_I4_Rank4(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B4Ki), allocatable, intent(out) :: Data(:,:,:,:) + integer(IntKi) :: stat + logical :: IsAllocated + integer(B4Ki) :: LB(4), UB(4) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Deallocate if allocated + if (allocated(Data)) deallocate(Data) + + ! Read value to see if it was allocated, return if not + call RegUnpack(RF, IsAllocated) + if (RegCheckErr(RF, "UnpackAlloc_I4_Rank4")) return + if (.not. IsAllocated) return + + ! Read array bounds + call RegUnpackBounds(RF, 4, LB, UB) + if (RegCheckErr(RF, "UnpackAlloc_I4_Rank4")) return + + ! Allocate data + allocate(Data(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackAlloc_I4_Rank4: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackAlloc_I4_Rank4")) return + end subroutine + + subroutine PackPtr_I4_Rank4(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B4Ki), pointer, intent(in) :: Data(:,:,:,:) + logical :: PtrInIndex + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if associated + call RegPack(RF, associated(Data)) + if (RegCheckErr(RF, "PackPtr_I4_Rank4")) return + if (.not. associated(Data)) return + + ! Write array bounds + call RegPackBounds(RF, 4, lbound(Data), ubound(Data)) + + ! Write pointer info + call RegPackPointer(RF, c_loc(Data), PtrInIndex) + if (RegCheckErr(RF, "PackPtr_I4_Rank4")) return + if (PtrInIndex) return + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackPtr_I4_Rank4")) return + end subroutine + + subroutine UnpackPtr_I4_Rank4(RF, Data, LB, UB) + type(RegFile), intent(inout) :: RF + integer(B4Ki), pointer, intent(out) :: Data(:,:,:,:) + integer(B4Ki), intent(out) :: LB(:), UB(:) + integer(IntKi) :: stat + integer(B8Ki) :: PtrIdx + logical :: IsAssociated + type(c_ptr) :: Ptr + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! If associated, deallocate and nullify + if (associated(Data)) then + deallocate(Data) + nullify(Data) + end if + + ! Read value to see if it was associated, return if not + call RegUnpack(RF, IsAssociated) + if (RegCheckErr(RF, "UnpackPtr_I4_Rank4")) return + if (.not. IsAssociated) return + + ! Read array bounds + call RegUnpackBounds(RF, 4, LB, UB) + if (RegCheckErr(RF, "UnpackPtr_I4_Rank4")) return + + ! Unpack pointer inf + call RegUnpackPointer(RF, Ptr, PtrIdx) + if (RegCheckErr(RF, "UnpackPtr_I4_Rank4")) return + + ! If pointer was in index, associate data with pointer, return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, Data, UB - LB) + Data(LB(1):,LB(2):,LB(3):,LB(4):) => Data + return + end if + + ! Allocate data + allocate(Data(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackPtr_I4_Rank4: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackPtr_I4_Rank4")) return + end subroutine + + subroutine Pack_I4_Rank5(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B4Ki), intent(in) :: Data(:,:,:,:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Increment data number and write to file + RF%NumData = RF%NumData + 1 + write(RF%Unit) RF%NumData + + ! Write data to file + write(RF%Unit) Data + end subroutine + + subroutine Unpack_I4_Rank5(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B4Ki), intent(out) :: Data(:,:,:,:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Read data number, return if invalid + if (.not. DataNumValid(RF)) return + + ! Read data from file + read(RF%Unit) Data + end subroutine + + subroutine PackAlloc_I4_Rank5(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B4Ki), allocatable, intent(in) :: Data(:,:,:,:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if allocated + call RegPack(RF, allocated(Data)) + if (RegCheckErr(RF, "PackAlloc_I4_Rank5")) return + if (.not. allocated(Data)) return + + ! Write array bounds + call RegPackBounds(RF, 5, lbound(Data), ubound(Data)) + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackAlloc_I4_Rank5")) return + end subroutine + + subroutine UnpackAlloc_I4_Rank5(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B4Ki), allocatable, intent(out) :: Data(:,:,:,:,:) + integer(IntKi) :: stat + logical :: IsAllocated + integer(B4Ki) :: LB(5), UB(5) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Deallocate if allocated + if (allocated(Data)) deallocate(Data) + + ! Read value to see if it was allocated, return if not + call RegUnpack(RF, IsAllocated) + if (RegCheckErr(RF, "UnpackAlloc_I4_Rank5")) return + if (.not. IsAllocated) return + + ! Read array bounds + call RegUnpackBounds(RF, 5, LB, UB) + if (RegCheckErr(RF, "UnpackAlloc_I4_Rank5")) return + + ! Allocate data + allocate(Data(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackAlloc_I4_Rank5: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackAlloc_I4_Rank5")) return + end subroutine + + subroutine PackPtr_I4_Rank5(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B4Ki), pointer, intent(in) :: Data(:,:,:,:,:) + logical :: PtrInIndex + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if associated + call RegPack(RF, associated(Data)) + if (RegCheckErr(RF, "PackPtr_I4_Rank5")) return + if (.not. associated(Data)) return + + ! Write array bounds + call RegPackBounds(RF, 5, lbound(Data), ubound(Data)) + + ! Write pointer info + call RegPackPointer(RF, c_loc(Data), PtrInIndex) + if (RegCheckErr(RF, "PackPtr_I4_Rank5")) return + if (PtrInIndex) return + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackPtr_I4_Rank5")) return + end subroutine + + subroutine UnpackPtr_I4_Rank5(RF, Data, LB, UB) + type(RegFile), intent(inout) :: RF + integer(B4Ki), pointer, intent(out) :: Data(:,:,:,:,:) + integer(B4Ki), intent(out) :: LB(:), UB(:) + integer(IntKi) :: stat + integer(B8Ki) :: PtrIdx + logical :: IsAssociated + type(c_ptr) :: Ptr + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! If associated, deallocate and nullify + if (associated(Data)) then + deallocate(Data) + nullify(Data) + end if + + ! Read value to see if it was associated, return if not + call RegUnpack(RF, IsAssociated) + if (RegCheckErr(RF, "UnpackPtr_I4_Rank5")) return + if (.not. IsAssociated) return + + ! Read array bounds + call RegUnpackBounds(RF, 5, LB, UB) + if (RegCheckErr(RF, "UnpackPtr_I4_Rank5")) return + + ! Unpack pointer inf + call RegUnpackPointer(RF, Ptr, PtrIdx) + if (RegCheckErr(RF, "UnpackPtr_I4_Rank5")) return + + ! If pointer was in index, associate data with pointer, return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, Data, UB - LB) + Data(LB(1):,LB(2):,LB(3):,LB(4):,LB(5):) => Data + return + end if + + ! Allocate data + allocate(Data(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackPtr_I4_Rank5: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackPtr_I4_Rank5")) return + end subroutine + + subroutine Pack_I8(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B8Ki), intent(in) :: Data + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Increment data number and write to file + RF%NumData = RF%NumData + 1 + write(RF%Unit) RF%NumData + + ! Write data to file + write(RF%Unit) Data + end subroutine + + subroutine Unpack_I8(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B8Ki), intent(out) :: Data + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Read data number, return if invalid + if (.not. DataNumValid(RF)) return + + ! Read data from file + read(RF%Unit) Data + end subroutine + + subroutine PackAlloc_I8(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B8Ki), allocatable, intent(in) :: Data + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if allocated + call RegPack(RF, allocated(Data)) + if (RegCheckErr(RF, "PackAlloc_I8")) return + if (.not. allocated(Data)) return + + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackAlloc_I8")) return + end subroutine + + subroutine UnpackAlloc_I8(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B8Ki), allocatable, intent(out) :: Data + integer(IntKi) :: stat + logical :: IsAllocated + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Deallocate if allocated + if (allocated(Data)) deallocate(Data) + + ! Read value to see if it was allocated, return if not + call RegUnpack(RF, IsAllocated) + if (RegCheckErr(RF, "UnpackAlloc_I8")) return + if (.not. IsAllocated) return + + + ! Allocate data + allocate(Data, stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackAlloc_I8: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackAlloc_I8")) return + end subroutine + + subroutine PackPtr_I8(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B8Ki), pointer, intent(in) :: Data + logical :: PtrInIndex + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if associated + call RegPack(RF, associated(Data)) + if (RegCheckErr(RF, "PackPtr_I8")) return + if (.not. associated(Data)) return + + ! Write pointer info + call RegPackPointer(RF, c_loc(Data), PtrInIndex) + if (RegCheckErr(RF, "PackPtr_I8")) return + if (PtrInIndex) return + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackPtr_I8")) return + end subroutine + + subroutine UnpackPtr_I8(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B8Ki), pointer, intent(out) :: Data + integer(IntKi) :: stat + integer(B8Ki) :: PtrIdx + logical :: IsAssociated + type(c_ptr) :: Ptr + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! If associated, deallocate and nullify + if (associated(Data)) then + deallocate(Data) + nullify(Data) + end if + + ! Read value to see if it was associated, return if not + call RegUnpack(RF, IsAssociated) + if (RegCheckErr(RF, "UnpackPtr_I8")) return + if (.not. IsAssociated) return + + ! Unpack pointer inf + call RegUnpackPointer(RF, Ptr, PtrIdx) + if (RegCheckErr(RF, "UnpackPtr_I8")) return + + ! If pointer was in index, associate data with pointer, return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, Data) + return + end if + + ! Allocate data + allocate(Data, stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackPtr_I8: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackPtr_I8")) return + end subroutine + + subroutine Pack_I8_Rank1(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B8Ki), intent(in) :: Data(:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Increment data number and write to file + RF%NumData = RF%NumData + 1 + write(RF%Unit) RF%NumData + + ! Write data to file + write(RF%Unit) Data + end subroutine + + subroutine Unpack_I8_Rank1(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B8Ki), intent(out) :: Data(:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Read data number, return if invalid + if (.not. DataNumValid(RF)) return + + ! Read data from file + read(RF%Unit) Data + end subroutine + + subroutine PackAlloc_I8_Rank1(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B8Ki), allocatable, intent(in) :: Data(:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if allocated + call RegPack(RF, allocated(Data)) + if (RegCheckErr(RF, "PackAlloc_I8_Rank1")) return + if (.not. allocated(Data)) return + + ! Write array bounds + call RegPackBounds(RF, 1, lbound(Data), ubound(Data)) + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackAlloc_I8_Rank1")) return + end subroutine + + subroutine UnpackAlloc_I8_Rank1(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B8Ki), allocatable, intent(out) :: Data(:) + integer(IntKi) :: stat + logical :: IsAllocated + integer(B4Ki) :: LB(1), UB(1) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Deallocate if allocated + if (allocated(Data)) deallocate(Data) + + ! Read value to see if it was allocated, return if not + call RegUnpack(RF, IsAllocated) + if (RegCheckErr(RF, "UnpackAlloc_I8_Rank1")) return + if (.not. IsAllocated) return + + ! Read array bounds + call RegUnpackBounds(RF, 1, LB, UB) + if (RegCheckErr(RF, "UnpackAlloc_I8_Rank1")) return + + ! Allocate data + allocate(Data(LB(1):UB(1)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackAlloc_I8_Rank1: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackAlloc_I8_Rank1")) return + end subroutine + + subroutine PackPtr_I8_Rank1(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B8Ki), pointer, intent(in) :: Data(:) + logical :: PtrInIndex + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if associated + call RegPack(RF, associated(Data)) + if (RegCheckErr(RF, "PackPtr_I8_Rank1")) return + if (.not. associated(Data)) return + + ! Write array bounds + call RegPackBounds(RF, 1, lbound(Data), ubound(Data)) + + ! Write pointer info + call RegPackPointer(RF, c_loc(Data), PtrInIndex) + if (RegCheckErr(RF, "PackPtr_I8_Rank1")) return + if (PtrInIndex) return + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackPtr_I8_Rank1")) return + end subroutine + + subroutine UnpackPtr_I8_Rank1(RF, Data, LB, UB) + type(RegFile), intent(inout) :: RF + integer(B8Ki), pointer, intent(out) :: Data(:) + integer(B4Ki), intent(out) :: LB(:), UB(:) + integer(IntKi) :: stat + integer(B8Ki) :: PtrIdx + logical :: IsAssociated + type(c_ptr) :: Ptr + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! If associated, deallocate and nullify + if (associated(Data)) then + deallocate(Data) + nullify(Data) + end if + + ! Read value to see if it was associated, return if not + call RegUnpack(RF, IsAssociated) + if (RegCheckErr(RF, "UnpackPtr_I8_Rank1")) return + if (.not. IsAssociated) return + + ! Read array bounds + call RegUnpackBounds(RF, 1, LB, UB) + if (RegCheckErr(RF, "UnpackPtr_I8_Rank1")) return + + ! Unpack pointer inf + call RegUnpackPointer(RF, Ptr, PtrIdx) + if (RegCheckErr(RF, "UnpackPtr_I8_Rank1")) return + + ! If pointer was in index, associate data with pointer, return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, Data, UB - LB) + Data(LB(1):) => Data + return + end if + + ! Allocate data + allocate(Data(LB(1):UB(1)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackPtr_I8_Rank1: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackPtr_I8_Rank1")) return + end subroutine + + subroutine Pack_I8_Rank2(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B8Ki), intent(in) :: Data(:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Increment data number and write to file + RF%NumData = RF%NumData + 1 + write(RF%Unit) RF%NumData + + ! Write data to file + write(RF%Unit) Data + end subroutine + + subroutine Unpack_I8_Rank2(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B8Ki), intent(out) :: Data(:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Read data number, return if invalid + if (.not. DataNumValid(RF)) return + + ! Read data from file + read(RF%Unit) Data + end subroutine + + subroutine PackAlloc_I8_Rank2(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B8Ki), allocatable, intent(in) :: Data(:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if allocated + call RegPack(RF, allocated(Data)) + if (RegCheckErr(RF, "PackAlloc_I8_Rank2")) return + if (.not. allocated(Data)) return + + ! Write array bounds + call RegPackBounds(RF, 2, lbound(Data), ubound(Data)) + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackAlloc_I8_Rank2")) return + end subroutine + + subroutine UnpackAlloc_I8_Rank2(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B8Ki), allocatable, intent(out) :: Data(:,:) + integer(IntKi) :: stat + logical :: IsAllocated + integer(B4Ki) :: LB(2), UB(2) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Deallocate if allocated + if (allocated(Data)) deallocate(Data) + + ! Read value to see if it was allocated, return if not + call RegUnpack(RF, IsAllocated) + if (RegCheckErr(RF, "UnpackAlloc_I8_Rank2")) return + if (.not. IsAllocated) return + + ! Read array bounds + call RegUnpackBounds(RF, 2, LB, UB) + if (RegCheckErr(RF, "UnpackAlloc_I8_Rank2")) return + + ! Allocate data + allocate(Data(LB(1):UB(1),LB(2):UB(2)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackAlloc_I8_Rank2: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackAlloc_I8_Rank2")) return + end subroutine + + subroutine PackPtr_I8_Rank2(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B8Ki), pointer, intent(in) :: Data(:,:) + logical :: PtrInIndex + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if associated + call RegPack(RF, associated(Data)) + if (RegCheckErr(RF, "PackPtr_I8_Rank2")) return + if (.not. associated(Data)) return + + ! Write array bounds + call RegPackBounds(RF, 2, lbound(Data), ubound(Data)) + + ! Write pointer info + call RegPackPointer(RF, c_loc(Data), PtrInIndex) + if (RegCheckErr(RF, "PackPtr_I8_Rank2")) return + if (PtrInIndex) return + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackPtr_I8_Rank2")) return + end subroutine + + subroutine UnpackPtr_I8_Rank2(RF, Data, LB, UB) + type(RegFile), intent(inout) :: RF + integer(B8Ki), pointer, intent(out) :: Data(:,:) + integer(B4Ki), intent(out) :: LB(:), UB(:) + integer(IntKi) :: stat + integer(B8Ki) :: PtrIdx + logical :: IsAssociated + type(c_ptr) :: Ptr + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! If associated, deallocate and nullify + if (associated(Data)) then + deallocate(Data) + nullify(Data) + end if + + ! Read value to see if it was associated, return if not + call RegUnpack(RF, IsAssociated) + if (RegCheckErr(RF, "UnpackPtr_I8_Rank2")) return + if (.not. IsAssociated) return + + ! Read array bounds + call RegUnpackBounds(RF, 2, LB, UB) + if (RegCheckErr(RF, "UnpackPtr_I8_Rank2")) return + + ! Unpack pointer inf + call RegUnpackPointer(RF, Ptr, PtrIdx) + if (RegCheckErr(RF, "UnpackPtr_I8_Rank2")) return + + ! If pointer was in index, associate data with pointer, return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, Data, UB - LB) + Data(LB(1):,LB(2):) => Data + return + end if + + ! Allocate data + allocate(Data(LB(1):UB(1),LB(2):UB(2)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackPtr_I8_Rank2: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackPtr_I8_Rank2")) return + end subroutine + + subroutine Pack_I8_Rank3(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B8Ki), intent(in) :: Data(:,:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Increment data number and write to file + RF%NumData = RF%NumData + 1 + write(RF%Unit) RF%NumData + + ! Write data to file + write(RF%Unit) Data + end subroutine + + subroutine Unpack_I8_Rank3(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B8Ki), intent(out) :: Data(:,:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Read data number, return if invalid + if (.not. DataNumValid(RF)) return + + ! Read data from file + read(RF%Unit) Data + end subroutine + + subroutine PackAlloc_I8_Rank3(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B8Ki), allocatable, intent(in) :: Data(:,:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if allocated + call RegPack(RF, allocated(Data)) + if (RegCheckErr(RF, "PackAlloc_I8_Rank3")) return + if (.not. allocated(Data)) return + + ! Write array bounds + call RegPackBounds(RF, 3, lbound(Data), ubound(Data)) + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackAlloc_I8_Rank3")) return + end subroutine + + subroutine UnpackAlloc_I8_Rank3(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B8Ki), allocatable, intent(out) :: Data(:,:,:) + integer(IntKi) :: stat + logical :: IsAllocated + integer(B4Ki) :: LB(3), UB(3) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Deallocate if allocated + if (allocated(Data)) deallocate(Data) + + ! Read value to see if it was allocated, return if not + call RegUnpack(RF, IsAllocated) + if (RegCheckErr(RF, "UnpackAlloc_I8_Rank3")) return + if (.not. IsAllocated) return + + ! Read array bounds + call RegUnpackBounds(RF, 3, LB, UB) + if (RegCheckErr(RF, "UnpackAlloc_I8_Rank3")) return + + ! Allocate data + allocate(Data(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackAlloc_I8_Rank3: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackAlloc_I8_Rank3")) return + end subroutine + + subroutine PackPtr_I8_Rank3(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B8Ki), pointer, intent(in) :: Data(:,:,:) + logical :: PtrInIndex + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if associated + call RegPack(RF, associated(Data)) + if (RegCheckErr(RF, "PackPtr_I8_Rank3")) return + if (.not. associated(Data)) return + + ! Write array bounds + call RegPackBounds(RF, 3, lbound(Data), ubound(Data)) + + ! Write pointer info + call RegPackPointer(RF, c_loc(Data), PtrInIndex) + if (RegCheckErr(RF, "PackPtr_I8_Rank3")) return + if (PtrInIndex) return + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackPtr_I8_Rank3")) return + end subroutine + + subroutine UnpackPtr_I8_Rank3(RF, Data, LB, UB) + type(RegFile), intent(inout) :: RF + integer(B8Ki), pointer, intent(out) :: Data(:,:,:) + integer(B4Ki), intent(out) :: LB(:), UB(:) + integer(IntKi) :: stat + integer(B8Ki) :: PtrIdx + logical :: IsAssociated + type(c_ptr) :: Ptr + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! If associated, deallocate and nullify + if (associated(Data)) then + deallocate(Data) + nullify(Data) + end if + + ! Read value to see if it was associated, return if not + call RegUnpack(RF, IsAssociated) + if (RegCheckErr(RF, "UnpackPtr_I8_Rank3")) return + if (.not. IsAssociated) return + + ! Read array bounds + call RegUnpackBounds(RF, 3, LB, UB) + if (RegCheckErr(RF, "UnpackPtr_I8_Rank3")) return + + ! Unpack pointer inf + call RegUnpackPointer(RF, Ptr, PtrIdx) + if (RegCheckErr(RF, "UnpackPtr_I8_Rank3")) return + + ! If pointer was in index, associate data with pointer, return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, Data, UB - LB) + Data(LB(1):,LB(2):,LB(3):) => Data + return + end if + + ! Allocate data + allocate(Data(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackPtr_I8_Rank3: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackPtr_I8_Rank3")) return + end subroutine + + subroutine Pack_I8_Rank4(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B8Ki), intent(in) :: Data(:,:,:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Increment data number and write to file + RF%NumData = RF%NumData + 1 + write(RF%Unit) RF%NumData + + ! Write data to file + write(RF%Unit) Data + end subroutine + + subroutine Unpack_I8_Rank4(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B8Ki), intent(out) :: Data(:,:,:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Read data number, return if invalid + if (.not. DataNumValid(RF)) return + + ! Read data from file + read(RF%Unit) Data + end subroutine + + subroutine PackAlloc_I8_Rank4(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B8Ki), allocatable, intent(in) :: Data(:,:,:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if allocated + call RegPack(RF, allocated(Data)) + if (RegCheckErr(RF, "PackAlloc_I8_Rank4")) return + if (.not. allocated(Data)) return + + ! Write array bounds + call RegPackBounds(RF, 4, lbound(Data), ubound(Data)) + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackAlloc_I8_Rank4")) return + end subroutine + + subroutine UnpackAlloc_I8_Rank4(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B8Ki), allocatable, intent(out) :: Data(:,:,:,:) + integer(IntKi) :: stat + logical :: IsAllocated + integer(B4Ki) :: LB(4), UB(4) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Deallocate if allocated + if (allocated(Data)) deallocate(Data) + + ! Read value to see if it was allocated, return if not + call RegUnpack(RF, IsAllocated) + if (RegCheckErr(RF, "UnpackAlloc_I8_Rank4")) return + if (.not. IsAllocated) return + + ! Read array bounds + call RegUnpackBounds(RF, 4, LB, UB) + if (RegCheckErr(RF, "UnpackAlloc_I8_Rank4")) return + + ! Allocate data + allocate(Data(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackAlloc_I8_Rank4: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackAlloc_I8_Rank4")) return + end subroutine + + subroutine PackPtr_I8_Rank4(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B8Ki), pointer, intent(in) :: Data(:,:,:,:) + logical :: PtrInIndex + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if associated + call RegPack(RF, associated(Data)) + if (RegCheckErr(RF, "PackPtr_I8_Rank4")) return + if (.not. associated(Data)) return + + ! Write array bounds + call RegPackBounds(RF, 4, lbound(Data), ubound(Data)) + + ! Write pointer info + call RegPackPointer(RF, c_loc(Data), PtrInIndex) + if (RegCheckErr(RF, "PackPtr_I8_Rank4")) return + if (PtrInIndex) return + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackPtr_I8_Rank4")) return + end subroutine + + subroutine UnpackPtr_I8_Rank4(RF, Data, LB, UB) + type(RegFile), intent(inout) :: RF + integer(B8Ki), pointer, intent(out) :: Data(:,:,:,:) + integer(B4Ki), intent(out) :: LB(:), UB(:) + integer(IntKi) :: stat + integer(B8Ki) :: PtrIdx + logical :: IsAssociated + type(c_ptr) :: Ptr + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! If associated, deallocate and nullify + if (associated(Data)) then + deallocate(Data) + nullify(Data) + end if + + ! Read value to see if it was associated, return if not + call RegUnpack(RF, IsAssociated) + if (RegCheckErr(RF, "UnpackPtr_I8_Rank4")) return + if (.not. IsAssociated) return + + ! Read array bounds + call RegUnpackBounds(RF, 4, LB, UB) + if (RegCheckErr(RF, "UnpackPtr_I8_Rank4")) return + + ! Unpack pointer inf + call RegUnpackPointer(RF, Ptr, PtrIdx) + if (RegCheckErr(RF, "UnpackPtr_I8_Rank4")) return + + ! If pointer was in index, associate data with pointer, return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, Data, UB - LB) + Data(LB(1):,LB(2):,LB(3):,LB(4):) => Data + return + end if + + ! Allocate data + allocate(Data(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackPtr_I8_Rank4: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackPtr_I8_Rank4")) return + end subroutine + + subroutine Pack_I8_Rank5(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B8Ki), intent(in) :: Data(:,:,:,:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Increment data number and write to file + RF%NumData = RF%NumData + 1 + write(RF%Unit) RF%NumData + + ! Write data to file + write(RF%Unit) Data + end subroutine + + subroutine Unpack_I8_Rank5(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B8Ki), intent(out) :: Data(:,:,:,:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Read data number, return if invalid + if (.not. DataNumValid(RF)) return + + ! Read data from file + read(RF%Unit) Data + end subroutine + + subroutine PackAlloc_I8_Rank5(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B8Ki), allocatable, intent(in) :: Data(:,:,:,:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if allocated + call RegPack(RF, allocated(Data)) + if (RegCheckErr(RF, "PackAlloc_I8_Rank5")) return + if (.not. allocated(Data)) return + + ! Write array bounds + call RegPackBounds(RF, 5, lbound(Data), ubound(Data)) + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackAlloc_I8_Rank5")) return + end subroutine + + subroutine UnpackAlloc_I8_Rank5(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B8Ki), allocatable, intent(out) :: Data(:,:,:,:,:) + integer(IntKi) :: stat + logical :: IsAllocated + integer(B4Ki) :: LB(5), UB(5) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Deallocate if allocated + if (allocated(Data)) deallocate(Data) + + ! Read value to see if it was allocated, return if not + call RegUnpack(RF, IsAllocated) + if (RegCheckErr(RF, "UnpackAlloc_I8_Rank5")) return + if (.not. IsAllocated) return + + ! Read array bounds + call RegUnpackBounds(RF, 5, LB, UB) + if (RegCheckErr(RF, "UnpackAlloc_I8_Rank5")) return + + ! Allocate data + allocate(Data(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackAlloc_I8_Rank5: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackAlloc_I8_Rank5")) return + end subroutine + + subroutine PackPtr_I8_Rank5(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B8Ki), pointer, intent(in) :: Data(:,:,:,:,:) + logical :: PtrInIndex + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if associated + call RegPack(RF, associated(Data)) + if (RegCheckErr(RF, "PackPtr_I8_Rank5")) return + if (.not. associated(Data)) return + + ! Write array bounds + call RegPackBounds(RF, 5, lbound(Data), ubound(Data)) + + ! Write pointer info + call RegPackPointer(RF, c_loc(Data), PtrInIndex) + if (RegCheckErr(RF, "PackPtr_I8_Rank5")) return + if (PtrInIndex) return + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackPtr_I8_Rank5")) return + end subroutine + + subroutine UnpackPtr_I8_Rank5(RF, Data, LB, UB) + type(RegFile), intent(inout) :: RF + integer(B8Ki), pointer, intent(out) :: Data(:,:,:,:,:) + integer(B4Ki), intent(out) :: LB(:), UB(:) + integer(IntKi) :: stat + integer(B8Ki) :: PtrIdx + logical :: IsAssociated + type(c_ptr) :: Ptr + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! If associated, deallocate and nullify + if (associated(Data)) then + deallocate(Data) + nullify(Data) + end if + + ! Read value to see if it was associated, return if not + call RegUnpack(RF, IsAssociated) + if (RegCheckErr(RF, "UnpackPtr_I8_Rank5")) return + if (.not. IsAssociated) return + + ! Read array bounds + call RegUnpackBounds(RF, 5, LB, UB) + if (RegCheckErr(RF, "UnpackPtr_I8_Rank5")) return + + ! Unpack pointer inf + call RegUnpackPointer(RF, Ptr, PtrIdx) + if (RegCheckErr(RF, "UnpackPtr_I8_Rank5")) return + + ! If pointer was in index, associate data with pointer, return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, Data, UB - LB) + Data(LB(1):,LB(2):,LB(3):,LB(4):,LB(5):) => Data + return + end if + + ! Allocate data + allocate(Data(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackPtr_I8_Rank5: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackPtr_I8_Rank5")) return + end subroutine + + subroutine Pack_R4(RF, Data) + type(RegFile), intent(inout) :: RF + real(R4Ki), intent(in) :: Data + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Increment data number and write to file + RF%NumData = RF%NumData + 1 + write(RF%Unit) RF%NumData + + ! Write data to file + write(RF%Unit) Data + end subroutine + + subroutine Unpack_R4(RF, Data) + type(RegFile), intent(inout) :: RF + real(R4Ki), intent(out) :: Data + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Read data number, return if invalid + if (.not. DataNumValid(RF)) return + + ! Read data from file + read(RF%Unit) Data + end subroutine + + subroutine PackAlloc_R4(RF, Data) + type(RegFile), intent(inout) :: RF + real(R4Ki), allocatable, intent(in) :: Data + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if allocated + call RegPack(RF, allocated(Data)) + if (RegCheckErr(RF, "PackAlloc_R4")) return + if (.not. allocated(Data)) return + + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackAlloc_R4")) return + end subroutine + + subroutine UnpackAlloc_R4(RF, Data) + type(RegFile), intent(inout) :: RF + real(R4Ki), allocatable, intent(out) :: Data + integer(IntKi) :: stat + logical :: IsAllocated + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Deallocate if allocated + if (allocated(Data)) deallocate(Data) + + ! Read value to see if it was allocated, return if not + call RegUnpack(RF, IsAllocated) + if (RegCheckErr(RF, "UnpackAlloc_R4")) return + if (.not. IsAllocated) return + + + ! Allocate data + allocate(Data, stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackAlloc_R4: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackAlloc_R4")) return + end subroutine + + subroutine PackPtr_R4(RF, Data) + type(RegFile), intent(inout) :: RF + real(R4Ki), pointer, intent(in) :: Data + logical :: PtrInIndex + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if associated + call RegPack(RF, associated(Data)) + if (RegCheckErr(RF, "PackPtr_R4")) return + if (.not. associated(Data)) return + + ! Write pointer info + call RegPackPointer(RF, c_loc(Data), PtrInIndex) + if (RegCheckErr(RF, "PackPtr_R4")) return + if (PtrInIndex) return + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackPtr_R4")) return + end subroutine + + subroutine UnpackPtr_R4(RF, Data) + type(RegFile), intent(inout) :: RF + real(R4Ki), pointer, intent(out) :: Data + integer(IntKi) :: stat + integer(B8Ki) :: PtrIdx + logical :: IsAssociated + type(c_ptr) :: Ptr + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! If associated, deallocate and nullify + if (associated(Data)) then + deallocate(Data) + nullify(Data) + end if + + ! Read value to see if it was associated, return if not + call RegUnpack(RF, IsAssociated) + if (RegCheckErr(RF, "UnpackPtr_R4")) return + if (.not. IsAssociated) return + + ! Unpack pointer inf + call RegUnpackPointer(RF, Ptr, PtrIdx) + if (RegCheckErr(RF, "UnpackPtr_R4")) return + + ! If pointer was in index, associate data with pointer, return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, Data) + return + end if + + ! Allocate data + allocate(Data, stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackPtr_R4: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackPtr_R4")) return + end subroutine + + subroutine Pack_R4_Rank1(RF, Data) + type(RegFile), intent(inout) :: RF + real(R4Ki), intent(in) :: Data(:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Increment data number and write to file + RF%NumData = RF%NumData + 1 + write(RF%Unit) RF%NumData + + ! Write data to file + write(RF%Unit) Data + end subroutine + + subroutine Unpack_R4_Rank1(RF, Data) + type(RegFile), intent(inout) :: RF + real(R4Ki), intent(out) :: Data(:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Read data number, return if invalid + if (.not. DataNumValid(RF)) return + + ! Read data from file + read(RF%Unit) Data + end subroutine + + subroutine PackAlloc_R4_Rank1(RF, Data) + type(RegFile), intent(inout) :: RF + real(R4Ki), allocatable, intent(in) :: Data(:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if allocated + call RegPack(RF, allocated(Data)) + if (RegCheckErr(RF, "PackAlloc_R4_Rank1")) return + if (.not. allocated(Data)) return + + ! Write array bounds + call RegPackBounds(RF, 1, lbound(Data), ubound(Data)) + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackAlloc_R4_Rank1")) return + end subroutine + + subroutine UnpackAlloc_R4_Rank1(RF, Data) + type(RegFile), intent(inout) :: RF + real(R4Ki), allocatable, intent(out) :: Data(:) + integer(IntKi) :: stat + logical :: IsAllocated + integer(B4Ki) :: LB(1), UB(1) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Deallocate if allocated + if (allocated(Data)) deallocate(Data) + + ! Read value to see if it was allocated, return if not + call RegUnpack(RF, IsAllocated) + if (RegCheckErr(RF, "UnpackAlloc_R4_Rank1")) return + if (.not. IsAllocated) return + + ! Read array bounds + call RegUnpackBounds(RF, 1, LB, UB) + if (RegCheckErr(RF, "UnpackAlloc_R4_Rank1")) return + + ! Allocate data + allocate(Data(LB(1):UB(1)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackAlloc_R4_Rank1: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackAlloc_R4_Rank1")) return + end subroutine + + subroutine PackPtr_R4_Rank1(RF, Data) + type(RegFile), intent(inout) :: RF + real(R4Ki), pointer, intent(in) :: Data(:) + logical :: PtrInIndex + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if associated + call RegPack(RF, associated(Data)) + if (RegCheckErr(RF, "PackPtr_R4_Rank1")) return + if (.not. associated(Data)) return + + ! Write array bounds + call RegPackBounds(RF, 1, lbound(Data), ubound(Data)) + + ! Write pointer info + call RegPackPointer(RF, c_loc(Data), PtrInIndex) + if (RegCheckErr(RF, "PackPtr_R4_Rank1")) return + if (PtrInIndex) return + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackPtr_R4_Rank1")) return + end subroutine + + subroutine UnpackPtr_R4_Rank1(RF, Data, LB, UB) + type(RegFile), intent(inout) :: RF + real(R4Ki), pointer, intent(out) :: Data(:) + integer(B4Ki), intent(out) :: LB(:), UB(:) + integer(IntKi) :: stat + integer(B8Ki) :: PtrIdx + logical :: IsAssociated + type(c_ptr) :: Ptr + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! If associated, deallocate and nullify + if (associated(Data)) then + deallocate(Data) + nullify(Data) + end if + + ! Read value to see if it was associated, return if not + call RegUnpack(RF, IsAssociated) + if (RegCheckErr(RF, "UnpackPtr_R4_Rank1")) return + if (.not. IsAssociated) return + + ! Read array bounds + call RegUnpackBounds(RF, 1, LB, UB) + if (RegCheckErr(RF, "UnpackPtr_R4_Rank1")) return + + ! Unpack pointer inf + call RegUnpackPointer(RF, Ptr, PtrIdx) + if (RegCheckErr(RF, "UnpackPtr_R4_Rank1")) return + + ! If pointer was in index, associate data with pointer, return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, Data, UB - LB) + Data(LB(1):) => Data + return + end if + + ! Allocate data + allocate(Data(LB(1):UB(1)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackPtr_R4_Rank1: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackPtr_R4_Rank1")) return + end subroutine + + subroutine Pack_R4_Rank2(RF, Data) + type(RegFile), intent(inout) :: RF + real(R4Ki), intent(in) :: Data(:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Increment data number and write to file + RF%NumData = RF%NumData + 1 + write(RF%Unit) RF%NumData + + ! Write data to file + write(RF%Unit) Data + end subroutine + + subroutine Unpack_R4_Rank2(RF, Data) + type(RegFile), intent(inout) :: RF + real(R4Ki), intent(out) :: Data(:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Read data number, return if invalid + if (.not. DataNumValid(RF)) return + + ! Read data from file + read(RF%Unit) Data + end subroutine + + subroutine PackAlloc_R4_Rank2(RF, Data) + type(RegFile), intent(inout) :: RF + real(R4Ki), allocatable, intent(in) :: Data(:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if allocated + call RegPack(RF, allocated(Data)) + if (RegCheckErr(RF, "PackAlloc_R4_Rank2")) return + if (.not. allocated(Data)) return + + ! Write array bounds + call RegPackBounds(RF, 2, lbound(Data), ubound(Data)) + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackAlloc_R4_Rank2")) return + end subroutine + + subroutine UnpackAlloc_R4_Rank2(RF, Data) + type(RegFile), intent(inout) :: RF + real(R4Ki), allocatable, intent(out) :: Data(:,:) + integer(IntKi) :: stat + logical :: IsAllocated + integer(B4Ki) :: LB(2), UB(2) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Deallocate if allocated + if (allocated(Data)) deallocate(Data) + + ! Read value to see if it was allocated, return if not + call RegUnpack(RF, IsAllocated) + if (RegCheckErr(RF, "UnpackAlloc_R4_Rank2")) return + if (.not. IsAllocated) return + + ! Read array bounds + call RegUnpackBounds(RF, 2, LB, UB) + if (RegCheckErr(RF, "UnpackAlloc_R4_Rank2")) return + + ! Allocate data + allocate(Data(LB(1):UB(1),LB(2):UB(2)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackAlloc_R4_Rank2: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackAlloc_R4_Rank2")) return + end subroutine + + subroutine PackPtr_R4_Rank2(RF, Data) + type(RegFile), intent(inout) :: RF + real(R4Ki), pointer, intent(in) :: Data(:,:) + logical :: PtrInIndex + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if associated + call RegPack(RF, associated(Data)) + if (RegCheckErr(RF, "PackPtr_R4_Rank2")) return + if (.not. associated(Data)) return + + ! Write array bounds + call RegPackBounds(RF, 2, lbound(Data), ubound(Data)) + + ! Write pointer info + call RegPackPointer(RF, c_loc(Data), PtrInIndex) + if (RegCheckErr(RF, "PackPtr_R4_Rank2")) return + if (PtrInIndex) return + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackPtr_R4_Rank2")) return + end subroutine + + subroutine UnpackPtr_R4_Rank2(RF, Data, LB, UB) + type(RegFile), intent(inout) :: RF + real(R4Ki), pointer, intent(out) :: Data(:,:) + integer(B4Ki), intent(out) :: LB(:), UB(:) + integer(IntKi) :: stat + integer(B8Ki) :: PtrIdx + logical :: IsAssociated + type(c_ptr) :: Ptr + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! If associated, deallocate and nullify + if (associated(Data)) then + deallocate(Data) + nullify(Data) + end if + + ! Read value to see if it was associated, return if not + call RegUnpack(RF, IsAssociated) + if (RegCheckErr(RF, "UnpackPtr_R4_Rank2")) return + if (.not. IsAssociated) return + + ! Read array bounds + call RegUnpackBounds(RF, 2, LB, UB) + if (RegCheckErr(RF, "UnpackPtr_R4_Rank2")) return + + ! Unpack pointer inf + call RegUnpackPointer(RF, Ptr, PtrIdx) + if (RegCheckErr(RF, "UnpackPtr_R4_Rank2")) return + + ! If pointer was in index, associate data with pointer, return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, Data, UB - LB) + Data(LB(1):,LB(2):) => Data + return + end if + + ! Allocate data + allocate(Data(LB(1):UB(1),LB(2):UB(2)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackPtr_R4_Rank2: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackPtr_R4_Rank2")) return + end subroutine + + subroutine Pack_R4_Rank3(RF, Data) + type(RegFile), intent(inout) :: RF + real(R4Ki), intent(in) :: Data(:,:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Increment data number and write to file + RF%NumData = RF%NumData + 1 + write(RF%Unit) RF%NumData + + ! Write data to file + write(RF%Unit) Data + end subroutine + + subroutine Unpack_R4_Rank3(RF, Data) + type(RegFile), intent(inout) :: RF + real(R4Ki), intent(out) :: Data(:,:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Read data number, return if invalid + if (.not. DataNumValid(RF)) return + + ! Read data from file + read(RF%Unit) Data + end subroutine + + subroutine PackAlloc_R4_Rank3(RF, Data) + type(RegFile), intent(inout) :: RF + real(R4Ki), allocatable, intent(in) :: Data(:,:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if allocated + call RegPack(RF, allocated(Data)) + if (RegCheckErr(RF, "PackAlloc_R4_Rank3")) return + if (.not. allocated(Data)) return + + ! Write array bounds + call RegPackBounds(RF, 3, lbound(Data), ubound(Data)) + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackAlloc_R4_Rank3")) return + end subroutine + + subroutine UnpackAlloc_R4_Rank3(RF, Data) + type(RegFile), intent(inout) :: RF + real(R4Ki), allocatable, intent(out) :: Data(:,:,:) + integer(IntKi) :: stat + logical :: IsAllocated + integer(B4Ki) :: LB(3), UB(3) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Deallocate if allocated + if (allocated(Data)) deallocate(Data) + + ! Read value to see if it was allocated, return if not + call RegUnpack(RF, IsAllocated) + if (RegCheckErr(RF, "UnpackAlloc_R4_Rank3")) return + if (.not. IsAllocated) return + + ! Read array bounds + call RegUnpackBounds(RF, 3, LB, UB) + if (RegCheckErr(RF, "UnpackAlloc_R4_Rank3")) return + + ! Allocate data + allocate(Data(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackAlloc_R4_Rank3: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackAlloc_R4_Rank3")) return + end subroutine + + subroutine PackPtr_R4_Rank3(RF, Data) + type(RegFile), intent(inout) :: RF + real(R4Ki), pointer, intent(in) :: Data(:,:,:) + logical :: PtrInIndex + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if associated + call RegPack(RF, associated(Data)) + if (RegCheckErr(RF, "PackPtr_R4_Rank3")) return + if (.not. associated(Data)) return + + ! Write array bounds + call RegPackBounds(RF, 3, lbound(Data), ubound(Data)) + + ! Write pointer info + call RegPackPointer(RF, c_loc(Data), PtrInIndex) + if (RegCheckErr(RF, "PackPtr_R4_Rank3")) return + if (PtrInIndex) return + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackPtr_R4_Rank3")) return + end subroutine + + subroutine UnpackPtr_R4_Rank3(RF, Data, LB, UB) + type(RegFile), intent(inout) :: RF + real(R4Ki), pointer, intent(out) :: Data(:,:,:) + integer(B4Ki), intent(out) :: LB(:), UB(:) + integer(IntKi) :: stat + integer(B8Ki) :: PtrIdx + logical :: IsAssociated + type(c_ptr) :: Ptr + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! If associated, deallocate and nullify + if (associated(Data)) then + deallocate(Data) + nullify(Data) + end if + + ! Read value to see if it was associated, return if not + call RegUnpack(RF, IsAssociated) + if (RegCheckErr(RF, "UnpackPtr_R4_Rank3")) return + if (.not. IsAssociated) return + + ! Read array bounds + call RegUnpackBounds(RF, 3, LB, UB) + if (RegCheckErr(RF, "UnpackPtr_R4_Rank3")) return + + ! Unpack pointer inf + call RegUnpackPointer(RF, Ptr, PtrIdx) + if (RegCheckErr(RF, "UnpackPtr_R4_Rank3")) return + + ! If pointer was in index, associate data with pointer, return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, Data, UB - LB) + Data(LB(1):,LB(2):,LB(3):) => Data + return + end if + + ! Allocate data + allocate(Data(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackPtr_R4_Rank3: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackPtr_R4_Rank3")) return + end subroutine + + subroutine Pack_R4_Rank4(RF, Data) + type(RegFile), intent(inout) :: RF + real(R4Ki), intent(in) :: Data(:,:,:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Increment data number and write to file + RF%NumData = RF%NumData + 1 + write(RF%Unit) RF%NumData + + ! Write data to file + write(RF%Unit) Data + end subroutine + + subroutine Unpack_R4_Rank4(RF, Data) + type(RegFile), intent(inout) :: RF + real(R4Ki), intent(out) :: Data(:,:,:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Read data number, return if invalid + if (.not. DataNumValid(RF)) return + + ! Read data from file + read(RF%Unit) Data + end subroutine + + subroutine PackAlloc_R4_Rank4(RF, Data) + type(RegFile), intent(inout) :: RF + real(R4Ki), allocatable, intent(in) :: Data(:,:,:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if allocated + call RegPack(RF, allocated(Data)) + if (RegCheckErr(RF, "PackAlloc_R4_Rank4")) return + if (.not. allocated(Data)) return + + ! Write array bounds + call RegPackBounds(RF, 4, lbound(Data), ubound(Data)) + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackAlloc_R4_Rank4")) return + end subroutine + + subroutine UnpackAlloc_R4_Rank4(RF, Data) + type(RegFile), intent(inout) :: RF + real(R4Ki), allocatable, intent(out) :: Data(:,:,:,:) + integer(IntKi) :: stat + logical :: IsAllocated + integer(B4Ki) :: LB(4), UB(4) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Deallocate if allocated + if (allocated(Data)) deallocate(Data) + + ! Read value to see if it was allocated, return if not + call RegUnpack(RF, IsAllocated) + if (RegCheckErr(RF, "UnpackAlloc_R4_Rank4")) return + if (.not. IsAllocated) return + + ! Read array bounds + call RegUnpackBounds(RF, 4, LB, UB) + if (RegCheckErr(RF, "UnpackAlloc_R4_Rank4")) return + + ! Allocate data + allocate(Data(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackAlloc_R4_Rank4: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackAlloc_R4_Rank4")) return + end subroutine + + subroutine PackPtr_R4_Rank4(RF, Data) + type(RegFile), intent(inout) :: RF + real(R4Ki), pointer, intent(in) :: Data(:,:,:,:) + logical :: PtrInIndex + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if associated + call RegPack(RF, associated(Data)) + if (RegCheckErr(RF, "PackPtr_R4_Rank4")) return + if (.not. associated(Data)) return + + ! Write array bounds + call RegPackBounds(RF, 4, lbound(Data), ubound(Data)) + + ! Write pointer info + call RegPackPointer(RF, c_loc(Data), PtrInIndex) + if (RegCheckErr(RF, "PackPtr_R4_Rank4")) return + if (PtrInIndex) return + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackPtr_R4_Rank4")) return + end subroutine + + subroutine UnpackPtr_R4_Rank4(RF, Data, LB, UB) + type(RegFile), intent(inout) :: RF + real(R4Ki), pointer, intent(out) :: Data(:,:,:,:) + integer(B4Ki), intent(out) :: LB(:), UB(:) + integer(IntKi) :: stat + integer(B8Ki) :: PtrIdx + logical :: IsAssociated + type(c_ptr) :: Ptr + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! If associated, deallocate and nullify + if (associated(Data)) then + deallocate(Data) + nullify(Data) + end if + + ! Read value to see if it was associated, return if not + call RegUnpack(RF, IsAssociated) + if (RegCheckErr(RF, "UnpackPtr_R4_Rank4")) return + if (.not. IsAssociated) return + + ! Read array bounds + call RegUnpackBounds(RF, 4, LB, UB) + if (RegCheckErr(RF, "UnpackPtr_R4_Rank4")) return + + ! Unpack pointer inf + call RegUnpackPointer(RF, Ptr, PtrIdx) + if (RegCheckErr(RF, "UnpackPtr_R4_Rank4")) return + + ! If pointer was in index, associate data with pointer, return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, Data, UB - LB) + Data(LB(1):,LB(2):,LB(3):,LB(4):) => Data + return + end if + + ! Allocate data + allocate(Data(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackPtr_R4_Rank4: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackPtr_R4_Rank4")) return + end subroutine + + subroutine Pack_R4_Rank5(RF, Data) + type(RegFile), intent(inout) :: RF + real(R4Ki), intent(in) :: Data(:,:,:,:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Increment data number and write to file + RF%NumData = RF%NumData + 1 + write(RF%Unit) RF%NumData + + ! Write data to file + write(RF%Unit) Data + end subroutine + + subroutine Unpack_R4_Rank5(RF, Data) + type(RegFile), intent(inout) :: RF + real(R4Ki), intent(out) :: Data(:,:,:,:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Read data number, return if invalid + if (.not. DataNumValid(RF)) return + + ! Read data from file + read(RF%Unit) Data + end subroutine + + subroutine PackAlloc_R4_Rank5(RF, Data) + type(RegFile), intent(inout) :: RF + real(R4Ki), allocatable, intent(in) :: Data(:,:,:,:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if allocated + call RegPack(RF, allocated(Data)) + if (RegCheckErr(RF, "PackAlloc_R4_Rank5")) return + if (.not. allocated(Data)) return + + ! Write array bounds + call RegPackBounds(RF, 5, lbound(Data), ubound(Data)) + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackAlloc_R4_Rank5")) return + end subroutine + + subroutine UnpackAlloc_R4_Rank5(RF, Data) + type(RegFile), intent(inout) :: RF + real(R4Ki), allocatable, intent(out) :: Data(:,:,:,:,:) + integer(IntKi) :: stat + logical :: IsAllocated + integer(B4Ki) :: LB(5), UB(5) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Deallocate if allocated + if (allocated(Data)) deallocate(Data) + + ! Read value to see if it was allocated, return if not + call RegUnpack(RF, IsAllocated) + if (RegCheckErr(RF, "UnpackAlloc_R4_Rank5")) return + if (.not. IsAllocated) return + + ! Read array bounds + call RegUnpackBounds(RF, 5, LB, UB) + if (RegCheckErr(RF, "UnpackAlloc_R4_Rank5")) return + + ! Allocate data + allocate(Data(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackAlloc_R4_Rank5: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackAlloc_R4_Rank5")) return + end subroutine + + subroutine PackPtr_R4_Rank5(RF, Data) + type(RegFile), intent(inout) :: RF + real(R4Ki), pointer, intent(in) :: Data(:,:,:,:,:) + logical :: PtrInIndex + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if associated + call RegPack(RF, associated(Data)) + if (RegCheckErr(RF, "PackPtr_R4_Rank5")) return + if (.not. associated(Data)) return + + ! Write array bounds + call RegPackBounds(RF, 5, lbound(Data), ubound(Data)) + + ! Write pointer info + call RegPackPointer(RF, c_loc(Data), PtrInIndex) + if (RegCheckErr(RF, "PackPtr_R4_Rank5")) return + if (PtrInIndex) return + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackPtr_R4_Rank5")) return + end subroutine + + subroutine UnpackPtr_R4_Rank5(RF, Data, LB, UB) + type(RegFile), intent(inout) :: RF + real(R4Ki), pointer, intent(out) :: Data(:,:,:,:,:) + integer(B4Ki), intent(out) :: LB(:), UB(:) + integer(IntKi) :: stat + integer(B8Ki) :: PtrIdx + logical :: IsAssociated + type(c_ptr) :: Ptr + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! If associated, deallocate and nullify + if (associated(Data)) then + deallocate(Data) + nullify(Data) + end if + + ! Read value to see if it was associated, return if not + call RegUnpack(RF, IsAssociated) + if (RegCheckErr(RF, "UnpackPtr_R4_Rank5")) return + if (.not. IsAssociated) return + + ! Read array bounds + call RegUnpackBounds(RF, 5, LB, UB) + if (RegCheckErr(RF, "UnpackPtr_R4_Rank5")) return + + ! Unpack pointer inf + call RegUnpackPointer(RF, Ptr, PtrIdx) + if (RegCheckErr(RF, "UnpackPtr_R4_Rank5")) return + + ! If pointer was in index, associate data with pointer, return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, Data, UB - LB) + Data(LB(1):,LB(2):,LB(3):,LB(4):,LB(5):) => Data + return + end if + + ! Allocate data + allocate(Data(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackPtr_R4_Rank5: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackPtr_R4_Rank5")) return + end subroutine + + subroutine Pack_R8(RF, Data) + type(RegFile), intent(inout) :: RF + real(R8Ki), intent(in) :: Data + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Increment data number and write to file + RF%NumData = RF%NumData + 1 + write(RF%Unit) RF%NumData + + ! Write data to file + write(RF%Unit) Data + end subroutine + + subroutine Unpack_R8(RF, Data) + type(RegFile), intent(inout) :: RF + real(R8Ki), intent(out) :: Data + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Read data number, return if invalid + if (.not. DataNumValid(RF)) return + + ! Read data from file + read(RF%Unit) Data + end subroutine + + subroutine PackAlloc_R8(RF, Data) + type(RegFile), intent(inout) :: RF + real(R8Ki), allocatable, intent(in) :: Data + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if allocated + call RegPack(RF, allocated(Data)) + if (RegCheckErr(RF, "PackAlloc_R8")) return + if (.not. allocated(Data)) return + + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackAlloc_R8")) return + end subroutine + + subroutine UnpackAlloc_R8(RF, Data) + type(RegFile), intent(inout) :: RF + real(R8Ki), allocatable, intent(out) :: Data + integer(IntKi) :: stat + logical :: IsAllocated + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Deallocate if allocated + if (allocated(Data)) deallocate(Data) + + ! Read value to see if it was allocated, return if not + call RegUnpack(RF, IsAllocated) + if (RegCheckErr(RF, "UnpackAlloc_R8")) return + if (.not. IsAllocated) return + + + ! Allocate data + allocate(Data, stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackAlloc_R8: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackAlloc_R8")) return + end subroutine + + subroutine PackPtr_R8(RF, Data) + type(RegFile), intent(inout) :: RF + real(R8Ki), pointer, intent(in) :: Data + logical :: PtrInIndex + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if associated + call RegPack(RF, associated(Data)) + if (RegCheckErr(RF, "PackPtr_R8")) return + if (.not. associated(Data)) return + + ! Write pointer info + call RegPackPointer(RF, c_loc(Data), PtrInIndex) + if (RegCheckErr(RF, "PackPtr_R8")) return + if (PtrInIndex) return + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackPtr_R8")) return + end subroutine + + subroutine UnpackPtr_R8(RF, Data) + type(RegFile), intent(inout) :: RF + real(R8Ki), pointer, intent(out) :: Data + integer(IntKi) :: stat + integer(B8Ki) :: PtrIdx + logical :: IsAssociated + type(c_ptr) :: Ptr + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! If associated, deallocate and nullify + if (associated(Data)) then + deallocate(Data) + nullify(Data) + end if + + ! Read value to see if it was associated, return if not + call RegUnpack(RF, IsAssociated) + if (RegCheckErr(RF, "UnpackPtr_R8")) return + if (.not. IsAssociated) return + + ! Unpack pointer inf + call RegUnpackPointer(RF, Ptr, PtrIdx) + if (RegCheckErr(RF, "UnpackPtr_R8")) return + + ! If pointer was in index, associate data with pointer, return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, Data) + return + end if + + ! Allocate data + allocate(Data, stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackPtr_R8: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackPtr_R8")) return + end subroutine + + subroutine Pack_R8_Rank1(RF, Data) + type(RegFile), intent(inout) :: RF + real(R8Ki), intent(in) :: Data(:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Increment data number and write to file + RF%NumData = RF%NumData + 1 + write(RF%Unit) RF%NumData + + ! Write data to file + write(RF%Unit) Data + end subroutine + + subroutine Unpack_R8_Rank1(RF, Data) + type(RegFile), intent(inout) :: RF + real(R8Ki), intent(out) :: Data(:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Read data number, return if invalid + if (.not. DataNumValid(RF)) return + + ! Read data from file + read(RF%Unit) Data + end subroutine + + subroutine PackAlloc_R8_Rank1(RF, Data) + type(RegFile), intent(inout) :: RF + real(R8Ki), allocatable, intent(in) :: Data(:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if allocated + call RegPack(RF, allocated(Data)) + if (RegCheckErr(RF, "PackAlloc_R8_Rank1")) return + if (.not. allocated(Data)) return + + ! Write array bounds + call RegPackBounds(RF, 1, lbound(Data), ubound(Data)) + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackAlloc_R8_Rank1")) return + end subroutine + + subroutine UnpackAlloc_R8_Rank1(RF, Data) + type(RegFile), intent(inout) :: RF + real(R8Ki), allocatable, intent(out) :: Data(:) + integer(IntKi) :: stat + logical :: IsAllocated + integer(B4Ki) :: LB(1), UB(1) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Deallocate if allocated + if (allocated(Data)) deallocate(Data) + + ! Read value to see if it was allocated, return if not + call RegUnpack(RF, IsAllocated) + if (RegCheckErr(RF, "UnpackAlloc_R8_Rank1")) return + if (.not. IsAllocated) return + + ! Read array bounds + call RegUnpackBounds(RF, 1, LB, UB) + if (RegCheckErr(RF, "UnpackAlloc_R8_Rank1")) return + + ! Allocate data + allocate(Data(LB(1):UB(1)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackAlloc_R8_Rank1: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackAlloc_R8_Rank1")) return + end subroutine + + subroutine PackPtr_R8_Rank1(RF, Data) + type(RegFile), intent(inout) :: RF + real(R8Ki), pointer, intent(in) :: Data(:) + logical :: PtrInIndex + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if associated + call RegPack(RF, associated(Data)) + if (RegCheckErr(RF, "PackPtr_R8_Rank1")) return + if (.not. associated(Data)) return + + ! Write array bounds + call RegPackBounds(RF, 1, lbound(Data), ubound(Data)) + + ! Write pointer info + call RegPackPointer(RF, c_loc(Data), PtrInIndex) + if (RegCheckErr(RF, "PackPtr_R8_Rank1")) return + if (PtrInIndex) return + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackPtr_R8_Rank1")) return + end subroutine + + subroutine UnpackPtr_R8_Rank1(RF, Data, LB, UB) + type(RegFile), intent(inout) :: RF + real(R8Ki), pointer, intent(out) :: Data(:) + integer(B4Ki), intent(out) :: LB(:), UB(:) + integer(IntKi) :: stat + integer(B8Ki) :: PtrIdx + logical :: IsAssociated + type(c_ptr) :: Ptr + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! If associated, deallocate and nullify + if (associated(Data)) then + deallocate(Data) + nullify(Data) + end if + + ! Read value to see if it was associated, return if not + call RegUnpack(RF, IsAssociated) + if (RegCheckErr(RF, "UnpackPtr_R8_Rank1")) return + if (.not. IsAssociated) return + + ! Read array bounds + call RegUnpackBounds(RF, 1, LB, UB) + if (RegCheckErr(RF, "UnpackPtr_R8_Rank1")) return + + ! Unpack pointer inf + call RegUnpackPointer(RF, Ptr, PtrIdx) + if (RegCheckErr(RF, "UnpackPtr_R8_Rank1")) return + + ! If pointer was in index, associate data with pointer, return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, Data, UB - LB) + Data(LB(1):) => Data + return + end if + + ! Allocate data + allocate(Data(LB(1):UB(1)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackPtr_R8_Rank1: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackPtr_R8_Rank1")) return + end subroutine + + subroutine Pack_R8_Rank2(RF, Data) + type(RegFile), intent(inout) :: RF + real(R8Ki), intent(in) :: Data(:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Increment data number and write to file + RF%NumData = RF%NumData + 1 + write(RF%Unit) RF%NumData + + ! Write data to file + write(RF%Unit) Data + end subroutine + + subroutine Unpack_R8_Rank2(RF, Data) + type(RegFile), intent(inout) :: RF + real(R8Ki), intent(out) :: Data(:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Read data number, return if invalid + if (.not. DataNumValid(RF)) return + + ! Read data from file + read(RF%Unit) Data + end subroutine + + subroutine PackAlloc_R8_Rank2(RF, Data) + type(RegFile), intent(inout) :: RF + real(R8Ki), allocatable, intent(in) :: Data(:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if allocated + call RegPack(RF, allocated(Data)) + if (RegCheckErr(RF, "PackAlloc_R8_Rank2")) return + if (.not. allocated(Data)) return + + ! Write array bounds + call RegPackBounds(RF, 2, lbound(Data), ubound(Data)) + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackAlloc_R8_Rank2")) return + end subroutine + + subroutine UnpackAlloc_R8_Rank2(RF, Data) + type(RegFile), intent(inout) :: RF + real(R8Ki), allocatable, intent(out) :: Data(:,:) + integer(IntKi) :: stat + logical :: IsAllocated + integer(B4Ki) :: LB(2), UB(2) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Deallocate if allocated + if (allocated(Data)) deallocate(Data) + + ! Read value to see if it was allocated, return if not + call RegUnpack(RF, IsAllocated) + if (RegCheckErr(RF, "UnpackAlloc_R8_Rank2")) return + if (.not. IsAllocated) return + + ! Read array bounds + call RegUnpackBounds(RF, 2, LB, UB) + if (RegCheckErr(RF, "UnpackAlloc_R8_Rank2")) return + + ! Allocate data + allocate(Data(LB(1):UB(1),LB(2):UB(2)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackAlloc_R8_Rank2: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackAlloc_R8_Rank2")) return + end subroutine + + subroutine PackPtr_R8_Rank2(RF, Data) + type(RegFile), intent(inout) :: RF + real(R8Ki), pointer, intent(in) :: Data(:,:) + logical :: PtrInIndex + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if associated + call RegPack(RF, associated(Data)) + if (RegCheckErr(RF, "PackPtr_R8_Rank2")) return + if (.not. associated(Data)) return + + ! Write array bounds + call RegPackBounds(RF, 2, lbound(Data), ubound(Data)) + + ! Write pointer info + call RegPackPointer(RF, c_loc(Data), PtrInIndex) + if (RegCheckErr(RF, "PackPtr_R8_Rank2")) return + if (PtrInIndex) return + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackPtr_R8_Rank2")) return + end subroutine + + subroutine UnpackPtr_R8_Rank2(RF, Data, LB, UB) + type(RegFile), intent(inout) :: RF + real(R8Ki), pointer, intent(out) :: Data(:,:) + integer(B4Ki), intent(out) :: LB(:), UB(:) + integer(IntKi) :: stat + integer(B8Ki) :: PtrIdx + logical :: IsAssociated + type(c_ptr) :: Ptr + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! If associated, deallocate and nullify + if (associated(Data)) then + deallocate(Data) + nullify(Data) + end if + + ! Read value to see if it was associated, return if not + call RegUnpack(RF, IsAssociated) + if (RegCheckErr(RF, "UnpackPtr_R8_Rank2")) return + if (.not. IsAssociated) return + + ! Read array bounds + call RegUnpackBounds(RF, 2, LB, UB) + if (RegCheckErr(RF, "UnpackPtr_R8_Rank2")) return + + ! Unpack pointer inf + call RegUnpackPointer(RF, Ptr, PtrIdx) + if (RegCheckErr(RF, "UnpackPtr_R8_Rank2")) return + + ! If pointer was in index, associate data with pointer, return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, Data, UB - LB) + Data(LB(1):,LB(2):) => Data + return + end if + + ! Allocate data + allocate(Data(LB(1):UB(1),LB(2):UB(2)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackPtr_R8_Rank2: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackPtr_R8_Rank2")) return + end subroutine + + subroutine Pack_R8_Rank3(RF, Data) + type(RegFile), intent(inout) :: RF + real(R8Ki), intent(in) :: Data(:,:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Increment data number and write to file + RF%NumData = RF%NumData + 1 + write(RF%Unit) RF%NumData + + ! Write data to file + write(RF%Unit) Data + end subroutine + + subroutine Unpack_R8_Rank3(RF, Data) + type(RegFile), intent(inout) :: RF + real(R8Ki), intent(out) :: Data(:,:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Read data number, return if invalid + if (.not. DataNumValid(RF)) return + + ! Read data from file + read(RF%Unit) Data + end subroutine + + subroutine PackAlloc_R8_Rank3(RF, Data) + type(RegFile), intent(inout) :: RF + real(R8Ki), allocatable, intent(in) :: Data(:,:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if allocated + call RegPack(RF, allocated(Data)) + if (RegCheckErr(RF, "PackAlloc_R8_Rank3")) return + if (.not. allocated(Data)) return + + ! Write array bounds + call RegPackBounds(RF, 3, lbound(Data), ubound(Data)) + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackAlloc_R8_Rank3")) return + end subroutine + + subroutine UnpackAlloc_R8_Rank3(RF, Data) + type(RegFile), intent(inout) :: RF + real(R8Ki), allocatable, intent(out) :: Data(:,:,:) + integer(IntKi) :: stat + logical :: IsAllocated + integer(B4Ki) :: LB(3), UB(3) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Deallocate if allocated + if (allocated(Data)) deallocate(Data) + + ! Read value to see if it was allocated, return if not + call RegUnpack(RF, IsAllocated) + if (RegCheckErr(RF, "UnpackAlloc_R8_Rank3")) return + if (.not. IsAllocated) return + + ! Read array bounds + call RegUnpackBounds(RF, 3, LB, UB) + if (RegCheckErr(RF, "UnpackAlloc_R8_Rank3")) return + + ! Allocate data + allocate(Data(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackAlloc_R8_Rank3: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackAlloc_R8_Rank3")) return + end subroutine + + subroutine PackPtr_R8_Rank3(RF, Data) + type(RegFile), intent(inout) :: RF + real(R8Ki), pointer, intent(in) :: Data(:,:,:) + logical :: PtrInIndex + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if associated + call RegPack(RF, associated(Data)) + if (RegCheckErr(RF, "PackPtr_R8_Rank3")) return + if (.not. associated(Data)) return + + ! Write array bounds + call RegPackBounds(RF, 3, lbound(Data), ubound(Data)) + + ! Write pointer info + call RegPackPointer(RF, c_loc(Data), PtrInIndex) + if (RegCheckErr(RF, "PackPtr_R8_Rank3")) return + if (PtrInIndex) return + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackPtr_R8_Rank3")) return + end subroutine + + subroutine UnpackPtr_R8_Rank3(RF, Data, LB, UB) + type(RegFile), intent(inout) :: RF + real(R8Ki), pointer, intent(out) :: Data(:,:,:) + integer(B4Ki), intent(out) :: LB(:), UB(:) + integer(IntKi) :: stat + integer(B8Ki) :: PtrIdx + logical :: IsAssociated + type(c_ptr) :: Ptr + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! If associated, deallocate and nullify + if (associated(Data)) then + deallocate(Data) + nullify(Data) + end if + + ! Read value to see if it was associated, return if not + call RegUnpack(RF, IsAssociated) + if (RegCheckErr(RF, "UnpackPtr_R8_Rank3")) return + if (.not. IsAssociated) return + + ! Read array bounds + call RegUnpackBounds(RF, 3, LB, UB) + if (RegCheckErr(RF, "UnpackPtr_R8_Rank3")) return + + ! Unpack pointer inf + call RegUnpackPointer(RF, Ptr, PtrIdx) + if (RegCheckErr(RF, "UnpackPtr_R8_Rank3")) return + + ! If pointer was in index, associate data with pointer, return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, Data, UB - LB) + Data(LB(1):,LB(2):,LB(3):) => Data + return + end if + + ! Allocate data + allocate(Data(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackPtr_R8_Rank3: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackPtr_R8_Rank3")) return + end subroutine + + subroutine Pack_R8_Rank4(RF, Data) + type(RegFile), intent(inout) :: RF + real(R8Ki), intent(in) :: Data(:,:,:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Increment data number and write to file + RF%NumData = RF%NumData + 1 + write(RF%Unit) RF%NumData + + ! Write data to file + write(RF%Unit) Data + end subroutine + + subroutine Unpack_R8_Rank4(RF, Data) + type(RegFile), intent(inout) :: RF + real(R8Ki), intent(out) :: Data(:,:,:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Read data number, return if invalid + if (.not. DataNumValid(RF)) return + + ! Read data from file + read(RF%Unit) Data + end subroutine + + subroutine PackAlloc_R8_Rank4(RF, Data) + type(RegFile), intent(inout) :: RF + real(R8Ki), allocatable, intent(in) :: Data(:,:,:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if allocated + call RegPack(RF, allocated(Data)) + if (RegCheckErr(RF, "PackAlloc_R8_Rank4")) return + if (.not. allocated(Data)) return + + ! Write array bounds + call RegPackBounds(RF, 4, lbound(Data), ubound(Data)) + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackAlloc_R8_Rank4")) return + end subroutine + + subroutine UnpackAlloc_R8_Rank4(RF, Data) + type(RegFile), intent(inout) :: RF + real(R8Ki), allocatable, intent(out) :: Data(:,:,:,:) + integer(IntKi) :: stat + logical :: IsAllocated + integer(B4Ki) :: LB(4), UB(4) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Deallocate if allocated + if (allocated(Data)) deallocate(Data) + + ! Read value to see if it was allocated, return if not + call RegUnpack(RF, IsAllocated) + if (RegCheckErr(RF, "UnpackAlloc_R8_Rank4")) return + if (.not. IsAllocated) return + + ! Read array bounds + call RegUnpackBounds(RF, 4, LB, UB) + if (RegCheckErr(RF, "UnpackAlloc_R8_Rank4")) return + + ! Allocate data + allocate(Data(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackAlloc_R8_Rank4: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackAlloc_R8_Rank4")) return + end subroutine + + subroutine PackPtr_R8_Rank4(RF, Data) + type(RegFile), intent(inout) :: RF + real(R8Ki), pointer, intent(in) :: Data(:,:,:,:) + logical :: PtrInIndex + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if associated + call RegPack(RF, associated(Data)) + if (RegCheckErr(RF, "PackPtr_R8_Rank4")) return + if (.not. associated(Data)) return + + ! Write array bounds + call RegPackBounds(RF, 4, lbound(Data), ubound(Data)) + + ! Write pointer info + call RegPackPointer(RF, c_loc(Data), PtrInIndex) + if (RegCheckErr(RF, "PackPtr_R8_Rank4")) return + if (PtrInIndex) return + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackPtr_R8_Rank4")) return + end subroutine + + subroutine UnpackPtr_R8_Rank4(RF, Data, LB, UB) + type(RegFile), intent(inout) :: RF + real(R8Ki), pointer, intent(out) :: Data(:,:,:,:) + integer(B4Ki), intent(out) :: LB(:), UB(:) + integer(IntKi) :: stat + integer(B8Ki) :: PtrIdx + logical :: IsAssociated + type(c_ptr) :: Ptr + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! If associated, deallocate and nullify + if (associated(Data)) then + deallocate(Data) + nullify(Data) + end if + + ! Read value to see if it was associated, return if not + call RegUnpack(RF, IsAssociated) + if (RegCheckErr(RF, "UnpackPtr_R8_Rank4")) return + if (.not. IsAssociated) return + + ! Read array bounds + call RegUnpackBounds(RF, 4, LB, UB) + if (RegCheckErr(RF, "UnpackPtr_R8_Rank4")) return + + ! Unpack pointer inf + call RegUnpackPointer(RF, Ptr, PtrIdx) + if (RegCheckErr(RF, "UnpackPtr_R8_Rank4")) return + + ! If pointer was in index, associate data with pointer, return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, Data, UB - LB) + Data(LB(1):,LB(2):,LB(3):,LB(4):) => Data + return + end if + + ! Allocate data + allocate(Data(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackPtr_R8_Rank4: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackPtr_R8_Rank4")) return + end subroutine + + subroutine Pack_R8_Rank5(RF, Data) + type(RegFile), intent(inout) :: RF + real(R8Ki), intent(in) :: Data(:,:,:,:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Increment data number and write to file + RF%NumData = RF%NumData + 1 + write(RF%Unit) RF%NumData + + ! Write data to file + write(RF%Unit) Data + end subroutine + + subroutine Unpack_R8_Rank5(RF, Data) + type(RegFile), intent(inout) :: RF + real(R8Ki), intent(out) :: Data(:,:,:,:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Read data number, return if invalid + if (.not. DataNumValid(RF)) return + + ! Read data from file + read(RF%Unit) Data + end subroutine + + subroutine PackAlloc_R8_Rank5(RF, Data) + type(RegFile), intent(inout) :: RF + real(R8Ki), allocatable, intent(in) :: Data(:,:,:,:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if allocated + call RegPack(RF, allocated(Data)) + if (RegCheckErr(RF, "PackAlloc_R8_Rank5")) return + if (.not. allocated(Data)) return + + ! Write array bounds + call RegPackBounds(RF, 5, lbound(Data), ubound(Data)) + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackAlloc_R8_Rank5")) return + end subroutine + + subroutine UnpackAlloc_R8_Rank5(RF, Data) + type(RegFile), intent(inout) :: RF + real(R8Ki), allocatable, intent(out) :: Data(:,:,:,:,:) + integer(IntKi) :: stat + logical :: IsAllocated + integer(B4Ki) :: LB(5), UB(5) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Deallocate if allocated + if (allocated(Data)) deallocate(Data) + + ! Read value to see if it was allocated, return if not + call RegUnpack(RF, IsAllocated) + if (RegCheckErr(RF, "UnpackAlloc_R8_Rank5")) return + if (.not. IsAllocated) return + + ! Read array bounds + call RegUnpackBounds(RF, 5, LB, UB) + if (RegCheckErr(RF, "UnpackAlloc_R8_Rank5")) return + + ! Allocate data + allocate(Data(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackAlloc_R8_Rank5: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackAlloc_R8_Rank5")) return + end subroutine + + subroutine PackPtr_R8_Rank5(RF, Data) + type(RegFile), intent(inout) :: RF + real(R8Ki), pointer, intent(in) :: Data(:,:,:,:,:) + logical :: PtrInIndex + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if associated + call RegPack(RF, associated(Data)) + if (RegCheckErr(RF, "PackPtr_R8_Rank5")) return + if (.not. associated(Data)) return + + ! Write array bounds + call RegPackBounds(RF, 5, lbound(Data), ubound(Data)) + + ! Write pointer info + call RegPackPointer(RF, c_loc(Data), PtrInIndex) + if (RegCheckErr(RF, "PackPtr_R8_Rank5")) return + if (PtrInIndex) return + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackPtr_R8_Rank5")) return + end subroutine + + subroutine UnpackPtr_R8_Rank5(RF, Data, LB, UB) + type(RegFile), intent(inout) :: RF + real(R8Ki), pointer, intent(out) :: Data(:,:,:,:,:) + integer(B4Ki), intent(out) :: LB(:), UB(:) + integer(IntKi) :: stat + integer(B8Ki) :: PtrIdx + logical :: IsAssociated + type(c_ptr) :: Ptr + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! If associated, deallocate and nullify + if (associated(Data)) then + deallocate(Data) + nullify(Data) + end if + + ! Read value to see if it was associated, return if not + call RegUnpack(RF, IsAssociated) + if (RegCheckErr(RF, "UnpackPtr_R8_Rank5")) return + if (.not. IsAssociated) return + + ! Read array bounds + call RegUnpackBounds(RF, 5, LB, UB) + if (RegCheckErr(RF, "UnpackPtr_R8_Rank5")) return + + ! Unpack pointer inf + call RegUnpackPointer(RF, Ptr, PtrIdx) + if (RegCheckErr(RF, "UnpackPtr_R8_Rank5")) return + + ! If pointer was in index, associate data with pointer, return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, Data, UB - LB) + Data(LB(1):,LB(2):,LB(3):,LB(4):,LB(5):) => Data + return + end if + + ! Allocate data + allocate(Data(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackPtr_R8_Rank5: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackPtr_R8_Rank5")) return + end subroutine +end module \ No newline at end of file diff --git a/modules/nwtc-library/src/NWTC_Base.f90 b/modules/nwtc-library/src/NWTC_Base.f90 index b27652c695..3cc5d1e65d 100644 --- a/modules/nwtc-library/src/NWTC_Base.f90 +++ b/modules/nwtc-library/src/NWTC_Base.f90 @@ -81,5 +81,30 @@ MODULE NWTC_Base END TYPE DLL_Type +contains + + !======================================================================= + !> This routine sets the error status and error message for a routine + !! that may set non-AbortErrLev errors. It concatenates error messages + !! and has the ability to provide a sort of traceback message of called + !! routines (if this is called consistently). + !! Modules in the FAST framework are recommended to use it. + subroutine SetErrStat (ErrStatLcl, ErrMessLcl, ErrStat, ErrMess, RoutineName) + + INTEGER(IntKi), INTENT(IN ) :: ErrStatLcl ! Error status of the operation + CHARACTER(*), INTENT(IN ) :: ErrMessLcl ! Error message if ErrStat /= ErrID_None + + INTEGER(IntKi), INTENT(INOUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT(INOUT) :: ErrMess ! Error message if ErrStat /= ErrID_None + + CHARACTER(*), INTENT(IN ) :: RoutineName ! Name of the routine error occurred in + + IF ( ErrStatLcl /= ErrID_None ) THEN + IF (ErrStat /= ErrID_None) ErrMess = TRIM(ErrMess)//new_line('a') + ErrMess = TRIM(ErrMess)//TRIM(RoutineName)//':'//TRIM(ErrMessLcl) + ErrStat = MAX(ErrStat,ErrStatLcl) + END IF + + end subroutine END MODULE NWTC_Base diff --git a/modules/nwtc-library/src/NWTC_IO.f90 b/modules/nwtc-library/src/NWTC_IO.f90 index 9f0bce1982..8c8f522d04 100644 --- a/modules/nwtc-library/src/NWTC_IO.f90 +++ b/modules/nwtc-library/src/NWTC_IO.f90 @@ -58,7 +58,7 @@ MODULE NWTC_IO LOGICAL :: Beep = .TRUE. !< Flag that specifies whether or not to beep for error messages and program terminations. - CHARACTER(20) :: ProgName = ' ' !< The name of the calling program. DO NOT USE THIS IN NEW PROGRAMS (Modules) + CHARACTER(25) :: ProgName = ' ' !< The name of the calling program. DO NOT USE THIS IN NEW PROGRAMS (Modules) CHARACTER(99) :: ProgVer = ' ' !< The version (including date) of the calling program. DO NOT USE THIS IN NEW PROGRAMS CHARACTER(1), PARAMETER :: Tab = CHAR( 9 ) !< The tab character. CHARACTER(*), PARAMETER :: CommChars = '!#%' !< Comment characters that mark the end of useful input @@ -120,6 +120,7 @@ MODULE NWTC_IO MODULE PROCEDURE AllIPAry1 MODULE PROCEDURE AllIPAry2 MODULE PROCEDURE AllFPAry1 + MODULE PROCEDURE AllDPAry1 MODULE PROCEDURE AllRPAry2 MODULE PROCEDURE AllR4PAry3 MODULE PROCEDURE AllR8PAry3 @@ -191,6 +192,14 @@ MODULE NWTC_IO MODULE PROCEDURE ReadR8AryFromStr END INTERFACE + !> \copydoc nwtc_io::readr4arywdefault + INTERFACE ReadAryWDefault + MODULE PROCEDURE ReadR4AryWDefault + MODULE PROCEDURE ReadR8AryWDefault +! MODULE PROCEDURE ReadR4AryWDefaultFromStr ! Not coded yet +! MODULE PROCEDURE ReadR8AryWDefaultFromStr ! Not coded yet + END INTERFACE + !> \copydoc nwtc_io::readcarylines INTERFACE ReadAryLines MODULE PROCEDURE ReadCAryLines @@ -620,6 +629,37 @@ SUBROUTINE AllFPAry1 ( Ary, AryDim1, Descr, ErrStat, ErrMsg ) RETURN END SUBROUTINE AllFPAry1 !======================================================================= +!> \copydoc nwtc_io::allipary1 + SUBROUTINE AllDPAry1 ( Ary, AryDim1, Descr, ErrStat, ErrMsg ) + ! This routine allocates a 1-D REAL array. + + ! Argument declarations. + REAL(C_DOUBLE), POINTER :: Ary (:) ! Array to be allocated + INTEGER, INTENT(IN) :: AryDim1 ! The size of the first dimension of the array. + INTEGER, INTENT(OUT) :: ErrStat !< Error status + CHARACTER(*), INTENT(OUT) :: ErrMsg ! Error message corresponding to ErrStat + CHARACTER(*), INTENT(IN) :: Descr ! Brief array description. + + IF ( ASSOCIATED(Ary) ) THEN + DEALLOCATE(Ary) + !ErrStat = ErrID_Warn + !ErrMsg = " AllRPAry2: Ary already allocated." + END IF + + ALLOCATE ( Ary(AryDim1) , STAT=ErrStat ) + IF ( ErrStat /= 0 ) THEN + ErrStat = ErrID_Fatal + ErrMsg = 'Error allocating '//TRIM(Num2LStr(AryDim1*BYTES_IN_REAL))//& + ' bytes of memory for the '//TRIM( Descr )//' array.' + ELSE + ErrStat = ErrID_None + ErrMsg = '' + Ary = 0 + END IF + + RETURN + END SUBROUTINE AllDPAry1 +!======================================================================= !> \copydoc nwtc_io::allipary1 SUBROUTINE AllRPAry2 ( Ary, AryDim1, AryDim2, Descr, ErrStat, ErrMsg ) ! This routine allocates a 2-D REAL array. @@ -674,7 +714,7 @@ SUBROUTINE AllR4PAry3 ( Ary, AryDim1, AryDim2, AryDim3, Descr, ErrStat, ErrMsg ALLOCATE ( Ary(AryDim1,AryDim2,AryDim3) , STAT=ErrStat ) IF ( ErrStat /= 0 ) THEN ErrStat = ErrID_Fatal - ErrMsg = 'Error allocating '//TRIM(Num2LStr(AryDim1*AryDim2*AryDim3*BYTES_IN_REAL))//& + ErrMsg = 'Error allocating '//TRIM(Num2LStr(AryDim1*AryDim2*AryDim3*BYTES_IN_R4Ki))//& ' bytes of memory for the '//TRIM( Descr )//' array.' ELSE ErrStat = ErrID_None @@ -707,7 +747,7 @@ SUBROUTINE AllR8PAry3 ( Ary, AryDim1, AryDim2, AryDim3, Descr, ErrStat, ErrMsg ALLOCATE ( Ary(AryDim1,AryDim2,AryDim3) , STAT=ErrStat ) IF ( ErrStat /= 0 ) THEN ErrStat = ErrID_Fatal - ErrMsg = 'Error allocating '//TRIM(Num2LStr(AryDim1*AryDim2*AryDim3*BYTES_IN_REAL))//& + ErrMsg = 'Error allocating '//TRIM(Num2LStr(AryDim1*AryDim2*AryDim3*BYTES_IN_R8Ki))//& ' bytes of memory for the '//TRIM( Descr )//' array.' ELSE ErrStat = ErrID_None @@ -827,7 +867,7 @@ SUBROUTINE AllR4Ary1 ( Ary, AryDim1, Descr, ErrStat, ErrMsg ) IF ( ALLOCATED(Ary) ) THEN ! or Sttus=151 on IVF ErrMsg = 'Error allocating memory for the '//TRIM( Descr )//' array; array was already allocated.' ELSE - ErrMsg = 'Error allocating '//TRIM(Num2LStr(AryDim1*BYTES_IN_SiKi))//' bytes of memory for the '//TRIM( Descr )//' array.' + ErrMsg = 'Error allocating '//TRIM(Num2LStr(AryDim1*BYTES_IN_R4Ki))//' bytes of memory for the '//TRIM( Descr )//' array.' END IF ELSE ErrStat = ErrID_None @@ -886,7 +926,7 @@ SUBROUTINE AllR4Ary2 ( Ary, AryDim1, AryDim2, Descr, ErrStat, ErrMsg ) IF ( ALLOCATED(Ary) ) THEN ErrMsg = 'Error allocating memory for the '//TRIM( Descr )//' array; array was already allocated.' ELSE - ErrMsg = 'Error allocating '//TRIM(Num2LStr(AryDim1*AryDim2*BYTES_IN_SiKi))//& + ErrMsg = 'Error allocating '//TRIM(Num2LStr(AryDim1*AryDim2*BYTES_IN_R4Ki))//& ' bytes of memory for the '//TRIM( Descr )//' array.' END IF ELSE @@ -949,7 +989,7 @@ SUBROUTINE AllR4Ary3 ( Ary, AryDim1, AryDim2, AryDim3, Descr, ErrStat, ErrMsg ) IF ( ALLOCATED(Ary) ) THEN ! or Sttus=151 on IVF ErrMsg = 'Error allocating memory for the '//TRIM( Descr )//' array; array was already allocated.' ELSE - ErrMsg = 'Error allocating '//TRIM(Num2LStr(AryDim1*AryDim2*AryDim3*BYTES_IN_REAL))//& + ErrMsg = 'Error allocating '//TRIM(Num2LStr(AryDim1*AryDim2*AryDim3*BYTES_IN_R4Ki))//& ' bytes of memory for the '//TRIM( Descr )//' array.' END IF ELSE @@ -981,7 +1021,7 @@ SUBROUTINE AllR8Ary3 ( Ary, AryDim1, AryDim2, AryDim3, Descr, ErrStat, ErrMsg ) IF ( ALLOCATED(Ary) ) THEN ! or Sttus=151 on IVF ErrMsg = 'Error allocating memory for the '//TRIM( Descr )//' array; array was already allocated.' ELSE - ErrMsg = 'Error allocating '//TRIM(Num2LStr(AryDim1*AryDim2*AryDim3*BYTES_IN_REAL))//& + ErrMsg = 'Error allocating '//TRIM(Num2LStr(AryDim1*AryDim2*AryDim3*BYTES_IN_R8Ki))//& ' bytes of memory for the '//TRIM( Descr )//' array.' END IF ELSE @@ -1014,7 +1054,7 @@ SUBROUTINE AllR4Ary4 ( Ary, AryDim1, AryDim2, AryDim3, AryDim4, Descr, ErrStat, IF ( ALLOCATED(Ary) ) THEN ! or Sttus=151 on IVF ErrMsg = 'Error allocating memory for the '//TRIM( Descr )//' array; array was already allocated.' ELSE - ErrMsg = 'Error allocating '//TRIM(Num2LStr(AryDim1*AryDim2*AryDim3*AryDim4*BYTES_IN_REAL))//& + ErrMsg = 'Error allocating '//TRIM(Num2LStr(AryDim1*AryDim2*AryDim3*AryDim4*BYTES_IN_R4Ki))//& ' bytes of memory for the '//TRIM( Descr )//' array.' END IF ELSE @@ -1047,7 +1087,7 @@ SUBROUTINE AllR8Ary4 ( Ary, AryDim1, AryDim2, AryDim3, AryDim4, Descr, ErrStat, IF ( ALLOCATED(Ary) ) THEN ! or Sttus=151 on IVF ErrMsg = 'Error allocating memory for the '//TRIM( Descr )//' array; array was already allocated.' ELSE - ErrMsg = 'Error allocating '//TRIM(Num2LStr(AryDim1*AryDim2*AryDim3*AryDim4*BYTES_IN_REAL))//& + ErrMsg = 'Error allocating '//TRIM(Num2LStr(AryDim1*AryDim2*AryDim3*AryDim4*BYTES_IN_R8Ki))//& ' bytes of memory for the '//TRIM( Descr )//' array.' END IF ELSE @@ -1081,7 +1121,7 @@ SUBROUTINE AllR4Ary5 ( Ary, AryDim1, AryDim2, AryDim3, AryDim4, AryDim5, Descr, IF ( ALLOCATED(Ary) ) THEN ! or Sttus=151 on IVF ErrMsg = 'Error allocating memory for the '//TRIM( Descr )//' array; array was already allocated.' ELSE - ErrMsg = 'Error allocating '//TRIM(Num2LStr(AryDim1*AryDim2*AryDim3*AryDim4*AryDim5*BYTES_IN_REAL))//& + ErrMsg = 'Error allocating '//TRIM(Num2LStr(AryDim1*AryDim2*AryDim3*AryDim4*AryDim5*BYTES_IN_R4Ki))//& ' bytes of memory for the '//TRIM( Descr )//' array.' END IF ELSE @@ -1115,7 +1155,7 @@ SUBROUTINE AllR8Ary5 ( Ary, AryDim1, AryDim2, AryDim3, AryDim4, AryDim5, Descr, IF ( ALLOCATED(Ary) ) THEN ! or Sttus=151 on IVF ErrMsg = 'Error allocating memory for the '//TRIM( Descr )//' array; array was already allocated.' ELSE - ErrMsg = 'Error allocating '//TRIM(Num2LStr(AryDim1*AryDim2*AryDim3*AryDim4*AryDim5*BYTES_IN_REAL))//& + ErrMsg = 'Error allocating '//TRIM(Num2LStr(AryDim1*AryDim2*AryDim3*AryDim4*AryDim5*BYTES_IN_R8Ki))//& ' bytes of memory for the '//TRIM( Descr )//' array.' END IF ELSE @@ -1599,105 +1639,65 @@ END SUBROUTINE DispCopyrightLicense !======================================================================= !> This routine packs the DLL_Type (nwtc_base::dll_type) data into an integer buffer. !! It is required for the FAST Registry. It is the inverse of DLLTypeUnPack (nwtc_io::dlltypeunpack). - SUBROUTINE DLLTypePack( InData, ReKiBuf, DbKiBuf, IntKiBuf, ErrStat, ErrMsg, SizeOnly ) - - - TYPE(DLL_Type), INTENT(IN ) :: InData !< DLL data to pack (store in arrays of type ReKi, DbKi, and/or IntKi) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) !< buffer with real (ReKi) data from InData structure - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) !< buffer with double (DbKi) data from InData structure - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) !< buffer with integer (IntKi) data from InData structure - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< error status - CHARACTER(*), INTENT( OUT) :: ErrMsg !< error message - LOGICAL, OPTIONAL, INTENT(IN ) :: SizeOnly !< flag to determine if we're just looking for the size of the buffers instead of the packed data - - ! Local variable - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: i,buf_start + SUBROUTINE DLLTypePack(RF, InData) + type(RegFile), intent(inout) :: RF + TYPE(DLL_Type), intent(in) :: InData !< DLL data to pack - ErrStat = ErrID_None - ErrMsg = "" + INTEGER(IntKi) :: i - ! get size of buffer: - Int_BufSz = LEN(InData%FileName) + LEN(InData%ProcName(1))*NWTC_MAX_DLL_PROC + 1 - - ALLOCATE( IntKiBuf(Int_BufSz), STAT=ErrStat ) - IF (ErrStat /= 0 ) THEN - ErrStat = ErrID_Fatal - ErrMsg = ' DLLTypePack: Error allocating IntKiBuf.' - RETURN - END IF - - IF ( PRESENT(SizeOnly) ) THEN - IF ( SizeOnly ) RETURN - ENDIF - - !.............. - ! Fill buffer - !.............. - - ! has the DLL procedure been loaded? - IF ( C_ASSOCIATED(InData%ProcAddr(1))) THEN - IntKiBuf(1) = 1 - ELSE - IntKiBuf(1) = 0 - END IF + ! If buffer error, return + if (RF%ErrStat /= ErrID_None) return - ! Put an ascii representation of the strings in the integer array - CALL Str2IntAry( InData%FileName, IntKiBuf(2:), ErrStat, ErrMsg ) - buf_start=LEN(InData%FileName)+2 - DO i=1,NWTC_MAX_DLL_PROC - CALL Str2IntAry( InData%ProcName(i), IntKiBuf(buf_start:), ErrStat, ErrMsg ) - buf_start = buf_start + LEN(InData%ProcName(i)) - END DO + ! has the DLL procedure been loaded? + call RegPack(RF, c_associated(InData%ProcAddr(1))) + ! Pack strings + call RegPack(RF, InData%FileName) + do i = 1, NWTC_MAX_DLL_PROC + call RegPack(RF, InData%ProcName(i)) + end do + + ! If buffer error, return + if (RegCheckErr(RF, 'DLLTypeUnPack')) return END SUBROUTINE DLLTypePack !======================================================================= !> This routine unpacks the DLL_Type data from an integer buffer. !! It is required for the FAST Registry. It is the inverse of DLLTypePack (nwtc_io::dlltypepack). - SUBROUTINE DLLTypeUnPack( OutData, ReKiBuf, DbKiBuf, IntKiBuf, ErrStat, ErrMsg ) - - - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) !< buffer with real (ReKi) data to place in the OutData structure - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) !< buffer with real (DbKi) data to place in the OutData structure - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) !< buffer with integer (IntKi) data to place in the OutData structure - TYPE(DLL_Type), INTENT( OUT) :: OutData !< the reconstituted OutData structure, created from 3 buffers - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< error status/level - CHARACTER(*), INTENT( OUT) :: ErrMsg !< message corresponding to ErrStat - - ! Local variable - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: i, Int_BufEnd + subroutine DLLTypeUnPack(RF, OutData) + type(RegFile), intent(inout) :: RF + type(DLL_Type), intent(out) :: OutData !< Reconstituted OutData structure + + logical :: WasAssociated + integer(IntKi) :: i + + ! If buffer error, return + if (RF%ErrStat /= ErrID_None) return - ErrStat = ErrID_None - ErrMsg = "" + ! Get flag indicating if dll was associated + call RegUnpack(RF, WasAssociated) - IF (.NOT. ALLOCATED(IntKiBuf) ) THEN - ErrStat = ErrID_Fatal - ErrMsg = ' DLLTypeUnPack: invalid buffer.' - END IF - - ! Get an ascii representation of the strings from the integer array - Int_BufSz = LEN(OutData%FileName) + 1 - CALL IntAry2Str( IntKiBuf(2:(Int_BufSz)), OutData%FileName, ErrStat, ErrMsg ) - IF (ErrStat >= AbortErrLev) RETURN - Int_BufSz = Int_BufSz + 1 - do i=1,NWTC_MAX_DLL_PROC - Int_BufEnd=Int_BufSz+LEN(OutData%ProcName(i))-1 - CALL IntAry2Str( IntKiBuf(Int_BufSz:Int_BufEnd), OutData%ProcName(i), ErrStat, ErrMsg ) - IF (ErrStat >= AbortErrLev) RETURN - Int_BufSz = Int_BufSz+LEN(OutData%ProcName(i)) + ! Unpack strings + call RegUnpack(RF, OutData%FileName) + do i = 1, NWTC_MAX_DLL_PROC + call RegUnpack(RF, OutData%ProcName(i)) end do + + ! If buffer error, return + if (RegCheckErr(RF, 'DLLTypeUnPack')) return - - IF ( IntKiBuf(1) == 1 .AND. LEN_TRIM(OutData%FileName) > 0 .AND. LEN_TRIM(OutData%ProcName(1)) > 0 ) THEN - CALL LoadDynamicLib( OutData, ErrStat, ErrMsg ) + ! If dll was loaded, and data in filename and procname, load dll + IF (WasAssociated .AND. LEN_TRIM(OutData%FileName) > 0 .AND. LEN_TRIM(OutData%ProcName(1)) > 0) THEN + CALL LoadDynamicLib(OutData, RF%ErrStat, RF%ErrMsg) else ! Nullifying OutData%FileAddr = INT(0,C_INTPTR_T) OutData%FileAddrX = C_NULL_PTR OutData%ProcAddr = C_NULL_FUNPTR END IF + + ! If buffer error, return + if (RegCheckErr(RF, 'DLLTypeUnPack')) return END SUBROUTINE DLLTypeUnPack !======================================================================= @@ -1730,7 +1730,7 @@ SUBROUTINE DispNVD1 ( ProgInfo, DispNWTCVer ) END IF END IF - CALL WrScr ( 'Running '//TRIM( GetNVD( ProgInfo ) )//'.' ) + CALL WrScr ( ' Running '//TRIM( GetNVD( ProgInfo ) )//'.' ) RETURN END SUBROUTINE DispNVD1 @@ -1873,7 +1873,7 @@ FUNCTION GetErrStr ( ErrID ) INTEGER(IntKi), INTENT(IN) :: ErrID !< error status/level ! Function delcaration - CHARACTER(13) :: GetErrStr !< description of the ErrID level + CHARACTER(25) :: GetErrStr !< description of the ErrID level SELECT CASE ( ErrID ) CASE ( ErrID_None ) @@ -1887,12 +1887,11 @@ FUNCTION GetErrStr ( ErrID ) CASE ( ErrID_Fatal ) GetErrStr = 'FATAL ERROR' CASE DEFAULT - GetErrStr = 'Unknown ErrID' + GetErrStr = 'Unknown ErrID '//TRIM(Num2LStr(ErrID)) END SELECT END FUNCTION GetErrStr - !======================================================================= !> This function extracts the Name field from the ProgDesc data type ! and return it. @@ -2161,6 +2160,65 @@ SUBROUTINE GetWords ( Line, Words, NumWords, NumFound, IgnoreQuotes ) END SUBROUTINE GetWords !======================================================================= +!> This subroutine is used to compare a header line (`HeaderLine`) with a list of column names. +!! It searches for each possible column name (AvailableChanName) and returns an index array indicating which +!! order the columns are listed in the file (this allows columns to be entered in different orders or for +!! some columns to be missing. It returns an error if any of the required channels are missing. + SUBROUTINE GetInputColumnIndex(MaxCols, AvailableChanNames, RequiredChanNames, HeaderLine, Indx, ErrStat, ErrMsg) + + INTEGER(IntKi), INTENT(IN ) :: MaxCols !< maximum number of columns that should be in the input file + CHARACTER(*), INTENT(IN ) :: AvailableChanNames(MaxCols) !< list of column headers, THESE SHOULD BE IN UPPER CASE + LOGICAL, INTENT(IN ) :: RequiredChanNames( MaxCols) !< T/F corresponding to channel names to determine if these channels should be required + CHARACTER(*), INTENT(IN ) :: HeaderLine !< line of text to be read + INTEGER(IntKi), INTENT(INOUT) :: Indx(MaxCols) !< index relating upper-case column names found in header line with AvailableChanNames + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< returns a fatal error if a required channel name isn't found in HeaderLine + CHARACTER(*), INTENT( OUT) :: ErrMsg !< returns message about which column is missing + + CHARACTER(ChanLen) :: Words(MaxCols) + INTEGER(IntKi) :: i ! loop counter + INTEGER(IntKi) :: j ! loop counter + INTEGER(IntKi) :: FirstCheck + INTEGER(IntKi) :: NumFound + + ErrStat = ErrID_None + ErrMsg = "" + + CALL GetWords ( HeaderLine, Words, MaxCols, NumFound ) + + DO j = 1,NumFound + CALL Conv2UC ( Words(j) ) + + ! stop reading any more headers if this word starts with a comment character (indicating that the columns aren't in the table) + IF ( INDEX( CommChars, Words(j)(1:1) ) > 0 ) THEN + NumFound = j - 1 + EXIT + END IF + END DO + + Indx = -1 ! initialize all values to be "not found" + + FirstCheck = 1 + DO i = 1,SIZE(Indx) + DO j = FirstCheck,NumFound + IF ( TRIM(AvailableChanNames(i)) == TRIM(Words(j)) ) THEN + Indx(I) = j + IF (j == FirstCheck + 1) FirstCheck = FirstCheck + 1 ! attempt to make this loop a little faster without assuming anything about the order of the words found + CYCLE + END IF + END DO + END DO + + ! check that the required columns are in the file: + DO i = 1,SIZE(Indx) + IF (Indx(i) < 1 .and. RequiredChanNames(i)) THEN + ErrStat = ErrID_Fatal + ErrMsg = TRIM(AvailableChanNames(i))//" , a required input, was not found in the line." + RETURN + END IF + END DO + + END SUBROUTINE GetInputColumnIndex +!======================================================================= !> This routine converts an ASCII array of integers into an equivalent string !! (character array). This routine is the inverse of the Str2IntAry() (nwtc_io::str2intary) routine. SUBROUTINE IntAry2Str( IntAry, Str, ErrStat, ErrMsg ) @@ -2868,7 +2926,7 @@ SUBROUTINE ParseChAry ( FileInfo, LineNum, AryName, Ary, AryLen, ErrStat, ErrMsg END SUBROUTINE ParseChAry !======================================================================= !> This subroutine parses a comment line - SUBROUTINE ParseCom ( FileInfo, LineNum, Var, ErrStat, ErrMsg, UnEc ) + SUBROUTINE ParseCom ( FileInfo, LineNum, Var, ErrStat, ErrMsg, UnEc, IsLegalComment ) ! Arguments declarations. INTEGER(IntKi), INTENT(OUT) :: ErrStat !< The error status. @@ -2877,6 +2935,7 @@ SUBROUTINE ParseCom ( FileInfo, LineNum, Var, ErrStat, ErrMsg, UnEc ) CHARACTER(*), INTENT(OUT) :: Var !< The variable to receive the comment CHARACTER(*), INTENT(OUT) :: ErrMsg !< The error message, if ErrStat /= 0. TYPE (FileInfoType), INTENT(IN) :: FileInfo !< The derived type for holding the file information. + LOGICAL, OPTIONAL, INTENT(INOUT) :: IsLegalComment !< True if the comment is a "legal" comment line starting with '---' or '==='. NOTE: We have too many options, we need to be more strict!!!! CHARACTER(*), PARAMETER :: RoutineName = 'ParseCom' ErrStat=ErrID_None @@ -2904,6 +2963,21 @@ SUBROUTINE ParseCom ( FileInfo, LineNum, Var, ErrStat, ErrMsg, UnEc ) END IF LineNum = LineNum + 1 + IF (PRESENT(IsLegalComment) ) then + if (len(Var)<=3) then + IsLegalComment=.False. + else + ! Here, we are talking about comments in the input file that are "expected to be there" + IsLegalComment = (Var(1:3)=='---') .or. (Var(1:3)=='===') + endif + if (.not.IsLegalComment) then + call SetErrStat(ErrID_Fatal, NewLine//' >> A fatal error occurred when parsing data.'//NewLine// & + ' >> The comment line did not start with `---` or `===`. LineNum='// & + trim(num2lstr(LineNum))//'; NumLines='//trim(num2lstr(size(FileInfo%Lines))) & + , ErrStat, ErrMsg, RoutineName ) + endif + END IF + END SUBROUTINE ParseCom !======================================================================= @@ -3872,7 +3946,7 @@ SUBROUTINE ParseSiVarWDefault ( FileInfo, LineNum, ExpVarName, Var, VarDefault, CALL Conv2UC( defaultStr ) IF ( INDEX(defaultStr, "DEFAULT" ) /= 1 ) THEN ! If it's not "default", read this variable LineNum = LineNum - 1 ! back up a line - CALL ParseVar ( FileInfo, LineNum, ExpVarName, Var, ErrStatLcl, ErrMsg2, UnEc ) + CALL ParseVar ( FileInfo, LineNum, ExpVarName, Var, ErrStatLcl, ErrMsg2 ) CALL SetErrStat( ErrStatLcl, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ELSE Var = VarDefault ! "DEFAULT" value @@ -4010,7 +4084,9 @@ subroutine InitFileInfo_FromNullCString(FileString, FileInfo, ErrStat, ErrMsg) NullLoc = index(FileString(idx:len(FileString)),C_NULL_CHAR) ! started indexing at idx, so add that back in for location in FileString NullLoc = NullLoc + idx - 1 - if (NullLoc > idx) then + if (NullLoc == idx) then ! blank line + FileStringArray(Line) = '' + elseif (NullLoc > idx) then FileStringArray(Line) = trim(FileString(idx:NullLoc-1)) else ! If not NULL terminated @@ -4584,20 +4660,26 @@ SUBROUTINE ReadCom ( UnIn, Fil, ComName, ErrStat, ErrMsg, UnEc, Comment ) ! Local declarations: INTEGER :: IOS ! I/O status returned from the read statement. + CHARACTER(ErrMsgLen) :: CommentInt ! internal comment, if not returned from this subroutine - - - READ (UnIn,'(A)',IOSTAT=IOS) Comment + IF (PRESENT(Comment)) THEN + READ (UnIn,'(A)',IOSTAT=IOS) Comment + ELSE + READ (UnIn,'(A)',IOSTAT=IOS) CommentInt + END IF CALL CheckIOS ( IOS, Fil, ComName, StrType, ErrStat, ErrMsg ) - - IF (ErrStat >= AbortErrLev) RETURN IF ( PRESENT(UnEc) ) THEN - IF ( UnEc > 0 ) & - WRITE (UnEc,'(A)') TRIM(Comment) + IF ( UnEc > 0 ) THEN + IF (PRESENT(Comment)) THEN + WRITE (UnEc,'(A)') TRIM(Comment) + ELSE + WRITE (UnEc,'(A)') TRIM(CommentInt) + END IF + END IF END IF @@ -5723,9 +5805,10 @@ SUBROUTINE ReadOutputList ( UnIn, Fil, CharAry, AryLenRead, AryName, AryDescr, E IF ( AryLenRead > MaxAryLen ) THEN - ErrStat = ErrID_Fatal + ErrStat = ErrID_Severe ErrMsg = 'ReadOutputList:The maximum number of output channels allowed is '//TRIM( Int2LStr(MaxAryLen) )//'.' - RETURN + AryLenRead = AryLenRead - NumWords ! The total number of output channels read in so far. +! RETURN ! finish reading the file instead of returning first ELSE @@ -5733,6 +5816,7 @@ SUBROUTINE ReadOutputList ( UnIn, Fil, CharAry, AryLenRead, AryName, AryDescr, E END IF + END DO @@ -5761,10 +5845,11 @@ SUBROUTINE ReadOutputListFromFileInfo ( FileInfo, LineNum, CharAry, AryLenRead, INTEGER :: MaxAryLen ! Maximum length of the array being read INTEGER :: NumWords ! Number of words contained on a line + INTEGER :: ErrStat2 - INTEGER :: QuoteCh ! Character position. +! INTEGER :: QuoteCh ! Character position. - CHARACTER(1000) :: OutLine ! Character string read from file, containing output list + CHARACTER(MaxFileInfoLineLen) :: OutLine ! Character string read from file, containing output list CHARACTER(3) :: EndOfFile @@ -5786,22 +5871,28 @@ SUBROUTINE ReadOutputListFromFileInfo ( FileInfo, LineNum, CharAry, AryLenRead, IF ( PRESENT(UnEc) ) THEN if (UnEc > 0) WRITE(UnEc, '(A)') trim(FileInfo%Lines(LineNum)) ENDIF - OutLine = adjustl(trim(FileInfo%Lines(LineNum))) ! remove leading whitespace + +! OutLine = adjustl(trim(FileInfo%Lines(LineNum))) ! remove leading whitespace + READ (FileInfo%Lines(LineNum),*,IOSTAT=ErrStat2) OutLine ! read first output channel name, or remove quotes on list of outputs so that this behaves like ReadOutputList + IF (ErrStat2 /= 0) THEN + ErrStat = ErrID_Fatal + ErrMsg = 'Error reading from OutList. Line # '//trim(num2lstr(LineNum))//': "'//trim(FileInfo%Lines(LineNum))//'".' + RETURN + END IF + + !IF ( PRESENT(UnEc) ) THEN + ! IF ( UnEc > 0 ) WRITE (UnEc,Ec_StrFrmt) OutLine, "List of user-requested output channels", '"OutList"' + !END IF + + LineNum = LineNum + 1 + EndOfFile = OutLine(1:3) ! EndOfFile is the 1st 3 characters of OutLine CALL Conv2UC( EndOfFile ) ! Convert EndOfFile to upper case IF ( EndOfFile == 'END' ) THEN - LineNum = LineNum + 1 EXIT ! End of OutList has been reached; therefore, exit this DO ENDIF - ! Check if we have a quoted string at the begining. Ignore anything outside the quotes if so (this is the ReadVar behaviour for quoted strings). - if (SCAN(OutLine(1:1), '''"' ) == 1_IntKi ) then - QuoteCh = SCAN( OutLine(2:), '''"' ) ! last quote - if (QuoteCh < 1) QuoteCh = LEN_TRIM(OutLine) ! in case no end quote - OutLine(QuoteCh+2:) = ' ' ! blank out everything after last quote - endif - NumWords = CountWords( OutLine ) ! The number of words in OutLine. AryLenRead = AryLenRead + NumWords ! The total number of output channels read in so far. @@ -5810,9 +5901,10 @@ SUBROUTINE ReadOutputListFromFileInfo ( FileInfo, LineNum, CharAry, AryLenRead, IF ( AryLenRead > MaxAryLen ) THEN - ErrStat = ErrID_Fatal + ErrStat = ErrID_Severe ErrMsg = 'ReadOutputList:The maximum number of output channels allowed is '//TRIM( Int2LStr(MaxAryLen) )//'.' - RETURN + AryLenRead = AryLenRead - NumWords ! The total number of output channels read in so far. +! RETURN ! finish processing the OutList variable before returning ELSE @@ -5820,7 +5912,6 @@ SUBROUTINE ReadOutputListFromFileInfo ( FileInfo, LineNum, CharAry, AryLenRead, END IF - LineNum = LineNum+1 if (LineNum > FileInfo%NumLines) exit ! Don't overrun end of file in case no END found @@ -6018,6 +6109,138 @@ SUBROUTINE ReadR8AryFromStr ( Str, Ary, AryLen, AryName, AryDescr, ErrStat, ErrM END IF RETURN END SUBROUTINE ReadR8AryFromStr + +!======================================================================= +!> This routine reads a AryLen values separated by whitespace (or other Fortran record delimiters such as commas) +!! into an array (either on same line or multiple lines), or sets default values. +!! Use ReadAryWDefault (nwtc_io::readarywdefault) instead of directly calling a specific routine in the generic interface. +subroutine ReadR4AryWDefault ( UnIn, Fil, Ary, AryLen, AryName, AryDescr, AryDefault, ErrStat, ErrMsg, UnEc ) + ! This routine reads a AryLen values into a 4-byte real array separated by white space, or sets to default + integer, intent(in ) :: UnIn ! I/O unit for input file. + character(*), intent(in ) :: Fil ! Name of the input file. + integer, intent(in ) :: AryLen ! Length of the array. + real(R4Ki), intent(inout) :: Ary(AryLen) ! Real array being read. + character(*), intent(in ) :: AryName ! Text string containing the variable name. + character(*), intent(in ) :: AryDescr ! Text string describing the variable. + real(R4Ki), intent(in ) :: AryDefault(AryLen) ! Default value for variable being read + integer, intent( out) :: ErrStat ! Error status + character(*), intent( out) :: ErrMsg ! Error message + integer, intent(in ), optional :: UnEc ! I/O unit for echo file. If present and > 0, write to UnEc + + integer :: Ind ! Index into the string array. Assumed to be one digit. + integer :: IOS ! I/O status returned from the read statement. + character(30) :: Word(AryLen) ! String to hold the words on the line. + character(2048) :: Line ! The contents of a line returned from ReadLine() with comment removed. + integer :: LineLen ! Length of line read in + + call ReadLine( UnIn, CommChars, Line, LineLen, IOS ) ! Reads a line. Returns what is before the first comment character. + call CheckIOS( IOS, Fil, trim(AryName), StrType, ErrStat, ErrMsg ) ! Assume `default` is most likely + if (ErrStat >= AbortErrLev) return + + ! check for default + call GetWords(Line, Word(1), 1) + call Conv2UC( Word(1) ) + + if ( index(Word(1), "DEFAULT" ) /= 1 ) then ! If it's not "default", read this variable; otherwise use the DEFAULT value + + ! Values exist, so reread line into AryLen of words + call GetWords( Line, Word(AryLen), AryLen) + + ! read the first AryLen numbers from the line + read (Line,*,iostat=IOS) ( Ary(Ind), Ind=1,AryLen ) + + ! Check if there was an error + call CheckIOS ( IOS, Fil, trim( AryName ), NumType, ErrStat, ErrMsg ) + if (ErrStat >= AbortErrLev) return + + do Ind=1,AryLen + call CheckRealVar( Ary(Ind), AryName, ErrStat, ErrMsg) + if (ErrStat >= AbortErrLev) return + end do + + if ( present(UnEc) ) then + if ( UnEc > 0 ) then + write(UnEc, Ec_ReAryFrmt) trim(AryName), AryDescr, Ary(1:min(AryLen,NWTC_MaxAryLen)) + end if + end if + + else + ! Set default + Ary = AryDefault + if ( present(UnEc) ) then + if ( UnEc > 0 ) then + write(UnEc, Ec_ReAryFrmt) trim(AryName), trim(AryDescr)//' (set to default)', Ary(1:min(AryLen,NWTC_MaxAryLen)) + endif + endif + endif + + return +end subroutine ReadR4AryWDefault +!======================================================================= +!> \copydoc nwtc_io::readr4arywdefault +subroutine ReadR8AryWDefault ( UnIn, Fil, Ary, AryLen, AryName, AryDescr, AryDefault, ErrStat, ErrMsg, UnEc ) + ! This routine reads a AryLen values into a 8-byte real array separated by white space, or sets to default + integer, intent(in ) :: UnIn ! I/O unit for input file. + character(*), intent(in ) :: Fil ! Name of the input file. + integer, intent(in ) :: AryLen ! Length of the array. + real(R8Ki), intent(inout) :: Ary(AryLen) ! Real array being read. + character(*), intent(in ) :: AryDescr ! Text string describing the variable. + character(*), intent(in ) :: AryName ! Text string containing the variable name. + real(R8Ki), intent(in ) :: AryDefault(AryLen) ! Default value for variable being read + integer, intent( out) :: ErrStat ! Error status + character(*), intent( out) :: ErrMsg ! Error message + integer, intent(in ), optional :: UnEc ! I/O unit for echo file. If present and > 0, write to UnEc + + integer :: Ind ! Index into the string array. Assumed to be one digit. + integer :: IOS ! I/O status returned from the read statement. + character(30) :: Word(AryLen) ! String to hold the words on the line. + character(2048) :: Line ! The contents of a line returned from ReadLine() with comment removed. + integer :: LineLen ! Length of line read in + + call ReadLine( UnIn, CommChars, Line, LineLen, IOS ) ! Reads a line. Returns what is before the first comment character. + call CheckIOS( IOS, Fil, trim(AryName), StrType, ErrStat, ErrMsg ) ! Assume `default` is most likely + if (ErrStat >= AbortErrLev) return + + ! check for default + call GetWords(Line, Word(1), 1) + call Conv2UC( Word(1) ) + + if ( index(Word(1), "DEFAULT" ) /= 1 ) then ! If it's not "default", read this variable; otherwise use the DEFAULT value + + ! Values exist, so reread line into AryLen of words + call GetWords( Line, Word(AryLen), AryLen) + + ! read the first AryLen numbers from the line + read (Line,*,iostat=IOS) ( Ary(Ind), Ind=1,AryLen ) + + ! Check if there was an error + call CheckIOS ( IOS, Fil, trim( AryName ), NumType, ErrStat, ErrMsg ) + if (ErrStat >= AbortErrLev) return + + do Ind=1,AryLen + call CheckRealVar( Ary(Ind), AryName, ErrStat, ErrMsg) + if (ErrStat >= AbortErrLev) return + end do + + if ( present(UnEc) ) then + if ( UnEc > 0 ) then + write(UnEc, Ec_ReAryFrmt) trim(AryName), AryDescr, Ary(1:min(AryLen,NWTC_MaxAryLen)) + end if + end if + + else + ! Set default + Ary = AryDefault + if ( present(UnEc) ) then + if ( UnEc > 0 ) then + write(UnEc, Ec_ReAryFrmt) trim(AryName), trim(AryDescr)//' (set to default)', Ary(1:min(AryLen,NWTC_MaxAryLen)) + endif + endif + endif + + return +end subroutine ReadR8AryWDefault + !======================================================================= !> \copydoc nwtc_io::readcarylines SUBROUTINE ReadR4AryLines ( UnIn, Fil, Ary, AryLen, AryName, AryDescr, ErrStat, ErrMsg, UnEc ) @@ -6146,7 +6369,6 @@ SUBROUTINE ReadR4Var ( UnIn, Fil, Var, VarName, VarDescr, ErrStat, ErrMsg, UnEc CALL ReadNum ( UnIn, Fil, Word, VarName, ErrStat, ErrMsg ) IF ( ErrStat >= AbortErrLev) RETURN ! If we're about to read a T/F and treat it as a number, we have a less severe ErrStat - READ (Word,*,IOSTAT=IOS) Var CALL CheckIOS ( IOS, Fil, VarName, NumType, ErrStat, ErrMsg ) @@ -6321,7 +6543,6 @@ SUBROUTINE ReadIAryWDefault ( UnIn, Fil, Var, AryLen, VarName, VarDescr, VarDefa 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. CHARACTER(1024) :: sVar ! String to hold the value of the variable ! Read full content of variable as one string, should it be "default", or an array CALL ReadVar (UnIn, Fil, sVar, VarName, VarDescr, ErrStat, ErrMsg, UnEc) @@ -7703,5 +7924,91 @@ SUBROUTINE WrScr1 ( Str ) RETURN END SUBROUTINE WrScr1 + !---------------------------------------------------------------------------------------------------------------------------------- + !> Read a delimited file of float with one or multiple lines of header + !! TODO: put me in a CSV.f90 file of the NWTC library + !! TODO: automatic detection of number of columns for instance using ReadCAryFromStr + !! See also the quick and dirty check introduced to read blade files that don't have Buoyancy columns + subroutine ReadDelimFile(Filename, nCol, array, errStat, errMsg, nHeaderLines, priPath) + character(len=*), intent(in) :: Filename + integer(IntKi), intent(in) :: nCol + real(ReKi), dimension(:,:), allocatable, intent(out) :: array + integer(IntKi) , intent(out) :: errStat ! Status of error message + character(*) , intent(out) :: errMsg ! Error message if errStat /= ErrID_None + integer(IntKi), optional, intent(in ) :: nHeaderLines + character(*) , optional, intent(in ) :: priPath ! Primary path, to use if filename is not absolute + integer(IntKi) :: UnIn, i, j, nLine, nHead + character(len= 2048) :: line + integer(IntKi) :: errStat2 ! local status of error message + character(ErrMsgLen) :: errMsg2 ! temporary Error message + character(len=2048) :: Filename_Loc ! filename local to this function + errStat = ErrID_None + errMsg = "" + + Filename_Loc = Filename + if (present(priPath)) then + if (PathIsRelative(Filename_Loc)) Filename_Loc = trim(PriPath)//trim(Filename) + endif + + ! Open file + call GetNewUnit(UnIn) + call OpenFInpFile(UnIn, Filename_Loc, errStat2, errMsg2); if(Failed()) return + ! Count number of lines + nLine = line_count(UnIn, errStat2, errMsg2); if(Failed()) return + if (allocated(array)) deallocate(array) + allocate(array(nLine-1, nCol), stat=errStat2); errMsg2='allocation failed'; if(Failed())return + ! Read header + nHead=1 + if (present(nHeaderLines)) nHead = nHeaderLines + do i=1,nHead + read(UnIn, *, IOSTAT=errStat2) line + errMsg2 = ' Error reading line '//trim(Num2LStr(1))//' of file: '//trim(Filename_Loc) + if(Failed()) return + enddo + ! Read data + do i = 1,nLine-1 + read (UnIn,*,IOSTAT=errStat2) (array(i,j), j=1,nCol) + errMsg2 = ' Error reading line '//trim(Num2LStr(i+1))//' of file: '//trim(Filename_Loc) + if(Failed()) return + end do + close(UnIn) + contains + logical function Failed() + CALL SetErrStat(errStat2, errMsg2, errStat, errMsg, 'ReadDelimFile' ) + Failed = errStat >= AbortErrLev + if (Failed) then + if ((UnIn)>0) close(UnIn) + endif + end function Failed + end subroutine ReadDelimFile + + !---------------------------------------------------------------------------------------------------------------------------------- + !> Counts number of lines in a file, do not count last line if empty + integer function line_count(iUnit, errStat, errMsg) + integer(IntKi), intent(in) :: iUnit + integer(IntKi), intent(out) :: errStat ! Error status + character(*), intent(out) :: errMsg ! Error message associated with ErrStat + character(len=2048) :: line + integer, parameter :: nline_max=100000000 ! 100 M safety for infinite loop.. + integer :: i + errStat = ErrID_None + errMsg = '' + line_count=0 + do i=1,nline_max + line='' + read(iUnit,'(A)',END=100)line + line_count=line_count+1 + enddo + if (line_count==nline_max) then + errStat = ErrID_Fatal + errMsg = 'Error: maximum number of line exceeded for line_count' + return + endif + 100 if(len(trim(line))>0) then + line_count=line_count+1 + endif + rewind(iUnit) + return + end function line_count END MODULE NWTC_IO diff --git a/modules/nwtc-library/src/NWTC_Library.f90 b/modules/nwtc-library/src/NWTC_Library.f90 index 77d1388f8c..e9c944c128 100644 --- a/modules/nwtc-library/src/NWTC_Library.f90 +++ b/modules/nwtc-library/src/NWTC_Library.f90 @@ -29,6 +29,7 @@ MODULE NWTC_Library ! NWTC_Library.f90 ! NWTC_Library_Types.f90 ! NWTC_Num.f90 + ! NWTC_Str.f90 ! ModMesh.f90 ! ModMesh_Types.f90 ! @@ -51,6 +52,7 @@ MODULE NWTC_Library ! NWTC_Library_Types.f90 ! NWTC_IO.f90 ! NWTC_Num.f90 + ! NWTC_Str.f90 ! ModMesh_Types.f90 ! ModMesh.f90 ! ModMesh_Mapping.f90 (remove if compiling with -DNO_MESHMAPPING) @@ -73,7 +75,9 @@ MODULE NWTC_Library USE NWTC_Library_Types USE NWTC_Num ! technically we don't need to specify this if we have ModMesh (because ModMesh USEs NWTC_Num) + USE NWTC_Str ! String utils USE ModMesh + USE ModReg #ifndef NO_MESHMAPPING ! Note that ModMesh_Mapping also includes LAPACK routines @@ -81,6 +85,11 @@ MODULE NWTC_Library #endif IMPLICIT NONE + + INTEGER, PARAMETER ::MHK_None = 0 + INTEGER, PARAMETER ::MHK_FixedBottom = 1 + INTEGER, PARAMETER ::MHK_Floating = 2 + CONTAINS diff --git a/modules/nwtc-library/src/NWTC_Library_IncSubs.f90 b/modules/nwtc-library/src/NWTC_Library_IncSubs.f90 new file mode 100644 index 0000000000..b289850916 --- /dev/null +++ b/modules/nwtc-library/src/NWTC_Library_IncSubs.f90 @@ -0,0 +1,577 @@ +!STARTOFREGISTRYGENERATEDFILE 'NWTC_Library_Subs.f90' +! +! WARNING This file is generated automatically by the FAST registry. +! Do not edit. Your changes to this file will be lost. +! +! FAST Registry' + +subroutine NWTC_Library_CopyMapType(SrcMapTypeData, DstMapTypeData, CtrlCode, ErrStat, ErrMsg) + type(MapType), intent(in) :: SrcMapTypeData + type(MapType), intent(inout) :: DstMapTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'NWTC_Library_CopyMapType' + ErrStat = ErrID_None + ErrMsg = '' + DstMapTypeData%OtherMesh_Element = SrcMapTypeData%OtherMesh_Element + DstMapTypeData%distance = SrcMapTypeData%distance + DstMapTypeData%couple_arm = SrcMapTypeData%couple_arm + DstMapTypeData%shape_fn = SrcMapTypeData%shape_fn +end subroutine + +subroutine NWTC_Library_DestroyMapType(MapTypeData, ErrStat, ErrMsg) + type(MapType), intent(inout) :: MapTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'NWTC_Library_DestroyMapType' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine NWTC_Library_PackMapType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(MapType), intent(in) :: InData + character(*), parameter :: RoutineName = 'NWTC_Library_PackMapType' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%OtherMesh_Element) + call RegPack(RF, InData%distance) + call RegPack(RF, InData%couple_arm) + call RegPack(RF, InData%shape_fn) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine NWTC_Library_UnPackMapType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(MapType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'NWTC_Library_UnPackMapType' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%OtherMesh_Element); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%distance); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%couple_arm); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%shape_fn); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine NWTC_Library_CopyMeshMapLinearizationType(SrcMeshMapLinearizationTypeData, DstMeshMapLinearizationTypeData, CtrlCode, ErrStat, ErrMsg) + type(MeshMapLinearizationType), intent(in) :: SrcMeshMapLinearizationTypeData + type(MeshMapLinearizationType), intent(inout) :: DstMeshMapLinearizationTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'NWTC_Library_CopyMeshMapLinearizationType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcMeshMapLinearizationTypeData%mi)) then + LB(1:2) = lbound(SrcMeshMapLinearizationTypeData%mi) + UB(1:2) = ubound(SrcMeshMapLinearizationTypeData%mi) + if (.not. allocated(DstMeshMapLinearizationTypeData%mi)) then + allocate(DstMeshMapLinearizationTypeData%mi(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapLinearizationTypeData%mi.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMeshMapLinearizationTypeData%mi = SrcMeshMapLinearizationTypeData%mi + end if + if (allocated(SrcMeshMapLinearizationTypeData%fx_p)) then + LB(1:2) = lbound(SrcMeshMapLinearizationTypeData%fx_p) + UB(1:2) = ubound(SrcMeshMapLinearizationTypeData%fx_p) + if (.not. allocated(DstMeshMapLinearizationTypeData%fx_p)) then + allocate(DstMeshMapLinearizationTypeData%fx_p(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapLinearizationTypeData%fx_p.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMeshMapLinearizationTypeData%fx_p = SrcMeshMapLinearizationTypeData%fx_p + end if + if (allocated(SrcMeshMapLinearizationTypeData%tv_uD)) then + LB(1:2) = lbound(SrcMeshMapLinearizationTypeData%tv_uD) + UB(1:2) = ubound(SrcMeshMapLinearizationTypeData%tv_uD) + if (.not. allocated(DstMeshMapLinearizationTypeData%tv_uD)) then + allocate(DstMeshMapLinearizationTypeData%tv_uD(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapLinearizationTypeData%tv_uD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMeshMapLinearizationTypeData%tv_uD = SrcMeshMapLinearizationTypeData%tv_uD + end if + if (allocated(SrcMeshMapLinearizationTypeData%tv_uS)) then + LB(1:2) = lbound(SrcMeshMapLinearizationTypeData%tv_uS) + UB(1:2) = ubound(SrcMeshMapLinearizationTypeData%tv_uS) + if (.not. allocated(DstMeshMapLinearizationTypeData%tv_uS)) then + allocate(DstMeshMapLinearizationTypeData%tv_uS(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapLinearizationTypeData%tv_uS.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMeshMapLinearizationTypeData%tv_uS = SrcMeshMapLinearizationTypeData%tv_uS + end if + if (allocated(SrcMeshMapLinearizationTypeData%ta_uD)) then + LB(1:2) = lbound(SrcMeshMapLinearizationTypeData%ta_uD) + UB(1:2) = ubound(SrcMeshMapLinearizationTypeData%ta_uD) + if (.not. allocated(DstMeshMapLinearizationTypeData%ta_uD)) then + allocate(DstMeshMapLinearizationTypeData%ta_uD(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapLinearizationTypeData%ta_uD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMeshMapLinearizationTypeData%ta_uD = SrcMeshMapLinearizationTypeData%ta_uD + end if + if (allocated(SrcMeshMapLinearizationTypeData%ta_uS)) then + LB(1:2) = lbound(SrcMeshMapLinearizationTypeData%ta_uS) + UB(1:2) = ubound(SrcMeshMapLinearizationTypeData%ta_uS) + if (.not. allocated(DstMeshMapLinearizationTypeData%ta_uS)) then + allocate(DstMeshMapLinearizationTypeData%ta_uS(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapLinearizationTypeData%ta_uS.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMeshMapLinearizationTypeData%ta_uS = SrcMeshMapLinearizationTypeData%ta_uS + end if + if (allocated(SrcMeshMapLinearizationTypeData%ta_rv)) then + LB(1:2) = lbound(SrcMeshMapLinearizationTypeData%ta_rv) + UB(1:2) = ubound(SrcMeshMapLinearizationTypeData%ta_rv) + if (.not. allocated(DstMeshMapLinearizationTypeData%ta_rv)) then + allocate(DstMeshMapLinearizationTypeData%ta_rv(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapLinearizationTypeData%ta_rv.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMeshMapLinearizationTypeData%ta_rv = SrcMeshMapLinearizationTypeData%ta_rv + end if + if (allocated(SrcMeshMapLinearizationTypeData%li)) then + LB(1:2) = lbound(SrcMeshMapLinearizationTypeData%li) + UB(1:2) = ubound(SrcMeshMapLinearizationTypeData%li) + if (.not. allocated(DstMeshMapLinearizationTypeData%li)) then + allocate(DstMeshMapLinearizationTypeData%li(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapLinearizationTypeData%li.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMeshMapLinearizationTypeData%li = SrcMeshMapLinearizationTypeData%li + end if + if (allocated(SrcMeshMapLinearizationTypeData%M_uS)) then + LB(1:2) = lbound(SrcMeshMapLinearizationTypeData%M_uS) + UB(1:2) = ubound(SrcMeshMapLinearizationTypeData%M_uS) + if (.not. allocated(DstMeshMapLinearizationTypeData%M_uS)) then + allocate(DstMeshMapLinearizationTypeData%M_uS(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapLinearizationTypeData%M_uS.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMeshMapLinearizationTypeData%M_uS = SrcMeshMapLinearizationTypeData%M_uS + end if + if (allocated(SrcMeshMapLinearizationTypeData%M_uD)) then + LB(1:2) = lbound(SrcMeshMapLinearizationTypeData%M_uD) + UB(1:2) = ubound(SrcMeshMapLinearizationTypeData%M_uD) + if (.not. allocated(DstMeshMapLinearizationTypeData%M_uD)) then + allocate(DstMeshMapLinearizationTypeData%M_uD(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapLinearizationTypeData%M_uD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMeshMapLinearizationTypeData%M_uD = SrcMeshMapLinearizationTypeData%M_uD + end if + if (allocated(SrcMeshMapLinearizationTypeData%M_f)) then + LB(1:2) = lbound(SrcMeshMapLinearizationTypeData%M_f) + UB(1:2) = ubound(SrcMeshMapLinearizationTypeData%M_f) + if (.not. allocated(DstMeshMapLinearizationTypeData%M_f)) then + allocate(DstMeshMapLinearizationTypeData%M_f(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapLinearizationTypeData%M_f.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMeshMapLinearizationTypeData%M_f = SrcMeshMapLinearizationTypeData%M_f + end if +end subroutine + +subroutine NWTC_Library_DestroyMeshMapLinearizationType(MeshMapLinearizationTypeData, ErrStat, ErrMsg) + type(MeshMapLinearizationType), intent(inout) :: MeshMapLinearizationTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'NWTC_Library_DestroyMeshMapLinearizationType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(MeshMapLinearizationTypeData%mi)) then + deallocate(MeshMapLinearizationTypeData%mi) + end if + if (allocated(MeshMapLinearizationTypeData%fx_p)) then + deallocate(MeshMapLinearizationTypeData%fx_p) + end if + if (allocated(MeshMapLinearizationTypeData%tv_uD)) then + deallocate(MeshMapLinearizationTypeData%tv_uD) + end if + if (allocated(MeshMapLinearizationTypeData%tv_uS)) then + deallocate(MeshMapLinearizationTypeData%tv_uS) + end if + if (allocated(MeshMapLinearizationTypeData%ta_uD)) then + deallocate(MeshMapLinearizationTypeData%ta_uD) + end if + if (allocated(MeshMapLinearizationTypeData%ta_uS)) then + deallocate(MeshMapLinearizationTypeData%ta_uS) + end if + if (allocated(MeshMapLinearizationTypeData%ta_rv)) then + deallocate(MeshMapLinearizationTypeData%ta_rv) + end if + if (allocated(MeshMapLinearizationTypeData%li)) then + deallocate(MeshMapLinearizationTypeData%li) + end if + if (allocated(MeshMapLinearizationTypeData%M_uS)) then + deallocate(MeshMapLinearizationTypeData%M_uS) + end if + if (allocated(MeshMapLinearizationTypeData%M_uD)) then + deallocate(MeshMapLinearizationTypeData%M_uD) + end if + if (allocated(MeshMapLinearizationTypeData%M_f)) then + deallocate(MeshMapLinearizationTypeData%M_f) + end if +end subroutine + +subroutine NWTC_Library_PackMeshMapLinearizationType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(MeshMapLinearizationType), intent(in) :: InData + character(*), parameter :: RoutineName = 'NWTC_Library_PackMeshMapLinearizationType' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%mi) + call RegPackAlloc(RF, InData%fx_p) + call RegPackAlloc(RF, InData%tv_uD) + call RegPackAlloc(RF, InData%tv_uS) + call RegPackAlloc(RF, InData%ta_uD) + call RegPackAlloc(RF, InData%ta_uS) + call RegPackAlloc(RF, InData%ta_rv) + call RegPackAlloc(RF, InData%li) + call RegPackAlloc(RF, InData%M_uS) + call RegPackAlloc(RF, InData%M_uD) + call RegPackAlloc(RF, InData%M_f) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine NWTC_Library_UnPackMeshMapLinearizationType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(MeshMapLinearizationType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'NWTC_Library_UnPackMeshMapLinearizationType' + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%mi); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%fx_p); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%tv_uD); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%tv_uS); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ta_uD); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ta_uS); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ta_rv); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%li); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%M_uS); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%M_uD); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%M_f); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine NWTC_Library_CopyMeshMapType(SrcMeshMapTypeData, DstMeshMapTypeData, CtrlCode, ErrStat, ErrMsg) + type(MeshMapType), intent(inout) :: SrcMeshMapTypeData + type(MeshMapType), intent(inout) :: DstMeshMapTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'NWTC_Library_CopyMeshMapType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcMeshMapTypeData%MapLoads)) then + LB(1:1) = lbound(SrcMeshMapTypeData%MapLoads) + UB(1:1) = ubound(SrcMeshMapTypeData%MapLoads) + if (.not. allocated(DstMeshMapTypeData%MapLoads)) then + allocate(DstMeshMapTypeData%MapLoads(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapTypeData%MapLoads.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMapType(SrcMeshMapTypeData%MapLoads(i1), DstMeshMapTypeData%MapLoads(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcMeshMapTypeData%MapMotions)) then + LB(1:1) = lbound(SrcMeshMapTypeData%MapMotions) + UB(1:1) = ubound(SrcMeshMapTypeData%MapMotions) + if (.not. allocated(DstMeshMapTypeData%MapMotions)) then + allocate(DstMeshMapTypeData%MapMotions(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapTypeData%MapMotions.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMapType(SrcMeshMapTypeData%MapMotions(i1), DstMeshMapTypeData%MapMotions(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcMeshMapTypeData%MapSrcToAugmt)) then + LB(1:1) = lbound(SrcMeshMapTypeData%MapSrcToAugmt) + UB(1:1) = ubound(SrcMeshMapTypeData%MapSrcToAugmt) + if (.not. allocated(DstMeshMapTypeData%MapSrcToAugmt)) then + allocate(DstMeshMapTypeData%MapSrcToAugmt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapTypeData%MapSrcToAugmt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMapType(SrcMeshMapTypeData%MapSrcToAugmt(i1), DstMeshMapTypeData%MapSrcToAugmt(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call MeshCopy(SrcMeshMapTypeData%Augmented_Ln2_Src, DstMeshMapTypeData%Augmented_Ln2_Src, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcMeshMapTypeData%Lumped_Points_Src, DstMeshMapTypeData%Lumped_Points_Src, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcMeshMapTypeData%LoadLn2_A_Mat_Piv)) then + LB(1:1) = lbound(SrcMeshMapTypeData%LoadLn2_A_Mat_Piv) + UB(1:1) = ubound(SrcMeshMapTypeData%LoadLn2_A_Mat_Piv) + if (.not. allocated(DstMeshMapTypeData%LoadLn2_A_Mat_Piv)) then + allocate(DstMeshMapTypeData%LoadLn2_A_Mat_Piv(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapTypeData%LoadLn2_A_Mat_Piv.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMeshMapTypeData%LoadLn2_A_Mat_Piv = SrcMeshMapTypeData%LoadLn2_A_Mat_Piv + end if + if (allocated(SrcMeshMapTypeData%DisplacedPosition)) then + LB(1:3) = lbound(SrcMeshMapTypeData%DisplacedPosition) + UB(1:3) = ubound(SrcMeshMapTypeData%DisplacedPosition) + if (.not. allocated(DstMeshMapTypeData%DisplacedPosition)) then + allocate(DstMeshMapTypeData%DisplacedPosition(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapTypeData%DisplacedPosition.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMeshMapTypeData%DisplacedPosition = SrcMeshMapTypeData%DisplacedPosition + end if + if (allocated(SrcMeshMapTypeData%LoadLn2_A_Mat)) then + LB(1:2) = lbound(SrcMeshMapTypeData%LoadLn2_A_Mat) + UB(1:2) = ubound(SrcMeshMapTypeData%LoadLn2_A_Mat) + if (.not. allocated(DstMeshMapTypeData%LoadLn2_A_Mat)) then + allocate(DstMeshMapTypeData%LoadLn2_A_Mat(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapTypeData%LoadLn2_A_Mat.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMeshMapTypeData%LoadLn2_A_Mat = SrcMeshMapTypeData%LoadLn2_A_Mat + end if + if (allocated(SrcMeshMapTypeData%LoadLn2_F)) then + LB(1:2) = lbound(SrcMeshMapTypeData%LoadLn2_F) + UB(1:2) = ubound(SrcMeshMapTypeData%LoadLn2_F) + if (.not. allocated(DstMeshMapTypeData%LoadLn2_F)) then + allocate(DstMeshMapTypeData%LoadLn2_F(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapTypeData%LoadLn2_F.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMeshMapTypeData%LoadLn2_F = SrcMeshMapTypeData%LoadLn2_F + end if + if (allocated(SrcMeshMapTypeData%LoadLn2_M)) then + LB(1:2) = lbound(SrcMeshMapTypeData%LoadLn2_M) + UB(1:2) = ubound(SrcMeshMapTypeData%LoadLn2_M) + if (.not. allocated(DstMeshMapTypeData%LoadLn2_M)) then + allocate(DstMeshMapTypeData%LoadLn2_M(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapTypeData%LoadLn2_M.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMeshMapTypeData%LoadLn2_M = SrcMeshMapTypeData%LoadLn2_M + end if + call NWTC_Library_CopyMeshMapLinearizationType(SrcMeshMapTypeData%dM, DstMeshMapTypeData%dM, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine NWTC_Library_DestroyMeshMapType(MeshMapTypeData, ErrStat, ErrMsg) + type(MeshMapType), intent(inout) :: MeshMapTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'NWTC_Library_DestroyMeshMapType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(MeshMapTypeData%MapLoads)) then + LB(1:1) = lbound(MeshMapTypeData%MapLoads) + UB(1:1) = ubound(MeshMapTypeData%MapLoads) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMapType(MeshMapTypeData%MapLoads(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MeshMapTypeData%MapLoads) + end if + if (allocated(MeshMapTypeData%MapMotions)) then + LB(1:1) = lbound(MeshMapTypeData%MapMotions) + UB(1:1) = ubound(MeshMapTypeData%MapMotions) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMapType(MeshMapTypeData%MapMotions(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MeshMapTypeData%MapMotions) + end if + if (allocated(MeshMapTypeData%MapSrcToAugmt)) then + LB(1:1) = lbound(MeshMapTypeData%MapSrcToAugmt) + UB(1:1) = ubound(MeshMapTypeData%MapSrcToAugmt) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMapType(MeshMapTypeData%MapSrcToAugmt(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MeshMapTypeData%MapSrcToAugmt) + end if + call MeshDestroy( MeshMapTypeData%Augmented_Ln2_Src, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( MeshMapTypeData%Lumped_Points_Src, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(MeshMapTypeData%LoadLn2_A_Mat_Piv)) then + deallocate(MeshMapTypeData%LoadLn2_A_Mat_Piv) + end if + if (allocated(MeshMapTypeData%DisplacedPosition)) then + deallocate(MeshMapTypeData%DisplacedPosition) + end if + if (allocated(MeshMapTypeData%LoadLn2_A_Mat)) then + deallocate(MeshMapTypeData%LoadLn2_A_Mat) + end if + if (allocated(MeshMapTypeData%LoadLn2_F)) then + deallocate(MeshMapTypeData%LoadLn2_F) + end if + if (allocated(MeshMapTypeData%LoadLn2_M)) then + deallocate(MeshMapTypeData%LoadLn2_M) + end if + call NWTC_Library_DestroyMeshMapLinearizationType(MeshMapTypeData%dM, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine NWTC_Library_PackMeshMapType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(MeshMapType), intent(in) :: InData + character(*), parameter :: RoutineName = 'NWTC_Library_PackMeshMapType' + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%MapLoads)) + if (allocated(InData%MapLoads)) then + call RegPackBounds(RF, 1, lbound(InData%MapLoads), ubound(InData%MapLoads)) + LB(1:1) = lbound(InData%MapLoads) + UB(1:1) = ubound(InData%MapLoads) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMapType(RF, InData%MapLoads(i1)) + end do + end if + call RegPack(RF, allocated(InData%MapMotions)) + if (allocated(InData%MapMotions)) then + call RegPackBounds(RF, 1, lbound(InData%MapMotions), ubound(InData%MapMotions)) + LB(1:1) = lbound(InData%MapMotions) + UB(1:1) = ubound(InData%MapMotions) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMapType(RF, InData%MapMotions(i1)) + end do + end if + call RegPack(RF, allocated(InData%MapSrcToAugmt)) + if (allocated(InData%MapSrcToAugmt)) then + call RegPackBounds(RF, 1, lbound(InData%MapSrcToAugmt), ubound(InData%MapSrcToAugmt)) + LB(1:1) = lbound(InData%MapSrcToAugmt) + UB(1:1) = ubound(InData%MapSrcToAugmt) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMapType(RF, InData%MapSrcToAugmt(i1)) + end do + end if + call MeshPack(RF, InData%Augmented_Ln2_Src) + call MeshPack(RF, InData%Lumped_Points_Src) + call RegPackAlloc(RF, InData%LoadLn2_A_Mat_Piv) + call RegPackAlloc(RF, InData%DisplacedPosition) + call RegPackAlloc(RF, InData%LoadLn2_A_Mat) + call RegPackAlloc(RF, InData%LoadLn2_F) + call RegPackAlloc(RF, InData%LoadLn2_M) + call NWTC_Library_PackMeshMapLinearizationType(RF, InData%dM) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine NWTC_Library_UnPackMeshMapType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(MeshMapType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'NWTC_Library_UnPackMeshMapType' + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + if (allocated(OutData%MapLoads)) deallocate(OutData%MapLoads) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%MapLoads(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MapLoads.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMapType(RF, OutData%MapLoads(i1)) ! MapLoads + end do + end if + if (allocated(OutData%MapMotions)) deallocate(OutData%MapMotions) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%MapMotions(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MapMotions.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMapType(RF, OutData%MapMotions(i1)) ! MapMotions + end do + end if + if (allocated(OutData%MapSrcToAugmt)) deallocate(OutData%MapSrcToAugmt) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%MapSrcToAugmt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MapSrcToAugmt.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMapType(RF, OutData%MapSrcToAugmt(i1)) ! MapSrcToAugmt + end do + end if + call MeshUnpack(RF, OutData%Augmented_Ln2_Src) ! Augmented_Ln2_Src + call MeshUnpack(RF, OutData%Lumped_Points_Src) ! Lumped_Points_Src + call RegUnpackAlloc(RF, OutData%LoadLn2_A_Mat_Piv); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%DisplacedPosition); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LoadLn2_A_Mat); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LoadLn2_F); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LoadLn2_M); if (RegCheckErr(RF, RoutineName)) return + call NWTC_Library_UnpackMeshMapLinearizationType(RF, OutData%dM) ! dM +end subroutine +!ENDOFREGISTRYGENERATEDFILE diff --git a/modules/nwtc-library/src/NWTC_Library_Types.f90 b/modules/nwtc-library/src/NWTC_Library_Types.f90 index ebe2e74a6c..4ae45e08b4 100644 --- a/modules/nwtc-library/src/NWTC_Library_Types.f90 +++ b/modules/nwtc-library/src/NWTC_Library_Types.f90 @@ -24,14 +24,37 @@ ! limitations under the License. ! ! -! bjj: modifications made +! 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 NWTC_Library. 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 NWTC_Library_Types !--------------------------------------------------------------------------------------------------------------------------------- USE SysSubs +USE ModReg IMPLICIT NONE + INTEGER(IntKi), PUBLIC, PARAMETER :: VarNameLen = 64 ! [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_Force = 1 ! [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_Moment = 2 ! [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_Orientation = 3 ! [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_TransDisp = 4 ! [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_AngularDisp = 5 ! [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_TransVel = 6 ! [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_AngularVel = 7 ! [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_TransAcc = 8 ! [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_AngularAcc = 9 ! [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_Scalar = 10 ! [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_None = 0 ! Variable with no flags [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_Mesh = 1 ! Variable contained in mesh [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_Line = 2 ! Variable is for a line mesh [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_RotFrame = 4 ! Variable in rotating frame [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_Ext = 8 ! Variable for extended linearization [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_Any = 4095 ! Enable all flags (used for filtering) [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VC_None = 0 ! [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VC_Tight = 1 ! [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VC_Option1 = 2 ! [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VC_Option2 = 3 ! [-] ! ========= ProgDesc ======= TYPE, PUBLIC :: ProgDesc CHARACTER(99) :: Name !< Name of the program or module [-] @@ -43,9 +66,9 @@ MODULE NWTC_Library_Types TYPE, PUBLIC :: FASTdataType CHARACTER(1024) :: File !< Name of the FAST-style binary file [-] CHARACTER(1024) :: Descr !< String describing file [-] - INTEGER(IntKi) :: NumChans !< Number of output channels in this binary file (not including the time channel) [-] - INTEGER(IntKi) :: NumRecs !< Number of records (rows) of data in the file [-] - REAL(DbKi) :: TimeStep !< Time step for evenly-spaced data in the output file (when NumRecs is not allo [-] + INTEGER(IntKi) :: NumChans = 0_IntKi !< Number of output channels in this binary file (not including the time channel) [-] + INTEGER(IntKi) :: NumRecs = 0_IntKi !< Number of records (rows) of data in the file [-] + REAL(DbKi) :: TimeStep = 0.0_R8Ki !< Time step for evenly-spaced data in the output file (when NumRecs is not allo [-] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: ChanNames !< Strings describing the names of the channels from the binary file (including the time channel) [-] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: ChanUnits !< Strings describing the units of the channels from the binary file (including the time channel) [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Data !< numeric data (rows and columns) from the binary file, including the time channel [-] @@ -53,16 +76,16 @@ MODULE NWTC_Library_Types ! ======================= ! ========= OutParmType ======= TYPE, PUBLIC :: OutParmType - INTEGER(IntKi) :: Indx !< An index into AllOuts array where this channel is computed/stored [-] + INTEGER(IntKi) :: Indx = 0_IntKi !< An index into AllOuts array where this channel is computed/stored [-] CHARACTER(ChanLen) :: Name !< Name of the output channel [-] CHARACTER(ChanLen) :: Units !< Units this channel is specified in [-] - INTEGER(IntKi) :: SignM !< Multiplier for output channel; usually -1 (minus) or 0 (invalid channel) [-] + INTEGER(IntKi) :: SignM = 0_IntKi !< Multiplier for output channel; usually -1 (minus) or 0 (invalid channel) [-] END TYPE OutParmType ! ======================= ! ========= FileInfoType ======= TYPE, PUBLIC :: FileInfoType - INTEGER(IntKi) :: NumLines - INTEGER(IntKi) :: NumFiles + INTEGER(IntKi) :: NumLines = 0_IntKi + INTEGER(IntKi) :: NumFiles = 0_IntKi INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: FileLine INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: FileIndx CHARACTER(MaxFileInfoLineLen) , DIMENSION(:), ALLOCATABLE :: FileList @@ -71,1460 +94,1323 @@ MODULE NWTC_Library_Types ! ======================= ! ========= Quaternion ======= TYPE, PUBLIC :: Quaternion - REAL(ReKi) :: q0 - REAL(ReKi) , DIMENSION(1:3) :: v + REAL(ReKi) :: q0 = 0.0_ReKi + REAL(ReKi) , DIMENSION(1:3) :: v = 0.0_ReKi END TYPE Quaternion ! ======================= ! ========= NWTC_RandomNumber_ParameterType ======= TYPE, PUBLIC :: NWTC_RandomNumber_ParameterType - INTEGER(IntKi) :: pRNG - INTEGER(IntKi) , DIMENSION(1:3) :: RandSeed + INTEGER(IntKi) :: pRNG = 0_IntKi + INTEGER(IntKi) , DIMENSION(1:3) :: RandSeed = 0_IntKi INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: RandSeedAry CHARACTER(6) :: RNG_type END TYPE NWTC_RandomNumber_ParameterType ! ======================= +! ========= ModVarType ======= + TYPE, PUBLIC :: ModVarType + character(VarNameLen) :: Name !< [-] + INTEGER(IntKi) :: Field = 0 !< [-] + INTEGER(IntKi) :: Nodes = 1 !< [-] + INTEGER(IntKi) :: Num = 1 !< [-] + INTEGER(IntKi) :: Flags = 0 !< [-] + INTEGER(IntKi) :: DerivOrder = 0 !< [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iLoc !< indices in local arrays [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iSol !< indices in solver arrays [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iLin !< indices in linearization arrays [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iq !< row index in solver q matrix [-] + INTEGER(IntKi) , DIMENSION(1:2) :: iUsr = 0_IntKi !< first user defined index for variable, can be used a lower/upper bounds [-] + INTEGER(IntKi) :: jUsr = 0 !< second user defined index for variable [-] + INTEGER(IntKi) :: MeshID = 0 !< Mesh identification number [-] + LOGICAL :: Solve = .false. !< flag indicating that variable is used by solver [-] + REAL(R8Ki) :: Perturb = 0 !< perturbation [-] + character(LinChanLen) , DIMENSION(:), ALLOCATABLE :: LinNames !< [-] + END TYPE ModVarType +! ======================= +! ========= ModVarsType ======= + TYPE, PUBLIC :: ModVarsType + INTEGER(IntKi) :: ModNum = 0 !< [-] + character(6) :: ModAbbr !< [-] + TYPE(ModVarType) , DIMENSION(:), ALLOCATABLE :: x !< Module state variable array [-] + TYPE(ModVarType) , DIMENSION(:), ALLOCATABLE :: u !< Module input variable array [-] + TYPE(ModVarType) , DIMENSION(:), ALLOCATABLE :: y !< Module output variable array [-] + INTEGER(IntKi) :: Nx = 0_IntKi !< [-] + INTEGER(IntKi) :: Nu = 0_IntKi !< [-] + INTEGER(IntKi) :: Ny = 0_IntKi !< [-] + END TYPE ModVarsType +! ======================= +! ========= ModValsType ======= + TYPE, PUBLIC :: ModValsType + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: x !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: dxdt !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: u !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: y !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: u_perturb !< input perturbation array [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: x_perturb !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: xp !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: xn !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: yp !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: yn !< [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dYdx !< [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dXdx !< [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dYdu !< [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dXdu !< [-] + END TYPE ModValsType +! ======================= +! ========= ModDataType ======= + TYPE, PUBLIC :: ModDataType + INTEGER(IntKi) :: Idx = 0 !< Module index in array of modules [-] + INTEGER(IntKi) :: ID = 0 !< Module identification number [-] + character(ChanLen) :: Abbr !< Module name abbreviation [-] + INTEGER(IntKi) :: Ins = 0 !< Module instance number [-] + LOGICAL :: IsTC = .false. !< Flag indicating module is part of tight coupling [-] + REAL(R8Ki) :: DT = 0 !< Module time step [-] + INTEGER(IntKi) :: SubSteps = 0 !< Module number of substeps per solver time step [-] + INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: ixs !< index array mapping local x vector to global x vector [-] + INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: ius !< index array mapping local u vector to global u vector [-] + INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: iys !< index array mapping local y vector to global y vector [-] + TYPE(ModVarsType) , POINTER :: Vars => NULL() !< Pointer to module variables type [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: SrcMaps !< Indices of mappings where module is the source [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: DstMaps !< Indices of mappings where module is the destination [-] + END TYPE ModDataType +! ======================= CONTAINS -!======================================================================= -!> This routine sets the error status and error message for a routine -!! that may set non-AbortErrLev errors. It concatenates error messages -!! and has the ability to provide a sort of traceback message of called -!! routines (if this is called consistently). -!! Modules in the FAST framework are recommend to use it. - SUBROUTINE SetErrStat ( ErrStatLcl, ErrMessLcl, ErrStat, ErrMess, RoutineName ) - - ! This routine is placed in this file because it is called in code generated by the FAST Registry (and I don't feel like putting it in the Sys files) ... be careful not to delete this routine! - - - INTEGER(IntKi), INTENT(IN ) :: ErrStatLcl ! Error status of the operation - CHARACTER(*), INTENT(IN ) :: ErrMessLcl ! Error message if ErrStat /= ErrID_None - - INTEGER(IntKi), INTENT(INOUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT(INOUT) :: ErrMess ! Error message if ErrStat /= ErrID_None - - CHARACTER(*), INTENT(IN ) :: RoutineName ! Name of the routine error occurred in - - - IF ( ErrStatLcl /= ErrID_None ) THEN - - IF (ErrStat /= ErrID_None) ErrMess = TRIM(ErrMess)//NewLine - ErrMess = TRIM(ErrMess)//TRIM(RoutineName)//':'//TRIM(ErrMessLcl) - ErrStat = MAX(ErrStat,ErrStatLcl) - - END IF - - END SUBROUTINE SetErrStat -!======================================================================= - - SUBROUTINE NWTC_Library_CopyProgDesc( SrcProgDescData, DstProgDescData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ProgDesc), INTENT(IN) :: SrcProgDescData - TYPE(ProgDesc), INTENT(INOUT) :: DstProgDescData - 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 = 'NWTC_Library_CopyProgDesc' -! +subroutine NWTC_Library_CopyProgDesc(SrcProgDescData, DstProgDescData, CtrlCode, ErrStat, ErrMsg) + type(ProgDesc), intent(in) :: SrcProgDescData + type(ProgDesc), intent(inout) :: DstProgDescData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'NWTC_Library_CopyProgDesc' ErrStat = ErrID_None - ErrMsg = "" - DstProgDescData%Name = SrcProgDescData%Name - DstProgDescData%Ver = SrcProgDescData%Ver - DstProgDescData%Date = SrcProgDescData%Date - END SUBROUTINE NWTC_Library_CopyProgDesc - - SUBROUTINE NWTC_Library_DestroyProgDesc( ProgDescData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(ProgDesc), INTENT(INOUT) :: ProgDescData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'NWTC_Library_DestroyProgDesc' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE NWTC_Library_DestroyProgDesc - - SUBROUTINE NWTC_Library_PackProgDesc( 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(ProgDesc), 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 = 'NWTC_Library_PackProgDesc' - ! 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%Name) ! Name - Int_BufSz = Int_BufSz + 1*LEN(InData%Ver) ! Ver - Int_BufSz = Int_BufSz + 1*LEN(InData%Date) ! Date - 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%Name) - IntKiBuf(Int_Xferred) = ICHAR(InData%Name(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%Ver) - IntKiBuf(Int_Xferred) = ICHAR(InData%Ver(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%Date) - IntKiBuf(Int_Xferred) = ICHAR(InData%Date(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END SUBROUTINE NWTC_Library_PackProgDesc - - SUBROUTINE NWTC_Library_UnPackProgDesc( 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(ProgDesc), 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 = 'NWTC_Library_UnPackProgDesc' - ! 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%Name) - OutData%Name(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%Ver) - OutData%Ver(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%Date) - OutData%Date(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END SUBROUTINE NWTC_Library_UnPackProgDesc - - SUBROUTINE NWTC_Library_CopyFASTdataType( SrcFASTdataTypeData, DstFASTdataTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FASTdataType), INTENT(IN) :: SrcFASTdataTypeData - TYPE(FASTdataType), INTENT(INOUT) :: DstFASTdataTypeData - 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 = 'NWTC_Library_CopyFASTdataType' -! + ErrMsg = '' + DstProgDescData%Name = SrcProgDescData%Name + DstProgDescData%Ver = SrcProgDescData%Ver + DstProgDescData%Date = SrcProgDescData%Date +end subroutine + +subroutine NWTC_Library_DestroyProgDesc(ProgDescData, ErrStat, ErrMsg) + type(ProgDesc), intent(inout) :: ProgDescData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'NWTC_Library_DestroyProgDesc' ErrStat = ErrID_None - ErrMsg = "" - DstFASTdataTypeData%File = SrcFASTdataTypeData%File - DstFASTdataTypeData%Descr = SrcFASTdataTypeData%Descr - DstFASTdataTypeData%NumChans = SrcFASTdataTypeData%NumChans - DstFASTdataTypeData%NumRecs = SrcFASTdataTypeData%NumRecs - DstFASTdataTypeData%TimeStep = SrcFASTdataTypeData%TimeStep -IF (ALLOCATED(SrcFASTdataTypeData%ChanNames)) THEN - i1_l = LBOUND(SrcFASTdataTypeData%ChanNames,1) - i1_u = UBOUND(SrcFASTdataTypeData%ChanNames,1) - IF (.NOT. ALLOCATED(DstFASTdataTypeData%ChanNames)) THEN - ALLOCATE(DstFASTdataTypeData%ChanNames(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstFASTdataTypeData%ChanNames.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstFASTdataTypeData%ChanNames = SrcFASTdataTypeData%ChanNames -ENDIF -IF (ALLOCATED(SrcFASTdataTypeData%ChanUnits)) THEN - i1_l = LBOUND(SrcFASTdataTypeData%ChanUnits,1) - i1_u = UBOUND(SrcFASTdataTypeData%ChanUnits,1) - IF (.NOT. ALLOCATED(DstFASTdataTypeData%ChanUnits)) THEN - ALLOCATE(DstFASTdataTypeData%ChanUnits(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstFASTdataTypeData%ChanUnits.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstFASTdataTypeData%ChanUnits = SrcFASTdataTypeData%ChanUnits -ENDIF -IF (ALLOCATED(SrcFASTdataTypeData%Data)) THEN - i1_l = LBOUND(SrcFASTdataTypeData%Data,1) - i1_u = UBOUND(SrcFASTdataTypeData%Data,1) - i2_l = LBOUND(SrcFASTdataTypeData%Data,2) - i2_u = UBOUND(SrcFASTdataTypeData%Data,2) - IF (.NOT. ALLOCATED(DstFASTdataTypeData%Data)) THEN - ALLOCATE(DstFASTdataTypeData%Data(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstFASTdataTypeData%Data.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstFASTdataTypeData%Data = SrcFASTdataTypeData%Data -ENDIF - END SUBROUTINE NWTC_Library_CopyFASTdataType - - SUBROUTINE NWTC_Library_DestroyFASTdataType( FASTdataTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(FASTdataType), INTENT(INOUT) :: FASTdataTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'NWTC_Library_DestroyFASTdataType' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(FASTdataTypeData%ChanNames)) THEN - DEALLOCATE(FASTdataTypeData%ChanNames) -ENDIF -IF (ALLOCATED(FASTdataTypeData%ChanUnits)) THEN - DEALLOCATE(FASTdataTypeData%ChanUnits) -ENDIF -IF (ALLOCATED(FASTdataTypeData%Data)) THEN - DEALLOCATE(FASTdataTypeData%Data) -ENDIF - END SUBROUTINE NWTC_Library_DestroyFASTdataType - - SUBROUTINE NWTC_Library_PackFASTdataType( 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(FASTdataType), 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 = 'NWTC_Library_PackFASTdataType' - ! 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%File) ! File - Int_BufSz = Int_BufSz + 1*LEN(InData%Descr) ! Descr - Int_BufSz = Int_BufSz + 1 ! NumChans - Int_BufSz = Int_BufSz + 1 ! NumRecs - Db_BufSz = Db_BufSz + 1 ! TimeStep - Int_BufSz = Int_BufSz + 1 ! ChanNames allocated yes/no - IF ( ALLOCATED(InData%ChanNames) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ChanNames upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%ChanNames)*LEN(InData%ChanNames) ! ChanNames - END IF - Int_BufSz = Int_BufSz + 1 ! ChanUnits allocated yes/no - IF ( ALLOCATED(InData%ChanUnits) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ChanUnits upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%ChanUnits)*LEN(InData%ChanUnits) ! ChanUnits - END IF - Int_BufSz = Int_BufSz + 1 ! Data allocated yes/no - IF ( ALLOCATED(InData%Data) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Data upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Data) ! Data - 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%File) - IntKiBuf(Int_Xferred) = ICHAR(InData%File(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%Descr) - IntKiBuf(Int_Xferred) = ICHAR(InData%Descr(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = InData%NumChans - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumRecs - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%TimeStep - Db_Xferred = Db_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%ChanNames) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ChanNames,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ChanNames,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ChanNames,1), UBOUND(InData%ChanNames,1) - DO I = 1, LEN(InData%ChanNames) - IntKiBuf(Int_Xferred) = ICHAR(InData%ChanNames(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ChanUnits) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ChanUnits,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ChanUnits,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ChanUnits,1), UBOUND(InData%ChanUnits,1) - DO I = 1, LEN(InData%ChanUnits) - IntKiBuf(Int_Xferred) = ICHAR(InData%ChanUnits(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Data) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Data,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Data,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Data,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Data,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Data,2), UBOUND(InData%Data,2) - DO i1 = LBOUND(InData%Data,1), UBOUND(InData%Data,1) - ReKiBuf(Re_Xferred) = InData%Data(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE NWTC_Library_PackFASTdataType - - SUBROUTINE NWTC_Library_UnPackFASTdataType( 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(FASTdataType), 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 = 'NWTC_Library_UnPackFASTdataType' - ! 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%File) - OutData%File(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%Descr) - OutData%Descr(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%NumChans = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumRecs = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TimeStep = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ChanNames not allocated - Int_Xferred = Int_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%ChanNames)) DEALLOCATE(OutData%ChanNames) - ALLOCATE(OutData%ChanNames(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ChanNames.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ChanNames,1), UBOUND(OutData%ChanNames,1) - DO I = 1, LEN(OutData%ChanNames) - OutData%ChanNames(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 ! ChanUnits not allocated - Int_Xferred = Int_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%ChanUnits)) DEALLOCATE(OutData%ChanUnits) - ALLOCATE(OutData%ChanUnits(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ChanUnits.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ChanUnits,1), UBOUND(OutData%ChanUnits,1) - DO I = 1, LEN(OutData%ChanUnits) - OutData%ChanUnits(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 ! Data not allocated - Int_Xferred = Int_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%Data)) DEALLOCATE(OutData%Data) - ALLOCATE(OutData%Data(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Data.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Data,2), UBOUND(OutData%Data,2) - DO i1 = LBOUND(OutData%Data,1), UBOUND(OutData%Data,1) - OutData%Data(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE NWTC_Library_UnPackFASTdataType - - SUBROUTINE NWTC_Library_CopyOutParmType( SrcOutParmTypeData, DstOutParmTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(OutParmType), INTENT(IN) :: SrcOutParmTypeData - TYPE(OutParmType), INTENT(INOUT) :: DstOutParmTypeData - 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 = 'NWTC_Library_CopyOutParmType' -! + ErrMsg = '' +end subroutine + +subroutine NWTC_Library_PackProgDesc(RF, Indata) + type(RegFile), intent(inout) :: RF + type(ProgDesc), intent(in) :: InData + character(*), parameter :: RoutineName = 'NWTC_Library_PackProgDesc' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%Name) + call RegPack(RF, InData%Ver) + call RegPack(RF, InData%Date) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine NWTC_Library_UnPackProgDesc(RF, OutData) + type(RegFile), intent(inout) :: RF + type(ProgDesc), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'NWTC_Library_UnPackProgDesc' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%Name); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Ver); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Date); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine NWTC_Library_CopyFASTdataType(SrcFASTdataTypeData, DstFASTdataTypeData, CtrlCode, ErrStat, ErrMsg) + type(FASTdataType), intent(in) :: SrcFASTdataTypeData + type(FASTdataType), intent(inout) :: DstFASTdataTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'NWTC_Library_CopyFASTdataType' ErrStat = ErrID_None - ErrMsg = "" - DstOutParmTypeData%Indx = SrcOutParmTypeData%Indx - DstOutParmTypeData%Name = SrcOutParmTypeData%Name - DstOutParmTypeData%Units = SrcOutParmTypeData%Units - DstOutParmTypeData%SignM = SrcOutParmTypeData%SignM - END SUBROUTINE NWTC_Library_CopyOutParmType - - SUBROUTINE NWTC_Library_DestroyOutParmType( OutParmTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(OutParmType), INTENT(INOUT) :: OutParmTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'NWTC_Library_DestroyOutParmType' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE NWTC_Library_DestroyOutParmType - - SUBROUTINE NWTC_Library_PackOutParmType( 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(OutParmType), 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 = 'NWTC_Library_PackOutParmType' - ! 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 ! Indx - Int_BufSz = Int_BufSz + 1*LEN(InData%Name) ! Name - Int_BufSz = Int_BufSz + 1*LEN(InData%Units) ! Units - Int_BufSz = Int_BufSz + 1 ! SignM - 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%Indx - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%Name) - IntKiBuf(Int_Xferred) = ICHAR(InData%Name(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%Units) - IntKiBuf(Int_Xferred) = ICHAR(InData%Units(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = InData%SignM - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE NWTC_Library_PackOutParmType - - SUBROUTINE NWTC_Library_UnPackOutParmType( 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(OutParmType), 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 = 'NWTC_Library_UnPackOutParmType' - ! 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%Indx = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%Name) - OutData%Name(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%Units) - OutData%Units(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%SignM = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE NWTC_Library_UnPackOutParmType - - SUBROUTINE NWTC_Library_CopyFileInfoType( SrcFileInfoTypeData, DstFileInfoTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FileInfoType), INTENT(IN) :: SrcFileInfoTypeData - TYPE(FileInfoType), INTENT(INOUT) :: DstFileInfoTypeData - 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 = 'NWTC_Library_CopyFileInfoType' -! + ErrMsg = '' + DstFASTdataTypeData%File = SrcFASTdataTypeData%File + DstFASTdataTypeData%Descr = SrcFASTdataTypeData%Descr + DstFASTdataTypeData%NumChans = SrcFASTdataTypeData%NumChans + DstFASTdataTypeData%NumRecs = SrcFASTdataTypeData%NumRecs + DstFASTdataTypeData%TimeStep = SrcFASTdataTypeData%TimeStep + if (allocated(SrcFASTdataTypeData%ChanNames)) then + LB(1:1) = lbound(SrcFASTdataTypeData%ChanNames) + UB(1:1) = ubound(SrcFASTdataTypeData%ChanNames) + if (.not. allocated(DstFASTdataTypeData%ChanNames)) then + allocate(DstFASTdataTypeData%ChanNames(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstFASTdataTypeData%ChanNames.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstFASTdataTypeData%ChanNames = SrcFASTdataTypeData%ChanNames + end if + if (allocated(SrcFASTdataTypeData%ChanUnits)) then + LB(1:1) = lbound(SrcFASTdataTypeData%ChanUnits) + UB(1:1) = ubound(SrcFASTdataTypeData%ChanUnits) + if (.not. allocated(DstFASTdataTypeData%ChanUnits)) then + allocate(DstFASTdataTypeData%ChanUnits(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstFASTdataTypeData%ChanUnits.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstFASTdataTypeData%ChanUnits = SrcFASTdataTypeData%ChanUnits + end if + if (allocated(SrcFASTdataTypeData%Data)) then + LB(1:2) = lbound(SrcFASTdataTypeData%Data) + UB(1:2) = ubound(SrcFASTdataTypeData%Data) + if (.not. allocated(DstFASTdataTypeData%Data)) then + allocate(DstFASTdataTypeData%Data(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstFASTdataTypeData%Data.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstFASTdataTypeData%Data = SrcFASTdataTypeData%Data + end if +end subroutine + +subroutine NWTC_Library_DestroyFASTdataType(FASTdataTypeData, ErrStat, ErrMsg) + type(FASTdataType), intent(inout) :: FASTdataTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'NWTC_Library_DestroyFASTdataType' ErrStat = ErrID_None - ErrMsg = "" - DstFileInfoTypeData%NumLines = SrcFileInfoTypeData%NumLines - DstFileInfoTypeData%NumFiles = SrcFileInfoTypeData%NumFiles -IF (ALLOCATED(SrcFileInfoTypeData%FileLine)) THEN - i1_l = LBOUND(SrcFileInfoTypeData%FileLine,1) - i1_u = UBOUND(SrcFileInfoTypeData%FileLine,1) - IF (.NOT. ALLOCATED(DstFileInfoTypeData%FileLine)) THEN - ALLOCATE(DstFileInfoTypeData%FileLine(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstFileInfoTypeData%FileLine.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstFileInfoTypeData%FileLine = SrcFileInfoTypeData%FileLine -ENDIF -IF (ALLOCATED(SrcFileInfoTypeData%FileIndx)) THEN - i1_l = LBOUND(SrcFileInfoTypeData%FileIndx,1) - i1_u = UBOUND(SrcFileInfoTypeData%FileIndx,1) - IF (.NOT. ALLOCATED(DstFileInfoTypeData%FileIndx)) THEN - ALLOCATE(DstFileInfoTypeData%FileIndx(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstFileInfoTypeData%FileIndx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstFileInfoTypeData%FileIndx = SrcFileInfoTypeData%FileIndx -ENDIF -IF (ALLOCATED(SrcFileInfoTypeData%FileList)) THEN - i1_l = LBOUND(SrcFileInfoTypeData%FileList,1) - i1_u = UBOUND(SrcFileInfoTypeData%FileList,1) - IF (.NOT. ALLOCATED(DstFileInfoTypeData%FileList)) THEN - ALLOCATE(DstFileInfoTypeData%FileList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstFileInfoTypeData%FileList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstFileInfoTypeData%FileList = SrcFileInfoTypeData%FileList -ENDIF -IF (ALLOCATED(SrcFileInfoTypeData%Lines)) THEN - i1_l = LBOUND(SrcFileInfoTypeData%Lines,1) - i1_u = UBOUND(SrcFileInfoTypeData%Lines,1) - IF (.NOT. ALLOCATED(DstFileInfoTypeData%Lines)) THEN - ALLOCATE(DstFileInfoTypeData%Lines(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstFileInfoTypeData%Lines.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstFileInfoTypeData%Lines = SrcFileInfoTypeData%Lines -ENDIF - END SUBROUTINE NWTC_Library_CopyFileInfoType - - SUBROUTINE NWTC_Library_DestroyFileInfoType( FileInfoTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(FileInfoType), INTENT(INOUT) :: FileInfoTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'NWTC_Library_DestroyFileInfoType' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(FileInfoTypeData%FileLine)) THEN - DEALLOCATE(FileInfoTypeData%FileLine) -ENDIF -IF (ALLOCATED(FileInfoTypeData%FileIndx)) THEN - DEALLOCATE(FileInfoTypeData%FileIndx) -ENDIF -IF (ALLOCATED(FileInfoTypeData%FileList)) THEN - DEALLOCATE(FileInfoTypeData%FileList) -ENDIF -IF (ALLOCATED(FileInfoTypeData%Lines)) THEN - DEALLOCATE(FileInfoTypeData%Lines) -ENDIF - END SUBROUTINE NWTC_Library_DestroyFileInfoType - - SUBROUTINE NWTC_Library_PackFileInfoType( 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(FileInfoType), 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 = 'NWTC_Library_PackFileInfoType' - ! 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 ! NumLines - Int_BufSz = Int_BufSz + 1 ! NumFiles - Int_BufSz = Int_BufSz + 1 ! FileLine allocated yes/no - IF ( ALLOCATED(InData%FileLine) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! FileLine upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%FileLine) ! FileLine - END IF - Int_BufSz = Int_BufSz + 1 ! FileIndx allocated yes/no - IF ( ALLOCATED(InData%FileIndx) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! FileIndx upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%FileIndx) ! FileIndx - END IF - Int_BufSz = Int_BufSz + 1 ! FileList allocated yes/no - IF ( ALLOCATED(InData%FileList) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! FileList upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%FileList)*LEN(InData%FileList) ! FileList - END IF - Int_BufSz = Int_BufSz + 1 ! Lines allocated yes/no - IF ( ALLOCATED(InData%Lines) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Lines upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Lines)*LEN(InData%Lines) ! Lines - 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%NumLines - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumFiles - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%FileLine) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FileLine,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FileLine,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%FileLine,1), UBOUND(InData%FileLine,1) - IntKiBuf(Int_Xferred) = InData%FileLine(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%FileIndx) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FileIndx,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FileIndx,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%FileIndx,1), UBOUND(InData%FileIndx,1) - IntKiBuf(Int_Xferred) = InData%FileIndx(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%FileList) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FileList,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FileList,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%FileList,1), UBOUND(InData%FileList,1) - DO I = 1, LEN(InData%FileList) - IntKiBuf(Int_Xferred) = ICHAR(InData%FileList(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Lines) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Lines,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Lines,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Lines,1), UBOUND(InData%Lines,1) - DO I = 1, LEN(InData%Lines) - IntKiBuf(Int_Xferred) = ICHAR(InData%Lines(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - END SUBROUTINE NWTC_Library_PackFileInfoType - - SUBROUTINE NWTC_Library_UnPackFileInfoType( 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(FileInfoType), 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 = 'NWTC_Library_UnPackFileInfoType' - ! 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%NumLines = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumFiles = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FileLine not allocated - Int_Xferred = Int_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%FileLine)) DEALLOCATE(OutData%FileLine) - ALLOCATE(OutData%FileLine(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FileLine.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%FileLine,1), UBOUND(OutData%FileLine,1) - OutData%FileLine(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FileIndx not allocated - Int_Xferred = Int_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%FileIndx)) DEALLOCATE(OutData%FileIndx) - ALLOCATE(OutData%FileIndx(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FileIndx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%FileIndx,1), UBOUND(OutData%FileIndx,1) - OutData%FileIndx(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FileList not allocated - Int_Xferred = Int_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%FileList)) DEALLOCATE(OutData%FileList) - ALLOCATE(OutData%FileList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FileList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%FileList,1), UBOUND(OutData%FileList,1) - DO I = 1, LEN(OutData%FileList) - OutData%FileList(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 ! Lines not allocated - Int_Xferred = Int_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%Lines)) DEALLOCATE(OutData%Lines) - ALLOCATE(OutData%Lines(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Lines.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Lines,1), UBOUND(OutData%Lines,1) - DO I = 1, LEN(OutData%Lines) - OutData%Lines(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - END SUBROUTINE NWTC_Library_UnPackFileInfoType - - SUBROUTINE NWTC_Library_CopyQuaternion( SrcQuaternionData, DstQuaternionData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Quaternion), INTENT(IN) :: SrcQuaternionData - TYPE(Quaternion), INTENT(INOUT) :: DstQuaternionData - 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 = 'NWTC_Library_CopyQuaternion' -! + ErrMsg = '' + if (allocated(FASTdataTypeData%ChanNames)) then + deallocate(FASTdataTypeData%ChanNames) + end if + if (allocated(FASTdataTypeData%ChanUnits)) then + deallocate(FASTdataTypeData%ChanUnits) + end if + if (allocated(FASTdataTypeData%Data)) then + deallocate(FASTdataTypeData%Data) + end if +end subroutine + +subroutine NWTC_Library_PackFASTdataType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(FASTdataType), intent(in) :: InData + character(*), parameter :: RoutineName = 'NWTC_Library_PackFASTdataType' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%File) + call RegPack(RF, InData%Descr) + call RegPack(RF, InData%NumChans) + call RegPack(RF, InData%NumRecs) + call RegPack(RF, InData%TimeStep) + call RegPackAlloc(RF, InData%ChanNames) + call RegPackAlloc(RF, InData%ChanUnits) + call RegPackAlloc(RF, InData%Data) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine NWTC_Library_UnPackFASTdataType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(FASTdataType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'NWTC_Library_UnPackFASTdataType' + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%File); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Descr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumChans); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumRecs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TimeStep); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ChanNames); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ChanUnits); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Data); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine NWTC_Library_CopyOutParmType(SrcOutParmTypeData, DstOutParmTypeData, CtrlCode, ErrStat, ErrMsg) + type(OutParmType), intent(in) :: SrcOutParmTypeData + type(OutParmType), intent(inout) :: DstOutParmTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'NWTC_Library_CopyOutParmType' ErrStat = ErrID_None - ErrMsg = "" - DstQuaternionData%q0 = SrcQuaternionData%q0 - DstQuaternionData%v = SrcQuaternionData%v - END SUBROUTINE NWTC_Library_CopyQuaternion - - SUBROUTINE NWTC_Library_DestroyQuaternion( QuaternionData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(Quaternion), INTENT(INOUT) :: QuaternionData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'NWTC_Library_DestroyQuaternion' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE NWTC_Library_DestroyQuaternion - - SUBROUTINE NWTC_Library_PackQuaternion( 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(Quaternion), 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 = 'NWTC_Library_PackQuaternion' - ! 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 ! q0 - Re_BufSz = Re_BufSz + SIZE(InData%v) ! v - 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%q0 - Re_Xferred = Re_Xferred + 1 - DO i1 = LBOUND(InData%v,1), UBOUND(InData%v,1) - ReKiBuf(Re_Xferred) = InData%v(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END SUBROUTINE NWTC_Library_PackQuaternion - - SUBROUTINE NWTC_Library_UnPackQuaternion( 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(Quaternion), 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 = 'NWTC_Library_UnPackQuaternion' - ! 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%q0 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%v,1) - i1_u = UBOUND(OutData%v,1) - DO i1 = LBOUND(OutData%v,1), UBOUND(OutData%v,1) - OutData%v(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END SUBROUTINE NWTC_Library_UnPackQuaternion - - SUBROUTINE NWTC_Library_CopyNWTC_RandomNumber_ParameterType( SrcNWTC_RandomNumber_ParameterTypeData, DstNWTC_RandomNumber_ParameterTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(NWTC_RandomNumber_ParameterType), INTENT(IN) :: SrcNWTC_RandomNumber_ParameterTypeData - TYPE(NWTC_RandomNumber_ParameterType), INTENT(INOUT) :: DstNWTC_RandomNumber_ParameterTypeData - 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 = 'NWTC_Library_CopyNWTC_RandomNumber_ParameterType' -! + ErrMsg = '' + DstOutParmTypeData%Indx = SrcOutParmTypeData%Indx + DstOutParmTypeData%Name = SrcOutParmTypeData%Name + DstOutParmTypeData%Units = SrcOutParmTypeData%Units + DstOutParmTypeData%SignM = SrcOutParmTypeData%SignM +end subroutine + +subroutine NWTC_Library_DestroyOutParmType(OutParmTypeData, ErrStat, ErrMsg) + type(OutParmType), intent(inout) :: OutParmTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'NWTC_Library_DestroyOutParmType' ErrStat = ErrID_None - ErrMsg = "" - DstNWTC_RandomNumber_ParameterTypeData%pRNG = SrcNWTC_RandomNumber_ParameterTypeData%pRNG - DstNWTC_RandomNumber_ParameterTypeData%RandSeed = SrcNWTC_RandomNumber_ParameterTypeData%RandSeed -IF (ALLOCATED(SrcNWTC_RandomNumber_ParameterTypeData%RandSeedAry)) THEN - i1_l = LBOUND(SrcNWTC_RandomNumber_ParameterTypeData%RandSeedAry,1) - i1_u = UBOUND(SrcNWTC_RandomNumber_ParameterTypeData%RandSeedAry,1) - IF (.NOT. ALLOCATED(DstNWTC_RandomNumber_ParameterTypeData%RandSeedAry)) THEN - ALLOCATE(DstNWTC_RandomNumber_ParameterTypeData%RandSeedAry(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstNWTC_RandomNumber_ParameterTypeData%RandSeedAry.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstNWTC_RandomNumber_ParameterTypeData%RandSeedAry = SrcNWTC_RandomNumber_ParameterTypeData%RandSeedAry -ENDIF - DstNWTC_RandomNumber_ParameterTypeData%RNG_type = SrcNWTC_RandomNumber_ParameterTypeData%RNG_type - END SUBROUTINE NWTC_Library_CopyNWTC_RandomNumber_ParameterType - - SUBROUTINE NWTC_Library_DestroyNWTC_RandomNumber_ParameterType( NWTC_RandomNumber_ParameterTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(NWTC_RandomNumber_ParameterType), INTENT(INOUT) :: NWTC_RandomNumber_ParameterTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'NWTC_Library_DestroyNWTC_RandomNumber_ParameterType' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(NWTC_RandomNumber_ParameterTypeData%RandSeedAry)) THEN - DEALLOCATE(NWTC_RandomNumber_ParameterTypeData%RandSeedAry) -ENDIF - END SUBROUTINE NWTC_Library_DestroyNWTC_RandomNumber_ParameterType - - SUBROUTINE NWTC_Library_PackNWTC_RandomNumber_ParameterType( 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(NWTC_RandomNumber_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 = 'NWTC_Library_PackNWTC_RandomNumber_ParameterType' - ! 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 ! pRNG - Int_BufSz = Int_BufSz + SIZE(InData%RandSeed) ! RandSeed - Int_BufSz = Int_BufSz + 1 ! RandSeedAry allocated yes/no - IF ( ALLOCATED(InData%RandSeedAry) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! RandSeedAry upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%RandSeedAry) ! RandSeedAry - END IF - Int_BufSz = Int_BufSz + 1*LEN(InData%RNG_type) ! RNG_type - 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%pRNG - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%RandSeed,1), UBOUND(InData%RandSeed,1) - IntKiBuf(Int_Xferred) = InData%RandSeed(i1) - Int_Xferred = Int_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%RandSeedAry) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RandSeedAry,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RandSeedAry,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%RandSeedAry,1), UBOUND(InData%RandSeedAry,1) - IntKiBuf(Int_Xferred) = InData%RandSeedAry(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - DO I = 1, LEN(InData%RNG_type) - IntKiBuf(Int_Xferred) = ICHAR(InData%RNG_type(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END SUBROUTINE NWTC_Library_PackNWTC_RandomNumber_ParameterType - - SUBROUTINE NWTC_Library_UnPackNWTC_RandomNumber_ParameterType( 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(NWTC_RandomNumber_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 = 'NWTC_Library_UnPackNWTC_RandomNumber_ParameterType' - ! 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%pRNG = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%RandSeed,1) - i1_u = UBOUND(OutData%RandSeed,1) - DO i1 = LBOUND(OutData%RandSeed,1), UBOUND(OutData%RandSeed,1) - OutData%RandSeed(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RandSeedAry not allocated - Int_Xferred = Int_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%RandSeedAry)) DEALLOCATE(OutData%RandSeedAry) - ALLOCATE(OutData%RandSeedAry(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RandSeedAry.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%RandSeedAry,1), UBOUND(OutData%RandSeedAry,1) - OutData%RandSeedAry(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - DO I = 1, LEN(OutData%RNG_type) - OutData%RNG_type(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END SUBROUTINE NWTC_Library_UnPackNWTC_RandomNumber_ParameterType - + ErrMsg = '' +end subroutine + +subroutine NWTC_Library_PackOutParmType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(OutParmType), intent(in) :: InData + character(*), parameter :: RoutineName = 'NWTC_Library_PackOutParmType' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%Indx) + call RegPack(RF, InData%Name) + call RegPack(RF, InData%Units) + call RegPack(RF, InData%SignM) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine NWTC_Library_UnPackOutParmType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(OutParmType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'NWTC_Library_UnPackOutParmType' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%Indx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Name); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Units); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SignM); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine NWTC_Library_CopyFileInfoType(SrcFileInfoTypeData, DstFileInfoTypeData, CtrlCode, ErrStat, ErrMsg) + type(FileInfoType), intent(in) :: SrcFileInfoTypeData + type(FileInfoType), intent(inout) :: DstFileInfoTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'NWTC_Library_CopyFileInfoType' + ErrStat = ErrID_None + ErrMsg = '' + DstFileInfoTypeData%NumLines = SrcFileInfoTypeData%NumLines + DstFileInfoTypeData%NumFiles = SrcFileInfoTypeData%NumFiles + if (allocated(SrcFileInfoTypeData%FileLine)) then + LB(1:1) = lbound(SrcFileInfoTypeData%FileLine) + UB(1:1) = ubound(SrcFileInfoTypeData%FileLine) + if (.not. allocated(DstFileInfoTypeData%FileLine)) then + allocate(DstFileInfoTypeData%FileLine(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstFileInfoTypeData%FileLine.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstFileInfoTypeData%FileLine = SrcFileInfoTypeData%FileLine + end if + if (allocated(SrcFileInfoTypeData%FileIndx)) then + LB(1:1) = lbound(SrcFileInfoTypeData%FileIndx) + UB(1:1) = ubound(SrcFileInfoTypeData%FileIndx) + if (.not. allocated(DstFileInfoTypeData%FileIndx)) then + allocate(DstFileInfoTypeData%FileIndx(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstFileInfoTypeData%FileIndx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstFileInfoTypeData%FileIndx = SrcFileInfoTypeData%FileIndx + end if + if (allocated(SrcFileInfoTypeData%FileList)) then + LB(1:1) = lbound(SrcFileInfoTypeData%FileList) + UB(1:1) = ubound(SrcFileInfoTypeData%FileList) + if (.not. allocated(DstFileInfoTypeData%FileList)) then + allocate(DstFileInfoTypeData%FileList(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstFileInfoTypeData%FileList.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstFileInfoTypeData%FileList = SrcFileInfoTypeData%FileList + end if + if (allocated(SrcFileInfoTypeData%Lines)) then + LB(1:1) = lbound(SrcFileInfoTypeData%Lines) + UB(1:1) = ubound(SrcFileInfoTypeData%Lines) + if (.not. allocated(DstFileInfoTypeData%Lines)) then + allocate(DstFileInfoTypeData%Lines(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstFileInfoTypeData%Lines.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstFileInfoTypeData%Lines = SrcFileInfoTypeData%Lines + end if +end subroutine + +subroutine NWTC_Library_DestroyFileInfoType(FileInfoTypeData, ErrStat, ErrMsg) + type(FileInfoType), intent(inout) :: FileInfoTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'NWTC_Library_DestroyFileInfoType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(FileInfoTypeData%FileLine)) then + deallocate(FileInfoTypeData%FileLine) + end if + if (allocated(FileInfoTypeData%FileIndx)) then + deallocate(FileInfoTypeData%FileIndx) + end if + if (allocated(FileInfoTypeData%FileList)) then + deallocate(FileInfoTypeData%FileList) + end if + if (allocated(FileInfoTypeData%Lines)) then + deallocate(FileInfoTypeData%Lines) + end if +end subroutine + +subroutine NWTC_Library_PackFileInfoType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(FileInfoType), intent(in) :: InData + character(*), parameter :: RoutineName = 'NWTC_Library_PackFileInfoType' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%NumLines) + call RegPack(RF, InData%NumFiles) + call RegPackAlloc(RF, InData%FileLine) + call RegPackAlloc(RF, InData%FileIndx) + call RegPackAlloc(RF, InData%FileList) + call RegPackAlloc(RF, InData%Lines) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine NWTC_Library_UnPackFileInfoType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(FileInfoType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'NWTC_Library_UnPackFileInfoType' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%NumLines); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumFiles); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%FileLine); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%FileIndx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%FileList); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Lines); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine NWTC_Library_CopyQuaternion(SrcQuaternionData, DstQuaternionData, CtrlCode, ErrStat, ErrMsg) + type(Quaternion), intent(in) :: SrcQuaternionData + type(Quaternion), intent(inout) :: DstQuaternionData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'NWTC_Library_CopyQuaternion' + ErrStat = ErrID_None + ErrMsg = '' + DstQuaternionData%q0 = SrcQuaternionData%q0 + DstQuaternionData%v = SrcQuaternionData%v +end subroutine + +subroutine NWTC_Library_DestroyQuaternion(QuaternionData, ErrStat, ErrMsg) + type(Quaternion), intent(inout) :: QuaternionData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'NWTC_Library_DestroyQuaternion' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine NWTC_Library_PackQuaternion(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Quaternion), intent(in) :: InData + character(*), parameter :: RoutineName = 'NWTC_Library_PackQuaternion' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%q0) + call RegPack(RF, InData%v) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine NWTC_Library_UnPackQuaternion(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Quaternion), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'NWTC_Library_UnPackQuaternion' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%q0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%v); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine NWTC_Library_CopyNWTC_RandomNumber_ParameterType(SrcNWTC_RandomNumber_ParameterTypeData, DstNWTC_RandomNumber_ParameterTypeData, CtrlCode, ErrStat, ErrMsg) + type(NWTC_RandomNumber_ParameterType), intent(in) :: SrcNWTC_RandomNumber_ParameterTypeData + type(NWTC_RandomNumber_ParameterType), intent(inout) :: DstNWTC_RandomNumber_ParameterTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'NWTC_Library_CopyNWTC_RandomNumber_ParameterType' + ErrStat = ErrID_None + ErrMsg = '' + DstNWTC_RandomNumber_ParameterTypeData%pRNG = SrcNWTC_RandomNumber_ParameterTypeData%pRNG + DstNWTC_RandomNumber_ParameterTypeData%RandSeed = SrcNWTC_RandomNumber_ParameterTypeData%RandSeed + if (allocated(SrcNWTC_RandomNumber_ParameterTypeData%RandSeedAry)) then + LB(1:1) = lbound(SrcNWTC_RandomNumber_ParameterTypeData%RandSeedAry) + UB(1:1) = ubound(SrcNWTC_RandomNumber_ParameterTypeData%RandSeedAry) + if (.not. allocated(DstNWTC_RandomNumber_ParameterTypeData%RandSeedAry)) then + allocate(DstNWTC_RandomNumber_ParameterTypeData%RandSeedAry(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstNWTC_RandomNumber_ParameterTypeData%RandSeedAry.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstNWTC_RandomNumber_ParameterTypeData%RandSeedAry = SrcNWTC_RandomNumber_ParameterTypeData%RandSeedAry + end if + DstNWTC_RandomNumber_ParameterTypeData%RNG_type = SrcNWTC_RandomNumber_ParameterTypeData%RNG_type +end subroutine + +subroutine NWTC_Library_DestroyNWTC_RandomNumber_ParameterType(NWTC_RandomNumber_ParameterTypeData, ErrStat, ErrMsg) + type(NWTC_RandomNumber_ParameterType), intent(inout) :: NWTC_RandomNumber_ParameterTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'NWTC_Library_DestroyNWTC_RandomNumber_ParameterType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(NWTC_RandomNumber_ParameterTypeData%RandSeedAry)) then + deallocate(NWTC_RandomNumber_ParameterTypeData%RandSeedAry) + end if +end subroutine + +subroutine NWTC_Library_PackNWTC_RandomNumber_ParameterType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(NWTC_RandomNumber_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'NWTC_Library_PackNWTC_RandomNumber_ParameterType' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%pRNG) + call RegPack(RF, InData%RandSeed) + call RegPackAlloc(RF, InData%RandSeedAry) + call RegPack(RF, InData%RNG_type) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine NWTC_Library_UnPackNWTC_RandomNumber_ParameterType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(NWTC_RandomNumber_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'NWTC_Library_UnPackNWTC_RandomNumber_ParameterType' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%pRNG); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RandSeed); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%RandSeedAry); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RNG_type); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine NWTC_Library_CopyModVarType(SrcModVarTypeData, DstModVarTypeData, CtrlCode, ErrStat, ErrMsg) + type(ModVarType), intent(in) :: SrcModVarTypeData + type(ModVarType), intent(inout) :: DstModVarTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'NWTC_Library_CopyModVarType' + ErrStat = ErrID_None + ErrMsg = '' + DstModVarTypeData%Name = SrcModVarTypeData%Name + DstModVarTypeData%Field = SrcModVarTypeData%Field + DstModVarTypeData%Nodes = SrcModVarTypeData%Nodes + DstModVarTypeData%Num = SrcModVarTypeData%Num + DstModVarTypeData%Flags = SrcModVarTypeData%Flags + DstModVarTypeData%DerivOrder = SrcModVarTypeData%DerivOrder + if (allocated(SrcModVarTypeData%iLoc)) then + LB(1:1) = lbound(SrcModVarTypeData%iLoc) + UB(1:1) = ubound(SrcModVarTypeData%iLoc) + if (.not. allocated(DstModVarTypeData%iLoc)) then + allocate(DstModVarTypeData%iLoc(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModVarTypeData%iLoc.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModVarTypeData%iLoc = SrcModVarTypeData%iLoc + end if + if (allocated(SrcModVarTypeData%iSol)) then + LB(1:1) = lbound(SrcModVarTypeData%iSol) + UB(1:1) = ubound(SrcModVarTypeData%iSol) + if (.not. allocated(DstModVarTypeData%iSol)) then + allocate(DstModVarTypeData%iSol(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModVarTypeData%iSol.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModVarTypeData%iSol = SrcModVarTypeData%iSol + end if + if (allocated(SrcModVarTypeData%iLin)) then + LB(1:1) = lbound(SrcModVarTypeData%iLin) + UB(1:1) = ubound(SrcModVarTypeData%iLin) + if (.not. allocated(DstModVarTypeData%iLin)) then + allocate(DstModVarTypeData%iLin(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModVarTypeData%iLin.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModVarTypeData%iLin = SrcModVarTypeData%iLin + end if + if (allocated(SrcModVarTypeData%iq)) then + LB(1:1) = lbound(SrcModVarTypeData%iq) + UB(1:1) = ubound(SrcModVarTypeData%iq) + if (.not. allocated(DstModVarTypeData%iq)) then + allocate(DstModVarTypeData%iq(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModVarTypeData%iq.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModVarTypeData%iq = SrcModVarTypeData%iq + end if + DstModVarTypeData%iUsr = SrcModVarTypeData%iUsr + DstModVarTypeData%jUsr = SrcModVarTypeData%jUsr + DstModVarTypeData%MeshID = SrcModVarTypeData%MeshID + DstModVarTypeData%Solve = SrcModVarTypeData%Solve + DstModVarTypeData%Perturb = SrcModVarTypeData%Perturb + if (allocated(SrcModVarTypeData%LinNames)) then + LB(1:1) = lbound(SrcModVarTypeData%LinNames) + UB(1:1) = ubound(SrcModVarTypeData%LinNames) + if (.not. allocated(DstModVarTypeData%LinNames)) then + allocate(DstModVarTypeData%LinNames(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModVarTypeData%LinNames.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModVarTypeData%LinNames = SrcModVarTypeData%LinNames + end if +end subroutine + +subroutine NWTC_Library_DestroyModVarType(ModVarTypeData, ErrStat, ErrMsg) + type(ModVarType), intent(inout) :: ModVarTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'NWTC_Library_DestroyModVarType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ModVarTypeData%iLoc)) then + deallocate(ModVarTypeData%iLoc) + end if + if (allocated(ModVarTypeData%iSol)) then + deallocate(ModVarTypeData%iSol) + end if + if (allocated(ModVarTypeData%iLin)) then + deallocate(ModVarTypeData%iLin) + end if + if (allocated(ModVarTypeData%iq)) then + deallocate(ModVarTypeData%iq) + end if + if (allocated(ModVarTypeData%LinNames)) then + deallocate(ModVarTypeData%LinNames) + end if +end subroutine + +subroutine NWTC_Library_PackModVarType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(ModVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'NWTC_Library_PackModVarType' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%Name) + call RegPack(RF, InData%Field) + call RegPack(RF, InData%Nodes) + call RegPack(RF, InData%Num) + call RegPack(RF, InData%Flags) + call RegPack(RF, InData%DerivOrder) + call RegPackAlloc(RF, InData%iLoc) + call RegPackAlloc(RF, InData%iSol) + call RegPackAlloc(RF, InData%iLin) + call RegPackAlloc(RF, InData%iq) + call RegPack(RF, InData%iUsr) + call RegPack(RF, InData%jUsr) + call RegPack(RF, InData%MeshID) + call RegPack(RF, InData%Solve) + call RegPack(RF, InData%Perturb) + call RegPackAlloc(RF, InData%LinNames) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine NWTC_Library_UnPackModVarType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(ModVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'NWTC_Library_UnPackModVarType' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%Name); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Field); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Nodes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Num); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Flags); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DerivOrder); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%iLoc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%iSol); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%iLin); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%iq); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iUsr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%jUsr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MeshID); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Solve); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Perturb); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LinNames); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine NWTC_Library_CopyModVarsType(SrcModVarsTypeData, DstModVarsTypeData, CtrlCode, ErrStat, ErrMsg) + type(ModVarsType), intent(in) :: SrcModVarsTypeData + type(ModVarsType), intent(inout) :: DstModVarsTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'NWTC_Library_CopyModVarsType' + ErrStat = ErrID_None + ErrMsg = '' + DstModVarsTypeData%ModNum = SrcModVarsTypeData%ModNum + DstModVarsTypeData%ModAbbr = SrcModVarsTypeData%ModAbbr + if (allocated(SrcModVarsTypeData%x)) then + LB(1:1) = lbound(SrcModVarsTypeData%x) + UB(1:1) = ubound(SrcModVarsTypeData%x) + if (.not. allocated(DstModVarsTypeData%x)) then + allocate(DstModVarsTypeData%x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModVarsTypeData%x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyModVarType(SrcModVarsTypeData%x(i1), DstModVarsTypeData%x(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcModVarsTypeData%u)) then + LB(1:1) = lbound(SrcModVarsTypeData%u) + UB(1:1) = ubound(SrcModVarsTypeData%u) + if (.not. allocated(DstModVarsTypeData%u)) then + allocate(DstModVarsTypeData%u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModVarsTypeData%u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyModVarType(SrcModVarsTypeData%u(i1), DstModVarsTypeData%u(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcModVarsTypeData%y)) then + LB(1:1) = lbound(SrcModVarsTypeData%y) + UB(1:1) = ubound(SrcModVarsTypeData%y) + if (.not. allocated(DstModVarsTypeData%y)) then + allocate(DstModVarsTypeData%y(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModVarsTypeData%y.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyModVarType(SrcModVarsTypeData%y(i1), DstModVarsTypeData%y(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + DstModVarsTypeData%Nx = SrcModVarsTypeData%Nx + DstModVarsTypeData%Nu = SrcModVarsTypeData%Nu + DstModVarsTypeData%Ny = SrcModVarsTypeData%Ny +end subroutine + +subroutine NWTC_Library_DestroyModVarsType(ModVarsTypeData, ErrStat, ErrMsg) + type(ModVarsType), intent(inout) :: ModVarsTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'NWTC_Library_DestroyModVarsType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ModVarsTypeData%x)) then + LB(1:1) = lbound(ModVarsTypeData%x) + UB(1:1) = ubound(ModVarsTypeData%x) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyModVarType(ModVarsTypeData%x(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ModVarsTypeData%x) + end if + if (allocated(ModVarsTypeData%u)) then + LB(1:1) = lbound(ModVarsTypeData%u) + UB(1:1) = ubound(ModVarsTypeData%u) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyModVarType(ModVarsTypeData%u(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ModVarsTypeData%u) + end if + if (allocated(ModVarsTypeData%y)) then + LB(1:1) = lbound(ModVarsTypeData%y) + UB(1:1) = ubound(ModVarsTypeData%y) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyModVarType(ModVarsTypeData%y(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ModVarsTypeData%y) + end if +end subroutine + +subroutine NWTC_Library_PackModVarsType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(ModVarsType), intent(in) :: InData + character(*), parameter :: RoutineName = 'NWTC_Library_PackModVarsType' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%ModNum) + call RegPack(RF, InData%ModAbbr) + call RegPack(RF, allocated(InData%x)) + if (allocated(InData%x)) then + call RegPackBounds(RF, 1, lbound(InData%x), ubound(InData%x)) + LB(1:1) = lbound(InData%x) + UB(1:1) = ubound(InData%x) + do i1 = LB(1), UB(1) + call NWTC_Library_PackModVarType(RF, InData%x(i1)) + end do + end if + call RegPack(RF, allocated(InData%u)) + if (allocated(InData%u)) then + call RegPackBounds(RF, 1, lbound(InData%u), ubound(InData%u)) + LB(1:1) = lbound(InData%u) + UB(1:1) = ubound(InData%u) + do i1 = LB(1), UB(1) + call NWTC_Library_PackModVarType(RF, InData%u(i1)) + end do + end if + call RegPack(RF, allocated(InData%y)) + if (allocated(InData%y)) then + call RegPackBounds(RF, 1, lbound(InData%y), ubound(InData%y)) + LB(1:1) = lbound(InData%y) + UB(1:1) = ubound(InData%y) + do i1 = LB(1), UB(1) + call NWTC_Library_PackModVarType(RF, InData%y(i1)) + end do + end if + call RegPack(RF, InData%Nx) + call RegPack(RF, InData%Nu) + call RegPack(RF, InData%Ny) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine NWTC_Library_UnPackModVarsType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(ModVarsType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'NWTC_Library_UnPackModVarsType' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%ModNum); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ModAbbr); if (RegCheckErr(RF, RoutineName)) return + if (allocated(OutData%x)) deallocate(OutData%x) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%x(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackModVarType(RF, OutData%x(i1)) ! x + end do + end if + if (allocated(OutData%u)) deallocate(OutData%u) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%u(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackModVarType(RF, OutData%u(i1)) ! u + end do + end if + if (allocated(OutData%y)) deallocate(OutData%y) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%y(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%y.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackModVarType(RF, OutData%y(i1)) ! y + end do + end if + call RegUnpack(RF, OutData%Nx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Nu); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Ny); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine NWTC_Library_CopyModValsType(SrcModValsTypeData, DstModValsTypeData, CtrlCode, ErrStat, ErrMsg) + type(ModValsType), intent(in) :: SrcModValsTypeData + type(ModValsType), intent(inout) :: DstModValsTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'NWTC_Library_CopyModValsType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcModValsTypeData%x)) then + LB(1:1) = lbound(SrcModValsTypeData%x) + UB(1:1) = ubound(SrcModValsTypeData%x) + if (.not. allocated(DstModValsTypeData%x)) then + allocate(DstModValsTypeData%x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModValsTypeData%x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModValsTypeData%x = SrcModValsTypeData%x + end if + if (allocated(SrcModValsTypeData%dxdt)) then + LB(1:1) = lbound(SrcModValsTypeData%dxdt) + UB(1:1) = ubound(SrcModValsTypeData%dxdt) + if (.not. allocated(DstModValsTypeData%dxdt)) then + allocate(DstModValsTypeData%dxdt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModValsTypeData%dxdt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModValsTypeData%dxdt = SrcModValsTypeData%dxdt + end if + if (allocated(SrcModValsTypeData%u)) then + LB(1:1) = lbound(SrcModValsTypeData%u) + UB(1:1) = ubound(SrcModValsTypeData%u) + if (.not. allocated(DstModValsTypeData%u)) then + allocate(DstModValsTypeData%u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModValsTypeData%u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModValsTypeData%u = SrcModValsTypeData%u + end if + if (allocated(SrcModValsTypeData%y)) then + LB(1:1) = lbound(SrcModValsTypeData%y) + UB(1:1) = ubound(SrcModValsTypeData%y) + if (.not. allocated(DstModValsTypeData%y)) then + allocate(DstModValsTypeData%y(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModValsTypeData%y.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModValsTypeData%y = SrcModValsTypeData%y + end if + if (allocated(SrcModValsTypeData%u_perturb)) then + LB(1:1) = lbound(SrcModValsTypeData%u_perturb) + UB(1:1) = ubound(SrcModValsTypeData%u_perturb) + if (.not. allocated(DstModValsTypeData%u_perturb)) then + allocate(DstModValsTypeData%u_perturb(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModValsTypeData%u_perturb.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModValsTypeData%u_perturb = SrcModValsTypeData%u_perturb + end if + if (allocated(SrcModValsTypeData%x_perturb)) then + LB(1:1) = lbound(SrcModValsTypeData%x_perturb) + UB(1:1) = ubound(SrcModValsTypeData%x_perturb) + if (.not. allocated(DstModValsTypeData%x_perturb)) then + allocate(DstModValsTypeData%x_perturb(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModValsTypeData%x_perturb.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModValsTypeData%x_perturb = SrcModValsTypeData%x_perturb + end if + if (allocated(SrcModValsTypeData%xp)) then + LB(1:1) = lbound(SrcModValsTypeData%xp) + UB(1:1) = ubound(SrcModValsTypeData%xp) + if (.not. allocated(DstModValsTypeData%xp)) then + allocate(DstModValsTypeData%xp(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModValsTypeData%xp.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModValsTypeData%xp = SrcModValsTypeData%xp + end if + if (allocated(SrcModValsTypeData%xn)) then + LB(1:1) = lbound(SrcModValsTypeData%xn) + UB(1:1) = ubound(SrcModValsTypeData%xn) + if (.not. allocated(DstModValsTypeData%xn)) then + allocate(DstModValsTypeData%xn(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModValsTypeData%xn.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModValsTypeData%xn = SrcModValsTypeData%xn + end if + if (allocated(SrcModValsTypeData%yp)) then + LB(1:1) = lbound(SrcModValsTypeData%yp) + UB(1:1) = ubound(SrcModValsTypeData%yp) + if (.not. allocated(DstModValsTypeData%yp)) then + allocate(DstModValsTypeData%yp(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModValsTypeData%yp.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModValsTypeData%yp = SrcModValsTypeData%yp + end if + if (allocated(SrcModValsTypeData%yn)) then + LB(1:1) = lbound(SrcModValsTypeData%yn) + UB(1:1) = ubound(SrcModValsTypeData%yn) + if (.not. allocated(DstModValsTypeData%yn)) then + allocate(DstModValsTypeData%yn(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModValsTypeData%yn.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModValsTypeData%yn = SrcModValsTypeData%yn + end if + if (allocated(SrcModValsTypeData%dYdx)) then + LB(1:2) = lbound(SrcModValsTypeData%dYdx) + UB(1:2) = ubound(SrcModValsTypeData%dYdx) + if (.not. allocated(DstModValsTypeData%dYdx)) then + allocate(DstModValsTypeData%dYdx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModValsTypeData%dYdx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModValsTypeData%dYdx = SrcModValsTypeData%dYdx + end if + if (allocated(SrcModValsTypeData%dXdx)) then + LB(1:2) = lbound(SrcModValsTypeData%dXdx) + UB(1:2) = ubound(SrcModValsTypeData%dXdx) + if (.not. allocated(DstModValsTypeData%dXdx)) then + allocate(DstModValsTypeData%dXdx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModValsTypeData%dXdx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModValsTypeData%dXdx = SrcModValsTypeData%dXdx + end if + if (allocated(SrcModValsTypeData%dYdu)) then + LB(1:2) = lbound(SrcModValsTypeData%dYdu) + UB(1:2) = ubound(SrcModValsTypeData%dYdu) + if (.not. allocated(DstModValsTypeData%dYdu)) then + allocate(DstModValsTypeData%dYdu(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModValsTypeData%dYdu.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModValsTypeData%dYdu = SrcModValsTypeData%dYdu + end if + if (allocated(SrcModValsTypeData%dXdu)) then + LB(1:2) = lbound(SrcModValsTypeData%dXdu) + UB(1:2) = ubound(SrcModValsTypeData%dXdu) + if (.not. allocated(DstModValsTypeData%dXdu)) then + allocate(DstModValsTypeData%dXdu(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModValsTypeData%dXdu.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModValsTypeData%dXdu = SrcModValsTypeData%dXdu + end if +end subroutine + +subroutine NWTC_Library_DestroyModValsType(ModValsTypeData, ErrStat, ErrMsg) + type(ModValsType), intent(inout) :: ModValsTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'NWTC_Library_DestroyModValsType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ModValsTypeData%x)) then + deallocate(ModValsTypeData%x) + end if + if (allocated(ModValsTypeData%dxdt)) then + deallocate(ModValsTypeData%dxdt) + end if + if (allocated(ModValsTypeData%u)) then + deallocate(ModValsTypeData%u) + end if + if (allocated(ModValsTypeData%y)) then + deallocate(ModValsTypeData%y) + end if + if (allocated(ModValsTypeData%u_perturb)) then + deallocate(ModValsTypeData%u_perturb) + end if + if (allocated(ModValsTypeData%x_perturb)) then + deallocate(ModValsTypeData%x_perturb) + end if + if (allocated(ModValsTypeData%xp)) then + deallocate(ModValsTypeData%xp) + end if + if (allocated(ModValsTypeData%xn)) then + deallocate(ModValsTypeData%xn) + end if + if (allocated(ModValsTypeData%yp)) then + deallocate(ModValsTypeData%yp) + end if + if (allocated(ModValsTypeData%yn)) then + deallocate(ModValsTypeData%yn) + end if + if (allocated(ModValsTypeData%dYdx)) then + deallocate(ModValsTypeData%dYdx) + end if + if (allocated(ModValsTypeData%dXdx)) then + deallocate(ModValsTypeData%dXdx) + end if + if (allocated(ModValsTypeData%dYdu)) then + deallocate(ModValsTypeData%dYdu) + end if + if (allocated(ModValsTypeData%dXdu)) then + deallocate(ModValsTypeData%dXdu) + end if +end subroutine + +subroutine NWTC_Library_PackModValsType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(ModValsType), intent(in) :: InData + character(*), parameter :: RoutineName = 'NWTC_Library_PackModValsType' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%x) + call RegPackAlloc(RF, InData%dxdt) + call RegPackAlloc(RF, InData%u) + call RegPackAlloc(RF, InData%y) + call RegPackAlloc(RF, InData%u_perturb) + call RegPackAlloc(RF, InData%x_perturb) + call RegPackAlloc(RF, InData%xp) + call RegPackAlloc(RF, InData%xn) + call RegPackAlloc(RF, InData%yp) + call RegPackAlloc(RF, InData%yn) + call RegPackAlloc(RF, InData%dYdx) + call RegPackAlloc(RF, InData%dXdx) + call RegPackAlloc(RF, InData%dYdu) + call RegPackAlloc(RF, InData%dXdu) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine NWTC_Library_UnPackModValsType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(ModValsType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'NWTC_Library_UnPackModValsType' + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%x); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dxdt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%u); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%u_perturb); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%x_perturb); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%xp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%xn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%yp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%yn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dYdx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dXdx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dYdu); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dXdu); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine NWTC_Library_CopyModDataType(SrcModDataTypeData, DstModDataTypeData, CtrlCode, ErrStat, ErrMsg) + type(ModDataType), intent(in) :: SrcModDataTypeData + type(ModDataType), intent(inout) :: DstModDataTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'NWTC_Library_CopyModDataType' + ErrStat = ErrID_None + ErrMsg = '' + DstModDataTypeData%Idx = SrcModDataTypeData%Idx + DstModDataTypeData%ID = SrcModDataTypeData%ID + DstModDataTypeData%Abbr = SrcModDataTypeData%Abbr + DstModDataTypeData%Ins = SrcModDataTypeData%Ins + DstModDataTypeData%IsTC = SrcModDataTypeData%IsTC + DstModDataTypeData%DT = SrcModDataTypeData%DT + DstModDataTypeData%SubSteps = SrcModDataTypeData%SubSteps + if (allocated(SrcModDataTypeData%ixs)) then + LB(1:2) = lbound(SrcModDataTypeData%ixs) + UB(1:2) = ubound(SrcModDataTypeData%ixs) + if (.not. allocated(DstModDataTypeData%ixs)) then + allocate(DstModDataTypeData%ixs(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModDataTypeData%ixs.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModDataTypeData%ixs = SrcModDataTypeData%ixs + end if + if (allocated(SrcModDataTypeData%ius)) then + LB(1:2) = lbound(SrcModDataTypeData%ius) + UB(1:2) = ubound(SrcModDataTypeData%ius) + if (.not. allocated(DstModDataTypeData%ius)) then + allocate(DstModDataTypeData%ius(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModDataTypeData%ius.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModDataTypeData%ius = SrcModDataTypeData%ius + end if + if (allocated(SrcModDataTypeData%iys)) then + LB(1:2) = lbound(SrcModDataTypeData%iys) + UB(1:2) = ubound(SrcModDataTypeData%iys) + if (.not. allocated(DstModDataTypeData%iys)) then + allocate(DstModDataTypeData%iys(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModDataTypeData%iys.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModDataTypeData%iys = SrcModDataTypeData%iys + end if + DstModDataTypeData%Vars => SrcModDataTypeData%Vars + if (allocated(SrcModDataTypeData%SrcMaps)) then + LB(1:1) = lbound(SrcModDataTypeData%SrcMaps) + UB(1:1) = ubound(SrcModDataTypeData%SrcMaps) + if (.not. allocated(DstModDataTypeData%SrcMaps)) then + allocate(DstModDataTypeData%SrcMaps(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModDataTypeData%SrcMaps.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModDataTypeData%SrcMaps = SrcModDataTypeData%SrcMaps + end if + if (allocated(SrcModDataTypeData%DstMaps)) then + LB(1:1) = lbound(SrcModDataTypeData%DstMaps) + UB(1:1) = ubound(SrcModDataTypeData%DstMaps) + if (.not. allocated(DstModDataTypeData%DstMaps)) then + allocate(DstModDataTypeData%DstMaps(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModDataTypeData%DstMaps.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModDataTypeData%DstMaps = SrcModDataTypeData%DstMaps + end if +end subroutine + +subroutine NWTC_Library_DestroyModDataType(ModDataTypeData, ErrStat, ErrMsg) + type(ModDataType), intent(inout) :: ModDataTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'NWTC_Library_DestroyModDataType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ModDataTypeData%ixs)) then + deallocate(ModDataTypeData%ixs) + end if + if (allocated(ModDataTypeData%ius)) then + deallocate(ModDataTypeData%ius) + end if + if (allocated(ModDataTypeData%iys)) then + deallocate(ModDataTypeData%iys) + end if + nullify(ModDataTypeData%Vars) + if (allocated(ModDataTypeData%SrcMaps)) then + deallocate(ModDataTypeData%SrcMaps) + end if + if (allocated(ModDataTypeData%DstMaps)) then + deallocate(ModDataTypeData%DstMaps) + end if +end subroutine + +subroutine NWTC_Library_PackModDataType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(ModDataType), intent(in) :: InData + character(*), parameter :: RoutineName = 'NWTC_Library_PackModDataType' + logical :: PtrInIndex + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%Idx) + call RegPack(RF, InData%ID) + call RegPack(RF, InData%Abbr) + call RegPack(RF, InData%Ins) + call RegPack(RF, InData%IsTC) + call RegPack(RF, InData%DT) + call RegPack(RF, InData%SubSteps) + call RegPackAlloc(RF, InData%ixs) + call RegPackAlloc(RF, InData%ius) + call RegPackAlloc(RF, InData%iys) + call RegPack(RF, associated(InData%Vars)) + if (associated(InData%Vars)) then + call RegPackPointer(RF, c_loc(InData%Vars), PtrInIndex) + if (.not. PtrInIndex) then + call NWTC_Library_PackModVarsType(RF, InData%Vars) + end if + end if + call RegPackAlloc(RF, InData%SrcMaps) + call RegPackAlloc(RF, InData%DstMaps) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine NWTC_Library_UnPackModDataType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(ModDataType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'NWTC_Library_UnPackModDataType' + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(B8Ki) :: PtrIdx + type(c_ptr) :: Ptr + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%Idx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ID); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Abbr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Ins); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%IsTC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SubSteps); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ixs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ius); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%iys); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%Vars)) deallocate(OutData%Vars) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackPointer(RF, Ptr, PtrIdx); if (RegCheckErr(RF, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%Vars) + else + allocate(OutData%Vars,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vars.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + RF%Pointers(PtrIdx) = c_loc(OutData%Vars) + call NWTC_Library_UnpackModVarsType(RF, OutData%Vars) ! Vars + end if + else + OutData%Vars => null() + end if + call RegUnpackAlloc(RF, OutData%SrcMaps); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%DstMaps); if (RegCheckErr(RF, RoutineName)) return +end subroutine END MODULE NWTC_Library_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/nwtc-library/src/NWTC_Num.f90 b/modules/nwtc-library/src/NWTC_Num.f90 index 8d7eb9338d..4316131007 100644 --- a/modules/nwtc-library/src/NWTC_Num.f90 +++ b/modules/nwtc-library/src/NWTC_Num.f90 @@ -103,6 +103,7 @@ MODULE NWTC_Num END INTERFACE INTERFACE EulerConstructZYX + MODULE PROCEDURE EulerConstructZYXR4 MODULE PROCEDURE EulerConstructZYXR8 END INTERFACE @@ -112,6 +113,17 @@ MODULE NWTC_Num MODULE PROCEDURE EulerExtractR8 END INTERFACE + INTERFACE EulerExtractZYX + MODULE PROCEDURE EulerExtractZYXR4 + MODULE PROCEDURE EulerExtractZYXR8 + END INTERFACE + + !> \copydoc nwtc_num::fzero_r4() + INTERFACE fZeros + MODULE PROCEDURE fzero_r4 + MODULE PROCEDURE fzero_r8 + END INTERFACE + !> \copydoc nwtc_num::taitbryanyxzextractr4() !! See nwtc_num::taitbryanyxzextractr4() for details on the algorithm INTERFACE TaitBryanYXZExtract @@ -209,6 +221,13 @@ MODULE NWTC_Num MODULE PROCEDURE InterpStpReal8 END INTERFACE + !> \copydoc nwtc_num::interpstpmat4 + INTERFACE InterpStpMat + MODULE PROCEDURE InterpStpMat4 + MODULE PROCEDURE InterpStpMat8 + END INTERFACE + + !> \copydoc nwtc_num::interparrayr4 INTERFACE InterpArray MODULE PROCEDURE InterpArrayR4 @@ -1680,8 +1699,8 @@ FUNCTION EqualRealNos8 ( ReNum1, ReNum2 ) END FUNCTION EqualRealNos8 !======================================================================= -!> This function creates a rotation matrix, M, from a 1-2-3 rotation -!! sequence of the 3 Euler angles, \f$\theta_x\f$, \f$\theta_y\f$, and \f$\theta_z\f$, in radians. +!> This function creates a rotation matrix, M, from a 3-2-1 intrinsic rotation +!! sequence of the 3 Tait-Bryan angles (1-2-3 extrinsic rotation), \f$\theta_x\f$, \f$\theta_y\f$, and \f$\theta_z\f$, in radians. !! M represents a change of basis (from global to local coordinates; !! not a physical rotation of the body). It is the inverse of EulerExtract (nwtc_num::eulerextract). !! @@ -1745,8 +1764,8 @@ END FUNCTION EulerConstructR4 !> \copydoc nwtc_num::eulerconstructr4 FUNCTION EulerConstructR8(theta) result(M) - ! this function creates a rotation matrix, M, from a 1-2-3 rotation - ! sequence of the 3 Euler angles, theta_x, theta_y, and theta_z, in radians. + ! this function creates a rotation matrix, M, from a 3-2-1 intrinsic rotation +!! sequence of the 3 Tait-Bryan angles (1-2-3 extrinsic rotation), theta_x, theta_y, and theta_z, in radians. ! M represents a change of basis (from global to local coordinates; ! not a physical rotation of the body). it is the inverse of EulerExtract (nwtc_num::eulerextract). ! @@ -2037,6 +2056,245 @@ FUNCTION EulerConstructZYXR8(theta) result(M) M(3,3) = cx*cy END FUNCTION EulerConstructZYXR8 + +!======================================================================= +!> + FUNCTION EulerConstructZYXR4(theta) result(M) + + ! this function creates a rotation matrix, M, from a 3-2-1 rotation + ! sequence of the 3 Euler angles, theta_z, theta_y, and theta_x, in radians. + ! M represents a change of basis (from global to local coordinates; + ! not a physical rotation of the body). + ! + REAL(SiKi) :: M(3,3) ! rotation matrix M + REAL(SiKi), INTENT(IN) :: theta(3) ! the 3 rotation angles: theta_x, theta_y, theta_z + + REAL(SiKi) :: cx ! cos(theta_x) + REAL(SiKi) :: sx ! sin(theta_x) + REAL(SiKi) :: cy ! cos(theta_y) + REAL(SiKi) :: sy ! sin(theta_y) + REAL(SiKi) :: cz ! cos(theta_z) + REAL(SiKi) :: sz ! sin(theta_z) + + + cx = cos( theta(1) ) + sx = sin( theta(1) ) + + cy = cos( theta(2) ) + sy = sin( theta(2) ) + + cz = cos( theta(3) ) + sz = sin( theta(3) ) + + M(1,1) = cy*cz + M(2,1) = sx*sy*cz - sz*cx + M(3,1) = sx*sz + sy*cx*cz + + M(1,2) = sz*cy + M(2,2) = sx*sy*sz + cx*cz + M(3,2) = -sx*cz + sy*sz*cx + + M(1,3) = -sy + M(2,3) = sx*cy + M(3,3) = cx*cy + + END FUNCTION EulerConstructZYXR4 + + +!======================================================================= +!> + FUNCTION EulerExtractZYXR8(M) result(theta) + + ! if M is a rotation matrix from a 3-2-1 rotation sequence, this function returns + ! the 3 Euler angles, theta_x, theta_y, and theta_z (in radians), that formed + ! the matrix. M represents a change of basis (from global to local coordinates; + ! not a physical rotation of the body). M is the inverse of EulerConstruct(). + ! + ! M = R(theta_x) * R(theta_y) * R(theta_z) + ! = [ 1 0 0 | [ cy 0 -sy | [ cz sz 0 | + ! | 0 cx sx | * | 0 1 0 | * |-sz cz 0 | + ! | 0 -sx cx ] | sy 0 cy ] | 0 0 1 ] + ! = [cy*cz sz*cy -sy| + ! |sx*sy*cz-sz*cx sx*sy*sz+cx*cz sx*cy| + ! |sx*sz+sy*cx*cz -sx*cz+sy*sz*cx cx*cy] + ! where cz = cos(theta_z), sz = sin(theta_z), cy = cos(theta_y), etc. + ! + ! returned angles are in the range [-pi, pi] + + REAL(R8Ki), INTENT(IN) :: M(3,3) ! rotation matrix M + REAL(R8Ki) :: theta(3) ! the 3 rotation angles: theta_x, theta_y, theta_z + + REAL(R8Ki) :: cx ! cos(theta_x) + REAL(R8Ki) :: sx ! sin(theta_x) + REAL(R8Ki) :: cy ! cos(theta_y) +! REAL(R8Ki) :: sy ! sin(theta_y) + REAL(R8Ki) :: cz ! cos(theta_z) + REAL(R8Ki) :: sz ! sin(theta_z) + + ! use trig identity sz**2 + cz**2 = 1 to get abs(cy): + cy = sqrt( m(1,1)**2 + m(1,2)**2 ) +! cy = sqrt( m(3,3)**2 + m(2,3)**2 ) + + if ( EqualRealNos(cy,0.0_R8Ki) ) then + !if ( cy < 16*epsilon(0.0_ReKi) ) then + + theta(2) = atan2( -m(1,3), cy ) ! theta_y + + ! cy = 0 -> sy = +/-1 + ! M = [0 0 +/-1| + ! |+/-sx*cz-sz*cx +/-sx*sz+cx*cz 0| + ! |sx*sz+/-cx*cz -sx*cz+/-sz*cx 0] + + ! gimbal lock allows us to choose theta_z = 0 + theta(3) = 0.0_R8Ki ! theta_z + + ! which reduces the matrix to + ! M = [0 0 +/-1| + ! |+/-sx cx 0| + ! |+/-cx -sx 0] + + theta(1) = atan2( -m(3,2), m(2,2) ) ! theta_x + + else + ! atan2( cy*sz, cy*cz ) + theta(3) = atan2( m(1,2), m(1,1) ) ! theta_z + cz = cos( theta(3) ) + sz = sin( theta(3) ) + + ! get the appropriate sign for cy: + if ( EqualRealNos(cz, 0.0_R8Ki) ) then + cy = sign( cy, m(1,2)/sz ) + !cy = m(1,2)/sz + else + cy = sign( cy, m(1,1)/cz ) + !cy = m(1,1)/cz + end if + theta(2) = atan2( -m(1,3), cy ) ! theta_y + + !theta(1) = atan2( m(2,3), m(3,3) ) ! theta_x + + ! for numerical reasons, we're going to get theta_x using + ! M' = M * (R(theta_y)*R(theta_z))^T = R(theta_x) + ! = [ cz -sz 0 | [ cy 0 sy | [ 1 0 0 | + ! M * | sz cz 0 | * | 0 1 0 | = | 0 cx sx | + ! | 0 0 1 ] |-sy 0 cy ] | 0 -sx cx ] + ! = [ cy*cz -sz sy*cz | [ 1 0 0 | + ! M * | cy*sz cz sy*sz | = | 0 cx sx | + ! | -sy 0 cy ] | 0 -sx cx ] + ! taking M'(2,2) and M'(2,3) , we get cx and sx: + ! -sz*m(2,1) + cz*m(2,2) = cx + ! -sz*m(3,1) + cz*m(3,2) = -sx + + cz = cos( theta(3) ) + sz = sin( theta(3) ) + + cx = -sz*m(2,1) + cz*m(2,2) + sx = sz*m(3,1) - cz*m(3,2) + + theta(1) = atan2( sx, cx ) + + end if + + + END FUNCTION EulerExtractZYXR8 + +!======================================================================= +!> + FUNCTION EulerExtractZYXR4(M) result(theta) + + ! if M is a rotation matrix from a 3-2-1 rotation sequence, this function returns + ! the 3 Euler angles, theta_x, theta_y, and theta_z (in radians), that formed + ! the matrix. M represents a change of basis (from global to local coordinates; + ! not a physical rotation of the body). M is the inverse of EulerConstruct(). + ! + ! M = R(theta_x) * R(theta_y) * R(theta_z) + ! = [ 1 0 0 | [ cy 0 -sy | [ cz sz 0 | + ! | 0 cx sx | * | 0 1 0 | * |-sz cz 0 | + ! | 0 -sx cx ] | sy 0 cy ] | 0 0 1 ] + ! = [cy*cz sz*cy -sy| + ! |sx*sy*cz-sz*cx sx*sy*sz+cx*cz sx*cy| + ! |sx*sz+sy*cx*cz -sx*cz+sy*sz*cx cx*cy] + ! where cz = cos(theta_z), sz = sin(theta_z), cy = cos(theta_y), etc. + ! + ! returned angles are in the range [-pi, pi] + + REAL(SiKi), INTENT(IN) :: M(3,3) ! rotation matrix M + REAL(SiKi) :: theta(3) ! the 3 rotation angles: theta_x, theta_y, theta_z + + REAL(SiKi) :: cx ! cos(theta_x) + REAL(SiKi) :: sx ! sin(theta_x) + REAL(SiKi) :: cy ! cos(theta_y) +! REAL(SiKi) :: sy ! sin(theta_y) + REAL(SiKi) :: cz ! cos(theta_z) + REAL(SiKi) :: sz ! sin(theta_z) + + ! use trig identity sz**2 + cz**2 = 1 to get abs(cy): + cy = sqrt( m(1,1)**2 + m(1,2)**2 ) +! cy = sqrt( m(3,3)**2 + m(2,3)**2 ) + + if ( EqualRealNos(cy,0.0_SiKi) ) then + !if ( cy < 16*epsilon(0.0_ReKi) ) then + + theta(2) = atan2( -m(1,3), cy ) ! theta_y + + ! cy = 0 -> sy = +/-1 + ! M = [0 0 +/-1| + ! |+/-sx*cz-sz*cx +/-sx*sz+cx*cz 0| + ! |sx*sz+/-cx*cz -sx*cz+/-sz*cx 0] + + ! gimbal lock allows us to choose theta_z = 0 + theta(3) = 0.0_SiKi ! theta_z + + ! which reduces the matrix to + ! M = [0 0 +/-1| + ! |+/-sx cx 0| + ! |+/-cx -sx 0] + + theta(1) = atan2( -m(3,2), m(2,2) ) ! theta_x + + else + ! atan2( cy*sz, cy*cz ) + theta(3) = atan2( m(1,2), m(1,1) ) ! theta_z + cz = cos( theta(3) ) + sz = sin( theta(3) ) + + ! get the appropriate sign for cy: + if ( EqualRealNos(cz, 0.0_SiKi) ) then + cy = sign( cy, m(1,2)/sz ) + !cy = m(1,2)/sz + else + cy = sign( cy, m(1,1)/cz ) + !cy = m(1,1)/cz + end if + theta(2) = atan2( -m(1,3), cy ) ! theta_y + + !theta(1) = atan2( m(2,3), m(3,3) ) ! theta_x + + ! for numerical reasons, we're going to get theta_x using + ! M' = M * (R(theta_y)*R(theta_z))^T = R(theta_x) + ! = [ cz -sz 0 | [ cy 0 sy | [ 1 0 0 | + ! M * | sz cz 0 | * | 0 1 0 | = | 0 cx sx | + ! | 0 0 1 ] |-sy 0 cy ] | 0 -sx cx ] + ! = [ cy*cz -sz sy*cz | [ 1 0 0 | + ! M * | cy*sz cz sy*sz | = | 0 cx sx | + ! | -sy 0 cy ] | 0 -sx cx ] + ! taking M'(2,2) and M'(2,3) , we get cx and sx: + ! -sz*m(2,1) + cz*m(2,2) = cx + ! -sz*m(3,1) + cz*m(3,2) = -sx + + cz = cos( theta(3) ) + sz = sin( theta(3) ) + + cx = -sz*m(2,1) + cz*m(2,2) + sx = sz*m(3,1) - cz*m(3,2) + + theta(1) = atan2( sx, cx ) + + end if + + + END FUNCTION EulerExtractZYXR4 + !======================================================================= !> This routine sets the matrices in the first two dimensions of A equal !! to the identity matrix (all zeros, with ones on the diagonal). @@ -2999,7 +3257,75 @@ FUNCTION InterpStpComp8( XVal, XAry, YAry, Ind, AryLen ) RETURN END FUNCTION InterpStpComp8 +!======================================================================= +!> Routine to interpolate and/or extrapolate + FUNCTION InterpExtrapStp( XVal, XAry, YAry, Ind, AryLen ) RESULT(InterpExtrap) + + ! Function declaration. + + REAL(ReKi) :: InterpExtrap !< The interpolated or extrapolated value of Y at XVal + + + ! Argument declarations. + + INTEGER, INTENT(IN) :: AryLen ! Length of the arrays. + INTEGER, INTENT(INOUT) :: Ind ! Initial and final index into the arrays. + + REAL(ReKi), INTENT(IN) :: XAry (AryLen) ! Array of X values to be interpolated. + REAL(ReKi), INTENT(IN) :: XVal ! X value to be interpolated. + REAL(ReKi), INTENT(IN) :: YAry (AryLen) ! Array of Y values to be interpolated. + + + + ! Let's check the limits first. + IF (AryLen < 2) THEN + Ind = 1 + InterpExtrap = YAry(1) + RETURN + END IF + + IF ( XVal <= XAry(1) ) THEN + Ind = 1 + InterpExtrap = GetLinearVal() ! extrapolate (using slope of x(1) and x(2)) + RETURN + ELSE IF ( XVal >= XAry(AryLen) ) THEN + Ind = MAX(AryLen - 1, 1) + InterpExtrap = GetLinearVal() ! extrapolate (using slope of x(AryLen-1) and x(AryLen)) + RETURN + END IF + + + ! Let's interpolate! + + Ind = MAX( MIN( Ind, AryLen-1 ), 1 ) + + DO + + IF ( XVal < XAry(Ind) ) THEN + + Ind = Ind - 1 + + ELSE IF ( XVal >= XAry(Ind+1) ) THEN + + Ind = Ind + 1 + ELSE + + InterpExtrap = GetLinearVal() + RETURN + + END IF + + END DO + + + RETURN + + contains + real(ReKi) function GetLinearVal() + GetLinearVal = ( YAry(Ind+1) - YAry(Ind) )*( XVal - XAry(Ind) )/( XAry(Ind+1) - XAry(Ind) ) + YAry(Ind) + end function GetLinearVal + END FUNCTION InterpExtrapStp !======================================================================= !> \copydoc nwtc_num::interpstpcomp4 FUNCTION InterpStpReal4( XVal, XAry, YAry, Ind, AryLen ) @@ -3184,11 +3510,11 @@ END FUNCTION InterpStpReal8 !! especially useful when the calling routines save the value from the last time this routine was called !! for a given case where XVal does not change much from call to call. !! It returns the first or last Y() row value if XVal is outside the limits of XAry(). - SUBROUTINE InterpStpMat( XVal, XAry, Y, Ind, AryLen, yInterp ) + SUBROUTINE InterpStpMat4( XVal, XAry, Y, Ind, AryLen, yInterp ) ! Function declaration. - REAL(ReKi), intent(out) :: yInterp(:) !< The interpolated value(s) of Y(dim=2) at XVal + REAL(R4Ki), intent(out) :: yInterp(:) !< The interpolated value(s) of Y(dim=2) at XVal ! Argument declarations. @@ -3196,9 +3522,9 @@ SUBROUTINE InterpStpMat( XVal, XAry, Y, Ind, AryLen, yInterp ) INTEGER, INTENT(IN) :: AryLen !< Length of the arrays. INTEGER, INTENT(INOUT) :: Ind !< Initial and final index into the arrays. - REAL(ReKi), INTENT(IN) :: XAry (AryLen) !< Array of X values to be interpolated. - REAL(ReKi), INTENT(IN) :: XVal !< X value to be interpolated. - REAL(ReKi), INTENT(IN) :: Y (:,:) !< Matrix of Y values to be interpolated; First dimension is AryLen. + REAL(R4Ki), INTENT(IN) :: XAry (AryLen) !< Array of X values to be interpolated. + REAL(R4Ki), INTENT(IN) :: XVal !< X value to be interpolated. + REAL(R4Ki), INTENT(IN) :: Y (:,:) !< Matrix of Y values to be interpolated; First dimension is AryLen. @@ -3240,7 +3566,108 @@ SUBROUTINE InterpStpMat( XVal, XAry, Y, Ind, AryLen, yInterp ) RETURN - END SUBROUTINE InterpStpMat + END SUBROUTINE InterpStpMat4 +!======================================================================= +!> This funtion returns a y-value array that corresponds to an input x-value by interpolating into the arrays. +!! It uses the passed index as the starting point and does a stepwise interpolation from there. This is +!! especially useful when the calling routines save the value from the last time this routine was called +!! for a given case where XVal does not change much from call to call. +!! It returns the first or last Y() row value if XVal is outside the limits of XAry(). + SUBROUTINE InterpStpMat8( XVal, XAry, Y, Ind, AryLen, yInterp ) + + ! Function declaration. + + REAL(R8Ki), intent(out) :: yInterp(:) !< The interpolated value(s) of Y(dim=2) at XVal + + + ! Argument declarations. + + INTEGER, INTENT(IN) :: AryLen !< Length of the arrays. + INTEGER, INTENT(INOUT) :: Ind !< Initial and final index into the arrays. + + REAL(R8Ki), INTENT(IN) :: XAry (AryLen) !< Array of X values to be interpolated. + REAL(R8Ki), INTENT(IN) :: XVal !< X value to be interpolated. + REAL(R8Ki), INTENT(IN) :: Y (:,:) !< Matrix of Y values to be interpolated; First dimension is AryLen. + + + + ! Let's check the limits first. + + IF ( XVal <= XAry(1) ) THEN + yInterp = Y(1,:) + Ind = 1 + RETURN + ELSE IF ( XVal >= XAry(AryLen) ) THEN + yInterp = Y(AryLen,:) + Ind = MAX(AryLen - 1, 1) + RETURN + END IF + + + ! Let's interpolate! + + Ind = MAX( MIN( Ind, AryLen-1 ), 1 ) + + DO + + IF ( XVal < XAry(Ind) ) THEN + + Ind = Ind - 1 + + ELSE IF ( XVal >= XAry(Ind+1) ) THEN + + Ind = Ind + 1 + + ELSE + + yInterp = ( Y(Ind+1,:) - Y(Ind,:) )*( XVal - XAry(Ind) )/( XAry(Ind+1) - XAry(Ind) ) + Y(Ind,:) + RETURN + + END IF + + END DO + + + RETURN + END SUBROUTINE InterpStpMat8 +!======================================================================= +!---------------------------------------------------------------------------------------------------------------------------------- +!> Perform linear interpolation of an array, where first column is assumed to be ascending time values +!! Similar to InterpStpMat, I think (to check), interpTimeValues=InterpStpMat( array(:,1), time, array(:,1:), iLast, AryLen, values ) +!! First value is used for times before, and last value is used for time beyond + subroutine interpTimeValue(array, time, iLast, values) + real(ReKi), dimension(:,:), intent(in) :: array !< Values, shape nt x nc, where array(:,1) is the time vector + real(DbKi), intent(in) :: time !< Time where values are to be interpolated + integer(IntKi), intent(inout) :: iLast !< previous index used (to speed up interpolation) + real(ReKi), dimension(:), intent(out) :: values !< vector of values, shape nc, at given `time` + integer :: i, nMax + real(ReKi) :: alpha + nMax = size(array, 1) + iLast = max( min(iLast, nMax), 1) ! Clip iLast between 1 and nMax + !call InterpStpMat( array(:,1), time, array(:,1:), iLast, AryLen, values ) + if (array(iLast,1) > time) then + values = array(iLast,2:) + elseif (iLast == nMax) then + values = array(iLast,2:) + else + ! Look for index + do i = iLast, nMax + if (array(i,1)<=time) then + iLast=i + else + exit + endif + enddo + if (iLast==nMax) then + values = array(iLast,2:) + else + ! Linear interpolation + alpha = (array(iLast+1,1)-time)/(array(iLast+1,1)-array(iLast,1)) + values = array(iLast,2:)*alpha + array(iLast+1,2:)*(1-alpha) + endif + endif + end subroutine interpTimeValue + !======================================================================= !< This routine linearly interpolates Dataset. It is !! set for a 2-d interpolation on x and y of the input point. @@ -4876,7 +5303,7 @@ FUNCTION RegCubicSplineInterpM ( X, XAry, YAry, DelX, Coef, ErrStat, ErrMsg ) RE RETURN END FUNCTION RegCubicSplineInterpM ! ( X, XAry, YAry, DelX, Coef, ErrStat, ErrMsg ) !======================================================================= -!> This routine is used to integrate funciton f over the interval [a, b]. This routine +!> This routine is used to integrate function f over the interval [a, b]. This routine !! is useful for sufficiently smooth (e.g., analytic) integrands, integrated over !! intervals which contain no singularities, and where the endpoints are also nonsingular. !! @@ -6055,22 +6482,21 @@ FUNCTION TaitBryanYXZExtractR8(M) result(theta) END FUNCTION TaitBryanYXZExtractR8 - - - FUNCTION TaitBryanYXZConstructR4(theta) result(M) - ! this function creates a rotation matrix, M, from a 1-2-3 rotation - ! sequence of the 3 TaitBryan angles, theta_x, theta_y, and theta_z, in radians. - ! M represents a change of basis (from global to local coordinates; - ! not a physical rotation of the body). it is the inverse of TaitBryanYXZExtract(). - ! - ! M = R(theta_z) * R(theta_x) * R(theta_y) - ! = [ cz sz 0 | [ 1 0 0 | [ cy 0 -sy | - ! |-sz cz 0 |* | 0 cx sx | * | 0 1 0 | - ! | 0 0 1 ] | 0 -sx cx ] | sy 0 cy ] - ! = [ cy*cz+sy*sx*sz cx*sz cy*sx*sz-cz*sy | - ! |cz*sy*sx-cy*sz cx*cz cy*cz*sx+sy*sz | - ! |cx*sy -sx cx*cy ] - ! where cz = cos(theta_z), sz = sin(theta_z), cy = cos(theta_y), etc. +!======================================================================= +!> this function creates a rotation matrix, M, from a 1-2-3 rotation +!! sequence of the 3 TaitBryan angles, theta_x, theta_y, and theta_z, in radians. +!! M represents a change of basis (from global to local coordinates; +!! not a physical rotation of the body). it is the inverse of TaitBryanYXZExtract(). +!! +!! M = R(theta_z) * R(theta_x) * R(theta_y) +!! = [ cz sz 0 | [ 1 0 0 | [ cy 0 -sy | +!! |-sz cz 0 |* | 0 cx sx | * | 0 1 0 | +!! | 0 0 1 ] | 0 -sx cx ] | sy 0 cy ] +!! = [ cy*cz+sy*sx*sz cx*sz cy*sx*sz-cz*sy | +!! |cz*sy*sx-cy*sz cx*cz cy*cz*sx+sy*sz | +!! |cx*sy -sx cx*cy ] +!! where cz = cos(theta_z), sz = sin(theta_z), cy = cos(theta_y), etc. + PURE FUNCTION TaitBryanYXZConstructR4(theta) result(M) REAL(SiKi) :: M(3,3) !< rotation matrix, M REAL(SiKi), INTENT(IN) :: theta(3) !< the 3 rotation angles: \f$\theta_x, \theta_y, \theta_z\f$ @@ -6104,8 +6530,8 @@ FUNCTION TaitBryanYXZConstructR4(theta) result(M) M(3,3) = cy*cx END FUNCTION TaitBryanYXZConstructR4 - - FUNCTION TaitBryanYXZConstructR8(theta) result(M) +!======================================================================= + PURE FUNCTION TaitBryanYXZConstructR8(theta) result(M) ! this function creates a rotation matrix, M, from a 1-2-3 rotation ! sequence of the 3 TaitBryan angles, theta_x, theta_y, and theta_z, in radians. @@ -6153,7 +6579,6 @@ FUNCTION TaitBryanYXZConstructR8(theta) result(M) M(3,3) = cy*cx END FUNCTION TaitBryanYXZConstructR8 - !======================================================================= !> This routine takes an array of time values such as that returned from @@ -6772,4 +7197,78 @@ SUBROUTINE Angles_ExtrapInterp2_R8R(Angle1, Angle2, Angle3, tin, Angle_out, tin_ END SUBROUTINE Angles_ExtrapInterp2_R8R !======================================================================= + SUBROUTINE fZero_R4(x, f, roots, nZeros, Period) + REAL(R4Ki), intent(in) :: x(:) ! assumed to be monotonic increasing: x(1) < x(2) < ... < x(n) + REAL(R4Ki), intent(in) :: f(:) ! f(x) + REAL(R4Ki), intent(inout) :: roots(:) + INTEGER(IntKi), intent( out) :: nZeros + REAL(R4Ki), OPTIONAL, intent(in) :: Period ! if this is provided, the function f is assumed to be periodic with f(x(j)) = f(x(j)+Period) + + integer(IntKi) :: n, j + real(R4Ki) :: dx, df, m ! help to find zero crossing + + n = size(f) + + nZeros = 0 + do j=2,n + if ((f(j-1) < 0 .and. f(j) >= 0) .or. (f(j-1) >= 0 .and. f(j) < 0)) then !this is a zero-crossing, so a root is located here + nZeros = nZeros + 1 + + df = f(j) - f(j-1) + dx = x(j) - x(j-1) + + roots( min(nZeros,size(roots)) ) = x(j) - f(j) * dx / df + end if + end do + + if (present(Period)) then + if ((f(n) < 0 .and. f(1) >= 0) .or. (f(n) >= 0 .and. f(1) < 0)) then !this is a zero-crossing, so a root is located here + nZeros = nZeros + 1 + + df = f(1) - f(n) + dx = x(1) - x(n) + Period + + roots( min(nZeros,size(roots)) ) = x(1) - f(1) * dx / df + end if + end if + + END SUBROUTINE fZero_R4 +!======================================================================= + SUBROUTINE fZero_R8(x, f, roots, nZeros, Period) + REAL(R8Ki), intent(in) :: x(:) ! assumed to be monotonic increasing: x(1) < x(2) < ... < x(n) + REAL(R8Ki), intent(in) :: f(:) ! f(x) + REAL(R8Ki), intent(inout) :: roots(:) + INTEGER(IntKi), intent( out) :: nZeros + REAL(R8Ki), OPTIONAL, intent(in) :: Period ! if this is provided, the function f is assumed to be periodic with f(x(j)) = f(x(j)+Period) + + integer(IntKi) :: n, j + real(R8Ki) :: dx, df, m ! help to find zero crossing + + n = size(f) + + nZeros = 0 + do j=2,n + if ((f(j-1) < 0 .and. f(j) >= 0) .or. (f(j-1) >= 0 .and. f(j) < 0)) then !this is a zero-crossing, so a root is located here + nZeros = nZeros + 1 + + df = f(j) - f(j-1) + dx = x(j) - x(j-1) + + roots( min(nZeros,size(roots)) ) = x(j) - f(j) * dx / df + end if + end do + + if (present(Period)) then + if ((f(n) < 0 .and. f(1) >= 0) .or. (f(n) >= 0 .and. f(1) < 0)) then !this is a zero-crossing, so a root is located here + nZeros = nZeros + 1 + + df = f(1) - f(n) + dx = x(1) - x(n) + Period + + roots( min(nZeros,size(roots)) ) = x(1) - f(1) * dx / df + end if + end if + + END SUBROUTINE fZero_R8 +!======================================================================= END MODULE NWTC_Num diff --git a/modules/nwtc-library/src/NWTC_RandomNumber.f90 b/modules/nwtc-library/src/NWTC_RandomNumber.f90 index f12b9a8528..52c4f0640c 100644 --- a/modules/nwtc-library/src/NWTC_RandomNumber.f90 +++ b/modules/nwtc-library/src/NWTC_RandomNumber.f90 @@ -46,8 +46,8 @@ SUBROUTINE RandNum_Init(p, ErrStat, ErrMsg ) IMPLICIT NONE TYPE(NWTC_RandomNumber_ParameterType), INTENT(IN ) :: p ! PARAMETERs for random number generation - INTEGER(IntKi) , INTENT(OUT) :: ErrStat ! allocation status - CHARACTER(*) , INTENT(OUT) :: ErrMsg ! error message + INTEGER(IntKi) , INTENT(OUT) :: ErrStat ! allocation status + CHARACTER(*) , INTENT(OUT) :: ErrMsg ! error message INTEGER :: I ! loop counter INTEGER(IntKi), ALLOCATABLE :: NextSeed(:) ! The array that holds the next random seed for each component diff --git a/modules/nwtc-library/src/NWTC_Str.f90 b/modules/nwtc-library/src/NWTC_Str.f90 new file mode 100644 index 0000000000..a64eca9691 --- /dev/null +++ b/modules/nwtc-library/src/NWTC_Str.f90 @@ -0,0 +1,141 @@ +!********************************************************************************************************************************** +! LICENSING +! Copyright (C) 2013-2016 National Renewable Energy Laboratory +! +! 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. +!********************************************************************************************************************************** + +!> This module contains string manipulation routines +MODULE NWTC_Str + + use Precision ! ProgDesc and other types with copy and other routines for those types + + implicit none + + interface is_numeric + module procedure is_numericR4 + module procedure is_numericR8 + end interface + +CONTAINS + + + +!> Count number of occurence of a substring in an input string. +function countsubstring(s1, s2) result(c) + character(len=*), intent(in) :: s1 !< Input string + character(len=*), intent(in) :: s2 !< string to be searched + integer :: c !< number of substrings + integer :: p, posn + c = 0 + if(len(s2) == 0) return + p = 1 + do + posn = index(s1(p:), s2) + if(posn == 0) return + c = c + 1 + p = p + posn + len(s2) + end do +end function countsubstring + +!> split a string according to a delimiter of size 1 +subroutine strsplit(String, StrArray, delimiter) + character(len=*),intent(in) :: String + character(len=1),intent(in) :: delimiter + character(1024), intent(out), allocatable :: StrArray(:) ! Array of strings extracted from line + ! Variable + integer :: j, k, l, n, nmax + logical :: EndOfLine + ! Find number of occurences + n = countsubstring(String, delimiter) + nmax = n+1 + ! Allocate substrings + if(allocated(StrArray)) deallocate(StrArray) + allocate(StrArray(nmax)) + StrArray(:)='' + ! Loop on string and store splits + n = 0 + k = 1 + l = len_trim(string) + EndOfLine = l-k < 0 + do while (.not.EndOfLine) + j = index(string(k:l),delimiter) + if (j == 0) then + j = l + 1 + else + j = j + k - 1 + end if + n = n + 1 + if(n==nmax) then + StrArray(n) = String(k:len(String)) + EndOfLine = .true. + else + if (j /= k .and. len_trim(string(k:j-1)) /= 0) StrArray(n) = String(k:j-1) + k = j + 1 + EndOfLine = l-k < 0 + endif + end do +end subroutine strsplit + +!> Return true if string is an integer, and also return the integer +logical function is_integer(string, x) + character(len=*), intent(in ) :: string + integer(IntKi), intent(out) :: x + integer :: e, n + x = 0 + n=len_trim(string) + if (n==0) then ! blank lines shouldn't be valid integers + is_integer = .false. + return + end if + read(string,*,iostat=e) x + is_integer = e == 0 +end function is_integer + +logical function is_numericR4(string, x) result(is_numeric) + character(len=*), intent(in ) :: string + real(SiKi), intent(out) :: x + 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_numericR4 + +logical function is_numericR8(string, x) result(is_numeric) + character(len=*), intent(in ) :: string + real(R8Ki), intent(out) :: x + 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_numericR8 + +logical function is_logical(string, b) + character(len=*), intent(in ) :: string + logical, intent(out) :: b + integer :: e,n + b = .false. + n=len_trim(string) + read(string,*,iostat=e) b + is_logical = e == 0 +end function is_logical + +END MODULE NWTC_Str diff --git a/modules/nwtc-library/src/NetLib/lapack/NWTC_LAPACK.f90 b/modules/nwtc-library/src/NetLib/lapack/NWTC_LAPACK.f90 index 54a61f1bac..bf48d36268 100644 --- a/modules/nwtc-library/src/NetLib/lapack/NWTC_LAPACK.f90 +++ b/modules/nwtc-library/src/NetLib/lapack/NWTC_LAPACK.f90 @@ -8,25 +8,8 @@ !********************************************************************************************************************************** MODULE NWTC_LAPACK - USE NWTC_Base ! we only need the precision and error level constants + USE NWTC_IO ! we need the precision and error level constants, plus SetErrStat and AllocAry routines from NWTC_Library - -! USE, INTRINSIC :: ISO_C_Binding, only: C_FLOAT, C_DOUBLE ! this is included in NWTC_Library - - ! Notes: - - ! Your project must include the following files: - ! From the NWTC Subroutine Library: - ! SingPrec.f90 [from NWTC Library] - ! Sys*.f90 [from NWTC Library] - ! NWTC_Base.f90 [from NWTC Library] - ! lapack library (preferably a binary, but available in source form from http://www.netlib.org/, too) - ! This wrapper file: - ! NWTC_LAPACK.f90 - - !INTEGER, PARAMETER :: Lib_ReKi = SiKi ! - !INTEGER, PARAMETER :: Lib_DbKi = R8Ki ! DbKi - ! ! bjj: when using the built-in (or dynamic) lapack libraries, S=Real(SiKi); D=Real(R8Ki). ! if people are compiling the lapack source, S=real; D=double precision. (default real and doubles) ! we need to check this somehow to make sure the right routines are called. @@ -36,7 +19,14 @@ MODULE NWTC_LAPACK IMPLICIT NONE + + !> Computes the linear least squares solution for a real general matrix A, where A is assumed to have full rank. Minimizes Norm(B-A*X) + INTERFACE LAPACK_gels + MODULE PROCEDURE LAPACK_dgels + MODULE PROCEDURE LAPACK_sgels + END INTERFACE + !> Computes the solution to system of linear equations A * X = B for GB matrices. INTERFACE LAPACK_gbsv MODULE PROCEDURE LAPACK_dgbsv @@ -44,7 +34,7 @@ MODULE NWTC_LAPACK END INTERFACE !> Computes scalar1*op( A )*op( B ) + scalar2*C where op(x) = x or op(x) = x**T for matrices A, B, and C. - INTERFACE LAPACK_gemm + INTERFACE LAPACK_gemm MODULE PROCEDURE LAPACK_dgemm MODULE PROCEDURE LAPACK_sgemm END INTERFACE @@ -264,6 +254,178 @@ SUBROUTINE LAPACK_SGBSV( N, KL, KU, NRHS, AB, IPIV, B, ErrStat, ErrMsg ) RETURN END SUBROUTINE LAPACK_SGBSV !======================================================================= +!> SGELS solves overdetermined or underdetermined real linear systems +!! involving an M-by-N matrix A, or its transpose, using a QR or LQ +!! factorization of A. It is assumed that A has full rank. + SUBROUTINE LAPACK_DGELS(TRANS, A, B, ErrStat, ErrMsg) + + ! passed parameters + CHARACTER(1), intent(in ) :: TRANS !< On entry, TRANS specifies the form of op( A ) to be used in the matrix multiplication as follows: + !! TRANSA = 'N' or 'n', op( A ) = A. + !! TRANSA = 'T' or 't', op( A ) = A**T. + REAL(R8Ki) ,intent(inout) :: A( :, : ) !< On entry, the M-by-N matrix A. On exit, if M >= N, A is overwritten by details of its QR factorization as returned by SGEQRF; + !! if M < N, A is overwritten by details of its LQ factorization as returned by SGELQF. + + REAL(R8Ki) ,intent(inout) :: B( :, : ) !< On entry, the matrix B of right hand side vectors, stored columnwise; B is M-by-NRHS if TRANS = 'N', or N-by-NRHS if TRANS = 'T'. + !! On exit, if INFO = 0, B is overwritten by the solution vectors, stored columnwise: + !! if TRANS = 'N' and m >= n, rows 1 to n of B contain the least squares solution vectors; the residual sum of squares for the + !! solution in each column is given by the sum of squares of elements N+1 to M in that column; + !! if TRANS = 'N' and m < n, rows 1 to N of B contain the minimum norm solution vectors; + !! if TRANS = 'T' and m >= n, rows 1 to M of B contain the minimum norm solution vectors; + !! if TRANS = 'T' and m < n, rows 1 to M of B contain the least squares solution vectors; the residual sum of squares + !! for the solution in each column is given by the sum of squares of elements M+1 to N in that column. + + INTEGER(IntKi), intent( out) :: ErrStat !< Error level + CHARACTER(*), intent( out) :: ErrMsg !< Message describing error + + ! local variables + REAL(R8Ki), ALLOCATABLE :: WORK( : ) !< dimension (MAX(1,LWORK)); On exit, if INFO=0, then WORK(1) returns the optimal LWORK. + REAL(R8Ki) :: WORK_SIZE(1) !< the optimal LWORK + INTEGER :: LWORK !< The dimension of the array WORK. LWORK >= max( 1, MN + max( MN, NRHS ) ). For optimal performance LWORK >= max( 1, MN + max( MN, NRHS )*NB ), where MN = min(M,N) and NB is the optimum block size. + !! If LWORK = -1, then a workspace query is assumed; the routine only calculates the optimal size of the WORK array, returns this value as the first + !! entry of the WORK array, and no error message related to LWORK is issued by XERBLA. + + + INTEGER :: INFO ! = 0: successful exit; < 0: if INFO = -i, the i-th argument had an illegal value; > 0: if INFO = i, the i-th diagonal element of the triangular factor of A is zero, so that A does not have full rank; the least squares solution could not be computed. + + INTEGER :: LDA ! The leading dimension of the array A. LDA >= MAX(1,M). + INTEGER :: LDB ! The leading dimension of the array B. LDB >= MAX(1,M,N). + INTEGER :: M !< The number of rows of the matrix A. M >= 0. + INTEGER :: N !< The number of columns of the matrix A. N >= 0. + INTEGER :: NRHS !< The number of right hand sides, i.e., the number of columns of the matrices B and X. NRHS >=0. + + INTEGER(IntKi) :: ErrStat2 !< Error level + CHARACTER(ErrMsgLen) :: ErrMsg2 !< Message describing error + CHARACTER(*), PARAMETER :: RoutineName = 'LAPACK_DGELS' + + + ErrStat = ErrID_None + ErrMsg = "" + + M = SIZE(A,1) + N = SIZE(A,2) + + LDA = SIZE(A,1) + + LDB = SIZE(B,1) + NRHS = SIZE(B,2) + + IF ( M == 0 .or. N == 0 ) THEN + ! this is a null case... + RETURN + END IF + + + LWORK = -1 ! get size for work array + call DGELS(TRANS, M, N, NRHS, A, LDA, B, LDB, WORK_SIZE, LWORK, INFO) + + LWORK = WORK_SIZE(1) + call AllocAry(WORK, LWORK, 'Work', ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg,RoutineName) + if (ErrStat >= AbortErrLev) return + + + call DGELS(TRANS, M, N, NRHS, A, LDA, B, LDB, WORK, LWORK, INFO) + deallocate(WORK) + + IF (INFO /= 0) THEN + WRITE( ErrMsg2, * ) INFO + IF (INFO < 0) THEN + ErrMsg2 = "Illegal value in argument "//TRIM(ErrMsg2)//"." + ELSE + ErrMsg2 = "Diagonal element "//TRIM(ErrMsg2)//" of the triangular factor of A is zero, so that A does not have full rank. The least squares solution could not be computed." + END IF + call SetErrStat(ErrID_FATAL, ErrMsg2, ErrStat, ErrMsg, RoutineName) + END IF + + END SUBROUTINE LAPACK_DGELS +!======================================================================= +!> SGELS solves overdetermined or underdetermined real linear systems +!! involving an M-by-N matrix A, or its transpose, using a QR or LQ +!! factorization of A. It is assumed that A has full rank. + SUBROUTINE LAPACK_SGELS(TRANS, A, B, ErrStat, ErrMsg) + + ! passed parameters + CHARACTER(1), intent(in ) :: TRANS !< On entry, TRANS specifies the form of op( A ) to be used in the matrix multiplication as follows: + !! TRANSA = 'N' or 'n', op( A ) = A. + !! TRANSA = 'T' or 't', op( A ) = A**T. + REAL(SiKi) ,intent(inout) :: A( :, : ) !< On entry, the M-by-N matrix A. On exit, if M >= N, A is overwritten by details of its QR factorization as returned by SGEQRF; + !! if M < N, A is overwritten by details of its LQ factorization as returned by SGELQF. + + REAL(SiKi) ,intent(inout) :: B( :, : ) !< On entry, the matrix B of right hand side vectors, stored columnwise; B is M-by-NRHS if TRANS = 'N', or N-by-NRHS if TRANS = 'T'. + !! On exit, if INFO = 0, B is overwritten by the solution vectors, stored columnwise: + !! if TRANS = 'N' and m >= n, rows 1 to n of B contain the least squares solution vectors; the residual sum of squares for the + !! solution in each column is given by the sum of squares of elements N+1 to M in that column; + !! if TRANS = 'N' and m < n, rows 1 to N of B contain the minimum norm solution vectors; + !! if TRANS = 'T' and m >= n, rows 1 to M of B contain the minimum norm solution vectors; + !! if TRANS = 'T' and m < n, rows 1 to M of B contain the least squares solution vectors; the residual sum of squares + !! for the solution in each column is given by the sum of squares of elements M+1 to N in that column. + + INTEGER(IntKi), intent( out) :: ErrStat !< Error level + CHARACTER(*), intent( out) :: ErrMsg !< Message describing error + + ! local variables + REAL(SiKi), ALLOCATABLE :: WORK( : ) !< dimension (MAX(1,LWORK)); On exit, if INFO=0, then WORK(1) returns the optimal LWORK. + REAL(SiKi) :: WORK_SIZE(1) !< the optimal LWORK + INTEGER :: LWORK !< The dimension of the array WORK. LWORK >= max( 1, MN + max( MN, NRHS ) ). For optimal performance LWORK >= max( 1, MN + max( MN, NRHS )*NB ), where MN = min(M,N) and NB is the optimum block size. + !! If LWORK = -1, then a workspace query is assumed; the routine only calculates the optimal size of the WORK array, returns this value as the first + !! entry of the WORK array, and no error message related to LWORK is issued by XERBLA. + + + INTEGER :: INFO ! = 0: successful exit; < 0: if INFO = -i, the i-th argument had an illegal value; > 0: if INFO = i, the i-th diagonal element of the triangular factor of A is zero, so that A does not have full rank; the least squares solution could not be computed. + + INTEGER :: LDA ! The leading dimension of the array A. LDA >= MAX(1,M). + INTEGER :: LDB ! The leading dimension of the array B. LDB >= MAX(1,M,N). + INTEGER :: M !< The number of rows of the matrix A. M >= 0. + INTEGER :: N !< The number of columns of the matrix A. N >= 0. + INTEGER :: NRHS !< The number of right hand sides, i.e., the number of columns of the matrices B and X. NRHS >=0. + + INTEGER(IntKi) :: ErrStat2 !< Error level + CHARACTER(ErrMsgLen) :: ErrMsg2 !< Message describing error + CHARACTER(*), PARAMETER :: RoutineName = 'LAPACK_SGELS' + + + ErrStat = ErrID_None + ErrMsg = "" + + M = SIZE(A,1) + N = SIZE(A,2) + + LDA = SIZE(A,1) + + LDB = SIZE(B,1) + NRHS = SIZE(B,2) + + IF ( M == 0 .or. N == 0 ) THEN + ! this is a null case... + RETURN + END IF + + + LWORK = -1 ! get size for work array + call SGELS(TRANS, M, N, NRHS, A, LDA, B, LDB, WORK_SIZE, LWORK, INFO) + + LWORK = WORK_SIZE(1) + call AllocAry(WORK, LWORK, 'Work', ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg,RoutineName) + if (ErrStat >= AbortErrLev) return + + + call SGELS(TRANS, M, N, NRHS, A, LDA, B, LDB, WORK, LWORK, INFO) + deallocate(WORK) + + IF (INFO /= 0) THEN + WRITE( ErrMsg2, * ) INFO + IF (INFO < 0) THEN + ErrMsg2 = "Illegal value in argument "//TRIM(ErrMsg2)//"." + ELSE + ErrMsg2 = "Diagonal element "//TRIM(ErrMsg2)//" of the triangular factor of A is zero, so that A does not have full rank. The least squares solution could not be computed." + END IF + call SetErrStat(ErrID_FATAL, ErrMsg2, ErrStat, ErrMsg, RoutineName) + END IF + + END SUBROUTINE LAPACK_SGELS +!======================================================================= !> general matrix multiply: computes C = alpha*op( A )*op( B ) + beta*C where op(x) = x or op(x) = x**T for matrices A, B, and C !! use LAPACK_GEMM (nwtc_lapack::lapack_gemm) instead of this specific function. SUBROUTINE LAPACK_DGEMM( TRANSA, TRANSB, ALPHA, A, B, BETA, C, ErrStat, ErrMsg ) @@ -1580,22 +1742,36 @@ SUBROUTINE LAPACK_SGESVD(JOBU, JOBVT, M, N, A, S, U, VT, WORK, LWORK, ErrStat, E RETURN END SUBROUTINE LAPACK_SGESVD - !======================================================================= - !INTERFACE LAPACK_TPTTR: - !> Unpack a by-column-packed array into a 2D matrix format - !! See documentation in DTPTTR/STPTTR source code. +!======================================================================= +!INTERFACE LAPACK_TPTTR: +!> Unpack a by-column-packed array into a 2D matrix format +!! See documentation in DTPTTR/STPTTR source code. +!======================================================================= SUBROUTINE LAPACK_DTPTTR( UPLO, N, AP, A, LDA, ErrStat, ErrMsg ) - CHARACTER(1), intent(in ) :: UPLO !< = 'U': A is an upper triangular matrix; 'L': A is a lower triangular matrix - INTEGER, intent(in ) :: N !< The order of matrix A and AP. - INTEGER, intent(in) :: LDA !< The leading dimension of the matrix A. LDA ? max(1,N) - INTEGER(IntKi), intent(out) :: ErrStat !< Error level - CHARACTER(*), intent(out) :: ErrMsg !< Message describing error - REAL(R8Ki), intent(in) :: AP( : ) !< Packed array - REAL(R8Ki), intent(out) :: A( :,: ) !< Unpacked array : Note AP(1)=A(1,1); AP(2)=A(1,2); AP(3)=A(2,2); AP(4)=A(1,3) etc. by column, upper triang - INTEGER :: INFO ! = 0: successful exit; < 0: if INFO = -i, the i-th argument had an illegal value + + ! passed parameters + + CHARACTER(1), intent(in ) :: UPLO !< = 'U': A is an upper triangular matrix; 'L': A is a lower triangular matrix + INTEGER, intent(in ) :: N !< The order of matrix A and AP. + INTEGER, intent(in) :: LDA !< The leading dimension of the matrix A. LDA ? max(1,N) + INTEGER(IntKi), intent( out) :: ErrStat !< Error level + CHARACTER(*), intent( out) :: ErrMsg !< Message describing error + + ! .. Array Arguments .. + REAL(R8Ki), intent(in) :: AP( : ) !< Packed array + + REAL(R8Ki), intent(out) :: A( :,: ) !< Unpacked array : Note AP(1)=A(1,1); AP(2)=A(1,2); AP(3)=A(2,2); AP(4)=A(1,3) etc. by column, upper triang + + ! Local variable + INTEGER :: INFO ! = 0: successful exit; < 0: if INFO = -i, the i-th argument had an illegal value + + ErrStat = ErrID_None ErrMsg = "" + + CALL DTPTTR( UPLO, N, AP, A, LDA, INFO ) + IF (INFO /= 0) THEN ErrStat = ErrID_FATAL WRITE( ErrMsg, * ) INFO @@ -1605,22 +1781,36 @@ SUBROUTINE LAPACK_DTPTTR( UPLO, N, AP, A, LDA, ErrStat, ErrMsg ) ErrMsg = 'LAPACK_DTPTTR: Unknown error '//TRIM(ErrMsg)//'.' END IF END IF - RETURN + + + RETURN END SUBROUTINE LAPACK_DTPTTR - !======================================================================= - !> Unpack a by-column-packed array into a 2D matrix format - SUBROUTINE LAPACK_STPTTR( UPLO, N, AP, A, LDA, ErrStat, ErrMsg ) - CHARACTER(1), intent(in ) :: UPLO !< = 'U': A is an upper triangular matrix; 'L': A is a lower triangular matrix - INTEGER, intent(in ) :: N !< The order of matrix A and AP. - INTEGER, intent(in) :: LDA !< The leading dimension of the matrix A. LDA ? max(1,N) - INTEGER(IntKi), intent(out) :: ErrStat !< Error level - CHARACTER(*), intent(out) :: ErrMsg !< Message describing error - REAL(SiKi), intent(in) :: AP( : ) !< Packed array - REAL(SiKi), intent(out) :: A( :,: ) !< Unpacked array : Note AP(1)=A(1,1); AP(2)=A(1,2); AP(3)=A(2,2); AP(4)=A(1,3) etc. by column, upper triang - INTEGER :: INFO ! = 0: successful exit; < 0: if INFO = -i, the i-th argument had an illegal value +!======================================================================= + SUBROUTINE LAPACK_STPTTR( UPLO, N, AP, A, LDA, ErrStat, ErrMsg ) + + ! passed parameters + + CHARACTER(1), intent(in ) :: UPLO !< = 'U': A is an upper triangular matrix; 'L': A is a lower triangular matrix + INTEGER, intent(in ) :: N !< The order of matrix A and AP. + INTEGER, intent(in) :: LDA !< The leading dimension of the matrix A. LDA ? max(1,N) + INTEGER(IntKi), intent( out) :: ErrStat !< Error level + CHARACTER(*), intent( out) :: ErrMsg !< Message describing error + + ! .. Array Arguments .. + REAL(SiKi), intent(in) :: AP( : ) !< Packed array + + REAL(SiKi), intent(out) :: A( :,: ) !< Unpacked array : Note AP(1)=A(1,1); AP(2)=A(1,2); AP(3)=A(2,2); AP(4)=A(1,3) etc. by column, upper triang + + ! Local variable + INTEGER :: INFO ! = 0: successful exit; < 0: if INFO = -i, the i-th argument had an illegal value + + ErrStat = ErrID_None ErrMsg = "" - CALL STPTTR( UPLO, N, AP, A, LDA, INFO ) + + + CALL STPTTR( UPLO, N, AP, A, LDA, INFO ) + IF (INFO /= 0) THEN ErrStat = ErrID_FATAL WRITE( ErrMsg, * ) INFO @@ -1629,8 +1819,10 @@ SUBROUTINE LAPACK_STPTTR( UPLO, N, AP, A, LDA, ErrStat, ErrMsg ) ELSE ErrMsg = 'LAPACK_STPTTR: Unknown error '//TRIM(ErrMsg)//'.' END IF - END IF - RETURN + END IF + + RETURN END SUBROUTINE LAPACK_STPTTR - !======================================================================= +!======================================================================= + END MODULE NWTC_LAPACK diff --git a/modules/nwtc-library/src/Registry_NWTC_Library.txt b/modules/nwtc-library/src/Registry_NWTC_Library.txt index a77c60c073..a4cd50c404 100644 --- a/modules/nwtc-library/src/Registry_NWTC_Library.txt +++ b/modules/nwtc-library/src/Registry_NWTC_Library.txt @@ -6,66 +6,160 @@ #............................................................. -usefrom NWTC_Library ProgDesc CHARACTER(99) Name -usefrom ^ ^ CHARACTER(99) Ver -usefrom ^ ^ CHARACTER(24) Date - -usefrom ^ FASTdataType CHARACTER(1024) File -usefrom ^ ^ CHARACTER(1024) Descr -usefrom ^ ^ IntKi NumChans -usefrom ^ ^ IntKi NumRecs -usefrom ^ ^ DbKi TimeStep -usefrom ^ ^ CHARACTER(ChanLen) ChanNames {:} -usefrom ^ ^ CHARACTER(ChanLen) ChanUnits {:} -usefrom ^ ^ ReKi Data {:}{:} - -usefrom NWTC_Library OutParmType IntKi Indx -usefrom ^ ^ CHARACTER(ChanLen) Name -usefrom ^ ^ CHARACTER(ChanLen) Units -usefrom ^ ^ IntKi SignM - -usefrom NWTC_Library FileInfoType IntKi NumLines -usefrom ^ ^ IntKi NumFiles -usefrom ^ ^ IntKi FileLine {:} -usefrom ^ ^ IntKi FileIndx {:} -usefrom ^ ^ CHARACTER(MaxFileInfoLineLen) FileList {:} -usefrom ^ ^ CHARACTER(MaxFileInfoLineLen) Lines {:} - -usefrom NWTC_Library Quaternion ReKi q0 -usefrom ^ ^ ReKi v {3} - -usefrom NWTC_Library NWTC_RandomNumber_ParameterType IntKi pRNG -usefrom ^ ^ IntKi RandSeed {3} -usefrom ^ ^ IntKi RandSeedAry {:} -usefrom ^ ^ CHARACTER(6) RNG_type +typedef NWTC_Library ProgDesc CHARACTER(99) Name - - - "Name of the program or module" +typedef ^ ^ CHARACTER(99) Ver - - - "Version number of the program or module" +typedef ^ ^ CHARACTER(24) Date - - - "String containing date module was last updated" + +typedef NWTC_Library FASTdataType CHARACTER(1024) File - - - "Name of the FAST-style binary file" +typedef ^ ^ CHARACTER(1024) Descr - - - "String describing file" +typedef ^ ^ IntKi NumChans - - - "Number of output channels in this binary file (not including the time channel)" +typedef ^ ^ IntKi NumRecs - - - "Number of records (rows) of data in the file" +typedef ^ ^ DbKi TimeStep - - - "Time step for evenly-spaced data in the output file (when NumRecs is not allo" +typedef ^ ^ CHARACTER(ChanLen) ChanNames {:} - - "Strings describing the names of the channels from the binary file (including the time channel)" +typedef ^ ^ CHARACTER(ChanLen) ChanUnits {:} - - "Strings describing the units of the channels from the binary file (including the time channel)" +typedef ^ ^ ReKi Data {:}{:} - - "numeric data (rows and columns) from the binary file, including the time channel" + +typedef NWTC_Library OutParmType IntKi Indx - - - "An index into AllOuts array where this channel is computed/stored" +typedef ^ ^ CHARACTER(ChanLen) Name - - - "Name of the output channel" +typedef ^ ^ CHARACTER(ChanLen) Units - - - "Units this channel is specified in" +typedef ^ ^ IntKi SignM - - - "Multiplier for output channel; usually -1 (minus) or 0 (invalid channel)" + +typedef NWTC_Library FileInfoType IntKi NumLines +typedef ^ ^ IntKi NumFiles +typedef ^ ^ IntKi FileLine {:} +typedef ^ ^ IntKi FileIndx {:} +typedef ^ ^ CHARACTER(MaxFileInfoLineLen) FileList {:} +typedef ^ ^ CHARACTER(MaxFileInfoLineLen) Lines {:} + +typedef NWTC_Library Quaternion ReKi q0 +typedef ^ ^ ReKi v {3} + +typedef NWTC_Library NWTC_RandomNumber_ParameterType IntKi pRNG +typedef ^ ^ IntKi RandSeed {3} +typedef ^ ^ IntKi RandSeedAry {:} +typedef ^ ^ CHARACTER(6) RNG_type + +#------------------------------------------------------------------------------- +# Module Variables +#------------------------------------------------------------------------------- + +param ^ - IntKi VarNameLen - 64 - "" - + +param ^ - IntKi VF_Force - 1 - "" - +param ^ - IntKi VF_Moment - 2 - "" - +param ^ - IntKi VF_Orientation - 3 - "" - +param ^ - IntKi VF_TransDisp - 4 - "" - +param ^ - IntKi VF_AngularDisp - 5 - "" - +param ^ - IntKi VF_TransVel - 6 - "" - +param ^ - IntKi VF_AngularVel - 7 - "" - +param ^ - IntKi VF_TransAcc - 8 - "" - +param ^ - IntKi VF_AngularAcc - 9 - "" - +param ^ - IntKi VF_Scalar - 10 - "" - + +param ^ - IntKi VF_None - 0 - "Variable with no flags" - +param ^ - IntKi VF_Mesh - 1 - "Variable contained in mesh" - +param ^ - IntKi VF_Line - 2 - "Variable is for a line mesh" - +param ^ - IntKi VF_RotFrame - 4 - "Variable in rotating frame" - +param ^ - IntKi VF_Ext - 8 - "Variable for extended linearization" - +param ^ - IntKi VF_Any - 4095 - "Enable all flags (used for filtering)" - + +param ^ - IntKi VC_None - 0 - "" - +param ^ - IntKi VC_Tight - 1 - "" - +param ^ - IntKi VC_Option1 - 2 - "" - +param ^ - IntKi VC_Option2 - 3 - "" - + +typedef ^ ModVarType character(VarNameLen) Name - - - "" - +typedef ^ ^ IntKi Field - 0 - "" - +typedef ^ ^ IntKi Nodes - 1 - "" - +typedef ^ ^ IntKi Num - 1 - "" - +typedef ^ ^ IntKi Flags - 0 - "" - +typedef ^ ^ IntKi DerivOrder - 0 - "" - +typedef ^ ^ IntKi iLoc : - - "indices in local arrays" - +typedef ^ ^ IntKi iSol : - - "indices in solver arrays" - +typedef ^ ^ IntKi iLin : - - "indices in linearization arrays" - +typedef ^ ^ IntKi iq : - - "row index in solver q matrix" - +typedef ^ ^ IntKi iUsr 2 - - "first user defined index for variable, can be used a lower/upper bounds" - +typedef ^ ^ IntKi jUsr - 0 - "second user defined index for variable" - +typedef ^ ^ IntKi MeshID - 0 - "Mesh identification number" - +typedef ^ ^ logical Solve - F - "flag indicating that variable is used by solver" - +typedef ^ ^ R8Ki Perturb - 0 - "perturbation" - +typedef ^ ^ character(LinChanLen) LinNames : - - "" - + +typedef ^ ModVarsType IntKi ModNum - 0 - "" - +typedef ^ ^ character(6) ModAbbr - - - "" - +typedef ^ ^ ModVarType x : - - "Module state variable array" - +typedef ^ ^ ModVarType u : - - "Module input variable array" - +typedef ^ ^ ModVarType y : - - "Module output variable array" - +typedef ^ ^ IntKi Nx - - - "" - +typedef ^ ^ IntKi Nu - - - "" - +typedef ^ ^ IntKi Ny - - - "" - + +typedef ^ ModValsType R8Ki x : - - "" - +typedef ^ ^ R8Ki dxdt : - - "" - +typedef ^ ^ R8Ki u : - - "" - +typedef ^ ^ R8Ki y : - - "" - +typedef ^ ^ R8Ki u_perturb : - - "input perturbation array" - +typedef ^ ^ R8Ki x_perturb : - - "" - +typedef ^ ^ R8Ki xp : - - "" - +typedef ^ ^ R8Ki xn : - - "" - +typedef ^ ^ R8Ki yp : - - "" - +typedef ^ ^ R8Ki yn : - - "" - +typedef ^ ^ R8Ki dYdx :: - - "" - +typedef ^ ^ R8Ki dXdx :: - - "" - +typedef ^ ^ R8Ki dYdu :: - - "" - +typedef ^ ^ R8Ki dXdu :: - - "" - + +typedef ^ ModDataType IntKi Idx - 0 - "Module index in array of modules" - +typedef ^ ^ IntKi ID - 0 - "Module identification number" - +typedef ^ ^ character(ChanLen) Abbr - - - "Module name abbreviation" - +typedef ^ ^ IntKi Ins - 0 - "Module instance number" - +typedef ^ ^ logical IsTC - F - "Flag indicating module is part of tight coupling" - +typedef ^ ^ R8Ki DT - 0 - "Module time step" - +typedef ^ ^ IntKi SubSteps - 0 - "Module number of substeps per solver time step" - +typedef ^ ^ IntKi ixs :: - - "index array mapping local x vector to global x vector" - +typedef ^ ^ IntKi ius :: - - "index array mapping local u vector to global u vector" - +typedef ^ ^ IntKi iys :: - - "index array mapping local y vector to global y vector" - +typedef ^ ^ ModVarsType *Vars - - - "Pointer to module variables type" - +typedef ^ ^ IntKi SrcMaps : - - "Indices of mappings where module is the source" +typedef ^ ^ IntKi DstMaps : - - "Indices of mappings where module is the destination" + +# This file defines types that may be used from the NWTC_Library +# include this into a component registry file if you wish to use these types +# the "usefrom" keyword defines the types for the registry without generating +# a NWTC_Library_Types.f90 file +# +#............................................................. + + #BJJ: the following three types will actually be placed in the ModMesh_Mapping.f90 file instead of NWTC_Library_Types.f90 -usefrom NWTC_Library MapType IntKi OtherMesh_Element -usefrom ^ ^ R8Ki distance - -usefrom ^ ^ R8Ki couple_arm {3} -usefrom ^ ^ R8Ki shape_fn {2} - -usefrom NWTC_Library MeshMapLinearizationType R8Ki mi {:}{:} -usefrom ^ ^ R8Ki fx_p {:}{:} -usefrom ^ ^ R8Ki tv_uD {:}{:} -usefrom ^ ^ R8Ki tv_uS {:}{:} -usefrom ^ ^ R8Ki ta_uD {:}{:} -usefrom ^ ^ R8Ki ta_uS {:}{:} -usefrom ^ ^ R8Ki ta_rv {:}{:} -usefrom ^ ^ R8Ki li {:}{:} -usefrom ^ ^ R8Ki M_u {:}{:} -usefrom ^ ^ R8Ki M_t {:}{:} -usefrom ^ ^ R8Ki M_f {:}{:} - -usefrom NWTC_Library MeshMapType MapType MapLoads {:} -usefrom ^ ^ MapType MapMotions {:} -usefrom ^ ^ MapType MapSrcToAugmt {:} -usefrom ^ ^ MeshType Augmented_Ln2_Src - -usefrom ^ ^ MeshType Lumped_Points_Src - -usefrom ^ ^ INTEGER LoadLn2_A_Mat_Piv {:} -usefrom ^ ^ R8Ki DisplacedPosition {:}{:}{:} -usefrom ^ ^ R8Ki LoadLn2_A_Mat {:}{:} -usefrom ^ ^ R8Ki LoadLn2_F {:}{:} -usefrom ^ ^ R8Ki LoadLn2_M {:}{:} -usefrom ^ ^ MeshMapLinearizationType dM +typedef NWTC_Library MapType IntKi OtherMesh_Element - - - "Node (for point meshes) or Element (for line2 meshes) number on other mesh; for loads, other mesh is Dest, for motions/scalars, other mesh is Src" - +typedef ^ ^ R8Ki distance - - - "Magnitude of couple_arm" m +typedef ^ ^ R8Ki couple_arm {3} - - "Vector between a point and node 1 of an element (p_ODR - p_OSR)" m +typedef ^ ^ R8Ki shape_fn {2} - - "shape functions: 1-D element-level location [0,1] based on closest-line projection of point" - + +typedef NWTC_Library MeshMapLinearizationType R8Ki mi {:}{:} - - "block matrix of motions that reflects identity (i.e., solely the mapping of one quantity to itself on another mesh)" +typedef ^ ^ R8Ki fx_p {:}{:} - - "block matrix of motions that reflects skew-symmetric (cross-product) matrix" +typedef ^ ^ R8Ki tv_uD {:}{:} - - "block matrix of translational velocity that is multiplied by destination translational displacement" +typedef ^ ^ R8Ki tv_uS {:}{:} - - "block matrix of translational velocity that is multiplied by source translational displacement" +typedef ^ ^ R8Ki ta_uD {:}{:} - - "block matrix of translational acceleration that is multiplied by destination translational displacement" +typedef ^ ^ R8Ki ta_uS {:}{:} - - "block matrix of translational acceleration that is multiplied by source translational displacement" +typedef ^ ^ R8Ki ta_rv {:}{:} - - "block matrix of translational acceleration that is multiplied by omega (RotationVel)" +typedef ^ ^ R8Ki li {:}{:} - - "block matrix of loads that reflects identity (i.e., solely the mapping on one quantity to itself on another mesh)" +typedef ^ ^ R8Ki M_uS {:}{:} - - "block matrix of moment that is multiplied by Source u (translationDisp)" +typedef ^ ^ R8Ki M_uD {:}{:} - - "block matrix of moment that is multiplied by Destination u (translationDisp)" +typedef ^ ^ R8Ki M_f {:}{:} - - "block matrix of moment that is multiplied by force" + +typedef NWTC_Library MeshMapType MapType MapLoads {:} - - "mapping data structure for load fields on the mesh" +typedef ^ ^ MapType MapMotions {:} - - "mapping data structure for motion and/or scalar fields on the mesh" +typedef ^ ^ MapType MapSrcToAugmt {:} - - "for source line2 loads, we map between source and an augmented source mesh, then between augmented source and destination" +typedef ^ ^ MeshType Augmented_Ln2_Src - - - "temporary mesh for storing augmented line2 source values" +typedef ^ ^ MeshType Lumped_Points_Src - - - "temporary mesh for lumping lines to points, stored here for efficiency" +typedef ^ ^ INTEGER LoadLn2_A_Mat_Piv {:} - - "The pivot values for the factorization of LoadLn2_A_Mat" +typedef ^ ^ R8Ki DisplacedPosition {:}{:}{:} - - "couple_arm +Scr%Disp - Dest%Disp for each mapped node (stored here for efficiency)" m +typedef ^ ^ R8Ki LoadLn2_A_Mat {:}{:} - - "The 3-components of the forces for each node of an element in the point-to-line load mapping (for each element)" +typedef ^ ^ R8Ki LoadLn2_F {:}{:} - - "The 6-by-6 matrix that makes up the diagonal of the [A 0; B A] matrix in the point-to-line load mapping" +typedef ^ ^ R8Ki LoadLn2_M {:}{:} - - "The 3-components of the moments for each node of an element in the point-to-line load mapping (for each element)" +typedef ^ ^ MeshMapLinearizationType dM +#typedef ^ ^ MeshType Lumped_Points_Dest - - - "temporary mesh for debugging the lumped values in the line2-to-line2" diff --git a/modules/nwtc-library/src/Registry_NWTC_Library_base.txt b/modules/nwtc-library/src/Registry_NWTC_Library_base.txt new file mode 100644 index 0000000000..b5f52bb478 --- /dev/null +++ b/modules/nwtc-library/src/Registry_NWTC_Library_base.txt @@ -0,0 +1,124 @@ +# This file defines types that may be used from the NWTC_Library +# include this into a component registry file if you wish to use these types +# the "usefrom" keyword defines the types for the registry without generating +# a NWTC_Library_Types.f90 file +# +#............................................................. + + +typedef NWTC_Library ProgDesc CHARACTER(99) Name - - - "Name of the program or module" +typedef ^ ^ CHARACTER(99) Ver - - - "Version number of the program or module" +typedef ^ ^ CHARACTER(24) Date - - - "String containing date module was last updated" + +typedef NWTC_Library FASTdataType CHARACTER(1024) File - - - "Name of the FAST-style binary file" +typedef ^ ^ CHARACTER(1024) Descr - - - "String describing file" +typedef ^ ^ IntKi NumChans - - - "Number of output channels in this binary file (not including the time channel)" +typedef ^ ^ IntKi NumRecs - - - "Number of records (rows) of data in the file" +typedef ^ ^ DbKi TimeStep - - - "Time step for evenly-spaced data in the output file (when NumRecs is not allo" +typedef ^ ^ CHARACTER(ChanLen) ChanNames {:} - - "Strings describing the names of the channels from the binary file (including the time channel)" +typedef ^ ^ CHARACTER(ChanLen) ChanUnits {:} - - "Strings describing the units of the channels from the binary file (including the time channel)" +typedef ^ ^ ReKi Data {:}{:} - - "numeric data (rows and columns) from the binary file, including the time channel" + +typedef NWTC_Library OutParmType IntKi Indx - - - "An index into AllOuts array where this channel is computed/stored" +typedef ^ ^ CHARACTER(ChanLen) Name - - - "Name of the output channel" +typedef ^ ^ CHARACTER(ChanLen) Units - - - "Units this channel is specified in" +typedef ^ ^ IntKi SignM - - - "Multiplier for output channel; usually -1 (minus) or 0 (invalid channel)" + +typedef NWTC_Library FileInfoType IntKi NumLines +typedef ^ ^ IntKi NumFiles +typedef ^ ^ IntKi FileLine {:} +typedef ^ ^ IntKi FileIndx {:} +typedef ^ ^ CHARACTER(MaxFileInfoLineLen) FileList {:} +typedef ^ ^ CHARACTER(MaxFileInfoLineLen) Lines {:} + +typedef NWTC_Library Quaternion ReKi q0 +typedef ^ ^ ReKi v {3} + +typedef NWTC_Library NWTC_RandomNumber_ParameterType IntKi pRNG +typedef ^ ^ IntKi RandSeed {3} +typedef ^ ^ IntKi RandSeedAry {:} +typedef ^ ^ CHARACTER(6) RNG_type + +#------------------------------------------------------------------------------- +# Module Variables +#------------------------------------------------------------------------------- + +param ^ - IntKi VarNameLen - 64 - "" - + +param ^ - IntKi VF_Force - 1 - "" - +param ^ - IntKi VF_Moment - 2 - "" - +param ^ - IntKi VF_Orientation - 3 - "" - +param ^ - IntKi VF_TransDisp - 4 - "" - +param ^ - IntKi VF_AngularDisp - 5 - "" - +param ^ - IntKi VF_TransVel - 6 - "" - +param ^ - IntKi VF_AngularVel - 7 - "" - +param ^ - IntKi VF_TransAcc - 8 - "" - +param ^ - IntKi VF_AngularAcc - 9 - "" - +param ^ - IntKi VF_Scalar - 10 - "" - + +param ^ - IntKi VF_None - 0 - "Variable with no flags" - +param ^ - IntKi VF_Mesh - 1 - "Variable contained in mesh" - +param ^ - IntKi VF_Line - 2 - "Variable is for a line mesh" - +param ^ - IntKi VF_RotFrame - 4 - "Variable in rotating frame" - +param ^ - IntKi VF_Ext - 8 - "Variable for extended linearization" - +param ^ - IntKi VF_Any - 4095 - "Enable all flags (used for filtering)" - + +param ^ - IntKi VC_None - 0 - "" - +param ^ - IntKi VC_Tight - 1 - "" - +param ^ - IntKi VC_Option1 - 2 - "" - +param ^ - IntKi VC_Option2 - 3 - "" - + +typedef ^ ModVarType character(VarNameLen) Name - - - "" - +typedef ^ ^ IntKi Field - 0 - "" - +typedef ^ ^ IntKi Nodes - 1 - "" - +typedef ^ ^ IntKi Num - 1 - "" - +typedef ^ ^ IntKi Flags - 0 - "" - +typedef ^ ^ IntKi DerivOrder - 0 - "" - +typedef ^ ^ IntKi iLoc : - - "indices in local arrays" - +typedef ^ ^ IntKi iSol : - - "indices in solver arrays" - +typedef ^ ^ IntKi iLin : - - "indices in linearization arrays" - +typedef ^ ^ IntKi iq : - - "row index in solver q matrix" - +typedef ^ ^ IntKi iUsr 2 - - "first user defined index for variable, can be used a lower/upper bounds" - +typedef ^ ^ IntKi jUsr - 0 - "second user defined index for variable" - +typedef ^ ^ IntKi MeshID - 0 - "Mesh identification number" - +typedef ^ ^ logical Solve - F - "flag indicating that variable is used by solver" - +typedef ^ ^ R8Ki Perturb - 0 - "perturbation" - +typedef ^ ^ character(LinChanLen) LinNames : - - "" - + +typedef ^ ModVarsType IntKi ModNum - 0 - "" - +typedef ^ ^ character(6) ModAbbr - - - "" - +typedef ^ ^ ModVarType x : - - "Module state variable array" - +typedef ^ ^ ModVarType u : - - "Module input variable array" - +typedef ^ ^ ModVarType y : - - "Module output variable array" - +typedef ^ ^ IntKi Nx - - - "" - +typedef ^ ^ IntKi Nu - - - "" - +typedef ^ ^ IntKi Ny - - - "" - + +typedef ^ ModValsType R8Ki x : - - "" - +typedef ^ ^ R8Ki dxdt : - - "" - +typedef ^ ^ R8Ki u : - - "" - +typedef ^ ^ R8Ki y : - - "" - +typedef ^ ^ R8Ki u_perturb : - - "input perturbation array" - +typedef ^ ^ R8Ki x_perturb : - - "" - +typedef ^ ^ R8Ki xp : - - "" - +typedef ^ ^ R8Ki xn : - - "" - +typedef ^ ^ R8Ki yp : - - "" - +typedef ^ ^ R8Ki yn : - - "" - +typedef ^ ^ R8Ki dYdx :: - - "" - +typedef ^ ^ R8Ki dXdx :: - - "" - +typedef ^ ^ R8Ki dYdu :: - - "" - +typedef ^ ^ R8Ki dXdu :: - - "" - + +typedef ^ ModDataType IntKi Idx - 0 - "Module index in array of modules" - +typedef ^ ^ IntKi ID - 0 - "Module identification number" - +typedef ^ ^ character(ChanLen) Abbr - - - "Module name abbreviation" - +typedef ^ ^ IntKi Ins - 0 - "Module instance number" - +typedef ^ ^ logical IsTC - F - "Flag indicating module is part of tight coupling" - +typedef ^ ^ R8Ki DT - 0 - "Module time step" - +typedef ^ ^ IntKi SubSteps - 0 - "Module number of substeps per solver time step" - +typedef ^ ^ IntKi ixs :: - - "index array mapping local x vector to global x vector" - +typedef ^ ^ IntKi ius :: - - "index array mapping local u vector to global u vector" - +typedef ^ ^ IntKi iys :: - - "index array mapping local y vector to global y vector" - +typedef ^ ^ ModVarsType *Vars - - - "Pointer to module variables type" - +typedef ^ ^ IntKi SrcMaps : - - "Indices of mappings where module is the source" +typedef ^ ^ IntKi DstMaps : - - "Indices of mappings where module is the destination" diff --git a/modules/nwtc-library/src/Registry_NWTC_Library_typedef_mesh.txt b/modules/nwtc-library/src/Registry_NWTC_Library_mesh.txt similarity index 98% rename from modules/nwtc-library/src/Registry_NWTC_Library_typedef_mesh.txt rename to modules/nwtc-library/src/Registry_NWTC_Library_mesh.txt index e1720a4772..0cb2a1ecf3 100644 --- a/modules/nwtc-library/src/Registry_NWTC_Library_typedef_mesh.txt +++ b/modules/nwtc-library/src/Registry_NWTC_Library_mesh.txt @@ -8,7 +8,7 @@ #BJJ: the following three types will actually be placed in the ModMesh_Mapping.f90 file instead of NWTC_Library_Types.f90 -typedef NWTC_Library MapType IntKi OtherMesh_Element - - - "Node (for point meshes) or Element (for line2 meshes) number on other mesh; for loads, other mesh is Dest, for motions/scalars, other mesh is Src" +typedef NWTC_Library MapType IntKi OtherMesh_Element - - - "Node (for point meshes) or Element (for line2 meshes) number on other mesh; for loads, other mesh is Dest, for motions/scalars, other mesh is Src" - typedef ^ ^ R8Ki distance - - - "Magnitude of couple_arm" m typedef ^ ^ R8Ki couple_arm {3} - - "Vector between a point and node 1 of an element (p_ODR - p_OSR)" m typedef ^ ^ R8Ki shape_fn {2} - - "shape functions: 1-D element-level location [0,1] based on closest-line projection of point" - diff --git a/modules/nwtc-library/src/Registry_NWTC_Library_typedef_nomesh.txt b/modules/nwtc-library/src/Registry_NWTC_Library_typedef_nomesh.txt deleted file mode 100644 index 40cdaee1b9..0000000000 --- a/modules/nwtc-library/src/Registry_NWTC_Library_typedef_nomesh.txt +++ /dev/null @@ -1,40 +0,0 @@ -# This file defines types that may be used from the NWTC_Library -# include this into a component registry file if you wish to use these types -# the "usefrom" keyword defines the types for the registry without generating -# a NWTC_Library_Types.f90 file -# -#............................................................. - - -typedef NWTC_Library ProgDesc CHARACTER(99) Name - - - "Name of the program or module" -typedef ^ ^ CHARACTER(99) Ver - - - "Version number of the program or module" -typedef ^ ^ CHARACTER(24) Date - - - "String containing date module was last updated" - -typedef NWTC_Library FASTdataType CHARACTER(1024) File - - - "Name of the FAST-style binary file" -typedef ^ ^ CHARACTER(1024) Descr - - - "String describing file" -typedef ^ ^ IntKi NumChans - - - "Number of output channels in this binary file (not including the time channel)" -typedef ^ ^ IntKi NumRecs - - - "Number of records (rows) of data in the file" -typedef ^ ^ DbKi TimeStep - - - "Time step for evenly-spaced data in the output file (when NumRecs is not allo" -typedef ^ ^ CHARACTER(ChanLen) ChanNames {:} - - "Strings describing the names of the channels from the binary file (including the time channel)" -typedef ^ ^ CHARACTER(ChanLen) ChanUnits {:} - - "Strings describing the units of the channels from the binary file (including the time channel)" -typedef ^ ^ ReKi Data {:}{:} - - "numeric data (rows and columns) from the binary file, including the time channel" - -typedef NWTC_Library OutParmType IntKi Indx - - - "An index into AllOuts array where this channel is computed/stored" -typedef ^ ^ CHARACTER(ChanLen) Name - - - "Name of the output channel" -typedef ^ ^ CHARACTER(ChanLen) Units - - - "Units this channel is specified in" -typedef ^ ^ IntKi SignM - - - "Multiplier for output channel; usually -1 (minus) or 0 (invalid channel)" - -typedef NWTC_Library FileInfoType IntKi NumLines -typedef ^ ^ IntKi NumFiles -typedef ^ ^ IntKi FileLine {:} -typedef ^ ^ IntKi FileIndx {:} -typedef ^ ^ CHARACTER(MaxFileInfoLineLen) FileList {:} -typedef ^ ^ CHARACTER(MaxFileInfoLineLen) Lines {:} - -typedef NWTC_Library Quaternion ReKi q0 -typedef ^ ^ ReKi v {3} - -typedef NWTC_Library NWTC_RandomNumber_ParameterType IntKi pRNG -typedef ^ ^ IntKi RandSeed {3} -typedef ^ ^ IntKi RandSeedAry {:} -typedef ^ ^ CHARACTER(6) RNG_type diff --git a/modules/nwtc-library/src/SingPrec.f90 b/modules/nwtc-library/src/SingPrec.f90 index edcfcf1740..ea0b6c246d 100644 --- a/modules/nwtc-library/src/SingPrec.f90 +++ b/modules/nwtc-library/src/SingPrec.f90 @@ -29,24 +29,36 @@ MODULE Precision !.................................................................................................................................. #ifdef HAS_FORTRAN2008_FEATURES -USE, INTRINSIC :: ISO_FORTRAN_ENV, ONLY: real32, real64, real128 +USE, INTRINSIC :: ISO_FORTRAN_ENV, ONLY: real32, real64, real128, int8, int16, int32, int64 #endif -IMPLICIT NONE +IMPLICIT NONE + +#ifdef HAS_FORTRAN2008_FEATURES + +INTEGER, PARAMETER :: B1Ki = int8 !< Kind for one-byte whole numbers +INTEGER, PARAMETER :: B2Ki = int16 !< Kind for two-byte whole numbers +INTEGER, PARAMETER :: B4Ki = int32 !< Kind for four-byte whole numbers +INTEGER, PARAMETER :: B8Ki = int64 !< Kind for eight-byte whole numbers + +INTEGER, PARAMETER :: R4Ki = real32 !< Kind for four-byte, floating-point numbers +INTEGER, PARAMETER :: R8Ki = real64 !< Kind for eight-byte floating-point numbers + +#else INTEGER, PARAMETER :: B1Ki = SELECTED_INT_KIND( 2 ) !< Kind for one-byte whole numbers INTEGER, PARAMETER :: B2Ki = SELECTED_INT_KIND( 4 ) !< Kind for two-byte whole numbers INTEGER, PARAMETER :: B4Ki = SELECTED_INT_KIND( 9 ) !< Kind for four-byte whole numbers INTEGER, PARAMETER :: B8Ki = SELECTED_INT_KIND( 18 ) !< Kind for eight-byte whole numbers -#ifdef HAS_FORTRAN2008_FEATURES -INTEGER, PARAMETER :: R4Ki = real32 !< Kind for four-byte, floating-point numbers -INTEGER, PARAMETER :: R8Ki = real64 !< Kind for eight-byte floating-point numbers -#else INTEGER, PARAMETER :: R4Ki = SELECTED_REAL_KIND( 6, 30 ) !< Kind for four-byte, floating-point numbers INTEGER, PARAMETER :: R8Ki = SELECTED_REAL_KIND( 14, 300 ) !< Kind for eight-byte floating-point numbers + #endif +INTEGER, PARAMETER :: BYTES_IN_B4Ki = 4 !< Number of bytes per B4Ki number +INTEGER, PARAMETER :: BYTES_IN_B8Ki = 8 !< Number of bytes per B8Ki number + INTEGER, PARAMETER :: BYTES_IN_R4Ki = 4 !< Number of bytes per R4Ki number INTEGER, PARAMETER :: BYTES_IN_R8Ki = 8 !< Number of bytes per R8Ki number @@ -55,7 +67,7 @@ MODULE Precision ! The default kinds for reals and integers, and the number of bytes they contain: INTEGER, PARAMETER :: IntKi = B4Ki !< Default kind for integers -INTEGER, PARAMETER :: BYTES_IN_INT = 4 !< Number of bytes per IntKi number - use SIZEOF() +INTEGER, PARAMETER :: BYTES_IN_INT = BYTES_IN_B4Ki !< Number of bytes per IntKi number - use SIZEOF() INTEGER, PARAMETER :: SiKi = R4Ki !< Default kind for single floating-point numbers INTEGER, PARAMETER :: BYTES_IN_SiKi = BYTES_IN_R4Ki !< Number of bytes per R4Ki number - use SIZEOF() diff --git a/modules/nwtc-library/src/SysIVF.f90 b/modules/nwtc-library/src/SysIVF.f90 index 603ad6da7e..2a6304dbdb 100644 --- a/modules/nwtc-library/src/SysIVF.f90 +++ b/modules/nwtc-library/src/SysIVF.f90 @@ -193,18 +193,18 @@ END SUBROUTINE Get_CWD !> This routine creates a given directory if it does not already exist. SUBROUTINE MKDIR ( new_directory_path ) + USE IFPORT, ONLY: MAKEDIRQQ implicit none character(*), intent(in) :: new_directory_path - character(1024) :: make_command logical :: directory_exists + logical :: success ! Check if the directory exists first inquire( directory=trim(new_directory_path), exist=directory_exists ) if ( .NOT. directory_exists ) then - make_command = 'mkdir "'//trim(new_directory_path)//'"' - call system( make_command ) + success = MAKEDIRQQ( trim(new_directory_path) ) endif END SUBROUTINE MKDIR diff --git a/modules/nwtc-library/src/SysMatlabWindows.f90 b/modules/nwtc-library/src/SysMatlabWindows.f90 index ff266e9b13..09c931aff2 100644 --- a/modules/nwtc-library/src/SysMatlabWindows.f90 +++ b/modules/nwtc-library/src/SysMatlabWindows.f90 @@ -47,7 +47,6 @@ MODULE SysSubs !======================================================================= - INTEGER, PARAMETER :: ConRecL = 120 ! The record length for console output. INTEGER, PARAMETER :: CU = 6 ! The I/O unit for the console. INTEGER, PARAMETER :: MaxWrScrLen = 98 ! The maximum number of characters allowed to be written to a line in WrScr diff --git a/modules/nwtc-library/src/VTK.f90 b/modules/nwtc-library/src/VTK.f90 index 0083582caf..a407c9d770 100644 --- a/modules/nwtc-library/src/VTK.f90 +++ b/modules/nwtc-library/src/VTK.f90 @@ -5,15 +5,14 @@ module VTK use Precision, only: IntKi, SiKi, ReKi - use NWTC_Base, only: ErrID_None, ErrID_Fatal, AbortErrLev, ErrMsgLen + use NWTC_Base, only: ErrID_None, ErrID_Fatal, AbortErrLev, ErrMsgLen, SetErrStat use NWTC_IO, only: GetNewUnit, NewLine, WrScr, ReadStr, OpenFOutFile use NWTC_IO, only: OpenFinpFile, ReadCom, Conv2UC - use NWTC_IO, only: SetErrStat implicit none - character(8), parameter :: RFMT='E17.8E3' - character(8), parameter :: IFMT='I7' + character(*), parameter :: RFMT='E17.8E3' + character(*), parameter :: IFMT='I7' ! Internal type to ensure the same options are used in between calls for the functions vtk_* TYPE, PUBLIC :: VTK_Misc diff --git a/modules/nwtc-library/src/ranlux/RANLUX.f90 b/modules/nwtc-library/src/ranlux/RANLUX.f90 index a9ae2063ff..e58830d546 100644 --- a/modules/nwtc-library/src/ranlux/RANLUX.f90 +++ b/modules/nwtc-library/src/ranlux/RANLUX.f90 @@ -36,9 +36,6 @@ Module Ran_Lux_Mod ! 1 1.5 2 3 5 on fast mainframe ! ! NotYet is .TRUE. if no initialization has been performed yet. -!Start bjj: We want to write to the screen instead of "print *" -! use NWTC_IO -!End bjj: use precision implicit none @@ -78,22 +75,12 @@ subroutine RanLux (RVec) NotYet = .FALSE. JSeed = JSDFlt InSeed = JSeed -!begin bjj -! print *, " RanLux default initialization: ", JSeed -! write( RanLux_str, '(I12)' ) JSeed -! CALL WrScr( " RanLux default initialization: "//TRIM( ADJUSTL( RanLux_str ) ) ) -!end bjj LuxLev = LxDflt NSkip = NDSkip(LuxLev) LP = NSkip + NSeeds - 1 In24 = 0 Kount = 0 MKount = 0 -!begin bjj -! print *, " RanLux default luxury level = ", LuxLev, " p = ", LP -! write( RanLux_str, '(A,I5,A,I12)' ) " RanLux default luxury level = ", LuxLev, " p = ", LP -! CALL WrScr( TRIM( RanLux_str ) ) -!end bjj TwoM24 = 1.0 do I = 1, NSeeds - 1 @@ -129,14 +116,8 @@ subroutine RanLux (RVec) ! "Pad" small numbers (with less than 12 "significant" bits) and eliminate zero values (in case someone takes a logarithm) if ( RVec(IVec) < TwoM12 ) RVec(IVec) = RVec(IVec) + tmpTwoM24Seed if ( Rvec(IVec) == 0.0 ) RVec(IVec) = tmpTwoM24 - !bjj end of modifications end do - !bjj removed to eliminate crashing in SNwind - ! "Pad" small numbers (with less than 12 "significant" bits) and eliminate zero values (in case someone takes a logarithm) - !where (RVec < TwoM12) RVec = RVec + TwoM24 * Seeds(J24) - !where (Rvec == 0.0) RVec = TwoM24 * TwoM24 - !bjj end of modifications Kount = Kount + LEnv if (Kount >= IGiga) then @@ -152,21 +133,12 @@ subroutine RLuxIn (ISDext) integer :: I, ISD ! start subroutine RLuxIn if (Size(ISDext) /= NSeeds) then -!begin bjj -! print *, " Array size for RLuxIn must be ", NSeeds -! write( RanLux_str, '(I5)' ) NSeeds -! CALL WrScr( " Array size for RLuxIn must be "//TRIM( ADJUSTL(RanLux_str) ) ) -!end bjj return end if ! The following IF block added by Phillip Helbig, based on conversation with Fred James; ! an equivalent correction has been published by James. if (NotYet) then -!begin bjj -! print *, " Proper results only with initialisation from 25 integers obtained with RLuxUt" -! CALL WrScr( " Proper results only with initialisation from 25 integers obtained with RLuxUt" ) -!end bjj NotYet = .FALSE. end if TwoM24 = 1.0 @@ -174,13 +146,6 @@ subroutine RLuxIn (ISDext) TwoM24 = TwoM24 * 0.5 end do TwoM12 = TwoM24 * 4096.0 -!Start bjj -! print *, " Full initialization of RanLux with 25 integers:" -! print *, ISDext -! CALL WrScr ( " Full initialization of RanLux with 25 integers:" ) -! write( RanLux_str, '(25(I11,1x))' ) ISDext -! CALL WrScr ( TRIM( RanLux_str ) ) -!End bjj Seeds = Real (ISDext(: NSeeds - 1)) * TwoM24 Carry = 0.0 if (ISDext(NSeeds) < 0) Carry = TwoM24 @@ -199,22 +164,10 @@ subroutine RLuxIn (ISDext) if (LuxLev <= MaxLev) then NSkip = NDSkip(LuxLev) -!start bjj -! print *, " RanLux luxury level set by RLuxIn to: ", LuxLev\ -! CALL WrScr( " RanLux luxury level set by RLuxIn to: "//TRIM(ADJUSTL(RanLux_str) )) -!end bjj else if (LuxLev >= NSeeds - 1) then NSkip = LuxLev - NSeeds + 1 -!start bjj -! print *, " RanLux p-value set by RLuxIn to:", LuxLev -! CALL WrScr( " RanLux p-value set by RLuxIn to: "//TRIM(ADJUSTL(RanLux_str) )) -!end bjj else NSkip = NDSkip(MaxLev) -!start bjj -! print *, " RanLux illegal luxury RLuxIn: ", LuxLev -! CALL WrScr( " RanLux illegal luxury RLuxIn: "//TRIM(ADJUSTL(RanLux_str) )) -!end bjj LuxLev = MaxLev end if InSeed = - 1 @@ -227,11 +180,6 @@ subroutine RLuxUt (ISDext) ! start subroutine RLuxUt if (Size(ISDext) /= NSeeds) then ISDext = 0 -!start bjj -! print *, " Array size for RLuxUt must be ", NSeeds -! write( RanLux_str, '(I20)' ) NSeeds -! CALL WrScr( " Array size for RLuxUt must be "//TRIM( ADJUSTL(RanLux_str ))) -!end bjj return end if ISDext(: NSeeds - 1) = Int (Seeds * TwoP12 * TwoP12) @@ -261,11 +209,6 @@ subroutine RLuxGo (Lux, Int, K1, K2) LuxLev = Lux else if (Lux < NSeeds - 1 .or. Lux > 2000) then LuxLev = MaxLev -!start bjj -! print *, " RanLux illegal luxury level in RLuxGo: ", Lux -! write( RanLux_str, '(I20)' ) Lux -! Call WrScr( " RanLux illegal luxury level in RLuxGo: "//TRIM( ADJUSTL(RanLux_str ) )) -!end bjj else LuxLev = Lux do ILx = 0, MaxLev @@ -276,39 +219,15 @@ subroutine RLuxGo (Lux, Int, K1, K2) end if if (LuxLev <= MaxLev) then NSkip = NDSkip(LuxLev) -!start bjj -! print *, " RanLux luxury level set by RLuxGo :", LuxLev, " p = ", NSkip + NSeeds - 1 -! write (RanLux_str, '(A,I5)') " RanLux luxury level set by RLuxGo :", LuxLev -! write (RanLux_str, '(A,I12)') TRIM(RanLux_str)//" p = ", NSkip + NSeeds - 1 -! CALL WrScr( TRIM(RanLux_str) ) -!end bjj else NSkip = LuxLev - 24 -!start bjj -! print *, " RanLux p-value set by RLuxGo to:", LuxLev -! write( RanLux_str, '(I20)' ) LuxLev -! CALL WrScr( " RanLux p-value set by RLuxGo to: "//TRIM( ADJUSTL(RanLux_str ) )) -!end bjj end if In24 = 0 if (Int < 0) then -!start bjj -! print *, " Illegal initialization by RLuxGo, negative input seed" -! CALL WrScr( " Illegal initialization by RLuxGo, negative input seed" ) -!end bjj else if (Int > 0) then JSeed = Int -!start bjj -! print *, " RanLux initialized by RLuxGo from Seeds", JSeed, K1, K2 -! write( RanLux_str, '(3(I12))' ) JSeed, K1, K2 -! CALL WrScr( " RanLux initialized by RLuxGo from Seeds"//TRIM( RanLux_str ) ) -!end bjj else JSeed = JSDFlt -!start bjj -! print *, " RanLux initialized by RLuxGo from default seed" -! CALL WrScr( " RanLux initialized by RLuxGo from default seed" ) -!end bjj end if InSeed = JSeed NotYet = .FALSE. @@ -343,12 +262,6 @@ subroutine RLuxGo (Lux, Int, K1, K2) end if ! Now IN24 had better be between zero and 23 inclusive if ((In24 < 1) .or. (In24 >= NSeeds - 1)) then -!start bjj -! print *, " Error in restarting with RLuxGo: the values", Int, K1, K2, " cannot occur at luxury level", LuxLev -! write( RanLux_str, '(A,3(I12),A,I5)' ) " Error in restarting with RLuxGo: the values ", Int, K1, K2, & -! " cannot occur at luxury level ", LuxLev -! CALL WrScr( TRIM(RanLux_str ) ) -!end bjj In24 = 0 end if end if diff --git a/modules/nwtc-library/src/readme.txt b/modules/nwtc-library/src/readme.txt deleted file mode 100644 index 607db5ced8..0000000000 --- a/modules/nwtc-library/src/readme.txt +++ /dev/null @@ -1,8 +0,0 @@ -The two NWTC_Library-related types files cannot be generated through the registry. At the moment it is a manual process. - -The NWTC registry input file gets split into two sections: one for the mesh mapping and everything else. -It's not an automatic process since you have to copy the SetErrStat routine into NWTC_Library_Types.f90, -and you have to copy the mesh-related types/routines into the ModMesh_Types.f90 file. -Originally, we also had to change some other parts, too, but I've hard-coded some stuff -in the registry source code for when it is trying to generate types for the NWTC_Library module. -We could hard-code the registry to generate SetErrStat() at some point, too. \ No newline at end of file diff --git a/modules/nwtc-library/tests/nwtc_library_utest.F90 b/modules/nwtc-library/tests/nwtc_library_utest.F90 new file mode 100644 index 0000000000..33be4d3475 --- /dev/null +++ b/modules/nwtc-library/tests/nwtc_library_utest.F90 @@ -0,0 +1,35 @@ +program nwtc_library_utest +use, intrinsic :: iso_fortran_env, only: error_unit +use testdrive, only: run_testsuite, new_testsuite, testsuite_type + +use test_NWTC_IO_FileInfo, only: test_NWTC_IO_FileInfo_suite +use test_NWTC_RandomNumber, only: test_NWTC_RandomNumber_suite +use NWTC_Num + +implicit none +integer :: stat, is +type(testsuite_type), allocatable :: testsuites(:) +character(len=*), parameter :: fmt = '("#", *(1x, a))' + +stat = 0 + +call SetConstants() + +testsuites = [ & + new_testsuite("test_NWTC_IO_FileInfo", test_NWTC_IO_FileInfo_suite), & + new_testsuite("test_NWTC_RandomNumber_suite", test_NWTC_RandomNumber_suite) & + ] + +do is = 1, size(testsuites) + write (error_unit, fmt) "Testing:", testsuites(is)%name + call run_testsuite(testsuites(is)%collect, error_unit, stat) +end do + +if (stat > 0) then + write (error_unit, '(i0, 1x, a)') stat, "test(s) failed!" + error stop +end if + +write (error_unit, fmt) "All tests PASSED" + +end program diff --git a/modules/nwtc-library/tests/test_NWTC_IO_FileInfo.F90 b/modules/nwtc-library/tests/test_NWTC_IO_FileInfo.F90 index 720ac96738..400885ece4 100644 --- a/modules/nwtc-library/tests/test_NWTC_IO_FileInfo.F90 +++ b/modules/nwtc-library/tests/test_NWTC_IO_FileInfo.F90 @@ -1,143 +1,153 @@ module test_NWTC_IO_FileInfo - use pFUnit_mod - use NWTC_IO - - implicit none +use iso_c_binding, only: c_char, c_null_char +use testdrive, only: new_unittest, unittest_type, error_type, check +use NWTC_IO + +implicit none +private +public :: test_NWTC_IO_FileInfo_suite contains -@test -subroutine test_initfileinfo() - - ! This case should result in error status 0. - ! It's a normal initialization of FileInfoType. - - integer, parameter :: num_lines = 5 - integer, parameter :: num_files = 1 - - integer(IntKi) :: error_status - character(ErrMsgLen) :: error_message - character(MaxFileInfoLineLen) :: input_strings(num_lines) - type(FileInfoType) :: file_info_type - integer :: i - - input_strings = (/ & - "line 0", & - "line 1", & - "line 2", & - "line 3", & - "line 4" & - /) - call InitFileInfo( input_strings, file_info_type, error_status, error_message ) - - @assertEqual(num_lines, file_info_type%NumLines) - @assertEqual(num_files, file_info_type%NumFiles) - do i = 1, num_lines - @assertEqual(i, file_info_type%FileLine(i)) - end do - do i = 1, num_files - @assertEqual(i, file_info_type%FileIndx(i)) - end do - - ! TODO: test FileList when we actually use it - - do i = 1, num_lines - @assertEqual( trim(input_strings(i)), trim(file_info_type%Lines(i)) ) - end do - - @assertEqual( 0, error_status ) - @assertEqual( "", error_message ) +!> Collect all exported unit tests +subroutine test_NWTC_IO_FileInfo_suite(testsuite) + type(unittest_type), allocatable, intent(out) :: testsuite(:) + testsuite = [ & + new_unittest("test_initfileinfo", test_initfileinfo), & + new_unittest("test_initfileinfo2", test_initfileinfo2) & + ] end subroutine -@test -subroutine test_initfileinfo2() - - ! This case should result in a non-zero error status. - ! It attempts to initialize FileInfoType without having - ! properly initializing the input strings array. - - integer, parameter :: num_lines = 5 - integer, parameter :: num_files = 1 - - integer(IntKi) :: error_status - character(ErrMsgLen) :: error_message - character(MaxFileInfoLineLen*2) :: input_strings(num_lines) - character(MaxFileInfoLineLen*2) :: tmpstring - type(FileInfoType) :: file_info_type - integer :: i - - input_strings = (/ & - "line 0", & - "line 1", & - "line 2", & - "line 3", & - "line 4" & - /) - ! make the last character a + so a trim does not reduce this string length - tmpstring=input_strings(5) - tmpstring(MaxFileInfoLineLen+1:MaxFileInfoLineLen+1) = 'a' - input_strings(5)=tmpstring - call InitFileInfo( input_strings, file_info_type, error_status, error_message ) - @assertEqual(num_lines, file_info_type%NumLines) - @assertEqual(num_files, file_info_type%NumFiles) - @assertEqual( 4, error_status ) - +subroutine test_initfileinfo(error) + type(error_type), allocatable, intent(out) :: error + + ! This case should result in error status 0. + ! It's a normal initialization of FileInfoType. + + integer, parameter :: num_lines = 5 + integer, parameter :: num_files = 1 + + integer(IntKi) :: error_status + character(ErrMsgLen) :: error_message + character(MaxFileInfoLineLen) :: input_strings(num_lines) + type(FileInfoType) :: file_info_type + integer :: i + + input_strings = (/ & + "line 0", & + "line 1", & + "line 2", & + "line 3", & + "line 4" & + /) + call InitFileInfo(input_strings, file_info_type, error_status, error_message) + + call check(error, num_lines, file_info_type%NumLines) + call check(error, num_files, file_info_type%NumFiles) + do i = 1, num_lines + call check(error, i, file_info_type%FileLine(i)) + end do + do i = 1, num_files + call check(error, i, file_info_type%FileIndx(i)) + end do + + ! TODO: test FileList when we actually use it + + do i = 1, num_lines + call check(error, trim(input_strings(i)), trim(file_info_type%Lines(i))) + end do + + call check(error, 0, error_status) + call check(error, "", error_message) end subroutine -@test -subroutine test_initfileinfo3() - USE ISO_C_BINDING, only: C_CHAR, C_NULL_CHAR - - ! This case should result in zero error status. - ! It attempts to initialize FileInfoType with a C_NULL_CHAR delimited string and compare with the equivalent array parsing - - integer, parameter :: num_lines = 7 - integer, parameter :: num_files = 1 - - integer(IntKi) :: error_status - character(ErrMsgLen) :: error_message - character(kind=C_CHAR,len=MaxFileInfoLineLen*2) :: input_string - character(MaxFileInfoLineLen) :: input_string_array(num_lines) - type(FileInfoType) :: file_info_type - type(FileInfoType) :: file_info_type_array - integer :: i - - ! Fortron string array pass - input_string_array = (/ & - "line 0", & - "line 1", & - "line 2", & - "line 3", & - "line 4", & - "line 5", & - "line 6" & - /) - call InitFileInfo( input_string_array, file_info_type_array, error_status, error_message ) - @assertEqual(num_lines, file_info_type_array%NumLines) - @assertEqual(num_files, file_info_type_array%NumFiles) - @assertEqual( 0, error_status ) - - - ! Equivalent C_CHAR string to pass - ! Note: the rest of the input string is empty. This won't pose an issue since the remainder of the empty string is ignored. - input_string = "line 0"//C_NULL_CHAR// & - "line 1"//C_NULL_CHAR// & - "line 2"//C_NULL_CHAR// & - "line 3"//C_NULL_CHAR// & - "line 4"//C_NULL_CHAR// & - "line 5"//C_NULL_CHAR// & - "line 6"//C_NULL_CHAR - call InitFileInfo( input_string, file_info_type, error_status, error_message ) - @assertEqual(num_lines, file_info_type%NumLines) - @assertEqual(num_files, file_info_type%NumFiles) - @assertEqual( 0, error_status ) - - ! Now check that the entries are identical - do i = 1, num_lines - @assertEqual( trim(file_info_type_array%Lines(i)), trim(file_info_type%Lines(i)) ) - end do - +subroutine test_initfileinfo2(error) + type(error_type), allocatable, intent(out) :: error + + ! This case should result in a non-zero error status. + ! It attempts to initialize FileInfoType without having + ! properly initializing the input strings array. + + integer, parameter :: num_lines = 5 + integer, parameter :: num_files = 1 + + integer(IntKi) :: error_status + character(ErrMsgLen) :: error_message + character(MaxFileInfoLineLen*2) :: input_strings(num_lines) + character(MaxFileInfoLineLen*2) :: tmpstring + type(FileInfoType) :: file_info_type + integer :: i + + input_strings = (/ & + "line 0", & + "line 1", & + "line 2", & + "line 3", & + "line 4" & + /) + ! make the last character a + so a trim does not reduce this string length + tmpstring = input_strings(5) + tmpstring(MaxFileInfoLineLen + 1:MaxFileInfoLineLen + 1) = 'a' + input_strings(5) = tmpstring + call InitFileInfo(input_strings, file_info_type, error_status, error_message) + call check(error, num_lines, file_info_type%NumLines) + call check(error, num_files, file_info_type%NumFiles) + call check(error, 4, error_status) + +end subroutine + +subroutine test_initfileinfo3(error) + type(error_type), allocatable, intent(out) :: error + + ! This case should result in zero error status. + ! It attempts to initialize FileInfoType with a C_NULL_CHAR delimited string and compare with the equivalent array parsing + + integer, parameter :: num_lines = 7 + integer, parameter :: num_files = 1 + + integer(IntKi) :: error_status + character(ErrMsgLen) :: error_message + character(kind=C_CHAR, len=MaxFileInfoLineLen*2) :: input_string + character(MaxFileInfoLineLen) :: input_string_array(num_lines) + type(FileInfoType) :: file_info_type + type(FileInfoType) :: file_info_type_array + integer :: i + + ! Fortron string array pass + input_string_array = (/ & + "line 0", & + "line 1", & + "line 2", & + "line 3", & + "line 4", & + "line 5", & + "line 6" & + /) + call InitFileInfo(input_string_array, file_info_type_array, error_status, error_message) + call check(error, num_lines, file_info_type_array%NumLines) + call check(error, num_files, file_info_type_array%NumFiles) + call check(error, 0, error_status) + + ! Equivalent C_CHAR string to pass + ! Note: the rest of the input string is empty. This won't pose an issue since the remainder of the empty string is ignored. + input_string = "line 0"//C_NULL_CHAR// & + "line 1"//C_NULL_CHAR// & + "line 2"//C_NULL_CHAR// & + "line 3"//C_NULL_CHAR// & + "line 4"//C_NULL_CHAR// & + "line 5"//C_NULL_CHAR// & + "line 6"//C_NULL_CHAR + call InitFileInfo(input_string, file_info_type, error_status, error_message) + call check(error, num_lines, file_info_type%NumLines) + call check(error, num_files, file_info_type%NumFiles) + call check(error, 0, error_status) + + ! Now check that the entries are identical + do i = 1, num_lines + call check(error, trim(file_info_type_array%Lines(i)), trim(file_info_type%Lines(i))) + end do + end subroutine end module diff --git a/modules/nwtc-library/tests/test_NWTC_RandomNumber.F90 b/modules/nwtc-library/tests/test_NWTC_RandomNumber.F90 index 2821a521fe..9b080331e2 100644 --- a/modules/nwtc-library/tests/test_NWTC_RandomNumber.F90 +++ b/modules/nwtc-library/tests/test_NWTC_RandomNumber.F90 @@ -1,57 +1,70 @@ module test_NWTC_RandomNumber - use pFUnit_mod - use NWTC_RandomNumber - use nwtc_library_test_tools - - implicit none +use testdrive, only: new_unittest, unittest_type, error_type, check +use NWTC_RandomNumber +use nwtc_library_test_tools - character(1024), parameter :: dumpfile="randnumber.temp" +implicit none + +character(1024), parameter :: dumpfile = "randnumber.temp" + +private +public :: test_NWTC_RandomNumber_suite contains - -@test -subroutine test_RANLUX() - type(NWTC_RandomNumber_ParameterType) :: p ! Paramters for random number generation - integer(IntKi) :: error_status - character(ErrMsgLen) :: error_message +!> Collect all exported unit tests +subroutine test_NWTC_RandomNumber_suite(testsuite) + type(unittest_type), allocatable, intent(out) :: testsuite(:) + testsuite = [ & + new_unittest("test_RANLUX", test_RANLUX), & + new_unittest("test_INTRINSIC", test_INTRINSIC) & + ] +end subroutine + +subroutine test_RANLUX(error) + type(error_type), allocatable, intent(out) :: error + + type(NWTC_RandomNumber_ParameterType) :: p ! Paramters for random number generation + integer(IntKi) :: error_status + character(ErrMsgLen) :: error_message - real(ReKi) :: random_numbers(2) ! Uniformly distributed random numbers + real(ReKi) :: random_numbers(2) ! Uniformly distributed random numbers - p%pRNG = pRNG_RANLUX - p%RandSeed(1) = 1 + p%pRNG = pRNG_RANLUX + p%RandSeed(1) = 1 - call RandNum_Init(p, error_status, error_message) - @assertEqual( 0, error_status ) + call RandNum_Init(p, error_status, error_message) + call check(error, error_status, ErrID_None) - call UniformRandomNumbers(p%pRNG, random_numbers) - @assertEqual( (/ 0.94589489698410034, 0.47347849607467651 /), random_numbers ) + call UniformRandomNumbers(p%pRNG, random_numbers) + call check(error, 0.94589489698410034_ReKi, random_numbers(1)) + call check(error, 0.47347849607467651_ReKi, random_numbers(2)) end subroutine -@test -subroutine test_INTRINSIC() +subroutine test_INTRINSIC(error) + type(error_type), allocatable, intent(out) :: error - type(NWTC_RandomNumber_ParameterType) :: p ! Paramters for random number generation - integer(IntKi) :: error_status - character(ErrMsgLen) :: error_message + type(NWTC_RandomNumber_ParameterType) :: p ! Paramters for random number generation + integer(IntKi) :: error_status + character(ErrMsgLen) :: error_message - integer :: expected_seed_count - real(ReKi) :: random_numbers(2) ! Uniformly distributed random numbers + integer :: expected_seed_count + real(ReKi) :: random_numbers(2) ! Uniformly distributed random numbers - p%pRNG = pRNG_INTRINSIC - p%RandSeed(1) = 1 - p%RandSeed(2) = 2 + p%pRNG = pRNG_INTRINSIC + p%RandSeed(1) = 1 + p%RandSeed(2) = 2 - call hide_terminal_output() - call RandNum_Init(p, error_status, error_message) - call show_terminal_output() - @assertEqual( 0, error_status ) + call hide_terminal_output() + call RandNum_Init(p, error_status, error_message) + call show_terminal_output() + call check(error, error_status, ErrID_None) - ! We cant use this test since it will fail for various machine/compiler combinations - ! call UniformRandomNumbers(p%pRNG, random_numbers) - ! @assertEqual( (/ 0.80377975339288821, 0.47469797199574959 /), random_numbers ) + ! We cant use this test since it will fail for various machine/compiler combinations + ! call UniformRandomNumbers(p%pRNG, random_numbers) + ! call check(error, (/ 0.80377975339288821, 0.47469797199574959 /), random_numbers ) end subroutine end module diff --git a/modules/openfast-library/CMakeLists.txt b/modules/openfast-library/CMakeLists.txt index d549e705f9..e4ac77521c 100644 --- a/modules/openfast-library/CMakeLists.txt +++ b/modules/openfast-library/CMakeLists.txt @@ -37,36 +37,43 @@ elseif (${_compiler_id} MATCHES "^INTEL" AND ${_build_type} STREQUAL "RELEASE" A set_source_files_properties(src/FAST_Types.f90 PROPERTIES COMPILE_FLAGS "-O2") endif() -add_library(openfast_prelib src/FAST_Types.f90) +add_library(openfast_prelib STATIC + src/FAST_Types.f90 +) target_link_libraries(openfast_prelib nwtclibs versioninfolib - aerodyn14lib + aerodisklib aerodynlib + extloadslib beamdynlib elastodynlib extptfm_mckflib feamlib - foamtypeslib + extinflowtypeslib hydrodynlib icedynlib icefloelib ifwlib - maplib + mappplib moordynlib orcaflexlib sctypeslib + seastlib + sedlib servodynlib subdynlib ) -add_library(openfast_postlib +add_library(openfast_postlib STATIC src/FAST_Lin.f90 src/FAST_Mods.f90 src/FAST_Subs.f90 src/FAST_Solver.f90 + src/FAST_SS_Subs.f90 + src/FAST_SS_Solver.f90 ) -target_link_libraries(openfast_postlib openfast_prelib foamfastlib scfastlib) +target_link_libraries(openfast_postlib openfast_prelib extinflowlib scfastlib) target_include_directories(openfast_postlib PUBLIC $ ) @@ -77,7 +84,9 @@ add_library(openfastlib_static INTERFACE) target_link_libraries(openfastlib_static INTERFACE openfast_postlib) # OpenFAST Library shared (Python, openfast_cpp, openfastcpplib) -add_library(openfastlib SHARED src/FAST_Library.f90) +add_library(openfastlib SHARED + src/FAST_Library.f90 +) target_link_libraries(openfastlib openfast_postlib) if(APPLE OR UNIX) target_compile_definitions(openfastlib PRIVATE IMPLICIT_DLLEXPORT) diff --git a/modules/openfast-library/src/FAST_Library.f90 b/modules/openfast-library/src/FAST_Library.f90 index a7c60a8722..6a957dcf6f 100644 --- a/modules/openfast-library/src/FAST_Library.f90 +++ b/modules/openfast-library/src/FAST_Library.f90 @@ -1,53 +1,53 @@ -! FAST_Library.f90 +! FAST_Library.f90 ! ! FUNCTIONS/SUBROUTINES exported from FAST_Library.dll: -! FAST_Start - subroutine -! FAST_Update - subroutine -! FAST_End - subroutine -! +! FAST_Start - subroutine +! FAST_Update - subroutine +! FAST_End - subroutine +! ! DO NOT REMOVE or MODIFY LINES starting with "!DEC$" or "!GCC$" ! !DEC$ specifies attributes for IVF and !GCC$ specifies attributes for gfortran ! -!================================================================================================================================== +!================================================================================================================================== MODULE FAST_Data USE, INTRINSIC :: ISO_C_Binding USE FAST_Subs ! all of the ModuleName and ModuleName_types modules are inherited from FAST_Subs - + IMPLICIT NONE SAVE - + ! Local parameters: REAL(DbKi), PARAMETER :: t_initial = 0.0_DbKi ! Initial time - INTEGER(IntKi) :: NumTurbines + INTEGER(IntKi) :: NumTurbines INTEGER, PARAMETER :: IntfStrLen = 1025 ! length of strings through the C interface INTEGER(IntKi), PARAMETER :: MAXOUTPUTS = 4000 ! Maximum number of outputs INTEGER(IntKi), PARAMETER :: MAXInitINPUTS = 53 ! Maximum number of initialization values from Simulink INTEGER(IntKi), PARAMETER :: NumFixedInputs = 51 - - + + ! Global (static) data: TYPE(FAST_TurbineType), ALLOCATABLE :: Turbine(:) ! Data for each turbine INTEGER(IntKi) :: n_t_global ! simulation time step, loop counter for global (FAST) simulation INTEGER(IntKi) :: ErrStat ! Error status CHARACTER(IntfStrLen-1) :: ErrMsg ! Error message (this needs to be static so that it will print in Matlab's mex library) - + contains -!================================================================================================================================== +!================================================================================================================================== subroutine FAST_AllocateTurbines(nTurbines, ErrStat_c, ErrMsg_c) BIND (C, NAME='FAST_AllocateTurbines') - IMPLICIT NONE + IMPLICIT NONE #ifndef IMPLICIT_DLLEXPORT !DEC$ ATTRIBUTES DLLEXPORT :: FAST_AllocateTurbines !GCC$ ATTRIBUTES DLLEXPORT :: FAST_AllocateTurbines #endif INTEGER(C_INT), INTENT(IN ) :: nTurbines INTEGER(C_INT), INTENT( OUT) :: ErrStat_c - CHARACTER(KIND=C_CHAR), INTENT( OUT) :: ErrMsg_c(IntfStrLen) - + CHARACTER(KIND=C_CHAR), INTENT( OUT) :: ErrMsg_c(IntfStrLen) + if (nTurbines > 0) then NumTurbines = nTurbines end if - + if (nTurbines > 10) then call wrscr1('Number of turbines is > 10! Are you sure you have enough memory?') call wrscr1('Proceeding anyway.') @@ -63,7 +63,7 @@ subroutine FAST_AllocateTurbines(nTurbines, ErrStat_c, ErrMsg_c) BIND (C, NAME=' ErrMsg = " "//C_NULL_CHAR end if ErrMsg_c = TRANSFER( ErrMsg//C_NULL_CHAR, ErrMsg_c ) - + end subroutine FAST_AllocateTurbines !================================================================================================================================== subroutine FAST_DeallocateTurbines(ErrStat_c, ErrMsg_c) BIND (C, NAME='FAST_DeallocateTurbines') @@ -90,20 +90,20 @@ subroutine FAST_Sizes(iTurb_c, InputFileName_c, AbortErrLev_c, NumOuts_c, dt_c, !GCC$ ATTRIBUTES DLLEXPORT :: FAST_Sizes #endif INTEGER(C_INT), INTENT(IN ) :: iTurb_c ! Turbine number, c indexing (starts at 0 for first turbine) - CHARACTER(KIND=C_CHAR), INTENT(IN ) :: InputFileName_c(IntfStrLen) - INTEGER(C_INT), INTENT( OUT) :: AbortErrLev_c - INTEGER(C_INT), INTENT( OUT) :: NumOuts_c - REAL(C_DOUBLE), INTENT( OUT) :: dt_c - REAL(C_DOUBLE), INTENT( OUT) :: dt_out_c + CHARACTER(KIND=C_CHAR), INTENT(IN ) :: InputFileName_c(IntfStrLen) + INTEGER(C_INT), INTENT( OUT) :: AbortErrLev_c + INTEGER(C_INT), INTENT( OUT) :: NumOuts_c + REAL(C_DOUBLE), INTENT( OUT) :: dt_c + REAL(C_DOUBLE), INTENT( OUT) :: dt_out_c REAL(C_DOUBLE), INTENT( OUT) :: tmax_c - INTEGER(C_INT), INTENT( OUT) :: ErrStat_c - CHARACTER(KIND=C_CHAR), INTENT( OUT) :: ErrMsg_c(IntfStrLen) + INTEGER(C_INT), INTENT( OUT) :: ErrStat_c + CHARACTER(KIND=C_CHAR), INTENT( OUT) :: ErrMsg_c(IntfStrLen) CHARACTER(KIND=C_CHAR), INTENT( OUT) :: ChannelNames_c(ChanLen*MAXOUTPUTS+1) - REAL(C_DOUBLE), OPTIONAL, INTENT(IN ) :: TMax - REAL(C_DOUBLE), OPTIONAL, INTENT(IN ) :: InitInpAry(MAXInitINPUTS) - + REAL(C_DOUBLE),OPTIONAL,INTENT(IN ) :: TMax + REAL(C_DOUBLE),OPTIONAL,INTENT(IN ) :: InitInpAry(MAXInitINPUTS) + ! local - CHARACTER(IntfStrLen) :: InputFileName + CHARACTER(IntfStrLen) :: InputFileName INTEGER :: i, j, k TYPE(FAST_ExternInitType) :: ExternInitData integer(IntKi) :: iTurb ! turbine number: Fortran indexing (starts at 1 for first turbine) @@ -115,8 +115,8 @@ subroutine FAST_Sizes(iTurb_c, InputFileName_c, AbortErrLev_c, NumOuts_c, dt_c, InputFileName = TRANSFER( InputFileName_c, InputFileName ) I = INDEX(InputFileName,C_NULL_CHAR) - 1 ! if this has a c null character at the end... IF ( I > 0 ) InputFileName = InputFileName(1:I) ! remove it - - ! initialize variables: + + ! initialize variables: n_t_global = 0 IF (PRESENT(TMax) .AND. .NOT. PRESENT(InitInpAry)) THEN @@ -134,17 +134,11 @@ subroutine FAST_Sizes(iTurb_c, InputFileName_c, AbortErrLev_c, NumOuts_c, dt_c, ExternInitData%TurbinePos = 0.0_ReKi ! turbine position is at the origin ExternInitData%NumCtrl2SC = 0 ExternInitData%NumSC2Ctrl = 0 - ExternInitData%SensorType = NINT(InitInpAry(1)) ! -- MATLAB Integration -- ! Make sure fast farm integration is false ExternInitData%FarmIntegration = .false. - - IF ( NINT(InitInpAry(2)) == 1 ) THEN - ExternInitData%LidRadialVel = .true. - ELSE - ExternInitData%LidRadialVel = .false. - END IF - + ExternInitData%WaveFieldMod = 0 + CALL FAST_InitializeAll_T( t_initial, iTurb, Turbine(iTurb), ErrStat, ErrMsg, InputFileName, ExternInitData) ELSE @@ -152,8 +146,8 @@ subroutine FAST_Sizes(iTurb_c, InputFileName_c, AbortErrLev_c, NumOuts_c, dt_c, CALL FAST_InitializeAll_T( t_initial, iTurb, Turbine(iTurb), ErrStat, ErrMsg, InputFileName) END IF - - AbortErrLev_c = AbortErrLev + + AbortErrLev_c = AbortErrLev NumOuts_c = min(MAXOUTPUTS, SUM( Turbine(iTurb)%y_FAST%numOuts )) dt_c = Turbine(iTurb)%p_FAST%dt dt_out_c = Turbine(iTurb)%p_FAST%DT_Out @@ -162,11 +156,11 @@ subroutine FAST_Sizes(iTurb_c, InputFileName_c, AbortErrLev_c, NumOuts_c, dt_c, ErrStat_c = ErrStat ErrMsg = TRIM(ErrMsg)//C_NULL_CHAR ErrMsg_c = TRANSFER( ErrMsg//C_NULL_CHAR, ErrMsg_c ) - -#ifdef CONSOLE_FILE + +#ifdef CONSOLE_FILE if (ErrStat /= ErrID_None) call wrscr1(trim(ErrMsg)) -#endif - +#endif + ! return the names of the output channels IF ( ALLOCATED( Turbine(iTurb)%y_FAST%ChannelNames ) ) then k = 1; @@ -180,7 +174,7 @@ subroutine FAST_Sizes(iTurb_c, InputFileName_c, AbortErrLev_c, NumOuts_c, dt_c, ELSE ChannelNames_c = C_NULL_CHAR END IF - + end subroutine FAST_Sizes !================================================================================================================================== subroutine FAST_Start(iTurb_c, NumInputs_c, NumOutputs_c, InputAry, OutputAry, ErrStat_c, ErrMsg_c) BIND (C, NAME='FAST_Start') @@ -190,62 +184,65 @@ subroutine FAST_Start(iTurb_c, NumInputs_c, NumOutputs_c, InputAry, OutputAry, E !GCC$ ATTRIBUTES DLLEXPORT :: FAST_Start #endif INTEGER(C_INT), INTENT(IN ) :: iTurb_c ! Turbine number, c indexing (starts at 0 for first turbine) - INTEGER(C_INT), INTENT(IN ) :: NumInputs_c - INTEGER(C_INT), INTENT(IN ) :: NumOutputs_c + INTEGER(C_INT), INTENT(IN ) :: NumInputs_c + INTEGER(C_INT), INTENT(IN ) :: NumOutputs_c REAL(C_DOUBLE), INTENT(IN ) :: InputAry(NumInputs_c) REAL(C_DOUBLE), INTENT( OUT) :: OutputAry(NumOutputs_c) - INTEGER(C_INT), INTENT( OUT) :: ErrStat_c - CHARACTER(KIND=C_CHAR), INTENT( OUT) :: ErrMsg_c(IntfStrLen) + INTEGER(C_INT), INTENT( OUT) :: ErrStat_c + CHARACTER(KIND=C_CHAR), INTENT( OUT) :: ErrMsg_c(IntfStrLen) + ! local - CHARACTER(IntfStrLen) :: InputFileName + CHARACTER(IntfStrLen) :: InputFileName INTEGER :: i REAL(ReKi) :: Outputs(NumOutputs_c-1) + integer(IntKi) :: iTurb ! turbine number: Fortran indexing (starts at 1 for first turbine) INTEGER(IntKi) :: ErrStat2 ! Error status CHARACTER(IntfStrLen-1) :: ErrMsg2 ! Error message (this needs to be static so that it will print in Matlab's mex library) - + ! transfer turbine index number from C to Fortran indexing (0 to 1 start) iTurb = int(iTurb_c,IntKi) + 1 - ! initialize variables: + ! initialize variables: n_t_global = 0 + !............................................................................................................................... ! Initialization of solver: (calculate outputs based on states at t=t_initial as well as guesses of inputs and constraint states) - !............................................................................................................................... - CALL FAST_Solution0_T(Turbine(iTurb), ErrStat, ErrMsg ) - + !............................................................................................................................... + CALL FAST_Solution0_T(Turbine(iTurb), ErrStat, ErrMsg ) + if (ErrStat <= AbortErrLev) then ! return outputs here, too IF(NumOutputs_c /= SIZE(Turbine(iTurb)%y_FAST%ChannelNames) ) THEN ErrStat = ErrID_Fatal ErrMsg = trim(ErrMsg)//NewLine//"FAST_Start:size of NumOutputs is invalid." ELSE - - CALL FillOutputAry_T(Turbine(iTurb), Outputs) - OutputAry(1) = Turbine(iTurb)%m_FAST%t_global - OutputAry(2:NumOutputs_c) = Outputs + + CALL FillOutputAry_T(Turbine(iTurb), Outputs) + OutputAry(1) = Turbine(iTurb)%m_FAST%t_global + OutputAry(2:NumOutputs_c) = Outputs CALL FAST_Linearize_T(t_initial, 0, Turbine(iTurb), ErrStat2, ErrMsg2) if (ErrStat2 /= ErrID_None) then ErrStat = max(ErrStat,ErrStat2) ErrMsg = TRIM(ErrMsg)//NewLine//TRIM(ErrMsg2) end if - - + + END IF end if - - + + ErrStat_c = ErrStat ErrMsg = TRIM(ErrMsg)//C_NULL_CHAR ErrMsg_c = TRANSFER( ErrMsg//C_NULL_CHAR, ErrMsg_c ) - -#ifdef CONSOLE_FILE + +#ifdef CONSOLE_FILE if (ErrStat /= ErrID_None) call wrscr1(trim(ErrMsg)) -#endif - +#endif + end subroutine FAST_Start !================================================================================================================================== subroutine FAST_Update(iTurb_c, NumInputs_c, NumOutputs_c, InputAry, OutputAry, EndSimulationEarly, ErrStat_c, ErrMsg_c) BIND (C, NAME='FAST_Update') @@ -255,18 +252,19 @@ subroutine FAST_Update(iTurb_c, NumInputs_c, NumOutputs_c, InputAry, OutputAry, !GCC$ ATTRIBUTES DLLEXPORT :: FAST_Update #endif INTEGER(C_INT), INTENT(IN ) :: iTurb_c ! Turbine number, c indexing (starts at 0 for first turbine) - INTEGER(C_INT), INTENT(IN ) :: NumInputs_c - INTEGER(C_INT), INTENT(IN ) :: NumOutputs_c + INTEGER(C_INT), INTENT(IN ) :: NumInputs_c + INTEGER(C_INT), INTENT(IN ) :: NumOutputs_c REAL(C_DOUBLE), INTENT(IN ) :: InputAry(NumInputs_c) REAL(C_DOUBLE), INTENT( OUT) :: OutputAry(NumOutputs_c) LOGICAL(C_BOOL), INTENT( OUT) :: EndSimulationEarly - INTEGER(C_INT), INTENT( OUT) :: ErrStat_c - CHARACTER(KIND=C_CHAR), INTENT( OUT) :: ErrMsg_c(IntfStrLen) - + INTEGER(C_INT), INTENT( OUT) :: ErrStat_c + CHARACTER(KIND=C_CHAR), INTENT( OUT) :: ErrMsg_c(IntfStrLen) + ! local variables REAL(ReKi) :: Outputs(NumOutputs_c-1) INTEGER(IntKi) :: i integer(IntKi) :: iTurb ! turbine number: Fortran indexing (starts at 1 for first turbine) + INTEGER(IntKi) :: ErrStat2 ! Error status CHARACTER(IntfStrLen-1) :: ErrMsg2 ! Error message (this needs to be static so that it will print in Matlab's mex library) @@ -275,8 +273,8 @@ subroutine FAST_Update(iTurb_c, NumInputs_c, NumOutputs_c, InputAry, OutputAry, EndSimulationEarly = .FALSE. - IF ( n_t_global > Turbine(iTurb)%p_FAST%n_TMax_m1 ) THEN !finish - + IF ( n_t_global > Turbine(iTurb)%p_FAST%n_TMax_m1 ) THEN !finish + ! we can't continue because we might over-step some arrays that are allocated to the size of the simulation IF (n_t_global == Turbine(iTurb)%p_FAST%n_TMax_m1 + 1) THEN ! we call update an extra time in Simulink, which we can ignore until the time shift with outputs is solved @@ -284,12 +282,12 @@ subroutine FAST_Update(iTurb_c, NumInputs_c, NumOutputs_c, InputAry, OutputAry, ErrStat_c = ErrID_None ErrMsg = C_NULL_CHAR ErrMsg_c = TRANSFER( ErrMsg//C_NULL_CHAR, ErrMsg_c ) - ELSE + ELSE ErrStat_c = ErrID_Info ErrMsg = "Simulation completed."//C_NULL_CHAR ErrMsg_c = TRANSFER( ErrMsg//C_NULL_CHAR, ErrMsg_c ) END IF - + ELSEIF(NumOutputs_c /= SIZE(Turbine(iTurb)%y_FAST%ChannelNames) ) THEN ErrStat_c = ErrID_Fatal ErrMsg = "FAST_Update:size of OutputAry is invalid or FAST has too many outputs."//C_NULL_CHAR @@ -304,7 +302,7 @@ subroutine FAST_Update(iTurb_c, NumInputs_c, NumOutputs_c, InputAry, OutputAry, CALL FAST_SetExternalInputs(iTurb, NumInputs_c, InputAry, Turbine(iTurb)%m_FAST) - CALL FAST_Solution_T( t_initial, n_t_global, Turbine(iTurb), ErrStat, ErrMsg ) + CALL FAST_Solution_T( t_initial, n_t_global, Turbine(iTurb), ErrStat, ErrMsg ) n_t_global = n_t_global + 1 CALL FAST_Linearize_T( t_initial, n_t_global, Turbine(iTurb), ErrStat2, ErrMsg2) @@ -312,26 +310,26 @@ subroutine FAST_Update(iTurb_c, NumInputs_c, NumOutputs_c, InputAry, OutputAry, ErrStat = max(ErrStat,ErrStat2) ErrMsg = TRIM(ErrMsg)//NewLine//TRIM(ErrMsg2) end if - + IF ( Turbine(iTurb)%m_FAST%Lin%FoundSteady) THEN EndSimulationEarly = .TRUE. END IF - + ErrStat_c = ErrStat ErrMsg = TRIM(ErrMsg)//C_NULL_CHAR ErrMsg_c = TRANSFER( ErrMsg//C_NULL_CHAR, ErrMsg_c ) END IF ! set the outputs for external code here - CALL FillOutputAry_T(Turbine(iTurb), Outputs) - OutputAry(1) = Turbine(iTurb)%m_FAST%t_global - OutputAry(2:NumOutputs_c) = Outputs + CALL FillOutputAry_T(Turbine(iTurb), Outputs) + OutputAry(1) = Turbine(iTurb)%m_FAST%t_global + OutputAry(2:NumOutputs_c) = Outputs -#ifdef CONSOLE_FILE +#ifdef CONSOLE_FILE if (ErrStat /= ErrID_None) call wrscr1(trim(ErrMsg)) -#endif - -end subroutine FAST_Update +#endif + +end subroutine FAST_Update !================================================================================================================================== ! Get the hub's absolute position, rotation velocity, and orientation DCM for the current time step subroutine FAST_HubPosition(iTurb_c, AbsPosition_c, RotationalVel_c, Orientation_c, ErrStat_c, ErrMsg_c) BIND (C, NAME='FAST_HubPosition') @@ -377,12 +375,15 @@ end subroutine FAST_HubPosition !! Ideally we would write this summary info from here, but that isn't currently done. So as a workaround so the user has some !! vague idea what went wrong with their simulation, we have ServoDyn include the arrangement set here in the SrvD.sum file. subroutine FAST_SetExternalInputs(iTurb, NumInputs_c, InputAry, m_FAST) + USE, INTRINSIC :: ISO_C_Binding USE FAST_Types +! USE FAST_Data, only: NumFixedInputs IMPLICIT NONE + INTEGER(IntKi), INTENT(IN ) :: iTurb ! Turbine number, Fortran indexing (starts at 1 for first turbine) - INTEGER(C_INT), INTENT(IN ) :: NumInputs_c + INTEGER(C_INT), INTENT(IN ) :: NumInputs_c REAL(C_DOUBLE), INTENT(IN ) :: InputAry(NumInputs_c) ! Inputs from Simulink TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST ! Miscellaneous variables @@ -400,12 +401,12 @@ subroutine FAST_SetExternalInputs(iTurb, NumInputs_c, InputAry, m_FAST) m_FAST%ExternInput%BlAirfoilCom = InputAry(9:11) m_FAST%ExternInput%CableDeltaL = InputAry(12:31) m_FAST%ExternInput%CableDeltaLdot = InputAry(32:51) - + IF ( NumInputs_c > NumFixedInputs ) THEN ! NumFixedInputs is the fixed number of inputs IF ( NumInputs_c == NumFixedInputs + 3 ) & m_FAST%ExternInput%LidarFocus = InputAry(52:54) - END IF - + END IF + end subroutine FAST_SetExternalInputs !================================================================================================================================== subroutine FAST_End(iTurb_c, StopTheProgram) BIND (C, NAME='FAST_End') @@ -422,7 +423,7 @@ subroutine FAST_End(iTurb_c, StopTheProgram) BIND (C, NAME='FAST_End') iTurb = int(iTurb_c,IntKi) + 1 CALL ExitThisProgram_T( Turbine(iTurb), ErrID_None, LOGICAL(StopTheProgram)) - + end subroutine FAST_End !================================================================================================================================== subroutine FAST_CreateCheckpoint(iTurb_c, CheckpointRootName_c, ErrStat_c, ErrMsg_c) BIND (C, NAME='FAST_CreateCheckpoint') @@ -432,12 +433,12 @@ subroutine FAST_CreateCheckpoint(iTurb_c, CheckpointRootName_c, ErrStat_c, ErrMs !GCC$ ATTRIBUTES DLLEXPORT :: FAST_CreateCheckpoint #endif INTEGER(C_INT), INTENT(IN ) :: iTurb_c ! Turbine number, c indexing (starts at 0 for first turbine) - CHARACTER(KIND=C_CHAR), INTENT(IN ) :: CheckpointRootName_c(IntfStrLen) - INTEGER(C_INT), INTENT( OUT) :: ErrStat_c - CHARACTER(KIND=C_CHAR), INTENT( OUT) :: ErrMsg_c(IntfStrLen) - + CHARACTER(KIND=C_CHAR), INTENT(IN ) :: CheckpointRootName_c(IntfStrLen) + INTEGER(C_INT), INTENT( OUT) :: ErrStat_c + CHARACTER(KIND=C_CHAR), INTENT( OUT) :: ErrMsg_c(IntfStrLen) + ! local - CHARACTER(IntfStrLen) :: CheckpointRootName + CHARACTER(IntfStrLen) :: CheckpointRootName INTEGER(IntKi) :: I INTEGER(IntKi) :: Unit integer(IntKi) :: iTurb ! turbine number: Fortran indexing (starts at 1 for first turbine) @@ -449,26 +450,26 @@ subroutine FAST_CreateCheckpoint(iTurb_c, CheckpointRootName_c, ErrStat_c, ErrMs CheckpointRootName = TRANSFER( CheckpointRootName_c, CheckpointRootName ) I = INDEX(CheckpointRootName,C_NULL_CHAR) - 1 ! if this has a c null character at the end... IF ( I > 0 ) CheckpointRootName = CheckpointRootName(1:I) ! remove it - + if ( LEN_TRIM(CheckpointRootName) == 0 ) then CheckpointRootName = TRIM(Turbine(iTurb)%p_FAST%OutFileRoot)//'.'//trim( Num2LStr(n_t_global) ) end if - - + + Unit = -1 CALL FAST_CreateCheckpoint_T(t_initial, n_t_global, 1, Turbine(iTurb), CheckpointRootName, ErrStat, ErrMsg, Unit ) - ! transfer Fortran variables to C: + ! transfer Fortran variables to C: ErrStat_c = ErrStat ErrMsg = TRIM(ErrMsg)//C_NULL_CHAR ErrMsg_c = TRANSFER( ErrMsg//C_NULL_CHAR, ErrMsg_c ) -#ifdef CONSOLE_FILE +#ifdef CONSOLE_FILE if (ErrStat /= ErrID_None) call wrscr1(trim(ErrMsg)) -#endif - -end subroutine FAST_CreateCheckpoint +#endif + +end subroutine FAST_CreateCheckpoint !================================================================================================================================== subroutine FAST_Restart(iTurb_c, CheckpointRootName_c, AbortErrLev_c, NumOuts_c, dt_c, n_t_global_c, ErrStat_c, ErrMsg_c) BIND (C, NAME='FAST_Restart') IMPLICIT NONE @@ -477,16 +478,16 @@ subroutine FAST_Restart(iTurb_c, CheckpointRootName_c, AbortErrLev_c, NumOuts_c, !GCC$ ATTRIBUTES DLLEXPORT :: FAST_Restart #endif INTEGER(C_INT), INTENT(IN ) :: iTurb_c ! Turbine number, c indexing (starts at 0 for first turbine) - CHARACTER(KIND=C_CHAR), INTENT(IN ) :: CheckpointRootName_c(IntfStrLen) - INTEGER(C_INT), INTENT( OUT) :: AbortErrLev_c - INTEGER(C_INT), INTENT( OUT) :: NumOuts_c - REAL(C_DOUBLE), INTENT( OUT) :: dt_c - INTEGER(C_INT), INTENT( OUT) :: n_t_global_c - INTEGER(C_INT), INTENT( OUT) :: ErrStat_c - CHARACTER(KIND=C_CHAR), INTENT( OUT) :: ErrMsg_c(IntfStrLen) - + CHARACTER(KIND=C_CHAR), INTENT(IN ) :: CheckpointRootName_c(IntfStrLen) + INTEGER(C_INT), INTENT( OUT) :: AbortErrLev_c + INTEGER(C_INT), INTENT( OUT) :: NumOuts_c + REAL(C_DOUBLE), INTENT( OUT) :: dt_c + INTEGER(C_INT), INTENT( OUT) :: n_t_global_c + INTEGER(C_INT), INTENT( OUT) :: ErrStat_c + CHARACTER(KIND=C_CHAR), INTENT( OUT) :: ErrMsg_c(IntfStrLen) + ! local - CHARACTER(IntfStrLen) :: CheckpointRootName + CHARACTER(IntfStrLen) :: CheckpointRootName INTEGER(IntKi) :: I INTEGER(IntKi) :: Unit REAL(DbKi) :: t_initial_out @@ -497,88 +498,189 @@ subroutine FAST_Restart(iTurb_c, CheckpointRootName_c, AbortErrLev_c, NumOuts_c, ! transfer turbine index number from C to Fortran indexing (0 to 1 start) iTurb = int(iTurb_c,IntKi) + 1 - ! transfer the character array from C to a Fortran string: + ! transfer the character array from C to a Fortran string: CheckpointRootName = TRANSFER( CheckpointRootName_c, CheckpointRootName ) I = INDEX(CheckpointRootName,C_NULL_CHAR) - 1 ! if this has a c null character at the end... IF ( I > 0 ) CheckpointRootName = CheckpointRootName(1:I) ! remove it - + Unit = -1 CALL FAST_RestoreFromCheckpoint_T(t_initial_out, n_t_global, NumTurbines_out, Turbine(iTurb), CheckpointRootName, ErrStat, ErrMsg, Unit ) - + ! check that these are valid: IF (t_initial_out /= t_initial) CALL SetErrStat(ErrID_Fatal, "invalid value of t_initial.", ErrStat, ErrMsg, RoutineName ) IF (NumTurbines_out /= 1) CALL SetErrStat(ErrID_Fatal, "invalid value of NumTurbines.", ErrStat, ErrMsg, RoutineName ) - - - ! transfer Fortran variables to C: + + + ! transfer Fortran variables to C: n_t_global_c = n_t_global - AbortErrLev_c = AbortErrLev + AbortErrLev_c = AbortErrLev NumOuts_c = min(MAXOUTPUTS, SUM( Turbine(iTurb)%y_FAST%numOuts )) ! includes time - dt_c = Turbine(iTurb)%p_FAST%dt - + dt_c = Turbine(iTurb)%p_FAST%dt + ErrStat_c = ErrStat ErrMsg = TRIM(ErrMsg)//C_NULL_CHAR ErrMsg_c = TRANSFER( ErrMsg//C_NULL_CHAR, ErrMsg_c ) -#ifdef CONSOLE_FILE +#ifdef CONSOLE_FILE if (ErrStat /= ErrID_None) call wrscr1(trim(ErrMsg)) -#endif - -end subroutine FAST_Restart +#endif + +end subroutine FAST_Restart + !================================================================================================================================== -subroutine FAST_OpFM_Init(iTurb_c, TMax, InputFileName_c, TurbIDforName, NumSC2CtrlGlob, NumSC2Ctrl, NumCtrl2SC, InitSCOutputsGlob, InitSCOutputsTurbine, NumActForcePtsBlade, NumActForcePtsTower, TurbPosn, AbortErrLev_c, dt_c, NumBl_c, NumBlElem_c, NodeClusterType_c, & - OpFM_Input_from_FAST, OpFM_Output_to_FAST, SC_DX_Input_from_FAST, SC_DX_Output_to_FAST, ErrStat_c, ErrMsg_c) BIND (C, NAME='FAST_OpFM_Init') +subroutine FAST_ExtLoads_Init(iTurb_c, TMax, InputFileName_c, TurbIDforName, OutFileRoot_c, TurbPosn, AbortErrLev_c, dtDriver_c, dt_c, NumBl_c, & + az_blend_mean_c, az_blend_delta_c, & + ExtLd_Input_from_FAST, ExtLd_Parameter_from_FAST, ExtLd_Output_to_FAST, SC_DX_Input_from_FAST, SC_DX_Output_to_FAST, ErrStat_c, ErrMsg_c) BIND (C, NAME='FAST_ExtLoads_Init') IMPLICIT NONE #ifndef IMPLICIT_DLLEXPORT -!DEC$ ATTRIBUTES DLLEXPORT :: FAST_OpFM_Init -!GCC$ ATTRIBUTES DLLEXPORT :: FAST_OpFM_Init +!DEC$ ATTRIBUTES DLLEXPORT :: FAST_ExtLoads_Init +!GCC$ ATTRIBUTES DLLEXPORT :: FAST_ExtLoads_Init #endif INTEGER(C_INT), INTENT(IN ) :: iTurb_c ! Turbine number, c indexing (starts at 0 for first turbine) - REAL(C_DOUBLE), INTENT(IN ) :: TMax - CHARACTER(KIND=C_CHAR), INTENT(IN ) :: InputFileName_c(IntfStrLen) - INTEGER(C_INT), INTENT(IN ) :: TurbIDforName ! Need not be same as iTurb -- use numbering from c/cpp - INTEGER(C_INT), INTENT(IN ) :: NumSC2CtrlGlob ! Supercontroller global outputs = controller global inputs - INTEGER(C_INT), INTENT(IN ) :: NumSC2Ctrl ! Supercontroller outputs = controller inputs - INTEGER(C_INT), INTENT(IN ) :: NumCtrl2SC ! controller outputs = Supercontroller inputs - REAL(C_FLOAT), INTENT(IN ) :: InitScOutputsGlob (*) ! Initial Supercontroller global outputs = controller inputs - REAL(C_FLOAT), INTENT(IN ) :: InitScOutputsTurbine (*) ! Initial Supercontroller turbine specific outputs = controller inputs - INTEGER(C_INT), INTENT(IN ) :: NumActForcePtsBlade ! number of actuator line force points in blade - INTEGER(C_INT), INTENT(IN ) :: NumActForcePtsTower ! number of actuator line force points in tower - INTEGER(C_INT), INTENT(IN ):: NodeClusterType_c - REAL(C_FLOAT), INTENT(IN ) :: TurbPosn(3) - INTEGER(C_INT), INTENT( OUT) :: AbortErrLev_c - REAL(C_DOUBLE), INTENT( OUT) :: dt_c - INTEGER(C_INT), INTENT( OUT) :: NumBl_c - INTEGER(C_INT), INTENT( OUT) :: NumBlElem_c - TYPE(OpFM_InputType_C), INTENT(INOUT) :: OpFM_Input_from_FAST !INTENT(INOUT) instead of INTENT(OUT) to avoid gcc compiler warnings about variable tracking sizes - TYPE(OpFM_OutputType_C),INTENT(INOUT) :: OpFM_Output_to_FAST !INTENT(INOUT) instead of INTENT(OUT) to avoid gcc compiler warnings about variable tracking sizes + REAL(C_DOUBLE), INTENT(IN ) :: TMax + CHARACTER(KIND=C_CHAR), INTENT(IN ) :: InputFileName_c(IntfStrLen) + INTEGER(C_INT), INTENT(IN ) :: TurbIDforName ! Need not be same as iTurb + CHARACTER(KIND=C_CHAR), INTENT( OUT) :: OutFileRoot_c(IntfStrLen) + REAL(C_FLOAT), INTENT(IN ) :: TurbPosn(3) + REAL(C_DOUBLE), INTENT(IN ) :: dtDriver_c + REAL(C_DOUBLE), INTENT(IN ) :: az_blend_mean_c + REAL(C_DOUBLE), INTENT(IN ) :: az_blend_delta_c + REAL(C_DOUBLE), INTENT( OUT) :: dt_c + INTEGER(C_INT), INTENT( OUT) :: AbortErrLev_c + INTEGER(C_INT), INTENT( OUT) :: NumBl_c + TYPE(ExtLdDX_InputType_C), INTENT( OUT) :: ExtLd_Input_from_FAST + TYPE(ExtLdDX_ParameterType_C), INTENT( OUT) :: ExtLd_Parameter_from_FAST + TYPE(ExtLdDX_OutputType_C), INTENT( OUT) :: ExtLd_Output_to_FAST + TYPE(SC_DX_InputType_C), INTENT(INOUT) :: SC_DX_Input_from_FAST + TYPE(SC_DX_OutputType_C), INTENT(INOUT) :: SC_DX_Output_to_FAST + INTEGER(C_INT), INTENT( OUT) :: ErrStat_c + CHARACTER(KIND=C_CHAR), INTENT( OUT) :: ErrMsg_c(IntfStrLen) + + ! local + CHARACTER(IntfStrLen) :: InputFileName + INTEGER(C_INT) :: i + TYPE(FAST_ExternInitType) :: ExternInitData + INTEGER(IntKi) :: CompLoadsType + integer(IntKi) :: iTurb ! turbine number: Fortran indexing (starts at 1 for first turbine) + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_ExtLoads_Init' + + ! transfer turbine index number from C to Fortran indexing (0 to 1 start) + iTurb = int(iTurb_c,IntKi) + 1 + + ! transfer the character array from C to a Fortran string: + InputFileName = TRANSFER( InputFileName_c, InputFileName ) + I = INDEX(InputFileName,C_NULL_CHAR) - 1 ! if this has a c null character at the end... + IF ( I > 0 ) InputFileName = InputFileName(1:I) ! remove it + + ! initialize variables: + n_t_global = 0 + ErrStat = ErrID_None + ErrMsg = "" + + ExternInitData%TMax = TMax + ExternInitData%TurbIDforName = TurbIDforName + ExternInitData%TurbinePos = TurbPosn + ExternInitData%NumSC2CtrlGlob = 0 + ExternInitData%NumCtrl2SC = 0 + ExternInitData%NumSC2Ctrl = 0 + ExternInitData%DTdriver = dtDriver_c + ExternInitData%az_blend_mean = az_blend_mean_c + ExternInitData%az_blend_delta = az_blend_delta_c + + CALL FAST_InitializeAll_T( t_initial, 1_IntKi, Turbine(iTurb), ErrStat, ErrMsg, InputFileName, ExternInitData ) + + write(*,*) 'ErrMsg = ', ErrMsg + ! set values for return to ExternalInflow + if (ErrStat .ne. ErrID_None) then + AbortErrLev_c = AbortErrLev + ErrStat_c = ErrStat + ErrMsg_c = TRANSFER( TRIM(ErrMsg)//C_NULL_CHAR, ErrMsg_c ) + return + end if + + dt_c = DBLE(Turbine(iTurb)%p_FAST%DT) + + NumBl_c = Turbine(iTurb)%ED%p%NumBl + + CompLoadsType = Turbine(iTurb)%p_FAST%CompAero + + if ( (CompLoadsType .ne. Module_ExtLd) ) then + CALL SetErrStat(ErrID_Fatal, "CompAero is not set to 3 for use of the External Loads module. Use a different C++ initialization call for this turbine.", ErrStat, ErrMsg, RoutineName ) + ErrStat_c = ErrStat + ErrMsg_c = TRANSFER( trim(ErrMsg)//C_NULL_CHAR, ErrMsg_c ) + return + end if + + call SetExtLoads_pointers(iTurb, ExtLd_Input_from_FAST, ExtLd_Parameter_from_FAST, ExtLd_Output_to_FAST) + + OutFileRoot_c = TRANSFER( trim(Turbine(iTurb)%p_FAST%OutFileRoot)//C_NULL_CHAR, OutFileRoot_c ) + + ErrStat_c = ErrStat + ErrMsg_c = TRANSFER( trim(ErrMsg)//C_NULL_CHAR, ErrMsg_c ) + +end subroutine FAST_ExtLoads_Init +!================================================================================================================================== +subroutine FAST_ExtInfw_Init(iTurb_c, TMax, InputFileName_c, TurbIDforName, OutFileRoot_c, NumSC2CtrlGlob, NumSC2Ctrl, NumCtrl2SC, & + InitSCOutputsGlob, InitSCOutputsTurbine, NumActForcePtsBlade, NumActForcePtsTower, TurbPosn, AbortErrLev_c, & + dtDriver_c, dt_c, InflowType, NumBl_c, NumBlElem_c, NumTwrElem_c, NodeClusterType_c, & + ExtInfw_Input_from_FAST, ExtInfw_Output_to_FAST, SC_DX_Input_from_FAST, SC_DX_Output_to_FAST, ErrStat_c, ErrMsg_c) BIND (C, NAME='FAST_ExtInfw_Init') + IMPLICIT NONE +#ifndef IMPLICIT_DLLEXPORT +!DEC$ ATTRIBUTES DLLEXPORT :: FAST_ExtInfw_Init +!GCC$ ATTRIBUTES DLLEXPORT :: FAST_ExtInfw_Init +#endif + INTEGER(C_INT), INTENT(IN ) :: iTurb_c ! Turbine number + REAL(C_DOUBLE), INTENT(IN ) :: TMax + CHARACTER(KIND=C_CHAR), INTENT(IN ) :: InputFileName_c(IntfStrLen) + INTEGER(C_INT), INTENT(IN ) :: TurbIDforName ! Need not be same as iTurb_c + CHARACTER(KIND=C_CHAR), INTENT( OUT) :: OutFileRoot_c(IntfStrLen) ! Root of output and restart file name + INTEGER(C_INT), INTENT(IN ) :: NumSC2CtrlGlob ! Supercontroller global outputs = controller global inputs + INTEGER(C_INT), INTENT(IN ) :: NumSC2Ctrl ! Supercontroller outputs = controller inputs + INTEGER(C_INT), INTENT(IN ) :: NumCtrl2SC ! controller outputs = Supercontroller inputs + REAL(C_FLOAT), INTENT(IN ) :: InitScOutputsGlob (*) ! Initial Supercontroller global outputs = controller inputs + REAL(C_FLOAT), INTENT(IN ) :: InitScOutputsTurbine (*) ! Initial Supercontroller turbine specific outputs = controller inputs + INTEGER(C_INT), INTENT(IN ) :: NumActForcePtsBlade ! number of actuator line force points in blade + INTEGER(C_INT), INTENT(IN ) :: NumActForcePtsTower ! number of actuator line force points in tower + INTEGER(C_INT), INTENT(IN ):: NodeClusterType_c + REAL(C_FLOAT), INTENT(IN ) :: TurbPosn(3) + INTEGER(C_INT), INTENT( OUT) :: AbortErrLev_c + REAL(C_DOUBLE), INTENT(IN ) :: dtDriver_c + REAL(C_DOUBLE), INTENT( OUT) :: dt_c + INTEGER(C_INT), INTENT( OUT) :: InflowType ! inflow type - 1 = From Inflow module, 2 = External + INTEGER(C_INT), INTENT( OUT) :: NumBl_c + INTEGER(C_INT), INTENT( OUT) :: NumBlElem_c + INTEGER(C_INT), INTENT( OUT) :: NumTwrElem_c + TYPE(ExtInfw_InputType_C), INTENT(INOUT) :: ExtInfw_Input_from_FAST !INTENT(INOUT) instead of INTENT(OUT) to avoid gcc compiler warnings about variable tracking sizes + TYPE(ExtInfw_OutputType_C),INTENT(INOUT) :: ExtInfw_Output_to_FAST !INTENT(INOUT) instead of INTENT(OUT) to avoid gcc compiler warnings about variable tracking sizes TYPE(SC_DX_InputType_C), INTENT(INOUT) :: SC_DX_Input_from_FAST TYPE(SC_DX_OutputType_C), INTENT(INOUT) :: SC_DX_Output_to_FAST - INTEGER(C_INT), INTENT( OUT) :: ErrStat_c - CHARACTER(KIND=C_CHAR), INTENT( OUT) :: ErrMsg_c(IntfStrLen) - + INTEGER(C_INT), INTENT( OUT) :: ErrStat_c + CHARACTER(KIND=C_CHAR), INTENT( OUT) :: ErrMsg_c(IntfStrLen) + ! local - CHARACTER(IntfStrLen) :: InputFileName - INTEGER(C_INT) :: i + CHARACTER(IntfStrLen) :: InputFileName + INTEGER(C_INT) :: i TYPE(FAST_ExternInitType) :: ExternInitData integer(IntKi) :: iTurb ! turbine number: Fortran indexing (starts at 1 for first turbine) + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_ExtInfw_Init' + ! transfer turbine index number from C to Fortran indexing (0 to 1 start) iTurb = int(iTurb_c,IntKi) + 1 - ! transfer the character array from C to a Fortran string: + ! transfer the character array from C to a Fortran string: InputFileName = TRANSFER( InputFileName_c, InputFileName ) I = INDEX(InputFileName,C_NULL_CHAR) - 1 ! if this has a c null character at the end... IF ( I > 0 ) InputFileName = InputFileName(1:I) ! remove it - - ! initialize variables: - n_t_global = 0 + + ! initialize variables: + n_t_global = 0 ErrStat = ErrID_None ErrMsg = "" - + NumBl_c = 0 ! initialize here in case of error NumBlElem_c = 0 ! initialize here in case of error - + ! Check TurbIDforName -- must be 0 or larger if (TurbIDforName < 0) then ErrStat = ErrID_Fatal @@ -589,10 +691,9 @@ subroutine FAST_OpFM_Init(iTurb_c, TMax, InputFileName_c, TurbIDforName, NumSC2C ExternInitData%TMax = TMax ExternInitData%TurbIDforName = TurbIDforName ExternInitData%TurbinePos = TurbPosn - ExternInitData%SensorType = SensorType_None ExternInitData%NumCtrl2SC = NumCtrl2SC ExternInitData%NumSC2CtrlGlob = NumSC2CtrlGlob - + if ( NumSC2CtrlGlob > 0 ) then CALL AllocAry( ExternInitData%fromSCGlob, NumSC2CtrlGlob, 'ExternInitData%fromSCGlob', ErrStat, ErrMsg) IF (FAILED()) RETURN @@ -601,7 +702,7 @@ subroutine FAST_OpFM_Init(iTurb_c, TMax, InputFileName_c, TurbIDforName, NumSC2C ExternInitData%fromSCGlob(i) = InitScOutputsGlob(i) end do end if - + ExternInitData%NumSC2Ctrl = NumSC2Ctrl if ( NumSC2Ctrl > 0 ) then CALL AllocAry( ExternInitData%fromSC, NumSC2Ctrl, 'ExternInitData%fromSC', ErrStat, ErrMsg) @@ -611,34 +712,49 @@ subroutine FAST_OpFM_Init(iTurb_c, TMax, InputFileName_c, TurbIDforName, NumSC2C ExternInitData%fromSC(i) = InitScOutputsTurbine(i) end do end if - + ExternInitData%NumActForcePtsBlade = NumActForcePtsBlade ExternInitData%NumActForcePtsTower = NumActForcePtsTower - + ExternInitData%DTdriver = dtDriver_c ExternInitData%NodeClusterType = NodeClusterType_c CALL FAST_InitializeAll_T( t_initial, iTurb, Turbine(iTurb), ErrStat, ErrMsg, InputFileName, ExternInitData ) - ! set values for return to OpenFOAM - AbortErrLev_c = AbortErrLev - dt_c = Turbine(iTurb)%p_FAST%dt - ErrStat_c = ErrStat - ErrMsg = TRIM(ErrMsg)//C_NULL_CHAR - ErrMsg_c = TRANSFER( ErrMsg//C_NULL_CHAR, ErrMsg_c ) - - IF ( ErrStat >= AbortErrLev ) THEN - CALL WrScr( "Error in FAST_OpFM_Init:FAST_InitializeAll_T" // TRIM(ErrMsg) ) - RETURN - END IF - - call SetOpenFOAM_pointers(iTurb, OpFM_Input_from_FAST, OpFM_Output_to_FAST, SC_DX_Input_from_FAST, SC_DX_Output_to_FAST) - - ! 7-Sep-2015: Sang wants these integers for the OpenFOAM mapping, which is tied to the AeroDyn nodes. FAST doesn't restrict the number of nodes on each - ! blade mesh to be the same, so if this DOES ever change, we'll need to make OpenFOAM less tied to the AeroDyn mapping. - IF (Turbine(iTurb)%p_FAST%CompAero == MODULE_AD14) THEN - NumBl_c = SIZE(Turbine(iTurb)%AD14%Input(1)%InputMarkers) - NumBlElem_c = Turbine(iTurb)%AD14%Input(1)%InputMarkers(1)%Nnodes - ELSEIF (Turbine(iTurb)%p_FAST%CompAero == MODULE_AD) THEN + ! set values for return to ExternalInflow + if (ErrStat .ne. ErrID_None) then + AbortErrLev_c = AbortErrLev + ErrStat_c = ErrStat + ErrMsg_c = TRANSFER( TRIM(ErrMsg)//C_NULL_CHAR, ErrMsg_c ) + return + end if + + dt_c = Turbine(iTurb)%p_FAST%dt + + if (Turbine(iTurb)%p_FAST%CompInflow == Module_ExtInfw) then + InflowType = 2 + else if (Turbine(iTurb)%p_FAST%CompInflow == Module_IfW) then + InflowType = 1 + else + InflowType = 0 + end if + + if ( (Turbine(iTurb)%p_FAST%CompInflow == Module_ExtInfw) .and. (NumActForcePtsBlade .eq. 0) .and. (NumActForcePtsTower .eq. 0) ) then + CALL SetErrStat(ErrID_Warn, "Number of actuator points is zero when inflow type is 2. Mapping of loads may not work. ", ErrStat, ErrMsg, RoutineName ) + end if + + if ( (Turbine(iTurb)%p_FAST%CompInflow .ne. Module_ExtInfw) .and. ((NumActForcePtsBlade .ne. 0) .or. (NumActForcePtsTower .ne. 0)) ) then + !!FAST reassigns CompInflow after reading it to a module number based on an internal list in the FAST_Registry. So 2 in input file becomes 3 inside the code. + CALL SetErrStat(ErrID_Fatal, "Number of requested actuator points is non-zero when inflow type is not 2. Please set number of actuator points to zero when induction is turned on.", ErrStat, ErrMsg, RoutineName ) + ErrStat_c = ErrStat + ErrMsg_c = TRANSFER( trim(ErrMsg)//C_NULL_CHAR, ErrMsg_c ) + return + end if + + call SetExternalInflow_pointers(iTurb, ExtInfw_Input_from_FAST, ExtInfw_Output_to_FAST, SC_DX_Input_from_FAST, SC_DX_Output_to_FAST) + + ! 7-Sep-2015: OpenFAST doesn't restrict the number of nodes on each blade mesh to be the same, so if this DOES ever change, + ! we'll need to make ExternalInflow less tied to the AeroDyn mapping. + IF (Turbine(iTurb)%p_FAST%CompAero == MODULE_AD) THEN IF (ALLOCATED(Turbine(iTurb)%AD%Input(1)%rotors)) THEN IF (ALLOCATED(Turbine(iTurb)%AD%Input(1)%rotors(1)%BladeMotion)) THEN NumBl_c = SIZE(Turbine(iTurb)%AD%Input(1)%rotors(1)%BladeMotion) @@ -647,110 +763,155 @@ subroutine FAST_OpFM_Init(iTurb_c, TMax, InputFileName_c, TurbIDforName, NumSC2C IF (NumBl_c > 0) THEN NumBlElem_c = Turbine(iTurb)%AD%Input(1)%rotors(1)%BladeMotion(1)%Nnodes END IF + if (Turbine(iTurb)%AD%y%rotors(1)%TowerLoad%Committed) then + NumTwrElem_c = Turbine(iTurb)%AD%y%rotors(1)%TowerLoad%Nnodes + else + NumTwrElem_c = 0 + endif + ELSEIF (Turbine(iTurb)%p_FAST%CompAero == MODULE_ADsk) THEN + call WrScr("AeroDisk cannot be used with ExtInfw through the FAST_Library interface") + ErrStat = AbortErrLev + ErrMsg = "AeroDisk cannot be used with ExtInfw through the FAST_Library interface" + if (Failed()) return + ELSE + NumBl_c = 0 + NumBlElem_c = 0 + NumTwrElem_c = 0 END IF - -contains + + OutFileRoot_c = TRANSFER( trim(Turbine(iTurb)%p_FAST%OutFileRoot)//C_NULL_CHAR, OutFileRoot_c ) + + ErrStat_c = ErrStat + ErrMsg_c = TRANSFER( trim(ErrMsg)//C_NULL_CHAR, ErrMsg_c ) + + contains LOGICAL FUNCTION FAILED() - + FAILED = ErrStat >= AbortErrLev - + IF (ErrStat > 0) THEN - CALL WrScr( "Error in FAST_OpFM_Init:FAST_InitializeAll_T" // TRIM(ErrMsg) ) - + CALL WrScr( "Error in FAST_ExtInfw_Init:FAST_InitializeAll_T" // TRIM(ErrMsg) ) + IF ( FAILED ) THEN - + AbortErrLev_c = AbortErrLev ErrStat_c = ErrStat ErrMsg = TRIM(ErrMsg)//C_NULL_CHAR ErrMsg_c = TRANSFER( ErrMsg//C_NULL_CHAR, ErrMsg_c ) - + !IF (ALLOCATED(Turbine)) DEALLOCATE(Turbine) ! bjj: if there is an error, the driver should call FAST_DeallocateTurbines() instead of putting this deallocate statement here END IF END IF - - + + END FUNCTION FAILED -end subroutine +end subroutine + !================================================================================================================================== -subroutine FAST_OpFM_Solution0(iTurb_c, ErrStat_c, ErrMsg_c) BIND (C, NAME='FAST_OpFM_Solution0') +subroutine FAST_CFD_Solution0(iTurb_c, ErrStat_c, ErrMsg_c) BIND (C, NAME='FAST_CFD_Solution0') IMPLICIT NONE #ifndef IMPLICIT_DLLEXPORT -!DEC$ ATTRIBUTES DLLEXPORT :: FAST_OpFM_Solution0 -!GCC$ ATTRIBUTES DLLEXPORT :: FAST_OpFM_Solution0 +!DEC$ ATTRIBUTES DLLEXPORT :: FAST_CFD_Solution0 +!GCC$ ATTRIBUTES DLLEXPORT :: FAST_CFD_Solution0 #endif INTEGER(C_INT), INTENT(IN ) :: iTurb_c ! Turbine number, c indexing (starts at 0 for first turbine) - INTEGER(C_INT), INTENT( OUT) :: ErrStat_c - CHARACTER(KIND=C_CHAR), INTENT( OUT) :: ErrMsg_c(IntfStrLen) + INTEGER(C_INT), INTENT( OUT) :: ErrStat_c + CHARACTER(KIND=C_CHAR), INTENT( OUT) :: ErrMsg_c(IntfStrLen) + integer(IntKi) :: iTurb ! turbine number: Fortran indexing (starts at 1 for first turbine) + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CFD_Solution0' ! transfer turbine index number from C to Fortran indexing (0 to 1 start) iTurb = int(iTurb_c,IntKi) + 1 - call FAST_Solution0_T(Turbine(iTurb), ErrStat, ErrMsg ) + call FAST_Solution0_T(Turbine(iTurb), ErrStat, ErrMsg ) ! if(Turbine(iTurb)%SC_DX%p%useSC) then ! CALL SC_SetInputs(Turbine(iTurb)%p_FAST, Turbine(iTurb)%SrvD%y, Turbine(iTurb)%SC_DX, ErrStat, ErrMsg) ! end if - - ! set values for return to OpenFOAM + + ! set values for return to ExternalInflow + ErrStat_c = ErrStat + ErrMsg = TRIM(ErrMsg)//C_NULL_CHAR + ErrMsg_c = TRANSFER( ErrMsg, ErrMsg_c ) + +end subroutine FAST_CFD_Solution0 +!================================================================================================================================== +subroutine FAST_CFD_InitIOarrays_SubStep(iTurb_c, ErrStat_c, ErrMsg_c) BIND (C, NAME='FAST_CFD_InitIOarrays_SubStep') + IMPLICIT NONE +#ifndef IMPLICIT_DLLEXPORT +!DEC$ ATTRIBUTES DLLEXPORT :: FAST_CFD_InitIOarrays_SubStep +!GCC$ ATTRIBUTES DLLEXPORT :: FAST_CFD_InitIOarrays_SubStep +#endif + INTEGER(C_INT), INTENT(IN ) :: iTurb_c ! Turbine number, c indexing (starts at 0 for first turbine) + INTEGER(C_INT), INTENT( OUT) :: ErrStat_c + CHARACTER(KIND=C_CHAR), INTENT( OUT) :: ErrMsg_c(IntfStrLen) + integer(IntKi) :: iTurb ! turbine number: Fortran indexing (starts at 1 for first turbine) + + ! transfer turbine index number from C to Fortran indexing (0 to 1 start) + iTurb = int(iTurb_c,IntKi) + 1 + + call FAST_InitIOarrays_SubStep_T(t_initial, Turbine(iTurb), ErrStat, ErrMsg ) + + ! set values for return to ExternalInflow ErrStat_c = ErrStat ErrMsg = TRIM(ErrMsg)//C_NULL_CHAR ErrMsg_c = TRANSFER( ErrMsg//C_NULL_CHAR, ErrMsg_c ) - - -end subroutine FAST_OpFM_Solution0 + +end subroutine FAST_CFD_InitIOarrays_SubStep !================================================================================================================================== -subroutine FAST_OpFM_Restart(iTurb_c, CheckpointRootName_c, AbortErrLev_c, dt_c, numblades_c, numElementsPerBlade_c, n_t_global_c, & - OpFM_Input_from_FAST, OpFM_Output_to_FAST, SC_DX_Input_from_FAST, SC_DX_Output_to_FAST, ErrStat_c, ErrMsg_c) BIND (C, NAME='FAST_OpFM_Restart') +subroutine FAST_ExtInfw_Restart(iTurb_c, CheckpointRootName_c, AbortErrLev_c, dt_c, numblades_c, numElementsPerBlade_c, numElementsTower_c, n_t_global_c, & + ExtInfw_Input_from_FAST, ExtInfw_Output_to_FAST, SC_DX_Input_from_FAST, SC_DX_Output_to_FAST, ErrStat_c, ErrMsg_c) BIND (C, NAME='FAST_ExtInfw_Restart') IMPLICIT NONE #ifndef IMPLICIT_DLLEXPORT -!DEC$ ATTRIBUTES DLLEXPORT :: FAST_OpFM_Restart -!GCC$ ATTRIBUTES DLLEXPORT :: FAST_OpFM_Restart +!DEC$ ATTRIBUTES DLLEXPORT :: FAST_ExtInfw_Restart +!GCC$ ATTRIBUTES DLLEXPORT :: FAST_ExtInfw_Restart #endif - INTEGER(C_INT), INTENT(IN ) :: iTurb_c ! Turbine number, c indexing (starts at 0 for first turbine) - CHARACTER(KIND=C_CHAR), INTENT(IN ) :: CheckpointRootName_c(IntfStrLen) - INTEGER(C_INT), INTENT( OUT) :: AbortErrLev_c - INTEGER(C_INT), INTENT( OUT) :: numblades_c - INTEGER(C_INT), INTENT( OUT) :: numElementsPerBlade_c - REAL(C_DOUBLE), INTENT( OUT) :: dt_c - INTEGER(C_INT), INTENT( OUT) :: n_t_global_c - TYPE(OpFM_InputType_C), INTENT(INOUT) :: OpFM_Input_from_FAST !INTENT(INOUT) instead of INTENT(OUT) to avoid gcc compiler warnings about variable tracking sizes - TYPE(OpFM_OutputType_C),INTENT(INOUT) :: OpFM_Output_to_FAST !INTENT(INOUT) instead of INTENT(OUT) to avoid gcc compiler warnings about variable tracking sizes + INTEGER(C_INT), INTENT(IN ) :: iTurb_c ! Turbine number, c indexing (starts at 0 for first turbine) + CHARACTER(KIND=C_CHAR), INTENT(IN ) :: CheckpointRootName_c(IntfStrLen) + INTEGER(C_INT), INTENT( OUT) :: AbortErrLev_c + INTEGER(C_INT), INTENT( OUT) :: numblades_c + INTEGER(C_INT), INTENT( OUT) :: numElementsPerBlade_c + INTEGER(C_INT), INTENT( OUT) :: numElementsTower_c + REAL(C_DOUBLE), INTENT( OUT) :: dt_c + INTEGER(C_INT), INTENT( OUT) :: n_t_global_c + TYPE(ExtInfw_InputType_C), INTENT(INOUT) :: ExtInfw_Input_from_FAST !INTENT(INOUT) instead of INTENT(OUT) to avoid gcc compiler warnings about variable tracking sizes + TYPE(ExtInfw_OutputType_C),INTENT(INOUT) :: ExtInfw_Output_to_FAST !INTENT(INOUT) instead of INTENT(OUT) to avoid gcc compiler warnings about variable tracking sizes TYPE(SC_DX_InputType_C), INTENT(INOUT) :: SC_DX_Input_from_FAST TYPE(SC_DX_OutputType_C), INTENT(INOUT) :: SC_DX_Output_to_FAST - INTEGER(C_INT), INTENT( OUT) :: ErrStat_c - CHARACTER(KIND=C_CHAR), INTENT( OUT) :: ErrMsg_c(IntfStrLen) - + INTEGER(C_INT), INTENT( OUT) :: ErrStat_c + CHARACTER(KIND=C_CHAR), INTENT( OUT) :: ErrMsg_c(IntfStrLen) + ! local variables - INTEGER(C_INT) :: NumOuts_c - CHARACTER(IntfStrLen) :: CheckpointRootName + INTEGER(C_INT) :: NumOuts_c + CHARACTER(IntfStrLen) :: CheckpointRootName INTEGER(IntKi) :: I INTEGER(IntKi) :: Unit REAL(DbKi) :: t_initial_out INTEGER(IntKi) :: NumTurbines_out integer(IntKi) :: iTurb ! turbine number: Fortran indexing (starts at 1 for first turbine) - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_Restart' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_Restart' ! transfer turbine index number from C to Fortran indexing (0 to 1 start) iTurb = int(iTurb_c,IntKi) + 1 CALL NWTC_Init() - ! transfer the character array from C to a Fortran string: + ! transfer the character array from C to a Fortran string: CheckpointRootName = TRANSFER( CheckpointRootName_c, CheckpointRootName ) I = INDEX(CheckpointRootName,C_NULL_CHAR) - 1 ! if this has a c null character at the end... IF ( I > 0 ) CheckpointRootName = CheckpointRootName(1:I) ! remove it - + Unit = -1 CALL FAST_RestoreFromCheckpoint_T(t_initial_out, n_t_global, NumTurbines_out, Turbine(iTurb), CheckpointRootName, ErrStat, ErrMsg, Unit ) - + ! check that these are valid: IF (t_initial_out /= t_initial) CALL SetErrStat(ErrID_Fatal, "invalid value of t_initial.", ErrStat, ErrMsg, RoutineName ) IF (NumTurbines_out /= 1) CALL SetErrStat(ErrID_Fatal, "invalid value of NumTurbines.", ErrStat, ErrMsg, RoutineName ) - - ! transfer Fortran variables to C: + + ! transfer Fortran variables to C: n_t_global_c = n_t_global - AbortErrLev_c = AbortErrLev + AbortErrLev_c = AbortErrLev NumOuts_c = min(MAXOUTPUTS, SUM( Turbine(iTurb)%y_FAST%numOuts )) ! includes time if (allocated(Turbine(iTurb)%ad%p%rotors)) then ! this might not be allocated if we had an error earlier numBlades_c = Turbine(iTurb)%ad%p%rotors(1)%numblades @@ -759,109 +920,441 @@ subroutine FAST_OpFM_Restart(iTurb_c, CheckpointRootName_c, AbortErrLev_c, dt_c, numBlades_c = 0 numElementsPerBlade_c = 0 end if - - dt_c = Turbine(iTurb)%p_FAST%dt - + + numElementsTower_c = Turbine(iTurb)%ad%p%rotors(1)%numtwrnds + + dt_c = Turbine(iTurb)%p_FAST%dt + ErrStat_c = ErrStat ErrMsg = TRIM(ErrMsg)//C_NULL_CHAR ErrMsg_c = TRANSFER( ErrMsg//C_NULL_CHAR, ErrMsg_c ) -#ifdef CONSOLE_FILE +#ifdef CONSOLE_FILE if (ErrStat /= ErrID_None) call wrscr1(trim(ErrMsg)) -#endif +#endif if (ErrStat >= AbortErrLev) return - - call SetOpenFOAM_pointers(iTurb, OpFM_Input_from_FAST, OpFM_Output_to_FAST, SC_DX_Input_from_FAST, SC_DX_Output_to_FAST) -end subroutine FAST_OpFM_Restart + call SetExternalInflow_pointers(iTurb, ExtInfw_Input_from_FAST, ExtInfw_Output_to_FAST, SC_DX_Input_from_FAST, SC_DX_Output_to_FAST) + +end subroutine FAST_ExtInfw_Restart !================================================================================================================================== -subroutine SetOpenFOAM_pointers(iTurb, OpFM_Input_from_FAST, OpFM_Output_to_FAST, SC_DX_Input_from_FAST, SC_DX_Output_to_FAST) +subroutine FAST_ExtLoads_Restart(iTurb_c, CheckpointRootName_c, AbortErrLev_c, dt_c, numblades_c, & + n_t_global_c, ExtLd_Input_from_FAST, ExtLd_Parameter_from_FAST, ExtLd_Output_to_FAST, & + SC_DX_Input_from_FAST, SC_DX_Output_to_FAST, ErrStat_c, ErrMsg_c) BIND (C, NAME='FAST_ExtLoads_Restart') IMPLICIT NONE - INTEGER(C_INT), INTENT(IN ) :: iTurb ! Turbine number, F indexing (starts at 1 for first turbine) - TYPE(OpFM_InputType_C), INTENT(INOUT) :: OpFM_Input_from_FAST - TYPE(OpFM_OutputType_C), INTENT(INOUT) :: OpFM_Output_to_FAST +#ifndef IMPLICIT_DLLEXPORT +!DEC$ ATTRIBUTES DLLEXPORT :: FAST_ExtLoads_Restart +!GCC$ ATTRIBUTES DLLEXPORT :: FAST_ExtLoads_Restart +#endif + INTEGER(C_INT), INTENT(IN ) :: iTurb_c ! Turbine number + CHARACTER(KIND=C_CHAR), INTENT(IN ) :: CheckpointRootName_c(IntfStrLen) + INTEGER(C_INT), INTENT( OUT) :: AbortErrLev_c + INTEGER(C_INT), INTENT( OUT) :: numblades_c + REAL(C_DOUBLE), INTENT( OUT) :: dt_c + INTEGER(C_INT), INTENT( OUT) :: n_t_global_c + TYPE(ExtLdDX_InputType_C), INTENT( OUT) :: ExtLd_Input_from_FAST + TYPE(ExtLdDX_ParameterType_C), INTENT( OUT) :: ExtLd_Parameter_from_FAST + TYPE(ExtLdDX_OutputType_C), INTENT( OUT) :: ExtLd_Output_to_FAST + TYPE(SC_DX_InputType_C), INTENT(INOUT) :: SC_DX_Input_from_FAST + TYPE(SC_DX_OutputType_C), INTENT(INOUT) :: SC_DX_Output_to_FAST + INTEGER(C_INT), INTENT( OUT) :: ErrStat_c + CHARACTER(KIND=C_CHAR), INTENT( OUT) :: ErrMsg_c(IntfStrLen) + + ! local variables + INTEGER(C_INT) :: NumOuts_c + CHARACTER(IntfStrLen) :: CheckpointRootName + INTEGER(IntKi) :: I + INTEGER(IntKi) :: Unit + REAL(DbKi) :: t_initial_out + INTEGER(IntKi) :: NumTurbines_out + INTEGER(IntKi) :: CompLoadsType + integer(IntKi) :: iTurb ! turbine number: Fortran indexing (starts at 1 for first turbine) + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_Restart' + + ! transfer turbine index number from C to Fortran indexing (0 to 1 start) + iTurb = int(iTurb_c,IntKi) + 1 + + CALL NWTC_Init() + ! transfer the character array from C to a Fortran string: + CheckpointRootName = TRANSFER( CheckpointRootName_c, CheckpointRootName ) + I = INDEX(CheckpointRootName,C_NULL_CHAR) - 1 ! if this has a c null character at the end... + IF ( I > 0 ) CheckpointRootName = CheckpointRootName(1:I) ! remove it + + Unit = -1 + CALL FAST_RestoreFromCheckpoint_T(t_initial_out, n_t_global, NumTurbines_out, Turbine(iTurb), CheckpointRootName, ErrStat, ErrMsg, Unit ) + + if (ErrStat .ne. ErrID_None) then + ErrStat_c = ErrStat + ErrMsg_c = TRANSFER( trim(ErrMsg)//C_NULL_CHAR, ErrMsg_c ) + return + end if + + ! check that these are valid: + IF (t_initial_out /= t_initial) CALL SetErrStat(ErrID_Fatal, "invalid value of t_initial.", ErrStat, ErrMsg, RoutineName ) + IF (NumTurbines_out /= 1) CALL SetErrStat(ErrID_Fatal, "invalid value of NumTurbines.", ErrStat, ErrMsg, RoutineName ) + + ! transfer Fortran variables to C: + n_t_global_c = n_t_global + AbortErrLev_c = AbortErrLev + NumOuts_c = min(MAXOUTPUTS, 1 + SUM( Turbine(iTurb)%y_FAST%numOuts )) ! includes time + numblades_c = Turbine(iTurb)%ED%p%NumBl + dt_c = Turbine(iTurb)%p_FAST%dt + +#ifdef CONSOLE_FILE + if (ErrStat .ne. ErrID_None) call wrscr1(trim(ErrMsg)) +#endif + + CompLoadsType = Turbine(iTurb)%p_FAST%CompAero + + if ( (CompLoadsType .ne. Module_ExtLd) ) then + CALL SetErrStat(ErrID_Fatal, "CompAero is not set to 3 for use of the External Loads module. Use a different initialization call for this turbine.", ErrStat, ErrMsg, RoutineName ) + ErrStat_c = ErrStat + ErrMsg_c = TRANSFER( trim(ErrMsg)//C_NULL_CHAR, ErrMsg_c ) + return + end if + + write(*,*) 'Finished restoring OpenFAST from checkpoint' + call SetExtLoads_pointers(iTurb, ExtLd_Input_from_FAST, ExtLd_Parameter_from_FAST, ExtLd_Output_to_FAST) + + ErrStat_c = ErrStat + ErrMsg_c = TRANSFER( trim(ErrMsg)//C_NULL_CHAR, ErrMsg_c ) + +end subroutine FAST_ExtLoads_Restart +!================================================================================================================================== +subroutine SetExtLoads_pointers(iTurb, ExtLd_iFromOF, ExtLd_pFromOF, ExtLd_oToOF) + + IMPLICIT NONE + INTEGER(C_INT), INTENT(IN ) :: iTurb ! Turbine number + TYPE(ExtLdDX_InputType_C), INTENT(INOUT) :: ExtLd_iFromOF + TYPE(ExtLdDX_ParameterType_C), INTENT(INOUT) :: ExtLd_pFromOF + TYPE(ExtLdDX_OutputType_C), INTENT(INOUT) :: ExtLd_oToOF + + ! Inputs + ExtLd_iFromOF%bldPitch_Len = Turbine(iTurb)%ExtLd%u%DX_u%c_obj%bldPitch_Len; ExtLd_iFromOF%bldPitch = Turbine(iTurb)%ExtLd%u%DX_u%c_obj%bldPitch + ExtLd_iFromOF%twrDef_Len = Turbine(iTurb)%ExtLd%u%DX_u%c_obj%twrDef_Len; ExtLd_iFromOF%twrDef = Turbine(iTurb)%ExtLd%u%DX_u%c_obj%twrDef + ExtLd_iFromOF%bldDef_Len = Turbine(iTurb)%ExtLd%u%DX_u%c_obj%bldDef_Len; ExtLd_iFromOF%bldDef = Turbine(iTurb)%ExtLd%u%DX_u%c_obj%bldDef + ExtLd_iFromOF%bldRootDef_Len = Turbine(iTurb)%ExtLd%u%DX_u%c_obj%bldRootDef_Len; ExtLd_iFromOF%bldRootDef = Turbine(iTurb)%ExtLd%u%DX_u%c_obj%bldRootDef + ExtLd_iFromOF%hubDef_Len = Turbine(iTurb)%ExtLd%u%DX_u%c_obj%hubDef_Len; ExtLd_iFromOF%hubDef = Turbine(iTurb)%ExtLd%u%DX_u%c_obj%hubDef + ExtLd_iFromOF%nacDef_Len = Turbine(iTurb)%ExtLd%u%DX_u%c_obj%nacDef_Len; ExtLd_iFromOF%nacDef = Turbine(iTurb)%ExtLd%u%DX_u%c_obj%nacDef + + ! Parameters + ExtLd_pFromOF%nBlades_Len = Turbine(iTurb)%ExtLd%p%DX_p%c_obj%nBlades_Len; ExtLd_pFromOF%nBlades = Turbine(iTurb)%ExtLd%p%DX_p%c_obj%nBlades + ExtLd_pFromOF%nBladeNodes_Len = Turbine(iTurb)%ExtLd%p%DX_p%c_obj%nBladeNodes_Len; ExtLd_pFromOF%nBladeNodes = Turbine(iTurb)%ExtLd%p%DX_p%c_obj%nBladeNodes + ExtLd_pFromOF%nTowerNodes_Len = Turbine(iTurb)%ExtLd%p%DX_p%c_obj%nTowerNodes_Len; ExtLd_pFromOF%nTowerNodes = Turbine(iTurb)%ExtLd%p%DX_p%c_obj%nTowerNodes + + ExtLd_pFromOF%twrHloc_Len = Turbine(iTurb)%ExtLd%p%DX_p%c_obj%twrHloc_Len; ExtLd_pFromOF%twrHloc = Turbine(iTurb)%ExtLd%p%DX_p%c_obj%twrHloc + ExtLd_pFromOF%twrDia_Len = Turbine(iTurb)%ExtLd%p%DX_p%c_obj%twrDia_Len; ExtLd_pFromOF%twrDia = Turbine(iTurb)%ExtLd%p%DX_p%c_obj%twrDia + ExtLd_pFromOF%twrRefPos_Len = Turbine(iTurb)%ExtLd%p%DX_p%c_obj%twrRefPos_Len; ExtLd_pFromOF%twrRefPos = Turbine(iTurb)%ExtLd%p%DX_p%c_obj%twrRefPos + ExtLd_pFromOF%bldRloc_Len = Turbine(iTurb)%ExtLd%p%DX_p%c_obj%bldRloc_Len; ExtLd_pFromOF%bldRloc = Turbine(iTurb)%ExtLd%p%DX_p%c_obj%bldRloc + ExtLd_pFromOF%bldChord_Len = Turbine(iTurb)%ExtLd%p%DX_p%c_obj%bldChord_Len; ExtLd_pFromOF%bldChord = Turbine(iTurb)%ExtLd%p%DX_p%c_obj%bldChord + ExtLd_pFromOF%bldRefPos_Len = Turbine(iTurb)%ExtLd%p%DX_p%c_obj%bldRefPos_Len; ExtLd_pFromOF%bldRefPos = Turbine(iTurb)%ExtLd%p%DX_p%c_obj%bldRefPos + ExtLd_pFromOF%bldRootRefPos_Len = Turbine(iTurb)%ExtLd%p%DX_p%c_obj%bldRootRefPos_Len; ExtLd_pFromOF%bldRootRefPos = Turbine(iTurb)%ExtLd%p%DX_p%c_obj%bldRootRefPos + ExtLd_pFromOF%hubRefPos_Len = Turbine(iTurb)%ExtLd%p%DX_p%c_obj%hubRefPos_Len; ExtLd_pFromOF%hubRefPos = Turbine(iTurb)%ExtLd%p%DX_p%c_obj%hubRefPos + ExtLd_pFromOF%nacRefPos_Len = Turbine(iTurb)%ExtLd%p%DX_p%c_obj%nacRefPos_Len; ExtLd_pFromOF%nacRefPos = Turbine(iTurb)%ExtLd%p%DX_p%c_obj%nacRefPos + + ! Outputs + ExtLd_oToOF%twrLd_Len = Turbine(iTurb)%ExtLd%y%DX_y%c_obj%twrLd_Len; ExtLd_oToOF%twrLd = Turbine(iTurb)%ExtLd%y%DX_y%c_obj%twrLd + ExtLd_oToOF%bldLd_Len = Turbine(iTurb)%ExtLd%y%DX_y%c_obj%bldLd_Len; ExtLd_oToOF%bldLd = Turbine(iTurb)%ExtLd%y%DX_y%c_obj%bldLd + + end subroutine SetExtLoads_pointers + +!================================================================================================================================== +subroutine SetExternalInflow_pointers(iTurb, ExtInfw_Input_from_FAST, ExtInfw_Output_to_FAST, SC_DX_Input_from_FAST, SC_DX_Output_to_FAST) + + IMPLICIT NONE + INTEGER(C_INT), INTENT(IN ) :: iTurb ! Turbine number + TYPE(ExtInfw_InputType_C), INTENT(INOUT) :: ExtInfw_Input_from_FAST + TYPE(ExtInfw_OutputType_C),INTENT(INOUT) :: ExtInfw_Output_to_FAST TYPE(SC_DX_InputType_C), INTENT(INOUT) :: SC_DX_Input_from_FAST TYPE(SC_DX_OutputType_C), INTENT(INOUT) :: SC_DX_Output_to_FAST - OpFM_Input_from_FAST%pxVel_Len = Turbine(iTurb)%OpFM%u%c_obj%pxVel_Len; OpFM_Input_from_FAST%pxVel = Turbine(iTurb)%OpFM%u%c_obj%pxVel - OpFM_Input_from_FAST%pyVel_Len = Turbine(iTurb)%OpFM%u%c_obj%pyVel_Len; OpFM_Input_from_FAST%pyVel = Turbine(iTurb)%OpFM%u%c_obj%pyVel - OpFM_Input_from_FAST%pzVel_Len = Turbine(iTurb)%OpFM%u%c_obj%pzVel_Len; OpFM_Input_from_FAST%pzVel = Turbine(iTurb)%OpFM%u%c_obj%pzVel - OpFM_Input_from_FAST%pxForce_Len = Turbine(iTurb)%OpFM%u%c_obj%pxForce_Len; OpFM_Input_from_FAST%pxForce = Turbine(iTurb)%OpFM%u%c_obj%pxForce - OpFM_Input_from_FAST%pyForce_Len = Turbine(iTurb)%OpFM%u%c_obj%pyForce_Len; OpFM_Input_from_FAST%pyForce = Turbine(iTurb)%OpFM%u%c_obj%pyForce - OpFM_Input_from_FAST%pzForce_Len = Turbine(iTurb)%OpFM%u%c_obj%pzForce_Len; OpFM_Input_from_FAST%pzForce = Turbine(iTurb)%OpFM%u%c_obj%pzForce - OpFM_Input_from_FAST%xdotForce_Len = Turbine(iTurb)%OpFM%u%c_obj%xdotForce_Len; OpFM_Input_from_FAST%xdotForce = Turbine(iTurb)%OpFM%u%c_obj%xdotForce - OpFM_Input_from_FAST%ydotForce_Len = Turbine(iTurb)%OpFM%u%c_obj%ydotForce_Len; OpFM_Input_from_FAST%ydotForce = Turbine(iTurb)%OpFM%u%c_obj%ydotForce - OpFM_Input_from_FAST%zdotForce_Len = Turbine(iTurb)%OpFM%u%c_obj%zdotForce_Len; OpFM_Input_from_FAST%zdotForce = Turbine(iTurb)%OpFM%u%c_obj%zdotForce - OpFM_Input_from_FAST%pOrientation_Len = Turbine(iTurb)%OpFM%u%c_obj%pOrientation_Len; OpFM_Input_from_FAST%pOrientation = Turbine(iTurb)%OpFM%u%c_obj%pOrientation - OpFM_Input_from_FAST%fx_Len = Turbine(iTurb)%OpFM%u%c_obj%fx_Len; OpFM_Input_from_FAST%fx = Turbine(iTurb)%OpFM%u%c_obj%fx - OpFM_Input_from_FAST%fy_Len = Turbine(iTurb)%OpFM%u%c_obj%fy_Len; OpFM_Input_from_FAST%fy = Turbine(iTurb)%OpFM%u%c_obj%fy - OpFM_Input_from_FAST%fz_Len = Turbine(iTurb)%OpFM%u%c_obj%fz_Len; OpFM_Input_from_FAST%fz = Turbine(iTurb)%OpFM%u%c_obj%fz - OpFM_Input_from_FAST%momentx_Len = Turbine(iTurb)%OpFM%u%c_obj%momentx_Len; OpFM_Input_from_FAST%momentx = Turbine(iTurb)%OpFM%u%c_obj%momentx - OpFM_Input_from_FAST%momenty_Len = Turbine(iTurb)%OpFM%u%c_obj%momenty_Len; OpFM_Input_from_FAST%momenty = Turbine(iTurb)%OpFM%u%c_obj%momenty - OpFM_Input_from_FAST%momentz_Len = Turbine(iTurb)%OpFM%u%c_obj%momentz_Len; OpFM_Input_from_FAST%momentz = Turbine(iTurb)%OpFM%u%c_obj%momentz - OpFM_Input_from_FAST%forceNodesChord_Len = Turbine(iTurb)%OpFM%u%c_obj%forceNodesChord_Len; OpFM_Input_from_FAST%forceNodesChord = Turbine(iTurb)%OpFM%u%c_obj%forceNodesChord + ExtInfw_Input_from_FAST%pxVel_Len = Turbine(iTurb)%ExtInfw%u%c_obj%pxVel_Len; ExtInfw_Input_from_FAST%pxVel = Turbine(iTurb)%ExtInfw%u%c_obj%pxVel + ExtInfw_Input_from_FAST%pyVel_Len = Turbine(iTurb)%ExtInfw%u%c_obj%pyVel_Len; ExtInfw_Input_from_FAST%pyVel = Turbine(iTurb)%ExtInfw%u%c_obj%pyVel + ExtInfw_Input_from_FAST%pzVel_Len = Turbine(iTurb)%ExtInfw%u%c_obj%pzVel_Len; ExtInfw_Input_from_FAST%pzVel = Turbine(iTurb)%ExtInfw%u%c_obj%pzVel + ExtInfw_Input_from_FAST%pxForce_Len = Turbine(iTurb)%ExtInfw%u%c_obj%pxForce_Len; ExtInfw_Input_from_FAST%pxForce = Turbine(iTurb)%ExtInfw%u%c_obj%pxForce + ExtInfw_Input_from_FAST%pyForce_Len = Turbine(iTurb)%ExtInfw%u%c_obj%pyForce_Len; ExtInfw_Input_from_FAST%pyForce = Turbine(iTurb)%ExtInfw%u%c_obj%pyForce + ExtInfw_Input_from_FAST%pzForce_Len = Turbine(iTurb)%ExtInfw%u%c_obj%pzForce_Len; ExtInfw_Input_from_FAST%pzForce = Turbine(iTurb)%ExtInfw%u%c_obj%pzForce + ExtInfw_Input_from_FAST%xdotForce_Len = Turbine(iTurb)%ExtInfw%u%c_obj%xdotForce_Len; ExtInfw_Input_from_FAST%xdotForce = Turbine(iTurb)%ExtInfw%u%c_obj%xdotForce + ExtInfw_Input_from_FAST%ydotForce_Len = Turbine(iTurb)%ExtInfw%u%c_obj%ydotForce_Len; ExtInfw_Input_from_FAST%ydotForce = Turbine(iTurb)%ExtInfw%u%c_obj%ydotForce + ExtInfw_Input_from_FAST%zdotForce_Len = Turbine(iTurb)%ExtInfw%u%c_obj%zdotForce_Len; ExtInfw_Input_from_FAST%zdotForce = Turbine(iTurb)%ExtInfw%u%c_obj%zdotForce + ExtInfw_Input_from_FAST%pOrientation_Len = Turbine(iTurb)%ExtInfw%u%c_obj%pOrientation_Len; ExtInfw_Input_from_FAST%pOrientation = Turbine(iTurb)%ExtInfw%u%c_obj%pOrientation + ExtInfw_Input_from_FAST%fx_Len = Turbine(iTurb)%ExtInfw%u%c_obj%fx_Len; ExtInfw_Input_from_FAST%fx = Turbine(iTurb)%ExtInfw%u%c_obj%fx + ExtInfw_Input_from_FAST%fy_Len = Turbine(iTurb)%ExtInfw%u%c_obj%fy_Len; ExtInfw_Input_from_FAST%fy = Turbine(iTurb)%ExtInfw%u%c_obj%fy + ExtInfw_Input_from_FAST%fz_Len = Turbine(iTurb)%ExtInfw%u%c_obj%fz_Len; ExtInfw_Input_from_FAST%fz = Turbine(iTurb)%ExtInfw%u%c_obj%fz + ExtInfw_Input_from_FAST%momentx_Len = Turbine(iTurb)%ExtInfw%u%c_obj%momentx_Len; ExtInfw_Input_from_FAST%momentx = Turbine(iTurb)%ExtInfw%u%c_obj%momentx + ExtInfw_Input_from_FAST%momenty_Len = Turbine(iTurb)%ExtInfw%u%c_obj%momenty_Len; ExtInfw_Input_from_FAST%momenty = Turbine(iTurb)%ExtInfw%u%c_obj%momenty + ExtInfw_Input_from_FAST%momentz_Len = Turbine(iTurb)%ExtInfw%u%c_obj%momentz_Len; ExtInfw_Input_from_FAST%momentz = Turbine(iTurb)%ExtInfw%u%c_obj%momentz + ExtInfw_Input_from_FAST%forceNodesChord_Len = Turbine(iTurb)%ExtInfw%u%c_obj%forceNodesChord_Len; ExtInfw_Input_from_FAST%forceNodesChord = Turbine(iTurb)%ExtInfw%u%c_obj%forceNodesChord if (Turbine(iTurb)%p_FAST%UseSC) then SC_DX_Input_from_FAST%toSC_Len = Turbine(iTurb)%SC_DX%u%c_obj%toSC_Len SC_DX_Input_from_FAST%toSC = Turbine(iTurb)%SC_DX%u%c_obj%toSC end if - OpFM_Output_to_FAST%u_Len = Turbine(iTurb)%OpFM%y%c_obj%u_Len; OpFM_Output_to_FAST%u = Turbine(iTurb)%OpFM%y%c_obj%u - OpFM_Output_to_FAST%v_Len = Turbine(iTurb)%OpFM%y%c_obj%v_Len; OpFM_Output_to_FAST%v = Turbine(iTurb)%OpFM%y%c_obj%v - OpFM_Output_to_FAST%w_Len = Turbine(iTurb)%OpFM%y%c_obj%w_Len; OpFM_Output_to_FAST%w = Turbine(iTurb)%OpFM%y%c_obj%w + ExtInfw_Output_to_FAST%u_Len = Turbine(iTurb)%ExtInfw%y%c_obj%u_Len; ExtInfw_Output_to_FAST%u = Turbine(iTurb)%ExtInfw%y%c_obj%u + ExtInfw_Output_to_FAST%v_Len = Turbine(iTurb)%ExtInfw%y%c_obj%v_Len; ExtInfw_Output_to_FAST%v = Turbine(iTurb)%ExtInfw%y%c_obj%v + ExtInfw_Output_to_FAST%w_Len = Turbine(iTurb)%ExtInfw%y%c_obj%w_Len; ExtInfw_Output_to_FAST%w = Turbine(iTurb)%ExtInfw%y%c_obj%w if (Turbine(iTurb)%p_FAST%UseSC) then SC_DX_Output_to_FAST%fromSC_Len = Turbine(iTurb)%SC_DX%y%c_obj%fromSC_Len SC_DX_Output_to_FAST%fromSC = Turbine(iTurb)%SC_DX%y%c_obj%fromSC end if -end subroutine SetOpenFOAM_pointers +end subroutine SetExternalInflow_pointers !================================================================================================================================== -subroutine FAST_OpFM_Step(iTurb_c, ErrStat_c, ErrMsg_c) BIND (C, NAME='FAST_OpFM_Step') +subroutine FAST_CFD_Prework(iTurb_c, ErrStat_c, ErrMsg_c) BIND (C, NAME='FAST_CFD_Prework') IMPLICIT NONE #ifndef IMPLICIT_DLLEXPORT -!DEC$ ATTRIBUTES DLLEXPORT :: FAST_OpFM_Step -!GCC$ ATTRIBUTES DLLEXPORT :: FAST_OpFM_Step +!DEC$ ATTRIBUTES DLLEXPORT :: FAST_CFD_Prework +!GCC$ ATTRIBUTES DLLEXPORT :: FAST_CFD_Prework #endif INTEGER(C_INT), INTENT(IN ) :: iTurb_c ! Turbine number, c indexing (starts at 0 for first turbine) - INTEGER(C_INT), INTENT( OUT) :: ErrStat_c - CHARACTER(KIND=C_CHAR), INTENT( OUT) :: ErrMsg_c(IntfStrLen) + INTEGER(C_INT), INTENT( OUT) :: ErrStat_c + CHARACTER(KIND=C_CHAR), INTENT( OUT) :: ErrMsg_c(IntfStrLen) integer(IntKi) :: iTurb ! turbine number: Fortran indexing (starts at 1 for first turbine) ! transfer turbine index number from C to Fortran indexing (0 to 1 start) iTurb = int(iTurb_c,IntKi) + 1 - IF ( n_t_global > Turbine(iTurb)%p_FAST%n_TMax_m1 ) THEN !finish - + IF ( n_t_global > Turbine(iTurb)%p_FAST%n_TMax_m1 ) THEN !finish + ! we can't continue because we might over-step some arrays that are allocated to the size of the simulation - + if (iTurb == NumTurbines) then IF (n_t_global == Turbine(iTurb)%p_FAST%n_TMax_m1 + 1) THEN ! we call update an extra time in Simulink, which we can ignore until the time shift with outputs is solved n_t_global = n_t_global + 1 ErrStat_c = ErrID_None ErrMsg = C_NULL_CHAR ErrMsg_c = TRANSFER( ErrMsg//C_NULL_CHAR, ErrMsg_c ) - ELSE + ELSE ErrStat_c = ErrID_Info ErrMsg = "Simulation completed."//C_NULL_CHAR ErrMsg_c = TRANSFER( ErrMsg//C_NULL_CHAR, ErrMsg_c ) END IF end if - + ELSE - CALL FAST_Solution_T( t_initial, n_t_global, Turbine(iTurb), ErrStat, ErrMsg ) - if (iTurb == NumTurbines) then + ! if(Turbine(iTurb)%SC%p%scOn) then + ! CALL SC_SetOutputs(Turbine(iTurb)%p_FAST, Turbine(iTurb)%SrvD%Input(1), Turbine(iTurb)%SC, ErrStat, ErrMsg) + ! end if + + CALL FAST_Prework_T( t_initial, n_t_global, Turbine(iTurb), ErrStat, ErrMsg ) + + ErrStat_c = ErrStat + ErrMsg = TRIM(ErrMsg)//C_NULL_CHAR + ErrMsg_c = TRANSFER( ErrMsg//C_NULL_CHAR, ErrMsg_c ) + END IF + +end subroutine FAST_CFD_Prework +!================================================================================================================================== +subroutine FAST_CFD_UpdateStates(iTurb_c, ErrStat_c, ErrMsg_c) BIND (C, NAME='FAST_CFD_UpdateStates') + IMPLICIT NONE +#ifndef IMPLICIT_DLLEXPORT +!DEC$ ATTRIBUTES DLLEXPORT :: FAST_CFD_UpdateStates +!GCC$ ATTRIBUTES DLLEXPORT :: FAST_CFD_UpdateStates +#endif + INTEGER(C_INT), INTENT(IN ) :: iTurb_c ! Turbine number, c indexing (starts at 0 for first turbine) + INTEGER(C_INT), INTENT( OUT) :: ErrStat_c + CHARACTER(KIND=C_CHAR), INTENT( OUT) :: ErrMsg_c(IntfStrLen) + integer(IntKi) :: iTurb ! turbine number: Fortran indexing (starts at 1 for first turbine) + + ! transfer turbine index number from C to Fortran indexing (0 to 1 start) + iTurb = int(iTurb_c,IntKi) + 1 + + IF ( n_t_global > Turbine(iTurb)%p_FAST%n_TMax_m1 ) THEN !finish + + ! we can't continue because we might over-step some arrays that are allocated to the size of the simulation + + if (iTurb == NumTurbines ) then + IF (n_t_global == Turbine(iTurb)%p_FAST%n_TMax_m1 + 1) THEN ! we call update an extra time in Simulink, which we can ignore until the time shift with outputs is solved + n_t_global = n_t_global + 1 + ErrStat_c = ErrID_None + ErrMsg = C_NULL_CHAR + ErrMsg_c = TRANSFER( ErrMsg//C_NULL_CHAR, ErrMsg_c ) + ELSE + ErrStat_c = ErrID_Info + ErrMsg = "Simulation completed."//C_NULL_CHAR + ErrMsg_c = TRANSFER( ErrMsg//C_NULL_CHAR, ErrMsg_c ) + END IF + end if + + ELSE + + CALL FAST_UpdateStates_T( t_initial, n_t_global, Turbine(iTurb), ErrStat, ErrMsg ) + + ErrStat_c = ErrStat + ErrMsg = TRIM(ErrMsg)//C_NULL_CHAR + ErrMsg_c = TRANSFER( ErrMsg//C_NULL_CHAR, ErrMsg_c ) + END IF + +end subroutine FAST_CFD_UpdateStates +!================================================================================================================================== +subroutine FAST_CFD_AdvanceToNextTimeStep(iTurb_c, ErrStat_c, ErrMsg_c) BIND (C, NAME='FAST_CFD_AdvanceToNextTimeStep') + IMPLICIT NONE +#ifndef IMPLICIT_DLLEXPORT +!DEC$ ATTRIBUTES DLLEXPORT :: FAST_CFD_AdvanceToNextTimeStep +!GCC$ ATTRIBUTES DLLEXPORT :: FAST_CFD_AdvanceToNextTimeStep +#endif + INTEGER(C_INT), INTENT(IN ) :: iTurb_c ! Turbine number, c indexing (starts at 0 for first turbine) + INTEGER(C_INT), INTENT( OUT) :: ErrStat_c + CHARACTER(KIND=C_CHAR), INTENT( OUT) :: ErrMsg_c(IntfStrLen) + integer(IntKi) :: iTurb ! turbine number: Fortran indexing (starts at 1 for first turbine) + + ! transfer turbine index number from C to Fortran indexing (0 to 1 start) + iTurb = int(iTurb_c,IntKi) + 1 + + IF ( n_t_global > Turbine(iTurb)%p_FAST%n_TMax_m1 ) THEN !finish + + ! we can't continue because we might over-step some arrays that are allocated to the size of the simulation + + if (iTurb == NumTurbines ) then + IF (n_t_global == Turbine(iTurb)%p_FAST%n_TMax_m1 + 1) THEN ! we call update an extra time in Simulink, which we can ignore until the time shift with outputs is solved + n_t_global = n_t_global + 1 + ErrStat_c = ErrID_None + ErrMsg = C_NULL_CHAR + ErrMsg_c = TRANSFER( ErrMsg//C_NULL_CHAR, ErrMsg_c ) + ELSE + ErrStat_c = ErrID_Info + ErrMsg = "Simulation completed."//C_NULL_CHAR + ErrMsg_c = TRANSFER( ErrMsg//C_NULL_CHAR, ErrMsg_c ) + END IF + end if + + ELSE + + CALL FAST_AdvanceToNextTimeStep_T( t_initial, n_t_global, Turbine(iTurb), ErrStat, ErrMsg ) + + ! if(Turbine(iTurb)%SC%p%scOn) then + ! CALL SC_SetInputs(Turbine(iTurb)%p_FAST, Turbine(iTurb)%SrvD%y, Turbine(iTurb)%SC, ErrStat, ErrMsg) + ! end if + + if (iTurb == NumTurbines ) then n_t_global = n_t_global + 1 end if - + ErrStat_c = ErrStat ErrMsg = TRIM(ErrMsg)//C_NULL_CHAR ErrMsg_c = TRANSFER( ErrMsg//C_NULL_CHAR, ErrMsg_c ) END IF + + +end subroutine FAST_CFD_AdvanceToNextTimeStep +!================================================================================================================================== +subroutine FAST_CFD_WriteOutput(iTurb_c, ErrStat_c, ErrMsg_c) BIND (C, NAME='FAST_CFD_WriteOutput') + IMPLICIT NONE +#ifndef IMPLICIT_DLLEXPORT +!DEC$ ATTRIBUTES DLLEXPORT :: FAST_CFD_WriteOutput +!GCC$ ATTRIBUTES DLLEXPORT :: FAST_CFD_WriteOutput +#endif + INTEGER(C_INT), INTENT(IN ) :: iTurb_c ! Turbine number, c indexing (starts at 0 for first turbine) + INTEGER(C_INT), INTENT( OUT) :: ErrStat_c + CHARACTER(KIND=C_CHAR), INTENT( OUT) :: ErrMsg_c(IntfStrLen) + integer(IntKi) :: iTurb ! turbine number: Fortran indexing (starts at 1 for first turbine) + + ! transfer turbine index number from C to Fortran indexing (0 to 1 start) + iTurb = int(iTurb_c,IntKi) + 1 + + CALL FAST_WriteOutput_T( t_initial, n_t_global, Turbine(iTurb), ErrStat, ErrMsg ) + +end subroutine FAST_CFD_WriteOutput +!================================================================================================================================== +subroutine FAST_CFD_Step(iTurb_c, ErrStat_c, ErrMsg_c) BIND (C, NAME='FAST_CFD_Step') + IMPLICIT NONE +#ifndef IMPLICIT_DLLEXPORT +!DEC$ ATTRIBUTES DLLEXPORT :: FAST_CFD_Step +!GCC$ ATTRIBUTES DLLEXPORT :: FAST_CFD_Step +#endif + INTEGER(C_INT), INTENT(IN ) :: iTurb_c ! Turbine number, c indexing (starts at 0 for first turbine) + INTEGER(C_INT), INTENT( OUT) :: ErrStat_c + CHARACTER(KIND=C_CHAR), INTENT( OUT) :: ErrMsg_c(IntfStrLen) + integer(IntKi) :: iTurb ! turbine number: Fortran indexing (starts at 1 for first turbine) + + ! transfer turbine index number from C to Fortran indexing (0 to 1 start) + iTurb = int(iTurb_c,IntKi) + 1 + + IF ( n_t_global > Turbine(iTurb)%p_FAST%n_TMax_m1 ) THEN !finish + + ! we can't continue because we might over-step some arrays that are allocated to the size of the simulation + + if (iTurb == NumTurbines ) then + IF (n_t_global == Turbine(iTurb)%p_FAST%n_TMax_m1 + 1) THEN ! we call update an extra time in Simulink, which we can ignore until the time shift with outputs is solved + n_t_global = n_t_global + 1 + ErrStat_c = ErrID_None + ErrMsg = C_NULL_CHAR + ErrMsg_c = TRANSFER( ErrMsg//C_NULL_CHAR, ErrMsg_c ) + ELSE + ErrStat_c = ErrID_Info + ErrMsg = "Simulation completed."//C_NULL_CHAR + ErrMsg_c = TRANSFER( ErrMsg//C_NULL_CHAR, ErrMsg_c ) + END IF + end if + + ELSE + + CALL FAST_Solution_T( t_initial, n_t_global, Turbine(iTurb), ErrStat, ErrMsg ) + + if (iTurb == NumTurbines ) then + n_t_global = n_t_global + 1 + end if + + ErrStat_c = ErrStat + ErrMsg = TRIM(ErrMsg)//C_NULL_CHAR + ErrMsg_c = TRANSFER( ErrMsg//C_NULL_CHAR, ErrMsg_c ) + END IF + + +end subroutine FAST_CFD_Step +!================================================================================================================================== +subroutine FAST_CFD_Reset_SubStep(iTurb_c, n_timesteps, ErrStat_c, ErrMsg_c) BIND (C, NAME='FAST_CFD_Reset_SubStep') + IMPLICIT NONE +#ifndef IMPLICIT_DLLEXPORT +!DEC$ ATTRIBUTES DLLEXPORT :: FAST_CFD_Reset_SubStep +!GCC$ ATTRIBUTES DLLEXPORT :: FAST_CFD_Reset_SubStep +#endif + INTEGER(C_INT), INTENT(IN ) :: iTurb_c ! Turbine number, c indexing (starts at 0 for first turbine) + INTEGER(C_INT), INTENT(IN ) :: n_timesteps ! Number of time steps to go back + INTEGER(C_INT), INTENT( OUT) :: ErrStat_c + CHARACTER(KIND=C_CHAR), INTENT( OUT) :: ErrMsg_c(IntfStrLen) + integer(IntKi) :: iTurb ! turbine number: Fortran indexing (starts at 1 for first turbine) + + ! transfer turbine index number from C to Fortran indexing (0 to 1 start) + iTurb = int(iTurb_c,IntKi) + 1 + + CALL FAST_Reset_SubStep_T(t_initial, n_t_global-n_timesteps, n_timesteps, Turbine(iTurb), ErrStat, ErrMsg ) + + if (iTurb == NumTurbines ) then + n_t_global = n_t_global - n_timesteps + end if + + ErrStat_c = ErrStat + ErrMsg = TRIM(ErrMsg)//C_NULL_CHAR + ErrMsg_c = TRANSFER( ErrMsg//C_NULL_CHAR, ErrMsg_c ) + +end subroutine FAST_CFD_Reset_SubStep +!================================================================================================================================== +subroutine FAST_CFD_Store_SubStep(iTurb_c, n_t_global, ErrStat_c, ErrMsg_c) BIND (C, NAME='FAST_CFD_Store_SubStep') + IMPLICIT NONE +#ifndef IMPLICIT_DLLEXPORT +!DEC$ ATTRIBUTES DLLEXPORT :: FAST_CFD_Store_SubStep +!GCC$ ATTRIBUTES DLLEXPORT :: FAST_CFD_Store_SubStep +#endif + INTEGER(C_INT), INTENT(IN ) :: iTurb_c ! Turbine number, c indexing (starts at 0 for first turbine) + INTEGER(C_INT), INTENT(IN ) :: n_t_global !< loop counter + INTEGER(C_INT), INTENT( OUT) :: ErrStat_c + CHARACTER(KIND=C_CHAR), INTENT( OUT) :: ErrMsg_c(IntfStrLen) + integer(IntKi) :: iTurb ! turbine number: Fortran indexing (starts at 1 for first turbine) + + ! transfer turbine index number from C to Fortran indexing (0 to 1 start) + iTurb = int(iTurb_c,IntKi) + 1 + + CALL FAST_Store_SubStep_T(t_initial, n_t_global, Turbine(iTurb), ErrStat, ErrMsg ) - -end subroutine FAST_OpFM_Step -!================================================================================================================================== + ErrStat_c = ErrStat + ErrMsg = TRIM(ErrMsg)//C_NULL_CHAR + ErrMsg_c = TRANSFER( ErrMsg//C_NULL_CHAR, ErrMsg_c ) + +end subroutine FAST_CFD_Store_SubStep +!================================================================================================================================== END MODULE FAST_Data diff --git a/modules/openfast-library/src/FAST_Library.h b/modules/openfast-library/src/FAST_Library.h index 54d321ae14..4fc1e3124b 100644 --- a/modules/openfast-library/src/FAST_Library.h +++ b/modules/openfast-library/src/FAST_Library.h @@ -2,7 +2,8 @@ #define FAST_LIBRARY_H // routines in FAST_Library_$(PlatformName).dll -#include "OpenFOAM_Types.h" +#include "ExternalInflow_Types.h" +#include "ExtLoadsDX_Types.h" #include "SCDataEx_Types.h" #include "stdio.h" @@ -15,13 +16,28 @@ EXTERNAL_ROUTINE void FAST_AllocateTurbines(int * iTurb, int *ErrStat, char *ErrMsg); EXTERNAL_ROUTINE void FAST_DeallocateTurbines(int *ErrStat, char *ErrMsg); -EXTERNAL_ROUTINE void FAST_OpFM_Restart(int * iTurb, const char *CheckpointRootName, int *AbortErrLev, double * dt, int * NumBl, int * NumBlElem, int * n_t_global, - OpFM_InputType_t* OpFM_Input, OpFM_OutputType_t* OpFM_Output, SC_DX_InputType_t* SC_DX_Input, SC_DX_OutputType_t* SC_DX_Output, int *ErrStat, char *ErrMsg); -EXTERNAL_ROUTINE void FAST_OpFM_Init(int * iTurb, double *TMax, const char *InputFileName, int * TurbIDforName, int * NumSC2CtrlGlob, int * NumSC2Ctrl, int * NumCtrl2SC, float * initSCInputsGlob, float * initSCInputsTurbine, int * NumActForcePtsBlade, int * NumActForcePtsTower, float * TurbinePosition, - int *AbortErrLev, double * dt, int * NumBl, int * NumBlElem, int * NodeClusterType, OpFM_InputType_t* OpFM_Input, OpFM_OutputType_t* OpFM_Output, SC_DX_InputType_t* SC_DX_Input, SC_DX_OutputType_t* SC_DX_Output, - int *ErrStat, char *ErrMsg); -EXTERNAL_ROUTINE void FAST_OpFM_Solution0(int * iTurb, int *ErrStat, char *ErrMsg); -EXTERNAL_ROUTINE void FAST_OpFM_Step(int * iTurb, int *ErrStat, char *ErrMsg); +EXTERNAL_ROUTINE void FAST_ExtInfw_Restart(int * iTurb, const char *CheckpointRootName, int *AbortErrLev, double * dt, int * InflowType, + int * NumBl, int * NumBlElem, int * NumTwrElem, int * n_t_global, + ExtInfw_InputType_t* ExtInfw_Input, ExtInfw_OutputType_t* ExtInfw_Output, SC_DX_InputType_t* SC_DX_Input, SC_DX_OutputType_t* SC_DX_Output, + int *ErrStat, char *ErrMsg); +EXTERNAL_ROUTINE void FAST_ExtInfw_Init(int * iTurb, double *TMax, const char *InputFileName, int * TurbIDforName, char *OutFileRoot, + int * NumSC2CtrlGlob, int * NumSC2Ctrl, int * NumCtrl2SC, float * initSCInputsGlob, float * initSCInputsTurbine, + int * NumActForcePtsBlade, int * NumActForcePtsTower, float * TurbinePosition, int *AbortErrLev, + double * dtDriver, double * dt, int * InflowType, int * NumBl, int * NumBlElem, int * NumTwrElem, int * NodeClusterType, + ExtInfw_InputType_t* ExtInfw_Input, ExtInfw_OutputType_t* ExtInfw_Output, SC_DX_InputType_t* SC_DX_Input, SC_DX_OutputType_t* SC_DX_Output, + int *ErrStat, char *ErrMsg); + +EXTERNAL_ROUTINE void FAST_ExtLoads_Restart(int * iTurb, const char *CheckpointRootName, int *AbortErrLev, double * dt, int * NumBl, int * n_t_global, ExtLdDX_InputType_t* ExtLdDX_Input, ExtLdDX_ParameterType_t* ExtLdDX_Parameter, ExtLdDX_OutputType_t* ExtLdDX_Output, SC_DX_InputType_t* SC_DX_Input, SC_DX_OutputType_t* SC_DX_Output, int *ErrStat, char *ErrMsg); +EXTERNAL_ROUTINE void FAST_ExtLoads_Init(int * iTurb, double *TMax, const char *InputFileName, int * TurbineID, char *OutFileRoot, float * TurbinePosition, int *AbortErrLev, double * dtDriver, double * dt, int * NumBl, double * az_blend_mean, double * az_blend_delta, ExtLdDX_InputType_t* ExtLdDX_Input, ExtLdDX_ParameterType_t* ExtLdDX_Parameter, ExtLdDX_OutputType_t* ExtLdDX_Output, SC_DX_InputType_t* SC_DX_Input, SC_DX_OutputType_t* SC_DX_Output, int *ErrStat, char *ErrMsg); +EXTERNAL_ROUTINE void FAST_CFD_Solution0(int * iTurb, int *ErrStat, char *ErrMsg); +EXTERNAL_ROUTINE void FAST_CFD_InitIOarrays_SubStep(int * iTurb, int *ErrStat, char *ErrMsg); +EXTERNAL_ROUTINE void FAST_CFD_Prework(int * iTurb, int *ErrStat, char *ErrMsg); +EXTERNAL_ROUTINE void FAST_CFD_UpdateStates(int * iTurb, int *ErrStat, char *ErrMsg); +EXTERNAL_ROUTINE void FAST_CFD_AdvanceToNextTimeStep(int * iTurb, int *ErrStat, char *ErrMsg); +EXTERNAL_ROUTINE void FAST_CFD_WriteOutput(int * iTurb, int *ErrStat, char *ErrMsg); +EXTERNAL_ROUTINE void FAST_CFD_Step(int * iTurb, int *ErrStat, char *ErrMsg); +EXTERNAL_ROUTINE void FAST_CFD_Reset_SubStep(int * iTurb, int * n_timesteps, int *ErrStat, char *ErrMsg); +EXTERNAL_ROUTINE void FAST_CFD_Store_SubStep(int * iTurb, int * n_t_global, int *ErrStat, char *ErrMsg); EXTERNAL_ROUTINE void FAST_HubPosition(int * iTurb, float * absolute_position, float * rotation_veocity, double * orientation_dcm, int *ErrStat, char *ErrMsg); @@ -46,8 +62,6 @@ EXTERNAL_ROUTINE void FAST_CreateCheckpoint(int * iTurb, const char *CheckpointR #define ErrID_Fatal 4 -#define SensorType_None -1 - // make sure these parameters match with FAST_Library.f90 and NWTC_Base.f90 #define MAXIMUM_BLADES 3 #define MAXIMUM_AFCTRL 3 diff --git a/modules/openfast-library/src/FAST_Lin.f90 b/modules/openfast-library/src/FAST_Lin.f90 index f8414a36df..7f4a9bf929 100644 --- a/modules/openfast-library/src/FAST_Lin.f90 +++ b/modules/openfast-library/src/FAST_Lin.f90 @@ -70,11 +70,15 @@ SUBROUTINE Init_Lin(p_FAST, y_FAST, m_FAST, AD, ED, NumBl, NumBlNodes, ErrStat, if ( p_FAST%CompInflow == Module_IfW ) then p_FAST%Lin_NumMods = p_FAST%Lin_NumMods + 1 p_FAST%Lin_ModOrder( p_FAST%Lin_NumMods ) = Module_IfW - call Init_Lin_IfW( p_FAST, y_FAST, AD%Input(1) ) ! overwrite some variables based on knowledge from glue code - end if - + + ! SeaState next, if activated: + if ( p_FAST%CompSeaSt == Module_SeaSt ) then + p_FAST%Lin_NumMods = p_FAST%Lin_NumMods + 1 + p_FAST%Lin_ModOrder( p_FAST%Lin_NumMods ) = Module_SeaSt + end if + ! ServoDyn is next, if activated: if ( p_FAST%CompServo == Module_SrvD ) then p_FAST%Lin_NumMods = p_FAST%Lin_NumMods + 1 @@ -332,10 +336,14 @@ SUBROUTINE Init_Lin(p_FAST, y_FAST, m_FAST, AD, ED, NumBl, NumBlNodes, ErrStat, call AllocAry( m_FAST%Lin%y_ref, y_FAST%Lin%Glue%SizeLin(LIN_OUTPUT_COL), 'y_ref', ErrStat2, ErrMsg2) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + !call AllocAry( m_FAST%Lin%eps_squared, y_FAST%Lin%Glue%SizeLin(LIN_OUTPUT_COL), 'eps_squared', ErrStat2, ErrMsg2) ! for debugging + ! CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat < AbortErrLev) then m_FAST%Lin%y_interp = 0.0_R8Ki m_FAST%Lin%Y_prevRot = 0.0_R8Ki m_FAST%Lin%y_ref = 1.0_R8Ki + !m_FAST%Lin%eps_squared = 0.0_ReKi end if end if @@ -380,52 +388,6 @@ SUBROUTINE Init_Lin_IfW( p_FAST, y_FAST, u_AD ) end do end if - IF (p_FAST%CompAero == MODULE_AD) THEN - - DO K = 1,SIZE(u_AD%rotors(1)%BladeMotion) - DO J = 1,u_AD%rotors(1)%BladeMotion(k)%Nnodes - Node = Node + 1 ! InflowWind node - NodeDesc = ' (blade '//trim(num2lstr(k))//', node '//trim(num2lstr(j))//')' - - do i=1,3 !XYZ components of this node - i2 = (Node-1)*3 + i - - position = index(y_FAST%Lin%Modules(Module_IfW)%Instance(1)%Names_u(i2), ',') - 1 - y_FAST%Lin%Modules(Module_IfW)%Instance(1)%Names_u(i2) = y_FAST%Lin%Modules(Module_IfW)%Instance(1)%Names_u(i2)(1:position)//trim(NodeDesc)//& - y_FAST%Lin%Modules(Module_IfW)%Instance(1)%Names_u(i2)(position+1:) - - position = index(y_FAST%Lin%Modules(Module_IfW)%Instance(1)%Names_y(i2), ',') - 1 - y_FAST%Lin%Modules(Module_IfW)%Instance(1)%Names_y(i2) = y_FAST%Lin%Modules(Module_IfW)%Instance(1)%Names_y(i2)(1:position)//trim(NodeDesc)//& - y_FAST%Lin%Modules(Module_IfW)%Instance(1)%Names_y(i2)(position+1:) - - ! IfW has inputs and outputs in the global frame - !y_FAST%Lin%Modules(Module_IfW)%Instance(1)%RotFrame_u(i2) = .true. - !y_FAST%Lin%Modules(Module_IfW)%Instance(1)%RotFrame_y(i2) = .true. - - end do - END DO !J = 1,p%BldNodes ! Loop through the blade nodes / elements - END DO !K = 1,p%NumBl - - ! tower: - DO J=1,u_AD%rotors(1)%TowerMotion%nnodes - Node = Node + 1 - NodeDesc = ' (Tower node '//trim(num2lstr(j))//')' - - do i=1,3 !XYZ components of this node - i2 = (Node-1)*3 + i - - position = index(y_FAST%Lin%Modules(Module_IfW)%Instance(1)%Names_u(i2), ',') - 1 - y_FAST%Lin%Modules(Module_IfW)%Instance(1)%Names_u(i2) = y_FAST%Lin%Modules(Module_IfW)%Instance(1)%Names_u(i2)(1:position)//trim(NodeDesc)//& - y_FAST%Lin%Modules(Module_IfW)%Instance(1)%Names_u(i2)(position+1:) - - position = index(y_FAST%Lin%Modules(Module_IfW)%Instance(1)%Names_y(i2), ',') - 1 - y_FAST%Lin%Modules(Module_IfW)%Instance(1)%Names_y(i2) = y_FAST%Lin%Modules(Module_IfW)%Instance(1)%Names_y(i2)(1:position)//trim(NodeDesc)//& - y_FAST%Lin%Modules(Module_IfW)%Instance(1)%Names_y(i2)(position+1:) - end do - END DO - - END IF - END SUBROUTINE Init_Lin_IfW !---------------------------------------------------------------------------------------------------------------------------------- !> Routine that initializes some use_u and use_y, which determine which, if any, inputs and outputs are output in the linearization file. @@ -486,10 +448,11 @@ SUBROUTINE Init_Lin_InputOutput(p_FAST, y_FAST, NumBl, NumBlNodes, ErrStat, ErrM y_FAST%Lin%Modules(ThisModule)%Instance(k)%use_u = .false. end do end do - - ! AD standard inputs: UserProp(NumBlNodes,NumBl) + +!NOTE: we assume that the standard inputs are the last inputs. These would ideally be checked against a stored set of indices so the order could be arbitrary + ! AD standard inputs: UserProp(NumBlNodes,NumBl), and 3 Extended inputs if (p_FAST%CompAero == MODULE_AD) then - do j=1,NumBl*NumBlNodes + do j=1,NumBl*NumBlNodes+3 y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%use_u(y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%SizeLin(LIN_INPUT_COL)+1-j) = .true. end do end if @@ -499,16 +462,18 @@ SUBROUTINE Init_Lin_InputOutput(p_FAST, y_FAST, NumBl, NumBlNodes, ErrStat, ErrM y_FAST%Lin%Modules(MODULE_ED)%Instance(1)%use_u(y_FAST%Lin%Modules(MODULE_ED)%Instance(1)%SizeLin(LIN_INPUT_COL)+1-j) = .true. end do - ! IfW standard inputs: HWindSpeed, PLexp, PropagationDir + ! IfW standard inputs (extended): HWindSpeed, PLexp, PropagationDir if (p_FAST%CompInflow == MODULE_IfW) then do j = 1,3 y_FAST%Lin%Modules(MODULE_IfW)%Instance(1)%use_u(y_FAST%Lin%Modules(MODULE_IfW)%Instance(1)%SizeLin(LIN_INPUT_COL)+1-j) = .true. end do end if - ! HD standard inputs: WaveElev0 + ! HD standard inputs (extended): WaveElev0, HWindSpeed, PLexp, PropagationDir if (p_FAST%CompHydro == MODULE_HD) then - y_FAST%Lin%Modules(MODULE_HD)%Instance(1)%use_u(y_FAST%Lin%Modules(MODULE_HD)%Instance(1)%SizeLin(LIN_INPUT_COL)) = .true. + do j = 1,4 + y_FAST%Lin%Modules(MODULE_HD)%Instance(1)%use_u(y_FAST%Lin%Modules(MODULE_HD)%Instance(1)%SizeLin(LIN_INPUT_COL)+1-j) = .true. + end do end if ! SD has no standard inputs @@ -563,23 +528,21 @@ SUBROUTINE Init_Lin_InputOutput(p_FAST, y_FAST, NumBl, NumBlNodes, ErrStat, ErrM END SUBROUTINE Init_Lin_InputOutput !---------------------------------------------------------------------------------------------------------------------------------- -!> Routine that performs lineaization at current operating point for a turbine. -SUBROUTINE FAST_Linearize_OP(t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, OpFM, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & +!> Routine that performs lineaization at current operating point for a turbine. +SUBROUTINE FAST_Linearize_OP(t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, ExtInfw, HD, SeaSt, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & IceF, IceD, MeshMapData, ErrStat, ErrMsg ) - REAL(DbKi), INTENT(IN ) :: t_global !< current (global) simulation time - TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Output variables for the glue code TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables - TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data - TYPE(OpenFOAM_Data), INTENT(INOUT) :: OpFM !< OpenFOAM data + TYPE(ExternalInflow_Data),INTENT(INOUT) :: ExtInfw !< ExternalInflow data TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HydroDyn data + TYPE(SeaState_Data), INTENT(INOUT) :: SeaSt !< SeaState data TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SubDyn data TYPE(ExtPtfm_Data), INTENT(INOUT) :: ExtPtfm !< ExtPtfm_MCKF data TYPE(MAP_Data), INTENT(INOUT) :: MAPp !< MAP data @@ -588,9 +551,7 @@ SUBROUTINE FAST_Linearize_OP(t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, TYPE(OrcaFlex_Data), INTENT(INOUT) :: Orca !< OrcaFlex interface data TYPE(IceFloe_Data), INTENT(INOUT) :: IceF !< IceFloe data TYPE(IceDyn_Data), INTENT(INOUT) :: IceD !< All the IceDyn data used in time-step loop - TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None @@ -598,8 +559,8 @@ SUBROUTINE FAST_Linearize_OP(t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, INTEGER(IntKi) :: Un ! unit number for linearization output file (written in two parts) INTEGER(IntKi) :: ErrStat2 ! local error status CHARACTER(ErrMsgLen) :: ErrMsg2 ! local error message - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_Linearize_OP' - + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_Linearize_OP' + REAL(R8Ki), ALLOCATABLE :: dUdu(:,:), dUdy(:,:) ! variables for glue-code linearization integer(intki) :: NumBl integer(intki) :: k @@ -608,13 +569,13 @@ SUBROUTINE FAST_Linearize_OP(t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, CHARACTER(200) :: SimStr CHARACTER(MaxWrScrLen) :: BlankLine CHARACTER(*), PARAMETER :: Fmt = 'F10.2' - - - + + + ErrStat = ErrID_None ErrMsg = "" Un = -1 - + !..................... SimStr = '(RotSpeed='//trim(num2lstr(ED%y%RotSpeed*RPS2RPM,Fmt))//' rpm, BldPitch1='//trim(num2lstr(ED%y%BlPitch(1)*R2D,Fmt))//' deg)' @@ -622,201 +583,140 @@ SUBROUTINE FAST_Linearize_OP(t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, CALL WrOver( BlankLine ) ! BlankLine contains MaxWrScrLen spaces CALL WrOver ( ' Performing linearization '//trim(num2lstr(m_FAST%Lin%NextLinTimeIndx))//' at simulation time '//TRIM( Num2LStr(t_global) )//' s. '//trim(SimStr) ) CALL WrScr('') - + !..................... - + LinRootName = TRIM(p_FAST%OutFileRoot)//'.'//trim(num2lstr(m_FAST%Lin%NextLinTimeIndx)) - + if (p_FAST%WrVTK == VTK_ModeShapes .and. .not. p_FAST%CalcSteady) then ! we already saved these for the CalcSteady case - call SaveOP(m_FAST%Lin%NextLinTimeIndx, p_FAST, y_FAST, ED, BD, SrvD, AD, IfW, OpFM, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & + call SaveOP(m_FAST%Lin%NextLinTimeIndx, p_FAST, y_FAST, ED, BD, SrvD, AD, IfW, ExtInfw, HD, SeaSt, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & IceF, IceD, ErrStat, ErrMsg, m_FAST%Lin%CopyOP_CtrlCode ) !m_FAST%Lin%CopyOP_CtrlCode = MESH_UPDATECOPY ! we need a new copy for each LinTime end if - - NumBl = size(ED%Input(1)%BlPitchCom) - y_FAST%Lin%RotSpeed = ED%y%RotSpeed - y_FAST%Lin%Azimuth = ED%y%LSSTipPxa - !..................... - ! ElastoDyn - !..................... + + NumBl = size(ED%Input(1)%BlPitchCom) + y_FAST%Lin%RotSpeed = ED%y%RotSpeed + y_FAST%Lin%Azimuth = ED%y%LSSTipPxa + + !..................... + ! ElastoDyn + !..................... + ! get the jacobians + call ED_JacobianPInput( t_global, ED%Input(1), ED%p, ED%x(STATE_CURR), ED%xd(STATE_CURR), ED%z(STATE_CURR), ED%OtherSt(STATE_CURR), & + ED%y, ED%m, ErrStat2, ErrMsg2, dYdu=y_FAST%Lin%Modules(Module_ED)%Instance(1)%D, dXdu=y_FAST%Lin%Modules(Module_ED)%Instance(1)%B ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + call ED_JacobianPContState( t_global, ED%Input(1), ED%p, ED%x(STATE_CURR), ED%xd(STATE_CURR), ED%z(STATE_CURR), ED%OtherSt(STATE_CURR), & + ED%y, ED%m, ErrStat2, ErrMsg2, dYdx=y_FAST%Lin%Modules(Module_ED)%Instance(1)%C, dXdx=y_FAST%Lin%Modules(Module_ED)%Instance(1)%A ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + ! get the operating point + call ED_GetOP( t_global, ED%Input(1), ED%p, ED%x(STATE_CURR), ED%xd(STATE_CURR), ED%z(STATE_CURR), ED%OtherSt(STATE_CURR), & + ED%y, ED%m, ErrStat2, ErrMsg2, u_op=y_FAST%Lin%Modules(Module_ED)%Instance(1)%op_u, & + y_op=y_FAST%Lin%Modules(Module_ED)%Instance(1)%op_y, & + x_op=y_FAST%Lin%Modules(Module_ED)%Instance(1)%op_x, & + dx_op=y_FAST%Lin%Modules(Module_ED)%Instance(1)%op_dx ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (ErrStat >=AbortErrLev) then + call cleanup() + return + end if + + + ! write the module matrices: + call WriteModuleLinearMatrices(Module_ED, 1, t_global, p_FAST, y_FAST, LinRootName, ErrStat2, ErrMsg2) + if(Failed()) return; + + !..................... + ! BeamDyn + !..................... + if ( p_FAST%CompElast == Module_BD ) then + do k=1,p_FAST%nBeams + ! get the jacobians - call ED_JacobianPInput( t_global, ED%Input(1), ED%p, ED%x(STATE_CURR), ED%xd(STATE_CURR), ED%z(STATE_CURR), ED%OtherSt(STATE_CURR), & - ED%y, ED%m, ErrStat2, ErrMsg2, dYdu=y_FAST%Lin%Modules(Module_ED)%Instance(1)%D, dXdu=y_FAST%Lin%Modules(Module_ED)%Instance(1)%B ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - call ED_JacobianPContState( t_global, ED%Input(1), ED%p, ED%x(STATE_CURR), ED%xd(STATE_CURR), ED%z(STATE_CURR), ED%OtherSt(STATE_CURR), & - ED%y, ED%m, ErrStat2, ErrMsg2, dYdx=y_FAST%Lin%Modules(Module_ED)%Instance(1)%C, dXdx=y_FAST%Lin%Modules(Module_ED)%Instance(1)%A ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - ! get the operating point - call ED_GetOP( t_global, ED%Input(1), ED%p, ED%x(STATE_CURR), ED%xd(STATE_CURR), ED%z(STATE_CURR), ED%OtherSt(STATE_CURR), & - ED%y, ED%m, ErrStat2, ErrMsg2, u_op=y_FAST%Lin%Modules(Module_ED)%Instance(1)%op_u, & - y_op=y_FAST%Lin%Modules(Module_ED)%Instance(1)%op_y, & - x_op=y_FAST%Lin%Modules(Module_ED)%Instance(1)%op_x, & - dx_op=y_FAST%Lin%Modules(Module_ED)%Instance(1)%op_dx ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat >=AbortErrLev) then - call cleanup() - return - end if - - - ! write the module matrices: - if (p_FAST%LinOutMod) then - - OutFileName = trim(LinRootName)//'.'//TRIM(y_FAST%Module_Abrev(Module_ED)) - call WrLinFile_txt_Head(t_global, p_FAST, y_FAST, y_FAST%Lin%Modules(Module_ED)%Instance(1), OutFileName, Un, ErrStat2, ErrMsg2 ) + call BD_JacobianPInput( t_global, BD%Input(1,k), BD%p(k), BD%x(k,STATE_CURR), BD%xd(k,STATE_CURR), BD%z(k,STATE_CURR), BD%OtherSt(k,STATE_CURR), & + BD%y(k), BD%m(k), ErrStat2, ErrMsg2, dYdu=y_FAST%Lin%Modules(Module_BD)%Instance(k)%D, & + dXdu=y_FAST%Lin%Modules(Module_BD)%Instance(k)%B, & + StateRel_x =y_FAST%Lin%Modules(Module_BD)%Instance(k)%StateRel_x, & + StateRel_xdot=y_FAST%Lin%Modules(Module_BD)%Instance(k)%StateRel_xdot ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + call BD_JacobianPContState( t_global, BD%Input(1,k), BD%p(k), BD%x(k,STATE_CURR), BD%xd(k,STATE_CURR), BD%z(k,STATE_CURR), BD%OtherSt(k,STATE_CURR), & + BD%y(k), BD%m(k), ErrStat2, ErrMsg2, dYdx=y_FAST%Lin%Modules(Module_BD)%Instance(k)%C, dXdx=y_FAST%Lin%Modules(Module_BD)%Instance(k)%A, & + StateRotation=y_FAST%Lin%Modules(Module_BD)%Instance(k)%StateRotation) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + ! get the operating point + call BD_GetOP( t_global, BD%Input(1,k), BD%p(k), BD%x(k,STATE_CURR), BD%xd(k,STATE_CURR), BD%z(k,STATE_CURR), BD%OtherSt(k,STATE_CURR), & + BD%y(k), BD%m(k), ErrStat2, ErrMsg2, u_op=y_FAST%Lin%Modules(Module_BD)%Instance(k)%op_u, y_op=y_FAST%Lin%Modules(Module_BD)%Instance(k)%op_y, & + x_op=y_FAST%Lin%Modules(Module_BD)%Instance(k)%op_x, dx_op=y_FAST%Lin%Modules(Module_BD)%Instance(k)%op_dx ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) if (ErrStat >=AbortErrLev) then call cleanup() return end if - - if (p_FAST%LinOutJac) then - ! Jacobians - !dXdx: - call WrPartialMatrix( y_FAST%Lin%Modules(Module_ED)%Instance(1)%A, Un, p_FAST%OutFmt, 'dXdx' ) - - !dXdu: - call WrPartialMatrix( y_FAST%Lin%Modules(Module_ED)%Instance(1)%B, Un, p_FAST%OutFmt, 'dXdu', UseCol=y_FAST%Lin%Modules(Module_ED)%Instance(1)%use_u ) - - ! dYdx: - call WrPartialMatrix( y_FAST%Lin%Modules(Module_ED)%Instance(1)%C, Un, p_FAST%OutFmt, 'dYdx', UseRow=y_FAST%Lin%Modules(Module_ED)%Instance(1)%use_y ) - - !dYdu: - call WrPartialMatrix( y_FAST%Lin%Modules(Module_ED)%Instance(1)%D, Un, p_FAST%OutFmt, 'dYdu', UseRow=y_FAST%Lin%Modules(Module_ED)%Instance(1)%use_y, & - UseCol=y_FAST%Lin%Modules(Module_ED)%Instance(1)%use_u ) - - end if - - ! finish writing the file - call WrLinFile_txt_End(Un, p_FAST, y_FAST%Lin%Modules(Module_ED)%Instance(1) ) - - end if - - !..................... - ! BeamDyn - !..................... - if ( p_FAST%CompElast == Module_BD ) then - do k=1,p_FAST%nBeams - ! get the jacobians - call BD_JacobianPInput( t_global, BD%Input(1,k), BD%p(k), BD%x(k,STATE_CURR), BD%xd(k,STATE_CURR), BD%z(k,STATE_CURR), BD%OtherSt(k,STATE_CURR), & - BD%y(k), BD%m(k), ErrStat2, ErrMsg2, dYdu=y_FAST%Lin%Modules(Module_BD)%Instance(k)%D, & - dXdu=y_FAST%Lin%Modules(Module_BD)%Instance(k)%B, & - StateRel_x =y_FAST%Lin%Modules(Module_BD)%Instance(k)%StateRel_x, & - StateRel_xdot=y_FAST%Lin%Modules(Module_BD)%Instance(k)%StateRel_xdot ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - call BD_JacobianPContState( t_global, BD%Input(1,k), BD%p(k), BD%x(k,STATE_CURR), BD%xd(k,STATE_CURR), BD%z(k,STATE_CURR), BD%OtherSt(k,STATE_CURR), & - BD%y(k), BD%m(k), ErrStat2, ErrMsg2, dYdx=y_FAST%Lin%Modules(Module_BD)%Instance(k)%C, dXdx=y_FAST%Lin%Modules(Module_BD)%Instance(k)%A, & - StateRotation=y_FAST%Lin%Modules(Module_BD)%Instance(k)%StateRotation) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - ! get the operating point - call BD_GetOP( t_global, BD%Input(1,k), BD%p(k), BD%x(k,STATE_CURR), BD%xd(k,STATE_CURR), BD%z(k,STATE_CURR), BD%OtherSt(k,STATE_CURR), & - BD%y(k), BD%m(k), ErrStat2, ErrMsg2, u_op=y_FAST%Lin%Modules(Module_BD)%Instance(k)%op_u, y_op=y_FAST%Lin%Modules(Module_BD)%Instance(k)%op_y, & - x_op=y_FAST%Lin%Modules(Module_BD)%Instance(k)%op_x, dx_op=y_FAST%Lin%Modules(Module_BD)%Instance(k)%op_dx ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat >=AbortErrLev) then - call cleanup() - return - end if - - - ! write the module matrices: - if (p_FAST%LinOutMod) then - - OutFileName = trim(LinRootName)//'.'//TRIM(y_FAST%Module_Abrev(Module_BD))//TRIM(num2lstr(k)) - call WrLinFile_txt_Head(t_global, p_FAST, y_FAST, y_FAST%Lin%Modules(Module_BD)%Instance(k), OutFileName, Un, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat >=AbortErrLev) then - call cleanup() - return - end if - - if (p_FAST%LinOutJac) then - ! Jacobians - !dXdx: - call WrPartialMatrix( y_FAST%Lin%Modules(Module_BD)%Instance(k)%A, Un, p_FAST%OutFmt, 'dXdx' ) - - !dXdu: - call WrPartialMatrix( y_FAST%Lin%Modules(Module_BD)%Instance(k)%B, Un, p_FAST%OutFmt, 'dXdu', UseCol=y_FAST%Lin%Modules(Module_BD)%Instance(k)%use_u ) - - !dYdx: - call WrPartialMatrix( y_FAST%Lin%Modules(Module_BD)%Instance(k)%C, Un, p_FAST%OutFmt, 'dYdx', UseRow=y_FAST%Lin%Modules(Module_BD)%Instance(k)%use_y ) - - !dYdu: - call WrPartialMatrix( y_FAST%Lin%Modules(Module_BD)%Instance(k)%D, Un, p_FAST%OutFmt, 'dYdu', UseRow=y_FAST%Lin%Modules(Module_BD)%Instance(k)%use_y, & - UseCol=y_FAST%Lin%Modules(Module_BD)%Instance(k)%use_u ) - end if - - ! finish writing the file - call WrLinFile_txt_End(Un, p_FAST, y_FAST%Lin%Modules(Module_BD)%Instance(k) ) - end if - end do - end if !BeamDyn - + ! write the module matrices: + call WriteModuleLinearMatrices(Module_BD, k, t_global, p_FAST, y_FAST, LinRootName, ErrStat2, ErrMsg2) + if(Failed()) return; + + end do + end if !BeamDyn + !..................... ! InflowWind - !..................... - if ( p_FAST%CompInflow == Module_IfW ) then - - ! get the jacobians + !..................... + if ( p_FAST%CompInflow == Module_IfW ) then + ! get the jacobians call InflowWind_JacobianPInput( t_global, IfW%Input(1), IfW%p, IfW%x(STATE_CURR), IfW%xd(STATE_CURR), IfW%z(STATE_CURR), & IfW%OtherSt(STATE_CURR), IfW%y, IfW%m, ErrStat2, ErrMsg2, dYdu=y_FAST%Lin%Modules(Module_IfW)%Instance(1)%D ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - + if(Failed()) return; + ! get the operating point call InflowWind_GetOP( t_global, IfW%Input(1), IfW%p, IfW%x(STATE_CURR), IfW%xd(STATE_CURR), IfW%z(STATE_CURR), & IfW%OtherSt(STATE_CURR), IfW%y, IfW%m, ErrStat2, ErrMsg2, u_op=y_FAST%Lin%Modules(Module_IfW)%Instance(1)%op_u, & y_op=y_FAST%Lin%Modules(Module_IfW)%Instance(1)%op_y ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat >=AbortErrLev) then - call cleanup() - return - end if - - - ! write the module matrices: - if (p_FAST%LinOutMod) then - - OutFileName = trim(LinRootName)//'.'//TRIM(y_FAST%Module_Abrev(Module_IfW)) - call WrLinFile_txt_Head(t_global, p_FAST, y_FAST, y_FAST%Lin%Modules(Module_IfW)%Instance(1), OutFileName, Un, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat >=AbortErrLev) then - call cleanup() - return - end if - - if (p_FAST%LinOutJac) then - ! Jacobians - !dYdu: - call WrPartialMatrix( y_FAST%Lin%Modules(Module_IfW)%Instance(1)%D, Un, p_FAST%OutFmt, 'dYdu', & - UseRow=y_FAST%Lin%Modules(Module_IfW)%Instance(1)%use_y, UseCol=y_FAST%Lin%Modules(Module_IfW)%Instance(1)%use_u ) - end if - - ! finish writing the file - call WrLinFile_txt_End(Un, p_FAST, y_FAST%Lin%Modules(Module_IfW)%Instance(1) ) - - end if - + if(Failed()) return; + + ! write the module matrices: + call WriteModuleLinearMatrices(Module_IfW, 1, t_global, p_FAST, y_FAST, LinRootName, ErrStat2, ErrMsg2) + if(Failed()) return; end if - + + !..................... + ! SeaState + !..................... + if ( p_FAST%CompSeaSt == Module_SeaSt ) then + ! get the jacobians + call SeaSt_JacobianPInput( t_global, SeaSt%Input(1), SeaSt%p, SeaSt%x(STATE_CURR), SeaSt%xd(STATE_CURR), SeaSt%z(STATE_CURR), & + SeaSt%OtherSt(STATE_CURR), SeaSt%y, SeaSt%m, ErrStat2, ErrMsg2, dYdu=y_FAST%Lin%Modules(Module_SeaSt)%Instance(1)%D ) + if(Failed()) return; + + ! get the operating point + call SeaSt_GetOP( t_global, SeaSt%Input(1), SeaSt%p, SeaSt%x(STATE_CURR), SeaSt%xd(STATE_CURR), SeaSt%z(STATE_CURR), & + SeaSt%OtherSt(STATE_CURR), SeaSt%y, SeaSt%m, ErrStat2, ErrMsg2, u_op=y_FAST%Lin%Modules(Module_SeaSt)%Instance(1)%op_u, & + y_op=y_FAST%Lin%Modules(Module_SeaSt)%Instance(1)%op_y ) + if(Failed()) return; + + ! write the module matrices: + call WriteModuleLinearMatrices(Module_SeaSt, 1, t_global, p_FAST, y_FAST, LinRootName, ErrStat2, ErrMsg2) + if(Failed()) return; + end if + !..................... ! ServoDyn - !..................... - if ( p_FAST%CompServo == Module_SrvD ) then + !..................... + if ( p_FAST%CompServo == Module_SrvD ) then ! get the jacobians call SrvD_JacobianPInput( t_global, SrvD%Input(1), SrvD%p, SrvD%x(STATE_CURR), SrvD%xd(STATE_CURR), SrvD%z(STATE_CURR), & SrvD%OtherSt(STATE_CURR), SrvD%y, SrvD%m, ErrStat2, ErrMsg2, & dXdu=y_FAST%Lin%Modules(Module_SrvD)%Instance(1)%B, & dYdu=y_FAST%Lin%Modules(Module_SrvD)%Instance(1)%D ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - + call SrvD_JacobianPContState( t_global, SrvD%Input(1), SrvD%p, SrvD%x(STATE_CURR), SrvD%xd(STATE_CURR), SrvD%z(STATE_CURR), & SrvD%OtherSt(STATE_CURR), SrvD%y, SrvD%m, ErrStat2, ErrMsg2, & dYdx=y_FAST%Lin%Modules(Module_SrvD)%Instance(1)%C, & @@ -835,51 +735,28 @@ SUBROUTINE FAST_Linearize_OP(t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, call cleanup() return end if - - ! write the module matrices: - if (p_FAST%LinOutMod) then - - OutFileName = trim(LinRootName)//'.'//TRIM(y_FAST%Module_Abrev(Module_SrvD)) - call WrLinFile_txt_Head(t_global, p_FAST, y_FAST, y_FAST%Lin%Modules(Module_SrvD)%Instance(1), OutFileName, Un, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat >=AbortErrLev) then - call cleanup() - return - end if - - ! Jacobians - if (p_FAST%LinOutJac) then - ! Jacobians - call WrPartialMatrix(y_FAST%Lin%Modules(Module_SrvD)%Instance(1)%A, Un, p_FAST%OutFmt, 'dXdx') - call WrPartialMatrix(y_FAST%Lin%Modules(Module_SrvD)%Instance(1)%B, Un, p_FAST%OutFmt, 'dXdu', UseCol=y_FAST%Lin%Modules(Module_SrvD)%Instance(1)%use_u) - call WrPartialMatrix(y_FAST%Lin%Modules(Module_SrvD)%Instance(1)%C, Un, p_FAST%OutFmt, 'dYdx', UseRow=y_FAST%Lin%Modules(Module_SrvD)%Instance(1)%use_y) - call WrPartialMatrix(y_FAST%Lin%Modules(Module_SrvD)%Instance(1)%D, Un, p_FAST%OutFmt, 'dYdu', UseRow=y_FAST%Lin%Modules(Module_SrvD)%Instance(1)%use_y, & - UseCol=y_FAST%Lin%Modules(Module_SrvD)%Instance(1)%use_u) - end if - - ! finish writing the file - call WrLinFile_txt_End(Un, p_FAST, y_FAST%Lin%Modules(Module_SrvD)%Instance(1) ) - - end if + + call WriteModuleLinearMatrices(Module_SrvD, 1, t_global, p_FAST, y_FAST, LinRootName, ErrStat2, ErrMsg2) + if(Failed()) return; end if !..................... ! AeroDyn !..................... - if ( p_FAST%CompAero == Module_AD ) then + if ( p_FAST%CompAero == Module_AD ) then ! get the jacobians call AD_JacobianPInput( t_global, AD%Input(1), AD%p, AD%x(STATE_CURR), AD%xd(STATE_CURR), AD%z(STATE_CURR), & AD%OtherSt(STATE_CURR), AD%y, AD%m, ErrStat2, ErrMsg2, & dXdu=y_FAST%Lin%Modules(Module_AD)%Instance(1)%B, & dYdu=y_FAST%Lin%Modules(Module_AD)%Instance(1)%D ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if(Failed()) return; call AD_JacobianPContState( t_global, AD%Input(1), AD%p, AD%x(STATE_CURR), AD%xd(STATE_CURR), AD%z(STATE_CURR), & AD%OtherSt(STATE_CURR), AD%y, AD%m, ErrStat2, ErrMsg2, & dXdx=y_FAST%Lin%Modules(Module_AD)%Instance(1)%A, & dYdx=y_FAST%Lin%Modules(Module_AD)%Instance(1)%C ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - + if(Failed()) return; + ! get the operating point call AD_GetOP( t_global, AD%Input(1), AD%p, AD%x(STATE_CURR), AD%xd(STATE_CURR), AD%z(STATE_CURR), & AD%OtherSt(STATE_CURR), AD%y, AD%m, ErrStat2, ErrMsg2, & @@ -887,109 +764,41 @@ SUBROUTINE FAST_Linearize_OP(t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, y_op=y_FAST%Lin%Modules(Module_AD)%Instance(1)%op_y, & x_op=y_FAST%Lin%Modules(Module_AD)%Instance(1)%op_x, & dx_op=y_FAST%Lin%Modules(Module_AD)%Instance(1)%op_dx ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat >=AbortErrLev) then - call cleanup() - return - end if - - ! write the module matrices: - if (p_FAST%LinOutMod) then - - OutFileName = trim(LinRootName)//'.'//TRIM(y_FAST%Module_Abrev(Module_AD)) - call WrLinFile_txt_Head(t_global, p_FAST, y_FAST, y_FAST%Lin%Modules(Module_AD)%Instance(1), OutFileName, Un, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat >=AbortErrLev) then - call cleanup() - return - end if - - if (p_FAST%LinOutJac) then - ! Jacobians - call WrPartialMatrix( y_FAST%Lin%Modules(Module_AD)%Instance(1)%A, Un, p_FAST%OutFmt, 'dXdx' ) - - call WrPartialMatrix( y_FAST%Lin%Modules(Module_AD)%Instance(1)%B, Un, p_FAST%OutFmt, 'dXdu', & - UseCol=y_FAST%Lin%Modules(Module_AD)%Instance(1)%use_u ) - - call WrPartialMatrix( y_FAST%Lin%Modules(Module_AD)%Instance(1)%C, Un, p_FAST%OutFmt, 'dYdx', & - UseRow=y_FAST%Lin%Modules(Module_AD)%Instance(1)%use_y ) - - call WrPartialMatrix( y_FAST%Lin%Modules(Module_AD)%Instance(1)%D, Un, p_FAST%OutFmt, 'dYdu', & - UseRow=y_FAST%Lin%Modules(Module_AD)%Instance(1)%use_y, & - UseCol=y_FAST%Lin%Modules(Module_AD)%Instance(1)%use_u ) - end if - - ! finish writing the file - call WrLinFile_txt_End(Un, p_FAST, y_FAST%Lin%Modules(Module_AD)%Instance(1) ) - end if + if(Failed()) return; + ! write the module matrices: + call WriteModuleLinearMatrices(Module_AD, 1, t_global, p_FAST, y_FAST, LinRootName, ErrStat2, ErrMsg2) + if(Failed()) return; end if - - + !..................... ! HydroDyn !..................... - if ( p_FAST%CompHydro == Module_HD ) then - ! get the jacobians + if ( p_FAST%CompHydro == Module_HD ) then + ! get the jacobians call HD_JacobianPInput( t_global, HD%Input(1), HD%p, HD%x(STATE_CURR), HD%xd(STATE_CURR), HD%z(STATE_CURR), HD%OtherSt(STATE_CURR), & HD%y, HD%m, ErrStat2, ErrMsg2, dYdu=y_FAST%Lin%Modules(Module_HD)%Instance(1)%D, dXdu=y_FAST%Lin%Modules(Module_HD)%Instance(1)%B ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - + if(Failed()) return; + call HD_JacobianPContState( t_global, HD%Input(1), HD%p, HD%x(STATE_CURR), HD%xd(STATE_CURR), HD%z(STATE_CURR), HD%OtherSt(STATE_CURR), & HD%y, HD%m, ErrStat2, ErrMsg2, dYdx=y_FAST%Lin%Modules(Module_HD)%Instance(1)%C, dXdx=y_FAST%Lin%Modules(Module_HD)%Instance(1)%A ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - ! get the operating point + if(Failed()) return; + + ! get the operating point call HD_GetOP( t_global, HD%Input(1), HD%p, HD%x(STATE_CURR), HD%xd(STATE_CURR), HD%z(STATE_CURR), HD%OtherSt(STATE_CURR), & HD%y, HD%m, ErrStat2, ErrMsg2, u_op=y_FAST%Lin%Modules(Module_HD)%Instance(1)%op_u, y_op=y_FAST%Lin%Modules(Module_HD)%Instance(1)%op_y, & x_op=y_FAST%Lin%Modules(Module_HD)%Instance(1)%op_x, dx_op=y_FAST%Lin%Modules(Module_HD)%Instance(1)%op_dx ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat >=AbortErrLev) then - call cleanup() - return - end if - - - - ! write the module matrices: - if (p_FAST%LinOutMod) then - - OutFileName = trim(LinRootName)//'.'//TRIM(y_FAST%Module_Abrev(Module_HD)) - call WrLinFile_txt_Head(t_global, p_FAST, y_FAST, y_FAST%Lin%Modules(Module_HD)%Instance(1), OutFileName, Un, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat >=AbortErrLev) then - call cleanup() - return - end if - - if (p_FAST%LinOutJac) then - ! Jacobians - !dXdx: - call WrPartialMatrix( y_FAST%Lin%Modules(Module_HD)%Instance(1)%A, Un, p_FAST%OutFmt, 'dXdx' ) - - !dXdu: - call WrPartialMatrix( y_FAST%Lin%Modules(Module_HD)%Instance(1)%B, Un, p_FAST%OutFmt, 'dXdu', UseCol=y_FAST%Lin%Modules(Module_HD)%Instance(1)%use_u ) - - !dYdx: - call WrPartialMatrix( y_FAST%Lin%Modules(Module_HD)%Instance(1)%C, Un, p_FAST%OutFmt, 'dYdx', UseRow=y_FAST%Lin%Modules(Module_HD)%Instance(1)%use_y ) - - !dYdu: - call WrPartialMatrix( y_FAST%Lin%Modules(Module_HD)%Instance(1)%D, Un, p_FAST%OutFmt, 'dYdu', UseRow=y_FAST%Lin%Modules(Module_HD)%Instance(1)%use_y, & - UseCol=y_FAST%Lin%Modules(Module_HD)%Instance(1)%use_u ) - - end if - - ! finish writing the file - call WrLinFile_txt_End(Un, p_FAST, y_FAST%Lin%Modules(Module_HD)%Instance(1) ) - - end if + if(Failed()) return; + + ! write the module matrices: + call WriteModuleLinearMatrices(Module_HD, 1, t_global, p_FAST, y_FAST, LinRootName, ErrStat2, ErrMsg2) + if(Failed()) return; end if - + !..................... ! SubDyn / ExtPtfm !..................... - - if ( p_FAST%CompSub == Module_SD ) then + if ( p_FAST%CompSub == Module_SD ) then ! get the jacobians call SD_JacobianPInput( t_global, SD%Input(1), SD%p, SD%x(STATE_CURR), SD%xd(STATE_CURR), & SD%z(STATE_CURR), SD%OtherSt(STATE_CURR), SD%y, SD%m, ErrStat2, ErrMsg2, & @@ -1009,23 +818,10 @@ SUBROUTINE FAST_Linearize_OP(t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, if(Failed()) return; ! write the module matrices: - if (p_FAST%LinOutMod) then - OutFileName = trim(LinRootName)//'.'//TRIM(y_FAST%Module_Abrev(Module_SD)) - call WrLinFile_txt_Head(t_global, p_FAST, y_FAST, y_FAST%Lin%Modules(Module_SD)%Instance(1), OutFileName, Un, ErrStat2, ErrMsg2) - if(Failed()) return; - - if (p_FAST%LinOutJac) then - ! Jacobians - call WrPartialMatrix(y_FAST%Lin%Modules(Module_SD)%Instance(1)%A, Un, p_FAST%OutFmt, 'dXdx') - call WrPartialMatrix(y_FAST%Lin%Modules(Module_SD)%Instance(1)%B, Un, p_FAST%OutFmt, 'dXdu', UseCol=y_FAST%Lin%Modules(Module_SD)%Instance(1)%use_u) - call WrPartialMatrix(y_FAST%Lin%Modules(Module_SD)%Instance(1)%C, Un, p_FAST%OutFmt, 'dYdx', UseRow=y_FAST%Lin%Modules(Module_SD)%Instance(1)%use_y) - call WrPartialMatrix(y_FAST%Lin%Modules(Module_SD)%Instance(1)%D, Un, p_FAST%OutFmt, 'dYdu', UseRow=y_FAST%Lin%Modules(Module_SD)%Instance(1)%use_y, & - UseCol=y_FAST%Lin%Modules(Module_SD)%Instance(1)%use_u) - end if - ! finish writing the file - call WrLinFile_txt_End(Un, p_FAST, y_FAST%Lin%Modules(Module_SD)%Instance(1) ) - end if - elseif ( p_FAST%CompSub == Module_ExtPtfm ) then + call WriteModuleLinearMatrices(Module_SD, 1, t_global, p_FAST, y_FAST, LinRootName, ErrStat2, ErrMsg2) + if(Failed()) return; + + elseif ( p_FAST%CompSub == Module_ExtPtfm ) then ! get the jacobians call ExtPtfm_JacobianPInput( t_global, ExtPtfm%Input(1), ExtPtfm%p, ExtPtfm%x(STATE_CURR), ExtPtfm%xd(STATE_CURR), & ExtPtfm%z(STATE_CURR), ExtPtfm%OtherSt(STATE_CURR), ExtPtfm%y, ExtPtfm%m, ErrStat2, ErrMsg2, & @@ -1045,25 +841,12 @@ SUBROUTINE FAST_Linearize_OP(t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, if(Failed()) return; ! write the module matrices: - if (p_FAST%LinOutMod) then - OutFileName = trim(LinRootName)//'.'//TRIM(y_FAST%Module_Abrev(Module_ExtPtfm)) - call WrLinFile_txt_Head(t_global, p_FAST, y_FAST, y_FAST%Lin%Modules(Module_ExtPtfm)%Instance(1), OutFileName, Un, ErrStat2, ErrMsg2) - if(Failed()) return; - - if (p_FAST%LinOutJac) then - ! Jacobians - call WrPartialMatrix(y_FAST%Lin%Modules(Module_ExtPtfm)%Instance(1)%A, Un, p_FAST%OutFmt, 'dXdx') - call WrPartialMatrix(y_FAST%Lin%Modules(Module_ExtPtfm)%Instance(1)%B, Un, p_FAST%OutFmt, 'dXdu', UseCol=y_FAST%Lin%Modules(Module_ExtPtfm)%Instance(1)%use_u) - call WrPartialMatrix(y_FAST%Lin%Modules(Module_ExtPtfm)%Instance(1)%C, Un, p_FAST%OutFmt, 'dYdx', UseRow=y_FAST%Lin%Modules(Module_ExtPtfm)%Instance(1)%use_y) - call WrPartialMatrix(y_FAST%Lin%Modules(Module_ExtPtfm)%Instance(1)%D, Un, p_FAST%OutFmt, 'dYdu', UseRow=y_FAST%Lin%Modules(Module_ExtPtfm)%Instance(1)%use_y, & - UseCol=y_FAST%Lin%Modules(Module_ExtPtfm)%Instance(1)%use_u) - end if - ! finish writing the file - call WrLinFile_txt_End(Un, p_FAST, y_FAST%Lin%Modules(Module_ExtPtfm)%Instance(1) ) - end if + call WriteModuleLinearMatrices(Module_ExtPtfm, 1, t_global, p_FAST, y_FAST, LinRootName, ErrStat2, ErrMsg2) + if(Failed()) return; + end if ! SubDyn/ExtPtfm - - + + !..................... ! MAP !..................... @@ -1072,7 +855,7 @@ SUBROUTINE FAST_Linearize_OP(t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, call MAP_JacobianPInput( t_global, MAPp%Input(1), MAPp%p, MAPp%x(STATE_CURR), MAPp%xd(STATE_CURR), MAPp%z(STATE_CURR), & MAPp%OtherSt, MAPp%y, ErrStat2, ErrMsg2, y_FAST%Lin%Modules(Module_MAP)%Instance(1)%D ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - + ! get the operating point !LIN-TODO: template uses OtherSt(STATE_CURR), but the FAST MAP DATA has OtherSt as a scalar ! email bonnie for a discussion on this. @@ -1084,93 +867,50 @@ SUBROUTINE FAST_Linearize_OP(t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, call cleanup() return end if - + ! write the module matrices: - if (p_FAST%LinOutMod) then - - OutFileName = trim(LinRootName)//'.'//TRIM(y_FAST%Module_Abrev(Module_MAP)) - call WrLinFile_txt_Head(t_global, p_FAST, y_FAST, y_FAST%Lin%Modules(Module_MAP)%Instance(1), OutFileName, Un, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat >=AbortErrLev) then - call cleanup() - return - end if - - if (p_FAST%LinOutJac) then - ! Jacobians - !dYdu: - call WrPartialMatrix( y_FAST%Lin%Modules(Module_MAP)%Instance(1)%D, Un, p_FAST%OutFmt, 'dYdu', & - UseRow=y_FAST%Lin%Modules(Module_MAP)%Instance(1)%use_y, & - UseCol=y_FAST%Lin%Modules(Module_MAP)%Instance(1)%use_u ) - end if - - ! finish writing the file - call WrLinFile_txt_End(Un, p_FAST, y_FAST%Lin%Modules(Module_MAP)%Instance(1) ) - - end if ! if ( p_FAST%LinOutMod ) + call WriteModuleLinearMatrices(Module_MAP, 1, t_global, p_FAST, y_FAST, LinRootName, ErrStat2, ErrMsg2) + if(Failed()) return; end if ! if ( p_FAST%CompMooring == Module_MAP ) - - + + !..................... ! MoorDyn !..................... if ( p_FAST%CompMooring == Module_MD ) then - + call MD_JacobianPInput( t_global, MD%Input(1), MD%p, MD%x(STATE_CURR), MD%xd(STATE_CURR), MD%z(STATE_CURR), & MD%OtherSt(STATE_CURR), MD%y, MD%m, ErrStat2, ErrMsg2, & dXdu=y_FAST%Lin%Modules(Module_MD)%Instance(1)%B, & dYdu=y_FAST%Lin%Modules(Module_MD)%Instance(1)%D ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - + call MD_JacobianPContState( t_global, MD%Input(1), MD%p, MD%x(STATE_CURR), MD%xd(STATE_CURR), MD%z(STATE_CURR), MD%OtherSt(STATE_CURR), & MD%y, MD%m, ErrStat2, ErrMsg2, dYdx=y_FAST%Lin%Modules(Module_MD)%Instance(1)%C, & dXdx=y_FAST%Lin%Modules(Module_MD)%Instance(1)%A ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - + ! get the operating point call MD_GetOP( t_global, MD%Input(1), MD%p, MD%x(STATE_CURR), MD%xd(STATE_CURR), MD%z(STATE_CURR), & MD%OtherSt(STATE_CURR), MD%y, MD%m, ErrStat2, ErrMsg2, & u_op=y_FAST%Lin%Modules(Module_MD)%Instance(1)%op_u, & y_op=y_FAST%Lin%Modules(Module_MD)%Instance(1)%op_y, & x_op=y_FAST%Lin%Modules(Module_MD)%Instance(1)%op_x, & - dx_op=y_FAST%Lin%Modules(Module_MD)%Instance(1)%op_dx ) + dx_op=y_FAST%Lin%Modules(Module_MD)%Instance(1)%op_dx ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) if (ErrStat >=AbortErrLev) then call cleanup() return end if - + ! write the module matrices: - if (p_FAST%LinOutMod) then - - OutFileName = trim(LinRootName)//'.'//TRIM(y_FAST%Module_Abrev(Module_MD)) - call WrLinFile_txt_Head(t_global, p_FAST, y_FAST, y_FAST%Lin%Modules(Module_MD)%Instance(1), OutFileName, Un, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat >=AbortErrLev) then - call cleanup() - return - end if - - if (p_FAST%LinOutJac) then - ! Jacobians - ! dXdx, dXdu, dYdx, dYdu: - call WrPartialMatrix( y_FAST%Lin%Modules(Module_MD)%Instance(1)%A, Un, p_FAST%OutFmt, 'dXdx' ) - call WrPartialMatrix( y_FAST%Lin%Modules(Module_MD)%Instance(1)%B, Un, p_FAST%OutFmt, 'dXdu', UseCol=y_FAST%Lin%Modules(Module_MD)%Instance(1)%use_u ) - call WrPartialMatrix( y_FAST%Lin%Modules(Module_MD)%Instance(1)%C, Un, p_FAST%OutFmt, 'dYdx', UseRow=y_FAST%Lin%Modules(Module_MD)%Instance(1)%use_y ) - call WrPartialMatrix( y_FAST%Lin%Modules(Module_MD)%Instance(1)%D, Un, p_FAST%OutFmt, 'dYdu', UseRow=y_FAST%Lin%Modules(Module_MD)%Instance(1)%use_y, & - UseCol=y_FAST%Lin%Modules(Module_MD)%Instance(1)%use_u ) - end if - - ! finish writing the file - call WrLinFile_txt_End(Un, p_FAST, y_FAST%Lin%Modules(Module_MD)%Instance(1) ) - - end if ! if ( p_FAST%LinOutMod ) - end if ! if ( p_FAST%CompMooring == Module_MD ) - + call WriteModuleLinearMatrices(Module_MD, 1, t_global, p_FAST, y_FAST, LinRootName, ErrStat2, ErrMsg2) + if(Failed()) return; end if ! if ( p_FAST%CompMooring == Module_MD ) + !..................... ! Linearization of glue code Input/Output solve: !..................... - + !..................... ! Glue code (currently a linearization of SolveOption2): ! Make sure we avoid any case where the operating point values change earlier in this routine (e.g., by calling the module Jacobian routines). @@ -1182,33 +922,33 @@ SUBROUTINE FAST_Linearize_OP(t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, call cleanup() return end if - + ! get the dUdu and dUdy matrices, which linearize SolveOption2 for the modules we've included in linearization - call Glue_Jacobians( p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, OpFM, HD, SD, MAPp, FEAM, MD, Orca, & + call Glue_Jacobians( p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, ExtInfw, HD, SeaSt, SD, MAPp, FEAM, MD, Orca, & IceF, IceD, MeshMapData, dUdu, dUdy, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) if (ErrStat >=AbortErrLev) then call cleanup() return end if - - - - call WrLinFile_txt_Head(t_global, p_FAST, y_FAST, y_FAST%Lin%Glue, LinRootName, Un, ErrStat2, ErrMsg2 ) + + + + call WrLinFile_txt_Head(t_global, p_FAST, y_FAST, y_FAST%Lin%Glue, LinRootName, Un, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) if (ErrStat >=AbortErrLev) then call cleanup() return end if - - + + if (p_FAST%LinOutJac) then ! Jacobians call WrPartialMatrix( dUdu, Un, p_FAST%OutFmt, 'dUdu', UseRow=y_FAST%Lin%Glue%use_u, UseCol=y_FAST%Lin%Glue%use_u ) call WrPartialMatrix( dUdy, Un, p_FAST%OutFmt, 'dUdy', UseRow=y_FAST%Lin%Glue%use_u, UseCol=y_FAST%Lin%Glue%use_y ) end if - - + + ! calculate the glue-code state matrices call Glue_StateMatrices( p_FAST, y_FAST, dUdu, dUdy, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) @@ -1216,9 +956,9 @@ SUBROUTINE FAST_Linearize_OP(t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, call cleanup() return end if - + ! Write the results to the file: - call WrLinFile_txt_End(Un, p_FAST, y_FAST%Lin%Glue ) + call WrLinFile_txt_End(Un, p_FAST, y_FAST%Lin%Glue ) m_FAST%Lin%NextLinTimeIndx = m_FAST%Lin%NextLinTimeIndx + 1 @@ -1229,14 +969,14 @@ logical function Failed() if(Failed) call cleanup() end function Failed subroutine cleanup() - + if (allocated(dUdu)) deallocate(dUdu) if (allocated(dUdy)) deallocate(dUdy) - + if (Un > 0) close(Un) - + end subroutine cleanup -END SUBROUTINE FAST_Linearize_OP +END SUBROUTINE FAST_Linearize_OP !---------------------------------------------------------------------------------------------------------------------------------- !> Routine that writes the A,B,C,D matrices from linearization to a text file. SUBROUTINE WrLinFile_txt_Head(t_global, p_FAST, y_FAST, LinData, FileName, Un, ErrStat, ErrMsg) @@ -1322,6 +1062,8 @@ SUBROUTINE WrLinFile_txt_Head(t_global, p_FAST, y_FAST, LinData, FileName, Un, E WRITE(Un, '(A)') 'Simulation information:' fmt = '(3x,A,1x,'//trim(p_FAST%OutFmt_t)//',1x,A)' + !fmt = '(3x,A,1x,F10.4,1x,A)' + Desc = 'Simulation time:'; WRITE (Un, fmt) Desc, t_global, 's' Desc = 'Rotor Speed:'; WRITE (Un, fmt) Desc, y_FAST%Lin%RotSpeed, 'rad/s' Desc = 'Azimuth:'; WRITE (Un, fmt) Desc, y_FAST%Lin%Azimuth, 'rad' @@ -1349,10 +1091,10 @@ SUBROUTINE WrLinFile_txt_Head(t_global, p_FAST, y_FAST, LinData, FileName, Un, E !...................................................... if (n(Indx_x) > 0) then WRITE(Un, '(A)') 'Order of continuous states:' - call WrLinFile_txt_Table(p_FAST, Un, "Row/Column", LinData%op_x, LinData%names_x, rotFrame=LinData%RotFrame_x, derivOrder=LinData%DerivOrder_x ) + call WrLinFile_txt_Table(p_FAST, Un, "Row/Column", LinData%op_x, LinData%names_x, rotFrame=LinData%RotFrame_x, derivOrder=LinData%DerivOrder_x ) WRITE(Un, '(A)') 'Order of continuous state derivatives:' - call WrLinFile_txt_Table(p_FAST, Un, "Row/Column", LinData%op_dx, LinData%names_x, rotFrame=LinData%RotFrame_x, deriv=.true., derivOrder=LinData%DerivOrder_x ) + call WrLinFile_txt_Table(p_FAST, Un, "Row/Column", LinData%op_dx, LinData%names_x, rotFrame=LinData%RotFrame_x, deriv=.true., derivOrder=LinData%DerivOrder_x ) end if if (n(Indx_xd) > 0) then @@ -1443,6 +1185,8 @@ SUBROUTINE WrLinFile_txt_Table(p_FAST, Un, RowCol, op, names, rotFrame, deriv, d CHARACTER(100) :: Fmt CHARACTER(100) :: Fmt_Str CHARACTER(100) :: FmtOrient + CHARACTER(25) :: DerivStr + CHARACTER(25) :: DerivUnitStr @@ -1469,12 +1213,25 @@ SUBROUTINE WrLinFile_txt_Table(p_FAST, Un, RowCol, op, names, rotFrame, deriv, d i_print = 1 end if + if (UseDerivNames) then + if (p_FAST%CompAeroMaps .and. p_FAST%CompElast /= MODULE_BD) then ! this might not work if we are using some other (not BD, ED) module with states + DerivStr = 'Second time derivative of' + DerivUnitStr = '/s^2' + else + DerivStr = 'First time derivative of' + DerivUnitStr = '/s' + end if + else + DerivStr = '' + DerivUnitStr = '' + end if + do i=1,size(names) UseThisCol = .true. if (present(UseCol)) then UseThisCol = useCol(i) - end if + end if DerivOrdCol = 0 if (present(derivOrder)) DerivOrdCol = derivOrder(i) @@ -1492,12 +1249,12 @@ SUBROUTINE WrLinFile_txt_Table(p_FAST, Un, RowCol, op, names, rotFrame, deriv, d else if (UseThisCol) then if (UseDerivNames) then - WRITE(Un, Fmt) i_print, op(i_op), RotatingCol, DerivOrdCol, 'First time derivative of '//trim(names(i))//'/s' + WRITE(Un, Fmt) i_print, op(i_op), RotatingCol, DerivOrdCol, trim(DerivStr)//' '//trim(names(i))//trim(DerivUnitStr) else WRITE(Un, Fmt) i_print, op(i_op), RotatingCol, DerivOrdCol, trim(names(i)) - end if + end if i_print = i_print + 1 - end if + end if i_op = i_op + 1 end if @@ -1509,7 +1266,68 @@ SUBROUTINE WrLinFile_txt_Table(p_FAST, Un, RowCol, op, names, rotFrame, deriv, d END SUBROUTINE WrLinFile_txt_Table !---------------------------------------------------------------------------------------------------------------------------------- +SUBROUTINE WriteModuleLinearMatrices(ThisModule, ThisInstance, t_global, p_FAST, y_FAST, LinRootName, ErrStat, ErrMsg) + INTEGER(IntKi), INTENT(IN ) :: ThisModule !< Module index + INTEGER(IntKi), INTENT(IN ) :: ThisInstance !< Module instance index + + REAL(DbKi), INTENT(IN ) :: t_global !< current time step (written in file) + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code + TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Output variables for the glue code +! TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables + + CHARACTER(*), INTENT(IN ) :: LinRootName !< root name for linearization output files + + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + CHARACTER(1024) :: OutFileName + INTEGER(IntKi) :: Un ! unit number for linearization file + + ErrStat = ErrID_None + ErrMsg = "" + + ! write the module matrices: + if (p_FAST%LinOutMod) then + + OutFileName = trim(LinRootName)//'.'//TRIM(y_FAST%Module_Abrev(ThisModule)) + if (size(y_FAST%Lin%Modules(ThisModule)%Instance) > 1 .or. ThisModule==Module_BD) OutFileName = trim(OutFileName)//TRIM(num2lstr(ThisInstance)) + + call WrLinFile_txt_Head(t_global, p_FAST, y_FAST, y_FAST%Lin%Modules(ThisModule)%Instance(ThisInstance), OutFileName, Un, ErrStat, ErrMsg ) + if (ErrStat >=AbortErrLev) then + if (Un > 0) close(Un) + return + end if + + if (p_FAST%LinOutJac) then + ! Jacobians + !dXdx: + if (allocated(y_FAST%Lin%Modules(ThisModule)%Instance(ThisInstance)%A)) & + call WrPartialMatrix( y_FAST%Lin%Modules(ThisModule)%Instance(ThisInstance)%A, Un, p_FAST%OutFmt, 'dXdx' ) + + !dXdu: + if (allocated(y_FAST%Lin%Modules(ThisModule)%Instance(ThisInstance)%B)) & + call WrPartialMatrix( y_FAST%Lin%Modules(ThisModule)%Instance(ThisInstance)%B, Un, p_FAST%OutFmt, 'dXdu', & + UseCol=y_FAST%Lin%Modules(ThisModule)%Instance(ThisInstance)%use_u ) + + ! dYdx: + if (allocated(y_FAST%Lin%Modules(ThisModule)%Instance(ThisInstance)%C)) & + call WrPartialMatrix( y_FAST%Lin%Modules(ThisModule)%Instance(ThisInstance)%C, Un, p_FAST%OutFmt, 'dYdx', & + UseRow=y_FAST%Lin%Modules(ThisModule)%Instance(ThisInstance)%use_y ) + + !dYdu: + if (allocated(y_FAST%Lin%Modules(ThisModule)%Instance(ThisInstance)%D)) & + call WrPartialMatrix( y_FAST%Lin%Modules(ThisModule)%Instance(ThisInstance)%D, Un, p_FAST%OutFmt, 'dYdu', & + UseRow=y_FAST%Lin%Modules(ThisModule)%Instance(ThisInstance)%use_y, & + UseCol=y_FAST%Lin%Modules(ThisModule)%Instance(ThisInstance)%use_u ) + + end if + + ! finish writing the file + call WrLinFile_txt_End(Un, p_FAST, y_FAST%Lin%Modules(ThisModule)%Instance(ThisInstance) ) + + end if +END SUBROUTINE WriteModuleLinearMatrices +!---------------------------------------------------------------------------------------------------------------------------------- !> This routine returns the operating points for the entire glue code. SUBROUTINE Glue_GetOP(p_FAST, y_FAST, ErrStat, ErrMsg) @@ -1602,7 +1420,7 @@ END SUBROUTINE Glue_GetOP !---------------------------------------------------------------------------------------------------------------------------------- !> This routine forms the Jacobian for the glue-code input-output solves. -SUBROUTINE Glue_Jacobians( p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, OpFM, HD, SD, MAPp, FEAM, MD, Orca, & +SUBROUTINE Glue_Jacobians( p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, ExtInfw, HD, SeaSt, SD, MAPp, FEAM, MD, Orca, & IceF, IceD, MeshMapData, dUdu, dUdy, ErrStat, ErrMsg ) TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code @@ -1614,8 +1432,9 @@ SUBROUTINE Glue_Jacobians( p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, OpFM, TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data - TYPE(OpenFOAM_Data), INTENT(INOUT) :: OpFM !< OpenFOAM data + TYPE(ExternalInflow_Data),INTENT(INOUT) :: ExtInfw !< ExternalInflow data TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HydroDyn data + TYPE(SeaState_Data), INTENT(INOUT) :: SeaSt !< SeaState data TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SubDyn data TYPE(MAP_Data), INTENT(INOUT) :: MAPp !< MAP data TYPE(FEAMooring_Data), INTENT(INOUT) :: FEAM !< FEAMooring data @@ -1702,13 +1521,7 @@ SUBROUTINE Glue_Jacobians( p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, OpFM, end do - !............ - ! \f$ \frac{\partial U_\Lambda^{IfW}}{\partial u^{AD}} \end{bmatrix} = \f$ (dUdu block row 1=IfW) - !............ - IF (p_FAST%CompInflow == MODULE_IfW .and. p_FAST%CompAero == MODULE_AD) THEN - call Linear_IfW_InputSolve_du_AD( p_FAST, y_FAST, AD%Input(1), dUdu ) - end if ! we're using the InflowWind module - + !............ ! \f$ \frac{\partial U_\Lambda^{SrvD}}{\partial u^{SrvD}} \end{bmatrix} = \f$ (dUdu block row 2=SrvD) !............ @@ -1725,9 +1538,9 @@ SUBROUTINE Glue_Jacobians( p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, OpFM, ! \f$ \frac{\partial U_\Lambda^{ED}}{\partial u^{SD}} \end{bmatrix} = \f$ and ! \f$ \frac{\partial U_\Lambda^{ED}}{\partial u^{MAP}} \end{bmatrix} = \f$ (dUdu block row 3=ED) !............ - ! we need to do this for CompElast=ED and CompElast=BD + ! we need to do this for CompElast=ED and CompElast=BD - call Linear_ED_InputSolve_du( p_FAST, y_FAST, SrvD, ED%Input(1), ED%y, AD%y, AD%Input(1), BD, HD, SD, MAPp, MD, MeshMapData, dUdu, ErrStat2, ErrMsg2 ) + call Linear_ED_InputSolve_du( p_FAST, y_FAST, SrvD, ED%p, ED%Input(1), ED%y, AD%p, AD%Input(1), AD%y, BD, HD, SD, MAPp, MD, MeshMapData, dUdu, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) !............ @@ -1735,7 +1548,7 @@ SUBROUTINE Glue_Jacobians( p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, OpFM, ! \f$ \frac{\partial U_\Lambda^{BD}}{\partial u^{AD}} \end{bmatrix} = \f$ (dUdu block row 4=BD) !............ IF (p_FAST%CompElast == Module_BD) THEN - call Linear_BD_InputSolve_du( p_FAST, y_FAST, SrvD, ED%y, AD%y, AD%Input(1), BD, MeshMapData, dUdu, ErrStat2, ErrMsg2 ) + call Linear_BD_InputSolve_du( p_FAST, y_FAST, SrvD, ED%y, AD%p, AD%Input(1), AD%y, BD, MeshMapData, dUdu, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) END IF @@ -1743,9 +1556,9 @@ SUBROUTINE Glue_Jacobians( p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, OpFM, ! \f$ \frac{\partial U_\Lambda^{AD}}{\partial u^{AD}} \end{bmatrix} = \f$ (dUdu block row 5=AD) !............ IF (p_FAST%CompAero == MODULE_AD) THEN - call Linear_AD_InputSolve_du( p_FAST, y_FAST, AD%Input(1), ED%y, BD, MeshMapData, dUdu, ErrStat2, ErrMsg2 ) + call Linear_AD_InputSolve_du( p_FAST, y_FAST, AD%p, AD%Input(1), ED%y, BD, MeshMapData, dUdu, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - end if + END IF @@ -1755,7 +1568,7 @@ SUBROUTINE Glue_Jacobians( p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, OpFM, IF (p_FAST%CompHydro == MODULE_HD) THEN call Linear_HD_InputSolve_du( p_FAST, y_FAST, HD%Input(1), ED%y, SD%y, MeshMapData, dUdu, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - end if + END IF !............ ! \f$ \frac{\partial U_\Lambda^{SD}}{\partial u^{HD}} \end{bmatrix} = \f$ and @@ -1811,7 +1624,7 @@ SUBROUTINE Glue_Jacobians( p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, OpFM, ! \f$ \frac{\partial U_\Lambda^{SrvD}}{\partial y^{ED}} \end{bmatrix} = \f$ (dUdy block row 2=SrvD) !............ if (p_FAST%CompServo == MODULE_SrvD) then ! need to do this regardless of CompElast - call Linear_SrvD_InputSolve_dy( p_FAST, y_FAST, SrvD%p, SrvD%Input(1), ED%y, BD, SD%y, MeshMapData, dUdy, ErrStat2, ErrMsg2 ) + call Linear_SrvD_InputSolve_dy( p_FAST, y_FAST, SrvD%p, SrvD%Input(1), ED%p, ED%y, BD, SD%y, MeshMapData, dUdy, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) end if @@ -1826,7 +1639,7 @@ SUBROUTINE Glue_Jacobians( p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, OpFM, ! \f$ \frac{\partial U_\Lambda^{ED}}{\partial y^{MAP}} \end{bmatrix} = \f$ (dUdy block row 3=ED) !............ - call Linear_ED_InputSolve_dy( p_FAST, y_FAST, SrvD, ED%Input(1), ED%y, AD%y, AD%Input(1), BD, HD, SD, MAPp, MD, MeshMapData, dUdy, ErrStat2, ErrMsg2 ) + call Linear_ED_InputSolve_dy( p_FAST, y_FAST, SrvD, ED%p, ED%Input(1), ED%y, AD%p, AD%Input(1), AD%y, BD, HD, SD, MAPp, MD, MeshMapData, dUdy, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) !............ @@ -1835,7 +1648,7 @@ SUBROUTINE Glue_Jacobians( p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, OpFM, ! \f$ \frac{\partial U_\Lambda^{BD}}{\partial y^{AD}} \end{bmatrix} = \f$ (dUdy block row 4=BD) !............ if (p_FAST%CompElast == MODULE_BD) then - call Linear_BD_InputSolve_dy( p_FAST, y_FAST, SrvD, ED%Input(1), ED%y, AD%y, AD%Input(1), BD, MeshMapData, dUdy, ErrStat2, ErrMsg2 ) + call Linear_BD_InputSolve_dy( p_FAST, y_FAST, SrvD, ED%p, ED%Input(1), ED%y, AD%p, AD%Input(1), AD%y, BD, MeshMapData, dUdy, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) end if @@ -1847,10 +1660,10 @@ SUBROUTINE Glue_Jacobians( p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, OpFM, if (p_FAST%CompAero == MODULE_AD) then ! need to do this regardless of CompElast if (p_FAST%CompInflow == MODULE_IfW) then - call Linear_AD_InputSolve_IfW_dy( p_FAST, y_FAST, AD%Input(1), dUdy ) + call Linear_AD_InputSolve_IfW_dy( p_FAST, y_FAST, AD%p, AD%Input(1), dUdy ) end if - call Linear_AD_InputSolve_NoIfW_dy( p_FAST, y_FAST, AD%Input(1), ED%y, BD, MeshMapData, dUdy, ErrStat2, ErrMsg2 ) + call Linear_AD_InputSolve_NoIfW_dy( p_FAST, y_FAST, AD%p, AD%Input(1), ED%p, ED%y, BD, MeshMapData, dUdy, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) end if @@ -1860,19 +1673,27 @@ SUBROUTINE Glue_Jacobians( p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, OpFM, ! \f$ \frac{\partial U_\Lambda^{SD}}{\partial y^{ED}} \end{bmatrix} = \f$ ! \f$ \frac{\partial U_\Lambda^{SD}}{\partial y^{HD}} \end{bmatrix} = \f$ ! \f$ \frac{\partial U_\Lambda^{SD}}{\partial y^{SD}} \end{bmatrix} = \f$ - ! \f$ \frac{\partial U_\Lambda^{SD}}{\partial y^{MAP}} \end{bmatrix} = \f$ (dUdy block row 7=AD) + ! \f$ \frac{\partial U_\Lambda^{SD}}{\partial y^{MAP}} \end{bmatrix} = \f$ (dUdy block row 7=SD) !............ if (p_FAST%CompHydro == MODULE_HD) then - call Linear_HD_InputSolve_dy( p_FAST, y_FAST, HD%Input(1), ED%y, SD%y, MeshMapData, dUdy, ErrStat2, ErrMsg2 ) + call Linear_HD_InputSolve_dy( p_FAST, y_FAST, HD%Input(1), ED%p, ED%y, SD%y, MeshMapData, dUdy, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + if (p_FAST%CompSeaSt == MODULE_SeaSt) then + call Linear_HD_InputSolve_SeaSt_dy( p_FAST, y_FAST, SeaSt%p, HD%p, HD%Input(1), dUdy ) + end if + + if (p_FAST%CompInflow == MODULE_IfW .and. p_FAST%MHK /= MHK_None) then + call Linear_HD_InputSolve_IfW_dy( p_FAST, y_FAST, HD%p, HD%Input(1), dUdy ) + end if end if !LIN-TODO: Add doc strings and look at above doc string IF (p_FAST%CompSub == Module_SD) THEN - call Linear_SD_InputSolve_dy( p_FAST, y_FAST, SrvD, SD%Input(1), SD%y, ED%y, HD, MAPp, MD, MeshMapData, dUdy, ErrStat2, ErrMsg2 ) + call Linear_SD_InputSolve_dy( p_FAST, y_FAST, SrvD, SD%Input(1), SD%y, ED%p, ED%y, HD, MAPp, MD, MeshMapData, dUdy, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ELSE IF (p_FAST%CompSub == Module_ExtPtfm) THEN - write(*,*)'>>> FAST_LIN: Linear_ExtPtfm_InputSolve_dy, TODO' + CALL WrScr('>>> FAST_LIN: Linear_ExtPtfm_InputSolve_dy, TODO') ENDIF !............ @@ -1880,7 +1701,7 @@ SUBROUTINE Glue_Jacobians( p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, OpFM, ! \f$ \frac{\partial U_\Lambda^{MAP}}{\partial y^{SD}} \end{bmatrix} = \f$ (dUdy block row 8=MAP) !............ if (p_FAST%CompMooring == MODULE_MAP) then - call Linear_MAP_InputSolve_dy( p_FAST, y_FAST, MAPp%Input(1), ED%y, SD%y, MeshMapData, dUdy, ErrStat2, ErrMsg2 ) + call Linear_MAP_InputSolve_dy( p_FAST, y_FAST, MAPp%Input(1), ED%p, ED%y, SD%y, MeshMapData, dUdy, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) end if !............ @@ -1888,86 +1709,25 @@ SUBROUTINE Glue_Jacobians( p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, OpFM, ! \f$ \frac{\partial U_\Lambda^{MD}}{\partial y^{SD}} \end{bmatrix} = \f$ (dUdy block row 9=MD) <<<< !............ if (p_FAST%CompMooring == MODULE_MD) then - call Linear_MD_InputSolve_dy( p_FAST, y_FAST, MD%Input(1), ED%y, SD%y, MeshMapData, dUdy, ErrStat2, ErrMsg2 ) + call Linear_MD_InputSolve_dy( p_FAST, y_FAST, MD%Input(1), ED%p, ED%y, SD%y, MeshMapData, dUdy, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) end if END SUBROUTINE Glue_Jacobians - -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine forms the dU^{IfW}/du^{AD} block of dUdu. (i.e., how do changes in the AD inputs affect IfW inputs?) -SUBROUTINE Linear_IfW_InputSolve_du_AD( p_FAST, y_FAST, u_AD, dUdu ) - - TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< FAST parameter data - TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output data (for linearization) - TYPE(AD_InputType), INTENT(IN) :: u_AD !< The input meshes (already calculated) from AeroDyn - REAL(R8Ki), INTENT(INOUT) :: dUdu(:,:) !< Jacobian matrix of which we are computing the dU^(IfW)/du^(AD) block - - - INTEGER(IntKi) :: i, j, k ! loop counters - INTEGER(IntKi) :: i2, j2 ! loop counters - INTEGER(IntKi) :: AD_Start_Bl ! starting index of dUdu (column) where AD blade motion inputs are located - INTEGER(IntKi) :: Node ! InflowWind node number - - - ! compare with IfW_InputSolve(): - - Node = 0 !InflowWind node - if (p_FAST%CompServo == MODULE_SrvD) Node = Node + 1 - - IF (p_FAST%CompAero == MODULE_AD) THEN - - ! blades: - AD_Start_Bl = y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) & - + u_AD%rotors(1)%TowerMotion%NNodes * 9 & ! 3 fields (MASKID_TRANSLATIONDISP,MASKID_Orientation,MASKID_TRANSLATIONVel) with 3 components - + u_AD%rotors(1)%HubMotion%NNodes * 9 ! 3 fields (MASKID_TRANSLATIONDISP,MASKID_Orientation,MASKID_RotationVel) with 3 components - - do k = 1,size(u_AD%rotors(1)%BladeRootMotion) - AD_Start_Bl = AD_Start_Bl + u_AD%rotors(1)%BladeRootMotion(k)%NNodes * 3 ! 1 field (MASKID_Orientation) with 3 components - end do - ! next is u_AD%BladeMotion(k): - - DO K = 1,SIZE(u_AD%rotors(1)%BladeMotion) - DO J = 1,u_AD%rotors(1)%BladeMotion(k)%Nnodes - Node = Node + 1 ! InflowWind node - do i=1,3 !XYZ components of this node - i2 = y_FAST%Lin%Modules(MODULE_IfW)%Instance(1)%LinStartIndx(LIN_INPUT_COL) + (Node-1)*3 + i - 1 - j2 = AD_Start_Bl + (j-1)*3 + i - 1 - dUdu( i2, j2 ) = -1.0_R8Ki - end do - END DO !J = 1,p%BldNodes ! Loop through the blade nodes / elements - - ! get starting AD index of BladeMotion for next blade - AD_Start_Bl = AD_Start_Bl + u_AD%rotors(1)%BladeMotion(k)%Nnodes * 9 ! 3 fields (MASKID_TRANSLATIONDISP,MASKID_Orientation,MASKID_TRANSLATIONVel) with 3 components - END DO !K = 1,p%NumBl - - ! tower: - DO J=1,u_AD%rotors(1)%TowerMotion%nnodes - Node = Node + 1 - do i=1,3 !XYZ components of this node - i2 = y_FAST%Lin%Modules(MODULE_IfW)%Instance(1)%LinStartIndx(LIN_INPUT_COL) + (Node-1)*3 + i - 1 - j2 = y_FAST%Lin%Modules(MODULE_AD )%Instance(1)%LinStartIndx(LIN_INPUT_COL) + (j-1)*3 + i - 1 - dUdu( i2, j2 ) = -1.0_R8Ki - end do - END DO - - ! HubPosition and HubOrientation from ElastoDyn are missing from this - END IF -END SUBROUTINE Linear_IfW_InputSolve_du_AD - - !---------------------------------------------------------------------------------------------------------------------------------- !> This routine forms the dU^{ED}/du^{BD} and dU^{ED}/du^{AD} blocks (ED row) of dUdu. (i.e., how do changes in the AD and BD inputs affect the ED inputs?) -SUBROUTINE Linear_ED_InputSolve_du( p_FAST, y_FAST, SrvD, u_ED, y_ED, y_AD, u_AD, BD, HD, SD, MAPp, MD, MeshMapData, dUdu, ErrStat, ErrMsg ) +SUBROUTINE Linear_ED_InputSolve_du( p_FAST, y_FAST, SrvD, p_ED, u_ED, y_ED, p_AD, u_AD, y_AD, BD, HD, SD, MAPp, MD, MeshMapData, dUdu, ErrStat, ErrMsg ) TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Glue-code simulation parameters TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< Glue-code output parameters (for linearization) type(ServoDyn_Data), intent(in ) :: SrvD !< SrvD parameters + TYPE(ED_ParameterType), intent(in ) :: p_ED !< ED Inputs at t TYPE(ED_InputType), INTENT(INOUT) :: u_ED !< ED Inputs at t TYPE(ED_OutputType), INTENT(IN ) :: y_ED !< ElastoDyn outputs (need translation displacement on meshes for loads mapping) - TYPE(AD_OutputType), INTENT(IN ) :: y_AD !< AeroDyn outputs + TYPE(AD_ParameterType), INTENT(IN ) :: p_AD !< AD parameters (for AD-ED load linerization) TYPE(AD_InputType), INTENT(INOUT) :: u_AD !< AD inputs (for AD-ED load linerization) + TYPE(AD_OutputType), INTENT(IN ) :: y_AD !< AeroDyn outputs TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BD data at t TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HD data at t TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SD data at t @@ -1983,7 +1743,7 @@ SUBROUTINE Linear_ED_InputSolve_du( p_FAST, y_FAST, SrvD, u_ED, y_ED, y_AD, u_AD INTEGER(IntKi) :: K ! Loops through blades INTEGER(IntKi) :: SrvD_Start ! starting index of dUdu (column) where SrvD StC load is INTEGER(IntKi) :: BD_Start ! starting index of dUdu (column) where BD root motion inputs are located - INTEGER(IntKi) :: AD_Start_Bl ! starting index of dUdu (column) where AD blade motion inputs are located + INTEGER(IntKi) :: AD_Start ! starting index of dUdu (column) where AD motion inputs are located INTEGER(IntKi) :: ED_Start_mt ! starting index of dUdu (row) where ED blade/tower or hub moment inputs are located INTEGER(IntKi) :: HD_Start ! starting index of dUdu (column) where HD motion inputs are located INTEGER(IntKi) :: SD_Start ! starting index of dUdu (column) where SD TP motion inputs are located @@ -2036,7 +1796,7 @@ SUBROUTINE Linear_ED_InputSolve_du( p_FAST, y_FAST, SrvD, u_ED, y_ED, y_AD, u_AD call Linearize_Point_to_Point( SrvD%y%NStCLoadMesh(j), u_ED%NacelleLoads, MeshMapData%NStC_P_2_ED_P_N(j), ErrStat2, ErrMsg2, SrvD%Input(1)%NStCMotionMesh(j), y_ED%NacelleMotion ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - ED_Start_mt = Indx_u_ED_Nacelle_Start(u_ED, y_FAST) & + ED_Start_mt = Indx_u_ED_Nacelle_Start(p_ED, u_ED, y_FAST) & + u_ED%NacelleLoads%NNodes * 3 ! 3 forces at the nacelle (so we start at the moments) SrvD_Start = y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) - 1 + SrvD%p%Jac_Idx_NStC_u(1,j) ! SrvD is source in the mapping, so we want M_{uSm} (moments) @@ -2054,7 +1814,7 @@ SUBROUTINE Linear_ED_InputSolve_du( p_FAST, y_FAST, SrvD, u_ED, y_ED, y_AD, u_AD call Linearize_Point_to_Point( SrvD%y%TStCLoadMesh(j), u_ED%TowerPtLoads, MeshMapData%TStC_P_2_ED_P_T(j), ErrStat2, ErrMsg2, SrvD%Input(1)%TStCMotionMesh(j), y_ED%TowerLn2Mesh ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - ED_Start_mt = Indx_u_ED_Tower_Start(u_ED, y_FAST) & + ED_Start_mt = Indx_u_ED_Tower_Start(p_ED, u_ED, y_FAST) & + u_ED%TowerPtLoads%NNodes * 3 ! 3 forces at the nacelle (so we start at the moments) SrvD_Start = y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) - 1 + SrvD%p%Jac_Idx_TStC_u(1,j) ! SrvD is source in the mapping, so we want M_{uSm} (moments) @@ -2070,15 +1830,15 @@ SUBROUTINE Linear_ED_InputSolve_du( p_FAST, y_FAST, SrvD, u_ED, y_ED, y_AD, u_AD if ( allocated(SrvD%y%SStCLoadMesh) ) then do j=1,size(SrvD%y%SStCLoadMesh) if (SrvD%y%SStCLoadMesh(j)%Committed) then - call Linearize_Point_to_Point( SrvD%y%SStCLoadMesh(j), u_ED%PlatformPtMesh, MeshMapData%SStC_P_P_2_ED_P(j), ErrStat2, ErrMsg2, SrvD%Input(1)%SStCMotionMesh(j), y_ED%PlatformPtMesh ) + call Linearize_Point_to_Point( SrvD%y%SStCLoadMesh(j), u_ED%PlatformPtMesh, MeshMapData%SStC_P_P_2_SubStructure(j), ErrStat2, ErrMsg2, SrvD%Input(1)%SStCMotionMesh(j), y_ED%PlatformPtMesh ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - ED_Start_mt = Indx_u_ED_Platform_Start(u_ED, y_FAST) & + ED_Start_mt = Indx_u_ED_Platform_Start(p_ED, u_ED, y_FAST) & + u_ED%PlatformPtMesh%NNodes * 3 ! 3 forces at the nacelle (so we start at the moments) SrvD_Start = y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) - 1 + SrvD%p%Jac_Idx_SStC_u(1,j) ! SrvD is source in the mapping, so we want M_{uSm} (moments) - if (allocated(MeshMapData%SStC_P_P_2_ED_P(j)%dM%m_us )) then - call SetBlockMatrix( dUdu, MeshMapData%SStC_P_P_2_ED_P(j)%dM%m_us, ED_Start_mt, SrvD_Start ) + if (allocated(MeshMapData%SStC_P_P_2_SubStructure(j)%dM%m_us )) then + call SetBlockMatrix( dUdu, MeshMapData%SStC_P_P_2_SubStructure(j)%dM%m_us, ED_Start_mt, SrvD_Start ) endif endif enddo @@ -2099,14 +1859,14 @@ SUBROUTINE Linear_ED_InputSolve_du( p_FAST, y_FAST, SrvD, u_ED, y_ED, y_AD, u_AD DO K = 1,SIZE(u_ED%BladePtLoads,1) ! Loop through all blades (p_ED%NumBl) ED_Start_mt = ED_Start_mt + u_ED%BladePtLoads(k)%NNodes*3 ! skip the forces on this blade - AD_Start_Bl = Indx_u_AD_Blade_Start(u_AD, y_FAST, k) + AD_Start = Indx_u_AD_Blade_Start(p_AD, u_AD, y_FAST, k) CALL Linearize_Line2_to_Point( y_AD%rotors(1)%BladeLoad(k), u_ED%BladePtLoads(k), MeshMapData%AD_L_2_BDED_B(k), ErrStat2, ErrMsg2, u_AD%rotors(1)%BladeMotion(k), y_ED%BladeLn2Mesh(k) ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ! AD is source in the mapping, so we want M_{uSm} if (allocated(MeshMapData%AD_L_2_BDED_B(k)%dM%m_us )) then - call SetBlockMatrix( dUdu, MeshMapData%AD_L_2_BDED_B(k)%dM%m_us, ED_Start_mt, AD_Start_Bl ) + call SetBlockMatrix( dUdu, MeshMapData%AD_L_2_BDED_B(k)%dM%m_us, ED_Start_mt, AD_Start ) end if ! get starting index of next blade @@ -2117,17 +1877,58 @@ SUBROUTINE Linear_ED_InputSolve_du( p_FAST, y_FAST, SrvD, u_ED, y_ED, y_AD, u_AD END IF ! ED inputs on tower from AD: - IF ( y_AD%rotors(1)%TowerLoad%Committed ) THEN - ED_Start_mt = Indx_u_ED_Tower_Start(u_ED, y_FAST) & - + u_ED%TowerPtLoads%NNodes * 3 ! 3 forces at each node (we're going to start at the moments) + ED_Start_mt = Indx_u_ED_Tower_Start(p_ED, u_ED, y_FAST) + u_ED%TowerPtLoads%NNodes * 3 ! skip 3 forces at each node + AD_Start = Indx_u_AD_Tower_Start(p_AD, u_AD, y_FAST) CALL Linearize_Line2_to_Point( y_AD%rotors(1)%TowerLoad, u_ED%TowerPtLoads, MeshMapData%AD_L_2_ED_P_T, ErrStat2, ErrMsg2, u_AD%rotors(1)%TowerMotion, y_ED%TowerLn2Mesh ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ! AD is source in the mapping, so we want M_{uSm} if (allocated(MeshMapData%AD_L_2_ED_P_T%dM%m_us )) then - call SetBlockMatrix( dUdu, MeshMapData%AD_L_2_ED_P_T%dM%m_us, ED_Start_mt, y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) ) + call SetBlockMatrix( dUdu, MeshMapData%AD_L_2_ED_P_T%dM%m_us, ED_Start_mt, AD_Start ) + end if + END IF + + ! ED inputs on Hub from AD: + IF ( y_AD%rotors(1)%HubLoad%Committed ) THEN + ED_Start_mt = Indx_u_ED_Hub_Start(p_ED, u_ED, y_FAST) + u_ED%HubPtLoad%NNodes * 3 ! skip 3 forces at each node + AD_Start = Indx_u_AD_Hub_Start(p_AD, u_AD, y_FAST) + + CALL Linearize_Point_to_Point( y_AD%rotors(1)%HubLoad, u_ED%HubPtLoad, MeshMapData%AD_P_2_ED_P_H, ErrStat2, ErrMsg2, u_AD%rotors(1)%HubMotion, y_ED%HubPtMotion ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + ! AD is source in the mapping, so we want M_{uSm} + if (allocated(MeshMapData%AD_P_2_ED_P_H%dM%m_us )) then + call SetBlockMatrix( dUdu, MeshMapData%AD_P_2_ED_P_H%dM%m_us, ED_Start_mt, AD_Start ) + end if + END IF + + ! ED inputs on Nacelle from AD: + IF ( y_AD%rotors(1)%NacelleLoad%Committed ) THEN + ED_Start_mt = Indx_u_ED_Nacelle_Start(p_ED, u_ED, y_FAST) + u_ED%NacelleLoads%NNodes * 3 ! skip 3 forces at each node + AD_Start = Indx_u_AD_Nacelle_Start(p_AD, u_AD, y_FAST) + + CALL Linearize_Point_to_Point( y_AD%rotors(1)%NacelleLoad, u_ED%NacelleLoads, MeshMapData%AD_P_2_ED_P_N, ErrStat2, ErrMsg2, u_AD%rotors(1)%NacelleMotion, y_ED%NacelleMotion ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + ! AD is source in the mapping, so we want M_{uSm} + if (allocated(MeshMapData%AD_P_2_ED_P_N%dM%m_us )) then + call SetBlockMatrix( dUdu, MeshMapData%AD_P_2_ED_P_N%dM%m_us, ED_Start_mt, AD_Start ) + end if + END IF + + ! ED inputs on Tailfin from AD: + IF ( y_AD%rotors(1)%TFinLoad%Committed ) THEN + ED_Start_mt = Indx_u_ED_TFin_Start(p_ED, u_ED, y_FAST) + u_ED%TFinCMLoads%NNodes * 3 ! skip 3 forces at each node + AD_Start = Indx_u_AD_TFin_Start(p_AD, u_AD, y_FAST) + + CALL Linearize_Point_to_Point( y_AD%rotors(1)%TFinLoad, u_ED%TFinCMLoads, MeshMapData%AD_P_2_ED_P_TF, ErrStat2, ErrMsg2, u_AD%rotors(1)%TFinMotion, y_ED%TFinCMMotion ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + ! AD is source in the mapping, so we want M_{uSm} + if (allocated(MeshMapData%AD_L_2_ED_P_T%dM%m_us )) then + call SetBlockMatrix( dUdu, MeshMapData%AD_P_2_ED_P_TF%dM%m_us, ED_Start_mt, AD_Start ) end if END IF @@ -2139,7 +1940,7 @@ SUBROUTINE Linear_ED_InputSolve_du( p_FAST, y_FAST, SrvD, u_ED, y_ED, y_AD, u_AD !.......... IF ( p_FAST%CompElast == Module_BD ) THEN ! see routine U_ED_SD_HD_BD_Orca_Residual() in SolveOption1 - ED_Start_mt = Indx_u_ED_Hub_Start(u_ED, y_FAST) & + ED_Start_mt = Indx_u_ED_Hub_Start(p_ED, u_ED, y_FAST) & + u_ED%HubPtLoad%NNodes * 3 ! 3 forces at the hub (so we start at the moments) ! Transfer BD loads to ED hub input: @@ -2159,7 +1960,7 @@ SUBROUTINE Linear_ED_InputSolve_du( p_FAST, y_FAST, SrvD, u_ED, y_ED, y_AD, u_AD END IF - ED_Start_mt = Indx_u_ED_Platform_Start(u_ED, y_FAST) & + ED_Start_mt = Indx_u_ED_Platform_Start(p_ED, u_ED, y_FAST) & + u_ED%PlatformPtMesh%NNodes * 3 ! 3 forces at each node (we're going to start at the moments) if ( p_FAST%CompSub == Module_SD ) then @@ -2193,12 +1994,12 @@ SUBROUTINE Linear_ED_InputSolve_du( p_FAST, y_FAST, SrvD, u_ED, y_ED, y_AD, u_AD ! we're mapping loads, so we also need the sibling meshes' displacements: HD_Start = Indx_u_HD_Morison_Start(HD%Input(1), y_FAST) - call Linearize_Point_to_Point( HD%y%Morison%Mesh, u_ED%PlatformPtMesh, MeshMapData%HD_M_P_2_ED_P, ErrStat2, ErrMsg2, HD%Input(1)%Morison%Mesh, y_ED%PlatformPtMesh) !HD%Input(1)%Morison and y_ED%PlatformPtMesh contain the displaced positions for load calculations + call Linearize_Point_to_Point( HD%y%Morison%Mesh, u_ED%PlatformPtMesh, MeshMapData%HD_M_P_2_SubStructure, ErrStat2, ErrMsg2, HD%Input(1)%Morison%Mesh, y_ED%PlatformPtMesh) !HD%Input(1)%Morison and y_ED%PlatformPtMesh contain the displaced positions for load calculations call SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) ! HD is source in the mapping, so we want M_{uSm} - if (allocated(MeshMapData%HD_M_P_2_ED_P%dM%m_us )) then - call SetBlockMatrix( dUdu, MeshMapData%HD_M_P_2_ED_P%dM%m_us, ED_Start_mt, HD_Start ) + if (allocated(MeshMapData%HD_M_P_2_SubStructure%dM%m_us )) then + call SetBlockMatrix( dUdu, MeshMapData%HD_M_P_2_SubStructure%dM%m_us, ED_Start_mt, HD_Start ) end if end if @@ -2208,12 +2009,12 @@ SUBROUTINE Linear_ED_InputSolve_du( p_FAST, y_FAST, SrvD, u_ED, y_ED, y_AD, u_AD ! we're mapping loads, so we also need the sibling meshes' displacements: HD_Start = Indx_u_HD_WAMIT_Start(HD%Input(1), y_FAST) - call Linearize_Point_to_Point( HD%y%WAMITMesh, u_ED%PlatformPtMesh, MeshMapData%HD_W_P_2_ED_P, ErrStat2, ErrMsg2, HD%Input(1)%WAMITMesh, y_ED%PlatformPtMesh) !HD%Input(1)%WAMITMesh and y_ED%PlatformPtMesh contain the displaced positions for load calculations + call Linearize_Point_to_Point( HD%y%WAMITMesh, u_ED%PlatformPtMesh, MeshMapData%HD_W_P_2_SubStructure, ErrStat2, ErrMsg2, HD%Input(1)%WAMITMesh, y_ED%PlatformPtMesh) !HD%Input(1)%WAMITMesh and y_ED%PlatformPtMesh contain the displaced positions for load calculations call SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) ! HD is source in the mapping, so we want M_{uSm} - if (allocated(MeshMapData%HD_W_P_2_ED_P%dM%m_us )) then - call SetBlockMatrix( dUdu, MeshMapData%HD_W_P_2_ED_P%dM%m_us, ED_Start_mt, HD_Start ) + if (allocated(MeshMapData%HD_W_P_2_SubStructure%dM%m_us )) then + call SetBlockMatrix( dUdu, MeshMapData%HD_W_P_2_SubStructure%dM%m_us, ED_Start_mt, HD_Start ) end if end if @@ -2225,7 +2026,7 @@ SUBROUTINE Linear_ED_InputSolve_du( p_FAST, y_FAST, SrvD, u_ED, y_ED, y_AD, u_AD if ( p_FAST%CompMooring == Module_MAP ) then - ED_Start_mt = Indx_u_ED_Platform_Start(u_ED, y_FAST) & + ED_Start_mt = Indx_u_ED_Platform_Start(p_ED, u_ED, y_FAST) & + u_ED%PlatformPtMesh%NNodes * 3 ! 3 forces at each node (we're going to start at the moments) ! Transfer MAP loads to ED PlatformPtmesh input: @@ -2235,12 +2036,12 @@ SUBROUTINE Linear_ED_InputSolve_du( p_FAST, y_FAST, SrvD, u_ED, y_ED, y_AD, u_AD ! NOTE: Assumes at least one MAP Fairlead point - CALL Linearize_Point_to_Point( MAPp%y%ptFairleadLoad, u_ED%PlatformPtMesh, MeshMapData%Mooring_P_2_ED_P, ErrStat2, ErrMsg2, MAPp%Input(1)%PtFairDisplacement, y_ED%PlatformPtMesh) !MAPp%Input(1)%ptFairleadLoad and y_ED%PlatformPtMesh contain the displaced positions for load calculations + CALL Linearize_Point_to_Point( MAPp%y%ptFairleadLoad, u_ED%PlatformPtMesh, MeshMapData%Mooring_2_Structure, ErrStat2, ErrMsg2, MAPp%Input(1)%PtFairDisplacement, y_ED%PlatformPtMesh) !MAPp%Input(1)%ptFairleadLoad and y_ED%PlatformPtMesh contain the displaced positions for load calculations CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) - ! HD is source in the mapping, so we want M_{uSm} - if (allocated(MeshMapData%Mooring_P_2_ED_P%dM%m_us )) then - call SetBlockMatrix( dUdu, MeshMapData%Mooring_P_2_ED_P%dM%m_us, ED_Start_mt, MAP_Start ) + ! MAP is source in the mapping, so we want M_{uSm} + if (allocated(MeshMapData%Mooring_2_Structure%dM%m_us )) then + call SetBlockMatrix( dUdu, MeshMapData%Mooring_2_Structure%dM%m_us, ED_Start_mt, MAP_Start ) end if !.......... @@ -2248,7 +2049,7 @@ SUBROUTINE Linear_ED_InputSolve_du( p_FAST, y_FAST, SrvD, u_ED, y_ED, y_AD, u_AD !.......... else if ( p_FAST%CompMooring == Module_MD ) then - ED_Start_mt = Indx_u_ED_Platform_Start(u_ED, y_FAST) & + ED_Start_mt = Indx_u_ED_Platform_Start(p_ED, u_ED, y_FAST) & + u_ED%PlatformPtMesh%NNodes * 3 ! 3 forces at each node (we're going to start at the moments) ! Transfer MD loads to ED PlatformPtmesh input: @@ -2258,12 +2059,12 @@ SUBROUTINE Linear_ED_InputSolve_du( p_FAST, y_FAST, SrvD, u_ED, y_ED, y_AD, u_AD ! NOTE: Assumes at least one coupled MD object - CALL Linearize_Point_to_Point( MD%y%CoupledLoads(1), u_ED%PlatformPtMesh, MeshMapData%Mooring_P_2_ED_P, ErrStat2, ErrMsg2, MD%Input(1)%CoupledKinematics(1), y_ED%PlatformPtMesh) + CALL Linearize_Point_to_Point( MD%y%CoupledLoads(1), u_ED%PlatformPtMesh, MeshMapData%Mooring_2_Structure, ErrStat2, ErrMsg2, MD%Input(1)%CoupledKinematics(1), y_ED%PlatformPtMesh) CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) ! HD is source in the mapping, so we want M_{uSm} - if (allocated(MeshMapData%Mooring_P_2_ED_P%dM%m_us )) then - call SetBlockMatrix( dUdu, MeshMapData%Mooring_P_2_ED_P%dM%m_us, ED_Start_mt, MD_Start ) + if (allocated(MeshMapData%Mooring_2_Structure%dM%m_us )) then + call SetBlockMatrix( dUdu, MeshMapData%Mooring_2_Structure%dM%m_us, ED_Start_mt, MD_Start ) end if end if @@ -2320,13 +2121,13 @@ SUBROUTINE Linear_SD_InputSolve_du( p_FAST, y_FAST, SrvD, u_SD, y_SD, y_ED, HD, + u_SD%LMesh%NNodes * 3 ! 3 forces at each node (we're going to start at the moments) do j=1,size(SrvD%y%SStCLoadMesh) if (SrvD%y%SStCLoadMesh(j)%Committed) then - call Linearize_Point_to_Point( SrvD%y%SStCLoadMesh(j), u_SD%LMesh, MeshMapData%SStC_P_P_2_SD_P(j), ErrStat2, ErrMsg2, SrvD%Input(1)%SStCMotionMesh(j), y_SD%Y3Mesh ) + call Linearize_Point_to_Point( SrvD%y%SStCLoadMesh(j), u_SD%LMesh, MeshMapData%SStC_P_P_2_SubStructure(j), ErrStat2, ErrMsg2, SrvD%Input(1)%SStCMotionMesh(j), y_SD%Y3Mesh ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) SrvD_Start = y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) - 1 + SrvD%p%Jac_Idx_SStC_u(1,j) ! SrvD is source in the mapping, so we want M_{uSm} (moments) - if (allocated(MeshMapData%SStC_P_P_2_SD_P(j)%dM%m_us )) then - call SetBlockMatrix( dUdu, MeshMapData%SStC_P_P_2_SD_P(j)%dM%m_us, SD_Start, SrvD_Start ) + if (allocated(MeshMapData%SStC_P_P_2_SubStructure(j)%dM%m_us )) then + call SetBlockMatrix( dUdu, MeshMapData%SStC_P_P_2_SubStructure(j)%dM%m_us, SD_Start, SrvD_Start ) endif endif enddo @@ -2378,12 +2179,12 @@ SUBROUTINE Linear_SD_InputSolve_du( p_FAST, y_FAST, SrvD, u_SD, y_SD, y_ED, HD, ! we're mapping loads, so we also need the sibling meshes' displacements: HD_Start = Indx_u_HD_Morison_Start(HD%Input(1), y_FAST) - call Linearize_Point_to_Point( HD%y%Morison%Mesh, u_SD%LMesh, MeshMapData%HD_M_P_2_SD_P, ErrStat2, ErrMsg2, HD%Input(1)%Morison%Mesh, y_SD%Y2Mesh) !HD%Input(1)%Mesh and y_ED%PlatformPtMesh contain the displaced positions for load calculations + call Linearize_Point_to_Point( HD%y%Morison%Mesh, u_SD%LMesh, MeshMapData%HD_M_P_2_SubStructure, ErrStat2, ErrMsg2, HD%Input(1)%Morison%Mesh, y_SD%Y2Mesh) !HD%Input(1)%Mesh and y_ED%PlatformPtMesh contain the displaced positions for load calculations call SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) ! HD is source in the mapping, so we want M_{uSm} - if (allocated(MeshMapData%HD_M_P_2_SD_P%dM%m_us )) then - call SetBlockMatrix( dUdu, MeshMapData%HD_M_P_2_SD_P%dM%m_us, SD_Start, HD_Start ) + if (allocated(MeshMapData%HD_M_P_2_SubStructure%dM%m_us )) then + call SetBlockMatrix( dUdu, MeshMapData%HD_M_P_2_SubStructure%dM%m_us, SD_Start, HD_Start ) end if @@ -2396,12 +2197,12 @@ SUBROUTINE Linear_SD_InputSolve_du( p_FAST, y_FAST, SrvD, u_SD, y_SD, y_ED, HD, ! we're mapping loads, so we also need the sibling meshes' displacements: HD_Start = Indx_u_HD_WAMIT_Start(HD%Input(1), y_FAST) - call Linearize_Point_to_Point( HD%y%WAMITMesh, u_SD%LMesh, MeshMapData%HD_W_P_2_SD_P, ErrStat2, ErrMsg2, HD%Input(1)%WAMITMesh, y_SD%Y2Mesh) !HD%Input(1)%Mesh and y_ED%PlatformPtMesh contain the displaced positions for load calculations + call Linearize_Point_to_Point( HD%y%WAMITMesh, u_SD%LMesh, MeshMapData%HD_W_P_2_SubStructure, ErrStat2, ErrMsg2, HD%Input(1)%WAMITMesh, y_SD%Y2Mesh) !HD%Input(1)%Mesh and y_ED%PlatformPtMesh contain the displaced positions for load calculations call SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) ! HD is source in the mapping, so we want M_{uSm} - if (allocated(MeshMapData%HD_W_P_2_SD_P%dM%m_us )) then - call SetBlockMatrix( dUdu, MeshMapData%HD_W_P_2_SD_P%dM%m_us, SD_Start, HD_Start ) + if (allocated(MeshMapData%HD_W_P_2_SubStructure%dM%m_us )) then + call SetBlockMatrix( dUdu, MeshMapData%HD_W_P_2_SubStructure%dM%m_us, SD_Start, HD_Start ) end if @@ -2417,17 +2218,17 @@ SUBROUTINE Linear_SD_InputSolve_du( p_FAST, y_FAST, SrvD, u_SD, y_SD, y_ED, HD, ! Transfer MAP loads to ED PlatformPtmesh input: ! we're mapping loads, so we also need the sibling meshes' displacements: - MAP_Start = y_FAST%Lin%Modules(MODULE_MAP)%Instance(1)%LinStartIndx(LIN_INPUT_COL) - - ! NOTE: Assumes at least one MAP Fairlead point - - CALL Linearize_Point_to_Point( MAPp%y%ptFairleadLoad, u_SD%LMesh, MeshMapData%Mooring_P_2_SD_P, ErrStat2, ErrMsg2, MAPp%Input(1)%PtFairDisplacement, y_SD%Y3Mesh) !MAPp%Input(1)%ptFairleadLoad and y_SD%Y3Mesh contain the displaced positions for load calculations - CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) - - ! SD is source in the mapping, so we want M_{uSm} - if (allocated(MeshMapData%Mooring_P_2_SD_P%dM%m_us )) then - call SetBlockMatrix( dUdu, MeshMapData%Mooring_P_2_SD_P%dM%m_us, SD_Start, MAP_Start ) - end if + MAP_Start = y_FAST%Lin%Modules(MODULE_MAP)%Instance(1)%LinStartIndx(LIN_INPUT_COL) + + ! NOTE: Assumes at least one MAP Fairlead point + + CALL Linearize_Point_to_Point( MAPp%y%ptFairleadLoad, u_SD%LMesh, MeshMapData%Mooring_2_Structure, ErrStat2, ErrMsg2, MAPp%Input(1)%PtFairDisplacement, y_SD%Y3Mesh) !MAPp%Input(1)%ptFairleadLoad and y_SD%Y3Mesh contain the displaced positions for load calculations + CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) + + ! SD is source in the mapping, so we want M_{uSm} + if (allocated(MeshMapData%Mooring_2_Structure%dM%m_us )) then + call SetBlockMatrix( dUdu, MeshMapData%Mooring_2_Structure%dM%m_us, SD_Start, MAP_Start ) + end if !.......... ! dU^{SD}/du^{MD} @@ -2441,12 +2242,12 @@ SUBROUTINE Linear_SD_InputSolve_du( p_FAST, y_FAST, SrvD, u_SD, y_SD, y_ED, HD, ! NOTE: Assumes at least one coupled MD object - CALL Linearize_Point_to_Point( MD%y%CoupledLoads(1), u_SD%LMesh, MeshMapData%Mooring_P_2_SD_P, ErrStat2, ErrMsg2, MD%Input(1)%CoupledKinematics(1), y_SD%Y3Mesh) + CALL Linearize_Point_to_Point( MD%y%CoupledLoads(1), u_SD%LMesh, MeshMapData%Mooring_2_Structure, ErrStat2, ErrMsg2, MD%Input(1)%CoupledKinematics(1), y_SD%Y3Mesh) CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) ! SD is source in the mapping, so we want M_{uSm} - if (allocated(MeshMapData%Mooring_P_2_SD_P%dM%m_us )) then - call SetBlockMatrix( dUdu, MeshMapData%Mooring_P_2_SD_P%dM%m_us, SD_Start, MD_Start ) + if (allocated(MeshMapData%Mooring_2_Structure%dM%m_us )) then + call SetBlockMatrix( dUdu, MeshMapData%Mooring_2_Structure%dM%m_us, SD_Start, MD_Start ) end if end if @@ -2457,13 +2258,14 @@ END SUBROUTINE Linear_SD_InputSolve_du !---------------------------------------------------------------------------------------------------------------------------------- !> This routine forms the dU^{SD}/dy^{SrvD}, dU^{SD}/dy^{HD} and dU^{SD}/dy^{SD} blocks (SD row) of dUdu. (i.e., how do changes in SrvD, HD, and SD inputs affect the SD inputs?) -SUBROUTINE Linear_SD_InputSolve_dy( p_FAST, y_FAST, SrvD, u_SD, y_SD, y_ED, HD, MAPp, MD, MeshMapData, dUdy, ErrStat, ErrMsg ) +SUBROUTINE Linear_SD_InputSolve_dy( p_FAST, y_FAST, SrvD, u_SD, y_SD, p_ED, y_ED, HD, MAPp, MD, MeshMapData, dUdy, ErrStat, ErrMsg ) TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Glue-code simulation parameters TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< Glue-code output parameters (for linearization) type(ServoDyn_Data), intent(in ) :: SrvD !< SrvD parameters TYPE(SD_InputType), INTENT(INOUT) :: u_SD !< SD Inputs at t TYPE(SD_OutputType), INTENT(IN ) :: y_SD !< SubDyn outputs (need translation displacement on meshes for loads mapping) + TYPE(ED_ParameterType), intent(in ) :: p_ED !< ED Inputs at t TYPE(ED_OutputType), INTENT(IN ) :: y_ED !< ElastoDyn outputs TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HD data at t TYPE(MAP_Data), INTENT(INOUT) :: MAPp !< MAP data at t @@ -2499,7 +2301,7 @@ SUBROUTINE Linear_SD_InputSolve_dy( p_FAST, y_FAST, SrvD, u_SD, y_SD, y_ED, HD, do j=1,size(SrvD%y%SStCLoadMesh) if (SrvD%y%SStCLoadMesh(j)%Committed) then SrvD_Out_Start = y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) - 1 + SrvD%p%Jac_Idx_SStC_y(1,j) - call Assemble_dUdy_Loads(SrvD%y%SStCLoadMesh(j), u_SD%LMesh, MeshMapData%SStC_P_P_2_SD_P(j), SD_Start, SrvD_Out_Start, dUdy) + call Assemble_dUdy_Loads(SrvD%y%SStCLoadMesh(j), u_SD%LMesh, MeshMapData%SStC_P_P_2_SubStructure(j), SD_Start, SrvD_Out_Start, dUdy) endif enddo endif @@ -2514,8 +2316,8 @@ SUBROUTINE Linear_SD_InputSolve_dy( p_FAST, y_FAST, SrvD, u_SD, y_SD, y_ED, HD, !!!call Linearize_Point_to_Line2( y_ED%PlatformPtMesh, u_SD%TPMesh, MeshMapData%ED_P_2_SD_TP, ErrStat2, ErrMsg2 ) SD_Start = Indx_u_SD_TPMesh_Start(u_SD, y_FAST) ! start of u_SD%MTPMesh%TranslationDisp field - ED_Out_Start = Indx_y_ED_Platform_Start(y_ED, y_FAST) ! start of y_ED%PlatformPtMesh%TranslationDisp field - call Assemble_dUdy_Motions(y_ED%PlatformPtMesh, u_SD%TPMesh, MeshMapData%ED_P_2_SD_TP, SD_Start, ED_Out_Start, dUdy, .false.) + ED_Out_Start = Indx_y_ED_Platform_Start(p_ED, y_ED, y_FAST) ! start of y_ED%PlatformPtMesh%TranslationDisp field + call Assemble_dUdy_Motions(y_ED%PlatformPtMesh, u_SD%TPMesh, MeshMapData%ED_P_2_SD_TP, SD_Start, ED_Out_Start, dUdy) !.......... ! dU^{SD}/dy^{HD} @@ -2526,29 +2328,29 @@ SUBROUTINE Linear_SD_InputSolve_dy( p_FAST, y_FAST, SrvD, u_SD, y_SD, y_ED, HD, SD_Out_Start = Indx_y_SD_Y2Mesh_Start(y_SD, y_FAST) ! start of y_SD%Y2Mesh%TranslationDisp field ! we're just going to assume u_SD%LMesh is committed if ( HD%y%Morison%Mesh%Committed ) then ! meshes for floating - !!! ! This linearization was done in forming dUdu (see Linear_ED_InputSolve_du()), so we don't need to re-calculate these matrices + !!! ! This linearization was done in forming dUdu (see Linear_SD_InputSolve_du()), so we don't need to re-calculate these matrices !!! ! while forming dUdy, too. - ! call Linearize_Point_to_Point( HD%y%Morison, u_ED%PlatformPtMesh, MeshMapData%HD_M_P_2_ED_P, ErrStat2, ErrMsg2, HD%Input(1)%Morison, y_ED%PlatformPtMesh) !HD%Input(1)%Morison and y_ED%PlatformPtMesh contain the displaced positions for load calculations + ! call Linearize_Point_to_Point( HD%y%Morison%Mesh, u_SD%LMesh, MeshMapData%HD_M_P_2_SubStructure, ErrStat2, ErrMsg2, HD%Input(1)%Morison%Mesh, y_SD%Y2Mesh) HD_Out_Start = Indx_y_HD_Morison_Start(HD%y, y_FAST) SD_Start = Indx_u_SD_LMesh_Start(u_SD, y_FAST) ! start of u_SD%LMesh%Force field - call Assemble_dUdy_Loads(HD%y%Morison%Mesh, u_SD%LMesh, MeshMapData%HD_M_P_2_SD_P, SD_Start, HD_Out_Start, dUdy) + call Assemble_dUdy_Loads(HD%y%Morison%Mesh, u_SD%LMesh, MeshMapData%HD_M_P_2_SubStructure, SD_Start, HD_Out_Start, dUdy) ! SD translation displacement-to-SD moment transfer (dU^{SD}/dy^{SD}): SD_Start = Indx_u_SD_LMesh_Start(u_SD, y_FAST) + u_SD%LMesh%NNodes*3 ! start of u_SD%LMesh%Moment field (skip the SD forces) - call SetBlockMatrix( dUdy, MeshMapData%HD_M_P_2_SD_P%dM%m_uD, SD_Start, SD_Out_Start ) + call SetBlockMatrix( dUdy, MeshMapData%HD_M_P_2_SubStructure%dM%m_uD, SD_Start, SD_Out_Start ) ! maybe this should be SumBlockMatrix with future changes to linearized modules??? end if if ( HD%y%WAMITMesh%Committed ) then ! meshes for floating - !!! ! This linearization was done in forming dUdu (see Linear_ED_InputSolve_du()), so we don't need to re-calculate these matrices + !!! ! This linearization was done in forming dUdu (see Linear_SD_InputSolve_du()), so we don't need to re-calculate these matrices !!! ! while forming dUdy, too. - ! call Linearize_Point_to_Point( HD%y%WAMITMesh, u_ED%PlatformPtMesh, MeshMapData%HD_W_P_2_ED_P, ErrStat2, ErrMsg2, HD%Input(1)%WAMITMesh, y_ED%PlatformPtMesh) !HD%Input(1)%WAMITMesh and y_ED%PlatformPtMesh contain the displaced positions for load calculations + ! call Linearize_Point_to_Point( HD%y%WAMITMesh, u_SD%LMesh, MeshMapData%HD_W_P_2_SubStructure, ErrStat2, ErrMsg2, HD%Input(1)%WAMITMesh, y_SD%Y2Mesh) HD_Out_Start = Indx_y_HD_WAMIT_Start(HD%y, y_FAST) SD_Start = Indx_u_SD_LMesh_Start(u_SD, y_FAST) ! start of u_SD%LMesh%Force field - call Assemble_dUdy_Loads(HD%y%WAMITMesh, u_SD%LMesh, MeshMapData%HD_W_P_2_SD_P, SD_Start, HD_Out_Start, dUdy) + call Assemble_dUdy_Loads(HD%y%WAMITMesh, u_SD%LMesh, MeshMapData%HD_W_P_2_SubStructure, SD_Start, HD_Out_Start, dUdy) ! SD translation displacement-to-SD moment transfer (dU^{SD}/dy^{SD}): SD_Start = Indx_u_SD_LMesh_Start(u_SD, y_FAST) + u_SD%LMesh%NNodes*3 ! start of u_SD%LMesh%Moment field (skip the SD forces) - call SumBlockMatrix( dUdy, MeshMapData%HD_W_P_2_SD_P%dM%m_uD, SD_Start, SD_Out_Start ) + call SumBlockMatrix( dUdy, MeshMapData%HD_W_P_2_SubStructure%dM%m_uD, SD_Start, SD_Out_Start ) ! maybe this should be SumBlockMatrix with future changes to linearized modules??? end if end if @@ -2560,15 +2362,15 @@ SUBROUTINE Linear_SD_InputSolve_dy( p_FAST, y_FAST, SrvD, u_SD, y_SD, y_ED, HD, if ( MAPp%y%ptFairleadLoad%Committed ) then ! meshes for floating !!! ! This linearization was done in forming dUdu (see Linear_SD_InputSolve_du()), so we don't need to re-calculate these matrices !!! ! while forming dUdy, too. - ! CALL Linearize_Point_to_Point( MAPp%y%ptFairleadLoad, u_SD%LMesh, MeshMapData%Mooring_P_2_SD_P, ErrStat2, ErrMsg2, MAPp%Input(1)%PtFairDisplacement, y_SD%Y3Mesh) !MAPp%Input(1)%ptFairleadLoad and y_ED%Y3Mesh contain the displaced positions for load calculations + ! CALL Linearize_Point_to_Point( MAPp%y%ptFairleadLoad, u_SD%LMesh, MeshMapData%Mooring_2_Structure, ErrStat2, ErrMsg2, MAPp%Input(1)%PtFairDisplacement, y_SD%Y3Mesh) !MAPp%Input(1)%ptFairleadLoad and y_ED%Y3Mesh contain the displaced positions for load calculations MAP_Out_Start = y_FAST%Lin%Modules(MODULE_MAP)%Instance(1)%LinStartIndx(LIN_OUTPUT_COL) SD_Start = Indx_u_SD_LMesh_Start(u_SD, y_FAST) ! start of u_SD%LMesh%TranslationDisp field - call Assemble_dUdy_Loads(MAPp%y%ptFairLeadLoad, u_SD%LMesh, MeshMapData%Mooring_P_2_SD_P, SD_Start, MAP_Out_Start, dUdy) + call Assemble_dUdy_Loads(MAPp%y%ptFairLeadLoad, u_SD%LMesh, MeshMapData%Mooring_2_Structure, SD_Start, MAP_Out_Start, dUdy) ! SD translation displacement-to-SD moment transfer (dU^{SD}/dy^{SD}): SD_Start = Indx_u_SD_LMesh_Start(u_SD, y_FAST) + u_SD%LMesh%NNodes*3 ! start of u_ED%LMesh%Moment field (skip the SD forces) SD_Out_Start = Indx_y_SD_Y3Mesh_Start(y_SD, y_FAST) ! start of y_SD%Y3Mesh%TranslationDisp field - call SumBlockMatrix( dUdy, MeshMapData%Mooring_P_2_SD_P%dM%m_uD, SD_Start, SD_Out_Start ) + call SumBlockMatrix( dUdy, MeshMapData%Mooring_2_Structure%dM%m_uD, SD_Start, SD_Out_Start ) end if !.......... @@ -2580,12 +2382,12 @@ SUBROUTINE Linear_SD_InputSolve_dy( p_FAST, y_FAST, SrvD, u_SD, y_SD, y_ED, HD, !!! ! while forming dUdy, too. MD_Out_Start = y_FAST%Lin%Modules(Module_MD)%Instance(1)%LinStartIndx(LIN_OUTPUT_COL) SD_Start = Indx_u_SD_LMesh_Start(u_SD, y_FAST) ! start of u_SD%LMesh%TranslationDisp field - call Assemble_dUdy_Loads(MD%y%CoupledLoads(1), u_SD%LMesh, MeshMapData%Mooring_P_2_SD_P, SD_Start, MD_Out_Start, dUdy) + call Assemble_dUdy_Loads(MD%y%CoupledLoads(1), u_SD%LMesh, MeshMapData%Mooring_2_Structure, SD_Start, MD_Out_Start, dUdy) ! SD translation displacement-to-SD moment transfer (dU^{SD}/dy^{SD}): SD_Start = Indx_u_SD_LMesh_Start(u_SD, y_FAST) + u_SD%LMesh%NNodes*3 ! start of u_ED%LMesh%Moment field (skip the SD forces) SD_Out_Start = Indx_y_SD_Y3Mesh_Start(y_SD, y_FAST) ! start of y_SD%Y3Mesh%TranslationDisp field - call SumBlockMatrix( dUdy, MeshMapData%Mooring_P_2_SD_P%dM%m_uD, SD_Start, SD_Out_Start ) + call SumBlockMatrix( dUdy, MeshMapData%Mooring_2_Structure%dM%m_uD, SD_Start, SD_Out_Start ) end if end if END SUBROUTINE Linear_SD_InputSolve_dy @@ -2594,14 +2396,15 @@ END SUBROUTINE Linear_SD_InputSolve_dy !---------------------------------------------------------------------------------------------------------------------------------- !> This routine forms the dU^{BD}/du^{BD} and dU^{BD}/du^{AD} blocks (BD row) of dUdu. (i.e., how do changes in the AD and BD inputs !! affect the BD inputs?) This should be called only when p_FAST%CompElast == Module_BD. -SUBROUTINE Linear_BD_InputSolve_du( p_FAST, y_FAST, SrvD, y_ED, y_AD, u_AD, BD, MeshMapData, dUdu, ErrStat, ErrMsg ) +SUBROUTINE Linear_BD_InputSolve_du( p_FAST, y_FAST, SrvD, y_ED, p_AD, u_AD, y_AD, BD, MeshMapData, dUdu, ErrStat, ErrMsg ) TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Glue-code simulation parameters TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< Glue-code output parameters (for linearization) type(ServoDyn_Data), intent(in ) :: SrvD !< SrvD parameters TYPE(ED_OutputType), INTENT(IN ) :: y_ED !< ElastoDyn outputs (need translation displacement on meshes for loads mapping) - TYPE(AD_OutputType), INTENT(IN ) :: y_AD !< AeroDyn outputs + TYPE(AD_ParameterType), INTENT(IN ) :: p_AD !< AD paraemters (for AD-ED load linerization) TYPE(AD_InputType), INTENT(INOUT) :: u_AD !< AD inputs (for AD-ED load linerization) + TYPE(AD_OutputType), INTENT(IN ) :: y_AD !< AeroDyn outputs TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BD data at t TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules @@ -2688,7 +2491,7 @@ SUBROUTINE Linear_BD_InputSolve_du( p_FAST, y_FAST, SrvD, y_ED, y_AD, u_AD, BD, ! AD is source in the mapping, so we want M_{uSm} if (allocated(MeshMapData%AD_L_2_BDED_B(k)%dM%m_us )) then - AD_Start = Indx_u_AD_Blade_Start(u_AD, y_FAST, k) ! index for the start of u_AD%BladeMotion(k)%translationDisp field + AD_Start = Indx_u_AD_Blade_Start(p_AD, u_AD, y_FAST, k) ! index for the start of u_AD%rotors(1)%BladeMotion(k)%translationDisp field BD_Start = y_FAST%Lin%Modules(MODULE_BD)%Instance(k)%LinStartIndx(LIN_INPUT_COL) & + BD%Input(1,k)%RootMotion%NNodes *18 & ! displacement, rotation, & acceleration fields for each node @@ -2736,12 +2539,11 @@ SUBROUTINE Linear_BD_InputSolve_du( p_FAST, y_FAST, SrvD, y_ED, y_AD, u_AD, BD, END SUBROUTINE Linear_BD_InputSolve_du !---------------------------------------------------------------------------------------------------------------------------------- !> This routine forms the dU^{AD}/du^{AD} block of dUdu. (i.e., how do changes in the AD inputs affect the AD inputs?) -SUBROUTINE Linear_AD_InputSolve_du( p_FAST, y_FAST, u_AD, y_ED, BD, MeshMapData, dUdu, ErrStat, ErrMsg ) - - ! Passed variables +SUBROUTINE Linear_AD_InputSolve_du( p_FAST, y_FAST, p_AD, u_AD, y_ED, BD, MeshMapData, dUdu, ErrStat, ErrMsg ) TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< FAST parameter data TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) - TYPE(AD_InputType), INTENT(INOUT) :: u_AD !< The inputs to AeroDyn14 + TYPE(AD_InputType), INTENT(INOUT) :: u_AD !< The inputs to AeroDyn15 + TYPE(AD_ParameterType), INTENT(IN ) :: p_AD !< The parameters of AD15 TYPE(ED_OutputType), INTENT(IN) :: y_ED !< The outputs from the structural dynamics module TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BD data at t TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules @@ -2771,66 +2573,87 @@ SUBROUTINE Linear_AD_InputSolve_du( p_FAST, y_FAST, u_AD, y_ED, BD, MeshMapData, ! Set the inputs from ElastoDyn and/or BeamDyn: !------------------------------------------------------------------------------------------------- - ! tower - IF (u_AD%rotors(1)%TowerMotion%Committed) THEN + !----------------------------------- + ! Nacelle - Disp, Orient + ! NOTE: no velocity or acceleration terms, so nothing to do here. + if (u_AD%rotors(1)%NacelleMotion%Committed) then + call Linearize_Point_to_Point( y_ED%NacelleMotion, u_AD%rotors(1)%NacelleMotion, MeshMapData%ED_P_2_AD_P_N, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName//':u_AD%NacelleMotion' ) + end if + + + !----------------------------------- + ! Hub - Disp, Orient, RotVel + if (u_AD%rotors(1)%HubMotion%Committed) then + call Linearize_Point_to_Point( y_ED%HubPtMotion, u_AD%rotors(1)%HubMotion, MeshMapData%ED_P_2_AD_P_H, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName//':u_AD%HubMotion' ) + end if - CALL Linearize_Line2_to_Line2( y_ED%TowerLn2Mesh, u_AD%rotors(1)%TowerMotion, MeshMapData%ED_L_2_AD_L_T, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName//':u_AD%TowerMotion' ) + !----------------------------------- + ! TailFin - Disp, Orient, TransVel, TransAcc + if (u_AD%rotors(1)%TFinMotion%Committed) then + call Linearize_Point_to_Point( y_ED%TFinCMMotion, u_AD%rotors(1)%TFinMotion, MeshMapData%ED_P_2_AD_P_TF, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName//':u_AD%TFinMotion' ) + + !AD is the destination here, so we need tv_ud + if (allocated( MeshMapData%ED_P_2_AD_P_TF%dM%tv_ud)) then + AD_Start_td = Indx_u_AD_TFin_Start(p_AD, u_AD, y_FAST) ! index for u_AD%rotors(1)%TFinMotion(k)%translationDisp field + AD_Start_tv = AD_Start_td + u_AD%rotors(1)%TFinMotion%NNodes * 6 ! 2 fields (TranslationDisp and Orientation) with 3 components before translational velocity field + call SetBlockMatrix( dUdu, MeshMapData%ED_P_2_AD_P_TF%dM%tv_ud, AD_Start_tv, AD_Start_td ) + end if + end if + + !----------------------------------- + ! tower - Disp, Orient, TransVel, TransAcc + IF (u_AD%rotors(1)%TowerMotion%Committed) THEN + CALL Linearize_Line2_to_Line2( y_ED%TowerLn2Mesh, u_AD%rotors(1)%TowerMotion, MeshMapData%ED_L_2_AD_L_T, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName//':u_AD%TowerMotion' ) + AD_Start_td = Indx_u_AD_Tower_Start(p_AD, u_AD, y_FAST) ! index for u_AD%rotors(1)%TowerMotion(k)%translationDisp field !AD is the destination here, so we need tv_ud if (allocated( MeshMapData%ED_L_2_AD_L_T%dM%tv_ud)) then - AD_Start_td = y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) - AD_Start_tv = AD_Start_td + u_AD%rotors(1)%TowerMotion%NNodes * 6 ! 2 fields (TranslationDisp and Orientation) with 3 components before translational velocity field - + AD_Start_tv = AD_Start_td + u_AD%rotors(1)%TowerMotion%NNodes * 6 ! 2 fields (TranslationDisp and Orientation) with 3 components before translational velocity field call SetBlockMatrix( dUdu, MeshMapData%ED_L_2_AD_L_T%dM%tv_ud, AD_Start_tv, AD_Start_td ) end if - - + if (allocated( MeshMapData%ED_L_2_AD_L_T%dM%ta_ud)) then + AD_Start_ta = AD_Start_td + u_AD%rotors(1)%TowerMotion%NNodes * 9 ! 3 fields (TranslationDisp and Orientation, transVel) with 3 components before translational accel + call SetBlockMatrix( dUdu, MeshMapData%ED_L_2_AD_L_T%dM%ta_ud, AD_Start_ta, AD_Start_td ) + end if END IF ! blades IF (p_FAST%CompElast == Module_ED ) THEN - DO k=1,size(u_AD%rotors(1)%BladeMotion) CALL Linearize_Line2_to_Line2( y_ED%BladeLn2Mesh(k), u_AD%rotors(1)%BladeMotion(k), MeshMapData%BDED_L_2_AD_L_B(k), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName//':u_AD%BladeMotion('//trim(num2lstr(k))//')' ) END DO - ELSEIF (p_FAST%CompElast == Module_BD ) THEN - DO k=1,size(u_AD%rotors(1)%BladeMotion) CALL Linearize_Line2_to_Line2( BD%y(k)%BldMotion, u_AD%rotors(1)%BladeMotion(k), MeshMapData%BDED_L_2_AD_L_B(k), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName//':u_AD%BladeMotion('//trim(num2lstr(k))//')' ) END DO - END IF DO k=1,size(u_AD%rotors(1)%BladeMotion) - AD_Start_td = Indx_u_AD_Blade_Start(u_AD, y_FAST, k) ! index for u_AD%BladeMotion(k)%translationDisp field - + AD_Start_td = Indx_u_AD_Blade_Start(p_AD, u_AD, y_FAST, k) ! index for u_AD%rotors(1)%BladeMotion(k)%translationDisp field !AD is the destination here, so we need tv_ud if (allocated( MeshMapData%BDED_L_2_AD_L_B(k)%dM%tv_ud)) then - ! index for u_AD%BladeMotion(k+1)%translationVel field + ! index for u_AD%rotors(1)%BladeMotion(k+1)%translationVel field AD_Start_tv = AD_Start_td + u_AD%rotors(1)%BladeMotion(k)%NNodes * 6 ! 2 fields (TranslationDisp and Orientation) with 3 components before translational velocity field - call SetBlockMatrix( dUdu, MeshMapData%BDED_L_2_AD_L_B(k)%dM%tv_ud, AD_Start_tv, AD_Start_td ) end if - - if (allocated( MeshMapData%BDED_L_2_AD_L_B(k)%dM%tv_ud)) then - AD_Start_ta = AD_Start_td + u_AD%rotors(1)%BladeMotion(k)%NNodes * 12 ! 4 fields (TranslationDisp, Orientation, TranslationVel, and RotationVel) with 3 components before translational velocity field - + + if (allocated( MeshMapData%BDED_L_2_AD_L_B(k)%dM%ta_ud)) then + AD_Start_ta = AD_Start_td + u_AD%rotors(1)%BladeMotion(k)%NNodes * 12 ! 4 fields (TranslationDisp, Orientation, TranslationVel, and RotationVel) with 3 components before translational acceleration field call SetBlockMatrix( dUdu, MeshMapData%BDED_L_2_AD_L_B(k)%dM%ta_ud, AD_Start_ta, AD_Start_td ) end if - END DO -END SUBROUTINE Linear_AD_InputSolve_du - - +END SUBROUTINE Linear_AD_InputSolve_du !---------------------------------------------------------------------------------------------------------------------------------- !> This routine forms the dU^{SrvD}/du^{SrvD} block (SrvD row) of dUdu. !! (i.e., how do changes in the SrvD inputs affect the SrvD inputs?) @@ -2963,20 +2786,20 @@ SUBROUTINE Linear_SrvD_InputSolve_du( p_FAST, y_FAST, p_SrvD, u_SrvD, y_ED, BD, if ( ALLOCATED(u_SrvD%SStCMotionMesh) ) then do j=1,size(u_SrvD%SStCMotionMesh) if (u_SrvD%SStCMotionMesh(j)%Committed) then - CALL Linearize_Point_to_Point( y_ED%PlatformPtMesh, u_SrvD%SStCMotionMesh(j), MeshMapData%ED_P_2_SStC_P_P(j), ErrStat2, ErrMsg2 ) + CALL Linearize_Point_to_Point( y_ED%PlatformPtMesh, u_SrvD%SStCMotionMesh(j), MeshMapData%Substructure_2_SStC_P_P(j), ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! SrvD is destination in the mapping, so we want M_{tv_uD} and M_{ta_uD} ! translational velocity: - if (allocated(MeshMapData%ED_P_2_SStC_P_P(j)%dM%tv_uD )) then + if (allocated(MeshMapData%Substructure_2_SStC_P_P(j)%dM%tv_uD )) then SrvD_Start = y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) - 1 + (p_SrvD%Jac_Idx_SStC_u(1,j) + 6) ! skip translational displacement and orientation fields - call SetBlockMatrix( dUdu, MeshMapData%ED_P_2_SStC_P_P(j)%dM%tv_uD, SrvD_Start, y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) ) + call SetBlockMatrix( dUdu, MeshMapData%Substructure_2_SStC_P_P(j)%dM%tv_uD, SrvD_Start, y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) ) end if ! translational acceleration: - if (allocated(MeshMapData%ED_P_2_SStC_P_P(j)%dM%ta_uD )) then + if (allocated(MeshMapData%Substructure_2_SStC_P_P(j)%dM%ta_uD )) then SrvD_Start = y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) - 1 + (p_SrvD%Jac_Idx_SStC_u(1,j) + 12) ! skip translational displacement and orientation fields - call SetBlockMatrix( dUdu, MeshMapData%ED_P_2_SStC_P_P(j)%dM%ta_uD, SrvD_Start, y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) ) + call SetBlockMatrix( dUdu, MeshMapData%Substructure_2_SStC_P_P(j)%dM%ta_uD, SrvD_Start, y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) ) end if endif enddo @@ -2985,20 +2808,20 @@ SUBROUTINE Linear_SrvD_InputSolve_du( p_FAST, y_FAST, p_SrvD, u_SrvD, y_ED, BD, if ( ALLOCATED(u_SrvD%SStCMotionMesh) ) then do j=1,size(u_SrvD%SStCMotionMesh) IF (u_SrvD%SStCMotionMesh(j)%Committed) then - CALL Linearize_Point_to_Point( SD%y%y3Mesh, u_SrvD%SStCMotionMesh(j), MeshMapData%SDy3_P_2_SStC_P_P(j), ErrStat2, ErrMsg2 ) + CALL Linearize_Point_to_Point( SD%y%y3Mesh, u_SrvD%SStCMotionMesh(j), MeshMapData%SubStructure_2_SStC_P_P(j), ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! SrvD is destination in the mapping, so we want M_{tv_uD} and M_{ta_uD} ! translational velocity: - if (allocated(MeshMapData%SDy3_P_2_SStC_P_P(j)%dM%tv_uD )) then + if (allocated(MeshMapData%SubStructure_2_SStC_P_P(j)%dM%tv_uD )) then SrvD_Start = y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) - 1 + (p_SrvD%Jac_Idx_SStC_u(1,j) + 6) ! skip translational displacement and orientation fields - call SetBlockMatrix( dUdu, MeshMapData%SDy3_P_2_SStC_P_P(j)%dM%tv_uD, SrvD_Start, y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) ) + call SetBlockMatrix( dUdu, MeshMapData%SubStructure_2_SStC_P_P(j)%dM%tv_uD, SrvD_Start, y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) ) end if ! translational acceleration: - if (allocated(MeshMapData%SDy3_P_2_SStC_P_P(j)%dM%ta_uD )) then + if (allocated(MeshMapData%SubStructure_2_SStC_P_P(j)%dM%ta_uD )) then SrvD_Start = y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) - 1 + (p_SrvD%Jac_Idx_SStC_u(1,j) + 12) ! skip translational displacement and orientation fields - call SetBlockMatrix( dUdu, MeshMapData%SDy3_P_2_SStC_P_P(j)%dM%ta_uD, SrvD_Start, y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) ) + call SetBlockMatrix( dUdu, MeshMapData%SubStructure_2_SStC_P_P(j)%dM%ta_uD, SrvD_Start, y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) ) end if endif enddo @@ -3012,12 +2835,12 @@ END SUBROUTINE Linear_SrvD_InputSolve_du !> This routine forms the dU^{SrvD}/dy^{ED}, dU^{SrvD}/dy^{BD}, dU^{SrvD}/dy^{SD} block of dUdy. !! (i.e., how do changes in the ED, SD, BD outputs affect the SrvD inputs?) !! NOTE: Linearze_Point_to_Point routines done in Linear_SrvD_InputSolve_du -SUBROUTINE Linear_SrvD_InputSolve_dy( p_FAST, y_FAST, p_SrvD, u_SrvD, y_ED, BD, y_SD, MeshMapData, dUdy, ErrStat, ErrMsg ) -!.................................................................................................................................. +SUBROUTINE Linear_SrvD_InputSolve_dy( p_FAST, y_FAST, p_SrvD, u_SrvD, p_ED, y_ED, BD, y_SD, MeshMapData, dUdy, ErrStat, ErrMsg ) type(FAST_ParameterType), intent(in ) :: p_FAST !< Glue-code simulation parameters type(FAST_OutputFileType), intent(in ) :: y_FAST !< Output variables for the glue code type(SrvD_ParameterType), intent(in ) :: p_SrvD !< SrvD parameters (holds indices for jacobian entries for each StC) type(SrvD_InputType), intent(inout) :: u_SrvD !< SrvD Inputs at t + TYPE(ED_ParameterType), intent(in ) :: p_ED !< ED Inputs at t type(ED_OutputType), intent(in ) :: y_ED !< ElastoDyn outputs (need translation displacement on meshes for loads mapping) type(BeamDyn_Data), intent(in ) :: BD !< BeamDyn data type(SD_OutputType), intent(in ) :: y_SD !< SubDyn outputs (need translation displacement on meshes for loads mapping) @@ -3057,8 +2880,8 @@ SUBROUTINE Linear_SrvD_InputSolve_dy( p_FAST, y_FAST, p_SrvD, u_SrvD, y_ED, BD, do K = 1,size(y_ED%BladeLn2Mesh) if (u_SrvD%BStCMotionMesh(K,j)%Committed) then SrvD_Start = y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) - 1 + (p_SrvD%Jac_Idx_BStC_u(1,k,j)) - ED_Out_Start = Indx_y_ED_Blade_Start(y_ED, y_FAST, k) ! start of %TranslationDisp field - call Assemble_dUdy_Motions( y_ED%BladeLn2Mesh(K), u_SrvD%BStCMotionMesh(K,j), MeshMapData%ED_L_2_BStC_P_B(K,j), SrvD_Start, ED_Out_Start, dUdy, .false.) + ED_Out_Start = Indx_y_ED_Blade_Start(p_ED, y_ED, y_FAST, k) ! start of %TranslationDisp field + call Assemble_dUdy_Motions( y_ED%BladeLn2Mesh(K), u_SrvD%BStCMotionMesh(K,j), MeshMapData%ED_L_2_BStC_P_B(K,j), SrvD_Start, ED_Out_Start, dUdy) endif enddo enddo @@ -3073,7 +2896,7 @@ SUBROUTINE Linear_SrvD_InputSolve_dy( p_FAST, y_FAST, p_SrvD, u_SrvD, y_ED, BD, if (u_SrvD%BStCMotionMesh(K,j)%Committed) then SrvD_Start = y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) - 1 + (p_SrvD%Jac_Idx_BStC_u(1,k,j)) BD_Out_Start = y_FAST%Lin%Modules(MODULE_BD)%Instance(k)%LinStartIndx(LIN_OUTPUT_COL) ! start of %TranslationDisp field - call Assemble_dUdy_Motions( BD%y(k)%BldMotion, u_SrvD%BStCMotionMesh(K,j), MeshMapData%BD_L_2_BStC_P_B(K,j), SrvD_Start, BD_Out_Start, dUdy, .false.) + call Assemble_dUdy_Motions( BD%y(k)%BldMotion, u_SrvD%BStCMotionMesh(K,j), MeshMapData%BD_L_2_BStC_P_B(K,j), SrvD_Start, BD_Out_Start, dUdy) endif enddo enddo @@ -3087,8 +2910,8 @@ SUBROUTINE Linear_SrvD_InputSolve_dy( p_FAST, y_FAST, p_SrvD, u_SrvD, y_ED, BD, do j = 1,size(u_SrvD%NStCMotionMesh) if (u_SrvD%NStCMotionMesh(j)%Committed) then SrvD_Start = y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) - 1 + (p_SrvD%Jac_Idx_NStC_u(1,j)) - ED_Out_Start = Indx_y_ED_Nacelle_Start(y_ED, y_FAST) ! start of %TranslationDisp field - call Assemble_dUdy_Motions( y_ED%NacelleMotion, u_SrvD%NStCMotionMesh(j), MeshMapData%ED_P_2_NStC_P_N(j), SrvD_Start, ED_Out_Start, dUdy, .false.) + ED_Out_Start = Indx_y_ED_Nacelle_Start(p_ED, y_ED, y_FAST) ! start of %TranslationDisp field + call Assemble_dUdy_Motions( y_ED%NacelleMotion, u_SrvD%NStCMotionMesh(j), MeshMapData%ED_P_2_NStC_P_N(j), SrvD_Start, ED_Out_Start, dUdy) endif enddo endif @@ -3100,8 +2923,8 @@ SUBROUTINE Linear_SrvD_InputSolve_dy( p_FAST, y_FAST, p_SrvD, u_SrvD, y_ED, BD, do j = 1,size(u_SrvD%TStCMotionMesh) if (u_SrvD%TStCMotionMesh(j)%Committed) then SrvD_Start = y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) - 1 + (p_SrvD%Jac_Idx_TStC_u(1,j)) - ED_Out_Start = Indx_y_ED_Tower_Start(y_ED, y_FAST) ! start of %TranslationDisp field - call Assemble_dUdy_Motions( y_ED%TowerLn2Mesh, u_SrvD%TStCMotionMesh(j), MeshMapData%ED_L_2_TStC_P_T(j), SrvD_Start, ED_Out_Start, dUdy, .false.) + ED_Out_Start = Indx_y_ED_Tower_Start(p_ED, y_ED, y_FAST) ! start of %TranslationDisp field + call Assemble_dUdy_Motions( y_ED%TowerLn2Mesh, u_SrvD%TStCMotionMesh(j), MeshMapData%ED_L_2_TStC_P_T(j), SrvD_Start, ED_Out_Start, dUdy) endif enddo endif @@ -3117,8 +2940,8 @@ SUBROUTINE Linear_SrvD_InputSolve_dy( p_FAST, y_FAST, p_SrvD, u_SrvD, y_ED, BD, do j=1,size(u_SrvD%SStCMotionMesh) if (u_SrvD%SStCMotionMesh(j)%Committed) then SrvD_Start = y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) - 1 + (p_SrvD%Jac_Idx_SStC_u(1,j)) - ED_Out_Start = Indx_y_ED_Platform_Start(y_ED, y_FAST) ! start of %TranslationDisp field - call Assemble_dUdy_Motions( y_ED%PlatformPtMesh, u_SrvD%SStCMotionMesh(j), MeshMapData%ED_P_2_SStC_P_P(j), SrvD_Start, ED_Out_Start, dUdy, .false.) + ED_Out_Start = Indx_y_ED_Platform_Start(p_ED, y_ED, y_FAST) ! start of %TranslationDisp field + call Assemble_dUdy_Motions( y_ED%PlatformPtMesh, u_SrvD%SStCMotionMesh(j), MeshMapData%Substructure_2_SStC_P_P(j), SrvD_Start, ED_Out_Start, dUdy) endif enddo endif @@ -3131,7 +2954,7 @@ SUBROUTINE Linear_SrvD_InputSolve_dy( p_FAST, y_FAST, p_SrvD, u_SrvD, y_ED, BD, if (u_SrvD%SStCMotionMesh(j)%Committed) then SrvD_Start = y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) - 1 + (p_SrvD%Jac_Idx_SStC_u(1,j)) SD_Out_Start = Indx_y_SD_Y3Mesh_Start(y_SD, y_FAST) ! start of %TranslationDisp field - call Assemble_dUdy_Motions( y_SD%y3Mesh, u_SrvD%SStCMotionMesh(j), MeshMapData%SDy3_P_2_SStC_P_P(j), SrvD_Start, SD_Out_Start, dUdy, .false.) + call Assemble_dUdy_Motions( y_SD%y3Mesh, u_SrvD%SStCMotionMesh(j), MeshMapData%SubStructure_2_SStC_P_P(j), SrvD_Start, SD_Out_Start, dUdy) endif enddo endif @@ -3143,15 +2966,16 @@ END SUBROUTINE Linear_SrvD_InputSolve_dy !---------------------------------------------------------------------------------------------------------------------------------- !> This routine forms the dU^{ED}/dy^{SrvD}, dU^{ED}/dy^{ED}, dU^{ED}/dy^{BD}, dU^{ED}/dy^{AD}, dU^{ED}/dy^{HD}, and dU^{ED}/dy^{MAP} !! blocks of dUdy. (i.e., how do changes in the SrvD, ED, BD, AD, HD, and MAP outputs effect the ED inputs?) -SUBROUTINE Linear_ED_InputSolve_dy( p_FAST, y_FAST, SrvD, u_ED, y_ED, y_AD, u_AD, BD, HD, SD, MAPp, MD, MeshMapData, dUdy, ErrStat, ErrMsg ) - +SUBROUTINE Linear_ED_InputSolve_dy( p_FAST, y_FAST, SrvD, p_ED, u_ED, y_ED, p_AD, u_AD, y_AD, BD, HD, SD, MAPp, MD, MeshMapData, dUdy, ErrStat, ErrMsg ) TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Glue-code simulation parameters TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) type(ServoDyn_Data), intent(in ) :: SrvD !< SrvD parameters TYPE(ED_InputType), INTENT(INOUT) :: u_ED !< ED Inputs at t + TYPE(ED_ParameterType), INTENT(IN ) :: p_ED !< ElastoDyn parameters TYPE(ED_OutputType), INTENT(IN ) :: y_ED !< ElastoDyn outputs (need translation displacement on meshes for loads mapping) - TYPE(AD_OutputType), INTENT(IN ) :: y_AD !< AeroDyn outputs + TYPE(AD_ParameterType), INTENT(IN ) :: p_AD !< AeroDyn outputs TYPE(AD_InputType), INTENT(INOUT) :: u_AD !< AD inputs (for AD-ED load linerization) + TYPE(AD_OutputType), INTENT(IN ) :: y_AD !< AeroDyn outputs TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BD data at t TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HD data at t TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SD data at t @@ -3169,6 +2993,7 @@ SUBROUTINE Linear_ED_InputSolve_dy( p_FAST, y_FAST, SrvD, u_ED, y_ED, y_AD, u_AD INTEGER(IntKi) :: K ! Loops through blades INTEGER(IntKi) :: SrvD_Out_Start ! starting index of dUdy (column) where the StC motion inputs are located INTEGER(IntKi) :: AD_Out_Start ! starting index of dUdy (column) where particular AD fields are located + INTEGER(IntKi) :: AD_Block_Start ! starting index of dUdy (column) for all AD outputs INTEGER(IntKi) :: BD_Out_Start ! starting index of dUdy (column) where particular BD fields are located INTEGER(IntKi) :: ED_Start ! starting index of dUdy (row) where ED input fields are located INTEGER(IntKi) :: ED_Out_Start ! starting index of dUdy (column) where ED output fields are located @@ -3191,7 +3016,7 @@ SUBROUTINE Linear_ED_InputSolve_dy( p_FAST, y_FAST, SrvD, u_ED, y_ED, y_AD, u_AD IF ( p_FAST%CompServo == Module_SrvD ) THEN ! BlPitchCom, YawMom, GenTrq - ED_Start = Indx_u_ED_BlPitchCom_Start(u_ED, y_FAST) + ED_Start = Indx_u_ED_BlPitchCom_Start(p_ED, u_ED, y_FAST) do i=1,size(u_ED%BlPitchCom)+2 ! BlPitchCom, YawMom, GenTrq (NOT collective pitch) dUdy(ED_Start + i - 1, y_FAST%Lin%Modules(Module_SrvD)%Instance(1)%LinStartIndx(LIN_OUTPUT_COL) + i - 1) = -1.0_ReKi !SrvD_Indx_Y_BlPitchCom end do @@ -3202,13 +3027,13 @@ SUBROUTINE Linear_ED_InputSolve_dy( p_FAST, y_FAST, SrvD, u_ED, y_ED, y_AD, u_AD do j=1,size(SrvD%y%BStCLoadMesh,2) do K = 1,SIZE(u_ED%BladePtLoads,1) ! Loop through all blades (p_ED%NumBl) if (SrvD%y%BStCLoadMesh(K,j)%Committed) then - ED_Start = Indx_u_ED_Blade_Start(u_ED, y_FAST, k) ! start of u_ED%BladePtLoads(k)%Force field + ED_Start = Indx_u_ED_Blade_Start(p_ED, u_ED, y_FAST, k) ! start of u_ED%BladePtLoads(k)%Force field SrvD_Out_Start = y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) - 1 + SrvD%p%Jac_Idx_BStC_y(1,k,j) call Assemble_dUdy_Loads(SrvD%y%BStCLoadMesh(k,j), u_ED%BladePtLoads(k), MeshMapData%BStC_P_2_ED_P_B(k,j), ED_Start, SrvD_Out_Start, dUdy) ! ED translation displacement-to-ED moment transfer (dU^{ED}/dy^{ED}): - ED_Start = Indx_u_ED_Blade_Start(u_ED, y_FAST, k) + u_ED%BladePtLoads(k)%NNodes*3 ! start of u_ED%BladePtLoads(k)%Moment field (skip the ED forces) - ED_Out_Start = Indx_y_ED_Blade_Start(y_ED, y_FAST, k) ! start of y_ED%BladeLn2Mesh(1)%TranslationDisp field + ED_Start = Indx_u_ED_Blade_Start(p_ED, u_ED, y_FAST, k) + u_ED%BladePtLoads(k)%NNodes*3 ! start of u_ED%BladePtLoads(k)%Moment field (skip the ED forces) + ED_Out_Start = Indx_y_ED_Blade_Start(p_ED, y_ED, y_FAST, k) ! start of y_ED%BladeLn2Mesh(1)%TranslationDisp field call SumBlockMatrix( dUdy, MeshMapData%BStC_P_2_ED_P_B(k,j)%dM%m_uD, ED_Start, ED_Out_Start ) endif enddo @@ -3220,13 +3045,13 @@ SUBROUTINE Linear_ED_InputSolve_dy( p_FAST, y_FAST, SrvD, u_ED, y_ED, y_AD, u_AD if ( allocated(SrvD%y%NStCLoadMesh) ) then do j = 1,size(SrvD%y%NStCLoadMesh) if (SrvD%y%NStCLoadMesh(j)%Committed) then - ED_Start = Indx_u_ED_Nacelle_Start(u_ED, y_FAST) + ED_Start = Indx_u_ED_Nacelle_Start(p_ED, u_ED, y_FAST) SrvD_Out_Start = y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) - 1 + SrvD%p%Jac_Idx_NStC_y(1,j) call Assemble_dUdy_Loads(SrvD%y%NStCLoadMesh(j), u_ED%NacelleLoads, MeshMapData%NStC_P_2_ED_P_N(j), ED_Start, SrvD_Out_Start, dUdy) ! ED translation displacement-to-ED moment transfer (dU^{ED}/dy^{ED}): - ED_Start = Indx_u_ED_Nacelle_Start(u_ED, y_FAST) + u_ED%NacelleLoads%NNodes*3 ! start of u_ED%NacelleLoads%Moment field (skip the ED forces) - ED_Out_Start = Indx_y_ED_Nacelle_Start(y_ED, y_FAST) ! start of y_ED%NacelleMotion%TranslationDisp field + ED_Start = Indx_u_ED_Nacelle_Start(p_ED, u_ED, y_FAST) + u_ED%NacelleLoads%NNodes*3 ! start of u_ED%NacelleLoads%Moment field (skip the ED forces) + ED_Out_Start = Indx_y_ED_Nacelle_Start(p_ED, y_ED, y_FAST) ! start of y_ED%NacelleMotion%TranslationDisp field call SumBlockMatrix( dUdy, MeshMapData%NStC_P_2_ED_P_N(j)%dM%m_uD, ED_Start, ED_Out_Start ) endif enddo @@ -3236,13 +3061,13 @@ SUBROUTINE Linear_ED_InputSolve_dy( p_FAST, y_FAST, SrvD, u_ED, y_ED, y_AD, u_AD if ( allocated(SrvD%y%TStCLoadMesh) ) then do j = 1,size(SrvD%y%TStCLoadMesh) if (SrvD%y%TStCLoadMesh(j)%Committed) then - ED_Start = Indx_u_ED_Tower_Start(u_ED, y_FAST) + ED_Start = Indx_u_ED_Tower_Start(p_ED, u_ED, y_FAST) SrvD_Out_Start = y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) - 1 + SrvD%p%Jac_Idx_TStC_y(1,j) call Assemble_dUdy_Loads(SrvD%y%TStCLoadMesh(j), u_ED%TowerPtLoads, MeshMapData%TStC_P_2_ED_P_T(j), ED_Start, SrvD_Out_Start, dUdy) ! ED translation displacement-to-ED moment transfer (dU^{ED}/dy^{ED}): - ED_Start = Indx_u_ED_Tower_Start(u_ED, y_FAST) + u_ED%TowerPtLoads%NNodes*3 ! start of u_ED%TowerPtLoads%Moment field [skip the ED forces to get to the moments] - ED_Out_Start = Indx_y_ED_Tower_Start(y_ED, y_FAST) ! start of y_ED%TowerLn2Mesh%TranslationDisp field + ED_Start = Indx_u_ED_Tower_Start(p_ED, u_ED, y_FAST) + u_ED%TowerPtLoads%NNodes*3 ! start of u_ED%TowerPtLoads%Moment field [skip the ED forces to get to the moments] + ED_Out_Start = Indx_y_ED_Tower_Start(p_ED, y_ED, y_FAST) ! start of y_ED%TowerLn2Mesh%TranslationDisp field call SumBlockMatrix( dUdy, MeshMapData%TStC_P_2_ED_P_T(j)%dM%m_uD, ED_Start, ED_Out_Start ) endif enddo @@ -3253,14 +3078,14 @@ SUBROUTINE Linear_ED_InputSolve_dy( p_FAST, y_FAST, SrvD, u_ED, y_ED, y_AD, u_AD if ( allocated(SrvD%y%SStCLoadMesh) ) then do j=1,size(SrvD%y%SStCLoadMesh) if (SrvD%y%SStCLoadMesh(j)%Committed) then - ED_Start = Indx_u_ED_Platform_Start(u_ED, y_FAST) + ED_Start = Indx_u_ED_Platform_Start(p_ED, u_ED, y_FAST) SrvD_Out_Start = y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) - 1 + SrvD%p%Jac_Idx_SStC_y(1,j) - call Assemble_dUdy_Loads(SrvD%y%SStCLoadMesh(j), u_ED%PlatformPtMesh, MeshMapData%SStC_P_P_2_ED_P(j), ED_Start, SrvD_Out_Start, dUdy) + call Assemble_dUdy_Loads(SrvD%y%SStCLoadMesh(j), u_ED%PlatformPtMesh, MeshMapData%SStC_P_P_2_SubStructure(j), ED_Start, SrvD_Out_Start, dUdy) ! ED translation displacement-to-ED moment transfer (dU^{ED}/dy^{ED}): - ED_Start = Indx_u_ED_Platform_Start(u_ED, y_FAST) + u_ED%PlatformPtMesh%NNodes*3 ! start of u_ED%PlatformPtMesh%Moment field (skip the ED forces) - ED_Out_Start = Indx_y_ED_Platform_Start(y_ED, y_FAST) ! start of y_ED%PlatformPtMesh%TranslationDisp field - call SumBlockMatrix( dUdy, MeshMapData%HD_M_P_2_ED_P%dM%m_uD, ED_Start, ED_Out_Start ) + ED_Start = Indx_u_ED_Platform_Start(p_ED, u_ED, y_FAST) + u_ED%PlatformPtMesh%NNodes*3 ! start of u_ED%PlatformPtMesh%Moment field (skip the ED forces) + ED_Out_Start = Indx_y_ED_Platform_Start(p_ED, y_ED, y_FAST) ! start of y_ED%PlatformPtMesh%TranslationDisp field + call SumBlockMatrix( dUdy, MeshMapData%HD_M_P_2_SubStructure%dM%m_uD, ED_Start, ED_Out_Start ) endif enddo endif @@ -3272,24 +3097,26 @@ SUBROUTINE Linear_ED_InputSolve_dy( p_FAST, y_FAST, SrvD, u_ED, y_ED, y_AD, u_AD ! ElastoDyn inputs on blade from AeroDyn and ElastoDyn IF ( p_FAST%CompAero == Module_AD ) THEN + AD_Block_Start = y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%LinStartIndx(LIN_OUTPUT_COL) + IF (p_FAST%CompElast == Module_ED) THEN - AD_Out_Start = y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%LinStartIndx(LIN_OUTPUT_COL) + y_AD%rotors(1)%TowerLoad%NNodes * 6 ! start of y_AD%BladeLoad(1)%Force field [2 fields (force, moment) with 3 components] + AD_Out_Start = AD_Block_Start + p_AD%rotors(1)%Jac_y_idxStartList%BladeLoad - 1 DO K = 1,SIZE(u_ED%BladePtLoads,1) ! Loop through all blades (p_ED%NumBl) !!! ! This linearization was done in forming dUdu (see Linear_ED_InputSolve_du()), so we don't need to re-calculate these matrices !!! ! while forming dUdy, too. - !CALL Linearize_Line2_to_Point( y_AD%BladeLoad(k), u_ED%BladePtLoads(k), MeshMapData%AD_L_2_BDED_B(k), ErrStat2, ErrMsg2, u_AD%BladeMotion(k), y_ED%BladeLn2Mesh(k) ) + !CALL Linearize_Line2_to_Point( y_AD%rotors(1)%BladeLoad(k), u_ED%BladePtLoads(k), MeshMapData%AD_L_2_BDED_B(k), ErrStat2, ErrMsg2, u_AD%rotors(1)%BladeMotion(k), y_ED%BladeLn2Mesh(k) ) ! AD loads-to-ED loads transfer (dU^{ED}/dy^{AD}): - ED_Start = Indx_u_ED_Blade_Start(u_ED, y_FAST, k) ! start of u_ED%BladePtLoads(k)%Force field + ED_Start = Indx_u_ED_Blade_Start(p_ED, u_ED, y_FAST, k) call Assemble_dUdy_Loads(y_AD%rotors(1)%BladeLoad(k), u_ED%BladePtLoads(k), MeshMapData%AD_L_2_BDED_B(k), ED_Start, AD_Out_Start, dUdy) ! ED translation displacement-to-ED moment transfer (dU^{ED}/dy^{ED}): - ED_Start = Indx_u_ED_Blade_Start(u_ED, y_FAST, k) + u_ED%BladePtLoads(k)%NNodes*3 ! start of u_ED%BladePtLoads(k)%Moment field (skip the ED forces) - ED_Out_Start = Indx_y_ED_Blade_Start(y_ED, y_FAST, k) ! start of y_ED%BladeLn2Mesh(1)%TranslationDisp field + ED_Start = Indx_u_ED_Blade_Start(p_ED, u_ED, y_FAST, k) + u_ED%BladePtLoads(k)%NNodes*3 ! start of u_ED%BladePtLoads(k)%Moment field (skip the ED forces) + ED_Out_Start = Indx_y_ED_Blade_Start(p_ED, y_ED, y_FAST, k) ! start of y_ED%BladeLn2Mesh(1)%TranslationDisp field call SumBlockMatrix( dUdy, MeshMapData%AD_L_2_BDED_B(k)%dM%m_uD, ED_Start, ED_Out_Start ) - AD_Out_Start = AD_Out_Start + y_AD%rotors(1)%BladeLoad(k)%NNodes*6 ! start of y_AD%BladeLoad(k+1)%Force field [skip 2 fields to forces on next blade] + AD_Out_Start = AD_Out_Start + y_AD%rotors(1)%BladeLoad(k)%NNodes*6 ! start of y_AD%rotors(1)%BladeLoad(k+1)%Force field [skip 2 fields to forces on next blade] END DO END IF ! ED @@ -3297,20 +3124,68 @@ SUBROUTINE Linear_ED_InputSolve_dy( p_FAST, y_FAST, SrvD, u_ED, y_ED, y_AD, u_AD IF ( y_AD%rotors(1)%TowerLoad%Committed ) THEN !!! ! This linearization was done in forming dUdu (see Linear_ED_InputSolve_du()), so we don't need to re-calculate these matrices !!! ! while forming dUdy, too. - !CALL Linearize_Line2_to_Point( y_AD%TowerLoad, u_ED%TowerPtLoads, MeshMapData%AD_L_2_ED_P_T, ErrStat2, ErrMsg2, u_AD%TowerMotion, y_ED%TowerLn2Mesh ) + !CALL Linearize_Line2_to_Point( y_AD%rotors(1)%TowerLoad, u_ED%TowerPtLoads, MeshMapData%AD_L_2_ED_P_T, ErrStat2, ErrMsg2, u_AD%rotors(1)%TowerMotion, y_ED%TowerLn2Mesh ) ! AD loads-to-ED loads transfer (dU^{ED}/dy^{AD}): - ED_Start = Indx_u_ED_Tower_Start(u_ED, y_FAST) ! u_ED%TowerPtLoads%Force field - AD_Out_Start = y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%LinStartIndx(LIN_OUTPUT_COL) ! start of y_AD%Tower%Force + ED_Start = Indx_u_ED_Tower_Start(p_ED, u_ED, y_FAST) ! u_ED%TowerPtLoads%Force field + AD_Out_Start = AD_Block_Start + p_AD%rotors(1)%Jac_y_idxStartList%TowerLoad - 1 call Assemble_dUdy_Loads(y_AD%rotors(1)%TowerLoad, u_ED%TowerPtLoads, MeshMapData%AD_L_2_ED_P_T, ED_Start, AD_Out_Start, dUdy) ! ED translation displacement-to-ED moment transfer (dU^{ED}/dy^{ED}): ED_Start = ED_Start + u_ED%TowerPtLoads%NNodes*3 ! start of u_ED%TowerPtLoads%Moment field [skip the ED forces to get to the moments] - ED_Out_Start = Indx_y_ED_Tower_Start(y_ED, y_FAST) ! start of y_ED%TowerLn2Mesh%TranslationDisp field + ED_Out_Start = Indx_y_ED_Tower_Start(p_ED, y_ED, y_FAST) ! start of y_ED%TowerLn2Mesh%TranslationDisp field call SumBlockMatrix( dUdy, MeshMapData%AD_L_2_ED_P_T%dM%m_uD, ED_Start, ED_Out_Start ) END IF ! tower - + + IF ( y_AD%rotors(1)%TFinLoad%Committed ) THEN + !!! ! This linearization was done in forming dUdu (see Linear_ED_InputSolve_du()), so we don't need to re-calculate these matrices + !!! ! while forming dUdy, too. + !CALL Linearize_Line2_to_Point( y_AD%rotors(1)%TFinLoad, u_ED%TFinCMLoads, MeshMapData%AD_L_2_ED_P_TF, ErrStat2, ErrMsg2, u_AD%rotors(1)%TFinMotion, y_ED%TFinCMMotion ) + + ! AD loads-to-ED loads transfer (dU^{ED}/dy^{AD}): + ED_Start = Indx_u_ED_TFin_Start(p_ED, u_ED, y_FAST) ! u_ED%TFinCMLoads%Force field + AD_Out_Start = AD_Block_Start + p_AD%rotors(1)%Jac_y_idxStartList%TFinLoad - 1 + call Assemble_dUdy_Loads(y_AD%rotors(1)%TFinLoad, u_ED%TFinCMLoads, MeshMapData%AD_P_2_ED_P_TF, ED_Start, AD_Out_Start, dUdy) + + ! ED translation displacement-to-ED moment transfer (dU^{ED}/dy^{ED}): + ED_Start = ED_Start + u_ED%TFinCMLoads%NNodes*3 ! start of u_ED%TFinCMLoads%Moment field [skip the ED forces to get to the moments] + ED_Out_Start = Indx_y_ED_TFin_Start(p_ED, y_ED, y_FAST) ! start of y_ED%TFinCMMotion%TranslationDisp field + call SumBlockMatrix( dUdy, MeshMapData%AD_P_2_ED_P_TF%dM%m_uD, ED_Start, ED_Out_Start ) + END IF ! tailfin + + IF ( y_AD%rotors(1)%NacelleLoad%Committed ) THEN + !!! ! This linearization was done in forming dUdu (see Linear_ED_InputSolve_du()), so we don't need to re-calculate these matrices + !!! ! while forming dUdy, too. + !CALL Linearize_Point_to_Point( y_AD%rotors(1)%NacelleLoad, u_ED%NacelleLoads, MeshMapData%AD_L_2_ED_P_N, ErrStat2, ErrMsg2, u_AD%rotors(1)%NacelleMotion, y_ED%NacelleMotion ) + + ! AD loads-to-ED loads transfer (dU^{ED}/dy^{AD}): + ED_Start = Indx_u_ED_Nacelle_Start(p_ED, u_ED, y_FAST) ! u_ED%NacelleLoads%Force field + AD_Out_Start = AD_Block_Start + p_AD%rotors(1)%Jac_y_idxStartList%NacelleLoad - 1 + call Assemble_dUdy_Loads(y_AD%rotors(1)%NacelleLoad, u_ED%NacelleLoads, MeshMapData%AD_P_2_ED_P_N, ED_Start, AD_Out_Start, dUdy) + + ! ED translation displacement-to-ED moment transfer (dU^{ED}/dy^{ED}): + ED_Start = ED_Start + u_ED%NacelleLoads%NNodes*3 ! start of u_ED%NacelleLoads%Moment field [skip the ED forces to get to the moments] + ED_Out_Start = Indx_y_ED_Nacelle_Start(p_ED, y_ED, y_FAST) ! start of y_ED%NacelleMotion%TranslationDisp field + call SumBlockMatrix( dUdy, MeshMapData%AD_P_2_ED_P_N%dM%m_uD, ED_Start, ED_Out_Start ) + END IF ! nacelle + + IF ( y_AD%rotors(1)%HubLoad%Committed ) THEN + !!! ! This linearization was done in forming dUdu (see Linear_ED_InputSolve_du()), so we don't need to re-calculate these matrices + !!! ! while forming dUdy, too. + !CALL Linearize_Point_to_Point( y_AD%rotors(1)%HubLoad, u_ED%HubLoads, MeshMapData%AD_L_2_ED_P_H, ErrStat2, ErrMsg2, u_AD%rotors(1)%HubMotion, y_ED%HubMotion ) + + ! AD loads-to-ED loads transfer (dU^{ED}/dy^{AD}): + ED_Start = Indx_u_ED_Hub_Start(p_ED, u_ED, y_FAST) ! u_ED%HubLoads%Force field + AD_Out_Start = AD_Block_Start + p_AD%rotors(1)%Jac_y_idxStartList%HubLoad - 1 + call Assemble_dUdy_Loads(y_AD%rotors(1)%HubLoad, u_ED%HubPtLoad, MeshMapData%AD_P_2_ED_P_H, ED_Start, AD_Out_Start, dUdy) + + ! ED translation displacement-to-ED moment transfer (dU^{ED}/dy^{ED}): + ED_Start = ED_Start + u_ED%HubPtLoad%NNodes*3 ! start of u_ED%HubLoads%Moment field [skip the ED forces to get to the moments] + ED_Out_Start = Indx_y_ED_Hub_Start(p_ED, y_ED, y_FAST) ! start of y_ED%HubMotion%TranslationDisp field + call SumBlockMatrix( dUdy, MeshMapData%AD_P_2_ED_P_H%dM%m_uD, ED_Start, ED_Out_Start ) + END IF ! hub + END IF ! aero loads ! U_ED_SD_HD_BD_Orca_Residual() in InputSolve Option 1 @@ -3323,51 +3198,51 @@ SUBROUTINE Linear_ED_InputSolve_dy( p_FAST, y_FAST, SrvD, u_ED, y_ED, y_AD, u_AD !!!END DO ! BD Reaction force-to-ED force transfer (dU^{ED}/dy^{BD}) from BD root-to-ED hub load transfer: - ED_Start = Indx_u_ED_Hub_Start(u_ED, y_FAST) ! start of u_ED%HubPtLoad%Force field + ED_Start = Indx_u_ED_Hub_Start(p_ED, u_ED, y_FAST) ! start of u_ED%HubPtLoad%Force field DO k=1,p_FAST%nBeams BD_Out_Start = y_FAST%Lin%Modules(MODULE_BD)%Instance(k)%LinStartIndx(LIN_OUTPUT_COL) ! BD%y(k)%ReactionForce%Force field call Assemble_dUdy_Loads(BD%y(k)%ReactionForce, u_ED%HubPtLoad, MeshMapData%BD_P_2_ED_P(k), ED_Start, BD_Out_Start, dUdy) END DO ! ED translation displacement-to-ED moment transfer (dU^{ED}/dy^{ED}) from BD root-to-ED hub load transfer: - ED_Start = Indx_u_ED_Hub_Start(u_ED, y_FAST) + u_ED%HubPtLoad%NNodes*3 ! start of u_ED%HubPtLoad%Moment field (skip forces) - ED_Out_Start = Indx_y_ED_Hub_Start(y_ED, y_FAST) ! start of y_ED%HubMotion%TranslationDisp field + ED_Start = Indx_u_ED_Hub_Start(p_ED, u_ED, y_FAST) + u_ED%HubPtLoad%NNodes*3 ! start of u_ED%HubPtLoad%Moment field (skip forces) + ED_Out_Start = Indx_y_ED_Hub_Start(p_ED, y_ED, y_FAST) ! start of y_ED%HubMotion%TranslationDisp field DO k=1,p_FAST%nBeams call SumBlockMatrix( dUdy, MeshMapData%BD_P_2_ED_P(k)%dM%m_ud, ED_Start, ED_Out_Start) END DO END IF - if ( p_FAST%CompSub == Module_None ) then + if ( p_FAST%CompSub == Module_None ) then !This also occurs with ExtPtfm (though that's not linearized, yet) ! HD ! parts of dU^{ED}/dy^{HD} and dU^{ED}/dy^{ED}: if ( p_FAST%CompHydro == Module_HD ) then ! HydroDyn-{ElastoDyn or SubDyn} - ED_Out_Start = Indx_y_ED_Platform_Start(y_ED, y_FAST) ! start of y_ED%PlatformPtMesh%TranslationDisp field + ED_Out_Start = Indx_y_ED_Platform_Start(p_ED, y_ED, y_FAST) ! start of y_ED%PlatformPtMesh%TranslationDisp field ! we're just going to assume u_ED%PlatformPtMesh is committed if ( HD%y%Morison%Mesh%Committed ) then ! meshes for floating !!! ! This linearization was done in forming dUdu (see Linear_ED_InputSolve_du()), so we don't need to re-calculate these matrices !!! ! while forming dUdy, too. - ! call Linearize_Point_to_Point( HD%y%Morison, u_ED%PlatformPtMesh, MeshMapData%HD_M_P_2_ED_P, ErrStat2, ErrMsg2, HD%Input(1)%Morison, y_ED%PlatformPtMesh) !HD%Input(1)%Morison and y_ED%PlatformPtMesh contain the displaced positions for load calculations + ! call Linearize_Point_to_Point( HD%y%Morison, u_ED%PlatformPtMesh, MeshMapData%HD_M_P_2_SubStructure, ErrStat2, ErrMsg2, HD%Input(1)%Morison, y_ED%PlatformPtMesh) !HD%Input(1)%Morison and y_ED%PlatformPtMesh contain the displaced positions for load calculations HD_Out_Start = Indx_y_HD_Morison_Start(HD%y, y_FAST) - ED_Start = Indx_u_ED_Platform_Start(u_ED, y_FAST) ! start of u_ED%PlatformPtMesh%Force field - call Assemble_dUdy_Loads(HD%y%Morison%Mesh, u_ED%PlatformPtMesh, MeshMapData%HD_M_P_2_ED_P, ED_Start, HD_Out_Start, dUdy) + ED_Start = Indx_u_ED_Platform_Start(p_ED, u_ED, y_FAST) ! start of u_ED%PlatformPtMesh%Force field + call Assemble_dUdy_Loads(HD%y%Morison%Mesh, u_ED%PlatformPtMesh, MeshMapData%HD_M_P_2_SubStructure, ED_Start, HD_Out_Start, dUdy) ! ED translation displacement-to-ED moment transfer (dU^{ED}/dy^{ED}): - ED_Start = Indx_u_ED_Platform_Start(u_ED, y_FAST) + u_ED%PlatformPtMesh%NNodes*3 ! start of u_ED%PlatformPtMesh%Moment field (skip the ED forces) - call SumBlockMatrix( dUdy, MeshMapData%HD_M_P_2_ED_P%dM%m_uD, ED_Start, ED_Out_Start ) + ED_Start = Indx_u_ED_Platform_Start(p_ED, u_ED, y_FAST) + u_ED%PlatformPtMesh%NNodes*3 ! start of u_ED%PlatformPtMesh%Moment field (skip the ED forces) + call SumBlockMatrix( dUdy, MeshMapData%HD_M_P_2_SubStructure%dM%m_uD, ED_Start, ED_Out_Start ) end if if ( HD%y%WAMITMesh%Committed ) then ! meshes for floating !!! ! This linearization was done in forming dUdu (see Linear_ED_InputSolve_du()), so we don't need to re-calculate these matrices !!! ! while forming dUdy, too. - ! call Linearize_Point_to_Point( HD%y%WAMITMesh, u_ED%PlatformPtMesh, MeshMapData%HD_W_P_2_ED_P, ErrStat2, ErrMsg2, HD%Input(1)%WAMITMesh, y_ED%PlatformPtMesh) !HD%Input(1)%WAMITMesh and y_ED%PlatformPtMesh contain the displaced positions for load calculations + ! call Linearize_Point_to_Point( HD%y%WAMITMesh, u_ED%PlatformPtMesh, MeshMapData%HD_W_P_2_SubStructure, ErrStat2, ErrMsg2, HD%Input(1)%WAMITMesh, y_ED%PlatformPtMesh) !HD%Input(1)%WAMITMesh and y_ED%PlatformPtMesh contain the displaced positions for load calculations HD_Out_Start = Indx_y_HD_WAMIT_Start(HD%y, y_FAST) - ED_Start = Indx_u_ED_Platform_Start(u_ED, y_FAST) ! start of u_ED%PlatformPtMesh%Force field - call Assemble_dUdy_Loads(HD%y%WAMITMesh, u_ED%PlatformPtMesh, MeshMapData%HD_W_P_2_ED_P, ED_Start, HD_Out_Start, dUdy) + ED_Start = Indx_u_ED_Platform_Start(p_ED, u_ED, y_FAST) ! start of u_ED%PlatformPtMesh%Force field + call Assemble_dUdy_Loads(HD%y%WAMITMesh, u_ED%PlatformPtMesh, MeshMapData%HD_W_P_2_SubStructure, ED_Start, HD_Out_Start, dUdy) ! ED translation displacement-to-ED moment transfer (dU^{ED}/dy^{ED}): - ED_Start = Indx_u_ED_Platform_Start(u_ED, y_FAST) + u_ED%PlatformPtMesh%NNodes*3 ! start of u_ED%PlatformPtMesh%Moment field (skip the ED forces) - call SumBlockMatrix( dUdy, MeshMapData%HD_W_P_2_ED_P%dM%m_uD, ED_Start, ED_Out_Start ) + ED_Start = Indx_u_ED_Platform_Start(p_ED, u_ED, y_FAST) + u_ED%PlatformPtMesh%NNodes*3 ! start of u_ED%PlatformPtMesh%Moment field (skip the ED forces) + call SumBlockMatrix( dUdy, MeshMapData%HD_W_P_2_SubStructure%dM%m_uD, ED_Start, ED_Out_Start ) end if @@ -3380,15 +3255,15 @@ SUBROUTINE Linear_ED_InputSolve_dy( p_FAST, y_FAST, SrvD, u_ED, y_ED, y_AD, u_AD if ( MAPp%y%ptFairleadLoad%Committed ) then ! meshes for floating !!! ! This linearization was done in forming dUdu (see Linear_ED_InputSolve_du()), so we don't need to re-calculate these matrices !!! ! while forming dUdy, too. - ! CALL Linearize_Point_to_Point( MAPp%y%ptFairleadLoad, u_ED%PlatformPtMesh, MeshMapData%Mooring_P_2_ED_P, ErrStat2, ErrMsg2, MAPp%Input(1)%PtFairDisplacement, y_ED%PlatformPtMesh) !MAPp%Input(1)%ptFairleadLoad and y_ED%PlatformPtMesh contain the displaced positions for load calculations + ! CALL Linearize_Point_to_Point( MAPp%y%ptFairleadLoad, u_ED%PlatformPtMesh, MeshMapData%Mooring_2_Structure, ErrStat2, ErrMsg2, MAPp%Input(1)%PtFairDisplacement, y_ED%PlatformPtMesh) !MAPp%Input(1)%ptFairleadLoad and y_ED%PlatformPtMesh contain the displaced positions for load calculations MAP_Out_Start = y_FAST%Lin%Modules(MODULE_MAP)%Instance(1)%LinStartIndx(LIN_OUTPUT_COL) - ED_Start = Indx_u_ED_Platform_Start(u_ED, y_FAST) ! start of u_ED%PlatformPtMesh%TranslationDisp field - call Assemble_dUdy_Loads(MAPp%y%ptFairLeadLoad, u_ED%PlatformPtMesh, MeshMapData%Mooring_P_2_ED_P, ED_Start, MAP_Out_Start, dUdy) + ED_Start = Indx_u_ED_Platform_Start(p_ED, u_ED, y_FAST) ! start of u_ED%PlatformPtMesh%Force field + call Assemble_dUdy_Loads(MAPp%y%ptFairLeadLoad, u_ED%PlatformPtMesh, MeshMapData%Mooring_2_Structure, ED_Start, MAP_Out_Start, dUdy) ! ED translation displacement-to-ED moment transfer (dU^{ED}/dy^{ED}): - ED_Start = Indx_u_ED_Platform_Start(u_ED, y_FAST) + u_ED%PlatformPtMesh%NNodes*3 ! start of u_ED%PlatformPtMesh%Moment field (skip the ED forces) - ED_Out_Start = Indx_y_ED_Platform_Start(y_ED, y_FAST) ! start of y_ED%PlatformPtMesh%TranslationDisp field - call SumBlockMatrix( dUdy, MeshMapData%Mooring_P_2_ED_P%dM%m_uD, ED_Start, ED_Out_Start ) + ED_Start = Indx_u_ED_Platform_Start(p_ED, u_ED, y_FAST) + u_ED%PlatformPtMesh%NNodes*3 ! start of u_ED%PlatformPtMesh%Moment field (skip the ED forces) + ED_Out_Start = Indx_y_ED_Platform_Start(p_ED, y_ED, y_FAST) ! start of y_ED%PlatformPtMesh%TranslationDisp field + call SumBlockMatrix( dUdy, MeshMapData%Mooring_2_Structure%dM%m_uD, ED_Start, ED_Out_Start ) end if ! MoorDyn ! parts of dU^{ED}/dy^{MD} and dU^{ED}/dy^{ED}: @@ -3397,13 +3272,13 @@ SUBROUTINE Linear_ED_InputSolve_dy( p_FAST, y_FAST, SrvD, u_ED, y_ED, y_AD, u_AD !!! ! This linearization was done in forming dUdu (see Linear_ED_InputSolve_du()), so we don't need to re-calculate these matrices !!! ! while forming dUdy, too. MD_Out_Start = y_FAST%Lin%Modules(Module_MD)%Instance(1)%LinStartIndx(LIN_OUTPUT_COL) - ED_Start = Indx_u_ED_Platform_Start(u_ED, y_FAST) ! start of u_ED%PlatformPtMesh%TranslationDisp field - call Assemble_dUdy_Loads(MD%y%CoupledLoads(1), u_ED%PlatformPtMesh, MeshMapData%Mooring_P_2_ED_P, ED_Start, MD_Out_Start, dUdy) + ED_Start = Indx_u_ED_Platform_Start(p_ED, u_ED, y_FAST) ! start of u_ED%PlatformPtMesh%Force field + call Assemble_dUdy_Loads(MD%y%CoupledLoads(1), u_ED%PlatformPtMesh, MeshMapData%Mooring_2_Structure, ED_Start, MD_Out_Start, dUdy) ! ED translation displacement-to-ED moment transfer (dU^{ED}/dy^{ED}): - ED_Start = Indx_u_ED_Platform_Start(u_ED, y_FAST) + u_ED%PlatformPtMesh%NNodes*3 ! start of u_ED%PlatformPtMesh%Moment field (skip the ED forces) - ED_Out_Start = Indx_y_ED_Platform_Start(y_ED, y_FAST) ! start of y_ED%PlatformPtMesh%TranslationDisp field - call SumBlockMatrix( dUdy, MeshMapData%Mooring_P_2_ED_P%dM%m_uD, ED_Start, ED_Out_Start ) + ED_Start = Indx_u_ED_Platform_Start(p_ED, u_ED, y_FAST) + u_ED%PlatformPtMesh%NNodes*3 ! start of u_ED%PlatformPtMesh%Moment field (skip the ED forces) + ED_Out_Start = Indx_y_ED_Platform_Start(p_ED, y_ED, y_FAST) ! start of y_ED%PlatformPtMesh%TranslationDisp field + call SumBlockMatrix( dUdy, MeshMapData%Mooring_2_Structure%dM%m_uD, ED_Start, ED_Out_Start ) end if end if else if ( p_FAST%CompSub == Module_SD ) then @@ -3413,27 +3288,30 @@ SUBROUTINE Linear_ED_InputSolve_dy( p_FAST, y_FAST, SrvD, u_ED, y_ED, y_AD, u_AD !!! ! while forming dUdy, too. ! CALL Linearize_Point_to_Point( SD%y%Y1Mesh, u_ED%PlatformPtMesh, MeshMapData%SD_TP_2_ED_P, ErrStat2, ErrMsg2, SD%Input(1)%TPMesh, y_ED%PlatformPtMesh) !SD%Input(1)%TPMesh and y_ED%PlatformPtMesh contain the displaced positions for load calculations SD_Out_Start = y_FAST%Lin%Modules(MODULE_SD)%Instance(1)%LinStartIndx(LIN_OUTPUT_COL) - ED_Start = Indx_u_ED_Platform_Start(u_ED, y_FAST) ! start of u_ED%PlatformPtMesh%TranslationDisp field + ED_Start = Indx_u_ED_Platform_Start(p_ED, u_ED, y_FAST) ! start of u_ED%PlatformPtMesh%Force field call Assemble_dUdy_Loads(SD%y%Y1Mesh, u_ED%PlatformPtMesh, MeshMapData%SD_TP_2_ED_P, ED_Start, SD_Out_Start, dUdy) ! ED translation displacement-to-ED moment transfer (dU^{ED}/dy^{ED}): - ED_Start = Indx_u_ED_Platform_Start(u_ED, y_FAST) + u_ED%PlatformPtMesh%NNodes*3 ! start of u_ED%PlatformPtMesh%Moment field (skip the ED forces) - ED_Out_Start = Indx_y_ED_Platform_Start(y_ED, y_FAST) ! start of y_ED%PlatformPtMesh%TranslationDisp field + ED_Start = Indx_u_ED_Platform_Start(p_ED, u_ED, y_FAST) + u_ED%PlatformPtMesh%NNodes*3 ! start of u_ED%PlatformPtMesh%Moment field (skip the ED forces) + ED_Out_Start = Indx_y_ED_Platform_Start(p_ED, y_ED, y_FAST) ! start of y_ED%PlatformPtMesh%TranslationDisp field call SetBlockMatrix( dUdy, MeshMapData%SD_TP_2_ED_P%dM%m_uD, ED_Start, ED_Out_Start ) + + !Mooring gets set in the Linear_SD_InputSolve_ routines end if END SUBROUTINE Linear_ED_InputSolve_dy !---------------------------------------------------------------------------------------------------------------------------------- !> This routine forms the dU^{BD}/dy^{ED}, dU^{BD}/dy^{BD}, and dU^{BD}/dy^{AD} blocks of dUdy. (i.e., how do !! changes in the ED, BD, and AD outputs effect the BD inputs?) -SUBROUTINE Linear_BD_InputSolve_dy( p_FAST, y_FAST, SrvD, u_ED, y_ED, y_AD, u_AD, BD, MeshMapData, dUdy, ErrStat, ErrMsg ) - +SUBROUTINE Linear_BD_InputSolve_dy( p_FAST, y_FAST, SrvD, p_ED, u_ED, y_ED, p_AD, u_AD, y_AD, BD, MeshMapData, dUdy, ErrStat, ErrMsg ) TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Glue-code simulation parameters TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) type(ServoDyn_Data), intent(in ) :: SrvD !< SrvD parameters + TYPE(ED_ParameterType), INTENT(IN ) :: p_ED !< ElastoDyn parameters TYPE(ED_InputType), INTENT(INOUT) :: u_ED !< ED Inputs at t TYPE(ED_OutputType), INTENT(IN ) :: y_ED !< ElastoDyn outputs (need translation displacement on meshes for loads mapping) - TYPE(AD_OutputType), INTENT(IN ) :: y_AD !< AeroDyn outputs + TYPE(AD_ParameterType), INTENT(IN ) :: p_AD !< AeroDyn parameters TYPE(AD_InputType), INTENT(INOUT) :: u_AD !< AD inputs (for AD-ED load linearization) + TYPE(AD_OutputType), INTENT(IN ) :: y_AD !< AeroDyn outputs TYPE(BeamDyn_Data), INTENT(IN ) :: BD !< BD data at t TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules @@ -3491,13 +3369,12 @@ SUBROUTINE Linear_BD_InputSolve_dy( p_FAST, y_FAST, SrvD, u_ED, y_ED, y_AD, u_AD !!! ! This linearization was done in forming dUdu (see Linear_BD_InputSolve_du()), so we don't need to re-calculate these matrices !!! ! while forming dUdy, too. !!!if (p_FAST%BD_OutputSibling) then - !!! CALL Linearize_Line2_to_Line2( y_AD%BladeLoad(k), BD%Input(1,k)%DistrLoad, MeshMapData%AD_L_2_BDED_B(k), ErrStat2, ErrMsg2, u_AD%BladeMotion(k), BD%y(k)%BldMotion ) + !!! CALL Linearize_Line2_to_Line2( y_AD%rotors(1)%BladeLoad(k), BD%Input(1,k)%DistrLoad, MeshMapData%AD_L_2_BDED_B(k), ErrStat2, ErrMsg2, u_AD%rotors(1)%BladeMotion(k), BD%y(k)%BldMotion ) !!!else !!! CALL Linearize_Line2_to_Line2( BD%y(k)%BldMotion, MeshMapData%y_BD_BldMotion_4Loads(k), MeshMapData%BD_L_2_BD_L(k), ErrStat2, ErrMsg2 ) - !!! CALL Linearize_Line2_to_Line2( y_AD%BladeLoad(k), BD%Input(1,k)%DistrLoad, MeshMapData%AD_L_2_BDED_B(k), ErrStat2, ErrMsg2, u_AD%BladeMotion(k), MeshMapData%y_BD_BldMotion_4Loads(k) ) + !!! CALL Linearize_Line2_to_Line2( y_AD%rotors(1)%BladeLoad(k), BD%Input(1,k)%DistrLoad, MeshMapData%AD_L_2_BDED_B(k), ErrStat2, ErrMsg2, u_AD%rotors(1)%BladeMotion(k), MeshMapData%y_BD_BldMotion_4Loads(k) ) !!!end if - - AD_Out_Start = y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%LinStartIndx(LIN_OUTPUT_COL) + y_AD%rotors(1)%TowerLoad%NNodes * 6 ! start of y_AD%BladeLoad(1)%Force field [2 fields (force, moment) with 3 components] + AD_Out_Start = y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%LinStartIndx(LIN_OUTPUT_COL) + p_AD%rotors(1)%Jac_y_idxStartList%BladeLoad - 1 DO K = 1,p_FAST%nBeams ! Loop through all blades BD_Start = y_FAST%Lin%Modules(MODULE_BD)%Instance(k)%LinStartIndx(LIN_INPUT_COL) & ! start of BD%Input(1,k)%DistrLoad%Force field @@ -3506,7 +3383,7 @@ SUBROUTINE Linear_BD_InputSolve_dy( p_FAST, y_FAST, SrvD, u_ED, y_ED, y_AD, u_AD ! AD loads-to-BD loads transfer (dU^{BD}/dy^{AD}): call Assemble_dUdy_Loads(y_AD%rotors(1)%BladeLoad(k), BD%Input(1,k)%DistrLoad, MeshMapData%AD_L_2_BDED_B(k), BD_Start, AD_Out_Start, dUdy) - AD_Out_Start = AD_Out_Start + y_AD%rotors(1)%BladeLoad(k)%NNodes*6 ! start of y_AD%BladeLoad(k+1)%Force field [skip the moments to get to forces on next blade] + AD_Out_Start = AD_Out_Start + y_AD%rotors(1)%BladeLoad(k)%NNodes*6 ! start of y_AD%rotors(1)%BladeLoad(k+1)%Force field [skip the moments to get to forces on next blade] ! BD translation displacement-to-BD moment transfer (dU^{BD}/dy^{BD}): @@ -3546,98 +3423,59 @@ SUBROUTINE Linear_BD_InputSolve_dy( p_FAST, y_FAST, SrvD, u_ED, y_ED, y_AD, u_AD !!!CALL Linearize_Point_to_Point( y_ED%BladeRootMotion(k), BD%Input(1,k)%RootMotion, MeshMapData%ED_P_2_BD_P(k), ErrStat2, ErrMsg2 ) BD_Start = y_FAST%Lin%Modules(MODULE_BD)%Instance(k)%LinStartIndx(LIN_INPUT_COL) ! ! start of BD%Input(1,k)%RootMotion%TranslationDisp field - ED_Out_Start = Indx_y_ED_BladeRoot_Start(y_ED, y_FAST, k) ! start of y_ED%BladeRootMotion(k)%TranslationDisp field + ED_Out_Start = Indx_y_ED_BladeRoot_Start(p_ED, y_ED, y_FAST, k) ! start of y_ED%BladeRootMotion(k)%TranslationDisp field call Assemble_dUdy_Motions(y_ED%BladeRootMotion(k), BD%Input(1,k)%RootMotion, MeshMapData%ED_P_2_BD_P(k), BD_Start, ED_Out_Start, dUdy) end do - END SUBROUTINE Linear_BD_InputSolve_dy + !---------------------------------------------------------------------------------------------------------------------------------- !> This routine forms the dU^{AD}/dy^{IfW} block of dUdy. (i.e., how do changes in the IfW outputs affect the AD inputs?) -SUBROUTINE Linear_AD_InputSolve_IfW_dy( p_FAST, y_FAST, u_AD, dUdy ) - - ! Passed variables - TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< FAST parameter data - TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) - TYPE(AD_InputType), INTENT(INOUT) :: u_AD !< The inputs to AeroDyn - REAL(R8Ki), INTENT(INOUT) :: dUdy(:,:) !< Jacobian matrix of which we are computing the dU^{AD}/dy^{IfW} block - - ! Local variables: - - INTEGER(IntKi) :: I ! Loops through components - INTEGER(IntKi) :: J ! Loops through nodes / elements - INTEGER(IntKi) :: K ! Loops through blades +SUBROUTINE Linear_AD_InputSolve_IfW_dy( p_FAST, y_FAST, p_AD, u_AD, dUdy ) + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< FAST parameter data + TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) + TYPE(AD_ParameterType), INTENT(IN ) :: p_AD !< The parameters of AeroDyn + TYPE(AD_InputType), INTENT(INOUT) :: u_AD !< The inputs to AeroDyn + REAL(R8Ki), INTENT(INOUT) :: dUdy(:,:) !< Jacobian matrix of which we are computing the dU^{AD}/dy^{IfW} block + INTEGER(IntKi) :: I ! Loops through components INTEGER(IntKi) :: node - INTEGER(IntKi) :: AD_Start ! starting index of dUdy (row) where AD input equations (for specific fields) are located - - + INTEGER(IntKi) :: AD_Start ! starting index of dUdy (row) where AD input equations (for specific fields) are located + INTEGER(IntKi) :: Ifw_Start ! starting index of dUdy (col) where IfW output equations (for specific fields) are located !------------------------------------------------------------------------------------------------- - ! Set the inputs from inflow wind: + ! Set the inputs from inflow wind (IfW only has 3 extended outputs): !------------------------------------------------------------------------------------------------- - !IF (p_FAST%CompInflow == MODULE_IfW) THEN !already checked in calling routine - - if (p_FAST%CompServo == MODULE_SrvD) then - node = 2 - else - node = 1 - end if - - - AD_Start = Indx_u_AD_BladeInflow_Start(u_AD, y_FAST) ! start of u_AD%InflowOnBlade array - - do k=1,size(u_AD%rotors(1)%InflowOnBlade,3) ! blades - do j=1,size(u_AD%rotors(1)%InflowOnBlade,2) ! nodes - do i=1,3 !velocity component - dUdy( AD_Start + i - 1, y_FAST%Lin%Modules(MODULE_IfW)%Instance(1)%LinStartIndx(LIN_OUTPUT_COL) + (node-1)*3 + i - 1 ) = -1.0_R8Ki - end do - node = node + 1 - AD_Start = AD_Start + 3 - end do - end do - - if ( allocated(u_AD%rotors(1)%InflowOnTower) ) then - do j=1,size(u_AD%rotors(1)%InflowOnTower,2) !nodes - do i=1,3 !velocity component - dUdy( AD_Start + i - 1, y_FAST%Lin%Modules(MODULE_IfW)%Instance(1)%LinStartIndx(LIN_OUTPUT_COL) + (node-1)*3 + i - 1 ) = -1.0_R8Ki - end do - node = node + 1 - AD_Start = AD_Start + 3 - end do - end if + AD_Start = y_FAST%Lin%Modules(Module_AD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) + p_AD%rotors(1)%Jac_u_idxStartList%Extended - 1 ! index starts at 1 + IfW_Start = y_FAST%Lin%Modules(Module_IfW)%Instance(1)%LinStartIndx(LIN_OUTPUT_COL) - do i=1,3 !rotor-disk velocity component (DiskVel) - dUdy( AD_Start + i - 1, y_FAST%Lin%Modules(MODULE_IfW)%Instance(1)%LinStartIndx(LIN_OUTPUT_COL) + (node-1)*3 + i - 1 ) = -1.0_R8Ki - end do - node = node + 1 - AD_Start = AD_Start + 3 - - !END IF - - + do i=1,p_AD%rotors(1)%NumExtendedInputs ! extended inputs -- direct mapping. Extended outputs of IfW are exactly the same number as AD15 extended inputs + dUdy( AD_Start + i - 1, IfW_Start + i - 1 ) = -1.0_R8Ki + end do END SUBROUTINE Linear_AD_InputSolve_IfW_dy + !---------------------------------------------------------------------------------------------------------------------------------- !> This routine forms the dU^{AD}/dy^{ED} and dU^{AD}/dy^{BD} blocks of dUdy. (i.e., how do changes in the ED and BD outputs affect !! the AD inputs?) -SUBROUTINE Linear_AD_InputSolve_NoIfW_dy( p_FAST, y_FAST, u_AD, y_ED, BD, MeshMapData, dUdy, ErrStat, ErrMsg ) - - ! Passed variables +SUBROUTINE Linear_AD_InputSolve_NoIfW_dy( p_FAST, y_FAST, p_AD, u_AD, p_ED, y_ED, BD, MeshMapData, dUdy, ErrStat, ErrMsg ) TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< FAST parameter data TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) - TYPE(AD_InputType), INTENT(INOUT) :: u_AD !< The inputs to AeroDyn14 + TYPE(AD_ParameterType), INTENT(IN ) :: p_AD !< The parameters of AeroDyn + TYPE(AD_InputType), INTENT(INOUT) :: u_AD !< The inputs to AeroDyn15 + TYPE(ED_ParameterType), INTENT(IN) :: p_ED !< ElastoDyn parameters TYPE(ED_OutputType), INTENT(IN) :: y_ED !< The outputs from the structural dynamics module TYPE(BeamDyn_Data), INTENT(IN ) :: BD !< BD data at t TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules REAL(R8Ki), INTENT(INOUT) :: dUdy(:,:) !< Jacobian matrix of which we are computing the dU^{AD}/dy^{ED} block - INTEGER(IntKi) :: ErrStat !< Error status of the operation - CHARACTER(*) :: ErrMsg !< Error message if ErrStat /= ErrID_None + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None ! Local variables: - INTEGER(IntKi) :: K ! Loops through blades INTEGER(IntKi) :: AD_Start ! starting index of dUdy (column) where particular AD fields are located INTEGER(IntKi) :: ED_Out_Start! starting index of dUdy (row) where particular ED fields are located INTEGER(IntKi) :: BD_Out_Start! starting index of dUdy (row) where particular BD fields are located + LOGICAL :: uFieldMask(FIELDMASK_SIZE) !< which destinationfields from u to assemble + LOGICAL :: yFieldMask(FIELDMASK_SIZE) !< which fields from y to assemble INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Linear_AD_InputSolve_NoIfW_dy' @@ -3649,64 +3487,109 @@ SUBROUTINE Linear_AD_InputSolve_NoIfW_dy( p_FAST, y_FAST, u_AD, y_ED, BD, MeshMa !------------------------------------------------------------------------------------------------- ! Set the inputs from ElastoDyn and/or BeamDyn: !------------------------------------------------------------------------------------------------- - !................................... - ! tower - !................................... + + !----------------------------------- + ! Nacelle -- disp, orient + if (u_AD%rotors(1)%NacelleMotion%Committed) then + ! Linearize done in dUdu (see Linear_AD_InputSolve_du()) + !CALL Linearize_Point_to_Point( y_ED%NacelleMotion, u_AD%rotors(1)%NacelleMotion, MeshMapData%ED_P_2_AD_P_N, ErrStat2, ErrMsg2 ) + ! CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName//':u_AD%NacelleMotion' ) + ! if (errStat>=AbortErrLev) return + + ! *** AD translational displacement: from ED translational displacement (MeshMapData%ED_P_2_AD_P_N%dM%mi) and orientation (MeshMapData%ED_P_2_AD_P_N%dM%fx_p) + AD_Start = Indx_u_AD_Nacelle_Start(p_AD, u_AD, y_FAST) ! start of u_AD%rotors(1)%NacelleMotion%TranslationDisp field + ED_Out_Start = Indx_y_ED_Nacelle_Start(p_ED, y_ED, y_FAST) ! start of y_ED%NacelleMotion%TranslationDisp field + + uFieldMask = .false. + uFieldMask(MASKID_TRANSLATIONDISP) = .true. + uFieldMask(MASKID_ORIENTATION) = .true. + call Assemble_dUdy_Motions(y_ED%NacelleMotion, u_AD%rotors(1)%NacelleMotion, MeshMapData%ED_P_2_AD_P_N, AD_Start, ED_Out_Start, dUdy, uFieldMask) + endif + + + !----------------------------------- + ! Hub -- disp, orient, RV + if (u_AD%rotors(1)%HubMotion%Committed) then + ! Linearize done in dUdu (see Linear_AD_InputSolve_du()) + !CALL Linearize_Point_to_Point( y_ED%HubPtMotion, u_AD%rotors(1)%HubMotion, MeshMapData%ED_P_2_AD_P_H, ErrStat2, ErrMsg2 ) + ! CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName//':u_AD%HubMotion' ) + ! if (errStat>=AbortErrLev) return + + ! *** AD translational displacement: from ED translational displacement (MeshMapData%ED_P_2_AD_P_H%dM%mi) and orientation (MeshMapData%ED_P_2_AD_P_H%dM%fx_p) + AD_Start = Indx_u_AD_Hub_Start(p_AD, u_AD, y_FAST) ! start of u_AD%rotors(1)%HubMotion%TranslationDisp field + ED_Out_Start = Indx_y_ED_Hub_Start(p_ED, y_ED, y_FAST) ! start of y_ED%HubPtMotion%TranslationDisp field + + uFieldMask = .false. + uFieldMask(MASKID_TRANSLATIONDISP) = .true. + uFieldMask(MASKID_ORIENTATION) = .true. + uFieldMask(MASKID_ROTATIONVEL) = .true. + yFieldMask = .false. + yFieldMask(MASKID_TRANSLATIONDISP) = .true. + yFieldMask(MASKID_ORIENTATION) = .true. + yFieldMask(MASKID_ROTATIONVEL) = .true. + call Assemble_dUdy_Motions(y_ED%HubPtMotion, u_AD%rotors(1)%HubMotion, MeshMapData%ED_P_2_AD_P_H, AD_Start, ED_Out_Start, dUdy, uFieldMask, yFieldMask) + endif + + + !----------------------------------- + ! TailFin -- disp, orient, TV + if (u_AD%rotors(1)%TFinMotion%Committed) then + ! Linearize done in dUdu (see Linear_AD_InputSolve_du()) + !CALL Linearize_Point_to_Point( y_ED%TFinCMMotion, u_AD%rotors(1)%TFinMotion, MeshMapData%ED_P_2_AD_P_TF, ErrStat2, ErrMsg2 ) + ! CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName//':u_AD%TFinMotion' ) + ! if (errStat>=AbortErrLev) return + + ! *** AD translational displacement: from ED translational displacement (MeshMapData%ED_P_2_AD_P_TF%dM%mi) and orientation (MeshMapData%ED_P_2_AD_P_TF%dM%fx_p) + AD_Start = Indx_u_AD_TFin_Start(p_AD, u_AD, y_FAST) ! start of u_AD%rotors(1)%TFinMotion%TranslationDisp field + ED_Out_Start = Indx_y_ED_TFin_Start(p_ED, y_ED, y_FAST) ! start of y_ED%TFinCMMotion%TranslationDisp field + + uFieldMask = .false. + uFieldMask(MASKID_TRANSLATIONDISP) = .true. + uFieldMask(MASKID_ORIENTATION) = .true. + uFieldMask(MASKID_TRANSLATIONVEL) = .true. + call Assemble_dUdy_Motions(y_ED%TFinCMMotion, u_AD%rotors(1)%TFinMotion, MeshMapData%ED_P_2_AD_P_TF, AD_Start, ED_Out_Start, dUdy, uFieldMask) + endif + + + !................................... + ! tower -- Disp, Orient, TransVel, TransAcc IF (u_AD%rotors(1)%TowerMotion%Committed) THEN - !!! ! This linearization was done in forming dUdu (see Linear_AD_InputSolve_du()), so we don't need to re-calculate these matrices !!! ! while forming dUdy, too. - !!!CALL Linearize_Line2_to_Line2( y_ED%TowerLn2Mesh, u_AD%TowerMotion, MeshMapData%ED_L_2_AD_L_T, ErrStat2, ErrMsg2 ) - - AD_Start = Indx_u_AD_Tower_Start(u_AD, y_FAST) ! start of u_AD%TowerMotion%TranslationDisp field + !!!CALL Linearize_Line2_to_Line2( y_ED%TowerLn2Mesh, u_AD%rotors(1)%TowerMotion, MeshMapData%ED_L_2_AD_L_T, ErrStat2, ErrMsg2 ) - ED_Out_Start = Indx_y_ED_Tower_Start(y_ED, y_FAST) ! start of y_ED%TowerLn2Mesh%TranslationDisp field - call Assemble_dUdy_Motions(y_ED%TowerLn2Mesh, u_AD%rotors(1)%TowerMotion, MeshMapData%ED_L_2_AD_L_T, AD_Start, ED_Out_Start, dUdy, skipRotVel=.true.) + AD_Start = Indx_u_AD_Tower_Start(p_AD, u_AD, y_FAST) ! start of u_AD%rotors(1)%TowerMotion%TranslationDisp field + ED_Out_Start = Indx_y_ED_Tower_Start(p_ED, y_ED, y_FAST) ! start of y_ED%TowerLn2Mesh%TranslationDisp field + uFieldMask = .false. + uFieldMask(MASKID_TRANSLATIONDISP) = .true. + uFieldMask(MASKID_ORIENTATION) = .true. + uFieldMask(MASKID_TRANSLATIONVEL) = .true. + uFieldMask(MASKID_TRANSLATIONACC) = .true. + call Assemble_dUdy_Motions(y_ED%TowerLn2Mesh, u_AD%rotors(1)%TowerMotion, MeshMapData%ED_L_2_AD_L_T, AD_Start, ED_Out_Start, dUdy, uFieldMask) END IF - - !................................... - ! hub - !................................... - CALL Linearize_Point_to_Point( y_ED%HubPtMotion, u_AD%rotors(1)%HubMotion, MeshMapData%ED_P_2_AD_P_H, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName//':u_AD%HubMotion' ) + + + !................................... + ! blade root + !................................... + DO k=1,size(y_ED%BladeRootMotion) + CALL Linearize_Point_to_Point( y_ED%BladeRootMotion(k), u_AD%rotors(1)%BladeRootMotion(k), MeshMapData%ED_P_2_AD_P_R(k), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName//':u_AD%BladeRootMotion('//trim(num2lstr(k))//')' ) if (errStat>=AbortErrLev) return - - ! *** AD translational displacement: from ED translational displacement (MeshMapData%ED_P_2_AD_P_H%dM%mi) and orientation (MeshMapData%ED_P_2_AD_P_H%dM%fx_p) - AD_Start = Indx_u_AD_Hub_Start(u_AD, y_FAST) ! start of u_AD%HubMotion%TranslationDisp field - ED_Out_Start = Indx_y_ED_Hub_Start(y_ED, y_FAST) ! start of y_ED%HubPtMotion%TranslationDisp field - call SetBlockMatrix( dUdy, MeshMapData%ED_P_2_AD_P_H%dM%mi, AD_Start, ED_Out_Start ) - - ED_Out_Start = Indx_y_ED_Hub_Start(y_ED, y_FAST) + y_ED%HubPtMotion%NNodes * 3 ! start of y_ED%HubPtMotion%Orientation field - call SetBlockMatrix( dUdy, MeshMapData%ED_P_2_AD_P_H%dM%fx_p, AD_Start, ED_Out_Start ) - + ! *** AD orientation: from ED orientation - AD_Start = AD_Start + u_AD%rotors(1)%HubMotion%NNodes * 3 ! move past the AD translation disp field to orientation field - call SetBlockMatrix( dUdy, MeshMapData%ED_P_2_AD_P_H%dM%mi, AD_Start, ED_Out_Start ) - - ! *** AD rotational velocity: from ED rotational velocity - AD_Start = AD_Start + u_AD%rotors(1)%HubMotion%NNodes * 3 ! move past the AD orientation field to rotational velocity field - ED_Out_Start = Indx_y_ED_Hub_Start(y_ED, y_FAST) + y_ED%HubPtMotion%NNodes * 6 ! ! start of y_ED%HubPtMotion%RotationVel field - call SetBlockMatrix( dUdy, MeshMapData%ED_P_2_AD_P_H%dM%mi, AD_Start, ED_Out_Start ) - - - - !................................... - ! blade root - !................................... - DO k=1,size(y_ED%BladeRootMotion) - CALL Linearize_Point_to_Point( y_ED%BladeRootMotion(k), u_AD%rotors(1)%BladeRootMotion(k), MeshMapData%ED_P_2_AD_P_R(k), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName//':u_AD%BladeRootMotion('//trim(num2lstr(k))//')' ) - if (errStat>=AbortErrLev) return - - ! *** AD orientation: from ED orientation - AD_Start = Indx_u_AD_BladeRoot_Start(u_AD, y_FAST, k) ! start of u_AD%BladeRootMotion(k)%Orientation field - - ED_Out_Start = Indx_y_ED_BladeRoot_Start(y_ED, y_FAST, k) & ! start of y_ED%BladeRootMotion(k)%TranslationDisp field - + y_ED%BladeRootMotion(k)%NNodes * 3 ! start of y_ED%BladeRootMotion(k)%Orientation field - call SetBlockMatrix( dUdy, MeshMapData%ED_P_2_AD_P_R(k)%dM%mi, AD_Start, ED_Out_Start ) - - END DO + AD_Start = Indx_u_AD_BladeRoot_Start(p_AD, u_AD, y_FAST, k) ! start of u_AD%rotors(1)%BladeRootMotion(k)%Orientation field + ED_Out_Start = Indx_y_ED_BladeRoot_Start(p_ED, y_ED, y_FAST, k) ! start of y_ED%BladeRootMotion(k)%TranslationDisp field + + uFieldMask = .false. + uFieldMask(MASKID_ORIENTATION) = .true. + yFieldMask = .false. + yFieldMask(MASKID_TRANSLATIONDISP) = .true. + yFieldMask(MASKID_ORIENTATION) = .true. + yFieldMask(MASKID_ROTATIONVEL) = .true. + call Assemble_dUdy_Motions(y_ED%BladeRootMotion(k), u_AD%rotors(1)%BladeRootMotion(k), MeshMapData%ED_P_2_AD_P_R(k), AD_Start, ED_Out_Start, dUdy, uFieldMask, yFieldMask) + END DO !................................... @@ -3714,29 +3597,30 @@ SUBROUTINE Linear_AD_InputSolve_NoIfW_dy( p_FAST, y_FAST, u_AD, y_ED, BD, MeshMa !................................... IF (p_FAST%CompElast == Module_ED ) THEN - DO k=1,size(y_ED%BladeLn2Mesh) !!! ! This linearization was done in forming dUdu (see Linear_AD_InputSolve_du()), so we don't need to re-calculate these matrices !!! ! while forming dUdy, too. - !!!CALL Linearize_Line2_to_Line2( y_ED%BladeLn2Mesh(k), u_AD%BladeMotion(k), MeshMapData%BDED_L_2_AD_L_B(k), ErrStat2, ErrMsg2 ) - - AD_Start = Indx_u_AD_Blade_Start(u_AD, y_FAST, k) ! start of u_AD%BladeMotion(k)%TranslationDisp field - ED_Out_Start = Indx_y_ED_Blade_Start(y_ED, y_FAST, k) ! start of y_ED%BladeLn2Mesh(k)%TranslationDisp field - CALL Assemble_dUdy_Motions(y_ED%BladeLn2Mesh(k), u_AD%rotors(1)%BladeMotion(k), MeshMapData%BDED_L_2_AD_L_B(k), AD_Start, ED_Out_Start, dUdy, skipRotAcc=.true.) + !!!CALL Linearize_Line2_to_Line2( y_ED%BladeLn2Mesh(k), u_AD%rotors(1)%BladeMotion(k), MeshMapData%BDED_L_2_AD_L_B(k), ErrStat2, ErrMsg2 ) + AD_Start = Indx_u_AD_Blade_Start(p_AD, u_AD, y_FAST, k) ! start of u_AD%rotors(1)%BladeMotion(k)%TranslationDisp field + ED_Out_Start = Indx_y_ED_Blade_Start(p_ED, y_ED, y_FAST, k) ! start of y_ED%BladeLn2Mesh(k)%TranslationDisp field + + uFieldMask = .true. ! all fields + CALL Assemble_dUdy_Motions(y_ED%BladeLn2Mesh(k), u_AD%rotors(1)%BladeMotion(k), MeshMapData%BDED_L_2_AD_L_B(k), AD_Start, ED_Out_Start, dUdy, uFieldMask) END DO ELSEIF (p_FAST%CompElast == Module_BD ) THEN !!! ! This linearization was done in forming dUdu (see Linear_AD_InputSolve_du()), so we don't need to re-calculate these matrices !!! ! while forming dUdy, too. - !!!CALL Linearize_Line2_to_Line2( BD%y(k)%BldMotion, u_AD%BladeMotion(k), MeshMapData%BDED_L_2_AD_L_B(k), ErrStat2, ErrMsg2 ) + !!!CALL Linearize_Line2_to_Line2( BD%y(k)%BldMotion, u_AD%rotors(1)%BladeMotion(k), MeshMapData%BDED_L_2_AD_L_B(k), ErrStat2, ErrMsg2 ) DO k=1,p_FAST%nBeams - AD_Start = Indx_u_AD_Blade_Start(u_AD, y_FAST, k) ! start of u_AD%BladeMotion(k)%TranslationDisp field + AD_Start = Indx_u_AD_Blade_Start(p_AD, u_AD, y_FAST, k) ! start of u_AD%rotors(1)%BladeMotion(k)%TranslationDisp field BD_Out_Start = y_FAST%Lin%Modules(MODULE_BD)%Instance(k)%LinStartIndx(LIN_OUTPUT_COL) & ! start of BD%y(k)%BldMotion%TranslationDisp field + BD%y(k)%ReactionForce%NNodes * 6 ! 2 fields with 3 components - CALL Assemble_dUdy_Motions(BD%y(k)%BldMotion, u_AD%rotors(1)%BladeMotion(k), MeshMapData%BDED_L_2_AD_L_B(k), AD_Start, BD_Out_Start, dUdy, skipRotAcc=.true.) + uFieldMask = .true. ! all fields + CALL Assemble_dUdy_Motions(BD%y(k)%BldMotion, u_AD%rotors(1)%BladeMotion(k), MeshMapData%BDED_L_2_AD_L_B(k), AD_Start, BD_Out_Start, dUdy, uFieldMask) END DO END IF @@ -3753,8 +3637,8 @@ SUBROUTINE Linear_HD_InputSolve_du( p_FAST, y_FAST, u_HD, y_ED, y_SD, MeshMapDat TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< FAST parameter data TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) TYPE(HydroDyn_InputType), INTENT(INOUT) :: u_HD !< The inputs to HydroDyn - TYPE(ED_OutputType), INTENT(IN) :: y_ED !< The outputs from the ElastoDyn structural dynamics module - TYPE(SD_OutputType), INTENT(IN) :: y_SD !< The outputs from the SubDyn structural dynamics module + TYPE(ED_OutputType), TARGET, INTENT(IN) :: y_ED !< The outputs from the ElastoDyn structural dynamics module + TYPE(SD_OutputType), TARGET, INTENT(IN) :: y_SD !< The outputs from the SubDyn structural dynamics module TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules REAL(R8Ki), INTENT(INOUT) :: dUdu(:,:) !< Jacobian matrix of which we are computing the dU^{HD}/du^{HD} block @@ -3768,12 +3652,22 @@ SUBROUTINE Linear_HD_InputSolve_du( p_FAST, y_FAST, u_HD, y_ED, y_SD, MeshMapDat INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Linear_HD_InputSolve_du' + TYPE(MeshType), POINTER :: PlatformMotion + TYPE(MeshType), POINTER :: SubstructureMotion2HD ErrStat = ErrID_None ErrMsg = "" - + ! note that we assume this block matrix has been initialized to the identity matrix before calling this routine + + PlatformMotion => y_ED%PlatformPtMesh + + IF (p_FAST%CompSub == Module_SD) THEN + SubstructureMotion2HD => y_SD%Y2Mesh + ELSE + SubstructureMotion2HD => PlatformMotion + END IF ! look at how the translational displacement gets transfered to the translational velocity and translational acceleration: !------------------------------------------------------------------------------------------------- ! Set the inputs from ElastoDyn: @@ -3792,7 +3686,7 @@ SUBROUTINE Linear_HD_InputSolve_du( p_FAST, y_FAST, u_HD, y_ED, y_SD, MeshMapDat ! Transfer ED motions to HD motion input (HD inputs depend on previously calculated HD inputs from ED): if ( u_HD%PRPMesh%Committed ) then - call Linearize_Point_to_Point( y_ED%PlatformPtMesh, u_HD%PRPMesh, MeshMapData%ED_P_2_HD_PRP_P, ErrStat2, ErrMsg2 ) + call Linearize_Point_to_Point( PlatformMotion, u_HD%PRPMesh, MeshMapData%ED_P_2_HD_PRP_P, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! HD is destination in the mapping, so we want M_{tv_uD} and M_{ta_uD} @@ -3812,240 +3706,214 @@ SUBROUTINE Linear_HD_InputSolve_du( p_FAST, y_FAST, u_HD, y_ED, y_SD, MeshMapDat end if end if - if ( p_FAST%CompSub == Module_None ) then - !=================================================== - ! y_ED%PlatformPtMesh and u_HD%Morison%Mesh - !=================================================== - - ! Transfer ED motions to HD motion input (HD inputs depend on previously calculated HD inputs from ED): - if ( u_HD%Morison%Mesh%Committed ) then - call Linearize_Point_to_Point( y_ED%PlatformPtMesh, u_HD%Morison%Mesh, MeshMapData%ED_P_2_HD_M_P, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + !=================================================== + ! y_ED%PlatformPtMesh or SD%y2Mesh and u_HD%Morison%Mesh + !=================================================== + ! Transfer ED motions to HD motion input (HD inputs depend on previously calculated HD inputs from ED): + if ( u_HD%Morison%Mesh%Committed ) then + call Linearize_Point_to_Point( SubstructureMotion2HD, u_HD%Morison%Mesh, MeshMapData%SubStructure_2_HD_M_P, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - ! HD is destination in the mapping, so we want M_{tv_uD} and M_{ta_uD} + ! HD is destination in the mapping, so we want M_{tv_uD} and M_{ta_uD} - HD_Start_td = Indx_u_HD_Morison_Start(u_HD, y_FAST) - HD_Start_tr = HD_Start_td + u_HD%Morison%Mesh%NNodes * 6 ! skip 2 fields (TranslationDisp and Orientation) with 3 components before translational velocity field + HD_Start_td = Indx_u_HD_Morison_Start(u_HD, y_FAST) + HD_Start_tr = HD_Start_td + u_HD%Morison%Mesh%NNodes * 6 ! skip 2 fields (TranslationDisp and Orientation) with 3 components before translational velocity field - ! translational velocity: - if (allocated(MeshMapData%ED_P_2_HD_M_P%dM%tv_uD )) then - call SetBlockMatrix( dUdu, MeshMapData%ED_P_2_HD_M_P%dM%tv_ud, HD_Start_tr, HD_Start_td ) - end if + ! translational velocity: + if (allocated(MeshMapData%SubStructure_2_HD_M_P%dM%tv_uD )) then + call SetBlockMatrix( dUdu, MeshMapData%SubStructure_2_HD_M_P%dM%tv_ud, HD_Start_tr, HD_Start_td ) + end if - ! translational acceleration: - HD_Start_tr = HD_Start_tr + u_HD%Morison%Mesh%NNodes * 6 ! skip 2 fields ( TranslationVel and RotationVel) - if (allocated(MeshMapData%ED_P_2_HD_M_P%dM%ta_uD )) then - call SetBlockMatrix( dUdu, MeshMapData%ED_P_2_HD_M_P%dM%ta_ud, HD_Start_tr, HD_Start_td ) - end if + ! translational acceleration: + HD_Start_tr = HD_Start_tr + u_HD%Morison%Mesh%NNodes * 6 ! skip 2 fields ( TranslationVel and RotationVel) + if (allocated(MeshMapData%SubStructure_2_HD_M_P%dM%ta_uD )) then + call SetBlockMatrix( dUdu, MeshMapData%SubStructure_2_HD_M_P%dM%ta_ud, HD_Start_tr, HD_Start_td ) end if + end if !=================================================== - ! y_ED%PlatformPtMesh and u_HD%WAMITMesh + ! y_ED%PlatformPtMesh or SD%y2Mesh and u_HD%WAMITMesh !=================================================== - if ( u_HD%WAMITMesh%Committed ) then - - call Linearize_Point_to_Point( y_ED%PlatformPtMesh, u_HD%WAMITMesh, MeshMapData%ED_P_2_HD_W_P, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - HD_Start_td = Indx_u_HD_WAMIT_Start(u_HD, y_FAST) - HD_Start_tr = HD_Start_td + u_HD%WAMITMesh%NNodes * 6 ! skip 2 fields (TranslationDisp and Orientation) with 3 components before translational velocity field - ! translational velocity: - if (allocated(MeshMapData%ED_P_2_HD_W_P%dM%tv_uD )) then - call SetBlockMatrix( dUdu, MeshMapData%ED_P_2_HD_W_P%dM%tv_ud, HD_Start_tr, HD_Start_td ) - end if + if ( u_HD%WAMITMesh%Committed ) then - ! translational acceleration: - HD_Start_tr = HD_Start_tr + u_HD%WAMITMesh%NNodes * 6 ! skip 2 fields ( TranslationVel and RotationVel) - - if (allocated(MeshMapData%ED_P_2_HD_W_P%dM%ta_uD )) then - call SetBlockMatrix( dUdu, MeshMapData%ED_P_2_HD_W_P%dM%ta_ud, HD_Start_tr, HD_Start_td ) - end if - end if - - - else if ( p_FAST%CompSub == Module_SD ) then - - - !=================================================== - ! y_SD%Y2Mesh and u_HD%Morison%Mesh - !=================================================== - if ( u_HD%Morison%Mesh%Committed ) then - ! Transfer ED motions to HD motion input (HD inputs depend on previously calculated HD inputs from ED): - - call Linearize_Point_to_Point( y_SD%Y2Mesh, u_HD%Morison%Mesh, MeshMapData%SD_P_2_HD_M_P, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - ! HD is destination in the mapping, so we want M_{tv_uD} and M_{ta_uD} + call Linearize_Point_to_Point( SubstructureMotion2HD, u_HD%WAMITMesh, MeshMapData%SubStructure_2_HD_W_P, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + HD_Start_td = Indx_u_HD_WAMIT_Start(u_HD, y_FAST) + HD_Start_tr = HD_Start_td + u_HD%WAMITMesh%NNodes * 6 ! skip 2 fields (TranslationDisp and Orientation) with 3 components before translational velocity field - HD_Start_td = Indx_u_HD_Morison_Start(u_HD, y_FAST) - HD_Start_tr = HD_Start_td + u_HD%Morison%Mesh%NNodes * 6 ! skip 2 fields (TranslationDisp and Orientation) with 3 components before translational velocity field - - ! translational velocity: - if (allocated(MeshMapData%SD_P_2_HD_M_P%dM%tv_uD )) then - call SetBlockMatrix( dUdu, MeshMapData%SD_P_2_HD_M_P%dM%tv_ud, HD_Start_tr, HD_Start_td ) - end if - - ! translational acceleration: - HD_Start_tr = HD_Start_tr + u_HD%Morison%Mesh%NNodes * 6 ! skip 2 fields ( TranslationVel and RotationVel) - if (allocated(MeshMapData%SD_P_2_HD_M_P%dM%ta_uD )) then - call SetBlockMatrix( dUdu, MeshMapData%SD_P_2_HD_M_P%dM%ta_ud, HD_Start_tr, HD_Start_td ) - end if + ! translational velocity: + if (allocated(MeshMapData%SubStructure_2_HD_W_P%dM%tv_uD )) then + call SetBlockMatrix( dUdu, MeshMapData%SubStructure_2_HD_W_P%dM%tv_ud, HD_Start_tr, HD_Start_td ) end if - - !=================================================== - ! y_SD%Y2Mesh and u_HD%WAMITMesh - !=================================================== - if ( u_HD%WAMITMesh%Committed ) then - call Linearize_Point_to_Point( y_SD%Y2Mesh, u_HD%WAMITMesh, MeshMapData%SD_P_2_HD_W_P, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - HD_Start_td = Indx_u_HD_WAMIT_Start(u_HD, y_FAST) - HD_Start_tr = HD_Start_td + u_HD%WAMITMesh%NNodes * 6 ! skip 2 fields (TranslationDisp and Orientation) with 3 components before translational velocity field - ! translational velocity: - if (allocated(MeshMapData%SD_P_2_HD_W_P%dM%tv_uD )) then - call SetBlockMatrix( dUdu, MeshMapData%SD_P_2_HD_W_P%dM%tv_ud, HD_Start_tr, HD_Start_td ) - end if - - ! translational acceleration: - HD_Start_tr = HD_Start_tr + u_HD%WAMITMesh%NNodes * 6 ! skip 2 fields ( TranslationVel and RotationVel) - if (allocated(MeshMapData%SD_P_2_HD_W_P%dM%ta_uD )) then - call SetBlockMatrix( dUdu, MeshMapData%ED_P_2_HD_W_P%dM%ta_ud, HD_Start_tr, HD_Start_td ) - end if + ! translational acceleration: + HD_Start_tr = HD_Start_tr + u_HD%WAMITMesh%NNodes * 6 ! skip 2 fields ( TranslationVel and RotationVel) + if (allocated(MeshMapData%SubStructure_2_HD_W_P%dM%ta_uD )) then + call SetBlockMatrix( dUdu, MeshMapData%SubStructure_2_HD_W_P%dM%ta_ud, HD_Start_tr, HD_Start_td ) end if - end if end if - - END SUBROUTINE Linear_HD_InputSolve_du + + !---------------------------------------------------------------------------------------------------------------------------------- !> This routine forms the dU^{HD}/dy^{ED} block of dUdy. (i.e., how do changes in the ED outputs affect !! the HD inputs?) -SUBROUTINE Linear_HD_InputSolve_dy( p_FAST, y_FAST, u_HD, y_ED, y_SD, MeshMapData, dUdy, ErrStat, ErrMsg ) - - ! Passed variables +SUBROUTINE Linear_HD_InputSolve_dy( p_FAST, y_FAST, u_HD, p_ED, y_ED, y_SD, MeshMapData, dUdy, ErrStat, ErrMsg ) TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< FAST parameter data TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) TYPE(HydroDyn_InputType), INTENT(INOUT) :: u_HD !< The inputs to HydroDyn - TYPE(ED_OutputType), INTENT(IN) :: y_ED !< The outputs from the ElastoDyn structural dynamics module - TYPE(SD_OutputType), INTENT(IN) :: y_SD !< The outputs from the SubDyn structural dynamics module + TYPE(ED_ParameterType), INTENT(IN ) :: p_ED !< ElastoDyn parameters + TYPE(ED_OutputType), TARGET, INTENT(IN ) :: y_ED !< The outputs from the ElastoDyn structural dynamics module + TYPE(SD_OutputType), TARGET, INTENT(IN ) :: y_SD !< The outputs from the SubDyn structural dynamics module TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules REAL(R8Ki), INTENT(INOUT) :: dUdy(:,:) !< Jacobian matrix of which we are computing the dU^{HD}/dy^{ED} block - - INTEGER(IntKi) :: ErrStat !< Error status of the operation - CHARACTER(*) :: ErrMsg !< Error message if ErrStat /= ErrID_None + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None ! Local variables: - INTEGER(IntKi) :: HD_Start ! starting index of dUdy (column) where particular HD fields are located - INTEGER(IntKi) :: ED_Out_Start! starting index of dUdy (row) where particular ED fields are located - INTEGER(IntKi) :: SD_Out_Start! starting index of dUdy (row) where particular SD fields are located + INTEGER(IntKi) :: Platform_Out_Start! starting index of dUdy (row) where particular ED fields are located + INTEGER(IntKi) :: SubStructure_Out_Start! starting index of dUdy (row) where particular SD/ED fields are located + TYPE(MeshType), POINTER :: PlatformMotion + TYPE(MeshType), POINTER :: SubstructureMotion2HD CHARACTER(*), PARAMETER :: RoutineName = 'Linear_HD_InputSolve_dy' - ErrStat = ErrID_None ErrMsg = "" - ! Add ED Platform mesh to HD PRP Mesh + PlatformMotion => y_ED%PlatformPtMesh + Platform_Out_Start = Indx_y_ED_Platform_Start(p_ED, y_ED, y_FAST) ! start of y_ED%PlatformPtMesh%TranslationDisp field + + IF (p_FAST%CompSub == Module_SD) THEN + SubstructureMotion2HD => y_SD%y2Mesh + SubStructure_Out_Start = Indx_y_SD_Y2Mesh_Start(y_SD, y_FAST) ! start of y_SD%Y2Mesh%TranslationDisp field + ELSE + SubstructureMotion2HD => PlatformMotion + SubStructure_Out_Start = Platform_Out_Start + END IF + + + !................................... + ! HD PRP Mesh + !................................... ! use Indx_u_HD_PRP_Start - HD_Start = Indx_u_HD_PRP_Start(u_HD, y_FAST) ! start of u_HD%Morison%Mesh%TranslationDisp field - ED_Out_Start = Indx_y_ED_Platform_Start(y_ED, y_FAST) ! start of y_ED%PlatformPtMesh%TranslationDisp field - call Assemble_dUdy_Motions(y_ED%PlatformPtMesh, u_HD%PRPMesh, MeshMapData%ED_P_2_HD_PRP_P, HD_Start, ED_Out_Start, dUdy, .false.) + HD_Start = Indx_u_HD_PRP_Start(u_HD, y_FAST) ! start of u_HD%Morison%Mesh%TranslationDisp field + call Assemble_dUdy_Motions(PlatformMotion, u_HD%PRPMesh, MeshMapData%ED_P_2_HD_PRP_P, HD_Start, Platform_Out_Start, dUdy) - if ( p_FAST%CompSub == Module_None ) then - ! dU^{HD}/dy^{ED} - !................................... - ! Morison Mesh - !................................... - IF (u_HD%Morison%Mesh%Committed) THEN - - !!! ! This linearization was done in forming dUdu (see Linear_HD_InputSolve_du()), so we don't need to re-calculate these matrices - !!! ! while forming dUdy, too. - !!!call Linearize_Point_to_Line2( y_ED%PlatformPtMesh, u_HD%Morison%Mesh, MeshMapData%ED_P_2_HD_M_P, ErrStat2, ErrMsg2 ) - - HD_Start = Indx_u_HD_Morison_Start(u_HD, y_FAST) ! start of u_HD%Morison%Mesh%TranslationDisp field - call Assemble_dUdy_Motions(y_ED%PlatformPtMesh, u_HD%Morison%Mesh, MeshMapData%ED_P_2_HD_M_P, HD_Start, ED_Out_Start, dUdy, .false.) - END IF - - !................................... - ! Lumped Platform Reference Pt Mesh - !................................... - IF (u_HD%WAMITMesh%Committed) THEN - - !!! ! This linearization was done in forming dUdu (see Linear_HD_InputSolve_du()), so we don't need to re-calculate these matrices - !!! ! while forming dUdy, too. - !!!call Linearize_Point_to_Point( y_ED%PlatformPtMesh, u_HD%Mesh, MeshMapData%ED_P_2_HD_W_P, ErrStat2, ErrMsg2 ) - - HD_Start = Indx_u_HD_WAMIT_Start(u_HD, y_FAST) ! start of u_HD%Mesh%TranslationDisp field - call Assemble_dUdy_Motions(y_ED%PlatformPtMesh, u_HD%WAMITMesh, MeshMapData%ED_P_2_HD_W_P, HD_Start, ED_Out_Start, dUdy, .false.) - END IF - - else if ( p_FAST%CompSub == Module_SD ) then - ! dU^{HD}/dy^{SD} - SD_Out_Start = Indx_y_SD_Y2Mesh_Start(y_SD, y_FAST) ! start of y_SD%Y2Mesh%TranslationDisp field - !................................... - ! Morison Mesh - !................................... - IF (u_HD%Morison%Mesh%Committed) THEN + ! dU^{HD}/dy^{ED} or ! dU^{HD}/dy^{SD} + !................................... + ! Morison Mesh + !................................... + IF (u_HD%Morison%Mesh%Committed) THEN - !!! ! This linearization was done in forming dUdu (see Linear_HD_InputSolve_du()), so we don't need to re-calculate these matrices - !!! ! while forming dUdy, too. - !!!call Linearize_Point_to_Line2( y_SD%Y2Mesh, u_HD%Morison%Mesh, MeshMapData%SD_P_2_HD_M_P, ErrStat2, ErrMsg2 ) + !!! ! This linearization was done in forming dUdu (see Linear_HD_InputSolve_du()), so we don't need to re-calculate these matrices + !!! ! while forming dUdy, too. + !!!call Linearize_Point_to_Line2( SubstructureMotion2HD, u_HD%Morison%Mesh, MeshMapData%SubStructure_2_HD_M_P, ErrStat2, ErrMsg2 ) - HD_Start = Indx_u_HD_Morison_Start(u_HD, y_FAST) ! start of u_HD%Morison%Mesh%TranslationDisp field - call Assemble_dUdy_Motions(y_SD%Y2Mesh, u_HD%Morison%Mesh, MeshMapData%SD_P_2_HD_M_P, HD_Start, SD_Out_Start, dUdy, .false.) - END IF + HD_Start = Indx_u_HD_Morison_Start(u_HD, y_FAST) ! start of u_HD%Morison%Mesh%TranslationDisp field + call Assemble_dUdy_Motions(SubstructureMotion2HD, u_HD%Morison%Mesh, MeshMapData%SubStructure_2_HD_M_P, HD_Start, SubStructure_Out_Start, dUdy) + END IF - !................................... - ! Lumped Platform Reference Pt Mesh - !................................... - IF (u_HD%WAMITMesh%Committed) THEN + !................................... + ! Lumped Platform Reference Pt Mesh + !................................... + IF (u_HD%WAMITMesh%Committed) THEN - !!! ! This linearization was done in forming dUdu (see Linear_HD_InputSolve_du()), so we don't need to re-calculate these matrices - !!! ! while forming dUdy, too. - !!!call Linearize_Point_to_Point( y_SD%Y2Mesh, u_HD%Mesh, MeshMapData%SD_P_2_HD_W_P, ErrStat2, ErrMsg2 ) - - HD_Start = Indx_u_HD_WAMIT_Start(u_HD, y_FAST) ! start of u_HD%Mesh%TranslationDisp field - call Assemble_dUdy_Motions(y_SD%Y2Mesh, u_HD%WAMITMesh, MeshMapData%SD_P_2_HD_W_P, HD_Start, SD_Out_Start, dUdy, .false.) - END IF - - end if - - + !!! ! This linearization was done in forming dUdu (see Linear_HD_InputSolve_du()), so we don't need to re-calculate these matrices + !!! ! while forming dUdy, too. + !!!call Linearize_Point_to_Point( SubstructureMotion2HD, u_HD%Mesh, MeshMapData%SubStructure_2_HD_W_P, ErrStat2, ErrMsg2 ) + + HD_Start = Indx_u_HD_WAMIT_Start(u_HD, y_FAST) ! start of u_HD%Mesh%TranslationDisp field + call Assemble_dUdy_Motions(SubstructureMotion2HD, u_HD%WAMITMesh, MeshMapData%SubStructure_2_HD_W_P, HD_Start, SubStructure_Out_Start, dUdy) + END IF END SUBROUTINE Linear_HD_InputSolve_dy +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine forms the dU^{HD}/dy^{SeaSt} block of dUdy. (i.e., how do changes in the SeaSt outputs affect the HD inputs?) +subroutine Linear_HD_InputSolve_SeaSt_dy( p_FAST, y_FAST, p_SeaSt, p_HD, u_HD, dUdy ) + type(FAST_ParameterType), intent(in ) :: p_FAST !< FAST parameter data + type(FAST_OutputFileType), intent(in ) :: y_FAST !< FAST output file data (for linearization) + type(SeaSt_ParameterType), intent(in ) :: p_SeaSt !< The parameters of SeaState + type(HydroDyn_ParameterType), intent(in ) :: p_HD !< The parameters of HydroDyn + type(HydroDyn_InputType), intent(inout) :: u_HD !< The inputs to HydroDyn + real(R8Ki), intent(inout) :: dUdy(:,:) !< Jacobian matrix of which we are computing the dU^{HD}/dy^{IfW} block + integer(IntKi) :: I ! Loops through components + integer(IntKi) :: node + integer(IntKi) :: HD_Start ! starting index of dUdy (row) where HD input equations (for specific fields) are located + integer(IntKi) :: SeaSt_Start ! starting index of dUdy (column) where SeaSt output equations (for specific fields) are located + !------------------------------------------------------------------------------------------------- + ! Set the inputs from SeaState (SeaSt only has 1 extended output): + !------------------------------------------------------------------------------------------------- + HD_Start = Indx_u_HD_Ext_Start(u_HD, y_FAST) + SeaSt_Start = y_FAST%Lin%Modules(Module_SeaSt)%Instance(1)%LinStartIndx(LIN_OUTPUT_COL) + p_SeaSt%LinParams%Jac_y_idxStartList%Extended - 1 ! index starts at 1 + + ! SeaState has one extended output, but HD has multiple extended inputs. WaveElev0 is transferred. + dUdy( HD_Start, SeaSt_Start ) = -1.0_R8Ki +end subroutine Linear_HD_InputSolve_SeaSt_dy + +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine forms the dU^{HD}/dy^{IfW} block of dUdy. (i.e., how do changes in the IfW outputs affect the HD inputs?) +subroutine Linear_HD_InputSolve_IfW_dy( p_FAST, y_FAST, p_HD, u_HD, dUdy ) + type(FAST_ParameterType), intent(in ) :: p_FAST !< FAST parameter data + type(FAST_OutputFileType), intent(in ) :: y_FAST !< FAST output file data (for linearization) + type(HydroDyn_ParameterType), intent(in ) :: p_HD !< The parameters of AeroDyn + type(HydroDyn_InputType), intent(inout) :: u_HD !< The inputs to AeroDyn + real(R8Ki), intent(inout) :: dUdy(:,:) !< Jacobian matrix of which we are computing the dU^{HD}/dy^{IfW} block + integer(IntKi) :: I ! Loops through components + integer(IntKi) :: node + integer(IntKi) :: HD_Start ! starting index of dUdy (row) where HD input equations (for specific fields) are located + integer(IntKi) :: IfW_Start ! starting index of dUdy (column) where IfW output equations (for specific fields) are located + !------------------------------------------------------------------------------------------------- + ! Set the inputs from IfW (IfW only has 3 extended output): + !------------------------------------------------------------------------------------------------- + HD_Start = Indx_u_HD_Ext_Start(u_HD, y_FAST) ! skip first Ext input (WaveElev0 from SeaSt) + IfW_Start = y_FAST%Lin%Modules(Module_IfW)%Instance(1)%LinStartIndx(LIN_OUTPUT_COL) ! use all IfW extended outputs + + ! IfW has 3 extended outputs, but HD has multiple extended inputs. Transfer HWindSpeed, PLexp, PropagationDir + do i = 0,2 + dUdy( HD_Start + i, IfW_Start + i ) = -1.0_R8Ki + enddo +end subroutine Linear_HD_InputSolve_IfW_dy + !---------------------------------------------------------------------------------------------------------------------------------- !> This routine forms the dU^{MAP}/dy^{ED} block of dUdy. (i.e., how do changes in the ED outputs affect !! the MAP inputs?) -SUBROUTINE Linear_MAP_InputSolve_dy( p_FAST, y_FAST, u_MAP, y_ED, y_SD, MeshMapData, dUdy, ErrStat, ErrMsg ) - - ! Passed variables +SUBROUTINE Linear_MAP_InputSolve_dy( p_FAST, y_FAST, u_MAP, p_ED, y_ED, y_SD, MeshMapData, dUdy, ErrStat, ErrMsg ) TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< FAST parameter data TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) TYPE(MAP_InputType), INTENT(INOUT) :: u_MAP !< The inputs to MAP - TYPE(ED_OutputType), INTENT(IN) :: y_ED !< The outputs from the ElastoDyn structural dynamics module - TYPE(SD_OutputType), INTENT(IN) :: y_SD !< The outputs from the SubDyn structural dynamics module + TYPE(ED_ParameterType), INTENT(IN ) :: p_ED !< ElastoDyn parameters + TYPE(ED_OutputType), TARGET, INTENT(IN ) :: y_ED !< The outputs from the ElastoDyn structural dynamics module + TYPE(SD_OutputType), TARGET, INTENT(IN ) :: y_SD !< The outputs from the SubDyn structural dynamics module TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules REAL(R8Ki), INTENT(INOUT) :: dUdy(:,:) !< Jacobian matrix of which we are computing the dU^{MAP}/dy^{ED} block - - INTEGER(IntKi) :: ErrStat !< Error status of the operation - CHARACTER(*) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - ! Local variables: + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None INTEGER(IntKi) :: MAP_Start ! starting index of dUdy (column) where particular MAP fields are located - INTEGER(IntKi) :: ED_Out_Start! starting index of dUdy (row) where particular ED fields are located - INTEGER(IntKi) :: SD_Out_Start! starting index of dUdy (row) where particular SD fields are located + INTEGER(IntKi) :: SubStructure_Out_Start! starting index of dUdy (row) where particular SD/ED fields are located + TYPE(MeshType), POINTER :: SubstructureMotion + LOGICAL :: FieldMask(FIELDMASK_SIZE) !< which source fields to assemble INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Linear_MAP_InputSolve_dy' - ErrStat = ErrID_None ErrMsg = "" + + IF (p_FAST%CompSub == Module_SD) THEN + SubstructureMotion => y_SD%y3Mesh + SubStructure_Out_Start = Indx_y_SD_Y3Mesh_Start(y_SD, y_FAST) ! start of y_SD%Y3Mesh%TranslationDisp field + ELSE + SubstructureMotion => y_ED%PlatformPtMesh + SubStructure_Out_Start = Indx_y_ED_Platform_Start(p_ED, y_ED, y_FAST) ! start of y_ED%PlatformPtMesh%TranslationDisp field + END IF + IF (u_MAP%PtFairDisplacement%Committed) THEN !................................... ! FairLead Mesh @@ -4053,20 +3921,12 @@ SUBROUTINE Linear_MAP_InputSolve_dy( p_FAST, y_FAST, u_MAP, y_ED, y_SD, MeshMapD MAP_Start = y_FAST%Lin%Modules(MODULE_MAP)%Instance(1)%LinStartIndx(LIN_INPUT_COL) - if ( p_FAST%CompSub == Module_SD ) THEN - ! dU^{MAP}/dy^{SD} - SD_Out_Start = Indx_y_SD_Y3Mesh_Start(y_SD, y_FAST) ! start of y_SD%Y3Mesh%TranslationDisp field - call Linearize_Point_to_Point( y_SD%Y3Mesh, u_MAP%PtFairDisplacement, MeshMapData%SDy3_P_2_Mooring_P, ErrStat2, ErrMsg2 ) - call Assemble_dUdy_Motions(y_SD%Y3Mesh , u_MAP%PtFairDisplacement, MeshMapData%SDy3_P_2_Mooring_P, MAP_Start, SD_Out_Start, dUdy, OnlyTranslationDisp=.true.) - - else if ( p_FAST%CompSub == Module_None ) THEN - ! dU^{MAP}/dy^{ED} - ED_Out_Start = Indx_y_ED_Platform_Start(y_ED, y_FAST) ! start of y_ED%PlatformPtMesh%TranslationDisp field - call Linearize_Point_to_Point( y_ED%PlatformPtMesh, u_MAP%PtFairDisplacement, MeshMapData%ED_P_2_Mooring_P, ErrStat2, ErrMsg2 ) - call Assemble_dUdy_Motions(y_ED%PlatformPtMesh, u_MAP%PtFairDisplacement, MeshMapData%ED_P_2_Mooring_P, MAP_Start, ED_Out_Start, dUdy, OnlyTranslationDisp=.true.) + ! dU^{MAP}/dy^{SD} or ! dU^{MAP}/dy^{ED} + call Linearize_Point_to_Point( SubstructureMotion, u_MAP%PtFairDisplacement, MeshMapData%Structure_2_Mooring, ErrStat2, ErrMsg2 ) + FieldMask = .false. + FieldMask(MASKID_TRANSLATIONDISP) = .true. + call Assemble_dUdy_Motions(y_ED%PlatformPtMesh, u_MAP%PtFairDisplacement, MeshMapData%Structure_2_Mooring, MAP_Start, SubStructure_Out_Start, dUdy, FieldMask) - end if - END IF END SUBROUTINE Linear_MAP_InputSolve_dy @@ -4074,75 +3934,54 @@ END SUBROUTINE Linear_MAP_InputSolve_dy !> This routine forms the dU^{MD}/du^{MD} block of dUdu. (i.e., how do changes in the MD outputs affect !! the MD inputs?) SUBROUTINE Linear_MD_InputSolve_du( p_FAST, y_FAST, u_MD, y_ED, y_SD, MeshMapData, dUdu, ErrStat, ErrMsg ) - - ! Passed variables TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< FAST parameter data TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) TYPE(MD_InputType), INTENT(INOUT) :: u_MD !< The inputs to MoorDyn - TYPE(ED_OutputType), INTENT(IN) :: y_ED !< The outputs from the ElastoDyn structural dynamics module - TYPE(SD_OutputType), INTENT(IN) :: y_SD !< The outputs from the SubDyn structural dynamics module + TYPE(ED_OutputType), TARGET, INTENT(IN ) :: y_ED !< The outputs from the ElastoDyn structural dynamics module + TYPE(SD_OutputType), TARGET, INTENT(IN ) :: y_SD !< The outputs from the SubDyn structural dynamics module TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules REAL(R8Ki), INTENT(INOUT) :: dUdu(:,:) !< Jacobian matrix of which we are computing the dU^{MD}/dy^{ED} block - - INTEGER(IntKi) :: ErrStat !< Error status of the operation - CHARACTER(*) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - ! Local variables: + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None INTEGER(IntKi) :: MD_Start_td ! starting index of dUdu (column) where particular MD fields are located INTEGER(IntKi) :: MD_Start_tr ! starting index of dUdu (row) where particular MD fields are located + TYPE(MeshType), POINTER :: SubstructureMotion INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Linear_MD_InputSolve_du' - ErrStat = ErrID_None ErrMsg = "" + + IF (p_FAST%CompSub == Module_SD) THEN + SubstructureMotion => y_SD%y3Mesh + ELSE + SubstructureMotion => y_ED%PlatformPtMesh + END IF + IF (u_MD%CoupledKinematics(1)%Committed) THEN - !................................... - ! FairLead Mesh - !................................... + !................................... + ! FairLead Mesh + !................................... - if ( p_FAST%CompSub == Module_SD ) THEN ! dU^{MD}/du^{MD} - call Linearize_Point_to_Point( y_SD%Y3Mesh, u_MD%CoupledKinematics(1), MeshMapData%SDy3_P_2_Mooring_P, ErrStat2, ErrMsg2 ) + call Linearize_Point_to_Point( SubstructureMotion, u_MD%CoupledKinematics(1), MeshMapData%Structure_2_Mooring, ErrStat2, ErrMsg2 ) - ! MD is destination in the mapping, so we want M_{tv_uD} and M_{ta_uD} - MD_Start_td = y_FAST%Lin%Modules(MODULE_MD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) - MD_Start_tr = MD_Start_td + u_MD%CoupledKinematics(1)%NNodes * 6 ! skip 2 fields (TranslationDisp and Orientation) with 3 components before translational velocity field + ! MD is destination in the mapping, so we want M_{tv_uD} and M_{ta_uD} + MD_Start_td = y_FAST%Lin%Modules(MODULE_MD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) + MD_Start_tr = MD_Start_td + u_MD%CoupledKinematics(1)%NNodes * 6 ! skip 2 fields (TranslationDisp and Orientation) with 3 components before translational velocity field ! translational velocity: - if (allocated(MeshMapData%SDy3_P_2_Mooring_P%dM%tv_uD )) then - call SetBlockMatrix( dUdu, MeshMapData%SDy3_P_2_Mooring_P%dM%tv_ud, MD_Start_tr, MD_Start_td ) + if (allocated(MeshMapData%Structure_2_Mooring%dM%tv_uD )) then + call SetBlockMatrix( dUdu, MeshMapData%Structure_2_Mooring%dM%tv_ud, MD_Start_tr, MD_Start_td ) end if ! translational acceleration: MD_Start_tr = MD_Start_tr + u_MD%CoupledKinematics(1)%NNodes * 6 ! skip 2 fields ( TranslationVel and RotationVel) - if (allocated(MeshMapData%SDy3_P_2_Mooring_P%dM%ta_uD )) then - call SetBlockMatrix( dUdu, MeshMapData%SDy3_P_2_Mooring_P%dM%ta_ud, MD_Start_tr, MD_Start_td ) - end if - - else if ( p_FAST%CompSub == Module_None ) THEN - ! dU^{MD}/du^{MD} - call Linearize_Point_to_Point( y_ED%PlatformPtMesh, u_MD%CoupledKinematics(1), MeshMapData%ED_P_2_Mooring_P, ErrStat2, ErrMsg2 ) - - ! MD is destination in the mapping, so we want M_{tv_uD} and M_{ta_uD} - MD_Start_td = y_FAST%Lin%Modules(MODULE_MD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) - MD_Start_tr = MD_Start_td + u_MD%CoupledKinematics(1)%NNodes * 6 ! skip 2 fields (TranslationDisp and Orientation) with 3 components before translational velocity field - - ! translational velocity: - if (allocated(MeshMapData%ED_P_2_Mooring_P%dM%tv_uD )) then - call SetBlockMatrix( dUdu, MeshMapData%ED_P_2_Mooring_P%dM%tv_ud, MD_Start_tr, MD_Start_td ) + if (allocated(MeshMapData%Structure_2_Mooring%dM%ta_uD )) then + call SetBlockMatrix( dUdu, MeshMapData%Structure_2_Mooring%dM%ta_ud, MD_Start_tr, MD_Start_td ) end if - - ! translational acceleration: - MD_Start_tr = MD_Start_tr + u_MD%CoupledKinematics(1)%NNodes * 6 ! skip 2 fields (TranslationDisp and Orientation) with 3 components before translational velocity field - if (allocated(MeshMapData%ED_P_2_Mooring_P%dM%ta_uD )) then - call SetBlockMatrix( dUdu, MeshMapData%ED_P_2_Mooring_P%dM%ta_ud, MD_Start_tr, MD_Start_td ) - end if - - end if - END IF END SUBROUTINE Linear_MD_InputSolve_du @@ -4150,57 +3989,49 @@ END SUBROUTINE Linear_MD_InputSolve_du !---------------------------------------------------------------------------------------------------------------------------------- !> This routine forms the dU^{MD}/dy^{ED} block of dUdy. (i.e., how do changes in the ED outputs affect !! the MD inputs?) -SUBROUTINE Linear_MD_InputSolve_dy( p_FAST, y_FAST, u_MD, y_ED, y_SD, MeshMapData, dUdy, ErrStat, ErrMsg ) - - ! Passed variables +SUBROUTINE Linear_MD_InputSolve_dy( p_FAST, y_FAST, u_MD, p_ED, y_ED, y_SD, MeshMapData, dUdy, ErrStat, ErrMsg ) TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< FAST parameter data TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) TYPE(MD_InputType), INTENT(INOUT) :: u_MD !< The inputs to MoorDyn - TYPE(ED_OutputType), INTENT(IN) :: y_ED !< The outputs from the ElastoDyn structural dynamics module - TYPE(SD_OutputType), INTENT(IN) :: y_SD !< The outputs from the SubDyn structural dynamics module + TYPE(ED_ParameterType), INTENT(IN) :: p_ED !< ElastoDyn parameters + TYPE(ED_OutputType), TARGET, INTENT(IN) :: y_ED !< The outputs from the ElastoDyn structural dynamics module + TYPE(SD_OutputType), TARGET, INTENT(IN) :: y_SD !< The outputs from the SubDyn structural dynamics module TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules REAL(R8Ki), INTENT(INOUT) :: dUdy(:,:) !< Jacobian matrix of which we are computing the dU^{MD}/dy^{ED} block - - INTEGER(IntKi) :: ErrStat !< Error status of the operation - CHARACTER(*) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - ! Local variables: + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None INTEGER(IntKi) :: MD_Start ! starting index of dUdy (column) where particular MD fields are located - INTEGER(IntKi) :: ED_Out_Start! starting index of dUdy (row) where particular ED fields are located - INTEGER(IntKi) :: SD_Out_Start! starting index of dUdy (row) where particular SD fields are located + INTEGER(IntKi) :: SubStructure_Out_Start! starting index of dUdy (row) where particular SD/ED fields are located + TYPE(MeshType), POINTER :: SubstructureMotion CHARACTER(*), PARAMETER :: RoutineName = 'Linear_MD_InputSolve_dy' - ErrStat = ErrID_None ErrMsg = "" - IF (u_MD%CoupledKinematics(1)%Committed) THEN + + IF (u_MD%CoupledKinematics(1)%Committed) THEN + + IF (p_FAST%CompSub == Module_SD) THEN + SubstructureMotion => y_SD%y3Mesh + SubStructure_Out_Start = Indx_y_SD_Y3Mesh_Start(y_SD, y_FAST) ! start of y_SD%Y3Mesh%TranslationDisp field + ELSE + SubstructureMotion => y_ED%PlatformPtMesh + SubStructure_Out_Start = Indx_y_ED_Platform_Start(p_ED, y_ED, y_FAST) ! start of y_ED%PlatformPtMesh%TranslationDisp field + END IF + !................................... ! FairLead Mesh !................................... MD_Start = y_FAST%Lin%Modules(MODULE_MD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) - if ( p_FAST%CompSub == Module_SD ) THEN - ! dU^{MD}/dy^{SD} - - !!! ! This linearization was done in forming dUdu (see Linear_MD_InputSolve_du()), so we don't need to re-calculate these matrices - !!! ! while forming dUdy, too. - !!!call Linearize_Point_to_Point( y_SD%Y3Mesh, u_MD%CoupledKinematics(1), MeshMapData%SD_P_2_Mooring_P, ErrStat2, ErrMsg2 ) - - SD_Out_Start = Indx_y_SD_Y3Mesh_Start(y_SD, y_FAST) ! start of y_SD%Y3Mesh%TranslationDisp field - call Assemble_dUdy_Motions( y_SD%Y3Mesh, u_MD%CoupledKinematics(1), MeshMapData%SDy3_P_2_Mooring_P, MD_Start, SD_Out_Start, dUdy, OnlyTranslationDisp=.false.) - - else if ( p_FAST%CompSub == Module_None ) THEN - ! dU^{MD}/dy^{ED} - !!! ! This linearization was done in forming dUdu (see Linear_MD_InputSolve_du()), so we don't need to re-calculate these matrices - !!! ! while forming dUdy, too. - !!!call Linearize_Point_to_Point( y_ED%PlatformPtMesh, u_MD%CoupledKinematics, MeshMapData%ED_P_2_Mooring_P, ErrStat2, ErrMsg2 ) + ! dU^{MD}/dy^{SD} or dU^{MD}/dy^{ED} - ED_Out_Start = Indx_y_ED_Platform_Start(y_ED, y_FAST) ! start of y_ED%PlatformPtMesh%TranslationDisp field - call Assemble_dUdy_Motions(y_ED%PlatformPtMesh, u_MD%CoupledKinematics(1), MeshMapData%ED_P_2_Mooring_P, MD_Start, ED_Out_Start, dUdy, OnlyTranslationDisp=.false.) + !!! ! This linearization was done in forming dUdu (see Linear_MD_InputSolve_du()), so we don't need to re-calculate these matrices + !!! ! while forming dUdy, too. + !!!call Linearize_Point_to_Point( SubstructureMotion, u_MD%CoupledKinematics(1), MeshMapData%Structure_2_Mooring, ErrStat2, ErrMsg2 ) - end if + call Assemble_dUdy_Motions( SubstructureMotion, u_MD%CoupledKinematics(1), MeshMapData%Structure_2_Mooring, MD_Start, SubStructure_Out_Start, dUdy) END IF END SUBROUTINE Linear_MD_InputSolve_dy @@ -4699,20 +4530,51 @@ END SUBROUTINE SumBlockMatrix !! \vec{a}^S \\ !! \vec{\alpha}^S \\ !! \end{matrix} \right\} \f$ -SUBROUTINE Assemble_dUdy_Motions(y, u, MeshMap, BlockRowStart, BlockColStart, dUdy, skipRotVel, skipRotAcc, onlyTranslationDisp) +SUBROUTINE Assemble_dUdy_Motions(y, u, MeshMap, BlockRowStart, BlockColStart, dUdy, uFieldMaskIn, yFieldMaskIn) TYPE(MeshType), INTENT(IN) :: y !< the output (source) mesh that is transfering motions TYPE(MeshType), INTENT(IN) :: u !< the input (destination) mesh that is receiving motions TYPE(MeshMapType), INTENT(IN) :: MeshMap !< the mesh mapping from y to u - INTEGER(IntKi), INTENT(IN) :: BlockRowStart !< the index of the row defining the block of dUdy to be set - INTEGER(IntKi), INTENT(IN) :: BlockColStart !< the index of the column defining the block of dUdy to be set + INTEGER(IntKi), INTENT(IN) :: BlockRowStart !< the index of the row defining the block of dUdy to be set (u) + INTEGER(IntKi), INTENT(IN) :: BlockColStart !< the index of the column defining the block of dUdy to be set (y) REAL(R8Ki), INTENT(INOUT) :: dUdy(:,:) !< full Jacobian matrix - LOGICAL, OPTIONAL, INTENT(IN) :: skipRotVel !< if present and true, we skip the rotational velocity and both acceleration fields and return early - LOGICAL, OPTIONAL, INTENT(IN) :: onlyTranslationDisp !< if present and true, we set only the destination translationDisp fields and return early - LOGICAL, OPTIONAL, INTENT(IN) :: skipRotAcc !< if present and true, we skip the rotational acceleration field + LOGICAL, OPTIONAL, INTENT(IN ) :: uFieldMaskIn(FIELDMASK_SIZE) !< which row fields to do + LOGICAL, OPTIONAL, INTENT(IN ) :: yFieldMaskIn(FIELDMASK_SIZE) !< which col fields to do INTEGER(IntKi) :: row INTEGER(IntKi) :: col - + LOGICAL :: uFieldMask(FIELDMASK_SIZE) !< which row fields to do + LOGICAL :: yFieldMask(FIELDMASK_SIZE) !< which row fields to do + + ! Fields: destination u mesh (row) may not have all fields. For some modules, a field may be skipped in + ! the sequence. A separate counting of fields before the current field must be tracked. + ! It is assumed that the source mesh is complete and contains all fields + integer(IntKi) :: uFieldIdx(FIELDMASK_SIZE) ! index 0 based + integer(IntKi) :: yFieldIdx(FIELDMASK_SIZE) ! index 0 based + + if (present(uFieldMaskIn)) then + uFieldMask = uFieldMaskIn + else + uFieldMask(MASKID_TRANSLATIONDISP) = .true. + uFieldMask(MASKID_ORIENTATION) = .true. + uFieldMask(MASKID_TRANSLATIONVEL) = .true. + uFieldMask(MASKID_ROTATIONVEL) = .true. + uFieldMask(MASKID_TRANSLATIONACC) = .true. + uFieldMask(MASKID_ROTATIONACC) = .true. + endif + call SetFieldIdx(uFieldMask,u%NNodes,uFieldIdx) + + if (present(yFieldMaskIn)) then + yFieldMask = yFieldMaskIn + else + yFieldMask(MASKID_TRANSLATIONDISP) = .true. + yFieldMask(MASKID_ORIENTATION) = .true. + yFieldMask(MASKID_TRANSLATIONVEL) = .true. + yFieldMask(MASKID_ROTATIONVEL) = .true. + yFieldMask(MASKID_TRANSLATIONACC) = .true. + yFieldMask(MASKID_ROTATIONACC) = .true. + endif + call SetFieldIdx(yFieldMask,y%NNodes,yFieldIdx) + !! \f$M_{mi}\f$ is modmesh_mapping::meshmaplinearizationtype::mi (motion identity)\n !! \f$M_{f_{\times p}}\f$ is modmesh_mapping::meshmaplinearizationtype::fx_p \n !! \f$M_{tv\_uD}\f$ is modmesh_mapping::meshmaplinearizationtype::tv_uD \n @@ -4721,94 +4583,126 @@ SUBROUTINE Assemble_dUdy_Motions(y, u, MeshMap, BlockRowStart, BlockColStart, dU !! \f$M_{ta\_uS}\f$ is modmesh_mapping::meshmaplinearizationtype::ta_uS \n !! \f$M_{ta\_rv}\f$ is modmesh_mapping::meshmaplinearizationtype::ta_rv \n - !*** row for translational displacement *** - ! source translational displacement to destination translational displacement: - row = BlockRowStart ! start of u%TranslationDisp field - col = BlockColStart ! start of y%TranslationDisp field - call SetBlockMatrix( dUdy, MeshMap%dM%mi, row, col ) - ! source orientation to destination translational displacement: - row = BlockRowStart ! start of u%TranslationDisp field - col = BlockColStart + y%NNodes*3 ! start of y%Orientation field [skip 1 field with 3 components] - call SetBlockMatrix( dUdy, MeshMap%dM%fx_p, row, col ) + !*** row for translational displacement *** + if (uFieldMask(MASKID_TRANSLATIONDISP)) then + row = BlockRowStart + uFieldIdx(MASKID_TRANSLATIONDISP) ! start of u%TranslationDisp field + ! source translational displacement to destination translational displacement: + if (yFieldMask(MASKID_TRANSLATIONDISP)) then + col = BlockColStart + yFieldIdx(MASKID_TRANSLATIONDISP) ! start of y%TranslationDisp field + call SetBlockMatrix( dUdy, MeshMap%dM%mi, row, col ) + endif - if (PRESENT(onlyTranslationDisp)) then - if (onlyTranslationDisp) return ! destination includes only the translational displacement field, so we'll just return - end if + ! source orientation to destination translational displacement: + if (yFieldMask(MASKID_ORIENTATION)) then + col = BlockColStart + yFieldIdx(MASKID_ORIENTATION) ! start of y%Orientation field + call SetBlockMatrix( dUdy, MeshMap%dM%fx_p, row, col ) + endif + endif - !*** row for orientation *** - ! source orientation to destination orientation: - row = BlockRowStart + u%NNodes*3 ! start of u%Orientation field [skip 1 field with 3 components] - col = BlockColStart + y%NNodes*3 ! start of y%Orientation field [skip 1 field with 3 components] + + !*** row for orientation *** + if (uFieldMask(MASKID_ORIENTATION) .and. yFieldMask(MASKID_ORIENTATION)) then + ! source orientation to destination orientation: + row = BlockRowStart + uFieldIdx(MASKID_ORIENTATION) ! start of u%Orientation field + col = BlockColStart + yFieldIdx(MASKID_ORIENTATION) ! start of y%Orientation field call SetBlockMatrix( dUdy, MeshMap%dM%mi, row, col ) + endif - !*** row for translational velocity *** - ! source translational displacement to destination translational velocity: - row = BlockRowStart + u%NNodes*6 ! start of u%TranslationVel field [skip 2 fields with 3 components] - col = BlockColStart ! start of y%TranslationDisp field - call SetBlockMatrix( dUdy, MeshMap%dM%tv_us, row, col ) + !*** row for translational velocity *** + if (uFieldMask(MASKID_TRANSLATIONVEL)) then + row = BlockRowStart + uFieldIdx(MASKID_TRANSLATIONVEL) ! start of u%TranslationVel field - ! source translational velocity to destination translational velocity: - row = BlockRowStart + u%NNodes*6 ! start of u%TranslationVel field [skip 2 fields with 3 components] - col = BlockColStart + y%NNodes*6 ! start of y%TranslationVel field [skip 2 fields with 3 components] - call SetBlockMatrix( dUdy, MeshMap%dM%mi, row, col ) + ! source translational displacement to destination translational velocity: + if (yFieldMask(MASKID_TRANSLATIONDISP)) then + col = BlockColStart + yFieldIdx(MASKID_TRANSLATIONDISP) ! start of y%TranslationDisp field + call SetBlockMatrix( dUdy, MeshMap%dM%tv_us, row, col ) + endif - ! source rotational velocity to destination translational velocity: - row = BlockRowStart + u%NNodes*6 ! start of u%TranslationVel field [skip 2 fields with 3 components] - col = BlockColStart + y%NNodes*9 ! start of y%RotationVel field [skip 3 fields with 3 components] - call SetBlockMatrix( dUdy, MeshMap%dM%fx_p, row, col ) + ! source translational velocity to destination translational velocity: + if (yFieldMask(MASKID_TRANSLATIONVEL)) then + col = BlockColStart + yFieldIdx(MASKID_TRANSLATIONVEL) ! start of y%TranslationVel field + call SetBlockMatrix( dUdy, MeshMap%dM%mi, row, col ) + endif + ! source rotational velocity to destination translational velocity: + if (yFieldMask(MASKID_ROTATIONVEL)) then + col = BlockColStart + yFieldIdx(MASKID_ROTATIONVEL) ! start of y%RotationVel field + call SetBlockMatrix( dUdy, MeshMap%dM%fx_p, row, col ) + endif + endif - if (PRESENT(skipRotVel)) then - if (skipRotVel) return ! destination does not include rotational velocities or accelerations, so we'll just return - end if - !*** row for rotational velocity *** - ! source rotational velocity to destination rotational velocity: - row = BlockRowStart + u%NNodes*9 ! start of u%RotationVel field [skip 3 fields with 3 components] - col = BlockColStart + y%NNodes*9 ! start of y%RotationVel field [skip 3 fields with 3 components] + !*** row for rotational velocity *** + if (uFieldMask(MASKID_ROTATIONVEL) .and. yFieldMask(MASKID_ROTATIONVEL)) then + ! source rotational velocity to destination rotational velocity: + row = BlockRowStart + uFieldIdx(MASKID_ROTATIONVEL) ! start of u%RotationVel field + col = BlockColStart + yFieldIdx(MASKID_ROTATIONVEL) ! start of y%RotationVel field call SetBlockMatrix( dUdy, MeshMap%dM%mi, row, col ) + endif - !*** row for translational acceleration *** - ! source translational displacement to destination translational acceleration: - row = BlockRowStart + u%NNodes*12 ! start of u%TranslationAcc field [skip 4 fields with 3 components] - col = BlockColStart ! start of y%TranslationDisp field - call SetBlockMatrix( dUdy, MeshMap%dM%ta_us, row, col ) - - ! source rotational velocity to destination translational acceleration: - row = BlockRowStart + u%NNodes*12 ! start of u%TranslationAcc field [skip 4 fields with 3 components] - col = BlockColStart + y%NNodes*9 ! start of y%RotationVel field [skip 3 fields with 3 components] - call SetBlockMatrix( dUdy, MeshMap%dM%ta_rv, row, col ) + !*** row for translational acceleration *** + if (uFieldMask(MASKID_TRANSLATIONACC)) then + row = BlockRowStart + uFieldIdx(MASKID_TRANSLATIONACC) ! start of u%TranslationAcc field - ! source translational acceleration to destination translational acceleration: - row = BlockRowStart + u%NNodes*12 ! start of u%TranslationAcc field [skip 4 fields with 3 components] - col = BlockColStart + y%NNodes*12 ! start of y%TranslationAcc field [skip 4 fields with 3 components] - call SetBlockMatrix( dUdy, MeshMap%dM%mi, row, col ) + ! source translational displacement to destination translational acceleration: + if (yFieldMask(MASKID_TRANSLATIONDISP)) then + col = BlockColStart + yFieldIdx(MASKID_TRANSLATIONDISP) ! start of y%TranslationDisp field + call SetBlockMatrix( dUdy, MeshMap%dM%ta_us, row, col ) + endif - ! source rotational acceleration to destination translational acceleration: - row = BlockRowStart + u%NNodes*12 ! start of u%TranslationAcc field [skip 4 fields with 3 components] - col = BlockColStart + y%NNodes*15 ! start of y%RotationAcc field [skip 5 fields with 3 components] - call SetBlockMatrix( dUdy, MeshMap%dM%fx_p, row, col ) + ! source rotational velocity to destination translational acceleration: + if (yFieldMask(MASKID_ROTATIONVEL)) then + col = BlockColStart + yFieldIdx(MASKID_ROTATIONVEL) ! start of y%RotationVel field + call SetBlockMatrix( dUdy, MeshMap%dM%ta_rv, row, col ) + endif + ! source translational acceleration to destination translational acceleration: + if (yFieldMask(MASKID_TRANSLATIONACC)) then + col = BlockColStart + yFieldIdx(MASKID_TRANSLATIONACC) ! start of y%TranslationAcc field + call SetBlockMatrix( dUdy, MeshMap%dM%mi, row, col ) + endif - if (PRESENT(skipRotAcc)) then - if (skipRotAcc) return ! destination does not include rotational accelerations, so we'll just return - end if + ! source rotational acceleration to destination translational acceleration: + if (yFieldMask(MASKID_ROTATIONACC)) then + col = BlockColStart + yFieldIdx(MASKID_ROTATIONACC) ! start of y%RotationAcc field + call SetBlockMatrix( dUdy, MeshMap%dM%fx_p, row, col ) + endif + endif - !*** row for rotational acceleration *** - ! source rotational acceleration to destination rotational acceleration - row = BlockRowStart + u%NNodes*15 ! start of u%RotationAcc field [skip 5 fields with 3 components] - col = BlockColStart + y%NNodes*15 ! start of y%RotationAcc field [skip 5 fields with 3 components] + !*** row for rotational acceleration *** + if (uFieldMask(MASKID_ROTATIONACC) .and. yFieldMask(MASKID_ROTATIONACC)) then + ! source rotational acceleration to destination rotational acceleration + row = BlockRowStart + uFieldIdx(MASKID_ROTATIONACC ) ! start of u%RotationAcc field + col = BlockColStart + yFieldIdx(MASKID_ROTATIONACC ) ! start of y%RotationAcc field call SetBlockMatrix( dUdy, MeshMap%dM%mi, row, col ) + endif +contains + subroutine SetFieldIdx(FMask,NNodes,FIdx) + logical, intent(in ) :: FMask(FIELDMASK_SIZE) + integer, intent(in ) :: NNodes + integer, intent( out) :: FIdx(FIELDMASK_SIZE) + integer :: idxNext + FIdx = 0 + idxNext = 0 ! index 0 based + if (FMask(MASKID_TRANSLATIONDISP)) then; FIdx(MASKID_TRANSLATIONDISP) = idxNext; idxNext = FIdx(MASKID_TRANSLATIONDISP) + 3*NNodes; endif ! 3 fields for TRANSLATIONDISP + if (FMask(MASKID_ORIENTATION )) then; FIdx(MASKID_ORIENTATION ) = idxNext; idxNext = FIdx(MASKID_ORIENTATION ) + 3*NNodes; endif ! 3 fields for ORIENTATION + if (FMask(MASKID_TRANSLATIONVEL )) then; FIdx(MASKID_TRANSLATIONVEL ) = idxNext; idxNext = FIdx(MASKID_TRANSLATIONVEL ) + 3*NNodes; endif ! 3 fields for TRANSLATIONVEL + if (FMask(MASKID_ROTATIONVEL )) then; FIdx(MASKID_ROTATIONVEL ) = idxNext; idxNext = FIdx(MASKID_ROTATIONVEL ) + 3*NNodes; endif ! 3 fields for ROTATIONVEL + if (FMask(MASKID_TRANSLATIONACC )) then; FIdx(MASKID_TRANSLATIONACC ) = idxNext; idxNext = FIdx(MASKID_TRANSLATIONACC ) + 3*NNodes; endif ! 3 fields for TRANSLATIONACC + if (FMask(MASKID_ROTATIONACC )) then; FIdx(MASKID_ROTATIONACC ) = idxNext; idxNext = FIdx(MASKID_ROTATIONACC ) + 3*NNodes; endif ! 3 fields for ROTATIONACC + end subroutine SetFieldIdx END SUBROUTINE Assemble_dUdy_Motions + + !---------------------------------------------------------------------------------------------------------------------------------- !> This routine assembles the linearization matrices for transfer of load fields between two meshes. !> It set the following block matrix, which is the dUdy block for transfering output (source) mesh \f$y\f$ to the @@ -4856,237 +4750,243 @@ END SUBROUTINE Assemble_dUdy_Loads !---------------------------------------------------------------------------------------------------------------------------------- !> This routine returns the starting index for the u_ED%BladePtLoads(BladeNum) mesh in the FAST linearization inputs. -FUNCTION Indx_u_ED_Blade_Start(u_ED, y_FAST, BladeNum) RESULT(ED_Start) +FUNCTION Indx_u_ED_Blade_Start(p_ED, u_ED, y_FAST, BladeNum) RESULT(ED_Start) TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) TYPE(ED_InputType), INTENT(IN ) :: u_ED !< ED Inputs at t + TYPE(ED_ParameterType), INTENT(IN ) :: p_ED !< ED parameters INTEGER, INTENT(IN ) :: BladeNum !< blade number to find index for INTEGER :: k !< blade number loop - INTEGER :: ED_Start !< starting index of this blade mesh in ElastoDyn inputs - - ED_Start = y_FAST%Lin%Modules(Module_ED)%Instance(1)%LinStartIndx(LIN_INPUT_COL) + ED_Start = y_FAST%Lin%Modules(Module_ED)%Instance(1)%LinStartIndx(LIN_INPUT_COL) + (p_ED%Jac_u_idxStartList%BladeLoad - 1) ! index starts at 1 if (allocated(u_ED%BladePtLoads)) then do k = 1,min(BladeNum-1, size(u_ED%BladePtLoads)) ED_Start = ED_Start + u_ED%BladePtLoads(k)%NNodes * 6 ! 3 forces + 3 moments at each node on each blade end do end if - END FUNCTION Indx_u_ED_Blade_Start !---------------------------------------------------------------------------------------------------------------------------------- !> This routine returns the starting index for the u_ED%PlatformPtMesh mesh in the FAST linearization inputs. -FUNCTION Indx_u_ED_Platform_Start(u_ED, y_FAST) RESULT(ED_Start) +FUNCTION Indx_u_ED_Platform_Start(p_ED, u_ED, y_FAST) RESULT(ED_Start) TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) TYPE(ED_InputType), INTENT(IN ) :: u_ED !< ED Inputs at t + TYPE(ED_ParameterType), INTENT(IN ) :: p_ED !< ED parameters INTEGER :: ED_Start !< starting index of this mesh - - ED_Start = Indx_u_ED_Blade_Start(u_ED, y_FAST, MaxNBlades+1) ! skip all of the blades to get to start of platform + ED_Start = y_FAST%Lin%Modules(Module_ED)%Instance(1)%LinStartIndx(LIN_INPUT_COL) + (p_ED%Jac_u_idxStartList%PlatformLoad - 1) ! index starts at 1 END FUNCTION Indx_u_ED_Platform_Start !---------------------------------------------------------------------------------------------------------------------------------- !> This routine returns the starting index for the u_ED%TowerPtLoads mesh in the FAST linearization inputs. -FUNCTION Indx_u_ED_Tower_Start(u_ED, y_FAST) RESULT(ED_Start) +FUNCTION Indx_u_ED_Tower_Start(p_ED, u_ED, y_FAST) RESULT(ED_Start) TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) TYPE(ED_InputType), INTENT(IN ) :: u_ED !< ED Inputs at t - + TYPE(ED_ParameterType), INTENT(IN ) :: p_ED !< ED parameters INTEGER :: ED_Start !< starting index of this mesh - - ED_Start = Indx_u_ED_Platform_Start(u_ED, y_FAST) - ED_Start = ED_Start + u_ED%PlatformPtMesh%NNodes * 6 ! 3 forces + 3 moments at each node + ED_Start = y_FAST%Lin%Modules(Module_ED)%Instance(1)%LinStartIndx(LIN_INPUT_COL) + (p_ED%Jac_u_idxStartList%TowerLoad - 1) ! index starts at 1 END FUNCTION Indx_u_ED_Tower_Start !---------------------------------------------------------------------------------------------------------------------------------- !> This routine returns the starting index for the u_ED%HubPtLoad mesh in the FAST linearization inputs. -FUNCTION Indx_u_ED_Hub_Start(u_ED, y_FAST) RESULT(ED_Start) +FUNCTION Indx_u_ED_Hub_Start(p_ED, u_ED, y_FAST) RESULT(ED_Start) TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) TYPE(ED_InputType), INTENT(IN ) :: u_ED !< ED Inputs at t - + TYPE(ED_ParameterType), INTENT(IN ) :: p_ED !< ED parameters INTEGER :: ED_Start !< starting index of this mesh - - ED_Start = Indx_u_ED_Tower_Start(u_ED, y_FAST) - ED_Start = ED_Start + u_ED%TowerPtLoads%NNodes * 6 ! 3 forces + 3 moments at each node + ED_Start = y_FAST%Lin%Modules(Module_ED)%Instance(1)%LinStartIndx(LIN_INPUT_COL) + (p_ED%Jac_u_idxStartList%HubLoad - 1) ! index starts at 1 END FUNCTION Indx_u_ED_Hub_Start !---------------------------------------------------------------------------------------------------------------------------------- !> This routine returns the starting index for the u_ED%NacelleLoads mesh in the FAST linearization inputs. -FUNCTION Indx_u_ED_Nacelle_Start(u_ED, y_FAST) RESULT(ED_Start) +FUNCTION Indx_u_ED_Nacelle_Start(p_ED, u_ED, y_FAST) RESULT(ED_Start) TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) TYPE(ED_InputType), INTENT(IN ) :: u_ED !< ED Inputs at t - + TYPE(ED_ParameterType), INTENT(IN ) :: p_ED !< ED parameters INTEGER :: ED_Start !< starting index of this mesh - - ED_Start = Indx_u_ED_Hub_Start(u_ED, y_FAST) - ED_Start = ED_Start + u_ED%HubPtLoad%NNodes * 6 ! 3 forces + 3 moments at each node + ED_Start = y_FAST%Lin%Modules(Module_ED)%Instance(1)%LinStartIndx(LIN_INPUT_COL) + (p_ED%Jac_u_idxStartList%NacelleLoad - 1) ! index starts at 1 END FUNCTION Indx_u_ED_Nacelle_Start !---------------------------------------------------------------------------------------------------------------------------------- +!> This routine returns the starting index for the u_ED%NacelleLoads mesh in the FAST linearization inputs. +FUNCTION Indx_u_ED_TFin_Start(p_ED, u_ED, y_FAST) RESULT(ED_Start) + TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) + TYPE(ED_InputType), INTENT(IN ) :: u_ED !< ED Inputs at t + TYPE(ED_ParameterType), INTENT(IN ) :: p_ED !< ED parameters + INTEGER :: ED_Start !< starting index of this mesh + ED_Start = y_FAST%Lin%Modules(Module_ED)%Instance(1)%LinStartIndx(LIN_INPUT_COL) + (p_ED%Jac_u_idxStartList%TFinLoad - 1) ! index starts at 1 +END FUNCTION Indx_u_ED_TFin_Start +!---------------------------------------------------------------------------------------------------------------------------------- !> This routine returns the starting index for the u_ED%BladePitchCom array in the FAST linearization inputs. -FUNCTION Indx_u_ED_BlPitchCom_Start(u_ED, y_FAST) RESULT(ED_Start) +FUNCTION Indx_u_ED_BlPitchCom_Start(p_ED, u_ED, y_FAST) RESULT(ED_Start) TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) TYPE(ED_InputType), INTENT(IN ) :: u_ED !< ED Inputs at t - + TYPE(ED_ParameterType), INTENT(IN ) :: p_ED !< ED parameters INTEGER :: ED_Start !< starting index of this mesh - - ED_Start = Indx_u_ED_Nacelle_Start(u_ED, y_FAST) - ED_Start = ED_Start + u_ED%NacelleLoads%NNodes * 6 ! 3 forces + 3 moments at each node + ED_Start = y_FAST%Lin%Modules(Module_ED)%Instance(1)%LinStartIndx(LIN_INPUT_COL) + (p_ED%Jac_u_idxStartList%BlPitchCom - 1) ! index starts at 1 END FUNCTION Indx_u_ED_BlPitchCom_Start !---------------------------------------------------------------------------------------------------------------------------------- !---------------------------------------------------------------------------------------------------------------------------------- !> This routine returns the starting index for the y_ED%BladeLn2Mesh(BladeNum) mesh in the FAST linearization outputs. -FUNCTION Indx_y_ED_Blade_Start(y_ED, y_FAST, BladeNum) RESULT(ED_Out_Start) +FUNCTION Indx_y_ED_Blade_Start(p_ED, y_ED, y_FAST, BladeNum) RESULT(ED_Out_Start) TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) TYPE(ED_OutputType), INTENT(IN ) :: y_ED !< ED outputs at t + TYPE(ED_ParameterType), INTENT(IN ) :: p_ED !< ED parameters INTEGER, INTENT(IN ) :: BladeNum !< blade number to find index for INTEGER :: k !< blade number loop - INTEGER :: ED_Out_Start !< starting index of this blade mesh in ElastoDyn outputs - - ED_Out_Start = y_FAST%Lin%Modules(MODULE_ED)%Instance(1)%LinStartIndx(LIN_OUTPUT_COL) ! start of y_ED%BladeLn2Mesh(1)%TranslationDisp field (blade motions in y_ED) + ED_Out_Start = y_FAST%Lin%Modules(Module_ED)%Instance(1)%LinStartIndx(LIN_OUTPUT_COL) + (p_ED%Jac_y_idxStartList%Blade - 1) ! index starts at 1 if (allocated(y_ED%BladeLn2Mesh)) then do k = 1,min(BladeNum-1,SIZE(y_ED%BladeLn2Mesh,1)) ! Loop through all blades (p_ED%NumBl) ED_Out_Start = ED_Out_Start + y_ED%BladeLn2Mesh(k)%NNodes*18 ! 6 fields with 3 components on each blade end do end if - END FUNCTION Indx_y_ED_Blade_Start !---------------------------------------------------------------------------------------------------------------------------------- !> This routine returns the starting index for the y_ED%PlatformPtMesh mesh in the FAST linearization outputs. -FUNCTION Indx_y_ED_Platform_Start(y_ED, y_FAST) RESULT(ED_Out_Start) +FUNCTION Indx_y_ED_Platform_Start(p_ED, y_ED, y_FAST) RESULT(ED_Out_Start) TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) TYPE(ED_OutputType), INTENT(IN ) :: y_ED !< ED outputs at t - + TYPE(ED_ParameterType), INTENT(IN ) :: p_ED !< ED parameters INTEGER :: ED_Out_Start !< starting index of this mesh in ElastoDyn outputs - - ED_Out_Start = Indx_y_ED_Blade_Start(y_ED, y_FAST, MaxNBlades+1) ! skip all of the blades to get to start of platform + ED_Out_Start = y_FAST%Lin%Modules(Module_ED)%Instance(1)%LinStartIndx(LIN_OUTPUT_COL) + (p_ED%Jac_y_idxStartList%Platform - 1) ! index starts at 1 END FUNCTION Indx_y_ED_Platform_Start !---------------------------------------------------------------------------------------------------------------------------------- !> This routine returns the starting index for the y_ED%TowerLn2Mesh mesh in the FAST linearization outputs. -FUNCTION Indx_y_ED_Tower_Start(y_ED, y_FAST) RESULT(ED_Out_Start) +FUNCTION Indx_y_ED_Tower_Start(p_ED, y_ED, y_FAST) RESULT(ED_Out_Start) TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) TYPE(ED_OutputType), INTENT(IN ) :: y_ED !< ED outputs at t - + TYPE(ED_ParameterType), INTENT(IN ) :: p_ED !< ED parameters INTEGER :: ED_Out_Start !< starting index of this mesh in ElastoDyn outputs - - ED_Out_Start = Indx_y_ED_Platform_Start(y_ED, y_FAST) - ED_Out_Start = ED_Out_Start + y_ED%PlatformPtMesh%NNodes*18 ! 6 fields with 3 components + ED_Out_Start = y_FAST%Lin%Modules(Module_ED)%Instance(1)%LinStartIndx(LIN_OUTPUT_COL) + (p_ED%Jac_y_idxStartList%Tower - 1) ! index starts at 1 END FUNCTION Indx_y_ED_Tower_Start !---------------------------------------------------------------------------------------------------------------------------------- !> This routine returns the starting index for the y_ED%HubPtMesh mesh in the FAST linearization outputs. -FUNCTION Indx_y_ED_Hub_Start(y_ED, y_FAST) RESULT(ED_Out_Start) +FUNCTION Indx_y_ED_Hub_Start(p_ED, y_ED, y_FAST) RESULT(ED_Out_Start) TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) TYPE(ED_OutputType), INTENT(IN ) :: y_ED !< ED outputs at t - + TYPE(ED_ParameterType), INTENT(IN ) :: p_ED !< ED parameters INTEGER :: ED_Out_Start !< starting index of this mesh in ElastoDyn outputs - - ED_Out_Start = Indx_y_ED_Tower_Start(y_ED, y_FAST) - ED_Out_Start = ED_Out_Start + y_ED%TowerLn2Mesh%NNodes*18 ! 6 fields with 3 components + ED_Out_Start = y_FAST%Lin%Modules(Module_ED)%Instance(1)%LinStartIndx(LIN_OUTPUT_COL) + (p_ED%Jac_y_idxStartList%Hub - 1) ! index starts at 1 END FUNCTION Indx_y_ED_Hub_Start !---------------------------------------------------------------------------------------------------------------------------------- !> This routine returns the starting index for the y_ED%BladeRootMotion(BladeNum) mesh in the FAST linearization outputs. -FUNCTION Indx_y_ED_BladeRoot_Start(y_ED, y_FAST, BladeNum) RESULT(ED_Out_Start) +FUNCTION Indx_y_ED_BladeRoot_Start(p_ED, y_ED, y_FAST, BladeNum) RESULT(ED_Out_Start) TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) TYPE(ED_OutputType), INTENT(IN ) :: y_ED !< ED outputs at t + TYPE(ED_ParameterType), INTENT(IN ) :: p_ED !< ED parameters INTEGER, INTENT(IN ) :: BladeNum !< blade number to find index for INTEGER :: k !< blade number loop - INTEGER :: ED_Out_Start !< starting index of this blade mesh in ElastoDyn outputs - - ED_Out_Start = Indx_y_ED_Hub_Start(y_ED, y_FAST) - ED_Out_Start = ED_Out_Start + y_ED%HubPtMotion%NNodes*9 ! 3 fields with 3 components - + ED_Out_Start = y_FAST%Lin%Modules(Module_ED)%Instance(1)%LinStartIndx(LIN_OUTPUT_COL) + (p_ED%Jac_y_idxStartList%BladeRoot - 1) ! index starts at 1 do k = 1,min(BladeNum-1,size(y_ED%BladeRootMotion)) - ED_Out_Start = ED_Out_Start + y_ED%BladeRootMotion(k)%NNodes*18 + ED_Out_Start = ED_Out_Start + y_ED%BladeRootMotion(k)%NNodes*18 ! all fields end do END FUNCTION Indx_y_ED_BladeRoot_Start !---------------------------------------------------------------------------------------------------------------------------------- !> This routine returns the starting index for the y_ED%NacelleMotion mesh in the FAST linearization outputs. -FUNCTION Indx_y_ED_Nacelle_Start(y_ED, y_FAST) RESULT(ED_Out_Start) +FUNCTION Indx_y_ED_Nacelle_Start(p_ED, y_ED, y_FAST) RESULT(ED_Out_Start) TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) TYPE(ED_OutputType), INTENT(IN ) :: y_ED !< ED outputs at t + TYPE(ED_ParameterType), INTENT(IN ) :: p_ED !< ED parameters INTEGER :: k !< blade number loop - INTEGER :: ED_Out_Start !< starting index of this blade mesh in ElastoDyn outputs - - ED_Out_Start = Indx_y_ED_BladeRoot_Start(y_ED, y_FAST, size(y_ED%BladeRootMotion)) ! start of last blade root - ED_Out_Start = ED_Out_Start + y_ED%BladeRootMotion(size(y_ED%BladeRootMotion))%NNodes*18 ! N blade roots, 6 fields with 3 components per blade. + ED_Out_Start = y_FAST%Lin%Modules(Module_ED)%Instance(1)%LinStartIndx(LIN_OUTPUT_COL) + (p_ED%Jac_y_idxStartList%Nacelle - 1) ! index starts at 1 END FUNCTION Indx_y_ED_Nacelle_Start !---------------------------------------------------------------------------------------------------------------------------------- +!> This routine returns the starting index for the y_ED%TFinCMMotion mesh in the FAST linearization outputs. +FUNCTION Indx_y_ED_TFin_Start(p_ED, y_ED, y_FAST) RESULT(ED_Out_Start) + TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) + TYPE(ED_OutputType), INTENT(IN ) :: y_ED !< ED outputs at t + TYPE(ED_ParameterType), INTENT(IN ) :: p_ED !< ED parameters + INTEGER :: k !< blade number loop + INTEGER :: ED_Out_Start !< starting index of tailfin mesh in ElastoDyn outputs + ED_Out_Start = y_FAST%Lin%Modules(Module_ED)%Instance(1)%LinStartIndx(LIN_OUTPUT_COL) + (p_ED%Jac_y_idxStartList%TFin - 1) ! index starts at 1 +END FUNCTION Indx_y_ED_TFin_Start +!---------------------------------------------------------------------------------------------------------------------------------- !> This routine returns the starting index for y_ED%Yaw in the FAST linearization outputs. FUNCTION Indx_y_Yaw_Start(y_FAST, ThisModule) RESULT(ED_Out_Start) TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) INTEGER, INTENT(IN ) :: ThisModule !< which structural module this is for - INTEGER :: ED_Out_Start !< starting index of this blade mesh in ElastoDyn outputs - - ED_Out_Start = y_FAST%Lin%Modules(thisModule)%Instance(1)%LinStartIndx(LIN_OUTPUT_COL) + y_FAST%Lin%Modules(thisModule)%Instance(1)%SizeLin(LIN_OUTPUT_COL) & !end of ED outputs (+1) - y_FAST%Lin%Modules(thisModule)%Instance(1)%NumOutputs - 3 ! start of ED where Yaw, YawRate, HSS_Spd occur (right before WriteOutputs) - END FUNCTION Indx_y_Yaw_Start !---------------------------------------------------------------------------------------------------------------------------------- + +! Indexing to AD15 Jac_u. Order is: +! Nacelle +! Hub +! Tower +! BladeRoot +! Blades +! TailFin +! UserProp +! Extended inputs !---------------------------------------------------------------------------------------------------------------------------------- -!> This routine returns the starting index for the u_AD%TowerMotion mesh in the FAST linearization inputs. -FUNCTION Indx_u_AD_Tower_Start(u_AD, y_FAST) RESULT(AD_Start) +!> This routine returns the starting index for the u_AD%rotors(1)%NacelleMotion mesh in the FAST linearization inputs. +FUNCTION Indx_u_AD_Nacelle_Start(p_AD, u_AD, y_FAST) RESULT(AD_Start) TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) TYPE(AD_InputType), INTENT(IN ) :: u_AD !< AD Inputs at t - + TYPE(AD_ParameterType), INTENT(IN ) :: p_AD !< AD parameters INTEGER :: AD_Start !< starting index of this mesh in AeroDyn inputs - - AD_Start = y_FAST%Lin%Modules(Module_AD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) - -END FUNCTION Indx_u_AD_Tower_Start + AD_Start = y_FAST%Lin%Modules(Module_AD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) + (p_AD%rotors(1)%Jac_u_idxStartList%Nacelle - 1) ! index starts at 1 +END FUNCTION Indx_u_AD_Nacelle_Start !---------------------------------------------------------------------------------------------------------------------------------- -!> This routine returns the starting index for the u_AD%HubMotion mesh in the FAST linearization inputs. -FUNCTION Indx_u_AD_Hub_Start(u_AD, y_FAST) RESULT(AD_Start) +!> This routine returns the starting index for the u_AD%rotors(1)%NacelleMotion mesh in the FAST linearization inputs. +FUNCTION Indx_u_AD_Hub_Start(p_AD, u_AD, y_FAST) RESULT(AD_Start) TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) TYPE(AD_InputType), INTENT(IN ) :: u_AD !< AD Inputs at t - + TYPE(AD_ParameterType), INTENT(IN ) :: p_AD !< AD parameters INTEGER :: AD_Start !< starting index of this mesh in AeroDyn inputs - - AD_Start = Indx_u_AD_Tower_Start(u_AD, y_FAST) + u_AD%rotors(1)%TowerMotion%NNodes * 9 ! 3 fields (MASKID_TRANSLATIONDISP,MASKID_Orientation,MASKID_TRANSLATIONVel) with 3 components - + AD_Start = y_FAST%Lin%Modules(Module_AD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) + (p_AD%rotors(1)%Jac_u_idxStartList%Hub - 1) ! index starts at 1 END FUNCTION Indx_u_AD_Hub_Start !---------------------------------------------------------------------------------------------------------------------------------- -!> This routine returns the starting index for the u_AD%BladeRootMotion(k) mesh in the FAST linearization inputs. -FUNCTION Indx_u_AD_BladeRoot_Start(u_AD, y_FAST, BladeNum) RESULT(AD_Start) +!> This routine returns the starting index for the u_AD%rotors(1)%TowerMotion mesh in the FAST linearization inputs. +FUNCTION Indx_u_AD_Tower_Start(p_AD, u_AD, y_FAST) RESULT(AD_Start) + TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) + TYPE(AD_InputType), INTENT(IN ) :: u_AD !< AD Inputs at t + TYPE(AD_ParameterType), INTENT(IN ) :: p_AD !< AD parameters + INTEGER :: AD_Start !< starting index of this mesh in AeroDyn inputs + AD_Start = y_FAST%Lin%Modules(Module_AD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) + (p_AD%rotors(1)%Jac_u_idxStartList%Tower - 1) ! index starts at 1 +END FUNCTION Indx_u_AD_Tower_Start +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine returns the starting index for the u_AD%rotors(1)%TFinMotion mesh in the FAST linearization inputs. +FUNCTION Indx_u_AD_TFin_Start(p_AD, u_AD, y_FAST) RESULT(AD_Start) + TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) + TYPE(AD_InputType), INTENT(IN ) :: u_AD !< AD Inputs at t + TYPE(AD_ParameterType), INTENT(IN ) :: p_AD !< AD parameters + INTEGER :: AD_Start !< starting index of this mesh in AeroDyn inputs + AD_Start = y_FAST%Lin%Modules(Module_AD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) + (p_AD%rotors(1)%Jac_u_idxStartList%TFin - 1) ! index starts at 1 +END FUNCTION Indx_u_AD_TFin_Start +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine returns the starting index for the u_AD%rotors(1)%BladeRootMotion(k) mesh in the FAST linearization inputs. +FUNCTION Indx_u_AD_BladeRoot_Start(p_AD, u_AD, y_FAST, BladeNum) RESULT(AD_Start) TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) TYPE(AD_InputType), INTENT(IN ) :: u_AD !< AD Inputs at t + TYPE(AD_ParameterType), INTENT(IN ) :: p_AD !< AD parameters INTEGER, INTENT(IN ) :: BladeNum !< blade number to find index for INTEGER :: k !< blade number loop - INTEGER :: AD_Start !< starting index of this mesh in AeroDyn inputs - AD_Start = Indx_u_AD_Hub_Start(u_AD, y_FAST) + u_AD%rotors(1)%HubMotion%NNodes * 9 ! 3 fields (MASKID_TRANSLATIONDISP,MASKID_Orientation,MASKID_RotationVel) with 3 components + AD_Start = y_FAST%Lin%Modules(Module_AD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) + (p_AD%rotors(1)%Jac_u_idxStartList%BladeRoot - 1) ! index starts at 1 do k = 1,min(BladeNum-1,size(u_AD%rotors(1)%BladeRootMotion)) AD_Start = AD_Start + u_AD%rotors(1)%BladeRootMotion(k)%NNodes * 3 ! 1 field (MASKID_Orientation) with 3 components end do END FUNCTION Indx_u_AD_BladeRoot_Start !---------------------------------------------------------------------------------------------------------------------------------- -!> This routine returns the starting index for the u_AD%BladeMotion(k) mesh in the FAST linearization inputs. -FUNCTION Indx_u_AD_Blade_Start(u_AD, y_FAST, BladeNum) RESULT(AD_Start) +!> This routine returns the starting index for the u_AD%rotors(1)%BladeMotion(k) mesh in the FAST linearization inputs. +FUNCTION Indx_u_AD_Blade_Start(p_AD, u_AD, y_FAST, BladeNum) RESULT(AD_Start) TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) TYPE(AD_InputType), INTENT(IN ) :: u_AD !< AD Inputs at t + TYPE(AD_ParameterType), INTENT(IN ) :: p_AD !< AD parameters INTEGER, INTENT(IN ) :: BladeNum !< blade number to find index for INTEGER :: k !< blade number loop - INTEGER :: AD_Start !< starting index of this mesh in AeroDyn inputs - AD_Start = Indx_u_AD_BladeRoot_Start(u_AD, y_FAST, MaxNBlades+1) + AD_Start = y_FAST%Lin%Modules(Module_AD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) + (p_AD%rotors(1)%Jac_u_idxStartList%Blade - 1) ! index starts at 1 do k = 1,min(BladeNum-1,size(u_AD%rotors(1)%BladeMotion)) - AD_Start = AD_Start + u_AD%rotors(1)%BladeMotion(k)%NNodes * 15 ! 5 fields (TranslationDisp, MASKID_Orientation, TranslationVel, RotationVel, TranslationAcc) with 3 components + AD_Start = AD_Start + u_AD%rotors(1)%BladeMotion(k)%NNodes * 18 ! 6 fields (TranslationDisp, MASKID_Orientation, TranslationVel, RotationVel, TranslationAcc, RotationAcc) with 3 components end do END FUNCTION Indx_u_AD_Blade_Start -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine returns the starting index for the u_AD%InflowOnBlade array in the FAST linearization inputs. -FUNCTION Indx_u_AD_BladeInflow_Start(u_AD, y_FAST) RESULT(AD_Start) - TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) - TYPE(AD_InputType), INTENT(IN ) :: u_AD !< AD Inputs at t - - INTEGER :: AD_Start !< starting index of this array in AeroDyn inputs - AD_Start = Indx_u_AD_Blade_Start(u_AD, y_FAST, MaxNBlades+1) - -END FUNCTION Indx_u_AD_BladeInflow_Start -!---------------------------------------------------------------------------------------------------------------------------------- !---------------------------------------------------------------------------------------------------------------------------------- !> This routine returns the starting index for the u_SD%TPMesh mesh in the FAST linearization inputs. @@ -5099,6 +4999,38 @@ FUNCTION Indx_u_SD_TPMesh_Start(u_SD, y_FAST) RESULT(SD_Start) SD_Start = y_FAST%Lin%Modules(Module_SD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) END FUNCTION Indx_u_SD_TPMesh_Start +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine returns the starting index for the y_SD%Y1Mesh mesh in the FAST linearization outputs. +FUNCTION Indx_y_SD_Y1Mesh_Start(y_SD, y_FAST) RESULT(SD_Out_Start) + TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) + TYPE(SD_OutputType), INTENT(IN ) :: y_SD !< SD outputs at t + + INTEGER :: SD_Out_Start !< starting index of this mesh in ElastoDyn outputs + + SD_Out_Start = y_FAST%Lin%Modules(MODULE_SD)%Instance(1)%LinStartIndx(LIN_OUTPUT_COL) +END FUNCTION Indx_y_SD_Y1Mesh_Start +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine returns the starting index for the y_SD%Y2Mesh mesh in the FAST linearization outputs. +FUNCTION Indx_y_SD_Y2Mesh_Start(y_SD, y_FAST) RESULT(SD_Out_Start) + TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) + TYPE(SD_OutputType), INTENT(IN ) :: y_SD !< SD outputs at t + + INTEGER :: SD_Out_Start !< starting index of this mesh in ElastoDyn outputs + + SD_Out_Start = Indx_y_SD_Y1Mesh_Start(y_SD, y_FAST) + y_SD%Y1Mesh%NNodes * 6 ! 3 forces + 3 moments at each node! skip all of the Y1Mesh data and get to the beginning of +END FUNCTION Indx_y_SD_Y2Mesh_Start +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine returns the starting index for the y_SD%Y3Mesh mesh in the FAST linearization outputs. +FUNCTION Indx_y_SD_Y3Mesh_Start(y_SD, y_FAST) RESULT(SD_Out_Start) + TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) + TYPE(SD_OutputType), INTENT(IN ) :: y_SD !< SD outputs at t + + INTEGER :: SD_Out_Start !< starting index of this mesh in ElastoDyn outputs + + SD_Out_Start = Indx_y_SD_Y2Mesh_Start(y_SD, y_FAST) + y_SD%Y2Mesh%NNodes * 6 ! 3 forces + 3 moments at each node! skip all of the Y1Mesh data and get to the beginning of +END FUNCTION Indx_y_SD_Y3Mesh_Start +!---------------------------------------------------------------------------------------------------------------------------------- + !---------------------------------------------------------------------------------------------------------------------------------- !> This routine returns the starting index for the u_SD%TPMesh mesh in the FAST linearization inputs. FUNCTION Indx_u_SD_LMesh_Start(u_SD, y_FAST) RESULT(SD_Start) @@ -5144,7 +5076,19 @@ FUNCTION Indx_u_HD_PRP_Start(u_HD, y_FAST) RESULT(HD_Start) HD_Start = Indx_u_HD_WAMIT_Start(u_HD, y_FAST) if (u_HD%WAMITMesh%committed) HD_Start = HD_Start + u_HD%WAMITMesh%NNodes * 18 ! 6 fields (MASKID_TRANSLATIONDISP,MASKID_Orientation,MASKID_TRANSLATIONVel,MASKID_ROTATIONVel,MASKID_TRANSLATIONAcc,MASKID_ROTATIONAcc) with 3 components - END FUNCTION Indx_u_HD_PRP_Start +END FUNCTION Indx_u_HD_PRP_Start +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine returns the starting index for the u_HD%PRPMesh mesh in the FAST linearization inputs. +function Indx_u_HD_Ext_Start(u_HD, y_FAST) RESULT(HD_Start) + type(FAST_OutputFileType), intent(in ) :: y_FAST !< FAST output file data (for linearization) + type(HydroDyn_InputType), intent(in ) :: u_HD !< HD Inputs at t + + integer :: HD_Start !< starting index of this mesh in HydroDyn inputs + + HD_Start = Indx_u_HD_PRP_Start(u_HD, y_FAST) + if (u_HD%WAMITMesh%committed) HD_Start = HD_Start + u_HD%PRPMesh%NNodes * 18 ! 6 fields (MASKID_TRANSLATIONDISP,MASKID_Orientation,MASKID_TRANSLATIONVel,MASKID_ROTATIONVel,MASKID_TRANSLATIONAcc,MASKID_ROTATIONAcc) with 3 components + +end function Indx_u_HD_Ext_Start !---------------------------------------------------------------------------------------------------------------------------------- !> This routine returns the starting index for the y_HD%Morison%DistribMesh mesh in the FAST linearization outputs. FUNCTION Indx_y_HD_Morison_Start(y_HD, y_FAST) RESULT(HD_Start) @@ -5171,34 +5115,6 @@ FUNCTION Indx_y_HD_WAMIT_Start(y_HD, y_FAST) RESULT(HD_Start) END FUNCTION Indx_y_HD_WAMIT_Start !---------------------------------------------------------------------------------------------------------------------------------- -!> This routine returns the starting index for the y_SD%Y1Mesh mesh in the FAST linearization outputs. -FUNCTION Indx_y_SD_Y1Mesh_Start(y_SD, y_FAST) RESULT(SD_Out_Start) - TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) - TYPE(SD_OutputType), INTENT(IN ) :: y_SD !< SD outputs at t - - INTEGER :: SD_Out_Start !< starting index of this mesh in SubDyn outputs - - SD_Out_Start = y_FAST%Lin%Modules(MODULE_SD)%Instance(1)%LinStartIndx(LIN_OUTPUT_COL) -END FUNCTION Indx_y_SD_Y1Mesh_Start -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine returns the starting index for the y_SD%Y2Mesh mesh in the FAST linearization outputs. -FUNCTION Indx_y_SD_Y2Mesh_Start(y_SD, y_FAST) RESULT(SD_Out_Start) - TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) - TYPE(SD_OutputType), INTENT(IN ) :: y_SD !< SD outputs at t - - INTEGER :: SD_Out_Start !< starting index of this mesh in SubDyn outputs - - SD_Out_Start = Indx_y_SD_Y1Mesh_Start(y_SD, y_FAST) + y_SD%Y1Mesh%NNodes * 6 ! 3 forces + 3 moments at each node! skip all of the Y1Mesh data and get to the beginning of -END FUNCTION Indx_y_SD_Y2Mesh_Start -!> This routine returns the starting index for the y_SD%Y3Mesh mesh in the FAST linearization outputs. -FUNCTION Indx_y_SD_Y3Mesh_Start(y_SD, y_FAST) RESULT(SD_Out_Start) - TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) - TYPE(SD_OutputType), INTENT(IN ) :: y_SD !< SD outputs at t - - INTEGER :: SD_Out_Start !< starting index of this mesh in SubDyn outputs - - SD_Out_Start = Indx_y_SD_Y2Mesh_Start(y_SD, y_FAST) + y_SD%Y2Mesh%NNodes * 6 ! 3 forces + 3 moments at each node! skip all of the Y2Mesh data and get to the beginning of Y3Mesh -END FUNCTION Indx_y_SD_Y3Mesh_Start !---------------------------------------------------------------------------------------------------------------------------------- !> This subroutine allocates the arrays that store the operating point at each linearization time for later producing VTK @@ -5213,6 +5129,7 @@ SUBROUTINE AllocateOP(p_FAST, y_FAST, ErrStat, ErrMsg ) ! local variables INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AllocateOP' @@ -5224,28 +5141,18 @@ SUBROUTINE AllocateOP(p_FAST, y_FAST, ErrStat, ErrMsg ) !---------------------------------------------------------------------------------------- - ALLOCATE( y_FAST%op%x_ED(p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) - ALLOCATE( y_FAST%op%xd_ED(p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) - ALLOCATE( y_FAST%op%z_ED(p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) - ALLOCATE( y_FAST%op%OtherSt_ED(p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) - ALLOCATE( y_FAST%op%u_ED(p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%x_ED(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("ElastoDyn operating point data")) return; + ALLOCATE( y_FAST%op%xd_ED(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("ElastoDyn operating point data")) return; + ALLOCATE( y_FAST%op%z_ED(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("ElastoDyn operating point data")) return; + ALLOCATE( y_FAST%op%OtherSt_ED(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("ElastoDyn operating point data")) return; + ALLOCATE( y_FAST%op%u_ED(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("ElastoDyn operating point data")) return; IF ( p_FAST%CompElast == Module_BD ) THEN - ALLOCATE( y_FAST%op%x_BD(p_FAST%nBeams, p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) - ALLOCATE( y_FAST%op%xd_BD(p_FAST%nBeams, p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) - ALLOCATE( y_FAST%op%z_BD(p_FAST%nBeams, p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) - ALLOCATE( y_FAST%op%OtherSt_BD(p_FAST%nBeams, p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) - ALLOCATE( y_FAST%op%u_BD(p_FAST%nBeams, p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%x_BD(p_FAST%nBeams, p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("BeamDyn operating point data")) return; + ALLOCATE( y_FAST%op%xd_BD(p_FAST%nBeams, p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("BeamDyn operating point data")) return; + ALLOCATE( y_FAST%op%z_BD(p_FAST%nBeams, p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("BeamDyn operating point data")) return; + ALLOCATE( y_FAST%op%OtherSt_BD(p_FAST%nBeams, p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("BeamDyn operating point data")) return; + ALLOCATE( y_FAST%op%u_BD(p_FAST%nBeams, p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("BeamDyn operating point data")) return; END IF @@ -5253,155 +5160,117 @@ SUBROUTINE AllocateOP(p_FAST, y_FAST, ErrStat, ErrMsg ) !IF ( p_FAST%CompAero == Module_AD14 ) THEN !ELSE IF ( p_FAST%CompAero == Module_AD ) THEN - ALLOCATE( y_FAST%op%x_AD(p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) - ALLOCATE( y_FAST%op%xd_AD(p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) - ALLOCATE( y_FAST%op%z_AD(p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) - ALLOCATE( y_FAST%op%OtherSt_AD(p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) - ALLOCATE( y_FAST%op%u_AD(p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%x_AD(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("AeroDyn operating point data")) return; + ALLOCATE( y_FAST%op%xd_AD(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("AeroDyn operating point data")) return; + ALLOCATE( y_FAST%op%z_AD(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("AeroDyn operating point data")) return; + ALLOCATE( y_FAST%op%OtherSt_AD(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("AeroDyn operating point data")) return; + ALLOCATE( y_FAST%op%u_AD(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("AeroDyn operating point data")) return; END IF IF ( p_FAST%CompInflow == Module_IfW ) THEN - ALLOCATE( y_FAST%op%x_IfW(p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) - ALLOCATE( y_FAST%op%xd_IfW(p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) - ALLOCATE( y_FAST%op%z_IfW(p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) - ALLOCATE( y_FAST%op%OtherSt_IfW(p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) - ALLOCATE( y_FAST%op%u_IfW(p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%x_IfW(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("InflowWind operating point data")) return; + ALLOCATE( y_FAST%op%xd_IfW(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("InflowWind operating point data")) return; + ALLOCATE( y_FAST%op%z_IfW(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("InflowWind operating point data")) return; + ALLOCATE( y_FAST%op%OtherSt_IfW(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("InflowWind operating point data")) return; + ALLOCATE( y_FAST%op%u_IfW(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("InflowWind operating point data")) return; END IF - - + + if ( p_FAST%CompSeaSt == Module_SeaSt ) then + allocate( y_FAST%op%x_SeaSt(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("SeaState operating point data")) return; + allocate( y_FAST%op%xd_SeaSt(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("SeaState operating point data")) return; + allocate( y_FAST%op%z_SeaSt(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("SeaState operating point data")) return; + allocate( y_FAST%op%OtherSt_SeaSt(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("SeaState operating point data")) return; + allocate( y_FAST%op%u_SeaSt(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("SeaState operating point data")) return; + endif + IF ( p_FAST%CompServo == Module_SrvD ) THEN - ALLOCATE( y_FAST%op%x_SrvD(p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) - ALLOCATE( y_FAST%op%xd_SrvD(p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) - ALLOCATE( y_FAST%op%z_SrvD(p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) - ALLOCATE( y_FAST%op%OtherSt_SrvD(p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) - ALLOCATE( y_FAST%op%u_SrvD(p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%x_SrvD(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("ServoDyn operating point data")) return; + ALLOCATE( y_FAST%op%xd_SrvD(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("ServoDyn operating point data")) return; + ALLOCATE( y_FAST%op%z_SrvD(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("ServoDyn operating point data")) return; + ALLOCATE( y_FAST%op%OtherSt_SrvD(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("ServoDyn operating point data")) return; + ALLOCATE( y_FAST%op%u_SrvD(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("ServoDyn operating point data")) return; END IF IF ( p_FAST%CompHydro == Module_HD ) THEN - ALLOCATE( y_FAST%op%x_HD(p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) - ALLOCATE( y_FAST%op%xd_HD(p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) - ALLOCATE( y_FAST%op%z_HD(p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) - ALLOCATE( y_FAST%op%OtherSt_HD(p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) - ALLOCATE( y_FAST%op%u_HD(p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%x_HD(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("HydroDyn operating point data")) return; + ALLOCATE( y_FAST%op%xd_HD(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("HydroDyn operating point data")) return; + ALLOCATE( y_FAST%op%z_HD(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("HydroDyn operating point data")) return; + ALLOCATE( y_FAST%op%OtherSt_HD(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("HydroDyn operating point data")) return; + ALLOCATE( y_FAST%op%u_HD(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("HydroDyn operating point data")) return; END IF ! SubDyn: copy final predictions to actual states IF ( p_FAST%CompSub == Module_SD ) THEN - ALLOCATE( y_FAST%op%x_SD(p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) - ALLOCATE( y_FAST%op%xd_SD(p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) - ALLOCATE( y_FAST%op%z_SD(p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) - ALLOCATE( y_FAST%op%OtherSt_SD(p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) - ALLOCATE( y_FAST%op%u_SD(p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%x_SD(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("SubDyn operating point data")) return; + ALLOCATE( y_FAST%op%xd_SD(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("SubDyn operating point data")) return; + ALLOCATE( y_FAST%op%z_SD(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("SubDyn operating point data")) return; + ALLOCATE( y_FAST%op%OtherSt_SD(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("SubDyn operating point data")) return; + ALLOCATE( y_FAST%op%u_SD(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("SubDyn operating point data")) return; ELSE IF ( p_FAST%CompSub == Module_ExtPtfm ) THEN - ALLOCATE( y_FAST%op%x_ExtPtfm(p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) - ALLOCATE( y_FAST%op%xd_ExtPtfm(p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) - ALLOCATE( y_FAST%op%z_ExtPtfm(p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) - ALLOCATE( y_FAST%op%OtherSt_ExtPtfm(p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) - ALLOCATE( y_FAST%op%u_ExtPtfm(p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%x_ExtPtfm(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("ExtPtfm operating point data")) return; + ALLOCATE( y_FAST%op%xd_ExtPtfm(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("ExtPtfm operating point data")) return; + ALLOCATE( y_FAST%op%z_ExtPtfm(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("ExtPtfm operating point data")) return; + ALLOCATE( y_FAST%op%OtherSt_ExtPtfm(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("ExtPtfm operating point data")) return; + ALLOCATE( y_FAST%op%u_ExtPtfm(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("ExtPtfm operating point data")) return; END IF ! MAP/MoorDyn/FEAM: copy states and inputs to OP array IF (p_FAST%CompMooring == Module_MAP) THEN - ALLOCATE( y_FAST%op%x_MAP(p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) - ALLOCATE( y_FAST%op%xd_MAP(p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) - ALLOCATE( y_FAST%op%z_MAP(p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) - !ALLOCATE( y_FAST%op%OtherSt_MAP(p_FAST%NLinTimes), STAT=ErrStat2 ) - ! if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) - ALLOCATE( y_FAST%op%u_MAP(p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%x_MAP(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("MAP operating point data")) return; + ALLOCATE( y_FAST%op%xd_MAP(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("MAP operating point data")) return; + ALLOCATE( y_FAST%op%z_MAP(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("MAP operating point data")) return; + !ALLOCATE( y_FAST%op%OtherSt_MAP(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("MAP operating point data")) return; + ALLOCATE( y_FAST%op%u_MAP(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("MAP operating point data")) return; ELSEIF (p_FAST%CompMooring == Module_MD) THEN - ALLOCATE( y_FAST%op%x_MD(p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) - ALLOCATE( y_FAST%op%xd_MD(p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) - ALLOCATE( y_FAST%op%z_MD(p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) - ALLOCATE( y_FAST%op%OtherSt_MD(p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) - ALLOCATE( y_FAST%op%u_MD(p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%x_MD(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("MoorDyn operating point data")) return; + ALLOCATE( y_FAST%op%xd_MD(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("MoorDyn operating point data")) return; + ALLOCATE( y_FAST%op%z_MD(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("MoorDyn operating point data")) return; + ALLOCATE( y_FAST%op%OtherSt_MD(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("MoorDyn operating point data")) return; + ALLOCATE( y_FAST%op%u_MD(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("MoorDyn operating point data")) return; ELSEIF (p_FAST%CompMooring == Module_FEAM) THEN - ALLOCATE( y_FAST%op%x_FEAM(p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) - ALLOCATE( y_FAST%op%xd_FEAM(p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) - ALLOCATE( y_FAST%op%z_FEAM(p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) - ALLOCATE( y_FAST%op%OtherSt_FEAM(p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) - ALLOCATE( y_FAST%op%u_FEAM(p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%x_FEAM(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("FEAM operating point data")) return; + ALLOCATE( y_FAST%op%xd_FEAM(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("FEAM operating point data")) return; + ALLOCATE( y_FAST%op%z_FEAM(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("FEAM operating point data")) return; + ALLOCATE( y_FAST%op%OtherSt_FEAM(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("FEAM operating point data")) return; + ALLOCATE( y_FAST%op%u_FEAM(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("FEAM operating point data")) return; !ELSEIF (p_FAST%CompMooring == Module_Orca) THEN END IF ! IceFloe/IceDyn: copy states and inputs to OP array IF ( p_FAST%CompIce == Module_IceF ) THEN - ALLOCATE( y_FAST%op%x_IceF(p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) - ALLOCATE( y_FAST%op%xd_IceF(p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) - ALLOCATE( y_FAST%op%z_IceF(p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) - ALLOCATE( y_FAST%op%OtherSt_IceF(p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) - ALLOCATE( y_FAST%op%u_IceF(p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%x_IceF(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("IceFloe operating point data")) return; + ALLOCATE( y_FAST%op%xd_IceF(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("IceFloe operating point data")) return; + ALLOCATE( y_FAST%op%z_IceF(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("IceFloe operating point data")) return; + ALLOCATE( y_FAST%op%OtherSt_IceF(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("IceFloe operating point data")) return; + ALLOCATE( y_FAST%op%u_IceF(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("IceFloe operating point data")) return; ELSEIF ( p_FAST%CompIce == Module_IceD ) THEN - ALLOCATE( y_FAST%op%x_IceD(p_FAST%numIceLegs, p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) - ALLOCATE( y_FAST%op%xd_IceD(p_FAST%numIceLegs, p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) - ALLOCATE( y_FAST%op%z_IceD(p_FAST%numIceLegs, p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) - ALLOCATE( y_FAST%op%OtherSt_IceD(p_FAST%numIceLegs, p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) - ALLOCATE( y_FAST%op%u_IceD(p_FAST%numIceLegs, p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%x_IceD(p_FAST%numIceLegs, p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("IceDyn operating point data")) return; + ALLOCATE( y_FAST%op%xd_IceD(p_FAST%numIceLegs, p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("IceDyn operating point data")) return; + ALLOCATE( y_FAST%op%z_IceD(p_FAST%numIceLegs, p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("IceDyn operating point data")) return; + ALLOCATE( y_FAST%op%OtherSt_IceD(p_FAST%numIceLegs, p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("IceDyn operating point data")) return; + ALLOCATE( y_FAST%op%u_IceD(p_FAST%numIceLegs, p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("IceDyn operating point data")) return; END IF - + +contains + ! check for failed where /= 0 is fatal + logical function Failed0(txt) + character(*), intent(in) :: txt + if (errStat /= 0) then + ErrStat2 = ErrID_Fatal + ErrMsg2 = "Could not allocate "//trim(txt) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + endif + Failed0 = ErrStat >= AbortErrLev + end function Failed0 END SUBROUTINE AllocateOP !---------------------------------------------------------------------------------------------------------------------------------- !> This subroutine is the inverse of SetOperatingPoint(). It saves the current operating points so they can be retrieved !> when visualizing mode shapes. -SUBROUTINE SaveOP(i, p_FAST, y_FAST, ED, BD, SrvD, AD, IfW, OpFM, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & +SUBROUTINE SaveOP(i, p_FAST, y_FAST, ED, BD, SrvD, AD, IfW, ExtInfw, HD, SeaSt, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & IceF, IceD, ErrStat, ErrMsg, CtrlCode ) - INTEGER(IntKi) , INTENT(IN ) :: i !< current index into LinTimes TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Output variables for the glue code @@ -5411,8 +5280,9 @@ SUBROUTINE SaveOP(i, p_FAST, y_FAST, ED, BD, SrvD, AD, IfW, OpFM, HD, SD, ExtPtf TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data - TYPE(OpenFOAM_Data), INTENT(INOUT) :: OpFM !< OpenFOAM data + TYPE(ExternalInflow_Data),INTENT(INOUT) :: ExtInfw !< ExternalInflow data TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HydroDyn data + TYPE(SeaState_Data), INTENT(INOUT) :: SeaSt !< SeaState data TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SubDyn data TYPE(ExtPtfm_Data), INTENT(INOUT) :: ExtPtfm !< ExtPtfm_MCKF data TYPE(MAP_Data), INTENT(INOUT) :: MAPp !< MAP data @@ -5491,7 +5361,7 @@ SUBROUTINE SaveOP(i, p_FAST, y_FAST, ED, BD, SrvD, AD, IfW, OpFM, HD, SD, ExtPtf CALL AD_CopyInput (AD%Input(1), y_FAST%op%u_AD(i), CtrlCode, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END IF - + ! InflowWind: copy states and inputs to OP array IF ( p_FAST%CompInflow == Module_IfW ) THEN CALL InflowWind_CopyContState (IfW%x( STATE_CURR), y_FAST%op%x_IfW( i), CtrlCode, Errstat2, ErrMsg2) @@ -5505,10 +5375,23 @@ SUBROUTINE SaveOP(i, p_FAST, y_FAST, ED, BD, SrvD, AD, IfW, OpFM, HD, SD, ExtPtf CALL InflowWind_CopyInput (IfW%Input(1), y_FAST%op%u_IfW(i), CtrlCode, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END IF - - + + ! SeaState: copy states and inputs to OP array + if ( p_FAST%CompSeaSt == Module_SeaSt ) then + call SeaSt_CopyContState (SeaSt%x( STATE_CURR), y_FAST%op%x_SeaSt( i), CtrlCode, Errstat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + call SeaSt_CopyDiscState (SeaSt%xd(STATE_CURR), y_FAST%op%xd_SeaSt( i), CtrlCode, Errstat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + call SeaSt_CopyConstrState (SeaSt%z( STATE_CURR), y_FAST%op%z_SeaSt( i), CtrlCode, Errstat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + call SeaSt_CopyOtherState( SeaSt%OtherSt( STATE_CURR), y_FAST%op%OtherSt_SeaSt( i), CtrlCode, Errstat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + call SeaSt_CopyInput (SeaSt%Input(1), y_FAST%op%u_SeaSt(i), CtrlCode, Errstat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + endif + ! ServoDyn: copy states and inputs to OP array IF ( p_FAST%CompServo == Module_SrvD ) THEN CALL SrvD_CopyContState (SrvD%x( STATE_CURR), y_FAST%op%x_SrvD( i), CtrlCode, Errstat2, ErrMsg2) @@ -5646,7 +5529,7 @@ END SUBROUTINE SaveOP !---------------------------------------------------------------------------------------------------------------------------------- !> This subroutine takes arrays representing the eigenvector of the states and uses it to modify the operating points for !! continuous states. It is highly tied to the module organizaton. -SUBROUTINE PerturbOP(t, iLinTime, iMode, p_FAST, y_FAST, ED, BD, SrvD, AD, IfW, OpFM, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & +SUBROUTINE PerturbOP(t, iLinTime, iMode, p_FAST, y_FAST, ED, BD, SrvD, AD, IfW, ExtInfw, HD, SeaSt,SD, ExtPtfm, MAPp, FEAM, MD, Orca, & IceF, IceD, ErrStat, ErrMsg ) REAL(DbKi), INTENT(IN ) :: t @@ -5661,8 +5544,9 @@ SUBROUTINE PerturbOP(t, iLinTime, iMode, p_FAST, y_FAST, ED, BD, SrvD, AD, IfW, TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data - TYPE(OpenFOAM_Data), INTENT(INOUT) :: OpFM !< OpenFOAM data + TYPE(ExternalInflow_Data),INTENT(INOUT) :: ExtInfw !< ExternalInflow data TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HydroDyn data + TYPE(SeaState_Data), INTENT(INOUT) :: SeaSt !< SeaState data TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SubDyn data TYPE(ExtPtfm_Data), INTENT(INOUT) :: ExtPtfm !< ExtPtfm_MCKF data TYPE(MAP_Data), INTENT(INOUT) :: MAPp !< MAP data @@ -5681,6 +5565,7 @@ SUBROUTINE PerturbOP(t, iLinTime, iMode, p_FAST, y_FAST, ED, BD, SrvD, AD, IfW, INTEGER(IntKi) :: i, iStart ! generic loop counters INTEGER(IntKi) :: iBody ! WAMIT body loop counter INTEGER(IntKi) :: j ! generic loop counters + INTEGER(IntKi) :: n ! generic loop counters INTEGER(IntKi) :: indx ! generic loop counters INTEGER(IntKi) :: indx_last ! generic loop counters INTEGER(IntKi) :: i_x ! index into packed array @@ -5756,8 +5641,6 @@ SUBROUTINE PerturbOP(t, iLinTime, iMode, p_FAST, y_FAST, ED, BD, SrvD, AD, IfW, !!! ! AeroDyn: copy final predictions to actual states; copy current outputs to next - !!!!IF ( p_FAST%CompAero == Module_AD14 ) THEN - !!!!ELSE IF ( p_FAST%CompAero == Module_AD ) THEN ThisModule = Module_AD if (allocated(y_FAST%Lin%Modules(ThisModule)%Instance(1)%op_x_eig_mag)) then @@ -5778,7 +5661,7 @@ SUBROUTINE PerturbOP(t, iLinTime, iMode, p_FAST, y_FAST, ED, BD, SrvD, AD, IfW, do i=1,size(AD%x(STATE_CURR)%rotors(1)%BEMT%DBEMT%element,1) indx_last = indx + size(AD%x(STATE_CURR)%rotors(1)%BEMT%DBEMT%element(i,j)%vind_1) - 1 call GetStateAry(p_FAST, iMode, t, AD%x(STATE_CURR)%rotors(1)%BEMT%DBEMT%element(i,j)%vind_1, y_FAST%Lin%Modules(ThisModule)%Instance(1)%op_x_eig_mag( indx : indx_last), & - y_FAST%Lin%Modules(ThisModule)%Instance(1)%op_x_eig_phase(indx : indx_last) ) + y_FAST%Lin%Modules(ThisModule)%Instance(1)%op_x_eig_phase(indx : indx_last) ) indx = indx_last + 1 end do end do @@ -5786,24 +5669,39 @@ SUBROUTINE PerturbOP(t, iLinTime, iMode, p_FAST, y_FAST, ED, BD, SrvD, AD, IfW, end if if (AD%p%rotors(1)%BEMT%UA%lin_nx>0) then - do j=1,size(AD%x(STATE_CURR)%rotors(1)%BEMT%UA%element,2) - do i=1,size(AD%x(STATE_CURR)%rotors(1)%BEMT%UA%element,1) - indx_last = indx + size(AD%x(STATE_CURR)%rotors(1)%BEMT%UA%element(i,j)%x) - 1 - call GetStateAry(p_FAST, iMode, t, AD%x(STATE_CURR)%rotors(1)%BEMT%UA%element(i,j)%x, y_FAST%Lin%Modules(ThisModule)%Instance(1)%op_x_eig_mag( indx : indx_last), & - y_FAST%Lin%Modules(ThisModule)%Instance(1)%op_x_eig_phase(indx : indx_last) ) - indx = indx_last + 1 - end do + do n=1,AD%p%rotors(1)%BEMT%UA%lin_nx + i = AD%p%rotors(1)%BEMT%UA%lin_xIndx(n,1) + j = AD%p%rotors(1)%BEMT%UA%lin_xIndx(n,2) + k = AD%p%rotors(1)%BEMT%UA%lin_xIndx(n,3) + + indx_last = indx + call GetStateAry(p_FAST, iMode, t, AD%x(STATE_CURR)%rotors(1)%BEMT%UA%element(i,j)%x(k:k), y_FAST%Lin%Modules(ThisModule)%Instance(1)%op_x_eig_mag( indx : indx_last), & + y_FAST%Lin%Modules(ThisModule)%Instance(1)%op_x_eig_phase(indx : indx_last) ) + indx = indx_last + 1 end do + end if +! if (AD%p%rotors(1)%BEMT%lin_nx>0) then +! indx_last = indx + size(AD%x(STATE_CURR)%rotors(1)%BEMT%v_w) - 1 +! call GetStateAry(p_FAST, iMode, t, AD%x(STATE_CURR)%rotors(1)%BEMT%v_w, y_FAST%Lin%Modules(ThisModule)%Instance(1)%op_x_eig_mag( indx : indx_last), & +! y_FAST%Lin%Modules(ThisModule)%Instance(1)%op_x_eig_phase(indx : indx_last) ) +! indx = indx_last + 1 +! end if +! end if END IF !!! !!!! InflowWind: copy op to actual states and inputs !!!IF ( p_FAST%CompInflow == Module_IfW ) THEN !!!END IF - !!! - !!! + !!! + !!! + !!!! SeaState: copy op to actual states and inputs + !!!IF ( p_FAST%CompSeaSt == Module_SeaSt ) THEN + !!!END IF + !!! + !!! !!!! ServoDyn: copy op to actual states and inputs !!!IF ( p_FAST%CompServo == Module_SrvD ) THEN !!!END IF @@ -5847,7 +5745,7 @@ SUBROUTINE PerturbOP(t, iLinTime, iMode, p_FAST, y_FAST, ED, BD, SrvD, AD, IfW, END SUBROUTINE PerturbOP !---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE SetOperatingPoint(i, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, OpFM, HD, SD, ExtPtfm, & +SUBROUTINE SetOperatingPoint(i, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, ExtInfw, HD, SeaSt, SD, ExtPtfm, & MAPp, FEAM, MD, Orca, IceF, IceD, ErrStat, ErrMsg ) INTEGER(IntKi), INTENT(IN ) :: i !< Index into LinTimes (to determine which operating point to copy) @@ -5860,8 +5758,9 @@ SUBROUTINE SetOperatingPoint(i, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, O TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data - TYPE(OpenFOAM_Data), INTENT(INOUT) :: OpFM !< OpenFOAM data + TYPE(ExternalInflow_Data),INTENT(INOUT) :: ExtInfw !< ExternalInflow data TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HydroDyn data + TYPE(SeaState_Data), INTENT(INOUT) :: SeaSt !< SeaState data TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SubDyn data TYPE(ExtPtfm_Data), INTENT(INOUT) :: ExtPtfm !< ExtPtfm_MCKF data TYPE(MAP_Data), INTENT(INOUT) :: MAPp !< MAP data @@ -5937,7 +5836,7 @@ SUBROUTINE SetOperatingPoint(i, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, O CALL AD_CopyInput (y_FAST%op%u_AD(i), AD%Input(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END IF - + ! InflowWind: copy op to actual states and inputs IF ( p_FAST%CompInflow == Module_IfW ) THEN CALL InflowWind_CopyContState (y_FAST%op%x_IfW( i), IfW%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) @@ -5951,10 +5850,23 @@ SUBROUTINE SetOperatingPoint(i, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, O CALL InflowWind_CopyInput (y_FAST%op%u_IfW(i), IfW%Input(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END IF - + ! SeaSt: copy op to actual states and inputs + if ( p_FAST%CompSeaSt == Module_SeaSt ) then + call SeaSt_CopyContState (y_FAST%op%x_SeaSt( i), SeaSt%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + call SeaSt_CopyDiscState (y_FAST%op%xd_SeaSt( i), SeaSt%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + call SeaSt_CopyConstrState (y_FAST%op%z_SeaSt( i), SeaSt%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + call SeaSt_CopyOtherState (y_FAST%op%OtherSt_SeaSt( i), SeaSt%OtherSt( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + call SeaSt_CopyInput (y_FAST%op%u_SeaSt(i), SeaSt%Input(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + endif + ! ServoDyn: copy op to actual states and inputs IF ( p_FAST%CompServo == Module_SrvD ) THEN CALL SrvD_CopyContState (y_FAST%op%x_SrvD( i), SrvD%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) @@ -6104,7 +6016,7 @@ end subroutine GetStateAry !---------------------------------------------------------------------------------------------------------------------------------- !---------------------------------------------------------------------------------------------------------------------------------- !> This routine performs the algorithm for computing a periodic steady-state solution. -SUBROUTINE FAST_CalcSteady( n_t_global, t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, OpFM, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & +SUBROUTINE FAST_CalcSteady( n_t_global, t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, ExtInfw, HD, SeaSt, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & IceF, IceD, ErrStat, ErrMsg ) INTEGER(IntKi), INTENT(IN ) :: n_t_global !< integer time step @@ -6118,8 +6030,9 @@ SUBROUTINE FAST_CalcSteady( n_t_global, t_global, p_FAST, y_FAST, m_FAST, ED, BD TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data - TYPE(OpenFOAM_Data), INTENT(INOUT) :: OpFM !< OpenFOAM data + TYPE(ExternalInflow_Data),INTENT(INOUT) :: ExtInfw !< ExternalInflow data TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HydroDyn data + TYPE(SeaState_Data), INTENT(INOUT) :: SeaSt !< SeaState data TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SubDyn data TYPE(ExtPtfm_Data), INTENT(INOUT) :: ExtPtfm !< ExtPtfm data TYPE(MAP_Data), INTENT(INOUT) :: MAPp !< MAP data @@ -6153,7 +6066,7 @@ SUBROUTINE FAST_CalcSteady( n_t_global, t_global, p_FAST, y_FAST, m_FAST, ED, BD if (n_t_global == 0) then ! initialize a few things on the first call: - call FAST_InitSteadyOutputs( psi, p_FAST, m_FAST, ED, BD, SrvD, AD, IfW, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & + call FAST_InitSteadyOutputs( psi, p_FAST, m_FAST, ED, BD, SrvD, AD, IfW, HD, SeaSt, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & IceF, IceD, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) else @@ -6166,7 +6079,7 @@ SUBROUTINE FAST_CalcSteady( n_t_global, t_global, p_FAST, y_FAST, m_FAST, ED, BD end if ! save the outputs and azimuth angle for possible interpolation later - call FAST_SaveOutputs( psi, p_FAST, m_FAST, ED, BD, SrvD, AD, IfW, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & + call FAST_SaveOutputs( psi, p_FAST, m_FAST, ED, BD, SrvD, AD, IfW, HD, SeaSt, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & IceF, IceD, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) end if @@ -6193,7 +6106,7 @@ SUBROUTINE FAST_CalcSteady( n_t_global, t_global, p_FAST, y_FAST, m_FAST, ED, BD if (NextAzimuth) then ! interpolate to find y at the target azimuth - call FAST_DiffInterpOutputs( m_FAST%Lin%AzimTarget(m_FAST%Lin%AzimIndx), p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & + call FAST_DiffInterpOutputs( m_FAST%Lin%AzimTarget(m_FAST%Lin%AzimIndx), p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, HD, SeaSt, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & IceF, IceD, ErrStat, ErrMsg ) ! If linearization is forced if (m_FAST%Lin%ForceLin) then @@ -6202,7 +6115,7 @@ SUBROUTINE FAST_CalcSteady( n_t_global, t_global, p_FAST, y_FAST, m_FAST, ED, BD if (m_FAST%Lin%IsConverged .or. m_FAST%Lin%n_rot == 0) then ! save this operating point for linearization later m_FAST%Lin%LinTimes(m_FAST%Lin%AzimIndx) = t_global - call SaveOP(m_FAST%Lin%AzimIndx, p_FAST, y_FAST, ED, BD, SrvD, AD, IfW, OpFM, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & + call SaveOP(m_FAST%Lin%AzimIndx, p_FAST, y_FAST, ED, BD, SrvD, AD, IfW, ExtInfw, HD, SeaSt, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & IceF, IceD, ErrStat, ErrMsg, m_FAST%Lin%CopyOP_CtrlCode ) end if @@ -6253,19 +6166,20 @@ SUBROUTINE FAST_CalcSteady( n_t_global, t_global, p_FAST, y_FAST, m_FAST, ED, BD END SUBROUTINE FAST_CalcSteady !---------------------------------------------------------------------------------------------------------------------------------- !> This routine initializes variables for calculating periodic steady-state solution. -SUBROUTINE FAST_InitSteadyOutputs( psi, p_FAST, m_FAST, ED, BD, SrvD, AD, IfW, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & +SUBROUTINE FAST_InitSteadyOutputs( psi, p_FAST, m_FAST, ED, BD, SrvD, AD, IfW, HD, SeaSt, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & IceF, IceD, ErrStat, ErrMsg ) REAL(DbKi), INTENT(IN ) :: psi !< psi (rotor azimuth) at which the outputs are defined TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables - + TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HydroDyn data + TYPE(SeaState_Data), INTENT(INOUT) :: SeaSt !< SeaState data TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SubDyn data TYPE(ExtPtfm_Data), INTENT(INOUT) :: ExtPtfm !< ExtPtfm data TYPE(MAP_Data), INTENT(INOUT) :: MAPp !< MAP data @@ -6282,75 +6196,75 @@ SUBROUTINE FAST_InitSteadyOutputs( psi, p_FAST, m_FAST, ED, BD, SrvD, AD, IfW, H INTEGER(IntKi) :: j, k ! loop counters INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_InitSteadyOutputs' - - + + ErrStat = ErrID_None ErrMsg = "" - + do j=1,p_FAST%NLinTimes m_FAST%Lin%AzimTarget(j) = (j-1) * p_FAST%AzimDelta + psi call Zero2TwoPi( m_FAST%Lin%AzimTarget(j) ) end do - ! this is circular, so I am going to add points at the beginning and end to avoid + ! this is circular, so I am going to add points at the beginning and end to avoid ! more IF statements later m_FAST%Lin%AzimTarget(0) = m_FAST%Lin%AzimTarget(p_FAST%NLinTimes) m_FAST%Lin%AzimTarget(p_FAST%NLinTimes+1) = m_FAST%Lin%AzimTarget(1) - + ! Azimuth angles that correspond to Output arrays for interpolation: !m_FAST%Lin%Psi = psi ! initialize entire array (note that we won't be able to interpolate with a constant array DO j = 1, p_FAST%LinInterpOrder + 1 m_FAST%Lin%Psi(j) = psi - (j - 1) * D2R_D ! arbitrarily say azimuth is one degree different END DO - - - ! ElastoDyn - allocate( ED%Output( p_FAST%LinInterpOrder+1 ), STAT = ErrStat2 ) + + + ! ElastoDyn + allocate( ED%Output( p_FAST%LinInterpOrder+1 ), STAT = ErrStat2 ) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, "Error allocating ED%Output.", ErrStat, ErrMsg, RoutineName ) + else + do j = 1, p_FAST%LinInterpOrder + 1 + call ED_CopyOutput(ED%y, ED%Output(j), MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + end do + + call ED_CopyOutput(ED%y, ED%y_interp, MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + end if + + ! BeamDyn + IF (p_FAST%CompElast == Module_BD) THEN + + allocate( BD%Output( p_FAST%LinInterpOrder+1, p_FAST%nBeams ), STAT = ErrStat2 ) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, "Error allocating ED%Output.", ErrStat, ErrMsg, RoutineName ) + call SetErrStat(ErrID_Fatal, "Error allocating BD%Output.", ErrStat, ErrMsg, RoutineName ) else - do j = 1, p_FAST%LinInterpOrder + 1 - call ED_CopyOutput(ED%y, ED%Output(j), MESH_NEWCOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + do k=1,p_FAST%nBeams + do j = 1, p_FAST%LinInterpOrder + 1 + call BD_CopyOutput(BD%y(k), BD%Output(j,k), MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + end do end do - - call ED_CopyOutput(ED%y, ED%y_interp, MESH_NEWCOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - end if - - ! BeamDyn - IF (p_FAST%CompElast == Module_BD) THEN - - allocate( BD%Output( p_FAST%LinInterpOrder+1, p_FAST%nBeams ), STAT = ErrStat2 ) + + allocate( BD%y_interp( p_FAST%nBeams ), STAT = ErrStat2 ) if (ErrStat2 /= 0) then call SetErrStat(ErrID_Fatal, "Error allocating BD%Output.", ErrStat, ErrMsg, RoutineName ) else do k=1,p_FAST%nBeams - do j = 1, p_FAST%LinInterpOrder + 1 - call BD_CopyOutput(BD%y(k), BD%Output(j,k), MESH_NEWCOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - end do + call BD_CopyOutput(BD%y(k), BD%y_interp(k), MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) end do - - allocate( BD%y_interp( p_FAST%nBeams ), STAT = ErrStat2 ) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, "Error allocating BD%Output.", ErrStat, ErrMsg, RoutineName ) - else - do k=1,p_FAST%nBeams - call BD_CopyOutput(BD%y(k), BD%y_interp(k), MESH_NEWCOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - end do - end if - end if - - END IF ! BeamDyn - + + end if + + END IF ! BeamDyn + ! AeroDyn IF ( p_FAST%CompAero == Module_AD ) THEN - + allocate( AD%Output( p_FAST%LinInterpOrder+1 ), STAT = ErrStat2 ) if (ErrStat2 /= 0) then call SetErrStat(ErrID_Fatal, "Error allocating AD%Output.", ErrStat, ErrMsg, RoutineName ) @@ -6359,17 +6273,17 @@ SUBROUTINE FAST_InitSteadyOutputs( psi, p_FAST, m_FAST, ED, BD, SrvD, AD, IfW, H call AD_CopyOutput(AD%y, AD%Output(j), MESH_NEWCOPY, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) end do - + call AD_CopyOutput(AD%y, AD%y_interp, MESH_NEWCOPY, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) end if - + END IF ! CompAero - - + + ! InflowWind IF ( p_FAST%CompInflow == Module_IfW ) THEN - + allocate( IfW%Output( p_FAST%LinInterpOrder+1 ), STAT = ErrStat2 ) if (ErrStat2 /= 0) then call SetErrStat(ErrID_Fatal, "Error allocating IfW%Output.", ErrStat, ErrMsg, RoutineName ) @@ -6378,17 +6292,34 @@ SUBROUTINE FAST_InitSteadyOutputs( psi, p_FAST, m_FAST, ED, BD, SrvD, AD, IfW, H call InflowWind_CopyOutput(IfW%y, IfW%Output(j), MESH_NEWCOPY, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) end do - + call InflowWind_CopyOutput(IfW%y, IfW%y_interp, MESH_NEWCOPY, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) end if - + END IF ! CompInflow - - + + + ! SeaSt + if ( p_FAST%CompSeaSt == Module_SeaSt ) then + allocate( SeaSt%Output( p_FAST%LinInterpOrder+1 ), STAT = ErrStat2 ) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, "Error allocating SeaSt%Output.", ErrStat, ErrMsg, RoutineName ) + else + do j = 1, p_FAST%LinInterpOrder + 1 + call SeaSt_CopyOutput(SeaSt%y, SeaSt%Output(j), MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + end do + + call SeaSt_CopyOutput(SeaSt%y, SeaSt%y_interp, MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + end if + endif ! CompSeaSt + + ! ServoDyn IF ( p_FAST%CompServo == Module_SrvD ) THEN - + allocate( SrvD%Output( p_FAST%LinInterpOrder+1 ), STAT = ErrStat2 ) if (ErrStat2 /= 0) then call SetErrStat(ErrID_Fatal, "Error allocating SrvD%Output.", ErrStat, ErrMsg, RoutineName ) @@ -6397,13 +6328,13 @@ SUBROUTINE FAST_InitSteadyOutputs( psi, p_FAST, m_FAST, ED, BD, SrvD, AD, IfW, H call SrvD_CopyOutput(SrvD%y, SrvD%Output(j), MESH_NEWCOPY, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) end do - + call SrvD_CopyOutput(SrvD%y, SrvD%y_interp, MESH_NEWCOPY, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) end if - + END IF ! ServoDyn - + ! HydroDyn IF ( p_FAST%CompHydro == Module_HD ) THEN @@ -6415,13 +6346,13 @@ SUBROUTINE FAST_InitSteadyOutputs( psi, p_FAST, m_FAST, ED, BD, SrvD, AD, IfW, H call HydroDyn_CopyOutput(HD%y, HD%Output(j), MESH_NEWCOPY, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) end do - + call HydroDyn_CopyOutput(HD%y, HD%y_interp, MESH_NEWCOPY, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) end if - + END IF ! HydroDyn - + !! SubDyn/ExtPtfm_MCKF IF ( p_FAST%CompSub == Module_SD ) THEN allocate( SD%Output( p_FAST%LinInterpOrder+1 ), STAT = ErrStat2 ) @@ -6432,18 +6363,18 @@ SUBROUTINE FAST_InitSteadyOutputs( psi, p_FAST, m_FAST, ED, BD, SrvD, AD, IfW, H call SD_CopyOutput(SD%y, SD%Output(j), MESH_NEWCOPY, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) end do - + call SD_CopyOutput(SD%y, SD%y_interp, MESH_NEWCOPY, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - end if + end if ELSE IF ( p_FAST%CompSub == Module_ExtPtfm ) THEN END IF ! SubDyn/ExtPtfm_MCKF - - + + ! Mooring (MAP , FEAM , MoorDyn) ! MAP IF ( p_FAST%CompMooring == Module_MAP ) THEN - + allocate( MAPp%Output( p_FAST%LinInterpOrder+1 ), STAT = ErrStat2 ) if (ErrStat2 /= 0) then call SetErrStat(ErrID_Fatal, "Error allocating MAPp%Output.", ErrStat, ErrMsg, RoutineName ) @@ -6452,14 +6383,14 @@ SUBROUTINE FAST_InitSteadyOutputs( psi, p_FAST, m_FAST, ED, BD, SrvD, AD, IfW, H call MAP_CopyOutput(MAPp%y, MAPp%Output(j), MESH_NEWCOPY, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) end do - + call MAP_CopyOutput(MAPp%y, MAPp%y_interp, MESH_NEWCOPY, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) end if - + ! MoorDyn ELSEIF ( p_FAST%CompMooring == Module_MD ) THEN - + allocate( MD%Output( p_FAST%LinInterpOrder+1 ), STAT = ErrStat2 ) if (ErrStat2 /= 0) then call SetErrStat(ErrID_Fatal, "Error allocating MD%Output.", ErrStat, ErrMsg, RoutineName ) @@ -6468,37 +6399,32 @@ SUBROUTINE FAST_InitSteadyOutputs( psi, p_FAST, m_FAST, ED, BD, SrvD, AD, IfW, H call MD_CopyOutput(MD%y, MD%Output(j), MESH_NEWCOPY, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) end do - + call MD_CopyOutput(MD%y, MD%y_interp, MESH_NEWCOPY, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) end if - - - - + !! FEAM !ELSEIF ( p_FAST%CompMooring == Module_FEAM ) THEN !! OrcaFlex !ELSEIF ( p_FAST%CompMooring == Module_Orca ) THEN - + END IF ! MAP/FEAM/MoorDyn/OrcaFlex - - - + !! Ice (IceFloe or IceDyn) !! IceFloe !IF ( p_FAST%CompIce == Module_IceF ) THEN - ! + ! !! IceDyn !ELSEIF ( p_FAST%CompIce == Module_IceD ) THEN ! !END IF ! IceFloe/IceDyn +END SUBROUTINE FAST_InitSteadyOutputs -END SUBROUTINE FAST_InitSteadyOutputs !---------------------------------------------------------------------------------------------------------------------------------- !> This routine saves outputs for future interpolation at a desired azimuth. -SUBROUTINE FAST_SaveOutputs( psi, p_FAST, m_FAST, ED, BD, SrvD, AD, IfW, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & +SUBROUTINE FAST_SaveOutputs( psi, p_FAST, m_FAST, ED, BD, SrvD, AD, IfW, HD, SeaSt, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & IceF, IceD, ErrStat, ErrMsg ) REAL(DbKi), INTENT(IN ) :: psi !< psi (rotor azimuth) at which the outputs are defined @@ -6511,6 +6437,7 @@ SUBROUTINE FAST_SaveOutputs( psi, p_FAST, m_FAST, ED, BD, SrvD, AD, IfW, HD, SD, TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HydroDyn data + TYPE(SeaState_Data), INTENT(INOUT) :: SeaSt !< SeaState data TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SubDyn data TYPE(ExtPtfm_Data), INTENT(INOUT) :: ExtPtfm !< ExtPtfm data TYPE(MAP_Data), INTENT(INOUT) :: MAPp !< MAP data @@ -6544,31 +6471,31 @@ SUBROUTINE FAST_SaveOutputs( psi, p_FAST, m_FAST, ED, BD, SrvD, AD, IfW, HD, SD, end if m_FAST%Lin%Psi(1) = psi - ! ElastoDyn - DO j = p_FAST%LinInterpOrder, 1, -1 - CALL ED_CopyOutput(ED%Output(j), ED%Output(j+1), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - END DO - - CALL ED_CopyOutput (ED%y, ED%Output(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) + ! ElastoDyn + DO j = p_FAST%LinInterpOrder, 1, -1 + CALL ED_CopyOutput(ED%Output(j), ED%Output(j+1), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - - ! BeamDyn - IF (p_FAST%CompElast == Module_BD) THEN - - DO k = 1,p_FAST%nBeams - - DO j = p_FAST%LinInterpOrder, 1, -1 - CALL BD_CopyOutput (BD%Output(j,k), BD%Output(j+1,k), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - END DO - - CALL BD_CopyOutput (BD%y(k), BD%Output(1,k), MESH_UPDATECOPY, Errstat2, ErrMsg2) + END DO + + CALL ED_CopyOutput (ED%y, ED%Output(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + + ! BeamDyn + IF (p_FAST%CompElast == Module_BD) THEN + + DO k = 1,p_FAST%nBeams + + DO j = p_FAST%LinInterpOrder, 1, -1 + CALL BD_CopyOutput (BD%Output(j,k), BD%Output(j+1,k), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - - END DO ! k=p_FAST%nBeams - - END IF ! BeamDyn + END DO + + CALL BD_CopyOutput (BD%y(k), BD%Output(1,k), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + + END DO ! k=p_FAST%nBeams + + END IF ! BeamDyn ! AeroDyn @@ -6599,6 +6526,18 @@ SUBROUTINE FAST_SaveOutputs( psi, p_FAST, m_FAST, ED, BD, SrvD, AD, IfW, HD, SD, END IF ! CompInflow + ! SeaState + if ( p_FAST%CompSeaSt == Module_SeaSt ) then + do j = p_FAST%LinInterpOrder, 1, -1 + call SeaSt_CopyOutput (SeaSt%Output(j), SeaSt%Output(j+1), MESH_UPDATECOPY, Errstat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + enddo + + call SeaSt_CopyOutput (SeaSt%y, SeaSt%Output(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + endif ! CompSeaSt + + ! ServoDyn IF ( p_FAST%CompServo == Module_SrvD ) THEN @@ -6683,22 +6622,23 @@ SUBROUTINE FAST_SaveOutputs( psi, p_FAST, m_FAST, ED, BD, SrvD, AD, IfW, HD, SD, END SUBROUTINE FAST_SaveOutputs !---------------------------------------------------------------------------------------------------------------------------------- -!> This routine interpolates the outputs at the target azimuths, computes the compared to the previous rotation, and stores +!> This routine interpolates the outputs at the target azimuths, computes the compared to the previous rotation, and stores !! them for future rotation . -SUBROUTINE FAST_DiffInterpOutputs( psi_target, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & +SUBROUTINE FAST_DiffInterpOutputs( psi_target, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, HD, SeaSt, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & IceF, IceD, ErrStat, ErrMsg ) REAL(DbKi), INTENT(IN ) :: psi_target !< psi (rotor azimuth) at which the outputs are requested TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Output variables for the glue code TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables - + TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HydroDyn data + TYPE(SeaState_Data), INTENT(INOUT) :: SeaSt !< SeaState data TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SubDyn data TYPE(ExtPtfm_Data), INTENT(INOUT) :: ExtPtfm !< ExtPtfm data TYPE(MAP_Data), INTENT(INOUT) :: MAPp !< MAP data @@ -6717,9 +6657,9 @@ SUBROUTINE FAST_DiffInterpOutputs( psi_target, p_FAST, y_FAST, m_FAST, ED, BD, S CHARACTER(ErrMsgLen) :: ErrMsg2 REAL(DbKi) :: t_global REAL(ReKi) :: eps_squared - + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DiffInterpOutputs' - + ErrStat = ErrID_None ErrMsg = "" t_global = 0.0_DbKi ! we don't really need this to get the output OPs @@ -6728,140 +6668,152 @@ SUBROUTINE FAST_DiffInterpOutputs( psi_target, p_FAST, y_FAST, m_FAST, ED, BD, S ! Extrapolate outputs to the target azimuth and pack into OP arrays !................................................................................................ - ! ElastoDyn - CALL ED_Output_ExtrapInterp (ED%Output, m_FAST%Lin%Psi, ED%y_interp, psi_target, ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - - call ED_GetOP( t_global, ED%Input(1), ED%p, ED%x(STATE_CURR), ED%xd(STATE_CURR), ED%z(STATE_CURR), ED%OtherSt(STATE_CURR), & - ED%y_interp, ED%m, ErrStat2, ErrMsg2, y_op=y_FAST%Lin%Modules(Module_ED)%Instance(1)%op_y, NeedTrimOP=.true.) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - ! BeamDyn - IF (p_FAST%CompElast == Module_BD) THEN - - DO k = 1,p_FAST%nBeams - - CALL BD_Output_ExtrapInterp (BD%Output(:,k), m_FAST%Lin%Psi, BD%y_interp(k), psi_target, ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - - call BD_GetOP( t_global, BD%Input(1,k), BD%p(k), BD%x(k,STATE_CURR), BD%xd(k,STATE_CURR), BD%z(k,STATE_CURR), BD%OtherSt(k,STATE_CURR), & - BD%y_interp(k), BD%m(k), ErrStat2, ErrMsg2, y_op=y_FAST%Lin%Modules(Module_BD)%Instance(k)%op_y, NeedTrimOP=.true.) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - END DO ! k=p_FAST%nBeams - - END IF ! BeamDyn - - + ! ElastoDyn + CALL ED_Output_ExtrapInterp (ED%Output, m_FAST%Lin%Psi, ED%y_interp, psi_target, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + + call ED_GetOP( t_global, ED%Input(1), ED%p, ED%x(STATE_CURR), ED%xd(STATE_CURR), ED%z(STATE_CURR), ED%OtherSt(STATE_CURR), & + ED%y_interp, ED%m, ErrStat2, ErrMsg2, y_op=y_FAST%Lin%Modules(Module_ED)%Instance(1)%op_y, NeedTrimOP=.true.) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + ! BeamDyn + IF (p_FAST%CompElast == Module_BD) THEN + + DO k = 1,p_FAST%nBeams + + CALL BD_Output_ExtrapInterp (BD%Output(:,k), m_FAST%Lin%Psi, BD%y_interp(k), psi_target, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + + call BD_GetOP( t_global, BD%Input(1,k), BD%p(k), BD%x(k,STATE_CURR), BD%xd(k,STATE_CURR), BD%z(k,STATE_CURR), BD%OtherSt(k,STATE_CURR), & + BD%y_interp(k), BD%m(k), ErrStat2, ErrMsg2, y_op=y_FAST%Lin%Modules(Module_BD)%Instance(k)%op_y, NeedTrimOP=.true.) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + END DO ! k=p_FAST%nBeams + + END IF ! BeamDyn + + ! AeroDyn IF ( p_FAST%CompAero == Module_AD ) THEN - + CALL AD_Output_ExtrapInterp (AD%Output, m_FAST%Lin%Psi, AD%y_interp, psi_target, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - + call AD_GetOP( t_global, AD%Input(1), AD%p, AD%x(STATE_CURR), AD%xd(STATE_CURR), AD%z(STATE_CURR), AD%OtherSt(STATE_CURR), & AD%y_interp, AD%m, ErrStat2, ErrMsg2, y_op=y_FAST%Lin%Modules(Module_AD)%Instance(1)%op_y) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) END IF ! CompAero - - + + ! InflowWind IF ( p_FAST%CompInflow == Module_IfW ) THEN - + CALL InflowWind_Output_ExtrapInterp (IfW%Output, m_FAST%Lin%Psi, IfW%y_interp, psi_target, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - + call InflowWind_GetOP( t_global, IfW%Input(1), IfW%p, IfW%x(STATE_CURR), IfW%xd(STATE_CURR), IfW%z(STATE_CURR), IfW%OtherSt(STATE_CURR), & IfW%y_interp, IfW%m, ErrStat2, ErrMsg2, y_op=y_FAST%Lin%Modules(Module_IfW)%Instance(1)%op_y) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) END IF ! CompInflow - - + + + ! SeaState + if ( p_FAST%CompSeaSt == Module_SeaSt ) then + ! No normal outputs to extrapolate + !call SeaSt_Output_ExtrapInterp (SeaSt%Output, m_FAST%Lin%Psi, SeaSt%y_interp, psi_target, ErrStat2, ErrMsg2) + ! call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + + call SeaSt_GetOP( t_global, SeaSt%Input(1), SeaSt%p, SeaSt%x(STATE_CURR), SeaSt%xd(STATE_CURR), SeaSt%z(STATE_CURR), SeaSt%OtherSt(STATE_CURR), & + SeaSt%y_interp, SeaSt%m, ErrStat2, ErrMsg2, y_op=y_FAST%Lin%Modules(Module_SeaSt)%Instance(1)%op_y) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + endif ! CompSeaSt + + ! ServoDyn IF ( p_FAST%CompServo == Module_SrvD ) THEN - + CALL SrvD_Output_ExtrapInterp (SrvD%Output, m_FAST%Lin%Psi, SrvD%y_interp, psi_target, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - + call SrvD_GetOP( t_global, SrvD%Input(1), SrvD%p, SrvD%x(STATE_CURR), SrvD%xd(STATE_CURR), SrvD%z(STATE_CURR), SrvD%OtherSt(STATE_CURR), & SrvD%y_interp, SrvD%m, ErrStat2, ErrMsg2, y_op=y_FAST%Lin%Modules(Module_SrvD)%Instance(1)%op_y) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) END IF ! ServoDyn - + ! HydroDyn IF ( p_FAST%CompHydro == Module_HD ) THEN CALL HydroDyn_Output_ExtrapInterp (HD%Output, m_FAST%Lin%Psi, HD%y_interp, psi_target, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - + call HD_GetOP( t_global, HD%Input(1), HD%p, HD%x(STATE_CURR), HD%xd(STATE_CURR), HD%z(STATE_CURR), HD%OtherSt(STATE_CURR), & HD%y_interp, HD%m, ErrStat2, ErrMsg2, y_op=y_FAST%Lin%Modules(Module_HD)%Instance(1)%op_y) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) END IF ! HydroDyn - + !! SubDyn/ExtPtfm_MCKF IF ( p_FAST%CompSub == Module_SD ) THEN - + CALL SD_Output_ExtrapInterp (SD%Output, m_FAST%Lin%Psi, SD%y_interp, psi_target, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - + call SD_GetOP( t_global, SD%Input(1), SD%p, SD%x(STATE_CURR), SD%xd(STATE_CURR), SD%z(STATE_CURR), SD%OtherSt(STATE_CURR), & SD%y_interp, SD%m, ErrStat2, ErrMsg2, y_op=y_FAST%Lin%Modules(Module_SD)%Instance(1)%op_y, NeedTrimOP=.true.) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ELSE IF ( p_FAST%CompSub == Module_ExtPtfm ) THEN END IF ! SubDyn/ExtPtfm_MCKF - - + + ! Mooring (MAP , FEAM , MoorDyn) ! MAP IF ( p_FAST%CompMooring == Module_MAP ) THEN - + CALL MAP_Output_ExtrapInterp (MAPp%Output, m_FAST%Lin%Psi, MAPp%y_interp, psi_target, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - + call MAP_GetOP( t_global, MAPp%Input(1), MAPp%p, MAPp%x(STATE_CURR), MAPp%xd(STATE_CURR), MAPp%z(STATE_CURR), MAPp%OtherSt, & MAPp%y_interp, ErrStat2, ErrMsg2, y_op=y_FAST%Lin%Modules(Module_MAP)%Instance(1)%op_y) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! MoorDyn ELSEIF ( p_FAST%CompMooring == Module_MD ) THEN - + CALL MD_Output_ExtrapInterp (MD%Output, m_FAST%Lin%Psi, MD%y_interp, psi_target, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - + call MD_GetOP( t_global, MD%Input(1), MD%p, MD%x(STATE_CURR), MD%xd(STATE_CURR), MD%z(STATE_CURR), MD%OtherSt(STATE_CURR), & MD%y_interp, MD%m, ErrStat2, ErrMsg2, y_op=y_FAST%Lin%Modules(Module_MD)%Instance(1)%op_y) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - + !! FEAM !ELSEIF ( p_FAST%CompMooring == Module_FEAM ) THEN !! OrcaFlex !ELSEIF ( p_FAST%CompMooring == Module_Orca ) THEN - + END IF ! MAP/FEAM/MoorDyn/OrcaFlex - - - + + + !! Ice (IceFloe or IceDyn) !! IceFloe !IF ( p_FAST%CompIce == Module_IceF ) THEN - ! + ! !! IceDyn !ELSEIF ( p_FAST%CompIce == Module_IceD ) THEN ! !END IF ! IceFloe/IceDyn - + call pack_in_array(p_FAST, y_FAST, m_FAST) - - if (m_FAST%Lin%IsConverged) then - ! check that error equation is less than TrimTol !!!call + + if (m_FAST%Lin%IsConverged) then ! if Forced Linearization, the error may be large due to a different azimuth, so printing it here isn't very helpful + ! check that error equation is less than TrimTol call calc_error(p_FAST, y_FAST, m_FAST, SrvD%y, eps_squared) m_FAST%Lin%IsConverged = eps_squared < p_FAST%TrimTol end if - - + + m_FAST%Lin%Y_prevRot(:,m_FAST%Lin%AzimIndx) = m_FAST%Lin%y_interp - + END SUBROUTINE FAST_DiffInterpOutputs !---------------------------------------------------------------------------------------------------------------------------------- SUBROUTINE pack_in_array(p_FAST, y_FAST, m_FAST) @@ -6930,6 +6882,7 @@ SUBROUTINE calc_error(p_FAST, y_FAST, m_FAST, y_SrvD, eps_squared) ! compute the error: eps_squared = 0.0_ReKi + !m_FAST%Lin%eps_squared = 0.0_ReKi do i = 1,p_FAST%Lin_NumMods ThisModule = p_FAST%Lin_ModOrder( i ) @@ -6946,6 +6899,7 @@ SUBROUTINE calc_error(p_FAST, y_FAST, m_FAST, y_SrvD, eps_squared) else diff = m_FAST%Lin%y_interp( indx ) - m_FAST%Lin%Y_prevRot( indx, m_FAST%Lin%AzimIndx ) end if + !m_FAST%Lin%eps_squared(indx) = ( diff / m_FAST%Lin%y_ref( indx ) ) ** 2 eps_squared = eps_squared + ( diff / m_FAST%Lin%y_ref( indx ) ) ** 2 end do @@ -6977,7 +6931,6 @@ SUBROUTINE ComputeOutputRanges(p_FAST, y_FAST, m_FAST, y_SrvD) do indx = 1,y_FAST%Lin%Glue%SizeLin(LIN_OUTPUT_COL) m_FAST%Lin%y_ref(indx) = maxval( m_FAST%Lin%Y_prevRot( indx, : ) ) - minval( m_FAST%Lin%Y_prevRot( indx, : ) ) m_FAST%Lin%y_ref(indx) = max( m_FAST%Lin%y_ref(indx), 0.01_ReKi ) -! if (m_FAST%Lin%y_ref(indx) < 1.0e-4) m_FAST%Lin%y_ref(indx) = 1.0_ReKi ! not sure why we wouldn't just do m_FAST%Lin%y_ref(indx) = max(1.0_ReKi, m_FAST%Lin%y_ref(indx)) or max(1e-4, y_ref(indx)) end do ! special case for angles: diff --git a/modules/openfast-library/src/FAST_Mods.f90 b/modules/openfast-library/src/FAST_Mods.f90 index a98e8d15b8..a09e8f43d5 100644 --- a/modules/openfast-library/src/FAST_Mods.f90 +++ b/modules/openfast-library/src/FAST_Mods.f90 @@ -24,8 +24,7 @@ MODULE FAST_ModTypes USE NWTC_Library USE FAST_Types - TYPE(ProgDesc), PARAMETER :: FAST_Ver = & - ProgDesc( 'OpenFAST', '', '' ) !< The version number of this module + TYPE(ProgDesc) :: FAST_Ver = ProgDesc( 'OpenFAST', '', '' ) !< The version number of this module !.................................................................. @@ -38,6 +37,8 @@ MODULE FAST_ModTypes ! state array indexes INTEGER(IntKi), PARAMETER :: STATE_CURR = 1 !< index for "current" (t_global) states INTEGER(IntKi), PARAMETER :: STATE_PRED = 2 !< index for "predicted" (t_global_next) states + INTEGER(IntKi), PARAMETER :: STATE_SAVED_CURR = 3 + INTEGER(IntKi), PARAMETER :: STATE_SAVED_PRED = 4 ! VTK visualization INTEGER(IntKi), PARAMETER :: VTK_Unknown = -1 !< unknown option (will produce error) @@ -61,6 +62,9 @@ MODULE FAST_ModTypes INTEGER(IntKi), PARAMETER :: LIN_OUTPUT_COL = 2 !< index for outputs INTEGER(IntKi), PARAMETER :: LIN_ContSTATE_COL = 3 !< index for continuous states + INTEGER(IntKi), PARAMETER :: Solve_FullOpt1 = 1 + INTEGER(IntKi), PARAMETER :: Solve_FullOpt2 = 2 + INTEGER(IntKi), PARAMETER :: Solve_SimplifiedOpt1 = 3 INTEGER(IntKi), PARAMETER :: SizeJac_ED_HD = 12 diff --git a/modules/openfast-library/src/FAST_Registry.txt b/modules/openfast-library/src/FAST_Registry.txt index d09ea72736..2cbaa53e41 100644 --- a/modules/openfast-library/src/FAST_Registry.txt +++ b/modules/openfast-library/src/FAST_Registry.txt @@ -12,15 +12,18 @@ # ...... Include files (definitions from NWTC Library and module components) ............................................................................ include Registry_NWTC_Library.txt usefrom ElastoDyn_Registry.txt +usefrom SED_Registry.txt usefrom Registry_BeamDyn.txt usefrom ServoDyn_Registry.txt -usefrom Registry-AD14.txt usefrom AeroDyn_Registry.txt +usefrom AeroDisk_Registry.txt +usefrom ExtLoads_Registry.txt usefrom SubDyn_Registry.txt +usefrom SeaState.txt usefrom HydroDyn.txt usefrom IceFloe_FASTRegistry.inp usefrom InflowWind.txt -usefrom OpenFOAM_Registry.txt +usefrom ExternalInflow_Registry.txt usefrom SC_DataEx_Registry.txt usefrom Registry_IceDyn.txt usefrom FEAM_Registry.txt @@ -38,25 +41,38 @@ param FAST - INTEGER Module_Unknown - -1 - "Unknown" - param ^ - INTEGER Module_None - 0 - "No module selected" - param ^ - INTEGER Module_Glue - 1 - "Glue code" - param ^ - INTEGER Module_IfW - 2 - "InflowWind" - -param ^ - INTEGER Module_OpFM - 3 - "OpenFOAM" - +param ^ - INTEGER Module_ExtInfw - 3 - "ExternalInflow" - param ^ - INTEGER Module_ED - 4 - "ElastoDyn" - param ^ - INTEGER Module_BD - 5 - "BeamDyn" - -param ^ - INTEGER Module_AD14 - 6 - "AeroDyn14" - param ^ - INTEGER Module_AD - 7 - "AeroDyn" - -param ^ - INTEGER Module_SrvD - 8 - "ServoDyn" - -param ^ - INTEGER Module_HD - 9 - "HydroDyn" - -param ^ - INTEGER Module_SD - 10 - "SubDyn" - -param ^ - INTEGER Module_ExtPtfm - 11 - "External Platform Loading MCKF" - -param ^ - INTEGER Module_MAP - 12 - "MAP (Mooring Analysis Program)" - -param ^ - INTEGER Module_FEAM - 13 - "FEAMooring" - -param ^ - INTEGER Module_MD - 14 - "MoorDyn" - -param ^ - INTEGER Module_Orca - 15 - "OrcaFlex integration (HD/Mooring)" - -param ^ - INTEGER Module_IceF - 16 - "IceFloe" - -param ^ - INTEGER Module_IceD - 17 - "IceDyn" - -param ^ - INTEGER NumModules - 17 - "The number of modules available in FAST" - +param ^ - INTEGER Module_ExtLd - 8 - "ExternalLoads" - +param ^ - INTEGER Module_SrvD - 9 - "ServoDyn" - +param ^ - INTEGER Module_SeaSt - 10 - "SeaState" - +param ^ - INTEGER Module_HD - 11 - "HydroDyn" - +param ^ - INTEGER Module_SD - 12 - "SubDyn" - +param ^ - INTEGER Module_ExtPtfm - 13 - "External Platform Loading MCKF" - +param ^ - INTEGER Module_MAP - 14 - "MAP (Mooring Analysis Program)" - +param ^ - INTEGER Module_FEAM - 15 - "FEAMooring" - +param ^ - INTEGER Module_MD - 16 - "MoorDyn" - +param ^ - INTEGER Module_Orca - 17 - "OrcaFlex integration (HD/Mooring)" - +param ^ - INTEGER Module_IceF - 18 - "IceFloe" - +param ^ - INTEGER Module_IceD - 19 - "IceDyn" - +param ^ - INTEGER Module_ADsk - 20 - "AeroDisk" - +param ^ - INTEGER Module_SED - 21 - "Simplified-ElastoDyn" - +param ^ - INTEGER NumModules - 21 - "The number of modules available in FAST" - # Other Constants param ^ - INTEGER MaxNBlades - 3 - "Maximum number of blades allowed on a turbine" - param ^ - INTEGER IceD_MaxLegs - 4 - "because I don't know how many legs there are before calling IceD_Init and I don't want to copy the data because of sibling mesh issues, I'm going to allocate IceD based on this number" - +# Constants for steady-state solve (indices for output channels) +param ^ - INTEGER SS_Indx_Pitch - 1 - "pitch" - +param ^ - INTEGER SS_Indx_TSR - 2 - "TSR" - +param ^ - INTEGER SS_Indx_WS - 3 - "wind speed" - +param ^ - INTEGER SS_Indx_RotSpeed - 4 - "rotor speed" - +param ^ - INTEGER SS_Indx_Err - 5 - "err in the ss solve" - +param ^ - INTEGER SS_Indx_Iter - 6 - "number of iterations" - +# Size of state derived type arrays +param ^ - INTEGER NumStateTimes - 4 - "size of arrays of state derived types (Continuous state type etc). (STATE_CURR, STATE_PRED, STATE_SAVED_CURR, STATE_SAVED_PRED)" - + # ...... Data for VTK surface visualization ............................................................................ typedef ^ FAST_VTK_BLSurfaceType SiKi AirfoilCoords {:}{:}{:} - - "x,y coordinates for airfoil around each blade node on a blade (relative to reference)" - # ...... Data for VTK surface visualization ............................................................................ @@ -66,8 +82,9 @@ typedef ^ FAST_VTK_SurfaceType SiKi GroundRad - - - "radius for plotting circle typedef ^ FAST_VTK_SurfaceType SiKi NacelleBox {3}{8} - - "X-Y-Z locations of 8 points that define the nacelle box, relative to the nacelle position" m typedef ^ FAST_VTK_SurfaceType SiKi TowerRad {:} - - "radius of each ED tower node" m typedef ^ FAST_VTK_SurfaceType IntKi NWaveElevPts {2} - - "number of points for wave elevation visualization" - -typedef ^ FAST_VTK_SurfaceType SiKi WaveElevXY {:}{:} - - "X-Y locations for WaveElev output (for visualization). First dimension is the X (1) and Y (2) coordinate. Second dimension is the point number." "m,-" -typedef ^ FAST_VTK_SurfaceType SiKi WaveElev {:}{:} - - "wave elevation at WaveElevXY; first dimension is time step; second dimension is point number" "m,-" +typedef ^ FAST_VTK_SurfaceType SiKi WaveElevVisX {:} - - "X locations for WaveElev output (for visualization)." "m,-" +typedef ^ FAST_VTK_SurfaceType SiKi WaveElevVisY {:} - - "Y locations for WaveElev output (for visualization)." "m,-" +typedef ^ FAST_VTK_SurfaceType SiKi WaveElevVisGrid {:}{:}{:} - - "wave elevation at WaveElevVis{XY}; first dimension is time step; second/third dimensions are grid of elevations" "m,-" typedef ^ FAST_VTK_SurfaceType FAST_VTK_BLSurfaceType BladeShape {:} - - "AirfoilCoords for each blade" m typedef ^ FAST_VTK_SurfaceType SiKi MorisonVisRad {:} - - "radius of each Morison node" m @@ -87,6 +104,11 @@ typedef ^ FAST_VTK_ModeShapeType R8Ki x_eig_magnitude {:}{:}{:} - - typedef ^ FAST_VTK_ModeShapeType R8Ki x_eig_phase {:}{:}{:} - - "phase of eigenvector (dimension 1=state, dim 2= azimuth, dim 3 = mode)" - +typedef ^ FAST_SS_CaseType ReKi RotSpeed - - - "Rotor speed for this case of the steady-state solve [>0]" "(rad/s)" +typedef ^ FAST_SS_CaseType ReKi TSR - - - "TSR for this case of the steady-state solve [>0]" "(-)" +typedef ^ FAST_SS_CaseType ReKi WindSpeed - - - "Windspeed for this case of the steady-state solve [>0]" "(m/s)" +typedef ^ FAST_SS_CaseType ReKi Pitch - - - "Pitch angle for this case of the steady-state solve" "(rad)" + # ..... FAST_ParameterType data ....................................................................................................... # Misc data for coupling: typedef FAST FAST_ParameterType DbKi DT - - - "Integration time step [global time]" s @@ -96,7 +118,7 @@ typedef ^ FAST_ParameterType INTEGER n_TMax_m1 - - - "The time step of TMax - dt typedef ^ FAST_ParameterType DbKi TMax - - - "Total run time" s typedef ^ FAST_ParameterType IntKi InterpOrder - - - "Interpolation order {0,1,2}" - typedef ^ FAST_ParameterType IntKi NumCrctn - - - "Number of correction iterations" - -typedef ^ FAST_ParameterType IntKi KMax - - - "Maximum number of input-output-solve iterations (KMax >= 1)" - +typedef ^ FAST_ParameterType IntKi KMax - - - "Maximum number of input-output-solve or nonlinear solve residual equation iterations (KMax >= 1) [>0]" - typedef ^ FAST_ParameterType IntKi numIceLegs - - - "number of suport-structure legs in contact with ice (IceDyn coupling)" - typedef ^ FAST_ParameterType IntKi nBeams - - - "number of BeamDyn instances" - typedef ^ FAST_ParameterType LOGICAL BD_OutputSibling - - - "flag to determine if BD input is sibling of output mesh" - @@ -105,14 +127,15 @@ typedef ^ FAST_ParameterType LOGICAL ModuleInitialized {NumModules} - - "An arra typedef ^ FAST_ParameterType DbKi DT_Ujac - - - "Time between when we need to re-calculate these Jacobians" s typedef ^ FAST_ParameterType Reki UJacSclFact - - - "Scaling factor used to get similar magnitudes between accelerations, forces, and moments in Jacobians" - typedef ^ FAST_ParameterType IntKi SizeJac_Opt1 {9} - - "(1)=size of matrix; (2)=size of ED portion; (3)=size of SD portion [2 meshes]; (4)=size of HD portion; (5)=size of BD portion blade 1; (6)=size of BD portion blade 2; (7)=size of BD portion blade 3; (8)=size of Orca portion; (9)=size of ExtPtfm portion;" - -#typedef ^ FAST_ParameterType IntKi SolveOption - - - "Switch to determine which solve option we are going to use (see Solve_FullOpt1, etc)" - +typedef ^ FAST_ParameterType IntKi SolveOption - - - "Switch to determine which solve option we are going to use (see Solve_FullOpt1, etc)" - # Feature switches and flags: -typedef ^ FAST_ParameterType IntKi CompElast - - - "Compute blade loads (switch) {Module_ED; Module_BD}" - -typedef ^ FAST_ParameterType IntKi CompInflow - - - "Compute inflow wind conditions (switch) {Module_None; Module_IfW; Module_OpFM}" - -typedef ^ FAST_ParameterType IntKi CompAero - - - "Compute aerodynamic loads (switch) {Module_None; Module_AD14; Module_AD}" - +typedef ^ FAST_ParameterType IntKi CompElast - - - "Compute blade loads (switch) {Module_ED; Module_BD; Module_SED}" - +typedef ^ FAST_ParameterType IntKi CompInflow - - - "Compute inflow wind conditions (switch) {Module_None; Module_IfW; Module_ExtInfw}" - +typedef ^ FAST_ParameterType IntKi CompAero - - - "Compute aerodynamic loads (switch) {Module_None; Module_ADsk; Module_AD}" - typedef ^ FAST_ParameterType IntKi CompServo - - - "Compute control and electrical-drive dynamics (switch) {Module_None; Module_SrvD}" - +typedef ^ FAST_ParameterType IntKi CompSeaSt - - - "Compute sea states; wave kinematics (switch) {Module_None; Module_SeaSt}" - typedef ^ FAST_ParameterType IntKi CompHydro - - - "Compute hydrodynamic loads (switch) {Module_None; Module_HD}" - -typedef ^ FAST_ParameterType IntKi CompSub - - - "Compute sub-structural dynamics (switch) {Module_None; Module_HD}" - +typedef ^ FAST_ParameterType IntKi CompSub - - - "Compute sub-structural dynamics (switch) {Module_None; Module_SD, Module_ExtPtfm}" - typedef ^ FAST_ParameterType IntKi CompMooring - - - "Compute mooring system (switch) {Module_None; Module_MAP; Module_FEAM; Module_MD; Module_Orca}" - typedef ^ FAST_ParameterType IntKi CompIce - - - "Compute ice loading (switch) {Module_None; Module_IceF, Module_IceD}" - typedef ^ FAST_ParameterType IntKi MHK - - - "MHK turbine type (switch) {0=Not an MHK turbine; 1=Fixed MHK turbine; 2=Floating MHK turbine}" - @@ -132,11 +155,12 @@ typedef ^ FAST_ParameterType ReKi Pvap - - - "Vapour pressure typedef ^ FAST_ParameterType ReKi WtrDpth - - - "Water depth" m typedef ^ FAST_ParameterType ReKi MSL2SWL - - - "Offset between still-water level and mean sea level" m # Input file names: -typedef ^ FAST_ParameterType CHARACTER(1024) EDFile - - - "The name of the ElastoDyn input file" - +typedef ^ FAST_ParameterType CHARACTER(1024) EDFile - - - "The name of the ElastoDyn/Simplified-ElastoDyn input file" - typedef ^ FAST_ParameterType CHARACTER(1024) BDBldFile {MaxNBlades} - - "Name of files containing BeamDyn inputs for each blade" - typedef ^ FAST_ParameterType CHARACTER(1024) InflowFile - - - "Name of file containing inflow wind input parameters" - typedef ^ FAST_ParameterType CHARACTER(1024) AeroFile - - - "Name of file containing aerodynamic input parameters" - typedef ^ FAST_ParameterType CHARACTER(1024) ServoFile - - - "Name of file containing control and electrical-drive input parameters" - +typedef ^ FAST_ParameterType CHARACTER(1024) SeaStFile - - - "Name of file containing sea state input parameters" - typedef ^ FAST_ParameterType CHARACTER(1024) HydroFile - - - "Name of file containing hydrodynamic input parameters" - typedef ^ FAST_ParameterType CHARACTER(1024) SubFile - - - "Name of file containing sub-structural input parameters" - typedef ^ FAST_ParameterType CHARACTER(1024) MooringFile - - - "Name of file containing mooring system input parameters" - @@ -150,7 +174,6 @@ typedef ^ FAST_ParameterType INTEGER n_SttsTime - - - "Number of time steps betw typedef ^ FAST_ParameterType INTEGER n_ChkptTime - - - "Number of time steps between writing checkpoint files" - typedef ^ FAST_ParameterType INTEGER n_DT_Out - - - "Number of time steps between writing a line in the time-marching output files" - typedef ^ FAST_ParameterType INTEGER n_VTKTime - - - "Number of time steps between writing VTK files" - -typedef ^ FAST_ParameterType IntKi TurbineType - - - "Type_LandBased, Type_Offshore_Fixed, Type_Offshore_Floating, Type_MHK_Fixed, or Type_MHK_Floating" - typedef ^ FAST_ParameterType LOGICAL WrBinOutFile - - - "Write a binary output file? (.outb)" - typedef ^ FAST_ParameterType LOGICAL WrTxtOutFile - - - "Write a text (formatted) output file? (.out)" - typedef ^ FAST_ParameterType IntKi WrBinMod - - - "If writing binary, which file format is to be written [1, 2, or 3]" - @@ -193,6 +216,19 @@ typedef ^ FAST_ParameterType IntKi Lin_ModOrder {NumModules} - - "indices that d typedef ^ FAST_ParameterType IntKi LinInterpOrder - - - "Interpolation order for CalcSteady solution" - #typedef ^ FAST_ParameterType LOGICAL CheckHSSBrTrqC - - - "Flag to determine if we should check HSSBrTrqC extrapolation to ElastoDyn" - +# Parameters for steady-state calculations: +typedef ^ FAST_ParameterType LOGICAL CompAeroMaps - - - "Flag to determine if we are calculating aero maps" - +typedef ^ FAST_ParameterType IntKi N_UJac - - - "Number of iterations between re-calculating Jacobian" "(-)" +typedef ^ FAST_ParameterType IntKi NumBl_Lin - - - "number of blades in the jacobian" - +typedef ^ FAST_ParameterType R8Ki tolerSquared - - - "Convergence tolerance for nonlinear solve residual equation [>0] squared" "(-)" +typedef ^ FAST_ParameterType IntKi NumSSCases - - - "Number of cases for steady-state solver generation [>0]" "(-)" +typedef ^ FAST_ParameterType IntKi WindSpeedOrTSR - - - "Choice of swept parameter (switch) { 1:wind speed; 2: TSR }" "(-)" +typedef ^ FAST_ParameterType ReKi RotSpeedInit - - - "Initial rotor speed for steady-state solve [>0]" "(rad/s)" +typedef ^ FAST_ParameterType ReKi RotSpeed {:} - - "List of rotor speeds for steady-state solve [>0]" "(rad/s)" +typedef ^ FAST_ParameterType ReKi WS_TSR {:} - - "List of WindSpeed or TSRs (depending on WindSpeedOrTSR setting) for aeromap generation" "(m/s or -)" +typedef ^ FAST_ParameterType ReKi Pitch {:} - - "List of pitch angles for aeromap generation" "(rad)" +typedef ^ FAST_ParameterType IntKi GearBox_index - - - "Index to gearbox rotation in state array (for steady-state calculations)" - + # SAVED OPERATING POINT DATA FOR VTKLIN (visualization of mode shapes from linearization analysis) # ..... IceDyn OP data ....................................................................................................... @@ -213,26 +249,27 @@ typedef ^ ^ ED_DiscreteStateType xd_ED typedef ^ ^ ED_ConstraintStateType z_ED {:} - - "Constraint states" typedef ^ ^ ED_OtherStateType OtherSt_ED {:} - - "Other states" typedef ^ ^ ED_InputType u_ED {:} - - "System inputs" +# ..... No Simplified-ElastoDyn data ........................................................................................... # ..... ServoDyn OP data ....................................................................................................... typedef FAST FAST_LinStateSave SrvD_ContinuousStateType x_SrvD {:} - - "Continuous states" typedef ^ ^ SrvD_DiscreteStateType xd_SrvD {:} - - "Discrete states" typedef ^ ^ SrvD_ConstraintStateType z_SrvD {:} - - "Constraint states" typedef ^ ^ SrvD_OtherStateType OtherSt_SrvD {:} - - "Other states" typedef ^ ^ SrvD_InputType u_SrvD {:} - - "System inputs" -# ..... No AeroDyn14 data ..................................................................................................... # ..... AeroDyn OP data ....................................................................................................... typedef FAST FAST_LinStateSave AD_ContinuousStateType x_AD {:} - - "Continuous states" typedef ^ ^ AD_DiscreteStateType xd_AD {:} - - "Discrete states" typedef ^ ^ AD_ConstraintStateType z_AD {:} - - "Constraint states" typedef ^ ^ AD_OtherStateType OtherSt_AD {:} - - "Other states" typedef ^ ^ AD_InputType u_AD {:} - - "System inputs" -# ..... InflowWind OP data ....................................................................................................... +# ..... No AeroDisk data ...................................................................................................... +# ..... InflowWind OP data .................................................................................................... typedef FAST FAST_LinStateSave InflowWind_ContinuousStateType x_IfW {:} - - "Continuous states" typedef ^ ^ InflowWind_DiscreteStateType xd_IfW {:} - - "Discrete states" typedef ^ ^ InflowWind_ConstraintStateType z_IfW {:} - - "Constraint states" typedef ^ ^ InflowWind_OtherStateType OtherSt_IfW {:} - - "Other states" typedef ^ ^ InflowWind_InputType u_IfW {:} - - "System inputs" -# ..... No OpenFOAM integration data ....................................................................................................... +# ..... No ExternalInflow integration data ....................................................................................................... # ..... SubDyn OP data ....................................................................................................... typedef FAST FAST_LinStateSave SD_ContinuousStateType x_SD {:} - - "Continuous states" typedef ^ ^ SD_DiscreteStateType xd_SD {:} - - "Discrete states" @@ -251,6 +288,12 @@ typedef ^ ^ HydroDyn_DiscreteStateType xd_HD typedef ^ ^ HydroDyn_ConstraintStateType z_HD {:} - - "Constraint states" typedef ^ ^ HydroDyn_OtherStateType OtherSt_HD {:} - - "Other states" typedef ^ ^ HydroDyn_InputType u_HD {:} - - "System inputs" +# ..... SeaSt OP data ....................................................................................................... +typedef FAST FAST_LinStateSave SeaSt_ContinuousStateType x_SeaSt {:} - - "Continuous states" +typedef ^ ^ SeaSt_DiscreteStateType xd_SeaSt {:} - - "Discrete states" +typedef ^ ^ SeaSt_ConstraintStateType z_SeaSt {:} - - "Constraint states" +typedef ^ ^ SeaSt_OtherStateType OtherSt_SeaSt {:} - - "Other states" +typedef ^ ^ SeaSt_InputType u_SeaSt {:} - - "System inputs" # ..... IceFloe OP data ....................................................................................................... typedef FAST FAST_LinStateSave IceFloe_ContinuousStateType x_IceF {:} - - "Continuous states" typedef ^ ^ IceFloe_DiscreteStateType xd_IceF {:} - - "Discrete states" @@ -335,6 +378,7 @@ typedef ^ FAST_MiscLinType DbKi Psi {:} - - "Azimuth angle a typedef ^ FAST_MiscLinType ReKi y_interp {:} - - "Interpolated outputs packed into an array" - typedef ^ FAST_MiscLinType ReKi y_ref {:} - - "Reference output range for CalcSteady error calculation" - typedef ^ FAST_MiscLinType ReKi Y_prevRot {:}{:} - - "Linearization outputs from previous rotor revolution at each target azimuth " - +#typedef ^ FAST_MiscLinType ReKi eps_squared {:} - - "For debugging, quantity of each component that contributes to eps_squared" - # ..... FAST_OutputFileType data ....................................................................................................... @@ -356,9 +400,8 @@ typedef ^ FAST_OutputFileType IntKi VTK_count - - - "Number of VTK files written typedef ^ FAST_OutputFileType IntKi VTK_LastWaveIndx - - - "last index into wave array" - typedef ^ FAST_OutputFileType FAST_LinFileType Lin - - - "linearization data for output" typedef ^ FAST_OutputFileType IntKi ActualChanLen - - - "width of the column headers output in the text and/or binary file" - -typedef ^ FAST_OutputFileType CHARACTER(30) OutFmt_a - - - "Format used for text tabular output (except time); combines OutFmt with delim and appropriate spaces" - typedef ^ FAST_OutputFileType FAST_LinStateSave op - - - "operating points of states and inputs for VTK output of mode shapes" -typedef ^ FAST_OutputFileType ReKi DriverWriteOutput {5} - - "pitch and tsr for current aero map case, plus error, number of iterations, wind speed" +typedef ^ FAST_OutputFileType ReKi DriverWriteOutput {6} - - "pitch and tsr for current aero map case, plus error, number of iterations, wind speed, rotor speed" #typedef ^ FAST_OutputFileType CHARACTER(ChanLen) DriverWriteOutputHdr {:} - - "headers of data output from the driver" #typedef ^ FAST_OutputFileType CHARACTER(ChanLen) DriverWriteOutputUnit {:} - - "units of data output from the driver" @@ -375,7 +418,9 @@ typedef ^ ^ IceD_InputType u {:} - - "System inputs" typedef ^ ^ IceD_OutputType y {:} - - "System outputs" typedef ^ ^ IceD_MiscVarType m {:} - - "Misc/optimization variables" typedef ^ ^ IceD_InputType Input {:}{:} - - "Array of inputs associated with InputTimes" +typedef ^ ^ IceD_InputType Input_Saved {:}{:} - - "Backup Array of inputs associated with InputTimes" typedef ^ ^ DbKi InputTimes {:}{:} - - "Array of times associated with Input Array" +typedef ^ ^ DbKi InputTimes_Saved {:}{:} - - "Backup Array of times associated with Input Array" # ..... BeamDyn data ....................................................................................................... # [ the last dimension of each allocatable array is for the instance of BeamDyn being used ] @@ -391,54 +436,65 @@ typedef ^ ^ BD_MiscVarType m {:} - - "Misc/optimization variables" typedef ^ ^ BD_OutputType Output {:}{:} - - "Array of outputs associated with CalcSteady Azimuths" typedef ^ ^ BD_OutputType y_interp {:} - - "interpolated system outputs for CalcSteady" typedef ^ ^ BD_InputType Input {:}{:} - - "Array of inputs associated with InputTimes" +typedef ^ ^ BD_InputType Input_Saved {:}{:} - - "Backup Array of inputs associated with InputTimes" typedef ^ ^ DbKi InputTimes {:}{:} - - "Array of times associated with Input Array" +typedef ^ ^ DbKi InputTimes_Saved {:}{:} - - "Backup Array of times associated with Input Array" # ..... ElastoDyn data ....................................................................................................... -typedef FAST ElastoDyn_Data ED_ContinuousStateType x {2} - - "Continuous states" -typedef ^ ^ ED_DiscreteStateType xd {2} - - "Discrete states" -typedef ^ ^ ED_ConstraintStateType z {2} - - "Constraint states" -typedef ^ ^ ED_OtherStateType OtherSt {2} - - "Other states" +typedef FAST ElastoDyn_Data ED_ContinuousStateType x {NumStateTimes} - - "Continuous states" +typedef ^ ^ ED_DiscreteStateType xd {NumStateTimes} - - "Discrete states" +typedef ^ ^ ED_ConstraintStateType z {NumStateTimes} - - "Constraint states" +typedef ^ ^ ED_OtherStateType OtherSt {NumStateTimes} - - "Other states" typedef ^ ^ ED_ParameterType p - - - "Parameters" typedef ^ ^ ED_InputType u - - - "System inputs" typedef ^ ^ ED_OutputType y - - - "System outputs" typedef ^ ^ ED_MiscVarType m - - - "Misc (optimization) variables not associated with time" typedef ^ ^ ED_OutputType Output {:} - - "Array of outputs associated with CalcSteady Azimuths" +typedef ^ ^ ED_OutputType Output_bak {:} - - "Backup Array of outputs associated with InputTimes" typedef ^ ^ ED_OutputType y_interp - - - "interpolated system outputs for CalcSteady" typedef ^ ^ ED_InputType Input {:} - - "Array of inputs associated with InputTimes" +typedef ^ ^ ED_InputType Input_Saved {:} - - "Backup Array of inputs associated with InputTimes" +typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" +typedef ^ ^ DbKi InputTimes_Saved {:} - - "Backup Array of times associated with Input Array" + + +# ..... Simplified-ElastoDyn data ............................................................................................ +typedef FAST SED_Data SED_ContinuousStateType x {2} - - "Continuous states" +typedef ^ ^ SED_DiscreteStateType xd {2} - - "Discrete states" +typedef ^ ^ SED_ConstraintStateType z {2} - - "Constraint states" +typedef ^ ^ SED_OtherStateType OtherSt {2} - - "Other states" +typedef ^ ^ SED_ParameterType p - - - "Parameters" +typedef ^ ^ SED_InputType u - - - "System inputs" +typedef ^ ^ SED_OutputType y - - - "System outputs" +typedef ^ ^ SED_MiscVarType m - - - "Misc (optimization) variables not associated with time" +typedef ^ ^ SED_OutputType Output {:} - - "Array of outputs associated with CalcSteady Azimuths" +typedef ^ ^ SED_OutputType y_interp - - - "interpolated system outputs for CalcSteady" +typedef ^ ^ SED_InputType Input {:} - - "Array of inputs associated with InputTimes" typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" # ..... ServoDyn data ....................................................................................................... -typedef FAST ServoDyn_Data SrvD_ContinuousStateType x {2} - - "Continuous states" -typedef ^ ^ SrvD_DiscreteStateType xd {2} - - "Discrete states" -typedef ^ ^ SrvD_ConstraintStateType z {2} - - "Constraint states" -typedef ^ ^ SrvD_OtherStateType OtherSt {2} - - "Other states" +typedef FAST ServoDyn_Data SrvD_ContinuousStateType x {NumStateTimes} - - "Continuous states" +typedef ^ ^ SrvD_DiscreteStateType xd {NumStateTimes} - - "Discrete states" +typedef ^ ^ SrvD_ConstraintStateType z {NumStateTimes} - - "Constraint states" +typedef ^ ^ SrvD_OtherStateType OtherSt {NumStateTimes} - - "Other states" typedef ^ ^ SrvD_ParameterType p - - - "Parameters" typedef ^ ^ SrvD_InputType u - - - "System inputs" typedef ^ ^ SrvD_OutputType y - - - "System outputs" typedef ^ ^ SrvD_MiscVarType m - - - "Misc (optimization) variables not associated with time" +typedef ^ ^ SrvD_MiscVarType m_bak - - - "Backup Misc (optimization) variables not associated with time" typedef ^ ^ SrvD_OutputType Output {:} - - "Array of outputs associated with CalcSteady Azimuths" typedef ^ ^ SrvD_OutputType y_interp - - - "interpolated system outputs for CalcSteady" typedef ^ ^ SrvD_InputType Input {:} - - "Array of inputs associated with InputTimes" +typedef ^ ^ SrvD_InputType Input_Saved {:} - - "Backup Array of inputs associated with InputTimes" typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" - -# ..... AeroDyn14 data ....................................................................................................... -typedef FAST AeroDyn14_Data AD14_ContinuousStateType x {2} - - "Continuous states" -typedef ^ ^ AD14_DiscreteStateType xd {2} - - "Discrete states" -typedef ^ ^ AD14_ConstraintStateType z {2} - - "Constraint states" -typedef ^ ^ AD14_OtherStateType OtherSt {2} - - "Other states" -typedef ^ ^ AD14_ParameterType p - - - "Parameters" -typedef ^ ^ AD14_InputType u - - - "System inputs" -typedef ^ ^ AD14_OutputType y - - - "System outputs" -typedef ^ ^ AD14_MiscVarType m - - - "Misc/optimization variables" -typedef ^ ^ AD14_InputType Input {:} - - "Array of inputs associated with InputTimes" -typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" +typedef ^ ^ DbKi InputTimes_Saved {:} - - "Backup Array of times associated with Input Array" # ..... AeroDyn data ....................................................................................................... -typedef FAST AeroDyn_Data AD_ContinuousStateType x {2} - - "Continuous states" -typedef ^ ^ AD_DiscreteStateType xd {2} - - "Discrete states" -typedef ^ ^ AD_ConstraintStateType z {2} - - "Constraint states" -typedef ^ ^ AD_OtherStateType OtherSt {2} - - "Other states" +typedef FAST AeroDyn_Data AD_ContinuousStateType x {NumStateTimes} - - "Continuous states" +typedef ^ ^ AD_DiscreteStateType xd {NumStateTimes} - - "Discrete states" +typedef ^ ^ AD_ConstraintStateType z {NumStateTimes} - - "Constraint states" +typedef ^ ^ AD_OtherStateType OtherSt {NumStateTimes} - - "Other states" typedef ^ ^ AD_ParameterType p - - - "Parameters" typedef ^ ^ AD_InputType u - - - "System inputs" typedef ^ ^ AD_OutputType y - - - "System outputs" @@ -446,13 +502,40 @@ typedef ^ ^ AD_MiscVarType m - - - "Misc/optimization variables" typedef ^ ^ AD_OutputType Output {:} - - "Array of outputs associated with CalcSteady Azimuths" typedef ^ ^ AD_OutputType y_interp - - - "interpolated system outputs for CalcSteady" typedef ^ ^ AD_InputType Input {:} - - "Array of inputs associated with InputTimes" +typedef ^ ^ AD_InputType Input_Saved {:} - - "Backup Array of inputs associated with InputTimes" +typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" +typedef ^ ^ DbKi InputTimes_Saved {:} - - "Backup Array of times associated with Input Array" + +# ..... ExtLoads data ....................................................................................................... +typedef FAST ExtLoads_Data ExtLd_ContinuousStateType x {NumStateTimes} - - "Continuous states" +typedef ^ ^ ExtLd_DiscreteStateType xd {NumStateTimes} - - "Discrete states" +typedef ^ ^ ExtLd_ConstraintStateType z {NumStateTimes} - - "Constraint states" +typedef ^ ^ ExtLd_OtherStateType OtherSt {NumStateTimes} - - "Other states" +typedef ^ ^ ExtLd_ParameterType p - - - "Parameters" +typedef ^ ^ ExtLd_InputType u - - - "System inputs" +typedef ^ ^ ExtLd_OutputType y - - - "System outputs" +typedef ^ ^ ExtLd_MiscVarType m - - - "Misc/optimization variables" +typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" + +# ..... AeroDisk data ....................................................................................................... +typedef FAST AeroDisk_Data ADsk_ContinuousStateType x {2} - - "Continuous states" +typedef ^ ^ ADsk_DiscreteStateType xd {2} - - "Discrete states" +typedef ^ ^ ADsk_ConstraintStateType z {2} - - "Constraint states" +typedef ^ ^ ADsk_OtherStateType OtherSt {2} - - "Other states" +typedef ^ ^ ADsk_ParameterType p - - - "Parameters" +typedef ^ ^ ADsk_InputType u - - - "System inputs" +typedef ^ ^ ADsk_OutputType y - - - "System outputs" +typedef ^ ^ ADsk_MiscVarType m - - - "Misc/optimization variables" +typedef ^ ^ ADsk_OutputType Output {:} - - "Array of outputs associated with CalcSteady Azimuths" +typedef ^ ^ ADsk_OutputType y_interp - - - "interpolated system outputs for CalcSteady" +typedef ^ ^ ADsk_InputType Input {:} - - "Array of inputs associated with InputTimes" typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" # ..... InflowWind data ....................................................................................................... -typedef FAST InflowWind_Data InflowWind_ContinuousStateType x {2} - - "Continuous states" -typedef ^ ^ InflowWind_DiscreteStateType xd {2} - - "Discrete states" -typedef ^ ^ InflowWind_ConstraintStateType z {2} - - "Constraint states" -typedef ^ ^ InflowWind_OtherStateType OtherSt {2} - - "Other states" +typedef FAST InflowWind_Data InflowWind_ContinuousStateType x {NumStateTimes} - - "Continuous states" +typedef ^ ^ InflowWind_DiscreteStateType xd {NumStateTimes} - - "Discrete states" +typedef ^ ^ InflowWind_ConstraintStateType z {NumStateTimes} - - "Constraint states" +typedef ^ ^ InflowWind_OtherStateType OtherSt {NumStateTimes} - - "Other states" typedef ^ ^ InflowWind_ParameterType p - - - "Parameters" typedef ^ ^ InflowWind_InputType u - - - "System inputs" typedef ^ ^ InflowWind_OutputType y - - - "System outputs" @@ -460,13 +543,15 @@ typedef ^ ^ InflowWind_MiscVarType m - - - "Misc/optimization variables" typedef ^ ^ InflowWind_OutputType Output {:} - - "Array of outputs associated with CalcSteady Azimuths" typedef ^ ^ InflowWind_OutputType y_interp - - - "interpolated system outputs for CalcSteady" typedef ^ ^ InflowWind_InputType Input {:} - - "Array of inputs associated with InputTimes" +typedef ^ ^ InflowWind_InputType Input_Saved {:} - - "Backup Array of inputs associated with InputTimes" typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" +typedef ^ ^ DbKi InputTimes_Saved {:} - - "Backup Array of times associated with Input Array" -# ..... OpenFOAM integration data ....................................................................................................... -typedef FAST OpenFOAM_Data OpFM_InputType u - - - "System inputs" -typedef ^ ^ OpFM_OutputType y - - - "System outputs" -typedef ^ ^ OpFM_ParameterType p - - - "Parameters" -typedef ^ ^ OpFM_MiscVarType m - - - "Parameters" +# ..... ExternalInflow integration data ....................................................................................................... +typedef FAST ExternalInflow_Data ExtInfw_InputType u - - - "System inputs" +typedef ^ ^ ExtInfw_OutputType y - - - "System outputs" +typedef ^ ^ ExtInfw_ParameterType p - - - "Parameters" +typedef ^ ^ ExtInfw_MiscVarType m - - - "Parameters" # ..... SuperController integration data ....................................................................................................... typedef FAST SCDataEx_Data SC_DX_InputType u - - - "System inputs" @@ -474,36 +559,56 @@ typedef ^ ^ SC_DX_OutputType y - - - "System outputs" typedef ^ ^ SC_DX_ParameterType p - - - "System parameters" # ..... SubDyn data ....................................................................................................... -typedef FAST SubDyn_Data SD_ContinuousStateType x {2} - - "Continuous states" -typedef ^ ^ SD_DiscreteStateType xd {2} - - "Discrete states" -typedef ^ ^ SD_ConstraintStateType z {2} - - "Constraint states" -typedef ^ ^ SD_OtherStateType OtherSt {2} - - "Other states" +typedef FAST SubDyn_Data SD_ContinuousStateType x {NumStateTimes} - - "Continuous states" +typedef ^ ^ SD_DiscreteStateType xd {NumStateTimes} - - "Discrete states" +typedef ^ ^ SD_ConstraintStateType z {NumStateTimes} - - "Constraint states" +typedef ^ ^ SD_OtherStateType OtherSt {NumStateTimes} - - "Other states" typedef ^ ^ SD_ParameterType p - - - "Parameters" typedef ^ ^ SD_InputType u - - - "System inputs" typedef ^ ^ SD_OutputType y - - - "System outputs" typedef ^ ^ SD_MiscVarType m - - - "Misc/optimization variables" typedef ^ ^ SD_InputType Input {:} - - "Array of inputs associated with InputTimes" +typedef ^ ^ SD_InputType Input_Saved {:} - - "Backup Array of inputs associated with InputTimes" typedef ^ ^ SD_OutputType Output {:} - - "Array of outputs associated with CalcSteady Azimuths" typedef ^ ^ SD_OutputType y_interp - - - "interpolated system outputs for CalcSteady" typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" +typedef ^ ^ DbKi InputTimes_Saved {:} - - "Backup Array of times associated with Input Array" # ..... ExtPtfm data ....................................................................................................... -typedef FAST ExtPtfm_Data ExtPtfm_ContinuousStateType x {2} - - "Continuous states" -typedef ^ ^ ExtPtfm_DiscreteStateType xd {2} - - "Discrete states" -typedef ^ ^ ExtPtfm_ConstraintStateType z {2} - - "Constraint states" -typedef ^ ^ ExtPtfm_OtherStateType OtherSt {2} - - "Other states" +typedef FAST ExtPtfm_Data ExtPtfm_ContinuousStateType x {NumStateTimes} - - "Continuous states" +typedef ^ ^ ExtPtfm_DiscreteStateType xd {NumStateTimes} - - "Discrete states" +typedef ^ ^ ExtPtfm_ConstraintStateType z {NumStateTimes} - - "Constraint states" +typedef ^ ^ ExtPtfm_OtherStateType OtherSt {NumStateTimes} - - "Other states" typedef ^ ^ ExtPtfm_ParameterType p - - - "Parameters" typedef ^ ^ ExtPtfm_InputType u - - - "System inputs" typedef ^ ^ ExtPtfm_OutputType y - - - "System outputs" typedef ^ ^ ExtPtfm_MiscVarType m - - - "Misc/optimization variables" typedef ^ ^ ExtPtfm_InputType Input {:} - - "Array of inputs associated with InputTimes" +typedef ^ ^ ExtPtfm_InputType Input_Saved {:} - - "Backup Array of inputs associated with InputTimes" typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" +typedef ^ ^ DbKi InputTimes_Saved {:} - - "Backup Array of times associated with Input Array" + +# ..... SeaState data ....................................................................................................... +typedef FAST SeaState_Data SeaSt_ContinuousStateType x {NumStateTimes} - - "Continuous states" +typedef ^ ^ SeaSt_DiscreteStateType xd {NumStateTimes} - - "Discrete states" +typedef ^ ^ SeaSt_ConstraintStateType z {NumStateTimes} - - "Constraint states" +typedef ^ ^ SeaSt_OtherStateType OtherSt {NumStateTimes} - - "Other states" +typedef ^ ^ SeaSt_ParameterType p - - - "Parameters" +typedef ^ ^ SeaSt_InputType u - - - "System inputs" +typedef ^ ^ SeaSt_OutputType y - - - "System outputs" +typedef ^ ^ SeaSt_MiscVarType m - - - "Misc/optimization variables" +typedef ^ ^ SeaSt_InputType Input {:} - - "Array of inputs associated with InputTimes" +typedef ^ ^ SeaSt_InputType Input_Saved {:} - - "Backup Array of inputs associated with InputTimes" +typedef ^ ^ SeaSt_OutputType Output {:} - - "Array of outputs associated with CalcSteady Azimuths" +typedef ^ ^ SeaSt_OutputType y_interp - - - "interpolated system outputs for CalcSteady" +typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" +typedef ^ ^ DbKi InputTimes_Saved {:} - - "Backup Array of times associated with Input Array" # ..... HydroDyn data ....................................................................................................... -typedef FAST HydroDyn_Data HydroDyn_ContinuousStateType x {2} - - "Continuous states" -typedef ^ ^ HydroDyn_DiscreteStateType xd {2} - - "Discrete states" -typedef ^ ^ HydroDyn_ConstraintStateType z {2} - - "Constraint states" -typedef ^ ^ HydroDyn_OtherStateType OtherSt {2} - - "Other states" +typedef FAST HydroDyn_Data HydroDyn_ContinuousStateType x {NumStateTimes} - - "Continuous states" +typedef ^ ^ HydroDyn_DiscreteStateType xd {NumStateTimes} - - "Discrete states" +typedef ^ ^ HydroDyn_ConstraintStateType z {NumStateTimes} - - "Constraint states" +typedef ^ ^ HydroDyn_OtherStateType OtherSt {NumStateTimes} - - "Other states" typedef ^ ^ HydroDyn_ParameterType p - - - "Parameters" typedef ^ ^ HydroDyn_InputType u - - - "System inputs" typedef ^ ^ HydroDyn_OutputType y - - - "System outputs" @@ -511,24 +616,28 @@ typedef ^ ^ HydroDyn_MiscVarType m - - - "Misc/optimization variables" typedef ^ ^ HydroDyn_OutputType Output {:} - - "Array of outputs associated with CalcSteady Azimuths" typedef ^ ^ HydroDyn_OutputType y_interp - - - "interpolated system outputs for CalcSteady" typedef ^ ^ HydroDyn_InputType Input {:} - - "Array of inputs associated with InputTimes" +typedef ^ ^ HydroDyn_InputType Input_Saved {:} - - "Backup Array of inputs associated with InputTimes" typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" +typedef ^ ^ DbKi InputTimes_Saved {:} - - "Backup Array of times associated with Input Array" # ..... IceFloe data ....................................................................................................... -typedef FAST IceFloe_Data IceFloe_ContinuousStateType x {2} - - "Continuous states" -typedef ^ ^ IceFloe_DiscreteStateType xd {2} - - "Discrete states" -typedef ^ ^ IceFloe_ConstraintStateType z {2} - - "Constraint states" -typedef ^ ^ IceFloe_OtherStateType OtherSt {2} - - "Other states" +typedef FAST IceFloe_Data IceFloe_ContinuousStateType x {NumStateTimes} - - "Continuous states" +typedef ^ ^ IceFloe_DiscreteStateType xd {NumStateTimes} - - "Discrete states" +typedef ^ ^ IceFloe_ConstraintStateType z {NumStateTimes} - - "Constraint states" +typedef ^ ^ IceFloe_OtherStateType OtherSt {NumStateTimes} - - "Other states" typedef ^ ^ IceFloe_ParameterType p - - - "Parameters" typedef ^ ^ IceFloe_InputType u - - - "System inputs" typedef ^ ^ IceFloe_OutputType y - - - "System outputs" typedef ^ ^ IceFloe_MiscVarType m - - - "Misc/optimization variables" typedef ^ ^ IceFloe_InputType Input {:} - - "Array of inputs associated with InputTimes" +typedef ^ ^ IceFloe_InputType Input_Saved {:} - - "Backup Array of inputs associated with InputTimes" typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" +typedef ^ ^ DbKi InputTimes_Saved {:} - - "Backup Array of times associated with Input Array" # ..... MAP data ....................................................................................................... -typedef FAST MAP_Data MAP_ContinuousStateType x {2} - - "Continuous states" -typedef ^ ^ MAP_DiscreteStateType xd {2} - - "Discrete states" -typedef ^ ^ MAP_ConstraintStateType z {2} - - "Constraint states" +typedef FAST MAP_Data MAP_ContinuousStateType x {NumStateTimes} - - "Continuous states" +typedef ^ ^ MAP_DiscreteStateType xd {NumStateTimes} - - "Discrete states" +typedef ^ ^ MAP_ConstraintStateType z {NumStateTimes} - - "Constraint states" typedef ^ ^ MAP_OtherStateType OtherSt - - - "Other/optimization states" typedef ^ ^ MAP_ParameterType p - - - "Parameters" typedef ^ ^ MAP_InputType u - - - "System inputs" @@ -537,25 +646,29 @@ typedef ^ ^ MAP_OtherStateType OtherSt_old - - - "Other/optimization states (cop typedef ^ ^ MAP_OutputType Output {:} - - "Array of outputs associated with CalcSteady Azimuths" typedef ^ ^ MAP_OutputType y_interp - - - "interpolated system outputs for CalcSteady" typedef ^ ^ MAP_InputType Input {:} - - "Array of inputs associated with InputTimes" +typedef ^ ^ MAP_InputType Input_Saved {:} - - "Backup Array of inputs associated with InputTimes" typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" +typedef ^ ^ DbKi InputTimes_Saved {:} - - "Backup Array of times associated with Input Array" # ..... FEAMooring data ....................................................................................................... -typedef FAST FEAMooring_Data FEAM_ContinuousStateType x {2} - - "Continuous states" -typedef ^ ^ FEAM_DiscreteStateType xd {2} - - "Discrete states" -typedef ^ ^ FEAM_ConstraintStateType z {2} - - "Constraint states" -typedef ^ ^ FEAM_OtherStateType OtherSt {2} - - "Other states" +typedef FAST FEAMooring_Data FEAM_ContinuousStateType x {NumStateTimes} - - "Continuous states" +typedef ^ ^ FEAM_DiscreteStateType xd {NumStateTimes} - - "Discrete states" +typedef ^ ^ FEAM_ConstraintStateType z {NumStateTimes} - - "Constraint states" +typedef ^ ^ FEAM_OtherStateType OtherSt {NumStateTimes} - - "Other states" typedef ^ ^ FEAM_ParameterType p - - - "Parameters" typedef ^ ^ FEAM_InputType u - - - "System inputs" typedef ^ ^ FEAM_OutputType y - - - "System outputs" typedef ^ ^ FEAM_MiscVarType m - - - "Misc/optimization variables" typedef ^ ^ FEAM_InputType Input {:} - - "Array of inputs associated with InputTimes" +typedef ^ ^ FEAM_InputType Input_Saved {:} - - "Backup Array of inputs associated with InputTimes" typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" +typedef ^ ^ DbKi InputTimes_Saved {:} - - "Backup Array of times associated with Input Array" # ..... MoorDyn data ....................................................................................................... -typedef FAST MoorDyn_Data MD_ContinuousStateType x {2} - - "Continuous states" -typedef ^ ^ MD_DiscreteStateType xd {2} - - "Discrete states" -typedef ^ ^ MD_ConstraintStateType z {2} - - "Constraint states" -typedef ^ ^ MD_OtherStateType OtherSt {2} - - "Other states" +typedef FAST MoorDyn_Data MD_ContinuousStateType x {NumStateTimes} - - "Continuous states" +typedef ^ ^ MD_DiscreteStateType xd {NumStateTimes} - - "Discrete states" +typedef ^ ^ MD_ConstraintStateType z {NumStateTimes} - - "Constraint states" +typedef ^ ^ MD_OtherStateType OtherSt {NumStateTimes} - - "Other states" typedef ^ ^ MD_ParameterType p - - - "Parameters" typedef ^ ^ MD_InputType u - - - "System inputs" typedef ^ ^ MD_OutputType y - - - "System outputs" @@ -563,19 +676,23 @@ typedef ^ ^ MD_MiscVarType m - - - "Misc/optimization variables" typedef ^ ^ MD_OutputType Output {:} - - "Array of outputs associated with CalcSteady Azimuths" typedef ^ ^ MD_OutputType y_interp - - - "interpolated system outputs for CalcSteady" typedef ^ ^ MD_InputType Input {:} - - "Array of inputs associated with InputTimes" +typedef ^ ^ MD_InputType Input_Saved {:} - - "Backup Array of inputs associated with InputTimes" typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" +typedef ^ ^ DbKi InputTimes_Saved {:} - - "Backup Array of times associated with Input Array" # ..... OrcaFlex data ....................................................................................................... -typedef FAST OrcaFlex_Data Orca_ContinuousStateType x {2} - - "Continuous states" -typedef ^ ^ Orca_DiscreteStateType xd {2} - - "Discrete states" -typedef ^ ^ Orca_ConstraintStateType z {2} - - "Constraint states" -typedef ^ ^ Orca_OtherStateType OtherSt {2} - - "Other states" +typedef FAST OrcaFlex_Data Orca_ContinuousStateType x {NumStateTimes} - - "Continuous states" +typedef ^ ^ Orca_DiscreteStateType xd {NumStateTimes} - - "Discrete states" +typedef ^ ^ Orca_ConstraintStateType z {NumStateTimes} - - "Constraint states" +typedef ^ ^ Orca_OtherStateType OtherSt {NumStateTimes} - - "Other states" typedef ^ ^ Orca_ParameterType p - - - "Parameters" typedef ^ ^ Orca_InputType u - - - "System inputs" typedef ^ ^ Orca_OutputType y - - - "System outputs" typedef ^ ^ Orca_MiscVarType m - - - "Misc/optimization variables" typedef ^ ^ Orca_InputType Input {:} - - "Array of inputs associated with InputTimes" +typedef ^ ^ Orca_InputType Input_Saved {:} - - "Backup Array of inputs associated with InputTimes" typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" +typedef ^ ^ DbKi InputTimes_Saved {:} - - "Backup Array of times associated with Input Array" # ..... FAST_ModuleMapType data ....................................................................................................... # ! Data structures for mapping and coupling the various modules together @@ -583,26 +700,18 @@ typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" typedef ^ FAST_ModuleMapType MeshMapType ED_P_2_BD_P {:} - - "Map ElastoDyn BladeRootMotion meshes to BeamDyn RootMotion point meshes" typedef ^ FAST_ModuleMapType MeshMapType BD_P_2_ED_P {:} - - "Map BeamDyn ReactionForce loads point meshes to ElastoDyn HubPtLoad point mesh" typedef ^ FAST_ModuleMapType MeshMapType ED_P_2_BD_P_Hub {:} - - "ElastoDyn hub to BeamDyn for hub orientation necessary for pitch actuator" -# ED <-> HD +# ED/SD <-> HD typedef ^ FAST_ModuleMapType MeshMapType ED_P_2_HD_PRP_P - - - "Map ElastoDyn PlatformPtMesh to HydroDyn platform reference Point" -typedef ^ FAST_ModuleMapType MeshMapType ED_P_2_HD_W_P - - - "Map ElastoDyn PlatformPtMesh to HydroDyn WAMIT Point" -typedef ^ FAST_ModuleMapType MeshMapType HD_W_P_2_ED_P - - - "Map HydroDyn WAMIT Point from y%WAMITMesh to ElastoDyn PlatformPtMesh" -typedef ^ FAST_ModuleMapType MeshMapType ED_P_2_HD_M_P - - - "Map ElastoDyn PlatformPtMesh to HydroDyn Morison Point" -typedef ^ FAST_ModuleMapType MeshMapType HD_M_P_2_ED_P - - - "Map HydroDyn Morison Point to ElastoDyn PlatformPtMesh" -# ED <-> Mooring (MAP, FEAM, MoorDyn, OrcaFlex) -typedef ^ FAST_ModuleMapType MeshMapType ED_P_2_Mooring_P - - - "Map ElastoDyn PlatformPtMesh to MAP/FEAM/MoorDyn/OrcaFlex point mesh" -typedef ^ FAST_ModuleMapType MeshMapType Mooring_P_2_ED_P - - - "Map FEAM/MAP/MoorDyn/OrcaFlex point mesh to ElastoDyn PlatformPtMesh" -# SD <-> Mooring (MAP, FEAM, MoorDyn, OrcaFlex) -typedef ^ FAST_ModuleMapType MeshMapType SDy3_P_2_Mooring_P - - - "Map SD Motions (y3Mesh) to MAP/FEAM/MoorDyn/OrcaFlex point mesh" -typedef ^ FAST_ModuleMapType MeshMapType Mooring_P_2_SD_P - - - "Map FEAM/MAP/MoorDyn/OrcaFlex point mesh to SD point loads (LMesh) mesh" +typedef ^ FAST_ModuleMapType MeshMapType SubStructure_2_HD_W_P - - - "Map ElastoDyn PlatformPtMesh or SubDyn y2Mesh to HydroDyn WAMIT Point" +typedef ^ FAST_ModuleMapType MeshMapType HD_W_P_2_SubStructure - - - "Map HydroDyn WAMIT Point from y%WAMITMesh to ElastoDyn PlatformPtMesh or SD LMesh" +typedef ^ FAST_ModuleMapType MeshMapType SubStructure_2_HD_M_P - - - "Map ElastoDyn PlatformPtMesh or SubDyn y2Mesh to HydroDyn Morison Point" +typedef ^ FAST_ModuleMapType MeshMapType HD_M_P_2_SubStructure - - - "Map HydroDyn Morison Point to ElastoDyn PlatformPtMesh or SD LMesh" +# Structure (ED, SD, ExtPtfm) <-> Mooring (MAP, FEAM, MoorDyn, OrcaFlex) +typedef ^ FAST_ModuleMapType MeshMapType Structure_2_Mooring - - - "Map structural SD (y3Mesh)/ED to MAP/FEAM/MoorDyn/OrcaFlex point mesh" "Motions" +typedef ^ FAST_ModuleMapType MeshMapType Mooring_2_Structure - - - "Map FEAM/MAP/MoorDyn/OrcaFlex mesh to SD (LMesh)/ED (PlatformPtMesh)/ExtPtfm mesh" "Loads" # ED <-> SD or User-Platform (ExtPtfm_MCKF) typedef ^ FAST_ModuleMapType MeshMapType ED_P_2_SD_TP - - - "Map ElastoDyn PlatformPtMesh to SubDyn transition-piece point mesh" typedef ^ FAST_ModuleMapType MeshMapType SD_TP_2_ED_P - - - "Map SubDyn transition-piece point mesh to ElastoDyn PlatformPtMesh" -# SD <-> HD -typedef ^ FAST_ModuleMapType MeshMapType SD_P_2_HD_M_P - - - "Map SubDyn y2Mesh Point to HydroDyn Morison Point" -typedef ^ FAST_ModuleMapType MeshMapType HD_M_P_2_SD_P - - - "Map HydroDyn Morison Point to SubDyn y2Mesh Point" -typedef ^ FAST_ModuleMapType MeshMapType SD_P_2_HD_W_P - - - "Map SubDyn y2Mesh Point to HydroDyn WAMIT Point" -typedef ^ FAST_ModuleMapType MeshMapType HD_W_P_2_SD_P - - - "Map HydroDyn WAMIT Point to SubDyn y2Mesh Point" # ED/BD <-> SrvD/StC typedef ^ FAST_ModuleMapType MeshMapType ED_P_2_NStC_P_N {:} - - "Map ElastoDyn nacelle point mesh to ServoDyn/NStC point mesh" typedef ^ FAST_ModuleMapType MeshMapType NStC_P_2_ED_P_N {:} - - "Map ServoDyn/NStC nacelle point mesh to ElastoDyn point mesh on the nacelle" @@ -613,16 +722,17 @@ typedef ^ FAST_ModuleMapType MeshMapType BStC_P_2_ED_P_B {:}{:} - - "Map ServoD typedef ^ FAST_ModuleMapType MeshMapType BD_L_2_BStC_P_B {:}{:} - - "Map BeamDyn blade line2 mesh to ServoDyn/BStC point mesh" typedef ^ FAST_ModuleMapType MeshMapType BStC_P_2_BD_P_B {:}{:} - - "Map ServoDyn/BStC point mesh to BeamDyn point load mesh on the blade" # ED/SD <-> SrvD/StC -- Platform TMD -typedef ^ FAST_ModuleMapType MeshMapType SStC_P_P_2_ED_P {:} - - "Map ServoDyn/SStC platform point mesh load to ElastoDyn point load mesh" -typedef ^ FAST_ModuleMapType MeshMapType ED_P_2_SStC_P_P {:} - - "Map ElastoDyn platform point mesh motion to ServoDyn/SStC point mesh" -typedef ^ FAST_ModuleMapType MeshMapType SStC_P_P_2_SD_P {:} - - "Map ServoDyn/SStC platform point mesh load to SubDyn point load mesh" -typedef ^ FAST_ModuleMapType MeshMapType SDy3_P_2_SStC_P_P {:} - - "Map SubDyn y3mesh point mesh motion to ServoDyn/SStC point mesh" +typedef ^ FAST_ModuleMapType MeshMapType SStC_P_P_2_SubStructure {:} - - "Map ServoDyn/SStC platform point mesh load to SubDyn/ElastoDyn point load mesh" +typedef ^ FAST_ModuleMapType MeshMapType SubStructure_2_SStC_P_P {:} - - "Map SubDyn y3mesh or ED platform mesh motion to ServoDyn/SStC point mesh" # ED --> SrvD -- PlatformPtMesh motion to SrvD%PtfmMotionMesh for passing to DLL -typedef ^ FAST_ModuleMapType MeshMapType ED_P_2_SrvD_P_P - - - "Map ElastoDyn platform point mesh motion to ServoDyn point mesh -- for passing to controller" -# ED/BD <-> AD (blades) +typedef ^ FAST_ModuleMapType MeshMapType ED_P_2_SrvD_P_P - - - "Map ElastoDyn/Simplified-ElastoDyn platform point mesh motion to ServoDyn point mesh -- for passing to controller" +# ED/BD/SED <-> AD (blades) typedef ^ FAST_ModuleMapType MeshMapType BDED_L_2_AD_L_B {:} - - "Map ElastoDyn BladeLn2Mesh point meshes OR BeamDyn BldMotion line2 meshes to AeroDyn14 InputMarkers OR AeroDyn BladeMotion line2 meshes" typedef ^ FAST_ModuleMapType MeshMapType AD_L_2_BDED_B {:} - - "Map AeroDyn14 InputMarkers or AeroDyn BladeLoad line2 meshes to ElastoDyn BladePtLoad point meshes or BeamDyn BldMotion line2 meshes" typedef ^ FAST_ModuleMapType MeshMapType BD_L_2_BD_L {:} - - "Map BeamDyn BldMotion output meshes to locations on the BD input DistrLoad mesh stored in MeshMapType%y_BD_BldMotion_4Loads (BD input and output meshes are not siblings and in fact have nodes at different locations" +typedef ^ FAST_ModuleMapType MeshMapType SED_P_2_AD_L_B {:} - - "Map Simplified-ElastoDyn BladeRoot point meshes to rigid AeroDyn BladeMotion line2 meshes" +typedef ^ FAST_ModuleMapType MeshMapType SED_P_2_AD_P_R {:} - - "Map Simplified-ElastoDyn BladeRootMotion point meshes to AeroDyn BladeRootMotion point meshes" +typedef ^ FAST_ModuleMapType MeshMapType AD_L_2_SED_P {:} - - "Map AeroDyn blade load output mesh to Simplified-ElastoDyn Hub point mesh" # ED <-> AD (nacelle, tower, hub, blade root, tailfin) typedef ^ FAST_ModuleMapType MeshMapType ED_P_2_AD_P_N - - - "Map ElastoDyn Nacelle point motion mesh to AeroDyn Nacelle point motion mesh" typedef ^ FAST_ModuleMapType MeshMapType AD_P_2_ED_P_N - - - "Map AeroDyn Nacelle point load mesh to ElastoDyn nacelle point load mesh" @@ -632,7 +742,27 @@ typedef ^ FAST_ModuleMapType MeshMapType ED_L_2_AD_L_T - - - "Map ElastoDyn Towe typedef ^ FAST_ModuleMapType MeshMapType AD_L_2_ED_P_T - - - "Map AeroDyn14 Twr_InputMarkers or AeroDyn TowerLoad line2 mesh to ElastoDyn TowerPtLoads point mesh" typedef ^ FAST_ModuleMapType MeshMapType ED_P_2_AD_P_R {:} - - "Map ElastoDyn BladeRootMotion point meshes to AeroDyn BladeRootMotion point meshes" typedef ^ FAST_ModuleMapType MeshMapType ED_P_2_AD_P_H - - - "Map ElastoDyn HubPtMotion point mesh to AeroDyn HubMotion point mesh" +# ED <-> ADsk (hub) +typedef ^ FAST_ModuleMapType MeshMapType ADsk_P_2_ED_P_H - - - "Map AeroDisk point load mesh to ElastoDyn hub point load mesh" +typedef ^ FAST_ModuleMapType MeshMapType ED_P_2_ADsk_P_H - - - "Map ElastoDyn HubPtMotion point mesh to AeroDisk HubMotion point mesh" +# SED <-> AD (nacelle, tower, hub, blade root) +typedef ^ FAST_ModuleMapType MeshMapType SED_P_2_AD_P_N - - - "Map Simplified-ElastoDyn Nacelle point motion mesh to AeroDyn Nacelle point motion mesh" +typedef ^ FAST_ModuleMapType MeshMapType SED_L_2_AD_L_T - - - "Map Simplified-ElastoDyn TowerLn2Mesh line2 mesh to AeroDyn TowerMotion line2 mesh" +typedef ^ FAST_ModuleMapType MeshMapType SED_P_2_AD_P_H - - - "Map Simplified-ElastoDyn HubPtMotion point mesh to AeroDyn HubMotion point mesh" +# SED <-> ADsk (hub) +typedef ^ FAST_ModuleMapType MeshMapType ADsk_P_2_SED_P_H - - - "Map AeroDisk point load mesh to Simplfied-ElastoDyn hub point load mesh" +typedef ^ FAST_ModuleMapType MeshMapType SED_P_2_ADsk_P_H - - - "Map Simplified-ElastoDyn HubPtMotion point mesh to AeroDisk HubMotion point mesh" typedef ^ FAST_ModuleMapType MeshMapType AD_P_2_ED_P_H - - - "Map AeroDyn HubLoad point mesh to ElastoDyn HubPtLoad point mesh" +# ED/BD <-> ExtLd (blades) +typedef ^ FAST_ModuleMapType MeshMapType BDED_L_2_ExtLd_P_B {:} - - "Map ElastoDyn/BeamDyn BladeLn2Mesh point meshes OR BeamDyn BldMotion line2 meshes to ExtLoads point meshes" +typedef ^ FAST_ModuleMapType MeshMapType ExtLd_P_2_BDED_B {:} - - "Map ExtLoads at points to ElastoDyn BladePtLoad point meshes or BeamDyn BldMotion line2 meshes" +# ED <-> ExtLd (tower, hub, blade root) +typedef ^ FAST_ModuleMapType MeshMapType ED_L_2_ExtLd_P_T - - - "Map ElastoDyn TowerLn2Mesh line2 mesh to ExtLoads point mesh" +typedef ^ FAST_ModuleMapType MeshMapType ExtLd_P_2_ED_P_T - - - "Map ExtLoads TowerLoad point mesh to ElastoDyn TowerPtLoads point mesh" +typedef ^ FAST_ModuleMapType MeshMapType ED_P_2_ExtLd_P_R {:} - - "Map ElastoDyn BladeRootMotion point meshes to ExtLoads BladeRootMotion point meshes" +typedef ^ FAST_ModuleMapType MeshMapType ED_P_2_ExtLd_P_H - - - "Map ElastoDyn HubPtMotion point mesh to ExtLoads HubMotion point mesh" +typedef ^ FAST_ModuleMapType MeshMapType AD_L_2_ExtLd_B {:} - - "Map AeroDyn line loads on blades to ExtLoads point loads" +typedef ^ FAST_ModuleMapType MeshMapType AD_L_2_ExtLd_T - - - "Map AeroDyn line loads on tower to ExtKoads point loads" # IceF <-> SD typedef ^ FAST_ModuleMapType MeshMapType IceF_P_2_SD_P - - - "Map IceFloe point mesh to SubDyn LMesh point mesh" typedef ^ FAST_ModuleMapType MeshMapType SDy3_P_2_IceF_P - - - "Map SubDyn y3Mesh point mesh to IceFloe point mesh" @@ -645,15 +775,14 @@ typedef ^ FAST_ModuleMapType Integer Jacobian_pivot {:} - - "Pivot array used fo typedef ^ FAST_ModuleMapType Integer Jac_u_indx {:}{:} - - "matrix to help fill/pack the u vector in computing the jacobian" # Temporary copies of input meshes (stored here so we don't have to keep allocating/destroying them) typedef ^ FAST_ModuleMapType MeshType u_ED_NacelleLoads - - - "copy of ED input mesh" -typedef ^ FAST_ModuleMapType MeshType u_ED_PlatformPtMesh - - - "copy of ED input mesh" -typedef ^ FAST_ModuleMapType MeshType u_ED_PlatformPtMesh_2 - - - "copy of ED input mesh (used only for temporary storage)" -typedef ^ FAST_ModuleMapType MeshType u_ED_PlatformPtMesh_3 - - - "copy of ED input mesh (used only for temporary storage)" -typedef ^ FAST_ModuleMapType MeshType u_ED_PlatformPtMesh_MDf - - - "copy of ED input mesh used to store loads from farm-level MD" +typedef ^ FAST_ModuleMapType MeshType SubstructureLoads_Tmp - - - "copy of substructure loads input mesh (ED or SD)" +typedef ^ FAST_ModuleMapType MeshType SubstructureLoads_Tmp2 - - - "copy of substructure loads input mesh (ED or SD, used only for temporary storage)" +typedef ^ FAST_ModuleMapType MeshType PlatformLoads_Tmp - - - "copy of platform loads input mesh (ED)" +typedef ^ FAST_ModuleMapType MeshType PlatformLoads_Tmp2 - - - "copy of platform loads input mesh (ED, used only for temporary storage)" +typedef ^ FAST_ModuleMapType MeshType SubstructureLoads_Tmp_Farm - - - "copy of substructure mesh used to store loads from farm-level MD" typedef ^ FAST_ModuleMapType MeshType u_ED_TowerPtloads - - - "copy of ED input mesh" typedef ^ FAST_ModuleMapType MeshType u_ED_BladePtLoads {:} - - "copy of ED input mesh" typedef ^ FAST_ModuleMapType MeshType u_SD_TPMesh - - - "copy of SD input mesh" -typedef ^ FAST_ModuleMapType MeshType u_SD_LMesh - - - "copy of SD input mesh" -typedef ^ FAST_ModuleMapType MeshType u_SD_LMesh_2 - - - "copy of SD input mesh (used only for temporary storage)" #typedef ^ FAST_ModuleMapType MeshType u_HD_M_LumpedMesh - - - "copy of HD input mesh" typedef ^ FAST_ModuleMapType MeshType u_HD_M_Mesh - - - "copy of HD morison input mesh" typedef ^ FAST_ModuleMapType MeshType u_HD_W_Mesh - - - "copy of HD wamit input mesh" @@ -665,7 +794,11 @@ typedef ^ FAST_ModuleMapType MeshType y_BD_BldMotion_4Loads {:} - - "BD blade mo typedef ^ FAST_ModuleMapType MeshType u_BD_Distrload {:} - - "copy of BD DistrLoad input meshes" typedef ^ FAST_ModuleMapType MeshType u_Orca_PtfmMesh - - - "copy of Orca PtfmMesh input mesh" typedef ^ FAST_ModuleMapType MeshType u_ExtPtfm_PtfmMesh - - - "copy of ExtPtfm_MCKF PtfmMesh input mesh" +typedef ^ FAST_ModuleMapType MeshType u_SED_HubPtLoad - - - "copy of SED input mesh" #typedef ^ FAST_ModuleMapType MeshType u_FarmMD_CoupledLoads - - - "FAST-internal copy of MoorDyn's CoupledLoads output mesh for use with shared moorings in FAST.Farm" +# for steady-state solve (convert 1 blade to all blades) +typedef ^ FAST_ModuleMapType R8Ki HubOrient {:}{:}{:} - - "Orientation matrix to translate results from blade 1 to remaining blades in aeromaps" "(-)" + # ..... FAST_ExternalInput data ....................................................................................................... typedef FAST FAST_ExternInputType ReKi GenTrq - - - "generator torque input from Simulink/Labview" typedef ^ FAST_ExternInputType ReKi ElecPwr - - - "electric power input from Simulink/Labview" @@ -696,18 +829,24 @@ typedef ^ FAST_MiscVarType FAST_MiscLinType Lin - - - "misc data for linearizati # ..... FAST_InitData data ....................................................................................................... typedef ^ FAST_InitData ED_InitInputType InData_ED - - - "ED Initialization input data" typedef ^ FAST_InitData ED_InitOutputType OutData_ED - - - "ED Initialization output data" +typedef ^ FAST_InitData SED_InitInputType InData_SED - - - "SED Initialization input data" +typedef ^ FAST_InitData SED_InitOutputType OutData_SED - - - "SED Initialization output data" typedef ^ FAST_InitData BD_InitInputType InData_BD - - - "BD Initialization input data" typedef ^ FAST_InitData BD_InitOutputType OutData_BD : - - "BD Initialization output data" typedef ^ FAST_InitData SrvD_InitInputType InData_SrvD - - - "SrvD Initialization input data" typedef ^ FAST_InitData SrvD_InitOutputType OutData_SrvD - - - "SrvD Initialization output data" -typedef ^ FAST_InitData AD14_InitInputType InData_AD14 - - - "AD14 Initialization input data" -typedef ^ FAST_InitData AD14_InitOutputType OutData_AD14 - - - "AD14 Initialization output data" typedef ^ FAST_InitData AD_InitInputType InData_AD - - - "AD Initialization input data" typedef ^ FAST_InitData AD_InitOutputType OutData_AD - - - "AD Initialization output data" +typedef ^ FAST_InitData ADsk_InitInputType InData_ADsk - - - "ADsk Initialization input data" +typedef ^ FAST_InitData ADsk_InitOutputType OutData_ADsk - - - "ADsk Initialization output data" +typedef ^ FAST_InitData ExtLd_InitInputType InData_ExtLd - - - "ExtLd Initialization input data" +typedef ^ FAST_InitData ExtLd_InitOutputType OutData_ExtLd - - - "ExtLd Initialization output data" typedef ^ FAST_InitData InflowWind_InitInputType InData_IfW - - - "IfW Initialization input data" typedef ^ FAST_InitData InflowWind_InitOutputType OutData_IfW - - - "IfW Initialization output data" -typedef ^ FAST_InitData OpFM_InitInputType InData_OpFM - - - "OpFM Initialization input data" -typedef ^ FAST_InitData OpFM_InitOutputType OutData_OpFM - - - "OpFM Initialization output data" +typedef ^ FAST_InitData ExtInfw_InitInputType InData_ExtInfw - - - "ExtInfw Initialization input data" +typedef ^ FAST_InitData ExtInfw_InitOutputType OutData_ExtInfw - - - "ExtInfw Initialization output data" +typedef ^ FAST_InitData SeaSt_InitInputType InData_SeaSt - - - "SeaSt Initialization input data" +typedef ^ FAST_InitData SeaSt_InitOutputType OutData_SeaSt - - - "SeaSt Initialization output data" typedef ^ FAST_InitData HydroDyn_InitInputType InData_HD - - - "HD Initialization input data" typedef ^ FAST_InitData HydroDyn_InitOutputType OutData_HD - - - "HD Initialization output data" typedef ^ FAST_InitData SD_InitInputType InData_SD - - - "SD Initialization input data" @@ -730,8 +869,6 @@ typedef ^ FAST_InitData IceD_InitOutputType OutData_IceD - - # ..... FAST External Initialization Input data ....................................................................................................... typedef ^ FAST_ExternInitType DbKi Tmax - -1 - "External code specified Tmax" s -typedef ^ FAST_ExternInitType IntKi SensorType - SensorType_None - "lidar sensor type, which should not be pulsed at the moment; this input should be replaced with a section in the InflowWind input file" - -typedef ^ FAST_ExternInitType LOGICAL LidRadialVel - - - "TRUE => return radial component, FALSE => return 'x' direction estimate" - typedef ^ FAST_ExternInitType IntKi TurbIDforName - -1 - "ID number for turbine (used to create output file naming convention)" - typedef ^ FAST_ExternInitType ReKi TurbinePos {3} - - "Initial position of turbine base (origin used for graphics or in FAST.Farm)" m typedef ^ FAST_ExternInitType IntKi WaveFieldMod - - - "Wave field handling (-) (switch) 0: use individual HydroDyn inputs without adjustment, 1: adjust wave phases based on turbine offsets from farm origin" - @@ -744,10 +881,15 @@ typedef ^ FAST_ExternInitType logical FarmIntegration - .false. - "whether this typedef ^ FAST_ExternInitType IntKi windGrid_n 4 - - "number of grid points in the x, y, z, and t directions for IfW" - typedef ^ FAST_ExternInitType ReKi windGrid_delta 4 - - "size between 2 consecutive grid points in each grid direction for IfW" "m,m,m,s" typedef ^ FAST_ExternInitType ReKi windGrid_pZero 3 - - "fixed position of the XYZ grid (i.e., XYZ coordinates of IfW m%V(:,1,1,1,:))" m +typedef ^ FAST_ExternInitType SiKi *windGrid_data ::::: - - "Pointers to Wind velocity of disturbed wind (ambient + wakes) across each high-resolution domain around a turbine for each high-resolution step within a low-resolution step" m/s typedef ^ FAST_ExternInitType CHARACTER(1024) RootName - - - "Root name of FAST output files (overrides normal operation)" - typedef ^ FAST_ExternInitType IntKi NumActForcePtsBlade - - - "number of actuator line force points in blade" - typedef ^ FAST_ExternInitType IntKi NumActForcePtsTower - - - "number of actuator line force points in tower" - -typedef ^ FAST_ExternInitType IntKi NodeClusterType - - - "Node clustering for actuator line (0 - Uniform, 1 - Non-uniform clustered towards tip)" - +typedef ^ FAST_ExternInitType IntKi NodeClusterType - - - "Node clustering for actuator line (0 - Uniform, 1 - Non-uniform clustered towards tip)" - +typedef ^ FAST_ExternInitType DbKi DTdriver - -1 - "External driver time step" s +typedef ^ FAST_ExternInitType Logical TwrAero - .false. - "Is Tower aerodynamics enabled for ExtLoads module?" +typedef ^ FAST_ExternInitType ReKi az_blend_mean - - - "Mean azimuth at which to blend the external and aerodyn loads" - +typedef ^ FAST_ExternInitType ReKi az_blend_delta - - - "Mean azimuth at which to blend the external and aerodyn loads" - # ..... FAST Turbine Data (one realization) ....................................................................................................... typedef ^ FAST_TurbineType IntKi TurbID - 1 - "Turbine ID Number" - @@ -756,13 +898,16 @@ typedef ^ FAST_TurbineType FAST_OutputFileType y_FAST - - - "Output variables fo typedef ^ FAST_TurbineType FAST_MiscVarType m_FAST - - - "Miscellaneous variables" - typedef ^ FAST_TurbineType FAST_ModuleMapType MeshMapData - - - "Data for mapping between modules" - typedef ^ FAST_TurbineType ElastoDyn_Data ED - - - "Data for the ElastoDyn module" - +typedef ^ FAST_TurbineType SED_Data SED - - - "Data for the Simplified-ElastoDyn module" - typedef ^ FAST_TurbineType BeamDyn_Data BD - - - "Data for the BeamDyn module" - typedef ^ FAST_TurbineType ServoDyn_Data SrvD - - - "Data for the ServoDyn module" - typedef ^ FAST_TurbineType AeroDyn_Data AD - - - "Data for the AeroDyn module" - -typedef ^ FAST_TurbineType AeroDyn14_Data AD14 - - - "Data for the AeroDyn14 module" - +typedef ^ FAST_TurbineType AeroDisk_Data ADsk - - - "Data for the AeroDisk module" - +typedef ^ FAST_TurbineType ExtLoads_Data ExtLd - - - "Data for the External loads module" - typedef ^ FAST_TurbineType InflowWind_Data IfW - - - "Data for InflowWind module" - -typedef ^ FAST_TurbineType OpenFOAM_Data OpFM - - - "Data for OpenFOAM integration module" - +typedef ^ FAST_TurbineType ExternalInflow_Data ExtInfw - - - "Data for ExternalInflow integration module" - typedef ^ FAST_TurbineType SCDataEx_Data SC_DX - - - "Data for SuperController integration module" - +typedef ^ FAST_TurbineType SeaState_Data SeaSt - - - "Data for the SeaState module" - typedef ^ FAST_TurbineType HydroDyn_Data HD - - - "Data for the HydroDyn module" - typedef ^ FAST_TurbineType SubDyn_Data SD - - - "Data for the SubDyn module" - typedef ^ FAST_TurbineType MAP_Data MAP - - - "Data for the MAP (Mooring Analysis Program) module" - diff --git a/modules/openfast-library/src/FAST_SS_Solver.f90 b/modules/openfast-library/src/FAST_SS_Solver.f90 new file mode 100644 index 0000000000..f4ea398e61 --- /dev/null +++ b/modules/openfast-library/src/FAST_SS_Solver.f90 @@ -0,0 +1,2169 @@ +!********************************************************************************************************************************** +! LICENSING +! Copyright (C) 2020 Envision Energy USA, National Renewable Energy Laboratory +! +! This file is part of FAST. +! +! 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 the routines used by FAST to solve input-output equations and to advance states. +MODULE FAST_SS_Solver + + USE FAST_SOLVER + USE FAST_Linear + USE FAST_Subs + USE BeamDyn_Subs, ONLY: BD_CrvMatrixR, BD_CrvExtractCrv + + IMPLICIT NONE + + REAL(DbKi), PARAMETER :: SS_t_global = 0.0_DbKi + REAL(DbKi), PARAMETER :: UJacSclFact_x = 1.0d3 + + LOGICAL, PARAMETER :: output_debugging = .false. + +CONTAINS +!---------------------------------------------------------------------------------------------------------------------------------- +SUBROUTINE SteadyStateCCSD( caseData, p_FAST, y_FAST, m_FAST, ED, BD, InputIndex, ErrStat, ErrMsg ) + + TYPE(FAST_SS_CaseType) , INTENT(IN ) :: caseData !< tsr, windSpeed, pitch, and rotor speed for this case + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code + TYPE(FAST_OutputFileType), INTENT(INOUT) :: y_FAST !< Output variables for the glue code + TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables + + TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data + TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data + INTEGER(IntKi), INTENT(IN ) :: InputIndex !< Index into input array + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message + + INTEGER(IntKi) :: i + INTEGER(IntKi) :: k + INTEGER(IntKi) :: BldMeshNode + INTEGER(IntKi) :: ErrStat2 ! temporary Error status of the operation + CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None + CHARACTER(*), PARAMETER :: RoutineName = 'SteadyStateCCSD' + REAL(R8Ki) :: Omega_Hub(3) + REAL(R8Ki) :: position(3) + REAL(R8Ki) :: omega_cross_position(3) + + ErrStat = ErrID_None + ErrMsg = "" + + IF (p_FAST%CompElast == Module_ED) THEN + CALL ED_CalcContStateDeriv( SS_t_global, ED%Input(InputIndex), ED%p, ED%x(STATE_CURR), ED%xd(STATE_CURR), ED%z(STATE_CURR), & + ED%OtherSt(STATE_CURR), ED%m, ED%x(STATE_PRED), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + ELSEIF (p_FAST%CompElast == Module_BD) THEN + Omega_Hub(1) = caseData%RotSpeed + Omega_Hub(2:3) = 0.0_R8Ki + + DO K = 1,p_FAST%nBeams + CALL BD_CalcContStateDeriv( SS_t_global, BD%Input(InputIndex,k), BD%p(k), BD%x(k,STATE_CURR), BD%xd(k,STATE_CURR), BD%z(k,STATE_CURR), & + BD%OtherSt(k,STATE_CURR), BD%m(k), BD%x(k,STATE_PRED), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + ! subtract xdot(y) here: + ! note that this only works when the BldMotion mesh is on the FE nodes + do i=2,BD%p(k)%node_total ! the first node isn't technically a state + BldMeshNode = BD%p(k)%NdIndx(i) + position = BD%y(k)%BldMotion%Position(:,BldMeshNode) + BD%y(k)%BldMotion%TranslationDisp(:,BldMeshNode) + omega_cross_position = cross_product( Omega_Hub, position ) + + BD%x(k, STATE_PRED)%q( 1:3,i) = BD%x(k, STATE_PRED)%q( 1:3,i) - omega_cross_position + BD%x(k, STATE_PRED)%q( 4:6,i) = BD%x(k, STATE_PRED)%q( 4:6,i) - Omega_Hub + BD%x(k, STATE_PRED)%dqdt( 1:3,i) = BD%x(k, STATE_PRED)%dqdt( 1:3,i) - cross_product( Omega_Hub, omega_cross_position ) + end do + + END DO + END IF + +END SUBROUTINE SteadyStateCCSD +!---------------------------------------------------------------------------------------------------------------------------------- +SUBROUTINE SteadyStateCalculatedInputs( p_FAST, y_FAST, m_FAST, ED, BD, AD, MeshMapData, InputIndex, ErrStat, ErrMsg ) + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code + TYPE(FAST_OutputFileType), INTENT(INOUT) :: y_FAST !< Output variables for the glue code + TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables + + TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data + TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data + TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data + TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules + INTEGER(IntKi), INTENT(IN ) :: InputIndex !< Index into input array + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message + + INTEGER(IntKi) :: ErrStat2 ! temporary Error status of the operation + CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None + CHARACTER(*), PARAMETER :: RoutineName = 'SteadyStateCalculatedInputs' + + ErrStat = ErrID_None + ErrMsg = "" + + ! transfer the motions first: + CALL SS_AD_InputSolve( p_FAST, AD%Input(InputIndex), ED%y, BD, MeshMapData, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + ! transfer the loads next: + IF (p_FAST%CompElast == Module_ED) THEN + CALL SS_ED_InputSolve( p_FAST, ED%Input(InputIndex), ED%y, AD%y, AD%Input(InputIndex), MeshMapData, ErrStat2, ErrMsg2 ) + + ELSEIF (p_FAST%CompElast == Module_BD) THEN + CALL SS_BD_InputSolve( p_FAST, BD, AD%y, AD%Input(InputIndex), MeshMapData, InputIndex, ErrStat2, ErrMsg2 ) + END IF + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + +END SUBROUTINE SteadyStateCalculatedInputs +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine sets the blade load inputs required for BD. +SUBROUTINE SS_BD_InputSolve( p_FAST, BD, y_AD, u_AD, MeshMapData, InputIndex, ErrStat, ErrMsg ) +!.................................................................................................................................. + + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Glue-code simulation parameters + TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BD Inputs at t + TYPE(AD_OutputType), INTENT(IN ) :: y_AD !< AeroDyn outputs + TYPE(AD_InputType), INTENT(IN ) :: u_AD !< AD inputs (for AD-BD load transfer) + + TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules + INTEGER(IntKi), INTENT(IN ) :: InputIndex !< Index into input array + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message + + ! local variables + INTEGER(IntKi) :: K ! Loops through blades + INTEGER(IntKi) :: ErrStat2 ! temporary Error status of the operation + CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None + CHARACTER(*), PARAMETER :: RoutineName = 'SS_BD_InputSolve' + + ! Initialize error status + + ErrStat = ErrID_None + ErrMsg = "" + + + ! BD inputs on blade from AeroDyn + + if (p_FAST%BD_OutputSibling) then + + DO K = 1, p_FAST%NumBl_Lin ! we don't need all blades here: p_FAST%nBeams ! Loop through all blades + + CALL Transfer_Line2_to_Line2( y_AD%rotors(1)%BladeLoad(k), BD%Input(InputIndex,k)%DistrLoad, MeshMapData%AD_L_2_BDED_B(k), ErrStat2, ErrMsg2, u_AD%rotors(1)%BladeMotion(k), BD%y(k)%BldMotion ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + END DO + + else + DO K = 1, p_FAST%NumBl_Lin ! we don't need all blades here: p_FAST%nBeams ! Loop through all blades + + ! need to transfer the BD output blade motions to nodes on a sibling of the BD blade motion mesh: + CALL Transfer_Line2_to_Line2( BD%y(k)%BldMotion, MeshMapData%y_BD_BldMotion_4Loads(k), MeshMapData%BD_L_2_BD_L(k), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + CALL Transfer_Line2_to_Line2( y_AD%rotors(1)%BladeLoad(k), BD%Input(InputIndex,k)%DistrLoad, MeshMapData%AD_L_2_BDED_B(k), ErrStat2, ErrMsg2, u_AD%rotors(1)%BladeMotion(k), MeshMapData%y_BD_BldMotion_4Loads(k) ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + END DO + end if + + + +END SUBROUTINE SS_BD_InputSolve +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine sets the blade-load ElastoDyn inputs from blade 1 to the other blades. +SUBROUTINE SS_BD_InputSolve_OtherBlades( p_FAST, BD, MeshMapData, InputIndex ) + + ! Passed variables + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< FAST parameter data + TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BD Inputs at t + + TYPE(FAST_ModuleMapType), INTENT(IN ) :: MeshMapData !< Data for mapping between modules + INTEGER(IntKi), INTENT(IN ) :: InputIndex !< Index into input array + + ! Local variables: + + INTEGER(IntKi) :: K ! Loops through blades + INTEGER(IntKi) :: J ! Loops through nodes + + + DO k = p_FAST%NumBl_Lin+1,p_FAST%nBeams + DO j=1,BD%Input(InputIndex,k)%DistrLoad%NNodes + BD%Input(InputIndex,k)%DistrLoad%Force( :,j) = MATMUL(BD%Input(InputIndex,1)%DistrLoad%Force( :,j), MeshMapData%HubOrient(:,:,k) ) + BD%Input(InputIndex,k)%DistrLoad%Moment(:,j) = MATMUL(BD%Input(InputIndex,1)%DistrLoad%Moment(:,j), MeshMapData%HubOrient(:,:,k) ) + END DO + END DO + +END SUBROUTINE SS_BD_InputSolve_OtherBlades + +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine sets the blade load inputs required for ED. +SUBROUTINE SS_ED_InputSolve( p_FAST, u_ED, y_ED, y_AD, u_AD, MeshMapData, ErrStat, ErrMsg ) +!.................................................................................................................................. + + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Glue-code simulation parameters + TYPE(ED_InputType), INTENT(INOUT) :: u_ED !< ED Inputs at t + TYPE(ED_OutputType), INTENT(IN ) :: y_ED !< ElastoDyn outputs (need translation displacement on meshes for loads mapping) + TYPE(AD_OutputType), INTENT(IN ) :: y_AD !< AeroDyn outputs + TYPE(AD_InputType), INTENT(IN ) :: u_AD !< AD inputs (for AD-ED load transfer) + + TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message + + ! local variables + + INTEGER(IntKi) :: K ! Loops through blades + INTEGER(IntKi) :: ErrStat2 ! temporary Error status of the operation + CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None + CHARACTER(*), PARAMETER :: RoutineName = 'SS_ED_InputSolve' + + + ! Initialize error status + + ErrStat = ErrID_None + ErrMsg = "" + + ! ED inputs on blade from AeroDyn + + DO K = 1, p_FAST%NumBl_Lin !we don't need all blades here: SIZE(u_ED%BladePtLoads,1) ! Loop through all blades (p_ED%NumBl) + CALL Transfer_Line2_to_Point( y_AD%rotors(1)%BladeLoad(k), u_ED%BladePtLoads(k), MeshMapData%AD_L_2_BDED_B(k), ErrStat2, ErrMsg2, u_AD%rotors(1)%BladeMotion(k), y_ED%BladeLn2Mesh(k) ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + END DO + +END SUBROUTINE SS_ED_InputSolve +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine sets the blade-load ElastoDyn inputs from blade 1 to the other blades. +SUBROUTINE SS_ED_InputSolve_OtherBlades( p_FAST, u_ED, MeshMapData ) + + ! Passed variables + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< FAST parameter data + TYPE(ED_InputType), INTENT(INOUT) :: u_ED !< ED Inputs at t + TYPE(FAST_ModuleMapType), INTENT(IN ) :: MeshMapData !< Data for mapping between modules + + ! Local variables: + + INTEGER(IntKi) :: K ! Loops through blades + INTEGER(IntKi) :: J ! Loops through nodes + + + DO k = p_FAST%NumBl_Lin+1,size(u_ED%BladePtLoads,1) + DO j=1,u_ED%BladePtLoads(k)%NNodes + u_ED%BladePtLoads(k)%Force( :,j) = MATMUL(u_ED%BladePtLoads(1)%Force( :,j), MeshMapData%HubOrient(:,:,k) ) + u_ED%BladePtLoads(k)%Moment(:,j) = MATMUL(u_ED%BladePtLoads(1)%Moment(:,j), MeshMapData%HubOrient(:,:,k) ) + END DO + END DO + +END SUBROUTINE SS_ED_InputSolve_OtherBlades + +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine sets the blade-motion AeroDyn inputs. +SUBROUTINE SS_AD_InputSolve( p_FAST, u_AD, y_ED, BD, MeshMapData, ErrStat, ErrMsg ) + + ! Passed variables + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< FAST parameter data + TYPE(AD_InputType), INTENT(INOUT) :: u_AD !< The inputs to AeroDyn14 + TYPE(ED_OutputType), INTENT(IN) :: y_ED !< The outputs from the structural dynamics module + TYPE(BeamDyn_Data), INTENT(IN) :: BD !< The data from BeamDyn (want the outputs only, but it's in an array) + TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules + + INTEGER(IntKi) :: ErrStat !< Error status of the operation + CHARACTER(*) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + ! Local variables: + + INTEGER(IntKi) :: K ! Loops through blades + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SS_AD_InputSolve' + + + ErrStat = ErrID_None + ErrMsg = "" + + !------------------------------------------------------------------------------------------------- + ! Set the inputs from structure: + !------------------------------------------------------------------------------------------------- + IF (p_FAST%CompElast == Module_ED ) THEN + + DO k=1,p_FAST%NumBl_Lin !we don't need all blades here: size(y_ED%BladeLn2Mesh) + CALL Transfer_Line2_to_Line2( y_ED%BladeLn2Mesh(k), u_AD%rotors(1)%BladeMotion(k), MeshMapData%BDED_L_2_AD_L_B(k), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName//':u_AD%BladeMotion('//trim(num2lstr(k))//')' ) + END DO + + ELSEIF (p_FAST%CompElast == Module_BD ) THEN + + ! get them from BeamDyn + DO k=1,p_FAST%NumBl_Lin !we don't need all blades here: size(u_AD%BladeMotion) + CALL Transfer_Line2_to_Line2( BD%y(k)%BldMotion, u_AD%rotors(1)%BladeMotion(k), MeshMapData%BDED_L_2_AD_L_B(k), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName//':u_AD%BladeMotion('//trim(num2lstr(k))//')' ) + END DO + + END IF + + ! make sure these are the prescribed values: + DO k = 1,p_FAST%NumBl_Lin !we don't need all blades here: size(u_AD%BladeMotion,1) + u_AD%rotors(1)%BladeMotion(k)%RotationVel = 0.0_ReKi + u_AD%rotors(1)%BladeMotion(k)%TranslationAcc = 0.0_ReKi + END DO + + +END SUBROUTINE SS_AD_InputSolve +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine sets the blade-motion AeroDyn inputs. +SUBROUTINE SS_AD_InputSolve_OtherBlades( p_FAST, u_AD, MeshMapData ) + + ! Passed variables + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< FAST parameter data + TYPE(AD_InputType), INTENT(INOUT) :: u_AD !< The inputs to AeroDyn14 + TYPE(FAST_ModuleMapType), INTENT(IN ) :: MeshMapData !< Data for mapping between modules + + ! Local variables: + + INTEGER(IntKi) :: K ! Loops through blades + INTEGER(IntKi) :: J ! Loops through nodes + + + DO k = p_FAST%NumBl_Lin+1,size(u_AD%rotors(1)%BladeMotion,1) + DO j=1,u_AD%rotors(1)%BladeMotion(k)%NNodes + u_AD%rotors(1)%BladeMotion(k)%TranslationDisp(:,j) = MATMUL( u_AD%rotors(1)%BladeMotion(1)%TranslationDisp(:,j), MeshMapData%HubOrient(:,:,k) ) + u_AD%rotors(1)%BladeMotion(k)%Orientation( :,:,j) = MATMUL( u_AD%rotors(1)%BladeMotion(1)%Orientation( :,:,j), MeshMapData%HubOrient(:,:,k) ) + u_AD%rotors(1)%BladeMotion(k)%TranslationVel( :,j) = MATMUL( u_AD%rotors(1)%BladeMotion(1)%TranslationVel( :,j), MeshMapData%HubOrient(:,:,k) ) + END DO + END DO + +END SUBROUTINE SS_AD_InputSolve_OtherBlades + +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine performs the Input-Output solve for the steady-state solver. +!! Note that this has been customized for the physics in the problems and is not a general solution. +SUBROUTINE SolveSteadyState( caseData, Jmat, p_FAST, y_FAST, m_FAST, ED, BD, AD, MeshMapData , ErrStat, ErrMsg ) +!.................................................................................................................................. + + ! Passed variables + TYPE(FAST_SS_CaseType) , INTENT(IN ) :: caseData !< tsr, windSpeed, pitch, and rotor speed for this case + REAL(R8Ki), INTENT(INOUT) :: Jmat(:,:) !< temporary storage space for jacobian matrix + + TYPE(FAST_ParameterType) , INTENT(IN ) :: p_FAST !< Glue-code simulation parameters + TYPE(FAST_OutputFileType) , INTENT(INOUT) :: y_FAST !< Glue-code output file values + TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables + TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data + TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data + TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data + + TYPE(FAST_ModuleMapType) , INTENT(INOUT) :: MeshMapData !< data for mapping meshes between modules + 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 = 'SolveSteadyState' + +!bjj: store these so that we don't reallocate every time? + REAL(R8Ki) :: u( p_FAST%SizeJac_Opt1(1)) ! size of loads/accelerations passed between the 6 modules + REAL(R8Ki) :: u_delta( p_FAST%SizeJac_Opt1(1)) ! size of loads/accelerations passed between the 6 modules + REAL(R8Ki) :: Fn_U_Resid( p_FAST%SizeJac_Opt1(1)) ! Residual of U + REAL(R8Ki) :: err + REAL(R8Ki) :: err_prev + REAL(R8Ki), PARAMETER :: reduction_factor = 0.1_R8Ki + + INTEGER(IntKi) :: nb ! loop counter (blade number) + INTEGER(IntKi) :: MaxIter ! maximum number of iterations + INTEGER(IntKi) :: K ! Input-output-solve iteration counter + INTEGER(IntKi) :: ErrStat2 ! temporary Error status of the operation + CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None + + LOGICAL :: GetWriteOutput ! flag to determine if we need WriteOutputs from this call to CalcOutput + + ! Note: p_FAST%UJacSclFact is a scaling factor that gets us similar magnitudes between loads and accelerations... + +!bjj: note, that this routine may have a problem if there is remapping done + + ErrStat = ErrID_None + ErrMsg = "" + !---------------------------------------------------------------------------------------------------- + ! Some record keeping stuff: + !---------------------------------------------------------------------------------------------------- + + CALL SteadyStateUpdateStates( caseData, p_FAST, ED, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + CALL SteadyStatePrescribedInputs( caseData, p_FAST, y_FAST, m_FAST, ED, BD, AD ) + CALL CopyStatesInputs( p_FAST, ED, BD, AD, ErrStat2, ErrMsg2, MESH_UPDATECOPY ) ! COPY the inputs to the temp copy (so we get updated input values) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + K = 0 + err = 1.0E3 + err_prev = err + + y_FAST%DriverWriteOutput(SS_Indx_Err) = -1 + y_FAST%DriverWriteOutput(SS_Indx_Iter) = 0 + y_FAST%DriverWriteOutput(SS_Indx_TSR) = caseData%tsr + y_FAST%DriverWriteOutput(SS_Indx_WS) = caseData%windSpeed + y_FAST%DriverWriteOutput(SS_Indx_Pitch) = caseData%Pitch*R2D + y_FAST%DriverWriteOutput(SS_Indx_RotSpeed) = caseData%RotSpeed*RPS2RPM + + MaxIter = p_FAST%KMax + 1 ! adding 1 here so that we get the error calculated correctly when we hit the max iteration + DO + + !------------------------------------------------------------------------------------------------- + ! Calculate outputs, based on inputs at this time + !------------------------------------------------------------------------------------------------- + GetWriteOutput = K > 0 ! we can skip this on the first call (because we always calculate outputs twice) + + IF ( p_FAST%CompElast == Module_ED ) THEN + CALL ED_CalcOutput( SS_t_global, ED%Input(1), ED%p, ED%x(STATE_CURR), ED%xd(STATE_CURR), ED%z(STATE_CURR), ED%OtherSt(STATE_CURR), ED%y, ED%m, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ELSEIF ( p_FAST%CompElast == Module_BD) THEN + do nb=1,p_FAST%nBeams + CALL BD_CalcOutput( SS_t_global, BD%Input(1,nb), BD%p(nb), BD%x(nb, STATE_CURR), BD%xd(nb, STATE_CURR), BD%z(nb, STATE_CURR), BD%OtherSt(nb, STATE_CURR), & + BD%y(nb), BD%m(nb), ErrStat2, ErrMsg2, GetWriteOutput ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + end do + END IF + + IF (K==0) THEN + + ! set the AD input guess based on the structural output (this will ensure that the pitch is accounted for in the fixed aero-map solve:): + CALL SS_AD_InputSolve( p_FAST, AD%Input(1), ED%y, BD, MeshMapData, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL SS_AD_InputSolve_OtherBlades( p_FAST, AD%Input(1), MeshMapData ) ! transfer results from blade 1 to other blades + + !---------------------------------------------------------------------------------------------------- + ! set up x-u vector, using local initial guesses: + !---------------------------------------------------------------------------------------------------- + CALL Create_SS_Vector( p_FAST, y_FAST, u, AD, ED, BD, 1, STATE_CURR ) + + END IF + + CALL AD_CalcOutput(SS_t_global, AD%Input(1), AD%p, AD%x(STATE_CURR), AD%xd(STATE_CURR), AD%z(STATE_CURR), AD%OtherSt(STATE_CURR), AD%y, AD%m, ErrStat2, ErrMsg2, GetWriteOutput ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + IF ( ErrStat >= AbortErrLev ) THEN + call resetInputsAndStates() + RETURN + END IF + + IF (K >= MaxIter) EXIT + + + !------------------------------------------------------------------------------------------------- + ! Calculate residual and the Jacobian: + ! (note that we don't want to change module%Input(1), here) + ! Also, the residual uses values from y_FAST, so do this before calculating the jacobian + !------------------------------------------------------------------------------------------------- + CALL SteadyStateSolve_Residual(caseData, p_FAST, y_FAST, m_FAST, ED, BD, AD, MeshMapData, u, Fn_U_Resid, ErrStat2, ErrMsg2) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + IF ( ErrStat >= AbortErrLev ) THEN + call resetInputsAndStates() + RETURN + END IF + + IF ( mod( K, p_FAST%N_UJac ) == 0 ) THEN + CALL FormSteadyStateJacobian( caseData, Jmat, p_FAST, y_FAST, m_FAST, ED, BD, AD, MeshMapData, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + call Precondition_Jmat(p_FAST, y_FAST, Jmat) + + ! Get the LU decomposition of this matrix using a LAPACK routine: + ! The result is of the form Jmat = P * L * U + + CALL LAPACK_getrf( M=size(Jmat,1), N=size(Jmat,2), & + A=Jmat, IPIV=MeshMapData%Jacobian_pivot, & + ErrStat=ErrStat2, ErrMsg=ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + IF ( ErrStat >= AbortErrLev ) THEN + call resetInputsAndStates() + RETURN + END IF + + END IF + + !------------------------------------------------------------------------------------------------- + ! Solve for delta u: Jac*u_delta = - Fn_U_Resid + ! using the LAPACK routine + !------------------------------------------------------------------------------------------------- + + u_delta = -Fn_U_Resid + CALL LAPACK_getrs( TRANS="N", N=SIZE(Jmat,1), A=Jmat, & + IPIV=MeshMapData%Jacobian_pivot, B=u_delta, ErrStat=ErrStat2, ErrMsg=ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + IF ( ErrStat >= AbortErrLev ) RETURN + + !------------------------------------------------------------------------------------------------- + ! check for error, update inputs if necessary, and iterate again + !------------------------------------------------------------------------------------------------- + err_prev = err + err = DOT_PRODUCT(u_delta, u_delta) + y_FAST%DriverWriteOutput(SS_Indx_Err) = sqrt(err) / p_FAST%SizeJac_Opt1(1) + + IF ( err <= p_FAST%TolerSquared) THEN + IF (K==0) THEN ! the error will be incorrect in this instance, but the outputs will be better + MaxIter = K + ELSE + EXIT + END IF + END IF + + IF (K >= p_FAST%KMax ) EXIT + IF (K > 5 .and. err > 1.0E35) EXIT ! this is obviously not converging. Let's try something else. + + !------------------------------------------------------------------------------------------------- + ! modify inputs and states for next iteration + !------------------------------------------------------------------------------------------------- + if (err > err_prev ) then + u_delta = u_delta * reduction_factor ! don't take a full step if we're getting farther from the solution! + err_prev = err_prev * reduction_factor + end if + + CALL Add_SteadyState_delta( p_FAST, y_FAST, u_delta, AD, ED, BD, MeshMapData ) + + !u = u + u_delta + CALL Create_SS_Vector( p_FAST, y_FAST, u, AD, ED, BD, 1, STATE_CURR ) + + K = K + 1 + y_FAST%DriverWriteOutput(SS_Indx_Iter) = k + + END DO ! K + + IF ( p_FAST%CompElast == Module_BD ) THEN + ! this doesn't actually get the correct hub point load from BD, but we'll get some outputs: + CALL ED_CalcOutput( SS_t_global, ED%Input(1), ED%p, ED%x(STATE_CURR), ED%xd(STATE_CURR), ED%z(STATE_CURR), ED%OtherSt(STATE_CURR), ED%y, ED%m, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END IF + + call resetInputsAndStates() + +contains + subroutine resetInputsAndStates() + + IF ( err > p_FAST%TolerSquared ) THEN + CALL SetErrStat(ErrID_Severe, 'Steady-state solver did not converge.', ErrStat, ErrMsg, RoutineName) + + IF ( err > 100.0 ) THEN + ! if we didn't get close on the solution, we should reset the states and inputs because they very well could + ! lead to numerical issues on the next iteration. Here, set the initial values to 0: + + ! because loads occasionally get very large when it fails, manually set these to zero (otherwise + ! roundoff can lead to non-zero values with the method below, which is most useful for states) + IF( p_FAST%CompElast == Module_BD ) THEN + DO K = 1,p_FAST%nBeams + BD%Input(1,k)%DistrLoad%Force = 0.0_ReKi + BD%Input(1,k)%DistrLoad%Moment = 0.0_ReKi + END DO + + END IF + + CALL Create_SS_Vector( p_FAST, y_FAST, u, AD, ED, BD, 1, STATE_CURR ) ! find the values we have been modifying (in u... continuous states and inputs) + CALL Add_SteadyState_delta( p_FAST, y_FAST, -u, AD, ED, BD, MeshMapData ) ! and reset them to 0 (by adding -u) + + END IF + END IF + end subroutine resetInputsAndStates + +END SUBROUTINE SolveSteadyState +!---------------------------------------------------------------------------------------------------------------------------------- +SUBROUTINE SteadyStateSolve_Residual(caseData, p_FAST, y_FAST, m_FAST, ED, BD, AD, MeshMapData, u_in, u_resid, ErrStat, ErrMsg) + ! Passed variables + TYPE(FAST_SS_CaseType) , INTENT(IN ) :: caseData !< tsr, windSpeed, pitch, and rotor speed for this case + TYPE(FAST_ParameterType) , INTENT(IN ) :: p_FAST !< Glue-code simulation parameters + TYPE(FAST_OutputFileType) , INTENT(INOUT) :: y_FAST !< Glue-code output file values + TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables + TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data + TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data + TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data + + TYPE(FAST_ModuleMapType) , INTENT(INOUT) :: MeshMapData !< data for mapping meshes between modules + REAL( R8Ki ) , INTENT(IN ) :: u_in(:) !< The residual of the array of states and inputs we are trying to solve for + REAL( R8Ki ) , INTENT( OUT) :: u_resid(:) !< The residual of the array of states and inputs we are trying to solve for + INTEGER(IntKi) , INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*) , INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + INTEGER(IntKi) :: ErrStat2 + INTEGER(IntKi) :: Indx_u_start + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SteadyStateSolve_Residual' + + integer, parameter :: InputIndex = 2 + + ErrStat = ErrID_None + ErrMsg = "" + + !note: prescribed inputs are already set in both InputIndex=1 and InputIndex=2 so we can ignore them here + + call SteadyStateCCSD( caseData, p_FAST, y_FAST, m_FAST, ED, BD, 1, ErrStat2, ErrMsg2 ) ! use current inputs and calculate CCSD in STATE_PRED + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ! note that we don't need to calculate the inputs on more than p_FAST%NumBl_Lin blades because we are only using them to compute the Create_SS_Vector + call SteadyStateCalculatedInputs( p_FAST, y_FAST, m_FAST, ED, BD, AD, MeshMapData, InputIndex, ErrStat2, ErrMsg2 ) ! calculate new inputs and store in InputIndex=2 + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + !.................. + ! Pack the output "residual vector" with these state derivatives and new inputs: + !.................. + CALL Create_SS_Vector( p_FAST, y_FAST, U_Resid, AD, ED, BD, InputIndex, STATE_PRED ) + + ! Make the inputs a residual (subtract from previous inputs) + Indx_u_start = y_FAST%Lin%Glue%SizeLin(LIN_ContSTATE_COL) + 1 + U_Resid(Indx_u_start : ) = u_in(Indx_u_start : ) - U_Resid(Indx_u_start : ) + +END SUBROUTINE SteadyStateSolve_Residual +!---------------------------------------------------------------------------------------------------------------------------------- +!> This subroutine saves the current states so they can be used to compute the residual. +SUBROUTINE CopyStatesInputs( p_FAST, ED, BD, AD, ErrStat, ErrMsg, CtrlCode ) + + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code + + TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data + TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data + TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data + + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + INTEGER(IntKi), INTENT(IN ) :: CtrlCode !< mesh copy control code (new, vs update) + + ! local variables + INTEGER(IntKi) :: k ! generic loop counters + + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'CopyStatesInputs' + + + ErrStat = ErrID_None + ErrMsg = "" + + + !---------------------------------------------------------------------------------------- + !! copy the operating point of the states and inputs + !---------------------------------------------------------------------------------------- + + ! ElastoDyn: copy states and inputs + IF ( CtrlCode == MESH_NEWCOPY ) THEN + CALL ED_CopyContState (ED%x( STATE_CURR), ED%x( STATE_PRED), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ED_CopyDiscState (ED%xd(STATE_CURR), ED%xd(STATE_PRED), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ED_CopyConstrState (ED%z( STATE_CURR), ED%z( STATE_PRED), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ED_CopyOtherState (ED%OtherSt( STATE_CURR), ED%OtherSt( STATE_PRED), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END IF + + CALL ED_CopyInput (ED%Input(1), ED%Input(2), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ! BeamDyn: copy states and inputs to OP array + IF ( p_FAST%CompElast == Module_BD ) THEN + + IF ( CtrlCode == MESH_NEWCOPY ) THEN + DO k=1,p_FAST%nBeams + CALL BD_CopyContState (BD%x( k,STATE_CURR),BD%x( k,STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL BD_CopyDiscState (BD%xd(k,STATE_CURR),BD%xd(k,STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL BD_CopyConstrState (BD%z( k,STATE_CURR),BD%z( k,STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL BD_CopyOtherState (BD%OtherSt( k,STATE_CURR),BD%OtherSt( k,STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + END IF + + DO k=1,p_FAST%nBeams + CALL BD_CopyInput (BD%Input(1,k), BD%Input(2,k), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + END IF + + + + ! AeroDyn: copy states and inputs to OP array + IF ( CtrlCode == MESH_NEWCOPY ) THEN + CALL AD_CopyContState (AD%x( STATE_CURR), AD%x( STATE_PRED), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AD_CopyDiscState (AD%xd(STATE_CURR), AD%xd(STATE_PRED), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AD_CopyConstrState (AD%z( STATE_CURR), AD%z( STATE_PRED), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AD_CopyOtherState( AD%OtherSt(STATE_CURR), AD%OtherSt(STATE_PRED), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END IF + + CALL AD_CopyInput (AD%Input(1), AD%Input(2), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + +END SUBROUTINE CopyStatesInputs +!---------------------------------------------------------------------------------------------------------------------------------- +! This routine sets the rotor speed for the steady state cases. Rotor speed is a continuous state. +SUBROUTINE SteadyStateUpdateStates(CaseData, p_FAST, ED, ErrStat, ErrMsg ) +!.................................................................................................................................. + + ! Passed variables + TYPE(FAST_SS_CaseType) , INTENT(IN ) :: caseData !< tsr, windSpeed, pitch, and rotor speed for this case + + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code + + TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data + + 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 ! generic loop counters + + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SteadyStateUpdateStates' + + + ErrStat = ErrID_None + ErrMsg = "" + + + ED%x(STATE_CURR)%QDT(p_FAST%GearBox_Index) = caseData%RotSpeed + +END SUBROUTINE SteadyStateUpdateStates +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine returns the preconditioned matrix, \f$ \hat{J} \f$, such that \f$ \hat{J} = S^(-1) J S \f$ with \f$S^(-1)\f$ defined +!! such that loads are scaled by p_FAST\%UJacSclFact. +SUBROUTINE Precondition_Jmat(p_FAST, y_FAST, Jmat) + + + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code + TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Output variables for the glue code + REAL(R8Ki), INTENT(INOUT) :: JMat(:,:) !< variable for steady-state solve (in is Jmat; out is Jmat_hat) + + + integer :: r, c, nx + + nx = y_FAST%Lin%Glue%SizeLin(LIN_ContSTATE_COL) + + !! Change J to J_hat: + do c=1,nx ! states are not loads: + + do r = 1,size(y_FAST%Lin%Glue%IsLoad_u) + if ( y_FAST%Lin%Glue%IsLoad_u(r) ) then + ! column is motion, but row is a load: + JMat(nx+r,c) = JMat(nx+r,c) / p_FAST%UJacSclFact + end if + end do + + end do + + + do c = 1,size(y_FAST%Lin%Glue%IsLoad_u) + + if ( y_FAST%Lin%Glue%IsLoad_u(c) ) then + + do r=1,nx ! states are not loads: + ! column is load, but row is a motion: + JMat(r,nx+c) = JMat(r,nx+c) * p_FAST%UJacSclFact + end do + + do r = 1,size(y_FAST%Lin%Glue%IsLoad_u) + if ( .not. y_FAST%Lin%Glue%IsLoad_u(r) ) then + ! column is load, but row is a motion: + JMat(nx+r,nx+c) = JMat(nx+r,nx+c) * p_FAST%UJacSclFact + end if + end do + + else + + do r = 1,size(y_FAST%Lin%Glue%IsLoad_u) + if ( y_FAST%Lin%Glue%IsLoad_u(r) ) then + ! column is motion, but row is a load: + JMat(nx+r,nx+c) = JMat(nx+r,nx+c) / p_FAST%UJacSclFact + end if + end do + + end if + + end do + + + +END SUBROUTINE Precondition_Jmat + +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine basically packs the relevant parts of the modules' inputs and states for use in the steady-state solver. +SUBROUTINE Create_SS_Vector( p_FAST, y_FAST, u, AD, ED, BD, InputIndex, StateIndex ) +!.................................................................................................................................. + TYPE(FAST_ParameterType) , INTENT(IN ) :: p_FAST !< Glue-code simulation parameters + TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< Output variables for the glue code + REAL( R8Ki ) , INTENT(INOUT) :: u(:) !< The array of states and inputs we are trying to solve for + TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data + TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data + TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data + INTEGER(IntKi), INTENT(IN ) :: InputIndex + INTEGER(IntKi), INTENT(IN ) :: StateIndex + + ! local variables: + INTEGER :: n + INTEGER :: fieldIndx + INTEGER :: node + INTEGER :: indx, indx_last + INTEGER :: i, j, k + INTEGER :: nx, nStates + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMSg2 + + + nx = y_FAST%Lin%Glue%SizeLin(LIN_ContSTATE_COL) ! make sure this is only STRUCTURAL states!!! + + ! structural code states: + IF ( p_FAST%CompElast == Module_ED ) THEN !bjj: QUESTION/FIXME: does this work when BD is used? Don't we have a combination of ED and BD states then??? Or are these only states on the blades? + nStates = nx + + if (StateIndex == STATE_PRED) then !this is actually the derivative of the current states instead of the value of the current states + do j = 1, nStates + indx = ED%p%DOFs%PS((j-1)*ED%p%NActvDOF_Stride + 1) + u(j) = ED%x( StateIndex )%QDT(indx) + end do + else + do j = 1, nStates + indx = ED%p%DOFs%PS((j-1)*ED%p%NActvDOF_Stride + 1) + u(j) = ED%x( StateIndex )%QT(indx) + end do + end if + + ELSEIF ( p_FAST%CompElast == Module_BD ) THEN + nStates = nx / 2 + + DO k=1,p_FAST%nBeams + indx = 1 + do i=2,BD%p(k)%node_total ! the first node isn't technically a state + indx_last = indx + BD%p(k)%dof_node - 1 + u( indx:indx_last ) = BD%x(k, StateIndex)%q( :,i) + u(nStates+indx:indx_last+nStates) = BD%x(k, StateIndex)%dqdt( :,i) + indx = indx_last+1 + end do + END DO + END IF !CompElast + + + + ! inputs: + ! we are at u_delta(nx+1 : end) + n = nx+1 + IF ( p_FAST%CompElast == Module_ED ) THEN + + do K = 1,p_FAST%NumBl_Lin !we don't need all blades here: SIZE(ED%Input(InputIndex)%BladePtLoads,1) ! Loop through all blades + + do node = 1, ED%Input(InputIndex)%BladePtLoads(k)%NNodes + do fieldIndx = 1,3 + u(n) = ED%Input(InputIndex)%BladePtLoads(k)%Force( fieldIndx,node) / p_FAST%UJacSclFact + n = n+1 + end do + end do + + do node = 1, ED%Input(InputIndex)%BladePtLoads(k)%NNodes + do fieldIndx = 1,3 + u(n) = ED%Input(InputIndex)%BladePtLoads(k)%Moment( fieldIndx,node) / p_FAST%UJacSclFact + n = n+1 + end do + end do + + end do + + ELSEIF ( p_FAST%CompElast == Module_BD ) THEN + + do K = 1,p_FAST%NumBl_Lin !we don't need all blades here: p_FAST%nBeams ! Loop through all blades + + do node = 1, BD%Input(InputIndex,k)%DistrLoad%NNodes + do fieldIndx = 1,3 + u(n) = BD%Input(InputIndex,k)%DistrLoad%Force( fieldIndx,node) / p_FAST%UJacSclFact + n = n+1 + end do + end do + + do node = 1, BD%Input(InputIndex,k)%DistrLoad%NNodes + do fieldIndx = 1,3 + u(n) = BD%Input(InputIndex,k)%DistrLoad%Moment( fieldIndx,node) / p_FAST%UJacSclFact + n = n+1 + end do + end do + + end do + END IF !CompElast + + + ! AeroDyn + DO k=1,p_FAST%NumBl_Lin !we don't need all blades here: SIZE(AD%Input(InputIndex)%BladeMotion) + do node = 1, AD%Input(InputIndex)%rotors(1)%BladeMotion(k)%NNodes + do fieldIndx = 1,3 + u(n) = AD%Input(InputIndex)%rotors(1)%BladeMotion(k)%TranslationDisp( fieldIndx,node) + n = n+1 + end do + end do + + do node = 1, AD%Input(InputIndex)%rotors(1)%BladeMotion(k)%NNodes + CALL DCM_LogMap( AD%Input(InputIndex)%rotors(1)%BladeMotion(k)%Orientation(:,:,node), u(n:n+2), ErrStat2, ErrMsg2 ) + n = n+3 + end do + + do node = 1, AD%Input(InputIndex)%rotors(1)%BladeMotion(k)%NNodes + do fieldIndx = 1,3 + u(n) = AD%Input(InputIndex)%rotors(1)%BladeMotion(k)%TranslationVel( fieldIndx,node) + n = n+1 + end do + end do + + END DO + + +END SUBROUTINE Create_SS_Vector + +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine adds u_delta to the corresponding mesh field and scales it as appropriate +SUBROUTINE Add_SteadyState_delta( p_FAST, y_FAST, u_delta, AD, ED, BD, MeshMapData ) +!.................................................................................................................................. + TYPE(FAST_ParameterType) , INTENT(IN ) :: p_FAST !< Glue-code simulation parameters + TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< Output variables for the glue code + REAL( R8Ki ) , INTENT(IN ) :: u_delta(:) !< The delta amount to add to the appropriate mesh fields + TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data + TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data + TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data + TYPE(FAST_ModuleMapType) , INTENT(IN ) :: MeshMapData !< data for mapping meshes between modules + + ! local variables + INTEGER :: n + INTEGER :: fieldIndx + INTEGER :: node + INTEGER :: indx, indx_last + INTEGER :: i, j, k + INTEGER :: nx, nStates + + REAL(R8Ki) :: orientation(3,3) + REAL(R8Ki) :: rotation(3,3) + + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + + + nx = y_FAST%Lin%Glue%SizeLin(LIN_ContSTATE_COL) + + ! structural code states: + IF ( p_FAST%CompElast == Module_ED ) THEN + nStates = nx + + do j = 1, nStates + + do k=1,ED%p%NActvDOF_Stride ! transfer these states to the other blades (this means that the original states MUST be set the same for all blades!!!) + indx = ED%p%DOFs%PS((j-1)*ED%p%NActvDOF_Stride + k) + + ED%x( STATE_CURR)%QT(indx) = ED%x( STATE_CURR)%QT( indx) + u_delta(j) + ED%x( STATE_CURR)%QDT(indx) = 0.0_R8Ki !ED%x( STATE_CURR)%QDT(indx) + u_delta(j+nStates) + end do + + end do + + + ELSEIF ( p_FAST%CompElast == Module_BD ) THEN + nStates = nx / 2 + + ! see BD's Perturb_x function: + + DO k=1,p_FAST%nBeams + indx = 1 + do i=2,BD%p(k)%node_total + indx_last = indx + BD%p(k)%dof_node - 1 + BD%x(k, STATE_CURR)%dqdt( :,i) = BD%x(k, STATE_CURR)%dqdt(:,i) + u_delta(nStates+indx:indx_last+nStates) + BD%x(k, STATE_CURR)%q( 1:3,i) = BD%x(k, STATE_CURR)%q( 1:3,i) + u_delta( indx:indx+2 ) + + ! w-m parameters + call BD_CrvMatrixR( BD%x(k, STATE_CURR)%q( 4:6,i), rotation ) ! returns the rotation matrix (transpose of DCM) that was stored in the state as a w-m parameter + orientation = transpose(rotation) + + call PerturbOrientationMatrix( Orientation, Perturbations = u_delta( indx+3:indx_last) ) + + rotation = transpose(orientation) + call BD_CrvExtractCrv( rotation, BD%x(k, STATE_CURR)%q( 4:6,i), ErrStat2, ErrMsg2 ) ! return the w-m parameters of the new orientation + + indx = indx_last+1 + end do + END DO + END IF !CompElast + + + + ! inputs: + ! we are at u_delta(nx+1 : end) + n = nx+1 + IF ( p_FAST%CompElast == Module_ED ) THEN + + do K = 1,p_FAST%NumBl_Lin !we don't need all blades here: SIZE(ED%Input(1)%BladePtLoads,1) ! Loop through all blades + + do node = 1, ED%Input(1)%BladePtLoads(k)%NNodes + do fieldIndx = 1,3 + ED%Input(1)%BladePtLoads(k)%Force( fieldIndx,node) = ED%Input(1)%BladePtLoads(k)%Force( fieldIndx,node) + u_delta(n) * p_FAST%UJacSclFact + n = n+1 + end do + end do + + do node = 1, ED%Input(1)%BladePtLoads(k)%NNodes + do fieldIndx = 1,3 + ED%Input(1)%BladePtLoads(k)%Moment( fieldIndx,node) = ED%Input(1)%BladePtLoads(k)%Moment( fieldIndx,node) + u_delta(n) * p_FAST%UJacSclFact + n = n+1 + end do + end do + + end do + + call SS_ED_InputSolve_OtherBlades( p_FAST, ED%Input(1), MeshMapData ) + + ELSEIF ( p_FAST%CompElast == Module_BD ) THEN + + do K = 1,p_FAST%NumBl_Lin !we don't need all blades here: p_FAST%nBeams ! Loop through all blades + + do node = 1, BD%Input(1,k)%DistrLoad%NNodes + do fieldIndx = 1,3 + BD%Input(1,k)%DistrLoad%Force( fieldIndx,node) = BD%Input(1,k)%DistrLoad%Force( fieldIndx,node) + u_delta(n) * p_FAST%UJacSclFact + n = n+1 + end do + end do + + do node = 1, BD%Input(1,k)%DistrLoad%NNodes + do fieldIndx = 1,3 + BD%Input(1,k)%DistrLoad%Moment( fieldIndx,node) = BD%Input(1,k)%DistrLoad%Moment( fieldIndx,node) + u_delta(n) * p_FAST%UJacSclFact + n = n+1 + end do + end do + + end do + + call SS_BD_InputSolve_OtherBlades( p_FAST, BD, MeshMapData, 1 ) ! 1 is for the input index (i.e., Input(1,Blades2-end) + + END IF !CompElast + + + ! AeroDyn + DO k=1,p_FAST%NumBl_Lin !we don't need all blades here: SIZE(AD%Input(1)%BladeMotion) + do node = 1, AD%Input(1)%rotors(1)%BladeMotion(k)%NNodes + do fieldIndx = 1,3 + AD%Input(1)%rotors(1)%BladeMotion(k)%TranslationDisp( fieldIndx,node) = AD%Input(1)%rotors(1)%BladeMotion(k)%TranslationDisp( fieldIndx,node) + u_delta(n) + n = n+1 + end do + end do + + do node = 1, AD%Input(1)%rotors(1)%BladeMotion(k)%NNodes + CALL PerturbOrientationMatrix( AD%Input(1)%rotors(1)%BladeMotion(k)%Orientation(:,:,node), Perturbations = u_delta(n:n+2) ) + n = n+3 + end do + + do node = 1, AD%Input(1)%rotors(1)%BladeMotion(k)%NNodes + AD%Input(1)%rotors(1)%BladeMotion(k)%TranslationVel( :,node) = AD%Input(1)%rotors(1)%BladeMotion(k)%TranslationVel( :,node) + u_delta(n:n+2) + + n = n+3 + end do + + END DO + + + ! now update the inputs on other blades: + CALL SS_AD_InputSolve_OtherBlades( p_FAST, AD%Input(1), MeshMapData ) ! transfer results from blade 1 to other blades + + +END SUBROUTINE Add_SteadyState_delta + +!---------------------------------------------------------------------------------------------------------------------------------- + + + + + +!---------------------------------------------------------------------------------------------------------------------------------- +SUBROUTINE SteadyStatePrescribedInputs( caseData, p_FAST, y_FAST, m_FAST, ED, BD, AD ) + TYPE(FAST_SS_CaseType) , INTENT(IN ) :: caseData !< tsr, windSpeed, pitch, and rotor speed for this case + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code + TYPE(FAST_OutputFileType), INTENT(INOUT) :: y_FAST !< Output variables for the glue code + TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables + + TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data + TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data + TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data + + INTEGER(IntKi) :: k + REAL(R8Ki) :: theta(3) + + ! Set prescribed inputs for all of the modules in the steady-state solve + + + ED%Input(1)%TwrAddedMass = 0.0_ReKi + ED%Input(1)%PtfmAddedMass = 0.0_ReKi + + ED%Input(1)%TowerPtLoads%Force = 0.0 + ED%Input(1)%TowerPtLoads%Moment = 0.0 + ED%Input(1)%NacelleLoads%Force = 0.0 + ED%Input(1)%NacelleLoads%Moment = 0.0 + ED%Input(1)%HubPtLoad%Force = 0.0 ! these are from BD, but they don't affect the ED calculations for aeromaps, so set them to 0 + ED%Input(1)%HubPtLoad%Moment = 0.0 ! these are from BD, but they don't affect the ED calculations for aeromaps, so set them to 0 + + ED%Input(1)%BlPitchCom = caseData%Pitch + ED%Input(1)%YawMom = 0.0 + ED%Input(1)%HSSBrTrqC = 0.0 + ED%Input(1)%GenTrq = 0.0 + + ! BeamDyn + IF (p_FAST%CompElast == Module_BD) THEN + + !CALL ED_CalcOutput( 0.0_DbKi, ED%Input(1), ED%p, ED%x(STATE_CURR), ED%xd(STATE_CURR), ED%z(STATE_CURR), ED%OtherSt(STATE_CURR), ED%y, ED%m, ErrStat2, ErrMsg2 ) + ! CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + DO k = 1,p_FAST%nBeams + BD%Input(1,k)%RootMotion%TranslationDisp = 0.0_ReKi + + theta = EulerExtract(BD%Input(1,k)%RootMotion%RefOrientation(:,:,1)) + theta(3) = -caseData%Pitch + BD%Input(1,k)%RootMotion%Orientation(:,:,1) = EulerConstruct(theta) + + BD%Input(1,k)%RootMotion%RotationVel(1,1) = caseData%RotSpeed !BD%Input(1,k)%RootMotion%RotationVel = ED%y_interp%BladeRootMotion(k)%RotationVel + BD%Input(1,k)%RootMotion%RotationVel(2:3,1) = 0.0_ReKi + + BD%Input(1,k)%RootMotion%TranslationVel(:,1) = cross_product( BD%Input(1,k)%RootMotion%RotationVel(:,1), BD%Input(1,k)%RootMotion%Position(:,1) - AD%Input(1)%rotors(1)%HubMotion%Position(:,1) ) ! ED%y_interp%BladeRootMotion(k)%TranslationVel + BD%Input(1,k)%RootMotion%TranslationAcc(:,1) = cross_product( BD%Input(1,k)%RootMotion%RotationVel(:,1), BD%Input(1,k)%RootMotion%TranslationVel(:,1) ) ! ED%y_interp%BladeRootMotion(k)%TranslationAcc + + BD%Input(1,k)%RootMotion%RotationAcc = 0.0_ReKi + END DO ! k=p_FAST%nBeams + + END IF ! BeamDyn + !BeamDyn's first "state" is not actually the state. So, do we need to do something with that????? + + + !AeroDyn + !note: i'm skipping the (unused) TowerMotion mesh + AD%Input(1)%rotors(1)%HubMotion%TranslationDisp = 0.0 + AD%Input(1)%rotors(1)%HubMotion%Orientation = AD%Input(1)%rotors(1)%HubMotion%RefOrientation + AD%Input(1)%rotors(1)%HubMotion%RotationVel(1, :) = caseData%RotSpeed + AD%Input(1)%rotors(1)%HubMotion%RotationVel(2:3,:) = 0.0_ReKi + + DO k = 1,size(AD%Input(1)%rotors(1)%BladeRootMotion,1) + theta = EulerExtract(AD%Input(1)%rotors(1)%BladeRootMotion(k)%RefOrientation(:,:,1)) + theta(3) = -caseData%Pitch + AD%Input(1)%rotors(1)%BladeRootMotion(k)%Orientation(:,:,1) = EulerConstruct(theta) !AD%Input(1)%BladeRootMotion(k)%RefOrientation + + AD%Input(1)%rotors(1)%BladeMotion(k)%RotationVel = 0.0_ReKi + !AD%Input(1)%rotors(1)%BladeMotion(k)%RotationAcc = 0.0_ReKi + AD%Input(1)%rotors(1)%BladeMotion(k)%TranslationAcc = 0.0_ReKi + END DO + + ! Set FlowField information -- AD calculates everything from the data stored in the FlowField pointer + AD%p%FlowField%Uniform%VelH(:) = caseData%WindSpeed + AD%p%FlowField%Uniform%LinShrV(:) = 0.0_ReKi + AD%p%FlowField%Uniform%AngleH(:) = 0.0_ReKi + AD%p%FlowField%PropagationDir = 0.0_ReKi + + AD%Input(1)%rotors(1)%UserProp = 0.0_ReKi + + +END SUBROUTINE SteadyStatePrescribedInputs +!---------------------------------------------------------------------------------------------------------------------------------- +SUBROUTINE FormSteadyStateJacobian( caseData, Jmat, p_FAST, y_FAST, m_FAST, ED, BD, AD, MeshMapData, ErrStat, ErrMsg ) + TYPE(FAST_SS_CaseType) , INTENT(IN ) :: caseData !< tsr, windSpeed, pitch, and rotor speed for this case + REAL(R8Ki), INTENT(INOUT) :: Jmat(:,:) !< temporary storage space for jacobian matrix + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code + TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Output variables for the glue code + TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables + + TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data + TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data + TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data + + TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules + + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + + CHARACTER(1024) :: LinRootName + REAL(R8Ki), ALLOCATABLE :: dUdu(:,:) !< temporary storage space for jacobian matrix + REAL(R8Ki), ALLOCATABLE :: dUdy(:,:) !< temporary storage space for jacobian matrix + REAL(R8Ki), ALLOCATABLE :: dxdotdy(:,:) !< temporary storage space for jacobian matrix + + + INTEGER(IntKi) :: Un + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMSg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FormSteadyStateJacobian' + + ErrStat = ErrID_None + ErrMsg = "" + + Jmat = 0.0_R8Ki ! initialize everything we are not spec + Un = -1 + + ! these values may get printed in the linearization output files, so we'll set them here: + y_FAST%Lin%WindSpeed = caseData%WindSpeed + y_FAST%Lin%RotSpeed = caseData%RotSpeed + y_FAST%Lin%Azimuth = 0.0 + + LinRootName = TRIM(p_FAST%OutFileRoot)//'.'//trim(num2lstr(m_FAST%Lin%NextLinTimeIndx)) + + call GetModuleJacobians( caseData, dxdotdy, p_FAST, y_FAST, m_FAST, ED, BD, AD, LinRootName, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (ErrStat >=AbortErrLev) then + call cleanup() + return + end if + + call GetGlueJacobians( dUdu, dUdy, p_FAST, y_FAST, m_FAST, ED, BD, AD, MeshMapData, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (ErrStat >=AbortErrLev) then + call cleanup() + return + end if + + + if (output_debugging) then + call WrLinFile_txt_Head(SS_t_global, p_FAST, y_FAST, y_FAST%Lin%Glue, LinRootName, Un, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (ErrStat >=AbortErrLev) then + call cleanup() + return + end if + + if (p_FAST%LinOutJac) then ! write these before they possibly get modified with LAPACK routines (in particular, dUdu) + call WrPartialMatrix( dUdu, Un, p_FAST%OutFmt, 'dUdu', UseRow=y_FAST%Lin%Glue%use_u, UseCol=y_FAST%Lin%Glue%use_u ) + call WrPartialMatrix( dUdy, Un, p_FAST%OutFmt, 'dUdy', UseRow=y_FAST%Lin%Glue%use_u, UseCol=y_FAST%Lin%Glue%use_y ) + call WrPartialMatrix( dxdotdy, Un, p_FAST%OutFmt, 'dxdotdy', UseRow=y_FAST%Lin%Glue%use_u, UseCol=y_FAST%Lin%Glue%use_y ) + end if + end if + + !----------------------------------------- + ! form J matrix + !----------------------------------------- + CALL GetBlock11(Jmat, dxdotdy, p_FAST, y_FAST, ErrStat2, ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + CALL GetBlock12(Jmat, dxdotdy, p_FAST, y_FAST, ErrStat2, ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + CALL GetBlock21(Jmat, dUdy, p_FAST, y_FAST, ErrStat2, ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + CALL GetBlock22(Jmat, dUdy, dUdu, p_FAST, y_FAST, ErrStat2, ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + + if (ErrStat >=AbortErrLev) then + call cleanup() + return + end if + + + + if (output_debugging) then + if (p_FAST%LinOutJac) then + ! Jacobians + call WrPartialMatrix( Jmat, Un, p_FAST%OutFmt, 'J' ) + end if + + ! finish writing the file + call WrLinFile_txt_End(Un, p_FAST, y_FAST%Lin%Glue ) + end if + + m_FAST%Lin%NextLinTimeIndx = m_FAST%Lin%NextLinTimeIndx + 1 +CONTAINS + SUBROUTINE Cleanup() + + IF (ALLOCATED(dUdu)) DEALLOCATE(dUdu) + IF (ALLOCATED(dUdy)) DEALLOCATE(dUdy) + IF (ALLOCATED(dxdotdy)) DEALLOCATE(dxdotdy) + + if (Un > 0) close(Un) + + END SUBROUTINE Cleanup + +END SUBROUTINE FormSteadyStateJacobian +!---------------------------------------------------------------------------------------------------------------------------------- +SUBROUTINE GetModuleJacobians( caseData, dxdotdy, p_FAST, y_FAST, m_FAST, ED, BD, AD, LinRootName, ErrStat, ErrMsg ) + TYPE(FAST_SS_CaseType) , INTENT(IN ) :: caseData !< tsr, windSpeed, pitch, and rotor speed for this case + REAL(R8Ki), ALLOCATABLE ,INTENT(INOUT) :: dxdotdy(:,:) !< temporary storage space for jacobian matrix + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code + TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Output variables for the glue code + TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables + + TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data + TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data + TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data + CHARACTER(*), INTENT(IN ) :: LinRootName + + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + REAL(R8Ki) :: OmegaSquared + INTEGER(IntKi) :: k + INTEGER(IntKi) :: i, r, c, nx + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMSg2 + CHARACTER(*), PARAMETER :: RoutineName = 'GetModuleJacobians' + + ErrStat = ErrID_None + ErrMsg = "" + + !------------------------ + ! dx_dot/dy: + !------------------------ + if (.not. allocated(dxdotdy)) then + call AllocAry(dxdotdy, y_FAST%Lin%Glue%SizeLin(LIN_ContState_COL), y_FAST%Lin%Glue%SizeLin(LIN_OUTPUT_COL), 'dxdotdy', ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (ErrStat>=AbortErrLev) return + end if + + dxdotdy = 0.0_R8Ki + + !..................... + ! Structure + !..................... + + y_FAST%Lin%RotSpeed = ED%y%RotSpeed + y_FAST%Lin%Azimuth = ED%y%LSSTipPxa + + !..................... + ! ElastoDyn + !..................... + if ( p_FAST%CompElast == Module_ED ) then + ! get the jacobians + call ED_JacobianPInput( SS_t_global, ED%Input(1), ED%p, ED%x(STATE_CURR), ED%xd(STATE_CURR), ED%z(STATE_CURR), ED%OtherSt(STATE_CURR), & + ED%y, ED%m, ErrStat2, ErrMsg2, dYdu=y_FAST%Lin%Modules(Module_ED)%Instance(1)%D, dXdu=y_FAST%Lin%Modules(Module_ED)%Instance(1)%B ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + call ED_JacobianPContState( SS_t_global, ED%Input(1), ED%p, ED%x(STATE_CURR), ED%xd(STATE_CURR), ED%z(STATE_CURR), ED%OtherSt(STATE_CURR), & + ED%y, ED%m, ErrStat2, ErrMsg2, dYdx=y_FAST%Lin%Modules(Module_ED)%Instance(1)%C, dXdx=y_FAST%Lin%Modules(Module_ED)%Instance(1)%A ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + ! get the operating point + if (output_debugging) then + call ED_GetOP( SS_t_global, ED%Input(1), ED%p, ED%x(STATE_CURR), ED%xd(STATE_CURR), ED%z(STATE_CURR), ED%OtherSt(STATE_CURR), & + ED%y, ED%m, ErrStat2, ErrMsg2, u_op=y_FAST%Lin%Modules(Module_ED)%Instance(1)%op_u, & + y_op=y_FAST%Lin%Modules(Module_ED)%Instance(1)%op_y, & + x_op=y_FAST%Lin%Modules(Module_ED)%Instance(1)%op_x, & + dx_op=y_FAST%Lin%Modules(Module_ED)%Instance(1)%op_dx ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (ErrStat >=AbortErrLev) return + + ! write the module matrices: + call WriteModuleLinearMatrices(Module_ED, 1, SS_t_global, p_FAST, y_FAST, LinRootName, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + end if + + !..................... + ! BeamDyn + !..................... + elseif ( p_FAST%CompElast == Module_BD ) then + + OmegaSquared = caseData%RotSpeed**2 + nx = size(dxdotdy,1)/2 + + do k=1,p_FAST%nBeams + + ! get the jacobians + call BD_JacobianPInput( SS_t_global, BD%Input(1,k), BD%p(k), BD%x(k,STATE_CURR), BD%xd(k,STATE_CURR), BD%z(k,STATE_CURR), BD%OtherSt(k,STATE_CURR), & + BD%y(k), BD%m(k), ErrStat2, ErrMsg2, dYdu=y_FAST%Lin%Modules(Module_BD)%Instance(k)%D, & + dXdu=y_FAST%Lin%Modules(Module_BD)%Instance(k)%B, & + StateRel_x =y_FAST%Lin%Modules(Module_BD)%Instance(k)%StateRel_x, & + StateRel_xdot=y_FAST%Lin%Modules(Module_BD)%Instance(k)%StateRel_xdot ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + call BD_JacobianPContState( SS_t_global, BD%Input(1,k), BD%p(k), BD%x(k,STATE_CURR), BD%xd(k,STATE_CURR), BD%z(k,STATE_CURR), BD%OtherSt(k,STATE_CURR), & + BD%y(k), BD%m(k), ErrStat2, ErrMsg2, dYdx=y_FAST%Lin%Modules(Module_BD)%Instance(k)%C, dXdx=y_FAST%Lin%Modules(Module_BD)%Instance(k)%A, & + StateRotation=y_FAST%Lin%Modules(Module_BD)%Instance(k)%StateRotation) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + if (output_debugging) then + ! get the operating point (for writing to file only) + call BD_GetOP( SS_t_global, BD%Input(1,k), BD%p(k), BD%x(k,STATE_CURR), BD%xd(k,STATE_CURR), BD%z(k,STATE_CURR), BD%OtherSt(k,STATE_CURR), & + BD%y(k), BD%m(k), ErrStat2, ErrMsg2, u_op=y_FAST%Lin%Modules(Module_BD)%Instance(k)%op_u, y_op=y_FAST%Lin%Modules(Module_BD)%Instance(k)%op_y, & + x_op=y_FAST%Lin%Modules(Module_BD)%Instance(k)%op_x, dx_op=y_FAST%Lin%Modules(Module_BD)%Instance(k)%op_dx ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (ErrStat >=AbortErrLev) return + + ! write the module matrices: + call WriteModuleLinearMatrices(Module_BD, k, SS_t_global, p_FAST, y_FAST, LinRootName, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + end if + + ! calculate dxdotdy here: + ! NOTE that this implies that the FEA nodes (states) are the same as the output nodes!!!! (note that we have overlapping nodes at the element end points) + r = 1 + do i=2,BD%p(k)%node_total ! the first node isn't technically a state + c = (BD%p(k)%NdIndx(i)-1)*3 + 1 ! BldMeshNode = BD%p(k)%NdIndx(i) + + !dxdotdy(r:r+2,c:c+2) = SkewSymMat( [p_FAST%RotSpeed, 0.0_ReKi, 0.0_ReKi] ) + dxdotdy(r+2,c+1) = caseData%RotSpeed + dxdotdy(r+1,c+2) = -caseData%RotSpeed + + ! derivative + dxdotdy(r+nx+1,c+1) = -OmegaSquared + dxdotdy(r+nx+2,c+2) = -OmegaSquared + + r = r + BD%p(k)%dof_node + end do + + end do ! k + + end if !BeamDyn + + + !..................... + ! AeroDyn + !..................... + if ( p_FAST%CompAero == Module_AD ) then + ! get the jacobians + call AD_JacobianPInput( SS_t_global, AD%Input(1), AD%p, AD%x(STATE_CURR), AD%xd(STATE_CURR), AD%z(STATE_CURR), & + AD%OtherSt(STATE_CURR), AD%y, AD%m, ErrStat2, ErrMsg2, & + dYdu=y_FAST%Lin%Modules(Module_AD)%Instance(1)%D ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + if (output_debugging) then + ! get the operating point + call AD_GetOP( SS_t_global, AD%Input(1), AD%p, AD%x(STATE_CURR), AD%xd(STATE_CURR), AD%z(STATE_CURR), & + AD%OtherSt(STATE_CURR), AD%y, AD%m, ErrStat2, ErrMsg2, & + u_op=y_FAST%Lin%Modules(Module_AD)%Instance(1)%op_u, & + y_op=y_FAST%Lin%Modules(Module_AD)%Instance(1)%op_y ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (ErrStat >=AbortErrLev) return + + + ! write the module matrices: + call WriteModuleLinearMatrices(Module_AD, 1, SS_t_global, p_FAST, y_FAST, LinRootName, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (ErrStat >=AbortErrLev) RETURN + end if + + end if + + ! move all module-level matrices into system-wide glue matrices: + call Glue_FormDiag( p_FAST, y_FAST, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (ErrStat>=AbortErrLev) return + +END SUBROUTINE GetModuleJacobians +!---------------------------------------------------------------------------------------------------------------------------------- +SUBROUTINE GetGlueJacobians( dUdu, dUdy, p_FAST, y_FAST, m_FAST, ED, BD, AD, MeshMapData, ErrStat, ErrMsg ) + REAL(R8Ki), ALLOCATABLE, INTENT(INOUT) :: dUdu(:,:) !< temporary storage space for jacobian matrix + REAL(R8Ki), ALLOCATABLE, INTENT(INOUT) :: dUdy(:,:) !< temporary storage space for jacobian matrix + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code + TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Output variables for the glue code + TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables + + TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data + TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data + TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data + + TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules + + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + INTEGER(IntKi) :: ThisModule + INTEGER(IntKi) :: i, j + INTEGER(IntKi) :: k + INTEGER(IntKi) :: r_start, r_end + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMSg2 + CHARACTER(*), PARAMETER :: RoutineName = 'GetGlueJacobians' + + + ErrStat = ErrID_None + ErrMsg = "" + + !------------------------ + ! dU/du: + !------------------------ + if (.not. allocated(dUdu)) then + call AllocAry(dUdu, y_FAST%Lin%Glue%SizeLin(LIN_INPUT_COL), y_FAST%Lin%Glue%SizeLin(LIN_INPUT_COL), 'dUdu', ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (ErrStat>=AbortErrLev) return + end if + + dUdu = 0.0_R8Ki ! most of this matrix is zero, so we'll just initialize everything and set only the non-zero parts below + do j = 1,p_FAST%Lin_NumMods + ThisModule = p_FAST%Lin_ModOrder(j) + do k=1,size(y_FAST%Lin%Modules(ThisModule)%Instance) + r_start = y_FAST%Lin%Modules(ThisModule)%Instance(k)%LinStartIndx(LIN_INPUT_COL) + r_end = r_start + y_FAST%Lin%Modules(ThisModule)%Instance(k)%SizeLin( LIN_INPUT_COL) - 1 + do i = r_start,r_end + dUdu(i,i) = 1.0_R8Ki + end do + end do + end do + + + call LinearSS_AD_InputSolve_du( p_FAST, y_FAST, AD%Input(1), ED%y, BD, MeshMapData, dUdu, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + + IF (p_FAST%CompElast == Module_ED) THEN + call LinearSS_ED_InputSolve_du( p_FAST, y_FAST, ED%Input(1), ED%y, AD%y, AD%Input(1), MeshMapData, dUdu, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + ELSEIF (p_FAST%CompElast == Module_BD) THEN + call LinearSS_BD_InputSolve_du( p_FAST, y_FAST, AD%y, AD%Input(1), BD, MeshMapData, dUdu, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + END IF + +!!! write the module matrices: +!!!call WriteModuleLinearMatrices(Module_AD, 1, SS_t_global, p_FAST, y_FAST, LinRootName, ErrStat2, ErrMsg2) +!!! call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) +!!! if (ErrStat >=AbortErrLev) RETURN + + !------------------------ + ! dU/dy: + !------------------------ + if (.not. allocated(dUdy)) then + call AllocAry(dUdy, y_FAST%Lin%Glue%SizeLin(LIN_INPUT_COL), y_FAST%Lin%Glue%SizeLin(LIN_OUTPUT_COL), 'dUdy', ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (ErrStat>=AbortErrLev) return + end if + + dUdy = 0.0_R8Ki ! most of this matrix is zero, so we'll just initialize everything and set only the non-zero parts below + + + if (p_FAST%CompElast == Module_ED) then + call LinearSS_ED_InputSolve_dy( p_FAST, y_FAST, ED%p, ED%Input(1), ED%y, AD%y, AD%Input(1), MeshMapData, dUdy, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + elseif (p_FAST%CompElast == MODULE_BD) then + call LinearSS_BD_InputSolve_dy( p_FAST, y_FAST, AD%y, AD%Input(1), BD, MeshMapData, dUdy, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + end if + + call LinearSS_AD_InputSolve_NoIfW_dy( p_FAST, y_FAST, AD%Input(1), ED%y, BD, MeshMapData, dUdy, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + + if (output_debugging) then + ! for debugging: + call Glue_GetOP(p_FAST, y_FAST, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (ErrStat >=AbortErrLev) return + end if + +END SUBROUTINE GetGlueJacobians +!---------------------------------------------------------------------------------------------------------------------------------- +SUBROUTINE GetBlock11(Jmat, dxdotdy, p_FAST, y_FAST, ErrStat, ErrMsg) + REAL(R8Ki), INTENT(INOUT) :: Jmat(:,:) !< Jacobian matrix of which we are calculating the upper left block: (1,1) + REAL(R8Ki), INTENT(IN ) :: dxdotdy(:,:) !< temporary storage space for jacobian matrix + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Glue-code simulation parameters + TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< Glue-code output parameters (for linearization) + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + REAL(R8Ki), ALLOCATABLE :: blockMat(:,:) + INTEGER(IntKi) :: r_start, c_start, r, c + INTEGER(IntKi) :: ErrStat2 ! temporary Error status of the operation + CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None + + CHARACTER(*), PARAMETER :: RoutineName = 'GetBlock11' + + ErrStat = ErrID_None + ErrMsg = "" + + !--------------- + ! upper left corner of J matrix: size of A (uses only blade DOFs from the structural module) + !--------------- + call AllocAry(blockMat, y_FAST%Lin%Glue%SizeLin(LIN_ContSTATE_COL), y_FAST%Lin%Glue%SizeLin(LIN_ContSTATE_COL), 'block matrix 1,1', ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (ErrStat >= AbortErrLev) return + + blockMat = y_FAST%Lin%Glue%A ! copy this so we don't overwrite y_FAST%Lin%Glue%A here + call LAPACK_GEMM( 'N', 'N', -1.0_R8Ki, dxdotdy, y_FAST%Lin%Glue%C, 1.0_R8Ki, blockMat, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + + r_start = 1 + c_start = 1 + + ! dX/dx - dx_dot/dy * dY/dx = A - dx_dot/dy * C: + do c=1,size( blockMat, 2) + do r=1,size( blockMat, 1) + Jmat(r_start + r - 1, c_start + c - 1) = blockMat(r,c) + end do + end do + + + if (allocated (blockMat)) deallocate(blockMat) + + +END SUBROUTINE GetBlock11 +!---------------------------------------------------------------------------------------------------------------------------------- +SUBROUTINE GetBlock12(Jmat, dxdotdy, p_FAST, y_FAST, ErrStat, ErrMsg) + REAL(R8Ki), INTENT(INOUT) :: Jmat(:,:) !< Jacobian matrix of which we are calculating the upper right block: (1,2) + REAL(R8Ki), INTENT(IN ) :: dxdotdy(:,:) !< temporary storage space for jacobian matrix + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Glue-code simulation parameters + TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< Glue-code output parameters (for linearization) + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + REAL(R8Ki), ALLOCATABLE :: blockMat(:,:) + INTEGER(IntKi) :: r_start, c_start, r, c + INTEGER(IntKi) :: ErrStat2 ! temporary Error status of the operation + CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None + + CHARACTER(*), PARAMETER :: RoutineName = 'GetBlock11' + + ErrStat = ErrID_None + ErrMsg = "" + + !--------------- + ! upper right corner of J matrix: size of B (uses only blade DOFs from the structural module) + !--------------- + call AllocAry(blockMat, y_FAST%Lin%Glue%SizeLin(LIN_ContSTATE_COL), y_FAST%Lin%Glue%SizeLin(LIN_INPUT_COL), 'block matrix 1,2', ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (ErrStat >= AbortErrLev) return + + blockMat = y_FAST%Lin%Glue%B ! copy this so we don't overwrite y_FAST%Lin%Glue%B here + call LAPACK_GEMM( 'N', 'N', -1.0_R8Ki, dxdotdy, y_FAST%Lin%Glue%D, 1.0_R8Ki, blockMat, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + r_start = 1 + c_start = y_FAST%Lin%Glue%SizeLin(LIN_ContSTATE_COL) + 1 + + ! dX/du - dx_dot/dy * dY/du = B - dx_dot/dy * D: + do c=1,size( blockMat, 2) + do r=1,size( blockMat, 1) + Jmat(r_start + r - 1, c_start + c - 1) = blockMat(r,c) + end do + end do + + + if (allocated (blockMat)) deallocate(blockMat) + + +END SUBROUTINE GetBlock12 +!---------------------------------------------------------------------------------------------------------------------------------- +SUBROUTINE GetBlock21(Jmat, dUdy, p_FAST, y_FAST, ErrStat, ErrMsg) + REAL(R8Ki), INTENT(INOUT) :: Jmat(:,:) !< Jacobian matrix of which we are calculating the lower left block: (2,1) + REAL(R8Ki), INTENT(IN ) :: dUdy(:,:) !< dUdy matrix + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Glue-code simulation parameters + TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< Glue-code output parameters (for linearization) + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + REAL(R8Ki), ALLOCATABLE :: dUdx(:,:) + INTEGER(IntKi) :: r_start, c_start, r, c + INTEGER(IntKi) :: ErrStat2 ! temporary Error status of the operation + CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None + + CHARACTER(*), PARAMETER :: RoutineName = 'GetBlock21' + + ErrStat = ErrID_None + ErrMsg = "" + + !--------------- + ! lower left corner of J matrix: + !--------------- + call AllocAry(dUdx, y_FAST%Lin%Glue%SizeLin(LIN_INPUT_COL), y_FAST%Lin%Glue%SizeLin(LIN_ContSTATE_COL), 'block matrix 2,1', ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (ErrStat >= AbortErrLev) return + + call LAPACK_GEMM( 'N', 'N', 1.0_R8Ki, dUdy, y_FAST%Lin%Glue%C, 0.0_R8Ki, dUdx, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + r_start = y_FAST%Lin%Glue%SizeLin(LIN_ContSTATE_COL) + 1 + c_start = 1 + + ! dU/dy * dY/dx: + do c=1,size( dUdx, 2) + do r=1,size( dUdx, 1) + Jmat(r_start + r - 1, c_start + c - 1) = dUdx(r,c) + end do + end do + + if (allocated (dUdx)) deallocate(dUdx) + +END SUBROUTINE GetBlock21 +!---------------------------------------------------------------------------------------------------------------------------------- +SUBROUTINE GetBlock22(Jmat, dUdy, dUdu, p_FAST, y_FAST, ErrStat, ErrMsg) + REAL(R8Ki), INTENT(INOUT) :: Jmat(:,:) !< Jacobian matrix of which we are calculating the lower left block: (2,1) + REAL(R8Ki), INTENT(IN ) :: dUdy(:,:) !< dUdy matrix + REAL(R8Ki), INTENT(INOUT) :: dUdu(:,:) !< dUdu matrix (note that it is modified on exit of this routine!) + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Glue-code simulation parameters + TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< Glue-code output parameters (for linearization) + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + INTEGER(IntKi) :: r_start, c_start, r, c + INTEGER(IntKi) :: ErrStat2 ! temporary Error status of the operation + CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None + + CHARACTER(*), PARAMETER :: RoutineName = 'GetBlock22' + + ErrStat = ErrID_None + ErrMsg = "" + + !--------------- + ! lower right corner of J matrix: + !--------------- + call LAPACK_GEMM( 'N', 'N', 1.0_R8Ki, dUdy, y_FAST%Lin%Glue%D, 1.0_R8Ki, dUdu, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + r_start = y_FAST%Lin%Glue%SizeLin(LIN_ContSTATE_COL) + 1 + c_start = y_FAST%Lin%Glue%SizeLin(LIN_ContSTATE_COL) + 1 + + ! dU/du + dU/dy * dY/du: + do c=1,size( dUdu, 2) + do r=1,size( dUdu, 1) + Jmat(r_start + r - 1, c_start + c - 1) = dUdu(r,c) + end do + end do + + +END SUBROUTINE GetBlock22 +!---------------------------------------------------------------------------------------------------------------------------------- + +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine forms the dU^{ED}/du^{BD} and dU^{ED}/du^{AD} blocks (ED row) of dUdu. (i.e., how do changes in the AD and BD inputs affect the ED inputs?) +SUBROUTINE LinearSS_ED_InputSolve_du( p_FAST, y_FAST, u_ED, y_ED, y_AD, u_AD, MeshMapData, dUdu, ErrStat, ErrMsg ) + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Glue-code simulation parameters + TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< Glue-code output parameters (for linearization) + TYPE(ED_InputType), INTENT(INOUT) :: u_ED !< ED Inputs at t + TYPE(ED_OutputType), INTENT(IN ) :: y_ED !< ElastoDyn outputs (need translation displacement on meshes for loads mapping) + TYPE(AD_OutputType), INTENT(IN ) :: y_AD !< AeroDyn outputs + TYPE(AD_InputType), INTENT(INOUT) :: u_AD !< AD inputs (for AD-ED load linerization) + TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules + REAL(R8Ki), INTENT(INOUT) :: dUdu(:,:) !< Jacobian matrix of which we are computing the dU^(ED)/du^(AD) block + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message + + ! local variables + INTEGER(IntKi) :: K ! Loops through blades + INTEGER(IntKi) :: AD_Start_Bl ! starting index of dUdu (column) where AD blade motion inputs are located + INTEGER(IntKi) :: ED_Start_mt ! starting index of dUdu (row) where ED blade/tower or hub moment inputs are located + INTEGER(IntKi) :: ErrStat2 ! temporary Error status of the operation + CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None + + CHARACTER(*), PARAMETER :: RoutineName = 'LinearSS_ED_InputSolve_du' + + + ! Initialize error status + + ErrStat = ErrID_None + ErrMsg = "" + + !.......... + ! dU^{ED}/du^{AD} + !.......... + IF ( p_FAST%CompAero == Module_AD ) THEN + + ! ED inputs on blade from AeroDyn + IF (p_FAST%CompElast == Module_ED) THEN + + ED_Start_mt = y_FAST%Lin%Modules(MODULE_ED)%Instance(1)%LinStartIndx(LIN_INPUT_COL) + + DO K = 1,p_FAST%NumBl_Lin !we don't need all blades: SIZE(u_ED%BladePtLoads,1) ! Loop through all blades (p_ED%NumBl) + ED_Start_mt = ED_Start_mt + u_ED%BladePtLoads(k)%NNodes*3 ! skip the forces on this blade + AD_Start_Bl = SS_Indx_u_AD_Blade_Start(u_AD, p_FAST, y_FAST, k) + + CALL Linearize_Line2_to_Point( y_AD%rotors(1)%BladeLoad(k), u_ED%BladePtLoads(k), MeshMapData%AD_L_2_BDED_B(k), ErrStat2, ErrMsg2, u_AD%rotors(1)%BladeMotion(k), y_ED%BladeLn2Mesh(k) ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + ! AD is source in the mapping, so we want M_{uSm} + if (allocated(MeshMapData%AD_L_2_BDED_B(k)%dM%m_us )) then + call SetBlockMatrix( dUdu, MeshMapData%AD_L_2_BDED_B(k)%dM%m_us, ED_Start_mt, AD_Start_Bl ) + end if + + ! get starting index of next blade + ED_Start_mt = ED_Start_mt + u_ED%BladePtLoads(k)%NNodes* 3 ! skip the moments on this blade + + END DO + + END IF + + END IF + + +END SUBROUTINE LinearSS_ED_InputSolve_du +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine forms the dU^{BD}/du^{BD} and dU^{BD}/du^{AD} blocks (BD row) of dUdu. (i.e., how do changes in the AD and BD inputs +!! affect the BD inputs?) This should be called only when p_FAST%CompElast == Module_BD. +SUBROUTINE LinearSS_BD_InputSolve_du( p_FAST, y_FAST, y_AD, u_AD, BD, MeshMapData, dUdu, ErrStat, ErrMsg ) + + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Glue-code simulation parameters + TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< Glue-code output parameters (for linearization) + TYPE(AD_OutputType), INTENT(IN ) :: y_AD !< AeroDyn outputs + TYPE(AD_InputType), INTENT(INOUT) :: u_AD !< AD inputs (for AD-ED load linerization) + TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BD data at t + + TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules + REAL(R8Ki), INTENT(INOUT) :: dUdu(:,:) !< Jacobian matrix of which we are computing the dU^(ED)/du^(AD) block + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message + + ! local variables + INTEGER(IntKi) :: k ! Loops through blades + INTEGER(IntKi) :: BD_Start ! starting index of dUdu (row) where BD inputs are located + INTEGER(IntKi) :: AD_Start ! starting index of dUdu (column) where AD inputs are located + INTEGER(IntKi) :: ErrStat2 ! temporary Error status of the operation + CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None + + CHARACTER(*), PARAMETER :: RoutineName = 'LinearSS_BD_InputSolve_du' + + + ! Initialize error status + + ErrStat = ErrID_None + ErrMsg = "" + + !.......... + ! dU^{BD}/du^{AD} + !.......... + IF ( p_FAST%CompAero == Module_AD ) THEN + + ! BD inputs on blade from AeroDyn + + + if (p_FAST%BD_OutputSibling) then + + DO K = 1,p_FAST%NumBl_Lin !we don't need all blades: p_FAST%nBeams ! Loop through all blades + CALL Linearize_Line2_to_Line2( y_AD%rotors(1)%BladeLoad(k), BD%Input(1,k)%DistrLoad, MeshMapData%AD_L_2_BDED_B(k), ErrStat2, ErrMsg2, u_AD%rotors(1)%BladeMotion(k), BD%y(k)%BldMotion ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + END DO + + else + + DO K = 1,p_FAST%NumBl_Lin !we don't need all blades: p_FAST%nBeams ! Loop through all blades + !linearization for dUdy will need some matrix multiplies because of the transfer (chain rule!), but we will perform individual linearization calculations here + !!! need to transfer the BD output blade motions to nodes on a sibling of the BD blade motion mesh: + CALL Linearize_Line2_to_Line2( BD%y(k)%BldMotion, MeshMapData%y_BD_BldMotion_4Loads(k), MeshMapData%BD_L_2_BD_L(k), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + CALL Linearize_Line2_to_Line2( y_AD%rotors(1)%BladeLoad(k), BD%Input(1,k)%DistrLoad, MeshMapData%AD_L_2_BDED_B(k), ErrStat2, ErrMsg2, u_AD%rotors(1)%BladeMotion(k), MeshMapData%y_BD_BldMotion_4Loads(k) ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + END DO + + end if + + + DO K = 1,p_FAST%NumBl_Lin !we don't need all blades: p_FAST%nBeams ! Loop through all blades + + ! AD is source in the mapping, so we want M_{uSm} + if (allocated(MeshMapData%AD_L_2_BDED_B(k)%dM%m_us )) then + AD_Start = SS_Indx_u_AD_Blade_Start(u_AD, p_FAST, y_FAST, k) ! index for the start of u_AD%BladeMotion(k)%translationDisp field + + BD_Start = y_FAST%Lin%Modules(MODULE_BD)%Instance(k)%LinStartIndx(LIN_INPUT_COL) & + + BD%Input(1,k)%DistrLoad%NNodes * 3 ! force field for each node (start with moment field) + + call SetBlockMatrix( dUdu, MeshMapData%AD_L_2_BDED_B(k)%dM%m_us, BD_Start, AD_Start ) + end if + + END DO + + END IF + +END SUBROUTINE LinearSS_BD_InputSolve_du +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine forms the dU^{AD}/du^{AD} block of dUdu. (i.e., how do changes in the AD inputs affect the AD inputs?) +SUBROUTINE LinearSS_AD_InputSolve_du( p_FAST, y_FAST, u_AD, y_ED, BD, MeshMapData, dUdu, ErrStat, ErrMsg ) + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< FAST parameter data + TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) + TYPE(AD_InputType), INTENT(INOUT) :: u_AD !< The inputs to AeroDyn14 + TYPE(ED_OutputType), INTENT(IN ) :: y_ED !< The outputs from the structural dynamics module + TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BD data at t + TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules + REAL(R8Ki), INTENT(INOUT) :: dUdu(:,:) !< Jacobian matrix of which we are computing the dU^(ED)/du^(AD) block + INTEGER(IntKi), INTENT(INOUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT(INOUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + ! Local variables: + INTEGER(IntKi) :: K ! Loops through blades + INTEGER(IntKi) :: AD_Start_td ! starting index of dUdu (column) where AD translation displacements are located + INTEGER(IntKi) :: AD_Start_tv ! starting index of dUdu (column) where AD translation velocities are located + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'LinearSS_AD_InputSolve_du' + + + ErrStat = ErrID_None + ErrMsg = "" + + ! note that we assume this block matrix has been initialized to the identity matrix before calling this routine + + ! look at how the translational displacement gets transfered to the translational velocity: + !------------------------------------------------------------------------------------------------- + ! Set the inputs from ElastoDyn and/or BeamDyn: + !------------------------------------------------------------------------------------------------- + + ! blades + IF (p_FAST%CompElast == Module_ED ) THEN + + DO k=1,p_FAST%NumBl_Lin !we don't need all blades: size(u_AD%BladeMotion) + CALL Linearize_Line2_to_Line2( y_ED%BladeLn2Mesh(k), u_AD%rotors(1)%BladeMotion(k), MeshMapData%BDED_L_2_AD_L_B(k), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName//':u_AD%BladeMotion('//trim(num2lstr(k))//')' ) + END DO + + ELSEIF (p_FAST%CompElast == Module_BD ) THEN + + DO k=1,p_FAST%NumBl_Lin !we don't need all blades: size(u_AD%BladeMotion) + CALL Linearize_Line2_to_Line2( BD%y(k)%BldMotion, u_AD%rotors(1)%BladeMotion(k), MeshMapData%BDED_L_2_AD_L_B(k), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName//':u_AD%BladeMotion('//trim(num2lstr(k))//')' ) + END DO + + END IF + + + + DO k=1,p_FAST%NumBl_Lin !we don't need all blades: size(u_AD%BladeMotion) + + AD_Start_td = SS_Indx_u_AD_Blade_Start(u_AD, p_FAST, y_FAST, k) ! index for u_AD%BladeMotion(k)%translationDisp field + + !AD is the destination here, so we need tv_ud + if (allocated( MeshMapData%BDED_L_2_AD_L_B(k)%dM%tv_ud)) then + ! index for u_AD%BladeMotion(k+1)%translationVel field + AD_Start_tv = AD_Start_td + u_AD%rotors(1)%BladeMotion(k)%NNodes * 6 ! 2 fields (TranslationDisp and Orientation) with 3 components before translational velocity field + + call SetBlockMatrix( dUdu, MeshMapData%BDED_L_2_AD_L_B(k)%dM%tv_ud, AD_Start_tv, AD_Start_td ) + end if + + + END DO + + + +END SUBROUTINE LinearSS_AD_InputSolve_du + +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine forms the dU^{ED}/dy^{SrvD}, dU^{ED}/dy^{ED}, dU^{ED}/dy^{BD}, dU^{ED}/dy^{AD}, dU^{ED}/dy^{HD}, and dU^{ED}/dy^{MAP} +!! blocks of dUdy. (i.e., how do changes in the SrvD, ED, BD, AD, HD, and MAP outputs effect the ED inputs?) +SUBROUTINE LinearSS_ED_InputSolve_dy( p_FAST, y_FAST, p_ED, u_ED, y_ED, y_AD, u_AD, MeshMapData, dUdy, ErrStat, ErrMsg ) + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Glue-code simulation parameters + TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) + TYPE(ED_ParameterType), INTENT(IN ) :: p_ED !< ElastoDyn parameters + TYPE(ED_InputType), INTENT(INOUT) :: u_ED !< ED Inputs at t + TYPE(ED_OutputType), INTENT(IN ) :: y_ED !< ElastoDyn outputs (need translation displacement on meshes for loads mapping) + TYPE(AD_OutputType), INTENT(IN ) :: y_AD !< AeroDyn outputs + TYPE(AD_InputType), INTENT(INOUT) :: u_AD !< AD inputs (for AD-ED load linerization) + + TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules + REAL(R8Ki), INTENT(INOUT) :: dUdy(:,:) !< Jacobian matrix of which we are computing the dU^(ED)/du^(AD) block + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message + + ! local variables + INTEGER(IntKi) :: K ! Loops through blades + INTEGER(IntKi) :: AD_Out_Start ! starting index of dUdy (column) where particular AD fields are located + INTEGER(IntKi) :: ED_Start ! starting index of dUdy (row) where ED input fields are located + INTEGER(IntKi) :: ED_Out_Start ! starting index of dUdy (column) where ED output fields are located + CHARACTER(*), PARAMETER :: RoutineName = 'Linear_ED_InputSolve_dy' + + + ! Initialize error status + + ErrStat = ErrID_None + ErrMsg = "" + + ! parts of dU^{ED}/dy^{AD} and dU^{ED}/dy^{ED}: + + ! ElastoDyn inputs on blade from AeroDyn and ElastoDyn + + AD_Out_Start = y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%LinStartIndx(LIN_OUTPUT_COL) ! start of y_AD%rotors(1)%BladeLoad(1)%Force field [2 fields (force, moment) with 3 components] + + DO K = 1,p_FAST%NumBl_Lin !we don't need all blades: SIZE(u_ED%BladePtLoads,1) ! Loop through all blades (p_ED%NumBl) + !!! ! This linearization was done in forming dUdu (see Linear_ED_InputSolve_du()), so we don't need to re-calculate these matrices + !!! ! while forming dUdy, too. + !CALL Linearize_Line2_to_Point( y_AD%rotors(1)%BladeLoad(k), u_ED%BladePtLoads(k), MeshMapData%AD_L_2_BDED_B(k), ErrStat2, ErrMsg2, u_AD%BladeMotion(k), y_ED%BladeLn2Mesh(k) ) + + ! AD loads-to-ED loads transfer (dU^{ED}/dy^{AD}): + ED_Start = Indx_u_ED_Blade_Start(p_ED, u_ED, y_FAST, k) ! start of u_ED%BladePtLoads(k)%Force field + call Assemble_dUdy_Loads(y_AD%rotors(1)%BladeLoad(k), u_ED%BladePtLoads(k), MeshMapData%AD_L_2_BDED_B(k), ED_Start, AD_Out_Start, dUdy) + + ! ED translation displacement-to-ED moment transfer (dU^{ED}/dy^{ED}): + ED_Start = Indx_u_ED_Blade_Start(p_ED, u_ED, y_FAST, k) + u_ED%BladePtLoads(k)%NNodes*3 ! start of u_ED%BladePtLoads(k)%Moment field (skip the ED forces) + ED_Out_Start = SS_Indx_y_ED_Blade_Start(y_ED, p_FAST, y_FAST, k) ! start of y_ED%BladeLn2Mesh(1)%TranslationDisp field + call SetBlockMatrix( dUdy, MeshMapData%AD_L_2_BDED_B(k)%dM%m_uD, ED_Start, ED_Out_Start ) + + AD_Out_Start = AD_Out_Start + y_AD%rotors(1)%BladeLoad(k)%NNodes*6 ! start of y_AD%rotors(1)%BladeLoad(k+1)%Force field [skip 2 fields to forces on next blade] + END DO + + +END SUBROUTINE LinearSS_ED_InputSolve_dy +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine forms the dU^{BD}/dy^{ED}, dU^{BD}/dy^{BD}, and dU^{BD}/dy^{AD} blocks of dUdy. (i.e., how do +!! changes in the ED, BD, and AD outputs effect the BD inputs?) +SUBROUTINE LinearSS_BD_InputSolve_dy( p_FAST, y_FAST, y_AD, u_AD, BD, MeshMapData, dUdy, ErrStat, ErrMsg ) + + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Glue-code simulation parameters + TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) + TYPE(AD_OutputType), INTENT(IN ) :: y_AD !< AeroDyn outputs + TYPE(AD_InputType), INTENT(INOUT) :: u_AD !< AD inputs (for AD-ED load linearization) + TYPE(BeamDyn_Data), INTENT(IN ) :: BD !< BD data at t + + TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules + REAL(R8Ki), INTENT(INOUT) :: dUdy(:,:) !< Jacobian matrix of which we are computing the dU^(ED)/du^(AD) block + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message + + ! local variables + INTEGER(IntKi) :: K ! Loops through blades + INTEGER(IntKi) :: AD_Out_Start ! starting index of dUdy (column) where particular AD fields are located + INTEGER(IntKi) :: BD_Start ! starting index of dUdy (column) where particular BD fields are located + INTEGER(IntKi) :: BD_Out_Start ! starting index of dUdy (column) where BD output fields are located + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + REAL(R8Ki), ALLOCATABLE :: TempMat(:,:) ! temporary matrix for getting linearization matrices when BD input and output meshes are not siblings + CHARACTER(*), PARAMETER :: RoutineName = 'LinearSS_BD_InputSolve_dy' + + + ! Initialize error status + + ErrStat = ErrID_None + ErrMsg = "" + + ! parts of dU^{BD}/dy^{AD} and dU^{BD}/dy^{BD}: + + ! BeamDyn inputs on blade from AeroDyn and BeamDyn + + AD_Out_Start = y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%LinStartIndx(LIN_OUTPUT_COL) ! start of y_AD%rotors(1)%BladeLoad(1)%Force field [2 fields (force, moment) with 3 components] + DO K = 1,p_FAST%NumBl_Lin !we don't need all blades: p_FAST%nBeams ! Loop through all blades + + BD_Start = y_FAST%Lin%Modules(MODULE_BD)%Instance(k)%LinStartIndx(LIN_INPUT_COL) ! start of BD%Input(1,k)%DistrLoad%Force field + + ! AD loads-to-BD loads transfer (dU^{BD}/dy^{AD}): + call Assemble_dUdy_Loads(y_AD%rotors(1)%BladeLoad(k), BD%Input(1,k)%DistrLoad, MeshMapData%AD_L_2_BDED_B(k), BD_Start, AD_Out_Start, dUdy) + AD_Out_Start = AD_Out_Start + y_AD%rotors(1)%BladeLoad(k)%NNodes*6 ! start of y_AD%rotors(1)%BladeLoad(k+1)%Force field [skip the moments to get to forces on next blade] + + + ! BD translation displacement-to-BD moment transfer (dU^{BD}/dy^{BD}): + BD_Start = BD_Start + BD%Input(1,k)%DistrLoad%NNodes * 3 ! start of BD%Input(1,k)%DistrLoad%Moment field (start with moment field) + BD_Out_Start = y_FAST%Lin%Modules(MODULE_BD)%Instance(k)%LinStartIndx(LIN_OUTPUT_COL) ! start of BD%y(k)%BldMotion%TranslationDisp field + + + if (p_FAST%BD_OutputSibling) then + call SetBlockMatrix( dUdy, MeshMapData%AD_L_2_BDED_B(k)%dM%m_uD, BD_Start, BD_Out_Start ) + else + call AllocAry(TempMat, size(MeshMapData%AD_L_2_BDED_B(k)%dM%m_uD,1), size(MeshMapData%BD_L_2_BD_L(k)%dM%mi,2), 'TempMat', ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat>=AbortErrLev) return + + ! these blocks should be small enough that we can use matmul instead of calling a LAPACK routine to do it. + TempMat = matmul(MeshMapData%AD_L_2_BDED_B(k)%dM%m_uD,MeshMapData%BD_L_2_BD_L(k)%dM%mi) + call SetBlockMatrix( dUdy, TempMat, BD_Start, BD_Out_Start ) + + BD_Out_Start = BD_Out_Start + BD%y(k)%BldMotion%NNodes*3 ! start of BD%y(k)%BldMotion%Orientation field + TempMat = matmul(MeshMapData%AD_L_2_BDED_B(k)%dM%m_uD,MeshMapData%BD_L_2_BD_L(k)%dM%fx_p) + call SetBlockMatrix( dUdy, TempMat, BD_Start, BD_Out_Start ) + + deallocate(TempMat) ! the next blade may have a different number of nodes + end if + + END DO + + +END SUBROUTINE LinearSS_BD_InputSolve_dy +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine forms the dU^{AD}/dy^{ED} and dU^{AD}/dy^{BD} blocks of dUdy. (i.e., how do changes in the ED and BD outputs affect +!! the AD inputs?) +SUBROUTINE LinearSS_AD_InputSolve_NoIfW_dy( p_FAST, y_FAST, u_AD, y_ED, BD, MeshMapData, dUdy, ErrStat, ErrMsg ) + + ! Passed variables + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< FAST parameter data + TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) + TYPE(AD_InputType), INTENT(INOUT) :: u_AD !< The inputs to AeroDyn14 + TYPE(ED_OutputType), INTENT(IN) :: y_ED !< The outputs from the structural dynamics module + TYPE(BeamDyn_Data), INTENT(IN ) :: BD !< BD data at t + TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules + REAL(R8Ki), INTENT(INOUT) :: dUdy(:,:) !< Jacobian matrix of which we are computing the dU^{AD}/dy^{ED} block + + INTEGER(IntKi) :: ErrStat !< Error status of the operation + CHARACTER(*) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + ! Local variables: + + INTEGER(IntKi) :: K ! Loops through blades + INTEGER(IntKi) :: AD_Start ! starting index of dUdy (column) where particular AD fields are located + INTEGER(IntKi) :: ED_Out_Start! starting index of dUdy (row) where particular ED fields are located + INTEGER(IntKi) :: BD_Out_Start! starting index of dUdy (row) where particular BD fields are located + LOGICAL :: FieldMask(FIELDMASK_SIZE) +! INTEGER(IntKi) :: ErrStat2 +! CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'LinearSS_AD_InputSolve_NoIfW_dy' + + + ErrStat = ErrID_None + ErrMsg = "" + + ! Only assemble from the following source fields + FieldMask(MASKID_TRANSLATIONDISP) = .true. + FieldMask(MASKID_ORIENTATION) = .true. + FieldMask(MASKID_TRANSLATIONVEL) = .true. + FieldMask(MASKID_ROTATIONVEL) = .false. + FieldMask(MASKID_TRANSLATIONACC) = .false. + FieldMask(MASKID_ROTATIONACC) = .false. + + !------------------------------------------------------------------------------------------------- + ! Set the inputs from ElastoDyn and/or BeamDyn: + !------------------------------------------------------------------------------------------------- + !................................... + ! blades + !................................... + IF (p_FAST%CompElast == Module_ED ) THEN + + DO k=1,p_FAST%NumBl_Lin !we don't need all blades: size(y_ED%BladeLn2Mesh) + !!! ! This linearization was done in forming dUdu (see Linear_AD_InputSolve_du()), so we don't need to re-calculate these matrices + !!! ! while forming dUdy, too. + !!!CALL Linearize_Line2_to_Line2( y_ED%BladeLn2Mesh(k), u_AD%BladeMotion(k), MeshMapData%BDED_L_2_AD_L_B(k), ErrStat2, ErrMsg2 ) + + AD_Start = SS_Indx_u_AD_Blade_Start(u_AD, p_FAST, y_FAST, k) ! start of u_AD%BladeMotion(k)%TranslationDisp field + ED_Out_Start = SS_Indx_y_ED_Blade_Start(y_ED, p_FAST, y_FAST, k) ! start of y_ED%BladeLn2Mesh(k)%TranslationDisp field + CALL Assemble_dUdy_Motions(y_ED%BladeLn2Mesh(k), u_AD%rotors(1)%BladeMotion(k), MeshMapData%BDED_L_2_AD_L_B(k), AD_Start, ED_Out_Start, dUdy, FieldMask) + + END DO + + ELSEIF (p_FAST%CompElast == Module_BD ) THEN + !!! ! This linearization was done in forming dUdu (see Linear_AD_InputSolve_du()), so we don't need to re-calculate these matrices + !!! ! while forming dUdy, too. + !!!CALL Linearize_Line2_to_Line2( BD%y(k)%BldMotion, u_AD%BladeMotion(k), MeshMapData%BDED_L_2_AD_L_B(k), ErrStat2, ErrMsg2 ) + + DO k=1,p_FAST%NumBl_Lin !we don't need all blades: p_FAST%nBeams + AD_Start = SS_Indx_u_AD_Blade_Start(u_AD, p_FAST, y_FAST, k) ! start of u_AD%BladeMotion(k)%TranslationDisp field + BD_Out_Start = y_FAST%Lin%Modules(Module_BD)%Instance(k)%LinStartIndx(LIN_OUTPUT_COL) + + CALL Assemble_dUdy_Motions(BD%y(k)%BldMotion, u_AD%rotors(1)%BladeMotion(k), MeshMapData%BDED_L_2_AD_L_B(k), AD_Start, BD_Out_Start, dUdy, FieldMask) + END DO + + END IF + + +END SUBROUTINE LinearSS_AD_InputSolve_NoIfW_dy +!---------------------------------------------------------------------------------------------------------------------------------- + +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine returns the starting index for the u_AD%BladeMotion(k) mesh in the FAST linearization inputs. +FUNCTION SS_Indx_u_AD_Blade_Start(u_AD, p_FAST, y_FAST, BladeNum) RESULT(AD_Start) + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< FAST parameter data + TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) + TYPE(AD_InputType), INTENT(IN ) :: u_AD !< AD Inputs at t + INTEGER(IntKi), INTENT(IN ) :: BladeNum !< blade number to find index for + INTEGER :: k !< blade number loop + + INTEGER(IntKi) :: AD_Start !< starting index of this mesh in AeroDyn inputs + + AD_Start = y_FAST%Lin%Modules(Module_AD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) + + do k = 1,min(BladeNum-1,p_FAST%NumBl_Lin) !size(u_AD%BladeMotion)) + AD_Start = AD_Start + u_AD%rotors(1)%BladeMotion(k)%NNodes * 9 ! 3 fields (TranslationDisp, MASKID_Orientation, TranslationVel) with 3 components + end do +END FUNCTION SS_Indx_u_AD_Blade_Start +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine returns the starting index for the y_ED%BladeLn2Mesh(BladeNum) mesh in the FAST linearization outputs. +FUNCTION SS_Indx_y_ED_Blade_Start(y_ED, p_FAST, y_FAST, BladeNum) RESULT(ED_Out_Start) + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< FAST parameter data + TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) + TYPE(ED_OutputType), INTENT(IN ) :: y_ED !< ED outputs at t + INTEGER(IntKi), INTENT(IN ) :: BladeNum !< blade number to find index for + INTEGER :: k !< blade number loop + + INTEGER(IntKi) :: ED_Out_Start !< starting index of this blade mesh in ElastoDyn outputs + + ED_Out_Start = y_FAST%Lin%Modules(MODULE_ED)%Instance(1)%LinStartIndx(LIN_OUTPUT_COL) ! start of y_ED%BladeLn2Mesh(1)%TranslationDisp field (blade motions in y_ED) + if (allocated(y_ED%BladeLn2Mesh)) then + do k = 1,min(BladeNum-1,p_FAST%NumBl_Lin) ! we don't need all blades: SIZE(y_ED%BladeLn2Mesh,1)) ! Loop through all blades (p_ED%NumBl) + ED_Out_Start = ED_Out_Start + y_ED%BladeLn2Mesh(k)%NNodes*12 ! 4 fields with 3 components on each blade + end do + end if + +END FUNCTION SS_Indx_y_ED_Blade_Start +!---------------------------------------------------------------------------------------------------------------------------------- + + + +END MODULE FAST_SS_Solver diff --git a/modules/openfast-library/src/FAST_SS_Subs.f90 b/modules/openfast-library/src/FAST_SS_Subs.f90 new file mode 100644 index 0000000000..c06c67beff --- /dev/null +++ b/modules/openfast-library/src/FAST_SS_Subs.f90 @@ -0,0 +1,323 @@ +!********************************************************************************************************************************** +! FAST_Solver.f90, FAST_Subs.f90, FAST_Lin.f90, and FAST_Mods.f90 make up the FAST glue code in the FAST Modularization Framework. +! FAST_Prog.f90, FAST_Library.f90, FAST_Prog.c are different drivers for this code. +!.................................................................................................................................. +! LICENSING +! Copyright (C) 2013-2016 National Renewable Energy Laboratory +! +! This file is part of FAST. +! +! 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 FAST_SS_Subs + + USE FAST_SS_Solver + + IMPLICIT NONE + + +CONTAINS +!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! DRIVER ROUTINE (runs + ends simulation) +! Put here so that we can call from either stand-alone code or from the ENFAST executable. +!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +SUBROUTINE FAST_RunSteadyStateDriver( Turbine ) + TYPE(FAST_TurbineType), INTENT(INOUT) :: Turbine !< all data for one instance of a turbine + + INTEGER(IntKi) :: ErrStat !< Error status of the operation + CHARACTER(ErrMsgLen) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + ProgName = TRIM(FAST_Ver%Name)//' Steady State' + FAST_Ver%Name = ProgName + + !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + ! initialization + !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + CALL FAST_InitializeSteadyState_T( Turbine, ErrStat, ErrMsg ) + CALL CheckError( ErrStat, ErrMsg, 'during module initialization' ) + + + !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + ! Calculate steady-state solutions: + !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + CALL FAST_SteadyState_T( Turbine, ErrStat, ErrMsg ) + CALL CheckError( ErrStat, ErrMsg, 'during steady-state solve' ) + + !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + ! Clean up and stop + !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + CALL ExitThisProgram_T( Turbine, ErrID_None, .true. ) + + CONTAINS + !............................................................................................................................... + SUBROUTINE CheckError(ErrID,Msg,SimMsg) + ! 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) + CHARACTER(*), INTENT(IN) :: SimMsg ! a message describing the location of the error + + IF ( ErrID /= ErrID_None ) THEN + CALL WrScr( NewLine//TRIM(Msg)//NewLine ) + + IF ( ErrID >= AbortErrLev ) THEN + CALL ExitThisProgram_T( Turbine, ErrID, .true., SimMsg ) + END IF + + END IF + + END SUBROUTINE CheckError +END SUBROUTINE FAST_RunSteadyStateDriver +!---------------------------------------------------------------------------------------------------------------------------------- + +!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! INITIALIZATION ROUTINES +!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +SUBROUTINE FAST_InitializeSteadyState_T( Turbine, ErrStat, ErrMsg ) + TYPE(FAST_TurbineType), INTENT(INOUT) :: Turbine !< all data for one instance of a turbine + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + LOGICAL, PARAMETER :: CompAeroMaps = .true. + REAL(DbKi), PARAMETER :: t_initial = 0.0_DbKi + + Turbine%TurbID = 1 + + CALL FAST_InitializeAll( t_initial, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & + Turbine%ED, Turbine%SED, Turbine%BD, Turbine%SrvD, Turbine%AD, Turbine%ADsk, Turbine%ExtLd, Turbine%IfW, Turbine%ExtInfw, Turbine%SC_DX, & + Turbine%SeaSt, Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & + Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, CompAeroMaps, ErrStat, ErrMsg ) + + call InitFlowField() + +contains + !> AD15 now directly accesses FlowField data from IfW. Since we don't use IfW, we need to manually set the FlowField data + !! NOTE: we deallocate(AD%p%FlowField) at the end of the simulation if CompAeroMaps is true + subroutine InitFlowField() + use InflowWind_IO, only: IfW_SteadyWind_Init + use InflowWind_IO_Types, only: InflowWind_IO_DestroySteady_InitInputType, InflowWind_IO_DestroyWindFileDat + type(Steady_InitInputType) :: InitInp + integer(IntKi) :: SumFileUnit = -1 + type(WindFileDat) :: WFileDat ! throw away data returned form init + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + + allocate(Turbine%AD%p%FlowField) + Turbine%AD%p%FlowField%FieldType = 1 ! Steady wind, init below. + InitInp%RefHt = 100.0_ReKi ! Any value will do here. No exponent, so this doesn't matter + InitInp%HWindSpeed = 8.0_ReKi ! This gets overwritten later before used + InitInp%PLExp = 0.0_ReKi ! no shear used + call IfW_SteadyWind_Init(InitInp, SumFileUnit, Turbine%AD%p%FlowField%Uniform, WFileDat, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'FAST_InitializeSteadyState_T:InitFlowField') + if (ErrStat >= AbortErrLev) deallocate(Turbine%AD%p%FlowField) + + call InflowWind_IO_DestroySteady_InitInputType(InitInp, ErrStat2, ErrMsg2) ! ignore errors here because I'm lazy + call InflowWind_IO_DestroyWindFileDat(WFileDat, ErrStat2, ErrMsg2) ! ignore errors here because I'm lazy + end subroutine +END SUBROUTINE FAST_InitializeSteadyState_T +!---------------------------------------------------------------------------------------------------------------------------------- +!> Routine that calls FAST_Solution for one instance of a Turbine data structure. This is a separate subroutine so that the FAST +!! driver programs do not need to change or operate on the individual module level. +SUBROUTINE FAST_SteadyState_T( Turbine, ErrStat, ErrMsg ) + + TYPE(FAST_TurbineType), INTENT(INOUT) :: Turbine !< all data for one instance of a turbine + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + CALL FAST_SteadyState( Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & + Turbine%ED, Turbine%BD, Turbine%AD, Turbine%MeshMapData, ErrStat, ErrMsg ) + +END SUBROUTINE FAST_SteadyState_T +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine takes data from n_t_global and gets values at n_t_global + 1 +SUBROUTINE FAST_SteadyState(p_FAST, y_FAST, m_FAST, ED, BD, AD, MeshMapData, ErrStat, ErrMsg ) + + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code + TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Output variables for the glue code + TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables + + TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data + TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data + TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data + + TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules + + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + INTEGER(IntKi) :: n_case !< loop counter + REAL(DbKi) :: n_global + REAL(ReKi), ALLOCATABLE :: UnusedAry(:) + REAL(R8Ki), ALLOCATABLE :: Jmat(:,:) + TYPE(FAST_SS_CaseType) :: caseData ! tsr, windSpeed, pitch, and rotor speed for this case + TYPE(FAST_SS_CaseType) :: caseData_try2 ! tsr, windSpeed, pitch, and rotor speed for this case (to try a different operating point first) + + INTEGER(IntKi) :: NStatus + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMSg2 + TYPE(IceD_OutputType), ALLOCATABLE :: y_IceD (:) !< IceDyn outputs (WriteOutput values are subset) + CHARACTER(MaxWrScrLen), PARAMETER :: BlankLine = " " + + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_SteadyState' + + ErrStat = ErrID_None + ErrMsg = "" + + CALL InitSSVariables(p_FAST, y_FAST, m_FAST, ED, BD, AD, MeshMapData, JMat, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + if (ErrStat >= AbortErrLev) then + call Cleanup() + return + end if + + ! how often do we inform the user which case we are on? + NStatus = min( 100, p_FAST%NumSSCases/100 + 1) ! at least 100 every 100 cases or 100 times per simulation + call WrScr(NewLine) + + DO n_case = 1, p_FAST%NumSSCases + + if (mod(n_case,NStatus) == 0 .or. n_case==p_FAST%NumSSCases .or. n_case==1) then + call WrOver( ' Case '//trim(num2lstr(n_case))//' of '//trim(num2lstr(p_FAST%NumSSCases)) ) + end if + + + if (p_FAST%WindSpeedOrTSR==1) then + caseData%windSpeed = p_FAST%WS_TSR(n_case) + caseData%tsr = p_FAST%RotSpeed(n_case) * AD%p%rotors(1)%BEMT%rTipFixMax / caseData%windSpeed + else + caseData%tsr = p_FAST%WS_TSR(n_case) + caseData%windSpeed = p_FAST%RotSpeed(n_case) * AD%p%rotors(1)%BEMT%rTipFixMax / caseData%tsr + end if + caseData%pitch = p_FAST%Pitch(n_case) + caseData%RotSpeed = p_FAST%RotSpeed(n_case) + + ! Call steady-state solve for this pitch and rotor speed + call SolveSteadyState(caseData, Jmat, p_FAST, y_FAST, m_FAST, ED, BD, AD, MeshMapData, ErrStat2, ErrMsg2) + + if (ErrStat2 >= ErrID_Severe) then + ! we didn't converge; let's try a different operating point and see if that helps: + caseData_try2%RotSpeed = caseData%RotSpeed + caseData_try2%Pitch = caseData%Pitch * 0.5_ReKi + caseData_try2%TSR = caseData%TSR * 0.5_ReKi + caseData_try2%WindSpeed = caseData%WindSpeed * 0.5_ReKi + + call WrScr('Retrying case '//trim(num2lstr(n_case))//', first trying to get a better initial guess. Average error is '// & + trim(num2lstr(y_FAST%DriverWriteOutput(SS_Indx_Err)))//'.') + call SolveSteadyState(caseData_try2, Jmat, p_FAST, y_FAST, m_FAST, ED, BD, AD, MeshMapData, ErrStat2, ErrMsg2) + + ! if that worked, try the real case again: + if (ErrStat2 < AbortErrLev) then + call SolveSteadyState(caseData, Jmat, p_FAST, y_FAST, m_FAST, ED, BD, AD, MeshMapData, ErrStat2, ErrMsg2) + call WrOver(BlankLine) + end if + + end if + + if (ErrStat2 > ErrID_None) then + ErrMsg2 = trim(ErrMsg2)//" case "//trim(num2lstr(n_case))//& + ' (tsr='//trim(num2lstr(caseData%tsr))//& + ', wind speed='//trim(num2lstr(caseData%windSpeed))//' m/s'//& + ', pitch='//trim(num2lstr(caseData%pitch*R2D))//' deg'//& + ', rotor speed='//trim(num2lstr(caseData%RotSpeed*RPS2RPM))//' rpm)' + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end if + + !---------------------------------------------------------------------------------------- + ! Write results to file + !---------------------------------------------------------------------------------------- + n_global = real(n_case, DbKi) ! n_global is double-precision so that we can reuse existing code. + + CALL WrOutputLine( n_global, p_FAST, y_FAST, UnusedAry, UnusedAry, ED%y%WriteOutput, UnusedAry, & + AD%y, UnusedAry, UnusedAry, UnusedAry, UnusedAry, UnusedAry, UnusedAry, UnusedAry, & + UnusedAry, UnusedAry, UnusedAry, UnusedAry, y_IceD, BD%y, ErrStat2, ErrMsg2 ) + + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) then + call Cleanup() + return + end if + + + ! in case we have a lot of error messages, let's print the non fatal ones here: + if (ErrStat > ErrID_None) then + call WrScr(trim(ErrMsg)) + call WrScr("") + ErrStat = ErrID_None + ErrMsg = "" + end if + + END DO + +CONTAINS + SUBROUTINE Cleanup() + if (allocated(Jmat)) deallocate(Jmat) + END SUBROUTINE Cleanup + + +END SUBROUTINE FAST_SteadyState +!---------------------------------------------------------------------------------------------------------------------------------- +SUBROUTINE InitSSVariables(p_FAST, y_FAST, m_FAST, ED, BD, AD, MeshMapData, JMat, ErrStat, ErrMsg ) + + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code + TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Output variables for the glue code + TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables + + TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data + TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data + TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data + + TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules + REAL(R8Ki), ALLOCATABLE , INTENT(INOUT) :: Jmat(:,:) !< Matrix for storing Jacobian + + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + INTEGER(IntKi) :: NumBlades !< number of blades + + + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMSg2 + + CHARACTER(*), PARAMETER :: RoutineName = 'SS_InitVariables' + + ErrStat = ErrID_None + ErrMsg = "" + + NumBlades = size(AD%y%rotors(1)%BladeLoad) + + + call AllocAry(Jmat, p_FAST%SizeJac_Opt1(1), p_FAST%SizeJac_Opt1(1), 'Jmat', ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + CALL AllocAry( MeshMapData%Jacobian_pivot, p_FAST%SizeJac_Opt1(1), 'Pivot array for Jacobian LU decomposition', ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + !CALL AllocAry( MeshMapData%HubOrient, 3, 3, NumBlades, 'Hub orientation matrix', ErrStat2, ErrMsg2 ) + ! CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + if (ErrStat >= AbortErrLev) return + + + CALL CopyStatesInputs( p_FAST, ED, BD, AD, ErrStat2, ErrMsg2, MESH_NEWCOPY ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + + +END SUBROUTINE InitSSVariables +!---------------------------------------------------------------------------------------------------------------------------------- +END MODULE FAST_SS_Subs +!---------------------------------------------------------------------------------------------------------------------------------- diff --git a/modules/openfast-library/src/FAST_Solver.f90 b/modules/openfast-library/src/FAST_Solver.f90 index 01138be3f1..90d292fe79 100644 --- a/modules/openfast-library/src/FAST_Solver.f90 +++ b/modules/openfast-library/src/FAST_Solver.f90 @@ -28,20 +28,23 @@ MODULE FAST_Solver USE FAST_ModTypes USE AeroDyn - USE AeroDyn14 + USE AeroDisk + USE ExtLoads USE InflowWind USE ElastoDyn + USE SED USE BeamDyn USE FEAMooring USE MoorDyn USE MAP USE OrcaFlexInterface + USE SeaState USE HydroDyn USE IceDyn USE IceFloe USE ServoDyn USE SubDyn - USE OpenFOAM + USE ExternalInflow Use ExtPtfm_MCKF @@ -51,13 +54,17 @@ MODULE FAST_Solver !---------------------------------------------------------------------------------------------------------------------------------- !> This routine sets the inputs required for BD--using the Option 2 solve method; currently the only inputs solved in this routine !! are the blade distributed loads from AD15; other inputs are solved in option 1. -SUBROUTINE BD_InputSolve( p_FAST, BD, y_AD, u_AD, y_ED, y_SrvD, u_SrvD, MeshMapData, ErrStat, ErrMsg ) +SUBROUTINE BD_InputSolve( p_FAST, BD, y_AD, u_AD, m_ExtLd, y_ExtLd, u_ExtLd, p_ExtLd, y_ED, y_SrvD, u_SrvD, MeshMapData, ErrStat, ErrMsg ) !.................................................................................................................................. TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Glue-code simulation parameters TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BD Inputs at t TYPE(AD_OutputType), INTENT(IN ) :: y_AD !< AeroDyn outputs TYPE(AD_InputType), INTENT(IN ) :: u_AD !< AD inputs (for AD-BD load transfer) + TYPE(ExtLd_MiscVarType), INTENT(INOUT) :: m_ExtLd !< External Misc Var + TYPE(ExtLd_OutputType), INTENT(INOUT) :: y_ExtLd !< External Load outputs + TYPE(ExtLd_InputType), INTENT(IN ) :: u_ExtLd !< External Load inputs (for ExtL-BD load transfer) + TYPE(ExtLd_ParameterType), INTENT(IN ) :: p_ExtLd !< External Load parameters TYPE(ED_OutputType), INTENT(IN ) :: y_ED !< ElastoDyn outputs TYPE(SrvD_OutputType), INTENT(IN ) :: y_SrvD !< ServoDyn outputs TYPE(SrvD_InputType), INTENT(IN ) :: u_SrvD !< ServoDyn Inputs (for SrvD-BD load transfer) @@ -111,7 +118,41 @@ SUBROUTINE BD_InputSolve( p_FAST, BD, y_AD, u_AD, y_ED, y_SrvD, u_SrvD, MeshMapD END DO end if - + + ELSE IF (p_FAST%CompAero == Module_ExtLd ) THEN + + !Get the aerodyn loads first + do K = 1,p_FAST%nBeams ! Loop through all blades + call Transfer_Line2_to_Point( y_AD%rotors(1)%BladeLoad(k), y_ExtLd%BladeLoadAD(k), MeshMapData%AD_L_2_ExtLd_B(k), ErrStat2, ErrMsg2, u_AD%rotors(1)%BladeMotion(k), u_ExtLd%BladeMotion(k) ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + + !Blend the aerodyn loads with the external loads + call ExtLd_ConvertOpDataForOpenFAST(y_ExtLd, u_ExtLd, m_ExtLd, p_ExtLd, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + if (p_FAST%BD_OutputSibling) then + + DO K = 1,p_FAST%nBeams ! Loop through all blades + + CALL Transfer_Point_to_Line2( y_ExtLd%BladeLoad(k), BD%Input(1,k)%DistrLoad, MeshMapData%ExtLd_P_2_BDED_B(k), ErrStat2, ErrMsg2, u_ExtLd%BladeMotion(k), BD%y(k)%BldMotion ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + END DO + + else + DO K = 1,p_FAST%nBeams ! Loop through all blades + + ! need to transfer the BD output blade motions to nodes on a sibling of the BD blade motion mesh: + CALL Transfer_Line2_to_Line2( BD%y(k)%BldMotion, MeshMapData%y_BD_BldMotion_4Loads(k), MeshMapData%BD_L_2_BD_L(k), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + CALL Transfer_Point_to_Line2( y_ExtLd%BladeLoad(k), BD%Input(1,k)%DistrLoad, MeshMapData%ExtLd_P_2_BDED_B(k), ErrStat2, ErrMsg2, u_ExtLd%BladeMotion(k), MeshMapData%y_BD_BldMotion_4Loads(k) ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + END DO + end if + ELSE DO K = 1,p_FAST%nBeams ! Loop through all blades @@ -177,16 +218,20 @@ END SUBROUTINE BD_InputSolve !---------------------------------------------------------------------------------------------------------------------------------- !> This routine sets the inputs required for ED--using the Option 2 solve method. Currently the only inputs not solved in this routine !! are the fields on PlatformPtMesh, which are solved in Option 1. The fields on HubPtLoad are solved in both Option 2 and Option 1. -SUBROUTINE ED_InputSolve( p_FAST, u_ED, y_ED, p_AD14, y_AD14, y_AD, y_SrvD, u_AD, u_SrvD, MeshMapData, ErrStat, ErrMsg ) +SUBROUTINE ED_InputSolve( p_FAST, u_ED, y_ED, y_AD, y_ADsk, y_SrvD, u_AD, u_ADsk, y_ExtLd, m_ExtLd, u_ExtLd, p_ExtLd, u_SrvD, MeshMapData, ErrStat, ErrMsg ) !.................................................................................................................................. TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Glue-code simulation parameters TYPE(ED_InputType), INTENT(INOUT) :: u_ED !< ED Inputs at t TYPE(ED_OutputType), INTENT(IN ) :: y_ED !< ElastoDyn outputs (need translation displacement on meshes for loads mapping) - TYPE(AD14_ParameterType), INTENT(IN ) :: p_AD14 !< AeroDyn14 parameters (a hack because the AD14 meshes aren't set up properly) - TYPE(AD14_OutputType), INTENT(IN ) :: y_AD14 !< AeroDyn14 outputs TYPE(AD_OutputType), INTENT(IN ) :: y_AD !< AeroDyn outputs + TYPE(ADsk_OutputType), INTENT(IN ) :: y_ADsk !< AeroDisk outputs TYPE(AD_InputType), INTENT(IN ) :: u_AD !< AD inputs (for AD-ED load transfer) + TYPE(ADsk_InputType), INTENT(IN ) :: u_ADsk !< ADsk inputs (for ADsk-ED load transfer) + TYPE(ExtLd_OutputType), INTENT(INOUT) :: y_ExtLd !< ExtLoads outputs + TYPE(ExtLd_MiscVarType), INTENT(INOUT) :: m_ExtLd !< ExtLoads misc var + TYPE(ExtLd_InputType), INTENT(IN ) :: u_ExtLd !< ExtLoads inputs (for ExtLoads-ED load transfer) + TYPE(ExtLd_ParameterType), INTENT(IN ) :: p_ExtLd !< ExtLoads parameters (for ExtLoads-ED load transfer) TYPE(SrvD_OutputType), INTENT(IN ) :: y_SrvD !< ServoDyn outputs TYPE(SrvD_InputType), INTENT(IN ) :: u_SrvD !< ServoDyn inputs @@ -214,27 +259,39 @@ SUBROUTINE ED_InputSolve( p_FAST, u_ED, y_ED, p_AD14, y_AD14, y_AD, y_SrvD, u_AD ErrStat = ErrID_None ErrMsg = "" - + + ! ED inputs on hub + if (p_FAST%CompAero == Module_ADsk) then + CALL Transfer_Point_to_Point( y_ADsk%AeroLoads, u_ED%HubPtLoad, MeshMapData%ADsk_P_2_ED_P_H, ErrStat2, ErrMsg2, u_ADsk%HubMotion, y_ED%HubPtMotion ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + endif + ! ED inputs on blade from AeroDyn IF (p_FAST%CompElast == Module_ED) THEN - IF ( p_FAST%CompAero == Module_AD14 ) THEN - - DO K = 1,SIZE(u_ED%BladePtLoads,1) ! Loop through all blades (p_ED%NumBl) - DO J = 1,y_AD14%OutputLoads(K)%Nnodes ! Loop through the blade nodes / elements (p_ED%BldNodes) - - u_ED%BladePtLoads(K)%Force(:,J) = y_AD14%OutputLoads(K)%Force(:,J)*p_AD14%Blade%DR(J) - u_ED%BladePtLoads(K)%Moment(:,J) = y_AD14%OutputLoads(K)%Moment(:,J)*p_AD14%Blade%DR(J) - - END DO !J - END DO !K - ELSEIF ( p_FAST%CompAero == Module_AD ) THEN + IF ( p_FAST%CompAero == Module_AD ) THEN DO K = 1,SIZE(u_ED%BladePtLoads,1) ! Loop through all blades (p_ED%NumBl) CALL Transfer_Line2_to_Point( y_AD%rotors(1)%BladeLoad(k), u_ED%BladePtLoads(k), MeshMapData%AD_L_2_BDED_B(k), ErrStat2, ErrMsg2, u_AD%rotors(1)%BladeMotion(k), y_ED%BladeLn2Mesh(k) ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END DO - + + ELSE IF (p_FAST%CompAero == Module_ExtLd ) THEN + + DO K = 1,SIZE(u_ED%BladePtLoads,1) ! Loop through all blades (p_ED%NumBl) + CALL Transfer_Line2_to_Point( y_AD%rotors(1)%BladeLoad(k), y_ExtLd%BladeLoadAD(k), MeshMapData%AD_L_2_ExtLd_B(k), ErrStat2, ErrMsg2, u_AD%rotors(1)%BladeMotion(k), u_ExtLd%BladeMotion(k) ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + END DO + + call ExtLd_ConvertOpDataForOpenFAST(y_ExtLd, u_ExtLd, m_ExtLd, p_ExtLd, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + DO K = 1,SIZE(u_ED%BladePtLoads,1) ! Loop through all blades (p_ED%NumBl) + ! NOTE - not only is BladeLn2Mesh not a Sbiling of BladePtLoads, it is a line 2 mesh with different number of nodes + CALL Transfer_Point_to_Point( y_ExtLd%BladeLoad(k), u_ED%BladePtLoads(k), MeshMapData%ExtLd_P_2_BDED_B(k), ErrStat2, ErrMsg2, u_ExtLd%BladeMotion(k), y_ED%BladeLn2Mesh(k) ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + END DO + ELSE !p_FAST%CompAero = Module_None DO K = 1,SIZE(u_ED%BladePtLoads,1) ! Loop through all blades (p_ED%NumBl) @@ -249,32 +306,26 @@ SUBROUTINE ED_InputSolve( p_FAST, u_ED, y_ED, p_AD14, y_AD14, y_AD, y_SrvD, u_AD u_ED%TowerPtLoads%Force = 0.0_ReKi u_ED%TowerPtLoads%Moment = 0.0_ReKi - IF ( p_FAST%CompAero == Module_AD14 ) THEN - - ! add aero force to the tower, if it's provided: - IF ( y_AD14%Twr_OutputLoads%Committed ) THEN - - ! we're mapping loads, so we also need the sibling meshes' displacements: - - ! CALL Transfer_Line2_to_Line2( ) - - J = y_AD14%Twr_OutputLoads%NNodes - - IF ( y_AD14%Twr_OutputLoads%FIELDMASK(MASKID_FORCE) ) & - u_ED%TowerPtLoads%Force(:,1:J) = u_ED%TowerPtLoads%Force( :,1:J) + y_AD14%Twr_OutputLoads%Force*p_AD14%TwrProps%TwrNodeWidth(j) - - IF ( y_AD14%Twr_OutputLoads%FIELDMASK(MASKID_MOMENT) ) & - u_ED%TowerPtLoads%Moment(:,1:J) = u_ED%TowerPtLoads%Moment(:,1:J) + y_AD14%Twr_OutputLoads%Moment*p_AD14%TwrProps%TwrNodeWidth(j) - - END IF - - ELSEIF ( p_FAST%CompAero == Module_AD ) THEN + IF ( p_FAST%CompAero == Module_AD ) THEN IF ( y_AD%rotors(1)%TowerLoad%Committed ) THEN CALL Transfer_Line2_to_Point( y_AD%rotors(1)%TowerLoad, u_ED%TowerPtLoads, MeshMapData%AD_L_2_ED_P_T, ErrStat2, ErrMsg2, u_AD%rotors(1)%TowerMotion, y_ED%TowerLn2Mesh ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END IF - + + ELSE IF (p_FAST%CompAero == Module_ExtLd ) THEN + + IF ( y_ExtLd%TowerLoad%Committed ) THEN ! NOTE - not only is TowerLn2Mesh not a Sbiling of TowerPtLoads, it is a line 2 mesh with different number of nodes + call Transfer_Line2_to_point( y_AD%rotors(1)%TowerLoad, y_ExtLd%TowerLoadAD, MeshMapData%AD_L_2_ExtLd_T, ErrStat2, ErrMsg2, u_AD%rotors(1)%TowerMotion, u_ExtLd%TowerMotion ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + call ExtLd_ConvertOpDataForOpenFAST(y_ExtLd, u_ExtLd, m_ExtLd, p_ExtLd, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + CALL Transfer_Point_to_Point( y_ExtLd%TowerLoad, u_ED%TowerPtLoads, MeshMapData%ExtLd_P_2_ED_P_T, ErrStat2, ErrMsg2, u_ExtLd%TowerMotion, y_ED%TowerLn2Mesh ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + END IF + ELSE u_ED%TowerPtLoads%Force = 0.0_ReKi u_ED%TowerPtLoads%Moment = 0.0_ReKi @@ -343,10 +394,10 @@ SUBROUTINE ED_InputSolve( p_FAST, u_ED, y_ED, p_AD14, y_AD14, y_AD, y_SrvD, u_AD IF ( ALLOCATED(y_SrvD%SStCLoadMesh) ) THEN ! Platform do j=1,size(y_SrvD%SStCLoadMesh) IF (y_SrvD%SStCLoadMesh(j)%Committed) THEN - CALL Transfer_Point_to_Point( y_SrvD%SStCLoadMesh(j), MeshMapData%u_ED_PlatformPtMesh, MeshMapData%SStC_P_P_2_ED_P(j), ErrStat2, ErrMsg2, u_SrvD%SStCMotionMesh(j), y_ED%PlatformPtMesh ) + CALL Transfer_Point_to_Point( y_SrvD%SStCLoadMesh(j), MeshMapData%SubstructureLoads_Tmp, MeshMapData%SStC_P_P_2_SubStructure(j), ErrStat2, ErrMsg2, u_SrvD%SStCMotionMesh(j), y_ED%PlatformPtMesh ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat, ErrMsg,RoutineName//':u_ED%PlatformPtMesh' ) - u_ED%PlatformPtMesh%Force = u_ED%PlatformPtMesh%Force + MeshMapData%u_ED_PlatformPtMesh%Force - u_ED%PlatformPtMesh%Moment = u_ED%PlatformPtMesh%Moment + MeshMapData%u_ED_PlatformPtMesh%Moment + u_ED%PlatformPtMesh%Force = u_ED%PlatformPtMesh%Force + MeshMapData%SubstructureLoads_Tmp%Force + u_ED%PlatformPtMesh%Moment = u_ED%PlatformPtMesh%Moment + MeshMapData%SubstructureLoads_Tmp%Moment ENDIF enddo ENDIF @@ -374,7 +425,7 @@ SUBROUTINE ED_InputSolve( p_FAST, u_ED, y_ED, p_AD14, y_AD14, y_AD, y_SrvD, u_AD END IF END IF - IF ( p_FAST%CompAero == Module_AD .and. p_FAST%MHK > 0 .and. .not. (p_FAST%CompElast == Module_BD .and. BD_Solve_Option1)) THEN + IF ( p_FAST%CompAero == Module_AD .and. p_FAST%MHK /= MHK_None .and. .not. (p_FAST%CompElast == Module_BD .and. BD_Solve_Option1)) THEN u_ED%HubPtLoad%Force = 0.0_ReKi u_ED%HubPtLoad%Moment = 0.0_ReKi IF ( u_AD%rotors(1)%HubMotion%Committed ) THEN @@ -406,20 +457,91 @@ SUBROUTINE ED_InputSolve( p_FAST, u_ED, y_ED, p_AD14, y_AD14, y_AD, y_SrvD, u_AD end do end do END IF - end if - END SUBROUTINE ED_InputSolve + + !---------------------------------------------------------------------------------------------------------------------------------- -!> This routine determines the points in space where InflowWind needs to compute wind speeds. -SUBROUTINE IfW_InputSolve( p_FAST, m_FAST, u_IfW, p_IfW, u_AD14, u_AD, OtherSt_AD, y_ED, ErrStat, ErrMsg ) +!> This routine sets the inputs required for SED--using the Option 2 solve method; currently the only input not solved in this routine +!! are the fields on PlatformPtMesh and HubPtLoad, which are solved in option 1. +SUBROUTINE SED_InputSolve( p_FAST, u_SED, y_SED, y_AD, y_ADsk, y_SrvD, u_AD, u_ADsk, u_SrvD, MeshMapData, ErrStat, ErrMsg ) + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Glue-code simulation parameters + TYPE(SED_InputType), INTENT(INOUT) :: u_SED !< SED Inputs at t + TYPE(SED_OutputType), INTENT(INOUT) :: y_SED !< Simplified-ElastoDyn outputs (need translation displacement on meshes for loads mapping) + TYPE(AD_OutputType), INTENT(IN ) :: y_AD !< AeroDyn outputs + TYPE(ADsk_OutputType), INTENT(IN ) :: y_ADsk !< AeroDisk outputs + TYPE(AD_InputType), INTENT(IN ) :: u_AD !< AD inputs (for AD-ED load transfer) + TYPE(ADsk_InputType), INTENT(IN ) :: u_ADsk !< ADsk inputs (for ADsk-ED load transfer) + TYPE(SrvD_OutputType), INTENT(IN ) :: y_SrvD !< ServoDyn outputs + TYPE(SrvD_InputType), INTENT(IN ) :: u_SrvD !< ServoDyn inputs + + TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message + + INTEGER(IntKi) :: k ! Loops through blades + INTEGER(IntKi) :: ErrStat2 ! temporary Error status of the operation + CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None + CHARACTER(*), PARAMETER :: RoutineName = 'SED_InputSolve' + + ErrStat = ErrID_None + ErrMsg = "" + + !----------- + ! Aero Loads + !----------- + u_SED%HubPtLoad%Force = 0.0_ReKi + u_SED%HubPtLoad%Moment = 0.0_ReKi + + if (p_FAST%CompAero == Module_AD) then + + ! AD --> SED hub + do k=1,size(y_AD%rotors(1)%BladeLoad) + !u_BD_RootMotion and y_ED2%HubPtMotion contain the displaced positions for load calculations + CALL Transfer_Line2_to_Point( y_AD%rotors(1)%BladeLoad(k), MeshMapData%u_SED_HubPtLoad, MeshMapData%AD_L_2_SED_P(k), ErrStat2, ErrMsg2, u_AD%rotors(1)%BladeMotion(k), y_SED%HubPtMotion) + if (Failed()) return + u_SED%HubPtLoad%Force = u_SED%HubPtLoad%Force + MeshMapData%u_SED_HubPtLoad%Force + u_SED%HubPtLoad%Moment = u_SED%HubPtLoad%Moment + MeshMapData%u_SED_HubPtLoad%Moment + end do + + elseif (p_FAST%CompAero == Module_ADsk) then + + ! ADsk --> SED hub + CALL Transfer_Point_to_Point( y_ADsk%AeroLoads, u_SED%HubPtLoad, MeshMapData%ADsk_P_2_SED_P_H, ErrStat2, ErrMsg2, u_ADsk%HubMotion, y_SED%HubPtMotion ) + if (Failed()) return + + endif + + !----------- + ! Controls + !----------- + if ( p_FAST%CompServo == Module_SrvD ) then + u_SED%GenTrq = y_SrvD%GenTrq + u_SED%HSSBrTrqC = y_SrvD%HSSBrTrqC + u_SED%BlPitchCom = y_SrvD%BlPitchCom + u_SED%YawPosCom = y_SrvD%YawPosCom + u_SED%YawRateCom = y_SrvD%YawRateCom + endif + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + !if (Failed) call CleanUp() + end function Failed +END SUBROUTINE SED_InputSolve + + +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine determines the points in space where InflowWind needs to compute wind speeds. +SUBROUTINE IfW_InputSolve( p_FAST, m_FAST, u_IfW, p_IfW, u_AD, OtherSt_AD, y_ED,y_SED, ErrStat, ErrMsg ) TYPE(InflowWind_InputType), INTENT(INOUT) :: u_IfW !< The inputs to InflowWind TYPE(InflowWind_ParameterType), INTENT(IN ) :: p_IfW !< The parameters to InflowWind - 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(AD_OtherStateType), INTENT(IN) :: OtherSt_AD !< The wake points from AeroDyn are in here (Free Vortex Wake) TYPE(ED_OutputType), INTENT(IN) :: y_ED !< The outputs of the structural dynamics module (for IfW Lidar) + TYPE(SED_OutputType), INTENT(IN ) :: y_SED !< The outputs of the structural dynamics module (for IfW Lidar) 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 @@ -442,153 +564,39 @@ SUBROUTINE IfW_InputSolve( p_FAST, m_FAST, u_IfW, p_IfW, u_AD14, u_AD, OtherSt_A Node = 0 IF (p_FAST%CompServo == MODULE_SrvD) THEN Node = Node + 1 - u_IfW%PositionXYZ(:,Node) = y_ED%HubPtMotion%Position(:,1) ! undisplaced position. Maybe we want to use the displaced position (y_ED%HubPtMotion%TranslationDisp) at some point in time. - END IF - - IF (p_FAST%CompAero == MODULE_AD14) THEN - - DO K = 1,SIZE(u_AD14%InputMarkers) - DO J = 1,u_AD14%InputMarkers(K)%nnodes !this mesh isn't properly set up (it's got the global [absolute] position and no reference position) - Node = Node + 1 - u_IfW%PositionXYZ(:,Node) = u_AD14%InputMarkers(K)%Position(:,J) - END DO !J = 1,p%BldNodes ! Loop through the blade nodes / elements - END DO !K = 1,p%NumBl - - DO J=1,u_AD14%Twr_InputMarkers%nnodes - Node = Node + 1 - u_IfW%PositionXYZ(:,Node) = u_AD14%Twr_InputMarkers%TranslationDisp(:,J) + u_AD14%Twr_InputMarkers%Position(:,J) - END DO - - ELSEIF (p_FAST%CompAero == MODULE_AD) THEN - - ! Set u_IfW%PositionXYZ needed by AeroDyn (node counter will be incremented) - call AD_SetExternalWindPositions(u_AD, OtherSt_AD, u_IfW%PositionXYZ, node, errStat, errMsg) - + if (p_FAST%CompElast == Module_SED) then + u_IfW%PositionXYZ(:,Node) = y_SED%HubPtMotion%Position(:,1) + else + u_IfW%PositionXYZ(:,Node) = y_ED%HubPtMotion%Position(:,1) ! undisplaced position. Maybe we want to use the displaced position (y_ED%HubPtMotion%TranslationDisp) at some point in time. + endif END IF - - - u_IfW%HubPosition = y_ED%HubPtMotion%Position(:,1) + y_ED%HubPtMotion%TranslationDisp(:,1) - u_IfW%HubOrientation = y_ED%HubPtMotion%Orientation(:,:,1) - - + !FIXME: is DiskVel still used? The following is used in DiskVel calculations + if (p_FAST%CompElast == Module_SED) then + u_IfW%HubPosition = y_SED%HubPtMotion%Position(:,1) + y_SED%HubPtMotion%TranslationDisp(:,1) + u_IfW%HubOrientation = y_SED%HubPtMotion%Orientation(:,:,1) + else + u_IfW%HubPosition = y_ED%HubPtMotion%Position(:,1) + y_ED%HubPtMotion%TranslationDisp(:,1) + u_IfW%HubOrientation = y_ED%HubPtMotion%Orientation(:,:,1) + endif + - IF ( p_FAST%MHK==1 .or. p_FAST%MHK==2 ) THEN + IF ( p_FAST%MHK /= MHK_None ) THEN u_IfW%PositionXYZ(3,:) = u_IfW%PositionXYZ(3,:) + p_FAST%WtrDpth ENDIF END SUBROUTINE IfW_InputSolve -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine sets the AeroDyn wind inflow inputs. -SUBROUTINE AD_InputSolve_IfW( p_FAST, u_AD, y_IfW, y_OpFM, ErrStat, ErrMsg ) - - ! Passed variables - TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< FAST parameter data - TYPE(AD_InputType), INTENT(INOUT) :: u_AD !< The inputs to AeroDyn - TYPE(InflowWind_OutputType), INTENT(IN) :: y_IfW !< The outputs from InflowWind - TYPE(OpFM_OutputType), INTENT(IN) :: y_OpFM !< outputs from the OpenFOAM integration module - - INTEGER(IntKi) :: ErrStat !< Error status of the operation - CHARACTER(*) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - ! Local variables: - - INTEGER(IntKi) :: J ! Loops through nodes / elements. - INTEGER(IntKi) :: K ! Loops through blades. - INTEGER(IntKi) :: NumBl - INTEGER(IntKi) :: NNodes - INTEGER(IntKi) :: node - - - ErrStat = ErrID_None - ErrMsg = "" - - !------------------------------------------------------------------------------------------------- - ! Set the inputs from inflow wind: - !------------------------------------------------------------------------------------------------- - IF (p_FAST%CompInflow == MODULE_IfW) THEN - - if (p_FAST%CompServo == MODULE_SrvD) then - node = 2 - else - node = 1 - end if - - ! Set the external wind from inflowwin into the AeroDyn inputs. Node counter is incremented - call AD_GetExternalWind(u_AD, y_IfW%VelocityUVW, node, errStat, errMsg) - - ELSEIF ( p_FAST%CompInflow == MODULE_OpFM ) THEN - node = 2 !start of inputs to AD15 - - NumBl = size(u_AD%rotors(1)%InflowOnBlade,3) - Nnodes = size(u_AD%rotors(1)%InflowOnBlade,2) - - ! Hub -- first point - if (u_AD%rotors(1)%HubMotion%NNodes > 0) then - u_AD%rotors(1)%InflowOnHub(1) = y_OpFM%u(1) - u_AD%rotors(1)%InflowOnHub(2) = y_OpFM%v(1) - u_AD%rotors(1)%InflowOnHub(3) = y_OpFM%w(1) - else - u_AD%rotors(1)%InflowOnHub = 0.0_ReKi - end if - - do k=1,NumBl - do j=1,Nnodes - u_AD%rotors(1)%InflowOnBlade(1,j,k) = y_OpFM%u(node) - u_AD%rotors(1)%InflowOnBlade(2,j,k) = y_OpFM%v(node) - u_AD%rotors(1)%InflowOnBlade(3,j,k) = y_OpFM%w(node) - node = node + 1 - end do - end do - - if ( allocated(u_AD%rotors(1)%InflowOnTower) ) then - Nnodes = size(u_AD%rotors(1)%InflowOnTower,2) - do j=1,Nnodes - u_AD%rotors(1)%InflowOnTower(1,j) = y_OpFM%u(node) - u_AD%rotors(1)%InflowOnTower(2,j) = y_OpFM%v(node) - u_AD%rotors(1)%InflowOnTower(3,j) = y_OpFM%w(node) - node = node + 1 - end do - end if - - ! Nacelle - if (u_AD%rotors(1)%NacelleMotion%NNodes > 0) then - u_AD%rotors(1)%InflowOnNacelle(1) = y_OpFM%u(node) - u_AD%rotors(1)%InflowOnNacelle(2) = y_OpFM%v(node) - u_AD%rotors(1)%InflowOnNacelle(3) = y_OpFM%w(node) - node = node + 1 - else - u_AD%rotors(1)%InflowOnNacelle = 0.0_ReKi - end if - - ! TailFin - if (u_AD%rotors(1)%TFinMotion%NNodes > 0) then - u_AD%rotors(1)%InflowOnTailFin(1) = y_OpFM%u(node) - u_AD%rotors(1)%InflowOnTailFin(2) = y_OpFM%v(node) - u_AD%rotors(1)%InflowOnTailFin(3) = y_OpFM%w(node) - node = node + 1 - else - u_AD%rotors(1)%InflowOnTailFin = 0.0_ReKi - end if - - ELSE - - u_AD%rotors(1)%InflowOnBlade = 0.0_ReKi ! whole array - - END IF - - -END SUBROUTINE AD_InputSolve_IfW !---------------------------------------------------------------------------------------------------------------------------------- !> This routine sets all the AeroDyn inputs, except for the wind inflow values. -SUBROUTINE AD_InputSolve_NoIfW( p_FAST, u_AD, y_SrvD, y_ED, BD, MeshMapData, ErrStat, ErrMsg ) +SUBROUTINE AD_InputSolve_NoIfW( p_FAST, u_AD, y_SrvD, y_ED, y_SED, BD, MeshMapData, ErrStat, ErrMsg ) ! Passed variables TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< FAST parameter data TYPE(AD_InputType), INTENT(INOUT) :: u_AD !< The inputs to AeroDyn14 TYPE(SrvD_OutputType), INTENT(IN ) :: y_SrvD !< ServoDyn outputs - TYPE(ED_OutputType), INTENT(IN) :: y_ED !< The outputs from the structural dynamics module + TYPE(ED_OutputType), INTENT(IN) :: y_ED !< The outputs from the structural dynamics module ED + TYPE(SED_OutputType), INTENT(IN) :: y_SED !< The outputs from the structural dynamics module SED TYPE(BeamDyn_Data), INTENT(IN) :: BD !< The data from BeamDyn (want the outputs only, but it's in an array) TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules @@ -614,28 +622,50 @@ SUBROUTINE AD_InputSolve_NoIfW( p_FAST, u_AD, y_SrvD, y_ED, BD, MeshMapData, Err !------------------------------------------------------------------------------------------------- ! tower - IF (u_AD%rotors(1)%TowerMotion%Committed) THEN - - CALL Transfer_Line2_to_Line2( y_ED%TowerLn2Mesh, u_AD%rotors(1)%TowerMotion, MeshMapData%ED_L_2_AD_L_T, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName//':u_AD%TowerMotion' ) - + IF (u_AD%rotors(1)%TowerMotion%Committed) then + if (y_SED%TowerLn2Mesh%Committed) then + CALL Transfer_Line2_to_Line2( y_SED%TowerLn2Mesh, u_AD%rotors(1)%TowerMotion, MeshMapData%SED_L_2_AD_L_T, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName//':u_AD%TowerMotion' ) + elseif (y_ED%TowerLn2Mesh%Committed) then + CALL Transfer_Line2_to_Line2( y_ED%TowerLn2Mesh, u_AD%rotors(1)%TowerMotion, MeshMapData%ED_L_2_AD_L_T, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName//':u_AD%TowerMotion' ) + endif END IF ! hub - CALL Transfer_Point_to_Point( y_ED%HubPtMotion, u_AD%rotors(1)%HubMotion, MeshMapData%ED_P_2_AD_P_H, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName//':u_AD%HubMotion' ) + if (p_FAST%CompElast == Module_SED) then + CALL Transfer_Point_to_Point( y_SED%HubPtMotion, u_AD%rotors(1)%HubMotion, MeshMapData%SED_P_2_AD_P_H, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName//':u_AD%HubMotion' ) + else + CALL Transfer_Point_to_Point( y_ED%HubPtMotion, u_AD%rotors(1)%HubMotion, MeshMapData%ED_P_2_AD_P_H, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName//':u_AD%HubMotion' ) + endif ! blade root - DO k=1,size(y_ED%BladeRootMotion) - CALL Transfer_Point_to_Point( y_ED%BladeRootMotion(k), u_AD%rotors(1)%BladeRootMotion(k), MeshMapData%ED_P_2_AD_P_R(k), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName//':u_AD%BladeRootMotion('//trim(num2lstr(k))//')' ) - END DO + if (p_FAST%CompElast == Module_SED) then + DO k=1,size(y_SED%BladeRootMotion) + CALL Transfer_Point_to_Point( y_SED%BladeRootMotion(k), u_AD%rotors(1)%BladeRootMotion(k), MeshMapData%SED_P_2_AD_P_R(k), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName//':u_AD%BladeRootMotion('//trim(num2lstr(k))//')' ) + END DO + else + DO k=1,size(y_ED%BladeRootMotion) + CALL Transfer_Point_to_Point( y_ED%BladeRootMotion(k), u_AD%rotors(1)%BladeRootMotion(k), MeshMapData%ED_P_2_AD_P_R(k), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName//':u_AD%BladeRootMotion('//trim(num2lstr(k))//')' ) + END DO + endif ! blades - IF (p_FAST%CompElast == Module_ED ) THEN + IF (p_FAST%CompElast == Module_SED) THEN + ! get rigid motion from SED + DO k=1,size(u_AD%rotors(1)%BladeMotion) + CALL Transfer_Point_to_Line2( y_SED%BladeRootMotion(k), u_AD%rotors(1)%BladeMotion(k), MeshMapData%SED_P_2_AD_L_B(k), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName//':u_AD%BladeMotion('//trim(num2lstr(k))//')' ) + END DO + + ELSEIF (p_FAST%CompElast == Module_ED ) THEN DO k=1,size(y_ED%BladeLn2Mesh) CALL Transfer_Line2_to_Line2( y_ED%BladeLn2Mesh(k), u_AD%rotors(1)%BladeMotion(k), MeshMapData%BDED_L_2_AD_L_B(k), ErrStat2, ErrMsg2 ) @@ -654,10 +684,13 @@ SUBROUTINE AD_InputSolve_NoIfW( p_FAST, u_AD, y_SrvD, y_ED, BD, MeshMapData, Err ! nacelle IF (u_AD%rotors(1)%NacelleMotion%Committed) THEN - - CALL Transfer_Point_to_Point( y_ED%NacelleMotion, u_AD%rotors(1)%NacelleMotion, MeshMapData%ED_P_2_AD_P_N, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - + if (p_FAST%CompElast == Module_SED) then + CALL Transfer_Point_to_Point( y_SED%NacelleMotion, u_AD%rotors(1)%NacelleMotion, MeshMapData%SED_P_2_AD_P_N, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + else + CALL Transfer_Point_to_Point( y_ED%NacelleMotion, u_AD%rotors(1)%NacelleMotion, MeshMapData%ED_P_2_AD_P_N, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + endif END IF ! Tailfin - Transfer ElastoDyn CM motion to AeroDyn ref point motion @@ -669,7 +702,7 @@ SUBROUTINE AD_InputSolve_NoIfW( p_FAST, u_AD, y_SrvD, y_ED, BD, MeshMapData, Err - ! Set Conrol parameter (i.e. flaps) if using ServoDyn + ! Set Control parameter (i.e. flaps) if using ServoDyn ! bem: This takes in flap deflection for each blade (only one flap deflection angle per blade), ! from ServoDyn (which comes from Bladed style DLL controller) ! Commanded Airfoil UserProp for blade (must be same units as given in AD15 airfoil tables) @@ -686,199 +719,116 @@ SUBROUTINE AD_InputSolve_NoIfW( p_FAST, u_AD, y_SrvD, y_ED, BD, MeshMapData, Err END SUBROUTINE AD_InputSolve_NoIfW !---------------------------------------------------------------------------------------------------------------------------------- -!> This routine sets the AeroDyn14 wind inflow inputs. -SUBROUTINE AD14_InputSolve_IfW( p_FAST, u_AD14, y_IfW, ErrStat, ErrMsg ) -!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, +!> This routine sets all the ExtLoads inputs, except for the wind inflow values. +SUBROUTINE ExtLd_InputSolve_NoIfW( p_FAST, u_ExtLd, p_ExtLd, y_ED, BD, MeshMapData, ErrStat, ErrMsg ) + + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< FAST parameter data + TYPE(ExtLd_InputType), INTENT(INOUT) :: u_ExtLd !< The inputs to ExtLoads + TYPE(ExtLd_ParameterType), INTENT(IN) :: p_ExtLd !< The parameters of ExtLoads + TYPE(ED_OutputType), INTENT(IN) :: y_ED !< The outputs from the structural dynamics module + TYPE(BeamDyn_Data), INTENT(IN) :: BD !< The data from BeamDyn (want the outputs only, but it's in an array) + TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules - ! Passed variables - TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< parameter FAST data - TYPE(AD14_InputType), INTENT(INOUT) :: u_AD14 !< The inputs to AeroDyn14 - TYPE(InflowWind_OutputType), INTENT(IN) :: y_IfW !< The outputs from InflowWind - INTEGER(IntKi) :: ErrStat !< Error status of the operation CHARACTER(*) :: ErrMsg !< Error message if ErrStat /= ErrID_None - ! Local variables: - - INTEGER(IntKi) :: NumBl - INTEGER(IntKi) :: BldNodes + INTEGER(IntKi) :: K ! Loops through blades + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'AD_InputSolve_NoIfW' - ErrStat = ErrID_None ErrMsg = "" - NumBl = SIZE(u_AD14%InputMarkers,1) - BldNodes = u_AD14%InputMarkers(1)%Nnodes - !------------------------------------------------------------------------------------------------- - ! Set the inputs from inflow wind: + ! Set the inputs from ElastoDyn and/or BeamDyn: !------------------------------------------------------------------------------------------------- - IF (p_FAST%CompInflow == MODULE_IfW) THEN - IF (p_FAST%CompServo == MODULE_SrvD) THEN - u_AD14%InflowVelocity = y_IfW%VelocityUVW(:,2:) ! first point is used for ServoDyn input - ELSE - u_AD14%InflowVelocity = y_IfW%VelocityUVW(:,:) - END IF - ELSE - u_AD14%InflowVelocity = 0.0_ReKi ! whole array + + ! tower + IF (u_ExtLd%TowerMotion%Committed) THEN + CALL Transfer_Line2_to_Point( y_ED%TowerLn2Mesh, u_ExtLd%TowerMotion, MeshMapData%ED_L_2_ExtLd_P_T, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName//':u_ExtLd%TowerMotion' ) END IF - - u_AD14%AvgInfVel = y_IfW%DiskVel - - -END SUBROUTINE AD14_InputSolve_IfW -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine sets all the AeroDyn14 inputs, except for the wind inflow values. -!! THIS ROUTINE IS A HACK TO GET THE OUTPUTS FROM ELASTODYN INTO AERODYN14. DO NOT COPY OR USE IN NEW CODE! -SUBROUTINE AD14_InputSolve_NoIfW( p_FAST, u_AD14, y_ED, MeshMapData, ErrStat, ErrMsg ) -!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, - ! Passed variables - TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< parameter FAST data - TYPE(AD14_InputType), INTENT(INOUT) :: u_AD14 !< The inputs to AeroDyn14 - TYPE(ED_OutputType), INTENT(IN) :: y_ED !< The outputs from the structural dynamics module - TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules - - INTEGER(IntKi) :: ErrStat !< Error status of the operation - CHARACTER(*) :: ErrMsg !< Error message if ErrStat /= ErrID_None + ! hub + CALL Transfer_Point_to_Point( y_ED%HubPtMotion, u_ExtLd%HubMotion, MeshMapData%ED_P_2_ExtLd_P_H, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName//':u_ExtLd%HubMotion' ) - ! Local variables: + ! blade root + DO k=1,size(y_ED%BladeRootMotion) + CALL Transfer_Point_to_Point( y_ED%BladeRootMotion(k), u_ExtLd%BladeRootMotion(k), MeshMapData%ED_P_2_ExtLd_P_R(k), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName//':u_ExtLd%BladeRootMotion('//trim(num2lstr(k))//')' ) + END DO - INTEGER(IntKi) :: J ! Loops through nodes / elements. - INTEGER(IntKi) :: K ! Loops through blades. - INTEGER(IntKi) :: NodeNum ! Node number for blade/node on mesh - INTEGER(IntKi) :: NumBl - INTEGER(IntKi) :: BldNodes + ! blades + IF (p_FAST%CompElast == Module_ED ) THEN - - ErrStat = ErrID_None - ErrMsg = "" + DO k=1,size(y_ED%BladeLn2Mesh) + CALL Transfer_Line2_to_Point( y_ED%BladeLn2Mesh(k), u_ExtLd%BladeMotion(k), MeshMapData%BDED_L_2_ExtLd_P_B(k), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName//':u_ExtLd%BladeMotion('//trim(num2lstr(k))//')' ) + END DO - NumBl = SIZE(u_AD14%InputMarkers,1) - BldNodes = u_AD14%InputMarkers(1)%Nnodes - - - !------------------------------------------------------------------------------------------------- - ! Blade positions, orientations, and velocities: - !------------------------------------------------------------------------------------------------- - IF (p_FAST%CompElast == Module_ED) THEN - DO K = 1,NumBl !p%NumBl ! Loop through all blades - - !CALL Transfer_Line2_to_Line2( y_ED%BladeLn2Mesh(K), u_AD%InputMarkers(K), MeshMapData%BDED_L_2_AD_L_B(K), ErrStat, ErrMsg ) - ! IF (ErrStat >= AbortErrLev ) RETURN - - u_AD14%InputMarkers(K)%RotationVel = 0.0_ReKi ! bjj: we don't need this field - - DO J = 1,BldNodes !p%BldNodes ! Loop through the blade nodes / elements + ELSEIF (p_FAST%CompElast == Module_BD ) THEN ! get them from BeamDyn - NodeNum = J ! note that this assumes ED has same discretization as AD - - u_AD14%InputMarkers(K)%Position(:,J) = y_ED%BladeLn2Mesh(K)%TranslationDisp(:,NodeNum) + y_ED%BladeLn2Mesh(K)%Position(:,NodeNum) - u_AD14%InputMarkers(K)%Orientation(:,:,J) = y_ED%BladeLn2Mesh(K)%Orientation(:,:,NodeNum) - u_AD14%InputMarkers(K)%TranslationVel(:,J) = y_ED%BladeLn2Mesh(K)%TranslationVel(:,NodeNum) - u_AD14%InputMarkers(K)%TranslationAcc(:,J) = y_ED%BladeLn2Mesh(K)%TranslationAcc(:,NodeNum) - - END DO !J = 1,p%BldNodes ! Loop through the blade nodes / elements - END DO !K = 1,p%NumBl - ELSE - ! just leave them as the initial guesses? - DO K = 1,NumBl - u_AD14%InputMarkers(K)%RotationVel = 0.0_ReKi - u_AD14%InputMarkers(K)%TranslationVel = 0.0_ReKi - u_AD14%InputMarkers(K)%TranslationAcc = 0.0_ReKi + DO k=1,size(u_ExtLd%BladeMotion) + CALL Transfer_Line2_to_Point( BD%y(k)%BldMotion, u_ExtLd%BladeMotion(k), MeshMapData%BDED_L_2_ExtLd_P_B(k), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName//':u_ExtLd%BladeMotion('//trim(num2lstr(k))//')' ) END DO - + END IF - - !------------------------------------------------------------------------------------------------- - ! Hub positions, orientations, and velocities: - ! (note that these may have to be adjusted in ElastoDyn as AeroDyn gets rewritten) - !------------------------------------------------------------------------------------------------- - u_AD14%TurbineComponents%Hub%Position = y_ED%HubPtMotion14%TranslationDisp(:,1) + y_ED%HubPtMotion14%Position(:,1) - u_AD14%TurbineComponents%Hub%Orientation = y_ED%HubPtMotion14%Orientation(:,:,1) - u_AD14%TurbineComponents%Hub%RotationVel = y_ED%HubPtMotion14%RotationVel(:,1) - - u_AD14%TurbineComponents%Hub%TranslationVel = 0.0_ReKi !bjj we don't need this field - !------------------------------------------------------------------------------------------------- - ! Blade root orientations: - !------------------------------------------------------------------------------------------------- - - DO K=1,NumBl - u_AD14%TurbineComponents%Blade(K)%Orientation = y_ED%BladeRootMotion14%Orientation(:,:,K) - - u_AD14%TurbineComponents%Blade(K)%Position = 0.0_ReKi !bjj we don't need this field - u_AD14%TurbineComponents%Blade(K)%RotationVel = 0.0_ReKi !bjj we don't need this field - u_AD14%TurbineComponents%Blade(K)%TranslationVel = 0.0_ReKi !bjj we don't need this field - END DO - - !------------------------------------------------------------------------------------------------- - ! RotorFurl position, orientation, rotational velocity: - !------------------------------------------------------------------------------------------------- + u_ExtLd%az = y_ED%LSSTipPxa + u_ExtLd%DX_u%bldPitch(:) = y_ED%BlPitch - u_AD14%TurbineComponents%RotorFurl%Position = y_ED%RotorFurlMotion14%TranslationDisp(:,1) + y_ED%RotorFurlMotion14%Position(:,1) - u_AD14%TurbineComponents%RotorFurl%Orientation = y_ED%RotorFurlMotion14%Orientation(:,:,1) - u_AD14%TurbineComponents%RotorFurl%RotationVel = y_ED%RotorFurlMotion14%RotationVel(:,1) - u_AD14%TurbineComponents%RotorFurl%TranslationVel = 0.0_ReKi !bjj we don't need this field - - !------------------------------------------------------------------------------------------------- - ! Nacelle position, orientation, rotational velocity: - !------------------------------------------------------------------------------------------------- + call ExtLd_ConvertInpDataForExtProg(u_ExtLd, p_ExtLd, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - u_AD14%TurbineComponents%Nacelle%Position = y_ED%NacelleMotion%TranslationDisp(:,1) + y_ED%NacelleMotion%Position(:,1) - u_AD14%TurbineComponents%Nacelle%Orientation = y_ED%NacelleMotion%Orientation(:,:,1) - u_AD14%TurbineComponents%Nacelle%RotationVel = y_ED%NacelleMotion%RotationVel(:,1) - u_AD14%TurbineComponents%Nacelle%TranslationVel = 0.0_ReKi !bjj we don't need this field - - !------------------------------------------------------------------------------------------------- - ! Tower base position, rotational velocity: - !------------------------------------------------------------------------------------------------- - - - ! Tower base position should be rT(0) instead of rZ, but AeroDyn needs this for - ! the HubVDue2Yaw calculation: - u_AD14%TurbineComponents%Tower%Position = y_ED%TowerBaseMotion14%TranslationDisp(:,1) + y_ED%TowerBaseMotion14%Position(:,1) - u_AD14%TurbineComponents%Tower%RotationVel = y_ED%TowerBaseMotion14%RotationVel(:,1) - u_AD14%TurbineComponents%Tower%Orientation = 0.0_ReKi !bjj we don't need this field - u_AD14%TurbineComponents%Tower%TranslationVel = 0.0_ReKi !bjj we don't need this field - +END SUBROUTINE ExtLd_InputSolve_NoIfW + +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine sets all the AeroDisk, except for the wind inflow values. +SUBROUTINE ADsk_InputSolve_NoIfW( p_FAST, u_ADsk, y_ED, y_SED, MeshMapData, ErrStat, ErrMsg ) + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< parameter FAST data + TYPE(ADsk_InputType), INTENT(INOUT) :: u_ADsk !< The inputs to AeroDyn14 + TYPE(ED_OutputType), INTENT(IN ) :: y_ED !< The outputs from the structural dynamics module + TYPE(SED_OutputType), INTENT(IN ) :: y_SED !< The outputs from the structural dynamics module + TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules + INTEGER(IntKi), intent( out) :: ErrStat !< Error status of the operation + CHARACTER(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + ErrStat = ErrID_None + ErrMsg = "" !------------------------------------------------------------------------------------------------- - ! Tower mesh info: Twr_InputMarkers - !------------------------------------------------------------------------------------------------- - - IF ( u_AD14%Twr_InputMarkers%Committed ) THEN - - !CALL Transfer_Line2_to_Line2( y_ED%TowerLn2Mesh, u_AD%Twr_InputMarkers, MeshMapData%ED_L_2_AD_L_T, ErrStat, ErrMsg ) - ! IF (ErrStat >= AbortErrLev ) RETURN - - J = u_AD14%Twr_InputMarkers%NNodes - u_AD14%Twr_InputMarkers%TranslationDisp = y_ED%TowerLn2Mesh%TranslationDisp(:,1:J) - u_AD14%Twr_InputMarkers%Orientation = y_ED%TowerLn2Mesh%Orientation (:,:,1:J) - - END IF - + ! Hub positions, orientations, and velocities: !------------------------------------------------------------------------------------------------- - ! If using MulTabLoc feature, set it here: - !------------------------------------------------------------------------------------------------- - - ! u_AD14%MulTabLoc(IElements,IBlades) = ??? - -END SUBROUTINE AD14_InputSolve_NoIfW + if (p_FAST%CompElast == Module_SED) then + CALL Transfer_Point_to_Point( y_SED%HubPtMotion, u_ADsk%HubMotion, MeshMapData%SED_P_2_ADsk_P_H, ErrStat, ErrMsg ) + u_ADsk%RotSpeed = y_SED%RotSpeed + u_ADsk%BlPitch = y_SED%BlPitch(1) ! ADsk only uses collective blade pitch + else + CALL Transfer_Point_to_Point( y_ED%HubPtMotion, u_ADsk%HubMotion, MeshMapData%ED_P_2_ADsk_P_H, ErrStat, ErrMsg ) + u_ADsk%RotSpeed = y_ED%RotSpeed + u_ADsk%BlPitch = y_ED%BlPitch(1) ! ADsk only uses collective blade pitch + endif + +END SUBROUTINE ADsk_InputSolve_NoIfW + !---------------------------------------------------------------------------------------------------------------------------------- !> This routine sets the inputs required for ServoDyn -SUBROUTINE SrvD_InputSolve( p_FAST, m_FAST, u_SrvD, y_ED, y_IfW, y_OpFM, y_BD, y_SD, MeshMapData, ErrStat, ErrMsg ) +SUBROUTINE SrvD_InputSolve( p_FAST, m_FAST, u_SrvD, y_ED, y_SED, y_IfW, y_ExtInfw, p_ExtLd, y_BD, y_SD, MeshMapData, ErrStat, ErrMsg ) !.................................................................................................................................. TYPE(FAST_ParameterType), INTENT(IN) :: p_FAST !< Glue-code simulation parameters TYPE(FAST_MiscVarType), INTENT(IN) :: m_FAST !< Glue-code misc variables (including inputs from external sources like Simulink) TYPE(SrvD_InputType), INTENT(INOUT) :: u_SrvD !< ServoDyn Inputs at t TYPE(ED_OutputType),TARGET, INTENT(IN) :: y_ED !< ElastoDyn outputs + TYPE(SED_OutputType),TARGET, INTENT(IN) :: y_SED !< Simplified-ElastoDyn outputs TYPE(InflowWind_OutputType), INTENT(IN) :: y_IfW !< InflowWind outputs - TYPE(OpFM_OutputType), INTENT(IN) :: y_OpFM !< OpenFOAM outputs + TYPE(ExtInfw_OutputType), INTENT(IN) :: y_ExtInfw !< ExternalInflow outputs + TYPE(ExtLd_ParameterType), INTENT(in) :: p_ExtLd !< Parameters of ExtLoads TYPE(BD_OutputType), INTENT(IN) :: y_BD(:) !< BD Outputs - TYPE(SD_OutputType), INTENT(IN) :: y_SD !< SD Outputs + TYPE(SD_OutputType),TARGET, INTENT(IN) :: y_SD !< SD Outputs TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message @@ -886,14 +836,25 @@ SUBROUTINE SrvD_InputSolve( p_FAST, m_FAST, u_SrvD, y_ED, y_IfW, y_OpFM, y_BD, y INTEGER(IntKi) :: k ! blade loop counter INTEGER(IntKi) :: j ! StC instance counter - TYPE(MeshType), POINTER :: PlatformMotion + TYPE(MeshType), POINTER :: SubStructureMotion + real(ReKi) :: z !< Local 'z' coordinate + real(ReKi) :: u !< Local u velocity + real(ReKi) :: v !< Local v velocity + real(ReKi) :: mean_vel !< Local mean velocity + real(ReKi) :: pi !< Our favorite number INTEGER(IntKi) :: ErrStat2 ! temporary Error status of the operation CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_InputSolve' - - PlatformMotion => y_ED%PlatformPtMesh - + + if (p_FAST%CompElast == Module_SED) then + SubStructureMotion => y_SED%PlatformPtMesh + elseif (p_FAST%CompSub == Module_SD) then + SubStructureMotion => y_SD%y3Mesh + else + SubStructureMotion => y_ED%PlatformPtMesh + endif + ErrStat = ErrID_None ErrMsg = "" @@ -909,10 +870,10 @@ SUBROUTINE SrvD_InputSolve( p_FAST, m_FAST, u_SrvD, y_ED, y_IfW, y_OpFM, y_BD, y if (allocated(y_IfW%lidar%MsrPositionsY)) u_SrvD%MsrPositionsY = y_IfW%lidar%MsrPositionsY if (allocated(y_IfW%lidar%MsrPositionsZ)) u_SrvD%MsrPositionsZ = y_IfW%lidar%MsrPositionsZ - ELSEIF ( p_FAST%CompInflow == Module_OpFM ) THEN + ELSEIF ( p_FAST%CompInflow == Module_ExtInfw ) THEN - u_SrvD%WindDir = ATAN2( y_OpFM%v(1), y_OpFM%u(1) ) - u_SrvD%HorWindV = SQRT( y_OpFM%u(1)**2 + y_OpFM%v(1)**2 ) + u_SrvD%WindDir = ATAN2( y_ExtInfw%v(1), y_ExtInfw%u(1) ) + u_SrvD%HorWindV = SQRT( y_ExtInfw%u(1)**2 + y_ExtInfw%v(1)**2 ) if (allocated(u_SrvD%LidSpeed )) u_SrvD%LidSpeed = 0.0 if (allocated(u_SrvD%MsrPositionsX)) u_SrvD%MsrPositionsX = 0.0 if (allocated(u_SrvD%MsrPositionsY)) u_SrvD%MsrPositionsY = 0.0 @@ -928,67 +889,106 @@ SUBROUTINE SrvD_InputSolve( p_FAST, m_FAST, u_SrvD, y_ED, y_IfW, y_OpFM, y_BD, y if (allocated(u_SrvD%MsrPositionsz)) u_SrvD%MsrPositionsz = 0.0 ENDIF - + if (p_FAST%CompElast == Module_SED) then + ! ServoDyn inputs from combination of InflowWind and ElastoDyn + u_SrvD%YawAngle = y_SED%Yaw !nacelle yaw (platform rigid) + u_SrvD%YawErr = u_SrvD%WindDir - u_SrvD%YawAngle ! the nacelle yaw error estimate (positive about zi-axis) - - ! ServoDyn inputs from combination of InflowWind and ElastoDyn + ! ServoDyn inputs from Simplified-ElastoDyn + u_SrvD%Yaw = y_SED%Yaw !nacelle yaw + u_SrvD%YawRate = y_SED%YawRate + u_SrvD%LSS_Spd = y_SED%RotSpeed + u_SrvD%HSS_Spd = y_SED%HSS_Spd + u_SrvD%RotSpeed = y_SED%RotSpeed + u_SrvD%BlPitch = y_SED%BlPitch - u_SrvD%YawAngle = y_ED%YawAngle !nacelle yaw plus platform yaw - u_SrvD%YawErr = u_SrvD%WindDir - u_SrvD%YawAngle ! the nacelle yaw error estimate (positive about zi-axis) + ! root moments + u_SrvD%RootMxc = 0.0_ReKi ! y_ED%RootMxc ! fixed-size arrays: always size 3 + u_SrvD%RootMyc = 0.0_ReKi ! y_ED%RootMyc ! fixed-size arrays: always size 3 + u_SrvD%YawBrTAxp = 0.0_ReKi ! y_ED%YawBrTAxp + u_SrvD%YawBrTAyp = 0.0_ReKi ! y_ED%YawBrTAyp + u_SrvD%LSSTipPxa = y_SED%LSSTipPxa - ! ServoDyn inputs from ElastoDyn - u_SrvD%Yaw = y_ED%Yaw !nacelle yaw - u_SrvD%YawRate = y_ED%YawRate - u_SrvD%BlPitch = y_ED%BlPitch - u_SrvD%LSS_Spd = y_ED%LSS_Spd - u_SrvD%HSS_Spd = y_ED%HSS_Spd - u_SrvD%RotSpeed = y_ED%RotSpeed - - IF ( p_FAST%CompElast == Module_BD ) THEN + u_SrvD%LSSTipMxa = y_SED%RotTrq + u_SrvD%LSSTipMya = 0.0_ReKi ! y_ED%LSSTipMya + u_SrvD%LSSTipMza = 0.0_ReKi ! y_ED%LSSTipMza + u_SrvD%LSSTipMys = 0.0_ReKi ! y_ED%LSSTipMys + u_SrvD%LSSTipMzs = 0.0_ReKi ! y_ED%LSSTipMzs - ! translate "b" system output from BD into "c" system for SrvD - do k=1,p_FAST%nBeams - u_SrvD%RootMxc(k) = y_BD(k)%RootMxr*COS(y_ED%BlPitch(k)) + y_BD(k)%RootMyr*SIN(y_ED%BlPitch(k)) - u_SrvD%RootMyc(k) = -y_BD(k)%RootMxr*SIN(y_ED%BlPitch(k)) + y_BD(k)%RootMyr*COS(y_ED%BlPitch(k)) - end do - - ELSE - u_SrvD%RootMxc = y_ED%RootMxc ! fixed-size arrays: always size 3 - u_SrvD%RootMyc = y_ED%RootMyc ! fixed-size arrays: always size 3 - END IF - - - u_SrvD%YawBrTAxp = y_ED%YawBrTAxp - u_SrvD%YawBrTAyp = y_ED%YawBrTAyp - u_SrvD%LSSTipPxa = y_ED%LSSTipPxa + u_SrvD%YawBrMyn = 0.0_ReKi ! y_ED%YawBrMyn + u_SrvD%YawBrMzn = 0.0_ReKi ! y_ED%YawBrMzn + u_SrvD%NcIMURAxs = 0.0_ReKi ! y_ED%NcIMURAxs + u_SrvD%NcIMURAys = 0.0_ReKi ! y_ED%NcIMURAys + u_SrvD%NcIMURAzs = 0.0_ReKi ! y_ED%NcIMURAzs - u_SrvD%LSSTipMxa = y_ED%LSSTipMxa - u_SrvD%LSSTipMya = y_ED%LSSTipMya - u_SrvD%LSSTipMza = y_ED%LSSTipMza - u_SrvD%LSSTipMys = y_ED%LSSTipMys - u_SrvD%LSSTipMzs = y_ED%LSSTipMzs - - u_SrvD%YawBrMyn = y_ED%YawBrMyn - u_SrvD%YawBrMzn = y_ED%YawBrMzn - u_SrvD%NcIMURAxs = y_ED%NcIMURAxs - u_SrvD%NcIMURAys = y_ED%NcIMURAys - u_SrvD%NcIMURAzs = y_ED%NcIMURAzs + u_SrvD%RotPwr = y_SED%RotPwr - u_SrvD%RotPwr = y_ED%RotPwr - - u_SrvD%LSShftFxa = y_ED%LSShftFxa - u_SrvD%LSShftFys = y_ED%LSShftFys - u_SrvD%LSShftFzs = y_ED%LSShftFzs - - ! ! ServoDyn inputs from AeroDyn - !IF ( p_FAST%CompAero == Module_AD ) THEN - !ELSE - !END IF - ! + u_SrvD%LSShftFxa = 0.0_ReKi ! y_ED%LSShftFxa + u_SrvD%LSShftFys = 0.0_ReKi ! y_ED%LSShftFys + u_SrvD%LSShftFzs = 0.0_ReKi ! y_ED%LSShftFzs + else + + ! ServoDyn inputs from combination of InflowWind and ElastoDyn + + u_SrvD%YawAngle = y_ED%YawAngle !nacelle yaw plus platform yaw + u_SrvD%YawErr = u_SrvD%WindDir - u_SrvD%YawAngle ! the nacelle yaw error estimate (positive about zi-axis) + + + ! ServoDyn inputs from ElastoDyn + u_SrvD%Yaw = y_ED%Yaw !nacelle yaw + u_SrvD%YawRate = y_ED%YawRate + u_SrvD%BlPitch = y_ED%BlPitch + u_SrvD%LSS_Spd = y_ED%LSS_Spd + u_SrvD%HSS_Spd = y_ED%HSS_Spd + u_SrvD%RotSpeed = y_ED%RotSpeed + + IF ( p_FAST%CompElast == Module_BD ) THEN + + ! translate "b" system output from BD into "c" system for SrvD + do k=1,p_FAST%nBeams + u_SrvD%RootMxc(k) = y_BD(k)%RootMxr*COS(y_ED%BlPitch(k)) + y_BD(k)%RootMyr*SIN(y_ED%BlPitch(k)) + u_SrvD%RootMyc(k) = -y_BD(k)%RootMxr*SIN(y_ED%BlPitch(k)) + y_BD(k)%RootMyr*COS(y_ED%BlPitch(k)) + end do + + ELSE + u_SrvD%RootMxc = y_ED%RootMxc ! fixed-size arrays: always size 3 + u_SrvD%RootMyc = y_ED%RootMyc ! fixed-size arrays: always size 3 + END IF + + + u_SrvD%YawBrTAxp = y_ED%YawBrTAxp + u_SrvD%YawBrTAyp = y_ED%YawBrTAyp + u_SrvD%LSSTipPxa = y_ED%LSSTipPxa + + u_SrvD%LSSTipMxa = y_ED%LSSTipMxa + u_SrvD%LSSTipMya = y_ED%LSSTipMya + u_SrvD%LSSTipMza = y_ED%LSSTipMza + u_SrvD%LSSTipMys = y_ED%LSSTipMys + u_SrvD%LSSTipMzs = y_ED%LSSTipMzs + + u_SrvD%YawBrMyn = y_ED%YawBrMyn + u_SrvD%YawBrMzn = y_ED%YawBrMzn + u_SrvD%NcIMURAxs = y_ED%NcIMURAxs + u_SrvD%NcIMURAys = y_ED%NcIMURAys + u_SrvD%NcIMURAzs = y_ED%NcIMURAzs + + u_SrvD%RotPwr = y_ED%RotPwr + + u_SrvD%LSShftFxa = y_ED%LSShftFxa + u_SrvD%LSShftFys = y_ED%LSShftFys + u_SrvD%LSShftFzs = y_ED%LSShftFzs + + ! ! ServoDyn inputs from AeroDyn + !IF ( p_FAST%CompAero == Module_AD ) THEN + !ELSE + !END IF + ! + endif ! SED/ED + ! Platform motion mesh to pass to DLL -- NOTE: this is only the transition piece motion, and only passed when DLL is used IF (y_ED%PlatformPtMesh%Committed .and. u_SrvD%PtfmMotionMesh%Committed ) THEN CALL Transfer_Point_to_Point( y_ED%PlatformPtMesh, u_SrvD%PtfmMotionMesh, MeshMapData%ED_P_2_SrvD_P_P, ErrStat2, ErrMsg2 ) @@ -1041,13 +1041,10 @@ SUBROUTINE SrvD_InputSolve( p_FAST, m_FAST, u_SrvD, y_ED, y_IfW, y_OpFM, y_BD, y ENDIF ! Platform - IF ( p_FAST%CompServo == Module_SrvD .and. p_FAST%CompSub /= Module_SD ) THEN - call Transfer_ED_to_SStC( u_SrvD, y_ED, MeshMapData, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - ELSE - call Transfer_SD_to_SStC( u_SrvD, y_SD, MeshMapData, ErrStat2, ErrMsg2 ) + IF ( p_FAST%CompSub /= Module_None ) THEN + call Transfer_Substructure_to_SStC( u_SrvD, SubStructureMotion, MeshMapData, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - ENDIF + END IF ! Transfer any cable length info from SD or MD ! --> SrvD, SD, and MD are not setup for this yet. Add here if feedback is ever required @@ -1056,65 +1053,37 @@ SUBROUTINE SrvD_InputSolve( p_FAST, m_FAST, u_SrvD, y_ED, y_IfW, y_OpFM, y_BD, y ! we're going to use the extrapolated values instead of the old values (Simulink inputs are from t, not t+dt) CALL SrvD_SetExternalInputs( p_FAST, m_FAST, u_SrvD ) #endif - + END SUBROUTINE SrvD_InputSolve !---------------------------------------------------------------------------------------------------------------------------------- -!> This routine sets the inputs for the SrvD%SStC mesh motion from ElastoDyn -SUBROUTINE Transfer_ED_to_SStC( u_SrvD, y_ED, MeshMapData, ErrStat, ErrMsg ) -!.................................................................................................................................. - TYPE(SrvD_InputType), INTENT(INOUT) :: u_SrvD !< ServoDyn input - TYPE(ED_OutputType), INTENT(IN ) :: y_ED !< The outputs of the structural dynamics module - TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< data for mapping meshes between modules - 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 ! Generic counter - - ErrStat = ErrID_None - ErrMsg = '' - !---------------------------------------------------------------------------------------------------- - ! Map ElastoDyn platform point mesh motion to ServoDyn/SStC point mesh -- motions - !---------------------------------------------------------------------------------------------------- - ! motions: - IF ( ALLOCATED(u_SrvD%SStCMotionMesh) ) THEN - do j=1,size(u_SrvD%SStCMotionMesh) - IF (u_SrvD%SStCMotionMesh(j)%Committed) THEN - CALL Transfer_Point_to_Point( y_ED%PlatformPtMesh, u_SrvD%SStCMotionMesh(j), MeshMapData%ED_P_2_SStC_P_P(j), ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'Transfer_ED_to_SStC') - ENDIF - enddo - ENDIF -END SUBROUTINE Transfer_ED_to_SStC -!---------------------------------------------------------------------------------------------------------------------------------- !> This routine sets the inputs for the SrvD%SStC mesh motion from SubDyn -SUBROUTINE Transfer_SD_to_SStC( u_SrvD, y_SD, MeshMapData, ErrStat, ErrMsg ) +SUBROUTINE Transfer_Substructure_to_SStC( u_SrvD, SubstructureMotionMesh, MeshMapData, ErrStat, ErrMsg ) !.................................................................................................................................. - TYPE(SrvD_InputType), INTENT(INOUT) :: u_SrvD !< ServoDyn input - TYPE(SD_OutputType), INTENT(IN ) :: y_SD !< The outputs of the structural dynamics module - TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< data for mapping meshes between modules - 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 ! Generic counter + TYPE(SrvD_InputType), INTENT(INOUT) :: u_SrvD !< ServoDyn input + TYPE(MeshType), INTENT(IN ) :: SubstructureMotionMesh !< The outputs of the structural dynamics module + TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< data for mapping meshes between modules + 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 ! Generic counter ErrStat = ErrID_None ErrMsg = '' !---------------------------------------------------------------------------------------------------- - ! Map SubDyn platform point mesh motion to ServoDyn/SStC point mesh -- motions + ! Map SubDyn or ElastoDyn platform point mesh motion to ServoDyn/SStC point mesh -- motions !---------------------------------------------------------------------------------------------------- ! motions: IF ( ALLOCATED(u_SrvD%SStCMotionMesh) ) THEN do j=1,size(u_SrvD%SStCMotionMesh) IF (u_SrvD%SStCMotionMesh(j)%Committed) THEN - CALL Transfer_Point_to_Point( y_SD%y3Mesh, u_SrvD%SStCMotionMesh(j), MeshMapData%SDy3_P_2_SStC_P_P(j), ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'Transfer_SD_to_SStC') + CALL Transfer_Point_to_Point( SubstructureMotionMesh, u_SrvD%SStCMotionMesh(j), MeshMapData%SubStructure_2_SStC_P_P(j), ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'Transfer_Substructure_to_SStC') ENDIF enddo ENDIF -END SUBROUTINE Transfer_SD_to_SStC +END SUBROUTINE Transfer_Substructure_to_SStC !---------------------------------------------------------------------------------------------------------------------------------- !> This routine sets the inputs required for ServoDyn from an external source (Simulink) SUBROUTINE SrvD_SetExternalInputs( p_FAST, m_FAST, u_SrvD ) @@ -1134,7 +1103,7 @@ SUBROUTINE SrvD_SetExternalInputs( p_FAST, m_FAST, u_SrvD ) u_SrvD%ExternalYawRateCom = m_FAST%ExternInput%YawRateCom u_SrvD%ExternalHSSBrFrac = m_FAST%ExternInput%HSSBrFrac - if (ALLOCATED(u_SrvD%ExternalBlPitchCom)) then !there should be no reason this isn't allocated, but OpenFOAM is acting strange... + if (ALLOCATED(u_SrvD%ExternalBlPitchCom)) then !there should be no reason this isn't allocated, but ExternalInflow is acting strange... do i=1,SIZE(u_SrvD%ExternalBlPitchCom) u_SrvD%ExternalBlPitchCom(i) = m_FAST%ExternInput%BlPitchCom(i) end do @@ -1164,9 +1133,9 @@ SUBROUTINE SrvD_SetExternalInputs( p_FAST, m_FAST, u_SrvD ) END SUBROUTINE SrvD_SetExternalInputs !---------------------------------------------------------------------------------------------------------------------------------- !> This routine transfers the SD outputs into inputs required for HD -SUBROUTINE Transfer_SD_to_HD( y_SD, u_HD_W_Mesh, u_HD_M_Mesh, MeshMapData, ErrStat, ErrMsg ) +SUBROUTINE Transfer_SubStructureMotion_to_HD( SubStructureMotionMesh2HD, u_HD_W_Mesh, u_HD_M_Mesh, MeshMapData, ErrStat, ErrMsg ) !.................................................................................................................................. - TYPE(SD_OutputType), INTENT(IN ) :: y_SD !< The outputs of the structural dynamics module + TYPE(MeshType), INTENT(IN ) :: SubStructureMotionMesh2HD !< The outputs of the structural dynamics module TYPE(MeshType), INTENT(INOUT) :: u_HD_W_Mesh !< HydroDyn input mesh (separated here so that we can use temp meshes in ED_SD_HD_InputSolve) TYPE(MeshType), INTENT(INOUT) :: u_HD_M_Mesh !< HydroDyn input mesh (separated here so that we can use temp meshes in ED_SD_HD_InputSolve) TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< data for mapping meshes @@ -1185,19 +1154,19 @@ SUBROUTINE Transfer_SD_to_HD( y_SD, u_HD_W_Mesh, u_HD_M_Mesh, MeshMapData, ErrSt IF ( u_HD_W_Mesh%Committed ) THEN ! These are the motions for the lumped point loads associated viscous drag on the WAMIT body and/or filled/flooded lumped forces of the WAMIT body - CALL Transfer_Point_to_Point( y_SD%y2Mesh, u_HD_W_Mesh, MeshMapData%SD_P_2_HD_W_P, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat, ErrMsg,'Transfer_SD_to_HD (u_HD%WAMITMesh)' ) + CALL Transfer_Point_to_Point( SubStructureMotionMesh2HD, u_HD_W_Mesh, MeshMapData%SubStructure_2_HD_W_P, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat, ErrMsg,'Transfer_SubStructureMotion_to_HD (u_HD%WAMITMesh)' ) END IF IF ( u_HD_M_Mesh%Committed ) THEN ! These are the motions for the lumped point loads associated viscous drag on the WAMIT body and/or filled/flooded lumped forces of the WAMIT body - CALL Transfer_Point_to_Point( y_SD%y2Mesh, u_HD_M_Mesh, MeshMapData%SD_P_2_HD_M_P, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat, ErrMsg,'Transfer_SD_to_HD (u_HD%Morison%Mesh)' ) + CALL Transfer_Point_to_Point( SubStructureMotionMesh2HD, u_HD_M_Mesh, MeshMapData%SubStructure_2_HD_M_P, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat, ErrMsg,'Transfer_SubStructureMotion_to_HD (u_HD%Morison%Mesh)' ) END IF -END SUBROUTINE Transfer_SD_to_HD +END SUBROUTINE Transfer_SubStructureMotion_to_HD !---------------------------------------------------------------------------------------------------------------------------------- !> This routine transfers the platform motion output of the structural module (ED) into inputs required for HD SUBROUTINE Transfer_PlatformMotion_to_HD( PlatformMotion, u_HD, MeshMapData, ErrStat, ErrMsg ) @@ -1220,31 +1189,14 @@ SUBROUTINE Transfer_PlatformMotion_to_HD( PlatformMotion, u_HD, MeshMapData, Err ! This is for case of rigid substructure - !bjj: We do this without all the extra meshcopy/destroy calls with u_mapped because these inputs are only from one mesh - ! Transfer the ED outputs of the platform motions to the HD input of which represents the same data CALL Transfer_Point_to_Point( PlatformMotion, u_HD%PRPMesh, MeshMapData%ED_P_2_HD_PRP_P, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat, ErrMsg,'Transfer_ED_to_HD (u_HD%PRPMesh)' ) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat, ErrMsg,RoutineName//' (u_HD%PRPMesh)' ) - IF ( u_HD%WAMITMesh%Committed ) THEN - - ! These are the motions for the lumped point loads associated the WAMIT body(ies) and include: hydrostatics, radiation memory effect, - ! wave kinematics, additional preload, additional stiffness, additional linear damping, additional quadratic damping, - ! hydrodynamic added mass - - CALL Transfer_Point_to_Point( PlatformMotion, u_HD%WAMITMesh, MeshMapData%ED_P_2_HD_W_P, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat, ErrMsg, RoutineName//' (u_HD%WAMITMesh)' ) - - END IF !WAMIT - - - IF ( u_HD%Morison%Mesh%Committed ) THEN - - ! These are the motions for the lumped point loads associated viscous drag on the WAMIT body and/or filled/flooded lumped forces of the WAMIT body - CALL Transfer_Point_to_Point( PlatformMotion, u_HD%Morison%Mesh, MeshMapData%ED_P_2_HD_M_P, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat, ErrMsg, RoutineName//' (u_HD%Morison%Mesh)' ) - END IF + CALL Transfer_SubStructureMotion_to_HD( PlatformMotion, u_HD%WAMITMesh, u_HD%Morison%Mesh, MeshMapData, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) + END SUBROUTINE Transfer_PlatformMotion_to_HD !---------------------------------------------------------------------------------------------------------------------------------- @@ -1256,6 +1208,7 @@ SUBROUTINE Transfer_SrvD_to_SD_MD( p_FAST, y_SrvD, u_SD, u_MD ) TYPE(SD_InputType), INTENT(INOUT) :: u_SD !< SubDyn input TYPE(MD_InputType), INTENT(INOUT) :: u_MD !< MoorDyn input + if (p_FAST%CompElast == Module_SED) return ! StCs not used with SED if (p_FAST%CompServo /= Module_SrvD) return ! transfer SrvD outputs to other modules used in option 1: @@ -1276,12 +1229,15 @@ SUBROUTINE Transfer_SrvD_to_SD_MD( p_FAST, y_SrvD, u_SD, u_MD ) END SUBROUTINE Transfer_SrvD_to_SD_MD !---------------------------------------------------------------------------------------------------------------------------------- !> This routine transfers the ED outputs into inputs required for HD, SD, ExtPtfm, BD, MAP, and/or FEAM -SUBROUTINE Transfer_ED_to_HD_SD_BD_Mooring( p_FAST, y_ED, u_HD, u_SD, u_ExtPtfm, u_MAP, u_FEAM, u_MD, u_Orca, u_BD, u_SrvD, MeshMapData, ErrStat, ErrMsg ) +!> Note that this also calls SD_CalcOutput if SubDyn and HydroDyn are both used. +SUBROUTINE Transfer_Structure_to_Opt1Inputs( this_time, this_state, p_FAST, y_ED, u_HD, SD, u_ExtPtfm, u_MAP, u_FEAM, u_MD, u_Orca, u_BD, u_SrvD, MeshMapData, ErrStat, ErrMsg ) !.................................................................................................................................. + REAL(DbKi) , intent(in ) :: this_time !< The current simulation time (actual or time of prediction) + INTEGER(IntKi) , intent(in ) :: this_state !< Index into the state array (current or predicted states) TYPE(FAST_ParameterType), INTENT(IN) :: p_FAST !< Glue-code simulation parameters - TYPE(ED_OutputType), INTENT(IN ) :: y_ED !< The outputs of the structural dynamics module + TYPE(ED_OutputType),TARGET, INTENT(IN ) :: y_ED !< The outputs of the structural dynamics module TYPE(HydroDyn_InputType), INTENT(INOUT) :: u_HD !< HydroDyn input - TYPE(SD_InputType), INTENT(INOUT) :: u_SD !< SubDyn input + TYPE(SubDyn_Data), TARGET, INTENT(INOUT) :: SD !< SubDyn data (all data transferred so we can call SD_CalcOutput if necessary) TYPE(ExtPtfm_InputType), INTENT(INOUT) :: u_ExtPtfm !< ExtPtfm_MCKF input TYPE(MAP_InputType), INTENT(INOUT) :: u_MAP !< MAP input TYPE(FEAM_InputType), INTENT(INOUT) :: u_FEAM !< FEAM input @@ -1297,118 +1253,111 @@ SUBROUTINE Transfer_ED_to_HD_SD_BD_Mooring( p_FAST, y_ED, u_HD, u_SD, u_ExtPtfm, ! local variables INTEGER(IntKi) :: ErrStat2 ! temporary Error status of the operation CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None - CHARACTER(*), PARAMETER :: RoutineName = 'Transfer_ED_to_HD_SD_BD_Mooring' + CHARACTER(*), PARAMETER :: RoutineName = 'Transfer_Structure_to_Opt1Inputs' + TYPE(MeshType), POINTER :: PlatformMotion + TYPE(MeshType), POINTER :: SubstructureMotion + TYPE(MeshType), POINTER :: SubstructureMotion2HD ErrStat = ErrID_None ErrMsg = "" + if (p_FAST%CompElast == Module_SED) return ! HD, SD, and BD not used with SED + + PlatformMotion => y_ED%PlatformPtMesh + + IF (p_FAST%CompSub == Module_SD) THEN + SubstructureMotion => SD%y%y3Mesh + SubstructureMotion2HD => SD%y%y2Mesh + ELSE + SubstructureMotion => PlatformMotion + SubstructureMotion2HD => PlatformMotion + ENDIF + ! transfer ED outputs to other modules used in option 1: IF ( p_FAST%CompSub == Module_SD ) THEN ! Map ED (motion) outputs to SD inputs: - CALL Transfer_Point_to_Point( y_ED%PlatformPtMesh, u_SD%TPMesh, MeshMapData%ED_P_2_SD_TP, ErrStat2, ErrMsg2 ) + CALL Transfer_Point_to_Point( PlatformMotion, SD%Input(1)%TPMesh, MeshMapData%ED_P_2_SD_TP, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat, ErrMsg,RoutineName//':u_SD%TPMesh' ) - IF ( p_FAST%CompHydro == Module_HD ) call TransferEDToHD_PRP() + IF ( p_FAST%CompHydro == Module_HD ) THEN ! This call to SD_CalcOutput was added because of some instabilities in the TCF merge (per conversation with ADP in May/June 2021) + CALL SD_CalcOutput( this_time, SD%Input(1), SD%p, SD%x(this_state), SD%xd(this_state), SD%z(this_state), SD%OtherSt(this_state), SD%y, SD%m, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END IF ELSEIF ( p_FAST%CompSub == Module_ExtPtfm ) THEN ! Map ED (motion) outputs to ExtPtfm inputs: - CALL Transfer_Point_to_Point( y_ED%PlatformPtMesh, u_ExtPtfm%PtfmMesh, MeshMapData%ED_P_2_SD_TP, ErrStat2, ErrMsg2 ) + CALL Transfer_Point_to_Point( PlatformMotion, u_ExtPtfm%PtfmMesh, MeshMapData%ED_P_2_SD_TP, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat, ErrMsg,RoutineName//':u_ExtPtfm%PtfmMesh' ) - if ( p_FAST%CompHydro == Module_HD ) then - ! Map ED outputs to HD inputs: - CALL Transfer_PlatformMotion_to_HD( y_ED%PlatformPtMesh, u_HD, MeshMapData, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat, ErrMsg,RoutineName ) - ! TODO: GJH Used to be the following GJH 5/13/2020 - ! call TransferFixedBottomToHD() - end if - - - ELSEIF ( p_FAST%CompHydro == Module_HD ) THEN - ! Map ED outputs to HD inputs: - CALL Transfer_PlatformMotion_to_HD( y_ED%PlatformPtMesh, u_HD, MeshMapData, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat, ErrMsg,RoutineName ) - END IF + IF ( p_FAST%CompHydro == Module_HD ) THEN - - - IF ( p_FAST%CompElast == Module_BD .and. BD_Solve_Option1) THEN - ! map ED root and hub motion outputs to BeamDyn: - CALL Transfer_ED_to_BD(y_ED, u_BD, MeshMapData, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat, ErrMsg,RoutineName ) + CALL Transfer_Point_to_Point( PlatformMotion, u_HD%PRPMesh, MeshMapData%ED_P_2_HD_PRP_P, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat, ErrMsg, RoutineName//' (u_HD%PRPMesh)' ) + ! if we don't have a call to SD_CalcOutput, we need to check that p_FAST%CompSub /= Module_SD before this: + ! IF (p_FAST%CompSub /= Module_SD) THEN + CALL Transfer_SubStructureMotion_to_HD( SubstructureMotion2HD, u_HD%WAMITMesh, u_HD%Morison%Mesh, MeshMapData, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) + !END IF ! don't transfer for SubDyn unless we have called SD_CalcOutput + END IF - - if ( p_FAST%CompSub /= Module_SD ) then + + ! if we don't have a call to SD_CalcOutput, we need to check that p_FAST%CompSub /= Module_SD before this: + ! IF (p_FAST%CompSub /= Module_SD) THEN IF ( p_FAST%CompMooring == Module_MAP ) THEN - !TODO: GJH I do not have plan documentation for the External Platform connection to MAP GJH 8/11/2020 ! motions: - CALL Transfer_Point_to_Point( y_ED%PlatformPtMesh, u_MAP%PtFairDisplacement, MeshMapData%ED_P_2_Mooring_P, ErrStat2, ErrMsg2 ) + CALL Transfer_Point_to_Point( SubstructureMotion, u_MAP%PtFairDisplacement, MeshMapData%Structure_2_Mooring, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat, ErrMsg,RoutineName//'u_MAP%PtFairDisplacement' ) ELSEIF ( p_FAST%CompMooring == Module_MD ) THEN ! motions: - CALL Transfer_Point_to_Point( y_ED%PlatformPtMesh, u_MD%CoupledKinematics(1), MeshMapData%ED_P_2_Mooring_P, ErrStat2, ErrMsg2 ) + CALL Transfer_Point_to_Point( SubstructureMotion, u_MD%CoupledKinematics(1), MeshMapData%Structure_2_Mooring, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat, ErrMsg,RoutineName//'u_MD%CoupledKinematics' ) ELSEIF ( p_FAST%CompMooring == Module_FEAM ) THEN ! motions: - CALL Transfer_Point_to_Point( y_ED%PlatformPtMesh, u_FEAM%PtFairleadDisplacement, MeshMapData%ED_P_2_Mooring_P, ErrStat2, ErrMsg2 ) + CALL Transfer_Point_to_Point( SubstructureMotion, u_FEAM%PtFairleadDisplacement, MeshMapData%Structure_2_Mooring, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat, ErrMsg,RoutineName//'u_FEAM%PtFairleadDisplacement' ) ELSEIF ( p_FAST%CompMooring == Module_Orca ) THEN ! motions: - CALL Transfer_Point_to_Point( y_ED%PlatformPtMesh, u_Orca%PtfmMesh, MeshMapData%ED_P_2_Mooring_P, ErrStat2, ErrMsg2 ) + CALL Transfer_Point_to_Point( PlatformMotion, u_Orca%PtfmMesh, MeshMapData%Structure_2_Mooring, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat, ErrMsg,RoutineName//'u_Orca%PtfmMesh' ) END IF - end if - - + ! Map motions for ServodDyn Structural control (TMD) if used. - IF ( p_FAST%CompServo == Module_SrvD .and. p_FAST%CompSub /= Module_SD ) THEN - call Transfer_ED_to_SStC( u_SrvD, y_ED, MeshMapData, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName//'u_SrvD%SStCMotionMesh') - ENDIF - -contains - subroutine TransferEDToHD_PRP() + ! don't transfer for SubDyn unless we have called SD_CalcOutput + IF ( p_FAST%CompServo == Module_SrvD ) THEN + call Transfer_Substructure_to_SStC( u_SrvD, SubstructureMotion, MeshMapData, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName//'u_SrvD%SStCMotionMesh') + END IF - ! These are the motions for the lumped point loads associated the WAMIT body and include: hydrostatics, radiation memory effect, - ! wave kinematics, additional preload, additional stiffness, additional linear damping, additional quadratic damping, - ! hydrodynamic added mass - - CALL Transfer_Point_to_Point( y_ED%PlatformPtMesh, u_HD%PRPMesh, MeshMapData%ED_P_2_HD_PRP_P, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat, ErrMsg, RoutineName//' (u_HD%PRPMesh)' ) - - end subroutine + !END IF ! don't transfer for SubDyn unless we have called SD_CalcOutput - subroutine TransferFixedBottomToHD() - IF ( u_HD%WAMITMesh%Committed ) THEN -!TODO: GJH Do we still need this? ExtPtfm ? GJH 5/11/2020 - ! These are the motions for the lumped point loads associated the WAMIT body and include: hydrostatics, radiation memory effect, - ! wave kinematics, additional preload, additional stiffness, additional linear damping, additional quadratic damping, - ! hydrodynamic added mass - CALL Transfer_Point_to_Point( y_ED%PlatformPtMesh, u_HD%WAMITMesh, MeshMapData%ED_P_2_HD_W_P, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat, ErrMsg, RoutineName//' (u_HD%Mesh)' ) + IF ( p_FAST%CompElast == Module_BD .and. BD_Solve_Option1) THEN + ! map ED root and hub motion outputs to BeamDyn: + CALL Transfer_ED_to_BD(y_ED, u_BD, MeshMapData, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat, ErrMsg,RoutineName ) + + END IF - END IF !WAMIT - end subroutine -END SUBROUTINE Transfer_ED_to_HD_SD_BD_Mooring + +END SUBROUTINE Transfer_Structure_to_Opt1Inputs !---------------------------------------------------------------------------------------------------------------------------------- !> This routine sets the inputs required for IceFloe. -SUBROUTINE IceFloe_InputSolve( u_IceF, y_SD, MeshMapData, ErrStat, ErrMsg ) +SUBROUTINE IceFloe_InputSolve( u_IceF, SubstructureMotionMesh, MeshMapData, ErrStat, ErrMsg ) !.................................................................................................................................. ! Passed variables TYPE(IceFloe_InputType), INTENT(INOUT) :: u_IceF !< IceFloe input - TYPE(SD_OutputType), INTENT(IN ) :: y_SD !< SubDyn outputs + TYPE(MeshType), INTENT(IN ) :: SubstructureMotionMesh !< Substructure motion (output) mesh TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< data for mapping meshes between modules INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation @@ -1419,17 +1368,17 @@ SUBROUTINE IceFloe_InputSolve( u_IceF, y_SD, MeshMapData, ErrStat, ErrMsg ) ! Map SD outputs to IceFloe inputs !---------------------------------------------------------------------------------------------------- ! motions: - CALL Transfer_Point_to_Point( y_SD%y3Mesh, u_IceF%IceMesh, MeshMapData%SDy3_P_2_IceF_P, ErrStat, ErrMsg ) + CALL Transfer_Point_to_Point( SubstructureMotionMesh, u_IceF%IceMesh, MeshMapData%SDy3_P_2_IceF_P, ErrStat, ErrMsg ) END SUBROUTINE IceFloe_InputSolve !---------------------------------------------------------------------------------------------------------------------------------- !> This routine sets the inputs required for IceFloe. -SUBROUTINE IceD_InputSolve( u_IceD, y_SD, MeshMapData, legNum, ErrStat, ErrMsg ) +SUBROUTINE IceD_InputSolve( u_IceD, SubstructureMotionMesh, MeshMapData, legNum, ErrStat, ErrMsg ) !.................................................................................................................................. ! Passed variables TYPE(IceD_InputType), INTENT(INOUT) :: u_IceD !< IceDyn input - TYPE(SD_OutputType), INTENT(IN ) :: y_SD !< SubDyn outputs + TYPE(MeshType), INTENT(IN ) :: SubstructureMotionMesh !< Substructure motion (output) mesh TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< data for mapping meshes between modules INTEGER(IntKi), INTENT(IN ) :: legNum !< which instance of IceDyn we're using @@ -1441,7 +1390,7 @@ SUBROUTINE IceD_InputSolve( u_IceD, y_SD, MeshMapData, legNum, ErrStat, ErrMsg ) ! Map SD outputs to IceFloe inputs !---------------------------------------------------------------------------------------------------- ! motions: - CALL Transfer_Point_to_Point( y_SD%y3Mesh, u_IceD%PointMesh, MeshMapData%SDy3_P_2_IceD_P(legNum), ErrStat, ErrMsg ) + CALL Transfer_Point_to_Point( SubstructureMotionMesh, u_IceD%PointMesh, MeshMapData%SDy3_P_2_IceD_P(legNum), ErrStat, ErrMsg ) END SUBROUTINE IceD_InputSolve !---------------------------------------------------------------------------------------------------------------------------------- @@ -1522,79 +1471,6 @@ SUBROUTINE Transfer_ED_to_BD_tmp( y_ED, MeshMapData, ErrStat, ErrMsg ) END SUBROUTINE Transfer_ED_to_BD_tmp !---------------------------------------------------------------------------------------------------------------------------------- -!> This routine transfers the HD outputs into inputs required for ED. Note that this *adds* to the values already in -!! u_SD_LMesh (so initialize it before calling this routine). -SUBROUTINE Transfer_HD_to_SD( u_mapped, u_SD_LMesh, u_mapped_positions, y_HD, u_HD_W_Mesh, u_HD_M_Mesh, MeshMapData, ErrStat, ErrMsg ) -!.................................................................................................................................. - TYPE(MeshType), INTENT(INOUT) :: u_mapped !< temporary copy of SD mesh (an argument to avoid another temporary mesh copy) - TYPE(MeshType), INTENT(INOUT) :: u_SD_LMesh !< SD Inputs on LMesh at t (separate so we can call from FullOpt1_InputOutputSolve with temp meshes) - TYPE(MeshType), INTENT(IN ) :: u_mapped_positions !< Mesh sibling of u_mapped, with displaced positions - TYPE(HydroDyn_OutputType), INTENT(IN ) :: y_HD !< HydroDyn outputs - TYPE(MeshType), INTENT(IN ) :: u_HD_W_Mesh !< HydroDyn WAMIT input mesh (separate so we can call from FullOpt1_InputOutputSolve with temp meshes) - TYPE(MeshType), INTENT(IN ) :: u_HD_M_Mesh !< HydroDyn Morison input mesh (separate so we can call from FullOpt1_InputOutputSolve with temp meshes) - - TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message - - ! local variables - INTEGER(IntKi) :: ErrStat2 ! temporary Error status of the operation - CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None - - CHARACTER(*), PARAMETER :: RoutineName = 'Transfer_HD_to_SD' - - ErrStat = ErrID_None - ErrMsg = "" - - !assumes u_SD%LMesh%Committed (i.e., u_SD_LMesh%Committed) - IF ( y_HD%WAMITMesh%Committed ) THEN - ! we're mapping loads, so we also need the sibling meshes' displacements: - CALL Transfer_Point_to_Point( y_HD%WAMITMesh, u_mapped, MeshMapData%HD_W_P_2_SD_P, ErrStat2, ErrMsg2, u_HD_W_Mesh, u_mapped_positions ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - u_SD_LMesh%Force = u_SD_LMesh%Force + u_mapped%Force - u_SD_LMesh%Moment = u_SD_LMesh%Moment + u_mapped%Moment - -#ifdef DEBUG_MESH_TRANSFER - CALL WrScr('********************************************************') - CALL WrScr('**** SD to HD point-to-point (WAMIT) *****') - CALL WrScr('********************************************************') - CALL WriteMappingTransferToFile(u_mapped, u_mapped_positions, u_HD_W_Mesh, y_HD%WAMITMesh,& - MeshMapData%SD_P_2_HD_W_P, MeshMapData%HD_M_P_2_SD_P, & - 'SD_y2_HD_WP_Meshes_t'//TRIM(Num2LStr(0))//'.bin' ) - !print * - !pause - -#endif - END IF - - IF ( y_HD%Morison%Mesh%Committed ) THEN - ! we're mapping loads, so we also need the sibling meshes' displacements: - CALL Transfer_Point_to_Point( y_HD%Morison%Mesh, u_mapped, MeshMapData%HD_M_P_2_SD_P, ErrStat2, ErrMsg2, u_HD_M_Mesh, u_mapped_positions ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - u_SD_LMesh%Force = u_SD_LMesh%Force + u_mapped%Force - u_SD_LMesh%Moment = u_SD_LMesh%Moment + u_mapped%Moment - -#ifdef DEBUG_MESH_TRANSFER - CALL WrScr('********************************************************') - CALL WrScr('**** SD to HD point-to-point (morison) *****') - CALL WrScr('********************************************************') - CALL WriteMappingTransferToFile(u_mapped, u_mapped_positions, u_HD_M_Mesh, y_HD%Morison%Mesh,& - MeshMapData%SD_P_2_HD_M_P, MeshMapData%HD_M_P_2_SD_P, & - 'SD_y2_HD_MP_Meshes_t'//TRIM(Num2LStr(0))//'.bin' ) - !print * - !pause - -#endif - - END IF - - -END SUBROUTINE Transfer_HD_to_SD -!---------------------------------------------------------------------------------------------------------------------------------- !> function to return the size of perturbation in calculating jacobian with finite differences. Currently hard-coded to return 1. REAL(ReKi) FUNCTION GetPerturb(x) REAL(ReKi), INTENT(IN) :: x !< value that we want to perturb @@ -1607,7 +1483,7 @@ END FUNCTION GetPerturb !---------------------------------------------------------------------------------------------------------------------------------- !> This routine performs the Input-Output solve for ED and HD. !! Note that this has been customized for the physics in the problems and is not a general solution. -!! This is only called is there is no substructure model (RIGID substructure) +!! This is only called if there is no substructure model (RIGID substructure) SUBROUTINE ED_HD_InputOutputSolve( this_time, p_FAST, calcJacobian & , u_ED, p_ED, x_ED, xd_ED, z_ED, OtherSt_ED, y_ED, m_ED & , u_HD, p_HD, x_HD, xd_HD, z_HD, OtherSt_HD, y_HD, m_HD & @@ -1983,9 +1859,14 @@ SUBROUTINE U_ED_HD_Residual( y_ED2, y_HD2, u_IN, U_Resid) REAL(ReKi) , INTENT( OUT) :: U_Resid(NumInputs) integer(IntKi) :: j ! Generic counter + TYPE(MeshType), POINTER :: SubstructureMotion TYPE(MeshType), POINTER :: PlatformMotions + TYPE(MeshType), POINTER :: SubstructureMotion2HD - PlatformMotions => y_ED2%PlatformPtMesh + ! SD cannot be used, so these all point to the same place. Using separate variables so they match with values in the full option 1 solve + PlatformMotions => y_ED2%PlatformPtMesh + SubstructureMotion => y_ED2%PlatformPtMesh + SubstructureMotion2HD => y_ED2%PlatformPtMesh ! This is only called is there is no flexible substructure model (RIGID substructure) @@ -1999,57 +1880,58 @@ SUBROUTINE U_ED_HD_Residual( y_ED2, y_HD2, u_IN, U_Resid) IF ( p_FAST%CompMooring == Module_MAP ) THEN ! note: MAP_InputSolve must be called before setting ED loads inputs (so that motions are known for loads [moment] mapping) - CALL Transfer_Point_to_Point( y_ED2%PlatformPtMesh, u_MAP%PtFairDisplacement, MeshMapData%ED_P_2_Mooring_P, ErrStat, ErrMsg ) + CALL Transfer_Point_to_Point( SubstructureMotion, u_MAP%PtFairDisplacement, MeshMapData%Structure_2_Mooring, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL Transfer_Point_to_Point( y_MAP%PtFairleadLoad, MeshMapData%u_ED_PlatformPtMesh, MeshMapData%Mooring_P_2_ED_P, ErrStat2, ErrMsg2, u_MAP%PtFairDisplacement, PlatformMotions ) !u_MAP and y_ED contain the displacements needed for moment calculations + CALL Transfer_Point_to_Point( y_MAP%PtFairleadLoad, MeshMapData%SubstructureLoads_Tmp, MeshMapData%Mooring_2_Structure, ErrStat2, ErrMsg2, u_MAP%PtFairDisplacement, SubstructureMotion ) !u_MAP and y_ED contain the displacements needed for moment calculations CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ELSEIF ( p_FAST%CompMooring == Module_MD ) THEN ! note: MD_InputSolve must be called before setting ED loads inputs (so that motions are known for loads [moment] mapping) - CALL Transfer_Point_to_Point( y_ED2%PlatformPtMesh, u_MD%CoupledKinematics(1), MeshMapData%ED_P_2_Mooring_P, ErrStat, ErrMsg ) + CALL Transfer_Point_to_Point( SubstructureMotion, u_MD%CoupledKinematics(1), MeshMapData%Structure_2_Mooring, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL Transfer_Point_to_Point( y_MD%CoupledLoads(1), MeshMapData%u_ED_PlatformPtMesh, MeshMapData%Mooring_P_2_ED_P, ErrStat2, ErrMsg2, u_MD%CoupledKinematics(1), PlatformMotions ) !u_MD and y_ED contain the displacements needed for moment calculations + CALL Transfer_Point_to_Point( y_MD%CoupledLoads(1), MeshMapData%SubstructureLoads_Tmp, MeshMapData%Mooring_2_Structure, ErrStat2, ErrMsg2, u_MD%CoupledKinematics(1), SubstructureMotion ) !u_MD and y_ED contain the displacements needed for moment calculations CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ELSEIF ( p_FAST%CompMooring == Module_FEAM ) THEN ! note: FEAM_InputSolve must be called before setting ED loads inputs (so that motions are known for loads [moment] mapping) - CALL Transfer_Point_to_Point( y_ED2%PlatformPtMesh, u_FEAM%PtFairleadDisplacement, MeshMapData%ED_P_2_Mooring_P, ErrStat, ErrMsg ) + CALL Transfer_Point_to_Point( SubstructureMotion, u_FEAM%PtFairleadDisplacement, MeshMapData%Structure_2_Mooring, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL Transfer_Point_to_Point( y_FEAM%PtFairleadLoad, MeshMapData%u_ED_PlatformPtMesh, MeshMapData%Mooring_P_2_ED_P, ErrStat2, ErrMsg2, u_FEAM%PtFairleadDisplacement, PlatformMotions ) !u_FEAM and y_ED contain the displacements needed for moment calculations + CALL Transfer_Point_to_Point( y_FEAM%PtFairleadLoad, MeshMapData%SubstructureLoads_Tmp, MeshMapData%Mooring_2_Structure, ErrStat2, ErrMsg2, u_FEAM%PtFairleadDisplacement, SubstructureMotion ) !u_FEAM and y_ED contain the displacements needed for moment calculations CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ELSE - MeshMapData%u_ED_PlatformPtMesh%Force = 0.0_ReKi - MeshMapData%u_ED_PlatformPtMesh%Moment = 0.0_ReKi + MeshMapData%SubstructureLoads_Tmp%Force = 0.0_ReKi + MeshMapData%SubstructureLoads_Tmp%Moment = 0.0_ReKi END IF - ! add farm-level mooring loads if applicable >>> note: not yet set up for SubDyn <<< + ! add farm-level mooring loads if applicable >>> note: these are fixed loads from the previous time step <<< IF (p_FAST%FarmIntegration) THEN - MeshMapData%u_ED_PlatformPtMesh%Force = MeshMapData%u_ED_PlatformPtMesh%Force + MeshMapData%u_ED_PlatformPtMesh_MDf%Force - MeshMapData%u_ED_PlatformPtMesh%Moment = MeshMapData%u_ED_PlatformPtMesh%Moment + MeshMapData%u_ED_PlatformPtMesh_MDf%Moment + MeshMapData%SubstructureLoads_Tmp%Force = MeshMapData%SubstructureLoads_Tmp%Force + MeshMapData%SubstructureLoads_Tmp_Farm%Force + MeshMapData%SubstructureLoads_Tmp%Moment = MeshMapData%SubstructureLoads_Tmp%Moment + MeshMapData%SubstructureLoads_Tmp_Farm%Moment END IF - + ! Map motions for ServodDyn Structural control (TMD) if used and forces from the TMD to the platform IF ( p_FAST%CompServo == Module_SrvD .and. p_FAST%CompSub /= Module_SD ) THEN - call Transfer_ED_to_SStC( u_SrvD, y_ED, MeshMapData, ErrStat2, ErrMsg2 ) + call Transfer_Substructure_to_SStC( u_SrvD, SubstructureMotion, MeshMapData, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName//'u_SrvD%SStC%Mesh') + ! we're mapping loads, so we also need the sibling meshes' displacements: IF ( ALLOCATED(y_SrvD%SStCLoadMesh) ) THEN ! Platform do j=1,size(y_SrvD%SStCLoadMesh) IF (y_SrvD%SStCLoadMesh(j)%Committed) THEN - CALL Transfer_Point_to_Point( y_SrvD%SStCLoadMesh(j), MeshMapData%u_ED_PlatformPtMesh_2, MeshMapData%SStC_P_P_2_ED_P(j), ErrStat2, ErrMsg2, u_SrvD%SStCMotionMesh(j), PlatformMotions ) + CALL Transfer_Point_to_Point( y_SrvD%SStCLoadMesh(j), MeshMapData%SubstructureLoads_Tmp2, MeshMapData%SStC_P_P_2_SubStructure(j), ErrStat2, ErrMsg2, u_SrvD%SStCMotionMesh(j), SubstructureMotion ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat, ErrMsg,RoutineName//':u_ED%PlatformPtMesh' ) - MeshMapData%u_ED_PlatformPtMesh%Force = MeshMapData%u_ED_PlatformPtMesh%Force + MeshMapData%u_ED_PlatformPtMesh_2%Force - MeshMapData%u_ED_PlatformPtMesh%Moment = MeshMapData%u_ED_PlatformPtMesh%Moment + MeshMapData%u_ED_PlatformPtMesh_2%Moment + MeshMapData%SubstructureLoads_Tmp%Force = MeshMapData%SubstructureLoads_Tmp%Force + MeshMapData%SubstructureLoads_Tmp2%Force + MeshMapData%SubstructureLoads_Tmp%Moment = MeshMapData%SubstructureLoads_Tmp%Moment + MeshMapData%SubstructureLoads_Tmp2%Moment ENDIF enddo ENDIF @@ -2058,34 +1940,32 @@ SUBROUTINE U_ED_HD_Residual( y_ED2, y_HD2, u_IN, U_Resid) ! we use copies of the input meshes (we don't need to update values in the original data structures): -!bjj: why don't we update u_HD2 here? shouldn't we update before using it to transfer the loads? + ! Need to transfer motions first + CALL Transfer_SubStructureMotion_to_HD( SubstructureMotion2HD, MeshMapData%u_HD_W_Mesh, MeshMapData%u_HD_M_Mesh, MeshMapData, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + if ( y_HD2%WAMITMesh%Committed ) then - ! Need to transfer motions first - CALL Transfer_Point_to_Point( PlatformMotions, MeshMapData%u_HD_W_Mesh, MeshMapData%ED_P_2_HD_W_P, ErrStat2, ErrMsg2) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ! we're mapping loads, so we also need the sibling meshes' displacements: - CALL Transfer_Point_to_Point( y_HD2%WAMITMesh, MeshMapData%u_ED_PlatformPtMesh_2, MeshMapData%HD_W_P_2_ED_P, ErrStat2, ErrMsg2, MeshMapData%u_HD_W_Mesh, PlatformMotions) !u_HD and u_mapped_positions contain the displaced positions for load calculations + CALL Transfer_Point_to_Point( y_HD2%WAMITMesh, MeshMapData%SubstructureLoads_Tmp2, MeshMapData%HD_W_P_2_SubStructure, ErrStat2, ErrMsg2, MeshMapData%u_HD_W_Mesh, SubstructureMotion2HD) !u_HD_W_Mesh and SubStructureMotions contain the displaced positions for load calculations CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - MeshMapData%u_ED_PlatformPtMesh%Force = MeshMapData%u_ED_PlatformPtMesh%Force + MeshMapData%u_ED_PlatformPtMesh_2%Force - MeshMapData%u_ED_PlatformPtMesh%Moment = MeshMapData%u_ED_PlatformPtMesh%Moment + MeshMapData%u_ED_PlatformPtMesh_2%Moment - end if + MeshMapData%SubstructureLoads_Tmp%Force = MeshMapData%SubstructureLoads_Tmp%Force + MeshMapData%SubstructureLoads_Tmp2%Force + MeshMapData%SubstructureLoads_Tmp%Moment = MeshMapData%SubstructureLoads_Tmp%Moment + MeshMapData%SubstructureLoads_Tmp2%Moment + end if + if ( y_HD2%Morison%Mesh%Committed ) then - ! Need to transfer motions first - CALL Transfer_Point_to_Point( PlatformMotions, MeshMapData%u_HD_M_Mesh, MeshMapData%ED_P_2_HD_M_P, ErrStat2, ErrMsg2) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ! we're mapping loads, so we also need the sibling meshes' displacements: - CALL Transfer_Point_to_Point( y_HD2%Morison%Mesh, MeshMapData%u_ED_PlatformPtMesh_2, MeshMapData%HD_M_P_2_ED_P, ErrStat2, ErrMsg2, MeshMapData%u_HD_M_Mesh, PlatformMotions) !u_HD and u_mapped_positions contain the displaced positions for load calculations + CALL Transfer_Point_to_Point( y_HD2%Morison%Mesh, MeshMapData%SubstructureLoads_Tmp2, MeshMapData%HD_M_P_2_SubStructure, ErrStat2, ErrMsg2, MeshMapData%u_HD_M_Mesh, SubStructureMotion2HD) !u_HD_W_Mesh and SubStructureMotions contain the displaced positions for load calculations CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - MeshMapData%u_ED_PlatformPtMesh%Force = MeshMapData%u_ED_PlatformPtMesh%Force + MeshMapData%u_ED_PlatformPtMesh_2%Force - MeshMapData%u_ED_PlatformPtMesh%Moment = MeshMapData%u_ED_PlatformPtMesh%Moment + MeshMapData%u_ED_PlatformPtMesh_2%Moment - end if - U_Resid( 1: 3) = u_in( 1: 3) - MeshMapData%u_ED_PlatformPtMesh%Force(:,1) / p_FAST%UJacSclFact - U_Resid( 4: 6) = u_in( 4: 6) - MeshMapData%u_ED_PlatformPtMesh%Moment(:,1) / p_FAST%UJacSclFact + MeshMapData%SubstructureLoads_Tmp%Force = MeshMapData%SubstructureLoads_Tmp%Force + MeshMapData%SubstructureLoads_Tmp2%Force + MeshMapData%SubstructureLoads_Tmp%Moment = MeshMapData%SubstructureLoads_Tmp%Moment + MeshMapData%SubstructureLoads_Tmp2%Moment + end if + + U_Resid( 1: 3) = u_in( 1: 3) - MeshMapData%SubstructureLoads_Tmp%Force(:,1) / p_FAST%UJacSclFact + U_Resid( 4: 6) = u_in( 4: 6) - MeshMapData%SubstructureLoads_Tmp%Moment(:,1) / p_FAST%UJacSclFact + ! note that PlatformMotions is the same as SubstructureMotion and SubstructureMotion2HD in this simplified option 1 solve: U_Resid( 7: 9) = u_in( 7: 9) - PlatformMotions%TranslationAcc(:,1) U_Resid(10:12) = u_in(10:12) - PlatformMotions%RotationAcc(:,1) @@ -2109,7 +1989,7 @@ SUBROUTINE CleanUp() CALL HydroDyn_DestroyInput( u_HD_perturb, ErrStat3, ErrMsg3 ) IF (ErrStat3 /= ErrID_None) CALL WrScr(RoutineName//'/HydroDyn_DestroyInput: '//TRIM(ErrMsg3) ) CALL HydroDyn_DestroyOutput(y_HD_perturb, ErrStat3, ErrMsg3 ) - IF (ErrStat3 /= ErrID_None) CALL WrScr(RoutineName//'/HydroDyn_DestroyOutput: '//TRIM(ErrMsg3) ) + IF (ErrStat3 /= ErrID_None) CALL WrScr(RoutineName//'/HydroDyn_DestroyOutput: '//TRIM(ErrMsg3) ) END IF @@ -2176,7 +2056,7 @@ SUBROUTINE FullOpt1_InputOutputSolve( this_time, p_FAST, calcJacobian & TYPE(SD_OtherStateType) , INTENT(IN ) :: OtherSt_SD !< Other states TYPE(SD_ParameterType) , INTENT(IN ) :: p_SD !< Parameters TYPE(SD_InputType) , INTENT(INOUT) :: u_SD !< System inputs - TYPE(SD_OutputType) , INTENT(INOUT) :: y_SD !< System outputs + TYPE(SD_OutputType), TARGET , INTENT(INOUT) :: y_SD !< System outputs TYPE(SD_MiscVarType) , INTENT(INOUT) :: m_SD !< misc/optimization variables !ExtPtfm: @@ -2228,7 +2108,7 @@ SUBROUTINE FullOpt1_InputOutputSolve( this_time, p_FAST, calcJacobian & TYPE(AD_OutputType), INTENT(IN ) :: y_AD !< The outputs to AeroDyn14 TYPE(AD_InputType), INTENT(INOUT) :: u_AD !< The inputs to AeroDyn15 - TYPE(FAST_ModuleMapType) , INTENT(INOUT) :: MeshMapData !< data for mapping meshes between modules + TYPE(FAST_ModuleMapType), TARGET , INTENT(INOUT) :: MeshMapData !< data for mapping meshes between modules INTEGER(IntKi) , INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*) , INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None LOGICAL , INTENT(IN ) :: WriteThisStep !< Will we print the WriteOutput values this step? @@ -2266,7 +2146,9 @@ SUBROUTINE FullOpt1_InputOutputSolve( this_time, p_FAST, calcJacobian & INTEGER(IntKi) :: ErrStat2 ! temporary Error status of the operation CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None - TYPE(MeshType), POINTER :: PlatformMotionMesh + TYPE(MeshType), POINTER :: PlatformMotionMesh_1 + TYPE(MeshType), POINTER :: SubStructureMotionMesh_1 + TYPE(MeshType), POINTER :: SubStructureMotionMesh2HD_1 #ifdef OUTPUT_ADDEDMASS REAL(ReKi) :: AddedMassMatrix(6,6) @@ -2359,7 +2241,7 @@ SUBROUTINE FullOpt1_InputOutputSolve( this_time, p_FAST, calcJacobian & call MeshCopy( u_BD(nb)%RootMotion, MeshMapData%u_BD_RootMotion(nb), MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO - + CALL Create_FullOpt1_UVector(u, u_ED%PlatformPtMesh, u_SD%TPMesh, u_SD%LMesh, & u_HD%Morison%Mesh, u_HD%WAMITMesh, u_ED%HubPtLoad, MeshMapData%u_BD_RootMotion, u_Orca%PtfmMesh, & u_ExtPtfm%PtfmMesh, p_FAST ) @@ -2782,7 +2664,15 @@ SUBROUTINE FullOpt1_InputOutputSolve( this_time, p_FAST, calcJacobian & ! This is effectively doing option 2, where we set the input velocities and displacements based on the outputs we just calculated !............................................... - PlatformMotionMesh => y_ED%PlatformPtMesh + PlatformMotionMesh_1 => y_ED%PlatformPtMesh + if (p_FAST%CompSub == MODULE_SD) then + SubStructureMotionMesh_1 => y_SD%y3Mesh + SubStructureMotionMesh2HD_1 => y_SD%y2Mesh + + else + SubStructureMotionMesh_1 => y_ED%PlatformPtMesh + SubStructureMotionMesh2HD_1 => y_ED%PlatformPtMesh + end if ! BD motion inputs: (from ED) @@ -2821,26 +2711,13 @@ SUBROUTINE FullOpt1_InputOutputSolve( this_time, p_FAST, calcJacobian & MeshMapData%u_HD_W_Mesh%TranslationAcc = u_HD%WAMITMesh%TranslationAcc ENDIF - ! transfer the output data to inputs - - IF ( p_FAST%CompSub == Module_SD ) THEN - ! Map SD outputs to HD inputs (keeping the accelerations we just calculated) - - CALL Transfer_SD_to_HD( y_SD, u_HD%WAMITMesh, u_HD%Morison%Mesh, MeshMapData, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ! transfer the output data from ED and/or SD to inputs + CALL Transfer_Point_to_Point( PlatformMotionMesh_1, u_HD%PRPMesh, MeshMapData%ED_P_2_HD_PRP_P, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ! Map ED outputs to HD inputs (keeping the accelerations we just calculated): + CALL Transfer_SubStructureMotion_to_HD( SubStructureMotionMesh2HD_1, u_HD%WAMITMesh, u_HD%Morison%Mesh, MeshMapData, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) - ! Transfer the ED outputs of the platform motions to the HD input of which represents the same data - CALL Transfer_Point_to_Point( PlatformMotionMesh, u_HD%PRPMesh, MeshMapData%ED_P_2_HD_PRP_P, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat, ErrMsg, RoutineName ) - - ELSE - - CALL Transfer_PlatformMotion_to_HD( PlatformMotionMesh, u_HD, MeshMapData, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - END IF ! put the acceleration data (calucluted in this routine) back @@ -2850,8 +2727,8 @@ SUBROUTINE FullOpt1_InputOutputSolve( this_time, p_FAST, calcJacobian & ENDIF IF (MeshMapData%u_HD_W_Mesh%Committed) THEN - u_HD%WAMITMesh%RotationAcc = MeshMapData%u_HD_W_Mesh%RotationAcc - u_HD%WAMITMesh%TranslationAcc = MeshMapData%u_HD_W_Mesh%TranslationAcc + u_HD%WAMITMesh%RotationAcc = MeshMapData%u_HD_W_Mesh%RotationAcc + u_HD%WAMITMesh%TranslationAcc = MeshMapData%u_HD_W_Mesh%TranslationAcc ENDIF !...... @@ -2867,7 +2744,7 @@ SUBROUTINE FullOpt1_InputOutputSolve( this_time, p_FAST, calcJacobian & MeshMapData%u_SD_TPMesh%RotationAcc = u_SD%TPMesh%RotationAcc MeshMapData%u_SD_TPMesh%TranslationAcc = u_SD%TPMesh%TranslationAcc - CALL Transfer_Point_to_Point( PlatformMotionMesh, u_SD%TPMesh, MeshMapData%ED_P_2_SD_TP, ErrStat2, ErrMsg2 ) + CALL Transfer_Point_to_Point( PlatformMotionMesh_1, u_SD%TPMesh, MeshMapData%ED_P_2_SD_TP, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -2883,7 +2760,7 @@ SUBROUTINE FullOpt1_InputOutputSolve( this_time, p_FAST, calcJacobian & MeshMapData%u_ExtPtfm_PtfmMesh%RotationAcc = u_ExtPtfm%PtfmMesh%RotationAcc MeshMapData%u_ExtPtfm_PtfmMesh%TranslationAcc = u_ExtPtfm%PtfmMesh%TranslationAcc - CALL Transfer_Point_to_Point( PlatformMotionMesh, u_ExtPtfm%PtfmMesh, MeshMapData%ED_P_2_SD_TP, ErrStat2, ErrMsg2 ) + CALL Transfer_Point_to_Point( PlatformMotionMesh_1, u_ExtPtfm%PtfmMesh, MeshMapData%ED_P_2_SD_TP, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) u_ExtPtfm%PtfmMesh%RotationAcc = MeshMapData%u_ExtPtfm_PtfmMesh%RotationAcc @@ -2900,7 +2777,7 @@ SUBROUTINE FullOpt1_InputOutputSolve( this_time, p_FAST, calcJacobian & MeshMapData%u_Orca_PtfmMesh%RotationAcc = u_Orca%PtfmMesh%RotationAcc MeshMapData%u_Orca_PtfmMesh%TranslationAcc = u_Orca%PtfmMesh%TranslationAcc - CALL Transfer_Point_to_Point( PlatformMotionMesh, u_Orca%PtfmMesh, MeshMapData%ED_P_2_Mooring_P, ErrStat2, ErrMsg2 ) + CALL Transfer_Point_to_Point( PlatformMotionMesh_1, u_Orca%PtfmMesh, MeshMapData%Structure_2_Mooring, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) u_Orca%PtfmMesh%RotationAcc = MeshMapData%u_Orca_PtfmMesh%RotationAcc @@ -2919,7 +2796,7 @@ SUBROUTINE U_FullOpt1_Residual( y_ED2, y_SD2, y_HD2, y_BD2, y_Orca2, y_ExtPtfm2, !............................................................................................................................... TYPE(ED_OutputType), TARGET , INTENT(IN ) :: y_ED2 ! System outputs - TYPE(SD_OutputType) , INTENT(IN ) :: y_SD2 ! System outputs + TYPE(SD_OutputType), TARGET , INTENT(IN ) :: y_SD2 ! System outputs TYPE(HydroDyn_OutputType) , INTENT(IN ) :: y_HD2 ! System outputs TYPE(BD_OutputType) , INTENT(IN ) :: y_BD2(:) ! System outputs TYPE(Orca_OutputType) , INTENT(IN ) :: y_Orca2 ! System outputs @@ -2930,9 +2807,25 @@ SUBROUTINE U_FullOpt1_Residual( y_ED2, y_SD2, y_HD2, y_BD2, y_Orca2, y_ExtPtfm2, INTEGER(IntKi) :: i ! counter for ice leg and beamdyn loops INTEGER(IntKi) :: k ! counter for SrvD TMD instances TYPE(MeshType), POINTER :: PlatformMotions + TYPE(MeshType), POINTER :: SubstructureMotion + TYPE(MeshType), POINTER :: SubstructureMotion2HD - PlatformMotions => y_ED2%PlatformPtMesh + TYPE(MeshType), POINTER :: SD_LMesh + TYPE(MeshType), POINTER :: ED_PtfmPtMesh + + TYPE(MeshType), TARGET :: BlankMesh + PlatformMotions => y_ED2%PlatformPtMesh + + IF (p_FAST%CompSub == Module_SD) then + SubstructureMotion => y_SD2%y3Mesh + SubstructureMotion2HD => y_SD2%y2Mesh + SD_LMesh => MeshMapData%SubstructureLoads_Tmp + ELSE + SubstructureMotion => y_ED2%PlatformPtMesh + SubstructureMotion2HD => y_ED2%PlatformPtMesh + SD_LMesh => BlankMesh + END IF !.................. ! Set mooring line and ice inputs (which don't have acceleration fields and aren't used elsewhere in this routine, thus we're using the actual inputs (not a copy) @@ -2943,57 +2836,43 @@ SUBROUTINE U_FullOpt1_Residual( y_ED2, y_SD2, y_HD2, y_BD2, y_Orca2, y_ExtPtfm2, IF ( p_FAST%CompMooring == Module_MAP ) THEN ! note: MAP_InputSolve must be called before setting ED loads inputs (so that motions are known for loads [moment] mapping) - if ( p_FAST%CompSub == Module_SD ) then - CALL Transfer_Point_to_Point( y_SD2%y3Mesh, u_MAP%PtFairDisplacement, MeshMapData%SDy3_P_2_Mooring_P, ErrStat, ErrMsg ) - CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) - else - CALL Transfer_Point_to_Point( y_ED2%PlatformPtMesh, u_MAP%PtFairDisplacement, MeshMapData%ED_P_2_Mooring_P, ErrStat, ErrMsg ) - CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) - end if + CALL Transfer_Point_to_Point( SubstructureMotion, u_MAP%PtFairDisplacement, MeshMapData%Structure_2_Mooring, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) ELSEIF ( p_FAST%CompMooring == Module_MD ) THEN ! note: MD_InputSolve must be called before setting ED loads inputs (so that motions are known for loads [moment] mapping) - if ( p_FAST%CompSub == Module_SD ) then - CALL Transfer_Point_to_Point( y_SD2%y3Mesh, u_MD%CoupledKinematics(1), MeshMapData%SDy3_P_2_Mooring_P, ErrStat, ErrMsg ) - CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) - else - CALL Transfer_Point_to_Point( y_ED2%PlatformPtMesh, u_MD%CoupledKinematics(1), MeshMapData%ED_P_2_Mooring_P, ErrStat, ErrMsg ) - CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) - end if + CALL Transfer_Point_to_Point( SubstructureMotion, u_MD%CoupledKinematics(1), MeshMapData%Structure_2_Mooring, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) ELSEIF ( p_FAST%CompMooring == Module_FEAM ) THEN ! note: FEAM_InputSolve must be called before setting ED loads inputs (so that motions are known for loads [moment] mapping) - if ( p_FAST%CompSub == Module_SD ) then - CALL Transfer_Point_to_Point( y_SD2%y3Mesh, u_FEAM%PtFairleadDisplacement, MeshMapData%SDy3_P_2_Mooring_P, ErrStat, ErrMsg ) - CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) - else - CALL Transfer_Point_to_Point( y_ED2%PlatformPtMesh, u_FEAM%PtFairleadDisplacement, MeshMapData%ED_P_2_Mooring_P, ErrStat, ErrMsg ) - CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) - end if + CALL Transfer_Point_to_Point( SubstructureMotion, u_FEAM%PtFairleadDisplacement, MeshMapData%Structure_2_Mooring, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) ELSEIF ( p_FAST%CompMooring == Module_Orca ) THEN ! Map ED motion output to Orca inputs: ! note: must be called before setting ED loads inputs (so that Orca motions are known for loads [moment] mapping) - CALL Transfer_Point_to_Point( PlatformMotions, MeshMapData%u_Orca_PtfmMesh, MeshMapData%ED_P_2_Mooring_P, ErrStat2, ErrMsg2 ) + + ! NOTE THAT THIS USES **PlatformMotion** WHILE THE OTHER MOORING CODES COUPLE WITH **SubStructureMotion** + CALL Transfer_Point_to_Point( PlatformMotions, MeshMapData%u_Orca_PtfmMesh, MeshMapData%Structure_2_Mooring, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) END IF - IF ( p_FAST%CompIce == Module_IceF ) THEN - CALL IceFloe_InputSolve( u_IceF, y_SD2, MeshMapData, ErrStat2, ErrMsg2 ) + CALL IceFloe_InputSolve( u_IceF, SubstructureMotion, MeshMapData, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) ELSEIF ( p_FAST%CompIce == Module_IceD ) THEN DO i=1,p_FAST%numIceLegs - CALL IceD_InputSolve( u_IceD(i), y_SD2, MeshMapData, i, ErrStat2, ErrMsg2 ) + CALL IceD_InputSolve( u_IceD(i), SubstructureMotion, MeshMapData, i, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) END DO @@ -3005,12 +2884,15 @@ SUBROUTINE U_FullOpt1_Residual( y_ED2, y_SD2, y_HD2, y_BD2, y_Orca2, y_ExtPtfm2, ! Set motions for the ServoDyn Structural control for platform inputs (this has accelerations, but we assume the loads generated are small) ! Note that these values get overwritten at the completion of this routine.) !.................. - IF ( p_FAST%CompServo == Module_SrvD .and. p_FAST%CompSub == Module_SD ) THEN - call Transfer_SD_to_SStC( u_SrvD, y_SD2, MeshMapData, ErrStat2, ErrMsg2 ) + IF ( p_FAST%CompServo == Module_SrvD ) THEN + call Transfer_Substructure_to_SStC( u_SrvD, SubstructureMotion, MeshMapData, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ENDIF + MeshMapData%u_ED_HubPtLoad%Force = 0.0_ReKi + MeshMapData%u_ED_HubPtLoad%Moment = 0.0_ReKi + IF ( p_FAST%CompElast == Module_BD .and. BD_Solve_Option1) THEN ! Transfer ED motions to BD inputs: @@ -3019,8 +2901,6 @@ SUBROUTINE U_FullOpt1_Residual( y_ED2, y_SD2, y_HD2, y_BD2, y_Orca2, y_ExtPtfm2, ! Transfer BD loads to ED hub input: ! we're mapping loads, so we also need the sibling meshes' displacements: - MeshMapData%u_ED_HubPtLoad%Force = 0.0_ReKi - MeshMapData%u_ED_HubPtLoad%Moment = 0.0_ReKi do i=1,p_FAST%nBeams CALL Transfer_Point_to_Point( y_BD2(i)%ReactionForce, MeshMapData%u_ED_HubPtLoad_2, MeshMapData%BD_P_2_ED_P(i), ErrStat2, ErrMsg2, MeshMapData%u_BD_RootMotion(i), y_ED2%HubPtMotion) !u_BD_RootMotion and y_ED2%HubPtMotion contain the displaced positions for load calculations CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3028,7 +2908,7 @@ SUBROUTINE U_FullOpt1_Residual( y_ED2, y_SD2, y_HD2, y_BD2, y_Orca2, y_ExtPtfm2, MeshMapData%u_ED_HubPtLoad%Force = MeshMapData%u_ED_HubPtLoad%Force + MeshMapData%u_ED_HubPtLoad_2%Force MeshMapData%u_ED_HubPtLoad%Moment = MeshMapData%u_ED_HubPtLoad%Moment + MeshMapData%u_ED_HubPtLoad_2%Moment end do - IF ( p_FAST%CompAero == Module_AD .and. p_FAST%MHK > 0) THEN + IF ( p_FAST%CompAero == Module_AD .and. p_FAST%MHK /= MHK_None) THEN IF ( u_AD%rotors(1)%HubMotion%Committed ) THEN CALL Transfer_Point_to_Point( y_AD%rotors(1)%HubLoad, MeshMapData%u_ED_HubPtLoad_2, MeshMapData%AD_P_2_ED_P_H, ErrStat2, ErrMsg2, u_AD%rotors(1)%HubMotion, y_ED2%HubPtMotion ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3039,98 +2919,100 @@ SUBROUTINE U_FullOpt1_Residual( y_ED2, y_SD2, y_HD2, y_BD2, y_Orca2, y_ExtPtfm2, END IF - IF ( p_FAST%CompSub == Module_SD ) THEN + MeshMapData%SubstructureLoads_Tmp%Force = 0.0_ReKi + MeshMapData%SubstructureLoads_Tmp%Moment = 0.0_ReKi - IF ( p_FAST%CompHydro == Module_HD ) THEN - - ! initialize these SD loads inputs here in case HD is used (note from initialiazation that these meshes don't exist if HD isn't used) - MeshMapData%u_SD_LMesh%Force = 0.0_ReKi - MeshMapData%u_SD_LMesh%Moment = 0.0_ReKi - + IF ( p_FAST%CompHydro == Module_HD ) THEN - !.................. - ! Get HD inputs on Morison%Mesh and WAMITMesh - !.................. + !.................. + ! Get HD inputs on Morison%Mesh and WAMITMesh + !.................. - ! SD motions to HD: - CALL Transfer_SD_to_HD( y_SD2, MeshMapData%u_HD_W_Mesh, MeshMapData%u_HD_M_Mesh, MeshMapData, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) + ! SD or ED motions to HD: + CALL Transfer_SubStructureMotion_to_HD( SubstructureMotion2HD, MeshMapData%u_HD_W_Mesh, MeshMapData%u_HD_M_Mesh, MeshMapData, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) - - !.................. - ! Get SD loads inputs (MeshMapData%u_HD_W_Mesh and MeshMapData%u_HD_M_Mesh meshes must be set first) - !.................. + + !.................. + ! Get Substructure loads inputs (MeshMapData%u_HD_W_Mesh and MeshMapData%u_HD_M_Mesh meshes must be set first) + !.................. + + ! Loads (outputs) from HD meshes transfered to SD LMesh (zero them out first because they get summed in Transfer_HD_to_SD) + IF ( y_HD2%WAMITMesh%Committed ) THEN + ! we're mapping loads, so we also need the sibling meshes' displacements: + CALL Transfer_Point_to_Point( y_HD2%WAMITMesh, MeshMapData%SubstructureLoads_Tmp2, MeshMapData%HD_W_P_2_SubStructure, ErrStat2, ErrMsg2, MeshMapData%u_HD_W_Mesh, SubStructureMotion2HD ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN - ! Loads (outputs) from HD meshes transfered to SD LMesh (zero them out first because they get summed in Transfer_HD_to_SD) + MeshMapData%SubstructureLoads_Tmp%Force = MeshMapData%SubstructureLoads_Tmp%Force + MeshMapData%SubstructureLoads_Tmp2%Force + MeshMapData%SubstructureLoads_Tmp%Moment = MeshMapData%SubstructureLoads_Tmp%Moment + MeshMapData%SubstructureLoads_Tmp2%Moment + + END IF + + IF ( y_HD2%Morison%Mesh%Committed ) THEN + ! we're mapping loads, so we also need the sibling meshes' displacements: + CALL Transfer_Point_to_Point( y_HD2%Morison%Mesh, MeshMapData%SubstructureLoads_Tmp2, MeshMapData%HD_M_P_2_SubStructure, ErrStat2, ErrMsg2, MeshMapData%u_HD_M_Mesh, SubStructureMotion2HD ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN - CALL Transfer_HD_to_SD( MeshMapData%u_SD_LMesh_2, MeshMapData%u_SD_LMesh, y_SD2%Y2Mesh, y_HD2, MeshMapData%u_HD_W_Mesh, MeshMapData%u_HD_M_Mesh, MeshMapData, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) + MeshMapData%SubstructureLoads_Tmp%Force = MeshMapData%SubstructureLoads_Tmp%Force + MeshMapData%SubstructureLoads_Tmp2%Force + MeshMapData%SubstructureLoads_Tmp%Moment = MeshMapData%SubstructureLoads_Tmp%Moment + MeshMapData%SubstructureLoads_Tmp2%Moment + END IF - IF ( p_FAST%CompIce == Module_IceF ) THEN + IF ( p_FAST%CompIce == Module_IceF ) THEN - ! SD loads from IceFloe: - IF ( y_IceF%iceMesh%Committed ) THEN - ! we're mapping loads, so we also need the sibling meshes' displacements: - CALL Transfer_Point_to_Point( y_IceF%iceMesh, MeshMapData%u_SD_LMesh_2, MeshMapData%IceF_P_2_SD_P, ErrStat2, ErrMsg2, u_IceF%iceMesh, y_SD2%Y3Mesh ) - CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) + ! SD loads from IceFloe: + IF ( y_IceF%iceMesh%Committed ) THEN + ! we're mapping loads, so we also need the sibling meshes' displacements: + CALL Transfer_Point_to_Point( y_IceF%iceMesh, MeshMapData%SubstructureLoads_Tmp2, MeshMapData%IceF_P_2_SD_P, ErrStat2, ErrMsg2, u_IceF%iceMesh, SubStructureMotion ) + CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) - MeshMapData%u_SD_LMesh%Force = MeshMapData%u_SD_LMesh%Force + MeshMapData%u_SD_LMesh_2%Force - MeshMapData%u_SD_LMesh%Moment = MeshMapData%u_SD_LMesh%Moment + MeshMapData%u_SD_LMesh_2%Moment + MeshMapData%SubstructureLoads_Tmp%Force = MeshMapData%SubstructureLoads_Tmp%Force + MeshMapData%SubstructureLoads_Tmp2%Force + MeshMapData%SubstructureLoads_Tmp%Moment = MeshMapData%SubstructureLoads_Tmp%Moment + MeshMapData%SubstructureLoads_Tmp2%Moment -!... -#ifdef DEBUG_MESH_TRANSFER_ICE - if (.not. calcJacobian) then - CALL WrScr('********************************************************') - CALL WrScr('**** IceF to SD point-to-point *****') - CALL WrScr('********************************************************') - CALL WriteMappingTransferToFile(MeshMapData%u_SD_LMesh_2, y_SD2%Y3Mesh, u_IceF%iceMesh, y_IceF%iceMesh,& - MeshMapData%SDy3_P_2_IceF_P, MeshMapData%IceF_P_2_SD_P, & - 'SD_y2_IceF_Meshes_t'//TRIM(Num2LStr(this_time))//'.I.bin' ) - !print * - !pause - end IF -#endif - END IF !Module_IceF + END IF !Module_IceF - ELSEIF ( p_FAST%CompIce == Module_IceD ) THEN + ELSEIF ( p_FAST%CompIce == Module_IceD ) THEN - ! SD loads from IceDyn: - DO i=1,p_FAST%numIceLegs + ! SD loads from IceDyn: + DO i=1,p_FAST%numIceLegs - IF ( y_IceD(i)%PointMesh%Committed ) THEN - ! we're mapping loads, so we also need the sibling meshes' displacements: - CALL Transfer_Point_to_Point( y_IceD(i)%PointMesh, MeshMapData%u_SD_LMesh_2, MeshMapData%IceD_P_2_SD_P(i), ErrStat2, ErrMsg2, u_IceD(i)%PointMesh, y_SD2%Y3Mesh ) - CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF ( y_IceD(i)%PointMesh%Committed ) THEN + ! we're mapping loads, so we also need the sibling meshes' displacements: + CALL Transfer_Point_to_Point( y_IceD(i)%PointMesh, MeshMapData%SubstructureLoads_Tmp2, MeshMapData%IceD_P_2_SD_P(i), ErrStat2, ErrMsg2, u_IceD(i)%PointMesh, SubStructureMotion ) + CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) - MeshMapData%u_SD_LMesh%Force = MeshMapData%u_SD_LMesh%Force + MeshMapData%u_SD_LMesh_2%Force - MeshMapData%u_SD_LMesh%Moment = MeshMapData%u_SD_LMesh%Moment + MeshMapData%u_SD_LMesh_2%Moment + MeshMapData%SubstructureLoads_Tmp%Force = MeshMapData%SubstructureLoads_Tmp%Force + MeshMapData%SubstructureLoads_Tmp2%Force + MeshMapData%SubstructureLoads_Tmp%Moment = MeshMapData%SubstructureLoads_Tmp%Moment + MeshMapData%SubstructureLoads_Tmp2%Moment - END IF + END IF - END DO + END DO - END IF ! Ice loading + END IF ! Ice loading - END IF ! HD is used (IceFloe/IceDyn can't be used unless HydroDyn is used) + END IF ! HD is used (IceFloe/IceDyn can't be used unless HydroDyn is used) + !.................. - ! Get SD loads inputs from ServoDyn Structural control + ! Get Substructure (SD or ED) loads inputs from ServoDyn Structural control !.................. + IF ( p_FAST%CompServo == Module_SrvD .and. allocated(y_SrvD%SStCLoadMesh) ) THEN + do k=1,size(y_SrvD%SStCLoadMesh) + IF (y_SrvD%SStCLoadMesh(k)%Committed) THEN ! size 1 only for SStC + CALL Transfer_Point_to_Point( y_SrvD%SStCLoadMesh(k), MeshMapData%SubstructureLoads_Tmp2, MeshMapData%SStC_P_P_2_SubStructure(k), ErrStat2, ErrMsg2, u_SrvD%SStCMotionMesh(k), SubStructureMotion ) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat, ErrMsg,RoutineName ) + MeshMapData%SubstructureLoads_Tmp%Force = MeshMapData%SubstructureLoads_Tmp%Force + MeshMapData%SubstructureLoads_Tmp2%Force + MeshMapData%SubstructureLoads_Tmp%Moment = MeshMapData%SubstructureLoads_Tmp%Moment + MeshMapData%SubstructureLoads_Tmp2%Moment + ENDIF + enddo + ENDIF - IF ( p_FAST%CompServo == Module_SrvD .and. allocated(y_SrvD%SStCLoadMesh) ) THEN - do k=1,size(y_SrvD%SStCLoadMesh) - IF (y_SrvD%SStCLoadMesh(k)%Committed) THEN ! size 1 only for SStC - CALL Transfer_Point_to_Point( y_SrvD%SStCLoadMesh(k), MeshMapData%u_SD_LMesh_2, MeshMapData%SStC_P_P_2_SD_P(k), ErrStat2, ErrMsg2, u_SrvD%SStCMotionMesh(k), y_SD2%Y3Mesh ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat, ErrMsg,RoutineName ) - MeshMapData%u_SD_LMesh%Force = MeshMapData%u_SD_LMesh%Force + MeshMapData%u_SD_LMesh_2%Force - MeshMapData%u_SD_LMesh%Moment = MeshMapData%u_SD_LMesh%Moment + MeshMapData%u_SD_LMesh_2%Moment - ENDIF - enddo - ENDIF + IF ( p_FAST%CompSub == Module_SD ) THEN !.................. ! Get SD motions input @@ -3141,12 +3023,12 @@ SUBROUTINE U_FullOpt1_Residual( y_ED2, y_SD2, y_HD2, y_BD2, y_Orca2, y_ExtPtfm2, CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) !.................. - ! Get ED loads input (from SD and possibly HD) + ! Get ED platform loads input !.................. ! Loads (outputs) on the SD transition piece transfered to ED input location/mesh: ! we're mapping loads, so we also need the sibling meshes' displacements: - CALL Transfer_Point_to_Point( y_SD2%Y1Mesh, MeshMapData%u_ED_PlatformPtMesh, MeshMapData%SD_TP_2_ED_P, ErrStat2, ErrMsg2, MeshMapData%u_SD_TPMesh, PlatformMotions ) !MeshMapData%u_SD_TPMesh contains the orientations needed for moment calculations + CALL Transfer_Point_to_Point( y_SD2%Y1Mesh, MeshMapData%PlatformLoads_Tmp, MeshMapData%SD_TP_2_ED_P, ErrStat2, ErrMsg2, MeshMapData%u_SD_TPMesh, PlatformMotions ) !MeshMapData%u_SD_TPMesh contains the orientations needed for moment calculations CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3161,156 +3043,86 @@ SUBROUTINE U_FullOpt1_Residual( y_ED2, y_SD2, y_HD2, y_BD2, y_Orca2, y_ExtPtfm2, CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) !.................. - ! Get ED loads input (from SD and possibly HD) + ! Get ED platform loads input !.................. ! Loads (outputs) on the ExtPtfm platform mesh transfered to ED input location/mesh: ! we're mapping loads, so we also need the sibling meshes' displacements: - CALL Transfer_Point_to_Point( y_ExtPtfm2%PtfmMesh, MeshMapData%u_ED_PlatformPtMesh, MeshMapData%SD_TP_2_ED_P, ErrStat2, ErrMsg2, MeshMapData%u_ExtPtfm_PtfmMesh, PlatformMotions ) - CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) - - ELSE IF ( p_FAST%CompHydro == Module_HD ) THEN - - ! Rigid Substructure case - - !.................. - ! Get HD inputs on 3 meshes - !.................. - - ! Map ED motion outputs to HD inputs: - ! basically, we want to call Transfer_PlatformMotion_to_HD, except we have the meshes in a different data structure (not a copy of u_HD) - ! CALL Transfer_PlatformMotion_to_HD( y_ED2%PlatformPtMesh, u_HD, MeshMapData, ErrStat2, ErrMsg2 ) - ! so, here are the transfers, again. - - ! Motions from ED to HD for mesh mapping - - ! These are the motions for the lumped point loads associated the WAMIT body: - if (MeshMapData%u_HD_W_Mesh%Committed) then - CALL Transfer_Point_to_Point( PlatformMotions, MeshMapData%u_HD_W_Mesh, MeshMapData%ED_P_2_HD_W_P, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) - endif - - ! These are the motions for the lumped point loads associated viscous drag on the WAMIT body and/or filled/flooded lumped forces of the WAMIT body - if (MeshMapData%u_HD_M_Mesh%Committed) then - CALL Transfer_Point_to_Point( PlatformMotions, MeshMapData%u_HD_M_Mesh, MeshMapData%ED_P_2_HD_M_P, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) - endif - - - - !.................. - ! Get ED loads input (from HD only) - !.................. - MeshMapData%u_ED_PlatformPtMesh%Force = 0.0_ReKi - MeshMapData%u_ED_PlatformPtMesh%Moment = 0.0_ReKi - - ! we're mapping loads, so we also need the sibling meshes' displacements: - if ( y_HD2%WAMITMesh%Committed) then - CALL Transfer_Point_to_Point( y_HD2%WAMITMesh, MeshMapData%u_ED_PlatformPtMesh, MeshMapData%HD_W_P_2_ED_P, ErrStat2, ErrMsg2, MeshMapData%u_HD_W_Mesh, PlatformMotions) !u_HD and u_mapped_positions contain the displaced positions for load calculations + CALL Transfer_Point_to_Point( y_ExtPtfm2%PtfmMesh, MeshMapData%PlatformLoads_Tmp, MeshMapData%SD_TP_2_ED_P, ErrStat2, ErrMsg2, MeshMapData%u_ExtPtfm_PtfmMesh, PlatformMotions ) CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) - end if - - if ( y_HD2%Morison%Mesh%Committed ) then - CALL Transfer_Point_to_Point( y_HD2%Morison%Mesh, MeshMapData%u_ED_PlatformPtMesh_2, MeshMapData%HD_M_P_2_ED_P, ErrStat2, ErrMsg2, MeshMapData%u_HD_M_Mesh, PlatformMotions ) !u_MAP and y_ED contain the displacements needed for moment calculations - CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) - - MeshMapData%u_ED_PlatformPtMesh%Force = MeshMapData%u_ED_PlatformPtMesh%Force + MeshMapData%u_ED_PlatformPtMesh_2%Force - MeshMapData%u_ED_PlatformPtMesh%Moment = MeshMapData%u_ED_PlatformPtMesh%Moment + MeshMapData%u_ED_PlatformPtMesh_2%Moment - end if ELSE - - ! When using OrcaFlex, we need to zero this out - MeshMapData%u_ED_PlatformPtMesh%Force = 0.0_ReKi - MeshMapData%u_ED_PlatformPtMesh%Moment = 0.0_ReKi + + MeshMapData%PlatformLoads_Tmp%Force = 0.0_ReKi + MeshMapData%PlatformLoads_Tmp%Moment = 0.0_ReKi END IF + !.................. - ! Get remaining portion of ED loads input on MeshMapData%u_ED_PlatformPtMesh (must do this after MeshMapData%u_SD_TPMesh and MeshMapData%u_HD_W_Mesh are set) - ! at this point, MeshMapData%u_ED_PlatformPtMesh contains the portion of loads from SD and/or HD + ! Get remaining portion of substructure (ED or SD) loads input on MeshMapData%SubstructureLoads_Tmp (must do this after all input motion meshes are set) + ! at this point, MeshMapData%PlatformLoads_Tmp contains the portion of loads from SD and/or HD !.................. ! Get the loads for ED/SD from a mooring module and add them: IF ( p_FAST%CompMooring == Module_MAP ) THEN - if ( p_FAST%CompSub == Module_SD ) then - CALL Transfer_Point_to_Point( y_MAP%PtFairleadLoad, MeshMapData%u_SD_LMesh_2, MeshMapData%Mooring_P_2_SD_P, ErrStat2, ErrMsg2, u_MAP%PtFairDisplacement, y_SD2%Y3Mesh ) !u_MAP and y_SD contain the displacements needed for moment calculations - CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL Transfer_Point_to_Point( y_MAP%PtFairleadLoad, MeshMapData%SubstructureLoads_Tmp2, MeshMapData%Mooring_2_Structure, ErrStat2, ErrMsg2, u_MAP%PtFairDisplacement, SubStructureMotion ) !u_MAP and y_SD contain the displacements needed for moment calculations + CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) - MeshMapData%u_SD_LMesh%Force = MeshMapData%u_SD_LMesh%Force + MeshMapData%u_SD_LMesh_2%Force - MeshMapData%u_SD_LMesh%Moment = MeshMapData%u_SD_LMesh%Moment + MeshMapData%u_SD_LMesh_2%Moment - else - CALL Transfer_Point_to_Point( y_MAP%PtFairleadLoad, MeshMapData%u_ED_PlatformPtMesh_2, MeshMapData%Mooring_P_2_ED_P, ErrStat2, ErrMsg2, u_MAP%PtFairDisplacement, PlatformMotions ) !u_MAP and y_ED contain the displacements needed for moment calculations - CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) - - MeshMapData%u_ED_PlatformPtMesh%Force = MeshMapData%u_ED_PlatformPtMesh%Force + MeshMapData%u_ED_PlatformPtMesh_2%Force - MeshMapData%u_ED_PlatformPtMesh%Moment = MeshMapData%u_ED_PlatformPtMesh%Moment + MeshMapData%u_ED_PlatformPtMesh_2%Moment - end if + MeshMapData%SubstructureLoads_Tmp%Force = MeshMapData%SubstructureLoads_Tmp%Force + MeshMapData%SubstructureLoads_Tmp2%Force + MeshMapData%SubstructureLoads_Tmp%Moment = MeshMapData%SubstructureLoads_Tmp%Moment + MeshMapData%SubstructureLoads_Tmp2%Moment ELSEIF ( p_FAST%CompMooring == Module_MD ) THEN - if ( p_FAST%CompSub == Module_SD ) then - CALL Transfer_Point_to_Point( y_MD%CoupledLoads(1), MeshMapData%u_SD_LMesh_2, MeshMapData%Mooring_P_2_SD_P, ErrStat2, ErrMsg2, u_MD%CoupledKinematics(1), y_SD2%Y3Mesh ) !u_MD and y_SD contain the displacements needed for moment calculations - CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) - - MeshMapData%u_SD_LMesh%Force = MeshMapData%u_SD_LMesh%Force + MeshMapData%u_SD_LMesh_2%Force - MeshMapData%u_SD_LMesh%Moment = MeshMapData%u_SD_LMesh%Moment + MeshMapData%u_SD_LMesh_2%Moment - else - CALL Transfer_Point_to_Point( y_MD%CoupledLoads(1), MeshMapData%u_ED_PlatformPtMesh_2, MeshMapData%Mooring_P_2_ED_P, ErrStat2, ErrMsg2, u_MD%CoupledKinematics(1), PlatformMotions ) !u_MD and y_ED contain the displacements needed for moment calculations - CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL Transfer_Point_to_Point( y_MD%CoupledLoads(1), MeshMapData%SubstructureLoads_Tmp2, MeshMapData%Mooring_2_Structure, ErrStat2, ErrMsg2, u_MD%CoupledKinematics(1), SubStructureMotion ) !u_MD and y_SD contain the displacements needed for moment calculations + CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) - MeshMapData%u_ED_PlatformPtMesh%Force = MeshMapData%u_ED_PlatformPtMesh%Force + MeshMapData%u_ED_PlatformPtMesh_2%Force - MeshMapData%u_ED_PlatformPtMesh%Moment = MeshMapData%u_ED_PlatformPtMesh%Moment + MeshMapData%u_ED_PlatformPtMesh_2%Moment - end if - + MeshMapData%SubstructureLoads_Tmp%Force = MeshMapData%SubstructureLoads_Tmp%Force + MeshMapData%SubstructureLoads_Tmp2%Force + MeshMapData%SubstructureLoads_Tmp%Moment = MeshMapData%SubstructureLoads_Tmp%Moment + MeshMapData%SubstructureLoads_Tmp2%Moment + ELSEIF ( p_FAST%CompMooring == Module_FEAM ) THEN - if ( p_FAST%CompSub == Module_SD ) then - CALL Transfer_Point_to_Point( y_FEAM%PtFairleadLoad, MeshMapData%u_SD_LMesh_2, MeshMapData%Mooring_P_2_SD_P, ErrStat2, ErrMsg2, u_FEAM%PtFairleadDisplacement, y_SD2%Y3Mesh ) !u_FEAM and y_SD contain the displacements needed for moment calculations - CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL Transfer_Point_to_Point( y_FEAM%PtFairleadLoad, MeshMapData%SubstructureLoads_Tmp2, MeshMapData%Mooring_2_Structure, ErrStat2, ErrMsg2, u_FEAM%PtFairleadDisplacement, SubStructureMotion ) !u_FEAM and y_SD contain the displacements needed for moment calculations + CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) - MeshMapData%u_SD_LMesh%Force = MeshMapData%u_SD_LMesh%Force + MeshMapData%u_SD_LMesh_2%Force - MeshMapData%u_SD_LMesh%Moment = MeshMapData%u_SD_LMesh%Moment + MeshMapData%u_SD_LMesh_2%Moment - else - CALL Transfer_Point_to_Point( y_FEAM%PtFairleadLoad, MeshMapData%u_ED_PlatformPtMesh_2, MeshMapData%Mooring_P_2_ED_P, ErrStat2, ErrMsg2, u_FEAM%PtFairleadDisplacement, PlatformMotions ) !u_FEAM and y_ED contain the displacements needed for moment calculations - CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) - - MeshMapData%u_ED_PlatformPtMesh%Force = MeshMapData%u_ED_PlatformPtMesh%Force + MeshMapData%u_ED_PlatformPtMesh_2%Force - MeshMapData%u_ED_PlatformPtMesh%Moment = MeshMapData%u_ED_PlatformPtMesh%Moment + MeshMapData%u_ED_PlatformPtMesh_2%Moment - end if + MeshMapData%SubstructureLoads_Tmp%Force = MeshMapData%SubstructureLoads_Tmp%Force + MeshMapData%SubstructureLoads_Tmp2%Force + MeshMapData%SubstructureLoads_Tmp%Moment = MeshMapData%SubstructureLoads_Tmp%Moment + MeshMapData%SubstructureLoads_Tmp2%Moment ELSEIF ( p_FAST%CompMooring == Module_Orca ) THEN - CALL Transfer_Point_to_Point( y_Orca2%PtfmMesh, MeshMapData%u_ED_PlatformPtMesh_2, MeshMapData%Mooring_P_2_ED_P, ErrStat2, ErrMsg2, MeshMapData%u_Orca_PtfmMesh, PlatformMotions ) !u_Orca_PtfmMesh and y_ED contain the displacements needed for moment calculations + !NOTE: ORCAFLEX INTERFACE COUPLES WITH **PlatformMotions** AND NOT **SubStructureMotion** LIKE THE OTHER MOORING MODULES DO + + ! BECAUSE ORCAFLEX INTERFACE CANNOT BE USED WITH SUBDYN, THE SUBSTRUCTURELOADS DATA STRUCTURES POINT TO ELASTODYN (MORE LIKE PLATFORM MESH) + CALL Transfer_Point_to_Point( y_Orca2%PtfmMesh, MeshMapData%PlatformLoads_Tmp2, MeshMapData%Mooring_2_Structure, ErrStat2, ErrMsg2, MeshMapData%u_Orca_PtfmMesh, PlatformMotions ) !u_Orca_PtfmMesh and y_ED contain the displacements needed for moment calculations CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) - MeshMapData%u_ED_PlatformPtMesh%Force = MeshMapData%u_ED_PlatformPtMesh%Force + MeshMapData%u_ED_PlatformPtMesh_2%Force - MeshMapData%u_ED_PlatformPtMesh%Moment = MeshMapData%u_ED_PlatformPtMesh%Moment + MeshMapData%u_ED_PlatformPtMesh_2%Moment + MeshMapData%PlatformLoads_Tmp%Force = MeshMapData%PlatformLoads_Tmp%Force + MeshMapData%PlatformLoads_Tmp2%Force + MeshMapData%PlatformLoads_Tmp%Moment = MeshMapData%PlatformLoads_Tmp%Moment + MeshMapData%PlatformLoads_Tmp2%Moment END IF ! add farm-level mooring loads if applicable IF (p_FAST%FarmIntegration) THEN - MeshMapData%u_ED_PlatformPtMesh%Force = MeshMapData%u_ED_PlatformPtMesh%Force + MeshMapData%u_ED_PlatformPtMesh_MDf%Force - MeshMapData%u_ED_PlatformPtMesh%Moment = MeshMapData%u_ED_PlatformPtMesh%Moment + MeshMapData%u_ED_PlatformPtMesh_MDf%Moment + MeshMapData%SubstructureLoads_Tmp%Force = MeshMapData%SubstructureLoads_Tmp%Force + MeshMapData%SubstructureLoads_Tmp_Farm%Force + MeshMapData%SubstructureLoads_Tmp%Moment = MeshMapData%SubstructureLoads_Tmp%Moment + MeshMapData%SubstructureLoads_Tmp_Farm%Moment END IF - ! Map the forces from the platform mounted TMD (from ServoDyn) to the platform reference point - IF ( p_FAST%CompServo == Module_SrvD .and. p_FAST%CompSub /= Module_SD .and. allocated(y_SrvD%SStCLoadMesh)) THEN - do k=1,size(y_SrvD%SStCLoadMesh) - IF (y_SrvD%SStCLoadMesh(k)%Committed) THEN ! size 1 only for SStC - CALL Transfer_Point_to_Point( y_SrvD%SStCLoadMesh(k), MeshMapData%u_ED_PlatformPtMesh_2, MeshMapData%SStC_P_P_2_ED_P(k), ErrStat2, ErrMsg2, u_SrvD%SStCMotionMesh(k), PlatformMotions ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat, ErrMsg,RoutineName//':u_ED%PlatformPtMesh' ) - MeshMapData%u_ED_PlatformPtMesh%Force = MeshMapData%u_ED_PlatformPtMesh%Force + MeshMapData%u_ED_PlatformPtMesh_2%Force - MeshMapData%u_ED_PlatformPtMesh%Moment = MeshMapData%u_ED_PlatformPtMesh%Moment + MeshMapData%u_ED_PlatformPtMesh_2%Moment - ENDIF - enddo - ENDIF - !.................. ! Calculate the residual with these new inputs: !.................. - - CALL Create_FullOpt1_UVector(U_Resid, MeshMapData%u_ED_PlatformPtMesh, MeshMapData%u_SD_TPMesh, MeshMapData%u_SD_LMesh, & + ! Make sure that the substructure loads get mapped with the platform loads when SD is not used: + IF (p_FAST%CompSub /= MODULE_SD) THEN + ! In this case, the substructure and platform are the same mesh: + ED_PtfmPtMesh => MeshMapData%PlatformLoads_Tmp + SD_LMesh => BlankMesh + + ED_PtfmPtMesh%Force = MeshMapData%SubstructureLoads_Tmp%Force + MeshMapData%PlatformLoads_Tmp%Force + ED_PtfmPtMesh%Moment = MeshMapData%SubstructureLoads_Tmp%Moment + MeshMapData%PlatformLoads_Tmp%Moment + ELSE + ED_PtfmPtMesh => MeshMapData%PlatformLoads_Tmp + SD_LMesh => MeshMapData%SubstructureLoads_Tmp + ENDIF + + CALL Create_FullOpt1_UVector(U_Resid, ED_PtfmPtMesh, MeshMapData%u_SD_TPMesh, SD_LMesh, & MeshMapData%u_HD_M_Mesh, MeshMapData%u_HD_W_Mesh, & MeshMapData%u_ED_HubPtLoad, MeshMapData%u_BD_RootMotion, MeshMapData%u_Orca_PtfmMesh, & MeshMapData%u_ExtPtfm_PtfmMesh, p_FAST ) @@ -4045,16 +3857,17 @@ SUBROUTINE Perturb_u_FullOpt1( p_FAST, Jac_u_indx, n, u_perturb, u_ED_perturb, u END SUBROUTINE Perturb_u_FullOpt1 !---------------------------------------------------------------------------------------------------------------------------------- !> This routine resets the remap flags on all of the meshes -SUBROUTINE ResetRemapFlags(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD ) +SUBROUTINE ResetRemapFlags(p_FAST, ED, SED, BD, AD, ExtLd, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD ) !............................................................................................................................... TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data + TYPE(SED_Data), INTENT(INOUT) :: SED !< Simplified-ElastoDyn data TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data - TYPE(AeroDyn14_Data), INTENT(INOUT) :: AD14 !< AeroDyn14 data + TYPE(ExtLoads_Data), INTENT(INOUT) :: ExtLd !< ExtLoads data TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HydroDyn data TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SubDyn data TYPE(ExtPtfm_Data), INTENT(INOUT) :: ExtPtfm !< ExtPtfm data @@ -4075,27 +3888,38 @@ SUBROUTINE ResetRemapFlags(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, MAPp ! Reset each mesh's RemapFlag (after calling all InputSolve routines): !..................................................................... - ! ElastoDyn meshes - ED%Input( 1)%PlatformPtMesh%RemapFlag = .FALSE. - ED%y%PlatformPtMesh%RemapFlag = .FALSE. - ED%Input( 1)%TowerPtLoads%RemapFlag = .FALSE. - ED%y%TowerLn2Mesh%RemapFlag = .FALSE. - DO K=1,SIZE(ED%y%BladeRootMotion) + if (p_FAST%CompElast == Module_SED) then + ! Simplified-ElastoDyn meshes + SED%y%PlatformPtMesh%RemapFlag = .FALSE. + DO K=1,SIZE(SED%y%BladeRootMotion) + SED%y%BladeRootMotion(K)%RemapFlag = .FALSE. + END DO + SED%y%NacelleMotion%RemapFlag = .FALSE. + SED%y%HubPtMotion%RemapFlag = .FALSE. + SED%Input(1)%HubPtLoad%RemapFlag = .FALSE. + else + ! ElastoDyn meshes + ED%Input( 1)%PlatformPtMesh%RemapFlag = .FALSE. + ED%y%PlatformPtMesh%RemapFlag = .FALSE. + ED%Input( 1)%TowerPtLoads%RemapFlag = .FALSE. + ED%y%TowerLn2Mesh%RemapFlag = .FALSE. + DO K=1,SIZE(ED%y%BladeRootMotion) ED%y%BladeRootMotion(K)%RemapFlag = .FALSE. - END DO - if (allocated(ED%Input(1)%BladePtLoads)) then - DO K=1,SIZE(ED%Input(1)%BladePtLoads) - ED%Input( 1)%BladePtLoads(K)%RemapFlag = .FALSE. - ED%y%BladeLn2Mesh(K)%RemapFlag = .FALSE. END DO - end if - - ED%Input( 1)%NacelleLoads%RemapFlag = .FALSE. - ED%y%NacelleMotion%RemapFlag = .FALSE. - ED%Input( 1)%TFinCMLoads%RemapFlag = .FALSE. - ED%y%TFinCMMotion%RemapFlag = .FALSE. - ED%Input( 1)%HubPtLoad%RemapFlag = .FALSE. - ED%y%HubPtMotion%RemapFlag = .FALSE. + if (allocated(ED%Input(1)%BladePtLoads)) then + DO K=1,SIZE(ED%Input(1)%BladePtLoads) + ED%Input( 1)%BladePtLoads(K)%RemapFlag = .FALSE. + ED%y%BladeLn2Mesh(K)%RemapFlag = .FALSE. + END DO + end if + + ED%Input( 1)%NacelleLoads%RemapFlag = .FALSE. + ED%y%NacelleMotion%RemapFlag = .FALSE. + ED%Input( 1)%TFinCMLoads%RemapFlag = .FALSE. + ED%y%TFinCMMotion%RemapFlag = .FALSE. + ED%Input( 1)%HubPtLoad%RemapFlag = .FALSE. + ED%y%HubPtMotion%RemapFlag = .FALSE. + endif ! BeamDyn meshes IF ( p_FAST%CompElast == Module_BD ) THEN @@ -4111,18 +3935,7 @@ SUBROUTINE ResetRemapFlags(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, MAPp END IF ! AeroDyn meshes - IF ( p_FAST%CompAero == Module_AD14 ) THEN - - DO k=1,SIZE(AD14%Input(1)%InputMarkers) - AD14%Input(1)%InputMarkers(k)%RemapFlag = .FALSE. - AD14%y%OutputLoads( k)%RemapFlag = .FALSE. - END DO - - IF (AD14%Input(1)%Twr_InputMarkers%Committed) THEN - AD14%Input(1)%Twr_InputMarkers%RemapFlag = .FALSE. - AD14%y%Twr_OutputLoads%RemapFlag = .FALSE. - END IF - ELSEIF ( p_FAST%CompAero == Module_AD ) THEN + IF ( (p_FAST%CompAero == Module_AD) .OR. (p_FAST%CompAero == Module_ExtLd ) ) THEN IF (AD%Input(1)%rotors(1)%HubMotion%Committed) THEN AD%Input(1)%rotors(1)%HubMotion%RemapFlag = .FALSE. @@ -4154,7 +3967,26 @@ SUBROUTINE ResetRemapFlags(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, MAPp END DO END IF - + + IF (p_FAST%CompAero == Module_ExtLd ) THEN + + ExtLd%u%HubMotion%RemapFlag = .FALSE. + + IF ( ExtLd%u%TowerMotion%Committed ) THEN + ExtLd%u%TowerMotion%RemapFlag = .FALSE. + + IF ( ExtLd%y%TowerLoad%Committed ) THEN + ExtLd%y%TowerLoad%RemapFlag = .FALSE. + END IF + END IF + + DO k=1,SIZE( ExtLd%u%BladeMotion ) + ExtLd%u%BladeRootMotion(k)%RemapFlag = .FALSE. + ExtLd%u%BladeMotion( k)%RemapFlag = .FALSE. + ExtLd%y%BladeLoad( k)%RemapFlag = .FALSE. + END DO + + END IF ! ServoDyn -- StrucCtrl meshes IF ( p_FAST%CompServo == Module_SrvD ) THEN @@ -4264,18 +4096,19 @@ SUBROUTINE ResetRemapFlags(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, MAPp END SUBROUTINE ResetRemapFlags !---------------------------------------------------------------------------------------------------------------------------------- !> This routine initializes all of the mapping data structures needed between the various modules. -SUBROUTINE InitModuleMappings(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat, ErrMsg) +SUBROUTINE InitModuleMappings(p_FAST, ED, SED, BD, AD, ADsk, ExtLd, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat, ErrMsg) !............................................................................................................................... TYPE(FAST_ParameterType), INTENT(INOUT) :: p_FAST !< Parameters for the glue code - TYPE(ElastoDyn_Data),TARGET,INTENT(INOUT) :: ED !< ElastoDyn data + TYPE(SED_Data),TARGET, INTENT(INOUT) :: SED !< Simplified-ElastoDyn data TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data - TYPE(AeroDyn14_Data), INTENT(INOUT) :: AD14 !< AeroDyn14 data + TYPE(AeroDisk_Data), INTENT(INOUT) :: ADsk !< AeroDisk data + TYPE(ExtLoads_Data), INTENT(INOUT) :: ExtLd !< ExtLoads data TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HydroDyn data - TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SubDyn data + TYPE(SubDyn_Data), TARGET, INTENT(INOUT) :: SD !< SubDyn data TYPE(ExtPtfm_Data), INTENT(INOUT) :: ExtPtfm !< ExtPtfm data TYPE(MAP_Data), INTENT(INOUT) :: MAPp !< MAP data TYPE(FEAMooring_Data), INTENT(INOUT) :: FEAM !< FEAMooring data @@ -4300,15 +4133,68 @@ SUBROUTINE InitModuleMappings(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, M TYPE(MeshType), POINTER :: PlatformMotion TYPE(MeshType), POINTER :: PlatformLoads + + TYPE(MeshType), POINTER :: SubstructureMotion2HD + TYPE(MeshType), POINTER :: SubstructureMotion + TYPE(MeshType), POINTER :: SubstructureLoads !............................................................................................................................ ErrStat = ErrID_None ErrMsg = "" + + if (p_FAST%CompElast == Module_SED) then + NumBl = SIZE(SED%y%BladeRootMotion,1) + PlatformMotion => SED%y%PlatformPtMesh + elseif (p_FAST%CompElast == Module_ED) then + NumBl = SIZE(ED%y%BladeRootMotion,1) + PlatformMotion => ED%y%PlatformPtMesh + PlatformLoads => ED%Input(1)%PlatformPtMesh + elseif (p_FAST%CompElast == Module_BD) then + NumBl = p_FAST%nBeams ! BeamDyn might set this to 1 blade for aeromaps (instead of SIZE(ED%y%BladeRootMotion,1)) + PlatformMotion => ED%y%PlatformPtMesh + PlatformLoads => ED%Input(1)%PlatformPtMesh + endif + + if (p_FAST%CompElast /= Module_SED) then ! HD cannot be used with SED + IF (p_FAST%CompSub == MODULE_SD) THEN + SubstructureMotion2HD => SD%y%y2Mesh + SubstructureMotion => SD%y%y3Mesh + SubstructureLoads => SD%Input(1)%LMesh + ELSE ! all of these get mapped to ElastoDyn ! (offshore floating with rigid substructure) + SubstructureMotion2HD => ED%y%PlatformPtMesh + SubstructureMotion => ED%y%PlatformPtMesh + SubstructureLoads => ED%Input(1)%PlatformPtMesh + END IF + endif + + + !............................................................................................................................ + ! Determine solver options: + !............................................................................................................................ + IF (p_FAST%CompElast == Module_BD .and. BD_Solve_Option1) THEN + + p_FAST%SolveOption = Solve_FullOpt1 + + ELSEIF (p_FAST%CompMooring == Module_Orca .or. & + p_FAST%CompSub /= Module_None ) THEN + + p_FAST%SolveOption = Solve_FullOpt1 + + ELSEIF ( p_FAST%CompHydro == Module_HD ) THEN - NumBl = SIZE(ED%y%BladeRootMotion,1) - PlatformMotion => ED%y%PlatformPtMesh - PlatformLoads => ED%Input(1)%PlatformPtMesh + IF (p_FAST%CompElast == Module_ED) THEN + p_FAST%SolveOption = Solve_SimplifiedOpt1 + ELSE + p_FAST%SolveOption = Solve_FullOpt1 + END IF + + ELSE + p_FAST%SolveOption = Solve_FullOpt2 + + END IF + + !............................................................................................................................ ! Create the data structures and mappings in MeshMapType !............................................................................................................................ @@ -4446,7 +4332,7 @@ SUBROUTINE InitModuleMappings(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, M ENDIF !------------------------- -! ServoDyn <-> Platform +! ServoDyn <-> Platform and Substructure !------------------------- ! ServoDyn platform point mesh from ElastoDyn platform point mesh -- Motions passed to DLL IF ( SrvD%Input(1)%PtfmMotionMesh%Committed ) THEN @@ -4454,154 +4340,172 @@ SUBROUTINE InitModuleMappings(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, M CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':ED_P_2_SrvD_P_P' ) ENDIF - IF ( ALLOCATED(SrvD%Input(1)%SStCMotionMesh) ) THEN - IF ( p_FAST%CompSub /= Module_SD ) THEN ! all of these get mapped to ElastoDyn ! (offshore floating with rigid substructure) - j=size(SrvD%Input(1)%SStCMotionMesh) - ALLOCATE( MeshMapData%SStC_P_P_2_ED_P(j), MeshMapData%ED_P_2_SStC_P_P(j), STAT=ErrStat2 ) - IF ( ErrStat2 /= 0 ) THEN - CALL SetErrStat( ErrID_Fatal, 'Error allocating MeshMapData%SStC_P_P_2_ED_P and MeshMapData%ED_P_2_SStC_P_P.', & - ErrStat, ErrMsg, RoutineName ) - RETURN - END IF - do j=1,size(SrvD%Input(1)%SStCMotionMesh) - IF ( SrvD%Input(1)%SStCMotionMesh(j)%Committed ) THEN ! Single point per SStC instance - ! ServoDyn SStC point mesh to/from ElastoDyn point mesh - CALL MeshMapCreate( PlatformMotion, SrvD%Input(1)%SStCMotionMesh(j), MeshMapData%ED_P_2_SStC_P_P(j), ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':ED_P_2_SStC_P_P' ) - CALL MeshMapCreate( SrvD%y%SStCLoadMesh(j), PlatformLoads, MeshMapData%SStC_P_P_2_ED_P(j), ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':SStC_P_P_2_ED_P' ) - ENDIF - enddo - ELSE ! SubDyn is used - j=size(SrvD%Input(1)%SStCMotionMesh) - ALLOCATE( MeshMapData%SStC_P_P_2_SD_P(j), MeshMapData%SDy3_P_2_SStC_P_P(j), STAT=ErrStat2 ) - IF ( ErrStat2 /= 0 ) THEN - CALL SetErrStat( ErrID_Fatal, 'Error allocating MeshMapData%SStC_P_P_2_SD_P and MeshMapData%SDy3_P_2_SStC_P_P.', & - ErrStat, ErrMsg, RoutineName ) - RETURN - END IF - do j=1,size(SrvD%Input(1)%SStCMotionMesh) - IF ( SrvD%Input(1)%SStCMotionMesh(j)%Committed ) THEN ! Single point per SStC instance - ! ServoDyn SStC point mesh to/from SubDyn point mesh - CALL MeshMapCreate( SrvD%y%SStCLoadMesh(j), SD%Input(1)%LMesh, MeshMapData%SStC_P_P_2_SD_P(j), ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':SStC_P_P_2_SD_P' ) - CALL MeshMapCreate( SD%y%y3Mesh, SrvD%Input(1)%SStCMotionMesh(j), MeshMapData%SDy3_P_2_SStC_P_P(j), ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':SDy3_P_2_SStC_P_P' ) - ENDIF - enddo - ENDIF + j=size(SrvD%Input(1)%SStCMotionMesh) + ALLOCATE( MeshMapData%SStC_P_P_2_SubStructure(j), MeshMapData%SubStructure_2_SStC_P_P(j), STAT=ErrStat2 ) + IF ( ErrStat2 /= 0 ) THEN + CALL SetErrStat( ErrID_Fatal, 'Error allocating MeshMapData%SStC_P_P_2_SubStructure and MeshMapData%SubStructure_2_SStC_P_P.', & + ErrStat, ErrMsg, RoutineName ) + RETURN + END IF + do j=1,size(SrvD%Input(1)%SStCMotionMesh) + IF ( SrvD%Input(1)%SStCMotionMesh(j)%Committed ) THEN ! Single point per SStC instance + ! ServoDyn SStC point mesh to/from SubDyn/ElastoDyn point mesh + CALL MeshMapCreate( SubStructureMotion, SrvD%Input(1)%SStCMotionMesh(j), MeshMapData%SubStructure_2_SStC_P_P(j), ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':SubStructure_2_SStC_P_P' ) + CALL MeshMapCreate( SrvD%y%SStCLoadMesh(j), SubStructureLoads, MeshMapData%SStC_P_P_2_SubStructure(j), ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':SStC_P_P_2_SubStructure' ) + ENDIF + enddo ENDIF + ENDIF !------------------------- -! ElastoDyn <-> AeroDyn14 +! ElastoDyn/Simplified-ElastoDyn <-> AeroDyn15 !------------------------- - IF ( p_FAST%CompAero == Module_AD14 ) THEN ! ED-AD14 - - ! Blade meshes: (allocate two mapping data structures to number of blades, then allocate data inside the structures) - ! AD14 does not properly set up its blade meshes, so we can't use this - !ALLOCATE( MeshMapData%BDED_L_2_AD_L_B(NumBl), MeshMapData%AD_L_2_BDED_B(NumBl), STAT=ErrStat2 ) - ! IF ( ErrStat2 /= 0 ) THEN - ! CALL SetErrStat( ErrID_Fatal, 'Error allocating MeshMapData%BDED_L_2_AD_L_B and MeshMapData%AD_L_2_BDED_B.', & - ! ErrStat, ErrMsg, RoutineName ) - ! RETURN - ! END IF - ! - !DO K=1,NumBl - ! CALL MeshMapCreate( AD14%y%OutputLoads(K), ED%Input(1)%BladePtLoads(K), MeshMapData%AD_L_2_BDED_B(K), ErrStat2, ErrMsg2 ) - ! CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':AD_L_2_BDED_B('//TRIM(Num2LStr(K))//')' ) - !END DO - - ! Tower mesh: - IF ( AD14%Input(1)%Twr_InputMarkers%Committed ) THEN - CALL MeshMapCreate( ED%y%TowerLn2Mesh, AD14%Input(1)%Twr_InputMarkers, MeshMapData%ED_L_2_AD_L_T, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':ED_2_AD_TowerMotion' ) - CALL MeshMapCreate( AD14%y%Twr_OutputLoads, ED%Input(1)%TowerPtLoads, MeshMapData%AD_L_2_ED_P_T, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':AD_2_ED_TowerLoad' ) - END IF - - IF (ErrStat >= AbortErrLev ) RETURN - - ELSEIF ( p_FAST%CompAero == Module_AD ) THEN ! ED-AD and/or BD-AD + IF ( (p_FAST%CompAero == Module_AD) .OR. (p_FAST%CompAero == Module_ExtLd) ) THEN ! ED-AD and/or BD-AD ! allocate per-blade space for mapping to structural module - - ! Blade root meshes - ALLOCATE( MeshMapData%ED_P_2_AD_P_R(NumBl), STAT=ErrStat2 ) - IF ( ErrStat2 /= 0 ) THEN - CALL SetErrStat( ErrID_Fatal, 'Error allocating MeshMapData%ED_P_2_AD_P_R.', ErrStat, ErrMsg, RoutineName ) - RETURN - END IF - - ! Blade meshes: (allocate two mapping data structures to number of blades, then allocate data inside the structures) - ALLOCATE( MeshMapData%BDED_L_2_AD_L_B(NumBl), MeshMapData%AD_L_2_BDED_B(NumBl), STAT=ErrStat2 ) - IF ( ErrStat2 /= 0 ) THEN - CALL SetErrStat( ErrID_Fatal, 'Error allocating MeshMapData%BDED_L_2_AD_L_B and MeshMapData%AD_L_2_BDED_B.', & - ErrStat, ErrMsg, RoutineName ) - RETURN - END IF - + if (p_FAST%CompElast == Module_SED) then + + ! Blade root meshes + ALLOCATE( MeshMapData%SED_P_2_AD_P_R(NumBl), STAT=ErrStat2 ) + IF ( ErrStat2 /= 0 ) THEN + CALL SetErrStat( ErrID_Fatal, 'Error allocating MeshMapData%SED_P_2_AD_P_R.', ErrStat, ErrMsg, RoutineName ) + RETURN + END IF + + ! Blade meshes: Map SED blade root to AD blade line. Load is completely ignored. + ALLOCATE( MeshMapData%SED_P_2_AD_L_B(NumBl), MeshMapData%AD_L_2_SED_P(NumBl), STAT=ErrStat2 ) + IF ( ErrStat2 /= 0 ) THEN + CALL SetErrStat( ErrID_Fatal, 'Error allocating MeshMapData%SED_P_2_AD_L_B and MeshMapData%AD_L_2_SED_P.', ErrStat, ErrMsg, RoutineName ) + RETURN + END IF + + else + + ! Blade root meshes + ALLOCATE( MeshMapData%ED_P_2_AD_P_R(NumBl), STAT=ErrStat2 ) + IF ( ErrStat2 /= 0 ) THEN + CALL SetErrStat( ErrID_Fatal, 'Error allocating MeshMapData%ED_P_2_AD_P_R.', ErrStat, ErrMsg, RoutineName ) + RETURN + END IF + + ! Blade meshes: (allocate two mapping data structures to number of blades, then allocate data inside the structures) + ALLOCATE( MeshMapData%BDED_L_2_AD_L_B(NumBl), MeshMapData%AD_L_2_BDED_B(NumBl), STAT=ErrStat2 ) + IF ( ErrStat2 /= 0 ) THEN + CALL SetErrStat( ErrID_Fatal, 'Error allocating MeshMapData%BDED_L_2_AD_L_B and MeshMapData%AD_L_2_BDED_B.', & + ErrStat, ErrMsg, RoutineName ) + RETURN + END IF + + endif +!------------------------- +! Simplified-ElastoDyn <-> AeroDyn +!------------------------- + IF ( p_FAST%CompElast == Module_SED ) then + ! blade root meshes + DO K=1,NumBl + CALL MeshMapCreate( SED%y%BladeRootMotion(K), AD%Input(1)%rotors(1)%BladeRootMotion(K), MeshMapData%SED_P_2_AD_P_R(K), ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':SED_2_AD_RootMotion('//TRIM(Num2LStr(K))//')' ) + END DO + + ! Hub point mesh + CALL MeshMapCreate( SED%y%HubPtMotion, AD%Input(1)%rotors(1)%HubMotion, MeshMapData%SED_P_2_AD_P_H, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':SED_2_AD_HubMotion' ) + + ! Tower mesh: (SED does not use tower loads, so only motion mapped) + IF ( AD%Input(1)%rotors(1)%TowerMotion%Committed ) THEN + CALL MeshMapCreate( SED%y%TowerLn2Mesh, AD%Input(1)%rotors(1)%TowerMotion, MeshMapData%SED_L_2_AD_L_T, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':SED_2_AD_TowerMotion' ) + END IF + ! Nacelle mesh: (SED does not use nacelle loads, so only motion mapped) + IF ( AD%Input(1)%rotors(1)%NacelleMotion%Committed ) THEN + CALL MeshMapCreate( SED%y%NacelleMotion, AD%Input(1)%rotors(1)%NacelleMotion, MeshMapData%SED_P_2_AD_P_N, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':SED_2_AD_NacelleMotion' ) + endif + !------------------------- ! ElastoDyn <-> AeroDyn !------------------------- + ELSE ! ED or BD + ! blade root meshes + DO K=1,NumBl + CALL MeshMapCreate( ED%y%BladeRootMotion(K), AD%Input(1)%rotors(1)%BladeRootMotion(K), MeshMapData%ED_P_2_AD_P_R(K), ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':ED_2_AD_RootMotion('//TRIM(Num2LStr(K))//')' ) + END DO - ! blade root meshes - DO K=1,NumBl - CALL MeshMapCreate( ED%y%BladeRootMotion(K), AD%Input(1)%rotors(1)%BladeRootMotion(K), MeshMapData%ED_P_2_AD_P_R(K), ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':ED_2_AD_RootMotion('//TRIM(Num2LStr(K))//')' ) - END DO + ! Hub point mesh: + IF ( AD%Input(1)%rotors(1)%HubMotion%Committed ) THEN + CALL MeshMapCreate( ED%y%HubPtMotion, AD%Input(1)%rotors(1)%HubMotion, MeshMapData%ED_P_2_AD_P_H, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':ED_2_AD_HubMotion' ) + CALL MeshMapCreate( AD%y%rotors(1)%HubLoad, ED%Input(1)%HubPtLoad, MeshMapData%AD_P_2_ED_P_H, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':AD_2_ED_HubLoad' ) + + CALL MeshCopy( ED%Input(1)%HubPtLoad, MeshMapData%u_ED_HubPtLoad, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':u_ED_HubPtLoad' ) + END IF + - ! Hub point mesh: - IF ( AD%Input(1)%rotors(1)%HubMotion%Committed ) THEN - CALL MeshMapCreate( ED%y%HubPtMotion, AD%Input(1)%rotors(1)%HubMotion, MeshMapData%ED_P_2_AD_P_H, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':ED_2_AD_HubMotion' ) - CALL MeshMapCreate( AD%y%rotors(1)%HubLoad, ED%Input(1)%HubPtLoad, MeshMapData%AD_P_2_ED_P_H, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':AD_2_ED_HubLoad' ) + ! Tower mesh: + IF ( AD%Input(1)%rotors(1)%TowerMotion%Committed ) THEN + CALL MeshMapCreate( ED%y%TowerLn2Mesh, AD%Input(1)%rotors(1)%TowerMotion, MeshMapData%ED_L_2_AD_L_T, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':ED_2_AD_TowerMotion' ) + + IF ( AD%y%rotors(1)%TowerLoad%Committed ) THEN + CALL MeshMapCreate( AD%y%rotors(1)%TowerLoad, ED%Input(1)%TowerPtLoads, MeshMapData%AD_L_2_ED_P_T, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':AD_2_ED_TowerLoad' ) + END IF + END IF + + ! Nacelle mesh: + IF ( AD%Input(1)%rotors(1)%NacelleMotion%Committed ) THEN + CALL MeshMapCreate( ED%y%NacelleMotion, AD%Input(1)%rotors(1)%NacelleMotion, MeshMapData%ED_P_2_AD_P_N, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':ED_2_AD_NacelleMotion' ) + CALL MeshMapCreate( AD%y%rotors(1)%NacelleLoad, ED%Input(1)%NacelleLoads, MeshMapData%AD_P_2_ED_P_N, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':AD_2_ED_NacelleLoads' ) + if (.not. MeshMapData%u_ED_NacelleLoads%Committed ) then ! May have been set for NStC intance + CALL MeshCopy( ED%Input(1)%NacelleLoads, MeshMapData%u_ED_NacelleLoads, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':u_ED_NacelleLoads' ) + endif + END IF - CALL MeshCopy( ED%Input(1)%HubPtLoad, MeshMapData%u_ED_HubPtLoad, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':u_ED_HubPtLoad' ) + ! Tailfin mesh: + if ( AD%Input(1)%rotors(1)%TFinMotion%Committed ) then + CALL MeshMapCreate( ED%y%TFinCMMotion, AD%Input(1)%rotors(1)%TFinMotion, MeshMapData%ED_P_2_AD_P_TF, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':ED_2_AD_TailFinMotion' ) + CALL MeshMapCreate( AD%y%rotors(1)%TFinLoad, ED%Input(1)%TFinCMLoads, MeshMapData%AD_P_2_ED_P_TF, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':AD_2_ED_TailFinLoads' ) + endif END IF - - ! Tower mesh: - IF ( AD%Input(1)%rotors(1)%TowerMotion%Committed ) THEN - CALL MeshMapCreate( ED%y%TowerLn2Mesh, AD%Input(1)%rotors(1)%TowerMotion, MeshMapData%ED_L_2_AD_L_T, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':ED_2_AD_TowerMotion' ) - - IF ( AD%y%rotors(1)%TowerLoad%Committed ) THEN - CALL MeshMapCreate( AD%y%rotors(1)%TowerLoad, ED%Input(1)%TowerPtLoads, MeshMapData%AD_L_2_ED_P_T, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':AD_2_ED_TowerLoad' ) - END IF - END IF - - ! Nacelle mesh: - IF ( AD%Input(1)%rotors(1)%NacelleMotion%Committed ) THEN - CALL MeshMapCreate( ED%y%NacelleMotion, AD%Input(1)%rotors(1)%NacelleMotion, MeshMapData%ED_P_2_AD_P_N, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':ED_2_AD_NacelleMotion' ) - CALL MeshMapCreate( AD%y%rotors(1)%NacelleLoad, ED%Input(1)%NacelleLoads, MeshMapData%AD_P_2_ED_P_N, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':AD_2_ED_NacelleLoads' ) - if (.not. MeshMapData%u_ED_NacelleLoads%Committed ) then ! May have been set for NStC intance - CALL MeshCopy( ED%Input(1)%NacelleLoads, MeshMapData%u_ED_NacelleLoads, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':u_ED_NacelleLoads' ) - endif - endif - ! Tailfin mesh: - if ( AD%Input(1)%rotors(1)%TFinMotion%Committed ) then - CALL MeshMapCreate( ED%y%TFinCMMotion, AD%Input(1)%rotors(1)%TFinMotion, MeshMapData%ED_P_2_AD_P_TF, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':ED_2_AD_TailFinMotion' ) - CALL MeshMapCreate( AD%y%rotors(1)%TFinLoad, ED%Input(1)%TFinCMLoads, MeshMapData%AD_P_2_ED_P_TF, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':AD_2_ED_TailFinLoads' ) - endif - - IF ( p_FAST%CompElast == Module_ED ) then + IF ( p_FAST%CompElast == Module_SED ) then +!------------------------- +! Simplified-ElastoDyn <-> AeroDyn +!------------------------- + + ! Blade meshes: + DO K=1,NumBl + CALL MeshMapCreate( SED%y%BladeRootMotion(K), AD%Input(1)%rotors(1)%BladeMotion(K), MeshMapData%SED_P_2_AD_L_B(K), ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':SED_2_AD_BladeMotion('//TRIM(Num2LStr(K))//')' ) + CALL MeshMapCreate( AD%y%rotors(1)%BladeLoad(K), SED%Input(1)%HubPtLoad, MeshMapData%AD_L_2_SED_P(K), ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':AD_L_2_SED_P('//TRIM(Num2LStr(K))//')' ) + END DO + CALL MeshCopy ( SED%Input(1)%HubPtLoad, MeshMapData%u_SED_HubPtLoad, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':u_SED_HubPtLoad' ) + + ELSEIF ( p_FAST%CompElast == Module_ED ) then +!------------------------- +! ElastoDyn <-> AeroDyn +!------------------------- ! Blade meshes: DO K=1,NumBl @@ -4664,9 +4568,142 @@ SUBROUTINE InitModuleMappings(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, M END IF ! CompElast - END IF ! AeroDyn/AeroDyn14 to structural code - - + + ELSEIF ( p_FAST%CompAero == Module_ADsk ) THEN ! ED-ADsk + if (p_FAST%CompElast == Module_SED) then +!------------------------- +! Simplified-ElastoDyn <-> AeroDisk +!------------------------- + ! Hub point mesh + CALL MeshMapCreate( SED%y%HubPtMotion, ADsk%Input(1)%HubMotion, MeshMapData%SED_P_2_ADsk_P_H, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':SED_2_ADsk_HubMotion' ) + CALL MeshMapCreate( ADsk%y%AeroLoads, SED%Input(1)%HubPtLoad, MeshMapData%ADsk_P_2_SED_P_H, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':ADsk_2_SED_HubPtLoad' ) + else +!------------------------- +! ElastoDyn <-> AeroDisk +!------------------------- + ! Hub point mesh + CALL MeshMapCreate( ED%y%HubPtMotion, ADsk%Input(1)%HubMotion, MeshMapData%ED_P_2_ADsk_P_H, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':ED_2_ADsk_HubMotion' ) + CALL MeshMapCreate( ADsk%y%AeroLoads, ED%Input(1)%HubPtLoad, MeshMapData%ADsk_P_2_ED_P_H, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':ADsk_2_ED_HubPtLoad' ) + endif ! SED/ED + END IF ! AeroDyn14/AeroDyn/AeroDisk to structural code + + IF ( p_FAST%CompAero == Module_ExtLd ) THEN ! ED-ExtLd and/or BD-ExtLd + + NumBl = SIZE(ExtLd%u%BladeRootMotion) ! Get number of blades + + ! Allocate memory for mapping between ED and ExtLoad blade root meshes + ALLOCATE( MeshMapData%ED_P_2_ExtLd_P_R(NumBl), STAT=ErrStat2 ) + IF ( ErrStat2 /= 0 ) THEN + CALL SetErrStat( ErrID_Fatal, 'Error allocating MeshMapData%ED_P_2_ExtLd_P_R.', ErrStat, ErrMsg, RoutineName ) + RETURN + END IF + + ! Create the the mesh mapping for mapping between ED and ExtLoad blade root meshes + DO K=1,NumBl + CALL MeshMapCreate( ED%y%BladeRootMotion(K), ExtLd%u%BladeRootMotion(K), MeshMapData%ED_P_2_ExtLd_P_R(K), ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':ED_P_2_ExtLd_P_R('//TRIM(Num2LStr(K))//')' ) + END DO + + ! Hub point mesh + CALL MeshMapCreate( ED%y%HubPtMotion, ExtLd%u%HubMotion, MeshMapData%ED_P_2_ExtLd_P_H, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':ED_P_2_ExtLd_P_H' ) + + ! Blade meshes: (allocate two mapping data structures to number of blades, then allocate data inside the structures) + ALLOCATE( MeshMapData%BDED_L_2_ExtLd_P_B(NumBl), MeshMapData%ExtLd_P_2_BDED_B(NumBl), MeshMapData%AD_L_2_ExtLd_B(NumBl), STAT=ErrStat2 ) + IF ( ErrStat2 /= 0 ) THEN + CALL SetErrStat( ErrID_Fatal, 'Error allocating MeshMapData%BDED_L_2_ExtLd_P_B and MeshMapData%ExtLd_P_2_BDED_B.', & + ErrStat, ErrMsg, RoutineName ) + RETURN + END IF + + ! Create mapping for AD line mesh to ExtLoads point mesh + do k=1,NumBl + call MeshMapCreate( AD%y%rotors(1)%BladeLoad(k), ExtLd%y%BladeLoadAD(k), MeshMapData%AD_L_2_ExtLd_B(k), ErrStat2, ErrMsg2) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':AD_L_2_ExtLd_B('//TRIM(Num2LStr(K))//')' ) + end do + + IF ( p_FAST%CompElast == Module_ED ) then + + DO K=1,NumBl + ! Create mapping for ElastoDyn BldMotion line2 meshes to ExtLoads point mesh + CALL MeshMapCreate( ED%y%BladeLn2Mesh(K), ExtLd%u%BladeMotion(K), MeshMapData%BDED_L_2_ExtLd_P_B(K), ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':BDED_L_2_ExtLd_P_B('//TRIM(Num2LStr(K))//')' ) + ! Create mapping for ExtLoads point mesh to ElastoDyn BldMotion line2 mesh + CALL MeshMapCreate( ExtLd%y%BladeLoad(K), ED%Input(1)%BladePtLoads(K), MeshMapData%ExtLd_P_2_BDED_B(K), ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':ExtLd_P_2_BDED_B('//TRIM(Num2LStr(K))//')' ) + END DO + + ELSEIF ( p_FAST%CompElast == Module_BD ) then + + ! connect ExtLoads mesh with BeamDyn + DO K=1,NumBl + ! Create mapping for BeamDyn BldMotion line2 meshes to ExtLoads point mesh + CALL MeshMapCreate( BD%y(k)%BldMotion, ExtLd%u%BladeMotion(K), MeshMapData%BDED_L_2_ExtLd_P_B(K), ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':BDED_L_2_ExtLd_P_B('//TRIM(Num2LStr(K))//')' ) + ! Create mapping for ExtLoads point mesh to BeamDyn BldMotion line2 mesh + CALL MeshMapCreate( ExtLd%y%BladeLoad(K), BD%Input(1,k)%DistrLoad, MeshMapData%ExtLd_P_2_BDED_B(K), ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':ExtLd_P_2_BDED_B('//TRIM(Num2LStr(K))//')' ) + END DO + + IF (.not. p_FAST%BD_OutputSibling) then + + ! Blade meshes for load transfer: (allocate meshes at BD input locations for motions transferred from BD output locations) + ALLOCATE( MeshMapData%BD_L_2_BD_L(NumBl), MeshMapData%y_BD_BldMotion_4Loads(NumBl), STAT=ErrStat2 ) + IF ( ErrStat2 /= 0 ) THEN + CALL SetErrStat( ErrID_Fatal, 'Error allocating MeshMapData%BD_L_2_BD_L and MeshMapData%y_BD_BldMotion_4Loads.', & + ErrStat, ErrMsg, RoutineName ) + RETURN + END IF ! ( ErrStat2 /= 0 ) + + DO K=1,NumBl + ! create the new mesh: + CALL MeshCopy ( SrcMesh = BD%Input(1,k)%DistrLoad & + , DestMesh = MeshMapData%y_BD_BldMotion_4Loads(k) & + , CtrlCode = MESH_SIBLING & + , IOS = COMPONENT_OUTPUT & + , TranslationDisp = .TRUE. & + , Orientation = .TRUE. & + , RotationVel = .TRUE. & + , TranslationVel = .TRUE. & + , RotationAcc = .TRUE. & + , TranslationAcc = .TRUE. & + , ErrStat = ErrStat2 & + , ErrMess = ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + IF (ErrStat >= AbortErrLev) RETURN + + ! create the mapping: + CALL MeshMapCreate( BD%y(k)%BldMotion, MeshMapData%y_BD_BldMotion_4Loads(k), MeshMapData%BD_L_2_BD_L(K), ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':BD_L_2_BD_L('//TRIM(Num2LStr(K))//')' ) + END DO + + END IF !.not. p_FAST%BD_OutputSibling + + ENDIF ! ( p_FAST%CompElast == Module_BD ) + + ! Tower mesh: + IF ( ExtLd%u%TowerMotion%Committed ) THEN + CALL MeshMapCreate( ED%y%TowerLn2Mesh, ExtLd%u%TowerMotion, MeshMapData%ED_L_2_ExtLd_P_T, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':ED_L_2_ExtLd_P_T' ) + + IF ( ExtLd%y%TowerLoad%Committed ) THEN + CALL MeshMapCreate( ExtLd%y%TowerLoad, ED%Input(1)%TowerPtLoads, MeshMapData%ExtLd_P_2_ED_P_T, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':ExtLd_P_2_ED_P_T' ) + + IF ( ( AD%Input(1)%rotors(1)%TowerMotion%Committed ) .and. ( AD%y%rotors(1)%TowerLoad%Committed ) ) THEN + !Aerodyn to External loads + CALL MeshMapCreate( AD%y%rotors(1)%TowerLoad, ExtLd%y%TowerLoadAD, MeshMapData%AD_L_2_ExtLd_T, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':AD_L_2_ExLd_T' ) + END IF + + END IF ! ( ExtLd%y%TowerLoad%Committed ) + END IF ! ( ExtLd%u%TowerMotion%Committed ) + + END IF ! ( p_FAST%CompAero == Module_ExtLd ) IF ( p_FAST%CompHydro == Module_HD ) THEN ! HydroDyn-{ElastoDyn or SubDyn} @@ -4676,54 +4713,25 @@ SUBROUTINE InitModuleMappings(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, M CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':ED_P_2_HD_PRP_P' ) !------------------------- -! HydroDyn <-> ElastoDyn -!------------------------- - IF ( p_FAST%CompSub /= Module_SD ) THEN ! all of these get mapped to ElastoDyn ! (offshore floating with rigid substructure) - - IF ( HD%y%WAMITMesh%Committed ) THEN ! meshes for floating - ! HydroDyn WAMIT point mesh to/from ElastoDyn point mesh - CALL MeshMapCreate( HD%y%WAMITMesh, PlatformLoads, MeshMapData%HD_W_P_2_ED_P, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':HD_W_P_2_ED_P' ) - CALL MeshMapCreate( PlatformMotion, HD%Input(1)%WAMITMesh, MeshMapData%ED_P_2_HD_W_P, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':ED_P_2_HD_W_P' ) - END IF - - ! ElastoDyn point mesh HydroDyn Morison point mesh (ED sets inputs, but gets outputs from HD%y%WAMITMesh in floating case) - IF ( HD%Input(1)%Morison%Mesh%Committed ) THEN - CALL MeshMapCreate( HD%y%Morison%Mesh, PlatformLoads, MeshMapData%HD_M_P_2_ED_P, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':HD_M_P_2_ED_P' ) - CALL MeshMapCreate( PlatformMotion, HD%Input(1)%Morison%Mesh, MeshMapData%ED_P_2_HD_M_P, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':ED_P_2_HD_M_P' ) - END IF - - ELSE ! these get mapped to ElastoDyn AND SubDyn (in ED_SD_HD coupling) ! offshore with substructure flexibility - - - +! HydroDyn <-> ElastoDyn or SubDyn !------------------------- -! HydroDyn <-> SubDyn -!------------------------- - - ! HydroDyn Morison point mesh to SubDyn point mesh - IF ( HD%y%Morison%Mesh%Committed ) THEN - - CALL MeshMapCreate( HD%y%Morison%Mesh, SD%Input(1)%LMesh, MeshMapData%HD_M_P_2_SD_P, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':HD_M_P_2_SD_P' ) - CALL MeshMapCreate( SD%y%y2Mesh, HD%Input(1)%Morison%Mesh, MeshMapData%SD_P_2_HD_M_P, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':SD_P_2_HD_M_P' ) - END IF - - ! HydroDyn WAMIT point mesh to SD point mesh - IF ( HD%y%WAMITMesh%Committed ) THEN - - CALL MeshMapCreate( HD%y%WAMITMesh, SD%Input(1)%LMesh, MeshMapData%HD_W_P_2_SD_P, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':HD_W_P_2_SD_P' ) - CALL MeshMapCreate( SD%y%y2Mesh, HD%Input(1)%WAMITMesh, MeshMapData%SD_P_2_HD_W_P, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':SD_P_2_HD_W_P' ) - - END IF - - END IF ! HydroDyn-SubDyn + ! NOTE: HD-SD couple with y2 mesh NOT y3! + + IF ( HD%y%WAMITMesh%Committed ) THEN ! meshes for floating + ! HydroDyn WAMIT point mesh to/from ElastoDyn or SD point mesh + CALL MeshMapCreate( HD%y%WAMITMesh, SubstructureLoads, MeshMapData%HD_W_P_2_SubStructure, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':HD_W_P_2_SubStructure' ) + CALL MeshMapCreate( SubstructureMotion2HD, HD%Input(1)%WAMITMesh, MeshMapData%SubStructure_2_HD_W_P, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':SubStructure_2_HD_W_P' ) + END IF + + ! ElastoDyn or SD point mesh to HydroDyn Morison point mesh (ED sets inputs, but gets outputs from HD%y%WAMITMesh in floating case) + IF ( HD%Input(1)%Morison%Mesh%Committed ) THEN + CALL MeshMapCreate( HD%y%Morison%Mesh, SubstructureLoads, MeshMapData%HD_M_P_2_SubStructure, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':HD_M_P_2_SubStructure' ) + CALL MeshMapCreate( SubstructureMotion2HD, HD%Input(1)%Morison%Mesh, MeshMapData%SubStructure_2_HD_M_P, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':SubStructure_2_HD_M_P' ) + END IF IF (ErrStat >= AbortErrLev ) RETURN @@ -4756,86 +4764,53 @@ SUBROUTINE InitModuleMappings(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, M CALL MeshMapCreate( PlatformMotion, ExtPtfm%Input(1)%PtfmMesh, MeshMapData%ED_P_2_SD_TP, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':Ptfm_2_SD_TP' ) - END IF ! SubDyn-ElastoDyn + END IF ! SubDyn,ExtPtfm - ElastoDyn IF ( p_FAST%CompMooring == Module_MAP ) THEN - - IF ( p_FAST%CompSub == Module_SD ) THEN !------------------------- -! SubDyn <-> MAP -!------------------------- - ! MAP point mesh to/from SubDyn point mesh - CALL MeshMapCreate( MAPp%y%PtFairleadLoad, SD%Input(1)%LMesh, MeshMapData%Mooring_P_2_SD_P, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':Mooring_P_2_SD_P' ) - CALL MeshMapCreate( SD%y%y3Mesh, MAPp%Input(1)%PtFairDisplacement, MeshMapData%SDy3_P_2_Mooring_P, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':SDy3_P_2_Mooring_P' ) - ELSE +! SubDyn/ElastoDyn <-> MAP !------------------------- -! ElastoDyn <-> MAP -!------------------------- - ! MAP point mesh to/from ElastoDyn point mesh - CALL MeshMapCreate( MAPp%y%PtFairleadLoad, PlatformLoads, MeshMapData%Mooring_P_2_ED_P, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':Mooring_P_2_Ptfm' ) - CALL MeshMapCreate( PlatformMotion, MAPp%Input(1)%PtFairDisplacement, MeshMapData%ED_P_2_Mooring_P, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':Ptfm_2_Mooring_P' ) - END IF ! p_FAST%CompSub == Module_SD - + ! MAP point mesh to/from SubDyn or ElastoDyn point mesh + CALL MeshMapCreate( MAPp%y%PtFairleadLoad, SubstructureLoads, MeshMapData%Mooring_2_Structure, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':Mooring_2_Structure' ) + CALL MeshMapCreate( SubstructureMotion, MAPp%Input(1)%PtFairDisplacement, MeshMapData%Structure_2_Mooring, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':Structure_2_Mooring' ) + ELSEIF ( p_FAST%CompMooring == Module_MD ) THEN - IF ( p_FAST%CompSub == Module_SD ) THEN !------------------------- -! SubDyn <-> MoorDyn -!------------------------- - ! MoorDyn point mesh to/from SubDyn point mesh - CALL MeshMapCreate( MD%y%CoupledLoads(1), SD%Input(1)%LMesh, MeshMapData%Mooring_P_2_SD_P, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':Mooring_P_2_SD_P' ) - CALL MeshMapCreate( SD%y%y3Mesh, MD%Input(1)%CoupledKinematics(1), MeshMapData%SDy3_P_2_Mooring_P, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':SDy3_P_2_Mooring_P' ) - ELSE +! SubDyn/ElastoDyn <-> MoorDyn !------------------------- -! ElastoDyn <-> MoorDyn -!------------------------- - ! MoorDyn point mesh to/from ElastoDyn point mesh - CALL MeshMapCreate( MD%y%CoupledLoads(1), PlatformLoads, MeshMapData%Mooring_P_2_ED_P, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':Mooring_P_2_Ptfm' ) - CALL MeshMapCreate( PlatformMotion, MD%Input(1)%CoupledKinematics(1), MeshMapData%ED_P_2_Mooring_P, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':Ptfm_2_Mooring_P' ) - END IF ! p_FAST%CompSub == Module_SD + ! MoorDyn point mesh to/from SubDyn or ElastoDyn point mesh + CALL MeshMapCreate( MD%y%CoupledLoads(1), SubstructureLoads, MeshMapData%Mooring_2_Structure, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':Mooring_2_Structure' ) + CALL MeshMapCreate( SubstructureMotion, MD%Input(1)%CoupledKinematics(1), MeshMapData%Structure_2_Mooring, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':Structure_2_Mooring' ) ELSEIF ( p_FAST%CompMooring == Module_FEAM ) THEN - IF ( p_FAST%CompSub == Module_SD ) THEN !------------------------- -! SubDyn <-> FEAMooring -!------------------------- - ! FEAMooring point mesh to/from SubDyn point mesh - CALL MeshMapCreate( FEAM%y%PtFairleadLoad, SD%Input(1)%LMesh, MeshMapData%Mooring_P_2_SD_P, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':Mooring_P_2_SD_P' ) - CALL MeshMapCreate( SD%y%y3Mesh, FEAM%Input(1)%PtFairleadDisplacement, MeshMapData%SDy3_P_2_Mooring_P, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':SDy3_P_2_Mooring_P' ) - ELSE +! SubDyn/ElastoDyn <-> FEAMooring !------------------------- -! ElastoDyn <-> FEAMooring -!------------------------- - ! FEAMooring point mesh to/from ElastoDyn point mesh - CALL MeshMapCreate( FEAM%y%PtFairleadLoad, PlatformLoads, MeshMapData%Mooring_P_2_ED_P, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':Mooring_P_2_Ptfm' ) - CALL MeshMapCreate( PlatformMotion, FEAM%Input(1)%PtFairleadDisplacement, MeshMapData%ED_P_2_Mooring_P, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':Ptfm_2_Mooring_P' ) - END IF ! p_FAST%CompSub == Module_SD + ! FEAMooring point mesh to/from SubDyn or ElastoDyn point mesh + CALL MeshMapCreate( FEAM%y%PtFairleadLoad, SubstructureLoads, MeshMapData%Mooring_2_Structure, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':Mooring_2_Structure' ) + CALL MeshMapCreate( SubstructureMotion, FEAM%Input(1)%PtFairleadDisplacement, MeshMapData%Structure_2_Mooring, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':Structure_2_Mooring' ) + ELSEIF ( p_FAST%CompMooring == Module_Orca ) THEN !------------------------- ! ElastoDyn <-> OrcaFlex -!------------------------- +!------------------------- ! OrcaFlex point mesh to/from ElastoDyn point mesh - CALL MeshMapCreate( Orca%y%PtfmMesh, PlatformLoads, MeshMapData%Mooring_P_2_ED_P, ErrStat2, ErrMsg2 ) + CALL MeshMapCreate( Orca%y%PtfmMesh, PlatformLoads, MeshMapData%Mooring_2_Structure, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':Mooring_P_2_Ptfm' ) - CALL MeshMapCreate( PlatformMotion, Orca%Input(1)%PtfmMesh, MeshMapData%ED_P_2_Mooring_P, ErrStat2, ErrMsg2 ) + CALL MeshMapCreate( PlatformMotion, Orca%Input(1)%PtfmMesh, MeshMapData%Structure_2_Mooring, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':Ptfm_2_Mooring_P' ) - END IF ! MAP-ElastoDyn ; FEAM-ElastoDyn; Orca-ElastoDyn + END IF ! Mooring to substructure !------------------------- @@ -4845,10 +4820,10 @@ SUBROUTINE InitModuleMappings(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, M IF ( p_FAST%CompIce == Module_IceF ) THEN ! IceFloe iceMesh point mesh to SubDyn LMesh point mesh - CALL MeshMapCreate( IceF%y%iceMesh, SD%Input(1)%LMesh, MeshMapData%IceF_P_2_SD_P, ErrStat2, ErrMsg2 ) + CALL MeshMapCreate( IceF%y%iceMesh, SubstructureLoads, MeshMapData%IceF_P_2_SD_P, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':IceF_P_2_SD_P' ) ! SubDyn y3Mesh point mesh to IceFloe iceMesh point mesh - CALL MeshMapCreate( SD%y%y3Mesh, IceF%Input(1)%iceMesh, MeshMapData%SDy3_P_2_IceF_P, ErrStat2, ErrMsg2 ) + CALL MeshMapCreate( SubstructureMotion, IceF%Input(1)%iceMesh, MeshMapData%SDy3_P_2_IceF_P, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':SDy3_P_2_IceF_P' ) !------------------------- @@ -4867,10 +4842,10 @@ SUBROUTINE InitModuleMappings(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, M DO i = 1,p_FAST%numIceLegs ! IceDyn PointMesh point mesh to SubDyn LMesh point mesh - CALL MeshMapCreate( IceD%y(i)%PointMesh, SD%Input(1)%LMesh, MeshMapData%IceD_P_2_SD_P(i), ErrStat2, ErrMsg2 ) + CALL MeshMapCreate( IceD%y(i)%PointMesh, SubstructureLoads, MeshMapData%IceD_P_2_SD_P(i), ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':IceD_P_2_SD_P('//TRIM(num2LStr(i))//')' ) ! SubDyn y3Mesh point mesh to IceDyn PointMesh point mesh - CALL MeshMapCreate( SD%y%y3Mesh, IceD%Input(1,i)%PointMesh, MeshMapData%SDy3_P_2_IceD_P(i), ErrStat2, ErrMsg2 ) + CALL MeshMapCreate( SubstructureMotion, IceD%Input(1,i)%PointMesh, MeshMapData%SDy3_P_2_IceD_P(i), ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':SDy3_P_2_IceD_P('//TRIM(num2LStr(i))//')' ) END DO @@ -4882,15 +4857,16 @@ SUBROUTINE InitModuleMappings(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, M !............................................................................................................................ ! Initialize the Jacobian structures: !............................................................................................................................ - !IF ( p_FAST%TurbineType == Type_Offshore_Fixed ) THEN - IF ( p_FAST%CompSub /= Module_None .OR. (p_FAST%CompElast == Module_BD .and. BD_Solve_Option1) .or. p_FAST%CompMooring == Module_Orca) THEN !.OR. p_FAST%CompHydro == Module_HD ) THEN - CALL Init_FullOpt1_Jacobian( p_FAST, MeshMapData, ED%Input(1)%PlatformPtMesh, SD%Input(1)%TPMesh, SD%Input(1)%LMesh, & - HD%Input(1)%Morison%Mesh, HD%Input(1)%WAMITMesh, & - ED%Input(1)%HubPtLoad, BD%Input(1,:), Orca%Input(1)%PtfmMesh, ExtPtfm%Input(1)%PtfmMesh, ErrStat2, ErrMsg2) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ELSEIF ( p_FAST%CompHydro == Module_HD ) THEN + IF (.not. p_FAST%CompAeroMaps) THEN + IF ( p_FAST%SolveOption == Solve_FullOpt1 ) THEN + CALL Init_FullOpt1_Jacobian( p_FAST, MeshMapData, ED%Input(1)%PlatformPtMesh, SD%Input(1)%TPMesh, SD%Input(1)%LMesh, & + HD%Input(1)%Morison%Mesh, HD%Input(1)%WAMITMesh, & + ED%Input(1)%HubPtLoad, BD%Input(1,:), Orca%Input(1)%PtfmMesh, ExtPtfm%Input(1)%PtfmMesh, ErrStat2, ErrMsg2) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ELSEIF ( p_FAST%SolveOption == Solve_SimplifiedOpt1 ) THEN CALL AllocAry( MeshMapData%Jacobian_Opt1, SizeJac_ED_HD, SizeJac_ED_HD, 'Jacobian for Ptfm-HD coupling', ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ENDIF END IF IF ( ALLOCATED( MeshMapData%Jacobian_Opt1 ) ) THEN @@ -4903,38 +4879,39 @@ SUBROUTINE InitModuleMappings(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, M !............................................................................................................................ ! reset the remap flags (do this before making the copies else the copies will always have remap = true) !............................................................................................................................ - CALL ResetRemapFlags(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD ) + CALL ResetRemapFlags(p_FAST, ED, SED, BD, AD, ExtLd, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD ) !............................................................................................................................ ! initialize the temporary input meshes (for input-output solves in Solve Option 1): ! (note that we do this after ResetRemapFlags() so that the copies have remap=false) !............................................................................................................................ - IF ( p_FAST%CompHydro == Module_HD .OR. p_FAST%CompSub /= Module_None .OR. (p_FAST%CompElast == Module_BD .and. BD_Solve_Option1) & - .or. p_FAST%CompMooring == Module_Orca) THEN + IF ( p_FAST%SolveOption /= Solve_FullOpt2 .and. .not. p_FAST%CompAeroMaps) THEN ! Temporary meshes for transfering inputs to ED, HD, BD, Orca, and SD - CALL MeshCopy( ED%Input(1)%HubPtLoad, MeshMapData%u_ED_HubPtLoad, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':u_ED_HubPtLoad' ) - - CALL MeshCopy ( ED%Input(1)%PlatformPtMesh, MeshMapData%u_ED_PlatformPtMesh, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':u_ED_PlatformPtMesh' ) + CALL MeshCopy ( ED%Input(1)%HubPtLoad, MeshMapData%u_ED_HubPtLoad, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':u_ED_HubPtLoad' ) + + CALL MeshCopy ( SubStructureLoads, MeshMapData%SubstructureLoads_Tmp, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':SubstructureLoads_Tmp' ) - CALL MeshCopy ( ED%Input(1)%PlatformPtMesh, MeshMapData%u_ED_PlatformPtMesh_2, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':u_ED_PlatformPtMesh_2' ) + CALL MeshCopy ( SubStructureLoads, MeshMapData%SubstructureLoads_Tmp2, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':SubstructureLoads_Tmp2' ) + + CALL MeshCopy ( PlatformLoads, MeshMapData%PlatformLoads_Tmp, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':PlatformLoads_Tmp' ) - CALL MeshCopy ( ED%Input(1)%PlatformPtMesh, MeshMapData%u_ED_PlatformPtMesh_3, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':u_ED_PlatformPtMesh_3' ) + CALL MeshCopy ( PlatformLoads, MeshMapData%PlatformLoads_Tmp2, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':PlatformLoads_Tmp2' ) ! for now, setting up this additional load mesh for farm-level MD loads if in FAST.Farm (@mhall TODO: add more checks/handling) <<< if (p_FAST%FarmIntegration) then - CALL MeshCopy ( ED%Input(1)%PlatformPtMesh, MeshMapData%u_ED_PlatformPtMesh_MDf, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':u_ED_PlatformPtMesh_MDf' ) + CALL MeshCopy ( SubStructureLoads, MeshMapData%SubstructureLoads_Tmp_Farm, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':SubstructureLoads_Tmp_Farm' ) - ! need to initialize to zero? - MeshMapData%u_ED_PlatformPtMesh_MDf%Force = 0.0_ReKi - MeshMapData%u_ED_PlatformPtMesh_MDf%Moment = 0.0_ReKi + ! initialize to zero for safety (likely not necessary) + MeshMapData%SubstructureLoads_Tmp_Farm%Force = 0.0_ReKi + MeshMapData%SubstructureLoads_Tmp_Farm%Moment = 0.0_ReKi end if - IF ( p_FAST%CompElast == Module_BD ) THEN @@ -4958,18 +4935,8 @@ SUBROUTINE InitModuleMappings(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, M IF ( p_FAST%CompSub == Module_SD ) THEN - CALL MeshCopy ( SD%Input(1)%TPMesh, MeshMapData%u_SD_TPMesh, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':u_SD_TPMesh' ) - - IF ( p_FAST%CompHydro == Module_HD ) THEN - - CALL MeshCopy ( SD%Input(1)%LMesh, MeshMapData%u_SD_LMesh, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':u_SD_LMesh' ) - - CALL MeshCopy ( SD%Input(1)%LMesh, MeshMapData%u_SD_LMesh_2, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':u_SD_LMesh_2' ) - - END IF + CALL MeshCopy ( SD%Input(1)%TPMesh, MeshMapData%u_SD_TPMesh, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':u_SD_TPMesh' ) ELSE IF ( p_FAST%CompSub == Module_ExtPtfm ) THEN @@ -5000,10 +4967,11 @@ SUBROUTINE InitModuleMappings(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, M END IF - ELSEIF ( p_FAST%CompSub /= Module_SD ) THEN ! Platform loads from SrvD Structural control (TMDs) if not SD + ELSEIF ( p_FAST%CompSub /= Module_SD ) THEN ! Platform loads from SrvD Structural control (TMDs) to ED in Full Option2 solve; bjj note: solves with SD are always option 1, so this condition is always true (could replace ELSEIF with ELSE) + IF ( ALLOCATED(SrvD%Input(1)%SStCMotionMesh) ) THEN ! Platform TMD loads - CALL MeshCopy ( ED%Input(1)%PlatformPtMesh, MeshMapData%u_ED_PlatformPtMesh, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':u_ED_PlatformPtMesh' ) + CALL MeshCopy ( SubstructureLoads, MeshMapData%SubstructureLoads_Tmp, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':SubstructureLoads_Tmp' ) ENDIF END IF @@ -5019,8 +4987,8 @@ END SUBROUTINE InitModuleMappings !! once at the start of the n_t_global loop and once in the j_pc loop, using different states. !! *** Note that modules that do not have direct feedthrough should be called first. *** SUBROUTINE CalcOutputs_And_SolveForInputs( n_t_global, this_time, this_state, calcJacobian, NextJacCalcTime, & - p_FAST, m_FAST, WriteThisStep, ED, BD, & - SrvD, AD14, AD, IfW, OpFM, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat, ErrMsg ) + p_FAST, m_FAST, WriteThisStep, ED, SED, BD, & + SrvD, AD, ADsk, ExtLd, IfW, ExtInfw, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat, ErrMsg ) REAL(DbKi) , intent(in ) :: this_time !< The current simulation time (actual or time of prediction) INTEGER(IntKi) , intent(in ) :: this_state !< Index into the state array (current or predicted states) INTEGER(IntKi) , intent(in ) :: n_t_global !< current time step (used only for SrvD hack) @@ -5032,12 +5000,14 @@ SUBROUTINE CalcOutputs_And_SolveForInputs( n_t_global, this_time, this_state, ca LOGICAL , INTENT(IN ) :: WriteThisStep !< Will we print the WriteOutput values this step? TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data + TYPE(SED_Data), INTENT(INOUT) :: SED !< Simplified-ElastoDyn data TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data - TYPE(AeroDyn14_Data), INTENT(INOUT) :: AD14 !< AeroDyn14 data TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data + TYPE(AeroDisk_Data), INTENT(INOUT) :: ADsk !< AeroDisk data + TYPE(ExtLoads_Data), INTENT(INOUT) :: ExtLd !< ExtLoads data TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data - TYPE(OpenFOAM_Data), INTENT(INOUT) :: OpFM !< OpenFOAM data + TYPE(ExternalInflow_Data),INTENT(INOUT) :: ExtInfw !< ExternalInflow data TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HydroDyn data TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SubDyn data TYPE(ExtPtfm_Data), INTENT(INOUT) :: ExtPtfm !< ExtPtfm data @@ -5097,11 +5067,11 @@ SUBROUTINE CalcOutputs_And_SolveForInputs( n_t_global, this_time, this_state, ca !> Solve option 2 (modules without direct feedthrough): - CALL SolveOption2(this_time, this_state, p_FAST, m_FAST, ED, BD, AD14, AD, SD, SrvD, IfW, OpFM, MeshMapData, ErrStat2, ErrMsg2, n_t_global < 0, WriteThisStep) + CALL SolveOption2(this_time, this_state, p_FAST, m_FAST, ED, SED, BD, AD, ADsk, ExtLd, SD, SrvD, IfW, ExtInfw, MeshMapData, ErrStat2, ErrMsg2, n_t_global < 0, WriteThisStep) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) #ifdef OUTPUT_MASS_MATRIX - if (n_t_global == 0) then + if (n_t_global == 0 .and. p_FAST%CompElast /= Module_SED) then UnMM = -1 !$OMP critical(fileopen) CALL GetNewUnit( UnMM, ErrStat2, ErrMsg2 ) @@ -5118,28 +5088,13 @@ SUBROUTINE CalcOutputs_And_SolveForInputs( n_t_global, this_time, this_state, ca !> transfer SrvD outputs to other modules used in option 1: call Transfer_SrvD_to_SD_MD( p_FAST, SrvD%y, SD%Input(1), MD%Input(1) ) - !> transfer ED outputs to other modules used in option 1: - CALL Transfer_ED_to_HD_SD_BD_Mooring( p_FAST, ED%y, HD%Input(1), SD%Input(1), ExtPtfm%Input(1), & + !> transfer ED outputs to other modules used in option 1 (because we've already computed ED_CalcOutput in SolveOption2): + !> Note that this also calls SD_CalcOutput if SubDyn and HydroDyn are both used. + CALL Transfer_Structure_to_Opt1Inputs( this_time, this_state, p_FAST, ED%y, HD%Input(1), SD, ExtPtfm%Input(1), & MAPp%Input(1), FEAM%Input(1), MD%Input(1), & Orca%Input(1), BD%Input(1,:), SrvD%Input(1), MeshMapData, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - IF ( p_FAST%CompSub == Module_SD .and. p_FAST%CompHydro == Module_HD ) THEN - CALL SD_CalcOutput( this_time, SD%Input(1), SD%p, SD%x(this_state), SD%xd(this_state), SD%z(this_state), SD%OtherSt(this_state), SD%y, SD%m, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - call Transfer_SD_to_HD( SD%y, HD%Input(1)%WAMITMesh, HD%Input(1)%Morison%Mesh, MeshMapData, ErrStat, ErrMsg ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( p_FAST%CompMooring == Module_MAP ) THEN - CALL Transfer_Point_to_Point( SD%y%y3Mesh, MAPp%Input(1)%PtFairDisplacement, MeshMapData%SDy3_P_2_Mooring_P, ErrStat, ErrMsg ) - CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) - ELSEIF ( p_FAST%CompMooring == Module_MD ) THEN - CALL Transfer_Point_to_Point( SD%y%y3Mesh, MD%Input(1)%CoupledKinematics(1), MeshMapData%SDy3_P_2_Mooring_P, ErrStat, ErrMsg ) - CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) - ELSEIF ( p_FAST%CompMooring == Module_FEAM ) THEN - CALL Transfer_Point_to_Point( SD%y%y3Mesh, FEAM%Input(1)%PtFairleadDisplacement, MeshMapData%SDy3_P_2_Mooring_P, ErrStat, ErrMsg ) - CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) - END IF - END IF !> Solve option 1 (rigorous solve on loads/accelerations) CALL SolveOption1(this_time, this_state, calcJacobian, p_FAST, ED, BD, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, SrvD, AD, MeshMapData, ErrStat2, ErrMsg2, WriteThisStep) @@ -5148,43 +5103,35 @@ SUBROUTINE CalcOutputs_And_SolveForInputs( n_t_global, this_time, this_state, ca !> Now use the ElastoDyn and BD outputs from option1 to update the inputs for InflowWind, AeroDyn, and ServoDyn (necessary only if they have states) - IF ( p_FAST%CompAero == Module_AD14 ) THEN - - CALL AD14_InputSolve_NoIfW( p_FAST, AD14%Input(1), ED%y, MeshMapData, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! because we're not calling InflowWind_CalcOutput or getting new values from OpenFOAM, - ! this probably can be skipped - CALL AD14_InputSolve_IfW( p_FAST, AD14%Input(1), IfW%y, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ELSEIF ( p_FAST%CompAero == Module_AD ) THEN + IF ( p_FAST%CompAero == Module_AD ) THEN - CALL AD_InputSolve_NoIfW( p_FAST, AD%Input(1), SrvD%y, ED%y, BD, MeshMapData, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AD_InputSolve_NoIfW( p_FAST, AD%Input(1), SrvD%y, ED%y, SED%y, BD, MeshMapData, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ELSE IF (p_FAST%CompAero == Module_ExtLd ) THEN - ! because we're not calling InflowWind_CalcOutput or getting new values from OpenFOAM, - ! this probably can be skipped; - ! @todo: alternatively, we could call InflowWind_CalcOutput, too. - CALL AD_InputSolve_IfW( p_FAST, AD%Input(1), IfW%y, OpFM%y, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AD_InputSolve_NoIfW( p_FAST, AD%Input(1), SrvD%y, ED%y, SED%y, BD, MeshMapData, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL ExtLd_InputSolve_NoIfW( p_FAST, ExtLd%u, ExtLd%p, ED%y, BD, MeshMapData, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END IF IF ( p_FAST%CompInflow == Module_IfW ) THEN - CALL IfW_InputSolve( p_FAST, m_FAST, IfW%Input(1), IfW%p, AD14%Input(1), AD%Input(1), AD%OtherSt(this_state), ED%y, ErrStat2, ErrMsg2 ) + CALL IfW_InputSolve( p_FAST, m_FAST, IfW%Input(1), IfW%p, AD%Input(1), AD%OtherSt(this_state), ED%y, SED%y, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ELSE IF ( p_FAST%CompInflow == Module_OpFM ) THEN - ! OpenFOAM is the driver and it sets these inputs outside of this solve; the OpenFOAM inputs and outputs thus don't change - ! in this scenario until OpenFOAM takes another step **this is a source of error, but it is the way the OpenFOAM-FAST7 coupling + ELSE IF ( p_FAST%CompInflow == Module_ExtInfw ) THEN + ! ExternalInflow is the driver and it sets these inputs outside of this solve; the ExternalInflow inputs and outputs thus don't change + ! in this scenario until ExternalInflow takes another step **this is a source of error, but it is the way the ExternalInflow-FAST7 coupling ! works, so I'm not going to spend time that I don't have now to fix it** - CALL OpFM_SetInputs( p_FAST, AD%Input(1), AD%y, SrvD%y, OpFM, ErrStat2, ErrMsg2 ) + CALL ExtInfw_SetInputs( p_FAST, AD%Input(1), AD%y, SrvD%y, ExtInfw, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END IF IF ( p_FAST%CompServo == Module_SrvD ) THEN - CALL SrvD_InputSolve( p_FAST, m_FAST, SrvD%Input(1), ED%y, IfW%y, OpFM%y, BD%y, SD%y, MeshmapData, ErrStat2, ErrMsg2 ) + CALL SrvD_InputSolve( p_FAST, m_FAST, SrvD%Input(1), ED%y, SED%y, IfW%y, ExtInfw%y, ExtLd%p, BD%y, SD%y, MeshmapData, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END IF @@ -5198,7 +5145,7 @@ SUBROUTINE CalcOutputs_And_SolveForInputs( n_t_global, this_time, this_state, ca ! Reset each mesh's RemapFlag (after calling all InputSolve routines): !..................................................................... - CALL ResetRemapFlags(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) + CALL ResetRemapFlags(p_FAST, ED, SED, BD, AD, ExtLd, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) END SUBROUTINE CalcOutputs_And_SolveForInputs @@ -5207,33 +5154,28 @@ END SUBROUTINE CalcOutputs_And_SolveForInputs !! platform reference point. Also in solve option 1 are the BD-ED blade root coupling. SUBROUTINE SolveOption1(this_time, this_state, calcJacobian, p_FAST, ED, BD, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, SrvD, AD, MeshMapData, ErrStat, ErrMsg, WriteThisStep ) !............................................................................................................................... - REAL(DbKi) , intent(in ) :: this_time !< The current simulation time (actual or time of prediction) - INTEGER(IntKi) , intent(in ) :: this_state !< Index into the state array (current or predicted states) - LOGICAL , intent(in ) :: calcJacobian !< Should we calculate Jacobians in Option 1? - - TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code - - TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data - TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data - TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD ! ServoDyn data - !TYPE(AeroDyn14_Data), INTENT(INOUT) :: AD14 ! AeroDyn14 data - TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HydroDyn data - TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SubDyn data - TYPE(ExtPtfm_Data), INTENT(INOUT) :: ExtPtfm !< ExtPtfm data - TYPE(MAP_Data), INTENT(INOUT) :: MAPp !< MAP data - TYPE(FEAMooring_Data), INTENT(INOUT) :: FEAM !< FEAMooring data - TYPE(MoorDyn_Data), INTENT(INOUT) :: MD !< MoorDyn data - TYPE(OrcaFlex_Data), INTENT(INOUT) :: Orca !< OrcaFlex interface data - TYPE(IceFloe_Data), INTENT(INOUT) :: IceF !< IceFloe data - TYPE(IceDyn_Data), INTENT(INOUT) :: IceD !< All the IceDyn data used in time-step loop - TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data - - TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules - - - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - LOGICAL , INTENT(IN ) :: WriteThisStep !< Will we print the WriteOutput values this step? + REAL(DbKi) , intent(in ) :: this_time !< The current simulation time (actual or time of prediction) + INTEGER(IntKi) , intent(in ) :: this_state !< Index into the state array (current or predicted states) + LOGICAL , intent(in ) :: calcJacobian !< Should we calculate Jacobians in Option 1? + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code + TYPE(ElastoDyn_Data), TARGET, INTENT(INOUT) :: ED !< ElastoDyn data + TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data + TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data + TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data + TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HydroDyn data + TYPE(SubDyn_Data), TARGET, INTENT(INOUT) :: SD !< SubDyn data + TYPE(ExtPtfm_Data), INTENT(INOUT) :: ExtPtfm !< ExtPtfm data + TYPE(MAP_Data), INTENT(INOUT) :: MAPp !< MAP data + TYPE(FEAMooring_Data), INTENT(INOUT) :: FEAM !< FEAMooring data + TYPE(MoorDyn_Data), INTENT(INOUT) :: MD !< MoorDyn data + TYPE(OrcaFlex_Data), INTENT(INOUT) :: Orca !< OrcaFlex interface data + TYPE(IceFloe_Data), INTENT(INOUT) :: IceF !< IceFloe data + TYPE(IceDyn_Data), INTENT(INOUT) :: IceD !< All the IceDyn data used in time-step loop + TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules + + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + LOGICAL, INTENT(IN ) :: WriteThisStep !< Will we print the WriteOutput values this step? INTEGER :: i ! loop counter @@ -5241,6 +5183,7 @@ SUBROUTINE SolveOption1(this_time, this_state, calcJacobian, p_FAST, ED, BD, HD, CHARACTER(ErrMsgLen) :: ErrMSg2 CHARACTER(*), PARAMETER :: RoutineName = 'SolveOption1' + TYPE(MeshType), POINTER :: SubstructureMotion !............................................................................................................................ !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ @@ -5251,6 +5194,12 @@ SUBROUTINE SolveOption1(this_time, this_state, calcJacobian, p_FAST, ED, BD, HD, ErrStat = ErrID_None ErrMsg = "" + IF (p_FAST%CompSub == Module_SD) then + SubstructureMotion => SD%y%y3Mesh + ELSE + SubstructureMotion => ED%y%PlatformPtMesh + END IF + ! Because MAP, FEAM, MoorDyn, IceDyn, and IceFloe do not contain acceleration inputs, we do this outside the DO loop in the ED{_SD}_HD_InputOutput solves. IF ( p_FAST%CompMooring == Module_MAP ) THEN @@ -5301,7 +5250,7 @@ SUBROUTINE SolveOption1(this_time, this_state, calcJacobian, p_FAST, ED, BD, HD, IF (ErrStat >= AbortErrLev) RETURN - IF ( p_FAST%CompSub /= Module_None .OR. (p_FAST%CompElast == Module_BD .and. BD_Solve_Option1) .OR. p_FAST%CompMooring == Module_Orca ) THEN !.OR. p_FAST%CompHydro == Module_HD ) THEN + IF (p_FAST%SolveOption == Solve_FullOpt1) THEN CALL FullOpt1_InputOutputSolve( this_time, p_FAST, calcJacobian & , ED%Input(1), ED%p, ED%x( this_state), ED%xd( this_state), ED%z( this_state), ED%OtherSt( this_state), ED%y, ED%m & @@ -5321,7 +5270,7 @@ SUBROUTINE SolveOption1(this_time, this_state, calcJacobian, p_FAST, ED, BD, HD, CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ELSEIF ( p_FAST%CompHydro == Module_HD ) THEN ! No substructure model + ELSEIF ( p_FAST%SolveOption == Solve_SimplifiedOpt1 ) THEN ! No substructure model CALL ED_HD_InputOutputSolve( this_time, p_FAST, calcJacobian & , ED%Input(1), ED%p, ED%x(this_state), ED%xd(this_state), ED%z(this_state), ED%OtherSt(this_state), ED%y, ED%m & @@ -5340,48 +5289,33 @@ SUBROUTINE SolveOption1(this_time, this_state, calcJacobian, p_FAST, ED, BD, HD, IF ( p_FAST%CompMooring == Module_MAP ) THEN ! note: MAP_InputSolve must be called before setting ED loads inputs (so that motions are known for loads [moment] mapping) - if ( p_FAST%CompSub == Module_SD ) then - CALL Transfer_Point_to_Point( SD%y%y3Mesh, MAPp%Input(1)%PtFairDisplacement, MeshMapData%SDy3_P_2_Mooring_P, ErrStat, ErrMsg ) - CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) - else - CALL Transfer_Point_to_Point( ED%y%PlatformPtMesh, MAPp%Input(1)%PtFairDisplacement, MeshMapData%ED_P_2_Mooring_P, ErrStat, ErrMsg ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - end if + CALL Transfer_Point_to_Point( SubstructureMotion, MAPp%Input(1)%PtFairDisplacement, MeshMapData%Structure_2_Mooring, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) ELSEIF ( p_FAST%CompMooring == Module_MD ) THEN ! note: MD_InputSolve must be called before setting ED loads inputs (so that motions are known for loads [moment] mapping) - if ( p_FAST%CompSub == Module_SD ) then - CALL Transfer_Point_to_Point( SD%y%y3Mesh, MD%Input(1)%CoupledKinematics(1), MeshMapData%SDy3_P_2_Mooring_P, ErrStat, ErrMsg ) - CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) - else - CALL Transfer_Point_to_Point( ED%y%PlatformPtMesh, MD%Input(1)%CoupledKinematics(1), MeshMapData%ED_P_2_Mooring_P, ErrStat, ErrMsg ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - endif + CALL Transfer_Point_to_Point( SubstructureMotion, MD%Input(1)%CoupledKinematics(1), MeshMapData%Structure_2_Mooring, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) ELSEIF ( p_FAST%CompMooring == Module_FEAM ) THEN - ! note: FEAM_InputSolve must be called before setting ED loads inputs (so that motions are known for loads [moment] mapping) - if ( p_FAST%CompSub == Module_SD ) then - CALL Transfer_Point_to_Point( SD%y%y3Mesh, FEAM%Input(1)%PtFairleadDisplacement, MeshMapData%SDy3_P_2_Mooring_P, ErrStat, ErrMsg ) - CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) - else - CALL Transfer_Point_to_Point( ED%y%PlatformPtMesh, FEAM%Input(1)%PtFairleadDisplacement, MeshMapData%ED_P_2_Mooring_P, ErrStat, ErrMsg ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - end if - - END IF + ! note: FEAM_InputSolve must be called before setting ED loads inputs (so that motions are known for loads [moment] mapping) + CALL Transfer_Point_to_Point( SubstructureMotion, FEAM%Input(1)%PtFairleadDisplacement, MeshMapData%Structure_2_Mooring, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) + + END IF IF ( p_FAST%CompIce == Module_IceF ) THEN - CALL IceFloe_InputSolve( IceF%Input(1), SD%y, MeshMapData, ErrStat2, ErrMsg2 ) + CALL IceFloe_InputSolve( IceF%Input(1), SubstructureMotion, MeshMapData, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ELSEIF ( p_FAST%CompIce == Module_IceD ) THEN DO i=1,p_FAST%numIceLegs - CALL IceD_InputSolve( IceD%Input(1,i), SD%y, MeshMapData, i, ErrStat2, ErrMsg2 ) + CALL IceD_InputSolve( IceD%Input(1,i), SubstructureMotion, MeshMapData, i, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':IceD_InputSolve' ) END DO @@ -5389,15 +5323,10 @@ SUBROUTINE SolveOption1(this_time, this_state, calcJacobian, p_FAST, ED, BD, HD, END IF - ! Map motions for ServodDyn Structural control (TMD) if used. - IF ( p_FAST%CompServo == Module_SrvD ) THEN - IF ( p_FAST%CompSub /= Module_SD ) THEN - call Transfer_ED_to_SStC( SrvD%Input(1), ED%y, MeshMapData, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - ELSEIF ( p_FAST%CompSub == Module_SD ) THEN - call Transfer_SD_to_SStC( SrvD%Input(1), SD%y, MeshMapData, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - ENDIF + ! Map motions for ServodDyn Structural control (TMD) if used (not allowed with SED). + IF ( p_FAST%CompServo == Module_SrvD .and. p_FAST%CompElast /= Module_SED ) THEN + call Transfer_Substructure_to_SStC( SrvD%Input(1), SubstructureMotion, MeshMapData, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) END IF @@ -5411,19 +5340,14 @@ SUBROUTINE SolveOption1(this_time, this_state, calcJacobian, p_FAST, ED, BD, HD, CALL WriteMappingTransferToFile(SD%Input(1)%LMesh, SD%y%Y2Mesh, HD%Input(1)%Morison%Mesh, HD%y%Morison%Mesh,& - MeshMapData%SD_P_2_HD_M_P, MeshMapData%HD_M_P_2_SD_P, & + MeshMapData%SubStructure_2_HD_M_P, MeshMapData%HD_M_P_2_SubStructure, & 'SD_y2_HD_M_L_Meshes_t'//TRIM(Num2LStr(0))//'.PHL.bin' ) - - - - !print * - !pause #endif END SUBROUTINE SolveOption1 !---------------------------------------------------------------------------------------------------------------------------------- !> This routine implements the first part of the "option 2" solve for inputs that apply to BeamDyn and AeroDyn -SUBROUTINE SolveOption2a_Inp2BD(this_time, this_state, p_FAST, m_FAST, ED, BD, AD14, AD, SrvD, IfW, OpFM, MeshMapData, ErrStat, ErrMsg, WriteThisStep) +SUBROUTINE SolveOption2a_Inp2BD(this_time, this_state, p_FAST, m_FAST, ED, SED, BD, AD, ADsk, SrvD, IfW, ExtInfw, MeshMapData, ErrStat, ErrMsg, WriteThisStep) REAL(DbKi) , intent(in ) :: this_time !< The current simulation time (actual or time of prediction) INTEGER(IntKi) , intent(in ) :: this_state !< Index into the state array (current or predicted states) @@ -5431,12 +5355,13 @@ SUBROUTINE SolveOption2a_Inp2BD(this_time, this_state, p_FAST, m_FAST, ED, BD, A TYPE(FAST_MiscVarType), INTENT(IN ) :: m_FAST !< Misc variables for the glue code (including external inputs) TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data + TYPE(SED_Data), INTENT(INOUT) :: SED !< Simplified-ElastoDyn data TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data - TYPE(AeroDyn14_Data), INTENT(INOUT) :: AD14 !< AeroDyn14 data TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data + TYPE(AeroDisk_Data), INTENT(INOUT) :: ADsk !< AeroDisk data TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data - TYPE(OpenFOAM_Data), INTENT(INOUT) :: OpFM !< OpenFOAM data + TYPE(ExternalInflow_Data),INTENT(INOUT) :: ExtInfw !< ExternalInflow data TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules @@ -5456,7 +5381,11 @@ SUBROUTINE SolveOption2a_Inp2BD(this_time, this_state, p_FAST, m_FAST, ED, BD, A ErrStat = ErrID_None ErrMsg = "" - + + IF ( p_FAST%CompElast == Module_SED ) THEN + CALL SED_CalcOutput( this_time, SED%Input(1), SED%p, SED%x(this_state), SED%xd(this_state), SED%z(this_state), SED%OtherSt(this_state), SED%y, SED%m, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ELSE CALL ED_CalcOutput( this_time, ED%Input(1), ED%p, ED%x(this_state), ED%xd(this_state), ED%z(this_state), ED%OtherSt(this_state), ED%y, ED%m, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -5465,12 +5394,13 @@ SUBROUTINE SolveOption2a_Inp2BD(this_time, this_state, p_FAST, m_FAST, ED, BD, A CALL Transfer_ED_to_BD(ED%y, BD%Input(1,:), MeshMapData, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat, ErrMsg,RoutineName ) END IF - + + END IF END SUBROUTINE SolveOption2a_Inp2BD !---------------------------------------------------------------------------------------------------------------------------------- !> This routine implements the first part of the "option 2" solve for inputs that apply to AeroDyn & InflowWind -SUBROUTINE SolveOption2b_Inp2IfW(this_time, this_state, p_FAST, m_FAST, ED, BD, AD14, AD, SrvD, IfW, OpFM, MeshMapData, ErrStat, ErrMsg, WriteThisStep) +SUBROUTINE SolveOption2b_Inp2IfW(this_time, this_state, p_FAST, m_FAST, ED, SED, BD, AD, ADsk, SrvD, IfW, ExtInfw, MeshMapData, ErrStat, ErrMsg, WriteThisStep) REAL(DbKi) , intent(in ) :: this_time !< The current simulation time (actual or time of prediction) INTEGER(IntKi) , intent(in ) :: this_state !< Index into the state array (current or predicted states) @@ -5478,12 +5408,13 @@ SUBROUTINE SolveOption2b_Inp2IfW(this_time, this_state, p_FAST, m_FAST, ED, BD, TYPE(FAST_MiscVarType), INTENT(IN ) :: m_FAST !< Misc variables for the glue code (including external inputs) TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data + TYPE(SED_Data), INTENT(INOUT) :: SED !< Simplified-ElastoDyn data TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data - TYPE(AeroDyn14_Data), INTENT(INOUT) :: AD14 !< AeroDyn14 data TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data + TYPE(AeroDisk_Data), INTENT(INOUT) :: ADsk !< AeroDisk data TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data - TYPE(OpenFOAM_Data), INTENT(INOUT) :: OpFM !< OpenFOAM data + TYPE(ExternalInflow_Data),INTENT(INOUT) :: ExtInfw !< ExternalInflow data TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules @@ -5492,7 +5423,7 @@ SUBROUTINE SolveOption2b_Inp2IfW(this_time, this_state, p_FAST, m_FAST, ED, BD, CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None LOGICAL , INTENT(IN ) :: WriteThisStep !< Will we print the WriteOutput values this step? - INTEGER(IntKi) :: k + INTEGER(IntKi) :: k, node INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMSg2 @@ -5516,28 +5447,27 @@ SUBROUTINE SolveOption2b_Inp2IfW(this_time, this_state, p_FAST, m_FAST, ED, BD, END IF ! find the positions where we want inflow wind in AeroDyn (i.e., set all the motion inputs to AeroDyn) - IF ( p_FAST%CompAero == Module_AD14 ) THEN - - CALL AD14_InputSolve_NoIfW( p_FAST, AD14%Input(1), ED%y, MeshMapData, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ELSE IF ( p_FAST%CompAero == Module_AD ) THEN + IF ( ( p_FAST%CompAero == Module_AD ) .OR. (p_FAST%CompAero == Module_ExtLd) ) THEN ! note that this uses BD outputs, which are from the previous step (and need to be initialized) - CALL AD_InputSolve_NoIfW( p_FAST, AD%Input(1), SrvD%y, ED%y, BD, MeshMapData, ErrStat2, ErrMsg2 ) + CALL AD_InputSolve_NoIfW( p_FAST, AD%Input(1), SrvD%y, ED%y, SED%y, BD, MeshMapData, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + - END IF + ELSE IF ( p_FAST%CompAero == Module_ADsk ) THEN + CALL ADsk_InputSolve_NoIfW( p_FAST, ADsk%Input(1), ED%y, SED%y, MeshMapData, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END IF IF (p_FAST%CompInflow == Module_IfW) THEN ! must be done after ED_CalcOutput and before AD_CalcOutput and SrvD - CALL IfW_InputSolve( p_FAST, m_FAST, IfW%Input(1), IfW%p, AD14%Input(1), AD%Input(1), AD%OtherSt(this_state), ED%y, ErrStat2, ErrMsg2 ) ! do we want this to be curr states + CALL IfW_InputSolve( p_FAST, m_FAST, IfW%Input(1), IfW%p, AD%Input(1), AD%OtherSt(this_state), ED%y, SED%y, ErrStat2, ErrMsg2 ) ! do we want this to be curr states CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - !ELSE IF ( p_FAST%CompInflow == Module_OpFM ) THEN - ! ! OpenFOAM is the driver and it computes outputs outside of this solve; the OpenFOAM inputs and outputs thus don't change - ! ! in this scenario until OpenFOAM takes another step **this is a source of error, but it is the way the OpenFOAM-FAST7 coupling + !ELSE IF ( p_FAST%CompInflow == Module_ExtInfw ) THEN + ! ! ExternalInflow is the driver and it computes outputs outside of this solve; the ExternalInflow inputs and outputs thus don't change + ! ! in this scenario until ExternalInflow takes another step **this is a source of error, but it is the way the ExternalInflow-FAST7 coupling ! ! works, so I'm not going to spend time that I don't have now to fix it** - ! CALL OpFM_SetInputs( p_FAST, AD14%p, AD14%Input(1), AD14%y, AD%Input(1), AD%y, ED%y, SrvD%y, OpFM, ErrStat2, ErrMsg2 ) + ! CALL ExtInfw_SetInputs( p_FAST, AD%Input(1), AD%y, ED%y, SrvD%y, ExtInfw, ErrStat2, ErrMsg2 ) ! CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END IF @@ -5545,7 +5475,7 @@ SUBROUTINE SolveOption2b_Inp2IfW(this_time, this_state, p_FAST, m_FAST, ED, BD, END SUBROUTINE SolveOption2b_Inp2IfW !---------------------------------------------------------------------------------------------------------------------------------- !> This routine implements the first part of the "option 2" solve for inputs that apply to AeroDyn and ServoDyn. -SUBROUTINE SolveOption2c_Inp2AD_SrvD(this_time, this_state, p_FAST, m_FAST, ED, BD, AD14, AD, SD, SrvD, IfW, OpFM, MeshMapData, ErrStat, ErrMsg, WriteThisStep) +SUBROUTINE SolveOption2c_Inp2AD_SrvD(this_time, this_state, p_FAST, m_FAST, ED, SED, BD, AD, ADsk, ExtLd, SD, SrvD, IfW, ExtInfw, MeshMapData, ErrStat, ErrMsg, WriteThisStep) REAL(DbKi) , intent(in ) :: this_time !< The current simulation time (actual or time of prediction) INTEGER(IntKi) , intent(in ) :: this_state !< Index into the state array (current or predicted states) @@ -5553,13 +5483,15 @@ SUBROUTINE SolveOption2c_Inp2AD_SrvD(this_time, this_state, p_FAST, m_FAST, ED, TYPE(FAST_MiscVarType), INTENT(IN ) :: m_FAST !< Misc variables for the glue code (including external inputs) TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data + TYPE(SED_Data), INTENT(INOUT) :: SED !< Simplified-ElastoDyn data TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SubDyn data TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data - TYPE(AeroDyn14_Data), INTENT(INOUT) :: AD14 !< AeroDyn14 data TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data + TYPE(AeroDisk_Data), INTENT(INOUT) :: ADsk !< AeroDisk data + TYPE(ExtLoads_Data), INTENT(INOUT) :: ExtLd !< ExtLoads data TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data - TYPE(OpenFOAM_Data), INTENT(INOUT) :: OpFM !< OpenFOAM data + TYPE(ExternalInflow_Data),INTENT(INOUT) :: ExtInfw !< ExternalInflow data TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules @@ -5583,40 +5515,35 @@ SUBROUTINE SolveOption2c_Inp2AD_SrvD(this_time, this_state, p_FAST, m_FAST, ED, IF (p_FAST%CompInflow == Module_IfW) THEN ! get Lidar position directly from hub mesh (may map meshes later) - IfW%Input%lidar%HubDisplacementX = ED%y%HubPtMotion%TranslationDisp(1,1) - IfW%Input%lidar%HubDisplacementY = ED%y%HubPtMotion%TranslationDisp(2,1) - IfW%Input%lidar%HubDisplacementZ = ED%y%HubPtMotion%TranslationDisp(3,1) + if ( p_FAST%CompElast == Module_SED ) then + IfW%Input(1)%lidar%HubDisplacementX = SED%y%HubPtMotion%TranslationDisp(1,1) + IfW%Input(1)%lidar%HubDisplacementY = SED%y%HubPtMotion%TranslationDisp(2,1) + IfW%Input(1)%lidar%HubDisplacementZ = SED%y%HubPtMotion%TranslationDisp(3,1) + else + IfW%Input(1)%lidar%HubDisplacementX = ED%y%HubPtMotion%TranslationDisp(1,1) + IfW%Input(1)%lidar%HubDisplacementY = ED%y%HubPtMotion%TranslationDisp(2,1) + IfW%Input(1)%lidar%HubDisplacementZ = ED%y%HubPtMotion%TranslationDisp(3,1) + endif CALL InflowWind_CalcOutput( this_time, IfW%Input(1), IfW%p, IfW%x(this_state), IfW%xd(this_state), IfW%z(this_state), & IfW%OtherSt(this_state), IfW%y, IfW%m, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - !ELSE IF ( p_FAST%CompInflow == Module_OpFM ) THEN - ! ! OpenFOAM is the driver and it computes outputs outside of this solve; the OpenFOAM inputs and outputs thus don't change - ! ! in this scenario until OpenFOAM takes another step **this is a source of error, but it is the way the OpenFOAM-FAST7 coupling - ! ! works, so I'm not going to spend time that I don't have now to fix it** - ! CALL OpFM_SetInputs( p_FAST, AD%Input(1), AD%y, ED%y, SrvD%y, OpFM, ErrStat2, ErrMsg2 ) - ! CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ! CALL OpFM_SetWriteOutput(OpFM) - - END IF - - IF ( p_FAST%CompAero == Module_AD14 ) THEN - - CALL AD14_InputSolve_IfW( p_FAST, AD14%Input(1), IfW%y, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ELSE IF ( p_FAST%CompAero == Module_AD ) THEN - - CALL AD_InputSolve_IfW( p_FAST, AD%Input(1), IfW%y, OpFM%y, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ELSE IF ( p_FAST%CompInflow == Module_ExtInfw ) THEN + ! ExternalInflow is the driver and it computes outputs outside of this solve; the ExternalInflow inputs and outputs thus don't change + ! in this scenario until ExternalInflow takes another step **this is a source of error, but it is the way the OpenFOAM-FAST7 coupling + ! works, so I'm not going to spend time that I don't have now to fix it** + ! The outputs from ExternalInflow need to be transfered to the FlowField for use by AeroDyn, this seems like the right place + call ExtInfw_UpdateFlowField(p_FAST, ExtInfw, ErrStat2, ErrMsg2) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ! CALL ExtInfw_SetInputs( p_FAST, AD%Input(1), AD%y, ED%y, SrvD%y, ExtInfw, ErrStat2, ErrMsg2 ) + ! CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ! CALL ExtInfw_SetWriteOutput(OpFM) END IF - - - IF ( p_FAST%CompServo == Module_SrvD ) THEN - CALL SrvD_InputSolve( p_FAST, m_FAST, SrvD%Input(1), ED%y, IfW%y, OpFM%y, BD%y, SD%y, MeshMapData, ErrStat2, ErrMsg2 ) + IF ( p_FAST%CompServo == Module_SrvD ) THEN + CALL SrvD_InputSolve( p_FAST, m_FAST, SrvD%Input(1), ED%y, SED%y, IfW%y, ExtInfw%y, ExtLd%p, BD%y, SD%y, MeshMapData, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END IF @@ -5624,7 +5551,7 @@ END SUBROUTINE SolveOption2c_Inp2AD_SrvD !---------------------------------------------------------------------------------------------------------------------------------- !> This routine implements the "option 2" solve for all inputs without direct links to HD, SD, MAP, or the ED platform reference !! point. -SUBROUTINE SolveOption2(this_time, this_state, p_FAST, m_FAST, ED, BD, AD14, AD, SD, SrvD, IfW, OpFM, MeshMapData, ErrStat, ErrMsg, firstCall, WriteThisStep) +SUBROUTINE SolveOption2(this_time, this_state, p_FAST, m_FAST, ED, SED, BD, AD, ADsk, ExtLd, SD, SrvD, IfW, ExtInfw, MeshMapData, ErrStat, ErrMsg, firstCall, WriteThisStep) !............................................................................................................................... LOGICAL , intent(in ) :: firstCall !< flag to determine how to call ServoDyn (a hack) REAL(DbKi) , intent(in ) :: this_time !< The current simulation time (actual or time of prediction) @@ -5634,13 +5561,15 @@ SUBROUTINE SolveOption2(this_time, this_state, p_FAST, m_FAST, ED, BD, AD14, AD, TYPE(FAST_MiscVarType), INTENT(IN ) :: m_FAST !< Misc variables for the glue code (including external inputs) TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data + TYPE(SED_Data), INTENT(INOUT) :: SED !< Simplified-ElastoDyn data TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SubDyn data TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data - TYPE(AeroDyn14_Data), INTENT(INOUT) :: AD14 !< AeroDyn14 data TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data + TYPE(AeroDisk_Data), INTENT(INOUT) :: ADsk !< AeroDisk data + TYPE(ExtLoads_Data), INTENT(INOUT) :: ExtLD !< ExtLoads data TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data - TYPE(OpenFOAM_Data), INTENT(INOUT) :: OpFM !< OpenFOAM data + TYPE(ExternalInflow_Data),INTENT(INOUT) :: ExtInfw !< ExternalInflow data TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules @@ -5666,28 +5595,37 @@ SUBROUTINE SolveOption2(this_time, this_state, p_FAST, m_FAST, ED, BD, AD14, AD, ! SolveOption2* routines are being called in FAST_AdvanceStates, but the first time we call CalcOutputs_And_SolveForInputs, we haven't called the AdvanceStates routine IF (firstCall) THEN ! call ElastoDyn's CalcOutput & compute BD inputs from ED: - CALL SolveOption2a_Inp2BD(this_time, this_state, p_FAST, m_FAST, ED, BD, AD14, AD, SrvD, IfW, OpFM, MeshMapData, ErrStat2, ErrMsg2, WriteThisStep) + CALL SolveOption2a_Inp2BD(this_time, this_state, p_FAST, m_FAST, ED, SED, BD, AD, ADsk, SrvD, IfW, ExtInfw, MeshMapData, ErrStat2, ErrMsg2, WriteThisStep) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ! compute AD position inputs; compute all of IfW inputs from ED/BD outputs: - CALL SolveOption2b_Inp2IfW(this_time, this_state, p_FAST, m_FAST, ED, BD, AD14, AD, SrvD, IfW, OpFM, MeshMapData, ErrStat2, ErrMsg2, WriteThisStep) + CALL SolveOption2b_Inp2IfW(this_time, this_state, p_FAST, m_FAST, ED, SED, BD, AD, ADsk, SrvD, IfW, ExtInfw, MeshMapData, ErrStat2, ErrMsg2, WriteThisStep) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ! call IfW's CalcOutput; transfer wind-inflow inputs to AD; compute all of SrvD inputs: - CALL SolveOption2c_Inp2AD_SrvD(this_time, this_state, p_FAST, m_FAST, ED, BD, AD14, AD, SD, SrvD, IfW, OpFM, MeshMapData, ErrStat2, ErrMsg2, WriteThisStep) + CALL SolveOption2c_Inp2AD_SrvD(this_time, this_state, p_FAST, m_FAST, ED, SED, BD, AD, ADsk, ExtLd, SD, SrvD, IfW, ExtInfw, MeshMapData, ErrStat2, ErrMsg2, WriteThisStep) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ! ELSE ! these subroutines are called in the AdvanceStates routine before BD, IfW, AD, and SrvD states are updated. This gives a more accurate solution that would otherwise require a correction step. END IF - IF ( p_FAST%CompAero == Module_AD14 ) THEN - - CALL AD14_CalcOutput( this_time, AD14%Input(1), AD14%p, AD14%x(this_state), AD14%xd(this_state), AD14%z(this_state), & - AD14%OtherSt(this_state), AD14%y, AD14%m, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ELSE IF ( p_FAST%CompAero == Module_AD ) THEN + IF ( p_FAST%CompAero == Module_AD ) THEN CALL AD_CalcOutput( this_time, AD%Input(1), AD%p, AD%x(this_state), AD%xd(this_state), AD%z(this_state), & AD%OtherSt(this_state), AD%y, AD%m, ErrStat2, ErrMsg2, WriteThisStep ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ELSE IF ( p_FAST%CompAero == Module_ADsk ) THEN + CALL ADsk_CalcOutput( this_time, ADsk%Input(1), ADsk%p, ADsk%x(this_state), ADsk%xd(this_state), ADsk%z(this_state), & + ADsk%OtherSt(this_state), ADsk%y, ADsk%m, ErrStat2, ErrMsg2, WriteThisStep ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ELSE IF (p_FAST%CompAero == Module_ExtLd ) THEN + + CALL AD_CalcOutput( this_time, AD%Input(1), AD%p, AD%x(this_state), AD%xd(this_state), AD%z(this_state), & + AD%OtherSt(this_state), AD%y, AD%m, ErrStat2, ErrMsg2, WriteThisStep ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL ExtLd_CalcOutput( this_time, ExtLd%u, ExtLd%p, ExtLd%x(this_state), ExtLd%xd(this_state), ExtLd%z(this_state), & + ExtLd%OtherSt(this_state), ExtLd%y, ExtLd%m, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END IF @@ -5700,29 +5638,34 @@ SUBROUTINE SolveOption2(this_time, this_state, p_FAST, m_FAST, ED, BD, AD14, AD, END IF - IF ( p_FAST%CompInflow == Module_OpFM ) THEN - ! OpenFOAM is the driver and it computes outputs outside of this solve; the OpenFOAM inputs and outputs thus don't change - ! in this scenario until OpenFOAM takes another step **this is a source of error, but it is the way the OpenFOAM-FAST7 coupling + IF ( p_FAST%CompInflow == Module_ExtInfw ) THEN + ! ExternalInflow is the driver and it computes outputs outside of this solve; the ExternalInflow inputs and outputs thus don't change + ! in this scenario until ExternalInflow takes another step **this is a source of error, but it is the way the ExternalInflow-FAST7 coupling ! works, so I'm not going to spend time that I don't have now to fix it** - ! note that I'm setting these inputs AFTER the call to ServoDyn so OpenFOAM gets all the inputs updated at the same step - CALL OpFM_SetInputs( p_FAST, AD%Input(1), AD%y, SrvD%y, OpFM, ErrStat2, ErrMsg2 ) + ! note that I'm setting these inputs AFTER the call to ServoDyn so ExternalInflow gets all the inputs updated at the same step + CALL ExtInfw_SetInputs( p_FAST, AD%Input(1), AD%y, SrvD%y, ExtInfw, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL OpFM_SetWriteOutput(OpFM) + CALL ExtInfw_SetWriteOutput(ExtInfw) END IF !bjj: note ED%Input(1) may be a sibling mesh of output, but ED%u is not (routine may update something that needs to be shared between siblings) - CALL ED_InputSolve( p_FAST, ED%Input(1), ED%y, AD14%p, AD14%y, AD%y, SrvD%y, AD%Input(1), SrvD%Input(1), MeshMapData, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + if (p_FAST%CompElast == Module_SED) then + CALL SED_InputSolve( p_FAST, SED%Input(1), SED%y, AD%y, ADsk%y, SrvD%y, AD%Input(1), ADsk%Input(1), SrvD%Input(1), MeshMapData, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + else + CALL ED_InputSolve( p_FAST, ED%Input(1), ED%y, AD%y, ADsk%y, SrvD%y, AD%Input(1), ADsk%Input(1), ExtLd%y, ExtLd%m, ExtLd%u, ExtLd%p, SrvD%Input(1), MeshMapData, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + endif - CALL BD_InputSolve( p_FAST, BD, AD%y, AD%Input(1), ED%y, SrvD%y, SrvD%Input(1), MeshMapData, ErrStat2, ErrMsg2 ) + CALL BD_InputSolve( p_FAST, BD, AD%y, AD%Input(1), ExtLd%m, ExtLd%y, ExtLd%u, ExtLd%p, ED%y, SrvD%y, SrvD%Input(1), MeshMapData, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END SUBROUTINE SolveOption2 !---------------------------------------------------------------------------------------------------------------------------------- !> This routines advances the states of each module -SUBROUTINE FAST_AdvanceStates( t_initial, n_t_global, p_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, OpFM, HD, SD, ExtPtfm, & +SUBROUTINE FAST_AdvanceStates( t_initial, n_t_global, p_FAST, m_FAST, ED, SED, BD, SrvD, AD, ADsk, ExtLd, IfW, ExtInfw, HD, SD, ExtPtfm, & MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat, ErrMsg, WriteThisStep ) REAL(DbKi), INTENT(IN ) :: t_initial !< initial simulation time (almost always 0) @@ -5731,12 +5674,14 @@ SUBROUTINE FAST_AdvanceStates( t_initial, n_t_global, p_FAST, m_FAST, ED, BD, Sr TYPE(FAST_MiscVarType), INTENT(IN ) :: m_FAST !< Miscellaneous variables TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data + TYPE(SED_Data), INTENT(INOUT) :: SED !< Simplified-ElastoDyn data TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data - TYPE(AeroDyn14_Data), INTENT(INOUT) :: AD14 !< AeroDyn v14 data TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data + TYPE(AeroDisk_Data), INTENT(INOUT) :: ADsk !< AeroDisk data + TYPE(ExtLoads_Data), INTENT(INOUT) :: ExtLd !< ExtLoads data TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data - TYPE(OpenFOAM_Data), INTENT(INOUT) :: OpFM !< OpenFOAM data + TYPE(ExternalInflow_Data),INTENT(INOUT) :: ExtInfw !< ExternalInflow data TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HydroDyn data TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SubDyn data TYPE(ExtPtfm_Data), INTENT(INOUT) :: ExtPtfm !< ExtPtfm data @@ -5776,30 +5721,52 @@ SUBROUTINE FAST_AdvanceStates( t_initial, n_t_global, p_FAST, m_FAST, ED, BD, Sr ! (note that we need to copy the states because UpdateStates updates the values ! and we need to have the old values [at m_FAST%t_global] for the next j_pc step) !---------------------------------------------------------------------------------------- - ! ElastoDyn: get predicted states - CALL ED_CopyContState (ED%x( STATE_CURR), ED%x( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ED_CopyDiscState (ED%xd(STATE_CURR), ED%xd(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ED_CopyConstrState (ED%z( STATE_CURR), ED%z( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ED_CopyOtherState (ED%OtherSt( STATE_CURR), ED%OtherSt( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - DO j_ss = 1, p_FAST%n_substeps( MODULE_ED ) - n_t_module = n_t_global*p_FAST%n_substeps( MODULE_ED ) + j_ss - 1 - t_module = n_t_module*p_FAST%dt_module( MODULE_ED ) + t_initial - - CALL ED_UpdateStates( t_module, n_t_module, ED%Input, ED%InputTimes, ED%p, ED%x(STATE_PRED), ED%xd(STATE_PRED), & - ED%z(STATE_PRED), ED%OtherSt(STATE_PRED), ED%m, ErrStat2, ErrMsg2 ) + if (p_FAST%CompElast == Module_SED) then + ! Simplified-ElastoDyn: get predicted states + CALL SED_CopyContState (SED%x( STATE_CURR), SED%x( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SED_CopyDiscState (SED%xd(STATE_CURR), SED%xd(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SED_CopyConstrState (SED%z( STATE_CURR), SED%z( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SED_CopyOtherState (SED%OtherSt( STATE_CURR), SED%OtherSt( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + DO j_ss = 1, p_FAST%n_substeps( MODULE_ED ) + n_t_module = n_t_global*p_FAST%n_substeps( MODULE_ED ) + j_ss - 1 + t_module = n_t_module*p_FAST%dt_module( MODULE_ED ) + t_initial + + CALL SED_UpdateStates( t_module, n_t_module, SED%Input, SED%InputTimes, SED%p, SED%x(STATE_PRED), SED%xd(STATE_PRED), & + SED%z(STATE_PRED), SED%OtherSt(STATE_PRED), SED%m, ErrStat2, ErrMsg2 ) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + IF (ErrStat >= AbortErrLev) RETURN + END DO !j_ss + else + ! ElastoDyn: get predicted states + CALL ED_CopyContState (ED%x( STATE_CURR), ED%x( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ED_CopyDiscState (ED%xd(STATE_CURR), ED%xd(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ED_CopyConstrState (ED%z( STATE_CURR), ED%z( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF (ErrStat >= AbortErrLev) RETURN - END DO !j_ss + CALL ED_CopyOtherState (ED%OtherSt( STATE_CURR), ED%OtherSt( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + DO j_ss = 1, p_FAST%n_substeps( MODULE_ED ) + n_t_module = n_t_global*p_FAST%n_substeps( MODULE_ED ) + j_ss - 1 + t_module = n_t_module*p_FAST%dt_module( MODULE_ED ) + t_initial + + CALL ED_UpdateStates( t_module, n_t_module, ED%Input, ED%InputTimes, ED%p, ED%x(STATE_PRED), ED%xd(STATE_PRED), & + ED%z(STATE_PRED), ED%OtherSt(STATE_PRED), ED%m, ErrStat2, ErrMsg2 ) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + IF (ErrStat >= AbortErrLev) RETURN + END DO !j_ss + endif ! BeamDyn doesn't like extrapolated rotations, so we will calculate them from ED and transfer instead of doing a correction step. ! (Also calls ED_CalcOutput here so that we can use it for AeroDyn optimization, too): - CALL SolveOption2a_Inp2BD(t_global_next, STATE_PRED, p_FAST, m_FAST, ED, BD, AD14, AD, SrvD, IfW, OpFM, MeshMapData, ErrStat2, ErrMsg2, WriteThisStep) + CALL SolveOption2a_Inp2BD(t_global_next, STATE_PRED, p_FAST, m_FAST, ED, SED, BD, AD, ADsk, SrvD, IfW, ExtInfw, MeshMapData, ErrStat2, ErrMsg2, WriteThisStep) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) IF ( p_FAST%CompElast == Module_BD ) THEN @@ -5831,56 +5798,38 @@ SUBROUTINE FAST_AdvanceStates( t_initial, n_t_global, p_FAST, m_FAST, ED, BD, Sr ! because AeroDyn DBEMT states depend heavily on getting inputs correct, we are overwriting its inputs with updated structural outputs here - CALL SolveOption2b_Inp2IfW(t_global_next, STATE_PRED, p_FAST, m_FAST, ED, BD, AD14, AD, SrvD, IfW, OpFM, MeshMapData, ErrStat2, ErrMsg2, WriteThisStep) + CALL SolveOption2b_Inp2IfW(t_global_next, STATE_PRED, p_FAST, m_FAST, ED, SED, BD, AD, ADsk, SrvD, IfW, ExtInfw, MeshMapData, ErrStat2, ErrMsg2, WriteThisStep) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ! InflowWind: get predicted states - IF ( p_FAST%CompInflow == Module_IfW ) THEN - CALL InflowWind_CopyContState (IfW%x( STATE_CURR), IfW%x( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL InflowWind_CopyDiscState (IfW%xd(STATE_CURR), IfW%xd(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL InflowWind_CopyConstrState (IfW%z( STATE_CURR), IfW%z( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL InflowWind_CopyOtherState( IfW%OtherSt(STATE_CURR), IfW%OtherSt(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - DO j_ss = 1, p_FAST%n_substeps( MODULE_IfW ) - n_t_module = n_t_global*p_FAST%n_substeps( MODULE_IfW ) + j_ss - 1 - t_module = n_t_module*p_FAST%dt_module( MODULE_IfW ) + t_initial - - CALL InflowWind_UpdateStates( t_module, n_t_module, IfW%Input, IfW%InputTimes, IfW%p, IfW%x(STATE_PRED), IfW%xd(STATE_PRED), & - IfW%z(STATE_PRED), IfW%OtherSt(STATE_PRED), IfW%m, ErrStat2, ErrMsg2 ) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO !j_ss - END IF + ! InflowWind: get predicted states -- NO STATES +! IF ( p_FAST%CompInflow == Module_IfW ) THEN +! CALL InflowWind_CopyContState (IfW%x( STATE_CURR), IfW%x( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) +! CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) +! CALL InflowWind_CopyDiscState (IfW%xd(STATE_CURR), IfW%xd(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) +! CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) +! CALL InflowWind_CopyConstrState (IfW%z( STATE_CURR), IfW%z( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) +! CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) +! CALL InflowWind_CopyOtherState( IfW%OtherSt(STATE_CURR), IfW%OtherSt(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) +! CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) +! +! DO j_ss = 1, p_FAST%n_substeps( MODULE_IfW ) +! n_t_module = n_t_global*p_FAST%n_substeps( MODULE_IfW ) + j_ss - 1 +! t_module = n_t_module*p_FAST%dt_module( MODULE_IfW ) + t_initial +! +! CALL InflowWind_UpdateStates( t_module, n_t_module, IfW%Input, IfW%InputTimes, IfW%p, IfW%x(STATE_PRED), IfW%xd(STATE_PRED), & +! IfW%z(STATE_PRED), IfW%OtherSt(STATE_PRED), IfW%m, ErrStat2, ErrMsg2 ) +! CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) +! END DO !j_ss +! END IF ! because AeroDyn DBEMT states depend heavily on getting inputs correct, we are overwriting its inputs with updated inflow outputs here - CALL SolveOption2c_Inp2AD_SrvD(t_global_next, STATE_PRED, p_FAST, m_FAST, ED, BD, AD14, AD, SD, SrvD, IfW, OpFM, MeshMapData, ErrStat2, ErrMsg2, WriteThisStep) + CALL SolveOption2c_Inp2AD_SrvD(t_global_next, STATE_PRED, p_FAST, m_FAST, ED, SED, BD, AD, ADsk, ExtLd, SD, SrvD, IfW, ExtInfw, MeshMapData, ErrStat2, ErrMsg2, WriteThisStep) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ! AeroDyn: get predicted states - IF ( p_FAST%CompAero == Module_AD14 ) THEN - CALL AD14_CopyContState (AD14%x( STATE_CURR), AD14%x( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AD14_CopyDiscState (AD14%xd(STATE_CURR), AD14%xd(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AD14_CopyConstrState (AD14%z( STATE_CURR), AD14%z( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AD14_CopyOtherState( AD14%OtherSt(STATE_CURR), AD14%OtherSt(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - DO j_ss = 1, p_FAST%n_substeps( MODULE_AD14 ) - n_t_module = n_t_global*p_FAST%n_substeps( MODULE_AD14 ) + j_ss - 1 - t_module = n_t_module*p_FAST%dt_module( MODULE_AD14 ) + t_initial - - CALL AD14_UpdateStates( t_module, n_t_module, AD14%Input, AD14%InputTimes, AD14%p, AD14%x(STATE_PRED), & - AD14%xd(STATE_PRED), AD14%z(STATE_PRED), AD14%OtherSt(STATE_PRED), AD14%m, ErrStat2, ErrMsg2 ) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO !j_ss - ELSEIF ( p_FAST%CompAero == Module_AD ) THEN + IF ( (p_FAST%CompAero == Module_AD) .or. (p_FAST%CompAero == Module_ExtLd) ) THEN CALL AD_CopyContState (AD%x( STATE_CURR), AD%x( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) CALL AD_CopyDiscState (AD%xd(STATE_CURR), AD%xd(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) @@ -5898,8 +5847,28 @@ SUBROUTINE FAST_AdvanceStates( t_initial, n_t_global, p_FAST, m_FAST, ED, BD, Sr AD%xd(STATE_PRED), AD%z(STATE_PRED), AD%OtherSt(STATE_PRED), AD%m, ErrStat2, ErrMsg2 ) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO !j_ss - END IF + ELSEIF ( p_FAST%CompAero == Module_ADsk ) THEN + CALL ADsk_CopyContState (ADsk%x( STATE_CURR), ADsk%x( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ADsk_CopyDiscState (ADsk%xd(STATE_CURR), ADsk%xd(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ADsk_CopyConstrState (ADsk%z( STATE_CURR), ADsk%z( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ADsk_CopyOtherState( ADsk%OtherSt(STATE_CURR), ADsk%OtherSt(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + DO j_ss = 1, p_FAST%n_substeps( MODULE_ADsk ) + n_t_module = n_t_global*p_FAST%n_substeps( MODULE_ADsk ) + j_ss - 1 + t_module = n_t_module*p_FAST%dt_module( MODULE_ADsk ) + t_initial + CALL ADsk_UpdateStates( t_module, n_t_module, ADsk%Input, ADsk%InputTimes, ADsk%p, ADsk%x(STATE_PRED), & + ADsk%xd(STATE_PRED), ADsk%z(STATE_PRED), ADsk%OtherSt(STATE_PRED), ADsk%m, ErrStat2, ErrMsg2 ) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO !j_ss + END IF + IF (p_FAST%CompAero == Module_ExtLd ) THEN + ! DO WE HAVE TO DO SOMETHING HERE? + END IF ! ServoDyn: get predicted states IF ( p_FAST%CompServo == Module_SrvD ) THEN @@ -6116,7 +6085,7 @@ SUBROUTINE FAST_AdvanceStates( t_initial, n_t_global, p_FAST, m_FAST, ED, BD, Sr END SUBROUTINE FAST_AdvanceStates !---------------------------------------------------------------------------------------------------------------------------------- !> This routine extrapolates inputs to modules to give predicted values at t+dt. -SUBROUTINE FAST_ExtrapInterpMods( t_global_next, p_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & +SUBROUTINE FAST_ExtrapInterpMods( t_global_next, p_FAST, m_FAST, ED, SED, BD, SrvD, AD, ADsk, ExtLd, IfW, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & IceF, IceD, ErrStat, ErrMsg ) REAL(DbKi), INTENT(IN ) :: t_global_next !< next global time step (t + dt), at which we're extrapolating inputs (and ED outputs) @@ -6124,10 +6093,12 @@ SUBROUTINE FAST_ExtrapInterpMods( t_global_next, p_FAST, m_FAST, ED, BD, SrvD, A TYPE(FAST_MiscVarType), INTENT(IN ) :: m_FAST !< Miscellaneous variables TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data + TYPE(SED_Data), INTENT(INOUT) :: SED !< Simplified-ElastoDyn data TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data - TYPE(AeroDyn14_Data), INTENT(INOUT) :: AD14 !< AeroDyn14 data TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data + TYPE(AeroDisk_Data), INTENT(INOUT) :: ADsk !< AeroDisk data + TYPE(ExtLoads_Data), INTENT(INOUT) :: ExtLd !< ExtLoads data TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HydroDyn data TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SubDyn data @@ -6162,19 +6133,35 @@ SUBROUTINE FAST_ExtrapInterpMods( t_global_next, p_FAST, m_FAST, ED, BD, SrvD, A ErrStat = ErrID_None ErrMsg = "" - ! ElastoDyn - CALL ED_Input_ExtrapInterp(ED%Input, ED%InputTimes, ED%u, t_global_next, ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + if (p_FAST%CompElast == Module_SED) then + ! Simplified-ElastoDyn + CALL SED_Input_ExtrapInterp(SED%Input, SED%InputTimes, SED%u, t_global_next, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - DO j = p_FAST%InterpOrder, 1, -1 - CALL ED_CopyInput (ED%Input(j), ED%Input(j+1), MESH_UPDATECOPY, Errstat2, ErrMsg2) + DO j = p_FAST%InterpOrder, 1, -1 + CALL SED_CopyInput (SED%Input(j), SED%Input(j+1), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + SED%InputTimes(j+1) = SED%InputTimes(j) + END DO + + CALL SED_CopyInput (SED%u, SED%Input(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - ED%InputTimes(j+1) = ED%InputTimes(j) - END DO - - CALL ED_CopyInput (ED%u, ED%Input(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - ED%InputTimes(1) = t_global_next + SED%InputTimes(1) = t_global_next + else + ! ElastoDyn + CALL ED_Input_ExtrapInterp(ED%Input, ED%InputTimes, ED%u, t_global_next, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + + DO j = p_FAST%InterpOrder, 1, -1 + CALL ED_CopyInput (ED%Input(j), ED%Input(j+1), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + ED%InputTimes(j+1) = ED%InputTimes(j) + END DO + + CALL ED_CopyInput (ED%u, ED%Input(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + ED%InputTimes(1) = t_global_next + endif ! BeamDyn @@ -6201,25 +6188,8 @@ SUBROUTINE FAST_ExtrapInterpMods( t_global_next, p_FAST, m_FAST, ED, BD, SrvD, A END IF ! BeamDyn - ! AeroDyn v14 - IF ( p_FAST%CompAero == Module_AD14 ) THEN - - CALL AD14_Input_ExtrapInterp(AD14%Input, AD14%InputTimes, AD14%u, t_global_next, ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - - ! Shift "window" of AD14%Input - - DO j = p_FAST%InterpOrder, 1, -1 - CALL AD14_CopyInput (AD14%Input(j), AD14%Input(j+1), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - AD14%InputTimes(j+1) = AD14%InputTimes(j) - END DO - - CALL AD14_CopyInput (AD14%u, AD14%Input(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - AD14%InputTimes(1) = t_global_next - - ELSEIF ( p_FAST%CompAero == Module_AD ) THEN + ! AeroDyn + IF ( (p_FAST%CompAero == Module_AD ) .or. (p_FAST%CompAero == Module_ExtLd ) ) THEN CALL AD_Input_ExtrapInterp(AD%Input, AD%InputTimes, AD%u, t_global_next, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) @@ -6235,10 +6205,28 @@ SUBROUTINE FAST_ExtrapInterpMods( t_global_next, p_FAST, m_FAST, ED, BD, SrvD, A CALL AD_CopyInput (AD%u, AD%Input(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) AD%InputTimes(1) = t_global_next - + + ELSEIF ( p_FAST%CompAero == Module_ADsk ) THEN + CALL ADsk_Input_ExtrapInterp(ADsk%Input, ADsk%InputTimes, ADsk%u, t_global_next, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + + ! Shift "window" of ADsk%Input + DO j = p_FAST%InterpOrder, 1, -1 + CALL ADsk_CopyInput (ADsk%Input(j), ADsk%Input(j+1), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + ADsk%InputTimes(j+1) = ADsk%InputTimes(j) + END DO + + CALL ADsk_CopyInput (ADsk%u, ADsk%Input(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + ADsk%InputTimes(1) = t_global_next + END IF ! CompAero - + IF (p_FAST%CompAero == Module_ExtLd ) THEN + ! Don't need to do anything here. ExtLoads does not have inputs at different times + END IF + ! InflowWind IF ( p_FAST%CompInflow == Module_IfW ) THEN @@ -6278,6 +6266,10 @@ SUBROUTINE FAST_ExtrapInterpMods( t_global_next, p_FAST, m_FAST, ED, BD, SrvD, A CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) SrvD%InputTimes(1) = t_global_next + + ! ! put zero-order hold on SrvD inputs from Simulink (avoids extrapolation issues) + !CALL SrvD_SetExternalInputs( p_FAST, m_FAST, SrvD%Input(1) ) + END IF ! ServoDyn ! HydroDyn diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index 7aec9c44f6..67cde541c4 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -23,7 +23,6 @@ MODULE FAST_Subs USE FAST_Solver USE FAST_Linear - USE Waves, ONLY : WaveGrid_n USE SC_DataEx USE VersionInfo @@ -44,34 +43,35 @@ SUBROUTINE FAST_InitializeAll_T( t_initial, TurbID, Turbine, ErrStat, ErrMsg, In CHARACTER(*), OPTIONAL,INTENT(IN ) :: InFile !< A CHARACTER string containing the name of the primary FAST input file (if not present, we'll get it from the command line) TYPE(FAST_ExternInitType),OPTIONAL,INTENT(IN ) :: ExternInitData !< Initialization input data from an external source (Simulink) + LOGICAL, PARAMETER :: CompAeroMaps = .false. Turbine%TurbID = TurbID IF (PRESENT(InFile)) THEN IF (PRESENT(ExternInitData)) THEN CALL FAST_InitializeAll( t_initial, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & - Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD14, Turbine%AD, Turbine%IfW, Turbine%OpFM, Turbine%SC_DX,& - Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & - Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat, ErrMsg, InFile, ExternInitData ) + Turbine%ED, Turbine%SED, Turbine%BD, Turbine%SrvD, Turbine%AD, Turbine%ADsk, Turbine%ExtLd, Turbine%IfW, Turbine%ExtInfw, Turbine%SC_DX,& + Turbine%SeaSt, Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & + Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, CompAeroMaps, ErrStat, ErrMsg, InFile, ExternInitData ) ELSE CALL FAST_InitializeAll( t_initial, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & - Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD14, Turbine%AD, Turbine%IfW, Turbine%OpFM, Turbine%SC_DX, & - Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & - Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat, ErrMsg, InFile ) + Turbine%ED, Turbine%SED, Turbine%BD, Turbine%SrvD, Turbine%AD, Turbine%ADsk, Turbine%ExtLd, Turbine%IfW, Turbine%ExtInfw, Turbine%SC_DX, & + Turbine%SeaSt, Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & + Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, CompAeroMaps, ErrStat, ErrMsg, InFile ) END IF ELSE CALL FAST_InitializeAll( t_initial, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & - Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD14, Turbine%AD, Turbine%IfW, Turbine%OpFM, Turbine%SC_DX, & - Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & - Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat, ErrMsg ) + Turbine%ED, Turbine%SED, Turbine%BD, Turbine%SrvD, Turbine%AD, Turbine%ADsk, Turbine%ExtLd, Turbine%IfW, Turbine%ExtInfw, Turbine%SC_DX, & + Turbine%SeaSt, Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & + Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, CompAeroMaps, ErrStat, ErrMsg ) END IF END SUBROUTINE FAST_InitializeAll_T !---------------------------------------------------------------------------------------------------------------------------------- !> Routine to call Init routine for each module. This routine sets all of the init input data for each module. -SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, OpFM, SC_DX, HD, SD, ExtPtfm, & - MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat, ErrMsg, InFile, ExternInitData ) +SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, SED, BD, SrvD, AD, ADsk, ExtLd, IfW, ExtInfw, SC_DX, SeaSt, HD, SD, ExtPtfm, & + MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, CompAeroMaps, ErrStat, ErrMsg, InFile, ExternInitData ) use ElastoDyn_Parameters, only: Method_RK4 @@ -81,13 +81,16 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data + TYPE(SED_Data), INTENT(INOUT) :: SED !< Simplified-ElastoDyn data TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data - TYPE(AeroDyn14_Data), INTENT(INOUT) :: AD14 !< AeroDyn14 data TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data + TYPE(AeroDisk_Data), INTENT(INOUT) :: ADsk !< AeroDisk data + TYPE(ExtLoads_Data), INTENT(INOUT) :: ExtLd !< ExtLoads data TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data - TYPE(OpenFOAM_Data), INTENT(INOUT) :: OpFM !< OpenFOAM data + TYPE(ExternalInflow_Data),INTENT(INOUT) :: ExtInfw !< ExternalInflow data TYPE(SCDataEx_Data), INTENT(INOUT) :: SC_DX !< SuperController exchange data + TYPE(SeaState_Data), INTENT(INOUT) :: SeaSt !< SeaState data TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HydroDyn data TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SubDyn data TYPE(ExtPtfm_Data), INTENT(INOUT) :: ExtPtfm !< ExtPtfm_MCKF data @@ -100,6 +103,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, TYPE(IceDyn_Data), INTENT(INOUT) :: IceD !< All the IceDyn data used in time-step loop TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules + LOGICAL, INTENT(IN ) :: CompAeroMaps !< Determines if simplifications are made to produce aero maps (not time-marching) INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None @@ -112,19 +116,19 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, TYPE(FAST_InitData) :: Init !< Initialization data for all modules - REAL(ReKi) :: AirDens ! air density for initialization/normalization of OpenFOAM data + REAL(ReKi) :: AirDens ! air density for initialization/normalization of ExternalInflow data REAL(DbKi) :: dt_IceD ! tmp dt variable to ensure IceDyn doesn't specify different dt values for different legs (IceDyn instances) REAL(DbKi) :: dt_BD ! tmp dt variable to ensure BeamDyn doesn't specify different dt values for different instances INTEGER(IntKi) :: ErrStat2 INTEGER(IntKi) :: IceDim ! dimension we're pre-allocating for number of IceDyn legs/instances INTEGER(IntKi) :: I ! generic loop counter INTEGER(IntKi) :: k ! blade loop counter - INTEGER(IntKi) :: nNodes ! temp var for OpFM coupling logical :: CallStart - - + + REAL(R8Ki) :: theta(3) ! angles for hub orientation matrix for aeromaps + INTEGER(IntKi) :: NumBl - + CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'FAST_InitializeAll' @@ -134,6 +138,8 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, ErrStat = ErrID_None ErrMsg = "" + p_FAST%CompAeroMaps = CompAeroMaps + y_FAST%UnSum = -1 ! set the summary file unit to -1 to indicate it's not open y_FAST%UnOu = -1 ! set the text output file unit to -1 to indicate it's not open y_FAST%UnGra = -1 ! set the binary graphics output file unit to -1 to indicate it's not open @@ -145,7 +151,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, y_FAST%VTK_count = 0 ! first VTK file has 0 as output y_FAST%n_Out = 0 ! set the number of ouptut channels to 0 to indicate there's nothing to write to the binary file p_FAST%ModuleInitialized = .FALSE. ! (array initialization) no modules are initialized - + ! Get the current time CALL DATE_AND_TIME ( Values=m_FAST%StrtTime ) ! Let's time the whole simulation CALL CPU_TIME ( m_FAST%UsrTime1 ) ! Initial time (this zeros the start time when used as a MATLAB function) @@ -172,7 +178,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, if (CallStart) then AbortErrLev = ErrID_Fatal ! Until we read otherwise from the FAST input file, we abort only on FATAL errors CALL FAST_ProgStart( FAST_Ver ) - p_FAST%WrSttsTime = .TRUE. + p_FAST%WrSttsTime = .not. p_FAST%CompAeroMaps !.TRUE. else ! if we don't call the start data (e.g., from FAST.Farm), we won't override AbortErrLev either CALL DispNVD( FAST_Ver ) @@ -195,7 +201,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, ! also, set applicable farm paramters and turbine reference position also for graphics output p_FAST%UseSC = .FALSE. if (PRESENT(ExternInitData)) then - p_FAST%FarmIntegration = ExternInitData%FarmIntegration + p_FAST%FarmIntegration = ExternInitData%FarmIntegration p_FAST%TurbinePos = ExternInitData%TurbinePos p_FAST%WaveFieldMod = ExternInitData%WaveFieldMod if( (ExternInitData%NumSC2CtrlGlob .gt. 0) .or. (ExternInitData%NumSC2Ctrl .gt. 0) .or. (ExternInitData%NumCtrl2SC .gt. 0)) then @@ -205,7 +211,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, if (ExternInitData%FarmIntegration) then ! we're integrating with FAST.Farm CALL FAST_Init( p_FAST, m_FAST, y_FAST, t_initial, InputFile, ErrStat2, ErrMsg2, ExternInitData%TMax, OverrideAbortLev=.false., RootName=ExternInitData%RootName ) else - CALL FAST_Init( p_FAST, m_FAST, y_FAST, t_initial, InputFile, ErrStat2, ErrMsg2, ExternInitData%TMax, ExternInitData%TurbIDforName ) ! We have the name of the input file and the simulation length from somewhere else (e.g. Simulink) + CALL FAST_Init( p_FAST, m_FAST, y_FAST, t_initial, InputFile, ErrStat2, ErrMsg2, ExternInitData%TMax, ExternInitData%TurbIDforName, DTdriver=ExternInitData%DTdriver ) ! We have the name of the input file and the simulation length from somewhere else (e.g. Simulink) end if else @@ -225,89 +231,117 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, p_FAST%dt_module = p_FAST%dt ! initialize time steps for each module - ! ........................ - ! initialize ElastoDyn (must be done first) - ! ........................ - - ALLOCATE( ED%Input( p_FAST%InterpOrder+1 ), ED%InputTimes( p_FAST%InterpOrder+1 ),STAT = ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal,"Error allocating ED%Input and ED%InputTimes.",ErrStat,ErrMsg,RoutineName) + if (p_FAST%CompElast == Module_SED) then + ! ........................ + ! initialize Simplified-ElastoDyn (must be done first) + ! ........................ + ALLOCATE( SED%Input( p_FAST%InterpOrder+1 ), SED%InputTimes( p_FAST%InterpOrder+1 ),STAT = ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal,"Error allocating SED%Input and SED%InputTimes.",ErrStat,ErrMsg,RoutineName) + CALL Cleanup() + RETURN + END IF + + Init%InData_SED%Linearize = p_FAST%Linearize + Init%InData_SED%InputFile = p_FAST%EDFile + Init%InData_SED%RootName = TRIM(p_FAST%OutFileRoot)//'.'//TRIM(y_FAST%Module_Abrev(Module_SED)) + + CALL SED_Init( Init%InData_SED, SED%Input(1), SED%p, SED%x(STATE_CURR), SED%xd(STATE_CURR), SED%z(STATE_CURR), SED%OtherSt(STATE_CURR), & + SED%y, SED%m, p_FAST%dt_module( MODULE_SED ), Init%OutData_SED, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + p_FAST%ModuleInitialized(Module_SED) = .TRUE. + CALL SetModuleSubstepTime(Module_SED, p_FAST, y_FAST, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + NumBl = Init%OutData_SED%NumBl + + else + ! ........................ + ! initialize ElastoDyn (must be done first) + ! ........................ + ALLOCATE( ED%Input( p_FAST%InterpOrder+1 ), ED%InputTimes( p_FAST%InterpOrder+1 ),STAT = ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal,"Error allocating ED%Input and ED%InputTimes.",ErrStat,ErrMsg,RoutineName) + CALL Cleanup() + RETURN + END IF + + ALLOCATE( ED%Input_Saved( p_FAST%InterpOrder+1 ), ED%InputTimes_Saved( p_FAST%InterpOrder+1 ), ED%Output_bak( p_FAST%InterpOrder+1 ),STAT = ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal,"Error allocating ED%Input_Saved, ED%Output_bak, and ED%InputTimes_Saved.",ErrStat,ErrMsg,RoutineName) + CALL Cleanup() + RETURN + END IF + + Init%InData_ED%Linearize = p_FAST%Linearize + Init%InData_ED%CompAeroMaps = p_FAST%CompAeroMaps + Init%InData_ED%RotSpeed = p_FAST%RotSpeedInit + Init%InData_ED%InputFile = p_FAST%EDFile + + Init%InData_ED%RootName = TRIM(p_FAST%OutFileRoot)//'.'//TRIM(y_FAST%Module_Abrev(Module_ED)) + Init%InData_ED%CompElast = p_FAST%CompElast == Module_ED + + Init%InData_ED%Gravity = p_FAST%Gravity + + Init%InData_ED%MHK = p_FAST%MHK + Init%InData_ED%WtrDpth = p_FAST%WtrDpth + + CALL ED_Init( Init%InData_ED, ED%Input(1), ED%p, ED%x(STATE_CURR), ED%xd(STATE_CURR), ED%z(STATE_CURR), ED%OtherSt(STATE_CURR), & + ED%y, ED%m, p_FAST%dt_module( MODULE_ED ), Init%OutData_ED, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + p_FAST%ModuleInitialized(Module_ED) = .TRUE. + CALL SetModuleSubstepTime(Module_ED, p_FAST, y_FAST, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + allocate( y_FAST%Lin%Modules(MODULE_ED)%Instance(1), stat=ErrStat2) + if (ErrStat2 /= 0 ) then + call SetErrStat(ErrID_Fatal, "Error allocating Lin%Modules(ED).", ErrStat, ErrMsg, RoutineName ) + else + + if (allocated(Init%OutData_ED%LinNames_y)) call move_alloc(Init%OutData_ED%LinNames_y,y_FAST%Lin%Modules(MODULE_ED)%Instance(1)%Names_y) + if (allocated(Init%OutData_ED%LinNames_x)) call move_alloc(Init%OutData_ED%LinNames_x,y_FAST%Lin%Modules(MODULE_ED)%Instance(1)%Names_x) + if (allocated(Init%OutData_ED%LinNames_u)) call move_alloc(Init%OutData_ED%LinNames_u,y_FAST%Lin%Modules(MODULE_ED)%Instance(1)%Names_u) + if (allocated(Init%OutData_ED%RotFrame_y)) call move_alloc(Init%OutData_ED%RotFrame_y,y_FAST%Lin%Modules(MODULE_ED)%Instance(1)%RotFrame_y) + if (allocated(Init%OutData_ED%RotFrame_x)) call move_alloc(Init%OutData_ED%RotFrame_x,y_FAST%Lin%Modules(MODULE_ED)%Instance(1)%RotFrame_x) + if (allocated(Init%OutData_ED%DerivOrder_x)) call move_alloc(Init%OutData_ED%DerivOrder_x,y_FAST%Lin%Modules(MODULE_ED)%Instance(1)%DerivOrder_x) + if (allocated(Init%OutData_ED%RotFrame_u)) call move_alloc(Init%OutData_ED%RotFrame_u,y_FAST%Lin%Modules(MODULE_ED)%Instance(1)%RotFrame_u) + if (allocated(Init%OutData_ED%IsLoad_u )) call move_alloc(Init%OutData_ED%IsLoad_u ,y_FAST%Lin%Modules(MODULE_ED)%Instance(1)%IsLoad_u ) + + if (allocated(Init%OutData_ED%WriteOutputHdr)) y_FAST%Lin%Modules(MODULE_ED)%Instance(1)%NumOutputs = size(Init%OutData_ED%WriteOutputHdr) + end if + + IF (ErrStat >= AbortErrLev) THEN CALL Cleanup() RETURN END IF - - Init%InData_ED%Linearize = p_FAST%Linearize - Init%InData_ED%InputFile = p_FAST%EDFile - IF ( p_FAST%CompAero == Module_AD14 ) THEN - Init%InData_ED%ADInputFile = p_FAST%AeroFile - ELSE - Init%InData_ED%ADInputFile = "" - END IF - - Init%InData_ED%RootName = TRIM(p_FAST%OutFileRoot)//'.'//TRIM(y_FAST%Module_Abrev(Module_ED)) - Init%InData_ED%CompElast = p_FAST%CompElast == Module_ED - - Init%InData_ED%Gravity = p_FAST%Gravity - - Init%InData_ED%MHK = p_FAST%MHK - Init%InData_ED%WtrDpth = p_FAST%WtrDpth - - CALL ED_Init( Init%InData_ED, ED%Input(1), ED%p, ED%x(STATE_CURR), ED%xd(STATE_CURR), ED%z(STATE_CURR), ED%OtherSt(STATE_CURR), & - ED%y, ED%m, p_FAST%dt_module( MODULE_ED ), Init%OutData_ED, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - p_FAST%ModuleInitialized(Module_ED) = .TRUE. - CALL SetModuleSubstepTime(Module_ED, p_FAST, y_FAST, ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - ! bjj: added this check per jmj; perhaps it would be better in ElastoDyn, but I'll leave it here for now: - IF ( p_FAST%TurbineType == Type_Offshore_Floating ) THEN - IF ( ED%p%TowerBsHt < 0.0_ReKi .AND. .NOT. EqualRealNos( ED%p%TowerBsHt, 0.0_ReKi ) ) THEN - CALL SetErrStat(ErrID_Fatal,"ElastoDyn TowerBsHt must not be negative for floating offshore systems.",ErrStat,ErrMsg,RoutineName) - END IF - END IF - - allocate( y_FAST%Lin%Modules(MODULE_ED)%Instance(1), stat=ErrStat2) - if (ErrStat2 /= 0 ) then - call SetErrStat(ErrID_Fatal, "Error allocating Lin%Modules(ED).", ErrStat, ErrMsg, RoutineName ) - else - - if (allocated(Init%OutData_ED%LinNames_y)) call move_alloc(Init%OutData_ED%LinNames_y,y_FAST%Lin%Modules(MODULE_ED)%Instance(1)%Names_y) - if (allocated(Init%OutData_ED%LinNames_x)) call move_alloc(Init%OutData_ED%LinNames_x,y_FAST%Lin%Modules(MODULE_ED)%Instance(1)%Names_x) - if (allocated(Init%OutData_ED%LinNames_u)) call move_alloc(Init%OutData_ED%LinNames_u,y_FAST%Lin%Modules(MODULE_ED)%Instance(1)%Names_u) - if (allocated(Init%OutData_ED%RotFrame_y)) call move_alloc(Init%OutData_ED%RotFrame_y,y_FAST%Lin%Modules(MODULE_ED)%Instance(1)%RotFrame_y) - if (allocated(Init%OutData_ED%RotFrame_x)) call move_alloc(Init%OutData_ED%RotFrame_x,y_FAST%Lin%Modules(MODULE_ED)%Instance(1)%RotFrame_x) - if (allocated(Init%OutData_ED%DerivOrder_x)) call move_alloc(Init%OutData_ED%DerivOrder_x,y_FAST%Lin%Modules(MODULE_ED)%Instance(1)%DerivOrder_x) - if (allocated(Init%OutData_ED%RotFrame_u)) call move_alloc(Init%OutData_ED%RotFrame_u,y_FAST%Lin%Modules(MODULE_ED)%Instance(1)%RotFrame_u) - if (allocated(Init%OutData_ED%IsLoad_u )) call move_alloc(Init%OutData_ED%IsLoad_u ,y_FAST%Lin%Modules(MODULE_ED)%Instance(1)%IsLoad_u ) - - if (allocated(Init%OutData_ED%WriteOutputHdr)) y_FAST%Lin%Modules(MODULE_ED)%Instance(1)%NumOutputs = size(Init%OutData_ED%WriteOutputHdr) - end if - - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF - - NumBl = Init%OutData_ED%NumBl - - - if (p_FAST%CalcSteady) then - if ( EqualRealNos(Init%OutData_ED%RotSpeed, 0.0_ReKi) ) then - p_FAST%TrimCase = TrimCase_none - p_FAST%NLinTimes = 1 - p_FAST%LinInterpOrder = 0 ! constant values - elseif ( Init%OutData_ED%isFixed_GenDOF ) then - p_FAST%TrimCase = TrimCase_none + + NumBl = Init%OutData_ED%NumBl + p_FAST%GearBox_index = Init%OutData_ED%GearBox_index + + + if (p_FAST%CalcSteady) then + if ( EqualRealNos(Init%OutData_ED%RotSpeed, 0.0_ReKi) ) then + p_FAST%TrimCase = TrimCase_none + p_FAST%NLinTimes = 1 + p_FAST%LinInterpOrder = 0 ! constant values + elseif ( Init%OutData_ED%isFixed_GenDOF ) then + p_FAST%TrimCase = TrimCase_none + end if end if - end if + endif ! SED/ED ! ........................ ! initialize BeamDyn ! ........................ IF ( p_FAST%CompElast == Module_BD ) THEN - p_FAST%nBeams = Init%OutData_ED%NumBl ! initialize number of BeamDyn instances = number of blades + IF (p_FAST%CompAeroMaps) then + p_FAST%nBeams = 1 ! initialize number of BeamDyn instances = 1 blade for aero maps + ELSE + p_FAST%nBeams = Init%OutData_ED%NumBl ! initialize number of BeamDyn instances = number of blades + END IF ELSE p_FAST%nBeams = 0 END IF @@ -319,10 +353,17 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, RETURN END IF - ALLOCATE( BD%x( p_FAST%nBeams,2), & - BD%xd( p_FAST%nBeams,2), & - BD%z( p_FAST%nBeams,2), & - BD%OtherSt( p_FAST%nBeams,2), & + ALLOCATE( BD%Input_Saved( p_FAST%InterpOrder+1, p_FAST%nBeams ), BD%InputTimes_Saved( p_FAST%InterpOrder+1, p_FAST%nBeams ), STAT = ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal,"Error allocating BD%Input_Saved and BD%InputTimes_Saved.",ErrStat,ErrMsg,RoutineName) + CALL Cleanup() + RETURN + END IF + + ALLOCATE( BD%x( p_FAST%nBeams,4), & + BD%xd( p_FAST%nBeams,4), & + BD%z( p_FAST%nBeams,4), & + BD%OtherSt( p_FAST%nBeams,4), & BD%p( p_FAST%nBeams ), & BD%u( p_FAST%nBeams ), & BD%y( p_FAST%nBeams ), & @@ -340,8 +381,9 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, Init%InData_BD%DynamicSolve = .TRUE. ! FAST can only couple to BeamDyn when dynamic solve is used. Init%InData_BD%Linearize = p_FAST%Linearize + Init%InData_BD%CompAeroMaps = p_FAST%CompAeroMaps Init%InData_BD%gravity = (/ 0.0_ReKi, 0.0_ReKi, -p_FAST%Gravity /) ! "Gravitational acceleration" m/s^2 - + ! now initialize BeamDyn for all beams dt_BD = p_FAST%dt_module( MODULE_BD ) @@ -366,6 +408,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, Init%InData_BD%GlbPos = ED%y%BladeRootMotion(k)%Position(:,1) ! {:} - - "Initial Position Vector of the local blade coordinate system" Init%InData_BD%GlbRot = ED%y%BladeRootMotion(k)%RefOrientation(:,:,1) ! {:}{:} - - "Initial direction cosine matrix of the local blade coordinate system" + ! These outputs are set in ElastoDyn only when BeamDyn is used: Init%InData_BD%RootDisp = ED%y%BladeRootMotion(k)%TranslationDisp(:,1) ! {:} - - "Initial root displacement" Init%InData_BD%RootOri = ED%y%BladeRootMotion(k)%Orientation(:,:,1) ! {:}{:} - - "Initial root orientation" Init%InData_BD%RootVel(1:3) = ED%y%BladeRootMotion(k)%TranslationVel(:,1) ! {:} - - "Initial root velocities and angular veolcities" @@ -386,11 +429,12 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, CALL SetErrStat(ErrID_Fatal,"All instances of BeamDyn (one per blade) must have the same time step.",ErrStat,ErrMsg,RoutineName) END IF - ! We're going to do fewer computations if the BD input and output meshes that couple to AD are siblings: + ! We're going to do fewer computations if the BD input and output meshes that couple to AD are siblings (but it needs to be true for all instances): if (BD%p(k)%BldMotionNodeLoc /= BD_MESH_QP) p_FAST%BD_OutputSibling = .false. + if (p_FAST%CompAeroMaps .and. BD%p(k)%BldMotionNodeLoc /= BD_MESH_FE) call SetErrStat(ErrID_Fatal, "BeamDyn aero maps must have outputs at FE nodes.", ErrStat, ErrMsg, RoutineName ) if (ErrStat>=AbortErrLev) exit !exit this loop so we don't get p_FAST%nBeams of the same errors - + if (size(y_FAST%Lin%Modules(MODULE_BD)%Instance) >= k) then ! for aero maps, we only use the first instance: if (allocated(Init%OutData_BD(k)%LinNames_y)) call move_alloc(Init%OutData_BD(k)%LinNames_y, y_FAST%Lin%Modules(MODULE_BD)%Instance(k)%Names_y ) if (allocated(Init%OutData_BD(k)%LinNames_x)) call move_alloc(Init%OutData_BD(k)%LinNames_x, y_FAST%Lin%Modules(MODULE_BD)%Instance(k)%Names_x ) @@ -400,94 +444,271 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, if (allocated(Init%OutData_BD(k)%RotFrame_u)) call move_alloc(Init%OutData_BD(k)%RotFrame_u, y_FAST%Lin%Modules(MODULE_BD)%Instance(k)%RotFrame_u ) if (allocated(Init%OutData_BD(k)%IsLoad_u )) call move_alloc(Init%OutData_BD(k)%IsLoad_u , y_FAST%Lin%Modules(MODULE_BD)%Instance(k)%IsLoad_u ) if (allocated(Init%OutData_BD(k)%DerivOrder_x)) call move_alloc(Init%OutData_BD(k)%DerivOrder_x, y_FAST%Lin%Modules(MODULE_BD)%Instance(k)%DerivOrder_x ) - + if (allocated(Init%OutData_BD(k)%WriteOutputHdr)) y_FAST%Lin%Modules(MODULE_BD)%Instance(k)%NumOutputs = size(Init%OutData_BD(k)%WriteOutputHdr) end if - + END DO - + IF (ErrStat >= AbortErrLev) THEN CALL Cleanup() RETURN END IF - + END IF ! ........................ - ! initialize AeroDyn + ! initialize InflowWind ! ........................ - ALLOCATE( AD14%Input( p_FAST%InterpOrder+1 ), AD14%InputTimes( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) + ALLOCATE( IfW%Input( p_FAST%InterpOrder+1 ), IfW%InputTimes( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal,"Error allocating AD14%Input and AD14%InputTimes.",ErrStat,ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal,"Error allocating IfW%Input and IfW%InputTimes.",ErrStat,ErrMsg,RoutineName) CALL Cleanup() RETURN END IF - ALLOCATE( AD%Input( p_FAST%InterpOrder+1 ), AD%InputTimes( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) + ALLOCATE( IfW%Input_Saved( p_FAST%InterpOrder+1 ), IfW%InputTimes_Saved( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal,"Error allocating AD%Input and AD%InputTimes.",ErrStat,ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal,"Error allocating IfW%Input_Saved and IfW%InputTimes_Saved.",ErrStat,ErrMsg,RoutineName) CALL Cleanup() RETURN END IF + IF ( p_FAST%CompInflow == Module_IfW ) THEN - IF ( p_FAST%CompAero == Module_AD14 ) THEN + Init%InData_IfW%Linearize = p_FAST%Linearize + Init%InData_IfW%InputFileName = p_FAST%InflowFile + Init%InData_IfW%RootName = TRIM(p_FAST%OutFileRoot)//'.'//TRIM(y_FAST%Module_Abrev(Module_IfW)) + Init%InData_IfW%FilePassingMethod= 0_IntKi ! IfW will read input file + Init%InData_IfW%FixedWindFileRootName = .FALSE. + Init%InData_IfW%OutputAccel = p_FAST%MHK /= MHK_None - CALL AD_SetInitInput(Init%InData_AD14, Init%OutData_ED, ED%y, p_FAST, ErrStat2, ErrMsg2) ! set the values in Init%InData_AD14 - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + Init%InData_IfW%MHK = p_FAST%MHK + Init%InData_IfW%WtrDpth = p_FAST%WtrDpth + + Init%InData_IfW%NumWindPoints = 0 + + IF ( p_FAST%CompServo == Module_SrvD ) THEN + Init%InData_IfW%NumWindPoints = Init%InData_IfW%NumWindPoints + 1 + END IF + + ! lidar + Init%InData_IfW%LidarEnabled = .true. ! allowed with OF, but not FF + Init%InData_IfW%lidar%Tmax = p_FAST%TMax + if (p_FAST%CompElast == Module_SED) then + Init%InData_IfW%lidar%HubPosition = SED%y%HubPtMotion%Position(:,1) + Init%InData_IfW%RadAvg = Init%OutData_SED%BladeLength + elseif ( p_FAST%CompElast == Module_ED ) then + Init%InData_IfW%lidar%HubPosition = ED%y%HubPtMotion%Position(:,1) + Init%InData_IfW%RadAvg = Init%OutData_ED%BladeLength + elseif ( p_FAST%CompElast == Module_BD ) then + Init%InData_IfW%lidar%HubPosition = ED%y%HubPtMotion%Position(:,1) + Init%InData_IfW%RadAvg = TwoNorm(BD%y(1)%BldMotion%Position(:,1) - BD%y(1)%BldMotion%Position(:,BD%y(1)%BldMotion%Nnodes)) + end if + + IF ( PRESENT(ExternInitData) ) THEN + Init%InData_IfW%Use4Dext = ExternInitData%FarmIntegration + + if (Init%InData_IfW%Use4Dext) then + Init%InData_IfW%FDext%n = ExternInitData%windGrid_n + Init%InData_IfW%FDext%delta = ExternInitData%windGrid_delta + Init%InData_IfW%FDext%pZero = ExternInitData%windGrid_pZero + Init%InData_IfW%FDext%Vel => ExternInitData%windGrid_data + end if + ELSE + Init%InData_IfW%Use4Dext = .false. + END IF + + ! OLAF might be used in AD, in which case we need to allow out of bounds for some calcs. To do that + ! the average values for the entire wind profile must be calculated and stored (we don't know if OLAF + ! is used until after AD_Init below). + if (p_FAST%CompAero == Module_AD) then + Init%InData_IfW%BoxExceedAllow = .true. + endif - CALL AD14_Init( Init%InData_AD14, AD14%Input(1), AD14%p, AD14%x(STATE_CURR), AD14%xd(STATE_CURR), AD14%z(STATE_CURR), & - AD14%OtherSt(STATE_CURR), AD14%y, AD14%m, p_FAST%dt_module( MODULE_AD14 ), Init%OutData_AD14, ErrStat2, ErrMsg2 ) + CALL InflowWind_Init( Init%InData_IfW, IfW%Input(1), IfW%p, IfW%x(STATE_CURR), IfW%xd(STATE_CURR), IfW%z(STATE_CURR), & + IfW%OtherSt(STATE_CURR), IfW%y, IfW%m, p_FAST%dt_module( MODULE_IfW ), Init%OutData_IfW, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - p_FAST%ModuleInitialized(Module_AD14) = .TRUE. - CALL SetModuleSubstepTime(Module_AD14, p_FAST, y_FAST, ErrStat2, ErrMsg2) + p_FAST%ModuleInitialized(Module_IfW) = .TRUE. + CALL SetModuleSubstepTime(Module_IfW, p_FAST, y_FAST, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - ! bjj: this really shouldn't be in the FAST glue code, but I'm going to put this check here so people don't use an invalid model - ! and send me emails to debug numerical issues in their results. - IF ( AD14%p%TwrProps%PJM_Version .AND. p_FAST%TurbineType == Type_Offshore_Floating ) THEN - CALL SetErrStat(ErrID_Fatal,'AeroDyn v14 tower influence model "NEWTOWER" is invalid for models of floating offshore turbines.',ErrStat,ErrMsg,RoutineName) + allocate( y_FAST%Lin%Modules(MODULE_IfW)%Instance(1), stat=ErrStat2) + if (ErrStat2 /= 0 ) then + call SetErrStat(ErrID_Fatal, "Error allocating Lin%Modules(IfW).", ErrStat, ErrMsg, RoutineName ) + else + if (allocated(Init%OutData_IfW%LinNames_y)) call move_alloc(Init%OutData_IfW%LinNames_y,y_FAST%Lin%Modules(MODULE_IfW)%Instance(1)%Names_y ) + if (allocated(Init%OutData_IfW%LinNames_u)) call move_alloc(Init%OutData_IfW%LinNames_u,y_FAST%Lin%Modules(MODULE_IfW)%Instance(1)%Names_u ) + if (allocated(Init%OutData_IfW%RotFrame_y)) call move_alloc(Init%OutData_IfW%RotFrame_y,y_FAST%Lin%Modules(MODULE_IfW)%Instance(1)%RotFrame_y ) + if (allocated(Init%OutData_IfW%RotFrame_u)) call move_alloc(Init%OutData_IfW%RotFrame_u,y_FAST%Lin%Modules(MODULE_IfW)%Instance(1)%RotFrame_u ) + if (allocated(Init%OutData_IfW%IsLoad_u )) call move_alloc(Init%OutData_IfW%IsLoad_u ,y_FAST%Lin%Modules(MODULE_IfW)%Instance(1)%IsLoad_u ) + + if (allocated(Init%OutData_IfW%WriteOutputHdr)) y_FAST%Lin%Modules(MODULE_IfW)%Instance(1)%NumOutputs = size(Init%OutData_IfW%WriteOutputHdr) + y_FAST%Lin%WindSpeed = Init%OutData_IfW%WindFileInfo%MWS + end if + + IF (ErrStat >= AbortErrLev) THEN + CALL Cleanup() + RETURN + END IF + + ELSEIF ( p_FAST%CompInflow == Module_ExtInfw ) THEN + ! ExtInfw requires initialization of AD first, so nothing executed here + ELSE + Init%OutData_IfW%WindFileInfo%MWS = 0.0_ReKi + END IF ! CompInflow + + + ! ........................ + ! initialize SeaStates + ! ........................ + ALLOCATE( SeaSt%Input( p_FAST%InterpOrder+1 ), SeaSt%InputTimes( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal,"Error allocating SeaSt%Input and SeaSt%InputTimes.",ErrStat,ErrMsg,RoutineName) + CALL Cleanup() + RETURN + END IF + + ALLOCATE( SeaSt%Input_Saved( p_FAST%InterpOrder+1 ), SeaSt%InputTimes_Saved( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal,"Error allocating SeaSt%Input_Saved and SeaSt%InputTimes_Saved.",ErrStat,ErrMsg,RoutineName) + CALL Cleanup() + RETURN END IF - AirDens = Init%OutData_AD14%AirDens + if ( p_FAST%CompSeaSt == Module_SeaSt ) then + + Init%InData_SeaSt%Gravity = p_FAST%Gravity + Init%InData_SeaSt%defWtrDens = p_FAST%WtrDens + Init%InData_SeaSt%defWtrDpth = p_FAST%WtrDpth + Init%InData_SeaSt%defMSL2SWL = p_FAST%MSL2SWL + Init%InData_SeaSt%UseInputFile = .TRUE. + Init%InData_SeaSt%Linearize = p_FAST%Linearize + Init%InData_SeaSt%hasIce = p_FAST%CompIce /= Module_None + Init%InData_SeaSt%InputFile = p_FAST%SeaStFile + Init%InData_SeaSt%OutRootName = TRIM(p_FAST%OutFileRoot)//'.'//TRIM(y_FAST%Module_Abrev(Module_SeaSt)) + + ! these values support wave field handling + Init%InData_SeaSt%WaveFieldMod = p_FAST%WaveFieldMod + Init%InData_SeaSt%PtfmLocationX = p_FAST%TurbinePos(1) + Init%InData_SeaSt%PtfmLocationY = p_FAST%TurbinePos(2) + + Init%InData_SeaSt%TMax = p_FAST%TMax + + ! wave field visualization + if (p_FAST%WrVTK == VTK_Animate .and. p_FAST%VTK_Type == VTK_Surf) Init%InData_SeaSt%SurfaceVis = .true. + + CALL SeaSt_Init( Init%InData_SeaSt, SeaSt%Input(1), SeaSt%p, SeaSt%x(STATE_CURR), SeaSt%xd(STATE_CURR), SeaSt%z(STATE_CURR), & + SeaSt%OtherSt(STATE_CURR), SeaSt%y, SeaSt%m, p_FAST%dt_module( MODULE_SeaSt ), Init%OutData_SeaSt, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + p_FAST%ModuleInitialized(Module_SeaSt) = .TRUE. + CALL SetModuleSubstepTime(Module_SeaSt, p_FAST, y_FAST, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + if (allocated(Init%OutData_SeaSt%WaveElevVisGrid)) then + p_FAST%VTK_surface%NWaveElevPts(1) = size(Init%OutData_SeaSt%WaveElevVisX) + p_FAST%VTK_surface%NWaveElevPts(2) = size(Init%OutData_SeaSt%WaveElevVisY) + else + p_FAST%VTK_surface%NWaveElevPts(1) = 0 + p_FAST%VTK_surface%NWaveElevPts(2) = 0 + endif + + allocate( y_FAST%Lin%Modules(MODULE_SeaSt)%Instance(1), stat=ErrStat2) + if (ErrStat2 /= 0 ) then + call SetErrStat(ErrID_Fatal, "Error allocating Lin%Modules(SeaSt).", ErrStat, ErrMsg, RoutineName ) + else + if (allocated(Init%OutData_SeaSt%LinNames_y)) call move_alloc(Init%OutData_SeaSt%LinNames_y,y_FAST%Lin%Modules(MODULE_SeaSt)%Instance(1)%Names_y ) + if (allocated(Init%OutData_SeaSt%LinNames_u)) call move_alloc(Init%OutData_SeaSt%LinNames_u,y_FAST%Lin%Modules(MODULE_SeaSt)%Instance(1)%Names_u ) + if (allocated(Init%OutData_SeaSt%RotFrame_y)) call move_alloc(Init%OutData_SeaSt%RotFrame_y,y_FAST%Lin%Modules(MODULE_SeaSt)%Instance(1)%RotFrame_y ) + if (allocated(Init%OutData_SeaSt%RotFrame_u)) call move_alloc(Init%OutData_SeaSt%RotFrame_u,y_FAST%Lin%Modules(MODULE_SeaSt)%Instance(1)%RotFrame_u ) + if (allocated(Init%OutData_SeaSt%IsLoad_u )) call move_alloc(Init%OutData_SeaSt%IsLoad_u ,y_FAST%Lin%Modules(MODULE_SeaSt)%Instance(1)%IsLoad_u ) + + if (allocated(Init%OutData_SeaSt%WriteOutputHdr)) y_FAST%Lin%Modules(MODULE_SeaSt)%Instance(1)%NumOutputs = size(Init%OutData_SeaSt%WriteOutputHdr) + end if IF (ErrStat >= AbortErrLev) THEN CALL Cleanup() RETURN + END IF + + end if + + + ! ........................ + ! initialize AeroDyn / ADsk + ! ........................ + ALLOCATE( AD%Input( p_FAST%InterpOrder+1 ), AD%InputTimes( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal,"Error allocating AD%Input and AD%InputTimes.",ErrStat,ErrMsg,RoutineName) + CALL Cleanup() + RETURN END IF - ELSEIF ( p_FAST%CompAero == Module_AD ) THEN - - allocate(Init%InData_AD%rotors(1), stat=ErrStat2) + ALLOCATE( AD%Input_Saved( p_FAST%InterpOrder+1 ), AD%InputTimes_Saved( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal,"Error allocating AD%Input and AD%InputTimes.",ErrStat,ErrMsg,RoutineName) + CALL Cleanup() + RETURN + END IF + + ALLOCATE( ADsk%Input( p_FAST%InterpOrder+1 ), ADsk%InputTimes( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal,"Error allocating ADsk%Input and ADsk%InputTimes.",ErrStat,ErrMsg,RoutineName) + CALL Cleanup() + RETURN + END IF + + IF ( (p_FAST%CompAero == Module_AD) .OR. (p_FAST%CompAero == Module_ExtLd) ) THEN + + allocate(Init%InData_AD%rotors(1), stat=ErrStat2) if (ErrStat2 /= 0 ) then call SetErrStat( ErrID_Fatal, 'Allocating rotors', errStat, errMsg, RoutineName ) call Cleanup() return end if - + Init%InData_AD%rotors(1)%NumBlades = NumBl - - + + if (p_FAST%CompAeroMaps) then + CALL AllocAry( MeshMapData%HubOrient, 3, 3, Init%InData_AD%rotors(1)%NumBlades, 'Hub orientation matrix', ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + IF (ErrStat >= AbortErrLev) THEN + CALL Cleanup() + RETURN + END IF + + theta = 0.0_R8Ki + do k=1,Init%InData_AD%rotors(1)%NumBlades + theta(1) = TwoPi_R8 * (k-1) / Init%InData_AD%rotors(1)%NumBlades + MeshMapData%HubOrient(:,:,k) = EulerConstruct( theta ) + end do + end if + + ! set initialization data for AD - CALL AllocAry( Init%InData_AD%rotors(1)%BladeRootPosition, 3, Init%InData_AD%rotors(1)%NumBlades, 'Init%InData_AD%BladeRootPosition', errStat2, ErrMsg2) + CALL AllocAry( Init%InData_AD%rotors(1)%BladeRootPosition, 3, Init%InData_AD%rotors(1)%NumBlades, 'Init%InData_AD%rotors(1)%BladeRootPosition', errStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - CALL AllocAry( Init%InData_AD%rotors(1)%BladeRootOrientation,3, 3, Init%InData_AD%rotors(1)%NumBlades, 'Init%InData_AD%BladeRootOrientation', errStat2, ErrMsg2) + CALL AllocAry( Init%InData_AD%rotors(1)%BladeRootOrientation,3, 3, Init%InData_AD%rotors(1)%NumBlades, 'Init%InData_AD%rotors(1)%BladeRootOrientation', errStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) IF (ErrStat >= AbortErrLev) THEN CALL Cleanup() RETURN END IF - Init%InData_AD%Gravity = p_FAST%Gravity + + Init%InData_AD%Gravity = p_FAST%Gravity Init%InData_AD%Linearize = p_FAST%Linearize + Init%InData_AD%CompAeroMaps = p_FAST%CompAeroMaps + Init%InData_AD%rotors(1)%RotSpeed = p_FAST%RotSpeedInit ! used only for aeromaps Init%InData_AD%InputFile = p_FAST%AeroFile Init%InData_AD%RootName = p_FAST%OutFileRoot Init%InData_AD%MHK = p_FAST%MHK - if ( p_FAST%MHK == 0 ) then + if ( p_FAST%MHK == MHK_None ) then Init%InData_AD%defFldDens = p_FAST%AirDens - elseif ( p_FAST%MHK == 1 .or. p_FAST%MHK == 2 ) then + else Init%InData_AD%defFldDens = p_FAST%WtrDens end if Init%InData_AD%defKinVisc = p_FAST%KinVisc @@ -496,20 +717,34 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, Init%InData_AD%defPvap = p_FAST%Pvap Init%InData_AD%WtrDpth = p_FAST%WtrDpth Init%InData_AD%MSL2SWL = p_FAST%MSL2SWL - - - Init%InData_AD%rotors(1)%HubPosition = ED%y%HubPtMotion%Position(:,1) - Init%InData_AD%rotors(1)%HubOrientation = ED%y%HubPtMotion%RefOrientation(:,:,1) - Init%InData_AD%rotors(1)%NacellePosition = ED%y%NacelleMotion%Position(:,1) - Init%InData_AD%rotors(1)%NacelleOrientation = ED%y%NacelleMotion%RefOrientation(:,:,1) + + + if (p_FAST%CompElast == Module_SED) then + Init%InData_AD%rotors(1)%HubPosition = SED%y%HubPtMotion%Position(:,1) + Init%InData_AD%rotors(1)%HubOrientation = SED%y%HubPtMotion%RefOrientation(:,:,1) + Init%InData_AD%rotors(1)%NacellePosition = SED%y%NacelleMotion%Position(:,1) + Init%InData_AD%rotors(1)%NacelleOrientation = SED%y%NacelleMotion%RefOrientation(:,:,1) + do k=1,NumBl + Init%InData_AD%rotors(1)%BladeRootPosition(:,k) = SED%y%BladeRootMotion(k)%Position(:,1) + Init%InData_AD%rotors(1)%BladeRootOrientation(:,:,k) = SED%y%BladeRootMotion(k)%RefOrientation(:,:,1) + end do + elseif (p_FAST%CompElast == Module_ED .or. p_FAST%CompElast == Module_BD) then + Init%InData_AD%rotors(1)%HubPosition = ED%y%HubPtMotion%Position(:,1) + Init%InData_AD%rotors(1)%HubOrientation = ED%y%HubPtMotion%RefOrientation(:,:,1) + Init%InData_AD%rotors(1)%NacellePosition = ED%y%NacelleMotion%Position(:,1) + Init%InData_AD%rotors(1)%NacelleOrientation = ED%y%NacelleMotion%RefOrientation(:,:,1) + do k=1,NumBl + Init%InData_AD%rotors(1)%BladeRootPosition(:,k) = ED%y%BladeRootMotion(k)%Position(:,1) + Init%InData_AD%rotors(1)%BladeRootOrientation(:,:,k) = ED%y%BladeRootMotion(k)%RefOrientation(:,:,1) + end do + endif + ! Note: not passing tailfin position and orientation at init - Init%InData_AD%rotors(1)%AeroProjMod = APM_BEM_NoSweepPitchTwist - - do k=1,NumBl - Init%InData_AD%rotors(1)%BladeRootPosition(:,k) = ED%y%BladeRootMotion(k)%Position(:,1) - Init%InData_AD%rotors(1)%BladeRootOrientation(:,:,k) = ED%y%BladeRootMotion(k)%RefOrientation(:,:,1) - end do - + Init%InData_AD%rotors(1)%AeroProjMod = -1 ! -1 means AeroDyn will decide based on BEM_Mod + + ! Set pointers to flowfield + IF (p_FAST%CompInflow == Module_IfW) Init%InData_AD%FlowField => Init%OutData_IfW%FlowField + CALL AD_Init( Init%InData_AD, AD%Input(1), AD%p, AD%x(STATE_CURR), AD%xd(STATE_CURR), AD%z(STATE_CURR), & AD%OtherSt(STATE_CURR), AD%y, AD%m, p_FAST%dt_module( MODULE_AD ), Init%OutData_AD, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) @@ -537,163 +772,113 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, IF (ErrStat >= AbortErrLev) THEN CALL Cleanup() RETURN - END IF - + END IF + + ! AeroDyn may override the AirDens value. Store this to inform other modules AirDens = Init%OutData_AD%rotors(1)%AirDens - - ELSE - AirDens = 0.0_ReKi - END IF ! CompAero + ELSEIF ( p_FAST%CompAero == Module_ADsk ) THEN + Init%InData_ADsk%InputFile = p_FAST%AeroFile + Init%InData_ADsk%RootName = p_FAST%OutFileRoot + ! NOTE: cone angle is not included in the RotorRad calculation!!! + if (p_FAST%CompElast == Module_SED) then + Init%InData_ADsk%RotorRad = Init%OutData_SED%HubRad + Init%OutData_SED%BladeLength + Init%InData_ADsk%HubPosition = SED%y%HubPtMotion%Position(:,1) + Init%InData_ADsk%HubOrientation = SED%y%HubPtMotion%RefOrientation(:,:,1) + else + Init%InData_ADsk%RotorRad = Init%OutData_ED%HubRad + Init%OutData_ED%BladeLength + Init%InData_ADsk%HubPosition = ED%y%HubPtMotion%Position(:,1) + Init%InData_ADsk%HubOrientation = ED%y%HubPtMotion%RefOrientation(:,:,1) + endif + Init%InData_ADsk%defAirDens = p_FAST%AirDens + Init%InData_ADsk%Linearize = p_FAST%Linearize ! NOTE: This module cannot be linearized + Init%InData_ADsk%UseInputFile = .true. + !Init%InData_ADsk%PassedFileData = ! Passing filename instead of file contents + IF (p_FAST%CompInflow == Module_IfW) Init%InData_ADsk%FlowField => Init%OutData_IfW%FlowField + + CALL ADsk_Init( Init%InData_ADsk, ADsk%Input(1), ADsk%p, ADsk%x(STATE_CURR), ADsk%xd(STATE_CURR), ADsk%z(STATE_CURR), & + ADsk%OtherSt(STATE_CURR), ADsk%y, ADsk%m, p_FAST%dt_module( MODULE_ADsk ), Init%OutData_ADsk, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - ! ........................ - ! initialize InflowWind - ! ........................ - ALLOCATE( IfW%Input( p_FAST%InterpOrder+1 ), IfW%InputTimes( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal,"Error allocating IfW%Input and IfW%InputTimes.",ErrStat,ErrMsg,RoutineName) - CALL Cleanup() - RETURN - END IF - - IF ( p_FAST%CompInflow == Module_IfW ) THEN - - Init%InData_IfW%Linearize = p_FAST%Linearize - Init%InData_IfW%InputFileName = p_FAST%InflowFile - Init%InData_IfW%RootName = TRIM(p_FAST%OutFileRoot)//'.'//TRIM(y_FAST%Module_Abrev(Module_IfW)) - Init%InData_IfW%UseInputFile = .TRUE. - Init%InData_IfW%FixedWindFileRootName = .FALSE. - Init%InData_IfW%OutputAccel = p_FAST%MHK > 0 + p_FAST%ModuleInitialized(Module_ADsk) = .TRUE. + CALL SetModuleSubstepTime(Module_ADsk, p_FAST, y_FAST, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - Init%InData_IfW%MHK = p_FAST%MHK - Init%InData_IfW%WtrDpth = p_FAST%WtrDpth + ! AeroDisk may override the AirDens value. Store this to inform other modules + AirDens = Init%OutData_ADsk%AirDens - Init%InData_IfW%NumWindPoints = 0 - IF ( p_FAST%CompServo == Module_SrvD ) Init%InData_IfW%NumWindPoints = Init%InData_IfW%NumWindPoints + 1 - IF ( p_FAST%CompAero == Module_AD14 ) THEN - Init%InData_IfW%NumWindPoints = Init%InData_IfW%NumWindPoints + NumBl * AD14%Input(1)%InputMarkers(1)%NNodes + AD14%Input(1)%Twr_InputMarkers%NNodes - ELSEIF ( p_FAST%CompAero == Module_AD ) THEN - ! Number of Wind points from AeroDyn, see AeroDyn.f90 - Init%InData_IfW%NumWindPoints = Init%InData_IfW%NumWindPoints + AD_NumWindPoints(AD%Input(1), AD%OtherSt(STATE_CURR)) - ! Wake -- we allow the wake positions to exceed the wind box - if (allocated(AD%OtherSt(STATE_CURR)%WakeLocationPoints)) then - Init%InData_IfW%BoxExceedAllowF = .true. - Init%InData_IfW%BoxExceedAllowIdx = AD_BoxExceedPointsIdx(AD%Input(1), AD%OtherSt(STATE_CURR)) - endif - END IF + END IF ! CompAero - ! lidar - Init%InData_IfW%LidarEnabled = .true. ! allowed with OF, but not FF - Init%InData_IfW%lidar%Tmax = p_FAST%TMax - Init%InData_IfW%lidar%HubPosition = ED%y%HubPtMotion%Position(:,1) + IF ( p_FAST%CompAero == Module_ExtLd ) THEN - Init%InData_IfW%lidar%HubPosition = ED%y%HubPtMotion%Position(:,1) - if ( p_FAST%CompElast == Module_BD ) then - Init%InData_IfW%RadAvg = TwoNorm(BD%y(1)%BldMotion%Position(:,1) - BD%y(1)%BldMotion%Position(:,BD%y(1)%BldMotion%Nnodes)) - else - Init%InData_IfW%RadAvg = Init%OutData_ED%BladeLength - end if - IF ( PRESENT(ExternInitData) ) THEN - Init%InData_IfW%Use4Dext = ExternInitData%FarmIntegration - - if (Init%InData_IfW%Use4Dext) then - Init%InData_IfW%FDext%n = ExternInitData%windGrid_n - Init%InData_IfW%FDext%delta = ExternInitData%windGrid_delta - Init%InData_IfW%FDext%pZero = ExternInitData%windGrid_pZero - end if - ELSE - Init%InData_IfW%Use4Dext = .false. - END IF - CALL InflowWind_Init( Init%InData_IfW, IfW%Input(1), IfW%p, IfW%x(STATE_CURR), IfW%xd(STATE_CURR), IfW%z(STATE_CURR), & - IfW%OtherSt(STATE_CURR), IfW%y, IfW%m, p_FAST%dt_module( MODULE_IfW ), Init%OutData_IfW, ErrStat2, ErrMsg2 ) + ! set initialization data for ExtLoads + CALL ExtLd_SetInitInput(Init%InData_ExtLd, Init%OutData_ED, ED%y, Init%OutData_BD, BD%y(:), Init%OutData_AD, p_FAST, ExternInitData, ErrStat2, ErrMsg2) + CALL ExtLd_Init( Init%InData_ExtLd, ExtLd%u, ExtLd%xd(1), ExtLd%p, ExtLd%y, ExtLd%m, p_FAST%dt_module( MODULE_ExtLd ), Init%OutData_ExtLd, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - p_FAST%ModuleInitialized(Module_IfW) = .TRUE. - CALL SetModuleSubstepTime(Module_IfW, p_FAST, y_FAST, ErrStat2, ErrMsg2) + p_FAST%ModuleInitialized(Module_ExtLd) = .TRUE. + CALL SetModuleSubstepTime(Module_ExtLd, p_FAST, y_FAST, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - allocate( y_FAST%Lin%Modules(MODULE_IfW)%Instance(1), stat=ErrStat2) - if (ErrStat2 /= 0 ) then - call SetErrStat(ErrID_Fatal, "Error allocating Lin%Modules(IfW).", ErrStat, ErrMsg, RoutineName ) - else - if (allocated(Init%OutData_IfW%LinNames_y)) call move_alloc(Init%OutData_IfW%LinNames_y,y_FAST%Lin%Modules(MODULE_IfW)%Instance(1)%Names_y ) - if (allocated(Init%OutData_IfW%LinNames_u)) call move_alloc(Init%OutData_IfW%LinNames_u,y_FAST%Lin%Modules(MODULE_IfW)%Instance(1)%Names_u ) - if (allocated(Init%OutData_IfW%RotFrame_y)) call move_alloc(Init%OutData_IfW%RotFrame_y,y_FAST%Lin%Modules(MODULE_IfW)%Instance(1)%RotFrame_y ) - if (allocated(Init%OutData_IfW%RotFrame_u)) call move_alloc(Init%OutData_IfW%RotFrame_u,y_FAST%Lin%Modules(MODULE_IfW)%Instance(1)%RotFrame_u ) - if (allocated(Init%OutData_IfW%IsLoad_u )) call move_alloc(Init%OutData_IfW%IsLoad_u ,y_FAST%Lin%Modules(MODULE_IfW)%Instance(1)%IsLoad_u ) + IF (ErrStat >= AbortErrLev) THEN + CALL Cleanup() + RETURN + END IF - if (allocated(Init%OutData_IfW%WriteOutputHdr)) y_FAST%Lin%Modules(MODULE_IfW)%Instance(1)%NumOutputs = size(Init%OutData_IfW%WriteOutputHdr) - y_FAST%Lin%WindSpeed = Init%OutData_IfW%WindFileInfo%MWS - end if + ! ExtLd may override the AirDens value. Store this to inform other modules + AirDens = Init%OutData_ExtLd%AirDens - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF - - IF ( p_FAST%CompServo == Module_SrvD ) THEN !assign the number of gates to ServD - if (allocated(IfW%y%lidar%LidSpeed)) then ! make sure we have the array allocated before setting it - CALL AllocAry(Init%InData_SrvD%LidSpeed, size(IfW%y%lidar%LidSpeed), 'Init%InData_SrvD%LidSpeed', errStat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - Init%InData_SrvD%LidSpeed = IfW%y%lidar%LidSpeed - endif - if (allocated(IfW%y%lidar%MsrPositionsX)) then ! make sure we have the array allocated before setting it - CALL AllocAry(Init%InData_SrvD%MsrPositionsX, size(IfW%y%lidar%MsrPositionsX), 'Init%InData_SrvD%MsrPositionsX', errStat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - Init%InData_SrvD%MsrPositionsX = IfW%y%lidar%MsrPositionsX - endif - if (allocated(IfW%y%lidar%MsrPositionsY)) then ! make sure we have the array allocated before setting it - CALL AllocAry(Init%InData_SrvD%MsrPositionsY, size(IfW%y%lidar%MsrPositionsY), 'Init%InData_SrvD%MsrPositionsY', errStat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - Init%InData_SrvD%MsrPositionsY = IfW%y%lidar%MsrPositionsY - endif - if (allocated(IfW%y%lidar%MsrPositionsZ)) then ! make sure we have the array allocated before setting it - CALL AllocAry(Init%InData_SrvD%MsrPositionsZ, size(IfW%y%lidar%MsrPositionsZ), 'Init%InData_SrvD%MsrPositionsZ', errStat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - Init%InData_SrvD%MsrPositionsZ = IfW%y%lidar%MsrPositionsZ - endif - Init%InData_SrvD%SensorType = IfW%p%lidar%SensorType - Init%InData_SrvD%NumBeam = IfW%p%lidar%NumBeam - Init%InData_SrvD%NumPulseGate = IfW%p%lidar%NumPulseGate - Init%InData_SrvD%PulseSpacing = IfW%p%lidar%PulseSpacing END IF - - ELSEIF ( p_FAST%CompInflow == Module_OpFM ) THEN + END IF + + ! ........................ + ! No aero of any sort + ! ........................ + IF ( (p_FAST%CompAero == Module_None) .or. (p_FAST%CompAero == Module_Unknown)) THEN + AirDens = 0.0_ReKi + ENDIF + + + ! ........................ + ! initialize ExtInfw + ! Ideally this would be initialized in the same logic as InflowWind above. However AD outputs are required + ! ........................ + IF ( p_FAST%CompInflow == Module_ExtInfw ) THEN IF ( PRESENT(ExternInitData) ) THEN - Init%InData_OpFM%NumActForcePtsBlade = ExternInitData%NumActForcePtsBlade - Init%InData_OpFM%NumActForcePtsTower = ExternInitData%NumActForcePtsTower + Init%InData_ExtInfw%NumActForcePtsBlade = ExternInitData%NumActForcePtsBlade + Init%InData_ExtInfw%NumActForcePtsTower = ExternInitData%NumActForcePtsTower ELSE - CALL SetErrStat( ErrID_Fatal, 'OpenFOAM integration can be used only with external input data (not the stand-alone executable).', ErrStat, ErrMsg, RoutineName ) + CALL SetErrStat( ErrID_Fatal, 'ExternalInflow integration can be used only with external input data (not the stand-alone executable).', ErrStat, ErrMsg, RoutineName ) CALL Cleanup() RETURN END IF ! get blade and tower info from AD. Assumption made that all blades have same spanwise characteristics - Init%InData_OpFM%BladeLength = Init%OutData_AD%rotors(1)%BladeProps(1)%BlSpn(Init%OutData_AD%rotors(1)%BladeProps(1)%NumBlNds) + Init%InData_ExtInfw%BladeLength = Init%OutData_AD%rotors(1)%BladeProps(1)%BlSpn(Init%OutData_AD%rotors(1)%BladeProps(1)%NumBlNds) if (allocated(Init%OutData_AD%rotors(1)%TwrElev)) then - Init%InData_OpFM%TowerHeight = Init%OutData_AD%rotors(1)%TwrElev(SIZE(Init%OutData_AD%rotors(1)%TwrElev)) - Init%OutData_AD%rotors(1)%TwrElev(1) ! TwrElev is based on ground or MSL. Need flexible tower length and first node - Init%InData_OpFM%TowerBaseHeight = Init%OutData_AD%rotors(1)%TwrElev(1) - ALLOCATE(Init%InData_OpFM%StructTwrHNodes( SIZE(Init%OutData_AD%rotors(1)%TwrElev)), STAT=ErrStat2) - Init%InData_OpFM%StructTwrHNodes(:) = Init%OutData_AD%rotors(1)%TwrElev(:) + Init%InData_ExtInfw%TowerHeight = Init%OutData_AD%rotors(1)%TwrElev(SIZE(Init%OutData_AD%rotors(1)%TwrElev)) - Init%OutData_AD%rotors(1)%TwrElev(1) ! TwrElev is based on ground or MSL. Need flexible tower length and first node + Init%InData_ExtInfw%TowerBaseHeight = Init%OutData_AD%rotors(1)%TwrElev(1) + ALLOCATE(Init%InData_ExtInfw%StructTwrHNodes( SIZE(Init%OutData_AD%rotors(1)%TwrElev)), STAT=ErrStat2) + Init%InData_ExtInfw%StructTwrHNodes(:) = Init%OutData_AD%rotors(1)%TwrElev(:) else - Init%InData_OpFM%TowerHeight = 0.0_ReKi - Init%InData_OpFM%TowerBaseHeight = 0.0_ReKi + Init%InData_ExtInfw%TowerHeight = 0.0_ReKi + Init%InData_ExtInfw%TowerBaseHeight = 0.0_ReKi endif - ALLOCATE(Init%InData_OpFM%StructBldRNodes(Init%OutData_AD%rotors(1)%BladeProps(1)%NumBlNds), STAT=ErrStat2) - Init%InData_OpFM%StructBldRNodes(:) = Init%OutData_AD%rotors(1)%BladeProps(1)%BlSpn(:) + ALLOCATE(Init%InData_ExtInfw%StructBldRNodes(Init%OutData_AD%rotors(1)%BladeProps(1)%NumBlNds), STAT=ErrStat2) + Init%InData_ExtInfw%StructBldRNodes(:) = Init%OutData_AD%rotors(1)%BladeProps(1)%BlSpn(:) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal,"Error allocating OpFM%InitInput.",ErrStat,ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal,"Error allocating ExtInfw%InitInput.",ErrStat,ErrMsg,RoutineName) CALL Cleanup() RETURN END IF !Set node clustering type - Init%InData_OpFM%NodeClusterType = ExternInitData%NodeClusterType - ! set up the data structures for integration with OpenFOAM - CALL Init_OpFM( Init%InData_OpFM, p_FAST, AirDens, AD%Input(1), Init%OutData_AD, AD%y, OpFM, Init%OutData_OpFM, ErrStat2, ErrMsg2 ) + Init%InData_ExtInfw%NodeClusterType = ExternInitData%NodeClusterType + ! set up the data structures for integration with ExternalInflow + CALL Init_ExtInfw( Init%InData_ExtInfw, p_FAST, AirDens, AD%Input(1), Init%OutData_AD, AD%y, ExtInfw, Init%OutData_ExtInfw, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) IF (ErrStat >= AbortErrLev) THEN @@ -704,62 +889,33 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, !bjj: fix me!!! to do Init%OutData_IfW%WindFileInfo%MWS = 0.0_ReKi - ELSE - Init%OutData_IfW%WindFileInfo%MWS = 0.0_ReKi - END IF ! CompInflow - - ! ........................ - ! initialize SuperController - ! ........................ - IF ( PRESENT(ExternInitData) ) THEN - ! set up the data structures for integration with supercontroller - IF ( p_FAST%UseSC ) THEN - CALL SC_DX_Init( ExternInitData%NumSC2CtrlGlob, ExternInitData%NumSC2Ctrl, ExternInitData%NumCtrl2SC, SC_DX, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ELSE - SC_DX%u%c_obj%toSC_Len = 0 - SC_DX%u%c_obj%toSC = C_NULL_PTR - SC_DX%y%c_obj%fromSC_Len = 0 - SC_DX%y%c_obj%fromSC = C_NULL_PTR - SC_DX%y%c_obj%fromSCglob_Len = 0 - SC_DX%y%c_obj%fromSCglob = C_NULL_PTR - END IF - END IF + ! Set pointer to flowfield -- I would prefer that we did this through the AD_Init, but AD_InitOut results are required for ExtInfw_Init + IF (p_FAST%CompAero == Module_AD) AD%p%FlowField => Init%OutData_ExtInfw%FlowField + endif - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF ! ........................ - ! some checks for AeroDyn14's Dynamic Inflow with Mean Wind Speed from InflowWind: - ! (DO NOT COPY THIS CODE!) - ! bjj: AeroDyn14 should not need this rule of thumb; it should check the instantaneous values when the code runs + ! initialize SuperController ! ........................ - - IF ( p_FAST%CompAero == Module_AD14 ) THEN - IF (AD14%p%DynInfl) THEN - IF ( Init%OutData_IfW%WindFileInfo%MWS < 8.0 ) THEN - CALL SetErrStat(ErrID_Fatal,'AeroDyn v14 "DYNINFL" InfModel is invalid for models with wind speeds less than 8 m/s.',ErrStat,ErrMsg,RoutineName) - !CALL SetErrStat(ErrID_Info,'Estimated average inflow wind speed is less than 8 m/s. Dynamic Inflow will be turned off.',ErrStat,ErrMess,RoutineName ) - END IF + IF ( PRESENT(ExternInitData) ) THEN + ! set up the data structures for integration with supercontroller + IF ( p_FAST%UseSC ) THEN + CALL SC_DX_Init( ExternInitData%NumSC2CtrlGlob, ExternInitData%NumSC2Ctrl, ExternInitData%NumCtrl2SC, SC_DX, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ELSE + SC_DX%u%c_obj%toSC_Len = 0 + SC_DX%u%c_obj%toSC = C_NULL_PTR + SC_DX%y%c_obj%fromSC_Len = 0 + SC_DX%y%c_obj%fromSC = C_NULL_PTR + SC_DX%y%c_obj%fromSCglob_Len = 0 + SC_DX%y%c_obj%fromSCglob = C_NULL_PTR END IF END IF - - ! ........................ - ! set some VTK parameters required before HydroDyn init (so we can get wave elevations for visualization) - ! ........................ - - ! get wave elevation data for visualization - if ( p_FAST%WrVTK > VTK_None ) then - call SetVTKParameters_B4HD(p_FAST, Init%OutData_ED, Init%InData_HD, BD, ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF - end if + IF (ErrStat >= AbortErrLev) THEN + CALL Cleanup() + RETURN + END IF ! ........................ @@ -772,24 +928,29 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, RETURN END IF + ALLOCATE( HD%Input_Saved( p_FAST%InterpOrder+1 ), HD%InputTimes_Saved( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal,"Error allocating HD%Input_Saved and HD%InputTimes_Saved.",ErrStat,ErrMsg,RoutineName) + CALL Cleanup() + RETURN + END IF + IF ( p_FAST%CompHydro == Module_HD ) THEN Init%InData_HD%Gravity = p_FAST%Gravity - Init%InData_HD%defWtrDens = p_FAST%WtrDens - Init%InData_HD%defWtrDpth = p_FAST%WtrDpth - Init%InData_HD%defMSL2SWL = p_FAST%MSL2SWL Init%InData_HD%UseInputFile = .TRUE. Init%InData_HD%InputFile = p_FAST%HydroFile - Init%InData_HD%OutRootName = p_FAST%OutFileRoot + Init%InData_HD%OutRootName = TRIM(p_FAST%OutFileRoot)//'.'//TRIM(y_FAST%Module_Abrev(Module_HD)) Init%InData_HD%TMax = p_FAST%TMax - Init%InData_HD%hasIce = p_FAST%CompIce /= Module_None Init%InData_HD%Linearize = p_FAST%Linearize + Init%InData_HD%PlatformPos = Init%OutData_ED%PlatformPos ! Initial platform position; PlatformPos(1:3) is effectively the initial position of the HD origin if (p_FAST%WrVTK /= VTK_None) Init%InData_HD%VisMeshes=.true. - - ! these values support wave field handling - Init%InData_HD%WaveFieldMod = p_FAST%WaveFieldMod - Init%InData_HD%PtfmLocationX = p_FAST%TurbinePos(1) - Init%InData_HD%PtfmLocationY = p_FAST%TurbinePos(2) + + ! if ( p_FAST%CompSeaSt == Module_SeaSt ) then ! this is always true + Init%InData_HD%InvalidWithSSExctn = Init%OutData_SeaSt%InvalidWithSSExctn + Init%InData_HD%WaveField => Init%OutData_SeaSt%WaveField + ! end if + CALL HydroDyn_Init( Init%InData_HD, HD%Input(1), HD%p, HD%x(STATE_CURR), HD%xd(STATE_CURR), HD%z(STATE_CURR), & HD%OtherSt(STATE_CURR), HD%y, HD%m, p_FAST%dt_module( MODULE_HD ), Init%OutData_HD, ErrStat2, ErrMsg2 ) @@ -799,6 +960,11 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, CALL SetModuleSubstepTime(Module_HD, p_FAST, y_FAST, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + IF (ErrStat >= AbortErrLev) THEN + CALL Cleanup() + RETURN + END IF + allocate( y_FAST%Lin%Modules(MODULE_HD)%Instance(1), stat=ErrStat2) if (ErrStat2 /= 0 ) then call SetErrStat(ErrID_Fatal, "Error allocating Lin%Modules(HD).", ErrStat, ErrMsg, RoutineName ) @@ -828,6 +994,13 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, RETURN END IF + ALLOCATE( SD%Input_Saved( p_FAST%InterpOrder+1 ), SD%InputTimes_Saved( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal,"Error allocating SD%Input_Saved and SD%InputTimes_Saved.",ErrStat,ErrMsg,RoutineName) + CALL Cleanup() + RETURN + END IF + ALLOCATE( ExtPtfm%Input( p_FAST%InterpOrder+1 ), ExtPtfm%InputTimes( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) IF (ErrStat2 /= 0) THEN CALL SetErrStat(ErrID_Fatal,"Error allocating ExtPtfm%Input and ExtPtfm%InputTimes.",ErrStat,ErrMsg,RoutineName) @@ -835,23 +1008,30 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, RETURN END IF + ALLOCATE( ExtPtfm%Input_Saved( p_FAST%InterpOrder+1 ), ExtPtfm%InputTimes_Saved( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal,"Error allocating ExtPtfm%Input_Saved and ExtPtfm%InputTimes_Saved.",ErrStat,ErrMsg,RoutineName) + CALL Cleanup() + RETURN + END IF + IF ( p_FAST%CompSub == Module_SD ) THEN IF ( p_FAST%CompHydro == Module_HD ) THEN - Init%InData_SD%WtrDpth = Init%OutData_HD%WtrDpth + Init%InData_SD%WtrDpth = Init%OutData_SeaSt%WaveField%WtrDpth ELSE Init%InData_SD%WtrDpth = 0.0_ReKi END IF - + Init%InData_SD%Linearize = p_FAST%Linearize - Init%InData_SD%g = p_FAST%Gravity - !Ini%tInData_SD%UseInputFile = .TRUE. + Init%InData_SD%g = p_FAST%Gravity + !Ini%tInData_SD%UseInputFile = .TRUE. Init%InData_SD%SDInputFile = p_FAST%SubFile Init%InData_SD%RootName = p_FAST%OutFileRoot Init%InData_SD%TP_RefPoint = ED%y%PlatformPtMesh%Position(:,1) ! "Interface point" where loads will be transferred to Init%InData_SD%SubRotateZ = 0.0 ! Used by driver to rotate structure around z - - + + CALL SD_Init( Init%InData_SD, SD%Input(1), SD%p, SD%x(STATE_CURR), SD%xd(STATE_CURR), SD%z(STATE_CURR), & SD%OtherSt(STATE_CURR), SD%y, SD%m, p_FAST%dt_module( MODULE_SD ), Init%OutData_SD, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) @@ -874,7 +1054,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, if (allocated(Init%OutData_SD%WriteOutputHdr)) y_FAST%Lin%Modules(MODULE_SD)%Instance(1)%NumOutputs = size(Init%OutData_SD%WriteOutputHdr) if (allocated(Init%OutData_SD%DerivOrder_x)) call move_alloc(Init%OutData_SD%DerivOrder_x,y_FAST%Lin%Modules(MODULE_SD)%Instance(1)%DerivOrder_x) end if - + IF (ErrStat >= AbortErrLev) THEN CALL Cleanup() RETURN @@ -926,24 +1106,48 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, CALL Cleanup() RETURN END IF + ALLOCATE( MAPp%Input_Saved( p_FAST%InterpOrder+1 ), MAPp%InputTimes_Saved( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal,"Error allocating MAPp%Input_Saved and MAPp%InputTimes_Saved.",ErrStat,ErrMsg,RoutineName) + CALL Cleanup() + RETURN + END IF ALLOCATE( MD%Input( p_FAST%InterpOrder+1 ), MD%InputTimes( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) IF (ErrStat2 /= 0) THEN CALL SetErrStat(ErrID_Fatal,"Error allocating MD%Input and MD%InputTimes.",ErrStat,ErrMsg,RoutineName) CALL Cleanup() RETURN END IF + ALLOCATE( MD%Input_Saved( p_FAST%InterpOrder+1 ), MD%InputTimes_Saved( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal,"Error allocating MD%Input_Saved and MD%InputTimes_Saved.",ErrStat,ErrMsg,RoutineName) + CALL Cleanup() + RETURN + END IF ALLOCATE( FEAM%Input( p_FAST%InterpOrder+1 ), FEAM%InputTimes( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) IF (ErrStat2 /= 0) THEN CALL SetErrStat(ErrID_Fatal,"Error allocating FEAM%Input and FEAM%InputTimes.",ErrStat,ErrMsg,RoutineName) CALL Cleanup() RETURN END IF + ALLOCATE( FEAM%Input_Saved( p_FAST%InterpOrder+1 ), FEAM%InputTimes_Saved( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal,"Error allocating FEAM%Input_Saved and FEAM%InputTimes_Saved.",ErrStat,ErrMsg,RoutineName) + CALL Cleanup() + RETURN + END IF ALLOCATE( Orca%Input( p_FAST%InterpOrder+1 ), Orca%InputTimes( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) IF (ErrStat2 /= 0) THEN CALL SetErrStat(ErrID_Fatal,"Error allocating Orca%Input and Orca%InputTimes.",ErrStat,ErrMsg,RoutineName) CALL Cleanup() RETURN END IF + ALLOCATE( Orca%Input_Saved( p_FAST%InterpOrder+1 ), Orca%InputTimes_Saved( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal,"Error allocating Orca%Input_Saved and Orca%InputTimes_Saved.",ErrStat,ErrMsg,RoutineName) + CALL Cleanup() + RETURN + END IF ! ........................ ! initialize MAP @@ -953,15 +1157,14 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, CALL WrScr(NewLine) !bjj: I'm printing two blank lines here because MAP seems to be writing over the last line on the screen. -! Init%InData_MAP%rootname = p_FAST%OutFileRoot ! Output file name +! Init%InData_MAP%rootname = p_FAST%OutFileRoot ! Output file name Init%InData_MAP%gravity = p_FAST%Gravity ! This need to be according to g from driver - Init%InData_MAP%sea_density = Init%OutData_HD%WtrDens ! This needs to be set according to seawater density in HydroDyn - Init%InData_MAP%depth = Init%OutData_HD%WtrDpth ! This need to be set according to the water depth in HydroDyn + Init%InData_MAP%sea_density = Init%OutData_SeaSt%WaveField%WtrDens ! This needs to be set according to seawater density in SeaState ! differences for MAP++ Init%InData_MAP%file_name = p_FAST%MooringFile ! This needs to be set according to what is in the FAST input file. Init%InData_MAP%summary_file_name = TRIM(p_FAST%OutFileRoot)//'.MAP.sum' ! Output file name - Init%InData_MAP%depth = -Init%OutData_HD%WtrDpth ! This need to be set according to the water depth in HydroDyn + Init%InData_MAP%depth = -Init%OutData_SeaSt%WaveField%WtrDpth ! This need to be set according to the water depth in SeaState Init%InData_MAP%LinInitInp%Linearize = p_FAST%Linearize @@ -992,7 +1195,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, ! initialize MoorDyn ! ........................ ELSEIF (p_FAST%CompMooring == Module_MD) THEN - + ! some new allocations needed with version that's compatible with farm-level use ALLOCATE( Init%InData_MD%PtfmInit(6,1), Init%InData_MD%TurbineRefPos(3,1), STAT = ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -1005,11 +1208,11 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, Init%InData_MD%RootName = p_FAST%OutFileRoot Init%InData_MD%PtfmInit(:,1) = Init%OutData_ED%PlatformPos ! initial position of the platform (when a FAST module, MoorDyn just takes one row in this matrix) - Init%InData_MD%FarmSize = 0 ! 0 here indicates normal FAST module use of MoorDyn, for a single turbine + Init%InData_MD%FarmSize = 0 ! 0 here indicates normal FAST module use of MoorDyn, for a single turbine Init%InData_MD%TurbineRefPos(:,1) = 0.0_DbKi ! for normal FAST use, the global reference frame is at 0,0,0 Init%InData_MD%g = p_FAST%Gravity ! This need to be according to g used in ElastoDyn - Init%InData_MD%rhoW = Init%OutData_HD%WtrDens ! This needs to be set according to seawater density in HydroDyn - Init%InData_MD%WtrDepth = Init%OutData_HD%WtrDpth ! This need to be set according to the water depth in HydroDyn + Init%InData_MD%rhoW = Init%OutData_SeaSt%WaveField%WtrDens ! This needs to be set according to seawater density in SeaState + Init%InData_MD%WtrDepth = Init%OutData_SeaSt%WaveField%WtrDpth ! This need to be set according to the water depth in SeaState Init%InData_MD%Tmax = p_FAST%TMax ! expected simulation duration (used by MoorDyn for wave kinematics preprocesing) Init%InData_MD%Linearize = p_FAST%Linearize @@ -1022,7 +1225,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, p_FAST%ModuleInitialized(Module_MD) = .TRUE. CALL SetModuleSubstepTime(Module_MD, p_FAST, y_FAST, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - + allocate( y_FAST%Lin%Modules(MODULE_MD)%Instance(1), stat=ErrStat2) if (ErrStat2 /= 0 ) then call SetErrStat(ErrID_Fatal, "Error allocating Lin%Modules(MD).", ErrStat, ErrMsg, RoutineName ) @@ -1037,7 +1240,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, if (allocated(Init%OutData_MD%WriteOutputHdr)) y_FAST%Lin%Modules(MODULE_MD)%Instance(1)%NumOutputs = size(Init%OutData_MD%WriteOutputHdr) if (allocated(Init%OutData_MD%DerivOrder_x)) call move_alloc(Init%OutData_MD%DerivOrder_x,y_FAST%Lin%Modules(MODULE_MD)%Instance(1)%DerivOrder_x) end if - + IF (ErrStat >= AbortErrLev) THEN CALL Cleanup() RETURN @@ -1051,10 +1254,10 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, Init%InData_FEAM%RootName = TRIM(p_FAST%OutFileRoot)//'.'//TRIM(y_FAST%Module_Abrev(Module_FEAM)) Init%InData_FEAM%PtfmInit = Init%OutData_ED%PlatformPos !ED%x(STATE_CURR)%QT(1:6) ! initial position of the platform !bjj: this should come from Init%OutData_ED, not x_ED - Init%InData_FEAM%NStepWave = 1 ! an arbitrary number > 0 (to set the size of the wave data, which currently contains all zero values) + Init%InData_FEAM%NStepWave = 1 ! an arbitrary number > 0 (to set the size of the wave data, which currently contains all zero values) Init%InData_FEAM%gravity = p_FAST%Gravity ! This need to be according to g from driver - Init%InData_FEAM%WtrDens = Init%OutData_HD%WtrDens ! This needs to be set according to seawater density in HydroDyn -! Init%InData_FEAM%depth = Init%OutData_HD%WtrDpth ! This need to be set according to the water depth in HydroDyn + Init%InData_FEAM%WtrDens = Init%OutData_SeaSt%WaveField%WtrDens ! This needs to be set according to seawater density in SeaState +! Init%InData_FEAM%depth = Init%OutData_SeaSt%WaveField%WtrDpth ! This need to be set according to the water depth in SeaState CALL FEAM_Init( Init%InData_FEAM, FEAM%Input(1), FEAM%p, FEAM%x(STATE_CURR), FEAM%xd(STATE_CURR), FEAM%z(STATE_CURR), & FEAM%OtherSt(STATE_CURR), FEAM%y, FEAM%m, p_FAST%dt_module( MODULE_FEAM ), Init%OutData_FEAM, ErrStat2, ErrMsg2 ) @@ -1101,6 +1304,13 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, RETURN END IF + ALLOCATE( IceF%Input_Saved( p_FAST%InterpOrder+1 ), IceF%InputTimes_Saved( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal,"Error allocating IceF%Input_Saved and IceF%InputTimes_Saved.",ErrStat,ErrMsg,RoutineName) + CALL Cleanup() + RETURN + END IF + ! We need this to be allocated (else we have issues passing nonallocated arrays and using the first index of Input(), ! but we don't need the space of IceD_MaxLegs if we're not using it. IF ( p_FAST%CompIce /= Module_IceD ) THEN @@ -1118,10 +1328,17 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, RETURN END IF - ALLOCATE( IceD%x( IceDim,2), & - IceD%xd( IceDim,2), & - IceD%z( IceDim,2), & - IceD%OtherSt( IceDim,2), & + ALLOCATE( IceD%Input_Saved( p_FAST%InterpOrder+1, IceDim ), IceD%InputTimes_Saved( p_FAST%InterpOrder+1, IceDim ), STAT = ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal,"Error allocating IceD%Input_Saved and IceD%InputTimes_Saved.",ErrStat,ErrMsg,RoutineName) + CALL Cleanup() + RETURN + END IF + + ALLOCATE( IceD%x( IceDim,4), & + IceD%xd( IceDim,4), & + IceD%z( IceDim,4), & + IceD%OtherSt( IceDim,4), & IceD%p( IceDim ), & IceD%u( IceDim ), & IceD%y( IceDim ), & @@ -1142,9 +1359,9 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, Init%InData_IceF%InputFile = p_FAST%IceFile Init%InData_IceF%RootName = TRIM(p_FAST%OutFileRoot)//'.'//TRIM(y_FAST%Module_Abrev(Module_IceF)) Init%InData_IceF%simLength = p_FAST%TMax !bjj: IceFloe stores this as single-precision (ReKi) TMax is DbKi - Init%InData_IceF%MSL2SWL = Init%OutData_HD%MSL2SWL + Init%InData_IceF%MSL2SWL = Init%OutData_SeaSt%WaveField%MSL2SWL Init%InData_IceF%gravity = p_FAST%Gravity - + CALL IceFloe_Init( Init%InData_IceF, IceF%Input(1), IceF%p, IceF%x(STATE_CURR), IceF%xd(STATE_CURR), IceF%z(STATE_CURR), & IceF%OtherSt(STATE_CURR), IceF%y, IceF%m, p_FAST%dt_module( MODULE_IceF ), Init%OutData_IceF, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) @@ -1163,9 +1380,9 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, ELSEIF ( p_FAST%CompIce == Module_IceD ) THEN Init%InData_IceD%InputFile = p_FAST%IceFile - Init%InData_IceD%RootName = TRIM(p_FAST%OutFileRoot)//'.'//TRIM(y_FAST%Module_Abrev(Module_IceD))//'1' - Init%InData_IceD%MSL2SWL = Init%OutData_HD%MSL2SWL - Init%InData_IceD%WtrDens = Init%OutData_HD%WtrDens + Init%InData_IceD%RootName = TRIM(p_FAST%OutFileRoot)//'.'//TRIM(y_FAST%Module_Abrev(Module_IceD))//'1' + Init%InData_IceD%MSL2SWL = Init%OutData_SeaSt%WaveField%MSL2SWL + Init%InData_IceD%WtrDens = Init%OutData_SeaSt%WaveField%WtrDens Init%InData_IceD%gravity = p_FAST%Gravity Init%InData_IceD%TMax = p_FAST%TMax Init%InData_IceD%LegNum = 1 @@ -1211,7 +1428,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, ! ........................ - ! initialize ServoDyn + ! initialize ServoDyn ! ........................ ALLOCATE( SrvD%Input( p_FAST%InterpOrder+1 ), SrvD%InputTimes( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -1219,53 +1436,97 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, CALL Cleanup() RETURN END IF - + + ALLOCATE( SrvD%Input_Saved( p_FAST%InterpOrder+1 ), SrvD%InputTimes_Saved( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal,"Error allocating SrvD%Input_Saved and SrvD%InputTimes_Saved.",ErrStat,ErrMsg,RoutineName) + CALL Cleanup() + RETURN + END IF + IF ( p_FAST%CompServo == Module_SrvD ) THEN Init%InData_SrvD%InputFile = p_FAST%ServoFile Init%InData_SrvD%RootName = TRIM(p_FAST%OutFileRoot)//'.'//TRIM(y_FAST%Module_Abrev(Module_SrvD)) - Init%InData_SrvD%NumBl = Init%OutData_ED%NumBl + Init%InData_SrvD%NumBl = NumBl Init%InData_SrvD%Gravity = (/ 0.0_ReKi, 0.0_ReKi, -p_FAST%Gravity /) ! "Gravitational acceleration vector" m/s^2 - Init%InData_SrvD%NacRefPos(1:3) = ED%y%NacelleMotion%Position(1:3,1) - Init%InData_SrvD%NacTransDisp(1:3) = ED%y%NacelleMotion%TranslationDisp(1:3,1) ! R8Ki - Init%InData_SrvD%NacRefOrient(1:3,1:3) = ED%y%NacelleMotion%RefOrientation(1:3,1:3,1) ! R8Ki - Init%InData_SrvD%NacOrient(1:3,1:3) = ED%y%NacelleMotion%Orientation(1:3,1:3,1) ! R8Ki - Init%InData_SrvD%TwrBaseRefPos = Init%OutData_ED%TwrBaseRefPos - Init%InData_SrvD%TwrBaseTransDisp = Init%OutData_ED%TwrBaseTransDisp - Init%InData_SrvD%TwrBaseRefOrient = Init%OutData_ED%TwrBaseRefOrient ! R8Ki - Init%InData_SrvD%TwrBaseOrient = Init%OutData_ED%TwrBaseOrient ! R8Ki - Init%InData_SrvD%PtfmRefPos(1:3) = ED%y%PlatformPtMesh%Position(1:3,1) - Init%InData_SrvD%PtfmTransDisp(1:3) = ED%y%PlatformPtMesh%TranslationDisp(1:3,1) - Init%InData_SrvD%PtfmRefOrient(1:3,1:3)= ED%y%PlatformPtMesh%RefOrientation(1:3,1:3,1) ! R8Ki - Init%InData_SrvD%PtfmOrient(1:3,1:3) = ED%y%PlatformPtMesh%Orientation(1:3,1:3,1) ! R8Ki + + CALL AllocAry(Init%InData_SrvD%BlPitchInit, NumBl, 'BlPitchInit', ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (ErrStat >= abortErrLev) then ! make sure allocatable arrays are valid before setting them + CALL Cleanup() + RETURN + end if + + if (p_FAST%CompElast == Module_SED) then + Init%InData_SrvD%NacRefPos(1:3) = SED%y%NacelleMotion%Position(1:3,1) + Init%InData_SrvD%NacTransDisp(1:3) = SED%y%NacelleMotion%TranslationDisp(1:3,1) ! R8Ki + Init%InData_SrvD%NacRefOrient(1:3,1:3) = SED%y%NacelleMotion%RefOrientation(1:3,1:3,1) ! R8Ki + Init%InData_SrvD%NacOrient(1:3,1:3) = SED%y%NacelleMotion%Orientation(1:3,1:3,1) ! R8Ki + Init%InData_SrvD%TwrBaseRefPos = 0.0_ReKi + Init%InData_SrvD%TwrBaseTransDisp = 0.0_R8Ki + Init%InData_SrvD%TwrBaseRefOrient = 0.0_R8Ki + Init%InData_SrvD%TwrBaseOrient = 0.0_R8Ki + Init%InData_SrvD%PtfmRefPos(1:3) = SED%y%PlatformPtMesh%Position(1:3,1) + Init%InData_SrvD%PtfmTransDisp(1:3) = SED%y%PlatformPtMesh%TranslationDisp(1:3,1) ! R8Ki + Init%InData_SrvD%PtfmRefOrient(1:3,1:3)= SED%y%PlatformPtMesh%RefOrientation(1:3,1:3,1) ! R8Ki + Init%InData_SrvD%PtfmOrient(1:3,1:3) = SED%y%PlatformPtMesh%Orientation(1:3,1:3,1) ! R8Ki + Init%InData_SrvD%RotSpeedRef = Init%OutData_SED%RotSpeed + Init%InData_SrvD%BlPitchInit = Init%OutData_SED%BlPitch + else + Init%InData_SrvD%NacRefPos(1:3) = ED%y%NacelleMotion%Position(1:3,1) + Init%InData_SrvD%NacTransDisp(1:3) = ED%y%NacelleMotion%TranslationDisp(1:3,1) ! R8Ki + Init%InData_SrvD%NacRefOrient(1:3,1:3) = ED%y%NacelleMotion%RefOrientation(1:3,1:3,1) ! R8Ki + Init%InData_SrvD%NacOrient(1:3,1:3) = ED%y%NacelleMotion%Orientation(1:3,1:3,1) ! R8Ki + Init%InData_SrvD%TwrBaseRefPos = Init%OutData_ED%TwrBaseRefPos + Init%InData_SrvD%TwrBaseTransDisp = Init%OutData_ED%TwrBaseTransDisp ! R8Ki + Init%InData_SrvD%TwrBaseRefOrient = Init%OutData_ED%TwrBaseRefOrient ! R8Ki + Init%InData_SrvD%TwrBaseOrient = Init%OutData_ED%TwrBaseOrient ! R8Ki + Init%InData_SrvD%PtfmRefPos(1:3) = ED%y%PlatformPtMesh%Position(1:3,1) + Init%InData_SrvD%PtfmTransDisp(1:3) = ED%y%PlatformPtMesh%TranslationDisp(1:3,1) ! R8Ki + Init%InData_SrvD%PtfmRefOrient(1:3,1:3)= ED%y%PlatformPtMesh%RefOrientation(1:3,1:3,1) ! R8Ki + Init%InData_SrvD%PtfmOrient(1:3,1:3) = ED%y%PlatformPtMesh%Orientation(1:3,1:3,1) ! R8Ki + Init%InData_SrvD%RotSpeedRef = Init%OutData_ED%RotSpeed + Init%InData_SrvD%BlPitchInit = Init%OutData_ED%BlPitch + endif Init%InData_SrvD%TMax = p_FAST%TMax Init%InData_SrvD%AirDens = AirDens Init%InData_SrvD%AvgWindSpeed = Init%OutData_IfW%WindFileInfo%MWS Init%InData_SrvD%Linearize = p_FAST%Linearize Init%InData_SrvD%TrimCase = p_FAST%TrimCase Init%InData_SrvD%TrimGain = p_FAST%TrimGain - Init%InData_SrvD%RotSpeedRef = Init%OutData_ED%RotSpeed Init%InData_SrvD%InterpOrder = p_FAST%InterpOrder - CALL AllocAry( Init%InData_SrvD%BladeRootRefPos, 3, Init%OutData_ED%NumBl, 'Init%InData_SrvD%BladeRootRefPos', errStat2, ErrMsg2) + CALL AllocAry( Init%InData_SrvD%BladeRootRefPos, 3, NumBl, 'Init%InData_SrvD%BladeRootRefPos', errStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - CALL AllocAry( Init%InData_SrvD%BladeRootTransDisp, 3, Init%OutData_ED%NumBl, 'Init%InData_SrvD%BladeRootTransDisp', errStat2, ErrMsg2) + CALL AllocAry( Init%InData_SrvD%BladeRootTransDisp, 3, NumBl, 'Init%InData_SrvD%BladeRootTransDisp', errStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - CALL AllocAry( Init%InData_SrvD%BladeRootRefOrient, 3, 3, Init%OutData_ED%NumBl, 'Init%InData_SrvD%BladeRootRefOrient', errStat2, ErrMsg2) + CALL AllocAry( Init%InData_SrvD%BladeRootRefOrient, 3, 3, NumBl, 'Init%InData_SrvD%BladeRootRefOrient', errStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - CALL AllocAry( Init%InData_SrvD%BladeRootOrient, 3, 3, Init%OutData_ED%NumBl, 'Init%InData_SrvD%BladeRootOrient', errStat2, ErrMsg2) + CALL AllocAry( Init%InData_SrvD%BladeRootOrient, 3, 3, NumBl, 'Init%InData_SrvD%BladeRootOrient', errStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) IF (ErrStat >= AbortErrLev) THEN CALL Cleanup() RETURN END IF - do k=1,Init%OutData_ED%NumBl - Init%InData_SrvD%BladeRootRefPos(:,k) = ED%y%BladeRootMotion(k)%Position(:,1) - Init%InData_SrvD%BladeRootTransDisp(:,k) = ED%y%BladeRootMotion(k)%TranslationDisp(:,1) - Init%InData_SrvD%BladeRootRefOrient(:,:,k)= ED%y%BladeRootMotion(k)%RefOrientation(:,:,1) - Init%InData_SrvD%BladeRootOrient(:,:,k) = ED%y%BladeRootMotion(k)%Orientation(:,:,1) - enddo + ! Set blade root info -- used for Blade StC. Set from SED even though SED is not compatible -- we won't know + ! if the BStC was used until after calling SrvD_Init. + if (p_FAST%CompElast == Module_SED) then + do k=1,NumBl + Init%InData_SrvD%BladeRootRefPos(:,k) = SED%y%BladeRootMotion(k)%Position(:,1) + Init%InData_SrvD%BladeRootTransDisp(:,k) = SED%y%BladeRootMotion(k)%TranslationDisp(:,1) + Init%InData_SrvD%BladeRootRefOrient(:,:,k)= SED%y%BladeRootMotion(k)%RefOrientation(:,:,1) + Init%InData_SrvD%BladeRootOrient(:,:,k) = SED%y%BladeRootMotion(k)%Orientation(:,:,1) + enddo + else + do k=1,NumBl + Init%InData_SrvD%BladeRootRefPos(:,k) = ED%y%BladeRootMotion(k)%Position(:,1) + Init%InData_SrvD%BladeRootTransDisp(:,k) = ED%y%BladeRootMotion(k)%TranslationDisp(:,1) + Init%InData_SrvD%BladeRootRefOrient(:,:,k)= ED%y%BladeRootMotion(k)%RefOrientation(:,:,1) + Init%InData_SrvD%BladeRootOrient(:,:,k) = ED%y%BladeRootMotion(k)%Orientation(:,:,1) + enddo + endif + - IF ( PRESENT(ExternInitData) ) THEN Init%InData_SrvD%NumSC2CtrlGlob = ExternInitData%NumSC2CtrlGlob IF ( (Init%InData_SrvD%NumSC2CtrlGlob > 0) ) THEN @@ -1275,7 +1536,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, CALL Cleanup() RETURN END IF - + do i=1,Init%InData_SrvD%NumSC2CtrlGlob Init%InData_SrvD%fromSCGlob(i) = ExternInitData%fromSCGlob(i) end do @@ -1289,7 +1550,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, CALL Cleanup() RETURN END IF - + do i=1,Init%InData_SrvD%NumSC2Ctrl Init%InData_SrvD%fromSC(i) = ExternInitData%fromSC(i) end do @@ -1301,21 +1562,40 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, Init%InData_SrvD%NumSC2CtrlGlob = 0 Init%InData_SrvD%NumSC2Ctrl = 0 Init%InData_SrvD%NumCtrl2SC = 0 - END IF + END IF + + IF ( p_FAST%CompInflow == Module_IfW ) THEN !assign the number of gates to ServD + if (allocated(IfW%y%lidar%LidSpeed)) then ! make sure we have the array allocated before setting it + CALL AllocAry(Init%InData_SrvD%LidSpeed, size(IfW%y%lidar%LidSpeed), 'Init%InData_SrvD%LidSpeed', errStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + Init%InData_SrvD%LidSpeed = IfW%y%lidar%LidSpeed + endif + if (allocated(IfW%y%lidar%MsrPositionsX)) then ! make sure we have the array allocated before setting it + CALL AllocAry(Init%InData_SrvD%MsrPositionsX, size(IfW%y%lidar%MsrPositionsX), 'Init%InData_SrvD%MsrPositionsX', errStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + Init%InData_SrvD%MsrPositionsX = IfW%y%lidar%MsrPositionsX + endif + if (allocated(IfW%y%lidar%MsrPositionsY)) then ! make sure we have the array allocated before setting it + CALL AllocAry(Init%InData_SrvD%MsrPositionsY, size(IfW%y%lidar%MsrPositionsY), 'Init%InData_SrvD%MsrPositionsY', errStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + Init%InData_SrvD%MsrPositionsY = IfW%y%lidar%MsrPositionsY + endif + if (allocated(IfW%y%lidar%MsrPositionsZ)) then ! make sure we have the array allocated before setting it + CALL AllocAry(Init%InData_SrvD%MsrPositionsZ, size(IfW%y%lidar%MsrPositionsZ), 'Init%InData_SrvD%MsrPositionsZ', errStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + Init%InData_SrvD%MsrPositionsZ = IfW%y%lidar%MsrPositionsZ + endif + Init%InData_SrvD%SensorType = IfW%p%lidar%SensorType + Init%InData_SrvD%NumBeam = IfW%p%lidar%NumBeam + Init%InData_SrvD%NumPulseGate = IfW%p%lidar%NumPulseGate + Init%InData_SrvD%PulseSpacing = IfW%p%lidar%PulseSpacing + END IF + ! Set cable controls inputs (if requested by other modules) -- There is probably a nicer way to do this, but this will work for now. call SetSrvDCableControls() - - - CALL AllocAry(Init%InData_SrvD%BlPitchInit, Init%OutData_ED%NumBl, 'BlPitchInit', ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat >= abortErrLev) then ! make sure allocatable arrays are valid before setting them - CALL Cleanup() - RETURN - end if - Init%InData_SrvD%BlPitchInit = Init%OutData_ED%BlPitch CALL SrvD_Init( Init%InData_SrvD, SrvD%Input(1), SrvD%p, SrvD%x(STATE_CURR), SrvD%xd(STATE_CURR), SrvD%z(STATE_CURR), & SrvD%OtherSt(STATE_CURR), SrvD%y, SrvD%m, p_FAST%dt_module( MODULE_SrvD ), Init%OutData_SrvD, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) @@ -1327,7 +1607,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) !! initialize SrvD%y%ElecPwr and SrvD%y%GenTq because they are one timestep different (used as input for the next step)? - + allocate( y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1), stat=ErrStat2) if (ErrStat2 /= 0 ) then call SetErrStat(ErrID_Fatal, "Error allocating Lin%Modules(SrvD).", ErrStat, ErrMsg, RoutineName ) @@ -1343,31 +1623,31 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, if (allocated(Init%OutData_SrvD%WriteOutputHdr)) y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%NumOutputs = size(Init%OutData_SrvD%WriteOutputHdr) end if - + IF (ErrStat >= AbortErrLev) THEN CALL Cleanup() RETURN END IF - + ! ........................ ! some checks for AeroDyn and ElastoDyn inputs with the high-speed shaft brake hack in ElastoDyn: ! (DO NOT COPY THIS CODE!) - ! ........................ + ! ........................ ! bjj: this is a hack to get high-speed shaft braking in FAST v8 - - IF ( Init%OutData_SrvD%UseHSSBrake ) THEN - IF ( p_FAST%CompAero == Module_AD14 ) THEN - IF ( AD14%p%DYNINFL ) THEN - CALL SetErrStat(ErrID_Fatal,'AeroDyn v14 "DYNINFL" InfModel is invalid for models with high-speed shaft braking.',ErrStat,ErrMsg,RoutineName) - END IF - END IF - + IF ( Init%OutData_SrvD%UseHSSBrake ) THEN IF ( ED%p%method == Method_RK4 ) THEN ! bjj: should be using ElastoDyn's Method_ABM4 Method_AB4 parameters CALL SetErrStat(ErrID_Fatal,'ElastoDyn must use the AB4 or ABM4 integration method to implement high-speed shaft braking.',ErrStat,ErrMsg,RoutineName) ENDIF END IF ! Init%OutData_SrvD%UseHSSBrake + ! SED module is not compatible with structural controls + if (p_FAST%CompElast == Module_SED) then + if (allocated(SrvD%Input(1)%BStCMotionMesh)) call SetErrStat(ErrID_Fatal,'Blade Structural Controls (BStC) from ServoDyn are not compatable with the Simplified-ElastoDyn module (SED).',ErrStat,ErrMsg,RoutineName) + if (allocated(SrvD%Input(1)%NStCMotionMesh)) call SetErrStat(ErrID_Fatal,'Nacelle Structural Controls (NStC) from ServoDyn are not compatable with the Simplified-ElastoDyn module (SED).',ErrStat,ErrMsg,RoutineName) + if (allocated(SrvD%Input(1)%TStCMotionMesh)) call SetErrStat(ErrID_Fatal,'Tower Structural Controls (TStC) from ServoDyn are not compatable with the Simplified-ElastoDyn module (SED).',ErrStat,ErrMsg,RoutineName) + if (allocated(SrvD%Input(1)%SStCMotionMesh)) call SetErrStat(ErrID_Fatal,'Substructure Structural Controls (SStC) from ServoDyn are not compatable with the Simplified-ElastoDyn module (SED).',ErrStat,ErrMsg,RoutineName) + endif END IF @@ -1384,7 +1664,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, ! Initialize mesh-mapping data ! ------------------------------------------------------------------------- - CALL InitModuleMappings(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2) + CALL InitModuleMappings(p_FAST, ED, SED, BD, AD, ADsk, ExtLd, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) IF (ErrStat >= AbortErrLev) THEN @@ -1398,22 +1678,30 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, END IF ! ------------------------------------------------------------------------- - ! Initialize for linearization: + ! Initialize for linearization or computing aero maps: ! ------------------------------------------------------------------------- - if ( p_FAST%Linearize ) then - ! NOTE: In the following call, we use Init%OutData_AD%BladeProps(1)%NumBlNds as the number of aero nodes on EACH blade, which + if ( p_FAST%Linearize .or. p_FAST%CompAeroMaps) then + ! NOTE: In the following call, we use Init%OutData_AD%BladeProps(1)%NumBlNds as the number of aero nodes on EACH blade, which ! is consistent with the current AD implementation, but if AD changes this, then it must be handled here, too! if (p_FAST%CompAero == MODULE_AD) then - call Init_Lin(p_FAST, y_FAST, m_FAST, AD, ED, NumBl, Init%OutData_AD%rotors(1)%BladeProps(1)%NumBlNds, ErrStat2, ErrMsg2) + call Init_Lin(p_FAST, y_FAST, m_FAST, AD, ED, NumBl, Init%OutData_AD%rotors(1)%BladeProps(1)%NumBlNds, ErrStat2, ErrMsg2) else - call Init_Lin(p_FAST, y_FAST, m_FAST, AD, ED, NumBl, -1, ErrStat2, ErrMsg2) - endif + call Init_Lin(p_FAST, y_FAST, m_FAST, AD, ED, NumBl, -1, ErrStat2, ErrMsg2) + endif call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat >= AbortErrLev) then call Cleanup() return end if + + if (p_FAST%CompAeroMaps) then + p_FAST%SizeJac_Opt1(1) = y_FAST%Lin%Glue%SizeLin(LIN_ContSTATE_COL) + y_FAST%Lin%Glue%SizeLin(LIN_INPUT_COL) + p_FAST%TolerSquared = p_FAST%TolerSquared * (p_FAST%SizeJac_Opt1(1)**2) ! do this calculation here so we don't have to keep dividing by the size of the array later + p_FAST%NumBl_Lin = 1 + else + p_FAST%NumBl_Lin = NumBl + end if + end if @@ -1421,7 +1709,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, ! Initialize data for VTK output ! ------------------------------------------------------------------------- if ( p_FAST%WrVTK > VTK_None ) then - call SetVTKParameters(p_FAST, Init%OutData_ED, Init%OutData_AD, Init%InData_HD, Init%OutData_HD, ED, BD, AD, HD, ErrStat2, ErrMsg2) + call SetVTKParameters(p_FAST, Init%OutData_ED, Init%OutData_SED, Init%OutData_AD, Init%OutData_SeaSt, Init%OutData_HD, ED, SED, BD, AD, HD, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) end if @@ -1486,7 +1774,9 @@ SUBROUTINE Cleanup() !............................................................................................................................... ! Destroy initializion data !............................................................................................................................... - CALL FAST_DestroyInitData( Init, ErrStat2, ErrMsg2 ) + ! We assume that all initializion data points to parameter data, so we just nullify the pointers instead of deallocate + ! data that they point to: + CALL FAST_DestroyInitData( Init, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) END SUBROUTINE Cleanup @@ -1594,9 +1884,18 @@ END SUBROUTINE FAST_InitializeAll SUBROUTINE FAST_ProgStart(ThisProgVer) TYPE(ProgDesc), INTENT(IN) :: ThisProgVer !< program name/date/version description + + TYPE(ProgDesc) :: NewProgVer !< program name/date/version description + + NewProgVer = ThisProgVer + if (LEN_TRIM(ProgName)>0) then ! add this for steady-state solver + NewProgVer%Name = ProgName + end if + + ! ... Initialize NWTC Library ! sets the pi constants, open console for output, etc... - CALL NWTC_Init( ProgNameIN=ThisProgVer%Name, EchoLibVer=.FALSE. ) + CALL NWTC_Init( ProgNameIN=NewProgVer%Name, EchoLibVer=.FALSE. ) ! Display the copyright notice and compile info: CALL DispCopyrightLicense( ThisProgVer%Name ) @@ -1614,13 +1913,14 @@ SUBROUTINE GetInputFileName(InputFile,UseDWM,ErrStat,ErrMsg) INTEGER(IntKi) :: ErrStat2 ! local error stat CHARACTER(1024) :: LastArg ! A second command-line argument that will allow DWM module to be used in AeroDyn + CHARACTER(1024) :: Flag ! Put this here in case we are calling steady-state solver (so it doesn't error out about the flag) ErrStat = ErrID_None ErrMsg = '' UseDWM = .FALSE. ! by default, we're not going to use the DWM module InputFile = "" ! initialize to empty string to make sure it's input from the command line - CALL CheckArgs( InputFile, ErrStat2, LastArg ) ! if ErrStat2 /= ErrID_None, we'll ignore and deal with the problem when we try to read the input file + CALL CheckArgs( InputFile, ErrStat2, LastArg, Flag ) ! if ErrStat2 /= ErrID_None, we'll ignore and deal with the problem when we try to read the input file IF (LEN_TRIM(InputFile) == 0) THEN ! no input file was specified ErrStat = ErrID_Fatal @@ -1639,7 +1939,7 @@ END SUBROUTINE GetInputFileName !---------------------------------------------------------------------------------------------------------------------------------- !> This subroutine checks for command-line arguments, gets the root name of the input files !! (including full path name), and creates the names of the output files. -SUBROUTINE FAST_Init( p, m_FAST, y_FAST, t_initial, InputFile, ErrStat, ErrMsg, TMax, TurbID, OverrideAbortLev, RootName ) +SUBROUTINE FAST_Init( p, m_FAST, y_FAST, t_initial, InputFile, ErrStat, ErrMsg, TMax, TurbID, OverrideAbortLev, RootName, DTdriver ) IMPLICIT NONE @@ -1656,6 +1956,8 @@ SUBROUTINE FAST_Init( p, m_FAST, y_FAST, t_initial, InputFile, ErrStat, ErrMsg, INTEGER(IntKi), INTENT(IN), OPTIONAL :: TurbID !< an ID for naming the tubine output file LOGICAL, INTENT(IN), OPTIONAL :: OverrideAbortLev !< whether or not we should override the abort error level (e.g., FAST.Farm) CHARACTER(*), INTENT(IN), OPTIONAL :: RootName !< A CHARACTER string containing the root name of FAST output files, overriding normal naming convention + REAL(DbKi), INTENT(IN), OPTIONAL :: DTdriver !< Driver program time step + ! Local variables INTEGER :: i ! loop counter @@ -1705,18 +2007,21 @@ SUBROUTINE FAST_Init( p, m_FAST, y_FAST, t_initial, InputFile, ErrStat, ErrMsg, !............................................................................................................................... y_FAST%Module_Ver( Module_Glue ) = FAST_Ver - + DO i=2,NumModules y_FAST%Module_Ver(i)%Date = 'unknown date' y_FAST%Module_Ver(i)%Ver = 'unknown version' END DO y_FAST%Module_Ver( Module_IfW )%Name = 'InflowWind' - y_FAST%Module_Ver( Module_OpFM )%Name = 'OpenFOAM integration' + y_FAST%Module_Ver( Module_ExtInfw)%Name = 'ExternalInflow integration' y_FAST%Module_Ver( Module_ED )%Name = 'ElastoDyn' + y_FAST%Module_Ver( Module_SED )%Name = 'Simplified-ElastoDyn' y_FAST%Module_Ver( Module_BD )%Name = 'BeamDyn' - y_FAST%Module_Ver( Module_AD14 )%Name = 'AeroDyn14' y_FAST%Module_Ver( Module_AD )%Name = 'AeroDyn' + y_FAST%Module_Ver( Module_ADsk )%Name = 'AeroDisk' + y_FAST%Module_Ver( Module_ExtLd )%Name = 'ExtLoads' y_FAST%Module_Ver( Module_SrvD )%Name = 'ServoDyn' + y_FAST%Module_Ver( Module_SeaSt )%Name = 'SeaState' y_FAST%Module_Ver( Module_HD )%Name = 'HydroDyn' y_FAST%Module_Ver( Module_SD )%Name = 'SubDyn' y_FAST%Module_Ver( Module_ExtPtfm)%Name = 'ExtPtfm_MCKF' @@ -1726,15 +2031,18 @@ SUBROUTINE FAST_Init( p, m_FAST, y_FAST, t_initial, InputFile, ErrStat, ErrMsg, y_FAST%Module_Ver( Module_Orca )%Name = 'OrcaFlexInterface' y_FAST%Module_Ver( Module_IceF )%Name = 'IceFloe' y_FAST%Module_Ver( Module_IceD )%Name = 'IceDyn' - + y_FAST%Module_Abrev( Module_Glue ) = 'FAST' y_FAST%Module_Abrev( Module_IfW ) = 'IfW' - y_FAST%Module_Abrev( Module_OpFM ) = 'OpFM' + y_FAST%Module_Abrev( Module_ExtInfw) = 'ExtInfw' y_FAST%Module_Abrev( Module_ED ) = 'ED' + y_FAST%Module_Abrev( Module_SED ) = 'SED' y_FAST%Module_Abrev( Module_BD ) = 'BD' - y_FAST%Module_Abrev( Module_AD14 ) = 'AD' y_FAST%Module_Abrev( Module_AD ) = 'AD' + y_FAST%Module_Abrev( Module_ADsk ) = 'ADsk' + y_FAST%Module_Abrev( Module_ExtLd ) = 'ExtLd' y_FAST%Module_Abrev( Module_SrvD ) = 'SrvD' + y_FAST%Module_Abrev( Module_SeaSt ) = 'SEA' y_FAST%Module_Abrev( Module_HD ) = 'HD' y_FAST%Module_Abrev( Module_SD ) = 'SD' y_FAST%Module_Abrev( Module_ExtPtfm) = 'ExtPtfm' @@ -1751,8 +2059,14 @@ SUBROUTINE FAST_Init( p, m_FAST, y_FAST, t_initial, InputFile, ErrStat, ErrMsg, !............................................................................................................................... ! Read the primary file for the glue code: !............................................................................................................................... - CALL FAST_ReadPrimaryFile( InputFile, p, m_FAST, OverrideAbortErrLev, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + IF (p%CompAeroMaps) THEN + CALL FAST_ReadSteadyStateFile( InputFile, p, m_FAST, ErrStat2, ErrMsg2 ) + ELSE + p%KMax = 1 ! after more checking, we may put this in the input file... + p%tolerSquared = 1 ! not used for time-marching simulation + CALL FAST_ReadPrimaryFile( InputFile, p, m_FAST, OverrideAbortErrLev, ErrStat2, ErrMsg2 ) + END IF + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ! make sure some linearization variables are consistant if (.not. p%Linearize) p%CalcSteady = .false. @@ -1766,10 +2080,20 @@ SUBROUTINE FAST_Init( p, m_FAST, y_FAST, t_initial, InputFile, ErrStat, ErrMsg, !p%TMax = MAX( TMax, p%TMax ) END IF + IF (PRESENT(DTdriver)) THEN + IF (DTdriver == -1.0_DbKi) THEN + ! DTdriver wasn't set, so don't use it + ELSE IF ( ABS( NINT(DTdriver/p%DT) * p%DT - DTdriver ) .lt. 0.001 ) THEN + p%DT_Out = NINT(DTdriver/p%DT) * p%DT + p%n_DT_Out = NINT(DTdriver/p%DT) + ELSE + CALL SetErrStat( ErrID_Fatal, 'DTdriver specified '//TRIM ( Num2LStr( DTdriver ) )//' is not an integral multiple of FAST time step '//TRIM ( Num2LStr( p%DT ) ), ErrStat, ErrMsg, RoutineName ) + END IF + END IF + IF ( ErrStat >= AbortErrLev ) RETURN - p%KMax = 1 ! after more checking, we may put this in the input file... !IF (p%CompIce == Module_IceF) p%KMax = 2 p%SizeJac_Opt1 = 0 ! initialize this vector to zero; after we figure out what size the ED/SD/HD/BD meshes are, we'll fill this @@ -1777,34 +2101,21 @@ SUBROUTINE FAST_Init( p, m_FAST, y_FAST, t_initial, InputFile, ErrStat, ErrMsg, p%nBeams = 0 ! initialize number of BeamDyn instances (will be set later) - ! determine what kind of turbine we're modeling: - IF ( p%CompHydro == Module_HD .and. p%MHK == 0) THEN - IF ( p%CompSub == Module_SD ) THEN - p%TurbineType = Type_Offshore_Fixed - ELSE - p%TurbineType = Type_Offshore_Floating - END IF - ELSEIF ( p%CompMooring == Module_Orca .and. p%MHK == 0) THEN - p%TurbineType = Type_Offshore_Floating - ELSEIF ( p%CompSub == Module_ExtPtfm .and. p%MHK == 0) THEN - p%TurbineType = Type_Offshore_Fixed - ELSEIF ( p%MHK == 1 ) THEN - p%TurbineType = Type_MHK_Fixed - ELSEIF ( p%MHK == 2 ) THEN - p%TurbineType = Type_MHK_Floating - ELSE - p%TurbineType = Type_LandBased - END IF - - p%n_TMax_m1 = CEILING( ( (p%TMax - t_initial) / p%DT ) ) - 1 ! We're going to go from step 0 to n_TMax (thus the -1 here) - if (p%TMax < 1.0_DbKi) then ! log10(0) gives floating point divide-by-zero error + + if (p%CompAeroMaps) then p%TChanLen = MinChanLen + p%OutFmt_t = 'F'//trim(num2lstr( p%TChanLen ))//'.0' ! 'F10.0' else - p%TChanLen = max( MinChanLen, int(log10(p%TMax))+7 ) + if (p%TMax < 1.0_DbKi) then !log10(0) is undefined (gives floating point divide-by-zero error) + p%TChanLen = MinChanLen + else + p%TChanLen = max( MinChanLen, int(log10(p%TMax))+7 ) + end if + p%OutFmt_t = 'F'//trim(num2lstr( p%TChanLen ))//'.4' ! 'F10.4' end if - p%OutFmt_t = 'F'//trim(num2lstr( p%TChanLen ))//'.4' ! 'F10.4' + !............................................................................................................................... ! Do some error checking on the inputs (validation): @@ -1813,7 +2124,6 @@ SUBROUTINE FAST_Init( p, m_FAST, y_FAST, t_initial, InputFile, ErrStat, ErrMsg, CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) RETURN @@ -1860,6 +2170,14 @@ SUBROUTINE ValidateInputData(p, m_FAST, ErrStat, ErrMsg) END IF END IF + IF (p%tolerSquared < EPSILON(p%tolerSquared)) THEN + CALL SetErrStat( ErrID_Fatal, 'Toler must be larger than sqrt(epsilon).', ErrStat, ErrMsg, RoutineName ) + END IF + + IF (p%KMax < 1) THEN + CALL SetErrStat( ErrID_Fatal, 'MaxIter must be at least 1.', ErrStat, ErrMsg, RoutineName ) + END IF + ! Check that InputFileData%OutFmt is a valid format specifier and will fit over the column headings CALL ChkRealFmtStr( p%OutFmt, 'OutFmt', p%FmtWidth, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1879,12 +2197,19 @@ SUBROUTINE ValidateInputData(p, m_FAST, ErrStat, ErrMsg) IF ( p%KMax < 1_IntKi ) CALL SetErrStat( ErrID_Fatal, 'KMax must be greater than 0.', ErrStat, ErrMsg, RoutineName ) IF (p%CompElast == Module_Unknown) CALL SetErrStat( ErrID_Fatal, 'CompElast must be 1 (ElastoDyn) or 2 (BeamDyn).', ErrStat, ErrMsg, RoutineName ) - IF (p%CompAero == Module_Unknown) CALL SetErrStat( ErrID_Fatal, 'CompAero must be 0 (None), 1 (AeroDyn14), or 2 (AeroDyn).', ErrStat, ErrMsg, RoutineName ) + IF (p%CompAero == Module_Unknown) CALL SetErrStat( ErrID_Fatal, 'CompAero must be 0 (None), 1 (AeroDisk), 2 (AeroDyn), or 3 (ExtLoads).', ErrStat, ErrMsg, RoutineName ) IF (p%CompServo == Module_Unknown) CALL SetErrStat( ErrID_Fatal, 'CompServo must be 0 (None) or 1 (ServoDyn).', ErrStat, ErrMsg, RoutineName ) + IF (p%CompSeaSt == Module_Unknown) CALL SetErrStat( ErrID_Fatal, 'CompSeaSt must be 0 (None) or 1 (SeaState).', ErrStat, ErrMsg, RoutineName ) IF (p%CompHydro == Module_Unknown) CALL SetErrStat( ErrID_Fatal, 'CompHydro must be 0 (None) or 1 (HydroDyn).', ErrStat, ErrMsg, RoutineName ) IF (p%CompSub == Module_Unknown) CALL SetErrStat( ErrID_Fatal, 'CompSub must be 0 (None), 1 (SubDyn), or 2 (ExtPtfm_MCKF).', ErrStat, ErrMsg, RoutineName ) IF (p%CompMooring == Module_Unknown) CALL SetErrStat( ErrID_Fatal, 'CompMooring must be 0 (None), 1 (MAP), 2 (FEAMooring), 3 (MoorDyn), or 4 (OrcaFlex).', ErrStat, ErrMsg, RoutineName ) IF (p%CompIce == Module_Unknown) CALL SetErrStat( ErrID_Fatal, 'CompIce must be 0 (None) or 1 (IceFloe).', ErrStat, ErrMsg, RoutineName ) + + ! NOTE: If future modules consume SeaState data, then their checks should be added to this routine. 12/1/21 GJH + if (p%CompHydro == Module_HD .and. p%CompSeaSt == Module_None) then + CALL SetErrStat( ErrID_Fatal, 'SeaState must be used when HydroDyn is used. Set CompSeaSt = 1 in the FAST input file.', ErrStat, ErrMsg, RoutineName ) + end if + IF (p%CompHydro /= Module_HD) THEN IF (p%CompMooring == Module_MAP) THEN CALL SetErrStat( ErrID_Fatal, 'HydroDyn must be used when MAP is used. Set CompHydro > 0 or CompMooring = 0 in the FAST input file.', ErrStat, ErrMsg, RoutineName ) @@ -1898,23 +2223,39 @@ SUBROUTINE ValidateInputData(p, m_FAST, ErrStat, ErrMsg) IF (p%CompSub == Module_ExtPtfm) CALL SetErrStat( ErrID_Fatal, 'HydroDyn cannot be used if ExtPtfm_MCKF is used. Set CompHydro = 0 or CompSub < 2 in the FAST input file.', ErrStat, ErrMsg, RoutineName ) END IF + ! SED cannot be used with certain modules + if (p%CompElast == Module_SED) then + if (p%CompSub == Module_SD) call SetErrStat( ErrID_Fatal, 'Simplified-ElastoDyn (SED) cannot be used with SubDyn. Set CompSub == 0 or CompElast /= 3 in the FAST input file.', ErrStat, ErrMsg, RoutineName ) + if (p%CompHydro == Module_HD) call SetErrStat( ErrID_Fatal, 'Simplified-ElastoDyn (SED) cannot be used with HydroDyn. Set CompHydro == 0 or CompElast /= 3 in the FAST input file.', ErrStat, ErrMsg, RoutineName ) + if (p%CompIce /= Module_None) call SetErrStat( ErrID_Fatal, 'Simplified-ElastoDyn (SED) cannot be used with any ice modules. Set CompIce == 0 or CompElast /= 3 in the FAST input file.', ErrStat, ErrMsg, RoutineName ) + if (p%CompMooring /= Module_None) call SetErrStat( ErrID_Fatal, 'Simplified-ElastoDyn (SED) cannot be used with any mooring modules. Set CompMooring == 0 or CompElast /= 3 in the FAST input file.', ErrStat, ErrMsg, RoutineName ) + if (p%MHK == 1 .or. p%MHK == 2) call SetErrStat( ErrID_Fatal, 'Simplified-ElastoDyn (SED) cannot be used with an MHK turbine. Set MHK == 0 or CompElast /= 3 in the FAST input file.', ErrStat, ErrMsg, RoutineName ) + if (p%CompInflow == Module_ExtInfw) call SetErrStat( ErrID_Fatal, 'Simplified-ElastoDyn (SED) cannot be used with ExtInfw. Set CompInflow /= 2 or CompElast /= 3 in the FAST input file.', ErrStat, ErrMsg, RoutineName ) + endif + + IF (p%CompMooring == Module_Orca .and. p%CompSub /= Module_None) CALL SetErrStat( ErrID_Fatal, 'SubDyn and ExtPtfm cannot be used if OrcaFlex is used. Set CompSub = 0 or CompMooring < 4 in the FAST input file.', ErrStat, ErrMsg, RoutineName ) + IF (p%CompIce == Module_IceF) THEN - IF (p%CompSub /= Module_SD) CALL SetErrStat( ErrID_Fatal, 'SubDyn must be used when IceFloe is used. Set CompSub > 0 or CompIce = 0 in the FAST input file.', ErrStat, ErrMsg, RoutineName ) + IF (p%CompSub /= Module_SD) CALL SetErrStat( ErrID_Fatal, 'SubDyn must be used when IceFloe is used. Set CompSub = 1 or CompIce = 0 in the FAST input file.', ErrStat, ErrMsg, RoutineName ) IF (p%CompHydro /= Module_HD) CALL SetErrStat( ErrID_Fatal, 'HydroDyn must be used when IceFloe is used. Set CompHydro > 0 or CompIce = 0 in the FAST input file.', ErrStat, ErrMsg, RoutineName ) ELSEIF (p%CompIce == Module_IceD) THEN - IF (p%CompSub /= Module_SD) CALL SetErrStat( ErrID_Fatal, 'SubDyn must be used when IceDyn is used. Set CompSub > 0 or CompIce = 0 in the FAST input file.', ErrStat, ErrMsg, RoutineName ) + IF (p%CompSub /= Module_SD) CALL SetErrStat( ErrID_Fatal, 'SubDyn must be used when IceDyn is used. Set CompSub = 1 or CompIce = 0 in the FAST input file.', ErrStat, ErrMsg, RoutineName ) IF (p%CompHydro /= Module_HD) CALL SetErrStat( ErrID_Fatal, 'HydroDyn must be used when IceDyn is used. Set CompHydro > 0 or CompIce = 0 in the FAST input file.', ErrStat, ErrMsg, RoutineName ) END IF - IF (p%CompElast == Module_BD .and. p%CompAero == Module_AD14 ) CALL SetErrStat( ErrID_Fatal, 'AeroDyn14 cannot be used when BeamDyn is used. Change CompAero or CompElast in the FAST input file.', ErrStat, ErrMsg, RoutineName ) - if (p%CompInflow == MODULE_OpFM .and. p%CompAero == Module_AD14 ) CALL SetErrStat( ErrID_Fatal, 'AeroDyn14 cannot be used when OpenFOAM is used. Change CompAero or CompInflow in the FAST input file.', ErrStat, ErrMsg, RoutineName ) - - IF (p%MHK /= 0 .and. p%MHK /= 1 .and. p%MHK /= 2) CALL SetErrStat( ErrID_Fatal, 'MHK switch is invalid. Set MHK to 0, 1, or 2 in the FAST input file.', ErrStat, ErrMsg, RoutineName ) + IF (p%CompElast == Module_BD .and. p%CompAero == Module_ADsk) CALL SetErrStat( ErrID_Fatal, 'AeroDisk cannot be used when BeamDyn is used. Change CompAero or CompElast in the FAST input file.', ErrStat, ErrMsg, RoutineName ) + + ! No method at the moment for getting disk average velocity from ExtInfw + if (p%CompAero == Module_ADsk .and. p%CompInflow == MODULE_ExtInfw) call SetErrStat( ErrID_Fatal, 'AeroDisk cannot be used with ExtInflow or the library interface', ErrStat, ErrMsg, RoutineName ) + + if ((p%CompAero == Module_ExtLd) .and. (p%CompInflow /= Module_IfW) ) call SetErrStat(ErrID_Fatal, 'Inflow module must be used when ExtLoads is used. Change CompAero or CompInflow in the OpenFAST input file.', ErrStat, ErrMsg, RoutineName) - IF (p%MHK == 1 .and. p%CompAero == Module_AD14 .or. p%MHK == 2 .and. p%CompAero == Module_AD14) CALL SetErrStat( ErrID_Fatal, 'AeroDyn14 cannot be used with an MHK turbine. Change CompAero or MHK in the FAST input file.', ErrStat, ErrMsg, RoutineName ) + IF (p%CompAero == Module_ADsk .and. p%MHK /= MHK_None) CALL SetErrStat( ErrID_Fatal, 'AeroDisk cannot be used with an MHK turbine. Change CompAero or MHK in the FAST input file.', ErrStat, ErrMsg, RoutineName ) - IF (p%MHK == 1 .and. p%Linearize .or. p%MHK == 2 .and. p%Linearize) CALL SetErrStat( ErrID_Fatal, 'Linearization has not yet been implemented for an MHK turbine. Change MHK or Linearize in the FAST input file.', ErrStat, ErrMsg, RoutineName ) + IF (p%MHK /= MHK_None .and. p%MHK /= MHK_FixedBottom .and. p%MHK /= MHK_Floating) CALL SetErrStat( ErrID_Fatal, 'MHK switch is invalid. Set MHK to 0, 1, or 2 in the FAST input file.', ErrStat, ErrMsg, RoutineName ) + + IF (p%MHK /= MHK_None .and. p%Linearize) CALL SetErrStat( ErrID_Warn, 'Linearization is not fully implemented for an MHK turbine (buoyancy not included in perturbations, and added mass not included anywhere).', ErrStat, ErrMsg, RoutineName ) IF (p%Gravity < 0.0_ReKi) CALL SetErrStat( ErrID_Fatal, 'Gravity must not be negative.', ErrStat, ErrMsg, RoutineName ) @@ -1922,7 +2263,7 @@ SUBROUTINE ValidateInputData(p, m_FAST, ErrStat, ErrMsg) ! IF ( p%InterpOrder < 0 .OR. p%InterpOrder > 2 ) THEN IF ( p%InterpOrder < 1 .OR. p%InterpOrder > 2 ) THEN - CALL SetErrStat( ErrID_Fatal, 'InterpOrder must be 1 or 2.', ErrStat, ErrMsg, RoutineName ) ! 5/13/14 bjj: MAS and JMJ compromise for certain integrators is that InterpOrder cannot be 0 + if (.not. p%CompAeroMaps) CALL SetErrStat( ErrID_Fatal, 'InterpOrder must be 1 or 2.', ErrStat, ErrMsg, RoutineName ) ! 5/13/14 bjj: MAS and JMJ compromise for certain integrators is that InterpOrder cannot be 0 p%InterpOrder = 1 ! Avoid problems in error handling by setting this to 0 END IF @@ -1983,19 +2324,13 @@ SUBROUTINE ValidateInputData(p, m_FAST, ErrStat, ErrMsg) end if ! now, make sure we haven't asked for any modules that we can't yet linearize: - if (p%CompInflow == MODULE_OpFM) call SetErrStat(ErrID_Fatal,'Linearization is not implemented for the OpenFOAM coupling.',ErrStat, ErrMsg, RoutineName) - if (p%CompAero == MODULE_AD14) call SetErrStat(ErrID_Fatal,'Linearization is not implemented for the AeroDyn v14 module.',ErrStat, ErrMsg, RoutineName) - !if (p%CompSub == MODULE_SD) call SetErrStat(ErrID_Fatal,'Linearization is not implemented for the SubDyn module.',ErrStat, ErrMsg, RoutineName) + if (p%CompAero == MODULE_ADsk) call SetErrStat(ErrID_Fatal,'Linearization is not implemented for the AeroDisk module.',ErrStat, ErrMsg, RoutineName) + if (p%CompInflow == MODULE_ExtInfw) call SetErrStat(ErrID_Fatal,'Linearization is not implemented for the ExternalInflow coupling.',ErrStat, ErrMsg, RoutineName) if (p%CompSub /= MODULE_None .and. p%CompSub /= MODULE_SD ) call SetErrStat(ErrID_Fatal,'Linearization is not implemented for the ExtPtfm_MCKF substructure module.',ErrStat, ErrMsg, RoutineName) if (p%CompMooring /= MODULE_None .and. p%CompMooring == MODULE_FEAM) call SetErrStat(ErrID_Fatal,'Linearization is not implemented for the FEAMooring mooring module.',ErrStat, ErrMsg, RoutineName) if (p%CompIce /= MODULE_None) call SetErrStat(ErrID_Fatal,'Linearization is not implemented for any of the ice loading modules.',ErrStat, ErrMsg, RoutineName) end if - - - if ( (p%TurbineType == Type_Offshore_Fixed .or. p%TurbineType == Type_Offshore_Floating) .and. .not. EqualRealNos(p%TurbinePos(3), 0.0_SiKi) ) then - call SetErrStat(ErrID_Fatal, 'Height of turbine location, TurbinePos(3), must be 0 for offshore turbines.', ErrStat, ErrMsg, RoutineName) - end if !............................................................................................................................... @@ -2009,7 +2344,26 @@ SUBROUTINE ValidateInputData(p, m_FAST, ErrStat, ErrMsg) END IF END IF + if (p%CompAeroMaps) then + if (p%NumSSCases < 0) then + CALL SetErrStat( ErrID_Fatal, 'NumSSCases must be at least 1 to compute steady-state solve.', ErrStat, ErrMsg, RoutineName ) + else + do i=1,p%NumSSCases + if (p%RotSpeed(i) < 0.0_ReKi) then + CALL SetErrStat( ErrID_Fatal, 'RotSpeed must be positive for the steady-state solver.', ErrStat, ErrMsg, RoutineName ) + end if + end do + + do i=1,p%NumSSCases + if (p%WS_TSR(i) < EPSILON(p%WS_TSR(1))) then + CALL SetErrStat( ErrID_Fatal, 'WindSpeed and TSR must be positive numbers for the steady-state solver.', ErrStat, ErrMsg, RoutineName ) ! at least, they can't be zero! + end if + end do + + end if + + end if END SUBROUTINE ValidateInputData !---------------------------------------------------------------------------------------------------------------------------------- @@ -2047,8 +2401,13 @@ SUBROUTINE FAST_InitOutput( p_FAST, y_FAST, Init, ErrStat, ErrMsg ) ! and save the module version info for later use, too: !...................................................... - y_FAST%Module_Ver( Module_ED ) = Init%OutData_ED%Ver - y_FAST%FileDescLines(2) = TRIM(y_FAST%FileDescLines(2) ) //'; '//TRIM(GetNVD(y_FAST%Module_Ver( Module_ED ) )) + IF ( p_FAST%CompElast == Module_SED ) THEN + y_FAST%Module_Ver( Module_SED ) = Init%OutData_SED%Ver + y_FAST%FileDescLines(2) = TRIM(y_FAST%FileDescLines(2) ) //'; '//TRIM(GetNVD(y_FAST%Module_Ver( Module_SED ) )) + ELSE + y_FAST%Module_Ver( Module_ED ) = Init%OutData_ED%Ver + y_FAST%FileDescLines(2) = TRIM(y_FAST%FileDescLines(2) ) //'; '//TRIM(GetNVD(y_FAST%Module_Ver( Module_ED ) )) + END IF IF ( p_FAST%CompElast == Module_BD ) THEN y_FAST%Module_Ver( Module_BD ) = Init%OutData_BD(1)%Ver ! call copy routine for this type if it every uses dynamic memory @@ -2059,17 +2418,17 @@ SUBROUTINE FAST_InitOutput( p_FAST, y_FAST, Init, ErrStat, ErrMsg ) IF ( p_FAST%CompInflow == Module_IfW ) THEN y_FAST%Module_Ver( Module_IfW ) = Init%OutData_IfW%Ver ! call copy routine for this type if it every uses dynamic memory y_FAST%FileDescLines(2) = TRIM(y_FAST%FileDescLines(2) ) //'; '//TRIM(GetNVD(y_FAST%Module_Ver( Module_IfW ))) - ELSEIF ( p_FAST%CompInflow == Module_OpFM ) THEN - y_FAST%Module_Ver( Module_OpFM ) = Init%OutData_OpFM%Ver ! call copy routine for this type if it every uses dynamic memory - y_FAST%FileDescLines(2) = TRIM(y_FAST%FileDescLines(2) ) //'; '//TRIM(GetNVD(y_FAST%Module_Ver( Module_OpFM ))) + ELSEIF ( p_FAST%CompInflow == Module_ExtInfw ) THEN + y_FAST%Module_Ver( Module_ExtInfw ) = Init%OutData_ExtInfw%Ver ! call copy routine for this type if it every uses dynamic memory + y_FAST%FileDescLines(2) = TRIM(y_FAST%FileDescLines(2) ) //'; '//TRIM(GetNVD(y_FAST%Module_Ver( Module_ExtInfw ))) END IF - IF ( p_FAST%CompAero == Module_AD14 ) THEN - y_FAST%Module_Ver( Module_AD14 ) = Init%OutData_AD14%Ver - y_FAST%FileDescLines(2) = TRIM(y_FAST%FileDescLines(2) ) //'; '//TRIM(GetNVD(y_FAST%Module_Ver( Module_AD14 ) )) - ELSEIF ( p_FAST%CompAero == Module_AD ) THEN + IF ( p_FAST%CompAero == Module_AD .OR. p_FAST%CompAero == Module_ExtLd) THEN y_FAST%Module_Ver( Module_AD ) = Init%OutData_AD%Ver y_FAST%FileDescLines(2) = TRIM(y_FAST%FileDescLines(2) ) //'; '//TRIM(GetNVD(y_FAST%Module_Ver( Module_AD ) )) + ELSEIF ( p_FAST%CompAero == Module_ADsk ) THEN + y_FAST%Module_Ver( Module_ADsk ) = Init%OutData_ADsk%Ver + y_FAST%FileDescLines(2) = TRIM(y_FAST%FileDescLines(2) ) //'; '//TRIM(GetNVD(y_FAST%Module_Ver( Module_ADsk ) )) END IF IF ( p_FAST%CompServo == Module_SrvD ) THEN @@ -2077,6 +2436,11 @@ SUBROUTINE FAST_InitOutput( p_FAST, y_FAST, Init, ErrStat, ErrMsg ) y_FAST%FileDescLines(2) = TRIM(y_FAST%FileDescLines(2) ) //'; '//TRIM(GetNVD(y_FAST%Module_Ver( Module_SrvD ))) END IF + IF ( p_FAST%CompSeaSt == Module_SeaSt ) THEN + y_FAST%Module_Ver( Module_SeaSt ) = Init%OutData_SeaSt%Ver + y_FAST%FileDescLines(2) = TRIM(y_FAST%FileDescLines(2) ) //'; '//TRIM(GetNVD(y_FAST%Module_Ver( Module_SeaSt ))) + END IF + IF ( p_FAST%CompHydro == Module_HD ) THEN y_FAST%Module_Ver( Module_HD ) = Init%OutData_HD%Ver y_FAST%FileDescLines(2) = TRIM(y_FAST%FileDescLines(2) ) //'; '//TRIM(GetNVD(y_FAST%Module_Ver( Module_HD ))) @@ -2116,20 +2480,21 @@ SUBROUTINE FAST_InitOutput( p_FAST, y_FAST, Init, ErrStat, ErrMsg ) ! Set the number of output columns from each module !...................................................... y_FAST%numOuts = 0 ! Inintialize entire array - + IF ( ALLOCATED( Init%OutData_IfW%WriteOutputHdr ) ) y_FAST%numOuts(Module_IfW) = SIZE(Init%OutData_IfW%WriteOutputHdr) - IF ( ALLOCATED( Init%OutData_OpFM%WriteOutputHdr ) ) y_FAST%numOuts(Module_OpFM) = SIZE(Init%OutData_OpFM%WriteOutputHdr) + IF ( ALLOCATED( Init%OutData_ExtInfw%WriteOutputHdr ) ) y_FAST%numOuts(Module_ExtInfw) = SIZE(Init%OutData_ExtInfw%WriteOutputHdr) IF ( ALLOCATED( Init%OutData_ED%WriteOutputHdr ) ) y_FAST%numOuts(Module_ED) = SIZE(Init%OutData_ED%WriteOutputHdr) + IF ( ALLOCATED( Init%OutData_SED%WriteOutputHdr ) ) y_FAST%numOuts(Module_SED) = SIZE(Init%OutData_SED%WriteOutputHdr) do i=1,p_FAST%nBeams IF ( ALLOCATED( Init%OutData_BD(i)%WriteOutputHdr) ) y_FAST%numOuts(Module_BD) = y_FAST%numOuts(Module_BD) + SIZE(Init%OutData_BD(i)%WriteOutputHdr) end do -!ad14 doesn't have outputs: - y_FAST%numOuts(Module_AD14) = 0 - + IF ( ALLOCATED( Init%OutData_AD%rotors)) then IF ( ALLOCATED( Init%OutData_AD%rotors(1)%WriteOutputHdr)) y_FAST%numOuts(Module_AD) = SIZE(Init%OutData_AD%rotors(1)%WriteOutputHdr) ENDIF + IF ( ALLOCATED( Init%OutData_ADsk%WriteOutputHdr ) ) y_FAST%numOuts(Module_ADsk) = SIZE(Init%OutData_ADsk%WriteOutputHdr) IF ( ALLOCATED( Init%OutData_SrvD%WriteOutputHdr ) ) y_FAST%numOuts(Module_SrvD) = SIZE(Init%OutData_SrvD%WriteOutputHdr) + IF ( ALLOCATED( Init%OutData_SeaSt%WriteOutputHdr ) ) y_FAST%numOuts(Module_SeaSt) = SIZE(Init%OutData_SeaSt%WriteOutputHdr) IF ( ALLOCATED( Init%OutData_HD%WriteOutputHdr ) ) y_FAST%numOuts(Module_HD) = SIZE(Init%OutData_HD%WriteOutputHdr) IF ( ALLOCATED( Init%OutData_SD%WriteOutputHdr ) ) y_FAST%numOuts(Module_SD) = SIZE(Init%OutData_SD%WriteOutputHdr) IF ( ALLOCATED( Init%OutData_ExtPtfm%WriteOutputHdr) ) y_FAST%numOuts(Module_ExtPtfm)= SIZE(Init%OutData_ExtPtfm%WriteOutputHdr) @@ -2143,9 +2508,13 @@ SUBROUTINE FAST_InitOutput( p_FAST, y_FAST, Init, ErrStat, ErrMsg ) !...................................................... ! Initialize the output channel names and units !...................................................... + if (p_FAST%CompAeroMaps) then + y_FAST%numOuts(Module_Glue) = 1 + size(y_FAST%DriverWriteOutput) + else y_FAST%numOuts(Module_Glue) = 1 ! time + end if + - NumOuts = SUM( y_FAST%numOuts ) CALL AllocAry( y_FAST%ChannelNames,NumOuts, 'ChannelNames', ErrStat, ErrMsg ) @@ -2153,22 +2522,46 @@ SUBROUTINE FAST_InitOutput( p_FAST, y_FAST, Init, ErrStat, ErrMsg ) CALL AllocAry( y_FAST%ChannelUnits,NumOuts, 'ChannelUnits', ErrStat, ErrMsg ) IF ( ErrStat /= ErrID_None ) RETURN - ! Glue outputs: - y_FAST%ChannelNames(1) = 'Time' - y_FAST%ChannelUnits(1) = '(s)' + ! Glue outputs: + if (p_FAST%CompAeroMaps) then + y_FAST%ChannelNames(1) = 'Case' + y_FAST%ChannelUnits(1) = '(-)' + + y_FAST%ChannelNames(SS_Indx_Pitch+1) = 'Pitch' + y_FAST%ChannelUnits(SS_Indx_Pitch+1) = '(deg)' + + y_FAST%ChannelNames(SS_Indx_TSR+1) = 'TSR' + y_FAST%ChannelUnits(SS_Indx_TSR+1) = '(-)' + + y_FAST%ChannelNames(SS_Indx_RotSpeed+1) = 'RotorSpeed' + y_FAST%ChannelUnits(SS_Indx_RotSpeed+1) = '(RPM)' + + y_FAST%ChannelNames(SS_Indx_Err+1) = 'AvgError' + y_FAST%ChannelUnits(SS_Indx_Err+1) = '(-)' + + y_FAST%ChannelNames(SS_Indx_Iter+1) = 'Iterations' + y_FAST%ChannelUnits(SS_Indx_Iter+1) = '(-)' + + y_FAST%ChannelNames(SS_Indx_WS+1) = 'WindSpeed' + y_FAST%ChannelUnits(SS_Indx_WS+1) = '(m/s)' + + else + y_FAST%ChannelNames(1) = 'Time' + y_FAST%ChannelUnits(1) = '(s)' + + end if - indxNext = y_FAST%numOuts(Module_Glue) + 1 - - DO i=1,y_FAST%numOuts(Module_IfW) !InflowWind - y_FAST%ChannelNames(indxNext) = Init%OutData_IfW%WriteOutputHdr(i) - y_FAST%ChannelUnits(indxNext) = Init%OutData_IfW%WriteOutputUnt(i) + + DO i=1,y_FAST%numOuts(Module_ExtInfw) !ExternalInflow + y_FAST%ChannelNames(indxNext) = Init%OutData_ExtInfw%WriteOutputHdr(i) + y_FAST%ChannelUnits(indxNext) = Init%OutData_ExtInfw%WriteOutputUnt(i) indxNext = indxNext + 1 END DO - DO i=1,y_FAST%numOuts(Module_OpFM) !OpenFOAM - y_FAST%ChannelNames(indxNext) = Init%OutData_OpFM%WriteOutputHdr(i) - y_FAST%ChannelUnits(indxNext) = Init%OutData_OpFM%WriteOutputUnt(i) + DO i=1,y_FAST%numOuts(Module_IfW) !InflowWind + y_FAST%ChannelNames(indxNext) = Init%OutData_IfW%WriteOutputHdr(i) + y_FAST%ChannelUnits(indxNext) = Init%OutData_IfW%WriteOutputUnt(i) indxNext = indxNext + 1 END DO @@ -2178,6 +2571,12 @@ SUBROUTINE FAST_InitOutput( p_FAST, y_FAST, Init, ErrStat, ErrMsg ) indxNext = indxNext + 1 END DO + DO i=1,y_FAST%numOuts(Module_SED) !Simnplified-ElastoDyn + y_FAST%ChannelNames(indxNext) = Init%OutData_SED%WriteOutputHdr(i) + y_FAST%ChannelUnits(indxNext) = Init%OutData_SED%WriteOutputUnt(i) + indxNext = indxNext + 1 + END DO + IF ( y_FAST%numOuts(Module_BD) > 0_IntKi ) THEN !BeamDyn do i=1,p_FAST%nBeams if ( allocated(Init%OutData_BD(i)%WriteOutputHdr) ) then @@ -2199,12 +2598,24 @@ SUBROUTINE FAST_InitOutput( p_FAST, y_FAST, Init, ErrStat, ErrMsg ) indxNext = indxNext + 1 END DO + DO i=1,y_FAST%numOuts(Module_ADsk) !AeroDisk + y_FAST%ChannelNames(indxNext) = Init%OutData_ADsk%WriteOutputHdr(i) + y_FAST%ChannelUnits(indxNext) = Init%OutData_ADsk%WriteOutputUnt(i) + indxNext = indxNext + 1 + END DO + DO i=1,y_FAST%numOuts(Module_SrvD) !ServoDyn y_FAST%ChannelNames(indxNext) = Init%OutData_SrvD%WriteOutputHdr(i) y_FAST%ChannelUnits(indxNext) = Init%OutData_SrvD%WriteOutputUnt(i) indxNext = indxNext + 1 END DO + DO i=1,y_FAST%numOuts(Module_SeaSt) !SeaState + y_FAST%ChannelNames(indxNext) = Init%OutData_SeaSt%WriteOutputHdr(i) + y_FAST%ChannelUnits(indxNext) = Init%OutData_SeaSt%WriteOutputUnt(i) + indxNext = indxNext + 1 + END DO + DO i=1,y_FAST%numOuts(Module_HD) !HydroDyn y_FAST%ChannelNames(indxNext) = Init%OutData_HD%WriteOutputHdr(i) y_FAST%ChannelUnits(indxNext) = Init%OutData_HD%WriteOutputUnt(i) @@ -2276,10 +2687,6 @@ SUBROUTINE FAST_InitOutput( p_FAST, y_FAST, Init, ErrStat, ErrMsg ) y_FAST%ActualChanLen = max( y_FAST%ActualChanLen, LEN_TRIM(y_FAST%ChannelUnits(I)) ) ENDDO ! I - y_FAST%OutFmt_a = '"'//p_FAST%Delim//'"'//p_FAST%OutFmt ! format for array elements from individual modules - if (p_FAST%FmtWidth < y_FAST%ActualChanLen) then - y_FAST%OutFmt_a = trim(y_FAST%OutFmt_a)//','//trim(num2lstr(y_FAST%ActualChanLen - p_FAST%FmtWidth))//'x' - end if !$OMP critical(fileopen) CALL GetNewUnit( y_FAST%UnOu, ErrStat, ErrMsg ) @@ -2349,9 +2756,10 @@ SUBROUTINE FAST_InitOutput( p_FAST, y_FAST, Init, ErrStat, ErrMsg ) IF (p_FAST%WrBinOutFile) THEN ! calculate the size of the array of outputs we need to store + !IF (p_FAST%CompAeroMaps) y_FAST%NOutSteps = p_FAST%NumTSR * p_FAST%NumPitch y_FAST%NOutSteps = CEILING ( (p_FAST%TMax - p_FAST%TStart) / p_FAST%DT_OUT ) + 1 - CALL AllocAry( y_FAST%AllOutData, NumOuts-1, y_FAST%NOutSteps, 'AllOutData', ErrStat, ErrMsg ) ! this does not include the time channel + CALL AllocAry( y_FAST%AllOutData, NumOuts-1, y_FAST%NOutSteps, 'AllOutData', ErrStat, ErrMsg ) ! this does not include the time channel (or case number for steady-state solve) IF ( ErrStat >= AbortErrLev ) RETURN y_FAST%AllOutData = 0.0_ReKi @@ -2431,6 +2839,8 @@ SUBROUTINE FAST_ReadPrimaryFile( InputFile, p, m_FAST, OverrideAbortErrLev, ErrS RETURN end if + p%NumSSCases = 0 + p%RotSpeedInit = 0.0_ReKi ! Read the lines up/including to the "Echo" simulation control variable ! If echo is FALSE, don't write these lines to the echo file. @@ -2497,9 +2907,11 @@ SUBROUTINE FAST_ReadPrimaryFile( InputFile, p, m_FAST, OverrideAbortErrLev, ErrS END DO - CALL WrScr( TRIM(FAST_Ver%Name)//' input file heading:' ) - CALL WrScr( ' '//TRIM( p%FTitle ) ) - CALL WrScr('') + if (.not. p%CompAeroMaps) then + CALL WrScr( TRIM(FAST_Ver%Name)//' input file heading:' ) + CALL WrScr( ' '//TRIM( p%FTitle ) ) + CALL WrScr('') + end if ! AbortLevel - Error level when simulation should abort: @@ -2597,7 +3009,7 @@ SUBROUTINE FAST_ReadPrimaryFile( InputFile, p, m_FAST, OverrideAbortErrLev, ErrS end if ! CompElast - Compute structural dynamics (switch) {1=ElastoDyn; 2=ElastoDyn + BeamDyn for blades}: - CALL ReadVar( UnIn, InputFile, p%CompElast, "CompElast", "Compute structural dynamics (switch) {1=ElastoDyn; 2=ElastoDyn + BeamDyn for blades}", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InputFile, p%CompElast, "CompElast", "Compute structural dynamics (switch) {1=ElastoDyn; 2=ElastoDyn + BeamDyn for blades; 3=Simplified-ElastoDyn}", ErrStat2, ErrMsg2, UnEc) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if ( ErrStat >= AbortErrLev ) then call cleanup() @@ -2609,6 +3021,8 @@ SUBROUTINE FAST_ReadPrimaryFile( InputFile, p, m_FAST, OverrideAbortErrLev, ErrS p%CompElast = Module_ED ELSEIF ( p%CompElast == 2 ) THEN p%CompElast = Module_BD + ELSEIF ( p%CompElast == 3 ) THEN + p%CompElast = Module_SED ELSE p%CompElast = Module_Unknown END IF @@ -2627,13 +3041,13 @@ SUBROUTINE FAST_ReadPrimaryFile( InputFile, p, m_FAST, OverrideAbortErrLev, ErrS ELSEIF ( p%CompInflow == 1 ) THEN p%CompInflow = Module_IfW ELSEIF ( p%CompInflow == 2 ) THEN - p%CompInflow = Module_OpFM + p%CompInflow = Module_ExtInfw ELSE p%CompInflow = Module_Unknown END IF - ! CompAero - Compute aerodynamic loads (switch) {0=None; 1=AeroDyn}: - CALL ReadVar( UnIn, InputFile, p%CompAero, "CompAero", "Compute aerodynamic loads (switch) {0=None; 1=AeroDyn}", ErrStat2, ErrMsg2, UnEc) + ! CompAero - Compute aerodynamic loads (switch) {0=None; 1=AeroDisk; 2=AeroDyn; 3=ExtLoads}: + CALL ReadVar( UnIn, InputFile, p%CompAero, "CompAero", "Compute aerodynamic loads (switch) {0=None; 1=AeroDisk; 2=AeroDyn; 3=ExtLoads}", ErrStat2, ErrMsg2, UnEc) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if ( ErrStat >= AbortErrLev ) then call cleanup() @@ -2644,9 +3058,11 @@ SUBROUTINE FAST_ReadPrimaryFile( InputFile, p, m_FAST, OverrideAbortErrLev, ErrS IF ( p%CompAero == 0 ) THEN p%CompAero = Module_NONE ELSEIF ( p%CompAero == 1 ) THEN - p%CompAero = Module_AD14 + p%CompAero = Module_ADsk ELSEIF ( p%CompAero == 2 ) THEN p%CompAero = Module_AD + ELSEIF ( p%CompAero == 3 ) THEN + p%CompAero = Module_ExtLd ELSE p%CompAero = Module_Unknown END IF @@ -2669,6 +3085,23 @@ SUBROUTINE FAST_ReadPrimaryFile( InputFile, p, m_FAST, OverrideAbortErrLev, ErrS END IF + ! CompSeaSt - Compute sea state information (switch) {0=None; 1=SeaState}: + CALL ReadVar( UnIn, InputFile, p%CompSeaSt, "CompSeaSt", "Compute sea state information (switch) {0=None; 1=SeaState}}", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + + ! immediately convert to values used inside the code: + IF ( p%CompSeaSt == 0 ) THEN + p%CompSeaSt = Module_NONE + ELSEIF ( p%CompSeaSt == 1 ) THEN + p%CompSeaSt = Module_SeaSt + ELSE + p%CompSeaSt = Module_Unknown + END IF + ! CompHydro - Compute hydrodynamic loads (switch) {0=None; 1=HydroDyn}: CALL ReadVar( UnIn, InputFile, p%CompHydro, "CompHydro", "Compute hydrodynamic loads (switch) {0=None; 1=HydroDyn}", ErrStat2, ErrMsg2, UnEc) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2746,13 +3179,13 @@ SUBROUTINE FAST_ReadPrimaryFile( InputFile, p, m_FAST, OverrideAbortErrLev, ErrS ELSE p%CompIce = Module_Unknown END IF - + ! MHK - MHK turbine type (switch) {0=Not an MHK turbine; 1=Fixed MHK turbine; 2=Floating MHK turbine}: CALL ReadVar( UnIn, InputFile, p%MHK, "MHK", "MHK turbine type (switch) {0=Not an MHK turbine; 1=Fixed MHK turbine; 2=Floating MHK turbine}", ErrStat2, ErrMsg2, UnEc) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if ( ErrStat >= AbortErrLev ) then call cleanup() - RETURN + RETURN end if !---------------------- ENVIRONMENTAL CONDITIONS -------------------------------- @@ -2760,15 +3193,15 @@ SUBROUTINE FAST_ReadPrimaryFile( InputFile, p, m_FAST, OverrideAbortErrLev, ErrS CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if ( ErrStat >= AbortErrLev ) then call cleanup() - RETURN - end if - + RETURN + end if + ! Gravity - Gravitational acceleration (m/s^2): CALL ReadVar( UnIn, InputFile, p%Gravity, "Gravity", "Gravitational acceleration (m/s^2)", ErrStat2, ErrMsg2, UnEc) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if ( ErrStat >= AbortErrLev ) then call cleanup() - RETURN + RETURN end if ! AirDens - Air density (kg/m^3): @@ -2776,7 +3209,7 @@ SUBROUTINE FAST_ReadPrimaryFile( InputFile, p, m_FAST, OverrideAbortErrLev, ErrS CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if ( ErrStat >= AbortErrLev ) then call cleanup() - RETURN + RETURN end if ! WtrDens - Water density (kg/m^3): @@ -2784,7 +3217,7 @@ SUBROUTINE FAST_ReadPrimaryFile( InputFile, p, m_FAST, OverrideAbortErrLev, ErrS CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if ( ErrStat >= AbortErrLev ) then call cleanup() - RETURN + RETURN end if ! KinVisc - Kinematic viscosity of working fluid (m^2/s): @@ -2792,7 +3225,7 @@ SUBROUTINE FAST_ReadPrimaryFile( InputFile, p, m_FAST, OverrideAbortErrLev, ErrS CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if ( ErrStat >= AbortErrLev ) then call cleanup() - RETURN + RETURN end if ! SpdSound - Speed of sound in working fluid (m/s): @@ -2800,7 +3233,7 @@ SUBROUTINE FAST_ReadPrimaryFile( InputFile, p, m_FAST, OverrideAbortErrLev, ErrS CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if ( ErrStat >= AbortErrLev ) then call cleanup() - RETURN + RETURN end if ! Patm - Atmospheric pressure (Pa): @@ -2808,7 +3241,7 @@ SUBROUTINE FAST_ReadPrimaryFile( InputFile, p, m_FAST, OverrideAbortErrLev, ErrS CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if ( ErrStat >= AbortErrLev ) then call cleanup() - RETURN + RETURN end if ! Pvap - Vapour pressure of working fluid (Pa): @@ -2816,7 +3249,7 @@ SUBROUTINE FAST_ReadPrimaryFile( InputFile, p, m_FAST, OverrideAbortErrLev, ErrS CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if ( ErrStat >= AbortErrLev ) then call cleanup() - RETURN + RETURN end if ! WtrDpth - Water depth (m): @@ -2824,7 +3257,7 @@ SUBROUTINE FAST_ReadPrimaryFile( InputFile, p, m_FAST, OverrideAbortErrLev, ErrS CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if ( ErrStat >= AbortErrLev ) then call cleanup() - RETURN + RETURN end if ! MSL2SWL - Offset between still-water level and mean sea level (m): @@ -2832,7 +3265,7 @@ SUBROUTINE FAST_ReadPrimaryFile( InputFile, p, m_FAST, OverrideAbortErrLev, ErrS CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if ( ErrStat >= AbortErrLev ) then call cleanup() - RETURN + RETURN end if !---------------------- INPUT FILES --------------------------------------------- @@ -2890,6 +3323,15 @@ SUBROUTINE FAST_ReadPrimaryFile( InputFile, p, m_FAST, OverrideAbortErrLev, ErrS end if IF ( PathIsRelative( p%ServoFile ) ) p%ServoFile = TRIM(PriPath)//TRIM(p%ServoFile) + ! SeaStFile - Name of file containing sea state input parameters (-): + CALL ReadVar( UnIn, InputFile, p%SeaStFile, "SeaStFile", "Name of file containing sea state input parameters (-)", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + IF ( PathIsRelative( p%SeaStFile ) ) p%SeaStFile = TRIM(PriPath)//TRIM(p%SeaStFile) + ! HydroFile - Name of file containing hydrodynamic input parameters (-): CALL ReadVar( UnIn, InputFile, p%HydroFile, "HydroFile", "Name of file containing hydrodynamic input parameters (-)", ErrStat2, ErrMsg2, UnEc) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3054,7 +3496,7 @@ SUBROUTINE FAST_ReadPrimaryFile( InputFile, p, m_FAST, OverrideAbortErrLev, ErrS OutFileFmt = OutFileFmt / 2 ! integer division if (OutFileFmt /= 0) then - call SetErrStat( ErrID_Fatal, "OutFileFmt must be 0, 1, 2, or 3.",ErrStat,ErrMsg,RoutineName) + call SetErrStat( ErrID_Fatal, "OutFileFmt must be 0, 1, 2, 3, 4, or 5.",ErrStat,ErrMsg,RoutineName) call cleanup() return end if @@ -3161,6 +3603,12 @@ SUBROUTINE FAST_ReadPrimaryFile( InputFile, p, m_FAST, OverrideAbortErrLev, ErrS RETURN end if + ! temporary work-around for error with CalcSteady + if (p%CalcSteady .and. p%NLinTimes == 1 ) then + call SetErrStat(ErrID_Info, "Setting NLinTimes to 2 to avoid problem with CalcSteady with only one time.", ErrStat,ErrMsg,RoutineName) + p%NLinTimes = 2 + end if + ! LinInputs - Include inputs in linearization (switch) {0=none; 1=standard; 2=all module inputs (debug)} CALL ReadVar( UnIn, InputFile, p%LinInputs, "LinInputs", "Include inputs in linearization (switch) {0=none; 1=standard; 2=all module inputs (debug)}", ErrStat2, ErrMsg2, UnEc) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3295,147 +3743,407 @@ end subroutine cleanup !............................................................................................................................... END SUBROUTINE FAST_ReadPrimaryFile !---------------------------------------------------------------------------------------------------------------------------------- -!> This subroutine sets up some of the information needed for plotting VTK surfaces. It initializes only the data needed before -!! HD initialization. (HD needs some of this data so it can return the wave elevation data we want.) -SUBROUTINE SetVTKParameters_B4HD(p_FAST, InitOutData_ED, InitInData_HD, BD, ErrStat, ErrMsg) +!> This routine reads in the primary FAST input file for steady-state calculations, does some validation, and places the values it reads in the +!! parameter structure (p). It prints to an echo file if requested. +SUBROUTINE FAST_ReadSteadyStateFile( InputFile, p, m_FAST, ErrStat, ErrMsg ) - TYPE(FAST_ParameterType), INTENT(INOUT) :: p_FAST !< The parameters of the glue code - TYPE(ED_InitOutputType), INTENT(IN ) :: InitOutData_ED !< The initialization output from structural dynamics module - TYPE(HydroDyn_InitInputType), INTENT(INOUT) :: InitInData_HD !< The initialization input to HydroDyn - TYPE(BeamDyn_Data), INTENT(IN ) :: BD !< BeamDyn data - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + IMPLICIT NONE + ! Passed variables + TYPE(FAST_ParameterType), INTENT(INOUT) :: p !< The parameter data for the FAST (glue-code) simulation + TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables + CHARACTER(*), INTENT(IN) :: InputFile !< Name of the file containing the primary input data + INTEGER(IntKi), INTENT(OUT) :: ErrStat !< Error status + CHARACTER(*), INTENT(OUT) :: ErrMsg !< Error message - REAL(SiKi) :: BladeLength, Width, WidthBy2 - REAL(SiKi) :: dx, dy - INTEGER(IntKi) :: i, j, n - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SetVTKParameters_B4HD' + ! Local variables: + INTEGER(IntKi) :: I ! loop counter + INTEGER(IntKi) :: UnIn ! Unit number for reading file + INTEGER(IntKi) :: UnEc ! I/O unit for echo file. If > 0, file is open for writing. + REAL(ReKi) :: TmpAry(3) ! temporary array to read in columns of case table - ErrStat = ErrID_None - ErrMsg = "" + 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) :: FstFile ! Name of the primary ENFAST model file - ! Get radius for ground (blade length + hub radius): - if ( p_FAST%CompElast == Module_BD ) then - BladeLength = TwoNorm(BD%y(1)%BldMotion%Position(:,1) - BD%y(1)%BldMotion%Position(:,BD%y(1)%BldMotion%Nnodes)) - else - BladeLength = InitOutData_ED%BladeLength - end if - p_FAST%VTK_Surface%HubRad = InitOutData_ED%HubRad - p_FAST%VTK_Surface%GroundRad = BladeLength + p_FAST%VTK_Surface%HubRad + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_ReadSteadyStateFile' - !........................................................................................................ - ! We don't use the rest of this routine for stick-figure output - if (p_FAST%VTK_Type /= VTK_Surf) return - !........................................................................................................ - ! initialize wave elevation data: - if ( p_FAST%CompHydro == Module_HD ) then - - p_FAST%VTK_surface%NWaveElevPts(1) = 25 - p_FAST%VTK_surface%NWaveElevPts(2) = 25 - - call allocAry( InitInData_HD%WaveElevXY, 2, p_FAST%VTK_surface%NWaveElevPts(1)*p_FAST%VTK_surface%NWaveElevPts(2), 'WaveElevXY', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - - Width = p_FAST%VTK_Surface%GroundRad * VTK_GroundFactor -!FIXME:ADP -- change test after merging to dev branch to compare to MHK_None - ! adjust to larger surface area for MHK since MHK turbines tend to be small compared to the platform - if (p_FAST%MHK /= 0_IntKi) Width = Width * 5.0_SiKi - dx = Width / (p_FAST%VTK_surface%NWaveElevPts(1) - 1) - dy = Width / (p_FAST%VTK_surface%NWaveElevPts(2) - 1) - - WidthBy2 = Width / 2.0_SiKi - n = 1 - do i=1,p_FAST%VTK_surface%NWaveElevPts(1) - do j=1,p_FAST%VTK_surface%NWaveElevPts(2) - InitInData_HD%WaveElevXY(1,n) = dx*(i-1) - WidthBy2 !+ p_FAST%TurbinePos(1) ! HD takes p_FAST%TurbinePos into account already - InitInData_HD%WaveElevXY(2,n) = dy*(j-1) - WidthBy2 !+ p_FAST%TurbinePos(2) - n = n+1 - end do - end do + ! Initialize some variables: + UnEc = -1 + Echo = .FALSE. ! Don't echo until we've read the "Echo" flag + CALL GetPath( InputFile, PriPath ) ! Input files will be relative to the path where the primary input file is located. - end if + ! Get an available unit number for the file. -END SUBROUTINE SetVTKParameters_B4HD -!---------------------------------------------------------------------------------------------------------------------------------- -!> This subroutine sets up the information needed for plotting VTK surfaces. -SUBROUTINE SetVTKParameters(p_FAST, InitOutData_ED, InitOutData_AD, InitInData_HD, InitOutData_HD, ED, BD, AD, HD, ErrStat, ErrMsg) + CALL GetNewUnit( UnIn, ErrStat, ErrMsg ) + IF ( ErrStat >= AbortErrLev ) RETURN - TYPE(FAST_ParameterType), INTENT(INOUT) :: p_FAST !< The parameters of the glue code - TYPE(ED_InitOutputType), INTENT(IN ) :: InitOutData_ED !< The initialization output from structural dynamics module - TYPE(AD_InitOutputType), INTENT(INOUT) :: InitOutData_AD !< The initialization output from AeroDyn - TYPE(HydroDyn_InitInputType), INTENT(INOUT) :: InitInData_HD !< The initialization input to HydroDyn - TYPE(HydroDyn_InitOutputType),INTENT(INOUT) :: InitOutData_HD !< The initialization output from HydroDyn - TYPE(ElastoDyn_Data), INTENT(IN ) :: ED !< ElastoDyn data - TYPE(BeamDyn_Data), INTENT(IN ) :: BD !< BeamDyn data - TYPE(AeroDyn_Data), INTENT(IN ) :: AD !< AeroDyn data - TYPE(HydroDyn_Data), INTENT(IN ) :: HD !< HydroDyn data - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - REAL(SiKi) :: RefPoint(3), RefLengths(2) - REAL(SiKi) :: x, y - REAL(SiKi) :: TwrDiam_top, TwrDiam_base, TwrRatio, TwrLength - INTEGER(IntKi) :: topNode, baseNode - INTEGER(IntKi) :: NumBl, k - CHARACTER(1024) :: vtkroot - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SetVTKParameters' - INTEGER(IntKi) :: rootNode, cylNode, tipNode + ! Open the Primary input file. + CALL OpenFInpFile ( UnIn, InputFile, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2,ErrStat,ErrMsg,RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if - ErrStat = ErrID_None - ErrMsg = "" - ! get the name of the output directory for vtk files (in a subdirectory called "vtk" of the output directory), and - ! create the VTK directory if it does not exist + ! 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. - call GetPath ( p_FAST%OutFileRoot, p_FAST%VTK_OutFileRoot, vtkroot ) ! the returned p_FAST%VTK_OutFileRoot includes a file separator character at the end - p_FAST%VTK_OutFileRoot = trim(p_FAST%VTK_OutFileRoot) // 'vtk' + I = 1 !set the number of times we've read the file + DO + !-------------------------- HEADER --------------------------------------------- - call MKDIR( trim(p_FAST%VTK_OutFileRoot) ) + CALL ReadCom( UnIn, InputFile, 'File header: Version (line 1)', ErrStat2, ErrMsg2, UnEc ) + CALL SetErrStat( ErrStat2, ErrMsg2,ErrStat,ErrMsg,RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if - p_FAST%VTK_OutFileRoot = trim( p_FAST%VTK_OutFileRoot ) // PathSep // trim(vtkroot) + CALL ReadStr( UnIn, InputFile, p%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 + !---------------------- ENFAST MODEL FILE -------------------------------------- + CALL ReadCom( UnIn, InputFile, 'Section Header: ENFAST Model', ErrStat2, ErrMsg2, UnEc ) + CALL SetErrStat( ErrStat2, ErrMsg2,ErrStat,ErrMsg,RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if - ! calculate the number of digits in 'y_FAST%NOutSteps' (Maximum number of output steps to be written) - ! this will be used to pad the write-out step in the VTK filename with zeros in calls to MeshWrVTK() - if (p_FAST%WrVTK == VTK_ModeShapes .AND. p_FAST%VTK_modes%VTKLinTim==1) then - if (p_FAST%NLinTimes < 1) p_FAST%NLinTimes = 1 !in case we reached here with an error + CALL ReadVar( UnIn, InputFile, FstFile, "FstFile", "Name of the primary ENFAST model file (-)", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2,ErrStat,ErrMsg,RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + + !---------------------- STEADY-STATE SIMULATION CONTROL -------------------------------------- + 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 data to .ech (flag): + CALL ReadVar( UnIn, InputFile, Echo, "Echo", "Echo input data to .ech (flag)", 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%OutFileRoot)//'.ech', ErrStat2, ErrMsg2, FAST_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(FAST_Ver%Name)//' primary steady-state 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 + + CALL WrScr( TRIM(FAST_Ver%Name)//' input file heading:' ) + CALL WrScr( ' '//TRIM( p%FTitle ) ) + CALL WrScr('') + + ! ------------------------------------------------------------- + ! READ FROM THE PRIMARY OPENFAST (TIME-DOMAIN) INPUT FILE + ! do this before reading the rest of the variables in this + ! steady-state input file so that we don't accidentally + ! overwrite them. + ! ------------------------------------------------------------- + IF ( PathIsRelative( FstFile ) ) FstFile = TRIM(PriPath)//TRIM(FstFile) + CALL FAST_ReadPrimaryFile( FstFile, p, m_FAST, .true., ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + + !-------------------------------------------- + ! Overwrite values for parameters that we do not + ! want to read from the input file: + !-------------------------------------------- + p%DT = 1.0_DbKi ! we'll make this unity to represent case numbers instead of time in the case of AeroMap generation + p%TMax = p%DT ! overwrite this later when we have the number of cases to run + p%InterpOrder = 1 ! set this to 1 so we have two copies of inputs in the solver + p%NumCrctn = 0 + p%DT_UJac = 9999.0_ReKi ! any non-zero number will do ! maybe we will want to use this???? + p%n_SttsTime = 1 + p%n_ChkptTime = HUGE(p%n_ChkptTime) + + p%CompInflow = Module_NONE + p%CompServo = Module_NONE + p%CompHydro = Module_NONE + p%CompSeaSt = Module_NONE + p%CompSub = Module_NONE + p%CompMooring = Module_NONE + p%CompIce = Module_NONE + if ( p%CompAero /= Module_AD) then + p%CompAero = Module_AD + call WrScr('Warning: AeroDyn must be used for generating AeroMaps. Check that variable "AeroFile" is set properly in the OpenFAST input file.') + end if + if (p%CompElast == Module_BD) then + CALL SetErrStat( ErrID_Warn, "AeroMaps with BeamDyn have not been verified.", ErrStat, ErrMsg, RoutineName) + end if + + p%DT_Out = p%DT + p%n_DT_Out = 1 ! output every step (i.e., every case) + p%TStart = 0.0_DbKi + + p%Linearize = .false. ! we use p%CompAeroMaps to do a subset of the linearization routines + p%CalcSteady = .false. + p%TrimCase = TrimCase_none + p%NLinTimes = 1 + p%LinInputs = LIN_ALL + p%LinOutputs = LIN_ALL + + p%LinOutMod = .TRUE. ! if debugging, this will allow us to output linearization files (see parameter "output_debugging" in FAST_SS_Solver.f90); otherwise this doesn't do anything + p%LinOutJac = .TRUE. ! if debugging, this will allow us to output linearization files (see parameter "output_debugging" in FAST_SS_Solver.f90); otherwise this doesn't do anything + p%WrVTK = VTK_None + p%VTK_Type = VTK_None + p%n_VTKTime = 1 + m_FAST%Lin%FoundSteady = .false. + p%LinInterpOrder = p%InterpOrder ! 1 ! always use linear (or constant) interpolation on rotor + !-------------------------------------------- + + + ! Toler - Convergence tolerance for nonlinear solve residual equation [>0] (-) + CALL ReadVar( UnIn, InputFile, p%tolerSquared, "Toler", "Convergence tolerance for nonlinear solve residual equation (-)", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + p%tolerSquared = p%tolerSquared ** 2 + + + ! MaxIter - Maximum number of iteration steps for nonlinear solve [>0] (-) + CALL ReadVar( UnIn, InputFile, p%KMax, "MaxIter", "Maximum number of iteration steps for nonlinear solve (-)", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + + + ! N_UJac - Number of iteration steps to recalculate Jacobian (-) [1=every iteration step, 2=every other step] + CALL ReadVar( UnIn, InputFile, p%N_UJac, "N_SSJac", "Number of iteration steps to recalculate steady-state Jacobian (-)", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + + + ! UJacSclFact - Scaling factor used in Jacobians (-) + CALL ReadVar( UnIn, InputFile, p%UJacSclFact, "SSJacSclFact", "Scaling factor used in steady-state Jacobians (-)", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + + + !---------------------- CASES ----------------------------------------------- + CALL ReadCom( UnIn, InputFile, 'Section Header: Steady-State Cases', ErrStat2, ErrMsg2, UnEc ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + + ! WindSpeedOrTSR - Choice of swept parameter (switch) { 1:wind speed; 2: TSR }: + CALL ReadVar( UnIn, InputFile, p%WindSpeedOrTSR, "WindSpeedOrTSR", "Choice of swept parameter (switch) { 1:wind speed; 2: TSR }", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + + ! NumSSCases - Number of steady-state cases (-) [>=1] + CALL ReadVar( UnIn, InputFile, p%NumSSCases, "NumSSCases", "Number of steady-state cases (-) [>=1]", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + + if (p%NumSSCases < 1) then + CALL SetErrStat( ErrID_Fatal, "Number of cases must be at least 1.", ErrStat, ErrMsg, RoutineName) + call cleanup() + RETURN + end if + + ! TSR - List of TSRs (-) [>0] + call AllocAry( p%RotSpeed, p%NumSSCases, 'RotSpeed', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AllocAry( p%WS_TSR, p%NumSSCases, 'WS_TSR', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AllocAry( p%Pitch, p%NumSSCases, 'Pitch', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + + ! Case table header: + CALL ReadCom( UnIn, InputFile, 'Section Header: Steady-State Case Column Names', ErrStat2, ErrMsg2, UnEc ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + CALL ReadCom( UnIn, InputFile, 'Section Header: Steady-State Case Column Units', ErrStat2, ErrMsg2, UnEc ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + + + ! Case table: + do i=1,p%NumSSCases + CALL ReadAry( UnIn, InputFile, TmpAry, size(TmpAry), "TmpAry", "List of cases (-) [>0]", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + + p%RotSpeed(i) = TmpAry(1) * RPM2RPS + p%WS_TSR( i) = TmpAry(2) + p%Pitch( i) = TmpAry(3) * D2R + end do + + !---------------------- END OF FILE ----------------------------------------- + p%TMax = p%NumSSCases + p%RotSpeedInit = p%RotSpeed(1) + + call cleanup() + RETURN + +CONTAINS + !............................................................................................................................... + subroutine cleanup() + CLOSE( UnIn ) + IF ( UnEc > 0 ) CLOSE ( UnEc ) + end subroutine cleanup + !............................................................................................................................... +END SUBROUTINE FAST_ReadSteadyStateFile +!---------------------------------------------------------------------------------------------------------------------------------- +!> This subroutine sets up the information needed for plotting VTK surfaces. +SUBROUTINE SetVTKParameters(p_FAST, InitOutData_ED, InitOutData_SED, InitOutData_AD, InitOutData_SeaSt, InitOutData_HD, ED, SED, BD, AD, HD, ErrStat, ErrMsg) + + TYPE(FAST_ParameterType), INTENT(INOUT) :: p_FAST !< The parameters of the glue code + TYPE(ED_InitOutputType), INTENT(IN ) :: InitOutData_ED !< The initialization output from structural dynamics module + TYPE(SED_InitOutputType), INTENT(IN ) :: InitOutData_SED !< The initialization output from structural dynamics module + TYPE(AD_InitOutputType), INTENT(INOUT) :: InitOutData_AD !< The initialization output from AeroDyn + TYPE(SeaSt_InitOutputType), INTENT(INOUT) :: InitOutData_SeaSt !< The initialization output from SeaState + TYPE(HydroDyn_InitOutputType),INTENT(INOUT) :: InitOutData_HD !< The initialization output from HydroDyn + TYPE(ElastoDyn_Data), TARGET, INTENT(IN ) :: ED !< ElastoDyn data + TYPE(SED_Data), INTENT(IN ) :: SED !< Simplified-ElastoDyn data + TYPE(BeamDyn_Data), INTENT(IN ) :: BD !< BeamDyn data + TYPE(AeroDyn_Data), INTENT(IN ) :: AD !< AeroDyn data + TYPE(HydroDyn_Data), INTENT(IN ) :: HD !< HydroDyn data + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + REAL(SiKi) :: RefPoint(3), RefLengths(2) + REAL(SiKi) :: x, y + REAL(SiKi) :: TwrDiam_top, TwrDiam_base, TwrRatio, TwrLength + REAL(SiKi) :: BladeLength, HubRad + INTEGER(IntKi) :: topNode, baseNode + INTEGER(IntKi) :: NumBl, k, Indx + LOGICAL :: UseADtwr + TYPE(MeshType), POINTER :: TowerMotionMesh + CHARACTER(1024) :: vtkroot + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SetVTKParameters' + INTEGER(IntKi) :: rootNode, cylNode, tipNode + + + ErrStat = ErrID_None + ErrMsg = "" + + ! get the name of the output directory for vtk files (in a subdirectory called "vtk" of the output directory), and + ! create the VTK directory if it does not exist + + call GetPath ( p_FAST%OutFileRoot, p_FAST%VTK_OutFileRoot, vtkroot ) ! the returned p_FAST%VTK_OutFileRoot includes a file separator character at the end + p_FAST%VTK_OutFileRoot = trim(p_FAST%VTK_OutFileRoot) // 'vtk' + + call MKDIR( trim(p_FAST%VTK_OutFileRoot) ) + + p_FAST%VTK_OutFileRoot = trim( p_FAST%VTK_OutFileRoot ) // PathSep // trim(vtkroot) + + + ! calculate the number of digits in 'y_FAST%NOutSteps' (Maximum number of output steps to be written) + ! this will be used to pad the write-out step in the VTK filename with zeros in calls to MeshWrVTK() + if (p_FAST%WrVTK == VTK_ModeShapes .AND. p_FAST%VTK_modes%VTKLinTim==1) then + if (p_FAST%NLinTimes < 1) p_FAST%NLinTimes = 1 !in case we reached here with an error p_FAST%VTK_tWidth = CEILING( log10( real( p_FAST%NLinTimes) ) ) + 1 else p_FAST%VTK_tWidth = CEILING( log10( real(p_FAST%n_TMax_m1+1, ReKi) / p_FAST%n_VTKTime ) ) + 1 end if ! determine number of blades - NumBl = InitOutData_ED%NumBl + if (p_FAST%CompElast == Module_SED) then + NumBl = InitOutData_SED%NumBl + else + NumBl = InitOutData_ED%NumBl + endif ! initialize the vtk data - p_FAST%VTK_Surface%NumSectors = 25 - ! NOTE: we set p_FAST%VTK_Surface%GroundRad and p_FAST%VTK_Surface%HubRad in SetVTKParameters_B4HD + ! Get radius for ground (blade length + hub radius): + if ( p_FAST%CompElast == Module_BD ) then + BladeLength = TwoNorm(BD%y(1)%BldMotion%Position(:,1) - BD%y(1)%BldMotion%Position(:,BD%y(1)%BldMotion%Nnodes)) + HubRad = InitOutData_ED%HubRad + else + BladeLength = InitOutData_ED%BladeLength + HubRad = InitOutData_ED%HubRad + end if + p_FAST%VTK_Surface%HubRad = HubRad + p_FAST%VTK_Surface%GroundRad = BladeLength + HubRad ! write the ground or seabed reference polygon: RefPoint = p_FAST%TurbinePos - if (p_FAST%CompHydro == MODULE_HD) then + if (p_FAST%CompSeaSt == MODULE_SeaSt) then RefLengths = p_FAST%VTK_Surface%GroundRad*VTK_GroundFactor/2.0_SiKi -!FIXME: after merge to dev, change this test to use MHK_None - ! adjust to larger ground area for MHK since MHK turbines tend to be small compared to the platform - if (p_FAST%MHK /= 0_IntKi) RefLengths = RefLengths*4.0_SiKi + if (p_FAST%MHK /= MHK_None) RefLengths = RefLengths*4.0_SiKi ! note that p_FAST%TurbinePos(3) must be 0 for offshore turbines - RefPoint(3) = p_FAST%TurbinePos(3) - InitOutData_HD%WtrDpth + RefPoint(3) = p_FAST%TurbinePos(3) - p_FAST%WtrDpth call WrVTK_Ground ( RefPoint, RefLengths, trim(p_FAST%VTK_OutFileRoot) // '.SeabedSurface', ErrStat2, ErrMsg2 ) - RefPoint(3) = p_FAST%TurbinePos(3) - InitOutData_HD%MSL2SWL + RefPoint(3) = p_FAST%TurbinePos(3) - p_FAST%MSL2SWL call WrVTK_Ground ( RefPoint, RefLengths, trim(p_FAST%VTK_OutFileRoot) // '.StillWaterSurface', ErrStat2, ErrMsg2 ) else RefLengths = p_FAST%VTK_Surface%GroundRad !array = scalar @@ -3449,8 +4157,13 @@ SUBROUTINE SetVTKParameters(p_FAST, InitOutData_ED, InitOutData_AD, InitInData_H !........................................................................................................ ! we're going to create a box using these dimensions - y = ED%y%HubPtMotion%Position(3, 1) - ED%y%NacelleMotion%Position(3, 1) - x = TwoNorm( ED%y%HubPtMotion%Position(1:2,1) - ED%y%NacelleMotion%Position(1:2,1) ) - p_FAST%VTK_Surface%HubRad + if (p_FAST%CompElast == Module_SED) then + y = SED%y%HubPtMotion%Position(3, 1) - SED%y%NacelleMotion%Position(3, 1) + x = TwoNorm( SED%y%HubPtMotion%Position(1:2,1) - SED%y%NacelleMotion%Position(1:2,1) ) - p_FAST%VTK_Surface%HubRad + else + y = ED%y%HubPtMotion%Position(3, 1) - ED%y%NacelleMotion%Position(3, 1) + x = TwoNorm( ED%y%HubPtMotion%Position(1:2,1) - ED%y%NacelleMotion%Position(1:2,1) ) - p_FAST%VTK_Surface%HubRad + endif p_FAST%VTK_Surface%NacelleBox(:,1) = (/ -x, y, 0.0_SiKi /) @@ -3463,28 +4176,51 @@ SUBROUTINE SetVTKParameters(p_FAST, InitOutData_ED, InitOutData_AD, InitInData_H p_FAST%VTK_Surface%NacelleBox(:,8) = (/ -x, y, 2*y /) !....................... - ! tapered tower + ! Create the tower surface data !....................... + TowerMotionMesh => ED%y%TowerLn2Mesh - CALL AllocAry(p_FAST%VTK_Surface%TowerRad,ED%y%TowerLn2Mesh%NNodes,'VTK_Surface%TowerRad',ErrStat2,ErrMsg2) + CALL AllocAry(p_FAST%VTK_Surface%TowerRad,TowerMotionMesh%NNodes,'VTK_Surface%TowerRad',ErrStat2,ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) IF (ErrStat >= AbortErrLev) RETURN - topNode = ED%y%TowerLn2Mesh%NNodes - 1 - baseNode = ED%y%TowerLn2Mesh%refNode - TwrLength = TwoNorm( ED%y%TowerLn2Mesh%position(:,topNode) - ED%y%TowerLn2Mesh%position(:,baseNode) ) ! this is the assumed length of the tower - TwrRatio = TwrLength / 87.6_SiKi ! use ratio of the tower length to the length of the 5MW tower - TwrDiam_top = 3.87*TwrRatio - TwrDiam_base = 6.0*TwrRatio - - TwrRatio = 0.5 * (TwrDiam_top - TwrDiam_base) / TwrLength - do k=1,ED%y%TowerLn2Mesh%NNodes - TwrLength = TwoNorm( ED%y%TowerLn2Mesh%position(:,k) - ED%y%TowerLn2Mesh%position(:,baseNode) ) - p_FAST%VTK_Surface%TowerRad(k) = 0.5*TwrDiam_Base + TwrRatio*TwrLength - end do + IF ( p_FAST%CompAero == Module_AD .and. allocated(InitOutData_AD%rotors) .and. allocated(AD%y%rotors) ) THEN ! These meshes may have tower diameter data associated with nodes + UseADtwr = allocated(InitOutData_AD%rotors(1)%TwrDiam) + ELSE + UseADtwr = .false. + END IF + if (UseADtwr) then + + ! This assumes a vertical tower (i.e., we deal only with z component of position) + Indx = 1 + do k=1,TowerMotionMesh%NNodes + p_FAST%VTK_Surface%TowerRad(k) = InterpStp( TowerMotionMesh%Position(3,k), InitOutData_AD%rotors(1)%TwrElev, InitOutData_AD%rotors(1)%TwrDiam, Indx, size(InitOutData_AD%rotors(1)%TwrElev) ) / 2.0_ReKi + end do + + else + !....................... + ! default tapered tower, based on 5MW baseline turbine: + !....................... + + topNode = maxloc(TowerMotionMesh%position(3,:),DIM=1) + baseNode = minloc(TowerMotionMesh%position(3,:),DIM=1) + TwrLength = TwoNorm( TowerMotionMesh%position(:,topNode) - TowerMotionMesh%position(:,baseNode) ) ! this is the assumed length of the tower + TwrRatio = TwrLength / 87.6_SiKi ! use ratio of the tower length to the length of the 5MW tower + TwrDiam_top = 3.87*TwrRatio + TwrDiam_base = 6.0*TwrRatio + + TwrRatio = 0.5 * (TwrDiam_top - TwrDiam_base) / TwrLength + + do k=1,TowerMotionMesh%NNodes + TwrLength = TwoNorm( TowerMotionMesh%position(:,k) - TowerMotionMesh%position(:,baseNode) ) + p_FAST%VTK_Surface%TowerRad(k) = 0.5*TwrDiam_Base + TwrRatio*TwrLength + end do + end if + + !....................... ! blade surfaces !....................... @@ -3497,7 +4233,7 @@ SUBROUTINE SetVTKParameters(p_FAST, InitOutData_ED, InitOutData_AD, InitInData_H IF ( p_FAST%CompAero == Module_AD ) THEN ! These meshes may have airfoil data associated with nodes... IF (ALLOCATED(InitOutData_AD%rotors(1)%BladeShape)) THEN - do k=1,NumBl + do k=1,NumBl call move_alloc( InitOutData_AD%rotors(1)%BladeShape(k)%AirfoilCoords, p_FAST%VTK_Surface%BladeShape(k)%AirfoilCoords ) end do ELSE @@ -3505,11 +4241,11 @@ SUBROUTINE SetVTKParameters(p_FAST, InitOutData_ED, InitOutData_AD, InitInData_H call WrScr('Using generic blade surfaces for AeroDyn (S809 airfoil, assumed chord, twist, AC). ') rootNode = 1 - - DO K=1,NumBl + + DO K=1,NumBl tipNode = AD%Input(1)%rotors(1)%BladeMotion(K)%NNodes cylNode = min(3,AD%Input(1)%rotors(1)%BladeMotion(K)%Nnodes) - + call SetVTKDefaultBladeParams(AD%Input(1)%rotors(1)%BladeMotion(K), p_FAST%VTK_Surface%BladeShape(K), tipNode, rootNode, cylNode, 1, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -3527,6 +4263,7 @@ SUBROUTINE SetVTKParameters(p_FAST, InitOutData_ED, InitOutData_AD, InitInData_H CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) IF (ErrStat >= AbortErrLev) RETURN END DO +! ELSE IF (p_FAST%CompElast == Module_SED) THEN ! no blade surface info from SED ELSE call WrScr('Using generic blade surfaces for ElastoDyn (rectangular airfoil, constant chord). ') ! TODO make this an option DO K=1,NumBl @@ -3546,26 +4283,25 @@ SUBROUTINE SetVTKParameters(p_FAST, InitOutData_ED, InitOutData_AD, InitInData_H !....................... !bjj: interpolate here instead of each time step? - if ( allocated(InitOutData_HD%WaveElevSeries) ) then - call move_alloc( InitInData_HD%WaveElevXY, p_FAST%VTK_Surface%WaveElevXY ) - call move_alloc( InitOutData_HD%WaveElevSeries, p_FAST%VTK_Surface%WaveElev ) + if ( allocated(InitOutData_SeaSt%WaveElevVisGrid) ) then + call move_alloc( InitOutData_SeaSt%WaveElevVisX, p_FAST%VTK_Surface%WaveElevVisX ) + call move_alloc( InitOutData_SeaSt%WaveElevVisY, p_FAST%VTK_Surface%WaveElevVisY ) + call move_alloc( InitOutData_SeaSt%WaveElevVisGrid,p_FAST%VTK_Surface%WaveElevVisGrid ) ! put the following lines in loops to avoid stack-size issues: - do k=1,size(p_FAST%VTK_Surface%WaveElevXY,2) - p_FAST%VTK_Surface%WaveElevXY(:,k) = p_FAST%VTK_Surface%WaveElevXY(:,k) + p_FAST%TurbinePos(1:2) + do k=1,size(p_FAST%VTK_Surface%WaveElevVisX) + p_FAST%VTK_Surface%WaveElevVisX(k) = p_FAST%VTK_Surface%WaveElevVisX(k) + p_FAST%TurbinePos(1) + end do + do k=1,size(p_FAST%VTK_Surface%WaveElevVisY) + p_FAST%VTK_Surface%WaveElevVisY(k) = p_FAST%VTK_Surface%WaveElevVisY(k) + p_FAST%TurbinePos(2) end do - - ! note that p_FAST%TurbinePos(3) must be 0 for offshore turbines - !do k=1,size(p_FAST%VTK_Surface%WaveElev,2) - ! p_FAST%VTK_Surface%WaveElev(:,k) = p_FAST%VTK_Surface%WaveElev(:,k) + p_FAST%TurbinePos(3) ! not sure this is really accurate if p_FAST%TurbinePos(3) is non-zero - !end do end if !....................... ! morison surfaces !....................... - + IF ( HD%y%Morison%VisMesh%Committed ) THEN call move_alloc(InitOutData_HD%Morison%MorisonVisRad, p_FAST%VTK_Surface%MorisonVisRad) END IF @@ -3649,7 +4385,7 @@ SUBROUTINE SetVTKDefaultBladeParams(M, BladeShape, tipNode, rootNode, cylNode, i bladeLengthFract = 0.22*bladeLength bladeLengthFract2 = bladeLength-bladeLengthFract != 0.78*bladeLength - + ! Circle, square or rectangle, constant chord if (iShape>1) then chord = bladeLength*0.04 ! chord set to 4% of blade length @@ -3660,8 +4396,8 @@ SUBROUTINE SetVTKDefaultBladeParams(M, BladeShape, tipNode, rootNode, cylNode, i x = yc(j) y = xc(j) - 0.5 ! x,y coordinates for cylinder - BladeShape%AirfoilCoords(1,j,i) = chord*x - BladeShape%AirfoilCoords(2,j,i) = chord*y + BladeShape%AirfoilCoords(1,j,i) = chord*x + BladeShape%AirfoilCoords(2,j,i) = chord*y END DO enddo return ! We exit this routine @@ -3781,95 +4517,283 @@ SUBROUTINE WrVTK_Ground ( RefPoint, HalfLengths, FileRootName, ErrStat, ErrMsg ) END SUBROUTINE WrVTK_Ground !---------------------------------------------------------------------------------------------------------------------------------- -!> This subroutine sets up the information needed to initialize AeroDyn, then initializes AeroDyn -SUBROUTINE AD_SetInitInput(InitInData_AD14, InitOutData_ED, y_ED, p_FAST, ErrStat, ErrMsg) - +!> This subroutine sets up the information needed to initialize ExtLoads +SUBROUTINE ExtLd_SetInitInput(InitInData_ExtLd, InitOutData_ED, y_ED, InitOutData_BD, y_BD, InitOutData_AD, p_FAST, ExternInitData, ErrStat, ErrMsg) ! Passed variables: - TYPE(AD14_InitInputType),INTENT(INOUT) :: InitInData_AD14 !< The initialization input to AeroDyn14 - TYPE(ED_InitOutputType), INTENT(IN) :: InitOutData_ED !< The initialization output from structural dynamics module - TYPE(ED_OutputType), INTENT(IN) :: y_ED !< The outputs of the structural dynamics module (meshes with position/RefOrientation set) - TYPE(FAST_ParameterType),INTENT(IN) :: p_FAST !< The parameters of the glue code - INTEGER(IntKi) :: ErrStat !< Error status of the operation - CHARACTER(*) :: ErrMsg !< Error message if ErrStat /= ErrID_None + TYPE(ExtLd_InitInputType), INTENT(INOUT) :: InitInData_ExtLd !< The initialization input to ExtLoads + TYPE(ED_InitOutputType), INTENT(IN) :: InitOutData_ED !< The initialization output from structural dynamics module + TYPE(ED_OutputType), INTENT(IN) :: y_ED !< The outputs of the structural dynamics module (meshes with position/RefOrientation set) + TYPE(BD_InitOutputType), INTENT(IN) :: InitOutData_BD(:) !< The initialization output from structural dynamics module + TYPE(BD_OutputType), INTENT(IN) :: y_BD(:) !< The outputs of the structural dynamics module (meshes with position/RefOrientation set) + TYPE(AD_InitOutputType), INTENT(IN) :: InitOutData_AD !< The initialization output from AeroDyn + TYPE(FAST_ParameterType), INTENT(IN) :: p_FAST !< The parameters of the glue code + TYPE(FAST_ExternInitType), INTENT(IN) :: ExternInitData !< Initialization input data from an external source + + INTEGER(IntKi) :: ErrStat !< Error status of the operation + CHARACTER(*) :: ErrMsg !< Error message if ErrStat /= ErrID_None ! Local variables + INTEGER :: i,j,k,jLower,tmp + integer :: nNodesBladeProps, nNodesTowerProps + real(ReKi) :: rInterp + INTEGER :: nTotBldNds + INTEGER :: nMaxBldNds + REAL(ReKi) :: tmp_eta - !TYPE(AD_InitOptions) :: ADOptions ! Options for AeroDyn - - INTEGER :: K - + REAL(ReKi), ALLOCATABLE :: AD_etaNodes(:) ! Non-dimensional co-ordinates eta at which the blade and tower chord are defined ErrStat = ErrID_None ErrMsg = "" - - ! Set up the AeroDyn parameters - InitInData_AD14%ADFileName = p_FAST%AeroFile - InitInData_AD14%OutRootName = p_FAST%OutFileRoot - InitInData_AD14%WrSumFile = p_FAST%SumPrint - InitInData_AD14%NumBl = InitOutData_ED%NumBl - InitInData_AD14%UseDWM = p_FAST%UseDWM - - InitInData_AD14%DWM%IfW%InputFileName = p_FAST%InflowFile - - ! Hub position and orientation (relative here, but does not need to be) - - InitInData_AD14%TurbineComponents%Hub%Position(:) = y_ED%HubPtMotion14%Position(:,1) - y_ED%HubPtMotion14%Position(:,1) ! bjj: was 0; mesh was changed by adding p_ED%HubHt to 3rd component - InitInData_AD14%TurbineComponents%Hub%Orientation(:,:) = y_ED%HubPtMotion14%RefOrientation(:,:,1) - InitInData_AD14%TurbineComponents%Hub%TranslationVel = 0.0_ReKi ! bjj: we don't need this field - InitInData_AD14%TurbineComponents%Hub%RotationVel = 0.0_ReKi ! bjj: we don't need this field - - ! Blade root position and orientation (relative here, but does not need to be) - - IF (.NOT. ALLOCATED( InitInData_AD14%TurbineComponents%Blade ) ) THEN - ALLOCATE( InitInData_AD14%TurbineComponents%Blade( InitInData_AD14%NumBl ), STAT = ErrStat ) + InitInData_ExtLd%NumBlades = InitOutData_ED%NumBl + IF (.NOT. ALLOCATED( InitInData_ExtLd%NumBldNodes) ) THEN + ALLOCATE( InitInData_ExtLd%NumBldNodes(InitInData_ExtLd%NumBlades), STAT = ErrStat ) IF ( ErrStat /= 0 ) THEN ErrStat = ErrID_Fatal - ErrMsg = ' Error allocating space for InitInData_AD%TurbineComponents%Blade.' + ErrMsg = ' Error allocating space for InitInData_ExtLd%NumBldNodes.' RETURN ELSE ErrStat = ErrID_None !reset to ErrID_None, just in case ErrID_None /= 0 END IF END IF - DO K=1, InitInData_AD14%NumBl - InitInData_AD14%TurbineComponents%Blade(K)%Position = y_ED%BladeRootMotion14%Position(:,K) - InitInData_AD14%TurbineComponents%Blade(K)%Orientation = y_ED%BladeRootMotion14%RefOrientation(:,:,K) - InitInData_AD14%TurbineComponents%Blade(K)%TranslationVel = 0.0_ReKi ! bjj: we don't need this field - InitInData_AD14%TurbineComponents%Blade(K)%RotationVel = 0.0_ReKi ! bjj: we don't need this field - END DO - - - ! Blade length - IF (p_FAST%CompElast == Module_ED) THEN ! note, we can't get here if we're using BeamDyn.... - InitInData_AD14%TurbineComponents%BladeLength = InitOutData_ED%BladeLength + ! Blade node positions and orientations + nTotBldNds = 0 + nMaxBldNds = 0 + IF (p_FAST%CompElast == Module_ED ) THEN + nMaxBldNds = SIZE(y_ED%BladeLn2Mesh(1)%position(1,:)) + nTotBldNds = nMaxBldNds * InitInData_ExtLd%NumBlades + InitInData_ExtLd%NumBldNodes(:) = nMaxBldNds + ELSE IF (p_FAST%CompElast == Module_BD ) THEN + do k=1,InitInData_ExtLd%NumBlades + tmp = SIZE(y_BD(k)%BldMotion%position(1,:)) + nMaxBldNds = max(nMaxBldNds, tmp) + nTotBldNds = nTotBldNds + tmp + InitInData_ExtLd%NumBldNodes(k) = tmp + end do END IF - - ! Tower mesh ( here only because we currently need line2 meshes to contain the same nodes/elements ) - - InitInData_AD14%NumTwrNodes = y_ED%TowerLn2Mesh%NNodes - 2 - IF (.NOT. ALLOCATED( InitInData_AD14%TwrNodeLocs ) ) THEN - ALLOCATE( InitInData_AD14%TwrNodeLocs( 3, InitInData_AD14%NumTwrNodes ), STAT = ErrStat ) + IF (.NOT. ALLOCATED( InitInData_ExtLd%BldRootPos) ) THEN + ALLOCATE( InitInData_ExtLd%BldRootPos( 3, InitInData_ExtLd%NumBlades), STAT = ErrStat ) IF ( ErrStat /= 0 ) THEN ErrStat = ErrID_Fatal - ErrMsg = ' Error allocating space for InitInData_AD%TwrNodeLocs.' + ErrMsg = ' Error allocating space for InitInData_ExtLd%BldRootPos.' RETURN ELSE - ErrStat = ErrID_None + ErrStat = ErrID_None !reset to ErrID_None, just in case ErrID_None /= 0 END IF END IF - IF ( InitInData_AD14%NumTwrNodes > 0 ) THEN - InitInData_AD14%TwrNodeLocs = y_ED%TowerLn2Mesh%Position(:,1:InitInData_AD14%NumTwrNodes) ! ED has extra nodes at beginning and top and bottom of tower + IF (.NOT. ALLOCATED( InitInData_ExtLd%BldRootOrient) ) THEN + ALLOCATE( InitInData_ExtLd%BldRootOrient( 3, 3, InitInData_ExtLd%NumBlades), STAT = ErrStat ) + IF ( ErrStat /= 0 ) THEN + ErrStat = ErrID_Fatal + ErrMsg = ' Error allocating space for InitInData_ExtLd%BldRootOrient.' + RETURN + ELSE + ErrStat = ErrID_None !reset to ErrID_None, just in case ErrID_None /= 0 + END IF END IF - ! hub height - InitInData_AD14%HubHt = InitOutData_ED%HubHt - + IF (.NOT. ALLOCATED( InitInData_ExtLd%BldPos) ) THEN + ALLOCATE( InitInData_ExtLd%BldPos( 3, nMaxBldNds, InitInData_ExtLd%NumBlades), STAT = ErrStat ) + IF ( ErrStat /= 0 ) THEN + ErrStat = ErrID_Fatal + ErrMsg = ' Error allocating space for InitInData_ExtLd%BldPos.' + RETURN + ELSE + ErrStat = ErrID_None !reset to ErrID_None, just in case ErrID_None /= 0 + END IF + END IF - RETURN -END SUBROUTINE AD_SetInitInput + IF (.NOT. ALLOCATED( InitInData_ExtLd%BldOrient) ) THEN + ALLOCATE( InitInData_ExtLd%BldOrient( 3, 3, nMaxBldNds, InitInData_ExtLd%NumBlades), STAT = ErrStat ) + IF ( ErrStat /= 0 ) THEN + ErrStat = ErrID_Fatal + ErrMsg = ' Error allocating space for InitInData_ExtLd%BldOrient.' + RETURN + ELSE + ErrStat = ErrID_None !reset to ErrID_None, just in case ErrID_None /= 0 + END IF + END IF + + IF (p_FAST%CompElast == Module_ED ) THEN + DO k=1,InitInData_ExtLd%NumBlades + InitInData_ExtLd%BldRootPos(:,k) = y_ED%BladeRootMotion(k)%position(:,1) + InitInData_ExtLd%BldRootOrient(:,:,k) = y_ED%BladeRootMotion(k)%RefOrientation(:,:,1) + !Deal with the weird node ordering in ElastoDyn where the blade root is the last node + InitInData_ExtLd%BldPos(:,1,k) = y_ED%BladeLn2Mesh(k)%position(:,nMaxBldNds) + InitInData_ExtLd%BldOrient(:,:,1,k) = y_ED%BladeLn2Mesh(k)%RefOrientation(:,:,nMaxBldNds) + !Now fill in the rest of the nodes + InitInData_ExtLd%BldPos(:,2:nMaxBldNds,k) = y_ED%BladeLn2Mesh(k)%position(:,1:nMaxBldNds-1) + InitInData_ExtLd%BldOrient(:,:,2:nMaxBldNds,k) = y_ED%BladeLn2Mesh(k)%RefOrientation(:,:,1:nMaxBldNds-1) + END DO + ELSE IF (p_FAST%CompElast == Module_BD ) THEN + DO k=1,InitInData_ExtLd%NumBlades + InitInData_ExtLd%BldRootPos(:,k) = y_ED%BladeRootMotion(k)%position(:,1) + InitInData_ExtLd%BldRootOrient(:,:,k) = y_ED%BladeRootMotion(k)%RefOrientation(:,:,1) + InitInData_ExtLd%BldPos(:,:,k) = y_BD(k)%BldMotion%position(:,:) + InitInData_ExtLd%BldOrient(:,:,:,k) = y_BD(k)%BldMotion%RefOrientation(:,:,:) + END DO + END IF + + IF (.NOT. ALLOCATED( InitInData_ExtLd%BldRloc) ) THEN + ALLOCATE( InitInData_ExtLd%BldRloc( nMaxBldNds, InitInData_ExtLd%NumBlades), STAT = ErrStat ) + IF ( ErrStat /= 0 ) THEN + ErrStat = ErrID_Fatal + ErrMsg = ' Error allocating space for InitInData_ExtLd%BldRloc.' + RETURN + ELSE + ErrStat = ErrID_None !reset to ErrID_None, just in case ErrID_None /= 0 + END IF + END IF + + do k=1,InitInData_ExtLd%NumBlades + InitInData_ExtLd%BldRloc(1,k) = 0.0 + do j = 2, InitInData_ExtLd%NumBldNodes(k) + InitInData_ExtLd%BldRloc(j,k) = InitInData_ExtLd%BldRloc(j-1,k) + TwoNorm(InitInData_ExtLd%BldPos(:,j,k) - InitInData_ExtLd%BldPos(:,j-1,k)) + end do + end do + + ! Tower mesh + InitInData_ExtLd%TwrAero = .true. + if (InitInData_ExtLd%TwrAero) then + InitInData_ExtLd%NumTwrNds = y_ED%TowerLn2Mesh%NNodes + IF ( InitInData_ExtLd%NumTwrNds > 0 ) THEN + + IF (.NOT. ALLOCATED( InitInData_ExtLd%TwrPos ) ) THEN + ALLOCATE( InitInData_ExtLd%TwrPos( 3, InitInData_ExtLd%NumTwrNds ), STAT = ErrStat ) + IF ( ErrStat /= 0 ) THEN + ErrStat = ErrID_Fatal + ErrMsg = ' Error allocating space for InitInData_AD%TwrNodeLocs.' + RETURN + ELSE + ErrStat = ErrID_None + END IF + END IF + IF (.NOT. ALLOCATED( InitInData_ExtLd%TwrOrient ) ) THEN + ALLOCATE( InitInData_ExtLd%TwrOrient( 3, 3, InitInData_ExtLd%NumTwrNds ), STAT = ErrStat ) + IF ( ErrStat /= 0 ) THEN + ErrStat = ErrID_Fatal + ErrMsg = ' Error allocating space for InitInData_AD%TwrOrient.' + RETURN + ELSE + ErrStat = ErrID_None + END IF + END IF + + ! For some reason, ElastoDyn keeps the last point as the blade/tower root + InitInData_ExtLd%TwrPos(:,1) = y_ED%TowerLn2Mesh%Position(:,InitInData_ExtLd%NumTwrNds) + InitInData_ExtLd%TwrOrient(:,:,1) = y_ED%TowerLn2Mesh%RefOrientation(:,:,InitInData_ExtLd%NumTwrNds) + ! Now fill in rest of the nodes + InitInData_ExtLd%TwrPos(:,2:InitInData_ExtLd%NumTwrNds) = y_ED%TowerLn2Mesh%Position(:,1:InitInData_ExtLd%NumTwrNds-1) + InitInData_ExtLd%TwrOrient(:,:,2:InitInData_ExtLd%NumTwrNds) = y_ED%TowerLn2Mesh%RefOrientation(:,:,1:InitInData_ExtLd%NumTwrNds-1) + + IF (.NOT. ALLOCATED( InitInData_ExtLd%TwrDia ) ) THEN + ALLOCATE( InitInData_ExtLd%TwrDia( InitInData_ExtLd%NumTwrNds ), STAT = ErrStat ) + IF ( ErrStat /= 0 ) THEN + ErrStat = ErrID_Fatal + ErrMsg = ' Error allocating space for InitInData_AD%TwrDia.' + RETURN + ELSE + ErrStat = ErrID_None + END IF + END IF + + IF (.NOT. ALLOCATED( InitInData_ExtLd%TwrHloc ) ) THEN + ALLOCATE( InitInData_ExtLd%TwrHloc( InitInData_ExtLd%NumTwrNds ), STAT = ErrStat ) + IF ( ErrStat /= 0 ) THEN + ErrStat = ErrID_Fatal + ErrMsg = ' Error allocating space for InitInData_AD%TwrHloc.' + RETURN + ELSE + ErrStat = ErrID_None + END IF + END IF + + InitInData_ExtLd%TwrHloc(1) = 0.0 + do j = 2, InitInData_ExtLd%NumTwrNds + InitInData_ExtLd%TwrHloc(j) = InitInData_ExtLd%TwrHloc(j-1) + TwoNorm(InitInData_ExtLd%TwrPos(:,j) - InitInData_ExtLd%TwrPos(:,j-1)) + end do + END IF + + else + + InitInData_ExtLd%NumTwrNds = 0 + + end if + + InitInData_ExtLd%HubPos = y_ED%HubPtMotion%Position(:,1) + InitInData_ExtLd%HubOrient = y_ED%HubPtMotion%RefOrientation(:,:,1) + + InitInData_ExtLd%NacellePos = y_ED%NacelleMotion%Position(:,1) + InitInData_ExtLd%NacelleOrient = y_ED%NacelleMotion%RefOrientation(:,:,1) + + InitInData_ExtLd%az_blend_mean = ExternInitData%az_blend_mean + InitInData_ExtLd%az_blend_delta = ExternInitData%az_blend_delta + + !Interpolate chord from AeroDyn to nodes of the ExtLoads module + IF (.NOT. ALLOCATED( InitInData_ExtLd%BldChord) ) THEN + ALLOCATE( InitInData_ExtLd%BldChord(nMaxBldNds, InitInData_ExtLd%NumBlades), STAT = ErrStat ) + IF ( ErrStat /= 0 ) THEN + ErrStat = ErrID_Fatal + ErrMsg = ' Error allocating space for InitInData_ExtLd%BldRootPos.' + RETURN + ELSE + ErrStat = ErrID_None !reset to ErrID_None, just in case ErrID_None /= 0 + END IF + END IF + + ! The blades first + do k = 1, InitInData_ExtLd%NumBlades + ! Calculate the chord at the force nodes based on interpolation + nNodesBladeProps = SIZE(InitOutData_AD%rotors(1)%BladeProps(k)%BlChord) + allocate(AD_etaNodes(nNodesBladeProps)) + AD_etaNodes = InitOutData_AD%rotors(1)%BladeProps(k)%BlSpn(:)/InitOutData_AD%rotors(1)%BladeProps(k)%BlSpn(nNodesBladeProps) + do i=1,InitInData_ExtLd%NumBldNodes(k) + jLower=1 + tmp_eta = InitInData_ExtLd%BldRloc(i,k)/InitInData_ExtLd%BldRloc(InitInData_ExtLd%NumBldNodes(k),k) + do while ( ( (AD_etaNodes(jLower) - tmp_eta)*(AD_etaNodes(jLower+1) - tmp_eta) .gt. 0 ) .and. (jLower .lt. nNodesBladeProps) )!Determine the closest two nodes at which the blade properties are specified + jLower = jLower + 1 + end do + if (jLower .lt. nNodesBladeProps) then + rInterp = (tmp_eta - AD_etaNodes(jLower))/(AD_etaNodes(jLower+1)-AD_etaNodes(jLower)) ! The location of this force node in (0,1) co-ordinates between the jLower and jLower+1 nodes + InitInData_ExtLd%BldChord(i,k) = InitOutData_AD%rotors(1)%BladeProps(k)%BlChord(jLower) + rInterp * (InitOutData_AD%rotors(1)%BladeProps(k)%BlChord(jLower+1) - InitOutData_AD%rotors(1)%BladeProps(k)%BlChord(jLower)) + else + InitInData_ExtLd%BldChord(i,k) = InitOutData_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 + deallocate(AD_etaNodes) + end do + + ! The tower now + if ( InitInData_ExtLd%NumTwrNds > 0 ) then + nNodesTowerProps = SIZE(InitOutData_AD%rotors(1)%TwrElev) + allocate(AD_etaNodes(nNodesTowerProps)) + ! Calculate the chord at the force nodes based on interpolation + AD_etaNodes = InitOutData_AD%rotors(1)%TwrElev(:)/InitOutData_AD%rotors(1)%TwrElev(nNodesTowerProps) ! Non-dimensionalize the tower elevation array + do i=1,InitInData_ExtLd%NumTwrNds + tmp_eta = InitInData_ExtLd%TwrHloc(i)/InitInData_ExtLd%TwrHloc(InitInData_ExtLd%NumTwrNds) + do jLower = 1, nNodesTowerProps - 1 + if ((AD_etaNodes(jLower) - tmp_eta)*(AD_etaNodes(jLower+1) - tmp_eta) <= 0) exit + end do + if (jLower .lt. nNodesTowerProps) then + rInterp = (tmp_eta - AD_etaNodes(jLower))/(AD_etaNodes(jLower+1)-AD_etaNodes(jLower)) ! The location of this force node in (0,1) co-ordinates between the jLower and jLower+1 nodes + InitInData_ExtLd%TwrDia(i) = InitOutData_AD%rotors(1)%TwrDiam(jLower) + rInterp * (InitOutData_AD%rotors(1)%TwrDiam(jLower+1) - InitOutData_AD%rotors(1)%TwrDiam(jLower)) + else + InitInData_ExtLd%TwrDia(i) = InitOutData_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 + deallocate(AD_etaNodes) + end if + + ! Total number of nodes velocity is needed at + InitInData_ExtLd%nNodesVel = InitOutData_AD%nNodesVel + + + RETURN + +END SUBROUTINE ExtLd_SetInitInput !---------------------------------------------------------------------------------------------------------------------------------- !> This routine sets the number of subcycles (substeps) for modules at initialization, checking to make sure that their requested !! time step is valid. @@ -3948,13 +4872,25 @@ SUBROUTINE FAST_WrSum( p_FAST, y_FAST, MeshMapData, ErrStat, ErrMsg ) WRITE (y_FAST%UnSum,'(/A)') 'FAST Summary File' WRITE (y_FAST%UnSum,'(/A)') TRIM( y_FAST%FileDescLines(1) ) - WRITE (y_FAST%UnSum,'(2X,A)' ) 'compiled with' + WRITE (y_FAST%UnSum,'(2X,A)' ) 'run with' Fmt = '(4x,A)' WRITE (y_FAST%UnSum,Fmt) TRIM( GetNVD( NWTC_Ver ) ) - WRITE (y_FAST%UnSum,Fmt) TRIM( GetNVD( y_FAST%Module_Ver( Module_ED ) ) ) - DescStr = GetNVD( y_FAST%Module_Ver( Module_BD ) ) - IF ( p_FAST%CompElast /= Module_BD ) DescStr = TRIM(DescStr)//NotUsedTxt + DescStr = GetNVD( y_FAST%Module_Ver( Module_ED ) ) + IF ((p_FAST%CompElast /= Module_ED) .or. (p_FAST%CompElast /= Module_BD)) DescStr = TRIM(DescStr)//NotUsedTxt + WRITE (y_FAST%UnSum,Fmt) TRIM( DescStr ) + + DO I = 2,NumModules + IF (p_FAST%ModuleInitialized(I)) THEN + WRITE (y_FAST%UnSum,Fmt) TRIM( GetNVD( y_FAST%Module_Ver( I ) ) ) + !ELSE + ! DescStr = GetNVD( y_FAST%Module_Ver( I ) ) + ! WRITE (y_FAST%UnSum,Fmt) TRIM( DescStr )//NotUsedTxt + END IF + END DO + + DescStr = GetNVD( y_FAST%Module_Ver( Module_SED ) ) + IF ( p_FAST%CompElast /= Module_SED ) DescStr = TRIM(DescStr)//NotUsedTxt WRITE (y_FAST%UnSum,Fmt) TRIM( DescStr ) DescStr = GetNVD( y_FAST%Module_Ver( Module_IfW ) ) @@ -3966,14 +4902,14 @@ SUBROUTINE FAST_WrSum( p_FAST, y_FAST, MeshMapData, ErrStat, ErrMsg ) !IF ( p_FAST%CompInflow /= Module_OpFM ) DescStr = TRIM(DescStr)//NotUsedTxt !WRITE (y_FAST%UnSum,Fmt) TRIM( DescStr ) - DescStr = GetNVD( y_FAST%Module_Ver( Module_AD14 ) ) - IF ( p_FAST%CompAero /= Module_AD14 ) DescStr = TRIM(DescStr)//NotUsedTxt - WRITE (y_FAST%UnSum,Fmt) TRIM( DescStr ) - DescStr = GetNVD( y_FAST%Module_Ver( Module_AD ) ) IF ( p_FAST%CompAero /= Module_AD ) DescStr = TRIM(DescStr)//NotUsedTxt WRITE (y_FAST%UnSum,Fmt) TRIM( DescStr ) + DescStr = GetNVD( y_FAST%Module_Ver( Module_ADsk ) ) + IF ( p_FAST%CompAero /= Module_ADsk ) DescStr = TRIM(DescStr)//NotUsedTxt + WRITE (y_FAST%UnSum,Fmt) TRIM( DescStr ) + DescStr = GetNVD( y_FAST%Module_Ver( Module_SrvD ) ) IF ( p_FAST%CompServo /= Module_SrvD ) DescStr = TRIM(DescStr)//NotUsedTxt WRITE (y_FAST%UnSum,Fmt) TRIM( DescStr ) @@ -4023,22 +4959,6 @@ SUBROUTINE FAST_WrSum( p_FAST, y_FAST, MeshMapData, ErrStat, ErrMsg ) ! output file format (text/binary) ! coupling method - SELECT CASE ( p_FAST%TurbineType ) - CASE ( Type_LandBased ) - DescStr = 'Modeling a land-based turbine' - CASE ( Type_Offshore_Fixed ) - DescStr = 'Modeling a fixed-bottom offshore turbine' - CASE ( Type_Offshore_Floating ) - DescStr = 'Modeling a floating offshore turbine' - CASE ( Type_MHK_Fixed ) - DescStr = 'Modeling a fixed-bottom MHK turbine' - CASE ( Type_MHK_Floating ) - DescStr = 'Modeling a floating MHK turbine' - CASE DEFAULT ! This should never happen - DescStr="" - END SELECT - WRITE(y_FAST%UnSum,'(//A)') TRIM(DescStr) - WRITE (y_FAST%UnSum,'(A)' ) 'Description from the FAST input file: ' WRITE (y_FAST%UnSum,'(2X,A)') TRIM(p_FAST%FTitle) @@ -4162,14 +5082,14 @@ SUBROUTINE FAST_Solution0_T(Turbine, ErrStat, ErrMsg) CALL FAST_Solution0(Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & - Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD14, Turbine%AD, Turbine%IfW, Turbine%OpFM, Turbine%SC_DX,& - Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & + Turbine%ED, Turbine%SED, Turbine%BD, Turbine%SrvD, Turbine%AD, Turbine%ADsk, Turbine%ExtLd, Turbine%IfW, Turbine%ExtInfw, Turbine%SC_DX,& + Turbine%SeaSt, Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat, ErrMsg ) END SUBROUTINE FAST_Solution0_T !---------------------------------------------------------------------------------------------------------------------------------- !> Routine that calls CalcOutput for the first time of the simulation (at t=0). After the initial solve, data arrays are initialized. -SUBROUTINE FAST_Solution0(p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, OpFM, SC_DX, HD, SD, ExtPtfm, & +SUBROUTINE FAST_Solution0(p_FAST, y_FAST, m_FAST, ED, SED, BD, SrvD, AD, ADsk, ExtLd, IfW, ExtInfw, SC_DX, SeaSt, HD, SD, ExtPtfm, & MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat, ErrMsg ) TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code @@ -4177,13 +5097,16 @@ SUBROUTINE FAST_Solution0(p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, O TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data + TYPE(SED_Data), INTENT(INOUT) :: SED !< Simplified-ElastoDyn data TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data - TYPE(AeroDyn14_Data), INTENT(INOUT) :: AD14 !< AeroDyn14 data TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data + TYPE(AeroDisk_Data), INTENT(INOUT) :: ADsk !< AeroDisk data + TYPE(ExtLoads_Data), INTENT(INOUT) :: ExtLd !< ExtLoads data TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data - TYPE(OpenFOAM_Data), INTENT(INOUT) :: OpFM !< OpenFOAM data + TYPE(ExternalInflow_Data),INTENT(INOUT) :: ExtInfw !< ExternalInflow data TYPE(SCDataEx_Data), INTENT(INOUT) :: SC_DX !< Supercontroller exchange data + TYPE(SeaState_Data), INTENT(INOUT) :: SeaSt !< SeaState data TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HydroDyn data TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SubDyn data TYPE(ExtPtfm_Data), INTENT(INOUT) :: ExtPtfm !< ExtPtfm_MCKF data @@ -4227,10 +5150,15 @@ SUBROUTINE FAST_Solution0(p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, O ! the initial ServoDyn and IfW/Lidar inputs from Simulink: IF ( p_FAST%CompServo == Module_SrvD ) CALL SrvD_SetExternalInputs( p_FAST, m_FAST, SrvD%Input(1) ) - - + + if ( P_FAST%CompSeaSt == Module_SeaSt .and. y_FAST%WriteThisStep) then + ! note: SeaState has no inputs and only calculates WriteOutputs, so we don't need to call CalcOutput unless we are writing to the file + call SeaSt_CalcOutput( t_initial, SeaSt%u, SeaSt%p, SeaSt%x(1), SeaSt%xd(1), SeaSt%z(1), SeaSt%OtherSt(1), SeaSt%y, SeaSt%m, ErrStat2, ErrMsg2 ) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + end if + CALL CalcOutputs_And_SolveForInputs( n_t_global, t_initial, STATE_CURR, m_FAST%calcJacobian, m_FAST%NextJacCalcTime, & - p_FAST, m_FAST, y_FAST%WriteThisStep, ED, BD, SrvD, AD14, AD, IfW, OpFM, HD, SD, ExtPtfm, & + p_FAST, m_FAST, y_FAST%WriteThisStep, ED, SED, BD, SrvD, AD, ADsk, ExtLd, IfW, ExtInfw, HD, SD, ExtPtfm, & MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -4243,14 +5171,14 @@ SUBROUTINE FAST_Solution0(p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, O ! Check to see if we should output data this time step: !---------------------------------------------------------------------------------------- - CALL WriteOutputToFile(n_t_global_next, t_initial, p_FAST, y_FAST, ED, BD, AD14, AD, IfW, OpFM, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2) + CALL WriteOutputToFile(n_t_global_next, t_initial, p_FAST, y_FAST, ED, SED, BD, AD, ADsk, IfW, ExtInfw, SeaSt, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ! turn off VTK output when if (p_FAST%WrVTK == VTK_InitOnly) then ! Write visualization data for initialization (and also note that we're ignoring any errors that occur doing so) - call WriteVTK(t_initial, p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, OpFM, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) + call WriteVTK(t_initial, p_FAST, y_FAST, MeshMapData, ED, SED, BD, AD, IfW, ExtInfw, SeaSt, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) end if @@ -4262,7 +5190,7 @@ SUBROUTINE FAST_Solution0(p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, O ! Initialize Input-Output arrays for interpolation/extrapolation: - CALL FAST_InitIOarrays( m_FAST%t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, HD, SD, ExtPtfm, & + CALL FAST_InitIOarrays( m_FAST%t_global, p_FAST, y_FAST, m_FAST, ED, SED, BD, SrvD, AD, ADsk, IfW, HD, SD, ExtPtfm, & MAPp, FEAM, MD, Orca, IceF, IceD, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -4272,7 +5200,7 @@ END SUBROUTINE FAST_Solution0 !> This routine initializes the input and output arrays stored for extrapolation. They are initialized after the first input-output solve so that the first !! extrapolations are used with values from the solution, not just initial guesses. It also creates new copies of the state variables, which need to !! be stored for the predictor-corrector loop. -SUBROUTINE FAST_InitIOarrays( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, HD, SD, ExtPtfm, & +SUBROUTINE FAST_InitIOarrays( t_initial, p_FAST, y_FAST, m_FAST, ED, SED, BD, SrvD, AD, ADsk, IfW, HD, SD, ExtPtfm, & MAPp, FEAM, MD, Orca, IceF, IceD, ErrStat, ErrMsg ) REAL(DbKi), INTENT(IN ) :: t_initial !< start time of the simulation @@ -4281,10 +5209,11 @@ SUBROUTINE FAST_InitIOarrays( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, A TYPE(FAST_MiscVarType), INTENT(IN ) :: m_FAST !< Miscellaneous variables TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data + TYPE(SED_Data), INTENT(INOUT) :: SED !< Simplified-ElastoDyn data TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data - TYPE(AeroDyn14_Data), INTENT(INOUT) :: AD14 !< AeroDyn v14 data TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data + TYPE(AeroDisk_Data), INTENT(INOUT) :: ADsk !< AeroDisk data TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HydroDyn data TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SubDyn data @@ -4309,33 +5238,56 @@ SUBROUTINE FAST_InitIOarrays( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, A ErrStat = ErrID_None ErrMsg = "" - ! We fill ED%InputTimes with negative times, but the ED%Input values are identical for each of those times; this allows + ! We fill (S)ED%InputTimes with negative times, but the (S)ED%Input values are identical for each of those times; this allows ! us to use, e.g., quadratic interpolation that effectively acts as a zeroth-order extrapolation and first-order extrapolation ! for the first and second time steps. (The interpolation order in the ExtrapInput routines are determined as ! order = SIZE(ED%Input) - - - DO j = 1, p_FAST%InterpOrder + 1 - ED%InputTimes(j) = t_initial - (j - 1) * p_FAST%dt - END DO - - DO j = 2, p_FAST%InterpOrder + 1 - CALL ED_CopyInput (ED%Input(1), ED%Input(j), MESH_NEWCOPY, Errstat2, ErrMsg2) + + IF (p_FAST%CompElast == Module_SED) THEN + DO j = 1, p_FAST%InterpOrder + 1 + SED%InputTimes(j) = t_initial - (j - 1) * p_FAST%dt + END DO + + DO j = 2, p_FAST%InterpOrder + 1 + CALL SED_CopyInput (SED%Input(1), SED%Input(j), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + CALL SED_CopyInput (SED%Input(1), SED%u, MESH_NEWCOPY, Errstat2, ErrMsg2) ! do this to initialize meshes/allocatable arrays for output of ExtrapInterp routine CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - CALL ED_CopyInput (ED%Input(1), ED%u, MESH_NEWCOPY, Errstat2, ErrMsg2) ! do this to initialize meshes/allocatable arrays for output of ExtrapInterp routine - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! Initialize predicted states for j_pc loop: - CALL ED_CopyContState (ED%x( STATE_CURR), ED%x( STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ED_CopyDiscState (ED%xd(STATE_CURR), ED%xd(STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ED_CopyConstrState (ED%z( STATE_CURR), ED%z( STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ED_CopyOtherState (ED%OtherSt( STATE_CURR), ED%OtherSt( STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - + + ! Initialize predicted states for j_pc loop: + CALL SED_CopyContState (SED%x( STATE_CURR), SED%x( STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SED_CopyDiscState (SED%xd(STATE_CURR), SED%xd(STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SED_CopyConstrState (SED%z( STATE_CURR), SED%z( STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SED_CopyOtherState (SED%OtherSt( STATE_CURR), SED%OtherSt( STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ELSE + + DO j = 1, p_FAST%InterpOrder + 1 + ED%InputTimes(j) = t_initial - (j - 1) * p_FAST%dt + END DO + + DO j = 2, p_FAST%InterpOrder + 1 + CALL ED_CopyInput (ED%Input(1), ED%Input(j), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + CALL ED_CopyInput (ED%Input(1), ED%u, MESH_NEWCOPY, Errstat2, ErrMsg2) ! do this to initialize meshes/allocatable arrays for output of ExtrapInterp routine + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ! Initialize predicted states for j_pc loop: + CALL ED_CopyContState (ED%x( STATE_CURR), ED%x( STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ED_CopyDiscState (ED%xd(STATE_CURR), ED%xd(STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ED_CopyConstrState (ED%z( STATE_CURR), ED%z( STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ED_CopyOtherState (ED%OtherSt( STATE_CURR), ED%OtherSt( STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ENDIF IF (p_FAST%CompElast == Module_BD ) THEN @@ -4397,54 +5349,54 @@ SUBROUTINE FAST_InitIOarrays( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, A END IF ! CompServo - IF ( p_FAST%CompAero == Module_AD14 ) THEN + IF ( (p_FAST%CompAero == Module_AD) .or. (p_FAST%CompAero == Module_ExtLd) ) THEN ! Copy values for interpolation/extrapolation: DO j = 1, p_FAST%InterpOrder + 1 - AD14%InputTimes(j) = t_initial - (j - 1) * p_FAST%dt + AD%InputTimes(j) = t_initial - (j - 1) * p_FAST%dt END DO DO j = 2, p_FAST%InterpOrder + 1 - CALL AD14_CopyInput (AD14%Input(1), AD14%Input(j), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL AD_CopyInput (AD%Input(1), AD%Input(j), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO - CALL AD14_CopyInput (AD14%Input(1), AD14%u, MESH_NEWCOPY, Errstat2, ErrMsg2) ! do this to initialize meshes/allocatable arrays for output of ExtrapInterp routine + CALL AD_CopyInput (AD%Input(1), AD%u, MESH_NEWCOPY, Errstat2, ErrMsg2) ! do this to initialize meshes/allocatable arrays for output of ExtrapInterp routine CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ! Initialize predicted states for j_pc loop: - CALL AD14_CopyContState (AD14%x( STATE_CURR), AD14%x( STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL AD_CopyContState(AD%x(STATE_CURR), AD%x(STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AD14_CopyDiscState (AD14%xd(STATE_CURR), AD14%xd(STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL AD_CopyDiscState(AD%xd(STATE_CURR), AD%xd(STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AD14_CopyConstrState (AD14%z( STATE_CURR), AD14%z( STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL AD_CopyConstrState(AD%z(STATE_CURR), AD%z(STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AD14_CopyOtherState( AD14%OtherSt(STATE_CURR), AD14%OtherSt(STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL AD_CopyOtherState(AD%OtherSt(STATE_CURR), AD%OtherSt(STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ELSEIF ( p_FAST%CompAero == Module_AD ) THEN + ELSEIF ( p_FAST%CompAero == Module_ADsk ) THEN ! Copy values for interpolation/extrapolation: DO j = 1, p_FAST%InterpOrder + 1 - AD%InputTimes(j) = t_initial - (j - 1) * p_FAST%dt + ADsk%InputTimes(j) = t_initial - (j - 1) * p_FAST%dt END DO DO j = 2, p_FAST%InterpOrder + 1 - CALL AD_CopyInput (AD%Input(1), AD%Input(j), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL ADsk_CopyInput (ADsk%Input(1), ADsk%Input(j), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO - CALL AD_CopyInput (AD%Input(1), AD%u, MESH_NEWCOPY, Errstat2, ErrMsg2) ! do this to initialize meshes/allocatable arrays for output of ExtrapInterp routine + CALL ADsk_CopyInput (ADsk%Input(1), ADsk%u, MESH_NEWCOPY, Errstat2, ErrMsg2) ! do this to initialize meshes/allocatable arrays for output of ExtrapInterp routine CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ! Initialize predicted states for j_pc loop: - CALL AD_CopyContState(AD%x(STATE_CURR), AD%x(STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL ADsk_CopyContState (ADsk%x( STATE_CURR), ADsk%x( STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AD_CopyDiscState(AD%xd(STATE_CURR), AD%xd(STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL ADsk_CopyDiscState (ADsk%xd(STATE_CURR), ADsk%xd(STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AD_CopyConstrState(AD%z(STATE_CURR), AD%z(STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL ADsk_CopyConstrState (ADsk%z( STATE_CURR), ADsk%z( STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AD_CopyOtherState(AD%OtherSt(STATE_CURR), AD%OtherSt(STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL ADsk_CopyOtherState( ADsk%OtherSt(STATE_CURR), ADsk%OtherSt(STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END IF ! CompAero == Module_AD @@ -4725,127 +5677,1967 @@ SUBROUTINE FAST_InitIOarrays( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, A END SUBROUTINE FAST_InitIOarrays !---------------------------------------------------------------------------------------------------------------------------------- -!> Routine that calls FAST_Solution for one instance of a Turbine data structure. This is a separate subroutine so that the FAST +!> Routine that calls FAST_InitIOarrays_SubStep for one instance of a Turbine data structure. This is a separate subroutine so that the FAST !! driver programs do not need to change or operate on the individual module level. -SUBROUTINE FAST_Solution_T(t_initial, n_t_global, Turbine, ErrStat, ErrMsg ) +SUBROUTINE FAST_InitIOarrays_SubStep_T(t_initial, Turbine, ErrStat, ErrMsg ) - REAL(DbKi), INTENT(IN ) :: t_initial !< initial time - INTEGER(IntKi), INTENT(IN ) :: n_t_global !< loop counter - TYPE(FAST_TurbineType), INTENT(INOUT) :: Turbine !< all data for one instance of a turbine - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + REAL(DbKi), INTENT(IN ) :: t_initial !< start time of the simulation + TYPE(FAST_TurbineType), INTENT(INOUT) :: Turbine !< all data for one instance of a turbine + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - CALL FAST_Solution(t_initial, n_t_global, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & - Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD14, Turbine%AD, Turbine%IfW, Turbine%OpFM, Turbine%SC_DX, & - Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & - Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat, ErrMsg ) + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_InitIOarrays_SubStep_T' -END SUBROUTINE FAST_Solution_T -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine takes data from n_t_global and gets values at n_t_global + 1 -SUBROUTINE FAST_Solution(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, OpFM, SC_DX, HD, SD, ExtPtfm, & - MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat, ErrMsg ) + CALL FAST_InitIOarrays_SubStep(t_initial, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & + Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD, Turbine%ExtLd, Turbine%IfW, & + Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & + Turbine%IceF, Turbine%IceD, ErrStat2, ErrMsg2 ) - REAL(DbKi), INTENT(IN ) :: t_initial !< initial time - INTEGER(IntKi), INTENT(IN ) :: n_t_global !< loop counter + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + +END SUBROUTINE FAST_InitIOarrays_SubStep_T +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine initializes the input and output arrays stored for extrapolation when used in a sub-timestepping mode with an external driver program. They are initialized after the first input-output solve so that the first +!! extrapolations are used with values from the solution, not just initial guesses. It also creates new copies of the state variables, which need to +!! be stored for the predictor-corrector loop. +SUBROUTINE FAST_InitIOarrays_SubStep( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, ExtLd, IfW, HD, SD, ExtPtfm, & + MAPp, FEAM, MD, Orca, IceF, IceD, ErrStat, ErrMsg ) + REAL(DbKi), INTENT(IN ) :: t_initial !< start time of the simulation TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code - TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Output variables for the glue code - TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables + TYPE(FAST_OutputFileType),INTENT(IN ) :: y_FAST !< Output variables for the glue code + TYPE(FAST_MiscVarType), INTENT(IN ) :: m_FAST !< Miscellaneous variables TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data - TYPE(AeroDyn14_Data), INTENT(INOUT) :: AD14 !< AeroDyn14 data TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data + TYPE(ExtLoads_Data), INTENT(INOUT) :: ExtLd !< ExtLoads data TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data - TYPE(OpenFOAM_Data), INTENT(INOUT) :: OpFM !< OpenFOAM data - TYPE(SCDataEx_Data), INTENT(INOUT) :: SC_DX !< Supercontroller Exchange data TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HydroDyn data TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SubDyn data TYPE(ExtPtfm_Data), INTENT(INOUT) :: ExtPtfm !< ExtPtfm_MCKF data TYPE(MAP_Data), INTENT(INOUT) :: MAPp !< MAP data TYPE(FEAMooring_Data), INTENT(INOUT) :: FEAM !< FEAMooring data - TYPE(MoorDyn_Data), INTENT(INOUT) :: MD !< Data for the MoorDyn module + TYPE(MoorDyn_Data), INTENT(INOUT) :: MD !< MoorDyn data TYPE(OrcaFlex_Data), INTENT(INOUT) :: Orca !< OrcaFlex interface data TYPE(IceFloe_Data), INTENT(INOUT) :: IceF !< IceFloe data TYPE(IceDyn_Data), INTENT(INOUT) :: IceD !< All the IceDyn data used in time-step loop - TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules - 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_global_next ! next simulation time (m_FAST%t_global + p_FAST%dt) - INTEGER(IntKi) :: n_t_global_next ! n_t_global + 1 - INTEGER(IntKi) :: j_pc ! predictor-corrector loop counter - INTEGER(IntKi) :: NumCorrections ! number of corrections for this time step - INTEGER(IntKi), parameter :: MaxCorrections = 20 ! maximum number of corrections allowed - LOGICAL :: WriteThisStep ! Whether WriteOutput values will be printed + INTEGER(IntKi) :: i, j, k ! loop counters + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_InitIOarrays_SubStep' - INTEGER(IntKi) :: I, k ! generic loop counters - !REAL(ReKi) :: ControlInputGuess ! value of controller inputs + ErrStat = ErrID_None + ErrMsg = "" + ! We fill ED%InputTimes with negative times, but the ED%Input values are identical for each of those times; this allows + ! us to use, e.g., quadratic interpolation that effectively acts as a zeroth-order extrapolation and first-order extrapolation + ! for the first and second time steps. (The interpolation order in the ExtrapInput routines are determined as + ! order = SIZE(ED%Input) - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_Solution' + DO j = 1, p_FAST%InterpOrder + 1 + ED%InputTimes_Saved(j) = t_initial - (j - 1) * p_FAST%dt + !ED_OutputTimes(p_FAST%InterpOrder + 1 + j) = t_initial - (j - 1) * dt + END DO + DO j = 1, p_FAST%InterpOrder + 1 + CALL ED_CopyInput (ED%Input(1), ED%Input_Saved(j), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ErrStat = ErrID_None - ErrMsg = "" - ErrStat2 = ErrID_None - ErrMsg2 = "" + CALL ED_CopyOutput (ED%y, ED%Output_bak(1), MESH_NEWCOPY, Errstat2, ErrMsg2) !BJJ: THIS IS REALLY ONLY NECESSARY FOR ED-HD COUPLING AT THE MOMENT + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO - n_t_global_next = n_t_global+1 - t_global_next = t_initial + n_t_global_next*p_FAST%DT ! = m_FAST%t_global + p_FAST%dt + CALL ED_CopyContState (ED%x( STATE_CURR), ED%x( STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ED_CopyDiscState (ED%xd(STATE_CURR), ED%xd(STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ED_CopyConstrState (ED%z( STATE_CURR), ED%z( STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ED_CopyOtherState (ED%OtherSt( STATE_CURR), ED%OtherSt( STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - y_FAST%WriteThisStep = NeedWriteOutput(n_t_global_next, t_global_next, p_FAST) + CALL ED_CopyContState (ED%x( STATE_PRED), ED%x( STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ED_CopyDiscState (ED%xd(STATE_PRED), ED%xd(STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ED_CopyConstrState (ED%z( STATE_PRED), ED%z( STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ED_CopyOtherState (ED%OtherSt( STATE_PRED), ED%OtherSt( STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - !! determine if the Jacobian should be calculated this time - IF ( m_FAST%calcJacobian ) THEN ! this was true (possibly at initialization), so we'll advance the time for the next calculation of the Jacobian + IF (p_FAST%CompElast == Module_BD ) THEN - if (p_FAST%CompMooring == Module_Orca .and. n_t_global < 5) then - m_FAST%NextJacCalcTime = m_FAST%t_global + p_FAST%DT ! the jacobian calculated with OrcaFlex at t=0 is incorrect, but is okay on the 2nd step (it's not okay for OrcaFlex version 10, so I increased this to 5) - else - m_FAST%NextJacCalcTime = m_FAST%t_global + p_FAST%DT_UJac - end if + DO k = 1,p_FAST%nBeams - END IF + ! Copy values for interpolation/extrapolation: + DO j = 1, p_FAST%InterpOrder + 1 + BD%InputTimes_Saved(j,k) = t_initial - (j - 1) * p_FAST%dt + END DO - ! set number of corrections to be used for this time step: - IF ( p_FAST%CompElast == Module_BD ) THEN ! BD accelerations have fewer spikes with these corrections on the first several time steps - if (n_t_global > 2) then ! this 2 should probably be related to p_FAST%InterpOrder - NumCorrections = p_FAST%NumCrctn - elseif (n_t_global == 0) then - NumCorrections = max(p_FAST%NumCrctn,16) - else - NumCorrections = max(p_FAST%NumCrctn,1) - end if - ELSE - NumCorrections = p_FAST%NumCrctn - END IF + DO j = 1, p_FAST%InterpOrder + 1 + CALL BD_CopyInput (BD%Input(1,k), BD%Input_Saved(j,k), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO - ! the ServoDyn inputs from Simulink are for t, not t+dt, so we're going to overwrite the inputs from - ! the previous step before we extrapolate these inputs: - IF ( p_FAST%CompServo == Module_SrvD ) CALL SrvD_SetExternalInputs( p_FAST, m_FAST, SrvD%Input(1) ) + ! Initialize predicted states for j_pc loop: + CALL BD_CopyContState (BD%x( k,STATE_CURR), BD%x( k,STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL BD_CopyDiscState (BD%xd(k,STATE_CURR), BD%xd(k,STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL BD_CopyConstrState (BD%z( k,STATE_CURR), BD%z( k,STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL BD_CopyOtherState (BD%OtherSt( k,STATE_CURR), BD%OtherSt( k,STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( p_FAST%UseSC ) THEN - CALL SC_DX_SetOutputs(p_FAST, SrvD%Input(1), SC_DX, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END IF + ! Initialize predicted states for j_pc loop: + CALL BD_CopyContState (BD%x( k,STATE_PRED), BD%x( k,STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL BD_CopyDiscState (BD%xd(k,STATE_PRED), BD%xd(k,STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL BD_CopyConstrState (BD%z( k,STATE_PRED), BD%z( k,STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL BD_CopyOtherState (BD%OtherSt( k,STATE_PRED), BD%OtherSt( k,STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - !! ## Step 1.a: Extrapolate Inputs - !! - !! gives predicted values at t+dt - !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - CALL FAST_ExtrapInterpMods( t_global_next, p_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, HD, SD, ExtPtfm, & - MAPp, FEAM, MD, Orca, IceF, IceD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO ! nBeams + END IF ! CompElast + + + IF ( p_FAST%CompServo == Module_SrvD ) THEN + ! Initialize Input-Output arrays for interpolation/extrapolation: + + DO j = 1, p_FAST%InterpOrder + 1 + SrvD%InputTimes_Saved(j) = t_initial - (j - 1) * p_FAST%dt + !SrvD_OutputTimes(j) = t_initial - (j - 1) * dt + END DO + + DO j = 1, p_FAST%InterpOrder + 1 + CALL SrvD_CopyInput (SrvD%Input(1), SrvD%Input_Saved(j), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + + ! Initialize predicted states for j_pc loop: + CALL SrvD_CopyContState (SrvD%x( STATE_CURR), SrvD%x( STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SrvD_CopyDiscState (SrvD%xd(STATE_CURR), SrvD%xd(STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SrvD_CopyConstrState (SrvD%z( STATE_CURR), SrvD%z( STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SrvD_CopyOtherState( SrvD%OtherSt(STATE_CURR), SrvD%OtherSt(STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ! Initialize predicted states for j_pc loop: + CALL SrvD_CopyContState (SrvD%x( STATE_PRED), SrvD%x( STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SrvD_CopyDiscState (SrvD%xd(STATE_PRED), SrvD%xd(STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SrvD_CopyConstrState (SrvD%z( STATE_PRED), SrvD%z( STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SrvD_CopyOtherState( SrvD%OtherSt(STATE_PRED), SrvD%OtherSt(STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL SrvD_CopyMisc( SrvD%m, SrvD%m_bak, MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + END IF ! CompServo + + + IF ( (p_FAST%CompAero == Module_AD) .or. (p_FAST%CompAero == Module_ExtLd) ) THEN + ! Copy values for interpolation/extrapolation: + + DO j = 1, p_FAST%InterpOrder + 1 + AD%InputTimes_Saved(j) = t_initial - (j - 1) * p_FAST%dt + END DO + + DO j = 1, p_FAST%InterpOrder + 1 + CALL AD_CopyInput (AD%Input(1), AD%Input_Saved(j), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + + ! Initialize predicted states for j_pc loop: + CALL AD_CopyContState(AD%x(STATE_CURR), AD%x(STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AD_CopyDiscState(AD%xd(STATE_CURR), AD%xd(STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AD_CopyConstrState(AD%z(STATE_CURR), AD%z(STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AD_CopyOtherState(AD%OtherSt(STATE_CURR), AD%OtherSt(STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ! Initialize predicted states for j_pc loop: + CALL AD_CopyContState(AD%x(STATE_PRED), AD%x(STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AD_CopyDiscState(AD%xd(STATE_PRED), AD%xd(STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AD_CopyConstrState(AD%z(STATE_PRED), AD%z(STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AD_CopyOtherState(AD%OtherSt(STATE_PRED), AD%OtherSt(STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + END IF ! CompAero == Module_AD + + + + IF ( p_FAST%CompInflow == Module_IfW ) THEN + ! Copy values for interpolation/extrapolation: + + DO j = 1, p_FAST%InterpOrder + 1 + IfW%InputTimes_Saved(j) = t_initial - (j - 1) * p_FAST%dt + !IfW%OutputTimes(i) = t_initial - (j - 1) * dt + END DO + + DO j = 1, p_FAST%InterpOrder + 1 + CALL InflowWind_CopyInput (IfW%Input(1), IfW%Input_Saved(j), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + + ! Initialize predicted states for j_pc loop: + CALL InflowWind_CopyContState (IfW%x( STATE_CURR), IfW%x( STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL InflowWind_CopyDiscState (IfW%xd(STATE_CURR), IfW%xd(STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL InflowWind_CopyConstrState (IfW%z( STATE_CURR), IfW%z( STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL InflowWind_CopyOtherState( IfW%OtherSt(STATE_CURR), IfW%OtherSt(STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ! Initialize predicted states for j_pc loop: + CALL InflowWind_CopyContState (IfW%x( STATE_PRED), IfW%x( STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL InflowWind_CopyDiscState (IfW%xd(STATE_PRED), IfW%xd(STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL InflowWind_CopyConstrState (IfW%z( STATE_PRED), IfW%z( STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL InflowWind_CopyOtherState( IfW%OtherSt(STATE_PRED), IfW%OtherSt(STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + END IF ! CompInflow == Module_IfW + + + IF ( p_FAST%CompHydro == Module_HD ) THEN + ! Copy values for interpolation/extrapolation: + DO j = 1, p_FAST%InterpOrder + 1 + HD%InputTimes_Saved(j) = t_initial - (j - 1) * p_FAST%dt + !HD_OutputTimes(i) = t_initial - (j - 1) * dt + END DO + + DO j = 1, p_FAST%InterpOrder + 1 + CALL HydroDyn_CopyInput (HD%Input(1), HD%Input_Saved(j), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + + ! Initialize predicted states for j_pc loop: + CALL HydroDyn_CopyContState (HD%x( STATE_CURR), HD%x( STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL HydroDyn_CopyDiscState (HD%xd(STATE_CURR), HD%xd(STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL HydroDyn_CopyConstrState (HD%z( STATE_CURR), HD%z( STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL HydroDyn_CopyOtherState( HD%OtherSt(STATE_CURR), HD%OtherSt(STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ! Initialize predicted states for j_pc loop: + CALL HydroDyn_CopyContState (HD%x( STATE_PRED), HD%x( STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL HydroDyn_CopyDiscState (HD%xd(STATE_PRED), HD%xd(STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL HydroDyn_CopyConstrState (HD%z( STATE_PRED), HD%z( STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL HydroDyn_CopyOtherState( HD%OtherSt(STATE_PRED), HD%OtherSt(STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + END IF !CompHydro + + + IF (p_FAST%CompSub == Module_SD ) THEN + + ! Copy values for interpolation/extrapolation: + DO j = 1, p_FAST%InterpOrder + 1 + SD%InputTimes_Saved(j) = t_initial - (j - 1) * p_FAST%dt + !SD_OutputTimes(i) = t_initial - (j - 1) * dt + END DO + + DO j = 1, p_FAST%InterpOrder + 1 + CALL SD_CopyInput (SD%Input(1), SD%Input_Saved(j), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + + ! Initialize predicted states for j_pc loop: + CALL SD_CopyContState (SD%x( STATE_CURR), SD%x( STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SD_CopyDiscState (SD%xd(STATE_CURR), SD%xd(STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SD_CopyConstrState (SD%z( STATE_CURR), SD%z( STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SD_CopyOtherState( SD%OtherSt(STATE_CURR), SD%OtherSt(STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ! Initialize predicted states for j_pc loop: + CALL SD_CopyContState (SD%x( STATE_PRED), SD%x( STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SD_CopyDiscState (SD%xd(STATE_PRED), SD%xd(STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SD_CopyConstrState (SD%z( STATE_PRED), SD%z( STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SD_CopyOtherState( SD%OtherSt(STATE_PRED), SD%OtherSt(STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ELSE IF (p_FAST%CompSub == Module_ExtPtfm ) THEN + + ! Copy values for interpolation/extrapolation: + DO j = 1, p_FAST%InterpOrder + 1 + ExtPtfm%InputTimes_Saved(j) = t_initial - (j - 1) * p_FAST%dt + END DO + + DO j = 1, p_FAST%InterpOrder + 1 + CALL ExtPtfm_CopyInput (ExtPtfm%Input(1), ExtPtfm%Input_Saved(j), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + + ! Initialize predicted states for j_pc loop: + CALL ExtPtfm_CopyContState (ExtPtfm%x( STATE_CURR), ExtPtfm%x( STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ExtPtfm_CopyDiscState (ExtPtfm%xd(STATE_CURR), ExtPtfm%xd(STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ExtPtfm_CopyConstrState (ExtPtfm%z( STATE_CURR), ExtPtfm%z( STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ExtPtfm_CopyOtherState( ExtPtfm%OtherSt(STATE_CURR), ExtPtfm%OtherSt(STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ! Initialize predicted states for j_pc loop: + CALL ExtPtfm_CopyContState (ExtPtfm%x( STATE_PRED), ExtPtfm%x( STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ExtPtfm_CopyDiscState (ExtPtfm%xd(STATE_PRED), ExtPtfm%xd(STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ExtPtfm_CopyConstrState (ExtPtfm%z( STATE_PRED), ExtPtfm%z( STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ExtPtfm_CopyOtherState( ExtPtfm%OtherSt(STATE_PRED), ExtPtfm%OtherSt(STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + END IF ! CompSub + + + IF (p_FAST%CompMooring == Module_MAP) THEN + ! Copy values for interpolation/extrapolation: + + DO j = 1, p_FAST%InterpOrder + 1 + MAPp%InputTimes_Saved(j) = t_initial - (j - 1) * p_FAST%dt + !MAP_OutputTimes(i) = t_initial - (j - 1) * dt + END DO + + DO j = 1, p_FAST%InterpOrder + 1 + CALL MAP_CopyInput (MAPp%Input(1), MAPp%Input_Saved(j), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + + ! Initialize predicted states for j_pc loop: + CALL MAP_CopyContState (MAPp%x( STATE_CURR), MAPp%x( STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL MAP_CopyDiscState (MAPp%xd(STATE_CURR), MAPp%xd(STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL MAP_CopyConstrState (MAPp%z( STATE_CURR), MAPp%z( STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + IF ( p_FAST%n_substeps( MODULE_MAP ) > 1 ) THEN + CALL MAP_CopyOtherState( MAPp%OtherSt, MAPp%OtherSt_old, MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END IF + + ! Initialize predicted states for j_pc loop: + CALL MAP_CopyContState (MAPp%x( STATE_PRED), MAPp%x( STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL MAP_CopyDiscState (MAPp%xd(STATE_PRED), MAPp%xd(STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL MAP_CopyConstrState (MAPp%z( STATE_PRED), MAPp%z( STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + IF ( p_FAST%n_substeps( MODULE_MAP ) > 1 ) THEN + CALL MAP_CopyOtherState( MAPp%OtherSt, MAPp%OtherSt_old, MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END IF + + ELSEIF (p_FAST%CompMooring == Module_MD) THEN + ! Copy values for interpolation/extrapolation: + + DO j = 1, p_FAST%InterpOrder + 1 + MD%InputTimes_Saved(j) = t_initial - (j - 1) * p_FAST%dt + !MD_OutputTimes(i) = t_initial - (j - 1) * dt + END DO + + DO j = 1, p_FAST%InterpOrder + 1 + CALL MD_CopyInput (MD%Input(1), MD%Input_Saved(j), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + + ! Initialize predicted states for j_pc loop: + CALL MD_CopyContState (MD%x( STATE_CURR), MD%x( STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL MD_CopyDiscState (MD%xd(STATE_CURR), MD%xd(STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL MD_CopyConstrState (MD%z( STATE_CURR), MD%z( STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL MD_CopyOtherState( MD%OtherSt(STATE_CURR), MD%OtherSt(STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ! Initialize predicted states for j_pc loop: + CALL MD_CopyContState (MD%x( STATE_PRED), MD%x( STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL MD_CopyDiscState (MD%xd(STATE_PRED), MD%xd(STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL MD_CopyConstrState (MD%z( STATE_PRED), MD%z( STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL MD_CopyOtherState( MD%OtherSt(STATE_PRED), MD%OtherSt(STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + + + ELSEIF (p_FAST%CompMooring == Module_FEAM) THEN + ! Copy values for interpolation/extrapolation: + + DO j = 1, p_FAST%InterpOrder + 1 + FEAM%InputTimes_Saved(j) = t_initial - (j - 1) * p_FAST%dt + !FEAM_OutputTimes(i) = t_initial - (j - 1) * dt + END DO + + DO j = 1, p_FAST%InterpOrder + 1 + CALL FEAM_CopyInput (FEAM%Input(1), FEAM%Input_Saved(j), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + + ! Initialize predicted states for j_pc loop: + CALL FEAM_CopyContState (FEAM%x( STATE_CURR), FEAM%x( STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL FEAM_CopyDiscState (FEAM%xd(STATE_CURR), FEAM%xd(STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL FEAM_CopyConstrState (FEAM%z( STATE_CURR), FEAM%z( STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL FEAM_CopyOtherState( FEAM%OtherSt(STATE_CURR), FEAM%OtherSt(STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ! Initialize predicted states for j_pc loop: + CALL FEAM_CopyContState (FEAM%x( STATE_PRED), FEAM%x( STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL FEAM_CopyDiscState (FEAM%xd(STATE_PRED), FEAM%xd(STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL FEAM_CopyConstrState (FEAM%z( STATE_PRED), FEAM%z( STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL FEAM_CopyOtherState( FEAM%OtherSt(STATE_PRED), FEAM%OtherSt(STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ELSEIF (p_FAST%CompMooring == Module_Orca) THEN + ! Copy values for interpolation/extrapolation: + + DO j = 1, p_FAST%InterpOrder + 1 + Orca%InputTimes_Saved(j) = t_initial - (j - 1) * p_FAST%dt + END DO + + DO j = 1, p_FAST%InterpOrder + 1 + CALL Orca_CopyInput (Orca%Input(1), Orca%Input_Saved(j), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + + ! Initialize predicted states for j_pc loop: + CALL Orca_CopyContState (Orca%x( STATE_CURR), Orca%x( STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL Orca_CopyDiscState (Orca%xd(STATE_CURR), Orca%xd(STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL Orca_CopyConstrState (Orca%z( STATE_CURR), Orca%z( STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL Orca_CopyOtherState( Orca%OtherSt(STATE_CURR), Orca%OtherSt(STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ! Initialize predicted states for j_pc loop: + CALL Orca_CopyContState (Orca%x( STATE_PRED), Orca%x( STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL Orca_CopyDiscState (Orca%xd(STATE_PRED), Orca%xd(STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL Orca_CopyConstrState (Orca%z( STATE_PRED), Orca%z( STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL Orca_CopyOtherState( Orca%OtherSt(STATE_PRED), Orca%OtherSt(STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + END IF ! CompMooring + + + IF (p_FAST%CompIce == Module_IceF ) THEN + + ! Copy values for interpolation/extrapolation: + DO j = 1, p_FAST%InterpOrder + 1 + IceF%InputTimes_Saved(j) = t_initial - (j - 1) * p_FAST%dt + !IceF_OutputTimes(i) = t_initial - (j - 1) * dt + END DO + + DO j = 1, p_FAST%InterpOrder + 1 + CALL IceFloe_CopyInput (IceF%Input(1), IceF%Input_Saved(j), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + + ! Initialize predicted states for j_pc loop: + CALL IceFloe_CopyContState (IceF%x( STATE_CURR), IceF%x( STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceFloe_CopyDiscState (IceF%xd(STATE_CURR), IceF%xd(STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceFloe_CopyConstrState (IceF%z( STATE_CURR), IceF%z( STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceFloe_CopyOtherState( IceF%OtherSt(STATE_CURR), IceF%OtherSt(STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ! Initialize predicted states for j_pc loop: + CALL IceFloe_CopyContState (IceF%x( STATE_PRED), IceF%x( STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceFloe_CopyDiscState (IceF%xd(STATE_PRED), IceF%xd(STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceFloe_CopyConstrState (IceF%z( STATE_PRED), IceF%z( STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceFloe_CopyOtherState( IceF%OtherSt(STATE_PRED), IceF%OtherSt(STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ELSEIF (p_FAST%CompIce == Module_IceD ) THEN + + DO i = 1,p_FAST%numIceLegs + + ! Copy values for interpolation/extrapolation: + DO j = 1, p_FAST%InterpOrder + 1 + IceD%InputTimes_Saved(j,i) = t_initial - (j - 1) * p_FAST%dt + !IceD%OutputTimes(j,i) = t_initial - (j - 1) * dt + END DO + + DO j = 1, p_FAST%InterpOrder + 1 + CALL IceD_CopyInput (IceD%Input(1,i), IceD%Input_Saved(j,i), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + + ! Initialize predicted states for j_pc loop: + CALL IceD_CopyContState (IceD%x( i,STATE_CURR), IceD%x( i,STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceD_CopyDiscState (IceD%xd(i,STATE_CURR), IceD%xd(i,STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceD_CopyConstrState (IceD%z( i,STATE_CURR), IceD%z( i,STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceD_CopyOtherState( IceD%OtherSt(i,STATE_CURR), IceD%OtherSt(i,STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ! Initialize predicted states for j_pc loop: + CALL IceD_CopyContState (IceD%x( i,STATE_PRED), IceD%x( i,STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceD_CopyDiscState (IceD%xd(i,STATE_PRED), IceD%xd(i,STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceD_CopyConstrState (IceD%z( i,STATE_PRED), IceD%z( i,STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceD_CopyOtherState( IceD%OtherSt(i,STATE_PRED), IceD%OtherSt(i,STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + END DO ! numIceLegs + + END IF ! CompIce + + +END SUBROUTINE FAST_InitIOarrays_SubStep +!---------------------------------------------------------------------------------------------------------------------------------- +!> Routine that calls FAST_Reset_SubStep for one instance of a Turbine data structure. This is a separate subroutine so that the FAST +!! driver programs do not need to change or operate on the individual module level. +SUBROUTINE FAST_Reset_SubStep_T(t_initial, n_t_global, n_timesteps, Turbine, ErrStat, ErrMsg ) + + REAL(DbKi), INTENT(IN ) :: t_initial !< initial time + INTEGER(IntKi), INTENT(IN ) :: n_t_global !< loop counter + INTEGER(IntKi), INTENT(IN ) :: n_timesteps !< number of time steps to go back + TYPE(FAST_TurbineType), INTENT(INOUT) :: Turbine !< all data for one instance of a turbine + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + CALL FAST_Reset_SubStep(t_initial, n_t_global, n_timesteps, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & + Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD, Turbine%IfW, Turbine%ExtInfw, & + Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & + Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat, ErrMsg ) + +END SUBROUTINE FAST_Reset_SubStep_T +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine resets the states, inputs and output data from n_t_global to n_t_global - 1 +SUBROUTINE FAST_Reset_SubStep(t_initial, n_t_global, n_timesteps, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, ExtInfw, HD, SD, ExtPtfm, & + MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat, ErrMsg ) + + USE BladedInterface, ONLY: CallBladedDLL ! Hack for Bladed-style DLL + + REAL(DbKi), INTENT(IN ) :: t_initial !< initial time + INTEGER(IntKi), INTENT(IN ) :: n_t_global !< loop counter + INTEGER(IntKi), INTENT(IN ) :: n_timesteps !< number of time steps to go back + + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code + TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Output variables for the glue code + TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables + + TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data + TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data + TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data + TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data + TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data + TYPE(ExternalInflow_Data),INTENT(INOUT) :: ExtInfw !< ExternalInflow data + TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HydroDyn data + TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SubDyn data + TYPE(ExtPtfm_Data), INTENT(INOUT) :: ExtPtfm !< ExtPtfm_MCKF data + TYPE(MAP_Data), INTENT(INOUT) :: MAPp !< MAP data + TYPE(FEAMooring_Data), INTENT(INOUT) :: FEAM !< FEAMooring data + TYPE(MoorDyn_Data), INTENT(INOUT) :: MD !< Data for the MoorDyn module + TYPE(OrcaFlex_Data), INTENT(INOUT) :: Orca !< OrcaFlex interface data + TYPE(IceFloe_Data), INTENT(INOUT) :: IceF !< IceFloe data + TYPE(IceDyn_Data), INTENT(INOUT) :: IceD !< All the IceDyn data used in time-step loop + + TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules + + 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 ! generic loop counters + REAL(DbKi) :: t_global ! the time to which states, inputs and outputs are reset + INTEGER(IntKi) :: old_avrSwap1 ! previous value of avrSwap(1) !hack for Bladed DLL checkpoint/restore + + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_Reset_SubStep' + + + ErrStat = ErrID_None + ErrMsg = "" + + + t_global = t_initial + n_t_global * p_FAST%DT + + !---------------------------------------------------------------------------------------- + !! copy the stored states and inputs from n_t_global the current states and inputs + !---------------------------------------------------------------------------------------- + + DO j = 1, p_FAST%InterpOrder + 1 + ED%InputTimes(j) = t_global - (j - 1) * p_FAST%dt + !ED_OutputTimes(j) = t_global - (j - 1) * dt + END DO + + DO j = 1, p_FAST%InterpOrder + 1 + CALL ED_CopyInput (ED%Input_Saved(j), ED%Input(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + CALL ED_CopyOutput (ED%Output_bak(1), ED%y, MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ! ElastoDyn: copy final predictions to actual states + CALL ED_CopyContState (ED%x( STATE_SAVED_PRED), ED%x( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ED_CopyDiscState (ED%xd(STATE_SAVED_PRED), ED%xd(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ED_CopyConstrState (ED%z( STATE_SAVED_PRED), ED%z( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ED_CopyOtherState (ED%OtherSt( STATE_SAVED_PRED), ED%OtherSt( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL ED_CopyContState (ED%x( STATE_SAVED_CURR), ED%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ED_CopyDiscState (ED%xd(STATE_SAVED_CURR), ED%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ED_CopyConstrState (ED%z( STATE_SAVED_CURR), ED%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ED_CopyOtherState (ED%OtherSt( STATE_SAVED_CURR), ED%OtherSt( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + + IF (p_FAST%CompElast == Module_BD ) THEN + + DO k = 1,p_FAST%nBeams + + ! Copy values for interpolation/extrapolation: + DO j = 1, p_FAST%InterpOrder + 1 + BD%InputTimes(j,k) = t_global - (j - 1) * p_FAST%dt + END DO + + DO j = 1, p_FAST%InterpOrder + 1 + CALL BD_CopyInput (BD%Input_Saved(j,k), BD%Input(j,k), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + + CALL BD_CopyContState (BD%x( k,STATE_SAVED_PRED), BD%x( k,STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL BD_CopyDiscState (BD%xd(k,STATE_SAVED_PRED), BD%xd(k,STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL BD_CopyConstrState (BD%z( k,STATE_SAVED_PRED), BD%z( k,STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL BD_CopyOtherState (BD%OtherSt( k,STATE_SAVED_PRED), BD%OtherSt( k,STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL BD_CopyContState (BD%x( k,STATE_SAVED_CURR), BD%x( k,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL BD_CopyDiscState (BD%xd(k,STATE_SAVED_CURR), BD%xd(k,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL BD_CopyConstrState (BD%z( k,STATE_SAVED_CURR), BD%z( k,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL BD_CopyOtherState (BD%OtherSt( k,STATE_SAVED_CURR), BD%OtherSt( k,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + + END IF + + IF ( p_FAST%CompServo == Module_SrvD ) THEN + + ! A hack to restore Bladed-style DLL data + if (SrvD%p%UseBladedInterface) then + if (SrvD%m%dll_data%avrSWAP( 1) > 0 ) then ! this isn't allocated if UseBladedInterface is FALSE + ! store value to be overwritten + old_avrSwap1 = SrvD%m%dll_data%avrSWAP( 1) + SrvD%m%dll_data%avrSWAP( 1) = -10 + CALL CallBladedDLL(SrvD%Input(1), SrvD%p, SrvD%m%dll_data, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ! put values back: + SrvD%m%dll_data%avrSWAP( 1) = old_avrSwap1 + end if + end if + + ! Initialize Input-Output arrays for interpolation/extrapolation: + + DO j = 1, p_FAST%InterpOrder + 1 + SrvD%InputTimes(j) = t_global - (j - 1) * p_FAST%dt + END DO + + DO j = 1, p_FAST%InterpOrder + 1 + CALL SrvD_CopyInput (SrvD%Input_Saved(j), SrvD%Input(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + + CALL SrvD_CopyContState (SrvD%x( STATE_SAVED_PRED), SrvD%x( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SrvD_CopyDiscState (SrvD%xd(STATE_SAVED_PRED), SrvD%xd(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SrvD_CopyConstrState (SrvD%z( STATE_SAVED_PRED), SrvD%z( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SrvD_CopyOtherState (SrvD%OtherSt( STATE_SAVED_PRED), SrvD%OtherSt( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL SrvD_CopyContState (SrvD%x( STATE_SAVED_CURR), SrvD%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SrvD_CopyDiscState (SrvD%xd(STATE_SAVED_CURR), SrvD%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SrvD_CopyConstrState (SrvD%z( STATE_SAVED_CURR), SrvD%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SrvD_CopyOtherState (SrvD%OtherSt( STATE_SAVED_CURR), SrvD%OtherSt( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL SrvD_CopyMisc( SrvD%m_bak, SrvD%m, MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + END IF + + IF ( (p_FAST%CompAero == Module_AD) .or. (p_FAST%CompAero == Module_ExtLd) ) THEN + ! Copy values for interpolation/extrapolation: + + DO j = 1, p_FAST%InterpOrder + 1 + AD%InputTimes(j) = t_global - (j - 1) * p_FAST%dt + END DO + + DO j = 1, p_FAST%InterpOrder + 1 + CALL AD_CopyInput (AD%Input_Saved(j), AD%Input(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + + CALL AD_CopyContState (AD%x( STATE_SAVED_PRED), AD%x( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AD_CopyDiscState (AD%xd(STATE_SAVED_PRED), AD%xd(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AD_CopyConstrState (AD%z( STATE_SAVED_PRED), AD%z( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AD_CopyOtherState (AD%OtherSt(STATE_SAVED_PRED), AD%OtherSt(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL AD_CopyContState (AD%x( STATE_SAVED_CURR), AD%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AD_CopyDiscState (AD%xd(STATE_SAVED_CURR), AD%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AD_CopyConstrState (AD%z( STATE_SAVED_CURR), AD%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AD_CopyOtherState (AD%OtherSt(STATE_SAVED_CURR), AD%OtherSt(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + END IF ! CompAero == Module_AD + + IF ( p_FAST%CompInflow == Module_IfW ) THEN + ! Copy values for interpolation/extrapolation: + + DO j = 1, p_FAST%InterpOrder + 1 + IfW%InputTimes(j) = t_global - (j - 1) * p_FAST%dt + !IfW%OutputTimes(i) = t_global - (j - 1) * dt + END DO + + DO j = 1, p_FAST%InterpOrder + 1 + CALL InflowWind_CopyInput (IfW%Input_Saved(j), IfW%Input(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + + CALL InflowWind_CopyContState (IfW%x( STATE_SAVED_PRED), IfW%x( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL InflowWind_CopyDiscState (IfW%xd(STATE_SAVED_PRED), IfW%xd(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL InflowWind_CopyConstrState (IfW%z( STATE_SAVED_PRED), IfW%z( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL InflowWind_CopyOtherState (IfW%OtherSt( STATE_SAVED_PRED), IfW%OtherSt( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL InflowWind_CopyContState (IfW%x( STATE_SAVED_CURR), IfW%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL InflowWind_CopyDiscState (IfW%xd(STATE_SAVED_CURR), IfW%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL InflowWind_CopyConstrState (IfW%z( STATE_SAVED_CURR), IfW%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL InflowWind_CopyOtherState (IfW%OtherSt( STATE_SAVED_CURR), IfW%OtherSt( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + END IF ! CompInflow == Module_IfW + + + IF ( p_FAST%CompHydro == Module_HD ) THEN + ! Copy values for interpolation/extrapolation: + DO j = 1, p_FAST%InterpOrder + 1 + HD%InputTimes(j) = t_global - (j - 1) * p_FAST%dt + !HD_OutputTimes(i) = t_global - (j - 1) * dt + END DO + + DO j = 1, p_FAST%InterpOrder + 1 + CALL HydroDyn_CopyInput (HD%Input_Saved(j), HD%Input(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + + CALL HydroDyn_CopyContState (HD%x( STATE_SAVED_PRED), HD%x( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL HydroDyn_CopyDiscState (HD%xd(STATE_SAVED_PRED), HD%xd(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL HydroDyn_CopyConstrState (HD%z( STATE_SAVED_PRED), HD%z( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL HydroDyn_CopyOtherState (HD%OtherSt(STATE_SAVED_PRED), HD%OtherSt(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL HydroDyn_CopyContState (HD%x( STATE_SAVED_CURR), HD%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL HydroDyn_CopyDiscState (HD%xd(STATE_SAVED_CURR), HD%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL HydroDyn_CopyConstrState (HD%z( STATE_SAVED_CURR), HD%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL HydroDyn_CopyOtherState (HD%OtherSt(STATE_SAVED_CURR), HD%OtherSt(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + END IF !CompHydro + + + IF (p_FAST%CompSub == Module_SD ) THEN + + ! Copy values for interpolation/extrapolation: + DO j = 1, p_FAST%InterpOrder + 1 + SD%InputTimes(j) = t_global - (j - 1) * p_FAST%dt + !SD_OutputTimes(i) = t_global - (j - 1) * dt + END DO + + DO j = 1, p_FAST%InterpOrder + 1 + CALL SD_CopyInput (SD%Input_Saved(j), SD%Input(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + + CALL SD_CopyContState (SD%x( STATE_SAVED_PRED), SD%x( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SD_CopyDiscState (SD%xd(STATE_SAVED_PRED), SD%xd(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SD_CopyConstrState (SD%z( STATE_SAVED_PRED), SD%z( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SD_CopyOtherState (SD%OtherSt(STATE_SAVED_PRED), SD%OtherSt(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL SD_CopyContState (SD%x( STATE_SAVED_CURR), SD%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SD_CopyDiscState (SD%xd(STATE_SAVED_CURR), SD%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SD_CopyConstrState (SD%z( STATE_SAVED_CURR), SD%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SD_CopyOtherState (SD%OtherSt(STATE_SAVED_CURR), SD%OtherSt(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ELSE IF (p_FAST%CompSub == Module_ExtPtfm ) THEN + + ! Copy values for interpolation/extrapolation: + DO j = 1, p_FAST%InterpOrder + 1 + ExtPtfm%InputTimes(j) = t_global - (j - 1) * p_FAST%dt + END DO + + DO j = 1, p_FAST%InterpOrder + 1 + CALL ExtPtfm_CopyInput (ExtPtfm%Input_Saved(j), ExtPtfm%Input(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + + CALL ExtPtfm_CopyContState (ExtPtfm%x( STATE_SAVED_PRED), ExtPtfm%x( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ExtPtfm_CopyDiscState (ExtPtfm%xd(STATE_SAVED_PRED), ExtPtfm%xd(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ExtPtfm_CopyConstrState (ExtPtfm%z( STATE_SAVED_PRED), ExtPtfm%z( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ExtPtfm_CopyOtherState (ExtPtfm%OtherSt(STATE_SAVED_PRED), ExtPtfm%OtherSt(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL ExtPtfm_CopyContState (ExtPtfm%x( STATE_SAVED_CURR), ExtPtfm%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ExtPtfm_CopyDiscState (ExtPtfm%xd(STATE_SAVED_CURR), ExtPtfm%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ExtPtfm_CopyConstrState (ExtPtfm%z( STATE_SAVED_CURR), ExtPtfm%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ExtPtfm_CopyOtherState (ExtPtfm%OtherSt(STATE_SAVED_CURR), ExtPtfm%OtherSt(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + END IF ! CompSub + + + IF (p_FAST%CompMooring == Module_MAP) THEN + ! Copy values for interpolation/extrapolation: + + DO j = 1, p_FAST%InterpOrder + 1 + MAPp%InputTimes(j) = t_global - (j - 1) * p_FAST%dt + !MAP_OutputTimes(i) = t_global - (j - 1) * dt + END DO + + DO j = 1, p_FAST%InterpOrder + 1 + CALL MAP_CopyInput (MAPp%Input_Saved(j), MAPp%Input(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + + CALL MAP_CopyContState (MAPp%x( STATE_SAVED_PRED), MAPp%x( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL MAP_CopyDiscState (MAPp%xd(STATE_SAVED_PRED), MAPp%xd(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL MAP_CopyConstrState (MAPp%z( STATE_SAVED_PRED), MAPp%z( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + !CALL MAP_CopyOtherState (MAPp%OtherSt(STATE_SAVED_PRED), MAPp%OtherSt(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + ! CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL MAP_CopyContState (MAPp%x( STATE_SAVED_CURR), MAPp%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL MAP_CopyDiscState (MAPp%xd(STATE_SAVED_CURR), MAPp%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL MAP_CopyConstrState (MAPp%z( STATE_SAVED_CURR), MAPp%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + !CALL MAP_CopyOtherState (MAPp%OtherSt(STATE_SAVED_CURR), MAPp%OtherSt(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + ! CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ELSEIF (p_FAST%CompMooring == Module_MD) THEN + ! Copy values for interpolation/extrapolation: + + DO j = 1, p_FAST%InterpOrder + 1 + MD%InputTimes(j) = t_global - (j - 1) * p_FAST%dt + !MD_OutputTimes(i) = t_global - (j - 1) * dt + END DO + + DO j = 1, p_FAST%InterpOrder + 1 + CALL MD_CopyInput (MD%Input_Saved(j), MD%Input(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + + CALL MD_CopyContState (MD%x( STATE_SAVED_PRED), MD%x( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL MD_CopyDiscState (MD%xd(STATE_SAVED_PRED), MD%xd(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL MD_CopyConstrState (MD%z( STATE_SAVED_PRED), MD%z( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL MD_CopyOtherState (MD%OtherSt(STATE_SAVED_PRED), MD%OtherSt(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL MD_CopyContState (MD%x( STATE_SAVED_CURR), MD%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL MD_CopyDiscState (MD%xd(STATE_SAVED_CURR), MD%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL MD_CopyConstrState (MD%z( STATE_SAVED_CURR), MD%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL MD_CopyOtherState (MD%OtherSt(STATE_SAVED_CURR), MD%OtherSt(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ELSEIF (p_FAST%CompMooring == Module_FEAM) THEN + ! Copy values for interpolation/extrapolation: + + DO j = 1, p_FAST%InterpOrder + 1 + FEAM%InputTimes(j) = t_global - (j - 1) * p_FAST%dt + !FEAM_OutputTimes(i) = t_global - (j - 1) * dt + END DO + + DO j = 1, p_FAST%InterpOrder + 1 + CALL FEAM_CopyInput (FEAM%Input_Saved(j), FEAM%Input(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + + CALL FEAM_CopyContState (FEAM%x( STATE_SAVED_PRED), FEAM%x( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL FEAM_CopyDiscState (FEAM%xd(STATE_SAVED_PRED), FEAM%xd(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL FEAM_CopyConstrState (FEAM%z( STATE_SAVED_PRED), FEAM%z( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL FEAM_CopyOtherState (FEAM%OtherSt( STATE_SAVED_PRED), FEAM%OtherSt( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL FEAM_CopyContState (FEAM%x( STATE_SAVED_CURR), FEAM%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL FEAM_CopyDiscState (FEAM%xd(STATE_SAVED_CURR), FEAM%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL FEAM_CopyConstrState (FEAM%z( STATE_SAVED_CURR), FEAM%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL FEAM_CopyOtherState (FEAM%OtherSt( STATE_SAVED_CURR), FEAM%OtherSt( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ELSEIF (p_FAST%CompMooring == Module_Orca) THEN + ! Copy values for interpolation/extrapolation: + + DO j = 1, p_FAST%InterpOrder + 1 + Orca%InputTimes(j) = t_global - (j - 1) * p_FAST%dt + END DO + + DO j = 1, p_FAST%InterpOrder + 1 + CALL Orca_CopyInput (Orca%Input_Saved(j), Orca%Input(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + + CALL Orca_CopyContState (Orca%x( STATE_SAVED_PRED), Orca%x( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL Orca_CopyDiscState (Orca%xd(STATE_SAVED_PRED), Orca%xd(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL Orca_CopyConstrState (Orca%z( STATE_SAVED_PRED), Orca%z( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL Orca_CopyOtherState (Orca%OtherSt( STATE_SAVED_PRED), Orca%OtherSt( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL Orca_CopyContState (Orca%x( STATE_SAVED_CURR), Orca%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL Orca_CopyDiscState (Orca%xd(STATE_SAVED_CURR), Orca%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL Orca_CopyConstrState (Orca%z( STATE_SAVED_CURR), Orca%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL Orca_CopyOtherState (Orca%OtherSt( STATE_SAVED_CURR), Orca%OtherSt( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + END IF ! CompMooring + + + IF (p_FAST%CompIce == Module_IceF ) THEN + + ! Copy values for interpolation/extrapolation: + DO j = 1, p_FAST%InterpOrder + 1 + IceF%InputTimes(j) = t_global - (j - 1) * p_FAST%dt + !IceF_OutputTimes(i) = t_global - (j - 1) * dt + END DO + + DO j = 1, p_FAST%InterpOrder + 1 + CALL IceFloe_CopyInput (IceF%Input_Saved(j), IceF%Input(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + + CALL IceFloe_CopyContState (IceF%x( STATE_SAVED_PRED), IceF%x( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceFloe_CopyDiscState (IceF%xd(STATE_SAVED_PRED), IceF%xd(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceFloe_CopyConstrState (IceF%z( STATE_SAVED_PRED), IceF%z( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceFloe_CopyOtherState (IceF%OtherSt(STATE_SAVED_PRED), IceF%OtherSt(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL IceFloe_CopyContState (IceF%x( STATE_SAVED_CURR), IceF%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceFloe_CopyDiscState (IceF%xd(STATE_SAVED_CURR), IceF%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceFloe_CopyConstrState (IceF%z( STATE_SAVED_CURR), IceF%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceFloe_CopyOtherState (IceF%OtherSt(STATE_SAVED_CURR), IceF%OtherSt(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ELSEIF (p_FAST%CompIce == Module_IceD ) THEN + + DO i = 1,p_FAST%numIceLegs + + ! Copy values for interpolation/extrapolation: + DO j = 1, p_FAST%InterpOrder + 1 + IceD%InputTimes(j,i) = t_global - (j - 1) * p_FAST%dt + !IceD%OutputTimes(j,i) = t_global - (j - 1) * dt + END DO + + DO j = 1, p_FAST%InterpOrder + 1 + CALL IceD_CopyInput (IceD%Input_Saved(j,i), IceD%Input(j,i), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + + CALL IceD_CopyContState (IceD%x( i,STATE_SAVED_PRED), IceD%x( i,STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceD_CopyDiscState (IceD%xd(i,STATE_SAVED_PRED), IceD%xd(i,STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceD_CopyConstrState (IceD%z( i,STATE_SAVED_PRED), IceD%z( i,STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceD_CopyOtherState (IceD%OtherSt( i,STATE_SAVED_PRED), IceD%OtherSt( i,STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL IceD_CopyContState (IceD%x( i,STATE_SAVED_CURR), IceD%x( i,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceD_CopyDiscState (IceD%xd(i,STATE_SAVED_CURR), IceD%xd(i,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceD_CopyConstrState (IceD%z( i,STATE_SAVED_CURR), IceD%z( i,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceD_CopyOtherState (IceD%OtherSt( i,STATE_SAVED_CURR), IceD%OtherSt( i,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + END DO ! numIceLegs + + END IF ! CompIce + + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + !! We've moved everything back to the initial time step: + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + !! update the global time + + m_FAST%t_global = t_global +! y_FAST%n_Out = y_FAST%n_Out - n_timesteps + +END SUBROUTINE FAST_Reset_SubStep +!---------------------------------------------------------------------------------------------------------------------------------- +!> Routine that calls FAST_Store_SubStep for one instance of a Turbine data structure. This is a separate subroutine so that the FAST +!! driver programs do not need to change or operate on the individual module level. +SUBROUTINE FAST_Store_SubStep_T(t_initial, n_t_global, Turbine, ErrStat, ErrMsg ) + + REAL(DbKi), INTENT(IN ) :: t_initial !< initial time + INTEGER(IntKi), INTENT(IN ) :: n_t_global !< loop counter + TYPE(FAST_TurbineType), INTENT(INOUT) :: Turbine !< all data for one instance of a turbine + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + CALL FAST_Store_SubStep(t_initial, n_t_global, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & + Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD, Turbine%IfW, Turbine%ExtInfw, & + Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & + Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat, ErrMsg ) + +END SUBROUTINE FAST_Store_SubStep_T +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine resets the states, inputs and output data from n_t_global to n_t_global - 1 +SUBROUTINE FAST_Store_SubStep(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, ExtInfw, HD, SD, ExtPtfm, & + MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat, ErrMsg ) + + USE BladedInterface, ONLY: CallBladedDLL ! Hack for Bladed-style DLL + + REAL(DbKi), INTENT(IN ) :: t_initial !< initial time + INTEGER(IntKi), INTENT(IN ) :: n_t_global !< loop counter + + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code + TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Output variables for the glue code + TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables + + TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data + TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data + TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data + TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data + TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data + TYPE(ExternalInflow_Data), INTENT(INOUT) :: ExtInfw !< ExternalInflow data + TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HydroDyn data + TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SubDyn data + TYPE(ExtPtfm_Data), INTENT(INOUT) :: ExtPtfm !< ExtPtfm_MCKF data + TYPE(MAP_Data), INTENT(INOUT) :: MAPp !< MAP data + TYPE(FEAMooring_Data), INTENT(INOUT) :: FEAM !< FEAMooring data + TYPE(MoorDyn_Data), INTENT(INOUT) :: MD !< Data for the MoorDyn module + TYPE(OrcaFlex_Data), INTENT(INOUT) :: Orca !< OrcaFlex interface data + TYPE(IceFloe_Data), INTENT(INOUT) :: IceF !< IceFloe data + TYPE(IceDyn_Data), INTENT(INOUT) :: IceD !< All the IceDyn data used in time-step loop + + TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules + + 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 ! generic loop counters + REAL(DbKi) :: t_global ! the time to which states, inputs and outputs are reset + INTEGER(IntKi) :: old_avrSwap1 ! previous value of avrSwap(1) !hack for Bladed DLL checkpoint/restore + + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_Store_SubStep' + + + ErrStat = ErrID_None + ErrMsg = "" + + + t_global = t_initial + n_t_global * p_FAST%DT + + !---------------------------------------------------------------------------------------- + !! copy the stored states and inputs from n_t_global the current states and inputs + !---------------------------------------------------------------------------------------- + + DO j = 1, p_FAST%InterpOrder + 1 + ED%InputTimes_Saved(j) = ED%InputTimes(j) + END DO + + DO j = 1, p_FAST%InterpOrder + 1 + CALL ED_CopyInput (ED%Input(j), ED%Input_Saved(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + CALL ED_CopyOutput (ED%y, ED%Output_bak(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + + ! ElastoDyn: copy final predictions to actual states + CALL ED_CopyContState (ED%x( STATE_PRED), ED%x( STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ED_CopyDiscState (ED%xd(STATE_PRED), ED%xd(STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ED_CopyConstrState (ED%z( STATE_PRED), ED%z( STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ED_CopyOtherState (ED%OtherSt( STATE_PRED), ED%OtherSt( STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL ED_CopyContState (ED%x( STATE_CURR), ED%x( STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ED_CopyDiscState (ED%xd(STATE_CURR), ED%xd(STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ED_CopyConstrState (ED%z( STATE_CURR), ED%z( STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ED_CopyOtherState (ED%OtherSt( STATE_CURR), ED%OtherSt( STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + IF (p_FAST%CompElast == Module_BD ) THEN + + DO k = 1,p_FAST%nBeams + + ! Copy values for interpolation/extrapolation: + DO j = 1, p_FAST%InterpOrder + 1 + BD%InputTimes_Saved(j,k) = BD%InputTimes(j,k) + END DO + + DO j = 1, p_FAST%InterpOrder + 1 + CALL BD_CopyInput (BD%Input(j,k), BD%Input_Saved(j,k), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + + CALL BD_CopyContState (BD%x( k,STATE_PRED), BD%x( k,STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL BD_CopyDiscState (BD%xd(k,STATE_PRED), BD%xd(k,STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL BD_CopyConstrState (BD%z( k,STATE_PRED), BD%z( k,STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL BD_CopyOtherState (BD%OtherSt( k,STATE_PRED), BD%OtherSt( k,STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL BD_CopyContState (BD%x( k,STATE_CURR), BD%x( k,STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL BD_CopyDiscState (BD%xd(k,STATE_CURR), BD%xd(k,STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL BD_CopyConstrState (BD%z( k,STATE_CURR), BD%z( k,STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL BD_CopyOtherState (BD%OtherSt( k,STATE_CURR), BD%OtherSt( k,STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + + END IF + + IF ( p_FAST%CompServo == Module_SrvD ) THEN + ! Initialize Input-Output arrays for interpolation/extrapolation: + + DO j = 1, p_FAST%InterpOrder + 1 + SrvD%InputTimes_Saved(j) = SrvD%InputTimes(j) + END DO + + DO j = 1, p_FAST%InterpOrder + 1 + CALL SrvD_CopyInput (SrvD%Input(j), SrvD%Input_Saved(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + + CALL SrvD_CopyContState (SrvD%x( STATE_PRED), SrvD%x( STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SrvD_CopyDiscState (SrvD%xd(STATE_PRED), SrvD%xd(STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SrvD_CopyConstrState (SrvD%z( STATE_PRED), SrvD%z( STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SrvD_CopyOtherState (SrvD%OtherSt( STATE_PRED), SrvD%OtherSt( STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL SrvD_CopyContState (SrvD%x( STATE_CURR), SrvD%x( STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SrvD_CopyDiscState (SrvD%xd(STATE_CURR), SrvD%xd(STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SrvD_CopyConstrState (SrvD%z( STATE_CURR), SrvD%z( STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SrvD_CopyOtherState (SrvD%OtherSt( STATE_CURR), SrvD%OtherSt( STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL SrvD_CopyMisc( SrvD%m, SrvD%m_bak, MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + END IF + + IF ( (p_FAST%CompAero == Module_AD) .or. (p_FAST%CompAero == Module_ExtLd) ) THEN + ! Copy values for interpolation/extrapolation: + + DO j = 1, p_FAST%InterpOrder + 1 + AD%InputTimes_Saved(j) = AD%InputTimes(j) + END DO + + DO j = 1, p_FAST%InterpOrder + 1 + CALL AD_CopyInput (AD%Input(j), AD%Input_Saved(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + + CALL AD_CopyContState (AD%x( STATE_PRED), AD%x( STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AD_CopyDiscState (AD%xd(STATE_PRED), AD%xd(STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AD_CopyConstrState (AD%z( STATE_PRED), AD%z( STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AD_CopyOtherState (AD%OtherSt(STATE_PRED), AD%OtherSt(STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL AD_CopyContState (AD%x( STATE_CURR), AD%x( STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AD_CopyDiscState (AD%xd(STATE_CURR), AD%xd(STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AD_CopyConstrState (AD%z( STATE_CURR), AD%z( STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AD_CopyOtherState (AD%OtherSt(STATE_CURR), AD%OtherSt(STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + END IF ! CompAero == Module_AD + + IF ( p_FAST%CompInflow == Module_IfW ) THEN + ! Copy values for interpolation/extrapolation: + + DO j = 1, p_FAST%InterpOrder + 1 + IfW%InputTimes_Saved(j) = IfW%InputTimes(j) + !IfW%OutputTimes(i) = t_global - (j - 1) * dt + END DO + + DO j = 1, p_FAST%InterpOrder + 1 + CALL InflowWind_CopyInput (IfW%Input(j), IfW%Input_Saved(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + + CALL InflowWind_CopyContState (IfW%x( STATE_PRED), IfW%x( STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL InflowWind_CopyDiscState (IfW%xd(STATE_PRED), IfW%xd(STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL InflowWind_CopyConstrState (IfW%z( STATE_PRED), IfW%z( STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL InflowWind_CopyOtherState (IfW%OtherSt( STATE_PRED), IfW%OtherSt( STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL InflowWind_CopyContState (IfW%x( STATE_CURR), IfW%x( STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL InflowWind_CopyDiscState (IfW%xd(STATE_CURR), IfW%xd(STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL InflowWind_CopyConstrState (IfW%z( STATE_CURR), IfW%z( STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL InflowWind_CopyOtherState (IfW%OtherSt( STATE_CURR), IfW%OtherSt( STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + END IF ! CompInflow == Module_IfW + + + IF ( p_FAST%CompHydro == Module_HD ) THEN + ! Copy values for interpolation/extrapolation: + DO j = 1, p_FAST%InterpOrder + 1 + HD%InputTimes_Saved(j) = HD%InputTimes(j) + !HD_OutputTimes(i) = t_global - (j - 1) * dt + END DO + + DO j = 1, p_FAST%InterpOrder + 1 + CALL HydroDyn_CopyInput (HD%Input(j), HD%Input_Saved(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + + CALL HydroDyn_CopyContState (HD%x( STATE_PRED), HD%x( STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL HydroDyn_CopyDiscState (HD%xd(STATE_PRED), HD%xd(STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL HydroDyn_CopyConstrState (HD%z( STATE_PRED), HD%z( STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL HydroDyn_CopyOtherState (HD%OtherSt(STATE_PRED), HD%OtherSt(STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL HydroDyn_CopyContState (HD%x( STATE_CURR), HD%x( STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL HydroDyn_CopyDiscState (HD%xd(STATE_CURR), HD%xd(STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL HydroDyn_CopyConstrState (HD%z( STATE_CURR), HD%z( STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL HydroDyn_CopyOtherState (HD%OtherSt(STATE_CURR), HD%OtherSt(STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + END IF !CompHydro + + + IF (p_FAST%CompSub == Module_SD ) THEN + + ! Copy values for interpolation/extrapolation: + DO j = 1, p_FAST%InterpOrder + 1 + SD%InputTimes_Saved(j) = SD%InputTimes(j) + !SD_OutputTimes(i) = t_global - (j - 1) * dt + END DO + + DO j = 1, p_FAST%InterpOrder + 1 + CALL SD_CopyInput (SD%Input(j), SD%Input_Saved(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + + CALL SD_CopyContState (SD%x( STATE_PRED), SD%x( STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SD_CopyDiscState (SD%xd(STATE_PRED), SD%xd(STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SD_CopyConstrState (SD%z( STATE_PRED), SD%z( STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SD_CopyOtherState (SD%OtherSt(STATE_PRED), SD%OtherSt(STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL SD_CopyContState (SD%x( STATE_CURR), SD%x( STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SD_CopyDiscState (SD%xd(STATE_CURR), SD%xd(STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SD_CopyConstrState (SD%z( STATE_CURR), SD%z( STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SD_CopyOtherState (SD%OtherSt(STATE_CURR), SD%OtherSt(STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ELSE IF (p_FAST%CompSub == Module_ExtPtfm ) THEN + + ! Copy values for interpolation/extrapolation: + DO j = 1, p_FAST%InterpOrder + 1 + ExtPtfm%InputTimes_Saved(j) = ExtPtfm%InputTimes(j) + END DO + + DO j = 1, p_FAST%InterpOrder + 1 + CALL ExtPtfm_CopyInput (ExtPtfm%Input(j), ExtPtfm%Input_Saved(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + + CALL ExtPtfm_CopyContState (ExtPtfm%x( STATE_PRED), ExtPtfm%x( STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ExtPtfm_CopyDiscState (ExtPtfm%xd(STATE_PRED), ExtPtfm%xd(STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ExtPtfm_CopyConstrState (ExtPtfm%z( STATE_PRED), ExtPtfm%z( STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ExtPtfm_CopyOtherState (ExtPtfm%OtherSt(STATE_PRED), ExtPtfm%OtherSt(STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL ExtPtfm_CopyContState (ExtPtfm%x( STATE_CURR), ExtPtfm%x( STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ExtPtfm_CopyDiscState (ExtPtfm%xd(STATE_CURR), ExtPtfm%xd(STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ExtPtfm_CopyConstrState (ExtPtfm%z( STATE_CURR), ExtPtfm%z( STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ExtPtfm_CopyOtherState (ExtPtfm%OtherSt(STATE_CURR), ExtPtfm%OtherSt(STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + END IF ! CompSub + + + IF (p_FAST%CompMooring == Module_MAP) THEN + ! Copy values for interpolation/extrapolation: + + DO j = 1, p_FAST%InterpOrder + 1 + MAPp%InputTimes_Saved(j) = MAPp%InputTimes(j) + !MAP_OutputTimes(i) = t_global - (j - 1) * dt + END DO + + DO j = 1, p_FAST%InterpOrder + 1 + CALL MAP_CopyInput (MAPp%Input(j), MAPp%Input_Saved(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + + CALL MAP_CopyContState (MAPp%x( STATE_PRED), MAPp%x( STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL MAP_CopyDiscState (MAPp%xd(STATE_PRED), MAPp%xd(STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL MAP_CopyConstrState (MAPp%z( STATE_PRED), MAPp%z( STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + !CALL MAP_CopyOtherState (MAPp%OtherSt(STATE_PRED), MAPp%OtherSt(STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + ! CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL MAP_CopyContState (MAPp%x( STATE_CURR), MAPp%x( STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL MAP_CopyDiscState (MAPp%xd(STATE_CURR), MAPp%xd(STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL MAP_CopyConstrState (MAPp%z( STATE_CURR), MAPp%z( STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + !CALL MAP_CopyOtherState (MAPp%OtherSt(STATE_CURR), MAPp%OtherSt(STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + ! CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ELSEIF (p_FAST%CompMooring == Module_MD) THEN + ! Copy values for interpolation/extrapolation: + + DO j = 1, p_FAST%InterpOrder + 1 + MD%InputTimes_Saved(j) = MD%InputTimes(j) + !MD_OutputTimes(i) = t_global - (j - 1) * dt + END DO + + DO j = 1, p_FAST%InterpOrder + 1 + CALL MD_CopyInput (MD%Input(j), MD%Input_Saved(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + + CALL MD_CopyContState (MD%x( STATE_PRED), MD%x( STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL MD_CopyDiscState (MD%xd(STATE_PRED), MD%xd(STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL MD_CopyConstrState (MD%z( STATE_PRED), MD%z( STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL MD_CopyOtherState (MD%OtherSt(STATE_PRED), MD%OtherSt(STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL MD_CopyContState (MD%x( STATE_CURR), MD%x( STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL MD_CopyDiscState (MD%xd(STATE_CURR), MD%xd(STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL MD_CopyConstrState (MD%z( STATE_CURR), MD%z( STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL MD_CopyOtherState (MD%OtherSt(STATE_CURR), MD%OtherSt(STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ELSEIF (p_FAST%CompMooring == Module_FEAM) THEN + ! Copy values for interpolation/extrapolation: + + DO j = 1, p_FAST%InterpOrder + 1 + FEAM%InputTimes_Saved(j) = FEAM%InputTimes(j) + !FEAM_OutputTimes(i) = t_global - (j - 1) * dt + END DO + + DO j = 1, p_FAST%InterpOrder + 1 + CALL FEAM_CopyInput (FEAM%Input(j), FEAM%Input_Saved(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + + CALL FEAM_CopyContState (FEAM%x( STATE_PRED), FEAM%x( STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL FEAM_CopyDiscState (FEAM%xd(STATE_PRED), FEAM%xd(STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL FEAM_CopyConstrState (FEAM%z( STATE_PRED), FEAM%z( STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL FEAM_CopyOtherState (FEAM%OtherSt( STATE_PRED), FEAM%OtherSt( STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL FEAM_CopyContState (FEAM%x( STATE_CURR), FEAM%x( STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL FEAM_CopyDiscState (FEAM%xd(STATE_CURR), FEAM%xd(STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL FEAM_CopyConstrState (FEAM%z( STATE_CURR), FEAM%z( STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL FEAM_CopyOtherState (FEAM%OtherSt( STATE_CURR), FEAM%OtherSt( STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ELSEIF (p_FAST%CompMooring == Module_Orca) THEN + ! Copy values for interpolation/extrapolation: + + DO j = 1, p_FAST%InterpOrder + 1 + Orca%InputTimes_Saved(j) = Orca%InputTimes(j) + END DO + + DO j = 1, p_FAST%InterpOrder + 1 + CALL Orca_CopyInput (Orca%Input(j), Orca%Input_Saved(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + + CALL Orca_CopyContState (Orca%x( STATE_PRED), Orca%x( STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL Orca_CopyDiscState (Orca%xd(STATE_PRED), Orca%xd(STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL Orca_CopyConstrState (Orca%z( STATE_PRED), Orca%z( STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL Orca_CopyOtherState (Orca%OtherSt( STATE_PRED), Orca%OtherSt( STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL Orca_CopyContState (Orca%x( STATE_CURR), Orca%x( STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL Orca_CopyDiscState (Orca%xd(STATE_CURR), Orca%xd(STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL Orca_CopyConstrState (Orca%z( STATE_CURR), Orca%z( STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL Orca_CopyOtherState (Orca%OtherSt( STATE_CURR), Orca%OtherSt( STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + END IF ! CompMooring + + + IF (p_FAST%CompIce == Module_IceF ) THEN + + ! Copy values for interpolation/extrapolation: + DO j = 1, p_FAST%InterpOrder + 1 + IceF%InputTimes_Saved(j) = IceF%InputTimes(j) + !IceF_OutputTimes(i) = t_global - (j - 1) * dt + END DO + + DO j = 1, p_FAST%InterpOrder + 1 + CALL IceFloe_CopyInput (IceF%Input(j), IceF%Input_Saved(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + + CALL IceFloe_CopyContState (IceF%x( STATE_PRED), IceF%x( STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceFloe_CopyDiscState (IceF%xd(STATE_PRED), IceF%xd(STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceFloe_CopyConstrState (IceF%z( STATE_PRED), IceF%z( STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceFloe_CopyOtherState (IceF%OtherSt(STATE_PRED), IceF%OtherSt(STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL IceFloe_CopyContState (IceF%x( STATE_CURR), IceF%x( STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceFloe_CopyDiscState (IceF%xd(STATE_CURR), IceF%xd(STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceFloe_CopyConstrState (IceF%z( STATE_CURR), IceF%z( STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceFloe_CopyOtherState (IceF%OtherSt(STATE_CURR), IceF%OtherSt(STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ELSEIF (p_FAST%CompIce == Module_IceD ) THEN + + DO i = 1,p_FAST%numIceLegs + + ! Copy values for interpolation/extrapolation: + DO j = 1, p_FAST%InterpOrder + 1 + IceD%InputTimes_Saved(j,i) = IceD%InputTimes(j,i) + !IceD%OutputTimes(j,i) = t_global - (j - 1) * dt + END DO + + DO j = 1, p_FAST%InterpOrder + 1 + CALL IceD_CopyInput (IceD%Input(j,i), IceD%Input_Saved(j,i), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + + CALL IceD_CopyContState (IceD%x( i,STATE_PRED), IceD%x( i,STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceD_CopyDiscState (IceD%xd(i,STATE_PRED), IceD%xd(i,STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceD_CopyConstrState (IceD%z( i,STATE_PRED), IceD%z( i,STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceD_CopyOtherState (IceD%OtherSt( i,STATE_PRED), IceD%OtherSt( i,STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL IceD_CopyContState (IceD%x( i,STATE_CURR), IceD%x( i,STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceD_CopyDiscState (IceD%xd(i,STATE_CURR), IceD%xd(i,STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceD_CopyConstrState (IceD%z( i,STATE_CURR), IceD%z( i,STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceD_CopyOtherState (IceD%OtherSt( i,STATE_CURR), IceD%OtherSt( i,STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + END DO ! numIceLegs + + END IF ! CompIce + + ! A hack to store Bladed-style DLL data + if (SrvD%p%UseBladedInterface) then + if (SrvD%m%dll_data%avrSWAP( 1) > 0 ) then ! this isn't allocated if UseBladedInterface is FALSE + ! store value to be overwritten + old_avrSwap1 = SrvD%m%dll_data%avrSWAP( 1) + SrvD%m%dll_data%avrSWAP( 1) = -11 + CALL CallBladedDLL(SrvD%Input(1), SrvD%p, SrvD%m%dll_data, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ! put values back: + SrvD%m%dll_data%avrSWAP( 1) = old_avrSwap1 + end if + end if + +END SUBROUTINE FAST_Store_SubStep +!---------------------------------------------------------------------------------------------------------------------------------- +!> Routine that calls FAST_Solution for one instance of a Turbine data structure. This is a separate subroutine so that the FAST +!! driver programs do not need to change or operate on the individual module level. +SUBROUTINE FAST_Solution_T(t_initial, n_t_global, Turbine, ErrStat, ErrMsg ) + + REAL(DbKi), INTENT(IN ) :: t_initial !< initial time + INTEGER(IntKi), INTENT(IN ) :: n_t_global !< loop counter + TYPE(FAST_TurbineType), INTENT(INOUT) :: Turbine !< all data for one instance of a turbine + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + CALL FAST_Solution(t_initial, n_t_global, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & + Turbine%ED, Turbine%SED, Turbine%BD, Turbine%SrvD, Turbine%AD, Turbine%ADsk, Turbine%ExtLd, Turbine%IfW, Turbine%ExtInfw, Turbine%SC_DX, & + Turbine%SeaSt, Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & + Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat, ErrMsg ) + +END SUBROUTINE FAST_Solution_T +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine takes data from n_t_global and gets values at n_t_global + 1 +SUBROUTINE FAST_Solution(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, SED, BD, SrvD, AD, ADsk, ExtLd, IfW, ExtInfw, SC_DX, SeaSt, HD, SD, ExtPtfm, & + MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat, ErrMsg ) + + REAL(DbKi), INTENT(IN ) :: t_initial !< initial time + INTEGER(IntKi), INTENT(IN ) :: n_t_global !< loop counter + + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code + TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Output variables for the glue code + TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables + + TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data + TYPE(SED_Data), INTENT(INOUT) :: SED !< Simplified-ElastoDyn data + TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data + TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data + TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data + TYPE(AeroDisk_Data), INTENT(INOUT) :: ADsk !< AeroDisk data + TYPE(ExtLoads_Data), INTENT(INOUT) :: ExtLd !< External loads data + TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data + TYPE(ExternalInflow_Data),INTENT(INOUT) :: ExtInfw !< ExternalInflow data + TYPE(SCDataEx_Data), INTENT(INOUT) :: SC_DX !< Supercontroller Exchange data + TYPE(SeaState_Data), INTENT(INOUT) :: SeaSt !< SeaState data + TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HydroDyn data + TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SubDyn data + TYPE(ExtPtfm_Data), INTENT(INOUT) :: ExtPtfm !< ExtPtfm_MCKF data + TYPE(MAP_Data), INTENT(INOUT) :: MAPp !< MAP data + TYPE(FEAMooring_Data), INTENT(INOUT) :: FEAM !< FEAMooring data + TYPE(MoorDyn_Data), INTENT(INOUT) :: MD !< Data for the MoorDyn module + TYPE(OrcaFlex_Data), INTENT(INOUT) :: Orca !< OrcaFlex interface data + TYPE(IceFloe_Data), INTENT(INOUT) :: IceF !< IceFloe data + TYPE(IceDyn_Data), INTENT(INOUT) :: IceD !< All the IceDyn data used in time-step loop + + TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules + + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + ! local variables + INTEGER(IntKi) :: n_t_global_next ! n_t_global + 1 + + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_Solution' + + ErrStat = ErrID_None + ErrMsg = "" + + n_t_global_next = n_t_global+1 + + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + !! ## Step 1.a: set some variables and Extrapolate Inputs + + call FAST_Prework(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, SED, BD, SrvD, AD, ADsk, ExtLd, IfW, ExtInfw, SC_DX, & + SeaSt, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + !! ## Step 1.b: Advance states (yield state and constraint values at t_global_next) + !! ## Step 1.c: Input-Output Solve + !! ## Step 2: Correct (continue in loop) + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + call FAST_UpdateStates(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, SED, BD, SrvD, AD, ADsk, ExtLd, IfW, ExtInfw, SC_DX, & + SeaSt, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + !! ## Step 3: Save all final variables (advance to next time) and reset global time + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + call FAST_AdvanceToNextTimeStep(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, SED, BD, SrvD, AD, ADsk, ExtLd, IfW, ExtInfw, SC_DX, & + SeaSt, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + + !---------------------------------------------------------------------------------------- + !! Write outputs + !---------------------------------------------------------------------------------------- + call FAST_WriteOutput(t_initial, n_t_global_next, p_FAST, y_FAST, m_FAST, ED, SED, BD, SrvD, AD, ADsk, ExtLd, IfW, ExtInfw, SC_DX, & + SeaSt, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + +END SUBROUTINE FAST_Solution + +!---------------------------------------------------------------------------------------------------------------------------------- +!> Routine that calls FAST_Prework for one instance of a Turbine data structure. This is a separate subroutine so that the FAST +!! driver programs do not need to change or operate on the individual module level. +SUBROUTINE FAST_Prework_T(t_initial, n_t_global, Turbine, ErrStat, ErrMsg ) + + REAL(DbKi), INTENT(IN ) :: t_initial !< initial time + INTEGER(IntKi), INTENT(IN ) :: n_t_global !< loop counter + TYPE(FAST_TurbineType), INTENT(INOUT) :: Turbine !< all data for one instance of a turbine + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + CALL FAST_Prework(t_initial, n_t_global, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & + Turbine%ED, Turbine%SED, Turbine%BD, Turbine%SrvD, Turbine%AD, Turbine%ADsk, Turbine%ExtLd, Turbine%IfW, Turbine%ExtInfw, Turbine%SC_DX, & + Turbine%SeaSt, Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & + Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat, ErrMsg ) + +END SUBROUTINE FAST_Prework_T +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine does thde prep work to advance the time step from n_t_global to n_t_global + 1 +SUBROUTINE FAST_Prework(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, SED, BD, SrvD, AD, ADsk, ExtLd, IfW, ExtInfw, SC_DX, & + SeaSt, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat, ErrMsg ) + + REAL(DbKi), INTENT(IN ) :: t_initial !< initial time + INTEGER(IntKi), INTENT(IN ) :: n_t_global !< loop counter + + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code + TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Output variables for the glue code + TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables + + TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data + TYPE(SED_Data), INTENT(INOUT) :: SED !< Simplified-ElastoDyn data + TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data + TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data + TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data + TYPE(AeroDisk_Data), INTENT(INOUT) :: ADsk !< AeroDisk data + TYPE(ExtLoads_Data), INTENT(INOUT) :: ExtLd !< External loads data + TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data + TYPE(ExternalInflow_Data),INTENT(INOUT) :: ExtInfw !< ExternalInflow data + TYPE(SCDataEx_Data), INTENT(INOUT) :: SC_DX !< Supercontroller Exchange data + TYPE(SeaState_Data), INTENT(INOUT) :: SeaSt !< SeaState data + TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HydroDyn data + TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SubDyn data + TYPE(ExtPtfm_Data), INTENT(INOUT) :: ExtPtfm !< ExtPtfm_MCKF data + TYPE(MAP_Data), INTENT(INOUT) :: MAPp !< MAP data + TYPE(FEAMooring_Data), INTENT(INOUT) :: FEAM !< FEAMooring data + TYPE(MoorDyn_Data), INTENT(INOUT) :: MD !< Data for the MoorDyn module + TYPE(OrcaFlex_Data), INTENT(INOUT) :: Orca !< OrcaFlex interface data + TYPE(IceFloe_Data), INTENT(INOUT) :: IceF !< IceFloe data + TYPE(IceDyn_Data), INTENT(INOUT) :: IceD !< All the IceDyn data used in time-step loop + + TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules + + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + ! local variables + INTEGER(IntKi) :: n_t_global_next ! n_t_global + 1 + REAL(DbKi) :: t_global_next ! next simulation time (m_FAST%t_global + p_FAST%dt) + + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_Prework' + + + ErrStat = ErrID_None + ErrMsg = "" + + n_t_global_next = n_t_global+1 + t_global_next = t_initial + n_t_global_next*p_FAST%DT ! = m_FAST%t_global + p_FAST%dt + + ! set flag for writing output at time t_global_next + y_FAST%WriteThisStep = NeedWriteOutput(n_t_global_next, t_global_next, p_FAST) + + !! determine if the Jacobian should be calculated this time + IF ( m_FAST%calcJacobian ) THEN ! this was true (possibly at initialization), so we'll advance the time for the next calculation of the Jacobian + + if (p_FAST%CompMooring == Module_Orca .and. n_t_global < 5) then + m_FAST%NextJacCalcTime = m_FAST%t_global + p_FAST%DT ! the jacobian calculated with OrcaFlex at t=0 is incorrect, but is okay on the 2nd step (it's not okay for OrcaFlex version 10, so I increased this to 5) + else + m_FAST%NextJacCalcTime = m_FAST%t_global + p_FAST%DT_UJac + end if + + END IF + + ! the ServoDyn inputs from Simulink are for t, not t+dt, so we're going to overwrite the inputs from + ! the previous step before we extrapolate these inputs: + IF ( p_FAST%CompServo == Module_SrvD ) CALL SrvD_SetExternalInputs( p_FAST, m_FAST, SrvD%Input(1) ) + + IF ( p_FAST%UseSC ) THEN + CALL SC_DX_SetOutputs(p_FAST, SrvD%Input(1), SC_DX, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END IF + + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + !! ## Step 1.a: Extrapolate Inputs + !! + !! gives predicted values at t+dt + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + CALL FAST_ExtrapInterpMods( t_global_next, p_FAST, m_FAST, ED, SED, BD, SrvD, AD, ADsk, ExtLd, IfW, HD, SD, ExtPtfm, & + MAPp, FEAM, MD, Orca, IceF, IceD, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + +END SUBROUTINE FAST_Prework +!---------------------------------------------------------------------------------------------------------------------------------- +!---------------------------------------------------------------------------------------------------------------------------------- +!> Routine that calls FAST_UpdateStates for one instance of a Turbine data structure. This is a separate subroutine so that the FAST +!! driver programs do not need to change or operate on the individual module level. +SUBROUTINE FAST_UpdateStates_T(t_initial, n_t_global, Turbine, ErrStat, ErrMsg ) + + REAL(DbKi), INTENT(IN ) :: t_initial !< initial time + INTEGER(IntKi), INTENT(IN ) :: n_t_global !< loop counter + TYPE(FAST_TurbineType), INTENT(INOUT) :: Turbine !< all data for one instance of a turbine + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + CALL FAST_UpdateStates(t_initial, n_t_global, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & + Turbine%ED, Turbine%SED, Turbine%BD, Turbine%SrvD, Turbine%AD, Turbine%ADsk, Turbine%ExtLd, Turbine%IfW, Turbine%ExtInfw, Turbine%SC_DX, & + Turbine%SeaSt, Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & + Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat, ErrMsg ) + +END SUBROUTINE FAST_UpdateStates_T +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine takes data from n_t_global and predicts the states and output at n_t_global+1 +SUBROUTINE FAST_UpdateStates(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, SED, BD, SrvD, AD, ADsk, ExtLd, IfW, ExtInfw, SC_DX, & + SeaSt, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat, ErrMsg ) + + REAL(DbKi), INTENT(IN ) :: t_initial !< initial time + INTEGER(IntKi), INTENT(IN ) :: n_t_global !< loop counter + + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code + TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Output variables for the glue code + TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables + + TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data + TYPE(SED_Data), INTENT(INOUT) :: SED !< Simplified-ElastoDyn data + TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data + TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data + TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data + TYPE(AeroDisk_Data), INTENT(INOUT) :: ADsk !< AeroDisk data + TYPE(ExtLoads_Data), INTENT(INOUT) :: ExtLd !< External loads data + TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data + TYPE(ExternalInflow_Data),INTENT(INOUT) :: ExtInfw !< ExternalInflow data + TYPE(SCDataEx_Data), INTENT(INOUT) :: SC_DX !< Supercontroller Exchange data + TYPE(SeaState_Data), INTENT(INOUT) :: SeaSt !< SeaState data + TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HydroDyn data + TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SubDyn data + TYPE(ExtPtfm_Data), INTENT(INOUT) :: ExtPtfm !< ExtPtfm_MCKF data + TYPE(MAP_Data), INTENT(INOUT) :: MAPp !< MAP data + TYPE(FEAMooring_Data), INTENT(INOUT) :: FEAM !< FEAMooring data + TYPE(MoorDyn_Data), INTENT(INOUT) :: MD !< Data for the MoorDyn module + TYPE(OrcaFlex_Data), INTENT(INOUT) :: Orca !< OrcaFlex interface data + TYPE(IceFloe_Data), INTENT(INOUT) :: IceF !< IceFloe data + TYPE(IceDyn_Data), INTENT(INOUT) :: IceD !< All the IceDyn data used in time-step loop + + TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules + + 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_global_next ! next simulation time (m_FAST%t_global + p_FAST%dt) + INTEGER(IntKi) :: n_t_global_next ! n_t_global + 1 + INTEGER(IntKi) :: j_pc ! predictor-corrector loop counter + INTEGER(IntKi) :: NumCorrections ! number of corrections for this time step + INTEGER(IntKi), parameter :: MaxCorrections = 20 ! maximum number of corrections allowed + LOGICAL :: WriteThisStep ! Whether WriteOutput values will be printed + + !REAL(ReKi) :: ControlInputGuess ! value of controller inputs + + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UpdateStates' + + + ErrStat = ErrID_None + ErrMsg = "" + + t_global_next = t_initial + (n_t_global+1)*p_FAST%DT ! = m_FAST%t_global + p_FAST%dt + n_t_global_next = n_t_global+1 + + ! set number of corrections to be used for this time step: + IF ( p_FAST%CompElast == Module_BD ) THEN ! BD accelerations have fewer spikes with these corrections on the first several time steps + if (n_t_global > 2) then ! this 2 should probably be related to p_FAST%InterpOrder + NumCorrections = p_FAST%NumCrctn + elseif (n_t_global == 0) then + NumCorrections = max(p_FAST%NumCrctn,16) + else + NumCorrections = max(p_FAST%NumCrctn,1) + end if + ELSE + NumCorrections = p_FAST%NumCrctn + END IF !! predictor-corrector loop: j_pc = 0 @@ -4859,7 +7651,7 @@ SUBROUTINE FAST_Solution(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, !! STATE_PRED values contain values at t_global_next. !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - CALL FAST_AdvanceStates( t_initial, n_t_global, p_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, OpFM, HD, SD, ExtPtfm, & + CALL FAST_AdvanceStates( t_initial, n_t_global, p_FAST, m_FAST, ED, SED, BD, SrvD, AD, ADsk, ExtLd, IfW, ExtInfw, HD, SD, ExtPtfm, & MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2, WriteThisStep ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) IF (ErrStat >= AbortErrLev) RETURN @@ -4873,7 +7665,7 @@ SUBROUTINE FAST_Solution(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, !END IF CALL CalcOutputs_And_SolveForInputs( n_t_global, t_global_next, STATE_PRED, m_FAST%calcJacobian, m_FAST%NextJacCalcTime, & - p_FAST, m_FAST, WriteThisStep, ED, BD, SrvD, AD14, AD, IfW, OpFM, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2 ) + p_FAST, m_FAST, WriteThisStep, ED, SED, BD, SrvD, AD, ADsk, ExtLd, IfW, ExtInfw, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) IF (ErrStat >= AbortErrLev) RETURN @@ -4897,12 +7689,89 @@ SUBROUTINE FAST_Solution(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, ! ! check pitch position input to structural code (not implemented, yet) !end if - enddo ! j_pc + enddo ! j_pc + + if (p_FAST%UseSC ) then + call SC_DX_SetInputs(p_FAST, SrvD%y, SC_DX, ErrStat2, ErrMsg2 ) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + end if + + if ( P_FAST%CompSeaSt == Module_SeaSt .and. y_FAST%WriteThisStep) then + ! note: SeaState has no inputs and only calculates WriteOutputs, so we don't need to call CalcOutput unless we are writing to the file + call SeaSt_CalcOutput( t_global_next, SeaSt%u, SeaSt%p, SeaSt%x(1), SeaSt%xd(1), SeaSt%z(1), SeaSt%OtherSt(1), SeaSt%y, SeaSt%m, ErrStat2, ErrMsg2 ) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + end if + +END SUBROUTINE FAST_UpdateStates + +!---------------------------------------------------------------------------------------------------------------------------------- +!> Routine that calls FAST_AdvanceToNextTimeStep for one instance of a Turbine data structure. This is a separate subroutine so that the FAST +!! driver programs do not need to change or operate on the individual module level. +SUBROUTINE FAST_AdvanceToNextTimeStep_T(t_initial, n_t_global, Turbine, ErrStat, ErrMsg ) + + REAL(DbKi), INTENT(IN ) :: t_initial !< initial time + INTEGER(IntKi), INTENT(IN ) :: n_t_global !< loop counter + TYPE(FAST_TurbineType), INTENT(INOUT) :: Turbine !< all data for one instance of a turbine + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + CALL FAST_AdvanceToNextTimeStep(t_initial, n_t_global, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & + Turbine%ED, Turbine%SED, Turbine%BD, Turbine%SrvD, Turbine%AD, Turbine%ADsk, Turbine%ExtLd, Turbine%IfW, Turbine%ExtInfw, Turbine%SC_DX, & + Turbine%SeaSt, Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & + Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat, ErrMsg ) + +END SUBROUTINE FAST_AdvanceToNextTimeStep_T +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine advances the time step from n_t_global to n_t_global + 1 and does all the relvant copying of data +SUBROUTINE FAST_AdvanceToNextTimeStep(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, SED, BD, SrvD, AD, ADsk, ExtLd, IfW, ExtInfw, SC_DX, & + SeaSt, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat, ErrMsg ) + + REAL(DbKi), INTENT(IN ) :: t_initial !< initial time + INTEGER(IntKi), INTENT(IN ) :: n_t_global !< loop counter + + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code + TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Output variables for the glue code + TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables + + TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data + TYPE(SED_Data), INTENT(INOUT) :: SED !< Simplified-ElastoDyn data + TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data + TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data + TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data + TYPE(AeroDisk_Data), INTENT(INOUT) :: ADsk !< AeroDisk data + TYPE(ExtLoads_Data), INTENT(INOUT) :: ExtLd !< External loads data + TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data + TYPE(ExternalInflow_Data),INTENT(INOUT) :: ExtInfw !< ExternalInflow data + TYPE(SCDataEx_Data), INTENT(INOUT) :: SC_DX !< Supercontroller Exchange data + TYPE(SeaState_Data), INTENT(INOUT) :: SeaSt !< SeaState data + TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HydroDyn data + TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SubDyn data + TYPE(ExtPtfm_Data), INTENT(INOUT) :: ExtPtfm !< ExtPtfm_MCKF data + TYPE(MAP_Data), INTENT(INOUT) :: MAPp !< MAP data + TYPE(FEAMooring_Data), INTENT(INOUT) :: FEAM !< FEAMooring data + TYPE(MoorDyn_Data), INTENT(INOUT) :: MD !< Data for the MoorDyn module + TYPE(OrcaFlex_Data), INTENT(INOUT) :: Orca !< OrcaFlex interface data + TYPE(IceFloe_Data), INTENT(INOUT) :: IceF !< IceFloe data + TYPE(IceDyn_Data), INTENT(INOUT) :: IceD !< All the IceDyn data used in time-step loop + + TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules + + 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_global_next ! next simulation time (m_FAST%t_global + p_FAST%dt) + INTEGER(IntKi) :: I, k ! generic loop counters - if (p_FAST%UseSC ) then - call SC_DX_SetInputs(p_FAST, SrvD%y, SC_DX, ErrStat2, ErrMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - end if + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_AdvanceToNextTimeStep' + + + ErrStat = ErrID_None + ErrMsg = "" + + t_global_next = t_initial + (n_t_global+1)*p_FAST%DT ! = m_FAST%t_global + p_FAST%dt !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ !! ## Step 3: Save all final variables (advance to next time) @@ -4912,15 +7781,27 @@ SUBROUTINE FAST_Solution(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, !! copy the final predicted states from step t_global_next to actual states for that step !---------------------------------------------------------------------------------------- - ! ElastoDyn: copy final predictions to actual states - CALL ED_CopyContState (ED%x( STATE_PRED), ED%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ED_CopyDiscState (ED%xd(STATE_PRED), ED%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ED_CopyConstrState (ED%z( STATE_PRED), ED%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ED_CopyOtherState (ED%OtherSt( STATE_PRED), ED%OtherSt( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + IF ( p_FAST%CompElast == Module_SED ) THEN + ! Simplified-ElastoDyn: copy final predictions to actual states + CALL SED_CopyContState (SED%x( STATE_PRED), SED%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SED_CopyDiscState (SED%xd(STATE_PRED), SED%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SED_CopyConstrState (SED%z( STATE_PRED), SED%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SED_CopyOtherState (SED%OtherSt( STATE_PRED), SED%OtherSt( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ELSE + ! ElastoDyn: copy final predictions to actual states + CALL ED_CopyContState (ED%x( STATE_PRED), ED%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ED_CopyDiscState (ED%xd(STATE_PRED), ED%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ED_CopyConstrState (ED%z( STATE_PRED), ED%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ED_CopyOtherState (ED%OtherSt( STATE_PRED), ED%OtherSt( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ENDIF ! BeamDyn: copy final predictions to actual states @@ -4939,16 +7820,7 @@ SUBROUTINE FAST_Solution(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, ! AeroDyn: copy final predictions to actual states; copy current outputs to next - IF ( p_FAST%CompAero == Module_AD14 ) THEN - CALL AD14_CopyContState (AD14%x( STATE_PRED), AD14%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AD14_CopyDiscState (AD14%xd(STATE_PRED), AD14%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AD14_CopyConstrState (AD14%z( STATE_PRED), AD14%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AD14_CopyOtherState (AD14%OtherSt(STATE_PRED), AD14%OtherSt(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ELSEIF ( p_FAST%CompAero == Module_AD ) THEN + IF ( (p_FAST%CompAero == Module_AD) .or. (p_FAST%CompAero == Module_ExtLd) ) THEN CALL AD_CopyContState (AD%x( STATE_PRED), AD%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) CALL AD_CopyDiscState (AD%xd(STATE_PRED), AD%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) @@ -4957,6 +7829,15 @@ SUBROUTINE FAST_Solution(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) CALL AD_CopyOtherState (AD%OtherSt(STATE_PRED), AD%OtherSt(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ELSEIF ( p_FAST%CompAero == Module_ADsk ) THEN + CALL ADsk_CopyContState (ADsk%x( STATE_PRED), ADsk%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ADsk_CopyDiscState (ADsk%xd(STATE_PRED), ADsk%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ADsk_CopyConstrState (ADsk%z( STATE_PRED), ADsk%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ADsk_CopyOtherState (ADsk%OtherSt(STATE_PRED), ADsk%OtherSt(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END IF @@ -4985,6 +7866,7 @@ SUBROUTINE FAST_Solution(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END IF + ! SeaState has no states ! HydroDyn: copy final predictions to actual states IF ( p_FAST%CompHydro == Module_HD ) THEN @@ -5092,12 +7974,78 @@ SUBROUTINE FAST_Solution(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, m_FAST%t_global = t_global_next +END SUBROUTINE FAST_AdvanceToNextTimeStep +!---------------------------------------------------------------------------------------------------------------------------------- +!> Routine that calls FAST_WriteOutput for one instance of a Turbine data structure. This is a separate subroutine so that the FAST +!! driver programs do not need to change or operate on the individual module level. +SUBROUTINE FAST_WriteOutput_T(t_initial, n_t_global, Turbine, ErrStat, ErrMsg ) + + REAL(DbKi), INTENT(IN ) :: t_initial !< initial time + INTEGER(IntKi), INTENT(IN ) :: n_t_global !< loop counter + TYPE(FAST_TurbineType), INTENT(INOUT) :: Turbine !< all data for one instance of a turbine + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + CALL FAST_WriteOutput(t_initial, n_t_global, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & + Turbine%ED, Turbine%SED, Turbine%BD, Turbine%SrvD, Turbine%AD, Turbine%ADsk, Turbine%ExtLd, Turbine%IfW, Turbine%ExtInfw, Turbine%SC_DX, & + Turbine%SeaSt, Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & + Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat, ErrMsg ) + +END SUBROUTINE FAST_WriteOutput_T +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine writes the outputs at this timestep +SUBROUTINE FAST_WriteOutput(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, SED, BD, SrvD, AD, ADsk, ExtLd, IfW, ExtInfw, SC_DX, & + SeaSt, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat, ErrMsg ) + + REAL(DbKi), INTENT(IN ) :: t_initial !< initial time + INTEGER(IntKi), INTENT(IN ) :: n_t_global !< loop counter + + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code + TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Output variables for the glue code + TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables + + TYPE(ElastoDyn_Data), INTENT(IN ) :: ED !< ElastoDyn data + TYPE(SED_Data), INTENT(IN ) :: SED !< Simplified-ElastoDyn data + TYPE(BeamDyn_Data), INTENT(IN ) :: BD !< BeamDyn data + TYPE(ServoDyn_Data), INTENT(IN ) :: SrvD !< ServoDyn data + TYPE(AeroDyn_Data), INTENT(IN ) :: AD !< AeroDyn data + TYPE(AeroDisk_Data), INTENT(IN ) :: ADsk !< AeroDisk data + TYPE(ExtLoads_Data), INTENT(IN ) :: ExtLd !< External loads data + TYPE(InflowWind_Data), INTENT(IN ) :: IfW !< InflowWind data + TYPE(ExternalInflow_Data),INTENT(IN ) :: ExtInfw !< ExternalInflow data + TYPE(SCDataEx_Data), INTENT(IN ) :: SC_DX !< Supercontroller Exchange data + TYPE(SeaState_Data), INTENT(IN ) :: SeaSt !< SeaState data + TYPE(HydroDyn_Data), INTENT(IN ) :: HD !< HydroDyn data + TYPE(SubDyn_Data), INTENT(IN ) :: SD !< SubDyn data + TYPE(ExtPtfm_Data), INTENT(IN ) :: ExtPtfm !< ExtPtfm_MCKF data + TYPE(MAP_Data), INTENT(IN ) :: MAPp !< MAP data + TYPE(FEAMooring_Data), INTENT(IN ) :: FEAM !< FEAMooring data + TYPE(MoorDyn_Data), INTENT(IN ) :: MD !< Data for the MoorDyn module + TYPE(OrcaFlex_Data), INTENT(IN ) :: Orca !< OrcaFlex interface data + TYPE(IceFloe_Data), INTENT(IN ) :: IceF !< IceFloe data + TYPE(IceDyn_Data), INTENT(IN ) :: IceD !< All the IceDyn data used in time-step loop + + TYPE(FAST_ModuleMapType), INTENT(IN ) :: MeshMapData !< Data for mapping between modules + + 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_global ! this simulation time (m_FAST%t_global + p_FAST%dt) + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_WriteOutput' + + + ErrStat = ErrID_None + ErrMsg = "" + + t_global = t_initial + n_t_global*p_FAST%DT !---------------------------------------------------------------------------------------- !! Check to see if we should output data this time step: !---------------------------------------------------------------------------------------- - - CALL WriteOutputToFile(n_t_global_next, t_global_next, p_FAST, y_FAST, ED, BD, AD14, AD, IfW, OpFM, HD, SD, ExtPtfm, & + CALL WriteOutputToFile(n_t_global, t_global, p_FAST, y_FAST, ED, SED, BD, AD, ADsk, IfW, ExtInfw, SeaSt, HD, SD, ExtPtfm, & SrvD, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -5106,13 +8054,13 @@ SUBROUTINE FAST_Solution(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, !---------------------------------------------------------------------------------------- IF (p_FAST%WrSttsTime) then - IF ( MOD( n_t_global_next, p_FAST%n_SttsTime ) == 0 ) THEN + IF ( MOD( n_t_global, p_FAST%n_SttsTime ) == 0 ) THEN CALL SimStatus( m_FAST%TiLstPrn, m_FAST%PrevClockTime, m_FAST%t_global, p_FAST%TMax, p_FAST%TDesc ) - ENDIF ENDIF -END SUBROUTINE FAST_Solution +END SUBROUTINE FAST_WriteOutput + !---------------------------------------------------------------------------------------------------------------------------------- ! ROUTINES TO OUTPUT WRITE DATA TO FILE AT EACH REQUSTED TIME STEP !---------------------------------------------------------------------------------------------------------------------------------- @@ -5134,7 +8082,7 @@ END FUNCTION NeedWriteOutput !> This routine determines if it's time to write to the output files--based on a previous call to fast_subs::needwriteoutput--, and !! calls the routine to write to the files with the output data. It should be called after all the output solves for a given time !! have been completed, and assumes y_FAST\%WriteThisStep has been set. -SUBROUTINE WriteOutputToFile(n_t_global, t_global, p_FAST, y_FAST, ED, BD, AD14, AD, IfW, OpFM, HD, SD, ExtPtfm, & +SUBROUTINE WriteOutputToFile(n_t_global, t_global, p_FAST, y_FAST, ED, SED, BD, AD, ADsk, IfW, ExtInfw, SeaSt, HD, SD, ExtPtfm, & SrvD, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat, ErrMsg) !............................................................................................................................... INTEGER(IntKi), INTENT(IN ) :: n_t_global !< Current global time step @@ -5143,12 +8091,14 @@ SUBROUTINE WriteOutputToFile(n_t_global, t_global, p_FAST, y_FAST, ED, BD, AD14, TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Output variables for the glue code TYPE(ElastoDyn_Data), INTENT(IN ) :: ED !< ElastoDyn data + TYPE(SED_Data), INTENT(IN ) :: SED !< Simplified-ElastoDyn data TYPE(BeamDyn_Data), INTENT(IN ) :: BD !< BeamDyn data TYPE(ServoDyn_Data), INTENT(IN ) :: SrvD !< ServoDyn data - TYPE(AeroDyn14_Data), INTENT(IN ) :: AD14 !< AeroDyn14 data TYPE(AeroDyn_Data), INTENT(IN ) :: AD !< AeroDyn data + TYPE(AeroDisk_Data), INTENT(IN ) :: ADsk !< AeroDisk data TYPE(InflowWind_Data), INTENT(IN ) :: IfW !< InflowWind data - TYPE(OpenFOAM_Data), INTENT(IN ) :: OpFM !< OpenFOAM data + TYPE(ExternalInflow_Data),INTENT(IN ) :: ExtInfw !< ExternalInflow data + TYPE(SeaState_Data), INTENT(IN ) :: SeaSt !< SeaState data TYPE(HydroDyn_Data), INTENT(IN ) :: HD !< HydroDyn data TYPE(SubDyn_Data), INTENT(IN ) :: SD !< SubDyn data TYPE(ExtPtfm_Data), INTENT(IN ) :: ExtPtfm !< ExtPtfm_MCKF data @@ -5175,8 +8125,8 @@ SUBROUTINE WriteOutputToFile(n_t_global, t_global, p_FAST, y_FAST, ED, BD, AD14, IF ( y_FAST%WriteThisStep ) THEN ! Generate glue-code output file - CALL WrOutputLine( t_global, p_FAST, y_FAST, IfW%y%WriteOutput, OpFM%y%WriteOutput, ED%y%WriteOutput, & - AD%y, SrvD%y%WriteOutput, HD%y%WriteOutput, SD%y%WriteOutput, ExtPtfm%y%WriteOutput, MAPp%y%WriteOutput, & + CALL WrOutputLine( t_global, p_FAST, y_FAST, IfW%y%WriteOutput, ExtInfw%y%WriteOutput, ED%y%WriteOutput, SED%y%WriteOutput, & + AD%y, ADsk%y%WriteOutput, SrvD%y%WriteOutput, SeaSt%y%WriteOutput, HD%y%WriteOutput, SD%y%WriteOutput, ExtPtfm%y%WriteOutput, MAPp%y%WriteOutput, & FEAM%y%WriteOutput, MD%y%WriteOutput, Orca%y%WriteOutput, IceF%y%WriteOutput, IceD%y, BD%y, ErrStat, ErrMsg ) ENDIF @@ -5184,7 +8134,7 @@ SUBROUTINE WriteOutputToFile(n_t_global, t_global, p_FAST, y_FAST, ED, BD, AD14, ! Write visualization data (and also note that we're ignoring any errors that occur doing so) IF ( p_FAST%WrVTK == VTK_Animate ) THEN IF ( MOD( n_t_global, p_FAST%n_VTKTime ) == 0 ) THEN - call WriteVTK(t_global, p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, OpFM, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) + call WriteVTK(t_global, p_FAST, y_FAST, MeshMapData, ED, SED, BD, AD, IfW, ExtInfw, SeaSt, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) END IF END IF @@ -5192,7 +8142,7 @@ SUBROUTINE WriteOutputToFile(n_t_global, t_global, p_FAST, y_FAST, ED, BD, AD14, END SUBROUTINE WriteOutputToFile !---------------------------------------------------------------------------------------------------------------------------------- !> This routine writes the module output to the primary output file(s). -SUBROUTINE WrOutputLine( t, p_FAST, y_FAST, IfWOutput, OpFMOutput, EDOutput, y_AD, SrvDOutput, HDOutput, SDOutput, ExtPtfmOutput,& +SUBROUTINE WrOutputLine( t, p_FAST, y_FAST, IfWOutput, ExtInfwOutput, EDOutput, SEDOutput, y_AD, ADskOutput, SrvDOutput, SeaStOutput, HDOutput, SDOutput, ExtPtfmOutput,& MAPOutput, FEAMOutput, MDOutput, OrcaOutput, IceFOutput, y_IceD, y_BD, ErrStat, ErrMsg) IMPLICIT NONE @@ -5204,10 +8154,13 @@ SUBROUTINE WrOutputLine( t, p_FAST, y_FAST, IfWOutput, OpFMOutput, EDOutput, y_A REAL(ReKi), ALLOCATABLE, INTENT(IN) :: IfWOutput (:) !< InflowWind WriteOutput values - REAL(ReKi), ALLOCATABLE, INTENT(IN) :: OpFMOutput (:) !< OpenFOAM WriteOutput values + REAL(ReKi), ALLOCATABLE, INTENT(IN) :: ExtInfwOutput (:) !< ExternalInflow WriteOutput values REAL(ReKi), ALLOCATABLE, INTENT(IN) :: EDOutput (:) !< ElastoDyn WriteOutput values + REAL(ReKi), ALLOCATABLE, INTENT(IN) :: SEDOutput (:) !< Simplified-ElastoDyn WriteOutput values TYPE(AD_OutputType), INTENT(IN) :: y_AD !< AeroDyn outputs (WriteOutput values are subset of allocated Rotors) + REAL(ReKi), ALLOCATABLE, INTENT(IN) :: ADskOutput (:) !< AeroDisk WriteOutput values REAL(ReKi), ALLOCATABLE, INTENT(IN) :: SrvDOutput (:) !< ServoDyn WriteOutput values + REAL(ReKi), ALLOCATABLE, INTENT(IN) :: SeaStOutput (:) !< SeaState WriteOutput values REAL(ReKi), ALLOCATABLE, INTENT(IN) :: HDOutput (:) !< HydroDyn WriteOutput values REAL(ReKi), ALLOCATABLE, INTENT(IN) :: SDOutput (:) !< SubDyn WriteOutput values REAL(ReKi), ALLOCATABLE, INTENT(IN) :: ExtPtfmOutput (:) !< ExtPtfm_MCKF WriteOutput values @@ -5231,9 +8184,9 @@ SUBROUTINE WrOutputLine( t, p_FAST, y_FAST, IfWOutput, OpFMOutput, EDOutput, y_A ErrStat = ErrID_None ErrMsg = '' - - CALL FillOutputAry(p_FAST, y_FAST, IfWOutput, OpFMOutput, EDOutput, y_AD, SrvDOutput, HDOutput, SDOutput, ExtPtfmOutput, & - MAPOutput, FEAMOutput, MDOutput, OrcaOutput, IceFOutput, y_IceD, y_BD, OutputAry) + + CALL FillOutputAry(p_FAST, y_FAST, IfWOutput, ExtInfwOutput, EDOutput, SEDOutput, y_AD, ADskOutput, SrvDOutput, SeaStOutput, HDOutput, SDOutput, ExtPtfmOutput, & + MAPOutput, FEAMOutput, MDOutput, OrcaOutput, IceFOutput, y_IceD, y_BD, OutputAry) IF (p_FAST%WrTxtOutFile) THEN @@ -5291,9 +8244,9 @@ SUBROUTINE FillOutputAry_T(Turbine, Outputs) REAL(ReKi), INTENT( OUT) :: Outputs(:) !< single array of output - CALL FillOutputAry(Turbine%p_FAST, Turbine%y_FAST, Turbine%IfW%y%WriteOutput, Turbine%OpFM%y%WriteOutput, & - Turbine%ED%y%WriteOutput, Turbine%AD%y, Turbine%SrvD%y%WriteOutput, & - Turbine%HD%y%WriteOutput, Turbine%SD%y%WriteOutput, Turbine%ExtPtfm%y%WriteOutput, Turbine%MAP%y%WriteOutput, & + CALL FillOutputAry(Turbine%p_FAST, Turbine%y_FAST, Turbine%IfW%y%WriteOutput, Turbine%ExtInfw%y%WriteOutput, & + Turbine%ED%y%WriteOutput, Turbine%SED%y%WriteOutput, Turbine%AD%y, Turbine%ADsk%y%WriteOutput, Turbine%SrvD%y%WriteOutput, & + Turbine%SeaSt%y%WriteOutput, Turbine%HD%y%WriteOutput, Turbine%SD%y%WriteOutput, Turbine%ExtPtfm%y%WriteOutput, Turbine%MAP%y%WriteOutput, & Turbine%FEAM%y%WriteOutput, Turbine%MD%y%WriteOutput, Turbine%Orca%y%WriteOutput, & Turbine%IceF%y%WriteOutput, Turbine%IceD%y, Turbine%BD%y, Outputs) @@ -5301,17 +8254,20 @@ END SUBROUTINE FillOutputAry_T !---------------------------------------------------------------------------------------------------------------------------------- !> This routine concatenates all of the WriteOutput values from the module Output into one array to be written to the FAST !! output file. -SUBROUTINE FillOutputAry(p_FAST, y_FAST, IfWOutput, OpFMOutput, EDOutput, y_AD, SrvDOutput, HDOutput, SDOutput, ExtPtfmOutput, & +SUBROUTINE FillOutputAry(p_FAST, y_FAST, IfWOutput, ExtInfwOutput, EDOutput, SEDOutput, y_AD, ADskOutput, SrvDOutput, SeaStOutput, HDOutput, SDOutput, ExtPtfmOutput, & MAPOutput, FEAMOutput, MDOutput, OrcaOutput, IceFOutput, y_IceD, y_BD, OutputAry) TYPE(FAST_ParameterType), INTENT(IN) :: p_FAST !< Glue-code simulation parameters TYPE(FAST_OutputFileType),INTENT(IN) :: y_FAST !< Glue-code simulation outputs REAL(ReKi), ALLOCATABLE, INTENT(IN) :: IfWOutput (:) !< InflowWind WriteOutput values - REAL(ReKi), ALLOCATABLE, INTENT(IN) :: OpFMOutput (:) !< OpenFOAM WriteOutput values + REAL(ReKi), ALLOCATABLE, INTENT(IN) :: ExtInfwOutput (:) !< ExternalInflow WriteOutput values REAL(ReKi), ALLOCATABLE, INTENT(IN) :: EDOutput (:) !< ElastoDyn WriteOutput values + REAL(ReKi), ALLOCATABLE, INTENT(IN) :: SEDOutput (:) !< Simplified-ElastoDyn WriteOutput values TYPE(AD_OutputType), INTENT(IN) :: y_AD !< AeroDyn outputs (WriteOutput values are subset of allocated Rotors) + REAL(ReKi), ALLOCATABLE, INTENT(IN) :: ADskOutput (:) !< AeroDisk WriteOutput values REAL(ReKi), ALLOCATABLE, INTENT(IN) :: SrvDOutput (:) !< ServoDyn WriteOutput values + REAL(ReKi), ALLOCATABLE, INTENT(IN) :: SeaStOutput (:) !< SeaState WriteOutput values REAL(ReKi), ALLOCATABLE, INTENT(IN) :: HDOutput (:) !< HydroDyn WriteOutput values REAL(ReKi), ALLOCATABLE, INTENT(IN) :: SDOutput (:) !< SubDyn WriteOutput values REAL(ReKi), ALLOCATABLE, INTENT(IN) :: ExtPtfmOutput (:) !< ExtPtfm_MCKF WriteOutput values @@ -5334,7 +8290,7 @@ SUBROUTINE FillOutputAry(p_FAST, y_FAST, IfWOutput, OpFMOutput, EDOutput, y_AD, indxLast = 0 indxNext = 1 - + IF (y_FAST%numOuts(Module_Glue) > 1) THEN ! if we output more than just the time channel.... indxLast = indxNext + SIZE(y_FAST%DriverWriteOutput) - 1 OutputAry(indxNext:indxLast) = y_FAST%DriverWriteOutput @@ -5345,9 +8301,9 @@ SUBROUTINE FillOutputAry(p_FAST, y_FAST, IfWOutput, OpFMOutput, EDOutput, y_AD, indxLast = indxNext + SIZE(IfWOutput) - 1 OutputAry(indxNext:indxLast) = IfWOutput indxNext = IndxLast + 1 - ELSEIF ( y_FAST%numOuts(Module_OpFM) > 0 ) THEN - indxLast = indxNext + SIZE(OpFMOutput) - 1 - OutputAry(indxNext:indxLast) = OpFMOutput + ELSEIF ( y_FAST%numOuts(Module_ExtInfw) > 0 ) THEN + indxLast = indxNext + SIZE(ExtInfwOutput) - 1 + OutputAry(indxNext:indxLast) = ExtInfwOutput indxNext = IndxLast + 1 END IF @@ -5357,6 +8313,12 @@ SUBROUTINE FillOutputAry(p_FAST, y_FAST, IfWOutput, OpFMOutput, EDOutput, y_AD, indxNext = IndxLast + 1 END IF + IF ( y_FAST%numOuts(Module_SED) > 0 ) THEN + indxLast = indxNext + SIZE(SEDOutput) - 1 + OutputAry(indxNext:indxLast) = SEDOutput + indxNext = IndxLast + 1 + END IF + IF ( y_FAST%numOuts(Module_BD) > 0 ) THEN do i=1,SIZE(y_BD) indxLast = indxNext + SIZE(y_BD(i)%WriteOutput) - 1 @@ -5372,15 +8334,27 @@ SUBROUTINE FillOutputAry(p_FAST, y_FAST, IfWOutput, OpFMOutput, EDOutput, y_AD, OutputAry(indxNext:indxLast) = y_AD%Rotors(i)%WriteOutput indxNext = IndxLast + 1 endif - end do - END IF - + end do + END IF + + IF ( y_FAST%numOuts(Module_ADsk) > 0 ) THEN + indxLast = indxNext + SIZE(ADskOutput) - 1 + OutputAry(indxNext:indxLast) = ADskOutput + indxNext = IndxLast + 1 + END IF + IF ( y_FAST%numOuts(Module_SrvD) > 0 ) THEN indxLast = indxNext + SIZE(SrvDOutput) - 1 OutputAry(indxNext:indxLast) = SrvDOutput indxNext = IndxLast + 1 END IF + IF ( y_FAST%numOuts(Module_SeaSt) > 0 ) THEN + indxLast = indxNext + SIZE(SeaStOutput) - 1 + OutputAry(indxNext:indxLast) = SeaStOutput + indxNext = IndxLast + 1 + END IF + IF ( y_FAST%numOuts(Module_HD) > 0 ) THEN indxLast = indxNext + SIZE(HDOutput) - 1 OutputAry(indxNext:indxLast) = HDOutput @@ -5429,18 +8403,20 @@ SUBROUTINE FillOutputAry(p_FAST, y_FAST, IfWOutput, OpFMOutput, EDOutput, y_AD, END SUBROUTINE FillOutputAry !---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE WriteVTK(t_global, p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, OpFM, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) +SUBROUTINE WriteVTK(t_global, p_FAST, y_FAST, MeshMapData, ED, SED, BD, AD, IfW, ExtInfw, SeaSt, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) REAL(DbKi), INTENT(IN ) :: t_global !< Current global time TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Output variables for the glue code (only because we're updating VTK_LastWaveIndx) TYPE(FAST_ModuleMapType), INTENT(IN ) :: MeshMapData !< Data for mapping between modules TYPE(ElastoDyn_Data), INTENT(IN ) :: ED !< ElastoDyn data + TYPE(SED_Data), INTENT(IN ) :: SED !< Simplified-ElastoDyn data TYPE(BeamDyn_Data), INTENT(IN ) :: BD !< BeamDyn data TYPE(ServoDyn_Data), INTENT(IN ) :: SrvD !< ServoDyn data TYPE(AeroDyn_Data), INTENT(IN ) :: AD !< AeroDyn data TYPE(InflowWind_Data), INTENT(IN ) :: IfW !< InflowWind data - TYPE(OpenFOAM_Data), INTENT(IN ) :: OpFM !< OpenFOAM data + TYPE(ExternalInflow_Data),INTENT(IN ) :: ExtInfw !< ExternalInflow data + TYPE(SeaState_Data), INTENT(IN ) :: SeaSt !< SeaState data TYPE(HydroDyn_Data), INTENT(IN ) :: HD !< HydroDyn data TYPE(SubDyn_Data), INTENT(IN ) :: SD !< SubDyn data TYPE(ExtPtfm_Data), INTENT(IN ) :: ExtPtfm !< ExtPtfm_MCKF data @@ -5458,14 +8434,16 @@ SUBROUTINE WriteVTK(t_global, p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, OpFM IF ( p_FAST%VTK_Type == VTK_Surf ) THEN - CALL WrVTK_Surfaces(t_global, p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, OpFM, HD, SD, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) + CALL WrVTK_Surfaces(t_global, p_FAST, y_FAST, MeshMapData, ED, SED, BD, AD, IfW, ExtInfw, SeaSt, HD, SD, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) ELSE IF ( p_FAST%VTK_Type == VTK_Basic ) THEN - CALL WrVTK_BasicMeshes(p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, OpFM, HD, SD, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) + CALL WrVTK_BasicMeshes(p_FAST, y_FAST, MeshMapData, ED, SED, BD, AD, IfW, ExtInfw, HD, SD, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) ELSE IF ( p_FAST%VTK_Type == VTK_All ) THEN - CALL WrVTK_AllMeshes(p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, OpFM, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) + CALL WrVTK_AllMeshes(p_FAST, y_FAST, MeshMapData, ED, SED, BD, AD, IfW, ExtInfw, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) ELSE IF (p_FAST%VTK_Type==VTK_Old) THEN + if (p_FAST%CompElast /= Module_SED) then !FIXME: SED is not included in these routines!!!! CALL WriteInputMeshesToFile( ED%Input(1), AD%Input(1), SD%Input(1), HD%Input(1), MAPp%Input(1), BD%Input(1,:), TRIM(p_FAST%OutFileRoot)//'.InputMeshes.bin', ErrStat2, ErrMsg2) CALL WriteMotionMeshesToFile(t_global, ED%y, SD%Input(1), SD%y, HD%Input(1), MAPp%Input(1), BD%y, BD%Input(1,:), y_FAST%UnGra, ErrStat2, ErrMsg2, TRIM(p_FAST%OutFileRoot)//'.gra') + endif !unOut = -1 !CALL MeshWrBin ( unOut, AD%y%BladeLoad(2), ErrStat2, ErrMsg2, 'AD_2_ED_loads.bin'); IF (ErrStat2 /= ErrID_None) CALL WrScr(TRIM(ErrMsg2)) !CALL MeshWrBin ( unOut, ED%Input(1)%BladePtLoads(2),ErrStat2, ErrMsg2, 'AD_2_ED_loads.bin'); IF (ErrStat2 /= ErrID_None) CALL WrScr(TRIM(ErrMsg2)) @@ -5478,7 +8456,7 @@ SUBROUTINE WriteVTK(t_global, p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, OpFM END SUBROUTINE WriteVTK !---------------------------------------------------------------------------------------------------------------------------------- !> This routine writes all the committed meshes to VTK-formatted files. It doesn't bother with returning an error code. -SUBROUTINE WrVTK_AllMeshes(p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, OpFM, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) +SUBROUTINE WrVTK_AllMeshes(p_FAST, y_FAST, MeshMapData, ED, SED, BD, AD, IfW, ExtInfw, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) use FVW_IO, only: WrVTK_FVW TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code @@ -5486,11 +8464,12 @@ SUBROUTINE WrVTK_AllMeshes(p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, OpFM, H TYPE(FAST_ModuleMapType), INTENT(IN ) :: MeshMapData !< Data for mapping between modules TYPE(ElastoDyn_Data), INTENT(IN ) :: ED !< ElastoDyn data + TYPE(SED_Data), INTENT(IN ) :: SED !< Simplified-ElastoDyn data TYPE(BeamDyn_Data), INTENT(IN ) :: BD !< BeamDyn data TYPE(ServoDyn_Data), INTENT(IN ) :: SrvD !< ServoDyn data TYPE(AeroDyn_Data), INTENT(IN ) :: AD !< AeroDyn data TYPE(InflowWind_Data), INTENT(IN ) :: IfW !< InflowWind data - TYPE(OpenFOAM_Data), INTENT(IN ) :: OpFM !< OpenFOAM data + TYPE(ExternalInflow_Data),INTENT(IN ) :: ExtInfw !< ExternalInflow data TYPE(HydroDyn_Data), INTENT(IN ) :: HD !< HydroDyn data TYPE(SubDyn_Data), INTENT(IN ) :: SD !< SubDyn data TYPE(ExtPtfm_Data), INTENT(IN ) :: ExtPtfm !< ExtPtfm data @@ -5515,6 +8494,8 @@ SUBROUTINE WrVTK_AllMeshes(p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, OpFM, H NumBl = 0 if (allocated(ED%y%BladeRootMotion)) then NumBl = SIZE(ED%y%BladeRootMotion) + elseif (allocated(SED%y%BladeRootMotion)) then + NumBl = SIZE(SED%y%BladeRootMotion) end if @@ -5586,7 +8567,16 @@ SUBROUTINE WrVTK_AllMeshes(p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, OpFM, H call MeshWrVTK(p_FAST%TurbinePos, ED%y%BladeLn2Mesh(K), trim(p_FAST%VTK_OutFileRoot)//'.ED_BladeLn2Mesh_motion'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) call MeshWrVTK(p_FAST%TurbinePos, ED%Input(1)%BladePtLoads(K), trim(p_FAST%VTK_OutFileRoot)//'.ED_BladePtLoads'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, ED%y%BladeLn2Mesh(K) ) END DO - END IF + ELSE if (p_FAST%CompElast == Module_SED .and. allocated(SED%Input)) then + ! Simplified-ElastoDyn + call MeshWrVTK(p_FAST%TurbinePos, SED%y%PlatformPtMesh, trim(p_FAST%VTK_OutFileRoot)//'.SED_PlatformPtMesh', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth) + call MeshWrVTK(p_FAST%TurbinePos, SED%y%TowerLn2Mesh, trim(p_FAST%VTK_OutFileRoot)//'.SED_TowerLn2Mesh', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth) + call MeshWrVTK(p_FAST%TurbinePos, SED%y%NacelleMotion, trim(p_FAST%VTK_OutFileRoot)//'.SED_NacelleMotion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth) + call MeshWrVTK(p_FAST%TurbinePos, SED%y%HubPtMotion, trim(p_FAST%VTK_OutFileRoot)//'.SED_HubPtMotion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth) + do k=1,NumBl + call MeshWrVTK(p_FAST%TurbinePos, SED%y%BladeRootMotion(k), trim(p_FAST%VTK_OutFileRoot)//'.SED_BladeRootMotion'//trim(Num2LStr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth) + enddo + END IF ! ServoDyn if (allocated(SrvD%Input)) then @@ -5619,28 +8609,31 @@ SUBROUTINE WrVTK_AllMeshes(p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, OpFM, H enddo ENDIF end if - - -! AeroDyn - IF ( p_FAST%CompAero == Module_AD .and. allocated(AD%Input)) THEN + + +! AeroDyn + IF ( p_FAST%CompAero == Module_AD .and. allocated(AD%Input)) THEN if (allocated(AD%Input(1)%rotors) .and. allocated(AD%y%rotors) ) then if (allocated(AD%Input(1)%rotors(1)%BladeRootMotion)) then - - DO K=1,NumBl + + DO K=1,NumBl call MeshWrVTK(p_FAST%TurbinePos, AD%Input(1)%rotors(1)%BladeRootMotion(K), trim(p_FAST%VTK_OutFileRoot)//'.AD_BladeRootMotion'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) - !call MeshWrVTK(p_FAST%TurbinePos, AD%Input(1)%BladeMotion(K), trim(p_FAST%VTK_OutFileRoot)//'.AD_BladeMotion'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) + !call MeshWrVTK(p_FAST%TurbinePos, AD%Input(1)%rotors(1)%BladeMotion(K), trim(p_FAST%VTK_OutFileRoot)//'.AD_BladeMotion'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) END DO call MeshWrVTK(p_FAST%TurbinePos, AD%Input(1)%rotors(1)%HubMotion, trim(p_FAST%VTK_OutFileRoot)//'.AD_HubMotion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) - !call MeshWrVTK(p_FAST%TurbinePos, AD%Input(1)%TowerMotion, trim(p_FAST%VTK_OutFileRoot)//'.AD_TowerMotion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) - - DO K=1,NumBl - call MeshWrVTK(p_FAST%TurbinePos, AD%y%rotors(1)%BladeLoad(K), trim(p_FAST%VTK_OutFileRoot)//'.AD_Blade'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, AD%Input(1)%rotors(1)%BladeMotion(k) ) - END DO + !call MeshWrVTK(p_FAST%TurbinePos, AD%Input(1)%rotors(1)%TowerMotion, trim(p_FAST%VTK_OutFileRoot)//'.AD_TowerMotion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) + + IF (allocated(AD%y%rotors(1)%BladeLoad)) then + DO K=1,NumBl + call MeshWrVTK(p_FAST%TurbinePos, AD%y%rotors(1)%BladeLoad(K), trim(p_FAST%VTK_OutFileRoot)//'.AD_Blade'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, AD%Input(1)%rotors(1)%BladeMotion(k) ) + END DO + END IF call MeshWrVTK(p_FAST%TurbinePos, AD%y%rotors(1)%TowerLoad, trim(p_FAST%VTK_OutFileRoot)//'.AD_Tower', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, AD%Input(1)%rotors(1)%TowerMotion ) - + end if end if + call MeshWrVTK(p_FAST%TurbinePos, AD%y%rotors(1)%TowerLoad, trim(p_FAST%VTK_OutFileRoot)//'.AD_Tower', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, AD%Input(1)%rotors(1)%TowerMotion ) ! FVW submodule of AD15 if (allocated(AD%m%FVW_u)) then @@ -5654,9 +8647,12 @@ SUBROUTINE WrVTK_AllMeshes(p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, OpFM, H end if end if END IF + +! AeroDisk +!FIXME: add visualization for AeroDisk -! HydroDyn - IF ( p_FAST%CompHydro == Module_HD .and. allocated(HD%Input)) THEN +! HydroDyn + IF ( p_FAST%CompHydro == Module_HD .and. allocated(HD%Input)) THEN call MeshWrVTK(p_FAST%TurbinePos, HD%Input(1)%PRPMesh, trim(p_FAST%VTK_OutFileRoot)//'.HD_PRP', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) call MeshWrVTK(p_FAST%TurbinePos, HD%y%WamitMesh, trim(p_FAST%VTK_OutFileRoot)//'.HD_WAMIT', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, HD%Input(1)%WAMITMesh ) call MeshWrVTK(p_FAST%TurbinePos, HD%y%Morison%Mesh, trim(p_FAST%VTK_OutFileRoot)//'.HD_MorisonPt', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, HD%Input(1)%Morison%Mesh ) @@ -5745,18 +8741,19 @@ END SUBROUTINE WrVTK_AllMeshes !---------------------------------------------------------------------------------------------------------------------------------- !> This routine writes a minimal subset of meshes (enough to visualize the turbine) to VTK-formatted files. It doesn't bother with !! returning an error code. -SUBROUTINE WrVTK_BasicMeshes(p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, OpFM, HD, SD, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) +SUBROUTINE WrVTK_BasicMeshes(p_FAST, y_FAST, MeshMapData, ED, SED, BD, AD, IfW, ExtInfw, HD, SD, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code TYPE(FAST_OutputFileType),INTENT(IN ) :: y_FAST !< Output variables for the glue code TYPE(FAST_ModuleMapType), INTENT(IN ) :: MeshMapData !< Data for mapping between modules TYPE(ElastoDyn_Data), INTENT(IN ) :: ED !< ElastoDyn data + TYPE(SED_Data), INTENT(IN ) :: SED !< Simplified-ElastoDyn data TYPE(BeamDyn_Data), INTENT(IN ) :: BD !< BeamDyn data TYPE(ServoDyn_Data), INTENT(IN ) :: SrvD !< ServoDyn data TYPE(AeroDyn_Data), INTENT(IN ) :: AD !< AeroDyn data TYPE(InflowWind_Data), INTENT(IN ) :: IfW !< InflowWind data - TYPE(OpenFOAM_Data), INTENT(IN ) :: OpFM !< OpenFOAM data + TYPE(ExternalInflow_Data),INTENT(IN ) :: ExtInfw !< ExternalInflow data TYPE(HydroDyn_Data), INTENT(IN ) :: HD !< HydroDyn data TYPE(SubDyn_Data), INTENT(IN ) :: SD !< SubDyn data TYPE(MAP_Data), INTENT(IN ) :: MAPp !< MAP data @@ -5775,13 +8772,15 @@ SUBROUTINE WrVTK_BasicMeshes(p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, OpFM, NumBl = 0 if (allocated(ED%y%BladeRootMotion)) then NumBl = SIZE(ED%y%BladeRootMotion) + elseif (allocated(SED%y%BladeRootMotion)) then + NumBl = SIZE(SED%y%BladeRootMotion) end if ! Blades IF ( p_FAST%CompAero == Module_AD .and. ALLOCATED(AD%Input) ) THEN ! These meshes may have airfoil data associated with nodes... if (allocated(AD%Input(1)%rotors) .and. allocated(AD%y%rotors)) then - DO K=1,NumBl + DO K=1,NumBl call MeshWrVTK(p_FAST%TurbinePos, AD%Input(1)%rotors(1)%BladeMotion(K), trim(p_FAST%VTK_OutFileRoot)//'.AD_Blade'//trim(num2lstr(k)), & y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, Sib=AD%y%rotors(1)%BladeLoad(K) ) END DO @@ -5798,21 +8797,35 @@ SUBROUTINE WrVTK_BasicMeshes(p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, OpFM, END DO END IF - if (allocated(ED%Input)) then - ! Nacelle - call MeshWrVTK(p_FAST%TurbinePos, ED%y%NacelleMotion, trim(p_FAST%VTK_OutFileRoot)//'.ED_Nacelle', y_FAST%VTK_count, & - p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, Sib=ED%Input(1)%NacelleLoads ) - ! TailFin - call MeshWrVTK(p_FAST%TurbinePos, ED%y%TFinCMMotion, trim(p_FAST%VTK_OutFileRoot)//'.ED_TailFin', y_FAST%VTK_count, & - p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, Sib=ED%Input(1)%TFinCMLoads ) - ! Hub - call MeshWrVTK(p_FAST%TurbinePos, ED%y%HubPtMotion, trim(p_FAST%VTK_OutFileRoot)//'.ED_Hub', y_FAST%VTK_count, & - p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, Sib=ED%Input(1)%HubPtLoad ) - ! Tower motions - call MeshWrVTK(p_FAST%TurbinePos, ED%y%TowerLn2Mesh, trim(p_FAST%VTK_OutFileRoot)//'.ED_TowerLn2Mesh_motion', & - y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) - end if - +! Nacelle + if (p_FAST%CompElast == Module_SED) then + if (allocated(SED%Input)) then + ! Nacelle + call MeshWrVTK(p_FAST%TurbinePos, SED%y%NacelleMotion, trim(p_FAST%VTK_OutFileRoot)//'.SED_NacelleMotion', y_FAST%VTK_count, & + p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth) + ! Hub + call MeshWrVTK(p_FAST%TurbinePos, SED%y%HubPtMotion, trim(p_FAST%VTK_OutFileRoot)//'.SED_HubPtMotion', y_FAST%VTK_count, & + p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth) + ! Tower motions + call MeshWrVTK(p_FAST%TurbinePos, SED%y%TowerLn2Mesh, trim(p_FAST%VTK_OutFileRoot)//'.SED_TowerLn2Mesh', y_FAST%VTK_count, & + p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth) + end if + else + if (allocated(ED%Input)) then + ! Nacelle + call MeshWrVTK(p_FAST%TurbinePos, ED%y%NacelleMotion, trim(p_FAST%VTK_OutFileRoot)//'.ED_Nacelle', y_FAST%VTK_count, & + p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, Sib=ED%Input(1)%NacelleLoads ) + ! TailFin + call MeshWrVTK(p_FAST%TurbinePos, ED%y%TFinCMMotion, trim(p_FAST%VTK_OutFileRoot)//'.ED_TailFin', y_FAST%VTK_count, & + p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, Sib=ED%Input(1)%TFinCMLoads ) + ! Hub + call MeshWrVTK(p_FAST%TurbinePos, ED%y%HubPtMotion, trim(p_FAST%VTK_OutFileRoot)//'.ED_Hub', y_FAST%VTK_count, & + p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, Sib=ED%Input(1)%HubPtLoad ) + ! Tower motions + call MeshWrVTK(p_FAST%TurbinePos, ED%y%TowerLn2Mesh, trim(p_FAST%VTK_OutFileRoot)//'.ED_TowerLn2Mesh_motion', & + y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) + end if + endif ! Substructure @@ -5824,7 +8837,7 @@ SUBROUTINE WrVTK_BasicMeshes(p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, OpFM, ! END IF IF ( p_FAST%CompHydro == Module_HD .and. ALLOCATED(HD%Input)) THEN - call MeshWrVTK(p_FAST%TurbinePos, HD%Input(1)%WAMITMesh, trim(p_FAST%VTK_OutFileRoot)//'.HD_WAMIT', y_FAST%VTK_count, & + call MeshWrVTK(p_FAST%TurbinePos, HD%Input(1)%WAMITMesh, trim(p_FAST%VTK_OutFileRoot)//'.HD_WAMIT', y_FAST%VTK_count, & p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, HD%y%WAMITMesh ) call MeshWrVTK(p_FAST%TurbinePos, HD%Input(1)%Morison%Mesh, trim(p_FAST%VTK_OutFileRoot)//'.HD_MorisonPt', y_FAST%VTK_count, & p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, HD%y%Morison%Mesh ) @@ -5864,7 +8877,7 @@ END SUBROUTINE WrVTK_BasicMeshes !---------------------------------------------------------------------------------------------------------------------------------- !> This routine writes a minimal subset of meshes with surfaces to VTK-formatted files. It doesn't bother with !! returning an error code. -SUBROUTINE WrVTK_Surfaces(t_global, p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, OpFM, HD, SD, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) +SUBROUTINE WrVTK_Surfaces(t_global, p_FAST, y_FAST, MeshMapData, ED, SED, BD, AD, IfW, ExtInfw, SeaSt, HD, SD, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) use FVW_IO, only: WrVTK_FVW REAL(DbKi), INTENT(IN ) :: t_global !< Current global time @@ -5873,11 +8886,13 @@ SUBROUTINE WrVTK_Surfaces(t_global, p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW TYPE(FAST_ModuleMapType), INTENT(IN ) :: MeshMapData !< Data for mapping between modules TYPE(ElastoDyn_Data), INTENT(IN ) :: ED !< ElastoDyn data + TYPE(SED_Data), INTENT(IN ) :: SED !< Simplified-ElastoDyn data TYPE(BeamDyn_Data), INTENT(IN ) :: BD !< BeamDyn data TYPE(ServoDyn_Data), INTENT(IN ) :: SrvD !< ServoDyn data TYPE(AeroDyn_Data), INTENT(IN ) :: AD !< AeroDyn data TYPE(InflowWind_Data), INTENT(IN ) :: IfW !< InflowWind data - TYPE(OpenFOAM_Data), INTENT(IN ) :: OpFM !< OpenFOAM data + TYPE(ExternalInflow_Data),INTENT(IN ) :: ExtInfw !< ExternalInflow data + TYPE(SeaState_Data), INTENT(IN ) :: SeaSt !< SeaState data TYPE(HydroDyn_Data), INTENT(IN ) :: HD !< HydroDyn data TYPE(SubDyn_Data), INTENT(IN ) :: SD !< SubDyn data TYPE(MAP_Data), INTENT(IN ) :: MAPp !< MAP data @@ -5889,7 +8904,7 @@ SUBROUTINE WrVTK_Surfaces(t_global, p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW logical, parameter :: OutputFields = .FALSE. ! due to confusion about what fields mean on a surface, we are going to just output the basic meshes if people ask for fields - INTEGER(IntKi) :: NumBl, k, l + INTEGER(IntKi) :: NumBl, k, L INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMSg2 CHARACTER(*), PARAMETER :: RoutineName = 'WrVTK_Surfaces' @@ -5897,12 +8912,14 @@ SUBROUTINE WrVTK_Surfaces(t_global, p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW NumBl = 0 if (allocated(ED%y%BladeRootMotion)) then NumBl = SIZE(ED%y%BladeRootMotion) + elseif (allocated(SED%y%BladeRootMotion)) then + NumBl = SIZE(SED%y%BladeRootMotion) end if ! Ground (written at initialization) ! Wave elevation - if ( allocated( p_FAST%VTK_Surface%WaveElev ) ) call WrVTK_WaveElev( t_global, p_FAST, y_FAST, HD) + if ( allocated( p_FAST%VTK_Surface%WaveElevVisGrid ) ) call WrVTK_WaveElevVisGrid( t_global, p_FAST, y_FAST, SeaSt) if (allocated(ED%Input)) then ! Nacelle @@ -5921,7 +8938,7 @@ SUBROUTINE WrVTK_Surfaces(t_global, p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW call MeshWrVTK_Ln2Surface (p_FAST%TurbinePos, ED%y%TowerLn2Mesh, trim(p_FAST%VTK_OutFileRoot)//'.TowerSurface', & y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, p_FAST%VTK_Surface%NumSectors, p_FAST%VTK_Surface%TowerRad ) end if - + ! Blades IF ( p_FAST%CompAero == Module_AD .and. allocated(AD%Input)) THEN ! These meshes may have airfoil data associated with nodes... if (allocated(AD%Input(1)%rotors) .and. allocated(AD%y%rotors)) then @@ -5941,6 +8958,7 @@ SUBROUTINE WrVTK_Surfaces(t_global, p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW call MeshWrVTK_Ln2Surface (p_FAST%TurbinePos, ED%y%BladeLn2Mesh(K), trim(p_FAST%VTK_OutFileRoot)//'.Blade'//trim(num2lstr(k))//'Surface', & y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth , verts=p_FAST%VTK_Surface%BladeShape(K)%AirfoilCoords ) END DO +! ELSE IF ( p_FAST%CompElast == Module_SED ) THEN ! No surface info from SED END IF ! Free wake @@ -5958,10 +8976,10 @@ SUBROUTINE WrVTK_Surfaces(t_global, p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW ! Substructure ! call MeshWrVTK(p_FAST%TurbinePos, ED%y%PlatformPtMesh, trim(p_FAST%VTK_OutFileRoot)//'.ED_PlatformPtMesh_motion', y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2 ) ! IF ( p_FAST%CompSub == Module_SD ) THEN -! call MeshWrVTK(p_FAST%TurbinePos, SD%Input(1)%TPMesh, trim(p_FAST%VTK_OutFileRoot)//'.SD_TPMesh_motion', y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2 ) -! call MeshWrVTK(p_FAST%TurbinePos, SD%y%y2Mesh, trim(p_FAST%VTK_OutFileRoot)//'.SD_y2Mesh_motion', y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2 ) -! call MeshWrVTK(p_FAST%TurbinePos, SD%y%y3Mesh, trim(p_FAST%VTK_OutFileRoot)//'.SD_y3Mesh_motion', y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2 ) -! END IF +! call MeshWrVTK(p_FAST%TurbinePos, SD%Input(1)%TPMesh, trim(p_FAST%VTK_OutFileRoot)//'.SD_TPMesh_motion', y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2 ) +! call MeshWrVTK(p_FAST%TurbinePos, SD%y%y2Mesh, trim(p_FAST%VTK_OutFileRoot)//'.SD_y2Mesh_motion', y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2 ) +! call MeshWrVTK(p_FAST%TurbinePos, SD%y%y3Mesh, trim(p_FAST%VTK_OutFileRoot)//'.SD_y3Mesh_motion', y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2 ) +! END IF ! HydroDyn @@ -5970,26 +8988,26 @@ SUBROUTINE WrVTK_Surfaces(t_global, p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, p_FAST%VTK_Surface%NumSectors, & p_FAST%VTK_Surface%MorisonVisRad ) END IF - - -! Mooring Lines? + + +! Mooring Lines? ! IF ( p_FAST%CompMooring == Module_MAP ) THEN ! call MeshWrVTK(p_FAST%TurbinePos, MAPp%Input(1)%PtFairDisplacement, trim(p_FAST%VTK_OutFileRoot)//'.MAP_PtFair_motion', y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2 ) if ( p_FAST%CompMooring == Module_MD ) THEN - !call MeshWrVTK(p_FAST%TurbinePos, MD%Input(1)%CoupledKinematics, trim(p_FAST%VTK_OutFileRoot)//'.MD_PtFair_motion', y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2 ) + !call MeshWrVTK(p_FAST%TurbinePos, MD%Input(1)%CoupledKinematics, trim(p_FAST%VTK_OutFileRoot)//'.MD_PtFair_motion', y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2 ) if (allocated(MD%y%VisLinesMesh)) then - do l=1,size(MD%y%VisLinesMesh) - if (MD%y%VisLinesMesh(l)%Committed) then ! No orientation data, so surface representation not possible - call MeshWrVTK(p_FAST%TurbinePos, MD%y%VisLinesMesh(l), trim(p_FAST%VTK_OutFileRoot)//'.MD_Line'//trim(Num2LStr(l)), y_FAST%VTK_count, p_FAST%VTK_fields, & + do L=1,size(MD%y%VisLinesMesh) + if (MD%y%VisLinesMesh(L)%Committed) then ! No orientation data, so surface representation not possible + call MeshWrVTK(p_FAST%TurbinePos, MD%y%VisLinesMesh(L), trim(p_FAST%VTK_OutFileRoot)//'.MD_Line'//trim(Num2LStr(L)), y_FAST%VTK_count, p_FAST%VTK_fields, & ErrSTat2, ErrMsg2, p_FAST%VTK_tWidth ) endif enddo endif if (allocated(MD%y%VisRodsMesh)) then - do l=1,size(MD%y%VisRodsMesh) - if (MD%y%VisRodsMesh(l)%Committed) then ! No orientation data, so surface representation not possible - call MeshWrVTK_Ln2Surface(p_FAST%TurbinePos, MD%y%VisRodsMesh(l), trim(p_FAST%VTK_OutFileRoot)//'.MD_Rod'//trim(Num2LStr(l))//'Surface', y_FAST%VTK_count, p_FAST%VTK_fields, & - ErrSTat2, ErrMsg2, p_FAST%VTK_tWidth, NumSegments=p_FAST%VTK_Surface%NumSectors, Radius=MD%p%VisRodsDiam(l)%Diam ) + do L=1,size(MD%y%VisRodsMesh) + if (MD%y%VisRodsMesh(L)%Committed) then ! No orientation data, so surface representation not possible + call MeshWrVTK_Ln2Surface(p_FAST%TurbinePos, MD%y%VisRodsMesh(L), trim(p_FAST%VTK_OutFileRoot)//'.MD_Rod'//trim(Num2LStr(L))//'Surface', y_FAST%VTK_count, p_FAST%VTK_fields, & + ErrSTat2, ErrMsg2, p_FAST%VTK_tWidth, NumSegments=p_FAST%VTK_Surface%NumSectors, Radius=MD%p%VisRodsDiam(L)%Diam ) endif enddo endif @@ -6000,20 +9018,20 @@ SUBROUTINE WrVTK_Surfaces(t_global, p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW if (p_FAST%VTK_fields) then - call WrVTK_BasicMeshes(p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, OpFM, HD, SD, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) + call WrVTK_BasicMeshes(p_FAST, y_FAST, MeshMapData, ED, SED, BD, AD, IfW, ExtInfw, HD, SD, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) end if END SUBROUTINE WrVTK_Surfaces !---------------------------------------------------------------------------------------------------------------------------------- !> This subroutine writes the wave elevation data for a given time step -SUBROUTINE WrVTK_WaveElev(t_global, p_FAST, y_FAST, HD) +SUBROUTINE WrVTK_WaveElevVisGrid(t_global, p_FAST, y_FAST, SeaSt) REAL(DbKi), INTENT(IN ) :: t_global !< Current global time TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Output variables for the glue code - TYPE(HydroDyn_Data), INTENT(IN ) :: HD !< HydroDyn data + TYPE(SeaState_Data), INTENT(IN ) :: SeaSt !< SeaState data ! local variables INTEGER(IntKi) :: Un ! fortran unit number @@ -6026,10 +9044,10 @@ SUBROUTINE WrVTK_WaveElev(t_global, p_FAST, y_FAST, HD) CHARACTER(1024) :: Tstr INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*),PARAMETER :: RoutineName = 'WrVTK_WaveElev' + CHARACTER(*),PARAMETER :: RoutineName = 'WrVTK_WaveElevVisGrid' - NumberOfPoints = size(p_FAST%VTK_surface%WaveElevXY,2) + NumberOfPoints = p_FAST%VTK_surface%NWaveElevPts(1) * p_FAST%VTK_surface%NWaveElevPts(2) ! I'm going to make triangles for now. we should probably just make this a structured file at some point NumberOfPolys = ( p_FAST%VTK_surface%NWaveElevPts(1) - 1 ) * & ( p_FAST%VTK_surface%NWaveElevPts(2) - 1 ) * 2 @@ -6047,49 +9065,47 @@ SUBROUTINE WrVTK_WaveElev(t_global, p_FAST, y_FAST, HD) if (ErrStat2 >= AbortErrLev) return ! points (nodes, augmented with NumSegments): - WRITE(Un,'(A)') ' ' - WRITE(Un,'(A)') ' ' + WRITE(Un,'(A)') ' ' + WRITE(Un,'(A)') ' ' - ! I'm not going to interpolate in time; I'm just going to get the index of the closest wave time value - t = REAL(t_global,SiKi) - call GetWaveElevIndx( t, HD%p%WaveTime, y_FAST%VTK_LastWaveIndx ) + ! I'm not going to interpolate in time; I'm just going to get the index of the closest wave time value + t = REAL(t_global,SiKi) + call GetWaveElevIndx( t, SeaSt%p%WaveField%WaveTime, y_FAST%VTK_LastWaveIndx ) - n = 1 - do ix=1,p_FAST%VTK_surface%NWaveElevPts(1) - do iy=1,p_FAST%VTK_surface%NWaveElevPts(2) - WRITE(Un,VTK_AryFmt) p_FAST%VTK_surface%WaveElevXY(:,n), p_FAST%VTK_surface%WaveElev(y_FAST%VTK_LastWaveIndx,n) - n = n+1 - end do + do ix=1,p_FAST%VTK_surface%NWaveElevPts(1) + do iy=1,p_FAST%VTK_surface%NWaveElevPts(2) + WRITE(Un,VTK_AryFmt) p_FAST%VTK_surface%WaveElevVisX(ix), p_FAST%VTK_surface%WaveElevVisY(iy), p_FAST%VTK_surface%WaveElevVisGrid(y_FAST%VTK_LastWaveIndx,ix,iy) end do + end do - WRITE(Un,'(A)') ' ' - WRITE(Un,'(A)') ' ' + WRITE(Un,'(A)') ' ' + WRITE(Un,'(A)') ' ' - WRITE(Un,'(A)') ' ' - WRITE(Un,'(A)') ' ' + WRITE(Un,'(A)') ' ' + WRITE(Un,'(A)') ' ' - do ix=1,p_FAST%VTK_surface%NWaveElevPts(1)-1 - do iy=1,p_FAST%VTK_surface%NWaveElevPts(2)-1 - n = p_FAST%VTK_surface%NWaveElevPts(1)*(ix-1)+iy - 1 ! points start at 0 + do ix=1,p_FAST%VTK_surface%NWaveElevPts(1)-1 + do iy=1,p_FAST%VTK_surface%NWaveElevPts(2)-1 + n = p_FAST%VTK_surface%NWaveElevPts(2)*(ix-1)+iy - 1 ! points start at 0 - WRITE(Un,'(3(i7))') n, n+1, n+p_FAST%VTK_surface%NWaveElevPts(2) - WRITE(Un,'(3(i7))') n+1, n+1+p_FAST%VTK_surface%NWaveElevPts(2), n+p_FAST%VTK_surface%NWaveElevPts(2) + WRITE(Un,'(3(i7))') n, n+1, n+p_FAST%VTK_surface%NWaveElevPts(2) + WRITE(Un,'(3(i7))') n+1, n+1+p_FAST%VTK_surface%NWaveElevPts(2), n+p_FAST%VTK_surface%NWaveElevPts(2) - end do end do - WRITE(Un,'(A)') ' ' + end do + WRITE(Un,'(A)') ' ' - WRITE(Un,'(A)') ' ' - do n=1,NumberOfPolys - WRITE(Un,'(i7)') 3*n - end do - WRITE(Un,'(A)') ' ' - WRITE(Un,'(A)') ' ' + WRITE(Un,'(A)') ' ' + do n=1,NumberOfPolys + WRITE(Un,'(i7)') 3*n + end do + WRITE(Un,'(A)') ' ' + WRITE(Un,'(A)') ' ' - call WrVTK_footer( Un ) + call WrVTK_footer( Un ) -END SUBROUTINE WrVTK_WaveElev +END SUBROUTINE WrVTK_WaveElevVisGrid !---------------------------------------------------------------------------------------------------------------------------------- !> This function returns the index, Ind, of the XAry closest to XValIn, where XAry is assumed to be periodic. It starts !! searching at the value of Ind from a previous step. @@ -6168,8 +9184,8 @@ SUBROUTINE WriteInputMeshesToFile(u_ED, u_AD, u_SD, u_HD, u_MAP, u_BD, FileName, TYPE(MAP_InputType), INTENT(IN) :: u_MAP !< MAP inputs TYPE(BD_InputType), INTENT(IN) :: u_BD(:) !< BeamDyn inputs CHARACTER(*), INTENT(IN) :: FileName !< Name of file to write this information to - INTEGER(IntKi) :: ErrStat !< Error status of the operation - CHARACTER(*) :: ErrMsg !< Error message if ErrStat /= ErrID_None + INTEGER(IntKi), INTENT(OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT(OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None INTEGER(IntKi) :: unOut INTEGER(IntKi) :: K_local @@ -6206,6 +9222,7 @@ SUBROUTINE WriteInputMeshesToFile(u_ED, u_AD, u_SD, u_HD, u_MAP, u_BD, FileName, CALL MeshWrBin( unOut, u_HD%WAMITMesh, ErrStat, ErrMsg ) CALL MeshWrBin( unOut, u_MAP%PtFairDisplacement, ErrStat, ErrMsg ) ! Add how many BD blade meshes there are: +!FIXME: if u_BD is not allocated, size could return garbage here!!!! NumBl = SIZE(u_BD,1) ! Note that NumBl is B4Ki WRITE( unOut, IOSTAT=ErrStat ) NumBl @@ -6215,13 +9232,13 @@ SUBROUTINE WriteInputMeshesToFile(u_ED, u_AD, u_SD, u_HD, u_MAP, u_BD, FileName, END DO ! Add how many AD blade meshes there are: - NumBl = SIZE(u_AD%rotors(1)%BladeMotion,1) ! Note that NumBl is B4Ki + NumBl = SIZE(u_AD%rotors(1)%BladeMotion,1) ! Note that NumBl is B4Ki WRITE( unOut, IOSTAT=ErrStat ) NumBl DO K_local = 1,NumBl CALL MeshWrBin( unOut, u_AD%rotors(1)%BladeMotion(k_local), ErrStat, ErrMsg ) - END DO - + END DO + ! Close the file CLOSE(unOut) @@ -6272,6 +9289,7 @@ SUBROUTINE WriteMotionMeshesToFile(time, y_ED, u_SD, y_SD, u_HD, u_MAP, y_BD, u_ ! Add how many blade meshes there are: NumBl = SIZE(y_ED%BladeLn2Mesh,1) ! Note that NumBl is B4Ki WRITE( unOut, IOSTAT=ErrStat ) NumBl +!FIXME: if y_BD is not allocated, size could return garbage here!!!! NumBl = SIZE(y_BD,1) ! Note that NumBl is B4Ki WRITE( unOut, IOSTAT=ErrStat ) NumBl end if @@ -6371,8 +9389,8 @@ SUBROUTINE FAST_Linearize_T(t_initial, n_t_global, Turbine, ErrStat, ErrMsg) if ( EqualRealNos( t_global, next_lin_time ) .or. t_global > next_lin_time ) then CALL FAST_Linearize_OP(t_global, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & - Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD, Turbine%IfW, Turbine%OpFM, & - Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & + Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD, Turbine%IfW, Turbine%ExtInfw, & + Turbine%HD, Turbine%SeaSt, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) IF (ErrStat >= AbortErrLev) RETURN @@ -6390,7 +9408,7 @@ SUBROUTINE FAST_Linearize_T(t_initial, n_t_global, Turbine, ErrStat, ErrMsg) t_global = t_initial + n_t_global*Turbine%p_FAST%dt call FAST_CalcSteady( n_t_global, t_global, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, Turbine%ED, Turbine%BD, Turbine%SrvD, & - Turbine%AD, Turbine%IfW, Turbine%OpFM, Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, & + Turbine%AD, Turbine%IfW, Turbine%ExtInfw, Turbine%HD, Turbine%SeaSt, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, & Turbine%Orca, Turbine%IceF, Turbine%IceD, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -6403,8 +9421,8 @@ SUBROUTINE FAST_Linearize_T(t_initial, n_t_global, Turbine, ErrStat, ErrMsg) t_global = Turbine%m_FAST%Lin%LinTimes(iLinTime) call SetOperatingPoint(iLinTime, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, Turbine%ED, Turbine%BD, Turbine%SrvD, & - Turbine%AD, Turbine%IfW, Turbine%OpFM, Turbine%HD, Turbine%SD, Turbine%ExtPtfm, & - Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, Turbine%IceF, Turbine%IceD, ErrStat2, ErrMsg2 ) + Turbine%AD, Turbine%IfW, Turbine%ExtInfw, Turbine%HD, Turbine%SeaSt, Turbine%SD, Turbine%ExtPtfm, & + Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, Turbine%IceF, Turbine%IceD, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) if (Turbine%p_FAST%DT_UJac < Turbine%p_FAST%TMax) then @@ -6413,14 +9431,14 @@ SUBROUTINE FAST_Linearize_T(t_initial, n_t_global, Turbine, ErrStat, ErrMsg) end if CALL CalcOutputs_And_SolveForInputs( -1, t_global, STATE_CURR, Turbine%m_FAST%calcJacobian, Turbine%m_FAST%NextJacCalcTime, & - Turbine%p_FAST, Turbine%m_FAST, .false., Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD14, Turbine%AD, Turbine%IfW, Turbine%OpFM, & + Turbine%p_FAST, Turbine%m_FAST, .false., Turbine%ED, Turbine%SED, Turbine%BD, Turbine%SrvD, Turbine%AD, Turbine%ADsk, Turbine%ExtLd, Turbine%IfW, Turbine%ExtInfw, & Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) IF (ErrStat >= AbortErrLev) RETURN CALL FAST_Linearize_OP(t_global, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & - Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD, Turbine%IfW, Turbine%OpFM, & - Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & + Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD, Turbine%IfW, Turbine%ExtInfw, & + Turbine%HD, Turbine%SeaSt, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) IF (ErrStat >= AbortErrLev) RETURN @@ -6464,6 +9482,8 @@ SUBROUTINE ExitThisProgram_T( Turbine, ErrLevel_in, StopTheProgram, ErrLocMsg, S LOGICAL, OPTIONAL, INTENT(IN) :: SkipRunTimeMsg !< an optional message describing run-time stats LOGICAL :: SkipRunTimes + INTEGER(IntKi) :: ErrStat + CHARACTER(ErrMsgLen) :: ErrMsg IF (PRESENT(SkipRunTimeMsg)) THEN SkipRunTimes = SkipRunTimeMsg @@ -6475,26 +9495,30 @@ SUBROUTINE ExitThisProgram_T( Turbine, ErrLevel_in, StopTheProgram, ErrLocMsg, S IF (PRESENT(ErrLocMsg)) THEN CALL ExitThisProgram( Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & - Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD14, Turbine%AD, Turbine%IfW, Turbine%OpFM, & - Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & + Turbine%ED, Turbine%SED, Turbine%BD, Turbine%SrvD, Turbine%AD, Turbine%ADsk, Turbine%IfW, Turbine%ExtInfw, & + Turbine%SeaSt, Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrLevel_in, StopTheProgram, ErrLocMsg, SkipRunTimes ) ELSE CALL ExitThisProgram( Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & - Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD14, Turbine%AD, Turbine%IfW, Turbine%OpFM, & - Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & + Turbine%ED, Turbine%SED, Turbine%BD, Turbine%SrvD, Turbine%AD, Turbine%ADsk, Turbine%IfW, Turbine%ExtInfw, & + Turbine%SeaSt, Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrLevel_in, StopTheProgram, SkipRunTimeMsg=SkipRunTimes ) END IF + + CALL FAST_DestroyTurbineType( Turbine, ErrStat, ErrMsg) ! just in case we missed some data in ExitThisProgram() + + END SUBROUTINE ExitThisProgram_T !---------------------------------------------------------------------------------------------------------------------------------- !> This subroutine is called when FAST exits. It calls all the modules' end routines and cleans up variables declared in the !! main program. If there was an error, it also aborts. Otherwise, it prints the run times and performs a normal exit. !! This routine should not be called from glue code (e.g., FAST_Prog.f90) or ExitThisProgram_T only. It should not be called in any !! of these driver routines. -SUBROUTINE ExitThisProgram( p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, OpFM, HD, SD, ExtPtfm, & +SUBROUTINE ExitThisProgram( p_FAST, y_FAST, m_FAST, ED, SED, BD, SrvD, AD, ADsk, IfW, ExtInfw, SeaSt, HD, SD, ExtPtfm, & MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrLevel_in, StopTheProgram, ErrLocMsg, SkipRunTimeMsg ) !............................................................................................................................... @@ -6504,12 +9528,14 @@ SUBROUTINE ExitThisProgram( p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data + TYPE(SED_Data), INTENT(INOUT) :: SED !< Simplified-ElastoDyn data TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data - TYPE(AeroDyn14_Data), INTENT(INOUT) :: AD14 !< AeroDyn v14 data TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data + TYPE(AeroDisk_Data), INTENT(INOUT) :: ADsk !< AeroDisk data TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data - TYPE(OpenFOAM_Data), INTENT(INOUT) :: OpFM !< OpenFOAM data + TYPE(ExternalInflow_Data),INTENT(INOUT) :: ExtInfw !< ExternalInflow data + TYPE(SeaState_Data), INTENT(INOUT) :: SeaSt !< SeaState data TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HydroDyn data TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SubDyn data TYPE(ExtPtfm_Data), INTENT(INOUT) :: ExtPtfm !< ExtPtfm_MCKF data @@ -6545,13 +9571,18 @@ SUBROUTINE ExitThisProgram( p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, IF ( ErrorLevel >= AbortErrLev .AND. p_FAST%WrVTK > VTK_None .and. .not. m_FAST%Lin%FoundSteady) THEN p_FAST%VTK_OutFileRoot = trim(p_FAST%VTK_OutFileRoot)//'.DebugError' p_FAST%VTK_fields = .true. - CALL WrVTK_AllMeshes(p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, OpFM, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) + CALL WrVTK_AllMeshes(p_FAST, y_FAST, MeshMapData, ED, SED, BD, AD, IfW, ExtInfw, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) end if + ! If we are doing AeroMaps, there is leftover data in AD15 parameters + if (p_FAST%CompAeroMaps) then + if (associated(AD%p%FlowField)) deallocate(AD%p%FlowField) + endif + ! End all modules - CALL FAST_EndMods( p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, ErrStat2, ErrMsg2 ) + CALL FAST_EndMods( p_FAST, y_FAST, m_FAST, ED, SED, BD, SrvD, AD, ADsk, IfW, SeaSt, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, ErrStat2, ErrMsg2 ) IF (ErrStat2 /= ErrID_None) THEN CALL WrScr( NewLine//RoutineName//':'//TRIM(ErrMsg2)//NewLine ) ErrorLevel = MAX(ErrorLevel,ErrStat2) @@ -6559,7 +9590,7 @@ SUBROUTINE ExitThisProgram( p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, ! Destroy all data associated with FAST variables: - CALL FAST_DestroyAll( p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, OpFM, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2 ) + CALL FAST_DestroyAll( p_FAST, y_FAST, m_FAST, ED, SED, BD, SrvD, AD, IfW, ExtInfw, SeaSt, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2 ) IF (ErrStat2 /= ErrID_None) THEN CALL WrScr( NewLine//RoutineName//':'//TRIM(ErrMsg2)//NewLine ) ErrorLevel = MAX(ErrorLevel,ErrStat2) @@ -6581,8 +9612,8 @@ SUBROUTINE ExitThisProgram( p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, CLOSE(y_FAST%UnSum) y_FAST%UnSum = -1 END IF - - + + SimMsg = TRIM(FAST_Ver%Name)//' encountered an error '//TRIM(SimMsg)//'.'//NewLine//' Simulation error level: '//TRIM(GetErrStr(ErrorLevel)) if (StopTheProgram) then CALL ProgAbort( trim(SimMsg), TrapErrors=.FALSE., TimeWait=3._ReKi ) ! wait 3 seconds (in case they double-clicked and got an error) @@ -6689,20 +9720,22 @@ SUBROUTINE FAST_EndOutput( p_FAST, y_FAST, m_FAST, ErrStat, ErrMsg ) END SUBROUTINE FAST_EndOutput !---------------------------------------------------------------------------------------------------------------------------------- !> This routine calls the end routines for each module that was previously initialized. -SUBROUTINE FAST_EndMods( p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, ErrStat, ErrMsg ) +SUBROUTINE FAST_EndMods( p_FAST, y_FAST, m_FAST, ED, SED, BD, SrvD, AD, ADsk, IfW, SeaSt, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, ErrStat, ErrMsg ) TYPE(FAST_ParameterType), INTENT(INOUT) :: p_FAST !< Parameters for the glue code TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Output variables for the glue code TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data + TYPE(SED_Data), INTENT(INOUT) :: SED !< Simplified-ElastoDyn data TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data - TYPE(AeroDyn14_Data), INTENT(INOUT) :: AD14 !< AeroDyn v14 data TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data + TYPE(AeroDisk_Data), INTENT(INOUT) :: ADsk !< AeroDisk data TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HydroDyn data TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SubDyn data + TYPE(SeaState_Data), INTENT(INOUT) :: SeaSt !< SeaState data TYPE(ExtPtfm_Data), INTENT(INOUT) :: ExtPtfm !< ExtPtfm data TYPE(MAP_Data), INTENT(INOUT) :: MAPp !< MAP data TYPE(FEAMooring_Data), INTENT(INOUT) :: FEAM !< FEAMooring data @@ -6729,15 +9762,18 @@ SUBROUTINE FAST_EndMods( p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, HD ErrMsg = "" - CALL FAST_EndOutput( p_FAST, y_FAST, m_FAST, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF ( p_FAST%ModuleInitialized(Module_ED) ) THEN CALL ED_End( ED%Input(1), ED%p, ED%x(STATE_CURR), ED%xd(STATE_CURR), ED%z(STATE_CURR), ED%OtherSt(STATE_CURR), & ED%y, ED%m, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END IF + IF ( p_FAST%ModuleInitialized(Module_SED) ) THEN + CALL SED_End( SED%Input(1), SED%p, SED%x(STATE_CURR), SED%xd(STATE_CURR), SED%z(STATE_CURR), SED%OtherSt(STATE_CURR), & + SED%y, SED%m, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + END IF + IF ( p_FAST%ModuleInitialized(Module_BD) ) THEN DO k=1,p_FAST%nBeams @@ -6749,14 +9785,14 @@ SUBROUTINE FAST_EndMods( p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, HD END IF - IF ( p_FAST%ModuleInitialized(Module_AD14) ) THEN - CALL AD14_End( AD14%Input(1), AD14%p, AD14%x(STATE_CURR), AD14%xd(STATE_CURR), AD14%z(STATE_CURR), & - AD14%OtherSt(STATE_CURR), AD14%y, AD14%m, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - ELSEIF ( p_FAST%ModuleInitialized(Module_AD) ) THEN + IF ( p_FAST%ModuleInitialized(Module_AD) ) THEN CALL AD_End( AD%Input(1), AD%p, AD%x(STATE_CURR), AD%xd(STATE_CURR), AD%z(STATE_CURR), & AD%OtherSt(STATE_CURR), AD%y, AD%m, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + ELSEIF ( p_FAST%ModuleInitialized(Module_ADsk) ) THEN + CALL ADsk_End( ADsk%Input(1), ADsk%p, ADsk%x(STATE_CURR), ADsk%xd(STATE_CURR), ADsk%z(STATE_CURR), & + ADsk%OtherSt(STATE_CURR), ADsk%y, ADsk%m, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END IF IF ( p_FAST%ModuleInitialized(Module_IfW) ) THEN @@ -6819,10 +9855,25 @@ SUBROUTINE FAST_EndMods( p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, HD END IF + IF ( p_FAST%ModuleInitialized(Module_SeaSt) ) THEN + ! make sure this is done AFTER any module that may be pointing to SeaSt data -- we deallocate the pointer targets here + CALL SeaSt_End( SeaSt%Input(1), SeaSt%p, SeaSt%x(STATE_CURR), SeaSt%xd(STATE_CURR), SeaSt%z(STATE_CURR), SeaSt%OtherSt(STATE_CURR), & + SeaSt%y, SeaSt%m, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + END IF + + + + ! Write output to file (do this after ending modules so that we have more memory to use if needed) + CALL FAST_EndOutput( p_FAST, y_FAST, m_FAST, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + + END SUBROUTINE FAST_EndMods !---------------------------------------------------------------------------------------------------------------------------------- !> This routine calls the destroy routines for each module. (It is basically a duplicate of FAST_DestroyTurbineType().) -SUBROUTINE FAST_DestroyAll( p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, OpFM, HD, SD, ExtPtfm, & +SUBROUTINE FAST_DestroyAll( p_FAST, y_FAST, m_FAST, ED, SED, BD, SrvD, AD, IfW, ExtInfw, SeaSt, HD, SD, ExtPtfm, & MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat, ErrMsg ) TYPE(FAST_ParameterType), INTENT(INOUT) :: p_FAST !< Parameters for the glue code @@ -6830,12 +9881,13 @@ SUBROUTINE FAST_DestroyAll( p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data + TYPE(SED_Data), INTENT(INOUT) :: SED !< Simplified-ElastoDyn data TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data - TYPE(AeroDyn14_Data), INTENT(INOUT) :: AD14 !< AeroDyn v14 data TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data - TYPE(OpenFOAM_Data), INTENT(INOUT) :: OpFM !< OpenFOAM data + TYPE(ExternalInflow_Data),INTENT(INOUT) :: ExtInfw !< ExternalInflow data + TYPE(SeaState_Data), INTENT(INOUT) :: SeaSt !< SeaState data TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HydroDyn data TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SubDyn data TYPE(ExtPtfm_Data), INTENT(INOUT) :: ExtPtfm !< ExtPtfm data @@ -6880,6 +9932,10 @@ SUBROUTINE FAST_DestroyAll( p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, CALL FAST_DestroyElastoDyn_Data( ED, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + ! Simplified-ElastoDyn + CALL FAST_DestroySED_Data( SED, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + ! BeamDyn CALL FAST_DestroyBeamDyn_Data( BD, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -6888,10 +9944,6 @@ SUBROUTINE FAST_DestroyAll( p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, CALL FAST_DestroyServoDyn_Data( SrvD, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - ! AeroDyn14 - CALL FAST_DestroyAeroDyn14_Data( AD14, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - ! AeroDyn CALL FAST_DestroyAeroDyn_Data( AD, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -6900,8 +9952,12 @@ SUBROUTINE FAST_DestroyAll( p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, CALL FAST_DestroyInflowWind_Data( IfW, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - ! OpenFOAM - CALL FAST_DestroyOpenFOAM_Data( OpFM, ErrStat2, ErrMsg2 ) + ! ExternalInflow + CALL FAST_DestroyExternalInflow_Data( ExtInfw, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + ! SeaState + CALL FAST_DestroySeaState_Data( SeaSt, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ! HydroDyn @@ -6916,7 +9972,6 @@ SUBROUTINE FAST_DestroyAll( p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, CALL FAST_DestroyExtPtfm_Data( ExtPtfm, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - ! MAP CALL FAST_DestroyMAP_Data( MAPp, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -6933,7 +9988,6 @@ SUBROUTINE FAST_DestroyAll( p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, CALL FAST_DestroyOrcaFlex_Data( Orca, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - ! IceFloe CALL FAST_DestroyIceFloe_Data( IceF, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -7013,11 +10067,7 @@ SUBROUTINE FAST_CreateCheckpoint_T(t_initial, n_t_global, NumTurbines, Turbine, INTEGER(IntKi), OPTIONAL, INTENT(INOUT) :: Unit !< unit number for output file ! local variables: - REAL(ReKi), ALLOCATABLE :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE :: IntKiBuf(:) - - INTEGER(B4Ki) :: ArraySizes(3) + type(RegFile) :: RF INTEGER(IntKi) :: unOut ! unit number for output file INTEGER(IntKi) :: old_avrSwap1 ! previous value of avrSwap(1) !hack for Bladed DLL checkpoint/restore @@ -7031,21 +10081,7 @@ SUBROUTINE FAST_CreateCheckpoint_T(t_initial, n_t_global, NumTurbines, Turbine, ! init error status ErrStat = ErrID_None ErrMsg = "" - - ! Get the arrays of data to be stored in the output file - CALL FAST_PackTurbineType( ReKiBuf, DbKiBuf, IntKiBuf, Turbine, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - if (ErrStat >= AbortErrLev ) then - call cleanup() - RETURN - end if - - - ArraySizes = 0 - IF ( ALLOCATED(ReKiBuf) ) ArraySizes(1) = SIZE(ReKiBuf) - IF ( ALLOCATED(DbKiBuf) ) ArraySizes(2) = SIZE(DbKiBuf) - IF ( ALLOCATED(IntKiBuf) ) ArraySizes(3) = SIZE(IntKiBuf) - + FileName = TRIM(CheckpointRoot)//'.chkp' DLLFileName = TRIM(CheckpointRoot)//'.dll.chkp' @@ -7060,44 +10096,35 @@ SUBROUTINE FAST_CreateCheckpoint_T(t_initial, n_t_global, NumTurbines, Turbine, !$OMP end critical(fileopen) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) if (ErrStat >= AbortErrLev ) then - call cleanup() IF (.NOT. PRESENT(Unit)) THEN CLOSE(unOut) unOut = -1 - END IF - - RETURN + end if + return end if - ! checkpoint file header: - WRITE (unOut, IOSTAT=ErrStat2) INT(ReKi ,B4Ki) ! let's make sure we've got the correct number of bytes for reals on restart. - WRITE (unOut, IOSTAT=ErrStat2) INT(DbKi ,B4Ki) ! let's make sure we've got the correct number of bytes for doubles on restart. - WRITE (unOut, IOSTAT=ErrStat2) INT(IntKi ,B4Ki) ! let's make sure we've got the correct number of bytes for integers on restart. - WRITE (unOut, IOSTAT=ErrStat2) AbortErrLev - WRITE (unOut, IOSTAT=ErrStat2) NumTurbines ! Number of turbines - WRITE (unOut, IOSTAT=ErrStat2) t_initial ! initial time - WRITE (unOut, IOSTAT=ErrStat2) n_t_global ! current time step + ! Checkpoint file header: + WRITE (unOut, IOSTAT=ErrStat2) AbortErrLev ! Abort error level + WRITE (unOut, IOSTAT=ErrStat2) NumTurbines ! Number of turbines + WRITE (unOut, IOSTAT=ErrStat2) t_initial ! initial time + WRITE (unOut, IOSTAT=ErrStat2) n_t_global ! current time step END IF + ! Initialize the registry file + call InitRegFile(RF, unOut, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return - ! data from current turbine at time step: - WRITE (unOut, IOSTAT=ErrStat2) ArraySizes ! Number of reals, doubles, and integers written to file - WRITE (unOut, IOSTAT=ErrStat2) ReKiBuf ! Packed reals - WRITE (unOut, IOSTAT=ErrStat2) DbKiBuf ! Packed doubles - WRITE (unOut, IOSTAT=ErrStat2) IntKiBuf ! Packed integers - - - IF ( ALLOCATED(ReKiBuf) ) DEALLOCATE(ReKiBuf) - IF ( ALLOCATED(DbKiBuf) ) DEALLOCATE(DbKiBuf) - IF ( ALLOCATED(IntKiBuf) ) DEALLOCATE(IntKiBuf) - - !CALL FAST_CreateCheckpoint(t_initial, n_t_global, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & - ! Turbine%ED, Turbine%SrvD, Turbine%AD, Turbine%IfW, & - ! Turbine%HD, Turbine%SD, Turbine%MAP, Turbine%FEAM, Turbine%MD, & - ! Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat, ErrMsg ) + ! Pack data into the registry file + call FAST_PackTurbineType(RF, Turbine) + ! Close registry file and get any errors that occurred while writing + call CloseRegFile(RF, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + ! If last turbine or no unit, close output unit IF (Turbine%TurbID == NumTurbines .OR. .NOT. PRESENT(Unit)) THEN CLOSE(unOut) unOut = -1 @@ -7127,18 +10154,10 @@ SUBROUTINE FAST_CreateCheckpoint_T(t_initial, n_t_global, NumTurbines, Turbine, end if END IF - call cleanup() - -contains - subroutine cleanup() - IF ( ALLOCATED(ReKiBuf) ) DEALLOCATE(ReKiBuf) - IF ( ALLOCATED(DbKiBuf) ) DEALLOCATE(DbKiBuf) - IF ( ALLOCATED(IntKiBuf) ) DEALLOCATE(IntKiBuf) - end subroutine cleanup END SUBROUTINE FAST_CreateCheckpoint_T !---------------------------------------------------------------------------------------------------------------------------------- !> Routine that calls FAST_RestoreFromCheckpoint_T for an array of Turbine data structures. -SUBROUTINE FAST_RestoreFromCheckpoint_Tary(t_initial, n_t_global, Turbine, CheckpointRoot, ErrStat, ErrMsg ) +SUBROUTINE FAST_RestoreFromCheckpoint_Tary(t_initial, n_t_global, Turbine, CheckpointRoot, ErrStat, ErrMsg, silent ) REAL(DbKi), INTENT(IN ) :: t_initial !< initial time (for comparing with time from checkpoint file) INTEGER(IntKi), INTENT( OUT) :: n_t_global !< loop counter @@ -7146,6 +10165,7 @@ SUBROUTINE FAST_RestoreFromCheckpoint_Tary(t_initial, n_t_global, Turbine, Check CHARACTER(*), INTENT(IN ) :: CheckpointRoot !< Rootname of checkpoint file INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + logical, optional, intent(in ) :: silent !< optional to not write "#Restarting here" info ! local variables REAL(DbKi) :: t_initial_out @@ -7168,7 +10188,11 @@ SUBROUTINE FAST_RestoreFromCheckpoint_Tary(t_initial, n_t_global, Turbine, Check ! Restore data from checkpoint file Unit = -1 DO i_turb = 1,NumTurbines - CALL FAST_RestoreFromCheckpoint_T(t_initial_out, n_t_global, NumTurbines_out, Turbine(i_turb), CheckpointRoot, ErrStat2, ErrMsg2, Unit ) + if (present(silent)) then + CALL FAST_RestoreFromCheckpoint_T(t_initial_out, n_t_global, NumTurbines_out, Turbine(i_turb), CheckpointRoot, ErrStat2, ErrMsg2, Unit, silent ) + else + CALL FAST_RestoreFromCheckpoint_T(t_initial_out, n_t_global, NumTurbines_out, Turbine(i_turb), CheckpointRoot, ErrStat2, ErrMsg2, Unit ) + endif CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) IF (t_initial_out /= t_initial) CALL SetErrStat(ErrID_Fatal, "invalid value of t_initial.", ErrStat, ErrMsg, RoutineName ) @@ -7183,7 +10207,7 @@ END SUBROUTINE FAST_RestoreFromCheckpoint_Tary !---------------------------------------------------------------------------------------------------------------------------------- !> This routine is the inverse of FAST_CreateCheckpoint_T. It reads data from a checkpoint file and populates data structures for !! the turbine instance. -SUBROUTINE FAST_RestoreFromCheckpoint_T(t_initial, n_t_global, NumTurbines, Turbine, CheckpointRoot, ErrStat, ErrMsg, Unit ) +SUBROUTINE FAST_RestoreFromCheckpoint_T(t_initial, n_t_global, NumTurbines, Turbine, CheckpointRoot, ErrStat, ErrMsg, Unit, silent ) USE BladedInterface, ONLY: CallBladedDLL ! Hack for Bladed-style DLL USE BladedInterface, ONLY: GH_DISCON_STATUS_RESTARTING @@ -7195,13 +10219,10 @@ SUBROUTINE FAST_RestoreFromCheckpoint_T(t_initial, n_t_global, NumTurbines, Turb INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None INTEGER(IntKi), OPTIONAL, INTENT(INOUT) :: Unit !< unit number for output file + logical, optional, intent(in ) :: silent !< optional to not write "#Restarting here" info ! local variables: - REAL(ReKi), ALLOCATABLE :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE :: IntKiBuf(:) - - INTEGER(B4Ki) :: ArraySizes(3) + type(RegFile) :: RF INTEGER(IntKi) :: unIn ! unit number for input file INTEGER(IntKi) :: old_avrSwap1 ! previous value of avrSwap(1) !hack for Bladed DLL checkpoint/restore @@ -7226,63 +10247,32 @@ SUBROUTINE FAST_RestoreFromCheckpoint_T(t_initial, n_t_global, NumTurbines, Turb !$OMP critical(fileopen) CALL GetNewUnit( unIn, ErrStat2, ErrMsg2 ) - CALL OpenBInpFile ( unIn, FileName, ErrStat2, ErrMsg2) !$OMP end critical(fileopen) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) IF (ErrStat >= AbortErrLev ) RETURN - ! checkpoint file header: - READ (unIn, IOSTAT=ErrStat2) ArraySizes ! let's make sure we've got the correct number of bytes for reals, doubles, and integers on restart. - - IF ( ArraySizes(1) /= ReKi ) CALL SetErrStat(ErrID_Fatal,"ReKi on restart is different than when checkpoint file was created.",ErrStat,ErrMsg,RoutineName) - IF ( ArraySizes(2) /= DbKi ) CALL SetErrStat(ErrID_Fatal,"DbKi on restart is different than when checkpoint file was created.",ErrStat,ErrMsg,RoutineName) - IF ( ArraySizes(3) /= IntKi ) CALL SetErrStat(ErrID_Fatal,"IntKi on restart is different than when checkpoint file was created.",ErrStat,ErrMsg,RoutineName) - IF (ErrStat >= AbortErrLev) THEN - CLOSE(unIn) - unIn = -1 - IF (PRESENT(Unit)) Unit = unIn - RETURN - END IF - - READ (unIn, IOSTAT=ErrStat2) AbortErrLev - READ (unIn, IOSTAT=ErrStat2) NumTurbines ! Number of turbines - READ (unIn, IOSTAT=ErrStat2) t_initial ! initial time - READ (unIn, IOSTAT=ErrStat2) n_t_global ! current time step + READ (unIn, IOSTAT=ErrStat2) AbortErrLev ! Abort error level + READ (unIn, IOSTAT=ErrStat2) NumTurbines ! Number of turbines + READ (unIn, IOSTAT=ErrStat2) t_initial ! initial time + READ (unIn, IOSTAT=ErrStat2) n_t_global ! current time step END IF ! in case the Turbine data structure isn't empty on entry of this routine: call FAST_DestroyTurbineType( Turbine, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + IF (ErrStat >= AbortErrLev) return - ! data from current time step: - READ (unIn, IOSTAT=ErrStat2) ArraySizes ! Number of reals, doubles, and integers written to file - - ALLOCATE(ReKiBuf( ArraySizes(1)), STAT=ErrStat2) - IF (ErrStat2 /=0) CALL SetErrStat(ErrID_Fatal, "Could not allocate ReKiBuf", ErrStat, ErrMsg, RoutineName ) - ALLOCATE(DbKiBuf( ArraySizes(2)), STAT=ErrStat2) - IF (ErrStat2 /=0) CALL SetErrStat(ErrID_Fatal, "Could not allocate DbKiBuf", ErrStat, ErrMsg, RoutineName ) - ALLOCATE(IntKiBuf(ArraySizes(3)), STAT=ErrStat2) - IF (ErrStat2 /=0) CALL SetErrStat(ErrID_Fatal, "Could not allocate IntKiBuf", ErrStat, ErrMsg, RoutineName ) - - ! Read the packed arrays - IF (ErrStat < AbortErrLev) THEN - - READ (unIn, IOSTAT=ErrStat2) ReKiBuf ! Packed reals - IF (ErrStat2 /=0) CALL SetErrStat(ErrID_Fatal, "Could not read ReKiBuf", ErrStat, ErrMsg, RoutineName ) - READ (unIn, IOSTAT=ErrStat2) DbKiBuf ! Packed doubles - IF (ErrStat2 /=0) CALL SetErrStat(ErrID_Fatal, "Could not read DbKiBuf", ErrStat, ErrMsg, RoutineName ) - READ (unIn, IOSTAT=ErrStat2) IntKiBuf ! Packed integers - IF (ErrStat2 /=0) CALL SetErrStat(ErrID_Fatal, "Could not read IntKiBuf", ErrStat, ErrMsg, RoutineName ) - - END IF - - ! Put the arrays back in the data types - IF (ErrStat < AbortErrLev) THEN - CALL FAST_UnpackTurbineType( ReKiBuf, DbKiBuf, IntKiBuf, Turbine, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END IF + ! Initialize registry file for reading + call OpenRegFile(RF, unIn, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + ! Unpack registry file into turbine data structure + call FAST_UnpackTurbineType(RF, Turbine) + call SetErrStat(RF%ErrStat, RF%ErrMsg, ErrStat, ErrMsg, RoutineName ) + if (ErrStat >= AbortErrLev) return ! close file if necessary (do this after unpacking turbine data, so that TurbID is set) IF (Turbine%TurbID == NumTurbines .OR. .NOT. PRESENT(Unit)) THEN @@ -7292,15 +10282,9 @@ SUBROUTINE FAST_RestoreFromCheckpoint_T(t_initial, n_t_global, NumTurbines, Turb IF (PRESENT(Unit)) Unit = unIn - - IF ( ALLOCATED(ReKiBuf) ) DEALLOCATE(ReKiBuf) - IF ( ALLOCATED(DbKiBuf) ) DEALLOCATE(DbKiBuf) - IF ( ALLOCATED(IntKiBuf) ) DEALLOCATE(IntKiBuf) - - ! A sort-of hack to restore MAP DLL data (in particular Turbine%MAP%OtherSt%C_Obj%object) - ! these must be the same variables that are used in MAP_Init because they get allocated in the DLL and - ! destroyed in MAP_End (also, inside the DLL) + ! these must be the same variables that are used in MAP_Init because they get allocated in the DLL and + ! destroyed in MAP_End (also, inside the DLL) IF (Turbine%p_FAST%CompMooring == Module_MAP) THEN CALL MAP_Restart( Turbine%MAP%Input(1), Turbine%MAP%p, Turbine%MAP%x(STATE_CURR), Turbine%MAP%xd(STATE_CURR), & Turbine%MAP%z(STATE_CURR), Turbine%MAP%OtherSt, Turbine%MAP%y, ErrStat2, ErrMsg2 ) @@ -7331,17 +10315,21 @@ SUBROUTINE FAST_RestoreFromCheckpoint_T(t_initial, n_t_global, NumTurbines, Turb ! deal with sibling meshes here: ! (ignoring for now; they are not going to be siblings on restart) - + ! deal with files that were open: IF (Turbine%p_FAST%WrTxtOutFile) THEN CALL OpenFunkFileAppend ( Turbine%y_FAST%UnOu, TRIM(Turbine%p_FAST%OutFileRoot)//'.out', ErrStat2, ErrMsg2) - IF ( ErrStat2 >= AbortErrLev ) RETURN CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL WrFileNR ( Turbine%y_FAST%UnOu, '#Restarting here') - WRITE(Turbine%y_FAST%UnOu, '()') + IF ( ErrStat2 >= AbortErrLev ) RETURN + if (present(silent)) then + if (.not. silent) then + CALL WrFileNR ( Turbine%y_FAST%UnOu, '#Restarting here') + WRITE(Turbine%y_FAST%UnOu, '()') + endif + endif END IF - ! (ignoring for now; will have fort.x files if any were open [though I printed a warning about not outputting binary files earlier]) + ! (ignoring for now; will have fort.x files if any were open [though I printed a warning about not outputting binary files earlier]) END SUBROUTINE FAST_RestoreFromCheckpoint_T !---------------------------------------------------------------------------------------------------------------------------------- @@ -7379,7 +10367,7 @@ SUBROUTINE FAST_RestoreForVTKModeShape_Tary(t_initial, Turbine, InputFileName, E CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) if (ErrStat >= AbortErrLev) return - CALL FAST_RestoreFromCheckpoint_Tary( t_initial, n_t_global, Turbine, trim(Turbine(1)%p_FAST%VTK_modes%CheckpointRoot), ErrStat2, ErrMsg2 ) + CALL FAST_RestoreFromCheckpoint_Tary( t_initial, n_t_global, Turbine, trim(Turbine(1)%p_FAST%VTK_modes%CheckpointRoot), ErrStat2, ErrMsg2, silent=.true. ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -7390,8 +10378,9 @@ SUBROUTINE FAST_RestoreForVTKModeShape_Tary(t_initial, Turbine, InputFileName, E end if CALL FAST_RestoreForVTKModeShape_T(t_initial, Turbine(i_turb)%p_FAST, Turbine(i_turb)%y_FAST, Turbine(i_turb)%m_FAST, & - Turbine(i_turb)%ED, Turbine(i_turb)%BD, Turbine(i_turb)%SrvD, Turbine(i_turb)%AD14, Turbine(i_turb)%AD, Turbine(i_turb)%IfW, Turbine(i_turb)%OpFM, & - Turbine(i_turb)%HD, Turbine(i_turb)%SD, Turbine(i_turb)%ExtPtfm, Turbine(i_turb)%MAP, Turbine(i_turb)%FEAM, Turbine(i_turb)%MD, Turbine(i_turb)%Orca, & + Turbine(i_turb)%ED, Turbine(i_turb)%SED, Turbine(i_turb)%BD, Turbine(i_turb)%SrvD, & + Turbine(i_turb)%AD, Turbine(i_turb)%ADsk, Turbine(i_turb)%ExtLd, Turbine(i_turb)%IfW, Turbine(i_turb)%ExtInfw, & + Turbine(i_turb)%SeaSt, Turbine(i_turb)%HD, Turbine(i_turb)%SD, Turbine(i_turb)%ExtPtfm, Turbine(i_turb)%MAP, Turbine(i_turb)%FEAM, Turbine(i_turb)%MD, Turbine(i_turb)%Orca, & Turbine(i_turb)%IceF, Turbine(i_turb)%IceD, Turbine(i_turb)%MeshMapData, trim(InputFileName), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO @@ -7401,7 +10390,7 @@ END SUBROUTINE FAST_RestoreForVTKModeShape_Tary !---------------------------------------------------------------------------------------------------------------------------------- !> This routine calculates the motions generated by mode shapes and outputs VTK data for it -SUBROUTINE FAST_RestoreForVTKModeShape_T(t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, OpFM, HD, SD, ExtPtfm, & +SUBROUTINE FAST_RestoreForVTKModeShape_T(t_initial, p_FAST, y_FAST, m_FAST, ED, SED, BD, SrvD, AD, ADsk, ExtLd, IfW, ExtInfw, SeaSt, HD, SD, ExtPtfm, & MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, InputFileName, ErrStat, ErrMsg ) REAL(DbKi), INTENT(IN ) :: t_initial !< initial time @@ -7411,12 +10400,15 @@ SUBROUTINE FAST_RestoreForVTKModeShape_T(t_initial, p_FAST, y_FAST, m_FAST, ED, TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data + TYPE(SED_Data), INTENT(INOUT) :: SED !< Simplified-ElastoDyn data (note: not linearized, but need for interfaces to routines called here) TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data - TYPE(AeroDyn14_Data), INTENT(INOUT) :: AD14 !< AeroDyn14 data TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data + TYPE(AeroDisk_Data), INTENT(INOUT) :: ADsk !< AeroDisk data + TYPE(ExtLoads_Data), INTENT(INOUT) :: ExtLd !< ExtLoads data TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data - TYPE(OpenFOAM_Data), INTENT(INOUT) :: OpFM !< OpenFOAM data + TYPE(ExternalInflow_Data),INTENT(INOUT) :: ExtInfw !< ExternalInflow data + TYPE(SeaState_Data), INTENT(INOUT) :: SeaSt !< SeaState data TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HydroDyn data TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SubDyn data TYPE(ExtPtfm_Data), INTENT(INOUT) :: ExtPtfm !< ExtPtfm_MCKF data @@ -7485,7 +10477,7 @@ SUBROUTINE FAST_RestoreForVTKModeShape_T(t_initial, p_FAST, y_FAST, m_FAST, ED, ModeNo = p_FAST%VTK_modes%VTKModes(iMode) if (ModeNo>iModeMax) then call WrScr(' Skipping mode '//trim(num2lstr(ModeNo))//', maximum number of modes reached ('//trim(num2lstr(iModeMax))//'). Exiting.') - exit; + exit; endif call GetTimeConstants(p_FAST%VTK_modes%DampedFreq_Hz(ModeNo), p_FAST%VTK_fps, p_FAST%VTK_modes%VTKLinTim, nt, dt, p_FAST%VTK_tWidth ) write(sInfo, '(A,I4,A,F12.4,A,I4,A,I0)') 'Mode',ModeNo,', Freq=', p_FAST%VTK_modes%DampedFreq_Hz(ModeNo),'Hz, NLinTimes=',NLinTimes,', nt=',nt @@ -7507,22 +10499,22 @@ SUBROUTINE FAST_RestoreForVTKModeShape_T(t_initial, p_FAST, y_FAST, m_FAST, ED, m_FAST%NextJacCalcTime = m_FAST%Lin%LinTimes(iLinTime) end if - call SetOperatingPoint(iLinTime, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, OpFM, HD, SD, ExtPtfm, & + call SetOperatingPoint(iLinTime, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, ExtInfw, HD, SeaSt, SD, ExtPtfm, & MAPp, FEAM, MD, Orca, IceF, IceD, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ! set perturbation of states based on x_eig magnitude and phase - call PerturbOP(tprime, iLinTime, ModeNo, p_FAST, y_FAST, ED, BD, SrvD, AD, IfW, OpFM, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & + call PerturbOP(tprime, iLinTime, ModeNo, p_FAST, y_FAST, ED, BD, SrvD, AD, IfW, ExtInfw, HD, SeaSt, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & IceF, IceD, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) IF (ErrStat >= AbortErrLev) RETURN CALL CalcOutputs_And_SolveForInputs( -1, m_FAST%Lin%LinTimes(iLinTime), STATE_CURR, m_FAST%calcJacobian, m_FAST%NextJacCalcTime, & - p_FAST, m_FAST, .true., ED, BD, SrvD, AD14, AD, IfW, OpFM, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2 ) + p_FAST, m_FAST, .true., ED, SED, BD, SrvD, AD, ADsk, ExtLd, IfW, ExtInfw, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) IF (ErrStat >= AbortErrLev) RETURN - call WriteVTK(m_FAST%Lin%LinTimes(iLinTime), p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, OpFM, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) + call WriteVTK(m_FAST%Lin%LinTimes(iLinTime), p_FAST, y_FAST, MeshMapData, ED, SED, BD, AD, IfW, ExtInfw, SeaSt, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) end do ! iLinTime case (2) @@ -7539,22 +10531,22 @@ SUBROUTINE FAST_RestoreForVTKModeShape_T(t_initial, p_FAST, y_FAST, m_FAST, ED, do it = 1,nt tprime = (it-1)*dt - call SetOperatingPoint(iLinTime, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, OpFM, HD, SD, ExtPtfm, & + call SetOperatingPoint(iLinTime, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, ExtInfw, HD, SeaSt, SD, ExtPtfm, & MAPp, FEAM, MD, Orca, IceF, IceD, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ! set perturbation of states based on x_eig magnitude and phase - call PerturbOP(tprime, iLinTime, ModeNo, p_FAST, y_FAST, ED, BD, SrvD, AD, IfW, OpFM, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & + call PerturbOP(tprime, iLinTime, ModeNo, p_FAST, y_FAST, ED, BD, SrvD, AD, IfW, ExtInfw, HD, SeaSt, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & IceF, IceD, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) IF (ErrStat >= AbortErrLev) RETURN CALL CalcOutputs_And_SolveForInputs( -1, m_FAST%Lin%LinTimes(iLinTime), STATE_CURR, m_FAST%calcJacobian, m_FAST%NextJacCalcTime, & - p_FAST, m_FAST, .true., ED, BD, SrvD, AD14, AD, IfW, OpFM, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2 ) + p_FAST, m_FAST, .true., ED, SED, BD, SrvD, AD, ADsk, ExtLd, IfW, ExtInfw, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) IF (ErrStat >= AbortErrLev) RETURN - call WriteVTK(m_FAST%Lin%LinTimes(iLinTime)+tprime, p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, OpFM, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) + call WriteVTK(m_FAST%Lin%LinTimes(iLinTime)+tprime, p_FAST, y_FAST, MeshMapData, ED, SED, BD, AD, IfW, ExtInfw, SeaSt, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) end do ! it end do ! iLinTime @@ -7599,7 +10591,7 @@ SUBROUTINE GetTimeConstants(DampedFreq_Hz, VTK_fps, VTKLinTim, nt, dt, VTK_tWidt else ! All simulation will use VTK_fps cycle_time = 1.0_DbKi / DampedFreq_Hz - nt = NINT(VTK_fps) + nt = NINT(VTK_fps) endif dt = cycle_time / nt diff --git a/modules/openfast-library/src/FAST_Types.f90 b/modules/openfast-library/src/FAST_Types.f90 index 309a826fd1..125d2a0643 100644 --- a/modules/openfast-library/src/FAST_Types.f90 +++ b/modules/openfast-library/src/FAST_Types.f90 @@ -32,15 +32,17 @@ MODULE FAST_Types !--------------------------------------------------------------------------------------------------------------------------------- USE ElastoDyn_Types +USE SED_Types USE BeamDyn_Types USE ServoDyn_Types -USE InflowWind_Types -USE AeroDyn14_Types USE AeroDyn_Types +USE AeroDisk_Types +USE ExtLoads_Types USE SubDyn_Types +USE SeaState_Types USE HydroDyn_Types USE IceFloe_Types -USE OpenFOAM_Types +USE ExternalInflow_Types USE SCDataEx_Types USE IceDyn_Types USE FEAMooring_Types @@ -54,24 +56,34 @@ MODULE FAST_Types INTEGER(IntKi), PUBLIC, PARAMETER :: Module_None = 0 ! No module selected [-] INTEGER(IntKi), PUBLIC, PARAMETER :: Module_Glue = 1 ! Glue code [-] INTEGER(IntKi), PUBLIC, PARAMETER :: Module_IfW = 2 ! InflowWind [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Module_OpFM = 3 ! OpenFOAM [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Module_ExtInfw = 3 ! ExternalInflow [-] INTEGER(IntKi), PUBLIC, PARAMETER :: Module_ED = 4 ! ElastoDyn [-] INTEGER(IntKi), PUBLIC, PARAMETER :: Module_BD = 5 ! BeamDyn [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Module_AD14 = 6 ! AeroDyn14 [-] INTEGER(IntKi), PUBLIC, PARAMETER :: Module_AD = 7 ! AeroDyn [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Module_SrvD = 8 ! ServoDyn [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Module_HD = 9 ! HydroDyn [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Module_SD = 10 ! SubDyn [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Module_ExtPtfm = 11 ! External Platform Loading MCKF [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Module_MAP = 12 ! MAP (Mooring Analysis Program) [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Module_FEAM = 13 ! FEAMooring [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Module_MD = 14 ! MoorDyn [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Module_Orca = 15 ! OrcaFlex integration (HD/Mooring) [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Module_IceF = 16 ! IceFloe [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Module_IceD = 17 ! IceDyn [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: NumModules = 17 ! The number of modules available in FAST [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Module_ExtLd = 8 ! ExternalLoads [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Module_SrvD = 9 ! ServoDyn [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Module_SeaSt = 10 ! SeaState [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Module_HD = 11 ! HydroDyn [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Module_SD = 12 ! SubDyn [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Module_ExtPtfm = 13 ! External Platform Loading MCKF [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Module_MAP = 14 ! MAP (Mooring Analysis Program) [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Module_FEAM = 15 ! FEAMooring [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Module_MD = 16 ! MoorDyn [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Module_Orca = 17 ! OrcaFlex integration (HD/Mooring) [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Module_IceF = 18 ! IceFloe [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Module_IceD = 19 ! IceDyn [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Module_ADsk = 20 ! AeroDisk [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Module_SED = 21 ! Simplified-ElastoDyn [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: NumModules = 21 ! The number of modules available in FAST [-] INTEGER(IntKi), PUBLIC, PARAMETER :: MaxNBlades = 3 ! Maximum number of blades allowed on a turbine [-] INTEGER(IntKi), PUBLIC, PARAMETER :: IceD_MaxLegs = 4 ! because I don't know how many legs there are before calling IceD_Init and I don't want to copy the data because of sibling mesh issues, I'm going to allocate IceD based on this number [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: SS_Indx_Pitch = 1 ! pitch [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: SS_Indx_TSR = 2 ! TSR [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: SS_Indx_WS = 3 ! wind speed [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: SS_Indx_RotSpeed = 4 ! rotor speed [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: SS_Indx_Err = 5 ! err in the ss solve [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: SS_Indx_Iter = 6 ! number of iterations [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: NumStateTimes = 4 ! size of arrays of state derived types (Continuous state type etc). (STATE_CURR, STATE_PRED, STATE_SAVED_CURR, STATE_SAVED_PRED) [-] ! ========= FAST_VTK_BLSurfaceType ======= TYPE, PUBLIC :: FAST_VTK_BLSurfaceType REAL(SiKi) , DIMENSION(:,:,:), ALLOCATABLE :: AirfoilCoords !< x,y coordinates for airfoil around each blade node on a blade (relative to reference) [-] @@ -79,14 +91,15 @@ MODULE FAST_Types ! ======================= ! ========= FAST_VTK_SurfaceType ======= TYPE, PUBLIC :: FAST_VTK_SurfaceType - INTEGER(IntKi) :: NumSectors !< number of sectors in which to split circles (higher number gives smoother surface) [-] - REAL(SiKi) :: HubRad !< Preconed hub radius (distance from the rotor apex to the blade root) [m] - REAL(SiKi) :: GroundRad !< radius for plotting circle on ground [m] - REAL(SiKi) , DIMENSION(1:3,1:8) :: NacelleBox !< X-Y-Z locations of 8 points that define the nacelle box, relative to the nacelle position [m] + INTEGER(IntKi) :: NumSectors = 0_IntKi !< number of sectors in which to split circles (higher number gives smoother surface) [-] + REAL(SiKi) :: HubRad = 0.0_R4Ki !< Preconed hub radius (distance from the rotor apex to the blade root) [m] + REAL(SiKi) :: GroundRad = 0.0_R4Ki !< radius for plotting circle on ground [m] + REAL(SiKi) , DIMENSION(1:3,1:8) :: NacelleBox = 0.0_R4Ki !< X-Y-Z locations of 8 points that define the nacelle box, relative to the nacelle position [m] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: TowerRad !< radius of each ED tower node [m] - INTEGER(IntKi) , DIMENSION(1:2) :: NWaveElevPts !< number of points for wave elevation visualization [-] - REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: WaveElevXY !< X-Y locations for WaveElev output (for visualization). First dimension is the X (1) and Y (2) coordinate. Second dimension is the point number. [m,-] - REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: WaveElev !< wave elevation at WaveElevXY; first dimension is time step; second dimension is point number [m,-] + INTEGER(IntKi) , DIMENSION(1:2) :: NWaveElevPts = 0_IntKi !< number of points for wave elevation visualization [-] + REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveElevVisX !< X locations for WaveElev output (for visualization). [m,-] + REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveElevVisY !< Y locations for WaveElev output (for visualization). [m,-] + REAL(SiKi) , DIMENSION(:,:,:), ALLOCATABLE :: WaveElevVisGrid !< wave elevation at WaveElevVis{XY}; first dimension is time step; second/third dimensions are grid of elevations [m,-] TYPE(FAST_VTK_BLSurfaceType) , DIMENSION(:), ALLOCATABLE :: BladeShape !< AirfoilCoords for each blade [m] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: MorisonVisRad !< radius of each Morison node [m] END TYPE FAST_VTK_SurfaceType @@ -95,12 +108,12 @@ MODULE FAST_Types TYPE, PUBLIC :: FAST_VTK_ModeShapeType CHARACTER(1024) :: CheckpointRoot !< name of the checkpoint file written by FAST when linearization data was produced [-] CHARACTER(1024) :: MatlabFileName !< name of the file with eigenvectors written by Matlab [-] - INTEGER(IntKi) :: VTKLinModes !< Number of modes to visualize [-] + INTEGER(IntKi) :: VTKLinModes = 0_IntKi !< Number of modes to visualize [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: VTKModes !< Which modes to visualize [-] - INTEGER(IntKi) :: VTKLinTim !< Switch to make one animation for all LinTimes together (1) or separate animations for each LinTimes(2) [-] - INTEGER(IntKi) :: VTKNLinTimes !< number of linearization times to use when VTKLinTim==2 [-] - REAL(ReKi) :: VTKLinScale !< Mode shape visualization scaling factor [-] - REAL(ReKi) :: VTKLinPhase !< Phase when making one animation for all LinTimes together (used only when VTKLinTim=1) [-] + INTEGER(IntKi) :: VTKLinTim = 0_IntKi !< Switch to make one animation for all LinTimes together (1) or separate animations for each LinTimes(2) [-] + INTEGER(IntKi) :: VTKNLinTimes = 0_IntKi !< number of linearization times to use when VTKLinTim==2 [-] + REAL(ReKi) :: VTKLinScale = 0.0_ReKi !< Mode shape visualization scaling factor [-] + REAL(ReKi) :: VTKLinPhase = 0.0_ReKi !< Phase when making one animation for all LinTimes together (used only when VTKLinTim=1) [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: DampingRatio !< damping ratios from mbc3 analysis [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: NaturalFreq_Hz !< natural frequency from mbc3 analysis [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: DampedFreq_Hz !< damped frequency from mbc3 analysis [-] @@ -108,99 +121,120 @@ MODULE FAST_Types REAL(R8Ki) , DIMENSION(:,:,:), ALLOCATABLE :: x_eig_phase !< phase of eigenvector (dimension 1=state, dim 2= azimuth, dim 3 = mode) [-] END TYPE FAST_VTK_ModeShapeType ! ======================= +! ========= FAST_SS_CaseType ======= + TYPE, PUBLIC :: FAST_SS_CaseType + REAL(ReKi) :: RotSpeed = 0.0_ReKi !< Rotor speed for this case of the steady-state solve [>0] [(rad/s)] + REAL(ReKi) :: TSR = 0.0_ReKi !< TSR for this case of the steady-state solve [>0] [(-)] + REAL(ReKi) :: WindSpeed = 0.0_ReKi !< Windspeed for this case of the steady-state solve [>0] [(m/s)] + REAL(ReKi) :: Pitch = 0.0_ReKi !< Pitch angle for this case of the steady-state solve [(rad)] + END TYPE FAST_SS_CaseType +! ======================= ! ========= FAST_ParameterType ======= TYPE, PUBLIC :: FAST_ParameterType - REAL(DbKi) :: DT !< Integration time step [global time] [s] - REAL(DbKi) , DIMENSION(NumModules) :: DT_module !< Integration time step [global time] [s] - INTEGER(IntKi) , DIMENSION(NumModules) :: n_substeps !< The number of module substeps for advancing states from t_global to t_global_next [-] - INTEGER(IntKi) :: n_TMax_m1 !< The time step of TMax - dt (the end time of the simulation) [(-)] - REAL(DbKi) :: TMax !< Total run time [s] - INTEGER(IntKi) :: InterpOrder !< Interpolation order {0,1,2} [-] - INTEGER(IntKi) :: NumCrctn !< Number of correction iterations [-] - INTEGER(IntKi) :: KMax !< Maximum number of input-output-solve iterations (KMax >= 1) [-] - INTEGER(IntKi) :: numIceLegs !< number of suport-structure legs in contact with ice (IceDyn coupling) [-] - INTEGER(IntKi) :: nBeams !< number of BeamDyn instances [-] - LOGICAL :: BD_OutputSibling !< flag to determine if BD input is sibling of output mesh [-] - LOGICAL , DIMENSION(NumModules) :: ModuleInitialized !< An array determining if the module has been initialized [-] - REAL(DbKi) :: DT_Ujac !< Time between when we need to re-calculate these Jacobians [s] - REAL(ReKi) :: UJacSclFact !< Scaling factor used to get similar magnitudes between accelerations, forces, and moments in Jacobians [-] - INTEGER(IntKi) , DIMENSION(1:9) :: SizeJac_Opt1 !< (1)=size of matrix; (2)=size of ED portion; (3)=size of SD portion [2 meshes]; (4)=size of HD portion; (5)=size of BD portion blade 1; (6)=size of BD portion blade 2; (7)=size of BD portion blade 3; (8)=size of Orca portion; (9)=size of ExtPtfm portion; [-] - INTEGER(IntKi) :: CompElast !< Compute blade loads (switch) {Module_ED; Module_BD} [-] - INTEGER(IntKi) :: CompInflow !< Compute inflow wind conditions (switch) {Module_None; Module_IfW; Module_OpFM} [-] - INTEGER(IntKi) :: CompAero !< Compute aerodynamic loads (switch) {Module_None; Module_AD14; Module_AD} [-] - INTEGER(IntKi) :: CompServo !< Compute control and electrical-drive dynamics (switch) {Module_None; Module_SrvD} [-] - INTEGER(IntKi) :: CompHydro !< Compute hydrodynamic loads (switch) {Module_None; Module_HD} [-] - INTEGER(IntKi) :: CompSub !< Compute sub-structural dynamics (switch) {Module_None; Module_HD} [-] - INTEGER(IntKi) :: CompMooring !< Compute mooring system (switch) {Module_None; Module_MAP; Module_FEAM; Module_MD; Module_Orca} [-] - INTEGER(IntKi) :: CompIce !< Compute ice loading (switch) {Module_None; Module_IceF, Module_IceD} [-] - INTEGER(IntKi) :: MHK !< MHK turbine type (switch) {0=Not an MHK turbine; 1=Fixed MHK turbine; 2=Floating MHK turbine} [-] - LOGICAL :: UseDWM !< Use the DWM module in AeroDyn [-] - LOGICAL :: Linearize !< Linearization analysis (flag) [-] - INTEGER(IntKi) :: WaveFieldMod !< Wave field handling (-) (switch) 0: use individual HydroDyn inputs without adjustment, 1: adjust wave phases based on turbine offsets from farm origin [-] + REAL(DbKi) :: DT = 0.0_R8Ki !< Integration time step [global time] [s] + REAL(DbKi) , DIMENSION(1:NumModules) :: DT_module = 0.0_R8Ki !< Integration time step [global time] [s] + INTEGER(IntKi) , DIMENSION(1:NumModules) :: n_substeps = 0_IntKi !< The number of module substeps for advancing states from t_global to t_global_next [-] + INTEGER(IntKi) :: n_TMax_m1 = 0_IntKi !< The time step of TMax - dt (the end time of the simulation) [(-)] + REAL(DbKi) :: TMax = 0.0_R8Ki !< Total run time [s] + INTEGER(IntKi) :: InterpOrder = 0_IntKi !< Interpolation order {0,1,2} [-] + INTEGER(IntKi) :: NumCrctn = 0_IntKi !< Number of correction iterations [-] + INTEGER(IntKi) :: KMax = 0_IntKi !< Maximum number of input-output-solve or nonlinear solve residual equation iterations (KMax >= 1) [>0] [-] + INTEGER(IntKi) :: numIceLegs = 0_IntKi !< number of suport-structure legs in contact with ice (IceDyn coupling) [-] + INTEGER(IntKi) :: nBeams = 0_IntKi !< number of BeamDyn instances [-] + LOGICAL :: BD_OutputSibling = .false. !< flag to determine if BD input is sibling of output mesh [-] + LOGICAL , DIMENSION(1:NumModules) :: ModuleInitialized = .false. !< An array determining if the module has been initialized [-] + REAL(DbKi) :: DT_Ujac = 0.0_R8Ki !< Time between when we need to re-calculate these Jacobians [s] + REAL(ReKi) :: UJacSclFact = 0.0_ReKi !< Scaling factor used to get similar magnitudes between accelerations, forces, and moments in Jacobians [-] + INTEGER(IntKi) , DIMENSION(1:9) :: SizeJac_Opt1 = 0_IntKi !< (1)=size of matrix; (2)=size of ED portion; (3)=size of SD portion [2 meshes]; (4)=size of HD portion; (5)=size of BD portion blade 1; (6)=size of BD portion blade 2; (7)=size of BD portion blade 3; (8)=size of Orca portion; (9)=size of ExtPtfm portion; [-] + INTEGER(IntKi) :: SolveOption = 0_IntKi !< Switch to determine which solve option we are going to use (see Solve_FullOpt1, etc) [-] + INTEGER(IntKi) :: CompElast = 0_IntKi !< Compute blade loads (switch) {Module_ED; Module_BD; Module_SED} [-] + INTEGER(IntKi) :: CompInflow = 0_IntKi !< Compute inflow wind conditions (switch) {Module_None; Module_IfW; Module_ExtInfw} [-] + INTEGER(IntKi) :: CompAero = 0_IntKi !< Compute aerodynamic loads (switch) {Module_None; Module_ADsk; Module_AD} [-] + INTEGER(IntKi) :: CompServo = 0_IntKi !< Compute control and electrical-drive dynamics (switch) {Module_None; Module_SrvD} [-] + INTEGER(IntKi) :: CompSeaSt = 0_IntKi !< Compute sea states; wave kinematics (switch) {Module_None; Module_SeaSt} [-] + INTEGER(IntKi) :: CompHydro = 0_IntKi !< Compute hydrodynamic loads (switch) {Module_None; Module_HD} [-] + INTEGER(IntKi) :: CompSub = 0_IntKi !< Compute sub-structural dynamics (switch) {Module_None; Module_SD, Module_ExtPtfm} [-] + INTEGER(IntKi) :: CompMooring = 0_IntKi !< Compute mooring system (switch) {Module_None; Module_MAP; Module_FEAM; Module_MD; Module_Orca} [-] + INTEGER(IntKi) :: CompIce = 0_IntKi !< Compute ice loading (switch) {Module_None; Module_IceF, Module_IceD} [-] + INTEGER(IntKi) :: MHK = 0_IntKi !< MHK turbine type (switch) {0=Not an MHK turbine; 1=Fixed MHK turbine; 2=Floating MHK turbine} [-] + LOGICAL :: UseDWM = .false. !< Use the DWM module in AeroDyn [-] + LOGICAL :: Linearize = .false. !< Linearization analysis (flag) [-] + INTEGER(IntKi) :: WaveFieldMod = 0_IntKi !< Wave field handling (-) (switch) 0: use individual HydroDyn inputs without adjustment, 1: adjust wave phases based on turbine offsets from farm origin [-] LOGICAL :: FarmIntegration = .false. !< whether this is called from FAST.Farm (or another program that doesn't want FAST to call all of the init stuff first) [-] - REAL(SiKi) , DIMENSION(1:3) :: TurbinePos !< Initial position of turbine base (origin used for graphics) [m] - REAL(ReKi) :: Gravity !< Gravitational acceleration [m/s^2] - REAL(ReKi) :: AirDens !< Air density [kg/m^3] - REAL(ReKi) :: WtrDens !< Water density [kg/m^3] - REAL(ReKi) :: KinVisc !< Kinematic viscosity of working fluid [m^2/s] - REAL(ReKi) :: SpdSound !< Speed of sound in working fluid [m/s] - REAL(ReKi) :: Patm !< Atmospheric pressure [Pa] - REAL(ReKi) :: Pvap !< Vapour pressure of working fluid [Pa] - REAL(ReKi) :: WtrDpth !< Water depth [m] - REAL(ReKi) :: MSL2SWL !< Offset between still-water level and mean sea level [m] - CHARACTER(1024) :: EDFile !< The name of the ElastoDyn input file [-] - CHARACTER(1024) , DIMENSION(MaxNBlades) :: BDBldFile !< Name of files containing BeamDyn inputs for each blade [-] + REAL(SiKi) , DIMENSION(1:3) :: TurbinePos = 0.0_R4Ki !< Initial position of turbine base (origin used for graphics) [m] + REAL(ReKi) :: Gravity = 0.0_ReKi !< Gravitational acceleration [m/s^2] + REAL(ReKi) :: AirDens = 0.0_ReKi !< Air density [kg/m^3] + REAL(ReKi) :: WtrDens = 0.0_ReKi !< Water density [kg/m^3] + REAL(ReKi) :: KinVisc = 0.0_ReKi !< Kinematic viscosity of working fluid [m^2/s] + REAL(ReKi) :: SpdSound = 0.0_ReKi !< Speed of sound in working fluid [m/s] + REAL(ReKi) :: Patm = 0.0_ReKi !< Atmospheric pressure [Pa] + REAL(ReKi) :: Pvap = 0.0_ReKi !< Vapour pressure of working fluid [Pa] + REAL(ReKi) :: WtrDpth = 0.0_ReKi !< Water depth [m] + REAL(ReKi) :: MSL2SWL = 0.0_ReKi !< Offset between still-water level and mean sea level [m] + CHARACTER(1024) :: EDFile !< The name of the ElastoDyn/Simplified-ElastoDyn input file [-] + CHARACTER(1024) , DIMENSION(1:MaxNBlades) :: BDBldFile !< Name of files containing BeamDyn inputs for each blade [-] CHARACTER(1024) :: InflowFile !< Name of file containing inflow wind input parameters [-] CHARACTER(1024) :: AeroFile !< Name of file containing aerodynamic input parameters [-] CHARACTER(1024) :: ServoFile !< Name of file containing control and electrical-drive input parameters [-] + CHARACTER(1024) :: SeaStFile !< Name of file containing sea state input parameters [-] CHARACTER(1024) :: HydroFile !< Name of file containing hydrodynamic input parameters [-] CHARACTER(1024) :: SubFile !< Name of file containing sub-structural input parameters [-] CHARACTER(1024) :: MooringFile !< Name of file containing mooring system input parameters [-] CHARACTER(1024) :: IceFile !< Name of file containing ice loading input parameters [-] - REAL(DbKi) :: TStart !< Time to begin tabular output [s] - REAL(DbKi) :: DT_Out !< Time step for tabular output [s] - LOGICAL :: WrSttsTime !< Whether we should write the status times to the screen [-] - INTEGER(IntKi) :: n_SttsTime !< Number of time steps between screen status messages [-] - INTEGER(IntKi) :: n_ChkptTime !< Number of time steps between writing checkpoint files [-] - INTEGER(IntKi) :: n_DT_Out !< Number of time steps between writing a line in the time-marching output files [-] - INTEGER(IntKi) :: n_VTKTime !< Number of time steps between writing VTK files [-] - INTEGER(IntKi) :: TurbineType !< Type_LandBased, Type_Offshore_Fixed, Type_Offshore_Floating, Type_MHK_Fixed, or Type_MHK_Floating [-] - LOGICAL :: WrBinOutFile !< Write a binary output file? (.outb) [-] - LOGICAL :: WrTxtOutFile !< Write a text (formatted) output file? (.out) [-] - INTEGER(IntKi) :: WrBinMod !< If writing binary, which file format is to be written [1, 2, or 3] [-] - LOGICAL :: SumPrint !< Print summary data to file? (.sum) [-] + REAL(DbKi) :: TStart = 0.0_R8Ki !< Time to begin tabular output [s] + REAL(DbKi) :: DT_Out = 0.0_R8Ki !< Time step for tabular output [s] + LOGICAL :: WrSttsTime = .false. !< Whether we should write the status times to the screen [-] + INTEGER(IntKi) :: n_SttsTime = 0_IntKi !< Number of time steps between screen status messages [-] + INTEGER(IntKi) :: n_ChkptTime = 0_IntKi !< Number of time steps between writing checkpoint files [-] + INTEGER(IntKi) :: n_DT_Out = 0_IntKi !< Number of time steps between writing a line in the time-marching output files [-] + INTEGER(IntKi) :: n_VTKTime = 0_IntKi !< Number of time steps between writing VTK files [-] + LOGICAL :: WrBinOutFile = .false. !< Write a binary output file? (.outb) [-] + LOGICAL :: WrTxtOutFile = .false. !< Write a text (formatted) output file? (.out) [-] + INTEGER(IntKi) :: WrBinMod = 0_IntKi !< If writing binary, which file format is to be written [1, 2, or 3] [-] + LOGICAL :: SumPrint = .false. !< Print summary data to file? (.sum) [-] INTEGER(IntKi) :: WrVTK = 0 !< VTK Visualization data output: (switch) {0=none; 1=initialization data only; 2=animation} [-] - INTEGER(IntKi) :: VTK_Type !< Type of VTK visualization data: (switch) {1=surfaces; 2=basic meshes (lines/points); 3=all meshes (debug)} [-] - LOGICAL :: VTK_fields !< Write mesh fields to VTK data files? (flag) {true/false} [-] + INTEGER(IntKi) :: VTK_Type = 0_IntKi !< Type of VTK visualization data: (switch) {1=surfaces; 2=basic meshes (lines/points); 3=all meshes (debug)} [-] + LOGICAL :: VTK_fields = .false. !< Write mesh fields to VTK data files? (flag) {true/false} [-] CHARACTER(1) :: Delim !< Delimiter between columns of text output file (.out): space or tab [-] CHARACTER(20) :: OutFmt !< Format used for text tabular output (except time); resulting field should be 10 characters [-] CHARACTER(20) :: OutFmt_t !< Format used for time channel in text tabular output; resulting field should be 10 characters [-] - INTEGER(IntKi) :: FmtWidth !< width of the time OutFmt specifier [-] - INTEGER(IntKi) :: TChanLen !< width of the time channel [-] + INTEGER(IntKi) :: FmtWidth = 0_IntKi !< width of the time OutFmt specifier [-] + INTEGER(IntKi) :: TChanLen = 0_IntKi !< width of the time channel [-] CHARACTER(1024) :: OutFileRoot !< The rootname of the output files [-] CHARACTER(1024) :: FTitle !< The description line from the FAST (glue-code) input file [-] CHARACTER(1024) :: VTK_OutFileRoot = '' !< The rootname of the VTK output files [-] - INTEGER(IntKi) :: VTK_tWidth !< Width of number of files for leading zeros in file name format [-] - REAL(DbKi) :: VTK_fps !< number of frames per second to output VTK data [-] + INTEGER(IntKi) :: VTK_tWidth = 0_IntKi !< Width of number of files for leading zeros in file name format [-] + REAL(DbKi) :: VTK_fps = 0.0_R8Ki !< number of frames per second to output VTK data [-] TYPE(FAST_VTK_SurfaceType) :: VTK_surface !< Data for VTK surface visualization [-] CHARACTER(4) :: Tdesc !< description of turbine ID (for FAST.Farm) screen printing [-] - LOGICAL :: CalcSteady !< Calculate a steady-state periodic operating point before linearization [unused if Linearize=False] [-] - INTEGER(IntKi) :: TrimCase !< Controller parameter to be trimmed {1:yaw; 2:torque; 3:pitch} [unused if Linearize=False; used only if CalcSteady=True] [-] - REAL(ReKi) :: TrimTol !< Tolerance for the rotational speed convergence (>0) [unused if Linearize=False; used only if CalcSteady=True] [-] - REAL(ReKi) :: TrimGain !< Proportional gain for the rotational speed error (>0) [unused if Linearize=False; used only if CalcSteady=True] [rad/(rad/s) for yaw or pitch; Nm/(rad/s) for torque] - REAL(ReKi) :: Twr_Kdmp !< Damping factor for the tower [unused if Linearize=False; used only if CalcSteady=True] [N/(m/s)] - REAL(ReKi) :: Bld_Kdmp !< Damping factor for the blades [unused if Linearize=False; used only if CalcSteady=True] [N/(m/s)] - INTEGER(IntKi) :: NLinTimes !< Number of LinTimes, or equally-spaced azimuth steps in periodic linearized model (>0)[unused if Linearize=False] [-] - REAL(DbKi) :: AzimDelta !< difference between two consecutive azimuth positions in CalcSteady algorithm [rad] - INTEGER(IntKi) :: LinInputs !< Inputs included in linearization (switch) {0=none; 1=standard; 2=all module inputs (debug)} [unused if Linearize=False] [-] - INTEGER(IntKi) :: LinOutputs !< Outputs included in linearization (switch) {0=none; 1=from OutList(s); 2=all module outputs (debug)} [unused if Linearize=False] [-] - LOGICAL :: LinOutJac !< Include full Jacabians in linearization output (for debug) (flag) [unused if Linearize=False; used only if LinInputs=LinOutputs=2] [-] - LOGICAL :: LinOutMod !< Write module-level linearization output files in addition to output for full system? (flag) [unused if Linearize=False] [-] + LOGICAL :: CalcSteady = .false. !< Calculate a steady-state periodic operating point before linearization [unused if Linearize=False] [-] + INTEGER(IntKi) :: TrimCase = 0_IntKi !< Controller parameter to be trimmed {1:yaw; 2:torque; 3:pitch} [unused if Linearize=False; used only if CalcSteady=True] [-] + REAL(ReKi) :: TrimTol = 0.0_ReKi !< Tolerance for the rotational speed convergence (>0) [unused if Linearize=False; used only if CalcSteady=True] [-] + REAL(ReKi) :: TrimGain = 0.0_ReKi !< Proportional gain for the rotational speed error (>0) [unused if Linearize=False; used only if CalcSteady=True] [rad/(rad/s) for yaw or pitch; Nm/(rad/s) for torque] + REAL(ReKi) :: Twr_Kdmp = 0.0_ReKi !< Damping factor for the tower [unused if Linearize=False; used only if CalcSteady=True] [N/(m/s)] + REAL(ReKi) :: Bld_Kdmp = 0.0_ReKi !< Damping factor for the blades [unused if Linearize=False; used only if CalcSteady=True] [N/(m/s)] + INTEGER(IntKi) :: NLinTimes = 0_IntKi !< Number of LinTimes, or equally-spaced azimuth steps in periodic linearized model (>0)[unused if Linearize=False] [-] + REAL(DbKi) :: AzimDelta = 0.0_R8Ki !< difference between two consecutive azimuth positions in CalcSteady algorithm [rad] + INTEGER(IntKi) :: LinInputs = 0_IntKi !< Inputs included in linearization (switch) {0=none; 1=standard; 2=all module inputs (debug)} [unused if Linearize=False] [-] + INTEGER(IntKi) :: LinOutputs = 0_IntKi !< Outputs included in linearization (switch) {0=none; 1=from OutList(s); 2=all module outputs (debug)} [unused if Linearize=False] [-] + LOGICAL :: LinOutJac = .false. !< Include full Jacabians in linearization output (for debug) (flag) [unused if Linearize=False; used only if LinInputs=LinOutputs=2] [-] + LOGICAL :: LinOutMod = .false. !< Write module-level linearization output files in addition to output for full system? (flag) [unused if Linearize=False] [-] TYPE(FAST_VTK_ModeShapeType) :: VTK_modes !< Data for VTK mode-shape visualization [-] - LOGICAL :: UseSC !< Use Supercontroller [-] - INTEGER(IntKi) :: Lin_NumMods !< number of modules in the linearization [-] - INTEGER(IntKi) , DIMENSION(NumModules) :: Lin_ModOrder !< indices that determine which order the modules are in the glue-code linearization matrix [-] - INTEGER(IntKi) :: LinInterpOrder !< Interpolation order for CalcSteady solution [-] + LOGICAL :: UseSC = .false. !< Use Supercontroller [-] + INTEGER(IntKi) :: Lin_NumMods = 0_IntKi !< number of modules in the linearization [-] + INTEGER(IntKi) , DIMENSION(1:NumModules) :: Lin_ModOrder = 0_IntKi !< indices that determine which order the modules are in the glue-code linearization matrix [-] + INTEGER(IntKi) :: LinInterpOrder = 0_IntKi !< Interpolation order for CalcSteady solution [-] + LOGICAL :: CompAeroMaps = .false. !< Flag to determine if we are calculating aero maps [-] + INTEGER(IntKi) :: N_UJac = 0_IntKi !< Number of iterations between re-calculating Jacobian [(-)] + INTEGER(IntKi) :: NumBl_Lin = 0_IntKi !< number of blades in the jacobian [-] + REAL(R8Ki) :: tolerSquared = 0.0_R8Ki !< Convergence tolerance for nonlinear solve residual equation [>0] squared [(-)] + INTEGER(IntKi) :: NumSSCases = 0_IntKi !< Number of cases for steady-state solver generation [>0] [(-)] + INTEGER(IntKi) :: WindSpeedOrTSR = 0_IntKi !< Choice of swept parameter (switch) { 1:wind speed; 2: TSR } [(-)] + REAL(ReKi) :: RotSpeedInit = 0.0_ReKi !< Initial rotor speed for steady-state solve [>0] [(rad/s)] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: RotSpeed !< List of rotor speeds for steady-state solve [>0] [(rad/s)] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: WS_TSR !< List of WindSpeed or TSRs (depending on WindSpeedOrTSR setting) for aeromap generation [(m/s or -)] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Pitch !< List of pitch angles for aeromap generation [(rad)] + INTEGER(IntKi) :: GearBox_index = 0_IntKi !< Index to gearbox rotation in state array (for steady-state calculations) [-] END TYPE FAST_ParameterType ! ======================= ! ========= FAST_LinStateSave ======= @@ -250,6 +284,11 @@ MODULE FAST_Types TYPE(HydroDyn_ConstraintStateType) , DIMENSION(:), ALLOCATABLE :: z_HD !< Constraint states [-] TYPE(HydroDyn_OtherStateType) , DIMENSION(:), ALLOCATABLE :: OtherSt_HD !< Other states [-] TYPE(HydroDyn_InputType) , DIMENSION(:), ALLOCATABLE :: u_HD !< System inputs [-] + TYPE(SeaSt_ContinuousStateType) , DIMENSION(:), ALLOCATABLE :: x_SeaSt !< Continuous states [-] + TYPE(SeaSt_DiscreteStateType) , DIMENSION(:), ALLOCATABLE :: xd_SeaSt !< Discrete states [-] + TYPE(SeaSt_ConstraintStateType) , DIMENSION(:), ALLOCATABLE :: z_SeaSt !< Constraint states [-] + TYPE(SeaSt_OtherStateType) , DIMENSION(:), ALLOCATABLE :: OtherSt_SeaSt !< Other states [-] + TYPE(SeaSt_InputType) , DIMENSION(:), ALLOCATABLE :: u_SeaSt !< System inputs [-] TYPE(IceFloe_ContinuousStateType) , DIMENSION(:), ALLOCATABLE :: x_IceF !< Continuous states [-] TYPE(IceFloe_DiscreteStateType) , DIMENSION(:), ALLOCATABLE :: xd_IceF !< Discrete states [-] TYPE(IceFloe_ConstraintStateType) , DIMENSION(:), ALLOCATABLE :: z_IceF !< Constraint states [-] @@ -301,9 +340,9 @@ MODULE FAST_Types LOGICAL , DIMENSION(:), ALLOCATABLE :: RotFrame_x !< Whether corresponding continuous state is in rotating frame [-] LOGICAL , DIMENSION(:), ALLOCATABLE :: RotFrame_z !< Whether corresponding constraint state is in rotating frame [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: DerivOrder_x !< Derivative order for continuous states [-] - INTEGER(IntKi) , DIMENSION(1:3) :: SizeLin !< sizes of (1) the module's inputs, (2) the module's linearized outputs, and (3) the module's continuous states [-] - INTEGER(IntKi) , DIMENSION(1:3) :: LinStartIndx !< the starting index in combined matrices of (1) the module's inputs, (2) the module's linearized outputs, and (3) the module's continuous states [-] - INTEGER(IntKi) :: NumOutputs !< number of WriteOutputs in each linearized module [-] + INTEGER(IntKi) , DIMENSION(1:3) :: SizeLin = 0_IntKi !< sizes of (1) the module's inputs, (2) the module's linearized outputs, and (3) the module's continuous states [-] + INTEGER(IntKi) , DIMENSION(1:3) :: LinStartIndx = 0_IntKi !< the starting index in combined matrices of (1) the module's inputs, (2) the module's linearized outputs, and (3) the module's continuous states [-] + INTEGER(IntKi) :: NumOutputs = 0_IntKi !< number of WriteOutputs in each linearized module [-] END TYPE FAST_LinType ! ======================= ! ========= FAST_ModLinType ======= @@ -313,24 +352,24 @@ MODULE FAST_Types ! ======================= ! ========= FAST_LinFileType ======= TYPE, PUBLIC :: FAST_LinFileType - TYPE(FAST_ModLinType) , DIMENSION(NumModules) :: Modules !< Linearization data for each module [-] + TYPE(FAST_ModLinType) , DIMENSION(1:NumModules) :: Modules !< Linearization data for each module [-] TYPE(FAST_LinType) :: Glue !< Linearization data for the glue code (coupled system) [-] - REAL(ReKi) :: RotSpeed !< Rotor azimuth angular speed [rad/s] - REAL(ReKi) :: Azimuth !< Rotor azimuth position [rad] - REAL(ReKi) :: WindSpeed !< Wind speed at reference height [m/s] + REAL(ReKi) :: RotSpeed = 0.0_ReKi !< Rotor azimuth angular speed [rad/s] + REAL(ReKi) :: Azimuth = 0.0_ReKi !< Rotor azimuth position [rad] + REAL(ReKi) :: WindSpeed = 0.0_ReKi !< Wind speed at reference height [m/s] END TYPE FAST_LinFileType ! ======================= ! ========= FAST_MiscLinType ======= TYPE, PUBLIC :: FAST_MiscLinType REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: LinTimes !< List of times at which to linearize [s] - INTEGER(IntKi) :: CopyOP_CtrlCode !< mesh control code for copy type (new on first call; update otherwise) [-] + INTEGER(IntKi) :: CopyOP_CtrlCode = 0_IntKi !< mesh control code for copy type (new on first call; update otherwise) [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: AzimTarget !< target azimuth positions in CalcSteady algorithm [rad] - LOGICAL :: IsConverged !< whether the error calculation in the CalcSteady algorithm is converged [-] - LOGICAL :: FoundSteady !< whether the CalcSteady algorithm found a steady-state solution [-] - LOGICAL :: ForceLin !< whether the CalcSteady algorithm found a steady-state solution [-] - INTEGER(IntKi) :: n_rot !< number of rotations completed in CalcSteady algorithm [-] - INTEGER(IntKi) :: AzimIndx !< index into target azimuth array in CalcSteady algorithm [-] - INTEGER(IntKi) :: NextLinTimeIndx !< index for next time in LinTimes where linearization should occur [-] + LOGICAL :: IsConverged = .false. !< whether the error calculation in the CalcSteady algorithm is converged [-] + LOGICAL :: FoundSteady = .false. !< whether the CalcSteady algorithm found a steady-state solution [-] + LOGICAL :: ForceLin = .false. !< whether the CalcSteady algorithm found a steady-state solution [-] + INTEGER(IntKi) :: n_rot = 0_IntKi !< number of rotations completed in CalcSteady algorithm [-] + INTEGER(IntKi) :: AzimIndx = 0_IntKi !< index into target azimuth array in CalcSteady algorithm [-] + INTEGER(IntKi) :: NextLinTimeIndx = 0_IntKi !< index for next time in LinTimes where linearization should occur [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: Psi !< Azimuth angle at the current and previous time steps (uses LinInterpOrder); DbKi so that we can use registry-generated extrap/interp routines [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: y_interp !< Interpolated outputs packed into an array [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: y_ref !< Reference output range for CalcSteady error calculation [-] @@ -341,25 +380,24 @@ MODULE FAST_Types TYPE, PUBLIC :: FAST_OutputFileType REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: TimeData !< Array to contain the time output data for the binary file (first output time and a time [fixed] increment) [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: AllOutData !< Array to contain all the output data (time history of all outputs); Index 1 is NumOuts, Index 2 is Time step [-] - INTEGER(IntKi) :: n_Out !< Time index into the AllOutData array [-] - INTEGER(IntKi) :: NOutSteps !< Maximum number of output steps [-] - INTEGER(IntKi) , DIMENSION(NumModules) :: numOuts !< number of outputs to print from each module [-] + INTEGER(IntKi) :: n_Out = 0_IntKi !< Time index into the AllOutData array [-] + INTEGER(IntKi) :: NOutSteps = 0_IntKi !< Maximum number of output steps [-] + INTEGER(IntKi) , DIMENSION(1:NumModules) :: numOuts = 0_IntKi !< number of outputs to print from each module [-] INTEGER(IntKi) :: UnOu = -1 !< I/O unit number for the tabular output file [-] INTEGER(IntKi) :: UnSum = -1 !< I/O unit number for the summary file [-] INTEGER(IntKi) :: UnGra = -1 !< I/O unit number for mesh graphics [-] CHARACTER(1024) , DIMENSION(1:3) :: FileDescLines !< Description lines to include in output files (header, time run, plus module names/versions) [-] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: ChannelNames !< Names of the output channels [-] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: ChannelUnits !< Units for the output channels [-] - TYPE(ProgDesc) , DIMENSION(NumModules) :: Module_Ver !< version information from all modules [-] - CHARACTER(ChanLen) , DIMENSION(NumModules) :: Module_Abrev !< abbreviation for module (used in file output naming conventions) [-] - LOGICAL :: WriteThisStep !< Whether this step will be written in the FAST output files [-] - INTEGER(IntKi) :: VTK_count !< Number of VTK files written (for naming output files) [-] - INTEGER(IntKi) :: VTK_LastWaveIndx !< last index into wave array [-] + TYPE(ProgDesc) , DIMENSION(1:NumModules) :: Module_Ver !< version information from all modules [-] + CHARACTER(ChanLen) , DIMENSION(1:NumModules) :: Module_Abrev !< abbreviation for module (used in file output naming conventions) [-] + LOGICAL :: WriteThisStep = .false. !< Whether this step will be written in the FAST output files [-] + INTEGER(IntKi) :: VTK_count = 0_IntKi !< Number of VTK files written (for naming output files) [-] + INTEGER(IntKi) :: VTK_LastWaveIndx = 0_IntKi !< last index into wave array [-] TYPE(FAST_LinFileType) :: Lin !< linearization data for output [-] - INTEGER(IntKi) :: ActualChanLen !< width of the column headers output in the text and/or binary file [-] - CHARACTER(30) :: OutFmt_a !< Format used for text tabular output (except time); combines OutFmt with delim and appropriate spaces [-] + INTEGER(IntKi) :: ActualChanLen = 0_IntKi !< width of the column headers output in the text and/or binary file [-] TYPE(FAST_LinStateSave) :: op !< operating points of states and inputs for VTK output of mode shapes [-] - REAL(ReKi) , DIMENSION(1:5) :: DriverWriteOutput !< pitch and tsr for current aero map case, plus error, number of iterations, wind speed [-] + REAL(ReKi) , DIMENSION(1:6) :: DriverWriteOutput = 0.0_ReKi !< pitch and tsr for current aero map case, plus error, number of iterations, wind speed, rotor speed [-] END TYPE FAST_OutputFileType ! ======================= ! ========= IceDyn_Data ======= @@ -373,7 +411,9 @@ MODULE FAST_Types TYPE(IceD_OutputType) , DIMENSION(:), ALLOCATABLE :: y !< System outputs [-] TYPE(IceD_MiscVarType) , DIMENSION(:), ALLOCATABLE :: m !< Misc/optimization variables [-] TYPE(IceD_InputType) , DIMENSION(:,:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] + TYPE(IceD_InputType) , DIMENSION(:,:), ALLOCATABLE :: Input_Saved !< Backup Array of inputs associated with InputTimes [-] REAL(DbKi) , DIMENSION(:,:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] + REAL(DbKi) , DIMENSION(:,:), ALLOCATABLE :: InputTimes_Saved !< Backup Array of times associated with Input Array [-] END TYPE IceDyn_Data ! ======================= ! ========= BeamDyn_Data ======= @@ -389,61 +429,71 @@ MODULE FAST_Types TYPE(BD_OutputType) , DIMENSION(:,:), ALLOCATABLE :: Output !< Array of outputs associated with CalcSteady Azimuths [-] TYPE(BD_OutputType) , DIMENSION(:), ALLOCATABLE :: y_interp !< interpolated system outputs for CalcSteady [-] TYPE(BD_InputType) , DIMENSION(:,:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] + TYPE(BD_InputType) , DIMENSION(:,:), ALLOCATABLE :: Input_Saved !< Backup Array of inputs associated with InputTimes [-] REAL(DbKi) , DIMENSION(:,:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] + REAL(DbKi) , DIMENSION(:,:), ALLOCATABLE :: InputTimes_Saved !< Backup Array of times associated with Input Array [-] END TYPE BeamDyn_Data ! ======================= ! ========= ElastoDyn_Data ======= TYPE, PUBLIC :: ElastoDyn_Data - TYPE(ED_ContinuousStateType) , DIMENSION(1:2) :: x !< Continuous states [-] - TYPE(ED_DiscreteStateType) , DIMENSION(1:2) :: xd !< Discrete states [-] - TYPE(ED_ConstraintStateType) , DIMENSION(1:2) :: z !< Constraint states [-] - TYPE(ED_OtherStateType) , DIMENSION(1:2) :: OtherSt !< Other states [-] + TYPE(ED_ContinuousStateType) , DIMENSION(1:NumStateTimes) :: x !< Continuous states [-] + TYPE(ED_DiscreteStateType) , DIMENSION(1:NumStateTimes) :: xd !< Discrete states [-] + TYPE(ED_ConstraintStateType) , DIMENSION(1:NumStateTimes) :: z !< Constraint states [-] + TYPE(ED_OtherStateType) , DIMENSION(1:NumStateTimes) :: OtherSt !< Other states [-] TYPE(ED_ParameterType) :: p !< Parameters [-] TYPE(ED_InputType) :: u !< System inputs [-] TYPE(ED_OutputType) :: y !< System outputs [-] TYPE(ED_MiscVarType) :: m !< Misc (optimization) variables not associated with time [-] TYPE(ED_OutputType) , DIMENSION(:), ALLOCATABLE :: Output !< Array of outputs associated with CalcSteady Azimuths [-] + TYPE(ED_OutputType) , DIMENSION(:), ALLOCATABLE :: Output_bak !< Backup Array of outputs associated with InputTimes [-] TYPE(ED_OutputType) :: y_interp !< interpolated system outputs for CalcSteady [-] TYPE(ED_InputType) , DIMENSION(:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] + TYPE(ED_InputType) , DIMENSION(:), ALLOCATABLE :: Input_Saved !< Backup Array of inputs associated with InputTimes [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] + REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes_Saved !< Backup Array of times associated with Input Array [-] END TYPE ElastoDyn_Data ! ======================= +! ========= SED_Data ======= + TYPE, PUBLIC :: SED_Data + TYPE(SED_ContinuousStateType) , DIMENSION(1:2) :: x !< Continuous states [-] + TYPE(SED_DiscreteStateType) , DIMENSION(1:2) :: xd !< Discrete states [-] + TYPE(SED_ConstraintStateType) , DIMENSION(1:2) :: z !< Constraint states [-] + TYPE(SED_OtherStateType) , DIMENSION(1:2) :: OtherSt !< Other states [-] + TYPE(SED_ParameterType) :: p !< Parameters [-] + TYPE(SED_InputType) :: u !< System inputs [-] + TYPE(SED_OutputType) :: y !< System outputs [-] + TYPE(SED_MiscVarType) :: m !< Misc (optimization) variables not associated with time [-] + TYPE(SED_OutputType) , DIMENSION(:), ALLOCATABLE :: Output !< Array of outputs associated with CalcSteady Azimuths [-] + TYPE(SED_OutputType) :: y_interp !< interpolated system outputs for CalcSteady [-] + TYPE(SED_InputType) , DIMENSION(:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] + REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] + END TYPE SED_Data +! ======================= ! ========= ServoDyn_Data ======= TYPE, PUBLIC :: ServoDyn_Data - TYPE(SrvD_ContinuousStateType) , DIMENSION(1:2) :: x !< Continuous states [-] - TYPE(SrvD_DiscreteStateType) , DIMENSION(1:2) :: xd !< Discrete states [-] - TYPE(SrvD_ConstraintStateType) , DIMENSION(1:2) :: z !< Constraint states [-] - TYPE(SrvD_OtherStateType) , DIMENSION(1:2) :: OtherSt !< Other states [-] + TYPE(SrvD_ContinuousStateType) , DIMENSION(1:NumStateTimes) :: x !< Continuous states [-] + TYPE(SrvD_DiscreteStateType) , DIMENSION(1:NumStateTimes) :: xd !< Discrete states [-] + TYPE(SrvD_ConstraintStateType) , DIMENSION(1:NumStateTimes) :: z !< Constraint states [-] + TYPE(SrvD_OtherStateType) , DIMENSION(1:NumStateTimes) :: OtherSt !< Other states [-] TYPE(SrvD_ParameterType) :: p !< Parameters [-] TYPE(SrvD_InputType) :: u !< System inputs [-] TYPE(SrvD_OutputType) :: y !< System outputs [-] TYPE(SrvD_MiscVarType) :: m !< Misc (optimization) variables not associated with time [-] + TYPE(SrvD_MiscVarType) :: m_bak !< Backup Misc (optimization) variables not associated with time [-] TYPE(SrvD_OutputType) , DIMENSION(:), ALLOCATABLE :: Output !< Array of outputs associated with CalcSteady Azimuths [-] TYPE(SrvD_OutputType) :: y_interp !< interpolated system outputs for CalcSteady [-] TYPE(SrvD_InputType) , DIMENSION(:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] + TYPE(SrvD_InputType) , DIMENSION(:), ALLOCATABLE :: Input_Saved !< Backup Array of inputs associated with InputTimes [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] + REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes_Saved !< Backup Array of times associated with Input Array [-] END TYPE ServoDyn_Data ! ======================= -! ========= AeroDyn14_Data ======= - TYPE, PUBLIC :: AeroDyn14_Data - TYPE(AD14_ContinuousStateType) , DIMENSION(1:2) :: x !< Continuous states [-] - TYPE(AD14_DiscreteStateType) , DIMENSION(1:2) :: xd !< Discrete states [-] - TYPE(AD14_ConstraintStateType) , DIMENSION(1:2) :: z !< Constraint states [-] - TYPE(AD14_OtherStateType) , DIMENSION(1:2) :: OtherSt !< Other states [-] - TYPE(AD14_ParameterType) :: p !< Parameters [-] - TYPE(AD14_InputType) :: u !< System inputs [-] - TYPE(AD14_OutputType) :: y !< System outputs [-] - TYPE(AD14_MiscVarType) :: m !< Misc/optimization variables [-] - TYPE(AD14_InputType) , DIMENSION(:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] - REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] - END TYPE AeroDyn14_Data -! ======================= ! ========= AeroDyn_Data ======= TYPE, PUBLIC :: AeroDyn_Data - TYPE(AD_ContinuousStateType) , DIMENSION(1:2) :: x !< Continuous states [-] - TYPE(AD_DiscreteStateType) , DIMENSION(1:2) :: xd !< Discrete states [-] - TYPE(AD_ConstraintStateType) , DIMENSION(1:2) :: z !< Constraint states [-] - TYPE(AD_OtherStateType) , DIMENSION(1:2) :: OtherSt !< Other states [-] + TYPE(AD_ContinuousStateType) , DIMENSION(1:NumStateTimes) :: x !< Continuous states [-] + TYPE(AD_DiscreteStateType) , DIMENSION(1:NumStateTimes) :: xd !< Discrete states [-] + TYPE(AD_ConstraintStateType) , DIMENSION(1:NumStateTimes) :: z !< Constraint states [-] + TYPE(AD_OtherStateType) , DIMENSION(1:NumStateTimes) :: OtherSt !< Other states [-] TYPE(AD_ParameterType) :: p !< Parameters [-] TYPE(AD_InputType) :: u !< System inputs [-] TYPE(AD_OutputType) :: y !< System outputs [-] @@ -451,15 +501,46 @@ MODULE FAST_Types TYPE(AD_OutputType) , DIMENSION(:), ALLOCATABLE :: Output !< Array of outputs associated with CalcSteady Azimuths [-] TYPE(AD_OutputType) :: y_interp !< interpolated system outputs for CalcSteady [-] TYPE(AD_InputType) , DIMENSION(:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] + TYPE(AD_InputType) , DIMENSION(:), ALLOCATABLE :: Input_Saved !< Backup Array of inputs associated with InputTimes [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] + REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes_Saved !< Backup Array of times associated with Input Array [-] END TYPE AeroDyn_Data ! ======================= +! ========= ExtLoads_Data ======= + TYPE, PUBLIC :: ExtLoads_Data + TYPE(ExtLd_ContinuousStateType) , DIMENSION(1:NumStateTimes) :: x !< Continuous states [-] + TYPE(ExtLd_DiscreteStateType) , DIMENSION(1:NumStateTimes) :: xd !< Discrete states [-] + TYPE(ExtLd_ConstraintStateType) , DIMENSION(1:NumStateTimes) :: z !< Constraint states [-] + TYPE(ExtLd_OtherStateType) , DIMENSION(1:NumStateTimes) :: OtherSt !< Other states [-] + TYPE(ExtLd_ParameterType) :: p !< Parameters [-] + TYPE(ExtLd_InputType) :: u !< System inputs [-] + TYPE(ExtLd_OutputType) :: y !< System outputs [-] + TYPE(ExtLd_MiscVarType) :: m !< Misc/optimization variables [-] + REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] + END TYPE ExtLoads_Data +! ======================= +! ========= AeroDisk_Data ======= + TYPE, PUBLIC :: AeroDisk_Data + TYPE(ADsk_ContinuousStateType) , DIMENSION(1:2) :: x !< Continuous states [-] + TYPE(ADsk_DiscreteStateType) , DIMENSION(1:2) :: xd !< Discrete states [-] + TYPE(ADsk_ConstraintStateType) , DIMENSION(1:2) :: z !< Constraint states [-] + TYPE(ADsk_OtherStateType) , DIMENSION(1:2) :: OtherSt !< Other states [-] + TYPE(ADsk_ParameterType) :: p !< Parameters [-] + TYPE(ADsk_InputType) :: u !< System inputs [-] + TYPE(ADsk_OutputType) :: y !< System outputs [-] + TYPE(ADsk_MiscVarType) :: m !< Misc/optimization variables [-] + TYPE(ADsk_OutputType) , DIMENSION(:), ALLOCATABLE :: Output !< Array of outputs associated with CalcSteady Azimuths [-] + TYPE(ADsk_OutputType) :: y_interp !< interpolated system outputs for CalcSteady [-] + TYPE(ADsk_InputType) , DIMENSION(:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] + REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] + END TYPE AeroDisk_Data +! ======================= ! ========= InflowWind_Data ======= TYPE, PUBLIC :: InflowWind_Data - TYPE(InflowWind_ContinuousStateType) , DIMENSION(1:2) :: x !< Continuous states [-] - TYPE(InflowWind_DiscreteStateType) , DIMENSION(1:2) :: xd !< Discrete states [-] - TYPE(InflowWind_ConstraintStateType) , DIMENSION(1:2) :: z !< Constraint states [-] - TYPE(InflowWind_OtherStateType) , DIMENSION(1:2) :: OtherSt !< Other states [-] + TYPE(InflowWind_ContinuousStateType) , DIMENSION(1:NumStateTimes) :: x !< Continuous states [-] + TYPE(InflowWind_DiscreteStateType) , DIMENSION(1:NumStateTimes) :: xd !< Discrete states [-] + TYPE(InflowWind_ConstraintStateType) , DIMENSION(1:NumStateTimes) :: z !< Constraint states [-] + TYPE(InflowWind_OtherStateType) , DIMENSION(1:NumStateTimes) :: OtherSt !< Other states [-] TYPE(InflowWind_ParameterType) :: p !< Parameters [-] TYPE(InflowWind_InputType) :: u !< System inputs [-] TYPE(InflowWind_OutputType) :: y !< System outputs [-] @@ -467,16 +548,18 @@ MODULE FAST_Types TYPE(InflowWind_OutputType) , DIMENSION(:), ALLOCATABLE :: Output !< Array of outputs associated with CalcSteady Azimuths [-] TYPE(InflowWind_OutputType) :: y_interp !< interpolated system outputs for CalcSteady [-] TYPE(InflowWind_InputType) , DIMENSION(:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] + TYPE(InflowWind_InputType) , DIMENSION(:), ALLOCATABLE :: Input_Saved !< Backup Array of inputs associated with InputTimes [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] + REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes_Saved !< Backup Array of times associated with Input Array [-] END TYPE InflowWind_Data ! ======================= -! ========= OpenFOAM_Data ======= - TYPE, PUBLIC :: OpenFOAM_Data - TYPE(OpFM_InputType) :: u !< System inputs [-] - TYPE(OpFM_OutputType) :: y !< System outputs [-] - TYPE(OpFM_ParameterType) :: p !< Parameters [-] - TYPE(OpFM_MiscVarType) :: m !< Parameters [-] - END TYPE OpenFOAM_Data +! ========= ExternalInflow_Data ======= + TYPE, PUBLIC :: ExternalInflow_Data + TYPE(ExtInfw_InputType) :: u !< System inputs [-] + TYPE(ExtInfw_OutputType) :: y !< System outputs [-] + TYPE(ExtInfw_ParameterType) :: p !< Parameters [-] + TYPE(ExtInfw_MiscVarType) :: m !< Parameters [-] + END TYPE ExternalInflow_Data ! ======================= ! ========= SCDataEx_Data ======= TYPE, PUBLIC :: SCDataEx_Data @@ -487,40 +570,62 @@ MODULE FAST_Types ! ======================= ! ========= SubDyn_Data ======= TYPE, PUBLIC :: SubDyn_Data - TYPE(SD_ContinuousStateType) , DIMENSION(1:2) :: x !< Continuous states [-] - TYPE(SD_DiscreteStateType) , DIMENSION(1:2) :: xd !< Discrete states [-] - TYPE(SD_ConstraintStateType) , DIMENSION(1:2) :: z !< Constraint states [-] - TYPE(SD_OtherStateType) , DIMENSION(1:2) :: OtherSt !< Other states [-] + TYPE(SD_ContinuousStateType) , DIMENSION(1:NumStateTimes) :: x !< Continuous states [-] + TYPE(SD_DiscreteStateType) , DIMENSION(1:NumStateTimes) :: xd !< Discrete states [-] + TYPE(SD_ConstraintStateType) , DIMENSION(1:NumStateTimes) :: z !< Constraint states [-] + TYPE(SD_OtherStateType) , DIMENSION(1:NumStateTimes) :: OtherSt !< Other states [-] TYPE(SD_ParameterType) :: p !< Parameters [-] TYPE(SD_InputType) :: u !< System inputs [-] TYPE(SD_OutputType) :: y !< System outputs [-] TYPE(SD_MiscVarType) :: m !< Misc/optimization variables [-] TYPE(SD_InputType) , DIMENSION(:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] + TYPE(SD_InputType) , DIMENSION(:), ALLOCATABLE :: Input_Saved !< Backup Array of inputs associated with InputTimes [-] TYPE(SD_OutputType) , DIMENSION(:), ALLOCATABLE :: Output !< Array of outputs associated with CalcSteady Azimuths [-] TYPE(SD_OutputType) :: y_interp !< interpolated system outputs for CalcSteady [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] + REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes_Saved !< Backup Array of times associated with Input Array [-] END TYPE SubDyn_Data ! ======================= ! ========= ExtPtfm_Data ======= TYPE, PUBLIC :: ExtPtfm_Data - TYPE(ExtPtfm_ContinuousStateType) , DIMENSION(1:2) :: x !< Continuous states [-] - TYPE(ExtPtfm_DiscreteStateType) , DIMENSION(1:2) :: xd !< Discrete states [-] - TYPE(ExtPtfm_ConstraintStateType) , DIMENSION(1:2) :: z !< Constraint states [-] - TYPE(ExtPtfm_OtherStateType) , DIMENSION(1:2) :: OtherSt !< Other states [-] + TYPE(ExtPtfm_ContinuousStateType) , DIMENSION(1:NumStateTimes) :: x !< Continuous states [-] + TYPE(ExtPtfm_DiscreteStateType) , DIMENSION(1:NumStateTimes) :: xd !< Discrete states [-] + TYPE(ExtPtfm_ConstraintStateType) , DIMENSION(1:NumStateTimes) :: z !< Constraint states [-] + TYPE(ExtPtfm_OtherStateType) , DIMENSION(1:NumStateTimes) :: OtherSt !< Other states [-] TYPE(ExtPtfm_ParameterType) :: p !< Parameters [-] TYPE(ExtPtfm_InputType) :: u !< System inputs [-] TYPE(ExtPtfm_OutputType) :: y !< System outputs [-] TYPE(ExtPtfm_MiscVarType) :: m !< Misc/optimization variables [-] TYPE(ExtPtfm_InputType) , DIMENSION(:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] + TYPE(ExtPtfm_InputType) , DIMENSION(:), ALLOCATABLE :: Input_Saved !< Backup Array of inputs associated with InputTimes [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] + REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes_Saved !< Backup Array of times associated with Input Array [-] END TYPE ExtPtfm_Data ! ======================= +! ========= SeaState_Data ======= + TYPE, PUBLIC :: SeaState_Data + TYPE(SeaSt_ContinuousStateType) , DIMENSION(1:NumStateTimes) :: x !< Continuous states [-] + TYPE(SeaSt_DiscreteStateType) , DIMENSION(1:NumStateTimes) :: xd !< Discrete states [-] + TYPE(SeaSt_ConstraintStateType) , DIMENSION(1:NumStateTimes) :: z !< Constraint states [-] + TYPE(SeaSt_OtherStateType) , DIMENSION(1:NumStateTimes) :: OtherSt !< Other states [-] + TYPE(SeaSt_ParameterType) :: p !< Parameters [-] + TYPE(SeaSt_InputType) :: u !< System inputs [-] + TYPE(SeaSt_OutputType) :: y !< System outputs [-] + TYPE(SeaSt_MiscVarType) :: m !< Misc/optimization variables [-] + TYPE(SeaSt_InputType) , DIMENSION(:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] + TYPE(SeaSt_InputType) , DIMENSION(:), ALLOCATABLE :: Input_Saved !< Backup Array of inputs associated with InputTimes [-] + TYPE(SeaSt_OutputType) , DIMENSION(:), ALLOCATABLE :: Output !< Array of outputs associated with CalcSteady Azimuths [-] + TYPE(SeaSt_OutputType) :: y_interp !< interpolated system outputs for CalcSteady [-] + REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] + REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes_Saved !< Backup Array of times associated with Input Array [-] + END TYPE SeaState_Data +! ======================= ! ========= HydroDyn_Data ======= TYPE, PUBLIC :: HydroDyn_Data - TYPE(HydroDyn_ContinuousStateType) , DIMENSION(1:2) :: x !< Continuous states [-] - TYPE(HydroDyn_DiscreteStateType) , DIMENSION(1:2) :: xd !< Discrete states [-] - TYPE(HydroDyn_ConstraintStateType) , DIMENSION(1:2) :: z !< Constraint states [-] - TYPE(HydroDyn_OtherStateType) , DIMENSION(1:2) :: OtherSt !< Other states [-] + TYPE(HydroDyn_ContinuousStateType) , DIMENSION(1:NumStateTimes) :: x !< Continuous states [-] + TYPE(HydroDyn_DiscreteStateType) , DIMENSION(1:NumStateTimes) :: xd !< Discrete states [-] + TYPE(HydroDyn_ConstraintStateType) , DIMENSION(1:NumStateTimes) :: z !< Constraint states [-] + TYPE(HydroDyn_OtherStateType) , DIMENSION(1:NumStateTimes) :: OtherSt !< Other states [-] TYPE(HydroDyn_ParameterType) :: p !< Parameters [-] TYPE(HydroDyn_InputType) :: u !< System inputs [-] TYPE(HydroDyn_OutputType) :: y !< System outputs [-] @@ -528,28 +633,32 @@ MODULE FAST_Types TYPE(HydroDyn_OutputType) , DIMENSION(:), ALLOCATABLE :: Output !< Array of outputs associated with CalcSteady Azimuths [-] TYPE(HydroDyn_OutputType) :: y_interp !< interpolated system outputs for CalcSteady [-] TYPE(HydroDyn_InputType) , DIMENSION(:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] + TYPE(HydroDyn_InputType) , DIMENSION(:), ALLOCATABLE :: Input_Saved !< Backup Array of inputs associated with InputTimes [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] + REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes_Saved !< Backup Array of times associated with Input Array [-] END TYPE HydroDyn_Data ! ======================= ! ========= IceFloe_Data ======= TYPE, PUBLIC :: IceFloe_Data - TYPE(IceFloe_ContinuousStateType) , DIMENSION(1:2) :: x !< Continuous states [-] - TYPE(IceFloe_DiscreteStateType) , DIMENSION(1:2) :: xd !< Discrete states [-] - TYPE(IceFloe_ConstraintStateType) , DIMENSION(1:2) :: z !< Constraint states [-] - TYPE(IceFloe_OtherStateType) , DIMENSION(1:2) :: OtherSt !< Other states [-] + TYPE(IceFloe_ContinuousStateType) , DIMENSION(1:NumStateTimes) :: x !< Continuous states [-] + TYPE(IceFloe_DiscreteStateType) , DIMENSION(1:NumStateTimes) :: xd !< Discrete states [-] + TYPE(IceFloe_ConstraintStateType) , DIMENSION(1:NumStateTimes) :: z !< Constraint states [-] + TYPE(IceFloe_OtherStateType) , DIMENSION(1:NumStateTimes) :: OtherSt !< Other states [-] TYPE(IceFloe_ParameterType) :: p !< Parameters [-] TYPE(IceFloe_InputType) :: u !< System inputs [-] TYPE(IceFloe_OutputType) :: y !< System outputs [-] TYPE(IceFloe_MiscVarType) :: m !< Misc/optimization variables [-] TYPE(IceFloe_InputType) , DIMENSION(:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] + TYPE(IceFloe_InputType) , DIMENSION(:), ALLOCATABLE :: Input_Saved !< Backup Array of inputs associated with InputTimes [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] + REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes_Saved !< Backup Array of times associated with Input Array [-] END TYPE IceFloe_Data ! ======================= ! ========= MAP_Data ======= TYPE, PUBLIC :: MAP_Data - TYPE(MAP_ContinuousStateType) , DIMENSION(1:2) :: x !< Continuous states [-] - TYPE(MAP_DiscreteStateType) , DIMENSION(1:2) :: xd !< Discrete states [-] - TYPE(MAP_ConstraintStateType) , DIMENSION(1:2) :: z !< Constraint states [-] + TYPE(MAP_ContinuousStateType) , DIMENSION(1:NumStateTimes) :: x !< Continuous states [-] + TYPE(MAP_DiscreteStateType) , DIMENSION(1:NumStateTimes) :: xd !< Discrete states [-] + TYPE(MAP_ConstraintStateType) , DIMENSION(1:NumStateTimes) :: z !< Constraint states [-] TYPE(MAP_OtherStateType) :: OtherSt !< Other/optimization states [-] TYPE(MAP_ParameterType) :: p !< Parameters [-] TYPE(MAP_InputType) :: u !< System inputs [-] @@ -558,29 +667,33 @@ MODULE FAST_Types TYPE(MAP_OutputType) , DIMENSION(:), ALLOCATABLE :: Output !< Array of outputs associated with CalcSteady Azimuths [-] TYPE(MAP_OutputType) :: y_interp !< interpolated system outputs for CalcSteady [-] TYPE(MAP_InputType) , DIMENSION(:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] + TYPE(MAP_InputType) , DIMENSION(:), ALLOCATABLE :: Input_Saved !< Backup Array of inputs associated with InputTimes [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] + REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes_Saved !< Backup Array of times associated with Input Array [-] END TYPE MAP_Data ! ======================= ! ========= FEAMooring_Data ======= TYPE, PUBLIC :: FEAMooring_Data - TYPE(FEAM_ContinuousStateType) , DIMENSION(1:2) :: x !< Continuous states [-] - TYPE(FEAM_DiscreteStateType) , DIMENSION(1:2) :: xd !< Discrete states [-] - TYPE(FEAM_ConstraintStateType) , DIMENSION(1:2) :: z !< Constraint states [-] - TYPE(FEAM_OtherStateType) , DIMENSION(1:2) :: OtherSt !< Other states [-] + TYPE(FEAM_ContinuousStateType) , DIMENSION(1:NumStateTimes) :: x !< Continuous states [-] + TYPE(FEAM_DiscreteStateType) , DIMENSION(1:NumStateTimes) :: xd !< Discrete states [-] + TYPE(FEAM_ConstraintStateType) , DIMENSION(1:NumStateTimes) :: z !< Constraint states [-] + TYPE(FEAM_OtherStateType) , DIMENSION(1:NumStateTimes) :: OtherSt !< Other states [-] TYPE(FEAM_ParameterType) :: p !< Parameters [-] TYPE(FEAM_InputType) :: u !< System inputs [-] TYPE(FEAM_OutputType) :: y !< System outputs [-] TYPE(FEAM_MiscVarType) :: m !< Misc/optimization variables [-] TYPE(FEAM_InputType) , DIMENSION(:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] + TYPE(FEAM_InputType) , DIMENSION(:), ALLOCATABLE :: Input_Saved !< Backup Array of inputs associated with InputTimes [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] + REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes_Saved !< Backup Array of times associated with Input Array [-] END TYPE FEAMooring_Data ! ======================= ! ========= MoorDyn_Data ======= TYPE, PUBLIC :: MoorDyn_Data - TYPE(MD_ContinuousStateType) , DIMENSION(1:2) :: x !< Continuous states [-] - TYPE(MD_DiscreteStateType) , DIMENSION(1:2) :: xd !< Discrete states [-] - TYPE(MD_ConstraintStateType) , DIMENSION(1:2) :: z !< Constraint states [-] - TYPE(MD_OtherStateType) , DIMENSION(1:2) :: OtherSt !< Other states [-] + TYPE(MD_ContinuousStateType) , DIMENSION(1:NumStateTimes) :: x !< Continuous states [-] + TYPE(MD_DiscreteStateType) , DIMENSION(1:NumStateTimes) :: xd !< Discrete states [-] + TYPE(MD_ConstraintStateType) , DIMENSION(1:NumStateTimes) :: z !< Constraint states [-] + TYPE(MD_OtherStateType) , DIMENSION(1:NumStateTimes) :: OtherSt !< Other states [-] TYPE(MD_ParameterType) :: p !< Parameters [-] TYPE(MD_InputType) :: u !< System inputs [-] TYPE(MD_OutputType) :: y !< System outputs [-] @@ -588,21 +701,25 @@ MODULE FAST_Types TYPE(MD_OutputType) , DIMENSION(:), ALLOCATABLE :: Output !< Array of outputs associated with CalcSteady Azimuths [-] TYPE(MD_OutputType) :: y_interp !< interpolated system outputs for CalcSteady [-] TYPE(MD_InputType) , DIMENSION(:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] + TYPE(MD_InputType) , DIMENSION(:), ALLOCATABLE :: Input_Saved !< Backup Array of inputs associated with InputTimes [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] + REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes_Saved !< Backup Array of times associated with Input Array [-] END TYPE MoorDyn_Data ! ======================= ! ========= OrcaFlex_Data ======= TYPE, PUBLIC :: OrcaFlex_Data - TYPE(Orca_ContinuousStateType) , DIMENSION(1:2) :: x !< Continuous states [-] - TYPE(Orca_DiscreteStateType) , DIMENSION(1:2) :: xd !< Discrete states [-] - TYPE(Orca_ConstraintStateType) , DIMENSION(1:2) :: z !< Constraint states [-] - TYPE(Orca_OtherStateType) , DIMENSION(1:2) :: OtherSt !< Other states [-] + TYPE(Orca_ContinuousStateType) , DIMENSION(1:NumStateTimes) :: x !< Continuous states [-] + TYPE(Orca_DiscreteStateType) , DIMENSION(1:NumStateTimes) :: xd !< Discrete states [-] + TYPE(Orca_ConstraintStateType) , DIMENSION(1:NumStateTimes) :: z !< Constraint states [-] + TYPE(Orca_OtherStateType) , DIMENSION(1:NumStateTimes) :: OtherSt !< Other states [-] TYPE(Orca_ParameterType) :: p !< Parameters [-] TYPE(Orca_InputType) :: u !< System inputs [-] TYPE(Orca_OutputType) :: y !< System outputs [-] TYPE(Orca_MiscVarType) :: m !< Misc/optimization variables [-] TYPE(Orca_InputType) , DIMENSION(:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] + TYPE(Orca_InputType) , DIMENSION(:), ALLOCATABLE :: Input_Saved !< Backup Array of inputs associated with InputTimes [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] + REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes_Saved !< Backup Array of times associated with Input Array [-] END TYPE OrcaFlex_Data ! ======================= ! ========= FAST_ModuleMapType ======= @@ -611,20 +728,14 @@ MODULE FAST_Types TYPE(MeshMapType) , DIMENSION(:), ALLOCATABLE :: BD_P_2_ED_P !< Map BeamDyn ReactionForce loads point meshes to ElastoDyn HubPtLoad point mesh [-] TYPE(MeshMapType) , DIMENSION(:), ALLOCATABLE :: ED_P_2_BD_P_Hub !< ElastoDyn hub to BeamDyn for hub orientation necessary for pitch actuator [-] TYPE(MeshMapType) :: ED_P_2_HD_PRP_P !< Map ElastoDyn PlatformPtMesh to HydroDyn platform reference Point [-] - TYPE(MeshMapType) :: ED_P_2_HD_W_P !< Map ElastoDyn PlatformPtMesh to HydroDyn WAMIT Point [-] - TYPE(MeshMapType) :: HD_W_P_2_ED_P !< Map HydroDyn WAMIT Point from y%WAMITMesh to ElastoDyn PlatformPtMesh [-] - TYPE(MeshMapType) :: ED_P_2_HD_M_P !< Map ElastoDyn PlatformPtMesh to HydroDyn Morison Point [-] - TYPE(MeshMapType) :: HD_M_P_2_ED_P !< Map HydroDyn Morison Point to ElastoDyn PlatformPtMesh [-] - TYPE(MeshMapType) :: ED_P_2_Mooring_P !< Map ElastoDyn PlatformPtMesh to MAP/FEAM/MoorDyn/OrcaFlex point mesh [-] - TYPE(MeshMapType) :: Mooring_P_2_ED_P !< Map FEAM/MAP/MoorDyn/OrcaFlex point mesh to ElastoDyn PlatformPtMesh [-] - TYPE(MeshMapType) :: SDy3_P_2_Mooring_P !< Map SD Motions (y3Mesh) to MAP/FEAM/MoorDyn/OrcaFlex point mesh [-] - TYPE(MeshMapType) :: Mooring_P_2_SD_P !< Map FEAM/MAP/MoorDyn/OrcaFlex point mesh to SD point loads (LMesh) mesh [-] + TYPE(MeshMapType) :: SubStructure_2_HD_W_P !< Map ElastoDyn PlatformPtMesh or SubDyn y2Mesh to HydroDyn WAMIT Point [-] + TYPE(MeshMapType) :: HD_W_P_2_SubStructure !< Map HydroDyn WAMIT Point from y%WAMITMesh to ElastoDyn PlatformPtMesh or SD LMesh [-] + TYPE(MeshMapType) :: SubStructure_2_HD_M_P !< Map ElastoDyn PlatformPtMesh or SubDyn y2Mesh to HydroDyn Morison Point [-] + TYPE(MeshMapType) :: HD_M_P_2_SubStructure !< Map HydroDyn Morison Point to ElastoDyn PlatformPtMesh or SD LMesh [-] + TYPE(MeshMapType) :: Structure_2_Mooring !< Map structural SD (y3Mesh)/ED to MAP/FEAM/MoorDyn/OrcaFlex point mesh [Motions] + TYPE(MeshMapType) :: Mooring_2_Structure !< Map FEAM/MAP/MoorDyn/OrcaFlex mesh to SD (LMesh)/ED (PlatformPtMesh)/ExtPtfm mesh [Loads] TYPE(MeshMapType) :: ED_P_2_SD_TP !< Map ElastoDyn PlatformPtMesh to SubDyn transition-piece point mesh [-] TYPE(MeshMapType) :: SD_TP_2_ED_P !< Map SubDyn transition-piece point mesh to ElastoDyn PlatformPtMesh [-] - TYPE(MeshMapType) :: SD_P_2_HD_M_P !< Map SubDyn y2Mesh Point to HydroDyn Morison Point [-] - TYPE(MeshMapType) :: HD_M_P_2_SD_P !< Map HydroDyn Morison Point to SubDyn y2Mesh Point [-] - TYPE(MeshMapType) :: SD_P_2_HD_W_P !< Map SubDyn y2Mesh Point to HydroDyn WAMIT Point [-] - TYPE(MeshMapType) :: HD_W_P_2_SD_P !< Map HydroDyn WAMIT Point to SubDyn y2Mesh Point [-] TYPE(MeshMapType) , DIMENSION(:), ALLOCATABLE :: ED_P_2_NStC_P_N !< Map ElastoDyn nacelle point mesh to ServoDyn/NStC point mesh [-] TYPE(MeshMapType) , DIMENSION(:), ALLOCATABLE :: NStC_P_2_ED_P_N !< Map ServoDyn/NStC nacelle point mesh to ElastoDyn point mesh on the nacelle [-] TYPE(MeshMapType) , DIMENSION(:), ALLOCATABLE :: ED_L_2_TStC_P_T !< Map ElastoDyn tower line2 mesh to ServoDyn/TStC point mesh [-] @@ -633,14 +744,15 @@ MODULE FAST_Types TYPE(MeshMapType) , DIMENSION(:,:), ALLOCATABLE :: BStC_P_2_ED_P_B !< Map ServoDyn/BStC point mesh to ElastoDyn point load mesh on the blade [-] TYPE(MeshMapType) , DIMENSION(:,:), ALLOCATABLE :: BD_L_2_BStC_P_B !< Map BeamDyn blade line2 mesh to ServoDyn/BStC point mesh [-] TYPE(MeshMapType) , DIMENSION(:,:), ALLOCATABLE :: BStC_P_2_BD_P_B !< Map ServoDyn/BStC point mesh to BeamDyn point load mesh on the blade [-] - TYPE(MeshMapType) , DIMENSION(:), ALLOCATABLE :: SStC_P_P_2_ED_P !< Map ServoDyn/SStC platform point mesh load to ElastoDyn point load mesh [-] - TYPE(MeshMapType) , DIMENSION(:), ALLOCATABLE :: ED_P_2_SStC_P_P !< Map ElastoDyn platform point mesh motion to ServoDyn/SStC point mesh [-] - TYPE(MeshMapType) , DIMENSION(:), ALLOCATABLE :: SStC_P_P_2_SD_P !< Map ServoDyn/SStC platform point mesh load to SubDyn point load mesh [-] - TYPE(MeshMapType) , DIMENSION(:), ALLOCATABLE :: SDy3_P_2_SStC_P_P !< Map SubDyn y3mesh point mesh motion to ServoDyn/SStC point mesh [-] - TYPE(MeshMapType) :: ED_P_2_SrvD_P_P !< Map ElastoDyn platform point mesh motion to ServoDyn point mesh -- for passing to controller [-] + TYPE(MeshMapType) , DIMENSION(:), ALLOCATABLE :: SStC_P_P_2_SubStructure !< Map ServoDyn/SStC platform point mesh load to SubDyn/ElastoDyn point load mesh [-] + TYPE(MeshMapType) , DIMENSION(:), ALLOCATABLE :: SubStructure_2_SStC_P_P !< Map SubDyn y3mesh or ED platform mesh motion to ServoDyn/SStC point mesh [-] + TYPE(MeshMapType) :: ED_P_2_SrvD_P_P !< Map ElastoDyn/Simplified-ElastoDyn platform point mesh motion to ServoDyn point mesh -- for passing to controller [-] TYPE(MeshMapType) , DIMENSION(:), ALLOCATABLE :: BDED_L_2_AD_L_B !< Map ElastoDyn BladeLn2Mesh point meshes OR BeamDyn BldMotion line2 meshes to AeroDyn14 InputMarkers OR AeroDyn BladeMotion line2 meshes [-] TYPE(MeshMapType) , DIMENSION(:), ALLOCATABLE :: AD_L_2_BDED_B !< Map AeroDyn14 InputMarkers or AeroDyn BladeLoad line2 meshes to ElastoDyn BladePtLoad point meshes or BeamDyn BldMotion line2 meshes [-] TYPE(MeshMapType) , DIMENSION(:), ALLOCATABLE :: BD_L_2_BD_L !< Map BeamDyn BldMotion output meshes to locations on the BD input DistrLoad mesh stored in MeshMapType%y_BD_BldMotion_4Loads (BD input and output meshes are not siblings and in fact have nodes at different locations [-] + TYPE(MeshMapType) , DIMENSION(:), ALLOCATABLE :: SED_P_2_AD_L_B !< Map Simplified-ElastoDyn BladeRoot point meshes to rigid AeroDyn BladeMotion line2 meshes [-] + TYPE(MeshMapType) , DIMENSION(:), ALLOCATABLE :: SED_P_2_AD_P_R !< Map Simplified-ElastoDyn BladeRootMotion point meshes to AeroDyn BladeRootMotion point meshes [-] + TYPE(MeshMapType) , DIMENSION(:), ALLOCATABLE :: AD_L_2_SED_P !< Map AeroDyn blade load output mesh to Simplified-ElastoDyn Hub point mesh [-] TYPE(MeshMapType) :: ED_P_2_AD_P_N !< Map ElastoDyn Nacelle point motion mesh to AeroDyn Nacelle point motion mesh [-] TYPE(MeshMapType) :: AD_P_2_ED_P_N !< Map AeroDyn Nacelle point load mesh to ElastoDyn nacelle point load mesh [-] TYPE(MeshMapType) :: ED_P_2_AD_P_TF !< Map ElastoDyn TailFin CM point motion mesh to AeroDyn TailFin ref point motion mesh [-] @@ -649,7 +761,22 @@ MODULE FAST_Types TYPE(MeshMapType) :: AD_L_2_ED_P_T !< Map AeroDyn14 Twr_InputMarkers or AeroDyn TowerLoad line2 mesh to ElastoDyn TowerPtLoads point mesh [-] TYPE(MeshMapType) , DIMENSION(:), ALLOCATABLE :: ED_P_2_AD_P_R !< Map ElastoDyn BladeRootMotion point meshes to AeroDyn BladeRootMotion point meshes [-] TYPE(MeshMapType) :: ED_P_2_AD_P_H !< Map ElastoDyn HubPtMotion point mesh to AeroDyn HubMotion point mesh [-] + TYPE(MeshMapType) :: ADsk_P_2_ED_P_H !< Map AeroDisk point load mesh to ElastoDyn hub point load mesh [-] + TYPE(MeshMapType) :: ED_P_2_ADsk_P_H !< Map ElastoDyn HubPtMotion point mesh to AeroDisk HubMotion point mesh [-] + TYPE(MeshMapType) :: SED_P_2_AD_P_N !< Map Simplified-ElastoDyn Nacelle point motion mesh to AeroDyn Nacelle point motion mesh [-] + TYPE(MeshMapType) :: SED_L_2_AD_L_T !< Map Simplified-ElastoDyn TowerLn2Mesh line2 mesh to AeroDyn TowerMotion line2 mesh [-] + TYPE(MeshMapType) :: SED_P_2_AD_P_H !< Map Simplified-ElastoDyn HubPtMotion point mesh to AeroDyn HubMotion point mesh [-] + TYPE(MeshMapType) :: ADsk_P_2_SED_P_H !< Map AeroDisk point load mesh to Simplfied-ElastoDyn hub point load mesh [-] + TYPE(MeshMapType) :: SED_P_2_ADsk_P_H !< Map Simplified-ElastoDyn HubPtMotion point mesh to AeroDisk HubMotion point mesh [-] TYPE(MeshMapType) :: AD_P_2_ED_P_H !< Map AeroDyn HubLoad point mesh to ElastoDyn HubPtLoad point mesh [-] + TYPE(MeshMapType) , DIMENSION(:), ALLOCATABLE :: BDED_L_2_ExtLd_P_B !< Map ElastoDyn/BeamDyn BladeLn2Mesh point meshes OR BeamDyn BldMotion line2 meshes to ExtLoads point meshes [-] + TYPE(MeshMapType) , DIMENSION(:), ALLOCATABLE :: ExtLd_P_2_BDED_B !< Map ExtLoads at points to ElastoDyn BladePtLoad point meshes or BeamDyn BldMotion line2 meshes [-] + TYPE(MeshMapType) :: ED_L_2_ExtLd_P_T !< Map ElastoDyn TowerLn2Mesh line2 mesh to ExtLoads point mesh [-] + TYPE(MeshMapType) :: ExtLd_P_2_ED_P_T !< Map ExtLoads TowerLoad point mesh to ElastoDyn TowerPtLoads point mesh [-] + TYPE(MeshMapType) , DIMENSION(:), ALLOCATABLE :: ED_P_2_ExtLd_P_R !< Map ElastoDyn BladeRootMotion point meshes to ExtLoads BladeRootMotion point meshes [-] + TYPE(MeshMapType) :: ED_P_2_ExtLd_P_H !< Map ElastoDyn HubPtMotion point mesh to ExtLoads HubMotion point mesh [-] + TYPE(MeshMapType) , DIMENSION(:), ALLOCATABLE :: AD_L_2_ExtLd_B !< Map AeroDyn line loads on blades to ExtLoads point loads [-] + TYPE(MeshMapType) :: AD_L_2_ExtLd_T !< Map AeroDyn line loads on tower to ExtKoads point loads [-] TYPE(MeshMapType) :: IceF_P_2_SD_P !< Map IceFloe point mesh to SubDyn LMesh point mesh [-] TYPE(MeshMapType) :: SDy3_P_2_IceF_P !< Map SubDyn y3Mesh point mesh to IceFloe point mesh [-] TYPE(MeshMapType) , DIMENSION(:), ALLOCATABLE :: IceD_P_2_SD_P !< Map IceDyn point mesh to SubDyn LMesh point mesh [-] @@ -658,15 +785,14 @@ MODULE FAST_Types INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: Jacobian_pivot !< Pivot array used for LU decomposition of Jacobian_Opt1 [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: Jac_u_indx !< matrix to help fill/pack the u vector in computing the jacobian [-] TYPE(MeshType) :: u_ED_NacelleLoads !< copy of ED input mesh [-] - TYPE(MeshType) :: u_ED_PlatformPtMesh !< copy of ED input mesh [-] - TYPE(MeshType) :: u_ED_PlatformPtMesh_2 !< copy of ED input mesh (used only for temporary storage) [-] - TYPE(MeshType) :: u_ED_PlatformPtMesh_3 !< copy of ED input mesh (used only for temporary storage) [-] - TYPE(MeshType) :: u_ED_PlatformPtMesh_MDf !< copy of ED input mesh used to store loads from farm-level MD [-] + TYPE(MeshType) :: SubstructureLoads_Tmp !< copy of substructure loads input mesh (ED or SD) [-] + TYPE(MeshType) :: SubstructureLoads_Tmp2 !< copy of substructure loads input mesh (ED or SD, used only for temporary storage) [-] + TYPE(MeshType) :: PlatformLoads_Tmp !< copy of platform loads input mesh (ED) [-] + TYPE(MeshType) :: PlatformLoads_Tmp2 !< copy of platform loads input mesh (ED, used only for temporary storage) [-] + TYPE(MeshType) :: SubstructureLoads_Tmp_Farm !< copy of substructure mesh used to store loads from farm-level MD [-] TYPE(MeshType) :: u_ED_TowerPtloads !< copy of ED input mesh [-] TYPE(MeshType) , DIMENSION(:), ALLOCATABLE :: u_ED_BladePtLoads !< copy of ED input mesh [-] TYPE(MeshType) :: u_SD_TPMesh !< copy of SD input mesh [-] - TYPE(MeshType) :: u_SD_LMesh !< copy of SD input mesh [-] - TYPE(MeshType) :: u_SD_LMesh_2 !< copy of SD input mesh (used only for temporary storage) [-] TYPE(MeshType) :: u_HD_M_Mesh !< copy of HD morison input mesh [-] TYPE(MeshType) :: u_HD_W_Mesh !< copy of HD wamit input mesh [-] TYPE(MeshType) :: u_ED_HubPtLoad !< copy of ED input mesh [-] @@ -676,33 +802,35 @@ MODULE FAST_Types TYPE(MeshType) , DIMENSION(:), ALLOCATABLE :: u_BD_Distrload !< copy of BD DistrLoad input meshes [-] TYPE(MeshType) :: u_Orca_PtfmMesh !< copy of Orca PtfmMesh input mesh [-] TYPE(MeshType) :: u_ExtPtfm_PtfmMesh !< copy of ExtPtfm_MCKF PtfmMesh input mesh [-] + TYPE(MeshType) :: u_SED_HubPtLoad !< copy of SED input mesh [-] + REAL(R8Ki) , DIMENSION(:,:,:), ALLOCATABLE :: HubOrient !< Orientation matrix to translate results from blade 1 to remaining blades in aeromaps [(-)] END TYPE FAST_ModuleMapType ! ======================= ! ========= FAST_ExternInputType ======= TYPE, PUBLIC :: FAST_ExternInputType - REAL(ReKi) :: GenTrq !< generator torque input from Simulink/Labview [-] - REAL(ReKi) :: ElecPwr !< electric power input from Simulink/Labview [-] - REAL(ReKi) :: YawPosCom !< yaw position command from Simulink/Labview [-] - REAL(ReKi) :: YawRateCom !< yaw rate command from Simulink/Labview [-] - REAL(ReKi) , DIMENSION(1:3) :: BlPitchCom !< blade pitch commands from Simulink/Labview [rad] - REAL(ReKi) , DIMENSION(1:3) :: BlAirfoilCom !< blade airfoil commands from Simulink/Labview [-] - REAL(ReKi) :: HSSBrFrac !< Fraction of full braking torque: 0 (off) <= HSSBrFrac <= 1 (full) from Simulink or LabVIEW [-] - REAL(ReKi) , DIMENSION(1:3) :: LidarFocus !< lidar focus (relative to lidar location) [m] - REAL(ReKi) , DIMENSION(1:20) :: CableDeltaL !< Cable control DeltaL [m] - REAL(ReKi) , DIMENSION(1:20) :: CableDeltaLdot !< Cable control DeltaLdot [m/s] + REAL(ReKi) :: GenTrq = 0.0_ReKi !< generator torque input from Simulink/Labview [-] + REAL(ReKi) :: ElecPwr = 0.0_ReKi !< electric power input from Simulink/Labview [-] + REAL(ReKi) :: YawPosCom = 0.0_ReKi !< yaw position command from Simulink/Labview [-] + REAL(ReKi) :: YawRateCom = 0.0_ReKi !< yaw rate command from Simulink/Labview [-] + REAL(ReKi) , DIMENSION(1:3) :: BlPitchCom = 0.0_ReKi !< blade pitch commands from Simulink/Labview [rad] + REAL(ReKi) , DIMENSION(1:3) :: BlAirfoilCom = 0.0_ReKi !< blade airfoil commands from Simulink/Labview [-] + REAL(ReKi) :: HSSBrFrac = 0.0_ReKi !< Fraction of full braking torque: 0 (off) <= HSSBrFrac <= 1 (full) from Simulink or LabVIEW [-] + REAL(ReKi) , DIMENSION(1:3) :: LidarFocus = 0.0_ReKi !< lidar focus (relative to lidar location) [m] + REAL(ReKi) , DIMENSION(1:20) :: CableDeltaL = 0.0_ReKi !< Cable control DeltaL [m] + REAL(ReKi) , DIMENSION(1:20) :: CableDeltaLdot = 0.0_ReKi !< Cable control DeltaLdot [m/s] END TYPE FAST_ExternInputType ! ======================= ! ========= FAST_MiscVarType ======= TYPE, PUBLIC :: FAST_MiscVarType - REAL(DbKi) :: TiLstPrn !< The simulation time of the last print (to file) [(s)] - REAL(DbKi) :: t_global !< Current simulation time (for global/FAST simulation) [(s)] - REAL(DbKi) :: NextJacCalcTime !< Time between calculating Jacobians in the HD-ED and SD-ED simulations [(s)] - REAL(ReKi) :: PrevClockTime !< Clock time at start of simulation in seconds [(s)] - REAL(ReKi) :: UsrTime1 !< User CPU time for simulation initialization [(s)] - REAL(ReKi) :: UsrTime2 !< User CPU time for simulation (without intialization) [(s)] - INTEGER(IntKi) , DIMENSION(1:8) :: StrtTime !< Start time of simulation (including intialization) [-] - INTEGER(IntKi) , DIMENSION(1:8) :: SimStrtTime !< Start time of simulation (after initialization) [-] - LOGICAL :: calcJacobian !< Should we calculate Jacobians in Option 1? [(flag)] + REAL(DbKi) :: TiLstPrn = 0.0_R8Ki !< The simulation time of the last print (to file) [(s)] + REAL(DbKi) :: t_global = 0.0_R8Ki !< Current simulation time (for global/FAST simulation) [(s)] + REAL(DbKi) :: NextJacCalcTime = 0.0_R8Ki !< Time between calculating Jacobians in the HD-ED and SD-ED simulations [(s)] + REAL(ReKi) :: PrevClockTime = 0.0_ReKi !< Clock time at start of simulation in seconds [(s)] + REAL(ReKi) :: UsrTime1 = 0.0_ReKi !< User CPU time for simulation initialization [(s)] + REAL(ReKi) :: UsrTime2 = 0.0_ReKi !< User CPU time for simulation (without intialization) [(s)] + INTEGER(IntKi) , DIMENSION(1:8) :: StrtTime = 0_IntKi !< Start time of simulation (including intialization) [-] + INTEGER(IntKi) , DIMENSION(1:8) :: SimStrtTime = 0_IntKi !< Start time of simulation (after initialization) [-] + LOGICAL :: calcJacobian = .false. !< Should we calculate Jacobians in Option 1? [(flag)] TYPE(FAST_ExternInputType) :: ExternInput !< external input values [-] TYPE(FAST_MiscLinType) :: Lin !< misc data for linearization analysis [-] END TYPE FAST_MiscVarType @@ -711,18 +839,24 @@ MODULE FAST_Types TYPE, PUBLIC :: FAST_InitData TYPE(ED_InitInputType) :: InData_ED !< ED Initialization input data [-] TYPE(ED_InitOutputType) :: OutData_ED !< ED Initialization output data [-] + TYPE(SED_InitInputType) :: InData_SED !< SED Initialization input data [-] + TYPE(SED_InitOutputType) :: OutData_SED !< SED Initialization output data [-] TYPE(BD_InitInputType) :: InData_BD !< BD Initialization input data [-] TYPE(BD_InitOutputType) , DIMENSION(:), ALLOCATABLE :: OutData_BD !< BD Initialization output data [-] TYPE(SrvD_InitInputType) :: InData_SrvD !< SrvD Initialization input data [-] TYPE(SrvD_InitOutputType) :: OutData_SrvD !< SrvD Initialization output data [-] - TYPE(AD14_InitInputType) :: InData_AD14 !< AD14 Initialization input data [-] - TYPE(AD14_InitOutputType) :: OutData_AD14 !< AD14 Initialization output data [-] TYPE(AD_InitInputType) :: InData_AD !< AD Initialization input data [-] TYPE(AD_InitOutputType) :: OutData_AD !< AD Initialization output data [-] + TYPE(ADsk_InitInputType) :: InData_ADsk !< ADsk Initialization input data [-] + TYPE(ADsk_InitOutputType) :: OutData_ADsk !< ADsk Initialization output data [-] + TYPE(ExtLd_InitInputType) :: InData_ExtLd !< ExtLd Initialization input data [-] + TYPE(ExtLd_InitOutputType) :: OutData_ExtLd !< ExtLd Initialization output data [-] TYPE(InflowWind_InitInputType) :: InData_IfW !< IfW Initialization input data [-] TYPE(InflowWind_InitOutputType) :: OutData_IfW !< IfW Initialization output data [-] - TYPE(OpFM_InitInputType) :: InData_OpFM !< OpFM Initialization input data [-] - TYPE(OpFM_InitOutputType) :: OutData_OpFM !< OpFM Initialization output data [-] + TYPE(ExtInfw_InitInputType) :: InData_ExtInfw !< ExtInfw Initialization input data [-] + TYPE(ExtInfw_InitOutputType) :: OutData_ExtInfw !< ExtInfw Initialization output data [-] + TYPE(SeaSt_InitInputType) :: InData_SeaSt !< SeaSt Initialization input data [-] + TYPE(SeaSt_InitOutputType) :: OutData_SeaSt !< SeaSt Initialization output data [-] TYPE(HydroDyn_InitInputType) :: InData_HD !< HD Initialization input data [-] TYPE(HydroDyn_InitOutputType) :: OutData_HD !< HD Initialization output data [-] TYPE(SD_InitInputType) :: InData_SD !< SD Initialization input data [-] @@ -746,24 +880,27 @@ MODULE FAST_Types ! ========= FAST_ExternInitType ======= TYPE, PUBLIC :: FAST_ExternInitType REAL(DbKi) :: Tmax = -1 !< External code specified Tmax [s] - INTEGER(IntKi) :: SensorType = SensorType_None !< lidar sensor type, which should not be pulsed at the moment; this input should be replaced with a section in the InflowWind input file [-] - LOGICAL :: LidRadialVel !< TRUE => return radial component, FALSE => return 'x' direction estimate [-] INTEGER(IntKi) :: TurbIDforName = -1 !< ID number for turbine (used to create output file naming convention) [-] - REAL(ReKi) , DIMENSION(1:3) :: TurbinePos !< Initial position of turbine base (origin used for graphics or in FAST.Farm) [m] - INTEGER(IntKi) :: WaveFieldMod !< Wave field handling (-) (switch) 0: use individual HydroDyn inputs without adjustment, 1: adjust wave phases based on turbine offsets from farm origin [-] - 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] [-] + REAL(ReKi) , DIMENSION(1:3) :: TurbinePos = 0.0_ReKi !< Initial position of turbine base (origin used for graphics or in FAST.Farm) [m] + INTEGER(IntKi) :: WaveFieldMod = 0_IntKi !< Wave field handling (-) (switch) 0: use individual HydroDyn inputs without adjustment, 1: adjust wave phases based on turbine offsets from farm origin [-] + INTEGER(IntKi) :: NumSC2CtrlGlob = 0_IntKi !< number of global controller inputs [from supercontroller] [-] + INTEGER(IntKi) :: NumSC2Ctrl = 0_IntKi !< number of turbine specific controller inputs [from supercontroller] [-] + INTEGER(IntKi) :: NumCtrl2SC = 0_IntKi !< number of controller outputs [to supercontroller] [-] 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] [-] LOGICAL :: FarmIntegration = .false. !< whether this is called from FAST.Farm (or another program that doesn't want FAST to call all of the init stuff first) [-] - INTEGER(IntKi) , DIMENSION(1:4) :: windGrid_n !< number of grid points in the x, y, z, and t directions for IfW [-] - REAL(ReKi) , DIMENSION(1:4) :: windGrid_delta !< size between 2 consecutive grid points in each grid direction for IfW [m,m,m,s] - REAL(ReKi) , DIMENSION(1:3) :: windGrid_pZero !< fixed position of the XYZ grid (i.e., XYZ coordinates of IfW m%V(:,1,1,1,:)) [m] + INTEGER(IntKi) , DIMENSION(1:4) :: windGrid_n = 0_IntKi !< number of grid points in the x, y, z, and t directions for IfW [-] + REAL(ReKi) , DIMENSION(1:4) :: windGrid_delta = 0.0_ReKi !< size between 2 consecutive grid points in each grid direction for IfW [m,m,m,s] + REAL(ReKi) , DIMENSION(1:3) :: windGrid_pZero = 0.0_ReKi !< fixed position of the XYZ grid (i.e., XYZ coordinates of IfW m%V(:,1,1,1,:)) [m] + REAL(SiKi) , DIMENSION(:,:,:,:,:), POINTER :: windGrid_data => NULL() !< Pointers to Wind velocity of disturbed wind (ambient + wakes) across each high-resolution domain around a turbine for each high-resolution step within a low-resolution step [m/s] CHARACTER(1024) :: RootName !< Root name of FAST output files (overrides normal operation) [-] - INTEGER(IntKi) :: NumActForcePtsBlade !< number of actuator line force points in blade [-] - INTEGER(IntKi) :: NumActForcePtsTower !< number of actuator line force points in tower [-] - INTEGER(IntKi) :: NodeClusterType !< Node clustering for actuator line (0 - Uniform, 1 - Non-uniform clustered towards tip) [-] + INTEGER(IntKi) :: NumActForcePtsBlade = 0_IntKi !< number of actuator line force points in blade [-] + INTEGER(IntKi) :: NumActForcePtsTower = 0_IntKi !< number of actuator line force points in tower [-] + INTEGER(IntKi) :: NodeClusterType = 0_IntKi !< Node clustering for actuator line (0 - Uniform, 1 - Non-uniform clustered towards tip) [-] + REAL(DbKi) :: DTdriver = -1 !< External driver time step [s] + LOGICAL :: TwrAero = .false. !< Is Tower aerodynamics enabled for ExtLoads module? [-] + REAL(ReKi) :: az_blend_mean = 0.0_ReKi !< Mean azimuth at which to blend the external and aerodyn loads [-] + REAL(ReKi) :: az_blend_delta = 0.0_ReKi !< Mean azimuth at which to blend the external and aerodyn loads [-] END TYPE FAST_ExternInitType ! ======================= ! ========= FAST_TurbineType ======= @@ -774,13 +911,16 @@ MODULE FAST_Types TYPE(FAST_MiscVarType) :: m_FAST !< Miscellaneous variables [-] TYPE(FAST_ModuleMapType) :: MeshMapData !< Data for mapping between modules [-] TYPE(ElastoDyn_Data) :: ED !< Data for the ElastoDyn module [-] + TYPE(SED_Data) :: SED !< Data for the Simplified-ElastoDyn module [-] TYPE(BeamDyn_Data) :: BD !< Data for the BeamDyn module [-] TYPE(ServoDyn_Data) :: SrvD !< Data for the ServoDyn module [-] TYPE(AeroDyn_Data) :: AD !< Data for the AeroDyn module [-] - TYPE(AeroDyn14_Data) :: AD14 !< Data for the AeroDyn14 module [-] + TYPE(AeroDisk_Data) :: ADsk !< Data for the AeroDisk module [-] + TYPE(ExtLoads_Data) :: ExtLd !< Data for the External loads module [-] TYPE(InflowWind_Data) :: IfW !< Data for InflowWind module [-] - TYPE(OpenFOAM_Data) :: OpFM !< Data for OpenFOAM integration module [-] + TYPE(ExternalInflow_Data) :: ExtInfw !< Data for ExternalInflow integration module [-] TYPE(SCDataEx_Data) :: SC_DX !< Data for SuperController integration module [-] + TYPE(SeaState_Data) :: SeaSt !< Data for the SeaState module [-] TYPE(HydroDyn_Data) :: HD !< Data for the HydroDyn module [-] TYPE(SubDyn_Data) :: SD !< Data for the SubDyn module [-] TYPE(MAP_Data) :: MAP !< Data for the MAP (Mooring Analysis Program) module [-] @@ -793,49611 +933,14613 @@ MODULE FAST_Types END TYPE FAST_TurbineType ! ======================= CONTAINS - SUBROUTINE FAST_CopyVTK_BLSurfaceType( SrcVTK_BLSurfaceTypeData, DstVTK_BLSurfaceTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FAST_VTK_BLSurfaceType), INTENT(IN) :: SrcVTK_BLSurfaceTypeData - TYPE(FAST_VTK_BLSurfaceType), INTENT(INOUT) :: DstVTK_BLSurfaceTypeData - 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 = 'FAST_CopyVTK_BLSurfaceType' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcVTK_BLSurfaceTypeData%AirfoilCoords)) THEN - i1_l = LBOUND(SrcVTK_BLSurfaceTypeData%AirfoilCoords,1) - i1_u = UBOUND(SrcVTK_BLSurfaceTypeData%AirfoilCoords,1) - i2_l = LBOUND(SrcVTK_BLSurfaceTypeData%AirfoilCoords,2) - i2_u = UBOUND(SrcVTK_BLSurfaceTypeData%AirfoilCoords,2) - i3_l = LBOUND(SrcVTK_BLSurfaceTypeData%AirfoilCoords,3) - i3_u = UBOUND(SrcVTK_BLSurfaceTypeData%AirfoilCoords,3) - IF (.NOT. ALLOCATED(DstVTK_BLSurfaceTypeData%AirfoilCoords)) THEN - ALLOCATE(DstVTK_BLSurfaceTypeData%AirfoilCoords(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_BLSurfaceTypeData%AirfoilCoords.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstVTK_BLSurfaceTypeData%AirfoilCoords = SrcVTK_BLSurfaceTypeData%AirfoilCoords -ENDIF - END SUBROUTINE FAST_CopyVTK_BLSurfaceType - - SUBROUTINE FAST_DestroyVTK_BLSurfaceType( VTK_BLSurfaceTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(FAST_VTK_BLSurfaceType), INTENT(INOUT) :: VTK_BLSurfaceTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyVTK_BLSurfaceType' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(VTK_BLSurfaceTypeData%AirfoilCoords)) THEN - DEALLOCATE(VTK_BLSurfaceTypeData%AirfoilCoords) -ENDIF - END SUBROUTINE FAST_DestroyVTK_BLSurfaceType - - SUBROUTINE FAST_PackVTK_BLSurfaceType( 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(FAST_VTK_BLSurfaceType), 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 = 'FAST_PackVTK_BLSurfaceType' - ! 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 ! AirfoilCoords allocated yes/no - IF ( ALLOCATED(InData%AirfoilCoords) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! AirfoilCoords upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AirfoilCoords) ! AirfoilCoords - 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%AirfoilCoords) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AirfoilCoords,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AirfoilCoords,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AirfoilCoords,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AirfoilCoords,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AirfoilCoords,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AirfoilCoords,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%AirfoilCoords,3), UBOUND(InData%AirfoilCoords,3) - DO i2 = LBOUND(InData%AirfoilCoords,2), UBOUND(InData%AirfoilCoords,2) - DO i1 = LBOUND(InData%AirfoilCoords,1), UBOUND(InData%AirfoilCoords,1) - ReKiBuf(Re_Xferred) = InData%AirfoilCoords(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - END SUBROUTINE FAST_PackVTK_BLSurfaceType - - SUBROUTINE FAST_UnPackVTK_BLSurfaceType( 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(FAST_VTK_BLSurfaceType), 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 = 'FAST_UnPackVTK_BLSurfaceType' - ! 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 ! AirfoilCoords not allocated - Int_Xferred = Int_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%AirfoilCoords)) DEALLOCATE(OutData%AirfoilCoords) - ALLOCATE(OutData%AirfoilCoords(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%AirfoilCoords.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%AirfoilCoords,3), UBOUND(OutData%AirfoilCoords,3) - DO i2 = LBOUND(OutData%AirfoilCoords,2), UBOUND(OutData%AirfoilCoords,2) - DO i1 = LBOUND(OutData%AirfoilCoords,1), UBOUND(OutData%AirfoilCoords,1) - OutData%AirfoilCoords(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - END SUBROUTINE FAST_UnPackVTK_BLSurfaceType - - SUBROUTINE FAST_CopyVTK_SurfaceType( SrcVTK_SurfaceTypeData, DstVTK_SurfaceTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FAST_VTK_SurfaceType), INTENT(IN) :: SrcVTK_SurfaceTypeData - TYPE(FAST_VTK_SurfaceType), INTENT(INOUT) :: DstVTK_SurfaceTypeData - 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 = 'FAST_CopyVTK_SurfaceType' -! +subroutine FAST_CopyVTK_BLSurfaceType(SrcVTK_BLSurfaceTypeData, DstVTK_BLSurfaceTypeData, CtrlCode, ErrStat, ErrMsg) + type(FAST_VTK_BLSurfaceType), intent(in) :: SrcVTK_BLSurfaceTypeData + type(FAST_VTK_BLSurfaceType), intent(inout) :: DstVTK_BLSurfaceTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'FAST_CopyVTK_BLSurfaceType' ErrStat = ErrID_None - ErrMsg = "" - DstVTK_SurfaceTypeData%NumSectors = SrcVTK_SurfaceTypeData%NumSectors - DstVTK_SurfaceTypeData%HubRad = SrcVTK_SurfaceTypeData%HubRad - DstVTK_SurfaceTypeData%GroundRad = SrcVTK_SurfaceTypeData%GroundRad - DstVTK_SurfaceTypeData%NacelleBox = SrcVTK_SurfaceTypeData%NacelleBox -IF (ALLOCATED(SrcVTK_SurfaceTypeData%TowerRad)) THEN - i1_l = LBOUND(SrcVTK_SurfaceTypeData%TowerRad,1) - i1_u = UBOUND(SrcVTK_SurfaceTypeData%TowerRad,1) - IF (.NOT. ALLOCATED(DstVTK_SurfaceTypeData%TowerRad)) THEN - ALLOCATE(DstVTK_SurfaceTypeData%TowerRad(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_SurfaceTypeData%TowerRad.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstVTK_SurfaceTypeData%TowerRad = SrcVTK_SurfaceTypeData%TowerRad -ENDIF - DstVTK_SurfaceTypeData%NWaveElevPts = SrcVTK_SurfaceTypeData%NWaveElevPts -IF (ALLOCATED(SrcVTK_SurfaceTypeData%WaveElevXY)) THEN - i1_l = LBOUND(SrcVTK_SurfaceTypeData%WaveElevXY,1) - i1_u = UBOUND(SrcVTK_SurfaceTypeData%WaveElevXY,1) - i2_l = LBOUND(SrcVTK_SurfaceTypeData%WaveElevXY,2) - i2_u = UBOUND(SrcVTK_SurfaceTypeData%WaveElevXY,2) - IF (.NOT. ALLOCATED(DstVTK_SurfaceTypeData%WaveElevXY)) THEN - ALLOCATE(DstVTK_SurfaceTypeData%WaveElevXY(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_SurfaceTypeData%WaveElevXY.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstVTK_SurfaceTypeData%WaveElevXY = SrcVTK_SurfaceTypeData%WaveElevXY -ENDIF -IF (ALLOCATED(SrcVTK_SurfaceTypeData%WaveElev)) THEN - i1_l = LBOUND(SrcVTK_SurfaceTypeData%WaveElev,1) - i1_u = UBOUND(SrcVTK_SurfaceTypeData%WaveElev,1) - i2_l = LBOUND(SrcVTK_SurfaceTypeData%WaveElev,2) - i2_u = UBOUND(SrcVTK_SurfaceTypeData%WaveElev,2) - IF (.NOT. ALLOCATED(DstVTK_SurfaceTypeData%WaveElev)) THEN - ALLOCATE(DstVTK_SurfaceTypeData%WaveElev(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_SurfaceTypeData%WaveElev.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstVTK_SurfaceTypeData%WaveElev = SrcVTK_SurfaceTypeData%WaveElev -ENDIF -IF (ALLOCATED(SrcVTK_SurfaceTypeData%BladeShape)) THEN - i1_l = LBOUND(SrcVTK_SurfaceTypeData%BladeShape,1) - i1_u = UBOUND(SrcVTK_SurfaceTypeData%BladeShape,1) - IF (.NOT. ALLOCATED(DstVTK_SurfaceTypeData%BladeShape)) THEN - ALLOCATE(DstVTK_SurfaceTypeData%BladeShape(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_SurfaceTypeData%BladeShape.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcVTK_SurfaceTypeData%BladeShape,1), UBOUND(SrcVTK_SurfaceTypeData%BladeShape,1) - CALL FAST_Copyvtk_blsurfacetype( SrcVTK_SurfaceTypeData%BladeShape(i1), DstVTK_SurfaceTypeData%BladeShape(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcVTK_SurfaceTypeData%MorisonVisRad)) THEN - i1_l = LBOUND(SrcVTK_SurfaceTypeData%MorisonVisRad,1) - i1_u = UBOUND(SrcVTK_SurfaceTypeData%MorisonVisRad,1) - IF (.NOT. ALLOCATED(DstVTK_SurfaceTypeData%MorisonVisRad)) THEN - ALLOCATE(DstVTK_SurfaceTypeData%MorisonVisRad(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_SurfaceTypeData%MorisonVisRad.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstVTK_SurfaceTypeData%MorisonVisRad = SrcVTK_SurfaceTypeData%MorisonVisRad -ENDIF - END SUBROUTINE FAST_CopyVTK_SurfaceType - - SUBROUTINE FAST_DestroyVTK_SurfaceType( VTK_SurfaceTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(FAST_VTK_SurfaceType), INTENT(INOUT) :: VTK_SurfaceTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyVTK_SurfaceType' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(VTK_SurfaceTypeData%TowerRad)) THEN - DEALLOCATE(VTK_SurfaceTypeData%TowerRad) -ENDIF -IF (ALLOCATED(VTK_SurfaceTypeData%WaveElevXY)) THEN - DEALLOCATE(VTK_SurfaceTypeData%WaveElevXY) -ENDIF -IF (ALLOCATED(VTK_SurfaceTypeData%WaveElev)) THEN - DEALLOCATE(VTK_SurfaceTypeData%WaveElev) -ENDIF -IF (ALLOCATED(VTK_SurfaceTypeData%BladeShape)) THEN -DO i1 = LBOUND(VTK_SurfaceTypeData%BladeShape,1), UBOUND(VTK_SurfaceTypeData%BladeShape,1) - CALL FAST_Destroyvtk_blsurfacetype( VTK_SurfaceTypeData%BladeShape(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(VTK_SurfaceTypeData%BladeShape) -ENDIF -IF (ALLOCATED(VTK_SurfaceTypeData%MorisonVisRad)) THEN - DEALLOCATE(VTK_SurfaceTypeData%MorisonVisRad) -ENDIF - END SUBROUTINE FAST_DestroyVTK_SurfaceType - - SUBROUTINE FAST_PackVTK_SurfaceType( 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(FAST_VTK_SurfaceType), 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 = 'FAST_PackVTK_SurfaceType' - ! 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 ! NumSectors - Re_BufSz = Re_BufSz + 1 ! HubRad - Re_BufSz = Re_BufSz + 1 ! GroundRad - Re_BufSz = Re_BufSz + SIZE(InData%NacelleBox) ! NacelleBox - Int_BufSz = Int_BufSz + 1 ! TowerRad allocated yes/no - IF ( ALLOCATED(InData%TowerRad) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TowerRad upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TowerRad) ! TowerRad - END IF - Int_BufSz = Int_BufSz + SIZE(InData%NWaveElevPts) ! NWaveElevPts - Int_BufSz = Int_BufSz + 1 ! WaveElevXY allocated yes/no - IF ( ALLOCATED(InData%WaveElevXY) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! WaveElevXY upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveElevXY) ! WaveElevXY - END IF - Int_BufSz = Int_BufSz + 1 ! WaveElev allocated yes/no - IF ( ALLOCATED(InData%WaveElev) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! WaveElev upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveElev) ! WaveElev - END IF - Int_BufSz = Int_BufSz + 1 ! BladeShape allocated yes/no - IF ( ALLOCATED(InData%BladeShape) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BladeShape upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%BladeShape,1), UBOUND(InData%BladeShape,1) - Int_BufSz = Int_BufSz + 3 ! BladeShape: size of buffers for each call to pack subtype - CALL FAST_Packvtk_blsurfacetype( Re_Buf, Db_Buf, Int_Buf, InData%BladeShape(i1), ErrStat2, ErrMsg2, .TRUE. ) ! BladeShape - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BladeShape - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BladeShape - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BladeShape - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! MorisonVisRad allocated yes/no - IF ( ALLOCATED(InData%MorisonVisRad) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! MorisonVisRad upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%MorisonVisRad) ! MorisonVisRad - 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%NumSectors - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%HubRad - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%GroundRad - Re_Xferred = Re_Xferred + 1 - DO i2 = LBOUND(InData%NacelleBox,2), UBOUND(InData%NacelleBox,2) - DO i1 = LBOUND(InData%NacelleBox,1), UBOUND(InData%NacelleBox,1) - ReKiBuf(Re_Xferred) = InData%NacelleBox(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - IF ( .NOT. ALLOCATED(InData%TowerRad) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TowerRad,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TowerRad,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TowerRad,1), UBOUND(InData%TowerRad,1) - ReKiBuf(Re_Xferred) = InData%TowerRad(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - DO i1 = LBOUND(InData%NWaveElevPts,1), UBOUND(InData%NWaveElevPts,1) - IntKiBuf(Int_Xferred) = InData%NWaveElevPts(i1) - Int_Xferred = Int_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%WaveElevXY) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevXY,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevXY,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevXY,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevXY,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%WaveElevXY,2), UBOUND(InData%WaveElevXY,2) - DO i1 = LBOUND(InData%WaveElevXY,1), UBOUND(InData%WaveElevXY,1) - ReKiBuf(Re_Xferred) = InData%WaveElevXY(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveElev) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%WaveElev,2), UBOUND(InData%WaveElev,2) - DO i1 = LBOUND(InData%WaveElev,1), UBOUND(InData%WaveElev,1) - ReKiBuf(Re_Xferred) = InData%WaveElev(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BladeShape) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BladeShape,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BladeShape,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BladeShape,1), UBOUND(InData%BladeShape,1) - CALL FAST_Packvtk_blsurfacetype( Re_Buf, Db_Buf, Int_Buf, InData%BladeShape(i1), ErrStat2, ErrMsg2, OnlySize ) ! BladeShape - 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%MorisonVisRad) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MorisonVisRad,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MorisonVisRad,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%MorisonVisRad,1), UBOUND(InData%MorisonVisRad,1) - ReKiBuf(Re_Xferred) = InData%MorisonVisRad(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE FAST_PackVTK_SurfaceType - - SUBROUTINE FAST_UnPackVTK_SurfaceType( 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(FAST_VTK_SurfaceType), 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 = 'FAST_UnPackVTK_SurfaceType' - ! 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%NumSectors = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%HubRad = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%GroundRad = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%NacelleBox,1) - i1_u = UBOUND(OutData%NacelleBox,1) - i2_l = LBOUND(OutData%NacelleBox,2) - i2_u = UBOUND(OutData%NacelleBox,2) - DO i2 = LBOUND(OutData%NacelleBox,2), UBOUND(OutData%NacelleBox,2) - DO i1 = LBOUND(OutData%NacelleBox,1), UBOUND(OutData%NacelleBox,1) - OutData%NacelleBox(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TowerRad not allocated - Int_Xferred = Int_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%TowerRad)) DEALLOCATE(OutData%TowerRad) - ALLOCATE(OutData%TowerRad(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TowerRad.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TowerRad,1), UBOUND(OutData%TowerRad,1) - OutData%TowerRad(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - i1_l = LBOUND(OutData%NWaveElevPts,1) - i1_u = UBOUND(OutData%NWaveElevPts,1) - DO i1 = LBOUND(OutData%NWaveElevPts,1), UBOUND(OutData%NWaveElevPts,1) - OutData%NWaveElevPts(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElevXY not allocated - Int_Xferred = Int_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%WaveElevXY)) DEALLOCATE(OutData%WaveElevXY) - ALLOCATE(OutData%WaveElevXY(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevXY.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%WaveElevXY,2), UBOUND(OutData%WaveElevXY,2) - DO i1 = LBOUND(OutData%WaveElevXY,1), UBOUND(OutData%WaveElevXY,1) - OutData%WaveElevXY(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElev not allocated - Int_Xferred = Int_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%WaveElev)) DEALLOCATE(OutData%WaveElev) - ALLOCATE(OutData%WaveElev(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%WaveElev,2), UBOUND(OutData%WaveElev,2) - DO i1 = LBOUND(OutData%WaveElev,1), UBOUND(OutData%WaveElev,1) - OutData%WaveElev(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BladeShape not allocated - Int_Xferred = Int_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%BladeShape)) DEALLOCATE(OutData%BladeShape) - ALLOCATE(OutData%BladeShape(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeShape.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BladeShape,1), UBOUND(OutData%BladeShape,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 FAST_Unpackvtk_blsurfacetype( Re_Buf, Db_Buf, Int_Buf, OutData%BladeShape(i1), ErrStat2, ErrMsg2 ) ! BladeShape - 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 ! MorisonVisRad not allocated - Int_Xferred = Int_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%MorisonVisRad)) DEALLOCATE(OutData%MorisonVisRad) - ALLOCATE(OutData%MorisonVisRad(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MorisonVisRad.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%MorisonVisRad,1), UBOUND(OutData%MorisonVisRad,1) - OutData%MorisonVisRad(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE FAST_UnPackVTK_SurfaceType - - SUBROUTINE FAST_CopyVTK_ModeShapeType( SrcVTK_ModeShapeTypeData, DstVTK_ModeShapeTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FAST_VTK_ModeShapeType), INTENT(IN) :: SrcVTK_ModeShapeTypeData - TYPE(FAST_VTK_ModeShapeType), INTENT(INOUT) :: DstVTK_ModeShapeTypeData - 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 = 'FAST_CopyVTK_ModeShapeType' -! + ErrMsg = '' + if (allocated(SrcVTK_BLSurfaceTypeData%AirfoilCoords)) then + LB(1:3) = lbound(SrcVTK_BLSurfaceTypeData%AirfoilCoords) + UB(1:3) = ubound(SrcVTK_BLSurfaceTypeData%AirfoilCoords) + if (.not. allocated(DstVTK_BLSurfaceTypeData%AirfoilCoords)) then + allocate(DstVTK_BLSurfaceTypeData%AirfoilCoords(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_BLSurfaceTypeData%AirfoilCoords.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstVTK_BLSurfaceTypeData%AirfoilCoords = SrcVTK_BLSurfaceTypeData%AirfoilCoords + end if +end subroutine + +subroutine FAST_DestroyVTK_BLSurfaceType(VTK_BLSurfaceTypeData, ErrStat, ErrMsg) + type(FAST_VTK_BLSurfaceType), intent(inout) :: VTK_BLSurfaceTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FAST_DestroyVTK_BLSurfaceType' ErrStat = ErrID_None - ErrMsg = "" - DstVTK_ModeShapeTypeData%CheckpointRoot = SrcVTK_ModeShapeTypeData%CheckpointRoot - DstVTK_ModeShapeTypeData%MatlabFileName = SrcVTK_ModeShapeTypeData%MatlabFileName - DstVTK_ModeShapeTypeData%VTKLinModes = SrcVTK_ModeShapeTypeData%VTKLinModes -IF (ALLOCATED(SrcVTK_ModeShapeTypeData%VTKModes)) THEN - i1_l = LBOUND(SrcVTK_ModeShapeTypeData%VTKModes,1) - i1_u = UBOUND(SrcVTK_ModeShapeTypeData%VTKModes,1) - IF (.NOT. ALLOCATED(DstVTK_ModeShapeTypeData%VTKModes)) THEN - ALLOCATE(DstVTK_ModeShapeTypeData%VTKModes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_ModeShapeTypeData%VTKModes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstVTK_ModeShapeTypeData%VTKModes = SrcVTK_ModeShapeTypeData%VTKModes -ENDIF - DstVTK_ModeShapeTypeData%VTKLinTim = SrcVTK_ModeShapeTypeData%VTKLinTim - DstVTK_ModeShapeTypeData%VTKNLinTimes = SrcVTK_ModeShapeTypeData%VTKNLinTimes - DstVTK_ModeShapeTypeData%VTKLinScale = SrcVTK_ModeShapeTypeData%VTKLinScale - DstVTK_ModeShapeTypeData%VTKLinPhase = SrcVTK_ModeShapeTypeData%VTKLinPhase -IF (ALLOCATED(SrcVTK_ModeShapeTypeData%DampingRatio)) THEN - i1_l = LBOUND(SrcVTK_ModeShapeTypeData%DampingRatio,1) - i1_u = UBOUND(SrcVTK_ModeShapeTypeData%DampingRatio,1) - IF (.NOT. ALLOCATED(DstVTK_ModeShapeTypeData%DampingRatio)) THEN - ALLOCATE(DstVTK_ModeShapeTypeData%DampingRatio(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_ModeShapeTypeData%DampingRatio.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstVTK_ModeShapeTypeData%DampingRatio = SrcVTK_ModeShapeTypeData%DampingRatio -ENDIF -IF (ALLOCATED(SrcVTK_ModeShapeTypeData%NaturalFreq_Hz)) THEN - i1_l = LBOUND(SrcVTK_ModeShapeTypeData%NaturalFreq_Hz,1) - i1_u = UBOUND(SrcVTK_ModeShapeTypeData%NaturalFreq_Hz,1) - IF (.NOT. ALLOCATED(DstVTK_ModeShapeTypeData%NaturalFreq_Hz)) THEN - ALLOCATE(DstVTK_ModeShapeTypeData%NaturalFreq_Hz(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_ModeShapeTypeData%NaturalFreq_Hz.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstVTK_ModeShapeTypeData%NaturalFreq_Hz = SrcVTK_ModeShapeTypeData%NaturalFreq_Hz -ENDIF -IF (ALLOCATED(SrcVTK_ModeShapeTypeData%DampedFreq_Hz)) THEN - i1_l = LBOUND(SrcVTK_ModeShapeTypeData%DampedFreq_Hz,1) - i1_u = UBOUND(SrcVTK_ModeShapeTypeData%DampedFreq_Hz,1) - IF (.NOT. ALLOCATED(DstVTK_ModeShapeTypeData%DampedFreq_Hz)) THEN - ALLOCATE(DstVTK_ModeShapeTypeData%DampedFreq_Hz(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_ModeShapeTypeData%DampedFreq_Hz.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstVTK_ModeShapeTypeData%DampedFreq_Hz = SrcVTK_ModeShapeTypeData%DampedFreq_Hz -ENDIF -IF (ALLOCATED(SrcVTK_ModeShapeTypeData%x_eig_magnitude)) THEN - i1_l = LBOUND(SrcVTK_ModeShapeTypeData%x_eig_magnitude,1) - i1_u = UBOUND(SrcVTK_ModeShapeTypeData%x_eig_magnitude,1) - i2_l = LBOUND(SrcVTK_ModeShapeTypeData%x_eig_magnitude,2) - i2_u = UBOUND(SrcVTK_ModeShapeTypeData%x_eig_magnitude,2) - i3_l = LBOUND(SrcVTK_ModeShapeTypeData%x_eig_magnitude,3) - i3_u = UBOUND(SrcVTK_ModeShapeTypeData%x_eig_magnitude,3) - IF (.NOT. ALLOCATED(DstVTK_ModeShapeTypeData%x_eig_magnitude)) THEN - ALLOCATE(DstVTK_ModeShapeTypeData%x_eig_magnitude(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_ModeShapeTypeData%x_eig_magnitude.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstVTK_ModeShapeTypeData%x_eig_magnitude = SrcVTK_ModeShapeTypeData%x_eig_magnitude -ENDIF -IF (ALLOCATED(SrcVTK_ModeShapeTypeData%x_eig_phase)) THEN - i1_l = LBOUND(SrcVTK_ModeShapeTypeData%x_eig_phase,1) - i1_u = UBOUND(SrcVTK_ModeShapeTypeData%x_eig_phase,1) - i2_l = LBOUND(SrcVTK_ModeShapeTypeData%x_eig_phase,2) - i2_u = UBOUND(SrcVTK_ModeShapeTypeData%x_eig_phase,2) - i3_l = LBOUND(SrcVTK_ModeShapeTypeData%x_eig_phase,3) - i3_u = UBOUND(SrcVTK_ModeShapeTypeData%x_eig_phase,3) - IF (.NOT. ALLOCATED(DstVTK_ModeShapeTypeData%x_eig_phase)) THEN - ALLOCATE(DstVTK_ModeShapeTypeData%x_eig_phase(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_ModeShapeTypeData%x_eig_phase.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstVTK_ModeShapeTypeData%x_eig_phase = SrcVTK_ModeShapeTypeData%x_eig_phase -ENDIF - END SUBROUTINE FAST_CopyVTK_ModeShapeType - - SUBROUTINE FAST_DestroyVTK_ModeShapeType( VTK_ModeShapeTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(FAST_VTK_ModeShapeType), INTENT(INOUT) :: VTK_ModeShapeTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyVTK_ModeShapeType' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(VTK_ModeShapeTypeData%VTKModes)) THEN - DEALLOCATE(VTK_ModeShapeTypeData%VTKModes) -ENDIF -IF (ALLOCATED(VTK_ModeShapeTypeData%DampingRatio)) THEN - DEALLOCATE(VTK_ModeShapeTypeData%DampingRatio) -ENDIF -IF (ALLOCATED(VTK_ModeShapeTypeData%NaturalFreq_Hz)) THEN - DEALLOCATE(VTK_ModeShapeTypeData%NaturalFreq_Hz) -ENDIF -IF (ALLOCATED(VTK_ModeShapeTypeData%DampedFreq_Hz)) THEN - DEALLOCATE(VTK_ModeShapeTypeData%DampedFreq_Hz) -ENDIF -IF (ALLOCATED(VTK_ModeShapeTypeData%x_eig_magnitude)) THEN - DEALLOCATE(VTK_ModeShapeTypeData%x_eig_magnitude) -ENDIF -IF (ALLOCATED(VTK_ModeShapeTypeData%x_eig_phase)) THEN - DEALLOCATE(VTK_ModeShapeTypeData%x_eig_phase) -ENDIF - END SUBROUTINE FAST_DestroyVTK_ModeShapeType - - SUBROUTINE FAST_PackVTK_ModeShapeType( 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(FAST_VTK_ModeShapeType), 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 = 'FAST_PackVTK_ModeShapeType' - ! 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%CheckpointRoot) ! CheckpointRoot - Int_BufSz = Int_BufSz + 1*LEN(InData%MatlabFileName) ! MatlabFileName - Int_BufSz = Int_BufSz + 1 ! VTKLinModes - Int_BufSz = Int_BufSz + 1 ! VTKModes allocated yes/no - IF ( ALLOCATED(InData%VTKModes) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! VTKModes upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%VTKModes) ! VTKModes - END IF - Int_BufSz = Int_BufSz + 1 ! VTKLinTim - Int_BufSz = Int_BufSz + 1 ! VTKNLinTimes - Re_BufSz = Re_BufSz + 1 ! VTKLinScale - Re_BufSz = Re_BufSz + 1 ! VTKLinPhase - Int_BufSz = Int_BufSz + 1 ! DampingRatio allocated yes/no - IF ( ALLOCATED(InData%DampingRatio) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! DampingRatio upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%DampingRatio) ! DampingRatio - END IF - Int_BufSz = Int_BufSz + 1 ! NaturalFreq_Hz allocated yes/no - IF ( ALLOCATED(InData%NaturalFreq_Hz) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! NaturalFreq_Hz upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%NaturalFreq_Hz) ! NaturalFreq_Hz - END IF - Int_BufSz = Int_BufSz + 1 ! DampedFreq_Hz allocated yes/no - IF ( ALLOCATED(InData%DampedFreq_Hz) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! DampedFreq_Hz upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%DampedFreq_Hz) ! DampedFreq_Hz - END IF - Int_BufSz = Int_BufSz + 1 ! x_eig_magnitude allocated yes/no - IF ( ALLOCATED(InData%x_eig_magnitude) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! x_eig_magnitude upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%x_eig_magnitude) ! x_eig_magnitude - END IF - Int_BufSz = Int_BufSz + 1 ! x_eig_phase allocated yes/no - IF ( ALLOCATED(InData%x_eig_phase) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! x_eig_phase upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%x_eig_phase) ! x_eig_phase - 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%CheckpointRoot) - IntKiBuf(Int_Xferred) = ICHAR(InData%CheckpointRoot(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%MatlabFileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%MatlabFileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = InData%VTKLinModes - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%VTKModes) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%VTKModes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VTKModes,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%VTKModes,1), UBOUND(InData%VTKModes,1) - IntKiBuf(Int_Xferred) = InData%VTKModes(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%VTKLinTim - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%VTKNLinTimes - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%VTKLinScale - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%VTKLinPhase - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%DampingRatio) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DampingRatio,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DampingRatio,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%DampingRatio,1), UBOUND(InData%DampingRatio,1) - DbKiBuf(Db_Xferred) = InData%DampingRatio(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%NaturalFreq_Hz) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%NaturalFreq_Hz,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NaturalFreq_Hz,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%NaturalFreq_Hz,1), UBOUND(InData%NaturalFreq_Hz,1) - DbKiBuf(Db_Xferred) = InData%NaturalFreq_Hz(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%DampedFreq_Hz) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DampedFreq_Hz,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DampedFreq_Hz,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%DampedFreq_Hz,1), UBOUND(InData%DampedFreq_Hz,1) - DbKiBuf(Db_Xferred) = InData%DampedFreq_Hz(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%x_eig_magnitude) ) THEN - 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_eig_magnitude,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x_eig_magnitude,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%x_eig_magnitude,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x_eig_magnitude,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%x_eig_magnitude,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x_eig_magnitude,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%x_eig_magnitude,3), UBOUND(InData%x_eig_magnitude,3) - DO i2 = LBOUND(InData%x_eig_magnitude,2), UBOUND(InData%x_eig_magnitude,2) - DO i1 = LBOUND(InData%x_eig_magnitude,1), UBOUND(InData%x_eig_magnitude,1) - DbKiBuf(Db_Xferred) = InData%x_eig_magnitude(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%x_eig_phase) ) THEN - 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_eig_phase,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x_eig_phase,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%x_eig_phase,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x_eig_phase,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%x_eig_phase,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x_eig_phase,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%x_eig_phase,3), UBOUND(InData%x_eig_phase,3) - DO i2 = LBOUND(InData%x_eig_phase,2), UBOUND(InData%x_eig_phase,2) - DO i1 = LBOUND(InData%x_eig_phase,1), UBOUND(InData%x_eig_phase,1) - DbKiBuf(Db_Xferred) = InData%x_eig_phase(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - END SUBROUTINE FAST_PackVTK_ModeShapeType - - SUBROUTINE FAST_UnPackVTK_ModeShapeType( 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(FAST_VTK_ModeShapeType), 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 = 'FAST_UnPackVTK_ModeShapeType' - ! 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%CheckpointRoot) - OutData%CheckpointRoot(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%MatlabFileName) - OutData%MatlabFileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%VTKLinModes = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! VTKModes not allocated - Int_Xferred = Int_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%VTKModes)) DEALLOCATE(OutData%VTKModes) - ALLOCATE(OutData%VTKModes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%VTKModes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%VTKModes,1), UBOUND(OutData%VTKModes,1) - OutData%VTKModes(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - OutData%VTKLinTim = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%VTKNLinTimes = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%VTKLinScale = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%VTKLinPhase = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DampingRatio not allocated - Int_Xferred = Int_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%DampingRatio)) DEALLOCATE(OutData%DampingRatio) - ALLOCATE(OutData%DampingRatio(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DampingRatio.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%DampingRatio,1), UBOUND(OutData%DampingRatio,1) - OutData%DampingRatio(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NaturalFreq_Hz not allocated - Int_Xferred = Int_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%NaturalFreq_Hz)) DEALLOCATE(OutData%NaturalFreq_Hz) - ALLOCATE(OutData%NaturalFreq_Hz(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NaturalFreq_Hz.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%NaturalFreq_Hz,1), UBOUND(OutData%NaturalFreq_Hz,1) - OutData%NaturalFreq_Hz(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DampedFreq_Hz not allocated - Int_Xferred = Int_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%DampedFreq_Hz)) DEALLOCATE(OutData%DampedFreq_Hz) - ALLOCATE(OutData%DampedFreq_Hz(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DampedFreq_Hz.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%DampedFreq_Hz,1), UBOUND(OutData%DampedFreq_Hz,1) - OutData%DampedFreq_Hz(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! x_eig_magnitude not allocated - Int_Xferred = Int_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%x_eig_magnitude)) DEALLOCATE(OutData%x_eig_magnitude) - ALLOCATE(OutData%x_eig_magnitude(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%x_eig_magnitude.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%x_eig_magnitude,3), UBOUND(OutData%x_eig_magnitude,3) - DO i2 = LBOUND(OutData%x_eig_magnitude,2), UBOUND(OutData%x_eig_magnitude,2) - DO i1 = LBOUND(OutData%x_eig_magnitude,1), UBOUND(OutData%x_eig_magnitude,1) - OutData%x_eig_magnitude(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! x_eig_phase not allocated - Int_Xferred = Int_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%x_eig_phase)) DEALLOCATE(OutData%x_eig_phase) - ALLOCATE(OutData%x_eig_phase(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%x_eig_phase.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%x_eig_phase,3), UBOUND(OutData%x_eig_phase,3) - DO i2 = LBOUND(OutData%x_eig_phase,2), UBOUND(OutData%x_eig_phase,2) - DO i1 = LBOUND(OutData%x_eig_phase,1), UBOUND(OutData%x_eig_phase,1) - OutData%x_eig_phase(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - END SUBROUTINE FAST_UnPackVTK_ModeShapeType - - SUBROUTINE FAST_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FAST_ParameterType), INTENT(IN) :: SrcParamData - TYPE(FAST_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 = 'FAST_CopyParam' -! + ErrMsg = '' + if (allocated(VTK_BLSurfaceTypeData%AirfoilCoords)) then + deallocate(VTK_BLSurfaceTypeData%AirfoilCoords) + end if +end subroutine + +subroutine FAST_PackVTK_BLSurfaceType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(FAST_VTK_BLSurfaceType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackVTK_BLSurfaceType' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%AirfoilCoords) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FAST_UnPackVTK_BLSurfaceType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(FAST_VTK_BLSurfaceType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackVTK_BLSurfaceType' + integer(B4Ki) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%AirfoilCoords); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FAST_CopyVTK_SurfaceType(SrcVTK_SurfaceTypeData, DstVTK_SurfaceTypeData, CtrlCode, ErrStat, ErrMsg) + type(FAST_VTK_SurfaceType), intent(in) :: SrcVTK_SurfaceTypeData + type(FAST_VTK_SurfaceType), intent(inout) :: DstVTK_SurfaceTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_CopyVTK_SurfaceType' ErrStat = ErrID_None - ErrMsg = "" - DstParamData%DT = SrcParamData%DT - DstParamData%DT_module = SrcParamData%DT_module - DstParamData%n_substeps = SrcParamData%n_substeps - DstParamData%n_TMax_m1 = SrcParamData%n_TMax_m1 - DstParamData%TMax = SrcParamData%TMax - DstParamData%InterpOrder = SrcParamData%InterpOrder - DstParamData%NumCrctn = SrcParamData%NumCrctn - DstParamData%KMax = SrcParamData%KMax - DstParamData%numIceLegs = SrcParamData%numIceLegs - DstParamData%nBeams = SrcParamData%nBeams - DstParamData%BD_OutputSibling = SrcParamData%BD_OutputSibling - DstParamData%ModuleInitialized = SrcParamData%ModuleInitialized - DstParamData%DT_Ujac = SrcParamData%DT_Ujac - DstParamData%UJacSclFact = SrcParamData%UJacSclFact - DstParamData%SizeJac_Opt1 = SrcParamData%SizeJac_Opt1 - DstParamData%CompElast = SrcParamData%CompElast - DstParamData%CompInflow = SrcParamData%CompInflow - DstParamData%CompAero = SrcParamData%CompAero - DstParamData%CompServo = SrcParamData%CompServo - DstParamData%CompHydro = SrcParamData%CompHydro - DstParamData%CompSub = SrcParamData%CompSub - DstParamData%CompMooring = SrcParamData%CompMooring - DstParamData%CompIce = SrcParamData%CompIce - DstParamData%MHK = SrcParamData%MHK - DstParamData%UseDWM = SrcParamData%UseDWM - DstParamData%Linearize = SrcParamData%Linearize - DstParamData%WaveFieldMod = SrcParamData%WaveFieldMod - DstParamData%FarmIntegration = SrcParamData%FarmIntegration - DstParamData%TurbinePos = SrcParamData%TurbinePos - DstParamData%Gravity = SrcParamData%Gravity - DstParamData%AirDens = SrcParamData%AirDens - DstParamData%WtrDens = SrcParamData%WtrDens - DstParamData%KinVisc = SrcParamData%KinVisc - DstParamData%SpdSound = SrcParamData%SpdSound - DstParamData%Patm = SrcParamData%Patm - DstParamData%Pvap = SrcParamData%Pvap - DstParamData%WtrDpth = SrcParamData%WtrDpth - DstParamData%MSL2SWL = SrcParamData%MSL2SWL - DstParamData%EDFile = SrcParamData%EDFile - DstParamData%BDBldFile = SrcParamData%BDBldFile - DstParamData%InflowFile = SrcParamData%InflowFile - DstParamData%AeroFile = SrcParamData%AeroFile - DstParamData%ServoFile = SrcParamData%ServoFile - DstParamData%HydroFile = SrcParamData%HydroFile - DstParamData%SubFile = SrcParamData%SubFile - DstParamData%MooringFile = SrcParamData%MooringFile - DstParamData%IceFile = SrcParamData%IceFile - DstParamData%TStart = SrcParamData%TStart - DstParamData%DT_Out = SrcParamData%DT_Out - DstParamData%WrSttsTime = SrcParamData%WrSttsTime - DstParamData%n_SttsTime = SrcParamData%n_SttsTime - DstParamData%n_ChkptTime = SrcParamData%n_ChkptTime - DstParamData%n_DT_Out = SrcParamData%n_DT_Out - DstParamData%n_VTKTime = SrcParamData%n_VTKTime - DstParamData%TurbineType = SrcParamData%TurbineType - DstParamData%WrBinOutFile = SrcParamData%WrBinOutFile - DstParamData%WrTxtOutFile = SrcParamData%WrTxtOutFile - DstParamData%WrBinMod = SrcParamData%WrBinMod - DstParamData%SumPrint = SrcParamData%SumPrint - DstParamData%WrVTK = SrcParamData%WrVTK - DstParamData%VTK_Type = SrcParamData%VTK_Type - DstParamData%VTK_fields = SrcParamData%VTK_fields - DstParamData%Delim = SrcParamData%Delim - DstParamData%OutFmt = SrcParamData%OutFmt - DstParamData%OutFmt_t = SrcParamData%OutFmt_t - DstParamData%FmtWidth = SrcParamData%FmtWidth - DstParamData%TChanLen = SrcParamData%TChanLen - DstParamData%OutFileRoot = SrcParamData%OutFileRoot - DstParamData%FTitle = SrcParamData%FTitle - DstParamData%VTK_OutFileRoot = SrcParamData%VTK_OutFileRoot - DstParamData%VTK_tWidth = SrcParamData%VTK_tWidth - DstParamData%VTK_fps = SrcParamData%VTK_fps - CALL FAST_Copyvtk_surfacetype( SrcParamData%VTK_surface, DstParamData%VTK_surface, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstParamData%Tdesc = SrcParamData%Tdesc - DstParamData%CalcSteady = SrcParamData%CalcSteady - DstParamData%TrimCase = SrcParamData%TrimCase - DstParamData%TrimTol = SrcParamData%TrimTol - DstParamData%TrimGain = SrcParamData%TrimGain - DstParamData%Twr_Kdmp = SrcParamData%Twr_Kdmp - DstParamData%Bld_Kdmp = SrcParamData%Bld_Kdmp - DstParamData%NLinTimes = SrcParamData%NLinTimes - DstParamData%AzimDelta = SrcParamData%AzimDelta - DstParamData%LinInputs = SrcParamData%LinInputs - DstParamData%LinOutputs = SrcParamData%LinOutputs - DstParamData%LinOutJac = SrcParamData%LinOutJac - DstParamData%LinOutMod = SrcParamData%LinOutMod - CALL FAST_Copyvtk_modeshapetype( SrcParamData%VTK_modes, DstParamData%VTK_modes, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstParamData%UseSC = SrcParamData%UseSC - DstParamData%Lin_NumMods = SrcParamData%Lin_NumMods - DstParamData%Lin_ModOrder = SrcParamData%Lin_ModOrder - DstParamData%LinInterpOrder = SrcParamData%LinInterpOrder - END SUBROUTINE FAST_CopyParam - - SUBROUTINE FAST_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(FAST_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL FAST_Destroyvtk_surfacetype( ParamData%VTK_surface, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FAST_Destroyvtk_modeshapetype( ParamData%VTK_modes, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE FAST_DestroyParam - - SUBROUTINE FAST_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(FAST_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 = 'FAST_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 + SIZE(InData%DT_module) ! DT_module - Int_BufSz = Int_BufSz + SIZE(InData%n_substeps) ! n_substeps - Int_BufSz = Int_BufSz + 1 ! n_TMax_m1 - Db_BufSz = Db_BufSz + 1 ! TMax - Int_BufSz = Int_BufSz + 1 ! InterpOrder - Int_BufSz = Int_BufSz + 1 ! NumCrctn - Int_BufSz = Int_BufSz + 1 ! KMax - Int_BufSz = Int_BufSz + 1 ! numIceLegs - Int_BufSz = Int_BufSz + 1 ! nBeams - Int_BufSz = Int_BufSz + 1 ! BD_OutputSibling - Int_BufSz = Int_BufSz + SIZE(InData%ModuleInitialized) ! ModuleInitialized - Db_BufSz = Db_BufSz + 1 ! DT_Ujac - Re_BufSz = Re_BufSz + 1 ! UJacSclFact - Int_BufSz = Int_BufSz + SIZE(InData%SizeJac_Opt1) ! SizeJac_Opt1 - Int_BufSz = Int_BufSz + 1 ! CompElast - Int_BufSz = Int_BufSz + 1 ! CompInflow - Int_BufSz = Int_BufSz + 1 ! CompAero - Int_BufSz = Int_BufSz + 1 ! CompServo - Int_BufSz = Int_BufSz + 1 ! CompHydro - Int_BufSz = Int_BufSz + 1 ! CompSub - Int_BufSz = Int_BufSz + 1 ! CompMooring - Int_BufSz = Int_BufSz + 1 ! CompIce - Int_BufSz = Int_BufSz + 1 ! MHK - Int_BufSz = Int_BufSz + 1 ! UseDWM - Int_BufSz = Int_BufSz + 1 ! Linearize - Int_BufSz = Int_BufSz + 1 ! WaveFieldMod - Int_BufSz = Int_BufSz + 1 ! FarmIntegration - Re_BufSz = Re_BufSz + SIZE(InData%TurbinePos) ! TurbinePos - Re_BufSz = Re_BufSz + 1 ! Gravity - Re_BufSz = Re_BufSz + 1 ! AirDens - Re_BufSz = Re_BufSz + 1 ! WtrDens - Re_BufSz = Re_BufSz + 1 ! KinVisc - Re_BufSz = Re_BufSz + 1 ! SpdSound - Re_BufSz = Re_BufSz + 1 ! Patm - Re_BufSz = Re_BufSz + 1 ! Pvap - Re_BufSz = Re_BufSz + 1 ! WtrDpth - Re_BufSz = Re_BufSz + 1 ! MSL2SWL - Int_BufSz = Int_BufSz + 1*LEN(InData%EDFile) ! EDFile - Int_BufSz = Int_BufSz + SIZE(InData%BDBldFile)*LEN(InData%BDBldFile) ! BDBldFile - Int_BufSz = Int_BufSz + 1*LEN(InData%InflowFile) ! InflowFile - Int_BufSz = Int_BufSz + 1*LEN(InData%AeroFile) ! AeroFile - Int_BufSz = Int_BufSz + 1*LEN(InData%ServoFile) ! ServoFile - Int_BufSz = Int_BufSz + 1*LEN(InData%HydroFile) ! HydroFile - Int_BufSz = Int_BufSz + 1*LEN(InData%SubFile) ! SubFile - Int_BufSz = Int_BufSz + 1*LEN(InData%MooringFile) ! MooringFile - Int_BufSz = Int_BufSz + 1*LEN(InData%IceFile) ! IceFile - Db_BufSz = Db_BufSz + 1 ! TStart - Db_BufSz = Db_BufSz + 1 ! DT_Out - Int_BufSz = Int_BufSz + 1 ! WrSttsTime - Int_BufSz = Int_BufSz + 1 ! n_SttsTime - Int_BufSz = Int_BufSz + 1 ! n_ChkptTime - Int_BufSz = Int_BufSz + 1 ! n_DT_Out - Int_BufSz = Int_BufSz + 1 ! n_VTKTime - Int_BufSz = Int_BufSz + 1 ! TurbineType - Int_BufSz = Int_BufSz + 1 ! WrBinOutFile - Int_BufSz = Int_BufSz + 1 ! WrTxtOutFile - Int_BufSz = Int_BufSz + 1 ! WrBinMod - Int_BufSz = Int_BufSz + 1 ! SumPrint - Int_BufSz = Int_BufSz + 1 ! WrVTK - Int_BufSz = Int_BufSz + 1 ! VTK_Type - Int_BufSz = Int_BufSz + 1 ! VTK_fields - 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%OutFmt_t) ! OutFmt_t - Int_BufSz = Int_BufSz + 1 ! FmtWidth - Int_BufSz = Int_BufSz + 1 ! TChanLen - Int_BufSz = Int_BufSz + 1*LEN(InData%OutFileRoot) ! OutFileRoot - Int_BufSz = Int_BufSz + 1*LEN(InData%FTitle) ! FTitle - Int_BufSz = Int_BufSz + 1*LEN(InData%VTK_OutFileRoot) ! VTK_OutFileRoot - Int_BufSz = Int_BufSz + 1 ! VTK_tWidth - Db_BufSz = Db_BufSz + 1 ! VTK_fps - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! VTK_surface: size of buffers for each call to pack subtype - CALL FAST_Packvtk_surfacetype( Re_Buf, Db_Buf, Int_Buf, InData%VTK_surface, ErrStat2, ErrMsg2, .TRUE. ) ! VTK_surface - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! VTK_surface - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! VTK_surface - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! VTK_surface - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1*LEN(InData%Tdesc) ! Tdesc - Int_BufSz = Int_BufSz + 1 ! CalcSteady - Int_BufSz = Int_BufSz + 1 ! TrimCase - Re_BufSz = Re_BufSz + 1 ! TrimTol - Re_BufSz = Re_BufSz + 1 ! TrimGain - Re_BufSz = Re_BufSz + 1 ! Twr_Kdmp - Re_BufSz = Re_BufSz + 1 ! Bld_Kdmp - Int_BufSz = Int_BufSz + 1 ! NLinTimes - Db_BufSz = Db_BufSz + 1 ! AzimDelta - Int_BufSz = Int_BufSz + 1 ! LinInputs - Int_BufSz = Int_BufSz + 1 ! LinOutputs - Int_BufSz = Int_BufSz + 1 ! LinOutJac - Int_BufSz = Int_BufSz + 1 ! LinOutMod - Int_BufSz = Int_BufSz + 3 ! VTK_modes: size of buffers for each call to pack subtype - CALL FAST_Packvtk_modeshapetype( Re_Buf, Db_Buf, Int_Buf, InData%VTK_modes, ErrStat2, ErrMsg2, .TRUE. ) ! VTK_modes - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! VTK_modes - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! VTK_modes - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! VTK_modes - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! UseSC - Int_BufSz = Int_BufSz + 1 ! Lin_NumMods - Int_BufSz = Int_BufSz + SIZE(InData%Lin_ModOrder) ! Lin_ModOrder - Int_BufSz = Int_BufSz + 1 ! LinInterpOrder - 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 i1 = LBOUND(InData%DT_module,1), UBOUND(InData%DT_module,1) - DbKiBuf(Db_Xferred) = InData%DT_module(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%n_substeps,1), UBOUND(InData%n_substeps,1) - IntKiBuf(Int_Xferred) = InData%n_substeps(i1) - Int_Xferred = Int_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%n_TMax_m1 - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%TMax - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%InterpOrder - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumCrctn - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%KMax - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%numIceLegs - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nBeams - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%BD_OutputSibling, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%ModuleInitialized,1), UBOUND(InData%ModuleInitialized,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%ModuleInitialized(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - DbKiBuf(Db_Xferred) = InData%DT_Ujac - Db_Xferred = Db_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%UJacSclFact - Re_Xferred = Re_Xferred + 1 - DO i1 = LBOUND(InData%SizeJac_Opt1,1), UBOUND(InData%SizeJac_Opt1,1) - IntKiBuf(Int_Xferred) = InData%SizeJac_Opt1(i1) - Int_Xferred = Int_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%CompElast - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%CompInflow - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%CompAero - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%CompServo - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%CompHydro - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%CompSub - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%CompMooring - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%CompIce - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%MHK - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%UseDWM, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%Linearize, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%WaveFieldMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%FarmIntegration, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%TurbinePos,1), UBOUND(InData%TurbinePos,1) - ReKiBuf(Re_Xferred) = InData%TurbinePos(i1) - Re_Xferred = Re_Xferred + 1 - END DO - ReKiBuf(Re_Xferred) = InData%Gravity - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%AirDens - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WtrDens - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%KinVisc - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%SpdSound - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Patm - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Pvap - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WtrDpth - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MSL2SWL - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(InData%EDFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%EDFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO i1 = LBOUND(InData%BDBldFile,1), UBOUND(InData%BDBldFile,1) - DO I = 1, LEN(InData%BDBldFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%BDBldFile(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - DO I = 1, LEN(InData%InflowFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%InflowFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%AeroFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%AeroFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%ServoFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%ServoFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%HydroFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%HydroFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%SubFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%SubFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%MooringFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%MooringFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%IceFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%IceFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DbKiBuf(Db_Xferred) = InData%TStart - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%DT_Out - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%WrSttsTime, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%n_SttsTime - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%n_ChkptTime - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%n_DT_Out - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%n_VTKTime - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%TurbineType - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%WrBinOutFile, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%WrTxtOutFile, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%WrBinMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%SumPrint, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%WrVTK - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%VTK_Type - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%VTK_fields, IntKiBuf(1)) - 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%OutFmt_t) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt_t(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = InData%FmtWidth - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%TChanLen - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%OutFileRoot) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutFileRoot(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%FTitle) - IntKiBuf(Int_Xferred) = ICHAR(InData%FTitle(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%VTK_OutFileRoot) - IntKiBuf(Int_Xferred) = ICHAR(InData%VTK_OutFileRoot(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = InData%VTK_tWidth - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%VTK_fps - Db_Xferred = Db_Xferred + 1 - CALL FAST_Packvtk_surfacetype( Re_Buf, Db_Buf, Int_Buf, InData%VTK_surface, ErrStat2, ErrMsg2, OnlySize ) ! VTK_surface - 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%Tdesc) - IntKiBuf(Int_Xferred) = ICHAR(InData%Tdesc(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = TRANSFER(InData%CalcSteady, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%TrimCase - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TrimTol - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TrimGain - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Twr_Kdmp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Bld_Kdmp - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NLinTimes - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%AzimDelta - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%LinInputs - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%LinOutputs - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%LinOutJac, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%LinOutMod, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - CALL FAST_Packvtk_modeshapetype( Re_Buf, Db_Buf, Int_Buf, InData%VTK_modes, ErrStat2, ErrMsg2, OnlySize ) ! VTK_modes - 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%UseSC, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%Lin_NumMods - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%Lin_ModOrder,1), UBOUND(InData%Lin_ModOrder,1) - IntKiBuf(Int_Xferred) = InData%Lin_ModOrder(i1) - Int_Xferred = Int_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%LinInterpOrder - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE FAST_PackParam - - SUBROUTINE FAST_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(FAST_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 = 'FAST_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 - i1_l = LBOUND(OutData%DT_module,1) - i1_u = UBOUND(OutData%DT_module,1) - DO i1 = LBOUND(OutData%DT_module,1), UBOUND(OutData%DT_module,1) - OutData%DT_module(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%n_substeps,1) - i1_u = UBOUND(OutData%n_substeps,1) - DO i1 = LBOUND(OutData%n_substeps,1), UBOUND(OutData%n_substeps,1) - OutData%n_substeps(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - OutData%n_TMax_m1 = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TMax = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%InterpOrder = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumCrctn = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%KMax = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%numIceLegs = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nBeams = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%BD_OutputSibling = TRANSFER(IntKiBuf(Int_Xferred), OutData%BD_OutputSibling) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%ModuleInitialized,1) - i1_u = UBOUND(OutData%ModuleInitialized,1) - DO i1 = LBOUND(OutData%ModuleInitialized,1), UBOUND(OutData%ModuleInitialized,1) - OutData%ModuleInitialized(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%ModuleInitialized(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - OutData%DT_Ujac = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%UJacSclFact = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%SizeJac_Opt1,1) - i1_u = UBOUND(OutData%SizeJac_Opt1,1) - DO i1 = LBOUND(OutData%SizeJac_Opt1,1), UBOUND(OutData%SizeJac_Opt1,1) - OutData%SizeJac_Opt1(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - OutData%CompElast = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%CompInflow = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%CompAero = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%CompServo = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%CompHydro = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%CompSub = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%CompMooring = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%CompIce = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%MHK = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%UseDWM = TRANSFER(IntKiBuf(Int_Xferred), OutData%UseDWM) - Int_Xferred = Int_Xferred + 1 - OutData%Linearize = TRANSFER(IntKiBuf(Int_Xferred), OutData%Linearize) - Int_Xferred = Int_Xferred + 1 - OutData%WaveFieldMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%FarmIntegration = TRANSFER(IntKiBuf(Int_Xferred), OutData%FarmIntegration) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%TurbinePos,1) - i1_u = UBOUND(OutData%TurbinePos,1) - DO i1 = LBOUND(OutData%TurbinePos,1), UBOUND(OutData%TurbinePos,1) - OutData%TurbinePos(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%Gravity = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%AirDens = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%WtrDens = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%KinVisc = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SpdSound = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Patm = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Pvap = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%WtrDpth = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MSL2SWL = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(OutData%EDFile) - OutData%EDFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - i1_l = LBOUND(OutData%BDBldFile,1) - i1_u = UBOUND(OutData%BDBldFile,1) - DO i1 = LBOUND(OutData%BDBldFile,1), UBOUND(OutData%BDBldFile,1) - DO I = 1, LEN(OutData%BDBldFile) - OutData%BDBldFile(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - DO I = 1, LEN(OutData%InflowFile) - OutData%InflowFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%AeroFile) - OutData%AeroFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%ServoFile) - OutData%ServoFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%HydroFile) - OutData%HydroFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%SubFile) - OutData%SubFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%MooringFile) - OutData%MooringFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%IceFile) - OutData%IceFile(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%DT_Out = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%WrSttsTime = TRANSFER(IntKiBuf(Int_Xferred), OutData%WrSttsTime) - Int_Xferred = Int_Xferred + 1 - OutData%n_SttsTime = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%n_ChkptTime = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%n_DT_Out = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%n_VTKTime = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TurbineType = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WrBinOutFile = TRANSFER(IntKiBuf(Int_Xferred), OutData%WrBinOutFile) - Int_Xferred = Int_Xferred + 1 - OutData%WrTxtOutFile = TRANSFER(IntKiBuf(Int_Xferred), OutData%WrTxtOutFile) - Int_Xferred = Int_Xferred + 1 - OutData%WrBinMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%SumPrint = TRANSFER(IntKiBuf(Int_Xferred), OutData%SumPrint) - Int_Xferred = Int_Xferred + 1 - OutData%WrVTK = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%VTK_Type = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%VTK_fields = TRANSFER(IntKiBuf(Int_Xferred), OutData%VTK_fields) - 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%OutFmt_t) - OutData%OutFmt_t(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%FmtWidth = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TChanLen = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%OutFileRoot) - OutData%OutFileRoot(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%FTitle) - OutData%FTitle(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%VTK_OutFileRoot) - OutData%VTK_OutFileRoot(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%VTK_tWidth = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%VTK_fps = 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 FAST_Unpackvtk_surfacetype( Re_Buf, Db_Buf, Int_Buf, OutData%VTK_surface, ErrStat2, ErrMsg2 ) ! VTK_surface - 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%Tdesc) - OutData%Tdesc(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%CalcSteady = TRANSFER(IntKiBuf(Int_Xferred), OutData%CalcSteady) - Int_Xferred = Int_Xferred + 1 - OutData%TrimCase = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TrimTol = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TrimGain = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Twr_Kdmp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Bld_Kdmp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NLinTimes = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%AzimDelta = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%LinInputs = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%LinOutputs = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%LinOutJac = TRANSFER(IntKiBuf(Int_Xferred), OutData%LinOutJac) - Int_Xferred = Int_Xferred + 1 - OutData%LinOutMod = TRANSFER(IntKiBuf(Int_Xferred), OutData%LinOutMod) - 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 FAST_Unpackvtk_modeshapetype( Re_Buf, Db_Buf, Int_Buf, OutData%VTK_modes, ErrStat2, ErrMsg2 ) ! VTK_modes - 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%UseSC = TRANSFER(IntKiBuf(Int_Xferred), OutData%UseSC) - Int_Xferred = Int_Xferred + 1 - OutData%Lin_NumMods = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%Lin_ModOrder,1) - i1_u = UBOUND(OutData%Lin_ModOrder,1) - DO i1 = LBOUND(OutData%Lin_ModOrder,1), UBOUND(OutData%Lin_ModOrder,1) - OutData%Lin_ModOrder(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - OutData%LinInterpOrder = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE FAST_UnPackParam - - SUBROUTINE FAST_CopyLinStateSave( SrcLinStateSaveData, DstLinStateSaveData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FAST_LinStateSave), INTENT(INOUT) :: SrcLinStateSaveData - TYPE(FAST_LinStateSave), INTENT(INOUT) :: DstLinStateSaveData - 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 = 'FAST_CopyLinStateSave' -! + ErrMsg = '' + DstVTK_SurfaceTypeData%NumSectors = SrcVTK_SurfaceTypeData%NumSectors + DstVTK_SurfaceTypeData%HubRad = SrcVTK_SurfaceTypeData%HubRad + DstVTK_SurfaceTypeData%GroundRad = SrcVTK_SurfaceTypeData%GroundRad + DstVTK_SurfaceTypeData%NacelleBox = SrcVTK_SurfaceTypeData%NacelleBox + if (allocated(SrcVTK_SurfaceTypeData%TowerRad)) then + LB(1:1) = lbound(SrcVTK_SurfaceTypeData%TowerRad) + UB(1:1) = ubound(SrcVTK_SurfaceTypeData%TowerRad) + if (.not. allocated(DstVTK_SurfaceTypeData%TowerRad)) then + allocate(DstVTK_SurfaceTypeData%TowerRad(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_SurfaceTypeData%TowerRad.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstVTK_SurfaceTypeData%TowerRad = SrcVTK_SurfaceTypeData%TowerRad + end if + DstVTK_SurfaceTypeData%NWaveElevPts = SrcVTK_SurfaceTypeData%NWaveElevPts + if (allocated(SrcVTK_SurfaceTypeData%WaveElevVisX)) then + LB(1:1) = lbound(SrcVTK_SurfaceTypeData%WaveElevVisX) + UB(1:1) = ubound(SrcVTK_SurfaceTypeData%WaveElevVisX) + if (.not. allocated(DstVTK_SurfaceTypeData%WaveElevVisX)) then + allocate(DstVTK_SurfaceTypeData%WaveElevVisX(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_SurfaceTypeData%WaveElevVisX.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstVTK_SurfaceTypeData%WaveElevVisX = SrcVTK_SurfaceTypeData%WaveElevVisX + end if + if (allocated(SrcVTK_SurfaceTypeData%WaveElevVisY)) then + LB(1:1) = lbound(SrcVTK_SurfaceTypeData%WaveElevVisY) + UB(1:1) = ubound(SrcVTK_SurfaceTypeData%WaveElevVisY) + if (.not. allocated(DstVTK_SurfaceTypeData%WaveElevVisY)) then + allocate(DstVTK_SurfaceTypeData%WaveElevVisY(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_SurfaceTypeData%WaveElevVisY.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstVTK_SurfaceTypeData%WaveElevVisY = SrcVTK_SurfaceTypeData%WaveElevVisY + end if + if (allocated(SrcVTK_SurfaceTypeData%WaveElevVisGrid)) then + LB(1:3) = lbound(SrcVTK_SurfaceTypeData%WaveElevVisGrid) + UB(1:3) = ubound(SrcVTK_SurfaceTypeData%WaveElevVisGrid) + if (.not. allocated(DstVTK_SurfaceTypeData%WaveElevVisGrid)) then + allocate(DstVTK_SurfaceTypeData%WaveElevVisGrid(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_SurfaceTypeData%WaveElevVisGrid.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstVTK_SurfaceTypeData%WaveElevVisGrid = SrcVTK_SurfaceTypeData%WaveElevVisGrid + end if + if (allocated(SrcVTK_SurfaceTypeData%BladeShape)) then + LB(1:1) = lbound(SrcVTK_SurfaceTypeData%BladeShape) + UB(1:1) = ubound(SrcVTK_SurfaceTypeData%BladeShape) + if (.not. allocated(DstVTK_SurfaceTypeData%BladeShape)) then + allocate(DstVTK_SurfaceTypeData%BladeShape(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_SurfaceTypeData%BladeShape.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call FAST_CopyVTK_BLSurfaceType(SrcVTK_SurfaceTypeData%BladeShape(i1), DstVTK_SurfaceTypeData%BladeShape(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcVTK_SurfaceTypeData%MorisonVisRad)) then + LB(1:1) = lbound(SrcVTK_SurfaceTypeData%MorisonVisRad) + UB(1:1) = ubound(SrcVTK_SurfaceTypeData%MorisonVisRad) + if (.not. allocated(DstVTK_SurfaceTypeData%MorisonVisRad)) then + allocate(DstVTK_SurfaceTypeData%MorisonVisRad(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_SurfaceTypeData%MorisonVisRad.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstVTK_SurfaceTypeData%MorisonVisRad = SrcVTK_SurfaceTypeData%MorisonVisRad + end if +end subroutine + +subroutine FAST_DestroyVTK_SurfaceType(VTK_SurfaceTypeData, ErrStat, ErrMsg) + type(FAST_VTK_SurfaceType), intent(inout) :: VTK_SurfaceTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_DestroyVTK_SurfaceType' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcLinStateSaveData%x_IceD)) THEN - i1_l = LBOUND(SrcLinStateSaveData%x_IceD,1) - i1_u = UBOUND(SrcLinStateSaveData%x_IceD,1) - i2_l = LBOUND(SrcLinStateSaveData%x_IceD,2) - i2_u = UBOUND(SrcLinStateSaveData%x_IceD,2) - IF (.NOT. ALLOCATED(DstLinStateSaveData%x_IceD)) THEN - ALLOCATE(DstLinStateSaveData%x_IceD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_IceD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcLinStateSaveData%x_IceD,2), UBOUND(SrcLinStateSaveData%x_IceD,2) - DO i1 = LBOUND(SrcLinStateSaveData%x_IceD,1), UBOUND(SrcLinStateSaveData%x_IceD,1) - CALL IceD_CopyContState( SrcLinStateSaveData%x_IceD(i1,i2), DstLinStateSaveData%x_IceD(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%xd_IceD)) THEN - i1_l = LBOUND(SrcLinStateSaveData%xd_IceD,1) - i1_u = UBOUND(SrcLinStateSaveData%xd_IceD,1) - i2_l = LBOUND(SrcLinStateSaveData%xd_IceD,2) - i2_u = UBOUND(SrcLinStateSaveData%xd_IceD,2) - IF (.NOT. ALLOCATED(DstLinStateSaveData%xd_IceD)) THEN - ALLOCATE(DstLinStateSaveData%xd_IceD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_IceD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcLinStateSaveData%xd_IceD,2), UBOUND(SrcLinStateSaveData%xd_IceD,2) - DO i1 = LBOUND(SrcLinStateSaveData%xd_IceD,1), UBOUND(SrcLinStateSaveData%xd_IceD,1) - CALL IceD_CopyDiscState( SrcLinStateSaveData%xd_IceD(i1,i2), DstLinStateSaveData%xd_IceD(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%z_IceD)) THEN - i1_l = LBOUND(SrcLinStateSaveData%z_IceD,1) - i1_u = UBOUND(SrcLinStateSaveData%z_IceD,1) - i2_l = LBOUND(SrcLinStateSaveData%z_IceD,2) - i2_u = UBOUND(SrcLinStateSaveData%z_IceD,2) - IF (.NOT. ALLOCATED(DstLinStateSaveData%z_IceD)) THEN - ALLOCATE(DstLinStateSaveData%z_IceD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_IceD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcLinStateSaveData%z_IceD,2), UBOUND(SrcLinStateSaveData%z_IceD,2) - DO i1 = LBOUND(SrcLinStateSaveData%z_IceD,1), UBOUND(SrcLinStateSaveData%z_IceD,1) - CALL IceD_CopyConstrState( SrcLinStateSaveData%z_IceD(i1,i2), DstLinStateSaveData%z_IceD(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%OtherSt_IceD)) THEN - i1_l = LBOUND(SrcLinStateSaveData%OtherSt_IceD,1) - i1_u = UBOUND(SrcLinStateSaveData%OtherSt_IceD,1) - i2_l = LBOUND(SrcLinStateSaveData%OtherSt_IceD,2) - i2_u = UBOUND(SrcLinStateSaveData%OtherSt_IceD,2) - IF (.NOT. ALLOCATED(DstLinStateSaveData%OtherSt_IceD)) THEN - ALLOCATE(DstLinStateSaveData%OtherSt_IceD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_IceD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcLinStateSaveData%OtherSt_IceD,2), UBOUND(SrcLinStateSaveData%OtherSt_IceD,2) - DO i1 = LBOUND(SrcLinStateSaveData%OtherSt_IceD,1), UBOUND(SrcLinStateSaveData%OtherSt_IceD,1) - CALL IceD_CopyOtherState( SrcLinStateSaveData%OtherSt_IceD(i1,i2), DstLinStateSaveData%OtherSt_IceD(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%u_IceD)) THEN - i1_l = LBOUND(SrcLinStateSaveData%u_IceD,1) - i1_u = UBOUND(SrcLinStateSaveData%u_IceD,1) - i2_l = LBOUND(SrcLinStateSaveData%u_IceD,2) - i2_u = UBOUND(SrcLinStateSaveData%u_IceD,2) - IF (.NOT. ALLOCATED(DstLinStateSaveData%u_IceD)) THEN - ALLOCATE(DstLinStateSaveData%u_IceD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_IceD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcLinStateSaveData%u_IceD,2), UBOUND(SrcLinStateSaveData%u_IceD,2) - DO i1 = LBOUND(SrcLinStateSaveData%u_IceD,1), UBOUND(SrcLinStateSaveData%u_IceD,1) - CALL IceD_CopyInput( SrcLinStateSaveData%u_IceD(i1,i2), DstLinStateSaveData%u_IceD(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%x_BD)) THEN - i1_l = LBOUND(SrcLinStateSaveData%x_BD,1) - i1_u = UBOUND(SrcLinStateSaveData%x_BD,1) - i2_l = LBOUND(SrcLinStateSaveData%x_BD,2) - i2_u = UBOUND(SrcLinStateSaveData%x_BD,2) - IF (.NOT. ALLOCATED(DstLinStateSaveData%x_BD)) THEN - ALLOCATE(DstLinStateSaveData%x_BD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_BD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcLinStateSaveData%x_BD,2), UBOUND(SrcLinStateSaveData%x_BD,2) - DO i1 = LBOUND(SrcLinStateSaveData%x_BD,1), UBOUND(SrcLinStateSaveData%x_BD,1) - CALL BD_CopyContState( SrcLinStateSaveData%x_BD(i1,i2), DstLinStateSaveData%x_BD(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%xd_BD)) THEN - i1_l = LBOUND(SrcLinStateSaveData%xd_BD,1) - i1_u = UBOUND(SrcLinStateSaveData%xd_BD,1) - i2_l = LBOUND(SrcLinStateSaveData%xd_BD,2) - i2_u = UBOUND(SrcLinStateSaveData%xd_BD,2) - IF (.NOT. ALLOCATED(DstLinStateSaveData%xd_BD)) THEN - ALLOCATE(DstLinStateSaveData%xd_BD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_BD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcLinStateSaveData%xd_BD,2), UBOUND(SrcLinStateSaveData%xd_BD,2) - DO i1 = LBOUND(SrcLinStateSaveData%xd_BD,1), UBOUND(SrcLinStateSaveData%xd_BD,1) - CALL BD_CopyDiscState( SrcLinStateSaveData%xd_BD(i1,i2), DstLinStateSaveData%xd_BD(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%z_BD)) THEN - i1_l = LBOUND(SrcLinStateSaveData%z_BD,1) - i1_u = UBOUND(SrcLinStateSaveData%z_BD,1) - i2_l = LBOUND(SrcLinStateSaveData%z_BD,2) - i2_u = UBOUND(SrcLinStateSaveData%z_BD,2) - IF (.NOT. ALLOCATED(DstLinStateSaveData%z_BD)) THEN - ALLOCATE(DstLinStateSaveData%z_BD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_BD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcLinStateSaveData%z_BD,2), UBOUND(SrcLinStateSaveData%z_BD,2) - DO i1 = LBOUND(SrcLinStateSaveData%z_BD,1), UBOUND(SrcLinStateSaveData%z_BD,1) - CALL BD_CopyConstrState( SrcLinStateSaveData%z_BD(i1,i2), DstLinStateSaveData%z_BD(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%OtherSt_BD)) THEN - i1_l = LBOUND(SrcLinStateSaveData%OtherSt_BD,1) - i1_u = UBOUND(SrcLinStateSaveData%OtherSt_BD,1) - i2_l = LBOUND(SrcLinStateSaveData%OtherSt_BD,2) - i2_u = UBOUND(SrcLinStateSaveData%OtherSt_BD,2) - IF (.NOT. ALLOCATED(DstLinStateSaveData%OtherSt_BD)) THEN - ALLOCATE(DstLinStateSaveData%OtherSt_BD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_BD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcLinStateSaveData%OtherSt_BD,2), UBOUND(SrcLinStateSaveData%OtherSt_BD,2) - DO i1 = LBOUND(SrcLinStateSaveData%OtherSt_BD,1), UBOUND(SrcLinStateSaveData%OtherSt_BD,1) - CALL BD_CopyOtherState( SrcLinStateSaveData%OtherSt_BD(i1,i2), DstLinStateSaveData%OtherSt_BD(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%u_BD)) THEN - i1_l = LBOUND(SrcLinStateSaveData%u_BD,1) - i1_u = UBOUND(SrcLinStateSaveData%u_BD,1) - i2_l = LBOUND(SrcLinStateSaveData%u_BD,2) - i2_u = UBOUND(SrcLinStateSaveData%u_BD,2) - IF (.NOT. ALLOCATED(DstLinStateSaveData%u_BD)) THEN - ALLOCATE(DstLinStateSaveData%u_BD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_BD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcLinStateSaveData%u_BD,2), UBOUND(SrcLinStateSaveData%u_BD,2) - DO i1 = LBOUND(SrcLinStateSaveData%u_BD,1), UBOUND(SrcLinStateSaveData%u_BD,1) - CALL BD_CopyInput( SrcLinStateSaveData%u_BD(i1,i2), DstLinStateSaveData%u_BD(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%x_ED)) THEN - i1_l = LBOUND(SrcLinStateSaveData%x_ED,1) - i1_u = UBOUND(SrcLinStateSaveData%x_ED,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%x_ED)) THEN - ALLOCATE(DstLinStateSaveData%x_ED(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_ED.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%x_ED,1), UBOUND(SrcLinStateSaveData%x_ED,1) - CALL ED_CopyContState( SrcLinStateSaveData%x_ED(i1), DstLinStateSaveData%x_ED(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%xd_ED)) THEN - i1_l = LBOUND(SrcLinStateSaveData%xd_ED,1) - i1_u = UBOUND(SrcLinStateSaveData%xd_ED,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%xd_ED)) THEN - ALLOCATE(DstLinStateSaveData%xd_ED(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_ED.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%xd_ED,1), UBOUND(SrcLinStateSaveData%xd_ED,1) - CALL ED_CopyDiscState( SrcLinStateSaveData%xd_ED(i1), DstLinStateSaveData%xd_ED(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%z_ED)) THEN - i1_l = LBOUND(SrcLinStateSaveData%z_ED,1) - i1_u = UBOUND(SrcLinStateSaveData%z_ED,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%z_ED)) THEN - ALLOCATE(DstLinStateSaveData%z_ED(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_ED.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%z_ED,1), UBOUND(SrcLinStateSaveData%z_ED,1) - CALL ED_CopyConstrState( SrcLinStateSaveData%z_ED(i1), DstLinStateSaveData%z_ED(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%OtherSt_ED)) THEN - i1_l = LBOUND(SrcLinStateSaveData%OtherSt_ED,1) - i1_u = UBOUND(SrcLinStateSaveData%OtherSt_ED,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%OtherSt_ED)) THEN - ALLOCATE(DstLinStateSaveData%OtherSt_ED(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_ED.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%OtherSt_ED,1), UBOUND(SrcLinStateSaveData%OtherSt_ED,1) - CALL ED_CopyOtherState( SrcLinStateSaveData%OtherSt_ED(i1), DstLinStateSaveData%OtherSt_ED(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%u_ED)) THEN - i1_l = LBOUND(SrcLinStateSaveData%u_ED,1) - i1_u = UBOUND(SrcLinStateSaveData%u_ED,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%u_ED)) THEN - ALLOCATE(DstLinStateSaveData%u_ED(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_ED.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%u_ED,1), UBOUND(SrcLinStateSaveData%u_ED,1) - CALL ED_CopyInput( SrcLinStateSaveData%u_ED(i1), DstLinStateSaveData%u_ED(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%x_SrvD)) THEN - i1_l = LBOUND(SrcLinStateSaveData%x_SrvD,1) - i1_u = UBOUND(SrcLinStateSaveData%x_SrvD,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%x_SrvD)) THEN - ALLOCATE(DstLinStateSaveData%x_SrvD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_SrvD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%x_SrvD,1), UBOUND(SrcLinStateSaveData%x_SrvD,1) - CALL SrvD_CopyContState( SrcLinStateSaveData%x_SrvD(i1), DstLinStateSaveData%x_SrvD(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%xd_SrvD)) THEN - i1_l = LBOUND(SrcLinStateSaveData%xd_SrvD,1) - i1_u = UBOUND(SrcLinStateSaveData%xd_SrvD,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%xd_SrvD)) THEN - ALLOCATE(DstLinStateSaveData%xd_SrvD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_SrvD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%xd_SrvD,1), UBOUND(SrcLinStateSaveData%xd_SrvD,1) - CALL SrvD_CopyDiscState( SrcLinStateSaveData%xd_SrvD(i1), DstLinStateSaveData%xd_SrvD(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%z_SrvD)) THEN - i1_l = LBOUND(SrcLinStateSaveData%z_SrvD,1) - i1_u = UBOUND(SrcLinStateSaveData%z_SrvD,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%z_SrvD)) THEN - ALLOCATE(DstLinStateSaveData%z_SrvD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_SrvD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%z_SrvD,1), UBOUND(SrcLinStateSaveData%z_SrvD,1) - CALL SrvD_CopyConstrState( SrcLinStateSaveData%z_SrvD(i1), DstLinStateSaveData%z_SrvD(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%OtherSt_SrvD)) THEN - i1_l = LBOUND(SrcLinStateSaveData%OtherSt_SrvD,1) - i1_u = UBOUND(SrcLinStateSaveData%OtherSt_SrvD,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%OtherSt_SrvD)) THEN - ALLOCATE(DstLinStateSaveData%OtherSt_SrvD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_SrvD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%OtherSt_SrvD,1), UBOUND(SrcLinStateSaveData%OtherSt_SrvD,1) - CALL SrvD_CopyOtherState( SrcLinStateSaveData%OtherSt_SrvD(i1), DstLinStateSaveData%OtherSt_SrvD(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%u_SrvD)) THEN - i1_l = LBOUND(SrcLinStateSaveData%u_SrvD,1) - i1_u = UBOUND(SrcLinStateSaveData%u_SrvD,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%u_SrvD)) THEN - ALLOCATE(DstLinStateSaveData%u_SrvD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_SrvD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%u_SrvD,1), UBOUND(SrcLinStateSaveData%u_SrvD,1) - CALL SrvD_CopyInput( SrcLinStateSaveData%u_SrvD(i1), DstLinStateSaveData%u_SrvD(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%x_AD)) THEN - i1_l = LBOUND(SrcLinStateSaveData%x_AD,1) - i1_u = UBOUND(SrcLinStateSaveData%x_AD,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%x_AD)) THEN - ALLOCATE(DstLinStateSaveData%x_AD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_AD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%x_AD,1), UBOUND(SrcLinStateSaveData%x_AD,1) - CALL AD_CopyContState( SrcLinStateSaveData%x_AD(i1), DstLinStateSaveData%x_AD(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%xd_AD)) THEN - i1_l = LBOUND(SrcLinStateSaveData%xd_AD,1) - i1_u = UBOUND(SrcLinStateSaveData%xd_AD,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%xd_AD)) THEN - ALLOCATE(DstLinStateSaveData%xd_AD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_AD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%xd_AD,1), UBOUND(SrcLinStateSaveData%xd_AD,1) - CALL AD_CopyDiscState( SrcLinStateSaveData%xd_AD(i1), DstLinStateSaveData%xd_AD(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%z_AD)) THEN - i1_l = LBOUND(SrcLinStateSaveData%z_AD,1) - i1_u = UBOUND(SrcLinStateSaveData%z_AD,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%z_AD)) THEN - ALLOCATE(DstLinStateSaveData%z_AD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_AD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%z_AD,1), UBOUND(SrcLinStateSaveData%z_AD,1) - CALL AD_CopyConstrState( SrcLinStateSaveData%z_AD(i1), DstLinStateSaveData%z_AD(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%OtherSt_AD)) THEN - i1_l = LBOUND(SrcLinStateSaveData%OtherSt_AD,1) - i1_u = UBOUND(SrcLinStateSaveData%OtherSt_AD,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%OtherSt_AD)) THEN - ALLOCATE(DstLinStateSaveData%OtherSt_AD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_AD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%OtherSt_AD,1), UBOUND(SrcLinStateSaveData%OtherSt_AD,1) - CALL AD_CopyOtherState( SrcLinStateSaveData%OtherSt_AD(i1), DstLinStateSaveData%OtherSt_AD(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%u_AD)) THEN - i1_l = LBOUND(SrcLinStateSaveData%u_AD,1) - i1_u = UBOUND(SrcLinStateSaveData%u_AD,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%u_AD)) THEN - ALLOCATE(DstLinStateSaveData%u_AD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_AD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%u_AD,1), UBOUND(SrcLinStateSaveData%u_AD,1) - CALL AD_CopyInput( SrcLinStateSaveData%u_AD(i1), DstLinStateSaveData%u_AD(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%x_IfW)) THEN - i1_l = LBOUND(SrcLinStateSaveData%x_IfW,1) - i1_u = UBOUND(SrcLinStateSaveData%x_IfW,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%x_IfW)) THEN - ALLOCATE(DstLinStateSaveData%x_IfW(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_IfW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%x_IfW,1), UBOUND(SrcLinStateSaveData%x_IfW,1) - CALL InflowWind_CopyContState( SrcLinStateSaveData%x_IfW(i1), DstLinStateSaveData%x_IfW(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%xd_IfW)) THEN - i1_l = LBOUND(SrcLinStateSaveData%xd_IfW,1) - i1_u = UBOUND(SrcLinStateSaveData%xd_IfW,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%xd_IfW)) THEN - ALLOCATE(DstLinStateSaveData%xd_IfW(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_IfW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%xd_IfW,1), UBOUND(SrcLinStateSaveData%xd_IfW,1) - CALL InflowWind_CopyDiscState( SrcLinStateSaveData%xd_IfW(i1), DstLinStateSaveData%xd_IfW(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%z_IfW)) THEN - i1_l = LBOUND(SrcLinStateSaveData%z_IfW,1) - i1_u = UBOUND(SrcLinStateSaveData%z_IfW,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%z_IfW)) THEN - ALLOCATE(DstLinStateSaveData%z_IfW(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_IfW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%z_IfW,1), UBOUND(SrcLinStateSaveData%z_IfW,1) - CALL InflowWind_CopyConstrState( SrcLinStateSaveData%z_IfW(i1), DstLinStateSaveData%z_IfW(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%OtherSt_IfW)) THEN - i1_l = LBOUND(SrcLinStateSaveData%OtherSt_IfW,1) - i1_u = UBOUND(SrcLinStateSaveData%OtherSt_IfW,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%OtherSt_IfW)) THEN - ALLOCATE(DstLinStateSaveData%OtherSt_IfW(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_IfW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%OtherSt_IfW,1), UBOUND(SrcLinStateSaveData%OtherSt_IfW,1) - CALL InflowWind_CopyOtherState( SrcLinStateSaveData%OtherSt_IfW(i1), DstLinStateSaveData%OtherSt_IfW(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%u_IfW)) THEN - i1_l = LBOUND(SrcLinStateSaveData%u_IfW,1) - i1_u = UBOUND(SrcLinStateSaveData%u_IfW,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%u_IfW)) THEN - ALLOCATE(DstLinStateSaveData%u_IfW(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_IfW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%u_IfW,1), UBOUND(SrcLinStateSaveData%u_IfW,1) - CALL InflowWind_CopyInput( SrcLinStateSaveData%u_IfW(i1), DstLinStateSaveData%u_IfW(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%x_SD)) THEN - i1_l = LBOUND(SrcLinStateSaveData%x_SD,1) - i1_u = UBOUND(SrcLinStateSaveData%x_SD,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%x_SD)) THEN - ALLOCATE(DstLinStateSaveData%x_SD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_SD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%x_SD,1), UBOUND(SrcLinStateSaveData%x_SD,1) - CALL SD_CopyContState( SrcLinStateSaveData%x_SD(i1), DstLinStateSaveData%x_SD(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%xd_SD)) THEN - i1_l = LBOUND(SrcLinStateSaveData%xd_SD,1) - i1_u = UBOUND(SrcLinStateSaveData%xd_SD,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%xd_SD)) THEN - ALLOCATE(DstLinStateSaveData%xd_SD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_SD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%xd_SD,1), UBOUND(SrcLinStateSaveData%xd_SD,1) - CALL SD_CopyDiscState( SrcLinStateSaveData%xd_SD(i1), DstLinStateSaveData%xd_SD(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%z_SD)) THEN - i1_l = LBOUND(SrcLinStateSaveData%z_SD,1) - i1_u = UBOUND(SrcLinStateSaveData%z_SD,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%z_SD)) THEN - ALLOCATE(DstLinStateSaveData%z_SD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_SD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%z_SD,1), UBOUND(SrcLinStateSaveData%z_SD,1) - CALL SD_CopyConstrState( SrcLinStateSaveData%z_SD(i1), DstLinStateSaveData%z_SD(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%OtherSt_SD)) THEN - i1_l = LBOUND(SrcLinStateSaveData%OtherSt_SD,1) - i1_u = UBOUND(SrcLinStateSaveData%OtherSt_SD,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%OtherSt_SD)) THEN - ALLOCATE(DstLinStateSaveData%OtherSt_SD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_SD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%OtherSt_SD,1), UBOUND(SrcLinStateSaveData%OtherSt_SD,1) - CALL SD_CopyOtherState( SrcLinStateSaveData%OtherSt_SD(i1), DstLinStateSaveData%OtherSt_SD(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%u_SD)) THEN - i1_l = LBOUND(SrcLinStateSaveData%u_SD,1) - i1_u = UBOUND(SrcLinStateSaveData%u_SD,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%u_SD)) THEN - ALLOCATE(DstLinStateSaveData%u_SD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_SD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%u_SD,1), UBOUND(SrcLinStateSaveData%u_SD,1) - CALL SD_CopyInput( SrcLinStateSaveData%u_SD(i1), DstLinStateSaveData%u_SD(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%x_ExtPtfm)) THEN - i1_l = LBOUND(SrcLinStateSaveData%x_ExtPtfm,1) - i1_u = UBOUND(SrcLinStateSaveData%x_ExtPtfm,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%x_ExtPtfm)) THEN - ALLOCATE(DstLinStateSaveData%x_ExtPtfm(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_ExtPtfm.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%x_ExtPtfm,1), UBOUND(SrcLinStateSaveData%x_ExtPtfm,1) - CALL ExtPtfm_CopyContState( SrcLinStateSaveData%x_ExtPtfm(i1), DstLinStateSaveData%x_ExtPtfm(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%xd_ExtPtfm)) THEN - i1_l = LBOUND(SrcLinStateSaveData%xd_ExtPtfm,1) - i1_u = UBOUND(SrcLinStateSaveData%xd_ExtPtfm,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%xd_ExtPtfm)) THEN - ALLOCATE(DstLinStateSaveData%xd_ExtPtfm(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_ExtPtfm.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%xd_ExtPtfm,1), UBOUND(SrcLinStateSaveData%xd_ExtPtfm,1) - CALL ExtPtfm_CopyDiscState( SrcLinStateSaveData%xd_ExtPtfm(i1), DstLinStateSaveData%xd_ExtPtfm(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%z_ExtPtfm)) THEN - i1_l = LBOUND(SrcLinStateSaveData%z_ExtPtfm,1) - i1_u = UBOUND(SrcLinStateSaveData%z_ExtPtfm,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%z_ExtPtfm)) THEN - ALLOCATE(DstLinStateSaveData%z_ExtPtfm(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_ExtPtfm.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%z_ExtPtfm,1), UBOUND(SrcLinStateSaveData%z_ExtPtfm,1) - CALL ExtPtfm_CopyConstrState( SrcLinStateSaveData%z_ExtPtfm(i1), DstLinStateSaveData%z_ExtPtfm(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%OtherSt_ExtPtfm)) THEN - i1_l = LBOUND(SrcLinStateSaveData%OtherSt_ExtPtfm,1) - i1_u = UBOUND(SrcLinStateSaveData%OtherSt_ExtPtfm,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%OtherSt_ExtPtfm)) THEN - ALLOCATE(DstLinStateSaveData%OtherSt_ExtPtfm(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_ExtPtfm.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%OtherSt_ExtPtfm,1), UBOUND(SrcLinStateSaveData%OtherSt_ExtPtfm,1) - CALL ExtPtfm_CopyOtherState( SrcLinStateSaveData%OtherSt_ExtPtfm(i1), DstLinStateSaveData%OtherSt_ExtPtfm(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%u_ExtPtfm)) THEN - i1_l = LBOUND(SrcLinStateSaveData%u_ExtPtfm,1) - i1_u = UBOUND(SrcLinStateSaveData%u_ExtPtfm,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%u_ExtPtfm)) THEN - ALLOCATE(DstLinStateSaveData%u_ExtPtfm(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_ExtPtfm.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%u_ExtPtfm,1), UBOUND(SrcLinStateSaveData%u_ExtPtfm,1) - CALL ExtPtfm_CopyInput( SrcLinStateSaveData%u_ExtPtfm(i1), DstLinStateSaveData%u_ExtPtfm(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%x_HD)) THEN - i1_l = LBOUND(SrcLinStateSaveData%x_HD,1) - i1_u = UBOUND(SrcLinStateSaveData%x_HD,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%x_HD)) THEN - ALLOCATE(DstLinStateSaveData%x_HD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_HD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%x_HD,1), UBOUND(SrcLinStateSaveData%x_HD,1) - CALL HydroDyn_CopyContState( SrcLinStateSaveData%x_HD(i1), DstLinStateSaveData%x_HD(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%xd_HD)) THEN - i1_l = LBOUND(SrcLinStateSaveData%xd_HD,1) - i1_u = UBOUND(SrcLinStateSaveData%xd_HD,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%xd_HD)) THEN - ALLOCATE(DstLinStateSaveData%xd_HD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_HD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%xd_HD,1), UBOUND(SrcLinStateSaveData%xd_HD,1) - CALL HydroDyn_CopyDiscState( SrcLinStateSaveData%xd_HD(i1), DstLinStateSaveData%xd_HD(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%z_HD)) THEN - i1_l = LBOUND(SrcLinStateSaveData%z_HD,1) - i1_u = UBOUND(SrcLinStateSaveData%z_HD,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%z_HD)) THEN - ALLOCATE(DstLinStateSaveData%z_HD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_HD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%z_HD,1), UBOUND(SrcLinStateSaveData%z_HD,1) - CALL HydroDyn_CopyConstrState( SrcLinStateSaveData%z_HD(i1), DstLinStateSaveData%z_HD(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%OtherSt_HD)) THEN - i1_l = LBOUND(SrcLinStateSaveData%OtherSt_HD,1) - i1_u = UBOUND(SrcLinStateSaveData%OtherSt_HD,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%OtherSt_HD)) THEN - ALLOCATE(DstLinStateSaveData%OtherSt_HD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_HD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%OtherSt_HD,1), UBOUND(SrcLinStateSaveData%OtherSt_HD,1) - CALL HydroDyn_CopyOtherState( SrcLinStateSaveData%OtherSt_HD(i1), DstLinStateSaveData%OtherSt_HD(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%u_HD)) THEN - i1_l = LBOUND(SrcLinStateSaveData%u_HD,1) - i1_u = UBOUND(SrcLinStateSaveData%u_HD,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%u_HD)) THEN - ALLOCATE(DstLinStateSaveData%u_HD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_HD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%u_HD,1), UBOUND(SrcLinStateSaveData%u_HD,1) - CALL HydroDyn_CopyInput( SrcLinStateSaveData%u_HD(i1), DstLinStateSaveData%u_HD(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%x_IceF)) THEN - i1_l = LBOUND(SrcLinStateSaveData%x_IceF,1) - i1_u = UBOUND(SrcLinStateSaveData%x_IceF,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%x_IceF)) THEN - ALLOCATE(DstLinStateSaveData%x_IceF(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_IceF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%x_IceF,1), UBOUND(SrcLinStateSaveData%x_IceF,1) - CALL IceFloe_CopyContState( SrcLinStateSaveData%x_IceF(i1), DstLinStateSaveData%x_IceF(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%xd_IceF)) THEN - i1_l = LBOUND(SrcLinStateSaveData%xd_IceF,1) - i1_u = UBOUND(SrcLinStateSaveData%xd_IceF,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%xd_IceF)) THEN - ALLOCATE(DstLinStateSaveData%xd_IceF(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_IceF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%xd_IceF,1), UBOUND(SrcLinStateSaveData%xd_IceF,1) - CALL IceFloe_CopyDiscState( SrcLinStateSaveData%xd_IceF(i1), DstLinStateSaveData%xd_IceF(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%z_IceF)) THEN - i1_l = LBOUND(SrcLinStateSaveData%z_IceF,1) - i1_u = UBOUND(SrcLinStateSaveData%z_IceF,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%z_IceF)) THEN - ALLOCATE(DstLinStateSaveData%z_IceF(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_IceF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%z_IceF,1), UBOUND(SrcLinStateSaveData%z_IceF,1) - CALL IceFloe_CopyConstrState( SrcLinStateSaveData%z_IceF(i1), DstLinStateSaveData%z_IceF(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%OtherSt_IceF)) THEN - i1_l = LBOUND(SrcLinStateSaveData%OtherSt_IceF,1) - i1_u = UBOUND(SrcLinStateSaveData%OtherSt_IceF,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%OtherSt_IceF)) THEN - ALLOCATE(DstLinStateSaveData%OtherSt_IceF(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_IceF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%OtherSt_IceF,1), UBOUND(SrcLinStateSaveData%OtherSt_IceF,1) - CALL IceFloe_CopyOtherState( SrcLinStateSaveData%OtherSt_IceF(i1), DstLinStateSaveData%OtherSt_IceF(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%u_IceF)) THEN - i1_l = LBOUND(SrcLinStateSaveData%u_IceF,1) - i1_u = UBOUND(SrcLinStateSaveData%u_IceF,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%u_IceF)) THEN - ALLOCATE(DstLinStateSaveData%u_IceF(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_IceF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%u_IceF,1), UBOUND(SrcLinStateSaveData%u_IceF,1) - CALL IceFloe_CopyInput( SrcLinStateSaveData%u_IceF(i1), DstLinStateSaveData%u_IceF(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%x_MAP)) THEN - i1_l = LBOUND(SrcLinStateSaveData%x_MAP,1) - i1_u = UBOUND(SrcLinStateSaveData%x_MAP,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%x_MAP)) THEN - ALLOCATE(DstLinStateSaveData%x_MAP(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_MAP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%x_MAP,1), UBOUND(SrcLinStateSaveData%x_MAP,1) - CALL MAP_CopyContState( SrcLinStateSaveData%x_MAP(i1), DstLinStateSaveData%x_MAP(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%xd_MAP)) THEN - i1_l = LBOUND(SrcLinStateSaveData%xd_MAP,1) - i1_u = UBOUND(SrcLinStateSaveData%xd_MAP,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%xd_MAP)) THEN - ALLOCATE(DstLinStateSaveData%xd_MAP(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_MAP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%xd_MAP,1), UBOUND(SrcLinStateSaveData%xd_MAP,1) - CALL MAP_CopyDiscState( SrcLinStateSaveData%xd_MAP(i1), DstLinStateSaveData%xd_MAP(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%z_MAP)) THEN - i1_l = LBOUND(SrcLinStateSaveData%z_MAP,1) - i1_u = UBOUND(SrcLinStateSaveData%z_MAP,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%z_MAP)) THEN - ALLOCATE(DstLinStateSaveData%z_MAP(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_MAP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%z_MAP,1), UBOUND(SrcLinStateSaveData%z_MAP,1) - CALL MAP_CopyConstrState( SrcLinStateSaveData%z_MAP(i1), DstLinStateSaveData%z_MAP(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%u_MAP)) THEN - i1_l = LBOUND(SrcLinStateSaveData%u_MAP,1) - i1_u = UBOUND(SrcLinStateSaveData%u_MAP,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%u_MAP)) THEN - ALLOCATE(DstLinStateSaveData%u_MAP(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_MAP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%u_MAP,1), UBOUND(SrcLinStateSaveData%u_MAP,1) - CALL MAP_CopyInput( SrcLinStateSaveData%u_MAP(i1), DstLinStateSaveData%u_MAP(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%x_FEAM)) THEN - i1_l = LBOUND(SrcLinStateSaveData%x_FEAM,1) - i1_u = UBOUND(SrcLinStateSaveData%x_FEAM,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%x_FEAM)) THEN - ALLOCATE(DstLinStateSaveData%x_FEAM(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_FEAM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%x_FEAM,1), UBOUND(SrcLinStateSaveData%x_FEAM,1) - CALL FEAM_CopyContState( SrcLinStateSaveData%x_FEAM(i1), DstLinStateSaveData%x_FEAM(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%xd_FEAM)) THEN - i1_l = LBOUND(SrcLinStateSaveData%xd_FEAM,1) - i1_u = UBOUND(SrcLinStateSaveData%xd_FEAM,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%xd_FEAM)) THEN - ALLOCATE(DstLinStateSaveData%xd_FEAM(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_FEAM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%xd_FEAM,1), UBOUND(SrcLinStateSaveData%xd_FEAM,1) - CALL FEAM_CopyDiscState( SrcLinStateSaveData%xd_FEAM(i1), DstLinStateSaveData%xd_FEAM(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%z_FEAM)) THEN - i1_l = LBOUND(SrcLinStateSaveData%z_FEAM,1) - i1_u = UBOUND(SrcLinStateSaveData%z_FEAM,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%z_FEAM)) THEN - ALLOCATE(DstLinStateSaveData%z_FEAM(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_FEAM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%z_FEAM,1), UBOUND(SrcLinStateSaveData%z_FEAM,1) - CALL FEAM_CopyConstrState( SrcLinStateSaveData%z_FEAM(i1), DstLinStateSaveData%z_FEAM(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%OtherSt_FEAM)) THEN - i1_l = LBOUND(SrcLinStateSaveData%OtherSt_FEAM,1) - i1_u = UBOUND(SrcLinStateSaveData%OtherSt_FEAM,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%OtherSt_FEAM)) THEN - ALLOCATE(DstLinStateSaveData%OtherSt_FEAM(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_FEAM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%OtherSt_FEAM,1), UBOUND(SrcLinStateSaveData%OtherSt_FEAM,1) - CALL FEAM_CopyOtherState( SrcLinStateSaveData%OtherSt_FEAM(i1), DstLinStateSaveData%OtherSt_FEAM(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%u_FEAM)) THEN - i1_l = LBOUND(SrcLinStateSaveData%u_FEAM,1) - i1_u = UBOUND(SrcLinStateSaveData%u_FEAM,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%u_FEAM)) THEN - ALLOCATE(DstLinStateSaveData%u_FEAM(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_FEAM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%u_FEAM,1), UBOUND(SrcLinStateSaveData%u_FEAM,1) - CALL FEAM_CopyInput( SrcLinStateSaveData%u_FEAM(i1), DstLinStateSaveData%u_FEAM(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%x_MD)) THEN - i1_l = LBOUND(SrcLinStateSaveData%x_MD,1) - i1_u = UBOUND(SrcLinStateSaveData%x_MD,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%x_MD)) THEN - ALLOCATE(DstLinStateSaveData%x_MD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_MD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%x_MD,1), UBOUND(SrcLinStateSaveData%x_MD,1) - CALL MD_CopyContState( SrcLinStateSaveData%x_MD(i1), DstLinStateSaveData%x_MD(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%xd_MD)) THEN - i1_l = LBOUND(SrcLinStateSaveData%xd_MD,1) - i1_u = UBOUND(SrcLinStateSaveData%xd_MD,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%xd_MD)) THEN - ALLOCATE(DstLinStateSaveData%xd_MD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_MD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%xd_MD,1), UBOUND(SrcLinStateSaveData%xd_MD,1) - CALL MD_CopyDiscState( SrcLinStateSaveData%xd_MD(i1), DstLinStateSaveData%xd_MD(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%z_MD)) THEN - i1_l = LBOUND(SrcLinStateSaveData%z_MD,1) - i1_u = UBOUND(SrcLinStateSaveData%z_MD,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%z_MD)) THEN - ALLOCATE(DstLinStateSaveData%z_MD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_MD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%z_MD,1), UBOUND(SrcLinStateSaveData%z_MD,1) - CALL MD_CopyConstrState( SrcLinStateSaveData%z_MD(i1), DstLinStateSaveData%z_MD(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%OtherSt_MD)) THEN - i1_l = LBOUND(SrcLinStateSaveData%OtherSt_MD,1) - i1_u = UBOUND(SrcLinStateSaveData%OtherSt_MD,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%OtherSt_MD)) THEN - ALLOCATE(DstLinStateSaveData%OtherSt_MD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_MD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%OtherSt_MD,1), UBOUND(SrcLinStateSaveData%OtherSt_MD,1) - CALL MD_CopyOtherState( SrcLinStateSaveData%OtherSt_MD(i1), DstLinStateSaveData%OtherSt_MD(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%u_MD)) THEN - i1_l = LBOUND(SrcLinStateSaveData%u_MD,1) - i1_u = UBOUND(SrcLinStateSaveData%u_MD,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%u_MD)) THEN - ALLOCATE(DstLinStateSaveData%u_MD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_MD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%u_MD,1), UBOUND(SrcLinStateSaveData%u_MD,1) - CALL MD_CopyInput( SrcLinStateSaveData%u_MD(i1), DstLinStateSaveData%u_MD(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - END SUBROUTINE FAST_CopyLinStateSave - - SUBROUTINE FAST_DestroyLinStateSave( LinStateSaveData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(FAST_LinStateSave), INTENT(INOUT) :: LinStateSaveData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyLinStateSave' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(LinStateSaveData%x_IceD)) THEN -DO i2 = LBOUND(LinStateSaveData%x_IceD,2), UBOUND(LinStateSaveData%x_IceD,2) -DO i1 = LBOUND(LinStateSaveData%x_IceD,1), UBOUND(LinStateSaveData%x_IceD,1) - CALL IceD_DestroyContState( LinStateSaveData%x_IceD(i1,i2), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO - DEALLOCATE(LinStateSaveData%x_IceD) -ENDIF -IF (ALLOCATED(LinStateSaveData%xd_IceD)) THEN -DO i2 = LBOUND(LinStateSaveData%xd_IceD,2), UBOUND(LinStateSaveData%xd_IceD,2) -DO i1 = LBOUND(LinStateSaveData%xd_IceD,1), UBOUND(LinStateSaveData%xd_IceD,1) - CALL IceD_DestroyDiscState( LinStateSaveData%xd_IceD(i1,i2), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO - DEALLOCATE(LinStateSaveData%xd_IceD) -ENDIF -IF (ALLOCATED(LinStateSaveData%z_IceD)) THEN -DO i2 = LBOUND(LinStateSaveData%z_IceD,2), UBOUND(LinStateSaveData%z_IceD,2) -DO i1 = LBOUND(LinStateSaveData%z_IceD,1), UBOUND(LinStateSaveData%z_IceD,1) - CALL IceD_DestroyConstrState( LinStateSaveData%z_IceD(i1,i2), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO - DEALLOCATE(LinStateSaveData%z_IceD) -ENDIF -IF (ALLOCATED(LinStateSaveData%OtherSt_IceD)) THEN -DO i2 = LBOUND(LinStateSaveData%OtherSt_IceD,2), UBOUND(LinStateSaveData%OtherSt_IceD,2) -DO i1 = LBOUND(LinStateSaveData%OtherSt_IceD,1), UBOUND(LinStateSaveData%OtherSt_IceD,1) - CALL IceD_DestroyOtherState( LinStateSaveData%OtherSt_IceD(i1,i2), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO - DEALLOCATE(LinStateSaveData%OtherSt_IceD) -ENDIF -IF (ALLOCATED(LinStateSaveData%u_IceD)) THEN -DO i2 = LBOUND(LinStateSaveData%u_IceD,2), UBOUND(LinStateSaveData%u_IceD,2) -DO i1 = LBOUND(LinStateSaveData%u_IceD,1), UBOUND(LinStateSaveData%u_IceD,1) - CALL IceD_DestroyInput( LinStateSaveData%u_IceD(i1,i2), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO - DEALLOCATE(LinStateSaveData%u_IceD) -ENDIF -IF (ALLOCATED(LinStateSaveData%x_BD)) THEN -DO i2 = LBOUND(LinStateSaveData%x_BD,2), UBOUND(LinStateSaveData%x_BD,2) -DO i1 = LBOUND(LinStateSaveData%x_BD,1), UBOUND(LinStateSaveData%x_BD,1) - CALL BD_DestroyContState( LinStateSaveData%x_BD(i1,i2), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO - DEALLOCATE(LinStateSaveData%x_BD) -ENDIF -IF (ALLOCATED(LinStateSaveData%xd_BD)) THEN -DO i2 = LBOUND(LinStateSaveData%xd_BD,2), UBOUND(LinStateSaveData%xd_BD,2) -DO i1 = LBOUND(LinStateSaveData%xd_BD,1), UBOUND(LinStateSaveData%xd_BD,1) - CALL BD_DestroyDiscState( LinStateSaveData%xd_BD(i1,i2), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO - DEALLOCATE(LinStateSaveData%xd_BD) -ENDIF -IF (ALLOCATED(LinStateSaveData%z_BD)) THEN -DO i2 = LBOUND(LinStateSaveData%z_BD,2), UBOUND(LinStateSaveData%z_BD,2) -DO i1 = LBOUND(LinStateSaveData%z_BD,1), UBOUND(LinStateSaveData%z_BD,1) - CALL BD_DestroyConstrState( LinStateSaveData%z_BD(i1,i2), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO - DEALLOCATE(LinStateSaveData%z_BD) -ENDIF -IF (ALLOCATED(LinStateSaveData%OtherSt_BD)) THEN -DO i2 = LBOUND(LinStateSaveData%OtherSt_BD,2), UBOUND(LinStateSaveData%OtherSt_BD,2) -DO i1 = LBOUND(LinStateSaveData%OtherSt_BD,1), UBOUND(LinStateSaveData%OtherSt_BD,1) - CALL BD_DestroyOtherState( LinStateSaveData%OtherSt_BD(i1,i2), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO - DEALLOCATE(LinStateSaveData%OtherSt_BD) -ENDIF -IF (ALLOCATED(LinStateSaveData%u_BD)) THEN -DO i2 = LBOUND(LinStateSaveData%u_BD,2), UBOUND(LinStateSaveData%u_BD,2) -DO i1 = LBOUND(LinStateSaveData%u_BD,1), UBOUND(LinStateSaveData%u_BD,1) - CALL BD_DestroyInput( LinStateSaveData%u_BD(i1,i2), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO - DEALLOCATE(LinStateSaveData%u_BD) -ENDIF -IF (ALLOCATED(LinStateSaveData%x_ED)) THEN -DO i1 = LBOUND(LinStateSaveData%x_ED,1), UBOUND(LinStateSaveData%x_ED,1) - CALL ED_DestroyContState( LinStateSaveData%x_ED(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(LinStateSaveData%x_ED) -ENDIF -IF (ALLOCATED(LinStateSaveData%xd_ED)) THEN -DO i1 = LBOUND(LinStateSaveData%xd_ED,1), UBOUND(LinStateSaveData%xd_ED,1) - CALL ED_DestroyDiscState( LinStateSaveData%xd_ED(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(LinStateSaveData%xd_ED) -ENDIF -IF (ALLOCATED(LinStateSaveData%z_ED)) THEN -DO i1 = LBOUND(LinStateSaveData%z_ED,1), UBOUND(LinStateSaveData%z_ED,1) - CALL ED_DestroyConstrState( LinStateSaveData%z_ED(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(LinStateSaveData%z_ED) -ENDIF -IF (ALLOCATED(LinStateSaveData%OtherSt_ED)) THEN -DO i1 = LBOUND(LinStateSaveData%OtherSt_ED,1), UBOUND(LinStateSaveData%OtherSt_ED,1) - CALL ED_DestroyOtherState( LinStateSaveData%OtherSt_ED(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(LinStateSaveData%OtherSt_ED) -ENDIF -IF (ALLOCATED(LinStateSaveData%u_ED)) THEN -DO i1 = LBOUND(LinStateSaveData%u_ED,1), UBOUND(LinStateSaveData%u_ED,1) - CALL ED_DestroyInput( LinStateSaveData%u_ED(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(LinStateSaveData%u_ED) -ENDIF -IF (ALLOCATED(LinStateSaveData%x_SrvD)) THEN -DO i1 = LBOUND(LinStateSaveData%x_SrvD,1), UBOUND(LinStateSaveData%x_SrvD,1) - CALL SrvD_DestroyContState( LinStateSaveData%x_SrvD(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(LinStateSaveData%x_SrvD) -ENDIF -IF (ALLOCATED(LinStateSaveData%xd_SrvD)) THEN -DO i1 = LBOUND(LinStateSaveData%xd_SrvD,1), UBOUND(LinStateSaveData%xd_SrvD,1) - CALL SrvD_DestroyDiscState( LinStateSaveData%xd_SrvD(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(LinStateSaveData%xd_SrvD) -ENDIF -IF (ALLOCATED(LinStateSaveData%z_SrvD)) THEN -DO i1 = LBOUND(LinStateSaveData%z_SrvD,1), UBOUND(LinStateSaveData%z_SrvD,1) - CALL SrvD_DestroyConstrState( LinStateSaveData%z_SrvD(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(LinStateSaveData%z_SrvD) -ENDIF -IF (ALLOCATED(LinStateSaveData%OtherSt_SrvD)) THEN -DO i1 = LBOUND(LinStateSaveData%OtherSt_SrvD,1), UBOUND(LinStateSaveData%OtherSt_SrvD,1) - CALL SrvD_DestroyOtherState( LinStateSaveData%OtherSt_SrvD(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(LinStateSaveData%OtherSt_SrvD) -ENDIF -IF (ALLOCATED(LinStateSaveData%u_SrvD)) THEN -DO i1 = LBOUND(LinStateSaveData%u_SrvD,1), UBOUND(LinStateSaveData%u_SrvD,1) - CALL SrvD_DestroyInput( LinStateSaveData%u_SrvD(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(LinStateSaveData%u_SrvD) -ENDIF -IF (ALLOCATED(LinStateSaveData%x_AD)) THEN -DO i1 = LBOUND(LinStateSaveData%x_AD,1), UBOUND(LinStateSaveData%x_AD,1) - CALL AD_DestroyContState( LinStateSaveData%x_AD(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(LinStateSaveData%x_AD) -ENDIF -IF (ALLOCATED(LinStateSaveData%xd_AD)) THEN -DO i1 = LBOUND(LinStateSaveData%xd_AD,1), UBOUND(LinStateSaveData%xd_AD,1) - CALL AD_DestroyDiscState( LinStateSaveData%xd_AD(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(LinStateSaveData%xd_AD) -ENDIF -IF (ALLOCATED(LinStateSaveData%z_AD)) THEN -DO i1 = LBOUND(LinStateSaveData%z_AD,1), UBOUND(LinStateSaveData%z_AD,1) - CALL AD_DestroyConstrState( LinStateSaveData%z_AD(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(LinStateSaveData%z_AD) -ENDIF -IF (ALLOCATED(LinStateSaveData%OtherSt_AD)) THEN -DO i1 = LBOUND(LinStateSaveData%OtherSt_AD,1), UBOUND(LinStateSaveData%OtherSt_AD,1) - CALL AD_DestroyOtherState( LinStateSaveData%OtherSt_AD(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(LinStateSaveData%OtherSt_AD) -ENDIF -IF (ALLOCATED(LinStateSaveData%u_AD)) THEN -DO i1 = LBOUND(LinStateSaveData%u_AD,1), UBOUND(LinStateSaveData%u_AD,1) - CALL AD_DestroyInput( LinStateSaveData%u_AD(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(LinStateSaveData%u_AD) -ENDIF -IF (ALLOCATED(LinStateSaveData%x_IfW)) THEN -DO i1 = LBOUND(LinStateSaveData%x_IfW,1), UBOUND(LinStateSaveData%x_IfW,1) - CALL InflowWind_DestroyContState( LinStateSaveData%x_IfW(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(LinStateSaveData%x_IfW) -ENDIF -IF (ALLOCATED(LinStateSaveData%xd_IfW)) THEN -DO i1 = LBOUND(LinStateSaveData%xd_IfW,1), UBOUND(LinStateSaveData%xd_IfW,1) - CALL InflowWind_DestroyDiscState( LinStateSaveData%xd_IfW(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(LinStateSaveData%xd_IfW) -ENDIF -IF (ALLOCATED(LinStateSaveData%z_IfW)) THEN -DO i1 = LBOUND(LinStateSaveData%z_IfW,1), UBOUND(LinStateSaveData%z_IfW,1) - CALL InflowWind_DestroyConstrState( LinStateSaveData%z_IfW(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(LinStateSaveData%z_IfW) -ENDIF -IF (ALLOCATED(LinStateSaveData%OtherSt_IfW)) THEN -DO i1 = LBOUND(LinStateSaveData%OtherSt_IfW,1), UBOUND(LinStateSaveData%OtherSt_IfW,1) - CALL InflowWind_DestroyOtherState( LinStateSaveData%OtherSt_IfW(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(LinStateSaveData%OtherSt_IfW) -ENDIF -IF (ALLOCATED(LinStateSaveData%u_IfW)) THEN -DO i1 = LBOUND(LinStateSaveData%u_IfW,1), UBOUND(LinStateSaveData%u_IfW,1) - CALL InflowWind_DestroyInput( LinStateSaveData%u_IfW(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(LinStateSaveData%u_IfW) -ENDIF -IF (ALLOCATED(LinStateSaveData%x_SD)) THEN -DO i1 = LBOUND(LinStateSaveData%x_SD,1), UBOUND(LinStateSaveData%x_SD,1) - CALL SD_DestroyContState( LinStateSaveData%x_SD(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(LinStateSaveData%x_SD) -ENDIF -IF (ALLOCATED(LinStateSaveData%xd_SD)) THEN -DO i1 = LBOUND(LinStateSaveData%xd_SD,1), UBOUND(LinStateSaveData%xd_SD,1) - CALL SD_DestroyDiscState( LinStateSaveData%xd_SD(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(LinStateSaveData%xd_SD) -ENDIF -IF (ALLOCATED(LinStateSaveData%z_SD)) THEN -DO i1 = LBOUND(LinStateSaveData%z_SD,1), UBOUND(LinStateSaveData%z_SD,1) - CALL SD_DestroyConstrState( LinStateSaveData%z_SD(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(LinStateSaveData%z_SD) -ENDIF -IF (ALLOCATED(LinStateSaveData%OtherSt_SD)) THEN -DO i1 = LBOUND(LinStateSaveData%OtherSt_SD,1), UBOUND(LinStateSaveData%OtherSt_SD,1) - CALL SD_DestroyOtherState( LinStateSaveData%OtherSt_SD(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(LinStateSaveData%OtherSt_SD) -ENDIF -IF (ALLOCATED(LinStateSaveData%u_SD)) THEN -DO i1 = LBOUND(LinStateSaveData%u_SD,1), UBOUND(LinStateSaveData%u_SD,1) - CALL SD_DestroyInput( LinStateSaveData%u_SD(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(LinStateSaveData%u_SD) -ENDIF -IF (ALLOCATED(LinStateSaveData%x_ExtPtfm)) THEN -DO i1 = LBOUND(LinStateSaveData%x_ExtPtfm,1), UBOUND(LinStateSaveData%x_ExtPtfm,1) - CALL ExtPtfm_DestroyContState( LinStateSaveData%x_ExtPtfm(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(LinStateSaveData%x_ExtPtfm) -ENDIF -IF (ALLOCATED(LinStateSaveData%xd_ExtPtfm)) THEN -DO i1 = LBOUND(LinStateSaveData%xd_ExtPtfm,1), UBOUND(LinStateSaveData%xd_ExtPtfm,1) - CALL ExtPtfm_DestroyDiscState( LinStateSaveData%xd_ExtPtfm(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(LinStateSaveData%xd_ExtPtfm) -ENDIF -IF (ALLOCATED(LinStateSaveData%z_ExtPtfm)) THEN -DO i1 = LBOUND(LinStateSaveData%z_ExtPtfm,1), UBOUND(LinStateSaveData%z_ExtPtfm,1) - CALL ExtPtfm_DestroyConstrState( LinStateSaveData%z_ExtPtfm(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(LinStateSaveData%z_ExtPtfm) -ENDIF -IF (ALLOCATED(LinStateSaveData%OtherSt_ExtPtfm)) THEN -DO i1 = LBOUND(LinStateSaveData%OtherSt_ExtPtfm,1), UBOUND(LinStateSaveData%OtherSt_ExtPtfm,1) - CALL ExtPtfm_DestroyOtherState( LinStateSaveData%OtherSt_ExtPtfm(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(LinStateSaveData%OtherSt_ExtPtfm) -ENDIF -IF (ALLOCATED(LinStateSaveData%u_ExtPtfm)) THEN -DO i1 = LBOUND(LinStateSaveData%u_ExtPtfm,1), UBOUND(LinStateSaveData%u_ExtPtfm,1) - CALL ExtPtfm_DestroyInput( LinStateSaveData%u_ExtPtfm(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(LinStateSaveData%u_ExtPtfm) -ENDIF -IF (ALLOCATED(LinStateSaveData%x_HD)) THEN -DO i1 = LBOUND(LinStateSaveData%x_HD,1), UBOUND(LinStateSaveData%x_HD,1) - CALL HydroDyn_DestroyContState( LinStateSaveData%x_HD(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(LinStateSaveData%x_HD) -ENDIF -IF (ALLOCATED(LinStateSaveData%xd_HD)) THEN -DO i1 = LBOUND(LinStateSaveData%xd_HD,1), UBOUND(LinStateSaveData%xd_HD,1) - CALL HydroDyn_DestroyDiscState( LinStateSaveData%xd_HD(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(LinStateSaveData%xd_HD) -ENDIF -IF (ALLOCATED(LinStateSaveData%z_HD)) THEN -DO i1 = LBOUND(LinStateSaveData%z_HD,1), UBOUND(LinStateSaveData%z_HD,1) - CALL HydroDyn_DestroyConstrState( LinStateSaveData%z_HD(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(LinStateSaveData%z_HD) -ENDIF -IF (ALLOCATED(LinStateSaveData%OtherSt_HD)) THEN -DO i1 = LBOUND(LinStateSaveData%OtherSt_HD,1), UBOUND(LinStateSaveData%OtherSt_HD,1) - CALL HydroDyn_DestroyOtherState( LinStateSaveData%OtherSt_HD(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(LinStateSaveData%OtherSt_HD) -ENDIF -IF (ALLOCATED(LinStateSaveData%u_HD)) THEN -DO i1 = LBOUND(LinStateSaveData%u_HD,1), UBOUND(LinStateSaveData%u_HD,1) - CALL HydroDyn_DestroyInput( LinStateSaveData%u_HD(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(LinStateSaveData%u_HD) -ENDIF -IF (ALLOCATED(LinStateSaveData%x_IceF)) THEN -DO i1 = LBOUND(LinStateSaveData%x_IceF,1), UBOUND(LinStateSaveData%x_IceF,1) - CALL IceFloe_DestroyContState( LinStateSaveData%x_IceF(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(LinStateSaveData%x_IceF) -ENDIF -IF (ALLOCATED(LinStateSaveData%xd_IceF)) THEN -DO i1 = LBOUND(LinStateSaveData%xd_IceF,1), UBOUND(LinStateSaveData%xd_IceF,1) - CALL IceFloe_DestroyDiscState( LinStateSaveData%xd_IceF(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(LinStateSaveData%xd_IceF) -ENDIF -IF (ALLOCATED(LinStateSaveData%z_IceF)) THEN -DO i1 = LBOUND(LinStateSaveData%z_IceF,1), UBOUND(LinStateSaveData%z_IceF,1) - CALL IceFloe_DestroyConstrState( LinStateSaveData%z_IceF(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(LinStateSaveData%z_IceF) -ENDIF -IF (ALLOCATED(LinStateSaveData%OtherSt_IceF)) THEN -DO i1 = LBOUND(LinStateSaveData%OtherSt_IceF,1), UBOUND(LinStateSaveData%OtherSt_IceF,1) - CALL IceFloe_DestroyOtherState( LinStateSaveData%OtherSt_IceF(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(LinStateSaveData%OtherSt_IceF) -ENDIF -IF (ALLOCATED(LinStateSaveData%u_IceF)) THEN -DO i1 = LBOUND(LinStateSaveData%u_IceF,1), UBOUND(LinStateSaveData%u_IceF,1) - CALL IceFloe_DestroyInput( LinStateSaveData%u_IceF(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(LinStateSaveData%u_IceF) -ENDIF -IF (ALLOCATED(LinStateSaveData%x_MAP)) THEN -DO i1 = LBOUND(LinStateSaveData%x_MAP,1), UBOUND(LinStateSaveData%x_MAP,1) - CALL MAP_DestroyContState( LinStateSaveData%x_MAP(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(LinStateSaveData%x_MAP) -ENDIF -IF (ALLOCATED(LinStateSaveData%xd_MAP)) THEN -DO i1 = LBOUND(LinStateSaveData%xd_MAP,1), UBOUND(LinStateSaveData%xd_MAP,1) - CALL MAP_DestroyDiscState( LinStateSaveData%xd_MAP(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(LinStateSaveData%xd_MAP) -ENDIF -IF (ALLOCATED(LinStateSaveData%z_MAP)) THEN -DO i1 = LBOUND(LinStateSaveData%z_MAP,1), UBOUND(LinStateSaveData%z_MAP,1) - CALL MAP_DestroyConstrState( LinStateSaveData%z_MAP(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(LinStateSaveData%z_MAP) -ENDIF -IF (ALLOCATED(LinStateSaveData%u_MAP)) THEN -DO i1 = LBOUND(LinStateSaveData%u_MAP,1), UBOUND(LinStateSaveData%u_MAP,1) - CALL MAP_DestroyInput( LinStateSaveData%u_MAP(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(LinStateSaveData%u_MAP) -ENDIF -IF (ALLOCATED(LinStateSaveData%x_FEAM)) THEN -DO i1 = LBOUND(LinStateSaveData%x_FEAM,1), UBOUND(LinStateSaveData%x_FEAM,1) - CALL FEAM_DestroyContState( LinStateSaveData%x_FEAM(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(LinStateSaveData%x_FEAM) -ENDIF -IF (ALLOCATED(LinStateSaveData%xd_FEAM)) THEN -DO i1 = LBOUND(LinStateSaveData%xd_FEAM,1), UBOUND(LinStateSaveData%xd_FEAM,1) - CALL FEAM_DestroyDiscState( LinStateSaveData%xd_FEAM(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(LinStateSaveData%xd_FEAM) -ENDIF -IF (ALLOCATED(LinStateSaveData%z_FEAM)) THEN -DO i1 = LBOUND(LinStateSaveData%z_FEAM,1), UBOUND(LinStateSaveData%z_FEAM,1) - CALL FEAM_DestroyConstrState( LinStateSaveData%z_FEAM(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(LinStateSaveData%z_FEAM) -ENDIF -IF (ALLOCATED(LinStateSaveData%OtherSt_FEAM)) THEN -DO i1 = LBOUND(LinStateSaveData%OtherSt_FEAM,1), UBOUND(LinStateSaveData%OtherSt_FEAM,1) - CALL FEAM_DestroyOtherState( LinStateSaveData%OtherSt_FEAM(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(LinStateSaveData%OtherSt_FEAM) -ENDIF -IF (ALLOCATED(LinStateSaveData%u_FEAM)) THEN -DO i1 = LBOUND(LinStateSaveData%u_FEAM,1), UBOUND(LinStateSaveData%u_FEAM,1) - CALL FEAM_DestroyInput( LinStateSaveData%u_FEAM(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(LinStateSaveData%u_FEAM) -ENDIF -IF (ALLOCATED(LinStateSaveData%x_MD)) THEN -DO i1 = LBOUND(LinStateSaveData%x_MD,1), UBOUND(LinStateSaveData%x_MD,1) - CALL MD_DestroyContState( LinStateSaveData%x_MD(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(LinStateSaveData%x_MD) -ENDIF -IF (ALLOCATED(LinStateSaveData%xd_MD)) THEN -DO i1 = LBOUND(LinStateSaveData%xd_MD,1), UBOUND(LinStateSaveData%xd_MD,1) - CALL MD_DestroyDiscState( LinStateSaveData%xd_MD(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(LinStateSaveData%xd_MD) -ENDIF -IF (ALLOCATED(LinStateSaveData%z_MD)) THEN -DO i1 = LBOUND(LinStateSaveData%z_MD,1), UBOUND(LinStateSaveData%z_MD,1) - CALL MD_DestroyConstrState( LinStateSaveData%z_MD(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(LinStateSaveData%z_MD) -ENDIF -IF (ALLOCATED(LinStateSaveData%OtherSt_MD)) THEN -DO i1 = LBOUND(LinStateSaveData%OtherSt_MD,1), UBOUND(LinStateSaveData%OtherSt_MD,1) - CALL MD_DestroyOtherState( LinStateSaveData%OtherSt_MD(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(LinStateSaveData%OtherSt_MD) -ENDIF -IF (ALLOCATED(LinStateSaveData%u_MD)) THEN -DO i1 = LBOUND(LinStateSaveData%u_MD,1), UBOUND(LinStateSaveData%u_MD,1) - CALL MD_DestroyInput( LinStateSaveData%u_MD(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(LinStateSaveData%u_MD) -ENDIF - END SUBROUTINE FAST_DestroyLinStateSave - - SUBROUTINE FAST_PackLinStateSave( 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(FAST_LinStateSave), 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 = 'FAST_PackLinStateSave' - ! 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 ! x_IceD allocated yes/no - IF ( ALLOCATED(InData%x_IceD) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! x_IceD upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i2 = LBOUND(InData%x_IceD,2), UBOUND(InData%x_IceD,2) - DO i1 = LBOUND(InData%x_IceD,1), UBOUND(InData%x_IceD,1) - Int_BufSz = Int_BufSz + 3 ! x_IceD: size of buffers for each call to pack subtype - CALL IceD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_IceD(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! x_IceD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x_IceD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x_IceD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x_IceD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! xd_IceD allocated yes/no - IF ( ALLOCATED(InData%xd_IceD) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! xd_IceD upper/lower bounds for each dimension - DO i2 = LBOUND(InData%xd_IceD,2), UBOUND(InData%xd_IceD,2) - DO i1 = LBOUND(InData%xd_IceD,1), UBOUND(InData%xd_IceD,1) - Int_BufSz = Int_BufSz + 3 ! xd_IceD: size of buffers for each call to pack subtype - CALL IceD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_IceD(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! xd_IceD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xd_IceD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd_IceD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd_IceD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! z_IceD allocated yes/no - IF ( ALLOCATED(InData%z_IceD) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! z_IceD upper/lower bounds for each dimension - DO i2 = LBOUND(InData%z_IceD,2), UBOUND(InData%z_IceD,2) - DO i1 = LBOUND(InData%z_IceD,1), UBOUND(InData%z_IceD,1) - Int_BufSz = Int_BufSz + 3 ! z_IceD: size of buffers for each call to pack subtype - CALL IceD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_IceD(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! z_IceD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! z_IceD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! z_IceD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! z_IceD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! OtherSt_IceD allocated yes/no - IF ( ALLOCATED(InData%OtherSt_IceD) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! OtherSt_IceD upper/lower bounds for each dimension - DO i2 = LBOUND(InData%OtherSt_IceD,2), UBOUND(InData%OtherSt_IceD,2) - DO i1 = LBOUND(InData%OtherSt_IceD,1), UBOUND(InData%OtherSt_IceD,1) - Int_BufSz = Int_BufSz + 3 ! OtherSt_IceD: size of buffers for each call to pack subtype - CALL IceD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_IceD(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt_IceD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt_IceD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt_IceD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt_IceD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! u_IceD allocated yes/no - IF ( ALLOCATED(InData%u_IceD) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! u_IceD upper/lower bounds for each dimension - DO i2 = LBOUND(InData%u_IceD,2), UBOUND(InData%u_IceD,2) - DO i1 = LBOUND(InData%u_IceD,1), UBOUND(InData%u_IceD,1) - Int_BufSz = Int_BufSz + 3 ! u_IceD: size of buffers for each call to pack subtype - CALL IceD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_IceD(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! u_IceD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_IceD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_IceD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_IceD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! x_BD allocated yes/no - IF ( ALLOCATED(InData%x_BD) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! x_BD upper/lower bounds for each dimension - DO i2 = LBOUND(InData%x_BD,2), UBOUND(InData%x_BD,2) - DO i1 = LBOUND(InData%x_BD,1), UBOUND(InData%x_BD,1) - Int_BufSz = Int_BufSz + 3 ! x_BD: size of buffers for each call to pack subtype - CALL BD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_BD(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! x_BD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x_BD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x_BD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x_BD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! xd_BD allocated yes/no - IF ( ALLOCATED(InData%xd_BD) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! xd_BD upper/lower bounds for each dimension - DO i2 = LBOUND(InData%xd_BD,2), UBOUND(InData%xd_BD,2) - DO i1 = LBOUND(InData%xd_BD,1), UBOUND(InData%xd_BD,1) - Int_BufSz = Int_BufSz + 3 ! xd_BD: size of buffers for each call to pack subtype - CALL BD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_BD(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! xd_BD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xd_BD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd_BD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd_BD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! z_BD allocated yes/no - IF ( ALLOCATED(InData%z_BD) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! z_BD upper/lower bounds for each dimension - DO i2 = LBOUND(InData%z_BD,2), UBOUND(InData%z_BD,2) - DO i1 = LBOUND(InData%z_BD,1), UBOUND(InData%z_BD,1) - Int_BufSz = Int_BufSz + 3 ! z_BD: size of buffers for each call to pack subtype - CALL BD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_BD(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! z_BD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! z_BD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! z_BD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! z_BD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! OtherSt_BD allocated yes/no - IF ( ALLOCATED(InData%OtherSt_BD) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! OtherSt_BD upper/lower bounds for each dimension - DO i2 = LBOUND(InData%OtherSt_BD,2), UBOUND(InData%OtherSt_BD,2) - DO i1 = LBOUND(InData%OtherSt_BD,1), UBOUND(InData%OtherSt_BD,1) - Int_BufSz = Int_BufSz + 3 ! OtherSt_BD: size of buffers for each call to pack subtype - CALL BD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_BD(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt_BD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt_BD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt_BD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt_BD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! u_BD allocated yes/no - IF ( ALLOCATED(InData%u_BD) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! u_BD upper/lower bounds for each dimension - DO i2 = LBOUND(InData%u_BD,2), UBOUND(InData%u_BD,2) - DO i1 = LBOUND(InData%u_BD,1), UBOUND(InData%u_BD,1) - Int_BufSz = Int_BufSz + 3 ! u_BD: size of buffers for each call to pack subtype - CALL BD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_BD(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! u_BD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_BD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_BD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_BD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! x_ED allocated yes/no - IF ( ALLOCATED(InData%x_ED) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! x_ED upper/lower bounds for each dimension - DO i1 = LBOUND(InData%x_ED,1), UBOUND(InData%x_ED,1) - Int_BufSz = Int_BufSz + 3 ! x_ED: size of buffers for each call to pack subtype - CALL ED_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_ED(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x_ED - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x_ED - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x_ED - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x_ED - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! xd_ED allocated yes/no - IF ( ALLOCATED(InData%xd_ED) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! xd_ED upper/lower bounds for each dimension - DO i1 = LBOUND(InData%xd_ED,1), UBOUND(InData%xd_ED,1) - Int_BufSz = Int_BufSz + 3 ! xd_ED: size of buffers for each call to pack subtype - CALL ED_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_ED(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd_ED - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xd_ED - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd_ED - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd_ED - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! z_ED allocated yes/no - IF ( ALLOCATED(InData%z_ED) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! z_ED upper/lower bounds for each dimension - DO i1 = LBOUND(InData%z_ED,1), UBOUND(InData%z_ED,1) - Int_BufSz = Int_BufSz + 3 ! z_ED: size of buffers for each call to pack subtype - CALL ED_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_ED(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z_ED - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! z_ED - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! z_ED - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! z_ED - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! OtherSt_ED allocated yes/no - IF ( ALLOCATED(InData%OtherSt_ED) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OtherSt_ED upper/lower bounds for each dimension - DO i1 = LBOUND(InData%OtherSt_ED,1), UBOUND(InData%OtherSt_ED,1) - Int_BufSz = Int_BufSz + 3 ! OtherSt_ED: size of buffers for each call to pack subtype - CALL ED_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_ED(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt_ED - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt_ED - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt_ED - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt_ED - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! u_ED allocated yes/no - IF ( ALLOCATED(InData%u_ED) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! u_ED upper/lower bounds for each dimension - DO i1 = LBOUND(InData%u_ED,1), UBOUND(InData%u_ED,1) - Int_BufSz = Int_BufSz + 3 ! u_ED: size of buffers for each call to pack subtype - CALL ED_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_ED(i1), ErrStat2, ErrMsg2, .TRUE. ) ! u_ED - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_ED - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_ED - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_ED - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! x_SrvD allocated yes/no - IF ( ALLOCATED(InData%x_SrvD) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! x_SrvD upper/lower bounds for each dimension - DO i1 = LBOUND(InData%x_SrvD,1), UBOUND(InData%x_SrvD,1) - Int_BufSz = Int_BufSz + 3 ! x_SrvD: size of buffers for each call to pack subtype - CALL SrvD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_SrvD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x_SrvD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x_SrvD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x_SrvD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x_SrvD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! xd_SrvD allocated yes/no - IF ( ALLOCATED(InData%xd_SrvD) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! xd_SrvD upper/lower bounds for each dimension - DO i1 = LBOUND(InData%xd_SrvD,1), UBOUND(InData%xd_SrvD,1) - Int_BufSz = Int_BufSz + 3 ! xd_SrvD: size of buffers for each call to pack subtype - CALL SrvD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_SrvD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd_SrvD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xd_SrvD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd_SrvD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd_SrvD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! z_SrvD allocated yes/no - IF ( ALLOCATED(InData%z_SrvD) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! z_SrvD upper/lower bounds for each dimension - DO i1 = LBOUND(InData%z_SrvD,1), UBOUND(InData%z_SrvD,1) - Int_BufSz = Int_BufSz + 3 ! z_SrvD: size of buffers for each call to pack subtype - CALL SrvD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_SrvD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z_SrvD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! z_SrvD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! z_SrvD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! z_SrvD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! OtherSt_SrvD allocated yes/no - IF ( ALLOCATED(InData%OtherSt_SrvD) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OtherSt_SrvD upper/lower bounds for each dimension - DO i1 = LBOUND(InData%OtherSt_SrvD,1), UBOUND(InData%OtherSt_SrvD,1) - Int_BufSz = Int_BufSz + 3 ! OtherSt_SrvD: size of buffers for each call to pack subtype - CALL SrvD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_SrvD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt_SrvD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt_SrvD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt_SrvD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt_SrvD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! u_SrvD allocated yes/no - IF ( ALLOCATED(InData%u_SrvD) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! u_SrvD upper/lower bounds for each dimension - DO i1 = LBOUND(InData%u_SrvD,1), UBOUND(InData%u_SrvD,1) - Int_BufSz = Int_BufSz + 3 ! u_SrvD: size of buffers for each call to pack subtype - CALL SrvD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_SrvD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! u_SrvD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_SrvD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_SrvD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_SrvD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! x_AD allocated yes/no - IF ( ALLOCATED(InData%x_AD) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! x_AD upper/lower bounds for each dimension - DO i1 = LBOUND(InData%x_AD,1), UBOUND(InData%x_AD,1) - Int_BufSz = Int_BufSz + 3 ! x_AD: size of buffers for each call to pack subtype - CALL AD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_AD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x_AD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x_AD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x_AD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x_AD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! xd_AD allocated yes/no - IF ( ALLOCATED(InData%xd_AD) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! xd_AD upper/lower bounds for each dimension - DO i1 = LBOUND(InData%xd_AD,1), UBOUND(InData%xd_AD,1) - Int_BufSz = Int_BufSz + 3 ! xd_AD: size of buffers for each call to pack subtype - CALL AD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_AD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd_AD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xd_AD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd_AD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd_AD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! z_AD allocated yes/no - IF ( ALLOCATED(InData%z_AD) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! z_AD upper/lower bounds for each dimension - DO i1 = LBOUND(InData%z_AD,1), UBOUND(InData%z_AD,1) - Int_BufSz = Int_BufSz + 3 ! z_AD: size of buffers for each call to pack subtype - CALL AD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_AD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z_AD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! z_AD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! z_AD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! z_AD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! OtherSt_AD allocated yes/no - IF ( ALLOCATED(InData%OtherSt_AD) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OtherSt_AD upper/lower bounds for each dimension - DO i1 = LBOUND(InData%OtherSt_AD,1), UBOUND(InData%OtherSt_AD,1) - Int_BufSz = Int_BufSz + 3 ! OtherSt_AD: size of buffers for each call to pack subtype - CALL AD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_AD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt_AD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt_AD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt_AD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt_AD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! u_AD allocated yes/no - IF ( ALLOCATED(InData%u_AD) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! u_AD upper/lower bounds for each dimension - DO i1 = LBOUND(InData%u_AD,1), UBOUND(InData%u_AD,1) - Int_BufSz = Int_BufSz + 3 ! u_AD: size of buffers for each call to pack subtype - CALL AD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_AD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! u_AD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_AD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_AD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_AD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! x_IfW allocated yes/no - IF ( ALLOCATED(InData%x_IfW) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! x_IfW upper/lower bounds for each dimension - DO i1 = LBOUND(InData%x_IfW,1), UBOUND(InData%x_IfW,1) - Int_BufSz = Int_BufSz + 3 ! x_IfW: size of buffers for each call to pack subtype - CALL InflowWind_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_IfW(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x_IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x_IfW - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x_IfW - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x_IfW - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! xd_IfW allocated yes/no - IF ( ALLOCATED(InData%xd_IfW) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! xd_IfW upper/lower bounds for each dimension - DO i1 = LBOUND(InData%xd_IfW,1), UBOUND(InData%xd_IfW,1) - Int_BufSz = Int_BufSz + 3 ! xd_IfW: size of buffers for each call to pack subtype - CALL InflowWind_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_IfW(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd_IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xd_IfW - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd_IfW - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd_IfW - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! z_IfW allocated yes/no - IF ( ALLOCATED(InData%z_IfW) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! z_IfW upper/lower bounds for each dimension - DO i1 = LBOUND(InData%z_IfW,1), UBOUND(InData%z_IfW,1) - Int_BufSz = Int_BufSz + 3 ! z_IfW: size of buffers for each call to pack subtype - CALL InflowWind_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_IfW(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z_IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! z_IfW - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! z_IfW - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! z_IfW - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! OtherSt_IfW allocated yes/no - IF ( ALLOCATED(InData%OtherSt_IfW) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OtherSt_IfW upper/lower bounds for each dimension - DO i1 = LBOUND(InData%OtherSt_IfW,1), UBOUND(InData%OtherSt_IfW,1) - Int_BufSz = Int_BufSz + 3 ! OtherSt_IfW: size of buffers for each call to pack subtype - CALL InflowWind_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_IfW(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt_IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt_IfW - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt_IfW - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt_IfW - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! u_IfW allocated yes/no - IF ( ALLOCATED(InData%u_IfW) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! u_IfW upper/lower bounds for each dimension - DO i1 = LBOUND(InData%u_IfW,1), UBOUND(InData%u_IfW,1) - Int_BufSz = Int_BufSz + 3 ! u_IfW: size of buffers for each call to pack subtype - CALL InflowWind_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_IfW(i1), ErrStat2, ErrMsg2, .TRUE. ) ! u_IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_IfW - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_IfW - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_IfW - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! x_SD allocated yes/no - IF ( ALLOCATED(InData%x_SD) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! x_SD upper/lower bounds for each dimension - DO i1 = LBOUND(InData%x_SD,1), UBOUND(InData%x_SD,1) - Int_BufSz = Int_BufSz + 3 ! x_SD: size of buffers for each call to pack subtype - CALL SD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_SD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x_SD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x_SD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x_SD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x_SD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! xd_SD allocated yes/no - IF ( ALLOCATED(InData%xd_SD) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! xd_SD upper/lower bounds for each dimension - DO i1 = LBOUND(InData%xd_SD,1), UBOUND(InData%xd_SD,1) - Int_BufSz = Int_BufSz + 3 ! xd_SD: size of buffers for each call to pack subtype - CALL SD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_SD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd_SD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xd_SD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd_SD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd_SD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! z_SD allocated yes/no - IF ( ALLOCATED(InData%z_SD) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! z_SD upper/lower bounds for each dimension - DO i1 = LBOUND(InData%z_SD,1), UBOUND(InData%z_SD,1) - Int_BufSz = Int_BufSz + 3 ! z_SD: size of buffers for each call to pack subtype - CALL SD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_SD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z_SD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! z_SD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! z_SD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! z_SD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! OtherSt_SD allocated yes/no - IF ( ALLOCATED(InData%OtherSt_SD) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OtherSt_SD upper/lower bounds for each dimension - DO i1 = LBOUND(InData%OtherSt_SD,1), UBOUND(InData%OtherSt_SD,1) - Int_BufSz = Int_BufSz + 3 ! OtherSt_SD: size of buffers for each call to pack subtype - CALL SD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_SD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt_SD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt_SD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt_SD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt_SD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! u_SD allocated yes/no - IF ( ALLOCATED(InData%u_SD) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! u_SD upper/lower bounds for each dimension - DO i1 = LBOUND(InData%u_SD,1), UBOUND(InData%u_SD,1) - Int_BufSz = Int_BufSz + 3 ! u_SD: size of buffers for each call to pack subtype - CALL SD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_SD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! u_SD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_SD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_SD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_SD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! x_ExtPtfm allocated yes/no - IF ( ALLOCATED(InData%x_ExtPtfm) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! x_ExtPtfm upper/lower bounds for each dimension - DO i1 = LBOUND(InData%x_ExtPtfm,1), UBOUND(InData%x_ExtPtfm,1) - Int_BufSz = Int_BufSz + 3 ! x_ExtPtfm: size of buffers for each call to pack subtype - CALL ExtPtfm_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_ExtPtfm(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x_ExtPtfm - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x_ExtPtfm - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x_ExtPtfm - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x_ExtPtfm - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! xd_ExtPtfm allocated yes/no - IF ( ALLOCATED(InData%xd_ExtPtfm) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! xd_ExtPtfm upper/lower bounds for each dimension - DO i1 = LBOUND(InData%xd_ExtPtfm,1), UBOUND(InData%xd_ExtPtfm,1) - Int_BufSz = Int_BufSz + 3 ! xd_ExtPtfm: size of buffers for each call to pack subtype - CALL ExtPtfm_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_ExtPtfm(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd_ExtPtfm - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xd_ExtPtfm - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd_ExtPtfm - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd_ExtPtfm - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! z_ExtPtfm allocated yes/no - IF ( ALLOCATED(InData%z_ExtPtfm) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! z_ExtPtfm upper/lower bounds for each dimension - DO i1 = LBOUND(InData%z_ExtPtfm,1), UBOUND(InData%z_ExtPtfm,1) - Int_BufSz = Int_BufSz + 3 ! z_ExtPtfm: size of buffers for each call to pack subtype - CALL ExtPtfm_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_ExtPtfm(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z_ExtPtfm - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! z_ExtPtfm - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! z_ExtPtfm - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! z_ExtPtfm - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! OtherSt_ExtPtfm allocated yes/no - IF ( ALLOCATED(InData%OtherSt_ExtPtfm) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OtherSt_ExtPtfm upper/lower bounds for each dimension - DO i1 = LBOUND(InData%OtherSt_ExtPtfm,1), UBOUND(InData%OtherSt_ExtPtfm,1) - Int_BufSz = Int_BufSz + 3 ! OtherSt_ExtPtfm: size of buffers for each call to pack subtype - CALL ExtPtfm_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_ExtPtfm(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt_ExtPtfm - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt_ExtPtfm - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt_ExtPtfm - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt_ExtPtfm - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! u_ExtPtfm allocated yes/no - IF ( ALLOCATED(InData%u_ExtPtfm) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! u_ExtPtfm upper/lower bounds for each dimension - DO i1 = LBOUND(InData%u_ExtPtfm,1), UBOUND(InData%u_ExtPtfm,1) - Int_BufSz = Int_BufSz + 3 ! u_ExtPtfm: size of buffers for each call to pack subtype - CALL ExtPtfm_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_ExtPtfm(i1), ErrStat2, ErrMsg2, .TRUE. ) ! u_ExtPtfm - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_ExtPtfm - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_ExtPtfm - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_ExtPtfm - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! x_HD allocated yes/no - IF ( ALLOCATED(InData%x_HD) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! x_HD upper/lower bounds for each dimension - DO i1 = LBOUND(InData%x_HD,1), UBOUND(InData%x_HD,1) - Int_BufSz = Int_BufSz + 3 ! x_HD: size of buffers for each call to pack subtype - CALL HydroDyn_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_HD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x_HD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x_HD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x_HD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x_HD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! xd_HD allocated yes/no - IF ( ALLOCATED(InData%xd_HD) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! xd_HD upper/lower bounds for each dimension - DO i1 = LBOUND(InData%xd_HD,1), UBOUND(InData%xd_HD,1) - Int_BufSz = Int_BufSz + 3 ! xd_HD: size of buffers for each call to pack subtype - CALL HydroDyn_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_HD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd_HD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xd_HD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd_HD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd_HD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! z_HD allocated yes/no - IF ( ALLOCATED(InData%z_HD) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! z_HD upper/lower bounds for each dimension - DO i1 = LBOUND(InData%z_HD,1), UBOUND(InData%z_HD,1) - Int_BufSz = Int_BufSz + 3 ! z_HD: size of buffers for each call to pack subtype - CALL HydroDyn_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_HD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z_HD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! z_HD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! z_HD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! z_HD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! OtherSt_HD allocated yes/no - IF ( ALLOCATED(InData%OtherSt_HD) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OtherSt_HD upper/lower bounds for each dimension - DO i1 = LBOUND(InData%OtherSt_HD,1), UBOUND(InData%OtherSt_HD,1) - Int_BufSz = Int_BufSz + 3 ! OtherSt_HD: size of buffers for each call to pack subtype - CALL HydroDyn_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_HD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt_HD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt_HD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt_HD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt_HD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! u_HD allocated yes/no - IF ( ALLOCATED(InData%u_HD) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! u_HD upper/lower bounds for each dimension - DO i1 = LBOUND(InData%u_HD,1), UBOUND(InData%u_HD,1) - Int_BufSz = Int_BufSz + 3 ! u_HD: size of buffers for each call to pack subtype - CALL HydroDyn_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_HD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! u_HD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_HD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_HD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_HD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! x_IceF allocated yes/no - IF ( ALLOCATED(InData%x_IceF) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! x_IceF upper/lower bounds for each dimension - DO i1 = LBOUND(InData%x_IceF,1), UBOUND(InData%x_IceF,1) - Int_BufSz = Int_BufSz + 3 ! x_IceF: size of buffers for each call to pack subtype - CALL IceFloe_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_IceF(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x_IceF - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x_IceF - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x_IceF - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x_IceF - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! xd_IceF allocated yes/no - IF ( ALLOCATED(InData%xd_IceF) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! xd_IceF upper/lower bounds for each dimension - DO i1 = LBOUND(InData%xd_IceF,1), UBOUND(InData%xd_IceF,1) - Int_BufSz = Int_BufSz + 3 ! xd_IceF: size of buffers for each call to pack subtype - CALL IceFloe_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_IceF(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd_IceF - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xd_IceF - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd_IceF - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd_IceF - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! z_IceF allocated yes/no - IF ( ALLOCATED(InData%z_IceF) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! z_IceF upper/lower bounds for each dimension - DO i1 = LBOUND(InData%z_IceF,1), UBOUND(InData%z_IceF,1) - Int_BufSz = Int_BufSz + 3 ! z_IceF: size of buffers for each call to pack subtype - CALL IceFloe_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_IceF(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z_IceF - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! z_IceF - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! z_IceF - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! z_IceF - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! OtherSt_IceF allocated yes/no - IF ( ALLOCATED(InData%OtherSt_IceF) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OtherSt_IceF upper/lower bounds for each dimension - DO i1 = LBOUND(InData%OtherSt_IceF,1), UBOUND(InData%OtherSt_IceF,1) - Int_BufSz = Int_BufSz + 3 ! OtherSt_IceF: size of buffers for each call to pack subtype - CALL IceFloe_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_IceF(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt_IceF - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt_IceF - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt_IceF - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt_IceF - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! u_IceF allocated yes/no - IF ( ALLOCATED(InData%u_IceF) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! u_IceF upper/lower bounds for each dimension - DO i1 = LBOUND(InData%u_IceF,1), UBOUND(InData%u_IceF,1) - Int_BufSz = Int_BufSz + 3 ! u_IceF: size of buffers for each call to pack subtype - CALL IceFloe_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_IceF(i1), ErrStat2, ErrMsg2, .TRUE. ) ! u_IceF - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_IceF - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_IceF - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_IceF - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! x_MAP allocated yes/no - IF ( ALLOCATED(InData%x_MAP) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! x_MAP upper/lower bounds for each dimension - DO i1 = LBOUND(InData%x_MAP,1), UBOUND(InData%x_MAP,1) - Int_BufSz = Int_BufSz + 3 ! x_MAP: size of buffers for each call to pack subtype - CALL MAP_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_MAP(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x_MAP - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x_MAP - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x_MAP - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x_MAP - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! xd_MAP allocated yes/no - IF ( ALLOCATED(InData%xd_MAP) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! xd_MAP upper/lower bounds for each dimension - DO i1 = LBOUND(InData%xd_MAP,1), UBOUND(InData%xd_MAP,1) - Int_BufSz = Int_BufSz + 3 ! xd_MAP: size of buffers for each call to pack subtype - CALL MAP_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_MAP(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd_MAP - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xd_MAP - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd_MAP - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd_MAP - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! z_MAP allocated yes/no - IF ( ALLOCATED(InData%z_MAP) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! z_MAP upper/lower bounds for each dimension - DO i1 = LBOUND(InData%z_MAP,1), UBOUND(InData%z_MAP,1) - Int_BufSz = Int_BufSz + 3 ! z_MAP: size of buffers for each call to pack subtype - CALL MAP_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_MAP(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z_MAP - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! z_MAP - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! z_MAP - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! z_MAP - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! u_MAP allocated yes/no - IF ( ALLOCATED(InData%u_MAP) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! u_MAP upper/lower bounds for each dimension - DO i1 = LBOUND(InData%u_MAP,1), UBOUND(InData%u_MAP,1) - Int_BufSz = Int_BufSz + 3 ! u_MAP: size of buffers for each call to pack subtype - CALL MAP_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_MAP(i1), ErrStat2, ErrMsg2, .TRUE. ) ! u_MAP - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_MAP - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_MAP - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_MAP - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! x_FEAM allocated yes/no - IF ( ALLOCATED(InData%x_FEAM) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! x_FEAM upper/lower bounds for each dimension - DO i1 = LBOUND(InData%x_FEAM,1), UBOUND(InData%x_FEAM,1) - Int_BufSz = Int_BufSz + 3 ! x_FEAM: size of buffers for each call to pack subtype - CALL FEAM_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_FEAM(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x_FEAM - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x_FEAM - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x_FEAM - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x_FEAM - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! xd_FEAM allocated yes/no - IF ( ALLOCATED(InData%xd_FEAM) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! xd_FEAM upper/lower bounds for each dimension - DO i1 = LBOUND(InData%xd_FEAM,1), UBOUND(InData%xd_FEAM,1) - Int_BufSz = Int_BufSz + 3 ! xd_FEAM: size of buffers for each call to pack subtype - CALL FEAM_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_FEAM(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd_FEAM - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xd_FEAM - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd_FEAM - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd_FEAM - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! z_FEAM allocated yes/no - IF ( ALLOCATED(InData%z_FEAM) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! z_FEAM upper/lower bounds for each dimension - DO i1 = LBOUND(InData%z_FEAM,1), UBOUND(InData%z_FEAM,1) - Int_BufSz = Int_BufSz + 3 ! z_FEAM: size of buffers for each call to pack subtype - CALL FEAM_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_FEAM(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z_FEAM - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! z_FEAM - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! z_FEAM - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! z_FEAM - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! OtherSt_FEAM allocated yes/no - IF ( ALLOCATED(InData%OtherSt_FEAM) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OtherSt_FEAM upper/lower bounds for each dimension - DO i1 = LBOUND(InData%OtherSt_FEAM,1), UBOUND(InData%OtherSt_FEAM,1) - Int_BufSz = Int_BufSz + 3 ! OtherSt_FEAM: size of buffers for each call to pack subtype - CALL FEAM_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_FEAM(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt_FEAM - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt_FEAM - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt_FEAM - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt_FEAM - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! u_FEAM allocated yes/no - IF ( ALLOCATED(InData%u_FEAM) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! u_FEAM upper/lower bounds for each dimension - DO i1 = LBOUND(InData%u_FEAM,1), UBOUND(InData%u_FEAM,1) - Int_BufSz = Int_BufSz + 3 ! u_FEAM: size of buffers for each call to pack subtype - CALL FEAM_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_FEAM(i1), ErrStat2, ErrMsg2, .TRUE. ) ! u_FEAM - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_FEAM - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_FEAM - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_FEAM - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! x_MD allocated yes/no - IF ( ALLOCATED(InData%x_MD) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! x_MD upper/lower bounds for each dimension - DO i1 = LBOUND(InData%x_MD,1), UBOUND(InData%x_MD,1) - Int_BufSz = Int_BufSz + 3 ! x_MD: size of buffers for each call to pack subtype - CALL MD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_MD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x_MD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x_MD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x_MD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x_MD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! xd_MD allocated yes/no - IF ( ALLOCATED(InData%xd_MD) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! xd_MD upper/lower bounds for each dimension - DO i1 = LBOUND(InData%xd_MD,1), UBOUND(InData%xd_MD,1) - Int_BufSz = Int_BufSz + 3 ! xd_MD: size of buffers for each call to pack subtype - CALL MD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_MD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd_MD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xd_MD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd_MD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd_MD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! z_MD allocated yes/no - IF ( ALLOCATED(InData%z_MD) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! z_MD upper/lower bounds for each dimension - DO i1 = LBOUND(InData%z_MD,1), UBOUND(InData%z_MD,1) - Int_BufSz = Int_BufSz + 3 ! z_MD: size of buffers for each call to pack subtype - CALL MD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_MD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z_MD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! z_MD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! z_MD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! z_MD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! OtherSt_MD allocated yes/no - IF ( ALLOCATED(InData%OtherSt_MD) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OtherSt_MD upper/lower bounds for each dimension - DO i1 = LBOUND(InData%OtherSt_MD,1), UBOUND(InData%OtherSt_MD,1) - Int_BufSz = Int_BufSz + 3 ! OtherSt_MD: size of buffers for each call to pack subtype - CALL MD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_MD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt_MD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt_MD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt_MD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt_MD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! u_MD allocated yes/no - IF ( ALLOCATED(InData%u_MD) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! u_MD upper/lower bounds for each dimension - DO i1 = LBOUND(InData%u_MD,1), UBOUND(InData%u_MD,1) - Int_BufSz = Int_BufSz + 3 ! u_MD: size of buffers for each call to pack subtype - CALL MD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_MD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! u_MD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_MD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_MD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_MD - 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%x_IceD) ) THEN - 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_IceD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x_IceD,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%x_IceD,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x_IceD,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%x_IceD,2), UBOUND(InData%x_IceD,2) - DO i1 = LBOUND(InData%x_IceD,1), UBOUND(InData%x_IceD,1) - CALL IceD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_IceD(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! x_IceD - 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 DO - END IF - IF ( .NOT. ALLOCATED(InData%xd_IceD) ) THEN - 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_IceD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xd_IceD,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%xd_IceD,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xd_IceD,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%xd_IceD,2), UBOUND(InData%xd_IceD,2) - DO i1 = LBOUND(InData%xd_IceD,1), UBOUND(InData%xd_IceD,1) - CALL IceD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_IceD(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! xd_IceD - 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 DO - END IF - IF ( .NOT. ALLOCATED(InData%z_IceD) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%z_IceD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z_IceD,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%z_IceD,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z_IceD,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%z_IceD,2), UBOUND(InData%z_IceD,2) - DO i1 = LBOUND(InData%z_IceD,1), UBOUND(InData%z_IceD,1) - CALL IceD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_IceD(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! z_IceD - 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 DO - END IF - IF ( .NOT. ALLOCATED(InData%OtherSt_IceD) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OtherSt_IceD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OtherSt_IceD,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OtherSt_IceD,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OtherSt_IceD,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%OtherSt_IceD,2), UBOUND(InData%OtherSt_IceD,2) - DO i1 = LBOUND(InData%OtherSt_IceD,1), UBOUND(InData%OtherSt_IceD,1) - CALL IceD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_IceD(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt_IceD - 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 DO - END IF - IF ( .NOT. ALLOCATED(InData%u_IceD) ) THEN - 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_IceD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_IceD,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%u_IceD,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_IceD,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%u_IceD,2), UBOUND(InData%u_IceD,2) - DO i1 = LBOUND(InData%u_IceD,1), UBOUND(InData%u_IceD,1) - CALL IceD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_IceD(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! u_IceD - 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 DO - END IF - IF ( .NOT. ALLOCATED(InData%x_BD) ) THEN - 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_BD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x_BD,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%x_BD,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x_BD,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%x_BD,2), UBOUND(InData%x_BD,2) - DO i1 = LBOUND(InData%x_BD,1), UBOUND(InData%x_BD,1) - CALL BD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_BD(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! x_BD - 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 DO - END IF - IF ( .NOT. ALLOCATED(InData%xd_BD) ) THEN - 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_BD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xd_BD,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%xd_BD,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xd_BD,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%xd_BD,2), UBOUND(InData%xd_BD,2) - DO i1 = LBOUND(InData%xd_BD,1), UBOUND(InData%xd_BD,1) - CALL BD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_BD(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! xd_BD - 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 DO - END IF - IF ( .NOT. ALLOCATED(InData%z_BD) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%z_BD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z_BD,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%z_BD,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z_BD,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%z_BD,2), UBOUND(InData%z_BD,2) - DO i1 = LBOUND(InData%z_BD,1), UBOUND(InData%z_BD,1) - CALL BD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_BD(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! z_BD - 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 DO - END IF - IF ( .NOT. ALLOCATED(InData%OtherSt_BD) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OtherSt_BD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OtherSt_BD,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OtherSt_BD,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OtherSt_BD,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%OtherSt_BD,2), UBOUND(InData%OtherSt_BD,2) - DO i1 = LBOUND(InData%OtherSt_BD,1), UBOUND(InData%OtherSt_BD,1) - CALL BD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_BD(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt_BD - 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 DO - END IF - IF ( .NOT. ALLOCATED(InData%u_BD) ) THEN - 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_BD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_BD,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%u_BD,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_BD,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%u_BD,2), UBOUND(InData%u_BD,2) - DO i1 = LBOUND(InData%u_BD,1), UBOUND(InData%u_BD,1) - CALL BD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_BD(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! u_BD - 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 DO - END IF - IF ( .NOT. ALLOCATED(InData%x_ED) ) THEN - 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_ED,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x_ED,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%x_ED,1), UBOUND(InData%x_ED,1) - CALL ED_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_ED(i1), ErrStat2, ErrMsg2, OnlySize ) ! x_ED - 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%xd_ED) ) THEN - 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_ED,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xd_ED,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%xd_ED,1), UBOUND(InData%xd_ED,1) - CALL ED_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_ED(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd_ED - 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%z_ED) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%z_ED,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z_ED,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%z_ED,1), UBOUND(InData%z_ED,1) - CALL ED_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_ED(i1), ErrStat2, ErrMsg2, OnlySize ) ! z_ED - 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%OtherSt_ED) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OtherSt_ED,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OtherSt_ED,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%OtherSt_ED,1), UBOUND(InData%OtherSt_ED,1) - CALL ED_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_ED(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt_ED - 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%u_ED) ) THEN - 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_ED,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_ED,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%u_ED,1), UBOUND(InData%u_ED,1) - CALL ED_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_ED(i1), ErrStat2, ErrMsg2, OnlySize ) ! u_ED - 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%x_SrvD) ) THEN - 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_SrvD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x_SrvD,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%x_SrvD,1), UBOUND(InData%x_SrvD,1) - CALL SrvD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_SrvD(i1), ErrStat2, ErrMsg2, OnlySize ) ! x_SrvD - 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%xd_SrvD) ) THEN - 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_SrvD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xd_SrvD,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%xd_SrvD,1), UBOUND(InData%xd_SrvD,1) - CALL SrvD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_SrvD(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd_SrvD - 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%z_SrvD) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%z_SrvD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z_SrvD,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%z_SrvD,1), UBOUND(InData%z_SrvD,1) - CALL SrvD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_SrvD(i1), ErrStat2, ErrMsg2, OnlySize ) ! z_SrvD - 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%OtherSt_SrvD) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OtherSt_SrvD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OtherSt_SrvD,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%OtherSt_SrvD,1), UBOUND(InData%OtherSt_SrvD,1) - CALL SrvD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_SrvD(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt_SrvD - 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%u_SrvD) ) THEN - 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_SrvD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_SrvD,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%u_SrvD,1), UBOUND(InData%u_SrvD,1) - CALL SrvD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_SrvD(i1), ErrStat2, ErrMsg2, OnlySize ) ! u_SrvD - 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%x_AD) ) THEN - 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_AD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x_AD,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%x_AD,1), UBOUND(InData%x_AD,1) - CALL AD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_AD(i1), ErrStat2, ErrMsg2, OnlySize ) ! x_AD - 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%xd_AD) ) THEN - 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_AD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xd_AD,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%xd_AD,1), UBOUND(InData%xd_AD,1) - CALL AD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_AD(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd_AD - 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%z_AD) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%z_AD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z_AD,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%z_AD,1), UBOUND(InData%z_AD,1) - CALL AD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_AD(i1), ErrStat2, ErrMsg2, OnlySize ) ! z_AD - 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%OtherSt_AD) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OtherSt_AD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OtherSt_AD,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%OtherSt_AD,1), UBOUND(InData%OtherSt_AD,1) - CALL AD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_AD(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt_AD - 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%u_AD) ) THEN - 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_AD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_AD,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%u_AD,1), UBOUND(InData%u_AD,1) - CALL AD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_AD(i1), ErrStat2, ErrMsg2, OnlySize ) ! u_AD - 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%x_IfW) ) THEN - 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_IfW,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x_IfW,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%x_IfW,1), UBOUND(InData%x_IfW,1) - CALL InflowWind_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_IfW(i1), ErrStat2, ErrMsg2, OnlySize ) ! x_IfW - 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%xd_IfW) ) THEN - 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_IfW,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xd_IfW,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%xd_IfW,1), UBOUND(InData%xd_IfW,1) - CALL InflowWind_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_IfW(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd_IfW - 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%z_IfW) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%z_IfW,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z_IfW,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%z_IfW,1), UBOUND(InData%z_IfW,1) - CALL InflowWind_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_IfW(i1), ErrStat2, ErrMsg2, OnlySize ) ! z_IfW - 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%OtherSt_IfW) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OtherSt_IfW,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OtherSt_IfW,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%OtherSt_IfW,1), UBOUND(InData%OtherSt_IfW,1) - CALL InflowWind_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_IfW(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt_IfW - 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%u_IfW) ) THEN - 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_IfW,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_IfW,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%u_IfW,1), UBOUND(InData%u_IfW,1) - CALL InflowWind_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_IfW(i1), ErrStat2, ErrMsg2, OnlySize ) ! u_IfW - 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%x_SD) ) THEN - 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_SD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x_SD,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%x_SD,1), UBOUND(InData%x_SD,1) - CALL SD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_SD(i1), ErrStat2, ErrMsg2, OnlySize ) ! x_SD - 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%xd_SD) ) THEN - 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_SD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xd_SD,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%xd_SD,1), UBOUND(InData%xd_SD,1) - CALL SD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_SD(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd_SD - 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%z_SD) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%z_SD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z_SD,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%z_SD,1), UBOUND(InData%z_SD,1) - CALL SD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_SD(i1), ErrStat2, ErrMsg2, OnlySize ) ! z_SD - 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%OtherSt_SD) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OtherSt_SD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OtherSt_SD,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%OtherSt_SD,1), UBOUND(InData%OtherSt_SD,1) - CALL SD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_SD(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt_SD - 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%u_SD) ) THEN - 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_SD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_SD,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%u_SD,1), UBOUND(InData%u_SD,1) - CALL SD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_SD(i1), ErrStat2, ErrMsg2, OnlySize ) ! u_SD - 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%x_ExtPtfm) ) THEN - 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_ExtPtfm,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x_ExtPtfm,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%x_ExtPtfm,1), UBOUND(InData%x_ExtPtfm,1) - CALL ExtPtfm_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_ExtPtfm(i1), ErrStat2, ErrMsg2, OnlySize ) ! x_ExtPtfm - 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%xd_ExtPtfm) ) THEN - 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_ExtPtfm,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xd_ExtPtfm,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%xd_ExtPtfm,1), UBOUND(InData%xd_ExtPtfm,1) - CALL ExtPtfm_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_ExtPtfm(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd_ExtPtfm - 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%z_ExtPtfm) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%z_ExtPtfm,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z_ExtPtfm,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%z_ExtPtfm,1), UBOUND(InData%z_ExtPtfm,1) - CALL ExtPtfm_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_ExtPtfm(i1), ErrStat2, ErrMsg2, OnlySize ) ! z_ExtPtfm - 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%OtherSt_ExtPtfm) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OtherSt_ExtPtfm,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OtherSt_ExtPtfm,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%OtherSt_ExtPtfm,1), UBOUND(InData%OtherSt_ExtPtfm,1) - CALL ExtPtfm_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_ExtPtfm(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt_ExtPtfm - 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%u_ExtPtfm) ) THEN - 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_ExtPtfm,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_ExtPtfm,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%u_ExtPtfm,1), UBOUND(InData%u_ExtPtfm,1) - CALL ExtPtfm_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_ExtPtfm(i1), ErrStat2, ErrMsg2, OnlySize ) ! u_ExtPtfm - 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%x_HD) ) THEN - 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_HD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x_HD,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%x_HD,1), UBOUND(InData%x_HD,1) - CALL HydroDyn_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_HD(i1), ErrStat2, ErrMsg2, OnlySize ) ! x_HD - 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%xd_HD) ) THEN - 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_HD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xd_HD,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%xd_HD,1), UBOUND(InData%xd_HD,1) - CALL HydroDyn_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_HD(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd_HD - 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%z_HD) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%z_HD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z_HD,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%z_HD,1), UBOUND(InData%z_HD,1) - CALL HydroDyn_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_HD(i1), ErrStat2, ErrMsg2, OnlySize ) ! z_HD - 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%OtherSt_HD) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OtherSt_HD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OtherSt_HD,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%OtherSt_HD,1), UBOUND(InData%OtherSt_HD,1) - CALL HydroDyn_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_HD(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt_HD - 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%u_HD) ) THEN - 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_HD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_HD,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%u_HD,1), UBOUND(InData%u_HD,1) - CALL HydroDyn_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_HD(i1), ErrStat2, ErrMsg2, OnlySize ) ! u_HD - 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%x_IceF) ) THEN - 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_IceF,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x_IceF,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%x_IceF,1), UBOUND(InData%x_IceF,1) - CALL IceFloe_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_IceF(i1), ErrStat2, ErrMsg2, OnlySize ) ! x_IceF - 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%xd_IceF) ) THEN - 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_IceF,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xd_IceF,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%xd_IceF,1), UBOUND(InData%xd_IceF,1) - CALL IceFloe_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_IceF(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd_IceF - 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%z_IceF) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%z_IceF,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z_IceF,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%z_IceF,1), UBOUND(InData%z_IceF,1) - CALL IceFloe_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_IceF(i1), ErrStat2, ErrMsg2, OnlySize ) ! z_IceF - 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%OtherSt_IceF) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OtherSt_IceF,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OtherSt_IceF,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%OtherSt_IceF,1), UBOUND(InData%OtherSt_IceF,1) - CALL IceFloe_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_IceF(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt_IceF - 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%u_IceF) ) THEN - 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_IceF,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_IceF,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%u_IceF,1), UBOUND(InData%u_IceF,1) - CALL IceFloe_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_IceF(i1), ErrStat2, ErrMsg2, OnlySize ) ! u_IceF - 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%x_MAP) ) THEN - 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_MAP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x_MAP,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%x_MAP,1), UBOUND(InData%x_MAP,1) - CALL MAP_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_MAP(i1), ErrStat2, ErrMsg2, OnlySize ) ! x_MAP - 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%xd_MAP) ) THEN - 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_MAP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xd_MAP,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%xd_MAP,1), UBOUND(InData%xd_MAP,1) - CALL MAP_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_MAP(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd_MAP - 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%z_MAP) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%z_MAP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z_MAP,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%z_MAP,1), UBOUND(InData%z_MAP,1) - CALL MAP_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_MAP(i1), ErrStat2, ErrMsg2, OnlySize ) ! z_MAP - 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%u_MAP) ) THEN - 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_MAP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_MAP,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%u_MAP,1), UBOUND(InData%u_MAP,1) - CALL MAP_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_MAP(i1), ErrStat2, ErrMsg2, OnlySize ) ! u_MAP - 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%x_FEAM) ) THEN - 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_FEAM,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x_FEAM,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%x_FEAM,1), UBOUND(InData%x_FEAM,1) - CALL FEAM_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_FEAM(i1), ErrStat2, ErrMsg2, OnlySize ) ! x_FEAM - 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%xd_FEAM) ) THEN - 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_FEAM,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xd_FEAM,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%xd_FEAM,1), UBOUND(InData%xd_FEAM,1) - CALL FEAM_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_FEAM(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd_FEAM - 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%z_FEAM) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%z_FEAM,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z_FEAM,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%z_FEAM,1), UBOUND(InData%z_FEAM,1) - CALL FEAM_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_FEAM(i1), ErrStat2, ErrMsg2, OnlySize ) ! z_FEAM - 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%OtherSt_FEAM) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OtherSt_FEAM,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OtherSt_FEAM,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%OtherSt_FEAM,1), UBOUND(InData%OtherSt_FEAM,1) - CALL FEAM_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_FEAM(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt_FEAM - 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%u_FEAM) ) THEN - 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_FEAM,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_FEAM,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%u_FEAM,1), UBOUND(InData%u_FEAM,1) - CALL FEAM_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_FEAM(i1), ErrStat2, ErrMsg2, OnlySize ) ! u_FEAM - 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%x_MD) ) THEN - 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_MD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x_MD,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%x_MD,1), UBOUND(InData%x_MD,1) - CALL MD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_MD(i1), ErrStat2, ErrMsg2, OnlySize ) ! x_MD - 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%xd_MD) ) THEN - 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_MD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xd_MD,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%xd_MD,1), UBOUND(InData%xd_MD,1) - CALL MD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_MD(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd_MD - 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%z_MD) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%z_MD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z_MD,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%z_MD,1), UBOUND(InData%z_MD,1) - CALL MD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_MD(i1), ErrStat2, ErrMsg2, OnlySize ) ! z_MD - 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%OtherSt_MD) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OtherSt_MD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OtherSt_MD,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%OtherSt_MD,1), UBOUND(InData%OtherSt_MD,1) - CALL MD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_MD(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt_MD - 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%u_MD) ) THEN - 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_MD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_MD,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%u_MD,1), UBOUND(InData%u_MD,1) - CALL MD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_MD(i1), ErrStat2, ErrMsg2, OnlySize ) ! u_MD - 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 FAST_PackLinStateSave - - SUBROUTINE FAST_UnPackLinStateSave( 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(FAST_LinStateSave), 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 = 'FAST_UnPackLinStateSave' - ! 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 ! x_IceD not allocated - Int_Xferred = Int_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%x_IceD)) DEALLOCATE(OutData%x_IceD) - ALLOCATE(OutData%x_IceD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_IceD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%x_IceD,2), UBOUND(OutData%x_IceD,2) - DO i1 = LBOUND(OutData%x_IceD,1), UBOUND(OutData%x_IceD,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 IceD_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x_IceD(i1,i2), ErrStat2, ErrMsg2 ) ! x_IceD - 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 DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! xd_IceD not allocated - Int_Xferred = Int_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%xd_IceD)) DEALLOCATE(OutData%xd_IceD) - ALLOCATE(OutData%xd_IceD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_IceD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%xd_IceD,2), UBOUND(OutData%xd_IceD,2) - DO i1 = LBOUND(OutData%xd_IceD,1), UBOUND(OutData%xd_IceD,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 IceD_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd_IceD(i1,i2), ErrStat2, ErrMsg2 ) ! xd_IceD - 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 DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! z_IceD not allocated - Int_Xferred = Int_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%z_IceD)) DEALLOCATE(OutData%z_IceD) - ALLOCATE(OutData%z_IceD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_IceD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%z_IceD,2), UBOUND(OutData%z_IceD,2) - DO i1 = LBOUND(OutData%z_IceD,1), UBOUND(OutData%z_IceD,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 IceD_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z_IceD(i1,i2), ErrStat2, ErrMsg2 ) ! z_IceD - 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 DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OtherSt_IceD not allocated - Int_Xferred = Int_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%OtherSt_IceD)) DEALLOCATE(OutData%OtherSt_IceD) - ALLOCATE(OutData%OtherSt_IceD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_IceD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%OtherSt_IceD,2), UBOUND(OutData%OtherSt_IceD,2) - DO i1 = LBOUND(OutData%OtherSt_IceD,1), UBOUND(OutData%OtherSt_IceD,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 IceD_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt_IceD(i1,i2), ErrStat2, ErrMsg2 ) ! OtherSt_IceD - 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 DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! u_IceD not allocated - Int_Xferred = Int_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%u_IceD)) DEALLOCATE(OutData%u_IceD) - ALLOCATE(OutData%u_IceD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_IceD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%u_IceD,2), UBOUND(OutData%u_IceD,2) - DO i1 = LBOUND(OutData%u_IceD,1), UBOUND(OutData%u_IceD,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 IceD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u_IceD(i1,i2), ErrStat2, ErrMsg2 ) ! u_IceD - 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 DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! x_BD not allocated - Int_Xferred = Int_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%x_BD)) DEALLOCATE(OutData%x_BD) - ALLOCATE(OutData%x_BD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_BD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%x_BD,2), UBOUND(OutData%x_BD,2) - DO i1 = LBOUND(OutData%x_BD,1), UBOUND(OutData%x_BD,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 BD_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x_BD(i1,i2), ErrStat2, ErrMsg2 ) ! x_BD - 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 DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! xd_BD not allocated - Int_Xferred = Int_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%xd_BD)) DEALLOCATE(OutData%xd_BD) - ALLOCATE(OutData%xd_BD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_BD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%xd_BD,2), UBOUND(OutData%xd_BD,2) - DO i1 = LBOUND(OutData%xd_BD,1), UBOUND(OutData%xd_BD,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 BD_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd_BD(i1,i2), ErrStat2, ErrMsg2 ) ! xd_BD - 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 DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! z_BD not allocated - Int_Xferred = Int_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%z_BD)) DEALLOCATE(OutData%z_BD) - ALLOCATE(OutData%z_BD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_BD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%z_BD,2), UBOUND(OutData%z_BD,2) - DO i1 = LBOUND(OutData%z_BD,1), UBOUND(OutData%z_BD,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 BD_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z_BD(i1,i2), ErrStat2, ErrMsg2 ) ! z_BD - 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 DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OtherSt_BD not allocated - Int_Xferred = Int_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%OtherSt_BD)) DEALLOCATE(OutData%OtherSt_BD) - ALLOCATE(OutData%OtherSt_BD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_BD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%OtherSt_BD,2), UBOUND(OutData%OtherSt_BD,2) - DO i1 = LBOUND(OutData%OtherSt_BD,1), UBOUND(OutData%OtherSt_BD,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 BD_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt_BD(i1,i2), ErrStat2, ErrMsg2 ) ! OtherSt_BD - 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 DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! u_BD not allocated - Int_Xferred = Int_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%u_BD)) DEALLOCATE(OutData%u_BD) - ALLOCATE(OutData%u_BD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_BD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%u_BD,2), UBOUND(OutData%u_BD,2) - DO i1 = LBOUND(OutData%u_BD,1), UBOUND(OutData%u_BD,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 BD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u_BD(i1,i2), ErrStat2, ErrMsg2 ) ! u_BD - 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 DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! x_ED not allocated - Int_Xferred = Int_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_ED)) DEALLOCATE(OutData%x_ED) - ALLOCATE(OutData%x_ED(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_ED.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%x_ED,1), UBOUND(OutData%x_ED,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 ED_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x_ED(i1), ErrStat2, ErrMsg2 ) ! x_ED - 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 ! xd_ED not allocated - Int_Xferred = Int_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_ED)) DEALLOCATE(OutData%xd_ED) - ALLOCATE(OutData%xd_ED(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_ED.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%xd_ED,1), UBOUND(OutData%xd_ED,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 ED_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd_ED(i1), ErrStat2, ErrMsg2 ) ! xd_ED - 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 ! z_ED not allocated - Int_Xferred = Int_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%z_ED)) DEALLOCATE(OutData%z_ED) - ALLOCATE(OutData%z_ED(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_ED.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%z_ED,1), UBOUND(OutData%z_ED,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 ED_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z_ED(i1), ErrStat2, ErrMsg2 ) ! z_ED - 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 ! OtherSt_ED not allocated - Int_Xferred = Int_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%OtherSt_ED)) DEALLOCATE(OutData%OtherSt_ED) - ALLOCATE(OutData%OtherSt_ED(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_ED.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%OtherSt_ED,1), UBOUND(OutData%OtherSt_ED,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 ED_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt_ED(i1), ErrStat2, ErrMsg2 ) ! OtherSt_ED - 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 ! u_ED not allocated - Int_Xferred = Int_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_ED)) DEALLOCATE(OutData%u_ED) - ALLOCATE(OutData%u_ED(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_ED.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%u_ED,1), UBOUND(OutData%u_ED,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 ED_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u_ED(i1), ErrStat2, ErrMsg2 ) ! u_ED - 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 ! x_SrvD not allocated - Int_Xferred = Int_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_SrvD)) DEALLOCATE(OutData%x_SrvD) - ALLOCATE(OutData%x_SrvD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_SrvD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%x_SrvD,1), UBOUND(OutData%x_SrvD,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_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x_SrvD(i1), ErrStat2, ErrMsg2 ) ! x_SrvD - 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 ! xd_SrvD not allocated - Int_Xferred = Int_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_SrvD)) DEALLOCATE(OutData%xd_SrvD) - ALLOCATE(OutData%xd_SrvD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_SrvD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%xd_SrvD,1), UBOUND(OutData%xd_SrvD,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_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd_SrvD(i1), ErrStat2, ErrMsg2 ) ! xd_SrvD - 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 ! z_SrvD not allocated - Int_Xferred = Int_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%z_SrvD)) DEALLOCATE(OutData%z_SrvD) - ALLOCATE(OutData%z_SrvD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_SrvD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%z_SrvD,1), UBOUND(OutData%z_SrvD,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_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z_SrvD(i1), ErrStat2, ErrMsg2 ) ! z_SrvD - 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 ! OtherSt_SrvD not allocated - Int_Xferred = Int_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%OtherSt_SrvD)) DEALLOCATE(OutData%OtherSt_SrvD) - ALLOCATE(OutData%OtherSt_SrvD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_SrvD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%OtherSt_SrvD,1), UBOUND(OutData%OtherSt_SrvD,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_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt_SrvD(i1), ErrStat2, ErrMsg2 ) ! OtherSt_SrvD - 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 ! u_SrvD not allocated - Int_Xferred = Int_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_SrvD)) DEALLOCATE(OutData%u_SrvD) - ALLOCATE(OutData%u_SrvD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_SrvD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%u_SrvD,1), UBOUND(OutData%u_SrvD,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_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u_SrvD(i1), ErrStat2, ErrMsg2 ) ! u_SrvD - 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 ! x_AD not allocated - Int_Xferred = Int_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_AD)) DEALLOCATE(OutData%x_AD) - ALLOCATE(OutData%x_AD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_AD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%x_AD,1), UBOUND(OutData%x_AD,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 AD_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x_AD(i1), ErrStat2, ErrMsg2 ) ! x_AD - 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 ! xd_AD not allocated - Int_Xferred = Int_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_AD)) DEALLOCATE(OutData%xd_AD) - ALLOCATE(OutData%xd_AD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_AD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%xd_AD,1), UBOUND(OutData%xd_AD,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 AD_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd_AD(i1), ErrStat2, ErrMsg2 ) ! xd_AD - 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 ! z_AD not allocated - Int_Xferred = Int_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%z_AD)) DEALLOCATE(OutData%z_AD) - ALLOCATE(OutData%z_AD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_AD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%z_AD,1), UBOUND(OutData%z_AD,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 AD_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z_AD(i1), ErrStat2, ErrMsg2 ) ! z_AD - 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 ! OtherSt_AD not allocated - Int_Xferred = Int_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%OtherSt_AD)) DEALLOCATE(OutData%OtherSt_AD) - ALLOCATE(OutData%OtherSt_AD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_AD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%OtherSt_AD,1), UBOUND(OutData%OtherSt_AD,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 AD_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt_AD(i1), ErrStat2, ErrMsg2 ) ! OtherSt_AD - 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 ! u_AD not allocated - Int_Xferred = Int_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_AD)) DEALLOCATE(OutData%u_AD) - ALLOCATE(OutData%u_AD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_AD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%u_AD,1), UBOUND(OutData%u_AD,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 AD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u_AD(i1), ErrStat2, ErrMsg2 ) ! u_AD - 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 ! x_IfW not allocated - Int_Xferred = Int_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_IfW)) DEALLOCATE(OutData%x_IfW) - ALLOCATE(OutData%x_IfW(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_IfW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%x_IfW,1), UBOUND(OutData%x_IfW,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 InflowWind_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x_IfW(i1), ErrStat2, ErrMsg2 ) ! x_IfW - 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 ! xd_IfW not allocated - Int_Xferred = Int_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_IfW)) DEALLOCATE(OutData%xd_IfW) - ALLOCATE(OutData%xd_IfW(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_IfW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%xd_IfW,1), UBOUND(OutData%xd_IfW,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 InflowWind_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd_IfW(i1), ErrStat2, ErrMsg2 ) ! xd_IfW - 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 ! z_IfW not allocated - Int_Xferred = Int_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%z_IfW)) DEALLOCATE(OutData%z_IfW) - ALLOCATE(OutData%z_IfW(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_IfW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%z_IfW,1), UBOUND(OutData%z_IfW,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 InflowWind_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z_IfW(i1), ErrStat2, ErrMsg2 ) ! z_IfW - 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 ! OtherSt_IfW not allocated - Int_Xferred = Int_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%OtherSt_IfW)) DEALLOCATE(OutData%OtherSt_IfW) - ALLOCATE(OutData%OtherSt_IfW(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_IfW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%OtherSt_IfW,1), UBOUND(OutData%OtherSt_IfW,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 InflowWind_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt_IfW(i1), ErrStat2, ErrMsg2 ) ! OtherSt_IfW - 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 ! u_IfW not allocated - Int_Xferred = Int_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_IfW)) DEALLOCATE(OutData%u_IfW) - ALLOCATE(OutData%u_IfW(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_IfW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%u_IfW,1), UBOUND(OutData%u_IfW,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 InflowWind_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u_IfW(i1), ErrStat2, ErrMsg2 ) ! u_IfW - 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 ! x_SD not allocated - Int_Xferred = Int_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_SD)) DEALLOCATE(OutData%x_SD) - ALLOCATE(OutData%x_SD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_SD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%x_SD,1), UBOUND(OutData%x_SD,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%x_SD(i1), ErrStat2, ErrMsg2 ) ! x_SD - 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 ! xd_SD not allocated - Int_Xferred = Int_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_SD)) DEALLOCATE(OutData%xd_SD) - ALLOCATE(OutData%xd_SD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_SD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%xd_SD,1), UBOUND(OutData%xd_SD,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_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd_SD(i1), ErrStat2, ErrMsg2 ) ! xd_SD - 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 ! z_SD not allocated - Int_Xferred = Int_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%z_SD)) DEALLOCATE(OutData%z_SD) - ALLOCATE(OutData%z_SD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_SD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%z_SD,1), UBOUND(OutData%z_SD,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_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z_SD(i1), ErrStat2, ErrMsg2 ) ! z_SD - 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 ! OtherSt_SD not allocated - Int_Xferred = Int_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%OtherSt_SD)) DEALLOCATE(OutData%OtherSt_SD) - ALLOCATE(OutData%OtherSt_SD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_SD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%OtherSt_SD,1), UBOUND(OutData%OtherSt_SD,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_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt_SD(i1), ErrStat2, ErrMsg2 ) ! OtherSt_SD - 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 ! u_SD not allocated - Int_Xferred = Int_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_SD)) DEALLOCATE(OutData%u_SD) - ALLOCATE(OutData%u_SD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_SD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%u_SD,1), UBOUND(OutData%u_SD,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_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u_SD(i1), ErrStat2, ErrMsg2 ) ! u_SD - 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 ! x_ExtPtfm not allocated - Int_Xferred = Int_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_ExtPtfm)) DEALLOCATE(OutData%x_ExtPtfm) - ALLOCATE(OutData%x_ExtPtfm(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_ExtPtfm.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%x_ExtPtfm,1), UBOUND(OutData%x_ExtPtfm,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 ExtPtfm_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x_ExtPtfm(i1), ErrStat2, ErrMsg2 ) ! x_ExtPtfm - 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 ! xd_ExtPtfm not allocated - Int_Xferred = Int_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_ExtPtfm)) DEALLOCATE(OutData%xd_ExtPtfm) - ALLOCATE(OutData%xd_ExtPtfm(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_ExtPtfm.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%xd_ExtPtfm,1), UBOUND(OutData%xd_ExtPtfm,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 ExtPtfm_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd_ExtPtfm(i1), ErrStat2, ErrMsg2 ) ! xd_ExtPtfm - 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 ! z_ExtPtfm not allocated - Int_Xferred = Int_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%z_ExtPtfm)) DEALLOCATE(OutData%z_ExtPtfm) - ALLOCATE(OutData%z_ExtPtfm(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_ExtPtfm.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%z_ExtPtfm,1), UBOUND(OutData%z_ExtPtfm,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 ExtPtfm_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z_ExtPtfm(i1), ErrStat2, ErrMsg2 ) ! z_ExtPtfm - 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 ! OtherSt_ExtPtfm not allocated - Int_Xferred = Int_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%OtherSt_ExtPtfm)) DEALLOCATE(OutData%OtherSt_ExtPtfm) - ALLOCATE(OutData%OtherSt_ExtPtfm(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_ExtPtfm.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%OtherSt_ExtPtfm,1), UBOUND(OutData%OtherSt_ExtPtfm,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 ExtPtfm_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt_ExtPtfm(i1), ErrStat2, ErrMsg2 ) ! OtherSt_ExtPtfm - 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 ! u_ExtPtfm not allocated - Int_Xferred = Int_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_ExtPtfm)) DEALLOCATE(OutData%u_ExtPtfm) - ALLOCATE(OutData%u_ExtPtfm(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_ExtPtfm.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%u_ExtPtfm,1), UBOUND(OutData%u_ExtPtfm,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 ExtPtfm_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u_ExtPtfm(i1), ErrStat2, ErrMsg2 ) ! u_ExtPtfm - 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 ! x_HD not allocated - Int_Xferred = Int_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_HD)) DEALLOCATE(OutData%x_HD) - ALLOCATE(OutData%x_HD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_HD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%x_HD,1), UBOUND(OutData%x_HD,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 HydroDyn_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x_HD(i1), ErrStat2, ErrMsg2 ) ! x_HD - 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 ! xd_HD not allocated - Int_Xferred = Int_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_HD)) DEALLOCATE(OutData%xd_HD) - ALLOCATE(OutData%xd_HD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_HD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%xd_HD,1), UBOUND(OutData%xd_HD,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 HydroDyn_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd_HD(i1), ErrStat2, ErrMsg2 ) ! xd_HD - 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 ! z_HD not allocated - Int_Xferred = Int_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%z_HD)) DEALLOCATE(OutData%z_HD) - ALLOCATE(OutData%z_HD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_HD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%z_HD,1), UBOUND(OutData%z_HD,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 HydroDyn_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z_HD(i1), ErrStat2, ErrMsg2 ) ! z_HD - 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 ! OtherSt_HD not allocated - Int_Xferred = Int_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%OtherSt_HD)) DEALLOCATE(OutData%OtherSt_HD) - ALLOCATE(OutData%OtherSt_HD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_HD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%OtherSt_HD,1), UBOUND(OutData%OtherSt_HD,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 HydroDyn_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt_HD(i1), ErrStat2, ErrMsg2 ) ! OtherSt_HD - 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 ! u_HD not allocated - Int_Xferred = Int_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_HD)) DEALLOCATE(OutData%u_HD) - ALLOCATE(OutData%u_HD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_HD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%u_HD,1), UBOUND(OutData%u_HD,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 HydroDyn_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u_HD(i1), ErrStat2, ErrMsg2 ) ! u_HD - 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 ! x_IceF not allocated - Int_Xferred = Int_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_IceF)) DEALLOCATE(OutData%x_IceF) - ALLOCATE(OutData%x_IceF(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_IceF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%x_IceF,1), UBOUND(OutData%x_IceF,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 IceFloe_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x_IceF(i1), ErrStat2, ErrMsg2 ) ! x_IceF - 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 ! xd_IceF not allocated - Int_Xferred = Int_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_IceF)) DEALLOCATE(OutData%xd_IceF) - ALLOCATE(OutData%xd_IceF(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_IceF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%xd_IceF,1), UBOUND(OutData%xd_IceF,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 IceFloe_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd_IceF(i1), ErrStat2, ErrMsg2 ) ! xd_IceF - 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 ! z_IceF not allocated - Int_Xferred = Int_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%z_IceF)) DEALLOCATE(OutData%z_IceF) - ALLOCATE(OutData%z_IceF(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_IceF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%z_IceF,1), UBOUND(OutData%z_IceF,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 IceFloe_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z_IceF(i1), ErrStat2, ErrMsg2 ) ! z_IceF - 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 ! OtherSt_IceF not allocated - Int_Xferred = Int_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%OtherSt_IceF)) DEALLOCATE(OutData%OtherSt_IceF) - ALLOCATE(OutData%OtherSt_IceF(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_IceF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%OtherSt_IceF,1), UBOUND(OutData%OtherSt_IceF,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 IceFloe_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt_IceF(i1), ErrStat2, ErrMsg2 ) ! OtherSt_IceF - 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 ! u_IceF not allocated - Int_Xferred = Int_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_IceF)) DEALLOCATE(OutData%u_IceF) - ALLOCATE(OutData%u_IceF(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_IceF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%u_IceF,1), UBOUND(OutData%u_IceF,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 IceFloe_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u_IceF(i1), ErrStat2, ErrMsg2 ) ! u_IceF - 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 ! x_MAP not allocated - Int_Xferred = Int_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_MAP)) DEALLOCATE(OutData%x_MAP) - ALLOCATE(OutData%x_MAP(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_MAP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%x_MAP,1), UBOUND(OutData%x_MAP,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 MAP_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x_MAP(i1), ErrStat2, ErrMsg2 ) ! x_MAP - 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 ! xd_MAP not allocated - Int_Xferred = Int_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_MAP)) DEALLOCATE(OutData%xd_MAP) - ALLOCATE(OutData%xd_MAP(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_MAP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%xd_MAP,1), UBOUND(OutData%xd_MAP,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 MAP_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd_MAP(i1), ErrStat2, ErrMsg2 ) ! xd_MAP - 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 ! z_MAP not allocated - Int_Xferred = Int_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%z_MAP)) DEALLOCATE(OutData%z_MAP) - ALLOCATE(OutData%z_MAP(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_MAP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%z_MAP,1), UBOUND(OutData%z_MAP,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 MAP_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z_MAP(i1), ErrStat2, ErrMsg2 ) ! z_MAP - 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 ! u_MAP not allocated - Int_Xferred = Int_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_MAP)) DEALLOCATE(OutData%u_MAP) - ALLOCATE(OutData%u_MAP(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_MAP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%u_MAP,1), UBOUND(OutData%u_MAP,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 MAP_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u_MAP(i1), ErrStat2, ErrMsg2 ) ! u_MAP - 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 ! x_FEAM not allocated - Int_Xferred = Int_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_FEAM)) DEALLOCATE(OutData%x_FEAM) - ALLOCATE(OutData%x_FEAM(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_FEAM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%x_FEAM,1), UBOUND(OutData%x_FEAM,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 FEAM_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x_FEAM(i1), ErrStat2, ErrMsg2 ) ! x_FEAM - 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 ! xd_FEAM not allocated - Int_Xferred = Int_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_FEAM)) DEALLOCATE(OutData%xd_FEAM) - ALLOCATE(OutData%xd_FEAM(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_FEAM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%xd_FEAM,1), UBOUND(OutData%xd_FEAM,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 FEAM_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd_FEAM(i1), ErrStat2, ErrMsg2 ) ! xd_FEAM - 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 ! z_FEAM not allocated - Int_Xferred = Int_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%z_FEAM)) DEALLOCATE(OutData%z_FEAM) - ALLOCATE(OutData%z_FEAM(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_FEAM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%z_FEAM,1), UBOUND(OutData%z_FEAM,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 FEAM_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z_FEAM(i1), ErrStat2, ErrMsg2 ) ! z_FEAM - 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 ! OtherSt_FEAM not allocated - Int_Xferred = Int_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%OtherSt_FEAM)) DEALLOCATE(OutData%OtherSt_FEAM) - ALLOCATE(OutData%OtherSt_FEAM(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_FEAM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%OtherSt_FEAM,1), UBOUND(OutData%OtherSt_FEAM,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 FEAM_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt_FEAM(i1), ErrStat2, ErrMsg2 ) ! OtherSt_FEAM - 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 ! u_FEAM not allocated - Int_Xferred = Int_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_FEAM)) DEALLOCATE(OutData%u_FEAM) - ALLOCATE(OutData%u_FEAM(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_FEAM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%u_FEAM,1), UBOUND(OutData%u_FEAM,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 FEAM_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u_FEAM(i1), ErrStat2, ErrMsg2 ) ! u_FEAM - 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 ! x_MD not allocated - Int_Xferred = Int_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_MD)) DEALLOCATE(OutData%x_MD) - ALLOCATE(OutData%x_MD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_MD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%x_MD,1), UBOUND(OutData%x_MD,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 MD_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x_MD(i1), ErrStat2, ErrMsg2 ) ! x_MD - 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 ! xd_MD not allocated - Int_Xferred = Int_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_MD)) DEALLOCATE(OutData%xd_MD) - ALLOCATE(OutData%xd_MD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_MD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%xd_MD,1), UBOUND(OutData%xd_MD,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 MD_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd_MD(i1), ErrStat2, ErrMsg2 ) ! xd_MD - 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 ! z_MD not allocated - Int_Xferred = Int_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%z_MD)) DEALLOCATE(OutData%z_MD) - ALLOCATE(OutData%z_MD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_MD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%z_MD,1), UBOUND(OutData%z_MD,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 MD_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z_MD(i1), ErrStat2, ErrMsg2 ) ! z_MD - 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 ! OtherSt_MD not allocated - Int_Xferred = Int_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%OtherSt_MD)) DEALLOCATE(OutData%OtherSt_MD) - ALLOCATE(OutData%OtherSt_MD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_MD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%OtherSt_MD,1), UBOUND(OutData%OtherSt_MD,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 MD_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt_MD(i1), ErrStat2, ErrMsg2 ) ! OtherSt_MD - 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 ! u_MD not allocated - Int_Xferred = Int_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_MD)) DEALLOCATE(OutData%u_MD) - ALLOCATE(OutData%u_MD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_MD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%u_MD,1), UBOUND(OutData%u_MD,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 MD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u_MD(i1), ErrStat2, ErrMsg2 ) ! u_MD - 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 FAST_UnPackLinStateSave - - SUBROUTINE FAST_CopyLinType( SrcLinTypeData, DstLinTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FAST_LinType), INTENT(IN) :: SrcLinTypeData - TYPE(FAST_LinType), INTENT(INOUT) :: DstLinTypeData - 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 = 'FAST_CopyLinType' -! + ErrMsg = '' + if (allocated(VTK_SurfaceTypeData%TowerRad)) then + deallocate(VTK_SurfaceTypeData%TowerRad) + end if + if (allocated(VTK_SurfaceTypeData%WaveElevVisX)) then + deallocate(VTK_SurfaceTypeData%WaveElevVisX) + end if + if (allocated(VTK_SurfaceTypeData%WaveElevVisY)) then + deallocate(VTK_SurfaceTypeData%WaveElevVisY) + end if + if (allocated(VTK_SurfaceTypeData%WaveElevVisGrid)) then + deallocate(VTK_SurfaceTypeData%WaveElevVisGrid) + end if + if (allocated(VTK_SurfaceTypeData%BladeShape)) then + LB(1:1) = lbound(VTK_SurfaceTypeData%BladeShape) + UB(1:1) = ubound(VTK_SurfaceTypeData%BladeShape) + do i1 = LB(1), UB(1) + call FAST_DestroyVTK_BLSurfaceType(VTK_SurfaceTypeData%BladeShape(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(VTK_SurfaceTypeData%BladeShape) + end if + if (allocated(VTK_SurfaceTypeData%MorisonVisRad)) then + deallocate(VTK_SurfaceTypeData%MorisonVisRad) + end if +end subroutine + +subroutine FAST_PackVTK_SurfaceType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(FAST_VTK_SurfaceType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackVTK_SurfaceType' + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%NumSectors) + call RegPack(RF, InData%HubRad) + call RegPack(RF, InData%GroundRad) + call RegPack(RF, InData%NacelleBox) + call RegPackAlloc(RF, InData%TowerRad) + call RegPack(RF, InData%NWaveElevPts) + call RegPackAlloc(RF, InData%WaveElevVisX) + call RegPackAlloc(RF, InData%WaveElevVisY) + call RegPackAlloc(RF, InData%WaveElevVisGrid) + call RegPack(RF, allocated(InData%BladeShape)) + if (allocated(InData%BladeShape)) then + call RegPackBounds(RF, 1, lbound(InData%BladeShape), ubound(InData%BladeShape)) + LB(1:1) = lbound(InData%BladeShape) + UB(1:1) = ubound(InData%BladeShape) + do i1 = LB(1), UB(1) + call FAST_PackVTK_BLSurfaceType(RF, InData%BladeShape(i1)) + end do + end if + call RegPackAlloc(RF, InData%MorisonVisRad) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FAST_UnPackVTK_SurfaceType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(FAST_VTK_SurfaceType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackVTK_SurfaceType' + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%NumSectors); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HubRad); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GroundRad); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NacelleBox); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TowerRad); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NWaveElevPts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WaveElevVisX); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WaveElevVisY); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WaveElevVisGrid); if (RegCheckErr(RF, RoutineName)) return + if (allocated(OutData%BladeShape)) deallocate(OutData%BladeShape) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%BladeShape(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeShape.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call FAST_UnpackVTK_BLSurfaceType(RF, OutData%BladeShape(i1)) ! BladeShape + end do + end if + call RegUnpackAlloc(RF, OutData%MorisonVisRad); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FAST_CopyVTK_ModeShapeType(SrcVTK_ModeShapeTypeData, DstVTK_ModeShapeTypeData, CtrlCode, ErrStat, ErrMsg) + type(FAST_VTK_ModeShapeType), intent(in) :: SrcVTK_ModeShapeTypeData + type(FAST_VTK_ModeShapeType), intent(inout) :: DstVTK_ModeShapeTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'FAST_CopyVTK_ModeShapeType' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcLinTypeData%Names_u)) THEN - i1_l = LBOUND(SrcLinTypeData%Names_u,1) - i1_u = UBOUND(SrcLinTypeData%Names_u,1) - IF (.NOT. ALLOCATED(DstLinTypeData%Names_u)) THEN - ALLOCATE(DstLinTypeData%Names_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%Names_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLinTypeData%Names_u = SrcLinTypeData%Names_u -ENDIF -IF (ALLOCATED(SrcLinTypeData%Names_y)) THEN - i1_l = LBOUND(SrcLinTypeData%Names_y,1) - i1_u = UBOUND(SrcLinTypeData%Names_y,1) - IF (.NOT. ALLOCATED(DstLinTypeData%Names_y)) THEN - ALLOCATE(DstLinTypeData%Names_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%Names_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLinTypeData%Names_y = SrcLinTypeData%Names_y -ENDIF -IF (ALLOCATED(SrcLinTypeData%Names_x)) THEN - i1_l = LBOUND(SrcLinTypeData%Names_x,1) - i1_u = UBOUND(SrcLinTypeData%Names_x,1) - IF (.NOT. ALLOCATED(DstLinTypeData%Names_x)) THEN - ALLOCATE(DstLinTypeData%Names_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%Names_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLinTypeData%Names_x = SrcLinTypeData%Names_x -ENDIF -IF (ALLOCATED(SrcLinTypeData%Names_xd)) THEN - i1_l = LBOUND(SrcLinTypeData%Names_xd,1) - i1_u = UBOUND(SrcLinTypeData%Names_xd,1) - IF (.NOT. ALLOCATED(DstLinTypeData%Names_xd)) THEN - ALLOCATE(DstLinTypeData%Names_xd(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%Names_xd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLinTypeData%Names_xd = SrcLinTypeData%Names_xd -ENDIF -IF (ALLOCATED(SrcLinTypeData%Names_z)) THEN - i1_l = LBOUND(SrcLinTypeData%Names_z,1) - i1_u = UBOUND(SrcLinTypeData%Names_z,1) - IF (.NOT. ALLOCATED(DstLinTypeData%Names_z)) THEN - ALLOCATE(DstLinTypeData%Names_z(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%Names_z.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLinTypeData%Names_z = SrcLinTypeData%Names_z -ENDIF -IF (ALLOCATED(SrcLinTypeData%op_u)) THEN - i1_l = LBOUND(SrcLinTypeData%op_u,1) - i1_u = UBOUND(SrcLinTypeData%op_u,1) - IF (.NOT. ALLOCATED(DstLinTypeData%op_u)) THEN - ALLOCATE(DstLinTypeData%op_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%op_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLinTypeData%op_u = SrcLinTypeData%op_u -ENDIF -IF (ALLOCATED(SrcLinTypeData%op_y)) THEN - i1_l = LBOUND(SrcLinTypeData%op_y,1) - i1_u = UBOUND(SrcLinTypeData%op_y,1) - IF (.NOT. ALLOCATED(DstLinTypeData%op_y)) THEN - ALLOCATE(DstLinTypeData%op_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%op_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLinTypeData%op_y = SrcLinTypeData%op_y -ENDIF -IF (ALLOCATED(SrcLinTypeData%op_x)) THEN - i1_l = LBOUND(SrcLinTypeData%op_x,1) - i1_u = UBOUND(SrcLinTypeData%op_x,1) - IF (.NOT. ALLOCATED(DstLinTypeData%op_x)) THEN - ALLOCATE(DstLinTypeData%op_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%op_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLinTypeData%op_x = SrcLinTypeData%op_x -ENDIF -IF (ALLOCATED(SrcLinTypeData%op_dx)) THEN - i1_l = LBOUND(SrcLinTypeData%op_dx,1) - i1_u = UBOUND(SrcLinTypeData%op_dx,1) - IF (.NOT. ALLOCATED(DstLinTypeData%op_dx)) THEN - ALLOCATE(DstLinTypeData%op_dx(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%op_dx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLinTypeData%op_dx = SrcLinTypeData%op_dx -ENDIF -IF (ALLOCATED(SrcLinTypeData%op_xd)) THEN - i1_l = LBOUND(SrcLinTypeData%op_xd,1) - i1_u = UBOUND(SrcLinTypeData%op_xd,1) - IF (.NOT. ALLOCATED(DstLinTypeData%op_xd)) THEN - ALLOCATE(DstLinTypeData%op_xd(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%op_xd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLinTypeData%op_xd = SrcLinTypeData%op_xd -ENDIF -IF (ALLOCATED(SrcLinTypeData%op_z)) THEN - i1_l = LBOUND(SrcLinTypeData%op_z,1) - i1_u = UBOUND(SrcLinTypeData%op_z,1) - IF (.NOT. ALLOCATED(DstLinTypeData%op_z)) THEN - ALLOCATE(DstLinTypeData%op_z(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%op_z.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLinTypeData%op_z = SrcLinTypeData%op_z -ENDIF -IF (ALLOCATED(SrcLinTypeData%op_x_eig_mag)) THEN - i1_l = LBOUND(SrcLinTypeData%op_x_eig_mag,1) - i1_u = UBOUND(SrcLinTypeData%op_x_eig_mag,1) - IF (.NOT. ALLOCATED(DstLinTypeData%op_x_eig_mag)) THEN - ALLOCATE(DstLinTypeData%op_x_eig_mag(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%op_x_eig_mag.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLinTypeData%op_x_eig_mag = SrcLinTypeData%op_x_eig_mag -ENDIF -IF (ALLOCATED(SrcLinTypeData%op_x_eig_phase)) THEN - i1_l = LBOUND(SrcLinTypeData%op_x_eig_phase,1) - i1_u = UBOUND(SrcLinTypeData%op_x_eig_phase,1) - IF (.NOT. ALLOCATED(DstLinTypeData%op_x_eig_phase)) THEN - ALLOCATE(DstLinTypeData%op_x_eig_phase(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%op_x_eig_phase.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLinTypeData%op_x_eig_phase = SrcLinTypeData%op_x_eig_phase -ENDIF -IF (ALLOCATED(SrcLinTypeData%Use_u)) THEN - i1_l = LBOUND(SrcLinTypeData%Use_u,1) - i1_u = UBOUND(SrcLinTypeData%Use_u,1) - IF (.NOT. ALLOCATED(DstLinTypeData%Use_u)) THEN - ALLOCATE(DstLinTypeData%Use_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%Use_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLinTypeData%Use_u = SrcLinTypeData%Use_u -ENDIF -IF (ALLOCATED(SrcLinTypeData%Use_y)) THEN - i1_l = LBOUND(SrcLinTypeData%Use_y,1) - i1_u = UBOUND(SrcLinTypeData%Use_y,1) - IF (.NOT. ALLOCATED(DstLinTypeData%Use_y)) THEN - ALLOCATE(DstLinTypeData%Use_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%Use_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLinTypeData%Use_y = SrcLinTypeData%Use_y -ENDIF -IF (ALLOCATED(SrcLinTypeData%A)) THEN - i1_l = LBOUND(SrcLinTypeData%A,1) - i1_u = UBOUND(SrcLinTypeData%A,1) - i2_l = LBOUND(SrcLinTypeData%A,2) - i2_u = UBOUND(SrcLinTypeData%A,2) - IF (.NOT. ALLOCATED(DstLinTypeData%A)) THEN - ALLOCATE(DstLinTypeData%A(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%A.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLinTypeData%A = SrcLinTypeData%A -ENDIF -IF (ALLOCATED(SrcLinTypeData%B)) THEN - i1_l = LBOUND(SrcLinTypeData%B,1) - i1_u = UBOUND(SrcLinTypeData%B,1) - i2_l = LBOUND(SrcLinTypeData%B,2) - i2_u = UBOUND(SrcLinTypeData%B,2) - IF (.NOT. ALLOCATED(DstLinTypeData%B)) THEN - ALLOCATE(DstLinTypeData%B(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%B.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLinTypeData%B = SrcLinTypeData%B -ENDIF -IF (ALLOCATED(SrcLinTypeData%C)) THEN - i1_l = LBOUND(SrcLinTypeData%C,1) - i1_u = UBOUND(SrcLinTypeData%C,1) - i2_l = LBOUND(SrcLinTypeData%C,2) - i2_u = UBOUND(SrcLinTypeData%C,2) - IF (.NOT. ALLOCATED(DstLinTypeData%C)) THEN - ALLOCATE(DstLinTypeData%C(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%C.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLinTypeData%C = SrcLinTypeData%C -ENDIF -IF (ALLOCATED(SrcLinTypeData%D)) THEN - i1_l = LBOUND(SrcLinTypeData%D,1) - i1_u = UBOUND(SrcLinTypeData%D,1) - i2_l = LBOUND(SrcLinTypeData%D,2) - i2_u = UBOUND(SrcLinTypeData%D,2) - IF (.NOT. ALLOCATED(DstLinTypeData%D)) THEN - ALLOCATE(DstLinTypeData%D(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%D.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLinTypeData%D = SrcLinTypeData%D -ENDIF -IF (ALLOCATED(SrcLinTypeData%StateRotation)) THEN - i1_l = LBOUND(SrcLinTypeData%StateRotation,1) - i1_u = UBOUND(SrcLinTypeData%StateRotation,1) - i2_l = LBOUND(SrcLinTypeData%StateRotation,2) - i2_u = UBOUND(SrcLinTypeData%StateRotation,2) - IF (.NOT. ALLOCATED(DstLinTypeData%StateRotation)) THEN - ALLOCATE(DstLinTypeData%StateRotation(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%StateRotation.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLinTypeData%StateRotation = SrcLinTypeData%StateRotation -ENDIF -IF (ALLOCATED(SrcLinTypeData%StateRel_x)) THEN - i1_l = LBOUND(SrcLinTypeData%StateRel_x,1) - i1_u = UBOUND(SrcLinTypeData%StateRel_x,1) - i2_l = LBOUND(SrcLinTypeData%StateRel_x,2) - i2_u = UBOUND(SrcLinTypeData%StateRel_x,2) - IF (.NOT. ALLOCATED(DstLinTypeData%StateRel_x)) THEN - ALLOCATE(DstLinTypeData%StateRel_x(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%StateRel_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLinTypeData%StateRel_x = SrcLinTypeData%StateRel_x -ENDIF -IF (ALLOCATED(SrcLinTypeData%StateRel_xdot)) THEN - i1_l = LBOUND(SrcLinTypeData%StateRel_xdot,1) - i1_u = UBOUND(SrcLinTypeData%StateRel_xdot,1) - i2_l = LBOUND(SrcLinTypeData%StateRel_xdot,2) - i2_u = UBOUND(SrcLinTypeData%StateRel_xdot,2) - IF (.NOT. ALLOCATED(DstLinTypeData%StateRel_xdot)) THEN - ALLOCATE(DstLinTypeData%StateRel_xdot(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%StateRel_xdot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLinTypeData%StateRel_xdot = SrcLinTypeData%StateRel_xdot -ENDIF -IF (ALLOCATED(SrcLinTypeData%IsLoad_u)) THEN - i1_l = LBOUND(SrcLinTypeData%IsLoad_u,1) - i1_u = UBOUND(SrcLinTypeData%IsLoad_u,1) - IF (.NOT. ALLOCATED(DstLinTypeData%IsLoad_u)) THEN - ALLOCATE(DstLinTypeData%IsLoad_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%IsLoad_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLinTypeData%IsLoad_u = SrcLinTypeData%IsLoad_u -ENDIF -IF (ALLOCATED(SrcLinTypeData%RotFrame_u)) THEN - i1_l = LBOUND(SrcLinTypeData%RotFrame_u,1) - i1_u = UBOUND(SrcLinTypeData%RotFrame_u,1) - IF (.NOT. ALLOCATED(DstLinTypeData%RotFrame_u)) THEN - ALLOCATE(DstLinTypeData%RotFrame_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%RotFrame_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLinTypeData%RotFrame_u = SrcLinTypeData%RotFrame_u -ENDIF -IF (ALLOCATED(SrcLinTypeData%RotFrame_y)) THEN - i1_l = LBOUND(SrcLinTypeData%RotFrame_y,1) - i1_u = UBOUND(SrcLinTypeData%RotFrame_y,1) - IF (.NOT. ALLOCATED(DstLinTypeData%RotFrame_y)) THEN - ALLOCATE(DstLinTypeData%RotFrame_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%RotFrame_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLinTypeData%RotFrame_y = SrcLinTypeData%RotFrame_y -ENDIF -IF (ALLOCATED(SrcLinTypeData%RotFrame_x)) THEN - i1_l = LBOUND(SrcLinTypeData%RotFrame_x,1) - i1_u = UBOUND(SrcLinTypeData%RotFrame_x,1) - IF (.NOT. ALLOCATED(DstLinTypeData%RotFrame_x)) THEN - ALLOCATE(DstLinTypeData%RotFrame_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%RotFrame_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLinTypeData%RotFrame_x = SrcLinTypeData%RotFrame_x -ENDIF -IF (ALLOCATED(SrcLinTypeData%RotFrame_z)) THEN - i1_l = LBOUND(SrcLinTypeData%RotFrame_z,1) - i1_u = UBOUND(SrcLinTypeData%RotFrame_z,1) - IF (.NOT. ALLOCATED(DstLinTypeData%RotFrame_z)) THEN - ALLOCATE(DstLinTypeData%RotFrame_z(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%RotFrame_z.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLinTypeData%RotFrame_z = SrcLinTypeData%RotFrame_z -ENDIF -IF (ALLOCATED(SrcLinTypeData%DerivOrder_x)) THEN - i1_l = LBOUND(SrcLinTypeData%DerivOrder_x,1) - i1_u = UBOUND(SrcLinTypeData%DerivOrder_x,1) - IF (.NOT. ALLOCATED(DstLinTypeData%DerivOrder_x)) THEN - ALLOCATE(DstLinTypeData%DerivOrder_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%DerivOrder_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLinTypeData%DerivOrder_x = SrcLinTypeData%DerivOrder_x -ENDIF - DstLinTypeData%SizeLin = SrcLinTypeData%SizeLin - DstLinTypeData%LinStartIndx = SrcLinTypeData%LinStartIndx - DstLinTypeData%NumOutputs = SrcLinTypeData%NumOutputs - END SUBROUTINE FAST_CopyLinType - - SUBROUTINE FAST_DestroyLinType( LinTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(FAST_LinType), INTENT(INOUT) :: LinTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyLinType' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(LinTypeData%Names_u)) THEN - DEALLOCATE(LinTypeData%Names_u) -ENDIF -IF (ALLOCATED(LinTypeData%Names_y)) THEN - DEALLOCATE(LinTypeData%Names_y) -ENDIF -IF (ALLOCATED(LinTypeData%Names_x)) THEN - DEALLOCATE(LinTypeData%Names_x) -ENDIF -IF (ALLOCATED(LinTypeData%Names_xd)) THEN - DEALLOCATE(LinTypeData%Names_xd) -ENDIF -IF (ALLOCATED(LinTypeData%Names_z)) THEN - DEALLOCATE(LinTypeData%Names_z) -ENDIF -IF (ALLOCATED(LinTypeData%op_u)) THEN - DEALLOCATE(LinTypeData%op_u) -ENDIF -IF (ALLOCATED(LinTypeData%op_y)) THEN - DEALLOCATE(LinTypeData%op_y) -ENDIF -IF (ALLOCATED(LinTypeData%op_x)) THEN - DEALLOCATE(LinTypeData%op_x) -ENDIF -IF (ALLOCATED(LinTypeData%op_dx)) THEN - DEALLOCATE(LinTypeData%op_dx) -ENDIF -IF (ALLOCATED(LinTypeData%op_xd)) THEN - DEALLOCATE(LinTypeData%op_xd) -ENDIF -IF (ALLOCATED(LinTypeData%op_z)) THEN - DEALLOCATE(LinTypeData%op_z) -ENDIF -IF (ALLOCATED(LinTypeData%op_x_eig_mag)) THEN - DEALLOCATE(LinTypeData%op_x_eig_mag) -ENDIF -IF (ALLOCATED(LinTypeData%op_x_eig_phase)) THEN - DEALLOCATE(LinTypeData%op_x_eig_phase) -ENDIF -IF (ALLOCATED(LinTypeData%Use_u)) THEN - DEALLOCATE(LinTypeData%Use_u) -ENDIF -IF (ALLOCATED(LinTypeData%Use_y)) THEN - DEALLOCATE(LinTypeData%Use_y) -ENDIF -IF (ALLOCATED(LinTypeData%A)) THEN - DEALLOCATE(LinTypeData%A) -ENDIF -IF (ALLOCATED(LinTypeData%B)) THEN - DEALLOCATE(LinTypeData%B) -ENDIF -IF (ALLOCATED(LinTypeData%C)) THEN - DEALLOCATE(LinTypeData%C) -ENDIF -IF (ALLOCATED(LinTypeData%D)) THEN - DEALLOCATE(LinTypeData%D) -ENDIF -IF (ALLOCATED(LinTypeData%StateRotation)) THEN - DEALLOCATE(LinTypeData%StateRotation) -ENDIF -IF (ALLOCATED(LinTypeData%StateRel_x)) THEN - DEALLOCATE(LinTypeData%StateRel_x) -ENDIF -IF (ALLOCATED(LinTypeData%StateRel_xdot)) THEN - DEALLOCATE(LinTypeData%StateRel_xdot) -ENDIF -IF (ALLOCATED(LinTypeData%IsLoad_u)) THEN - DEALLOCATE(LinTypeData%IsLoad_u) -ENDIF -IF (ALLOCATED(LinTypeData%RotFrame_u)) THEN - DEALLOCATE(LinTypeData%RotFrame_u) -ENDIF -IF (ALLOCATED(LinTypeData%RotFrame_y)) THEN - DEALLOCATE(LinTypeData%RotFrame_y) -ENDIF -IF (ALLOCATED(LinTypeData%RotFrame_x)) THEN - DEALLOCATE(LinTypeData%RotFrame_x) -ENDIF -IF (ALLOCATED(LinTypeData%RotFrame_z)) THEN - DEALLOCATE(LinTypeData%RotFrame_z) -ENDIF -IF (ALLOCATED(LinTypeData%DerivOrder_x)) THEN - DEALLOCATE(LinTypeData%DerivOrder_x) -ENDIF - END SUBROUTINE FAST_DestroyLinType - - SUBROUTINE FAST_PackLinType( 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(FAST_LinType), 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 = 'FAST_PackLinType' - ! 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 ! Names_u allocated yes/no - IF ( ALLOCATED(InData%Names_u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Names_u upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Names_u)*LEN(InData%Names_u) ! Names_u - END IF - Int_BufSz = Int_BufSz + 1 ! Names_y allocated yes/no - IF ( ALLOCATED(InData%Names_y) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Names_y upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Names_y)*LEN(InData%Names_y) ! Names_y - END IF - Int_BufSz = Int_BufSz + 1 ! Names_x allocated yes/no - IF ( ALLOCATED(InData%Names_x) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Names_x upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Names_x)*LEN(InData%Names_x) ! Names_x - END IF - Int_BufSz = Int_BufSz + 1 ! Names_xd allocated yes/no - IF ( ALLOCATED(InData%Names_xd) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Names_xd upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Names_xd)*LEN(InData%Names_xd) ! Names_xd - END IF - Int_BufSz = Int_BufSz + 1 ! Names_z allocated yes/no - IF ( ALLOCATED(InData%Names_z) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Names_z upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Names_z)*LEN(InData%Names_z) ! Names_z - END IF - Int_BufSz = Int_BufSz + 1 ! op_u allocated yes/no - IF ( ALLOCATED(InData%op_u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! op_u upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%op_u) ! op_u - END IF - Int_BufSz = Int_BufSz + 1 ! op_y allocated yes/no - IF ( ALLOCATED(InData%op_y) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! op_y upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%op_y) ! op_y - END IF - Int_BufSz = Int_BufSz + 1 ! op_x allocated yes/no - IF ( ALLOCATED(InData%op_x) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! op_x upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%op_x) ! op_x - END IF - Int_BufSz = Int_BufSz + 1 ! op_dx allocated yes/no - IF ( ALLOCATED(InData%op_dx) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! op_dx upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%op_dx) ! op_dx - END IF - Int_BufSz = Int_BufSz + 1 ! op_xd allocated yes/no - IF ( ALLOCATED(InData%op_xd) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! op_xd upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%op_xd) ! op_xd - END IF - Int_BufSz = Int_BufSz + 1 ! op_z allocated yes/no - IF ( ALLOCATED(InData%op_z) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! op_z upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%op_z) ! op_z - END IF - Int_BufSz = Int_BufSz + 1 ! op_x_eig_mag allocated yes/no - IF ( ALLOCATED(InData%op_x_eig_mag) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! op_x_eig_mag upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%op_x_eig_mag) ! op_x_eig_mag - END IF - Int_BufSz = Int_BufSz + 1 ! op_x_eig_phase allocated yes/no - IF ( ALLOCATED(InData%op_x_eig_phase) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! op_x_eig_phase upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%op_x_eig_phase) ! op_x_eig_phase - END IF - Int_BufSz = Int_BufSz + 1 ! Use_u allocated yes/no - IF ( ALLOCATED(InData%Use_u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Use_u upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Use_u) ! Use_u - END IF - Int_BufSz = Int_BufSz + 1 ! Use_y allocated yes/no - IF ( ALLOCATED(InData%Use_y) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Use_y upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Use_y) ! Use_y - END IF - Int_BufSz = Int_BufSz + 1 ! A allocated yes/no - IF ( ALLOCATED(InData%A) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! A upper/lower bounds for each dimension - Db_BufSz = Db_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*2 ! B upper/lower bounds for each dimension - Db_BufSz = Db_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*2 ! C upper/lower bounds for each dimension - Db_BufSz = Db_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*2 ! D upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%D) ! D - END IF - Int_BufSz = Int_BufSz + 1 ! StateRotation allocated yes/no - IF ( ALLOCATED(InData%StateRotation) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! StateRotation upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%StateRotation) ! StateRotation - END IF - Int_BufSz = Int_BufSz + 1 ! StateRel_x allocated yes/no - IF ( ALLOCATED(InData%StateRel_x) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! StateRel_x upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%StateRel_x) ! StateRel_x - END IF - Int_BufSz = Int_BufSz + 1 ! StateRel_xdot allocated yes/no - IF ( ALLOCATED(InData%StateRel_xdot) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! StateRel_xdot upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%StateRel_xdot) ! StateRel_xdot - 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 ! 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 ! 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_z allocated yes/no - IF ( ALLOCATED(InData%RotFrame_z) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! RotFrame_z upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%RotFrame_z) ! RotFrame_z - 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 - Int_BufSz = Int_BufSz + SIZE(InData%SizeLin) ! SizeLin - Int_BufSz = Int_BufSz + SIZE(InData%LinStartIndx) ! LinStartIndx - Int_BufSz = Int_BufSz + 1 ! NumOutputs - 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%Names_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%Names_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Names_u,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Names_u,1), UBOUND(InData%Names_u,1) - DO I = 1, LEN(InData%Names_u) - IntKiBuf(Int_Xferred) = ICHAR(InData%Names_u(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Names_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%Names_y,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Names_y,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Names_y,1), UBOUND(InData%Names_y,1) - DO I = 1, LEN(InData%Names_y) - IntKiBuf(Int_Xferred) = ICHAR(InData%Names_y(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Names_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%Names_x,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Names_x,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Names_x,1), UBOUND(InData%Names_x,1) - DO I = 1, LEN(InData%Names_x) - IntKiBuf(Int_Xferred) = ICHAR(InData%Names_x(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Names_xd) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Names_xd,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Names_xd,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Names_xd,1), UBOUND(InData%Names_xd,1) - DO I = 1, LEN(InData%Names_xd) - IntKiBuf(Int_Xferred) = ICHAR(InData%Names_xd(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Names_z) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Names_z,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Names_z,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Names_z,1), UBOUND(InData%Names_z,1) - DO I = 1, LEN(InData%Names_z) - IntKiBuf(Int_Xferred) = ICHAR(InData%Names_z(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%op_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%op_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%op_u,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%op_u,1), UBOUND(InData%op_u,1) - ReKiBuf(Re_Xferred) = InData%op_u(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%op_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%op_y,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%op_y,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%op_y,1), UBOUND(InData%op_y,1) - ReKiBuf(Re_Xferred) = InData%op_y(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%op_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%op_x,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%op_x,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%op_x,1), UBOUND(InData%op_x,1) - ReKiBuf(Re_Xferred) = InData%op_x(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%op_dx) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%op_dx,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%op_dx,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%op_dx,1), UBOUND(InData%op_dx,1) - ReKiBuf(Re_Xferred) = InData%op_dx(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%op_xd) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%op_xd,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%op_xd,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%op_xd,1), UBOUND(InData%op_xd,1) - ReKiBuf(Re_Xferred) = InData%op_xd(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%op_z) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%op_z,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%op_z,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%op_z,1), UBOUND(InData%op_z,1) - ReKiBuf(Re_Xferred) = InData%op_z(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%op_x_eig_mag) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%op_x_eig_mag,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%op_x_eig_mag,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%op_x_eig_mag,1), UBOUND(InData%op_x_eig_mag,1) - DbKiBuf(Db_Xferred) = InData%op_x_eig_mag(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%op_x_eig_phase) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%op_x_eig_phase,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%op_x_eig_phase,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%op_x_eig_phase,1), UBOUND(InData%op_x_eig_phase,1) - DbKiBuf(Db_Xferred) = InData%op_x_eig_phase(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Use_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%Use_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Use_u,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Use_u,1), UBOUND(InData%Use_u,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%Use_u(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Use_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%Use_y,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Use_y,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Use_y,1), UBOUND(InData%Use_y,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%Use_y(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - 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 - IntKiBuf( Int_Xferred ) = LBOUND(InData%A,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%A,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%A,2), UBOUND(InData%A,2) - DO i1 = LBOUND(InData%A,1), UBOUND(InData%A,1) - DbKiBuf(Db_Xferred) = InData%A(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - 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 - IntKiBuf( Int_Xferred ) = LBOUND(InData%B,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%B,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%B,2), UBOUND(InData%B,2) - DO i1 = LBOUND(InData%B,1), UBOUND(InData%B,1) - DbKiBuf(Db_Xferred) = InData%B(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - 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 - IntKiBuf( Int_Xferred ) = LBOUND(InData%C,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%C,2), UBOUND(InData%C,2) - DO i1 = LBOUND(InData%C,1), UBOUND(InData%C,1) - DbKiBuf(Db_Xferred) = InData%C(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - 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 - IntKiBuf( Int_Xferred ) = LBOUND(InData%D,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%D,2), UBOUND(InData%D,2) - DO i1 = LBOUND(InData%D,1), UBOUND(InData%D,1) - DbKiBuf(Db_Xferred) = InData%D(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%StateRotation) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StateRotation,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StateRotation,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StateRotation,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StateRotation,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%StateRotation,2), UBOUND(InData%StateRotation,2) - DO i1 = LBOUND(InData%StateRotation,1), UBOUND(InData%StateRotation,1) - DbKiBuf(Db_Xferred) = InData%StateRotation(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%StateRel_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%StateRel_x,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StateRel_x,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StateRel_x,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StateRel_x,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%StateRel_x,2), UBOUND(InData%StateRel_x,2) - DO i1 = LBOUND(InData%StateRel_x,1), UBOUND(InData%StateRel_x,1) - DbKiBuf(Db_Xferred) = InData%StateRel_x(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%StateRel_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%StateRel_xdot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StateRel_xdot,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StateRel_xdot,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StateRel_xdot,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%StateRel_xdot,2), UBOUND(InData%StateRel_xdot,2) - DO i1 = LBOUND(InData%StateRel_xdot,1), UBOUND(InData%StateRel_xdot,1) - DbKiBuf(Db_Xferred) = InData%StateRel_xdot(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - 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%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%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_z) ) THEN - 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_z,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_z,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%RotFrame_z,1), UBOUND(InData%RotFrame_z,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%RotFrame_z(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 - DO i1 = LBOUND(InData%SizeLin,1), UBOUND(InData%SizeLin,1) - IntKiBuf(Int_Xferred) = InData%SizeLin(i1) - Int_Xferred = Int_Xferred + 1 - END DO - DO i1 = LBOUND(InData%LinStartIndx,1), UBOUND(InData%LinStartIndx,1) - IntKiBuf(Int_Xferred) = InData%LinStartIndx(i1) - Int_Xferred = Int_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%NumOutputs - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE FAST_PackLinType - - SUBROUTINE FAST_UnPackLinType( 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(FAST_LinType), 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 = 'FAST_UnPackLinType' - ! 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 ! Names_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%Names_u)) DEALLOCATE(OutData%Names_u) - ALLOCATE(OutData%Names_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Names_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Names_u,1), UBOUND(OutData%Names_u,1) - DO I = 1, LEN(OutData%Names_u) - OutData%Names_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 ! Names_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%Names_y)) DEALLOCATE(OutData%Names_y) - ALLOCATE(OutData%Names_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Names_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Names_y,1), UBOUND(OutData%Names_y,1) - DO I = 1, LEN(OutData%Names_y) - OutData%Names_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 ! Names_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%Names_x)) DEALLOCATE(OutData%Names_x) - ALLOCATE(OutData%Names_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Names_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Names_x,1), UBOUND(OutData%Names_x,1) - DO I = 1, LEN(OutData%Names_x) - OutData%Names_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 ! Names_xd not allocated - Int_Xferred = Int_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%Names_xd)) DEALLOCATE(OutData%Names_xd) - ALLOCATE(OutData%Names_xd(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Names_xd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Names_xd,1), UBOUND(OutData%Names_xd,1) - DO I = 1, LEN(OutData%Names_xd) - OutData%Names_xd(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 ! Names_z not allocated - Int_Xferred = Int_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%Names_z)) DEALLOCATE(OutData%Names_z) - ALLOCATE(OutData%Names_z(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Names_z.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Names_z,1), UBOUND(OutData%Names_z,1) - DO I = 1, LEN(OutData%Names_z) - OutData%Names_z(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 ! op_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%op_u)) DEALLOCATE(OutData%op_u) - ALLOCATE(OutData%op_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%op_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%op_u,1), UBOUND(OutData%op_u,1) - OutData%op_u(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! op_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%op_y)) DEALLOCATE(OutData%op_y) - ALLOCATE(OutData%op_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%op_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%op_y,1), UBOUND(OutData%op_y,1) - OutData%op_y(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! op_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%op_x)) DEALLOCATE(OutData%op_x) - ALLOCATE(OutData%op_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%op_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%op_x,1), UBOUND(OutData%op_x,1) - OutData%op_x(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! op_dx not allocated - Int_Xferred = Int_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%op_dx)) DEALLOCATE(OutData%op_dx) - ALLOCATE(OutData%op_dx(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%op_dx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%op_dx,1), UBOUND(OutData%op_dx,1) - OutData%op_dx(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! op_xd not allocated - Int_Xferred = Int_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%op_xd)) DEALLOCATE(OutData%op_xd) - ALLOCATE(OutData%op_xd(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%op_xd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%op_xd,1), UBOUND(OutData%op_xd,1) - OutData%op_xd(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! op_z not allocated - Int_Xferred = Int_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%op_z)) DEALLOCATE(OutData%op_z) - ALLOCATE(OutData%op_z(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%op_z.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%op_z,1), UBOUND(OutData%op_z,1) - OutData%op_z(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! op_x_eig_mag not allocated - Int_Xferred = Int_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%op_x_eig_mag)) DEALLOCATE(OutData%op_x_eig_mag) - ALLOCATE(OutData%op_x_eig_mag(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%op_x_eig_mag.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%op_x_eig_mag,1), UBOUND(OutData%op_x_eig_mag,1) - OutData%op_x_eig_mag(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! op_x_eig_phase not allocated - Int_Xferred = Int_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%op_x_eig_phase)) DEALLOCATE(OutData%op_x_eig_phase) - ALLOCATE(OutData%op_x_eig_phase(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%op_x_eig_phase.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%op_x_eig_phase,1), UBOUND(OutData%op_x_eig_phase,1) - OutData%op_x_eig_phase(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Use_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%Use_u)) DEALLOCATE(OutData%Use_u) - ALLOCATE(OutData%Use_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Use_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Use_u,1), UBOUND(OutData%Use_u,1) - OutData%Use_u(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%Use_u(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Use_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%Use_y)) DEALLOCATE(OutData%Use_y) - ALLOCATE(OutData%Use_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Use_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Use_y,1), UBOUND(OutData%Use_y,1) - OutData%Use_y(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%Use_y(i1)) - Int_Xferred = Int_Xferred + 1 - 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 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%A)) DEALLOCATE(OutData%A) - ALLOCATE(OutData%A(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%A.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%A,2), UBOUND(OutData%A,2) - DO i1 = LBOUND(OutData%A,1), UBOUND(OutData%A,1) - OutData%A(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - 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 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%B)) DEALLOCATE(OutData%B) - ALLOCATE(OutData%B(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%B.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%B,2), UBOUND(OutData%B,2) - DO i1 = LBOUND(OutData%B,1), UBOUND(OutData%B,1) - OutData%B(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - 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 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%C)) DEALLOCATE(OutData%C) - ALLOCATE(OutData%C(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%C.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%C,2), UBOUND(OutData%C,2) - DO i1 = LBOUND(OutData%C,1), UBOUND(OutData%C,1) - OutData%C(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - 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 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%D)) DEALLOCATE(OutData%D) - ALLOCATE(OutData%D(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%D.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%D,2), UBOUND(OutData%D,2) - DO i1 = LBOUND(OutData%D,1), UBOUND(OutData%D,1) - OutData%D(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StateRotation not allocated - Int_Xferred = Int_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%StateRotation)) DEALLOCATE(OutData%StateRotation) - ALLOCATE(OutData%StateRotation(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StateRotation.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%StateRotation,2), UBOUND(OutData%StateRotation,2) - DO i1 = LBOUND(OutData%StateRotation,1), UBOUND(OutData%StateRotation,1) - OutData%StateRotation(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StateRel_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%StateRel_x)) DEALLOCATE(OutData%StateRel_x) - ALLOCATE(OutData%StateRel_x(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StateRel_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%StateRel_x,2), UBOUND(OutData%StateRel_x,2) - DO i1 = LBOUND(OutData%StateRel_x,1), UBOUND(OutData%StateRel_x,1) - OutData%StateRel_x(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StateRel_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%StateRel_xdot)) DEALLOCATE(OutData%StateRel_xdot) - ALLOCATE(OutData%StateRel_xdot(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StateRel_xdot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%StateRel_xdot,2), UBOUND(OutData%StateRel_xdot,2) - DO i1 = LBOUND(OutData%StateRel_xdot,1), UBOUND(OutData%StateRel_xdot,1) - OutData%StateRel_xdot(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - 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 ! 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 ! 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_z not allocated - Int_Xferred = Int_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_z)) DEALLOCATE(OutData%RotFrame_z) - ALLOCATE(OutData%RotFrame_z(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_z.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%RotFrame_z,1), UBOUND(OutData%RotFrame_z,1) - OutData%RotFrame_z(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotFrame_z(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 - i1_l = LBOUND(OutData%SizeLin,1) - i1_u = UBOUND(OutData%SizeLin,1) - DO i1 = LBOUND(OutData%SizeLin,1), UBOUND(OutData%SizeLin,1) - OutData%SizeLin(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - i1_l = LBOUND(OutData%LinStartIndx,1) - i1_u = UBOUND(OutData%LinStartIndx,1) - DO i1 = LBOUND(OutData%LinStartIndx,1), UBOUND(OutData%LinStartIndx,1) - OutData%LinStartIndx(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - OutData%NumOutputs = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE FAST_UnPackLinType - - SUBROUTINE FAST_CopyModLinType( SrcModLinTypeData, DstModLinTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FAST_ModLinType), INTENT(IN) :: SrcModLinTypeData - TYPE(FAST_ModLinType), INTENT(INOUT) :: DstModLinTypeData - 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 = 'FAST_CopyModLinType' -! + ErrMsg = '' + DstVTK_ModeShapeTypeData%CheckpointRoot = SrcVTK_ModeShapeTypeData%CheckpointRoot + DstVTK_ModeShapeTypeData%MatlabFileName = SrcVTK_ModeShapeTypeData%MatlabFileName + DstVTK_ModeShapeTypeData%VTKLinModes = SrcVTK_ModeShapeTypeData%VTKLinModes + if (allocated(SrcVTK_ModeShapeTypeData%VTKModes)) then + LB(1:1) = lbound(SrcVTK_ModeShapeTypeData%VTKModes) + UB(1:1) = ubound(SrcVTK_ModeShapeTypeData%VTKModes) + if (.not. allocated(DstVTK_ModeShapeTypeData%VTKModes)) then + allocate(DstVTK_ModeShapeTypeData%VTKModes(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_ModeShapeTypeData%VTKModes.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstVTK_ModeShapeTypeData%VTKModes = SrcVTK_ModeShapeTypeData%VTKModes + end if + DstVTK_ModeShapeTypeData%VTKLinTim = SrcVTK_ModeShapeTypeData%VTKLinTim + DstVTK_ModeShapeTypeData%VTKNLinTimes = SrcVTK_ModeShapeTypeData%VTKNLinTimes + DstVTK_ModeShapeTypeData%VTKLinScale = SrcVTK_ModeShapeTypeData%VTKLinScale + DstVTK_ModeShapeTypeData%VTKLinPhase = SrcVTK_ModeShapeTypeData%VTKLinPhase + if (allocated(SrcVTK_ModeShapeTypeData%DampingRatio)) then + LB(1:1) = lbound(SrcVTK_ModeShapeTypeData%DampingRatio) + UB(1:1) = ubound(SrcVTK_ModeShapeTypeData%DampingRatio) + if (.not. allocated(DstVTK_ModeShapeTypeData%DampingRatio)) then + allocate(DstVTK_ModeShapeTypeData%DampingRatio(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_ModeShapeTypeData%DampingRatio.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstVTK_ModeShapeTypeData%DampingRatio = SrcVTK_ModeShapeTypeData%DampingRatio + end if + if (allocated(SrcVTK_ModeShapeTypeData%NaturalFreq_Hz)) then + LB(1:1) = lbound(SrcVTK_ModeShapeTypeData%NaturalFreq_Hz) + UB(1:1) = ubound(SrcVTK_ModeShapeTypeData%NaturalFreq_Hz) + if (.not. allocated(DstVTK_ModeShapeTypeData%NaturalFreq_Hz)) then + allocate(DstVTK_ModeShapeTypeData%NaturalFreq_Hz(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_ModeShapeTypeData%NaturalFreq_Hz.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstVTK_ModeShapeTypeData%NaturalFreq_Hz = SrcVTK_ModeShapeTypeData%NaturalFreq_Hz + end if + if (allocated(SrcVTK_ModeShapeTypeData%DampedFreq_Hz)) then + LB(1:1) = lbound(SrcVTK_ModeShapeTypeData%DampedFreq_Hz) + UB(1:1) = ubound(SrcVTK_ModeShapeTypeData%DampedFreq_Hz) + if (.not. allocated(DstVTK_ModeShapeTypeData%DampedFreq_Hz)) then + allocate(DstVTK_ModeShapeTypeData%DampedFreq_Hz(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_ModeShapeTypeData%DampedFreq_Hz.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstVTK_ModeShapeTypeData%DampedFreq_Hz = SrcVTK_ModeShapeTypeData%DampedFreq_Hz + end if + if (allocated(SrcVTK_ModeShapeTypeData%x_eig_magnitude)) then + LB(1:3) = lbound(SrcVTK_ModeShapeTypeData%x_eig_magnitude) + UB(1:3) = ubound(SrcVTK_ModeShapeTypeData%x_eig_magnitude) + if (.not. allocated(DstVTK_ModeShapeTypeData%x_eig_magnitude)) then + allocate(DstVTK_ModeShapeTypeData%x_eig_magnitude(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_ModeShapeTypeData%x_eig_magnitude.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstVTK_ModeShapeTypeData%x_eig_magnitude = SrcVTK_ModeShapeTypeData%x_eig_magnitude + end if + if (allocated(SrcVTK_ModeShapeTypeData%x_eig_phase)) then + LB(1:3) = lbound(SrcVTK_ModeShapeTypeData%x_eig_phase) + UB(1:3) = ubound(SrcVTK_ModeShapeTypeData%x_eig_phase) + if (.not. allocated(DstVTK_ModeShapeTypeData%x_eig_phase)) then + allocate(DstVTK_ModeShapeTypeData%x_eig_phase(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_ModeShapeTypeData%x_eig_phase.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstVTK_ModeShapeTypeData%x_eig_phase = SrcVTK_ModeShapeTypeData%x_eig_phase + end if +end subroutine + +subroutine FAST_DestroyVTK_ModeShapeType(VTK_ModeShapeTypeData, ErrStat, ErrMsg) + type(FAST_VTK_ModeShapeType), intent(inout) :: VTK_ModeShapeTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FAST_DestroyVTK_ModeShapeType' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcModLinTypeData%Instance)) THEN - i1_l = LBOUND(SrcModLinTypeData%Instance,1) - i1_u = UBOUND(SrcModLinTypeData%Instance,1) - IF (.NOT. ALLOCATED(DstModLinTypeData%Instance)) THEN - ALLOCATE(DstModLinTypeData%Instance(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModLinTypeData%Instance.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcModLinTypeData%Instance,1), UBOUND(SrcModLinTypeData%Instance,1) - CALL FAST_Copylintype( SrcModLinTypeData%Instance(i1), DstModLinTypeData%Instance(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - END SUBROUTINE FAST_CopyModLinType - - SUBROUTINE FAST_DestroyModLinType( ModLinTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(FAST_ModLinType), INTENT(INOUT) :: ModLinTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyModLinType' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(ModLinTypeData%Instance)) THEN -DO i1 = LBOUND(ModLinTypeData%Instance,1), UBOUND(ModLinTypeData%Instance,1) - CALL FAST_Destroylintype( ModLinTypeData%Instance(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ModLinTypeData%Instance) -ENDIF - END SUBROUTINE FAST_DestroyModLinType - - SUBROUTINE FAST_PackModLinType( 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(FAST_ModLinType), 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 = 'FAST_PackModLinType' - ! 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 ! Instance allocated yes/no - IF ( ALLOCATED(InData%Instance) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Instance upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%Instance,1), UBOUND(InData%Instance,1) - Int_BufSz = Int_BufSz + 3 ! Instance: size of buffers for each call to pack subtype - CALL FAST_Packlintype( Re_Buf, Db_Buf, Int_Buf, InData%Instance(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Instance - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Instance - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Instance - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Instance - 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%Instance) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Instance,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Instance,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Instance,1), UBOUND(InData%Instance,1) - CALL FAST_Packlintype( Re_Buf, Db_Buf, Int_Buf, InData%Instance(i1), ErrStat2, ErrMsg2, OnlySize ) ! Instance - 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 FAST_PackModLinType - - SUBROUTINE FAST_UnPackModLinType( 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(FAST_ModLinType), 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 = 'FAST_UnPackModLinType' - ! 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 ! Instance not allocated - Int_Xferred = Int_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%Instance)) DEALLOCATE(OutData%Instance) - ALLOCATE(OutData%Instance(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Instance.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Instance,1), UBOUND(OutData%Instance,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 FAST_Unpacklintype( Re_Buf, Db_Buf, Int_Buf, OutData%Instance(i1), ErrStat2, ErrMsg2 ) ! Instance - 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 FAST_UnPackModLinType - - SUBROUTINE FAST_CopyLinFileType( SrcLinFileTypeData, DstLinFileTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FAST_LinFileType), INTENT(IN) :: SrcLinFileTypeData - TYPE(FAST_LinFileType), INTENT(INOUT) :: DstLinFileTypeData - 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 = 'FAST_CopyLinFileType' -! + ErrMsg = '' + if (allocated(VTK_ModeShapeTypeData%VTKModes)) then + deallocate(VTK_ModeShapeTypeData%VTKModes) + end if + if (allocated(VTK_ModeShapeTypeData%DampingRatio)) then + deallocate(VTK_ModeShapeTypeData%DampingRatio) + end if + if (allocated(VTK_ModeShapeTypeData%NaturalFreq_Hz)) then + deallocate(VTK_ModeShapeTypeData%NaturalFreq_Hz) + end if + if (allocated(VTK_ModeShapeTypeData%DampedFreq_Hz)) then + deallocate(VTK_ModeShapeTypeData%DampedFreq_Hz) + end if + if (allocated(VTK_ModeShapeTypeData%x_eig_magnitude)) then + deallocate(VTK_ModeShapeTypeData%x_eig_magnitude) + end if + if (allocated(VTK_ModeShapeTypeData%x_eig_phase)) then + deallocate(VTK_ModeShapeTypeData%x_eig_phase) + end if +end subroutine + +subroutine FAST_PackVTK_ModeShapeType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(FAST_VTK_ModeShapeType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackVTK_ModeShapeType' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%CheckpointRoot) + call RegPack(RF, InData%MatlabFileName) + call RegPack(RF, InData%VTKLinModes) + call RegPackAlloc(RF, InData%VTKModes) + call RegPack(RF, InData%VTKLinTim) + call RegPack(RF, InData%VTKNLinTimes) + call RegPack(RF, InData%VTKLinScale) + call RegPack(RF, InData%VTKLinPhase) + call RegPackAlloc(RF, InData%DampingRatio) + call RegPackAlloc(RF, InData%NaturalFreq_Hz) + call RegPackAlloc(RF, InData%DampedFreq_Hz) + call RegPackAlloc(RF, InData%x_eig_magnitude) + call RegPackAlloc(RF, InData%x_eig_phase) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FAST_UnPackVTK_ModeShapeType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(FAST_VTK_ModeShapeType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackVTK_ModeShapeType' + integer(B4Ki) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%CheckpointRoot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MatlabFileName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VTKLinModes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%VTKModes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VTKLinTim); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VTKNLinTimes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VTKLinScale); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VTKLinPhase); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%DampingRatio); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%NaturalFreq_Hz); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%DampedFreq_Hz); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%x_eig_magnitude); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%x_eig_phase); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FAST_CopySS_CaseType(SrcSS_CaseTypeData, DstSS_CaseTypeData, CtrlCode, ErrStat, ErrMsg) + type(FAST_SS_CaseType), intent(in) :: SrcSS_CaseTypeData + type(FAST_SS_CaseType), intent(inout) :: DstSS_CaseTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FAST_CopySS_CaseType' ErrStat = ErrID_None - ErrMsg = "" - DO i1 = LBOUND(SrcLinFileTypeData%Modules,1), UBOUND(SrcLinFileTypeData%Modules,1) - CALL FAST_Copymodlintype( SrcLinFileTypeData%Modules(i1), DstLinFileTypeData%Modules(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - CALL FAST_Copylintype( SrcLinFileTypeData%Glue, DstLinFileTypeData%Glue, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstLinFileTypeData%RotSpeed = SrcLinFileTypeData%RotSpeed - DstLinFileTypeData%Azimuth = SrcLinFileTypeData%Azimuth - DstLinFileTypeData%WindSpeed = SrcLinFileTypeData%WindSpeed - END SUBROUTINE FAST_CopyLinFileType - - SUBROUTINE FAST_DestroyLinFileType( LinFileTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(FAST_LinFileType), INTENT(INOUT) :: LinFileTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyLinFileType' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -DO i1 = LBOUND(LinFileTypeData%Modules,1), UBOUND(LinFileTypeData%Modules,1) - CALL FAST_Destroymodlintype( LinFileTypeData%Modules(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - CALL FAST_Destroylintype( LinFileTypeData%Glue, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE FAST_DestroyLinFileType - - SUBROUTINE FAST_PackLinFileType( 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(FAST_LinFileType), 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 = 'FAST_PackLinFileType' - ! 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) - DO i1 = LBOUND(InData%Modules,1), UBOUND(InData%Modules,1) - Int_BufSz = Int_BufSz + 3 ! Modules: size of buffers for each call to pack subtype - CALL FAST_Packmodlintype( Re_Buf, Db_Buf, Int_Buf, InData%Modules(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Modules - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Modules - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Modules - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Modules - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - Int_BufSz = Int_BufSz + 3 ! Glue: size of buffers for each call to pack subtype - CALL FAST_Packlintype( Re_Buf, Db_Buf, Int_Buf, InData%Glue, ErrStat2, ErrMsg2, .TRUE. ) ! Glue - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Glue - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Glue - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Glue - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Re_BufSz = Re_BufSz + 1 ! RotSpeed - Re_BufSz = Re_BufSz + 1 ! Azimuth - Re_BufSz = Re_BufSz + 1 ! WindSpeed - 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%Modules,1), UBOUND(InData%Modules,1) - CALL FAST_Packmodlintype( Re_Buf, Db_Buf, Int_Buf, InData%Modules(i1), ErrStat2, ErrMsg2, OnlySize ) ! Modules - 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 - CALL FAST_Packlintype( Re_Buf, Db_Buf, Int_Buf, InData%Glue, ErrStat2, ErrMsg2, OnlySize ) ! Glue - 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 - ReKiBuf(Re_Xferred) = InData%RotSpeed - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Azimuth - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WindSpeed - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE FAST_PackLinFileType - - SUBROUTINE FAST_UnPackLinFileType( 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(FAST_LinFileType), 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 = 'FAST_UnPackLinFileType' - ! 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%Modules,1) - i1_u = UBOUND(OutData%Modules,1) - DO i1 = LBOUND(OutData%Modules,1), UBOUND(OutData%Modules,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 FAST_Unpackmodlintype( Re_Buf, Db_Buf, Int_Buf, OutData%Modules(i1), ErrStat2, ErrMsg2 ) ! Modules - 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 - 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 FAST_Unpacklintype( Re_Buf, Db_Buf, Int_Buf, OutData%Glue, ErrStat2, ErrMsg2 ) ! Glue - 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%RotSpeed = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Azimuth = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%WindSpeed = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE FAST_UnPackLinFileType - - SUBROUTINE FAST_CopyMiscLinType( SrcMiscLinTypeData, DstMiscLinTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FAST_MiscLinType), INTENT(IN) :: SrcMiscLinTypeData - TYPE(FAST_MiscLinType), INTENT(INOUT) :: DstMiscLinTypeData - 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 = 'FAST_CopyMiscLinType' -! + ErrMsg = '' + DstSS_CaseTypeData%RotSpeed = SrcSS_CaseTypeData%RotSpeed + DstSS_CaseTypeData%TSR = SrcSS_CaseTypeData%TSR + DstSS_CaseTypeData%WindSpeed = SrcSS_CaseTypeData%WindSpeed + DstSS_CaseTypeData%Pitch = SrcSS_CaseTypeData%Pitch +end subroutine + +subroutine FAST_DestroySS_CaseType(SS_CaseTypeData, ErrStat, ErrMsg) + type(FAST_SS_CaseType), intent(inout) :: SS_CaseTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FAST_DestroySS_CaseType' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcMiscLinTypeData%LinTimes)) THEN - i1_l = LBOUND(SrcMiscLinTypeData%LinTimes,1) - i1_u = UBOUND(SrcMiscLinTypeData%LinTimes,1) - IF (.NOT. ALLOCATED(DstMiscLinTypeData%LinTimes)) THEN - ALLOCATE(DstMiscLinTypeData%LinTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscLinTypeData%LinTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscLinTypeData%LinTimes = SrcMiscLinTypeData%LinTimes -ENDIF - DstMiscLinTypeData%CopyOP_CtrlCode = SrcMiscLinTypeData%CopyOP_CtrlCode -IF (ALLOCATED(SrcMiscLinTypeData%AzimTarget)) THEN - i1_l = LBOUND(SrcMiscLinTypeData%AzimTarget,1) - i1_u = UBOUND(SrcMiscLinTypeData%AzimTarget,1) - IF (.NOT. ALLOCATED(DstMiscLinTypeData%AzimTarget)) THEN - ALLOCATE(DstMiscLinTypeData%AzimTarget(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscLinTypeData%AzimTarget.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscLinTypeData%AzimTarget = SrcMiscLinTypeData%AzimTarget -ENDIF - DstMiscLinTypeData%IsConverged = SrcMiscLinTypeData%IsConverged - DstMiscLinTypeData%FoundSteady = SrcMiscLinTypeData%FoundSteady - DstMiscLinTypeData%ForceLin = SrcMiscLinTypeData%ForceLin - DstMiscLinTypeData%n_rot = SrcMiscLinTypeData%n_rot - DstMiscLinTypeData%AzimIndx = SrcMiscLinTypeData%AzimIndx - DstMiscLinTypeData%NextLinTimeIndx = SrcMiscLinTypeData%NextLinTimeIndx -IF (ALLOCATED(SrcMiscLinTypeData%Psi)) THEN - i1_l = LBOUND(SrcMiscLinTypeData%Psi,1) - i1_u = UBOUND(SrcMiscLinTypeData%Psi,1) - IF (.NOT. ALLOCATED(DstMiscLinTypeData%Psi)) THEN - ALLOCATE(DstMiscLinTypeData%Psi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscLinTypeData%Psi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscLinTypeData%Psi = SrcMiscLinTypeData%Psi -ENDIF -IF (ALLOCATED(SrcMiscLinTypeData%y_interp)) THEN - i1_l = LBOUND(SrcMiscLinTypeData%y_interp,1) - i1_u = UBOUND(SrcMiscLinTypeData%y_interp,1) - IF (.NOT. ALLOCATED(DstMiscLinTypeData%y_interp)) THEN - ALLOCATE(DstMiscLinTypeData%y_interp(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscLinTypeData%y_interp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscLinTypeData%y_interp = SrcMiscLinTypeData%y_interp -ENDIF -IF (ALLOCATED(SrcMiscLinTypeData%y_ref)) THEN - i1_l = LBOUND(SrcMiscLinTypeData%y_ref,1) - i1_u = UBOUND(SrcMiscLinTypeData%y_ref,1) - IF (.NOT. ALLOCATED(DstMiscLinTypeData%y_ref)) THEN - ALLOCATE(DstMiscLinTypeData%y_ref(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscLinTypeData%y_ref.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscLinTypeData%y_ref = SrcMiscLinTypeData%y_ref -ENDIF -IF (ALLOCATED(SrcMiscLinTypeData%Y_prevRot)) THEN - i1_l = LBOUND(SrcMiscLinTypeData%Y_prevRot,1) - i1_u = UBOUND(SrcMiscLinTypeData%Y_prevRot,1) - i2_l = LBOUND(SrcMiscLinTypeData%Y_prevRot,2) - i2_u = UBOUND(SrcMiscLinTypeData%Y_prevRot,2) - IF (.NOT. ALLOCATED(DstMiscLinTypeData%Y_prevRot)) THEN - ALLOCATE(DstMiscLinTypeData%Y_prevRot(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscLinTypeData%Y_prevRot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscLinTypeData%Y_prevRot = SrcMiscLinTypeData%Y_prevRot -ENDIF - END SUBROUTINE FAST_CopyMiscLinType - - SUBROUTINE FAST_DestroyMiscLinType( MiscLinTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(FAST_MiscLinType), INTENT(INOUT) :: MiscLinTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyMiscLinType' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(MiscLinTypeData%LinTimes)) THEN - DEALLOCATE(MiscLinTypeData%LinTimes) -ENDIF -IF (ALLOCATED(MiscLinTypeData%AzimTarget)) THEN - DEALLOCATE(MiscLinTypeData%AzimTarget) -ENDIF -IF (ALLOCATED(MiscLinTypeData%Psi)) THEN - DEALLOCATE(MiscLinTypeData%Psi) -ENDIF -IF (ALLOCATED(MiscLinTypeData%y_interp)) THEN - DEALLOCATE(MiscLinTypeData%y_interp) -ENDIF -IF (ALLOCATED(MiscLinTypeData%y_ref)) THEN - DEALLOCATE(MiscLinTypeData%y_ref) -ENDIF -IF (ALLOCATED(MiscLinTypeData%Y_prevRot)) THEN - DEALLOCATE(MiscLinTypeData%Y_prevRot) -ENDIF - END SUBROUTINE FAST_DestroyMiscLinType - - SUBROUTINE FAST_PackMiscLinType( 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(FAST_MiscLinType), 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 = 'FAST_PackMiscLinType' - ! 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 ! LinTimes allocated yes/no - IF ( ALLOCATED(InData%LinTimes) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LinTimes upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%LinTimes) ! LinTimes - END IF - Int_BufSz = Int_BufSz + 1 ! CopyOP_CtrlCode - Int_BufSz = Int_BufSz + 1 ! AzimTarget allocated yes/no - IF ( ALLOCATED(InData%AzimTarget) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! AzimTarget upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%AzimTarget) ! AzimTarget - END IF - Int_BufSz = Int_BufSz + 1 ! IsConverged - Int_BufSz = Int_BufSz + 1 ! FoundSteady - Int_BufSz = Int_BufSz + 1 ! ForceLin - Int_BufSz = Int_BufSz + 1 ! n_rot - Int_BufSz = Int_BufSz + 1 ! AzimIndx - Int_BufSz = Int_BufSz + 1 ! NextLinTimeIndx - Int_BufSz = Int_BufSz + 1 ! Psi allocated yes/no - IF ( ALLOCATED(InData%Psi) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Psi upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Psi) ! Psi - END IF - Int_BufSz = Int_BufSz + 1 ! y_interp allocated yes/no - IF ( ALLOCATED(InData%y_interp) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! y_interp upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%y_interp) ! y_interp - END IF - Int_BufSz = Int_BufSz + 1 ! y_ref allocated yes/no - IF ( ALLOCATED(InData%y_ref) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! y_ref upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%y_ref) ! y_ref - END IF - Int_BufSz = Int_BufSz + 1 ! Y_prevRot allocated yes/no - IF ( ALLOCATED(InData%Y_prevRot) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Y_prevRot upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Y_prevRot) ! Y_prevRot - 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%LinTimes) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LinTimes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinTimes,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LinTimes,1), UBOUND(InData%LinTimes,1) - DbKiBuf(Db_Xferred) = InData%LinTimes(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%CopyOP_CtrlCode - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%AzimTarget) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AzimTarget,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AzimTarget,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%AzimTarget,1), UBOUND(InData%AzimTarget,1) - DbKiBuf(Db_Xferred) = InData%AzimTarget(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = TRANSFER(InData%IsConverged, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%FoundSteady, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%ForceLin, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%n_rot - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%AzimIndx - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NextLinTimeIndx - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%Psi) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Psi,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Psi,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Psi,1), UBOUND(InData%Psi,1) - DbKiBuf(Db_Xferred) = InData%Psi(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%y_interp) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%y_interp,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%y_interp,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%y_interp,1), UBOUND(InData%y_interp,1) - ReKiBuf(Re_Xferred) = InData%y_interp(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%y_ref) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%y_ref,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%y_ref,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%y_ref,1), UBOUND(InData%y_ref,1) - ReKiBuf(Re_Xferred) = InData%y_ref(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Y_prevRot) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Y_prevRot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Y_prevRot,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Y_prevRot,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Y_prevRot,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Y_prevRot,2), UBOUND(InData%Y_prevRot,2) - DO i1 = LBOUND(InData%Y_prevRot,1), UBOUND(InData%Y_prevRot,1) - ReKiBuf(Re_Xferred) = InData%Y_prevRot(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE FAST_PackMiscLinType - - SUBROUTINE FAST_UnPackMiscLinType( 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(FAST_MiscLinType), 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 = 'FAST_UnPackMiscLinType' - ! 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 ! LinTimes not allocated - Int_Xferred = Int_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%LinTimes)) DEALLOCATE(OutData%LinTimes) - ALLOCATE(OutData%LinTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LinTimes,1), UBOUND(OutData%LinTimes,1) - OutData%LinTimes(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - OutData%CopyOP_CtrlCode = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AzimTarget not allocated - Int_Xferred = Int_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%AzimTarget)) DEALLOCATE(OutData%AzimTarget) - ALLOCATE(OutData%AzimTarget(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AzimTarget.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%AzimTarget,1), UBOUND(OutData%AzimTarget,1) - OutData%AzimTarget(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - OutData%IsConverged = TRANSFER(IntKiBuf(Int_Xferred), OutData%IsConverged) - Int_Xferred = Int_Xferred + 1 - OutData%FoundSteady = TRANSFER(IntKiBuf(Int_Xferred), OutData%FoundSteady) - Int_Xferred = Int_Xferred + 1 - OutData%ForceLin = TRANSFER(IntKiBuf(Int_Xferred), OutData%ForceLin) - Int_Xferred = Int_Xferred + 1 - OutData%n_rot = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%AzimIndx = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NextLinTimeIndx = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Psi not allocated - Int_Xferred = Int_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%Psi)) DEALLOCATE(OutData%Psi) - ALLOCATE(OutData%Psi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Psi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Psi,1), UBOUND(OutData%Psi,1) - OutData%Psi(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! y_interp not allocated - Int_Xferred = Int_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%y_interp)) DEALLOCATE(OutData%y_interp) - ALLOCATE(OutData%y_interp(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%y_interp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%y_interp,1), UBOUND(OutData%y_interp,1) - OutData%y_interp(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! y_ref not allocated - Int_Xferred = Int_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%y_ref)) DEALLOCATE(OutData%y_ref) - ALLOCATE(OutData%y_ref(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%y_ref.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%y_ref,1), UBOUND(OutData%y_ref,1) - OutData%y_ref(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Y_prevRot not allocated - Int_Xferred = Int_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%Y_prevRot)) DEALLOCATE(OutData%Y_prevRot) - ALLOCATE(OutData%Y_prevRot(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Y_prevRot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Y_prevRot,2), UBOUND(OutData%Y_prevRot,2) - DO i1 = LBOUND(OutData%Y_prevRot,1), UBOUND(OutData%Y_prevRot,1) - OutData%Y_prevRot(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE FAST_UnPackMiscLinType - - SUBROUTINE FAST_CopyOutputFileType( SrcOutputFileTypeData, DstOutputFileTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FAST_OutputFileType), INTENT(INOUT) :: SrcOutputFileTypeData - TYPE(FAST_OutputFileType), INTENT(INOUT) :: DstOutputFileTypeData - 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 = 'FAST_CopyOutputFileType' -! + ErrMsg = '' +end subroutine + +subroutine FAST_PackSS_CaseType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(FAST_SS_CaseType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackSS_CaseType' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%RotSpeed) + call RegPack(RF, InData%TSR) + call RegPack(RF, InData%WindSpeed) + call RegPack(RF, InData%Pitch) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FAST_UnPackSS_CaseType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(FAST_SS_CaseType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackSS_CaseType' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%RotSpeed); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TSR); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WindSpeed); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Pitch); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FAST_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(FAST_ParameterType), intent(in) :: SrcParamData + type(FAST_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_CopyParam' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcOutputFileTypeData%TimeData)) THEN - i1_l = LBOUND(SrcOutputFileTypeData%TimeData,1) - i1_u = UBOUND(SrcOutputFileTypeData%TimeData,1) - IF (.NOT. ALLOCATED(DstOutputFileTypeData%TimeData)) THEN - ALLOCATE(DstOutputFileTypeData%TimeData(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputFileTypeData%TimeData.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputFileTypeData%TimeData = SrcOutputFileTypeData%TimeData -ENDIF -IF (ALLOCATED(SrcOutputFileTypeData%AllOutData)) THEN - i1_l = LBOUND(SrcOutputFileTypeData%AllOutData,1) - i1_u = UBOUND(SrcOutputFileTypeData%AllOutData,1) - i2_l = LBOUND(SrcOutputFileTypeData%AllOutData,2) - i2_u = UBOUND(SrcOutputFileTypeData%AllOutData,2) - IF (.NOT. ALLOCATED(DstOutputFileTypeData%AllOutData)) THEN - ALLOCATE(DstOutputFileTypeData%AllOutData(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputFileTypeData%AllOutData.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputFileTypeData%AllOutData = SrcOutputFileTypeData%AllOutData -ENDIF - DstOutputFileTypeData%n_Out = SrcOutputFileTypeData%n_Out - DstOutputFileTypeData%NOutSteps = SrcOutputFileTypeData%NOutSteps - DstOutputFileTypeData%numOuts = SrcOutputFileTypeData%numOuts - DstOutputFileTypeData%UnOu = SrcOutputFileTypeData%UnOu - DstOutputFileTypeData%UnSum = SrcOutputFileTypeData%UnSum - DstOutputFileTypeData%UnGra = SrcOutputFileTypeData%UnGra - DstOutputFileTypeData%FileDescLines = SrcOutputFileTypeData%FileDescLines -IF (ALLOCATED(SrcOutputFileTypeData%ChannelNames)) THEN - i1_l = LBOUND(SrcOutputFileTypeData%ChannelNames,1) - i1_u = UBOUND(SrcOutputFileTypeData%ChannelNames,1) - IF (.NOT. ALLOCATED(DstOutputFileTypeData%ChannelNames)) THEN - ALLOCATE(DstOutputFileTypeData%ChannelNames(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputFileTypeData%ChannelNames.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputFileTypeData%ChannelNames = SrcOutputFileTypeData%ChannelNames -ENDIF -IF (ALLOCATED(SrcOutputFileTypeData%ChannelUnits)) THEN - i1_l = LBOUND(SrcOutputFileTypeData%ChannelUnits,1) - i1_u = UBOUND(SrcOutputFileTypeData%ChannelUnits,1) - IF (.NOT. ALLOCATED(DstOutputFileTypeData%ChannelUnits)) THEN - ALLOCATE(DstOutputFileTypeData%ChannelUnits(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputFileTypeData%ChannelUnits.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputFileTypeData%ChannelUnits = SrcOutputFileTypeData%ChannelUnits -ENDIF - DO i1 = LBOUND(SrcOutputFileTypeData%Module_Ver,1), UBOUND(SrcOutputFileTypeData%Module_Ver,1) - CALL NWTC_Library_Copyprogdesc( SrcOutputFileTypeData%Module_Ver(i1), DstOutputFileTypeData%Module_Ver(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DstOutputFileTypeData%Module_Abrev = SrcOutputFileTypeData%Module_Abrev - DstOutputFileTypeData%WriteThisStep = SrcOutputFileTypeData%WriteThisStep - DstOutputFileTypeData%VTK_count = SrcOutputFileTypeData%VTK_count - DstOutputFileTypeData%VTK_LastWaveIndx = SrcOutputFileTypeData%VTK_LastWaveIndx - CALL FAST_Copylinfiletype( SrcOutputFileTypeData%Lin, DstOutputFileTypeData%Lin, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstOutputFileTypeData%ActualChanLen = SrcOutputFileTypeData%ActualChanLen - DstOutputFileTypeData%OutFmt_a = SrcOutputFileTypeData%OutFmt_a - CALL FAST_Copylinstatesave( SrcOutputFileTypeData%op, DstOutputFileTypeData%op, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstOutputFileTypeData%DriverWriteOutput = SrcOutputFileTypeData%DriverWriteOutput - END SUBROUTINE FAST_CopyOutputFileType - - SUBROUTINE FAST_DestroyOutputFileType( OutputFileTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(FAST_OutputFileType), INTENT(INOUT) :: OutputFileTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyOutputFileType' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(OutputFileTypeData%TimeData)) THEN - DEALLOCATE(OutputFileTypeData%TimeData) -ENDIF -IF (ALLOCATED(OutputFileTypeData%AllOutData)) THEN - DEALLOCATE(OutputFileTypeData%AllOutData) -ENDIF -IF (ALLOCATED(OutputFileTypeData%ChannelNames)) THEN - DEALLOCATE(OutputFileTypeData%ChannelNames) -ENDIF -IF (ALLOCATED(OutputFileTypeData%ChannelUnits)) THEN - DEALLOCATE(OutputFileTypeData%ChannelUnits) -ENDIF -DO i1 = LBOUND(OutputFileTypeData%Module_Ver,1), UBOUND(OutputFileTypeData%Module_Ver,1) - CALL NWTC_Library_Destroyprogdesc( OutputFileTypeData%Module_Ver(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - CALL FAST_Destroylinfiletype( OutputFileTypeData%Lin, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FAST_Destroylinstatesave( OutputFileTypeData%op, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE FAST_DestroyOutputFileType - - SUBROUTINE FAST_PackOutputFileType( 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(FAST_OutputFileType), 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 = 'FAST_PackOutputFileType' - ! 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 ! TimeData allocated yes/no - IF ( ALLOCATED(InData%TimeData) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TimeData upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%TimeData) ! TimeData - END IF - Int_BufSz = Int_BufSz + 1 ! AllOutData allocated yes/no - IF ( ALLOCATED(InData%AllOutData) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! AllOutData upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AllOutData) ! AllOutData - END IF - Int_BufSz = Int_BufSz + 1 ! n_Out - Int_BufSz = Int_BufSz + 1 ! NOutSteps - Int_BufSz = Int_BufSz + SIZE(InData%numOuts) ! numOuts - Int_BufSz = Int_BufSz + 1 ! UnOu - Int_BufSz = Int_BufSz + 1 ! UnSum - Int_BufSz = Int_BufSz + 1 ! UnGra - Int_BufSz = Int_BufSz + SIZE(InData%FileDescLines)*LEN(InData%FileDescLines) ! FileDescLines - Int_BufSz = Int_BufSz + 1 ! ChannelNames allocated yes/no - IF ( ALLOCATED(InData%ChannelNames) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ChannelNames upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%ChannelNames)*LEN(InData%ChannelNames) ! ChannelNames - END IF - Int_BufSz = Int_BufSz + 1 ! ChannelUnits allocated yes/no - IF ( ALLOCATED(InData%ChannelUnits) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ChannelUnits upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%ChannelUnits)*LEN(InData%ChannelUnits) ! ChannelUnits - END IF - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%Module_Ver,1), UBOUND(InData%Module_Ver,1) - Int_BufSz = Int_BufSz + 3 ! Module_Ver: size of buffers for each call to pack subtype - CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Module_Ver(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Module_Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Module_Ver - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Module_Ver - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Module_Ver - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - Int_BufSz = Int_BufSz + SIZE(InData%Module_Abrev)*LEN(InData%Module_Abrev) ! Module_Abrev - Int_BufSz = Int_BufSz + 1 ! WriteThisStep - Int_BufSz = Int_BufSz + 1 ! VTK_count - Int_BufSz = Int_BufSz + 1 ! VTK_LastWaveIndx - Int_BufSz = Int_BufSz + 3 ! Lin: size of buffers for each call to pack subtype - CALL FAST_Packlinfiletype( Re_Buf, Db_Buf, Int_Buf, InData%Lin, ErrStat2, ErrMsg2, .TRUE. ) ! Lin - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Lin - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Lin - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Lin - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! ActualChanLen - Int_BufSz = Int_BufSz + 1*LEN(InData%OutFmt_a) ! OutFmt_a - Int_BufSz = Int_BufSz + 3 ! op: size of buffers for each call to pack subtype - CALL FAST_Packlinstatesave( Re_Buf, Db_Buf, Int_Buf, InData%op, ErrStat2, ErrMsg2, .TRUE. ) ! op - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! op - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! op - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! op - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Re_BufSz = Re_BufSz + SIZE(InData%DriverWriteOutput) ! DriverWriteOutput - 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%TimeData) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TimeData,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TimeData,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TimeData,1), UBOUND(InData%TimeData,1) - DbKiBuf(Db_Xferred) = InData%TimeData(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AllOutData) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AllOutData,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AllOutData,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AllOutData,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AllOutData,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%AllOutData,2), UBOUND(InData%AllOutData,2) - DO i1 = LBOUND(InData%AllOutData,1), UBOUND(InData%AllOutData,1) - ReKiBuf(Re_Xferred) = InData%AllOutData(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%n_Out - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NOutSteps - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%numOuts,1), UBOUND(InData%numOuts,1) - IntKiBuf(Int_Xferred) = InData%numOuts(i1) - Int_Xferred = Int_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%UnOu - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%UnSum - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%UnGra - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%FileDescLines,1), UBOUND(InData%FileDescLines,1) - DO I = 1, LEN(InData%FileDescLines) - IntKiBuf(Int_Xferred) = ICHAR(InData%FileDescLines(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - IF ( .NOT. ALLOCATED(InData%ChannelNames) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ChannelNames,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ChannelNames,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ChannelNames,1), UBOUND(InData%ChannelNames,1) - DO I = 1, LEN(InData%ChannelNames) - IntKiBuf(Int_Xferred) = ICHAR(InData%ChannelNames(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ChannelUnits) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ChannelUnits,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ChannelUnits,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ChannelUnits,1), UBOUND(InData%ChannelUnits,1) - DO I = 1, LEN(InData%ChannelUnits) - IntKiBuf(Int_Xferred) = ICHAR(InData%ChannelUnits(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - DO i1 = LBOUND(InData%Module_Ver,1), UBOUND(InData%Module_Ver,1) - CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Module_Ver(i1), ErrStat2, ErrMsg2, OnlySize ) ! Module_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 DO - DO i1 = LBOUND(InData%Module_Abrev,1), UBOUND(InData%Module_Abrev,1) - DO I = 1, LEN(InData%Module_Abrev) - IntKiBuf(Int_Xferred) = ICHAR(InData%Module_Abrev(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - IntKiBuf(Int_Xferred) = TRANSFER(InData%WriteThisStep, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%VTK_count - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%VTK_LastWaveIndx - Int_Xferred = Int_Xferred + 1 - CALL FAST_Packlinfiletype( Re_Buf, Db_Buf, Int_Buf, InData%Lin, ErrStat2, ErrMsg2, OnlySize ) ! Lin - 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%ActualChanLen - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%OutFmt_a) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt_a(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - CALL FAST_Packlinstatesave( Re_Buf, Db_Buf, Int_Buf, InData%op, ErrStat2, ErrMsg2, OnlySize ) ! op - 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 i1 = LBOUND(InData%DriverWriteOutput,1), UBOUND(InData%DriverWriteOutput,1) - ReKiBuf(Re_Xferred) = InData%DriverWriteOutput(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END SUBROUTINE FAST_PackOutputFileType - - SUBROUTINE FAST_UnPackOutputFileType( 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(FAST_OutputFileType), 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 = 'FAST_UnPackOutputFileType' - ! 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 ! TimeData not allocated - Int_Xferred = Int_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%TimeData)) DEALLOCATE(OutData%TimeData) - ALLOCATE(OutData%TimeData(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TimeData.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TimeData,1), UBOUND(OutData%TimeData,1) - OutData%TimeData(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AllOutData not allocated - Int_Xferred = Int_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%AllOutData)) DEALLOCATE(OutData%AllOutData) - ALLOCATE(OutData%AllOutData(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AllOutData.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%AllOutData,2), UBOUND(OutData%AllOutData,2) - DO i1 = LBOUND(OutData%AllOutData,1), UBOUND(OutData%AllOutData,1) - OutData%AllOutData(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%n_Out = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NOutSteps = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%numOuts,1) - i1_u = UBOUND(OutData%numOuts,1) - DO i1 = LBOUND(OutData%numOuts,1), UBOUND(OutData%numOuts,1) - OutData%numOuts(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - OutData%UnOu = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%UnSum = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%UnGra = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%FileDescLines,1) - i1_u = UBOUND(OutData%FileDescLines,1) - DO i1 = LBOUND(OutData%FileDescLines,1), UBOUND(OutData%FileDescLines,1) - DO I = 1, LEN(OutData%FileDescLines) - OutData%FileDescLines(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ChannelNames not allocated - Int_Xferred = Int_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%ChannelNames)) DEALLOCATE(OutData%ChannelNames) - ALLOCATE(OutData%ChannelNames(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ChannelNames.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ChannelNames,1), UBOUND(OutData%ChannelNames,1) - DO I = 1, LEN(OutData%ChannelNames) - OutData%ChannelNames(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 ! ChannelUnits not allocated - Int_Xferred = Int_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%ChannelUnits)) DEALLOCATE(OutData%ChannelUnits) - ALLOCATE(OutData%ChannelUnits(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ChannelUnits.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ChannelUnits,1), UBOUND(OutData%ChannelUnits,1) - DO I = 1, LEN(OutData%ChannelUnits) - OutData%ChannelUnits(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - i1_l = LBOUND(OutData%Module_Ver,1) - i1_u = UBOUND(OutData%Module_Ver,1) - DO i1 = LBOUND(OutData%Module_Ver,1), UBOUND(OutData%Module_Ver,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%Module_Ver(i1), ErrStat2, ErrMsg2 ) ! Module_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 DO - i1_l = LBOUND(OutData%Module_Abrev,1) - i1_u = UBOUND(OutData%Module_Abrev,1) - DO i1 = LBOUND(OutData%Module_Abrev,1), UBOUND(OutData%Module_Abrev,1) - DO I = 1, LEN(OutData%Module_Abrev) - OutData%Module_Abrev(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - OutData%WriteThisStep = TRANSFER(IntKiBuf(Int_Xferred), OutData%WriteThisStep) - Int_Xferred = Int_Xferred + 1 - OutData%VTK_count = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%VTK_LastWaveIndx = IntKiBuf(Int_Xferred) - 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 FAST_Unpacklinfiletype( Re_Buf, Db_Buf, Int_Buf, OutData%Lin, ErrStat2, ErrMsg2 ) ! Lin - 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%ActualChanLen = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%OutFmt_a) - OutData%OutFmt_a(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - 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 FAST_Unpacklinstatesave( Re_Buf, Db_Buf, Int_Buf, OutData%op, ErrStat2, ErrMsg2 ) ! op - 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) - i1_l = LBOUND(OutData%DriverWriteOutput,1) - i1_u = UBOUND(OutData%DriverWriteOutput,1) - DO i1 = LBOUND(OutData%DriverWriteOutput,1), UBOUND(OutData%DriverWriteOutput,1) - OutData%DriverWriteOutput(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END SUBROUTINE FAST_UnPackOutputFileType - - SUBROUTINE FAST_CopyIceDyn_Data( SrcIceDyn_DataData, DstIceDyn_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(IceDyn_Data), INTENT(INOUT) :: SrcIceDyn_DataData - TYPE(IceDyn_Data), INTENT(INOUT) :: DstIceDyn_DataData - 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 = 'FAST_CopyIceDyn_Data' -! + ErrMsg = '' + DstParamData%DT = SrcParamData%DT + DstParamData%DT_module = SrcParamData%DT_module + DstParamData%n_substeps = SrcParamData%n_substeps + DstParamData%n_TMax_m1 = SrcParamData%n_TMax_m1 + DstParamData%TMax = SrcParamData%TMax + DstParamData%InterpOrder = SrcParamData%InterpOrder + DstParamData%NumCrctn = SrcParamData%NumCrctn + DstParamData%KMax = SrcParamData%KMax + DstParamData%numIceLegs = SrcParamData%numIceLegs + DstParamData%nBeams = SrcParamData%nBeams + DstParamData%BD_OutputSibling = SrcParamData%BD_OutputSibling + DstParamData%ModuleInitialized = SrcParamData%ModuleInitialized + DstParamData%DT_Ujac = SrcParamData%DT_Ujac + DstParamData%UJacSclFact = SrcParamData%UJacSclFact + DstParamData%SizeJac_Opt1 = SrcParamData%SizeJac_Opt1 + DstParamData%SolveOption = SrcParamData%SolveOption + DstParamData%CompElast = SrcParamData%CompElast + DstParamData%CompInflow = SrcParamData%CompInflow + DstParamData%CompAero = SrcParamData%CompAero + DstParamData%CompServo = SrcParamData%CompServo + DstParamData%CompSeaSt = SrcParamData%CompSeaSt + DstParamData%CompHydro = SrcParamData%CompHydro + DstParamData%CompSub = SrcParamData%CompSub + DstParamData%CompMooring = SrcParamData%CompMooring + DstParamData%CompIce = SrcParamData%CompIce + DstParamData%MHK = SrcParamData%MHK + DstParamData%UseDWM = SrcParamData%UseDWM + DstParamData%Linearize = SrcParamData%Linearize + DstParamData%WaveFieldMod = SrcParamData%WaveFieldMod + DstParamData%FarmIntegration = SrcParamData%FarmIntegration + DstParamData%TurbinePos = SrcParamData%TurbinePos + DstParamData%Gravity = SrcParamData%Gravity + DstParamData%AirDens = SrcParamData%AirDens + DstParamData%WtrDens = SrcParamData%WtrDens + DstParamData%KinVisc = SrcParamData%KinVisc + DstParamData%SpdSound = SrcParamData%SpdSound + DstParamData%Patm = SrcParamData%Patm + DstParamData%Pvap = SrcParamData%Pvap + DstParamData%WtrDpth = SrcParamData%WtrDpth + DstParamData%MSL2SWL = SrcParamData%MSL2SWL + DstParamData%EDFile = SrcParamData%EDFile + DstParamData%BDBldFile = SrcParamData%BDBldFile + DstParamData%InflowFile = SrcParamData%InflowFile + DstParamData%AeroFile = SrcParamData%AeroFile + DstParamData%ServoFile = SrcParamData%ServoFile + DstParamData%SeaStFile = SrcParamData%SeaStFile + DstParamData%HydroFile = SrcParamData%HydroFile + DstParamData%SubFile = SrcParamData%SubFile + DstParamData%MooringFile = SrcParamData%MooringFile + DstParamData%IceFile = SrcParamData%IceFile + DstParamData%TStart = SrcParamData%TStart + DstParamData%DT_Out = SrcParamData%DT_Out + DstParamData%WrSttsTime = SrcParamData%WrSttsTime + DstParamData%n_SttsTime = SrcParamData%n_SttsTime + DstParamData%n_ChkptTime = SrcParamData%n_ChkptTime + DstParamData%n_DT_Out = SrcParamData%n_DT_Out + DstParamData%n_VTKTime = SrcParamData%n_VTKTime + DstParamData%WrBinOutFile = SrcParamData%WrBinOutFile + DstParamData%WrTxtOutFile = SrcParamData%WrTxtOutFile + DstParamData%WrBinMod = SrcParamData%WrBinMod + DstParamData%SumPrint = SrcParamData%SumPrint + DstParamData%WrVTK = SrcParamData%WrVTK + DstParamData%VTK_Type = SrcParamData%VTK_Type + DstParamData%VTK_fields = SrcParamData%VTK_fields + DstParamData%Delim = SrcParamData%Delim + DstParamData%OutFmt = SrcParamData%OutFmt + DstParamData%OutFmt_t = SrcParamData%OutFmt_t + DstParamData%FmtWidth = SrcParamData%FmtWidth + DstParamData%TChanLen = SrcParamData%TChanLen + DstParamData%OutFileRoot = SrcParamData%OutFileRoot + DstParamData%FTitle = SrcParamData%FTitle + DstParamData%VTK_OutFileRoot = SrcParamData%VTK_OutFileRoot + DstParamData%VTK_tWidth = SrcParamData%VTK_tWidth + DstParamData%VTK_fps = SrcParamData%VTK_fps + call FAST_CopyVTK_SurfaceType(SrcParamData%VTK_surface, DstParamData%VTK_surface, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstParamData%Tdesc = SrcParamData%Tdesc + DstParamData%CalcSteady = SrcParamData%CalcSteady + DstParamData%TrimCase = SrcParamData%TrimCase + DstParamData%TrimTol = SrcParamData%TrimTol + DstParamData%TrimGain = SrcParamData%TrimGain + DstParamData%Twr_Kdmp = SrcParamData%Twr_Kdmp + DstParamData%Bld_Kdmp = SrcParamData%Bld_Kdmp + DstParamData%NLinTimes = SrcParamData%NLinTimes + DstParamData%AzimDelta = SrcParamData%AzimDelta + DstParamData%LinInputs = SrcParamData%LinInputs + DstParamData%LinOutputs = SrcParamData%LinOutputs + DstParamData%LinOutJac = SrcParamData%LinOutJac + DstParamData%LinOutMod = SrcParamData%LinOutMod + call FAST_CopyVTK_ModeShapeType(SrcParamData%VTK_modes, DstParamData%VTK_modes, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstParamData%UseSC = SrcParamData%UseSC + DstParamData%Lin_NumMods = SrcParamData%Lin_NumMods + DstParamData%Lin_ModOrder = SrcParamData%Lin_ModOrder + DstParamData%LinInterpOrder = SrcParamData%LinInterpOrder + DstParamData%CompAeroMaps = SrcParamData%CompAeroMaps + DstParamData%N_UJac = SrcParamData%N_UJac + DstParamData%NumBl_Lin = SrcParamData%NumBl_Lin + DstParamData%tolerSquared = SrcParamData%tolerSquared + DstParamData%NumSSCases = SrcParamData%NumSSCases + DstParamData%WindSpeedOrTSR = SrcParamData%WindSpeedOrTSR + DstParamData%RotSpeedInit = SrcParamData%RotSpeedInit + if (allocated(SrcParamData%RotSpeed)) then + LB(1:1) = lbound(SrcParamData%RotSpeed) + UB(1:1) = ubound(SrcParamData%RotSpeed) + if (.not. allocated(DstParamData%RotSpeed)) then + allocate(DstParamData%RotSpeed(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%RotSpeed.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%RotSpeed = SrcParamData%RotSpeed + end if + if (allocated(SrcParamData%WS_TSR)) then + LB(1:1) = lbound(SrcParamData%WS_TSR) + UB(1:1) = ubound(SrcParamData%WS_TSR) + if (.not. allocated(DstParamData%WS_TSR)) then + allocate(DstParamData%WS_TSR(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WS_TSR.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%WS_TSR = SrcParamData%WS_TSR + end if + if (allocated(SrcParamData%Pitch)) then + LB(1:1) = lbound(SrcParamData%Pitch) + UB(1:1) = ubound(SrcParamData%Pitch) + if (.not. allocated(DstParamData%Pitch)) then + allocate(DstParamData%Pitch(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Pitch.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Pitch = SrcParamData%Pitch + end if + DstParamData%GearBox_index = SrcParamData%GearBox_index +end subroutine + +subroutine FAST_DestroyParam(ParamData, ErrStat, ErrMsg) + type(FAST_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_DestroyParam' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcIceDyn_DataData%x)) THEN - i1_l = LBOUND(SrcIceDyn_DataData%x,1) - i1_u = UBOUND(SrcIceDyn_DataData%x,1) - i2_l = LBOUND(SrcIceDyn_DataData%x,2) - i2_u = UBOUND(SrcIceDyn_DataData%x,2) - IF (.NOT. ALLOCATED(DstIceDyn_DataData%x)) THEN - ALLOCATE(DstIceDyn_DataData%x(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcIceDyn_DataData%x,2), UBOUND(SrcIceDyn_DataData%x,2) - DO i1 = LBOUND(SrcIceDyn_DataData%x,1), UBOUND(SrcIceDyn_DataData%x,1) - CALL IceD_CopyContState( SrcIceDyn_DataData%x(i1,i2), DstIceDyn_DataData%x(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcIceDyn_DataData%xd)) THEN - i1_l = LBOUND(SrcIceDyn_DataData%xd,1) - i1_u = UBOUND(SrcIceDyn_DataData%xd,1) - i2_l = LBOUND(SrcIceDyn_DataData%xd,2) - i2_u = UBOUND(SrcIceDyn_DataData%xd,2) - IF (.NOT. ALLOCATED(DstIceDyn_DataData%xd)) THEN - ALLOCATE(DstIceDyn_DataData%xd(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%xd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcIceDyn_DataData%xd,2), UBOUND(SrcIceDyn_DataData%xd,2) - DO i1 = LBOUND(SrcIceDyn_DataData%xd,1), UBOUND(SrcIceDyn_DataData%xd,1) - CALL IceD_CopyDiscState( SrcIceDyn_DataData%xd(i1,i2), DstIceDyn_DataData%xd(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcIceDyn_DataData%z)) THEN - i1_l = LBOUND(SrcIceDyn_DataData%z,1) - i1_u = UBOUND(SrcIceDyn_DataData%z,1) - i2_l = LBOUND(SrcIceDyn_DataData%z,2) - i2_u = UBOUND(SrcIceDyn_DataData%z,2) - IF (.NOT. ALLOCATED(DstIceDyn_DataData%z)) THEN - ALLOCATE(DstIceDyn_DataData%z(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%z.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcIceDyn_DataData%z,2), UBOUND(SrcIceDyn_DataData%z,2) - DO i1 = LBOUND(SrcIceDyn_DataData%z,1), UBOUND(SrcIceDyn_DataData%z,1) - CALL IceD_CopyConstrState( SrcIceDyn_DataData%z(i1,i2), DstIceDyn_DataData%z(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcIceDyn_DataData%OtherSt)) THEN - i1_l = LBOUND(SrcIceDyn_DataData%OtherSt,1) - i1_u = UBOUND(SrcIceDyn_DataData%OtherSt,1) - i2_l = LBOUND(SrcIceDyn_DataData%OtherSt,2) - i2_u = UBOUND(SrcIceDyn_DataData%OtherSt,2) - IF (.NOT. ALLOCATED(DstIceDyn_DataData%OtherSt)) THEN - ALLOCATE(DstIceDyn_DataData%OtherSt(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%OtherSt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcIceDyn_DataData%OtherSt,2), UBOUND(SrcIceDyn_DataData%OtherSt,2) - DO i1 = LBOUND(SrcIceDyn_DataData%OtherSt,1), UBOUND(SrcIceDyn_DataData%OtherSt,1) - CALL IceD_CopyOtherState( SrcIceDyn_DataData%OtherSt(i1,i2), DstIceDyn_DataData%OtherSt(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcIceDyn_DataData%p)) THEN - i1_l = LBOUND(SrcIceDyn_DataData%p,1) - i1_u = UBOUND(SrcIceDyn_DataData%p,1) - IF (.NOT. ALLOCATED(DstIceDyn_DataData%p)) THEN - ALLOCATE(DstIceDyn_DataData%p(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%p.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcIceDyn_DataData%p,1), UBOUND(SrcIceDyn_DataData%p,1) - CALL IceD_CopyParam( SrcIceDyn_DataData%p(i1), DstIceDyn_DataData%p(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcIceDyn_DataData%u)) THEN - i1_l = LBOUND(SrcIceDyn_DataData%u,1) - i1_u = UBOUND(SrcIceDyn_DataData%u,1) - IF (.NOT. ALLOCATED(DstIceDyn_DataData%u)) THEN - ALLOCATE(DstIceDyn_DataData%u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcIceDyn_DataData%u,1), UBOUND(SrcIceDyn_DataData%u,1) - CALL IceD_CopyInput( SrcIceDyn_DataData%u(i1), DstIceDyn_DataData%u(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcIceDyn_DataData%y)) THEN - i1_l = LBOUND(SrcIceDyn_DataData%y,1) - i1_u = UBOUND(SrcIceDyn_DataData%y,1) - IF (.NOT. ALLOCATED(DstIceDyn_DataData%y)) THEN - ALLOCATE(DstIceDyn_DataData%y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcIceDyn_DataData%y,1), UBOUND(SrcIceDyn_DataData%y,1) - CALL IceD_CopyOutput( SrcIceDyn_DataData%y(i1), DstIceDyn_DataData%y(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcIceDyn_DataData%m)) THEN - i1_l = LBOUND(SrcIceDyn_DataData%m,1) - i1_u = UBOUND(SrcIceDyn_DataData%m,1) - IF (.NOT. ALLOCATED(DstIceDyn_DataData%m)) THEN - ALLOCATE(DstIceDyn_DataData%m(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%m.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcIceDyn_DataData%m,1), UBOUND(SrcIceDyn_DataData%m,1) - CALL IceD_CopyMisc( SrcIceDyn_DataData%m(i1), DstIceDyn_DataData%m(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcIceDyn_DataData%Input)) THEN - i1_l = LBOUND(SrcIceDyn_DataData%Input,1) - i1_u = UBOUND(SrcIceDyn_DataData%Input,1) - i2_l = LBOUND(SrcIceDyn_DataData%Input,2) - i2_u = UBOUND(SrcIceDyn_DataData%Input,2) - IF (.NOT. ALLOCATED(DstIceDyn_DataData%Input)) THEN - ALLOCATE(DstIceDyn_DataData%Input(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcIceDyn_DataData%Input,2), UBOUND(SrcIceDyn_DataData%Input,2) - DO i1 = LBOUND(SrcIceDyn_DataData%Input,1), UBOUND(SrcIceDyn_DataData%Input,1) - CALL IceD_CopyInput( SrcIceDyn_DataData%Input(i1,i2), DstIceDyn_DataData%Input(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcIceDyn_DataData%InputTimes)) THEN - i1_l = LBOUND(SrcIceDyn_DataData%InputTimes,1) - i1_u = UBOUND(SrcIceDyn_DataData%InputTimes,1) - i2_l = LBOUND(SrcIceDyn_DataData%InputTimes,2) - i2_u = UBOUND(SrcIceDyn_DataData%InputTimes,2) - IF (.NOT. ALLOCATED(DstIceDyn_DataData%InputTimes)) THEN - ALLOCATE(DstIceDyn_DataData%InputTimes(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstIceDyn_DataData%InputTimes = SrcIceDyn_DataData%InputTimes -ENDIF - END SUBROUTINE FAST_CopyIceDyn_Data - - SUBROUTINE FAST_DestroyIceDyn_Data( IceDyn_DataData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(IceDyn_Data), INTENT(INOUT) :: IceDyn_DataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyIceDyn_Data' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(IceDyn_DataData%x)) THEN -DO i2 = LBOUND(IceDyn_DataData%x,2), UBOUND(IceDyn_DataData%x,2) -DO i1 = LBOUND(IceDyn_DataData%x,1), UBOUND(IceDyn_DataData%x,1) - CALL IceD_DestroyContState( IceDyn_DataData%x(i1,i2), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO - DEALLOCATE(IceDyn_DataData%x) -ENDIF -IF (ALLOCATED(IceDyn_DataData%xd)) THEN -DO i2 = LBOUND(IceDyn_DataData%xd,2), UBOUND(IceDyn_DataData%xd,2) -DO i1 = LBOUND(IceDyn_DataData%xd,1), UBOUND(IceDyn_DataData%xd,1) - CALL IceD_DestroyDiscState( IceDyn_DataData%xd(i1,i2), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO - DEALLOCATE(IceDyn_DataData%xd) -ENDIF -IF (ALLOCATED(IceDyn_DataData%z)) THEN -DO i2 = LBOUND(IceDyn_DataData%z,2), UBOUND(IceDyn_DataData%z,2) -DO i1 = LBOUND(IceDyn_DataData%z,1), UBOUND(IceDyn_DataData%z,1) - CALL IceD_DestroyConstrState( IceDyn_DataData%z(i1,i2), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO - DEALLOCATE(IceDyn_DataData%z) -ENDIF -IF (ALLOCATED(IceDyn_DataData%OtherSt)) THEN -DO i2 = LBOUND(IceDyn_DataData%OtherSt,2), UBOUND(IceDyn_DataData%OtherSt,2) -DO i1 = LBOUND(IceDyn_DataData%OtherSt,1), UBOUND(IceDyn_DataData%OtherSt,1) - CALL IceD_DestroyOtherState( IceDyn_DataData%OtherSt(i1,i2), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO - DEALLOCATE(IceDyn_DataData%OtherSt) -ENDIF -IF (ALLOCATED(IceDyn_DataData%p)) THEN -DO i1 = LBOUND(IceDyn_DataData%p,1), UBOUND(IceDyn_DataData%p,1) - CALL IceD_DestroyParam( IceDyn_DataData%p(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(IceDyn_DataData%p) -ENDIF -IF (ALLOCATED(IceDyn_DataData%u)) THEN -DO i1 = LBOUND(IceDyn_DataData%u,1), UBOUND(IceDyn_DataData%u,1) - CALL IceD_DestroyInput( IceDyn_DataData%u(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(IceDyn_DataData%u) -ENDIF -IF (ALLOCATED(IceDyn_DataData%y)) THEN -DO i1 = LBOUND(IceDyn_DataData%y,1), UBOUND(IceDyn_DataData%y,1) - CALL IceD_DestroyOutput( IceDyn_DataData%y(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(IceDyn_DataData%y) -ENDIF -IF (ALLOCATED(IceDyn_DataData%m)) THEN -DO i1 = LBOUND(IceDyn_DataData%m,1), UBOUND(IceDyn_DataData%m,1) - CALL IceD_DestroyMisc( IceDyn_DataData%m(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(IceDyn_DataData%m) -ENDIF -IF (ALLOCATED(IceDyn_DataData%Input)) THEN -DO i2 = LBOUND(IceDyn_DataData%Input,2), UBOUND(IceDyn_DataData%Input,2) -DO i1 = LBOUND(IceDyn_DataData%Input,1), UBOUND(IceDyn_DataData%Input,1) - CALL IceD_DestroyInput( IceDyn_DataData%Input(i1,i2), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO - DEALLOCATE(IceDyn_DataData%Input) -ENDIF -IF (ALLOCATED(IceDyn_DataData%InputTimes)) THEN - DEALLOCATE(IceDyn_DataData%InputTimes) -ENDIF - END SUBROUTINE FAST_DestroyIceDyn_Data - - SUBROUTINE FAST_PackIceDyn_Data( 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(IceDyn_Data), 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 = 'FAST_PackIceDyn_Data' - ! 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 ! x allocated yes/no - IF ( ALLOCATED(InData%x) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! x upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i2 = LBOUND(InData%x,2), UBOUND(InData%x,2) - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - Int_BufSz = Int_BufSz + 3 ! x: size of buffers for each call to pack subtype - CALL IceD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! xd allocated yes/no - IF ( ALLOCATED(InData%xd) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! xd upper/lower bounds for each dimension - DO i2 = LBOUND(InData%xd,2), UBOUND(InData%xd,2) - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype - CALL IceD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xd - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! z allocated yes/no - IF ( ALLOCATED(InData%z) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! z upper/lower bounds for each dimension - DO i2 = LBOUND(InData%z,2), UBOUND(InData%z,2) - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype - CALL IceD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! z - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! z - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! z - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! OtherSt allocated yes/no - IF ( ALLOCATED(InData%OtherSt) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! OtherSt upper/lower bounds for each dimension - DO i2 = LBOUND(InData%OtherSt,2), UBOUND(InData%OtherSt,2) - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - Int_BufSz = Int_BufSz + 3 ! OtherSt: size of buffers for each call to pack subtype - CALL IceD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! p allocated yes/no - IF ( ALLOCATED(InData%p) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! p upper/lower bounds for each dimension - DO i1 = LBOUND(InData%p,1), UBOUND(InData%p,1) - Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype - CALL IceD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p(i1), ErrStat2, ErrMsg2, .TRUE. ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! p - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! p - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! p - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! u allocated yes/no - IF ( ALLOCATED(InData%u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! u upper/lower bounds for each dimension - DO i1 = LBOUND(InData%u,1), UBOUND(InData%u,1) - Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype - CALL IceD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u(i1), ErrStat2, ErrMsg2, .TRUE. ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! y allocated yes/no - IF ( ALLOCATED(InData%y) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! y upper/lower bounds for each dimension - DO i1 = LBOUND(InData%y,1), UBOUND(InData%y,1) - Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype - CALL IceD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y(i1), ErrStat2, ErrMsg2, .TRUE. ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! m allocated yes/no - IF ( ALLOCATED(InData%m) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! m upper/lower bounds for each dimension - DO i1 = LBOUND(InData%m,1), UBOUND(InData%m,1) - Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype - CALL IceD_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m(i1), ErrStat2, ErrMsg2, .TRUE. ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! m - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! m - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! m - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! Input allocated yes/no - IF ( ALLOCATED(InData%Input) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Input upper/lower bounds for each dimension - DO i2 = LBOUND(InData%Input,2), UBOUND(InData%Input,2) - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - Int_BufSz = Int_BufSz + 3 ! Input: size of buffers for each call to pack subtype - CALL IceD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! Input - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Input - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Input - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Input - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! InputTimes allocated yes/no - IF ( ALLOCATED(InData%InputTimes) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! InputTimes upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes - 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%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%x,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%x,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%x,2), UBOUND(InData%x,2) - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - CALL IceD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! x - 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 DO - END IF - IF ( .NOT. ALLOCATED(InData%xd) ) THEN - 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,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xd,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%xd,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xd,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%xd,2), UBOUND(InData%xd,2) - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - CALL IceD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! xd - 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 DO - END IF - IF ( .NOT. ALLOCATED(InData%z) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%z,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%z,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%z,2), UBOUND(InData%z,2) - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - CALL IceD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! z - 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 DO - END IF - IF ( .NOT. ALLOCATED(InData%OtherSt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OtherSt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OtherSt,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OtherSt,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OtherSt,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%OtherSt,2), UBOUND(InData%OtherSt,2) - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - CALL IceD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt - 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 DO - END IF - IF ( .NOT. ALLOCATED(InData%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%p,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%p,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%p,1), UBOUND(InData%p,1) - CALL IceD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p(i1), ErrStat2, ErrMsg2, OnlySize ) ! p - 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%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) - CALL IceD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u(i1), ErrStat2, ErrMsg2, OnlySize ) ! u - 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%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%y,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%y,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%y,1), UBOUND(InData%y,1) - CALL IceD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y(i1), ErrStat2, ErrMsg2, OnlySize ) ! y - 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%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 - - DO i1 = LBOUND(InData%m,1), UBOUND(InData%m,1) - CALL IceD_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m(i1), ErrStat2, ErrMsg2, OnlySize ) ! m - 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%Input) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Input,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Input,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Input,2), UBOUND(InData%Input,2) - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - CALL IceD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! Input - 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 DO - END IF - IF ( .NOT. ALLOCATED(InData%InputTimes) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InputTimes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InputTimes,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%InputTimes,2), UBOUND(InData%InputTimes,2) - DO i1 = LBOUND(InData%InputTimes,1), UBOUND(InData%InputTimes,1) - DbKiBuf(Db_Xferred) = InData%InputTimes(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE FAST_PackIceDyn_Data - - SUBROUTINE FAST_UnPackIceDyn_Data( 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(IceDyn_Data), 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 = 'FAST_UnPackIceDyn_Data' - ! 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 ! 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%x)) DEALLOCATE(OutData%x) - ALLOCATE(OutData%x(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%x,2), UBOUND(OutData%x,2) - DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,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 IceD_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x(i1,i2), ErrStat2, ErrMsg2 ) ! x - 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 DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! xd not allocated - Int_Xferred = Int_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%xd)) DEALLOCATE(OutData%xd) - ALLOCATE(OutData%xd(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%xd,2), UBOUND(OutData%xd,2) - DO i1 = LBOUND(OutData%xd,1), UBOUND(OutData%xd,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 IceD_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1,i2), ErrStat2, ErrMsg2 ) ! xd - 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 DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! z not allocated - Int_Xferred = Int_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%z)) DEALLOCATE(OutData%z) - ALLOCATE(OutData%z(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%z.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%z,2), UBOUND(OutData%z,2) - DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,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 IceD_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1,i2), ErrStat2, ErrMsg2 ) ! z - 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 DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OtherSt not allocated - Int_Xferred = Int_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%OtherSt)) DEALLOCATE(OutData%OtherSt) - ALLOCATE(OutData%OtherSt(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%OtherSt,2), UBOUND(OutData%OtherSt,2) - DO i1 = LBOUND(OutData%OtherSt,1), UBOUND(OutData%OtherSt,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 IceD_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt(i1,i2), ErrStat2, ErrMsg2 ) ! OtherSt - 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 DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! 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 - IF (ALLOCATED(OutData%p)) DEALLOCATE(OutData%p) - ALLOCATE(OutData%p(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%p.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%p,1), UBOUND(OutData%p,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 IceD_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p(i1), ErrStat2, ErrMsg2 ) ! p - 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 ! 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%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 - DO i1 = LBOUND(OutData%u,1), UBOUND(OutData%u,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 IceD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u(i1), ErrStat2, ErrMsg2 ) ! u - 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 ! 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%y)) DEALLOCATE(OutData%y) - ALLOCATE(OutData%y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%y,1), UBOUND(OutData%y,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 IceD_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y(i1), ErrStat2, ErrMsg2 ) ! y - 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 ! 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 - IF (ALLOCATED(OutData%m)) DEALLOCATE(OutData%m) - ALLOCATE(OutData%m(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%m.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%m,1), UBOUND(OutData%m,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 IceD_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m(i1), ErrStat2, ErrMsg2 ) ! m - 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 ! Input not allocated - Int_Xferred = Int_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%Input)) DEALLOCATE(OutData%Input) - ALLOCATE(OutData%Input(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Input,2), UBOUND(OutData%Input,2) - DO i1 = LBOUND(OutData%Input,1), UBOUND(OutData%Input,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 IceD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input(i1,i2), ErrStat2, ErrMsg2 ) ! Input - 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 DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InputTimes not allocated - Int_Xferred = Int_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%InputTimes)) DEALLOCATE(OutData%InputTimes) - ALLOCATE(OutData%InputTimes(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%InputTimes,2), UBOUND(OutData%InputTimes,2) - DO i1 = LBOUND(OutData%InputTimes,1), UBOUND(OutData%InputTimes,1) - OutData%InputTimes(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE FAST_UnPackIceDyn_Data - - SUBROUTINE FAST_CopyBeamDyn_Data( SrcBeamDyn_DataData, DstBeamDyn_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(BeamDyn_Data), INTENT(INOUT) :: SrcBeamDyn_DataData - TYPE(BeamDyn_Data), INTENT(INOUT) :: DstBeamDyn_DataData - 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 = 'FAST_CopyBeamDyn_Data' -! + ErrMsg = '' + call FAST_DestroyVTK_SurfaceType(ParamData%VTK_surface, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FAST_DestroyVTK_ModeShapeType(ParamData%VTK_modes, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(ParamData%RotSpeed)) then + deallocate(ParamData%RotSpeed) + end if + if (allocated(ParamData%WS_TSR)) then + deallocate(ParamData%WS_TSR) + end if + if (allocated(ParamData%Pitch)) then + deallocate(ParamData%Pitch) + end if +end subroutine + +subroutine FAST_PackParam(RF, Indata) + type(RegFile), intent(inout) :: RF + type(FAST_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackParam' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DT) + call RegPack(RF, InData%DT_module) + call RegPack(RF, InData%n_substeps) + call RegPack(RF, InData%n_TMax_m1) + call RegPack(RF, InData%TMax) + call RegPack(RF, InData%InterpOrder) + call RegPack(RF, InData%NumCrctn) + call RegPack(RF, InData%KMax) + call RegPack(RF, InData%numIceLegs) + call RegPack(RF, InData%nBeams) + call RegPack(RF, InData%BD_OutputSibling) + call RegPack(RF, InData%ModuleInitialized) + call RegPack(RF, InData%DT_Ujac) + call RegPack(RF, InData%UJacSclFact) + call RegPack(RF, InData%SizeJac_Opt1) + call RegPack(RF, InData%SolveOption) + call RegPack(RF, InData%CompElast) + call RegPack(RF, InData%CompInflow) + call RegPack(RF, InData%CompAero) + call RegPack(RF, InData%CompServo) + call RegPack(RF, InData%CompSeaSt) + call RegPack(RF, InData%CompHydro) + call RegPack(RF, InData%CompSub) + call RegPack(RF, InData%CompMooring) + call RegPack(RF, InData%CompIce) + call RegPack(RF, InData%MHK) + call RegPack(RF, InData%UseDWM) + call RegPack(RF, InData%Linearize) + call RegPack(RF, InData%WaveFieldMod) + call RegPack(RF, InData%FarmIntegration) + call RegPack(RF, InData%TurbinePos) + call RegPack(RF, InData%Gravity) + call RegPack(RF, InData%AirDens) + call RegPack(RF, InData%WtrDens) + call RegPack(RF, InData%KinVisc) + call RegPack(RF, InData%SpdSound) + call RegPack(RF, InData%Patm) + call RegPack(RF, InData%Pvap) + call RegPack(RF, InData%WtrDpth) + call RegPack(RF, InData%MSL2SWL) + call RegPack(RF, InData%EDFile) + call RegPack(RF, InData%BDBldFile) + call RegPack(RF, InData%InflowFile) + call RegPack(RF, InData%AeroFile) + call RegPack(RF, InData%ServoFile) + call RegPack(RF, InData%SeaStFile) + call RegPack(RF, InData%HydroFile) + call RegPack(RF, InData%SubFile) + call RegPack(RF, InData%MooringFile) + call RegPack(RF, InData%IceFile) + call RegPack(RF, InData%TStart) + call RegPack(RF, InData%DT_Out) + call RegPack(RF, InData%WrSttsTime) + call RegPack(RF, InData%n_SttsTime) + call RegPack(RF, InData%n_ChkptTime) + call RegPack(RF, InData%n_DT_Out) + call RegPack(RF, InData%n_VTKTime) + call RegPack(RF, InData%WrBinOutFile) + call RegPack(RF, InData%WrTxtOutFile) + call RegPack(RF, InData%WrBinMod) + call RegPack(RF, InData%SumPrint) + call RegPack(RF, InData%WrVTK) + call RegPack(RF, InData%VTK_Type) + call RegPack(RF, InData%VTK_fields) + call RegPack(RF, InData%Delim) + call RegPack(RF, InData%OutFmt) + call RegPack(RF, InData%OutFmt_t) + call RegPack(RF, InData%FmtWidth) + call RegPack(RF, InData%TChanLen) + call RegPack(RF, InData%OutFileRoot) + call RegPack(RF, InData%FTitle) + call RegPack(RF, InData%VTK_OutFileRoot) + call RegPack(RF, InData%VTK_tWidth) + call RegPack(RF, InData%VTK_fps) + call FAST_PackVTK_SurfaceType(RF, InData%VTK_surface) + call RegPack(RF, InData%Tdesc) + call RegPack(RF, InData%CalcSteady) + call RegPack(RF, InData%TrimCase) + call RegPack(RF, InData%TrimTol) + call RegPack(RF, InData%TrimGain) + call RegPack(RF, InData%Twr_Kdmp) + call RegPack(RF, InData%Bld_Kdmp) + call RegPack(RF, InData%NLinTimes) + call RegPack(RF, InData%AzimDelta) + call RegPack(RF, InData%LinInputs) + call RegPack(RF, InData%LinOutputs) + call RegPack(RF, InData%LinOutJac) + call RegPack(RF, InData%LinOutMod) + call FAST_PackVTK_ModeShapeType(RF, InData%VTK_modes) + call RegPack(RF, InData%UseSC) + call RegPack(RF, InData%Lin_NumMods) + call RegPack(RF, InData%Lin_ModOrder) + call RegPack(RF, InData%LinInterpOrder) + call RegPack(RF, InData%CompAeroMaps) + call RegPack(RF, InData%N_UJac) + call RegPack(RF, InData%NumBl_Lin) + call RegPack(RF, InData%tolerSquared) + call RegPack(RF, InData%NumSSCases) + call RegPack(RF, InData%WindSpeedOrTSR) + call RegPack(RF, InData%RotSpeedInit) + call RegPackAlloc(RF, InData%RotSpeed) + call RegPackAlloc(RF, InData%WS_TSR) + call RegPackAlloc(RF, InData%Pitch) + call RegPack(RF, InData%GearBox_index) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FAST_UnPackParam(RF, OutData) + type(RegFile), intent(inout) :: RF + type(FAST_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackParam' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DT_module); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%n_substeps); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%n_TMax_m1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TMax); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%InterpOrder); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumCrctn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%KMax); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%numIceLegs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nBeams); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BD_OutputSibling); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ModuleInitialized); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DT_Ujac); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UJacSclFact); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SizeJac_Opt1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SolveOption); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CompElast); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CompInflow); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CompAero); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CompServo); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CompSeaSt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CompHydro); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CompSub); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CompMooring); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CompIce); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MHK); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UseDWM); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Linearize); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WaveFieldMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FarmIntegration); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TurbinePos); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Gravity); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AirDens); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WtrDens); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%KinVisc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SpdSound); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Patm); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Pvap); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WtrDpth); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MSL2SWL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%EDFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BDBldFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%InflowFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AeroFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ServoFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SeaStFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HydroFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SubFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MooringFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%IceFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TStart); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DT_Out); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WrSttsTime); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%n_SttsTime); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%n_ChkptTime); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%n_DT_Out); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%n_VTKTime); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WrBinOutFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WrTxtOutFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WrBinMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SumPrint); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WrVTK); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VTK_Type); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VTK_fields); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Delim); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutFmt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutFmt_t); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FmtWidth); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TChanLen); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutFileRoot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FTitle); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VTK_OutFileRoot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VTK_tWidth); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VTK_fps); if (RegCheckErr(RF, RoutineName)) return + call FAST_UnpackVTK_SurfaceType(RF, OutData%VTK_surface) ! VTK_surface + call RegUnpack(RF, OutData%Tdesc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CalcSteady); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TrimCase); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TrimTol); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TrimGain); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Twr_Kdmp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Bld_Kdmp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NLinTimes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AzimDelta); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LinInputs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LinOutputs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LinOutJac); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LinOutMod); if (RegCheckErr(RF, RoutineName)) return + call FAST_UnpackVTK_ModeShapeType(RF, OutData%VTK_modes) ! VTK_modes + call RegUnpack(RF, OutData%UseSC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Lin_NumMods); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Lin_ModOrder); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LinInterpOrder); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CompAeroMaps); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%N_UJac); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumBl_Lin); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%tolerSquared); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumSSCases); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WindSpeedOrTSR); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RotSpeedInit); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%RotSpeed); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WS_TSR); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Pitch); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GearBox_index); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlCode, ErrStat, ErrMsg) + type(FAST_LinStateSave), intent(inout) :: SrcLinStateSaveData + type(FAST_LinStateSave), intent(inout) :: DstLinStateSaveData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_CopyLinStateSave' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcBeamDyn_DataData%x)) THEN - i1_l = LBOUND(SrcBeamDyn_DataData%x,1) - i1_u = UBOUND(SrcBeamDyn_DataData%x,1) - i2_l = LBOUND(SrcBeamDyn_DataData%x,2) - i2_u = UBOUND(SrcBeamDyn_DataData%x,2) - IF (.NOT. ALLOCATED(DstBeamDyn_DataData%x)) THEN - ALLOCATE(DstBeamDyn_DataData%x(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcBeamDyn_DataData%x,2), UBOUND(SrcBeamDyn_DataData%x,2) - DO i1 = LBOUND(SrcBeamDyn_DataData%x,1), UBOUND(SrcBeamDyn_DataData%x,1) - CALL BD_CopyContState( SrcBeamDyn_DataData%x(i1,i2), DstBeamDyn_DataData%x(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcBeamDyn_DataData%xd)) THEN - i1_l = LBOUND(SrcBeamDyn_DataData%xd,1) - i1_u = UBOUND(SrcBeamDyn_DataData%xd,1) - i2_l = LBOUND(SrcBeamDyn_DataData%xd,2) - i2_u = UBOUND(SrcBeamDyn_DataData%xd,2) - IF (.NOT. ALLOCATED(DstBeamDyn_DataData%xd)) THEN - ALLOCATE(DstBeamDyn_DataData%xd(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%xd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcBeamDyn_DataData%xd,2), UBOUND(SrcBeamDyn_DataData%xd,2) - DO i1 = LBOUND(SrcBeamDyn_DataData%xd,1), UBOUND(SrcBeamDyn_DataData%xd,1) - CALL BD_CopyDiscState( SrcBeamDyn_DataData%xd(i1,i2), DstBeamDyn_DataData%xd(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcBeamDyn_DataData%z)) THEN - i1_l = LBOUND(SrcBeamDyn_DataData%z,1) - i1_u = UBOUND(SrcBeamDyn_DataData%z,1) - i2_l = LBOUND(SrcBeamDyn_DataData%z,2) - i2_u = UBOUND(SrcBeamDyn_DataData%z,2) - IF (.NOT. ALLOCATED(DstBeamDyn_DataData%z)) THEN - ALLOCATE(DstBeamDyn_DataData%z(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%z.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcBeamDyn_DataData%z,2), UBOUND(SrcBeamDyn_DataData%z,2) - DO i1 = LBOUND(SrcBeamDyn_DataData%z,1), UBOUND(SrcBeamDyn_DataData%z,1) - CALL BD_CopyConstrState( SrcBeamDyn_DataData%z(i1,i2), DstBeamDyn_DataData%z(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcBeamDyn_DataData%OtherSt)) THEN - i1_l = LBOUND(SrcBeamDyn_DataData%OtherSt,1) - i1_u = UBOUND(SrcBeamDyn_DataData%OtherSt,1) - i2_l = LBOUND(SrcBeamDyn_DataData%OtherSt,2) - i2_u = UBOUND(SrcBeamDyn_DataData%OtherSt,2) - IF (.NOT. ALLOCATED(DstBeamDyn_DataData%OtherSt)) THEN - ALLOCATE(DstBeamDyn_DataData%OtherSt(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%OtherSt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcBeamDyn_DataData%OtherSt,2), UBOUND(SrcBeamDyn_DataData%OtherSt,2) - DO i1 = LBOUND(SrcBeamDyn_DataData%OtherSt,1), UBOUND(SrcBeamDyn_DataData%OtherSt,1) - CALL BD_CopyOtherState( SrcBeamDyn_DataData%OtherSt(i1,i2), DstBeamDyn_DataData%OtherSt(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcBeamDyn_DataData%p)) THEN - i1_l = LBOUND(SrcBeamDyn_DataData%p,1) - i1_u = UBOUND(SrcBeamDyn_DataData%p,1) - IF (.NOT. ALLOCATED(DstBeamDyn_DataData%p)) THEN - ALLOCATE(DstBeamDyn_DataData%p(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%p.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcBeamDyn_DataData%p,1), UBOUND(SrcBeamDyn_DataData%p,1) - CALL BD_CopyParam( SrcBeamDyn_DataData%p(i1), DstBeamDyn_DataData%p(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcBeamDyn_DataData%u)) THEN - i1_l = LBOUND(SrcBeamDyn_DataData%u,1) - i1_u = UBOUND(SrcBeamDyn_DataData%u,1) - IF (.NOT. ALLOCATED(DstBeamDyn_DataData%u)) THEN - ALLOCATE(DstBeamDyn_DataData%u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcBeamDyn_DataData%u,1), UBOUND(SrcBeamDyn_DataData%u,1) - CALL BD_CopyInput( SrcBeamDyn_DataData%u(i1), DstBeamDyn_DataData%u(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcBeamDyn_DataData%y)) THEN - i1_l = LBOUND(SrcBeamDyn_DataData%y,1) - i1_u = UBOUND(SrcBeamDyn_DataData%y,1) - IF (.NOT. ALLOCATED(DstBeamDyn_DataData%y)) THEN - ALLOCATE(DstBeamDyn_DataData%y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcBeamDyn_DataData%y,1), UBOUND(SrcBeamDyn_DataData%y,1) - CALL BD_CopyOutput( SrcBeamDyn_DataData%y(i1), DstBeamDyn_DataData%y(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcBeamDyn_DataData%m)) THEN - i1_l = LBOUND(SrcBeamDyn_DataData%m,1) - i1_u = UBOUND(SrcBeamDyn_DataData%m,1) - IF (.NOT. ALLOCATED(DstBeamDyn_DataData%m)) THEN - ALLOCATE(DstBeamDyn_DataData%m(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%m.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcBeamDyn_DataData%m,1), UBOUND(SrcBeamDyn_DataData%m,1) - CALL BD_CopyMisc( SrcBeamDyn_DataData%m(i1), DstBeamDyn_DataData%m(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcBeamDyn_DataData%Output)) THEN - i1_l = LBOUND(SrcBeamDyn_DataData%Output,1) - i1_u = UBOUND(SrcBeamDyn_DataData%Output,1) - i2_l = LBOUND(SrcBeamDyn_DataData%Output,2) - i2_u = UBOUND(SrcBeamDyn_DataData%Output,2) - IF (.NOT. ALLOCATED(DstBeamDyn_DataData%Output)) THEN - ALLOCATE(DstBeamDyn_DataData%Output(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%Output.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcBeamDyn_DataData%Output,2), UBOUND(SrcBeamDyn_DataData%Output,2) - DO i1 = LBOUND(SrcBeamDyn_DataData%Output,1), UBOUND(SrcBeamDyn_DataData%Output,1) - CALL BD_CopyOutput( SrcBeamDyn_DataData%Output(i1,i2), DstBeamDyn_DataData%Output(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcBeamDyn_DataData%y_interp)) THEN - i1_l = LBOUND(SrcBeamDyn_DataData%y_interp,1) - i1_u = UBOUND(SrcBeamDyn_DataData%y_interp,1) - IF (.NOT. ALLOCATED(DstBeamDyn_DataData%y_interp)) THEN - ALLOCATE(DstBeamDyn_DataData%y_interp(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%y_interp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcBeamDyn_DataData%y_interp,1), UBOUND(SrcBeamDyn_DataData%y_interp,1) - CALL BD_CopyOutput( SrcBeamDyn_DataData%y_interp(i1), DstBeamDyn_DataData%y_interp(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcBeamDyn_DataData%Input)) THEN - i1_l = LBOUND(SrcBeamDyn_DataData%Input,1) - i1_u = UBOUND(SrcBeamDyn_DataData%Input,1) - i2_l = LBOUND(SrcBeamDyn_DataData%Input,2) - i2_u = UBOUND(SrcBeamDyn_DataData%Input,2) - IF (.NOT. ALLOCATED(DstBeamDyn_DataData%Input)) THEN - ALLOCATE(DstBeamDyn_DataData%Input(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcBeamDyn_DataData%Input,2), UBOUND(SrcBeamDyn_DataData%Input,2) - DO i1 = LBOUND(SrcBeamDyn_DataData%Input,1), UBOUND(SrcBeamDyn_DataData%Input,1) - CALL BD_CopyInput( SrcBeamDyn_DataData%Input(i1,i2), DstBeamDyn_DataData%Input(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcBeamDyn_DataData%InputTimes)) THEN - i1_l = LBOUND(SrcBeamDyn_DataData%InputTimes,1) - i1_u = UBOUND(SrcBeamDyn_DataData%InputTimes,1) - i2_l = LBOUND(SrcBeamDyn_DataData%InputTimes,2) - i2_u = UBOUND(SrcBeamDyn_DataData%InputTimes,2) - IF (.NOT. ALLOCATED(DstBeamDyn_DataData%InputTimes)) THEN - ALLOCATE(DstBeamDyn_DataData%InputTimes(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeamDyn_DataData%InputTimes = SrcBeamDyn_DataData%InputTimes -ENDIF - END SUBROUTINE FAST_CopyBeamDyn_Data - - SUBROUTINE FAST_DestroyBeamDyn_Data( BeamDyn_DataData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(BeamDyn_Data), INTENT(INOUT) :: BeamDyn_DataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyBeamDyn_Data' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(BeamDyn_DataData%x)) THEN -DO i2 = LBOUND(BeamDyn_DataData%x,2), UBOUND(BeamDyn_DataData%x,2) -DO i1 = LBOUND(BeamDyn_DataData%x,1), UBOUND(BeamDyn_DataData%x,1) - CALL BD_DestroyContState( BeamDyn_DataData%x(i1,i2), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO - DEALLOCATE(BeamDyn_DataData%x) -ENDIF -IF (ALLOCATED(BeamDyn_DataData%xd)) THEN -DO i2 = LBOUND(BeamDyn_DataData%xd,2), UBOUND(BeamDyn_DataData%xd,2) -DO i1 = LBOUND(BeamDyn_DataData%xd,1), UBOUND(BeamDyn_DataData%xd,1) - CALL BD_DestroyDiscState( BeamDyn_DataData%xd(i1,i2), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO - DEALLOCATE(BeamDyn_DataData%xd) -ENDIF -IF (ALLOCATED(BeamDyn_DataData%z)) THEN -DO i2 = LBOUND(BeamDyn_DataData%z,2), UBOUND(BeamDyn_DataData%z,2) -DO i1 = LBOUND(BeamDyn_DataData%z,1), UBOUND(BeamDyn_DataData%z,1) - CALL BD_DestroyConstrState( BeamDyn_DataData%z(i1,i2), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO - DEALLOCATE(BeamDyn_DataData%z) -ENDIF -IF (ALLOCATED(BeamDyn_DataData%OtherSt)) THEN -DO i2 = LBOUND(BeamDyn_DataData%OtherSt,2), UBOUND(BeamDyn_DataData%OtherSt,2) -DO i1 = LBOUND(BeamDyn_DataData%OtherSt,1), UBOUND(BeamDyn_DataData%OtherSt,1) - CALL BD_DestroyOtherState( BeamDyn_DataData%OtherSt(i1,i2), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO - DEALLOCATE(BeamDyn_DataData%OtherSt) -ENDIF -IF (ALLOCATED(BeamDyn_DataData%p)) THEN -DO i1 = LBOUND(BeamDyn_DataData%p,1), UBOUND(BeamDyn_DataData%p,1) - CALL BD_DestroyParam( BeamDyn_DataData%p(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(BeamDyn_DataData%p) -ENDIF -IF (ALLOCATED(BeamDyn_DataData%u)) THEN -DO i1 = LBOUND(BeamDyn_DataData%u,1), UBOUND(BeamDyn_DataData%u,1) - CALL BD_DestroyInput( BeamDyn_DataData%u(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(BeamDyn_DataData%u) -ENDIF -IF (ALLOCATED(BeamDyn_DataData%y)) THEN -DO i1 = LBOUND(BeamDyn_DataData%y,1), UBOUND(BeamDyn_DataData%y,1) - CALL BD_DestroyOutput( BeamDyn_DataData%y(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(BeamDyn_DataData%y) -ENDIF -IF (ALLOCATED(BeamDyn_DataData%m)) THEN -DO i1 = LBOUND(BeamDyn_DataData%m,1), UBOUND(BeamDyn_DataData%m,1) - CALL BD_DestroyMisc( BeamDyn_DataData%m(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(BeamDyn_DataData%m) -ENDIF -IF (ALLOCATED(BeamDyn_DataData%Output)) THEN -DO i2 = LBOUND(BeamDyn_DataData%Output,2), UBOUND(BeamDyn_DataData%Output,2) -DO i1 = LBOUND(BeamDyn_DataData%Output,1), UBOUND(BeamDyn_DataData%Output,1) - CALL BD_DestroyOutput( BeamDyn_DataData%Output(i1,i2), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO - DEALLOCATE(BeamDyn_DataData%Output) -ENDIF -IF (ALLOCATED(BeamDyn_DataData%y_interp)) THEN -DO i1 = LBOUND(BeamDyn_DataData%y_interp,1), UBOUND(BeamDyn_DataData%y_interp,1) - CALL BD_DestroyOutput( BeamDyn_DataData%y_interp(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(BeamDyn_DataData%y_interp) -ENDIF -IF (ALLOCATED(BeamDyn_DataData%Input)) THEN -DO i2 = LBOUND(BeamDyn_DataData%Input,2), UBOUND(BeamDyn_DataData%Input,2) -DO i1 = LBOUND(BeamDyn_DataData%Input,1), UBOUND(BeamDyn_DataData%Input,1) - CALL BD_DestroyInput( BeamDyn_DataData%Input(i1,i2), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO - DEALLOCATE(BeamDyn_DataData%Input) -ENDIF -IF (ALLOCATED(BeamDyn_DataData%InputTimes)) THEN - DEALLOCATE(BeamDyn_DataData%InputTimes) -ENDIF - END SUBROUTINE FAST_DestroyBeamDyn_Data - - SUBROUTINE FAST_PackBeamDyn_Data( 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(BeamDyn_Data), 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 = 'FAST_PackBeamDyn_Data' - ! 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 ! x allocated yes/no - IF ( ALLOCATED(InData%x) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! x upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i2 = LBOUND(InData%x,2), UBOUND(InData%x,2) - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - Int_BufSz = Int_BufSz + 3 ! x: size of buffers for each call to pack subtype - CALL BD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! xd allocated yes/no - IF ( ALLOCATED(InData%xd) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! xd upper/lower bounds for each dimension - DO i2 = LBOUND(InData%xd,2), UBOUND(InData%xd,2) - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype - CALL BD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xd - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! z allocated yes/no - IF ( ALLOCATED(InData%z) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! z upper/lower bounds for each dimension - DO i2 = LBOUND(InData%z,2), UBOUND(InData%z,2) - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype - CALL BD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! z - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! z - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! z - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! OtherSt allocated yes/no - IF ( ALLOCATED(InData%OtherSt) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! OtherSt upper/lower bounds for each dimension - DO i2 = LBOUND(InData%OtherSt,2), UBOUND(InData%OtherSt,2) - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - Int_BufSz = Int_BufSz + 3 ! OtherSt: size of buffers for each call to pack subtype - CALL BD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! p allocated yes/no - IF ( ALLOCATED(InData%p) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! p upper/lower bounds for each dimension - DO i1 = LBOUND(InData%p,1), UBOUND(InData%p,1) - Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype - CALL BD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p(i1), ErrStat2, ErrMsg2, .TRUE. ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! p - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! p - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! p - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! u allocated yes/no - IF ( ALLOCATED(InData%u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! u upper/lower bounds for each dimension - DO i1 = LBOUND(InData%u,1), UBOUND(InData%u,1) - Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype - CALL BD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u(i1), ErrStat2, ErrMsg2, .TRUE. ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! y allocated yes/no - IF ( ALLOCATED(InData%y) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! y upper/lower bounds for each dimension - DO i1 = LBOUND(InData%y,1), UBOUND(InData%y,1) - Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype - CALL BD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y(i1), ErrStat2, ErrMsg2, .TRUE. ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! m allocated yes/no - IF ( ALLOCATED(InData%m) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! m upper/lower bounds for each dimension - DO i1 = LBOUND(InData%m,1), UBOUND(InData%m,1) - Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype - CALL BD_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m(i1), ErrStat2, ErrMsg2, .TRUE. ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! m - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! m - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! m - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! Output allocated yes/no - IF ( ALLOCATED(InData%Output) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Output upper/lower bounds for each dimension - DO i2 = LBOUND(InData%Output,2), UBOUND(InData%Output,2) - DO i1 = LBOUND(InData%Output,1), UBOUND(InData%Output,1) - Int_BufSz = Int_BufSz + 3 ! Output: size of buffers for each call to pack subtype - CALL BD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Output(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! Output - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Output - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Output - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Output - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! y_interp allocated yes/no - IF ( ALLOCATED(InData%y_interp) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! y_interp upper/lower bounds for each dimension - DO i1 = LBOUND(InData%y_interp,1), UBOUND(InData%y_interp,1) - Int_BufSz = Int_BufSz + 3 ! y_interp: size of buffers for each call to pack subtype - CALL BD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_interp(i1), ErrStat2, ErrMsg2, .TRUE. ) ! y_interp - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y_interp - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y_interp - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y_interp - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! Input allocated yes/no - IF ( ALLOCATED(InData%Input) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Input upper/lower bounds for each dimension - DO i2 = LBOUND(InData%Input,2), UBOUND(InData%Input,2) - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - Int_BufSz = Int_BufSz + 3 ! Input: size of buffers for each call to pack subtype - CALL BD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! Input - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Input - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Input - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Input - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! InputTimes allocated yes/no - IF ( ALLOCATED(InData%InputTimes) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! InputTimes upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes - 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%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%x,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%x,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%x,2), UBOUND(InData%x,2) - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - CALL BD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! x - 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 DO - END IF - IF ( .NOT. ALLOCATED(InData%xd) ) THEN - 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,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xd,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%xd,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xd,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%xd,2), UBOUND(InData%xd,2) - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - CALL BD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! xd - 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 DO - END IF - IF ( .NOT. ALLOCATED(InData%z) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%z,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%z,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%z,2), UBOUND(InData%z,2) - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - CALL BD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! z - 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 DO - END IF - IF ( .NOT. ALLOCATED(InData%OtherSt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OtherSt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OtherSt,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OtherSt,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OtherSt,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%OtherSt,2), UBOUND(InData%OtherSt,2) - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - CALL BD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt - 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 DO - END IF - IF ( .NOT. ALLOCATED(InData%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%p,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%p,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%p,1), UBOUND(InData%p,1) - CALL BD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p(i1), ErrStat2, ErrMsg2, OnlySize ) ! p - 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%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) - CALL BD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u(i1), ErrStat2, ErrMsg2, OnlySize ) ! u - 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%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%y,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%y,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%y,1), UBOUND(InData%y,1) - CALL BD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y(i1), ErrStat2, ErrMsg2, OnlySize ) ! y - 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%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 - - DO i1 = LBOUND(InData%m,1), UBOUND(InData%m,1) - CALL BD_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m(i1), ErrStat2, ErrMsg2, OnlySize ) ! m - 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%Output) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Output,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Output,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Output,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Output,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Output,2), UBOUND(InData%Output,2) - DO i1 = LBOUND(InData%Output,1), UBOUND(InData%Output,1) - CALL BD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Output(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! Output - 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 DO - END IF - IF ( .NOT. ALLOCATED(InData%y_interp) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%y_interp,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%y_interp,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%y_interp,1), UBOUND(InData%y_interp,1) - CALL BD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_interp(i1), ErrStat2, ErrMsg2, OnlySize ) ! y_interp - 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%Input) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Input,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Input,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Input,2), UBOUND(InData%Input,2) - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - CALL BD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! Input - 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 DO - END IF - IF ( .NOT. ALLOCATED(InData%InputTimes) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InputTimes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InputTimes,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%InputTimes,2), UBOUND(InData%InputTimes,2) - DO i1 = LBOUND(InData%InputTimes,1), UBOUND(InData%InputTimes,1) - DbKiBuf(Db_Xferred) = InData%InputTimes(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE FAST_PackBeamDyn_Data - - SUBROUTINE FAST_UnPackBeamDyn_Data( 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(BeamDyn_Data), 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 = 'FAST_UnPackBeamDyn_Data' - ! 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 ! 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%x)) DEALLOCATE(OutData%x) - ALLOCATE(OutData%x(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%x,2), UBOUND(OutData%x,2) - DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,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 BD_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x(i1,i2), ErrStat2, ErrMsg2 ) ! x - 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 DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! xd not allocated - Int_Xferred = Int_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%xd)) DEALLOCATE(OutData%xd) - ALLOCATE(OutData%xd(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%xd,2), UBOUND(OutData%xd,2) - DO i1 = LBOUND(OutData%xd,1), UBOUND(OutData%xd,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 BD_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1,i2), ErrStat2, ErrMsg2 ) ! xd - 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 DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! z not allocated - Int_Xferred = Int_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%z)) DEALLOCATE(OutData%z) - ALLOCATE(OutData%z(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%z.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%z,2), UBOUND(OutData%z,2) - DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,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 BD_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1,i2), ErrStat2, ErrMsg2 ) ! z - 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 DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OtherSt not allocated - Int_Xferred = Int_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%OtherSt)) DEALLOCATE(OutData%OtherSt) - ALLOCATE(OutData%OtherSt(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%OtherSt,2), UBOUND(OutData%OtherSt,2) - DO i1 = LBOUND(OutData%OtherSt,1), UBOUND(OutData%OtherSt,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 BD_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt(i1,i2), ErrStat2, ErrMsg2 ) ! OtherSt - 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 DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! 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 - IF (ALLOCATED(OutData%p)) DEALLOCATE(OutData%p) - ALLOCATE(OutData%p(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%p.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%p,1), UBOUND(OutData%p,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 BD_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p(i1), ErrStat2, ErrMsg2 ) ! p - 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 ! 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%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 - DO i1 = LBOUND(OutData%u,1), UBOUND(OutData%u,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 BD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u(i1), ErrStat2, ErrMsg2 ) ! u - 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 ! 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%y)) DEALLOCATE(OutData%y) - ALLOCATE(OutData%y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%y,1), UBOUND(OutData%y,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 BD_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y(i1), ErrStat2, ErrMsg2 ) ! y - 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 ! 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 - IF (ALLOCATED(OutData%m)) DEALLOCATE(OutData%m) - ALLOCATE(OutData%m(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%m.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%m,1), UBOUND(OutData%m,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 BD_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m(i1), ErrStat2, ErrMsg2 ) ! m - 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 ! Output not allocated - Int_Xferred = Int_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%Output)) DEALLOCATE(OutData%Output) - ALLOCATE(OutData%Output(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Output,2), UBOUND(OutData%Output,2) - DO i1 = LBOUND(OutData%Output,1), UBOUND(OutData%Output,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 BD_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%Output(i1,i2), ErrStat2, ErrMsg2 ) ! Output - 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 DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! y_interp not allocated - Int_Xferred = Int_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%y_interp)) DEALLOCATE(OutData%y_interp) - ALLOCATE(OutData%y_interp(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%y_interp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%y_interp,1), UBOUND(OutData%y_interp,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 BD_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y_interp(i1), ErrStat2, ErrMsg2 ) ! y_interp - 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 ! Input not allocated - Int_Xferred = Int_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%Input)) DEALLOCATE(OutData%Input) - ALLOCATE(OutData%Input(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Input,2), UBOUND(OutData%Input,2) - DO i1 = LBOUND(OutData%Input,1), UBOUND(OutData%Input,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 BD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input(i1,i2), ErrStat2, ErrMsg2 ) ! Input - 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 DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InputTimes not allocated - Int_Xferred = Int_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%InputTimes)) DEALLOCATE(OutData%InputTimes) - ALLOCATE(OutData%InputTimes(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%InputTimes,2), UBOUND(OutData%InputTimes,2) - DO i1 = LBOUND(OutData%InputTimes,1), UBOUND(OutData%InputTimes,1) - OutData%InputTimes(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE FAST_UnPackBeamDyn_Data - - SUBROUTINE FAST_CopyElastoDyn_Data( SrcElastoDyn_DataData, DstElastoDyn_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ElastoDyn_Data), INTENT(INOUT) :: SrcElastoDyn_DataData - TYPE(ElastoDyn_Data), INTENT(INOUT) :: DstElastoDyn_DataData - 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 = 'FAST_CopyElastoDyn_Data' -! + ErrMsg = '' + if (allocated(SrcLinStateSaveData%x_IceD)) then + LB(1:2) = lbound(SrcLinStateSaveData%x_IceD) + UB(1:2) = ubound(SrcLinStateSaveData%x_IceD) + if (.not. allocated(DstLinStateSaveData%x_IceD)) then + allocate(DstLinStateSaveData%x_IceD(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_IceD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_CopyContState(SrcLinStateSaveData%x_IceD(i1,i2), DstLinStateSaveData%x_IceD(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do + end if + if (allocated(SrcLinStateSaveData%xd_IceD)) then + LB(1:2) = lbound(SrcLinStateSaveData%xd_IceD) + UB(1:2) = ubound(SrcLinStateSaveData%xd_IceD) + if (.not. allocated(DstLinStateSaveData%xd_IceD)) then + allocate(DstLinStateSaveData%xd_IceD(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_IceD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_CopyDiscState(SrcLinStateSaveData%xd_IceD(i1,i2), DstLinStateSaveData%xd_IceD(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do + end if + if (allocated(SrcLinStateSaveData%z_IceD)) then + LB(1:2) = lbound(SrcLinStateSaveData%z_IceD) + UB(1:2) = ubound(SrcLinStateSaveData%z_IceD) + if (.not. allocated(DstLinStateSaveData%z_IceD)) then + allocate(DstLinStateSaveData%z_IceD(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_IceD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_CopyConstrState(SrcLinStateSaveData%z_IceD(i1,i2), DstLinStateSaveData%z_IceD(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do + end if + if (allocated(SrcLinStateSaveData%OtherSt_IceD)) then + LB(1:2) = lbound(SrcLinStateSaveData%OtherSt_IceD) + UB(1:2) = ubound(SrcLinStateSaveData%OtherSt_IceD) + if (.not. allocated(DstLinStateSaveData%OtherSt_IceD)) then + allocate(DstLinStateSaveData%OtherSt_IceD(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_IceD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_CopyOtherState(SrcLinStateSaveData%OtherSt_IceD(i1,i2), DstLinStateSaveData%OtherSt_IceD(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do + end if + if (allocated(SrcLinStateSaveData%u_IceD)) then + LB(1:2) = lbound(SrcLinStateSaveData%u_IceD) + UB(1:2) = ubound(SrcLinStateSaveData%u_IceD) + if (.not. allocated(DstLinStateSaveData%u_IceD)) then + allocate(DstLinStateSaveData%u_IceD(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_IceD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_CopyInput(SrcLinStateSaveData%u_IceD(i1,i2), DstLinStateSaveData%u_IceD(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do + end if + if (allocated(SrcLinStateSaveData%x_BD)) then + LB(1:2) = lbound(SrcLinStateSaveData%x_BD) + UB(1:2) = ubound(SrcLinStateSaveData%x_BD) + if (.not. allocated(DstLinStateSaveData%x_BD)) then + allocate(DstLinStateSaveData%x_BD(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_BD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_CopyContState(SrcLinStateSaveData%x_BD(i1,i2), DstLinStateSaveData%x_BD(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do + end if + if (allocated(SrcLinStateSaveData%xd_BD)) then + LB(1:2) = lbound(SrcLinStateSaveData%xd_BD) + UB(1:2) = ubound(SrcLinStateSaveData%xd_BD) + if (.not. allocated(DstLinStateSaveData%xd_BD)) then + allocate(DstLinStateSaveData%xd_BD(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_BD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_CopyDiscState(SrcLinStateSaveData%xd_BD(i1,i2), DstLinStateSaveData%xd_BD(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do + end if + if (allocated(SrcLinStateSaveData%z_BD)) then + LB(1:2) = lbound(SrcLinStateSaveData%z_BD) + UB(1:2) = ubound(SrcLinStateSaveData%z_BD) + if (.not. allocated(DstLinStateSaveData%z_BD)) then + allocate(DstLinStateSaveData%z_BD(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_BD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_CopyConstrState(SrcLinStateSaveData%z_BD(i1,i2), DstLinStateSaveData%z_BD(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do + end if + if (allocated(SrcLinStateSaveData%OtherSt_BD)) then + LB(1:2) = lbound(SrcLinStateSaveData%OtherSt_BD) + UB(1:2) = ubound(SrcLinStateSaveData%OtherSt_BD) + if (.not. allocated(DstLinStateSaveData%OtherSt_BD)) then + allocate(DstLinStateSaveData%OtherSt_BD(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_BD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_CopyOtherState(SrcLinStateSaveData%OtherSt_BD(i1,i2), DstLinStateSaveData%OtherSt_BD(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do + end if + if (allocated(SrcLinStateSaveData%u_BD)) then + LB(1:2) = lbound(SrcLinStateSaveData%u_BD) + UB(1:2) = ubound(SrcLinStateSaveData%u_BD) + if (.not. allocated(DstLinStateSaveData%u_BD)) then + allocate(DstLinStateSaveData%u_BD(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_BD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_CopyInput(SrcLinStateSaveData%u_BD(i1,i2), DstLinStateSaveData%u_BD(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do + end if + if (allocated(SrcLinStateSaveData%x_ED)) then + LB(1:1) = lbound(SrcLinStateSaveData%x_ED) + UB(1:1) = ubound(SrcLinStateSaveData%x_ED) + if (.not. allocated(DstLinStateSaveData%x_ED)) then + allocate(DstLinStateSaveData%x_ED(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_ED.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call ED_CopyContState(SrcLinStateSaveData%x_ED(i1), DstLinStateSaveData%x_ED(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcLinStateSaveData%xd_ED)) then + LB(1:1) = lbound(SrcLinStateSaveData%xd_ED) + UB(1:1) = ubound(SrcLinStateSaveData%xd_ED) + if (.not. allocated(DstLinStateSaveData%xd_ED)) then + allocate(DstLinStateSaveData%xd_ED(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_ED.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call ED_CopyDiscState(SrcLinStateSaveData%xd_ED(i1), DstLinStateSaveData%xd_ED(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcLinStateSaveData%z_ED)) then + LB(1:1) = lbound(SrcLinStateSaveData%z_ED) + UB(1:1) = ubound(SrcLinStateSaveData%z_ED) + if (.not. allocated(DstLinStateSaveData%z_ED)) then + allocate(DstLinStateSaveData%z_ED(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_ED.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call ED_CopyConstrState(SrcLinStateSaveData%z_ED(i1), DstLinStateSaveData%z_ED(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcLinStateSaveData%OtherSt_ED)) then + LB(1:1) = lbound(SrcLinStateSaveData%OtherSt_ED) + UB(1:1) = ubound(SrcLinStateSaveData%OtherSt_ED) + if (.not. allocated(DstLinStateSaveData%OtherSt_ED)) then + allocate(DstLinStateSaveData%OtherSt_ED(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_ED.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call ED_CopyOtherState(SrcLinStateSaveData%OtherSt_ED(i1), DstLinStateSaveData%OtherSt_ED(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcLinStateSaveData%u_ED)) then + LB(1:1) = lbound(SrcLinStateSaveData%u_ED) + UB(1:1) = ubound(SrcLinStateSaveData%u_ED) + if (.not. allocated(DstLinStateSaveData%u_ED)) then + allocate(DstLinStateSaveData%u_ED(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_ED.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call ED_CopyInput(SrcLinStateSaveData%u_ED(i1), DstLinStateSaveData%u_ED(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcLinStateSaveData%x_SrvD)) then + LB(1:1) = lbound(SrcLinStateSaveData%x_SrvD) + UB(1:1) = ubound(SrcLinStateSaveData%x_SrvD) + if (.not. allocated(DstLinStateSaveData%x_SrvD)) then + allocate(DstLinStateSaveData%x_SrvD(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_SrvD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call SrvD_CopyContState(SrcLinStateSaveData%x_SrvD(i1), DstLinStateSaveData%x_SrvD(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcLinStateSaveData%xd_SrvD)) then + LB(1:1) = lbound(SrcLinStateSaveData%xd_SrvD) + UB(1:1) = ubound(SrcLinStateSaveData%xd_SrvD) + if (.not. allocated(DstLinStateSaveData%xd_SrvD)) then + allocate(DstLinStateSaveData%xd_SrvD(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_SrvD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call SrvD_CopyDiscState(SrcLinStateSaveData%xd_SrvD(i1), DstLinStateSaveData%xd_SrvD(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcLinStateSaveData%z_SrvD)) then + LB(1:1) = lbound(SrcLinStateSaveData%z_SrvD) + UB(1:1) = ubound(SrcLinStateSaveData%z_SrvD) + if (.not. allocated(DstLinStateSaveData%z_SrvD)) then + allocate(DstLinStateSaveData%z_SrvD(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_SrvD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call SrvD_CopyConstrState(SrcLinStateSaveData%z_SrvD(i1), DstLinStateSaveData%z_SrvD(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcLinStateSaveData%OtherSt_SrvD)) then + LB(1:1) = lbound(SrcLinStateSaveData%OtherSt_SrvD) + UB(1:1) = ubound(SrcLinStateSaveData%OtherSt_SrvD) + if (.not. allocated(DstLinStateSaveData%OtherSt_SrvD)) then + allocate(DstLinStateSaveData%OtherSt_SrvD(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_SrvD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call SrvD_CopyOtherState(SrcLinStateSaveData%OtherSt_SrvD(i1), DstLinStateSaveData%OtherSt_SrvD(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcLinStateSaveData%u_SrvD)) then + LB(1:1) = lbound(SrcLinStateSaveData%u_SrvD) + UB(1:1) = ubound(SrcLinStateSaveData%u_SrvD) + if (.not. allocated(DstLinStateSaveData%u_SrvD)) then + allocate(DstLinStateSaveData%u_SrvD(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_SrvD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call SrvD_CopyInput(SrcLinStateSaveData%u_SrvD(i1), DstLinStateSaveData%u_SrvD(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcLinStateSaveData%x_AD)) then + LB(1:1) = lbound(SrcLinStateSaveData%x_AD) + UB(1:1) = ubound(SrcLinStateSaveData%x_AD) + if (.not. allocated(DstLinStateSaveData%x_AD)) then + allocate(DstLinStateSaveData%x_AD(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_AD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AD_CopyContState(SrcLinStateSaveData%x_AD(i1), DstLinStateSaveData%x_AD(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcLinStateSaveData%xd_AD)) then + LB(1:1) = lbound(SrcLinStateSaveData%xd_AD) + UB(1:1) = ubound(SrcLinStateSaveData%xd_AD) + if (.not. allocated(DstLinStateSaveData%xd_AD)) then + allocate(DstLinStateSaveData%xd_AD(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_AD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AD_CopyDiscState(SrcLinStateSaveData%xd_AD(i1), DstLinStateSaveData%xd_AD(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcLinStateSaveData%z_AD)) then + LB(1:1) = lbound(SrcLinStateSaveData%z_AD) + UB(1:1) = ubound(SrcLinStateSaveData%z_AD) + if (.not. allocated(DstLinStateSaveData%z_AD)) then + allocate(DstLinStateSaveData%z_AD(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_AD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AD_CopyConstrState(SrcLinStateSaveData%z_AD(i1), DstLinStateSaveData%z_AD(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcLinStateSaveData%OtherSt_AD)) then + LB(1:1) = lbound(SrcLinStateSaveData%OtherSt_AD) + UB(1:1) = ubound(SrcLinStateSaveData%OtherSt_AD) + if (.not. allocated(DstLinStateSaveData%OtherSt_AD)) then + allocate(DstLinStateSaveData%OtherSt_AD(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_AD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AD_CopyOtherState(SrcLinStateSaveData%OtherSt_AD(i1), DstLinStateSaveData%OtherSt_AD(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcLinStateSaveData%u_AD)) then + LB(1:1) = lbound(SrcLinStateSaveData%u_AD) + UB(1:1) = ubound(SrcLinStateSaveData%u_AD) + if (.not. allocated(DstLinStateSaveData%u_AD)) then + allocate(DstLinStateSaveData%u_AD(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_AD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AD_CopyInput(SrcLinStateSaveData%u_AD(i1), DstLinStateSaveData%u_AD(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcLinStateSaveData%x_IfW)) then + LB(1:1) = lbound(SrcLinStateSaveData%x_IfW) + UB(1:1) = ubound(SrcLinStateSaveData%x_IfW) + if (.not. allocated(DstLinStateSaveData%x_IfW)) then + allocate(DstLinStateSaveData%x_IfW(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_IfW.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call InflowWind_CopyContState(SrcLinStateSaveData%x_IfW(i1), DstLinStateSaveData%x_IfW(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcLinStateSaveData%xd_IfW)) then + LB(1:1) = lbound(SrcLinStateSaveData%xd_IfW) + UB(1:1) = ubound(SrcLinStateSaveData%xd_IfW) + if (.not. allocated(DstLinStateSaveData%xd_IfW)) then + allocate(DstLinStateSaveData%xd_IfW(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_IfW.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call InflowWind_CopyDiscState(SrcLinStateSaveData%xd_IfW(i1), DstLinStateSaveData%xd_IfW(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcLinStateSaveData%z_IfW)) then + LB(1:1) = lbound(SrcLinStateSaveData%z_IfW) + UB(1:1) = ubound(SrcLinStateSaveData%z_IfW) + if (.not. allocated(DstLinStateSaveData%z_IfW)) then + allocate(DstLinStateSaveData%z_IfW(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_IfW.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call InflowWind_CopyConstrState(SrcLinStateSaveData%z_IfW(i1), DstLinStateSaveData%z_IfW(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcLinStateSaveData%OtherSt_IfW)) then + LB(1:1) = lbound(SrcLinStateSaveData%OtherSt_IfW) + UB(1:1) = ubound(SrcLinStateSaveData%OtherSt_IfW) + if (.not. allocated(DstLinStateSaveData%OtherSt_IfW)) then + allocate(DstLinStateSaveData%OtherSt_IfW(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_IfW.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call InflowWind_CopyOtherState(SrcLinStateSaveData%OtherSt_IfW(i1), DstLinStateSaveData%OtherSt_IfW(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcLinStateSaveData%u_IfW)) then + LB(1:1) = lbound(SrcLinStateSaveData%u_IfW) + UB(1:1) = ubound(SrcLinStateSaveData%u_IfW) + if (.not. allocated(DstLinStateSaveData%u_IfW)) then + allocate(DstLinStateSaveData%u_IfW(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_IfW.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call InflowWind_CopyInput(SrcLinStateSaveData%u_IfW(i1), DstLinStateSaveData%u_IfW(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcLinStateSaveData%x_SD)) then + LB(1:1) = lbound(SrcLinStateSaveData%x_SD) + UB(1:1) = ubound(SrcLinStateSaveData%x_SD) + if (.not. allocated(DstLinStateSaveData%x_SD)) then + allocate(DstLinStateSaveData%x_SD(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_SD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call SD_CopyContState(SrcLinStateSaveData%x_SD(i1), DstLinStateSaveData%x_SD(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcLinStateSaveData%xd_SD)) then + LB(1:1) = lbound(SrcLinStateSaveData%xd_SD) + UB(1:1) = ubound(SrcLinStateSaveData%xd_SD) + if (.not. allocated(DstLinStateSaveData%xd_SD)) then + allocate(DstLinStateSaveData%xd_SD(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_SD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call SD_CopyDiscState(SrcLinStateSaveData%xd_SD(i1), DstLinStateSaveData%xd_SD(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcLinStateSaveData%z_SD)) then + LB(1:1) = lbound(SrcLinStateSaveData%z_SD) + UB(1:1) = ubound(SrcLinStateSaveData%z_SD) + if (.not. allocated(DstLinStateSaveData%z_SD)) then + allocate(DstLinStateSaveData%z_SD(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_SD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call SD_CopyConstrState(SrcLinStateSaveData%z_SD(i1), DstLinStateSaveData%z_SD(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcLinStateSaveData%OtherSt_SD)) then + LB(1:1) = lbound(SrcLinStateSaveData%OtherSt_SD) + UB(1:1) = ubound(SrcLinStateSaveData%OtherSt_SD) + if (.not. allocated(DstLinStateSaveData%OtherSt_SD)) then + allocate(DstLinStateSaveData%OtherSt_SD(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_SD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call SD_CopyOtherState(SrcLinStateSaveData%OtherSt_SD(i1), DstLinStateSaveData%OtherSt_SD(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcLinStateSaveData%u_SD)) then + LB(1:1) = lbound(SrcLinStateSaveData%u_SD) + UB(1:1) = ubound(SrcLinStateSaveData%u_SD) + if (.not. allocated(DstLinStateSaveData%u_SD)) then + allocate(DstLinStateSaveData%u_SD(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_SD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call SD_CopyInput(SrcLinStateSaveData%u_SD(i1), DstLinStateSaveData%u_SD(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcLinStateSaveData%x_ExtPtfm)) then + LB(1:1) = lbound(SrcLinStateSaveData%x_ExtPtfm) + UB(1:1) = ubound(SrcLinStateSaveData%x_ExtPtfm) + if (.not. allocated(DstLinStateSaveData%x_ExtPtfm)) then + allocate(DstLinStateSaveData%x_ExtPtfm(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_ExtPtfm.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call ExtPtfm_CopyContState(SrcLinStateSaveData%x_ExtPtfm(i1), DstLinStateSaveData%x_ExtPtfm(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcLinStateSaveData%xd_ExtPtfm)) then + LB(1:1) = lbound(SrcLinStateSaveData%xd_ExtPtfm) + UB(1:1) = ubound(SrcLinStateSaveData%xd_ExtPtfm) + if (.not. allocated(DstLinStateSaveData%xd_ExtPtfm)) then + allocate(DstLinStateSaveData%xd_ExtPtfm(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_ExtPtfm.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call ExtPtfm_CopyDiscState(SrcLinStateSaveData%xd_ExtPtfm(i1), DstLinStateSaveData%xd_ExtPtfm(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcLinStateSaveData%z_ExtPtfm)) then + LB(1:1) = lbound(SrcLinStateSaveData%z_ExtPtfm) + UB(1:1) = ubound(SrcLinStateSaveData%z_ExtPtfm) + if (.not. allocated(DstLinStateSaveData%z_ExtPtfm)) then + allocate(DstLinStateSaveData%z_ExtPtfm(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_ExtPtfm.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call ExtPtfm_CopyConstrState(SrcLinStateSaveData%z_ExtPtfm(i1), DstLinStateSaveData%z_ExtPtfm(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcLinStateSaveData%OtherSt_ExtPtfm)) then + LB(1:1) = lbound(SrcLinStateSaveData%OtherSt_ExtPtfm) + UB(1:1) = ubound(SrcLinStateSaveData%OtherSt_ExtPtfm) + if (.not. allocated(DstLinStateSaveData%OtherSt_ExtPtfm)) then + allocate(DstLinStateSaveData%OtherSt_ExtPtfm(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_ExtPtfm.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call ExtPtfm_CopyOtherState(SrcLinStateSaveData%OtherSt_ExtPtfm(i1), DstLinStateSaveData%OtherSt_ExtPtfm(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcLinStateSaveData%u_ExtPtfm)) then + LB(1:1) = lbound(SrcLinStateSaveData%u_ExtPtfm) + UB(1:1) = ubound(SrcLinStateSaveData%u_ExtPtfm) + if (.not. allocated(DstLinStateSaveData%u_ExtPtfm)) then + allocate(DstLinStateSaveData%u_ExtPtfm(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_ExtPtfm.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call ExtPtfm_CopyInput(SrcLinStateSaveData%u_ExtPtfm(i1), DstLinStateSaveData%u_ExtPtfm(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcLinStateSaveData%x_HD)) then + LB(1:1) = lbound(SrcLinStateSaveData%x_HD) + UB(1:1) = ubound(SrcLinStateSaveData%x_HD) + if (.not. allocated(DstLinStateSaveData%x_HD)) then + allocate(DstLinStateSaveData%x_HD(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_HD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call HydroDyn_CopyContState(SrcLinStateSaveData%x_HD(i1), DstLinStateSaveData%x_HD(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcLinStateSaveData%xd_HD)) then + LB(1:1) = lbound(SrcLinStateSaveData%xd_HD) + UB(1:1) = ubound(SrcLinStateSaveData%xd_HD) + if (.not. allocated(DstLinStateSaveData%xd_HD)) then + allocate(DstLinStateSaveData%xd_HD(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_HD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call HydroDyn_CopyDiscState(SrcLinStateSaveData%xd_HD(i1), DstLinStateSaveData%xd_HD(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcLinStateSaveData%z_HD)) then + LB(1:1) = lbound(SrcLinStateSaveData%z_HD) + UB(1:1) = ubound(SrcLinStateSaveData%z_HD) + if (.not. allocated(DstLinStateSaveData%z_HD)) then + allocate(DstLinStateSaveData%z_HD(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_HD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call HydroDyn_CopyConstrState(SrcLinStateSaveData%z_HD(i1), DstLinStateSaveData%z_HD(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcLinStateSaveData%OtherSt_HD)) then + LB(1:1) = lbound(SrcLinStateSaveData%OtherSt_HD) + UB(1:1) = ubound(SrcLinStateSaveData%OtherSt_HD) + if (.not. allocated(DstLinStateSaveData%OtherSt_HD)) then + allocate(DstLinStateSaveData%OtherSt_HD(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_HD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call HydroDyn_CopyOtherState(SrcLinStateSaveData%OtherSt_HD(i1), DstLinStateSaveData%OtherSt_HD(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcLinStateSaveData%u_HD)) then + LB(1:1) = lbound(SrcLinStateSaveData%u_HD) + UB(1:1) = ubound(SrcLinStateSaveData%u_HD) + if (.not. allocated(DstLinStateSaveData%u_HD)) then + allocate(DstLinStateSaveData%u_HD(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_HD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call HydroDyn_CopyInput(SrcLinStateSaveData%u_HD(i1), DstLinStateSaveData%u_HD(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcLinStateSaveData%x_SeaSt)) then + LB(1:1) = lbound(SrcLinStateSaveData%x_SeaSt) + UB(1:1) = ubound(SrcLinStateSaveData%x_SeaSt) + if (.not. allocated(DstLinStateSaveData%x_SeaSt)) then + allocate(DstLinStateSaveData%x_SeaSt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_SeaSt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call SeaSt_CopyContState(SrcLinStateSaveData%x_SeaSt(i1), DstLinStateSaveData%x_SeaSt(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcLinStateSaveData%xd_SeaSt)) then + LB(1:1) = lbound(SrcLinStateSaveData%xd_SeaSt) + UB(1:1) = ubound(SrcLinStateSaveData%xd_SeaSt) + if (.not. allocated(DstLinStateSaveData%xd_SeaSt)) then + allocate(DstLinStateSaveData%xd_SeaSt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_SeaSt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call SeaSt_CopyDiscState(SrcLinStateSaveData%xd_SeaSt(i1), DstLinStateSaveData%xd_SeaSt(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcLinStateSaveData%z_SeaSt)) then + LB(1:1) = lbound(SrcLinStateSaveData%z_SeaSt) + UB(1:1) = ubound(SrcLinStateSaveData%z_SeaSt) + if (.not. allocated(DstLinStateSaveData%z_SeaSt)) then + allocate(DstLinStateSaveData%z_SeaSt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_SeaSt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call SeaSt_CopyConstrState(SrcLinStateSaveData%z_SeaSt(i1), DstLinStateSaveData%z_SeaSt(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcLinStateSaveData%OtherSt_SeaSt)) then + LB(1:1) = lbound(SrcLinStateSaveData%OtherSt_SeaSt) + UB(1:1) = ubound(SrcLinStateSaveData%OtherSt_SeaSt) + if (.not. allocated(DstLinStateSaveData%OtherSt_SeaSt)) then + allocate(DstLinStateSaveData%OtherSt_SeaSt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_SeaSt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call SeaSt_CopyOtherState(SrcLinStateSaveData%OtherSt_SeaSt(i1), DstLinStateSaveData%OtherSt_SeaSt(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcLinStateSaveData%u_SeaSt)) then + LB(1:1) = lbound(SrcLinStateSaveData%u_SeaSt) + UB(1:1) = ubound(SrcLinStateSaveData%u_SeaSt) + if (.not. allocated(DstLinStateSaveData%u_SeaSt)) then + allocate(DstLinStateSaveData%u_SeaSt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_SeaSt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call SeaSt_CopyInput(SrcLinStateSaveData%u_SeaSt(i1), DstLinStateSaveData%u_SeaSt(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcLinStateSaveData%x_IceF)) then + LB(1:1) = lbound(SrcLinStateSaveData%x_IceF) + UB(1:1) = ubound(SrcLinStateSaveData%x_IceF) + if (.not. allocated(DstLinStateSaveData%x_IceF)) then + allocate(DstLinStateSaveData%x_IceF(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_IceF.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call IceFloe_CopyContState(SrcLinStateSaveData%x_IceF(i1), DstLinStateSaveData%x_IceF(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcLinStateSaveData%xd_IceF)) then + LB(1:1) = lbound(SrcLinStateSaveData%xd_IceF) + UB(1:1) = ubound(SrcLinStateSaveData%xd_IceF) + if (.not. allocated(DstLinStateSaveData%xd_IceF)) then + allocate(DstLinStateSaveData%xd_IceF(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_IceF.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call IceFloe_CopyDiscState(SrcLinStateSaveData%xd_IceF(i1), DstLinStateSaveData%xd_IceF(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcLinStateSaveData%z_IceF)) then + LB(1:1) = lbound(SrcLinStateSaveData%z_IceF) + UB(1:1) = ubound(SrcLinStateSaveData%z_IceF) + if (.not. allocated(DstLinStateSaveData%z_IceF)) then + allocate(DstLinStateSaveData%z_IceF(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_IceF.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call IceFloe_CopyConstrState(SrcLinStateSaveData%z_IceF(i1), DstLinStateSaveData%z_IceF(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcLinStateSaveData%OtherSt_IceF)) then + LB(1:1) = lbound(SrcLinStateSaveData%OtherSt_IceF) + UB(1:1) = ubound(SrcLinStateSaveData%OtherSt_IceF) + if (.not. allocated(DstLinStateSaveData%OtherSt_IceF)) then + allocate(DstLinStateSaveData%OtherSt_IceF(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_IceF.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call IceFloe_CopyOtherState(SrcLinStateSaveData%OtherSt_IceF(i1), DstLinStateSaveData%OtherSt_IceF(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcLinStateSaveData%u_IceF)) then + LB(1:1) = lbound(SrcLinStateSaveData%u_IceF) + UB(1:1) = ubound(SrcLinStateSaveData%u_IceF) + if (.not. allocated(DstLinStateSaveData%u_IceF)) then + allocate(DstLinStateSaveData%u_IceF(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_IceF.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call IceFloe_CopyInput(SrcLinStateSaveData%u_IceF(i1), DstLinStateSaveData%u_IceF(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcLinStateSaveData%x_MAP)) then + LB(1:1) = lbound(SrcLinStateSaveData%x_MAP) + UB(1:1) = ubound(SrcLinStateSaveData%x_MAP) + if (.not. allocated(DstLinStateSaveData%x_MAP)) then + allocate(DstLinStateSaveData%x_MAP(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_MAP.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MAP_CopyContState(SrcLinStateSaveData%x_MAP(i1), DstLinStateSaveData%x_MAP(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcLinStateSaveData%xd_MAP)) then + LB(1:1) = lbound(SrcLinStateSaveData%xd_MAP) + UB(1:1) = ubound(SrcLinStateSaveData%xd_MAP) + if (.not. allocated(DstLinStateSaveData%xd_MAP)) then + allocate(DstLinStateSaveData%xd_MAP(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_MAP.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MAP_CopyDiscState(SrcLinStateSaveData%xd_MAP(i1), DstLinStateSaveData%xd_MAP(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcLinStateSaveData%z_MAP)) then + LB(1:1) = lbound(SrcLinStateSaveData%z_MAP) + UB(1:1) = ubound(SrcLinStateSaveData%z_MAP) + if (.not. allocated(DstLinStateSaveData%z_MAP)) then + allocate(DstLinStateSaveData%z_MAP(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_MAP.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MAP_CopyConstrState(SrcLinStateSaveData%z_MAP(i1), DstLinStateSaveData%z_MAP(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcLinStateSaveData%u_MAP)) then + LB(1:1) = lbound(SrcLinStateSaveData%u_MAP) + UB(1:1) = ubound(SrcLinStateSaveData%u_MAP) + if (.not. allocated(DstLinStateSaveData%u_MAP)) then + allocate(DstLinStateSaveData%u_MAP(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_MAP.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MAP_CopyInput(SrcLinStateSaveData%u_MAP(i1), DstLinStateSaveData%u_MAP(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcLinStateSaveData%x_FEAM)) then + LB(1:1) = lbound(SrcLinStateSaveData%x_FEAM) + UB(1:1) = ubound(SrcLinStateSaveData%x_FEAM) + if (.not. allocated(DstLinStateSaveData%x_FEAM)) then + allocate(DstLinStateSaveData%x_FEAM(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_FEAM.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call FEAM_CopyContState(SrcLinStateSaveData%x_FEAM(i1), DstLinStateSaveData%x_FEAM(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcLinStateSaveData%xd_FEAM)) then + LB(1:1) = lbound(SrcLinStateSaveData%xd_FEAM) + UB(1:1) = ubound(SrcLinStateSaveData%xd_FEAM) + if (.not. allocated(DstLinStateSaveData%xd_FEAM)) then + allocate(DstLinStateSaveData%xd_FEAM(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_FEAM.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call FEAM_CopyDiscState(SrcLinStateSaveData%xd_FEAM(i1), DstLinStateSaveData%xd_FEAM(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcLinStateSaveData%z_FEAM)) then + LB(1:1) = lbound(SrcLinStateSaveData%z_FEAM) + UB(1:1) = ubound(SrcLinStateSaveData%z_FEAM) + if (.not. allocated(DstLinStateSaveData%z_FEAM)) then + allocate(DstLinStateSaveData%z_FEAM(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_FEAM.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call FEAM_CopyConstrState(SrcLinStateSaveData%z_FEAM(i1), DstLinStateSaveData%z_FEAM(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcLinStateSaveData%OtherSt_FEAM)) then + LB(1:1) = lbound(SrcLinStateSaveData%OtherSt_FEAM) + UB(1:1) = ubound(SrcLinStateSaveData%OtherSt_FEAM) + if (.not. allocated(DstLinStateSaveData%OtherSt_FEAM)) then + allocate(DstLinStateSaveData%OtherSt_FEAM(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_FEAM.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call FEAM_CopyOtherState(SrcLinStateSaveData%OtherSt_FEAM(i1), DstLinStateSaveData%OtherSt_FEAM(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcLinStateSaveData%u_FEAM)) then + LB(1:1) = lbound(SrcLinStateSaveData%u_FEAM) + UB(1:1) = ubound(SrcLinStateSaveData%u_FEAM) + if (.not. allocated(DstLinStateSaveData%u_FEAM)) then + allocate(DstLinStateSaveData%u_FEAM(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_FEAM.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call FEAM_CopyInput(SrcLinStateSaveData%u_FEAM(i1), DstLinStateSaveData%u_FEAM(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcLinStateSaveData%x_MD)) then + LB(1:1) = lbound(SrcLinStateSaveData%x_MD) + UB(1:1) = ubound(SrcLinStateSaveData%x_MD) + if (.not. allocated(DstLinStateSaveData%x_MD)) then + allocate(DstLinStateSaveData%x_MD(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_MD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MD_CopyContState(SrcLinStateSaveData%x_MD(i1), DstLinStateSaveData%x_MD(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcLinStateSaveData%xd_MD)) then + LB(1:1) = lbound(SrcLinStateSaveData%xd_MD) + UB(1:1) = ubound(SrcLinStateSaveData%xd_MD) + if (.not. allocated(DstLinStateSaveData%xd_MD)) then + allocate(DstLinStateSaveData%xd_MD(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_MD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MD_CopyDiscState(SrcLinStateSaveData%xd_MD(i1), DstLinStateSaveData%xd_MD(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcLinStateSaveData%z_MD)) then + LB(1:1) = lbound(SrcLinStateSaveData%z_MD) + UB(1:1) = ubound(SrcLinStateSaveData%z_MD) + if (.not. allocated(DstLinStateSaveData%z_MD)) then + allocate(DstLinStateSaveData%z_MD(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_MD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MD_CopyConstrState(SrcLinStateSaveData%z_MD(i1), DstLinStateSaveData%z_MD(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcLinStateSaveData%OtherSt_MD)) then + LB(1:1) = lbound(SrcLinStateSaveData%OtherSt_MD) + UB(1:1) = ubound(SrcLinStateSaveData%OtherSt_MD) + if (.not. allocated(DstLinStateSaveData%OtherSt_MD)) then + allocate(DstLinStateSaveData%OtherSt_MD(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_MD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MD_CopyOtherState(SrcLinStateSaveData%OtherSt_MD(i1), DstLinStateSaveData%OtherSt_MD(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcLinStateSaveData%u_MD)) then + LB(1:1) = lbound(SrcLinStateSaveData%u_MD) + UB(1:1) = ubound(SrcLinStateSaveData%u_MD) + if (.not. allocated(DstLinStateSaveData%u_MD)) then + allocate(DstLinStateSaveData%u_MD(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_MD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MD_CopyInput(SrcLinStateSaveData%u_MD(i1), DstLinStateSaveData%u_MD(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if +end subroutine + +subroutine FAST_DestroyLinStateSave(LinStateSaveData, ErrStat, ErrMsg) + type(FAST_LinStateSave), intent(inout) :: LinStateSaveData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_DestroyLinStateSave' ErrStat = ErrID_None - ErrMsg = "" - DO i1 = LBOUND(SrcElastoDyn_DataData%x,1), UBOUND(SrcElastoDyn_DataData%x,1) - CALL ED_CopyContState( SrcElastoDyn_DataData%x(i1), DstElastoDyn_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcElastoDyn_DataData%xd,1), UBOUND(SrcElastoDyn_DataData%xd,1) - CALL ED_CopyDiscState( SrcElastoDyn_DataData%xd(i1), DstElastoDyn_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcElastoDyn_DataData%z,1), UBOUND(SrcElastoDyn_DataData%z,1) - CALL ED_CopyConstrState( SrcElastoDyn_DataData%z(i1), DstElastoDyn_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcElastoDyn_DataData%OtherSt,1), UBOUND(SrcElastoDyn_DataData%OtherSt,1) - CALL ED_CopyOtherState( SrcElastoDyn_DataData%OtherSt(i1), DstElastoDyn_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - CALL ED_CopyParam( SrcElastoDyn_DataData%p, DstElastoDyn_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL ED_CopyInput( SrcElastoDyn_DataData%u, DstElastoDyn_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL ED_CopyOutput( SrcElastoDyn_DataData%y, DstElastoDyn_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL ED_CopyMisc( SrcElastoDyn_DataData%m, DstElastoDyn_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcElastoDyn_DataData%Output)) THEN - i1_l = LBOUND(SrcElastoDyn_DataData%Output,1) - i1_u = UBOUND(SrcElastoDyn_DataData%Output,1) - IF (.NOT. ALLOCATED(DstElastoDyn_DataData%Output)) THEN - ALLOCATE(DstElastoDyn_DataData%Output(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElastoDyn_DataData%Output.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcElastoDyn_DataData%Output,1), UBOUND(SrcElastoDyn_DataData%Output,1) - CALL ED_CopyOutput( SrcElastoDyn_DataData%Output(i1), DstElastoDyn_DataData%Output(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL ED_CopyOutput( SrcElastoDyn_DataData%y_interp, DstElastoDyn_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcElastoDyn_DataData%Input)) THEN - i1_l = LBOUND(SrcElastoDyn_DataData%Input,1) - i1_u = UBOUND(SrcElastoDyn_DataData%Input,1) - IF (.NOT. ALLOCATED(DstElastoDyn_DataData%Input)) THEN - ALLOCATE(DstElastoDyn_DataData%Input(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElastoDyn_DataData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcElastoDyn_DataData%Input,1), UBOUND(SrcElastoDyn_DataData%Input,1) - CALL ED_CopyInput( SrcElastoDyn_DataData%Input(i1), DstElastoDyn_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcElastoDyn_DataData%InputTimes)) THEN - i1_l = LBOUND(SrcElastoDyn_DataData%InputTimes,1) - i1_u = UBOUND(SrcElastoDyn_DataData%InputTimes,1) - IF (.NOT. ALLOCATED(DstElastoDyn_DataData%InputTimes)) THEN - ALLOCATE(DstElastoDyn_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElastoDyn_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstElastoDyn_DataData%InputTimes = SrcElastoDyn_DataData%InputTimes -ENDIF - END SUBROUTINE FAST_CopyElastoDyn_Data - - SUBROUTINE FAST_DestroyElastoDyn_Data( ElastoDyn_DataData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(ElastoDyn_Data), INTENT(INOUT) :: ElastoDyn_DataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyElastoDyn_Data' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -DO i1 = LBOUND(ElastoDyn_DataData%x,1), UBOUND(ElastoDyn_DataData%x,1) - CALL ED_DestroyContState( ElastoDyn_DataData%x(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(ElastoDyn_DataData%xd,1), UBOUND(ElastoDyn_DataData%xd,1) - CALL ED_DestroyDiscState( ElastoDyn_DataData%xd(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(ElastoDyn_DataData%z,1), UBOUND(ElastoDyn_DataData%z,1) - CALL ED_DestroyConstrState( ElastoDyn_DataData%z(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(ElastoDyn_DataData%OtherSt,1), UBOUND(ElastoDyn_DataData%OtherSt,1) - CALL ED_DestroyOtherState( ElastoDyn_DataData%OtherSt(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - CALL ED_DestroyParam( ElastoDyn_DataData%p, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL ED_DestroyInput( ElastoDyn_DataData%u, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL ED_DestroyOutput( ElastoDyn_DataData%y, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL ED_DestroyMisc( ElastoDyn_DataData%m, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(ElastoDyn_DataData%Output)) THEN -DO i1 = LBOUND(ElastoDyn_DataData%Output,1), UBOUND(ElastoDyn_DataData%Output,1) - CALL ED_DestroyOutput( ElastoDyn_DataData%Output(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ElastoDyn_DataData%Output) -ENDIF - CALL ED_DestroyOutput( ElastoDyn_DataData%y_interp, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(ElastoDyn_DataData%Input)) THEN -DO i1 = LBOUND(ElastoDyn_DataData%Input,1), UBOUND(ElastoDyn_DataData%Input,1) - CALL ED_DestroyInput( ElastoDyn_DataData%Input(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ElastoDyn_DataData%Input) -ENDIF -IF (ALLOCATED(ElastoDyn_DataData%InputTimes)) THEN - DEALLOCATE(ElastoDyn_DataData%InputTimes) -ENDIF - END SUBROUTINE FAST_DestroyElastoDyn_Data - - SUBROUTINE FAST_PackElastoDyn_Data( 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(ElastoDyn_Data), 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 = 'FAST_PackElastoDyn_Data' - ! 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) - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - Int_BufSz = Int_BufSz + 3 ! x: size of buffers for each call to pack subtype - CALL ED_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype - CALL ED_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xd - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype - CALL ED_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! z - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! z - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! z - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - Int_BufSz = Int_BufSz + 3 ! OtherSt: size of buffers for each call to pack subtype - CALL ED_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype - CALL ED_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! p - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! p - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! p - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype - CALL ED_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype - CALL ED_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype - CALL ED_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! m - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! m - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! m - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! Output allocated yes/no - IF ( ALLOCATED(InData%Output) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Output upper/lower bounds for each dimension - DO i1 = LBOUND(InData%Output,1), UBOUND(InData%Output,1) - Int_BufSz = Int_BufSz + 3 ! Output: size of buffers for each call to pack subtype - CALL ED_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Output(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Output - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Output - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Output - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Output - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! y_interp: size of buffers for each call to pack subtype - CALL ED_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_interp, ErrStat2, ErrMsg2, .TRUE. ) ! y_interp - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y_interp - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y_interp - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y_interp - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! Input allocated yes/no - IF ( ALLOCATED(InData%Input) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Input upper/lower bounds for each dimension - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - Int_BufSz = Int_BufSz + 3 ! Input: size of buffers for each call to pack subtype - CALL ED_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Input - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Input - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Input - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! InputTimes allocated yes/no - IF ( ALLOCATED(InData%InputTimes) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! InputTimes upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes - 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 i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - CALL ED_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, OnlySize ) ! x - 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 - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - CALL ED_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd - 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 - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - CALL ED_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, OnlySize ) ! z - 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 - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - CALL ED_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt - 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 - CALL ED_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! p - 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 ED_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u - 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 ED_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y - 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 ED_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! m - 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%Output) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Output,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Output,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Output,1), UBOUND(InData%Output,1) - CALL ED_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Output(i1), ErrStat2, ErrMsg2, OnlySize ) ! Output - 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 - CALL ED_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_interp, ErrStat2, ErrMsg2, OnlySize ) ! y_interp - 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%Input) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Input,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - CALL ED_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input - 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%InputTimes) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InputTimes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%InputTimes,1), UBOUND(InData%InputTimes,1) - DbKiBuf(Db_Xferred) = InData%InputTimes(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE FAST_PackElastoDyn_Data - - SUBROUTINE FAST_UnPackElastoDyn_Data( 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(ElastoDyn_Data), 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 = 'FAST_UnPackElastoDyn_Data' - ! 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%x,1) - i1_u = UBOUND(OutData%x,1) - DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,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 ED_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x(i1), ErrStat2, ErrMsg2 ) ! x - 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 - i1_l = LBOUND(OutData%xd,1) - i1_u = UBOUND(OutData%xd,1) - DO i1 = LBOUND(OutData%xd,1), UBOUND(OutData%xd,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 ED_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1), ErrStat2, ErrMsg2 ) ! xd - 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 - i1_l = LBOUND(OutData%z,1) - i1_u = UBOUND(OutData%z,1) - DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,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 ED_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1), ErrStat2, ErrMsg2 ) ! z - 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 - i1_l = LBOUND(OutData%OtherSt,1) - i1_u = UBOUND(OutData%OtherSt,1) - DO i1 = LBOUND(OutData%OtherSt,1), UBOUND(OutData%OtherSt,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 ED_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt(i1), ErrStat2, ErrMsg2 ) ! OtherSt - 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 - 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 ED_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p - 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 ED_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u - 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 ED_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y - 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 ED_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! m - 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 ! Output not allocated - Int_Xferred = Int_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%Output)) DEALLOCATE(OutData%Output) - ALLOCATE(OutData%Output(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Output,1), UBOUND(OutData%Output,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 ED_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%Output(i1), ErrStat2, ErrMsg2 ) ! Output - 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 - 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 ED_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y_interp, ErrStat2, ErrMsg2 ) ! y_interp - 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 ! Input not allocated - Int_Xferred = Int_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%Input)) DEALLOCATE(OutData%Input) - ALLOCATE(OutData%Input(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Input,1), UBOUND(OutData%Input,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 ED_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input(i1), ErrStat2, ErrMsg2 ) ! Input - 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 ! InputTimes not allocated - Int_Xferred = Int_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%InputTimes)) DEALLOCATE(OutData%InputTimes) - ALLOCATE(OutData%InputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%InputTimes,1), UBOUND(OutData%InputTimes,1) - OutData%InputTimes(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE FAST_UnPackElastoDyn_Data - - SUBROUTINE FAST_CopyServoDyn_Data( SrcServoDyn_DataData, DstServoDyn_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ServoDyn_Data), INTENT(INOUT) :: SrcServoDyn_DataData - TYPE(ServoDyn_Data), INTENT(INOUT) :: DstServoDyn_DataData - 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 = 'FAST_CopyServoDyn_Data' -! + ErrMsg = '' + if (allocated(LinStateSaveData%x_IceD)) then + LB(1:2) = lbound(LinStateSaveData%x_IceD) + UB(1:2) = ubound(LinStateSaveData%x_IceD) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_DestroyContState(LinStateSaveData%x_IceD(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + deallocate(LinStateSaveData%x_IceD) + end if + if (allocated(LinStateSaveData%xd_IceD)) then + LB(1:2) = lbound(LinStateSaveData%xd_IceD) + UB(1:2) = ubound(LinStateSaveData%xd_IceD) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_DestroyDiscState(LinStateSaveData%xd_IceD(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + deallocate(LinStateSaveData%xd_IceD) + end if + if (allocated(LinStateSaveData%z_IceD)) then + LB(1:2) = lbound(LinStateSaveData%z_IceD) + UB(1:2) = ubound(LinStateSaveData%z_IceD) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_DestroyConstrState(LinStateSaveData%z_IceD(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + deallocate(LinStateSaveData%z_IceD) + end if + if (allocated(LinStateSaveData%OtherSt_IceD)) then + LB(1:2) = lbound(LinStateSaveData%OtherSt_IceD) + UB(1:2) = ubound(LinStateSaveData%OtherSt_IceD) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_DestroyOtherState(LinStateSaveData%OtherSt_IceD(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + deallocate(LinStateSaveData%OtherSt_IceD) + end if + if (allocated(LinStateSaveData%u_IceD)) then + LB(1:2) = lbound(LinStateSaveData%u_IceD) + UB(1:2) = ubound(LinStateSaveData%u_IceD) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_DestroyInput(LinStateSaveData%u_IceD(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + deallocate(LinStateSaveData%u_IceD) + end if + if (allocated(LinStateSaveData%x_BD)) then + LB(1:2) = lbound(LinStateSaveData%x_BD) + UB(1:2) = ubound(LinStateSaveData%x_BD) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_DestroyContState(LinStateSaveData%x_BD(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + deallocate(LinStateSaveData%x_BD) + end if + if (allocated(LinStateSaveData%xd_BD)) then + LB(1:2) = lbound(LinStateSaveData%xd_BD) + UB(1:2) = ubound(LinStateSaveData%xd_BD) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_DestroyDiscState(LinStateSaveData%xd_BD(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + deallocate(LinStateSaveData%xd_BD) + end if + if (allocated(LinStateSaveData%z_BD)) then + LB(1:2) = lbound(LinStateSaveData%z_BD) + UB(1:2) = ubound(LinStateSaveData%z_BD) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_DestroyConstrState(LinStateSaveData%z_BD(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + deallocate(LinStateSaveData%z_BD) + end if + if (allocated(LinStateSaveData%OtherSt_BD)) then + LB(1:2) = lbound(LinStateSaveData%OtherSt_BD) + UB(1:2) = ubound(LinStateSaveData%OtherSt_BD) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_DestroyOtherState(LinStateSaveData%OtherSt_BD(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + deallocate(LinStateSaveData%OtherSt_BD) + end if + if (allocated(LinStateSaveData%u_BD)) then + LB(1:2) = lbound(LinStateSaveData%u_BD) + UB(1:2) = ubound(LinStateSaveData%u_BD) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_DestroyInput(LinStateSaveData%u_BD(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + deallocate(LinStateSaveData%u_BD) + end if + if (allocated(LinStateSaveData%x_ED)) then + LB(1:1) = lbound(LinStateSaveData%x_ED) + UB(1:1) = ubound(LinStateSaveData%x_ED) + do i1 = LB(1), UB(1) + call ED_DestroyContState(LinStateSaveData%x_ED(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(LinStateSaveData%x_ED) + end if + if (allocated(LinStateSaveData%xd_ED)) then + LB(1:1) = lbound(LinStateSaveData%xd_ED) + UB(1:1) = ubound(LinStateSaveData%xd_ED) + do i1 = LB(1), UB(1) + call ED_DestroyDiscState(LinStateSaveData%xd_ED(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(LinStateSaveData%xd_ED) + end if + if (allocated(LinStateSaveData%z_ED)) then + LB(1:1) = lbound(LinStateSaveData%z_ED) + UB(1:1) = ubound(LinStateSaveData%z_ED) + do i1 = LB(1), UB(1) + call ED_DestroyConstrState(LinStateSaveData%z_ED(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(LinStateSaveData%z_ED) + end if + if (allocated(LinStateSaveData%OtherSt_ED)) then + LB(1:1) = lbound(LinStateSaveData%OtherSt_ED) + UB(1:1) = ubound(LinStateSaveData%OtherSt_ED) + do i1 = LB(1), UB(1) + call ED_DestroyOtherState(LinStateSaveData%OtherSt_ED(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(LinStateSaveData%OtherSt_ED) + end if + if (allocated(LinStateSaveData%u_ED)) then + LB(1:1) = lbound(LinStateSaveData%u_ED) + UB(1:1) = ubound(LinStateSaveData%u_ED) + do i1 = LB(1), UB(1) + call ED_DestroyInput(LinStateSaveData%u_ED(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(LinStateSaveData%u_ED) + end if + if (allocated(LinStateSaveData%x_SrvD)) then + LB(1:1) = lbound(LinStateSaveData%x_SrvD) + UB(1:1) = ubound(LinStateSaveData%x_SrvD) + do i1 = LB(1), UB(1) + call SrvD_DestroyContState(LinStateSaveData%x_SrvD(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(LinStateSaveData%x_SrvD) + end if + if (allocated(LinStateSaveData%xd_SrvD)) then + LB(1:1) = lbound(LinStateSaveData%xd_SrvD) + UB(1:1) = ubound(LinStateSaveData%xd_SrvD) + do i1 = LB(1), UB(1) + call SrvD_DestroyDiscState(LinStateSaveData%xd_SrvD(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(LinStateSaveData%xd_SrvD) + end if + if (allocated(LinStateSaveData%z_SrvD)) then + LB(1:1) = lbound(LinStateSaveData%z_SrvD) + UB(1:1) = ubound(LinStateSaveData%z_SrvD) + do i1 = LB(1), UB(1) + call SrvD_DestroyConstrState(LinStateSaveData%z_SrvD(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(LinStateSaveData%z_SrvD) + end if + if (allocated(LinStateSaveData%OtherSt_SrvD)) then + LB(1:1) = lbound(LinStateSaveData%OtherSt_SrvD) + UB(1:1) = ubound(LinStateSaveData%OtherSt_SrvD) + do i1 = LB(1), UB(1) + call SrvD_DestroyOtherState(LinStateSaveData%OtherSt_SrvD(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(LinStateSaveData%OtherSt_SrvD) + end if + if (allocated(LinStateSaveData%u_SrvD)) then + LB(1:1) = lbound(LinStateSaveData%u_SrvD) + UB(1:1) = ubound(LinStateSaveData%u_SrvD) + do i1 = LB(1), UB(1) + call SrvD_DestroyInput(LinStateSaveData%u_SrvD(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(LinStateSaveData%u_SrvD) + end if + if (allocated(LinStateSaveData%x_AD)) then + LB(1:1) = lbound(LinStateSaveData%x_AD) + UB(1:1) = ubound(LinStateSaveData%x_AD) + do i1 = LB(1), UB(1) + call AD_DestroyContState(LinStateSaveData%x_AD(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(LinStateSaveData%x_AD) + end if + if (allocated(LinStateSaveData%xd_AD)) then + LB(1:1) = lbound(LinStateSaveData%xd_AD) + UB(1:1) = ubound(LinStateSaveData%xd_AD) + do i1 = LB(1), UB(1) + call AD_DestroyDiscState(LinStateSaveData%xd_AD(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(LinStateSaveData%xd_AD) + end if + if (allocated(LinStateSaveData%z_AD)) then + LB(1:1) = lbound(LinStateSaveData%z_AD) + UB(1:1) = ubound(LinStateSaveData%z_AD) + do i1 = LB(1), UB(1) + call AD_DestroyConstrState(LinStateSaveData%z_AD(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(LinStateSaveData%z_AD) + end if + if (allocated(LinStateSaveData%OtherSt_AD)) then + LB(1:1) = lbound(LinStateSaveData%OtherSt_AD) + UB(1:1) = ubound(LinStateSaveData%OtherSt_AD) + do i1 = LB(1), UB(1) + call AD_DestroyOtherState(LinStateSaveData%OtherSt_AD(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(LinStateSaveData%OtherSt_AD) + end if + if (allocated(LinStateSaveData%u_AD)) then + LB(1:1) = lbound(LinStateSaveData%u_AD) + UB(1:1) = ubound(LinStateSaveData%u_AD) + do i1 = LB(1), UB(1) + call AD_DestroyInput(LinStateSaveData%u_AD(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(LinStateSaveData%u_AD) + end if + if (allocated(LinStateSaveData%x_IfW)) then + LB(1:1) = lbound(LinStateSaveData%x_IfW) + UB(1:1) = ubound(LinStateSaveData%x_IfW) + do i1 = LB(1), UB(1) + call InflowWind_DestroyContState(LinStateSaveData%x_IfW(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(LinStateSaveData%x_IfW) + end if + if (allocated(LinStateSaveData%xd_IfW)) then + LB(1:1) = lbound(LinStateSaveData%xd_IfW) + UB(1:1) = ubound(LinStateSaveData%xd_IfW) + do i1 = LB(1), UB(1) + call InflowWind_DestroyDiscState(LinStateSaveData%xd_IfW(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(LinStateSaveData%xd_IfW) + end if + if (allocated(LinStateSaveData%z_IfW)) then + LB(1:1) = lbound(LinStateSaveData%z_IfW) + UB(1:1) = ubound(LinStateSaveData%z_IfW) + do i1 = LB(1), UB(1) + call InflowWind_DestroyConstrState(LinStateSaveData%z_IfW(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(LinStateSaveData%z_IfW) + end if + if (allocated(LinStateSaveData%OtherSt_IfW)) then + LB(1:1) = lbound(LinStateSaveData%OtherSt_IfW) + UB(1:1) = ubound(LinStateSaveData%OtherSt_IfW) + do i1 = LB(1), UB(1) + call InflowWind_DestroyOtherState(LinStateSaveData%OtherSt_IfW(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(LinStateSaveData%OtherSt_IfW) + end if + if (allocated(LinStateSaveData%u_IfW)) then + LB(1:1) = lbound(LinStateSaveData%u_IfW) + UB(1:1) = ubound(LinStateSaveData%u_IfW) + do i1 = LB(1), UB(1) + call InflowWind_DestroyInput(LinStateSaveData%u_IfW(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(LinStateSaveData%u_IfW) + end if + if (allocated(LinStateSaveData%x_SD)) then + LB(1:1) = lbound(LinStateSaveData%x_SD) + UB(1:1) = ubound(LinStateSaveData%x_SD) + do i1 = LB(1), UB(1) + call SD_DestroyContState(LinStateSaveData%x_SD(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(LinStateSaveData%x_SD) + end if + if (allocated(LinStateSaveData%xd_SD)) then + LB(1:1) = lbound(LinStateSaveData%xd_SD) + UB(1:1) = ubound(LinStateSaveData%xd_SD) + do i1 = LB(1), UB(1) + call SD_DestroyDiscState(LinStateSaveData%xd_SD(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(LinStateSaveData%xd_SD) + end if + if (allocated(LinStateSaveData%z_SD)) then + LB(1:1) = lbound(LinStateSaveData%z_SD) + UB(1:1) = ubound(LinStateSaveData%z_SD) + do i1 = LB(1), UB(1) + call SD_DestroyConstrState(LinStateSaveData%z_SD(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(LinStateSaveData%z_SD) + end if + if (allocated(LinStateSaveData%OtherSt_SD)) then + LB(1:1) = lbound(LinStateSaveData%OtherSt_SD) + UB(1:1) = ubound(LinStateSaveData%OtherSt_SD) + do i1 = LB(1), UB(1) + call SD_DestroyOtherState(LinStateSaveData%OtherSt_SD(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(LinStateSaveData%OtherSt_SD) + end if + if (allocated(LinStateSaveData%u_SD)) then + LB(1:1) = lbound(LinStateSaveData%u_SD) + UB(1:1) = ubound(LinStateSaveData%u_SD) + do i1 = LB(1), UB(1) + call SD_DestroyInput(LinStateSaveData%u_SD(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(LinStateSaveData%u_SD) + end if + if (allocated(LinStateSaveData%x_ExtPtfm)) then + LB(1:1) = lbound(LinStateSaveData%x_ExtPtfm) + UB(1:1) = ubound(LinStateSaveData%x_ExtPtfm) + do i1 = LB(1), UB(1) + call ExtPtfm_DestroyContState(LinStateSaveData%x_ExtPtfm(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(LinStateSaveData%x_ExtPtfm) + end if + if (allocated(LinStateSaveData%xd_ExtPtfm)) then + LB(1:1) = lbound(LinStateSaveData%xd_ExtPtfm) + UB(1:1) = ubound(LinStateSaveData%xd_ExtPtfm) + do i1 = LB(1), UB(1) + call ExtPtfm_DestroyDiscState(LinStateSaveData%xd_ExtPtfm(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(LinStateSaveData%xd_ExtPtfm) + end if + if (allocated(LinStateSaveData%z_ExtPtfm)) then + LB(1:1) = lbound(LinStateSaveData%z_ExtPtfm) + UB(1:1) = ubound(LinStateSaveData%z_ExtPtfm) + do i1 = LB(1), UB(1) + call ExtPtfm_DestroyConstrState(LinStateSaveData%z_ExtPtfm(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(LinStateSaveData%z_ExtPtfm) + end if + if (allocated(LinStateSaveData%OtherSt_ExtPtfm)) then + LB(1:1) = lbound(LinStateSaveData%OtherSt_ExtPtfm) + UB(1:1) = ubound(LinStateSaveData%OtherSt_ExtPtfm) + do i1 = LB(1), UB(1) + call ExtPtfm_DestroyOtherState(LinStateSaveData%OtherSt_ExtPtfm(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(LinStateSaveData%OtherSt_ExtPtfm) + end if + if (allocated(LinStateSaveData%u_ExtPtfm)) then + LB(1:1) = lbound(LinStateSaveData%u_ExtPtfm) + UB(1:1) = ubound(LinStateSaveData%u_ExtPtfm) + do i1 = LB(1), UB(1) + call ExtPtfm_DestroyInput(LinStateSaveData%u_ExtPtfm(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(LinStateSaveData%u_ExtPtfm) + end if + if (allocated(LinStateSaveData%x_HD)) then + LB(1:1) = lbound(LinStateSaveData%x_HD) + UB(1:1) = ubound(LinStateSaveData%x_HD) + do i1 = LB(1), UB(1) + call HydroDyn_DestroyContState(LinStateSaveData%x_HD(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(LinStateSaveData%x_HD) + end if + if (allocated(LinStateSaveData%xd_HD)) then + LB(1:1) = lbound(LinStateSaveData%xd_HD) + UB(1:1) = ubound(LinStateSaveData%xd_HD) + do i1 = LB(1), UB(1) + call HydroDyn_DestroyDiscState(LinStateSaveData%xd_HD(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(LinStateSaveData%xd_HD) + end if + if (allocated(LinStateSaveData%z_HD)) then + LB(1:1) = lbound(LinStateSaveData%z_HD) + UB(1:1) = ubound(LinStateSaveData%z_HD) + do i1 = LB(1), UB(1) + call HydroDyn_DestroyConstrState(LinStateSaveData%z_HD(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(LinStateSaveData%z_HD) + end if + if (allocated(LinStateSaveData%OtherSt_HD)) then + LB(1:1) = lbound(LinStateSaveData%OtherSt_HD) + UB(1:1) = ubound(LinStateSaveData%OtherSt_HD) + do i1 = LB(1), UB(1) + call HydroDyn_DestroyOtherState(LinStateSaveData%OtherSt_HD(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(LinStateSaveData%OtherSt_HD) + end if + if (allocated(LinStateSaveData%u_HD)) then + LB(1:1) = lbound(LinStateSaveData%u_HD) + UB(1:1) = ubound(LinStateSaveData%u_HD) + do i1 = LB(1), UB(1) + call HydroDyn_DestroyInput(LinStateSaveData%u_HD(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(LinStateSaveData%u_HD) + end if + if (allocated(LinStateSaveData%x_SeaSt)) then + LB(1:1) = lbound(LinStateSaveData%x_SeaSt) + UB(1:1) = ubound(LinStateSaveData%x_SeaSt) + do i1 = LB(1), UB(1) + call SeaSt_DestroyContState(LinStateSaveData%x_SeaSt(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(LinStateSaveData%x_SeaSt) + end if + if (allocated(LinStateSaveData%xd_SeaSt)) then + LB(1:1) = lbound(LinStateSaveData%xd_SeaSt) + UB(1:1) = ubound(LinStateSaveData%xd_SeaSt) + do i1 = LB(1), UB(1) + call SeaSt_DestroyDiscState(LinStateSaveData%xd_SeaSt(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(LinStateSaveData%xd_SeaSt) + end if + if (allocated(LinStateSaveData%z_SeaSt)) then + LB(1:1) = lbound(LinStateSaveData%z_SeaSt) + UB(1:1) = ubound(LinStateSaveData%z_SeaSt) + do i1 = LB(1), UB(1) + call SeaSt_DestroyConstrState(LinStateSaveData%z_SeaSt(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(LinStateSaveData%z_SeaSt) + end if + if (allocated(LinStateSaveData%OtherSt_SeaSt)) then + LB(1:1) = lbound(LinStateSaveData%OtherSt_SeaSt) + UB(1:1) = ubound(LinStateSaveData%OtherSt_SeaSt) + do i1 = LB(1), UB(1) + call SeaSt_DestroyOtherState(LinStateSaveData%OtherSt_SeaSt(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(LinStateSaveData%OtherSt_SeaSt) + end if + if (allocated(LinStateSaveData%u_SeaSt)) then + LB(1:1) = lbound(LinStateSaveData%u_SeaSt) + UB(1:1) = ubound(LinStateSaveData%u_SeaSt) + do i1 = LB(1), UB(1) + call SeaSt_DestroyInput(LinStateSaveData%u_SeaSt(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(LinStateSaveData%u_SeaSt) + end if + if (allocated(LinStateSaveData%x_IceF)) then + LB(1:1) = lbound(LinStateSaveData%x_IceF) + UB(1:1) = ubound(LinStateSaveData%x_IceF) + do i1 = LB(1), UB(1) + call IceFloe_DestroyContState(LinStateSaveData%x_IceF(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(LinStateSaveData%x_IceF) + end if + if (allocated(LinStateSaveData%xd_IceF)) then + LB(1:1) = lbound(LinStateSaveData%xd_IceF) + UB(1:1) = ubound(LinStateSaveData%xd_IceF) + do i1 = LB(1), UB(1) + call IceFloe_DestroyDiscState(LinStateSaveData%xd_IceF(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(LinStateSaveData%xd_IceF) + end if + if (allocated(LinStateSaveData%z_IceF)) then + LB(1:1) = lbound(LinStateSaveData%z_IceF) + UB(1:1) = ubound(LinStateSaveData%z_IceF) + do i1 = LB(1), UB(1) + call IceFloe_DestroyConstrState(LinStateSaveData%z_IceF(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(LinStateSaveData%z_IceF) + end if + if (allocated(LinStateSaveData%OtherSt_IceF)) then + LB(1:1) = lbound(LinStateSaveData%OtherSt_IceF) + UB(1:1) = ubound(LinStateSaveData%OtherSt_IceF) + do i1 = LB(1), UB(1) + call IceFloe_DestroyOtherState(LinStateSaveData%OtherSt_IceF(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(LinStateSaveData%OtherSt_IceF) + end if + if (allocated(LinStateSaveData%u_IceF)) then + LB(1:1) = lbound(LinStateSaveData%u_IceF) + UB(1:1) = ubound(LinStateSaveData%u_IceF) + do i1 = LB(1), UB(1) + call IceFloe_DestroyInput(LinStateSaveData%u_IceF(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(LinStateSaveData%u_IceF) + end if + if (allocated(LinStateSaveData%x_MAP)) then + LB(1:1) = lbound(LinStateSaveData%x_MAP) + UB(1:1) = ubound(LinStateSaveData%x_MAP) + do i1 = LB(1), UB(1) + call MAP_DestroyContState(LinStateSaveData%x_MAP(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(LinStateSaveData%x_MAP) + end if + if (allocated(LinStateSaveData%xd_MAP)) then + LB(1:1) = lbound(LinStateSaveData%xd_MAP) + UB(1:1) = ubound(LinStateSaveData%xd_MAP) + do i1 = LB(1), UB(1) + call MAP_DestroyDiscState(LinStateSaveData%xd_MAP(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(LinStateSaveData%xd_MAP) + end if + if (allocated(LinStateSaveData%z_MAP)) then + LB(1:1) = lbound(LinStateSaveData%z_MAP) + UB(1:1) = ubound(LinStateSaveData%z_MAP) + do i1 = LB(1), UB(1) + call MAP_DestroyConstrState(LinStateSaveData%z_MAP(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(LinStateSaveData%z_MAP) + end if + if (allocated(LinStateSaveData%u_MAP)) then + LB(1:1) = lbound(LinStateSaveData%u_MAP) + UB(1:1) = ubound(LinStateSaveData%u_MAP) + do i1 = LB(1), UB(1) + call MAP_DestroyInput(LinStateSaveData%u_MAP(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(LinStateSaveData%u_MAP) + end if + if (allocated(LinStateSaveData%x_FEAM)) then + LB(1:1) = lbound(LinStateSaveData%x_FEAM) + UB(1:1) = ubound(LinStateSaveData%x_FEAM) + do i1 = LB(1), UB(1) + call FEAM_DestroyContState(LinStateSaveData%x_FEAM(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(LinStateSaveData%x_FEAM) + end if + if (allocated(LinStateSaveData%xd_FEAM)) then + LB(1:1) = lbound(LinStateSaveData%xd_FEAM) + UB(1:1) = ubound(LinStateSaveData%xd_FEAM) + do i1 = LB(1), UB(1) + call FEAM_DestroyDiscState(LinStateSaveData%xd_FEAM(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(LinStateSaveData%xd_FEAM) + end if + if (allocated(LinStateSaveData%z_FEAM)) then + LB(1:1) = lbound(LinStateSaveData%z_FEAM) + UB(1:1) = ubound(LinStateSaveData%z_FEAM) + do i1 = LB(1), UB(1) + call FEAM_DestroyConstrState(LinStateSaveData%z_FEAM(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(LinStateSaveData%z_FEAM) + end if + if (allocated(LinStateSaveData%OtherSt_FEAM)) then + LB(1:1) = lbound(LinStateSaveData%OtherSt_FEAM) + UB(1:1) = ubound(LinStateSaveData%OtherSt_FEAM) + do i1 = LB(1), UB(1) + call FEAM_DestroyOtherState(LinStateSaveData%OtherSt_FEAM(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(LinStateSaveData%OtherSt_FEAM) + end if + if (allocated(LinStateSaveData%u_FEAM)) then + LB(1:1) = lbound(LinStateSaveData%u_FEAM) + UB(1:1) = ubound(LinStateSaveData%u_FEAM) + do i1 = LB(1), UB(1) + call FEAM_DestroyInput(LinStateSaveData%u_FEAM(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(LinStateSaveData%u_FEAM) + end if + if (allocated(LinStateSaveData%x_MD)) then + LB(1:1) = lbound(LinStateSaveData%x_MD) + UB(1:1) = ubound(LinStateSaveData%x_MD) + do i1 = LB(1), UB(1) + call MD_DestroyContState(LinStateSaveData%x_MD(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(LinStateSaveData%x_MD) + end if + if (allocated(LinStateSaveData%xd_MD)) then + LB(1:1) = lbound(LinStateSaveData%xd_MD) + UB(1:1) = ubound(LinStateSaveData%xd_MD) + do i1 = LB(1), UB(1) + call MD_DestroyDiscState(LinStateSaveData%xd_MD(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(LinStateSaveData%xd_MD) + end if + if (allocated(LinStateSaveData%z_MD)) then + LB(1:1) = lbound(LinStateSaveData%z_MD) + UB(1:1) = ubound(LinStateSaveData%z_MD) + do i1 = LB(1), UB(1) + call MD_DestroyConstrState(LinStateSaveData%z_MD(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(LinStateSaveData%z_MD) + end if + if (allocated(LinStateSaveData%OtherSt_MD)) then + LB(1:1) = lbound(LinStateSaveData%OtherSt_MD) + UB(1:1) = ubound(LinStateSaveData%OtherSt_MD) + do i1 = LB(1), UB(1) + call MD_DestroyOtherState(LinStateSaveData%OtherSt_MD(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(LinStateSaveData%OtherSt_MD) + end if + if (allocated(LinStateSaveData%u_MD)) then + LB(1:1) = lbound(LinStateSaveData%u_MD) + UB(1:1) = ubound(LinStateSaveData%u_MD) + do i1 = LB(1), UB(1) + call MD_DestroyInput(LinStateSaveData%u_MD(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(LinStateSaveData%u_MD) + end if +end subroutine + +subroutine FAST_PackLinStateSave(RF, Indata) + type(RegFile), intent(inout) :: RF + type(FAST_LinStateSave), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackLinStateSave' + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%x_IceD)) + if (allocated(InData%x_IceD)) then + call RegPackBounds(RF, 2, lbound(InData%x_IceD), ubound(InData%x_IceD)) + LB(1:2) = lbound(InData%x_IceD) + UB(1:2) = ubound(InData%x_IceD) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_PackContState(RF, InData%x_IceD(i1,i2)) + end do + end do + end if + call RegPack(RF, allocated(InData%xd_IceD)) + if (allocated(InData%xd_IceD)) then + call RegPackBounds(RF, 2, lbound(InData%xd_IceD), ubound(InData%xd_IceD)) + LB(1:2) = lbound(InData%xd_IceD) + UB(1:2) = ubound(InData%xd_IceD) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_PackDiscState(RF, InData%xd_IceD(i1,i2)) + end do + end do + end if + call RegPack(RF, allocated(InData%z_IceD)) + if (allocated(InData%z_IceD)) then + call RegPackBounds(RF, 2, lbound(InData%z_IceD), ubound(InData%z_IceD)) + LB(1:2) = lbound(InData%z_IceD) + UB(1:2) = ubound(InData%z_IceD) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_PackConstrState(RF, InData%z_IceD(i1,i2)) + end do + end do + end if + call RegPack(RF, allocated(InData%OtherSt_IceD)) + if (allocated(InData%OtherSt_IceD)) then + call RegPackBounds(RF, 2, lbound(InData%OtherSt_IceD), ubound(InData%OtherSt_IceD)) + LB(1:2) = lbound(InData%OtherSt_IceD) + UB(1:2) = ubound(InData%OtherSt_IceD) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_PackOtherState(RF, InData%OtherSt_IceD(i1,i2)) + end do + end do + end if + call RegPack(RF, allocated(InData%u_IceD)) + if (allocated(InData%u_IceD)) then + call RegPackBounds(RF, 2, lbound(InData%u_IceD), ubound(InData%u_IceD)) + LB(1:2) = lbound(InData%u_IceD) + UB(1:2) = ubound(InData%u_IceD) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_PackInput(RF, InData%u_IceD(i1,i2)) + end do + end do + end if + call RegPack(RF, allocated(InData%x_BD)) + if (allocated(InData%x_BD)) then + call RegPackBounds(RF, 2, lbound(InData%x_BD), ubound(InData%x_BD)) + LB(1:2) = lbound(InData%x_BD) + UB(1:2) = ubound(InData%x_BD) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_PackContState(RF, InData%x_BD(i1,i2)) + end do + end do + end if + call RegPack(RF, allocated(InData%xd_BD)) + if (allocated(InData%xd_BD)) then + call RegPackBounds(RF, 2, lbound(InData%xd_BD), ubound(InData%xd_BD)) + LB(1:2) = lbound(InData%xd_BD) + UB(1:2) = ubound(InData%xd_BD) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_PackDiscState(RF, InData%xd_BD(i1,i2)) + end do + end do + end if + call RegPack(RF, allocated(InData%z_BD)) + if (allocated(InData%z_BD)) then + call RegPackBounds(RF, 2, lbound(InData%z_BD), ubound(InData%z_BD)) + LB(1:2) = lbound(InData%z_BD) + UB(1:2) = ubound(InData%z_BD) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_PackConstrState(RF, InData%z_BD(i1,i2)) + end do + end do + end if + call RegPack(RF, allocated(InData%OtherSt_BD)) + if (allocated(InData%OtherSt_BD)) then + call RegPackBounds(RF, 2, lbound(InData%OtherSt_BD), ubound(InData%OtherSt_BD)) + LB(1:2) = lbound(InData%OtherSt_BD) + UB(1:2) = ubound(InData%OtherSt_BD) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_PackOtherState(RF, InData%OtherSt_BD(i1,i2)) + end do + end do + end if + call RegPack(RF, allocated(InData%u_BD)) + if (allocated(InData%u_BD)) then + call RegPackBounds(RF, 2, lbound(InData%u_BD), ubound(InData%u_BD)) + LB(1:2) = lbound(InData%u_BD) + UB(1:2) = ubound(InData%u_BD) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_PackInput(RF, InData%u_BD(i1,i2)) + end do + end do + end if + call RegPack(RF, allocated(InData%x_ED)) + if (allocated(InData%x_ED)) then + call RegPackBounds(RF, 1, lbound(InData%x_ED), ubound(InData%x_ED)) + LB(1:1) = lbound(InData%x_ED) + UB(1:1) = ubound(InData%x_ED) + do i1 = LB(1), UB(1) + call ED_PackContState(RF, InData%x_ED(i1)) + end do + end if + call RegPack(RF, allocated(InData%xd_ED)) + if (allocated(InData%xd_ED)) then + call RegPackBounds(RF, 1, lbound(InData%xd_ED), ubound(InData%xd_ED)) + LB(1:1) = lbound(InData%xd_ED) + UB(1:1) = ubound(InData%xd_ED) + do i1 = LB(1), UB(1) + call ED_PackDiscState(RF, InData%xd_ED(i1)) + end do + end if + call RegPack(RF, allocated(InData%z_ED)) + if (allocated(InData%z_ED)) then + call RegPackBounds(RF, 1, lbound(InData%z_ED), ubound(InData%z_ED)) + LB(1:1) = lbound(InData%z_ED) + UB(1:1) = ubound(InData%z_ED) + do i1 = LB(1), UB(1) + call ED_PackConstrState(RF, InData%z_ED(i1)) + end do + end if + call RegPack(RF, allocated(InData%OtherSt_ED)) + if (allocated(InData%OtherSt_ED)) then + call RegPackBounds(RF, 1, lbound(InData%OtherSt_ED), ubound(InData%OtherSt_ED)) + LB(1:1) = lbound(InData%OtherSt_ED) + UB(1:1) = ubound(InData%OtherSt_ED) + do i1 = LB(1), UB(1) + call ED_PackOtherState(RF, InData%OtherSt_ED(i1)) + end do + end if + call RegPack(RF, allocated(InData%u_ED)) + if (allocated(InData%u_ED)) then + call RegPackBounds(RF, 1, lbound(InData%u_ED), ubound(InData%u_ED)) + LB(1:1) = lbound(InData%u_ED) + UB(1:1) = ubound(InData%u_ED) + do i1 = LB(1), UB(1) + call ED_PackInput(RF, InData%u_ED(i1)) + end do + end if + call RegPack(RF, allocated(InData%x_SrvD)) + if (allocated(InData%x_SrvD)) then + call RegPackBounds(RF, 1, lbound(InData%x_SrvD), ubound(InData%x_SrvD)) + LB(1:1) = lbound(InData%x_SrvD) + UB(1:1) = ubound(InData%x_SrvD) + do i1 = LB(1), UB(1) + call SrvD_PackContState(RF, InData%x_SrvD(i1)) + end do + end if + call RegPack(RF, allocated(InData%xd_SrvD)) + if (allocated(InData%xd_SrvD)) then + call RegPackBounds(RF, 1, lbound(InData%xd_SrvD), ubound(InData%xd_SrvD)) + LB(1:1) = lbound(InData%xd_SrvD) + UB(1:1) = ubound(InData%xd_SrvD) + do i1 = LB(1), UB(1) + call SrvD_PackDiscState(RF, InData%xd_SrvD(i1)) + end do + end if + call RegPack(RF, allocated(InData%z_SrvD)) + if (allocated(InData%z_SrvD)) then + call RegPackBounds(RF, 1, lbound(InData%z_SrvD), ubound(InData%z_SrvD)) + LB(1:1) = lbound(InData%z_SrvD) + UB(1:1) = ubound(InData%z_SrvD) + do i1 = LB(1), UB(1) + call SrvD_PackConstrState(RF, InData%z_SrvD(i1)) + end do + end if + call RegPack(RF, allocated(InData%OtherSt_SrvD)) + if (allocated(InData%OtherSt_SrvD)) then + call RegPackBounds(RF, 1, lbound(InData%OtherSt_SrvD), ubound(InData%OtherSt_SrvD)) + LB(1:1) = lbound(InData%OtherSt_SrvD) + UB(1:1) = ubound(InData%OtherSt_SrvD) + do i1 = LB(1), UB(1) + call SrvD_PackOtherState(RF, InData%OtherSt_SrvD(i1)) + end do + end if + call RegPack(RF, allocated(InData%u_SrvD)) + if (allocated(InData%u_SrvD)) then + call RegPackBounds(RF, 1, lbound(InData%u_SrvD), ubound(InData%u_SrvD)) + LB(1:1) = lbound(InData%u_SrvD) + UB(1:1) = ubound(InData%u_SrvD) + do i1 = LB(1), UB(1) + call SrvD_PackInput(RF, InData%u_SrvD(i1)) + end do + end if + call RegPack(RF, allocated(InData%x_AD)) + if (allocated(InData%x_AD)) then + call RegPackBounds(RF, 1, lbound(InData%x_AD), ubound(InData%x_AD)) + LB(1:1) = lbound(InData%x_AD) + UB(1:1) = ubound(InData%x_AD) + do i1 = LB(1), UB(1) + call AD_PackContState(RF, InData%x_AD(i1)) + end do + end if + call RegPack(RF, allocated(InData%xd_AD)) + if (allocated(InData%xd_AD)) then + call RegPackBounds(RF, 1, lbound(InData%xd_AD), ubound(InData%xd_AD)) + LB(1:1) = lbound(InData%xd_AD) + UB(1:1) = ubound(InData%xd_AD) + do i1 = LB(1), UB(1) + call AD_PackDiscState(RF, InData%xd_AD(i1)) + end do + end if + call RegPack(RF, allocated(InData%z_AD)) + if (allocated(InData%z_AD)) then + call RegPackBounds(RF, 1, lbound(InData%z_AD), ubound(InData%z_AD)) + LB(1:1) = lbound(InData%z_AD) + UB(1:1) = ubound(InData%z_AD) + do i1 = LB(1), UB(1) + call AD_PackConstrState(RF, InData%z_AD(i1)) + end do + end if + call RegPack(RF, allocated(InData%OtherSt_AD)) + if (allocated(InData%OtherSt_AD)) then + call RegPackBounds(RF, 1, lbound(InData%OtherSt_AD), ubound(InData%OtherSt_AD)) + LB(1:1) = lbound(InData%OtherSt_AD) + UB(1:1) = ubound(InData%OtherSt_AD) + do i1 = LB(1), UB(1) + call AD_PackOtherState(RF, InData%OtherSt_AD(i1)) + end do + end if + call RegPack(RF, allocated(InData%u_AD)) + if (allocated(InData%u_AD)) then + call RegPackBounds(RF, 1, lbound(InData%u_AD), ubound(InData%u_AD)) + LB(1:1) = lbound(InData%u_AD) + UB(1:1) = ubound(InData%u_AD) + do i1 = LB(1), UB(1) + call AD_PackInput(RF, InData%u_AD(i1)) + end do + end if + call RegPack(RF, allocated(InData%x_IfW)) + if (allocated(InData%x_IfW)) then + call RegPackBounds(RF, 1, lbound(InData%x_IfW), ubound(InData%x_IfW)) + LB(1:1) = lbound(InData%x_IfW) + UB(1:1) = ubound(InData%x_IfW) + do i1 = LB(1), UB(1) + call InflowWind_PackContState(RF, InData%x_IfW(i1)) + end do + end if + call RegPack(RF, allocated(InData%xd_IfW)) + if (allocated(InData%xd_IfW)) then + call RegPackBounds(RF, 1, lbound(InData%xd_IfW), ubound(InData%xd_IfW)) + LB(1:1) = lbound(InData%xd_IfW) + UB(1:1) = ubound(InData%xd_IfW) + do i1 = LB(1), UB(1) + call InflowWind_PackDiscState(RF, InData%xd_IfW(i1)) + end do + end if + call RegPack(RF, allocated(InData%z_IfW)) + if (allocated(InData%z_IfW)) then + call RegPackBounds(RF, 1, lbound(InData%z_IfW), ubound(InData%z_IfW)) + LB(1:1) = lbound(InData%z_IfW) + UB(1:1) = ubound(InData%z_IfW) + do i1 = LB(1), UB(1) + call InflowWind_PackConstrState(RF, InData%z_IfW(i1)) + end do + end if + call RegPack(RF, allocated(InData%OtherSt_IfW)) + if (allocated(InData%OtherSt_IfW)) then + call RegPackBounds(RF, 1, lbound(InData%OtherSt_IfW), ubound(InData%OtherSt_IfW)) + LB(1:1) = lbound(InData%OtherSt_IfW) + UB(1:1) = ubound(InData%OtherSt_IfW) + do i1 = LB(1), UB(1) + call InflowWind_PackOtherState(RF, InData%OtherSt_IfW(i1)) + end do + end if + call RegPack(RF, allocated(InData%u_IfW)) + if (allocated(InData%u_IfW)) then + call RegPackBounds(RF, 1, lbound(InData%u_IfW), ubound(InData%u_IfW)) + LB(1:1) = lbound(InData%u_IfW) + UB(1:1) = ubound(InData%u_IfW) + do i1 = LB(1), UB(1) + call InflowWind_PackInput(RF, InData%u_IfW(i1)) + end do + end if + call RegPack(RF, allocated(InData%x_SD)) + if (allocated(InData%x_SD)) then + call RegPackBounds(RF, 1, lbound(InData%x_SD), ubound(InData%x_SD)) + LB(1:1) = lbound(InData%x_SD) + UB(1:1) = ubound(InData%x_SD) + do i1 = LB(1), UB(1) + call SD_PackContState(RF, InData%x_SD(i1)) + end do + end if + call RegPack(RF, allocated(InData%xd_SD)) + if (allocated(InData%xd_SD)) then + call RegPackBounds(RF, 1, lbound(InData%xd_SD), ubound(InData%xd_SD)) + LB(1:1) = lbound(InData%xd_SD) + UB(1:1) = ubound(InData%xd_SD) + do i1 = LB(1), UB(1) + call SD_PackDiscState(RF, InData%xd_SD(i1)) + end do + end if + call RegPack(RF, allocated(InData%z_SD)) + if (allocated(InData%z_SD)) then + call RegPackBounds(RF, 1, lbound(InData%z_SD), ubound(InData%z_SD)) + LB(1:1) = lbound(InData%z_SD) + UB(1:1) = ubound(InData%z_SD) + do i1 = LB(1), UB(1) + call SD_PackConstrState(RF, InData%z_SD(i1)) + end do + end if + call RegPack(RF, allocated(InData%OtherSt_SD)) + if (allocated(InData%OtherSt_SD)) then + call RegPackBounds(RF, 1, lbound(InData%OtherSt_SD), ubound(InData%OtherSt_SD)) + LB(1:1) = lbound(InData%OtherSt_SD) + UB(1:1) = ubound(InData%OtherSt_SD) + do i1 = LB(1), UB(1) + call SD_PackOtherState(RF, InData%OtherSt_SD(i1)) + end do + end if + call RegPack(RF, allocated(InData%u_SD)) + if (allocated(InData%u_SD)) then + call RegPackBounds(RF, 1, lbound(InData%u_SD), ubound(InData%u_SD)) + LB(1:1) = lbound(InData%u_SD) + UB(1:1) = ubound(InData%u_SD) + do i1 = LB(1), UB(1) + call SD_PackInput(RF, InData%u_SD(i1)) + end do + end if + call RegPack(RF, allocated(InData%x_ExtPtfm)) + if (allocated(InData%x_ExtPtfm)) then + call RegPackBounds(RF, 1, lbound(InData%x_ExtPtfm), ubound(InData%x_ExtPtfm)) + LB(1:1) = lbound(InData%x_ExtPtfm) + UB(1:1) = ubound(InData%x_ExtPtfm) + do i1 = LB(1), UB(1) + call ExtPtfm_PackContState(RF, InData%x_ExtPtfm(i1)) + end do + end if + call RegPack(RF, allocated(InData%xd_ExtPtfm)) + if (allocated(InData%xd_ExtPtfm)) then + call RegPackBounds(RF, 1, lbound(InData%xd_ExtPtfm), ubound(InData%xd_ExtPtfm)) + LB(1:1) = lbound(InData%xd_ExtPtfm) + UB(1:1) = ubound(InData%xd_ExtPtfm) + do i1 = LB(1), UB(1) + call ExtPtfm_PackDiscState(RF, InData%xd_ExtPtfm(i1)) + end do + end if + call RegPack(RF, allocated(InData%z_ExtPtfm)) + if (allocated(InData%z_ExtPtfm)) then + call RegPackBounds(RF, 1, lbound(InData%z_ExtPtfm), ubound(InData%z_ExtPtfm)) + LB(1:1) = lbound(InData%z_ExtPtfm) + UB(1:1) = ubound(InData%z_ExtPtfm) + do i1 = LB(1), UB(1) + call ExtPtfm_PackConstrState(RF, InData%z_ExtPtfm(i1)) + end do + end if + call RegPack(RF, allocated(InData%OtherSt_ExtPtfm)) + if (allocated(InData%OtherSt_ExtPtfm)) then + call RegPackBounds(RF, 1, lbound(InData%OtherSt_ExtPtfm), ubound(InData%OtherSt_ExtPtfm)) + LB(1:1) = lbound(InData%OtherSt_ExtPtfm) + UB(1:1) = ubound(InData%OtherSt_ExtPtfm) + do i1 = LB(1), UB(1) + call ExtPtfm_PackOtherState(RF, InData%OtherSt_ExtPtfm(i1)) + end do + end if + call RegPack(RF, allocated(InData%u_ExtPtfm)) + if (allocated(InData%u_ExtPtfm)) then + call RegPackBounds(RF, 1, lbound(InData%u_ExtPtfm), ubound(InData%u_ExtPtfm)) + LB(1:1) = lbound(InData%u_ExtPtfm) + UB(1:1) = ubound(InData%u_ExtPtfm) + do i1 = LB(1), UB(1) + call ExtPtfm_PackInput(RF, InData%u_ExtPtfm(i1)) + end do + end if + call RegPack(RF, allocated(InData%x_HD)) + if (allocated(InData%x_HD)) then + call RegPackBounds(RF, 1, lbound(InData%x_HD), ubound(InData%x_HD)) + LB(1:1) = lbound(InData%x_HD) + UB(1:1) = ubound(InData%x_HD) + do i1 = LB(1), UB(1) + call HydroDyn_PackContState(RF, InData%x_HD(i1)) + end do + end if + call RegPack(RF, allocated(InData%xd_HD)) + if (allocated(InData%xd_HD)) then + call RegPackBounds(RF, 1, lbound(InData%xd_HD), ubound(InData%xd_HD)) + LB(1:1) = lbound(InData%xd_HD) + UB(1:1) = ubound(InData%xd_HD) + do i1 = LB(1), UB(1) + call HydroDyn_PackDiscState(RF, InData%xd_HD(i1)) + end do + end if + call RegPack(RF, allocated(InData%z_HD)) + if (allocated(InData%z_HD)) then + call RegPackBounds(RF, 1, lbound(InData%z_HD), ubound(InData%z_HD)) + LB(1:1) = lbound(InData%z_HD) + UB(1:1) = ubound(InData%z_HD) + do i1 = LB(1), UB(1) + call HydroDyn_PackConstrState(RF, InData%z_HD(i1)) + end do + end if + call RegPack(RF, allocated(InData%OtherSt_HD)) + if (allocated(InData%OtherSt_HD)) then + call RegPackBounds(RF, 1, lbound(InData%OtherSt_HD), ubound(InData%OtherSt_HD)) + LB(1:1) = lbound(InData%OtherSt_HD) + UB(1:1) = ubound(InData%OtherSt_HD) + do i1 = LB(1), UB(1) + call HydroDyn_PackOtherState(RF, InData%OtherSt_HD(i1)) + end do + end if + call RegPack(RF, allocated(InData%u_HD)) + if (allocated(InData%u_HD)) then + call RegPackBounds(RF, 1, lbound(InData%u_HD), ubound(InData%u_HD)) + LB(1:1) = lbound(InData%u_HD) + UB(1:1) = ubound(InData%u_HD) + do i1 = LB(1), UB(1) + call HydroDyn_PackInput(RF, InData%u_HD(i1)) + end do + end if + call RegPack(RF, allocated(InData%x_SeaSt)) + if (allocated(InData%x_SeaSt)) then + call RegPackBounds(RF, 1, lbound(InData%x_SeaSt), ubound(InData%x_SeaSt)) + LB(1:1) = lbound(InData%x_SeaSt) + UB(1:1) = ubound(InData%x_SeaSt) + do i1 = LB(1), UB(1) + call SeaSt_PackContState(RF, InData%x_SeaSt(i1)) + end do + end if + call RegPack(RF, allocated(InData%xd_SeaSt)) + if (allocated(InData%xd_SeaSt)) then + call RegPackBounds(RF, 1, lbound(InData%xd_SeaSt), ubound(InData%xd_SeaSt)) + LB(1:1) = lbound(InData%xd_SeaSt) + UB(1:1) = ubound(InData%xd_SeaSt) + do i1 = LB(1), UB(1) + call SeaSt_PackDiscState(RF, InData%xd_SeaSt(i1)) + end do + end if + call RegPack(RF, allocated(InData%z_SeaSt)) + if (allocated(InData%z_SeaSt)) then + call RegPackBounds(RF, 1, lbound(InData%z_SeaSt), ubound(InData%z_SeaSt)) + LB(1:1) = lbound(InData%z_SeaSt) + UB(1:1) = ubound(InData%z_SeaSt) + do i1 = LB(1), UB(1) + call SeaSt_PackConstrState(RF, InData%z_SeaSt(i1)) + end do + end if + call RegPack(RF, allocated(InData%OtherSt_SeaSt)) + if (allocated(InData%OtherSt_SeaSt)) then + call RegPackBounds(RF, 1, lbound(InData%OtherSt_SeaSt), ubound(InData%OtherSt_SeaSt)) + LB(1:1) = lbound(InData%OtherSt_SeaSt) + UB(1:1) = ubound(InData%OtherSt_SeaSt) + do i1 = LB(1), UB(1) + call SeaSt_PackOtherState(RF, InData%OtherSt_SeaSt(i1)) + end do + end if + call RegPack(RF, allocated(InData%u_SeaSt)) + if (allocated(InData%u_SeaSt)) then + call RegPackBounds(RF, 1, lbound(InData%u_SeaSt), ubound(InData%u_SeaSt)) + LB(1:1) = lbound(InData%u_SeaSt) + UB(1:1) = ubound(InData%u_SeaSt) + do i1 = LB(1), UB(1) + call SeaSt_PackInput(RF, InData%u_SeaSt(i1)) + end do + end if + call RegPack(RF, allocated(InData%x_IceF)) + if (allocated(InData%x_IceF)) then + call RegPackBounds(RF, 1, lbound(InData%x_IceF), ubound(InData%x_IceF)) + LB(1:1) = lbound(InData%x_IceF) + UB(1:1) = ubound(InData%x_IceF) + do i1 = LB(1), UB(1) + call IceFloe_PackContState(RF, InData%x_IceF(i1)) + end do + end if + call RegPack(RF, allocated(InData%xd_IceF)) + if (allocated(InData%xd_IceF)) then + call RegPackBounds(RF, 1, lbound(InData%xd_IceF), ubound(InData%xd_IceF)) + LB(1:1) = lbound(InData%xd_IceF) + UB(1:1) = ubound(InData%xd_IceF) + do i1 = LB(1), UB(1) + call IceFloe_PackDiscState(RF, InData%xd_IceF(i1)) + end do + end if + call RegPack(RF, allocated(InData%z_IceF)) + if (allocated(InData%z_IceF)) then + call RegPackBounds(RF, 1, lbound(InData%z_IceF), ubound(InData%z_IceF)) + LB(1:1) = lbound(InData%z_IceF) + UB(1:1) = ubound(InData%z_IceF) + do i1 = LB(1), UB(1) + call IceFloe_PackConstrState(RF, InData%z_IceF(i1)) + end do + end if + call RegPack(RF, allocated(InData%OtherSt_IceF)) + if (allocated(InData%OtherSt_IceF)) then + call RegPackBounds(RF, 1, lbound(InData%OtherSt_IceF), ubound(InData%OtherSt_IceF)) + LB(1:1) = lbound(InData%OtherSt_IceF) + UB(1:1) = ubound(InData%OtherSt_IceF) + do i1 = LB(1), UB(1) + call IceFloe_PackOtherState(RF, InData%OtherSt_IceF(i1)) + end do + end if + call RegPack(RF, allocated(InData%u_IceF)) + if (allocated(InData%u_IceF)) then + call RegPackBounds(RF, 1, lbound(InData%u_IceF), ubound(InData%u_IceF)) + LB(1:1) = lbound(InData%u_IceF) + UB(1:1) = ubound(InData%u_IceF) + do i1 = LB(1), UB(1) + call IceFloe_PackInput(RF, InData%u_IceF(i1)) + end do + end if + call RegPack(RF, allocated(InData%x_MAP)) + if (allocated(InData%x_MAP)) then + call RegPackBounds(RF, 1, lbound(InData%x_MAP), ubound(InData%x_MAP)) + LB(1:1) = lbound(InData%x_MAP) + UB(1:1) = ubound(InData%x_MAP) + do i1 = LB(1), UB(1) + call MAP_PackContState(RF, InData%x_MAP(i1)) + end do + end if + call RegPack(RF, allocated(InData%xd_MAP)) + if (allocated(InData%xd_MAP)) then + call RegPackBounds(RF, 1, lbound(InData%xd_MAP), ubound(InData%xd_MAP)) + LB(1:1) = lbound(InData%xd_MAP) + UB(1:1) = ubound(InData%xd_MAP) + do i1 = LB(1), UB(1) + call MAP_PackDiscState(RF, InData%xd_MAP(i1)) + end do + end if + call RegPack(RF, allocated(InData%z_MAP)) + if (allocated(InData%z_MAP)) then + call RegPackBounds(RF, 1, lbound(InData%z_MAP), ubound(InData%z_MAP)) + LB(1:1) = lbound(InData%z_MAP) + UB(1:1) = ubound(InData%z_MAP) + do i1 = LB(1), UB(1) + call MAP_PackConstrState(RF, InData%z_MAP(i1)) + end do + end if + call RegPack(RF, allocated(InData%u_MAP)) + if (allocated(InData%u_MAP)) then + call RegPackBounds(RF, 1, lbound(InData%u_MAP), ubound(InData%u_MAP)) + LB(1:1) = lbound(InData%u_MAP) + UB(1:1) = ubound(InData%u_MAP) + do i1 = LB(1), UB(1) + call MAP_PackInput(RF, InData%u_MAP(i1)) + end do + end if + call RegPack(RF, allocated(InData%x_FEAM)) + if (allocated(InData%x_FEAM)) then + call RegPackBounds(RF, 1, lbound(InData%x_FEAM), ubound(InData%x_FEAM)) + LB(1:1) = lbound(InData%x_FEAM) + UB(1:1) = ubound(InData%x_FEAM) + do i1 = LB(1), UB(1) + call FEAM_PackContState(RF, InData%x_FEAM(i1)) + end do + end if + call RegPack(RF, allocated(InData%xd_FEAM)) + if (allocated(InData%xd_FEAM)) then + call RegPackBounds(RF, 1, lbound(InData%xd_FEAM), ubound(InData%xd_FEAM)) + LB(1:1) = lbound(InData%xd_FEAM) + UB(1:1) = ubound(InData%xd_FEAM) + do i1 = LB(1), UB(1) + call FEAM_PackDiscState(RF, InData%xd_FEAM(i1)) + end do + end if + call RegPack(RF, allocated(InData%z_FEAM)) + if (allocated(InData%z_FEAM)) then + call RegPackBounds(RF, 1, lbound(InData%z_FEAM), ubound(InData%z_FEAM)) + LB(1:1) = lbound(InData%z_FEAM) + UB(1:1) = ubound(InData%z_FEAM) + do i1 = LB(1), UB(1) + call FEAM_PackConstrState(RF, InData%z_FEAM(i1)) + end do + end if + call RegPack(RF, allocated(InData%OtherSt_FEAM)) + if (allocated(InData%OtherSt_FEAM)) then + call RegPackBounds(RF, 1, lbound(InData%OtherSt_FEAM), ubound(InData%OtherSt_FEAM)) + LB(1:1) = lbound(InData%OtherSt_FEAM) + UB(1:1) = ubound(InData%OtherSt_FEAM) + do i1 = LB(1), UB(1) + call FEAM_PackOtherState(RF, InData%OtherSt_FEAM(i1)) + end do + end if + call RegPack(RF, allocated(InData%u_FEAM)) + if (allocated(InData%u_FEAM)) then + call RegPackBounds(RF, 1, lbound(InData%u_FEAM), ubound(InData%u_FEAM)) + LB(1:1) = lbound(InData%u_FEAM) + UB(1:1) = ubound(InData%u_FEAM) + do i1 = LB(1), UB(1) + call FEAM_PackInput(RF, InData%u_FEAM(i1)) + end do + end if + call RegPack(RF, allocated(InData%x_MD)) + if (allocated(InData%x_MD)) then + call RegPackBounds(RF, 1, lbound(InData%x_MD), ubound(InData%x_MD)) + LB(1:1) = lbound(InData%x_MD) + UB(1:1) = ubound(InData%x_MD) + do i1 = LB(1), UB(1) + call MD_PackContState(RF, InData%x_MD(i1)) + end do + end if + call RegPack(RF, allocated(InData%xd_MD)) + if (allocated(InData%xd_MD)) then + call RegPackBounds(RF, 1, lbound(InData%xd_MD), ubound(InData%xd_MD)) + LB(1:1) = lbound(InData%xd_MD) + UB(1:1) = ubound(InData%xd_MD) + do i1 = LB(1), UB(1) + call MD_PackDiscState(RF, InData%xd_MD(i1)) + end do + end if + call RegPack(RF, allocated(InData%z_MD)) + if (allocated(InData%z_MD)) then + call RegPackBounds(RF, 1, lbound(InData%z_MD), ubound(InData%z_MD)) + LB(1:1) = lbound(InData%z_MD) + UB(1:1) = ubound(InData%z_MD) + do i1 = LB(1), UB(1) + call MD_PackConstrState(RF, InData%z_MD(i1)) + end do + end if + call RegPack(RF, allocated(InData%OtherSt_MD)) + if (allocated(InData%OtherSt_MD)) then + call RegPackBounds(RF, 1, lbound(InData%OtherSt_MD), ubound(InData%OtherSt_MD)) + LB(1:1) = lbound(InData%OtherSt_MD) + UB(1:1) = ubound(InData%OtherSt_MD) + do i1 = LB(1), UB(1) + call MD_PackOtherState(RF, InData%OtherSt_MD(i1)) + end do + end if + call RegPack(RF, allocated(InData%u_MD)) + if (allocated(InData%u_MD)) then + call RegPackBounds(RF, 1, lbound(InData%u_MD), ubound(InData%u_MD)) + LB(1:1) = lbound(InData%u_MD) + UB(1:1) = ubound(InData%u_MD) + do i1 = LB(1), UB(1) + call MD_PackInput(RF, InData%u_MD(i1)) + end do + end if + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FAST_UnPackLinStateSave(RF, OutData) + type(RegFile), intent(inout) :: RF + type(FAST_LinStateSave), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackLinStateSave' + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + if (allocated(OutData%x_IceD)) deallocate(OutData%x_IceD) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%x_IceD(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_IceD.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_UnpackContState(RF, OutData%x_IceD(i1,i2)) ! x_IceD + end do + end do + end if + if (allocated(OutData%xd_IceD)) deallocate(OutData%xd_IceD) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%xd_IceD(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_IceD.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_UnpackDiscState(RF, OutData%xd_IceD(i1,i2)) ! xd_IceD + end do + end do + end if + if (allocated(OutData%z_IceD)) deallocate(OutData%z_IceD) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%z_IceD(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_IceD.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_UnpackConstrState(RF, OutData%z_IceD(i1,i2)) ! z_IceD + end do + end do + end if + if (allocated(OutData%OtherSt_IceD)) deallocate(OutData%OtherSt_IceD) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%OtherSt_IceD(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_IceD.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_UnpackOtherState(RF, OutData%OtherSt_IceD(i1,i2)) ! OtherSt_IceD + end do + end do + end if + if (allocated(OutData%u_IceD)) deallocate(OutData%u_IceD) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%u_IceD(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_IceD.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_UnpackInput(RF, OutData%u_IceD(i1,i2)) ! u_IceD + end do + end do + end if + if (allocated(OutData%x_BD)) deallocate(OutData%x_BD) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%x_BD(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_BD.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_UnpackContState(RF, OutData%x_BD(i1,i2)) ! x_BD + end do + end do + end if + if (allocated(OutData%xd_BD)) deallocate(OutData%xd_BD) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%xd_BD(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_BD.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_UnpackDiscState(RF, OutData%xd_BD(i1,i2)) ! xd_BD + end do + end do + end if + if (allocated(OutData%z_BD)) deallocate(OutData%z_BD) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%z_BD(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_BD.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_UnpackConstrState(RF, OutData%z_BD(i1,i2)) ! z_BD + end do + end do + end if + if (allocated(OutData%OtherSt_BD)) deallocate(OutData%OtherSt_BD) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%OtherSt_BD(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_BD.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_UnpackOtherState(RF, OutData%OtherSt_BD(i1,i2)) ! OtherSt_BD + end do + end do + end if + if (allocated(OutData%u_BD)) deallocate(OutData%u_BD) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%u_BD(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_BD.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_UnpackInput(RF, OutData%u_BD(i1,i2)) ! u_BD + end do + end do + end if + if (allocated(OutData%x_ED)) deallocate(OutData%x_ED) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%x_ED(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_ED.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call ED_UnpackContState(RF, OutData%x_ED(i1)) ! x_ED + end do + end if + if (allocated(OutData%xd_ED)) deallocate(OutData%xd_ED) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%xd_ED(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_ED.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call ED_UnpackDiscState(RF, OutData%xd_ED(i1)) ! xd_ED + end do + end if + if (allocated(OutData%z_ED)) deallocate(OutData%z_ED) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%z_ED(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_ED.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call ED_UnpackConstrState(RF, OutData%z_ED(i1)) ! z_ED + end do + end if + if (allocated(OutData%OtherSt_ED)) deallocate(OutData%OtherSt_ED) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%OtherSt_ED(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_ED.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call ED_UnpackOtherState(RF, OutData%OtherSt_ED(i1)) ! OtherSt_ED + end do + end if + if (allocated(OutData%u_ED)) deallocate(OutData%u_ED) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%u_ED(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_ED.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call ED_UnpackInput(RF, OutData%u_ED(i1)) ! u_ED + end do + end if + if (allocated(OutData%x_SrvD)) deallocate(OutData%x_SrvD) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%x_SrvD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_SrvD.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SrvD_UnpackContState(RF, OutData%x_SrvD(i1)) ! x_SrvD + end do + end if + if (allocated(OutData%xd_SrvD)) deallocate(OutData%xd_SrvD) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%xd_SrvD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_SrvD.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SrvD_UnpackDiscState(RF, OutData%xd_SrvD(i1)) ! xd_SrvD + end do + end if + if (allocated(OutData%z_SrvD)) deallocate(OutData%z_SrvD) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%z_SrvD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_SrvD.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SrvD_UnpackConstrState(RF, OutData%z_SrvD(i1)) ! z_SrvD + end do + end if + if (allocated(OutData%OtherSt_SrvD)) deallocate(OutData%OtherSt_SrvD) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%OtherSt_SrvD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_SrvD.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SrvD_UnpackOtherState(RF, OutData%OtherSt_SrvD(i1)) ! OtherSt_SrvD + end do + end if + if (allocated(OutData%u_SrvD)) deallocate(OutData%u_SrvD) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%u_SrvD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_SrvD.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SrvD_UnpackInput(RF, OutData%u_SrvD(i1)) ! u_SrvD + end do + end if + if (allocated(OutData%x_AD)) deallocate(OutData%x_AD) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%x_AD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_AD.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AD_UnpackContState(RF, OutData%x_AD(i1)) ! x_AD + end do + end if + if (allocated(OutData%xd_AD)) deallocate(OutData%xd_AD) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%xd_AD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_AD.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AD_UnpackDiscState(RF, OutData%xd_AD(i1)) ! xd_AD + end do + end if + if (allocated(OutData%z_AD)) deallocate(OutData%z_AD) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%z_AD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_AD.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AD_UnpackConstrState(RF, OutData%z_AD(i1)) ! z_AD + end do + end if + if (allocated(OutData%OtherSt_AD)) deallocate(OutData%OtherSt_AD) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%OtherSt_AD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_AD.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AD_UnpackOtherState(RF, OutData%OtherSt_AD(i1)) ! OtherSt_AD + end do + end if + if (allocated(OutData%u_AD)) deallocate(OutData%u_AD) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%u_AD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_AD.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AD_UnpackInput(RF, OutData%u_AD(i1)) ! u_AD + end do + end if + if (allocated(OutData%x_IfW)) deallocate(OutData%x_IfW) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%x_IfW(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_IfW.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call InflowWind_UnpackContState(RF, OutData%x_IfW(i1)) ! x_IfW + end do + end if + if (allocated(OutData%xd_IfW)) deallocate(OutData%xd_IfW) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%xd_IfW(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_IfW.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call InflowWind_UnpackDiscState(RF, OutData%xd_IfW(i1)) ! xd_IfW + end do + end if + if (allocated(OutData%z_IfW)) deallocate(OutData%z_IfW) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%z_IfW(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_IfW.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call InflowWind_UnpackConstrState(RF, OutData%z_IfW(i1)) ! z_IfW + end do + end if + if (allocated(OutData%OtherSt_IfW)) deallocate(OutData%OtherSt_IfW) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%OtherSt_IfW(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_IfW.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call InflowWind_UnpackOtherState(RF, OutData%OtherSt_IfW(i1)) ! OtherSt_IfW + end do + end if + if (allocated(OutData%u_IfW)) deallocate(OutData%u_IfW) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%u_IfW(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_IfW.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call InflowWind_UnpackInput(RF, OutData%u_IfW(i1)) ! u_IfW + end do + end if + if (allocated(OutData%x_SD)) deallocate(OutData%x_SD) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%x_SD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_SD.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SD_UnpackContState(RF, OutData%x_SD(i1)) ! x_SD + end do + end if + if (allocated(OutData%xd_SD)) deallocate(OutData%xd_SD) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%xd_SD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_SD.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SD_UnpackDiscState(RF, OutData%xd_SD(i1)) ! xd_SD + end do + end if + if (allocated(OutData%z_SD)) deallocate(OutData%z_SD) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%z_SD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_SD.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SD_UnpackConstrState(RF, OutData%z_SD(i1)) ! z_SD + end do + end if + if (allocated(OutData%OtherSt_SD)) deallocate(OutData%OtherSt_SD) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%OtherSt_SD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_SD.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SD_UnpackOtherState(RF, OutData%OtherSt_SD(i1)) ! OtherSt_SD + end do + end if + if (allocated(OutData%u_SD)) deallocate(OutData%u_SD) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%u_SD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_SD.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SD_UnpackInput(RF, OutData%u_SD(i1)) ! u_SD + end do + end if + if (allocated(OutData%x_ExtPtfm)) deallocate(OutData%x_ExtPtfm) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%x_ExtPtfm(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_ExtPtfm.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call ExtPtfm_UnpackContState(RF, OutData%x_ExtPtfm(i1)) ! x_ExtPtfm + end do + end if + if (allocated(OutData%xd_ExtPtfm)) deallocate(OutData%xd_ExtPtfm) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%xd_ExtPtfm(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_ExtPtfm.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call ExtPtfm_UnpackDiscState(RF, OutData%xd_ExtPtfm(i1)) ! xd_ExtPtfm + end do + end if + if (allocated(OutData%z_ExtPtfm)) deallocate(OutData%z_ExtPtfm) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%z_ExtPtfm(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_ExtPtfm.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call ExtPtfm_UnpackConstrState(RF, OutData%z_ExtPtfm(i1)) ! z_ExtPtfm + end do + end if + if (allocated(OutData%OtherSt_ExtPtfm)) deallocate(OutData%OtherSt_ExtPtfm) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%OtherSt_ExtPtfm(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_ExtPtfm.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call ExtPtfm_UnpackOtherState(RF, OutData%OtherSt_ExtPtfm(i1)) ! OtherSt_ExtPtfm + end do + end if + if (allocated(OutData%u_ExtPtfm)) deallocate(OutData%u_ExtPtfm) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%u_ExtPtfm(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_ExtPtfm.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call ExtPtfm_UnpackInput(RF, OutData%u_ExtPtfm(i1)) ! u_ExtPtfm + end do + end if + if (allocated(OutData%x_HD)) deallocate(OutData%x_HD) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%x_HD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_HD.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call HydroDyn_UnpackContState(RF, OutData%x_HD(i1)) ! x_HD + end do + end if + if (allocated(OutData%xd_HD)) deallocate(OutData%xd_HD) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%xd_HD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_HD.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call HydroDyn_UnpackDiscState(RF, OutData%xd_HD(i1)) ! xd_HD + end do + end if + if (allocated(OutData%z_HD)) deallocate(OutData%z_HD) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%z_HD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_HD.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call HydroDyn_UnpackConstrState(RF, OutData%z_HD(i1)) ! z_HD + end do + end if + if (allocated(OutData%OtherSt_HD)) deallocate(OutData%OtherSt_HD) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%OtherSt_HD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_HD.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call HydroDyn_UnpackOtherState(RF, OutData%OtherSt_HD(i1)) ! OtherSt_HD + end do + end if + if (allocated(OutData%u_HD)) deallocate(OutData%u_HD) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%u_HD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_HD.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call HydroDyn_UnpackInput(RF, OutData%u_HD(i1)) ! u_HD + end do + end if + if (allocated(OutData%x_SeaSt)) deallocate(OutData%x_SeaSt) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%x_SeaSt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_SeaSt.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SeaSt_UnpackContState(RF, OutData%x_SeaSt(i1)) ! x_SeaSt + end do + end if + if (allocated(OutData%xd_SeaSt)) deallocate(OutData%xd_SeaSt) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%xd_SeaSt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_SeaSt.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SeaSt_UnpackDiscState(RF, OutData%xd_SeaSt(i1)) ! xd_SeaSt + end do + end if + if (allocated(OutData%z_SeaSt)) deallocate(OutData%z_SeaSt) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%z_SeaSt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_SeaSt.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SeaSt_UnpackConstrState(RF, OutData%z_SeaSt(i1)) ! z_SeaSt + end do + end if + if (allocated(OutData%OtherSt_SeaSt)) deallocate(OutData%OtherSt_SeaSt) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%OtherSt_SeaSt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_SeaSt.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SeaSt_UnpackOtherState(RF, OutData%OtherSt_SeaSt(i1)) ! OtherSt_SeaSt + end do + end if + if (allocated(OutData%u_SeaSt)) deallocate(OutData%u_SeaSt) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%u_SeaSt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_SeaSt.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SeaSt_UnpackInput(RF, OutData%u_SeaSt(i1)) ! u_SeaSt + end do + end if + if (allocated(OutData%x_IceF)) deallocate(OutData%x_IceF) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%x_IceF(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_IceF.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call IceFloe_UnpackContState(RF, OutData%x_IceF(i1)) ! x_IceF + end do + end if + if (allocated(OutData%xd_IceF)) deallocate(OutData%xd_IceF) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%xd_IceF(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_IceF.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call IceFloe_UnpackDiscState(RF, OutData%xd_IceF(i1)) ! xd_IceF + end do + end if + if (allocated(OutData%z_IceF)) deallocate(OutData%z_IceF) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%z_IceF(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_IceF.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call IceFloe_UnpackConstrState(RF, OutData%z_IceF(i1)) ! z_IceF + end do + end if + if (allocated(OutData%OtherSt_IceF)) deallocate(OutData%OtherSt_IceF) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%OtherSt_IceF(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_IceF.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call IceFloe_UnpackOtherState(RF, OutData%OtherSt_IceF(i1)) ! OtherSt_IceF + end do + end if + if (allocated(OutData%u_IceF)) deallocate(OutData%u_IceF) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%u_IceF(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_IceF.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call IceFloe_UnpackInput(RF, OutData%u_IceF(i1)) ! u_IceF + end do + end if + if (allocated(OutData%x_MAP)) deallocate(OutData%x_MAP) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%x_MAP(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_MAP.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MAP_UnpackContState(RF, OutData%x_MAP(i1)) ! x_MAP + end do + end if + if (allocated(OutData%xd_MAP)) deallocate(OutData%xd_MAP) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%xd_MAP(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_MAP.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MAP_UnpackDiscState(RF, OutData%xd_MAP(i1)) ! xd_MAP + end do + end if + if (allocated(OutData%z_MAP)) deallocate(OutData%z_MAP) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%z_MAP(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_MAP.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MAP_UnpackConstrState(RF, OutData%z_MAP(i1)) ! z_MAP + end do + end if + if (allocated(OutData%u_MAP)) deallocate(OutData%u_MAP) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%u_MAP(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_MAP.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MAP_UnpackInput(RF, OutData%u_MAP(i1)) ! u_MAP + end do + end if + if (allocated(OutData%x_FEAM)) deallocate(OutData%x_FEAM) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%x_FEAM(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_FEAM.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call FEAM_UnpackContState(RF, OutData%x_FEAM(i1)) ! x_FEAM + end do + end if + if (allocated(OutData%xd_FEAM)) deallocate(OutData%xd_FEAM) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%xd_FEAM(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_FEAM.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call FEAM_UnpackDiscState(RF, OutData%xd_FEAM(i1)) ! xd_FEAM + end do + end if + if (allocated(OutData%z_FEAM)) deallocate(OutData%z_FEAM) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%z_FEAM(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_FEAM.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call FEAM_UnpackConstrState(RF, OutData%z_FEAM(i1)) ! z_FEAM + end do + end if + if (allocated(OutData%OtherSt_FEAM)) deallocate(OutData%OtherSt_FEAM) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%OtherSt_FEAM(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_FEAM.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call FEAM_UnpackOtherState(RF, OutData%OtherSt_FEAM(i1)) ! OtherSt_FEAM + end do + end if + if (allocated(OutData%u_FEAM)) deallocate(OutData%u_FEAM) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%u_FEAM(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_FEAM.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call FEAM_UnpackInput(RF, OutData%u_FEAM(i1)) ! u_FEAM + end do + end if + if (allocated(OutData%x_MD)) deallocate(OutData%x_MD) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%x_MD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_MD.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MD_UnpackContState(RF, OutData%x_MD(i1)) ! x_MD + end do + end if + if (allocated(OutData%xd_MD)) deallocate(OutData%xd_MD) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%xd_MD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_MD.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MD_UnpackDiscState(RF, OutData%xd_MD(i1)) ! xd_MD + end do + end if + if (allocated(OutData%z_MD)) deallocate(OutData%z_MD) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%z_MD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_MD.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MD_UnpackConstrState(RF, OutData%z_MD(i1)) ! z_MD + end do + end if + if (allocated(OutData%OtherSt_MD)) deallocate(OutData%OtherSt_MD) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%OtherSt_MD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_MD.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MD_UnpackOtherState(RF, OutData%OtherSt_MD(i1)) ! OtherSt_MD + end do + end if + if (allocated(OutData%u_MD)) deallocate(OutData%u_MD) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%u_MD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_MD.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MD_UnpackInput(RF, OutData%u_MD(i1)) ! u_MD + end do + end if +end subroutine + +subroutine FAST_CopyLinType(SrcLinTypeData, DstLinTypeData, CtrlCode, ErrStat, ErrMsg) + type(FAST_LinType), intent(in) :: SrcLinTypeData + type(FAST_LinType), intent(inout) :: DstLinTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'FAST_CopyLinType' ErrStat = ErrID_None - ErrMsg = "" - DO i1 = LBOUND(SrcServoDyn_DataData%x,1), UBOUND(SrcServoDyn_DataData%x,1) - CALL SrvD_CopyContState( SrcServoDyn_DataData%x(i1), DstServoDyn_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcServoDyn_DataData%xd,1), UBOUND(SrcServoDyn_DataData%xd,1) - CALL SrvD_CopyDiscState( SrcServoDyn_DataData%xd(i1), DstServoDyn_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcServoDyn_DataData%z,1), UBOUND(SrcServoDyn_DataData%z,1) - CALL SrvD_CopyConstrState( SrcServoDyn_DataData%z(i1), DstServoDyn_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcServoDyn_DataData%OtherSt,1), UBOUND(SrcServoDyn_DataData%OtherSt,1) - CALL SrvD_CopyOtherState( SrcServoDyn_DataData%OtherSt(i1), DstServoDyn_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - CALL SrvD_CopyParam( SrcServoDyn_DataData%p, DstServoDyn_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SrvD_CopyInput( SrcServoDyn_DataData%u, DstServoDyn_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SrvD_CopyOutput( SrcServoDyn_DataData%y, DstServoDyn_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SrvD_CopyMisc( SrcServoDyn_DataData%m, DstServoDyn_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcServoDyn_DataData%Output)) THEN - i1_l = LBOUND(SrcServoDyn_DataData%Output,1) - i1_u = UBOUND(SrcServoDyn_DataData%Output,1) - IF (.NOT. ALLOCATED(DstServoDyn_DataData%Output)) THEN - ALLOCATE(DstServoDyn_DataData%Output(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstServoDyn_DataData%Output.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcServoDyn_DataData%Output,1), UBOUND(SrcServoDyn_DataData%Output,1) - CALL SrvD_CopyOutput( SrcServoDyn_DataData%Output(i1), DstServoDyn_DataData%Output(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL SrvD_CopyOutput( SrcServoDyn_DataData%y_interp, DstServoDyn_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcServoDyn_DataData%Input)) THEN - i1_l = LBOUND(SrcServoDyn_DataData%Input,1) - i1_u = UBOUND(SrcServoDyn_DataData%Input,1) - IF (.NOT. ALLOCATED(DstServoDyn_DataData%Input)) THEN - ALLOCATE(DstServoDyn_DataData%Input(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstServoDyn_DataData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcServoDyn_DataData%Input,1), UBOUND(SrcServoDyn_DataData%Input,1) - CALL SrvD_CopyInput( SrcServoDyn_DataData%Input(i1), DstServoDyn_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcServoDyn_DataData%InputTimes)) THEN - i1_l = LBOUND(SrcServoDyn_DataData%InputTimes,1) - i1_u = UBOUND(SrcServoDyn_DataData%InputTimes,1) - IF (.NOT. ALLOCATED(DstServoDyn_DataData%InputTimes)) THEN - ALLOCATE(DstServoDyn_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstServoDyn_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstServoDyn_DataData%InputTimes = SrcServoDyn_DataData%InputTimes -ENDIF - END SUBROUTINE FAST_CopyServoDyn_Data - - SUBROUTINE FAST_DestroyServoDyn_Data( ServoDyn_DataData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(ServoDyn_Data), INTENT(INOUT) :: ServoDyn_DataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyServoDyn_Data' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -DO i1 = LBOUND(ServoDyn_DataData%x,1), UBOUND(ServoDyn_DataData%x,1) - CALL SrvD_DestroyContState( ServoDyn_DataData%x(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(ServoDyn_DataData%xd,1), UBOUND(ServoDyn_DataData%xd,1) - CALL SrvD_DestroyDiscState( ServoDyn_DataData%xd(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(ServoDyn_DataData%z,1), UBOUND(ServoDyn_DataData%z,1) - CALL SrvD_DestroyConstrState( ServoDyn_DataData%z(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(ServoDyn_DataData%OtherSt,1), UBOUND(ServoDyn_DataData%OtherSt,1) - CALL SrvD_DestroyOtherState( ServoDyn_DataData%OtherSt(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - CALL SrvD_DestroyParam( ServoDyn_DataData%p, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SrvD_DestroyInput( ServoDyn_DataData%u, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SrvD_DestroyOutput( ServoDyn_DataData%y, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SrvD_DestroyMisc( ServoDyn_DataData%m, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(ServoDyn_DataData%Output)) THEN -DO i1 = LBOUND(ServoDyn_DataData%Output,1), UBOUND(ServoDyn_DataData%Output,1) - CALL SrvD_DestroyOutput( ServoDyn_DataData%Output(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ServoDyn_DataData%Output) -ENDIF - CALL SrvD_DestroyOutput( ServoDyn_DataData%y_interp, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(ServoDyn_DataData%Input)) THEN -DO i1 = LBOUND(ServoDyn_DataData%Input,1), UBOUND(ServoDyn_DataData%Input,1) - CALL SrvD_DestroyInput( ServoDyn_DataData%Input(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ServoDyn_DataData%Input) -ENDIF -IF (ALLOCATED(ServoDyn_DataData%InputTimes)) THEN - DEALLOCATE(ServoDyn_DataData%InputTimes) -ENDIF - END SUBROUTINE FAST_DestroyServoDyn_Data - - SUBROUTINE FAST_PackServoDyn_Data( 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(ServoDyn_Data), 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 = 'FAST_PackServoDyn_Data' - ! 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) - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - Int_BufSz = Int_BufSz + 3 ! x: size of buffers for each call to pack subtype - CALL SrvD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype - CALL SrvD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xd - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype - CALL SrvD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! z - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! z - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! z - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - Int_BufSz = Int_BufSz + 3 ! OtherSt: size of buffers for each call to pack subtype - CALL SrvD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype - CALL SrvD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! p - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! p - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! p - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype - CALL SrvD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype - CALL SrvD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype - CALL SrvD_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! m - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! m - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! m - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! Output allocated yes/no - IF ( ALLOCATED(InData%Output) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Output upper/lower bounds for each dimension - DO i1 = LBOUND(InData%Output,1), UBOUND(InData%Output,1) - Int_BufSz = Int_BufSz + 3 ! Output: size of buffers for each call to pack subtype - CALL SrvD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Output(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Output - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Output - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Output - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Output - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! y_interp: size of buffers for each call to pack subtype - CALL SrvD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_interp, ErrStat2, ErrMsg2, .TRUE. ) ! y_interp - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y_interp - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y_interp - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y_interp - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! Input allocated yes/no - IF ( ALLOCATED(InData%Input) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Input upper/lower bounds for each dimension - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - Int_BufSz = Int_BufSz + 3 ! Input: size of buffers for each call to pack subtype - CALL SrvD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Input - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Input - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Input - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! InputTimes allocated yes/no - IF ( ALLOCATED(InData%InputTimes) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! InputTimes upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes - 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 i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - CALL SrvD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, OnlySize ) ! x - 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 - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - CALL SrvD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd - 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 - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - CALL SrvD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, OnlySize ) ! z - 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 - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - CALL SrvD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt - 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 - CALL SrvD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! p - 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 SrvD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u - 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 SrvD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y - 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 SrvD_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! m - 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%Output) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Output,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Output,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Output,1), UBOUND(InData%Output,1) - CALL SrvD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Output(i1), ErrStat2, ErrMsg2, OnlySize ) ! Output - 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 - CALL SrvD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_interp, ErrStat2, ErrMsg2, OnlySize ) ! y_interp - 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%Input) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Input,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - CALL SrvD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input - 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%InputTimes) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InputTimes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%InputTimes,1), UBOUND(InData%InputTimes,1) - DbKiBuf(Db_Xferred) = InData%InputTimes(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE FAST_PackServoDyn_Data - - SUBROUTINE FAST_UnPackServoDyn_Data( 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(ServoDyn_Data), 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 = 'FAST_UnPackServoDyn_Data' - ! 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%x,1) - i1_u = UBOUND(OutData%x,1) - DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,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_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x(i1), ErrStat2, ErrMsg2 ) ! x - 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 - i1_l = LBOUND(OutData%xd,1) - i1_u = UBOUND(OutData%xd,1) - DO i1 = LBOUND(OutData%xd,1), UBOUND(OutData%xd,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_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1), ErrStat2, ErrMsg2 ) ! xd - 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 - i1_l = LBOUND(OutData%z,1) - i1_u = UBOUND(OutData%z,1) - DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,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_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1), ErrStat2, ErrMsg2 ) ! z - 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 - i1_l = LBOUND(OutData%OtherSt,1) - i1_u = UBOUND(OutData%OtherSt,1) - DO i1 = LBOUND(OutData%OtherSt,1), UBOUND(OutData%OtherSt,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_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt(i1), ErrStat2, ErrMsg2 ) ! OtherSt - 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 - 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_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p - 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 SrvD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u - 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 SrvD_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y - 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 SrvD_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! m - 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 ! Output not allocated - Int_Xferred = Int_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%Output)) DEALLOCATE(OutData%Output) - ALLOCATE(OutData%Output(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Output,1), UBOUND(OutData%Output,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_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%Output(i1), ErrStat2, ErrMsg2 ) ! Output - 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 - 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_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y_interp, ErrStat2, ErrMsg2 ) ! y_interp - 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 ! Input not allocated - Int_Xferred = Int_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%Input)) DEALLOCATE(OutData%Input) - ALLOCATE(OutData%Input(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Input,1), UBOUND(OutData%Input,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_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input(i1), ErrStat2, ErrMsg2 ) ! Input - 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 ! InputTimes not allocated - Int_Xferred = Int_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%InputTimes)) DEALLOCATE(OutData%InputTimes) - ALLOCATE(OutData%InputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%InputTimes,1), UBOUND(OutData%InputTimes,1) - OutData%InputTimes(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE FAST_UnPackServoDyn_Data - - SUBROUTINE FAST_CopyAeroDyn14_Data( SrcAeroDyn14_DataData, DstAeroDyn14_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AeroDyn14_Data), INTENT(INOUT) :: SrcAeroDyn14_DataData - TYPE(AeroDyn14_Data), INTENT(INOUT) :: DstAeroDyn14_DataData - 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 = 'FAST_CopyAeroDyn14_Data' -! + ErrMsg = '' + if (allocated(SrcLinTypeData%Names_u)) then + LB(1:1) = lbound(SrcLinTypeData%Names_u) + UB(1:1) = ubound(SrcLinTypeData%Names_u) + if (.not. allocated(DstLinTypeData%Names_u)) then + allocate(DstLinTypeData%Names_u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%Names_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinTypeData%Names_u = SrcLinTypeData%Names_u + end if + if (allocated(SrcLinTypeData%Names_y)) then + LB(1:1) = lbound(SrcLinTypeData%Names_y) + UB(1:1) = ubound(SrcLinTypeData%Names_y) + if (.not. allocated(DstLinTypeData%Names_y)) then + allocate(DstLinTypeData%Names_y(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%Names_y.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinTypeData%Names_y = SrcLinTypeData%Names_y + end if + if (allocated(SrcLinTypeData%Names_x)) then + LB(1:1) = lbound(SrcLinTypeData%Names_x) + UB(1:1) = ubound(SrcLinTypeData%Names_x) + if (.not. allocated(DstLinTypeData%Names_x)) then + allocate(DstLinTypeData%Names_x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%Names_x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinTypeData%Names_x = SrcLinTypeData%Names_x + end if + if (allocated(SrcLinTypeData%Names_xd)) then + LB(1:1) = lbound(SrcLinTypeData%Names_xd) + UB(1:1) = ubound(SrcLinTypeData%Names_xd) + if (.not. allocated(DstLinTypeData%Names_xd)) then + allocate(DstLinTypeData%Names_xd(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%Names_xd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinTypeData%Names_xd = SrcLinTypeData%Names_xd + end if + if (allocated(SrcLinTypeData%Names_z)) then + LB(1:1) = lbound(SrcLinTypeData%Names_z) + UB(1:1) = ubound(SrcLinTypeData%Names_z) + if (.not. allocated(DstLinTypeData%Names_z)) then + allocate(DstLinTypeData%Names_z(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%Names_z.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinTypeData%Names_z = SrcLinTypeData%Names_z + end if + if (allocated(SrcLinTypeData%op_u)) then + LB(1:1) = lbound(SrcLinTypeData%op_u) + UB(1:1) = ubound(SrcLinTypeData%op_u) + if (.not. allocated(DstLinTypeData%op_u)) then + allocate(DstLinTypeData%op_u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%op_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinTypeData%op_u = SrcLinTypeData%op_u + end if + if (allocated(SrcLinTypeData%op_y)) then + LB(1:1) = lbound(SrcLinTypeData%op_y) + UB(1:1) = ubound(SrcLinTypeData%op_y) + if (.not. allocated(DstLinTypeData%op_y)) then + allocate(DstLinTypeData%op_y(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%op_y.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinTypeData%op_y = SrcLinTypeData%op_y + end if + if (allocated(SrcLinTypeData%op_x)) then + LB(1:1) = lbound(SrcLinTypeData%op_x) + UB(1:1) = ubound(SrcLinTypeData%op_x) + if (.not. allocated(DstLinTypeData%op_x)) then + allocate(DstLinTypeData%op_x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%op_x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinTypeData%op_x = SrcLinTypeData%op_x + end if + if (allocated(SrcLinTypeData%op_dx)) then + LB(1:1) = lbound(SrcLinTypeData%op_dx) + UB(1:1) = ubound(SrcLinTypeData%op_dx) + if (.not. allocated(DstLinTypeData%op_dx)) then + allocate(DstLinTypeData%op_dx(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%op_dx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinTypeData%op_dx = SrcLinTypeData%op_dx + end if + if (allocated(SrcLinTypeData%op_xd)) then + LB(1:1) = lbound(SrcLinTypeData%op_xd) + UB(1:1) = ubound(SrcLinTypeData%op_xd) + if (.not. allocated(DstLinTypeData%op_xd)) then + allocate(DstLinTypeData%op_xd(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%op_xd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinTypeData%op_xd = SrcLinTypeData%op_xd + end if + if (allocated(SrcLinTypeData%op_z)) then + LB(1:1) = lbound(SrcLinTypeData%op_z) + UB(1:1) = ubound(SrcLinTypeData%op_z) + if (.not. allocated(DstLinTypeData%op_z)) then + allocate(DstLinTypeData%op_z(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%op_z.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinTypeData%op_z = SrcLinTypeData%op_z + end if + if (allocated(SrcLinTypeData%op_x_eig_mag)) then + LB(1:1) = lbound(SrcLinTypeData%op_x_eig_mag) + UB(1:1) = ubound(SrcLinTypeData%op_x_eig_mag) + if (.not. allocated(DstLinTypeData%op_x_eig_mag)) then + allocate(DstLinTypeData%op_x_eig_mag(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%op_x_eig_mag.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinTypeData%op_x_eig_mag = SrcLinTypeData%op_x_eig_mag + end if + if (allocated(SrcLinTypeData%op_x_eig_phase)) then + LB(1:1) = lbound(SrcLinTypeData%op_x_eig_phase) + UB(1:1) = ubound(SrcLinTypeData%op_x_eig_phase) + if (.not. allocated(DstLinTypeData%op_x_eig_phase)) then + allocate(DstLinTypeData%op_x_eig_phase(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%op_x_eig_phase.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinTypeData%op_x_eig_phase = SrcLinTypeData%op_x_eig_phase + end if + if (allocated(SrcLinTypeData%Use_u)) then + LB(1:1) = lbound(SrcLinTypeData%Use_u) + UB(1:1) = ubound(SrcLinTypeData%Use_u) + if (.not. allocated(DstLinTypeData%Use_u)) then + allocate(DstLinTypeData%Use_u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%Use_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinTypeData%Use_u = SrcLinTypeData%Use_u + end if + if (allocated(SrcLinTypeData%Use_y)) then + LB(1:1) = lbound(SrcLinTypeData%Use_y) + UB(1:1) = ubound(SrcLinTypeData%Use_y) + if (.not. allocated(DstLinTypeData%Use_y)) then + allocate(DstLinTypeData%Use_y(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%Use_y.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinTypeData%Use_y = SrcLinTypeData%Use_y + end if + if (allocated(SrcLinTypeData%A)) then + LB(1:2) = lbound(SrcLinTypeData%A) + UB(1:2) = ubound(SrcLinTypeData%A) + if (.not. allocated(DstLinTypeData%A)) then + allocate(DstLinTypeData%A(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%A.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinTypeData%A = SrcLinTypeData%A + end if + if (allocated(SrcLinTypeData%B)) then + LB(1:2) = lbound(SrcLinTypeData%B) + UB(1:2) = ubound(SrcLinTypeData%B) + if (.not. allocated(DstLinTypeData%B)) then + allocate(DstLinTypeData%B(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%B.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinTypeData%B = SrcLinTypeData%B + end if + if (allocated(SrcLinTypeData%C)) then + LB(1:2) = lbound(SrcLinTypeData%C) + UB(1:2) = ubound(SrcLinTypeData%C) + if (.not. allocated(DstLinTypeData%C)) then + allocate(DstLinTypeData%C(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%C.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinTypeData%C = SrcLinTypeData%C + end if + if (allocated(SrcLinTypeData%D)) then + LB(1:2) = lbound(SrcLinTypeData%D) + UB(1:2) = ubound(SrcLinTypeData%D) + if (.not. allocated(DstLinTypeData%D)) then + allocate(DstLinTypeData%D(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%D.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinTypeData%D = SrcLinTypeData%D + end if + if (allocated(SrcLinTypeData%StateRotation)) then + LB(1:2) = lbound(SrcLinTypeData%StateRotation) + UB(1:2) = ubound(SrcLinTypeData%StateRotation) + if (.not. allocated(DstLinTypeData%StateRotation)) then + allocate(DstLinTypeData%StateRotation(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%StateRotation.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinTypeData%StateRotation = SrcLinTypeData%StateRotation + end if + if (allocated(SrcLinTypeData%StateRel_x)) then + LB(1:2) = lbound(SrcLinTypeData%StateRel_x) + UB(1:2) = ubound(SrcLinTypeData%StateRel_x) + if (.not. allocated(DstLinTypeData%StateRel_x)) then + allocate(DstLinTypeData%StateRel_x(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%StateRel_x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinTypeData%StateRel_x = SrcLinTypeData%StateRel_x + end if + if (allocated(SrcLinTypeData%StateRel_xdot)) then + LB(1:2) = lbound(SrcLinTypeData%StateRel_xdot) + UB(1:2) = ubound(SrcLinTypeData%StateRel_xdot) + if (.not. allocated(DstLinTypeData%StateRel_xdot)) then + allocate(DstLinTypeData%StateRel_xdot(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%StateRel_xdot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinTypeData%StateRel_xdot = SrcLinTypeData%StateRel_xdot + end if + if (allocated(SrcLinTypeData%IsLoad_u)) then + LB(1:1) = lbound(SrcLinTypeData%IsLoad_u) + UB(1:1) = ubound(SrcLinTypeData%IsLoad_u) + if (.not. allocated(DstLinTypeData%IsLoad_u)) then + allocate(DstLinTypeData%IsLoad_u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%IsLoad_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinTypeData%IsLoad_u = SrcLinTypeData%IsLoad_u + end if + if (allocated(SrcLinTypeData%RotFrame_u)) then + LB(1:1) = lbound(SrcLinTypeData%RotFrame_u) + UB(1:1) = ubound(SrcLinTypeData%RotFrame_u) + if (.not. allocated(DstLinTypeData%RotFrame_u)) then + allocate(DstLinTypeData%RotFrame_u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%RotFrame_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinTypeData%RotFrame_u = SrcLinTypeData%RotFrame_u + end if + if (allocated(SrcLinTypeData%RotFrame_y)) then + LB(1:1) = lbound(SrcLinTypeData%RotFrame_y) + UB(1:1) = ubound(SrcLinTypeData%RotFrame_y) + if (.not. allocated(DstLinTypeData%RotFrame_y)) then + allocate(DstLinTypeData%RotFrame_y(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%RotFrame_y.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinTypeData%RotFrame_y = SrcLinTypeData%RotFrame_y + end if + if (allocated(SrcLinTypeData%RotFrame_x)) then + LB(1:1) = lbound(SrcLinTypeData%RotFrame_x) + UB(1:1) = ubound(SrcLinTypeData%RotFrame_x) + if (.not. allocated(DstLinTypeData%RotFrame_x)) then + allocate(DstLinTypeData%RotFrame_x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%RotFrame_x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinTypeData%RotFrame_x = SrcLinTypeData%RotFrame_x + end if + if (allocated(SrcLinTypeData%RotFrame_z)) then + LB(1:1) = lbound(SrcLinTypeData%RotFrame_z) + UB(1:1) = ubound(SrcLinTypeData%RotFrame_z) + if (.not. allocated(DstLinTypeData%RotFrame_z)) then + allocate(DstLinTypeData%RotFrame_z(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%RotFrame_z.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinTypeData%RotFrame_z = SrcLinTypeData%RotFrame_z + end if + if (allocated(SrcLinTypeData%DerivOrder_x)) then + LB(1:1) = lbound(SrcLinTypeData%DerivOrder_x) + UB(1:1) = ubound(SrcLinTypeData%DerivOrder_x) + if (.not. allocated(DstLinTypeData%DerivOrder_x)) then + allocate(DstLinTypeData%DerivOrder_x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%DerivOrder_x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinTypeData%DerivOrder_x = SrcLinTypeData%DerivOrder_x + end if + DstLinTypeData%SizeLin = SrcLinTypeData%SizeLin + DstLinTypeData%LinStartIndx = SrcLinTypeData%LinStartIndx + DstLinTypeData%NumOutputs = SrcLinTypeData%NumOutputs +end subroutine + +subroutine FAST_DestroyLinType(LinTypeData, ErrStat, ErrMsg) + type(FAST_LinType), intent(inout) :: LinTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FAST_DestroyLinType' ErrStat = ErrID_None - ErrMsg = "" - DO i1 = LBOUND(SrcAeroDyn14_DataData%x,1), UBOUND(SrcAeroDyn14_DataData%x,1) - CALL AD14_CopyContState( SrcAeroDyn14_DataData%x(i1), DstAeroDyn14_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcAeroDyn14_DataData%xd,1), UBOUND(SrcAeroDyn14_DataData%xd,1) - CALL AD14_CopyDiscState( SrcAeroDyn14_DataData%xd(i1), DstAeroDyn14_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcAeroDyn14_DataData%z,1), UBOUND(SrcAeroDyn14_DataData%z,1) - CALL AD14_CopyConstrState( SrcAeroDyn14_DataData%z(i1), DstAeroDyn14_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcAeroDyn14_DataData%OtherSt,1), UBOUND(SrcAeroDyn14_DataData%OtherSt,1) - CALL AD14_CopyOtherState( SrcAeroDyn14_DataData%OtherSt(i1), DstAeroDyn14_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - CALL AD14_CopyParam( SrcAeroDyn14_DataData%p, DstAeroDyn14_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD14_CopyInput( SrcAeroDyn14_DataData%u, DstAeroDyn14_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD14_CopyOutput( SrcAeroDyn14_DataData%y, DstAeroDyn14_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD14_CopyMisc( SrcAeroDyn14_DataData%m, DstAeroDyn14_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcAeroDyn14_DataData%Input)) THEN - i1_l = LBOUND(SrcAeroDyn14_DataData%Input,1) - i1_u = UBOUND(SrcAeroDyn14_DataData%Input,1) - IF (.NOT. ALLOCATED(DstAeroDyn14_DataData%Input)) THEN - ALLOCATE(DstAeroDyn14_DataData%Input(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstAeroDyn14_DataData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcAeroDyn14_DataData%Input,1), UBOUND(SrcAeroDyn14_DataData%Input,1) - CALL AD14_CopyInput( SrcAeroDyn14_DataData%Input(i1), DstAeroDyn14_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcAeroDyn14_DataData%InputTimes)) THEN - i1_l = LBOUND(SrcAeroDyn14_DataData%InputTimes,1) - i1_u = UBOUND(SrcAeroDyn14_DataData%InputTimes,1) - IF (.NOT. ALLOCATED(DstAeroDyn14_DataData%InputTimes)) THEN - ALLOCATE(DstAeroDyn14_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstAeroDyn14_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstAeroDyn14_DataData%InputTimes = SrcAeroDyn14_DataData%InputTimes -ENDIF - END SUBROUTINE FAST_CopyAeroDyn14_Data - - SUBROUTINE FAST_DestroyAeroDyn14_Data( AeroDyn14_DataData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(AeroDyn14_Data), INTENT(INOUT) :: AeroDyn14_DataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyAeroDyn14_Data' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -DO i1 = LBOUND(AeroDyn14_DataData%x,1), UBOUND(AeroDyn14_DataData%x,1) - CALL AD14_DestroyContState( AeroDyn14_DataData%x(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(AeroDyn14_DataData%xd,1), UBOUND(AeroDyn14_DataData%xd,1) - CALL AD14_DestroyDiscState( AeroDyn14_DataData%xd(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(AeroDyn14_DataData%z,1), UBOUND(AeroDyn14_DataData%z,1) - CALL AD14_DestroyConstrState( AeroDyn14_DataData%z(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(AeroDyn14_DataData%OtherSt,1), UBOUND(AeroDyn14_DataData%OtherSt,1) - CALL AD14_DestroyOtherState( AeroDyn14_DataData%OtherSt(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - CALL AD14_DestroyParam( AeroDyn14_DataData%p, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD14_DestroyInput( AeroDyn14_DataData%u, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD14_DestroyOutput( AeroDyn14_DataData%y, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD14_DestroyMisc( AeroDyn14_DataData%m, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(AeroDyn14_DataData%Input)) THEN -DO i1 = LBOUND(AeroDyn14_DataData%Input,1), UBOUND(AeroDyn14_DataData%Input,1) - CALL AD14_DestroyInput( AeroDyn14_DataData%Input(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(AeroDyn14_DataData%Input) -ENDIF -IF (ALLOCATED(AeroDyn14_DataData%InputTimes)) THEN - DEALLOCATE(AeroDyn14_DataData%InputTimes) -ENDIF - END SUBROUTINE FAST_DestroyAeroDyn14_Data - - SUBROUTINE FAST_PackAeroDyn14_Data( 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(AeroDyn14_Data), 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 = 'FAST_PackAeroDyn14_Data' - ! 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) - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - Int_BufSz = Int_BufSz + 3 ! x: size of buffers for each call to pack subtype - CALL AD14_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype - CALL AD14_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xd - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype - CALL AD14_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! z - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! z - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! z - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - Int_BufSz = Int_BufSz + 3 ! OtherSt: size of buffers for each call to pack subtype - CALL AD14_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype - CALL AD14_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! p - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! p - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! p - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype - CALL AD14_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype - CALL AD14_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype - CALL AD14_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! m - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! m - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! m - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! Input allocated yes/no - IF ( ALLOCATED(InData%Input) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Input upper/lower bounds for each dimension - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - Int_BufSz = Int_BufSz + 3 ! Input: size of buffers for each call to pack subtype - CALL AD14_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Input - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Input - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Input - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! InputTimes allocated yes/no - IF ( ALLOCATED(InData%InputTimes) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! InputTimes upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes - 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 i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - CALL AD14_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, OnlySize ) ! x - 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 - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - CALL AD14_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd - 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 - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - CALL AD14_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, OnlySize ) ! z - 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 - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - CALL AD14_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt - 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 - CALL AD14_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! p - 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 AD14_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u - 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 AD14_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y - 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 AD14_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! m - 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%Input) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Input,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - CALL AD14_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input - 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%InputTimes) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InputTimes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%InputTimes,1), UBOUND(InData%InputTimes,1) - DbKiBuf(Db_Xferred) = InData%InputTimes(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE FAST_PackAeroDyn14_Data - - SUBROUTINE FAST_UnPackAeroDyn14_Data( 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(AeroDyn14_Data), 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 = 'FAST_UnPackAeroDyn14_Data' - ! 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%x,1) - i1_u = UBOUND(OutData%x,1) - DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,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 AD14_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x(i1), ErrStat2, ErrMsg2 ) ! x - 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 - i1_l = LBOUND(OutData%xd,1) - i1_u = UBOUND(OutData%xd,1) - DO i1 = LBOUND(OutData%xd,1), UBOUND(OutData%xd,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 AD14_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1), ErrStat2, ErrMsg2 ) ! xd - 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 - i1_l = LBOUND(OutData%z,1) - i1_u = UBOUND(OutData%z,1) - DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,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 AD14_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1), ErrStat2, ErrMsg2 ) ! z - 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 - i1_l = LBOUND(OutData%OtherSt,1) - i1_u = UBOUND(OutData%OtherSt,1) - DO i1 = LBOUND(OutData%OtherSt,1), UBOUND(OutData%OtherSt,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 AD14_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt(i1), ErrStat2, ErrMsg2 ) ! OtherSt - 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 - 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 AD14_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p - 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 AD14_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u - 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 AD14_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y - 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 AD14_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! m - 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 ! Input not allocated - Int_Xferred = Int_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%Input)) DEALLOCATE(OutData%Input) - ALLOCATE(OutData%Input(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Input,1), UBOUND(OutData%Input,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 AD14_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input(i1), ErrStat2, ErrMsg2 ) ! Input - 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 ! InputTimes not allocated - Int_Xferred = Int_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%InputTimes)) DEALLOCATE(OutData%InputTimes) - ALLOCATE(OutData%InputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%InputTimes,1), UBOUND(OutData%InputTimes,1) - OutData%InputTimes(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE FAST_UnPackAeroDyn14_Data - - SUBROUTINE FAST_CopyAeroDyn_Data( SrcAeroDyn_DataData, DstAeroDyn_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AeroDyn_Data), INTENT(INOUT) :: SrcAeroDyn_DataData - TYPE(AeroDyn_Data), INTENT(INOUT) :: DstAeroDyn_DataData - 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 = 'FAST_CopyAeroDyn_Data' -! + ErrMsg = '' + if (allocated(LinTypeData%Names_u)) then + deallocate(LinTypeData%Names_u) + end if + if (allocated(LinTypeData%Names_y)) then + deallocate(LinTypeData%Names_y) + end if + if (allocated(LinTypeData%Names_x)) then + deallocate(LinTypeData%Names_x) + end if + if (allocated(LinTypeData%Names_xd)) then + deallocate(LinTypeData%Names_xd) + end if + if (allocated(LinTypeData%Names_z)) then + deallocate(LinTypeData%Names_z) + end if + if (allocated(LinTypeData%op_u)) then + deallocate(LinTypeData%op_u) + end if + if (allocated(LinTypeData%op_y)) then + deallocate(LinTypeData%op_y) + end if + if (allocated(LinTypeData%op_x)) then + deallocate(LinTypeData%op_x) + end if + if (allocated(LinTypeData%op_dx)) then + deallocate(LinTypeData%op_dx) + end if + if (allocated(LinTypeData%op_xd)) then + deallocate(LinTypeData%op_xd) + end if + if (allocated(LinTypeData%op_z)) then + deallocate(LinTypeData%op_z) + end if + if (allocated(LinTypeData%op_x_eig_mag)) then + deallocate(LinTypeData%op_x_eig_mag) + end if + if (allocated(LinTypeData%op_x_eig_phase)) then + deallocate(LinTypeData%op_x_eig_phase) + end if + if (allocated(LinTypeData%Use_u)) then + deallocate(LinTypeData%Use_u) + end if + if (allocated(LinTypeData%Use_y)) then + deallocate(LinTypeData%Use_y) + end if + if (allocated(LinTypeData%A)) then + deallocate(LinTypeData%A) + end if + if (allocated(LinTypeData%B)) then + deallocate(LinTypeData%B) + end if + if (allocated(LinTypeData%C)) then + deallocate(LinTypeData%C) + end if + if (allocated(LinTypeData%D)) then + deallocate(LinTypeData%D) + end if + if (allocated(LinTypeData%StateRotation)) then + deallocate(LinTypeData%StateRotation) + end if + if (allocated(LinTypeData%StateRel_x)) then + deallocate(LinTypeData%StateRel_x) + end if + if (allocated(LinTypeData%StateRel_xdot)) then + deallocate(LinTypeData%StateRel_xdot) + end if + if (allocated(LinTypeData%IsLoad_u)) then + deallocate(LinTypeData%IsLoad_u) + end if + if (allocated(LinTypeData%RotFrame_u)) then + deallocate(LinTypeData%RotFrame_u) + end if + if (allocated(LinTypeData%RotFrame_y)) then + deallocate(LinTypeData%RotFrame_y) + end if + if (allocated(LinTypeData%RotFrame_x)) then + deallocate(LinTypeData%RotFrame_x) + end if + if (allocated(LinTypeData%RotFrame_z)) then + deallocate(LinTypeData%RotFrame_z) + end if + if (allocated(LinTypeData%DerivOrder_x)) then + deallocate(LinTypeData%DerivOrder_x) + end if +end subroutine + +subroutine FAST_PackLinType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(FAST_LinType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackLinType' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%Names_u) + call RegPackAlloc(RF, InData%Names_y) + call RegPackAlloc(RF, InData%Names_x) + call RegPackAlloc(RF, InData%Names_xd) + call RegPackAlloc(RF, InData%Names_z) + call RegPackAlloc(RF, InData%op_u) + call RegPackAlloc(RF, InData%op_y) + call RegPackAlloc(RF, InData%op_x) + call RegPackAlloc(RF, InData%op_dx) + call RegPackAlloc(RF, InData%op_xd) + call RegPackAlloc(RF, InData%op_z) + call RegPackAlloc(RF, InData%op_x_eig_mag) + call RegPackAlloc(RF, InData%op_x_eig_phase) + call RegPackAlloc(RF, InData%Use_u) + call RegPackAlloc(RF, InData%Use_y) + call RegPackAlloc(RF, InData%A) + call RegPackAlloc(RF, InData%B) + call RegPackAlloc(RF, InData%C) + call RegPackAlloc(RF, InData%D) + call RegPackAlloc(RF, InData%StateRotation) + call RegPackAlloc(RF, InData%StateRel_x) + call RegPackAlloc(RF, InData%StateRel_xdot) + call RegPackAlloc(RF, InData%IsLoad_u) + call RegPackAlloc(RF, InData%RotFrame_u) + call RegPackAlloc(RF, InData%RotFrame_y) + call RegPackAlloc(RF, InData%RotFrame_x) + call RegPackAlloc(RF, InData%RotFrame_z) + call RegPackAlloc(RF, InData%DerivOrder_x) + call RegPack(RF, InData%SizeLin) + call RegPack(RF, InData%LinStartIndx) + call RegPack(RF, InData%NumOutputs) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FAST_UnPackLinType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(FAST_LinType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackLinType' + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%Names_u); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Names_y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Names_x); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Names_xd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Names_z); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%op_u); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%op_y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%op_x); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%op_dx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%op_xd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%op_z); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%op_x_eig_mag); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%op_x_eig_phase); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Use_u); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Use_y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%A); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%B); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%C); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%D); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%StateRotation); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%StateRel_x); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%StateRel_xdot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%IsLoad_u); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%RotFrame_u); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%RotFrame_y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%RotFrame_x); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%RotFrame_z); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%DerivOrder_x); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SizeLin); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LinStartIndx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumOutputs); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FAST_CopyModLinType(SrcModLinTypeData, DstModLinTypeData, CtrlCode, ErrStat, ErrMsg) + type(FAST_ModLinType), intent(in) :: SrcModLinTypeData + type(FAST_ModLinType), intent(inout) :: DstModLinTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_CopyModLinType' ErrStat = ErrID_None - ErrMsg = "" - DO i1 = LBOUND(SrcAeroDyn_DataData%x,1), UBOUND(SrcAeroDyn_DataData%x,1) - CALL AD_CopyContState( SrcAeroDyn_DataData%x(i1), DstAeroDyn_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcAeroDyn_DataData%xd,1), UBOUND(SrcAeroDyn_DataData%xd,1) - CALL AD_CopyDiscState( SrcAeroDyn_DataData%xd(i1), DstAeroDyn_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcAeroDyn_DataData%z,1), UBOUND(SrcAeroDyn_DataData%z,1) - CALL AD_CopyConstrState( SrcAeroDyn_DataData%z(i1), DstAeroDyn_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcAeroDyn_DataData%OtherSt,1), UBOUND(SrcAeroDyn_DataData%OtherSt,1) - CALL AD_CopyOtherState( SrcAeroDyn_DataData%OtherSt(i1), DstAeroDyn_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - CALL AD_CopyParam( SrcAeroDyn_DataData%p, DstAeroDyn_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD_CopyInput( SrcAeroDyn_DataData%u, DstAeroDyn_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD_CopyOutput( SrcAeroDyn_DataData%y, DstAeroDyn_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD_CopyMisc( SrcAeroDyn_DataData%m, DstAeroDyn_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcAeroDyn_DataData%Output)) THEN - i1_l = LBOUND(SrcAeroDyn_DataData%Output,1) - i1_u = UBOUND(SrcAeroDyn_DataData%Output,1) - IF (.NOT. ALLOCATED(DstAeroDyn_DataData%Output)) THEN - ALLOCATE(DstAeroDyn_DataData%Output(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstAeroDyn_DataData%Output.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcAeroDyn_DataData%Output,1), UBOUND(SrcAeroDyn_DataData%Output,1) - CALL AD_CopyOutput( SrcAeroDyn_DataData%Output(i1), DstAeroDyn_DataData%Output(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL AD_CopyOutput( SrcAeroDyn_DataData%y_interp, DstAeroDyn_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcAeroDyn_DataData%Input)) THEN - i1_l = LBOUND(SrcAeroDyn_DataData%Input,1) - i1_u = UBOUND(SrcAeroDyn_DataData%Input,1) - IF (.NOT. ALLOCATED(DstAeroDyn_DataData%Input)) THEN - ALLOCATE(DstAeroDyn_DataData%Input(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstAeroDyn_DataData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcAeroDyn_DataData%Input,1), UBOUND(SrcAeroDyn_DataData%Input,1) - CALL AD_CopyInput( SrcAeroDyn_DataData%Input(i1), DstAeroDyn_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcAeroDyn_DataData%InputTimes)) THEN - i1_l = LBOUND(SrcAeroDyn_DataData%InputTimes,1) - i1_u = UBOUND(SrcAeroDyn_DataData%InputTimes,1) - IF (.NOT. ALLOCATED(DstAeroDyn_DataData%InputTimes)) THEN - ALLOCATE(DstAeroDyn_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstAeroDyn_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstAeroDyn_DataData%InputTimes = SrcAeroDyn_DataData%InputTimes -ENDIF - END SUBROUTINE FAST_CopyAeroDyn_Data - - SUBROUTINE FAST_DestroyAeroDyn_Data( AeroDyn_DataData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(AeroDyn_Data), INTENT(INOUT) :: AeroDyn_DataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyAeroDyn_Data' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -DO i1 = LBOUND(AeroDyn_DataData%x,1), UBOUND(AeroDyn_DataData%x,1) - CALL AD_DestroyContState( AeroDyn_DataData%x(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(AeroDyn_DataData%xd,1), UBOUND(AeroDyn_DataData%xd,1) - CALL AD_DestroyDiscState( AeroDyn_DataData%xd(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(AeroDyn_DataData%z,1), UBOUND(AeroDyn_DataData%z,1) - CALL AD_DestroyConstrState( AeroDyn_DataData%z(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(AeroDyn_DataData%OtherSt,1), UBOUND(AeroDyn_DataData%OtherSt,1) - CALL AD_DestroyOtherState( AeroDyn_DataData%OtherSt(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - CALL AD_DestroyParam( AeroDyn_DataData%p, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD_DestroyInput( AeroDyn_DataData%u, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD_DestroyOutput( AeroDyn_DataData%y, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD_DestroyMisc( AeroDyn_DataData%m, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(AeroDyn_DataData%Output)) THEN -DO i1 = LBOUND(AeroDyn_DataData%Output,1), UBOUND(AeroDyn_DataData%Output,1) - CALL AD_DestroyOutput( AeroDyn_DataData%Output(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(AeroDyn_DataData%Output) -ENDIF - CALL AD_DestroyOutput( AeroDyn_DataData%y_interp, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(AeroDyn_DataData%Input)) THEN -DO i1 = LBOUND(AeroDyn_DataData%Input,1), UBOUND(AeroDyn_DataData%Input,1) - CALL AD_DestroyInput( AeroDyn_DataData%Input(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(AeroDyn_DataData%Input) -ENDIF -IF (ALLOCATED(AeroDyn_DataData%InputTimes)) THEN - DEALLOCATE(AeroDyn_DataData%InputTimes) -ENDIF - END SUBROUTINE FAST_DestroyAeroDyn_Data - - SUBROUTINE FAST_PackAeroDyn_Data( 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(AeroDyn_Data), 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 = 'FAST_PackAeroDyn_Data' - ! 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) - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - Int_BufSz = Int_BufSz + 3 ! x: size of buffers for each call to pack subtype - CALL AD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype - CALL AD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xd - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype - CALL AD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! z - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! z - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! z - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - Int_BufSz = Int_BufSz + 3 ! OtherSt: size of buffers for each call to pack subtype - CALL AD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype - CALL AD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! p - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! p - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! p - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype - CALL AD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype - CALL AD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype - CALL AD_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! m - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! m - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! m - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! Output allocated yes/no - IF ( ALLOCATED(InData%Output) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Output upper/lower bounds for each dimension - DO i1 = LBOUND(InData%Output,1), UBOUND(InData%Output,1) - Int_BufSz = Int_BufSz + 3 ! Output: size of buffers for each call to pack subtype - CALL AD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Output(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Output - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Output - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Output - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Output - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! y_interp: size of buffers for each call to pack subtype - CALL AD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_interp, ErrStat2, ErrMsg2, .TRUE. ) ! y_interp - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y_interp - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y_interp - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y_interp - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! Input allocated yes/no - IF ( ALLOCATED(InData%Input) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Input upper/lower bounds for each dimension - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - Int_BufSz = Int_BufSz + 3 ! Input: size of buffers for each call to pack subtype - CALL AD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Input - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Input - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Input - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! InputTimes allocated yes/no - IF ( ALLOCATED(InData%InputTimes) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! InputTimes upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes - 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 i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - CALL AD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, OnlySize ) ! x - 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 - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - CALL AD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd - 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 - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - CALL AD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, OnlySize ) ! z - 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 - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - CALL AD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt - 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 - CALL AD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! p - 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 AD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u - 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 AD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y - 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 AD_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! m - 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%Output) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Output,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Output,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Output,1), UBOUND(InData%Output,1) - CALL AD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Output(i1), ErrStat2, ErrMsg2, OnlySize ) ! Output - 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 - CALL AD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_interp, ErrStat2, ErrMsg2, OnlySize ) ! y_interp - 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%Input) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Input,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - CALL AD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input - 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%InputTimes) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InputTimes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%InputTimes,1), UBOUND(InData%InputTimes,1) - DbKiBuf(Db_Xferred) = InData%InputTimes(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE FAST_PackAeroDyn_Data - - SUBROUTINE FAST_UnPackAeroDyn_Data( 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(AeroDyn_Data), 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 = 'FAST_UnPackAeroDyn_Data' - ! 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%x,1) - i1_u = UBOUND(OutData%x,1) - DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,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 AD_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x(i1), ErrStat2, ErrMsg2 ) ! x - 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 - i1_l = LBOUND(OutData%xd,1) - i1_u = UBOUND(OutData%xd,1) - DO i1 = LBOUND(OutData%xd,1), UBOUND(OutData%xd,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 AD_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1), ErrStat2, ErrMsg2 ) ! xd - 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 - i1_l = LBOUND(OutData%z,1) - i1_u = UBOUND(OutData%z,1) - DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,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 AD_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1), ErrStat2, ErrMsg2 ) ! z - 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 - i1_l = LBOUND(OutData%OtherSt,1) - i1_u = UBOUND(OutData%OtherSt,1) - DO i1 = LBOUND(OutData%OtherSt,1), UBOUND(OutData%OtherSt,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 AD_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt(i1), ErrStat2, ErrMsg2 ) ! OtherSt - 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 - 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 AD_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p - 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 AD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u - 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 AD_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y - 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 AD_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! m - 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 ! Output not allocated - Int_Xferred = Int_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%Output)) DEALLOCATE(OutData%Output) - ALLOCATE(OutData%Output(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Output,1), UBOUND(OutData%Output,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 AD_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%Output(i1), ErrStat2, ErrMsg2 ) ! Output - 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 - 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 AD_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y_interp, ErrStat2, ErrMsg2 ) ! y_interp - 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 ! Input not allocated - Int_Xferred = Int_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%Input)) DEALLOCATE(OutData%Input) - ALLOCATE(OutData%Input(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Input,1), UBOUND(OutData%Input,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 AD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input(i1), ErrStat2, ErrMsg2 ) ! Input - 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 ! InputTimes not allocated - Int_Xferred = Int_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%InputTimes)) DEALLOCATE(OutData%InputTimes) - ALLOCATE(OutData%InputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%InputTimes,1), UBOUND(OutData%InputTimes,1) - OutData%InputTimes(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE FAST_UnPackAeroDyn_Data - - SUBROUTINE FAST_CopyInflowWind_Data( SrcInflowWind_DataData, DstInflowWind_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(InflowWind_Data), INTENT(IN) :: SrcInflowWind_DataData - TYPE(InflowWind_Data), INTENT(INOUT) :: DstInflowWind_DataData - 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 = 'FAST_CopyInflowWind_Data' -! + ErrMsg = '' + if (allocated(SrcModLinTypeData%Instance)) then + LB(1:1) = lbound(SrcModLinTypeData%Instance) + UB(1:1) = ubound(SrcModLinTypeData%Instance) + if (.not. allocated(DstModLinTypeData%Instance)) then + allocate(DstModLinTypeData%Instance(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModLinTypeData%Instance.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call FAST_CopyLinType(SrcModLinTypeData%Instance(i1), DstModLinTypeData%Instance(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if +end subroutine + +subroutine FAST_DestroyModLinType(ModLinTypeData, ErrStat, ErrMsg) + type(FAST_ModLinType), intent(inout) :: ModLinTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_DestroyModLinType' ErrStat = ErrID_None - ErrMsg = "" - DO i1 = LBOUND(SrcInflowWind_DataData%x,1), UBOUND(SrcInflowWind_DataData%x,1) - CALL InflowWind_CopyContState( SrcInflowWind_DataData%x(i1), DstInflowWind_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcInflowWind_DataData%xd,1), UBOUND(SrcInflowWind_DataData%xd,1) - CALL InflowWind_CopyDiscState( SrcInflowWind_DataData%xd(i1), DstInflowWind_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcInflowWind_DataData%z,1), UBOUND(SrcInflowWind_DataData%z,1) - CALL InflowWind_CopyConstrState( SrcInflowWind_DataData%z(i1), DstInflowWind_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcInflowWind_DataData%OtherSt,1), UBOUND(SrcInflowWind_DataData%OtherSt,1) - CALL InflowWind_CopyOtherState( SrcInflowWind_DataData%OtherSt(i1), DstInflowWind_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - CALL InflowWind_CopyParam( SrcInflowWind_DataData%p, DstInflowWind_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL InflowWind_CopyInput( SrcInflowWind_DataData%u, DstInflowWind_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL InflowWind_CopyOutput( SrcInflowWind_DataData%y, DstInflowWind_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL InflowWind_CopyMisc( SrcInflowWind_DataData%m, DstInflowWind_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcInflowWind_DataData%Output)) THEN - i1_l = LBOUND(SrcInflowWind_DataData%Output,1) - i1_u = UBOUND(SrcInflowWind_DataData%Output,1) - IF (.NOT. ALLOCATED(DstInflowWind_DataData%Output)) THEN - ALLOCATE(DstInflowWind_DataData%Output(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInflowWind_DataData%Output.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcInflowWind_DataData%Output,1), UBOUND(SrcInflowWind_DataData%Output,1) - CALL InflowWind_CopyOutput( SrcInflowWind_DataData%Output(i1), DstInflowWind_DataData%Output(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL InflowWind_CopyOutput( SrcInflowWind_DataData%y_interp, DstInflowWind_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcInflowWind_DataData%Input)) THEN - i1_l = LBOUND(SrcInflowWind_DataData%Input,1) - i1_u = UBOUND(SrcInflowWind_DataData%Input,1) - IF (.NOT. ALLOCATED(DstInflowWind_DataData%Input)) THEN - ALLOCATE(DstInflowWind_DataData%Input(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInflowWind_DataData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcInflowWind_DataData%Input,1), UBOUND(SrcInflowWind_DataData%Input,1) - CALL InflowWind_CopyInput( SrcInflowWind_DataData%Input(i1), DstInflowWind_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcInflowWind_DataData%InputTimes)) THEN - i1_l = LBOUND(SrcInflowWind_DataData%InputTimes,1) - i1_u = UBOUND(SrcInflowWind_DataData%InputTimes,1) - IF (.NOT. ALLOCATED(DstInflowWind_DataData%InputTimes)) THEN - ALLOCATE(DstInflowWind_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInflowWind_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInflowWind_DataData%InputTimes = SrcInflowWind_DataData%InputTimes -ENDIF - END SUBROUTINE FAST_CopyInflowWind_Data - - SUBROUTINE FAST_DestroyInflowWind_Data( InflowWind_DataData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(InflowWind_Data), INTENT(INOUT) :: InflowWind_DataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyInflowWind_Data' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -DO i1 = LBOUND(InflowWind_DataData%x,1), UBOUND(InflowWind_DataData%x,1) - CALL InflowWind_DestroyContState( InflowWind_DataData%x(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(InflowWind_DataData%xd,1), UBOUND(InflowWind_DataData%xd,1) - CALL InflowWind_DestroyDiscState( InflowWind_DataData%xd(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(InflowWind_DataData%z,1), UBOUND(InflowWind_DataData%z,1) - CALL InflowWind_DestroyConstrState( InflowWind_DataData%z(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(InflowWind_DataData%OtherSt,1), UBOUND(InflowWind_DataData%OtherSt,1) - CALL InflowWind_DestroyOtherState( InflowWind_DataData%OtherSt(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - CALL InflowWind_DestroyParam( InflowWind_DataData%p, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL InflowWind_DestroyInput( InflowWind_DataData%u, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL InflowWind_DestroyOutput( InflowWind_DataData%y, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL InflowWind_DestroyMisc( InflowWind_DataData%m, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(InflowWind_DataData%Output)) THEN -DO i1 = LBOUND(InflowWind_DataData%Output,1), UBOUND(InflowWind_DataData%Output,1) - CALL InflowWind_DestroyOutput( InflowWind_DataData%Output(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(InflowWind_DataData%Output) -ENDIF - CALL InflowWind_DestroyOutput( InflowWind_DataData%y_interp, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(InflowWind_DataData%Input)) THEN -DO i1 = LBOUND(InflowWind_DataData%Input,1), UBOUND(InflowWind_DataData%Input,1) - CALL InflowWind_DestroyInput( InflowWind_DataData%Input(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(InflowWind_DataData%Input) -ENDIF -IF (ALLOCATED(InflowWind_DataData%InputTimes)) THEN - DEALLOCATE(InflowWind_DataData%InputTimes) -ENDIF - END SUBROUTINE FAST_DestroyInflowWind_Data - - SUBROUTINE FAST_PackInflowWind_Data( 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(InflowWind_Data), 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 = 'FAST_PackInflowWind_Data' - ! 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) - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - Int_BufSz = Int_BufSz + 3 ! x: size of buffers for each call to pack subtype - CALL InflowWind_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype - CALL InflowWind_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xd - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype - CALL InflowWind_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! z - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! z - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! z - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - Int_BufSz = Int_BufSz + 3 ! OtherSt: size of buffers for each call to pack subtype - CALL InflowWind_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype - CALL InflowWind_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! p - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! p - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! p - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype - CALL InflowWind_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype - CALL InflowWind_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype - CALL InflowWind_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! m - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! m - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! m - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! Output allocated yes/no - IF ( ALLOCATED(InData%Output) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Output upper/lower bounds for each dimension - DO i1 = LBOUND(InData%Output,1), UBOUND(InData%Output,1) - Int_BufSz = Int_BufSz + 3 ! Output: size of buffers for each call to pack subtype - CALL InflowWind_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Output(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Output - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Output - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Output - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Output - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! y_interp: size of buffers for each call to pack subtype - CALL InflowWind_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_interp, ErrStat2, ErrMsg2, .TRUE. ) ! y_interp - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y_interp - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y_interp - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y_interp - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! Input allocated yes/no - IF ( ALLOCATED(InData%Input) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Input upper/lower bounds for each dimension - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - Int_BufSz = Int_BufSz + 3 ! Input: size of buffers for each call to pack subtype - CALL InflowWind_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Input - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Input - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Input - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! InputTimes allocated yes/no - IF ( ALLOCATED(InData%InputTimes) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! InputTimes upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes - 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 i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - CALL InflowWind_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, OnlySize ) ! x - 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 - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - CALL InflowWind_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd - 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 - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - CALL InflowWind_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, OnlySize ) ! z - 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 - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - CALL InflowWind_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt - 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 - CALL InflowWind_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! p - 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 InflowWind_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u - 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 InflowWind_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y - 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 InflowWind_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! m - 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%Output) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Output,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Output,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Output,1), UBOUND(InData%Output,1) - CALL InflowWind_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Output(i1), ErrStat2, ErrMsg2, OnlySize ) ! Output - 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 - CALL InflowWind_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_interp, ErrStat2, ErrMsg2, OnlySize ) ! y_interp - 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%Input) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Input,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - CALL InflowWind_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input - 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%InputTimes) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InputTimes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%InputTimes,1), UBOUND(InData%InputTimes,1) - DbKiBuf(Db_Xferred) = InData%InputTimes(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE FAST_PackInflowWind_Data - - SUBROUTINE FAST_UnPackInflowWind_Data( 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(InflowWind_Data), 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 = 'FAST_UnPackInflowWind_Data' - ! 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%x,1) - i1_u = UBOUND(OutData%x,1) - DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,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 InflowWind_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x(i1), ErrStat2, ErrMsg2 ) ! x - 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 - i1_l = LBOUND(OutData%xd,1) - i1_u = UBOUND(OutData%xd,1) - DO i1 = LBOUND(OutData%xd,1), UBOUND(OutData%xd,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 InflowWind_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1), ErrStat2, ErrMsg2 ) ! xd - 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 - i1_l = LBOUND(OutData%z,1) - i1_u = UBOUND(OutData%z,1) - DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,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 InflowWind_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1), ErrStat2, ErrMsg2 ) ! z - 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 - i1_l = LBOUND(OutData%OtherSt,1) - i1_u = UBOUND(OutData%OtherSt,1) - DO i1 = LBOUND(OutData%OtherSt,1), UBOUND(OutData%OtherSt,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 InflowWind_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt(i1), ErrStat2, ErrMsg2 ) ! OtherSt - 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 - 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 InflowWind_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p - 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 InflowWind_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u - 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 InflowWind_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y - 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 InflowWind_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! m - 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 ! Output not allocated - Int_Xferred = Int_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%Output)) DEALLOCATE(OutData%Output) - ALLOCATE(OutData%Output(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Output,1), UBOUND(OutData%Output,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 InflowWind_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%Output(i1), ErrStat2, ErrMsg2 ) ! Output - 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 - 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 InflowWind_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y_interp, ErrStat2, ErrMsg2 ) ! y_interp - 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 ! Input not allocated - Int_Xferred = Int_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%Input)) DEALLOCATE(OutData%Input) - ALLOCATE(OutData%Input(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Input,1), UBOUND(OutData%Input,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 InflowWind_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input(i1), ErrStat2, ErrMsg2 ) ! Input - 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 ! InputTimes not allocated - Int_Xferred = Int_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%InputTimes)) DEALLOCATE(OutData%InputTimes) - ALLOCATE(OutData%InputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%InputTimes,1), UBOUND(OutData%InputTimes,1) - OutData%InputTimes(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE FAST_UnPackInflowWind_Data - - SUBROUTINE FAST_CopyOpenFOAM_Data( SrcOpenFOAM_DataData, DstOpenFOAM_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(OpenFOAM_Data), INTENT(INOUT) :: SrcOpenFOAM_DataData - TYPE(OpenFOAM_Data), INTENT(INOUT) :: DstOpenFOAM_DataData - 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 = 'FAST_CopyOpenFOAM_Data' -! + ErrMsg = '' + if (allocated(ModLinTypeData%Instance)) then + LB(1:1) = lbound(ModLinTypeData%Instance) + UB(1:1) = ubound(ModLinTypeData%Instance) + do i1 = LB(1), UB(1) + call FAST_DestroyLinType(ModLinTypeData%Instance(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ModLinTypeData%Instance) + end if +end subroutine + +subroutine FAST_PackModLinType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(FAST_ModLinType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackModLinType' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%Instance)) + if (allocated(InData%Instance)) then + call RegPackBounds(RF, 1, lbound(InData%Instance), ubound(InData%Instance)) + LB(1:1) = lbound(InData%Instance) + UB(1:1) = ubound(InData%Instance) + do i1 = LB(1), UB(1) + call FAST_PackLinType(RF, InData%Instance(i1)) + end do + end if + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FAST_UnPackModLinType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(FAST_ModLinType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackModLinType' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + if (allocated(OutData%Instance)) deallocate(OutData%Instance) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%Instance(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Instance.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call FAST_UnpackLinType(RF, OutData%Instance(i1)) ! Instance + end do + end if +end subroutine + +subroutine FAST_CopyLinFileType(SrcLinFileTypeData, DstLinFileTypeData, CtrlCode, ErrStat, ErrMsg) + type(FAST_LinFileType), intent(in) :: SrcLinFileTypeData + type(FAST_LinFileType), intent(inout) :: DstLinFileTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_CopyLinFileType' ErrStat = ErrID_None - ErrMsg = "" - CALL OpFM_CopyInput( SrcOpenFOAM_DataData%u, DstOpenFOAM_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL OpFM_CopyOutput( SrcOpenFOAM_DataData%y, DstOpenFOAM_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL OpFM_CopyParam( SrcOpenFOAM_DataData%p, DstOpenFOAM_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL OpFM_CopyMisc( SrcOpenFOAM_DataData%m, DstOpenFOAM_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE FAST_CopyOpenFOAM_Data - - SUBROUTINE FAST_DestroyOpenFOAM_Data( OpenFOAM_DataData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(OpenFOAM_Data), INTENT(INOUT) :: OpenFOAM_DataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyOpenFOAM_Data' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL OpFM_DestroyInput( OpenFOAM_DataData%u, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL OpFM_DestroyOutput( OpenFOAM_DataData%y, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL OpFM_DestroyParam( OpenFOAM_DataData%p, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL OpFM_DestroyMisc( OpenFOAM_DataData%m, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE FAST_DestroyOpenFOAM_Data - - SUBROUTINE FAST_PackOpenFOAM_Data( 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(OpenFOAM_Data), 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 = 'FAST_PackOpenFOAM_Data' - ! 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 ! u: size of buffers for each call to pack subtype - CALL OpFM_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype - CALL OpFM_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype - CALL OpFM_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! p - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! p - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! p - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype - CALL OpFM_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! m - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! m - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! m - 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 OpFM_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u - 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 OpFM_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y - 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 OpFM_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! p - 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 OpFM_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! m - 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 FAST_PackOpenFOAM_Data - - SUBROUTINE FAST_UnPackOpenFOAM_Data( 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(OpenFOAM_Data), 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 = 'FAST_UnPackOpenFOAM_Data' - ! 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 OpFM_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u - 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 OpFM_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y - 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 OpFM_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p - 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 OpFM_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! m - 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 FAST_UnPackOpenFOAM_Data - - SUBROUTINE FAST_CopySCDataEx_Data( SrcSCDataEx_DataData, DstSCDataEx_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SCDataEx_Data), INTENT(IN) :: SrcSCDataEx_DataData - TYPE(SCDataEx_Data), INTENT(INOUT) :: DstSCDataEx_DataData - 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 = 'FAST_CopySCDataEx_Data' -! + ErrMsg = '' + LB(1:1) = lbound(SrcLinFileTypeData%Modules) + UB(1:1) = ubound(SrcLinFileTypeData%Modules) + do i1 = LB(1), UB(1) + call FAST_CopyModLinType(SrcLinFileTypeData%Modules(i1), DstLinFileTypeData%Modules(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + call FAST_CopyLinType(SrcLinFileTypeData%Glue, DstLinFileTypeData%Glue, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstLinFileTypeData%RotSpeed = SrcLinFileTypeData%RotSpeed + DstLinFileTypeData%Azimuth = SrcLinFileTypeData%Azimuth + DstLinFileTypeData%WindSpeed = SrcLinFileTypeData%WindSpeed +end subroutine + +subroutine FAST_DestroyLinFileType(LinFileTypeData, ErrStat, ErrMsg) + type(FAST_LinFileType), intent(inout) :: LinFileTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_DestroyLinFileType' ErrStat = ErrID_None - ErrMsg = "" - CALL SC_DX_CopyInput( SrcSCDataEx_DataData%u, DstSCDataEx_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SC_DX_CopyOutput( SrcSCDataEx_DataData%y, DstSCDataEx_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SC_DX_CopyParam( SrcSCDataEx_DataData%p, DstSCDataEx_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE FAST_CopySCDataEx_Data - - SUBROUTINE FAST_DestroySCDataEx_Data( SCDataEx_DataData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(SCDataEx_Data), INTENT(INOUT) :: SCDataEx_DataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroySCDataEx_Data' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL SC_DX_DestroyInput( SCDataEx_DataData%u, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SC_DX_DestroyOutput( SCDataEx_DataData%y, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SC_DX_DestroyParam( SCDataEx_DataData%p, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE FAST_DestroySCDataEx_Data - - SUBROUTINE FAST_PackSCDataEx_Data( 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(SCDataEx_Data), 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 = 'FAST_PackSCDataEx_Data' - ! 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 ! u: size of buffers for each call to pack subtype - CALL SC_DX_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype - CALL SC_DX_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype - CALL SC_DX_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! p - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! p - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! p - 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 SC_DX_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u - 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 SC_DX_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y - 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 SC_DX_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! p - 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 FAST_PackSCDataEx_Data - - SUBROUTINE FAST_UnPackSCDataEx_Data( 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(SCDataEx_Data), 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 = 'FAST_UnPackSCDataEx_Data' - ! 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 SC_DX_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u - 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 SC_DX_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y - 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 SC_DX_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p - 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 FAST_UnPackSCDataEx_Data - - SUBROUTINE FAST_CopySubDyn_Data( SrcSubDyn_DataData, DstSubDyn_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SubDyn_Data), INTENT(INOUT) :: SrcSubDyn_DataData - TYPE(SubDyn_Data), INTENT(INOUT) :: DstSubDyn_DataData - 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 = 'FAST_CopySubDyn_Data' -! + ErrMsg = '' + LB(1:1) = lbound(LinFileTypeData%Modules) + UB(1:1) = ubound(LinFileTypeData%Modules) + do i1 = LB(1), UB(1) + call FAST_DestroyModLinType(LinFileTypeData%Modules(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + call FAST_DestroyLinType(LinFileTypeData%Glue, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine FAST_PackLinFileType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(FAST_LinFileType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackLinFileType' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + if (RF%ErrStat >= AbortErrLev) return + LB(1:1) = lbound(InData%Modules) + UB(1:1) = ubound(InData%Modules) + do i1 = LB(1), UB(1) + call FAST_PackModLinType(RF, InData%Modules(i1)) + end do + call FAST_PackLinType(RF, InData%Glue) + call RegPack(RF, InData%RotSpeed) + call RegPack(RF, InData%Azimuth) + call RegPack(RF, InData%WindSpeed) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FAST_UnPackLinFileType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(FAST_LinFileType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackLinFileType' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + if (RF%ErrStat /= ErrID_None) return + LB(1:1) = lbound(OutData%Modules) + UB(1:1) = ubound(OutData%Modules) + do i1 = LB(1), UB(1) + call FAST_UnpackModLinType(RF, OutData%Modules(i1)) ! Modules + end do + call FAST_UnpackLinType(RF, OutData%Glue) ! Glue + call RegUnpack(RF, OutData%RotSpeed); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Azimuth); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WindSpeed); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FAST_CopyMiscLinType(SrcMiscLinTypeData, DstMiscLinTypeData, CtrlCode, ErrStat, ErrMsg) + type(FAST_MiscLinType), intent(in) :: SrcMiscLinTypeData + type(FAST_MiscLinType), intent(inout) :: DstMiscLinTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'FAST_CopyMiscLinType' ErrStat = ErrID_None - ErrMsg = "" - DO i1 = LBOUND(SrcSubDyn_DataData%x,1), UBOUND(SrcSubDyn_DataData%x,1) - CALL SD_CopyContState( SrcSubDyn_DataData%x(i1), DstSubDyn_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcSubDyn_DataData%xd,1), UBOUND(SrcSubDyn_DataData%xd,1) - CALL SD_CopyDiscState( SrcSubDyn_DataData%xd(i1), DstSubDyn_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcSubDyn_DataData%z,1), UBOUND(SrcSubDyn_DataData%z,1) - CALL SD_CopyConstrState( SrcSubDyn_DataData%z(i1), DstSubDyn_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcSubDyn_DataData%OtherSt,1), UBOUND(SrcSubDyn_DataData%OtherSt,1) - CALL SD_CopyOtherState( SrcSubDyn_DataData%OtherSt(i1), DstSubDyn_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - CALL SD_CopyParam( SrcSubDyn_DataData%p, DstSubDyn_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SD_CopyInput( SrcSubDyn_DataData%u, DstSubDyn_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SD_CopyOutput( SrcSubDyn_DataData%y, DstSubDyn_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SD_CopyMisc( SrcSubDyn_DataData%m, DstSubDyn_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcSubDyn_DataData%Input)) THEN - i1_l = LBOUND(SrcSubDyn_DataData%Input,1) - i1_u = UBOUND(SrcSubDyn_DataData%Input,1) - IF (.NOT. ALLOCATED(DstSubDyn_DataData%Input)) THEN - ALLOCATE(DstSubDyn_DataData%Input(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstSubDyn_DataData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcSubDyn_DataData%Input,1), UBOUND(SrcSubDyn_DataData%Input,1) - CALL SD_CopyInput( SrcSubDyn_DataData%Input(i1), DstSubDyn_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcSubDyn_DataData%Output)) THEN - i1_l = LBOUND(SrcSubDyn_DataData%Output,1) - i1_u = UBOUND(SrcSubDyn_DataData%Output,1) - IF (.NOT. ALLOCATED(DstSubDyn_DataData%Output)) THEN - ALLOCATE(DstSubDyn_DataData%Output(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstSubDyn_DataData%Output.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcSubDyn_DataData%Output,1), UBOUND(SrcSubDyn_DataData%Output,1) - CALL SD_CopyOutput( SrcSubDyn_DataData%Output(i1), DstSubDyn_DataData%Output(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL SD_CopyOutput( SrcSubDyn_DataData%y_interp, DstSubDyn_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcSubDyn_DataData%InputTimes)) THEN - i1_l = LBOUND(SrcSubDyn_DataData%InputTimes,1) - i1_u = UBOUND(SrcSubDyn_DataData%InputTimes,1) - IF (.NOT. ALLOCATED(DstSubDyn_DataData%InputTimes)) THEN - ALLOCATE(DstSubDyn_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstSubDyn_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstSubDyn_DataData%InputTimes = SrcSubDyn_DataData%InputTimes -ENDIF - END SUBROUTINE FAST_CopySubDyn_Data - - SUBROUTINE FAST_DestroySubDyn_Data( SubDyn_DataData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(SubDyn_Data), INTENT(INOUT) :: SubDyn_DataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroySubDyn_Data' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -DO i1 = LBOUND(SubDyn_DataData%x,1), UBOUND(SubDyn_DataData%x,1) - CALL SD_DestroyContState( SubDyn_DataData%x(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(SubDyn_DataData%xd,1), UBOUND(SubDyn_DataData%xd,1) - CALL SD_DestroyDiscState( SubDyn_DataData%xd(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(SubDyn_DataData%z,1), UBOUND(SubDyn_DataData%z,1) - CALL SD_DestroyConstrState( SubDyn_DataData%z(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(SubDyn_DataData%OtherSt,1), UBOUND(SubDyn_DataData%OtherSt,1) - CALL SD_DestroyOtherState( SubDyn_DataData%OtherSt(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - CALL SD_DestroyParam( SubDyn_DataData%p, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SD_DestroyInput( SubDyn_DataData%u, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SD_DestroyOutput( SubDyn_DataData%y, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SD_DestroyMisc( SubDyn_DataData%m, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(SubDyn_DataData%Input)) THEN -DO i1 = LBOUND(SubDyn_DataData%Input,1), UBOUND(SubDyn_DataData%Input,1) - CALL SD_DestroyInput( SubDyn_DataData%Input(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(SubDyn_DataData%Input) -ENDIF -IF (ALLOCATED(SubDyn_DataData%Output)) THEN -DO i1 = LBOUND(SubDyn_DataData%Output,1), UBOUND(SubDyn_DataData%Output,1) - CALL SD_DestroyOutput( SubDyn_DataData%Output(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(SubDyn_DataData%Output) -ENDIF - CALL SD_DestroyOutput( SubDyn_DataData%y_interp, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(SubDyn_DataData%InputTimes)) THEN - DEALLOCATE(SubDyn_DataData%InputTimes) -ENDIF - END SUBROUTINE FAST_DestroySubDyn_Data - - SUBROUTINE FAST_PackSubDyn_Data( 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(SubDyn_Data), 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 = 'FAST_PackSubDyn_Data' - ! 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) - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - Int_BufSz = Int_BufSz + 3 ! x: size of buffers for each call to pack subtype - CALL SD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype - CALL SD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xd - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype - CALL SD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! z - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! z - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! z - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - Int_BufSz = Int_BufSz + 3 ! OtherSt: size of buffers for each call to pack subtype - CALL SD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype - CALL SD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! p - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! p - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! p - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype - CALL SD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype - CALL SD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype - CALL SD_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! m - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! m - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! m - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! Input allocated yes/no - IF ( ALLOCATED(InData%Input) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Input upper/lower bounds for each dimension - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - Int_BufSz = Int_BufSz + 3 ! Input: size of buffers for each call to pack subtype - CALL SD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Input - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Input - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Input - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! Output allocated yes/no - IF ( ALLOCATED(InData%Output) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Output upper/lower bounds for each dimension - DO i1 = LBOUND(InData%Output,1), UBOUND(InData%Output,1) - Int_BufSz = Int_BufSz + 3 ! Output: size of buffers for each call to pack subtype - CALL SD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Output(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Output - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Output - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Output - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Output - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! y_interp: size of buffers for each call to pack subtype - CALL SD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_interp, ErrStat2, ErrMsg2, .TRUE. ) ! y_interp - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y_interp - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y_interp - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y_interp - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! InputTimes allocated yes/no - IF ( ALLOCATED(InData%InputTimes) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! InputTimes upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes - 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 i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - CALL SD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, OnlySize ) ! x - 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 - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - CALL SD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd - 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 - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - CALL SD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, OnlySize ) ! z - 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 - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - CALL SD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt - 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 - CALL SD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! p - 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 SD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u - 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 SD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y - 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 SD_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! m - 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%Input) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Input,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - CALL SD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input - 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%Output) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Output,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Output,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Output,1), UBOUND(InData%Output,1) - CALL SD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Output(i1), ErrStat2, ErrMsg2, OnlySize ) ! Output - 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 - CALL SD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_interp, ErrStat2, ErrMsg2, OnlySize ) ! y_interp - 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%InputTimes) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InputTimes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%InputTimes,1), UBOUND(InData%InputTimes,1) - DbKiBuf(Db_Xferred) = InData%InputTimes(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE FAST_PackSubDyn_Data - - SUBROUTINE FAST_UnPackSubDyn_Data( 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(SubDyn_Data), 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 = 'FAST_UnPackSubDyn_Data' - ! 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%x,1) - i1_u = UBOUND(OutData%x,1) - DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,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%x(i1), ErrStat2, ErrMsg2 ) ! x - 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 - i1_l = LBOUND(OutData%xd,1) - i1_u = UBOUND(OutData%xd,1) - DO i1 = LBOUND(OutData%xd,1), UBOUND(OutData%xd,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_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1), ErrStat2, ErrMsg2 ) ! xd - 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 - i1_l = LBOUND(OutData%z,1) - i1_u = UBOUND(OutData%z,1) - DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,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_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1), ErrStat2, ErrMsg2 ) ! z - 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 - i1_l = LBOUND(OutData%OtherSt,1) - i1_u = UBOUND(OutData%OtherSt,1) - DO i1 = LBOUND(OutData%OtherSt,1), UBOUND(OutData%OtherSt,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_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt(i1), ErrStat2, ErrMsg2 ) ! OtherSt - 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 - 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_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p - 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 SD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u - 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 SD_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y - 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 SD_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! m - 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 ! Input not allocated - Int_Xferred = Int_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%Input)) DEALLOCATE(OutData%Input) - ALLOCATE(OutData%Input(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Input,1), UBOUND(OutData%Input,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_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input(i1), ErrStat2, ErrMsg2 ) ! Input - 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 ! Output not allocated - Int_Xferred = Int_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%Output)) DEALLOCATE(OutData%Output) - ALLOCATE(OutData%Output(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Output,1), UBOUND(OutData%Output,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_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%Output(i1), ErrStat2, ErrMsg2 ) ! Output - 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 - 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_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y_interp, ErrStat2, ErrMsg2 ) ! y_interp - 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 ! InputTimes not allocated - Int_Xferred = Int_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%InputTimes)) DEALLOCATE(OutData%InputTimes) - ALLOCATE(OutData%InputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%InputTimes,1), UBOUND(OutData%InputTimes,1) - OutData%InputTimes(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE FAST_UnPackSubDyn_Data - - SUBROUTINE FAST_CopyExtPtfm_Data( SrcExtPtfm_DataData, DstExtPtfm_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ExtPtfm_Data), INTENT(INOUT) :: SrcExtPtfm_DataData - TYPE(ExtPtfm_Data), INTENT(INOUT) :: DstExtPtfm_DataData - 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 = 'FAST_CopyExtPtfm_Data' -! + ErrMsg = '' + if (allocated(SrcMiscLinTypeData%LinTimes)) then + LB(1:1) = lbound(SrcMiscLinTypeData%LinTimes) + UB(1:1) = ubound(SrcMiscLinTypeData%LinTimes) + if (.not. allocated(DstMiscLinTypeData%LinTimes)) then + allocate(DstMiscLinTypeData%LinTimes(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscLinTypeData%LinTimes.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscLinTypeData%LinTimes = SrcMiscLinTypeData%LinTimes + end if + DstMiscLinTypeData%CopyOP_CtrlCode = SrcMiscLinTypeData%CopyOP_CtrlCode + if (allocated(SrcMiscLinTypeData%AzimTarget)) then + LB(1:1) = lbound(SrcMiscLinTypeData%AzimTarget) + UB(1:1) = ubound(SrcMiscLinTypeData%AzimTarget) + if (.not. allocated(DstMiscLinTypeData%AzimTarget)) then + allocate(DstMiscLinTypeData%AzimTarget(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscLinTypeData%AzimTarget.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscLinTypeData%AzimTarget = SrcMiscLinTypeData%AzimTarget + end if + DstMiscLinTypeData%IsConverged = SrcMiscLinTypeData%IsConverged + DstMiscLinTypeData%FoundSteady = SrcMiscLinTypeData%FoundSteady + DstMiscLinTypeData%ForceLin = SrcMiscLinTypeData%ForceLin + DstMiscLinTypeData%n_rot = SrcMiscLinTypeData%n_rot + DstMiscLinTypeData%AzimIndx = SrcMiscLinTypeData%AzimIndx + DstMiscLinTypeData%NextLinTimeIndx = SrcMiscLinTypeData%NextLinTimeIndx + if (allocated(SrcMiscLinTypeData%Psi)) then + LB(1:1) = lbound(SrcMiscLinTypeData%Psi) + UB(1:1) = ubound(SrcMiscLinTypeData%Psi) + if (.not. allocated(DstMiscLinTypeData%Psi)) then + allocate(DstMiscLinTypeData%Psi(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscLinTypeData%Psi.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscLinTypeData%Psi = SrcMiscLinTypeData%Psi + end if + if (allocated(SrcMiscLinTypeData%y_interp)) then + LB(1:1) = lbound(SrcMiscLinTypeData%y_interp) + UB(1:1) = ubound(SrcMiscLinTypeData%y_interp) + if (.not. allocated(DstMiscLinTypeData%y_interp)) then + allocate(DstMiscLinTypeData%y_interp(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscLinTypeData%y_interp.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscLinTypeData%y_interp = SrcMiscLinTypeData%y_interp + end if + if (allocated(SrcMiscLinTypeData%y_ref)) then + LB(1:1) = lbound(SrcMiscLinTypeData%y_ref) + UB(1:1) = ubound(SrcMiscLinTypeData%y_ref) + if (.not. allocated(DstMiscLinTypeData%y_ref)) then + allocate(DstMiscLinTypeData%y_ref(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscLinTypeData%y_ref.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscLinTypeData%y_ref = SrcMiscLinTypeData%y_ref + end if + if (allocated(SrcMiscLinTypeData%Y_prevRot)) then + LB(1:2) = lbound(SrcMiscLinTypeData%Y_prevRot) + UB(1:2) = ubound(SrcMiscLinTypeData%Y_prevRot) + if (.not. allocated(DstMiscLinTypeData%Y_prevRot)) then + allocate(DstMiscLinTypeData%Y_prevRot(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscLinTypeData%Y_prevRot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscLinTypeData%Y_prevRot = SrcMiscLinTypeData%Y_prevRot + end if +end subroutine + +subroutine FAST_DestroyMiscLinType(MiscLinTypeData, ErrStat, ErrMsg) + type(FAST_MiscLinType), intent(inout) :: MiscLinTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FAST_DestroyMiscLinType' ErrStat = ErrID_None - ErrMsg = "" - DO i1 = LBOUND(SrcExtPtfm_DataData%x,1), UBOUND(SrcExtPtfm_DataData%x,1) - CALL ExtPtfm_CopyContState( SrcExtPtfm_DataData%x(i1), DstExtPtfm_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcExtPtfm_DataData%xd,1), UBOUND(SrcExtPtfm_DataData%xd,1) - CALL ExtPtfm_CopyDiscState( SrcExtPtfm_DataData%xd(i1), DstExtPtfm_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcExtPtfm_DataData%z,1), UBOUND(SrcExtPtfm_DataData%z,1) - CALL ExtPtfm_CopyConstrState( SrcExtPtfm_DataData%z(i1), DstExtPtfm_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcExtPtfm_DataData%OtherSt,1), UBOUND(SrcExtPtfm_DataData%OtherSt,1) - CALL ExtPtfm_CopyOtherState( SrcExtPtfm_DataData%OtherSt(i1), DstExtPtfm_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - CALL ExtPtfm_CopyParam( SrcExtPtfm_DataData%p, DstExtPtfm_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL ExtPtfm_CopyInput( SrcExtPtfm_DataData%u, DstExtPtfm_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL ExtPtfm_CopyOutput( SrcExtPtfm_DataData%y, DstExtPtfm_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL ExtPtfm_CopyMisc( SrcExtPtfm_DataData%m, DstExtPtfm_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcExtPtfm_DataData%Input)) THEN - i1_l = LBOUND(SrcExtPtfm_DataData%Input,1) - i1_u = UBOUND(SrcExtPtfm_DataData%Input,1) - IF (.NOT. ALLOCATED(DstExtPtfm_DataData%Input)) THEN - ALLOCATE(DstExtPtfm_DataData%Input(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstExtPtfm_DataData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcExtPtfm_DataData%Input,1), UBOUND(SrcExtPtfm_DataData%Input,1) - CALL ExtPtfm_CopyInput( SrcExtPtfm_DataData%Input(i1), DstExtPtfm_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcExtPtfm_DataData%InputTimes)) THEN - i1_l = LBOUND(SrcExtPtfm_DataData%InputTimes,1) - i1_u = UBOUND(SrcExtPtfm_DataData%InputTimes,1) - IF (.NOT. ALLOCATED(DstExtPtfm_DataData%InputTimes)) THEN - ALLOCATE(DstExtPtfm_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstExtPtfm_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstExtPtfm_DataData%InputTimes = SrcExtPtfm_DataData%InputTimes -ENDIF - END SUBROUTINE FAST_CopyExtPtfm_Data - - SUBROUTINE FAST_DestroyExtPtfm_Data( ExtPtfm_DataData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(ExtPtfm_Data), INTENT(INOUT) :: ExtPtfm_DataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyExtPtfm_Data' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -DO i1 = LBOUND(ExtPtfm_DataData%x,1), UBOUND(ExtPtfm_DataData%x,1) - CALL ExtPtfm_DestroyContState( ExtPtfm_DataData%x(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(ExtPtfm_DataData%xd,1), UBOUND(ExtPtfm_DataData%xd,1) - CALL ExtPtfm_DestroyDiscState( ExtPtfm_DataData%xd(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(ExtPtfm_DataData%z,1), UBOUND(ExtPtfm_DataData%z,1) - CALL ExtPtfm_DestroyConstrState( ExtPtfm_DataData%z(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(ExtPtfm_DataData%OtherSt,1), UBOUND(ExtPtfm_DataData%OtherSt,1) - CALL ExtPtfm_DestroyOtherState( ExtPtfm_DataData%OtherSt(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - CALL ExtPtfm_DestroyParam( ExtPtfm_DataData%p, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL ExtPtfm_DestroyInput( ExtPtfm_DataData%u, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL ExtPtfm_DestroyOutput( ExtPtfm_DataData%y, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL ExtPtfm_DestroyMisc( ExtPtfm_DataData%m, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(ExtPtfm_DataData%Input)) THEN -DO i1 = LBOUND(ExtPtfm_DataData%Input,1), UBOUND(ExtPtfm_DataData%Input,1) - CALL ExtPtfm_DestroyInput( ExtPtfm_DataData%Input(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ExtPtfm_DataData%Input) -ENDIF -IF (ALLOCATED(ExtPtfm_DataData%InputTimes)) THEN - DEALLOCATE(ExtPtfm_DataData%InputTimes) -ENDIF - END SUBROUTINE FAST_DestroyExtPtfm_Data - - SUBROUTINE FAST_PackExtPtfm_Data( 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(ExtPtfm_Data), 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 = 'FAST_PackExtPtfm_Data' - ! 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) - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - Int_BufSz = Int_BufSz + 3 ! x: size of buffers for each call to pack subtype - CALL ExtPtfm_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype - CALL ExtPtfm_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xd - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype - CALL ExtPtfm_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! z - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! z - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! z - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - Int_BufSz = Int_BufSz + 3 ! OtherSt: size of buffers for each call to pack subtype - CALL ExtPtfm_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype - CALL ExtPtfm_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! p - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! p - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! p - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype - CALL ExtPtfm_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype - CALL ExtPtfm_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype - CALL ExtPtfm_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! m - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! m - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! m - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! Input allocated yes/no - IF ( ALLOCATED(InData%Input) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Input upper/lower bounds for each dimension - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - Int_BufSz = Int_BufSz + 3 ! Input: size of buffers for each call to pack subtype - CALL ExtPtfm_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Input - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Input - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Input - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! InputTimes allocated yes/no - IF ( ALLOCATED(InData%InputTimes) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! InputTimes upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes - 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 i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - CALL ExtPtfm_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, OnlySize ) ! x - 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 - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - CALL ExtPtfm_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd - 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 - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - CALL ExtPtfm_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, OnlySize ) ! z - 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 - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - CALL ExtPtfm_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt - 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 - CALL ExtPtfm_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! p - 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 ExtPtfm_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u - 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 ExtPtfm_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y - 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 ExtPtfm_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! m - 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%Input) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Input,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - CALL ExtPtfm_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input - 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%InputTimes) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InputTimes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%InputTimes,1), UBOUND(InData%InputTimes,1) - DbKiBuf(Db_Xferred) = InData%InputTimes(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE FAST_PackExtPtfm_Data - - SUBROUTINE FAST_UnPackExtPtfm_Data( 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(ExtPtfm_Data), 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 = 'FAST_UnPackExtPtfm_Data' - ! 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%x,1) - i1_u = UBOUND(OutData%x,1) - DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,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 ExtPtfm_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x(i1), ErrStat2, ErrMsg2 ) ! x - 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 - i1_l = LBOUND(OutData%xd,1) - i1_u = UBOUND(OutData%xd,1) - DO i1 = LBOUND(OutData%xd,1), UBOUND(OutData%xd,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 ExtPtfm_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1), ErrStat2, ErrMsg2 ) ! xd - 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 - i1_l = LBOUND(OutData%z,1) - i1_u = UBOUND(OutData%z,1) - DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,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 ExtPtfm_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1), ErrStat2, ErrMsg2 ) ! z - 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 - i1_l = LBOUND(OutData%OtherSt,1) - i1_u = UBOUND(OutData%OtherSt,1) - DO i1 = LBOUND(OutData%OtherSt,1), UBOUND(OutData%OtherSt,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 ExtPtfm_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt(i1), ErrStat2, ErrMsg2 ) ! OtherSt - 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 - 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 ExtPtfm_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p - 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 ExtPtfm_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u - 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 ExtPtfm_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y - 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 ExtPtfm_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! m - 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 ! Input not allocated - Int_Xferred = Int_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%Input)) DEALLOCATE(OutData%Input) - ALLOCATE(OutData%Input(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Input,1), UBOUND(OutData%Input,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 ExtPtfm_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input(i1), ErrStat2, ErrMsg2 ) ! Input - 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 ! InputTimes not allocated - Int_Xferred = Int_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%InputTimes)) DEALLOCATE(OutData%InputTimes) - ALLOCATE(OutData%InputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%InputTimes,1), UBOUND(OutData%InputTimes,1) - OutData%InputTimes(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE FAST_UnPackExtPtfm_Data - - SUBROUTINE FAST_CopyHydroDyn_Data( SrcHydroDyn_DataData, DstHydroDyn_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(HydroDyn_Data), INTENT(INOUT) :: SrcHydroDyn_DataData - TYPE(HydroDyn_Data), INTENT(INOUT) :: DstHydroDyn_DataData - 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 = 'FAST_CopyHydroDyn_Data' -! + ErrMsg = '' + if (allocated(MiscLinTypeData%LinTimes)) then + deallocate(MiscLinTypeData%LinTimes) + end if + if (allocated(MiscLinTypeData%AzimTarget)) then + deallocate(MiscLinTypeData%AzimTarget) + end if + if (allocated(MiscLinTypeData%Psi)) then + deallocate(MiscLinTypeData%Psi) + end if + if (allocated(MiscLinTypeData%y_interp)) then + deallocate(MiscLinTypeData%y_interp) + end if + if (allocated(MiscLinTypeData%y_ref)) then + deallocate(MiscLinTypeData%y_ref) + end if + if (allocated(MiscLinTypeData%Y_prevRot)) then + deallocate(MiscLinTypeData%Y_prevRot) + end if +end subroutine + +subroutine FAST_PackMiscLinType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(FAST_MiscLinType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackMiscLinType' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%LinTimes) + call RegPack(RF, InData%CopyOP_CtrlCode) + call RegPackAlloc(RF, InData%AzimTarget) + call RegPack(RF, InData%IsConverged) + call RegPack(RF, InData%FoundSteady) + call RegPack(RF, InData%ForceLin) + call RegPack(RF, InData%n_rot) + call RegPack(RF, InData%AzimIndx) + call RegPack(RF, InData%NextLinTimeIndx) + call RegPackAlloc(RF, InData%Psi) + call RegPackAlloc(RF, InData%y_interp) + call RegPackAlloc(RF, InData%y_ref) + call RegPackAlloc(RF, InData%Y_prevRot) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FAST_UnPackMiscLinType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(FAST_MiscLinType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackMiscLinType' + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%LinTimes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CopyOP_CtrlCode); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AzimTarget); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%IsConverged); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FoundSteady); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ForceLin); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%n_rot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AzimIndx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NextLinTimeIndx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Psi); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%y_interp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%y_ref); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Y_prevRot); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FAST_CopyOutputFileType(SrcOutputFileTypeData, DstOutputFileTypeData, CtrlCode, ErrStat, ErrMsg) + type(FAST_OutputFileType), intent(inout) :: SrcOutputFileTypeData + type(FAST_OutputFileType), intent(inout) :: DstOutputFileTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_CopyOutputFileType' ErrStat = ErrID_None - ErrMsg = "" - DO i1 = LBOUND(SrcHydroDyn_DataData%x,1), UBOUND(SrcHydroDyn_DataData%x,1) - CALL HydroDyn_CopyContState( SrcHydroDyn_DataData%x(i1), DstHydroDyn_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcHydroDyn_DataData%xd,1), UBOUND(SrcHydroDyn_DataData%xd,1) - CALL HydroDyn_CopyDiscState( SrcHydroDyn_DataData%xd(i1), DstHydroDyn_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcHydroDyn_DataData%z,1), UBOUND(SrcHydroDyn_DataData%z,1) - CALL HydroDyn_CopyConstrState( SrcHydroDyn_DataData%z(i1), DstHydroDyn_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcHydroDyn_DataData%OtherSt,1), UBOUND(SrcHydroDyn_DataData%OtherSt,1) - CALL HydroDyn_CopyOtherState( SrcHydroDyn_DataData%OtherSt(i1), DstHydroDyn_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - CALL HydroDyn_CopyParam( SrcHydroDyn_DataData%p, DstHydroDyn_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL HydroDyn_CopyInput( SrcHydroDyn_DataData%u, DstHydroDyn_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL HydroDyn_CopyOutput( SrcHydroDyn_DataData%y, DstHydroDyn_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL HydroDyn_CopyMisc( SrcHydroDyn_DataData%m, DstHydroDyn_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcHydroDyn_DataData%Output)) THEN - i1_l = LBOUND(SrcHydroDyn_DataData%Output,1) - i1_u = UBOUND(SrcHydroDyn_DataData%Output,1) - IF (.NOT. ALLOCATED(DstHydroDyn_DataData%Output)) THEN - ALLOCATE(DstHydroDyn_DataData%Output(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstHydroDyn_DataData%Output.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcHydroDyn_DataData%Output,1), UBOUND(SrcHydroDyn_DataData%Output,1) - CALL HydroDyn_CopyOutput( SrcHydroDyn_DataData%Output(i1), DstHydroDyn_DataData%Output(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL HydroDyn_CopyOutput( SrcHydroDyn_DataData%y_interp, DstHydroDyn_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcHydroDyn_DataData%Input)) THEN - i1_l = LBOUND(SrcHydroDyn_DataData%Input,1) - i1_u = UBOUND(SrcHydroDyn_DataData%Input,1) - IF (.NOT. ALLOCATED(DstHydroDyn_DataData%Input)) THEN - ALLOCATE(DstHydroDyn_DataData%Input(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstHydroDyn_DataData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcHydroDyn_DataData%Input,1), UBOUND(SrcHydroDyn_DataData%Input,1) - CALL HydroDyn_CopyInput( SrcHydroDyn_DataData%Input(i1), DstHydroDyn_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcHydroDyn_DataData%InputTimes)) THEN - i1_l = LBOUND(SrcHydroDyn_DataData%InputTimes,1) - i1_u = UBOUND(SrcHydroDyn_DataData%InputTimes,1) - IF (.NOT. ALLOCATED(DstHydroDyn_DataData%InputTimes)) THEN - ALLOCATE(DstHydroDyn_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstHydroDyn_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstHydroDyn_DataData%InputTimes = SrcHydroDyn_DataData%InputTimes -ENDIF - END SUBROUTINE FAST_CopyHydroDyn_Data - - SUBROUTINE FAST_DestroyHydroDyn_Data( HydroDyn_DataData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(HydroDyn_Data), INTENT(INOUT) :: HydroDyn_DataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyHydroDyn_Data' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -DO i1 = LBOUND(HydroDyn_DataData%x,1), UBOUND(HydroDyn_DataData%x,1) - CALL HydroDyn_DestroyContState( HydroDyn_DataData%x(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(HydroDyn_DataData%xd,1), UBOUND(HydroDyn_DataData%xd,1) - CALL HydroDyn_DestroyDiscState( HydroDyn_DataData%xd(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(HydroDyn_DataData%z,1), UBOUND(HydroDyn_DataData%z,1) - CALL HydroDyn_DestroyConstrState( HydroDyn_DataData%z(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(HydroDyn_DataData%OtherSt,1), UBOUND(HydroDyn_DataData%OtherSt,1) - CALL HydroDyn_DestroyOtherState( HydroDyn_DataData%OtherSt(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - CALL HydroDyn_DestroyParam( HydroDyn_DataData%p, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL HydroDyn_DestroyInput( HydroDyn_DataData%u, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL HydroDyn_DestroyOutput( HydroDyn_DataData%y, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL HydroDyn_DestroyMisc( HydroDyn_DataData%m, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(HydroDyn_DataData%Output)) THEN -DO i1 = LBOUND(HydroDyn_DataData%Output,1), UBOUND(HydroDyn_DataData%Output,1) - CALL HydroDyn_DestroyOutput( HydroDyn_DataData%Output(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(HydroDyn_DataData%Output) -ENDIF - CALL HydroDyn_DestroyOutput( HydroDyn_DataData%y_interp, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(HydroDyn_DataData%Input)) THEN -DO i1 = LBOUND(HydroDyn_DataData%Input,1), UBOUND(HydroDyn_DataData%Input,1) - CALL HydroDyn_DestroyInput( HydroDyn_DataData%Input(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(HydroDyn_DataData%Input) -ENDIF -IF (ALLOCATED(HydroDyn_DataData%InputTimes)) THEN - DEALLOCATE(HydroDyn_DataData%InputTimes) -ENDIF - END SUBROUTINE FAST_DestroyHydroDyn_Data - - SUBROUTINE FAST_PackHydroDyn_Data( 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(HydroDyn_Data), 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 = 'FAST_PackHydroDyn_Data' - ! 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) - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - Int_BufSz = Int_BufSz + 3 ! x: size of buffers for each call to pack subtype - CALL HydroDyn_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype - CALL HydroDyn_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xd - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype - CALL HydroDyn_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! z - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! z - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! z - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - Int_BufSz = Int_BufSz + 3 ! OtherSt: size of buffers for each call to pack subtype - CALL HydroDyn_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype - CALL HydroDyn_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! p - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! p - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! p - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype - CALL HydroDyn_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype - CALL HydroDyn_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype - CALL HydroDyn_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! m - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! m - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! m - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! Output allocated yes/no - IF ( ALLOCATED(InData%Output) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Output upper/lower bounds for each dimension - DO i1 = LBOUND(InData%Output,1), UBOUND(InData%Output,1) - Int_BufSz = Int_BufSz + 3 ! Output: size of buffers for each call to pack subtype - CALL HydroDyn_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Output(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Output - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Output - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Output - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Output - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! y_interp: size of buffers for each call to pack subtype - CALL HydroDyn_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_interp, ErrStat2, ErrMsg2, .TRUE. ) ! y_interp - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y_interp - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y_interp - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y_interp - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! Input allocated yes/no - IF ( ALLOCATED(InData%Input) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Input upper/lower bounds for each dimension - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - Int_BufSz = Int_BufSz + 3 ! Input: size of buffers for each call to pack subtype - CALL HydroDyn_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Input - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Input - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Input - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! InputTimes allocated yes/no - IF ( ALLOCATED(InData%InputTimes) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! InputTimes upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes - 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 i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - CALL HydroDyn_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, OnlySize ) ! x - 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 - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - CALL HydroDyn_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd - 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 - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - CALL HydroDyn_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, OnlySize ) ! z - 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 - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - CALL HydroDyn_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt - 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 - CALL HydroDyn_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! p - 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 HydroDyn_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u - 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 HydroDyn_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y - 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 HydroDyn_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! m - 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%Output) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Output,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Output,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Output,1), UBOUND(InData%Output,1) - CALL HydroDyn_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Output(i1), ErrStat2, ErrMsg2, OnlySize ) ! Output - 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 - CALL HydroDyn_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_interp, ErrStat2, ErrMsg2, OnlySize ) ! y_interp - 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%Input) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Input,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - CALL HydroDyn_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input - 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%InputTimes) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InputTimes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%InputTimes,1), UBOUND(InData%InputTimes,1) - DbKiBuf(Db_Xferred) = InData%InputTimes(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE FAST_PackHydroDyn_Data - - SUBROUTINE FAST_UnPackHydroDyn_Data( 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(HydroDyn_Data), 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 = 'FAST_UnPackHydroDyn_Data' - ! 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%x,1) - i1_u = UBOUND(OutData%x,1) - DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,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 HydroDyn_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x(i1), ErrStat2, ErrMsg2 ) ! x - 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 - i1_l = LBOUND(OutData%xd,1) - i1_u = UBOUND(OutData%xd,1) - DO i1 = LBOUND(OutData%xd,1), UBOUND(OutData%xd,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 HydroDyn_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1), ErrStat2, ErrMsg2 ) ! xd - 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 - i1_l = LBOUND(OutData%z,1) - i1_u = UBOUND(OutData%z,1) - DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,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 HydroDyn_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1), ErrStat2, ErrMsg2 ) ! z - 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 - i1_l = LBOUND(OutData%OtherSt,1) - i1_u = UBOUND(OutData%OtherSt,1) - DO i1 = LBOUND(OutData%OtherSt,1), UBOUND(OutData%OtherSt,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 HydroDyn_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt(i1), ErrStat2, ErrMsg2 ) ! OtherSt - 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 - 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 HydroDyn_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p - 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 HydroDyn_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u - 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 HydroDyn_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y - 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 HydroDyn_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! m - 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 ! Output not allocated - Int_Xferred = Int_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%Output)) DEALLOCATE(OutData%Output) - ALLOCATE(OutData%Output(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Output,1), UBOUND(OutData%Output,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 HydroDyn_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%Output(i1), ErrStat2, ErrMsg2 ) ! Output - 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 - 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 HydroDyn_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y_interp, ErrStat2, ErrMsg2 ) ! y_interp - 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 ! Input not allocated - Int_Xferred = Int_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%Input)) DEALLOCATE(OutData%Input) - ALLOCATE(OutData%Input(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Input,1), UBOUND(OutData%Input,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 HydroDyn_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input(i1), ErrStat2, ErrMsg2 ) ! Input - 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 ! InputTimes not allocated - Int_Xferred = Int_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%InputTimes)) DEALLOCATE(OutData%InputTimes) - ALLOCATE(OutData%InputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%InputTimes,1), UBOUND(OutData%InputTimes,1) - OutData%InputTimes(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE FAST_UnPackHydroDyn_Data - - SUBROUTINE FAST_CopyIceFloe_Data( SrcIceFloe_DataData, DstIceFloe_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(IceFloe_Data), INTENT(INOUT) :: SrcIceFloe_DataData - TYPE(IceFloe_Data), INTENT(INOUT) :: DstIceFloe_DataData - 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 = 'FAST_CopyIceFloe_Data' -! + ErrMsg = '' + if (allocated(SrcOutputFileTypeData%TimeData)) then + LB(1:1) = lbound(SrcOutputFileTypeData%TimeData) + UB(1:1) = ubound(SrcOutputFileTypeData%TimeData) + if (.not. allocated(DstOutputFileTypeData%TimeData)) then + allocate(DstOutputFileTypeData%TimeData(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputFileTypeData%TimeData.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputFileTypeData%TimeData = SrcOutputFileTypeData%TimeData + end if + if (allocated(SrcOutputFileTypeData%AllOutData)) then + LB(1:2) = lbound(SrcOutputFileTypeData%AllOutData) + UB(1:2) = ubound(SrcOutputFileTypeData%AllOutData) + if (.not. allocated(DstOutputFileTypeData%AllOutData)) then + allocate(DstOutputFileTypeData%AllOutData(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputFileTypeData%AllOutData.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputFileTypeData%AllOutData = SrcOutputFileTypeData%AllOutData + end if + DstOutputFileTypeData%n_Out = SrcOutputFileTypeData%n_Out + DstOutputFileTypeData%NOutSteps = SrcOutputFileTypeData%NOutSteps + DstOutputFileTypeData%numOuts = SrcOutputFileTypeData%numOuts + DstOutputFileTypeData%UnOu = SrcOutputFileTypeData%UnOu + DstOutputFileTypeData%UnSum = SrcOutputFileTypeData%UnSum + DstOutputFileTypeData%UnGra = SrcOutputFileTypeData%UnGra + DstOutputFileTypeData%FileDescLines = SrcOutputFileTypeData%FileDescLines + if (allocated(SrcOutputFileTypeData%ChannelNames)) then + LB(1:1) = lbound(SrcOutputFileTypeData%ChannelNames) + UB(1:1) = ubound(SrcOutputFileTypeData%ChannelNames) + if (.not. allocated(DstOutputFileTypeData%ChannelNames)) then + allocate(DstOutputFileTypeData%ChannelNames(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputFileTypeData%ChannelNames.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputFileTypeData%ChannelNames = SrcOutputFileTypeData%ChannelNames + end if + if (allocated(SrcOutputFileTypeData%ChannelUnits)) then + LB(1:1) = lbound(SrcOutputFileTypeData%ChannelUnits) + UB(1:1) = ubound(SrcOutputFileTypeData%ChannelUnits) + if (.not. allocated(DstOutputFileTypeData%ChannelUnits)) then + allocate(DstOutputFileTypeData%ChannelUnits(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputFileTypeData%ChannelUnits.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputFileTypeData%ChannelUnits = SrcOutputFileTypeData%ChannelUnits + end if + LB(1:1) = lbound(SrcOutputFileTypeData%Module_Ver) + UB(1:1) = ubound(SrcOutputFileTypeData%Module_Ver) + do i1 = LB(1), UB(1) + call NWTC_Library_CopyProgDesc(SrcOutputFileTypeData%Module_Ver(i1), DstOutputFileTypeData%Module_Ver(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + DstOutputFileTypeData%Module_Abrev = SrcOutputFileTypeData%Module_Abrev + DstOutputFileTypeData%WriteThisStep = SrcOutputFileTypeData%WriteThisStep + DstOutputFileTypeData%VTK_count = SrcOutputFileTypeData%VTK_count + DstOutputFileTypeData%VTK_LastWaveIndx = SrcOutputFileTypeData%VTK_LastWaveIndx + call FAST_CopyLinFileType(SrcOutputFileTypeData%Lin, DstOutputFileTypeData%Lin, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstOutputFileTypeData%ActualChanLen = SrcOutputFileTypeData%ActualChanLen + call FAST_CopyLinStateSave(SrcOutputFileTypeData%op, DstOutputFileTypeData%op, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstOutputFileTypeData%DriverWriteOutput = SrcOutputFileTypeData%DriverWriteOutput +end subroutine + +subroutine FAST_DestroyOutputFileType(OutputFileTypeData, ErrStat, ErrMsg) + type(FAST_OutputFileType), intent(inout) :: OutputFileTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_DestroyOutputFileType' ErrStat = ErrID_None - ErrMsg = "" - DO i1 = LBOUND(SrcIceFloe_DataData%x,1), UBOUND(SrcIceFloe_DataData%x,1) - CALL IceFloe_CopyContState( SrcIceFloe_DataData%x(i1), DstIceFloe_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcIceFloe_DataData%xd,1), UBOUND(SrcIceFloe_DataData%xd,1) - CALL IceFloe_CopyDiscState( SrcIceFloe_DataData%xd(i1), DstIceFloe_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcIceFloe_DataData%z,1), UBOUND(SrcIceFloe_DataData%z,1) - CALL IceFloe_CopyConstrState( SrcIceFloe_DataData%z(i1), DstIceFloe_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcIceFloe_DataData%OtherSt,1), UBOUND(SrcIceFloe_DataData%OtherSt,1) - CALL IceFloe_CopyOtherState( SrcIceFloe_DataData%OtherSt(i1), DstIceFloe_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - CALL IceFloe_CopyParam( SrcIceFloe_DataData%p, DstIceFloe_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL IceFloe_CopyInput( SrcIceFloe_DataData%u, DstIceFloe_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL IceFloe_CopyOutput( SrcIceFloe_DataData%y, DstIceFloe_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL IceFloe_CopyMisc( SrcIceFloe_DataData%m, DstIceFloe_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcIceFloe_DataData%Input)) THEN - i1_l = LBOUND(SrcIceFloe_DataData%Input,1) - i1_u = UBOUND(SrcIceFloe_DataData%Input,1) - IF (.NOT. ALLOCATED(DstIceFloe_DataData%Input)) THEN - ALLOCATE(DstIceFloe_DataData%Input(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceFloe_DataData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcIceFloe_DataData%Input,1), UBOUND(SrcIceFloe_DataData%Input,1) - CALL IceFloe_CopyInput( SrcIceFloe_DataData%Input(i1), DstIceFloe_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcIceFloe_DataData%InputTimes)) THEN - i1_l = LBOUND(SrcIceFloe_DataData%InputTimes,1) - i1_u = UBOUND(SrcIceFloe_DataData%InputTimes,1) - IF (.NOT. ALLOCATED(DstIceFloe_DataData%InputTimes)) THEN - ALLOCATE(DstIceFloe_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceFloe_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstIceFloe_DataData%InputTimes = SrcIceFloe_DataData%InputTimes -ENDIF - END SUBROUTINE FAST_CopyIceFloe_Data - - SUBROUTINE FAST_DestroyIceFloe_Data( IceFloe_DataData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(IceFloe_Data), INTENT(INOUT) :: IceFloe_DataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyIceFloe_Data' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -DO i1 = LBOUND(IceFloe_DataData%x,1), UBOUND(IceFloe_DataData%x,1) - CALL IceFloe_DestroyContState( IceFloe_DataData%x(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(IceFloe_DataData%xd,1), UBOUND(IceFloe_DataData%xd,1) - CALL IceFloe_DestroyDiscState( IceFloe_DataData%xd(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(IceFloe_DataData%z,1), UBOUND(IceFloe_DataData%z,1) - CALL IceFloe_DestroyConstrState( IceFloe_DataData%z(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(IceFloe_DataData%OtherSt,1), UBOUND(IceFloe_DataData%OtherSt,1) - CALL IceFloe_DestroyOtherState( IceFloe_DataData%OtherSt(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - CALL IceFloe_DestroyParam( IceFloe_DataData%p, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL IceFloe_DestroyInput( IceFloe_DataData%u, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL IceFloe_DestroyOutput( IceFloe_DataData%y, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL IceFloe_DestroyMisc( IceFloe_DataData%m, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(IceFloe_DataData%Input)) THEN -DO i1 = LBOUND(IceFloe_DataData%Input,1), UBOUND(IceFloe_DataData%Input,1) - CALL IceFloe_DestroyInput( IceFloe_DataData%Input(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(IceFloe_DataData%Input) -ENDIF -IF (ALLOCATED(IceFloe_DataData%InputTimes)) THEN - DEALLOCATE(IceFloe_DataData%InputTimes) -ENDIF - END SUBROUTINE FAST_DestroyIceFloe_Data - - SUBROUTINE FAST_PackIceFloe_Data( 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(IceFloe_Data), 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 = 'FAST_PackIceFloe_Data' - ! 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) - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - Int_BufSz = Int_BufSz + 3 ! x: size of buffers for each call to pack subtype - CALL IceFloe_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype - CALL IceFloe_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xd - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype - CALL IceFloe_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! z - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! z - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! z - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - Int_BufSz = Int_BufSz + 3 ! OtherSt: size of buffers for each call to pack subtype - CALL IceFloe_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype - CALL IceFloe_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! p - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! p - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! p - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype - CALL IceFloe_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype - CALL IceFloe_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype - CALL IceFloe_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! m - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! m - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! m - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! Input allocated yes/no - IF ( ALLOCATED(InData%Input) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Input upper/lower bounds for each dimension - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - Int_BufSz = Int_BufSz + 3 ! Input: size of buffers for each call to pack subtype - CALL IceFloe_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Input - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Input - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Input - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! InputTimes allocated yes/no - IF ( ALLOCATED(InData%InputTimes) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! InputTimes upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes - 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 i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - CALL IceFloe_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, OnlySize ) ! x - 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 - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - CALL IceFloe_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd - 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 - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - CALL IceFloe_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, OnlySize ) ! z - 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 - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - CALL IceFloe_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt - 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 - CALL IceFloe_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! p - 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 IceFloe_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u - 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 IceFloe_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y - 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 IceFloe_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! m - 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%Input) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Input,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - CALL IceFloe_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input - 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%InputTimes) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InputTimes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%InputTimes,1), UBOUND(InData%InputTimes,1) - DbKiBuf(Db_Xferred) = InData%InputTimes(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE FAST_PackIceFloe_Data - - SUBROUTINE FAST_UnPackIceFloe_Data( 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(IceFloe_Data), 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 = 'FAST_UnPackIceFloe_Data' - ! 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%x,1) - i1_u = UBOUND(OutData%x,1) - DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,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 IceFloe_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x(i1), ErrStat2, ErrMsg2 ) ! x - 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 - i1_l = LBOUND(OutData%xd,1) - i1_u = UBOUND(OutData%xd,1) - DO i1 = LBOUND(OutData%xd,1), UBOUND(OutData%xd,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 IceFloe_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1), ErrStat2, ErrMsg2 ) ! xd - 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 - i1_l = LBOUND(OutData%z,1) - i1_u = UBOUND(OutData%z,1) - DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,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 IceFloe_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1), ErrStat2, ErrMsg2 ) ! z - 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 - i1_l = LBOUND(OutData%OtherSt,1) - i1_u = UBOUND(OutData%OtherSt,1) - DO i1 = LBOUND(OutData%OtherSt,1), UBOUND(OutData%OtherSt,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 IceFloe_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt(i1), ErrStat2, ErrMsg2 ) ! OtherSt - 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 - 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 IceFloe_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p - 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 IceFloe_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u - 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 IceFloe_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y - 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 IceFloe_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! m - 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 ! Input not allocated - Int_Xferred = Int_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%Input)) DEALLOCATE(OutData%Input) - ALLOCATE(OutData%Input(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Input,1), UBOUND(OutData%Input,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 IceFloe_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input(i1), ErrStat2, ErrMsg2 ) ! Input - 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 ! InputTimes not allocated - Int_Xferred = Int_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%InputTimes)) DEALLOCATE(OutData%InputTimes) - ALLOCATE(OutData%InputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%InputTimes,1), UBOUND(OutData%InputTimes,1) - OutData%InputTimes(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE FAST_UnPackIceFloe_Data - - SUBROUTINE FAST_CopyMAP_Data( SrcMAP_DataData, DstMAP_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MAP_Data), INTENT(INOUT) :: SrcMAP_DataData - TYPE(MAP_Data), INTENT(INOUT) :: DstMAP_DataData - 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 = 'FAST_CopyMAP_Data' -! + ErrMsg = '' + if (allocated(OutputFileTypeData%TimeData)) then + deallocate(OutputFileTypeData%TimeData) + end if + if (allocated(OutputFileTypeData%AllOutData)) then + deallocate(OutputFileTypeData%AllOutData) + end if + if (allocated(OutputFileTypeData%ChannelNames)) then + deallocate(OutputFileTypeData%ChannelNames) + end if + if (allocated(OutputFileTypeData%ChannelUnits)) then + deallocate(OutputFileTypeData%ChannelUnits) + end if + LB(1:1) = lbound(OutputFileTypeData%Module_Ver) + UB(1:1) = ubound(OutputFileTypeData%Module_Ver) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyProgDesc(OutputFileTypeData%Module_Ver(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + call FAST_DestroyLinFileType(OutputFileTypeData%Lin, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FAST_DestroyLinStateSave(OutputFileTypeData%op, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine FAST_PackOutputFileType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(FAST_OutputFileType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackOutputFileType' + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%TimeData) + call RegPackAlloc(RF, InData%AllOutData) + call RegPack(RF, InData%n_Out) + call RegPack(RF, InData%NOutSteps) + call RegPack(RF, InData%numOuts) + call RegPack(RF, InData%UnOu) + call RegPack(RF, InData%UnSum) + call RegPack(RF, InData%UnGra) + call RegPack(RF, InData%FileDescLines) + call RegPackAlloc(RF, InData%ChannelNames) + call RegPackAlloc(RF, InData%ChannelUnits) + LB(1:1) = lbound(InData%Module_Ver) + UB(1:1) = ubound(InData%Module_Ver) + do i1 = LB(1), UB(1) + call NWTC_Library_PackProgDesc(RF, InData%Module_Ver(i1)) + end do + call RegPack(RF, InData%Module_Abrev) + call RegPack(RF, InData%WriteThisStep) + call RegPack(RF, InData%VTK_count) + call RegPack(RF, InData%VTK_LastWaveIndx) + call FAST_PackLinFileType(RF, InData%Lin) + call RegPack(RF, InData%ActualChanLen) + call FAST_PackLinStateSave(RF, InData%op) + call RegPack(RF, InData%DriverWriteOutput) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FAST_UnPackOutputFileType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(FAST_OutputFileType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackOutputFileType' + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%TimeData); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AllOutData); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%n_Out); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NOutSteps); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%numOuts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UnOu); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UnSum); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UnGra); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FileDescLines); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ChannelNames); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ChannelUnits); if (RegCheckErr(RF, RoutineName)) return + LB(1:1) = lbound(OutData%Module_Ver) + UB(1:1) = ubound(OutData%Module_Ver) + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackProgDesc(RF, OutData%Module_Ver(i1)) ! Module_Ver + end do + call RegUnpack(RF, OutData%Module_Abrev); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WriteThisStep); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VTK_count); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VTK_LastWaveIndx); if (RegCheckErr(RF, RoutineName)) return + call FAST_UnpackLinFileType(RF, OutData%Lin) ! Lin + call RegUnpack(RF, OutData%ActualChanLen); if (RegCheckErr(RF, RoutineName)) return + call FAST_UnpackLinStateSave(RF, OutData%op) ! op + call RegUnpack(RF, OutData%DriverWriteOutput); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FAST_CopyIceDyn_Data(SrcIceDyn_DataData, DstIceDyn_DataData, CtrlCode, ErrStat, ErrMsg) + type(IceDyn_Data), intent(inout) :: SrcIceDyn_DataData + type(IceDyn_Data), intent(inout) :: DstIceDyn_DataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_CopyIceDyn_Data' ErrStat = ErrID_None - ErrMsg = "" - DO i1 = LBOUND(SrcMAP_DataData%x,1), UBOUND(SrcMAP_DataData%x,1) - CALL MAP_CopyContState( SrcMAP_DataData%x(i1), DstMAP_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcMAP_DataData%xd,1), UBOUND(SrcMAP_DataData%xd,1) - CALL MAP_CopyDiscState( SrcMAP_DataData%xd(i1), DstMAP_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcMAP_DataData%z,1), UBOUND(SrcMAP_DataData%z,1) - CALL MAP_CopyConstrState( SrcMAP_DataData%z(i1), DstMAP_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - CALL MAP_CopyOtherState( SrcMAP_DataData%OtherSt, DstMAP_DataData%OtherSt, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MAP_CopyParam( SrcMAP_DataData%p, DstMAP_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MAP_CopyInput( SrcMAP_DataData%u, DstMAP_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MAP_CopyOutput( SrcMAP_DataData%y, DstMAP_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MAP_CopyOtherState( SrcMAP_DataData%OtherSt_old, DstMAP_DataData%OtherSt_old, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcMAP_DataData%Output)) THEN - i1_l = LBOUND(SrcMAP_DataData%Output,1) - i1_u = UBOUND(SrcMAP_DataData%Output,1) - IF (.NOT. ALLOCATED(DstMAP_DataData%Output)) THEN - ALLOCATE(DstMAP_DataData%Output(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMAP_DataData%Output.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMAP_DataData%Output,1), UBOUND(SrcMAP_DataData%Output,1) - CALL MAP_CopyOutput( SrcMAP_DataData%Output(i1), DstMAP_DataData%Output(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL MAP_CopyOutput( SrcMAP_DataData%y_interp, DstMAP_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcMAP_DataData%Input)) THEN - i1_l = LBOUND(SrcMAP_DataData%Input,1) - i1_u = UBOUND(SrcMAP_DataData%Input,1) - IF (.NOT. ALLOCATED(DstMAP_DataData%Input)) THEN - ALLOCATE(DstMAP_DataData%Input(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMAP_DataData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMAP_DataData%Input,1), UBOUND(SrcMAP_DataData%Input,1) - CALL MAP_CopyInput( SrcMAP_DataData%Input(i1), DstMAP_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcMAP_DataData%InputTimes)) THEN - i1_l = LBOUND(SrcMAP_DataData%InputTimes,1) - i1_u = UBOUND(SrcMAP_DataData%InputTimes,1) - IF (.NOT. ALLOCATED(DstMAP_DataData%InputTimes)) THEN - ALLOCATE(DstMAP_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMAP_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMAP_DataData%InputTimes = SrcMAP_DataData%InputTimes -ENDIF - END SUBROUTINE FAST_CopyMAP_Data - - SUBROUTINE FAST_DestroyMAP_Data( MAP_DataData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(MAP_Data), INTENT(INOUT) :: MAP_DataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyMAP_Data' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -DO i1 = LBOUND(MAP_DataData%x,1), UBOUND(MAP_DataData%x,1) - CALL MAP_DestroyContState( MAP_DataData%x(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(MAP_DataData%xd,1), UBOUND(MAP_DataData%xd,1) - CALL MAP_DestroyDiscState( MAP_DataData%xd(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(MAP_DataData%z,1), UBOUND(MAP_DataData%z,1) - CALL MAP_DestroyConstrState( MAP_DataData%z(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - CALL MAP_DestroyOtherState( MAP_DataData%OtherSt, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MAP_DestroyParam( MAP_DataData%p, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MAP_DestroyInput( MAP_DataData%u, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MAP_DestroyOutput( MAP_DataData%y, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MAP_DestroyOtherState( MAP_DataData%OtherSt_old, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(MAP_DataData%Output)) THEN -DO i1 = LBOUND(MAP_DataData%Output,1), UBOUND(MAP_DataData%Output,1) - CALL MAP_DestroyOutput( MAP_DataData%Output(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MAP_DataData%Output) -ENDIF - CALL MAP_DestroyOutput( MAP_DataData%y_interp, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(MAP_DataData%Input)) THEN -DO i1 = LBOUND(MAP_DataData%Input,1), UBOUND(MAP_DataData%Input,1) - CALL MAP_DestroyInput( MAP_DataData%Input(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MAP_DataData%Input) -ENDIF -IF (ALLOCATED(MAP_DataData%InputTimes)) THEN - DEALLOCATE(MAP_DataData%InputTimes) -ENDIF - END SUBROUTINE FAST_DestroyMAP_Data - - SUBROUTINE FAST_PackMAP_Data( 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(MAP_Data), 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 = 'FAST_PackMAP_Data' - ! 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) - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - Int_BufSz = Int_BufSz + 3 ! x: size of buffers for each call to pack subtype - CALL MAP_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype - CALL MAP_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xd - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype - CALL MAP_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! z - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! z - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! z - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - Int_BufSz = Int_BufSz + 3 ! OtherSt: size of buffers for each call to pack subtype - CALL MAP_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt, ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype - CALL MAP_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! p - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! p - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! p - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype - CALL MAP_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype - CALL MAP_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! OtherSt_old: size of buffers for each call to pack subtype - CALL MAP_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_old, ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt_old - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt_old - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt_old - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt_old - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! Output allocated yes/no - IF ( ALLOCATED(InData%Output) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Output upper/lower bounds for each dimension - DO i1 = LBOUND(InData%Output,1), UBOUND(InData%Output,1) - Int_BufSz = Int_BufSz + 3 ! Output: size of buffers for each call to pack subtype - CALL MAP_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Output(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Output - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Output - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Output - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Output - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! y_interp: size of buffers for each call to pack subtype - CALL MAP_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_interp, ErrStat2, ErrMsg2, .TRUE. ) ! y_interp - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y_interp - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y_interp - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y_interp - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! Input allocated yes/no - IF ( ALLOCATED(InData%Input) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Input upper/lower bounds for each dimension - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - Int_BufSz = Int_BufSz + 3 ! Input: size of buffers for each call to pack subtype - CALL MAP_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Input - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Input - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Input - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! InputTimes allocated yes/no - IF ( ALLOCATED(InData%InputTimes) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! InputTimes upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes - 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 i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - CALL MAP_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, OnlySize ) ! x - 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 - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - CALL MAP_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd - 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 - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - CALL MAP_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, OnlySize ) ! z - 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 - CALL MAP_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt, ErrStat2, ErrMsg2, OnlySize ) ! OtherSt - 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 MAP_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! p - 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 MAP_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u - 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 MAP_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y - 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 MAP_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_old, ErrStat2, ErrMsg2, OnlySize ) ! OtherSt_old - 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%Output) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Output,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Output,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Output,1), UBOUND(InData%Output,1) - CALL MAP_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Output(i1), ErrStat2, ErrMsg2, OnlySize ) ! Output - 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 - CALL MAP_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_interp, ErrStat2, ErrMsg2, OnlySize ) ! y_interp - 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%Input) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Input,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - CALL MAP_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input - 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%InputTimes) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InputTimes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%InputTimes,1), UBOUND(InData%InputTimes,1) - DbKiBuf(Db_Xferred) = InData%InputTimes(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE FAST_PackMAP_Data - - SUBROUTINE FAST_UnPackMAP_Data( 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(MAP_Data), 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 = 'FAST_UnPackMAP_Data' - ! 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%x,1) - i1_u = UBOUND(OutData%x,1) - DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,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 MAP_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x(i1), ErrStat2, ErrMsg2 ) ! x - 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 - i1_l = LBOUND(OutData%xd,1) - i1_u = UBOUND(OutData%xd,1) - DO i1 = LBOUND(OutData%xd,1), UBOUND(OutData%xd,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 MAP_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1), ErrStat2, ErrMsg2 ) ! xd - 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 - i1_l = LBOUND(OutData%z,1) - i1_u = UBOUND(OutData%z,1) - DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,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 MAP_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1), ErrStat2, ErrMsg2 ) ! z - 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 - 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 MAP_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt, ErrStat2, ErrMsg2 ) ! OtherSt - 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 MAP_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p - 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 MAP_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u - 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 MAP_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y - 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 MAP_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt_old, ErrStat2, ErrMsg2 ) ! OtherSt_old - 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 ! Output not allocated - Int_Xferred = Int_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%Output)) DEALLOCATE(OutData%Output) - ALLOCATE(OutData%Output(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Output,1), UBOUND(OutData%Output,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 MAP_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%Output(i1), ErrStat2, ErrMsg2 ) ! Output - 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 - 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 MAP_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y_interp, ErrStat2, ErrMsg2 ) ! y_interp - 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 ! Input not allocated - Int_Xferred = Int_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%Input)) DEALLOCATE(OutData%Input) - ALLOCATE(OutData%Input(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Input,1), UBOUND(OutData%Input,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 MAP_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input(i1), ErrStat2, ErrMsg2 ) ! Input - 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 ! InputTimes not allocated - Int_Xferred = Int_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%InputTimes)) DEALLOCATE(OutData%InputTimes) - ALLOCATE(OutData%InputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%InputTimes,1), UBOUND(OutData%InputTimes,1) - OutData%InputTimes(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE FAST_UnPackMAP_Data - - SUBROUTINE FAST_CopyFEAMooring_Data( SrcFEAMooring_DataData, DstFEAMooring_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FEAMooring_Data), INTENT(INOUT) :: SrcFEAMooring_DataData - TYPE(FEAMooring_Data), INTENT(INOUT) :: DstFEAMooring_DataData - 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 = 'FAST_CopyFEAMooring_Data' -! + ErrMsg = '' + if (allocated(SrcIceDyn_DataData%x)) then + LB(1:2) = lbound(SrcIceDyn_DataData%x) + UB(1:2) = ubound(SrcIceDyn_DataData%x) + if (.not. allocated(DstIceDyn_DataData%x)) then + allocate(DstIceDyn_DataData%x(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_CopyContState(SrcIceDyn_DataData%x(i1,i2), DstIceDyn_DataData%x(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do + end if + if (allocated(SrcIceDyn_DataData%xd)) then + LB(1:2) = lbound(SrcIceDyn_DataData%xd) + UB(1:2) = ubound(SrcIceDyn_DataData%xd) + if (.not. allocated(DstIceDyn_DataData%xd)) then + allocate(DstIceDyn_DataData%xd(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%xd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_CopyDiscState(SrcIceDyn_DataData%xd(i1,i2), DstIceDyn_DataData%xd(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do + end if + if (allocated(SrcIceDyn_DataData%z)) then + LB(1:2) = lbound(SrcIceDyn_DataData%z) + UB(1:2) = ubound(SrcIceDyn_DataData%z) + if (.not. allocated(DstIceDyn_DataData%z)) then + allocate(DstIceDyn_DataData%z(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%z.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_CopyConstrState(SrcIceDyn_DataData%z(i1,i2), DstIceDyn_DataData%z(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do + end if + if (allocated(SrcIceDyn_DataData%OtherSt)) then + LB(1:2) = lbound(SrcIceDyn_DataData%OtherSt) + UB(1:2) = ubound(SrcIceDyn_DataData%OtherSt) + if (.not. allocated(DstIceDyn_DataData%OtherSt)) then + allocate(DstIceDyn_DataData%OtherSt(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%OtherSt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_CopyOtherState(SrcIceDyn_DataData%OtherSt(i1,i2), DstIceDyn_DataData%OtherSt(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do + end if + if (allocated(SrcIceDyn_DataData%p)) then + LB(1:1) = lbound(SrcIceDyn_DataData%p) + UB(1:1) = ubound(SrcIceDyn_DataData%p) + if (.not. allocated(DstIceDyn_DataData%p)) then + allocate(DstIceDyn_DataData%p(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%p.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call IceD_CopyParam(SrcIceDyn_DataData%p(i1), DstIceDyn_DataData%p(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcIceDyn_DataData%u)) then + LB(1:1) = lbound(SrcIceDyn_DataData%u) + UB(1:1) = ubound(SrcIceDyn_DataData%u) + if (.not. allocated(DstIceDyn_DataData%u)) then + allocate(DstIceDyn_DataData%u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call IceD_CopyInput(SrcIceDyn_DataData%u(i1), DstIceDyn_DataData%u(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcIceDyn_DataData%y)) then + LB(1:1) = lbound(SrcIceDyn_DataData%y) + UB(1:1) = ubound(SrcIceDyn_DataData%y) + if (.not. allocated(DstIceDyn_DataData%y)) then + allocate(DstIceDyn_DataData%y(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%y.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call IceD_CopyOutput(SrcIceDyn_DataData%y(i1), DstIceDyn_DataData%y(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcIceDyn_DataData%m)) then + LB(1:1) = lbound(SrcIceDyn_DataData%m) + UB(1:1) = ubound(SrcIceDyn_DataData%m) + if (.not. allocated(DstIceDyn_DataData%m)) then + allocate(DstIceDyn_DataData%m(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%m.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call IceD_CopyMisc(SrcIceDyn_DataData%m(i1), DstIceDyn_DataData%m(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcIceDyn_DataData%Input)) then + LB(1:2) = lbound(SrcIceDyn_DataData%Input) + UB(1:2) = ubound(SrcIceDyn_DataData%Input) + if (.not. allocated(DstIceDyn_DataData%Input)) then + allocate(DstIceDyn_DataData%Input(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%Input.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_CopyInput(SrcIceDyn_DataData%Input(i1,i2), DstIceDyn_DataData%Input(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do + end if + if (allocated(SrcIceDyn_DataData%Input_Saved)) then + LB(1:2) = lbound(SrcIceDyn_DataData%Input_Saved) + UB(1:2) = ubound(SrcIceDyn_DataData%Input_Saved) + if (.not. allocated(DstIceDyn_DataData%Input_Saved)) then + allocate(DstIceDyn_DataData%Input_Saved(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%Input_Saved.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_CopyInput(SrcIceDyn_DataData%Input_Saved(i1,i2), DstIceDyn_DataData%Input_Saved(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do + end if + if (allocated(SrcIceDyn_DataData%InputTimes)) then + LB(1:2) = lbound(SrcIceDyn_DataData%InputTimes) + UB(1:2) = ubound(SrcIceDyn_DataData%InputTimes) + if (.not. allocated(DstIceDyn_DataData%InputTimes)) then + allocate(DstIceDyn_DataData%InputTimes(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%InputTimes.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstIceDyn_DataData%InputTimes = SrcIceDyn_DataData%InputTimes + end if + if (allocated(SrcIceDyn_DataData%InputTimes_Saved)) then + LB(1:2) = lbound(SrcIceDyn_DataData%InputTimes_Saved) + UB(1:2) = ubound(SrcIceDyn_DataData%InputTimes_Saved) + if (.not. allocated(DstIceDyn_DataData%InputTimes_Saved)) then + allocate(DstIceDyn_DataData%InputTimes_Saved(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%InputTimes_Saved.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstIceDyn_DataData%InputTimes_Saved = SrcIceDyn_DataData%InputTimes_Saved + end if +end subroutine + +subroutine FAST_DestroyIceDyn_Data(IceDyn_DataData, ErrStat, ErrMsg) + type(IceDyn_Data), intent(inout) :: IceDyn_DataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_DestroyIceDyn_Data' ErrStat = ErrID_None - ErrMsg = "" - DO i1 = LBOUND(SrcFEAMooring_DataData%x,1), UBOUND(SrcFEAMooring_DataData%x,1) - CALL FEAM_CopyContState( SrcFEAMooring_DataData%x(i1), DstFEAMooring_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcFEAMooring_DataData%xd,1), UBOUND(SrcFEAMooring_DataData%xd,1) - CALL FEAM_CopyDiscState( SrcFEAMooring_DataData%xd(i1), DstFEAMooring_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcFEAMooring_DataData%z,1), UBOUND(SrcFEAMooring_DataData%z,1) - CALL FEAM_CopyConstrState( SrcFEAMooring_DataData%z(i1), DstFEAMooring_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcFEAMooring_DataData%OtherSt,1), UBOUND(SrcFEAMooring_DataData%OtherSt,1) - CALL FEAM_CopyOtherState( SrcFEAMooring_DataData%OtherSt(i1), DstFEAMooring_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - CALL FEAM_CopyParam( SrcFEAMooring_DataData%p, DstFEAMooring_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL FEAM_CopyInput( SrcFEAMooring_DataData%u, DstFEAMooring_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL FEAM_CopyOutput( SrcFEAMooring_DataData%y, DstFEAMooring_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL FEAM_CopyMisc( SrcFEAMooring_DataData%m, DstFEAMooring_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcFEAMooring_DataData%Input)) THEN - i1_l = LBOUND(SrcFEAMooring_DataData%Input,1) - i1_u = UBOUND(SrcFEAMooring_DataData%Input,1) - IF (.NOT. ALLOCATED(DstFEAMooring_DataData%Input)) THEN - ALLOCATE(DstFEAMooring_DataData%Input(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstFEAMooring_DataData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcFEAMooring_DataData%Input,1), UBOUND(SrcFEAMooring_DataData%Input,1) - CALL FEAM_CopyInput( SrcFEAMooring_DataData%Input(i1), DstFEAMooring_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcFEAMooring_DataData%InputTimes)) THEN - i1_l = LBOUND(SrcFEAMooring_DataData%InputTimes,1) - i1_u = UBOUND(SrcFEAMooring_DataData%InputTimes,1) - IF (.NOT. ALLOCATED(DstFEAMooring_DataData%InputTimes)) THEN - ALLOCATE(DstFEAMooring_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstFEAMooring_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstFEAMooring_DataData%InputTimes = SrcFEAMooring_DataData%InputTimes -ENDIF - END SUBROUTINE FAST_CopyFEAMooring_Data - - SUBROUTINE FAST_DestroyFEAMooring_Data( FEAMooring_DataData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(FEAMooring_Data), INTENT(INOUT) :: FEAMooring_DataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyFEAMooring_Data' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -DO i1 = LBOUND(FEAMooring_DataData%x,1), UBOUND(FEAMooring_DataData%x,1) - CALL FEAM_DestroyContState( FEAMooring_DataData%x(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(FEAMooring_DataData%xd,1), UBOUND(FEAMooring_DataData%xd,1) - CALL FEAM_DestroyDiscState( FEAMooring_DataData%xd(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(FEAMooring_DataData%z,1), UBOUND(FEAMooring_DataData%z,1) - CALL FEAM_DestroyConstrState( FEAMooring_DataData%z(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(FEAMooring_DataData%OtherSt,1), UBOUND(FEAMooring_DataData%OtherSt,1) - CALL FEAM_DestroyOtherState( FEAMooring_DataData%OtherSt(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - CALL FEAM_DestroyParam( FEAMooring_DataData%p, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FEAM_DestroyInput( FEAMooring_DataData%u, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FEAM_DestroyOutput( FEAMooring_DataData%y, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FEAM_DestroyMisc( FEAMooring_DataData%m, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(FEAMooring_DataData%Input)) THEN -DO i1 = LBOUND(FEAMooring_DataData%Input,1), UBOUND(FEAMooring_DataData%Input,1) - CALL FEAM_DestroyInput( FEAMooring_DataData%Input(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(FEAMooring_DataData%Input) -ENDIF -IF (ALLOCATED(FEAMooring_DataData%InputTimes)) THEN - DEALLOCATE(FEAMooring_DataData%InputTimes) -ENDIF - END SUBROUTINE FAST_DestroyFEAMooring_Data - - SUBROUTINE FAST_PackFEAMooring_Data( 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(FEAMooring_Data), 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 = 'FAST_PackFEAMooring_Data' - ! 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) - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - Int_BufSz = Int_BufSz + 3 ! x: size of buffers for each call to pack subtype - CALL FEAM_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype - CALL FEAM_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xd - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype - CALL FEAM_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! z - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! z - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! z - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - Int_BufSz = Int_BufSz + 3 ! OtherSt: size of buffers for each call to pack subtype - CALL FEAM_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype - CALL FEAM_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! p - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! p - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! p - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype - CALL FEAM_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype - CALL FEAM_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype - CALL FEAM_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! m - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! m - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! m - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! Input allocated yes/no - IF ( ALLOCATED(InData%Input) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Input upper/lower bounds for each dimension - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - Int_BufSz = Int_BufSz + 3 ! Input: size of buffers for each call to pack subtype - CALL FEAM_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Input - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Input - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Input - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! InputTimes allocated yes/no - IF ( ALLOCATED(InData%InputTimes) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! InputTimes upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes - 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 i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - CALL FEAM_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, OnlySize ) ! x - 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 - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - CALL FEAM_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd - 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 - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - CALL FEAM_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, OnlySize ) ! z - 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 - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - CALL FEAM_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt - 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 - CALL FEAM_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! p - 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 FEAM_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u - 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 FEAM_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y - 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 FEAM_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! m - 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%Input) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Input,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - CALL FEAM_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input - 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%InputTimes) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InputTimes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%InputTimes,1), UBOUND(InData%InputTimes,1) - DbKiBuf(Db_Xferred) = InData%InputTimes(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE FAST_PackFEAMooring_Data - - SUBROUTINE FAST_UnPackFEAMooring_Data( 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(FEAMooring_Data), 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 = 'FAST_UnPackFEAMooring_Data' - ! 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%x,1) - i1_u = UBOUND(OutData%x,1) - DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,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 FEAM_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x(i1), ErrStat2, ErrMsg2 ) ! x - 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 - i1_l = LBOUND(OutData%xd,1) - i1_u = UBOUND(OutData%xd,1) - DO i1 = LBOUND(OutData%xd,1), UBOUND(OutData%xd,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 FEAM_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1), ErrStat2, ErrMsg2 ) ! xd - 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 - i1_l = LBOUND(OutData%z,1) - i1_u = UBOUND(OutData%z,1) - DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,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 FEAM_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1), ErrStat2, ErrMsg2 ) ! z - 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 - i1_l = LBOUND(OutData%OtherSt,1) - i1_u = UBOUND(OutData%OtherSt,1) - DO i1 = LBOUND(OutData%OtherSt,1), UBOUND(OutData%OtherSt,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 FEAM_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt(i1), ErrStat2, ErrMsg2 ) ! OtherSt - 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 - 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 FEAM_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p - 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 FEAM_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u - 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 FEAM_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y - 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 FEAM_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! m - 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 ! Input not allocated - Int_Xferred = Int_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%Input)) DEALLOCATE(OutData%Input) - ALLOCATE(OutData%Input(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Input,1), UBOUND(OutData%Input,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 FEAM_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input(i1), ErrStat2, ErrMsg2 ) ! Input - 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 ! InputTimes not allocated - Int_Xferred = Int_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%InputTimes)) DEALLOCATE(OutData%InputTimes) - ALLOCATE(OutData%InputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%InputTimes,1), UBOUND(OutData%InputTimes,1) - OutData%InputTimes(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE FAST_UnPackFEAMooring_Data - - SUBROUTINE FAST_CopyMoorDyn_Data( SrcMoorDyn_DataData, DstMoorDyn_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MoorDyn_Data), INTENT(INOUT) :: SrcMoorDyn_DataData - TYPE(MoorDyn_Data), INTENT(INOUT) :: DstMoorDyn_DataData - 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 = 'FAST_CopyMoorDyn_Data' -! - ErrStat = ErrID_None - ErrMsg = "" - DO i1 = LBOUND(SrcMoorDyn_DataData%x,1), UBOUND(SrcMoorDyn_DataData%x,1) - CALL MD_CopyContState( SrcMoorDyn_DataData%x(i1), DstMoorDyn_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcMoorDyn_DataData%xd,1), UBOUND(SrcMoorDyn_DataData%xd,1) - CALL MD_CopyDiscState( SrcMoorDyn_DataData%xd(i1), DstMoorDyn_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcMoorDyn_DataData%z,1), UBOUND(SrcMoorDyn_DataData%z,1) - CALL MD_CopyConstrState( SrcMoorDyn_DataData%z(i1), DstMoorDyn_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcMoorDyn_DataData%OtherSt,1), UBOUND(SrcMoorDyn_DataData%OtherSt,1) - CALL MD_CopyOtherState( SrcMoorDyn_DataData%OtherSt(i1), DstMoorDyn_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - CALL MD_CopyParam( SrcMoorDyn_DataData%p, DstMoorDyn_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MD_CopyInput( SrcMoorDyn_DataData%u, DstMoorDyn_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MD_CopyOutput( SrcMoorDyn_DataData%y, DstMoorDyn_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MD_CopyMisc( SrcMoorDyn_DataData%m, DstMoorDyn_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcMoorDyn_DataData%Output)) THEN - i1_l = LBOUND(SrcMoorDyn_DataData%Output,1) - i1_u = UBOUND(SrcMoorDyn_DataData%Output,1) - IF (.NOT. ALLOCATED(DstMoorDyn_DataData%Output)) THEN - ALLOCATE(DstMoorDyn_DataData%Output(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMoorDyn_DataData%Output.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMoorDyn_DataData%Output,1), UBOUND(SrcMoorDyn_DataData%Output,1) - CALL MD_CopyOutput( SrcMoorDyn_DataData%Output(i1), DstMoorDyn_DataData%Output(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL MD_CopyOutput( SrcMoorDyn_DataData%y_interp, DstMoorDyn_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcMoorDyn_DataData%Input)) THEN - i1_l = LBOUND(SrcMoorDyn_DataData%Input,1) - i1_u = UBOUND(SrcMoorDyn_DataData%Input,1) - IF (.NOT. ALLOCATED(DstMoorDyn_DataData%Input)) THEN - ALLOCATE(DstMoorDyn_DataData%Input(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMoorDyn_DataData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMoorDyn_DataData%Input,1), UBOUND(SrcMoorDyn_DataData%Input,1) - CALL MD_CopyInput( SrcMoorDyn_DataData%Input(i1), DstMoorDyn_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcMoorDyn_DataData%InputTimes)) THEN - i1_l = LBOUND(SrcMoorDyn_DataData%InputTimes,1) - i1_u = UBOUND(SrcMoorDyn_DataData%InputTimes,1) - IF (.NOT. ALLOCATED(DstMoorDyn_DataData%InputTimes)) THEN - ALLOCATE(DstMoorDyn_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMoorDyn_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMoorDyn_DataData%InputTimes = SrcMoorDyn_DataData%InputTimes -ENDIF - END SUBROUTINE FAST_CopyMoorDyn_Data - - SUBROUTINE FAST_DestroyMoorDyn_Data( MoorDyn_DataData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(MoorDyn_Data), INTENT(INOUT) :: MoorDyn_DataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyMoorDyn_Data' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -DO i1 = LBOUND(MoorDyn_DataData%x,1), UBOUND(MoorDyn_DataData%x,1) - CALL MD_DestroyContState( MoorDyn_DataData%x(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(MoorDyn_DataData%xd,1), UBOUND(MoorDyn_DataData%xd,1) - CALL MD_DestroyDiscState( MoorDyn_DataData%xd(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(MoorDyn_DataData%z,1), UBOUND(MoorDyn_DataData%z,1) - CALL MD_DestroyConstrState( MoorDyn_DataData%z(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(MoorDyn_DataData%OtherSt,1), UBOUND(MoorDyn_DataData%OtherSt,1) - CALL MD_DestroyOtherState( MoorDyn_DataData%OtherSt(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - CALL MD_DestroyParam( MoorDyn_DataData%p, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MD_DestroyInput( MoorDyn_DataData%u, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MD_DestroyOutput( MoorDyn_DataData%y, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MD_DestroyMisc( MoorDyn_DataData%m, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(MoorDyn_DataData%Output)) THEN -DO i1 = LBOUND(MoorDyn_DataData%Output,1), UBOUND(MoorDyn_DataData%Output,1) - CALL MD_DestroyOutput( MoorDyn_DataData%Output(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MoorDyn_DataData%Output) -ENDIF - CALL MD_DestroyOutput( MoorDyn_DataData%y_interp, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(MoorDyn_DataData%Input)) THEN -DO i1 = LBOUND(MoorDyn_DataData%Input,1), UBOUND(MoorDyn_DataData%Input,1) - CALL MD_DestroyInput( MoorDyn_DataData%Input(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MoorDyn_DataData%Input) -ENDIF -IF (ALLOCATED(MoorDyn_DataData%InputTimes)) THEN - DEALLOCATE(MoorDyn_DataData%InputTimes) -ENDIF - END SUBROUTINE FAST_DestroyMoorDyn_Data - - SUBROUTINE FAST_PackMoorDyn_Data( 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(MoorDyn_Data), 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 = 'FAST_PackMoorDyn_Data' - ! 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) - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - Int_BufSz = Int_BufSz + 3 ! x: size of buffers for each call to pack subtype - CALL MD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype - CALL MD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xd - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype - CALL MD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! z - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! z - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! z - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - Int_BufSz = Int_BufSz + 3 ! OtherSt: size of buffers for each call to pack subtype - CALL MD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype - CALL MD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! p - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! p - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! p - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype - CALL MD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype - CALL MD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype - CALL MD_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! m - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! m - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! m - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! Output allocated yes/no - IF ( ALLOCATED(InData%Output) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Output upper/lower bounds for each dimension - DO i1 = LBOUND(InData%Output,1), UBOUND(InData%Output,1) - Int_BufSz = Int_BufSz + 3 ! Output: size of buffers for each call to pack subtype - CALL MD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Output(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Output - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Output - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Output - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Output - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! y_interp: size of buffers for each call to pack subtype - CALL MD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_interp, ErrStat2, ErrMsg2, .TRUE. ) ! y_interp - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y_interp - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y_interp - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y_interp - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! Input allocated yes/no - IF ( ALLOCATED(InData%Input) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Input upper/lower bounds for each dimension - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - Int_BufSz = Int_BufSz + 3 ! Input: size of buffers for each call to pack subtype - CALL MD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Input - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Input - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Input - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! InputTimes allocated yes/no - IF ( ALLOCATED(InData%InputTimes) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! InputTimes upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes - 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 i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - CALL MD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, OnlySize ) ! x - 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 - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - CALL MD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd - 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 - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - CALL MD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, OnlySize ) ! z - 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 - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - CALL MD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt - 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 - CALL MD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! p - 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 MD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u - 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 MD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y - 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 MD_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! m - 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%Output) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Output,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Output,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Output,1), UBOUND(InData%Output,1) - CALL MD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Output(i1), ErrStat2, ErrMsg2, OnlySize ) ! Output - 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 - CALL MD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_interp, ErrStat2, ErrMsg2, OnlySize ) ! y_interp - 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%Input) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Input,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - CALL MD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input - 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%InputTimes) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InputTimes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%InputTimes,1), UBOUND(InData%InputTimes,1) - DbKiBuf(Db_Xferred) = InData%InputTimes(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE FAST_PackMoorDyn_Data - - SUBROUTINE FAST_UnPackMoorDyn_Data( 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(MoorDyn_Data), 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 = 'FAST_UnPackMoorDyn_Data' - ! 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%x,1) - i1_u = UBOUND(OutData%x,1) - DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,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 MD_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x(i1), ErrStat2, ErrMsg2 ) ! x - 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 - i1_l = LBOUND(OutData%xd,1) - i1_u = UBOUND(OutData%xd,1) - DO i1 = LBOUND(OutData%xd,1), UBOUND(OutData%xd,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 MD_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1), ErrStat2, ErrMsg2 ) ! xd - 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 - i1_l = LBOUND(OutData%z,1) - i1_u = UBOUND(OutData%z,1) - DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,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 MD_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1), ErrStat2, ErrMsg2 ) ! z - 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 - i1_l = LBOUND(OutData%OtherSt,1) - i1_u = UBOUND(OutData%OtherSt,1) - DO i1 = LBOUND(OutData%OtherSt,1), UBOUND(OutData%OtherSt,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 MD_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt(i1), ErrStat2, ErrMsg2 ) ! OtherSt - 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 - 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 MD_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p - 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 MD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u - 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 MD_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y - 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 MD_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! m - 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 ! Output not allocated - Int_Xferred = Int_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%Output)) DEALLOCATE(OutData%Output) - ALLOCATE(OutData%Output(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Output,1), UBOUND(OutData%Output,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 MD_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%Output(i1), ErrStat2, ErrMsg2 ) ! Output - 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 - 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 MD_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y_interp, ErrStat2, ErrMsg2 ) ! y_interp - 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 ! Input not allocated - Int_Xferred = Int_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%Input)) DEALLOCATE(OutData%Input) - ALLOCATE(OutData%Input(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Input,1), UBOUND(OutData%Input,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 MD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input(i1), ErrStat2, ErrMsg2 ) ! Input - 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 ! InputTimes not allocated - Int_Xferred = Int_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%InputTimes)) DEALLOCATE(OutData%InputTimes) - ALLOCATE(OutData%InputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%InputTimes,1), UBOUND(OutData%InputTimes,1) - OutData%InputTimes(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE FAST_UnPackMoorDyn_Data - - SUBROUTINE FAST_CopyOrcaFlex_Data( SrcOrcaFlex_DataData, DstOrcaFlex_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(OrcaFlex_Data), INTENT(INOUT) :: SrcOrcaFlex_DataData - TYPE(OrcaFlex_Data), INTENT(INOUT) :: DstOrcaFlex_DataData - 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 = 'FAST_CopyOrcaFlex_Data' -! + ErrMsg = '' + if (allocated(IceDyn_DataData%x)) then + LB(1:2) = lbound(IceDyn_DataData%x) + UB(1:2) = ubound(IceDyn_DataData%x) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_DestroyContState(IceDyn_DataData%x(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + deallocate(IceDyn_DataData%x) + end if + if (allocated(IceDyn_DataData%xd)) then + LB(1:2) = lbound(IceDyn_DataData%xd) + UB(1:2) = ubound(IceDyn_DataData%xd) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_DestroyDiscState(IceDyn_DataData%xd(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + deallocate(IceDyn_DataData%xd) + end if + if (allocated(IceDyn_DataData%z)) then + LB(1:2) = lbound(IceDyn_DataData%z) + UB(1:2) = ubound(IceDyn_DataData%z) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_DestroyConstrState(IceDyn_DataData%z(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + deallocate(IceDyn_DataData%z) + end if + if (allocated(IceDyn_DataData%OtherSt)) then + LB(1:2) = lbound(IceDyn_DataData%OtherSt) + UB(1:2) = ubound(IceDyn_DataData%OtherSt) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_DestroyOtherState(IceDyn_DataData%OtherSt(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + deallocate(IceDyn_DataData%OtherSt) + end if + if (allocated(IceDyn_DataData%p)) then + LB(1:1) = lbound(IceDyn_DataData%p) + UB(1:1) = ubound(IceDyn_DataData%p) + do i1 = LB(1), UB(1) + call IceD_DestroyParam(IceDyn_DataData%p(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(IceDyn_DataData%p) + end if + if (allocated(IceDyn_DataData%u)) then + LB(1:1) = lbound(IceDyn_DataData%u) + UB(1:1) = ubound(IceDyn_DataData%u) + do i1 = LB(1), UB(1) + call IceD_DestroyInput(IceDyn_DataData%u(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(IceDyn_DataData%u) + end if + if (allocated(IceDyn_DataData%y)) then + LB(1:1) = lbound(IceDyn_DataData%y) + UB(1:1) = ubound(IceDyn_DataData%y) + do i1 = LB(1), UB(1) + call IceD_DestroyOutput(IceDyn_DataData%y(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(IceDyn_DataData%y) + end if + if (allocated(IceDyn_DataData%m)) then + LB(1:1) = lbound(IceDyn_DataData%m) + UB(1:1) = ubound(IceDyn_DataData%m) + do i1 = LB(1), UB(1) + call IceD_DestroyMisc(IceDyn_DataData%m(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(IceDyn_DataData%m) + end if + if (allocated(IceDyn_DataData%Input)) then + LB(1:2) = lbound(IceDyn_DataData%Input) + UB(1:2) = ubound(IceDyn_DataData%Input) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_DestroyInput(IceDyn_DataData%Input(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + deallocate(IceDyn_DataData%Input) + end if + if (allocated(IceDyn_DataData%Input_Saved)) then + LB(1:2) = lbound(IceDyn_DataData%Input_Saved) + UB(1:2) = ubound(IceDyn_DataData%Input_Saved) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_DestroyInput(IceDyn_DataData%Input_Saved(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + deallocate(IceDyn_DataData%Input_Saved) + end if + if (allocated(IceDyn_DataData%InputTimes)) then + deallocate(IceDyn_DataData%InputTimes) + end if + if (allocated(IceDyn_DataData%InputTimes_Saved)) then + deallocate(IceDyn_DataData%InputTimes_Saved) + end if +end subroutine + +subroutine FAST_PackIceDyn_Data(RF, Indata) + type(RegFile), intent(inout) :: RF + type(IceDyn_Data), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackIceDyn_Data' + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%x)) + if (allocated(InData%x)) then + call RegPackBounds(RF, 2, lbound(InData%x), ubound(InData%x)) + LB(1:2) = lbound(InData%x) + UB(1:2) = ubound(InData%x) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_PackContState(RF, InData%x(i1,i2)) + end do + end do + end if + call RegPack(RF, allocated(InData%xd)) + if (allocated(InData%xd)) then + call RegPackBounds(RF, 2, lbound(InData%xd), ubound(InData%xd)) + LB(1:2) = lbound(InData%xd) + UB(1:2) = ubound(InData%xd) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_PackDiscState(RF, InData%xd(i1,i2)) + end do + end do + end if + call RegPack(RF, allocated(InData%z)) + if (allocated(InData%z)) then + call RegPackBounds(RF, 2, lbound(InData%z), ubound(InData%z)) + LB(1:2) = lbound(InData%z) + UB(1:2) = ubound(InData%z) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_PackConstrState(RF, InData%z(i1,i2)) + end do + end do + end if + call RegPack(RF, allocated(InData%OtherSt)) + if (allocated(InData%OtherSt)) then + call RegPackBounds(RF, 2, lbound(InData%OtherSt), ubound(InData%OtherSt)) + LB(1:2) = lbound(InData%OtherSt) + UB(1:2) = ubound(InData%OtherSt) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_PackOtherState(RF, InData%OtherSt(i1,i2)) + end do + end do + end if + call RegPack(RF, allocated(InData%p)) + if (allocated(InData%p)) then + call RegPackBounds(RF, 1, lbound(InData%p), ubound(InData%p)) + LB(1:1) = lbound(InData%p) + UB(1:1) = ubound(InData%p) + do i1 = LB(1), UB(1) + call IceD_PackParam(RF, InData%p(i1)) + end do + end if + call RegPack(RF, allocated(InData%u)) + if (allocated(InData%u)) then + call RegPackBounds(RF, 1, lbound(InData%u), ubound(InData%u)) + LB(1:1) = lbound(InData%u) + UB(1:1) = ubound(InData%u) + do i1 = LB(1), UB(1) + call IceD_PackInput(RF, InData%u(i1)) + end do + end if + call RegPack(RF, allocated(InData%y)) + if (allocated(InData%y)) then + call RegPackBounds(RF, 1, lbound(InData%y), ubound(InData%y)) + LB(1:1) = lbound(InData%y) + UB(1:1) = ubound(InData%y) + do i1 = LB(1), UB(1) + call IceD_PackOutput(RF, InData%y(i1)) + end do + end if + call RegPack(RF, allocated(InData%m)) + if (allocated(InData%m)) then + call RegPackBounds(RF, 1, lbound(InData%m), ubound(InData%m)) + LB(1:1) = lbound(InData%m) + UB(1:1) = ubound(InData%m) + do i1 = LB(1), UB(1) + call IceD_PackMisc(RF, InData%m(i1)) + end do + end if + call RegPack(RF, allocated(InData%Input)) + if (allocated(InData%Input)) then + call RegPackBounds(RF, 2, lbound(InData%Input), ubound(InData%Input)) + LB(1:2) = lbound(InData%Input) + UB(1:2) = ubound(InData%Input) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_PackInput(RF, InData%Input(i1,i2)) + end do + end do + end if + call RegPack(RF, allocated(InData%Input_Saved)) + if (allocated(InData%Input_Saved)) then + call RegPackBounds(RF, 2, lbound(InData%Input_Saved), ubound(InData%Input_Saved)) + LB(1:2) = lbound(InData%Input_Saved) + UB(1:2) = ubound(InData%Input_Saved) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_PackInput(RF, InData%Input_Saved(i1,i2)) + end do + end do + end if + call RegPackAlloc(RF, InData%InputTimes) + call RegPackAlloc(RF, InData%InputTimes_Saved) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FAST_UnPackIceDyn_Data(RF, OutData) + type(RegFile), intent(inout) :: RF + type(IceDyn_Data), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackIceDyn_Data' + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + if (allocated(OutData%x)) deallocate(OutData%x) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%x(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_UnpackContState(RF, OutData%x(i1,i2)) ! x + end do + end do + end if + if (allocated(OutData%xd)) deallocate(OutData%xd) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%xd(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_UnpackDiscState(RF, OutData%xd(i1,i2)) ! xd + end do + end do + end if + if (allocated(OutData%z)) deallocate(OutData%z) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%z(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_UnpackConstrState(RF, OutData%z(i1,i2)) ! z + end do + end do + end if + if (allocated(OutData%OtherSt)) deallocate(OutData%OtherSt) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%OtherSt(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_UnpackOtherState(RF, OutData%OtherSt(i1,i2)) ! OtherSt + end do + end do + end if + if (allocated(OutData%p)) deallocate(OutData%p) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%p(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%p.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call IceD_UnpackParam(RF, OutData%p(i1)) ! p + end do + end if + if (allocated(OutData%u)) deallocate(OutData%u) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%u(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call IceD_UnpackInput(RF, OutData%u(i1)) ! u + end do + end if + if (allocated(OutData%y)) deallocate(OutData%y) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%y(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%y.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call IceD_UnpackOutput(RF, OutData%y(i1)) ! y + end do + end if + if (allocated(OutData%m)) deallocate(OutData%m) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%m(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%m.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call IceD_UnpackMisc(RF, OutData%m(i1)) ! m + end do + end if + if (allocated(OutData%Input)) deallocate(OutData%Input) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%Input(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_UnpackInput(RF, OutData%Input(i1,i2)) ! Input + end do + end do + end if + if (allocated(OutData%Input_Saved)) deallocate(OutData%Input_Saved) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%Input_Saved(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input_Saved.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_UnpackInput(RF, OutData%Input_Saved(i1,i2)) ! Input_Saved + end do + end do + end if + call RegUnpackAlloc(RF, OutData%InputTimes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%InputTimes_Saved); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FAST_CopyBeamDyn_Data(SrcBeamDyn_DataData, DstBeamDyn_DataData, CtrlCode, ErrStat, ErrMsg) + type(BeamDyn_Data), intent(inout) :: SrcBeamDyn_DataData + type(BeamDyn_Data), intent(inout) :: DstBeamDyn_DataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_CopyBeamDyn_Data' ErrStat = ErrID_None - ErrMsg = "" - DO i1 = LBOUND(SrcOrcaFlex_DataData%x,1), UBOUND(SrcOrcaFlex_DataData%x,1) - CALL Orca_CopyContState( SrcOrcaFlex_DataData%x(i1), DstOrcaFlex_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcOrcaFlex_DataData%xd,1), UBOUND(SrcOrcaFlex_DataData%xd,1) - CALL Orca_CopyDiscState( SrcOrcaFlex_DataData%xd(i1), DstOrcaFlex_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcOrcaFlex_DataData%z,1), UBOUND(SrcOrcaFlex_DataData%z,1) - CALL Orca_CopyConstrState( SrcOrcaFlex_DataData%z(i1), DstOrcaFlex_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcOrcaFlex_DataData%OtherSt,1), UBOUND(SrcOrcaFlex_DataData%OtherSt,1) - CALL Orca_CopyOtherState( SrcOrcaFlex_DataData%OtherSt(i1), DstOrcaFlex_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - CALL Orca_CopyParam( SrcOrcaFlex_DataData%p, DstOrcaFlex_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL Orca_CopyInput( SrcOrcaFlex_DataData%u, DstOrcaFlex_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL Orca_CopyOutput( SrcOrcaFlex_DataData%y, DstOrcaFlex_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL Orca_CopyMisc( SrcOrcaFlex_DataData%m, DstOrcaFlex_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcOrcaFlex_DataData%Input)) THEN - i1_l = LBOUND(SrcOrcaFlex_DataData%Input,1) - i1_u = UBOUND(SrcOrcaFlex_DataData%Input,1) - IF (.NOT. ALLOCATED(DstOrcaFlex_DataData%Input)) THEN - ALLOCATE(DstOrcaFlex_DataData%Input(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOrcaFlex_DataData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcOrcaFlex_DataData%Input,1), UBOUND(SrcOrcaFlex_DataData%Input,1) - CALL Orca_CopyInput( SrcOrcaFlex_DataData%Input(i1), DstOrcaFlex_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcOrcaFlex_DataData%InputTimes)) THEN - i1_l = LBOUND(SrcOrcaFlex_DataData%InputTimes,1) - i1_u = UBOUND(SrcOrcaFlex_DataData%InputTimes,1) - IF (.NOT. ALLOCATED(DstOrcaFlex_DataData%InputTimes)) THEN - ALLOCATE(DstOrcaFlex_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOrcaFlex_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOrcaFlex_DataData%InputTimes = SrcOrcaFlex_DataData%InputTimes -ENDIF - END SUBROUTINE FAST_CopyOrcaFlex_Data - - SUBROUTINE FAST_DestroyOrcaFlex_Data( OrcaFlex_DataData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(OrcaFlex_Data), INTENT(INOUT) :: OrcaFlex_DataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyOrcaFlex_Data' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -DO i1 = LBOUND(OrcaFlex_DataData%x,1), UBOUND(OrcaFlex_DataData%x,1) - CALL Orca_DestroyContState( OrcaFlex_DataData%x(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(OrcaFlex_DataData%xd,1), UBOUND(OrcaFlex_DataData%xd,1) - CALL Orca_DestroyDiscState( OrcaFlex_DataData%xd(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(OrcaFlex_DataData%z,1), UBOUND(OrcaFlex_DataData%z,1) - CALL Orca_DestroyConstrState( OrcaFlex_DataData%z(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(OrcaFlex_DataData%OtherSt,1), UBOUND(OrcaFlex_DataData%OtherSt,1) - CALL Orca_DestroyOtherState( OrcaFlex_DataData%OtherSt(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - CALL Orca_DestroyParam( OrcaFlex_DataData%p, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL Orca_DestroyInput( OrcaFlex_DataData%u, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL Orca_DestroyOutput( OrcaFlex_DataData%y, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL Orca_DestroyMisc( OrcaFlex_DataData%m, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(OrcaFlex_DataData%Input)) THEN -DO i1 = LBOUND(OrcaFlex_DataData%Input,1), UBOUND(OrcaFlex_DataData%Input,1) - CALL Orca_DestroyInput( OrcaFlex_DataData%Input(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(OrcaFlex_DataData%Input) -ENDIF -IF (ALLOCATED(OrcaFlex_DataData%InputTimes)) THEN - DEALLOCATE(OrcaFlex_DataData%InputTimes) -ENDIF - END SUBROUTINE FAST_DestroyOrcaFlex_Data - - SUBROUTINE FAST_PackOrcaFlex_Data( 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(OrcaFlex_Data), 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 = 'FAST_PackOrcaFlex_Data' - ! 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) - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - Int_BufSz = Int_BufSz + 3 ! x: size of buffers for each call to pack subtype - CALL Orca_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype - CALL Orca_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xd - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype - CALL Orca_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! z - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! z - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! z - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - Int_BufSz = Int_BufSz + 3 ! OtherSt: size of buffers for each call to pack subtype - CALL Orca_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype - CALL Orca_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! p - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! p - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! p - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype - CALL Orca_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype - CALL Orca_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype - CALL Orca_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! m - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! m - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! m - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! Input allocated yes/no - IF ( ALLOCATED(InData%Input) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Input upper/lower bounds for each dimension - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - Int_BufSz = Int_BufSz + 3 ! Input: size of buffers for each call to pack subtype - CALL Orca_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Input - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Input - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Input - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! InputTimes allocated yes/no - IF ( ALLOCATED(InData%InputTimes) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! InputTimes upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes - 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 i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - CALL Orca_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, OnlySize ) ! x - 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 - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - CALL Orca_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd - 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 - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - CALL Orca_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, OnlySize ) ! z - 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 - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - CALL Orca_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt - 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 - CALL Orca_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! p - 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 Orca_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u - 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 Orca_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y - 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 Orca_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! m - 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%Input) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Input,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - CALL Orca_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input - 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%InputTimes) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InputTimes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%InputTimes,1), UBOUND(InData%InputTimes,1) - DbKiBuf(Db_Xferred) = InData%InputTimes(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE FAST_PackOrcaFlex_Data - - SUBROUTINE FAST_UnPackOrcaFlex_Data( 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(OrcaFlex_Data), 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 = 'FAST_UnPackOrcaFlex_Data' - ! 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%x,1) - i1_u = UBOUND(OutData%x,1) - DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,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 Orca_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x(i1), ErrStat2, ErrMsg2 ) ! x - 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 - i1_l = LBOUND(OutData%xd,1) - i1_u = UBOUND(OutData%xd,1) - DO i1 = LBOUND(OutData%xd,1), UBOUND(OutData%xd,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 Orca_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1), ErrStat2, ErrMsg2 ) ! xd - 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 - i1_l = LBOUND(OutData%z,1) - i1_u = UBOUND(OutData%z,1) - DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,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 Orca_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1), ErrStat2, ErrMsg2 ) ! z - 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 - i1_l = LBOUND(OutData%OtherSt,1) - i1_u = UBOUND(OutData%OtherSt,1) - DO i1 = LBOUND(OutData%OtherSt,1), UBOUND(OutData%OtherSt,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 Orca_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt(i1), ErrStat2, ErrMsg2 ) ! OtherSt - 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 - 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 Orca_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p - 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 Orca_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u - 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 Orca_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y - 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 Orca_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! m - 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 ! Input not allocated - Int_Xferred = Int_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%Input)) DEALLOCATE(OutData%Input) - ALLOCATE(OutData%Input(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Input,1), UBOUND(OutData%Input,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 Orca_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input(i1), ErrStat2, ErrMsg2 ) ! Input - 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 ! InputTimes not allocated - Int_Xferred = Int_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%InputTimes)) DEALLOCATE(OutData%InputTimes) - ALLOCATE(OutData%InputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%InputTimes,1), UBOUND(OutData%InputTimes,1) - OutData%InputTimes(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE FAST_UnPackOrcaFlex_Data - - SUBROUTINE FAST_CopyModuleMapType( SrcModuleMapTypeData, DstModuleMapTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FAST_ModuleMapType), INTENT(INOUT) :: SrcModuleMapTypeData - TYPE(FAST_ModuleMapType), INTENT(INOUT) :: DstModuleMapTypeData - 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 = 'FAST_CopyModuleMapType' -! + ErrMsg = '' + if (allocated(SrcBeamDyn_DataData%x)) then + LB(1:2) = lbound(SrcBeamDyn_DataData%x) + UB(1:2) = ubound(SrcBeamDyn_DataData%x) + if (.not. allocated(DstBeamDyn_DataData%x)) then + allocate(DstBeamDyn_DataData%x(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_CopyContState(SrcBeamDyn_DataData%x(i1,i2), DstBeamDyn_DataData%x(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do + end if + if (allocated(SrcBeamDyn_DataData%xd)) then + LB(1:2) = lbound(SrcBeamDyn_DataData%xd) + UB(1:2) = ubound(SrcBeamDyn_DataData%xd) + if (.not. allocated(DstBeamDyn_DataData%xd)) then + allocate(DstBeamDyn_DataData%xd(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%xd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_CopyDiscState(SrcBeamDyn_DataData%xd(i1,i2), DstBeamDyn_DataData%xd(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do + end if + if (allocated(SrcBeamDyn_DataData%z)) then + LB(1:2) = lbound(SrcBeamDyn_DataData%z) + UB(1:2) = ubound(SrcBeamDyn_DataData%z) + if (.not. allocated(DstBeamDyn_DataData%z)) then + allocate(DstBeamDyn_DataData%z(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%z.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_CopyConstrState(SrcBeamDyn_DataData%z(i1,i2), DstBeamDyn_DataData%z(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do + end if + if (allocated(SrcBeamDyn_DataData%OtherSt)) then + LB(1:2) = lbound(SrcBeamDyn_DataData%OtherSt) + UB(1:2) = ubound(SrcBeamDyn_DataData%OtherSt) + if (.not. allocated(DstBeamDyn_DataData%OtherSt)) then + allocate(DstBeamDyn_DataData%OtherSt(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%OtherSt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_CopyOtherState(SrcBeamDyn_DataData%OtherSt(i1,i2), DstBeamDyn_DataData%OtherSt(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do + end if + if (allocated(SrcBeamDyn_DataData%p)) then + LB(1:1) = lbound(SrcBeamDyn_DataData%p) + UB(1:1) = ubound(SrcBeamDyn_DataData%p) + if (.not. allocated(DstBeamDyn_DataData%p)) then + allocate(DstBeamDyn_DataData%p(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%p.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call BD_CopyParam(SrcBeamDyn_DataData%p(i1), DstBeamDyn_DataData%p(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcBeamDyn_DataData%u)) then + LB(1:1) = lbound(SrcBeamDyn_DataData%u) + UB(1:1) = ubound(SrcBeamDyn_DataData%u) + if (.not. allocated(DstBeamDyn_DataData%u)) then + allocate(DstBeamDyn_DataData%u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call BD_CopyInput(SrcBeamDyn_DataData%u(i1), DstBeamDyn_DataData%u(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcBeamDyn_DataData%y)) then + LB(1:1) = lbound(SrcBeamDyn_DataData%y) + UB(1:1) = ubound(SrcBeamDyn_DataData%y) + if (.not. allocated(DstBeamDyn_DataData%y)) then + allocate(DstBeamDyn_DataData%y(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%y.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call BD_CopyOutput(SrcBeamDyn_DataData%y(i1), DstBeamDyn_DataData%y(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcBeamDyn_DataData%m)) then + LB(1:1) = lbound(SrcBeamDyn_DataData%m) + UB(1:1) = ubound(SrcBeamDyn_DataData%m) + if (.not. allocated(DstBeamDyn_DataData%m)) then + allocate(DstBeamDyn_DataData%m(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%m.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call BD_CopyMisc(SrcBeamDyn_DataData%m(i1), DstBeamDyn_DataData%m(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcBeamDyn_DataData%Output)) then + LB(1:2) = lbound(SrcBeamDyn_DataData%Output) + UB(1:2) = ubound(SrcBeamDyn_DataData%Output) + if (.not. allocated(DstBeamDyn_DataData%Output)) then + allocate(DstBeamDyn_DataData%Output(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%Output.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_CopyOutput(SrcBeamDyn_DataData%Output(i1,i2), DstBeamDyn_DataData%Output(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do + end if + if (allocated(SrcBeamDyn_DataData%y_interp)) then + LB(1:1) = lbound(SrcBeamDyn_DataData%y_interp) + UB(1:1) = ubound(SrcBeamDyn_DataData%y_interp) + if (.not. allocated(DstBeamDyn_DataData%y_interp)) then + allocate(DstBeamDyn_DataData%y_interp(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%y_interp.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call BD_CopyOutput(SrcBeamDyn_DataData%y_interp(i1), DstBeamDyn_DataData%y_interp(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcBeamDyn_DataData%Input)) then + LB(1:2) = lbound(SrcBeamDyn_DataData%Input) + UB(1:2) = ubound(SrcBeamDyn_DataData%Input) + if (.not. allocated(DstBeamDyn_DataData%Input)) then + allocate(DstBeamDyn_DataData%Input(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%Input.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_CopyInput(SrcBeamDyn_DataData%Input(i1,i2), DstBeamDyn_DataData%Input(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do + end if + if (allocated(SrcBeamDyn_DataData%Input_Saved)) then + LB(1:2) = lbound(SrcBeamDyn_DataData%Input_Saved) + UB(1:2) = ubound(SrcBeamDyn_DataData%Input_Saved) + if (.not. allocated(DstBeamDyn_DataData%Input_Saved)) then + allocate(DstBeamDyn_DataData%Input_Saved(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%Input_Saved.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_CopyInput(SrcBeamDyn_DataData%Input_Saved(i1,i2), DstBeamDyn_DataData%Input_Saved(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do + end if + if (allocated(SrcBeamDyn_DataData%InputTimes)) then + LB(1:2) = lbound(SrcBeamDyn_DataData%InputTimes) + UB(1:2) = ubound(SrcBeamDyn_DataData%InputTimes) + if (.not. allocated(DstBeamDyn_DataData%InputTimes)) then + allocate(DstBeamDyn_DataData%InputTimes(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%InputTimes.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBeamDyn_DataData%InputTimes = SrcBeamDyn_DataData%InputTimes + end if + if (allocated(SrcBeamDyn_DataData%InputTimes_Saved)) then + LB(1:2) = lbound(SrcBeamDyn_DataData%InputTimes_Saved) + UB(1:2) = ubound(SrcBeamDyn_DataData%InputTimes_Saved) + if (.not. allocated(DstBeamDyn_DataData%InputTimes_Saved)) then + allocate(DstBeamDyn_DataData%InputTimes_Saved(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%InputTimes_Saved.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBeamDyn_DataData%InputTimes_Saved = SrcBeamDyn_DataData%InputTimes_Saved + end if +end subroutine + +subroutine FAST_DestroyBeamDyn_Data(BeamDyn_DataData, ErrStat, ErrMsg) + type(BeamDyn_Data), intent(inout) :: BeamDyn_DataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_DestroyBeamDyn_Data' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcModuleMapTypeData%ED_P_2_BD_P)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%ED_P_2_BD_P,1) - i1_u = UBOUND(SrcModuleMapTypeData%ED_P_2_BD_P,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%ED_P_2_BD_P)) THEN - ALLOCATE(DstModuleMapTypeData%ED_P_2_BD_P(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%ED_P_2_BD_P.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcModuleMapTypeData%ED_P_2_BD_P,1), UBOUND(SrcModuleMapTypeData%ED_P_2_BD_P,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_P_2_BD_P(i1), DstModuleMapTypeData%ED_P_2_BD_P(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcModuleMapTypeData%BD_P_2_ED_P)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%BD_P_2_ED_P,1) - i1_u = UBOUND(SrcModuleMapTypeData%BD_P_2_ED_P,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%BD_P_2_ED_P)) THEN - ALLOCATE(DstModuleMapTypeData%BD_P_2_ED_P(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%BD_P_2_ED_P.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcModuleMapTypeData%BD_P_2_ED_P,1), UBOUND(SrcModuleMapTypeData%BD_P_2_ED_P,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%BD_P_2_ED_P(i1), DstModuleMapTypeData%BD_P_2_ED_P(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcModuleMapTypeData%ED_P_2_BD_P_Hub)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%ED_P_2_BD_P_Hub,1) - i1_u = UBOUND(SrcModuleMapTypeData%ED_P_2_BD_P_Hub,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%ED_P_2_BD_P_Hub)) THEN - ALLOCATE(DstModuleMapTypeData%ED_P_2_BD_P_Hub(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%ED_P_2_BD_P_Hub.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcModuleMapTypeData%ED_P_2_BD_P_Hub,1), UBOUND(SrcModuleMapTypeData%ED_P_2_BD_P_Hub,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_P_2_BD_P_Hub(i1), DstModuleMapTypeData%ED_P_2_BD_P_Hub(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_P_2_HD_PRP_P, DstModuleMapTypeData%ED_P_2_HD_PRP_P, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_P_2_HD_W_P, DstModuleMapTypeData%ED_P_2_HD_W_P, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%HD_W_P_2_ED_P, DstModuleMapTypeData%HD_W_P_2_ED_P, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_P_2_HD_M_P, DstModuleMapTypeData%ED_P_2_HD_M_P, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%HD_M_P_2_ED_P, DstModuleMapTypeData%HD_M_P_2_ED_P, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_P_2_Mooring_P, DstModuleMapTypeData%ED_P_2_Mooring_P, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%Mooring_P_2_ED_P, DstModuleMapTypeData%Mooring_P_2_ED_P, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%SDy3_P_2_Mooring_P, DstModuleMapTypeData%SDy3_P_2_Mooring_P, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%Mooring_P_2_SD_P, DstModuleMapTypeData%Mooring_P_2_SD_P, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_P_2_SD_TP, DstModuleMapTypeData%ED_P_2_SD_TP, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%SD_TP_2_ED_P, DstModuleMapTypeData%SD_TP_2_ED_P, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%SD_P_2_HD_M_P, DstModuleMapTypeData%SD_P_2_HD_M_P, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%HD_M_P_2_SD_P, DstModuleMapTypeData%HD_M_P_2_SD_P, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%SD_P_2_HD_W_P, DstModuleMapTypeData%SD_P_2_HD_W_P, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%HD_W_P_2_SD_P, DstModuleMapTypeData%HD_W_P_2_SD_P, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcModuleMapTypeData%ED_P_2_NStC_P_N)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%ED_P_2_NStC_P_N,1) - i1_u = UBOUND(SrcModuleMapTypeData%ED_P_2_NStC_P_N,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%ED_P_2_NStC_P_N)) THEN - ALLOCATE(DstModuleMapTypeData%ED_P_2_NStC_P_N(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%ED_P_2_NStC_P_N.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcModuleMapTypeData%ED_P_2_NStC_P_N,1), UBOUND(SrcModuleMapTypeData%ED_P_2_NStC_P_N,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_P_2_NStC_P_N(i1), DstModuleMapTypeData%ED_P_2_NStC_P_N(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcModuleMapTypeData%NStC_P_2_ED_P_N)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%NStC_P_2_ED_P_N,1) - i1_u = UBOUND(SrcModuleMapTypeData%NStC_P_2_ED_P_N,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%NStC_P_2_ED_P_N)) THEN - ALLOCATE(DstModuleMapTypeData%NStC_P_2_ED_P_N(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%NStC_P_2_ED_P_N.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcModuleMapTypeData%NStC_P_2_ED_P_N,1), UBOUND(SrcModuleMapTypeData%NStC_P_2_ED_P_N,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%NStC_P_2_ED_P_N(i1), DstModuleMapTypeData%NStC_P_2_ED_P_N(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcModuleMapTypeData%ED_L_2_TStC_P_T)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%ED_L_2_TStC_P_T,1) - i1_u = UBOUND(SrcModuleMapTypeData%ED_L_2_TStC_P_T,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%ED_L_2_TStC_P_T)) THEN - ALLOCATE(DstModuleMapTypeData%ED_L_2_TStC_P_T(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%ED_L_2_TStC_P_T.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcModuleMapTypeData%ED_L_2_TStC_P_T,1), UBOUND(SrcModuleMapTypeData%ED_L_2_TStC_P_T,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_L_2_TStC_P_T(i1), DstModuleMapTypeData%ED_L_2_TStC_P_T(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcModuleMapTypeData%TStC_P_2_ED_P_T)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%TStC_P_2_ED_P_T,1) - i1_u = UBOUND(SrcModuleMapTypeData%TStC_P_2_ED_P_T,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%TStC_P_2_ED_P_T)) THEN - ALLOCATE(DstModuleMapTypeData%TStC_P_2_ED_P_T(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%TStC_P_2_ED_P_T.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcModuleMapTypeData%TStC_P_2_ED_P_T,1), UBOUND(SrcModuleMapTypeData%TStC_P_2_ED_P_T,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%TStC_P_2_ED_P_T(i1), DstModuleMapTypeData%TStC_P_2_ED_P_T(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcModuleMapTypeData%ED_L_2_BStC_P_B)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%ED_L_2_BStC_P_B,1) - i1_u = UBOUND(SrcModuleMapTypeData%ED_L_2_BStC_P_B,1) - i2_l = LBOUND(SrcModuleMapTypeData%ED_L_2_BStC_P_B,2) - i2_u = UBOUND(SrcModuleMapTypeData%ED_L_2_BStC_P_B,2) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%ED_L_2_BStC_P_B)) THEN - ALLOCATE(DstModuleMapTypeData%ED_L_2_BStC_P_B(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%ED_L_2_BStC_P_B.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcModuleMapTypeData%ED_L_2_BStC_P_B,2), UBOUND(SrcModuleMapTypeData%ED_L_2_BStC_P_B,2) - DO i1 = LBOUND(SrcModuleMapTypeData%ED_L_2_BStC_P_B,1), UBOUND(SrcModuleMapTypeData%ED_L_2_BStC_P_B,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_L_2_BStC_P_B(i1,i2), DstModuleMapTypeData%ED_L_2_BStC_P_B(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcModuleMapTypeData%BStC_P_2_ED_P_B)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%BStC_P_2_ED_P_B,1) - i1_u = UBOUND(SrcModuleMapTypeData%BStC_P_2_ED_P_B,1) - i2_l = LBOUND(SrcModuleMapTypeData%BStC_P_2_ED_P_B,2) - i2_u = UBOUND(SrcModuleMapTypeData%BStC_P_2_ED_P_B,2) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%BStC_P_2_ED_P_B)) THEN - ALLOCATE(DstModuleMapTypeData%BStC_P_2_ED_P_B(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%BStC_P_2_ED_P_B.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcModuleMapTypeData%BStC_P_2_ED_P_B,2), UBOUND(SrcModuleMapTypeData%BStC_P_2_ED_P_B,2) - DO i1 = LBOUND(SrcModuleMapTypeData%BStC_P_2_ED_P_B,1), UBOUND(SrcModuleMapTypeData%BStC_P_2_ED_P_B,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%BStC_P_2_ED_P_B(i1,i2), DstModuleMapTypeData%BStC_P_2_ED_P_B(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcModuleMapTypeData%BD_L_2_BStC_P_B)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%BD_L_2_BStC_P_B,1) - i1_u = UBOUND(SrcModuleMapTypeData%BD_L_2_BStC_P_B,1) - i2_l = LBOUND(SrcModuleMapTypeData%BD_L_2_BStC_P_B,2) - i2_u = UBOUND(SrcModuleMapTypeData%BD_L_2_BStC_P_B,2) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%BD_L_2_BStC_P_B)) THEN - ALLOCATE(DstModuleMapTypeData%BD_L_2_BStC_P_B(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%BD_L_2_BStC_P_B.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcModuleMapTypeData%BD_L_2_BStC_P_B,2), UBOUND(SrcModuleMapTypeData%BD_L_2_BStC_P_B,2) - DO i1 = LBOUND(SrcModuleMapTypeData%BD_L_2_BStC_P_B,1), UBOUND(SrcModuleMapTypeData%BD_L_2_BStC_P_B,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%BD_L_2_BStC_P_B(i1,i2), DstModuleMapTypeData%BD_L_2_BStC_P_B(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcModuleMapTypeData%BStC_P_2_BD_P_B)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%BStC_P_2_BD_P_B,1) - i1_u = UBOUND(SrcModuleMapTypeData%BStC_P_2_BD_P_B,1) - i2_l = LBOUND(SrcModuleMapTypeData%BStC_P_2_BD_P_B,2) - i2_u = UBOUND(SrcModuleMapTypeData%BStC_P_2_BD_P_B,2) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%BStC_P_2_BD_P_B)) THEN - ALLOCATE(DstModuleMapTypeData%BStC_P_2_BD_P_B(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%BStC_P_2_BD_P_B.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcModuleMapTypeData%BStC_P_2_BD_P_B,2), UBOUND(SrcModuleMapTypeData%BStC_P_2_BD_P_B,2) - DO i1 = LBOUND(SrcModuleMapTypeData%BStC_P_2_BD_P_B,1), UBOUND(SrcModuleMapTypeData%BStC_P_2_BD_P_B,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%BStC_P_2_BD_P_B(i1,i2), DstModuleMapTypeData%BStC_P_2_BD_P_B(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcModuleMapTypeData%SStC_P_P_2_ED_P)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%SStC_P_P_2_ED_P,1) - i1_u = UBOUND(SrcModuleMapTypeData%SStC_P_P_2_ED_P,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%SStC_P_P_2_ED_P)) THEN - ALLOCATE(DstModuleMapTypeData%SStC_P_P_2_ED_P(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%SStC_P_P_2_ED_P.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcModuleMapTypeData%SStC_P_P_2_ED_P,1), UBOUND(SrcModuleMapTypeData%SStC_P_P_2_ED_P,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%SStC_P_P_2_ED_P(i1), DstModuleMapTypeData%SStC_P_P_2_ED_P(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcModuleMapTypeData%ED_P_2_SStC_P_P)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%ED_P_2_SStC_P_P,1) - i1_u = UBOUND(SrcModuleMapTypeData%ED_P_2_SStC_P_P,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%ED_P_2_SStC_P_P)) THEN - ALLOCATE(DstModuleMapTypeData%ED_P_2_SStC_P_P(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%ED_P_2_SStC_P_P.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcModuleMapTypeData%ED_P_2_SStC_P_P,1), UBOUND(SrcModuleMapTypeData%ED_P_2_SStC_P_P,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_P_2_SStC_P_P(i1), DstModuleMapTypeData%ED_P_2_SStC_P_P(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcModuleMapTypeData%SStC_P_P_2_SD_P)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%SStC_P_P_2_SD_P,1) - i1_u = UBOUND(SrcModuleMapTypeData%SStC_P_P_2_SD_P,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%SStC_P_P_2_SD_P)) THEN - ALLOCATE(DstModuleMapTypeData%SStC_P_P_2_SD_P(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%SStC_P_P_2_SD_P.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcModuleMapTypeData%SStC_P_P_2_SD_P,1), UBOUND(SrcModuleMapTypeData%SStC_P_P_2_SD_P,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%SStC_P_P_2_SD_P(i1), DstModuleMapTypeData%SStC_P_P_2_SD_P(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcModuleMapTypeData%SDy3_P_2_SStC_P_P)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%SDy3_P_2_SStC_P_P,1) - i1_u = UBOUND(SrcModuleMapTypeData%SDy3_P_2_SStC_P_P,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%SDy3_P_2_SStC_P_P)) THEN - ALLOCATE(DstModuleMapTypeData%SDy3_P_2_SStC_P_P(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%SDy3_P_2_SStC_P_P.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcModuleMapTypeData%SDy3_P_2_SStC_P_P,1), UBOUND(SrcModuleMapTypeData%SDy3_P_2_SStC_P_P,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%SDy3_P_2_SStC_P_P(i1), DstModuleMapTypeData%SDy3_P_2_SStC_P_P(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_P_2_SrvD_P_P, DstModuleMapTypeData%ED_P_2_SrvD_P_P, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcModuleMapTypeData%BDED_L_2_AD_L_B)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%BDED_L_2_AD_L_B,1) - i1_u = UBOUND(SrcModuleMapTypeData%BDED_L_2_AD_L_B,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%BDED_L_2_AD_L_B)) THEN - ALLOCATE(DstModuleMapTypeData%BDED_L_2_AD_L_B(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%BDED_L_2_AD_L_B.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcModuleMapTypeData%BDED_L_2_AD_L_B,1), UBOUND(SrcModuleMapTypeData%BDED_L_2_AD_L_B,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%BDED_L_2_AD_L_B(i1), DstModuleMapTypeData%BDED_L_2_AD_L_B(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcModuleMapTypeData%AD_L_2_BDED_B)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%AD_L_2_BDED_B,1) - i1_u = UBOUND(SrcModuleMapTypeData%AD_L_2_BDED_B,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%AD_L_2_BDED_B)) THEN - ALLOCATE(DstModuleMapTypeData%AD_L_2_BDED_B(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%AD_L_2_BDED_B.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcModuleMapTypeData%AD_L_2_BDED_B,1), UBOUND(SrcModuleMapTypeData%AD_L_2_BDED_B,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%AD_L_2_BDED_B(i1), DstModuleMapTypeData%AD_L_2_BDED_B(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcModuleMapTypeData%BD_L_2_BD_L)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%BD_L_2_BD_L,1) - i1_u = UBOUND(SrcModuleMapTypeData%BD_L_2_BD_L,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%BD_L_2_BD_L)) THEN - ALLOCATE(DstModuleMapTypeData%BD_L_2_BD_L(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%BD_L_2_BD_L.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcModuleMapTypeData%BD_L_2_BD_L,1), UBOUND(SrcModuleMapTypeData%BD_L_2_BD_L,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%BD_L_2_BD_L(i1), DstModuleMapTypeData%BD_L_2_BD_L(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_P_2_AD_P_N, DstModuleMapTypeData%ED_P_2_AD_P_N, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%AD_P_2_ED_P_N, DstModuleMapTypeData%AD_P_2_ED_P_N, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_P_2_AD_P_TF, DstModuleMapTypeData%ED_P_2_AD_P_TF, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%AD_P_2_ED_P_TF, DstModuleMapTypeData%AD_P_2_ED_P_TF, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_L_2_AD_L_T, DstModuleMapTypeData%ED_L_2_AD_L_T, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%AD_L_2_ED_P_T, DstModuleMapTypeData%AD_L_2_ED_P_T, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcModuleMapTypeData%ED_P_2_AD_P_R)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%ED_P_2_AD_P_R,1) - i1_u = UBOUND(SrcModuleMapTypeData%ED_P_2_AD_P_R,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%ED_P_2_AD_P_R)) THEN - ALLOCATE(DstModuleMapTypeData%ED_P_2_AD_P_R(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%ED_P_2_AD_P_R.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcModuleMapTypeData%ED_P_2_AD_P_R,1), UBOUND(SrcModuleMapTypeData%ED_P_2_AD_P_R,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_P_2_AD_P_R(i1), DstModuleMapTypeData%ED_P_2_AD_P_R(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_P_2_AD_P_H, DstModuleMapTypeData%ED_P_2_AD_P_H, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%AD_P_2_ED_P_H, DstModuleMapTypeData%AD_P_2_ED_P_H, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%IceF_P_2_SD_P, DstModuleMapTypeData%IceF_P_2_SD_P, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%SDy3_P_2_IceF_P, DstModuleMapTypeData%SDy3_P_2_IceF_P, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcModuleMapTypeData%IceD_P_2_SD_P)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%IceD_P_2_SD_P,1) - i1_u = UBOUND(SrcModuleMapTypeData%IceD_P_2_SD_P,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%IceD_P_2_SD_P)) THEN - ALLOCATE(DstModuleMapTypeData%IceD_P_2_SD_P(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%IceD_P_2_SD_P.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcModuleMapTypeData%IceD_P_2_SD_P,1), UBOUND(SrcModuleMapTypeData%IceD_P_2_SD_P,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%IceD_P_2_SD_P(i1), DstModuleMapTypeData%IceD_P_2_SD_P(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcModuleMapTypeData%SDy3_P_2_IceD_P)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%SDy3_P_2_IceD_P,1) - i1_u = UBOUND(SrcModuleMapTypeData%SDy3_P_2_IceD_P,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%SDy3_P_2_IceD_P)) THEN - ALLOCATE(DstModuleMapTypeData%SDy3_P_2_IceD_P(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%SDy3_P_2_IceD_P.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcModuleMapTypeData%SDy3_P_2_IceD_P,1), UBOUND(SrcModuleMapTypeData%SDy3_P_2_IceD_P,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%SDy3_P_2_IceD_P(i1), DstModuleMapTypeData%SDy3_P_2_IceD_P(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcModuleMapTypeData%Jacobian_Opt1)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%Jacobian_Opt1,1) - i1_u = UBOUND(SrcModuleMapTypeData%Jacobian_Opt1,1) - i2_l = LBOUND(SrcModuleMapTypeData%Jacobian_Opt1,2) - i2_u = UBOUND(SrcModuleMapTypeData%Jacobian_Opt1,2) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%Jacobian_Opt1)) THEN - ALLOCATE(DstModuleMapTypeData%Jacobian_Opt1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%Jacobian_Opt1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstModuleMapTypeData%Jacobian_Opt1 = SrcModuleMapTypeData%Jacobian_Opt1 -ENDIF -IF (ALLOCATED(SrcModuleMapTypeData%Jacobian_pivot)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%Jacobian_pivot,1) - i1_u = UBOUND(SrcModuleMapTypeData%Jacobian_pivot,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%Jacobian_pivot)) THEN - ALLOCATE(DstModuleMapTypeData%Jacobian_pivot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%Jacobian_pivot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstModuleMapTypeData%Jacobian_pivot = SrcModuleMapTypeData%Jacobian_pivot -ENDIF -IF (ALLOCATED(SrcModuleMapTypeData%Jac_u_indx)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%Jac_u_indx,1) - i1_u = UBOUND(SrcModuleMapTypeData%Jac_u_indx,1) - i2_l = LBOUND(SrcModuleMapTypeData%Jac_u_indx,2) - i2_u = UBOUND(SrcModuleMapTypeData%Jac_u_indx,2) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%Jac_u_indx)) THEN - ALLOCATE(DstModuleMapTypeData%Jac_u_indx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%Jac_u_indx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstModuleMapTypeData%Jac_u_indx = SrcModuleMapTypeData%Jac_u_indx -ENDIF - CALL MeshCopy( SrcModuleMapTypeData%u_ED_NacelleLoads, DstModuleMapTypeData%u_ED_NacelleLoads, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcModuleMapTypeData%u_ED_PlatformPtMesh, DstModuleMapTypeData%u_ED_PlatformPtMesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcModuleMapTypeData%u_ED_PlatformPtMesh_2, DstModuleMapTypeData%u_ED_PlatformPtMesh_2, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcModuleMapTypeData%u_ED_PlatformPtMesh_3, DstModuleMapTypeData%u_ED_PlatformPtMesh_3, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcModuleMapTypeData%u_ED_PlatformPtMesh_MDf, DstModuleMapTypeData%u_ED_PlatformPtMesh_MDf, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcModuleMapTypeData%u_ED_TowerPtloads, DstModuleMapTypeData%u_ED_TowerPtloads, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcModuleMapTypeData%u_ED_BladePtLoads)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%u_ED_BladePtLoads,1) - i1_u = UBOUND(SrcModuleMapTypeData%u_ED_BladePtLoads,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%u_ED_BladePtLoads)) THEN - ALLOCATE(DstModuleMapTypeData%u_ED_BladePtLoads(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%u_ED_BladePtLoads.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcModuleMapTypeData%u_ED_BladePtLoads,1), UBOUND(SrcModuleMapTypeData%u_ED_BladePtLoads,1) - CALL MeshCopy( SrcModuleMapTypeData%u_ED_BladePtLoads(i1), DstModuleMapTypeData%u_ED_BladePtLoads(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL MeshCopy( SrcModuleMapTypeData%u_SD_TPMesh, DstModuleMapTypeData%u_SD_TPMesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcModuleMapTypeData%u_SD_LMesh, DstModuleMapTypeData%u_SD_LMesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcModuleMapTypeData%u_SD_LMesh_2, DstModuleMapTypeData%u_SD_LMesh_2, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcModuleMapTypeData%u_HD_M_Mesh, DstModuleMapTypeData%u_HD_M_Mesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcModuleMapTypeData%u_HD_W_Mesh, DstModuleMapTypeData%u_HD_W_Mesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcModuleMapTypeData%u_ED_HubPtLoad, DstModuleMapTypeData%u_ED_HubPtLoad, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcModuleMapTypeData%u_ED_HubPtLoad_2, DstModuleMapTypeData%u_ED_HubPtLoad_2, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcModuleMapTypeData%u_BD_RootMotion)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%u_BD_RootMotion,1) - i1_u = UBOUND(SrcModuleMapTypeData%u_BD_RootMotion,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%u_BD_RootMotion)) THEN - ALLOCATE(DstModuleMapTypeData%u_BD_RootMotion(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%u_BD_RootMotion.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcModuleMapTypeData%u_BD_RootMotion,1), UBOUND(SrcModuleMapTypeData%u_BD_RootMotion,1) - CALL MeshCopy( SrcModuleMapTypeData%u_BD_RootMotion(i1), DstModuleMapTypeData%u_BD_RootMotion(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcModuleMapTypeData%y_BD_BldMotion_4Loads)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%y_BD_BldMotion_4Loads,1) - i1_u = UBOUND(SrcModuleMapTypeData%y_BD_BldMotion_4Loads,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%y_BD_BldMotion_4Loads)) THEN - ALLOCATE(DstModuleMapTypeData%y_BD_BldMotion_4Loads(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%y_BD_BldMotion_4Loads.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcModuleMapTypeData%y_BD_BldMotion_4Loads,1), UBOUND(SrcModuleMapTypeData%y_BD_BldMotion_4Loads,1) - CALL MeshCopy( SrcModuleMapTypeData%y_BD_BldMotion_4Loads(i1), DstModuleMapTypeData%y_BD_BldMotion_4Loads(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcModuleMapTypeData%u_BD_Distrload)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%u_BD_Distrload,1) - i1_u = UBOUND(SrcModuleMapTypeData%u_BD_Distrload,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%u_BD_Distrload)) THEN - ALLOCATE(DstModuleMapTypeData%u_BD_Distrload(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%u_BD_Distrload.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcModuleMapTypeData%u_BD_Distrload,1), UBOUND(SrcModuleMapTypeData%u_BD_Distrload,1) - CALL MeshCopy( SrcModuleMapTypeData%u_BD_Distrload(i1), DstModuleMapTypeData%u_BD_Distrload(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL MeshCopy( SrcModuleMapTypeData%u_Orca_PtfmMesh, DstModuleMapTypeData%u_Orca_PtfmMesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcModuleMapTypeData%u_ExtPtfm_PtfmMesh, DstModuleMapTypeData%u_ExtPtfm_PtfmMesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE FAST_CopyModuleMapType - - SUBROUTINE FAST_DestroyModuleMapType( ModuleMapTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(FAST_ModuleMapType), INTENT(INOUT) :: ModuleMapTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyModuleMapType' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(ModuleMapTypeData%ED_P_2_BD_P)) THEN -DO i1 = LBOUND(ModuleMapTypeData%ED_P_2_BD_P,1), UBOUND(ModuleMapTypeData%ED_P_2_BD_P,1) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%ED_P_2_BD_P(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ModuleMapTypeData%ED_P_2_BD_P) -ENDIF -IF (ALLOCATED(ModuleMapTypeData%BD_P_2_ED_P)) THEN -DO i1 = LBOUND(ModuleMapTypeData%BD_P_2_ED_P,1), UBOUND(ModuleMapTypeData%BD_P_2_ED_P,1) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%BD_P_2_ED_P(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ModuleMapTypeData%BD_P_2_ED_P) -ENDIF -IF (ALLOCATED(ModuleMapTypeData%ED_P_2_BD_P_Hub)) THEN -DO i1 = LBOUND(ModuleMapTypeData%ED_P_2_BD_P_Hub,1), UBOUND(ModuleMapTypeData%ED_P_2_BD_P_Hub,1) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%ED_P_2_BD_P_Hub(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ModuleMapTypeData%ED_P_2_BD_P_Hub) -ENDIF - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%ED_P_2_HD_PRP_P, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%ED_P_2_HD_W_P, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%HD_W_P_2_ED_P, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%ED_P_2_HD_M_P, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%HD_M_P_2_ED_P, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%ED_P_2_Mooring_P, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%Mooring_P_2_ED_P, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%SDy3_P_2_Mooring_P, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%Mooring_P_2_SD_P, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%ED_P_2_SD_TP, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%SD_TP_2_ED_P, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%SD_P_2_HD_M_P, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%HD_M_P_2_SD_P, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%SD_P_2_HD_W_P, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%HD_W_P_2_SD_P, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(ModuleMapTypeData%ED_P_2_NStC_P_N)) THEN -DO i1 = LBOUND(ModuleMapTypeData%ED_P_2_NStC_P_N,1), UBOUND(ModuleMapTypeData%ED_P_2_NStC_P_N,1) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%ED_P_2_NStC_P_N(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ModuleMapTypeData%ED_P_2_NStC_P_N) -ENDIF -IF (ALLOCATED(ModuleMapTypeData%NStC_P_2_ED_P_N)) THEN -DO i1 = LBOUND(ModuleMapTypeData%NStC_P_2_ED_P_N,1), UBOUND(ModuleMapTypeData%NStC_P_2_ED_P_N,1) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%NStC_P_2_ED_P_N(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ModuleMapTypeData%NStC_P_2_ED_P_N) -ENDIF -IF (ALLOCATED(ModuleMapTypeData%ED_L_2_TStC_P_T)) THEN -DO i1 = LBOUND(ModuleMapTypeData%ED_L_2_TStC_P_T,1), UBOUND(ModuleMapTypeData%ED_L_2_TStC_P_T,1) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%ED_L_2_TStC_P_T(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ModuleMapTypeData%ED_L_2_TStC_P_T) -ENDIF -IF (ALLOCATED(ModuleMapTypeData%TStC_P_2_ED_P_T)) THEN -DO i1 = LBOUND(ModuleMapTypeData%TStC_P_2_ED_P_T,1), UBOUND(ModuleMapTypeData%TStC_P_2_ED_P_T,1) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%TStC_P_2_ED_P_T(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ModuleMapTypeData%TStC_P_2_ED_P_T) -ENDIF -IF (ALLOCATED(ModuleMapTypeData%ED_L_2_BStC_P_B)) THEN -DO i2 = LBOUND(ModuleMapTypeData%ED_L_2_BStC_P_B,2), UBOUND(ModuleMapTypeData%ED_L_2_BStC_P_B,2) -DO i1 = LBOUND(ModuleMapTypeData%ED_L_2_BStC_P_B,1), UBOUND(ModuleMapTypeData%ED_L_2_BStC_P_B,1) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%ED_L_2_BStC_P_B(i1,i2), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO - DEALLOCATE(ModuleMapTypeData%ED_L_2_BStC_P_B) -ENDIF -IF (ALLOCATED(ModuleMapTypeData%BStC_P_2_ED_P_B)) THEN -DO i2 = LBOUND(ModuleMapTypeData%BStC_P_2_ED_P_B,2), UBOUND(ModuleMapTypeData%BStC_P_2_ED_P_B,2) -DO i1 = LBOUND(ModuleMapTypeData%BStC_P_2_ED_P_B,1), UBOUND(ModuleMapTypeData%BStC_P_2_ED_P_B,1) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%BStC_P_2_ED_P_B(i1,i2), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO - DEALLOCATE(ModuleMapTypeData%BStC_P_2_ED_P_B) -ENDIF -IF (ALLOCATED(ModuleMapTypeData%BD_L_2_BStC_P_B)) THEN -DO i2 = LBOUND(ModuleMapTypeData%BD_L_2_BStC_P_B,2), UBOUND(ModuleMapTypeData%BD_L_2_BStC_P_B,2) -DO i1 = LBOUND(ModuleMapTypeData%BD_L_2_BStC_P_B,1), UBOUND(ModuleMapTypeData%BD_L_2_BStC_P_B,1) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%BD_L_2_BStC_P_B(i1,i2), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO - DEALLOCATE(ModuleMapTypeData%BD_L_2_BStC_P_B) -ENDIF -IF (ALLOCATED(ModuleMapTypeData%BStC_P_2_BD_P_B)) THEN -DO i2 = LBOUND(ModuleMapTypeData%BStC_P_2_BD_P_B,2), UBOUND(ModuleMapTypeData%BStC_P_2_BD_P_B,2) -DO i1 = LBOUND(ModuleMapTypeData%BStC_P_2_BD_P_B,1), UBOUND(ModuleMapTypeData%BStC_P_2_BD_P_B,1) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%BStC_P_2_BD_P_B(i1,i2), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO - DEALLOCATE(ModuleMapTypeData%BStC_P_2_BD_P_B) -ENDIF -IF (ALLOCATED(ModuleMapTypeData%SStC_P_P_2_ED_P)) THEN -DO i1 = LBOUND(ModuleMapTypeData%SStC_P_P_2_ED_P,1), UBOUND(ModuleMapTypeData%SStC_P_P_2_ED_P,1) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%SStC_P_P_2_ED_P(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ModuleMapTypeData%SStC_P_P_2_ED_P) -ENDIF -IF (ALLOCATED(ModuleMapTypeData%ED_P_2_SStC_P_P)) THEN -DO i1 = LBOUND(ModuleMapTypeData%ED_P_2_SStC_P_P,1), UBOUND(ModuleMapTypeData%ED_P_2_SStC_P_P,1) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%ED_P_2_SStC_P_P(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ModuleMapTypeData%ED_P_2_SStC_P_P) -ENDIF -IF (ALLOCATED(ModuleMapTypeData%SStC_P_P_2_SD_P)) THEN -DO i1 = LBOUND(ModuleMapTypeData%SStC_P_P_2_SD_P,1), UBOUND(ModuleMapTypeData%SStC_P_P_2_SD_P,1) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%SStC_P_P_2_SD_P(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ModuleMapTypeData%SStC_P_P_2_SD_P) -ENDIF -IF (ALLOCATED(ModuleMapTypeData%SDy3_P_2_SStC_P_P)) THEN -DO i1 = LBOUND(ModuleMapTypeData%SDy3_P_2_SStC_P_P,1), UBOUND(ModuleMapTypeData%SDy3_P_2_SStC_P_P,1) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%SDy3_P_2_SStC_P_P(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ModuleMapTypeData%SDy3_P_2_SStC_P_P) -ENDIF - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%ED_P_2_SrvD_P_P, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(ModuleMapTypeData%BDED_L_2_AD_L_B)) THEN -DO i1 = LBOUND(ModuleMapTypeData%BDED_L_2_AD_L_B,1), UBOUND(ModuleMapTypeData%BDED_L_2_AD_L_B,1) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%BDED_L_2_AD_L_B(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ModuleMapTypeData%BDED_L_2_AD_L_B) -ENDIF -IF (ALLOCATED(ModuleMapTypeData%AD_L_2_BDED_B)) THEN -DO i1 = LBOUND(ModuleMapTypeData%AD_L_2_BDED_B,1), UBOUND(ModuleMapTypeData%AD_L_2_BDED_B,1) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%AD_L_2_BDED_B(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ModuleMapTypeData%AD_L_2_BDED_B) -ENDIF -IF (ALLOCATED(ModuleMapTypeData%BD_L_2_BD_L)) THEN -DO i1 = LBOUND(ModuleMapTypeData%BD_L_2_BD_L,1), UBOUND(ModuleMapTypeData%BD_L_2_BD_L,1) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%BD_L_2_BD_L(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ModuleMapTypeData%BD_L_2_BD_L) -ENDIF - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%ED_P_2_AD_P_N, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%AD_P_2_ED_P_N, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%ED_P_2_AD_P_TF, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%AD_P_2_ED_P_TF, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%ED_L_2_AD_L_T, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%AD_L_2_ED_P_T, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(ModuleMapTypeData%ED_P_2_AD_P_R)) THEN -DO i1 = LBOUND(ModuleMapTypeData%ED_P_2_AD_P_R,1), UBOUND(ModuleMapTypeData%ED_P_2_AD_P_R,1) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%ED_P_2_AD_P_R(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ModuleMapTypeData%ED_P_2_AD_P_R) -ENDIF - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%ED_P_2_AD_P_H, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%AD_P_2_ED_P_H, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%IceF_P_2_SD_P, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%SDy3_P_2_IceF_P, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(ModuleMapTypeData%IceD_P_2_SD_P)) THEN -DO i1 = LBOUND(ModuleMapTypeData%IceD_P_2_SD_P,1), UBOUND(ModuleMapTypeData%IceD_P_2_SD_P,1) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%IceD_P_2_SD_P(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ModuleMapTypeData%IceD_P_2_SD_P) -ENDIF -IF (ALLOCATED(ModuleMapTypeData%SDy3_P_2_IceD_P)) THEN -DO i1 = LBOUND(ModuleMapTypeData%SDy3_P_2_IceD_P,1), UBOUND(ModuleMapTypeData%SDy3_P_2_IceD_P,1) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%SDy3_P_2_IceD_P(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ModuleMapTypeData%SDy3_P_2_IceD_P) -ENDIF -IF (ALLOCATED(ModuleMapTypeData%Jacobian_Opt1)) THEN - DEALLOCATE(ModuleMapTypeData%Jacobian_Opt1) -ENDIF -IF (ALLOCATED(ModuleMapTypeData%Jacobian_pivot)) THEN - DEALLOCATE(ModuleMapTypeData%Jacobian_pivot) -ENDIF -IF (ALLOCATED(ModuleMapTypeData%Jac_u_indx)) THEN - DEALLOCATE(ModuleMapTypeData%Jac_u_indx) -ENDIF - CALL MeshDestroy( ModuleMapTypeData%u_ED_NacelleLoads, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( ModuleMapTypeData%u_ED_PlatformPtMesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( ModuleMapTypeData%u_ED_PlatformPtMesh_2, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( ModuleMapTypeData%u_ED_PlatformPtMesh_3, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( ModuleMapTypeData%u_ED_PlatformPtMesh_MDf, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( ModuleMapTypeData%u_ED_TowerPtloads, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(ModuleMapTypeData%u_ED_BladePtLoads)) THEN -DO i1 = LBOUND(ModuleMapTypeData%u_ED_BladePtLoads,1), UBOUND(ModuleMapTypeData%u_ED_BladePtLoads,1) - CALL MeshDestroy( ModuleMapTypeData%u_ED_BladePtLoads(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ModuleMapTypeData%u_ED_BladePtLoads) -ENDIF - CALL MeshDestroy( ModuleMapTypeData%u_SD_TPMesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( ModuleMapTypeData%u_SD_LMesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( ModuleMapTypeData%u_SD_LMesh_2, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( ModuleMapTypeData%u_HD_M_Mesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( ModuleMapTypeData%u_HD_W_Mesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( ModuleMapTypeData%u_ED_HubPtLoad, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( ModuleMapTypeData%u_ED_HubPtLoad_2, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(ModuleMapTypeData%u_BD_RootMotion)) THEN -DO i1 = LBOUND(ModuleMapTypeData%u_BD_RootMotion,1), UBOUND(ModuleMapTypeData%u_BD_RootMotion,1) - CALL MeshDestroy( ModuleMapTypeData%u_BD_RootMotion(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ModuleMapTypeData%u_BD_RootMotion) -ENDIF -IF (ALLOCATED(ModuleMapTypeData%y_BD_BldMotion_4Loads)) THEN -DO i1 = LBOUND(ModuleMapTypeData%y_BD_BldMotion_4Loads,1), UBOUND(ModuleMapTypeData%y_BD_BldMotion_4Loads,1) - CALL MeshDestroy( ModuleMapTypeData%y_BD_BldMotion_4Loads(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ModuleMapTypeData%y_BD_BldMotion_4Loads) -ENDIF -IF (ALLOCATED(ModuleMapTypeData%u_BD_Distrload)) THEN -DO i1 = LBOUND(ModuleMapTypeData%u_BD_Distrload,1), UBOUND(ModuleMapTypeData%u_BD_Distrload,1) - CALL MeshDestroy( ModuleMapTypeData%u_BD_Distrload(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ModuleMapTypeData%u_BD_Distrload) -ENDIF - CALL MeshDestroy( ModuleMapTypeData%u_Orca_PtfmMesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( ModuleMapTypeData%u_ExtPtfm_PtfmMesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE FAST_DestroyModuleMapType - - SUBROUTINE FAST_PackModuleMapType( 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(FAST_ModuleMapType), 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 = 'FAST_PackModuleMapType' - ! 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 ! ED_P_2_BD_P allocated yes/no - IF ( ALLOCATED(InData%ED_P_2_BD_P) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ED_P_2_BD_P upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%ED_P_2_BD_P,1), UBOUND(InData%ED_P_2_BD_P,1) - Int_BufSz = Int_BufSz + 3 ! ED_P_2_BD_P: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_BD_P(i1), ErrStat2, ErrMsg2, .TRUE. ) ! ED_P_2_BD_P - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! ED_P_2_BD_P - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! ED_P_2_BD_P - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! ED_P_2_BD_P - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! BD_P_2_ED_P allocated yes/no - IF ( ALLOCATED(InData%BD_P_2_ED_P) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BD_P_2_ED_P upper/lower bounds for each dimension - DO i1 = LBOUND(InData%BD_P_2_ED_P,1), UBOUND(InData%BD_P_2_ED_P,1) - Int_BufSz = Int_BufSz + 3 ! BD_P_2_ED_P: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%BD_P_2_ED_P(i1), ErrStat2, ErrMsg2, .TRUE. ) ! BD_P_2_ED_P - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BD_P_2_ED_P - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BD_P_2_ED_P - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BD_P_2_ED_P - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! ED_P_2_BD_P_Hub allocated yes/no - IF ( ALLOCATED(InData%ED_P_2_BD_P_Hub) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ED_P_2_BD_P_Hub upper/lower bounds for each dimension - DO i1 = LBOUND(InData%ED_P_2_BD_P_Hub,1), UBOUND(InData%ED_P_2_BD_P_Hub,1) - Int_BufSz = Int_BufSz + 3 ! ED_P_2_BD_P_Hub: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_BD_P_Hub(i1), ErrStat2, ErrMsg2, .TRUE. ) ! ED_P_2_BD_P_Hub - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! ED_P_2_BD_P_Hub - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! ED_P_2_BD_P_Hub - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! ED_P_2_BD_P_Hub - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! ED_P_2_HD_PRP_P: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_HD_PRP_P, ErrStat2, ErrMsg2, .TRUE. ) ! ED_P_2_HD_PRP_P - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! ED_P_2_HD_PRP_P - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! ED_P_2_HD_PRP_P - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! ED_P_2_HD_PRP_P - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! ED_P_2_HD_W_P: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_HD_W_P, ErrStat2, ErrMsg2, .TRUE. ) ! ED_P_2_HD_W_P - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! ED_P_2_HD_W_P - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! ED_P_2_HD_W_P - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! ED_P_2_HD_W_P - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! HD_W_P_2_ED_P: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%HD_W_P_2_ED_P, ErrStat2, ErrMsg2, .TRUE. ) ! HD_W_P_2_ED_P - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! HD_W_P_2_ED_P - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! HD_W_P_2_ED_P - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! HD_W_P_2_ED_P - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! ED_P_2_HD_M_P: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_HD_M_P, ErrStat2, ErrMsg2, .TRUE. ) ! ED_P_2_HD_M_P - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! ED_P_2_HD_M_P - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! ED_P_2_HD_M_P - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! ED_P_2_HD_M_P - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! HD_M_P_2_ED_P: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%HD_M_P_2_ED_P, ErrStat2, ErrMsg2, .TRUE. ) ! HD_M_P_2_ED_P - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! HD_M_P_2_ED_P - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! HD_M_P_2_ED_P - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! HD_M_P_2_ED_P - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! ED_P_2_Mooring_P: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_Mooring_P, ErrStat2, ErrMsg2, .TRUE. ) ! ED_P_2_Mooring_P - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! ED_P_2_Mooring_P - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! ED_P_2_Mooring_P - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! ED_P_2_Mooring_P - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! Mooring_P_2_ED_P: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%Mooring_P_2_ED_P, ErrStat2, ErrMsg2, .TRUE. ) ! Mooring_P_2_ED_P - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Mooring_P_2_ED_P - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Mooring_P_2_ED_P - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Mooring_P_2_ED_P - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! SDy3_P_2_Mooring_P: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%SDy3_P_2_Mooring_P, ErrStat2, ErrMsg2, .TRUE. ) ! SDy3_P_2_Mooring_P - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SDy3_P_2_Mooring_P - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SDy3_P_2_Mooring_P - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SDy3_P_2_Mooring_P - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! Mooring_P_2_SD_P: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%Mooring_P_2_SD_P, ErrStat2, ErrMsg2, .TRUE. ) ! Mooring_P_2_SD_P - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Mooring_P_2_SD_P - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Mooring_P_2_SD_P - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Mooring_P_2_SD_P - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! ED_P_2_SD_TP: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_SD_TP, ErrStat2, ErrMsg2, .TRUE. ) ! ED_P_2_SD_TP - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! ED_P_2_SD_TP - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! ED_P_2_SD_TP - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! ED_P_2_SD_TP - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! SD_TP_2_ED_P: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%SD_TP_2_ED_P, ErrStat2, ErrMsg2, .TRUE. ) ! SD_TP_2_ED_P - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SD_TP_2_ED_P - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SD_TP_2_ED_P - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SD_TP_2_ED_P - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! SD_P_2_HD_M_P: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%SD_P_2_HD_M_P, ErrStat2, ErrMsg2, .TRUE. ) ! SD_P_2_HD_M_P - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SD_P_2_HD_M_P - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SD_P_2_HD_M_P - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SD_P_2_HD_M_P - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! HD_M_P_2_SD_P: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%HD_M_P_2_SD_P, ErrStat2, ErrMsg2, .TRUE. ) ! HD_M_P_2_SD_P - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! HD_M_P_2_SD_P - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! HD_M_P_2_SD_P - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! HD_M_P_2_SD_P - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! SD_P_2_HD_W_P: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%SD_P_2_HD_W_P, ErrStat2, ErrMsg2, .TRUE. ) ! SD_P_2_HD_W_P - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SD_P_2_HD_W_P - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SD_P_2_HD_W_P - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SD_P_2_HD_W_P - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! HD_W_P_2_SD_P: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%HD_W_P_2_SD_P, ErrStat2, ErrMsg2, .TRUE. ) ! HD_W_P_2_SD_P - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! HD_W_P_2_SD_P - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! HD_W_P_2_SD_P - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! HD_W_P_2_SD_P - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! ED_P_2_NStC_P_N allocated yes/no - IF ( ALLOCATED(InData%ED_P_2_NStC_P_N) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ED_P_2_NStC_P_N upper/lower bounds for each dimension - DO i1 = LBOUND(InData%ED_P_2_NStC_P_N,1), UBOUND(InData%ED_P_2_NStC_P_N,1) - Int_BufSz = Int_BufSz + 3 ! ED_P_2_NStC_P_N: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_NStC_P_N(i1), ErrStat2, ErrMsg2, .TRUE. ) ! ED_P_2_NStC_P_N - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! ED_P_2_NStC_P_N - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! ED_P_2_NStC_P_N - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! ED_P_2_NStC_P_N - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! NStC_P_2_ED_P_N allocated yes/no - IF ( ALLOCATED(InData%NStC_P_2_ED_P_N) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! NStC_P_2_ED_P_N upper/lower bounds for each dimension - DO i1 = LBOUND(InData%NStC_P_2_ED_P_N,1), UBOUND(InData%NStC_P_2_ED_P_N,1) - Int_BufSz = Int_BufSz + 3 ! NStC_P_2_ED_P_N: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%NStC_P_2_ED_P_N(i1), ErrStat2, ErrMsg2, .TRUE. ) ! NStC_P_2_ED_P_N - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! NStC_P_2_ED_P_N - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! NStC_P_2_ED_P_N - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! NStC_P_2_ED_P_N - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! ED_L_2_TStC_P_T allocated yes/no - IF ( ALLOCATED(InData%ED_L_2_TStC_P_T) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ED_L_2_TStC_P_T upper/lower bounds for each dimension - DO i1 = LBOUND(InData%ED_L_2_TStC_P_T,1), UBOUND(InData%ED_L_2_TStC_P_T,1) - Int_BufSz = Int_BufSz + 3 ! ED_L_2_TStC_P_T: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_L_2_TStC_P_T(i1), ErrStat2, ErrMsg2, .TRUE. ) ! ED_L_2_TStC_P_T - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! ED_L_2_TStC_P_T - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! ED_L_2_TStC_P_T - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! ED_L_2_TStC_P_T - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! TStC_P_2_ED_P_T allocated yes/no - IF ( ALLOCATED(InData%TStC_P_2_ED_P_T) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TStC_P_2_ED_P_T upper/lower bounds for each dimension - DO i1 = LBOUND(InData%TStC_P_2_ED_P_T,1), UBOUND(InData%TStC_P_2_ED_P_T,1) - Int_BufSz = Int_BufSz + 3 ! TStC_P_2_ED_P_T: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%TStC_P_2_ED_P_T(i1), ErrStat2, ErrMsg2, .TRUE. ) ! TStC_P_2_ED_P_T - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! TStC_P_2_ED_P_T - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! TStC_P_2_ED_P_T - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! TStC_P_2_ED_P_T - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! ED_L_2_BStC_P_B allocated yes/no - IF ( ALLOCATED(InData%ED_L_2_BStC_P_B) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! ED_L_2_BStC_P_B upper/lower bounds for each dimension - DO i2 = LBOUND(InData%ED_L_2_BStC_P_B,2), UBOUND(InData%ED_L_2_BStC_P_B,2) - DO i1 = LBOUND(InData%ED_L_2_BStC_P_B,1), UBOUND(InData%ED_L_2_BStC_P_B,1) - Int_BufSz = Int_BufSz + 3 ! ED_L_2_BStC_P_B: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_L_2_BStC_P_B(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! ED_L_2_BStC_P_B - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! ED_L_2_BStC_P_B - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! ED_L_2_BStC_P_B - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! ED_L_2_BStC_P_B - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! BStC_P_2_ED_P_B allocated yes/no - IF ( ALLOCATED(InData%BStC_P_2_ED_P_B) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BStC_P_2_ED_P_B upper/lower bounds for each dimension - DO i2 = LBOUND(InData%BStC_P_2_ED_P_B,2), UBOUND(InData%BStC_P_2_ED_P_B,2) - DO i1 = LBOUND(InData%BStC_P_2_ED_P_B,1), UBOUND(InData%BStC_P_2_ED_P_B,1) - Int_BufSz = Int_BufSz + 3 ! BStC_P_2_ED_P_B: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%BStC_P_2_ED_P_B(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! BStC_P_2_ED_P_B - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BStC_P_2_ED_P_B - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BStC_P_2_ED_P_B - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BStC_P_2_ED_P_B - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! BD_L_2_BStC_P_B allocated yes/no - IF ( ALLOCATED(InData%BD_L_2_BStC_P_B) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BD_L_2_BStC_P_B upper/lower bounds for each dimension - DO i2 = LBOUND(InData%BD_L_2_BStC_P_B,2), UBOUND(InData%BD_L_2_BStC_P_B,2) - DO i1 = LBOUND(InData%BD_L_2_BStC_P_B,1), UBOUND(InData%BD_L_2_BStC_P_B,1) - Int_BufSz = Int_BufSz + 3 ! BD_L_2_BStC_P_B: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%BD_L_2_BStC_P_B(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! BD_L_2_BStC_P_B - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BD_L_2_BStC_P_B - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BD_L_2_BStC_P_B - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BD_L_2_BStC_P_B - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! BStC_P_2_BD_P_B allocated yes/no - IF ( ALLOCATED(InData%BStC_P_2_BD_P_B) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BStC_P_2_BD_P_B upper/lower bounds for each dimension - DO i2 = LBOUND(InData%BStC_P_2_BD_P_B,2), UBOUND(InData%BStC_P_2_BD_P_B,2) - DO i1 = LBOUND(InData%BStC_P_2_BD_P_B,1), UBOUND(InData%BStC_P_2_BD_P_B,1) - Int_BufSz = Int_BufSz + 3 ! BStC_P_2_BD_P_B: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%BStC_P_2_BD_P_B(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! BStC_P_2_BD_P_B - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BStC_P_2_BD_P_B - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BStC_P_2_BD_P_B - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BStC_P_2_BD_P_B - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! SStC_P_P_2_ED_P allocated yes/no - IF ( ALLOCATED(InData%SStC_P_P_2_ED_P) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! SStC_P_P_2_ED_P upper/lower bounds for each dimension - DO i1 = LBOUND(InData%SStC_P_P_2_ED_P,1), UBOUND(InData%SStC_P_P_2_ED_P,1) - Int_BufSz = Int_BufSz + 3 ! SStC_P_P_2_ED_P: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%SStC_P_P_2_ED_P(i1), ErrStat2, ErrMsg2, .TRUE. ) ! SStC_P_P_2_ED_P - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SStC_P_P_2_ED_P - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SStC_P_P_2_ED_P - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SStC_P_P_2_ED_P - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! ED_P_2_SStC_P_P allocated yes/no - IF ( ALLOCATED(InData%ED_P_2_SStC_P_P) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ED_P_2_SStC_P_P upper/lower bounds for each dimension - DO i1 = LBOUND(InData%ED_P_2_SStC_P_P,1), UBOUND(InData%ED_P_2_SStC_P_P,1) - Int_BufSz = Int_BufSz + 3 ! ED_P_2_SStC_P_P: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_SStC_P_P(i1), ErrStat2, ErrMsg2, .TRUE. ) ! ED_P_2_SStC_P_P - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! ED_P_2_SStC_P_P - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! ED_P_2_SStC_P_P - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! ED_P_2_SStC_P_P - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! SStC_P_P_2_SD_P allocated yes/no - IF ( ALLOCATED(InData%SStC_P_P_2_SD_P) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! SStC_P_P_2_SD_P upper/lower bounds for each dimension - DO i1 = LBOUND(InData%SStC_P_P_2_SD_P,1), UBOUND(InData%SStC_P_P_2_SD_P,1) - Int_BufSz = Int_BufSz + 3 ! SStC_P_P_2_SD_P: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%SStC_P_P_2_SD_P(i1), ErrStat2, ErrMsg2, .TRUE. ) ! SStC_P_P_2_SD_P - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SStC_P_P_2_SD_P - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SStC_P_P_2_SD_P - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SStC_P_P_2_SD_P - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! SDy3_P_2_SStC_P_P allocated yes/no - IF ( ALLOCATED(InData%SDy3_P_2_SStC_P_P) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! SDy3_P_2_SStC_P_P upper/lower bounds for each dimension - DO i1 = LBOUND(InData%SDy3_P_2_SStC_P_P,1), UBOUND(InData%SDy3_P_2_SStC_P_P,1) - Int_BufSz = Int_BufSz + 3 ! SDy3_P_2_SStC_P_P: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%SDy3_P_2_SStC_P_P(i1), ErrStat2, ErrMsg2, .TRUE. ) ! SDy3_P_2_SStC_P_P - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SDy3_P_2_SStC_P_P - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SDy3_P_2_SStC_P_P - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SDy3_P_2_SStC_P_P - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! ED_P_2_SrvD_P_P: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_SrvD_P_P, ErrStat2, ErrMsg2, .TRUE. ) ! ED_P_2_SrvD_P_P - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! ED_P_2_SrvD_P_P - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! ED_P_2_SrvD_P_P - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! ED_P_2_SrvD_P_P - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! BDED_L_2_AD_L_B allocated yes/no - IF ( ALLOCATED(InData%BDED_L_2_AD_L_B) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BDED_L_2_AD_L_B upper/lower bounds for each dimension - DO i1 = LBOUND(InData%BDED_L_2_AD_L_B,1), UBOUND(InData%BDED_L_2_AD_L_B,1) - Int_BufSz = Int_BufSz + 3 ! BDED_L_2_AD_L_B: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%BDED_L_2_AD_L_B(i1), ErrStat2, ErrMsg2, .TRUE. ) ! BDED_L_2_AD_L_B - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BDED_L_2_AD_L_B - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BDED_L_2_AD_L_B - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BDED_L_2_AD_L_B - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! AD_L_2_BDED_B allocated yes/no - IF ( ALLOCATED(InData%AD_L_2_BDED_B) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! AD_L_2_BDED_B upper/lower bounds for each dimension - DO i1 = LBOUND(InData%AD_L_2_BDED_B,1), UBOUND(InData%AD_L_2_BDED_B,1) - Int_BufSz = Int_BufSz + 3 ! AD_L_2_BDED_B: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%AD_L_2_BDED_B(i1), ErrStat2, ErrMsg2, .TRUE. ) ! AD_L_2_BDED_B - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! AD_L_2_BDED_B - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! AD_L_2_BDED_B - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! AD_L_2_BDED_B - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! BD_L_2_BD_L allocated yes/no - IF ( ALLOCATED(InData%BD_L_2_BD_L) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BD_L_2_BD_L upper/lower bounds for each dimension - DO i1 = LBOUND(InData%BD_L_2_BD_L,1), UBOUND(InData%BD_L_2_BD_L,1) - Int_BufSz = Int_BufSz + 3 ! BD_L_2_BD_L: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%BD_L_2_BD_L(i1), ErrStat2, ErrMsg2, .TRUE. ) ! BD_L_2_BD_L - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BD_L_2_BD_L - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BD_L_2_BD_L - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BD_L_2_BD_L - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! ED_P_2_AD_P_N: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_AD_P_N, ErrStat2, ErrMsg2, .TRUE. ) ! ED_P_2_AD_P_N - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! ED_P_2_AD_P_N - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! ED_P_2_AD_P_N - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! ED_P_2_AD_P_N - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! AD_P_2_ED_P_N: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%AD_P_2_ED_P_N, ErrStat2, ErrMsg2, .TRUE. ) ! AD_P_2_ED_P_N - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! AD_P_2_ED_P_N - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! AD_P_2_ED_P_N - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! AD_P_2_ED_P_N - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! ED_P_2_AD_P_TF: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_AD_P_TF, ErrStat2, ErrMsg2, .TRUE. ) ! ED_P_2_AD_P_TF - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! ED_P_2_AD_P_TF - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! ED_P_2_AD_P_TF - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! ED_P_2_AD_P_TF - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! AD_P_2_ED_P_TF: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%AD_P_2_ED_P_TF, ErrStat2, ErrMsg2, .TRUE. ) ! AD_P_2_ED_P_TF - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! AD_P_2_ED_P_TF - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! AD_P_2_ED_P_TF - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! AD_P_2_ED_P_TF - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! ED_L_2_AD_L_T: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_L_2_AD_L_T, ErrStat2, ErrMsg2, .TRUE. ) ! ED_L_2_AD_L_T - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! ED_L_2_AD_L_T - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! ED_L_2_AD_L_T - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! ED_L_2_AD_L_T - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! AD_L_2_ED_P_T: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%AD_L_2_ED_P_T, ErrStat2, ErrMsg2, .TRUE. ) ! AD_L_2_ED_P_T - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! AD_L_2_ED_P_T - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! AD_L_2_ED_P_T - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! AD_L_2_ED_P_T - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! ED_P_2_AD_P_R allocated yes/no - IF ( ALLOCATED(InData%ED_P_2_AD_P_R) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ED_P_2_AD_P_R upper/lower bounds for each dimension - DO i1 = LBOUND(InData%ED_P_2_AD_P_R,1), UBOUND(InData%ED_P_2_AD_P_R,1) - Int_BufSz = Int_BufSz + 3 ! ED_P_2_AD_P_R: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_AD_P_R(i1), ErrStat2, ErrMsg2, .TRUE. ) ! ED_P_2_AD_P_R - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! ED_P_2_AD_P_R - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! ED_P_2_AD_P_R - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! ED_P_2_AD_P_R - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! ED_P_2_AD_P_H: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_AD_P_H, ErrStat2, ErrMsg2, .TRUE. ) ! ED_P_2_AD_P_H - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! ED_P_2_AD_P_H - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! ED_P_2_AD_P_H - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! ED_P_2_AD_P_H - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! AD_P_2_ED_P_H: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%AD_P_2_ED_P_H, ErrStat2, ErrMsg2, .TRUE. ) ! AD_P_2_ED_P_H - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! AD_P_2_ED_P_H - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! AD_P_2_ED_P_H - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! AD_P_2_ED_P_H - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! IceF_P_2_SD_P: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%IceF_P_2_SD_P, ErrStat2, ErrMsg2, .TRUE. ) ! IceF_P_2_SD_P - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! IceF_P_2_SD_P - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! IceF_P_2_SD_P - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! IceF_P_2_SD_P - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! SDy3_P_2_IceF_P: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%SDy3_P_2_IceF_P, ErrStat2, ErrMsg2, .TRUE. ) ! SDy3_P_2_IceF_P - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SDy3_P_2_IceF_P - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SDy3_P_2_IceF_P - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SDy3_P_2_IceF_P - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! IceD_P_2_SD_P allocated yes/no - IF ( ALLOCATED(InData%IceD_P_2_SD_P) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! IceD_P_2_SD_P upper/lower bounds for each dimension - DO i1 = LBOUND(InData%IceD_P_2_SD_P,1), UBOUND(InData%IceD_P_2_SD_P,1) - Int_BufSz = Int_BufSz + 3 ! IceD_P_2_SD_P: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%IceD_P_2_SD_P(i1), ErrStat2, ErrMsg2, .TRUE. ) ! IceD_P_2_SD_P - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! IceD_P_2_SD_P - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! IceD_P_2_SD_P - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! IceD_P_2_SD_P - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! SDy3_P_2_IceD_P allocated yes/no - IF ( ALLOCATED(InData%SDy3_P_2_IceD_P) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! SDy3_P_2_IceD_P upper/lower bounds for each dimension - DO i1 = LBOUND(InData%SDy3_P_2_IceD_P,1), UBOUND(InData%SDy3_P_2_IceD_P,1) - Int_BufSz = Int_BufSz + 3 ! SDy3_P_2_IceD_P: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%SDy3_P_2_IceD_P(i1), ErrStat2, ErrMsg2, .TRUE. ) ! SDy3_P_2_IceD_P - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SDy3_P_2_IceD_P - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SDy3_P_2_IceD_P - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SDy3_P_2_IceD_P - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! Jacobian_Opt1 allocated yes/no - IF ( ALLOCATED(InData%Jacobian_Opt1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Jacobian_Opt1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Jacobian_Opt1) ! Jacobian_Opt1 - END IF - Int_BufSz = Int_BufSz + 1 ! Jacobian_pivot allocated yes/no - IF ( ALLOCATED(InData%Jacobian_pivot) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Jacobian_pivot upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Jacobian_pivot) ! Jacobian_pivot - END IF - 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 + 3 ! u_ED_NacelleLoads: size of buffers for each call to pack subtype - CALL MeshPack( InData%u_ED_NacelleLoads, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! u_ED_NacelleLoads - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_ED_NacelleLoads - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_ED_NacelleLoads - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_ED_NacelleLoads - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! u_ED_PlatformPtMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%u_ED_PlatformPtMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! u_ED_PlatformPtMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_ED_PlatformPtMesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_ED_PlatformPtMesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_ED_PlatformPtMesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! u_ED_PlatformPtMesh_2: size of buffers for each call to pack subtype - CALL MeshPack( InData%u_ED_PlatformPtMesh_2, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! u_ED_PlatformPtMesh_2 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_ED_PlatformPtMesh_2 - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_ED_PlatformPtMesh_2 - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_ED_PlatformPtMesh_2 - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! u_ED_PlatformPtMesh_3: size of buffers for each call to pack subtype - CALL MeshPack( InData%u_ED_PlatformPtMesh_3, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! u_ED_PlatformPtMesh_3 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_ED_PlatformPtMesh_3 - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_ED_PlatformPtMesh_3 - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_ED_PlatformPtMesh_3 - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! u_ED_PlatformPtMesh_MDf: size of buffers for each call to pack subtype - CALL MeshPack( InData%u_ED_PlatformPtMesh_MDf, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! u_ED_PlatformPtMesh_MDf - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_ED_PlatformPtMesh_MDf - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_ED_PlatformPtMesh_MDf - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_ED_PlatformPtMesh_MDf - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! u_ED_TowerPtloads: size of buffers for each call to pack subtype - CALL MeshPack( InData%u_ED_TowerPtloads, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! u_ED_TowerPtloads - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_ED_TowerPtloads - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_ED_TowerPtloads - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_ED_TowerPtloads - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! u_ED_BladePtLoads allocated yes/no - IF ( ALLOCATED(InData%u_ED_BladePtLoads) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! u_ED_BladePtLoads upper/lower bounds for each dimension - DO i1 = LBOUND(InData%u_ED_BladePtLoads,1), UBOUND(InData%u_ED_BladePtLoads,1) - Int_BufSz = Int_BufSz + 3 ! u_ED_BladePtLoads: size of buffers for each call to pack subtype - CALL MeshPack( InData%u_ED_BladePtLoads(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! u_ED_BladePtLoads - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_ED_BladePtLoads - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_ED_BladePtLoads - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_ED_BladePtLoads - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! u_SD_TPMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%u_SD_TPMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! u_SD_TPMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_SD_TPMesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_SD_TPMesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_SD_TPMesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! u_SD_LMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%u_SD_LMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! u_SD_LMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_SD_LMesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_SD_LMesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_SD_LMesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! u_SD_LMesh_2: size of buffers for each call to pack subtype - CALL MeshPack( InData%u_SD_LMesh_2, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! u_SD_LMesh_2 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_SD_LMesh_2 - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_SD_LMesh_2 - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_SD_LMesh_2 - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! u_HD_M_Mesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%u_HD_M_Mesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! u_HD_M_Mesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_HD_M_Mesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_HD_M_Mesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_HD_M_Mesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! u_HD_W_Mesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%u_HD_W_Mesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! u_HD_W_Mesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_HD_W_Mesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_HD_W_Mesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_HD_W_Mesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! u_ED_HubPtLoad: size of buffers for each call to pack subtype - CALL MeshPack( InData%u_ED_HubPtLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! u_ED_HubPtLoad - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_ED_HubPtLoad - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_ED_HubPtLoad - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_ED_HubPtLoad - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! u_ED_HubPtLoad_2: size of buffers for each call to pack subtype - CALL MeshPack( InData%u_ED_HubPtLoad_2, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! u_ED_HubPtLoad_2 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_ED_HubPtLoad_2 - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_ED_HubPtLoad_2 - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_ED_HubPtLoad_2 - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! u_BD_RootMotion allocated yes/no - IF ( ALLOCATED(InData%u_BD_RootMotion) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! u_BD_RootMotion upper/lower bounds for each dimension - DO i1 = LBOUND(InData%u_BD_RootMotion,1), UBOUND(InData%u_BD_RootMotion,1) - Int_BufSz = Int_BufSz + 3 ! u_BD_RootMotion: size of buffers for each call to pack subtype - CALL MeshPack( InData%u_BD_RootMotion(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! u_BD_RootMotion - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_BD_RootMotion - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_BD_RootMotion - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_BD_RootMotion - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! y_BD_BldMotion_4Loads allocated yes/no - IF ( ALLOCATED(InData%y_BD_BldMotion_4Loads) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! y_BD_BldMotion_4Loads upper/lower bounds for each dimension - DO i1 = LBOUND(InData%y_BD_BldMotion_4Loads,1), UBOUND(InData%y_BD_BldMotion_4Loads,1) - Int_BufSz = Int_BufSz + 3 ! y_BD_BldMotion_4Loads: size of buffers for each call to pack subtype - CALL MeshPack( InData%y_BD_BldMotion_4Loads(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! y_BD_BldMotion_4Loads - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y_BD_BldMotion_4Loads - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y_BD_BldMotion_4Loads - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y_BD_BldMotion_4Loads - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! u_BD_Distrload allocated yes/no - IF ( ALLOCATED(InData%u_BD_Distrload) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! u_BD_Distrload upper/lower bounds for each dimension - DO i1 = LBOUND(InData%u_BD_Distrload,1), UBOUND(InData%u_BD_Distrload,1) - Int_BufSz = Int_BufSz + 3 ! u_BD_Distrload: size of buffers for each call to pack subtype - CALL MeshPack( InData%u_BD_Distrload(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! u_BD_Distrload - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_BD_Distrload - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_BD_Distrload - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_BD_Distrload - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! u_Orca_PtfmMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%u_Orca_PtfmMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! u_Orca_PtfmMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_Orca_PtfmMesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_Orca_PtfmMesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_Orca_PtfmMesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! u_ExtPtfm_PtfmMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%u_ExtPtfm_PtfmMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! u_ExtPtfm_PtfmMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_ExtPtfm_PtfmMesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_ExtPtfm_PtfmMesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_ExtPtfm_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 - - IF ( .NOT. ALLOCATED(InData%ED_P_2_BD_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%ED_P_2_BD_P,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ED_P_2_BD_P,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ED_P_2_BD_P,1), UBOUND(InData%ED_P_2_BD_P,1) - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_BD_P(i1), ErrStat2, ErrMsg2, OnlySize ) ! ED_P_2_BD_P - 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%BD_P_2_ED_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%BD_P_2_ED_P,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BD_P_2_ED_P,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BD_P_2_ED_P,1), UBOUND(InData%BD_P_2_ED_P,1) - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%BD_P_2_ED_P(i1), ErrStat2, ErrMsg2, OnlySize ) ! BD_P_2_ED_P - 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%ED_P_2_BD_P_Hub) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ED_P_2_BD_P_Hub,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ED_P_2_BD_P_Hub,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ED_P_2_BD_P_Hub,1), UBOUND(InData%ED_P_2_BD_P_Hub,1) - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_BD_P_Hub(i1), ErrStat2, ErrMsg2, OnlySize ) ! ED_P_2_BD_P_Hub - 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 - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_HD_PRP_P, ErrStat2, ErrMsg2, OnlySize ) ! ED_P_2_HD_PRP_P - 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 NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_HD_W_P, ErrStat2, ErrMsg2, OnlySize ) ! ED_P_2_HD_W_P - 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 NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%HD_W_P_2_ED_P, ErrStat2, ErrMsg2, OnlySize ) ! HD_W_P_2_ED_P - 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 NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_HD_M_P, ErrStat2, ErrMsg2, OnlySize ) ! ED_P_2_HD_M_P - 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 NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%HD_M_P_2_ED_P, ErrStat2, ErrMsg2, OnlySize ) ! HD_M_P_2_ED_P - 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 NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_Mooring_P, ErrStat2, ErrMsg2, OnlySize ) ! ED_P_2_Mooring_P - 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 NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%Mooring_P_2_ED_P, ErrStat2, ErrMsg2, OnlySize ) ! Mooring_P_2_ED_P - 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 NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%SDy3_P_2_Mooring_P, ErrStat2, ErrMsg2, OnlySize ) ! SDy3_P_2_Mooring_P - 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 NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%Mooring_P_2_SD_P, ErrStat2, ErrMsg2, OnlySize ) ! Mooring_P_2_SD_P - 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 NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_SD_TP, ErrStat2, ErrMsg2, OnlySize ) ! ED_P_2_SD_TP - 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 NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%SD_TP_2_ED_P, ErrStat2, ErrMsg2, OnlySize ) ! SD_TP_2_ED_P - 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 NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%SD_P_2_HD_M_P, ErrStat2, ErrMsg2, OnlySize ) ! SD_P_2_HD_M_P - 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 NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%HD_M_P_2_SD_P, ErrStat2, ErrMsg2, OnlySize ) ! HD_M_P_2_SD_P - 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 NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%SD_P_2_HD_W_P, ErrStat2, ErrMsg2, OnlySize ) ! SD_P_2_HD_W_P - 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 NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%HD_W_P_2_SD_P, ErrStat2, ErrMsg2, OnlySize ) ! HD_W_P_2_SD_P - 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%ED_P_2_NStC_P_N) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ED_P_2_NStC_P_N,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ED_P_2_NStC_P_N,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ED_P_2_NStC_P_N,1), UBOUND(InData%ED_P_2_NStC_P_N,1) - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_NStC_P_N(i1), ErrStat2, ErrMsg2, OnlySize ) ! ED_P_2_NStC_P_N - 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_P_2_ED_P_N) ) THEN - 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_P_2_ED_P_N,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NStC_P_2_ED_P_N,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%NStC_P_2_ED_P_N,1), UBOUND(InData%NStC_P_2_ED_P_N,1) - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%NStC_P_2_ED_P_N(i1), ErrStat2, ErrMsg2, OnlySize ) ! NStC_P_2_ED_P_N - 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%ED_L_2_TStC_P_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%ED_L_2_TStC_P_T,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ED_L_2_TStC_P_T,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ED_L_2_TStC_P_T,1), UBOUND(InData%ED_L_2_TStC_P_T,1) - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_L_2_TStC_P_T(i1), ErrStat2, ErrMsg2, OnlySize ) ! ED_L_2_TStC_P_T - 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_P_2_ED_P_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%TStC_P_2_ED_P_T,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TStC_P_2_ED_P_T,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TStC_P_2_ED_P_T,1), UBOUND(InData%TStC_P_2_ED_P_T,1) - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%TStC_P_2_ED_P_T(i1), ErrStat2, ErrMsg2, OnlySize ) ! TStC_P_2_ED_P_T - 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%ED_L_2_BStC_P_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%ED_L_2_BStC_P_B,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ED_L_2_BStC_P_B,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ED_L_2_BStC_P_B,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ED_L_2_BStC_P_B,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%ED_L_2_BStC_P_B,2), UBOUND(InData%ED_L_2_BStC_P_B,2) - DO i1 = LBOUND(InData%ED_L_2_BStC_P_B,1), UBOUND(InData%ED_L_2_BStC_P_B,1) - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_L_2_BStC_P_B(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! ED_L_2_BStC_P_B - 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 DO - END IF - IF ( .NOT. ALLOCATED(InData%BStC_P_2_ED_P_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%BStC_P_2_ED_P_B,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BStC_P_2_ED_P_B,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BStC_P_2_ED_P_B,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BStC_P_2_ED_P_B,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%BStC_P_2_ED_P_B,2), UBOUND(InData%BStC_P_2_ED_P_B,2) - DO i1 = LBOUND(InData%BStC_P_2_ED_P_B,1), UBOUND(InData%BStC_P_2_ED_P_B,1) - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%BStC_P_2_ED_P_B(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! BStC_P_2_ED_P_B - 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 DO - END IF - IF ( .NOT. ALLOCATED(InData%BD_L_2_BStC_P_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%BD_L_2_BStC_P_B,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BD_L_2_BStC_P_B,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BD_L_2_BStC_P_B,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BD_L_2_BStC_P_B,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%BD_L_2_BStC_P_B,2), UBOUND(InData%BD_L_2_BStC_P_B,2) - DO i1 = LBOUND(InData%BD_L_2_BStC_P_B,1), UBOUND(InData%BD_L_2_BStC_P_B,1) - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%BD_L_2_BStC_P_B(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! BD_L_2_BStC_P_B - 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 DO - END IF - IF ( .NOT. ALLOCATED(InData%BStC_P_2_BD_P_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%BStC_P_2_BD_P_B,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BStC_P_2_BD_P_B,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BStC_P_2_BD_P_B,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BStC_P_2_BD_P_B,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%BStC_P_2_BD_P_B,2), UBOUND(InData%BStC_P_2_BD_P_B,2) - DO i1 = LBOUND(InData%BStC_P_2_BD_P_B,1), UBOUND(InData%BStC_P_2_BD_P_B,1) - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%BStC_P_2_BD_P_B(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! BStC_P_2_BD_P_B - 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 DO - END IF - IF ( .NOT. ALLOCATED(InData%SStC_P_P_2_ED_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%SStC_P_P_2_ED_P,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SStC_P_P_2_ED_P,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%SStC_P_P_2_ED_P,1), UBOUND(InData%SStC_P_P_2_ED_P,1) - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%SStC_P_P_2_ED_P(i1), ErrStat2, ErrMsg2, OnlySize ) ! SStC_P_P_2_ED_P - 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%ED_P_2_SStC_P_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%ED_P_2_SStC_P_P,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ED_P_2_SStC_P_P,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ED_P_2_SStC_P_P,1), UBOUND(InData%ED_P_2_SStC_P_P,1) - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_SStC_P_P(i1), ErrStat2, ErrMsg2, OnlySize ) ! ED_P_2_SStC_P_P - 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_P_P_2_SD_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%SStC_P_P_2_SD_P,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SStC_P_P_2_SD_P,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%SStC_P_P_2_SD_P,1), UBOUND(InData%SStC_P_P_2_SD_P,1) - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%SStC_P_P_2_SD_P(i1), ErrStat2, ErrMsg2, OnlySize ) ! SStC_P_P_2_SD_P - 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%SDy3_P_2_SStC_P_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%SDy3_P_2_SStC_P_P,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SDy3_P_2_SStC_P_P,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%SDy3_P_2_SStC_P_P,1), UBOUND(InData%SDy3_P_2_SStC_P_P,1) - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%SDy3_P_2_SStC_P_P(i1), ErrStat2, ErrMsg2, OnlySize ) ! SDy3_P_2_SStC_P_P - 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 - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_SrvD_P_P, ErrStat2, ErrMsg2, OnlySize ) ! ED_P_2_SrvD_P_P - 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%BDED_L_2_AD_L_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%BDED_L_2_AD_L_B,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BDED_L_2_AD_L_B,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BDED_L_2_AD_L_B,1), UBOUND(InData%BDED_L_2_AD_L_B,1) - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%BDED_L_2_AD_L_B(i1), ErrStat2, ErrMsg2, OnlySize ) ! BDED_L_2_AD_L_B - 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%AD_L_2_BDED_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%AD_L_2_BDED_B,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AD_L_2_BDED_B,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%AD_L_2_BDED_B,1), UBOUND(InData%AD_L_2_BDED_B,1) - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%AD_L_2_BDED_B(i1), ErrStat2, ErrMsg2, OnlySize ) ! AD_L_2_BDED_B - 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%BD_L_2_BD_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%BD_L_2_BD_L,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BD_L_2_BD_L,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BD_L_2_BD_L,1), UBOUND(InData%BD_L_2_BD_L,1) - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%BD_L_2_BD_L(i1), ErrStat2, ErrMsg2, OnlySize ) ! BD_L_2_BD_L - 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 - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_AD_P_N, ErrStat2, ErrMsg2, OnlySize ) ! ED_P_2_AD_P_N - 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 NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%AD_P_2_ED_P_N, ErrStat2, ErrMsg2, OnlySize ) ! AD_P_2_ED_P_N - 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 NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_AD_P_TF, ErrStat2, ErrMsg2, OnlySize ) ! ED_P_2_AD_P_TF - 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 NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%AD_P_2_ED_P_TF, ErrStat2, ErrMsg2, OnlySize ) ! AD_P_2_ED_P_TF - 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 NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_L_2_AD_L_T, ErrStat2, ErrMsg2, OnlySize ) ! ED_L_2_AD_L_T - 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 NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%AD_L_2_ED_P_T, ErrStat2, ErrMsg2, OnlySize ) ! AD_L_2_ED_P_T - 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%ED_P_2_AD_P_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%ED_P_2_AD_P_R,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ED_P_2_AD_P_R,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ED_P_2_AD_P_R,1), UBOUND(InData%ED_P_2_AD_P_R,1) - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_AD_P_R(i1), ErrStat2, ErrMsg2, OnlySize ) ! ED_P_2_AD_P_R - 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 - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_AD_P_H, ErrStat2, ErrMsg2, OnlySize ) ! ED_P_2_AD_P_H - 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 NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%AD_P_2_ED_P_H, ErrStat2, ErrMsg2, OnlySize ) ! AD_P_2_ED_P_H - 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 NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%IceF_P_2_SD_P, ErrStat2, ErrMsg2, OnlySize ) ! IceF_P_2_SD_P - 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 NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%SDy3_P_2_IceF_P, ErrStat2, ErrMsg2, OnlySize ) ! SDy3_P_2_IceF_P - 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%IceD_P_2_SD_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%IceD_P_2_SD_P,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IceD_P_2_SD_P,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%IceD_P_2_SD_P,1), UBOUND(InData%IceD_P_2_SD_P,1) - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%IceD_P_2_SD_P(i1), ErrStat2, ErrMsg2, OnlySize ) ! IceD_P_2_SD_P - 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%SDy3_P_2_IceD_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%SDy3_P_2_IceD_P,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SDy3_P_2_IceD_P,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%SDy3_P_2_IceD_P,1), UBOUND(InData%SDy3_P_2_IceD_P,1) - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%SDy3_P_2_IceD_P(i1), ErrStat2, ErrMsg2, OnlySize ) ! SDy3_P_2_IceD_P - 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%Jacobian_Opt1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Jacobian_Opt1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jacobian_Opt1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Jacobian_Opt1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jacobian_Opt1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Jacobian_Opt1,2), UBOUND(InData%Jacobian_Opt1,2) - DO i1 = LBOUND(InData%Jacobian_Opt1,1), UBOUND(InData%Jacobian_Opt1,1) - ReKiBuf(Re_Xferred) = InData%Jacobian_Opt1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Jacobian_pivot) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Jacobian_pivot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jacobian_pivot,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Jacobian_pivot,1), UBOUND(InData%Jacobian_pivot,1) - IntKiBuf(Int_Xferred) = InData%Jacobian_pivot(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - 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 - CALL MeshPack( InData%u_ED_NacelleLoads, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! u_ED_NacelleLoads - 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%u_ED_PlatformPtMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! u_ED_PlatformPtMesh - 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%u_ED_PlatformPtMesh_2, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! u_ED_PlatformPtMesh_2 - 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%u_ED_PlatformPtMesh_3, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! u_ED_PlatformPtMesh_3 - 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%u_ED_PlatformPtMesh_MDf, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! u_ED_PlatformPtMesh_MDf - 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%u_ED_TowerPtloads, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! u_ED_TowerPtloads - 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%u_ED_BladePtLoads) ) THEN - 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_ED_BladePtLoads,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_ED_BladePtLoads,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%u_ED_BladePtLoads,1), UBOUND(InData%u_ED_BladePtLoads,1) - CALL MeshPack( InData%u_ED_BladePtLoads(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! u_ED_BladePtLoads - 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 - CALL MeshPack( InData%u_SD_TPMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! u_SD_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%u_SD_LMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! u_SD_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 - CALL MeshPack( InData%u_SD_LMesh_2, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! u_SD_LMesh_2 - 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%u_HD_M_Mesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! u_HD_M_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 - CALL MeshPack( InData%u_HD_W_Mesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! u_HD_W_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 - CALL MeshPack( InData%u_ED_HubPtLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! u_ED_HubPtLoad - 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%u_ED_HubPtLoad_2, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! u_ED_HubPtLoad_2 - 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%u_BD_RootMotion) ) THEN - 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_BD_RootMotion,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_BD_RootMotion,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%u_BD_RootMotion,1), UBOUND(InData%u_BD_RootMotion,1) - CALL MeshPack( InData%u_BD_RootMotion(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! u_BD_RootMotion - 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%y_BD_BldMotion_4Loads) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%y_BD_BldMotion_4Loads,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%y_BD_BldMotion_4Loads,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%y_BD_BldMotion_4Loads,1), UBOUND(InData%y_BD_BldMotion_4Loads,1) - CALL MeshPack( InData%y_BD_BldMotion_4Loads(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! y_BD_BldMotion_4Loads - 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%u_BD_Distrload) ) THEN - 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_BD_Distrload,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_BD_Distrload,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%u_BD_Distrload,1), UBOUND(InData%u_BD_Distrload,1) - CALL MeshPack( InData%u_BD_Distrload(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! u_BD_Distrload - 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 - CALL MeshPack( InData%u_Orca_PtfmMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! u_Orca_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 - CALL MeshPack( InData%u_ExtPtfm_PtfmMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! u_ExtPtfm_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 FAST_PackModuleMapType - - SUBROUTINE FAST_UnPackModuleMapType( 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(FAST_ModuleMapType), 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 = 'FAST_UnPackModuleMapType' - ! 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 ! ED_P_2_BD_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 - IF (ALLOCATED(OutData%ED_P_2_BD_P)) DEALLOCATE(OutData%ED_P_2_BD_P) - ALLOCATE(OutData%ED_P_2_BD_P(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ED_P_2_BD_P.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ED_P_2_BD_P,1), UBOUND(OutData%ED_P_2_BD_P,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%ED_P_2_BD_P(i1), ErrStat2, ErrMsg2 ) ! ED_P_2_BD_P - 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 ! BD_P_2_ED_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 - IF (ALLOCATED(OutData%BD_P_2_ED_P)) DEALLOCATE(OutData%BD_P_2_ED_P) - ALLOCATE(OutData%BD_P_2_ED_P(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BD_P_2_ED_P.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BD_P_2_ED_P,1), UBOUND(OutData%BD_P_2_ED_P,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%BD_P_2_ED_P(i1), ErrStat2, ErrMsg2 ) ! BD_P_2_ED_P - 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 ! ED_P_2_BD_P_Hub not allocated - Int_Xferred = Int_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%ED_P_2_BD_P_Hub)) DEALLOCATE(OutData%ED_P_2_BD_P_Hub) - ALLOCATE(OutData%ED_P_2_BD_P_Hub(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ED_P_2_BD_P_Hub.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ED_P_2_BD_P_Hub,1), UBOUND(OutData%ED_P_2_BD_P_Hub,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%ED_P_2_BD_P_Hub(i1), ErrStat2, ErrMsg2 ) ! ED_P_2_BD_P_Hub - 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 - 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%ED_P_2_HD_PRP_P, ErrStat2, ErrMsg2 ) ! ED_P_2_HD_PRP_P - 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 NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%ED_P_2_HD_W_P, ErrStat2, ErrMsg2 ) ! ED_P_2_HD_W_P - 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 NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%HD_W_P_2_ED_P, ErrStat2, ErrMsg2 ) ! HD_W_P_2_ED_P - 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 NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%ED_P_2_HD_M_P, ErrStat2, ErrMsg2 ) ! ED_P_2_HD_M_P - 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 NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%HD_M_P_2_ED_P, ErrStat2, ErrMsg2 ) ! HD_M_P_2_ED_P - 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 NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%ED_P_2_Mooring_P, ErrStat2, ErrMsg2 ) ! ED_P_2_Mooring_P - 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 NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%Mooring_P_2_ED_P, ErrStat2, ErrMsg2 ) ! Mooring_P_2_ED_P - 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 NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%SDy3_P_2_Mooring_P, ErrStat2, ErrMsg2 ) ! SDy3_P_2_Mooring_P - 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 NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%Mooring_P_2_SD_P, ErrStat2, ErrMsg2 ) ! Mooring_P_2_SD_P - 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 NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%ED_P_2_SD_TP, ErrStat2, ErrMsg2 ) ! ED_P_2_SD_TP - 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 NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%SD_TP_2_ED_P, ErrStat2, ErrMsg2 ) ! SD_TP_2_ED_P - 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 NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%SD_P_2_HD_M_P, ErrStat2, ErrMsg2 ) ! SD_P_2_HD_M_P - 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 NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%HD_M_P_2_SD_P, ErrStat2, ErrMsg2 ) ! HD_M_P_2_SD_P - 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 NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%SD_P_2_HD_W_P, ErrStat2, ErrMsg2 ) ! SD_P_2_HD_W_P - 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 NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%HD_W_P_2_SD_P, ErrStat2, ErrMsg2 ) ! HD_W_P_2_SD_P - 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 ! ED_P_2_NStC_P_N not allocated - Int_Xferred = Int_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%ED_P_2_NStC_P_N)) DEALLOCATE(OutData%ED_P_2_NStC_P_N) - ALLOCATE(OutData%ED_P_2_NStC_P_N(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ED_P_2_NStC_P_N.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ED_P_2_NStC_P_N,1), UBOUND(OutData%ED_P_2_NStC_P_N,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%ED_P_2_NStC_P_N(i1), ErrStat2, ErrMsg2 ) ! ED_P_2_NStC_P_N - 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_P_2_ED_P_N not allocated - Int_Xferred = Int_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_P_2_ED_P_N)) DEALLOCATE(OutData%NStC_P_2_ED_P_N) - ALLOCATE(OutData%NStC_P_2_ED_P_N(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NStC_P_2_ED_P_N.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%NStC_P_2_ED_P_N,1), UBOUND(OutData%NStC_P_2_ED_P_N,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%NStC_P_2_ED_P_N(i1), ErrStat2, ErrMsg2 ) ! NStC_P_2_ED_P_N - 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 ! ED_L_2_TStC_P_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 - IF (ALLOCATED(OutData%ED_L_2_TStC_P_T)) DEALLOCATE(OutData%ED_L_2_TStC_P_T) - ALLOCATE(OutData%ED_L_2_TStC_P_T(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ED_L_2_TStC_P_T.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ED_L_2_TStC_P_T,1), UBOUND(OutData%ED_L_2_TStC_P_T,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%ED_L_2_TStC_P_T(i1), ErrStat2, ErrMsg2 ) ! ED_L_2_TStC_P_T - 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_P_2_ED_P_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 - IF (ALLOCATED(OutData%TStC_P_2_ED_P_T)) DEALLOCATE(OutData%TStC_P_2_ED_P_T) - ALLOCATE(OutData%TStC_P_2_ED_P_T(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TStC_P_2_ED_P_T.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TStC_P_2_ED_P_T,1), UBOUND(OutData%TStC_P_2_ED_P_T,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%TStC_P_2_ED_P_T(i1), ErrStat2, ErrMsg2 ) ! TStC_P_2_ED_P_T - 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 ! ED_L_2_BStC_P_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 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%ED_L_2_BStC_P_B)) DEALLOCATE(OutData%ED_L_2_BStC_P_B) - ALLOCATE(OutData%ED_L_2_BStC_P_B(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ED_L_2_BStC_P_B.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%ED_L_2_BStC_P_B,2), UBOUND(OutData%ED_L_2_BStC_P_B,2) - DO i1 = LBOUND(OutData%ED_L_2_BStC_P_B,1), UBOUND(OutData%ED_L_2_BStC_P_B,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%ED_L_2_BStC_P_B(i1,i2), ErrStat2, ErrMsg2 ) ! ED_L_2_BStC_P_B - 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 DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BStC_P_2_ED_P_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 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BStC_P_2_ED_P_B)) DEALLOCATE(OutData%BStC_P_2_ED_P_B) - ALLOCATE(OutData%BStC_P_2_ED_P_B(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BStC_P_2_ED_P_B.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%BStC_P_2_ED_P_B,2), UBOUND(OutData%BStC_P_2_ED_P_B,2) - DO i1 = LBOUND(OutData%BStC_P_2_ED_P_B,1), UBOUND(OutData%BStC_P_2_ED_P_B,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%BStC_P_2_ED_P_B(i1,i2), ErrStat2, ErrMsg2 ) ! BStC_P_2_ED_P_B - 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 DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BD_L_2_BStC_P_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 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BD_L_2_BStC_P_B)) DEALLOCATE(OutData%BD_L_2_BStC_P_B) - ALLOCATE(OutData%BD_L_2_BStC_P_B(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BD_L_2_BStC_P_B.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%BD_L_2_BStC_P_B,2), UBOUND(OutData%BD_L_2_BStC_P_B,2) - DO i1 = LBOUND(OutData%BD_L_2_BStC_P_B,1), UBOUND(OutData%BD_L_2_BStC_P_B,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%BD_L_2_BStC_P_B(i1,i2), ErrStat2, ErrMsg2 ) ! BD_L_2_BStC_P_B - 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 DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BStC_P_2_BD_P_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 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BStC_P_2_BD_P_B)) DEALLOCATE(OutData%BStC_P_2_BD_P_B) - ALLOCATE(OutData%BStC_P_2_BD_P_B(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BStC_P_2_BD_P_B.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%BStC_P_2_BD_P_B,2), UBOUND(OutData%BStC_P_2_BD_P_B,2) - DO i1 = LBOUND(OutData%BStC_P_2_BD_P_B,1), UBOUND(OutData%BStC_P_2_BD_P_B,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%BStC_P_2_BD_P_B(i1,i2), ErrStat2, ErrMsg2 ) ! BStC_P_2_BD_P_B - 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 DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SStC_P_P_2_ED_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 - IF (ALLOCATED(OutData%SStC_P_P_2_ED_P)) DEALLOCATE(OutData%SStC_P_P_2_ED_P) - ALLOCATE(OutData%SStC_P_P_2_ED_P(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SStC_P_P_2_ED_P.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%SStC_P_P_2_ED_P,1), UBOUND(OutData%SStC_P_P_2_ED_P,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%SStC_P_P_2_ED_P(i1), ErrStat2, ErrMsg2 ) ! SStC_P_P_2_ED_P - 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 ! ED_P_2_SStC_P_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 - IF (ALLOCATED(OutData%ED_P_2_SStC_P_P)) DEALLOCATE(OutData%ED_P_2_SStC_P_P) - ALLOCATE(OutData%ED_P_2_SStC_P_P(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ED_P_2_SStC_P_P.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ED_P_2_SStC_P_P,1), UBOUND(OutData%ED_P_2_SStC_P_P,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%ED_P_2_SStC_P_P(i1), ErrStat2, ErrMsg2 ) ! ED_P_2_SStC_P_P - 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_P_P_2_SD_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 - IF (ALLOCATED(OutData%SStC_P_P_2_SD_P)) DEALLOCATE(OutData%SStC_P_P_2_SD_P) - ALLOCATE(OutData%SStC_P_P_2_SD_P(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SStC_P_P_2_SD_P.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%SStC_P_P_2_SD_P,1), UBOUND(OutData%SStC_P_P_2_SD_P,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%SStC_P_P_2_SD_P(i1), ErrStat2, ErrMsg2 ) ! SStC_P_P_2_SD_P - 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 ! SDy3_P_2_SStC_P_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 - IF (ALLOCATED(OutData%SDy3_P_2_SStC_P_P)) DEALLOCATE(OutData%SDy3_P_2_SStC_P_P) - ALLOCATE(OutData%SDy3_P_2_SStC_P_P(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SDy3_P_2_SStC_P_P.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%SDy3_P_2_SStC_P_P,1), UBOUND(OutData%SDy3_P_2_SStC_P_P,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%SDy3_P_2_SStC_P_P(i1), ErrStat2, ErrMsg2 ) ! SDy3_P_2_SStC_P_P - 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 - 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%ED_P_2_SrvD_P_P, ErrStat2, ErrMsg2 ) ! ED_P_2_SrvD_P_P - 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 ! BDED_L_2_AD_L_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%BDED_L_2_AD_L_B)) DEALLOCATE(OutData%BDED_L_2_AD_L_B) - ALLOCATE(OutData%BDED_L_2_AD_L_B(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BDED_L_2_AD_L_B.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BDED_L_2_AD_L_B,1), UBOUND(OutData%BDED_L_2_AD_L_B,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%BDED_L_2_AD_L_B(i1), ErrStat2, ErrMsg2 ) ! BDED_L_2_AD_L_B - 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 ! AD_L_2_BDED_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%AD_L_2_BDED_B)) DEALLOCATE(OutData%AD_L_2_BDED_B) - ALLOCATE(OutData%AD_L_2_BDED_B(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AD_L_2_BDED_B.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%AD_L_2_BDED_B,1), UBOUND(OutData%AD_L_2_BDED_B,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%AD_L_2_BDED_B(i1), ErrStat2, ErrMsg2 ) ! AD_L_2_BDED_B - 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 ! BD_L_2_BD_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%BD_L_2_BD_L)) DEALLOCATE(OutData%BD_L_2_BD_L) - ALLOCATE(OutData%BD_L_2_BD_L(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BD_L_2_BD_L.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BD_L_2_BD_L,1), UBOUND(OutData%BD_L_2_BD_L,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%BD_L_2_BD_L(i1), ErrStat2, ErrMsg2 ) ! BD_L_2_BD_L - 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 - 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%ED_P_2_AD_P_N, ErrStat2, ErrMsg2 ) ! ED_P_2_AD_P_N - 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 NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%AD_P_2_ED_P_N, ErrStat2, ErrMsg2 ) ! AD_P_2_ED_P_N - 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 NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%ED_P_2_AD_P_TF, ErrStat2, ErrMsg2 ) ! ED_P_2_AD_P_TF - 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 NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%AD_P_2_ED_P_TF, ErrStat2, ErrMsg2 ) ! AD_P_2_ED_P_TF - 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 NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%ED_L_2_AD_L_T, ErrStat2, ErrMsg2 ) ! ED_L_2_AD_L_T - 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 NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%AD_L_2_ED_P_T, ErrStat2, ErrMsg2 ) ! AD_L_2_ED_P_T - 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 ! ED_P_2_AD_P_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%ED_P_2_AD_P_R)) DEALLOCATE(OutData%ED_P_2_AD_P_R) - ALLOCATE(OutData%ED_P_2_AD_P_R(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ED_P_2_AD_P_R.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ED_P_2_AD_P_R,1), UBOUND(OutData%ED_P_2_AD_P_R,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%ED_P_2_AD_P_R(i1), ErrStat2, ErrMsg2 ) ! ED_P_2_AD_P_R - 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 - 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%ED_P_2_AD_P_H, ErrStat2, ErrMsg2 ) ! ED_P_2_AD_P_H - 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 NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%AD_P_2_ED_P_H, ErrStat2, ErrMsg2 ) ! AD_P_2_ED_P_H - 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 NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%IceF_P_2_SD_P, ErrStat2, ErrMsg2 ) ! IceF_P_2_SD_P - 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 NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%SDy3_P_2_IceF_P, ErrStat2, ErrMsg2 ) ! SDy3_P_2_IceF_P - 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 ! IceD_P_2_SD_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 - IF (ALLOCATED(OutData%IceD_P_2_SD_P)) DEALLOCATE(OutData%IceD_P_2_SD_P) - ALLOCATE(OutData%IceD_P_2_SD_P(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IceD_P_2_SD_P.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%IceD_P_2_SD_P,1), UBOUND(OutData%IceD_P_2_SD_P,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%IceD_P_2_SD_P(i1), ErrStat2, ErrMsg2 ) ! IceD_P_2_SD_P - 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 ! SDy3_P_2_IceD_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 - IF (ALLOCATED(OutData%SDy3_P_2_IceD_P)) DEALLOCATE(OutData%SDy3_P_2_IceD_P) - ALLOCATE(OutData%SDy3_P_2_IceD_P(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SDy3_P_2_IceD_P.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%SDy3_P_2_IceD_P,1), UBOUND(OutData%SDy3_P_2_IceD_P,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%SDy3_P_2_IceD_P(i1), ErrStat2, ErrMsg2 ) ! SDy3_P_2_IceD_P - 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 ! Jacobian_Opt1 not allocated - Int_Xferred = Int_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%Jacobian_Opt1)) DEALLOCATE(OutData%Jacobian_Opt1) - ALLOCATE(OutData%Jacobian_Opt1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jacobian_Opt1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Jacobian_Opt1,2), UBOUND(OutData%Jacobian_Opt1,2) - DO i1 = LBOUND(OutData%Jacobian_Opt1,1), UBOUND(OutData%Jacobian_Opt1,1) - OutData%Jacobian_Opt1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Jacobian_pivot not allocated - Int_Xferred = Int_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%Jacobian_pivot)) DEALLOCATE(OutData%Jacobian_pivot) - ALLOCATE(OutData%Jacobian_pivot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jacobian_pivot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Jacobian_pivot,1), UBOUND(OutData%Jacobian_pivot,1) - OutData%Jacobian_pivot(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - 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 - 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%u_ED_NacelleLoads, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_ED_NacelleLoads - 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%u_ED_PlatformPtMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_ED_PlatformPtMesh - 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%u_ED_PlatformPtMesh_2, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_ED_PlatformPtMesh_2 - 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%u_ED_PlatformPtMesh_3, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_ED_PlatformPtMesh_3 - 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%u_ED_PlatformPtMesh_MDf, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_ED_PlatformPtMesh_MDf - 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%u_ED_TowerPtloads, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_ED_TowerPtloads - 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 ! u_ED_BladePtLoads not allocated - Int_Xferred = Int_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_ED_BladePtLoads)) DEALLOCATE(OutData%u_ED_BladePtLoads) - ALLOCATE(OutData%u_ED_BladePtLoads(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_ED_BladePtLoads.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%u_ED_BladePtLoads,1), UBOUND(OutData%u_ED_BladePtLoads,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%u_ED_BladePtLoads(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_ED_BladePtLoads - 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 - 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%u_SD_TPMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_SD_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%u_SD_LMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_SD_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) - 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%u_SD_LMesh_2, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_SD_LMesh_2 - 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%u_HD_M_Mesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_HD_M_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) - 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%u_HD_W_Mesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_HD_W_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) - 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%u_ED_HubPtLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_ED_HubPtLoad - 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%u_ED_HubPtLoad_2, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_ED_HubPtLoad_2 - 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 ! u_BD_RootMotion not allocated - Int_Xferred = Int_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_BD_RootMotion)) DEALLOCATE(OutData%u_BD_RootMotion) - ALLOCATE(OutData%u_BD_RootMotion(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_BD_RootMotion.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%u_BD_RootMotion,1), UBOUND(OutData%u_BD_RootMotion,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%u_BD_RootMotion(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_BD_RootMotion - 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 ! y_BD_BldMotion_4Loads not allocated - Int_Xferred = Int_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%y_BD_BldMotion_4Loads)) DEALLOCATE(OutData%y_BD_BldMotion_4Loads) - ALLOCATE(OutData%y_BD_BldMotion_4Loads(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%y_BD_BldMotion_4Loads.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%y_BD_BldMotion_4Loads,1), UBOUND(OutData%y_BD_BldMotion_4Loads,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%y_BD_BldMotion_4Loads(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! y_BD_BldMotion_4Loads - 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 ! u_BD_Distrload not allocated - Int_Xferred = Int_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_BD_Distrload)) DEALLOCATE(OutData%u_BD_Distrload) - ALLOCATE(OutData%u_BD_Distrload(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_BD_Distrload.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%u_BD_Distrload,1), UBOUND(OutData%u_BD_Distrload,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%u_BD_Distrload(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_BD_Distrload - 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 - 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%u_Orca_PtfmMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_Orca_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) - 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%u_ExtPtfm_PtfmMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_ExtPtfm_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 FAST_UnPackModuleMapType - - SUBROUTINE FAST_CopyExternInputType( SrcExternInputTypeData, DstExternInputTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FAST_ExternInputType), INTENT(IN) :: SrcExternInputTypeData - TYPE(FAST_ExternInputType), INTENT(INOUT) :: DstExternInputTypeData - 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 = 'FAST_CopyExternInputType' -! + ErrMsg = '' + if (allocated(BeamDyn_DataData%x)) then + LB(1:2) = lbound(BeamDyn_DataData%x) + UB(1:2) = ubound(BeamDyn_DataData%x) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_DestroyContState(BeamDyn_DataData%x(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + deallocate(BeamDyn_DataData%x) + end if + if (allocated(BeamDyn_DataData%xd)) then + LB(1:2) = lbound(BeamDyn_DataData%xd) + UB(1:2) = ubound(BeamDyn_DataData%xd) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_DestroyDiscState(BeamDyn_DataData%xd(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + deallocate(BeamDyn_DataData%xd) + end if + if (allocated(BeamDyn_DataData%z)) then + LB(1:2) = lbound(BeamDyn_DataData%z) + UB(1:2) = ubound(BeamDyn_DataData%z) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_DestroyConstrState(BeamDyn_DataData%z(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + deallocate(BeamDyn_DataData%z) + end if + if (allocated(BeamDyn_DataData%OtherSt)) then + LB(1:2) = lbound(BeamDyn_DataData%OtherSt) + UB(1:2) = ubound(BeamDyn_DataData%OtherSt) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_DestroyOtherState(BeamDyn_DataData%OtherSt(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + deallocate(BeamDyn_DataData%OtherSt) + end if + if (allocated(BeamDyn_DataData%p)) then + LB(1:1) = lbound(BeamDyn_DataData%p) + UB(1:1) = ubound(BeamDyn_DataData%p) + do i1 = LB(1), UB(1) + call BD_DestroyParam(BeamDyn_DataData%p(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(BeamDyn_DataData%p) + end if + if (allocated(BeamDyn_DataData%u)) then + LB(1:1) = lbound(BeamDyn_DataData%u) + UB(1:1) = ubound(BeamDyn_DataData%u) + do i1 = LB(1), UB(1) + call BD_DestroyInput(BeamDyn_DataData%u(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(BeamDyn_DataData%u) + end if + if (allocated(BeamDyn_DataData%y)) then + LB(1:1) = lbound(BeamDyn_DataData%y) + UB(1:1) = ubound(BeamDyn_DataData%y) + do i1 = LB(1), UB(1) + call BD_DestroyOutput(BeamDyn_DataData%y(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(BeamDyn_DataData%y) + end if + if (allocated(BeamDyn_DataData%m)) then + LB(1:1) = lbound(BeamDyn_DataData%m) + UB(1:1) = ubound(BeamDyn_DataData%m) + do i1 = LB(1), UB(1) + call BD_DestroyMisc(BeamDyn_DataData%m(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(BeamDyn_DataData%m) + end if + if (allocated(BeamDyn_DataData%Output)) then + LB(1:2) = lbound(BeamDyn_DataData%Output) + UB(1:2) = ubound(BeamDyn_DataData%Output) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_DestroyOutput(BeamDyn_DataData%Output(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + deallocate(BeamDyn_DataData%Output) + end if + if (allocated(BeamDyn_DataData%y_interp)) then + LB(1:1) = lbound(BeamDyn_DataData%y_interp) + UB(1:1) = ubound(BeamDyn_DataData%y_interp) + do i1 = LB(1), UB(1) + call BD_DestroyOutput(BeamDyn_DataData%y_interp(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(BeamDyn_DataData%y_interp) + end if + if (allocated(BeamDyn_DataData%Input)) then + LB(1:2) = lbound(BeamDyn_DataData%Input) + UB(1:2) = ubound(BeamDyn_DataData%Input) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_DestroyInput(BeamDyn_DataData%Input(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + deallocate(BeamDyn_DataData%Input) + end if + if (allocated(BeamDyn_DataData%Input_Saved)) then + LB(1:2) = lbound(BeamDyn_DataData%Input_Saved) + UB(1:2) = ubound(BeamDyn_DataData%Input_Saved) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_DestroyInput(BeamDyn_DataData%Input_Saved(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + deallocate(BeamDyn_DataData%Input_Saved) + end if + if (allocated(BeamDyn_DataData%InputTimes)) then + deallocate(BeamDyn_DataData%InputTimes) + end if + if (allocated(BeamDyn_DataData%InputTimes_Saved)) then + deallocate(BeamDyn_DataData%InputTimes_Saved) + end if +end subroutine + +subroutine FAST_PackBeamDyn_Data(RF, Indata) + type(RegFile), intent(inout) :: RF + type(BeamDyn_Data), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackBeamDyn_Data' + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%x)) + if (allocated(InData%x)) then + call RegPackBounds(RF, 2, lbound(InData%x), ubound(InData%x)) + LB(1:2) = lbound(InData%x) + UB(1:2) = ubound(InData%x) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_PackContState(RF, InData%x(i1,i2)) + end do + end do + end if + call RegPack(RF, allocated(InData%xd)) + if (allocated(InData%xd)) then + call RegPackBounds(RF, 2, lbound(InData%xd), ubound(InData%xd)) + LB(1:2) = lbound(InData%xd) + UB(1:2) = ubound(InData%xd) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_PackDiscState(RF, InData%xd(i1,i2)) + end do + end do + end if + call RegPack(RF, allocated(InData%z)) + if (allocated(InData%z)) then + call RegPackBounds(RF, 2, lbound(InData%z), ubound(InData%z)) + LB(1:2) = lbound(InData%z) + UB(1:2) = ubound(InData%z) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_PackConstrState(RF, InData%z(i1,i2)) + end do + end do + end if + call RegPack(RF, allocated(InData%OtherSt)) + if (allocated(InData%OtherSt)) then + call RegPackBounds(RF, 2, lbound(InData%OtherSt), ubound(InData%OtherSt)) + LB(1:2) = lbound(InData%OtherSt) + UB(1:2) = ubound(InData%OtherSt) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_PackOtherState(RF, InData%OtherSt(i1,i2)) + end do + end do + end if + call RegPack(RF, allocated(InData%p)) + if (allocated(InData%p)) then + call RegPackBounds(RF, 1, lbound(InData%p), ubound(InData%p)) + LB(1:1) = lbound(InData%p) + UB(1:1) = ubound(InData%p) + do i1 = LB(1), UB(1) + call BD_PackParam(RF, InData%p(i1)) + end do + end if + call RegPack(RF, allocated(InData%u)) + if (allocated(InData%u)) then + call RegPackBounds(RF, 1, lbound(InData%u), ubound(InData%u)) + LB(1:1) = lbound(InData%u) + UB(1:1) = ubound(InData%u) + do i1 = LB(1), UB(1) + call BD_PackInput(RF, InData%u(i1)) + end do + end if + call RegPack(RF, allocated(InData%y)) + if (allocated(InData%y)) then + call RegPackBounds(RF, 1, lbound(InData%y), ubound(InData%y)) + LB(1:1) = lbound(InData%y) + UB(1:1) = ubound(InData%y) + do i1 = LB(1), UB(1) + call BD_PackOutput(RF, InData%y(i1)) + end do + end if + call RegPack(RF, allocated(InData%m)) + if (allocated(InData%m)) then + call RegPackBounds(RF, 1, lbound(InData%m), ubound(InData%m)) + LB(1:1) = lbound(InData%m) + UB(1:1) = ubound(InData%m) + do i1 = LB(1), UB(1) + call BD_PackMisc(RF, InData%m(i1)) + end do + end if + call RegPack(RF, allocated(InData%Output)) + if (allocated(InData%Output)) then + call RegPackBounds(RF, 2, lbound(InData%Output), ubound(InData%Output)) + LB(1:2) = lbound(InData%Output) + UB(1:2) = ubound(InData%Output) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_PackOutput(RF, InData%Output(i1,i2)) + end do + end do + end if + call RegPack(RF, allocated(InData%y_interp)) + if (allocated(InData%y_interp)) then + call RegPackBounds(RF, 1, lbound(InData%y_interp), ubound(InData%y_interp)) + LB(1:1) = lbound(InData%y_interp) + UB(1:1) = ubound(InData%y_interp) + do i1 = LB(1), UB(1) + call BD_PackOutput(RF, InData%y_interp(i1)) + end do + end if + call RegPack(RF, allocated(InData%Input)) + if (allocated(InData%Input)) then + call RegPackBounds(RF, 2, lbound(InData%Input), ubound(InData%Input)) + LB(1:2) = lbound(InData%Input) + UB(1:2) = ubound(InData%Input) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_PackInput(RF, InData%Input(i1,i2)) + end do + end do + end if + call RegPack(RF, allocated(InData%Input_Saved)) + if (allocated(InData%Input_Saved)) then + call RegPackBounds(RF, 2, lbound(InData%Input_Saved), ubound(InData%Input_Saved)) + LB(1:2) = lbound(InData%Input_Saved) + UB(1:2) = ubound(InData%Input_Saved) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_PackInput(RF, InData%Input_Saved(i1,i2)) + end do + end do + end if + call RegPackAlloc(RF, InData%InputTimes) + call RegPackAlloc(RF, InData%InputTimes_Saved) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FAST_UnPackBeamDyn_Data(RF, OutData) + type(RegFile), intent(inout) :: RF + type(BeamDyn_Data), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackBeamDyn_Data' + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + if (allocated(OutData%x)) deallocate(OutData%x) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%x(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_UnpackContState(RF, OutData%x(i1,i2)) ! x + end do + end do + end if + if (allocated(OutData%xd)) deallocate(OutData%xd) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%xd(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_UnpackDiscState(RF, OutData%xd(i1,i2)) ! xd + end do + end do + end if + if (allocated(OutData%z)) deallocate(OutData%z) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%z(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_UnpackConstrState(RF, OutData%z(i1,i2)) ! z + end do + end do + end if + if (allocated(OutData%OtherSt)) deallocate(OutData%OtherSt) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%OtherSt(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_UnpackOtherState(RF, OutData%OtherSt(i1,i2)) ! OtherSt + end do + end do + end if + if (allocated(OutData%p)) deallocate(OutData%p) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%p(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%p.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call BD_UnpackParam(RF, OutData%p(i1)) ! p + end do + end if + if (allocated(OutData%u)) deallocate(OutData%u) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%u(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call BD_UnpackInput(RF, OutData%u(i1)) ! u + end do + end if + if (allocated(OutData%y)) deallocate(OutData%y) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%y(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%y.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call BD_UnpackOutput(RF, OutData%y(i1)) ! y + end do + end if + if (allocated(OutData%m)) deallocate(OutData%m) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%m(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%m.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call BD_UnpackMisc(RF, OutData%m(i1)) ! m + end do + end if + if (allocated(OutData%Output)) deallocate(OutData%Output) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%Output(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_UnpackOutput(RF, OutData%Output(i1,i2)) ! Output + end do + end do + end if + if (allocated(OutData%y_interp)) deallocate(OutData%y_interp) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%y_interp(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%y_interp.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call BD_UnpackOutput(RF, OutData%y_interp(i1)) ! y_interp + end do + end if + if (allocated(OutData%Input)) deallocate(OutData%Input) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%Input(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_UnpackInput(RF, OutData%Input(i1,i2)) ! Input + end do + end do + end if + if (allocated(OutData%Input_Saved)) deallocate(OutData%Input_Saved) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%Input_Saved(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input_Saved.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_UnpackInput(RF, OutData%Input_Saved(i1,i2)) ! Input_Saved + end do + end do + end if + call RegUnpackAlloc(RF, OutData%InputTimes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%InputTimes_Saved); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FAST_CopyElastoDyn_Data(SrcElastoDyn_DataData, DstElastoDyn_DataData, CtrlCode, ErrStat, ErrMsg) + type(ElastoDyn_Data), intent(inout) :: SrcElastoDyn_DataData + type(ElastoDyn_Data), intent(inout) :: DstElastoDyn_DataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_CopyElastoDyn_Data' ErrStat = ErrID_None - ErrMsg = "" - DstExternInputTypeData%GenTrq = SrcExternInputTypeData%GenTrq - DstExternInputTypeData%ElecPwr = SrcExternInputTypeData%ElecPwr - DstExternInputTypeData%YawPosCom = SrcExternInputTypeData%YawPosCom - DstExternInputTypeData%YawRateCom = SrcExternInputTypeData%YawRateCom - DstExternInputTypeData%BlPitchCom = SrcExternInputTypeData%BlPitchCom - DstExternInputTypeData%BlAirfoilCom = SrcExternInputTypeData%BlAirfoilCom - DstExternInputTypeData%HSSBrFrac = SrcExternInputTypeData%HSSBrFrac - DstExternInputTypeData%LidarFocus = SrcExternInputTypeData%LidarFocus - DstExternInputTypeData%CableDeltaL = SrcExternInputTypeData%CableDeltaL - DstExternInputTypeData%CableDeltaLdot = SrcExternInputTypeData%CableDeltaLdot - END SUBROUTINE FAST_CopyExternInputType - - SUBROUTINE FAST_DestroyExternInputType( ExternInputTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(FAST_ExternInputType), INTENT(INOUT) :: ExternInputTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyExternInputType' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE FAST_DestroyExternInputType - - SUBROUTINE FAST_PackExternInputType( 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(FAST_ExternInputType), 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 = 'FAST_PackExternInputType' - ! 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 ! GenTrq - Re_BufSz = Re_BufSz + 1 ! ElecPwr - Re_BufSz = Re_BufSz + 1 ! YawPosCom - Re_BufSz = Re_BufSz + 1 ! YawRateCom - Re_BufSz = Re_BufSz + SIZE(InData%BlPitchCom) ! BlPitchCom - Re_BufSz = Re_BufSz + SIZE(InData%BlAirfoilCom) ! BlAirfoilCom - Re_BufSz = Re_BufSz + 1 ! HSSBrFrac - Re_BufSz = Re_BufSz + SIZE(InData%LidarFocus) ! LidarFocus - Re_BufSz = Re_BufSz + SIZE(InData%CableDeltaL) ! CableDeltaL - Re_BufSz = Re_BufSz + SIZE(InData%CableDeltaLdot) ! CableDeltaLdot - 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%GenTrq - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%ElecPwr - 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 - 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%BlAirfoilCom,1), UBOUND(InData%BlAirfoilCom,1) - ReKiBuf(Re_Xferred) = InData%BlAirfoilCom(i1) - Re_Xferred = Re_Xferred + 1 - END DO - ReKiBuf(Re_Xferred) = InData%HSSBrFrac - Re_Xferred = Re_Xferred + 1 - DO i1 = LBOUND(InData%LidarFocus,1), UBOUND(InData%LidarFocus,1) - ReKiBuf(Re_Xferred) = InData%LidarFocus(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%CableDeltaL,1), UBOUND(InData%CableDeltaL,1) - ReKiBuf(Re_Xferred) = InData%CableDeltaL(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%CableDeltaLdot,1), UBOUND(InData%CableDeltaLdot,1) - ReKiBuf(Re_Xferred) = InData%CableDeltaLdot(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END SUBROUTINE FAST_PackExternInputType - - SUBROUTINE FAST_UnPackExternInputType( 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(FAST_ExternInputType), 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 = 'FAST_UnPackExternInputType' - ! 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%GenTrq = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%ElecPwr = 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 - 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%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%HSSBrFrac = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%LidarFocus,1) - i1_u = UBOUND(OutData%LidarFocus,1) - DO i1 = LBOUND(OutData%LidarFocus,1), UBOUND(OutData%LidarFocus,1) - OutData%LidarFocus(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%CableDeltaL,1) - i1_u = UBOUND(OutData%CableDeltaL,1) - DO i1 = LBOUND(OutData%CableDeltaL,1), UBOUND(OutData%CableDeltaL,1) - OutData%CableDeltaL(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%CableDeltaLdot,1) - i1_u = UBOUND(OutData%CableDeltaLdot,1) - DO i1 = LBOUND(OutData%CableDeltaLdot,1), UBOUND(OutData%CableDeltaLdot,1) - OutData%CableDeltaLdot(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END SUBROUTINE FAST_UnPackExternInputType - - SUBROUTINE FAST_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FAST_MiscVarType), INTENT(IN) :: SrcMiscData - TYPE(FAST_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 = 'FAST_CopyMisc' -! + ErrMsg = '' + LB(1:1) = lbound(SrcElastoDyn_DataData%x) + UB(1:1) = ubound(SrcElastoDyn_DataData%x) + do i1 = LB(1), UB(1) + call ED_CopyContState(SrcElastoDyn_DataData%x(i1), DstElastoDyn_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + LB(1:1) = lbound(SrcElastoDyn_DataData%xd) + UB(1:1) = ubound(SrcElastoDyn_DataData%xd) + do i1 = LB(1), UB(1) + call ED_CopyDiscState(SrcElastoDyn_DataData%xd(i1), DstElastoDyn_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + LB(1:1) = lbound(SrcElastoDyn_DataData%z) + UB(1:1) = ubound(SrcElastoDyn_DataData%z) + do i1 = LB(1), UB(1) + call ED_CopyConstrState(SrcElastoDyn_DataData%z(i1), DstElastoDyn_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + LB(1:1) = lbound(SrcElastoDyn_DataData%OtherSt) + UB(1:1) = ubound(SrcElastoDyn_DataData%OtherSt) + do i1 = LB(1), UB(1) + call ED_CopyOtherState(SrcElastoDyn_DataData%OtherSt(i1), DstElastoDyn_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + call ED_CopyParam(SrcElastoDyn_DataData%p, DstElastoDyn_DataData%p, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call ED_CopyInput(SrcElastoDyn_DataData%u, DstElastoDyn_DataData%u, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call ED_CopyOutput(SrcElastoDyn_DataData%y, DstElastoDyn_DataData%y, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call ED_CopyMisc(SrcElastoDyn_DataData%m, DstElastoDyn_DataData%m, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcElastoDyn_DataData%Output)) then + LB(1:1) = lbound(SrcElastoDyn_DataData%Output) + UB(1:1) = ubound(SrcElastoDyn_DataData%Output) + if (.not. allocated(DstElastoDyn_DataData%Output)) then + allocate(DstElastoDyn_DataData%Output(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstElastoDyn_DataData%Output.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call ED_CopyOutput(SrcElastoDyn_DataData%Output(i1), DstElastoDyn_DataData%Output(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcElastoDyn_DataData%Output_bak)) then + LB(1:1) = lbound(SrcElastoDyn_DataData%Output_bak) + UB(1:1) = ubound(SrcElastoDyn_DataData%Output_bak) + if (.not. allocated(DstElastoDyn_DataData%Output_bak)) then + allocate(DstElastoDyn_DataData%Output_bak(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstElastoDyn_DataData%Output_bak.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call ED_CopyOutput(SrcElastoDyn_DataData%Output_bak(i1), DstElastoDyn_DataData%Output_bak(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call ED_CopyOutput(SrcElastoDyn_DataData%y_interp, DstElastoDyn_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcElastoDyn_DataData%Input)) then + LB(1:1) = lbound(SrcElastoDyn_DataData%Input) + UB(1:1) = ubound(SrcElastoDyn_DataData%Input) + if (.not. allocated(DstElastoDyn_DataData%Input)) then + allocate(DstElastoDyn_DataData%Input(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstElastoDyn_DataData%Input.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call ED_CopyInput(SrcElastoDyn_DataData%Input(i1), DstElastoDyn_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcElastoDyn_DataData%Input_Saved)) then + LB(1:1) = lbound(SrcElastoDyn_DataData%Input_Saved) + UB(1:1) = ubound(SrcElastoDyn_DataData%Input_Saved) + if (.not. allocated(DstElastoDyn_DataData%Input_Saved)) then + allocate(DstElastoDyn_DataData%Input_Saved(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstElastoDyn_DataData%Input_Saved.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call ED_CopyInput(SrcElastoDyn_DataData%Input_Saved(i1), DstElastoDyn_DataData%Input_Saved(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcElastoDyn_DataData%InputTimes)) then + LB(1:1) = lbound(SrcElastoDyn_DataData%InputTimes) + UB(1:1) = ubound(SrcElastoDyn_DataData%InputTimes) + if (.not. allocated(DstElastoDyn_DataData%InputTimes)) then + allocate(DstElastoDyn_DataData%InputTimes(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstElastoDyn_DataData%InputTimes.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstElastoDyn_DataData%InputTimes = SrcElastoDyn_DataData%InputTimes + end if + if (allocated(SrcElastoDyn_DataData%InputTimes_Saved)) then + LB(1:1) = lbound(SrcElastoDyn_DataData%InputTimes_Saved) + UB(1:1) = ubound(SrcElastoDyn_DataData%InputTimes_Saved) + if (.not. allocated(DstElastoDyn_DataData%InputTimes_Saved)) then + allocate(DstElastoDyn_DataData%InputTimes_Saved(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstElastoDyn_DataData%InputTimes_Saved.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstElastoDyn_DataData%InputTimes_Saved = SrcElastoDyn_DataData%InputTimes_Saved + end if +end subroutine + +subroutine FAST_DestroyElastoDyn_Data(ElastoDyn_DataData, ErrStat, ErrMsg) + type(ElastoDyn_Data), intent(inout) :: ElastoDyn_DataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_DestroyElastoDyn_Data' ErrStat = ErrID_None - ErrMsg = "" - DstMiscData%TiLstPrn = SrcMiscData%TiLstPrn - DstMiscData%t_global = SrcMiscData%t_global - DstMiscData%NextJacCalcTime = SrcMiscData%NextJacCalcTime - DstMiscData%PrevClockTime = SrcMiscData%PrevClockTime - DstMiscData%UsrTime1 = SrcMiscData%UsrTime1 - DstMiscData%UsrTime2 = SrcMiscData%UsrTime2 - DstMiscData%StrtTime = SrcMiscData%StrtTime - DstMiscData%SimStrtTime = SrcMiscData%SimStrtTime - DstMiscData%calcJacobian = SrcMiscData%calcJacobian - CALL FAST_Copyexterninputtype( SrcMiscData%ExternInput, DstMiscData%ExternInput, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL FAST_Copymisclintype( SrcMiscData%Lin, DstMiscData%Lin, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE FAST_CopyMisc - - SUBROUTINE FAST_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(FAST_MiscVarType), INTENT(INOUT) :: MiscData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyMisc' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL FAST_Destroyexterninputtype( MiscData%ExternInput, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FAST_Destroymisclintype( MiscData%Lin, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE FAST_DestroyMisc - - SUBROUTINE FAST_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(FAST_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 = 'FAST_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 ! TiLstPrn - Db_BufSz = Db_BufSz + 1 ! t_global - Db_BufSz = Db_BufSz + 1 ! NextJacCalcTime - Re_BufSz = Re_BufSz + 1 ! PrevClockTime - Re_BufSz = Re_BufSz + 1 ! UsrTime1 - Re_BufSz = Re_BufSz + 1 ! UsrTime2 - Int_BufSz = Int_BufSz + SIZE(InData%StrtTime) ! StrtTime - Int_BufSz = Int_BufSz + SIZE(InData%SimStrtTime) ! SimStrtTime - Int_BufSz = Int_BufSz + 1 ! calcJacobian - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! ExternInput: size of buffers for each call to pack subtype - CALL FAST_Packexterninputtype( Re_Buf, Db_Buf, Int_Buf, InData%ExternInput, ErrStat2, ErrMsg2, .TRUE. ) ! ExternInput - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! ExternInput - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! ExternInput - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! ExternInput - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! Lin: size of buffers for each call to pack subtype - CALL FAST_Packmisclintype( Re_Buf, Db_Buf, Int_Buf, InData%Lin, ErrStat2, ErrMsg2, .TRUE. ) ! Lin - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Lin - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Lin - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Lin - 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 - - DbKiBuf(Db_Xferred) = InData%TiLstPrn - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%t_global - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%NextJacCalcTime - Db_Xferred = Db_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PrevClockTime - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%UsrTime1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%UsrTime2 - Re_Xferred = Re_Xferred + 1 - DO i1 = LBOUND(InData%StrtTime,1), UBOUND(InData%StrtTime,1) - IntKiBuf(Int_Xferred) = InData%StrtTime(i1) - Int_Xferred = Int_Xferred + 1 - END DO - DO i1 = LBOUND(InData%SimStrtTime,1), UBOUND(InData%SimStrtTime,1) - IntKiBuf(Int_Xferred) = InData%SimStrtTime(i1) - Int_Xferred = Int_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = TRANSFER(InData%calcJacobian, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - CALL FAST_Packexterninputtype( Re_Buf, Db_Buf, Int_Buf, InData%ExternInput, ErrStat2, ErrMsg2, OnlySize ) ! ExternInput - 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 FAST_Packmisclintype( Re_Buf, Db_Buf, Int_Buf, InData%Lin, ErrStat2, ErrMsg2, OnlySize ) ! Lin - 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 FAST_PackMisc - - SUBROUTINE FAST_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(FAST_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 = 'FAST_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%TiLstPrn = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%t_global = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%NextJacCalcTime = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%PrevClockTime = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%UsrTime1 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%UsrTime2 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%StrtTime,1) - i1_u = UBOUND(OutData%StrtTime,1) - DO i1 = LBOUND(OutData%StrtTime,1), UBOUND(OutData%StrtTime,1) - OutData%StrtTime(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - i1_l = LBOUND(OutData%SimStrtTime,1) - i1_u = UBOUND(OutData%SimStrtTime,1) - DO i1 = LBOUND(OutData%SimStrtTime,1), UBOUND(OutData%SimStrtTime,1) - OutData%SimStrtTime(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - OutData%calcJacobian = TRANSFER(IntKiBuf(Int_Xferred), OutData%calcJacobian) - 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 FAST_Unpackexterninputtype( Re_Buf, Db_Buf, Int_Buf, OutData%ExternInput, ErrStat2, ErrMsg2 ) ! ExternInput - 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 FAST_Unpackmisclintype( Re_Buf, Db_Buf, Int_Buf, OutData%Lin, ErrStat2, ErrMsg2 ) ! Lin - 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 FAST_UnPackMisc - - SUBROUTINE FAST_CopyInitData( SrcInitDataData, DstInitDataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FAST_InitData), INTENT(INOUT) :: SrcInitDataData - TYPE(FAST_InitData), INTENT(INOUT) :: DstInitDataData - 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 = 'FAST_CopyInitData' -! + ErrMsg = '' + LB(1:1) = lbound(ElastoDyn_DataData%x) + UB(1:1) = ubound(ElastoDyn_DataData%x) + do i1 = LB(1), UB(1) + call ED_DestroyContState(ElastoDyn_DataData%x(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(ElastoDyn_DataData%xd) + UB(1:1) = ubound(ElastoDyn_DataData%xd) + do i1 = LB(1), UB(1) + call ED_DestroyDiscState(ElastoDyn_DataData%xd(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(ElastoDyn_DataData%z) + UB(1:1) = ubound(ElastoDyn_DataData%z) + do i1 = LB(1), UB(1) + call ED_DestroyConstrState(ElastoDyn_DataData%z(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(ElastoDyn_DataData%OtherSt) + UB(1:1) = ubound(ElastoDyn_DataData%OtherSt) + do i1 = LB(1), UB(1) + call ED_DestroyOtherState(ElastoDyn_DataData%OtherSt(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + call ED_DestroyParam(ElastoDyn_DataData%p, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call ED_DestroyInput(ElastoDyn_DataData%u, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call ED_DestroyOutput(ElastoDyn_DataData%y, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call ED_DestroyMisc(ElastoDyn_DataData%m, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(ElastoDyn_DataData%Output)) then + LB(1:1) = lbound(ElastoDyn_DataData%Output) + UB(1:1) = ubound(ElastoDyn_DataData%Output) + do i1 = LB(1), UB(1) + call ED_DestroyOutput(ElastoDyn_DataData%Output(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ElastoDyn_DataData%Output) + end if + if (allocated(ElastoDyn_DataData%Output_bak)) then + LB(1:1) = lbound(ElastoDyn_DataData%Output_bak) + UB(1:1) = ubound(ElastoDyn_DataData%Output_bak) + do i1 = LB(1), UB(1) + call ED_DestroyOutput(ElastoDyn_DataData%Output_bak(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ElastoDyn_DataData%Output_bak) + end if + call ED_DestroyOutput(ElastoDyn_DataData%y_interp, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(ElastoDyn_DataData%Input)) then + LB(1:1) = lbound(ElastoDyn_DataData%Input) + UB(1:1) = ubound(ElastoDyn_DataData%Input) + do i1 = LB(1), UB(1) + call ED_DestroyInput(ElastoDyn_DataData%Input(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ElastoDyn_DataData%Input) + end if + if (allocated(ElastoDyn_DataData%Input_Saved)) then + LB(1:1) = lbound(ElastoDyn_DataData%Input_Saved) + UB(1:1) = ubound(ElastoDyn_DataData%Input_Saved) + do i1 = LB(1), UB(1) + call ED_DestroyInput(ElastoDyn_DataData%Input_Saved(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ElastoDyn_DataData%Input_Saved) + end if + if (allocated(ElastoDyn_DataData%InputTimes)) then + deallocate(ElastoDyn_DataData%InputTimes) + end if + if (allocated(ElastoDyn_DataData%InputTimes_Saved)) then + deallocate(ElastoDyn_DataData%InputTimes_Saved) + end if +end subroutine + +subroutine FAST_PackElastoDyn_Data(RF, Indata) + type(RegFile), intent(inout) :: RF + type(ElastoDyn_Data), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackElastoDyn_Data' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + if (RF%ErrStat >= AbortErrLev) return + LB(1:1) = lbound(InData%x) + UB(1:1) = ubound(InData%x) + do i1 = LB(1), UB(1) + call ED_PackContState(RF, InData%x(i1)) + end do + LB(1:1) = lbound(InData%xd) + UB(1:1) = ubound(InData%xd) + do i1 = LB(1), UB(1) + call ED_PackDiscState(RF, InData%xd(i1)) + end do + LB(1:1) = lbound(InData%z) + UB(1:1) = ubound(InData%z) + do i1 = LB(1), UB(1) + call ED_PackConstrState(RF, InData%z(i1)) + end do + LB(1:1) = lbound(InData%OtherSt) + UB(1:1) = ubound(InData%OtherSt) + do i1 = LB(1), UB(1) + call ED_PackOtherState(RF, InData%OtherSt(i1)) + end do + call ED_PackParam(RF, InData%p) + call ED_PackInput(RF, InData%u) + call ED_PackOutput(RF, InData%y) + call ED_PackMisc(RF, InData%m) + call RegPack(RF, allocated(InData%Output)) + if (allocated(InData%Output)) then + call RegPackBounds(RF, 1, lbound(InData%Output), ubound(InData%Output)) + LB(1:1) = lbound(InData%Output) + UB(1:1) = ubound(InData%Output) + do i1 = LB(1), UB(1) + call ED_PackOutput(RF, InData%Output(i1)) + end do + end if + call RegPack(RF, allocated(InData%Output_bak)) + if (allocated(InData%Output_bak)) then + call RegPackBounds(RF, 1, lbound(InData%Output_bak), ubound(InData%Output_bak)) + LB(1:1) = lbound(InData%Output_bak) + UB(1:1) = ubound(InData%Output_bak) + do i1 = LB(1), UB(1) + call ED_PackOutput(RF, InData%Output_bak(i1)) + end do + end if + call ED_PackOutput(RF, InData%y_interp) + call RegPack(RF, allocated(InData%Input)) + if (allocated(InData%Input)) then + call RegPackBounds(RF, 1, lbound(InData%Input), ubound(InData%Input)) + LB(1:1) = lbound(InData%Input) + UB(1:1) = ubound(InData%Input) + do i1 = LB(1), UB(1) + call ED_PackInput(RF, InData%Input(i1)) + end do + end if + call RegPack(RF, allocated(InData%Input_Saved)) + if (allocated(InData%Input_Saved)) then + call RegPackBounds(RF, 1, lbound(InData%Input_Saved), ubound(InData%Input_Saved)) + LB(1:1) = lbound(InData%Input_Saved) + UB(1:1) = ubound(InData%Input_Saved) + do i1 = LB(1), UB(1) + call ED_PackInput(RF, InData%Input_Saved(i1)) + end do + end if + call RegPackAlloc(RF, InData%InputTimes) + call RegPackAlloc(RF, InData%InputTimes_Saved) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FAST_UnPackElastoDyn_Data(RF, OutData) + type(RegFile), intent(inout) :: RF + type(ElastoDyn_Data), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackElastoDyn_Data' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + LB(1:1) = lbound(OutData%x) + UB(1:1) = ubound(OutData%x) + do i1 = LB(1), UB(1) + call ED_UnpackContState(RF, OutData%x(i1)) ! x + end do + LB(1:1) = lbound(OutData%xd) + UB(1:1) = ubound(OutData%xd) + do i1 = LB(1), UB(1) + call ED_UnpackDiscState(RF, OutData%xd(i1)) ! xd + end do + LB(1:1) = lbound(OutData%z) + UB(1:1) = ubound(OutData%z) + do i1 = LB(1), UB(1) + call ED_UnpackConstrState(RF, OutData%z(i1)) ! z + end do + LB(1:1) = lbound(OutData%OtherSt) + UB(1:1) = ubound(OutData%OtherSt) + do i1 = LB(1), UB(1) + call ED_UnpackOtherState(RF, OutData%OtherSt(i1)) ! OtherSt + end do + call ED_UnpackParam(RF, OutData%p) ! p + call ED_UnpackInput(RF, OutData%u) ! u + call ED_UnpackOutput(RF, OutData%y) ! y + call ED_UnpackMisc(RF, OutData%m) ! m + if (allocated(OutData%Output)) deallocate(OutData%Output) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%Output(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call ED_UnpackOutput(RF, OutData%Output(i1)) ! Output + end do + end if + if (allocated(OutData%Output_bak)) deallocate(OutData%Output_bak) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%Output_bak(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output_bak.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call ED_UnpackOutput(RF, OutData%Output_bak(i1)) ! Output_bak + end do + end if + call ED_UnpackOutput(RF, OutData%y_interp) ! y_interp + if (allocated(OutData%Input)) deallocate(OutData%Input) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%Input(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call ED_UnpackInput(RF, OutData%Input(i1)) ! Input + end do + end if + if (allocated(OutData%Input_Saved)) deallocate(OutData%Input_Saved) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%Input_Saved(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input_Saved.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call ED_UnpackInput(RF, OutData%Input_Saved(i1)) ! Input_Saved + end do + end if + call RegUnpackAlloc(RF, OutData%InputTimes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%InputTimes_Saved); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FAST_CopySED_Data(SrcSED_DataData, DstSED_DataData, CtrlCode, ErrStat, ErrMsg) + type(SED_Data), intent(inout) :: SrcSED_DataData + type(SED_Data), intent(inout) :: DstSED_DataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_CopySED_Data' ErrStat = ErrID_None - ErrMsg = "" - CALL ED_CopyInitInput( SrcInitDataData%InData_ED, DstInitDataData%InData_ED, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL ED_CopyInitOutput( SrcInitDataData%OutData_ED, DstInitDataData%OutData_ED, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL BD_CopyInitInput( SrcInitDataData%InData_BD, DstInitDataData%InData_BD, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcInitDataData%OutData_BD)) THEN - i1_l = LBOUND(SrcInitDataData%OutData_BD,1) - i1_u = UBOUND(SrcInitDataData%OutData_BD,1) - IF (.NOT. ALLOCATED(DstInitDataData%OutData_BD)) THEN - ALLOCATE(DstInitDataData%OutData_BD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitDataData%OutData_BD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcInitDataData%OutData_BD,1), UBOUND(SrcInitDataData%OutData_BD,1) - CALL BD_CopyInitOutput( SrcInitDataData%OutData_BD(i1), DstInitDataData%OutData_BD(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL SrvD_CopyInitInput( SrcInitDataData%InData_SrvD, DstInitDataData%InData_SrvD, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SrvD_CopyInitOutput( SrcInitDataData%OutData_SrvD, DstInitDataData%OutData_SrvD, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD14_CopyInitInput( SrcInitDataData%InData_AD14, DstInitDataData%InData_AD14, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD14_CopyInitOutput( SrcInitDataData%OutData_AD14, DstInitDataData%OutData_AD14, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD_CopyInitInput( SrcInitDataData%InData_AD, DstInitDataData%InData_AD, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD_CopyInitOutput( SrcInitDataData%OutData_AD, DstInitDataData%OutData_AD, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL InflowWind_CopyInitInput( SrcInitDataData%InData_IfW, DstInitDataData%InData_IfW, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL InflowWind_CopyInitOutput( SrcInitDataData%OutData_IfW, DstInitDataData%OutData_IfW, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL OpFM_CopyInitInput( SrcInitDataData%InData_OpFM, DstInitDataData%InData_OpFM, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL OpFM_CopyInitOutput( SrcInitDataData%OutData_OpFM, DstInitDataData%OutData_OpFM, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL HydroDyn_CopyInitInput( SrcInitDataData%InData_HD, DstInitDataData%InData_HD, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL HydroDyn_CopyInitOutput( SrcInitDataData%OutData_HD, DstInitDataData%OutData_HD, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SD_CopyInitInput( SrcInitDataData%InData_SD, DstInitDataData%InData_SD, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SD_CopyInitOutput( SrcInitDataData%OutData_SD, DstInitDataData%OutData_SD, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL ExtPtfm_CopyInitInput( SrcInitDataData%InData_ExtPtfm, DstInitDataData%InData_ExtPtfm, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL ExtPtfm_CopyInitOutput( SrcInitDataData%OutData_ExtPtfm, DstInitDataData%OutData_ExtPtfm, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MAP_CopyInitInput( SrcInitDataData%InData_MAP, DstInitDataData%InData_MAP, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MAP_CopyInitOutput( SrcInitDataData%OutData_MAP, DstInitDataData%OutData_MAP, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL FEAM_CopyInitInput( SrcInitDataData%InData_FEAM, DstInitDataData%InData_FEAM, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL FEAM_CopyInitOutput( SrcInitDataData%OutData_FEAM, DstInitDataData%OutData_FEAM, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MD_CopyInitInput( SrcInitDataData%InData_MD, DstInitDataData%InData_MD, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MD_CopyInitOutput( SrcInitDataData%OutData_MD, DstInitDataData%OutData_MD, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL Orca_CopyInitInput( SrcInitDataData%InData_Orca, DstInitDataData%InData_Orca, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL Orca_CopyInitOutput( SrcInitDataData%OutData_Orca, DstInitDataData%OutData_Orca, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL IceFloe_CopyInitInput( SrcInitDataData%InData_IceF, DstInitDataData%InData_IceF, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL IceFloe_CopyInitOutput( SrcInitDataData%OutData_IceF, DstInitDataData%OutData_IceF, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL IceD_CopyInitInput( SrcInitDataData%InData_IceD, DstInitDataData%InData_IceD, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL IceD_CopyInitOutput( SrcInitDataData%OutData_IceD, DstInitDataData%OutData_IceD, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE FAST_CopyInitData - - SUBROUTINE FAST_DestroyInitData( InitDataData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(FAST_InitData), INTENT(INOUT) :: InitDataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyInitData' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL ED_DestroyInitInput( InitDataData%InData_ED, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL ED_DestroyInitOutput( InitDataData%OutData_ED, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL BD_DestroyInitInput( InitDataData%InData_BD, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(InitDataData%OutData_BD)) THEN -DO i1 = LBOUND(InitDataData%OutData_BD,1), UBOUND(InitDataData%OutData_BD,1) - CALL BD_DestroyInitOutput( InitDataData%OutData_BD(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(InitDataData%OutData_BD) -ENDIF - CALL SrvD_DestroyInitInput( InitDataData%InData_SrvD, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SrvD_DestroyInitOutput( InitDataData%OutData_SrvD, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD14_DestroyInitInput( InitDataData%InData_AD14, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD14_DestroyInitOutput( InitDataData%OutData_AD14, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD_DestroyInitInput( InitDataData%InData_AD, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD_DestroyInitOutput( InitDataData%OutData_AD, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL InflowWind_DestroyInitInput( InitDataData%InData_IfW, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL InflowWind_DestroyInitOutput( InitDataData%OutData_IfW, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL OpFM_DestroyInitInput( InitDataData%InData_OpFM, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL OpFM_DestroyInitOutput( InitDataData%OutData_OpFM, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL HydroDyn_DestroyInitInput( InitDataData%InData_HD, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL HydroDyn_DestroyInitOutput( InitDataData%OutData_HD, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SD_DestroyInitInput( InitDataData%InData_SD, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SD_DestroyInitOutput( InitDataData%OutData_SD, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL ExtPtfm_DestroyInitInput( InitDataData%InData_ExtPtfm, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL ExtPtfm_DestroyInitOutput( InitDataData%OutData_ExtPtfm, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MAP_DestroyInitInput( InitDataData%InData_MAP, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MAP_DestroyInitOutput( InitDataData%OutData_MAP, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FEAM_DestroyInitInput( InitDataData%InData_FEAM, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FEAM_DestroyInitOutput( InitDataData%OutData_FEAM, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MD_DestroyInitInput( InitDataData%InData_MD, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MD_DestroyInitOutput( InitDataData%OutData_MD, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL Orca_DestroyInitInput( InitDataData%InData_Orca, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL Orca_DestroyInitOutput( InitDataData%OutData_Orca, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL IceFloe_DestroyInitInput( InitDataData%InData_IceF, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL IceFloe_DestroyInitOutput( InitDataData%OutData_IceF, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL IceD_DestroyInitInput( InitDataData%InData_IceD, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL IceD_DestroyInitOutput( InitDataData%OutData_IceD, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE FAST_DestroyInitData - - SUBROUTINE FAST_PackInitData( 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(FAST_InitData), 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 = 'FAST_PackInitData' - ! 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 ! InData_ED: size of buffers for each call to pack subtype - CALL ED_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_ED, ErrStat2, ErrMsg2, .TRUE. ) ! InData_ED - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! InData_ED - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! InData_ED - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! InData_ED - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! OutData_ED: size of buffers for each call to pack subtype - CALL ED_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_ED, ErrStat2, ErrMsg2, .TRUE. ) ! OutData_ED - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OutData_ED - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OutData_ED - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OutData_ED - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! InData_BD: size of buffers for each call to pack subtype - CALL BD_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_BD, ErrStat2, ErrMsg2, .TRUE. ) ! InData_BD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! InData_BD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! InData_BD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! InData_BD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! OutData_BD allocated yes/no - IF ( ALLOCATED(InData%OutData_BD) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OutData_BD upper/lower bounds for each dimension - DO i1 = LBOUND(InData%OutData_BD,1), UBOUND(InData%OutData_BD,1) - Int_BufSz = Int_BufSz + 3 ! OutData_BD: size of buffers for each call to pack subtype - CALL BD_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_BD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OutData_BD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OutData_BD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OutData_BD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OutData_BD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! InData_SrvD: size of buffers for each call to pack subtype - CALL SrvD_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_SrvD, ErrStat2, ErrMsg2, .TRUE. ) ! InData_SrvD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! InData_SrvD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! InData_SrvD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! InData_SrvD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! OutData_SrvD: size of buffers for each call to pack subtype - CALL SrvD_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_SrvD, ErrStat2, ErrMsg2, .TRUE. ) ! OutData_SrvD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OutData_SrvD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OutData_SrvD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OutData_SrvD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! InData_AD14: size of buffers for each call to pack subtype - CALL AD14_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_AD14, ErrStat2, ErrMsg2, .TRUE. ) ! InData_AD14 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! InData_AD14 - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! InData_AD14 - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! InData_AD14 - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! OutData_AD14: size of buffers for each call to pack subtype - CALL AD14_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_AD14, ErrStat2, ErrMsg2, .TRUE. ) ! OutData_AD14 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OutData_AD14 - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OutData_AD14 - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OutData_AD14 - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! InData_AD: size of buffers for each call to pack subtype - CALL AD_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_AD, ErrStat2, ErrMsg2, .TRUE. ) ! InData_AD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! InData_AD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! InData_AD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! InData_AD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! OutData_AD: size of buffers for each call to pack subtype - CALL AD_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_AD, ErrStat2, ErrMsg2, .TRUE. ) ! OutData_AD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OutData_AD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OutData_AD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OutData_AD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! InData_IfW: size of buffers for each call to pack subtype - CALL InflowWind_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_IfW, ErrStat2, ErrMsg2, .TRUE. ) ! InData_IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! InData_IfW - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! InData_IfW - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! InData_IfW - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! OutData_IfW: size of buffers for each call to pack subtype - CALL InflowWind_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_IfW, ErrStat2, ErrMsg2, .TRUE. ) ! OutData_IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OutData_IfW - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OutData_IfW - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OutData_IfW - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! InData_OpFM: size of buffers for each call to pack subtype - CALL OpFM_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_OpFM, ErrStat2, ErrMsg2, .TRUE. ) ! InData_OpFM - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! InData_OpFM - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! InData_OpFM - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! InData_OpFM - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! OutData_OpFM: size of buffers for each call to pack subtype - CALL OpFM_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_OpFM, ErrStat2, ErrMsg2, .TRUE. ) ! OutData_OpFM - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OutData_OpFM - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OutData_OpFM - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OutData_OpFM - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! InData_HD: size of buffers for each call to pack subtype - CALL HydroDyn_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_HD, ErrStat2, ErrMsg2, .TRUE. ) ! InData_HD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! InData_HD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! InData_HD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! InData_HD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! OutData_HD: size of buffers for each call to pack subtype - CALL HydroDyn_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_HD, ErrStat2, ErrMsg2, .TRUE. ) ! OutData_HD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OutData_HD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OutData_HD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OutData_HD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! InData_SD: size of buffers for each call to pack subtype - CALL SD_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_SD, ErrStat2, ErrMsg2, .TRUE. ) ! InData_SD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! InData_SD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! InData_SD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! InData_SD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! OutData_SD: size of buffers for each call to pack subtype - CALL SD_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_SD, ErrStat2, ErrMsg2, .TRUE. ) ! OutData_SD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OutData_SD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OutData_SD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OutData_SD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! InData_ExtPtfm: size of buffers for each call to pack subtype - CALL ExtPtfm_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_ExtPtfm, ErrStat2, ErrMsg2, .TRUE. ) ! InData_ExtPtfm - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! InData_ExtPtfm - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! InData_ExtPtfm - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! InData_ExtPtfm - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! OutData_ExtPtfm: size of buffers for each call to pack subtype - CALL ExtPtfm_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_ExtPtfm, ErrStat2, ErrMsg2, .TRUE. ) ! OutData_ExtPtfm - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OutData_ExtPtfm - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OutData_ExtPtfm - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OutData_ExtPtfm - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! InData_MAP: size of buffers for each call to pack subtype - CALL MAP_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_MAP, ErrStat2, ErrMsg2, .TRUE. ) ! InData_MAP - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! InData_MAP - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! InData_MAP - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! InData_MAP - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! OutData_MAP: size of buffers for each call to pack subtype - CALL MAP_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_MAP, ErrStat2, ErrMsg2, .TRUE. ) ! OutData_MAP - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OutData_MAP - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OutData_MAP - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OutData_MAP - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! InData_FEAM: size of buffers for each call to pack subtype - CALL FEAM_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_FEAM, ErrStat2, ErrMsg2, .TRUE. ) ! InData_FEAM - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! InData_FEAM - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! InData_FEAM - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! InData_FEAM - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! OutData_FEAM: size of buffers for each call to pack subtype - CALL FEAM_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_FEAM, ErrStat2, ErrMsg2, .TRUE. ) ! OutData_FEAM - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OutData_FEAM - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OutData_FEAM - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OutData_FEAM - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! InData_MD: size of buffers for each call to pack subtype - CALL MD_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_MD, ErrStat2, ErrMsg2, .TRUE. ) ! InData_MD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! InData_MD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! InData_MD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! InData_MD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! OutData_MD: size of buffers for each call to pack subtype - CALL MD_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_MD, ErrStat2, ErrMsg2, .TRUE. ) ! OutData_MD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OutData_MD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OutData_MD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OutData_MD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! InData_Orca: size of buffers for each call to pack subtype - CALL Orca_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_Orca, ErrStat2, ErrMsg2, .TRUE. ) ! InData_Orca - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! InData_Orca - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! InData_Orca - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! InData_Orca - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! OutData_Orca: size of buffers for each call to pack subtype - CALL Orca_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_Orca, ErrStat2, ErrMsg2, .TRUE. ) ! OutData_Orca - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OutData_Orca - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OutData_Orca - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OutData_Orca - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! InData_IceF: size of buffers for each call to pack subtype - CALL IceFloe_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_IceF, ErrStat2, ErrMsg2, .TRUE. ) ! InData_IceF - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! InData_IceF - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! InData_IceF - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! InData_IceF - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! OutData_IceF: size of buffers for each call to pack subtype - CALL IceFloe_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_IceF, ErrStat2, ErrMsg2, .TRUE. ) ! OutData_IceF - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OutData_IceF - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OutData_IceF - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OutData_IceF - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! InData_IceD: size of buffers for each call to pack subtype - CALL IceD_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_IceD, ErrStat2, ErrMsg2, .TRUE. ) ! InData_IceD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! InData_IceD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! InData_IceD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! InData_IceD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! OutData_IceD: size of buffers for each call to pack subtype - CALL IceD_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_IceD, ErrStat2, ErrMsg2, .TRUE. ) ! OutData_IceD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OutData_IceD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OutData_IceD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OutData_IceD - 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 ED_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_ED, ErrStat2, ErrMsg2, OnlySize ) ! InData_ED - 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 ED_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_ED, ErrStat2, ErrMsg2, OnlySize ) ! OutData_ED - 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 BD_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_BD, ErrStat2, ErrMsg2, OnlySize ) ! InData_BD - 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%OutData_BD) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OutData_BD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutData_BD,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%OutData_BD,1), UBOUND(InData%OutData_BD,1) - CALL BD_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_BD(i1), ErrStat2, ErrMsg2, OnlySize ) ! OutData_BD - 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 - CALL SrvD_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_SrvD, ErrStat2, ErrMsg2, OnlySize ) ! InData_SrvD - 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 SrvD_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_SrvD, ErrStat2, ErrMsg2, OnlySize ) ! OutData_SrvD - 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 AD14_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_AD14, ErrStat2, ErrMsg2, OnlySize ) ! InData_AD14 - 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 AD14_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_AD14, ErrStat2, ErrMsg2, OnlySize ) ! OutData_AD14 - 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 AD_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_AD, ErrStat2, ErrMsg2, OnlySize ) ! InData_AD - 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 AD_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_AD, ErrStat2, ErrMsg2, OnlySize ) ! OutData_AD - 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 InflowWind_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_IfW, ErrStat2, ErrMsg2, OnlySize ) ! InData_IfW - 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 InflowWind_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_IfW, ErrStat2, ErrMsg2, OnlySize ) ! OutData_IfW - 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 OpFM_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_OpFM, ErrStat2, ErrMsg2, OnlySize ) ! InData_OpFM - 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 OpFM_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_OpFM, ErrStat2, ErrMsg2, OnlySize ) ! OutData_OpFM - 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 HydroDyn_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_HD, ErrStat2, ErrMsg2, OnlySize ) ! InData_HD - 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 HydroDyn_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_HD, ErrStat2, ErrMsg2, OnlySize ) ! OutData_HD - 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 SD_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_SD, ErrStat2, ErrMsg2, OnlySize ) ! InData_SD - 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 SD_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_SD, ErrStat2, ErrMsg2, OnlySize ) ! OutData_SD - 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 ExtPtfm_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_ExtPtfm, ErrStat2, ErrMsg2, OnlySize ) ! InData_ExtPtfm - 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 ExtPtfm_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_ExtPtfm, ErrStat2, ErrMsg2, OnlySize ) ! OutData_ExtPtfm - 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 MAP_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_MAP, ErrStat2, ErrMsg2, OnlySize ) ! InData_MAP - 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 MAP_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_MAP, ErrStat2, ErrMsg2, OnlySize ) ! OutData_MAP - 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 FEAM_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_FEAM, ErrStat2, ErrMsg2, OnlySize ) ! InData_FEAM - 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 FEAM_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_FEAM, ErrStat2, ErrMsg2, OnlySize ) ! OutData_FEAM - 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 MD_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_MD, ErrStat2, ErrMsg2, OnlySize ) ! InData_MD - 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 MD_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_MD, ErrStat2, ErrMsg2, OnlySize ) ! OutData_MD - 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 Orca_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_Orca, ErrStat2, ErrMsg2, OnlySize ) ! InData_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 - CALL Orca_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_Orca, ErrStat2, ErrMsg2, OnlySize ) ! OutData_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 - CALL IceFloe_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_IceF, ErrStat2, ErrMsg2, OnlySize ) ! InData_IceF - 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 IceFloe_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_IceF, ErrStat2, ErrMsg2, OnlySize ) ! OutData_IceF - 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 IceD_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_IceD, ErrStat2, ErrMsg2, OnlySize ) ! InData_IceD - 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 IceD_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_IceD, ErrStat2, ErrMsg2, OnlySize ) ! OutData_IceD - 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 FAST_PackInitData - - SUBROUTINE FAST_UnPackInitData( 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(FAST_InitData), 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 = 'FAST_UnPackInitData' - ! 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 ED_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%InData_ED, ErrStat2, ErrMsg2 ) ! InData_ED - 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 ED_UnpackInitOutput( Re_Buf, Db_Buf, Int_Buf, OutData%OutData_ED, ErrStat2, ErrMsg2 ) ! OutData_ED - 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 BD_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%InData_BD, ErrStat2, ErrMsg2 ) ! InData_BD - 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 ! OutData_BD not allocated - Int_Xferred = Int_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%OutData_BD)) DEALLOCATE(OutData%OutData_BD) - ALLOCATE(OutData%OutData_BD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutData_BD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%OutData_BD,1), UBOUND(OutData%OutData_BD,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 BD_UnpackInitOutput( Re_Buf, Db_Buf, Int_Buf, OutData%OutData_BD(i1), ErrStat2, ErrMsg2 ) ! OutData_BD - 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 - 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_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%InData_SrvD, ErrStat2, ErrMsg2 ) ! InData_SrvD - 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 SrvD_UnpackInitOutput( Re_Buf, Db_Buf, Int_Buf, OutData%OutData_SrvD, ErrStat2, ErrMsg2 ) ! OutData_SrvD - 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 AD14_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%InData_AD14, ErrStat2, ErrMsg2 ) ! InData_AD14 - 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 AD14_UnpackInitOutput( Re_Buf, Db_Buf, Int_Buf, OutData%OutData_AD14, ErrStat2, ErrMsg2 ) ! OutData_AD14 - 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 AD_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%InData_AD, ErrStat2, ErrMsg2 ) ! InData_AD - 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 AD_UnpackInitOutput( Re_Buf, Db_Buf, Int_Buf, OutData%OutData_AD, ErrStat2, ErrMsg2 ) ! OutData_AD - 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 InflowWind_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%InData_IfW, ErrStat2, ErrMsg2 ) ! InData_IfW - 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 InflowWind_UnpackInitOutput( Re_Buf, Db_Buf, Int_Buf, OutData%OutData_IfW, ErrStat2, ErrMsg2 ) ! OutData_IfW - 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 OpFM_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%InData_OpFM, ErrStat2, ErrMsg2 ) ! InData_OpFM - 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 OpFM_UnpackInitOutput( Re_Buf, Db_Buf, Int_Buf, OutData%OutData_OpFM, ErrStat2, ErrMsg2 ) ! OutData_OpFM - 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 HydroDyn_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%InData_HD, ErrStat2, ErrMsg2 ) ! InData_HD - 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 HydroDyn_UnpackInitOutput( Re_Buf, Db_Buf, Int_Buf, OutData%OutData_HD, ErrStat2, ErrMsg2 ) ! OutData_HD - 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 SD_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%InData_SD, ErrStat2, ErrMsg2 ) ! InData_SD - 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 SD_UnpackInitOutput( Re_Buf, Db_Buf, Int_Buf, OutData%OutData_SD, ErrStat2, ErrMsg2 ) ! OutData_SD - 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 ExtPtfm_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%InData_ExtPtfm, ErrStat2, ErrMsg2 ) ! InData_ExtPtfm - 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 ExtPtfm_UnpackInitOutput( Re_Buf, Db_Buf, Int_Buf, OutData%OutData_ExtPtfm, ErrStat2, ErrMsg2 ) ! OutData_ExtPtfm - 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 MAP_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%InData_MAP, ErrStat2, ErrMsg2 ) ! InData_MAP - 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 MAP_UnpackInitOutput( Re_Buf, Db_Buf, Int_Buf, OutData%OutData_MAP, ErrStat2, ErrMsg2 ) ! OutData_MAP - 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 FEAM_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%InData_FEAM, ErrStat2, ErrMsg2 ) ! InData_FEAM - 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 FEAM_UnpackInitOutput( Re_Buf, Db_Buf, Int_Buf, OutData%OutData_FEAM, ErrStat2, ErrMsg2 ) ! OutData_FEAM - 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 MD_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%InData_MD, ErrStat2, ErrMsg2 ) ! InData_MD - 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 MD_UnpackInitOutput( Re_Buf, Db_Buf, Int_Buf, OutData%OutData_MD, ErrStat2, ErrMsg2 ) ! OutData_MD - 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 Orca_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%InData_Orca, ErrStat2, ErrMsg2 ) ! InData_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) - 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 Orca_UnpackInitOutput( Re_Buf, Db_Buf, Int_Buf, OutData%OutData_Orca, ErrStat2, ErrMsg2 ) ! OutData_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) - 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 IceFloe_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%InData_IceF, ErrStat2, ErrMsg2 ) ! InData_IceF - 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 IceFloe_UnpackInitOutput( Re_Buf, Db_Buf, Int_Buf, OutData%OutData_IceF, ErrStat2, ErrMsg2 ) ! OutData_IceF - 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 IceD_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%InData_IceD, ErrStat2, ErrMsg2 ) ! InData_IceD - 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 IceD_UnpackInitOutput( Re_Buf, Db_Buf, Int_Buf, OutData%OutData_IceD, ErrStat2, ErrMsg2 ) ! OutData_IceD - 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 FAST_UnPackInitData - - SUBROUTINE FAST_CopyExternInitType( SrcExternInitTypeData, DstExternInitTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FAST_ExternInitType), INTENT(IN) :: SrcExternInitTypeData - TYPE(FAST_ExternInitType), INTENT(INOUT) :: DstExternInitTypeData - 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 = 'FAST_CopyExternInitType' -! + ErrMsg = '' + LB(1:1) = lbound(SrcSED_DataData%x) + UB(1:1) = ubound(SrcSED_DataData%x) + do i1 = LB(1), UB(1) + call SED_CopyContState(SrcSED_DataData%x(i1), DstSED_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + LB(1:1) = lbound(SrcSED_DataData%xd) + UB(1:1) = ubound(SrcSED_DataData%xd) + do i1 = LB(1), UB(1) + call SED_CopyDiscState(SrcSED_DataData%xd(i1), DstSED_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + LB(1:1) = lbound(SrcSED_DataData%z) + UB(1:1) = ubound(SrcSED_DataData%z) + do i1 = LB(1), UB(1) + call SED_CopyConstrState(SrcSED_DataData%z(i1), DstSED_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + LB(1:1) = lbound(SrcSED_DataData%OtherSt) + UB(1:1) = ubound(SrcSED_DataData%OtherSt) + do i1 = LB(1), UB(1) + call SED_CopyOtherState(SrcSED_DataData%OtherSt(i1), DstSED_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + call SED_CopyParam(SrcSED_DataData%p, DstSED_DataData%p, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SED_CopyInput(SrcSED_DataData%u, DstSED_DataData%u, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SED_CopyOutput(SrcSED_DataData%y, DstSED_DataData%y, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SED_CopyMisc(SrcSED_DataData%m, DstSED_DataData%m, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcSED_DataData%Output)) then + LB(1:1) = lbound(SrcSED_DataData%Output) + UB(1:1) = ubound(SrcSED_DataData%Output) + if (.not. allocated(DstSED_DataData%Output)) then + allocate(DstSED_DataData%Output(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstSED_DataData%Output.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call SED_CopyOutput(SrcSED_DataData%Output(i1), DstSED_DataData%Output(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call SED_CopyOutput(SrcSED_DataData%y_interp, DstSED_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcSED_DataData%Input)) then + LB(1:1) = lbound(SrcSED_DataData%Input) + UB(1:1) = ubound(SrcSED_DataData%Input) + if (.not. allocated(DstSED_DataData%Input)) then + allocate(DstSED_DataData%Input(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstSED_DataData%Input.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call SED_CopyInput(SrcSED_DataData%Input(i1), DstSED_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcSED_DataData%InputTimes)) then + LB(1:1) = lbound(SrcSED_DataData%InputTimes) + UB(1:1) = ubound(SrcSED_DataData%InputTimes) + if (.not. allocated(DstSED_DataData%InputTimes)) then + allocate(DstSED_DataData%InputTimes(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstSED_DataData%InputTimes.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstSED_DataData%InputTimes = SrcSED_DataData%InputTimes + end if +end subroutine + +subroutine FAST_DestroySED_Data(SED_DataData, ErrStat, ErrMsg) + type(SED_Data), intent(inout) :: SED_DataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_DestroySED_Data' ErrStat = ErrID_None - ErrMsg = "" - DstExternInitTypeData%Tmax = SrcExternInitTypeData%Tmax - DstExternInitTypeData%SensorType = SrcExternInitTypeData%SensorType - DstExternInitTypeData%LidRadialVel = SrcExternInitTypeData%LidRadialVel - DstExternInitTypeData%TurbIDforName = SrcExternInitTypeData%TurbIDforName - DstExternInitTypeData%TurbinePos = SrcExternInitTypeData%TurbinePos - DstExternInitTypeData%WaveFieldMod = SrcExternInitTypeData%WaveFieldMod - DstExternInitTypeData%NumSC2CtrlGlob = SrcExternInitTypeData%NumSC2CtrlGlob - DstExternInitTypeData%NumSC2Ctrl = SrcExternInitTypeData%NumSC2Ctrl - DstExternInitTypeData%NumCtrl2SC = SrcExternInitTypeData%NumCtrl2SC -IF (ALLOCATED(SrcExternInitTypeData%fromSCGlob)) THEN - i1_l = LBOUND(SrcExternInitTypeData%fromSCGlob,1) - i1_u = UBOUND(SrcExternInitTypeData%fromSCGlob,1) - IF (.NOT. ALLOCATED(DstExternInitTypeData%fromSCGlob)) THEN - ALLOCATE(DstExternInitTypeData%fromSCGlob(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstExternInitTypeData%fromSCGlob.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstExternInitTypeData%fromSCGlob = SrcExternInitTypeData%fromSCGlob -ENDIF -IF (ALLOCATED(SrcExternInitTypeData%fromSC)) THEN - i1_l = LBOUND(SrcExternInitTypeData%fromSC,1) - i1_u = UBOUND(SrcExternInitTypeData%fromSC,1) - IF (.NOT. ALLOCATED(DstExternInitTypeData%fromSC)) THEN - ALLOCATE(DstExternInitTypeData%fromSC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstExternInitTypeData%fromSC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstExternInitTypeData%fromSC = SrcExternInitTypeData%fromSC -ENDIF - DstExternInitTypeData%FarmIntegration = SrcExternInitTypeData%FarmIntegration - DstExternInitTypeData%windGrid_n = SrcExternInitTypeData%windGrid_n - DstExternInitTypeData%windGrid_delta = SrcExternInitTypeData%windGrid_delta - DstExternInitTypeData%windGrid_pZero = SrcExternInitTypeData%windGrid_pZero - DstExternInitTypeData%RootName = SrcExternInitTypeData%RootName - DstExternInitTypeData%NumActForcePtsBlade = SrcExternInitTypeData%NumActForcePtsBlade - DstExternInitTypeData%NumActForcePtsTower = SrcExternInitTypeData%NumActForcePtsTower - DstExternInitTypeData%NodeClusterType = SrcExternInitTypeData%NodeClusterType - END SUBROUTINE FAST_CopyExternInitType - - SUBROUTINE FAST_DestroyExternInitType( ExternInitTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(FAST_ExternInitType), INTENT(INOUT) :: ExternInitTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyExternInitType' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(ExternInitTypeData%fromSCGlob)) THEN - DEALLOCATE(ExternInitTypeData%fromSCGlob) -ENDIF -IF (ALLOCATED(ExternInitTypeData%fromSC)) THEN - DEALLOCATE(ExternInitTypeData%fromSC) -ENDIF - END SUBROUTINE FAST_DestroyExternInitType - - SUBROUTINE FAST_PackExternInitType( 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(FAST_ExternInitType), 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 = 'FAST_PackExternInitType' - ! 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 ! Tmax - Int_BufSz = Int_BufSz + 1 ! SensorType - Int_BufSz = Int_BufSz + 1 ! LidRadialVel - Int_BufSz = Int_BufSz + 1 ! TurbIDforName - Re_BufSz = Re_BufSz + SIZE(InData%TurbinePos) ! TurbinePos - Int_BufSz = Int_BufSz + 1 ! WaveFieldMod - Int_BufSz = Int_BufSz + 1 ! NumSC2CtrlGlob - Int_BufSz = Int_BufSz + 1 ! NumSC2Ctrl - Int_BufSz = Int_BufSz + 1 ! NumCtrl2SC - 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 - Int_BufSz = Int_BufSz + 1 ! FarmIntegration - Int_BufSz = Int_BufSz + SIZE(InData%windGrid_n) ! windGrid_n - Re_BufSz = Re_BufSz + SIZE(InData%windGrid_delta) ! windGrid_delta - Re_BufSz = Re_BufSz + SIZE(InData%windGrid_pZero) ! windGrid_pZero - Int_BufSz = Int_BufSz + 1*LEN(InData%RootName) ! RootName - Int_BufSz = Int_BufSz + 1 ! NumActForcePtsBlade - Int_BufSz = Int_BufSz + 1 ! NumActForcePtsTower - Int_BufSz = Int_BufSz + 1 ! NodeClusterType - 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%Tmax - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%SensorType - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%LidRadialVel, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%TurbIDforName - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%TurbinePos,1), UBOUND(InData%TurbinePos,1) - ReKiBuf(Re_Xferred) = InData%TurbinePos(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%WaveFieldMod - Int_Xferred = Int_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 - 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 - IntKiBuf(Int_Xferred) = TRANSFER(InData%FarmIntegration, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%windGrid_n,1), UBOUND(InData%windGrid_n,1) - IntKiBuf(Int_Xferred) = InData%windGrid_n(i1) - Int_Xferred = Int_Xferred + 1 - END DO - DO i1 = LBOUND(InData%windGrid_delta,1), UBOUND(InData%windGrid_delta,1) - ReKiBuf(Re_Xferred) = InData%windGrid_delta(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%windGrid_pZero,1), UBOUND(InData%windGrid_pZero,1) - ReKiBuf(Re_Xferred) = InData%windGrid_pZero(i1) - Re_Xferred = Re_Xferred + 1 - END DO - 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%NumActForcePtsBlade - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumActForcePtsTower - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NodeClusterType - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE FAST_PackExternInitType - - SUBROUTINE FAST_UnPackExternInitType( 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(FAST_ExternInitType), 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 = 'FAST_UnPackExternInitType' - ! 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%Tmax = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%SensorType = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%LidRadialVel = TRANSFER(IntKiBuf(Int_Xferred), OutData%LidRadialVel) - Int_Xferred = Int_Xferred + 1 - OutData%TurbIDforName = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%TurbinePos,1) - i1_u = UBOUND(OutData%TurbinePos,1) - DO i1 = LBOUND(OutData%TurbinePos,1), UBOUND(OutData%TurbinePos,1) - OutData%TurbinePos(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%WaveFieldMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_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 - 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 - OutData%FarmIntegration = TRANSFER(IntKiBuf(Int_Xferred), OutData%FarmIntegration) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%windGrid_n,1) - i1_u = UBOUND(OutData%windGrid_n,1) - DO i1 = LBOUND(OutData%windGrid_n,1), UBOUND(OutData%windGrid_n,1) - OutData%windGrid_n(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - i1_l = LBOUND(OutData%windGrid_delta,1) - i1_u = UBOUND(OutData%windGrid_delta,1) - DO i1 = LBOUND(OutData%windGrid_delta,1), UBOUND(OutData%windGrid_delta,1) - OutData%windGrid_delta(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%windGrid_pZero,1) - i1_u = UBOUND(OutData%windGrid_pZero,1) - DO i1 = LBOUND(OutData%windGrid_pZero,1), UBOUND(OutData%windGrid_pZero,1) - OutData%windGrid_pZero(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%NumActForcePtsBlade = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumActForcePtsTower = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NodeClusterType = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE FAST_UnPackExternInitType - - SUBROUTINE FAST_CopyTurbineType( SrcTurbineTypeData, DstTurbineTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FAST_TurbineType), INTENT(INOUT) :: SrcTurbineTypeData - TYPE(FAST_TurbineType), INTENT(INOUT) :: DstTurbineTypeData - 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 = 'FAST_CopyTurbineType' -! + ErrMsg = '' + LB(1:1) = lbound(SED_DataData%x) + UB(1:1) = ubound(SED_DataData%x) + do i1 = LB(1), UB(1) + call SED_DestroyContState(SED_DataData%x(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(SED_DataData%xd) + UB(1:1) = ubound(SED_DataData%xd) + do i1 = LB(1), UB(1) + call SED_DestroyDiscState(SED_DataData%xd(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(SED_DataData%z) + UB(1:1) = ubound(SED_DataData%z) + do i1 = LB(1), UB(1) + call SED_DestroyConstrState(SED_DataData%z(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(SED_DataData%OtherSt) + UB(1:1) = ubound(SED_DataData%OtherSt) + do i1 = LB(1), UB(1) + call SED_DestroyOtherState(SED_DataData%OtherSt(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + call SED_DestroyParam(SED_DataData%p, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SED_DestroyInput(SED_DataData%u, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SED_DestroyOutput(SED_DataData%y, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SED_DestroyMisc(SED_DataData%m, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(SED_DataData%Output)) then + LB(1:1) = lbound(SED_DataData%Output) + UB(1:1) = ubound(SED_DataData%Output) + do i1 = LB(1), UB(1) + call SED_DestroyOutput(SED_DataData%Output(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(SED_DataData%Output) + end if + call SED_DestroyOutput(SED_DataData%y_interp, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(SED_DataData%Input)) then + LB(1:1) = lbound(SED_DataData%Input) + UB(1:1) = ubound(SED_DataData%Input) + do i1 = LB(1), UB(1) + call SED_DestroyInput(SED_DataData%Input(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(SED_DataData%Input) + end if + if (allocated(SED_DataData%InputTimes)) then + deallocate(SED_DataData%InputTimes) + end if +end subroutine + +subroutine FAST_PackSED_Data(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SED_Data), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackSED_Data' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + if (RF%ErrStat >= AbortErrLev) return + LB(1:1) = lbound(InData%x) + UB(1:1) = ubound(InData%x) + do i1 = LB(1), UB(1) + call SED_PackContState(RF, InData%x(i1)) + end do + LB(1:1) = lbound(InData%xd) + UB(1:1) = ubound(InData%xd) + do i1 = LB(1), UB(1) + call SED_PackDiscState(RF, InData%xd(i1)) + end do + LB(1:1) = lbound(InData%z) + UB(1:1) = ubound(InData%z) + do i1 = LB(1), UB(1) + call SED_PackConstrState(RF, InData%z(i1)) + end do + LB(1:1) = lbound(InData%OtherSt) + UB(1:1) = ubound(InData%OtherSt) + do i1 = LB(1), UB(1) + call SED_PackOtherState(RF, InData%OtherSt(i1)) + end do + call SED_PackParam(RF, InData%p) + call SED_PackInput(RF, InData%u) + call SED_PackOutput(RF, InData%y) + call SED_PackMisc(RF, InData%m) + call RegPack(RF, allocated(InData%Output)) + if (allocated(InData%Output)) then + call RegPackBounds(RF, 1, lbound(InData%Output), ubound(InData%Output)) + LB(1:1) = lbound(InData%Output) + UB(1:1) = ubound(InData%Output) + do i1 = LB(1), UB(1) + call SED_PackOutput(RF, InData%Output(i1)) + end do + end if + call SED_PackOutput(RF, InData%y_interp) + call RegPack(RF, allocated(InData%Input)) + if (allocated(InData%Input)) then + call RegPackBounds(RF, 1, lbound(InData%Input), ubound(InData%Input)) + LB(1:1) = lbound(InData%Input) + UB(1:1) = ubound(InData%Input) + do i1 = LB(1), UB(1) + call SED_PackInput(RF, InData%Input(i1)) + end do + end if + call RegPackAlloc(RF, InData%InputTimes) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FAST_UnPackSED_Data(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SED_Data), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackSED_Data' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + LB(1:1) = lbound(OutData%x) + UB(1:1) = ubound(OutData%x) + do i1 = LB(1), UB(1) + call SED_UnpackContState(RF, OutData%x(i1)) ! x + end do + LB(1:1) = lbound(OutData%xd) + UB(1:1) = ubound(OutData%xd) + do i1 = LB(1), UB(1) + call SED_UnpackDiscState(RF, OutData%xd(i1)) ! xd + end do + LB(1:1) = lbound(OutData%z) + UB(1:1) = ubound(OutData%z) + do i1 = LB(1), UB(1) + call SED_UnpackConstrState(RF, OutData%z(i1)) ! z + end do + LB(1:1) = lbound(OutData%OtherSt) + UB(1:1) = ubound(OutData%OtherSt) + do i1 = LB(1), UB(1) + call SED_UnpackOtherState(RF, OutData%OtherSt(i1)) ! OtherSt + end do + call SED_UnpackParam(RF, OutData%p) ! p + call SED_UnpackInput(RF, OutData%u) ! u + call SED_UnpackOutput(RF, OutData%y) ! y + call SED_UnpackMisc(RF, OutData%m) ! m + if (allocated(OutData%Output)) deallocate(OutData%Output) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%Output(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SED_UnpackOutput(RF, OutData%Output(i1)) ! Output + end do + end if + call SED_UnpackOutput(RF, OutData%y_interp) ! y_interp + if (allocated(OutData%Input)) deallocate(OutData%Input) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%Input(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SED_UnpackInput(RF, OutData%Input(i1)) ! Input + end do + end if + call RegUnpackAlloc(RF, OutData%InputTimes); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FAST_CopyServoDyn_Data(SrcServoDyn_DataData, DstServoDyn_DataData, CtrlCode, ErrStat, ErrMsg) + type(ServoDyn_Data), intent(inout) :: SrcServoDyn_DataData + type(ServoDyn_Data), intent(inout) :: DstServoDyn_DataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_CopyServoDyn_Data' ErrStat = ErrID_None - ErrMsg = "" - DstTurbineTypeData%TurbID = SrcTurbineTypeData%TurbID - CALL FAST_CopyParam( SrcTurbineTypeData%p_FAST, DstTurbineTypeData%p_FAST, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL FAST_Copyoutputfiletype( SrcTurbineTypeData%y_FAST, DstTurbineTypeData%y_FAST, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL FAST_CopyMisc( SrcTurbineTypeData%m_FAST, DstTurbineTypeData%m_FAST, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL FAST_Copymodulemaptype( SrcTurbineTypeData%MeshMapData, DstTurbineTypeData%MeshMapData, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL FAST_Copyelastodyn_data( SrcTurbineTypeData%ED, DstTurbineTypeData%ED, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL FAST_Copybeamdyn_data( SrcTurbineTypeData%BD, DstTurbineTypeData%BD, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL FAST_Copyservodyn_data( SrcTurbineTypeData%SrvD, DstTurbineTypeData%SrvD, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL FAST_Copyaerodyn_data( SrcTurbineTypeData%AD, DstTurbineTypeData%AD, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL FAST_Copyaerodyn14_data( SrcTurbineTypeData%AD14, DstTurbineTypeData%AD14, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL FAST_Copyinflowwind_data( SrcTurbineTypeData%IfW, DstTurbineTypeData%IfW, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL FAST_Copyopenfoam_data( SrcTurbineTypeData%OpFM, DstTurbineTypeData%OpFM, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL FAST_Copyscdataex_data( SrcTurbineTypeData%SC_DX, DstTurbineTypeData%SC_DX, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL FAST_Copyhydrodyn_data( SrcTurbineTypeData%HD, DstTurbineTypeData%HD, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL FAST_Copysubdyn_data( SrcTurbineTypeData%SD, DstTurbineTypeData%SD, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL FAST_Copymap_data( SrcTurbineTypeData%MAP, DstTurbineTypeData%MAP, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL FAST_Copyfeamooring_data( SrcTurbineTypeData%FEAM, DstTurbineTypeData%FEAM, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL FAST_Copymoordyn_data( SrcTurbineTypeData%MD, DstTurbineTypeData%MD, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL FAST_Copyorcaflex_data( SrcTurbineTypeData%Orca, DstTurbineTypeData%Orca, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL FAST_Copyicefloe_data( SrcTurbineTypeData%IceF, DstTurbineTypeData%IceF, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL FAST_Copyicedyn_data( SrcTurbineTypeData%IceD, DstTurbineTypeData%IceD, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL FAST_Copyextptfm_data( SrcTurbineTypeData%ExtPtfm, DstTurbineTypeData%ExtPtfm, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE FAST_CopyTurbineType - - SUBROUTINE FAST_DestroyTurbineType( TurbineTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(FAST_TurbineType), INTENT(INOUT) :: TurbineTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyTurbineType' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL FAST_DestroyParam( TurbineTypeData%p_FAST, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FAST_Destroyoutputfiletype( TurbineTypeData%y_FAST, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FAST_DestroyMisc( TurbineTypeData%m_FAST, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FAST_Destroymodulemaptype( TurbineTypeData%MeshMapData, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FAST_Destroyelastodyn_data( TurbineTypeData%ED, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FAST_Destroybeamdyn_data( TurbineTypeData%BD, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FAST_Destroyservodyn_data( TurbineTypeData%SrvD, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FAST_Destroyaerodyn_data( TurbineTypeData%AD, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FAST_Destroyaerodyn14_data( TurbineTypeData%AD14, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FAST_Destroyinflowwind_data( TurbineTypeData%IfW, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FAST_Destroyopenfoam_data( TurbineTypeData%OpFM, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FAST_Destroyscdataex_data( TurbineTypeData%SC_DX, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FAST_Destroyhydrodyn_data( TurbineTypeData%HD, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FAST_Destroysubdyn_data( TurbineTypeData%SD, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FAST_Destroymap_data( TurbineTypeData%MAP, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FAST_Destroyfeamooring_data( TurbineTypeData%FEAM, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FAST_Destroymoordyn_data( TurbineTypeData%MD, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FAST_Destroyorcaflex_data( TurbineTypeData%Orca, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FAST_Destroyicefloe_data( TurbineTypeData%IceF, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FAST_Destroyicedyn_data( TurbineTypeData%IceD, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FAST_Destroyextptfm_data( TurbineTypeData%ExtPtfm, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE FAST_DestroyTurbineType - - SUBROUTINE FAST_PackTurbineType( 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(FAST_TurbineType), 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 = 'FAST_PackTurbineType' - ! 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 ! TurbID - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! p_FAST: size of buffers for each call to pack subtype - CALL FAST_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p_FAST, ErrStat2, ErrMsg2, .TRUE. ) ! p_FAST - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! p_FAST - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! p_FAST - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! p_FAST - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! y_FAST: size of buffers for each call to pack subtype - CALL FAST_Packoutputfiletype( Re_Buf, Db_Buf, Int_Buf, InData%y_FAST, ErrStat2, ErrMsg2, .TRUE. ) ! y_FAST - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y_FAST - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y_FAST - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y_FAST - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! m_FAST: size of buffers for each call to pack subtype - CALL FAST_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m_FAST, ErrStat2, ErrMsg2, .TRUE. ) ! m_FAST - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! m_FAST - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! m_FAST - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! m_FAST - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! MeshMapData: size of buffers for each call to pack subtype - CALL FAST_Packmodulemaptype( Re_Buf, Db_Buf, Int_Buf, InData%MeshMapData, ErrStat2, ErrMsg2, .TRUE. ) ! MeshMapData - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! MeshMapData - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! MeshMapData - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! MeshMapData - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! ED: size of buffers for each call to pack subtype - CALL FAST_Packelastodyn_data( Re_Buf, Db_Buf, Int_Buf, InData%ED, ErrStat2, ErrMsg2, .TRUE. ) ! ED - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! ED - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! ED - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! ED - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! BD: size of buffers for each call to pack subtype - CALL FAST_Packbeamdyn_data( Re_Buf, Db_Buf, Int_Buf, InData%BD, ErrStat2, ErrMsg2, .TRUE. ) ! BD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! SrvD: size of buffers for each call to pack subtype - CALL FAST_Packservodyn_data( Re_Buf, Db_Buf, Int_Buf, InData%SrvD, ErrStat2, ErrMsg2, .TRUE. ) ! SrvD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SrvD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SrvD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SrvD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! AD: size of buffers for each call to pack subtype - CALL FAST_Packaerodyn_data( Re_Buf, Db_Buf, Int_Buf, InData%AD, ErrStat2, ErrMsg2, .TRUE. ) ! AD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! AD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! AD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! AD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! AD14: size of buffers for each call to pack subtype - CALL FAST_Packaerodyn14_data( Re_Buf, Db_Buf, Int_Buf, InData%AD14, ErrStat2, ErrMsg2, .TRUE. ) ! AD14 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! AD14 - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! AD14 - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! AD14 - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! IfW: size of buffers for each call to pack subtype - CALL FAST_Packinflowwind_data( Re_Buf, Db_Buf, Int_Buf, InData%IfW, ErrStat2, ErrMsg2, .TRUE. ) ! IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! IfW - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! IfW - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! IfW - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! OpFM: size of buffers for each call to pack subtype - CALL FAST_Packopenfoam_data( Re_Buf, Db_Buf, Int_Buf, InData%OpFM, ErrStat2, ErrMsg2, .TRUE. ) ! OpFM - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OpFM - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OpFM - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OpFM - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! SC_DX: size of buffers for each call to pack subtype - CALL FAST_Packscdataex_data( Re_Buf, Db_Buf, Int_Buf, InData%SC_DX, ErrStat2, ErrMsg2, .TRUE. ) ! SC_DX - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SC_DX - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SC_DX - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SC_DX - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! HD: size of buffers for each call to pack subtype - CALL FAST_Packhydrodyn_data( Re_Buf, Db_Buf, Int_Buf, InData%HD, ErrStat2, ErrMsg2, .TRUE. ) ! HD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! HD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! HD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! HD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! SD: size of buffers for each call to pack subtype - CALL FAST_Packsubdyn_data( Re_Buf, Db_Buf, Int_Buf, InData%SD, ErrStat2, ErrMsg2, .TRUE. ) ! SD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! MAP: size of buffers for each call to pack subtype - CALL FAST_Packmap_data( Re_Buf, Db_Buf, Int_Buf, InData%MAP, ErrStat2, ErrMsg2, .TRUE. ) ! MAP - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! MAP - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! MAP - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! MAP - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! FEAM: size of buffers for each call to pack subtype - CALL FAST_Packfeamooring_data( Re_Buf, Db_Buf, Int_Buf, InData%FEAM, ErrStat2, ErrMsg2, .TRUE. ) ! FEAM - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! FEAM - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! FEAM - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! FEAM - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! MD: size of buffers for each call to pack subtype - CALL FAST_Packmoordyn_data( Re_Buf, Db_Buf, Int_Buf, InData%MD, ErrStat2, ErrMsg2, .TRUE. ) ! MD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! MD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! MD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! MD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! Orca: size of buffers for each call to pack subtype - CALL FAST_Packorcaflex_data( Re_Buf, Db_Buf, Int_Buf, InData%Orca, ErrStat2, ErrMsg2, .TRUE. ) ! Orca - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Orca - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Orca - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Orca - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! IceF: size of buffers for each call to pack subtype - CALL FAST_Packicefloe_data( Re_Buf, Db_Buf, Int_Buf, InData%IceF, ErrStat2, ErrMsg2, .TRUE. ) ! IceF - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! IceF - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! IceF - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! IceF - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! IceD: size of buffers for each call to pack subtype - CALL FAST_Packicedyn_data( Re_Buf, Db_Buf, Int_Buf, InData%IceD, ErrStat2, ErrMsg2, .TRUE. ) ! IceD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! IceD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! IceD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! IceD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! ExtPtfm: size of buffers for each call to pack subtype - CALL FAST_Packextptfm_data( Re_Buf, Db_Buf, Int_Buf, InData%ExtPtfm, ErrStat2, ErrMsg2, .TRUE. ) ! ExtPtfm - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! ExtPtfm - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! ExtPtfm - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! ExtPtfm - 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 - - IntKiBuf(Int_Xferred) = InData%TurbID - Int_Xferred = Int_Xferred + 1 - CALL FAST_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p_FAST, ErrStat2, ErrMsg2, OnlySize ) ! p_FAST - 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 FAST_Packoutputfiletype( Re_Buf, Db_Buf, Int_Buf, InData%y_FAST, ErrStat2, ErrMsg2, OnlySize ) ! y_FAST - 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 FAST_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m_FAST, ErrStat2, ErrMsg2, OnlySize ) ! m_FAST - 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 FAST_Packmodulemaptype( Re_Buf, Db_Buf, Int_Buf, InData%MeshMapData, ErrStat2, ErrMsg2, OnlySize ) ! MeshMapData - 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 FAST_Packelastodyn_data( Re_Buf, Db_Buf, Int_Buf, InData%ED, ErrStat2, ErrMsg2, OnlySize ) ! ED - 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 FAST_Packbeamdyn_data( Re_Buf, Db_Buf, Int_Buf, InData%BD, ErrStat2, ErrMsg2, OnlySize ) ! BD - 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 FAST_Packservodyn_data( Re_Buf, Db_Buf, Int_Buf, InData%SrvD, ErrStat2, ErrMsg2, OnlySize ) ! SrvD - 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 FAST_Packaerodyn_data( Re_Buf, Db_Buf, Int_Buf, InData%AD, ErrStat2, ErrMsg2, OnlySize ) ! AD - 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 FAST_Packaerodyn14_data( Re_Buf, Db_Buf, Int_Buf, InData%AD14, ErrStat2, ErrMsg2, OnlySize ) ! AD14 - 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 FAST_Packinflowwind_data( Re_Buf, Db_Buf, Int_Buf, InData%IfW, ErrStat2, ErrMsg2, OnlySize ) ! IfW - 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 FAST_Packopenfoam_data( Re_Buf, Db_Buf, Int_Buf, InData%OpFM, ErrStat2, ErrMsg2, OnlySize ) ! OpFM - 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 FAST_Packscdataex_data( Re_Buf, Db_Buf, Int_Buf, InData%SC_DX, ErrStat2, ErrMsg2, OnlySize ) ! SC_DX - 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 FAST_Packhydrodyn_data( Re_Buf, Db_Buf, Int_Buf, InData%HD, ErrStat2, ErrMsg2, OnlySize ) ! HD - 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 FAST_Packsubdyn_data( Re_Buf, Db_Buf, Int_Buf, InData%SD, ErrStat2, ErrMsg2, OnlySize ) ! SD - 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 FAST_Packmap_data( Re_Buf, Db_Buf, Int_Buf, InData%MAP, ErrStat2, ErrMsg2, OnlySize ) ! MAP - 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 FAST_Packfeamooring_data( Re_Buf, Db_Buf, Int_Buf, InData%FEAM, ErrStat2, ErrMsg2, OnlySize ) ! FEAM - 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 FAST_Packmoordyn_data( Re_Buf, Db_Buf, Int_Buf, InData%MD, ErrStat2, ErrMsg2, OnlySize ) ! MD - 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 FAST_Packorcaflex_data( Re_Buf, Db_Buf, Int_Buf, InData%Orca, ErrStat2, ErrMsg2, OnlySize ) ! 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 - CALL FAST_Packicefloe_data( Re_Buf, Db_Buf, Int_Buf, InData%IceF, ErrStat2, ErrMsg2, OnlySize ) ! IceF - 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 FAST_Packicedyn_data( Re_Buf, Db_Buf, Int_Buf, InData%IceD, ErrStat2, ErrMsg2, OnlySize ) ! IceD - 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 FAST_Packextptfm_data( Re_Buf, Db_Buf, Int_Buf, InData%ExtPtfm, ErrStat2, ErrMsg2, OnlySize ) ! ExtPtfm - 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 FAST_PackTurbineType - - SUBROUTINE FAST_UnPackTurbineType( 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(FAST_TurbineType), 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 = 'FAST_UnPackTurbineType' - ! 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%TurbID = IntKiBuf(Int_Xferred) - 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 FAST_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p_FAST, ErrStat2, ErrMsg2 ) ! p_FAST - 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 FAST_Unpackoutputfiletype( Re_Buf, Db_Buf, Int_Buf, OutData%y_FAST, ErrStat2, ErrMsg2 ) ! y_FAST - 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 FAST_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m_FAST, ErrStat2, ErrMsg2 ) ! m_FAST - 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 FAST_Unpackmodulemaptype( Re_Buf, Db_Buf, Int_Buf, OutData%MeshMapData, ErrStat2, ErrMsg2 ) ! MeshMapData - 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 FAST_Unpackelastodyn_data( Re_Buf, Db_Buf, Int_Buf, OutData%ED, ErrStat2, ErrMsg2 ) ! ED - 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 FAST_Unpackbeamdyn_data( Re_Buf, Db_Buf, Int_Buf, OutData%BD, ErrStat2, ErrMsg2 ) ! BD - 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 FAST_Unpackservodyn_data( Re_Buf, Db_Buf, Int_Buf, OutData%SrvD, ErrStat2, ErrMsg2 ) ! SrvD - 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 FAST_Unpackaerodyn_data( Re_Buf, Db_Buf, Int_Buf, OutData%AD, ErrStat2, ErrMsg2 ) ! AD - 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 FAST_Unpackaerodyn14_data( Re_Buf, Db_Buf, Int_Buf, OutData%AD14, ErrStat2, ErrMsg2 ) ! AD14 - 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 FAST_Unpackinflowwind_data( Re_Buf, Db_Buf, Int_Buf, OutData%IfW, ErrStat2, ErrMsg2 ) ! IfW - 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 FAST_Unpackopenfoam_data( Re_Buf, Db_Buf, Int_Buf, OutData%OpFM, ErrStat2, ErrMsg2 ) ! OpFM - 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 FAST_Unpackscdataex_data( Re_Buf, Db_Buf, Int_Buf, OutData%SC_DX, ErrStat2, ErrMsg2 ) ! SC_DX - 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 FAST_Unpackhydrodyn_data( Re_Buf, Db_Buf, Int_Buf, OutData%HD, ErrStat2, ErrMsg2 ) ! HD - 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 FAST_Unpacksubdyn_data( Re_Buf, Db_Buf, Int_Buf, OutData%SD, ErrStat2, ErrMsg2 ) ! SD - 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 FAST_Unpackmap_data( Re_Buf, Db_Buf, Int_Buf, OutData%MAP, ErrStat2, ErrMsg2 ) ! MAP - 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 FAST_Unpackfeamooring_data( Re_Buf, Db_Buf, Int_Buf, OutData%FEAM, ErrStat2, ErrMsg2 ) ! FEAM - 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 FAST_Unpackmoordyn_data( Re_Buf, Db_Buf, Int_Buf, OutData%MD, ErrStat2, ErrMsg2 ) ! MD - 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 FAST_Unpackorcaflex_data( Re_Buf, Db_Buf, Int_Buf, OutData%Orca, ErrStat2, ErrMsg2 ) ! 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) - 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 FAST_Unpackicefloe_data( Re_Buf, Db_Buf, Int_Buf, OutData%IceF, ErrStat2, ErrMsg2 ) ! IceF - 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 FAST_Unpackicedyn_data( Re_Buf, Db_Buf, Int_Buf, OutData%IceD, ErrStat2, ErrMsg2 ) ! IceD - 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 FAST_Unpackextptfm_data( Re_Buf, Db_Buf, Int_Buf, OutData%ExtPtfm, ErrStat2, ErrMsg2 ) ! ExtPtfm - 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 FAST_UnPackTurbineType - + ErrMsg = '' + LB(1:1) = lbound(SrcServoDyn_DataData%x) + UB(1:1) = ubound(SrcServoDyn_DataData%x) + do i1 = LB(1), UB(1) + call SrvD_CopyContState(SrcServoDyn_DataData%x(i1), DstServoDyn_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + LB(1:1) = lbound(SrcServoDyn_DataData%xd) + UB(1:1) = ubound(SrcServoDyn_DataData%xd) + do i1 = LB(1), UB(1) + call SrvD_CopyDiscState(SrcServoDyn_DataData%xd(i1), DstServoDyn_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + LB(1:1) = lbound(SrcServoDyn_DataData%z) + UB(1:1) = ubound(SrcServoDyn_DataData%z) + do i1 = LB(1), UB(1) + call SrvD_CopyConstrState(SrcServoDyn_DataData%z(i1), DstServoDyn_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + LB(1:1) = lbound(SrcServoDyn_DataData%OtherSt) + UB(1:1) = ubound(SrcServoDyn_DataData%OtherSt) + do i1 = LB(1), UB(1) + call SrvD_CopyOtherState(SrcServoDyn_DataData%OtherSt(i1), DstServoDyn_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + call SrvD_CopyParam(SrcServoDyn_DataData%p, DstServoDyn_DataData%p, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SrvD_CopyInput(SrcServoDyn_DataData%u, DstServoDyn_DataData%u, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SrvD_CopyOutput(SrcServoDyn_DataData%y, DstServoDyn_DataData%y, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SrvD_CopyMisc(SrcServoDyn_DataData%m, DstServoDyn_DataData%m, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SrvD_CopyMisc(SrcServoDyn_DataData%m_bak, DstServoDyn_DataData%m_bak, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcServoDyn_DataData%Output)) then + LB(1:1) = lbound(SrcServoDyn_DataData%Output) + UB(1:1) = ubound(SrcServoDyn_DataData%Output) + if (.not. allocated(DstServoDyn_DataData%Output)) then + allocate(DstServoDyn_DataData%Output(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstServoDyn_DataData%Output.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call SrvD_CopyOutput(SrcServoDyn_DataData%Output(i1), DstServoDyn_DataData%Output(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call SrvD_CopyOutput(SrcServoDyn_DataData%y_interp, DstServoDyn_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcServoDyn_DataData%Input)) then + LB(1:1) = lbound(SrcServoDyn_DataData%Input) + UB(1:1) = ubound(SrcServoDyn_DataData%Input) + if (.not. allocated(DstServoDyn_DataData%Input)) then + allocate(DstServoDyn_DataData%Input(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstServoDyn_DataData%Input.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call SrvD_CopyInput(SrcServoDyn_DataData%Input(i1), DstServoDyn_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcServoDyn_DataData%Input_Saved)) then + LB(1:1) = lbound(SrcServoDyn_DataData%Input_Saved) + UB(1:1) = ubound(SrcServoDyn_DataData%Input_Saved) + if (.not. allocated(DstServoDyn_DataData%Input_Saved)) then + allocate(DstServoDyn_DataData%Input_Saved(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstServoDyn_DataData%Input_Saved.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call SrvD_CopyInput(SrcServoDyn_DataData%Input_Saved(i1), DstServoDyn_DataData%Input_Saved(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcServoDyn_DataData%InputTimes)) then + LB(1:1) = lbound(SrcServoDyn_DataData%InputTimes) + UB(1:1) = ubound(SrcServoDyn_DataData%InputTimes) + if (.not. allocated(DstServoDyn_DataData%InputTimes)) then + allocate(DstServoDyn_DataData%InputTimes(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstServoDyn_DataData%InputTimes.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstServoDyn_DataData%InputTimes = SrcServoDyn_DataData%InputTimes + end if + if (allocated(SrcServoDyn_DataData%InputTimes_Saved)) then + LB(1:1) = lbound(SrcServoDyn_DataData%InputTimes_Saved) + UB(1:1) = ubound(SrcServoDyn_DataData%InputTimes_Saved) + if (.not. allocated(DstServoDyn_DataData%InputTimes_Saved)) then + allocate(DstServoDyn_DataData%InputTimes_Saved(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstServoDyn_DataData%InputTimes_Saved.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstServoDyn_DataData%InputTimes_Saved = SrcServoDyn_DataData%InputTimes_Saved + end if +end subroutine + +subroutine FAST_DestroyServoDyn_Data(ServoDyn_DataData, ErrStat, ErrMsg) + type(ServoDyn_Data), intent(inout) :: ServoDyn_DataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_DestroyServoDyn_Data' + ErrStat = ErrID_None + ErrMsg = '' + LB(1:1) = lbound(ServoDyn_DataData%x) + UB(1:1) = ubound(ServoDyn_DataData%x) + do i1 = LB(1), UB(1) + call SrvD_DestroyContState(ServoDyn_DataData%x(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(ServoDyn_DataData%xd) + UB(1:1) = ubound(ServoDyn_DataData%xd) + do i1 = LB(1), UB(1) + call SrvD_DestroyDiscState(ServoDyn_DataData%xd(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(ServoDyn_DataData%z) + UB(1:1) = ubound(ServoDyn_DataData%z) + do i1 = LB(1), UB(1) + call SrvD_DestroyConstrState(ServoDyn_DataData%z(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(ServoDyn_DataData%OtherSt) + UB(1:1) = ubound(ServoDyn_DataData%OtherSt) + do i1 = LB(1), UB(1) + call SrvD_DestroyOtherState(ServoDyn_DataData%OtherSt(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + call SrvD_DestroyParam(ServoDyn_DataData%p, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SrvD_DestroyInput(ServoDyn_DataData%u, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SrvD_DestroyOutput(ServoDyn_DataData%y, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SrvD_DestroyMisc(ServoDyn_DataData%m, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SrvD_DestroyMisc(ServoDyn_DataData%m_bak, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(ServoDyn_DataData%Output)) then + LB(1:1) = lbound(ServoDyn_DataData%Output) + UB(1:1) = ubound(ServoDyn_DataData%Output) + do i1 = LB(1), UB(1) + call SrvD_DestroyOutput(ServoDyn_DataData%Output(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ServoDyn_DataData%Output) + end if + call SrvD_DestroyOutput(ServoDyn_DataData%y_interp, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(ServoDyn_DataData%Input)) then + LB(1:1) = lbound(ServoDyn_DataData%Input) + UB(1:1) = ubound(ServoDyn_DataData%Input) + do i1 = LB(1), UB(1) + call SrvD_DestroyInput(ServoDyn_DataData%Input(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ServoDyn_DataData%Input) + end if + if (allocated(ServoDyn_DataData%Input_Saved)) then + LB(1:1) = lbound(ServoDyn_DataData%Input_Saved) + UB(1:1) = ubound(ServoDyn_DataData%Input_Saved) + do i1 = LB(1), UB(1) + call SrvD_DestroyInput(ServoDyn_DataData%Input_Saved(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ServoDyn_DataData%Input_Saved) + end if + if (allocated(ServoDyn_DataData%InputTimes)) then + deallocate(ServoDyn_DataData%InputTimes) + end if + if (allocated(ServoDyn_DataData%InputTimes_Saved)) then + deallocate(ServoDyn_DataData%InputTimes_Saved) + end if +end subroutine + +subroutine FAST_PackServoDyn_Data(RF, Indata) + type(RegFile), intent(inout) :: RF + type(ServoDyn_Data), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackServoDyn_Data' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + if (RF%ErrStat >= AbortErrLev) return + LB(1:1) = lbound(InData%x) + UB(1:1) = ubound(InData%x) + do i1 = LB(1), UB(1) + call SrvD_PackContState(RF, InData%x(i1)) + end do + LB(1:1) = lbound(InData%xd) + UB(1:1) = ubound(InData%xd) + do i1 = LB(1), UB(1) + call SrvD_PackDiscState(RF, InData%xd(i1)) + end do + LB(1:1) = lbound(InData%z) + UB(1:1) = ubound(InData%z) + do i1 = LB(1), UB(1) + call SrvD_PackConstrState(RF, InData%z(i1)) + end do + LB(1:1) = lbound(InData%OtherSt) + UB(1:1) = ubound(InData%OtherSt) + do i1 = LB(1), UB(1) + call SrvD_PackOtherState(RF, InData%OtherSt(i1)) + end do + call SrvD_PackParam(RF, InData%p) + call SrvD_PackInput(RF, InData%u) + call SrvD_PackOutput(RF, InData%y) + call SrvD_PackMisc(RF, InData%m) + call SrvD_PackMisc(RF, InData%m_bak) + call RegPack(RF, allocated(InData%Output)) + if (allocated(InData%Output)) then + call RegPackBounds(RF, 1, lbound(InData%Output), ubound(InData%Output)) + LB(1:1) = lbound(InData%Output) + UB(1:1) = ubound(InData%Output) + do i1 = LB(1), UB(1) + call SrvD_PackOutput(RF, InData%Output(i1)) + end do + end if + call SrvD_PackOutput(RF, InData%y_interp) + call RegPack(RF, allocated(InData%Input)) + if (allocated(InData%Input)) then + call RegPackBounds(RF, 1, lbound(InData%Input), ubound(InData%Input)) + LB(1:1) = lbound(InData%Input) + UB(1:1) = ubound(InData%Input) + do i1 = LB(1), UB(1) + call SrvD_PackInput(RF, InData%Input(i1)) + end do + end if + call RegPack(RF, allocated(InData%Input_Saved)) + if (allocated(InData%Input_Saved)) then + call RegPackBounds(RF, 1, lbound(InData%Input_Saved), ubound(InData%Input_Saved)) + LB(1:1) = lbound(InData%Input_Saved) + UB(1:1) = ubound(InData%Input_Saved) + do i1 = LB(1), UB(1) + call SrvD_PackInput(RF, InData%Input_Saved(i1)) + end do + end if + call RegPackAlloc(RF, InData%InputTimes) + call RegPackAlloc(RF, InData%InputTimes_Saved) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FAST_UnPackServoDyn_Data(RF, OutData) + type(RegFile), intent(inout) :: RF + type(ServoDyn_Data), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackServoDyn_Data' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + LB(1:1) = lbound(OutData%x) + UB(1:1) = ubound(OutData%x) + do i1 = LB(1), UB(1) + call SrvD_UnpackContState(RF, OutData%x(i1)) ! x + end do + LB(1:1) = lbound(OutData%xd) + UB(1:1) = ubound(OutData%xd) + do i1 = LB(1), UB(1) + call SrvD_UnpackDiscState(RF, OutData%xd(i1)) ! xd + end do + LB(1:1) = lbound(OutData%z) + UB(1:1) = ubound(OutData%z) + do i1 = LB(1), UB(1) + call SrvD_UnpackConstrState(RF, OutData%z(i1)) ! z + end do + LB(1:1) = lbound(OutData%OtherSt) + UB(1:1) = ubound(OutData%OtherSt) + do i1 = LB(1), UB(1) + call SrvD_UnpackOtherState(RF, OutData%OtherSt(i1)) ! OtherSt + end do + call SrvD_UnpackParam(RF, OutData%p) ! p + call SrvD_UnpackInput(RF, OutData%u) ! u + call SrvD_UnpackOutput(RF, OutData%y) ! y + call SrvD_UnpackMisc(RF, OutData%m) ! m + call SrvD_UnpackMisc(RF, OutData%m_bak) ! m_bak + if (allocated(OutData%Output)) deallocate(OutData%Output) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%Output(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SrvD_UnpackOutput(RF, OutData%Output(i1)) ! Output + end do + end if + call SrvD_UnpackOutput(RF, OutData%y_interp) ! y_interp + if (allocated(OutData%Input)) deallocate(OutData%Input) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%Input(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SrvD_UnpackInput(RF, OutData%Input(i1)) ! Input + end do + end if + if (allocated(OutData%Input_Saved)) deallocate(OutData%Input_Saved) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%Input_Saved(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input_Saved.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SrvD_UnpackInput(RF, OutData%Input_Saved(i1)) ! Input_Saved + end do + end if + call RegUnpackAlloc(RF, OutData%InputTimes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%InputTimes_Saved); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FAST_CopyAeroDyn_Data(SrcAeroDyn_DataData, DstAeroDyn_DataData, CtrlCode, ErrStat, ErrMsg) + type(AeroDyn_Data), intent(inout) :: SrcAeroDyn_DataData + type(AeroDyn_Data), intent(inout) :: DstAeroDyn_DataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_CopyAeroDyn_Data' + ErrStat = ErrID_None + ErrMsg = '' + LB(1:1) = lbound(SrcAeroDyn_DataData%x) + UB(1:1) = ubound(SrcAeroDyn_DataData%x) + do i1 = LB(1), UB(1) + call AD_CopyContState(SrcAeroDyn_DataData%x(i1), DstAeroDyn_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + LB(1:1) = lbound(SrcAeroDyn_DataData%xd) + UB(1:1) = ubound(SrcAeroDyn_DataData%xd) + do i1 = LB(1), UB(1) + call AD_CopyDiscState(SrcAeroDyn_DataData%xd(i1), DstAeroDyn_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + LB(1:1) = lbound(SrcAeroDyn_DataData%z) + UB(1:1) = ubound(SrcAeroDyn_DataData%z) + do i1 = LB(1), UB(1) + call AD_CopyConstrState(SrcAeroDyn_DataData%z(i1), DstAeroDyn_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + LB(1:1) = lbound(SrcAeroDyn_DataData%OtherSt) + UB(1:1) = ubound(SrcAeroDyn_DataData%OtherSt) + do i1 = LB(1), UB(1) + call AD_CopyOtherState(SrcAeroDyn_DataData%OtherSt(i1), DstAeroDyn_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + call AD_CopyParam(SrcAeroDyn_DataData%p, DstAeroDyn_DataData%p, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AD_CopyInput(SrcAeroDyn_DataData%u, DstAeroDyn_DataData%u, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AD_CopyOutput(SrcAeroDyn_DataData%y, DstAeroDyn_DataData%y, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AD_CopyMisc(SrcAeroDyn_DataData%m, DstAeroDyn_DataData%m, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcAeroDyn_DataData%Output)) then + LB(1:1) = lbound(SrcAeroDyn_DataData%Output) + UB(1:1) = ubound(SrcAeroDyn_DataData%Output) + if (.not. allocated(DstAeroDyn_DataData%Output)) then + allocate(DstAeroDyn_DataData%Output(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstAeroDyn_DataData%Output.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AD_CopyOutput(SrcAeroDyn_DataData%Output(i1), DstAeroDyn_DataData%Output(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call AD_CopyOutput(SrcAeroDyn_DataData%y_interp, DstAeroDyn_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcAeroDyn_DataData%Input)) then + LB(1:1) = lbound(SrcAeroDyn_DataData%Input) + UB(1:1) = ubound(SrcAeroDyn_DataData%Input) + if (.not. allocated(DstAeroDyn_DataData%Input)) then + allocate(DstAeroDyn_DataData%Input(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstAeroDyn_DataData%Input.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AD_CopyInput(SrcAeroDyn_DataData%Input(i1), DstAeroDyn_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcAeroDyn_DataData%Input_Saved)) then + LB(1:1) = lbound(SrcAeroDyn_DataData%Input_Saved) + UB(1:1) = ubound(SrcAeroDyn_DataData%Input_Saved) + if (.not. allocated(DstAeroDyn_DataData%Input_Saved)) then + allocate(DstAeroDyn_DataData%Input_Saved(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstAeroDyn_DataData%Input_Saved.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AD_CopyInput(SrcAeroDyn_DataData%Input_Saved(i1), DstAeroDyn_DataData%Input_Saved(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcAeroDyn_DataData%InputTimes)) then + LB(1:1) = lbound(SrcAeroDyn_DataData%InputTimes) + UB(1:1) = ubound(SrcAeroDyn_DataData%InputTimes) + if (.not. allocated(DstAeroDyn_DataData%InputTimes)) then + allocate(DstAeroDyn_DataData%InputTimes(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstAeroDyn_DataData%InputTimes.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstAeroDyn_DataData%InputTimes = SrcAeroDyn_DataData%InputTimes + end if + if (allocated(SrcAeroDyn_DataData%InputTimes_Saved)) then + LB(1:1) = lbound(SrcAeroDyn_DataData%InputTimes_Saved) + UB(1:1) = ubound(SrcAeroDyn_DataData%InputTimes_Saved) + if (.not. allocated(DstAeroDyn_DataData%InputTimes_Saved)) then + allocate(DstAeroDyn_DataData%InputTimes_Saved(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstAeroDyn_DataData%InputTimes_Saved.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstAeroDyn_DataData%InputTimes_Saved = SrcAeroDyn_DataData%InputTimes_Saved + end if +end subroutine + +subroutine FAST_DestroyAeroDyn_Data(AeroDyn_DataData, ErrStat, ErrMsg) + type(AeroDyn_Data), intent(inout) :: AeroDyn_DataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_DestroyAeroDyn_Data' + ErrStat = ErrID_None + ErrMsg = '' + LB(1:1) = lbound(AeroDyn_DataData%x) + UB(1:1) = ubound(AeroDyn_DataData%x) + do i1 = LB(1), UB(1) + call AD_DestroyContState(AeroDyn_DataData%x(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(AeroDyn_DataData%xd) + UB(1:1) = ubound(AeroDyn_DataData%xd) + do i1 = LB(1), UB(1) + call AD_DestroyDiscState(AeroDyn_DataData%xd(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(AeroDyn_DataData%z) + UB(1:1) = ubound(AeroDyn_DataData%z) + do i1 = LB(1), UB(1) + call AD_DestroyConstrState(AeroDyn_DataData%z(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(AeroDyn_DataData%OtherSt) + UB(1:1) = ubound(AeroDyn_DataData%OtherSt) + do i1 = LB(1), UB(1) + call AD_DestroyOtherState(AeroDyn_DataData%OtherSt(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + call AD_DestroyParam(AeroDyn_DataData%p, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AD_DestroyInput(AeroDyn_DataData%u, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AD_DestroyOutput(AeroDyn_DataData%y, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AD_DestroyMisc(AeroDyn_DataData%m, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(AeroDyn_DataData%Output)) then + LB(1:1) = lbound(AeroDyn_DataData%Output) + UB(1:1) = ubound(AeroDyn_DataData%Output) + do i1 = LB(1), UB(1) + call AD_DestroyOutput(AeroDyn_DataData%Output(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(AeroDyn_DataData%Output) + end if + call AD_DestroyOutput(AeroDyn_DataData%y_interp, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(AeroDyn_DataData%Input)) then + LB(1:1) = lbound(AeroDyn_DataData%Input) + UB(1:1) = ubound(AeroDyn_DataData%Input) + do i1 = LB(1), UB(1) + call AD_DestroyInput(AeroDyn_DataData%Input(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(AeroDyn_DataData%Input) + end if + if (allocated(AeroDyn_DataData%Input_Saved)) then + LB(1:1) = lbound(AeroDyn_DataData%Input_Saved) + UB(1:1) = ubound(AeroDyn_DataData%Input_Saved) + do i1 = LB(1), UB(1) + call AD_DestroyInput(AeroDyn_DataData%Input_Saved(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(AeroDyn_DataData%Input_Saved) + end if + if (allocated(AeroDyn_DataData%InputTimes)) then + deallocate(AeroDyn_DataData%InputTimes) + end if + if (allocated(AeroDyn_DataData%InputTimes_Saved)) then + deallocate(AeroDyn_DataData%InputTimes_Saved) + end if +end subroutine + +subroutine FAST_PackAeroDyn_Data(RF, Indata) + type(RegFile), intent(inout) :: RF + type(AeroDyn_Data), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackAeroDyn_Data' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + if (RF%ErrStat >= AbortErrLev) return + LB(1:1) = lbound(InData%x) + UB(1:1) = ubound(InData%x) + do i1 = LB(1), UB(1) + call AD_PackContState(RF, InData%x(i1)) + end do + LB(1:1) = lbound(InData%xd) + UB(1:1) = ubound(InData%xd) + do i1 = LB(1), UB(1) + call AD_PackDiscState(RF, InData%xd(i1)) + end do + LB(1:1) = lbound(InData%z) + UB(1:1) = ubound(InData%z) + do i1 = LB(1), UB(1) + call AD_PackConstrState(RF, InData%z(i1)) + end do + LB(1:1) = lbound(InData%OtherSt) + UB(1:1) = ubound(InData%OtherSt) + do i1 = LB(1), UB(1) + call AD_PackOtherState(RF, InData%OtherSt(i1)) + end do + call AD_PackParam(RF, InData%p) + call AD_PackInput(RF, InData%u) + call AD_PackOutput(RF, InData%y) + call AD_PackMisc(RF, InData%m) + call RegPack(RF, allocated(InData%Output)) + if (allocated(InData%Output)) then + call RegPackBounds(RF, 1, lbound(InData%Output), ubound(InData%Output)) + LB(1:1) = lbound(InData%Output) + UB(1:1) = ubound(InData%Output) + do i1 = LB(1), UB(1) + call AD_PackOutput(RF, InData%Output(i1)) + end do + end if + call AD_PackOutput(RF, InData%y_interp) + call RegPack(RF, allocated(InData%Input)) + if (allocated(InData%Input)) then + call RegPackBounds(RF, 1, lbound(InData%Input), ubound(InData%Input)) + LB(1:1) = lbound(InData%Input) + UB(1:1) = ubound(InData%Input) + do i1 = LB(1), UB(1) + call AD_PackInput(RF, InData%Input(i1)) + end do + end if + call RegPack(RF, allocated(InData%Input_Saved)) + if (allocated(InData%Input_Saved)) then + call RegPackBounds(RF, 1, lbound(InData%Input_Saved), ubound(InData%Input_Saved)) + LB(1:1) = lbound(InData%Input_Saved) + UB(1:1) = ubound(InData%Input_Saved) + do i1 = LB(1), UB(1) + call AD_PackInput(RF, InData%Input_Saved(i1)) + end do + end if + call RegPackAlloc(RF, InData%InputTimes) + call RegPackAlloc(RF, InData%InputTimes_Saved) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FAST_UnPackAeroDyn_Data(RF, OutData) + type(RegFile), intent(inout) :: RF + type(AeroDyn_Data), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackAeroDyn_Data' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + LB(1:1) = lbound(OutData%x) + UB(1:1) = ubound(OutData%x) + do i1 = LB(1), UB(1) + call AD_UnpackContState(RF, OutData%x(i1)) ! x + end do + LB(1:1) = lbound(OutData%xd) + UB(1:1) = ubound(OutData%xd) + do i1 = LB(1), UB(1) + call AD_UnpackDiscState(RF, OutData%xd(i1)) ! xd + end do + LB(1:1) = lbound(OutData%z) + UB(1:1) = ubound(OutData%z) + do i1 = LB(1), UB(1) + call AD_UnpackConstrState(RF, OutData%z(i1)) ! z + end do + LB(1:1) = lbound(OutData%OtherSt) + UB(1:1) = ubound(OutData%OtherSt) + do i1 = LB(1), UB(1) + call AD_UnpackOtherState(RF, OutData%OtherSt(i1)) ! OtherSt + end do + call AD_UnpackParam(RF, OutData%p) ! p + call AD_UnpackInput(RF, OutData%u) ! u + call AD_UnpackOutput(RF, OutData%y) ! y + call AD_UnpackMisc(RF, OutData%m) ! m + if (allocated(OutData%Output)) deallocate(OutData%Output) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%Output(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AD_UnpackOutput(RF, OutData%Output(i1)) ! Output + end do + end if + call AD_UnpackOutput(RF, OutData%y_interp) ! y_interp + if (allocated(OutData%Input)) deallocate(OutData%Input) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%Input(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AD_UnpackInput(RF, OutData%Input(i1)) ! Input + end do + end if + if (allocated(OutData%Input_Saved)) deallocate(OutData%Input_Saved) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%Input_Saved(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input_Saved.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AD_UnpackInput(RF, OutData%Input_Saved(i1)) ! Input_Saved + end do + end if + call RegUnpackAlloc(RF, OutData%InputTimes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%InputTimes_Saved); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FAST_CopyExtLoads_Data(SrcExtLoads_DataData, DstExtLoads_DataData, CtrlCode, ErrStat, ErrMsg) + type(ExtLoads_Data), intent(inout) :: SrcExtLoads_DataData + type(ExtLoads_Data), intent(inout) :: DstExtLoads_DataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_CopyExtLoads_Data' + ErrStat = ErrID_None + ErrMsg = '' + LB(1:1) = lbound(SrcExtLoads_DataData%x) + UB(1:1) = ubound(SrcExtLoads_DataData%x) + do i1 = LB(1), UB(1) + call ExtLd_CopyContState(SrcExtLoads_DataData%x(i1), DstExtLoads_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + LB(1:1) = lbound(SrcExtLoads_DataData%xd) + UB(1:1) = ubound(SrcExtLoads_DataData%xd) + do i1 = LB(1), UB(1) + call ExtLd_CopyDiscState(SrcExtLoads_DataData%xd(i1), DstExtLoads_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + LB(1:1) = lbound(SrcExtLoads_DataData%z) + UB(1:1) = ubound(SrcExtLoads_DataData%z) + do i1 = LB(1), UB(1) + call ExtLd_CopyConstrState(SrcExtLoads_DataData%z(i1), DstExtLoads_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + LB(1:1) = lbound(SrcExtLoads_DataData%OtherSt) + UB(1:1) = ubound(SrcExtLoads_DataData%OtherSt) + do i1 = LB(1), UB(1) + call ExtLd_CopyOtherState(SrcExtLoads_DataData%OtherSt(i1), DstExtLoads_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + call ExtLd_CopyParam(SrcExtLoads_DataData%p, DstExtLoads_DataData%p, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call ExtLd_CopyInput(SrcExtLoads_DataData%u, DstExtLoads_DataData%u, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call ExtLd_CopyOutput(SrcExtLoads_DataData%y, DstExtLoads_DataData%y, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call ExtLd_CopyMisc(SrcExtLoads_DataData%m, DstExtLoads_DataData%m, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcExtLoads_DataData%InputTimes)) then + LB(1:1) = lbound(SrcExtLoads_DataData%InputTimes) + UB(1:1) = ubound(SrcExtLoads_DataData%InputTimes) + if (.not. allocated(DstExtLoads_DataData%InputTimes)) then + allocate(DstExtLoads_DataData%InputTimes(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstExtLoads_DataData%InputTimes.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstExtLoads_DataData%InputTimes = SrcExtLoads_DataData%InputTimes + end if +end subroutine + +subroutine FAST_DestroyExtLoads_Data(ExtLoads_DataData, ErrStat, ErrMsg) + type(ExtLoads_Data), intent(inout) :: ExtLoads_DataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_DestroyExtLoads_Data' + ErrStat = ErrID_None + ErrMsg = '' + LB(1:1) = lbound(ExtLoads_DataData%x) + UB(1:1) = ubound(ExtLoads_DataData%x) + do i1 = LB(1), UB(1) + call ExtLd_DestroyContState(ExtLoads_DataData%x(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(ExtLoads_DataData%xd) + UB(1:1) = ubound(ExtLoads_DataData%xd) + do i1 = LB(1), UB(1) + call ExtLd_DestroyDiscState(ExtLoads_DataData%xd(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(ExtLoads_DataData%z) + UB(1:1) = ubound(ExtLoads_DataData%z) + do i1 = LB(1), UB(1) + call ExtLd_DestroyConstrState(ExtLoads_DataData%z(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(ExtLoads_DataData%OtherSt) + UB(1:1) = ubound(ExtLoads_DataData%OtherSt) + do i1 = LB(1), UB(1) + call ExtLd_DestroyOtherState(ExtLoads_DataData%OtherSt(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + call ExtLd_DestroyParam(ExtLoads_DataData%p, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call ExtLd_DestroyInput(ExtLoads_DataData%u, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call ExtLd_DestroyOutput(ExtLoads_DataData%y, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call ExtLd_DestroyMisc(ExtLoads_DataData%m, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(ExtLoads_DataData%InputTimes)) then + deallocate(ExtLoads_DataData%InputTimes) + end if +end subroutine + +subroutine FAST_PackExtLoads_Data(RF, Indata) + type(RegFile), intent(inout) :: RF + type(ExtLoads_Data), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackExtLoads_Data' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + if (RF%ErrStat >= AbortErrLev) return + LB(1:1) = lbound(InData%x) + UB(1:1) = ubound(InData%x) + do i1 = LB(1), UB(1) + call ExtLd_PackContState(RF, InData%x(i1)) + end do + LB(1:1) = lbound(InData%xd) + UB(1:1) = ubound(InData%xd) + do i1 = LB(1), UB(1) + call ExtLd_PackDiscState(RF, InData%xd(i1)) + end do + LB(1:1) = lbound(InData%z) + UB(1:1) = ubound(InData%z) + do i1 = LB(1), UB(1) + call ExtLd_PackConstrState(RF, InData%z(i1)) + end do + LB(1:1) = lbound(InData%OtherSt) + UB(1:1) = ubound(InData%OtherSt) + do i1 = LB(1), UB(1) + call ExtLd_PackOtherState(RF, InData%OtherSt(i1)) + end do + call ExtLd_PackParam(RF, InData%p) + call ExtLd_PackInput(RF, InData%u) + call ExtLd_PackOutput(RF, InData%y) + call ExtLd_PackMisc(RF, InData%m) + call RegPackAlloc(RF, InData%InputTimes) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FAST_UnPackExtLoads_Data(RF, OutData) + type(RegFile), intent(inout) :: RF + type(ExtLoads_Data), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackExtLoads_Data' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + LB(1:1) = lbound(OutData%x) + UB(1:1) = ubound(OutData%x) + do i1 = LB(1), UB(1) + call ExtLd_UnpackContState(RF, OutData%x(i1)) ! x + end do + LB(1:1) = lbound(OutData%xd) + UB(1:1) = ubound(OutData%xd) + do i1 = LB(1), UB(1) + call ExtLd_UnpackDiscState(RF, OutData%xd(i1)) ! xd + end do + LB(1:1) = lbound(OutData%z) + UB(1:1) = ubound(OutData%z) + do i1 = LB(1), UB(1) + call ExtLd_UnpackConstrState(RF, OutData%z(i1)) ! z + end do + LB(1:1) = lbound(OutData%OtherSt) + UB(1:1) = ubound(OutData%OtherSt) + do i1 = LB(1), UB(1) + call ExtLd_UnpackOtherState(RF, OutData%OtherSt(i1)) ! OtherSt + end do + call ExtLd_UnpackParam(RF, OutData%p) ! p + call ExtLd_UnpackInput(RF, OutData%u) ! u + call ExtLd_UnpackOutput(RF, OutData%y) ! y + call ExtLd_UnpackMisc(RF, OutData%m) ! m + call RegUnpackAlloc(RF, OutData%InputTimes); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FAST_CopyAeroDisk_Data(SrcAeroDisk_DataData, DstAeroDisk_DataData, CtrlCode, ErrStat, ErrMsg) + type(AeroDisk_Data), intent(inout) :: SrcAeroDisk_DataData + type(AeroDisk_Data), intent(inout) :: DstAeroDisk_DataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_CopyAeroDisk_Data' + ErrStat = ErrID_None + ErrMsg = '' + LB(1:1) = lbound(SrcAeroDisk_DataData%x) + UB(1:1) = ubound(SrcAeroDisk_DataData%x) + do i1 = LB(1), UB(1) + call ADsk_CopyContState(SrcAeroDisk_DataData%x(i1), DstAeroDisk_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + LB(1:1) = lbound(SrcAeroDisk_DataData%xd) + UB(1:1) = ubound(SrcAeroDisk_DataData%xd) + do i1 = LB(1), UB(1) + call ADsk_CopyDiscState(SrcAeroDisk_DataData%xd(i1), DstAeroDisk_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + LB(1:1) = lbound(SrcAeroDisk_DataData%z) + UB(1:1) = ubound(SrcAeroDisk_DataData%z) + do i1 = LB(1), UB(1) + call ADsk_CopyConstrState(SrcAeroDisk_DataData%z(i1), DstAeroDisk_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + LB(1:1) = lbound(SrcAeroDisk_DataData%OtherSt) + UB(1:1) = ubound(SrcAeroDisk_DataData%OtherSt) + do i1 = LB(1), UB(1) + call ADsk_CopyOtherState(SrcAeroDisk_DataData%OtherSt(i1), DstAeroDisk_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + call ADsk_CopyParam(SrcAeroDisk_DataData%p, DstAeroDisk_DataData%p, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call ADsk_CopyInput(SrcAeroDisk_DataData%u, DstAeroDisk_DataData%u, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call ADsk_CopyOutput(SrcAeroDisk_DataData%y, DstAeroDisk_DataData%y, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call ADsk_CopyMisc(SrcAeroDisk_DataData%m, DstAeroDisk_DataData%m, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcAeroDisk_DataData%Output)) then + LB(1:1) = lbound(SrcAeroDisk_DataData%Output) + UB(1:1) = ubound(SrcAeroDisk_DataData%Output) + if (.not. allocated(DstAeroDisk_DataData%Output)) then + allocate(DstAeroDisk_DataData%Output(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstAeroDisk_DataData%Output.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call ADsk_CopyOutput(SrcAeroDisk_DataData%Output(i1), DstAeroDisk_DataData%Output(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call ADsk_CopyOutput(SrcAeroDisk_DataData%y_interp, DstAeroDisk_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcAeroDisk_DataData%Input)) then + LB(1:1) = lbound(SrcAeroDisk_DataData%Input) + UB(1:1) = ubound(SrcAeroDisk_DataData%Input) + if (.not. allocated(DstAeroDisk_DataData%Input)) then + allocate(DstAeroDisk_DataData%Input(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstAeroDisk_DataData%Input.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call ADsk_CopyInput(SrcAeroDisk_DataData%Input(i1), DstAeroDisk_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcAeroDisk_DataData%InputTimes)) then + LB(1:1) = lbound(SrcAeroDisk_DataData%InputTimes) + UB(1:1) = ubound(SrcAeroDisk_DataData%InputTimes) + if (.not. allocated(DstAeroDisk_DataData%InputTimes)) then + allocate(DstAeroDisk_DataData%InputTimes(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstAeroDisk_DataData%InputTimes.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstAeroDisk_DataData%InputTimes = SrcAeroDisk_DataData%InputTimes + end if +end subroutine + +subroutine FAST_DestroyAeroDisk_Data(AeroDisk_DataData, ErrStat, ErrMsg) + type(AeroDisk_Data), intent(inout) :: AeroDisk_DataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_DestroyAeroDisk_Data' + ErrStat = ErrID_None + ErrMsg = '' + LB(1:1) = lbound(AeroDisk_DataData%x) + UB(1:1) = ubound(AeroDisk_DataData%x) + do i1 = LB(1), UB(1) + call ADsk_DestroyContState(AeroDisk_DataData%x(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(AeroDisk_DataData%xd) + UB(1:1) = ubound(AeroDisk_DataData%xd) + do i1 = LB(1), UB(1) + call ADsk_DestroyDiscState(AeroDisk_DataData%xd(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(AeroDisk_DataData%z) + UB(1:1) = ubound(AeroDisk_DataData%z) + do i1 = LB(1), UB(1) + call ADsk_DestroyConstrState(AeroDisk_DataData%z(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(AeroDisk_DataData%OtherSt) + UB(1:1) = ubound(AeroDisk_DataData%OtherSt) + do i1 = LB(1), UB(1) + call ADsk_DestroyOtherState(AeroDisk_DataData%OtherSt(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + call ADsk_DestroyParam(AeroDisk_DataData%p, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call ADsk_DestroyInput(AeroDisk_DataData%u, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call ADsk_DestroyOutput(AeroDisk_DataData%y, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call ADsk_DestroyMisc(AeroDisk_DataData%m, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(AeroDisk_DataData%Output)) then + LB(1:1) = lbound(AeroDisk_DataData%Output) + UB(1:1) = ubound(AeroDisk_DataData%Output) + do i1 = LB(1), UB(1) + call ADsk_DestroyOutput(AeroDisk_DataData%Output(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(AeroDisk_DataData%Output) + end if + call ADsk_DestroyOutput(AeroDisk_DataData%y_interp, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(AeroDisk_DataData%Input)) then + LB(1:1) = lbound(AeroDisk_DataData%Input) + UB(1:1) = ubound(AeroDisk_DataData%Input) + do i1 = LB(1), UB(1) + call ADsk_DestroyInput(AeroDisk_DataData%Input(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(AeroDisk_DataData%Input) + end if + if (allocated(AeroDisk_DataData%InputTimes)) then + deallocate(AeroDisk_DataData%InputTimes) + end if +end subroutine + +subroutine FAST_PackAeroDisk_Data(RF, Indata) + type(RegFile), intent(inout) :: RF + type(AeroDisk_Data), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackAeroDisk_Data' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + if (RF%ErrStat >= AbortErrLev) return + LB(1:1) = lbound(InData%x) + UB(1:1) = ubound(InData%x) + do i1 = LB(1), UB(1) + call ADsk_PackContState(RF, InData%x(i1)) + end do + LB(1:1) = lbound(InData%xd) + UB(1:1) = ubound(InData%xd) + do i1 = LB(1), UB(1) + call ADsk_PackDiscState(RF, InData%xd(i1)) + end do + LB(1:1) = lbound(InData%z) + UB(1:1) = ubound(InData%z) + do i1 = LB(1), UB(1) + call ADsk_PackConstrState(RF, InData%z(i1)) + end do + LB(1:1) = lbound(InData%OtherSt) + UB(1:1) = ubound(InData%OtherSt) + do i1 = LB(1), UB(1) + call ADsk_PackOtherState(RF, InData%OtherSt(i1)) + end do + call ADsk_PackParam(RF, InData%p) + call ADsk_PackInput(RF, InData%u) + call ADsk_PackOutput(RF, InData%y) + call ADsk_PackMisc(RF, InData%m) + call RegPack(RF, allocated(InData%Output)) + if (allocated(InData%Output)) then + call RegPackBounds(RF, 1, lbound(InData%Output), ubound(InData%Output)) + LB(1:1) = lbound(InData%Output) + UB(1:1) = ubound(InData%Output) + do i1 = LB(1), UB(1) + call ADsk_PackOutput(RF, InData%Output(i1)) + end do + end if + call ADsk_PackOutput(RF, InData%y_interp) + call RegPack(RF, allocated(InData%Input)) + if (allocated(InData%Input)) then + call RegPackBounds(RF, 1, lbound(InData%Input), ubound(InData%Input)) + LB(1:1) = lbound(InData%Input) + UB(1:1) = ubound(InData%Input) + do i1 = LB(1), UB(1) + call ADsk_PackInput(RF, InData%Input(i1)) + end do + end if + call RegPackAlloc(RF, InData%InputTimes) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FAST_UnPackAeroDisk_Data(RF, OutData) + type(RegFile), intent(inout) :: RF + type(AeroDisk_Data), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackAeroDisk_Data' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + LB(1:1) = lbound(OutData%x) + UB(1:1) = ubound(OutData%x) + do i1 = LB(1), UB(1) + call ADsk_UnpackContState(RF, OutData%x(i1)) ! x + end do + LB(1:1) = lbound(OutData%xd) + UB(1:1) = ubound(OutData%xd) + do i1 = LB(1), UB(1) + call ADsk_UnpackDiscState(RF, OutData%xd(i1)) ! xd + end do + LB(1:1) = lbound(OutData%z) + UB(1:1) = ubound(OutData%z) + do i1 = LB(1), UB(1) + call ADsk_UnpackConstrState(RF, OutData%z(i1)) ! z + end do + LB(1:1) = lbound(OutData%OtherSt) + UB(1:1) = ubound(OutData%OtherSt) + do i1 = LB(1), UB(1) + call ADsk_UnpackOtherState(RF, OutData%OtherSt(i1)) ! OtherSt + end do + call ADsk_UnpackParam(RF, OutData%p) ! p + call ADsk_UnpackInput(RF, OutData%u) ! u + call ADsk_UnpackOutput(RF, OutData%y) ! y + call ADsk_UnpackMisc(RF, OutData%m) ! m + if (allocated(OutData%Output)) deallocate(OutData%Output) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%Output(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call ADsk_UnpackOutput(RF, OutData%Output(i1)) ! Output + end do + end if + call ADsk_UnpackOutput(RF, OutData%y_interp) ! y_interp + if (allocated(OutData%Input)) deallocate(OutData%Input) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%Input(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call ADsk_UnpackInput(RF, OutData%Input(i1)) ! Input + end do + end if + call RegUnpackAlloc(RF, OutData%InputTimes); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FAST_CopyInflowWind_Data(SrcInflowWind_DataData, DstInflowWind_DataData, CtrlCode, ErrStat, ErrMsg) + type(InflowWind_Data), intent(in) :: SrcInflowWind_DataData + type(InflowWind_Data), intent(inout) :: DstInflowWind_DataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_CopyInflowWind_Data' + ErrStat = ErrID_None + ErrMsg = '' + LB(1:1) = lbound(SrcInflowWind_DataData%x) + UB(1:1) = ubound(SrcInflowWind_DataData%x) + do i1 = LB(1), UB(1) + call InflowWind_CopyContState(SrcInflowWind_DataData%x(i1), DstInflowWind_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + LB(1:1) = lbound(SrcInflowWind_DataData%xd) + UB(1:1) = ubound(SrcInflowWind_DataData%xd) + do i1 = LB(1), UB(1) + call InflowWind_CopyDiscState(SrcInflowWind_DataData%xd(i1), DstInflowWind_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + LB(1:1) = lbound(SrcInflowWind_DataData%z) + UB(1:1) = ubound(SrcInflowWind_DataData%z) + do i1 = LB(1), UB(1) + call InflowWind_CopyConstrState(SrcInflowWind_DataData%z(i1), DstInflowWind_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + LB(1:1) = lbound(SrcInflowWind_DataData%OtherSt) + UB(1:1) = ubound(SrcInflowWind_DataData%OtherSt) + do i1 = LB(1), UB(1) + call InflowWind_CopyOtherState(SrcInflowWind_DataData%OtherSt(i1), DstInflowWind_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + call InflowWind_CopyParam(SrcInflowWind_DataData%p, DstInflowWind_DataData%p, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call InflowWind_CopyInput(SrcInflowWind_DataData%u, DstInflowWind_DataData%u, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call InflowWind_CopyOutput(SrcInflowWind_DataData%y, DstInflowWind_DataData%y, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call InflowWind_CopyMisc(SrcInflowWind_DataData%m, DstInflowWind_DataData%m, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcInflowWind_DataData%Output)) then + LB(1:1) = lbound(SrcInflowWind_DataData%Output) + UB(1:1) = ubound(SrcInflowWind_DataData%Output) + if (.not. allocated(DstInflowWind_DataData%Output)) then + allocate(DstInflowWind_DataData%Output(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInflowWind_DataData%Output.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call InflowWind_CopyOutput(SrcInflowWind_DataData%Output(i1), DstInflowWind_DataData%Output(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call InflowWind_CopyOutput(SrcInflowWind_DataData%y_interp, DstInflowWind_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcInflowWind_DataData%Input)) then + LB(1:1) = lbound(SrcInflowWind_DataData%Input) + UB(1:1) = ubound(SrcInflowWind_DataData%Input) + if (.not. allocated(DstInflowWind_DataData%Input)) then + allocate(DstInflowWind_DataData%Input(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInflowWind_DataData%Input.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call InflowWind_CopyInput(SrcInflowWind_DataData%Input(i1), DstInflowWind_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcInflowWind_DataData%Input_Saved)) then + LB(1:1) = lbound(SrcInflowWind_DataData%Input_Saved) + UB(1:1) = ubound(SrcInflowWind_DataData%Input_Saved) + if (.not. allocated(DstInflowWind_DataData%Input_Saved)) then + allocate(DstInflowWind_DataData%Input_Saved(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInflowWind_DataData%Input_Saved.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call InflowWind_CopyInput(SrcInflowWind_DataData%Input_Saved(i1), DstInflowWind_DataData%Input_Saved(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcInflowWind_DataData%InputTimes)) then + LB(1:1) = lbound(SrcInflowWind_DataData%InputTimes) + UB(1:1) = ubound(SrcInflowWind_DataData%InputTimes) + if (.not. allocated(DstInflowWind_DataData%InputTimes)) then + allocate(DstInflowWind_DataData%InputTimes(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInflowWind_DataData%InputTimes.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInflowWind_DataData%InputTimes = SrcInflowWind_DataData%InputTimes + end if + if (allocated(SrcInflowWind_DataData%InputTimes_Saved)) then + LB(1:1) = lbound(SrcInflowWind_DataData%InputTimes_Saved) + UB(1:1) = ubound(SrcInflowWind_DataData%InputTimes_Saved) + if (.not. allocated(DstInflowWind_DataData%InputTimes_Saved)) then + allocate(DstInflowWind_DataData%InputTimes_Saved(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInflowWind_DataData%InputTimes_Saved.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInflowWind_DataData%InputTimes_Saved = SrcInflowWind_DataData%InputTimes_Saved + end if +end subroutine + +subroutine FAST_DestroyInflowWind_Data(InflowWind_DataData, ErrStat, ErrMsg) + type(InflowWind_Data), intent(inout) :: InflowWind_DataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_DestroyInflowWind_Data' + ErrStat = ErrID_None + ErrMsg = '' + LB(1:1) = lbound(InflowWind_DataData%x) + UB(1:1) = ubound(InflowWind_DataData%x) + do i1 = LB(1), UB(1) + call InflowWind_DestroyContState(InflowWind_DataData%x(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(InflowWind_DataData%xd) + UB(1:1) = ubound(InflowWind_DataData%xd) + do i1 = LB(1), UB(1) + call InflowWind_DestroyDiscState(InflowWind_DataData%xd(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(InflowWind_DataData%z) + UB(1:1) = ubound(InflowWind_DataData%z) + do i1 = LB(1), UB(1) + call InflowWind_DestroyConstrState(InflowWind_DataData%z(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(InflowWind_DataData%OtherSt) + UB(1:1) = ubound(InflowWind_DataData%OtherSt) + do i1 = LB(1), UB(1) + call InflowWind_DestroyOtherState(InflowWind_DataData%OtherSt(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + call InflowWind_DestroyParam(InflowWind_DataData%p, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call InflowWind_DestroyInput(InflowWind_DataData%u, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call InflowWind_DestroyOutput(InflowWind_DataData%y, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call InflowWind_DestroyMisc(InflowWind_DataData%m, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(InflowWind_DataData%Output)) then + LB(1:1) = lbound(InflowWind_DataData%Output) + UB(1:1) = ubound(InflowWind_DataData%Output) + do i1 = LB(1), UB(1) + call InflowWind_DestroyOutput(InflowWind_DataData%Output(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InflowWind_DataData%Output) + end if + call InflowWind_DestroyOutput(InflowWind_DataData%y_interp, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(InflowWind_DataData%Input)) then + LB(1:1) = lbound(InflowWind_DataData%Input) + UB(1:1) = ubound(InflowWind_DataData%Input) + do i1 = LB(1), UB(1) + call InflowWind_DestroyInput(InflowWind_DataData%Input(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InflowWind_DataData%Input) + end if + if (allocated(InflowWind_DataData%Input_Saved)) then + LB(1:1) = lbound(InflowWind_DataData%Input_Saved) + UB(1:1) = ubound(InflowWind_DataData%Input_Saved) + do i1 = LB(1), UB(1) + call InflowWind_DestroyInput(InflowWind_DataData%Input_Saved(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InflowWind_DataData%Input_Saved) + end if + if (allocated(InflowWind_DataData%InputTimes)) then + deallocate(InflowWind_DataData%InputTimes) + end if + if (allocated(InflowWind_DataData%InputTimes_Saved)) then + deallocate(InflowWind_DataData%InputTimes_Saved) + end if +end subroutine + +subroutine FAST_PackInflowWind_Data(RF, Indata) + type(RegFile), intent(inout) :: RF + type(InflowWind_Data), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackInflowWind_Data' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + if (RF%ErrStat >= AbortErrLev) return + LB(1:1) = lbound(InData%x) + UB(1:1) = ubound(InData%x) + do i1 = LB(1), UB(1) + call InflowWind_PackContState(RF, InData%x(i1)) + end do + LB(1:1) = lbound(InData%xd) + UB(1:1) = ubound(InData%xd) + do i1 = LB(1), UB(1) + call InflowWind_PackDiscState(RF, InData%xd(i1)) + end do + LB(1:1) = lbound(InData%z) + UB(1:1) = ubound(InData%z) + do i1 = LB(1), UB(1) + call InflowWind_PackConstrState(RF, InData%z(i1)) + end do + LB(1:1) = lbound(InData%OtherSt) + UB(1:1) = ubound(InData%OtherSt) + do i1 = LB(1), UB(1) + call InflowWind_PackOtherState(RF, InData%OtherSt(i1)) + end do + call InflowWind_PackParam(RF, InData%p) + call InflowWind_PackInput(RF, InData%u) + call InflowWind_PackOutput(RF, InData%y) + call InflowWind_PackMisc(RF, InData%m) + call RegPack(RF, allocated(InData%Output)) + if (allocated(InData%Output)) then + call RegPackBounds(RF, 1, lbound(InData%Output), ubound(InData%Output)) + LB(1:1) = lbound(InData%Output) + UB(1:1) = ubound(InData%Output) + do i1 = LB(1), UB(1) + call InflowWind_PackOutput(RF, InData%Output(i1)) + end do + end if + call InflowWind_PackOutput(RF, InData%y_interp) + call RegPack(RF, allocated(InData%Input)) + if (allocated(InData%Input)) then + call RegPackBounds(RF, 1, lbound(InData%Input), ubound(InData%Input)) + LB(1:1) = lbound(InData%Input) + UB(1:1) = ubound(InData%Input) + do i1 = LB(1), UB(1) + call InflowWind_PackInput(RF, InData%Input(i1)) + end do + end if + call RegPack(RF, allocated(InData%Input_Saved)) + if (allocated(InData%Input_Saved)) then + call RegPackBounds(RF, 1, lbound(InData%Input_Saved), ubound(InData%Input_Saved)) + LB(1:1) = lbound(InData%Input_Saved) + UB(1:1) = ubound(InData%Input_Saved) + do i1 = LB(1), UB(1) + call InflowWind_PackInput(RF, InData%Input_Saved(i1)) + end do + end if + call RegPackAlloc(RF, InData%InputTimes) + call RegPackAlloc(RF, InData%InputTimes_Saved) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FAST_UnPackInflowWind_Data(RF, OutData) + type(RegFile), intent(inout) :: RF + type(InflowWind_Data), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackInflowWind_Data' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + LB(1:1) = lbound(OutData%x) + UB(1:1) = ubound(OutData%x) + do i1 = LB(1), UB(1) + call InflowWind_UnpackContState(RF, OutData%x(i1)) ! x + end do + LB(1:1) = lbound(OutData%xd) + UB(1:1) = ubound(OutData%xd) + do i1 = LB(1), UB(1) + call InflowWind_UnpackDiscState(RF, OutData%xd(i1)) ! xd + end do + LB(1:1) = lbound(OutData%z) + UB(1:1) = ubound(OutData%z) + do i1 = LB(1), UB(1) + call InflowWind_UnpackConstrState(RF, OutData%z(i1)) ! z + end do + LB(1:1) = lbound(OutData%OtherSt) + UB(1:1) = ubound(OutData%OtherSt) + do i1 = LB(1), UB(1) + call InflowWind_UnpackOtherState(RF, OutData%OtherSt(i1)) ! OtherSt + end do + call InflowWind_UnpackParam(RF, OutData%p) ! p + call InflowWind_UnpackInput(RF, OutData%u) ! u + call InflowWind_UnpackOutput(RF, OutData%y) ! y + call InflowWind_UnpackMisc(RF, OutData%m) ! m + if (allocated(OutData%Output)) deallocate(OutData%Output) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%Output(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call InflowWind_UnpackOutput(RF, OutData%Output(i1)) ! Output + end do + end if + call InflowWind_UnpackOutput(RF, OutData%y_interp) ! y_interp + if (allocated(OutData%Input)) deallocate(OutData%Input) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%Input(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call InflowWind_UnpackInput(RF, OutData%Input(i1)) ! Input + end do + end if + if (allocated(OutData%Input_Saved)) deallocate(OutData%Input_Saved) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%Input_Saved(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input_Saved.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call InflowWind_UnpackInput(RF, OutData%Input_Saved(i1)) ! Input_Saved + end do + end if + call RegUnpackAlloc(RF, OutData%InputTimes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%InputTimes_Saved); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FAST_CopyExternalInflow_Data(SrcExternalInflow_DataData, DstExternalInflow_DataData, CtrlCode, ErrStat, ErrMsg) + type(ExternalInflow_Data), intent(inout) :: SrcExternalInflow_DataData + type(ExternalInflow_Data), intent(inout) :: DstExternalInflow_DataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_CopyExternalInflow_Data' + ErrStat = ErrID_None + ErrMsg = '' + call ExtInfw_CopyInput(SrcExternalInflow_DataData%u, DstExternalInflow_DataData%u, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call ExtInfw_CopyOutput(SrcExternalInflow_DataData%y, DstExternalInflow_DataData%y, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call ExtInfw_CopyParam(SrcExternalInflow_DataData%p, DstExternalInflow_DataData%p, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call ExtInfw_CopyMisc(SrcExternalInflow_DataData%m, DstExternalInflow_DataData%m, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine FAST_DestroyExternalInflow_Data(ExternalInflow_DataData, ErrStat, ErrMsg) + type(ExternalInflow_Data), intent(inout) :: ExternalInflow_DataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_DestroyExternalInflow_Data' + ErrStat = ErrID_None + ErrMsg = '' + call ExtInfw_DestroyInput(ExternalInflow_DataData%u, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call ExtInfw_DestroyOutput(ExternalInflow_DataData%y, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call ExtInfw_DestroyParam(ExternalInflow_DataData%p, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call ExtInfw_DestroyMisc(ExternalInflow_DataData%m, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine FAST_PackExternalInflow_Data(RF, Indata) + type(RegFile), intent(inout) :: RF + type(ExternalInflow_Data), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackExternalInflow_Data' + if (RF%ErrStat >= AbortErrLev) return + call ExtInfw_PackInput(RF, InData%u) + call ExtInfw_PackOutput(RF, InData%y) + call ExtInfw_PackParam(RF, InData%p) + call ExtInfw_PackMisc(RF, InData%m) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FAST_UnPackExternalInflow_Data(RF, OutData) + type(RegFile), intent(inout) :: RF + type(ExternalInflow_Data), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackExternalInflow_Data' + if (RF%ErrStat /= ErrID_None) return + call ExtInfw_UnpackInput(RF, OutData%u) ! u + call ExtInfw_UnpackOutput(RF, OutData%y) ! y + call ExtInfw_UnpackParam(RF, OutData%p) ! p + call ExtInfw_UnpackMisc(RF, OutData%m) ! m +end subroutine + +subroutine FAST_CopySCDataEx_Data(SrcSCDataEx_DataData, DstSCDataEx_DataData, CtrlCode, ErrStat, ErrMsg) + type(SCDataEx_Data), intent(in) :: SrcSCDataEx_DataData + type(SCDataEx_Data), intent(inout) :: DstSCDataEx_DataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_CopySCDataEx_Data' + ErrStat = ErrID_None + ErrMsg = '' + call SC_DX_CopyInput(SrcSCDataEx_DataData%u, DstSCDataEx_DataData%u, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SC_DX_CopyOutput(SrcSCDataEx_DataData%y, DstSCDataEx_DataData%y, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SC_DX_CopyParam(SrcSCDataEx_DataData%p, DstSCDataEx_DataData%p, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine FAST_DestroySCDataEx_Data(SCDataEx_DataData, ErrStat, ErrMsg) + type(SCDataEx_Data), intent(inout) :: SCDataEx_DataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_DestroySCDataEx_Data' + ErrStat = ErrID_None + ErrMsg = '' + call SC_DX_DestroyInput(SCDataEx_DataData%u, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SC_DX_DestroyOutput(SCDataEx_DataData%y, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SC_DX_DestroyParam(SCDataEx_DataData%p, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine FAST_PackSCDataEx_Data(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SCDataEx_Data), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackSCDataEx_Data' + if (RF%ErrStat >= AbortErrLev) return + call SC_DX_PackInput(RF, InData%u) + call SC_DX_PackOutput(RF, InData%y) + call SC_DX_PackParam(RF, InData%p) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FAST_UnPackSCDataEx_Data(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SCDataEx_Data), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackSCDataEx_Data' + if (RF%ErrStat /= ErrID_None) return + call SC_DX_UnpackInput(RF, OutData%u) ! u + call SC_DX_UnpackOutput(RF, OutData%y) ! y + call SC_DX_UnpackParam(RF, OutData%p) ! p +end subroutine + +subroutine FAST_CopySubDyn_Data(SrcSubDyn_DataData, DstSubDyn_DataData, CtrlCode, ErrStat, ErrMsg) + type(SubDyn_Data), intent(inout) :: SrcSubDyn_DataData + type(SubDyn_Data), intent(inout) :: DstSubDyn_DataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_CopySubDyn_Data' + ErrStat = ErrID_None + ErrMsg = '' + LB(1:1) = lbound(SrcSubDyn_DataData%x) + UB(1:1) = ubound(SrcSubDyn_DataData%x) + do i1 = LB(1), UB(1) + call SD_CopyContState(SrcSubDyn_DataData%x(i1), DstSubDyn_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + LB(1:1) = lbound(SrcSubDyn_DataData%xd) + UB(1:1) = ubound(SrcSubDyn_DataData%xd) + do i1 = LB(1), UB(1) + call SD_CopyDiscState(SrcSubDyn_DataData%xd(i1), DstSubDyn_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + LB(1:1) = lbound(SrcSubDyn_DataData%z) + UB(1:1) = ubound(SrcSubDyn_DataData%z) + do i1 = LB(1), UB(1) + call SD_CopyConstrState(SrcSubDyn_DataData%z(i1), DstSubDyn_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + LB(1:1) = lbound(SrcSubDyn_DataData%OtherSt) + UB(1:1) = ubound(SrcSubDyn_DataData%OtherSt) + do i1 = LB(1), UB(1) + call SD_CopyOtherState(SrcSubDyn_DataData%OtherSt(i1), DstSubDyn_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + call SD_CopyParam(SrcSubDyn_DataData%p, DstSubDyn_DataData%p, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SD_CopyInput(SrcSubDyn_DataData%u, DstSubDyn_DataData%u, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SD_CopyOutput(SrcSubDyn_DataData%y, DstSubDyn_DataData%y, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SD_CopyMisc(SrcSubDyn_DataData%m, DstSubDyn_DataData%m, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcSubDyn_DataData%Input)) then + LB(1:1) = lbound(SrcSubDyn_DataData%Input) + UB(1:1) = ubound(SrcSubDyn_DataData%Input) + if (.not. allocated(DstSubDyn_DataData%Input)) then + allocate(DstSubDyn_DataData%Input(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstSubDyn_DataData%Input.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call SD_CopyInput(SrcSubDyn_DataData%Input(i1), DstSubDyn_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcSubDyn_DataData%Input_Saved)) then + LB(1:1) = lbound(SrcSubDyn_DataData%Input_Saved) + UB(1:1) = ubound(SrcSubDyn_DataData%Input_Saved) + if (.not. allocated(DstSubDyn_DataData%Input_Saved)) then + allocate(DstSubDyn_DataData%Input_Saved(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstSubDyn_DataData%Input_Saved.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call SD_CopyInput(SrcSubDyn_DataData%Input_Saved(i1), DstSubDyn_DataData%Input_Saved(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcSubDyn_DataData%Output)) then + LB(1:1) = lbound(SrcSubDyn_DataData%Output) + UB(1:1) = ubound(SrcSubDyn_DataData%Output) + if (.not. allocated(DstSubDyn_DataData%Output)) then + allocate(DstSubDyn_DataData%Output(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstSubDyn_DataData%Output.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call SD_CopyOutput(SrcSubDyn_DataData%Output(i1), DstSubDyn_DataData%Output(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call SD_CopyOutput(SrcSubDyn_DataData%y_interp, DstSubDyn_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcSubDyn_DataData%InputTimes)) then + LB(1:1) = lbound(SrcSubDyn_DataData%InputTimes) + UB(1:1) = ubound(SrcSubDyn_DataData%InputTimes) + if (.not. allocated(DstSubDyn_DataData%InputTimes)) then + allocate(DstSubDyn_DataData%InputTimes(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstSubDyn_DataData%InputTimes.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstSubDyn_DataData%InputTimes = SrcSubDyn_DataData%InputTimes + end if + if (allocated(SrcSubDyn_DataData%InputTimes_Saved)) then + LB(1:1) = lbound(SrcSubDyn_DataData%InputTimes_Saved) + UB(1:1) = ubound(SrcSubDyn_DataData%InputTimes_Saved) + if (.not. allocated(DstSubDyn_DataData%InputTimes_Saved)) then + allocate(DstSubDyn_DataData%InputTimes_Saved(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstSubDyn_DataData%InputTimes_Saved.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstSubDyn_DataData%InputTimes_Saved = SrcSubDyn_DataData%InputTimes_Saved + end if +end subroutine + +subroutine FAST_DestroySubDyn_Data(SubDyn_DataData, ErrStat, ErrMsg) + type(SubDyn_Data), intent(inout) :: SubDyn_DataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_DestroySubDyn_Data' + ErrStat = ErrID_None + ErrMsg = '' + LB(1:1) = lbound(SubDyn_DataData%x) + UB(1:1) = ubound(SubDyn_DataData%x) + do i1 = LB(1), UB(1) + call SD_DestroyContState(SubDyn_DataData%x(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(SubDyn_DataData%xd) + UB(1:1) = ubound(SubDyn_DataData%xd) + do i1 = LB(1), UB(1) + call SD_DestroyDiscState(SubDyn_DataData%xd(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(SubDyn_DataData%z) + UB(1:1) = ubound(SubDyn_DataData%z) + do i1 = LB(1), UB(1) + call SD_DestroyConstrState(SubDyn_DataData%z(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(SubDyn_DataData%OtherSt) + UB(1:1) = ubound(SubDyn_DataData%OtherSt) + do i1 = LB(1), UB(1) + call SD_DestroyOtherState(SubDyn_DataData%OtherSt(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + call SD_DestroyParam(SubDyn_DataData%p, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SD_DestroyInput(SubDyn_DataData%u, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SD_DestroyOutput(SubDyn_DataData%y, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SD_DestroyMisc(SubDyn_DataData%m, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(SubDyn_DataData%Input)) then + LB(1:1) = lbound(SubDyn_DataData%Input) + UB(1:1) = ubound(SubDyn_DataData%Input) + do i1 = LB(1), UB(1) + call SD_DestroyInput(SubDyn_DataData%Input(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(SubDyn_DataData%Input) + end if + if (allocated(SubDyn_DataData%Input_Saved)) then + LB(1:1) = lbound(SubDyn_DataData%Input_Saved) + UB(1:1) = ubound(SubDyn_DataData%Input_Saved) + do i1 = LB(1), UB(1) + call SD_DestroyInput(SubDyn_DataData%Input_Saved(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(SubDyn_DataData%Input_Saved) + end if + if (allocated(SubDyn_DataData%Output)) then + LB(1:1) = lbound(SubDyn_DataData%Output) + UB(1:1) = ubound(SubDyn_DataData%Output) + do i1 = LB(1), UB(1) + call SD_DestroyOutput(SubDyn_DataData%Output(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(SubDyn_DataData%Output) + end if + call SD_DestroyOutput(SubDyn_DataData%y_interp, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(SubDyn_DataData%InputTimes)) then + deallocate(SubDyn_DataData%InputTimes) + end if + if (allocated(SubDyn_DataData%InputTimes_Saved)) then + deallocate(SubDyn_DataData%InputTimes_Saved) + end if +end subroutine + +subroutine FAST_PackSubDyn_Data(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SubDyn_Data), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackSubDyn_Data' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + if (RF%ErrStat >= AbortErrLev) return + LB(1:1) = lbound(InData%x) + UB(1:1) = ubound(InData%x) + do i1 = LB(1), UB(1) + call SD_PackContState(RF, InData%x(i1)) + end do + LB(1:1) = lbound(InData%xd) + UB(1:1) = ubound(InData%xd) + do i1 = LB(1), UB(1) + call SD_PackDiscState(RF, InData%xd(i1)) + end do + LB(1:1) = lbound(InData%z) + UB(1:1) = ubound(InData%z) + do i1 = LB(1), UB(1) + call SD_PackConstrState(RF, InData%z(i1)) + end do + LB(1:1) = lbound(InData%OtherSt) + UB(1:1) = ubound(InData%OtherSt) + do i1 = LB(1), UB(1) + call SD_PackOtherState(RF, InData%OtherSt(i1)) + end do + call SD_PackParam(RF, InData%p) + call SD_PackInput(RF, InData%u) + call SD_PackOutput(RF, InData%y) + call SD_PackMisc(RF, InData%m) + call RegPack(RF, allocated(InData%Input)) + if (allocated(InData%Input)) then + call RegPackBounds(RF, 1, lbound(InData%Input), ubound(InData%Input)) + LB(1:1) = lbound(InData%Input) + UB(1:1) = ubound(InData%Input) + do i1 = LB(1), UB(1) + call SD_PackInput(RF, InData%Input(i1)) + end do + end if + call RegPack(RF, allocated(InData%Input_Saved)) + if (allocated(InData%Input_Saved)) then + call RegPackBounds(RF, 1, lbound(InData%Input_Saved), ubound(InData%Input_Saved)) + LB(1:1) = lbound(InData%Input_Saved) + UB(1:1) = ubound(InData%Input_Saved) + do i1 = LB(1), UB(1) + call SD_PackInput(RF, InData%Input_Saved(i1)) + end do + end if + call RegPack(RF, allocated(InData%Output)) + if (allocated(InData%Output)) then + call RegPackBounds(RF, 1, lbound(InData%Output), ubound(InData%Output)) + LB(1:1) = lbound(InData%Output) + UB(1:1) = ubound(InData%Output) + do i1 = LB(1), UB(1) + call SD_PackOutput(RF, InData%Output(i1)) + end do + end if + call SD_PackOutput(RF, InData%y_interp) + call RegPackAlloc(RF, InData%InputTimes) + call RegPackAlloc(RF, InData%InputTimes_Saved) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FAST_UnPackSubDyn_Data(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SubDyn_Data), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackSubDyn_Data' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + LB(1:1) = lbound(OutData%x) + UB(1:1) = ubound(OutData%x) + do i1 = LB(1), UB(1) + call SD_UnpackContState(RF, OutData%x(i1)) ! x + end do + LB(1:1) = lbound(OutData%xd) + UB(1:1) = ubound(OutData%xd) + do i1 = LB(1), UB(1) + call SD_UnpackDiscState(RF, OutData%xd(i1)) ! xd + end do + LB(1:1) = lbound(OutData%z) + UB(1:1) = ubound(OutData%z) + do i1 = LB(1), UB(1) + call SD_UnpackConstrState(RF, OutData%z(i1)) ! z + end do + LB(1:1) = lbound(OutData%OtherSt) + UB(1:1) = ubound(OutData%OtherSt) + do i1 = LB(1), UB(1) + call SD_UnpackOtherState(RF, OutData%OtherSt(i1)) ! OtherSt + end do + call SD_UnpackParam(RF, OutData%p) ! p + call SD_UnpackInput(RF, OutData%u) ! u + call SD_UnpackOutput(RF, OutData%y) ! y + call SD_UnpackMisc(RF, OutData%m) ! m + if (allocated(OutData%Input)) deallocate(OutData%Input) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%Input(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SD_UnpackInput(RF, OutData%Input(i1)) ! Input + end do + end if + if (allocated(OutData%Input_Saved)) deallocate(OutData%Input_Saved) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%Input_Saved(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input_Saved.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SD_UnpackInput(RF, OutData%Input_Saved(i1)) ! Input_Saved + end do + end if + if (allocated(OutData%Output)) deallocate(OutData%Output) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%Output(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SD_UnpackOutput(RF, OutData%Output(i1)) ! Output + end do + end if + call SD_UnpackOutput(RF, OutData%y_interp) ! y_interp + call RegUnpackAlloc(RF, OutData%InputTimes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%InputTimes_Saved); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FAST_CopyExtPtfm_Data(SrcExtPtfm_DataData, DstExtPtfm_DataData, CtrlCode, ErrStat, ErrMsg) + type(ExtPtfm_Data), intent(inout) :: SrcExtPtfm_DataData + type(ExtPtfm_Data), intent(inout) :: DstExtPtfm_DataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_CopyExtPtfm_Data' + ErrStat = ErrID_None + ErrMsg = '' + LB(1:1) = lbound(SrcExtPtfm_DataData%x) + UB(1:1) = ubound(SrcExtPtfm_DataData%x) + do i1 = LB(1), UB(1) + call ExtPtfm_CopyContState(SrcExtPtfm_DataData%x(i1), DstExtPtfm_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + LB(1:1) = lbound(SrcExtPtfm_DataData%xd) + UB(1:1) = ubound(SrcExtPtfm_DataData%xd) + do i1 = LB(1), UB(1) + call ExtPtfm_CopyDiscState(SrcExtPtfm_DataData%xd(i1), DstExtPtfm_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + LB(1:1) = lbound(SrcExtPtfm_DataData%z) + UB(1:1) = ubound(SrcExtPtfm_DataData%z) + do i1 = LB(1), UB(1) + call ExtPtfm_CopyConstrState(SrcExtPtfm_DataData%z(i1), DstExtPtfm_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + LB(1:1) = lbound(SrcExtPtfm_DataData%OtherSt) + UB(1:1) = ubound(SrcExtPtfm_DataData%OtherSt) + do i1 = LB(1), UB(1) + call ExtPtfm_CopyOtherState(SrcExtPtfm_DataData%OtherSt(i1), DstExtPtfm_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + call ExtPtfm_CopyParam(SrcExtPtfm_DataData%p, DstExtPtfm_DataData%p, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call ExtPtfm_CopyInput(SrcExtPtfm_DataData%u, DstExtPtfm_DataData%u, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call ExtPtfm_CopyOutput(SrcExtPtfm_DataData%y, DstExtPtfm_DataData%y, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call ExtPtfm_CopyMisc(SrcExtPtfm_DataData%m, DstExtPtfm_DataData%m, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcExtPtfm_DataData%Input)) then + LB(1:1) = lbound(SrcExtPtfm_DataData%Input) + UB(1:1) = ubound(SrcExtPtfm_DataData%Input) + if (.not. allocated(DstExtPtfm_DataData%Input)) then + allocate(DstExtPtfm_DataData%Input(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstExtPtfm_DataData%Input.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call ExtPtfm_CopyInput(SrcExtPtfm_DataData%Input(i1), DstExtPtfm_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcExtPtfm_DataData%Input_Saved)) then + LB(1:1) = lbound(SrcExtPtfm_DataData%Input_Saved) + UB(1:1) = ubound(SrcExtPtfm_DataData%Input_Saved) + if (.not. allocated(DstExtPtfm_DataData%Input_Saved)) then + allocate(DstExtPtfm_DataData%Input_Saved(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstExtPtfm_DataData%Input_Saved.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call ExtPtfm_CopyInput(SrcExtPtfm_DataData%Input_Saved(i1), DstExtPtfm_DataData%Input_Saved(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcExtPtfm_DataData%InputTimes)) then + LB(1:1) = lbound(SrcExtPtfm_DataData%InputTimes) + UB(1:1) = ubound(SrcExtPtfm_DataData%InputTimes) + if (.not. allocated(DstExtPtfm_DataData%InputTimes)) then + allocate(DstExtPtfm_DataData%InputTimes(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstExtPtfm_DataData%InputTimes.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstExtPtfm_DataData%InputTimes = SrcExtPtfm_DataData%InputTimes + end if + if (allocated(SrcExtPtfm_DataData%InputTimes_Saved)) then + LB(1:1) = lbound(SrcExtPtfm_DataData%InputTimes_Saved) + UB(1:1) = ubound(SrcExtPtfm_DataData%InputTimes_Saved) + if (.not. allocated(DstExtPtfm_DataData%InputTimes_Saved)) then + allocate(DstExtPtfm_DataData%InputTimes_Saved(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstExtPtfm_DataData%InputTimes_Saved.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstExtPtfm_DataData%InputTimes_Saved = SrcExtPtfm_DataData%InputTimes_Saved + end if +end subroutine + +subroutine FAST_DestroyExtPtfm_Data(ExtPtfm_DataData, ErrStat, ErrMsg) + type(ExtPtfm_Data), intent(inout) :: ExtPtfm_DataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_DestroyExtPtfm_Data' + ErrStat = ErrID_None + ErrMsg = '' + LB(1:1) = lbound(ExtPtfm_DataData%x) + UB(1:1) = ubound(ExtPtfm_DataData%x) + do i1 = LB(1), UB(1) + call ExtPtfm_DestroyContState(ExtPtfm_DataData%x(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(ExtPtfm_DataData%xd) + UB(1:1) = ubound(ExtPtfm_DataData%xd) + do i1 = LB(1), UB(1) + call ExtPtfm_DestroyDiscState(ExtPtfm_DataData%xd(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(ExtPtfm_DataData%z) + UB(1:1) = ubound(ExtPtfm_DataData%z) + do i1 = LB(1), UB(1) + call ExtPtfm_DestroyConstrState(ExtPtfm_DataData%z(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(ExtPtfm_DataData%OtherSt) + UB(1:1) = ubound(ExtPtfm_DataData%OtherSt) + do i1 = LB(1), UB(1) + call ExtPtfm_DestroyOtherState(ExtPtfm_DataData%OtherSt(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + call ExtPtfm_DestroyParam(ExtPtfm_DataData%p, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call ExtPtfm_DestroyInput(ExtPtfm_DataData%u, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call ExtPtfm_DestroyOutput(ExtPtfm_DataData%y, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call ExtPtfm_DestroyMisc(ExtPtfm_DataData%m, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(ExtPtfm_DataData%Input)) then + LB(1:1) = lbound(ExtPtfm_DataData%Input) + UB(1:1) = ubound(ExtPtfm_DataData%Input) + do i1 = LB(1), UB(1) + call ExtPtfm_DestroyInput(ExtPtfm_DataData%Input(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ExtPtfm_DataData%Input) + end if + if (allocated(ExtPtfm_DataData%Input_Saved)) then + LB(1:1) = lbound(ExtPtfm_DataData%Input_Saved) + UB(1:1) = ubound(ExtPtfm_DataData%Input_Saved) + do i1 = LB(1), UB(1) + call ExtPtfm_DestroyInput(ExtPtfm_DataData%Input_Saved(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ExtPtfm_DataData%Input_Saved) + end if + if (allocated(ExtPtfm_DataData%InputTimes)) then + deallocate(ExtPtfm_DataData%InputTimes) + end if + if (allocated(ExtPtfm_DataData%InputTimes_Saved)) then + deallocate(ExtPtfm_DataData%InputTimes_Saved) + end if +end subroutine + +subroutine FAST_PackExtPtfm_Data(RF, Indata) + type(RegFile), intent(inout) :: RF + type(ExtPtfm_Data), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackExtPtfm_Data' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + if (RF%ErrStat >= AbortErrLev) return + LB(1:1) = lbound(InData%x) + UB(1:1) = ubound(InData%x) + do i1 = LB(1), UB(1) + call ExtPtfm_PackContState(RF, InData%x(i1)) + end do + LB(1:1) = lbound(InData%xd) + UB(1:1) = ubound(InData%xd) + do i1 = LB(1), UB(1) + call ExtPtfm_PackDiscState(RF, InData%xd(i1)) + end do + LB(1:1) = lbound(InData%z) + UB(1:1) = ubound(InData%z) + do i1 = LB(1), UB(1) + call ExtPtfm_PackConstrState(RF, InData%z(i1)) + end do + LB(1:1) = lbound(InData%OtherSt) + UB(1:1) = ubound(InData%OtherSt) + do i1 = LB(1), UB(1) + call ExtPtfm_PackOtherState(RF, InData%OtherSt(i1)) + end do + call ExtPtfm_PackParam(RF, InData%p) + call ExtPtfm_PackInput(RF, InData%u) + call ExtPtfm_PackOutput(RF, InData%y) + call ExtPtfm_PackMisc(RF, InData%m) + call RegPack(RF, allocated(InData%Input)) + if (allocated(InData%Input)) then + call RegPackBounds(RF, 1, lbound(InData%Input), ubound(InData%Input)) + LB(1:1) = lbound(InData%Input) + UB(1:1) = ubound(InData%Input) + do i1 = LB(1), UB(1) + call ExtPtfm_PackInput(RF, InData%Input(i1)) + end do + end if + call RegPack(RF, allocated(InData%Input_Saved)) + if (allocated(InData%Input_Saved)) then + call RegPackBounds(RF, 1, lbound(InData%Input_Saved), ubound(InData%Input_Saved)) + LB(1:1) = lbound(InData%Input_Saved) + UB(1:1) = ubound(InData%Input_Saved) + do i1 = LB(1), UB(1) + call ExtPtfm_PackInput(RF, InData%Input_Saved(i1)) + end do + end if + call RegPackAlloc(RF, InData%InputTimes) + call RegPackAlloc(RF, InData%InputTimes_Saved) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FAST_UnPackExtPtfm_Data(RF, OutData) + type(RegFile), intent(inout) :: RF + type(ExtPtfm_Data), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackExtPtfm_Data' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + LB(1:1) = lbound(OutData%x) + UB(1:1) = ubound(OutData%x) + do i1 = LB(1), UB(1) + call ExtPtfm_UnpackContState(RF, OutData%x(i1)) ! x + end do + LB(1:1) = lbound(OutData%xd) + UB(1:1) = ubound(OutData%xd) + do i1 = LB(1), UB(1) + call ExtPtfm_UnpackDiscState(RF, OutData%xd(i1)) ! xd + end do + LB(1:1) = lbound(OutData%z) + UB(1:1) = ubound(OutData%z) + do i1 = LB(1), UB(1) + call ExtPtfm_UnpackConstrState(RF, OutData%z(i1)) ! z + end do + LB(1:1) = lbound(OutData%OtherSt) + UB(1:1) = ubound(OutData%OtherSt) + do i1 = LB(1), UB(1) + call ExtPtfm_UnpackOtherState(RF, OutData%OtherSt(i1)) ! OtherSt + end do + call ExtPtfm_UnpackParam(RF, OutData%p) ! p + call ExtPtfm_UnpackInput(RF, OutData%u) ! u + call ExtPtfm_UnpackOutput(RF, OutData%y) ! y + call ExtPtfm_UnpackMisc(RF, OutData%m) ! m + if (allocated(OutData%Input)) deallocate(OutData%Input) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%Input(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call ExtPtfm_UnpackInput(RF, OutData%Input(i1)) ! Input + end do + end if + if (allocated(OutData%Input_Saved)) deallocate(OutData%Input_Saved) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%Input_Saved(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input_Saved.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call ExtPtfm_UnpackInput(RF, OutData%Input_Saved(i1)) ! Input_Saved + end do + end if + call RegUnpackAlloc(RF, OutData%InputTimes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%InputTimes_Saved); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FAST_CopySeaState_Data(SrcSeaState_DataData, DstSeaState_DataData, CtrlCode, ErrStat, ErrMsg) + type(SeaState_Data), intent(in) :: SrcSeaState_DataData + type(SeaState_Data), intent(inout) :: DstSeaState_DataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_CopySeaState_Data' + ErrStat = ErrID_None + ErrMsg = '' + LB(1:1) = lbound(SrcSeaState_DataData%x) + UB(1:1) = ubound(SrcSeaState_DataData%x) + do i1 = LB(1), UB(1) + call SeaSt_CopyContState(SrcSeaState_DataData%x(i1), DstSeaState_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + LB(1:1) = lbound(SrcSeaState_DataData%xd) + UB(1:1) = ubound(SrcSeaState_DataData%xd) + do i1 = LB(1), UB(1) + call SeaSt_CopyDiscState(SrcSeaState_DataData%xd(i1), DstSeaState_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + LB(1:1) = lbound(SrcSeaState_DataData%z) + UB(1:1) = ubound(SrcSeaState_DataData%z) + do i1 = LB(1), UB(1) + call SeaSt_CopyConstrState(SrcSeaState_DataData%z(i1), DstSeaState_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + LB(1:1) = lbound(SrcSeaState_DataData%OtherSt) + UB(1:1) = ubound(SrcSeaState_DataData%OtherSt) + do i1 = LB(1), UB(1) + call SeaSt_CopyOtherState(SrcSeaState_DataData%OtherSt(i1), DstSeaState_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + call SeaSt_CopyParam(SrcSeaState_DataData%p, DstSeaState_DataData%p, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SeaSt_CopyInput(SrcSeaState_DataData%u, DstSeaState_DataData%u, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SeaSt_CopyOutput(SrcSeaState_DataData%y, DstSeaState_DataData%y, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SeaSt_CopyMisc(SrcSeaState_DataData%m, DstSeaState_DataData%m, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcSeaState_DataData%Input)) then + LB(1:1) = lbound(SrcSeaState_DataData%Input) + UB(1:1) = ubound(SrcSeaState_DataData%Input) + if (.not. allocated(DstSeaState_DataData%Input)) then + allocate(DstSeaState_DataData%Input(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstSeaState_DataData%Input.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call SeaSt_CopyInput(SrcSeaState_DataData%Input(i1), DstSeaState_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcSeaState_DataData%Input_Saved)) then + LB(1:1) = lbound(SrcSeaState_DataData%Input_Saved) + UB(1:1) = ubound(SrcSeaState_DataData%Input_Saved) + if (.not. allocated(DstSeaState_DataData%Input_Saved)) then + allocate(DstSeaState_DataData%Input_Saved(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstSeaState_DataData%Input_Saved.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call SeaSt_CopyInput(SrcSeaState_DataData%Input_Saved(i1), DstSeaState_DataData%Input_Saved(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcSeaState_DataData%Output)) then + LB(1:1) = lbound(SrcSeaState_DataData%Output) + UB(1:1) = ubound(SrcSeaState_DataData%Output) + if (.not. allocated(DstSeaState_DataData%Output)) then + allocate(DstSeaState_DataData%Output(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstSeaState_DataData%Output.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call SeaSt_CopyOutput(SrcSeaState_DataData%Output(i1), DstSeaState_DataData%Output(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call SeaSt_CopyOutput(SrcSeaState_DataData%y_interp, DstSeaState_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcSeaState_DataData%InputTimes)) then + LB(1:1) = lbound(SrcSeaState_DataData%InputTimes) + UB(1:1) = ubound(SrcSeaState_DataData%InputTimes) + if (.not. allocated(DstSeaState_DataData%InputTimes)) then + allocate(DstSeaState_DataData%InputTimes(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstSeaState_DataData%InputTimes.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstSeaState_DataData%InputTimes = SrcSeaState_DataData%InputTimes + end if + if (allocated(SrcSeaState_DataData%InputTimes_Saved)) then + LB(1:1) = lbound(SrcSeaState_DataData%InputTimes_Saved) + UB(1:1) = ubound(SrcSeaState_DataData%InputTimes_Saved) + if (.not. allocated(DstSeaState_DataData%InputTimes_Saved)) then + allocate(DstSeaState_DataData%InputTimes_Saved(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstSeaState_DataData%InputTimes_Saved.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstSeaState_DataData%InputTimes_Saved = SrcSeaState_DataData%InputTimes_Saved + end if +end subroutine + +subroutine FAST_DestroySeaState_Data(SeaState_DataData, ErrStat, ErrMsg) + type(SeaState_Data), intent(inout) :: SeaState_DataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_DestroySeaState_Data' + ErrStat = ErrID_None + ErrMsg = '' + LB(1:1) = lbound(SeaState_DataData%x) + UB(1:1) = ubound(SeaState_DataData%x) + do i1 = LB(1), UB(1) + call SeaSt_DestroyContState(SeaState_DataData%x(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(SeaState_DataData%xd) + UB(1:1) = ubound(SeaState_DataData%xd) + do i1 = LB(1), UB(1) + call SeaSt_DestroyDiscState(SeaState_DataData%xd(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(SeaState_DataData%z) + UB(1:1) = ubound(SeaState_DataData%z) + do i1 = LB(1), UB(1) + call SeaSt_DestroyConstrState(SeaState_DataData%z(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(SeaState_DataData%OtherSt) + UB(1:1) = ubound(SeaState_DataData%OtherSt) + do i1 = LB(1), UB(1) + call SeaSt_DestroyOtherState(SeaState_DataData%OtherSt(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + call SeaSt_DestroyParam(SeaState_DataData%p, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SeaSt_DestroyInput(SeaState_DataData%u, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SeaSt_DestroyOutput(SeaState_DataData%y, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SeaSt_DestroyMisc(SeaState_DataData%m, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(SeaState_DataData%Input)) then + LB(1:1) = lbound(SeaState_DataData%Input) + UB(1:1) = ubound(SeaState_DataData%Input) + do i1 = LB(1), UB(1) + call SeaSt_DestroyInput(SeaState_DataData%Input(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(SeaState_DataData%Input) + end if + if (allocated(SeaState_DataData%Input_Saved)) then + LB(1:1) = lbound(SeaState_DataData%Input_Saved) + UB(1:1) = ubound(SeaState_DataData%Input_Saved) + do i1 = LB(1), UB(1) + call SeaSt_DestroyInput(SeaState_DataData%Input_Saved(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(SeaState_DataData%Input_Saved) + end if + if (allocated(SeaState_DataData%Output)) then + LB(1:1) = lbound(SeaState_DataData%Output) + UB(1:1) = ubound(SeaState_DataData%Output) + do i1 = LB(1), UB(1) + call SeaSt_DestroyOutput(SeaState_DataData%Output(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(SeaState_DataData%Output) + end if + call SeaSt_DestroyOutput(SeaState_DataData%y_interp, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(SeaState_DataData%InputTimes)) then + deallocate(SeaState_DataData%InputTimes) + end if + if (allocated(SeaState_DataData%InputTimes_Saved)) then + deallocate(SeaState_DataData%InputTimes_Saved) + end if +end subroutine + +subroutine FAST_PackSeaState_Data(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SeaState_Data), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackSeaState_Data' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + if (RF%ErrStat >= AbortErrLev) return + LB(1:1) = lbound(InData%x) + UB(1:1) = ubound(InData%x) + do i1 = LB(1), UB(1) + call SeaSt_PackContState(RF, InData%x(i1)) + end do + LB(1:1) = lbound(InData%xd) + UB(1:1) = ubound(InData%xd) + do i1 = LB(1), UB(1) + call SeaSt_PackDiscState(RF, InData%xd(i1)) + end do + LB(1:1) = lbound(InData%z) + UB(1:1) = ubound(InData%z) + do i1 = LB(1), UB(1) + call SeaSt_PackConstrState(RF, InData%z(i1)) + end do + LB(1:1) = lbound(InData%OtherSt) + UB(1:1) = ubound(InData%OtherSt) + do i1 = LB(1), UB(1) + call SeaSt_PackOtherState(RF, InData%OtherSt(i1)) + end do + call SeaSt_PackParam(RF, InData%p) + call SeaSt_PackInput(RF, InData%u) + call SeaSt_PackOutput(RF, InData%y) + call SeaSt_PackMisc(RF, InData%m) + call RegPack(RF, allocated(InData%Input)) + if (allocated(InData%Input)) then + call RegPackBounds(RF, 1, lbound(InData%Input), ubound(InData%Input)) + LB(1:1) = lbound(InData%Input) + UB(1:1) = ubound(InData%Input) + do i1 = LB(1), UB(1) + call SeaSt_PackInput(RF, InData%Input(i1)) + end do + end if + call RegPack(RF, allocated(InData%Input_Saved)) + if (allocated(InData%Input_Saved)) then + call RegPackBounds(RF, 1, lbound(InData%Input_Saved), ubound(InData%Input_Saved)) + LB(1:1) = lbound(InData%Input_Saved) + UB(1:1) = ubound(InData%Input_Saved) + do i1 = LB(1), UB(1) + call SeaSt_PackInput(RF, InData%Input_Saved(i1)) + end do + end if + call RegPack(RF, allocated(InData%Output)) + if (allocated(InData%Output)) then + call RegPackBounds(RF, 1, lbound(InData%Output), ubound(InData%Output)) + LB(1:1) = lbound(InData%Output) + UB(1:1) = ubound(InData%Output) + do i1 = LB(1), UB(1) + call SeaSt_PackOutput(RF, InData%Output(i1)) + end do + end if + call SeaSt_PackOutput(RF, InData%y_interp) + call RegPackAlloc(RF, InData%InputTimes) + call RegPackAlloc(RF, InData%InputTimes_Saved) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FAST_UnPackSeaState_Data(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SeaState_Data), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackSeaState_Data' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + LB(1:1) = lbound(OutData%x) + UB(1:1) = ubound(OutData%x) + do i1 = LB(1), UB(1) + call SeaSt_UnpackContState(RF, OutData%x(i1)) ! x + end do + LB(1:1) = lbound(OutData%xd) + UB(1:1) = ubound(OutData%xd) + do i1 = LB(1), UB(1) + call SeaSt_UnpackDiscState(RF, OutData%xd(i1)) ! xd + end do + LB(1:1) = lbound(OutData%z) + UB(1:1) = ubound(OutData%z) + do i1 = LB(1), UB(1) + call SeaSt_UnpackConstrState(RF, OutData%z(i1)) ! z + end do + LB(1:1) = lbound(OutData%OtherSt) + UB(1:1) = ubound(OutData%OtherSt) + do i1 = LB(1), UB(1) + call SeaSt_UnpackOtherState(RF, OutData%OtherSt(i1)) ! OtherSt + end do + call SeaSt_UnpackParam(RF, OutData%p) ! p + call SeaSt_UnpackInput(RF, OutData%u) ! u + call SeaSt_UnpackOutput(RF, OutData%y) ! y + call SeaSt_UnpackMisc(RF, OutData%m) ! m + if (allocated(OutData%Input)) deallocate(OutData%Input) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%Input(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SeaSt_UnpackInput(RF, OutData%Input(i1)) ! Input + end do + end if + if (allocated(OutData%Input_Saved)) deallocate(OutData%Input_Saved) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%Input_Saved(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input_Saved.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SeaSt_UnpackInput(RF, OutData%Input_Saved(i1)) ! Input_Saved + end do + end if + if (allocated(OutData%Output)) deallocate(OutData%Output) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%Output(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SeaSt_UnpackOutput(RF, OutData%Output(i1)) ! Output + end do + end if + call SeaSt_UnpackOutput(RF, OutData%y_interp) ! y_interp + call RegUnpackAlloc(RF, OutData%InputTimes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%InputTimes_Saved); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FAST_CopyHydroDyn_Data(SrcHydroDyn_DataData, DstHydroDyn_DataData, CtrlCode, ErrStat, ErrMsg) + type(HydroDyn_Data), intent(inout) :: SrcHydroDyn_DataData + type(HydroDyn_Data), intent(inout) :: DstHydroDyn_DataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_CopyHydroDyn_Data' + ErrStat = ErrID_None + ErrMsg = '' + LB(1:1) = lbound(SrcHydroDyn_DataData%x) + UB(1:1) = ubound(SrcHydroDyn_DataData%x) + do i1 = LB(1), UB(1) + call HydroDyn_CopyContState(SrcHydroDyn_DataData%x(i1), DstHydroDyn_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + LB(1:1) = lbound(SrcHydroDyn_DataData%xd) + UB(1:1) = ubound(SrcHydroDyn_DataData%xd) + do i1 = LB(1), UB(1) + call HydroDyn_CopyDiscState(SrcHydroDyn_DataData%xd(i1), DstHydroDyn_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + LB(1:1) = lbound(SrcHydroDyn_DataData%z) + UB(1:1) = ubound(SrcHydroDyn_DataData%z) + do i1 = LB(1), UB(1) + call HydroDyn_CopyConstrState(SrcHydroDyn_DataData%z(i1), DstHydroDyn_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + LB(1:1) = lbound(SrcHydroDyn_DataData%OtherSt) + UB(1:1) = ubound(SrcHydroDyn_DataData%OtherSt) + do i1 = LB(1), UB(1) + call HydroDyn_CopyOtherState(SrcHydroDyn_DataData%OtherSt(i1), DstHydroDyn_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + call HydroDyn_CopyParam(SrcHydroDyn_DataData%p, DstHydroDyn_DataData%p, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call HydroDyn_CopyInput(SrcHydroDyn_DataData%u, DstHydroDyn_DataData%u, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call HydroDyn_CopyOutput(SrcHydroDyn_DataData%y, DstHydroDyn_DataData%y, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call HydroDyn_CopyMisc(SrcHydroDyn_DataData%m, DstHydroDyn_DataData%m, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcHydroDyn_DataData%Output)) then + LB(1:1) = lbound(SrcHydroDyn_DataData%Output) + UB(1:1) = ubound(SrcHydroDyn_DataData%Output) + if (.not. allocated(DstHydroDyn_DataData%Output)) then + allocate(DstHydroDyn_DataData%Output(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstHydroDyn_DataData%Output.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call HydroDyn_CopyOutput(SrcHydroDyn_DataData%Output(i1), DstHydroDyn_DataData%Output(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call HydroDyn_CopyOutput(SrcHydroDyn_DataData%y_interp, DstHydroDyn_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcHydroDyn_DataData%Input)) then + LB(1:1) = lbound(SrcHydroDyn_DataData%Input) + UB(1:1) = ubound(SrcHydroDyn_DataData%Input) + if (.not. allocated(DstHydroDyn_DataData%Input)) then + allocate(DstHydroDyn_DataData%Input(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstHydroDyn_DataData%Input.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call HydroDyn_CopyInput(SrcHydroDyn_DataData%Input(i1), DstHydroDyn_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcHydroDyn_DataData%Input_Saved)) then + LB(1:1) = lbound(SrcHydroDyn_DataData%Input_Saved) + UB(1:1) = ubound(SrcHydroDyn_DataData%Input_Saved) + if (.not. allocated(DstHydroDyn_DataData%Input_Saved)) then + allocate(DstHydroDyn_DataData%Input_Saved(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstHydroDyn_DataData%Input_Saved.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call HydroDyn_CopyInput(SrcHydroDyn_DataData%Input_Saved(i1), DstHydroDyn_DataData%Input_Saved(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcHydroDyn_DataData%InputTimes)) then + LB(1:1) = lbound(SrcHydroDyn_DataData%InputTimes) + UB(1:1) = ubound(SrcHydroDyn_DataData%InputTimes) + if (.not. allocated(DstHydroDyn_DataData%InputTimes)) then + allocate(DstHydroDyn_DataData%InputTimes(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstHydroDyn_DataData%InputTimes.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstHydroDyn_DataData%InputTimes = SrcHydroDyn_DataData%InputTimes + end if + if (allocated(SrcHydroDyn_DataData%InputTimes_Saved)) then + LB(1:1) = lbound(SrcHydroDyn_DataData%InputTimes_Saved) + UB(1:1) = ubound(SrcHydroDyn_DataData%InputTimes_Saved) + if (.not. allocated(DstHydroDyn_DataData%InputTimes_Saved)) then + allocate(DstHydroDyn_DataData%InputTimes_Saved(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstHydroDyn_DataData%InputTimes_Saved.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstHydroDyn_DataData%InputTimes_Saved = SrcHydroDyn_DataData%InputTimes_Saved + end if +end subroutine + +subroutine FAST_DestroyHydroDyn_Data(HydroDyn_DataData, ErrStat, ErrMsg) + type(HydroDyn_Data), intent(inout) :: HydroDyn_DataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_DestroyHydroDyn_Data' + ErrStat = ErrID_None + ErrMsg = '' + LB(1:1) = lbound(HydroDyn_DataData%x) + UB(1:1) = ubound(HydroDyn_DataData%x) + do i1 = LB(1), UB(1) + call HydroDyn_DestroyContState(HydroDyn_DataData%x(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(HydroDyn_DataData%xd) + UB(1:1) = ubound(HydroDyn_DataData%xd) + do i1 = LB(1), UB(1) + call HydroDyn_DestroyDiscState(HydroDyn_DataData%xd(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(HydroDyn_DataData%z) + UB(1:1) = ubound(HydroDyn_DataData%z) + do i1 = LB(1), UB(1) + call HydroDyn_DestroyConstrState(HydroDyn_DataData%z(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(HydroDyn_DataData%OtherSt) + UB(1:1) = ubound(HydroDyn_DataData%OtherSt) + do i1 = LB(1), UB(1) + call HydroDyn_DestroyOtherState(HydroDyn_DataData%OtherSt(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + call HydroDyn_DestroyParam(HydroDyn_DataData%p, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call HydroDyn_DestroyInput(HydroDyn_DataData%u, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call HydroDyn_DestroyOutput(HydroDyn_DataData%y, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call HydroDyn_DestroyMisc(HydroDyn_DataData%m, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(HydroDyn_DataData%Output)) then + LB(1:1) = lbound(HydroDyn_DataData%Output) + UB(1:1) = ubound(HydroDyn_DataData%Output) + do i1 = LB(1), UB(1) + call HydroDyn_DestroyOutput(HydroDyn_DataData%Output(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(HydroDyn_DataData%Output) + end if + call HydroDyn_DestroyOutput(HydroDyn_DataData%y_interp, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(HydroDyn_DataData%Input)) then + LB(1:1) = lbound(HydroDyn_DataData%Input) + UB(1:1) = ubound(HydroDyn_DataData%Input) + do i1 = LB(1), UB(1) + call HydroDyn_DestroyInput(HydroDyn_DataData%Input(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(HydroDyn_DataData%Input) + end if + if (allocated(HydroDyn_DataData%Input_Saved)) then + LB(1:1) = lbound(HydroDyn_DataData%Input_Saved) + UB(1:1) = ubound(HydroDyn_DataData%Input_Saved) + do i1 = LB(1), UB(1) + call HydroDyn_DestroyInput(HydroDyn_DataData%Input_Saved(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(HydroDyn_DataData%Input_Saved) + end if + if (allocated(HydroDyn_DataData%InputTimes)) then + deallocate(HydroDyn_DataData%InputTimes) + end if + if (allocated(HydroDyn_DataData%InputTimes_Saved)) then + deallocate(HydroDyn_DataData%InputTimes_Saved) + end if +end subroutine + +subroutine FAST_PackHydroDyn_Data(RF, Indata) + type(RegFile), intent(inout) :: RF + type(HydroDyn_Data), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackHydroDyn_Data' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + if (RF%ErrStat >= AbortErrLev) return + LB(1:1) = lbound(InData%x) + UB(1:1) = ubound(InData%x) + do i1 = LB(1), UB(1) + call HydroDyn_PackContState(RF, InData%x(i1)) + end do + LB(1:1) = lbound(InData%xd) + UB(1:1) = ubound(InData%xd) + do i1 = LB(1), UB(1) + call HydroDyn_PackDiscState(RF, InData%xd(i1)) + end do + LB(1:1) = lbound(InData%z) + UB(1:1) = ubound(InData%z) + do i1 = LB(1), UB(1) + call HydroDyn_PackConstrState(RF, InData%z(i1)) + end do + LB(1:1) = lbound(InData%OtherSt) + UB(1:1) = ubound(InData%OtherSt) + do i1 = LB(1), UB(1) + call HydroDyn_PackOtherState(RF, InData%OtherSt(i1)) + end do + call HydroDyn_PackParam(RF, InData%p) + call HydroDyn_PackInput(RF, InData%u) + call HydroDyn_PackOutput(RF, InData%y) + call HydroDyn_PackMisc(RF, InData%m) + call RegPack(RF, allocated(InData%Output)) + if (allocated(InData%Output)) then + call RegPackBounds(RF, 1, lbound(InData%Output), ubound(InData%Output)) + LB(1:1) = lbound(InData%Output) + UB(1:1) = ubound(InData%Output) + do i1 = LB(1), UB(1) + call HydroDyn_PackOutput(RF, InData%Output(i1)) + end do + end if + call HydroDyn_PackOutput(RF, InData%y_interp) + call RegPack(RF, allocated(InData%Input)) + if (allocated(InData%Input)) then + call RegPackBounds(RF, 1, lbound(InData%Input), ubound(InData%Input)) + LB(1:1) = lbound(InData%Input) + UB(1:1) = ubound(InData%Input) + do i1 = LB(1), UB(1) + call HydroDyn_PackInput(RF, InData%Input(i1)) + end do + end if + call RegPack(RF, allocated(InData%Input_Saved)) + if (allocated(InData%Input_Saved)) then + call RegPackBounds(RF, 1, lbound(InData%Input_Saved), ubound(InData%Input_Saved)) + LB(1:1) = lbound(InData%Input_Saved) + UB(1:1) = ubound(InData%Input_Saved) + do i1 = LB(1), UB(1) + call HydroDyn_PackInput(RF, InData%Input_Saved(i1)) + end do + end if + call RegPackAlloc(RF, InData%InputTimes) + call RegPackAlloc(RF, InData%InputTimes_Saved) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FAST_UnPackHydroDyn_Data(RF, OutData) + type(RegFile), intent(inout) :: RF + type(HydroDyn_Data), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackHydroDyn_Data' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + LB(1:1) = lbound(OutData%x) + UB(1:1) = ubound(OutData%x) + do i1 = LB(1), UB(1) + call HydroDyn_UnpackContState(RF, OutData%x(i1)) ! x + end do + LB(1:1) = lbound(OutData%xd) + UB(1:1) = ubound(OutData%xd) + do i1 = LB(1), UB(1) + call HydroDyn_UnpackDiscState(RF, OutData%xd(i1)) ! xd + end do + LB(1:1) = lbound(OutData%z) + UB(1:1) = ubound(OutData%z) + do i1 = LB(1), UB(1) + call HydroDyn_UnpackConstrState(RF, OutData%z(i1)) ! z + end do + LB(1:1) = lbound(OutData%OtherSt) + UB(1:1) = ubound(OutData%OtherSt) + do i1 = LB(1), UB(1) + call HydroDyn_UnpackOtherState(RF, OutData%OtherSt(i1)) ! OtherSt + end do + call HydroDyn_UnpackParam(RF, OutData%p) ! p + call HydroDyn_UnpackInput(RF, OutData%u) ! u + call HydroDyn_UnpackOutput(RF, OutData%y) ! y + call HydroDyn_UnpackMisc(RF, OutData%m) ! m + if (allocated(OutData%Output)) deallocate(OutData%Output) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%Output(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call HydroDyn_UnpackOutput(RF, OutData%Output(i1)) ! Output + end do + end if + call HydroDyn_UnpackOutput(RF, OutData%y_interp) ! y_interp + if (allocated(OutData%Input)) deallocate(OutData%Input) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%Input(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call HydroDyn_UnpackInput(RF, OutData%Input(i1)) ! Input + end do + end if + if (allocated(OutData%Input_Saved)) deallocate(OutData%Input_Saved) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%Input_Saved(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input_Saved.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call HydroDyn_UnpackInput(RF, OutData%Input_Saved(i1)) ! Input_Saved + end do + end if + call RegUnpackAlloc(RF, OutData%InputTimes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%InputTimes_Saved); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FAST_CopyIceFloe_Data(SrcIceFloe_DataData, DstIceFloe_DataData, CtrlCode, ErrStat, ErrMsg) + type(IceFloe_Data), intent(inout) :: SrcIceFloe_DataData + type(IceFloe_Data), intent(inout) :: DstIceFloe_DataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_CopyIceFloe_Data' + ErrStat = ErrID_None + ErrMsg = '' + LB(1:1) = lbound(SrcIceFloe_DataData%x) + UB(1:1) = ubound(SrcIceFloe_DataData%x) + do i1 = LB(1), UB(1) + call IceFloe_CopyContState(SrcIceFloe_DataData%x(i1), DstIceFloe_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + LB(1:1) = lbound(SrcIceFloe_DataData%xd) + UB(1:1) = ubound(SrcIceFloe_DataData%xd) + do i1 = LB(1), UB(1) + call IceFloe_CopyDiscState(SrcIceFloe_DataData%xd(i1), DstIceFloe_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + LB(1:1) = lbound(SrcIceFloe_DataData%z) + UB(1:1) = ubound(SrcIceFloe_DataData%z) + do i1 = LB(1), UB(1) + call IceFloe_CopyConstrState(SrcIceFloe_DataData%z(i1), DstIceFloe_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + LB(1:1) = lbound(SrcIceFloe_DataData%OtherSt) + UB(1:1) = ubound(SrcIceFloe_DataData%OtherSt) + do i1 = LB(1), UB(1) + call IceFloe_CopyOtherState(SrcIceFloe_DataData%OtherSt(i1), DstIceFloe_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + call IceFloe_CopyParam(SrcIceFloe_DataData%p, DstIceFloe_DataData%p, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call IceFloe_CopyInput(SrcIceFloe_DataData%u, DstIceFloe_DataData%u, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call IceFloe_CopyOutput(SrcIceFloe_DataData%y, DstIceFloe_DataData%y, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call IceFloe_CopyMisc(SrcIceFloe_DataData%m, DstIceFloe_DataData%m, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcIceFloe_DataData%Input)) then + LB(1:1) = lbound(SrcIceFloe_DataData%Input) + UB(1:1) = ubound(SrcIceFloe_DataData%Input) + if (.not. allocated(DstIceFloe_DataData%Input)) then + allocate(DstIceFloe_DataData%Input(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstIceFloe_DataData%Input.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call IceFloe_CopyInput(SrcIceFloe_DataData%Input(i1), DstIceFloe_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcIceFloe_DataData%Input_Saved)) then + LB(1:1) = lbound(SrcIceFloe_DataData%Input_Saved) + UB(1:1) = ubound(SrcIceFloe_DataData%Input_Saved) + if (.not. allocated(DstIceFloe_DataData%Input_Saved)) then + allocate(DstIceFloe_DataData%Input_Saved(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstIceFloe_DataData%Input_Saved.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call IceFloe_CopyInput(SrcIceFloe_DataData%Input_Saved(i1), DstIceFloe_DataData%Input_Saved(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcIceFloe_DataData%InputTimes)) then + LB(1:1) = lbound(SrcIceFloe_DataData%InputTimes) + UB(1:1) = ubound(SrcIceFloe_DataData%InputTimes) + if (.not. allocated(DstIceFloe_DataData%InputTimes)) then + allocate(DstIceFloe_DataData%InputTimes(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstIceFloe_DataData%InputTimes.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstIceFloe_DataData%InputTimes = SrcIceFloe_DataData%InputTimes + end if + if (allocated(SrcIceFloe_DataData%InputTimes_Saved)) then + LB(1:1) = lbound(SrcIceFloe_DataData%InputTimes_Saved) + UB(1:1) = ubound(SrcIceFloe_DataData%InputTimes_Saved) + if (.not. allocated(DstIceFloe_DataData%InputTimes_Saved)) then + allocate(DstIceFloe_DataData%InputTimes_Saved(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstIceFloe_DataData%InputTimes_Saved.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstIceFloe_DataData%InputTimes_Saved = SrcIceFloe_DataData%InputTimes_Saved + end if +end subroutine + +subroutine FAST_DestroyIceFloe_Data(IceFloe_DataData, ErrStat, ErrMsg) + type(IceFloe_Data), intent(inout) :: IceFloe_DataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_DestroyIceFloe_Data' + ErrStat = ErrID_None + ErrMsg = '' + LB(1:1) = lbound(IceFloe_DataData%x) + UB(1:1) = ubound(IceFloe_DataData%x) + do i1 = LB(1), UB(1) + call IceFloe_DestroyContState(IceFloe_DataData%x(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(IceFloe_DataData%xd) + UB(1:1) = ubound(IceFloe_DataData%xd) + do i1 = LB(1), UB(1) + call IceFloe_DestroyDiscState(IceFloe_DataData%xd(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(IceFloe_DataData%z) + UB(1:1) = ubound(IceFloe_DataData%z) + do i1 = LB(1), UB(1) + call IceFloe_DestroyConstrState(IceFloe_DataData%z(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(IceFloe_DataData%OtherSt) + UB(1:1) = ubound(IceFloe_DataData%OtherSt) + do i1 = LB(1), UB(1) + call IceFloe_DestroyOtherState(IceFloe_DataData%OtherSt(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + call IceFloe_DestroyParam(IceFloe_DataData%p, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call IceFloe_DestroyInput(IceFloe_DataData%u, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call IceFloe_DestroyOutput(IceFloe_DataData%y, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call IceFloe_DestroyMisc(IceFloe_DataData%m, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(IceFloe_DataData%Input)) then + LB(1:1) = lbound(IceFloe_DataData%Input) + UB(1:1) = ubound(IceFloe_DataData%Input) + do i1 = LB(1), UB(1) + call IceFloe_DestroyInput(IceFloe_DataData%Input(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(IceFloe_DataData%Input) + end if + if (allocated(IceFloe_DataData%Input_Saved)) then + LB(1:1) = lbound(IceFloe_DataData%Input_Saved) + UB(1:1) = ubound(IceFloe_DataData%Input_Saved) + do i1 = LB(1), UB(1) + call IceFloe_DestroyInput(IceFloe_DataData%Input_Saved(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(IceFloe_DataData%Input_Saved) + end if + if (allocated(IceFloe_DataData%InputTimes)) then + deallocate(IceFloe_DataData%InputTimes) + end if + if (allocated(IceFloe_DataData%InputTimes_Saved)) then + deallocate(IceFloe_DataData%InputTimes_Saved) + end if +end subroutine + +subroutine FAST_PackIceFloe_Data(RF, Indata) + type(RegFile), intent(inout) :: RF + type(IceFloe_Data), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackIceFloe_Data' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + if (RF%ErrStat >= AbortErrLev) return + LB(1:1) = lbound(InData%x) + UB(1:1) = ubound(InData%x) + do i1 = LB(1), UB(1) + call IceFloe_PackContState(RF, InData%x(i1)) + end do + LB(1:1) = lbound(InData%xd) + UB(1:1) = ubound(InData%xd) + do i1 = LB(1), UB(1) + call IceFloe_PackDiscState(RF, InData%xd(i1)) + end do + LB(1:1) = lbound(InData%z) + UB(1:1) = ubound(InData%z) + do i1 = LB(1), UB(1) + call IceFloe_PackConstrState(RF, InData%z(i1)) + end do + LB(1:1) = lbound(InData%OtherSt) + UB(1:1) = ubound(InData%OtherSt) + do i1 = LB(1), UB(1) + call IceFloe_PackOtherState(RF, InData%OtherSt(i1)) + end do + call IceFloe_PackParam(RF, InData%p) + call IceFloe_PackInput(RF, InData%u) + call IceFloe_PackOutput(RF, InData%y) + call IceFloe_PackMisc(RF, InData%m) + call RegPack(RF, allocated(InData%Input)) + if (allocated(InData%Input)) then + call RegPackBounds(RF, 1, lbound(InData%Input), ubound(InData%Input)) + LB(1:1) = lbound(InData%Input) + UB(1:1) = ubound(InData%Input) + do i1 = LB(1), UB(1) + call IceFloe_PackInput(RF, InData%Input(i1)) + end do + end if + call RegPack(RF, allocated(InData%Input_Saved)) + if (allocated(InData%Input_Saved)) then + call RegPackBounds(RF, 1, lbound(InData%Input_Saved), ubound(InData%Input_Saved)) + LB(1:1) = lbound(InData%Input_Saved) + UB(1:1) = ubound(InData%Input_Saved) + do i1 = LB(1), UB(1) + call IceFloe_PackInput(RF, InData%Input_Saved(i1)) + end do + end if + call RegPackAlloc(RF, InData%InputTimes) + call RegPackAlloc(RF, InData%InputTimes_Saved) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FAST_UnPackIceFloe_Data(RF, OutData) + type(RegFile), intent(inout) :: RF + type(IceFloe_Data), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackIceFloe_Data' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + LB(1:1) = lbound(OutData%x) + UB(1:1) = ubound(OutData%x) + do i1 = LB(1), UB(1) + call IceFloe_UnpackContState(RF, OutData%x(i1)) ! x + end do + LB(1:1) = lbound(OutData%xd) + UB(1:1) = ubound(OutData%xd) + do i1 = LB(1), UB(1) + call IceFloe_UnpackDiscState(RF, OutData%xd(i1)) ! xd + end do + LB(1:1) = lbound(OutData%z) + UB(1:1) = ubound(OutData%z) + do i1 = LB(1), UB(1) + call IceFloe_UnpackConstrState(RF, OutData%z(i1)) ! z + end do + LB(1:1) = lbound(OutData%OtherSt) + UB(1:1) = ubound(OutData%OtherSt) + do i1 = LB(1), UB(1) + call IceFloe_UnpackOtherState(RF, OutData%OtherSt(i1)) ! OtherSt + end do + call IceFloe_UnpackParam(RF, OutData%p) ! p + call IceFloe_UnpackInput(RF, OutData%u) ! u + call IceFloe_UnpackOutput(RF, OutData%y) ! y + call IceFloe_UnpackMisc(RF, OutData%m) ! m + if (allocated(OutData%Input)) deallocate(OutData%Input) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%Input(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call IceFloe_UnpackInput(RF, OutData%Input(i1)) ! Input + end do + end if + if (allocated(OutData%Input_Saved)) deallocate(OutData%Input_Saved) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%Input_Saved(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input_Saved.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call IceFloe_UnpackInput(RF, OutData%Input_Saved(i1)) ! Input_Saved + end do + end if + call RegUnpackAlloc(RF, OutData%InputTimes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%InputTimes_Saved); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FAST_CopyMAP_Data(SrcMAP_DataData, DstMAP_DataData, CtrlCode, ErrStat, ErrMsg) + type(MAP_Data), intent(inout) :: SrcMAP_DataData + type(MAP_Data), intent(inout) :: DstMAP_DataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_CopyMAP_Data' + ErrStat = ErrID_None + ErrMsg = '' + LB(1:1) = lbound(SrcMAP_DataData%x) + UB(1:1) = ubound(SrcMAP_DataData%x) + do i1 = LB(1), UB(1) + call MAP_CopyContState(SrcMAP_DataData%x(i1), DstMAP_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + LB(1:1) = lbound(SrcMAP_DataData%xd) + UB(1:1) = ubound(SrcMAP_DataData%xd) + do i1 = LB(1), UB(1) + call MAP_CopyDiscState(SrcMAP_DataData%xd(i1), DstMAP_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + LB(1:1) = lbound(SrcMAP_DataData%z) + UB(1:1) = ubound(SrcMAP_DataData%z) + do i1 = LB(1), UB(1) + call MAP_CopyConstrState(SrcMAP_DataData%z(i1), DstMAP_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + call MAP_CopyOtherState(SrcMAP_DataData%OtherSt, DstMAP_DataData%OtherSt, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MAP_CopyParam(SrcMAP_DataData%p, DstMAP_DataData%p, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MAP_CopyInput(SrcMAP_DataData%u, DstMAP_DataData%u, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MAP_CopyOutput(SrcMAP_DataData%y, DstMAP_DataData%y, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MAP_CopyOtherState(SrcMAP_DataData%OtherSt_old, DstMAP_DataData%OtherSt_old, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcMAP_DataData%Output)) then + LB(1:1) = lbound(SrcMAP_DataData%Output) + UB(1:1) = ubound(SrcMAP_DataData%Output) + if (.not. allocated(DstMAP_DataData%Output)) then + allocate(DstMAP_DataData%Output(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMAP_DataData%Output.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MAP_CopyOutput(SrcMAP_DataData%Output(i1), DstMAP_DataData%Output(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call MAP_CopyOutput(SrcMAP_DataData%y_interp, DstMAP_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcMAP_DataData%Input)) then + LB(1:1) = lbound(SrcMAP_DataData%Input) + UB(1:1) = ubound(SrcMAP_DataData%Input) + if (.not. allocated(DstMAP_DataData%Input)) then + allocate(DstMAP_DataData%Input(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMAP_DataData%Input.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MAP_CopyInput(SrcMAP_DataData%Input(i1), DstMAP_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcMAP_DataData%Input_Saved)) then + LB(1:1) = lbound(SrcMAP_DataData%Input_Saved) + UB(1:1) = ubound(SrcMAP_DataData%Input_Saved) + if (.not. allocated(DstMAP_DataData%Input_Saved)) then + allocate(DstMAP_DataData%Input_Saved(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMAP_DataData%Input_Saved.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MAP_CopyInput(SrcMAP_DataData%Input_Saved(i1), DstMAP_DataData%Input_Saved(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcMAP_DataData%InputTimes)) then + LB(1:1) = lbound(SrcMAP_DataData%InputTimes) + UB(1:1) = ubound(SrcMAP_DataData%InputTimes) + if (.not. allocated(DstMAP_DataData%InputTimes)) then + allocate(DstMAP_DataData%InputTimes(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMAP_DataData%InputTimes.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMAP_DataData%InputTimes = SrcMAP_DataData%InputTimes + end if + if (allocated(SrcMAP_DataData%InputTimes_Saved)) then + LB(1:1) = lbound(SrcMAP_DataData%InputTimes_Saved) + UB(1:1) = ubound(SrcMAP_DataData%InputTimes_Saved) + if (.not. allocated(DstMAP_DataData%InputTimes_Saved)) then + allocate(DstMAP_DataData%InputTimes_Saved(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMAP_DataData%InputTimes_Saved.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMAP_DataData%InputTimes_Saved = SrcMAP_DataData%InputTimes_Saved + end if +end subroutine + +subroutine FAST_DestroyMAP_Data(MAP_DataData, ErrStat, ErrMsg) + type(MAP_Data), intent(inout) :: MAP_DataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_DestroyMAP_Data' + ErrStat = ErrID_None + ErrMsg = '' + LB(1:1) = lbound(MAP_DataData%x) + UB(1:1) = ubound(MAP_DataData%x) + do i1 = LB(1), UB(1) + call MAP_DestroyContState(MAP_DataData%x(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(MAP_DataData%xd) + UB(1:1) = ubound(MAP_DataData%xd) + do i1 = LB(1), UB(1) + call MAP_DestroyDiscState(MAP_DataData%xd(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(MAP_DataData%z) + UB(1:1) = ubound(MAP_DataData%z) + do i1 = LB(1), UB(1) + call MAP_DestroyConstrState(MAP_DataData%z(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + call MAP_DestroyOtherState(MAP_DataData%OtherSt, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MAP_DestroyParam(MAP_DataData%p, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MAP_DestroyInput(MAP_DataData%u, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MAP_DestroyOutput(MAP_DataData%y, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MAP_DestroyOtherState(MAP_DataData%OtherSt_old, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(MAP_DataData%Output)) then + LB(1:1) = lbound(MAP_DataData%Output) + UB(1:1) = ubound(MAP_DataData%Output) + do i1 = LB(1), UB(1) + call MAP_DestroyOutput(MAP_DataData%Output(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MAP_DataData%Output) + end if + call MAP_DestroyOutput(MAP_DataData%y_interp, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(MAP_DataData%Input)) then + LB(1:1) = lbound(MAP_DataData%Input) + UB(1:1) = ubound(MAP_DataData%Input) + do i1 = LB(1), UB(1) + call MAP_DestroyInput(MAP_DataData%Input(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MAP_DataData%Input) + end if + if (allocated(MAP_DataData%Input_Saved)) then + LB(1:1) = lbound(MAP_DataData%Input_Saved) + UB(1:1) = ubound(MAP_DataData%Input_Saved) + do i1 = LB(1), UB(1) + call MAP_DestroyInput(MAP_DataData%Input_Saved(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MAP_DataData%Input_Saved) + end if + if (allocated(MAP_DataData%InputTimes)) then + deallocate(MAP_DataData%InputTimes) + end if + if (allocated(MAP_DataData%InputTimes_Saved)) then + deallocate(MAP_DataData%InputTimes_Saved) + end if +end subroutine + +subroutine FAST_PackMAP_Data(RF, Indata) + type(RegFile), intent(inout) :: RF + type(MAP_Data), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackMAP_Data' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + if (RF%ErrStat >= AbortErrLev) return + LB(1:1) = lbound(InData%x) + UB(1:1) = ubound(InData%x) + do i1 = LB(1), UB(1) + call MAP_PackContState(RF, InData%x(i1)) + end do + LB(1:1) = lbound(InData%xd) + UB(1:1) = ubound(InData%xd) + do i1 = LB(1), UB(1) + call MAP_PackDiscState(RF, InData%xd(i1)) + end do + LB(1:1) = lbound(InData%z) + UB(1:1) = ubound(InData%z) + do i1 = LB(1), UB(1) + call MAP_PackConstrState(RF, InData%z(i1)) + end do + call MAP_PackOtherState(RF, InData%OtherSt) + call MAP_PackParam(RF, InData%p) + call MAP_PackInput(RF, InData%u) + call MAP_PackOutput(RF, InData%y) + call MAP_PackOtherState(RF, InData%OtherSt_old) + call RegPack(RF, allocated(InData%Output)) + if (allocated(InData%Output)) then + call RegPackBounds(RF, 1, lbound(InData%Output), ubound(InData%Output)) + LB(1:1) = lbound(InData%Output) + UB(1:1) = ubound(InData%Output) + do i1 = LB(1), UB(1) + call MAP_PackOutput(RF, InData%Output(i1)) + end do + end if + call MAP_PackOutput(RF, InData%y_interp) + call RegPack(RF, allocated(InData%Input)) + if (allocated(InData%Input)) then + call RegPackBounds(RF, 1, lbound(InData%Input), ubound(InData%Input)) + LB(1:1) = lbound(InData%Input) + UB(1:1) = ubound(InData%Input) + do i1 = LB(1), UB(1) + call MAP_PackInput(RF, InData%Input(i1)) + end do + end if + call RegPack(RF, allocated(InData%Input_Saved)) + if (allocated(InData%Input_Saved)) then + call RegPackBounds(RF, 1, lbound(InData%Input_Saved), ubound(InData%Input_Saved)) + LB(1:1) = lbound(InData%Input_Saved) + UB(1:1) = ubound(InData%Input_Saved) + do i1 = LB(1), UB(1) + call MAP_PackInput(RF, InData%Input_Saved(i1)) + end do + end if + call RegPackAlloc(RF, InData%InputTimes) + call RegPackAlloc(RF, InData%InputTimes_Saved) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FAST_UnPackMAP_Data(RF, OutData) + type(RegFile), intent(inout) :: RF + type(MAP_Data), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackMAP_Data' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + LB(1:1) = lbound(OutData%x) + UB(1:1) = ubound(OutData%x) + do i1 = LB(1), UB(1) + call MAP_UnpackContState(RF, OutData%x(i1)) ! x + end do + LB(1:1) = lbound(OutData%xd) + UB(1:1) = ubound(OutData%xd) + do i1 = LB(1), UB(1) + call MAP_UnpackDiscState(RF, OutData%xd(i1)) ! xd + end do + LB(1:1) = lbound(OutData%z) + UB(1:1) = ubound(OutData%z) + do i1 = LB(1), UB(1) + call MAP_UnpackConstrState(RF, OutData%z(i1)) ! z + end do + call MAP_UnpackOtherState(RF, OutData%OtherSt) ! OtherSt + call MAP_UnpackParam(RF, OutData%p) ! p + call MAP_UnpackInput(RF, OutData%u) ! u + call MAP_UnpackOutput(RF, OutData%y) ! y + call MAP_UnpackOtherState(RF, OutData%OtherSt_old) ! OtherSt_old + if (allocated(OutData%Output)) deallocate(OutData%Output) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%Output(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MAP_UnpackOutput(RF, OutData%Output(i1)) ! Output + end do + end if + call MAP_UnpackOutput(RF, OutData%y_interp) ! y_interp + if (allocated(OutData%Input)) deallocate(OutData%Input) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%Input(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MAP_UnpackInput(RF, OutData%Input(i1)) ! Input + end do + end if + if (allocated(OutData%Input_Saved)) deallocate(OutData%Input_Saved) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%Input_Saved(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input_Saved.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MAP_UnpackInput(RF, OutData%Input_Saved(i1)) ! Input_Saved + end do + end if + call RegUnpackAlloc(RF, OutData%InputTimes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%InputTimes_Saved); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FAST_CopyFEAMooring_Data(SrcFEAMooring_DataData, DstFEAMooring_DataData, CtrlCode, ErrStat, ErrMsg) + type(FEAMooring_Data), intent(inout) :: SrcFEAMooring_DataData + type(FEAMooring_Data), intent(inout) :: DstFEAMooring_DataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_CopyFEAMooring_Data' + ErrStat = ErrID_None + ErrMsg = '' + LB(1:1) = lbound(SrcFEAMooring_DataData%x) + UB(1:1) = ubound(SrcFEAMooring_DataData%x) + do i1 = LB(1), UB(1) + call FEAM_CopyContState(SrcFEAMooring_DataData%x(i1), DstFEAMooring_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + LB(1:1) = lbound(SrcFEAMooring_DataData%xd) + UB(1:1) = ubound(SrcFEAMooring_DataData%xd) + do i1 = LB(1), UB(1) + call FEAM_CopyDiscState(SrcFEAMooring_DataData%xd(i1), DstFEAMooring_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + LB(1:1) = lbound(SrcFEAMooring_DataData%z) + UB(1:1) = ubound(SrcFEAMooring_DataData%z) + do i1 = LB(1), UB(1) + call FEAM_CopyConstrState(SrcFEAMooring_DataData%z(i1), DstFEAMooring_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + LB(1:1) = lbound(SrcFEAMooring_DataData%OtherSt) + UB(1:1) = ubound(SrcFEAMooring_DataData%OtherSt) + do i1 = LB(1), UB(1) + call FEAM_CopyOtherState(SrcFEAMooring_DataData%OtherSt(i1), DstFEAMooring_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + call FEAM_CopyParam(SrcFEAMooring_DataData%p, DstFEAMooring_DataData%p, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FEAM_CopyInput(SrcFEAMooring_DataData%u, DstFEAMooring_DataData%u, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FEAM_CopyOutput(SrcFEAMooring_DataData%y, DstFEAMooring_DataData%y, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FEAM_CopyMisc(SrcFEAMooring_DataData%m, DstFEAMooring_DataData%m, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcFEAMooring_DataData%Input)) then + LB(1:1) = lbound(SrcFEAMooring_DataData%Input) + UB(1:1) = ubound(SrcFEAMooring_DataData%Input) + if (.not. allocated(DstFEAMooring_DataData%Input)) then + allocate(DstFEAMooring_DataData%Input(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstFEAMooring_DataData%Input.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call FEAM_CopyInput(SrcFEAMooring_DataData%Input(i1), DstFEAMooring_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcFEAMooring_DataData%Input_Saved)) then + LB(1:1) = lbound(SrcFEAMooring_DataData%Input_Saved) + UB(1:1) = ubound(SrcFEAMooring_DataData%Input_Saved) + if (.not. allocated(DstFEAMooring_DataData%Input_Saved)) then + allocate(DstFEAMooring_DataData%Input_Saved(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstFEAMooring_DataData%Input_Saved.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call FEAM_CopyInput(SrcFEAMooring_DataData%Input_Saved(i1), DstFEAMooring_DataData%Input_Saved(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcFEAMooring_DataData%InputTimes)) then + LB(1:1) = lbound(SrcFEAMooring_DataData%InputTimes) + UB(1:1) = ubound(SrcFEAMooring_DataData%InputTimes) + if (.not. allocated(DstFEAMooring_DataData%InputTimes)) then + allocate(DstFEAMooring_DataData%InputTimes(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstFEAMooring_DataData%InputTimes.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstFEAMooring_DataData%InputTimes = SrcFEAMooring_DataData%InputTimes + end if + if (allocated(SrcFEAMooring_DataData%InputTimes_Saved)) then + LB(1:1) = lbound(SrcFEAMooring_DataData%InputTimes_Saved) + UB(1:1) = ubound(SrcFEAMooring_DataData%InputTimes_Saved) + if (.not. allocated(DstFEAMooring_DataData%InputTimes_Saved)) then + allocate(DstFEAMooring_DataData%InputTimes_Saved(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstFEAMooring_DataData%InputTimes_Saved.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstFEAMooring_DataData%InputTimes_Saved = SrcFEAMooring_DataData%InputTimes_Saved + end if +end subroutine + +subroutine FAST_DestroyFEAMooring_Data(FEAMooring_DataData, ErrStat, ErrMsg) + type(FEAMooring_Data), intent(inout) :: FEAMooring_DataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_DestroyFEAMooring_Data' + ErrStat = ErrID_None + ErrMsg = '' + LB(1:1) = lbound(FEAMooring_DataData%x) + UB(1:1) = ubound(FEAMooring_DataData%x) + do i1 = LB(1), UB(1) + call FEAM_DestroyContState(FEAMooring_DataData%x(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(FEAMooring_DataData%xd) + UB(1:1) = ubound(FEAMooring_DataData%xd) + do i1 = LB(1), UB(1) + call FEAM_DestroyDiscState(FEAMooring_DataData%xd(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(FEAMooring_DataData%z) + UB(1:1) = ubound(FEAMooring_DataData%z) + do i1 = LB(1), UB(1) + call FEAM_DestroyConstrState(FEAMooring_DataData%z(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(FEAMooring_DataData%OtherSt) + UB(1:1) = ubound(FEAMooring_DataData%OtherSt) + do i1 = LB(1), UB(1) + call FEAM_DestroyOtherState(FEAMooring_DataData%OtherSt(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + call FEAM_DestroyParam(FEAMooring_DataData%p, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FEAM_DestroyInput(FEAMooring_DataData%u, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FEAM_DestroyOutput(FEAMooring_DataData%y, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FEAM_DestroyMisc(FEAMooring_DataData%m, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(FEAMooring_DataData%Input)) then + LB(1:1) = lbound(FEAMooring_DataData%Input) + UB(1:1) = ubound(FEAMooring_DataData%Input) + do i1 = LB(1), UB(1) + call FEAM_DestroyInput(FEAMooring_DataData%Input(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(FEAMooring_DataData%Input) + end if + if (allocated(FEAMooring_DataData%Input_Saved)) then + LB(1:1) = lbound(FEAMooring_DataData%Input_Saved) + UB(1:1) = ubound(FEAMooring_DataData%Input_Saved) + do i1 = LB(1), UB(1) + call FEAM_DestroyInput(FEAMooring_DataData%Input_Saved(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(FEAMooring_DataData%Input_Saved) + end if + if (allocated(FEAMooring_DataData%InputTimes)) then + deallocate(FEAMooring_DataData%InputTimes) + end if + if (allocated(FEAMooring_DataData%InputTimes_Saved)) then + deallocate(FEAMooring_DataData%InputTimes_Saved) + end if +end subroutine + +subroutine FAST_PackFEAMooring_Data(RF, Indata) + type(RegFile), intent(inout) :: RF + type(FEAMooring_Data), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackFEAMooring_Data' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + if (RF%ErrStat >= AbortErrLev) return + LB(1:1) = lbound(InData%x) + UB(1:1) = ubound(InData%x) + do i1 = LB(1), UB(1) + call FEAM_PackContState(RF, InData%x(i1)) + end do + LB(1:1) = lbound(InData%xd) + UB(1:1) = ubound(InData%xd) + do i1 = LB(1), UB(1) + call FEAM_PackDiscState(RF, InData%xd(i1)) + end do + LB(1:1) = lbound(InData%z) + UB(1:1) = ubound(InData%z) + do i1 = LB(1), UB(1) + call FEAM_PackConstrState(RF, InData%z(i1)) + end do + LB(1:1) = lbound(InData%OtherSt) + UB(1:1) = ubound(InData%OtherSt) + do i1 = LB(1), UB(1) + call FEAM_PackOtherState(RF, InData%OtherSt(i1)) + end do + call FEAM_PackParam(RF, InData%p) + call FEAM_PackInput(RF, InData%u) + call FEAM_PackOutput(RF, InData%y) + call FEAM_PackMisc(RF, InData%m) + call RegPack(RF, allocated(InData%Input)) + if (allocated(InData%Input)) then + call RegPackBounds(RF, 1, lbound(InData%Input), ubound(InData%Input)) + LB(1:1) = lbound(InData%Input) + UB(1:1) = ubound(InData%Input) + do i1 = LB(1), UB(1) + call FEAM_PackInput(RF, InData%Input(i1)) + end do + end if + call RegPack(RF, allocated(InData%Input_Saved)) + if (allocated(InData%Input_Saved)) then + call RegPackBounds(RF, 1, lbound(InData%Input_Saved), ubound(InData%Input_Saved)) + LB(1:1) = lbound(InData%Input_Saved) + UB(1:1) = ubound(InData%Input_Saved) + do i1 = LB(1), UB(1) + call FEAM_PackInput(RF, InData%Input_Saved(i1)) + end do + end if + call RegPackAlloc(RF, InData%InputTimes) + call RegPackAlloc(RF, InData%InputTimes_Saved) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FAST_UnPackFEAMooring_Data(RF, OutData) + type(RegFile), intent(inout) :: RF + type(FEAMooring_Data), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackFEAMooring_Data' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + LB(1:1) = lbound(OutData%x) + UB(1:1) = ubound(OutData%x) + do i1 = LB(1), UB(1) + call FEAM_UnpackContState(RF, OutData%x(i1)) ! x + end do + LB(1:1) = lbound(OutData%xd) + UB(1:1) = ubound(OutData%xd) + do i1 = LB(1), UB(1) + call FEAM_UnpackDiscState(RF, OutData%xd(i1)) ! xd + end do + LB(1:1) = lbound(OutData%z) + UB(1:1) = ubound(OutData%z) + do i1 = LB(1), UB(1) + call FEAM_UnpackConstrState(RF, OutData%z(i1)) ! z + end do + LB(1:1) = lbound(OutData%OtherSt) + UB(1:1) = ubound(OutData%OtherSt) + do i1 = LB(1), UB(1) + call FEAM_UnpackOtherState(RF, OutData%OtherSt(i1)) ! OtherSt + end do + call FEAM_UnpackParam(RF, OutData%p) ! p + call FEAM_UnpackInput(RF, OutData%u) ! u + call FEAM_UnpackOutput(RF, OutData%y) ! y + call FEAM_UnpackMisc(RF, OutData%m) ! m + if (allocated(OutData%Input)) deallocate(OutData%Input) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%Input(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call FEAM_UnpackInput(RF, OutData%Input(i1)) ! Input + end do + end if + if (allocated(OutData%Input_Saved)) deallocate(OutData%Input_Saved) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%Input_Saved(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input_Saved.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call FEAM_UnpackInput(RF, OutData%Input_Saved(i1)) ! Input_Saved + end do + end if + call RegUnpackAlloc(RF, OutData%InputTimes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%InputTimes_Saved); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FAST_CopyMoorDyn_Data(SrcMoorDyn_DataData, DstMoorDyn_DataData, CtrlCode, ErrStat, ErrMsg) + type(MoorDyn_Data), intent(inout) :: SrcMoorDyn_DataData + type(MoorDyn_Data), intent(inout) :: DstMoorDyn_DataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_CopyMoorDyn_Data' + ErrStat = ErrID_None + ErrMsg = '' + LB(1:1) = lbound(SrcMoorDyn_DataData%x) + UB(1:1) = ubound(SrcMoorDyn_DataData%x) + do i1 = LB(1), UB(1) + call MD_CopyContState(SrcMoorDyn_DataData%x(i1), DstMoorDyn_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + LB(1:1) = lbound(SrcMoorDyn_DataData%xd) + UB(1:1) = ubound(SrcMoorDyn_DataData%xd) + do i1 = LB(1), UB(1) + call MD_CopyDiscState(SrcMoorDyn_DataData%xd(i1), DstMoorDyn_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + LB(1:1) = lbound(SrcMoorDyn_DataData%z) + UB(1:1) = ubound(SrcMoorDyn_DataData%z) + do i1 = LB(1), UB(1) + call MD_CopyConstrState(SrcMoorDyn_DataData%z(i1), DstMoorDyn_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + LB(1:1) = lbound(SrcMoorDyn_DataData%OtherSt) + UB(1:1) = ubound(SrcMoorDyn_DataData%OtherSt) + do i1 = LB(1), UB(1) + call MD_CopyOtherState(SrcMoorDyn_DataData%OtherSt(i1), DstMoorDyn_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + call MD_CopyParam(SrcMoorDyn_DataData%p, DstMoorDyn_DataData%p, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MD_CopyInput(SrcMoorDyn_DataData%u, DstMoorDyn_DataData%u, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MD_CopyOutput(SrcMoorDyn_DataData%y, DstMoorDyn_DataData%y, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MD_CopyMisc(SrcMoorDyn_DataData%m, DstMoorDyn_DataData%m, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcMoorDyn_DataData%Output)) then + LB(1:1) = lbound(SrcMoorDyn_DataData%Output) + UB(1:1) = ubound(SrcMoorDyn_DataData%Output) + if (.not. allocated(DstMoorDyn_DataData%Output)) then + allocate(DstMoorDyn_DataData%Output(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMoorDyn_DataData%Output.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MD_CopyOutput(SrcMoorDyn_DataData%Output(i1), DstMoorDyn_DataData%Output(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call MD_CopyOutput(SrcMoorDyn_DataData%y_interp, DstMoorDyn_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcMoorDyn_DataData%Input)) then + LB(1:1) = lbound(SrcMoorDyn_DataData%Input) + UB(1:1) = ubound(SrcMoorDyn_DataData%Input) + if (.not. allocated(DstMoorDyn_DataData%Input)) then + allocate(DstMoorDyn_DataData%Input(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMoorDyn_DataData%Input.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MD_CopyInput(SrcMoorDyn_DataData%Input(i1), DstMoorDyn_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcMoorDyn_DataData%Input_Saved)) then + LB(1:1) = lbound(SrcMoorDyn_DataData%Input_Saved) + UB(1:1) = ubound(SrcMoorDyn_DataData%Input_Saved) + if (.not. allocated(DstMoorDyn_DataData%Input_Saved)) then + allocate(DstMoorDyn_DataData%Input_Saved(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMoorDyn_DataData%Input_Saved.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MD_CopyInput(SrcMoorDyn_DataData%Input_Saved(i1), DstMoorDyn_DataData%Input_Saved(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcMoorDyn_DataData%InputTimes)) then + LB(1:1) = lbound(SrcMoorDyn_DataData%InputTimes) + UB(1:1) = ubound(SrcMoorDyn_DataData%InputTimes) + if (.not. allocated(DstMoorDyn_DataData%InputTimes)) then + allocate(DstMoorDyn_DataData%InputTimes(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMoorDyn_DataData%InputTimes.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMoorDyn_DataData%InputTimes = SrcMoorDyn_DataData%InputTimes + end if + if (allocated(SrcMoorDyn_DataData%InputTimes_Saved)) then + LB(1:1) = lbound(SrcMoorDyn_DataData%InputTimes_Saved) + UB(1:1) = ubound(SrcMoorDyn_DataData%InputTimes_Saved) + if (.not. allocated(DstMoorDyn_DataData%InputTimes_Saved)) then + allocate(DstMoorDyn_DataData%InputTimes_Saved(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMoorDyn_DataData%InputTimes_Saved.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMoorDyn_DataData%InputTimes_Saved = SrcMoorDyn_DataData%InputTimes_Saved + end if +end subroutine + +subroutine FAST_DestroyMoorDyn_Data(MoorDyn_DataData, ErrStat, ErrMsg) + type(MoorDyn_Data), intent(inout) :: MoorDyn_DataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_DestroyMoorDyn_Data' + ErrStat = ErrID_None + ErrMsg = '' + LB(1:1) = lbound(MoorDyn_DataData%x) + UB(1:1) = ubound(MoorDyn_DataData%x) + do i1 = LB(1), UB(1) + call MD_DestroyContState(MoorDyn_DataData%x(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(MoorDyn_DataData%xd) + UB(1:1) = ubound(MoorDyn_DataData%xd) + do i1 = LB(1), UB(1) + call MD_DestroyDiscState(MoorDyn_DataData%xd(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(MoorDyn_DataData%z) + UB(1:1) = ubound(MoorDyn_DataData%z) + do i1 = LB(1), UB(1) + call MD_DestroyConstrState(MoorDyn_DataData%z(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(MoorDyn_DataData%OtherSt) + UB(1:1) = ubound(MoorDyn_DataData%OtherSt) + do i1 = LB(1), UB(1) + call MD_DestroyOtherState(MoorDyn_DataData%OtherSt(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + call MD_DestroyParam(MoorDyn_DataData%p, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MD_DestroyInput(MoorDyn_DataData%u, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MD_DestroyOutput(MoorDyn_DataData%y, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MD_DestroyMisc(MoorDyn_DataData%m, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(MoorDyn_DataData%Output)) then + LB(1:1) = lbound(MoorDyn_DataData%Output) + UB(1:1) = ubound(MoorDyn_DataData%Output) + do i1 = LB(1), UB(1) + call MD_DestroyOutput(MoorDyn_DataData%Output(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MoorDyn_DataData%Output) + end if + call MD_DestroyOutput(MoorDyn_DataData%y_interp, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(MoorDyn_DataData%Input)) then + LB(1:1) = lbound(MoorDyn_DataData%Input) + UB(1:1) = ubound(MoorDyn_DataData%Input) + do i1 = LB(1), UB(1) + call MD_DestroyInput(MoorDyn_DataData%Input(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MoorDyn_DataData%Input) + end if + if (allocated(MoorDyn_DataData%Input_Saved)) then + LB(1:1) = lbound(MoorDyn_DataData%Input_Saved) + UB(1:1) = ubound(MoorDyn_DataData%Input_Saved) + do i1 = LB(1), UB(1) + call MD_DestroyInput(MoorDyn_DataData%Input_Saved(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MoorDyn_DataData%Input_Saved) + end if + if (allocated(MoorDyn_DataData%InputTimes)) then + deallocate(MoorDyn_DataData%InputTimes) + end if + if (allocated(MoorDyn_DataData%InputTimes_Saved)) then + deallocate(MoorDyn_DataData%InputTimes_Saved) + end if +end subroutine + +subroutine FAST_PackMoorDyn_Data(RF, Indata) + type(RegFile), intent(inout) :: RF + type(MoorDyn_Data), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackMoorDyn_Data' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + if (RF%ErrStat >= AbortErrLev) return + LB(1:1) = lbound(InData%x) + UB(1:1) = ubound(InData%x) + do i1 = LB(1), UB(1) + call MD_PackContState(RF, InData%x(i1)) + end do + LB(1:1) = lbound(InData%xd) + UB(1:1) = ubound(InData%xd) + do i1 = LB(1), UB(1) + call MD_PackDiscState(RF, InData%xd(i1)) + end do + LB(1:1) = lbound(InData%z) + UB(1:1) = ubound(InData%z) + do i1 = LB(1), UB(1) + call MD_PackConstrState(RF, InData%z(i1)) + end do + LB(1:1) = lbound(InData%OtherSt) + UB(1:1) = ubound(InData%OtherSt) + do i1 = LB(1), UB(1) + call MD_PackOtherState(RF, InData%OtherSt(i1)) + end do + call MD_PackParam(RF, InData%p) + call MD_PackInput(RF, InData%u) + call MD_PackOutput(RF, InData%y) + call MD_PackMisc(RF, InData%m) + call RegPack(RF, allocated(InData%Output)) + if (allocated(InData%Output)) then + call RegPackBounds(RF, 1, lbound(InData%Output), ubound(InData%Output)) + LB(1:1) = lbound(InData%Output) + UB(1:1) = ubound(InData%Output) + do i1 = LB(1), UB(1) + call MD_PackOutput(RF, InData%Output(i1)) + end do + end if + call MD_PackOutput(RF, InData%y_interp) + call RegPack(RF, allocated(InData%Input)) + if (allocated(InData%Input)) then + call RegPackBounds(RF, 1, lbound(InData%Input), ubound(InData%Input)) + LB(1:1) = lbound(InData%Input) + UB(1:1) = ubound(InData%Input) + do i1 = LB(1), UB(1) + call MD_PackInput(RF, InData%Input(i1)) + end do + end if + call RegPack(RF, allocated(InData%Input_Saved)) + if (allocated(InData%Input_Saved)) then + call RegPackBounds(RF, 1, lbound(InData%Input_Saved), ubound(InData%Input_Saved)) + LB(1:1) = lbound(InData%Input_Saved) + UB(1:1) = ubound(InData%Input_Saved) + do i1 = LB(1), UB(1) + call MD_PackInput(RF, InData%Input_Saved(i1)) + end do + end if + call RegPackAlloc(RF, InData%InputTimes) + call RegPackAlloc(RF, InData%InputTimes_Saved) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FAST_UnPackMoorDyn_Data(RF, OutData) + type(RegFile), intent(inout) :: RF + type(MoorDyn_Data), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackMoorDyn_Data' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + LB(1:1) = lbound(OutData%x) + UB(1:1) = ubound(OutData%x) + do i1 = LB(1), UB(1) + call MD_UnpackContState(RF, OutData%x(i1)) ! x + end do + LB(1:1) = lbound(OutData%xd) + UB(1:1) = ubound(OutData%xd) + do i1 = LB(1), UB(1) + call MD_UnpackDiscState(RF, OutData%xd(i1)) ! xd + end do + LB(1:1) = lbound(OutData%z) + UB(1:1) = ubound(OutData%z) + do i1 = LB(1), UB(1) + call MD_UnpackConstrState(RF, OutData%z(i1)) ! z + end do + LB(1:1) = lbound(OutData%OtherSt) + UB(1:1) = ubound(OutData%OtherSt) + do i1 = LB(1), UB(1) + call MD_UnpackOtherState(RF, OutData%OtherSt(i1)) ! OtherSt + end do + call MD_UnpackParam(RF, OutData%p) ! p + call MD_UnpackInput(RF, OutData%u) ! u + call MD_UnpackOutput(RF, OutData%y) ! y + call MD_UnpackMisc(RF, OutData%m) ! m + if (allocated(OutData%Output)) deallocate(OutData%Output) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%Output(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MD_UnpackOutput(RF, OutData%Output(i1)) ! Output + end do + end if + call MD_UnpackOutput(RF, OutData%y_interp) ! y_interp + if (allocated(OutData%Input)) deallocate(OutData%Input) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%Input(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MD_UnpackInput(RF, OutData%Input(i1)) ! Input + end do + end if + if (allocated(OutData%Input_Saved)) deallocate(OutData%Input_Saved) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%Input_Saved(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input_Saved.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MD_UnpackInput(RF, OutData%Input_Saved(i1)) ! Input_Saved + end do + end if + call RegUnpackAlloc(RF, OutData%InputTimes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%InputTimes_Saved); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FAST_CopyOrcaFlex_Data(SrcOrcaFlex_DataData, DstOrcaFlex_DataData, CtrlCode, ErrStat, ErrMsg) + type(OrcaFlex_Data), intent(inout) :: SrcOrcaFlex_DataData + type(OrcaFlex_Data), intent(inout) :: DstOrcaFlex_DataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_CopyOrcaFlex_Data' + ErrStat = ErrID_None + ErrMsg = '' + LB(1:1) = lbound(SrcOrcaFlex_DataData%x) + UB(1:1) = ubound(SrcOrcaFlex_DataData%x) + do i1 = LB(1), UB(1) + call Orca_CopyContState(SrcOrcaFlex_DataData%x(i1), DstOrcaFlex_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + LB(1:1) = lbound(SrcOrcaFlex_DataData%xd) + UB(1:1) = ubound(SrcOrcaFlex_DataData%xd) + do i1 = LB(1), UB(1) + call Orca_CopyDiscState(SrcOrcaFlex_DataData%xd(i1), DstOrcaFlex_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + LB(1:1) = lbound(SrcOrcaFlex_DataData%z) + UB(1:1) = ubound(SrcOrcaFlex_DataData%z) + do i1 = LB(1), UB(1) + call Orca_CopyConstrState(SrcOrcaFlex_DataData%z(i1), DstOrcaFlex_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + LB(1:1) = lbound(SrcOrcaFlex_DataData%OtherSt) + UB(1:1) = ubound(SrcOrcaFlex_DataData%OtherSt) + do i1 = LB(1), UB(1) + call Orca_CopyOtherState(SrcOrcaFlex_DataData%OtherSt(i1), DstOrcaFlex_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + call Orca_CopyParam(SrcOrcaFlex_DataData%p, DstOrcaFlex_DataData%p, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call Orca_CopyInput(SrcOrcaFlex_DataData%u, DstOrcaFlex_DataData%u, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call Orca_CopyOutput(SrcOrcaFlex_DataData%y, DstOrcaFlex_DataData%y, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call Orca_CopyMisc(SrcOrcaFlex_DataData%m, DstOrcaFlex_DataData%m, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcOrcaFlex_DataData%Input)) then + LB(1:1) = lbound(SrcOrcaFlex_DataData%Input) + UB(1:1) = ubound(SrcOrcaFlex_DataData%Input) + if (.not. allocated(DstOrcaFlex_DataData%Input)) then + allocate(DstOrcaFlex_DataData%Input(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOrcaFlex_DataData%Input.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call Orca_CopyInput(SrcOrcaFlex_DataData%Input(i1), DstOrcaFlex_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcOrcaFlex_DataData%Input_Saved)) then + LB(1:1) = lbound(SrcOrcaFlex_DataData%Input_Saved) + UB(1:1) = ubound(SrcOrcaFlex_DataData%Input_Saved) + if (.not. allocated(DstOrcaFlex_DataData%Input_Saved)) then + allocate(DstOrcaFlex_DataData%Input_Saved(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOrcaFlex_DataData%Input_Saved.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call Orca_CopyInput(SrcOrcaFlex_DataData%Input_Saved(i1), DstOrcaFlex_DataData%Input_Saved(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcOrcaFlex_DataData%InputTimes)) then + LB(1:1) = lbound(SrcOrcaFlex_DataData%InputTimes) + UB(1:1) = ubound(SrcOrcaFlex_DataData%InputTimes) + if (.not. allocated(DstOrcaFlex_DataData%InputTimes)) then + allocate(DstOrcaFlex_DataData%InputTimes(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOrcaFlex_DataData%InputTimes.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOrcaFlex_DataData%InputTimes = SrcOrcaFlex_DataData%InputTimes + end if + if (allocated(SrcOrcaFlex_DataData%InputTimes_Saved)) then + LB(1:1) = lbound(SrcOrcaFlex_DataData%InputTimes_Saved) + UB(1:1) = ubound(SrcOrcaFlex_DataData%InputTimes_Saved) + if (.not. allocated(DstOrcaFlex_DataData%InputTimes_Saved)) then + allocate(DstOrcaFlex_DataData%InputTimes_Saved(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOrcaFlex_DataData%InputTimes_Saved.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOrcaFlex_DataData%InputTimes_Saved = SrcOrcaFlex_DataData%InputTimes_Saved + end if +end subroutine + +subroutine FAST_DestroyOrcaFlex_Data(OrcaFlex_DataData, ErrStat, ErrMsg) + type(OrcaFlex_Data), intent(inout) :: OrcaFlex_DataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_DestroyOrcaFlex_Data' + ErrStat = ErrID_None + ErrMsg = '' + LB(1:1) = lbound(OrcaFlex_DataData%x) + UB(1:1) = ubound(OrcaFlex_DataData%x) + do i1 = LB(1), UB(1) + call Orca_DestroyContState(OrcaFlex_DataData%x(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(OrcaFlex_DataData%xd) + UB(1:1) = ubound(OrcaFlex_DataData%xd) + do i1 = LB(1), UB(1) + call Orca_DestroyDiscState(OrcaFlex_DataData%xd(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(OrcaFlex_DataData%z) + UB(1:1) = ubound(OrcaFlex_DataData%z) + do i1 = LB(1), UB(1) + call Orca_DestroyConstrState(OrcaFlex_DataData%z(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(OrcaFlex_DataData%OtherSt) + UB(1:1) = ubound(OrcaFlex_DataData%OtherSt) + do i1 = LB(1), UB(1) + call Orca_DestroyOtherState(OrcaFlex_DataData%OtherSt(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + call Orca_DestroyParam(OrcaFlex_DataData%p, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call Orca_DestroyInput(OrcaFlex_DataData%u, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call Orca_DestroyOutput(OrcaFlex_DataData%y, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call Orca_DestroyMisc(OrcaFlex_DataData%m, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(OrcaFlex_DataData%Input)) then + LB(1:1) = lbound(OrcaFlex_DataData%Input) + UB(1:1) = ubound(OrcaFlex_DataData%Input) + do i1 = LB(1), UB(1) + call Orca_DestroyInput(OrcaFlex_DataData%Input(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(OrcaFlex_DataData%Input) + end if + if (allocated(OrcaFlex_DataData%Input_Saved)) then + LB(1:1) = lbound(OrcaFlex_DataData%Input_Saved) + UB(1:1) = ubound(OrcaFlex_DataData%Input_Saved) + do i1 = LB(1), UB(1) + call Orca_DestroyInput(OrcaFlex_DataData%Input_Saved(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(OrcaFlex_DataData%Input_Saved) + end if + if (allocated(OrcaFlex_DataData%InputTimes)) then + deallocate(OrcaFlex_DataData%InputTimes) + end if + if (allocated(OrcaFlex_DataData%InputTimes_Saved)) then + deallocate(OrcaFlex_DataData%InputTimes_Saved) + end if +end subroutine + +subroutine FAST_PackOrcaFlex_Data(RF, Indata) + type(RegFile), intent(inout) :: RF + type(OrcaFlex_Data), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackOrcaFlex_Data' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + if (RF%ErrStat >= AbortErrLev) return + LB(1:1) = lbound(InData%x) + UB(1:1) = ubound(InData%x) + do i1 = LB(1), UB(1) + call Orca_PackContState(RF, InData%x(i1)) + end do + LB(1:1) = lbound(InData%xd) + UB(1:1) = ubound(InData%xd) + do i1 = LB(1), UB(1) + call Orca_PackDiscState(RF, InData%xd(i1)) + end do + LB(1:1) = lbound(InData%z) + UB(1:1) = ubound(InData%z) + do i1 = LB(1), UB(1) + call Orca_PackConstrState(RF, InData%z(i1)) + end do + LB(1:1) = lbound(InData%OtherSt) + UB(1:1) = ubound(InData%OtherSt) + do i1 = LB(1), UB(1) + call Orca_PackOtherState(RF, InData%OtherSt(i1)) + end do + call Orca_PackParam(RF, InData%p) + call Orca_PackInput(RF, InData%u) + call Orca_PackOutput(RF, InData%y) + call Orca_PackMisc(RF, InData%m) + call RegPack(RF, allocated(InData%Input)) + if (allocated(InData%Input)) then + call RegPackBounds(RF, 1, lbound(InData%Input), ubound(InData%Input)) + LB(1:1) = lbound(InData%Input) + UB(1:1) = ubound(InData%Input) + do i1 = LB(1), UB(1) + call Orca_PackInput(RF, InData%Input(i1)) + end do + end if + call RegPack(RF, allocated(InData%Input_Saved)) + if (allocated(InData%Input_Saved)) then + call RegPackBounds(RF, 1, lbound(InData%Input_Saved), ubound(InData%Input_Saved)) + LB(1:1) = lbound(InData%Input_Saved) + UB(1:1) = ubound(InData%Input_Saved) + do i1 = LB(1), UB(1) + call Orca_PackInput(RF, InData%Input_Saved(i1)) + end do + end if + call RegPackAlloc(RF, InData%InputTimes) + call RegPackAlloc(RF, InData%InputTimes_Saved) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FAST_UnPackOrcaFlex_Data(RF, OutData) + type(RegFile), intent(inout) :: RF + type(OrcaFlex_Data), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackOrcaFlex_Data' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + LB(1:1) = lbound(OutData%x) + UB(1:1) = ubound(OutData%x) + do i1 = LB(1), UB(1) + call Orca_UnpackContState(RF, OutData%x(i1)) ! x + end do + LB(1:1) = lbound(OutData%xd) + UB(1:1) = ubound(OutData%xd) + do i1 = LB(1), UB(1) + call Orca_UnpackDiscState(RF, OutData%xd(i1)) ! xd + end do + LB(1:1) = lbound(OutData%z) + UB(1:1) = ubound(OutData%z) + do i1 = LB(1), UB(1) + call Orca_UnpackConstrState(RF, OutData%z(i1)) ! z + end do + LB(1:1) = lbound(OutData%OtherSt) + UB(1:1) = ubound(OutData%OtherSt) + do i1 = LB(1), UB(1) + call Orca_UnpackOtherState(RF, OutData%OtherSt(i1)) ! OtherSt + end do + call Orca_UnpackParam(RF, OutData%p) ! p + call Orca_UnpackInput(RF, OutData%u) ! u + call Orca_UnpackOutput(RF, OutData%y) ! y + call Orca_UnpackMisc(RF, OutData%m) ! m + if (allocated(OutData%Input)) deallocate(OutData%Input) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%Input(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call Orca_UnpackInput(RF, OutData%Input(i1)) ! Input + end do + end if + if (allocated(OutData%Input_Saved)) deallocate(OutData%Input_Saved) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%Input_Saved(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input_Saved.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call Orca_UnpackInput(RF, OutData%Input_Saved(i1)) ! Input_Saved + end do + end if + call RegUnpackAlloc(RF, OutData%InputTimes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%InputTimes_Saved); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, CtrlCode, ErrStat, ErrMsg) + type(FAST_ModuleMapType), intent(inout) :: SrcModuleMapTypeData + type(FAST_ModuleMapType), intent(inout) :: DstModuleMapTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_CopyModuleMapType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcModuleMapTypeData%ED_P_2_BD_P)) then + LB(1:1) = lbound(SrcModuleMapTypeData%ED_P_2_BD_P) + UB(1:1) = ubound(SrcModuleMapTypeData%ED_P_2_BD_P) + if (.not. allocated(DstModuleMapTypeData%ED_P_2_BD_P)) then + allocate(DstModuleMapTypeData%ED_P_2_BD_P(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%ED_P_2_BD_P.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%ED_P_2_BD_P(i1), DstModuleMapTypeData%ED_P_2_BD_P(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcModuleMapTypeData%BD_P_2_ED_P)) then + LB(1:1) = lbound(SrcModuleMapTypeData%BD_P_2_ED_P) + UB(1:1) = ubound(SrcModuleMapTypeData%BD_P_2_ED_P) + if (.not. allocated(DstModuleMapTypeData%BD_P_2_ED_P)) then + allocate(DstModuleMapTypeData%BD_P_2_ED_P(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%BD_P_2_ED_P.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%BD_P_2_ED_P(i1), DstModuleMapTypeData%BD_P_2_ED_P(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcModuleMapTypeData%ED_P_2_BD_P_Hub)) then + LB(1:1) = lbound(SrcModuleMapTypeData%ED_P_2_BD_P_Hub) + UB(1:1) = ubound(SrcModuleMapTypeData%ED_P_2_BD_P_Hub) + if (.not. allocated(DstModuleMapTypeData%ED_P_2_BD_P_Hub)) then + allocate(DstModuleMapTypeData%ED_P_2_BD_P_Hub(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%ED_P_2_BD_P_Hub.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%ED_P_2_BD_P_Hub(i1), DstModuleMapTypeData%ED_P_2_BD_P_Hub(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%ED_P_2_HD_PRP_P, DstModuleMapTypeData%ED_P_2_HD_PRP_P, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%SubStructure_2_HD_W_P, DstModuleMapTypeData%SubStructure_2_HD_W_P, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%HD_W_P_2_SubStructure, DstModuleMapTypeData%HD_W_P_2_SubStructure, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%SubStructure_2_HD_M_P, DstModuleMapTypeData%SubStructure_2_HD_M_P, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%HD_M_P_2_SubStructure, DstModuleMapTypeData%HD_M_P_2_SubStructure, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%Structure_2_Mooring, DstModuleMapTypeData%Structure_2_Mooring, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%Mooring_2_Structure, DstModuleMapTypeData%Mooring_2_Structure, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%ED_P_2_SD_TP, DstModuleMapTypeData%ED_P_2_SD_TP, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%SD_TP_2_ED_P, DstModuleMapTypeData%SD_TP_2_ED_P, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcModuleMapTypeData%ED_P_2_NStC_P_N)) then + LB(1:1) = lbound(SrcModuleMapTypeData%ED_P_2_NStC_P_N) + UB(1:1) = ubound(SrcModuleMapTypeData%ED_P_2_NStC_P_N) + if (.not. allocated(DstModuleMapTypeData%ED_P_2_NStC_P_N)) then + allocate(DstModuleMapTypeData%ED_P_2_NStC_P_N(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%ED_P_2_NStC_P_N.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%ED_P_2_NStC_P_N(i1), DstModuleMapTypeData%ED_P_2_NStC_P_N(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcModuleMapTypeData%NStC_P_2_ED_P_N)) then + LB(1:1) = lbound(SrcModuleMapTypeData%NStC_P_2_ED_P_N) + UB(1:1) = ubound(SrcModuleMapTypeData%NStC_P_2_ED_P_N) + if (.not. allocated(DstModuleMapTypeData%NStC_P_2_ED_P_N)) then + allocate(DstModuleMapTypeData%NStC_P_2_ED_P_N(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%NStC_P_2_ED_P_N.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%NStC_P_2_ED_P_N(i1), DstModuleMapTypeData%NStC_P_2_ED_P_N(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcModuleMapTypeData%ED_L_2_TStC_P_T)) then + LB(1:1) = lbound(SrcModuleMapTypeData%ED_L_2_TStC_P_T) + UB(1:1) = ubound(SrcModuleMapTypeData%ED_L_2_TStC_P_T) + if (.not. allocated(DstModuleMapTypeData%ED_L_2_TStC_P_T)) then + allocate(DstModuleMapTypeData%ED_L_2_TStC_P_T(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%ED_L_2_TStC_P_T.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%ED_L_2_TStC_P_T(i1), DstModuleMapTypeData%ED_L_2_TStC_P_T(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcModuleMapTypeData%TStC_P_2_ED_P_T)) then + LB(1:1) = lbound(SrcModuleMapTypeData%TStC_P_2_ED_P_T) + UB(1:1) = ubound(SrcModuleMapTypeData%TStC_P_2_ED_P_T) + if (.not. allocated(DstModuleMapTypeData%TStC_P_2_ED_P_T)) then + allocate(DstModuleMapTypeData%TStC_P_2_ED_P_T(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%TStC_P_2_ED_P_T.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%TStC_P_2_ED_P_T(i1), DstModuleMapTypeData%TStC_P_2_ED_P_T(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcModuleMapTypeData%ED_L_2_BStC_P_B)) then + LB(1:2) = lbound(SrcModuleMapTypeData%ED_L_2_BStC_P_B) + UB(1:2) = ubound(SrcModuleMapTypeData%ED_L_2_BStC_P_B) + if (.not. allocated(DstModuleMapTypeData%ED_L_2_BStC_P_B)) then + allocate(DstModuleMapTypeData%ED_L_2_BStC_P_B(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%ED_L_2_BStC_P_B.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%ED_L_2_BStC_P_B(i1,i2), DstModuleMapTypeData%ED_L_2_BStC_P_B(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do + end if + if (allocated(SrcModuleMapTypeData%BStC_P_2_ED_P_B)) then + LB(1:2) = lbound(SrcModuleMapTypeData%BStC_P_2_ED_P_B) + UB(1:2) = ubound(SrcModuleMapTypeData%BStC_P_2_ED_P_B) + if (.not. allocated(DstModuleMapTypeData%BStC_P_2_ED_P_B)) then + allocate(DstModuleMapTypeData%BStC_P_2_ED_P_B(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%BStC_P_2_ED_P_B.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%BStC_P_2_ED_P_B(i1,i2), DstModuleMapTypeData%BStC_P_2_ED_P_B(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do + end if + if (allocated(SrcModuleMapTypeData%BD_L_2_BStC_P_B)) then + LB(1:2) = lbound(SrcModuleMapTypeData%BD_L_2_BStC_P_B) + UB(1:2) = ubound(SrcModuleMapTypeData%BD_L_2_BStC_P_B) + if (.not. allocated(DstModuleMapTypeData%BD_L_2_BStC_P_B)) then + allocate(DstModuleMapTypeData%BD_L_2_BStC_P_B(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%BD_L_2_BStC_P_B.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%BD_L_2_BStC_P_B(i1,i2), DstModuleMapTypeData%BD_L_2_BStC_P_B(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do + end if + if (allocated(SrcModuleMapTypeData%BStC_P_2_BD_P_B)) then + LB(1:2) = lbound(SrcModuleMapTypeData%BStC_P_2_BD_P_B) + UB(1:2) = ubound(SrcModuleMapTypeData%BStC_P_2_BD_P_B) + if (.not. allocated(DstModuleMapTypeData%BStC_P_2_BD_P_B)) then + allocate(DstModuleMapTypeData%BStC_P_2_BD_P_B(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%BStC_P_2_BD_P_B.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%BStC_P_2_BD_P_B(i1,i2), DstModuleMapTypeData%BStC_P_2_BD_P_B(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do + end if + if (allocated(SrcModuleMapTypeData%SStC_P_P_2_SubStructure)) then + LB(1:1) = lbound(SrcModuleMapTypeData%SStC_P_P_2_SubStructure) + UB(1:1) = ubound(SrcModuleMapTypeData%SStC_P_P_2_SubStructure) + if (.not. allocated(DstModuleMapTypeData%SStC_P_P_2_SubStructure)) then + allocate(DstModuleMapTypeData%SStC_P_P_2_SubStructure(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%SStC_P_P_2_SubStructure.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%SStC_P_P_2_SubStructure(i1), DstModuleMapTypeData%SStC_P_P_2_SubStructure(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcModuleMapTypeData%SubStructure_2_SStC_P_P)) then + LB(1:1) = lbound(SrcModuleMapTypeData%SubStructure_2_SStC_P_P) + UB(1:1) = ubound(SrcModuleMapTypeData%SubStructure_2_SStC_P_P) + if (.not. allocated(DstModuleMapTypeData%SubStructure_2_SStC_P_P)) then + allocate(DstModuleMapTypeData%SubStructure_2_SStC_P_P(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%SubStructure_2_SStC_P_P.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%SubStructure_2_SStC_P_P(i1), DstModuleMapTypeData%SubStructure_2_SStC_P_P(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%ED_P_2_SrvD_P_P, DstModuleMapTypeData%ED_P_2_SrvD_P_P, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcModuleMapTypeData%BDED_L_2_AD_L_B)) then + LB(1:1) = lbound(SrcModuleMapTypeData%BDED_L_2_AD_L_B) + UB(1:1) = ubound(SrcModuleMapTypeData%BDED_L_2_AD_L_B) + if (.not. allocated(DstModuleMapTypeData%BDED_L_2_AD_L_B)) then + allocate(DstModuleMapTypeData%BDED_L_2_AD_L_B(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%BDED_L_2_AD_L_B.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%BDED_L_2_AD_L_B(i1), DstModuleMapTypeData%BDED_L_2_AD_L_B(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcModuleMapTypeData%AD_L_2_BDED_B)) then + LB(1:1) = lbound(SrcModuleMapTypeData%AD_L_2_BDED_B) + UB(1:1) = ubound(SrcModuleMapTypeData%AD_L_2_BDED_B) + if (.not. allocated(DstModuleMapTypeData%AD_L_2_BDED_B)) then + allocate(DstModuleMapTypeData%AD_L_2_BDED_B(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%AD_L_2_BDED_B.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%AD_L_2_BDED_B(i1), DstModuleMapTypeData%AD_L_2_BDED_B(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcModuleMapTypeData%BD_L_2_BD_L)) then + LB(1:1) = lbound(SrcModuleMapTypeData%BD_L_2_BD_L) + UB(1:1) = ubound(SrcModuleMapTypeData%BD_L_2_BD_L) + if (.not. allocated(DstModuleMapTypeData%BD_L_2_BD_L)) then + allocate(DstModuleMapTypeData%BD_L_2_BD_L(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%BD_L_2_BD_L.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%BD_L_2_BD_L(i1), DstModuleMapTypeData%BD_L_2_BD_L(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcModuleMapTypeData%SED_P_2_AD_L_B)) then + LB(1:1) = lbound(SrcModuleMapTypeData%SED_P_2_AD_L_B) + UB(1:1) = ubound(SrcModuleMapTypeData%SED_P_2_AD_L_B) + if (.not. allocated(DstModuleMapTypeData%SED_P_2_AD_L_B)) then + allocate(DstModuleMapTypeData%SED_P_2_AD_L_B(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%SED_P_2_AD_L_B.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%SED_P_2_AD_L_B(i1), DstModuleMapTypeData%SED_P_2_AD_L_B(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcModuleMapTypeData%SED_P_2_AD_P_R)) then + LB(1:1) = lbound(SrcModuleMapTypeData%SED_P_2_AD_P_R) + UB(1:1) = ubound(SrcModuleMapTypeData%SED_P_2_AD_P_R) + if (.not. allocated(DstModuleMapTypeData%SED_P_2_AD_P_R)) then + allocate(DstModuleMapTypeData%SED_P_2_AD_P_R(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%SED_P_2_AD_P_R.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%SED_P_2_AD_P_R(i1), DstModuleMapTypeData%SED_P_2_AD_P_R(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcModuleMapTypeData%AD_L_2_SED_P)) then + LB(1:1) = lbound(SrcModuleMapTypeData%AD_L_2_SED_P) + UB(1:1) = ubound(SrcModuleMapTypeData%AD_L_2_SED_P) + if (.not. allocated(DstModuleMapTypeData%AD_L_2_SED_P)) then + allocate(DstModuleMapTypeData%AD_L_2_SED_P(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%AD_L_2_SED_P.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%AD_L_2_SED_P(i1), DstModuleMapTypeData%AD_L_2_SED_P(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%ED_P_2_AD_P_N, DstModuleMapTypeData%ED_P_2_AD_P_N, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%AD_P_2_ED_P_N, DstModuleMapTypeData%AD_P_2_ED_P_N, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%ED_P_2_AD_P_TF, DstModuleMapTypeData%ED_P_2_AD_P_TF, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%AD_P_2_ED_P_TF, DstModuleMapTypeData%AD_P_2_ED_P_TF, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%ED_L_2_AD_L_T, DstModuleMapTypeData%ED_L_2_AD_L_T, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%AD_L_2_ED_P_T, DstModuleMapTypeData%AD_L_2_ED_P_T, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcModuleMapTypeData%ED_P_2_AD_P_R)) then + LB(1:1) = lbound(SrcModuleMapTypeData%ED_P_2_AD_P_R) + UB(1:1) = ubound(SrcModuleMapTypeData%ED_P_2_AD_P_R) + if (.not. allocated(DstModuleMapTypeData%ED_P_2_AD_P_R)) then + allocate(DstModuleMapTypeData%ED_P_2_AD_P_R(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%ED_P_2_AD_P_R.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%ED_P_2_AD_P_R(i1), DstModuleMapTypeData%ED_P_2_AD_P_R(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%ED_P_2_AD_P_H, DstModuleMapTypeData%ED_P_2_AD_P_H, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%ADsk_P_2_ED_P_H, DstModuleMapTypeData%ADsk_P_2_ED_P_H, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%ED_P_2_ADsk_P_H, DstModuleMapTypeData%ED_P_2_ADsk_P_H, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%SED_P_2_AD_P_N, DstModuleMapTypeData%SED_P_2_AD_P_N, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%SED_L_2_AD_L_T, DstModuleMapTypeData%SED_L_2_AD_L_T, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%SED_P_2_AD_P_H, DstModuleMapTypeData%SED_P_2_AD_P_H, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%ADsk_P_2_SED_P_H, DstModuleMapTypeData%ADsk_P_2_SED_P_H, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%SED_P_2_ADsk_P_H, DstModuleMapTypeData%SED_P_2_ADsk_P_H, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%AD_P_2_ED_P_H, DstModuleMapTypeData%AD_P_2_ED_P_H, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcModuleMapTypeData%BDED_L_2_ExtLd_P_B)) then + LB(1:1) = lbound(SrcModuleMapTypeData%BDED_L_2_ExtLd_P_B) + UB(1:1) = ubound(SrcModuleMapTypeData%BDED_L_2_ExtLd_P_B) + if (.not. allocated(DstModuleMapTypeData%BDED_L_2_ExtLd_P_B)) then + allocate(DstModuleMapTypeData%BDED_L_2_ExtLd_P_B(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%BDED_L_2_ExtLd_P_B.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%BDED_L_2_ExtLd_P_B(i1), DstModuleMapTypeData%BDED_L_2_ExtLd_P_B(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcModuleMapTypeData%ExtLd_P_2_BDED_B)) then + LB(1:1) = lbound(SrcModuleMapTypeData%ExtLd_P_2_BDED_B) + UB(1:1) = ubound(SrcModuleMapTypeData%ExtLd_P_2_BDED_B) + if (.not. allocated(DstModuleMapTypeData%ExtLd_P_2_BDED_B)) then + allocate(DstModuleMapTypeData%ExtLd_P_2_BDED_B(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%ExtLd_P_2_BDED_B.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%ExtLd_P_2_BDED_B(i1), DstModuleMapTypeData%ExtLd_P_2_BDED_B(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%ED_L_2_ExtLd_P_T, DstModuleMapTypeData%ED_L_2_ExtLd_P_T, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%ExtLd_P_2_ED_P_T, DstModuleMapTypeData%ExtLd_P_2_ED_P_T, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcModuleMapTypeData%ED_P_2_ExtLd_P_R)) then + LB(1:1) = lbound(SrcModuleMapTypeData%ED_P_2_ExtLd_P_R) + UB(1:1) = ubound(SrcModuleMapTypeData%ED_P_2_ExtLd_P_R) + if (.not. allocated(DstModuleMapTypeData%ED_P_2_ExtLd_P_R)) then + allocate(DstModuleMapTypeData%ED_P_2_ExtLd_P_R(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%ED_P_2_ExtLd_P_R.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%ED_P_2_ExtLd_P_R(i1), DstModuleMapTypeData%ED_P_2_ExtLd_P_R(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%ED_P_2_ExtLd_P_H, DstModuleMapTypeData%ED_P_2_ExtLd_P_H, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcModuleMapTypeData%AD_L_2_ExtLd_B)) then + LB(1:1) = lbound(SrcModuleMapTypeData%AD_L_2_ExtLd_B) + UB(1:1) = ubound(SrcModuleMapTypeData%AD_L_2_ExtLd_B) + if (.not. allocated(DstModuleMapTypeData%AD_L_2_ExtLd_B)) then + allocate(DstModuleMapTypeData%AD_L_2_ExtLd_B(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%AD_L_2_ExtLd_B.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%AD_L_2_ExtLd_B(i1), DstModuleMapTypeData%AD_L_2_ExtLd_B(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%AD_L_2_ExtLd_T, DstModuleMapTypeData%AD_L_2_ExtLd_T, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%IceF_P_2_SD_P, DstModuleMapTypeData%IceF_P_2_SD_P, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%SDy3_P_2_IceF_P, DstModuleMapTypeData%SDy3_P_2_IceF_P, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcModuleMapTypeData%IceD_P_2_SD_P)) then + LB(1:1) = lbound(SrcModuleMapTypeData%IceD_P_2_SD_P) + UB(1:1) = ubound(SrcModuleMapTypeData%IceD_P_2_SD_P) + if (.not. allocated(DstModuleMapTypeData%IceD_P_2_SD_P)) then + allocate(DstModuleMapTypeData%IceD_P_2_SD_P(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%IceD_P_2_SD_P.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%IceD_P_2_SD_P(i1), DstModuleMapTypeData%IceD_P_2_SD_P(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcModuleMapTypeData%SDy3_P_2_IceD_P)) then + LB(1:1) = lbound(SrcModuleMapTypeData%SDy3_P_2_IceD_P) + UB(1:1) = ubound(SrcModuleMapTypeData%SDy3_P_2_IceD_P) + if (.not. allocated(DstModuleMapTypeData%SDy3_P_2_IceD_P)) then + allocate(DstModuleMapTypeData%SDy3_P_2_IceD_P(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%SDy3_P_2_IceD_P.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%SDy3_P_2_IceD_P(i1), DstModuleMapTypeData%SDy3_P_2_IceD_P(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcModuleMapTypeData%Jacobian_Opt1)) then + LB(1:2) = lbound(SrcModuleMapTypeData%Jacobian_Opt1) + UB(1:2) = ubound(SrcModuleMapTypeData%Jacobian_Opt1) + if (.not. allocated(DstModuleMapTypeData%Jacobian_Opt1)) then + allocate(DstModuleMapTypeData%Jacobian_Opt1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%Jacobian_Opt1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModuleMapTypeData%Jacobian_Opt1 = SrcModuleMapTypeData%Jacobian_Opt1 + end if + if (allocated(SrcModuleMapTypeData%Jacobian_pivot)) then + LB(1:1) = lbound(SrcModuleMapTypeData%Jacobian_pivot) + UB(1:1) = ubound(SrcModuleMapTypeData%Jacobian_pivot) + if (.not. allocated(DstModuleMapTypeData%Jacobian_pivot)) then + allocate(DstModuleMapTypeData%Jacobian_pivot(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%Jacobian_pivot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModuleMapTypeData%Jacobian_pivot = SrcModuleMapTypeData%Jacobian_pivot + end if + if (allocated(SrcModuleMapTypeData%Jac_u_indx)) then + LB(1:2) = lbound(SrcModuleMapTypeData%Jac_u_indx) + UB(1:2) = ubound(SrcModuleMapTypeData%Jac_u_indx) + if (.not. allocated(DstModuleMapTypeData%Jac_u_indx)) then + allocate(DstModuleMapTypeData%Jac_u_indx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%Jac_u_indx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModuleMapTypeData%Jac_u_indx = SrcModuleMapTypeData%Jac_u_indx + end if + call MeshCopy(SrcModuleMapTypeData%u_ED_NacelleLoads, DstModuleMapTypeData%u_ED_NacelleLoads, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcModuleMapTypeData%SubstructureLoads_Tmp, DstModuleMapTypeData%SubstructureLoads_Tmp, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcModuleMapTypeData%SubstructureLoads_Tmp2, DstModuleMapTypeData%SubstructureLoads_Tmp2, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcModuleMapTypeData%PlatformLoads_Tmp, DstModuleMapTypeData%PlatformLoads_Tmp, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcModuleMapTypeData%PlatformLoads_Tmp2, DstModuleMapTypeData%PlatformLoads_Tmp2, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcModuleMapTypeData%SubstructureLoads_Tmp_Farm, DstModuleMapTypeData%SubstructureLoads_Tmp_Farm, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcModuleMapTypeData%u_ED_TowerPtloads, DstModuleMapTypeData%u_ED_TowerPtloads, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcModuleMapTypeData%u_ED_BladePtLoads)) then + LB(1:1) = lbound(SrcModuleMapTypeData%u_ED_BladePtLoads) + UB(1:1) = ubound(SrcModuleMapTypeData%u_ED_BladePtLoads) + if (.not. allocated(DstModuleMapTypeData%u_ED_BladePtLoads)) then + allocate(DstModuleMapTypeData%u_ED_BladePtLoads(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%u_ED_BladePtLoads.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MeshCopy(SrcModuleMapTypeData%u_ED_BladePtLoads(i1), DstModuleMapTypeData%u_ED_BladePtLoads(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call MeshCopy(SrcModuleMapTypeData%u_SD_TPMesh, DstModuleMapTypeData%u_SD_TPMesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcModuleMapTypeData%u_HD_M_Mesh, DstModuleMapTypeData%u_HD_M_Mesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcModuleMapTypeData%u_HD_W_Mesh, DstModuleMapTypeData%u_HD_W_Mesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcModuleMapTypeData%u_ED_HubPtLoad, DstModuleMapTypeData%u_ED_HubPtLoad, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcModuleMapTypeData%u_ED_HubPtLoad_2, DstModuleMapTypeData%u_ED_HubPtLoad_2, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcModuleMapTypeData%u_BD_RootMotion)) then + LB(1:1) = lbound(SrcModuleMapTypeData%u_BD_RootMotion) + UB(1:1) = ubound(SrcModuleMapTypeData%u_BD_RootMotion) + if (.not. allocated(DstModuleMapTypeData%u_BD_RootMotion)) then + allocate(DstModuleMapTypeData%u_BD_RootMotion(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%u_BD_RootMotion.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MeshCopy(SrcModuleMapTypeData%u_BD_RootMotion(i1), DstModuleMapTypeData%u_BD_RootMotion(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcModuleMapTypeData%y_BD_BldMotion_4Loads)) then + LB(1:1) = lbound(SrcModuleMapTypeData%y_BD_BldMotion_4Loads) + UB(1:1) = ubound(SrcModuleMapTypeData%y_BD_BldMotion_4Loads) + if (.not. allocated(DstModuleMapTypeData%y_BD_BldMotion_4Loads)) then + allocate(DstModuleMapTypeData%y_BD_BldMotion_4Loads(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%y_BD_BldMotion_4Loads.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MeshCopy(SrcModuleMapTypeData%y_BD_BldMotion_4Loads(i1), DstModuleMapTypeData%y_BD_BldMotion_4Loads(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcModuleMapTypeData%u_BD_Distrload)) then + LB(1:1) = lbound(SrcModuleMapTypeData%u_BD_Distrload) + UB(1:1) = ubound(SrcModuleMapTypeData%u_BD_Distrload) + if (.not. allocated(DstModuleMapTypeData%u_BD_Distrload)) then + allocate(DstModuleMapTypeData%u_BD_Distrload(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%u_BD_Distrload.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MeshCopy(SrcModuleMapTypeData%u_BD_Distrload(i1), DstModuleMapTypeData%u_BD_Distrload(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call MeshCopy(SrcModuleMapTypeData%u_Orca_PtfmMesh, DstModuleMapTypeData%u_Orca_PtfmMesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcModuleMapTypeData%u_ExtPtfm_PtfmMesh, DstModuleMapTypeData%u_ExtPtfm_PtfmMesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcModuleMapTypeData%u_SED_HubPtLoad, DstModuleMapTypeData%u_SED_HubPtLoad, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcModuleMapTypeData%HubOrient)) then + LB(1:3) = lbound(SrcModuleMapTypeData%HubOrient) + UB(1:3) = ubound(SrcModuleMapTypeData%HubOrient) + if (.not. allocated(DstModuleMapTypeData%HubOrient)) then + allocate(DstModuleMapTypeData%HubOrient(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%HubOrient.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModuleMapTypeData%HubOrient = SrcModuleMapTypeData%HubOrient + end if +end subroutine + +subroutine FAST_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) + type(FAST_ModuleMapType), intent(inout) :: ModuleMapTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_DestroyModuleMapType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ModuleMapTypeData%ED_P_2_BD_P)) then + LB(1:1) = lbound(ModuleMapTypeData%ED_P_2_BD_P) + UB(1:1) = ubound(ModuleMapTypeData%ED_P_2_BD_P) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%ED_P_2_BD_P(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ModuleMapTypeData%ED_P_2_BD_P) + end if + if (allocated(ModuleMapTypeData%BD_P_2_ED_P)) then + LB(1:1) = lbound(ModuleMapTypeData%BD_P_2_ED_P) + UB(1:1) = ubound(ModuleMapTypeData%BD_P_2_ED_P) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%BD_P_2_ED_P(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ModuleMapTypeData%BD_P_2_ED_P) + end if + if (allocated(ModuleMapTypeData%ED_P_2_BD_P_Hub)) then + LB(1:1) = lbound(ModuleMapTypeData%ED_P_2_BD_P_Hub) + UB(1:1) = ubound(ModuleMapTypeData%ED_P_2_BD_P_Hub) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%ED_P_2_BD_P_Hub(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ModuleMapTypeData%ED_P_2_BD_P_Hub) + end if + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%ED_P_2_HD_PRP_P, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%SubStructure_2_HD_W_P, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%HD_W_P_2_SubStructure, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%SubStructure_2_HD_M_P, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%HD_M_P_2_SubStructure, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%Structure_2_Mooring, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%Mooring_2_Structure, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%ED_P_2_SD_TP, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%SD_TP_2_ED_P, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(ModuleMapTypeData%ED_P_2_NStC_P_N)) then + LB(1:1) = lbound(ModuleMapTypeData%ED_P_2_NStC_P_N) + UB(1:1) = ubound(ModuleMapTypeData%ED_P_2_NStC_P_N) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%ED_P_2_NStC_P_N(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ModuleMapTypeData%ED_P_2_NStC_P_N) + end if + if (allocated(ModuleMapTypeData%NStC_P_2_ED_P_N)) then + LB(1:1) = lbound(ModuleMapTypeData%NStC_P_2_ED_P_N) + UB(1:1) = ubound(ModuleMapTypeData%NStC_P_2_ED_P_N) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%NStC_P_2_ED_P_N(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ModuleMapTypeData%NStC_P_2_ED_P_N) + end if + if (allocated(ModuleMapTypeData%ED_L_2_TStC_P_T)) then + LB(1:1) = lbound(ModuleMapTypeData%ED_L_2_TStC_P_T) + UB(1:1) = ubound(ModuleMapTypeData%ED_L_2_TStC_P_T) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%ED_L_2_TStC_P_T(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ModuleMapTypeData%ED_L_2_TStC_P_T) + end if + if (allocated(ModuleMapTypeData%TStC_P_2_ED_P_T)) then + LB(1:1) = lbound(ModuleMapTypeData%TStC_P_2_ED_P_T) + UB(1:1) = ubound(ModuleMapTypeData%TStC_P_2_ED_P_T) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%TStC_P_2_ED_P_T(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ModuleMapTypeData%TStC_P_2_ED_P_T) + end if + if (allocated(ModuleMapTypeData%ED_L_2_BStC_P_B)) then + LB(1:2) = lbound(ModuleMapTypeData%ED_L_2_BStC_P_B) + UB(1:2) = ubound(ModuleMapTypeData%ED_L_2_BStC_P_B) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%ED_L_2_BStC_P_B(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + deallocate(ModuleMapTypeData%ED_L_2_BStC_P_B) + end if + if (allocated(ModuleMapTypeData%BStC_P_2_ED_P_B)) then + LB(1:2) = lbound(ModuleMapTypeData%BStC_P_2_ED_P_B) + UB(1:2) = ubound(ModuleMapTypeData%BStC_P_2_ED_P_B) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%BStC_P_2_ED_P_B(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + deallocate(ModuleMapTypeData%BStC_P_2_ED_P_B) + end if + if (allocated(ModuleMapTypeData%BD_L_2_BStC_P_B)) then + LB(1:2) = lbound(ModuleMapTypeData%BD_L_2_BStC_P_B) + UB(1:2) = ubound(ModuleMapTypeData%BD_L_2_BStC_P_B) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%BD_L_2_BStC_P_B(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + deallocate(ModuleMapTypeData%BD_L_2_BStC_P_B) + end if + if (allocated(ModuleMapTypeData%BStC_P_2_BD_P_B)) then + LB(1:2) = lbound(ModuleMapTypeData%BStC_P_2_BD_P_B) + UB(1:2) = ubound(ModuleMapTypeData%BStC_P_2_BD_P_B) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%BStC_P_2_BD_P_B(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + deallocate(ModuleMapTypeData%BStC_P_2_BD_P_B) + end if + if (allocated(ModuleMapTypeData%SStC_P_P_2_SubStructure)) then + LB(1:1) = lbound(ModuleMapTypeData%SStC_P_P_2_SubStructure) + UB(1:1) = ubound(ModuleMapTypeData%SStC_P_P_2_SubStructure) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%SStC_P_P_2_SubStructure(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ModuleMapTypeData%SStC_P_P_2_SubStructure) + end if + if (allocated(ModuleMapTypeData%SubStructure_2_SStC_P_P)) then + LB(1:1) = lbound(ModuleMapTypeData%SubStructure_2_SStC_P_P) + UB(1:1) = ubound(ModuleMapTypeData%SubStructure_2_SStC_P_P) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%SubStructure_2_SStC_P_P(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ModuleMapTypeData%SubStructure_2_SStC_P_P) + end if + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%ED_P_2_SrvD_P_P, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(ModuleMapTypeData%BDED_L_2_AD_L_B)) then + LB(1:1) = lbound(ModuleMapTypeData%BDED_L_2_AD_L_B) + UB(1:1) = ubound(ModuleMapTypeData%BDED_L_2_AD_L_B) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%BDED_L_2_AD_L_B(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ModuleMapTypeData%BDED_L_2_AD_L_B) + end if + if (allocated(ModuleMapTypeData%AD_L_2_BDED_B)) then + LB(1:1) = lbound(ModuleMapTypeData%AD_L_2_BDED_B) + UB(1:1) = ubound(ModuleMapTypeData%AD_L_2_BDED_B) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%AD_L_2_BDED_B(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ModuleMapTypeData%AD_L_2_BDED_B) + end if + if (allocated(ModuleMapTypeData%BD_L_2_BD_L)) then + LB(1:1) = lbound(ModuleMapTypeData%BD_L_2_BD_L) + UB(1:1) = ubound(ModuleMapTypeData%BD_L_2_BD_L) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%BD_L_2_BD_L(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ModuleMapTypeData%BD_L_2_BD_L) + end if + if (allocated(ModuleMapTypeData%SED_P_2_AD_L_B)) then + LB(1:1) = lbound(ModuleMapTypeData%SED_P_2_AD_L_B) + UB(1:1) = ubound(ModuleMapTypeData%SED_P_2_AD_L_B) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%SED_P_2_AD_L_B(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ModuleMapTypeData%SED_P_2_AD_L_B) + end if + if (allocated(ModuleMapTypeData%SED_P_2_AD_P_R)) then + LB(1:1) = lbound(ModuleMapTypeData%SED_P_2_AD_P_R) + UB(1:1) = ubound(ModuleMapTypeData%SED_P_2_AD_P_R) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%SED_P_2_AD_P_R(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ModuleMapTypeData%SED_P_2_AD_P_R) + end if + if (allocated(ModuleMapTypeData%AD_L_2_SED_P)) then + LB(1:1) = lbound(ModuleMapTypeData%AD_L_2_SED_P) + UB(1:1) = ubound(ModuleMapTypeData%AD_L_2_SED_P) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%AD_L_2_SED_P(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ModuleMapTypeData%AD_L_2_SED_P) + end if + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%ED_P_2_AD_P_N, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%AD_P_2_ED_P_N, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%ED_P_2_AD_P_TF, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%AD_P_2_ED_P_TF, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%ED_L_2_AD_L_T, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%AD_L_2_ED_P_T, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(ModuleMapTypeData%ED_P_2_AD_P_R)) then + LB(1:1) = lbound(ModuleMapTypeData%ED_P_2_AD_P_R) + UB(1:1) = ubound(ModuleMapTypeData%ED_P_2_AD_P_R) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%ED_P_2_AD_P_R(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ModuleMapTypeData%ED_P_2_AD_P_R) + end if + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%ED_P_2_AD_P_H, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%ADsk_P_2_ED_P_H, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%ED_P_2_ADsk_P_H, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%SED_P_2_AD_P_N, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%SED_L_2_AD_L_T, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%SED_P_2_AD_P_H, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%ADsk_P_2_SED_P_H, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%SED_P_2_ADsk_P_H, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%AD_P_2_ED_P_H, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(ModuleMapTypeData%BDED_L_2_ExtLd_P_B)) then + LB(1:1) = lbound(ModuleMapTypeData%BDED_L_2_ExtLd_P_B) + UB(1:1) = ubound(ModuleMapTypeData%BDED_L_2_ExtLd_P_B) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%BDED_L_2_ExtLd_P_B(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ModuleMapTypeData%BDED_L_2_ExtLd_P_B) + end if + if (allocated(ModuleMapTypeData%ExtLd_P_2_BDED_B)) then + LB(1:1) = lbound(ModuleMapTypeData%ExtLd_P_2_BDED_B) + UB(1:1) = ubound(ModuleMapTypeData%ExtLd_P_2_BDED_B) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%ExtLd_P_2_BDED_B(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ModuleMapTypeData%ExtLd_P_2_BDED_B) + end if + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%ED_L_2_ExtLd_P_T, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%ExtLd_P_2_ED_P_T, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(ModuleMapTypeData%ED_P_2_ExtLd_P_R)) then + LB(1:1) = lbound(ModuleMapTypeData%ED_P_2_ExtLd_P_R) + UB(1:1) = ubound(ModuleMapTypeData%ED_P_2_ExtLd_P_R) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%ED_P_2_ExtLd_P_R(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ModuleMapTypeData%ED_P_2_ExtLd_P_R) + end if + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%ED_P_2_ExtLd_P_H, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(ModuleMapTypeData%AD_L_2_ExtLd_B)) then + LB(1:1) = lbound(ModuleMapTypeData%AD_L_2_ExtLd_B) + UB(1:1) = ubound(ModuleMapTypeData%AD_L_2_ExtLd_B) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%AD_L_2_ExtLd_B(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ModuleMapTypeData%AD_L_2_ExtLd_B) + end if + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%AD_L_2_ExtLd_T, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%IceF_P_2_SD_P, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%SDy3_P_2_IceF_P, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(ModuleMapTypeData%IceD_P_2_SD_P)) then + LB(1:1) = lbound(ModuleMapTypeData%IceD_P_2_SD_P) + UB(1:1) = ubound(ModuleMapTypeData%IceD_P_2_SD_P) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%IceD_P_2_SD_P(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ModuleMapTypeData%IceD_P_2_SD_P) + end if + if (allocated(ModuleMapTypeData%SDy3_P_2_IceD_P)) then + LB(1:1) = lbound(ModuleMapTypeData%SDy3_P_2_IceD_P) + UB(1:1) = ubound(ModuleMapTypeData%SDy3_P_2_IceD_P) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%SDy3_P_2_IceD_P(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ModuleMapTypeData%SDy3_P_2_IceD_P) + end if + if (allocated(ModuleMapTypeData%Jacobian_Opt1)) then + deallocate(ModuleMapTypeData%Jacobian_Opt1) + end if + if (allocated(ModuleMapTypeData%Jacobian_pivot)) then + deallocate(ModuleMapTypeData%Jacobian_pivot) + end if + if (allocated(ModuleMapTypeData%Jac_u_indx)) then + deallocate(ModuleMapTypeData%Jac_u_indx) + end if + call MeshDestroy( ModuleMapTypeData%u_ED_NacelleLoads, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( ModuleMapTypeData%SubstructureLoads_Tmp, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( ModuleMapTypeData%SubstructureLoads_Tmp2, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( ModuleMapTypeData%PlatformLoads_Tmp, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( ModuleMapTypeData%PlatformLoads_Tmp2, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( ModuleMapTypeData%SubstructureLoads_Tmp_Farm, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( ModuleMapTypeData%u_ED_TowerPtloads, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(ModuleMapTypeData%u_ED_BladePtLoads)) then + LB(1:1) = lbound(ModuleMapTypeData%u_ED_BladePtLoads) + UB(1:1) = ubound(ModuleMapTypeData%u_ED_BladePtLoads) + do i1 = LB(1), UB(1) + call MeshDestroy( ModuleMapTypeData%u_ED_BladePtLoads(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ModuleMapTypeData%u_ED_BladePtLoads) + end if + call MeshDestroy( ModuleMapTypeData%u_SD_TPMesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( ModuleMapTypeData%u_HD_M_Mesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( ModuleMapTypeData%u_HD_W_Mesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( ModuleMapTypeData%u_ED_HubPtLoad, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( ModuleMapTypeData%u_ED_HubPtLoad_2, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(ModuleMapTypeData%u_BD_RootMotion)) then + LB(1:1) = lbound(ModuleMapTypeData%u_BD_RootMotion) + UB(1:1) = ubound(ModuleMapTypeData%u_BD_RootMotion) + do i1 = LB(1), UB(1) + call MeshDestroy( ModuleMapTypeData%u_BD_RootMotion(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ModuleMapTypeData%u_BD_RootMotion) + end if + if (allocated(ModuleMapTypeData%y_BD_BldMotion_4Loads)) then + LB(1:1) = lbound(ModuleMapTypeData%y_BD_BldMotion_4Loads) + UB(1:1) = ubound(ModuleMapTypeData%y_BD_BldMotion_4Loads) + do i1 = LB(1), UB(1) + call MeshDestroy( ModuleMapTypeData%y_BD_BldMotion_4Loads(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ModuleMapTypeData%y_BD_BldMotion_4Loads) + end if + if (allocated(ModuleMapTypeData%u_BD_Distrload)) then + LB(1:1) = lbound(ModuleMapTypeData%u_BD_Distrload) + UB(1:1) = ubound(ModuleMapTypeData%u_BD_Distrload) + do i1 = LB(1), UB(1) + call MeshDestroy( ModuleMapTypeData%u_BD_Distrload(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ModuleMapTypeData%u_BD_Distrload) + end if + call MeshDestroy( ModuleMapTypeData%u_Orca_PtfmMesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( ModuleMapTypeData%u_ExtPtfm_PtfmMesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( ModuleMapTypeData%u_SED_HubPtLoad, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(ModuleMapTypeData%HubOrient)) then + deallocate(ModuleMapTypeData%HubOrient) + end if +end subroutine + +subroutine FAST_PackModuleMapType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(FAST_ModuleMapType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackModuleMapType' + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%ED_P_2_BD_P)) + if (allocated(InData%ED_P_2_BD_P)) then + call RegPackBounds(RF, 1, lbound(InData%ED_P_2_BD_P), ubound(InData%ED_P_2_BD_P)) + LB(1:1) = lbound(InData%ED_P_2_BD_P) + UB(1:1) = ubound(InData%ED_P_2_BD_P) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(RF, InData%ED_P_2_BD_P(i1)) + end do + end if + call RegPack(RF, allocated(InData%BD_P_2_ED_P)) + if (allocated(InData%BD_P_2_ED_P)) then + call RegPackBounds(RF, 1, lbound(InData%BD_P_2_ED_P), ubound(InData%BD_P_2_ED_P)) + LB(1:1) = lbound(InData%BD_P_2_ED_P) + UB(1:1) = ubound(InData%BD_P_2_ED_P) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(RF, InData%BD_P_2_ED_P(i1)) + end do + end if + call RegPack(RF, allocated(InData%ED_P_2_BD_P_Hub)) + if (allocated(InData%ED_P_2_BD_P_Hub)) then + call RegPackBounds(RF, 1, lbound(InData%ED_P_2_BD_P_Hub), ubound(InData%ED_P_2_BD_P_Hub)) + LB(1:1) = lbound(InData%ED_P_2_BD_P_Hub) + UB(1:1) = ubound(InData%ED_P_2_BD_P_Hub) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(RF, InData%ED_P_2_BD_P_Hub(i1)) + end do + end if + call NWTC_Library_PackMeshMapType(RF, InData%ED_P_2_HD_PRP_P) + call NWTC_Library_PackMeshMapType(RF, InData%SubStructure_2_HD_W_P) + call NWTC_Library_PackMeshMapType(RF, InData%HD_W_P_2_SubStructure) + call NWTC_Library_PackMeshMapType(RF, InData%SubStructure_2_HD_M_P) + call NWTC_Library_PackMeshMapType(RF, InData%HD_M_P_2_SubStructure) + call NWTC_Library_PackMeshMapType(RF, InData%Structure_2_Mooring) + call NWTC_Library_PackMeshMapType(RF, InData%Mooring_2_Structure) + call NWTC_Library_PackMeshMapType(RF, InData%ED_P_2_SD_TP) + call NWTC_Library_PackMeshMapType(RF, InData%SD_TP_2_ED_P) + call RegPack(RF, allocated(InData%ED_P_2_NStC_P_N)) + if (allocated(InData%ED_P_2_NStC_P_N)) then + call RegPackBounds(RF, 1, lbound(InData%ED_P_2_NStC_P_N), ubound(InData%ED_P_2_NStC_P_N)) + LB(1:1) = lbound(InData%ED_P_2_NStC_P_N) + UB(1:1) = ubound(InData%ED_P_2_NStC_P_N) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(RF, InData%ED_P_2_NStC_P_N(i1)) + end do + end if + call RegPack(RF, allocated(InData%NStC_P_2_ED_P_N)) + if (allocated(InData%NStC_P_2_ED_P_N)) then + call RegPackBounds(RF, 1, lbound(InData%NStC_P_2_ED_P_N), ubound(InData%NStC_P_2_ED_P_N)) + LB(1:1) = lbound(InData%NStC_P_2_ED_P_N) + UB(1:1) = ubound(InData%NStC_P_2_ED_P_N) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(RF, InData%NStC_P_2_ED_P_N(i1)) + end do + end if + call RegPack(RF, allocated(InData%ED_L_2_TStC_P_T)) + if (allocated(InData%ED_L_2_TStC_P_T)) then + call RegPackBounds(RF, 1, lbound(InData%ED_L_2_TStC_P_T), ubound(InData%ED_L_2_TStC_P_T)) + LB(1:1) = lbound(InData%ED_L_2_TStC_P_T) + UB(1:1) = ubound(InData%ED_L_2_TStC_P_T) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(RF, InData%ED_L_2_TStC_P_T(i1)) + end do + end if + call RegPack(RF, allocated(InData%TStC_P_2_ED_P_T)) + if (allocated(InData%TStC_P_2_ED_P_T)) then + call RegPackBounds(RF, 1, lbound(InData%TStC_P_2_ED_P_T), ubound(InData%TStC_P_2_ED_P_T)) + LB(1:1) = lbound(InData%TStC_P_2_ED_P_T) + UB(1:1) = ubound(InData%TStC_P_2_ED_P_T) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(RF, InData%TStC_P_2_ED_P_T(i1)) + end do + end if + call RegPack(RF, allocated(InData%ED_L_2_BStC_P_B)) + if (allocated(InData%ED_L_2_BStC_P_B)) then + call RegPackBounds(RF, 2, lbound(InData%ED_L_2_BStC_P_B), ubound(InData%ED_L_2_BStC_P_B)) + LB(1:2) = lbound(InData%ED_L_2_BStC_P_B) + UB(1:2) = ubound(InData%ED_L_2_BStC_P_B) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(RF, InData%ED_L_2_BStC_P_B(i1,i2)) + end do + end do + end if + call RegPack(RF, allocated(InData%BStC_P_2_ED_P_B)) + if (allocated(InData%BStC_P_2_ED_P_B)) then + call RegPackBounds(RF, 2, lbound(InData%BStC_P_2_ED_P_B), ubound(InData%BStC_P_2_ED_P_B)) + LB(1:2) = lbound(InData%BStC_P_2_ED_P_B) + UB(1:2) = ubound(InData%BStC_P_2_ED_P_B) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(RF, InData%BStC_P_2_ED_P_B(i1,i2)) + end do + end do + end if + call RegPack(RF, allocated(InData%BD_L_2_BStC_P_B)) + if (allocated(InData%BD_L_2_BStC_P_B)) then + call RegPackBounds(RF, 2, lbound(InData%BD_L_2_BStC_P_B), ubound(InData%BD_L_2_BStC_P_B)) + LB(1:2) = lbound(InData%BD_L_2_BStC_P_B) + UB(1:2) = ubound(InData%BD_L_2_BStC_P_B) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(RF, InData%BD_L_2_BStC_P_B(i1,i2)) + end do + end do + end if + call RegPack(RF, allocated(InData%BStC_P_2_BD_P_B)) + if (allocated(InData%BStC_P_2_BD_P_B)) then + call RegPackBounds(RF, 2, lbound(InData%BStC_P_2_BD_P_B), ubound(InData%BStC_P_2_BD_P_B)) + LB(1:2) = lbound(InData%BStC_P_2_BD_P_B) + UB(1:2) = ubound(InData%BStC_P_2_BD_P_B) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(RF, InData%BStC_P_2_BD_P_B(i1,i2)) + end do + end do + end if + call RegPack(RF, allocated(InData%SStC_P_P_2_SubStructure)) + if (allocated(InData%SStC_P_P_2_SubStructure)) then + call RegPackBounds(RF, 1, lbound(InData%SStC_P_P_2_SubStructure), ubound(InData%SStC_P_P_2_SubStructure)) + LB(1:1) = lbound(InData%SStC_P_P_2_SubStructure) + UB(1:1) = ubound(InData%SStC_P_P_2_SubStructure) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(RF, InData%SStC_P_P_2_SubStructure(i1)) + end do + end if + call RegPack(RF, allocated(InData%SubStructure_2_SStC_P_P)) + if (allocated(InData%SubStructure_2_SStC_P_P)) then + call RegPackBounds(RF, 1, lbound(InData%SubStructure_2_SStC_P_P), ubound(InData%SubStructure_2_SStC_P_P)) + LB(1:1) = lbound(InData%SubStructure_2_SStC_P_P) + UB(1:1) = ubound(InData%SubStructure_2_SStC_P_P) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(RF, InData%SubStructure_2_SStC_P_P(i1)) + end do + end if + call NWTC_Library_PackMeshMapType(RF, InData%ED_P_2_SrvD_P_P) + call RegPack(RF, allocated(InData%BDED_L_2_AD_L_B)) + if (allocated(InData%BDED_L_2_AD_L_B)) then + call RegPackBounds(RF, 1, lbound(InData%BDED_L_2_AD_L_B), ubound(InData%BDED_L_2_AD_L_B)) + LB(1:1) = lbound(InData%BDED_L_2_AD_L_B) + UB(1:1) = ubound(InData%BDED_L_2_AD_L_B) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(RF, InData%BDED_L_2_AD_L_B(i1)) + end do + end if + call RegPack(RF, allocated(InData%AD_L_2_BDED_B)) + if (allocated(InData%AD_L_2_BDED_B)) then + call RegPackBounds(RF, 1, lbound(InData%AD_L_2_BDED_B), ubound(InData%AD_L_2_BDED_B)) + LB(1:1) = lbound(InData%AD_L_2_BDED_B) + UB(1:1) = ubound(InData%AD_L_2_BDED_B) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(RF, InData%AD_L_2_BDED_B(i1)) + end do + end if + call RegPack(RF, allocated(InData%BD_L_2_BD_L)) + if (allocated(InData%BD_L_2_BD_L)) then + call RegPackBounds(RF, 1, lbound(InData%BD_L_2_BD_L), ubound(InData%BD_L_2_BD_L)) + LB(1:1) = lbound(InData%BD_L_2_BD_L) + UB(1:1) = ubound(InData%BD_L_2_BD_L) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(RF, InData%BD_L_2_BD_L(i1)) + end do + end if + call RegPack(RF, allocated(InData%SED_P_2_AD_L_B)) + if (allocated(InData%SED_P_2_AD_L_B)) then + call RegPackBounds(RF, 1, lbound(InData%SED_P_2_AD_L_B), ubound(InData%SED_P_2_AD_L_B)) + LB(1:1) = lbound(InData%SED_P_2_AD_L_B) + UB(1:1) = ubound(InData%SED_P_2_AD_L_B) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(RF, InData%SED_P_2_AD_L_B(i1)) + end do + end if + call RegPack(RF, allocated(InData%SED_P_2_AD_P_R)) + if (allocated(InData%SED_P_2_AD_P_R)) then + call RegPackBounds(RF, 1, lbound(InData%SED_P_2_AD_P_R), ubound(InData%SED_P_2_AD_P_R)) + LB(1:1) = lbound(InData%SED_P_2_AD_P_R) + UB(1:1) = ubound(InData%SED_P_2_AD_P_R) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(RF, InData%SED_P_2_AD_P_R(i1)) + end do + end if + call RegPack(RF, allocated(InData%AD_L_2_SED_P)) + if (allocated(InData%AD_L_2_SED_P)) then + call RegPackBounds(RF, 1, lbound(InData%AD_L_2_SED_P), ubound(InData%AD_L_2_SED_P)) + LB(1:1) = lbound(InData%AD_L_2_SED_P) + UB(1:1) = ubound(InData%AD_L_2_SED_P) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(RF, InData%AD_L_2_SED_P(i1)) + end do + end if + call NWTC_Library_PackMeshMapType(RF, InData%ED_P_2_AD_P_N) + call NWTC_Library_PackMeshMapType(RF, InData%AD_P_2_ED_P_N) + call NWTC_Library_PackMeshMapType(RF, InData%ED_P_2_AD_P_TF) + call NWTC_Library_PackMeshMapType(RF, InData%AD_P_2_ED_P_TF) + call NWTC_Library_PackMeshMapType(RF, InData%ED_L_2_AD_L_T) + call NWTC_Library_PackMeshMapType(RF, InData%AD_L_2_ED_P_T) + call RegPack(RF, allocated(InData%ED_P_2_AD_P_R)) + if (allocated(InData%ED_P_2_AD_P_R)) then + call RegPackBounds(RF, 1, lbound(InData%ED_P_2_AD_P_R), ubound(InData%ED_P_2_AD_P_R)) + LB(1:1) = lbound(InData%ED_P_2_AD_P_R) + UB(1:1) = ubound(InData%ED_P_2_AD_P_R) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(RF, InData%ED_P_2_AD_P_R(i1)) + end do + end if + call NWTC_Library_PackMeshMapType(RF, InData%ED_P_2_AD_P_H) + call NWTC_Library_PackMeshMapType(RF, InData%ADsk_P_2_ED_P_H) + call NWTC_Library_PackMeshMapType(RF, InData%ED_P_2_ADsk_P_H) + call NWTC_Library_PackMeshMapType(RF, InData%SED_P_2_AD_P_N) + call NWTC_Library_PackMeshMapType(RF, InData%SED_L_2_AD_L_T) + call NWTC_Library_PackMeshMapType(RF, InData%SED_P_2_AD_P_H) + call NWTC_Library_PackMeshMapType(RF, InData%ADsk_P_2_SED_P_H) + call NWTC_Library_PackMeshMapType(RF, InData%SED_P_2_ADsk_P_H) + call NWTC_Library_PackMeshMapType(RF, InData%AD_P_2_ED_P_H) + call RegPack(RF, allocated(InData%BDED_L_2_ExtLd_P_B)) + if (allocated(InData%BDED_L_2_ExtLd_P_B)) then + call RegPackBounds(RF, 1, lbound(InData%BDED_L_2_ExtLd_P_B), ubound(InData%BDED_L_2_ExtLd_P_B)) + LB(1:1) = lbound(InData%BDED_L_2_ExtLd_P_B) + UB(1:1) = ubound(InData%BDED_L_2_ExtLd_P_B) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(RF, InData%BDED_L_2_ExtLd_P_B(i1)) + end do + end if + call RegPack(RF, allocated(InData%ExtLd_P_2_BDED_B)) + if (allocated(InData%ExtLd_P_2_BDED_B)) then + call RegPackBounds(RF, 1, lbound(InData%ExtLd_P_2_BDED_B), ubound(InData%ExtLd_P_2_BDED_B)) + LB(1:1) = lbound(InData%ExtLd_P_2_BDED_B) + UB(1:1) = ubound(InData%ExtLd_P_2_BDED_B) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(RF, InData%ExtLd_P_2_BDED_B(i1)) + end do + end if + call NWTC_Library_PackMeshMapType(RF, InData%ED_L_2_ExtLd_P_T) + call NWTC_Library_PackMeshMapType(RF, InData%ExtLd_P_2_ED_P_T) + call RegPack(RF, allocated(InData%ED_P_2_ExtLd_P_R)) + if (allocated(InData%ED_P_2_ExtLd_P_R)) then + call RegPackBounds(RF, 1, lbound(InData%ED_P_2_ExtLd_P_R), ubound(InData%ED_P_2_ExtLd_P_R)) + LB(1:1) = lbound(InData%ED_P_2_ExtLd_P_R) + UB(1:1) = ubound(InData%ED_P_2_ExtLd_P_R) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(RF, InData%ED_P_2_ExtLd_P_R(i1)) + end do + end if + call NWTC_Library_PackMeshMapType(RF, InData%ED_P_2_ExtLd_P_H) + call RegPack(RF, allocated(InData%AD_L_2_ExtLd_B)) + if (allocated(InData%AD_L_2_ExtLd_B)) then + call RegPackBounds(RF, 1, lbound(InData%AD_L_2_ExtLd_B), ubound(InData%AD_L_2_ExtLd_B)) + LB(1:1) = lbound(InData%AD_L_2_ExtLd_B) + UB(1:1) = ubound(InData%AD_L_2_ExtLd_B) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(RF, InData%AD_L_2_ExtLd_B(i1)) + end do + end if + call NWTC_Library_PackMeshMapType(RF, InData%AD_L_2_ExtLd_T) + call NWTC_Library_PackMeshMapType(RF, InData%IceF_P_2_SD_P) + call NWTC_Library_PackMeshMapType(RF, InData%SDy3_P_2_IceF_P) + call RegPack(RF, allocated(InData%IceD_P_2_SD_P)) + if (allocated(InData%IceD_P_2_SD_P)) then + call RegPackBounds(RF, 1, lbound(InData%IceD_P_2_SD_P), ubound(InData%IceD_P_2_SD_P)) + LB(1:1) = lbound(InData%IceD_P_2_SD_P) + UB(1:1) = ubound(InData%IceD_P_2_SD_P) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(RF, InData%IceD_P_2_SD_P(i1)) + end do + end if + call RegPack(RF, allocated(InData%SDy3_P_2_IceD_P)) + if (allocated(InData%SDy3_P_2_IceD_P)) then + call RegPackBounds(RF, 1, lbound(InData%SDy3_P_2_IceD_P), ubound(InData%SDy3_P_2_IceD_P)) + LB(1:1) = lbound(InData%SDy3_P_2_IceD_P) + UB(1:1) = ubound(InData%SDy3_P_2_IceD_P) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(RF, InData%SDy3_P_2_IceD_P(i1)) + end do + end if + call RegPackAlloc(RF, InData%Jacobian_Opt1) + call RegPackAlloc(RF, InData%Jacobian_pivot) + call RegPackAlloc(RF, InData%Jac_u_indx) + call MeshPack(RF, InData%u_ED_NacelleLoads) + call MeshPack(RF, InData%SubstructureLoads_Tmp) + call MeshPack(RF, InData%SubstructureLoads_Tmp2) + call MeshPack(RF, InData%PlatformLoads_Tmp) + call MeshPack(RF, InData%PlatformLoads_Tmp2) + call MeshPack(RF, InData%SubstructureLoads_Tmp_Farm) + call MeshPack(RF, InData%u_ED_TowerPtloads) + call RegPack(RF, allocated(InData%u_ED_BladePtLoads)) + if (allocated(InData%u_ED_BladePtLoads)) then + call RegPackBounds(RF, 1, lbound(InData%u_ED_BladePtLoads), ubound(InData%u_ED_BladePtLoads)) + LB(1:1) = lbound(InData%u_ED_BladePtLoads) + UB(1:1) = ubound(InData%u_ED_BladePtLoads) + do i1 = LB(1), UB(1) + call MeshPack(RF, InData%u_ED_BladePtLoads(i1)) + end do + end if + call MeshPack(RF, InData%u_SD_TPMesh) + call MeshPack(RF, InData%u_HD_M_Mesh) + call MeshPack(RF, InData%u_HD_W_Mesh) + call MeshPack(RF, InData%u_ED_HubPtLoad) + call MeshPack(RF, InData%u_ED_HubPtLoad_2) + call RegPack(RF, allocated(InData%u_BD_RootMotion)) + if (allocated(InData%u_BD_RootMotion)) then + call RegPackBounds(RF, 1, lbound(InData%u_BD_RootMotion), ubound(InData%u_BD_RootMotion)) + LB(1:1) = lbound(InData%u_BD_RootMotion) + UB(1:1) = ubound(InData%u_BD_RootMotion) + do i1 = LB(1), UB(1) + call MeshPack(RF, InData%u_BD_RootMotion(i1)) + end do + end if + call RegPack(RF, allocated(InData%y_BD_BldMotion_4Loads)) + if (allocated(InData%y_BD_BldMotion_4Loads)) then + call RegPackBounds(RF, 1, lbound(InData%y_BD_BldMotion_4Loads), ubound(InData%y_BD_BldMotion_4Loads)) + LB(1:1) = lbound(InData%y_BD_BldMotion_4Loads) + UB(1:1) = ubound(InData%y_BD_BldMotion_4Loads) + do i1 = LB(1), UB(1) + call MeshPack(RF, InData%y_BD_BldMotion_4Loads(i1)) + end do + end if + call RegPack(RF, allocated(InData%u_BD_Distrload)) + if (allocated(InData%u_BD_Distrload)) then + call RegPackBounds(RF, 1, lbound(InData%u_BD_Distrload), ubound(InData%u_BD_Distrload)) + LB(1:1) = lbound(InData%u_BD_Distrload) + UB(1:1) = ubound(InData%u_BD_Distrload) + do i1 = LB(1), UB(1) + call MeshPack(RF, InData%u_BD_Distrload(i1)) + end do + end if + call MeshPack(RF, InData%u_Orca_PtfmMesh) + call MeshPack(RF, InData%u_ExtPtfm_PtfmMesh) + call MeshPack(RF, InData%u_SED_HubPtLoad) + call RegPackAlloc(RF, InData%HubOrient) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FAST_UnPackModuleMapType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(FAST_ModuleMapType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackModuleMapType' + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + if (allocated(OutData%ED_P_2_BD_P)) deallocate(OutData%ED_P_2_BD_P) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%ED_P_2_BD_P(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ED_P_2_BD_P.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(RF, OutData%ED_P_2_BD_P(i1)) ! ED_P_2_BD_P + end do + end if + if (allocated(OutData%BD_P_2_ED_P)) deallocate(OutData%BD_P_2_ED_P) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%BD_P_2_ED_P(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BD_P_2_ED_P.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(RF, OutData%BD_P_2_ED_P(i1)) ! BD_P_2_ED_P + end do + end if + if (allocated(OutData%ED_P_2_BD_P_Hub)) deallocate(OutData%ED_P_2_BD_P_Hub) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%ED_P_2_BD_P_Hub(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ED_P_2_BD_P_Hub.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(RF, OutData%ED_P_2_BD_P_Hub(i1)) ! ED_P_2_BD_P_Hub + end do + end if + call NWTC_Library_UnpackMeshMapType(RF, OutData%ED_P_2_HD_PRP_P) ! ED_P_2_HD_PRP_P + call NWTC_Library_UnpackMeshMapType(RF, OutData%SubStructure_2_HD_W_P) ! SubStructure_2_HD_W_P + call NWTC_Library_UnpackMeshMapType(RF, OutData%HD_W_P_2_SubStructure) ! HD_W_P_2_SubStructure + call NWTC_Library_UnpackMeshMapType(RF, OutData%SubStructure_2_HD_M_P) ! SubStructure_2_HD_M_P + call NWTC_Library_UnpackMeshMapType(RF, OutData%HD_M_P_2_SubStructure) ! HD_M_P_2_SubStructure + call NWTC_Library_UnpackMeshMapType(RF, OutData%Structure_2_Mooring) ! Structure_2_Mooring + call NWTC_Library_UnpackMeshMapType(RF, OutData%Mooring_2_Structure) ! Mooring_2_Structure + call NWTC_Library_UnpackMeshMapType(RF, OutData%ED_P_2_SD_TP) ! ED_P_2_SD_TP + call NWTC_Library_UnpackMeshMapType(RF, OutData%SD_TP_2_ED_P) ! SD_TP_2_ED_P + if (allocated(OutData%ED_P_2_NStC_P_N)) deallocate(OutData%ED_P_2_NStC_P_N) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%ED_P_2_NStC_P_N(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ED_P_2_NStC_P_N.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(RF, OutData%ED_P_2_NStC_P_N(i1)) ! ED_P_2_NStC_P_N + end do + end if + if (allocated(OutData%NStC_P_2_ED_P_N)) deallocate(OutData%NStC_P_2_ED_P_N) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%NStC_P_2_ED_P_N(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NStC_P_2_ED_P_N.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(RF, OutData%NStC_P_2_ED_P_N(i1)) ! NStC_P_2_ED_P_N + end do + end if + if (allocated(OutData%ED_L_2_TStC_P_T)) deallocate(OutData%ED_L_2_TStC_P_T) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%ED_L_2_TStC_P_T(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ED_L_2_TStC_P_T.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(RF, OutData%ED_L_2_TStC_P_T(i1)) ! ED_L_2_TStC_P_T + end do + end if + if (allocated(OutData%TStC_P_2_ED_P_T)) deallocate(OutData%TStC_P_2_ED_P_T) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%TStC_P_2_ED_P_T(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TStC_P_2_ED_P_T.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(RF, OutData%TStC_P_2_ED_P_T(i1)) ! TStC_P_2_ED_P_T + end do + end if + if (allocated(OutData%ED_L_2_BStC_P_B)) deallocate(OutData%ED_L_2_BStC_P_B) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%ED_L_2_BStC_P_B(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ED_L_2_BStC_P_B.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(RF, OutData%ED_L_2_BStC_P_B(i1,i2)) ! ED_L_2_BStC_P_B + end do + end do + end if + if (allocated(OutData%BStC_P_2_ED_P_B)) deallocate(OutData%BStC_P_2_ED_P_B) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%BStC_P_2_ED_P_B(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BStC_P_2_ED_P_B.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(RF, OutData%BStC_P_2_ED_P_B(i1,i2)) ! BStC_P_2_ED_P_B + end do + end do + end if + if (allocated(OutData%BD_L_2_BStC_P_B)) deallocate(OutData%BD_L_2_BStC_P_B) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%BD_L_2_BStC_P_B(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BD_L_2_BStC_P_B.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(RF, OutData%BD_L_2_BStC_P_B(i1,i2)) ! BD_L_2_BStC_P_B + end do + end do + end if + if (allocated(OutData%BStC_P_2_BD_P_B)) deallocate(OutData%BStC_P_2_BD_P_B) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%BStC_P_2_BD_P_B(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BStC_P_2_BD_P_B.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(RF, OutData%BStC_P_2_BD_P_B(i1,i2)) ! BStC_P_2_BD_P_B + end do + end do + end if + if (allocated(OutData%SStC_P_P_2_SubStructure)) deallocate(OutData%SStC_P_P_2_SubStructure) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%SStC_P_P_2_SubStructure(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SStC_P_P_2_SubStructure.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(RF, OutData%SStC_P_P_2_SubStructure(i1)) ! SStC_P_P_2_SubStructure + end do + end if + if (allocated(OutData%SubStructure_2_SStC_P_P)) deallocate(OutData%SubStructure_2_SStC_P_P) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%SubStructure_2_SStC_P_P(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SubStructure_2_SStC_P_P.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(RF, OutData%SubStructure_2_SStC_P_P(i1)) ! SubStructure_2_SStC_P_P + end do + end if + call NWTC_Library_UnpackMeshMapType(RF, OutData%ED_P_2_SrvD_P_P) ! ED_P_2_SrvD_P_P + if (allocated(OutData%BDED_L_2_AD_L_B)) deallocate(OutData%BDED_L_2_AD_L_B) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%BDED_L_2_AD_L_B(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BDED_L_2_AD_L_B.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(RF, OutData%BDED_L_2_AD_L_B(i1)) ! BDED_L_2_AD_L_B + end do + end if + if (allocated(OutData%AD_L_2_BDED_B)) deallocate(OutData%AD_L_2_BDED_B) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%AD_L_2_BDED_B(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AD_L_2_BDED_B.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(RF, OutData%AD_L_2_BDED_B(i1)) ! AD_L_2_BDED_B + end do + end if + if (allocated(OutData%BD_L_2_BD_L)) deallocate(OutData%BD_L_2_BD_L) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%BD_L_2_BD_L(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BD_L_2_BD_L.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(RF, OutData%BD_L_2_BD_L(i1)) ! BD_L_2_BD_L + end do + end if + if (allocated(OutData%SED_P_2_AD_L_B)) deallocate(OutData%SED_P_2_AD_L_B) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%SED_P_2_AD_L_B(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SED_P_2_AD_L_B.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(RF, OutData%SED_P_2_AD_L_B(i1)) ! SED_P_2_AD_L_B + end do + end if + if (allocated(OutData%SED_P_2_AD_P_R)) deallocate(OutData%SED_P_2_AD_P_R) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%SED_P_2_AD_P_R(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SED_P_2_AD_P_R.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(RF, OutData%SED_P_2_AD_P_R(i1)) ! SED_P_2_AD_P_R + end do + end if + if (allocated(OutData%AD_L_2_SED_P)) deallocate(OutData%AD_L_2_SED_P) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%AD_L_2_SED_P(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AD_L_2_SED_P.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(RF, OutData%AD_L_2_SED_P(i1)) ! AD_L_2_SED_P + end do + end if + call NWTC_Library_UnpackMeshMapType(RF, OutData%ED_P_2_AD_P_N) ! ED_P_2_AD_P_N + call NWTC_Library_UnpackMeshMapType(RF, OutData%AD_P_2_ED_P_N) ! AD_P_2_ED_P_N + call NWTC_Library_UnpackMeshMapType(RF, OutData%ED_P_2_AD_P_TF) ! ED_P_2_AD_P_TF + call NWTC_Library_UnpackMeshMapType(RF, OutData%AD_P_2_ED_P_TF) ! AD_P_2_ED_P_TF + call NWTC_Library_UnpackMeshMapType(RF, OutData%ED_L_2_AD_L_T) ! ED_L_2_AD_L_T + call NWTC_Library_UnpackMeshMapType(RF, OutData%AD_L_2_ED_P_T) ! AD_L_2_ED_P_T + if (allocated(OutData%ED_P_2_AD_P_R)) deallocate(OutData%ED_P_2_AD_P_R) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%ED_P_2_AD_P_R(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ED_P_2_AD_P_R.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(RF, OutData%ED_P_2_AD_P_R(i1)) ! ED_P_2_AD_P_R + end do + end if + call NWTC_Library_UnpackMeshMapType(RF, OutData%ED_P_2_AD_P_H) ! ED_P_2_AD_P_H + call NWTC_Library_UnpackMeshMapType(RF, OutData%ADsk_P_2_ED_P_H) ! ADsk_P_2_ED_P_H + call NWTC_Library_UnpackMeshMapType(RF, OutData%ED_P_2_ADsk_P_H) ! ED_P_2_ADsk_P_H + call NWTC_Library_UnpackMeshMapType(RF, OutData%SED_P_2_AD_P_N) ! SED_P_2_AD_P_N + call NWTC_Library_UnpackMeshMapType(RF, OutData%SED_L_2_AD_L_T) ! SED_L_2_AD_L_T + call NWTC_Library_UnpackMeshMapType(RF, OutData%SED_P_2_AD_P_H) ! SED_P_2_AD_P_H + call NWTC_Library_UnpackMeshMapType(RF, OutData%ADsk_P_2_SED_P_H) ! ADsk_P_2_SED_P_H + call NWTC_Library_UnpackMeshMapType(RF, OutData%SED_P_2_ADsk_P_H) ! SED_P_2_ADsk_P_H + call NWTC_Library_UnpackMeshMapType(RF, OutData%AD_P_2_ED_P_H) ! AD_P_2_ED_P_H + if (allocated(OutData%BDED_L_2_ExtLd_P_B)) deallocate(OutData%BDED_L_2_ExtLd_P_B) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%BDED_L_2_ExtLd_P_B(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BDED_L_2_ExtLd_P_B.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(RF, OutData%BDED_L_2_ExtLd_P_B(i1)) ! BDED_L_2_ExtLd_P_B + end do + end if + if (allocated(OutData%ExtLd_P_2_BDED_B)) deallocate(OutData%ExtLd_P_2_BDED_B) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%ExtLd_P_2_BDED_B(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ExtLd_P_2_BDED_B.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(RF, OutData%ExtLd_P_2_BDED_B(i1)) ! ExtLd_P_2_BDED_B + end do + end if + call NWTC_Library_UnpackMeshMapType(RF, OutData%ED_L_2_ExtLd_P_T) ! ED_L_2_ExtLd_P_T + call NWTC_Library_UnpackMeshMapType(RF, OutData%ExtLd_P_2_ED_P_T) ! ExtLd_P_2_ED_P_T + if (allocated(OutData%ED_P_2_ExtLd_P_R)) deallocate(OutData%ED_P_2_ExtLd_P_R) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%ED_P_2_ExtLd_P_R(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ED_P_2_ExtLd_P_R.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(RF, OutData%ED_P_2_ExtLd_P_R(i1)) ! ED_P_2_ExtLd_P_R + end do + end if + call NWTC_Library_UnpackMeshMapType(RF, OutData%ED_P_2_ExtLd_P_H) ! ED_P_2_ExtLd_P_H + if (allocated(OutData%AD_L_2_ExtLd_B)) deallocate(OutData%AD_L_2_ExtLd_B) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%AD_L_2_ExtLd_B(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AD_L_2_ExtLd_B.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(RF, OutData%AD_L_2_ExtLd_B(i1)) ! AD_L_2_ExtLd_B + end do + end if + call NWTC_Library_UnpackMeshMapType(RF, OutData%AD_L_2_ExtLd_T) ! AD_L_2_ExtLd_T + call NWTC_Library_UnpackMeshMapType(RF, OutData%IceF_P_2_SD_P) ! IceF_P_2_SD_P + call NWTC_Library_UnpackMeshMapType(RF, OutData%SDy3_P_2_IceF_P) ! SDy3_P_2_IceF_P + if (allocated(OutData%IceD_P_2_SD_P)) deallocate(OutData%IceD_P_2_SD_P) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%IceD_P_2_SD_P(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%IceD_P_2_SD_P.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(RF, OutData%IceD_P_2_SD_P(i1)) ! IceD_P_2_SD_P + end do + end if + if (allocated(OutData%SDy3_P_2_IceD_P)) deallocate(OutData%SDy3_P_2_IceD_P) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%SDy3_P_2_IceD_P(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SDy3_P_2_IceD_P.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(RF, OutData%SDy3_P_2_IceD_P(i1)) ! SDy3_P_2_IceD_P + end do + end if + call RegUnpackAlloc(RF, OutData%Jacobian_Opt1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Jacobian_pivot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Jac_u_indx); if (RegCheckErr(RF, RoutineName)) return + call MeshUnpack(RF, OutData%u_ED_NacelleLoads) ! u_ED_NacelleLoads + call MeshUnpack(RF, OutData%SubstructureLoads_Tmp) ! SubstructureLoads_Tmp + call MeshUnpack(RF, OutData%SubstructureLoads_Tmp2) ! SubstructureLoads_Tmp2 + call MeshUnpack(RF, OutData%PlatformLoads_Tmp) ! PlatformLoads_Tmp + call MeshUnpack(RF, OutData%PlatformLoads_Tmp2) ! PlatformLoads_Tmp2 + call MeshUnpack(RF, OutData%SubstructureLoads_Tmp_Farm) ! SubstructureLoads_Tmp_Farm + call MeshUnpack(RF, OutData%u_ED_TowerPtloads) ! u_ED_TowerPtloads + if (allocated(OutData%u_ED_BladePtLoads)) deallocate(OutData%u_ED_BladePtLoads) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%u_ED_BladePtLoads(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_ED_BladePtLoads.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(RF, OutData%u_ED_BladePtLoads(i1)) ! u_ED_BladePtLoads + end do + end if + call MeshUnpack(RF, OutData%u_SD_TPMesh) ! u_SD_TPMesh + call MeshUnpack(RF, OutData%u_HD_M_Mesh) ! u_HD_M_Mesh + call MeshUnpack(RF, OutData%u_HD_W_Mesh) ! u_HD_W_Mesh + call MeshUnpack(RF, OutData%u_ED_HubPtLoad) ! u_ED_HubPtLoad + call MeshUnpack(RF, OutData%u_ED_HubPtLoad_2) ! u_ED_HubPtLoad_2 + if (allocated(OutData%u_BD_RootMotion)) deallocate(OutData%u_BD_RootMotion) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%u_BD_RootMotion(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_BD_RootMotion.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(RF, OutData%u_BD_RootMotion(i1)) ! u_BD_RootMotion + end do + end if + if (allocated(OutData%y_BD_BldMotion_4Loads)) deallocate(OutData%y_BD_BldMotion_4Loads) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%y_BD_BldMotion_4Loads(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%y_BD_BldMotion_4Loads.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(RF, OutData%y_BD_BldMotion_4Loads(i1)) ! y_BD_BldMotion_4Loads + end do + end if + if (allocated(OutData%u_BD_Distrload)) deallocate(OutData%u_BD_Distrload) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%u_BD_Distrload(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_BD_Distrload.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(RF, OutData%u_BD_Distrload(i1)) ! u_BD_Distrload + end do + end if + call MeshUnpack(RF, OutData%u_Orca_PtfmMesh) ! u_Orca_PtfmMesh + call MeshUnpack(RF, OutData%u_ExtPtfm_PtfmMesh) ! u_ExtPtfm_PtfmMesh + call MeshUnpack(RF, OutData%u_SED_HubPtLoad) ! u_SED_HubPtLoad + call RegUnpackAlloc(RF, OutData%HubOrient); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FAST_CopyExternInputType(SrcExternInputTypeData, DstExternInputTypeData, CtrlCode, ErrStat, ErrMsg) + type(FAST_ExternInputType), intent(in) :: SrcExternInputTypeData + type(FAST_ExternInputType), intent(inout) :: DstExternInputTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FAST_CopyExternInputType' + ErrStat = ErrID_None + ErrMsg = '' + DstExternInputTypeData%GenTrq = SrcExternInputTypeData%GenTrq + DstExternInputTypeData%ElecPwr = SrcExternInputTypeData%ElecPwr + DstExternInputTypeData%YawPosCom = SrcExternInputTypeData%YawPosCom + DstExternInputTypeData%YawRateCom = SrcExternInputTypeData%YawRateCom + DstExternInputTypeData%BlPitchCom = SrcExternInputTypeData%BlPitchCom + DstExternInputTypeData%BlAirfoilCom = SrcExternInputTypeData%BlAirfoilCom + DstExternInputTypeData%HSSBrFrac = SrcExternInputTypeData%HSSBrFrac + DstExternInputTypeData%LidarFocus = SrcExternInputTypeData%LidarFocus + DstExternInputTypeData%CableDeltaL = SrcExternInputTypeData%CableDeltaL + DstExternInputTypeData%CableDeltaLdot = SrcExternInputTypeData%CableDeltaLdot +end subroutine + +subroutine FAST_DestroyExternInputType(ExternInputTypeData, ErrStat, ErrMsg) + type(FAST_ExternInputType), intent(inout) :: ExternInputTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FAST_DestroyExternInputType' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine FAST_PackExternInputType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(FAST_ExternInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackExternInputType' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%GenTrq) + call RegPack(RF, InData%ElecPwr) + call RegPack(RF, InData%YawPosCom) + call RegPack(RF, InData%YawRateCom) + call RegPack(RF, InData%BlPitchCom) + call RegPack(RF, InData%BlAirfoilCom) + call RegPack(RF, InData%HSSBrFrac) + call RegPack(RF, InData%LidarFocus) + call RegPack(RF, InData%CableDeltaL) + call RegPack(RF, InData%CableDeltaLdot) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FAST_UnPackExternInputType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(FAST_ExternInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackExternInputType' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%GenTrq); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ElecPwr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawPosCom); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawRateCom); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BlPitchCom); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BlAirfoilCom); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HSSBrFrac); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LidarFocus); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CableDeltaL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CableDeltaLdot); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FAST_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(FAST_MiscVarType), intent(in) :: SrcMiscData + type(FAST_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + DstMiscData%TiLstPrn = SrcMiscData%TiLstPrn + DstMiscData%t_global = SrcMiscData%t_global + DstMiscData%NextJacCalcTime = SrcMiscData%NextJacCalcTime + DstMiscData%PrevClockTime = SrcMiscData%PrevClockTime + DstMiscData%UsrTime1 = SrcMiscData%UsrTime1 + DstMiscData%UsrTime2 = SrcMiscData%UsrTime2 + DstMiscData%StrtTime = SrcMiscData%StrtTime + DstMiscData%SimStrtTime = SrcMiscData%SimStrtTime + DstMiscData%calcJacobian = SrcMiscData%calcJacobian + call FAST_CopyExternInputType(SrcMiscData%ExternInput, DstMiscData%ExternInput, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FAST_CopyMiscLinType(SrcMiscData%Lin, DstMiscData%Lin, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine FAST_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(FAST_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' + call FAST_DestroyExternInputType(MiscData%ExternInput, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FAST_DestroyMiscLinType(MiscData%Lin, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine FAST_PackMisc(RF, Indata) + type(RegFile), intent(inout) :: RF + type(FAST_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackMisc' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%TiLstPrn) + call RegPack(RF, InData%t_global) + call RegPack(RF, InData%NextJacCalcTime) + call RegPack(RF, InData%PrevClockTime) + call RegPack(RF, InData%UsrTime1) + call RegPack(RF, InData%UsrTime2) + call RegPack(RF, InData%StrtTime) + call RegPack(RF, InData%SimStrtTime) + call RegPack(RF, InData%calcJacobian) + call FAST_PackExternInputType(RF, InData%ExternInput) + call FAST_PackMiscLinType(RF, InData%Lin) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FAST_UnPackMisc(RF, OutData) + type(RegFile), intent(inout) :: RF + type(FAST_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackMisc' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%TiLstPrn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%t_global); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NextJacCalcTime); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PrevClockTime); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UsrTime1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UsrTime2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StrtTime); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SimStrtTime); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%calcJacobian); if (RegCheckErr(RF, RoutineName)) return + call FAST_UnpackExternInputType(RF, OutData%ExternInput) ! ExternInput + call FAST_UnpackMiscLinType(RF, OutData%Lin) ! Lin +end subroutine + +subroutine FAST_CopyInitData(SrcInitDataData, DstInitDataData, CtrlCode, ErrStat, ErrMsg) + type(FAST_InitData), intent(inout) :: SrcInitDataData + type(FAST_InitData), intent(inout) :: DstInitDataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_CopyInitData' + ErrStat = ErrID_None + ErrMsg = '' + call ED_CopyInitInput(SrcInitDataData%InData_ED, DstInitDataData%InData_ED, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call ED_CopyInitOutput(SrcInitDataData%OutData_ED, DstInitDataData%OutData_ED, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SED_CopyInitInput(SrcInitDataData%InData_SED, DstInitDataData%InData_SED, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SED_CopyInitOutput(SrcInitDataData%OutData_SED, DstInitDataData%OutData_SED, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call BD_CopyInitInput(SrcInitDataData%InData_BD, DstInitDataData%InData_BD, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcInitDataData%OutData_BD)) then + LB(1:1) = lbound(SrcInitDataData%OutData_BD) + UB(1:1) = ubound(SrcInitDataData%OutData_BD) + if (.not. allocated(DstInitDataData%OutData_BD)) then + allocate(DstInitDataData%OutData_BD(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitDataData%OutData_BD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call BD_CopyInitOutput(SrcInitDataData%OutData_BD(i1), DstInitDataData%OutData_BD(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call SrvD_CopyInitInput(SrcInitDataData%InData_SrvD, DstInitDataData%InData_SrvD, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SrvD_CopyInitOutput(SrcInitDataData%OutData_SrvD, DstInitDataData%OutData_SrvD, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AD_CopyInitInput(SrcInitDataData%InData_AD, DstInitDataData%InData_AD, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AD_CopyInitOutput(SrcInitDataData%OutData_AD, DstInitDataData%OutData_AD, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call ADsk_CopyInitInput(SrcInitDataData%InData_ADsk, DstInitDataData%InData_ADsk, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call ADsk_CopyInitOutput(SrcInitDataData%OutData_ADsk, DstInitDataData%OutData_ADsk, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call ExtLd_CopyInitInput(SrcInitDataData%InData_ExtLd, DstInitDataData%InData_ExtLd, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call ExtLd_CopyInitOutput(SrcInitDataData%OutData_ExtLd, DstInitDataData%OutData_ExtLd, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call InflowWind_CopyInitInput(SrcInitDataData%InData_IfW, DstInitDataData%InData_IfW, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call InflowWind_CopyInitOutput(SrcInitDataData%OutData_IfW, DstInitDataData%OutData_IfW, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call ExtInfw_CopyInitInput(SrcInitDataData%InData_ExtInfw, DstInitDataData%InData_ExtInfw, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call ExtInfw_CopyInitOutput(SrcInitDataData%OutData_ExtInfw, DstInitDataData%OutData_ExtInfw, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SeaSt_CopyInitInput(SrcInitDataData%InData_SeaSt, DstInitDataData%InData_SeaSt, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SeaSt_CopyInitOutput(SrcInitDataData%OutData_SeaSt, DstInitDataData%OutData_SeaSt, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call HydroDyn_CopyInitInput(SrcInitDataData%InData_HD, DstInitDataData%InData_HD, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call HydroDyn_CopyInitOutput(SrcInitDataData%OutData_HD, DstInitDataData%OutData_HD, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SD_CopyInitInput(SrcInitDataData%InData_SD, DstInitDataData%InData_SD, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SD_CopyInitOutput(SrcInitDataData%OutData_SD, DstInitDataData%OutData_SD, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call ExtPtfm_CopyInitInput(SrcInitDataData%InData_ExtPtfm, DstInitDataData%InData_ExtPtfm, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call ExtPtfm_CopyInitOutput(SrcInitDataData%OutData_ExtPtfm, DstInitDataData%OutData_ExtPtfm, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MAP_CopyInitInput(SrcInitDataData%InData_MAP, DstInitDataData%InData_MAP, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MAP_CopyInitOutput(SrcInitDataData%OutData_MAP, DstInitDataData%OutData_MAP, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FEAM_CopyInitInput(SrcInitDataData%InData_FEAM, DstInitDataData%InData_FEAM, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FEAM_CopyInitOutput(SrcInitDataData%OutData_FEAM, DstInitDataData%OutData_FEAM, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MD_CopyInitInput(SrcInitDataData%InData_MD, DstInitDataData%InData_MD, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MD_CopyInitOutput(SrcInitDataData%OutData_MD, DstInitDataData%OutData_MD, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call Orca_CopyInitInput(SrcInitDataData%InData_Orca, DstInitDataData%InData_Orca, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call Orca_CopyInitOutput(SrcInitDataData%OutData_Orca, DstInitDataData%OutData_Orca, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call IceFloe_CopyInitInput(SrcInitDataData%InData_IceF, DstInitDataData%InData_IceF, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call IceFloe_CopyInitOutput(SrcInitDataData%OutData_IceF, DstInitDataData%OutData_IceF, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call IceD_CopyInitInput(SrcInitDataData%InData_IceD, DstInitDataData%InData_IceD, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call IceD_CopyInitOutput(SrcInitDataData%OutData_IceD, DstInitDataData%OutData_IceD, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine FAST_DestroyInitData(InitDataData, ErrStat, ErrMsg) + type(FAST_InitData), intent(inout) :: InitDataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_DestroyInitData' + ErrStat = ErrID_None + ErrMsg = '' + call ED_DestroyInitInput(InitDataData%InData_ED, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call ED_DestroyInitOutput(InitDataData%OutData_ED, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SED_DestroyInitInput(InitDataData%InData_SED, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SED_DestroyInitOutput(InitDataData%OutData_SED, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call BD_DestroyInitInput(InitDataData%InData_BD, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(InitDataData%OutData_BD)) then + LB(1:1) = lbound(InitDataData%OutData_BD) + UB(1:1) = ubound(InitDataData%OutData_BD) + do i1 = LB(1), UB(1) + call BD_DestroyInitOutput(InitDataData%OutData_BD(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InitDataData%OutData_BD) + end if + call SrvD_DestroyInitInput(InitDataData%InData_SrvD, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SrvD_DestroyInitOutput(InitDataData%OutData_SrvD, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AD_DestroyInitInput(InitDataData%InData_AD, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AD_DestroyInitOutput(InitDataData%OutData_AD, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call ADsk_DestroyInitInput(InitDataData%InData_ADsk, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call ADsk_DestroyInitOutput(InitDataData%OutData_ADsk, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call ExtLd_DestroyInitInput(InitDataData%InData_ExtLd, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call ExtLd_DestroyInitOutput(InitDataData%OutData_ExtLd, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call InflowWind_DestroyInitInput(InitDataData%InData_IfW, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call InflowWind_DestroyInitOutput(InitDataData%OutData_IfW, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call ExtInfw_DestroyInitInput(InitDataData%InData_ExtInfw, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call ExtInfw_DestroyInitOutput(InitDataData%OutData_ExtInfw, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SeaSt_DestroyInitInput(InitDataData%InData_SeaSt, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SeaSt_DestroyInitOutput(InitDataData%OutData_SeaSt, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call HydroDyn_DestroyInitInput(InitDataData%InData_HD, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call HydroDyn_DestroyInitOutput(InitDataData%OutData_HD, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SD_DestroyInitInput(InitDataData%InData_SD, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SD_DestroyInitOutput(InitDataData%OutData_SD, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call ExtPtfm_DestroyInitInput(InitDataData%InData_ExtPtfm, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call ExtPtfm_DestroyInitOutput(InitDataData%OutData_ExtPtfm, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MAP_DestroyInitInput(InitDataData%InData_MAP, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MAP_DestroyInitOutput(InitDataData%OutData_MAP, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FEAM_DestroyInitInput(InitDataData%InData_FEAM, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FEAM_DestroyInitOutput(InitDataData%OutData_FEAM, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MD_DestroyInitInput(InitDataData%InData_MD, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MD_DestroyInitOutput(InitDataData%OutData_MD, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call Orca_DestroyInitInput(InitDataData%InData_Orca, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call Orca_DestroyInitOutput(InitDataData%OutData_Orca, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call IceFloe_DestroyInitInput(InitDataData%InData_IceF, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call IceFloe_DestroyInitOutput(InitDataData%OutData_IceF, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call IceD_DestroyInitInput(InitDataData%InData_IceD, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call IceD_DestroyInitOutput(InitDataData%OutData_IceD, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine FAST_PackInitData(RF, Indata) + type(RegFile), intent(inout) :: RF + type(FAST_InitData), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackInitData' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + if (RF%ErrStat >= AbortErrLev) return + call ED_PackInitInput(RF, InData%InData_ED) + call ED_PackInitOutput(RF, InData%OutData_ED) + call SED_PackInitInput(RF, InData%InData_SED) + call SED_PackInitOutput(RF, InData%OutData_SED) + call BD_PackInitInput(RF, InData%InData_BD) + call RegPack(RF, allocated(InData%OutData_BD)) + if (allocated(InData%OutData_BD)) then + call RegPackBounds(RF, 1, lbound(InData%OutData_BD), ubound(InData%OutData_BD)) + LB(1:1) = lbound(InData%OutData_BD) + UB(1:1) = ubound(InData%OutData_BD) + do i1 = LB(1), UB(1) + call BD_PackInitOutput(RF, InData%OutData_BD(i1)) + end do + end if + call SrvD_PackInitInput(RF, InData%InData_SrvD) + call SrvD_PackInitOutput(RF, InData%OutData_SrvD) + call AD_PackInitInput(RF, InData%InData_AD) + call AD_PackInitOutput(RF, InData%OutData_AD) + call ADsk_PackInitInput(RF, InData%InData_ADsk) + call ADsk_PackInitOutput(RF, InData%OutData_ADsk) + call ExtLd_PackInitInput(RF, InData%InData_ExtLd) + call ExtLd_PackInitOutput(RF, InData%OutData_ExtLd) + call InflowWind_PackInitInput(RF, InData%InData_IfW) + call InflowWind_PackInitOutput(RF, InData%OutData_IfW) + call ExtInfw_PackInitInput(RF, InData%InData_ExtInfw) + call ExtInfw_PackInitOutput(RF, InData%OutData_ExtInfw) + call SeaSt_PackInitInput(RF, InData%InData_SeaSt) + call SeaSt_PackInitOutput(RF, InData%OutData_SeaSt) + call HydroDyn_PackInitInput(RF, InData%InData_HD) + call HydroDyn_PackInitOutput(RF, InData%OutData_HD) + call SD_PackInitInput(RF, InData%InData_SD) + call SD_PackInitOutput(RF, InData%OutData_SD) + call ExtPtfm_PackInitInput(RF, InData%InData_ExtPtfm) + call ExtPtfm_PackInitOutput(RF, InData%OutData_ExtPtfm) + call MAP_PackInitInput(RF, InData%InData_MAP) + call MAP_PackInitOutput(RF, InData%OutData_MAP) + call FEAM_PackInitInput(RF, InData%InData_FEAM) + call FEAM_PackInitOutput(RF, InData%OutData_FEAM) + call MD_PackInitInput(RF, InData%InData_MD) + call MD_PackInitOutput(RF, InData%OutData_MD) + call Orca_PackInitInput(RF, InData%InData_Orca) + call Orca_PackInitOutput(RF, InData%OutData_Orca) + call IceFloe_PackInitInput(RF, InData%InData_IceF) + call IceFloe_PackInitOutput(RF, InData%OutData_IceF) + call IceD_PackInitInput(RF, InData%InData_IceD) + call IceD_PackInitOutput(RF, InData%OutData_IceD) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FAST_UnPackInitData(RF, OutData) + type(RegFile), intent(inout) :: RF + type(FAST_InitData), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackInitData' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call ED_UnpackInitInput(RF, OutData%InData_ED) ! InData_ED + call ED_UnpackInitOutput(RF, OutData%OutData_ED) ! OutData_ED + call SED_UnpackInitInput(RF, OutData%InData_SED) ! InData_SED + call SED_UnpackInitOutput(RF, OutData%OutData_SED) ! OutData_SED + call BD_UnpackInitInput(RF, OutData%InData_BD) ! InData_BD + if (allocated(OutData%OutData_BD)) deallocate(OutData%OutData_BD) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%OutData_BD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutData_BD.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call BD_UnpackInitOutput(RF, OutData%OutData_BD(i1)) ! OutData_BD + end do + end if + call SrvD_UnpackInitInput(RF, OutData%InData_SrvD) ! InData_SrvD + call SrvD_UnpackInitOutput(RF, OutData%OutData_SrvD) ! OutData_SrvD + call AD_UnpackInitInput(RF, OutData%InData_AD) ! InData_AD + call AD_UnpackInitOutput(RF, OutData%OutData_AD) ! OutData_AD + call ADsk_UnpackInitInput(RF, OutData%InData_ADsk) ! InData_ADsk + call ADsk_UnpackInitOutput(RF, OutData%OutData_ADsk) ! OutData_ADsk + call ExtLd_UnpackInitInput(RF, OutData%InData_ExtLd) ! InData_ExtLd + call ExtLd_UnpackInitOutput(RF, OutData%OutData_ExtLd) ! OutData_ExtLd + call InflowWind_UnpackInitInput(RF, OutData%InData_IfW) ! InData_IfW + call InflowWind_UnpackInitOutput(RF, OutData%OutData_IfW) ! OutData_IfW + call ExtInfw_UnpackInitInput(RF, OutData%InData_ExtInfw) ! InData_ExtInfw + call ExtInfw_UnpackInitOutput(RF, OutData%OutData_ExtInfw) ! OutData_ExtInfw + call SeaSt_UnpackInitInput(RF, OutData%InData_SeaSt) ! InData_SeaSt + call SeaSt_UnpackInitOutput(RF, OutData%OutData_SeaSt) ! OutData_SeaSt + call HydroDyn_UnpackInitInput(RF, OutData%InData_HD) ! InData_HD + call HydroDyn_UnpackInitOutput(RF, OutData%OutData_HD) ! OutData_HD + call SD_UnpackInitInput(RF, OutData%InData_SD) ! InData_SD + call SD_UnpackInitOutput(RF, OutData%OutData_SD) ! OutData_SD + call ExtPtfm_UnpackInitInput(RF, OutData%InData_ExtPtfm) ! InData_ExtPtfm + call ExtPtfm_UnpackInitOutput(RF, OutData%OutData_ExtPtfm) ! OutData_ExtPtfm + call MAP_UnpackInitInput(RF, OutData%InData_MAP) ! InData_MAP + call MAP_UnpackInitOutput(RF, OutData%OutData_MAP) ! OutData_MAP + call FEAM_UnpackInitInput(RF, OutData%InData_FEAM) ! InData_FEAM + call FEAM_UnpackInitOutput(RF, OutData%OutData_FEAM) ! OutData_FEAM + call MD_UnpackInitInput(RF, OutData%InData_MD) ! InData_MD + call MD_UnpackInitOutput(RF, OutData%OutData_MD) ! OutData_MD + call Orca_UnpackInitInput(RF, OutData%InData_Orca) ! InData_Orca + call Orca_UnpackInitOutput(RF, OutData%OutData_Orca) ! OutData_Orca + call IceFloe_UnpackInitInput(RF, OutData%InData_IceF) ! InData_IceF + call IceFloe_UnpackInitOutput(RF, OutData%OutData_IceF) ! OutData_IceF + call IceD_UnpackInitInput(RF, OutData%InData_IceD) ! InData_IceD + call IceD_UnpackInitOutput(RF, OutData%OutData_IceD) ! OutData_IceD +end subroutine + +subroutine FAST_CopyExternInitType(SrcExternInitTypeData, DstExternInitTypeData, CtrlCode, ErrStat, ErrMsg) + type(FAST_ExternInitType), intent(in) :: SrcExternInitTypeData + type(FAST_ExternInitType), intent(inout) :: DstExternInitTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(5), UB(5) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'FAST_CopyExternInitType' + ErrStat = ErrID_None + ErrMsg = '' + DstExternInitTypeData%Tmax = SrcExternInitTypeData%Tmax + DstExternInitTypeData%TurbIDforName = SrcExternInitTypeData%TurbIDforName + DstExternInitTypeData%TurbinePos = SrcExternInitTypeData%TurbinePos + DstExternInitTypeData%WaveFieldMod = SrcExternInitTypeData%WaveFieldMod + DstExternInitTypeData%NumSC2CtrlGlob = SrcExternInitTypeData%NumSC2CtrlGlob + DstExternInitTypeData%NumSC2Ctrl = SrcExternInitTypeData%NumSC2Ctrl + DstExternInitTypeData%NumCtrl2SC = SrcExternInitTypeData%NumCtrl2SC + if (allocated(SrcExternInitTypeData%fromSCGlob)) then + LB(1:1) = lbound(SrcExternInitTypeData%fromSCGlob) + UB(1:1) = ubound(SrcExternInitTypeData%fromSCGlob) + if (.not. allocated(DstExternInitTypeData%fromSCGlob)) then + allocate(DstExternInitTypeData%fromSCGlob(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstExternInitTypeData%fromSCGlob.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstExternInitTypeData%fromSCGlob = SrcExternInitTypeData%fromSCGlob + end if + if (allocated(SrcExternInitTypeData%fromSC)) then + LB(1:1) = lbound(SrcExternInitTypeData%fromSC) + UB(1:1) = ubound(SrcExternInitTypeData%fromSC) + if (.not. allocated(DstExternInitTypeData%fromSC)) then + allocate(DstExternInitTypeData%fromSC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstExternInitTypeData%fromSC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstExternInitTypeData%fromSC = SrcExternInitTypeData%fromSC + end if + DstExternInitTypeData%FarmIntegration = SrcExternInitTypeData%FarmIntegration + DstExternInitTypeData%windGrid_n = SrcExternInitTypeData%windGrid_n + DstExternInitTypeData%windGrid_delta = SrcExternInitTypeData%windGrid_delta + DstExternInitTypeData%windGrid_pZero = SrcExternInitTypeData%windGrid_pZero + DstExternInitTypeData%windGrid_data => SrcExternInitTypeData%windGrid_data + DstExternInitTypeData%RootName = SrcExternInitTypeData%RootName + DstExternInitTypeData%NumActForcePtsBlade = SrcExternInitTypeData%NumActForcePtsBlade + DstExternInitTypeData%NumActForcePtsTower = SrcExternInitTypeData%NumActForcePtsTower + DstExternInitTypeData%NodeClusterType = SrcExternInitTypeData%NodeClusterType + DstExternInitTypeData%DTdriver = SrcExternInitTypeData%DTdriver + DstExternInitTypeData%TwrAero = SrcExternInitTypeData%TwrAero + DstExternInitTypeData%az_blend_mean = SrcExternInitTypeData%az_blend_mean + DstExternInitTypeData%az_blend_delta = SrcExternInitTypeData%az_blend_delta +end subroutine + +subroutine FAST_DestroyExternInitType(ExternInitTypeData, ErrStat, ErrMsg) + type(FAST_ExternInitType), intent(inout) :: ExternInitTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FAST_DestroyExternInitType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ExternInitTypeData%fromSCGlob)) then + deallocate(ExternInitTypeData%fromSCGlob) + end if + if (allocated(ExternInitTypeData%fromSC)) then + deallocate(ExternInitTypeData%fromSC) + end if + nullify(ExternInitTypeData%windGrid_data) +end subroutine + +subroutine FAST_PackExternInitType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(FAST_ExternInitType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackExternInitType' + logical :: PtrInIndex + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%Tmax) + call RegPack(RF, InData%TurbIDforName) + call RegPack(RF, InData%TurbinePos) + call RegPack(RF, InData%WaveFieldMod) + call RegPack(RF, InData%NumSC2CtrlGlob) + call RegPack(RF, InData%NumSC2Ctrl) + call RegPack(RF, InData%NumCtrl2SC) + call RegPackAlloc(RF, InData%fromSCGlob) + call RegPackAlloc(RF, InData%fromSC) + call RegPack(RF, InData%FarmIntegration) + call RegPack(RF, InData%windGrid_n) + call RegPack(RF, InData%windGrid_delta) + call RegPack(RF, InData%windGrid_pZero) + call RegPackPtr(RF, InData%windGrid_data) + call RegPack(RF, InData%RootName) + call RegPack(RF, InData%NumActForcePtsBlade) + call RegPack(RF, InData%NumActForcePtsTower) + call RegPack(RF, InData%NodeClusterType) + call RegPack(RF, InData%DTdriver) + call RegPack(RF, InData%TwrAero) + call RegPack(RF, InData%az_blend_mean) + call RegPack(RF, InData%az_blend_delta) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FAST_UnPackExternInitType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(FAST_ExternInitType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackExternInitType' + integer(B4Ki) :: LB(5), UB(5) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(B8Ki) :: PtrIdx + type(c_ptr) :: Ptr + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%Tmax); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TurbIDforName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TurbinePos); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WaveFieldMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumSC2CtrlGlob); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumSC2Ctrl); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumCtrl2SC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%fromSCGlob); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%fromSC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FarmIntegration); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%windGrid_n); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%windGrid_delta); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%windGrid_pZero); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackPtr(RF, OutData%windGrid_data, LB, UB); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RootName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumActForcePtsBlade); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumActForcePtsTower); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NodeClusterType); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DTdriver); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TwrAero); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%az_blend_mean); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%az_blend_delta); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FAST_CopyTurbineType(SrcTurbineTypeData, DstTurbineTypeData, CtrlCode, ErrStat, ErrMsg) + type(FAST_TurbineType), intent(inout) :: SrcTurbineTypeData + type(FAST_TurbineType), intent(inout) :: DstTurbineTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_CopyTurbineType' + ErrStat = ErrID_None + ErrMsg = '' + DstTurbineTypeData%TurbID = SrcTurbineTypeData%TurbID + call FAST_CopyParam(SrcTurbineTypeData%p_FAST, DstTurbineTypeData%p_FAST, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FAST_CopyOutputFileType(SrcTurbineTypeData%y_FAST, DstTurbineTypeData%y_FAST, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FAST_CopyMisc(SrcTurbineTypeData%m_FAST, DstTurbineTypeData%m_FAST, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FAST_CopyModuleMapType(SrcTurbineTypeData%MeshMapData, DstTurbineTypeData%MeshMapData, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FAST_CopyElastoDyn_Data(SrcTurbineTypeData%ED, DstTurbineTypeData%ED, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FAST_CopySED_Data(SrcTurbineTypeData%SED, DstTurbineTypeData%SED, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FAST_CopyBeamDyn_Data(SrcTurbineTypeData%BD, DstTurbineTypeData%BD, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FAST_CopyServoDyn_Data(SrcTurbineTypeData%SrvD, DstTurbineTypeData%SrvD, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FAST_CopyAeroDyn_Data(SrcTurbineTypeData%AD, DstTurbineTypeData%AD, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FAST_CopyAeroDisk_Data(SrcTurbineTypeData%ADsk, DstTurbineTypeData%ADsk, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FAST_CopyExtLoads_Data(SrcTurbineTypeData%ExtLd, DstTurbineTypeData%ExtLd, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FAST_CopyInflowWind_Data(SrcTurbineTypeData%IfW, DstTurbineTypeData%IfW, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FAST_CopyExternalInflow_Data(SrcTurbineTypeData%ExtInfw, DstTurbineTypeData%ExtInfw, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FAST_CopySCDataEx_Data(SrcTurbineTypeData%SC_DX, DstTurbineTypeData%SC_DX, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FAST_CopySeaState_Data(SrcTurbineTypeData%SeaSt, DstTurbineTypeData%SeaSt, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FAST_CopyHydroDyn_Data(SrcTurbineTypeData%HD, DstTurbineTypeData%HD, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FAST_CopySubDyn_Data(SrcTurbineTypeData%SD, DstTurbineTypeData%SD, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FAST_CopyMAP_Data(SrcTurbineTypeData%MAP, DstTurbineTypeData%MAP, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FAST_CopyFEAMooring_Data(SrcTurbineTypeData%FEAM, DstTurbineTypeData%FEAM, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FAST_CopyMoorDyn_Data(SrcTurbineTypeData%MD, DstTurbineTypeData%MD, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FAST_CopyOrcaFlex_Data(SrcTurbineTypeData%Orca, DstTurbineTypeData%Orca, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FAST_CopyIceFloe_Data(SrcTurbineTypeData%IceF, DstTurbineTypeData%IceF, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FAST_CopyIceDyn_Data(SrcTurbineTypeData%IceD, DstTurbineTypeData%IceD, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FAST_CopyExtPtfm_Data(SrcTurbineTypeData%ExtPtfm, DstTurbineTypeData%ExtPtfm, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine FAST_DestroyTurbineType(TurbineTypeData, ErrStat, ErrMsg) + type(FAST_TurbineType), intent(inout) :: TurbineTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_DestroyTurbineType' + ErrStat = ErrID_None + ErrMsg = '' + call FAST_DestroyParam(TurbineTypeData%p_FAST, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FAST_DestroyOutputFileType(TurbineTypeData%y_FAST, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FAST_DestroyMisc(TurbineTypeData%m_FAST, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FAST_DestroyModuleMapType(TurbineTypeData%MeshMapData, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FAST_DestroyElastoDyn_Data(TurbineTypeData%ED, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FAST_DestroySED_Data(TurbineTypeData%SED, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FAST_DestroyBeamDyn_Data(TurbineTypeData%BD, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FAST_DestroyServoDyn_Data(TurbineTypeData%SrvD, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FAST_DestroyAeroDyn_Data(TurbineTypeData%AD, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FAST_DestroyAeroDisk_Data(TurbineTypeData%ADsk, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FAST_DestroyExtLoads_Data(TurbineTypeData%ExtLd, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FAST_DestroyInflowWind_Data(TurbineTypeData%IfW, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FAST_DestroyExternalInflow_Data(TurbineTypeData%ExtInfw, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FAST_DestroySCDataEx_Data(TurbineTypeData%SC_DX, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FAST_DestroySeaState_Data(TurbineTypeData%SeaSt, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FAST_DestroyHydroDyn_Data(TurbineTypeData%HD, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FAST_DestroySubDyn_Data(TurbineTypeData%SD, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FAST_DestroyMAP_Data(TurbineTypeData%MAP, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FAST_DestroyFEAMooring_Data(TurbineTypeData%FEAM, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FAST_DestroyMoorDyn_Data(TurbineTypeData%MD, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FAST_DestroyOrcaFlex_Data(TurbineTypeData%Orca, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FAST_DestroyIceFloe_Data(TurbineTypeData%IceF, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FAST_DestroyIceDyn_Data(TurbineTypeData%IceD, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FAST_DestroyExtPtfm_Data(TurbineTypeData%ExtPtfm, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine FAST_PackTurbineType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(FAST_TurbineType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackTurbineType' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%TurbID) + call FAST_PackParam(RF, InData%p_FAST) + call FAST_PackOutputFileType(RF, InData%y_FAST) + call FAST_PackMisc(RF, InData%m_FAST) + call FAST_PackModuleMapType(RF, InData%MeshMapData) + call FAST_PackElastoDyn_Data(RF, InData%ED) + call FAST_PackSED_Data(RF, InData%SED) + call FAST_PackBeamDyn_Data(RF, InData%BD) + call FAST_PackServoDyn_Data(RF, InData%SrvD) + call FAST_PackAeroDyn_Data(RF, InData%AD) + call FAST_PackAeroDisk_Data(RF, InData%ADsk) + call FAST_PackExtLoads_Data(RF, InData%ExtLd) + call FAST_PackInflowWind_Data(RF, InData%IfW) + call FAST_PackExternalInflow_Data(RF, InData%ExtInfw) + call FAST_PackSCDataEx_Data(RF, InData%SC_DX) + call FAST_PackSeaState_Data(RF, InData%SeaSt) + call FAST_PackHydroDyn_Data(RF, InData%HD) + call FAST_PackSubDyn_Data(RF, InData%SD) + call FAST_PackMAP_Data(RF, InData%MAP) + call FAST_PackFEAMooring_Data(RF, InData%FEAM) + call FAST_PackMoorDyn_Data(RF, InData%MD) + call FAST_PackOrcaFlex_Data(RF, InData%Orca) + call FAST_PackIceFloe_Data(RF, InData%IceF) + call FAST_PackIceDyn_Data(RF, InData%IceD) + call FAST_PackExtPtfm_Data(RF, InData%ExtPtfm) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FAST_UnPackTurbineType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(FAST_TurbineType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackTurbineType' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%TurbID); if (RegCheckErr(RF, RoutineName)) return + call FAST_UnpackParam(RF, OutData%p_FAST) ! p_FAST + call FAST_UnpackOutputFileType(RF, OutData%y_FAST) ! y_FAST + call FAST_UnpackMisc(RF, OutData%m_FAST) ! m_FAST + call FAST_UnpackModuleMapType(RF, OutData%MeshMapData) ! MeshMapData + call FAST_UnpackElastoDyn_Data(RF, OutData%ED) ! ED + call FAST_UnpackSED_Data(RF, OutData%SED) ! SED + call FAST_UnpackBeamDyn_Data(RF, OutData%BD) ! BD + call FAST_UnpackServoDyn_Data(RF, OutData%SrvD) ! SrvD + call FAST_UnpackAeroDyn_Data(RF, OutData%AD) ! AD + call FAST_UnpackAeroDisk_Data(RF, OutData%ADsk) ! ADsk + call FAST_UnpackExtLoads_Data(RF, OutData%ExtLd) ! ExtLd + call FAST_UnpackInflowWind_Data(RF, OutData%IfW) ! IfW + call FAST_UnpackExternalInflow_Data(RF, OutData%ExtInfw) ! ExtInfw + call FAST_UnpackSCDataEx_Data(RF, OutData%SC_DX) ! SC_DX + call FAST_UnpackSeaState_Data(RF, OutData%SeaSt) ! SeaSt + call FAST_UnpackHydroDyn_Data(RF, OutData%HD) ! HD + call FAST_UnpackSubDyn_Data(RF, OutData%SD) ! SD + call FAST_UnpackMAP_Data(RF, OutData%MAP) ! MAP + call FAST_UnpackFEAMooring_Data(RF, OutData%FEAM) ! FEAM + call FAST_UnpackMoorDyn_Data(RF, OutData%MD) ! MD + call FAST_UnpackOrcaFlex_Data(RF, OutData%Orca) ! Orca + call FAST_UnpackIceFloe_Data(RF, OutData%IceF) ! IceF + call FAST_UnpackIceDyn_Data(RF, OutData%IceD) ! IceD + call FAST_UnpackExtPtfm_Data(RF, OutData%ExtPtfm) ! ExtPtfm +end subroutine END MODULE FAST_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/openfast-registry/CMakeLists.txt b/modules/openfast-registry/CMakeLists.txt index 8e373eb4ac..2e81dd35c0 100644 --- a/modules/openfast-registry/CMakeLists.txt +++ b/modules/openfast-registry/CMakeLists.txt @@ -14,20 +14,16 @@ # limitations under the License. # -set(REGISTRY_SOURCES - src/data.c - src/gen_c_types.c - src/gen_module_files.c - src/misc.c - src/my_strtok.c - src/reg_parse.c - src/registry.c - src/sym.c - src/symtab_gen.c - src/type.c - ) - -add_executable(openfast_registry ${REGISTRY_SOURCES}) +add_executable(openfast_registry + src/main.cpp + src/registry_gen_fortran.cpp + src/registry_gen_c.cpp + src/registry_parse.cpp + src/registry.cpp + src/registry.hpp + src/templates.hpp +) +target_compile_features(openfast_registry PRIVATE cxx_std_14) set_target_properties(openfast_registry PROPERTIES RUNTIME_OUTPUT_DIRECTORY_DEBUG ${CMAKE_BINARY_DIR}/modules/openfast-registry diff --git a/modules/openfast-registry/src/FAST_preamble.h b/modules/openfast-registry/src/FAST_preamble.h deleted file mode 100644 index 74de0a837b..0000000000 --- a/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/modules/openfast-registry/src/Template_data.c b/modules/openfast-registry/src/Template_data.c deleted file mode 100644 index 22aa731e7e..0000000000 --- a/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/modules/openfast-registry/src/Template_registry.c b/modules/openfast-registry/src/Template_registry.c deleted file mode 100644 index e06dc7dcad..0000000000 --- a/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/modules/openfast-registry/src/data.c b/modules/openfast-registry/src/data.c deleted file mode 100644 index 3224b9118c..0000000000 --- a/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/modules/openfast-registry/src/data.h b/modules/openfast-registry/src/data.h deleted file mode 100644 index 4680d1539e..0000000000 --- a/modules/openfast-registry/src/data.h +++ /dev/null @@ -1,134 +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 ; - -/* array pointer instead of allocatable*/ - int is_pointer; /* 0 = allocatable, 1 = pointer */ -/* 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/modules/openfast-registry/src/gen_c_types.c b/modules/openfast-registry/src/gen_c_types.c deleted file mode 100644 index 74bd14d662..0000000000 --- a/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/modules/openfast-registry/src/gen_module_files.c b/modules/openfast-registry/src/gen_module_files.c deleted file mode 100644 index 1d15ebfe08..0000000000 --- a/modules/openfast-registry/src/gen_module_files.c +++ /dev/null @@ -1,2521 +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(", nonick, r->name, nonick, r->name); - for (int d = 1; d <= r->ndims; d++) { - fprintf(fp, " LBOUND(%sData%%%s,%d)", nonick, r->name, d); - if (d < r->ndims) { fprintf(fp, ","); } - } - fprintf(fp, " ) )\n"); - - 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(", nonick, r->name, nonick, r->name); - for (d = 1; d <= r->ndims; d++) { - fprintf(fp, " i%d_l", d); - if (d < r->ndims) { fprintf(fp, ","); } - } - fprintf(fp, " ) )\n"); - - } - - 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(", r->name,r->name); - for (d = 1; d <= r->ndims; d++) { - fprintf(fp, " i%d_l", d); - if (d < r->ndims) { fprintf(fp, ","); } - } - fprintf(fp, " ) )\n"); - - } - 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, DEALLOCATEpointers )\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 ) :: DEALLOCATEpointers\n"); - fprintf(fp, " \n"); - fprintf(fp, " INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 \n"); - fprintf(fp, " LOGICAL :: DEALLOCATEpointers_local\n"); - fprintf(fp, " INTEGER(IntKi) :: ErrStat2\n"); - fprintf(fp, " CHARACTER(ErrMsgLen) :: ErrMsg2\n"); - fprintf(fp, " CHARACTER(*), PARAMETER :: RoutineName = '%s_Destroy%s'\n\n", ModName->nickname, nonick); - fprintf(fp, " ErrStat = ErrID_None\n"); - fprintf(fp, " ErrMsg = \"\"\n\n"); - fprintf(fp, " IF (PRESENT(DEALLOCATEpointers)) THEN\n"); - fprintf(fp, " DEALLOCATEpointers_local = DEALLOCATEpointers\n"); - fprintf(fp, " ELSE\n"); - fprintf(fp, " DEALLOCATEpointers_local = .true.\n"); - fprintf(fp, " END IF\n"); - fprintf(fp," \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, ErrStat2, ErrMsg2 )\n", nonick, r->name, dimstr(r->ndims)); - fprintf(fp, " CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName)\n"); - } - else if (!strcmp(r->type->name, "dll_type")) { - fprintf(fp, " CALL FreeDynamicLib( %sData%%%s%s, ErrStat2, ErrMsg2 )\n", nonick, r->name, dimstr(r->ndims)); - fprintf(fp, " CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName)\n"); - - } - 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, ErrStat2, ErrMsg2, DEALLOCATEpointers_local )\n", - r->type->module->nickname, fast_interface_type_shortname(nonick2), nonick, r->name, dimstr(r->ndims)); - fprintf(fp, " CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName)\n"); - } - - for (d = r->ndims; d >= 1; d--) { - fprintf(fp, "ENDDO\n"); - } - } - if ( r->ndims > 0 && has_deferred_dim(r,0) ) { - if (is_pointer(r)) { - fprintf(fp, " IF (DEALLOCATEpointers_local) &\n"); - } - 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, char * modPrefix, 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", modPrefix, typnmlong, (q->containsPtr == 1) ? "INOUT" : "IN", uy, typnm); - fprintf(fp, " TYPE(%s%s), INTENT(%s) :: %s2 ! %s at t2 \n", modPrefix, 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", modPrefix, 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, char * modPrefix, 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", modPrefix, typnmlong, (q->containsPtr == 1) ? "INOUT" : "IN", uy, typnm); - fprintf(fp, " TYPE(%s%s), INTENT(%s) :: %s2 ! %s at t2 > t3\n", modPrefix, typnmlong, (q->containsPtr == 1) ? "INOUT" : "IN", uy, typnm); - fprintf(fp, " TYPE(%s%s), INTENT(%s) :: %s3 ! %s at t3\n", modPrefix, 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", modPrefix, 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, const int useModPrefix) -{ - char nonick[NAMELEN]; - char *ddtname; char uy[2]; char modPrefix[NAMELEN + 1]; - 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"); - } - - if (useModPrefix == 1) { - strcpy(modPrefix, ModName->nickname); - strcat(modPrefix, "_"); - } - else - { - strcpy(modPrefix, ""); - } - - 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", modPrefix, 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", modPrefix, 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, modPrefix, max_ndims, max_nrecurs, max_alloc_ndims, q); - gen_ExtrapInterp2(fp, ModName, typnm, typnmlong, xtypnm, uy, modPrefix, 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 == 1 ) { - 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 (sw_ccode && 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",1); - gen_ExtrapInterp(fp, ModName, "UA_BL_Type", "UA_BL_Type", "ReKi",1); - } 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",1); - } -// else if (strcmp(make_lower_temp(ModName->name), "bemt") == 0) { -// gen_ExtrapInterp(fp, ModName, "SkewWake_InputType", "SkewWake_InputType", "DbKi",1); -// } -// else if (strcmp(make_lower_temp(ModName->name), "aerodyn") == 0) { -// gen_ExtrapInterp(fp, ModName, "RotInputType", "RotInputType", "DbKi",0); // don't append "AD_" to the type name! -// } - - gen_ExtrapInterp(fp, ModName, "Input", "InputType", "DbKi",1); - gen_ExtrapInterp(fp, ModName, "Output", "OutputType", "DbKi",1); - } - - 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, ""); - - gen_module ( fp , p, prog_ver ) ; - close_the_file( fp, "" ) ; - - // generate .h files for C/C++: - if ( sw_ccode ) { - 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); - fprintf(stderr, "generating %s\n", fname); - - 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_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/modules/openfast-registry/src/main.cpp b/modules/openfast-registry/src/main.cpp new file mode 100644 index 0000000000..7f7250ae1b --- /dev/null +++ b/modules/openfast-registry/src/main.cpp @@ -0,0 +1,197 @@ +#include + +#include "registry.hpp" +#include "templates.hpp" + +void output_template(std::string &module_name, std::string &module_nickname, bool overwrite, + bool is_template); + +const std::string usage_template = R""""( +Usage: openfast_registry registryfile [options] -or- + [-force] [-template|-registry] ModuleName ModName +Options: + -h this summary + -I look for usefrom files in directory "dir" + -O generate types files in directory "dir" + -incsubs generate the pack/unpack/copy/destroy subroutines to be included in another file + -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) +)""""; + +int main(int argc, char *argv[]) +{ + std::cerr << std::endl; + std::cerr << "------------------------------------------------------------" << std::endl; + std::cerr << "-------------------- OpenFAST Registry ---------------------" << std::endl; + std::cerr << "------------------------------------------------------------" << std::endl; + + // Read command line arguments into a vector + std::vector arguments; + for (int i = 0; i < argc; ++i) + { + arguments.push_back(argv[i]); + } + + std::string out_dir = "."; // if no OutDir is listed, use current directory + std::string inp_file_path; + std::string module_name, module_nickname; + bool output_force_template = false; + + // Create registry object + Registry reg; + + // Loop through arguments + for (auto it = arguments.begin(); it != arguments.end(); ++it) + { + auto arg = *it; + + if ((arg.compare("-force") == 0) || (arg.compare("/force") == 0)) + { + output_force_template = true; + } + else if ((arg.compare("-ccode")) == 0 || (arg.compare("/ccode")) == 0) + { + reg.gen_c_code = true; + } + else if ((arg.compare("-noextrap")) == 0 || (arg.compare("/noextrap")) == 0) + { + reg.no_extrap_interp = true; + } + else if ((arg.compare("-shownodes")) == 0 || (arg.compare("/shownodes")) == 0) + { + } + else if ((arg.compare("-O")) == 0 || (arg.compare("/O")) == 0) + { + std::advance(it, 1); + if (it != arguments.end()) + { + out_dir = *it; + } + } + else if ((arg.compare("-I")) == 0 || (arg.compare("/I")) == 0) + { + std::advance(it, 1); + if (it != arguments.end()) + { + reg.include_dirs.push_back(*it); + } + } + else if ((arg.compare("-incsubs")) == 0 || (arg.compare("/incsubs")) == 0) + { + reg.gen_inc_subs = true; + } + else if ((arg.compare("-template")) == 0 || (arg.compare("-registry")) == 0 || + (arg.compare("/template")) == 0 || (arg.compare("/registry")) == 0) + { + std::advance(it, 1); + if (it != arguments.end()) + { + module_name = *it; + } + else + { + std::cerr << usage_template; + return EXIT_FAILURE; + } + std::advance(it, 1); + if (it != arguments.end()) + { + module_nickname = *it; + } + else + { + std::cerr << usage_template; + return EXIT_FAILURE; + } + + bool is_template = arg.substr(1).compare("template") == 0; + + output_template(module_name, module_nickname, output_force_template, is_template); + return EXIT_SUCCESS; + } + else if ((arg.compare("-h") == 0) || (arg.compare("/h") == 0)) + { + std::cerr << usage_template; + return EXIT_SUCCESS; + } + else + { + // Set input file path + inp_file_path = arg; + + // Replace backslashes with forward slashes in path + std::string path = std::regex_replace(arg, std::regex("\\\\"), "/"); + + // If path contains / remove everything after it + auto slash_index = path.find_last_of("/"); + if (slash_index != std::string::npos) + path = path.substr(0, slash_index); + + // Add input file directory to list of include directories + reg.include_dirs.push_back(path); + } + } + + // If input file name was not specified, exit with error + if (inp_file_path.empty()) + { + std::cerr << usage_template; + return EXIT_FAILURE; + } + + // Parse the registry file + reg.parse(inp_file_path, 0); + + // Generate module files + reg.gen_module_files(out_dir); +} + +void output_template(std::string &module_name, std::string &module_nickname, bool overwrite, + bool is_template) +{ + // Create file name depending on if template or registry + std::string fname = module_name + (is_template ? ".f90" : "_Registry.txt"); + + // If overwrite not requested and file exists, return error + if (!overwrite) + { + std::ifstream infile(fname); + if (infile.good()) + { + std::cerr << "Registry exiting. Attempt to overwrite file (" << fname; + std::cerr << ") . Move out of the way or specify -force before -template option. " + << std::endl; + exit(EXIT_FAILURE); + } + } + + // Open output file, return on error + std::ofstream outfile(fname); + if (!outfile.is_open()) + { + std::cerr << "Registry exiting. Failure opening " << fname << std::endl; + exit(EXIT_FAILURE); + } + + // Select file contents + auto contents = (is_template ? module_template : registry_template); + + // Populate module name and module nickname + contents = std::regex_replace(contents, std::regex("ModuleName"), module_name); + contents = std::regex_replace(contents, std::regex("ModName"), module_nickname); + + // Output contents to file + outfile << contents; + + std::cerr << "Created " << (is_template ? "template" : "registry") << " file '" << fname << "'" << std::endl; +} diff --git a/modules/openfast-registry/src/misc.c b/modules/openfast-registry/src/misc.c deleted file mode 100644 index 628aa05bc4..0000000000 --- a/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/modules/openfast-registry/src/my_strtok.c b/modules/openfast-registry/src/my_strtok.c deleted file mode 100644 index ec7f479a99..0000000000 --- a/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/modules/openfast-registry/src/protos.h b/modules/openfast-registry/src/protos.h deleted file mode 100644 index 1c8e06c000..0000000000 --- a/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/modules/openfast-registry/src/reg_parse.c b/modules/openfast-registry/src/reg_parse.c deleted file mode 100644 index ccacae580c..0000000000 --- a/modules/openfast-registry/src/reg_parse.c +++ /dev/null @@ -1,814 +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%i %s", usefrom_sw, 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 */ -// || !strcmp(tokens[TABLE], "usefrom") - if ( !strcmp( tokens[ TABLE ] , "typedef" ) - || !strncmp(tokens[TABLE], "usefrom", 7) - || !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; - } else if(!strncmp(tokens[TABLE], "usefrom", 7)) - { - tokens[TABLE] += 7; - if (!strcmp(tokens[TABLE], "1")) - { - modname_struct->usefrom = 1; - } - else - { - modname_struct->usefrom = 2; - } - } - - 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 ; - /* Error Checking for Fortran Pointers used outside of FAST Interfaces: InitInputType, InitOutputType, Parameter */ - /* Note: Skip this check if the -ccode option is being used */ - if (field_struct->ndims > 0) { - if (!sw_ccode && is_pointer(field_struct)) { - if (modname_struct->is_interface_type) { - char nonick[NAMELEN]; - sprintf(tmpstr, "%s", make_lower_temp(ddtname)); - remove_nickname(modname_struct->nickname, tmpstr, nonick); - if (!strcmp(nonick, "continuousstatetype")) { - fprintf(stderr, "REGISTRY ERROR: Fortran Pointer Arrays cannot be used in ContinuousStateType data\n"); - exit(9); - } - if (!strcmp(nonick, "discretestatetype")) { - fprintf(stderr, "REGISTRY ERROR: Fortran Pointer Arrays cannot be used in DiscreteStateType data\n"); - exit(9); - } - if (!strcmp(nonick, "constraintstatetype")) { - fprintf(stderr, "REGISTRY ERROR: Fortran Pointer Arrays cannot be used in ConstraintStateType data\n"); - exit(9); - } - if (!strcmp(nonick, "otherstatetype")) { - fprintf(stderr, "REGISTRY ERROR: Fortran Pointer Arrays cannot be used in OtherStateType data\n"); - exit(9); - } - if (!strcmp(nonick, "miscvartype")) { - fprintf(stderr, "REGISTRY ERROR: Fortran Pointer Arrays cannot be used in MiscVarType data\n"); - exit(9); - } - if (!strcmp(nonick, "inputtype")) { - fprintf(stderr, "REGISTRY ERROR: Fortran Pointer Arrays cannot be used in InputType data\n"); - exit(9); - } - if (!strcmp(nonick, "outputtype")) { - fprintf(stderr, "REGISTRY ERROR: Fortran Pointer Arrays cannot be used in OutputType data\n"); - exit(9); - } - } - } - } - 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 ; - dim_entry->is_pointer = 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] == '*' || dimspec[0] == '(' ) - { - char *p, *colon, *paren ; - p = (isNum(dimspec[0])||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 if ((colon = index(p, '*')) != NULL) - { - *colon = '\0'; - dim_entry->deferred = 1; - dim_entry->coord_end = atoi(colon + 1); - dim_entry->is_pointer = 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/modules/openfast-registry/src/registry.c b/modules/openfast-registry/src/registry.c deleted file mode 100644 index 2fe9dc566e..0000000000 --- a/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/modules/openfast-registry/src/registry.cpp b/modules/openfast-registry/src/registry.cpp new file mode 100644 index 0000000000..cc998fb8bf --- /dev/null +++ b/modules/openfast-registry/src/registry.cpp @@ -0,0 +1,39 @@ +#include +#include + +#include "registry.hpp" + +void Registry::gen_module_files(std::string const &out_dir) +{ + // Find root module + std::shared_ptr mod; + for (auto &it : this->modules) + { + if (it.second->is_root) + { + mod = it.second; + break; + } + } + + // If module not found, return error + if (mod == nullptr) + { + std::cerr << "unable to find root module" << std::endl; + exit(EXIT_FAILURE); + } + + // Generate fortran module + this->gen_fortran_module(*mod, out_dir); + + // Generate C code + if (this->gen_c_code) + this->gen_c_module(*mod, out_dir); +} + +std::string tolower(std::string s) +{ + for (auto &c : s) + c = std::tolower(c); + return s; +} \ No newline at end of file diff --git a/modules/openfast-registry/src/registry.h b/modules/openfast-registry/src/registry.h deleted file mode 100644 index 524bbe7e1a..0000000000 --- a/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/modules/openfast-registry/src/registry.hpp b/modules/openfast-registry/src/registry.hpp new file mode 100644 index 0000000000..f615fb7a15 --- /dev/null +++ b/modules/openfast-registry/src/registry.hpp @@ -0,0 +1,551 @@ +#ifndef REGISTRY_HPP +#define REGISTRY_HPP + +#include +#include +#include +#include +#include +#include +#include +#include + +std::string tolower(std::string s); + +// case-independent (ci) string less_than: returns true if s1 < s2 +struct ci_less +{ + // case-independent (ci) compare_less binary function + struct nocase_compare + { + bool operator()(const unsigned char &c1, const unsigned char &c2) const + { + return tolower(c1) < tolower(c2); + } + }; + bool operator()(const std::string &s1, const std::string &s2) const + { + return std::lexicographical_compare(s1.begin(), s1.end(), // source range + s2.begin(), s2.end(), // dest range + nocase_compare()); // comparison + } +}; + +enum class Period +{ + None, + TwoPi, +}; + +struct Module; +struct DataType; + +struct InterfaceData +{ + std::string name; + std::string name_short; + bool only_reals; + + InterfaceData(std::string name, std::string name_short, bool only_reals) + : name(name), name_short(name_short), only_reals(only_reals) + { + } +}; + +struct DimSpec +{ + size_t i = 0; + bool is_deferred = false; + bool is_pointer = false; + std::string lower_bound = "1"; + std::string upper_bound = "-1"; + + DimSpec(std::string spec) + { + // Get indices of first colon and asterisk + auto i = spec.find(":"); + auto j = spec.find("*"); + + // If colon was found + if (i != std::string::npos) + { + // If colon is the only character, this is a deferred dimension + this->is_deferred = spec.size() == 1; + + // If colon isn't first, then parse the lower bound, otherwise 1 + this->lower_bound = i > 0 ? spec.substr(0, i) : "1"; + + // Parse the upper bound + this->upper_bound = this->is_deferred ? "-1" : spec.substr(i + 1); + } + // If asterisk was found + else if (j != std::string::npos) + { + this->is_deferred = true; + this->is_pointer = true; + } + // Otherwise, spec contains upper bound + else + { + this->lower_bound = "1"; + this->upper_bound = spec; + } + } +}; + +struct Field +{ + std::string name; + std::shared_ptr data_type; + std::vector dims; + std::string init_value = ""; + std::string desc = "-"; + std::string units = "-"; + Period gen_periodic = Period::None; + int rank = 0; + bool is_pointer = false; + bool is_allocatable = false; + bool is_target = false; + + Field(const std::string &name, std::shared_ptr const &type, const std::string &dims, + const std::string &ctrl, const std::string &init_value, const std::string &desc, + const std::string &units) + { + if (name[0] == '&') + { + this->name = name.substr(1); + this->is_target = true; + this->is_pointer = true; + this->is_allocatable = true; + } + else if (name[0] == '*') + { + this->name = name.substr(1); + this->is_pointer = true; + this->is_allocatable = true; + } + else + { + this->name = name; + } + + this->data_type = type; + + if (ctrl.compare("2pi") == 0) + { + this->gen_periodic = Period::TwoPi; + } + + if (desc.compare("-") != 0) + { + this->desc = desc; + } + + if (units.compare("-") != 0) + { + this->units = units; + } + + if (dims.compare("-") != 0) + { + // Parse dims, throw exception on error + if (this->parse_dims(dims) != 0) + { + throw std::invalid_argument("invalid dimensions: " + dims); + } + + // Add dimension number + for (size_t i = 0; i < this->dims.size(); ++i) + { + this->dims[i].i = i + 1; + } + + // Get field rank (number of dimensions) + this->rank = static_cast(this->dims.size()); + + // Field is a pointer if any dim is a pointer + this->is_pointer |= std::any_of(this->dims.begin(), this->dims.end(), + [](const DimSpec &ds) + { return ds.is_pointer; }); + + // Field is allocatable if any dim is deferred + this->is_allocatable |= std::any_of(this->dims.begin(), this->dims.end(), + [](const DimSpec &ds) + { return ds.is_deferred; }); + } + + // If field is a pointer, initialize to null + if (this->is_pointer) + { + this->init_value = "null()"; + } + // If field is allocatable, then no initialization + else if (this->is_allocatable) + { + this->init_value = ""; + } + // If initialization is not empty + else if (init_value.compare("-") != 0) + { + this->init_value = init_value; + if (tolower(init_value).compare("f") == 0) + { + this->init_value = ".false."; + } + else if (tolower(init_value).compare("t") == 0) + { + this->init_value = ".true."; + } + } + } + + int parse_dims(std::string dim_field) + { + // If no dimensions specified + if (dim_field.size() == 0) + return 0; + + // Remove leading and trailing braces + if (dim_field[0] == '{') + dim_field = dim_field.substr(1); + if (dim_field.back() == '}') + dim_field.pop_back(); + + // If dim field is only digits, parse number + if (std::all_of(dim_field.begin(), dim_field.end(), ::isdigit)) + { + this->dims.push_back(DimSpec(dim_field)); + return 0; + } + + // If all dims are colons or asterisks, no braces + if (std::all_of(dim_field.begin(), dim_field.end(), [](char c) + { return c == '*'; }) || + std::all_of(dim_field.begin(), dim_field.end(), [](char c) + { return c == ':'; })) + { + for (auto &dim : dim_field) + { + this->dims.push_back(DimSpec(std::string(1, dim))); + } + return 0; + } + + // Split by braces + std::regex split("\\}\\{"); + std::sregex_token_iterator iter(dim_field.begin(), dim_field.end(), split, -1); + std::sregex_token_iterator re_end; + for (; iter != re_end; ++iter) + { + this->dims.push_back(DimSpec(*iter)); + } + + return 0; + } +}; + +struct DataType +{ + enum class Tag + { + Integer, + Real, + Logical, + Character, + Derived, + }; + Tag tag; + + struct Basic + { + std::string name; + std::string type_fortran; + std::string string_len; + int bit_size = 0; + }; + Basic basic; + + struct Derived + { + std::string name; + std::string name_short; + std::string type_fortran; + std::shared_ptr module; + std::vector fields; + bool contains_mesh = false; + std::shared_ptr interface; + int max_rank = 0; + + bool only_contains_reals() + { + // Loop through fields + for (const auto &field : this->fields) + { + // Switch based on field data type + switch (field.data_type->tag) + { + + // Field is a derived type, so check its fields and + // return false if it doesn't only contain reals + case Tag::Derived: + if (!field.data_type->derived.only_contains_reals()) + return false; + continue; + + // Field is a real, continue + case Tag::Real: + continue; + + // Field is not a real, return false + case Tag::Character: + case Tag::Integer: + case Tag::Logical: + return false; + } + } + + // Derived data type and all of its fields only contain reals + return true; + } + }; + Derived derived; + + // Constructor for basic type + DataType(const std::string &name, const std::string &type_fortran, const Tag &type, + const int bit_size = 0, const std::string &string_len = "") + : tag(type) + { + this->basic.name = name; + this->basic.type_fortran = type_fortran; + this->basic.string_len = string_len; + this->basic.bit_size = bit_size; + } + + // Constructor for derived type + DataType(std::shared_ptr mod, const std::string &name, + const std::string &name_short = "", const std::string &name_prefixed = "") + : tag(Tag::Derived) + { + this->derived.name = name; + this->derived.module = mod; + this->derived.name_short = name_short.empty() ? name : name_short; + this->derived.type_fortran = name_prefixed.empty() ? name : name_prefixed; + this->derived.contains_mesh = + (tolower(name).compare("meshtype") == 0) || (tolower(name).compare("meshmaptype") == 0); + } + + std::string c_type() + { + switch (this->tag) + { + case DataType::Tag::Integer: + return "int"; + case DataType::Tag::Logical: + return "bool"; + case DataType::Tag::Character: + return "char"; + case DataType::Tag::Real: + switch (this->basic.bit_size) + { + case 0: + return "float"; + case 32: + return "float"; + case 64: + return "double"; + } + case DataType::Tag::Derived: + return "invalid"; + } + return "invalid"; + } + + std::string c_types_binding() + { + switch (this->tag) + { + case DataType::Tag::Integer: + return "INTEGER(KIND=C_INT)"; + case DataType::Tag::Logical: + return "LOGICAL(KIND=C_BOOL)"; + case DataType::Tag::Character: + return "CHARACTER(KIND=C_CHAR), DIMENSION(" + this->basic.string_len + ")"; + case DataType::Tag::Real: + switch (this->basic.bit_size) + { + case 0: + return "REAL(KIND=C_FLOAT)"; + case 32: + return "REAL(KIND=C_FLOAT)"; + case 64: + return "REAL(KIND=C_DOUBLE)"; + } + case DataType::Tag::Derived: + return "INVALID"; + } + return "INVALID"; + } +}; + +struct Parameter +{ + std::string name; + std::shared_ptr type; + std::string value = ""; + std::string desc = "-"; + std::string units = "-"; + + Parameter(const std::string &name, std::shared_ptr &type, const std::string &value, + const std::string &desc, const std::string &units) + { + this->name = name; + this->type = type; + if (value.compare("-") != 0) + { + this->value = value; + } + if (desc.compare("-") != 0) + { + this->desc = desc; + } + if (desc.compare("-") != 0) + { + this->desc = desc; + } + } +}; + +struct Module +{ + std::string name; + std::string nickname; + std::vector params; + std::map, ci_less> data_types; + std::vector ddt_names; + bool is_root = false; + + Module(std::string name, std::string nickname, bool is_root) + : name(name), nickname(nickname), is_root(is_root) + { + } +}; + +struct Registry +{ + std::vector include_dirs = {"."}; + std::set include_files; + std::vector use_modules; + std::map, ci_less> interface_map; + std::map, ci_less> modules; + std::map, ci_less> data_types; + bool gen_c_code = false; + bool no_extrap_interp = false; + bool gen_inc_subs = false; + + Registry() + { + // Basic types + auto IntKi = + std::make_shared("IntKi", "INTEGER(IntKi)", DataType::Tag::Integer, 32); + auto SiKi = std::make_shared("SiKi", "REAL(SiKi)", DataType::Tag::Real, 32); + auto R4Ki = std::make_shared("R4Ki", "REAL(R4Ki)", DataType::Tag::Real, 32); + auto ReKi = std::make_shared("ReKi", "REAL(ReKi)", DataType::Tag::Real); + auto R8Ki = std::make_shared("R8Ki", "REAL(R8Ki)", DataType::Tag::Real, 64); + auto DbKi = std::make_shared("DbKi", "REAL(DbKi)", DataType::Tag::Real, 64); + auto logical = std::make_shared("Logical", "LOGICAL", DataType::Tag::Logical); + + // Derived types + auto mesh = std::make_shared(nullptr, "MeshType", "MeshType", "MeshType"); + auto dll = std::make_shared(nullptr, "DLL_Type"); + + // Map of data types + this->data_types = std::map, ci_less>{ + {"integer", IntKi}, + {"intki", IntKi}, + {"b4ki", IntKi}, + {"real", ReKi}, + {"reki", ReKi}, + {"siki", SiKi}, + {"r4ki", R4Ki}, + {"r8ki", R8Ki}, + {"doubleprecision", DbKi}, + {"dbki", DbKi}, + {"logical", logical}, + {"meshtype", mesh}, + {"dll_type", dll}, + }; + + this->interface_map = std::map, ci_less>{ + {"InitInputType", std::make_shared("InitInputType", "InitInput", false)}, + {"InitOutputType", + std::make_shared("InitOutputType", "InitOutput", false)}, + {"InputType", std::make_shared("InputType", "Input", true)}, + {"OutputType", std::make_shared("OutputType", "Output", true)}, + {"ContinuousStateType", + std::make_shared("ContinuousStateType", "ContState", true)}, + {"DiscreteStateType", + std::make_shared("DiscreteStateType", "DiscState", true)}, + {"ConstraintStateType", + std::make_shared("ConstraintStateType", "ConstrState", true)}, + {"OtherStateType", + std::make_shared("OtherStateType", "OtherState", false)}, + {"MiscVarType", std::make_shared("MiscVarType", "Misc", false)}, + {"ParameterType", std::make_shared("ParameterType", "Param", false)}, + {"PartialOutputPInputType", + std::make_shared("PartialOutputPInputType", "dYdu", true)}, + {"PartialContStatePInputType", + std::make_shared("PartialContStatePInputType", "dXdu", true)}, + {"PartialDiscStatePInputType", + std::make_shared("PartialDiscStatePInputType", "dXddu", true)}, + {"PartialConstrStatePInputType", + std::make_shared("PartialConstrStatePInputType", "dZdu", true)}, + }; + } + + // Parsing + void parse(const std::string &file_name, const int recurse_level); + int parse_line(const std::string &line, std::vector &fields_prev, + const int recurse_level); + std::shared_ptr find_data_type(const std::string &type_name, + std::shared_ptr mod = nullptr) + { + // Pointer to type + std::shared_ptr data_type; + + // Get map of data types to search + // If module was provided, search it; otherwise, search registry + auto &data_types = mod == nullptr ? this->data_types : mod->data_types; + + // Search for type in registry, return if found + auto it = data_types.find(type_name); + if (it != data_types.end()) + { + return it->second; + } + + // If type starts with character (string type), build type and return it + if (tolower(type_name).compare(0, 9, "character") == 0) + { + // Get string length + auto string_len = type_name.substr(10, type_name.size() - 11); + + // Build type + data_type = std::make_shared(type_name, type_name, DataType::Tag::Character, + 0, string_len); + + // Add type to registry + this->data_types[type_name] = data_type; + return data_type; + } + + return nullptr; + } + + // Output + void gen_module_files(std::string const &out_dir); + void gen_fortran_module(const Module &mod, const std::string &out_dir); + void gen_c_module(const Module &mod, const std::string &out_dir); + void gen_fortran_subs(std::ostream &w, const Module &mod); +}; + +#endif diff --git a/modules/openfast-registry/src/registry_gen_c.cpp b/modules/openfast-registry/src/registry_gen_c.cpp new file mode 100644 index 0000000000..bc8685b6de --- /dev/null +++ b/modules/openfast-registry/src/registry_gen_c.cpp @@ -0,0 +1,132 @@ +#include +#include + +#include "registry.hpp" + +void Registry::gen_c_module(const Module &mod, const std::string &out_dir) +{ + auto file_name = mod.name + "_Types.h"; + auto file_path = out_dir + "/" + file_name; + std::string indent("\n"); + + // Write message that file is being generated + std::cerr << "generating " << file_name << std::endl; + + // Open output file, return if error + std::ofstream w(file_path); + if (!w) + { + std::cerr << "Error creating module file: '" << file_path << "'" << std::endl; + exit(EXIT_FAILURE); + } + + // Write file header + w << "//!STARTOFREGISTRYGENERATEDFILE '" << file_name << "'"; + w << indent << "//!"; + w << indent << "//! WARNING This file is generated automatically by the FAST registry."; + w << indent << "//! Do not edit. Your changes to this file will be lost."; + w << indent << "//!"; + w << indent; + w << indent << "#ifndef _" << mod.name << "_TYPES_H"; + w << indent << "#define _" << mod.name << "_TYPES_H"; + w << indent; + w << indent << "#ifdef _WIN32 //define something for Windows (32-bit)"; + w << indent << "\t#include \"stdbool.h\""; + w << indent << "\t#define CALL __declspec(dllexport)"; + w << indent << "#elif _WIN64 //define something for Windows (64-bit)"; + w << indent << "\t#include \"stdbool.h\""; + w << indent << "\t#define CALL __declspec(dllexport) "; + w << indent << "#else"; + w << indent << "\t#include "; + w << indent << "\t#define CALL "; + w << indent << "#endif"; + + // Loop through data types in module + for (auto &dt_name : mod.ddt_names) + { + // Get derive data types in module + auto it = mod.data_types.find(dt_name); + auto &dt = *it->second; + if (dt.tag != DataType::Tag::Derived) + continue; + auto &ddt = dt.derived; + + // Start of struct + w << indent; + w << indent << "typedef struct " << ddt.type_fortran << " {"; + indent += "\t"; + w << indent << "void *object;"; + + // Loop through fields + for (const auto &field : ddt.fields) + { + if (field.data_type->tag == DataType::Tag::Derived) + { + // TODO:Support derived types + } + else // Basic Type + { + if (field.is_allocatable) + { + w << indent << std::setw(28) << std::left << field.data_type->c_type() + " *" + field.name + ";" + << "int " << field.name << "_Len;"; + } + else if (field.data_type->tag == DataType::Tag::Character) + { + if (field.rank == 0) + { + w << indent << field.data_type->c_type() << " " << field.name << "[" + << field.data_type->basic.string_len << "];"; + } + } + else + { + w << indent << field.data_type->c_type() << " " << field.name << ";"; + } + } + for (int i = 0; i < field.rank; i++) + { + if (!field.is_allocatable && + (field.data_type->tag != DataType::Tag::Character || field.rank == 0)) + w << "[" << field.dims[i].upper_bound << "-" << field.dims[i].lower_bound << "+1];"; + } + } + + indent.erase(indent.size() - 1); + w << indent << "} " << ddt.type_fortran << "_t;"; + } + + //-------------------------------------------------------------------------- + // Write struct containing all of the module's derived types + //-------------------------------------------------------------------------- + + w << indent; + w << indent << "typedef struct " << mod.nickname << "_UserData {"; + indent += "\t"; + + for (auto &dt_name : mod.ddt_names) + { + // Get derived data types with interfaces + auto it = mod.data_types.find(dt_name); + auto &dt = *it->second; + if (dt.tag != DataType::Tag::Derived) + continue; + auto &ddt = dt.derived; + if (ddt.interface == nullptr) + continue; + + // Write name + w << indent << std::setw(28) << std::left << ddt.type_fortran + "_t" + << " " << mod.nickname << "_" << ddt.interface->name_short << ";"; + } + + indent.erase(indent.size() - 1); + w << indent << "} " << mod.nickname << "_t;"; + + // Write file footer + w << indent; + w << indent << "#endif // _" << mod.name << "_TYPES_H"; + w << indent; + w << indent << "//!ENDOFREGISTRYGENERATEDFILE"; + w << indent; +} \ No newline at end of file diff --git a/modules/openfast-registry/src/registry_gen_fortran.cpp b/modules/openfast-registry/src/registry_gen_fortran.cpp new file mode 100644 index 0000000000..2ecc53b1f6 --- /dev/null +++ b/modules/openfast-registry/src/registry_gen_fortran.cpp @@ -0,0 +1,1643 @@ +#include +#include + +#include "registry.hpp" +#include "templates.hpp" + +const int MAXRECURSE = 9; + +void gen_ExtrapInterp(std::ostream &w, const Module &mod, std::string type_name_long, + std::string type_kind, const bool useModPrefix); +void gen_copy(std::ostream &w, const Module &mod, const DataType::Derived &ddt, + const bool gen_c_code); +void gen_destroy(std::ostream &out, const Module &mod, const DataType::Derived &ddt, + const bool gen_c_code); +void gen_pack(std::ostream &out, const Module &mod, const DataType::Derived &ddt, + const bool gen_c_code); +void gen_unpack(std::ostream &out, const Module &mod, const DataType::Derived &ddt, + bool gen_c_code); +void gen_copy_c2f(std::ostream &w, const Module &mod, const DataType::Derived &ddt); +void gen_copy_f2c(std::ostream &w, const Module &mod, const DataType::Derived &ddt); + +std::string dimstr(size_t d) +{ + switch (d) + { + case 0: + return ""; + case 1: + return "(i1)"; + case 2: + return "(i1,i2)"; + case 3: + return "(i1,i2,i3)"; + case 4: + return "(i1,i2,i3,i4)"; + case 5: + return "(i1,i2,i3,i4,i5)"; + } + return " REGISTRY ERROR TOO MANY DIMS "; +} + +std::string dimstr_c(size_t d) +{ + switch (d) + { + case 0: + return ""; + case 1: + return "[i1]"; + case 2: + return "[i2][i1]"; + case 3: + return "[i3][i2][i1]"; + case 4: + return "[i4][i3][i2][i1]"; + case 5: + return "[i5][i4][i3][i2][i1]"; + } + return " REGISTRY ERROR TOO MANY DIMS "; +} + +void Registry::gen_fortran_module(const Module &mod, const std::string &out_dir) +{ + // Create file name and path + auto file_name = mod.name + "_Types.f90"; + if (this->gen_inc_subs) + { + file_name = mod.name + "_IncSubs.f90"; + } + auto file_path = out_dir + "/" + file_name; + std::cerr << "generating " << file_name << std::endl; + bool is_NWTC_Library = false; + + // Open file, exit if error + std::ofstream w(file_path); + if (!w) + { + std::cerr << "Error creating module file: '" << file_path << "'\n"; + exit(EXIT_FAILURE); + } + + // If flag set to generate subroutines only (e.g. for inclusing in ModMesh_Mappings.f90) + // write header, subs, and footer to file, then return + if (this->gen_inc_subs) + { + w << std::regex_replace("!STARTOFREGISTRYGENERATEDFILE 'ModuleName_Subs.f90'\n", std::regex("ModuleName"), mod.name); + w << "!\n! WARNING This file is generated automatically by the FAST registry.\n"; + w << "! Do not edit. Your changes to this file will be lost.\n"; + w << "!\n! FAST Registry'\n"; + + this->gen_fortran_subs(w, mod); + + w << "!ENDOFREGISTRYGENERATEDFILE\n"; + return; + } + + // Write preamble + w << std::regex_replace(FAST_preamble, std::regex("ModuleName"), mod.name); + + // Output USE statements for non-root modules + for (auto const &mod : this->use_modules) + if (tolower(mod).compare("nwtc_library") != 0) + w << "USE " << mod << "_Types\n"; + + // If this is the NWTC Library, we're not going to print "USE NWTC_Library" + if (tolower(mod.name).compare("nwtc_library") == 0) + w << "USE SysSubs\n" + << "USE ModReg\n"; + else + w << "USE NWTC_Library\n"; + + w << "IMPLICIT NONE\n"; + + // Write parameters to file + for (const auto ¶m : mod.params) + { + w << " " << param.type->basic.type_fortran << ", PUBLIC, PARAMETER :: " << param.name; + + if (!param.value.empty()) + w << " = " << param.value; + + if (param.desc.compare("-") != 0 || param.units.compare("-") != 0) + w << " ! " << param.desc << " [" << param.units << "]"; + + w << "\n"; + } + + // Loop through data type names in module + for (auto &dt_name : mod.ddt_names) + { + // Get derived data type + auto &ddt = mod.data_types.find(dt_name)->second->derived; + + // If derived data type should only contain reals, + // verify that it does, otherwise exit with error + if ((ddt.interface != nullptr) && ddt.interface->only_reals) + if (!ddt.only_contains_reals()) + { + std::cerr << "Registry warning: Data type '" << dt_name << "' contains non-real values." << std::endl; + exit(EXIT_FAILURE); + } + + // Write derived type header + w << "! ========= " << ddt.type_fortran << (this->gen_c_code ? "_C" : "") << " =======\n"; + + // If requested, write C version of derived data type + if (this->gen_c_code) + { + w << " TYPE, BIND(C) :: " << ddt.type_fortran << "_C\n"; + w << " TYPE(C_PTR) :: object = C_NULL_PTR\n"; + + for (auto &field : ddt.fields) + { + if (field.data_type->tag != DataType::Tag::Derived) + { + if (field.rank == 0) + { + auto c = field.data_type->c_types_binding(); + w << " " << field.data_type->c_types_binding() + << " :: " << field.name << " \n"; + } + else + { + if (field.is_allocatable) + { + w << " TYPE(C_ptr) :: " << field.name << " = C_NULL_PTR \n"; + w << " INTEGER(C_int) :: " << field.name << "_Len = 0 \n"; + } + else if (field.data_type->tag != DataType::Tag::Character) + { + w << " TYPE(C_PTR) :: " << field.name << "("; + for (int i = 0; i < field.rank; i++) + { + w << (i > 0 ? "," : "") << field.dims[i].upper_bound; + } + w << ")\n"; + } + } + } + } + w << " END TYPE " << ddt.type_fortran << "_C\n"; + } + + // Write Fortran derived data type + w << " TYPE, PUBLIC :: " << ddt.type_fortran << "\n"; + if (this->gen_c_code) + w << " TYPE( " << ddt.type_fortran << "_C ) :: C_obj\n"; + + // Loop through fields + for (auto &field : ddt.fields) + { + if (field.data_type->tag == DataType::Tag::Derived) + { + w << " TYPE(" << field.data_type->derived.type_fortran << ") "; + } + else if (this->gen_c_code && field.is_pointer) + { + auto c = field.data_type->c_types_binding(); + w << " " << field.data_type->c_types_binding() << " "; + } + else + { + w << " " << field.data_type->basic.type_fortran << " "; + } + + if (field.rank > 0) + { + w << ", DIMENSION("; + + // If field is allocatable + if (field.is_allocatable) + { + for (int i = 0; i < field.rank; i++) + w << (i == 0 ? ":" : ",:"); + + w << "), " << (field.is_pointer ? "POINTER " : "ALLOCATABLE "); + } + // Field is not allocatable + else + { + bool first = true; + for (const auto &dim : field.dims) + { + w << (first ? "" : ",") << dim.lower_bound << ":" + << dim.upper_bound; + first = false; + } + w << ") "; + } + } + else if (field.is_pointer) + { + w << ", POINTER"; + } + + w << " :: " << field.name << " "; + + // Add field initialization + if (field.is_pointer) + { + w << "=> NULL() "; + } + else if (field.is_allocatable) + { + // No initialization + } + else if (!field.init_value.empty()) + { + w << "= " << field.init_value << " "; + } + else + { + switch (field.data_type->tag) + { + case DataType::Tag::Real: + switch (field.data_type->basic.bit_size) + { + case 0: + w << "= 0.0_ReKi "; + break; + case 32: + w << "= 0.0_R4Ki "; + break; + case 64: + w << "= 0.0_R8Ki "; + break; + } + break; + case DataType::Tag::Integer: + w << "= 0_IntKi "; + break; + case DataType::Tag::Logical: + w << "= .false. "; + break; + case DataType::Tag::Character: + // w << "= '' "; // This breaks MAP (TODO) + break; + case DataType::Tag::Derived: + break; + } + } + + if (field.desc.compare("-") != 0 || field.units.compare("-") != 0) + { + w << " !< " << field.desc << " [" << field.units << "]"; + } + + w << "\n"; + } + w << " END TYPE " << ddt.type_fortran << "\n"; + w << "! =======================\n"; + } + + w << "CONTAINS\n"; + + // Generate subroutines for this module + this->gen_fortran_subs(w, mod); + + // Write module footer + w << "END MODULE " << mod.name << "_Types\n"; + w << "!ENDOFREGISTRYGENERATEDFILE\n"; +} + +void Registry::gen_fortran_subs(std::ostream &w, const Module &mod) +{ + // Loop through derived data types + for (auto &dt_name : mod.ddt_names) + { + // Get derived data type + auto &ddt = mod.data_types.find(dt_name)->second->derived; + + // Generate copy, destroy, pack, and unpack routines + gen_copy(w, mod, ddt, this->gen_c_code); + gen_destroy(w, mod, ddt, this->gen_c_code); + gen_pack(w, mod, ddt, this->gen_c_code); + gen_unpack(w, mod, ddt, this->gen_c_code); + + // If C code generation requested + if (this->gen_c_code) + { + // Generate C <-> Fortran copy functions + gen_copy_c2f(w, mod, ddt); + gen_copy_f2c(w, mod, ddt); + } + } + + // If this is the AirfoilInfo module, generate routines for Output and UA_BL_Type + if (tolower(mod.name).compare("airfoilinfo") == 0) + { + gen_ExtrapInterp(w, mod, "OutputType", "ReKi", 1); + gen_ExtrapInterp(w, mod, "UA_BL_Type", "ReKi", 1); + } + else if (!this->no_extrap_interp) + { + // If this is the DBEMT module make extrap/interp for ElementInput + if (tolower(mod.name).compare("dbemt") == 0) + gen_ExtrapInterp(w, mod, "ElementInputType", "DbKi", 1); + + // Generate extrap/interp routines for module input and output types + gen_ExtrapInterp(w, mod, "InputType", "DbKi", 1); + gen_ExtrapInterp(w, mod, "OutputType", "DbKi", 1); + + // If this is the AD15 module make extrap/interp for InflowType + if (tolower(mod.name).compare("aerodyn") == 0) + gen_ExtrapInterp(w, mod, "InflowType", "DbKi", 1); + } +} + +void gen_copy(std::ostream &w, const Module &mod, const DataType::Derived &ddt, + const bool gen_c_code) +{ + auto routine_name = mod.nickname + "_Copy" + ddt.name_short; + std::string indent("\n"); + + bool has_alloc = std::any_of(ddt.fields.begin(), ddt.fields.end(), [](Field f) + { return f.is_allocatable; }); + bool has_ddt = std::any_of(ddt.fields.begin(), ddt.fields.end(), [](Field f) + { return f.data_type->tag == DataType::Tag::Derived; }); + bool has_ddt_arr = std::any_of(ddt.fields.begin(), ddt.fields.end(), [](Field f) + { return f.data_type->tag == DataType::Tag::Derived && f.rank > 0; }); + + w << indent << "subroutine " << routine_name << "(Src" << ddt.name_short + << "Data, Dst" << ddt.name_short << "Data, CtrlCode, ErrStat, ErrMsg)"; + indent += " "; + w << indent << "type(" << ddt.type_fortran << "), intent(" << (ddt.contains_mesh ? "inout" : "in") + << ") :: Src" << ddt.name_short << "Data"; + w << indent << "type(" << ddt.type_fortran << "), intent(inout) :: Dst" << ddt.name_short << "Data"; + w << indent << "integer(IntKi), intent(in ) :: CtrlCode"; + w << indent << "integer(IntKi), intent( out) :: ErrStat"; + w << indent << "character(*), intent( out) :: ErrMsg"; + if (has_ddt_arr) + { + w << indent << "integer(B4Ki) :: "; + for (int i = 1; i <= ddt.max_rank; i++) + w << (i > 1 ? ", " : "") << "i" << i; + w << ""; + } + if (has_ddt_arr || has_alloc) + w << indent << "integer(B4Ki) :: LB(" << ddt.max_rank << "), UB(" << ddt.max_rank << ")"; + if (has_ddt || has_alloc) + w << indent << "integer(IntKi) :: ErrStat2"; + if (has_ddt) + w << indent << "character(ErrMsgLen) :: ErrMsg2"; + w << indent << "character(*), parameter :: RoutineName = '" << routine_name << "'"; + w << indent << "ErrStat = ErrID_None"; + w << indent << "ErrMsg = ''"; + + // Loop through fields + for (auto &field : ddt.fields) + { + std::string alloc_assoc = field.is_pointer ? "associated" : "allocated"; + std::string src = "Src" + ddt.name_short + "Data%" + field.name; + std::string dst = "Dst" + ddt.name_short + "Data%" + field.name; + + // w << indent << "! " << field.name; + + // If field is a non-target pointer, associate the destination + // pointer with the source pointer + if (field.is_pointer && !field.is_target) + { + w << indent << dst << " => " << src; + continue; + } + + // If field is allocatable + if (field.is_allocatable) + { + w << indent << "if (" << alloc_assoc << "(" << src << ")) then"; + indent += " "; + + std::string dims(""); + if (field.rank > 0) + { + w << indent << "LB(1:" << field.rank << ") = lbound(" << src << ")"; + w << indent << "UB(1:" << field.rank << ") = ubound(" << src << ")"; + for (int d = 1; d <= field.rank; d++) + dims += ",LB(" + std::to_string(d) + "):UB(" + std::to_string(d) + ")"; + dims = "(" + dims.substr(1) + ")"; + } + + // If dst alloc/assoc + w << indent << "if (.not. " << alloc_assoc << "(" << dst << ")) then"; + indent += " "; + w << indent << "allocate(" << dst << dims << ", stat=ErrStat2)"; + w << indent << "if (ErrStat2 /= 0) then"; + w << indent << " call SetErrStat(ErrID_Fatal, 'Error allocating " << dst << ".', ErrStat, ErrMsg, RoutineName)"; + w << indent << " return"; + w << indent << "end if"; + + // bjj: this needs to be updated if we've got multidimensional arrays + if (gen_c_code && field.is_pointer && + (field.data_type->tag != DataType::Tag::Derived)) + { + std::string dst_c = "Dst" + ddt.name_short + "Data%C_obj%" + field.name; + w << indent << dst_c << "_Len = size(" << dst << ")"; + w << indent << "if (" << dst_c << "_Len > 0) &"; + w << indent << " " << dst_c << " = c_loc(" << dst << "("; + for (int d = 1; d <= field.rank; d++) + w << (d > 1 ? "," : "") << "LB(" << d << ")"; + w << "))"; + } + + // End if dst alloc/assoc + indent.erase(indent.size() - 3); + w << indent << "end if"; + } + + // If derived data type (includes mesh and dll_type) + if (field.data_type->tag == DataType::Tag::Derived) + { + auto &ddt = field.data_type->derived; + + // Get bounds for non-allocated field + if (field.rank > 0 && !field.is_allocatable) + { + w << indent << "LB(1:" << field.rank << ") = lbound(" << src << ")"; + w << indent << "UB(1:" << field.rank << ") = ubound(" << src << ")"; + } + + for (int d = field.rank; d >= 1; d--) + { + w << indent << "do i" << d << " = LB(" << d << "), UB(" << d << ")"; + indent += " "; + } + + if (ddt.name_short.compare("MeshType") == 0) + { + w << indent << "call MeshCopy(" << src << dimstr(field.rank) << ", " << dst + << dimstr(field.rank) << ", CtrlCode, ErrStat2, ErrMsg2 )"; + w << indent << "call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName)"; + w << indent << "if (ErrStat >= AbortErrLev) return"; + } + else if (ddt.name_short.compare("DLL_Type") == 0) + { + w << indent << dst << " = " << src << ""; + } + else + { + w << indent << "call " << ddt.module->nickname << "_Copy" << ddt.name_short << "(" + << src << dimstr(field.rank) << ", " << dst << dimstr(field.rank) + << ", CtrlCode, ErrStat2, ErrMsg2)"; + w << indent << "call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName)"; + w << indent << "if (ErrStat >= AbortErrLev) return"; + } + + for (auto &d : field.dims) + { + indent.erase(indent.size() - 3); + w << indent << "end do"; + } + } + else + { + // Copy values + w << indent << dst << " = " << src; + + // If C code and field isn't a pointer, copy data to C object + if (gen_c_code && !field.is_pointer) + { + if (field.rank == 0) // scalar of any type OR a character array + { + std::string tmp = ddt.name_short + "Data%C_obj%" + field.name; + w << indent << "Dst" << tmp << " = Src" << tmp; + } + } + } + + // End if for source is allocated/associated + // If source is not allocated/associated, but destination is allocated + if (field.is_allocatable) + { + indent.erase(indent.size() - 3); + w << indent << "end if"; + } + } + + indent.erase(indent.size() - 3); + w << indent << "end subroutine"; + w << indent; +} + +void gen_destroy(std::ostream &w, const Module &mod, const DataType::Derived &ddt, + const bool gen_c_code) +{ + auto ddt_data = ddt.name_short + "Data"; + auto routine_name = mod.nickname + "_Destroy" + ddt.name_short; + std::string indent("\n"); + + bool has_ddt = std::any_of(ddt.fields.begin(), ddt.fields.end(), [](Field f) + { return f.data_type->tag == DataType::Tag::Derived; }); + bool has_ddt_arr = std::any_of(ddt.fields.begin(), ddt.fields.end(), [](Field f) + { return f.data_type->tag == DataType::Tag::Derived && f.rank > 0; }); + + w << indent << "subroutine " << routine_name << "(" << ddt_data << ", ErrStat, ErrMsg)"; + indent += " "; + w << indent << "type(" << ddt.type_fortran << "), intent(inout) :: " << ddt_data; + w << indent << "integer(IntKi), intent( out) :: ErrStat"; + w << indent << "character(*), intent( out) :: ErrMsg"; + if (has_ddt_arr) + { + w << indent << "integer(B4Ki) :: "; + for (int i = 1; i <= ddt.max_rank; i++) + w << (i > 1 ? ", " : "") << "i" << i; + w << indent << "integer(B4Ki) :: LB(" << ddt.max_rank << "), UB(" << ddt.max_rank << ")"; + } + if (has_ddt) + { + w << indent << "integer(IntKi) :: ErrStat2"; + w << indent << "character(ErrMsgLen) :: ErrMsg2"; + } + w << indent << "character(*), parameter :: RoutineName = '" << routine_name << "'"; + w << indent << "ErrStat = ErrID_None"; + w << indent << "ErrMsg = ''"; + + // Loop through fields in derived data type + for (auto &field : ddt.fields) + { + auto var = ddt_data + "%" + field.name; + std::string alloc_assoc = field.is_pointer ? "associated" : "allocated"; + + // w << indent << "! " << field.name; + + // If non-target pointer field, just nullify pointer + if (field.is_pointer && !field.is_target) + { + w << indent << "nullify(" << var << ")"; + continue; + } + + // If field is allocatable + if (field.is_allocatable) + { + w << indent << "if (" << alloc_assoc << "(" << var << ")) then"; + indent += " "; + } + + // If field is a derived data type, loop through elements and destroy + if (field.data_type->tag == DataType::Tag::Derived) + { + auto var_dims = var + dimstr(field.rank); + + if (field.rank > 0) + { + w << indent << "LB(1:" << field.rank << ") = lbound(" << var << ")"; + w << indent << "UB(1:" << field.rank << ") = ubound(" << var << ")"; + } + for (int d = field.rank; d >= 1; d--) + { + w << indent << "do i" << d << " = LB(" << d << "), UB(" << d << ")"; + indent += " "; + } + + if (field.data_type->derived.name.compare("MeshType") == 0) + { + w << indent << "call MeshDestroy( " << var_dims << ", ErrStat2, ErrMsg2)"; + w << indent << "call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName)"; + } + else if (field.data_type->derived.name.compare("DLL_Type") == 0) + { + w << indent << "call FreeDynamicLib( " << var_dims << ", ErrStat2, ErrMsg2)"; + w << indent << "call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName)"; + } + else + { + w << indent << "call " << field.data_type->derived.module->nickname << "_Destroy" + << field.data_type->derived.name_short << "(" << var_dims << ", ErrStat2, ErrMsg2)"; + w << indent << "call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName)"; + } + + // Close for loops + for (int d = field.rank; d >= 1; d--) + { + indent.erase(indent.size() - 3); + w << indent << "end do"; + } + } + + if (field.is_allocatable) + { + w << indent << "deallocate(" << var << ")"; + if (field.is_pointer) + { + w << indent << var << " => null()"; + + if (gen_c_code && (field.data_type->tag != DataType::Tag::Derived)) + { + auto var_c = ddt_data + "%C_obj%" + field.name; + w << indent << var_c << " = c_null_ptr"; + w << indent << var_c << "_Len = 0"; + } + } + + indent.erase(indent.size() - 3); + w << indent << "end if"; + } + } + + indent.erase(indent.size() - 3); + w << indent << "end subroutine"; + w << indent; +} + +void gen_pack(std::ostream &w, const Module &mod, const DataType::Derived &ddt, + const bool gen_c_code) +{ + auto ddt_data = ddt.name_short + "Data"; + auto routine_name = mod.nickname + "_Pack" + ddt.name_short; + std::string indent("\n"); + + bool has_alloc = std::any_of(ddt.fields.begin(), ddt.fields.end(), [](Field f) + { return f.is_allocatable; }); + bool has_ptr = std::any_of(ddt.fields.begin(), ddt.fields.end(), [](Field f) + { return f.is_pointer; }); + bool has_ddt_arr = std::any_of(ddt.fields.begin(), ddt.fields.end(), [](Field f) + { return f.data_type->tag == DataType::Tag::Derived && f.rank > 0; }); + + w << indent << "subroutine " << routine_name << "(RF, Indata)"; + indent += " "; + w << indent << "type(RegFile), intent(inout) :: RF"; + w << indent << "type(" << ddt.type_fortran << "), intent(in) :: InData"; + w << indent << "character(*), parameter :: RoutineName = '" << routine_name << "'"; + if (has_ddt_arr) + { + w << indent << "integer(B4Ki) :: "; + for (int i = 1; i <= ddt.max_rank; i++) + w << (i > 1 ? ", " : "") << "i" << i; + w << indent << "integer(B4Ki) :: LB(" << ddt.max_rank << "), UB(" << ddt.max_rank << ")"; + } + if (has_ptr) + { + w << indent << "logical :: PtrInIndex"; + } + + w << indent << "if (RF%ErrStat >= AbortErrLev) return"; + + if (gen_c_code) + { + w << indent << "if (c_associated(InData%C_obj%object)) then"; + w << indent << " call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', RF%ErrStat, RF%ErrMsg, RoutineName)"; + w << indent << " return"; + w << indent << "end if"; + } + + // Pack data + for (auto &field : ddt.fields) + { + auto assoc_alloc = field.is_pointer ? "associated" : "allocated"; + auto var = "InData%" + field.name; + + // w << indent << "! " << field.name; + + // If the field is not derived, is allocatable, is not a pointer, + // use RegPackAlloc function and continue + if (field.data_type->tag != DataType::Tag::Derived && field.is_allocatable) + { + if (field.is_pointer) + { + w << indent << "call RegPackPtr(RF, " << var << ")"; + } + else + { + w << indent << "call RegPackAlloc(RF, " << var << ")"; + } + continue; + } + + if (field.is_allocatable) + { + w << indent << "call RegPack(RF, " << assoc_alloc << "(" << var << "))"; + w << indent << "if (" << assoc_alloc << "(" << var << ")) then"; + indent += " "; + if (field.rank > 0) + { + w << indent << "call RegPackBounds(RF, " << field.rank << ", lbound(" << var << "), ubound(" << var << "))"; + } + if (field.is_pointer) + { + w << indent << "call RegPackPointer(RF, c_loc(" << var << "), PtrInIndex)"; + w << indent << "if (.not. PtrInIndex) then"; + indent += " "; + } + } + + // call individual routines to pack data from subtypes: + if (field.data_type->tag == DataType::Tag::Derived) + { + auto field_dims = var + dimstr(field.rank); + + if (field.rank > 0) + { + w << indent << "LB(1:" << field.rank << ") = lbound(" << var << ")"; + w << indent << "UB(1:" << field.rank << ") = ubound(" << var << ")"; + } + + for (int d = field.rank; d >= 1; d--) + { + w << indent << "do i" << d << " = LB(" << d << "), UB(" << d << ")"; + indent += " "; + } + + if (field.data_type->derived.name.compare("MeshType") == 0) + { + w << indent << "call MeshPack(RF, " << field_dims << ") "; + } + else if (field.data_type->derived.name.compare("DLL_Type") == 0) + { + w << indent << "call DLLTypePack(RF, " << field_dims << ") "; + } + else + { + w << indent << "call " << field.data_type->derived.module->nickname << "_Pack" + << field.data_type->derived.name_short << "(RF, " << field_dims << ") "; + } + + for (int d = field.rank; d >= 1; d--) + { + indent.erase(indent.size() - 3); + w << indent << "end do"; + } + } + else + { + // Intrinsic types are handled by generic registry file Pack method + w << indent << "call RegPack(RF, " << var << ")"; + } + + if (field.is_pointer) + { + indent.erase(indent.size() - 3); + w << indent << "end if"; + } + + if (field.is_allocatable) + { + indent.erase(indent.size() - 3); + w << indent << "end if"; + } + } + + // Check for pack errors at end of routine + w << indent << "if (RegCheckErr(RF, RoutineName)) return"; + + indent.erase(indent.size() - 3); + w << indent << "end subroutine"; + w << indent; +} + +void gen_unpack(std::ostream &w, const Module &mod, const DataType::Derived &ddt, bool gen_c_code) +{ + auto routine_name = mod.nickname + "_UnPack" + ddt.name_short; + std::string indent("\n"); + + bool has_alloc = std::any_of(ddt.fields.begin(), ddt.fields.end(), [](Field f) + { return f.is_allocatable; }); + bool has_ptr = std::any_of(ddt.fields.begin(), ddt.fields.end(), [](Field f) + { return f.is_pointer; }); + bool has_ddt_arr = std::any_of(ddt.fields.begin(), ddt.fields.end(), [](Field f) + { return f.data_type->tag == DataType::Tag::Derived && f.rank > 0; }); + + w << indent << "subroutine " << routine_name << "(RF, OutData)"; + indent += " "; + w << indent << "type(RegFile), intent(inout) :: RF"; + w << indent << "type(" << ddt.type_fortran << "), intent(inout) :: OutData"; + w << indent << "character(*), parameter :: RoutineName = '" << routine_name << "'"; + if (has_ddt_arr) + { + w << indent << "integer(B4Ki) :: "; + for (int i = 1; i <= ddt.max_rank; i++) + w << (i > 1 ? ", " : "") << "i" << i; + w << ""; + } + if (has_ddt_arr || has_alloc) + { + w << indent << "integer(B4Ki) :: LB(" << ddt.max_rank << "), UB(" << ddt.max_rank << ")"; + } + if (has_alloc) + { + w << indent << "integer(IntKi) :: stat"; + w << indent << "logical :: IsAllocAssoc"; + } + if (has_ptr) + { + w << indent << "integer(B8Ki) :: PtrIdx"; + w << indent << "type(c_ptr) :: Ptr"; + } + w << indent << "if (RF%ErrStat /= ErrID_None) return"; + + // BJJ: TODO: if there are C types, we're going to have to associate with C data structures.... + + // Loop through fields and generate code to unpack data + for (auto &field : ddt.fields) + { + auto field_dims = field.name + dimstr(field.rank); + std::string var = "OutData%" + field.name; + std::string var_dims = "OutData%" + field.name + dimstr(field.rank); + std::string var_c = "OutData%C_obj%" + field.name; + auto assoc_alloc = field.is_pointer ? "associated" : "allocated"; + + // w << indent << "! " << field.name << ""; + + // If the field is not derived and is allocatable + if (field.data_type->tag != DataType::Tag::Derived && field.is_allocatable) + { + if (field.is_pointer) + { + w << indent << "call RegUnpackPtr(RF, " << var << ", LB, UB)" + << "; if (RegCheckErr(RF, RoutineName)) return"; + + // If C code is generated, output code to initialize C object + if (gen_c_code) + { + w << indent << "if (associated(" << var << ")) then"; + w << indent << " " << var_c << "_Len = size(" << var << ")"; + w << indent << " " << "if (" << var_c << "_Len > 0) " << var_c << " = c_loc(" << var << "("; + for (int d = 1; d <= field.rank; d++) + w << (d > 1 ? "," : "") << "LB(" << d << ")"; + w << "))"; + w << indent << "end if"; + } + } + else + { + w << indent << "call RegUnpackAlloc(RF, " << var << ")" + << "; if (RegCheckErr(RF, RoutineName)) return"; + } + continue; + } + + if (field.is_allocatable) + { + w << indent << "if (" << assoc_alloc << "(" << var << ")) deallocate(" << var << ")"; + w << indent << "call RegUnpack(RF, IsAllocAssoc)" + << "; if (RegCheckErr(RF, RoutineName)) return"; + w << indent << "if (IsAllocAssoc) then"; + indent += " "; + if (field.rank > 0) + { + w << indent << "call RegUnpackBounds(RF, " << field.rank << ", LB, UB)" + << "; if (RegCheckErr(RF, RoutineName)) return"; + } + } + + if (field.is_pointer) + { + w << indent << "call RegUnpackPointer(RF, Ptr, PtrIdx)" + << "; if (RegCheckErr(RF, RoutineName)) return"; + w << indent << "if (c_associated(Ptr)) then"; + if (field.rank == 0) + { + w << indent << " call c_f_pointer(Ptr, " << var << ")"; + } + else + { + auto rank = std::to_string(field.rank); + w << indent << " call c_f_pointer(Ptr, " << var << ", UB(1:" << rank << ")-LB(1:" << rank << "))"; + std::string remap_dims; + for (int d = 1; d <= field.rank; d++) + remap_dims += std::string(d > 1 ? "," : "") + "LB(" + std::to_string(d) + "):"; + w << indent << " " << var << "(" << remap_dims << ") => " << var; + } + w << indent << "else"; + indent += " "; + } + + if (field.is_allocatable) + { + std::string dims; + for (int d = 1; d <= field.rank; d++) + dims += std::string(d == 1 ? "(" : "") + "LB(" + std::to_string(d) + ")" + + ":UB(" + std::to_string(d) + ")" + (d < field.rank ? "," : ")"); + w << indent << "allocate(" << var << dims << ",stat=stat)"; + w << indent << "if (stat /= 0) then "; + w << indent << " call SetErrStat(ErrID_Fatal, 'Error allocating " << var << ".', RF%ErrStat, RF%ErrMsg, RoutineName)"; + w << indent << " return"; + w << indent << "end if"; + } + + // If this is a pointer, set pointer in registry file pointer index + if (field.is_pointer) + { + w << indent << "RF%Pointers(PtrIdx) = c_loc(" << var << ")"; + } + + // Call individual routines to unpack data from subtypes: + if (field.data_type->tag == DataType::Tag::Derived) + { + // Get bounds for non-allocated field + if (field.rank > 0 && !field.is_allocatable) + { + w << indent << "LB(1:" << field.rank << ") = lbound(" << var << ")"; + w << indent << "UB(1:" << field.rank << ") = ubound(" << var << ")"; + } + + for (int d = field.rank; d >= 1; d--) + { + w << indent << "do i" << d << " = LB(" << d << "), UB(" << d << ")"; + indent += " "; + } + + if (field.data_type->derived.name.compare("MeshType") == 0) + { + w << indent << "call MeshUnpack(RF, " << var_dims << ") ! " << field.name << " "; + } + else if (field.data_type->derived.name.compare("DLL_Type") == 0) + { + w << indent << "call DLLTypeUnpack(RF, " << var_dims << ") ! " << field.name << " "; + } + else + { + w << indent << "call " << field.data_type->derived.module->nickname << "_Unpack" + << field.data_type->derived.name_short << "(RF, " << var_dims << ") ! " << field.name << " "; + } + + for (int d = field.rank; d >= 1; d--) + { + indent.erase(indent.size() - 3); + w << indent << "end do"; + } + } + else + { + // Intrinsic types are handled by generic registry file unpack method + w << indent << "call RegUnpack(RF, " << var << ")" + << "; if (RegCheckErr(RF, RoutineName)) return"; + + // need to move scalars and strings to the %c_obj% type, too! + // compare with copy routine + if (gen_c_code && !field.is_pointer && field.rank == 0) + { + switch (field.data_type->tag) + { + case DataType::Tag::Real: + case DataType::Tag::Integer: + case DataType::Tag::Logical: + w << indent << var_c << " = " << var << ""; + break; + case DataType::Tag::Character: + w << indent << var_c << " = transfer(" << var << ", " << var_c << " )"; + break; + case DataType::Tag::Derived: + break; + } + } + } + + if (field.is_pointer) + { + indent.erase(indent.size() - 3); + w << indent << "end if"; + } + + if (field.is_allocatable) + { + indent.erase(indent.size() - 3); + if (field.is_pointer) + { + w << indent << "else"; + w << indent << " " << var << " => null()"; + } + w << indent << "end if"; + } + } + + indent.erase(indent.size() - 3); + w << indent << "end subroutine"; + w << indent; +} + +void gen_extint_order(std::ostream &w, const Module &mod, std::string uy, const int order, + const Field &field, const std::string &deref, const int recurse_level, std::string &indent) +{ + if (recurse_level > MAXRECURSE) + { + std::cerr << "REGISTRY ERROR: too many levels of array subtypes\n"; + exit(EXIT_FAILURE); + } + + auto assoc_alloc = field.is_pointer ? "ASSOCIATED" : "ALLOCATED"; + + std::string dims = dimstr(field.rank); + std::string v1 = uy + "1" + deref + "%" + field.name; + std::string v2 = uy + "2" + deref + "%" + field.name; + std::string v3 = uy + "3" + deref + "%" + field.name; + std::string vout = uy + "_out" + deref + "%" + field.name; + + // check if this is an allocatable array: + if (field.is_allocatable) + { + w << indent << "IF (" << assoc_alloc << "(" << vout << ") .AND. " << assoc_alloc << "(" << v1 << ")) THEN"; + indent += " "; + } + + if (field.data_type->tag == DataType::Tag::Derived) + { + auto &ddt = field.data_type->derived; + + // If this is a type within this module + if ((ddt.module != nullptr) && (ddt.module->name == mod.name)) + { + for (auto &sub_field : ddt.fields) + { + std::string field_var = deref + "%" + field.name; + + for (int j = field.rank; j > 0; j--) + { + w << indent << "do i" << recurse_level << j << " = lbound(" << uy << "_out" << field_var << "," << j << "),ubound(" << uy << "_out" << field_var << "," << j << ")"; + indent += " "; + } + + if (field.rank > 0) + { + field_var += "("; + for (int j = 1; j <= field.rank; j++) + { + field_var += "i" + std::to_string(recurse_level) + std::to_string(j); + if (j < field.rank) + field_var += ","; + } + field_var += ")"; + } + + gen_extint_order(w, mod, uy, order, sub_field, field_var, recurse_level + 1, indent); + + for (int j = field.rank; j > 0; j--) + { + indent.erase(indent.size() - 3); + w << indent << "END DO"; + } + } + } + else + { + for (int j = field.rank; j > 0; j--) + { + w << indent << "do i" << j << " = lbound(" << vout << "," << j << "),ubound(" << vout << "," << j << ")"; + indent += " "; + } + + if (field.data_type->derived.name.compare("MeshType") == 0) + { + if (order == 0) + { + w << indent << "CALL MeshCopy(" << v1 + dims << ", " << vout + dims + << ", MESH_UPDATECOPY, ErrStat2, ErrMsg2)"; + } + else if (order == 1) + { + w << indent << "CALL MeshExtrapInterp1(" << v1 + dims << ", " << v2 + dims + << ", tin, " << vout + dims << ", tin_out, ErrStat2, ErrMsg2)"; + } + else if (order == 2) + { + w << indent << "CALL MeshExtrapInterp2(" << v1 + dims << ", " << v2 + dims << ", " + << v3 + dims << ", tin, " << vout + dims + << ", tin_out, ErrStat2, ErrMsg2)"; + } + } + else + { + if (order == 0) + { + w << indent << "CALL " << field.data_type->derived.module->nickname << "_Copy" + << field.data_type->derived.name_short << "(" << v1 + dims << ", " + << vout + dims << ", MESH_UPDATECOPY, ErrStat2, ErrMsg2)"; + } + else if (order == 1) + { + w << indent << "CALL " << field.data_type->derived.module->nickname << "_" + << field.data_type->derived.name_short << "_ExtrapInterp1( " << v1 + dims + << ", " << v2 + dims << ", tin, " << vout + dims + << ", tin_out, ErrStat2, ErrMsg2)"; + } + else if (order == 2) + { + w << indent << "CALL " << field.data_type->derived.module->nickname << "_" + << field.data_type->derived.name_short << "_ExtrapInterp2( " << v1 + dims + << ", " << v2 + dims << ", " << v3 + dims << ", tin, " << vout + dims + << ", tin_out, ErrStat2, ErrMsg2)"; + } + } + + w << indent << " CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName)"; + + for (int j = field.rank; j >= 1; j--) + { + indent.erase(indent.size() - 3); + w << indent << "END DO"; + } + } + } + else if (field.data_type->tag == DataType::Tag::Real) + { + if (order == 0) + { + w << indent << vout << " = " << v1; + } + + if (order == 0 || field.gen_periodic == Period::TwoPi) + { + for (int j = field.rank; j > 0; j--) + { + w << indent << "do i" << j << " = lbound(" << vout << "," << j << "),ubound(" << vout << "," << j << ")"; + indent += " "; + } + } + + if (order == 1) + { + if (field.gen_periodic == Period::TwoPi) + { + w << indent << "CALL Angles_ExtrapInterp( " << v1 + dims << ", " << v2 + dims + << ", tin, " << vout + dims << ", tin_out )"; + } + else + { + w << indent << vout << " = a1*" << v1 << " + a2*" << v2; + }; + } + if (order == 2) + { + if (field.gen_periodic == Period::TwoPi) + { + w << indent << "CALL Angles_ExtrapInterp( " << v1 + dims << ", " << v2 + dims + << ", " << v3 + dims << ", tin, " << vout + dims << ", tin_out )"; + } + else + { + w << indent << vout << " = a1*" << v1 << " + a2*" << v2 << " + a3*" << v3; + } + } + if (order == 0 || field.gen_periodic == Period::TwoPi) + { + for (int j = field.rank; j >= 1; j--) + { + indent.erase(indent.size() - 3); + w << indent << "END DO"; + } + } + } + + // check if this is an allocatable array: + if (field.is_allocatable) + { + indent.erase(indent.size() - 3); + w << indent << "END IF ! check if allocated"; + } +} + +void calc_extint_order(std::ostream &w, const Module &mod, const Field &field, int recurse_level, + int &max_rank, int &max_nrecurs, int &max_alloc_ndims) +{ + // bjj: make sure this is consistent with logic of gen_extint_order + + // If recursion level is greater than limit, exit with error + if (recurse_level > MAXRECURSE) + { + std::cerr << "REGISTRY ERROR: too many levels of array subtypes\n"; + exit(EXIT_FAILURE); + } + + // Update max dims based on field rank + max_rank = std::max(max_rank, field.rank); + + // Switch based on field data type + switch (field.data_type->tag) + { + case DataType::Tag::Derived: + + // If this derived type belongs to this module + if (field.data_type->derived.module != nullptr && + field.data_type->derived.module->name.compare(mod.name) == 0) + { + // Update recursion level + max_nrecurs = std::max(max_nrecurs, recurse_level); + + // Loop through fields and calculate order + for (const auto &sub_field : field.data_type->derived.fields) + calc_extint_order(w, mod, sub_field, recurse_level + 1, max_rank, max_nrecurs, + max_alloc_ndims); + } + break; + + case DataType::Tag::Real: + max_alloc_ndims = std::max(max_alloc_ndims, field.rank); + break; + + default: + // TODO: handle other field types + break; + } +} + +void gen_ExtrapInterp1(std::ostream &w, const Module &mod, const DataType::Derived &ddt, + std::string &type_kind, std::string &uy, std::string &mod_prefix, + const int max_rank, const int max_nrecurs, const int max_alloc_ndims) +{ + std::string indent("\n"); + std::string mod_ddt(mod.nickname + "_" + ddt.name_short); + + w << indent << "SUBROUTINE " << mod_ddt << "_ExtrapInterp1(" << uy << "1, " << uy << "2, tin, " << uy << "_out, tin_out, ErrStat, ErrMsg )"; + w << indent << "!"; + w << indent << "! This subroutine calculates a extrapolated (or interpolated) " << ddt.name_short << " " << uy << "_out at time t_out, from previous/future time"; + w << indent << "! values of " << uy << " (which has values associated with times in t). Order of the interpolation is 1."; + w << indent << "!"; + w << indent << "! f(t) = a + b * t, or"; + w << indent << "!"; + w << indent << "! where a and b are determined as the solution to"; + w << indent << "! f(t1) = " << uy << "1, f(t2) = " << uy << "2"; + w << indent << "!"; + w << indent << "!" << std::string(130, '.'); + w << indent; + indent += " "; + w << indent << "TYPE(" << ddt.type_fortran << "), INTENT(" << (ddt.contains_mesh == 1 ? "INOUT" : "IN") << ") :: " << uy << "1 ! " << ddt.name_short << " at t1 > t2"; + w << indent << "TYPE(" << ddt.type_fortran << "), INTENT(" << (ddt.contains_mesh == 1 ? "INOUT" : "IN") << ") :: " << uy << "2 ! " << ddt.name_short << " at t2 "; + w << indent << "REAL(" << type_kind << "), INTENT(IN ) :: tin(2) ! Times associated with the " << ddt.name_short << "s"; + w << indent << "TYPE(" << ddt.type_fortran << "), INTENT(INOUT) :: " << uy << "_out ! " << ddt.name_short << " at tin_out"; + w << indent << "REAL(" << type_kind << "), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to"; + w << indent << "INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation"; + w << indent << "CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None"; + w << indent << "! local variables"; + w << indent << "REAL(" << type_kind << ") :: t(2) ! Times associated with the " << ddt.name_short << "s"; + w << indent << "REAL(" << type_kind << ") :: t_out ! Time to which to be extrap/interpd"; + w << indent << "CHARACTER(*), PARAMETER :: RoutineName = '" << mod_ddt << "_ExtrapInterp1'"; + w << indent << "REAL(DbKi) :: a1, a2 ! temporary for extrapolation/interpolation"; + w << indent << "INTEGER(IntKi) :: ErrStat2 ! local errors"; + w << indent << "CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors"; + + for (int j = 1; j <= max_rank; j++) + { + for (int i = 0; i <= max_nrecurs; i++) + { + w << indent << "INTEGER :: i" << i << j << " ! dim" << j + << " level " << i << " counter variable for arrays of ddts"; + } + } + for (int j = 1; j <= max_rank; j++) + { + w << indent << "INTEGER :: i" << j << " ! dim" << j + << " counter variable for arrays"; + } + + w << indent << "! Initialize ErrStat"; + w << indent << "ErrStat = ErrID_None"; + w << indent << "ErrMsg = ''"; + w << indent << "! we'll subtract a constant from the times to resolve some "; + w << indent << "! numerical issues when t gets large (and to simplify the equations)"; + w << indent << "t = tin - tin(1)"; + w << indent << "t_out = tin_out - tin(1)"; + w << indent; + w << indent << "IF (EqualRealNos(t(1), t(2))) THEN"; + w << indent << " CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg, RoutineName)"; + w << indent << " RETURN"; + w << indent << "END IF"; + w << indent; + w << indent << "! Calculate weighting factors from Lagrange polynomial"; + w << indent << "a1 = -(t_out - t(2))/t(2)"; + w << indent << "a2 = t_out/t(2)"; + w << indent; + + // Recursively generate extrap interp code + for (const auto &field : ddt.fields) + gen_extint_order(w, mod, uy, 1, field, "", 0, indent); + + indent.erase(indent.size() - 3); + w << indent << "END SUBROUTINE"; + w << indent; +} + +void gen_ExtrapInterp2(std::ostream &w, const Module &mod, const DataType::Derived &ddt, + std::string &type_kind, std::string &uy, std::string &modPrefix, + const int max_rank, const int max_nrecurs, const int max_alloc_ndims) +{ + std::string indent("\n"); + std::string ddt_intent(ddt.contains_mesh == 1 ? "INOUT" : "IN"); + + w << indent << "SUBROUTINE " << mod.nickname << "_" << ddt.name_short << "_ExtrapInterp2(" << uy << "1, " + << uy << "2, " << uy << "3, tin, " << uy << "_out, tin_out, ErrStat, ErrMsg )"; + w << indent << "!"; + w << indent << "! This subroutine calculates a extrapolated (or interpolated) " << ddt.name_short << " " + << uy << "_out at time t_out, from previous/future time"; + w << indent << "! values of " << uy + << " (which has values associated with times in t). Order of the interpolation is 2."; + w << indent << "!"; + w << indent << "! expressions below based on either"; + w << indent << "!"; + w << indent << "! f(t) = a + b * t + c * t**2"; + w << indent << "!"; + w << indent << "! where a, b and c are determined as the solution to"; + w << indent << "! f(t1) = " << uy << "1, f(t2) = " << uy << "2, f(t3) = " << uy << "3"; + w << indent << "!"; + w << indent << "!" << std::string(130, '.') << ""; + w << indent << ""; + indent += " "; + w << indent << "TYPE(" << ddt.type_fortran << "), INTENT(" << ddt_intent << ") :: " << uy << "1 ! " << ddt.name_short << " at t1 > t2 > t3"; + w << indent << "TYPE(" << ddt.type_fortran << "), INTENT(" << ddt_intent << ") :: " << uy << "2 ! " << ddt.name_short << " at t2 > t3"; + w << indent << "TYPE(" << ddt.type_fortran << "), INTENT(" << ddt_intent << ") :: " << uy << "3 ! " << ddt.name_short << " at t3"; + w << indent << "REAL(" << type_kind << "), INTENT(IN ) :: tin(3) ! Times associated with the " << ddt.name_short << "s"; + w << indent << "TYPE(" << ddt.type_fortran << "), INTENT(INOUT) :: " << uy << "_out ! " << ddt.name_short << " at tin_out"; + w << indent << "REAL(" << type_kind << "), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to"; + + w << indent << "INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation"; + w << indent << "CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None"; + w << indent << "! local variables"; + w << indent << "REAL(" << type_kind << ") :: t(3) ! Times associated with the " << ddt.name_short << "s"; + w << indent << "REAL(" << type_kind << ") :: t_out ! Time to which to be extrap/interpd"; + w << indent << "INTEGER(IntKi) :: order ! order of polynomial fit (max 2)"; + + w << indent << "REAL(DbKi) :: a1,a2,a3 ! temporary for extrapolation/interpolation"; + // w << indent << "REAL(DbKi) :: b ! temporary for extrapolation/interpolation"; + // w << indent << "REAL(DbKi) :: c ! temporary for extrapolation/interpolation"; + // w << indent << "REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation"; + w << indent << "INTEGER(IntKi) :: ErrStat2 ! local errors"; + w << indent << "CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors"; + w << indent << "CHARACTER(*), PARAMETER :: RoutineName = '" << mod.nickname << "_" << ddt.name_short << "_ExtrapInterp2'"; + for (int j = 1; j <= max_rank; j++) + { + for (int i = 0; i <= max_nrecurs; i++) + { + w << indent << "INTEGER :: i" << i << j << " ! dim" << j << " level " << i << " counter variable for arrays of ddts"; + } + } + for (int j = 1; j <= max_rank; j++) + { + w << indent << "INTEGER :: i" << j << " ! dim" << j << " counter variable for arrays"; + } + w << indent << "! Initialize ErrStat"; + w << indent << "ErrStat = ErrID_None"; + w << indent << "ErrMsg = ''"; + w << indent << "! we'll subtract a constant from the times to resolve some "; + w << indent << "! numerical issues when t gets large (and to simplify the equations)"; + w << indent << "t = tin - tin(1)"; + w << indent << "t_out = tin_out - tin(1)"; + w << indent; + w << indent << "IF ( EqualRealNos( t(1), t(2) ) ) THEN"; + w << indent << " CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName)"; + w << indent << " RETURN"; + w << indent << "ELSE IF ( EqualRealNos( t(2), t(3) ) ) THEN"; + w << indent << " CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName)"; + w << indent << " RETURN"; + w << indent << "ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN"; + w << indent << " CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName)"; + w << indent << " RETURN"; + w << indent << "END IF"; + w << indent; + // w << indent << "ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3)))"; + w << indent << "! Calculate Lagrange polynomial coefficients"; + w << indent << "a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3)))"; + w << indent << "a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3)))"; + w << indent << "a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2)))"; + + // Recursively generate extrap interp code + for (const auto &field : ddt.fields) + gen_extint_order(w, mod, uy, 2, field, "", 0, indent); + + indent.erase(indent.size() - 3); + w << indent << "END SUBROUTINE"; + w << indent; +} + +void gen_ExtrapInterp(std::ostream &w, const Module &mod, std::string type_name_long, + std::string type_kind, const bool useModPrefix) +{ + // Get derived data type from module + std::string modPrefix = useModPrefix ? mod.nickname + "_" : ""; + auto iter = mod.data_types.find(modPrefix + type_name_long); + if (iter == mod.data_types.end()) + return; + const auto &dt = iter->second; + if (dt == nullptr) + return; + const auto &ddt = dt->derived; + + std::string mod_ddt = mod.nickname + "_" + ddt.name_short; + + std::string uy = tolower(ddt.name_short).compare("output") == 0 ? "y" : "u"; + std::string indent("\n"); + + w << indent << "subroutine " << mod_ddt << "_ExtrapInterp(" << uy << ", t, " << uy << "_out, t_out, ErrStat, ErrMsg)"; + indent += " "; + w << indent << "!"; + w << indent << "! This subroutine calculates a extrapolated (or interpolated) " << ddt.name_short << " " + << uy << "_out at time t_out, from previous/future time"; + w << indent << "! values of " << uy + << " (which has values associated with times in t). Order of the interpolation is given by the size of " << uy; + w << indent << "!"; + w << indent << "! expressions below based on either"; + w << indent << "!"; + w << indent << "! f(t) = a"; + w << indent << "! f(t) = a + b * t, or"; + w << indent << "! f(t) = a + b * t + c * t**2"; + w << indent << "!"; + w << indent << "! where a, b and c are determined as the solution to"; + w << indent << "! f(t1) = " << uy << "1, f(t2) = " << uy << "2, f(t3) = " << uy << "3 (as appropriate)"; + w << indent << "!"; + w << indent << "!" << std::string(130, '-'); + w << indent << ""; + w << indent << "type(" << ddt.type_fortran << "), intent(" << (ddt.contains_mesh == 1 ? "inout" : "in") + << ") :: " << uy << "(:) ! " << ddt.name_short << " at t1 > t2 > t3"; + w << indent << "real(" << type_kind << "), intent(in ) :: t(:) ! Times associated with the " + << ddt.name_short << "s"; + // Intent must be (INOUT) to prevent ALLOCATABLE array arguments in the DDT from + // being deallocated in this call. See Sec. 5.1.2.7 of Fortran 2003 standard + w << indent << "type(" << ddt.type_fortran << "), intent(inout) :: " << uy << "_out ! " << ddt.name_short << " at tin_out"; + w << indent << "real(" << type_kind << "), intent(in ) :: t_out ! time to be extrap/interp'd to"; + w << indent << "integer(IntKi), intent( out) :: ErrStat ! Error status of the operation"; + w << indent << "character(*), intent( out) :: ErrMsg ! Error message if ErrStat /= ErrID_None"; + w << indent << "! local variables"; + w << indent << "integer(IntKi) :: order ! order of polynomial fit (max 2)"; + w << indent << "integer(IntKi) :: ErrStat2 ! local errors"; + w << indent << "character(ErrMsgLen) :: ErrMsg2 ! local errors"; + w << indent << "character(*), PARAMETER :: RoutineName = '" << mod_ddt << "_ExtrapInterp'"; + w << indent; + w << indent << "! Initialize ErrStat"; + w << indent << "ErrStat = ErrID_None"; + w << indent << "ErrMsg = ''"; + w << indent << "if (size(t) /= size(" << uy << ")) then"; + w << indent << " call SetErrStat(ErrID_Fatal, 'size(t) must equal size(" << uy << ")', ErrStat, ErrMsg, RoutineName)"; + w << indent << " return"; + w << indent << "endif"; + w << indent << "order = size(" << uy << ") - 1"; + w << indent << "select case (order)"; + w << indent << "case (0)"; + w << indent << " call " << mod.nickname << "_Copy" << ddt.name_short << "(" << uy << "(1), " << uy << "_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2)"; + w << indent << " call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName)"; + w << indent << "case (1)"; + w << indent << " call " << mod_ddt << "_ExtrapInterp1(" << uy << "(1), " << uy << "(2), t, " << uy << "_out, t_out, ErrStat2, ErrMsg2)"; + w << indent << " call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName)"; + w << indent << "case (2)"; + w << indent << " call " << mod_ddt << "_ExtrapInterp2(" << uy << "(1), " << uy << "(2), " << uy << "(3), t, " << uy << "_out, t_out, ErrStat2, ErrMsg2)"; + w << indent << " call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName)"; + w << indent << "case default"; + w << indent << " call SetErrStat(ErrID_Fatal, 'size(" << uy << ") must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName)"; + w << indent << " return"; + w << indent << "end select"; + indent.erase(indent.size() - 3); + w << indent << "end subroutine"; + w << indent; + + // bjj: this is max for module, not for type_name_long + int max_rank = 0; // mod.module_ddt_list->max_ndims; + int max_nrecurs = 0; // MAXRECURSE; + int max_alloc_ndims = 0; + + // Recursively calculate extrap/interp order + for (const auto &field : ddt.fields) + calc_extint_order(w, mod, field, 0, max_rank, max_nrecurs, max_alloc_ndims); + + // Generate first order extrap/interp routine + gen_ExtrapInterp1(w, mod, ddt, type_kind, uy, modPrefix, max_rank, max_nrecurs, + max_alloc_ndims); + + // Generate second order extrap/interp routine + gen_ExtrapInterp2(w, mod, ddt, type_kind, uy, modPrefix, max_rank, max_nrecurs, + max_alloc_ndims); +} + +void gen_copy_c2f(std::ostream &w, const Module &mod, const DataType::Derived &ddt) +{ + std::string routine_name = mod.nickname + "_C2Fary_Copy" + ddt.name_short; + std::string indent("\n"); + + w << indent << "SUBROUTINE " << routine_name << "(" << ddt.name_short << "Data, ErrStat, ErrMsg, SkipPointers)"; + indent += " "; + w << indent << "TYPE(" << ddt.type_fortran << "), INTENT(INOUT) :: " << ddt.name_short << "Data"; + w << indent << "INTEGER(IntKi), INTENT( OUT) :: ErrStat"; + w << indent << "CHARACTER(*), INTENT( OUT) :: ErrMsg"; + w << indent << "LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers"; + w << indent << "! "; + w << indent << "LOGICAL :: SkipPointers_local"; + w << indent << "ErrStat = ErrID_None"; + w << indent << "ErrMsg = \"\""; + w << indent; + w << indent << "IF (PRESENT(SkipPointers)) THEN"; + w << indent << " SkipPointers_local = SkipPointers"; + w << indent << "ELSE"; + w << indent << " SkipPointers_local = .false."; + w << indent << "END IF"; + + // Loop through fields in derived data type + for (const auto &field : ddt.fields) + { + // If field is a derived type, print warning and continue + if (field.data_type->tag == DataType::Tag::Derived) + { + std::cerr << "Registry WARNING: derived data type " << field.name << " of type " + << field.data_type->derived.name << " is not passed through C interface"; + continue; + } + + std::string var_f = ddt.name_short + "Data%" + field.name; + std::string var_c = ddt.name_short + "Data%C_obj%" + field.name; + if (field.is_pointer) + { + w << indent; + w << indent << "! -- " << field.name << " " << ddt.name_short << " Data fields"; + w << indent << "IF ( .NOT. SkipPointers_local ) THEN"; + w << indent << " IF ( .NOT. C_ASSOCIATED( " << var_c << " ) ) THEN"; + w << indent << " NULLIFY( " << var_f << " )"; + w << indent << " ELSE"; + w << indent << " CALL C_F_POINTER(" << var_c << ", " << var_f << ", [" << var_c << "_Len])"; + w << indent << " END IF"; + w << indent << "END IF"; + } + else if (!field.is_allocatable) + { + switch (field.data_type->tag) + { + case DataType::Tag::Real: + case DataType::Tag::Integer: + case DataType::Tag::Logical: + w << indent << var_f << " = " << var_c; + break; + case DataType::Tag::Character: + if (field.rank == 0) + w << indent << var_f << " = TRANSFER(" << var_c << ", " << var_f << " )"; + break; + case DataType::Tag::Derived: + break; + } + } + } + + indent.erase(indent.size() - 3); + w << indent << "END SUBROUTINE"; + w << indent; +} + +void gen_copy_f2c(std::ostream &w, const Module &mod, const DataType::Derived &ddt) +{ + std::string routine_name = mod.nickname + "_F2C_Copy" + ddt.name_short; + std::string indent("\n"); + + w << indent << "SUBROUTINE " << routine_name << "( " << ddt.name_short << "Data, ErrStat, ErrMsg, SkipPointers )"; + indent += " "; + w << indent << "TYPE(" << ddt.type_fortran << "), INTENT(INOUT) :: " << ddt.name_short << "Data"; + w << indent << "INTEGER(IntKi), INTENT( OUT) :: ErrStat"; + w << indent << "CHARACTER(*), INTENT( OUT) :: ErrMsg"; + w << indent << "LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers"; + w << indent << "! "; + w << indent << "LOGICAL :: SkipPointers_local"; + w << indent << "ErrStat = ErrID_None"; + w << indent << "ErrMsg = ''"; + w << indent; + w << indent << "IF (PRESENT(SkipPointers)) THEN"; + w << indent << " SkipPointers_local = SkipPointers"; + w << indent << "ELSE"; + w << indent << " SkipPointers_local = .false."; + w << indent << "END IF"; + + for (const auto &field : ddt.fields) + { + // If field is a derived type, print warning and continue + if (field.data_type->tag == DataType::Tag::Derived) + { + std::cerr << "Registry WARNING: derived data type " << field.name << " of type " + << field.data_type->derived.name << " is not passed through F-C interface\n"; + continue; + } + + std::string var_f = ddt.name_short + "Data%" + field.name; + std::string var_c = ddt.name_short + "Data%C_obj%" + field.name; + + if (field.is_pointer) + { + std::string dims; + for (int d = 1; d <= field.rank; d++) + dims += std::string(d > 1 ? "," : "") + "lbound(" + var_f + "," + std::to_string(d) + ")"; + w << indent; + w << indent << "! -- " << field.name << " " << ddt.name_short << " Data fields"; + w << indent << "IF (.NOT. SkipPointers_local ) THEN"; + w << indent << " IF (.NOT. ASSOCIATED(" << var_f << ")) THEN "; + w << indent << " " << var_c << "_Len = 0"; + w << indent << " " << var_c << " = C_NULL_PTR"; + w << indent << " ELSE"; + w << indent << " " << var_c << "_Len = SIZE(" << var_f << ")"; + w << indent << " IF (" << var_c << "_Len > 0) &"; + w << indent << " " << var_c << " = C_LOC(" << var_f << "(" << dims << "))"; + w << indent << " END IF"; + w << indent << "END IF"; + } + else if (!field.is_allocatable) + { + switch (field.data_type->tag) + { + case DataType::Tag::Real: + case DataType::Tag::Integer: + case DataType::Tag::Logical: + w << indent << var_c << " = " << var_f; + break; + case DataType::Tag::Character: + if (field.rank == 0) + w << indent << var_c << " = TRANSFER(" << var_f << ", " << var_c << ")"; + break; + case DataType::Tag::Derived: + break; + } + } + } + + indent.erase(indent.size() - 3); + w << indent << "END SUBROUTINE"; + w << indent; +} diff --git a/modules/openfast-registry/src/registry_parse.cpp b/modules/openfast-registry/src/registry_parse.cpp new file mode 100644 index 0000000000..e8ad7cdaf9 --- /dev/null +++ b/modules/openfast-registry/src/registry_parse.cpp @@ -0,0 +1,293 @@ +#include +#include + +#include "registry.hpp" + +const int MAX_FIELDS = 10; + +void Registry::parse(const std::string &file_name, const int recurse_level) +{ + std::ifstream inp_file; + std::vector fields_prev; + + // If this is the root file, open given file name + if (recurse_level == 0) + { + std::cerr << "input file: " << file_name << std::endl; + inp_file.open(file_name); + if (!inp_file) + { + std::cerr << "Registry program cannot open " << file_name << " for reading. "; + std::cerr << "Ending." << std::endl; + exit(EXIT_FAILURE); + } + } + // Otherwise, find and open include file + else + { + // If this include file has been parsed, return + if (this->include_files.find(file_name) != this->include_files.end()) + return; + + // Loop through directories and try to open file, break on success + for (auto &dir : this->include_dirs) + { + inp_file.open(dir + "/" + file_name); + if (inp_file) + break; + } + + // If file not opened successfully, exit + if (!inp_file) + { + std::cerr << "Registry error: cannot open '" << file_name << "'." << std::endl; + exit(EXIT_FAILURE); + } + + // Display message about opening file + std::cerr << "opening " << file_name << std::endl; + + // Add file to list of includes + this->include_files.insert(file_name); + } + + // Loop through lines in file and parse + std::string line; + for (size_t line_num = 1; std::getline(inp_file, line); ++line_num) + { + // Parse line into record + if (this->parse_line(line, fields_prev, recurse_level) != 0) + { + std::cerr << "Error reading " << file_name << ":" << line_num << "\n"; + exit(EXIT_FAILURE); + } + } + + // If this file is directly included by the root file, save use module + if (recurse_level == 1) + { + auto slash_index = fields_prev[1].find("/"); + bool has_slash = slash_index != std::string::npos; + auto module_name = has_slash ? fields_prev[1].substr(0, slash_index) : fields_prev[1]; + this->use_modules.push_back(module_name); + } +} + +int Registry::parse_line(const std::string &line, std::vector &fields_prev, + const int recurse_level) +{ + std::istringstream iss(line); + std::string s; + std::vector fields; + + // Read fields from line while respecting quotes + while (iss >> std::quoted(s)) + { + // If # found in unquoted field, break iteration + if (s.find("#") != std::string::npos && s.find(" ") == std::string::npos) + break; + + fields.push_back(s); + } + + // Skip empty line + if (fields.size() == 0 || fields[0][0] == '#') + return EXIT_SUCCESS; + + //-------------------------------------------------------------------------- + // Include Line + //-------------------------------------------------------------------------- + + if (fields.size() == 2 && + (tolower(fields[0]).compare("include") == 0 || tolower(fields[0]).compare("usefrom") == 0)) + { + auto file_name = fields[1]; + this->parse(file_name, recurse_level + 1); + return EXIT_SUCCESS; + } + + //-------------------------------------------------------------------------- + // Populate Fields + //-------------------------------------------------------------------------- + + // Resize and fill remaining fields + fields.resize(MAX_FIELDS, "-"); + + // Propagate field values from previous fields if requested + for (int i = 0; i < MAX_FIELDS; i++) + if (fields[i].compare("^") == 0) + fields[i] = fields_prev[i]; + + // Update previous fields to current values + fields_prev = fields; + + //-------------------------------------------------------------------------- + // Get Module + //-------------------------------------------------------------------------- + + // Shared pointer to module + std::shared_ptr mod; + + // Is this the root module + auto is_root = recurse_level == 0; + + // Parse module name and nickname from field + auto slash_index = fields[1].find("/"); + bool has_slash = slash_index != std::string::npos; + auto module_name = has_slash ? fields[1].substr(0, slash_index) : fields[1]; + auto module_nickname = has_slash ? fields[1].substr(slash_index + 1) : fields[1]; + + // Find module in map or create and add it to map + auto it = this->modules.find(module_name); + if (it == this->modules.end()) + { + mod = std::make_shared(module_name, module_nickname, is_root); + this->modules[module_name] = mod; + } + else + { + mod = it->second; + } + + //-------------------------------------------------------------------------- + // Parameter Line + //-------------------------------------------------------------------------- + + if (tolower(fields[0]).compare("param") == 0) + { + auto name = fields[4]; + auto type = fields[3]; + auto value = fields[6]; + auto desc = fields[8]; + auto units = fields[9]; + + // Find parameter type in registry, display message if not found + auto param_type = this->find_data_type(type); + if (param_type == nullptr) + { + std::cerr << "Registry error: type " << type << " used before defined for " << name + << std::endl; + return EXIT_FAILURE; + } + + // Add parameter to module + mod->params.push_back(Parameter(name, param_type, value, desc, units)); + return EXIT_SUCCESS; + } + + //-------------------------------------------------------------------------- + // Derived Type Line + //-------------------------------------------------------------------------- + + if ((tolower(fields[0]).compare("typedef") == 0) || + (tolower(fields[0]).compare("usefrom") == 0)) + { + auto ddt_name_base = fields[2]; + auto field_type_name = fields[3]; + auto name = fields[4]; + auto dims = fields[5]; + auto init_value = fields[6]; + auto ctrl = fields[7]; + auto desc = fields[8]; + auto units = fields[9]; + + // Get derived data type name + auto ddt_name = ddt_name_base; + auto ddt_name_short = ddt_name_base; + + // Remove module prefix from name + std::string prefix = tolower(mod->nickname) + "_"; + if (tolower(ddt_name_short).compare(0, prefix.size(), prefix) == 0) + { + ddt_name_short = ddt_name_short.substr(prefix.size()); + } + + // If interface name was found for derived data type, prepend module nickname + auto it = this->interface_map.find(ddt_name_short); + auto is_interface_type = it != this->interface_map.end(); + if (is_interface_type) + { + ddt_name = mod->nickname + "_" + ddt_name_short; + } + + // Get data type from module + auto ddt_dt = this->find_data_type(ddt_name, mod); + + // If struct type not found and module is not root, get from registry + if (ddt_dt == nullptr && !mod->is_root) + ddt_dt = this->find_data_type(ddt_name); + + // If derived data type not found, create and add to module or registry + if (ddt_dt == nullptr) + { + // Get short name from interface if this is an interface type + if (is_interface_type) + ddt_name_short = it->second->name_short; + + // Create derived data type + ddt_dt = std::make_shared(mod, ddt_name_base, ddt_name_short, ddt_name); + + // Add interface to type if found + if (is_interface_type) + ddt_dt->derived.interface = it->second; + + // Add type module if this is root; otherwise, add to registry + if (is_root) + { + mod->data_types[ddt_name] = ddt_dt; + mod->ddt_names.push_back(ddt_name); + } + else + { + this->data_types[ddt_name] = ddt_dt; + } + } + + // Get field data type from module or registry + auto field_dt = this->find_data_type(field_type_name, mod); + if (field_dt == nullptr) + { + field_dt = this->find_data_type(field_type_name); + } + if (field_dt == nullptr) + { + std::cerr << "Error: type " << field_type_name << " used before defined for " << name + << std::endl; + return EXIT_FAILURE; + } + + // Create field + Field field(name, field_dt, dims, ctrl, init_value, desc, units); + + // The field is a target pointer if the following is true: + // - C code will be generated + // - The field is allocatable + // - The field is not a derived type + // - The field name doesn't start with "writeoutput" + if (this->gen_c_code && field.is_allocatable && + (field.data_type->tag != DataType::Tag::Derived) && + (tolower(field.name.substr(0, 11)).compare("writeoutput") != 0)) + { + field.is_pointer = true; + field.is_target = true; + } + + // If field is a mesh derived type (MeshType or MeshMapType) + // or a derived type that contains a mesh, + // set flag in derived data type + if ((field.data_type->tag == DataType::Tag::Derived) && + field.data_type->derived.contains_mesh) + ddt_dt->derived.contains_mesh = true; + + // Accumulate max rank of fields in derived data type + ddt_dt->derived.max_rank = std::max(ddt_dt->derived.max_rank, field.rank); + + // Add field to derived data type + ddt_dt->derived.fields.push_back(field); + return EXIT_SUCCESS; + } + + // Line is invalid + std::cerr << "Error: invalid line: '" << line << "'\n"; + return EXIT_FAILURE; +} diff --git a/modules/openfast-registry/src/sym.c b/modules/openfast-registry/src/sym.c deleted file mode 100644 index 689f5800ba..0000000000 --- a/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/modules/openfast-registry/src/sym.h b/modules/openfast-registry/src/sym.h deleted file mode 100644 index 71de456860..0000000000 --- a/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/modules/openfast-registry/src/symtab_gen.c b/modules/openfast-registry/src/symtab_gen.c deleted file mode 100644 index 944ce461b0..0000000000 --- a/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/modules/openfast-registry/src/templates.hpp b/modules/openfast-registry/src/templates.hpp new file mode 100644 index 0000000000..628d89bfad --- /dev/null +++ b/modules/openfast-registry/src/templates.hpp @@ -0,0 +1,971 @@ +#ifndef TEMPLATES_HPP +#define TEMPLATES_HPP + +#include + +const std::string FAST_preamble( + "!STARTOFREGISTRYGENERATEDFILE 'ModuleName_Types.f90'\n" + "!\n" + "! WARNING This file is generated automatically by the FAST registry.\n" + "! Do not edit. Your changes to this file will be lost.\n" + "!\n" + "! FAST Registry\n" + "!*********************************************************************************************************************************\n" + "! ModuleName_Types\n" + "!.................................................................................................................................\n" + "! This file is part of ModuleName.\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 ModuleName. 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 ModuleName_Types\n" + "!---------------------------------------------------------------------------------------------------------------------------------\n"); + +const std::string registry_template( + "###################################################################################################################################\n" + "# Registry for ModuleName in the FAST Modularization Framework\n" + "# This Registry file is used to create MODULE ModuleName_Types, which contains all of the user-defined types needed in ModuleName.\n" + "# It also contains copy, destroy, pack, and unpack routines associated with each defined data types.\n" + "#\n" + "# Entries are of the form\n" + "# keyword \n" + "#\n" + "# Use ^ as a shortcut for the value from the previous line.\n" + "# See NWTC Programmer's Handbook at https://nwtc.nrel.gov/FAST-Developers for further information on the format/contents of this file.\n" + "###################################################################################################################################\n" + "\n" + "# ...... Include files (definitions from NWTC Library) ............................................................................\n" + "include Registry_NWTC_Library.txt\n" + "\n" + "\n" + "# ..... Initialization data .......................................................................................................\n" + "# Define inputs that the initialization routine may need here:\n" + "# e.g., the name of the input file, the file root name, etc.\n" + "typedef ModuleName/ModName InitInputType CHARACTER(1024) InputFile - - - \"Name of the input file; remove if there is no file\" -\n" + "typedef ^ ^ LOGICAL Linearize - .FALSE. - \"Flag that tells this module if the glue code wants to linearize.\" -\n" + "\n" + "# Define outputs from the initialization routine here:\n" + "typedef ^ InitOutputType CHARACTER(ChanLen) WriteOutputHdr {:} - - \"Names of the output-to-file channels\" -\n" + "typedef ^ InitOutputType CHARACTER(ChanLen) WriteOutputUnt {:} - - \"Units of the output-to-file channels\" -\n" + "# if this module has implemented linearization, return the names of the rows/columns of the Jacobian matrices:\n" + "#typedef ^ InitOutputType CHARACTER(LinChanLen) LinNames_y {:} - - \"Names of the outputs used in linearization\" - \n" + "#typedef ^ InitOutputType CHARACTER(LinChanLen) LinNames_x {:} - - \"Names of the continuous states used in linearization\" -\n" + "#typedef ^ InitOutputType CHARACTER(LinChanLen) LinNames_xd {:} - - \"Names of the discrete states used in linearization\" -\n" + "#typedef ^ InitOutputType CHARACTER(LinChanLen) LinNames_z {:} - - \"Names of the constraint states used in linearization\" -\n" + "#typedef ^ InitOutputType CHARACTER(LinChanLen) LinNames_u {:} - - \"Names of the inputs used in linearization\" -\n" + "#typedef ^ InitOutputType LOGICAL RotFrame_y {:} - - \"Flag that tells FAST/MBC3 if the outputs used in linearization are in the rotating frame\" -\n" + "#typedef ^ InitOutputType LOGICAL RotFrame_x {:} - - \"Flag that tells FAST/MBC3 if the continuous states used in linearization are in the rotating frame\" -\n" + "#typedef ^ InitOutputType LOGICAL RotFrame_xd {:} - - \"Flag that tells FAST if the discrete states used in linearization are in the rotating frame\" -\n" + "#typedef ^ InitOutputType LOGICAL RotFrame_z {:} - - \"Flag that tells FAST if the constraint states used in linearization are in the rotating frame\" -\n" + "#typedef ^ InitOutputType LOGICAL RotFrame_u {:} - - \"Flag that tells FAST/MBC3 if the inputs used in linearization are in the rotating frame\" -\n" + "#typedef ^ InitOutputType LOGICAL IsLoad_u {:} - - \"Flag that tells FAST if the inputs used in linearization are loads (for preconditioning matrices)\" -\n" + "#typedef ^ InitOutputType IntKi DerivOrder_x {:} - - \"Integer that tells FAST/MBC3 the order derivative for the continuous states used in linearization\" -\n" + "\n" + "\n" + "# ..... States ....................................................................................................................\n" + "# Define continuous (differentiable) states here:\n" + "typedef ^ ContinuousStateType ReKi DummyContState - - - \"Remove this variable if you have continuous states\" -\n" + "\n" + "# Define discrete (nondifferentiable) states here:\n" + "typedef ^ DiscreteStateType ReKi DummyDiscState - - - \"Remove this variable if you have discrete states\" -\n" + "\n" + "# Define constraint states here:\n" + "typedef ^ ConstraintStateType ReKi DummyConstrState - - - \"Remove this variable if you have constraint states\" -\n" + "\n" + "# Define any other states, including integer or logical states here:\n" + "typedef ^ OtherStateType IntKi DummyOtherState - - - \"Remove this variable if you have other states\" -\n" + "\n" + "\n" + "# ..... Misc/Optimization variables.................................................................................................\n" + "# Define any data that are used only for efficiency purposes (these variables are not associated with time):\n" + "# e.g. indices for searching in an array, large arrays that are local variables in any routine called multiple times, etc.\n" + "typedef ^ MiscVarType ReKi DummyMiscVar - - - \"Remove this variable if you have misc/optimization variables\" -\n" + "\n" + "\n" + "# ..... Parameters ................................................................................................................\n" + "# Define parameters here:\n" + "# Time step for integration of continuous states (if a fixed-step integrator is used) and update of discrete states:\n" + "typedef ^ ParameterType DbKi DT - - - \"Time step for cont. state integration & disc. state update\" seconds\n" + "\n" + "\n" + "# ..... Inputs ....................................................................................................................\n" + "# Define inputs that are contained on the mesh here:\n" + "#typedef ^ InputType MeshType MeshedInput - - - \"Meshed data\" -\n" + "# Define inputs that are not on this mesh here:\n" + "typedef ^ InputType ReKi DummyInput - - - \"Remove this variable if you have input data\" -\n" + "\n" + "\n" + "# ..... Outputs ...................................................................................................................\n" + "# Define outputs that are contained on the mesh here:\n" + "#typedef ^ OutputType MeshType MeshedOutput - - - \"Meshed data\" -\n" + "# Define outputs that are not on this mesh here:\n" + "typedef ^ OutputType ReKi DummyOutput - - - \"Remove this variable if you have output data\" -\n" + "typedef ^ OutputType ReKi WriteOutput {:} - - \"Example of data to be written to an output file\" \"s,-\"\n"); + +const std::string module_template( + "!**********************************************************************************************************************************\n" + "!> ## ModuleName\n" + "!! The ModuleName and ModuleName_Types modules make up a template for creating user-defined calculations in the FAST Modularization\n" + "!! Framework. ModuleName_Types will be auto-generated by the FAST registry program, based on the variables specified in the\n" + "!! ModuleName_Registry.txt file.\n" + "!!\n" + "! ..................................................................................................................................\n" + "!! ## LICENSING\n" + "!! Copyright (C) 2012-2013, 2015-2016 National Renewable Energy Laboratory\n" + "!!\n" + "!! This file is part of ModuleName.\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" + "MODULE ModuleName\n" + "\n" + " USE ModuleName_Types\n" + " USE NWTC_Library\n" + "\n" + " IMPLICIT NONE\n" + "\n" + " PRIVATE\n" + "\n" + " TYPE(ProgDesc), PARAMETER :: ModName_Ver = ProgDesc( 'ModuleName', '', '' ) !< module date/version information\n" + "\n" + "\n" + " ! ..... Public Subroutines ...................................................................................................\n" + "\n" + " PUBLIC :: ModName_Init ! Initialization routine\n" + " PUBLIC :: ModName_End ! Ending routine (includes clean up)\n" + "\n" + " PUBLIC :: ModName_UpdateStates ! Loose coupling routine for solving for constraint states, integrating\n" + " ! continuous states, and updating discrete states\n" + " PUBLIC :: ModName_CalcOutput ! Routine for computing outputs\n" + "\n" + " PUBLIC :: ModName_CalcConstrStateResidual ! Tight coupling routine for returning the constraint state residual\n" + " PUBLIC :: ModName_CalcContStateDeriv ! Tight coupling routine for computing derivatives of continuous states\n" + " PUBLIC :: ModName_UpdateDiscState ! Tight coupling routine for updating discrete states\n" + "\n" + " PUBLIC :: ModName_JacobianPInput ! Routine to compute the Jacobians of the output(Y), continuous - (X), discrete -\n" + " ! (Xd), and constraint - state(Z) functions all with respect to the inputs(u)\n" + " PUBLIC :: ModName_JacobianPContState ! Routine to compute the Jacobians of the output(Y), continuous - (X), discrete -\n" + " ! (Xd), and constraint - state(Z) functions all with respect to the continuous\n" + " ! states(x)\n" + " PUBLIC :: ModName_JacobianPDiscState ! Routine to compute the Jacobians of the output(Y), continuous - (X), discrete -\n" + " ! (Xd), and constraint - state(Z) functions all with respect to the discrete\n" + " ! states(xd)\n" + " PUBLIC :: ModName_JacobianPConstrState ! Routine to compute the Jacobians of the output(Y), continuous - (X), discrete -\n" + " ! (Xd), and constraint - state(Z) functions all with respect to the constraint\n" + " ! states(z)\n" + " PUBLIC :: ModName_GetOP ! Routine to get the operating-point values for linearization (from data structures to arrays)\n" + "\n" + "CONTAINS\n" + "!----------------------------------------------------------------------------------------------------------------------------------\n" + "!> This routine is called at the start of the simulation to perform initialization steps.\n" + "!! The parameters are set here and not changed during the simulation.\n" + "!! The initial states and initial guess for the input are defined. \n" + "SUBROUTINE ModName_Init( InitInp, u, p, x, xd, z, OtherState, y, misc, Interval, InitOut, ErrStat, ErrMsg )\n" + "!..................................................................................................................................\n" + "\n" + " TYPE(ModName_InitInputType), INTENT(IN ) :: InitInp !< Input data for initialization routine\n" + " TYPE(ModName_InputType), INTENT( OUT) :: u !< An initial guess for the input; input mesh must be defined\n" + " TYPE(ModName_ParameterType), INTENT( OUT) :: p !< Parameters\n" + " TYPE(ModName_ContinuousStateType), INTENT( OUT) :: x !< Initial continuous states\n" + " TYPE(ModName_DiscreteStateType), INTENT( OUT) :: xd !< Initial discrete states\n" + " TYPE(ModName_ConstraintStateType), INTENT( OUT) :: z !< Initial guess of the constraint states\n" + " TYPE(ModName_OtherStateType), INTENT( OUT) :: OtherState !< Initial other states (logical, etc)\n" + " TYPE(ModName_OutputType), INTENT( OUT) :: y !< Initial system outputs (outputs are not calculated;\n" + " !! only the output mesh is initialized)\n" + " TYPE(ModName_MiscVarType), INTENT( OUT) :: misc !< Misc variables for optimization (not copied in glue code)\n" + " REAL(DbKi), INTENT(INOUT) :: Interval !< Coupling interval in seconds: the rate that\n" + " !! (1) ModName_UpdateStates() is called in loose coupling &\n" + " !! (2) ModName_UpdateDiscState() is called in tight coupling.\n" + " !! Input is the suggested time from the glue code;\n" + " !! Output is the actual coupling interval that will be used\n" + " !! by the glue code.\n" + " TYPE(ModName_InitOutputType), INTENT( OUT) :: InitOut !< Output for initialization routine\n" + " INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation\n" + " CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None\n" + "\n" + " ! local variables\n" + "\n" + " INTEGER(IntKi) :: NumOuts ! number of outputs; would probably be in the parameter type\n" + " INTEGER(IntKi) :: ErrStat2 ! local error status\n" + " CHARACTER(ErrMsgLen) :: ErrMsg2 ! local error message\n" + " CHARACTER(*), PARAMETER :: RoutineName = 'ModName_Init'\n" + "\n" + " !! Initialize variables\n" + "\n" + " ErrStat = ErrID_None\n" + " ErrMsg = ''\n" + " NumOuts = 2\n" + "\n" + "\n" + " ! Initialize the NWTC Subroutine Library\n" + "\n" + " call NWTC_Init( )\n" + "\n" + " ! Display the module information\n" + "\n" + " call DispNVD( ModName_Ver )\n" + "\n" + "\n" + " ! Define parameters here:\n" + "\n" + " p%DT = Interval\n" + "\n" + "\n" + " ! Define initial system states here:\n" + "\n" + " x%DummyContState = 0.0_ReKi\n" + " xd%DummyDiscState = 0.0_ReKi\n" + " z%DummyConstrState = 0.0_ReKi\n" + " OtherState%DummyOtherState = 0.0_ReKi\n" + "\n" + " ! define optimization variables here:\n" + " misc%DummyMiscVar = 0.0_ReKi\n" + "\n" + " ! Define initial guess for the system inputs here:\n" + "\n" + " u%DummyInput = 0.0_ReKi\n" + "\n" + "\n" + " ! Define system output initializations (set up mesh) here:\n" + " call AllocAry( y%WriteOutput, NumOuts, 'WriteOutput', ErrStat2, ErrMsg2 )\n" + " call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! set return error status based on local (concatenate errors)\n" + " if (ErrStat >= AbortErrLev) return ! if there are local variables that need to be deallocated, do so before early return\n" + " \n" + " y%DummyOutput = 0\n" + " y%WriteOutput = 0\n" + "\n" + "\n" + " ! Define initialization-routine output here:\n" + " call AllocAry(InitOut%WriteOutputHdr,NumOuts,'WriteOutputHdr',ErrStat2,ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName)\n" + " call AllocAry(InitOut%WriteOutputUnt,NumOuts,'WriteOutputUnt',ErrStat2,ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName)\n" + " if (ErrStat >= AbortErrLev) return ! if there are local variables that need to be deallocated, do so before early return\n" + "\n" + " InitOut%WriteOutputHdr = (/ 'Time ', 'Column2' /)\n" + " InitOut%WriteOutputUnt = (/ '(s)', '(-)' /)\n" + "\n" + "\n" + " ! If you want to choose your own rate instead of using what the glue code suggests, tell the glue code the rate at which\n" + " ! this module must be called here:\n" + "\n" + " !Interval = p%DT\n" + "\n" + "\n" + " if (InitInp%Linearize) then\n" + "\n" + " ! If this module does not implement the four Jacobian routines at the end of this template, or the module cannot\n" + " ! linearize with the features that are enabled, stop the simulation if InitInp%Linearize is true.\n" + "\n" + " CALL SetErrStat( ErrID_Fatal, 'ModuleName cannot perform linearization analysis.', ErrStat, ErrMsg, RoutineName)\n" + "\n" + " ! Otherwise, if the module does allow linearization, return the appropriate Jacobian row/column names and rotating-frame flags here:\n" + " ! Allocate and set these variables: InitOut%LinNames_y, InitOut%LinNames_x, InitOut%LinNames_xd, InitOut%LinNames_z, InitOut%LinNames_u\n" + " ! Allocate and set these variables: InitOut%RotFrame_y, InitOut%RotFrame_x, InitOut%RotFrame_xd, InitOut%RotFrame_z, InitOut%RotFrame_u\n" + " ! Allocate and set these variables: InitOut%IsLoad_u, InitOut%DerivOrder_x\n" + "\n" + " end if\n" + "\n" + "\n" + "END SUBROUTINE ModName_Init\n" + "!----------------------------------------------------------------------------------------------------------------------------------\n" + "!> This routine is called at the end of the simulation.\n" + "SUBROUTINE ModName_End( u, p, x, xd, z, OtherState, y, misc, ErrStat, ErrMsg )\n" + "!..................................................................................................................................\n" + "\n" + " TYPE(ModName_InputType), INTENT(INOUT) :: u !< System inputs\n" + " TYPE(ModName_ParameterType), INTENT(INOUT) :: p !< Parameters\n" + " TYPE(ModName_ContinuousStateType), INTENT(INOUT) :: x !< Continuous states\n" + " TYPE(ModName_DiscreteStateType), INTENT(INOUT) :: xd !< Discrete states\n" + " TYPE(ModName_ConstraintStateType), INTENT(INOUT) :: z !< Constraint states\n" + " TYPE(ModName_OtherStateType), INTENT(INOUT) :: OtherState !< Other states\n" + " TYPE(ModName_OutputType), INTENT(INOUT) :: y !< System outputs\n" + " TYPE(ModName_MiscVarType), INTENT(INOUT) :: misc !< Misc variables for optimization (not copied in glue code)\n" + " INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation\n" + " CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None\n" + "\n" + " ! local variables\n" + " INTEGER(IntKi) :: ErrStat2 ! local error status\n" + " CHARACTER(ErrMsgLen) :: ErrMsg2 ! local error message\n" + " CHARACTER(*), PARAMETER :: RoutineName = 'ModName_End'\n" + "\n" + " ! Initialize ErrStat\n" + "\n" + " ErrStat = ErrID_None\n" + " ErrMsg = ''\n" + "\n" + "\n" + " !! Place any last minute operations or calculations here:\n" + "\n" + "\n" + " !! Close files here (but because of checkpoint-restart capability, it is not recommended to have files open during the simulation):\n" + "\n" + "\n" + " !! Destroy the input data:\n" + "\n" + " call ModName_DestroyInput( u, ErrStat2, ErrMsg2 )\n" + " call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName)\n" + "\n" + "\n" + " !! Destroy the parameter data:\n" + "\n" + " call ModName_DestroyParam( p, ErrStat2, ErrMsg2 )\n" + " call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName)\n" + "\n" + " !! Destroy the state data:\n" + "\n" + " call ModName_DestroyContState( x, ErrStat2,ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName)\n" + " call ModName_DestroyDiscState( xd, ErrStat2,ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName)\n" + " call ModName_DestroyConstrState( z, ErrStat2,ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName)\n" + " call ModName_DestroyOtherState( OtherState, ErrStat2,ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName)\n" + "\n" + "\n" + " !! Destroy the output data:\n" + "\n" + " call ModName_DestroyOutput( y, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName)\n" + "\n" + " \n" + " !! Destroy the misc data:\n" + "\n" + " call ModName_DestroyMisc( misc, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName)\n" + "\n" + "\n" + "END SUBROUTINE ModName_End\n" + "!----------------------------------------------------------------------------------------------------------------------------------\n" + "!> This is a loose coupling routine for solving constraint states, integrating continuous states, and updating discrete and other \n" + "!! states. Continuous, constraint, discrete, and other states are updated to values at t + Interval.\n" + "SUBROUTINE ModName_UpdateStates( t, n, Inputs, InputTimes, p, x, xd, z, OtherState, misc, ErrStat, ErrMsg )\n" + "!..................................................................................................................................\n" + "\n" + " REAL(DbKi), INTENT(IN ) :: t !< Current simulation time in seconds\n" + " INTEGER(IntKi), INTENT(IN ) :: n !< Current step of the simulation: t = n*Interval\n" + " TYPE(ModName_InputType), INTENT(INOUT) :: Inputs(:) !< Inputs at InputTimes (output from this routine only \n" + " !! because of record keeping in routines that copy meshes)\n" + " REAL(DbKi), INTENT(IN ) :: InputTimes(:) !< Times in seconds associated with Inputs\n" + " TYPE(ModName_ParameterType), INTENT(IN ) :: p !< Parameters\n" + " TYPE(ModName_ContinuousStateType), INTENT(INOUT) :: x !< Input: Continuous states at t;\n" + " !! Output: Continuous states at t + Interval\n" + " TYPE(ModName_DiscreteStateType), INTENT(INOUT) :: xd !< Input: Discrete states at t;\n" + " !! Output: Discrete states at t + Interval\n" + " TYPE(ModName_ConstraintStateType), INTENT(INOUT) :: z !< Input: Constraint states at t;\n" + " !! Output: Constraint states at t + Interval\n" + " TYPE(ModName_OtherStateType), INTENT(INOUT) :: OtherState !< Other states: Other states at t;\n" + " !! Output: Other states at t + Interval\n" + " TYPE(ModName_MiscVarType), INTENT(INOUT) :: misc !< Misc variables for optimization (not copied in glue code)\n" + " INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation\n" + " CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None\n" + "\n" + " ! Local variables\n" + "\n" + " TYPE(ModName_ContinuousStateType) :: dxdt ! Continuous state derivatives at t\n" + " TYPE(ModName_DiscreteStateType) :: xd_t ! Discrete states at t (copy)\n" + " TYPE(ModName_ConstraintStateType) :: z_Residual ! Residual of the constraint state functions (Z)\n" + " TYPE(ModName_InputType) :: u ! Instantaneous inputs\n" + " \n" + " INTEGER(IntKi) :: ErrStat2 ! local error status\n" + " CHARACTER(ErrMsgLen) :: ErrMsg2 ! local error message\n" + " CHARACTER(*), PARAMETER :: RoutineName = 'ModName_UpdateStates'\n" + "\n" + "\n" + " ! Initialize variables\n" + "\n" + " ErrStat = ErrID_None ! no error has occurred\n" + " ErrMsg = ''\n" + "\n" + "\n" + " ! This subroutine contains an example of how the states could be updated. Developers will\n" + " ! want to adjust the logic as necessary for their own situations.\n" + "\n" + "\n" + "\n" + " ! Get the inputs at time t, based on the array of values sent by the glue code:\n" + "\n" + " ! before calling ExtrapInterp routine, memory in u must be allocated; we can do that with a copy:\n" + " call ModName_CopyInput( Inputs(1), u, MESH_NEWCOPY, ErrStat2, ErrMsg2 )\n" + " call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName)\n" + " if ( ErrStat >= AbortErrLev ) then\n" + " call cleanup() ! to avoid memory leaks, we have to destroy the local variables that may have allocatable arrays or meshes\n" + " return\n" + " end if\n" + "\n" + " call ModName_Input_ExtrapInterp( Inputs, InputTimes, u, t, ErrStat2, ErrMsg2 ) \n" + " call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName)\n" + " if ( ErrStat >= AbortErrLev ) then\n" + " call cleanup()\n" + " return\n" + " end if\n" + "\n" + "\n" + "\n" + " ! Get first time derivatives of continuous states (dxdt):\n" + "\n" + " call ModName_CalcContStateDeriv( t, u, p, x, xd, z, OtherState, misc, dxdt, ErrStat2, ErrMsg2 )\n" + " call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName)\n" + " if ( ErrStat >= AbortErrLev ) then\n" + " call cleanup()\n" + " return\n" + " end if\n" + "\n" + "\n" + " ! Update discrete states:\n" + " ! Note that xd [discrete state] is changed in ModName_UpdateDiscState() so xd will now contain values at t+Interval\n" + " ! We'll first make a copy that contains xd at time t, which will be used in computing the constraint states\n" + " call ModName_CopyDiscState( xd, xd_t, MESH_NEWCOPY, ErrStat2, ErrMsg2 )\n" + " call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName)\n" + " if ( ErrStat >= AbortErrLev ) then\n" + " call cleanup()\n" + " return\n" + " end if\n" + "\n" + " call ModName_UpdateDiscState( t, n, u, p, x, xd, z, OtherState, misc, ErrStat2, ErrMsg2 )\n" + " call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName)\n" + " if ( ErrStat >= AbortErrLev ) then\n" + " call cleanup()\n" + " return\n" + " end if\n" + "\n" + "\n" + " ! Solve for the constraint states (z) here:\n" + "\n" + " ! Iterate until the value is within a given tolerance.\n" + "\n" + " ! DO \n" + "\n" + " call ModName_CalcConstrStateResidual( t, u, p, x, xd_t, z, OtherState, misc, Z_Residual, ErrStat2, ErrMsg2 )\n" + " call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName)\n" + " if ( ErrStat >= AbortErrLev ) then\n" + " call cleanup()\n" + " return\n" + " end if\n" + "\n" + " ! z =\n" + "\n" + " ! END DO\n" + "\n" + "\n" + "\n" + " ! Integrate (update) continuous states (x) here:\n" + "\n" + " !x = function of dxdt and x\n" + "\n" + "\n" + " ! Destroy local variables before returning\n" + " call cleanup()\n" + "\n" + "\n" + "CONTAINS\n" + " SUBROUTINE cleanup()\n" + " ! note that this routine inherits all of the data in ModName_UpdateStates\n" + "\n" + "\n" + " CALL ModName_DestroyInput( u, ErrStat2, ErrMsg2)\n" + " CALL ModName_DestroyConstrState( Z_Residual, ErrStat2, ErrMsg2)\n" + " CALL ModName_DestroyContState( dxdt, ErrStat2, ErrMsg2)\n" + " CALL ModName_DestroyDiscState( xd_t, ErrStat2, ErrMsg2) \n" + "\n" + " END SUBROUTINE cleanup\n" + "END SUBROUTINE ModName_UpdateStates\n" + "!----------------------------------------------------------------------------------------------------------------------------------\n" + "!> This is a routine for computing outputs, used in both loose and tight coupling.\n" + "SUBROUTINE ModName_CalcOutput( t, u, p, x, xd, z, OtherState, y, misc, ErrStat, ErrMsg )\n" + "!..................................................................................................................................\n" + "\n" + " REAL(DbKi), INTENT(IN ) :: t !< Current simulation time in seconds\n" + " TYPE(ModName_InputType), INTENT(IN ) :: u !< Inputs at t\n" + " TYPE(ModName_ParameterType), INTENT(IN ) :: p !< Parameters\n" + " TYPE(ModName_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at t\n" + " TYPE(ModName_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at t\n" + " TYPE(ModName_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at t\n" + " TYPE(ModName_OtherStateType), INTENT(IN ) :: OtherState !< Other states at t\n" + " TYPE(ModName_MiscVarType), INTENT(INOUT) :: misc !< Misc variables for optimization (not copied in glue code)\n" + " TYPE(ModName_OutputType), INTENT(INOUT) :: y !< Outputs computed at t (Input only so that mesh con-\n" + " !! nectivity information does not have to be recalculated)\n" + " INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation\n" + " CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None\n" + "\n" + "\n" + " ! Initialize ErrStat\n" + "\n" + " ErrStat = ErrID_None\n" + " ErrMsg = ''\n" + "\n" + "\n" + " ! Compute outputs here:\n" + " y%DummyOutput = 2.0_ReKi\n" + "\n" + " y%WriteOutput(1) = REAL(t,ReKi)\n" + " y%WriteOutput(2) = 1.0_ReKi\n" + "\n" + "\n" + "END SUBROUTINE ModName_CalcOutput\n" + "!----------------------------------------------------------------------------------------------------------------------------------\n" + "!> This is a tight coupling routine for computing derivatives of continuous states.\n" + "SUBROUTINE ModName_CalcContStateDeriv( t, u, p, x, xd, z, OtherState, misc, dxdt, ErrStat, ErrMsg )\n" + "!..................................................................................................................................\n" + "\n" + " REAL(DbKi), INTENT(IN ) :: t !< Current simulation time in seconds\n" + " TYPE(ModName_InputType), INTENT(IN ) :: u !< Inputs at t\n" + " TYPE(ModName_ParameterType), INTENT(IN ) :: p !< Parameters\n" + " TYPE(ModName_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at t\n" + " TYPE(ModName_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at t\n" + " TYPE(ModName_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at t\n" + " TYPE(ModName_OtherStateType), INTENT(IN ) :: OtherState !< Other states at t\n" + " TYPE(ModName_MiscVarType), INTENT(INOUT) :: misc !< Misc variables for optimization (not copied in glue code)\n" + " TYPE(ModName_ContinuousStateType), INTENT( OUT) :: dxdt !< Continuous state derivatives at t\n" + " INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation\n" + " CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None\n" + "\n" + "\n" + " ! Initialize ErrStat\n" + "\n" + " ErrStat = ErrID_None\n" + " ErrMsg = ''\n" + "\n" + "\n" + " ! Compute the first time derivatives of the continuous states here:\n" + "\n" + " dxdt%DummyContState = 0.0_ReKi\n" + "\n" + "\n" + "END SUBROUTINE ModName_CalcContStateDeriv\n" + "!----------------------------------------------------------------------------------------------------------------------------------\n" + "!> This is a tight coupling routine for updating discrete states.\n" + "SUBROUTINE ModName_UpdateDiscState( t, n, u, p, x, xd, z, OtherState, misc, ErrStat, ErrMsg )\n" + "!..................................................................................................................................\n" + "\n" + " REAL(DbKi), INTENT(IN ) :: t !< Current simulation time in seconds\n" + " INTEGER(IntKi), INTENT(IN ) :: n !< Current step of the simulation: t = n*Interval\n" + " TYPE(ModName_InputType), INTENT(IN ) :: u !< Inputs at t\n" + " TYPE(ModName_ParameterType), INTENT(IN ) :: p !< Parameters\n" + " TYPE(ModName_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at t\n" + " TYPE(ModName_DiscreteStateType), INTENT(INOUT) :: xd !< Input: Discrete states at t;\n" + " !! Output: Discrete states at t + Interval\n" + " TYPE(ModName_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at t\n" + " TYPE(ModName_OtherStateType), INTENT(IN ) :: OtherState !< Other states at t\n" + " TYPE(ModName_MiscVarType), INTENT(INOUT) :: misc !< Misc variables for optimization (not copied in glue code)\n" + " INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation\n" + " CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None\n" + "\n" + "\n" + " ! Initialize ErrStat\n" + "\n" + " ErrStat = ErrID_None\n" + " ErrMsg = ''\n" + "\n" + "\n" + " ! Update discrete states here:\n" + "\n" + " xd%DummyDiscState = 0.0_Reki\n" + "\n" + "END SUBROUTINE ModName_UpdateDiscState\n" + "!----------------------------------------------------------------------------------------------------------------------------------\n" + "!> This is a tight coupling routine for solving for the residual of the constraint state functions.\n" + "SUBROUTINE ModName_CalcConstrStateResidual( t, u, p, x, xd, z, OtherState, misc, Z_residual, ErrStat, ErrMsg )\n" + "!..................................................................................................................................\n" + "\n" + " REAL(DbKi), INTENT(IN ) :: t !< Current simulation time in seconds\n" + " TYPE(ModName_InputType), INTENT(IN ) :: u !< Inputs at t\n" + " TYPE(ModName_ParameterType), INTENT(IN ) :: p !< Parameters\n" + " TYPE(ModName_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at t\n" + " TYPE(ModName_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at t\n" + " TYPE(ModName_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at t (possibly a guess)\n" + " TYPE(ModName_OtherStateType), INTENT(IN ) :: OtherState !< Other states at t\n" + " TYPE(ModName_MiscVarType), INTENT(INOUT) :: misc !< Misc variables for optimization (not copied in glue code)\n" + " TYPE(ModName_ConstraintStateType), INTENT( OUT) :: Z_residual !< Residual of the constraint state functions using\n" + " !! the input values described above\n" + " INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation\n" + " CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None\n" + "\n" + "\n" + " ! Initialize ErrStat\n" + "\n" + " ErrStat = ErrID_None\n" + " ErrMsg = ''\n" + "\n" + "\n" + " ! Solve for the residual of the constraint state functions here:\n" + "\n" + " Z_residual%DummyConstrState = 0.0_ReKi\n" + "\n" + "END SUBROUTINE ModName_CalcConstrStateResidual\n" + "\n" + "\n" + "!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++\n" + "! ###### The following four routines are Jacobian routines for linearization capabilities #######\n" + "! If the module does not implement them, set ErrStat = ErrID_Fatal in ModName_Init() when InitInp%Linearize is .true.\n" + "!----------------------------------------------------------------------------------------------------------------------------------\n" + "!> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions\n" + "!! with respect to the inputs (u). The partial derivatives dY/du, dX/du, dXd/du, and dZ/du are returned.\n" + "SUBROUTINE ModName_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdu, dXdu, dXddu, dZdu)\n" + "!..................................................................................................................................\n" + "\n" + " REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point\n" + " TYPE(ModName_InputType), INTENT(IN ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required)\n" + " TYPE(ModName_ParameterType), INTENT(IN ) :: p !< Parameters\n" + " TYPE(ModName_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point\n" + " TYPE(ModName_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point\n" + " TYPE(ModName_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point\n" + " TYPE(ModName_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point\n" + " TYPE(ModName_OutputType), INTENT(IN ) :: y !< Output (change to inout if a mesh copy is required);\n" + " !! Output fields are not used by this routine, but type is\n" + " !! available here so that mesh parameter information (i.e.,\n" + " !! connectivity) does not have to be recalculated for dYdu.\n" + " TYPE(ModName_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables\n" + " INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation\n" + " CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None\n" + " REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdu(:,:) !< Partial derivatives of output functions (Y) with respect\n" + " !! to the inputs (u) [intent in to avoid deallocation]\n" + " REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdu(:,:) !< Partial derivatives of continuous state functions (X) with\n" + " !! respect to the inputs (u) [intent in to avoid deallocation]\n" + " REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddu(:,:) !< Partial derivatives of discrete state functions (Xd) with\n" + " !! respect to the inputs (u) [intent in to avoid deallocation]\n" + " REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdu(:,:) !< Partial derivatives of constraint state functions (Z) with\n" + " !! respect to the inputs (u) [intent in to avoid deallocation]\n" + "\n" + "\n" + " ! Initialize ErrStat\n" + "\n" + " ErrStat = ErrID_None\n" + " ErrMsg = ''\n" + "\n" + "\n" + " IF ( PRESENT( dYdu ) ) THEN\n" + "\n" + " ! Calculate the partial derivative of the output functions (Y) with respect to the inputs (u) here:\n" + "\n" + " ! allocate and set dYdu\n" + "\n" + " END IF\n" + "\n" + " IF ( PRESENT( dXdu ) ) THEN\n" + "\n" + " ! Calculate the partial derivative of the continuous state functions (X) with respect to the inputs (u) here:\n" + "\n" + " ! allocate and set dXdu\n" + "\n" + " END IF\n" + "\n" + " IF ( PRESENT( dXddu ) ) THEN\n" + "\n" + " ! Calculate the partial derivative of the discrete state functions (Xd) with respect to the inputs (u) here:\n" + "\n" + " ! allocate and set dXddu\n" + "\n" + " END IF\n" + "\n" + " IF ( PRESENT( dZdu ) ) THEN\n" + "\n" + " ! Calculate the partial derivative of the constraint state functions (Z) with respect to the inputs (u) here:\n" + "\n" + " ! allocate and set dZdu\n" + "\n" + " END IF\n" + "\n" + "\n" + "END SUBROUTINE ModName_JacobianPInput\n" + "!----------------------------------------------------------------------------------------------------------------------------------\n" + "!> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions\n" + "!! with respect to the continuous states (x). The partial derivatives dY/dx, dX/dx, dXd/dx, and dZ/dx are returned.\n" + "SUBROUTINE ModName_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdx, dXdx, dXddx, dZdx )\n" + "!..................................................................................................................................\n" + "\n" + " REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point\n" + " TYPE(ModName_InputType), INTENT(IN ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required)\n" + " TYPE(ModName_ParameterType), INTENT(IN ) :: p !< Parameters\n" + " TYPE(ModName_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point\n" + " TYPE(ModName_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point\n" + " TYPE(ModName_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point\n" + " TYPE(ModName_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point\n" + " TYPE(ModName_OutputType), INTENT(IN ) :: y !< Output (change to inout if a mesh copy is required);\n" + " !! Output fields are not used by this routine, but type is\n" + " !! available here so that mesh parameter information (i.e.,\n" + " !! connectivity) does not have to be recalculated for dYdx.\n" + " TYPE(ModName_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables\n" + " INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation\n" + " CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None\n" + " REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdx(:,:) !< Partial derivatives of output functions\n" + " !! (Y) with respect to the continuous\n" + " !! states (x) [intent in to avoid deallocation]\n" + " REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdx(:,:) !< Partial derivatives of continuous state\n" + " !! functions (X) with respect to\n" + " !! the continuous states (x) [intent in to avoid deallocation]\n" + " REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddx(:,:) !< Partial derivatives of discrete state\n" + " !! functions (Xd) with respect to\n" + " !! the continuous states (x) [intent in to avoid deallocation]\n" + " REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdx(:,:) !< Partial derivatives of constraint state\n" + " !! functions (Z) with respect to\n" + " !! the continuous states (x) [intent in to avoid deallocation]\n" + "\n" + "\n" + " ! Initialize ErrStat\n" + "\n" + " ErrStat = ErrID_None\n" + " ErrMsg = ''\n" + "\n" + "\n" + "\n" + " IF ( PRESENT( dYdx ) ) THEN\n" + "\n" + " ! Calculate the partial derivative of the output functions (Y) with respect to the continuous states (x) here:\n" + "\n" + " ! allocate and set dYdx\n" + "\n" + " END IF\n" + "\n" + " IF ( PRESENT( dXdx ) ) THEN\n" + "\n" + " ! Calculate the partial derivative of the continuous state functions (X) with respect to the continuous states (x) here:\n" + "\n" + " ! allocate and set dXdx\n" + "\n" + " END IF\n" + "\n" + " IF ( PRESENT( dXddx ) ) THEN\n" + "\n" + " ! Calculate the partial derivative of the discrete state functions (Xd) with respect to the continuous states (x) here:\n" + "\n" + " ! allocate and set dXddx\n" + "\n" + " END IF\n" + "\n" + " IF ( PRESENT( dZdx ) ) THEN\n" + "\n" + "\n" + " ! Calculate the partial derivative of the constraint state functions (Z) with respect to the continuous states (x) here:\n" + "\n" + " ! allocate and set dZdx\n" + "\n" + " END IF\n" + "\n" + "\n" + "END SUBROUTINE ModName_JacobianPContState\n" + "!----------------------------------------------------------------------------------------------------------------------------------\n" + "!> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions\n" + "!! with respect to the discrete states (xd). The partial derivatives dY/dxd, dX/dxd, dXd/dxd, and dZ/dxd are returned.\n" + "SUBROUTINE ModName_JacobianPDiscState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdxd, dXdxd, dXddxd, dZdxd )\n" + "!..................................................................................................................................\n" + "\n" + " REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point\n" + " TYPE(ModName_InputType), INTENT(IN ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required)\n" + " TYPE(ModName_ParameterType), INTENT(IN ) :: p !< Parameters\n" + " TYPE(ModName_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point\n" + " TYPE(ModName_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point\n" + " TYPE(ModName_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point\n" + " TYPE(ModName_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point\n" + " TYPE(ModName_OutputType), INTENT(IN ) :: y !< Output (change to inout if a mesh copy is required);\n" + " !! Output fields are not used by this routine, but type is\n" + " !! available here so that mesh parameter information (i.e.,\n" + " !! connectivity) does not have to be recalculated for dYdxd.\n" + " TYPE(ModName_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables\n" + " INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation\n" + " CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None\n" + " REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdxd(:,:) !< Partial derivatives of output functions\n" + " !! (Y) with respect to the discrete\n" + " !! states (xd) [intent in to avoid deallocation]\n" + " REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdxd(:,:) !< Partial derivatives of continuous state\n" + " !! functions (X) with respect to the\n" + " !! discrete states (xd) [intent in to avoid deallocation]\n" + " REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddxd(:,:)!< Partial derivatives of discrete state\n" + " !! functions (Xd) with respect to the\n" + " !! discrete states (xd) [intent in to avoid deallocation]\n" + " REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdxd(:,:) !< Partial derivatives of constraint state\n" + " !! functions (Z) with respect to the\n" + " !! discrete states (xd) [intent in to avoid deallocation]\n" + "\n" + "\n" + " ! Initialize ErrStat\n" + "\n" + " ErrStat = ErrID_None\n" + " ErrMsg = ''\n" + "\n" + "\n" + " IF ( PRESENT( dYdxd ) ) THEN\n" + "\n" + " ! Calculate the partial derivative of the output functions (Y) with respect to the discrete states (xd) here:\n" + "\n" + " ! allocate and set dYdxd\n" + "\n" + " END IF\n" + "\n" + " IF ( PRESENT( dXdxd ) ) THEN\n" + "\n" + " ! Calculate the partial derivative of the continuous state functions (X) with respect to the discrete states (xd) here:\n" + "\n" + " ! allocate and set dXdxd\n" + "\n" + " END IF\n" + "\n" + " IF ( PRESENT( dXddxd ) ) THEN\n" + "\n" + " ! Calculate the partial derivative of the discrete state functions (Xd) with respect to the discrete states (xd) here:\n" + "\n" + " ! allocate and set dXddxd\n" + "\n" + " END IF\n" + "\n" + " IF ( PRESENT( dZdxd ) ) THEN\n" + "\n" + " ! Calculate the partial derivative of the constraint state functions (Z) with respect to the discrete states (xd) here:\n" + "\n" + " ! allocate and set dZdxd\n" + "\n" + " END IF\n" + "\n" + "\n" + "END SUBROUTINE ModName_JacobianPDiscState\n" + "!----------------------------------------------------------------------------------------------------------------------------------\n" + "!> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions\n" + "!! with respect to the constraint states (z). The partial derivatives dY/dz, dX/dz, dXd/dz, and dZ/dz are returned.\n" + "SUBROUTINE ModName_JacobianPConstrState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdz, dXdz, dXddz, dZdz )\n" + "!..................................................................................................................................\n" + "\n" + " REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point\n" + " TYPE(ModName_InputType), INTENT(IN ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required)\n" + " TYPE(ModName_ParameterType), INTENT(IN ) :: p !< Parameters\n" + " TYPE(ModName_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point\n" + " TYPE(ModName_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point\n" + " TYPE(ModName_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point\n" + " TYPE(ModName_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point\n" + " TYPE(ModName_OutputType), INTENT(IN ) :: y !< Output (change to inout if a mesh copy is required);\n" + " !! Output fields are not used by this routine, but type is\n" + " !! available here so that mesh parameter information (i.e.,\n" + " !! connectivity) does not have to be recalculated for dYdz.\n" + " TYPE(ModName_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables\n" + " INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation\n" + " CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None\n" + " REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdz(:,:) !< Partial derivatives of output\n" + " !! functions (Y) with respect to the\n" + " !! constraint states (z) [intent in to avoid deallocation]\n" + " REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdz(:,:) !< Partial derivatives of continuous\n" + " !! state functions (X) with respect to\n" + " !! the constraint states (z) [intent in to avoid deallocation]\n" + " REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddz(:,:) !< Partial derivatives of discrete state\n" + " !! functions (Xd) with respect to the\n" + " !! constraint states (z) [intent in to avoid deallocation]\n" + " REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdz(:,:) !< Partial derivatives of constraint\n" + " !! state functions (Z) with respect to\n" + " !! the constraint states (z) [intent in to avoid deallocation]\n" + "\n" + "\n" + " ! Initialize ErrStat\n" + "\n" + " ErrStat = ErrID_None\n" + " ErrMsg = ''\n" + "\n" + " IF ( PRESENT( dYdz ) ) THEN\n" + "\n" + " ! Calculate the partial derivative of the output functions (Y) with respect to the constraint states (z) here:\n" + "\n" + " ! allocate and set dYdz\n" + "\n" + " END IF\n" + "\n" + " IF ( PRESENT( dXdz ) ) THEN\n" + "\n" + " ! Calculate the partial derivative of the continuous state functions (X) with respect to the constraint states (z) here:\n" + "\n" + " ! allocate and set dXdz\n" + "\n" + " END IF\n" + "\n" + " IF ( PRESENT( dXddz ) ) THEN\n" + "\n" + " ! Calculate the partial derivative of the discrete state functions (Xd) with respect to the constraint states (z) here:\n" + "\n" + " ! allocate and set dXddz\n" + "\n" + " END IF\n" + "\n" + " IF ( PRESENT( dZdz ) ) THEN\n" + "\n" + " ! Calculate the partial derivative of the constraint state functions (Z) with respect to the constraint states (z) here:\n" + "\n" + " ! allocate and set dZdz\n" + "\n" + " END IF\n" + "\n" + "\n" + "END SUBROUTINE ModName_JacobianPConstrState\n" + "!----------------------------------------------------------------------------------------------------------------------------------\n" + "!> Routine to pack the data structures representing the operating points into arrays for linearization.\n" + "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 )\n" + "\n" + " REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point\n" + " TYPE(ModName_InputType), INTENT(IN ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required)\n" + " TYPE(ModName_ParameterType), INTENT(IN ) :: p !< Parameters\n" + " TYPE(ModName_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point\n" + " TYPE(ModName_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point\n" + " TYPE(ModName_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point\n" + " TYPE(ModName_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point\n" + " TYPE(ModName_OutputType), INTENT(IN ) :: y !< Output at operating point\n" + " TYPE(ModName_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables\n" + " INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation\n" + " CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None\n" + " REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: u_op(:) !< values of linearized inputs\n" + " REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: y_op(:) !< values of linearized outputs\n" + " REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: x_op(:) !< values of linearized continuous states\n" + " REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dx_op(:) !< values of first time derivatives of linearized continuous states\n" + " REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: xd_op(:) !< values of linearized discrete states\n" + " REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: z_op(:) !< values of linearized constraint states\n" + "\n" + "\n" + " ! Initialize ErrStat\n" + "\n" + " ErrStat = ErrID_None\n" + " ErrMsg = ''\n" + "\n" + " IF ( PRESENT( u_op ) ) THEN\n" + "\n" + " END IF\n" + "\n" + " IF ( PRESENT( y_op ) ) THEN\n" + " END IF\n" + "\n" + " IF ( PRESENT( x_op ) ) THEN\n" + "\n" + " END IF\n" + "\n" + " IF ( PRESENT( dx_op ) ) THEN\n" + "\n" + " END IF\n" + "\n" + " IF ( PRESENT( xd_op ) ) THEN\n" + "\n" + " END IF\n" + "\n" + " IF ( PRESENT( z_op ) ) THEN\n" + "\n" + " END IF\n" + "\n" + "END SUBROUTINE ModName_GetOP\n" + "!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++\n" + "\n" + "END MODULE ModuleName\n" + "!**********************************************************************************************************************************\n"); + +#endif \ No newline at end of file diff --git a/modules/openfast-registry/src/type.c b/modules/openfast-registry/src/type.c deleted file mode 100644 index 5c3f19ace2..0000000000 --- a/modules/openfast-registry/src/type.c +++ /dev/null @@ -1,428 +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 (r->ndims > 0 && r->dims[0]->is_pointer) { - return(1); - } - 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/modules/openfoam/README.md b/modules/openfoam/README.md deleted file mode 100644 index 0d57400745..0000000000 --- a/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/modules/openfoam/src/OpenFOAM_Registry.txt b/modules/openfoam/src/OpenFOAM_Registry.txt deleted file mode 100644 index a8bd4f5f22..0000000000 --- a/modules/openfoam/src/OpenFOAM_Registry.txt +++ /dev/null @@ -1,76 +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 -- from extern (used to linearly interpolate along AD15 blades)" - -typedef ^ ^ IntKi NumActForcePtsTower - - - "number of actuator line force points in tower -- from extern (used to linearly interpolate along AD15 tower)" - -typedef ^ ^ ReKi StructBldRNodes {:} - - "Radius to structural model analysis nodes relative to hub" -typedef ^ ^ ReKi StructTwrHNodes {:} - - "Location of tower nodes from AD15 (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 -typedef ^ ^ IntKi NodeClusterType - - - "Node clustering (0 - Uniform, 1 - Non-uniform clustered towards tip)" - - - - -# ..... 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 ActForceMotionsPoints {:} - - "point mesh for transferring AeroDyn motions to OpenFOAM (includes hub+blades+nacelle+tower+tailfin)" - -typedef OpenFOAM/OpFM OpFM_MiscVarType MeshType ActForceLoadsPoints {:} - - "point mesh for transferring AeroDyn distributed loads to OpenFOAM (includes hub+blades+nacelle+tower+tailfin)" - -typedef OpenFOAM/OpFM OpFM_MiscVarType MeshMapType Line2_to_Point_Loads {:} - - "mapping data structure to convert line2 loads to point loads" - -typedef OpenFOAM/OpFM OpFM_MiscVarType 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 OpenFOAM/OpFM ParameterType ReKi forceBldRnodes {:} - - "Radial location of force nodes" - -typedef OpenFOAM/OpFM ParameterType ReKi forceTwrHnodes {:} - - "Vertical location of force nodes" - -typedef OpenFOAM/OpFM ParameterType ReKi BladeLength - - - "Blade length (same for all blades)" "m" -typedef OpenFOAM/OpFM ParameterType ReKi TowerHeight - - - "Tower height" "m" -typedef OpenFOAM/OpFM ParameterType ReKi TowerBaseHeight - - - "Tower base height" "m" -typedef OpenFOAM/OpFM ParameterType IntKi NodeClusterType - - - "Node clustering (0 - Uniform, 1 - Non-uniform clustered towards tip)" - - -# ..... 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/modules/openfoam/src/OpenFOAM_Types.f90 b/modules/openfoam/src/OpenFOAM_Types.f90 deleted file mode 100644 index 3613f4b483..0000000000 --- a/modules/openfoam/src/OpenFOAM_Types.f90 +++ /dev/null @@ -1,4819 +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 - INTEGER(KIND=C_INT) :: NodeClusterType - 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 -- from extern (used to linearly interpolate along AD15 blades) [-] - INTEGER(IntKi) :: NumActForcePtsTower !< number of actuator line force points in tower -- from extern (used to linearly interpolate along AD15 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 tower nodes from AD15 (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] - INTEGER(IntKi) :: NodeClusterType !< Node clustering (0 - Uniform, 1 - Non-uniform clustered towards tip) [-] - 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 :: ActForceMotionsPoints !< point mesh for transferring AeroDyn motions to OpenFOAM (includes hub+blades+nacelle+tower+tailfin) [-] - TYPE(MeshType) , DIMENSION(:), ALLOCATABLE :: ActForceLoadsPoints !< point mesh for transferring AeroDyn distributed loads to OpenFOAM (includes hub+blades+nacelle+tower+tailfin) [-] - 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 - INTEGER(KIND=C_INT) :: NodeClusterType - 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() !< Radial location of force nodes [-] - REAL(KIND=C_FLOAT) , DIMENSION(:), POINTER :: forceTwrHnodes => NULL() !< Vertical location of force nodes [-] - REAL(ReKi) :: BladeLength !< Blade length (same for all blades) [m] - REAL(ReKi) :: TowerHeight !< Tower height [m] - REAL(ReKi) :: TowerBaseHeight !< Tower base height [m] - INTEGER(IntKi) :: NodeClusterType !< Node clustering (0 - Uniform, 1 - Non-uniform clustered towards tip) [-] - 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 - DstInitInputData%NodeClusterType = SrcInitInputData%NodeClusterType - DstInitInputData%C_obj%NodeClusterType = SrcInitInputData%C_obj%NodeClusterType - END SUBROUTINE OpFM_CopyInitInput - - SUBROUTINE OpFM_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(OpFM_InitInputType), INTENT(INOUT) :: InitInputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'OpFM_DestroyInitInput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ASSOCIATED(InitInputData%StructBldRNodes)) THEN - IF (DEALLOCATEpointers_local) & - 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 - IF (DEALLOCATEpointers_local) & - 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 - Int_BufSz = Int_BufSz + 1 ! NodeClusterType - 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 - IntKiBuf(Int_Xferred) = InData%NodeClusterType - Int_Xferred = Int_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 - OutData%NodeClusterType = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%C_obj%NodeClusterType = OutData%NodeClusterType - 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 - InitInputData%NodeClusterType = InitInputData%C_obj%NodeClusterType - 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 - InitInputData%C_obj%NodeClusterType = InitInputData%NodeClusterType - 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, DEALLOCATEpointers ) - TYPE(OpFM_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'OpFM_DestroyInitOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(InitOutputData%WriteOutputHdr)) THEN - DEALLOCATE(InitOutputData%WriteOutputHdr) -ENDIF -IF (ALLOCATED(InitOutputData%WriteOutputUnt)) THEN - DEALLOCATE(InitOutputData%WriteOutputUnt) -ENDIF - CALL NWTC_Library_Destroyprogdesc( InitOutputData%Ver, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - 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%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_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, DEALLOCATEpointers ) - TYPE(OpFM_MiscVarType), INTENT(INOUT) :: MiscData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'OpFM_DestroyMisc' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(MiscData%ActForceMotionsPoints)) THEN -DO i1 = LBOUND(MiscData%ActForceMotionsPoints,1), UBOUND(MiscData%ActForceMotionsPoints,1) - CALL MeshDestroy( MiscData%ActForceMotionsPoints(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -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), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MiscData%ActForceLoadsPoints) -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), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -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), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -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 ! ActForceMotionsPoints allocated yes/no - IF ( ALLOCATED(InData%ActForceMotionsPoints) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ActForceMotionsPoints upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - 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_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%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_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 ! 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_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 - DstParamData%NodeClusterType = SrcParamData%NodeClusterType - DstParamData%C_obj%NodeClusterType = SrcParamData%C_obj%NodeClusterType - END SUBROUTINE OpFM_CopyParam - - SUBROUTINE OpFM_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(OpFM_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'OpFM_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ASSOCIATED(ParamData%forceBldRnodes)) THEN - IF (DEALLOCATEpointers_local) & - 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 - IF (DEALLOCATEpointers_local) & - 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 - Int_BufSz = Int_BufSz + 1 ! NodeClusterType - 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 - IntKiBuf(Int_Xferred) = InData%NodeClusterType - Int_Xferred = Int_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 - OutData%NodeClusterType = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%C_obj%NodeClusterType = OutData%NodeClusterType - 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 - ParamData%NodeClusterType = ParamData%C_obj%NodeClusterType - 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 - ParamData%C_obj%NodeClusterType = ParamData%NodeClusterType - 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, DEALLOCATEpointers ) - TYPE(OpFM_InputType), INTENT(INOUT) :: InputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'OpFM_DestroyInput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ASSOCIATED(InputData%pxVel)) THEN - IF (DEALLOCATEpointers_local) & - 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 - IF (DEALLOCATEpointers_local) & - 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 - IF (DEALLOCATEpointers_local) & - 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 - IF (DEALLOCATEpointers_local) & - 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 - IF (DEALLOCATEpointers_local) & - 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 - IF (DEALLOCATEpointers_local) & - 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 - IF (DEALLOCATEpointers_local) & - 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 - IF (DEALLOCATEpointers_local) & - 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 - IF (DEALLOCATEpointers_local) & - 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 - IF (DEALLOCATEpointers_local) & - 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 - IF (DEALLOCATEpointers_local) & - 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 - IF (DEALLOCATEpointers_local) & - 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 - IF (DEALLOCATEpointers_local) & - 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 - IF (DEALLOCATEpointers_local) & - 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 - IF (DEALLOCATEpointers_local) & - 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 - IF (DEALLOCATEpointers_local) & - 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 - IF (DEALLOCATEpointers_local) & - 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, DEALLOCATEpointers ) - TYPE(OpFM_OutputType), INTENT(INOUT) :: OutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'OpFM_DestroyOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ASSOCIATED(OutputData%u)) THEN - IF (DEALLOCATEpointers_local) & - 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 - IF (DEALLOCATEpointers_local) & - 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 - IF (DEALLOCATEpointers_local) & - 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/modules/openfoam/src/OpenFOAM_Types.h b/modules/openfoam/src/OpenFOAM_Types.h deleted file mode 100644 index b26552f2a8..0000000000 --- a/modules/openfoam/src/OpenFOAM_Types.h +++ /dev/null @@ -1,102 +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 ; - int NodeClusterType ; - } 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 ; - int NodeClusterType ; - } 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/modules/orcaflex-interface/CMakeLists.txt b/modules/orcaflex-interface/CMakeLists.txt index 3b744c4ce8..737f57be9a 100644 --- a/modules/orcaflex-interface/CMakeLists.txt +++ b/modules/orcaflex-interface/CMakeLists.txt @@ -18,7 +18,7 @@ if (GENERATE_TYPES) generate_f90_types(src/OrcaFlexInterface.txt ${CMAKE_CURRENT_LIST_DIR}/src/OrcaFlexInterface_Types.f90) endif() -add_library(orcaflexlib +add_library(orcaflexlib STATIC src/OrcaFlexInterface.f90 src/OrcaFlexInterface_Types.f90 ) diff --git a/modules/orcaflex-interface/src/OrcaFlexInterface.f90 b/modules/orcaflex-interface/src/OrcaFlexInterface.f90 index 04c49d6d76..3671b6266c 100644 --- a/modules/orcaflex-interface/src/OrcaFlexInterface.f90 +++ b/modules/orcaflex-interface/src/OrcaFlexInterface.f90 @@ -728,7 +728,7 @@ SUBROUTINE Orca_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ! 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 + IF ( ErrStat >= AbortErrLev) RETURN q = reshape((/REAL(u%PtfmMesh%TranslationDisp(:,1),ReKi),rotdisp(:)/),(/6/)) qdot = reshape((/u%PtfmMesh%TranslationVel(:,1),u%PtfmMesh%RotationVel(:,1)/),(/6/)) diff --git a/modules/orcaflex-interface/src/OrcaFlexInterface_Types.f90 b/modules/orcaflex-interface/src/OrcaFlexInterface_Types.f90 index 69d3c7a6ee..8b70866a69 100644 --- a/modules/orcaflex-interface/src/OrcaFlexInterface_Types.f90 +++ b/modules/orcaflex-interface/src/OrcaFlexInterface_Types.f90 @@ -37,7 +37,7 @@ MODULE OrcaFlexInterface_Types 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] + REAL(ReKi) :: TMax = 0.0_ReKi !< Maximum Time [seconds] END TYPE Orca_InitInputType ! ======================= ! ========= Orca_InitOutputType ======= @@ -58,24 +58,24 @@ MODULE OrcaFlexInterface_Types ! ======================= ! ========= Orca_OtherStateType ======= TYPE, PUBLIC :: Orca_OtherStateType - REAL(SiKi) :: DummyOtherState !< Remove if you have OtherStates [-] + REAL(SiKi) :: DummyOtherState = 0.0_R4Ki !< 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(1:6,1:6) :: PtfmAM = 0.0_ReKi !< Added mass matrix results from OrcaFlex [-] + REAL(ReKi) , DIMENSION(1:6) :: PtfmFt = 0.0_ReKi !< Force/moment results from OrcaFlex [-] + REAL(ReKi) , DIMENSION(1:6) :: F_PtfmAM = 0.0_ReKi !< 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 [-] + REAL(DbKi) :: LastTimeStep = 0.0_R8Ki !< 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] + REAL(DbKi) :: DT = 0.0_R8Ki !< 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) :: SimNamePathLen = 0_IntKi !< 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 @@ -93,2429 +93,699 @@ MODULE OrcaFlexInterface_Types ! ======================= ! ========= Orca_ContinuousStateType ======= TYPE, PUBLIC :: Orca_ContinuousStateType - REAL(ReKi) :: Dummy !< Dummy placeholder [-] + REAL(ReKi) :: Dummy = 0.0_ReKi !< Dummy placeholder [-] END TYPE Orca_ContinuousStateType ! ======================= ! ========= Orca_DiscreteStateType ======= TYPE, PUBLIC :: Orca_DiscreteStateType - REAL(ReKi) :: Dummy !< Dummy placeholder [-] + REAL(ReKi) :: Dummy = 0.0_ReKi !< Dummy placeholder [-] END TYPE Orca_DiscreteStateType ! ======================= ! ========= Orca_ConstraintStateType ======= TYPE, PUBLIC :: Orca_ConstraintStateType - REAL(ReKi) :: DummyConstrState !< Dummy placeholder [-] + REAL(ReKi) :: DummyConstrState = 0.0_ReKi !< 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, DEALLOCATEpointers ) - TYPE(Orca_InitInputType), INTENT(INOUT) :: InitInputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_DestroyInitInput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - 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' -! +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 + character(*), parameter :: RoutineName = 'Orca_CopyInitInput' 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, DEALLOCATEpointers ) - TYPE(Orca_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_DestroyInitOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL NWTC_Library_Destroyprogdesc( InitOutputData%Ver, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -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' -! + ErrMsg = '' + DstInitInputData%InputFile = SrcInitInputData%InputFile + DstInitInputData%RootName = SrcInitInputData%RootName + DstInitInputData%TMax = SrcInitInputData%TMax +end subroutine + +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' 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, DEALLOCATEpointers ) - TYPE(Orca_InputFile), INTENT(INOUT) :: InputFileData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_DestroyInputFile' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - 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' -! + ErrMsg = '' +end subroutine + +subroutine Orca_PackInitInput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Orca_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Orca_PackInitInput' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%InputFile) + call RegPack(RF, InData%RootName) + call RegPack(RF, InData%TMax) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Orca_UnPackInitInput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Orca_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Orca_UnPackInitInput' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%InputFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RootName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TMax); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +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 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Orca_CopyInitOutput' ErrStat = ErrID_None - ErrMsg = "" - DstOtherStateData%DummyOtherState = SrcOtherStateData%DummyOtherState - END SUBROUTINE Orca_CopyOtherState - - SUBROUTINE Orca_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(Orca_OtherStateType), INTENT(INOUT) :: OtherStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_DestroyOtherState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - 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' -! + 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 + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) + if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then + allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitOutputData%WriteOutputUnt)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) + if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then + allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), 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 + end if +end subroutine + +subroutine Orca_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(Orca_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Orca_DestroyInitOutput' 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, DEALLOCATEpointers ) - TYPE(Orca_MiscVarType), INTENT(INOUT) :: MiscData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_DestroyMisc' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -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' -! + ErrMsg = '' + call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(InitOutputData%WriteOutputHdr)) then + deallocate(InitOutputData%WriteOutputHdr) + end if + if (allocated(InitOutputData%WriteOutputUnt)) then + deallocate(InitOutputData%WriteOutputUnt) + end if +end subroutine + +subroutine Orca_PackInitOutput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Orca_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Orca_PackInitOutput' + if (RF%ErrStat >= AbortErrLev) return + call NWTC_Library_PackProgDesc(RF, InData%Ver) + call RegPackAlloc(RF, InData%WriteOutputHdr) + call RegPackAlloc(RF, InData%WriteOutputUnt) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Orca_UnPackInitOutput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Orca_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Orca_UnPackInitOutput' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call NWTC_Library_UnpackProgDesc(RF, OutData%Ver) ! Ver + call RegUnpackAlloc(RF, OutData%WriteOutputHdr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WriteOutputUnt); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +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 + character(*), parameter :: RoutineName = 'Orca_CopyInputFile' 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, DEALLOCATEpointers ) - TYPE(Orca_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL FreeDynamicLib( ParamData%DLL_Orca, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(ParamData%OutParam)) THEN -DO i1 = LBOUND(ParamData%OutParam,1), UBOUND(ParamData%OutParam,1) - CALL NWTC_Library_Destroyoutparmtype( ParamData%OutParam(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -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' -! + 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 + +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' 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, DEALLOCATEpointers ) - TYPE(Orca_InputType), INTENT(INOUT) :: InputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_DestroyInput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL MeshDestroy( InputData%PtfmMesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - 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' -! + ErrMsg = '' +end subroutine + +subroutine Orca_PackInputFile(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Orca_InputFile), intent(in) :: InData + character(*), parameter :: RoutineName = 'Orca_PackInputFile' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DLL_FileName) + call RegPack(RF, InData%DLL_InitProcName) + call RegPack(RF, InData%DLL_CalcProcName) + call RegPack(RF, InData%DLL_EndProcName) + call RegPack(RF, InData%DirRoot) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Orca_UnPackInputFile(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Orca_InputFile), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Orca_UnPackInputFile' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DLL_FileName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DLL_InitProcName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DLL_CalcProcName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DLL_EndProcName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DirRoot); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +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 + character(*), parameter :: RoutineName = 'Orca_CopyOtherState' 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, DEALLOCATEpointers ) - TYPE(Orca_OutputType), INTENT(INOUT) :: OutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_DestroyOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL MeshDestroy( OutputData%PtfmMesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -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' -! + ErrMsg = '' + DstOtherStateData%DummyOtherState = SrcOtherStateData%DummyOtherState +end subroutine + +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' ErrStat = ErrID_None - ErrMsg = "" - DstContStateData%Dummy = SrcContStateData%Dummy - END SUBROUTINE Orca_CopyContState - - SUBROUTINE Orca_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(Orca_ContinuousStateType), INTENT(INOUT) :: ContStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_DestroyContState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - 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' -! + ErrMsg = '' +end subroutine + +subroutine Orca_PackOtherState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Orca_OtherStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Orca_PackOtherState' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyOtherState) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Orca_UnPackOtherState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Orca_OtherStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Orca_UnPackOtherState' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyOtherState); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +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 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'Orca_CopyMisc' ErrStat = ErrID_None - ErrMsg = "" - DstDiscStateData%Dummy = SrcDiscStateData%Dummy - END SUBROUTINE Orca_CopyDiscState - - SUBROUTINE Orca_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(Orca_DiscreteStateType), INTENT(INOUT) :: DiscStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_DestroyDiscState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - 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' -! + ErrMsg = '' + DstMiscData%PtfmAM = SrcMiscData%PtfmAM + DstMiscData%PtfmFt = SrcMiscData%PtfmFt + DstMiscData%F_PtfmAM = SrcMiscData%F_PtfmAM + if (allocated(SrcMiscData%AllOuts)) then + LB(1:1) = lbound(SrcMiscData%AllOuts) + UB(1:1) = ubound(SrcMiscData%AllOuts) + if (.not. allocated(DstMiscData%AllOuts)) then + allocate(DstMiscData%AllOuts(LB(1):UB(1)), 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 + end if + DstMiscData%LastTimeStep = SrcMiscData%LastTimeStep +end subroutine + +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' ErrStat = ErrID_None - ErrMsg = "" - DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState - END SUBROUTINE Orca_CopyConstrState - - SUBROUTINE Orca_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(Orca_ConstraintStateType), INTENT(INOUT) :: ConstrStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_DestroyConstrState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - 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 + ErrMsg = '' + if (allocated(MiscData%AllOuts)) then + deallocate(MiscData%AllOuts) + end if +end subroutine + +subroutine Orca_PackMisc(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Orca_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Orca_PackMisc' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%PtfmAM) + call RegPack(RF, InData%PtfmFt) + call RegPack(RF, InData%F_PtfmAM) + call RegPackAlloc(RF, InData%AllOuts) + call RegPack(RF, InData%LastTimeStep) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Orca_UnPackMisc(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Orca_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Orca_UnPackMisc' + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%PtfmAM); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PtfmFt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%F_PtfmAM); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AllOuts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LastTimeStep); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +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 + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(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 + LB(1:1) = lbound(SrcParamData%OutParam) + UB(1:1) = ubound(SrcParamData%OutParam) + if (.not. allocated(DstParamData%OutParam)) then + allocate(DstParamData%OutParam(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutParam.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyOutParmType(SrcParamData%OutParam(i1), DstParamData%OutParam(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if +end subroutine + +subroutine Orca_DestroyParam(ParamData, ErrStat, ErrMsg) + type(Orca_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Orca_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' + call FreeDynamicLib( ParamData%DLL_Orca, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(ParamData%OutParam)) then + LB(1:1) = lbound(ParamData%OutParam) + UB(1:1) = ubound(ParamData%OutParam) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyOutParmType(ParamData%OutParam(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%OutParam) + end if +end subroutine + +subroutine Orca_PackParam(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Orca_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Orca_PackParam' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DT) + call DLLTypePack(RF, InData%DLL_Orca) + call RegPack(RF, InData%SimNamePath) + call RegPack(RF, InData%SimNamePathLen) + call RegPack(RF, InData%NumOuts) + call RegPack(RF, allocated(InData%OutParam)) + if (allocated(InData%OutParam)) then + call RegPackBounds(RF, 1, lbound(InData%OutParam), ubound(InData%OutParam)) + LB(1:1) = lbound(InData%OutParam) + UB(1:1) = ubound(InData%OutParam) + do i1 = LB(1), UB(1) + call NWTC_Library_PackOutParmType(RF, InData%OutParam(i1)) + end do + end if + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Orca_UnPackParam(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Orca_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Orca_UnPackParam' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DT); if (RegCheckErr(RF, RoutineName)) return + call DLLTypeUnpack(RF, OutData%DLL_Orca) ! DLL_Orca + call RegUnpack(RF, OutData%SimNamePath); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SimNamePathLen); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumOuts); if (RegCheckErr(RF, RoutineName)) return + if (allocated(OutData%OutParam)) deallocate(OutData%OutParam) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%OutParam(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackOutParmType(RF, OutData%OutParam(i1)) ! OutParam + end do + end if +end subroutine + +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 + 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 + +subroutine Orca_DestroyInput(InputData, ErrStat, ErrMsg) + type(Orca_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Orca_DestroyInput' + ErrStat = ErrID_None + ErrMsg = '' + call MeshDestroy( InputData%PtfmMesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine Orca_PackInput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Orca_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Orca_PackInput' + if (RF%ErrStat >= AbortErrLev) return + call MeshPack(RF, InData%PtfmMesh) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Orca_UnPackInput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Orca_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Orca_UnPackInput' + if (RF%ErrStat /= ErrID_None) return + call MeshUnpack(RF, OutData%PtfmMesh) ! PtfmMesh +end subroutine + +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 + integer(B4Ki) :: LB(1), UB(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 + LB(1:1) = lbound(SrcOutputData%WriteOutput) + UB(1:1) = ubound(SrcOutputData%WriteOutput) + if (.not. allocated(DstOutputData%WriteOutput)) then + allocate(DstOutputData%WriteOutput(LB(1):UB(1)), 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 + end if +end subroutine + +subroutine Orca_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(Orca_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Orca_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' + call MeshDestroy( OutputData%PtfmMesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(OutputData%WriteOutput)) then + deallocate(OutputData%WriteOutput) + end if +end subroutine + +subroutine Orca_PackOutput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Orca_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Orca_PackOutput' + if (RF%ErrStat >= AbortErrLev) return + call MeshPack(RF, InData%PtfmMesh) + call RegPackAlloc(RF, InData%WriteOutput) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Orca_UnPackOutput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Orca_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Orca_UnPackOutput' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call MeshUnpack(RF, OutData%PtfmMesh) ! PtfmMesh + call RegUnpackAlloc(RF, OutData%WriteOutput); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +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 + character(*), parameter :: RoutineName = 'Orca_CopyContState' + ErrStat = ErrID_None + ErrMsg = '' + DstContStateData%Dummy = SrcContStateData%Dummy +end subroutine + +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' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine Orca_PackContState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Orca_ContinuousStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Orca_PackContState' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%Dummy) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Orca_UnPackContState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Orca_ContinuousStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Orca_UnPackContState' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%Dummy); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +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 + character(*), parameter :: RoutineName = 'Orca_CopyDiscState' + ErrStat = ErrID_None + ErrMsg = '' + DstDiscStateData%Dummy = SrcDiscStateData%Dummy +end subroutine + +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' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine Orca_PackDiscState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Orca_DiscreteStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Orca_PackDiscState' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%Dummy) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Orca_UnPackDiscState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Orca_DiscreteStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Orca_UnPackDiscState' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%Dummy); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +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 + character(*), parameter :: RoutineName = 'Orca_CopyConstrState' + ErrStat = ErrID_None + ErrMsg = '' + DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState +end subroutine + +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' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine Orca_PackConstrState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Orca_ConstraintStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Orca_PackConstrState' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyConstrState) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Orca_UnPackConstrState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Orca_ConstraintStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Orca_UnPackConstrState' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyConstrState); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +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 ) + 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) /= size(u)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(u)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(u) - 1 + select case (order) + case (0) + call Orca_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call Orca_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call Orca_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(u) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +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. @@ -2527,41 +797,42 @@ SUBROUTINE Orca_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ! !.................................................................................................................................. - 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 + 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 + 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) :: a1, a2 ! 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 ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = 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 + +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. @@ -2575,101 +846,102 @@ SUBROUTINE Orca_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Er ! !.................................................................................................................................. - 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 + 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) - + 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) :: a1,a2,a3 ! 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 + 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 + 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 + 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 + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + 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 + +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 ) + 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) /= size(y)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(y)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(y) - 1 + select case (order) + case (0) + call Orca_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call Orca_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call Orca_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(y) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +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. @@ -2681,49 +953,47 @@ SUBROUTINE Orca_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMs ! !.................................................................................................................................. - 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 + 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 + 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) :: a1, a2 ! 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 ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = 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 + y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + END IF ! check if allocated +END SUBROUTINE + +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. @@ -2737,56 +1007,52 @@ SUBROUTINE Orca_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, E ! !.................................................................................................................................. - 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 + 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) - + 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) :: a1,a2,a3 ! 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 + 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 + 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 + 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 - + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + 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 + y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + a3*y3%WriteOutput + END IF ! check if allocated +END SUBROUTINE END MODULE OrcaFlexInterface_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/seastate/CMakeLists.txt b/modules/seastate/CMakeLists.txt new file mode 100644 index 0000000000..f0860e89ef --- /dev/null +++ b/modules/seastate/CMakeLists.txt @@ -0,0 +1,53 @@ +# +# Copyright 2023 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/Current.txt ${CMAKE_CURRENT_LIST_DIR}/src/Current_Types.f90 -noextrap) + generate_f90_types(src/Waves.txt ${CMAKE_CURRENT_LIST_DIR}/src/Waves_Types.f90 -noextrap) + generate_f90_types(src/Waves2.txt ${CMAKE_CURRENT_LIST_DIR}/src/Waves2_Types.f90 -noextrap) + generate_f90_types(src/SeaSt_WaveField.txt ${CMAKE_CURRENT_LIST_DIR}/src/SeaSt_WaveField_Types.f90 -noextrap) + generate_f90_types(src/SeaState.txt ${CMAKE_CURRENT_LIST_DIR}/src/SeaState_Types.f90 -noextrap) +endif() + +add_library(seastlib STATIC + src/Current.f90 + src/Waves.f90 + src/Waves2.f90 + src/UserWaves.f90 + src/SeaSt_WaveField.f90 + src/SeaState_Input.f90 + src/SeaState.f90 + src/SeaState_Output.f90 + src/Current_Types.f90 + src/Waves_Types.f90 + src/Waves2_Types.f90 + src/SeaSt_WaveField_Types.f90 + src/SeaState_Types.f90 +) +target_link_libraries(seastlib nwtclibs versioninfolib) + +# Driver +add_executable(seastate_driver + src/SeaState_DriverCode.f90 +) +target_link_libraries(seastate_driver seastlib) + +install(TARGETS seastate_driver seastlib + EXPORT "${CMAKE_PROJECT_NAME}Libraries" + RUNTIME DESTINATION bin + LIBRARY DESTINATION lib + ARCHIVE DESTINATION lib +) diff --git a/modules/seastate/README.md b/modules/seastate/README.md new file mode 100644 index 0000000000..57c6b9672c --- /dev/null +++ b/modules/seastate/README.md @@ -0,0 +1,9 @@ +# SeaState Module +The legacy version of this module was incorporated within the HydroDyn module. Additional documentation are available +at the [NWTC Software Portal](https://nwtc.nrel.gov/HydroDyn/). + +## Overview +SeaState is a module for modeling hydrodynamics. It has been coupled +into the OpenFAST multi-physics engineering tool to enable hydrodynamic +simulation of horizontal-axis wind turbines. SeaState can also be driven +as a standalone code to generate wave elevation and kinematic data uncoupled from OpenFAST. diff --git a/modules/hydrodyn/src/Current.f90 b/modules/seastate/src/Current.f90 similarity index 64% rename from modules/hydrodyn/src/Current.f90 rename to modules/seastate/src/Current.f90 index a7415f6779..5d57f642e5 100644 --- a/modules/hydrodyn/src/Current.f90 +++ b/modules/seastate/src/Current.f90 @@ -35,7 +35,6 @@ MODULE Current ! ..... Public Subroutines ................................................................................................... PUBLIC :: Current_Init ! Initialization routine - PUBLIC :: Current_End ! Ending routine (includes clean up) CONTAINS @@ -43,7 +42,7 @@ MODULE Current !JASON: MOVE THIS USER-DEFINED ROUTINE (UserCurrent) TO THE UserSubs.f90 OF HydroDyn WHEN THE PLATFORM LOADING FUNCTIONALITY HAS BEEN DOCUMENTED!!!!! !> This is a dummy routine for holding the place of a user-specified !! current profile. Modify this code to create your own profile. -SUBROUTINE UserCurrent ( zi, WtrDpth, DirRoot, CurrVxi, CurrVyi ) +SUBROUTINE UserCurrent ( zi, EffWtrDpth, DirRoot, CurrVxi, CurrVyi ) IMPLICIT NONE @@ -52,8 +51,8 @@ SUBROUTINE UserCurrent ( zi, WtrDpth, DirRoot, CurrVxi, CurrVyi ) REAL(SiKi), INTENT(OUT) :: CurrVxi !< xi-component of the current velocity at elevation zi, m/s. REAL(SiKi), INTENT(OUT) :: CurrVyi !< yi-component of the current velocity at elevation zi, m/s. - REAL(SiKi), INTENT(IN ) :: WtrDpth !< Water depth ( WtrDpth > 0 ), meters. - REAL(SiKi), INTENT(IN ) :: zi !< Elevation (-WtrDpth <= zi <= 0 ), meters. + REAL(SiKi), INTENT(IN ) :: EffWtrDpth !< Effective water depth ( EffWtrDpth > 0 ), meters. + REAL(SiKi), INTENT(IN ) :: zi !< Elevation (-EffWtrDpth <= zi <= 0 ), meters. CHARACTER(*), 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. @@ -87,7 +86,7 @@ SUBROUTINE Calc_Current( InitInp, z, h , DirRoot, CurrVxi, CurrVyi ) REAL(SiKi), INTENT(OUT) :: CurrVxi !< xi-component of the current velocity at elevation z (m/s) REAL(SiKi), INTENT(OUT) :: CurrVyi !< yi-component of the current velocity at elevation z (m/s) - REAL(SiKi), INTENT(IN ) :: h !< Water depth (meters) This quantity must be positive-valued + REAL(SiKi), INTENT(IN ) :: h !< Effective water depth (meters) This quantity must be positive-valued REAL(SiKi), INTENT(IN ) :: z !< Elevation relative to the mean sea level (meters) CHARACTER(*), 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 @@ -154,25 +153,10 @@ END SUBROUTINE Calc_Current !> 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 Current_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut, ErrStat, ErrMsg ) +SUBROUTINE Current_Init( InitInp, InitOut, ErrStat, ErrMsg ) !.................................................................................................................................. TYPE(Current_InitInputType), INTENT(IN ) :: InitInp !< Input data for initialization routine - TYPE(Current_InputType), INTENT( OUT) :: u !< An initial guess for the input; input mesh must be defined - TYPE(Current_ParameterType), INTENT( OUT) :: p !< Parameters - TYPE(Current_ContinuousStateType), INTENT( OUT) :: x !< Initial continuous states - TYPE(Current_DiscreteStateType), INTENT( OUT) :: xd !< Initial discrete states - TYPE(Current_ConstraintStateType), INTENT( OUT) :: z !< Initial guess of the constraint states - TYPE(Current_OtherStateType), INTENT( OUT) :: OtherState !< Initial other states - TYPE(Current_OutputType), INTENT( OUT) :: y !< Initial system outputs (outputs are not calculated; - !! only the output mesh is initialized) - TYPE(Current_MiscVarType), INTENT( OUT) :: m !< Initial misc/optimization variables - REAL(DbKi), INTENT(INOUT) :: Interval !< Coupling interval in seconds: the rate that - !! (1) Current_UpdateStates() is called in loose coupling & - !! (2) Current_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(Current_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 @@ -198,26 +182,20 @@ SUBROUTINE Current_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, In ErrStat = ErrID_None ErrMsg = "" - - - ! Initialize the NWTC Subroutine Library - - CALL NWTC_Init( ) - ! IF there are Morison elements, then compute the current components at each morison node elevation - IF ( InitInp%NMorisonNodes > 0 ) THEN + IF ( InitInp%NGridPts > 0 ) THEN - ALLOCATE ( InitOut%CurrVxi( InitInp%NMorisonNodes ) , STAT=ErrStat ) + ALLOCATE ( InitOut%CurrVxi( InitInp%NGridPts ) , STAT=ErrStat ) IF ( ErrStat /= ErrID_None ) THEN ErrMsg = ' Error allocating memory for the CurrVxi array.' ErrStat = ErrID_Fatal RETURN END IF - ALLOCATE ( InitOut%CurrVyi( InitInp%NMorisonNodes ) , STAT=ErrStat ) + ALLOCATE ( InitOut%CurrVyi( InitInp%NGridPts ) , STAT=ErrStat ) IF ( ErrStat /= ErrID_None ) THEN ErrMsg = ' Error allocating memory for the CurrVyi array.' ErrStat = ErrID_Fatal @@ -227,9 +205,9 @@ SUBROUTINE Current_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, In ! Loop over all of the points where current information is required - DO I = 1, InitInp%NMorisonNodes + DO I = 1, InitInp%NGridPts - CALL Calc_Current( InitInp, InitInp%MorisonNodezi(I), InitInp%WtrDpth, InitInp%DirRoot, CurrVxi, CurrVyi ) + CALL Calc_Current( InitInp, InitInp%WaveKinGridzi(I), InitInp%EffWtrDpth, InitInp%DirRoot, CurrVxi, CurrVyi ) InitOut%CurrVxi(I) = CurrVxi InitOut%CurrVyi(I) = CurrVyi @@ -240,84 +218,15 @@ SUBROUTINE Current_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, In ! Compute the partial derivative for wave stretching - CALL Calc_Current( InitInp, 0.0_SiKi, InitInp%WtrDpth, InitInp%DirRoot, CurrVxi0, CurrVyi0 ) - CALL Calc_Current( InitInp, -SmllNmbr, InitInp%WtrDpth, InitInp%DirRoot, CurrVxiS, CurrVyiS ) + CALL Calc_Current( InitInp, 0.0_SiKi, InitInp%EffWtrDpth, InitInp%DirRoot, CurrVxi0, CurrVyi0 ) + CALL Calc_Current( InitInp, -SmllNmbr, InitInp%EffWtrDpth, InitInp%DirRoot, CurrVxiS, CurrVyiS ) InitOut%PCurrVxiPz0 = ( CurrVxi0 - CurrVxiS )/SmllNmbr ! xi-direction InitOut%PCurrVyiPz0 = ( CurrVyi0 - CurrVyiS )/SmllNmbr ! yi-direction - u%DummyInput = 0.0 - p%DT = Interval - x%DummyContState = 0.0 - xd%DummyDiscState = 0.0 - z%DummyConstrState = 0.0 - OtherState%DummyOtherState = 0 - y%DummyOutput = 0.0 - m%DummyMiscVar = 0 - END SUBROUTINE Current_Init - -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine is called at the end of the simulation. -SUBROUTINE Current_End( u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) -!.................................................................................................................................. - - TYPE(Current_InputType), INTENT(INOUT) :: u !< System inputs - TYPE(Current_ParameterType), INTENT(INOUT) :: p !< Parameters - TYPE(Current_ContinuousStateType), INTENT(INOUT) :: x !< Continuous states - TYPE(Current_DiscreteStateType), INTENT(INOUT) :: xd !< Discrete states - TYPE(Current_ConstraintStateType), INTENT(INOUT) :: z !< Constraint states - TYPE(Current_OtherStateType), INTENT(INOUT) :: OtherState !< Other/optimization states - TYPE(Current_OutputType), INTENT(INOUT) :: y !< System outputs - TYPE(Current_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 Current_DestroyInput( u, ErrStat, ErrMsg ) - - - ! Destroy the parameter data: - - CALL Current_DestroyParam( p, ErrStat, ErrMsg ) - - - ! Destroy the state data: - - CALL Current_DestroyContState( x, ErrStat, ErrMsg ) - CALL Current_DestroyDiscState( xd, ErrStat, ErrMsg ) - CALL Current_DestroyConstrState( z, ErrStat, ErrMsg ) - CALL Current_DestroyOtherState( OtherState, ErrStat, ErrMsg ) - - CALL Current_DestroyMisc( m, ErrStat, ErrMsg ) - - ! Destroy the output data: - - CALL Current_DestroyOutput( y, ErrStat, ErrMsg ) - - - - -END SUBROUTINE Current_End -!---------------------------------------------------------------------------------------------------------------------------------- END MODULE Current !********************************************************************************************************************************** diff --git a/modules/hydrodyn/src/Current.txt b/modules/seastate/src/Current.txt similarity index 52% rename from modules/hydrodyn/src/Current.txt rename to modules/seastate/src/Current.txt index 5008b1b0af..f4f6ccd0e3 100644 --- a/modules/hydrodyn/src/Current.txt +++ b/modules/seastate/src/Current.txt @@ -27,9 +27,9 @@ typedef ^ ^ SiKi Cu typedef ^ ^ SiKi CurrDIV - - - "" - typedef ^ ^ SiKi CurrDIDir - - - "" - typedef ^ ^ INTEGER CurrMod - - - "" - -typedef ^ ^ SiKi WtrDpth - - - "" - -typedef ^ ^ SiKi MorisonNodezi {:} - - "" - -typedef ^ ^ INTEGER NMorisonNodes - - - "" - +typedef ^ ^ SiKi EffWtrDpth - - - "" - +typedef ^ ^ SiKi WaveKinGridzi {:} - - "" - +typedef ^ ^ INTEGER NGridPts - - - "" - typedef ^ ^ CHARACTER(1024) DirRoot - "" - "" - # # @@ -40,49 +40,4 @@ typedef ^ ^ SiKi Cu typedef ^ ^ SiKi PCurrVxiPz0 - - - "" - typedef ^ ^ SiKi PCurrVyiPz0 - - - "" - # -# -# ..... States .................................................................................................................... -# Define continuous (differentiable) states here: -# -typedef ^ ContinuousStateType SiKi DummyContState - - - "Remove this variable if you have continuous states" - -# -# -# Define discrete (nondifferentiable) states here: -# -typedef ^ DiscreteStateType SiKi DummyDiscState - - - "Remove this variable if you have discrete states" - -# -# -# Define constraint states here: -# -typedef ^ ConstraintStateType SiKi 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 continuous state integration and discrete state update" seconds -# -# -# ..... Inputs .................................................................................................................... -# Define inputs that are contained on the mesh here: -# -#typedef^ InputType MeshType MeshedInput - - - "Meshed input data" - -# Define inputs that are not on this mesh here: -typedef ^ InputType SiKi DummyInput - - - "Remove this variable if you have input data" - -# -# -# ..... 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 SiKi DummyOutput - - - "Remove this variable if you have output data" - \ No newline at end of file diff --git a/modules/seastate/src/Current_Types.f90 b/modules/seastate/src/Current_Types.f90 new file mode 100644 index 0000000000..3ed765adbd --- /dev/null +++ b/modules/seastate/src/Current_Types.f90 @@ -0,0 +1,236 @@ +!STARTOFREGISTRYGENERATEDFILE 'Current_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 +!********************************************************************************************************************************* +! Current_Types +!................................................................................................................................. +! This file is part of Current. +! +! 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 Current. 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 Current_Types +!--------------------------------------------------------------------------------------------------------------------------------- +USE NWTC_Library +IMPLICIT NONE +! ========= Current_InitInputType ======= + TYPE, PUBLIC :: Current_InitInputType + REAL(SiKi) :: CurrSSV0 = 0.0_R4Ki !< [-] + CHARACTER(80) :: CurrSSDirChr !< [-] + REAL(SiKi) :: CurrSSDir = 0.0_R4Ki !< [-] + REAL(SiKi) :: CurrNSRef = 0.0_R4Ki !< [-] + REAL(SiKi) :: CurrNSV0 = 0.0_R4Ki !< [-] + REAL(SiKi) :: CurrNSDir = 0.0_R4Ki !< [-] + REAL(SiKi) :: CurrDIV = 0.0_R4Ki !< [-] + REAL(SiKi) :: CurrDIDir = 0.0_R4Ki !< [-] + INTEGER(IntKi) :: CurrMod = 0_IntKi !< [-] + REAL(SiKi) :: EffWtrDpth = 0.0_R4Ki !< [-] + REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveKinGridzi !< [-] + INTEGER(IntKi) :: NGridPts = 0_IntKi !< [-] + CHARACTER(1024) :: DirRoot !< [-] + END TYPE Current_InitInputType +! ======================= +! ========= Current_InitOutputType ======= + TYPE, PUBLIC :: Current_InitOutputType + REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: CurrVxi !< [-] + REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: CurrVyi !< [-] + REAL(SiKi) :: PCurrVxiPz0 = 0.0_R4Ki !< [-] + REAL(SiKi) :: PCurrVyiPz0 = 0.0_R4Ki !< [-] + END TYPE Current_InitOutputType +! ======================= +CONTAINS + +subroutine Current_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) + type(Current_InitInputType), intent(in) :: SrcInitInputData + type(Current_InitInputType), intent(inout) :: DstInitInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'Current_CopyInitInput' + ErrStat = ErrID_None + ErrMsg = '' + DstInitInputData%CurrSSV0 = SrcInitInputData%CurrSSV0 + DstInitInputData%CurrSSDirChr = SrcInitInputData%CurrSSDirChr + DstInitInputData%CurrSSDir = SrcInitInputData%CurrSSDir + DstInitInputData%CurrNSRef = SrcInitInputData%CurrNSRef + DstInitInputData%CurrNSV0 = SrcInitInputData%CurrNSV0 + DstInitInputData%CurrNSDir = SrcInitInputData%CurrNSDir + DstInitInputData%CurrDIV = SrcInitInputData%CurrDIV + DstInitInputData%CurrDIDir = SrcInitInputData%CurrDIDir + DstInitInputData%CurrMod = SrcInitInputData%CurrMod + DstInitInputData%EffWtrDpth = SrcInitInputData%EffWtrDpth + if (allocated(SrcInitInputData%WaveKinGridzi)) then + LB(1:1) = lbound(SrcInitInputData%WaveKinGridzi) + UB(1:1) = ubound(SrcInitInputData%WaveKinGridzi) + if (.not. allocated(DstInitInputData%WaveKinGridzi)) then + allocate(DstInitInputData%WaveKinGridzi(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveKinGridzi.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%WaveKinGridzi = SrcInitInputData%WaveKinGridzi + end if + DstInitInputData%NGridPts = SrcInitInputData%NGridPts + DstInitInputData%DirRoot = SrcInitInputData%DirRoot +end subroutine + +subroutine Current_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(Current_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Current_DestroyInitInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InitInputData%WaveKinGridzi)) then + deallocate(InitInputData%WaveKinGridzi) + end if +end subroutine + +subroutine Current_PackInitInput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Current_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Current_PackInitInput' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%CurrSSV0) + call RegPack(RF, InData%CurrSSDirChr) + call RegPack(RF, InData%CurrSSDir) + call RegPack(RF, InData%CurrNSRef) + call RegPack(RF, InData%CurrNSV0) + call RegPack(RF, InData%CurrNSDir) + call RegPack(RF, InData%CurrDIV) + call RegPack(RF, InData%CurrDIDir) + call RegPack(RF, InData%CurrMod) + call RegPack(RF, InData%EffWtrDpth) + call RegPackAlloc(RF, InData%WaveKinGridzi) + call RegPack(RF, InData%NGridPts) + call RegPack(RF, InData%DirRoot) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Current_UnPackInitInput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Current_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Current_UnPackInitInput' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%CurrSSV0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CurrSSDirChr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CurrSSDir); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CurrNSRef); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CurrNSV0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CurrNSDir); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CurrDIV); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CurrDIDir); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CurrMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%EffWtrDpth); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WaveKinGridzi); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NGridPts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DirRoot); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Current_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) + type(Current_InitOutputType), intent(in) :: SrcInitOutputData + type(Current_InitOutputType), intent(inout) :: DstInitOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'Current_CopyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcInitOutputData%CurrVxi)) then + LB(1:1) = lbound(SrcInitOutputData%CurrVxi) + UB(1:1) = ubound(SrcInitOutputData%CurrVxi) + if (.not. allocated(DstInitOutputData%CurrVxi)) then + allocate(DstInitOutputData%CurrVxi(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%CurrVxi.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%CurrVxi = SrcInitOutputData%CurrVxi + end if + if (allocated(SrcInitOutputData%CurrVyi)) then + LB(1:1) = lbound(SrcInitOutputData%CurrVyi) + UB(1:1) = ubound(SrcInitOutputData%CurrVyi) + if (.not. allocated(DstInitOutputData%CurrVyi)) then + allocate(DstInitOutputData%CurrVyi(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%CurrVyi.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%CurrVyi = SrcInitOutputData%CurrVyi + end if + DstInitOutputData%PCurrVxiPz0 = SrcInitOutputData%PCurrVxiPz0 + DstInitOutputData%PCurrVyiPz0 = SrcInitOutputData%PCurrVyiPz0 +end subroutine + +subroutine Current_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(Current_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Current_DestroyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InitOutputData%CurrVxi)) then + deallocate(InitOutputData%CurrVxi) + end if + if (allocated(InitOutputData%CurrVyi)) then + deallocate(InitOutputData%CurrVyi) + end if +end subroutine + +subroutine Current_PackInitOutput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Current_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Current_PackInitOutput' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%CurrVxi) + call RegPackAlloc(RF, InData%CurrVyi) + call RegPack(RF, InData%PCurrVxiPz0) + call RegPack(RF, InData%PCurrVyiPz0) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Current_UnPackInitOutput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Current_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Current_UnPackInitOutput' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%CurrVxi); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%CurrVyi); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PCurrVxiPz0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PCurrVyiPz0); if (RegCheckErr(RF, RoutineName)) return +end subroutine +END MODULE Current_Types +!ENDOFREGISTRYGENERATEDFILE diff --git a/modules/seastate/src/SeaSt_WaveField.f90 b/modules/seastate/src/SeaSt_WaveField.f90 new file mode 100644 index 0000000000..0c1fb951e2 --- /dev/null +++ b/modules/seastate/src/SeaSt_WaveField.f90 @@ -0,0 +1,892 @@ +MODULE SeaSt_WaveField + +USE SeaSt_WaveField_Types + +IMPLICIT NONE + +PRIVATE + +! Public functions and subroutines +PUBLIC WaveField_GetNodeWaveElev1 +PUBLIC WaveField_GetNodeWaveElev2 +PUBLIC WaveField_GetNodeTotalWaveElev +PUBLIC WaveField_GetNodeWaveNormal +PUBLIC WaveField_GetNodeWaveKin +PUBLIC WaveField_GetNodeWaveVel + +PUBLIC WaveField_GetWaveKin + +public WaveField_Interp_Setup3D, WaveField_Interp_Setup4D + +CONTAINS + +!-------------------- Subroutine for wave elevation ------------------! +function WaveField_GetNodeWaveElev1( WaveField, WaveField_m, Time, pos, ErrStat, ErrMsg ) + type(SeaSt_WaveFieldType), intent(in ) :: WaveField + type(SeaSt_WaveField_MiscVarType), intent(inout) :: WaveField_m + real(DbKi), intent(in ) :: Time + real(ReKi), intent(in ) :: pos(*) ! Position at which free-surface elevation is to be calculated. Third entry ignored if present. + integer(IntKi), intent( out) :: ErrStat ! Error status of the operation + character(*), intent( out) :: ErrMsg ! Error message if errStat /= ErrID_None + + real(SiKi) :: WaveField_GetNodeWaveElev1 + real(SiKi) :: Zeta + character(*), parameter :: RoutineName = 'WaveField_GetNodeWaveElev1' + integer(IntKi) :: errStat2 + character(ErrMsgLen) :: errMsg2 + + ErrStat = ErrID_None + ErrMsg = "" + + IF (ALLOCATED(WaveField%WaveElev1)) THEN + CALL WaveField_Interp_Setup3D( Time, pos, WaveField%GridParams, WaveField_m, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + Zeta = WaveField_Interp_3D( WaveField%WaveElev1, WaveField_m ) + ELSE + Zeta = 0.0_SiKi + END IF + + WaveField_GetNodeWaveElev1 = Zeta + +end function WaveField_GetNodeWaveElev1 + + +function WaveField_GetNodeWaveElev2( WaveField, WaveField_m, Time, pos, ErrStat, ErrMsg ) + type(SeaSt_WaveFieldType), intent(in ) :: WaveField + type(SeaSt_WaveField_MiscVarType), intent(inout) :: WaveField_m + real(DbKi), intent(in ) :: Time + real(ReKi), intent(in ) :: pos(*) ! Position at which free-surface elevation is to be calculated. Third entry ignored if present. + integer(IntKi), intent( out) :: ErrStat ! Error status of the operation + character(*), intent( out) :: ErrMsg ! Error message if errStat /= ErrID_None + + real(SiKi) :: WaveField_GetNodeWaveElev2 + real(SiKi) :: Zeta + character(*), parameter :: RoutineName = 'WaveField_GetNodeWaveElev2' + integer(IntKi) :: errStat2 + character(ErrMsgLen) :: errMsg2 + + ErrStat = ErrID_None + ErrMsg = "" + + IF (ALLOCATED(WaveField%WaveElev2)) THEN + CALL WaveField_Interp_Setup3D( Time, pos, WaveField%GridParams, WaveField_m, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + Zeta = WaveField_Interp_3D( WaveField%WaveElev2, WaveField_m ) + ELSE + Zeta = 0.0_SiKi + END IF + + WaveField_GetNodeWaveElev2 = Zeta + +end function WaveField_GetNodeWaveElev2 + + +FUNCTION WaveField_GetNodeTotalWaveElev( WaveField, WaveField_m, Time, pos, ErrStat, ErrMsg ) + type(SeaSt_WaveFieldType), intent(in ) :: WaveField + type(SeaSt_WaveField_MiscVarType), intent(inout) :: WaveField_m + real(DbKi), intent(in ) :: Time + real(ReKi), intent(in ) :: pos(*) ! Position at which free-surface elevation is to be calculated. Third entry ignored if present. + integer(IntKi), intent( out) :: ErrStat ! Error status of the operation + character(*), intent( out) :: ErrMsg ! Error message if errStat /= ErrID_None + + real(SiKi) :: WaveField_GetNodeTotalWaveElev + real(SiKi) :: Zeta1, Zeta2 + character(*), parameter :: RoutineName = 'WaveField_GetNodeTotalWaveElev' + integer(IntKi) :: errStat2 + character(ErrMsgLen) :: errMsg2 + + ErrStat = ErrID_None + ErrMsg = "" + + Zeta1 = WaveField_GetNodeWaveElev1( WaveField, WaveField_m, Time, pos, ErrStat2, ErrMsg2 ); if (Failed()) return; + Zeta2 = WaveField_GetNodeWaveElev2( WaveField, WaveField_m, Time, pos, ErrStat2, ErrMsg2 ); if (Failed()) return; + WaveField_GetNodeTotalWaveElev = Zeta1 + Zeta2 + +contains + logical function Failed() + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + Failed = ErrStat >= AbortErrLev + end function +END FUNCTION WaveField_GetNodeTotalWaveElev + + +SUBROUTINE WaveField_GetNodeWaveNormal( WaveField, WaveField_m, Time, pos, r, n, ErrStat, ErrMsg ) + type(SeaSt_WaveFieldType), intent(in ) :: WaveField + type(SeaSt_WaveField_MiscVarType), intent(inout) :: WaveField_m + real(DbKi), intent(in ) :: Time + real(ReKi), intent(in ) :: pos(*) ! Position at which free-surface normal is to be calculated. Third entry ignored if present. + real(ReKi), intent(in ) :: r ! Distance for central differencing + real(ReKi), intent( out) :: n(3) ! Free-surface normal vector + integer(IntKi), intent( out) :: ErrStat ! Error status of the operation + character(*), intent( out) :: ErrMsg ! Error message if errStat /= ErrID_None + + real(SiKi) :: ZetaP,ZetaM + real(ReKi) :: r1,dZetadx,dZetady + character(*), parameter :: RoutineName = 'WaveField_GetNodeWaveNormal' + integer(IntKi) :: errStat2 + character(ErrMsgLen) :: errMsg2 + + ErrStat = ErrID_None + ErrMsg = "" + + r1 = MAX(r,real(1.0e-6,ReKi)) ! In case r is zero + + ZetaP = WaveField_GetNodeTotalWaveElev( WaveField, WaveField_m, Time, (/pos(1)+r1,pos(2)/), ErrStat2, ErrMsg2 ); if (Failed()) return; + ZetaM = WaveField_GetNodeTotalWaveElev( WaveField, WaveField_m, Time, (/pos(1)-r1,pos(2)/), ErrStat2, ErrMsg2 ); if (Failed()) return; + dZetadx = REAL(ZetaP-ZetaM,ReKi)/(2.0_ReKi*r1) + + ZetaP = WaveField_GetNodeTotalWaveElev( WaveField, WaveField_m, Time, (/pos(1),pos(2)+r1/), ErrStat2, ErrMsg2 ); if (Failed()) return; + ZetaM = WaveField_GetNodeTotalWaveElev( WaveField, WaveField_m, Time, (/pos(1),pos(2)-r1/), ErrStat2, ErrMsg2 ); if (Failed()) return; + dZetady = REAL(ZetaP-ZetaM,ReKi)/(2.0_ReKi*r1) + + n = (/-dZetadx,-dZetady,1.0_ReKi/) + n = n / SQRT(Dot_Product(n,n)) + +contains + logical function Failed() + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + Failed = ErrStat >= AbortErrLev + end function +END SUBROUTINE WaveField_GetNodeWaveNormal + + +!-------------------- Subroutine for full wave field kinematics --------------------! +SUBROUTINE WaveField_GetNodeWaveKin( WaveField, WaveField_m, Time, pos, forceNodeInWater, nodeInWater, WaveElev1, WaveElev2, WaveElev, FDynP, FV, FA, FAMCF, ErrStat, ErrMsg ) + type(SeaSt_WaveFieldType), intent(in ) :: WaveField + type(SeaSt_WaveField_MiscVarType), intent(inout) :: WaveField_m + real(DbKi), intent(in ) :: Time + real(ReKi), intent(in ) :: pos(3) + logical, intent(in ) :: forceNodeInWater + real(SiKi), intent( out) :: WaveElev1 + real(SiKi), intent( out) :: WaveElev2 + real(SiKi), intent( out) :: WaveElev + real(SiKi), intent( out) :: FV(3) + real(SiKi), intent( out) :: FA(3) + real(SiKi), intent( out) :: FAMCF(3) + real(SiKi), intent( out) :: FDynP + integer(IntKi), intent( out) :: nodeInWater + integer(IntKi), intent( out) :: ErrStat ! Error status of the operation + character(*), intent( out) :: ErrMsg ! Error message if errStat /= ErrID_None + + real(ReKi) :: posXY(2), posPrime(3), posXY0(3) + character(*), parameter :: RoutineName = 'WaveField_GetNodeWaveKin' + integer(IntKi) :: errStat2 + character(ErrMsgLen) :: errMsg2 + + ErrStat = ErrID_None + ErrMsg = "" + + posXY = pos(1:2) + posXY0 = (/pos(1),pos(2),0.0_ReKi/) + FAMCF(:) = 0.0 + + ! Wave elevation + WaveElev1 = WaveField_GetNodeWaveElev1( WaveField, WaveField_m, Time, pos, ErrStat2, ErrMsg2 ); if (Failed()) return; + WaveElev2 = WaveField_GetNodeWaveElev2( WaveField, WaveField_m, Time, pos, ErrStat2, ErrMsg2 ); if (Failed()) return; + WaveElev = WaveElev1 + WaveElev2 + + IF (WaveField%WaveStMod == 0) THEN ! No wave stretching + + IF ( pos(3) <= 0.0_ReKi) THEN ! Node is at or below the SWL + nodeInWater = 1_IntKi + ! Use location to obtain interpolated values of kinematics + CALL WaveField_Interp_Setup4D( Time, pos, WaveField%GridParams, WaveField_m, ErrStat2, ErrMsg2 ); if (Failed()) return; + FV(:) = WaveField_Interp_4D_Vec( WaveField%WaveVel, WaveField_m ) + FA(:) = WaveField_Interp_4D_Vec( WaveField%WaveAcc, WaveField_m ) + FDynP = WaveField_Interp_4D ( WaveField%WaveDynP, WaveField_m ) + IF ( ALLOCATED(WaveField%WaveAccMCF) ) THEN + FAMCF(:) = WaveField_Interp_4D_Vec( WaveField%WaveAccMCF, WaveField_m ) + END IF + ELSE ! Node is above the SWL + nodeInWater = 0_IntKi + FV(:) = 0.0 + FA(:) = 0.0 + FDynP = 0.0 + FAMCF(:) = 0.0 + END IF + + ELSE ! Wave stretching enabled + + IF ( (pos(3) <= WaveElev) .OR. forceNodeInWater ) THEN ! Node is submerged + + nodeInWater = 1_IntKi + + IF ( WaveField%WaveStMod < 3 ) THEN ! Vertical or extrapolated wave stretching + + IF ( pos(3) <= 0.0_SiKi) THEN ! Node is below the SWL - evaluate wave dynamics as usual + + ! Use location to obtain interpolated values of kinematics + CALL WaveField_Interp_Setup4D( Time, pos, WaveField%GridParams, WaveField_m, ErrStat2, ErrMsg2 ); if (Failed()) return; + FV(:) = WaveField_Interp_4D_Vec( WaveField%WaveVel, WaveField_m ) + FA(:) = WaveField_Interp_4D_Vec( WaveField%WaveAcc, WaveField_m ) + FDynP = WaveField_Interp_4D ( WaveField%WaveDynP, WaveField_m ) + IF ( ALLOCATED(WaveField%WaveAccMCF) ) THEN + FAMCF(:) = WaveField_Interp_4D_Vec( WaveField%WaveAccMCF, WaveField_m ) + END IF + + ELSE ! Node is above SWL - need wave stretching + + ! Vertical wave stretching + CALL WaveField_Interp_Setup4D( Time, posXY0, WaveField%GridParams, WaveField_m, ErrStat2, ErrMsg2 ); if (Failed()) return; + FV(:) = WaveField_Interp_4D_vec( WaveField%WaveVel, WaveField_m ) + FA(:) = WaveField_Interp_4D_vec( WaveField%WaveAcc, WaveField_m ) + FDynP = WaveField_Interp_4D ( WaveField%WaveDynP, WaveField_m ) + IF ( ALLOCATED(WaveField%WaveAccMCF) ) THEN + FAMCF(:) = WaveField_Interp_4D_vec( WaveField%WaveAccMCF, WaveField_m ) + END IF + + ! Extrapoled wave stretching + IF (WaveField%WaveStMod == 2) THEN + CALL WaveField_Interp_Setup3D( Time, posXY, WaveField%GridParams, WaveField_m, ErrStat2, ErrMsg2 ); if (Failed()) return; + FV(:) = FV(:) + WaveField_Interp_3D_vec( WaveField%PWaveVel0, WaveField_m ) * pos(3) + FA(:) = FA(:) + WaveField_Interp_3D_vec( WaveField%PWaveAcc0, WaveField_m ) * pos(3) + FDynP = FDynP + WaveField_Interp_3D ( WaveField%PWaveDynP0, WaveField_m ) * pos(3) + IF ( ALLOCATED(WaveField%WaveAccMCF) ) THEN + FAMCF(:) = FAMCF(:) + WaveField_Interp_3D_vec( WaveField%PWaveAccMCF0, WaveField_m ) * pos(3) + END IF + END IF + + END IF ! Node is submerged + + ELSE ! Wheeler stretching - no need to check whether the node is above or below SWL + + ! Map the node z-position linearly from [-EffWtrDpth,m%WaveElev(j)] to [-EffWtrDpth,0] + posPrime = pos + posPrime(3) = WaveField%EffWtrDpth*(WaveField%EffWtrDpth+pos(3))/(WaveField%EffWtrDpth+WaveElev)-WaveField%EffWtrDpth + posPrime(3) = MIN( posPrime(3), 0.0_ReKi) ! Clamp z-position to zero. Needed when forceNodeInWater=.TRUE. + + ! Obtain the wave-field variables by interpolation with the mapped position. + CALL WaveField_Interp_Setup4D( Time, posPrime, WaveField%GridParams, WaveField_m, ErrStat2, ErrMsg2 ); if (Failed()) return; + FV(:) = WaveField_Interp_4D_Vec( WaveField%WaveVel, WaveField_m ) + FA(:) = WaveField_Interp_4D_Vec( WaveField%WaveAcc, WaveField_m ) + FDynP = WaveField_Interp_4D ( WaveField%WaveDynP, WaveField_m ) + IF ( ALLOCATED(WaveField%WaveAccMCF) ) THEN + FAMCF(:) = WaveField_Interp_4D_Vec( WaveField%WaveAccMCF, WaveField_m ) + END IF + END IF + + ELSE ! Node is out of water - zero-out all wave dynamics + + nodeInWater = 0_IntKi + FV(:) = 0.0 + FA(:) = 0.0 + FDynP = 0.0 + FAMCF(:) = 0.0 + + END IF ! If node is in or out of water + + END IF ! If wave stretching is on or off + +contains + logical function Failed() + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + Failed = ErrStat >= AbortErrLev + end function +END SUBROUTINE WaveField_GetNodeWaveKin + + +!-------------------- Subroutine for wave field velocity only --------------------! +SUBROUTINE WaveField_GetNodeWaveVel( WaveField, WaveField_m, Time, pos, forceNodeInWater, nodeInWater, FV, ErrStat, ErrMsg ) + type(SeaSt_WaveFieldType), intent(in ) :: WaveField + type(SeaSt_WaveField_MiscVarType), intent(inout) :: WaveField_m + real(DbKi), intent(in ) :: Time + real(ReKi), intent(in ) :: pos(3) + logical, intent(in ) :: forceNodeInWater + integer(IntKi), intent( out) :: nodeInWater + real(SiKi), intent( out) :: FV(3) + integer(IntKi), intent( out) :: ErrStat ! Error status of the operation + character(*), intent( out) :: ErrMsg ! Error message if errStat /= ErrID_None + + real(SiKi) :: WaveElev + real(ReKi) :: posXY(2), posPrime(3), posXY0(3) + character(*), parameter :: RoutineName = 'WaveField_GetNodeWaveVel' + integer(IntKi) :: errStat2 + character(ErrMsgLen) :: errMsg2 + + ErrStat = ErrID_None + ErrMsg = "" + + posXY = pos(1:2) + posXY0 = (/pos(1),pos(2),0.0_ReKi/) + + ! Wave elevation + WaveElev = WaveField_GetNodeTotalWaveElev( WaveField, WaveField_m, Time, pos, ErrStat2, ErrMsg2 ); if (Failed()) return; + + IF (WaveField%WaveStMod == 0) THEN ! No wave stretching + + IF ( pos(3) <= 0.0_ReKi) THEN ! Node is at or below the SWL + nodeInWater = 1_IntKi + ! Use location to obtain interpolated values of kinematics + CALL WaveField_Interp_Setup4D( Time, pos, WaveField%GridParams, WaveField_m, ErrStat2, ErrMsg2 ); if (Failed()) return; + FV(:) = WaveField_Interp_4D_Vec( WaveField%WaveVel, WaveField_m ) + ELSE ! Node is above the SWL + nodeInWater = 0_IntKi + FV(:) = 0.0 + END IF + + ELSE ! Wave stretching enabled + + IF ( (pos(3) <= WaveElev) .OR. forceNodeInWater ) THEN ! Node is submerged + + nodeInWater = 1_IntKi + + IF ( WaveField%WaveStMod < 3 ) THEN ! Vertical or extrapolated wave stretching + + IF ( pos(3) <= 0.0_SiKi) THEN ! Node is below the SWL - evaluate wave dynamics as usual + + ! Use location to obtain interpolated values of kinematics + CALL WaveField_Interp_Setup4D( Time, pos, WaveField%GridParams, WaveField_m, ErrStat2, ErrMsg2 ); if (Failed()) return; + FV(:) = WaveField_Interp_4D_Vec( WaveField%WaveVel, WaveField_m ) + + ELSE ! Node is above SWL - need wave stretching + + ! Vertical wave stretching + CALL WaveField_Interp_Setup4D( Time, posXY0, WaveField%GridParams, WaveField_m, ErrStat2, ErrMsg2 ); if (Failed()) return; + FV(:) = WaveField_Interp_4D_vec( WaveField%WaveVel, WaveField_m ) + + ! Extrapoled wave stretching + IF (WaveField%WaveStMod == 2) THEN + CALL WaveField_Interp_Setup3D( Time, posXY, WaveField%GridParams, WaveField_m, ErrStat2, ErrMsg2 ); if (Failed()) return; + FV(:) = FV(:) + WaveField_Interp_3D_vec( WaveField%PWaveVel0, WaveField_m ) * pos(3) + END IF + + END IF ! Node is submerged + + ELSE ! Wheeler stretching - no need to check whether the node is above or below SWL + + ! Map the node z-position linearly from [-EffWtrDpth,m%WaveElev(j)] to [-EffWtrDpth,0] + posPrime = pos + posPrime(3) = WaveField%EffWtrDpth*(WaveField%EffWtrDpth+pos(3))/(WaveField%EffWtrDpth+WaveElev)-WaveField%EffWtrDpth + posPrime(3) = MIN( posPrime(3), 0.0_ReKi) ! Clamp z-position to zero. Needed when forceNodeInWater=.TRUE. + + ! Obtain the wave-field variables by interpolation with the mapped position. + CALL WaveField_Interp_Setup4D( Time, posPrime, WaveField%GridParams, WaveField_m, ErrStat2, ErrMsg2 ); if (Failed()) return; + FV(:) = WaveField_Interp_4D_Vec( WaveField%WaveVel, WaveField_m ) + + END IF + + ELSE ! Node is out of water - zero-out all wave dynamics + + nodeInWater = 0_IntKi + FV(:) = 0.0 + + END IF ! If node is in or out of water + + END IF ! If wave stretching is on or off + +contains + logical function Failed() + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + Failed = ErrStat >= AbortErrLev + end function +END SUBROUTINE WaveField_GetNodeWaveVel + + +SUBROUTINE WaveField_GetWaveKin( WaveField, WaveField_m, Time, pos, forceNodeInWater, nodeInWater, WaveElev1, WaveElev2, WaveElev, FDynP, FV, FA, FAMCF, ErrStat, ErrMsg ) + type(SeaSt_WaveFieldType), intent(in ) :: WaveField + type(SeaSt_WaveField_MiscVarType), intent(inout) :: WaveField_m + real(DbKi), intent(in ) :: Time + real(ReKi), intent(in ) :: pos(:,:) + logical, intent(in ) :: forceNodeInWater + real(SiKi), intent( out) :: WaveElev1(:) + real(SiKi), intent( out) :: WaveElev2(:) + real(SiKi), intent( out) :: WaveElev(:) + real(ReKi), intent( out) :: FV(:,:) + real(ReKi), intent( out) :: FA(:,:) + real(ReKi), intent( out) :: FAMCF(:,:) + real(ReKi), intent( out) :: FDynP(:) + integer(IntKi), intent( out) :: nodeInWater(:) + integer(IntKi), intent( out) :: ErrStat ! Error status of the operation + character(*), intent( out) :: ErrMsg ! Error message if errStat /= ErrID_None + + character(*), parameter :: RoutineName = 'WaveField_GetWaveKin' + integer(IntKi) :: errStat2 + character(ErrMsgLen) :: errMsg2 + + integer(IntKi) :: NumPoints, i + real(SiKi) :: FDynP_node, FV_node(3), FA_node(3), FAMCF_node(3) + + ErrStat = ErrID_None + ErrMsg = "" + + NumPoints = size(pos, dim=2) + DO i = 1, NumPoints + CALL WaveField_GetNodeWaveKin( WaveField, WaveField_m, Time, pos(:,i), forceNodeInWater, nodeInWater(i), WaveElev1(i), WaveElev2(i), WaveElev(i), FDynP_node, FV_node, FA_node, FAMCF_node, ErrStat2, ErrMsg2 ) + if (Failed()) return; + FDynP(i) = REAL(FDynP_node,ReKi) + FV(:, i) = REAL(FV_node, ReKi) + FA(:, i) = REAL(FA_node, ReKi) + IF (ALLOCATED(WaveField%WaveAccMCF)) THEN + FAMCF(:,i) = REAL(FAMCF_node,ReKi) + END IF + END DO + +contains + logical function Failed() + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + Failed = ErrStat >= AbortErrLev + end function +end subroutine WaveField_GetWaveKin + + +!---------------------------------------------------------------------------------------------------- +! Interpolation related functions +!---------------------------------------------------------------------------------------------------- + +subroutine SetCartesianXYIndex(p, pZero, delta, nMax, Indx_Lo, Indx_Hi, isopc, FirstWarn, ErrStat, ErrMsg) + REAL(ReKi), intent(in ) :: p + REAL(ReKi), intent(in ) :: pZero + REAL(ReKi), intent(in ) :: delta + INTEGER(IntKi), intent(in ) :: nMax + INTEGER(IntKi), intent(inout) :: Indx_Lo + INTEGER(IntKi), intent(inout) :: Indx_Hi + real(SiKi), intent(inout) :: isopc + logical, intent(inout) :: FirstWarn + INTEGER(IntKi), intent( out) :: ErrStat + CHARACTER(*), intent( out) :: ErrMsg + + real(ReKi) :: Tmp + + ErrStat = ErrID_None + ErrMsg = "" + + isopc = -1.0 + Indx_Lo = 0 + Indx_Hi = 0 + + if ( nMax .EQ. 1_IntKi ) then ! Only one grid point + Indx_Lo = 1_IntKi + Indx_Hi = 1_IntKi + isopc = 0_SiKi + return + end if + + Tmp = (p-pZero) / delta + Indx_Lo = INT( Tmp ) + 1 ! convert REAL to INTEGER, then add one since our grid indices start at 1, not 0 + isopc = 2.0_ReKi * (Tmp - REAL(Indx_Lo - 1, ReKi)) - 1.0_ReKi ! convert to value between -1 and 1 + + if ( Indx_Lo < 1 ) then + Indx_Lo = 1 + isopc = -1.0 + if (FirstWarn) then + call SetErrStat(ErrID_Warn,'Position has been clamped to the grid boundary. Warning will not be repeated though condition may persist.',ErrStat,ErrMsg,'SetCartesianXYIndex') !error out if time is outside the lower bounds + FirstWarn = .false. + end if + end if + + Indx_Hi = min( Indx_Lo + 1, nMax ) ! make sure it's a valid index, zero-based + + if ( Indx_Lo >= Indx_Hi ) then + ! Need to clamp to grid boundary + if (FirstWarn .and. Indx_Lo /= Indx_Hi) then ! don't warn if we are exactly at the boundary + call SetErrStat(ErrID_Warn,'Position has been clamped to the grid boundary. Warning will not be repeated though condition may persist.',ErrStat,ErrMsg,'SetCartesianXYIndex') !error out if time is outside the lower bounds + FirstWarn = .false. + end if + Indx_Lo = max(Indx_Hi - 1, 1) + isopc = 1.0 + end if + + !------------------------------------------------------------------------------------------------- + ! to verify that we don't extrapolate, make sure isopc is bound between -1 and 1 (effectively nearest neighbor) + !------------------------------------------------------------------------------------------------- + isopc = min( 1.0_SiKi, isopc ) + isopc = max(-1.0_SiKi, isopc ) + +end subroutine SetCartesianXYIndex + + +subroutine SetCartesianZIndex(p, z_depth, delta, nMax, Indx_Lo, Indx_Hi, isopc, FirstWarn, ErrStat, ErrMsg) + real(ReKi), intent(in ) :: p + real(ReKi), intent(in ) :: z_depth + real(ReKi), intent(in ) :: delta + integer(IntKi), intent(in ) :: nMax + integer(IntKi), intent(inout) :: Indx_Lo + integer(IntKi), intent(inout) :: Indx_Hi + real(SiKi), intent(inout) :: isopc + logical, intent(inout) :: FirstWarn + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + + real(ReKi) :: Tmp + + ErrStat = ErrID_None + ErrMsg = "" + + isopc = -1.0 + Indx_Lo = 0 + Indx_Hi = 0 + + + !Tmp = acos(-p / z_depth) / delta + Tmp = acos( max(-1.0_ReKi, min(1.0_ReKi, 1+(p / z_depth)) ) ) / delta + Tmp = nmax - 1 - Tmp + Indx_Lo = INT( Tmp ) + 1 ! convert REAL to INTEGER, then add one since our grid indices start at 1, not 0 + isopc = 2.0_ReKi * (Tmp - REAL(Indx_Lo - 1, ReKi)) - 1.0_ReKi ! convert to value between -1 and 1 + + if ( Indx_Lo < 1 ) then + Indx_Lo = 1 + isopc = -1.0 + if (FirstWarn) then + call SetErrStat(ErrID_Warn,'Position has been clamped to the grid boundary. Warning will not be repeated though condition may persist.',ErrStat,ErrMsg,'SetCartesianZIndex') !error out if z is outside the lower bounds + FirstWarn = .false. + end if + end if + + Indx_Hi = min( Indx_Lo + 1, nMax ) ! make sure it's a valid index, one-based + + if ( Indx_Lo >= Indx_Hi ) then + ! Need to clamp to grid boundary + if (FirstWarn .and. Indx_Lo /= Indx_Hi) then ! don't warn if we are exactly at the boundary + call SetErrStat(ErrID_Warn,'Position has been clamped to the grid boundary. Warning will not be repeated though condition may persist.',ErrStat,ErrMsg,'SetCartesianZIndex') !error out if z is outside the upper bounds + FirstWarn = .false. + end if + Indx_Lo = max(Indx_Hi - 1, 1) + isopc = 1.0 + end if + + !------------------------------------------------------------------------------------------------- + ! to verify that we don't extrapolate, make sure isopc is bound between -1 and 1 (effectively nearest neighbor) + !------------------------------------------------------------------------------------------------- + isopc = min( 1.0_SiKi, isopc ) + isopc = max(-1.0_SiKi, isopc ) + +end subroutine SetCartesianZIndex + + +subroutine SetTimeIndex(Time, deltaT, nMax, Indx_Lo, Indx_Hi, isopc, ErrStat, ErrMsg) + real(DbKi), intent(in ) :: Time !< time from the start of the simulation + real(ReKi), intent(in ) :: deltaT + integer(IntKi), intent(in ) :: nMax + integer(IntKi), intent(inout) :: Indx_Lo + integer(IntKi), intent(inout) :: Indx_Hi + real(SiKi), intent(inout) :: isopc + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + + real(ReKi) :: Tmp + + ErrStat = ErrID_None + ErrMsg = "" + + isopc = -1.0 + Indx_Lo = 0 + Indx_Hi = 0 + if ( Time < 0.0_DbKi ) then + CALL SetErrStat(ErrID_Fatal,'Time value must be greater than or equal to zero!',ErrStat,ErrMsg,'SetTimeIndex') !error out if time is outside the lower bounds + RETURN + end if + + ! if there are no timesteps, don't proceed + if (EqualRealNos(deltaT,0.0_ReKi) .or. deltaT < 0.0_ReKi) return; + +! NOTE: nMax is the total number of time values in the grid, since this is zero-based indexing, the max index is nMax-1 +! for example: in a time grid with 11 grid points, the indices run from 0,1,2,3,4,5,6,7,8,9,10 +! for the repeating waves feature, index 10 is the same as index 0, so if Indx_Lo = 10 then we want to +! wrap it back to index 0, if Indx_Lo = 11 we want to wrap back to index 1. + + Tmp = real( (Time/ real(deltaT,DbKi)) ,ReKi) + Tmp = MOD(Tmp,real((nMax), ReKi)) + Indx_Lo = INT( Tmp ) ! convert REAL to INTEGER + + isopc = 2.0_ReKi * (Tmp - REAL(Indx_Lo , ReKi)) - 1.0_ReKi ! convert to value between -1 and 1 + + !------------------------------------------------------------------------------------------------- + ! to verify that we don't extrapolate, make sure isopc is bound between -1 and 1 (effectively nearest neighbor) + !------------------------------------------------------------------------------------------------- + isopc = min( 1.0_SiKi, isopc ) + isopc = max(-1.0_SiKi, isopc ) + + Indx_Hi = min( Indx_Lo + 1, nMax ) ! make sure it's a valid index, zero-based + +end subroutine SetTimeIndex + + +!==================================================================================================== +!> This routine sets up interpolation of a 3-d or 4-d dataset. +!! This method is described here: http://rjwagner49.com/Mathematics/Interpolation.pdf +subroutine WaveField_Interp_Setup4D( Time, Position, p, m, ErrStat, ErrMsg ) + real(DbKi), intent(in ) :: Time !< time from the start of the simulation + real(ReKi), intent(in ) :: Position(3) !< Array of XYZ coordinates, 3 + type(SeaSt_WaveField_ParameterType), intent(in ) :: p !< Parameters + type(SeaSt_WaveField_MiscVarType), intent(inout) :: m !< MiscVars + integer(IntKi), intent( out) :: ErrStat !< Error status + character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + + character(*), parameter :: RoutineName = 'WaveField_Interp_Setup4D' + integer(IntKi) :: i + real(SiKi) :: isopc(4) ! isoparametric coordinates + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + + ErrStat = ErrID_None + ErrMsg = "" + + ! Find the bounding indices for time + call SetTimeIndex(Time, p%delta(1), p%n(1), m%Indx_Lo(1), m%Indx_Hi(1), isopc(1), ErrStat2, ErrMsg2) + if (Failed()) return; + + ! Find the bounding indices for XY position + do i=2,3 ! x and y components + call SetCartesianXYIndex(Position(i-1), p%pZero(i), p%delta(i), p%n(i), m%Indx_Lo(i), m%Indx_Hi(i), isopc(i), m%FirstWarn_Clamp, ErrStat2, ErrMsg2) + if (Failed()) return; + enddo + + ! Find the bounding indices for Z position + i=4 ! z component + if (p%Z_Depth>0) then + call SetCartesianZIndex(Position(i-1), p%Z_Depth, p%delta(i), p%n(i), m%Indx_Lo(i), m%Indx_Hi(i), isopc(i), m%FirstWarn_Clamp, ErrStat2, ErrMsg2) + if (Failed()) return; + else ! Regular z-grid + call SetCartesianXYIndex(Position(i-1), p%pZero(i), p%delta(i), p%n(i), m%Indx_Lo(i), m%Indx_Hi(i), isopc(i), m%FirstWarn_Clamp, ErrStat2, ErrMsg2) + if (Failed()) return; + end if + + ! compute weighting factors + m%N4D( 1) = ( 1.0_SiKi - isopc(1) ) * ( 1.0_SiKi - isopc(2) ) * ( 1.0_SiKi - isopc(3) ) * ( 1.0_SiKi - isopc(4) ) + m%N4D( 2) = ( 1.0_SiKi - isopc(1) ) * ( 1.0_SiKi - isopc(2) ) * ( 1.0_SiKi - isopc(3) ) * ( 1.0_SiKi + isopc(4) ) + m%N4D( 3) = ( 1.0_SiKi - isopc(1) ) * ( 1.0_SiKi - isopc(2) ) * ( 1.0_SiKi + isopc(3) ) * ( 1.0_SiKi - isopc(4) ) + m%N4D( 4) = ( 1.0_SiKi - isopc(1) ) * ( 1.0_SiKi - isopc(2) ) * ( 1.0_SiKi + isopc(3) ) * ( 1.0_SiKi + isopc(4) ) + m%N4D( 5) = ( 1.0_SiKi - isopc(1) ) * ( 1.0_SiKi + isopc(2) ) * ( 1.0_SiKi - isopc(3) ) * ( 1.0_SiKi - isopc(4) ) + m%N4D( 6) = ( 1.0_SiKi - isopc(1) ) * ( 1.0_SiKi + isopc(2) ) * ( 1.0_SiKi - isopc(3) ) * ( 1.0_SiKi + isopc(4) ) + m%N4D( 7) = ( 1.0_SiKi - isopc(1) ) * ( 1.0_SiKi + isopc(2) ) * ( 1.0_SiKi + isopc(3) ) * ( 1.0_SiKi - isopc(4) ) + m%N4D( 8) = ( 1.0_SiKi - isopc(1) ) * ( 1.0_SiKi + isopc(2) ) * ( 1.0_SiKi + isopc(3) ) * ( 1.0_SiKi + isopc(4) ) + m%N4D( 9) = ( 1.0_SiKi + isopc(1) ) * ( 1.0_SiKi - isopc(2) ) * ( 1.0_SiKi - isopc(3) ) * ( 1.0_SiKi - isopc(4) ) + m%N4D(10) = ( 1.0_SiKi + isopc(1) ) * ( 1.0_SiKi - isopc(2) ) * ( 1.0_SiKi - isopc(3) ) * ( 1.0_SiKi + isopc(4) ) + m%N4D(11) = ( 1.0_SiKi + isopc(1) ) * ( 1.0_SiKi - isopc(2) ) * ( 1.0_SiKi + isopc(3) ) * ( 1.0_SiKi - isopc(4) ) + m%N4D(12) = ( 1.0_SiKi + isopc(1) ) * ( 1.0_SiKi - isopc(2) ) * ( 1.0_SiKi + isopc(3) ) * ( 1.0_SiKi + isopc(4) ) + m%N4D(13) = ( 1.0_SiKi + isopc(1) ) * ( 1.0_SiKi + isopc(2) ) * ( 1.0_SiKi - isopc(3) ) * ( 1.0_SiKi - isopc(4) ) + m%N4D(14) = ( 1.0_SiKi + isopc(1) ) * ( 1.0_SiKi + isopc(2) ) * ( 1.0_SiKi - isopc(3) ) * ( 1.0_SiKi + isopc(4) ) + m%N4D(15) = ( 1.0_SiKi + isopc(1) ) * ( 1.0_SiKi + isopc(2) ) * ( 1.0_SiKi + isopc(3) ) * ( 1.0_SiKi - isopc(4) ) + m%N4D(16) = ( 1.0_SiKi + isopc(1) ) * ( 1.0_SiKi + isopc(2) ) * ( 1.0_SiKi + isopc(3) ) * ( 1.0_SiKi + isopc(4) ) + m%N4D = m%N4D / REAL( SIZE(m%N4D), SiKi ) ! normalize + +contains + logical function Failed() + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + Failed = ErrStat >= AbortErrLev + end function +END Subroutine WaveField_Interp_Setup4D + + +subroutine WaveField_Interp_Setup3D( Time, Position, p, m, ErrStat, ErrMsg ) + real(DbKi), intent(in ) :: Time !< time from the start of the simulation + real(ReKi), intent(in ) :: Position(2) !< Array of XYZ coordinates, 3 + type(SeaSt_WaveField_ParameterType), intent(in ) :: p !< Parameters + type(SeaSt_WaveField_MiscVarType), intent(inout) :: m !< MiscVars + integer(IntKi), intent( out) :: ErrStat !< Error status + character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + character(*), parameter :: RoutineName = 'WaveField_Interp_Setup3D' + integer(IntKi) :: i + real(SiKi) :: isopc(4) ! isoparametric coordinates + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + + ErrStat = ErrID_None + ErrMsg = "" + + ! Find the bounding indices for time + call SetTimeIndex(Time, p%delta(1), p%n(1), m%Indx_Lo(1), m%Indx_Hi(1), isopc(1), ErrStat2, ErrMsg2) + if (Failed()) return; + + ! Find the bounding indices for XY position + do i=2,3 ! x and y components + call SetCartesianXYIndex(Position(i-1), p%pZero(i), p%delta(i), p%n(i), m%Indx_Lo(i), m%Indx_Hi(i), isopc(i), m%FirstWarn_Clamp, ErrStat2, ErrMsg2) + if (Failed()) return; + enddo + + ! compute weighting factors + m%N3D(1) = ( 1.0_ReKi + isopc(1) )*( 1.0_ReKi - isopc(2) )*( 1.0_ReKi - isopc(3) ) + m%N3D(2) = ( 1.0_ReKi + isopc(1) )*( 1.0_ReKi + isopc(2) )*( 1.0_ReKi - isopc(3) ) + m%N3D(3) = ( 1.0_ReKi - isopc(1) )*( 1.0_ReKi + isopc(2) )*( 1.0_ReKi - isopc(3) ) + m%N3D(4) = ( 1.0_ReKi - isopc(1) )*( 1.0_ReKi - isopc(2) )*( 1.0_ReKi - isopc(3) ) + m%N3D(5) = ( 1.0_ReKi + isopc(1) )*( 1.0_ReKi - isopc(2) )*( 1.0_ReKi + isopc(3) ) + m%N3D(6) = ( 1.0_ReKi + isopc(1) )*( 1.0_ReKi + isopc(2) )*( 1.0_ReKi + isopc(3) ) + m%N3D(7) = ( 1.0_ReKi - isopc(1) )*( 1.0_ReKi + isopc(2) )*( 1.0_ReKi + isopc(3) ) + m%N3D(8) = ( 1.0_ReKi - isopc(1) )*( 1.0_ReKi - isopc(2) )*( 1.0_ReKi + isopc(3) ) + m%N3D = m%N3D / REAL( SIZE(m%N3D), ReKi ) ! normalize + +contains + logical function Failed() + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + Failed = ErrStat >= AbortErrLev + end function +END Subroutine WaveField_Interp_Setup3D + + +!==================================================================================================== +!> This routine interpolates a 4-d dataset. +!! This method is described here: http://rjwagner49.com/Mathematics/WaveFieldolation.pdf +function WaveField_Interp_4D( pKinXX, m ) + real(SiKi), intent(in ) :: pKinXX(0:,:,:,:) + type(SeaSt_WaveField_MiscVarType), intent(in ) :: m + + real(SiKi) :: WaveField_Interp_4D + real(SiKi) :: u(16) ! size 2^n + + ! interpolate + u( 1) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Lo(4) ) + u( 2) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Hi(4) ) + u( 3) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Lo(4) ) + u( 4) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Hi(4) ) + u( 5) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Lo(4) ) + u( 6) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Hi(4) ) + u( 7) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Lo(4) ) + u( 8) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Hi(4) ) + u( 9) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Lo(4) ) + u(10) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Hi(4) ) + u(11) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Lo(4) ) + u(12) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Hi(4) ) + u(13) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Lo(4) ) + u(14) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Hi(4) ) + u(15) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Lo(4) ) + u(16) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Hi(4) ) + WaveField_Interp_4D = SUM ( m%N4D * u ) +end function WaveField_Interp_4D + + +!==================================================================================================== +!> This routine interpolates a 4-d dataset. +!! This method is described here: http://rjwagner49.com/Mathematics/Interpolation.pdf +function WaveField_Interp_4D_Vec( pKinXX, m) + real(SiKi), intent(in ) :: pKinXX(0:,:,:,:,:) + type(SeaSt_WaveField_MiscVarType), intent(in ) :: m !< misc vars for interpolation + + real(SiKi) :: WaveField_Interp_4D_Vec(3) + real(SiKi) :: u(16) ! size 2^n + integer(IntKi) :: iDir + + ! interpolate + do iDir = 1,3 + u( 1) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Lo(4), iDir ) + u( 2) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Hi(4), iDir ) + u( 3) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Lo(4), iDir ) + u( 4) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Hi(4), iDir ) + u( 5) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Lo(4), iDir ) + u( 6) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Hi(4), iDir ) + u( 7) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Lo(4), iDir ) + u( 8) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Hi(4), iDir ) + u( 9) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Lo(4), iDir ) + u(10) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Hi(4), iDir ) + u(11) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Lo(4), iDir ) + u(12) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Hi(4), iDir ) + u(13) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Lo(4), iDir ) + u(14) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Hi(4), iDir ) + u(15) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Lo(4), iDir ) + u(16) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Hi(4), iDir ) + WaveField_Interp_4D_Vec(iDir) = SUM ( m%N4D * u ) + end do +END FUNCTION WaveField_Interp_4D_Vec + + +!==================================================================================================== +!> This routine interpolates a 4-d dataset. +!! This method is described here: http://rjwagner49.com/Mathematics/Interpolation.pdf +function WaveField_Interp_4D_Vec6( pKinXX, m) + real(SiKi), intent(in ) :: pKinXX(0:,:,:,:,:) + type(SeaSt_WaveField_MiscVarType), intent(in ) :: m !< misc vars for interpolation + + real(SiKi) :: WaveField_Interp_4D_Vec6(6) + real(SiKi) :: u(16) ! size 2^n + integer(IntKi) :: iDir + + ! interpolate + do iDir = 1,6 + u( 1) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Lo(4), iDir ) + u( 2) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Hi(4), iDir ) + u( 3) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Lo(4), iDir ) + u( 4) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Hi(4), iDir ) + u( 5) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Lo(4), iDir ) + u( 6) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Hi(4), iDir ) + u( 7) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Lo(4), iDir ) + u( 8) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Hi(4), iDir ) + u( 9) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Lo(4), iDir ) + u(10) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Hi(4), iDir ) + u(11) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Lo(4), iDir ) + u(12) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Hi(4), iDir ) + u(13) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Lo(4), iDir ) + u(14) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Hi(4), iDir ) + u(15) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Lo(4), iDir ) + u(16) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Hi(4), iDir ) + WaveField_Interp_4D_Vec6(iDir) = SUM ( m%N4D * u ) + end do +END FUNCTION WaveField_Interp_4D_Vec6 + + +!==================================================================================================== +!> This routine interpolates a 3-d dataset with index 1 = time (zero-based indexing), 2 = x-coordinate (1-based indexing), 3 = y-coordinate (1-based indexing) +!! This method is described here: http://rjwagner49.com/Mathematics/Interpolation.pdf +!FIXME: do like the above and call the WaveField_Interp_Setup3D routine ahead +function WaveField_Interp_3D( pKinXX, m ) + real(SiKi), intent(in ) :: pKinXX(0:,:,:) !< 3D Wave elevation data (SiKi for storage space reasons) + type(SeaSt_WaveField_MiscVarType), intent(inout) :: m !< MiscVars + + character(*), parameter :: RoutineName = 'WaveField_Interp_3D' + real(SiKi) :: WaveField_Interp_3D + real(SiKi) :: u(8) + integer(IntKi) :: i + + ! interpolate + u(1) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Lo(3) ) + u(2) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Lo(3) ) + u(3) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Lo(3) ) + u(4) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Lo(3) ) + u(5) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Hi(3) ) + u(6) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Hi(3) ) + u(7) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Hi(3) ) + u(8) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Hi(3) ) + WaveField_Interp_3D = SUM ( m%N3D * u ) +end function WaveField_Interp_3D + + +FUNCTION WaveField_Interp_3D_VEC( pKinXX, m ) + real(SiKi), intent(in ) :: pKinXX(0:,:,:,:) !< 3D Wave excitation data (SiKi for storage space reasons) + type(SeaSt_WaveField_MiscVarType), intent(inout) :: m !< MiscVars + + character(*), parameter :: RoutineName = 'WaveField_Interp_3D_VEC' + real(SiKi) :: WaveField_Interp_3D_VEC(3) + real(SiKi) :: u(8) + integer(IntKi) :: i + + ! interpolate + do i = 1,3 + u(1) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Lo(3), i ) + u(2) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Lo(3), i ) + u(3) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Lo(3), i ) + u(4) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Lo(3), i ) + u(5) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Hi(3), i ) + u(6) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Hi(3), i ) + u(7) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Hi(3), i ) + u(8) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Hi(3), i ) + WaveField_Interp_3D_VEC(i) = SUM ( m%N3D * u ) + end do +end function WaveField_Interp_3D_VEC + + +function Wavefield_Interp_3D_VEC6( pKinXX, m ) + real(SiKi), intent(in ) :: pKinXX(0:,:,:,:) !< 3D Wave excitation data (SiKi for storage space reasons) + type(SeaSt_WaveField_MiscVarType), intent(inout) :: m !< Miscvars + + character(*), parameter :: RoutineName = 'Wavefield_Interp_3D_VEC6' + real(SiKi) :: Wavefield_Interp_3D_VEC6(6) + real(SiKi) :: u(8) + integer(IntKi) :: i + + ! interpolate + do i = 1,6 + u(1) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Lo(3), i ) + u(2) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Lo(3), i ) + u(3) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Lo(3), i ) + u(4) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Lo(3), i ) + u(5) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Hi(3), i ) + u(6) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Hi(3), i ) + u(7) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Hi(3), i ) + u(8) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Hi(3), i ) + Wavefield_Interp_3D_VEC6(i) = SUM ( m%N3D * u ) + end do +end function Wavefield_Interp_3D_VEC6 + + + +END MODULE SeaSt_WaveField diff --git a/modules/seastate/src/SeaSt_WaveField.txt b/modules/seastate/src/SeaSt_WaveField.txt new file mode 100644 index 0000000000..f5730bc868 --- /dev/null +++ b/modules/seastate/src/SeaSt_WaveField.txt @@ -0,0 +1,74 @@ +#--------------------------------------------------------------------------------------------------------------------------------------------------------- +# Data structures for representing wave fields. +# +param SeaSt_WaveField - INTEGER WaveDirMod_None - 0 - "WaveDirMod = 0 [Directional spreading function is NONE]" - +param SeaSt_WaveField - INTEGER WaveDirMod_COS2S - 1 - "WaveDirMod = 1 [Directional spreading function is COS2S]" - + +param SeaSt_WaveField - INTEGER WaveMod_None - 0 - "WaveMod = 0 [Incident wave kinematics model: NONE (still water)]" - +param SeaSt_WaveField - INTEGER WaveMod_Regular - 1 - "WaveMod = 1 [Incident wave kinematics model: Regular (periodic)]" - +param SeaSt_WaveField - INTEGER WaveMod_RegularUsrPh - 10 - "WaveMod = 1P# [Incident wave kinematics model: Regular (user specified phase)]" - +param SeaSt_WaveField - INTEGER WaveMod_JONSWAP - 2 - "WaveMod = 2 [Incident wave kinematics model: JONSWAP/Pierson-Moskowitz spectrum (irregular)]" - +param SeaSt_WaveField - INTEGER WaveMod_WhiteNoise - 3 - "WaveMod = 3 [Incident wave kinematics model: White noise spectrum (irregular)]" - +param SeaSt_WaveField - INTEGER WaveMod_UserSpctrm - 4 - "WaveMod = 4 [Incident wave kinematics model: user-defined spectrum from routine UserWaveSpctrm (irregular)]" - +param SeaSt_WaveField - INTEGER WaveMod_ExtElev - 5 - "WaveMod = 5 [Incident wave kinematics model: Externally generated wave-elevation time series]" - +param SeaSt_WaveField - INTEGER WaveMod_ExtFull - 6 - "WaveMod = 6 [Incident wave kinematics model: Externally generated full wave-kinematics time series (invalid for PotMod/=0)]" - +param SeaSt_WaveField - INTEGER WaveMod_UserFreq - 7 - "WaveMod = 7 [Incident wave kinematics model: user-defined wave frequency components]" - + +param SeaSt_WaveField - INTEGER ConstWaveMod_None - 0 - "ConstWaveMod = 0 [Constrained wave model: No constrained waves]" - +param SeaSt_WaveField - INTEGER ConstWaveMod_CrestElev - 1 - "ConstWaveMod = 1 [Constrained wave model: Constrained wave with specified crest elevation, alpha]" - +param SeaSt_WaveField - INTEGER ConstWaveMod_Peak2Trough - 2 - "ConstWaveMod = 2 [Constrained wave model: Constrained wave with guaranteed peak-to-trough crest height, HCrest]" - + +#--------------------------------------------------------------------------------------------------------------------------------------------------------- +# +#--------------------------------------------------------------------------------------------------------------------------------------------------------- +typedef ^ ParameterType IntKi n 4 - - "number of evenly-spaced grid points in the t, x, y, and z directions" - +typedef ^ ParameterType ReKi delta 4 - - "size between 2 consecutive grid points in each grid direction" "s,m,m,m" +typedef ^ ParameterType ReKi pZero 4 - - "fixed position of the XYZ grid (i.e., XYZ coordinates of m%V(:,1,1,1,:))" "m" +typedef ^ ParameterType ReKi Z_Depth - - - "grid depth" m + +typedef ^ MiscVarType SiKi N3D {8} - - "this is the weighting function for 3-d velocity field" - +typedef ^ MiscVarType SiKi N4D {16} - - "this is the weighting function for 4-d velocity field" - +typedef ^ MiscVarType integer Indx_Lo 4 - - "this is the index into the 4-d velocity field for each wave component" - +typedef ^ MiscVarType integer Indx_Hi 4 - - "this is the index into the 4-d velocity field for each wave component" - +typedef ^ MiscVarType logical FirstWarn_Clamp - .true. - "used to avoid too many 'Position has been clamped to the grid boundary' warning messages " - + + +typedef SeaSt_WaveField SeaSt_WaveFieldType SiKi WaveTime {:} - - "Time array" (s) +typedef ^ ^ SiKi WaveDynP {:}{:}{:}{:} - - "Incident wave dynamic pressure" (N/m^2) +typedef ^ ^ SiKi WaveAcc {:}{:}{:}{:}{:} - - "Incident wave acceleration" (m/s^2) +typedef ^ ^ SiKi WaveAccMCF {:}{:}{:}{:}{:} - - "Scaled acceleration for MacCamy-Fuchs members" (m/s^2) +typedef ^ ^ SiKi WaveVel {:}{:}{:}{:}{:} - - "Incident wave velocity" (m/s) +typedef ^ ^ SiKi PWaveDynP0 {:}{:}{:} - - "Partial derivative of dynamic pressure in the vertical direction at the still water level" (Pa/m) +typedef ^ ^ SiKi PWaveAcc0 {:}{:}{:}{:} - - "Partial derivative of incident wave acceleration in the vertical direction at the still water level" (m/s^2/m) +typedef ^ ^ SiKi PWaveAccMCF0 {:}{:}{:}{:} - - "Partial derivative of scaled wave acceleration in the vertical direction at the still water level for MacCamy-Fuchs members" (m/s^2/m) +typedef ^ ^ SiKi PWaveVel0 {:}{:}{:}{:} - - "Partial derivative of incident wave velocity in the vertical direction at the still water level" (m/s/m) +typedef ^ ^ SiKi WaveElev0 {:} - - "Instantaneous elevation time-series of incident waves at the platform reference point (NOTE THAT THIS CAN GET MODIFIED IN WAMIT)" (m) +typedef ^ ^ SiKi WaveElev1 {:}{:}{:} - - "First order wave elevation" (m) +typedef ^ ^ SiKi WaveElev2 {:}{:}{:} - - "Second order wave elevation" (m) +typedef ^ ^ SeaSt_WaveField_ParameterType GridParams - - - "Parameters for grid spacing" (-) +typedef ^ ^ IntKi WaveStMod - - - "Wave stretching model" +typedef ^ ^ ReKi EffWtrDpth - - - "Water depth" (-) +typedef ^ ^ ReKi MSL2SWL - - - "Vertical distance from mean sea level to still water level" (m) +typedef ^ ^ SiKi WaveElevC {:}{:}{:} - - "Discrete Fourier transform of the instantaneous elevation of incident waves at all grid points. First column is real part, second column is imaginary part" (m) +typedef ^ ^ SiKi WaveElevC0 {:}{:} - - "Fourier components of the incident wave elevation at the platform reference point. First column is the real part; second column is the imaginary part" (m) +typedef ^ ^ SiKi WaveDirArr {:} - - "Wave direction array. Each frequency has a unique direction of WaveNDir > 1" (degrees) + +typedef ^ ^ ReKi WtrDpth - - - "Water depth, this is necessary to inform glue-code what the module is using for WtrDpth (may not be the glue-code's default)" (m) +typedef ^ ^ ReKi WtrDens - - - "Water density, this is necessary to inform glue-code what the module is using for WtrDens (may not be the glue-code's default)" (kg/m^3) +typedef ^ ^ SiKi RhoXg - - - "= WtrDens*Gravity" - +typedef ^ ^ SiKi WaveDirMin - - - "Minimum wave direction." (degrees) +typedef ^ ^ SiKi WaveDirMax - - - "Maximum wave direction." (degrees) +typedef ^ ^ SiKi WaveDir - - - "Incident wave propagation heading direction" (degrees) +typedef ^ ^ LOGICAL WaveMultiDir - - - "Indicates the waves are multidirectional -- set by HydroDyn_Input" - +typedef ^ ^ SiKi MCFD - - - "Diameter of members that will use the MacCamy-Fuchs diffraction model" +typedef ^ ^ SiKi WvLowCOff - - - "Low cut-off frequency or lower frequency limit of the wave spectrum beyond which the wave spectrum is zeroed. [used only when WaveMod=2,3,4]" (rad/s) +typedef ^ ^ SiKi WvHiCOff - - - "High cut-off frequency or upper frequency limit of the wave spectrum beyond which the wave spectrum is zeroed. [used only when WaveMod=2,3,4]" (rad/s) +typedef ^ ^ SiKi WvLowCOffD - - - "Minimum frequency used in the difference methods [Ignored if all difference methods = 0]" (rad/s) +typedef ^ ^ SiKi WvHiCOffD - - - "Maximum frequency used in the difference methods [Ignored if all difference methods = 0]" (rad/s) +typedef ^ ^ SiKi WvLowCOffS - - - "Minimum frequency used in the sum-QTF method [Ignored if SumQTF = 0]" (rad/s) +typedef ^ ^ SiKi WvHiCOffS - - - "Maximum frequency used in the sum-QTF method [Ignored if SumQTF = 0]" (rad/s) +typedef ^ ^ SiKi WaveDOmega - - - "Frequency step for incident wave calculations" (rad/s) +typedef ^ ^ INTEGER WaveMod - - - "Incident wave kinematics model: See valid values in SeaSt_WaveField module parameters." - + +typedef ^ ^ INTEGER NStepWave - - - "Total number of frequency components = total number of time steps in the incident wave" - +typedef ^ ^ INTEGER NStepWave2 - - - "NStepWave / 2" - diff --git a/modules/seastate/src/SeaSt_WaveField_Types.f90 b/modules/seastate/src/SeaSt_WaveField_Types.f90 new file mode 100644 index 0000000000..4654a04040 --- /dev/null +++ b/modules/seastate/src/SeaSt_WaveField_Types.f90 @@ -0,0 +1,575 @@ +!STARTOFREGISTRYGENERATEDFILE 'SeaSt_WaveField_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 +!********************************************************************************************************************************* +! SeaSt_WaveField_Types +!................................................................................................................................. +! This file is part of SeaSt_WaveField. +! +! 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 SeaSt_WaveField. 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 SeaSt_WaveField_Types +!--------------------------------------------------------------------------------------------------------------------------------- +USE NWTC_Library +IMPLICIT NONE + INTEGER(IntKi), PUBLIC, PARAMETER :: WaveDirMod_None = 0 ! WaveDirMod = 0 [Directional spreading function is NONE] [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: WaveDirMod_COS2S = 1 ! WaveDirMod = 1 [Directional spreading function is COS2S] [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: WaveMod_None = 0 ! WaveMod = 0 [Incident wave kinematics model: NONE (still water)] [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: WaveMod_Regular = 1 ! WaveMod = 1 [Incident wave kinematics model: Regular (periodic)] [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: WaveMod_RegularUsrPh = 10 ! WaveMod = 1P# [Incident wave kinematics model: Regular (user specified phase)] [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: WaveMod_JONSWAP = 2 ! WaveMod = 2 [Incident wave kinematics model: JONSWAP/Pierson-Moskowitz spectrum (irregular)] [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: WaveMod_WhiteNoise = 3 ! WaveMod = 3 [Incident wave kinematics model: White noise spectrum (irregular)] [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: WaveMod_UserSpctrm = 4 ! WaveMod = 4 [Incident wave kinematics model: user-defined spectrum from routine UserWaveSpctrm (irregular)] [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: WaveMod_ExtElev = 5 ! WaveMod = 5 [Incident wave kinematics model: Externally generated wave-elevation time series] [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: WaveMod_ExtFull = 6 ! WaveMod = 6 [Incident wave kinematics model: Externally generated full wave-kinematics time series (invalid for PotMod/=0)] [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: WaveMod_UserFreq = 7 ! WaveMod = 7 [Incident wave kinematics model: user-defined wave frequency components] [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: ConstWaveMod_None = 0 ! ConstWaveMod = 0 [Constrained wave model: No constrained waves] [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: ConstWaveMod_CrestElev = 1 ! ConstWaveMod = 1 [Constrained wave model: Constrained wave with specified crest elevation, alpha] [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: ConstWaveMod_Peak2Trough = 2 ! ConstWaveMod = 2 [Constrained wave model: Constrained wave with guaranteed peak-to-trough crest height, HCrest] [-] +! ========= SeaSt_WaveField_ParameterType ======= + TYPE, PUBLIC :: SeaSt_WaveField_ParameterType + INTEGER(IntKi) , DIMENSION(1:4) :: n = 0_IntKi !< number of evenly-spaced grid points in the t, x, y, and z directions [-] + REAL(ReKi) , DIMENSION(1:4) :: delta = 0.0_ReKi !< size between 2 consecutive grid points in each grid direction [s,m,m,m] + REAL(ReKi) , DIMENSION(1:4) :: pZero = 0.0_ReKi !< fixed position of the XYZ grid (i.e., XYZ coordinates of m%V(:,1,1,1,:)) [m] + REAL(ReKi) :: Z_Depth = 0.0_ReKi !< grid depth [m] + END TYPE SeaSt_WaveField_ParameterType +! ======================= +! ========= SeaSt_WaveField_MiscVarType ======= + TYPE, PUBLIC :: SeaSt_WaveField_MiscVarType + REAL(SiKi) , DIMENSION(1:8) :: N3D = 0.0_R4Ki !< this is the weighting function for 3-d velocity field [-] + REAL(SiKi) , DIMENSION(1:16) :: N4D = 0.0_R4Ki !< this is the weighting function for 4-d velocity field [-] + INTEGER(IntKi) , DIMENSION(1:4) :: Indx_Lo = 0_IntKi !< this is the index into the 4-d velocity field for each wave component [-] + INTEGER(IntKi) , DIMENSION(1:4) :: Indx_Hi = 0_IntKi !< this is the index into the 4-d velocity field for each wave component [-] + LOGICAL :: FirstWarn_Clamp = .true. !< used to avoid too many 'Position has been clamped to the grid boundary' warning messages [-] + END TYPE SeaSt_WaveField_MiscVarType +! ======================= +! ========= SeaSt_WaveFieldType ======= + TYPE, PUBLIC :: SeaSt_WaveFieldType + REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveTime !< Time array [(s)] + REAL(SiKi) , DIMENSION(:,:,:,:), ALLOCATABLE :: WaveDynP !< Incident wave dynamic pressure [(N/m^2)] + REAL(SiKi) , DIMENSION(:,:,:,:,:), ALLOCATABLE :: WaveAcc !< Incident wave acceleration [(m/s^2)] + REAL(SiKi) , DIMENSION(:,:,:,:,:), ALLOCATABLE :: WaveAccMCF !< Scaled acceleration for MacCamy-Fuchs members [(m/s^2)] + REAL(SiKi) , DIMENSION(:,:,:,:,:), ALLOCATABLE :: WaveVel !< Incident wave velocity [(m/s)] + REAL(SiKi) , DIMENSION(:,:,:), ALLOCATABLE :: PWaveDynP0 !< Partial derivative of dynamic pressure in the vertical direction at the still water level [(Pa/m)] + REAL(SiKi) , DIMENSION(:,:,:,:), ALLOCATABLE :: PWaveAcc0 !< Partial derivative of incident wave acceleration in the vertical direction at the still water level [(m/s^2/m)] + REAL(SiKi) , DIMENSION(:,:,:,:), ALLOCATABLE :: PWaveAccMCF0 !< Partial derivative of scaled wave acceleration in the vertical direction at the still water level for MacCamy-Fuchs members [(m/s^2/m)] + REAL(SiKi) , DIMENSION(:,:,:,:), ALLOCATABLE :: PWaveVel0 !< Partial derivative of incident wave velocity in the vertical direction at the still water level [(m/s/m)] + REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveElev0 !< Instantaneous elevation time-series of incident waves at the platform reference point (NOTE THAT THIS CAN GET MODIFIED IN WAMIT) [(m)] + REAL(SiKi) , DIMENSION(:,:,:), ALLOCATABLE :: WaveElev1 !< First order wave elevation [(m)] + REAL(SiKi) , DIMENSION(:,:,:), ALLOCATABLE :: WaveElev2 !< Second order wave elevation [(m)] + TYPE(SeaSt_WaveField_ParameterType) :: GridParams !< Parameters for grid spacing [(-)] + INTEGER(IntKi) :: WaveStMod = 0_IntKi !< Wave stretching model [-] + REAL(ReKi) :: EffWtrDpth = 0.0_ReKi !< Water depth [(-)] + REAL(ReKi) :: MSL2SWL = 0.0_ReKi !< Vertical distance from mean sea level to still water level [(m)] + REAL(SiKi) , DIMENSION(:,:,:), ALLOCATABLE :: WaveElevC !< Discrete Fourier transform of the instantaneous elevation of incident waves at all grid points. First column is real part, second column is imaginary part [(m)] + REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: WaveElevC0 !< Fourier components of the incident wave elevation at the platform reference point. First column is the real part; second column is the imaginary part [(m)] + REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveDirArr !< Wave direction array. Each frequency has a unique direction of WaveNDir > 1 [(degrees)] + REAL(ReKi) :: WtrDpth = 0.0_ReKi !< Water depth, this is necessary to inform glue-code what the module is using for WtrDpth (may not be the glue-code's default) [(m)] + REAL(ReKi) :: WtrDens = 0.0_ReKi !< Water density, this is necessary to inform glue-code what the module is using for WtrDens (may not be the glue-code's default) [(kg/m^3)] + REAL(SiKi) :: RhoXg = 0.0_R4Ki !< = WtrDens*Gravity [-] + REAL(SiKi) :: WaveDirMin = 0.0_R4Ki !< Minimum wave direction. [(degrees)] + REAL(SiKi) :: WaveDirMax = 0.0_R4Ki !< Maximum wave direction. [(degrees)] + REAL(SiKi) :: WaveDir = 0.0_R4Ki !< Incident wave propagation heading direction [(degrees)] + LOGICAL :: WaveMultiDir = .false. !< Indicates the waves are multidirectional -- set by HydroDyn_Input [-] + REAL(SiKi) :: MCFD = 0.0_R4Ki !< Diameter of members that will use the MacCamy-Fuchs diffraction model [-] + REAL(SiKi) :: WvLowCOff = 0.0_R4Ki !< Low cut-off frequency or lower frequency limit of the wave spectrum beyond which the wave spectrum is zeroed. [used only when WaveMod=2,3,4] [(rad/s)] + REAL(SiKi) :: WvHiCOff = 0.0_R4Ki !< High cut-off frequency or upper frequency limit of the wave spectrum beyond which the wave spectrum is zeroed. [used only when WaveMod=2,3,4] [(rad/s)] + REAL(SiKi) :: WvLowCOffD = 0.0_R4Ki !< Minimum frequency used in the difference methods [Ignored if all difference methods = 0] [(rad/s)] + REAL(SiKi) :: WvHiCOffD = 0.0_R4Ki !< Maximum frequency used in the difference methods [Ignored if all difference methods = 0] [(rad/s)] + REAL(SiKi) :: WvLowCOffS = 0.0_R4Ki !< Minimum frequency used in the sum-QTF method [Ignored if SumQTF = 0] [(rad/s)] + REAL(SiKi) :: WvHiCOffS = 0.0_R4Ki !< Maximum frequency used in the sum-QTF method [Ignored if SumQTF = 0] [(rad/s)] + REAL(SiKi) :: WaveDOmega = 0.0_R4Ki !< Frequency step for incident wave calculations [(rad/s)] + INTEGER(IntKi) :: WaveMod = 0_IntKi !< Incident wave kinematics model: See valid values in SeaSt_WaveField module parameters. [-] + INTEGER(IntKi) :: NStepWave = 0_IntKi !< Total number of frequency components = total number of time steps in the incident wave [-] + INTEGER(IntKi) :: NStepWave2 = 0_IntKi !< NStepWave / 2 [-] + END TYPE SeaSt_WaveFieldType +! ======================= +CONTAINS + +subroutine SeaSt_WaveField_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(SeaSt_WaveField_ParameterType), intent(in) :: SrcParamData + type(SeaSt_WaveField_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SeaSt_WaveField_CopyParam' + ErrStat = ErrID_None + ErrMsg = '' + DstParamData%n = SrcParamData%n + DstParamData%delta = SrcParamData%delta + DstParamData%pZero = SrcParamData%pZero + DstParamData%Z_Depth = SrcParamData%Z_Depth +end subroutine + +subroutine SeaSt_WaveField_DestroyParam(ParamData, ErrStat, ErrMsg) + type(SeaSt_WaveField_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SeaSt_WaveField_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine SeaSt_WaveField_PackParam(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SeaSt_WaveField_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SeaSt_WaveField_PackParam' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%n) + call RegPack(RF, InData%delta) + call RegPack(RF, InData%pZero) + call RegPack(RF, InData%Z_Depth) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SeaSt_WaveField_UnPackParam(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SeaSt_WaveField_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SeaSt_WaveField_UnPackParam' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%n); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%delta); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%pZero); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Z_Depth); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SeaSt_WaveField_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(SeaSt_WaveField_MiscVarType), intent(in) :: SrcMiscData + type(SeaSt_WaveField_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SeaSt_WaveField_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + DstMiscData%N3D = SrcMiscData%N3D + DstMiscData%N4D = SrcMiscData%N4D + DstMiscData%Indx_Lo = SrcMiscData%Indx_Lo + DstMiscData%Indx_Hi = SrcMiscData%Indx_Hi + DstMiscData%FirstWarn_Clamp = SrcMiscData%FirstWarn_Clamp +end subroutine + +subroutine SeaSt_WaveField_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(SeaSt_WaveField_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SeaSt_WaveField_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine SeaSt_WaveField_PackMisc(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SeaSt_WaveField_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SeaSt_WaveField_PackMisc' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%N3D) + call RegPack(RF, InData%N4D) + call RegPack(RF, InData%Indx_Lo) + call RegPack(RF, InData%Indx_Hi) + call RegPack(RF, InData%FirstWarn_Clamp) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SeaSt_WaveField_UnPackMisc(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SeaSt_WaveField_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SeaSt_WaveField_UnPackMisc' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%N3D); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%N4D); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Indx_Lo); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Indx_Hi); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FirstWarn_Clamp); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SeaSt_WaveField_CopySeaSt_WaveFieldType(SrcSeaSt_WaveFieldTypeData, DstSeaSt_WaveFieldTypeData, CtrlCode, ErrStat, ErrMsg) + type(SeaSt_WaveFieldType), intent(in) :: SrcSeaSt_WaveFieldTypeData + type(SeaSt_WaveFieldType), intent(inout) :: DstSeaSt_WaveFieldTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(5), UB(5) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SeaSt_WaveField_CopySeaSt_WaveFieldType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcSeaSt_WaveFieldTypeData%WaveTime)) then + LB(1:1) = lbound(SrcSeaSt_WaveFieldTypeData%WaveTime) + UB(1:1) = ubound(SrcSeaSt_WaveFieldTypeData%WaveTime) + if (.not. allocated(DstSeaSt_WaveFieldTypeData%WaveTime)) then + allocate(DstSeaSt_WaveFieldTypeData%WaveTime(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstSeaSt_WaveFieldTypeData%WaveTime.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstSeaSt_WaveFieldTypeData%WaveTime = SrcSeaSt_WaveFieldTypeData%WaveTime + end if + if (allocated(SrcSeaSt_WaveFieldTypeData%WaveDynP)) then + LB(1:4) = lbound(SrcSeaSt_WaveFieldTypeData%WaveDynP) + UB(1:4) = ubound(SrcSeaSt_WaveFieldTypeData%WaveDynP) + if (.not. allocated(DstSeaSt_WaveFieldTypeData%WaveDynP)) then + allocate(DstSeaSt_WaveFieldTypeData%WaveDynP(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstSeaSt_WaveFieldTypeData%WaveDynP.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstSeaSt_WaveFieldTypeData%WaveDynP = SrcSeaSt_WaveFieldTypeData%WaveDynP + end if + if (allocated(SrcSeaSt_WaveFieldTypeData%WaveAcc)) then + LB(1:5) = lbound(SrcSeaSt_WaveFieldTypeData%WaveAcc) + UB(1:5) = ubound(SrcSeaSt_WaveFieldTypeData%WaveAcc) + if (.not. allocated(DstSeaSt_WaveFieldTypeData%WaveAcc)) then + allocate(DstSeaSt_WaveFieldTypeData%WaveAcc(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstSeaSt_WaveFieldTypeData%WaveAcc.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstSeaSt_WaveFieldTypeData%WaveAcc = SrcSeaSt_WaveFieldTypeData%WaveAcc + end if + if (allocated(SrcSeaSt_WaveFieldTypeData%WaveAccMCF)) then + LB(1:5) = lbound(SrcSeaSt_WaveFieldTypeData%WaveAccMCF) + UB(1:5) = ubound(SrcSeaSt_WaveFieldTypeData%WaveAccMCF) + if (.not. allocated(DstSeaSt_WaveFieldTypeData%WaveAccMCF)) then + allocate(DstSeaSt_WaveFieldTypeData%WaveAccMCF(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstSeaSt_WaveFieldTypeData%WaveAccMCF.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstSeaSt_WaveFieldTypeData%WaveAccMCF = SrcSeaSt_WaveFieldTypeData%WaveAccMCF + end if + if (allocated(SrcSeaSt_WaveFieldTypeData%WaveVel)) then + LB(1:5) = lbound(SrcSeaSt_WaveFieldTypeData%WaveVel) + UB(1:5) = ubound(SrcSeaSt_WaveFieldTypeData%WaveVel) + if (.not. allocated(DstSeaSt_WaveFieldTypeData%WaveVel)) then + allocate(DstSeaSt_WaveFieldTypeData%WaveVel(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstSeaSt_WaveFieldTypeData%WaveVel.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstSeaSt_WaveFieldTypeData%WaveVel = SrcSeaSt_WaveFieldTypeData%WaveVel + end if + if (allocated(SrcSeaSt_WaveFieldTypeData%PWaveDynP0)) then + LB(1:3) = lbound(SrcSeaSt_WaveFieldTypeData%PWaveDynP0) + UB(1:3) = ubound(SrcSeaSt_WaveFieldTypeData%PWaveDynP0) + if (.not. allocated(DstSeaSt_WaveFieldTypeData%PWaveDynP0)) then + allocate(DstSeaSt_WaveFieldTypeData%PWaveDynP0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstSeaSt_WaveFieldTypeData%PWaveDynP0.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstSeaSt_WaveFieldTypeData%PWaveDynP0 = SrcSeaSt_WaveFieldTypeData%PWaveDynP0 + end if + if (allocated(SrcSeaSt_WaveFieldTypeData%PWaveAcc0)) then + LB(1:4) = lbound(SrcSeaSt_WaveFieldTypeData%PWaveAcc0) + UB(1:4) = ubound(SrcSeaSt_WaveFieldTypeData%PWaveAcc0) + if (.not. allocated(DstSeaSt_WaveFieldTypeData%PWaveAcc0)) then + allocate(DstSeaSt_WaveFieldTypeData%PWaveAcc0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstSeaSt_WaveFieldTypeData%PWaveAcc0.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstSeaSt_WaveFieldTypeData%PWaveAcc0 = SrcSeaSt_WaveFieldTypeData%PWaveAcc0 + end if + if (allocated(SrcSeaSt_WaveFieldTypeData%PWaveAccMCF0)) then + LB(1:4) = lbound(SrcSeaSt_WaveFieldTypeData%PWaveAccMCF0) + UB(1:4) = ubound(SrcSeaSt_WaveFieldTypeData%PWaveAccMCF0) + if (.not. allocated(DstSeaSt_WaveFieldTypeData%PWaveAccMCF0)) then + allocate(DstSeaSt_WaveFieldTypeData%PWaveAccMCF0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstSeaSt_WaveFieldTypeData%PWaveAccMCF0.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstSeaSt_WaveFieldTypeData%PWaveAccMCF0 = SrcSeaSt_WaveFieldTypeData%PWaveAccMCF0 + end if + if (allocated(SrcSeaSt_WaveFieldTypeData%PWaveVel0)) then + LB(1:4) = lbound(SrcSeaSt_WaveFieldTypeData%PWaveVel0) + UB(1:4) = ubound(SrcSeaSt_WaveFieldTypeData%PWaveVel0) + if (.not. allocated(DstSeaSt_WaveFieldTypeData%PWaveVel0)) then + allocate(DstSeaSt_WaveFieldTypeData%PWaveVel0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstSeaSt_WaveFieldTypeData%PWaveVel0.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstSeaSt_WaveFieldTypeData%PWaveVel0 = SrcSeaSt_WaveFieldTypeData%PWaveVel0 + end if + if (allocated(SrcSeaSt_WaveFieldTypeData%WaveElev0)) then + LB(1:1) = lbound(SrcSeaSt_WaveFieldTypeData%WaveElev0) + UB(1:1) = ubound(SrcSeaSt_WaveFieldTypeData%WaveElev0) + if (.not. allocated(DstSeaSt_WaveFieldTypeData%WaveElev0)) then + allocate(DstSeaSt_WaveFieldTypeData%WaveElev0(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstSeaSt_WaveFieldTypeData%WaveElev0.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstSeaSt_WaveFieldTypeData%WaveElev0 = SrcSeaSt_WaveFieldTypeData%WaveElev0 + end if + if (allocated(SrcSeaSt_WaveFieldTypeData%WaveElev1)) then + LB(1:3) = lbound(SrcSeaSt_WaveFieldTypeData%WaveElev1) + UB(1:3) = ubound(SrcSeaSt_WaveFieldTypeData%WaveElev1) + if (.not. allocated(DstSeaSt_WaveFieldTypeData%WaveElev1)) then + allocate(DstSeaSt_WaveFieldTypeData%WaveElev1(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstSeaSt_WaveFieldTypeData%WaveElev1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstSeaSt_WaveFieldTypeData%WaveElev1 = SrcSeaSt_WaveFieldTypeData%WaveElev1 + end if + if (allocated(SrcSeaSt_WaveFieldTypeData%WaveElev2)) then + LB(1:3) = lbound(SrcSeaSt_WaveFieldTypeData%WaveElev2) + UB(1:3) = ubound(SrcSeaSt_WaveFieldTypeData%WaveElev2) + if (.not. allocated(DstSeaSt_WaveFieldTypeData%WaveElev2)) then + allocate(DstSeaSt_WaveFieldTypeData%WaveElev2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstSeaSt_WaveFieldTypeData%WaveElev2.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstSeaSt_WaveFieldTypeData%WaveElev2 = SrcSeaSt_WaveFieldTypeData%WaveElev2 + end if + call SeaSt_WaveField_CopyParam(SrcSeaSt_WaveFieldTypeData%GridParams, DstSeaSt_WaveFieldTypeData%GridParams, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstSeaSt_WaveFieldTypeData%WaveStMod = SrcSeaSt_WaveFieldTypeData%WaveStMod + DstSeaSt_WaveFieldTypeData%EffWtrDpth = SrcSeaSt_WaveFieldTypeData%EffWtrDpth + DstSeaSt_WaveFieldTypeData%MSL2SWL = SrcSeaSt_WaveFieldTypeData%MSL2SWL + if (allocated(SrcSeaSt_WaveFieldTypeData%WaveElevC)) then + LB(1:3) = lbound(SrcSeaSt_WaveFieldTypeData%WaveElevC) + UB(1:3) = ubound(SrcSeaSt_WaveFieldTypeData%WaveElevC) + if (.not. allocated(DstSeaSt_WaveFieldTypeData%WaveElevC)) then + allocate(DstSeaSt_WaveFieldTypeData%WaveElevC(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstSeaSt_WaveFieldTypeData%WaveElevC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstSeaSt_WaveFieldTypeData%WaveElevC = SrcSeaSt_WaveFieldTypeData%WaveElevC + end if + if (allocated(SrcSeaSt_WaveFieldTypeData%WaveElevC0)) then + LB(1:2) = lbound(SrcSeaSt_WaveFieldTypeData%WaveElevC0) + UB(1:2) = ubound(SrcSeaSt_WaveFieldTypeData%WaveElevC0) + if (.not. allocated(DstSeaSt_WaveFieldTypeData%WaveElevC0)) then + allocate(DstSeaSt_WaveFieldTypeData%WaveElevC0(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstSeaSt_WaveFieldTypeData%WaveElevC0.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstSeaSt_WaveFieldTypeData%WaveElevC0 = SrcSeaSt_WaveFieldTypeData%WaveElevC0 + end if + if (allocated(SrcSeaSt_WaveFieldTypeData%WaveDirArr)) then + LB(1:1) = lbound(SrcSeaSt_WaveFieldTypeData%WaveDirArr) + UB(1:1) = ubound(SrcSeaSt_WaveFieldTypeData%WaveDirArr) + if (.not. allocated(DstSeaSt_WaveFieldTypeData%WaveDirArr)) then + allocate(DstSeaSt_WaveFieldTypeData%WaveDirArr(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstSeaSt_WaveFieldTypeData%WaveDirArr.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstSeaSt_WaveFieldTypeData%WaveDirArr = SrcSeaSt_WaveFieldTypeData%WaveDirArr + end if + DstSeaSt_WaveFieldTypeData%WtrDpth = SrcSeaSt_WaveFieldTypeData%WtrDpth + DstSeaSt_WaveFieldTypeData%WtrDens = SrcSeaSt_WaveFieldTypeData%WtrDens + DstSeaSt_WaveFieldTypeData%RhoXg = SrcSeaSt_WaveFieldTypeData%RhoXg + DstSeaSt_WaveFieldTypeData%WaveDirMin = SrcSeaSt_WaveFieldTypeData%WaveDirMin + DstSeaSt_WaveFieldTypeData%WaveDirMax = SrcSeaSt_WaveFieldTypeData%WaveDirMax + DstSeaSt_WaveFieldTypeData%WaveDir = SrcSeaSt_WaveFieldTypeData%WaveDir + DstSeaSt_WaveFieldTypeData%WaveMultiDir = SrcSeaSt_WaveFieldTypeData%WaveMultiDir + DstSeaSt_WaveFieldTypeData%MCFD = SrcSeaSt_WaveFieldTypeData%MCFD + DstSeaSt_WaveFieldTypeData%WvLowCOff = SrcSeaSt_WaveFieldTypeData%WvLowCOff + DstSeaSt_WaveFieldTypeData%WvHiCOff = SrcSeaSt_WaveFieldTypeData%WvHiCOff + DstSeaSt_WaveFieldTypeData%WvLowCOffD = SrcSeaSt_WaveFieldTypeData%WvLowCOffD + DstSeaSt_WaveFieldTypeData%WvHiCOffD = SrcSeaSt_WaveFieldTypeData%WvHiCOffD + DstSeaSt_WaveFieldTypeData%WvLowCOffS = SrcSeaSt_WaveFieldTypeData%WvLowCOffS + DstSeaSt_WaveFieldTypeData%WvHiCOffS = SrcSeaSt_WaveFieldTypeData%WvHiCOffS + DstSeaSt_WaveFieldTypeData%WaveDOmega = SrcSeaSt_WaveFieldTypeData%WaveDOmega + DstSeaSt_WaveFieldTypeData%WaveMod = SrcSeaSt_WaveFieldTypeData%WaveMod + DstSeaSt_WaveFieldTypeData%NStepWave = SrcSeaSt_WaveFieldTypeData%NStepWave + DstSeaSt_WaveFieldTypeData%NStepWave2 = SrcSeaSt_WaveFieldTypeData%NStepWave2 +end subroutine + +subroutine SeaSt_WaveField_DestroySeaSt_WaveFieldType(SeaSt_WaveFieldTypeData, ErrStat, ErrMsg) + type(SeaSt_WaveFieldType), intent(inout) :: SeaSt_WaveFieldTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SeaSt_WaveField_DestroySeaSt_WaveFieldType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SeaSt_WaveFieldTypeData%WaveTime)) then + deallocate(SeaSt_WaveFieldTypeData%WaveTime) + end if + if (allocated(SeaSt_WaveFieldTypeData%WaveDynP)) then + deallocate(SeaSt_WaveFieldTypeData%WaveDynP) + end if + if (allocated(SeaSt_WaveFieldTypeData%WaveAcc)) then + deallocate(SeaSt_WaveFieldTypeData%WaveAcc) + end if + if (allocated(SeaSt_WaveFieldTypeData%WaveAccMCF)) then + deallocate(SeaSt_WaveFieldTypeData%WaveAccMCF) + end if + if (allocated(SeaSt_WaveFieldTypeData%WaveVel)) then + deallocate(SeaSt_WaveFieldTypeData%WaveVel) + end if + if (allocated(SeaSt_WaveFieldTypeData%PWaveDynP0)) then + deallocate(SeaSt_WaveFieldTypeData%PWaveDynP0) + end if + if (allocated(SeaSt_WaveFieldTypeData%PWaveAcc0)) then + deallocate(SeaSt_WaveFieldTypeData%PWaveAcc0) + end if + if (allocated(SeaSt_WaveFieldTypeData%PWaveAccMCF0)) then + deallocate(SeaSt_WaveFieldTypeData%PWaveAccMCF0) + end if + if (allocated(SeaSt_WaveFieldTypeData%PWaveVel0)) then + deallocate(SeaSt_WaveFieldTypeData%PWaveVel0) + end if + if (allocated(SeaSt_WaveFieldTypeData%WaveElev0)) then + deallocate(SeaSt_WaveFieldTypeData%WaveElev0) + end if + if (allocated(SeaSt_WaveFieldTypeData%WaveElev1)) then + deallocate(SeaSt_WaveFieldTypeData%WaveElev1) + end if + if (allocated(SeaSt_WaveFieldTypeData%WaveElev2)) then + deallocate(SeaSt_WaveFieldTypeData%WaveElev2) + end if + call SeaSt_WaveField_DestroyParam(SeaSt_WaveFieldTypeData%GridParams, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(SeaSt_WaveFieldTypeData%WaveElevC)) then + deallocate(SeaSt_WaveFieldTypeData%WaveElevC) + end if + if (allocated(SeaSt_WaveFieldTypeData%WaveElevC0)) then + deallocate(SeaSt_WaveFieldTypeData%WaveElevC0) + end if + if (allocated(SeaSt_WaveFieldTypeData%WaveDirArr)) then + deallocate(SeaSt_WaveFieldTypeData%WaveDirArr) + end if +end subroutine + +subroutine SeaSt_WaveField_PackSeaSt_WaveFieldType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SeaSt_WaveFieldType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SeaSt_WaveField_PackSeaSt_WaveFieldType' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%WaveTime) + call RegPackAlloc(RF, InData%WaveDynP) + call RegPackAlloc(RF, InData%WaveAcc) + call RegPackAlloc(RF, InData%WaveAccMCF) + call RegPackAlloc(RF, InData%WaveVel) + call RegPackAlloc(RF, InData%PWaveDynP0) + call RegPackAlloc(RF, InData%PWaveAcc0) + call RegPackAlloc(RF, InData%PWaveAccMCF0) + call RegPackAlloc(RF, InData%PWaveVel0) + call RegPackAlloc(RF, InData%WaveElev0) + call RegPackAlloc(RF, InData%WaveElev1) + call RegPackAlloc(RF, InData%WaveElev2) + call SeaSt_WaveField_PackParam(RF, InData%GridParams) + call RegPack(RF, InData%WaveStMod) + call RegPack(RF, InData%EffWtrDpth) + call RegPack(RF, InData%MSL2SWL) + call RegPackAlloc(RF, InData%WaveElevC) + call RegPackAlloc(RF, InData%WaveElevC0) + call RegPackAlloc(RF, InData%WaveDirArr) + call RegPack(RF, InData%WtrDpth) + call RegPack(RF, InData%WtrDens) + call RegPack(RF, InData%RhoXg) + call RegPack(RF, InData%WaveDirMin) + call RegPack(RF, InData%WaveDirMax) + call RegPack(RF, InData%WaveDir) + call RegPack(RF, InData%WaveMultiDir) + call RegPack(RF, InData%MCFD) + call RegPack(RF, InData%WvLowCOff) + call RegPack(RF, InData%WvHiCOff) + call RegPack(RF, InData%WvLowCOffD) + call RegPack(RF, InData%WvHiCOffD) + call RegPack(RF, InData%WvLowCOffS) + call RegPack(RF, InData%WvHiCOffS) + call RegPack(RF, InData%WaveDOmega) + call RegPack(RF, InData%WaveMod) + call RegPack(RF, InData%NStepWave) + call RegPack(RF, InData%NStepWave2) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SeaSt_WaveField_UnPackSeaSt_WaveFieldType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SeaSt_WaveFieldType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SeaSt_WaveField_UnPackSeaSt_WaveFieldType' + integer(B4Ki) :: LB(5), UB(5) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%WaveTime); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WaveDynP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WaveAcc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WaveAccMCF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WaveVel); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PWaveDynP0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PWaveAcc0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PWaveAccMCF0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PWaveVel0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WaveElev0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WaveElev1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WaveElev2); if (RegCheckErr(RF, RoutineName)) return + call SeaSt_WaveField_UnpackParam(RF, OutData%GridParams) ! GridParams + call RegUnpack(RF, OutData%WaveStMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%EffWtrDpth); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MSL2SWL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WaveElevC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WaveElevC0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WaveDirArr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WtrDpth); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WtrDens); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RhoXg); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WaveDirMin); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WaveDirMax); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WaveDir); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WaveMultiDir); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MCFD); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WvLowCOff); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WvHiCOff); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WvLowCOffD); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WvHiCOffD); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WvLowCOffS); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WvHiCOffS); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WaveDOmega); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WaveMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NStepWave); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NStepWave2); if (RegCheckErr(RF, RoutineName)) return +end subroutine +END MODULE SeaSt_WaveField_Types +!ENDOFREGISTRYGENERATEDFILE diff --git a/modules/seastate/src/SeaState.f90 b/modules/seastate/src/SeaState.f90 new file mode 100644 index 0000000000..10dca7ab7d --- /dev/null +++ b/modules/seastate/src/SeaState.f90 @@ -0,0 +1,1107 @@ +!********************************************************************************************************************************** +! The SeaState and SeaState_Types modules make up a template for creating user-defined calculations in the FAST Modularization +! Framework. HydroDyns_Types will be auto-generated based on a description of the variables for the module. +! +! "SeaState" should be replaced with the name of your module. Example: SeaState +! "SeaState" (in SeaState_*) should be replaced with the module name or an abbreviation of it. Example: SeaSt +!.................................................................................................................................. +! LICENSING +! Copyright (C) 2013-2015 National Renewable Energy Laboratory +! +! This file is part of SeaState. +! +! 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 SeaState + + USE SeaState_Types + USE NWTC_Library + USE SeaSt_WaveField + USE SeaState_Input + USE SeaState_Output + USE Current + USE Waves2 + + IMPLICIT NONE + PRIVATE + + ! ..... Public Subroutines ................................................................................................... + PUBLIC :: SeaSt_Init ! Initialization routine + PUBLIC :: SeaSt_End ! Ending routine (includes clean up) + + PUBLIC :: SeaSt_UpdateStates ! Loose coupling routine for solving for constraint states, integrating + ! continuous states, and updating discrete states + PUBLIC :: SeaSt_CalcOutput ! Routine for computing outputs + + PUBLIC :: SeaSt_CalcConstrStateResidual ! Tight coupling routine for returning the constraint state residual + PUBLIC :: SeaSt_CalcContStateDeriv ! Tight coupling routine for computing derivatives of continuous states + !PUBLIC :: SeaSt_UpdateDiscState ! Tight coupling routine for updating discrete states + + ! Linearization routines + PUBLIC :: SeaSt_JacobianPInput ! Jacobians dY/du, dX/du, dXd/du, and dZ/du + PUBLIC :: SeaSt_JacobianPContState ! Jacobians dY/dx, dX/dx, dXd/dx, and dZ/dx + PUBLIC :: SeaSt_JacobianPDiscState ! Jacobians dY/dxd, dX/dxd, dXd/dxd, and dZ/dxd + PUBLIC :: SeaSt_JacobianPConstrState ! Jacobians dY/dz, dX/dz, dXd/dz, and dZ/dz + PUBLIC :: SeaSt_GetOP ! operating points u_op, y_op, x_op, dx_op, xd_op, and z_op + + 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 SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut, ErrStat, ErrMsg ) +!.................................................................................................................................. + + TYPE(SeaSt_InitInputType), INTENT(IN ) :: InitInp !< Input data for initialization routine. + TYPE(SeaSt_InputType), INTENT( OUT) :: u !< An initial guess for the input; input mesh must be defined + TYPE(SeaSt_ParameterType), INTENT( OUT) :: p !< Parameters + TYPE(SeaSt_ContinuousStateType), INTENT( OUT) :: x !< Initial continuous states + TYPE(SeaSt_DiscreteStateType), INTENT( OUT) :: xd !< Initial discrete states + TYPE(SeaSt_ConstraintStateType), INTENT( OUT) :: z !< Initial guess of the constraint states + TYPE(SeaSt_OtherStateType), INTENT( OUT) :: OtherState !< Initial other states + TYPE(SeaSt_OutputType), INTENT( OUT) :: y !< Initial system outputs (outputs are not calculated; + !! only the output mesh is initialized) + TYPE(SeaSt_MiscVarType), INTENT( OUT) :: m !< Initial misc/optimization variables + REAL(DbKi), INTENT(INOUT) :: Interval !< Coupling interval in seconds: the rate that + !! (1) SeaSt_UpdateStates() is called in loose coupling & + !! (2) SeaSt_UpdateDiscState() is called in tight coupling. + !! Input is the suggested time from the glue code; + !! Output is the actual coupling interval that will be used + !! by the glue code. + TYPE(SeaSt_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(SeaSt_InputFile) :: InputFileData !< Data from input file + TYPE(FileInfoType) :: InFileInfo !< The derived type for holding the full input file for parsing -- we may pass this in the future + TYPE(Waves_InitOutputType) :: Waves_InitOut ! Initialization Outputs from the Waves submodule initialization + TYPE(Waves2_InitOutputType) :: Waves2_InitOut ! Initialization Outputs from the Waves2 submodule initialization + TYPE(Current_InitOutputType) :: Current_InitOut ! Initialization Outputs from the Current module initialization + INTEGER :: I ! Generic counters + INTEGER :: it ! Generic counters + REAL(ReKi) :: TmpElev ! temporary wave elevation + + + ! Wave Stretching Data + REAL(SiKi), ALLOCATABLE :: tmpWaveKinzi(: ) + REAL(SiKi), ALLOCATABLE :: tmpWaveElevxi(: ) + REAL(SiKi), ALLOCATABLE :: tmpWaveElevyi(: ) + REAL(SiKi), ALLOCATABLE :: WaveVel2S0 (:,:,:) + REAL(SiKi), ALLOCATABLE :: WaveAcc2S0 (:,:,:) + REAL(SiKi), ALLOCATABLE :: WaveDynP2S0 (:,: ) + REAL(SiKi), ALLOCATABLE :: WaveVel2D0 (:,:,:) + REAL(SiKi), ALLOCATABLE :: WaveAcc2D0 (:,:,:) + REAL(SiKi), ALLOCATABLE :: WaveDynP2D0 (:,: ) + + INTEGER(IntKi) :: ErrStat2 ! local error status + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local error message + CHARACTER(*), PARAMETER :: RoutineName = 'SeaSt_Init' + + ! Initialize ErrStat + + ErrStat = ErrID_None + ErrMsg = "" + p%UnOutFile = -1 + + u%DummyInput = 0 ! initialize dummy variable to make the compiler warnings go away + z%UnusedStates = 0.0 + x%UnusedStates = 0.0 + xd%UnusedStates = 0.0 + OtherState%UnusedStates = 0.0 + m%WaveField_m%FirstWarn_Clamp = .true. + + ! Initialize the NWTC Subroutine Library + CALL NWTC_Init( ) + + ! Display the module information + CALL DispNVD( SeaSt_ProgDesc ) + + IF ( InitInp%UseInputFile ) THEN + CALL ProcessComFile( InitInp%InputFile, InFileInfo, ErrStat2, ErrMsg2 ); if(Failed()) return; + ELSE + CALL NWTC_Library_CopyFileInfoType( InitInp%PassedFileData, InFileInfo, MESH_NEWCOPY, ErrStat2, ErrMsg2 ); if(Failed()) return; + ENDIF + + ! For diagnostic purposes, the following can be used to display the contents + ! of the InFileInfo data structure. + ! call Print_FileInfo_Struct( CU, InFileInfo ) ! CU is the screen -- different number on different systems. + + ! Parse all SeaState-related input and populate the InputFileData structure + CALL SeaSt_ParseInput( InitInp%InputFile, InitInp%OutRootName, InitInp%defWtrDens, InitInp%defWtrDpth, InitInp%defMSL2SWL, InFileInfo, InputFileData, ErrStat2, ErrMsg2 ); if(Failed()) return; + + ! Verify all the necessary initialization data. Do this at the HydroDynInput module-level + ! because the HydroDynInput module is also responsible for parsing all this + ! initialization data from a file + CALL SeaStateInput_ProcessInitData( InitInp, p, InputFileData, ErrStat2, ErrMsg2 ); if(Failed()) return; + + ! Now call each sub-module's *_Init subroutine + ! to fully initialize each sub-module based on the necessary initialization data + + ! Initialize Current module + CALL Current_Init(InputFileData%Current, Current_InitOut, ErrStat2, ErrMsg2 ); if(Failed()) return; + + + ! Move initialization output data from Current module into the initialization input data for the Waves module + IF (ALLOCATED(Current_InitOut%CurrVxi)) CALL Move_Alloc( Current_InitOut%CurrVxi, InputFileData%Waves%CurrVxi ) + IF (ALLOCATED(Current_InitOut%CurrVyi)) CALL Move_Alloc( Current_InitOut%CurrVyi, InputFileData%Waves%CurrVyi ) + + InputFileData%Waves%PCurrVxiPz0 = Current_InitOut%PCurrVxiPz0 + InputFileData%Waves%PCurrVyiPz0 = Current_InitOut%PCurrVyiPz0 + + ! distribute wave field and turbine location variables as needed to submodule initInputs + InputFileData%Waves%WaveFieldMod = InitInp%WaveFieldMod + InputFileData%Waves%PtfmLocationX = InitInp%PtfmLocationX + InputFileData%Waves%PtfmLocationY = InitInp%PtfmLocationY + + ! Initialize Waves module (Note that this may change InputFileData%Waves%WaveDT) + CALL Waves_Init(InputFileData%Waves, Waves_InitOut, p%WaveField, ErrStat2, ErrMsg2 ); if(Failed()) return; + + ! Copy Waves initialization output into the initialization input type for the WAMIT module + p%WaveDT = InputFileData%Waves%WaveDT + + ! Store user-requested wave elevation locations + p%NWaveElev = InputFileData%NWaveElev + call MOVE_ALLOC(InputFileData%WaveElevxi, p%WaveElevxi) + call MOVE_ALLOC(InputFileData%WaveElevyi, p%WaveElevyi) + + ! Store user-requested wave kinematic locations + p%NWaveKin = InputFileData%NWaveKin + call MOVE_ALLOC(InputFileData%WaveKinxi, p%WaveKinxi) + call MOVE_ALLOC(InputFileData%WaveKinyi, p%WaveKinyi) + call MOVE_ALLOC(InputFileData%WaveKinzi, p%WaveKinzi) + + + + ! add some warnings about requesting WriteOutput outside the SeaState domain: + do i=1,p%NWaveKin + if (abs(p%WaveKinxi(i)) > InputFileData%X_HalfWidth) then + CALL SetErrStat(ErrID_Warn,'Requested WaveKinxi is outside the SeaState spatial domain.', ErrStat, ErrMsg, RoutineName) + exit + end if + if (abs(p%WaveKinyi(i)) > InputFileData%Y_HalfWidth) then + CALL SetErrStat(ErrID_Warn,'Requested WaveKinyi is outside the SeaState spatial domain.', ErrStat, ErrMsg, RoutineName) + exit + end if + !if (p%WaveKinzi(i) < 0.0_ReKi .or. p%WaveKinzi(i) > p%Z_Depth) then + ! CALL SetErrStat(ErrID_Warn,'Requested WaveKinzi is outside the SeaState spatial domain.', ErrStat, ErrMsg, RoutineName) + ! exit + !end if + end do + + m%LastIndWave = 1 + + + IF ( InputFileData%WaveMod /= WaveMod_ExtFull ) THEN + + !---------------------------------- + ! Initialize Waves2 module + !---------------------------------- + IF (InputFileData%Waves2%WvDiffQTFF .OR. InputFileData%Waves2%WvSumQTFF ) THEN + CALL Waves2_Init(InputFileData%Waves2, Waves2_InitOut, p%WaveField, ErrStat2, ErrMsg2 ); if(Failed()) return; + + ! The acceleration, velocity, and dynamic pressures will get added to the parts passed to the morrison module later... + ! Difference frequency results + IF ( InputFileData%Waves2%WvDiffQTFF ) THEN + ! Dynamic pressure -- difference frequency terms ! WaveDynP = WaveDynP + WaveDynP2D + CALL AddArrays_4D(p%WaveField%WaveDynP, Waves2_InitOut%WaveDynP2D,'WaveDynP_D', ErrStat2, ErrMsg2); if(Failed()) return; + + ! Particle velocity -- difference frequency terms ! WaveVel = WaveVel + WaveVel2D + CALL AddArrays_5D(p%WaveField%WaveVel, Waves2_InitOut%WaveVel2D,'WaveVel_D', ErrStat2, ErrMsg2); if(Failed()) return; + + ! Particle acceleration -- difference frequency terms ! WaveAcc = WaveAcc + WaveAcc2D + CALL AddArrays_5D(p%WaveField%WaveAcc, Waves2_InitOut%WaveAcc2D,'WaveAcc_D', ErrStat2, ErrMsg2); if(Failed()) return; + ENDIF ! second order wave kinematics difference frequency results + + ! Sum frequency results + IF ( InputFileData%Waves2%WvSumQTFF ) THEN + ! Dynamic pressure -- sum frequency terms ! WaveDynP = WaveDynP + WaveDynP2S + CALL AddArrays_4D(p%WaveField%WaveDynP, Waves2_InitOut%WaveDynP2S,'WaveDynP_S', ErrStat2, ErrMsg2); if(Failed()) return; + + ! Particle velocity -- sum frequency terms ! WaveVel = WaveVel + WaveVel2S + CALL AddArrays_5D(p%WaveField%WaveVel, Waves2_InitOut%WaveVel2S,'WaveVel_S', ErrStat2, ErrMsg2); if(Failed()) return; + + ! Particle acceleration -- sum frequency terms ! WaveAcc = WaveAcc + WaveAcc2S + ! Note: MacCamy-Fuchs scaled accleration should not contain second-order contributions + CALL AddArrays_5D(p%WaveField%WaveAcc, Waves2_InitOut%WaveAcc2S,'WaveAcc_S', ErrStat2, ErrMsg2); if(Failed()) return; + ENDIF ! second order wave kinematics sum frequency results + + ELSE + ! these need to be set to zero since we don't have a UseWaves2 flag: + InputFileData%Waves2%NWaveElevGrid = 0 + ENDIF ! InputFileData%Waves2%WvDiffQTFF .OR. InputFileData%Waves2%WvSumQTFF + + END IF ! Check for WaveMod = 6 (WaveMod_ExtFull) + + ! Create the Output file if requested + p%OutSwtch = InputFileData%OutSwtch + p%Delim = '' + p%OutFmt = InputFileData%OutFmt + p%OutSFmt = InputFileData%OutSFmt + p%NumOuts = InputFileData%NumOuts + + ! Define initialization-routine output here: + InitOut%Ver = SeaSt_ProgDesc + + CALL SeaStOut_Init( SeaSt_ProgDesc, InitInp%OutRootName, InputFileData, y, p, m, InitOut, ErrStat2, ErrMsg2 ); if(Failed()) return; + + CALL SeaStOut_WrSummaryFile(InitInp, InputFileData, p, ErrStat2, ErrMsg2); if(Failed()) return; + + + + ! Setup the 4D grid information for the Interpolation Module + p%WaveField%GridParams%n = (/p%WaveField%NStepWave,p%nGrid(1),p%nGrid(2),p%nGrid(3)/) + p%WaveField%GridParams%delta = (/real(p%WaveDT,ReKi),p%deltaGrid(1),p%deltaGrid(2),p%deltaGrid(3)/) + p%WaveField%GridParams%pZero(1) = 0.0 !Time + p%WaveField%GridParams%pZero(2) = -InputFileData%X_HalfWidth + p%WaveField%GridParams%pZero(3) = -InputFileData%Y_HalfWidth + p%WaveField%GridParams%pZero(4) = -InputFileData%Z_Depth ! zi + p%WaveField%GridParams%Z_Depth = InputFileData%Z_Depth + + IF ( p%OutSwtch == 1 ) THEN ! Only SeaSt-level output writing + ! HACK WE can tell FAST not to write any SeaState outputs by simply deallocating the WriteOutputHdr array! + DEALLOCATE ( InitOut%WriteOutputHdr ) + END IF + + InitOut%WaveField => p%WaveField + + ! Tell HydroDyn if state-space wave excitation is not allowed: + InitOut%InvalidWithSSExctn = InputFileData%WaveMod == WaveMod_ExtFull .or. & ! 'Externally generated full wave-kinematics time series cannot be used with state-space wave excitations. Set WaveMod 0, 1, 1P#, 2, 3, 4, or 5.' + InputFileData%WaveDirMod /= WaveDirMod_None .or. & ! 'Directional spreading cannot be used with state-space wave excitations. Set WaveDirMod=0.' + InputFileData%Waves2%WvDiffQTFF .or. & ! 'Cannot use full difference-frequency 2nd-order wave kinematics with state-space wave excitations. Set WvDiffQTF=FALSE.' + InputFileData%Waves2%WvSumQTFF ! 'Cannot use full summation-frequency 2nd-order wave kinematics with state-space wave excitations. Set WvSumQTF=FALSE.' + + ! Write Wave Kinematics? + if ( InputFileData%WaveMod /= WaveMod_ExtFull ) then + if ( InitInp%WrWvKinMod == 2 ) then + call SeaStOut_WriteWvKinFiles( InitInp%OutRootname, SeaSt_ProgDesc, p%WaveField, p%WaveDT, InputFileData%X_HalfWidth, InputFileData%Y_HalfWidth, & + p%deltaGrid, p%NGrid, ErrStat2, ErrMsg2 ) + if(Failed()) return; + else if ( InitInp%WrWvKinMod == 1 ) then + call SeaStOut_WriteWaveElev0(InitInp%OutRootname, p%WaveField%NStepWave, & + p%NGrid, p%WaveField%WaveElev1, p%WaveField%WaveElev2, & + p%WaveField%WaveTime, ErrStat2, ErrMsg2 ) + if(Failed()) return; + end if + + end if + + + ! If requested, output wave elevation data for VTK visualization + if (InitInp%SurfaceVis) then + call SurfaceVisGenerate(ErrStat2, ErrMsg2); if(Failed()) return; + endif + + + IF ( InitInp%hasIce ) THEN + IF ((InputFileData%WaveMod /= WaveMod_None) .OR. (InputFileData%Current%CurrMod /= 0) ) THEN + CALL SetErrStat(ErrID_Fatal,'Waves and Current must be turned off in SeaState when ice loading is computed. Set WaveMod=0 and CurrMod=0.',ErrStat,ErrMsg,RoutineName) + END IF + END IF + + + ! Linearization + if (InitInp%Linearize) then + if ( InputFileData%WaveMod /= WaveMod_None ) then + call SetErrStat( ErrID_Fatal, 'Still water conditions must be used for linearization. Set WaveMod=0.', ErrStat, ErrMsg, RoutineName ) + end if + + if ( InputFileData%WaveDirMod /= WaveDirMod_None ) then + call SetErrStat( ErrID_Fatal, 'No directional spreading must be used for linearization. Set WaveDirMod=0.', ErrStat, ErrMsg, RoutineName ) + end if + + if ( InputFileData%Waves2%WvDiffQTFF ) then + call SetErrStat( ErrID_Fatal, 'Cannot use full difference-frequency 2nd-order wave kinematics for linearization. Set WvDiffQTF=FALSE.', ErrStat, ErrMsg, RoutineName ) + end if + + if ( InputFileData%Waves2%WvSumQTFF ) then + call SetErrStat( ErrID_Fatal, 'Cannot use full summation-frequency 2nd-order wave kinematics for linearization. Set WvSumQTF=FALSE.', ErrStat, ErrMsg, RoutineName ) + end if + + if ( InputFileData%Waves%ConstWaveMod /= WaveMod_None ) then + call SetErrStat( ErrID_Fatal, 'Constrained wave conditions cannot be used for linearization. Set ConstWaveMod=0.', ErrStat, ErrMsg, RoutineName ) + end if + + ! set the Jacobian info if we don't have a fatal error + if (ErrStat < AbortErrLev) then + call SeaSt_Init_Jacobian(p, InitOut, ErrStat2, ErrMsg2) + if (Failed()) return + endif + end if + + + ! Destroy the local initialization data + CALL CleanUp() + +CONTAINS + logical function Failed() + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + Failed = ErrStat >= AbortErrLev + if (Failed) call CleanUp() + end function +!................................ + SUBROUTINE CleanUp() + + CALL SeaSt_DestroyInputFile( InputFileData, ErrStat2, ErrMsg2 );CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + CALL NWTC_Library_DestroyFileInfoType(InFileInfo,ErrStat2, ErrMsg2);CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + ! Note: all pointers possibly allocated in Waves_init and Waves2_init are transferred to SeaSt parameters before deallocating them: + CALL Waves_DestroyInitOutput( Waves_InitOut, ErrStat2, ErrMsg2 ); CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + CALL Waves2_DestroyInitOutput( Waves2_InitOut, ErrStat2, ErrMsg2 ); CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + CALL Current_DestroyInitOutput( Current_InitOut, ErrStat2, ErrMsg2);CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + + if (allocated(tmpWaveKinzi )) deallocate(tmpWaveKinzi ) + if (allocated(tmpWaveElevxi)) deallocate(tmpWaveElevxi) + if (allocated(tmpWaveElevyi)) deallocate(tmpWaveElevyi) + if (allocated(WaveVel2S0 )) deallocate(WaveVel2S0 ) + if (allocated(WaveAcc2S0 )) deallocate(WaveAcc2S0 ) + if (allocated(WaveDynP2S0 )) deallocate(WaveDynP2S0 ) + if (allocated(WaveVel2D0 )) deallocate(WaveVel2D0 ) + if (allocated(WaveAcc2D0 )) deallocate(WaveAcc2D0 ) + if (allocated(WaveDynP2D0 )) deallocate(WaveDynP2D0 ) + + END SUBROUTINE CleanUp +!................................ + subroutine SurfaceVisGenerate(ErrStat3, ErrMsg3) + integer(IntKi), intent( out) :: ErrStat3 + character(ErrMsgLen),intent( out) :: ErrMsg3 + integer(IntKi) :: Nx,Ny,i1,i2 + real(SiKi) :: HWidX, HWidY, dx, dy, TmpElev + real(ReKi) :: loc(2) ! location (x,y) + integer(IntKi) :: ErrStat4 + character(ErrMsgLen) :: ErrMsg4 + character(*), parameter :: RtnName="SurfaceVisGenerate" + + ErrStat3 = ErrID_None + ErrMsg3 = "" + + ! Grid half width from the WaveField + HWidX = (real(p%WaveField%GridParams%n(2)-1,SiKi)) / 2.0_SiKi * p%WaveField%GridParams%delta(2) + HWidY = (real(p%WaveField%GridParams%n(3)-1,SiKi)) / 2.0_SiKi * p%WaveField%GridParams%delta(3) + + if ((InitInp%SurfaceVisNx <= 0) .or. (InitInp%SurfaceVisNy <= 0))then ! use the SeaState points exactly + ! Set number of points to the number of seastate grid points in each direction + Nx = p%WaveField%GridParams%n(2) + Ny = p%WaveField%GridParams%n(3) + dx = p%WaveField%GridParams%delta(2) + dy = p%WaveField%GridParams%delta(3) + call SetErrStat(ErrID_Info,"Setting wavefield visualization grid to "//trim(Num2LStr(Nx))//" x "//trim(Num2LStr(Ny))//"points",ErrStat3,ErrMsg3,RoutineName) + elseif ((InitInp%SurfaceVisNx < 3) .or. (InitInp%SurfaceVisNx < 3)) then ! Set to 3 for minimum + Nx = 3 + Ny = 3 + dx = HWidX + dy = HWidY + call SetErrStat(ErrID_Warn,"Setting wavefield visualization grid to 3 points in each direction",ErrStat3,ErrMsg3,RoutineName) + else ! Specified number of points + Nx = InitInp%SurfaceVisNx + Ny = InitInp%SurfaceVisNy + dx = 2.0_SiKi * HWidX / (real(Nx,SiKi)-1) + dy = 2.0_SiKi * HWidY / (real(Ny,SiKi)-1) + endif + + ! allocate arrays + call AllocAry(InitOut%WaveElevVisX,Nx,"InitOut%NWaveElevVisX",ErrStat4,ErrMsg4) + call SetErrStat(ErrStat4,ErrMsg4,ErrStat3,ErrMsg3,RtnName) + call AllocAry(InitOut%WaveElevVisY,Ny,"InitOut%NWaveElevVisY",ErrStat4,ErrMsg4) + call SetErrStat(ErrStat4,ErrMsg4,ErrStat3,ErrMsg3,RtnName) + allocate(InitOut%WaveElevVisGrid( 0:size(p%WaveField%WaveTime),Nx,Ny ),STAT=ErrStat4) + if (ErrStat4 /= 0) then + CALL SetErrStat(ErrID_Fatal,"Error allocating InitOut%WaveElevVisGrid.",ErrStat3,ErrMsg3,RoutineName) + return + end if + + ! Populate the arrays + do i1=1,Nx + InitOut%WaveElevVisX(i1) = -HWidX + real(i1-1,SiKi)*dx + enddo + do i2=1,Ny + InitOut%WaveElevVisY(i2) = -HWidY + real(i2-1,SiKi)*dy + enddo + + !TODO: sometime in the future, we might want larger grids than is stored in the WaveField. When + ! we want that, we will need to add a WaveField routine to generate for arbitrary points from an + ! FFT of the whole complex series. + do it = 0,size(p%WaveField%WaveTime)-1 + do i1 = 1, nx + loc(1) = InitOut%WaveElevVisX(i1) + do i2 = 1, ny + loc(2) = InitOut%WaveElevVisX(i2) + InitOut%WaveElevVisGrid(it,i1,i2) = WaveField_GetNodeTotalWaveElev(p%WaveField, m%WaveField_m, real(p%WaveField%WaveTime(it),DbKi), real(loc,ReKi), ErrStat4, ErrMsg4 ) + call SetErrStat( ErrStat4, ErrMsg4, ErrStat3, ErrMsg3, RoutineName ) + enddo + end do + end do + end subroutine SurfaceVisGenerate + +END SUBROUTINE SeaSt_Init +!---------------------------------------------------------------------------------------------------------------------------------- +SUBROUTINE AddArrays_4D(Array1, Array2, ArrayName, ErrStat, ErrMsg) + REAL(SiKi), INTENT(INOUT) :: Array1(:,:,:,:) + REAL(SiKi), INTENT(IN ) :: Array2(:,:,:,:) + CHARACTER(*), INTENT(IN ) :: ArrayName + 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 ( SIZE(Array1,DIM=1) /= SIZE(Array2,DIM=1) .OR. & + SIZE(Array1,DIM=2) /= SIZE(Array2,DIM=2) .OR. & + SIZE(Array1,DIM=3) /= SIZE(Array2,DIM=3) .OR. & + SIZE(Array1,DIM=4) /= SIZE(Array2,DIM=4)) THEN + + ErrStat = ErrID_Fatal + ErrMsg = TRIM(ArrayName)//' arrays for first and second order wave elevations are of different sizes: '//NewLine// & + 'Waves: '// TRIM(Num2LStr(SIZE(Array1,DIM=1)))//'x'// & + TRIM(Num2LStr(SIZE(Array1,DIM=2)))//'x'// & + TRIM(Num2LStr(SIZE(Array1,DIM=3)))//'x'// & + TRIM(Num2LStr(SIZE(Array1,DIM=4)))//NewLine// & + 'Waves2: '// TRIM(Num2LStr(SIZE(Array2,DIM=1)))//'x'// & + TRIM(Num2LStr(SIZE(Array2,DIM=2)))//'x'// & + TRIM(Num2LStr(SIZE(Array2,DIM=3)))//'x'// & + TRIM(Num2LStr(SIZE(Array2,DIM=4))) + ELSE + Array1 = Array1 + Array2 + ENDIF + +END SUBROUTINE AddArrays_4D +!---------------------------------------------------------------------------------------------------------------------------------- +SUBROUTINE AddArrays_5D(Array1, Array2, ArrayName, ErrStat, ErrMsg) + REAL(SiKi), INTENT(INOUT) :: Array1(:,:,:,:,:) + REAL(SiKi), INTENT(IN ) :: Array2(:,:,:,:,:) + CHARACTER(*), INTENT(IN ) :: ArrayName + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + + IF ( SIZE(Array1,DIM=1) /= SIZE(Array2,DIM=1) .OR. & + SIZE(Array1,DIM=2) /= SIZE(Array2,DIM=2) .OR. & + SIZE(Array1,DIM=3) /= SIZE(Array2,DIM=3) .OR. & + SIZE(Array1,DIM=4) /= SIZE(Array2,DIM=4) .OR. & + SIZE(Array1,DIM=5) /= SIZE(Array2,DIM=5)) THEN + + ErrStat = ErrID_Fatal + ErrMsg = TRIM(ArrayName)//' arrays for first and second order wave elevations are of different sizes: '//NewLine// & + 'Waves: '// TRIM(Num2LStr(SIZE(Array1,DIM=1)))//'x'// & + TRIM(Num2LStr(SIZE(Array1,DIM=2)))//'x'// & + TRIM(Num2LStr(SIZE(Array1,DIM=3)))//'x'// & + TRIM(Num2LStr(SIZE(Array1,DIM=4)))//'x'// & + TRIM(Num2LStr(SIZE(Array1,DIM=5)))//NewLine// & + 'Waves2: '// TRIM(Num2LStr(SIZE(Array2,DIM=1)))//'x'// & + TRIM(Num2LStr(SIZE(Array2,DIM=2)))//'x'// & + TRIM(Num2LStr(SIZE(Array2,DIM=3)))//'x'// & + TRIM(Num2LStr(SIZE(Array2,DIM=4)))//'x'// & + TRIM(Num2LStr(SIZE(Array2,DIM=5))) + ELSE + ErrStat = ErrID_None + ErrMsg = "" + Array1 = Array1 + Array2 + ENDIF + +END SUBROUTINE AddArrays_5D +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine is called at the end of the simulation. +SUBROUTINE SeaSt_End( u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) + TYPE(SeaSt_InputType), INTENT(INOUT) :: u !< System inputs + TYPE(SeaSt_ParameterType), INTENT(INOUT) :: p !< Parameters + TYPE(SeaSt_ContinuousStateType), INTENT(INOUT) :: x !< Continuous states + TYPE(SeaSt_DiscreteStateType), INTENT(INOUT) :: xd !< Discrete states + TYPE(SeaSt_ConstraintStateType), INTENT(INOUT) :: z !< Constraint states + TYPE(SeaSt_OtherStateType), INTENT(INOUT) :: OtherState !< Other/optimization states + TYPE(SeaSt_OutputType), INTENT(INOUT) :: y !< System outputs + TYPE(SeaSt_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 + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" + + ! Place any last minute operations or calculations here: + ! CALL WaveField_End(p%WaveField) + + ! Write the SeaState-level output file data FROM THE LAST COMPLETED TIME STEP if the user requested module-level output + ! and the current time has advanced since the last stored time step. + + IF ( p%OutSwtch == 1 .OR. p%OutSwtch == 3) THEN !Note: this will always output a line, even if we're ending early (e.g. if SeaState doesn't initialize properly, this will write a line of zeros to the output file.) + CALL SeaStOut_WriteOutputs( m%LastOutTime, y, p, m%Decimate, ErrStat, ErrMsg ) + END IF + + ! Close files here: + CALL SeaStOut_CloseOutput( p, ErrStat, ErrMsg ) + + ! Destroy the input data: + CALL SeaSt_DestroyInput( u, ErrStat, ErrMsg ) + + ! Destroy the parameter data: + CALL SeaSt_DestroyParam( p, ErrStat, ErrMsg ) + + ! Destroy the state data: + CALL SeaSt_DestroyContState( x, ErrStat, ErrMsg ) + CALL SeaSt_DestroyDiscState( xd, ErrStat, ErrMsg ) + CALL SeaSt_DestroyConstrState( z, ErrStat, ErrMsg ) + CALL SeaSt_DestroyOtherState( OtherState, ErrStat, ErrMsg ) + + ! Destroy misc variables: + CALL SeaSt_DestroyMisc( m, ErrStat, ErrMsg ) + + ! Destroy the output data: + CALL SeaSt_DestroyOutput( y, ErrStat, ErrMsg ) + +END SUBROUTINE SeaSt_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 SeaSt_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(SeaSt_InputType), INTENT(INOUT ) :: Inputs(:) !< Inputs at InputTimes + REAL(DbKi), INTENT(IN ) :: InputTimes(:) !< Times in seconds associated with Inputs + TYPE(SeaSt_ParameterType), INTENT(IN ) :: p !< Parameters + TYPE(SeaSt_ContinuousStateType), INTENT(INOUT) :: x !< Input: Continuous states at t; + !! Output: Continuous states at t + Interval + TYPE(SeaSt_DiscreteStateType), INTENT(INOUT) :: xd !< Input: Discrete states at t; + !! Output: Discrete states at t + Interval + TYPE(SeaSt_ConstraintStateType), INTENT(INOUT) :: z !< Input: Constraint states at t; + !! Output: Constraint states at t + Interval + TYPE(SeaSt_OtherStateType), INTENT(INOUT) :: OtherState !< Other states: Other states at t; + !! Output: Other states at t + Interval + TYPE(SeaSt_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 + + ! Initialize variables + ErrStat = ErrID_None ! no error has occurred + ErrMsg = "" + +END SUBROUTINE SeaSt_UpdateStates + + +!---------------------------------------------------------------------------------------------------------------------------------- +!> Routine for computing outputs, used in both loose and tight coupling. +SUBROUTINE SeaSt_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) + REAL(DbKi), INTENT(IN ) :: Time !< Current simulation time in seconds + TYPE(SeaSt_InputType), INTENT(INOUT) :: u !< Inputs at Time (note that this is intent out because we're copying the u%WAMITMesh into m%u_wamit%mesh) + TYPE(SeaSt_ParameterType), INTENT(IN ) :: p !< Parameters + TYPE(SeaSt_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at Time + TYPE(SeaSt_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at Time + TYPE(SeaSt_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at Time + TYPE(SeaSt_OtherStateType), INTENT(IN ) :: OtherState !< Other states at Time + TYPE(SeaSt_OutputType), INTENT(INOUT) :: y !< Outputs computed at Time (Input only so that mesh con- + !! nectivity information does not have to be recalculated) + TYPE(SeaSt_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 :: I ! Generic counters + + INTEGER(IntKi) :: ErrStat2 ! Error status of the operation (secondary error) + CHARACTER(ErrMsgLen) :: ErrMsg2 ! Error message if ErrStat2 /= ErrID_None + character(*), parameter :: RoutineName = 'SeaSt_CalcOutput' + + + REAL(SiKi) :: WaveElev (p%NWaveElev) ! Instantaneous total elevation of incident waves at each of the NWaveElev points where the incident wave elevations can be output (meters) + REAL(SiKi) :: WaveElev1(p%NWaveElev) ! Instantaneous first order elevation of incident waves at each of the NWaveElev points where the incident wave elevations can be output (meters) + REAL(SiKi) :: WaveElev2(p%NWaveElev) ! Instantaneous first order elevation of incident waves at each of the NWaveElev points where the incident wave elevations can be output (meters) + REAL(SiKi) :: WaveVel(3,p%NWaveKin) + REAL(SiKi) :: WaveAcc(3,p%NWaveKin) + REAL(SiKi) :: WaveAccMCF(3,p%NWaveKin) + REAL(SiKi) :: WaveDynP(p%NWaveKin) + REAL(ReKi) :: AllOuts(MaxOutPts) + real(ReKi) :: positionXYZ(3), positionXY(2) + + REAL(SiKi) :: zeta + REAL(SiKi) :: zeta1 + REAL(SiKi) :: zeta2 + + INTEGER(IntKi) :: nodeInWater + + ! Initialize ErrStat + + ErrStat = ErrID_None + ErrMsg = "" + WaveElev = 0.0_ReKi + WaveElev1 = 0.0_ReKi + WaveElev2 = 0.0_ReKi ! In case we don't use 2nd order waves + WaveAccMCF = 0.0_ReKi ! In case we don't use MCF approximation + ErrStat2 = ErrID_None + ErrMsg = "" + + ! Compute outputs here: + + ! These Outputs are only used for generated user-requested output channel results. + ! If the user did not request any outputs, then we can simply return + IF ( p%NumOuts > 0 ) THEN + + ! Write the SeaState-level output file data FROM THE LAST COMPLETED TIME STEP if the user requested module-level output + ! and the current time has advanced since the last stored time step. Note that this must be done before filling y%WriteOutput + ! so that we don't get recent results. Also note that this may give strange results in the .SeaSt.out files of linearization simulations + ! because it assumes that the last call to SeaSt_CalcOutput was for a "normal" time step. + + IF ( (p%OutSwtch == 1 .OR. p%OutSwtch == 3) .AND. ( Time > m%LastOutTime ) ) THEN + CALL SeaStOut_WriteOutputs( m%LastOutTime, y, p, m%Decimate, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END IF + m%LastOutTime = Time ! time associated with next WriteOutput calculations + + DO i = 1, p%NWaveKin + positionXYZ = (/p%WaveKinxi(i),p%WaveKinyi(i),p%WaveKinzi(i)/) + CALL WaveField_GetNodeWaveKin( p%WaveField, m%WaveField_m, Time, positionXYZ, .FALSE., nodeInWater, zeta1, zeta2, zeta, WaveDynP(i), WaveVel(:,i), WaveAcc(:,i), WaveAccMCF(:,i), ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + + ! Compute the wave elevations at the requested output locations for this time. Note that p%WaveElev has the second order added to it already. + DO i = 1, p%NWaveElev + positionXY = (/p%WaveElevxi(i),p%WaveElevyi(i)/) + WaveElev1(i) = WaveField_GetNodeWaveElev1( p%WaveField, m%WaveField_m, Time, positionXY, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + WaveElev2(i) = WaveField_GetNodeWaveElev2( p%WaveField, m%WaveField_m, Time, positionXY, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + WaveElev(i) = WaveElev1(i) + WaveElev2(i) + END DO + + ! Map calculated results into the AllOuts Array + CALL SeaStOut_MapOutputs( p, WaveElev, WaveElev1, WaveElev2, WaveVel, WaveAcc, WaveAccMCF, WaveDynP, AllOuts, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + DO I = 1,p%NumOuts + y%WriteOutput(I) = p%OutParam(I)%SignM * AllOuts( p%OutParam(I)%Indx ) + END DO + + END IF + +END SUBROUTINE SeaSt_CalcOutput + + +!---------------------------------------------------------------------------------------------------------------------------------- +!> Tight coupling routine for computing derivatives of continuous states. Not used in SeaState +SUBROUTINE SeaSt_CalcContStateDeriv( Time, u, p, x, xd, z, OtherState, m, dxdt, ErrStat, ErrMsg ) + real(DbKi), intent(in ) :: Time !< Current simulation time in seconds + type(SeaSt_InputType), intent(inout) :: u !< Inputs at Time (intent OUT only because we're copying the input mesh) + type(SeaSt_ParameterType), intent(in ) :: p !< Parameters + type(SeaSt_ContinuousStateType), intent(in ) :: x !< Continuous states at Time + type(SeaSt_DiscreteStateType), intent(in ) :: xd !< Discrete states at Time + type(SeaSt_ConstraintStateType), intent(in ) :: z !< Constraint states at Time + type(SeaSt_OtherStateType), intent(in ) :: OtherState !< Other states + type(SeaSt_MiscVarType), intent(inout) :: m !< Initial misc/optimization variables + type(SeaSt_ContinuousStateType), intent(inout) :: dxdt !< Continuous state derivatives at Time + integer(IntKi), intent( out) :: ErrStat !< Error status of the operation + character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + character(*), parameter :: RoutineName = 'SeaSt_CalcContStateDeriv' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" +END SUBROUTINE SeaSt_CalcContStateDeriv + + +!---------------------------------------------------------------------------------------------------------------------------------- +!> Tight coupling routine for solving for the residual of the constraint state equations +SUBROUTINE SeaSt_CalcConstrStateResidual( Time, u, p, x, xd, z, OtherState, m, z_residual, ErrStat, ErrMsg ) + real(DbKi), intent(in ) :: Time !< Current simulation time in seconds + type(SeaSt_InputType), intent(inout) :: u !< Inputs at Time (intent OUT only because we're copying the input mesh) + type(SeaSt_ParameterType), intent(in ) :: p !< Parameters + type(SeaSt_ContinuousStateType), intent(in ) :: x !< Continuous states at Time + type(SeaSt_DiscreteStateType), intent(in ) :: xd !< Discrete states at Time + type(SeaSt_ConstraintStateType), intent(in ) :: z !< Constraint states at Time (possibly a guess) + type(SeaSt_OtherStateType), intent(in ) :: OtherState !< Other/optimization states + type(SeaSt_MiscVarType), intent(inout) :: m !< Initial misc/optimization variables + type(SeaSt_ConstraintStateType), intent( out) :: z_residual !< Residual of the constraint state equations using + 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 = "" + + ! Nothing to do here since no contraint states + call SeaSt_CopyConstrState(z, z_residual, MESH_NEWCOPY, ErrStat, ErrMsg) +END SUBROUTINE SeaSt_CalcConstrStateResidual + + + +!---------------------------------------------------------------------------------------------------------------------------------- +! Linearization routines +!---------------------------------------------------------------------------------------------------------------------------------- +!> Initialize Jacobian info for linearization (only u and y) +subroutine SeaSt_Init_Jacobian(p, InitOut, ErrStat, ErrMsg) + type(SeaSt_ParameterType), intent(inout) :: p !< Parameters + type(SeaSt_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 + + integer(IntKi) :: nu, ny ! counters for number of u and y linearization terms + integer(IntKi) :: i, idx ! generic indexing + integer(IntKi) :: ExtStart ! start of Extended input/output + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SeaSt_Init_Jacobian' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + + !-------------------------- + ! Init Jacobians for u + !-------------------------- + + ! One extended input (WaveElev0), and no regular inputs. Starts at first index. + nu = 1 + p%LinParams%NumExtendedInputs = 1 + ! Total number of inputs (including regular and extended inputs) + p%LinParams%Jac_nu = nu + + ! Allocate storage for names, indexing, and perturbations + call AllocAry(InitOut%LinNames_u, nu, "LinNames_u", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(InitOut%RotFrame_u, nu, "RotFrame_u", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(InitOut%IsLoad_u, nu, "IsLoad_u", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(p%LinParams%du, nu, "LinParams%du", ErrStat2, ErrMsg2); if (Failed()) return + + ! Step through list of inputs and save names. No regular inputs, so we skip directly to the Extended input + ! WaveElev0 - extended input + ExtStart = 1 + InitOut%LinNames_u(ExtStart) = 'Extended input: wave elevation at platform ref point, m' + InitOut%RotFrame_u(ExtStart) = .false. + InitOut%IsLoad_u( ExtStart) = .false. + + p%LinParams%Jac_u_idxStartList%Extended = ExtStart + p%LinParams%du(ExtStart) = 0.02_ReKi * Pi / 180.0_ReKi * max(1.0_ReKi, p%WaveField%WtrDpth) ! TODO: check that this is the correct perturbation to use + + + !-------------------------- + ! Init Jacobians for y + !-------------------------- + + ! No regular outputs, only the extended outputs and the WrOuts + p%LinParams%NumExtendedOutputs = 1 + ExtStart = 1 ! Extended output is the first output + ny = 1 ! one extended output + p%LinParams%Jac_y_idxStartList%Extended = 1 + + ! Nunber of WrOuts (only if output to OpenFAST) + if ( p%OutSwtch /= 1 .and. allocated(InitOut%WriteOutputHdr) ) then + ny = ny + size(InitOut%WriteOutputHdr) + endif + + ! start position for WrOuts (may be beyond ny) + p%LinParams%Jac_y_idxStartList%WrOuts = p%LinParams%Jac_y_idxStartList%Extended + p%LinParams%NumExtendedOutputs + + ! Total number of outs (including regular outs and extended outs) + p%LinParams%Jac_ny = ny + + ! allocate some things + call AllocAry(InitOut%LinNames_y, ny, "LinNames_y", ErrStat2, ErrMsg2); if (Failed()) return; + call AllocAry(InitOut%RotFrame_y, ny, "RotFrame_y", ErrStat2, ErrMsg2); if (Failed()) return; + InitOut%RotFrame_y = .false. ! No outputs in rotating frame + + ! Set names: no regular output, so start at extended output + InitOut%LinNames_y(ExtStart) = 'Extended output: wave elevation at platform ref point, m' + + ! WrOuts names (only if output to OpenFAST) + if ( p%OutSwtch > 1 .and. allocated(InitOut%WriteOutputHdr) ) then + do i = 1,size(InitOut%WriteOutputHdr) + idx = p%LinParams%Jac_y_idxStartList%WrOuts - 1 + i ! current index + InitOut%LinNames_y(idx) = trim(InitOut%WriteOutputHdr(i))//', '//trim(InitOut%WriteOutputUnt(i)) + enddo + endif + + +contains + logical function Failed() + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + Failed = ErrStat >= AbortErrLev + end function Failed +end subroutine SeaSt_Init_Jacobian + +!---------------------------------------------------------------------------------------------------------------------------------- +!> Linearization Jacobians dY/du, dX/du, dXd/du, and dZ/du +subroutine SeaSt_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(SeaSt_InputType), intent(inout) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) + type(SeaSt_ParameterType), intent(in ) :: p !< Parameters + type(SeaSt_ContinuousStateType), intent(in ) :: x !< Continuous states at operating point + type(SeaSt_DiscreteStateType), intent(in ) :: xd !< Discrete states at operating point + type(SeaSt_ConstraintStateType), intent(in ) :: z !< Constraint states at operating point + type(SeaSt_OtherStateType), intent(in ) :: OtherState !< Other states at operating point + type(SeaSt_OutputType), intent(inout) :: y !< Output (change to inout if a mesh copy is required); + type(SeaSt_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 + real(R8Ki), allocatable, optional, intent(inout) :: dXdu(:,:) !< Partial derivatives of continuous state + real(R8Ki), allocatable, optional, intent(inout) :: dXddu(:,:) !< Partial derivatives of discrete state + real(R8Ki), allocatable, optional, intent(inout) :: dZdu(:,:) !< Partial derivatives of constraint state + + integer(IntKi) :: idx_dY,idx_du,i + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SeaSt_JacobianPInput' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + + if ( present( dYdu ) ) then + + ! If dYdu is allocated, make sure it is the correct size + if (allocated(dYdu)) then + if (size(dYdu,1) /= p%LinParams%Jac_ny .or. size(dYdu,2) /= p%LinParams%Jac_nu) deallocate (dYdu) + endif + + ! Calculate the partial derivative of the output functions (Y) with respect to the inputs (u) here: + ! - inputs are extended inputs only + ! - outputs are the extended outputs and the WriteOutput values + if (.not. ALLOCATED(dYdu)) then + call AllocAry( dYdu, p%LinParams%Jac_ny, p%LinParams%Jac_nu, 'dYdu', ErrStat2, ErrMsg2 ) + if (Failed()) return + end if + + dYdu = 0.0_R8Ki + + ! Extended inputs to extended outputs (direct pass-through) + do i=1,min(p%LinParams%NumExtendedInputs,p%LinParams%NumExtendedOutputs) + idx_du = p%LinParams%Jac_u_idxStartList%Extended + i - 1 + idx_dY = p%LinParams%Jac_y_idxStartList%Extended + i - 1 + dYdu(idx_dY,idx_du) = 1.0_R8Ki + enddo + + ! It isn't possible to determine the relationship between the extended input and the WrOuts. So we leave them all zero. + + endif + + + ! No states or constraints, so deallocate any such matrices + if ( present( dXdu ) ) then + if (allocated(dXdu)) deallocate(dXdu) + endif + + if ( present( dXddu ) ) then + if (allocated(dXddu)) deallocate(dXddu) + endif + + if ( present( dZdu ) ) then + if (allocated(dZdu)) deallocate(dZdu) + endif + +contains + logical function Failed() + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + Failed = ErrStat >= AbortErrLev + end function Failed +end subroutine SeaSt_JacobianPInput + +!---------------------------------------------------------------------------------------------------------------------------------- +!> Linearization Jacobians dY/dx, dX/dx, dXd/dx, and dZ/dx +!! No continuous states, so this doesn't do anything +subroutine SeaSt_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(SeaSt_InputType), intent(in ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) + type(SeaSt_ParameterType), intent(in ) :: p !< Parameters + type(SeaSt_ContinuousStateType), intent(in ) :: x !< Continuous states at operating point + type(SeaSt_DiscreteStateType), intent(in ) :: xd !< Discrete states at operating point + type(SeaSt_ConstraintStateType), intent(in ) :: z !< Constraint states at operating point + type(SeaSt_OtherStateType), intent(in ) :: OtherState !< Other states at operating point + type(SeaSt_OutputType), intent(inout) :: y !< Output (change to inout if a mesh copy is required); + type(SeaSt_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 + real(R8Ki), allocatable, optional, intent(inout) :: dXdx(:,:) !< Partial derivatives of continuous state + real(R8Ki), allocatable, optional, intent(inout) :: dXddx(:,:) !< Partial derivatives of discrete state + real(R8Ki), allocatable, optional, intent(inout) :: dZdx(:,:) !< Partial derivatives of constraint state + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + + ! Calculate the partial derivative of the output functions (Y) with respect to the continuous states (x): + ! if (present(dYdx)) then + ! endif + + ! Calculate the partial derivative of the continuous state functions (X) with respect to the continuous states (x): + ! if (present(dXdx)) then + ! endif + + ! Calculate the partial derivative of the discrete state functions (Xd) with respect to the continuous states (x): + ! if (present(dXddx)) then + ! endif + + ! Calculate the partial derivative of the constraint state functions (Z) with respect to the continuous states (x): + ! if (present(dZdx)) then + ! endif +end subroutine SeaSt_JacobianPContState + +!---------------------------------------------------------------------------------------------------------------------------------- +!> Linearization Jacobians dY/dxd, dX/dxd, dXd/dxd, and dZ/dxd +!! No discrete states, so this doesn't do anything +subroutine SeaSt_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(SeaSt_InputType), intent(in ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) + type(SeaSt_ParameterType), intent(in ) :: p !< Parameters + type(SeaSt_ContinuousStateType), intent(in ) :: x !< Continuous states at operating point + type(SeaSt_DiscreteStateType), intent(in ) :: xd !< Discrete states at operating point + type(SeaSt_ConstraintStateType), intent(in ) :: z !< Constraint states at operating point + type(SeaSt_OtherStateType), intent(in ) :: OtherState !< Other states at operating point + type(SeaSt_OutputType), intent(in ) :: y !< Output (change to inout if a mesh copy is required); + type(SeaSt_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 + real(R8Ki), allocatable, optional, intent(inout) :: dXdxd(:,:) !< Partial derivatives of continuous state + real(R8Ki), allocatable, optional, intent(inout) :: dXddxd(:,:)!< Partial derivatives of discrete state + real(R8Ki), allocatable, optional, intent(inout) :: dZdxd(:,:) !< Partial derivatives of constraint state + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + + ! Calculate the partial derivative of the output functions (Y) with respect to the discrete states (xd): + ! if (present(dYdxd)) then + ! endif + + ! Calculate the partial derivative of the continuous state functions (X) with respect to the discrete states (xd): + ! if (present(dXdxd)) then + ! endif + + ! Calculate the partial derivative of the discrete state functions (Xd) with respect to the discrete states (xd): + ! if (present(dXddxd)) then + ! endif + + ! Calculate the partial derivative of the constraint state functions (Z) with respect to the discrete states (xd): + ! if (present(dZdxd)) then + ! endif +end subroutine SeaSt_JacobianPDiscState + +!---------------------------------------------------------------------------------------------------------------------------------- +!> Linearization Jacobians dY/dz, dX/dz, dXd/dz, and dZ/dz +!! No constraint states, so this doesn't do anything +subroutine SeaSt_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(SeaSt_InputType), intent(in ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) + type(SeaSt_ParameterType), intent(in ) :: p !< Parameters + type(SeaSt_ContinuousStateType), intent(in ) :: x !< Continuous states at operating point + type(SeaSt_DiscreteStateType), intent(in ) :: xd !< Discrete states at operating point + type(SeaSt_ConstraintStateType), intent(in ) :: z !< Constraint states at operating point + type(SeaSt_OtherStateType), intent(in ) :: OtherState !< Other states at operating point + type(SeaSt_OutputType), intent(inout) :: y !< Output (change to inout if a mesh copy is required); + type(SeaSt_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 + real(R8Ki), allocatable, optional, intent(inout) :: dXdz(:,:) !< Partial derivatives of continuous + real(R8Ki), allocatable, optional, intent(inout) :: dXddz(:,:) !< Partial derivatives of discrete state + real(R8Ki), allocatable, optional, intent(inout) :: dZdz(:,:) !< Partial derivatives of constraint + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + + ! Calculate the partial derivative of the output functions (Y) with respect to the constraint states (z): + ! if (present(dYdz)) then + ! endif + + ! Calculate the partial derivative of the continuous state functions (X) with respect to the constraint states (z): + ! if (present(dXdz)) then + ! endif + + ! Calculate the partial derivative of the discrete state functions (Xd) with respect to the constraint states (z): + ! if (present(dXddz)) then + ! endif + + ! Calculate the partial derivative of the constraint state functions (Z) with respect to the constraint states (z): + ! if (present(dZdz)) then + ! endif +end subroutine SeaSt_JacobianPConstrState + +!---------------------------------------------------------------------------------------------------------------------------------- +!> Linearization operating points u_op, y_op, x_op, dx_op, xd_op, and z_op +subroutine SeaSt_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(SeaSt_InputType), intent(in ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) + type(SeaSt_ParameterType), intent(in ) :: p !< Parameters + type(SeaSt_ContinuousStateType), intent(in ) :: x !< Continuous states at operating point + type(SeaSt_DiscreteStateType), intent(in ) :: xd !< Discrete states at operating point + type(SeaSt_ConstraintStateType), intent(in ) :: z !< Constraint states at operating point + type(SeaSt_OtherStateType), intent(in ) :: OtherState !< Other states at operating point + type(SeaSt_OutputType), intent(in ) :: y !< Output at operating point + type(SeaSt_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) :: idxStart, idxEnd + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SeaSt_GetOP' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + + + if ( present( u_op ) ) then + if (.not. allocated(u_op)) then + call AllocAry(u_op, p%LinParams%Jac_nu, 'u_op', ErrStat2, ErrMsg2) + if (Failed()) return + end if + + ! no regular inputs, only extended input + u_op(p%LinParams%Jac_u_idxStartList%Extended) = 0.0_ReKi ! WaveElev0 is zero to be consistent with linearization requirements + ! NOTE: if more extended inputs are added, place them here + end if + + if ( present( y_op ) ) then + if (.not. allocated(y_op)) then + call AllocAry(y_op, p%LinParams%Jac_ny, 'y_op', ErrStat2, ErrMsg2) + if (Failed()) return + end if + + ! no regular outputs, only extended output and WrOuts + y_op(p%LinParams%Jac_y_idxStartList%Extended) = 0.0_ReKi ! WaveElev0 is zero to be consistent with linearization requirements + ! NOTE: if more extended inputs are added, place them here + + ! WrOuts may not be sent to OpenFAST (y_op sized smaller if WrOuts not sent to OpenFAST) + if (p%LinParams%Jac_y_idxStartList%WrOuts <= p%LinParams%Jac_ny) then + idxStart = p%LinParams%Jac_y_idxStartList%WrOuts + idxEnd = p%LinParams%Jac_y_idxStartList%WrOuts + p%NumOuts - 1 + ! unnecessary array check to make me feel better about the potentially sloppy indexing + if (idxEnd > p%LinParams%Jac_ny) then + ErrStat2 = ErrID_Fatal; ErrMsg2 = "Error in the y_op sizing -- u_op not large enough for WrOuts" + if (Failed()) return + endif + ! copy over the returned outputs + y_op(idxStart:idxEnd) = y%WriteOutput(1:p%NumOuts) + endif + end if + + +contains + logical function Failed() + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + Failed = ErrStat >= AbortErrLev + end function Failed +end subroutine SeaSt_GetOP + +!---------------------------------------------------------------------------------------------------------------------------------- +END MODULE SeaState +!********************************************************************************************************************************** diff --git a/modules/seastate/src/SeaState.txt b/modules/seastate/src/SeaState.txt new file mode 100644 index 0000000000..f38dfdf231 --- /dev/null +++ b/modules/seastate/src/SeaState.txt @@ -0,0 +1,183 @@ +################################################################################################################################### +################################################################################################################################### +# Registry for SeaState in the FAST Modularization Framework +# This Registry file is used to create MODULE SeaState which contains all of the user-defined types needed in SeaState. +# It also contains copy, destroy, pack, and unpack routines associated with each defined data types. +# See 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) ............................................................................ +# make sure that the file name does not have any trailing white spaces! +include Registry_NWTC_Library.txt +usefrom Current.txt +usefrom Waves.txt +usefrom Waves2.txt +usefrom SeaSt_WaveField.txt +# +# +typedef SeaState/SeaSt SeaSt_InputFile LOGICAL EchoFlag - - - "Echo the input file" +typedef ^ ^ ReKi MSL2SWL - - - "Mean Sea Level to Still Water Level offset" m +typedef ^ ^ ReKi X_HalfWidth - - - "Half-width of the domain in the X direction" m +typedef ^ ^ ReKi Y_HalfWidth - - - "Half-width of the domain in the Y direction" m +typedef ^ ^ ReKi Z_Depth - - - "Depth of the domain the Z direction" m +typedef ^ ^ INTEGER NX - - - "Number of nodes in half of the X-direction domain" +typedef ^ ^ INTEGER NY - - - "Number of nodes in half of the Y-direction domain" +typedef ^ ^ INTEGER NZ - - - "Number of nodes in half of the Z-direction domain" +typedef ^ ^ Waves_InitInputType Waves - - - "Initialization data for Waves module" - +typedef ^ ^ Waves2_InitInputType Waves2 - - - "Initialization data for Waves2 module" - +typedef ^ ^ Current_InitInputType Current - - - "Initialization data for Current module" - +typedef ^ ^ LOGICAL Echo - - - "Echo the input files to a file with the same name as the input but with a .echo extension [T/F]" - +typedef ^ ^ INTEGER NWaveElev - - - "Number of user-requested points where the incident wave elevations can be output" - +typedef ^ ^ SiKi WaveElevxi {:} - - "xi-coordinates for points where the incident wave elevations can be output" (meters) +typedef ^ ^ SiKi WaveElevyi {:} - - "yi-coordinates for points where the incident wave elevations can be output" (meters) +typedef ^ ^ INTEGER NWaveKin - - - "Number of points where the incident wave kinematics will be computed" - +typedef ^ ^ SiKi WaveKinxi {:} - - "xi-coordinates for points where the incident wave kinematics will be computed; these are relative to the mean sea level" (meters) +typedef ^ ^ SiKi WaveKinyi {:} - - "yi-coordinates for points where the incident wave kinematics will be computed; these are relative to the mean sea level" (meters) +typedef ^ ^ SiKi WaveKinzi {:} - - "zi-coordinates for points where the incident wave kinematics will be computed; these are relative to the mean sea level" (meters) +typedef ^ ^ INTEGER OutSwtch - - - "Output requested channels to: [1=SeaState.out 2=GlueCode.out 3=both files]" - +typedef ^ ^ LOGICAL OutAll - - - "Output all user-specified member and joint loads (only at each member end, not interior locations) [T/F]" - +typedef ^ ^ INTEGER NumOuts - - - "The number of outputs for this module as requested in the input file" - +typedef ^ ^ CHARACTER(ChanLen) OutList {:} - - "The user-requested output channel labels for this modules. This should really be dimensioned with MaxOutPts" - +typedef ^ ^ LOGICAL SeaStSum - - - "Generate a SeaState summary file [T/F]" - +typedef ^ ^ CHARACTER(20) OutFmt - - - "Output format for numerical results" - +typedef ^ ^ CHARACTER(20) OutSFmt - - - "Output format for header strings" - +typedef ^ ^ INTEGER WaveStMod - - - "Model for stretching incident wave kinematics to instantaneous free surface {0: none=no stretching, 1: vertical stretching, 2: extrapolation stretching, 3: Wheeler stretching}" - +typedef ^ ^ ReKi WtrDpth - - - "Water depth, this is necessary to inform glue-code what the module is using for WtrDpth (may not be the glue-code's default)" (m) +typedef ^ ^ ReKi WtrDens - - - "Water density, this is necessary to inform glue-code what the module is using for WtrDens (may not be the glue-code's default)" (kg/m^3) +typedef ^ ^ INTEGER WaveDirMod - - - "Directional wave spreading function {0: none, 1: COS2S} [only used if WaveMod=6]" - +typedef ^ ^ SiKi WaveDir - - - "Incident wave propagation heading direction" (degrees) +typedef ^ ^ LOGICAL WaveMultiDir - - - "Indicates the waves are multidirectional" - +typedef ^ ^ SiKi MCFD - - - "Diameter of members that will use the MacCamy-Fuchs diffraction model" +typedef ^ ^ SiKi WvLowCOff - - - "Low cut-off frequency or lower frequency limit of the wave spectrum beyond which the wave spectrum is zeroed. [used only when WaveMod=2,3,4]" (rad/s) +typedef ^ ^ SiKi WvHiCOff - - - "High cut-off frequency or upper frequency limit of the wave spectrum beyond which the wave spectrum is zeroed. [used only when WaveMod=2,3,4]" (rad/s) +typedef ^ ^ SiKi WvLowCOffD - - - "Minimum frequency used in the difference methods [Ignored if all difference methods = 0]" (rad/s) +typedef ^ ^ SiKi WvHiCOffD - - - "Maximum frequency used in the difference methods [Ignored if all difference methods = 0]" (rad/s) +typedef ^ ^ SiKi WvLowCOffS - - - "Minimum frequency used in the sum-QTF method [Ignored if SumQTF = 0]" (rad/s) +typedef ^ ^ SiKi WvHiCOffS - - - "Maximum frequency used in the sum-QTF method [Ignored if SumQTF = 0]" (rad/s) +typedef ^ ^ SiKi WaveDOmega - - - "Frequency step for incident wave calculations" (rad/s) +typedef ^ ^ INTEGER WaveMod - - - "Incident wave kinematics model: See valid values in SeaSt_WaveField module parameters." - + + +typedef SeaState/SeaSt InitInputType CHARACTER(1024) InputFile - - - "Supplied by Driver: full path and filename for the SeaState module" - +typedef ^ ^ LOGICAL UseInputFile - .TRUE. - "Supplied by Driver: .TRUE. if using a input file, .FALSE. if all inputs are being passed in by the caller" - +typedef ^ ^ FileInfoType PassedFileData - - - "If we don't use the input file, pass everything through this" - +typedef ^ ^ CHARACTER(1024) OutRootName - - - "Supplied by Driver: The name of the root file (without extension) including the full path" - +typedef ^ ^ ReKi Gravity - - - "Supplied by Driver: Gravitational acceleration" "(m/s^2)" +typedef ^ ^ ReKi defWtrDens - - - "Default water density from the driver; may be overwritten " "(kg/m^3)" +typedef ^ ^ ReKi defWtrDpth - - - "Default water depth from the driver; may be overwritten " "m" +typedef ^ ^ ReKi defMSL2SWL - - - "Default mean sea level to still water level from the driver; may be overwritten" "m" +typedef ^ ^ DbKi TMax - - - "Supplied by Driver: The total simulation time" "(sec)" +typedef ^ ^ INTEGER WaveFieldMod - - - "Wave field handling (-) (switch) 0: use individual SeaState inputs without adjustment, 1: adjust wave phases based on turbine offsets from farm origin" - +typedef ^ ^ ReKi PtfmLocationX - - - "Supplied by Driver: X coordinate of platform location in the wave field" "m" +typedef ^ ^ ReKi PtfmLocationY - - - "Supplied by Driver: Y coordinate of platform location in the wave field" "m" +typedef ^ ^ IntKi WrWvKinMod - 0 - "0,1, or 2 indicating whether we are going to write out kinematics files. [ignored if WaveMod = 6, if 1 or 2 then files are written using the outrootname]" - +typedef ^ ^ LOGICAL HasIce - - - "Supplied by Driver: Whether this simulation has ice loading (flag)" - +typedef ^ ^ Logical Linearize - .FALSE. - "Flag that tells this module if the glue code wants to linearize." - +typedef ^ ^ Logical SurfaceVis - .FALSE. - "Turn on grid surface visualization outputs" - +typedef ^ ^ IntKi SurfaceVisNx - 0 - "Number of points in X direction to output for visualization grid. Use 0 or negative to set to SeaState resolution." - +typedef ^ ^ IntKi SurfaceVisNy - 0 - "Number of points in Y direction to output for visualization grid. Use 0 or negative to set to SeaState resolution." - + +# +# +# Define outputs from the initialization routine here: +# +typedef ^ InitOutputType CHARACTER(ChanLen) WriteOutputHdr {:} - - "The is the list of all HD-related output channel header strings (includes all sub-module channels)" - +typedef ^ ^ CHARACTER(ChanLen) WriteOutputUnt {:} - - "The is the list of all HD-related output channel unit strings (includes all sub-module channels)" - +typedef ^ ^ ProgDesc Ver - - - "Version of SeaState" +typedef ^ ^ LOGICAL InvalidWithSSExctn - - - "Whether SeaState configuration is invalid with HydroDyn's state-space excitation (ExctnMod=2)" (-) +typedef ^ ^ SiKi WaveElevVisX {:} - - "X locations of grid output" "m,-" +typedef ^ ^ SiKi WaveElevVisY {:} - - "Y locations of grid output" "m,-" +typedef ^ ^ SiKi WaveElevVisGrid {:}{:}{:} - - "Wave elevation time-series at each of the points given by WaveElevXY. First dimension is the timestep. Second/third dimensions are the grid of points." (m) +typedef ^ ^ SeaSt_WaveFieldType *WaveField - - - "Pointer to wave field" +typedef ^ ^ CHARACTER(LinChanLen) LinNames_y {:} - - "Names of the outputs used in linearization" - +typedef ^ ^ CHARACTER(LinChanLen) LinNames_u {:} - - "Names of the inputs used in linearization" - +typedef ^ ^ LOGICAL RotFrame_u {:} - - "Flag that tells FAST/MBC3 if the inputs used in linearization are in the rotating frame" - +typedef ^ ^ LOGICAL RotFrame_y {:} - - "Flag that tells FAST/MBC3 if the outputs used in linearization are in the rotating frame" - +typedef ^ ^ LOGICAL IsLoad_u {:} - - "Flag that tells FAST if the inputs used in linearization are loads (for preconditioning matrix)" - + + + +# +# +# ..... States .................................................................................................................... +# Define continuous (differentiable) states here: +typedef ^ ContinuousStateType R8Ki UnusedStates - - - "placeholder for states" - +# +# +# Define discrete (nondifferentiable) states here: +typedef ^ DiscreteStateType R8Ki UnusedStates - - - "placeholder for states" - +# +# +# Define constraint states here: +typedef ^ ConstraintStateType R8Ki UnusedStates - - - "placeholder for states" - +# +# +# Define any other states, including integer or logical states here: +typedef ^ OtherStateType R8Ki UnusedStates - - - "placeholder for 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 INTEGER Decimate - - - "The output decimation counter" - +typedef ^ ^ DbKi LastOutTime - - - "Last time step which was written to the output file (sec)" - +typedef ^ ^ INTEGER LastIndWave - - - "The last index used in the wave kinematics arrays, used to optimize interpolation" - +typedef ^ ^ SeaSt_WaveField_MiscVarType WaveField_m - - - "misc var information from the SeaState Interpolation module" - + +# .... Linearization params ....................................................................................................... +# NOTE: This is overkill given how limited linearization is. For completeness and similarity to other modules, keeping all this here. Also note some +# values are set here, but will be overwritten in the code. +typedef ^ Jac_u_idxStarts IntKi Extended - 1 - "Index to first point in u jacobian for Extended" - +typedef ^ Jac_y_idxStarts IntKi Extended - 1 - "Index to first point in y jacobian for Extended" - +typedef ^ Jac_y_idxStarts IntKi WrOuts - 2 - "Index to first point in y jacobian for WrOuts" - +typedef ^ SeaSt_LinParams IntKi NumExtendedInputs - 1 - "number of extended inputs" - +typedef ^ ^ IntKi NumExtendedOutputs - 1 - "number of extended outputs" - +typedef ^ ^ Jac_u_idxStarts Jac_u_idxStartList - - - "Starting indices for all Jac_u components" - +typedef ^ ^ Jac_y_idxStarts Jac_y_idxStartList - - - "Starting indices for all Jac_y components" - +typedef ^ ^ ReKi du {:} - - "vector that determines size of perturbation for u (inputs)" +typedef ^ ^ IntKi Jac_nu - - - "number of inputs in jacobian matrix" - +typedef ^ ^ IntKi Jac_ny - - - "number of outputs in jacobian matrix" - + + + +# ..... 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 WaveDT - - - "Wave DT" sec +typedef ^ ^ INTEGER NGridPts - - - "Number of data points in the wave kinematics grid" - +typedef ^ ^ INTEGER NGrid 3 - - "Number of grid entries in x, y, and z" +typedef ^ ^ ReKi deltaGrid 3 - - "delta between grid points in x, y, and theta (for z)" m,m,rad +typedef ^ ^ INTEGER NWaveElev - - - "Number of wave elevation outputs" - +typedef ^ ^ SiKi WaveElevxi {:} - - "xi-coordinates for points where the incident wave elevations can be output" (meters) +typedef ^ ^ SiKi WaveElevyi {:} - - "yi-coordinates for points where the incident wave elevations can be output" (meters) +typedef ^ ^ INTEGER NWaveKin - - - "Number of points where the incident wave kinematics can be output" - +typedef ^ ^ SiKi WaveKinxi {:} - - "xi-coordinates for points where the incident wave kinematics can be output; these are relative to the mean sea level" (meters) +typedef ^ ^ SiKi WaveKinyi {:} - - "yi-coordinates for points where the incident wave kinematics can be output; these are relative to the mean sea level" (meters) +typedef ^ ^ SiKi WaveKinzi {:} - - "zi-coordinates for points where the incident wave kinematics can be output; these are relative to the mean sea level" (meters) +typedef ^ ^ OutParmType OutParam {:} - - "" - +typedef ^ ^ INTEGER NumOuts - - - "Number of SeaState module-level outputs (not the total number including sub-modules" - +typedef ^ ^ INTEGER OutSwtch - - - "Output requested channels to: [1=SeaState.out 2=GlueCode.out 3=both files]" - +typedef ^ ^ CHARACTER(20) OutFmt - - - "Output format for numerical results" - +typedef ^ ^ CHARACTER(20) OutSFmt - - - "Output format for header strings" - +typedef ^ ^ CHARACTER(1) Delim - - - "Delimiter string for outputs, defaults to space" - +typedef ^ ^ INTEGER UnOutFile - - - "File unit for the SeaState outputs" - +typedef ^ ^ INTEGER OutDec - - - "Write every OutDec time steps" - +typedef ^ ^ SeaSt_WaveFieldType &WaveField - - - "Wave field" - +typedef ^ ^ SeaSt_LinParams LinParams - - - "Linearization parameters" - + +# +# +# ..... Inputs .................................................................................................................... +# Define inputs that are contained on the mesh here: +# +typedef ^ InputType SiKi DummyInput - - - "Remove this variable if you have inputs" - +# +# +# ..... Outputs ................................................................................................................... +# Define outputs that are contained on the mesh here: +typedef ^ OutputType ReKi WriteOutput {:} - - "Outputs to be written to the output file(s)" - diff --git a/modules/seastate/src/SeaState_DriverCode.f90 b/modules/seastate/src/SeaState_DriverCode.f90 new file mode 100644 index 0000000000..885a1f50e7 --- /dev/null +++ b/modules/seastate/src/SeaState_DriverCode.f90 @@ -0,0 +1,690 @@ +!********************************************************************************************************************************** +! SeaState_DriverCode: This code tests the template modules +!.................................................................................................................................. +! LICENSING +! Copyright (C) 2012-2015 National Renewable Energy Laboratory +! +! This file is part of SeaState. +! +! 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 SeaStateDriver + + use NWTC_Library + use SeaState + use SeaState_Types + use SeaState_Output + use ModMesh_Types + use VersionInfo + + implicit none + + type SeaSt_Drvr_InitInput + logical :: Echo + real(ReKi) :: Gravity + real(ReKi) :: WtrDens + real(ReKi) :: WtrDpth + real(ReKi) :: MSL2SWL + character(1024) :: SeaStateInputFile + character(1024) :: OutRootName + integer :: WrWvKinMod + integer :: NSteps + real(DbKi) :: TimeInterval + logical :: WaveElevVis !< Should we put together a wave elevation series and save it to file? + integer(IntKi) :: WaveElevVisNx !< Number of points in the X direction for the wave elevation series (-) + integer(IntKi) :: WaveElevVisNy !< Number of points in the X direction for the wave elevation series (-) + end type SeaSt_Drvr_InitInput + +! ----------------------------------------------------------------------------------- +! NOTE: this module and the ModMesh.f90 modules must use the Fortran compiler flag: +! /fpp because of they both have preprocessor statements +! ----------------------------------------------------------------------------------- + + INTEGER(IntKi), PARAMETER :: NumInp = 1 ! Number of inputs sent to HydroDyn_UpdateStates + + ! Program variables + + real(DbKi) :: Time ! Variable for storing time, in seconds + + real(DbKi) :: InputTime(NumInp) ! Variable for storing time associated with inputs, in seconds + real(DbKi) :: Interval ! HD module requested time interval + integer(B1Ki), allocatable :: SaveAry(:) ! Array to store packed data structure + + type(SeaSt_InitInputType) :: InitInData ! Input data for initialization + type(SeaSt_InitOutputType) :: InitOutData ! Output data from initialization + + type(SeaSt_ContinuousStateType) :: x ! Continuous states + type(SeaSt_ContinuousStateType) :: x_new ! Continuous states at updated time + type(SeaSt_DiscreteStateType) :: xd ! Discrete states + type(SeaSt_DiscreteStateType) :: xd_new ! Discrete states at updated time + type(SeaSt_ConstraintStateType) :: z ! Constraint states + type(SeaSt_ConstraintStateType) :: z_residual ! Residual of the constraint state equations (Z) + type(SeaSt_OtherStateType) :: OtherState ! Other states + type(SeaSt_MiscVarType) :: m ! Misc/optimization variables + + type(SeaSt_ParameterType) :: p ! Parameters + !type(SeaSt_InputType) :: u ! System inputs [OLD STYLE] + type(SeaSt_InputType) :: u(NumInp) ! System inputs + type(SeaSt_OutputType) :: y ! System outputs + + integer(IntKi) :: UnSeaSt_Out ! Output file identifier + integer(IntKi) :: I ! Generic loop counter + integer(IntKi) :: J ! Generic loop counter + integer(IntKi) :: n ! Loop counter (for time step) + integer(IntKi) :: ErrStat,ErrStat2 ! Status of error message + character(1024) :: ErrMsg,ErrMsg2 ! Error message if ErrStat /= ErrID_None + real(R8Ki) :: dcm (3,3) ! The resulting transformation matrix from X to x, (-). + 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(SeaSt_Drvr_InitInput) :: drvrInitInp ! Initialization data for the driver program + + integer :: StrtTime (8) ! Start time of simulation (including intialization) + integer :: SimStrtTime (8) ! Start time of simulation (after initialization) + real(ReKi) :: PrevClockTime ! Clock time at start of simulation in seconds + real(ReKi) :: UsrTime1 ! User CPU time for simulation initialization + real(ReKi) :: UsrTime2 ! User CPU time for simulation (without intialization) + real(DbKi) :: TiLstPrn ! The simulation time of the last print + real(DbKi) :: t_global ! Current simulation time (for global/FAST simulation) + real(DbKi) :: SttsTime ! Amount of time between screen status messages (sec) + integer :: n_SttsTime ! Number of time steps between screen status messages (-) + + + ! For testing + logical :: DoTight = .FALSE. + + + + character(20) :: FlagArg ! Flag argument from command line + character(200) :: git_commit ! String containing the current git commit hash + + type(ProgDesc), parameter :: version = ProgDesc( 'SeaState Driver', '', '' ) ! The version number of this program. + + ! Variables Init + Time = -99999 + + !............................................................................................................................... + ! Routines called in initialization + !............................................................................................................................... + + + + ! TODO: Need to think some more about how to pass DRIVER-level initialization data to the SeaState module because if UseInputFile = .FALSE. + ! then the input processing code will still be querying the *Chr input data to look for the use of the 'DEFAULT' string and to set that + ! data to the driver's version instead of using a module-specific version. + ! Currently, these variables are: + ! InitInp%Waves%WavePkShpChr + ! InitInp%Current%CurrSSDirChr + ! InitInp%PtfmSgFChr + ! InitInp%PtfmSwFChr + ! InitInp%PtfmHvFChr + ! InitInp%PtfmRFChr + ! InitInp%PtfmPFChr + ! InitInp%PtfmYFChr + ! InitInp%Morison%InpMembers(k)%FillDensChr + ! + ! + + call NWTC_Init( ProgNameIn=version%Name ) + + drvrFilename = '' + call CheckArgs( drvrFilename, Flag=FlagArg ) + if ( LEN( TRIM(FlagArg) ) > 0 ) call NormStop() + + ! Display the copyright notice + call DispCopyrightLicense( version%Name ) + CALL DispCompileRuntimeInfo( version%Name ) + + + ! Parse the driver input file and run the simulation based on that file + call ReadDriverInputFile( drvrFilename, drvrInitInp, ErrStat, ErrMsg ) + if (errStat >= AbortErrLev) then + ! Clean up and exit + call SeaSt_DvrCleanup() + end if + InitInData%Gravity = drvrInitInp%Gravity + InitInData%defWtrDens = drvrInitInp%WtrDens + InitInData%defWtrDpth = drvrInitInp%WtrDpth + InitInData%defMSL2SWL = drvrInitInp%MSL2SWL + InitInData%UseInputFile = .TRUE. + InitInData%InputFile = drvrInitInp%SeaStateInputFile + InitInData%OutRootName = drvrInitInp%OutRootName + InitInData%TMax = (drvrInitInp%NSteps-1) * drvrInitInp%TimeInterval ! Starting time is always t = 0.0 + InitInData%HasIce = .false. + + ! 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) + SttsTime = 1.0 ! seconds + + ! figure out how many time steps we should go before writing screen output: + n_SttsTime = MAX( 1, NINT( SttsTime / drvrInitInp%TimeInterval ) ) ! this may not be the final TimeInterval, though!!! GJH 8/14/14 + + InitInData%WrWvKinMod = drvrInitInp%WrWvKinMod +!------------------------------------------------------------------------------------- +! Begin Simulation Setup +!------------------------------------------------------------------------------------- + + ! Setup the arrays for the wave elevation timeseries if requested by the driver input file + if ( drvrInitInp%WaveElevVis ) then + InitInData%SurfaceVis = .true. +!FIXME: enable this when we can use an arbitrary number of points from the FFT of the data. + !InitInData%SurfaceVisNx = drvrInitInp%WaveElevVisNx ! Number of points in X + !InitInData%SurfaceVisNy = drvrInitInp%WaveElevVisNy ! Number of points in Y + InitInData%SurfaceVisNx = 0 ! use the WaveField grid resolution + InitInData%SurfaceVisNy = 0 ! use the WaveField grid resolution + endif + + ! Initialize the module + Interval = drvrInitInp%TimeInterval + call SeaSt_Init( InitInData, u(1), p, x, xd, z, OtherState, y, m, Interval, InitOutData, ErrStat, ErrMsg ) + if (errStat >= AbortErrLev) then + ! Clean up and exit + call SeaSt_DvrCleanup() + end if + + if ( Interval /= drvrInitInp%TimeInterval) then + call SetErrStat( ErrID_Fatal, 'The SeaState Module attempted to change timestep interval, but this is not allowed. The SeaState Module must use the Driver Interval.', ErrStat, ErrMsg, 'Driver') + call SeaSt_DvrCleanup() + end if + + + ! Write the gridded wave elevation data to a file + + if ( drvrInitInp%WaveElevVis ) call WaveElevGrid_Output (drvrInitInp, InitInData, InitOutData, p, ErrStat, ErrMsg) + if (errStat >= AbortErrLev) then + ! Clean up and exit + call SeaSt_DvrCleanup() + end if + + + ! Destroy initialization data + + call SeaSt_DestroyInitInput( InitInData, ErrStat, ErrMsg ) + call SeaSt_DestroyInitOutput( InitOutData, ErrStat, ErrMsg ) + + + if (errStat >= AbortErrLev) then + ! Clean up and exit + call SeaSt_DvrCleanup() + end if + + + + !............................................................................................................................... + ! Routines called in loose coupling -- the glue code may implement this in various ways + !............................................................................................................................... + Time = 0.0 + call SimStatus_FirstTime( TiLstPrn, PrevClockTime, SimStrtTime, UsrTime2, time, InitInData%TMax ) + + ! loop through time steps + + + do n = 1, drvrInitInp%NSteps + + Time = (n-1) * drvrInitInp%TimeInterval + InputTime(1) = Time + + ! Calculate outputs at n + + call SeaSt_CalcOutput( Time, u(1), p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) + if (errStat >= AbortErrLev) then + ! Clean up and exit + call SeaSt_DvrCleanup() + end if + + + if ( MOD( n + 1, n_SttsTime ) == 0 ) then + + call SimStatus( TiLstPrn, PrevClockTime, time, InitInData%TMax ) + + endif + + ! Write output to a file which is managed by the driver program and not the individual modules + ! TODO + + end do + + + +! For now, finish here. +call SeaSt_DvrCleanup() + + + + contains + + + +subroutine SeaSt_DvrCleanup() + + ! Local variables + character(len(errMsg)) :: errMsg2 ! temporary Error message if ErrStat /= ErrID_None + integer(IntKi) :: errStat2 ! temporary Error status of the operation + + errStat2 = ErrID_None + errMsg2 = "" + + call SeaSt_DestroyInitInput( InitInData, errStat2, errMsg2 ) + call SetErrStat( errStat2, errMsg2, errStat, errMsg, 'SeaSt_DvrCleanup' ) + + call SeaSt_End( u(1), p, x, xd, z, OtherState, y, m, errStat2, errMsg2 ) + call SetErrStat( errStat2, errMsg2, errStat, errMsg, 'SeaSt_DvrCleanup' ) + + if ( ErrStat /= ErrID_None ) then !This assumes PRESENT(ErrID) is also .TRUE. : + call WrScr(NewLine//NewLine//'Error status and messages after execution:'//NewLine//' ErrStat: '// & + TRIM(Num2LStr(ErrStat))//NewLine//' ErrMsg returned: '//TRIM(ErrMsg)//NewLine) + if ( time < 0.0 ) then + ErrMsg = 'at initialization' + else if ( time > InitInData%TMax ) then + ErrMsg = 'after computing the solution' + else + ErrMsg = 'at simulation time '//trim(Num2LStr(time))//' of '//trim(Num2LStr(InitInData%TMax))//' seconds' + end if + + if (ErrStat >= AbortErrLev) then + call ProgAbort( 'SeaState encountered an error '//trim(errMsg)//'.'//NewLine//' Simulation error level: '& + //trim(GetErrStr(errStat)), TrapErrors=.FALSE., TimeWait=3._ReKi ) ! wait 3 seconds (in case they double-clicked and got an error) + end if + end if + + call RunTimes( StrtTime, real(UsrTime1,ReKi), SimStrtTime, real(UsrTime2,ReKi), time ) + call NormStop() + +end subroutine SeaSt_DvrCleanup + + +SUBROUTINE ReadDriverInputFile( inputFile, InitInp, ErrStat, ErrMsg ) + + character(1024), intent( in ) :: inputFile + type(SeaSt_Drvr_InitInput), intent( out ) :: InitInp + 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 integer for counting + integer :: J ! generic integer for counting + character( 2) :: strI ! string version of the loop counter + + integer :: UnIn ! Unit number for the input file + integer :: UnEchoLocal ! The local unit number for this module's echo file + character(1024) :: EchoFile ! Name of SeaState 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 SeaState input file + + real(ReKi) :: TmpRealVar2(2) !< Temporary real array size 2 + integer(IntKi) :: TmpIntVar2(2) !< Temporary integer array size 2 + + + + ! 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(inputFile) + + call GetNewUnit( UnIn ) + call OpenFInpFile ( UnIn, FileName, ErrStat, ErrMsg ) + if (ErrStat >=AbortErrLev) then + call WrScr( ErrMsg ) + stop + endif + + + call WrScr( 'Opening SeaState Driver input file: '//FileName ) + + + !------------------------------------------------------------------------------------------------- + ! File header + !------------------------------------------------------------------------------------------------- + + call ReadCom( UnIn, FileName, 'SeaState Driver input file header line 1', ErrStat, ErrMsg ) + + if ( ErrStat >=AbortErrLev ) then + close( UnIn ) + return + end if + + + call ReadCom( UnIn, FileName, 'SeaState Driver input file header line 2', ErrStat, ErrMsg ) + + if ( ErrStat >=AbortErrLev ) then + close( UnIn ) + return + end if + + + ! Echo Input Files. + + call ReadVar ( UnIn, FileName, InitInp%Echo, 'Echo', 'Echo Input', ErrStat, ErrMsg ) + + if ( ErrStat>=AbortErrLev ) then + close( UnIn ) + return + end if + + + ! 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 ( InitInp%Echo ) then + + EchoFile = TRIM(FileName)//'.ech' + call GetNewUnit( UnEchoLocal ) + call OpenEcho ( UnEchoLocal, EchoFile, ErrStat, ErrMsg ) + if ( ErrStat >= AbortErrLev ) then + close( UnIn ) + return + end if + + REWIND(UnIn) + + call ReadCom( UnIn, FileName, 'SeaState Driver input file header line 1', ErrStat, ErrMsg, UnEchoLocal ) + + if ( ErrStat >= AbortErrLev ) then + if (InitInp%Echo .and. UnEchoLocal>0) close(UnEchoLocal) + close( UnIn ) + return + end if + + + call ReadCom( UnIn, FileName, 'SeaState Driver input file header line 2', ErrStat, ErrMsg, UnEchoLocal ) + + if ( ErrStat >= AbortErrLev ) then + if (InitInp%Echo .and. UnEchoLocal>0) close(UnEchoLocal) + close( UnIn ) + return + end if + + + ! Echo Input Files. Note this line is prevented from being echoed by the ReadVar routine. + + call ReadVar ( UnIn, FileName, InitInp%Echo, 'Echo', 'Echo the input file data', ErrStat, ErrMsg, UnEchoLocal ) + !write (UnEchoLocal,Frmt ) InitInp%Echo, 'Echo', 'Echo input file' + if ( ErrStat >= AbortErrLev ) then + if (InitInp%Echo .and. UnEchoLocal>0) close(UnEchoLocal) + close( UnIn ) + return + end if + + end if + !------------------------------------------------------------------------------------------------- + ! Environmental conditions section + !------------------------------------------------------------------------------------------------- + + ! Header + + call ReadCom( UnIn, FileName, 'Environmental conditions header', ErrStat, ErrMsg, UnEchoLocal ) + + if ( ErrStat >= AbortErrLev ) then + if (InitInp%Echo .and. UnEchoLocal>0) close(UnEchoLocal) + close( UnIn ) + return + end if + + + ! Gravity - Gravity. + + call ReadVar ( UnIn, FileName, InitInp%Gravity, 'Gravity', 'Gravity', ErrStat, ErrMsg, UnEchoLocal ) + + if ( ErrStat >= AbortErrLev ) then + if (InitInp%Echo .and. UnEchoLocal>0) close(UnEchoLocal) + close( UnIn ) + return + end if + + ! WtrDens - Water density. + + call ReadVar ( UnIn, FileName, InitInp%WtrDens, 'WtrDens', 'Water density', ErrStat, ErrMsg, UnEchoLocal ) + + if ( ErrStat >= AbortErrLev ) then + if (InitInp%Echo .and. UnEchoLocal>0) close(UnEchoLocal) + close( UnIn ) + return + end if + + ! WtrDpth - Water depth. + + call ReadVar ( UnIn, FileName, InitInp%WtrDpth, 'WtrDpth', 'Water depth', ErrStat, ErrMsg, UnEchoLocal ) + + if ( ErrStat >= AbortErrLev ) then + if (InitInp%Echo .and. UnEchoLocal>0) close(UnEchoLocal) + close( UnIn ) + return + end if + + ! MSL2SWL - Offset between still-water level and mean sea level. + + call ReadVar ( UnIn, FileName, InitInp%MSL2SWL, 'MSL2SWL', 'Offset between still-water level and mean sea level', ErrStat, ErrMsg, UnEchoLocal ) + + if ( ErrStat >= AbortErrLev ) then + if (InitInp%Echo .and. UnEchoLocal>0) close(UnEchoLocal) + close( UnIn ) + return + end if + + !------------------------------------------------------------------------------------------------- + ! SeaState section + !------------------------------------------------------------------------------------------------- + + ! Header + + call ReadCom( UnIn, FileName, 'SeaState header', ErrStat, ErrMsg, UnEchoLocal ) + + if ( ErrStat >= AbortErrLev ) then + if (InitInp%Echo .and. UnEchoLocal>0) close(UnEchoLocal) + close( UnIn ) + return + end if + + + ! HDInputFile + + call ReadVar ( UnIn, FileName, InitInp%SeaStateInputFile, 'SeaStateInputFile', & + 'SeaState input filename', ErrStat, ErrMsg, UnEchoLocal ) + + if ( ErrStat >= AbortErrLev ) then + if (InitInp%Echo .and. UnEchoLocal>0) close(UnEchoLocal) + close( UnIn ) + return + end if + + + ! OutRootName + + call ReadVar ( UnIn, FileName, InitInp%OutRootName, 'OutRootName', & + 'SeaState output root filename', ErrStat, ErrMsg, UnEchoLocal ) + + if ( ErrStat >= AbortErrLev ) then + if (InitInp%Echo .and. UnEchoLocal>0) close(UnEchoLocal) + close( UnIn ) + return + end if + + ! WrWvKinMod - Write Kinematics? + + call ReadVar ( UnIn, FileName, InitInp%WrWvKinMod, 'WrWvKinMod', 'WrWvKinMod', ErrStat, ErrMsg, UnEchoLocal ) + + if ( ErrStat >= AbortErrLev ) then + if (InitInp%Echo .and. UnEchoLocal>0) close(UnEchoLocal) + close( UnIn ) + return + end if + + if ( InitInp%WrWvKinMod < 0 .or. InitInp%WrWvKinMod > 2 ) then + ErrMsg = ' WrWvKinMod parameter must be 0, 1, or 2' + ErrStat = ErrID_Fatal + if (InitInp%Echo .and. UnEchoLocal>0) close(UnEchoLocal) + close( UnIn ) + return + end if + + + ! NSteps + + call ReadVar ( UnIn, FileName, InitInp%NSteps, 'NSteps', & + 'Number of time steps in the SeaState simulation', ErrStat, ErrMsg, UnEchoLocal ) + + if ( ErrStat >= AbortErrLev ) then + if (InitInp%Echo .and. UnEchoLocal>0) close(UnEchoLocal) + close( UnIn ) + return + end if + + + ! TimeInterval + + call ReadVar ( UnIn, FileName, InitInp%TimeInterval, 'TimeInterval', & + 'Time interval for any SeaState inputs', ErrStat, ErrMsg, UnEchoLocal ) + + if ( ErrStat >= AbortErrLev ) then + if (InitInp%Echo .and. UnEchoLocal>0) close(UnEchoLocal) + close( UnIn ) + return + end if + + + !------------------------------------------------------------------------------------------------- + !> ### Waves elevation series section + !------------------------------------------------------------------------------------------------- + + !> Header + + call ReadCom( UnIn, FileName, 'Waves multipoint elevation output header', ErrStat, ErrMsg, UnEchoLocal ) + + if ( ErrStat >= AbortErrLev ) then + if (InitInp%Echo .and. UnEchoLocal>0) close(UnEchoLocal) + close( UnIn ) + return + end if + + !> WaveElevSeriesFlag -- are we doing multipoint wave elevation output? + call ReadVar ( UnIn, FileName, InitInp%WaveElevVis, 'WaveElevVis', 'WaveElevVis', ErrStat, ErrMsg ) + if ( ErrStat >= AbortErrLev ) then + if (InitInp%Echo .and. UnEchoLocal>0) close(UnEchoLocal) + close( UnIn ) + return + end if + +!FIXME: enable this when we can use an arbitrary number of points from the FFT of the data. +! !> WaveElevVisNx -- number of points in X if visualizing +! call ReadVar ( UnIn, FileName, InitInp%WaveElevVisNx, 'WaveElevVisNX', 'WaveElevVisNx', ErrStat, ErrMsg ) +! if ( ErrStat >= AbortErrLev ) then +! if (InitInp%Echo .and. UnEchoLocal>0) close(UnEchoLocal) +! close( UnIn ) +! return +! end if +! +! !> WaveElevVisNy -- number of points in Y if visualizing +! call ReadVar ( UnIn, FileName, InitInp%WaveElevVisNy, 'WaveElevVisNy', 'WaveElevVisNy', ErrStat, ErrMsg ) +! if ( ErrStat >= AbortErrLev ) then +! if (InitInp%Echo .and. UnEchoLocal>0) close(UnEchoLocal) +! close( UnIn ) +! return +! end if + + + if (InitInp%Echo .and. UnEchoLocal>0) close(UnEchoLocal) + close( UnIn ) + +end SUBROUTINE ReadDriverInputFile + +SUBROUTINE WaveElevGrid_Output (drvrInitInp, SeaStateInitInp, SeaStateInitOut, SeaState_p, ErrStat, ErrMsg) + + type(SeaSt_drvr_InitInput), intent( in ) :: drvrInitInp + type(SeaSt_InitInputType), intent( in ) :: SeaStateInitInp + type(SeaSt_InitOutputType), intent( in ) :: SeaStateInitOut ! Output data from initialization + type(SeaSt_ParameterType), intent( in ) :: SeaState_p ! Output data from initialization + integer, 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(1024) :: ErrMsgTmp !< Temporary variable for the error message + + integer(IntKi) :: WaveElevFileUn !< Number for the output file for the wave elevation series + character(1024) :: WaveElevFileName !< Name for the output file for the wave elevation series + character(128) :: WaveElevFmt !< Format specifier for the output file for wave elevation series + real(ReKi) :: xpos, ypos + real(SiKi) :: WaveElev,minWaveVal,maxWaveVal + integer(IntKi) :: i,j,k + + WaveElevFmt = "(F14.7,3x,F14.7,3x,F14.7)" + + ErrMsg = "" + ErrStat = ErrID_None + + + ! If we calculated the wave elevation at a set of coordinates for use with making movies, put it into an output file + WaveElevFileName = TRIM(drvrInitInp%OutRootName)//".WaveElev.out" + call GetNewUnit( WaveElevFileUn ) + + call OpenFOutFile( WaveElevFileUn, WaveElevFileName, ErrStat, ErrMsg ) + if ( ErrStat /= ErrID_None) then + if ( ErrStat >= AbortErrLev ) return + end if + + if (allocated(SeaState_p%WaveField%WaveElev2)) then + maxWaveVal = MAXVAL(SeaState_p%WaveField%WaveElev1 + SeaState_p%WaveField%WaveElev2) + minWaveVal = MINVAL(SeaState_p%WaveField%WaveElev1 + SeaState_p%WaveField%WaveElev2) + else + maxWaveVal = MAXVAL(SeaState_p%WaveField%WaveElev1) + minWaveVal = MINVAL(SeaState_p%WaveField%WaveElev1) + end if + + ! Write some useful header information +! write (WaveElevFileUn,'(A)', IOSTAT=ErrStatTmp ) '## This file was generated by '//TRIM(GetNVD(SeaState_Drv_ProgDesc))// & +! ' on '//CurDate()//' at '//CurTime()//'.' + write (WaveElevFileUn,'(A)', IOSTAT=ErrStatTmp ) '## This file was generated on '//CurDate()//' at '//CurTime()//'.' + write (WaveElevFileUn,'(A)', IOSTAT=ErrStatTmp ) '## This file contains the wave elevations at a series of points '// & + 'through the entire timeseries.' + write (WaveElevFileUn,'(A)', IOSTAT=ErrStatTmp ) '## It is arranged as blocks of X,Y,Elevation at each timestep' + write (WaveElevFileUn,'(A)', IOSTAT=ErrStatTmp ) '## Each block is separated by two blank lines for use in gnuplot' + write (WaveElevFileUn,'(A)', IOSTAT=ErrStatTmp ) '# ' + write (WaveElevFileUn,'(A)', IOSTAT=ErrStatTmp ) '# WaveTMax = '//TRIM(Num2LStr(SeaState_p%WaveField%WaveTime(SeaState_p%WaveField%NStepWave))) + write (WaveElevFileUn,'(A)', IOSTAT=ErrStatTmp ) '# NStepWave = '//TRIM(Num2LStr(SeaState_p%WaveField%NStepWave)) + write (WaveElevFileUn,'(A)', IOSTAT=ErrStatTmp ) '# GridXPoints = '//TRIM(Num2LStr(SeaState_p%NGrid(1))) + write (WaveElevFileUn,'(A)', IOSTAT=ErrStatTmp ) '# GridYPoints = '//TRIM(Num2LStr(SeaState_p%NGrid(2))) + write (WaveElevFileUn,'(A)', IOSTAT=ErrStatTmp ) '# GridDX = '//TRIM(Num2LStr(SeaState_p%deltaGrid(1))) + write (WaveElevFileUn,'(A)', IOSTAT=ErrStatTmp ) '# GridDY = '//TRIM(Num2LStr(SeaState_p%deltaGrid(2))) + write (WaveElevFileUn,'(A)', IOSTAT=ErrStatTmp ) '# MaxWaveElev = '//TRIM(Num2LStr(maxWaveVal)) + write (WaveElevFileUn,'(A)', IOSTAT=ErrStatTmp ) '# MinWaveElev = '//TRIM(Num2LStr(minWaveVal)) + write (WaveElevFileUn,'(A)', IOSTAT=ErrStatTmp ) '# ' + + ! Timestep looping + do i = 0,SeaState_p%WaveField%NStepWave + write (WaveElevFileUn,'(A)', IOSTAT=ErrStatTmp ) NewLine + write (WaveElevFileUn,'(A8,F10.3)', IOSTAT=ErrStatTmp ) '# Time: ',SeaState_p%WaveField%WaveTime(I) + ! Now output the X,Y, Elev info for this timestep + do j=1,size(SeaStateInitOut%WaveElevVisX) + xpos = SeaStateInitOut%WaveElevVisX(j) + do k=1, SeaState_p%NGrid(2) + ypos = SeaStateInitOut%WaveElevVisY(k) + WaveElev = SeaStateInitOut%WaveElevVisGrid(i,j,k) + write (WaveElevFileUn,WaveElevFmt, IOSTAT=ErrStatTmp ) xpos, ypos, WaveElev + end do + end do + end do + + ! Done. Close the file + close (WaveElevFileUn) + +end SUBROUTINE WaveElevGrid_Output + +!---------------------------------------------------------------------------------------------------------------------------------- + +end PROGRAM SeaStateDriver + diff --git a/modules/seastate/src/SeaState_Input.f90 b/modules/seastate/src/SeaState_Input.f90 new file mode 100644 index 0000000000..0ddedbaffc --- /dev/null +++ b/modules/seastate/src/SeaState_Input.f90 @@ -0,0 +1,1185 @@ +!********************************************************************************************************************************** +! LICENSING +! Copyright (C) 2013-2021 National Renewable Energy Laboratory +! +! This file is part of SeaState. +! +! 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 SeaState_Input + use NWTC_Library + use SeaState_Types + use SeaState_Output + use Waves + use NWTC_RandomNumber ! for parameters pRNG_INTRINSIC and pRNG_RANLUX + + implicit none + + contains + +!==================================================================================================== +subroutine SeaSt_ParseInput( InputFileName, OutRootName, defWtrDens, defWtrDpth, defMSL2SWL, FileInfo_In, InputFileData, ErrStat, ErrMsg ) +! This public subroutine reads the input required for SeaState from the file whose name is an +! input parameter. +!---------------------------------------------------------------------------------------------------- + + ! Passed variables + character(*), intent(in ) :: InputFileName !< The name of the input file, for putting in echo file. + character(*), intent(in ) :: OutRootName !< The rootname of the echo file, possibly opened in this routine + real(ReKi), intent(in ) :: defWtrDens !< default value for water density + real(ReKi), intent(in ) :: defWtrDpth !< default value for water depth + real(ReKi), intent(in ) :: defMSL2SWL !< default value for mean sea level to still water level + type(FileInfoType), INTENT(IN ) :: FileInfo_In !< The derived type for holding the file information + type(SeaSt_InputFile), INTENT(INOUT) :: InputFileData ! the SeaState input file 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 :: UnEc ! The local unit number for this module's echo file + character(1024) :: EchoFile ! Name of SeaState echo file + character(MaxFileInfoLineLen) :: Line ! String to temporarially hold value of read line + real(ReKi), allocatable :: tmpVec1(:), tmpVec2(:) ! Temporary arrays for WAMIT data + integer, allocatable :: tmpArray(:) ! Temporary array storage of the joint output list + real(ReKi), allocatable :: tmpReArray(:) ! Temporary array storage of the joint output list + character(1) :: Line1 ! The first character of an input line + integer(IntKi) :: CurLine !< Current entry in FileInfo_In%Lines array + integer(IntKi) :: IOS + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SeaSt_ParseInput' + + ! Initialize local data + UnEc = -1 + ErrStat = ErrID_None + ErrMsg = "" + InputFileData%Echo = .FALSE. ! initialize for error handling (cleanup() routine) + + + !------------------------------------------------------------------------------------------------- + ! General settings + !------------------------------------------------------------------------------------------------- + + CurLine = 3 ! 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 + EchoFile = trim(OutRootName)//'.ech' + call OpenEcho ( UnEc, trim(EchoFile), ErrStat2, ErrMsg2 ) + if (Failed()) return; + write(UnEc, '(A)') 'Echo file for SeaState primary input file: '//trim(InputFileName) + ! Write the first three lines into the echo file + write(UnEc, '(A)') trim(FileInfo_In%Lines(1)) + write(UnEc, '(A)') trim(FileInfo_In%Lines(2)) + + CurLine = 3 + call ParseVar( FileInfo_In, CurLine, 'Echo', InputFileData%Echo, ErrStat2, ErrMsg2, UnEc ) + if (Failed()) return + endif + + + !------------------------------------------------------------------------------------------------- + ! Environmental conditions section + !------------------------------------------------------------------------------------------------- + if ( InputFileData%Echo ) write(UnEc, '(A)') trim(FileInfo_In%Lines(CurLine)) ! Write section break to echo + CurLine = CurLine + 1 + + ! WtrDens - Water density. + call ParseVarWDefault ( FileInfo_In, CurLine, 'WtrDens', InputFileData%WtrDens, defWtrDens, ErrStat2, ErrMsg2, UnEc ) + if (Failed()) return; + + ! WtrDpth - Water depth + call ParseVarWDefault ( FileInfo_In, CurLine, 'WtrDpth', InputFileData%WtrDpth, defWtrDpth, ErrStat2, ErrMsg2, UnEc ) + if (Failed()) return; + + ! MSL2SWL + call ParseVarWDefault ( FileInfo_In, CurLine, 'MSL2SWL', InputFileData%MSL2SWL, defMSL2SWL, ErrStat2, ErrMsg2, UnEc ) + if (Failed()) return; + + !------------------------------------------------------------------------------------------------- + ! Data section for Wave Kinematics data grid spatial discretization + !------------------------------------------------------------------------------------------------- + if ( InputFileData%Echo ) write(UnEc, '(A)') trim(FileInfo_In%Lines(CurLine)) ! Write section break to echo + CurLine = CurLine + 1 + + ! X_HalfWidth - Half-width of the domain in the X direction. + call ParseVar( FileInfo_In, CurLine, 'X_HalfWidth', InputFileData%X_HalfWidth, ErrStat2, ErrMsg2, UnEc ) + if (Failed()) return; + + ! Y_HalfWidth - Half-width of the domain in the Y direction. + call ParseVar( FileInfo_In, CurLine, 'Y_HalfWidth', InputFileData%Y_HalfWidth, ErrStat2, ErrMsg2, UnEc ) + if (Failed()) return; + + ! Z_Depth - Depth of the domain the Z direction. + call ParseVarWDefault ( FileInfo_In, CurLine, 'Z_Depth', InputFileData%Z_Depth, InputFileData%WtrDpth+InputFileData%MSL2SWL, ErrStat2, ErrMsg2, UnEc ) + if (Failed()) return; + + ! NX - Number of nodes in half of the X-direction domain. + call ParseVar( FileInfo_In, CurLine, 'NX', InputFileData%NX, ErrStat2, ErrMsg2, UnEc ) + if (Failed()) return; + + ! NY - Number of nodes in half of the Y-direction domain. + call ParseVar( FileInfo_In, CurLine, 'NY', InputFileData%NY, ErrStat2, ErrMsg2, UnEc ) + if (Failed()) return; + + ! NZ - Number of nodes in the Z-direction domain. + call ParseVar( FileInfo_In, CurLine, 'NZ', InputFileData%NZ, ErrStat2, ErrMsg2, UnEc ) + if (Failed()) return; + + !------------------------------------------------------------------------------------------------- + ! Data section for waves + !------------------------------------------------------------------------------------------------- + if ( InputFileData%Echo ) write(UnEc, '(A)') trim(FileInfo_In%Lines(CurLine)) ! Write section break to echo + CurLine = CurLine + 1 + + ! WaveMod - Wave kinematics model switch. and WavePhase (as appropriate) + InputFileData%Waves%WavePhase = 0.0 + call ParseVar( FileInfo_In, CurLine, 'WaveMod', InputFileData%WaveMod, ErrStat2, ErrMsg2, UnEc ) + if ( ErrStat2 >= AbortErrLev ) then + ! try to read the line that just failed, as a string this time to see if it's "1P" + call ParseVar( FileInfo_In, CurLine, 'WaveMod', Line, ErrStat2, ErrMsg2, UnEc ) + if (Failed()) return + + call Conv2UC( Line ) ! Convert Line to upper case. + if ( Line(1:2) == '1P' ) then ! The user wants to specify the phase in place of a random phase + + InputFileData%WaveMod = WaveMod_RegularUsrPh ! Internally define WaveMod = 10 to mean regular waves with a specified (nonrandom) phase + + read (Line(3:),*,IOSTAT=IOS ) InputFileData%Waves%WavePhase + call CheckIOS ( IOS, "", 'WavePhase', NumType, ErrStat2, ErrMsg2 ) + if (Failed()) return + + InputFileData%Waves%WavePhase = InputFileData%Waves%WavePhase*D2R ! Convert the phase from degrees to radians + + else ! The user must have specified WaveMod incorrectly. + ErrStat2 = ErrID_Fatal + ErrMsg2 = 'WaveMod incorrectly specified in SeaState input file.' + if (Failed()) return + end if + + end if + + ! WaveStMod - Model switch for stretching incident wave kinematics to instantaneous free surface. + call ParseVar( FileInfo_In, CurLine, 'WaveStMod', InputFileData%WaveStMod, ErrStat2, ErrMsg2, UnEc ) + if (Failed()) return; + + ! WaveTMax - Analysis time for incident wave calculations. + call ParseVar( FileInfo_In, CurLine, 'WaveTMax', InputFileData%Waves%WaveTMax, ErrStat2, ErrMsg2, UnEc ) + if (Failed()) return; + + ! WaveDT - Time step for incident wave calculations + call ParseVar( FileInfo_In, CurLine, 'WaveDT', InputFileData%Waves%WaveDT, ErrStat2, ErrMsg2, UnEc ) + if (Failed()) return; + + ! WaveHs - Significant wave height + call ParseVar( FileInfo_In, CurLine, 'WaveHs', InputFileData%Waves%WaveHs, ErrStat2, ErrMsg2, UnEc ) + if (Failed()) return; + + ! WaveTp - Peak spectral period. + call ParseVar( FileInfo_In, CurLine, 'WaveTp', InputFileData%Waves%WaveTp, ErrStat2, ErrMsg2, UnEc ) + if (Failed()) return; + + ! WavePkShp - Peak shape parameter. + call ParseVarWDefault(FileInfo_In, CurLine, 'WavePkShp', InputFileData%Waves%WavePkShp, & + WavePkShpDefault( InputFileData%WaveMod, InputFileData%Waves%WaveHs, InputFileData%Waves%WaveTp), ErrStat2, ErrMsg2, UnEc ) + if (Failed()) return; + + + ! WvLowCOff - Low Cut-off frequency or lower frequency limit of the wave spectrum beyond which the wave spectrum is zeroed (rad/s). + call ParseVar( FileInfo_In, CurLine, 'WvLowCOff', InputFileData%WvLowCOff, ErrStat2, ErrMsg2, UnEc ) + if (Failed()) return; + + ! WvHiCOff - High Cut-off frequency or upper frequency limit of the wave spectrum beyond which the wave spectrum is zeroed (rad/s). + call ParseVar( FileInfo_In, CurLine, 'WvHiCOff', InputFileData%WvHiCOff, ErrStat2, ErrMsg2, UnEc ) + if (Failed()) return; + + ! WaveDir - Mean wave heading direction. + call ParseVar( FileInfo_In, CurLine, 'WaveDir', InputFileData%WaveDir, ErrStat2, ErrMsg2, UnEc ) + if (Failed()) return; + + ! WaveDirMod - Directional spreading function {0: None, 1: COS2S} (-) [Used only if WaveMod=2] + call ParseVar( FileInfo_In, CurLine, 'WaveDirMod', InputFileData%WaveDirMod, ErrStat2, ErrMsg2, UnEc ) + if (Failed()) return; + + ! WaveDirSpread - Spreading coefficient [only used if WaveMod=2 and WaveDirMod=1] + call ParseVar( FileInfo_In, CurLine, 'WaveDirSpread', InputFileData%Waves%WaveDirSpread, ErrStat2, ErrMsg2, UnEc ) + if (Failed()) return; + + ! WaveNDir - The number of wave directions to calculate [must be odd; only used if WaveDirMod=1] + call ParseVar( FileInfo_In, CurLine, 'WaveNDir', InputFileData%Waves%WaveNDir, ErrStat2, ErrMsg2, UnEc ) + if (Failed()) return; + + ! WaveDirRange - Full range of the wave directions from WaveDir - WaveDirRange/2 to WaveDir + WaveDirRange/2 (only used if WaveMod=2 and WaveDirMod=1) + call ParseVar( FileInfo_In, CurLine, 'WaveDirRange', InputFileData%Waves%WaveDirRange, ErrStat2, ErrMsg2, UnEc ) + if (Failed()) return; + + ! Negative values should be treated as positive. + InputFileData%Waves%WaveDirRange = abs( InputFileData%Waves%WaveDirRange ) + + + ! WaveSeed(1) + call ParseVar( FileInfo_In, CurLine, 'WaveSeed(1)', InputFileData%Waves%RNG%RandSeed(1), ErrStat2, ErrMsg2, UnEc ) + if (Failed()) return; + + !WaveSeed(2) + call ParseVar( FileInfo_In, CurLine, 'WaveSeed(2)', Line, ErrStat2, ErrMsg2, UnEc ) ! Read into a string and then parse + if (Failed()) return; + + 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 + ErrStat2 = ErrID_Fatal + ErrMsg2 = ' WaveSeed(2): Invalid RNG type.' + if (Failed()) return; + endif + + read (Line,*,IOSTAT=ErrStat2) InputFileData%Waves%RNG%RandSeed(2) + + if (ErrStat2 == 0) then ! the user entered a number + InputFileData%Waves%RNG%RNG_type = "NORMAL" + InputFileData%Waves%RNG%pRNG = pRNG_INTRINSIC + else + InputFileData%Waves%RNG%RandSeed(2) = 0 + + InputFileData%Waves%RNG%RNG_type = adjustl( Line ) + call Conv2UC( InputFileData%Waves%RNG%RNG_type ) + + if ( InputFileData%Waves%RNG%RNG_type == "RANLUX") then + InputFileData%Waves%RNG%pRNG = pRNG_RANLUX + else + ErrStat2 = ErrID_Fatal + ErrMsg2 = ' WaveSeed(2): Invalid alternative random number generator.' + if (Failed()) return; + endif + + endif + + + ! WaveNDAmp - Flag for normally distributed amplitudes. + call ParseVar( FileInfo_In, CurLine, 'WaveNDAmp', InputFileData%Waves%WaveNDAmp, ErrStat2, ErrMsg2, UnEc ) + if (Failed()) return; + + ! WvKinFile + call ParseVar( FileInfo_In, CurLine, 'WvKinFile', InputFileData%Waves%WvKinFile, ErrStat2, ErrMsg2, UnEc, IsPath=.true. ) + if (Failed()) return; + + !------------------------------------------------------------------------------------------------- + ! Data section for 2nd Order Waves + !------------------------------------------------------------------------------------------------- + if ( InputFileData%Echo ) write(UnEc, '(A)') trim(FileInfo_In%Lines(CurLine)) ! Write section break to echo + CurLine = CurLine + 1 + + ! WvDiffQTFF - Second order waves -- difference forces + call ParseVar( FileInfo_In, CurLine, 'WvDiffQTF', InputFileData%Waves2%WvDiffQTFF, ErrStat2, ErrMsg2, UnEc ) + if (Failed()) return; + + ! WvSumQTFF - Second order waves -- sum forces + call ParseVar( FileInfo_In, CurLine, 'WvSumQTF', InputFileData%Waves2%WvSumQTFF, ErrStat2, ErrMsg2, UnEc ) + if (Failed()) return; + + ! WvLowCOffD -- Minimum frequency used in the difference methods (rad/s) [Only used if DiffQTF /= 0] + call ParseVar( FileInfo_In, CurLine, 'WvLowCOffD', InputFileData%WvLowCOffD, ErrStat2, ErrMsg2, UnEc ) + if (Failed()) return; + + ! WvHiCOffD -- Maximum frequency used in the difference methods (rad/s) [Only used if DiffQTF /= 0] + call ParseVar( FileInfo_In, CurLine, 'WvHiCOffD', InputFileData%WvHiCOffD, ErrStat2, ErrMsg2, UnEc ) + if (Failed()) return; + + ! WvLowCOffS -- Minimum frequency used in the sum-QTF (rad/s) [Only used if SumQTF /= 0] + call ParseVar( FileInfo_In, CurLine, 'WvLowCOffS', InputFileData%WvLowCOffS, ErrStat2, ErrMsg2, UnEc ) + if (Failed()) return; + + ! WvHiCOffS -- Maximum frequency used in the sum-QTF (rad/s) [Only used if SumQTF /= 0] + call ParseVar( FileInfo_In, CurLine, 'WvHiCOffS', InputFileData%WvHiCOffS, ErrStat2, ErrMsg2, UnEc ) + if (Failed()) return; + + !------------------------------------------------------------------------------------------------- + ! Data section for constrained wave + !------------------------------------------------------------------------------------------------- + if ( InputFileData%Echo ) write(UnEc, '(A)') trim(FileInfo_In%Lines(CurLine)) ! Write section break to echo + CurLine = CurLine + 1 + + ! ConstWaveMod - Constrained wave model switch. + call ParseVar( FileInfo_In, CurLine, 'ConstWaveMod', InputFileData%Waves%ConstWaveMod, ErrStat2, ErrMsg2, UnEc ) + if (Failed()) return; + + + ! CrestHmax - Crest height + call ParseVar( FileInfo_In, CurLine, 'CrestHmax', InputFileData%Waves%CrestHmax, ErrStat2, ErrMsg2, UnEc ) + if (Failed()) return; + + ! CrestTime -Time of the crest + call ParseVar( FileInfo_In, CurLine, 'CrestTime', InputFileData%Waves%CrestTime, ErrStat2, ErrMsg2, UnEc ) + if (Failed()) return; + + ! CrestXi - X-position of the crest + call ParseVar( FileInfo_In, CurLine, 'CrestXi', InputFileData%Waves%CrestXi, ErrStat2, ErrMsg2, UnEc ) + if (Failed()) return; + + ! CrestYi - Y-position of the crest + call ParseVar( FileInfo_In, CurLine, 'CrestYi', InputFileData%Waves%CrestYi, ErrStat2, ErrMsg2, UnEc ) + if (Failed()) return; + + !------------------------------------------------------------------------------------------------- + ! Data section for current + !------------------------------------------------------------------------------------------------- + if ( InputFileData%Echo ) write(UnEc, '(A)') trim(FileInfo_In%Lines(CurLine)) ! Write section break to echo + CurLine = CurLine + 1 + + ! CurrMod - Current profile model switch + call ParseVar( FileInfo_In, CurLine, 'CurrMod', InputFileData%Current%CurrMod, ErrStat2, ErrMsg2, UnEc ) + if (Failed()) return; + + ! CurrSSV0 - Sub-surface current velocity at still water level + call ParseVar( FileInfo_In, CurLine, 'CurrSSV0', InputFileData%Current%CurrSSV0, ErrStat2, ErrMsg2, UnEc ) + if (Failed()) return; + + + ! CurrSSDirChr - Sub-surface current heading direction + call ParseVar( FileInfo_In, CurLine, 'CurrSSDir', InputFileData%Current%CurrSSDirChr, ErrStat2, ErrMsg2, UnEc ) + if (Failed()) return; + + call Conv2UC( InputFileData%Current%CurrSSDirChr ) ! Convert Line to upper case. + + + ! CurrNSRef - Near-surface current reference depth. + call ParseVar( FileInfo_In, CurLine, 'CurrNSRef', InputFileData%Current%CurrNSRef, ErrStat2, ErrMsg2, UnEc ) + if (Failed()) return; + + ! CurrNSV0 - Near-surface current velocity at still water level. + call ParseVar( FileInfo_In, CurLine, 'CurrNSV0', InputFileData%Current%CurrNSV0, ErrStat2, ErrMsg2, UnEc ) + if (Failed()) return; + + ! CurrNSDir - Near-surface current heading direction. + call ParseVar( FileInfo_In, CurLine, 'CurrNSDir', InputFileData%Current%CurrNSDir, ErrStat2, ErrMsg2, UnEc ) + if (Failed()) return; + + ! CurrDIV - Depth-independent current velocity. + call ParseVar( FileInfo_In, CurLine, 'CurrDIV', InputFileData%Current%CurrDIV, ErrStat2, ErrMsg2, UnEc ) + if (Failed()) return; + + ! CurrDIDir - Depth-independent current heading direction. + call ParseVar( FileInfo_In, CurLine, 'CurrDIDir', InputFileData%Current%CurrDIDir, ErrStat2, ErrMsg2, UnEc ) + if (Failed()) return; + + !------------------------------------------------------------------------------------------------- + ! Data section for the MacCamy-Fuchs diffraction model + !------------------------------------------------------------------------------------------------- + if ( InputFileData%Echo ) write(UnEc, '(A)') trim(FileInfo_In%Lines(CurLine)) ! Write section break to echo + CurLine = CurLine + 1 + + ! MacCamy-Fuchs member radius + call ParseVar( FileInfo_In, CurLine, 'MCFD', InputFileData%MCFD, ErrStat2, ErrMsg2, UnEc ) + if (Failed()) return; + + + !------------------------------------------------------------------------------------------------- + ! Data section for OUTPUT + !------------------------------------------------------------------------------------------------- + if ( InputFileData%Echo ) write(UnEc, '(A)') trim(FileInfo_In%Lines(CurLine)) ! Write section break to echo + CurLine = CurLine + 1 + + ! SeaSum - Whether or not to generate a summary file + call ParseVar( FileInfo_In, CurLine, 'SeaStSum', InputFileData%SeaStSum, ErrStat2, ErrMsg2, UnEc ) + if (Failed()) return; + + ! OutSwtch - Specify how to write to an output file + call ParseVar( FileInfo_In, CurLine, 'OutSwtch', InputFileData%OutSwtch, ErrStat2, ErrMsg2, UnEc ) + if (Failed()) return; + + ! OutFmt - Format for numerical outputs + call ParseVar( FileInfo_In, CurLine, 'OutFmt', InputFileData%OutFmt, ErrStat2, ErrMsg2, UnEc ) + if (Failed()) return; + + ! OutSFmt - Format for output column headers + call ParseVar( FileInfo_In, CurLine, 'OutSFmt', InputFileData%OutSFmt, ErrStat2, ErrMsg2, UnEc ) + if (Failed()) return; + + ! NWaveElev - Number of Wave elevations to output + call ParseVar( FileInfo_In, CurLine, 'NWaveElev', InputFileData%NWaveElev, ErrStat2, ErrMsg2, UnEc ) + if (Failed()) return; + + + ! This check is needed here instead of being located in SeaStateInput_ProcessInputData() because + ! we need to allocate arrays. If _GetInput() was skipped, then these array would already have + ! been allocated and populated. + + if ( InputFileData%NWaveElev < 0 .OR. InputFileData%NWaveElev > 9 ) then + ErrStat2 = ErrID_Fatal + ErrMsg2 = 'NWaveElev must be greater than or equal to zero and less than 10.' + if (Failed()) return; + end if + + ! allocate space for the output location arrays: + call AllocAry( InputFileData%WaveElevxi, InputFileData%NWaveElev, 'WaveElevxi' , ErrStat2, ErrMsg2); if (Failed()) return; + call AllocAry( InputFileData%WaveElevyi, InputFileData%NWaveElev, 'WaveElevyi' , ErrStat2, ErrMsg2); if (Failed()) return; + + ! WaveElevxi + call ParseAry ( FileInfo_In, CurLine, 'WaveElevxi.', InputFileData%WaveElevxi, InputFileData%NWaveElev, ErrStat2, ErrMsg2, UnEc ) + if (Failed()) return; + + ! WaveElevyi + call ParseAry ( FileInfo_In, CurLine, 'WaveElevyi.', InputFileData%WaveElevyi, InputFileData%NWaveElev, ErrStat2, ErrMsg2, UnEc ) + if (Failed()) return; + + ! NWaveKin + call ParseVar( FileInfo_In, CurLine, 'NWaveKin', InputFileData%NWaveKin, ErrStat2, ErrMsg2, UnEc ) + if (Failed()) return; + + + ! This check is needed here instead of being located in SeaStateInput_ProcessInputData() because + ! we need to allocate arrays. If _GetInput() was skipped, then these array would already have + ! been allocated and populated. + + if ( InputFileData%NWaveKin < 0 .OR. InputFileData%NWaveKin > 9 ) then + ErrStat2 = ErrID_Fatal + ErrMsg2 = 'NWaveKin must be greater than or equal to zero and less than 10.' + if (Failed()) return; + end if + + ! allocate space for the output location arrays: + call AllocAry( InputFileData%WaveKinxi, InputFileData%NWaveKin, 'WaveKinxi' , ErrStat2, ErrMsg2); if (Failed()) return; + call AllocAry( InputFileData%WaveKinyi, InputFileData%NWaveKin, 'WaveKinyi' , ErrStat2, ErrMsg2); if (Failed()) return; + call AllocAry( InputFileData%WaveKinzi, InputFileData%NWaveKin, 'WaveKinzi' , ErrStat2, ErrMsg2); if (Failed()) return; + + ! WaveKinxi + call ParseAry ( FileInfo_In, CurLine, 'WaveKinxi.', InputFileData%WaveKinxi, InputFileData%NWaveKin, ErrStat2, ErrMsg2, UnEc ) + if (Failed()) return; + + ! WaveKinyi + call ParseAry ( FileInfo_In, CurLine, 'WaveKinyi.', InputFileData%WaveKinyi, InputFileData%NWaveKin, ErrStat2, ErrMsg2, UnEc ) + if (Failed()) return; + + ! WaveKinzi + call ParseAry ( FileInfo_In, CurLine, 'WaveKinzi.', InputFileData%WaveKinzi, InputFileData%NWaveKin, ErrStat2, ErrMsg2, UnEc ) + if (Failed()) return; + + !------------------------------------------------------------------------------------------------- + ! Data section for OUTPUT CHANNELS + !------------------------------------------------------------------------------------------------- + + if ( InputFileData%Echo ) WRITE(UnEc, '(A)') trim(FileInfo_In%Lines(CurLine)) ! Write section break to echo + CurLine = CurLine + 1 + + ! OutList - list of requested parameters to output to a file + call AllocAry( InputFileData%OutList, MaxOutPts, 'InputFileData%OutList', ErrStat2, ErrMsg2 ) + if (Failed()) return; + + call ReadOutputListFromFileInfo( FileInfo_In, CurLine, InputFileData%OutList, InputFileData%NumOuts, ErrStat2, ErrMsg2, UnEc ) + if (Failed()) 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(tmpArray )) deallocate(tmpArray ) + if (allocated(tmpReArray)) deallocate(tmpReArray) + if (allocated(tmpVec1 )) deallocate(tmpVec1 ) + if (allocated(tmpVec2 )) deallocate(tmpVec2 ) + ! Cleanup the Echo file and global variables + if (UnEc > 0) close ( UnEc ) + end subroutine Cleanup + +end subroutine SeaSt_ParseInput + +!==================================================================================================== +subroutine SeaStateInput_ProcessInitData( InitInp, p, InputFileData, ErrStat, ErrMsg ) +! This private subroutine verifies the input required for HydroDyn is correctly specified. +!---------------------------------------------------------------------------------------------------- + + + ! Passed variables + + type(SeaSt_InitInputType), intent( in ) :: InitInp ! the SeaState data + type(SeaSt_ParameterType), intent( inout ) :: p ! the SeaState parameter data + type(SeaSt_InputFile), intent( inout ) :: InputFileData ! the SeaState input file data + integer, intent( out ) :: ErrStat ! returns a non-zero value when an error occurs + character(*), intent( out ) :: ErrMsg ! Error message if ErrStat /= ErrID_None + + integer :: I, count ! Generic loop counter index + integer :: J ! Generic loop counter index + integer :: K ! Generic loop counter index + character(1024) :: TmpPath ! Temporary storage for relative path name + real(ReKi) :: xpos, ypos, zpos + real(SiKi) :: TmpFreq + + integer(IntKi) :: ErrStat2, IOS + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SeaStateInput_ProcessInitData' + ! Initialize ErrStat + + ErrStat = ErrID_None + ErrMsg = "" + + + !------------------------------------------------------------------------- + ! Check environmental conditions + !------------------------------------------------------------------------- + + + ! WtrDens - Water density. + if ( InputFileData%WtrDens < 0.0 ) then + call SetErrStat( ErrID_Fatal,'WtrDens must not be negative.',ErrStat,ErrMsg,RoutineName) + return + end if + + ! WtrDpth - Water depth + if ( InputFileData%WtrDpth + InputFileData%MSL2SWL <= 0.0 ) then + call SetErrStat( ErrID_Fatal,'WtrDpth + MSL2SWL must be greater than zero.',ErrStat,ErrMsg,RoutineName) + return + end if + + ! X_HalfWidth - Half-width of the domain in the X direction (m) + if ( InputFileData%X_HalfWidth <= 0.0_ReKi ) then + call SetErrStat( ErrID_Fatal,'X_HalfWidth must be greater than zero.',ErrStat,ErrMsg,RoutineName) + return + end if + + ! Y_HalfWidth - Half-width of the domain in the Y direction (m) + if ( InputFileData%Y_HalfWidth <= 0.0_ReKi ) then + call SetErrStat( ErrID_Fatal,'Y_HalfWidth must be greater than zero.',ErrStat,ErrMsg,RoutineName) + return + end if + + ! Z_Depth - Depth of the domain the Z direction (m) + if ( ( InputFileData%Z_Depth <= 0.0_ReKi ) .or. ( InputFileData%Z_Depth > InputFileData%WtrDpth + InputFileData%MSL2SWL ) ) then + call SetErrStat( ErrID_Fatal,'Z_Depth must be greater than zero and less than or equal to the WtrDpth + MSL2SWL.',ErrStat,ErrMsg,RoutineName) + return + end if + + ! NX - Number of nodes in half of the X-direction domain + if ( InputFileData%NX < 2 ) then + call SetErrStat( ErrID_Fatal,'NX must be greater than or equal to 2.',ErrStat,ErrMsg,RoutineName) + return + end if + + ! NY - Number of nodes in half of the Y-direction domain + if ( InputFileData%NY < 2 ) then + call SetErrStat( ErrID_Fatal,'NY must be greater than or equal to 2.',ErrStat,ErrMsg,RoutineName) + return + end if + + ! NZ - Number of nodes in the Z-direction domain + if ( InputFileData%NZ < 2 ) then + call SetErrStat( ErrID_Fatal,'NZ must be greater than or equal to 2.',ErrStat,ErrMsg,RoutineName) + return + end if + + ! WaveMod - Wave kinematics model switch. + + SELECT CASE(InputFileData%WaveMod) + CASE(WaveMod_None) + CASE(WaveMod_Regular) + CASE(WaveMod_RegularUsrPh) + CASE(WaveMod_JONSWAP) + CASE(WaveMod_WhiteNoise) + CASE(WaveMod_UserSpctrm) + CASE(WaveMod_ExtElev) + CASE(WaveMod_ExtFull) + CASE(WaveMod_UserFreq) + CASE DEFAULT + call SetErrStat( ErrID_Fatal,'WaveMod must be 0, 1, 1P#, 2, 3, 4, 5, 6, or 7',ErrStat,ErrMsg,RoutineName) + return + END SELECT + + + + ! WaveStMod - Model switch for stretching incident wave kinematics to instantaneous free surface. + IF ( InputFileData%WaveMod == WaveMod_None ) THEN + InputFileData%WaveStMod = 0_IntKi + ELSEIF ( InputFileData%WaveMod == WaveMod_ExtFull ) THEN + IF ( (InputFileData%WaveStMod /= 0) .AND. (InputFileData%WaveStMod /= 1) .AND. & + (InputFileData%WaveStMod /= 3) ) THEN + CALL SetErrStat( ErrID_Fatal,'WaveStMod must be 0, 1, or 3 when WaveMod = 6.',ErrStat,ErrMsg,RoutineName) + RETURN + END IF + ELSE + IF ( (InputFileData%WaveStMod /= 0) .AND. (InputFileData%WaveStMod /= 1) .AND. & + (InputFileData%WaveStMod /= 2) .AND. (InputFileData%WaveStMod /= 3) ) THEN + CALL SetErrStat( ErrID_Fatal,'WaveStMod must be 0, 1, 2, or 3.',ErrStat,ErrMsg,RoutineName) + RETURN + END IF + END IF + + + ! WaveTMax - Analysis time for incident wave calculations. + + if ( InputFileData%WaveMod == WaveMod_None ) then ! .TRUE if we have incident waves. + + ! TODO: Issue warning if WaveTMax was not already 0.0 in this case. + ! Setting WaveTMax = 0 breaks interpolation. Should probably set it to just TMax instead. + if ( .NOT. EqualRealNos(InputFileData%Waves%WaveTMax, InitInp%TMax) ) then + call WrScr( ' Setting WaveTMax to TMax since WaveMod = 0' ) + InputFileData%Waves%WaveTMax = InitInp%TMax + end if + if ( .NOT. EqualRealNos(InputFileData%WaveDir, 0.0_SiKi) ) then + call WrScr( ' Setting WaveDir to 0.0 since WaveMod = 0' ) + InputFileData%WaveDir = 0.0 + end if + elseif ( InputFileData%WaveMod == WaveMod_ExtElev ) then ! User wave elevation file reading in + if (InitInp%TMax > InputFileData%Waves%WaveTMax ) then + call SetErrstat( ErrID_Fatal, ' WaveTMax must be larger than the simulation time for user wave elevations (WaveMod == 5).',ErrStat,ErrMsg,RoutineName) + return + end if + else + if (InitInp%TMax > InputFileData%Waves%WaveTMax ) then + call WrScr( ' WaveTMax is less then the simulation time. Wave data will repeat every WaveTMax seconds.') + end if + end if + + + ! WaveDT - Time step for incident wave calculations + + if ( InputFileData%WaveMod /= WaveMod_None ) then ! .TRUE if we have incident waves. + + if ( InputFileData%Waves%WaveDT <= 0.0 ) then + call SetErrStat( ErrID_Fatal,'WaveDT must be greater than zero.',ErrStat,ErrMsg,RoutineName) + return + end if + + else + + ! When waveMod = 0, should also set WaveDT to InitInp%TMax to keep interpolation working. + ! Essentially just two time steps, t=0 and t=TMax + !InputFileData%Waves%WaveDT = 0.0 + InputFileData%Waves%WaveDT = InitInp%TMax + + end if + + + ! WaveHs - Significant wave height + if ( InputFileData%WaveMod == WaveMod_Regular .OR. & + InputFileData%WaveMod == WaveMod_RegularUsrPh .OR. & + InputFileData%WaveMod == WaveMod_JONSWAP .OR. & + InputFileData%WaveMod == WaveMod_WhiteNoise ) then + + if ( InputFileData%Waves%WaveHs <= 0.0 ) then + call SetErrStat( ErrID_Fatal,'WaveHs must be greater than zero.',ErrStat,ErrMsg,RoutineName) + return + end if + + end if + + + ! WaveTp - Peak spectral period. + if ( InputFileData%Waves%WaveTp <= 0.0 ) then + call SetErrStat( ErrID_Fatal,'WaveTp must be greater than zero.',ErrStat,ErrMsg,RoutineName) + return + end if + + + + ! WavePkShp - Peak shape parameter + if ( ( InputFileData%Waves%WavePkShp < 1.0 ) .OR. ( InputFileData%Waves%WavePkShp > 7.0 ) ) then + call SetErrStat( ErrID_Fatal,'WavePkShp must be greater than or equal to 1 and less than or equal to 7.',ErrStat,ErrMsg,RoutineName) + return + end if + + + ! WvLowCOff and WvHiCOff - Wave Cut-off frequency + + if ( InputFileData%WvLowCOff < 0 ) then + call SetErrStat( ErrID_Fatal,'WvLowCOff must be greater than or equal to zero.',ErrStat,ErrMsg,RoutineName) + return + end if + + ! Threshold upper cut-off based on sampling rate + if ( EqualRealNos(InputFileData%Waves%WaveDT, 0.0_DbKi) ) then + InputFileData%WvHiCOff = 10000.0; ! This is not going to be used because WaveDT is zero. + else + TmpFreq = REAL( Pi/InputFileData%Waves%WaveDT,SiKi) + if ( InputFileData%WvHiCOff > TmpFreq ) then + InputFileData%WvHiCOff = TmpFreq + call SetErrStat( ErrID_Info,'WvHiCOff adjusted to '//trim(num2lstr(TmpFreq))//' rad/s, based on WaveDT.',ErrStat,ErrMsg,RoutineName) + end if + end if + + if (InputFileData%WaveMod == WaveMod_JONSWAP .or. & + InputFileData%WaveMod == WaveMod_WhiteNoise .or. & + InputFileData%WaveMod == WaveMod_UserSpctrm .or. & + InputFileData%WaveMod == WaveMod_ExtElev .or. & + InputFileData%WaveMod == WaveMod_UserFreq ) then + + if ( InputFileData%WvLowCOff >= InputFileData%WvHiCOff ) then + call SetErrSTat( ErrID_Fatal,'WvLowCOff must be less than WvHiCOff.',ErrStat,ErrMsg,RoutineName) + return + end if + else + ! overwrite these so that ALL frequencies are allowed (otherwise we might exclude frequencies with WaveMod = WaveMod_Regular or WaveMod_RegularUsrPh) + InputFileData%WvLowCOff = -HUGE(InputFileData%WvLowCOff) + InputFileData%WvHiCOff = HUGE(InputFileData%WvHiCOff ) + end if + + ! WaveDir - Wave heading direction. + + if ( ( InputFileData%WaveMod /= WaveMod_None ) .AND. ( InputFileData%WaveMod /= WaveMod_ExtFull ) ) then ! .TRUE if we have incident waves, but not user input wave data. + + if ( ( InputFileData%WaveDir <= -180.0 ) .OR. ( InputFileData%WaveDir > 180.0 ) ) then + call SetErrStat( ErrID_Fatal,'WaveDir must be greater than -180 and less than or equal to 180.',ErrStat,ErrMsg,RoutineName) + return + end if + + else + + InputFileData%WaveDir = 0.0 + + end if + + + ! Multi-directional waves + + ! Check the WaveDirMod value + if ( InputFileData%WaveDirMod /= WaveDirMod_None .AND. InputFileData%WaveDirMod /= WaveDirMod_COS2S ) then + call SetErrStat( ErrID_Fatal,'WaveDirMod must be either 0 (No spreading) or 1 (COS2S spreading function)',ErrStat,ErrMsg,RoutineName) + return + end if + + ! Check if we are doing multidirectional waves or not. + ! We can only use multi directional waves on WaveMod=2,3,4 + InputFileData%WaveMultiDir = .FALSE. ! Set flag to false to start + IF (InputFileData%WaveDirMod == WaveDirMod_COS2S ) THEN + if ( InputFileData%WaveMod == WaveMod_JONSWAP .OR. InputFileData%WaveMod == WaveMod_WhiteNoise .OR. InputFileData%WaveMod == WaveMod_UserSpctrm ) then + InputFileData%WaveMultiDir = .TRUE. + else + call SetErrStat( ErrID_Warn,'WaveDirMod unused unless WaveMod == 2, 3, or 4. Ignoring WaveDirMod.',ErrStat,ErrMsg,RoutineName) + end if + ENDIF + + + ! Check to see if the for some reason the wave direction spreading range is set to zero. If it is, + ! we don't have any spreading, so we will turn off the multidirectional waves. + if ( InputFileData%WaveMultiDir .AND. EqualRealNos( InputFileData%Waves%WaveDirRange, 0.0_SiKi ) ) then + call SetErrStat( ErrID_Warn,' WaveDirRange set to zero, so multidirectional waves are turned off.',ErrStat,ErrMsg,RoutineName) + InputFileData%WaveMultiDir = .FALSE. + ENDIF + + + + ! We check the following only if we set WaveMultiDir to true, otherwise ignore them and set them to zero + if ( InputFileData%WaveMultiDir ) then + + ! Check WaveDirSpread + if ( InputFileData%Waves%WaveDirSpread <= 0.0 ) then + + call SetErrStat( ErrID_Fatal,'WaveDirSpread cannot negative or zero.',ErrStat,ErrMsg,RoutineName) + return + + ENDIF + + + ! Check that the number of wave directions is a positive odd number. + ! -> If it is less than 0, error out. + ! -> If it is even, we will increment it by 1. + if ( InputFileData%Waves%WaveNDir <= 0_IntKi ) then + call SetErrStat( ErrID_Fatal,' WaveNDir must be an odd number greater than 0.',ErrStat,ErrMsg,RoutineName) + return + ENDIF + + ! Check that the value for WaveNDir is odd + if ( MODULO( InputFileData%Waves%WaveNDir, 2_IntKi) == 0_IntKi ) then + InputFileData%Waves%WaveNDir = InputFileData%Waves%WaveNDir + 1 + call SetErrStat( ErrID_Warn,'WaveNDir must be odd. Changing the value to '//Num2LStr(InputFileData%Waves%WaveNDir),ErrStat,ErrMsg,RoutineName) + ENDIF + + ! Now check that the WaveDirRange is less than 360 degrees (not sure why we would want that) + if ( InputFileData%Waves%WaveDirRange > 360.0_ReKi ) then + call SetErrStat( ErrID_Fatal,' WaveDirRange should be less than a full circle.',ErrStat,ErrMsg,RoutineName) + ENDIF + + else ! Set everything to zero if we aren't going to use it + + InputFileData%Waves%WaveNDir = 1 ! Only one direction set -- this shouldn't get used later anyhow + InputFileData%Waves%WaveDirRange = PiBy2 ! This is so that the constant C=1 in the COS2S function (it shouldn't get called, but in case it does) + InputFileData%Waves%WaveDirSpread = 0.0 + + end if + + + ! WvKinFile + + if ( InputFileData%WaveMod == WaveMod_ExtElev .OR. InputFileData%WaveMod == WaveMod_ExtFull .OR. InputFileData%WaveMod == WaveMod_UserFreq) then ! .TRUE if we are to read user-supplied wave elevation or wave kinematics file(s). + + if ( LEN_TRIM( InputFileData%Waves%WvKinFile ) == 0 ) then + call SetErrStat( ErrID_Fatal,'WvKinFile must not be an empty string.',ErrStat,ErrMsg,RoutineName) + return + end if + + if ( PathIsRelative( InputFileData%Waves%WvKinFile ) ) then + call GetPath( TRIM(InitInp%InputFile), TmpPath ) + InputFileData%Waves%WvKinFile = TRIM(TmpPath)//TRIM(InputFileData%Waves%WvKinFile) + end if + + end if + + + !------------------------------------------------------------------------- + ! Check 2nd Order Waves section + !------------------------------------------------------------------------- + + + ! Difference frequency cutoffs + + ! WvLowCOffD and WvHiCOffD - Wave Cut-off frequency + if ( InputFileData%WvLowCOffD < 0 ) then + call SetErrStat( ErrID_Fatal,'WvLowCOffD must be greater than or equal to zero.',ErrStat,ErrMsg,RoutineName) + return + end if + + ! Check that the order given makes sense. + if ( InputFileData%WvLowCOffD >= InputFileData%WvHiCOffD ) then + call SetErrStat( ErrID_Fatal,'WvLowCOffD must be less than WvHiCOffD.',ErrStat,ErrMsg,RoutineName) + return + end if + + + ! Sum frequency cutoffs + + ! WvLowCOffS and WvHiCOffD - Wave Cut-off frequency + if ( InputFileData%WvLowCOffS < 0 ) then + call SetErrStat( ErrID_Fatal,'WvLowCOffS must be greater than or equal to zero.',ErrStat,ErrMsg,RoutineName) + return + end if + + ! Check that the order given makes sense. + if ( InputFileData%WvLowCOffS >= InputFileData%WvHiCOffS ) then + call SetErrStat( ErrID_Fatal,'WvLowCOffS must be less than WvHiCOffS.',ErrStat,ErrMsg,RoutineName) + return + end if + + !------------------------------------------------------------------------- + ! Check Constrained Waves section + !------------------------------------------------------------------------- + + ! ConstWaveMod + select case(InputFileData%Waves%ConstWaveMod) + case(ConstWaveMod_None) ! 0 + case(ConstWaveMod_CrestElev) ! 1 + case(ConstWaveMod_Peak2Trough) ! 2 + case default + call SetErrStat( ErrID_Fatal,'ConstWaveMod must be 0, 1, or 2.',ErrStat,ErrMsg,RoutineName) + return + end select + + ! CrestHmax + IF ( ( InputFileData%WaveMod == WaveMod_JONSWAP ) .AND. ( InputFileData%Waves%ConstWaveMod /= ConstWaveMod_None ) .AND. & + ( InputFileData%Waves%CrestHmax < InputFileData%Waves%WaveHs ) ) THEN + call SetErrStat( ErrID_Fatal,'CrestHmax must be larger than WaveHs.',ErrStat,ErrMsg,RoutineName) + RETURN + END IF + + !------------------------------------------------------------------------- + ! Check Current section + !------------------------------------------------------------------------- + + + ! CurrMod - Current profile model switch + + if ( ( InputFileData%Current%CurrMod /= 0 ) .AND. ( InputFileData%Current%CurrMod /= 1 ) .AND. ( InputFileData%Current%CurrMod /= 2 ) ) then + call SetErrStat( ErrID_Fatal,'CurrMod must be 0, 1, or 2.',ErrStat,ErrMsg,RoutineName) + return + end if + + if ( ( InputFileData%Current%CurrMod /= 0 ) .AND. ( InputFileData%WaveMod == WaveMod_ExtFull ) ) then + call SetErrStat( ErrID_Fatal,'CurrMod must be set to 0 when WaveMod is set to 6: user-input wave data.',ErrStat,ErrMsg,RoutineName) + return + end if + + + ! CurrSSV0 - Sub-surface current velocity at still water level + + if ( InputFileData%Current%CurrMod == 1 ) then ! .TRUE if we have standard current. + + if ( InputFileData%Current%CurrSSV0 < 0.0 ) then + call SetErrStat( ErrID_Fatal,'CurrSSV0 must not be less than zero.',ErrStat,ErrMsg,RoutineName) + return + end if + + else + + InputFileData%Current%CurrSSV0 = 0.0 + + end if + + + ! CurrSSDirChr - Sub-surface current heading direction + + if ( InputFileData%Current%CurrMod == 1 ) then ! .TRUE if we have standard current. + + + if ( TRIM(InputFileData%Current%CurrSSDirChr) == 'DEFAULT' ) then ! .TRUE. when one wants to use the default value of codirectionality between sub-surface current and incident wave propogation heading directions. + + if ( InputFileData%WaveMod == WaveMod_None ) then + call SetErrStat( ErrID_Fatal,'CurrSSDir must not be set to ''DEFAULT'' when WaveMod is set to 0.',ErrStat,ErrMsg,RoutineName) + return + end if + + InputFileData%Current%CurrSSDir = InputFileData%WaveDir + + else ! The input must have been specified numerically. + + read (InputFileData%Current%CurrSSDirChr,*,IOSTAT=IOS) InputFileData%Current%CurrSSDir + call CheckIOS ( IOS, "", 'CurrSSDir', NumType, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2,ErrStat,ErrMsg,RoutineName) + if ( ErrStat >= AbortErrLev ) return + + if ( ( InputFileData%Current%CurrSSDir <= -180.0 ) .OR. ( InputFileData%Current%CurrSSDir > 180.0 ) ) then + call SetErrStat( ErrID_Fatal,'CurrSSDir must be greater than -180 and less than or equal to 180.',ErrStat,ErrMsg,RoutineName) + return + end if + + end if + + + else + + InputFileData%Current%CurrSSDir = 0.0 + + end if + + + ! CurrNSRef - Near-surface current reference depth. + + if ( InputFileData%Current%CurrMod == 1 ) then ! .TRUE if we have standard current. + + if ( InputFileData%Current%CurrNSRef <= 0.0 ) then + call SetErrStat( ErrID_Fatal,'CurrNSRef must be greater than zero.',ErrStat,ErrMsg,RoutineName) + return + end if + + else + + InputFileData%Current%CurrNSRef = 0.0 + + end if + + + + ! CurrNSV0 - Near-surface current velocity at still water level. + + if ( InputFileData%Current%CurrMod == 1 ) then ! .TRUE if we have standard current. + + if ( InputFileData%Current%CurrNSV0 < 0.0 ) then + call SetErrStat( ErrID_Fatal,'CurrNSV0 must not be less than zero.',ErrStat,ErrMsg,RoutineName) + return + end if + + else + + InputFileData%Current%CurrNSV0 = 0.0 + + end if + + + ! CurrNSDir - Near-surface current heading direction. + + if ( InputFileData%Current%CurrMod == 1 ) then ! .TRUE if we have standard current. + + if ( ( InputFileData%Current%CurrNSDir <= -180.0 ) .OR. ( InputFileData%Current%CurrNSDir > 180.0 ) ) then + call SetErrStat( ErrID_Fatal,'CurrNSDir must be greater than -180 and less than or equal to 180.',ErrStat,ErrMsg,RoutineName) + return + end if + + else + + InputFileData%Current%CurrNSDir = 0.0 + + end if + + + ! CurrDIV - Depth-independent current velocity. + + if ( InputFileData%Current%CurrMod == 1 ) then ! .TRUE if we have standard current. + + if ( InputFileData%Current%CurrDIV < 0.0 ) then + call SetErrStat( ErrID_Fatal,'CurrDIV must not be less than zero.',ErrStat,ErrMsg,RoutineName) + return + end if + + else + + InputFileData%Current%CurrDIV = 0.0 + + end if + + + ! CurrDIDir - Depth-independent current heading direction. + + if ( InputFileData%Current%CurrMod == 1 ) then ! .TRUE if we have standard current. + + if ( ( InputFileData%Current%CurrDIDir <= -180.0 ) .OR. ( InputFileData%Current%CurrDIDir > 180.0 ) ) then + call SetErrStat( ErrID_Fatal,'CurrDIDir must be greater than -180 and less than or equal to 180.',ErrStat,ErrMsg,RoutineName) + return + end if + + else + + InputFileData%Current%CurrDIDir = 0.0 + + end if + + !------------------------------------------------------------------------------------------------- + ! Data section for MacCamy-Fuchs diffraction model + !------------------------------------------------------------------------------------------------- + IF ( InputFileData%WaveMod == WaveMod_None .OR. InputFileData%WaveMod == WaveMod_ExtFull ) THEN + IF ( InputFileData%MCFD > 0.0_SiKi ) THEN + CALL SetErrStat( ErrID_Fatal,' The MacCamy-Fuchs diffraction model is not compatible with WaveMod = 0 or 6. Need to set MCFD to 0.',ErrStat,ErrMsg,RoutineName) + RETURN + END IF + END IF + + !------------------------------------------------------------------------------------------------- + ! Data section for OUTPUT + !------------------------------------------------------------------------------------------------- + + + ! OutSwtch - output file switch + + if ( InputFileData%OutSwtch /= 1 .AND. InputFileData%OutSwtch /= 2 .AND. InputFileData%OutSwtch /= 3 ) then + call SetErrStat( ErrID_Fatal,'OutSwitch must be set to 1, 2, or 3.',ErrStat,ErrMsg,RoutineName) + return + end if + + !InputFileData%OutFmt + !InputFileData%OutSFmt + + ! Shift from MSL to SWL coordinate system + InputFileData%WaveKinzi(:) = InputFileData%WaveKinzi(:) - InputFileData%MSL2SWL + + + !---------------------------------------------------------- + ! Populate data in sub-types from parent or other module types + !---------------------------------------------------------- + + ! Current + ! For wave kinematic calculations, the effective water depth is the user input water depth (positive valued) + MSL2SWL (positive when SWL is above MSL). + InputFileData%Current%EffWtrDpth = InputFileData%WtrDpth + InputFileData%MSL2SWL ! adjusted for the MSL2SWL. + + + ! Waves + InputFileData%Waves%Gravity = InitInp%Gravity + ! For wave kinematic calculations, the effective water depth is the user input water depth (positive valued) + MSL2SWL (positive when SWL is above MSL). + + + + +!TODO: This is now set with the grid points? GJH 7/11/21 + + p%NGrid(1) = InputFileData%NX*2-1 + p%NGrid(2) = InputFileData%NY*2-1 + p%NGrid(3) = InputFileData%NZ + p%NGridPts = p%NGrid(1) * p%NGrid(2) * p%NGrid(3) + InputFileData%Waves%NGrid = p%NGrid + InputFileData%Current%NGridPts = p%NGridPts + + call AllocAry( InputFileData%Current%WaveKinGridzi, p%NGridPts, 'WaveKinGridzi' , ErrStat2, ErrMsg2); call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + if ( ErrStat >= AbortErrLev ) return + + + ! Establish the number and locations where the wave kinematics will be computed + InputFileData%Waves%NWaveKinGrid = p%NGridPts ! Number of grid points where the incident wave kinematics will be computed (-) + InputFileData%Waves%NWaveElevGrid = p%NGrid(1)*p%NGrid(2) ! Number of XY grid points where the wave elevations are computed + + if ( InputFileData%Waves%NWaveElevGrid < 0 ) then + call SetErrStat( ErrID_Fatal,'Number of nodes in the spatial discretization ('//trim(num2lstr(InputFileData%Waves%NWaveElevGrid))//') must not be negative.',ErrStat,ErrMsg,RoutineName) + return + end if + + call AllocAry( InputFileData%Waves%WaveKinGridxi, p%NGridPts, 'WaveKinGridxi' , ErrStat2, ErrMsg2); call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + call AllocAry( InputFileData%Waves%WaveKinGridyi, p%NGridPts, 'WaveKinGridyi' , ErrStat2, ErrMsg2); call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + call AllocAry( InputFileData%Waves%WaveKinGridzi, p%NGridPts, 'WaveKinGridzi' , ErrStat2, ErrMsg2); call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + if ( ErrStat >= AbortErrLev ) return + + ! Generate grid points + p%deltaGrid(1) = InputFileData%X_HalfWidth/(InputFileData%NX-1) + p%deltaGrid(2)= InputFileData%Y_HalfWidth/(InputFileData%NY-1) + p%deltaGrid(3) = PI / ( 2*(InputFileData%NZ-1) ) + count = 1 + do k = 0, p%NGrid(3) - 1 + zpos = - ( 1.0 - cos( real((p%NGrid(3) - 1) - k, ReKi) * p%deltaGrid(3) ) ) * InputFileData%Z_Depth + do j = 0, p%NGrid(2)-1 + ypos = -InputFileData%Y_HalfWidth + p%deltaGrid(2)*j + do i= 0, p%NGrid(1)-1 + xpos = -InputFileData%X_HalfWidth + p%deltaGrid(1)*i + InputFileData%Waves%WaveKinGridxi(count) = xpos ! xi-coordinates for points where the incident wave kinematics will be computed; + InputFileData%Waves%WaveKinGridyi(count) = ypos ! yi-coordinates for points where the incident wave kinematics will be computed; + + InputFileData%Waves%WaveKinGridzi(count) = zpos ! zi-coordinates for points where the incident wave kinematics will be computed; + InputFileData%Current%WaveKinGridzi(count) = InputFileData%Waves%WaveKinGridzi(count) + + !if ( k == 0 ) then + ! InputFileData%Waves%WaveElevGridxi(count) = xpos ! xi-coordinates for points where the incident wave kinematics will be computed; + ! InputFileData%Waves%WaveElevGridyi(count) = ypos ! yi-coordinates for points where the incident wave kinematics will be computed; + !end if + count = count + 1 + end do + end do + end do + + ! Waves2 + + ! If we are using the Waves module, the node information must be copied over. + InputFileData%Waves2%NWaveKinGrid = InputFileData%Waves%NWaveKinGrid ! Number of points where the incident wave kinematics will be computed (-) + if ( InputFileData%Waves2%WvDiffQTFF .OR. InputFileData%Waves2%WvSumQTFF ) then + InputFileData%Waves2%Gravity = InitInp%Gravity + InputFileData%Waves2%NGrid = p%NGrid + InputFileData%Waves2%NWaveElevGrid = InputFileData%Waves%NWaveElevGrid + + call AllocAry( InputFileData%Waves2%WaveKinGridxi, p%NGridPts, 'WaveKinGridxi' , ErrStat2, ErrMsg2); call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + call AllocAry( InputFileData%Waves2%WaveKinGridyi, p%NGridPts, 'WaveKinGridyi' , ErrStat2, ErrMsg2); call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + call AllocAry( InputFileData%Waves2%WaveKinGridzi, p%NGridPts, 'WaveKinGridzi' , ErrStat2, ErrMsg2); call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + if ( ErrStat >= AbortErrLev ) return + + InputFileData%Waves2%WaveKinGridxi = InputFileData%Waves%WaveKinGridxi + InputFileData%Waves2%WaveKinGridyi = InputFileData%Waves%WaveKinGridyi + InputFileData%Waves2%WaveKinGridzi = InputFileData%Waves%WaveKinGridzi + ENDIF + + + !------------------------------------------------------------ + ! Allocate the WaveFieldType to store wave field information + !------------------------------------------------------------ + ALLOCATE(p%WaveField, STAT=ErrStat2) + IF (ErrStat2 /=0) THEN + CALL SetErrStat(ErrID_Fatal,"Error allocating WaveField.",ErrStat,ErrMsg,RoutineName) + RETURN + END IF + + p%WaveField%WtrDpth = InputFileData%WtrDpth + p%WaveField%MSL2SWL = InputFileData%MSL2SWL + p%WaveField%EffWtrDpth = InputFileData%WtrDpth + InputFileData%MSL2SWL + + p%WaveField%WaveMod = InputFileData%WaveMod + p%WaveField%WaveStMod = InputFileData%WaveStMod + p%WaveField%WtrDens = InputFileData%WtrDens ! may have overwritten default InitInp + p%WaveField%RhoXg = p%WaveField%WtrDens*InitInp%Gravity ! For WAMIT and WAMIT2 + p%WaveField%WaveDir = InputFileData%WaveDir + p%WaveField%WaveMultiDir = InputFileData%WaveMultiDir + p%WaveField%MCFD = InputFileData%MCFD + + p%WaveField%WvLowCOff = InputFileData%WvLowCOff + p%WaveField%WvHiCOff = InputFileData%WvHiCOff + p%WaveField%WvLowCOffD = InputFileData%WvLowCOffD + p%WaveField%WvHiCOffD = InputFileData%WvHiCOffD + p%WaveField%WvLowCOffS = InputFileData%WvLowCOffS + p%WaveField%WvHiCOffS = InputFileData%WvHiCOffS + p%WaveField%WaveDOmega = InputFileData%WaveDOmega ! For WAMIT and WAMIT2, FIT + + +end subroutine SeaStateInput_ProcessInitData + +end module SeaState_Input diff --git a/modules/seastate/src/SeaState_Output.f90 b/modules/seastate/src/SeaState_Output.f90 new file mode 100644 index 0000000000..dc202ce5a6 --- /dev/null +++ b/modules/seastate/src/SeaState_Output.f90 @@ -0,0 +1,1122 @@ +!********************************************************************************************************************************** +! LICENSING +! Copyright (C) 2013-2015 National Renewable Energy Laboratory +! +! This file is part of SeaState. +! +! 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 SeaState_Output + + ! This MODULE stores variables used for output. + + USE NWTC_Library + USE SeaState_Types + USE Waves ! for WaveNumber + + IMPLICIT NONE + + PRIVATE + + TYPE(ProgDesc), PUBLIC, PARAMETER :: SeaSt_ProgDesc = ProgDesc( 'SeaState', '', '' ) + +! =================================================================================================== +! 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 07-Sep-2022 15:30:45. + + + ! 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 + + + ! Wave Elevations: + + INTEGER(IntKi), PARAMETER :: Wave1Elev = 1 + INTEGER(IntKi), PARAMETER :: Wave2Elev = 2 + INTEGER(IntKi), PARAMETER :: Wave3Elev = 3 + INTEGER(IntKi), PARAMETER :: Wave4Elev = 4 + INTEGER(IntKi), PARAMETER :: Wave5Elev = 5 + INTEGER(IntKi), PARAMETER :: Wave6Elev = 6 + INTEGER(IntKi), PARAMETER :: Wave7Elev = 7 + INTEGER(IntKi), PARAMETER :: Wave8Elev = 8 + INTEGER(IntKi), PARAMETER :: Wave9Elev = 9 + INTEGER(IntKi), PARAMETER :: Wave1Elv1 = 10 + INTEGER(IntKi), PARAMETER :: Wave2Elv1 = 11 + INTEGER(IntKi), PARAMETER :: Wave3Elv1 = 12 + INTEGER(IntKi), PARAMETER :: Wave4Elv1 = 13 + INTEGER(IntKi), PARAMETER :: Wave5Elv1 = 14 + INTEGER(IntKi), PARAMETER :: Wave6Elv1 = 15 + INTEGER(IntKi), PARAMETER :: Wave7Elv1 = 16 + INTEGER(IntKi), PARAMETER :: Wave8Elv1 = 17 + INTEGER(IntKi), PARAMETER :: Wave9Elv1 = 18 + INTEGER(IntKi), PARAMETER :: Wave1Elv2 = 19 + INTEGER(IntKi), PARAMETER :: Wave2Elv2 = 20 + INTEGER(IntKi), PARAMETER :: Wave3Elv2 = 21 + INTEGER(IntKi), PARAMETER :: Wave4Elv2 = 22 + INTEGER(IntKi), PARAMETER :: Wave5Elv2 = 23 + INTEGER(IntKi), PARAMETER :: Wave6Elv2 = 24 + INTEGER(IntKi), PARAMETER :: Wave7Elv2 = 25 + INTEGER(IntKi), PARAMETER :: Wave8Elv2 = 26 + INTEGER(IntKi), PARAMETER :: Wave9Elv2 = 27 + + + ! Wave Kinematics: + + INTEGER(IntKi), PARAMETER :: FVel1xi = 28 + INTEGER(IntKi), PARAMETER :: FVel2xi = 29 + INTEGER(IntKi), PARAMETER :: FVel3xi = 30 + INTEGER(IntKi), PARAMETER :: FVel4xi = 31 + INTEGER(IntKi), PARAMETER :: FVel5xi = 32 + INTEGER(IntKi), PARAMETER :: FVel6xi = 33 + INTEGER(IntKi), PARAMETER :: FVel7xi = 34 + INTEGER(IntKi), PARAMETER :: FVel8xi = 35 + INTEGER(IntKi), PARAMETER :: FVel9xi = 36 + INTEGER(IntKi), PARAMETER :: FVel1yi = 37 + INTEGER(IntKi), PARAMETER :: FVel2yi = 38 + INTEGER(IntKi), PARAMETER :: FVel3yi = 39 + INTEGER(IntKi), PARAMETER :: FVel4yi = 40 + INTEGER(IntKi), PARAMETER :: FVel5yi = 41 + INTEGER(IntKi), PARAMETER :: FVel6yi = 42 + INTEGER(IntKi), PARAMETER :: FVel7yi = 43 + INTEGER(IntKi), PARAMETER :: FVel8yi = 44 + INTEGER(IntKi), PARAMETER :: FVel9yi = 45 + INTEGER(IntKi), PARAMETER :: FVel1zi = 46 + INTEGER(IntKi), PARAMETER :: FVel2zi = 47 + INTEGER(IntKi), PARAMETER :: FVel3zi = 48 + INTEGER(IntKi), PARAMETER :: FVel4zi = 49 + INTEGER(IntKi), PARAMETER :: FVel5zi = 50 + INTEGER(IntKi), PARAMETER :: FVel6zi = 51 + INTEGER(IntKi), PARAMETER :: FVel7zi = 52 + INTEGER(IntKi), PARAMETER :: FVel8zi = 53 + INTEGER(IntKi), PARAMETER :: FVel9zi = 54 + INTEGER(IntKi), PARAMETER :: FAcc1xi = 55 + INTEGER(IntKi), PARAMETER :: FAcc2xi = 56 + INTEGER(IntKi), PARAMETER :: FAcc3xi = 57 + INTEGER(IntKi), PARAMETER :: FAcc4xi = 58 + INTEGER(IntKi), PARAMETER :: FAcc5xi = 59 + INTEGER(IntKi), PARAMETER :: FAcc6xi = 60 + INTEGER(IntKi), PARAMETER :: FAcc7xi = 61 + INTEGER(IntKi), PARAMETER :: FAcc8xi = 62 + INTEGER(IntKi), PARAMETER :: FAcc9xi = 63 + INTEGER(IntKi), PARAMETER :: FAcc1yi = 64 + INTEGER(IntKi), PARAMETER :: FAcc2yi = 65 + INTEGER(IntKi), PARAMETER :: FAcc3yi = 66 + INTEGER(IntKi), PARAMETER :: FAcc4yi = 67 + INTEGER(IntKi), PARAMETER :: FAcc5yi = 68 + INTEGER(IntKi), PARAMETER :: FAcc6yi = 69 + INTEGER(IntKi), PARAMETER :: FAcc7yi = 70 + INTEGER(IntKi), PARAMETER :: FAcc8yi = 71 + INTEGER(IntKi), PARAMETER :: FAcc9yi = 72 + INTEGER(IntKi), PARAMETER :: FAcc1zi = 73 + INTEGER(IntKi), PARAMETER :: FAcc2zi = 74 + INTEGER(IntKi), PARAMETER :: FAcc3zi = 75 + INTEGER(IntKi), PARAMETER :: FAcc4zi = 76 + INTEGER(IntKi), PARAMETER :: FAcc5zi = 77 + INTEGER(IntKi), PARAMETER :: FAcc6zi = 78 + INTEGER(IntKi), PARAMETER :: FAcc7zi = 79 + INTEGER(IntKi), PARAMETER :: FAcc8zi = 80 + INTEGER(IntKi), PARAMETER :: FAcc9zi = 81 + INTEGER(IntKi), PARAMETER :: FDynP1 = 82 + INTEGER(IntKi), PARAMETER :: FDynP2 = 83 + INTEGER(IntKi), PARAMETER :: FDynP3 = 84 + INTEGER(IntKi), PARAMETER :: FDynP4 = 85 + INTEGER(IntKi), PARAMETER :: FDynP5 = 86 + INTEGER(IntKi), PARAMETER :: FDynP6 = 87 + INTEGER(IntKi), PARAMETER :: FDynP7 = 88 + INTEGER(IntKi), PARAMETER :: FDynP8 = 89 + INTEGER(IntKi), PARAMETER :: FDynP9 = 90 + INTEGER(IntKi), PARAMETER :: FAccMCF1xi = 91 + INTEGER(IntKi), PARAMETER :: FAccMCF2xi = 92 + INTEGER(IntKi), PARAMETER :: FAccMCF3xi = 93 + INTEGER(IntKi), PARAMETER :: FAccMCF4xi = 94 + INTEGER(IntKi), PARAMETER :: FAccMCF5xi = 95 + INTEGER(IntKi), PARAMETER :: FAccMCF6xi = 96 + INTEGER(IntKi), PARAMETER :: FAccMCF7xi = 97 + INTEGER(IntKi), PARAMETER :: FAccMCF8xi = 98 + INTEGER(IntKi), PARAMETER :: FAccMCF9xi = 99 + INTEGER(IntKi), PARAMETER :: FAccMCF1yi = 100 + INTEGER(IntKi), PARAMETER :: FAccMCF2yi = 101 + INTEGER(IntKi), PARAMETER :: FAccMCF3yi = 102 + INTEGER(IntKi), PARAMETER :: FAccMCF4yi = 103 + INTEGER(IntKi), PARAMETER :: FAccMCF5yi = 104 + INTEGER(IntKi), PARAMETER :: FAccMCF6yi = 105 + INTEGER(IntKi), PARAMETER :: FAccMCF7yi = 106 + INTEGER(IntKi), PARAMETER :: FAccMCF8yi = 107 + INTEGER(IntKi), PARAMETER :: FAccMCF9yi = 108 + INTEGER(IntKi), PARAMETER :: FAccMCF1zi = 109 + INTEGER(IntKi), PARAMETER :: FAccMCF2zi = 110 + INTEGER(IntKi), PARAMETER :: FAccMCF3zi = 111 + INTEGER(IntKi), PARAMETER :: FAccMCF4zi = 112 + INTEGER(IntKi), PARAMETER :: FAccMCF5zi = 113 + INTEGER(IntKi), PARAMETER :: FAccMCF6zi = 114 + INTEGER(IntKi), PARAMETER :: FAccMCF7zi = 115 + INTEGER(IntKi), PARAMETER :: FAccMCF8zi = 116 + INTEGER(IntKi), PARAMETER :: FAccMCF9zi = 117 + + + ! The maximum number of output channels which can be output by the code. + INTEGER(IntKi), PARAMETER, PUBLIC :: MaxOutPts = 117 + +!End of code generated by Matlab script Write_ChckOutLst +! =================================================================================================== + + + INTEGER, PARAMETER :: WaveElevi(9) = (/Wave1Elev,Wave2Elev,Wave3Elev,Wave4Elev,Wave5Elev,Wave6Elev,Wave7Elev,Wave8Elev,Wave9Elev/) + INTEGER, PARAMETER :: WaveElevi1(9) = (/Wave1Elv1,Wave2Elv1,Wave3Elv1,Wave4Elv1,Wave5Elv1,Wave6Elv1,Wave7Elv1,Wave8Elv1,Wave9Elv1/) + INTEGER, PARAMETER :: WaveElevi2(9) = (/Wave1Elv2,Wave2Elv2,Wave3Elv2,Wave4Elv2,Wave5Elv2,Wave6Elv2,Wave7Elv2,Wave8Elv2,Wave9Elv2/) + + INTEGER, PARAMETER :: FVel(3,9) = reshape((/FVel1xi,FVel1yi,FVel1zi, & + FVel2xi,FVel2yi,FVel2zi, & + FVel3xi,FVel3yi,FVel3zi, & + FVel4xi,FVel4yi,FVel4zi, & + FVel5xi,FVel5yi,FVel5zi, & + FVel6xi,FVel6yi,FVel6zi, & + FVel7xi,FVel7yi,FVel7zi, & + FVel8xi,FVel8yi,FVel8zi, & + FVel9xi,FVel9yi,FVel9zi/), & + (/3,9/)) + INTEGER, PARAMETER :: FAcc(3,9) = reshape((/FAcc1xi,FAcc1yi,FAcc1zi, & + FAcc2xi,FAcc2yi,FAcc2zi, & + FAcc3xi,FAcc3yi,FAcc3zi, & + FAcc4xi,FAcc4yi,FAcc4zi, & + FAcc5xi,FAcc5yi,FAcc5zi, & + FAcc6xi,FAcc6yi,FAcc6zi, & + FAcc7xi,FAcc7yi,FAcc7zi, & + FAcc8xi,FAcc8yi,FAcc8zi, & + FAcc9xi,FAcc9yi,FAcc9zi/), & + (/3,9/)) + INTEGER, PARAMETER :: FDynP(9) = (/FDynP1,FDynP2,FDynP3,FDynP4,FDynP5,FDynP6,FDynP7,FDynP8,FDynP9/) + INTEGER, PARAMETER :: FAccMCF(3,9) = reshape((/FAccMCF1xi,FAccMCF1yi,FAccMCF1zi, & + FAccMCF2xi,FAccMCF2yi,FAccMCF2zi, & + FAccMCF3xi,FAccMCF3yi,FAccMCF3zi, & + FAccMCF4xi,FAccMCF4yi,FAccMCF4zi, & + FAccMCF5xi,FAccMCF5yi,FAccMCF5zi, & + FAccMCF6xi,FAccMCF6yi,FAccMCF6zi, & + FAccMCF7xi,FAccMCF7yi,FAccMCF7zi, & + FAccMCF8xi,FAccMCF8yi,FAccMCF8zi, & + FAccMCF9xi,FAccMCF9yi,FAccMCF9zi/), & + (/3,9/)) + + + ! ..... Public Subroutines ................................................................................................... + PUBLIC :: SeaStOut_WrSummaryFile + PUBLIC :: SeaStOut_MapOutputs + PUBLIC :: SeaStOut_WriteOutputs + PUBLIC :: SeaStOut_OpenOutput + PUBLIC :: SeaStOut_CloseOutput + PUBLIC :: SeaStOut_Init + PUBLIC :: SeaStOut_WriteWvKinFiles + PUBLIC :: SeaStOut_WriteWaveElev0 + +CONTAINS + +!==================================================================================================== +SUBROUTINE SeaStOut_WriteWvKinFiles( Rootname, SeaSt_Prog, WaveField, WaveDT, X_HalfWidth, Y_HalfWidth, & + deltaGrid, NGrid, ErrStat, ErrMsg ) + + ! Passed variables + CHARACTER(*), INTENT( IN ) :: Rootname ! filename including full path, minus any file extension. + TYPE(ProgDesc), INTENT( IN ) :: SeaSt_Prog ! the name/version/date of the SeaState program + TYPE(SeaSt_WaveFieldType), INTENT( IN ) :: WaveField !< WaveFieldType + real(DbKi), intent( in ) :: WaveDT + real(ReKi), intent( in ) :: X_HalfWidth + real(ReKi), intent( in ) :: Y_HalfWidth + real(ReKi), intent( in ) :: deltaGrid(3) + INTEGER, INTENT( IN ) :: NGrid(3) ! Number of grid points for the wave kinematics arrays + 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 :: UnWv ! file unit for writing the various wave kinematics files + CHARACTER(1024) :: WvName ! complete filename for one of the output files + CHARACTER(5) :: extension(7) + INTEGER :: i, j, k, m, iFile + CHARACTER(64) :: Frmt, Sfrmt + CHARACTER(1), parameter :: Delim = " " + real(ReKi) :: x_gridPts(NGrid(1)), y_gridPts(NGrid(2)), z_gridPts(NGrid(3)) + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" + + extension = (/'.Vxi ','.Vyi ','.Vzi ','.Axi ','.Ayi ','.Azi ','.DynP'/) + !Frmt = '('//TRIM(Int2LStr(NNodes))//'(:,A,ES11.4e2))' + Frmt = '(A1,ES11.4e2)' + Sfrmt = '(A1,A11)' + + ! Create grid point locations + + do i = 0, NGrid(1)-1 + x_gridPts(i+1) = -X_HalfWidth + deltaGrid(1)*i + end do + do i = 0, NGrid(2)-1 + y_gridPts(i+1) = -Y_HalfWidth + deltaGrid(2)*i + end do + do i = 0, NGrid(3)-1 + z_gridPts(i+1) = - ( 1.0 - cos( real((NGrid(3) - 1) - i, ReKi) * deltaGrid(3) ) ) * WaveField%GridParams%Z_Depth + end do + + ! Write the increments from [0, NStepWave] even though for OpenFAST data, NStepWave = 0, but for arbitrary user data this may not be true. + ! As a result for WaveMod=5,6 we shouldn't assume periodic waves over the period WaveTMax + + DO iFile = 1,7 + + + WvName = TRIM(Rootname) // TRIM(extension(iFile)) + !$OMP critical(fileopen) + CALL GetNewUnit( UnWv ) + CALL OpenFOutFile ( UnWv, WvName, ErrStat, ErrMsg ) + !$OMP end critical(fileopen) + IF (ErrStat >=AbortErrLev) RETURN + + call WriteWvKinHeader( UnWv, iFile, Delim, SeaSt_Prog, waveDT, -z_gridPts(1), NGrid, deltaGrid ) + + DO m= 0,WaveField%NStepWave + DO k = 1, NGrid(3) + do j = 1, NGrid(2) + do i = 1, NGrid(1) + + !IF ( nodeInWater(i,j) == 0 ) THEN + ! WRITE(UnWv,Sfrmt,ADVANCE='no') Delim, '##########' + !ELSE + + SELECT CASE (iFile) + CASE (1) + WRITE(UnWv,Frmt,ADVANCE='no') Delim, WaveField%WaveVel (m,i,j,k,1) + CASE (2) + WRITE(UnWv,Frmt,ADVANCE='no') Delim, WaveField%WaveVel (m,i,j,k,2) + CASE (3) + WRITE(UnWv,Frmt,ADVANCE='no') Delim, WaveField%WaveVel (m,i,j,k,3) + CASE (4) + WRITE(UnWv,Frmt,ADVANCE='no') Delim, WaveField%WaveAcc (m,i,j,k,1) + CASE (5) + WRITE(UnWv,Frmt,ADVANCE='no') Delim, WaveField%WaveAcc (m,i,j,k,2) + CASE (6) + WRITE(UnWv,Frmt,ADVANCE='no') Delim, WaveField%WaveAcc (m,i,j,k,3) + CASE (7) + WRITE(UnWv,Frmt,ADVANCE='no') Delim, WaveField%WaveDynP(m,i,j,k ) + END SELECT + !END IF + END DO ! for i + WRITE (UnWv,'(A)', IOSTAT=ErrStat) ' ! All X grid locations at Y = '//TRIM(num2lstr(y_gridPts(j)))// & + ', Z = '//TRIM(num2lstr(z_gridPts(k)))// & + ', WaveTime = '//TRIM(num2lstr(waveDT*m)) ! write the line return + END DO ! for j + END DO ! for k + END DO ! for m + CLOSE( UnWv, IOSTAT=ErrStat ) + IF (ErrStat /= 0) THEN + ErrStat = ErrID_Fatal + ErrMsg = 'Problem closing wave kinematics file' + RETURN + END IF + END DO + + ! WaveElevation Grid + WvName = TRIM(Rootname) // '.Elev' + !$OMP critical(fileopen) + CALL GetNewUnit( UnWv ) + CALL OpenFOutFile ( UnWv, WvName, ErrStat, ErrMsg ) + !$OMP end critical(fileopen) + IF (ErrStat >=AbortErrLev) RETURN + + + call WriteWvKinHeader( UnWv, 8, Delim, SeaSt_Prog, waveDT, -z_gridPts(1), NGrid, deltaGrid ) + + + DO m= 0,WaveField%NStepWave + do j = 1, NGrid(2) + do i = 1, NGrid(1) + if ( allocated(WaveField%WaveElev2) ) then + WRITE(UnWv,Frmt,ADVANCE='no') Delim, WaveField%WaveElev1(m,i,j) + WaveField%WaveElev2(m,i,j) + else + WRITE(UnWv,Frmt,ADVANCE='no') Delim, WaveField%WaveElev1(m,i,j) + end if + end do + WRITE (UnWv,'()', IOSTAT=ErrStat) ! write the line return + end do + + END DO + + CLOSE( UnWv, IOSTAT=ErrStat ) + IF (ErrStat /= 0) THEN + ErrStat = ErrID_Fatal + ErrMsg = 'Problem closing wave elevations file' + RETURN + END IF + + contains + + subroutine WriteWvKinHeader( UnWv, fileType, Delim, SeaSt_Prog, waveDT, Z_Depth, NGrid, deltaGrid ) + ! Passed variables + INTEGER, INTENT( IN ) :: UnWv + integer, intent( in ) :: fileType + CHARACTER(*), intent( in ) :: Delim + TYPE(ProgDesc), INTENT( IN ) :: SeaSt_Prog ! the name/version/date of the SeaState program + real(DbKi), intent( in ) :: WaveDT + real(ReKi), intent( in ) :: Z_Depth + real(ReKi), intent( in ) :: deltaGrid(3) + INTEGER, INTENT( IN ) :: NGrid(3) ! Number of grid points for the wave kinematics arrays + + integer(IntKi) :: i + CHARACTER(64) :: Frmt, Frmt2 + + ! Write the summary file header + ! WRITE (UnWv,'(/,A/)', IOSTAT=ErrStat) 'This wave kinematics file was generated by '//TRIM( HD_Prog%Name )//& + WRITE (UnWv,'(A)', IOSTAT=ErrStat) 'This wave kinematics file was generated by '//TRIM( SeaSt_Prog%Name )//& + ' '//TRIM( SeaSt_Prog%Ver )//' on '//CurDate()//' at '//CurTime()//'.' + SELECT CASE (fileType) + CASE (1) + WRITE(UnWv, '(A)', IOSTAT=ErrStat) 'Fluid Velocity along the X-direction (m/s)' + CASE (2) + WRITE(UnWv, '(A)', IOSTAT=ErrStat) 'Fluid Velocity along the Y-direction (m/s)' + CASE (3) + WRITE(UnWv, '(A)', IOSTAT=ErrStat) 'Fluid Velocity along the Z-direction (m/s)' + CASE (4) + WRITE(UnWv, '(A)', IOSTAT=ErrStat) 'Fluid Acceleration along the X-direction (m/s^2)' + CASE (5) + WRITE(UnWv, '(A)', IOSTAT=ErrStat) 'Fluid Acceleration along the Y-direction (m/s^2)' + CASE (6) + WRITE(UnWv, '(A)', IOSTAT=ErrStat) 'Fluid Acceleration along the Z-direction (m/s^2)' + CASE (7) + WRITE(UnWv, '(A)', IOSTAT=ErrStat) 'Fluid Dynamic Pressure (Pa)' + CASE (8) + WRITE(UnWv, '(A)', IOSTAT=ErrStat) 'Wave Elevation (m)' + END SELECT + Frmt = '(A1,ES11.4e2,A)' + Frmt2 = '(A1,I11,A)' + write (UnWv,Frmt, IOSTAT=ErrStat) '!' , waveDT , ' - WaveDT (s)' + write (UnWv,Frmt2, IOSTAT=ErrStat) '!' , NGrid(1) , ' - Number of X grid points [NX*2 - 1]' + write (UnWv,Frmt2, IOSTAT=ErrStat) '!' , NGrid(2) , ' - Number of Y grid points [NY*2 - 1]' + write (UnWv,Frmt2, IOSTAT=ErrStat) '!' , NGrid(3) , ' - Number of Z grid points [NZ]' + write (UnWv,Frmt, IOSTAT=ErrStat) '!' , deltaGrid(1) , ' - X grid spacing (m) [dX]' + write (UnWv,Frmt, IOSTAT=ErrStat) '!' , deltaGrid(2) , ' - Y grid spacing (m) [dY]' + write (UnWv,Frmt, IOSTAT=ErrStat) '!' , Z_Depth , ' - Lowest Z Depth (m) [Z_Depth]' + write (UnWv,Frmt, IOSTAT=ErrStat) '!' , deltaGrid(3) , ' - Z grid spacing (radians) [dthetaZ, where Z coordinates are found using: Z[nZ] = ( COS( nZ*dthetaZ ) - 1 )*Z_Depth, where nZ = {NZ-1, NZ-2, ..., 1,0} and dthetaZ = pi/( 2*(NZ-1) ) and 0 < Z_Depth <= WtrDpth+MSL2SWL ]' + + Frmt = '(A1,'//TRIM(Int2LStr(NGrid(1)))//'(A1,ES11.4e2),A)' + write(UnWv,Frmt) '!', ( Delim, x_gridPts(i) , i=1,NGrid(1) ), ' - X-Locations (m)' + Frmt = '(A1,'//TRIM(Int2LStr(NGrid(2)))//'(A1,ES11.4e2),A)' + write(UnWv,Frmt) '!', ( Delim, y_gridPts(i) , i=1,NGrid(2) ), ' - Y-Locations (m)' + Frmt = '(A1,'//TRIM(Int2LStr(NGrid(3)))//'(A1,ES11.4e2),A)' + write(UnWv,Frmt) '!', ( Delim, z_gridPts(i) , i=1,NGrid(3) ), ' - Z-Locations (m)' + end subroutine WriteWvKinHeader + + +END SUBROUTINE SeaStOut_WriteWvKinFiles +subroutine SeaStOut_WriteWaveElev0( Rootname, NStepWave, NGrid, WaveElev1, WaveElev2, WaveTime, ErrStat, ErrMsg ) + + ! Passed variables + CHARACTER(*), INTENT( IN ) :: Rootname ! filename including full path, minus any file extension. + INTEGER, INTENT( IN ) :: NStepWave ! Number of time steps for the wave kinematics arrays + INTEGER, INTENT( IN ) :: NGrid(3) ! Number of grid points for the wave kinematics arrays + REAL(SiKi), allocatable, INTENT( IN ) :: WaveElev1 (:,:,: ) ! Instantaneous wave elevations at requested locations - 1st order + REAL(SiKi), allocatable, INTENT( IN ) :: WaveElev2 (:,:,: ) ! Instantaneous wave elevations at requested locations - 2nd order + REAL(SiKi), allocatable, INTENT( IN ) :: WaveTime (: ) ! The time values for the wave kinematics (time) + 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 :: UnWv ! file unit for writing the various wave kinematics files + CHARACTER(1024) :: WvName ! complete filename for one of the output files + INTEGER :: i, j, m + CHARACTER(64) :: Frmt, Frmt2 + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" + Frmt = '(F12.4,ES12.4e2)' + Frmt2 = '(2(A12))' + + + WvName = TRIM(Rootname) // '.Elev' + i = NGrid(1) / 2 + 1 + j = NGrid(2) / 2 + 1 + !$OMP critical(fileopen) + CALL GetNewUnit( UnWv ) + CALL OpenFOutFile ( UnWv, WvName, ErrStat, ErrMsg ) + !$OMP end critical(fileopen) + IF (ErrStat >=AbortErrLev) RETURN + ! WRITE (UnWv,'(A)', IOSTAT=ErrStat) 'This wave elevation (0,0) file was generated by '//TRIM( SeaSt_Prog%Name )//& + ! ' '//TRIM( SeaSt_Prog%Ver )//' on '//CurDate()//' at '//CurTime()//'.' + WRITE (UnWv,Frmt2, IOSTAT=ErrStat) 'Time', 'WaveElev0' + ! Write the increments from [0, NStepWave] even though for OpenFAST data, NStepWave = 0, but for arbitrary user data this may not be true. + ! As a result for WaveMod=5,6 we shouldn't assume periodic waves over the period WaveTMax + DO m= 0,NStepWave + if ( allocated(WaveElev2) ) then + WRITE(UnWv,Frmt) WaveTime(m), WaveElev1(m,i,j) + WaveElev2(m,i,j) + else + WRITE(UnWv,Frmt) WaveTime(m), WaveElev1(m,i,j) + end if + END DO + + CLOSE( UnWv, IOSTAT=ErrStat ) + IF (ErrStat /= 0) THEN + ErrStat = ErrID_Fatal + ErrMsg = 'Problem closing wave elevations file' + RETURN + END IF +end subroutine SeaStOut_WriteWaveElev0 + +!==================================================================================================== +subroutine SeaStOut_MapOutputs( p, WaveElev, WaveElev1, WaveElev2, WaveVel, WaveAcc, WaveAccMCF, WaveDynP, AllOuts, ErrStat, ErrMsg ) +! This subroutine writes the data stored in the y variable to the correct indexed postions in WriteOutput +! This is called by SeaSt_CalcOutput() at each time step. +!---------------------------------------------------------------------------------------------------- + TYPE(SeaSt_ParameterType), intent( in ) :: p ! SeaState's parameter data + REAL(SiKi), intent( in ) :: WaveElev(:) ! Instantaneous total elevation of incident waves at each of the NWaveElev points where the incident wave elevations can be output (meters) + REAL(SiKi), intent( in ) :: WaveElev1(:) ! Instantaneous first order elevation of incident waves at each of the NWaveElev points where the incident wave elevations can be output (meters) + REAL(SiKi), intent( in ) :: WaveElev2(:) ! Instantaneous second order elevation of incident waves at each of the NWaveElev points where the incident wave elevations can be output (meters) + REAL(SiKi), intent( in ) :: WaveVel(:,:) ! Instantaneous total elevation of incident waves at each of the NWaveElev points where the incident wave elevations can be output (meters) + REAL(SiKi), intent( in ) :: WaveAcc(:,:) ! Instantaneous first order elevation of incident waves at each of the NWaveElev points where the incident wave elevations can be output (meters) + REAL(SiKi), intent( in ) :: WaveAccMCF(:,:) ! Instantaneous first order elevation of incident waves at each of the NWaveElev points where the incident wave elevations can be output (meters) + REAL(SiKi), intent( in ) :: WaveDynP(:) ! Instantaneous second order elevation of incident waves at each of the NWaveElev points where the incident wave elevations can be output (meters) + REAL(ReKi), intent( out ) :: AllOuts(MaxOutpts) + INTEGER(IntKi), intent( out ) :: ErrStat ! Error status of the operation + CHARACTER(*), intent( out ) :: ErrMsg ! Error message if ErrStat /= ErrID_None + + integer :: I +! integer(IntKi) :: ErrStat2 +! character(ErrMsgLen) :: ErrMsg2 + + ErrStat = ErrID_None + ErrMsg = "" + + ! Initialize all unused channels to zero (in case they don't get set, but are still requested) + AllOuts = 0.0_ReKi + + do I=1,p%NWaveElev + AllOuts(WaveElevi(I)) = WaveElev(I) + AllOuts(WaveElevi1(I))= WaveElev1(I) + AllOuts(WaveElevi2(I))= WaveElev2(I) + end do + + do I=1,p%NWaveKin + AllOuts(FVel(:,I)) = WaveVel(1:3,I) + AllOuts(FAcc(:,I))= WaveAcc(1:3,I) + AllOuts(FDynP(I))= WaveDynP(I) + AllOuts(FAccMCF(:,I))= WaveAccMCF(1:3,I) + end do + + +end subroutine SeaStOut_MapOutputs + +!==================================================================================================== +SUBROUTINE SeaStOut_WriteOutputs( Time, y, p, Decimate, ErrStat, ErrMsg ) +! This subroutine writes the data stored in WriteOutputs (and indexed in OutParam) to the file +! opened in SeaStOut_Init() +!---------------------------------------------------------------------------------------------------- + + ! Passed variables + REAL(DbKi), INTENT( IN ) :: Time + TYPE(SeaSt_OutputType), INTENT( INOUT ) :: y ! SeaState's output data + TYPE(SeaSt_ParameterType), INTENT( IN ) :: p ! SeaState parameter data + INTEGER, INTENT( INOUT ) :: Decimate ! Output decimatation counter + 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 + + + IF (p%UnOutFile < 0 ) RETURN + + ! Initialize ErrStat and determine if it makes any sense to write output +!TODO: We should not have this check here, once per timestep! This should be resolved during initialization. GJH 7/7/2014 + IF ( .NOT. ALLOCATED( p%OutParam ) ) THEN + ErrStat = ErrID_Warn + ErrMsg = ' Cannot write output to file because there are not a valid output list.' + RETURN + ELSE + ErrStat = ErrID_None + ErrMsg = '' + END IF + + + ! Write the output parameters to the file + + !Frmt = '(F8.3,'//TRIM(Int2LStr(p%WAMIT%NumOuts+p%Morison%NumOuts))//'(:,A,'//TRIM( p%OutFmt )//'))' + !Frmt = '('//TRIM( p%OutFmt )//','//TRIM(Int2LStr(p%NumOuts))//'(:,A,'//TRIM( p%OutFmt )//'))' + + !WRITE(p%UnOutFile,Frmt) Time, ( p%Delim, y%WAMIT%WriteOutput(I), I=1,p%WAMIT%NumOuts), ( p%Delim, y%Morison%WriteOutput(I), I=1,p%Morison%NumOuts) + + IF ((Decimate .EQ. p%OutDec) .OR. (Decimate .EQ. 0)) THEN + + Decimate = 1 !reset counter +!TODO: Fix formatting + Frmt = '(F10.4)' + + WRITE(p%UnOutFile,Frmt,ADVANCE='no') Time + + IF ( p%NumOuts > 0 ) THEN + Frmt = '('//TRIM(Int2LStr(p%NumOuts))//'(:,A,'//TRIM( p%OutFmt )//'))' + WRITE(p%UnOutFile,Frmt,ADVANCE='no') ( p%Delim, y%WriteOutput(I) , I=1,p%NumOuts ) + END IF + + WRITE (p%UnOutFile,'()', IOSTAT=ErrStat) ! write the line return + + ELSE + Decimate = Decimate + 1 + ENDIF + + RETURN + +END SUBROUTINE SeaStOut_WriteOutputs + +!==================================================================================================== +SUBROUTINE SeaStOut_Init( SeaSt_ProgDesc, OutRootName, InputFileData, y, p, m, 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 +! NOTE: This routine must be called only after any sub-modules OUT_Init() subroutines have been called. +!---------------------------------------------------------------------------------------------------- + + + + ! Passed variables + + TYPE(ProgDesc), INTENT( IN ) :: SeaSt_ProgDesc ! + CHARACTER(*), INTENT( IN ) :: OutRootName ! The name of the output file + TYPE(SeaSt_InputFile ), INTENT( IN ) :: InputFileData ! data needed to initialize the output module + TYPE(SeaSt_OutputType), INTENT( INOUT ) :: y ! This module's internal data + TYPE(SeaSt_ParameterType), INTENT( INOUT ) :: p + TYPE(SeaSt_MiscVarType), INTENT( INOUT ) :: m + TYPE(SeaSt_InitOutputType), INTENT( INOUT ) :: 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 + INTEGER :: J ! Generic loop counter + + + + + + !------------------------------------------------------------------------------------------------- + ! Initialize local variables + !------------------------------------------------------------------------------------------------- + + + ErrStat = ErrID_None + ErrMsg = "" + + + !------------------------------------------------------------------------------------------------- + ! Check that the variables in OutList are valid + !------------------------------------------------------------------------------------------------- + + CALL SetOutParam(InputFileData%OutList, p, ErrStat, ErrMsg ) + IF ( ErrStat >= AbortErrLev ) RETURN + + ! Aggregate the sub-module initialization outputs for the glue code + + m%LastOutTime = 0.0_DbKi + m%Decimate = 0 + p%OutDec = 1 !TODO: Remove this once the parameter has been added to the HD input file GJH 7/8/2014 + + + ! Allocate the aggregate arrays + + ALLOCATE ( InitOut%WriteOutputHdr ( p%NumOuts ) , STAT=ErrStat ) + IF ( ErrStat /= 0 ) THEN + ErrMsg = ' Error allocating memory for the WriteOutputHdr array.' + ErrStat = ErrID_Fatal + RETURN + END IF + + ALLOCATE ( InitOut%WriteOutputUnt ( p%NumOuts ) , STAT=ErrStat ) + IF ( ErrStat /= 0 ) THEN + ErrMsg = ' Error allocating memory for the WriteOutputUnt array.' + ErrStat = ErrID_Fatal + RETURN + END IF + + ALLOCATE ( y%WriteOutput ( p%NumOuts ) , STAT=ErrStat ) + IF ( ErrStat /= 0 ) THEN + ErrMsg = ' Error allocating memory for the WriteOutput array.' + ErrStat = ErrID_Fatal + RETURN + END IF + y%WriteOutput = 0.0_ReKi ! If there is an error at initialization, y%WriteOutput can be written in the SeaState_End() routine, so this needs some initial value. + + + ! Initialize the HD-level Hdr and Unt elements + DO I = 1,p%NumOuts + + InitOut%WriteOutputHdr(I) = TRIM( p%OutParam(I)%Name ) + InitOut%WriteOutputUnt(I) = TRIM( p%OutParam(I)%Units ) + + END DO + + + J = p%NumOuts + 1 + + + IF ( p%OutSwtch == 1 .OR. p%OutSwtch == 3 ) THEN + CALL SeaStOut_OpenOutput( SeaSt_ProgDesc, OutRootName, p, InitOut, ErrStat, ErrMsg ) + IF (ErrStat >= AbortErrLev ) RETURN + END IF + + + + RETURN + +END SUBROUTINE SeaStOUT_Init + +!==================================================================================================== +SUBROUTINE SeaStOut_OpenOutput( SeaSt_ProgDesc, 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 ) :: SeaSt_ProgDesc + CHARACTER(*), INTENT( IN ) :: OutRootName ! Root name for the output file + TYPE(SeaSt_ParameterType), INTENT( INOUT ) :: p + TYPE(SeaSt_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 +! INTEGER :: Indx ! Counts the current index into the WaveKinNd array + CHARACTER(1024) :: OutFileName ! The name of the output file including the full path. + CHARACTER(200) :: Frmt ! a string to hold a format statement + + !------------------------------------------------------------------------------------------------- + ! Initialize local variables + !------------------------------------------------------------------------------------------------- + ErrStat = ErrID_None + ErrMsg = "" + + + + !------------------------------------------------------------------------------------------------- + ! Open the output file, if necessary, and write the header + !------------------------------------------------------------------------------------------------- + p%UnOutFile = -1 + 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' + + !$OMP critical(fileopen) + CALL GetNewUnit( p%UnOutFile ) + CALL OpenFOutFile ( p%UnOutFile, OutFileName, ErrStat, ErrMsg ) + !$OMP end critical(fileopen) + IF (ErrStat >=AbortErrLev) RETURN + + + ! Write the output file header + + WRITE (p%UnOutFile,'(/,A/)', IOSTAT=ErrStat) 'These predictions were generated by '//TRIM(SeaSt_ProgDesc%Name)//& + ' on '//CurDate()//' at '//CurTime()//'.' + + ! Write three empty lines + WRITE (p%UnOutFile,'()', IOSTAT=ErrStat) + WRITE (p%UnOutFile,'()', IOSTAT=ErrStat) + WRITE (p%UnOutFile,'()', IOSTAT=ErrStat) + + ! Write the names of the output parameters: + Frmt = '(A10)' + WRITE(p%UnOutFile,Frmt,ADVANCE='no') TRIM( 'Time' ) + + IF (ALLOCATED( p%OutParam ) .AND. p%NumOuts > 0) THEN + Frmt = '('//TRIM(Int2LStr(p%NumOuts))//'(:,A,'//TRIM( p%OutSFmt )//'))' + WRITE(p%UnOutFile,Frmt,ADVANCE='no') ( p%Delim, TRIM( InitOut%WriteOutputHdr(I) ), I=1,p%NumOuts ) !since p%OutSFmt is a user-specified format, we should probably add some error handling here... + END IF + + WRITE (p%UnOutFile,'()', IOSTAT=ErrStat) ! write the line return + + + ! Write the units of the output parameters: + + + Frmt = '(A8)' + WRITE(p%UnOutFile,Frmt,ADVANCE='no') TRIM( '(sec)' ) + + IF (ALLOCATED( p%OutParam ) .AND. p%NumOuts > 0) THEN + Frmt = '('//TRIM(Int2LStr(p%NumOuts))//'(:,A,'//TRIM( p%OutSFmt )//'))' + WRITE(p%UnOutFile,Frmt,ADVANCE='no') ( p%Delim, TRIM( InitOut%WriteOutputUnt(I) ), I=1,p%NumOuts ) !since p%OutSFmt is a user-specified format, we should probably add some error handling here... + END IF + + + WRITE (p%UnOutFile,'()', IOSTAT=ErrStat) ! write the line return + + + + END IF ! there are any requested outputs + + RETURN + +END SUBROUTINE SeaStOut_OpenOutput + +!==================================================================================================== +! 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 07-Sep-2022 16:06:37. +SUBROUTINE SetOutParam(OutList, p, ErrStat, ErrMsg ) +!.................................................................................................................................. + + IMPLICIT NONE + + ! Passed variables + + CHARACTER(ChanLen), INTENT(IN) :: OutList(:) !< The list out user-requested outputs + TYPE(SeaSt_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 :: InvalidOutput(0:MaxOutPts) ! This array determines if the output channel is valid for this configuration + CHARACTER(*), PARAMETER :: RoutineName = "SetOutParam" + + CHARACTER(OutStrLenM1), PARAMETER :: ValidParamAry(117) = (/ & ! This lists the names of the allowed parameters, which must be sorted alphabetically + "FACC1XI ","FACC1YI ","FACC1ZI ","FACC2XI ","FACC2YI ","FACC2ZI ","FACC3XI ", & + "FACC3YI ","FACC3ZI ","FACC4XI ","FACC4YI ","FACC4ZI ","FACC5XI ","FACC5YI ", & + "FACC5ZI ","FACC6XI ","FACC6YI ","FACC6ZI ","FACC7XI ","FACC7YI ","FACC7ZI ", & + "FACC8XI ","FACC8YI ","FACC8ZI ","FACC9XI ","FACC9YI ","FACC9ZI ","FACCMCF1XI", & + "FACCMCF1YI","FACCMCF1ZI","FACCMCF2XI","FACCMCF2YI","FACCMCF2ZI","FACCMCF3XI","FACCMCF3YI", & + "FACCMCF3ZI","FACCMCF4XI","FACCMCF4YI","FACCMCF4ZI","FACCMCF5XI","FACCMCF5YI","FACCMCF5ZI", & + "FACCMCF6XI","FACCMCF6YI","FACCMCF6ZI","FACCMCF7XI","FACCMCF7YI","FACCMCF7ZI","FACCMCF8XI", & + "FACCMCF8YI","FACCMCF8ZI","FACCMCF9XI","FACCMCF9YI","FACCMCF9ZI","FDYNP1 ","FDYNP2 ", & + "FDYNP3 ","FDYNP4 ","FDYNP5 ","FDYNP6 ","FDYNP7 ","FDYNP8 ","FDYNP9 ", & + "FVEL1XI ","FVEL1YI ","FVEL1ZI ","FVEL2XI ","FVEL2YI ","FVEL2ZI ","FVEL3XI ", & + "FVEL3YI ","FVEL3ZI ","FVEL4XI ","FVEL4YI ","FVEL4ZI ","FVEL5XI ","FVEL5YI ", & + "FVEL5ZI ","FVEL6XI ","FVEL6YI ","FVEL6ZI ","FVEL7XI ","FVEL7YI ","FVEL7ZI ", & + "FVEL8XI ","FVEL8YI ","FVEL8ZI ","FVEL9XI ","FVEL9YI ","FVEL9ZI ","WAVE1ELEV ", & + "WAVE1ELV1 ","WAVE1ELV2 ","WAVE2ELEV ","WAVE2ELV1 ","WAVE2ELV2 ","WAVE3ELEV ","WAVE3ELV1 ", & + "WAVE3ELV2 ","WAVE4ELEV ","WAVE4ELV1 ","WAVE4ELV2 ","WAVE5ELEV ","WAVE5ELV1 ","WAVE5ELV2 ", & + "WAVE6ELEV ","WAVE6ELV1 ","WAVE6ELV2 ","WAVE7ELEV ","WAVE7ELV1 ","WAVE7ELV2 ","WAVE8ELEV ", & + "WAVE8ELV1 ","WAVE8ELV2 ","WAVE9ELEV ","WAVE9ELV1 ","WAVE9ELV2 "/) + INTEGER(IntKi), PARAMETER :: ParamIndxAry(117) = (/ & ! This lists the index into AllOuts(:) of the allowed parameters ValidParamAry(:) + FAcc1xi , FAcc1yi , FAcc1zi , FAcc2xi , FAcc2yi , FAcc2zi , FAcc3xi , & + FAcc3yi , FAcc3zi , FAcc4xi , FAcc4yi , FAcc4zi , FAcc5xi , FAcc5yi , & + FAcc5zi , FAcc6xi , FAcc6yi , FAcc6zi , FAcc7xi , FAcc7yi , FAcc7zi , & + FAcc8xi , FAcc8yi , FAcc8zi , FAcc9xi , FAcc9yi , FAcc9zi , FAccMCF1xi , & + FAccMCF1yi , FAccMCF1zi , FAccMCF2xi , FAccMCF2yi , FAccMCF2zi , FAccMCF3xi , FAccMCF3yi , & + FAccMCF3zi , FAccMCF4xi , FAccMCF4yi , FAccMCF4zi , FAccMCF5xi , FAccMCF5yi , FAccMCF5zi , & + FAccMCF6xi , FAccMCF6yi , FAccMCF6zi , FAccMCF7xi , FAccMCF7yi , FAccMCF7zi , FAccMCF8xi , & + FAccMCF8yi , FAccMCF8zi , FAccMCF9xi , FAccMCF9yi , FAccMCF9zi , FDynP1 , FDynP2 , & + FDynP3 , FDynP4 , FDynP5 , FDynP6 , FDynP7 , FDynP8 , FDynP9 , & + FVel1xi , FVel1yi , FVel1zi , FVel2xi , FVel2yi , FVel2zi , FVel3xi , & + FVel3yi , FVel3zi , FVel4xi , FVel4yi , FVel4zi , FVel5xi , FVel5yi , & + FVel5zi , FVel6xi , FVel6yi , FVel6zi , FVel7xi , FVel7yi , FVel7zi , & + FVel8xi , FVel8yi , FVel8zi , FVel9xi , FVel9yi , FVel9zi , Wave1Elev , & + Wave1Elv1 , Wave1Elv2 , Wave2Elev , Wave2Elv1 , Wave2Elv2 , Wave3Elev , Wave3Elv1 , & + Wave3Elv2 , Wave4Elev , Wave4Elv1 , Wave4Elv2 , Wave5Elev , Wave5Elv1 , Wave5Elv2 , & + Wave6Elev , Wave6Elv1 , Wave6Elv2 , Wave7Elev , Wave7Elv1 , Wave7Elv2 , Wave8Elev , & + Wave8Elv1 , Wave8Elv2 , Wave9Elev , Wave9Elv1 , Wave9Elv2 /) + CHARACTER(ChanLen), PARAMETER :: ParamUnitsAry(117) = (/ character(ChanLen) :: & ! This lists the units corresponding to the allowed parameters + "(m/s^2)","(m/s^2)","(m/s^2)","(m/s^2)","(m/s^2)","(m/s^2)","(m/s^2)", & + "(m/s^2)","(m/s^2)","(m/s^2)","(m/s^2)","(m/s^2)","(m/s^2)","(m/s^2)", & + "(m/s^2)","(m/s^2)","(m/s^2)","(m/s^2)","(m/s^2)","(m/s^2)","(m/s^2)", & + "(m/s^2)","(m/s^2)","(m/s^2)","(m/s^2)","(m/s^2)","(m/s^2)","(m/s^2)", & + "(m/s^2)","(m/s^2)","(m/s^2)","(m/s^2)","(m/s^2)","(m/s^2)","(m/s^2)", & + "(m/s^2)","(m/s^2)","(m/s^2)","(m/s^2)","(m/s^2)","(m/s^2)","(m/s^2)", & + "(m/s^2)","(m/s^2)","(m/s^2)","(m/s^2)","(m/s^2)","(m/s^2)","(m/s^2)", & + "(m/s^2)","(m/s^2)","(m/s^2)","(m/s^2)","(m/s^2)","(Pa) ","(Pa) ", & + "(Pa) ","(Pa) ","(Pa) ","(Pa) ","(Pa) ","(Pa) ","(Pa) ", & + "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & + "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & + "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & + "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m) ", & + "(m) ","(m) ","(m) ","(m) ","(m) ","(m) ","(m) ", & + "(m) ","(m) ","(m) ","(m) ","(m) ","(m) ","(m) ", & + "(m) ","(m) ","(m) ","(m) ","(m) ","(m) ","(m) ", & + "(m) ","(m) ","(m) ","(m) ","(m) "/) + + + ! Initialize values + ErrStat = ErrID_None + ErrMsg = "" + InvalidOutput = .FALSE. + + +! ..... Developer must add checking for invalid inputs here: ..... + + do I=p%NWaveElev+1,9 + InvalidOutput(WaveElevi(I)) = .true. + InvalidOutput(WaveElevi1(I))= .true. + InvalidOutput(WaveElevi2(I))= .true. + end do + + do I=p%NWaveKin+1,9 + InvalidOutput(FVel( :,I)) = .true. + InvalidOutput(FAcc( :,I)) = .true. + InvalidOutput(FDynP( I)) = .true. + InvalidOutput(FAccMCF(:,I)) = .true. + end do + +! ................. 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 SeaState 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) + + Indx = FindValidChannelIndx(OutList(I), ValidParamAry, p%OutParam(I)%SignM) + + 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_Warn, 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 SeaStOut_CloseOutput ( p, ErrStat, ErrMsg ) +! This function cleans up after running the SeaState output module. It closes the output file, +! releases memory, and resets the number of outputs requested to 0. +!---------------------------------------------------------------------------------------------------- + + ! Passed variables + + TYPE(SeaSt_ParameterType), INTENT( INOUT ) :: p ! parameter data for this instance of the SeaState module + INTEGER, INTENT( OUT ) :: ErrStat ! a non-zero value indicates an error occurred + CHARACTER(*), INTENT( OUT ) :: ErrMsg ! Error message if ErrStat /= ErrID_None + + ! Internal variables + INTEGER :: ErrStat2 + + + !------------------------------------------------------------------------------------------------- + ! Initialize error information + !------------------------------------------------------------------------------------------------- + + + ErrStat = ErrID_None + ErrMsg = "" + + + ! Write the summary file header + IF ( p%UnOutFile > -1 ) THEN + ! WRITE (p%UnOutFile,'(/,A/)', IOSTAT=ErrStat) 'This output file was closed on '//CurDate()//' at '//CurTime()//'.' + + !------------------------------------------------------------------------------------------------- + ! Close our output file + !------------------------------------------------------------------------------------------------- + CLOSE( p%UnOutFile, IOSTAT = ErrStat2 ) + IF ( ErrStat2 /= 0 ) then + ErrStat = ErrID_Severe + ErrMsg = ' Error closing SeaState output file.' + END IF + + END IF + + RETURN + +END SUBROUTINE SeaStOut_CloseOutput +!==================================================================================================== + +SUBROUTINE SeaStOut_WrSummaryFile(InitInp, InputFileData, p, ErrStat, ErrMsg ) + TYPE(SeaSt_InitInputType), INTENT(IN ) :: InitInp !< Input data for initialization routine. + TYPE(SeaSt_InputFile) , INTENT(IN ) :: InputFileData !< Data from input file + TYPE(SeaSt_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 + + CHARACTER(1024) :: SummaryName ! name of the SeaState summary file + INTEGER :: I ! Generic counters + REAL(SiKi) :: WaveNmbr ! Wavenumber of the current frequency component (1/meter) + + + INTEGER(IntKi) :: ErrStat2 ! local error status + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local error message + CHARACTER(*), PARAMETER :: RoutineName = 'SeaStOut_WrSummaryFile' + + CHARACTER(64) :: Frmt + INTEGER(IntKi) :: UnSum + + ErrStat = ErrID_None + ErrMsg = "" + + + + IF ( .not. InputFileData%SeaStSum ) RETURN + + + SummaryName = trim(InitInp%OutRootName)//'.sum' + UnSum = -1 + + !$OMP critical(fileopen) + CALL GetNewUnit( UnSum ) + CALL OpenFOutFile ( UnSum, SummaryName, ErrStat2, ErrMsg2 ) + !$OMP end critical(fileopen) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + IF (ErrStat >=AbortErrLev) RETURN + + + ! Write the summary file header + + WRITE (UnSum,'(/,A/)', IOSTAT=ErrStat2) 'This summary file was generated by '//trim(SeaSt_ProgDesc%Name)//' on '//CurDate()//' at '//CurTime()//'.' + + IF (InputFileData%WaveMod /= WaveMod_None .and. InputFileData%WaveMod /= WaveMod_ExtFull) THEN + + WRITE( UnSum, '(1X,A61,F8.2,A4/)' ) 'The Mean Sea Level to Still Water Level (MSL2SWL) Offset is :',p%WaveField%MSL2SWL,' (m)' + WRITE( UnSum, '(1X,A15,F8.2,A8)' ) 'Water Density: ', p%WaveField%WtrDens, '(kg/m^3)' + WRITE( UnSum, '(1X,A15,F8.2,A20,F8.2,A19)' ) 'Water Depth : ', p%WaveField%WtrDpth, '(m) relative to MSL; ', & + p%WaveField%EffWtrDpth, '(m) relative to SWL' + WRITE( UnSum, '(1X,A15,F8.2,A20,F8.2,A19/)' ) 'Grid Z_Depth : ', InputFileData%Z_Depth - p%WaveField%MSL2SWL, '(m) relative to MSL; ', & + InputFileData%Z_Depth, '(m) relative to SWL' + end if + + Frmt = '(1X,ES18.4e2,2x,ES18.4e2,2x,ES18.4e2,2x,ES18.4e2)' + + ! Write Kinematics grid point locations + WRITE( UnSum, '(1X,A31/)' ) 'Wave Kinematics Grid Points (m)' + WRITE( UnSum, '(1X,A78)' ) ' Xi Yi Zi relative to MSL Z relative to SWL' + do i= 1, p%NGridPts + ! NOTE: The Waves%WaveKinxi, yi, zi arrays hold all the grid point locations + WRITE(UnSum,Frmt) InputFileData%Waves%WaveKinGridxi(i), InputFileData%Waves%WaveKinGridyi(i), InputFileData%Waves%WaveKinGridzi(i) + p%WaveField%MSL2SWL, InputFileData%Waves%WaveKinGridzi(i) + end do + + ! ! Write User-requested Wave Kinematics locations + WRITE( UnSum, '(/)' ) + if (p%NWaveKin > 0) then + WRITE( UnSum, '(1X,A51/)' ) 'User-Requested Wave Kinematics Output Locations (m)' + ! WRITE( UnSum, '(/)' ) + WRITE( UnSum, '(2X,A84)' ) 'Index Xi Yi Zi relative to MSL Z relative to SWL' + Frmt = '(1X,I5, 2X,ES18.4e2,2x,ES18.4e2,2x,ES18.4e2,2x,ES18.4e2)' + do i= 1, p%NWaveKin + ! NOTE: The InputFileData%WaveKinxi, yi, zi arrays hold the User-request kinematics output locations + WRITE(UnSum,Frmt) i, p%WaveKinxi(i), p%WaveKinyi(i), p%WaveKinzi(i) + p%WaveField%MSL2SWL, p%WaveKinzi(i) + end do + + else + WRITE( UnSum, '(1X,A50)' ) 'No User-Requested Wave Kinematics Output Channels' + end if + + ! Write User-requested Wave Elevations + WRITE( UnSum, '(/)' ) + if (p%NWaveElev > 0) then + WRITE( UnSum, '(1X,A50/)' ) 'User-Requested Wave Elevation Output Locations (m)' + ! WRITE( UnSum, '(/)' ) + WRITE( UnSum, '(2X,A25)' ) 'Index Xi Yi' + Frmt = '(1X,I5, 2X, ES11.4e2,2x,ES11.4e2)' + do i= 1, p%NWaveElev + WRITE(UnSum,Frmt) i, p%WaveElevxi(i), p%WaveElevyi(i) + end do + + else + WRITE( UnSum, '(1X,A50)' ) 'No User-Requested Wave Elevation Output Channels' + end if + if (p%NumOuts > 0) then + WRITE( UnSum, '(//1X,A/)' ) 'Requested Output Channels' + do i = 1, p%NumOuts + WRITE( UnSum, '(4X,A)' ) p%OutParam(I)%Name + end do + end if + + IF (InputFileData%WaveMod /= WaveMod_ExtFull) THEN + ! Write wave kinematics at (0,0) + WRITE( UnSum, '(/)' ) + WRITE( UnSum, '(1X,A28/)' ) 'Wave Kinematics DFT at (0,0)' + ! WRITE( UnSum, '(/)' ) + WRITE( UnSum, '(1X,A10,2X,A14,2X,A14,2X,A14,2X,A19,2X,A19)' ) & + ' index ', ' k ', ' Omega ', ' Direction ', 'REAL(DFT{WaveElev})','IMAG(DFT{WaveElev})' + WRITE( UnSum, '(1X,A10,2X,A14,2X,A14,2X,A14,2X,A19,2X,A19)' ) & + ' (-) ', ' (1/m) ', ' (rad/s) ', ' (deg) ', ' (m) ',' (m) ' + + ! Write the data + DO I = -1*p%WaveField%NStepWave2+1, p%WaveField%NStepWave2 + WaveNmbr = WaveNumber ( I*p%WaveField%WaveDOmega, InitInp%Gravity, p%WaveField%EffWtrDpth ) + WRITE( UnSum, '(1X,I10,2X,ES14.5,2X,ES14.5,2X,ES14.5,2X,ES14.5,7X,ES14.5)' ) I, WaveNmbr, I*p%WaveField%WaveDOmega, & + p%WaveField%WaveDirArr(ABS(I)), p%WaveField%WaveElevC0( 1,ABS(I ) ) , p%WaveField%WaveElevC0( 2, ABS(I ) )*SIGN(1,I) + END DO + END IF + + + ! Close the summary file + WRITE (UnSum,'(/,A/)', IOSTAT=ErrStat2) 'This summary file was closed on '//CurDate()//' at '//CurTime()//'.' + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Severe,'Problem writing to summary file.',ErrStat,ErrMsg,RoutineName) + END IF + + ! Close the file + + CLOSE( UnSum, IOSTAT=ErrStat2 ) + +END SUBROUTINE SeaStOut_WrSummaryFile + +!==================================================================================================== +END MODULE SeaState_Output diff --git a/modules/seastate/src/SeaState_Types.f90 b/modules/seastate/src/SeaState_Types.f90 new file mode 100644 index 0000000000..bdd95ed4de --- /dev/null +++ b/modules/seastate/src/SeaState_Types.f90 @@ -0,0 +1,1563 @@ +!STARTOFREGISTRYGENERATEDFILE 'SeaState_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 +!********************************************************************************************************************************* +! SeaState_Types +!................................................................................................................................. +! This file is part of SeaState. +! +! 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 SeaState. 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 SeaState_Types +!--------------------------------------------------------------------------------------------------------------------------------- +USE Current_Types +USE Waves_Types +USE Waves2_Types +USE SeaSt_WaveField_Types +USE NWTC_Library +IMPLICIT NONE +! ========= SeaSt_InputFile ======= + TYPE, PUBLIC :: SeaSt_InputFile + LOGICAL :: EchoFlag = .false. !< Echo the input file [-] + REAL(ReKi) :: MSL2SWL = 0.0_ReKi !< Mean Sea Level to Still Water Level offset [m] + REAL(ReKi) :: X_HalfWidth = 0.0_ReKi !< Half-width of the domain in the X direction [m] + REAL(ReKi) :: Y_HalfWidth = 0.0_ReKi !< Half-width of the domain in the Y direction [m] + REAL(ReKi) :: Z_Depth = 0.0_ReKi !< Depth of the domain the Z direction [m] + INTEGER(IntKi) :: NX = 0_IntKi !< Number of nodes in half of the X-direction domain [-] + INTEGER(IntKi) :: NY = 0_IntKi !< Number of nodes in half of the Y-direction domain [-] + INTEGER(IntKi) :: NZ = 0_IntKi !< Number of nodes in half of the Z-direction domain [-] + TYPE(Waves_InitInputType) :: Waves !< Initialization data for Waves module [-] + TYPE(Waves2_InitInputType) :: Waves2 !< Initialization data for Waves2 module [-] + TYPE(Current_InitInputType) :: Current !< Initialization data for Current module [-] + LOGICAL :: Echo = .false. !< Echo the input files to a file with the same name as the input but with a .echo extension [T/F] [-] + INTEGER(IntKi) :: NWaveElev = 0_IntKi !< Number of user-requested points where the incident wave elevations can be output [-] + REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveElevxi !< xi-coordinates for points where the incident wave elevations can be output [(meters)] + REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveElevyi !< yi-coordinates for points where the incident wave elevations can be output [(meters)] + INTEGER(IntKi) :: NWaveKin = 0_IntKi !< Number of points where the incident wave kinematics will be computed [-] + REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveKinxi !< xi-coordinates for points where the incident wave kinematics will be computed; these are relative to the mean sea level [(meters)] + REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveKinyi !< yi-coordinates for points where the incident wave kinematics will be computed; these are relative to the mean sea level [(meters)] + REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveKinzi !< zi-coordinates for points where the incident wave kinematics will be computed; these are relative to the mean sea level [(meters)] + INTEGER(IntKi) :: OutSwtch = 0_IntKi !< Output requested channels to: [1=SeaState.out 2=GlueCode.out 3=both files] [-] + LOGICAL :: OutAll = .false. !< Output all user-specified member and joint loads (only at each member end, not interior locations) [T/F] [-] + INTEGER(IntKi) :: NumOuts = 0_IntKi !< The number of outputs for this module as requested in the input file [-] + CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: OutList !< The user-requested output channel labels for this modules. This should really be dimensioned with MaxOutPts [-] + LOGICAL :: SeaStSum = .false. !< Generate a SeaState summary file [T/F] [-] + CHARACTER(20) :: OutFmt !< Output format for numerical results [-] + CHARACTER(20) :: OutSFmt !< Output format for header strings [-] + INTEGER(IntKi) :: WaveStMod = 0_IntKi !< Model for stretching incident wave kinematics to instantaneous free surface {0: none=no stretching, 1: vertical stretching, 2: extrapolation stretching, 3: Wheeler stretching} [-] + REAL(ReKi) :: WtrDpth = 0.0_ReKi !< Water depth, this is necessary to inform glue-code what the module is using for WtrDpth (may not be the glue-code's default) [(m)] + REAL(ReKi) :: WtrDens = 0.0_ReKi !< Water density, this is necessary to inform glue-code what the module is using for WtrDens (may not be the glue-code's default) [(kg/m^3)] + INTEGER(IntKi) :: WaveDirMod = 0_IntKi !< Directional wave spreading function {0: none, 1: COS2S} [only used if WaveMod=6] [-] + REAL(SiKi) :: WaveDir = 0.0_R4Ki !< Incident wave propagation heading direction [(degrees)] + LOGICAL :: WaveMultiDir = .false. !< Indicates the waves are multidirectional [-] + REAL(SiKi) :: MCFD = 0.0_R4Ki !< Diameter of members that will use the MacCamy-Fuchs diffraction model [-] + REAL(SiKi) :: WvLowCOff = 0.0_R4Ki !< Low cut-off frequency or lower frequency limit of the wave spectrum beyond which the wave spectrum is zeroed. [used only when WaveMod=2,3,4] [(rad/s)] + REAL(SiKi) :: WvHiCOff = 0.0_R4Ki !< High cut-off frequency or upper frequency limit of the wave spectrum beyond which the wave spectrum is zeroed. [used only when WaveMod=2,3,4] [(rad/s)] + REAL(SiKi) :: WvLowCOffD = 0.0_R4Ki !< Minimum frequency used in the difference methods [Ignored if all difference methods = 0] [(rad/s)] + REAL(SiKi) :: WvHiCOffD = 0.0_R4Ki !< Maximum frequency used in the difference methods [Ignored if all difference methods = 0] [(rad/s)] + REAL(SiKi) :: WvLowCOffS = 0.0_R4Ki !< Minimum frequency used in the sum-QTF method [Ignored if SumQTF = 0] [(rad/s)] + REAL(SiKi) :: WvHiCOffS = 0.0_R4Ki !< Maximum frequency used in the sum-QTF method [Ignored if SumQTF = 0] [(rad/s)] + REAL(SiKi) :: WaveDOmega = 0.0_R4Ki !< Frequency step for incident wave calculations [(rad/s)] + INTEGER(IntKi) :: WaveMod = 0_IntKi !< Incident wave kinematics model: See valid values in SeaSt_WaveField module parameters. [-] + END TYPE SeaSt_InputFile +! ======================= +! ========= SeaSt_InitInputType ======= + TYPE, PUBLIC :: SeaSt_InitInputType + CHARACTER(1024) :: InputFile !< Supplied by Driver: full path and filename for the SeaState module [-] + LOGICAL :: UseInputFile = .TRUE. !< Supplied by Driver: .TRUE. if using a input file, .FALSE. if all inputs are being passed in by the caller [-] + TYPE(FileInfoType) :: PassedFileData !< If we don't use the input file, pass everything through this [-] + CHARACTER(1024) :: OutRootName !< Supplied by Driver: The name of the root file (without extension) including the full path [-] + REAL(ReKi) :: Gravity = 0.0_ReKi !< Supplied by Driver: Gravitational acceleration [(m/s^2)] + REAL(ReKi) :: defWtrDens = 0.0_ReKi !< Default water density from the driver; may be overwritten [(kg/m^3)] + REAL(ReKi) :: defWtrDpth = 0.0_ReKi !< Default water depth from the driver; may be overwritten [m] + REAL(ReKi) :: defMSL2SWL = 0.0_ReKi !< Default mean sea level to still water level from the driver; may be overwritten [m] + REAL(DbKi) :: TMax = 0.0_R8Ki !< Supplied by Driver: The total simulation time [(sec)] + INTEGER(IntKi) :: WaveFieldMod = 0_IntKi !< Wave field handling (-) (switch) 0: use individual SeaState inputs without adjustment, 1: adjust wave phases based on turbine offsets from farm origin [-] + REAL(ReKi) :: PtfmLocationX = 0.0_ReKi !< Supplied by Driver: X coordinate of platform location in the wave field [m] + REAL(ReKi) :: PtfmLocationY = 0.0_ReKi !< Supplied by Driver: Y coordinate of platform location in the wave field [m] + INTEGER(IntKi) :: WrWvKinMod = 0 !< 0,1, or 2 indicating whether we are going to write out kinematics files. [ignored if WaveMod = 6, if 1 or 2 then files are written using the outrootname] [-] + LOGICAL :: HasIce = .false. !< Supplied by Driver: Whether this simulation has ice loading (flag) [-] + LOGICAL :: Linearize = .FALSE. !< Flag that tells this module if the glue code wants to linearize. [-] + LOGICAL :: SurfaceVis = .FALSE. !< Turn on grid surface visualization outputs [-] + INTEGER(IntKi) :: SurfaceVisNx = 0 !< Number of points in X direction to output for visualization grid. Use 0 or negative to set to SeaState resolution. [-] + INTEGER(IntKi) :: SurfaceVisNy = 0 !< Number of points in Y direction to output for visualization grid. Use 0 or negative to set to SeaState resolution. [-] + END TYPE SeaSt_InitInputType +! ======================= +! ========= SeaSt_InitOutputType ======= + TYPE, PUBLIC :: SeaSt_InitOutputType + CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputHdr !< The is the list of all HD-related output channel header strings (includes all sub-module channels) [-] + CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputUnt !< The is the list of all HD-related output channel unit strings (includes all sub-module channels) [-] + TYPE(ProgDesc) :: Ver !< Version of SeaState [-] + LOGICAL :: InvalidWithSSExctn = .false. !< Whether SeaState configuration is invalid with HydroDyn's state-space excitation (ExctnMod=2) [(-)] + REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveElevVisX !< X locations of grid output [m,-] + REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveElevVisY !< Y locations of grid output [m,-] + REAL(SiKi) , DIMENSION(:,:,:), ALLOCATABLE :: WaveElevVisGrid !< Wave elevation time-series at each of the points given by WaveElevXY. First dimension is the timestep. Second/third dimensions are the grid of points. [(m)] + TYPE(SeaSt_WaveFieldType) , POINTER :: WaveField => NULL() !< Pointer to wave field [-] + 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_u !< Flag that tells FAST/MBC3 if the inputs used in linearization are in the rotating frame [-] + LOGICAL , DIMENSION(:), ALLOCATABLE :: RotFrame_y !< Flag that tells FAST/MBC3 if the outputs 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 SeaSt_InitOutputType +! ======================= +! ========= SeaSt_ContinuousStateType ======= + TYPE, PUBLIC :: SeaSt_ContinuousStateType + REAL(R8Ki) :: UnusedStates = 0.0_R8Ki !< placeholder for states [-] + END TYPE SeaSt_ContinuousStateType +! ======================= +! ========= SeaSt_DiscreteStateType ======= + TYPE, PUBLIC :: SeaSt_DiscreteStateType + REAL(R8Ki) :: UnusedStates = 0.0_R8Ki !< placeholder for states [-] + END TYPE SeaSt_DiscreteStateType +! ======================= +! ========= SeaSt_ConstraintStateType ======= + TYPE, PUBLIC :: SeaSt_ConstraintStateType + REAL(R8Ki) :: UnusedStates = 0.0_R8Ki !< placeholder for states [-] + END TYPE SeaSt_ConstraintStateType +! ======================= +! ========= SeaSt_OtherStateType ======= + TYPE, PUBLIC :: SeaSt_OtherStateType + REAL(R8Ki) :: UnusedStates = 0.0_R8Ki !< placeholder for states [-] + END TYPE SeaSt_OtherStateType +! ======================= +! ========= SeaSt_MiscVarType ======= + TYPE, PUBLIC :: SeaSt_MiscVarType + INTEGER(IntKi) :: Decimate = 0_IntKi !< The output decimation counter [-] + REAL(DbKi) :: LastOutTime = 0.0_R8Ki !< Last time step which was written to the output file (sec) [-] + INTEGER(IntKi) :: LastIndWave = 0_IntKi !< The last index used in the wave kinematics arrays, used to optimize interpolation [-] + TYPE(SeaSt_WaveField_MiscVarType) :: WaveField_m !< misc var information from the SeaState Interpolation module [-] + END TYPE SeaSt_MiscVarType +! ======================= +! ========= Jac_u_idxStarts ======= + TYPE, PUBLIC :: Jac_u_idxStarts + INTEGER(IntKi) :: Extended = 1 !< Index to first point in u jacobian for Extended [-] + END TYPE Jac_u_idxStarts +! ======================= +! ========= Jac_y_idxStarts ======= + TYPE, PUBLIC :: Jac_y_idxStarts + INTEGER(IntKi) :: Extended = 1 !< Index to first point in y jacobian for Extended [-] + INTEGER(IntKi) :: WrOuts = 2 !< Index to first point in y jacobian for WrOuts [-] + END TYPE Jac_y_idxStarts +! ======================= +! ========= SeaSt_LinParams ======= + TYPE, PUBLIC :: SeaSt_LinParams + INTEGER(IntKi) :: NumExtendedInputs = 1 !< number of extended inputs [-] + INTEGER(IntKi) :: NumExtendedOutputs = 1 !< number of extended outputs [-] + TYPE(Jac_u_idxStarts) :: Jac_u_idxStartList !< Starting indices for all Jac_u components [-] + TYPE(Jac_y_idxStarts) :: Jac_y_idxStartList !< Starting indices for all Jac_y components [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: du !< vector that determines size of perturbation for u (inputs) [-] + INTEGER(IntKi) :: Jac_nu = 0_IntKi !< number of inputs in jacobian matrix [-] + INTEGER(IntKi) :: Jac_ny = 0_IntKi !< number of outputs in jacobian matrix [-] + END TYPE SeaSt_LinParams +! ======================= +! ========= SeaSt_ParameterType ======= + TYPE, PUBLIC :: SeaSt_ParameterType + REAL(DbKi) :: WaveDT = 0.0_R8Ki !< Wave DT [sec] + INTEGER(IntKi) :: NGridPts = 0_IntKi !< Number of data points in the wave kinematics grid [-] + INTEGER(IntKi) , DIMENSION(1:3) :: NGrid = 0_IntKi !< Number of grid entries in x, y, and z [-] + REAL(ReKi) , DIMENSION(1:3) :: deltaGrid = 0.0_ReKi !< delta between grid points in x, y, and theta (for z) [m,m,rad] + INTEGER(IntKi) :: NWaveElev = 0_IntKi !< Number of wave elevation outputs [-] + REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveElevxi !< xi-coordinates for points where the incident wave elevations can be output [(meters)] + REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveElevyi !< yi-coordinates for points where the incident wave elevations can be output [(meters)] + INTEGER(IntKi) :: NWaveKin = 0_IntKi !< Number of points where the incident wave kinematics can be output [-] + REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveKinxi !< xi-coordinates for points where the incident wave kinematics can be output; these are relative to the mean sea level [(meters)] + REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveKinyi !< yi-coordinates for points where the incident wave kinematics can be output; these are relative to the mean sea level [(meters)] + REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveKinzi !< zi-coordinates for points where the incident wave kinematics can be output; these are relative to the mean sea level [(meters)] + TYPE(OutParmType) , DIMENSION(:), ALLOCATABLE :: OutParam !< [-] + INTEGER(IntKi) :: NumOuts = 0_IntKi !< Number of SeaState module-level outputs (not the total number including sub-modules [-] + INTEGER(IntKi) :: OutSwtch = 0_IntKi !< Output requested channels to: [1=SeaState.out 2=GlueCode.out 3=both files] [-] + CHARACTER(20) :: OutFmt !< Output format for numerical results [-] + CHARACTER(20) :: OutSFmt !< Output format for header strings [-] + CHARACTER(1) :: Delim !< Delimiter string for outputs, defaults to space [-] + INTEGER(IntKi) :: UnOutFile = 0_IntKi !< File unit for the SeaState outputs [-] + INTEGER(IntKi) :: OutDec = 0_IntKi !< Write every OutDec time steps [-] + TYPE(SeaSt_WaveFieldType) , POINTER :: WaveField => NULL() !< Wave field [-] + TYPE(SeaSt_LinParams) :: LinParams !< Linearization parameters [-] + END TYPE SeaSt_ParameterType +! ======================= +! ========= SeaSt_InputType ======= + TYPE, PUBLIC :: SeaSt_InputType + REAL(SiKi) :: DummyInput = 0.0_R4Ki !< Remove this variable if you have inputs [-] + END TYPE SeaSt_InputType +! ======================= +! ========= SeaSt_OutputType ======= + TYPE, PUBLIC :: SeaSt_OutputType + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: WriteOutput !< Outputs to be written to the output file(s) [-] + END TYPE SeaSt_OutputType +! ======================= +CONTAINS + +subroutine SeaSt_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg) + type(SeaSt_InputFile), intent(in) :: SrcInputFileData + type(SeaSt_InputFile), intent(inout) :: DstInputFileData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SeaSt_CopyInputFile' + ErrStat = ErrID_None + ErrMsg = '' + DstInputFileData%EchoFlag = SrcInputFileData%EchoFlag + DstInputFileData%MSL2SWL = SrcInputFileData%MSL2SWL + DstInputFileData%X_HalfWidth = SrcInputFileData%X_HalfWidth + DstInputFileData%Y_HalfWidth = SrcInputFileData%Y_HalfWidth + DstInputFileData%Z_Depth = SrcInputFileData%Z_Depth + DstInputFileData%NX = SrcInputFileData%NX + DstInputFileData%NY = SrcInputFileData%NY + DstInputFileData%NZ = SrcInputFileData%NZ + call Waves_CopyInitInput(SrcInputFileData%Waves, DstInputFileData%Waves, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call Waves2_CopyInitInput(SrcInputFileData%Waves2, DstInputFileData%Waves2, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call Current_CopyInitInput(SrcInputFileData%Current, DstInputFileData%Current, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstInputFileData%Echo = SrcInputFileData%Echo + DstInputFileData%NWaveElev = SrcInputFileData%NWaveElev + if (allocated(SrcInputFileData%WaveElevxi)) then + LB(1:1) = lbound(SrcInputFileData%WaveElevxi) + UB(1:1) = ubound(SrcInputFileData%WaveElevxi) + if (.not. allocated(DstInputFileData%WaveElevxi)) then + allocate(DstInputFileData%WaveElevxi(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%WaveElevxi.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%WaveElevxi = SrcInputFileData%WaveElevxi + end if + if (allocated(SrcInputFileData%WaveElevyi)) then + LB(1:1) = lbound(SrcInputFileData%WaveElevyi) + UB(1:1) = ubound(SrcInputFileData%WaveElevyi) + if (.not. allocated(DstInputFileData%WaveElevyi)) then + allocate(DstInputFileData%WaveElevyi(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%WaveElevyi.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%WaveElevyi = SrcInputFileData%WaveElevyi + end if + DstInputFileData%NWaveKin = SrcInputFileData%NWaveKin + if (allocated(SrcInputFileData%WaveKinxi)) then + LB(1:1) = lbound(SrcInputFileData%WaveKinxi) + UB(1:1) = ubound(SrcInputFileData%WaveKinxi) + if (.not. allocated(DstInputFileData%WaveKinxi)) then + allocate(DstInputFileData%WaveKinxi(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%WaveKinxi.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%WaveKinxi = SrcInputFileData%WaveKinxi + end if + if (allocated(SrcInputFileData%WaveKinyi)) then + LB(1:1) = lbound(SrcInputFileData%WaveKinyi) + UB(1:1) = ubound(SrcInputFileData%WaveKinyi) + if (.not. allocated(DstInputFileData%WaveKinyi)) then + allocate(DstInputFileData%WaveKinyi(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%WaveKinyi.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%WaveKinyi = SrcInputFileData%WaveKinyi + end if + if (allocated(SrcInputFileData%WaveKinzi)) then + LB(1:1) = lbound(SrcInputFileData%WaveKinzi) + UB(1:1) = ubound(SrcInputFileData%WaveKinzi) + if (.not. allocated(DstInputFileData%WaveKinzi)) then + allocate(DstInputFileData%WaveKinzi(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%WaveKinzi.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%WaveKinzi = SrcInputFileData%WaveKinzi + end if + DstInputFileData%OutSwtch = SrcInputFileData%OutSwtch + DstInputFileData%OutAll = SrcInputFileData%OutAll + DstInputFileData%NumOuts = SrcInputFileData%NumOuts + if (allocated(SrcInputFileData%OutList)) then + LB(1:1) = lbound(SrcInputFileData%OutList) + UB(1:1) = ubound(SrcInputFileData%OutList) + if (.not. allocated(DstInputFileData%OutList)) then + allocate(DstInputFileData%OutList(LB(1):UB(1)), 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 + end if + DstInputFileData%SeaStSum = SrcInputFileData%SeaStSum + DstInputFileData%OutFmt = SrcInputFileData%OutFmt + DstInputFileData%OutSFmt = SrcInputFileData%OutSFmt + DstInputFileData%WaveStMod = SrcInputFileData%WaveStMod + DstInputFileData%WtrDpth = SrcInputFileData%WtrDpth + DstInputFileData%WtrDens = SrcInputFileData%WtrDens + DstInputFileData%WaveDirMod = SrcInputFileData%WaveDirMod + DstInputFileData%WaveDir = SrcInputFileData%WaveDir + DstInputFileData%WaveMultiDir = SrcInputFileData%WaveMultiDir + DstInputFileData%MCFD = SrcInputFileData%MCFD + DstInputFileData%WvLowCOff = SrcInputFileData%WvLowCOff + DstInputFileData%WvHiCOff = SrcInputFileData%WvHiCOff + DstInputFileData%WvLowCOffD = SrcInputFileData%WvLowCOffD + DstInputFileData%WvHiCOffD = SrcInputFileData%WvHiCOffD + DstInputFileData%WvLowCOffS = SrcInputFileData%WvLowCOffS + DstInputFileData%WvHiCOffS = SrcInputFileData%WvHiCOffS + DstInputFileData%WaveDOmega = SrcInputFileData%WaveDOmega + DstInputFileData%WaveMod = SrcInputFileData%WaveMod +end subroutine + +subroutine SeaSt_DestroyInputFile(InputFileData, ErrStat, ErrMsg) + type(SeaSt_InputFile), intent(inout) :: InputFileData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SeaSt_DestroyInputFile' + ErrStat = ErrID_None + ErrMsg = '' + call Waves_DestroyInitInput(InputFileData%Waves, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call Waves2_DestroyInitInput(InputFileData%Waves2, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call Current_DestroyInitInput(InputFileData%Current, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(InputFileData%WaveElevxi)) then + deallocate(InputFileData%WaveElevxi) + end if + if (allocated(InputFileData%WaveElevyi)) then + deallocate(InputFileData%WaveElevyi) + end if + if (allocated(InputFileData%WaveKinxi)) then + deallocate(InputFileData%WaveKinxi) + end if + if (allocated(InputFileData%WaveKinyi)) then + deallocate(InputFileData%WaveKinyi) + end if + if (allocated(InputFileData%WaveKinzi)) then + deallocate(InputFileData%WaveKinzi) + end if + if (allocated(InputFileData%OutList)) then + deallocate(InputFileData%OutList) + end if +end subroutine + +subroutine SeaSt_PackInputFile(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SeaSt_InputFile), intent(in) :: InData + character(*), parameter :: RoutineName = 'SeaSt_PackInputFile' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%EchoFlag) + call RegPack(RF, InData%MSL2SWL) + call RegPack(RF, InData%X_HalfWidth) + call RegPack(RF, InData%Y_HalfWidth) + call RegPack(RF, InData%Z_Depth) + call RegPack(RF, InData%NX) + call RegPack(RF, InData%NY) + call RegPack(RF, InData%NZ) + call Waves_PackInitInput(RF, InData%Waves) + call Waves2_PackInitInput(RF, InData%Waves2) + call Current_PackInitInput(RF, InData%Current) + call RegPack(RF, InData%Echo) + call RegPack(RF, InData%NWaveElev) + call RegPackAlloc(RF, InData%WaveElevxi) + call RegPackAlloc(RF, InData%WaveElevyi) + call RegPack(RF, InData%NWaveKin) + call RegPackAlloc(RF, InData%WaveKinxi) + call RegPackAlloc(RF, InData%WaveKinyi) + call RegPackAlloc(RF, InData%WaveKinzi) + call RegPack(RF, InData%OutSwtch) + call RegPack(RF, InData%OutAll) + call RegPack(RF, InData%NumOuts) + call RegPackAlloc(RF, InData%OutList) + call RegPack(RF, InData%SeaStSum) + call RegPack(RF, InData%OutFmt) + call RegPack(RF, InData%OutSFmt) + call RegPack(RF, InData%WaveStMod) + call RegPack(RF, InData%WtrDpth) + call RegPack(RF, InData%WtrDens) + call RegPack(RF, InData%WaveDirMod) + call RegPack(RF, InData%WaveDir) + call RegPack(RF, InData%WaveMultiDir) + call RegPack(RF, InData%MCFD) + call RegPack(RF, InData%WvLowCOff) + call RegPack(RF, InData%WvHiCOff) + call RegPack(RF, InData%WvLowCOffD) + call RegPack(RF, InData%WvHiCOffD) + call RegPack(RF, InData%WvLowCOffS) + call RegPack(RF, InData%WvHiCOffS) + call RegPack(RF, InData%WaveDOmega) + call RegPack(RF, InData%WaveMod) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SeaSt_UnPackInputFile(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SeaSt_InputFile), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SeaSt_UnPackInputFile' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%EchoFlag); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MSL2SWL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%X_HalfWidth); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Y_HalfWidth); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Z_Depth); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NX); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NY); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NZ); if (RegCheckErr(RF, RoutineName)) return + call Waves_UnpackInitInput(RF, OutData%Waves) ! Waves + call Waves2_UnpackInitInput(RF, OutData%Waves2) ! Waves2 + call Current_UnpackInitInput(RF, OutData%Current) ! Current + call RegUnpack(RF, OutData%Echo); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NWaveElev); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WaveElevxi); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WaveElevyi); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NWaveKin); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WaveKinxi); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WaveKinyi); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WaveKinzi); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutSwtch); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutAll); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumOuts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%OutList); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SeaStSum); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutFmt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutSFmt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WaveStMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WtrDpth); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WtrDens); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WaveDirMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WaveDir); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WaveMultiDir); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MCFD); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WvLowCOff); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WvHiCOff); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WvLowCOffD); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WvHiCOffD); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WvLowCOffS); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WvHiCOffS); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WaveDOmega); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WaveMod); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SeaSt_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) + type(SeaSt_InitInputType), intent(in) :: SrcInitInputData + type(SeaSt_InitInputType), intent(inout) :: DstInitInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SeaSt_CopyInitInput' + ErrStat = ErrID_None + ErrMsg = '' + DstInitInputData%InputFile = SrcInitInputData%InputFile + DstInitInputData%UseInputFile = SrcInitInputData%UseInputFile + call NWTC_Library_CopyFileInfoType(SrcInitInputData%PassedFileData, DstInitInputData%PassedFileData, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstInitInputData%OutRootName = SrcInitInputData%OutRootName + DstInitInputData%Gravity = SrcInitInputData%Gravity + DstInitInputData%defWtrDens = SrcInitInputData%defWtrDens + DstInitInputData%defWtrDpth = SrcInitInputData%defWtrDpth + DstInitInputData%defMSL2SWL = SrcInitInputData%defMSL2SWL + DstInitInputData%TMax = SrcInitInputData%TMax + DstInitInputData%WaveFieldMod = SrcInitInputData%WaveFieldMod + DstInitInputData%PtfmLocationX = SrcInitInputData%PtfmLocationX + DstInitInputData%PtfmLocationY = SrcInitInputData%PtfmLocationY + DstInitInputData%WrWvKinMod = SrcInitInputData%WrWvKinMod + DstInitInputData%HasIce = SrcInitInputData%HasIce + DstInitInputData%Linearize = SrcInitInputData%Linearize + DstInitInputData%SurfaceVis = SrcInitInputData%SurfaceVis + DstInitInputData%SurfaceVisNx = SrcInitInputData%SurfaceVisNx + DstInitInputData%SurfaceVisNy = SrcInitInputData%SurfaceVisNy +end subroutine + +subroutine SeaSt_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(SeaSt_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SeaSt_DestroyInitInput' + ErrStat = ErrID_None + ErrMsg = '' + call NWTC_Library_DestroyFileInfoType(InitInputData%PassedFileData, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine SeaSt_PackInitInput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SeaSt_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SeaSt_PackInitInput' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%InputFile) + call RegPack(RF, InData%UseInputFile) + call NWTC_Library_PackFileInfoType(RF, InData%PassedFileData) + call RegPack(RF, InData%OutRootName) + call RegPack(RF, InData%Gravity) + call RegPack(RF, InData%defWtrDens) + call RegPack(RF, InData%defWtrDpth) + call RegPack(RF, InData%defMSL2SWL) + call RegPack(RF, InData%TMax) + call RegPack(RF, InData%WaveFieldMod) + call RegPack(RF, InData%PtfmLocationX) + call RegPack(RF, InData%PtfmLocationY) + call RegPack(RF, InData%WrWvKinMod) + call RegPack(RF, InData%HasIce) + call RegPack(RF, InData%Linearize) + call RegPack(RF, InData%SurfaceVis) + call RegPack(RF, InData%SurfaceVisNx) + call RegPack(RF, InData%SurfaceVisNy) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SeaSt_UnPackInitInput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SeaSt_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SeaSt_UnPackInitInput' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%InputFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UseInputFile); if (RegCheckErr(RF, RoutineName)) return + call NWTC_Library_UnpackFileInfoType(RF, OutData%PassedFileData) ! PassedFileData + call RegUnpack(RF, OutData%OutRootName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Gravity); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%defWtrDens); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%defWtrDpth); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%defMSL2SWL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TMax); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WaveFieldMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PtfmLocationX); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PtfmLocationY); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WrWvKinMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HasIce); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Linearize); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SurfaceVis); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SurfaceVisNx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SurfaceVisNy); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SeaSt_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) + type(SeaSt_InitOutputType), intent(in) :: SrcInitOutputData + type(SeaSt_InitOutputType), intent(inout) :: DstInitOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SeaSt_CopyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcInitOutputData%WriteOutputHdr)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) + if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then + allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitOutputData%WriteOutputUnt)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) + if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then + allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), 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 + end if + call NWTC_Library_CopyProgDesc(SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstInitOutputData%InvalidWithSSExctn = SrcInitOutputData%InvalidWithSSExctn + if (allocated(SrcInitOutputData%WaveElevVisX)) then + LB(1:1) = lbound(SrcInitOutputData%WaveElevVisX) + UB(1:1) = ubound(SrcInitOutputData%WaveElevVisX) + if (.not. allocated(DstInitOutputData%WaveElevVisX)) then + allocate(DstInitOutputData%WaveElevVisX(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveElevVisX.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%WaveElevVisX = SrcInitOutputData%WaveElevVisX + end if + if (allocated(SrcInitOutputData%WaveElevVisY)) then + LB(1:1) = lbound(SrcInitOutputData%WaveElevVisY) + UB(1:1) = ubound(SrcInitOutputData%WaveElevVisY) + if (.not. allocated(DstInitOutputData%WaveElevVisY)) then + allocate(DstInitOutputData%WaveElevVisY(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveElevVisY.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%WaveElevVisY = SrcInitOutputData%WaveElevVisY + end if + if (allocated(SrcInitOutputData%WaveElevVisGrid)) then + LB(1:3) = lbound(SrcInitOutputData%WaveElevVisGrid) + UB(1:3) = ubound(SrcInitOutputData%WaveElevVisGrid) + if (.not. allocated(DstInitOutputData%WaveElevVisGrid)) then + allocate(DstInitOutputData%WaveElevVisGrid(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveElevVisGrid.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%WaveElevVisGrid = SrcInitOutputData%WaveElevVisGrid + end if + DstInitOutputData%WaveField => SrcInitOutputData%WaveField + if (allocated(SrcInitOutputData%LinNames_y)) then + LB(1:1) = lbound(SrcInitOutputData%LinNames_y) + UB(1:1) = ubound(SrcInitOutputData%LinNames_y) + if (.not. allocated(DstInitOutputData%LinNames_y)) then + allocate(DstInitOutputData%LinNames_y(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitOutputData%LinNames_u)) then + LB(1:1) = lbound(SrcInitOutputData%LinNames_u) + UB(1:1) = ubound(SrcInitOutputData%LinNames_u) + if (.not. allocated(DstInitOutputData%LinNames_u)) then + allocate(DstInitOutputData%LinNames_u(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitOutputData%RotFrame_u)) then + LB(1:1) = lbound(SrcInitOutputData%RotFrame_u) + UB(1:1) = ubound(SrcInitOutputData%RotFrame_u) + if (.not. allocated(DstInitOutputData%RotFrame_u)) then + allocate(DstInitOutputData%RotFrame_u(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitOutputData%RotFrame_y)) then + LB(1:1) = lbound(SrcInitOutputData%RotFrame_y) + UB(1:1) = ubound(SrcInitOutputData%RotFrame_y) + if (.not. allocated(DstInitOutputData%RotFrame_y)) then + allocate(DstInitOutputData%RotFrame_y(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitOutputData%IsLoad_u)) then + LB(1:1) = lbound(SrcInitOutputData%IsLoad_u) + UB(1:1) = ubound(SrcInitOutputData%IsLoad_u) + if (.not. allocated(DstInitOutputData%IsLoad_u)) then + allocate(DstInitOutputData%IsLoad_u(LB(1):UB(1)), 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 + end if +end subroutine + +subroutine SeaSt_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(SeaSt_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SeaSt_DestroyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InitOutputData%WriteOutputHdr)) then + deallocate(InitOutputData%WriteOutputHdr) + end if + if (allocated(InitOutputData%WriteOutputUnt)) then + deallocate(InitOutputData%WriteOutputUnt) + end if + call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(InitOutputData%WaveElevVisX)) then + deallocate(InitOutputData%WaveElevVisX) + end if + if (allocated(InitOutputData%WaveElevVisY)) then + deallocate(InitOutputData%WaveElevVisY) + end if + if (allocated(InitOutputData%WaveElevVisGrid)) then + deallocate(InitOutputData%WaveElevVisGrid) + end if + nullify(InitOutputData%WaveField) + if (allocated(InitOutputData%LinNames_y)) then + deallocate(InitOutputData%LinNames_y) + end if + if (allocated(InitOutputData%LinNames_u)) then + deallocate(InitOutputData%LinNames_u) + end if + if (allocated(InitOutputData%RotFrame_u)) then + deallocate(InitOutputData%RotFrame_u) + end if + if (allocated(InitOutputData%RotFrame_y)) then + deallocate(InitOutputData%RotFrame_y) + end if + if (allocated(InitOutputData%IsLoad_u)) then + deallocate(InitOutputData%IsLoad_u) + end if +end subroutine + +subroutine SeaSt_PackInitOutput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SeaSt_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SeaSt_PackInitOutput' + logical :: PtrInIndex + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%WriteOutputHdr) + call RegPackAlloc(RF, InData%WriteOutputUnt) + call NWTC_Library_PackProgDesc(RF, InData%Ver) + call RegPack(RF, InData%InvalidWithSSExctn) + call RegPackAlloc(RF, InData%WaveElevVisX) + call RegPackAlloc(RF, InData%WaveElevVisY) + call RegPackAlloc(RF, InData%WaveElevVisGrid) + call RegPack(RF, associated(InData%WaveField)) + if (associated(InData%WaveField)) then + call RegPackPointer(RF, c_loc(InData%WaveField), PtrInIndex) + if (.not. PtrInIndex) then + call SeaSt_WaveField_PackSeaSt_WaveFieldType(RF, InData%WaveField) + end if + end if + call RegPackAlloc(RF, InData%LinNames_y) + call RegPackAlloc(RF, InData%LinNames_u) + call RegPackAlloc(RF, InData%RotFrame_u) + call RegPackAlloc(RF, InData%RotFrame_y) + call RegPackAlloc(RF, InData%IsLoad_u) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SeaSt_UnPackInitOutput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SeaSt_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SeaSt_UnPackInitOutput' + integer(B4Ki) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(B8Ki) :: PtrIdx + type(c_ptr) :: Ptr + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%WriteOutputHdr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WriteOutputUnt); if (RegCheckErr(RF, RoutineName)) return + call NWTC_Library_UnpackProgDesc(RF, OutData%Ver) ! Ver + call RegUnpack(RF, OutData%InvalidWithSSExctn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WaveElevVisX); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WaveElevVisY); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WaveElevVisGrid); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%WaveField)) deallocate(OutData%WaveField) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackPointer(RF, Ptr, PtrIdx); if (RegCheckErr(RF, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveField) + else + allocate(OutData%WaveField,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveField.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + RF%Pointers(PtrIdx) = c_loc(OutData%WaveField) + call SeaSt_WaveField_UnpackSeaSt_WaveFieldType(RF, OutData%WaveField) ! WaveField + end if + else + OutData%WaveField => null() + end if + call RegUnpackAlloc(RF, OutData%LinNames_y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LinNames_u); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%RotFrame_u); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%RotFrame_y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%IsLoad_u); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SeaSt_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) + type(SeaSt_ContinuousStateType), intent(in) :: SrcContStateData + type(SeaSt_ContinuousStateType), intent(inout) :: DstContStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SeaSt_CopyContState' + ErrStat = ErrID_None + ErrMsg = '' + DstContStateData%UnusedStates = SrcContStateData%UnusedStates +end subroutine + +subroutine SeaSt_DestroyContState(ContStateData, ErrStat, ErrMsg) + type(SeaSt_ContinuousStateType), intent(inout) :: ContStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SeaSt_DestroyContState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine SeaSt_PackContState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SeaSt_ContinuousStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SeaSt_PackContState' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%UnusedStates) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SeaSt_UnPackContState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SeaSt_ContinuousStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SeaSt_UnPackContState' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%UnusedStates); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SeaSt_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) + type(SeaSt_DiscreteStateType), intent(in) :: SrcDiscStateData + type(SeaSt_DiscreteStateType), intent(inout) :: DstDiscStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SeaSt_CopyDiscState' + ErrStat = ErrID_None + ErrMsg = '' + DstDiscStateData%UnusedStates = SrcDiscStateData%UnusedStates +end subroutine + +subroutine SeaSt_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) + type(SeaSt_DiscreteStateType), intent(inout) :: DiscStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SeaSt_DestroyDiscState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine SeaSt_PackDiscState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SeaSt_DiscreteStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SeaSt_PackDiscState' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%UnusedStates) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SeaSt_UnPackDiscState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SeaSt_DiscreteStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SeaSt_UnPackDiscState' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%UnusedStates); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SeaSt_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) + type(SeaSt_ConstraintStateType), intent(in) :: SrcConstrStateData + type(SeaSt_ConstraintStateType), intent(inout) :: DstConstrStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SeaSt_CopyConstrState' + ErrStat = ErrID_None + ErrMsg = '' + DstConstrStateData%UnusedStates = SrcConstrStateData%UnusedStates +end subroutine + +subroutine SeaSt_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) + type(SeaSt_ConstraintStateType), intent(inout) :: ConstrStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SeaSt_DestroyConstrState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine SeaSt_PackConstrState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SeaSt_ConstraintStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SeaSt_PackConstrState' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%UnusedStates) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SeaSt_UnPackConstrState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SeaSt_ConstraintStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SeaSt_UnPackConstrState' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%UnusedStates); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SeaSt_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) + type(SeaSt_OtherStateType), intent(in) :: SrcOtherStateData + type(SeaSt_OtherStateType), intent(inout) :: DstOtherStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SeaSt_CopyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + DstOtherStateData%UnusedStates = SrcOtherStateData%UnusedStates +end subroutine + +subroutine SeaSt_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) + type(SeaSt_OtherStateType), intent(inout) :: OtherStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SeaSt_DestroyOtherState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine SeaSt_PackOtherState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SeaSt_OtherStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SeaSt_PackOtherState' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%UnusedStates) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SeaSt_UnPackOtherState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SeaSt_OtherStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SeaSt_UnPackOtherState' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%UnusedStates); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SeaSt_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(SeaSt_MiscVarType), intent(in) :: SrcMiscData + type(SeaSt_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SeaSt_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + DstMiscData%Decimate = SrcMiscData%Decimate + DstMiscData%LastOutTime = SrcMiscData%LastOutTime + DstMiscData%LastIndWave = SrcMiscData%LastIndWave + call SeaSt_WaveField_CopyMisc(SrcMiscData%WaveField_m, DstMiscData%WaveField_m, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine SeaSt_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(SeaSt_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SeaSt_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' + call SeaSt_WaveField_DestroyMisc(MiscData%WaveField_m, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine SeaSt_PackMisc(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SeaSt_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SeaSt_PackMisc' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%Decimate) + call RegPack(RF, InData%LastOutTime) + call RegPack(RF, InData%LastIndWave) + call SeaSt_WaveField_PackMisc(RF, InData%WaveField_m) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SeaSt_UnPackMisc(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SeaSt_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SeaSt_UnPackMisc' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%Decimate); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LastOutTime); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LastIndWave); if (RegCheckErr(RF, RoutineName)) return + call SeaSt_WaveField_UnpackMisc(RF, OutData%WaveField_m) ! WaveField_m +end subroutine + +subroutine SeaSt_CopyJac_u_idxStarts(SrcJac_u_idxStartsData, DstJac_u_idxStartsData, CtrlCode, ErrStat, ErrMsg) + type(Jac_u_idxStarts), intent(in) :: SrcJac_u_idxStartsData + type(Jac_u_idxStarts), intent(inout) :: DstJac_u_idxStartsData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SeaSt_CopyJac_u_idxStarts' + ErrStat = ErrID_None + ErrMsg = '' + DstJac_u_idxStartsData%Extended = SrcJac_u_idxStartsData%Extended +end subroutine + +subroutine SeaSt_DestroyJac_u_idxStarts(Jac_u_idxStartsData, ErrStat, ErrMsg) + type(Jac_u_idxStarts), intent(inout) :: Jac_u_idxStartsData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SeaSt_DestroyJac_u_idxStarts' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine SeaSt_PackJac_u_idxStarts(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Jac_u_idxStarts), intent(in) :: InData + character(*), parameter :: RoutineName = 'SeaSt_PackJac_u_idxStarts' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%Extended) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SeaSt_UnPackJac_u_idxStarts(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Jac_u_idxStarts), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SeaSt_UnPackJac_u_idxStarts' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%Extended); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SeaSt_CopyJac_y_idxStarts(SrcJac_y_idxStartsData, DstJac_y_idxStartsData, CtrlCode, ErrStat, ErrMsg) + type(Jac_y_idxStarts), intent(in) :: SrcJac_y_idxStartsData + type(Jac_y_idxStarts), intent(inout) :: DstJac_y_idxStartsData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SeaSt_CopyJac_y_idxStarts' + ErrStat = ErrID_None + ErrMsg = '' + DstJac_y_idxStartsData%Extended = SrcJac_y_idxStartsData%Extended + DstJac_y_idxStartsData%WrOuts = SrcJac_y_idxStartsData%WrOuts +end subroutine + +subroutine SeaSt_DestroyJac_y_idxStarts(Jac_y_idxStartsData, ErrStat, ErrMsg) + type(Jac_y_idxStarts), intent(inout) :: Jac_y_idxStartsData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SeaSt_DestroyJac_y_idxStarts' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine SeaSt_PackJac_y_idxStarts(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Jac_y_idxStarts), intent(in) :: InData + character(*), parameter :: RoutineName = 'SeaSt_PackJac_y_idxStarts' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%Extended) + call RegPack(RF, InData%WrOuts) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SeaSt_UnPackJac_y_idxStarts(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Jac_y_idxStarts), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SeaSt_UnPackJac_y_idxStarts' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%Extended); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WrOuts); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SeaSt_CopyLinParams(SrcLinParamsData, DstLinParamsData, CtrlCode, ErrStat, ErrMsg) + type(SeaSt_LinParams), intent(in) :: SrcLinParamsData + type(SeaSt_LinParams), intent(inout) :: DstLinParamsData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SeaSt_CopyLinParams' + ErrStat = ErrID_None + ErrMsg = '' + DstLinParamsData%NumExtendedInputs = SrcLinParamsData%NumExtendedInputs + DstLinParamsData%NumExtendedOutputs = SrcLinParamsData%NumExtendedOutputs + call SeaSt_CopyJac_u_idxStarts(SrcLinParamsData%Jac_u_idxStartList, DstLinParamsData%Jac_u_idxStartList, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SeaSt_CopyJac_y_idxStarts(SrcLinParamsData%Jac_y_idxStartList, DstLinParamsData%Jac_y_idxStartList, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcLinParamsData%du)) then + LB(1:1) = lbound(SrcLinParamsData%du) + UB(1:1) = ubound(SrcLinParamsData%du) + if (.not. allocated(DstLinParamsData%du)) then + allocate(DstLinParamsData%du(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinParamsData%du.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinParamsData%du = SrcLinParamsData%du + end if + DstLinParamsData%Jac_nu = SrcLinParamsData%Jac_nu + DstLinParamsData%Jac_ny = SrcLinParamsData%Jac_ny +end subroutine + +subroutine SeaSt_DestroyLinParams(LinParamsData, ErrStat, ErrMsg) + type(SeaSt_LinParams), intent(inout) :: LinParamsData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SeaSt_DestroyLinParams' + ErrStat = ErrID_None + ErrMsg = '' + call SeaSt_DestroyJac_u_idxStarts(LinParamsData%Jac_u_idxStartList, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SeaSt_DestroyJac_y_idxStarts(LinParamsData%Jac_y_idxStartList, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(LinParamsData%du)) then + deallocate(LinParamsData%du) + end if +end subroutine + +subroutine SeaSt_PackLinParams(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SeaSt_LinParams), intent(in) :: InData + character(*), parameter :: RoutineName = 'SeaSt_PackLinParams' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%NumExtendedInputs) + call RegPack(RF, InData%NumExtendedOutputs) + call SeaSt_PackJac_u_idxStarts(RF, InData%Jac_u_idxStartList) + call SeaSt_PackJac_y_idxStarts(RF, InData%Jac_y_idxStartList) + call RegPackAlloc(RF, InData%du) + call RegPack(RF, InData%Jac_nu) + call RegPack(RF, InData%Jac_ny) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SeaSt_UnPackLinParams(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SeaSt_LinParams), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SeaSt_UnPackLinParams' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%NumExtendedInputs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumExtendedOutputs); if (RegCheckErr(RF, RoutineName)) return + call SeaSt_UnpackJac_u_idxStarts(RF, OutData%Jac_u_idxStartList) ! Jac_u_idxStartList + call SeaSt_UnpackJac_y_idxStarts(RF, OutData%Jac_y_idxStartList) ! Jac_y_idxStartList + call RegUnpackAlloc(RF, OutData%du); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Jac_nu); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Jac_ny); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SeaSt_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(SeaSt_ParameterType), intent(in) :: SrcParamData + type(SeaSt_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SeaSt_CopyParam' + ErrStat = ErrID_None + ErrMsg = '' + DstParamData%WaveDT = SrcParamData%WaveDT + DstParamData%NGridPts = SrcParamData%NGridPts + DstParamData%NGrid = SrcParamData%NGrid + DstParamData%deltaGrid = SrcParamData%deltaGrid + DstParamData%NWaveElev = SrcParamData%NWaveElev + if (allocated(SrcParamData%WaveElevxi)) then + LB(1:1) = lbound(SrcParamData%WaveElevxi) + UB(1:1) = ubound(SrcParamData%WaveElevxi) + if (.not. allocated(DstParamData%WaveElevxi)) then + allocate(DstParamData%WaveElevxi(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WaveElevxi.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%WaveElevxi = SrcParamData%WaveElevxi + end if + if (allocated(SrcParamData%WaveElevyi)) then + LB(1:1) = lbound(SrcParamData%WaveElevyi) + UB(1:1) = ubound(SrcParamData%WaveElevyi) + if (.not. allocated(DstParamData%WaveElevyi)) then + allocate(DstParamData%WaveElevyi(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WaveElevyi.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%WaveElevyi = SrcParamData%WaveElevyi + end if + DstParamData%NWaveKin = SrcParamData%NWaveKin + if (allocated(SrcParamData%WaveKinxi)) then + LB(1:1) = lbound(SrcParamData%WaveKinxi) + UB(1:1) = ubound(SrcParamData%WaveKinxi) + if (.not. allocated(DstParamData%WaveKinxi)) then + allocate(DstParamData%WaveKinxi(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WaveKinxi.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%WaveKinxi = SrcParamData%WaveKinxi + end if + if (allocated(SrcParamData%WaveKinyi)) then + LB(1:1) = lbound(SrcParamData%WaveKinyi) + UB(1:1) = ubound(SrcParamData%WaveKinyi) + if (.not. allocated(DstParamData%WaveKinyi)) then + allocate(DstParamData%WaveKinyi(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WaveKinyi.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%WaveKinyi = SrcParamData%WaveKinyi + end if + if (allocated(SrcParamData%WaveKinzi)) then + LB(1:1) = lbound(SrcParamData%WaveKinzi) + UB(1:1) = ubound(SrcParamData%WaveKinzi) + if (.not. allocated(DstParamData%WaveKinzi)) then + allocate(DstParamData%WaveKinzi(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WaveKinzi.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%WaveKinzi = SrcParamData%WaveKinzi + end if + if (allocated(SrcParamData%OutParam)) then + LB(1:1) = lbound(SrcParamData%OutParam) + UB(1:1) = ubound(SrcParamData%OutParam) + if (.not. allocated(DstParamData%OutParam)) then + allocate(DstParamData%OutParam(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutParam.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyOutParmType(SrcParamData%OutParam(i1), DstParamData%OutParam(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + DstParamData%NumOuts = SrcParamData%NumOuts + DstParamData%OutSwtch = SrcParamData%OutSwtch + DstParamData%OutFmt = SrcParamData%OutFmt + DstParamData%OutSFmt = SrcParamData%OutSFmt + DstParamData%Delim = SrcParamData%Delim + DstParamData%UnOutFile = SrcParamData%UnOutFile + DstParamData%OutDec = SrcParamData%OutDec + if (associated(SrcParamData%WaveField)) then + if (.not. associated(DstParamData%WaveField)) then + allocate(DstParamData%WaveField, stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WaveField.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + call SeaSt_WaveField_CopySeaSt_WaveFieldType(SrcParamData%WaveField, DstParamData%WaveField, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end if + call SeaSt_CopyLinParams(SrcParamData%LinParams, DstParamData%LinParams, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine SeaSt_DestroyParam(ParamData, ErrStat, ErrMsg) + type(SeaSt_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SeaSt_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ParamData%WaveElevxi)) then + deallocate(ParamData%WaveElevxi) + end if + if (allocated(ParamData%WaveElevyi)) then + deallocate(ParamData%WaveElevyi) + end if + if (allocated(ParamData%WaveKinxi)) then + deallocate(ParamData%WaveKinxi) + end if + if (allocated(ParamData%WaveKinyi)) then + deallocate(ParamData%WaveKinyi) + end if + if (allocated(ParamData%WaveKinzi)) then + deallocate(ParamData%WaveKinzi) + end if + if (allocated(ParamData%OutParam)) then + LB(1:1) = lbound(ParamData%OutParam) + UB(1:1) = ubound(ParamData%OutParam) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyOutParmType(ParamData%OutParam(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%OutParam) + end if + if (associated(ParamData%WaveField)) then + call SeaSt_WaveField_DestroySeaSt_WaveFieldType(ParamData%WaveField, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + deallocate(ParamData%WaveField) + ParamData%WaveField => null() + end if + call SeaSt_DestroyLinParams(ParamData%LinParams, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine SeaSt_PackParam(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SeaSt_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SeaSt_PackParam' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + logical :: PtrInIndex + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%WaveDT) + call RegPack(RF, InData%NGridPts) + call RegPack(RF, InData%NGrid) + call RegPack(RF, InData%deltaGrid) + call RegPack(RF, InData%NWaveElev) + call RegPackAlloc(RF, InData%WaveElevxi) + call RegPackAlloc(RF, InData%WaveElevyi) + call RegPack(RF, InData%NWaveKin) + call RegPackAlloc(RF, InData%WaveKinxi) + call RegPackAlloc(RF, InData%WaveKinyi) + call RegPackAlloc(RF, InData%WaveKinzi) + call RegPack(RF, allocated(InData%OutParam)) + if (allocated(InData%OutParam)) then + call RegPackBounds(RF, 1, lbound(InData%OutParam), ubound(InData%OutParam)) + LB(1:1) = lbound(InData%OutParam) + UB(1:1) = ubound(InData%OutParam) + do i1 = LB(1), UB(1) + call NWTC_Library_PackOutParmType(RF, InData%OutParam(i1)) + end do + end if + call RegPack(RF, InData%NumOuts) + call RegPack(RF, InData%OutSwtch) + call RegPack(RF, InData%OutFmt) + call RegPack(RF, InData%OutSFmt) + call RegPack(RF, InData%Delim) + call RegPack(RF, InData%UnOutFile) + call RegPack(RF, InData%OutDec) + call RegPack(RF, associated(InData%WaveField)) + if (associated(InData%WaveField)) then + call RegPackPointer(RF, c_loc(InData%WaveField), PtrInIndex) + if (.not. PtrInIndex) then + call SeaSt_WaveField_PackSeaSt_WaveFieldType(RF, InData%WaveField) + end if + end if + call SeaSt_PackLinParams(RF, InData%LinParams) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SeaSt_UnPackParam(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SeaSt_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SeaSt_UnPackParam' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(B8Ki) :: PtrIdx + type(c_ptr) :: Ptr + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%WaveDT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NGridPts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NGrid); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%deltaGrid); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NWaveElev); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WaveElevxi); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WaveElevyi); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NWaveKin); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WaveKinxi); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WaveKinyi); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WaveKinzi); if (RegCheckErr(RF, RoutineName)) return + if (allocated(OutData%OutParam)) deallocate(OutData%OutParam) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%OutParam(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackOutParmType(RF, OutData%OutParam(i1)) ! OutParam + end do + end if + call RegUnpack(RF, OutData%NumOuts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutSwtch); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutFmt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutSFmt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Delim); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UnOutFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutDec); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%WaveField)) deallocate(OutData%WaveField) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackPointer(RF, Ptr, PtrIdx); if (RegCheckErr(RF, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveField) + else + allocate(OutData%WaveField,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveField.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + RF%Pointers(PtrIdx) = c_loc(OutData%WaveField) + call SeaSt_WaveField_UnpackSeaSt_WaveFieldType(RF, OutData%WaveField) ! WaveField + end if + else + OutData%WaveField => null() + end if + call SeaSt_UnpackLinParams(RF, OutData%LinParams) ! LinParams +end subroutine + +subroutine SeaSt_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) + type(SeaSt_InputType), intent(in) :: SrcInputData + type(SeaSt_InputType), intent(inout) :: DstInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SeaSt_CopyInput' + ErrStat = ErrID_None + ErrMsg = '' + DstInputData%DummyInput = SrcInputData%DummyInput +end subroutine + +subroutine SeaSt_DestroyInput(InputData, ErrStat, ErrMsg) + type(SeaSt_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SeaSt_DestroyInput' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine SeaSt_PackInput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SeaSt_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SeaSt_PackInput' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyInput) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SeaSt_UnPackInput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SeaSt_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SeaSt_UnPackInput' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyInput); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SeaSt_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(SeaSt_OutputType), intent(in) :: SrcOutputData + type(SeaSt_OutputType), intent(inout) :: DstOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'SeaSt_CopyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcOutputData%WriteOutput)) then + LB(1:1) = lbound(SrcOutputData%WriteOutput) + UB(1:1) = ubound(SrcOutputData%WriteOutput) + if (.not. allocated(DstOutputData%WriteOutput)) then + allocate(DstOutputData%WriteOutput(LB(1):UB(1)), 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 + end if +end subroutine + +subroutine SeaSt_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(SeaSt_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SeaSt_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OutputData%WriteOutput)) then + deallocate(OutputData%WriteOutput) + end if +end subroutine + +subroutine SeaSt_PackOutput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SeaSt_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SeaSt_PackOutput' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%WriteOutput) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SeaSt_UnPackOutput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SeaSt_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SeaSt_UnPackOutput' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%WriteOutput); if (RegCheckErr(RF, RoutineName)) return +end subroutine +END MODULE SeaState_Types +!ENDOFREGISTRYGENERATEDFILE diff --git a/modules/seastate/src/UserWaves.f90 b/modules/seastate/src/UserWaves.f90 new file mode 100644 index 0000000000..4dbb0c79b2 --- /dev/null +++ b/modules/seastate/src/UserWaves.f90 @@ -0,0 +1,1243 @@ +MODULE UserWaves + + USE Waves_Types + USE SeaSt_WaveField_Types + USE NWTC_Library + USE NWTC_FFTPACK + + IMPLICIT NONE + PRIVATE + + PUBLIC :: UserWaves_Init + PUBLIC :: UserWaveElevations_Init + PUBLIC :: UserWaveComponents_Init + PUBLIC :: Initial_InitOut_Arrays + + + ! Data type for reading in wave elevation data from a file. + TYPE :: WaveElevInputDataFile + REAL(DbKi) :: WaveDT !< time step size + INTEGER(IntKi) :: NStepWave !< Number of wave elevation steps + REAL(SiKi) :: WaveTMax !< Maximum time + REAL(SiKi), ALLOCATABLE :: WaveElev(:) !< Wave elevation at each timestep (m) + REAL(SiKi), ALLOCATABLE :: WaveTime(:) !< Timestamp of each wave elevation (s) + CHARACTER(1024) :: FileName !< Name of the file + END TYPE WaveElevInputDataFile + + ! Data type for reading in wave component data from a file. + TYPE :: WaveCompInputDataFile + INTEGER(IntKi) :: NCompWave !< Number of wave components + REAL(SiKi), ALLOCATABLE :: WaveAngFreq(:) !< Wave angular frequency of each component (rad/s) + REAL(SiKi), ALLOCATABLE :: WaveAmp(:) !< Wave height of each component (m) + REAL(SiKi), ALLOCATABLE :: WaveDir(:) !< Wave direction of each component (rad) + REAL(SiKi), ALLOCATABLE :: WavePhase(:) !< Wave phase of each component (rad) + CHARACTER(1024) :: FileName !< Name of the file + END TYPE WaveCompInputDataFile + + + CONTAINS + +!---------------------------------------------------------------------------------------------------------------------------------- +SUBROUTINE Initial_InitOut_Arrays(InitOut, WaveField, InitInp, WaveDT, ErrStat, ErrMsg) + TYPE(Waves_InitOutputType), INTENT(INOUT) :: InitOut ! Initialization output data + TYPE(SeaSt_WaveFieldType), INTENT(INOUT) :: WaveField + TYPE(Waves_InitInputType), INTENT(IN ) :: InitInp ! Initialization input data + REAL(DbKi), INTENT(IN ) :: WaveDT ! Value of wave dt, used for filling WaveTime + 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 + ! CHARACTER(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Initial_InitOut_Arrays' + + + ErrStat = ErrID_None + ErrMsg = "" + + ! Allocatable arrays: + ALLOCATE ( WaveField%WaveElev0 ( 0:WaveField%NStepWave ), STAT=ErrStat2 ); IF (ErrStat2 /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveField%WaveElev0.', ErrStat, ErrMsg, RoutineName) + ALLOCATE ( WaveField%WaveElevC (2, 0:WaveField%NStepWave2, InitInp%NGrid(1)*InitInp%NGrid(2) ), STAT=ErrStat2 ); IF (ErrStat2 /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveField%WaveElevC.', ErrStat,ErrMsg,RoutineName) + + ! Allocatable arrays in WaveField: + ALLOCATE ( WaveField%WaveTime ( 0:WaveField%NStepWave ) , STAT=ErrStat2 ); IF (ErrStat2 /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveField%WaveTime.', ErrStat, ErrMsg, RoutineName) + ALLOCATE ( WaveField%WaveElevC0 (2, 0:WaveField%NStepWave2 ) , STAT=ErrStat2 ); IF (ErrStat2 /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveField%WaveElevC0.',ErrStat, ErrMsg, RoutineName) + ALLOCATE ( WaveField%WaveDirArr ( 0:WaveField%NStepWave2 ) , STAT=ErrStat2 ); IF (ErrStat2 /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveField%WaveDirArr.',ErrStat, ErrMsg, RoutineName) + + ALLOCATE ( WaveField%WaveElev1(0:WaveField%NStepWave,InitInp%NGrid(1),InitInp%NGrid(2) ), STAT=ErrStat2 ); IF (ErrStat2 /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveField%WaveElev1.', ErrStat,ErrMsg,RoutineName) + ALLOCATE ( WaveField%WaveDynP (0:WaveField%NStepWave,InitInp%NGrid(1),InitInp%NGrid(2),InitInp%NGrid(3) ), STAT=ErrStat2 ); IF (ErrStat2 /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveField%WaveDynP.', ErrStat,ErrMsg,RoutineName) + ALLOCATE ( WaveField%WaveVel (0:WaveField%NStepWave,InitInp%NGrid(1),InitInp%NGrid(2),InitInp%NGrid(3),3), STAT=ErrStat2 ); IF (ErrStat2 /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveField%WaveVel.', ErrStat,ErrMsg,RoutineName) + ALLOCATE ( WaveField%WaveAcc (0:WaveField%NStepWave,InitInp%NGrid(1),InitInp%NGrid(2),InitInp%NGrid(3),3), STAT=ErrStat2 ); IF (ErrStat2 /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveField%WaveAcc.', ErrStat,ErrMsg,RoutineName) + + + if (ErrStat >= AbortErrLev) return + + !---------------------------------------- + ! Initialize the arrays we just allocated + !---------------------------------------- + + ! Calculate the array of simulation times at which the instantaneous + ! elevation of, velocity of, acceleration of, and loads associated with + ! the incident waves are to be determined: + DO I = 0,WaveField%NStepWave ! Loop through all time steps + WaveField%WaveTime(I) = I * WaveDT + END DO ! I - All time steps + + WaveField%WaveElev0 = 0.0 + WaveField%WaveElevC = 0.0 + WaveField%WaveElevC0 = 0.0 + WaveField%WaveElev1 = 0.0 + WaveField%WaveDynP = 0.0 + WaveField%WaveVel = 0.0 + WaveField%WaveAcc = 0.0 + WaveField%WaveDirArr = 0.0 + + ! scalars (adjusted later, if necessary) + WaveField%WaveDirMin = 0.0 + WaveField%WaveDirMax = 0.0 + InitOut%WaveNDir = 1 + +END SUBROUTINE Initial_InitOut_Arrays + +!----------------------------------------------------------------------------------------------------------------------! +! ! +! WaveMod = 5 (WaveMod_ExtElev) ! +! ! +!----------------------------------------------------------------------------------------------------------------------! + +!----------------------------------------------------------------------------------------------------------------------- +!> This subroutine reads in the wave elevations from a file and reconstructs the frequency information. +!! +!! FILE Format: +!! Header info: +!! This file may have header lines. These can be any number of lines at the beginning of the file that +!! start with non-numeric data. The Value of WaveDT is calculated using the first and last rows of data, +!! and the number of timesteps. The Number of timesteps is calculated as the number of lines of data, minus 1. +!! +!! column headings --> column 1 = time (s), column 2 = elevation (m) +!! +!! +SUBROUTINE WaveElev_ReadFile ( InitInp, WaveElevData, ErrStat, ErrMsg ) + + IMPLICIT NONE + TYPE(Waves_InitInputType), INTENT(IN ) :: InitInp !< Input data for initialization routine + TYPE(WaveElevInputDataFile), INTENT( OUT) :: WaveElevData !< Wave elevation file data, after changing NStepWave + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error Status at return + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + + ! Variables for reading in the wave elevation + REAL(SiKi) :: TmpWaveElevRow(2) !< row read in from the wave elevation input file + + ! Local Variables + CHARACTER(MaxFileInfoLineLen) :: TextLine !< One line of text read from the file + INTEGER(IntKi) :: LineLen !< The length of the line read in + INTEGER(IntKi) :: I !< Generic counter integer + INTEGER(IntKi) :: NumDataColumns !< Number of columns of data found in the file + INTEGER(IntKi) :: NumHeaderLines !< Number of header lines in the file. + INTEGER(IntKi) :: WaveElevUnit !< Unit number for the ElevFileName + INTEGER(IntKi) :: ErrStatTmp !< Temporarary error status for procesing + CHARACTER(ErrMsgLen) :: ErrMsgTmp !< Temporary error message for processing + CHARACTER(*), PARAMETER :: RoutineName = 'WaveElev_ReadFile' + + ! Initialize the error handling + ErrStat = ErrID_None + ErrMsg = "" + + ! Assemble the filename for the wave elevation data. + WaveElevData%FileName = TRIM(InitInp%WvKinFile)//'.Elev' + + ! Open the file containing the wave elevation timeseries + !$OMP critical(fileopen) + CALL GetNewUnit( WaveElevUnit ) + CALL OpenFInpFile( WaveElevUnit, WaveElevData%FileName, ErrStatTmp, ErrMsgTmp ) + !$OMP end critical(fileopen) + CALL SetErrStat( ErrStatTmp, ErrMsgTmp, ErrStat,ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) THEN + CLOSE ( WaveElevUnit ) + CALL CleanUp() + RETURN + END IF + + ! Find out how the data is formatted + CALL GetFileLength(WaveElevUnit, TRIM(WaveElevData%Filename), NumDataColumns, WaveElevData%NStepWave, NumHeaderLines, ErrStatTmp, ErrMsgTmp) + CALL SetErrStat( ErrStatTmp, ErrMsgTmp, ErrStat,ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) THEN + CLOSE ( WaveElevUnit ) + CALL CleanUp() + RETURN + END IF + + ! Check that we read in two columns + IF ( NumDataColumns /= 2_IntKi ) THEN + CALL SetErrStat( ErrID_Fatal, ' Wave elevation files should contain only two columns of data: Time (s) and Elevation (m). '// & + 'Found '//TRIM(Num2LStr(NumDataColumns))//' of data in '//TRIM(WaveElevData%FileName)//'.', ErrStat, ErrMsg, RoutineName) + CLOSE ( WaveElevUnit ) + CALL CleanUp() + RETURN + END IF + + ! Check that we have at least two time steps + IF ( WaveElevData%NStepWave < 2 ) THEN + CALL SetErrStat( ErrID_Fatal, ' The file '//TRIM(WaveElevData%Filename)//' contains only '//TRIM(Num2LStr(WaveElevData%NStepWave))// & + ' lines of data. This does not appear to be a useful wave elevation file.', ErrStat, ErrMsg, RoutineName) + CLOSE ( WaveElevUnit ) + CALL CleanUp + RETURN + END IF + + ! Adjust the number of steps since we index from zero + WaveElevData%NStepWave = WaveElevData%NStepWave - 1_IntKi + + ! Even though for OpenFAST data, NStepWave time increment data equals the 0 time increment data, + ! we cannot assume that is true for arbitrary user data. Therefore, we read the entire [0, NStepWave] data from file. + ! As a result for WaveMod=5,6 we shouldn't assume periodic waves over the period WaveTMax + + !-------------------------------------------------- + ! Read in the data + !-------------------------------------------------- + + ! Allocate the array to store the time series + ALLOCATE ( WaveElevData%WaveTime(0:WaveElevData%NStepWave), STAT = ErrStatTmp ) + IF ( ErrStatTmp /= 0 ) THEN + CALL SetErrStat( ErrID_Fatal, 'Error allocating space for user WaveTime array.', ErrStat, ErrMsg, RoutineName ) + CLOSE ( WaveElevUnit ) + CALL CleanUp() + RETURN + END IF + + ! Allocate the array to store the elevation series + ALLOCATE ( WaveElevData%WaveElev(0:WaveElevData%NStepWave), STAT = ErrStatTmp ) + IF ( ErrStatTmp /= 0 ) THEN + CALL SetErrStat( ErrID_Fatal, 'Error allocating space for user WaveElev array.', ErrStat, ErrMsg, RoutineName ) + CLOSE ( WaveElevUnit ) + CALL CleanUp() + RETURN + END IF + + ! Read and discard the header lines + DO I=1,NumHeaderLines + CALL ReadLine( WaveElevUnit, '', TextLine, LineLen, ErrStatTmp ) + ENDDO + + ! Read in all the data + DO I=0,WaveElevData%NStepWave + CALL ReadAry( WaveElevUnit, WaveElevData%FileName, TmpWaveElevRow(1:2), 2, 'TmpWaveElevRow','Temporary variable holding the time and wave elevation pair', & + ErrStatTmp,ErrMsgTmp ) + IF ( ErrStatTmp /= 0 ) THEN + CALL SetErrStat( ErrID_Fatal, 'Error in reading in value from the file: line number '//TRIM(Num2LStr(I))//'. Expecting a total of '// & + TRIM(Num2LStr(WaveElevData%NStepWave))//' rows of data.', ErrStat, ErrMsg, RoutineName ) + CLOSE ( WaveElevUnit ) + CALL CleanUp() + RETURN + END IF + + ! Copy the data to the appropriate places + WaveElevData%WaveTime(I) = TmpWaveElevRow(1) + WaveElevData%WaveElev(I) = TmpWaveElevRow(2) + + ENDDO + + CALL WrScr( ' Read in '//TRIM(Num2LStr(I))//' lines of wave elevation data from '//TRIM(WaveElevData%FileName)//'.' ) + + CLOSE( WaveElevUnit ) + + ! We are going to be a little bit lazy here and blindly assume that the time is correct in the file + ! and that the timesteps are uniform throughout the file (if this isn't true, that isn't the problem + ! of the programmer, rather of the user). + + ! Set the value for WaveTMax using the difference betwee the last value read in and the fist + WaveElevData%WaveTMax = WaveElevData%WaveTime(WaveElevData%NStepWave) - WaveElevData%WaveTime(0) + + ! Set the value for WaveDT using the number of steps read in and the difference from first and last + WaveElevData%WaveDT = REAL( WaveElevData%WaveTMax / WaveElevData%NStepWave, DbKi ) + + CONTAINS + + SUBROUTINE CleanUp + IF (ALLOCATED( WaveElevData%WaveElev )) DEALLOCATE( WaveElevData%WaveElev, STAT=ErrStatTmp) + IF (ALLOCATED( WaveElevData%WaveTime )) DEALLOCATE( WaveElevData%WaveTime, STAT=ErrStatTmp) + END SUBROUTINE CleanUp + +END SUBROUTINE WaveElev_ReadFile + +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine initializes the wave kinematics based a set of user-supplied wave elevations +!! +!! NOTE: WaveDT in file must match given WaveDT in HydroDyn input file +!! Final timestep must match given WaveTMax in HydroDyn input file +!! NOTE: Wave frequency cutoffs can are applied to the read in wave elevation time series +!! +SUBROUTINE UserWaveElevations_Init ( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) +!---------------------------------------------------------------------------------------------------------------------------------- + TYPE(Waves_InitInputType), INTENT(IN ) :: InitInp !< Input data for initialization routine + TYPE(Waves_InitOutputType), INTENT(INOUT) :: InitOut !< Initialization outputs + TYPE(SeaSt_WaveFieldType), INTENT(INOUT) :: WaveField !< Initialization outputs + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + ! Local Variables + TYPE(WaveElevInputDataFile) :: WaveElevData !< Wave elevation file data after changing NStepWave + REAL(SiKi), ALLOCATABLE :: TmpFFTWaveElev(:) !< Data for the FFT calculation + TYPE(FFT_DataType) :: FFT_Data !< the instance of the FFT module we're using + INTEGER(IntKi) :: I !< Generic counter + + ! Temporary error handling variables + INTEGER(IntKi) :: ErrStatTmp !< Temporarary error status for procesing + CHARACTER(ErrMsgLen) :: ErrMsgTmp !< Temporary error message for processing + CHARACTER(*), PARAMETER :: RoutineName = 'UserWaveElevations_Init' + + ! Data verification: WaveDT in the HD file and in the .Elev file may be slightly different. We will allow + ! some slight differences due to rounding. If necessary, we could change this to a percentage allowable in the future. + REAL(SiKi), PARAMETER :: WaveDT_Tol = 0.001_SiKi !< Allowable difference in WaveDT values + + ! set error status information + ErrStat = ErrID_None + ErrMsg = '' + + ! Statement to user + CALL WrScr1 ( ' Reading in wave elevation data from wave kinematics files with root name "'//TRIM(InitInp%WvKinFile)//'".' ) + + ! Read in the wave elevation data + CALL WaveElev_ReadFile (InitInp, WaveElevData, ErrStatTmp, ErrMsgTmp ) + CALL SetErrStat(ErrStatTmp,ErrMsgTmp,ErrStat,ErrMsg,RoutineName) + IF ( ErrStat >= AbortErrLev ) THEN + CALL CleanUp() + RETURN + END IF + + ! Check that the file timestep is the same as the HD file, and check that the WaveTMax value of the file is larger than that of HD. + IF ( InitInp%WaveTMax > WaveElevData%WaveTMax ) THEN + CALL SetErrStat(ErrID_Fatal,' SeaState requires a minimum of '//TRIM(Num2LStr(InitInp%WaveTMax))//', but '//TRIM(WaveElevData%FileName)// & + ' only contains a maximum time of '//TRIM(Num2LStr(WaveElevData%WaveTMax))//' (last line).',ErrStat,ErrMsg,RoutineName) + ENDIF + + ! Check that the values of WaveDT are the same or similar enough + IF ( ABS(InitInp%WaveDT - WaveElevData%WaveDT) > WaveDT_Tol ) THEN + CALL SetErrStat(ErrID_Fatal,' WaveDT from SeaState ('//TRIM(Num2LStr(InitInp%WaveDT))//') and timestep size in wave elevation file '// & + TRIM(WaveElevData%FileName)//' (WaveDT = '//TRIM(Num2LStr(WaveElevData%WaveDT))//') do not match. These need to be within '// & + TRIM(Num2LStr(WaveDT_Tol))//' seconds of each other.',ErrStat,ErrMsg,RoutineName) + ENDIF + + IF ( ErrStat >= AbortErrLev ) THEN + CALL CleanUp() + RETURN + END IF + + !>>>>>> COMPUTE INITOUT SCALARS WaveField%NStepWave, WaveField%NStepWave2, InitOut%WaveTMax, and InitOut%WaveDOmega for WAVEMOD = 5 + ! Set new value for NStepWave so that the FFT algorithms are efficient. We will use the values passed in rather than what is read from the file + ! NOTE: This method is what is used in the VariousWaves_Init routine in Waves.f90 + WaveField%NStepWave = CEILING ( InitInp%WaveTMax/InitInp%WaveDT ) ! Set NStepWave to an even integer + IF ( MOD(WaveField%NStepWave,2) == 1 ) WaveField%NStepWave = WaveField%NStepWave + 1 ! larger or equal to WaveTMax/WaveDT. + WaveField%NStepWave2 = MAX( WaveField%NStepWave/2, 1 ) ! Make sure that NStepWave is an even product of small factors (PSF) that is + WaveField%NStepWave = 2*PSF ( WaveField%NStepWave2, 9 ) ! greater or equal to WaveTMax/WaveDT to ensure that the FFT is efficient. + WaveField%NStepWave2 = WaveField%NStepWave/2 ! Update the value of NStepWave2 based on the value needed for NStepWave. + InitOut%WaveTMax = WaveField%NStepWave*InitInp%WaveDT ! Update the value of WaveTMax based on the value needed for NStepWave. + WaveField%WaveDOmega = TwoPi/InitInp%WaveTMax ! Compute the frequency step for incident wave calculations. + + ! >>> Allocate and initialize (set to 0) InitOut arrays + call Initial_InitOut_Arrays(InitOut, WaveField, InitInp, InitInp%WaveDT, ErrStatTmp, ErrMsgTmp); CALL SetErrStat(ErrStatTmp,ErrMsgTmp, ErrStat,ErrMsg,RoutineName) + !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + + + ! Give warning if the number of timesteps changed + IF ( WaveElevData%NStepWave /= WaveField%NStepWave ) THEN + CALL SetErrStat(ErrID_Warn, ' Changed number of timesteps from '//TRIM(Num2LStr(WaveElevData%NStepWave))//' to '// & + TRIM(Num2LStr(WaveField%NStepWave))//' in order to calculate the frequency information from the wave elevations. '// & + 'Wave elevations during additional time are padded with zero wave elevation.',ErrStat,ErrMsg,RoutineName) + ENDIF + + ! Allocate array to hold the wave elevations for calculation of FFT. + ALLOCATE ( TmpFFTWaveElev( 0:WaveField%NStepWave-1 ), STAT=ErrStatTmp ) + IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array TmpFFTWaveElev.',ErrStat,ErrMsg,RoutineName) + + ! Now check if all the allocations worked properly + IF ( ErrStat >= AbortErrLev ) THEN + CALL CleanUp() + RETURN + END IF + + ! Set the values + TmpFFTWaveElev = 0.0_SiKi + + ! Copy values over + DO I=0,MIN(WaveElevData%NStepWave,WaveField%NStepWave-1) + TmpFFTWaveElev(I) = WaveElevData%WaveElev(I) + ENDDO + + ! Initialize the FFT + CALL InitFFT ( WaveField%NStepWave, FFT_Data, .FALSE., ErrStatTmp ) + CALL SetErrStat(ErrStatTmp,'Error occured while initializing the FFT.',ErrStat,ErrMsg,RoutineName) + IF ( ErrStat >= AbortErrLev ) THEN + CALL CleanUp() + RETURN + END IF + + ! Apply the forward FFT to get the real and imaginary parts of the frequency information. + CALL ApplyFFT_f ( TmpFFTWaveElev(:), FFT_Data, ErrStatTmp ) ! Note that the TmpFFTWaveElev now contains the real and imaginary bits. + CALL SetErrStat(ErrStatTmp,'Error occured while applying the forwards FFT to TmpFFTWaveElev array.',ErrStat,ErrMsg,RoutineName) + IF ( ErrStat >= AbortErrLev ) THEN + CALL CleanUp() + RETURN + END IF + + ! Copy the resulting TmpFFTWaveElev(:) data over to the InitOut%WaveElevC0 array + DO I=1,WaveField%NStepWave2-1 + WaveField%WaveElevC0 (1,I) = TmpFFTWaveElev(2*I-1) + WaveField%WaveElevC0 (2,I) = TmpFFTWaveElev(2*I) + ENDDO + WaveField%WaveElevC0(:,WaveField%NStepWave2) = 0.0_SiKi + + CALL ExitFFT(FFT_Data, ErrStatTmp) + CALL SetErrStat(ErrStatTmp,'Error occured while cleaning up after the FFTs.', ErrStat,ErrMsg,RoutineName) + IF ( ErrStat >= AbortErrLev ) THEN + CALL CleanUp() + RETURN + END IF + + CALL CleanUp() + + CONTAINS + + SUBROUTINE CleanUp + + IF (ALLOCATED( WaveElevData%WaveElev )) DEALLOCATE( WaveElevData%WaveElev, STAT=ErrStatTmp) + IF (ALLOCATED( WaveElevData%WaveTime )) DEALLOCATE( WaveElevData%WaveTime, STAT=ErrStatTmp) + IF (ALLOCATED( TmpFFTWaveElev )) DEALLOCATE( TmpFFTWaveElev, STAT=ErrStatTmp) + + END SUBROUTINE CleanUp + +END SUBROUTINE UserWaveElevations_Init + +!----------------------------------------------------------------------------------------------------------------------! +! ! +! WaveMod = 6 (WaveMod_ExtFull) ! +! ! +!----------------------------------------------------------------------------------------------------------------------! + +!---------------------------------------------------------------------------------------------------------------------------------- +SUBROUTINE UserWaves_Init ( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) +! This routine initializes the wave kinematics based on user-supplied data +!---------------------------------------------------------------------------------------------------------------------------------- + TYPE(Waves_InitInputType), INTENT(IN ) :: InitInp ! Input data for initialization routine + TYPE(Waves_InitOutputType), INTENT(INOUT) :: InitOut ! Initialization outputs + TYPE(SeaSt_WaveFieldType), INTENT(INOUT) :: WaveField !< Initialization outputs + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + + INTEGER :: UnWv ! file unit for writing the various wave kinematics files + CHARACTER(1024) :: FileName ! complete filename for one of the output files + INTEGER :: i, j, k, m, icount ! Generic index + INTEGER :: iFile ! Generic index + CHARACTER(10) :: Delim + CHARACTER(64), ALLOCATABLE :: WaveDataStr(:) + REAL(SiKi) :: WaveData + + ! Temporary error handling variables + INTEGER(IntKi) :: ErrStatTmp ! Temporarary error status for procesing + CHARACTER(ErrMsgLen) :: ErrMsgTmp ! Temporary error message for processing + LOGICAL :: isNumeric + CHARACTER(*), PARAMETER :: RoutineName = 'UserWaves_Init' + CHARACTER(5) :: extension(7) + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" + + extension = (/'.Vxi ','.Vyi ','.Vzi ','.Axi ','.Ayi ','.Azi ','.DynP'/) + Delim = '' + + + ! Tell our nice users what is about to happen that may take a while: + + CALL WrScr1 ( ' Reading in wave data from wave kinematics files with root name "'//TRIM(InitInp%WvKinFile)//'".' ) + + + + !>>>>>> COMPUTE INITOUT SCALARS InitOut%NStepWave, WaveField%NStepWave2, InitOut%WaveTMax, and InitOut%WaveDOmega for WAVEMOD = 6 + ! Perform some initialization computations including calculating the + ! total number of time steps in the incident wave and ALLOCATing the + ! arrays; initialize the unneeded values to zero: + WaveField%NStepWave = CEILING ( InitInp%WaveTMax/InitInp%WaveDT ) ! Set NStepWave to an even integer + IF (.NOT. (EqualRealNos( REAL(InitInp%WaveTMax, SiKi) - REAL(WaveField%NStepWave*InitInp%WaveDT, SiKi), 0.0_SiKi ) ) ) THEN + ErrMsg = 'For WaveMod = 5 or 6, WaveTMax must be a multiple of WaveDT' + ErrStat = ErrID_Fatal + RETURN + END IF + + WaveField%NStepWave2 = WaveField%NStepWave/2 + InitOut%WaveTMax = InitInp%WaveTMax + WaveField%WaveDOmega = TwoPi/InitInp%WaveTMax + + ! >>> Allocate and initialize (set to 0) InitOut arrays + call Initial_InitOut_Arrays(InitOut, WaveField, InitInp, InitInp%WaveDT, ErrStatTmp, ErrMsgTmp); CALL SetErrStat(ErrStatTmp,ErrMsgTmp, ErrStat,ErrMsg,RoutineName) + !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + + ALLOCATE ( WaveDataStr ( InitInp%NGrid(1) ) , STAT=ErrStatTmp ) + IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveDataStr.', ErrStat,ErrMsg,RoutineName) + + + + ! Now check if all the allocations worked properly + IF ( ErrStat >= AbortErrLev ) THEN + CALL CleanUp() + RETURN + END IF + + + ! Even though for OpenFAST data, NStepWave time increment data equals the 0 time increment data, + ! we cannot assume that is true for arbitrary user data. Therefore, we read the entire [0, NStepWave] data from file. + ! As a result for WaveMod=5,6 we shouldn't assume periodic waves over the period WaveTMax + + + ! Read the first file and set the initial values of the + DO iFile = 1,7 + + FileName = TRIM(InitInp%WvKinFile) // TRIM(extension(iFile)) + + !$OMP critical(fileopen) + CALL GetNewUnit( UnWv ) + CALL OpenFInpFile ( UnWv, FileName, ErrStatTmp, ErrMsgTmp ) + !$OMP end critical(fileopen) + IF ( ErrStatTmp /= 0 ) THEN + ErrMsgTmp = 'Failed to open wave kinematics file, ' // TRIM(FileName) + CALL SetErrStat( ErrID_Fatal, ErrMsgTmp, ErrStat, ErrMsg, RoutineName ) + RETURN + END IF + + do i = 1, 13 + CALL ReadCom( UnWv, FileName, 'HydroDyn wave kinematics file header line', ErrStatTmp, ErrMsgTmp ) + CALL SetErrStat( ErrStatTmp, ErrMsgTmp, ErrStat, ErrMsg, RoutineName ) + IF (ErrStat >= AbortErrLev) THEN + CALL Cleanup() + RETURN + END IF + end do + + DO m = 0,WaveField%NStepWave + icount = 1 + do k = 1, InitInp%NGrid(3) + do j = 1, InitInp%NGrid(2) + ! Extract fields from current line + IF (.not. ExtractFields(UnWv, WaveDataStr(:), InitInp%NGrid(1))) THEN + call Cleanup() + RETURN + END IF + DO i = 1, InitInp%NGrid(1) + + isNumeric = is_numeric(WaveDataStr(i), WaveData) + IF (.NOT. isNumeric ) THEN + WaveData = 0.0 + END IF + + SELECT CASE (iFile) + CASE (1) + WaveField%WaveVel (m,i,j,k,1) = WaveData + CASE (2) + WaveField%WaveVel (m,i,j,k,2) = WaveData + CASE (3) + WaveField%WaveVel (m,i,j,k,3) = WaveData + CASE (4) + WaveField%WaveAcc (m,i,j,k,1) = WaveData + CASE (5) + WaveField%WaveAcc (m,i,j,k,2) = WaveData + CASE (6) + WaveField%WaveAcc (m,i,j,k,3) = WaveData + CASE (7) + WaveField%WaveDynP(m,i,j,k ) = WaveData + END SELECT + icount = icount + 1 + END DO + end do + end do + END DO + end do + + ! WaveElev + + FileName = TRIM(InitInp%WvKinFile) // '.Elev' + + !$OMP critical(fileopen) + CALL GetNewUnit( UnWv ) + CALL OpenFInpFile ( UnWv, FileName, ErrStatTmp, ErrMsgTmp ) + !$OMP end critical(fileopen) + IF ( ErrStatTmp /= 0 ) THEN + ErrMsgTmp = 'Failed to open wave elevation file, ' // TRIM(FileName) + CALL SetErrStat( ErrID_Fatal, ErrMsgTmp, ErrStat, ErrMsg, RoutineName ) + RETURN + END IF + + do i = 1, 13 + CALL ReadCom( UnWv, FileName, 'HydroDyn wave elevation file header line', ErrStatTmp, ErrMsgTmp ) + CALL SetErrStat( ErrStatTmp, ErrMsgTmp, ErrStat, ErrMsg, RoutineName ) + IF (ErrStat >= AbortErrLev) THEN + CALL Cleanup() + RETURN + END IF + end do + + DO m = 0,WaveField%NStepWave + do j = 1, InitInp%NGrid(2) + ! Extract fields from current line + IF (.not. ExtractFields(UnWv, WaveDataStr(:), InitInp%NGrid(1))) THEN + call Cleanup() + RETURN + END IF + DO i = 1, InitInp%NGrid(1) + + isNumeric = is_numeric(WaveDataStr(i), WaveData) + IF (.NOT. isNumeric ) THEN + WaveField%WaveElev1(m,i,j ) = 0.0 + ELSE + WaveField%WaveElev1(m,i,j ) = WaveData + END IF + END DO + end do + + END DO + + CALL CleanUp( ) + + + + +CONTAINS + + !> Sub function to extract n fields on the current line of the file unit FU + FUNCTION ExtractFields(FU, s, n) result(OK) + ! Arguments + INTEGER, INTENT(IN) :: FU !< Unit name + INTEGER, INTENT(IN) :: n !< Number of fields + CHARACTER(*), INTENT(OUT) :: s(n) !< Fields + LOGICAL :: OK + ! Local var + CHARACTER(MaxFileInfoLineLen*64) :: TextLine !< One line of text read from the file : length should be > n*(1+length(s(1))) + OK=.TRUE. + + ! Read line + READ(FU, FMT='(A)', IOSTAT=ErrStat) TextLine + IF (ErrStat/=0) THEN + ErrStat = ErrID_Fatal + WRITE(ErrMsg,'(A,I0,A,I0,A)') 'Failed to read line ',I+2,' (out of ',WaveField%NStepWave+1,' expected lines) in file '//TRIM(FileName)//& + & '. Check that the number of lines (without header) is equal to WaveTMax/WaveDT. ' + OK=.FALSE. + RETURN + END IF + + ! Extract fields (ReadCAryFromStr is in NWTC_IO) + CALL ReadCAryFromStr ( TextLine, s, n, 'line', 'junk', ErrStat, ErrMsgTmp ) + IF (ErrStat/=0) THEN + ErrStat = ErrID_Fatal + write(ErrMsg,'(A,I0,A,I0,A)') 'Failed to extract fields from line ',I+2,' in file '//TRIM(FileName)//'. '//& + & trim(ErrMsgTmp)//' Check that the number of columns is correct and matches the number of internal HydroDyn nodes.'//& + &' (Typically twice the number of joints).' + OK=.FALSE. + RETURN + END IF + END FUNCTION ExtractFields + + SUBROUTINE CleanUp( ) + + IF (ALLOCATED( WaveDataStr )) DEALLOCATE( WaveDataStr, STAT=ErrStatTmp) + CLOSE(UnWv) + RETURN + END SUBROUTINE CleanUp + +END SUBROUTINE UserWaves_Init + + +!----------------------------------------------------------------------------------------------------------------------! +! ! +! WaveMod = 7 (WaveMod_UserFreq) ! +! ! +!----------------------------------------------------------------------------------------------------------------------! + +!----------------------------------------------------------------------------------------------------------------------- +!> This subroutine reads in the wave components from a file and reconstructs the frequency information. +SUBROUTINE WaveComp_ReadFile ( InitInp, WaveDOmega, WaveCompData, ErrStat, ErrMsg ) + + IMPLICIT NONE + TYPE(Waves_InitInputType), INTENT(INOUT) :: InitInp !< Input data for initialization routine + REAL(SiKi), INTENT(INOUT) :: WaveDOmega !< wave field data + TYPE(WaveCompInputDataFile), INTENT( OUT) :: WaveCompData !< Wave component file data + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error Status at return + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + + ! Variables for reading in the wave components + REAL(SiKi) :: TmpWaveCompRow(4) !< row read in from the wave component input file + REAL(SiKi) :: WaveAngFreq + + + ! Local Variables + CHARACTER(MaxFileInfoLineLen) :: TextLine !< One line of text read from the file + INTEGER(IntKi) :: LineLen !< The length of the line read in + INTEGER(IntKi) :: I !< Generic counter integer + INTEGER(IntKi) :: NumDataColumns !< Number of columns of data found in the file + INTEGER(IntKi) :: NumHeaderLines !< Number of header lines in the file. + INTEGER(IntKi) :: WaveCompUnit !< Unit number for the CompFileName + INTEGER(IntKi) :: ErrStatTmp !< Temporarary error status for procesing + CHARACTER(ErrMsgLen) :: ErrMsgTmp !< Temporary error message for processing + CHARACTER(*), PARAMETER :: RoutineName = 'WaveComp_ReadFile' + REAL(SiKi), PARAMETER :: WaveDOmega_RelTol = 0.001_SiKi !< Allowable relative difference in WaveDOmega values + REAL(SiKi) :: OmegaRatio + + CHARACTER(1024) :: StrRead !< String containing the first word read in + REAL(SiKi) :: RealRead !< Returns value of the number (if there was one), or NaN (as set by NWTC_Num) if there wasn't + 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 + + LOGICAL :: USESEAFormat + + CHARACTER(24) :: Words(20) !< Array of words we extract from a line. We shouldn't have more than 20. + + ! Initialize the error handling + ErrStat = ErrID_None + ErrMsg = "" + + ! Assemble the filename for the wave component data. + WaveCompData%FileName = TRIM(InitInp%WvKinFile) + + ! Open the file containing the list of wave components + !$OMP critical(fileopen) + CALL GetNewUnit( WaveCompUnit ) + CALL OpenFInpFile( WaveCompUnit, WaveCompData%FileName, ErrStatTmp, ErrMsgTmp ) + !$OMP end critical(fileopen) + CALL SetErrStat( ErrStatTmp, ErrMsgTmp, ErrStat,ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) THEN + CALL CleanUpError() + RETURN + END IF + + ! Find out how the data is formatted + CALL GetFileLength(WaveCompUnit, TRIM(WaveCompData%Filename), NumDataColumns, WaveCompData%NCompWave, NumHeaderLines, ErrStatTmp, ErrMsgTmp) + CALL SetErrStat( ErrStatTmp, ErrMsgTmp, ErrStat,ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) THEN + CALL CleanUpError() + RETURN + END IF + + ! Find out which format the file uses - OpenFAST or SEA + CALL ReadLine( WaveCompUnit, '', TextLine, LineLen, ErrStatTmp ) + IF (ErrStatTmp /= ErrID_None) THEN + CALL SetErrStat( ErrID_Fatal, 'Error reading the first line of ' // TRIM(WaveCompData%FileName), ErrStat, ErrMsg, RoutineName) + CALL CleanUpError() + RETURN + END IF + If (TextLine(1:28) == 'source: SEAFileGenerator.exe') THEN + CALL WrScr1 ( ' Reading "'//TRIM(InitInp%WvKinFile)//'" following the .SEA format: Wave Frequency (Hz), Wave Amplitude (m), Wave Direction (rad), Wave Phase (rad).' ) + UseSEAFormat = .TRUE. + ErrStatTmp = ErrID_None + + ! Go through the SEA headerlines + DO I = 2,NumHeaderLines + CALL ReadLine( WaveCompUnit, '', TextLine, LineLen, ErrStatTmp ) + CALL GetWords( TextLine, Words, SIZE(Words) ) + + ! Make sure the wave direction convention is not nautial, which is not supported + IF (TRIM(Words(1)) == 'dconv:' .AND. TRIM(Words(2)) == 'naut') THEN + CALL SetErrStat( ErrID_Fatal, 'Nautical (naut) convention for wave direction is not supported. Must use cartesian (cart) convention.', ErrStat, ErrMsg, RoutineName) + CALL CleanUpError() + RETURN + END IF + + ! Override WaveTMax from SeaState input with the "duration" specified in the SEA file header if available + IF (TRIM(Words(1)) == 'duration: ') THEN + CALL ReadRealNumberFromString( Words(2), RealRead, StrRead, IsRealNum, ErrStatTmp, ErrMsgTmp, TmpIOErrStat ) + IF ( IsRealNum ) THEN + InitInp%WaveTMax = RealRead + CALL WrScr1(' WaveTMax overriden based on "' //TRIM(WaveCompData%FileName)// '" to ' // TRIM(Num2Lstr(InitInp%WaveTMax)) // ' sec.' ) + END IF + END IF + END DO + + ELSE + UseSEAFormat = .FALSE. + CALL WrScr1 ( ' Reading "'//TRIM(InitInp%WvKinFile)//'" following the OpenFAST format: Wave Angular Frequency (rad/s), Wave Height (m), Wave Direction (deg), Wave Phase (deg).' ) + END IF + REWIND( WaveCompUnit ) + + ! Check that we read in four columns + IF ( NumDataColumns /= 4_IntKi ) THEN + CALL SetErrStat( ErrID_Fatal, ' Wave component files should contain four columns of data: (angular) frequency, wave height/amplitude, wave direction, wave phase. '// & + 'Found '//TRIM(Num2LStr(NumDataColumns))//' of data in "'//TRIM(WaveCompData%FileName)//'".', ErrStat, ErrMsg, RoutineName) + CALL CleanUpError() + RETURN + END IF + + ! Compute the frequency step for incident wave calculations. + WaveDOmega = TwoPi/InitInp%WaveTMax + + !-------------------------------------------------- + ! Read in the data + !-------------------------------------------------- + + ! Allocate the array to store the wave components + ALLOCATE ( WaveCompData%WaveAngFreq(WaveCompData%NCompWave), STAT = ErrStatTmp ) + IF ( ErrStatTmp /= 0 ) THEN + CALL SetErrStat( ErrID_Fatal, 'Error allocating space for user WaveAngFreq array.', ErrStat, ErrMsg, RoutineName ) + CALL CleanUpError() + RETURN + END IF + + ALLOCATE ( WaveCompData%WaveAmp(WaveCompData%NCompWave), STAT = ErrStatTmp ) + IF ( ErrStatTmp /= 0 ) THEN + CALL SetErrStat( ErrID_Fatal, 'Error allocating space for user WaveAmp array.', ErrStat, ErrMsg, RoutineName ) + CALL CleanUpError() + RETURN + END IF + + ALLOCATE ( WaveCompData%WaveDir(WaveCompData%NCompWave), STAT = ErrStatTmp ) + IF ( ErrStatTmp /= 0 ) THEN + CALL SetErrStat( ErrID_Fatal, 'Error allocating space for user WaveDir array.', ErrStat, ErrMsg, RoutineName ) + CALL CleanUpError() + RETURN + END IF + + ALLOCATE ( WaveCompData%WavePhase(WaveCompData%NCompWave), STAT = ErrStatTmp ) + IF ( ErrStatTmp /= 0 ) THEN + CALL SetErrStat( ErrID_Fatal, 'Error allocating space for user WavePhase array.', ErrStat, ErrMsg, RoutineName ) + CALL CleanUpError() + RETURN + END IF + + ! Read and discard the header lines + DO I=1,NumHeaderLines + CALL ReadLine( WaveCompUnit, '', TextLine, LineLen, ErrStatTmp ) + ENDDO + + + ! Read in all the data + DO I=1,WaveCompData%NCompWave + CALL ReadAry( WaveCompUnit, WaveCompData%FileName, TmpWaveCompRow(1:4), 4, 'TmpWaveCompRow','Temporary variable holding the wave component information', & + ErrStatTmp,ErrMsgTmp ) + IF ( ErrStatTmp /= 0 ) THEN + CALL SetErrStat( ErrID_Fatal, 'Error in reading in value from the file: line number '//TRIM(Num2LStr(I))//'. Expecting a total of '// & + TRIM(Num2LStr(WaveCompData%NCompWave))//' rows of data.', ErrStat, ErrMsg, RoutineName ) + CALL CleanUpError() + RETURN + END IF + + WaveAngFreq = TmpWaveCompRow(1) + IF (UseSEAFormat) THEN + WaveAngFreq = TwoPi * WaveAngFreq + END IF + + ! Check if the frequency is valid + OmegaRatio = WaveAngFreq/WaveDOmega + IF (ABS(OmegaRatio - REAL(NINT(OmegaRatio),SiKi))>WaveDOmega_RelTol) THEN + CALL SetErrStat( ErrID_Fatal, 'The wave frequency on line number '//TRIM(Num2LStr(I))//' is not an integer multiple of the frequency resolution given by 1/WaveTMax.', ErrStat, ErrMsg, RoutineName ) + CALL CleanUpError() + RETURN + ELSE IF (WaveAngFreq <= 0.0_ReKi) THEN + CALL SetErrStat( ErrID_Fatal, 'The wave frequency on line number '//TRIM(Num2LStr(I))//' is less than or equal to zero. All frequency must be positive.', ErrStat, ErrMsg, RoutineName ) + CALL CleanUpError() + RETURN + END IF + + ! Copy the data to the appropriate places + IF (UseSEAFormat) THEN ! SEA format - Frequency (Hz), Amplitude (m), Direction (rad), Phase (rad) + WaveCompData%WaveAngFreq(I) = TmpWaveCompRow(1) * TwoPi ! Convert to angular frequency + WaveCompData%WaveAmp(I) = TmpWaveCompRow(2) ! Already wave amplitude + WaveCompData%WaveDir(I) = TmpWaveCompRow(3) * 180_ReKi/PI ! Convert to degrees + WaveCompData%WavePhase(I) = TmpWaveCompRow(4) ! Aleady in radians + ELSE ! OpenFAST format - Angular Frequency (rad/s), Wave Height (m), Direction (deg), Phase (deg) + WaveCompData%WaveAngFreq(I) = TmpWaveCompRow(1) ! Already angular frequency + WaveCompData%WaveAmp(I) = TmpWaveCompRow(2) * 0.5_ReKi ! Convert wave height to wave amplitude + WaveCompData%WaveDir(I) = TmpWaveCompRow(3) ! Already in degrees + WaveCompData%WavePhase(I) = TmpWaveCompRow(4) * PI/180_ReKi ! Convert to radians + END IF + + ENDDO + + CALL WrScr( ' Read in '//TRIM(Num2LStr(I))//' lines of wave component data from '//TRIM(WaveCompData%FileName)//'.' ) + + + CLOSE( WaveCompUnit ) + + CONTAINS + + SUBROUTINE CleanUpError + + CLOSE ( WaveCompUnit ) + + IF (ALLOCATED( WaveCompData%WaveAngFreq )) DEALLOCATE( WaveCompData%WaveAngFreq, STAT=ErrStatTmp) + IF (ALLOCATED( WaveCompData%WaveAmp )) DEALLOCATE( WaveCompData%WaveAmp, STAT=ErrStatTmp) + IF (ALLOCATED( WaveCompData%WaveDir )) DEALLOCATE( WaveCompData%WaveDir, STAT=ErrStatTmp) + IF (ALLOCATED( WaveCompData%WavePhase )) DEALLOCATE( WaveCompData%WavePhase, STAT=ErrStatTmp) + + END SUBROUTINE CleanUpError +END SUBROUTINE WaveComp_ReadFile + + +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine initializes the wave kinematics based a set of user-supplied wave frequency components +!! +!! NOTE: WaveDT in file must match given WaveDT in HydroDyn input file +!! Final timestep must match given WaveTMax in HydroDyn input file +!! NOTE: Wave frequency cutoffs can are applied to the read in wave elevation time series +!! +SUBROUTINE UserWaveComponents_Init ( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) +!---------------------------------------------------------------------------------------------------------------------------------- + TYPE(Waves_InitInputType), INTENT(INOUT) :: InitInp !< Input data for initialization routine + TYPE(Waves_InitOutputType), INTENT(INOUT) :: InitOut !< Initialization outputs + TYPE(SeaSt_WaveFieldType), INTENT(INOUT) :: WaveField !< Initialization outputs + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + ! Local Variables + TYPE(WaveCompInputDataFile) :: WaveCompData !< Wave elevation file data after changing NStepWave + REAL(SiKi) :: MaxWaveAngFreq !< Maximum wave angular frequency in the user wave component file + INTEGER(IntKi) :: I,J !< Generic counter + LOGICAL, ALLOCATABLE :: IsSpecified(:) !< If frequency component is already specified + + ! Temporary error handling variables + INTEGER(IntKi) :: ErrStatTmp !< Temporarary error status for procesing + CHARACTER(ErrMsgLen) :: ErrMsgTmp !< Temporary error message for processing + CHARACTER(*), PARAMETER :: RoutineName = 'UserWaveComponents_Init' + + ! set error status information + ErrStat = ErrID_None + ErrMsg = '' + + ! Statement to user + CALL WrScr1 ( ' Reading in wave component data from wave kinematics files with root name "'//TRIM(InitInp%WvKinFile)//'".' ) + + ! Read in the wave component data ! NOTE THAT THIS OVERWRITES InitInp%WaveTMax + CALL WaveComp_ReadFile (InitInp, WaveField%WaveDOmega, WaveCompData, ErrStatTmp, ErrMsgTmp ) + CALL SetErrStat(ErrStatTmp,ErrMsgTmp,ErrStat,ErrMsg,RoutineName) + IF ( ErrStat >= AbortErrLev ) THEN + CALL CleanUp() + RETURN + END IF + + !>>>>>> COMPUTE INITOUT SCALARS WaveField%NStepWave, WaveField%NStepWave2, InitOut%WaveTMax, and InitOut%WaveDOmega for WAVEMOD = 7 + MaxWaveAngFreq = MAXVAL(WaveCompData%WaveAngFreq) + ! NStepWave2 should be large enough to accommodate the highest user frequency component and + ! produce a time step no larger than the user WaveDT. + WaveField%NStepWave2 = MAX( NINT(MaxWaveAngFreq / WaveField%WaveDOmega) + 1_IntKi, & + CEILING(TwoPi/(InitInp%WaveDt*WaveField%WaveDOmega)) ) + WaveField%NStepWave2 = PSF ( WaveField%NStepWave2, 9 ) ! Make sure NStepWave2 is a product of small factors (PSF) greater or equal to what's required by the user input + WaveField%NStepWave = WaveField%NStepWave2 * 2_IntKi ! NStepWave is guaranteed to be even + InitOut%WaveTMax = InitInp%WaveTMax ! Copy over WaveTMax. + + ! Note that InitOut%WaveDOmega is computed in WaveComp_ReadFile: + !InitOut%WaveDOmega = TwoPi/InitInp%WaveTMax + + + !BJJ: Note that this is changing an InitInp value. This seems dangerous... check that this isn't an issue elsewhere + InitInp%WaveDT = InitOut%WaveTMax / WaveField%NStepWave ! Update the value of WaveDT based on the value needed for NStepWave. + CALL WrScr1 (' Setting WaveDT to ' // TRIM(Num2Lstr(InitInp%WaveDt)) // ' sec.') + + + ! >>> Allocate and initialize (set to 0) InitOut arrays + call Initial_InitOut_Arrays(InitOut, WaveField, InitInp, InitInp%WaveDT, ErrStatTmp, ErrMsgTmp); CALL SetErrStat(ErrStatTmp,ErrMsgTmp, ErrStat,ErrMsg,RoutineName) + !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< + + ALLOCATE ( IsSpecified( 0:WaveField%NStepWave2 ), STAT = ErrStatTmp) + IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array IsSpecified.',ErrStat,ErrMsg,RoutineName) + + ! Now check if all the allocations worked properly + IF ( ErrStat >= AbortErrLev ) THEN + CALL CleanUp() + RETURN + END IF + + ! Set the values + IsSpecified(:) = .FALSE. + + ! Copy the wave frequency component information to the InitOut%WaveElevC0 array + DO I=1,WaveCompData%NCompWave + J = NINT(WaveCompData%WaveAngFreq(I)/WaveField%WaveDOmega) + IF ( .NOT. IsSpecified(J) ) THEN + IsSpecified(J) = .TRUE. + WaveField%WaveElevC0(1,J) = WaveCompData%WaveAmp(I) * COS(WaveCompData%WavePhase(I)) * WaveField%NStepWave2 + WaveField%WaveElevC0(2,J) = WaveCompData%WaveAmp(I) * SIN(WaveCompData%WavePhase(I)) * WaveField%NStepWave2 + WaveField%WaveDirArr(J) = WaveCompData%WaveDir(I) + ELSE + CALL SetErrStat(ErrID_Fatal,'Wave component with angular frequency ' //TRIM( Num2Lstr( WaveCompData%WaveAngFreq(I) ) )// & + ' is listed twice in ' //TRIM(InitInp%WvKinFile)// '.',ErrStat,ErrMsg,RoutineName) + CALL CleanUp() + RETURN + END IF + END DO + ! Make sure the DC and Nyquist components are zero - should be redundant + WaveField%WaveElevC0(:,0 ) = 0.0_SiKi + WaveField%WaveElevC0(:,WaveField%NStepWave2) = 0.0_SiKi + + CALL CleanUp() + + CONTAINS + + SUBROUTINE CleanUp + + IF (ALLOCATED( WaveCompData%WaveAngFreq )) DEALLOCATE( WaveCompData%WaveAngFreq, STAT=ErrStatTmp) + IF (ALLOCATED( WaveCompData%WaveAmp )) DEALLOCATE( WaveCompData%WaveAmp, STAT=ErrStatTmp) + IF (ALLOCATED( WaveCompData%WaveDir )) DEALLOCATE( WaveCompData%WaveDir, STAT=ErrStatTmp) + IF (ALLOCATED( WaveCompData%WavePhase )) DEALLOCATE( WaveCompData%WavePhase, STAT=ErrStatTmp) + IF (ALLOCATED( IsSpecified )) DEALLOCATE( IsSpecified, STAT=ErrStatTmp) + + END SUBROUTINE CleanUp + +END SUBROUTINE UserWaveComponents_Init + + + +!----------------------------------------------------------------------------------------------------------------------! +! ! +! Shared Private Utility Functions and Subroutines ! +! ! +!----------------------------------------------------------------------------------------------------------------------! + +!------------------------------------------------------------------------------------------------------------------------------- +!> This subroutine looks at a file that has been opened and finds out how many header lines there are, how many periods +!! (frequencies) there are (first only if there are paired periods for second order), 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 the file header lines. +!! 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, Filename, NumDataColumns, NumDataLines, NumHeaderLines, ErrStat, ErrMsg) + + IMPLICIT NONE + + ! Passed variables + INTEGER(IntKi), INTENT(IN ) :: UnitDataFile !< Unit number of the file we are looking at. + CHARACTER(*), INTENT(IN ) :: Filename !< 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. + 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(MaxFileInfoLineLen*4) :: TextLine !< One line of text read from the file + INTEGER(IntKi) :: LineLen !< The length of the line read in + CHARACTER(MaxFileInfoLineLen) :: StrRead !< String containing the first word read in + REAL(SiKi) :: RealRead !< Returns value of the number (if there was one), or NaN (as set by NWTC_Num) if there wasn't + CHARACTER(24) :: Words(20) !< Array of words we extract from a line. We shouldn't have more than 20. + INTEGER(IntKi) :: i !< simple integer counter + 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 + CHARACTER(*), PARAMETER :: RoutineName = 'GetFileLength' + + ! 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, SIZE(Words), NumWords ) + + !> Now cycle through the first 'NumWords' of non-empty values stored in 'Words'. Words should contain + !! everything that is on the line. The subroutine ReadRealNumberFromString will set a flag 'IsRealNum' + !! when the value in Words(i) can be read as a real(SiKi). '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. + END IF + END DO + + !> 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(FileName)// & + ' when real numbers were expected. There may be a problem with the file.', ErrStat, ErrMsg, RoutineName) + IF ( ErrStat >= AbortErrLev ) THEN + RETURN + END IF + ELSE + NumHeaderLines = NumHeaderLines + 1 + END IF + 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 data file: '//TRIM(Filename)//'.'// & + ' 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 + END IF + END IF + END IF + END IF + END DO + 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(SiKi), 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(ErrMsg)//NewLine + ErrSTat = ErrID_Severe + END IF + + 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(SiKi), 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. + END IF + + RETURN +END SUBROUTINE ReadRealNumber + +END MODULE UserWaves diff --git a/modules/seastate/src/Waves.f90 b/modules/seastate/src/Waves.f90 new file mode 100644 index 0000000000..405b35e2ab --- /dev/null +++ b/modules/seastate/src/Waves.f90 @@ -0,0 +1,2289 @@ +!********************************************************************************************************************************** +! The Waves and Waves_Types modules make up a template for creating user-defined calculations in the FAST Modularization +! Framework. Waves_Types will be auto-generated based on a description of the variables for the module. +!.................................................................................................................................. +! LICENSING +! Copyright (C) 2013-2015 National Renewable Energy Laboratory +! +! This file is part of Waves. +! +! 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 Waves + + USE Waves_Types + USE UserWaves + USE SeaSt_WaveField_Types + USE NWTC_Library + USE NWTC_FFTPACK + USE NWTC_RandomNumber + + IMPLICIT NONE + + PRIVATE + + TYPE(ProgDesc), PARAMETER :: Waves_ProgDesc = ProgDesc( 'Waves', '', '' ) + + COMPLEX(SiKi), PARAMETER, PUBLIC :: ImagNmbr = (0.0_SiKi,1.0_SiKi) ! The imaginary number, SQRT(-1.0) + + + ! ..... Public Subroutines ................................................................................................... + PUBLIC :: WavePkShpDefault ! Return the default value of the peak shape parameter of the incident wave spectrum + PUBLIC :: Waves_Init ! Initialization routine + + + PRIVATE:: WheelerStretching ! This FUNCTION applies the principle of Wheeler stretching to (1-Forward) find the elevation where the wave kinematics are to be applied using Wheeler stretching or (2-Backword) + PRIVATE:: BoxMuller + PRIVATE:: JONSWAP + PUBLIC :: WaveNumber + PRIVATE:: UserWaveSpctrm + PRIVATE:: StillWaterWaves_Init + PRIVATE:: VariousWaves_Init + ! PRIVATE:: WhiteNoiseWaves_Init + +CONTAINS + +!======================================================================= + + FUNCTION WavePkShpDefault ( WaveMod, Hs, Tp ) + + + ! This FUNCTION is used to return the default value of the peak shape + ! parameter of the incident wave spectrum, conditioned on significant + ! wave height and peak spectral period. + ! + ! There are several different versions of the JONSWAP spectrum + ! formula. This version is based on the one documented in the + ! IEC61400-3 wind turbine design standard for offshore wind turbines. + + + + IMPLICIT NONE + + + ! Passed Variables: + INTEGER(IntKi), INTENT(IN ) :: WaveMod + REAL(SiKi), INTENT(IN ) :: Hs ! Significant wave height (meters) + REAL(SiKi), INTENT(IN ) :: Tp ! Peak spectral period (sec) + REAL(SiKi) :: WavePkShpDefault ! This function = default value of the peak shape parameter of the incident wave spectrum conditioned on significant wave height and peak spectral period (-) + + + ! Local Variables: + + REAL(SiKi) :: TpOvrSqrtHs ! = Tp/SQRT(Hs) (s/SQRT(m)) + + + + ! Compute the default peak shape parameter of the incident wave spectrum, + ! conditioned on significant wave height and peak spectral period: + + if ( WaveMod == WaveMod_JONSWAP ) then + + if ( Hs <= 0.0_SiKi ) then + + WavePkShpDefault = 1.0 + + else + + TpOvrSqrtHs = Tp/SQRT(Hs) + + IF ( TpOvrSqrtHs <= 3.6 ) THEN + WavePkShpDefault = 5.0 + ELSEIF ( TpOvrSqrtHs >= 5.0 ) THEN + WavePkShpDefault = 1.0 + ELSE + WavePkShpDefault = EXP( 5.75 - 1.15*TpOvrSqrtHs ) + END IF + end if + + else + + WavePkShpDefault = 1.0 + + end if + + + + RETURN + END FUNCTION WavePkShpDefault + +!======================================================================= + FUNCTION BoxMuller ( RNGType, NDAmp, Phase ) + + ! This FUNCTION uses the Box-Muller method to turn two uniformly + ! distributed randoms into two unit normal randoms, which are + ! returned as real and imaginary components. + + IMPLICIT NONE + + COMPLEX(SiKi) :: BoxMuller ! This function + + ! Passed Variables: + + INTEGER, INTENT(IN) :: RNGType + LOGICAL, INTENT(IN) :: NDAmp ! Flag for normally-distributed amplitudes + REAL(SiKi), INTENT(IN), OPTIONAL :: Phase ! Optional phase to override random phase (radians) + + ! Local Variables: + + REAL(SiKi) :: C1 ! Intermediate variable + REAL(SiKi) :: C2 ! Intermediate variable + REAL(SiKi) :: U1(1) ! First uniformly distributed random + REAL(SiKi) :: U2(1) ! Second uniformly distributed random + + ! Compute the two uniformly distributed randoms: + ! NOTE: The first random, U1, cannot be zero else the LOG() function + ! below will blow up; there is no restriction on the value of the + ! second random, U2. + + U1 = 0.0 + DO WHILE ( U1(1) == 0.0 ) + CALL UniformRandomNumbers(RNGType, U1) + END DO + CALL UniformRandomNumbers(RNGType, U2) + + ! Compute intermediate variables: + + IF ( NDAmp ) THEN ! Normally-distributed amplitudes + C1 = SQRT( -2.0*LOG(U1(1)) ) + ELSE ! Constant amplitudes (ignore U1); therefore, C1 = SQRT( 2.0 ) = MEAN( SQRT( -2.0*LOG(U1) ) for a uniform distribution of U1 between 0 and 1 + C1 = SQRT( 2.0 ) + END IF + + IF ( PRESENT( Phase ) ) THEN ! Specified phase to replace random phase (ignore U2) + C2 = Phase + ELSE ! Uniformly-distributed phase + C2 = TwoPi*U2(1) + END IF + + ! Compute the unit normal randoms: + + BoxMuller = CMPLX( C1*COS(C2), C1*SIN(C2) ) + + RETURN + END FUNCTION BoxMuller +!======================================================================= + FUNCTION JONSWAP ( Omega, Hs, Tp, Gamma ) + + + ! This FUNCTION computes the JOint North Sea WAve Project + ! (JONSWAP) representation of the one-sided power spectral density + ! or wave spectrum given the frequency, Omega, peak shape + ! parameter, Gamma, significant wave height, Hs, and peak spectral + ! period, Tp, as inputs. If the value of Gamma is 1.0, the + ! Pierson-Moskowitz wave spectrum is returned. + ! + ! There are several different versions of the JONSWAP spectrum + ! formula. This version is based on the one documented in the + ! IEC61400-3 wind turbine design standard for offshore wind + ! turbines. + + + + + IMPLICIT NONE + + + ! Passed Variables: + + REAL(SiKi), INTENT(IN ) :: Gamma ! Peak shape parameter (-) + REAL(SiKi), INTENT(IN ) :: Hs ! Significant wave height (meters) + REAL(SiKi) :: JONSWAP ! This function = JONSWAP wave spectrum, S (m^2/(rad/s)) + REAL(SiKi), INTENT(IN ) :: Omega ! Wave frequency (rad/s) + REAL(SiKi), INTENT(IN ) :: Tp ! Peak spectral period (sec) + + + ! Local Variables: + + REAL(SiKi) :: Alpha ! Exponent on Gamma used in the spectral formulation (-) + REAL(SiKi) :: C ! Normalising factor used in the spectral formulation (-) + REAL(SiKi) :: f ! Wave frequency (Hz) + REAL(SiKi) :: fp ! Peak spectral frequency (Hz) + REAL(SiKi) :: fpOvrf4 ! (fp/f)^4 + REAL(SiKi) :: Sigma ! Scaling factor used in the spectral formulation (-) + + REAL(SiKi) :: Inv2Pi = 0.15915494 + + ! Compute the JONSWAP wave spectrum, unless Omega is zero, in which case, + ! return zero: + + IF ( EqualRealNos(Omega, 0.0_SiKi) ) THEN ! When .TRUE., the formulation below is ill-conditioned; thus, the known value of zero is returned. + + + JONSWAP = 0.0 + + + ELSE ! Omega > 0.0; forumulate the JONSWAP spectrum. + + + ! Compute the wave frequency and peak spectral frequency in Hz: + + f = Inv2Pi*Omega + fp = 1/Tp + fpOvrf4 = (fp/f)**4 + + + ! Compute the normalising factor: + + C = 1.0 - ( 0.287*LOG(GAMMA) ) + + + ! Compute Alpha: + + IF ( f <= fp ) THEN + Sigma = 0.07 + ELSE + Sigma = 0.09 + END IF + +!bjj: Alpha = EXP( ( -0.5*( ( (f/fp) - 1.0 )/Sigma )**2 ) ) + Alpha = EXP( ( -0.5*( ( (f*Tp) - 1.0 )/Sigma )**2 ) ) !this works even if Tp is 0 (but using f/fp doesn't) + + + ! Compute the wave spectrum: + + JONSWAP = Inv2Pi*C*( 0.3125*Hs*Hs*fpOvrf4/f )*EXP( ( -1.25*fpOvrf4 ) )*( GAMMA**Alpha ) + + + END IF + + + + RETURN + END FUNCTION JONSWAP + !======================================================================= +!JASON: MOVE THIS USER-DEFINED ROUTINE (UserWaveSpctrm) TO THE UserSubs.f90 OF HydroDyn WHEN THE PLATFORM LOADING FUNCTIONALITY HAS BEEN DOCUMENTED!!!!! + SUBROUTINE UserWaveSpctrm ( Omega, WaveDir, DirRoot, WaveS1Sdd ) + + + ! This is a dummy routine for holding the place of a user-specified + ! wave spectrum. Modify this code to create your own spectrum. + + + + IMPLICIT NONE + + + ! Passed Variables: + + REAL(SiKi), INTENT(IN ) :: Omega ! Wave frequency, rad/s. + REAL(SiKi), INTENT(IN ) :: WaveDir ! Incident wave propagation heading direction, degrees + REAL(SiKi), INTENT(OUT) :: WaveS1Sdd ! One-sided power spectral density of the wave spectrum per unit time for the current frequency component and heading direction, m^2/(rad/s). + + CHARACTER(*), 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. + + + + WaveS1Sdd = 0.0 + + + + RETURN + END SUBROUTINE UserWaveSpctrm + !======================================================================= + FUNCTION WaveNumber ( Omega, g, h ) + + + ! This FUNCTION solves the finite depth dispersion relationship: + ! + ! k*tanh(k*h)=(Omega^2)/g + ! + ! for k, the wavenumber (WaveNumber) given the frequency, Omega, + ! gravitational constant, g, and water depth, h, as inputs. A + ! high order initial guess is used in conjunction with a quadratic + ! Newton's method for the solution with seven significant digits + ! accuracy using only one iteration pass. The method is due to + ! Professor J.N. Newman of M.I.T. as found in routine EIGVAL of + ! the SWIM-MOTION-LINES (SML) software package in source file + ! Solve.f of the SWIM module. + + + + IMPLICIT NONE + + + ! Passed Variables: + + REAL(ReKi), INTENT(IN ) :: g ! Gravitational acceleration (m/s^2) + REAL(ReKi), INTENT(IN ) :: h ! Water depth (meters) + REAL(SiKi), INTENT(IN ) :: Omega ! Wave frequency (rad/s) + REAL(SiKi) :: WaveNumber ! This function = wavenumber, k (1/m) + + + ! Local Variables: + + REAL(SiKi) :: A ! A temporary variable used in the solution. + REAL(SiKi) :: B ! A temporary variable used in the solution. + REAL(SiKi) :: C ! A temporary variable used in the solution. + REAL(SiKi) :: C2 ! A temporary variable used in the solution. + REAL(SiKi) :: CC ! A temporary variable used in the solution. + REAL(SiKi) :: E2 ! A temporary variable used in the solution. + REAL(SiKi) :: X0 ! A temporary variable used in the solution. + + + + ! Compute the wavenumber, unless Omega is zero, in which case, return + ! zero: + + IF ( Omega == 0.0 ) THEN ! When .TRUE., the formulation below is ill-conditioned; thus, the known value of zero is returned. + + + WaveNumber = 0.0 + + + ELSE ! Omega > 0.0; solve for the wavenumber as usual. + + + C = Omega*Omega*REAL(h,SiKi)/REAL(g,SiKi) + CC = C*C + + + ! Find X0: + + IF ( C <= 2.0 ) THEN + + X0 = SQRT(C)*( 1.0 + C*( 0.169 + (0.031*C) ) ) + + ELSE + + E2 = EXP(-2.0*C) + + X0 = C*( 1.0 + ( E2*( 2.0 - (12.0*E2) ) ) ) + + END IF + + + ! Find the WaveNumber: + + IF ( C <= 4.8 ) THEN + + C2 = CC - X0*X0 + A = 1.0/( C - C2 ) + B = A*( ( 0.5*LOG( ( X0 + C )/( X0 - C ) ) ) - X0 ) + + WaveNumber = ( X0 - ( B*C2*( 1.0 + (A*B*C*X0) ) ) )/REAL(h,SiKi) + + ELSE + + WaveNumber = X0/REAL(h,SiKi) + + END IF + + + END IF + + + + RETURN + END FUNCTION WaveNumber + + !======================================================================= + FUNCTION COSHNumOvrCOSHDen ( k, h, z ) + + + ! This FUNCTION computes the shallow water hyperbolic numerator + ! over denominator term in the wave kinematics expressions: + ! + ! COSH( k*( z + h ) )/COSH( k*h ) + ! + ! given the wave number, k, water depth, h, and elevation z, as + ! inputs. + + IMPLICIT NONE + + + ! Passed Variables: + + REAL(SiKi) :: COSHNumOvrCOSHDen ! This function = COSH( k*( z + h ) )/COSH( k*h ) (-) + REAL(ReKi), INTENT(IN ) :: h ! Water depth ( h > 0 ) (meters) + REAL(SiKi), INTENT(IN ) :: k ! Wave number ( k >= 0 ) (1/m) + REAL(SiKi), INTENT(IN ) :: z ! Elevation (-h <= z <= 0 ) (meters) + + + + ! Compute the hyperbolic numerator over denominator: + + IF ( k*h > 89.4_SiKi ) THEN ! When .TRUE., the shallow water formulation will trigger a floating point overflow error; however, COSH( k*( z + h ) )/COSH( k*h ) = EXP( k*z ) + EXP( -k*( z + 2*h ) ) for large k*h. This equals the deep water formulation, EXP( k*z ), except near z = -h, because h > 14.23*wavelength (since k = 2*Pi/wavelength) in this case. + + COSHNumOvrCOSHDen = EXP( k*z ) + EXP( -k*( z + 2.0_SiKi*REAL(h,SiKi) ) ) + + ELSE ! 0 < k*h <= 89.4; use the shallow water formulation. + + COSHNumOvrCOSHDen =REAL( COSH( k*( z + REAL(h,SiKi) ) ),R8Ki)/COSH( k*REAL(h,SiKi) ) + + END IF + + + + RETURN + END FUNCTION COSHNumOvrCOSHDen +!======================================================================= + FUNCTION COSHNumOvrSINHDen ( k, h, z ) + + + ! This FUNCTION computes the shallow water hyperbolic numerator + ! over denominator term in the wave kinematics expressions: + ! + ! COSH( k*( z + h ) )/SINH( k*h ) + ! + ! given the wave number, k, water depth, h, and elevation z, as + ! inputs. + + + + IMPLICIT NONE + + + ! Passed Variables: + + REAL(SiKi) :: COSHNumOvrSINHDen ! This function = COSH( k*( z + h ) )/SINH( k*h ) (-) + REAL(ReKi), INTENT(IN ) :: h ! Water depth ( h > 0 ) (meters) + REAL(SiKi), INTENT(IN ) :: k ! Wave number ( k >= 0 ) (1/m) + REAL(SiKi), INTENT(IN ) :: z ! Elevation (-h <= z <= 0 ) (meters) + + + + ! Compute the hyperbolic numerator over denominator: + + + IF ( k < EPSILON(0.0_SiKi) ) THEN ! When .TRUE., the shallow water formulation is ill-conditioned; thus, HUGE(k) is returned to approximate the known value of infinity. + + COSHNumOvrSINHDen = HUGE( k ) + + ELSEIF ( k*REAL(h,SiKi) > 89.4_SiKi ) THEN ! When .TRUE., the shallow water formulation will trigger a floating point overflow error; however, COSH( k*( z + h ) )/SINH( k*h ) = EXP( k*z ) + EXP( -k*( z + 2*h ) ) for large k*h. This equals the deep water formulation, EXP( k*z ), except near z = -h, because h > 14.23*wavelength (since k = 2*Pi/wavelength) in this case. + + COSHNumOvrSINHDen = EXP( k*z ) + EXP( -k*( z + 2*REAL(h,SiKi) ) ) + + ELSE ! 0 < k*h <= 89.4; use the shallow water formulation. + + COSHNumOvrSINHDen = COSH( k*( z + REAL(h,SiKi) ) )/SINH( k*REAL(h,SiKi) ) + + END IF + + + + RETURN + END FUNCTION COSHNumOvrSINHDen +!======================================================================= + FUNCTION COTH ( X ) + + + ! This FUNCTION computes the hyperbolic cotangent, + ! COSH(X)/SINH(X). + + + USE Precision + + + IMPLICIT NONE + + + ! Passed Variables: + + REAL(SiKi) :: COTH ! This function = COSH( X )/SINH( X ) (-) + REAL(SiKi), INTENT(IN ) :: X ! The argument (-) + + + + ! Compute the hyperbolic cotangent: + + IF ( X == 0.0_SiKi ) THEN ! When .TRUE., the formulation below is ill-conditioned; thus, HUGE(X) is returned to approximate the known value of infinity. + + COTH = HUGE( X ) + + ELSE ! X /= 0.0; use the numerically-stable computation of COTH(X) by means of TANH(X). + + COTH = 1.0_SiKi/TANH( X ) ! = COSH( X )/SINH( X ) + + END IF + + + + RETURN + END FUNCTION COTH + + !======================================================================= + FUNCTION SINHNumOvrSINHDen ( k, h, z ) + + + ! This FUNCTION computes the shallow water hyperbolic numerator + ! over denominator term in the wave kinematics expressions: + ! + ! SINH( k*( z + h ) )/SINH( k*h ) + ! + ! given the wave number, k, water depth, h, and elevation z, as + ! inputs. + + + IMPLICIT NONE + + + ! Passed Variables: + + REAL(SiKi) :: SINHNumOvrSINHDen ! This function = SINH( k*( z + h ) )/SINH( k*h ) (-) + REAL(ReKi), INTENT(IN ) :: h ! Water depth ( h > 0 ) (meters) + REAL(SiKi), INTENT(IN ) :: k ! Wave number ( k >= 0 ) (1/m) + REAL(SiKi), INTENT(IN ) :: z ! Elevation (-h <= z <= 0 ) (meters) + + + + ! Compute the hyperbolic numerator over denominator: + + IF ( k == 0.0_SiKi ) THEN ! When .TRUE., the shallow water formulation is ill-conditioned; thus, the known value of unity is returned. + + SINHNumOvrSINHDen = 1.0 + + ELSEIF ( k*REAL(h,SiKi) > 89.4_SiKi ) THEN ! When .TRUE., the shallow water formulation will trigger a floating point overflow error; however, SINH( k*( z + h ) )/SINH( k*h ) = EXP( k*z ) - EXP( -k*( z + 2*h ) ) for large k*h. This equals the deep water formulation, EXP( k*z ), except near z = -h, because h > 14.23*wavelength (since k = 2*Pi/wavelength) in this case. + + SINHNumOvrSINHDen = EXP( k*z ) - EXP( -k*( z + 2.0_SiKi*h ) ) + + ELSE ! 0 < k*h <= 89.4; use the shallow water formulation. + + SINHNumOvrSINHDen = SINH( k*( z + REAL(h,SiKi) ) )/SINH( k*REAL(h,SiKi) ) + + END IF + + + + RETURN + END FUNCTION SINHNumOvrSINHDen + + +!---------------------------------------------------------------------------------------------------------------------------------- +SUBROUTINE StillWaterWaves_Init ( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) +! This routine initializes the waves data for WaveMod = 0 , or still water waves option +!---------------------------------------------------------------------------------------------------------------------------------- + + + TYPE(Waves_InitInputType), INTENT(IN ) :: InitInp ! Input data for initialization routine + TYPE(Waves_InitOutputType), INTENT(INOUT) :: InitOut ! Initialization output data + TYPE(SeaSt_WaveFieldType), INTENT(INOUT) :: WaveField ! SeaState wave field type containing the wave field data + 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, count ! Generic index + INTEGER(IntKi) :: ErrStatTmp ! Temporary error status + CHARACTER(ErrMsgLen) :: ErrMsgTmp ! Temporary error message + character(*), parameter :: RoutineName = 'StillWaterWaves_Init' + + ! Initialize ErrStat + + ErrStat = ErrID_None + ErrMsg = "" + + + ! Initialize everything to zero: + + !>>>>>> COMPUTE INITOUT SCALARS WaveField%NStepWave, WaveField%NStepWave2, InitOut%WaveTMax, and InitOut%WaveDOmega for WAVEMOD = 0 (WaveMod_None) + WaveField%NStepWave = 2 ! We must have at least two elements in order to interpolate later on + WaveField%NStepWave2 = 1 + InitOut%WaveTMax = InitInp%WaveTMax + WaveField%WaveDOmega = 0.0 + + ! >>> Allocate and initialize (set to 0) InitOut arrays + call Initial_InitOut_Arrays(InitOut, WaveField, InitInp, 1.0_DbKi, ErrStatTmp, ErrMsgTmp) + CALL SetErrStat(ErrStatTmp,ErrMsgTmp, ErrStat,ErrMsg,RoutineName) + IF ( ErrStat >= AbortErrLev ) RETURN + + + ! Add the current velocities to the wave velocities: + count = 0 + + !DO J = 1,InitInp%NWaveKinGrid ! Loop through all points where the incident wave kinematics will be computed + do k = 1, InitInp%NGrid(3) + do j = 1, InitInp%NGrid(2) + do i = 1, InitInp%NGrid(1) + count = count + 1 + WaveField%WaveVel(:,i,j,k,1) = InitInp%CurrVxi(count) ! xi-direction + WaveField%WaveVel(:,i,j,k,2) = InitInp%CurrVyi(count) ! yi-direction + end do + end do + end do + + ! END DO ! J - All points where the incident wave kinematics will be computed + +END SUBROUTINE StillWaterWaves_Init + + +!---------------------------------------------------------------------------------------------------------------------------------- +SUBROUTINE VariousWaves_Init ( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) +! Compute the wave kinematics and related information for Plane progressive (regular) wave, JONSWAP/Pierson-Moskowitz spectrum +! (irregular) wave, or user-defined spectrum (irregular) wave. +!---------------------------------------------------------------------------------------------------------------------------------- + + TYPE(Waves_InitInputType), INTENT(IN ) :: InitInp ! Input data for initialization routine + TYPE(Waves_InitOutputType), INTENT(INOUT) :: InitOut ! Output data + TYPE(SeaSt_WaveFieldType), INTENT(INOUT) :: WaveField ! SeaState wave field type containing the wave field data + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + + ! Local Variables + COMPLEX(SiKi) :: ImagOmega ! = ImagNmbr*Omega (rad/s) + COMPLEX(SiKi), ALLOCATABLE :: PWaveAccC0HxiPz0(:,:) ! Partial derivative of WaveAccC0Hxi(:) with respect to zi at zi = 0 (1/s^2) + COMPLEX(SiKi), ALLOCATABLE :: PWaveAccC0HyiPz0(:,:) ! Partial derivative of WaveAccC0Hyi(:) with respect to zi at zi = 0 (1/s^2) + COMPLEX(SiKi), ALLOCATABLE :: PWaveAccC0VPz0(:,:) ! Partial derivative of WaveAccC0V (:) with respect to zi at zi = 0 (1/s^2) + COMPLEX(SiKi), ALLOCATABLE :: PWaveDynPC0BPz0(:,:) ! Partial derivative of WaveDynPC0B (:) with respect to zi at zi = 0 (N/m ) + COMPLEX(SiKi), ALLOCATABLE :: PWaveVelC0HxiPz0(:,:) ! Partial derivative of WaveVelC0Hxi(:) with respect to zi at zi = 0 (1/s ) + COMPLEX(SiKi), ALLOCATABLE :: PWaveVelC0HyiPz0(:,:) ! Partial derivative of WaveVelC0Hyi(:) with respect to zi at zi = 0 (1/s ) + COMPLEX(SiKi), ALLOCATABLE :: PWaveVelC0VPz0(:,:) ! Partial derivative of WaveVelC0V (:) with respect to zi at zi = 0 (1/s ) + COMPLEX(SiKi), ALLOCATABLE :: WaveAccC0Hxi(:,:) ! Discrete Fourier transform of the instantaneous horizontal acceleration in x-direction of incident waves before applying stretching at the zi-coordinates for points (m/s^2) + COMPLEX(SiKi), ALLOCATABLE :: WaveAccC0Hyi(:,:) ! Discrete Fourier transform of the instantaneous horizontal acceleration in y-direction of incident waves before applying stretching at the zi-coordinates for points (m/s^2) + COMPLEX(SiKi), ALLOCATABLE :: WaveAccC0V(:,:) ! Discrete Fourier transform of the instantaneous vertical acceleration of incident waves before applying stretching at the zi-coordinates for points (m/s^2) + COMPLEX(SiKi), ALLOCATABLE :: WaveDynPC0(:,:) ! Discrete Fourier transform of the instantaneous dynamic pressure of incident waves before applying stretching at the zi-coordinates for points (N/m^2) + COMPLEX(SiKi), ALLOCATABLE :: WaveVelC0Hxi(:,:) ! Discrete Fourier transform of the instantaneous horizontal velocity of incident waves before applying stretching at the zi-coordinates for points (m/s) + COMPLEX(SiKi), ALLOCATABLE :: WaveVelC0Hyi(:,:) ! Discrete Fourier transform of the instantaneous horizontal velocity in x-direction of incident waves before applying stretching at the zi-coordinates for points (m/s) + COMPLEX(SiKi), ALLOCATABLE :: WaveVelC0V(:,:) ! Discrete Fourier transform of the instantaneous vertical velocity in y-direction of incident waves before applying stretching at the zi-coordinates for points (m/s) + + REAL(SiKi), ALLOCATABLE :: CosWaveDir(:) ! COS( WaveDirArr(I) ) -- Each wave frequency has a unique wave direction. + REAL(SiKi), ALLOCATABLE :: GHWaveAcc (:,:) ! Instantaneous acceleration of incident waves in the xi-(1), yi-(2), and zi-(3) directions, respectively, at each of the GHNWvDpth vertical locations in GH Bladed wave data files (m/s^2) + REAL(SiKi), ALLOCATABLE :: GHWaveDynP(: ) ! Instantaneous dynamic pressure of incident waves at each of the GHNWvDpth vertical locations in GH Bladed wave data files (N/m^2) + REAL(SiKi), ALLOCATABLE :: GHWaveVel (:,:) ! Instantaneous velocity of incident waves in the xi-(1), yi-(2), and zi-(3) directions, respectively, at each of the GHNWvDpth vertical locations in GH Bladed wave data files (m/s ) + REAL(SiKi), ALLOCATABLE :: GHWvDpth (:) ! Vertical locations in GH Bladed wave data files. + + REAL(SiKi), ALLOCATABLE :: PWaveAcc0HxiPz0(:,:) ! Partial derivative of WaveAcc0Hxi(:) with respect to zi at zi = 0 (1/s^2) + REAL(SiKi), ALLOCATABLE :: PWaveAcc0HyiPz0(:,:) ! Partial derivative of WaveAcc0Hyi(:) with respect to zi at zi = 0 (1/s^2) + REAL(SiKi), ALLOCATABLE :: PWaveAcc0VPz0 (:,:) ! Partial derivative of WaveAcc0V (:) with respect to zi at zi = 0 (1/s^2) + REAL(SiKi), ALLOCATABLE :: PWaveDynP0BPz0 (:,:) ! Partial derivative of WaveDynP0B (:) with respect to zi at zi = 0 (N/m ) + REAL(SiKi), ALLOCATABLE :: PWaveVel0HxiPz0(:,:) ! Partial derivative of WaveVel0Hxi(:) with respect to zi at zi = 0 (1/s ) + REAL(SiKi), ALLOCATABLE :: PWaveVel0HyiPz0(:,:) ! Partial derivative of WaveVel0Hyi(:) with respect to zi at zi = 0 (1/s ) + REAL(SiKi), ALLOCATABLE :: PWaveVel0VPz0 (:,:) ! Partial derivative of WaveVel0V (:) with respect to zi at zi = 0 (1/s ) + + REAL(SiKi), ALLOCATABLE :: SinWaveDir (:) ! SIN( WaveDirArr(I) ) + REAL(SiKi), ALLOCATABLE :: WaveAcc0Hxi (:,:) ! Instantaneous horizontal acceleration in x-direction of incident waves before applying stretching at the zi-coordinates for points (m/s^2) + REAL(SiKi), ALLOCATABLE :: WaveAcc0Hyi (:,:) ! Instantaneous horizontal acceleration in y-direction of incident waves before applying stretching at the zi-coordinates for points (m/s^2) + REAL(SiKi), ALLOCATABLE :: WaveAcc0V (:,:) ! Instantaneous vertical acceleration of incident waves before applying stretching at the zi-coordinates for points (m/s^2) + REAL(SiKi), ALLOCATABLE :: WaveDynP0B(:,:) ! Instantaneous dynamic pressure of incident waves before applying stretching at the zi-coordinates for points (N/m^2) + + COMPLEX(SiKi) :: WaveElevxiPrime0 + REAL(SiKi), ALLOCATABLE :: WaveKinzi0Prime(:) ! zi-coordinates for points where the incident wave kinematics will be computed before applying stretching; these are relative to the mean see level (meters) + INTEGER , ALLOCATABLE :: WaveKinPrimeMap(:) + REAL(SiKi) :: WaveNmbr ! Wavenumber of the current frequency component (1/meter) + REAL(SiKi), ALLOCATABLE :: WaveVel0Hxi (:,:) ! Instantaneous xi-direction velocity of incident waves before applying stretching at the zi-coordinates for points (m/s ) + REAL(SiKi), ALLOCATABLE :: WaveVel0Hyi (:,:) ! Instantaneous yi-direction velocity of incident waves before applying stretching at the zi-coordinates for points (m/s ) + REAL(SiKi), ALLOCATABLE :: WaveVel0V (:,:) ! Instantaneous vertical velocity of incident waves before applying stretching at the zi-coordinates for points (m/s ) + INTEGER :: I,J,K,count ! Generic index + INTEGER :: NWaveKin0Prime ! Number of points where the incident wave kinematics will be computed before applying stretching to the instantaneous free surface (-) + integer :: primeCount ! Counter for locations before applying stretching + COMPLEX(SiKi) :: tmpComplex ! A temporary varible to hold the complex value of the wave elevation before storing it into a REAL array + COMPLEX(SiKi),ALLOCATABLE :: tmpComplexArr(:) ! A temporary array (0:NStepWave2-1) for FFT use. + TYPE(FFT_DataType) :: FFT_Data ! the instance of the FFT module we're using + + REAL(SiKi), ALLOCATABLE :: WaveS1SddArr(:) !< One-sided power spectral density of the wave spectrum at all non-negative frequencies (m^2/(rad/s)) + REAL(SiKi), ALLOCATABLE :: OmegaArr(:) !< Array of all non-negative angular frequencies (rad/s) + + ! Variables for MacCamy-Fuchs model + REAL(SiKi) :: ka + REAL(SiKi) :: JPrime + REAL(SiKi) :: YPrime + REAL(SiKi) :: HPrime + REAL(SiKi) :: MCFC + COMPLEX(SiKi), ALLOCATABLE :: WaveAccC0HxiMCF(:,:) ! Discrete Fourier transform of the instantaneous horizontal acceleration in x-direction of incident waves before applying stretching at the zi-coordinates for points (m/s^2) + COMPLEX(SiKi), ALLOCATABLE :: WaveAccC0HyiMCF(:,:) ! Discrete Fourier transform of the instantaneous horizontal acceleration in y-direction of incident waves before applying stretching at the zi-coordinates for points (m/s^2) + COMPLEX(SiKi), ALLOCATABLE :: WaveAccC0VMCF(:,:) ! Discrete Fourier transform of the instantaneous vertical acceleration of incident waves before applying stretching at the zi-coordinates for points (m/s^2) + COMPLEX(SiKi), ALLOCATABLE :: PWaveAccC0HxiMCFPz0(:,:) ! Discrete Fourier transform of the instantaneous horizontal acceleration in x-direction of incident waves before applying stretching at the zi-coordinates for points (m/s^2) + COMPLEX(SiKi), ALLOCATABLE :: PWaveAccC0HyiMCFPz0(:,:) ! Discrete Fourier transform of the instantaneous horizontal acceleration in y-direction of incident waves before applying stretching at the zi-coordinates for points (m/s^2) + COMPLEX(SiKi), ALLOCATABLE :: PWaveAccC0VMCFPz0(:,:) ! Discrete Fourier transform of the instantaneous vertical acceleration of incident waves before applying stretching at the zi-coordinates for points (m/s^2) + REAL(SiKi), ALLOCATABLE :: WaveAcc0HxiMCF(:,:) ! Discrete Fourier transform of the instantaneous horizontal acceleration in x-direction of incident waves before applying stretching at the zi-coordinates for points (m/s^2) + REAL(SiKi), ALLOCATABLE :: WaveAcc0HyiMCF(:,:) ! Discrete Fourier transform of the instantaneous horizontal acceleration in y-direction of incident waves before applying stretching at the zi-coordinates for points (m/s^2) + REAL(SiKi), ALLOCATABLE :: WaveAcc0VMCF(:,:) ! Discrete Fourier transform of the instantaneous vertical acceleration of incident waves before applying stretching at the zi-coordinates for points (m/s^2) + REAL(SiKi), ALLOCATABLE :: PWaveAcc0HxiMCFPz0(:,:) ! Discrete Fourier transform of the instantaneous horizontal acceleration in x-direction of incident waves before applying stretching at the zi-coordinates for points (m/s^2) + REAL(SiKi), ALLOCATABLE :: PWaveAcc0HyiMCFPz0(:,:) ! Discrete Fourier transform of the instantaneous horizontal acceleration in y-direction of incident waves before applying stretching at the zi-coordinates for points (m/s^2) + REAL(SiKi), ALLOCATABLE :: PWaveAcc0VMCFPz0(:,:) ! Discrete Fourier transform of the instantaneous vertical acceleration of incident waves before applying stretching at the zi-coordinates for points (m/s^2) + + + ! Variables for error handling + INTEGER(IntKi) :: ErrStatTmp !< Temporary error status + CHARACTER(ErrMsgLen) :: ErrMsgTmp !< Temporary error message + CHARACTER(*), PARAMETER :: RoutineName = 'VariousWaves_Init' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" + + ! Tell our users what is about to happen that may take a while: + CALL WrScr ( ' Generating incident wave kinematics and current time history.' ) + + + + ! Determine the number of, NWaveKin0Prime, and the zi-coordinates for, + ! WaveKinzi0Prime(:), points where the incident wave kinematics will be + ! computed before applying stretching to the instantaneous free surface. + ! The locations are relative to the mean see level. + + NWaveKin0Prime = 0 + DO J = 1,InitInp%NWaveKinGrid ! Loop through all mesh points where the incident wave kinematics will be computed + ! NOTE: We test to 0 instead of MSL2SWL because the locations of WaveKinGridzi and EffWtrDpth have already been adjusted using MSL2SWL + IF ( InitInp%WaveKinGridzi(J) >= -WaveField%EffWtrDpth .AND. InitInp%WaveKinGridzi(J) <= 0 ) THEN + NWaveKin0Prime = NWaveKin0Prime + 1 + END IF + END DO ! J - All Morison nodes where the incident wave kinematics will be computed + + + + ! ALLOCATE the WaveKinzi0Prime(:) array and compute its elements here: + + ALLOCATE ( WaveKinzi0Prime(NWaveKin0Prime) , STAT=ErrStatTmp ); if (Failed0('WaveKinzi0Prime')) return; + ALLOCATE ( WaveKinPrimeMap(NWaveKin0Prime) , STAT=ErrStatTmp ); if (Failed0('WaveKinPrimeMap')) return; + + IF ( ErrStat >= AbortErrLev ) THEN + CALL CleanUp() + RETURN + END IF + + + I = 1 + + DO J = 1,InitInp%NWaveKinGrid ! Loop through all points where the incident wave kinematics will be computed without stretching + ! NOTE: We test to 0 instead of MSL2SWL because the locations of WaveKinGridzi and EffWtrDpth have already been adjusted using MSL2SWL + IF ( InitInp%WaveKinGridzi(J) >= -WaveField%EffWtrDpth .AND. InitInp%WaveKinGridzi(J) <= 0 ) THEN + + WaveKinzi0Prime(I) = InitInp%WaveKinGridzi(J) + WaveKinPrimeMap(I) = J + I = I + 1 + + END IF + + END DO ! J - All points where the incident wave kinematics will be computed without stretching + + + + ! Perform some initialization computations including calculating the total number of frequency + ! components = total number of time steps in the incident wave, + ! calculating the frequency step, calculating the index of the frequency + ! component nearest to WaveTp, and ALLOCATing the arrays: + ! NOTE: WaveDOmega = 2*Pi/WaveTMax since, in the FFT: + ! Omega = (K-1)*WaveDOmega + ! Time = (J-1)*WaveDT + ! and therefore: + ! Omega*Time = (K-1)*(J-1)*WaveDOmega*WaveDT + ! = (K-1)*(J-1)*2*Pi/NStepWave [see NWTC_FFTPACK] + ! or: + ! WaveDOmega = 2*Pi/(NStepWave*WaveDT) + ! = 2*Pi/WaveTMax + + + + + ! Set new value for NStepWave so that the FFT algorithms are efficient. Note that if this method is changed, the method + ! used to calculate the number of multidirectional wave directions (WaveNDir) and the UserWaveElevations_Init subroutine + ! will need to be updated. + + !>>>>>> COMPUTE INITOUT SCALARS WaveField%NStepWave, WaveField%NStepWave2, InitOut%WaveTMax, and InitOut%WaveDOmega for WAVEMOD = 1,2,3,4,10 (5 and 7 also call this routine, but have been set already) + ! NOTE: For WaveMod = 5, NStepWave and several other things were already set in the UserWaveElevations_Init routine + ! using file information (an FFT was performed there, so the information was needed before now). + ! Same with WaveMod = 7 (WaveMod_UserFreq). With WaveMod = 7, WaveDirArr is also populated in UserWaveComponents_Init routine. + ! Need to make sure the wave-direction in formation is not overwritten later. + IF (WaveField%WaveMod /= WaveMod_ExtElev .AND. WaveField%WaveMod /= WaveMod_UserFreq) THEN + WaveField%NStepWave = CEILING ( InitInp%WaveTMax/InitInp%WaveDT ) ! Set NStepWave to an even integer ... + IF ( MOD(WaveField%NStepWave,2) == 1 ) WaveField%NStepWave = WaveField%NStepWave + 1 ! ... larger or equal to WaveTMax/WaveDT. + + WaveField%NStepWave2 = MAX( WaveField%NStepWave/2, 1 ) ! Make sure that NStepWave is an even product of small factors (PSF) that is + WaveField%NStepWave = 2 * PSF( WaveField%NStepWave2, 9 ) ! greater or equal to WaveTMax/WaveDT to ensure that the FFT is efficient. + + WaveField%NStepWave2 = WaveField%NStepWave/2 ! Update the value of NStepWave2 based on the value needed for NStepWave. + InitOut%WaveTMax = WaveField%NStepWave*InitInp%WaveDT ! Update the value of WaveTMax based on the value needed for NStepWave. + WaveField%WaveDOmega = TwoPi/InitOut%WaveTMax ! Compute the frequency step for incident wave calculations. + + ! >>> Allocate and initialize (set to 0) InitOut arrays + call Initial_InitOut_Arrays(InitOut, WaveField, InitInp, InitInp%WaveDT, ErrStatTmp, ErrMsgTmp); CALL SetErrStat(ErrStatTmp,ErrMsgTmp, ErrStat,ErrMsg,RoutineName) + ENDIF + + + ! Allocate all the arrays we need. + ALLOCATE ( tmpComplexArr(0:WaveField%NStepWave2 ), STAT=ErrStatTmp ); if (Failed0('tmpComplexArr')) return; + ALLOCATE ( WaveDynPC0 (0:WaveField%NStepWave2 ,NWaveKin0Prime ), STAT=ErrStatTmp ); if (Failed0('WaveDynPC0 ')) return; + ALLOCATE ( WaveVelC0Hxi (0:WaveField%NStepWave2 ,NWaveKin0Prime ), STAT=ErrStatTmp ); if (Failed0('WaveVelC0Hxi')) return; + ALLOCATE ( WaveVelC0Hyi (0:WaveField%NStepWave2 ,NWaveKin0Prime ), STAT=ErrStatTmp ); if (Failed0('WaveVelC0Hyi')) return; + ALLOCATE ( WaveVelC0V (0:WaveField%NStepWave2 ,NWaveKin0Prime ), STAT=ErrStatTmp ); if (Failed0('WaveVelC0V ')) return; + ALLOCATE ( WaveAccC0Hxi (0:WaveField%NStepWave2 ,NWaveKin0Prime ), STAT=ErrStatTmp ); if (Failed0('WaveAccC0Hxi')) return; + ALLOCATE ( WaveAccC0Hyi (0:WaveField%NStepWave2 ,NWaveKin0Prime ), STAT=ErrStatTmp ); if (Failed0('WaveAccC0Hyi')) return; + ALLOCATE ( WaveAccC0V (0:WaveField%NStepWave2 ,NWaveKin0Prime ), STAT=ErrStatTmp ); if (Failed0('WaveAccC0V ')) return; + + ALLOCATE ( WaveDynP0B (0:WaveField%NStepWave-1,NWaveKin0Prime ), STAT=ErrStatTmp ); if (Failed0('WaveDynP0B ')) return; + ALLOCATE ( WaveVel0Hxi (0:WaveField%NStepWave-1,NWaveKin0Prime ), STAT=ErrStatTmp ); if (Failed0('WaveVel0Hxi ')) return; + ALLOCATE ( WaveVel0Hyi (0:WaveField%NStepWave-1,NWaveKin0Prime ), STAT=ErrStatTmp ); if (Failed0('WaveVel0Hyi ')) return; + ALLOCATE ( WaveVel0V (0:WaveField%NStepWave-1,NWaveKin0Prime ), STAT=ErrStatTmp ); if (Failed0('WaveVel0V ')) return; + ALLOCATE ( WaveAcc0Hxi (0:WaveField%NStepWave-1,NWaveKin0Prime ), STAT=ErrStatTmp ); if (Failed0('WaveAcc0Hxi ')) return; + ALLOCATE ( WaveAcc0Hyi (0:WaveField%NStepWave-1,NWaveKin0Prime ), STAT=ErrStatTmp ); if (Failed0('WaveAcc0Hyi ')) return; + ALLOCATE ( WaveAcc0V (0:WaveField%NStepWave-1,NWaveKin0Prime ), STAT=ErrStatTmp ); if (Failed0('WaveAcc0V ')) return; + + IF (WaveField%MCFD > 0.0_SiKi) THEN ! MacCamy-Fuchs model + ALLOCATE ( WaveAccC0HxiMCF(0:WaveField%NStepWave2 ,NWaveKin0Prime ), STAT=ErrStatTmp ); if (Failed0('WaveAccC0HxiMCF')) return; + ALLOCATE ( WaveAccC0HyiMCF(0:WaveField%NStepWave2 ,NWaveKin0Prime ), STAT=ErrStatTmp ); if (Failed0('WaveAccC0HyiMCF')) return; + ALLOCATE ( WaveAccC0VMCF (0:WaveField%NStepWave2 ,NWaveKin0Prime ), STAT=ErrStatTmp ); if (Failed0('WaveAccC0VMCF ')) return; + ALLOCATE ( WaveAcc0HxiMCF (0:WaveField%NStepWave-1,NWaveKin0Prime ), STAT=ErrStatTmp ); if (Failed0('WaveAcc0HxiMCF ')) return; + ALLOCATE ( WaveAcc0HyiMCF (0:WaveField%NStepWave-1,NWaveKin0Prime ), STAT=ErrStatTmp ); if (Failed0('WaveAcc0HyiMCF ')) return; + ALLOCATE ( WaveAcc0VMCF (0:WaveField%NStepWave-1,NWaveKin0Prime ), STAT=ErrStatTmp ); if (Failed0('WaveAcc0VMCF ')) return; + ALLOCATE ( WaveField%WaveAccMCF (0:WaveField%NStepWave,InitInp%NGrid(1),InitInp%NGrid(2),InitInp%NGrid(3),3), STAT=ErrStatTmp ); if (Failed0('WaveField%WaveAccMCF')) return; + END IF + + + IF (WaveField%WaveStMod .EQ. 2_IntKi) THEN ! Extrapolation Wave Stretching + ALLOCATE ( PWaveDynPC0BPz0 (0:WaveField%NStepWave2 ,InitInp%NWaveElevGrid), STAT=ErrStatTmp ); if (Failed0('PWaveDynPC0BPz0 ')) return; + ALLOCATE ( PWaveVelC0HxiPz0 (0:WaveField%NStepWave2 ,InitInp%NWaveElevGrid), STAT=ErrStatTmp ); if (Failed0('PWaveVelC0HxiPz0')) return; + ALLOCATE ( PWaveVelC0HyiPz0 (0:WaveField%NStepWave2 ,InitInp%NWaveElevGrid), STAT=ErrStatTmp ); if (Failed0('PWaveVelC0HyiPz0')) return; + ALLOCATE ( PWaveVelC0VPz0 (0:WaveField%NStepWave2 ,InitInp%NWaveElevGrid), STAT=ErrStatTmp ); if (Failed0('PWaveVelC0VPz0 ')) return; + ALLOCATE ( PWaveAccC0HxiPz0 (0:WaveField%NStepWave2 ,InitInp%NWaveElevGrid), STAT=ErrStatTmp ); if (Failed0('PWaveAccC0HxiPz0')) return; + ALLOCATE ( PWaveAccC0HyiPz0 (0:WaveField%NStepWave2 ,InitInp%NWaveElevGrid), STAT=ErrStatTmp ); if (Failed0('PWaveAccC0HyiPz0')) return; + ALLOCATE ( PWaveAccC0VPz0 (0:WaveField%NStepWave2 ,InitInp%NWaveElevGrid), STAT=ErrStatTmp ); if (Failed0('PWaveAccC0VPz0 ')) return; + ALLOCATE ( PWaveDynP0BPz0 (0:WaveField%NStepWave-1,InitInp%NWaveElevGrid), STAT=ErrStatTmp ); if (Failed0('PWaveDynP0BPz0 ')) return; + ALLOCATE ( PWaveVel0HxiPz0 (0:WaveField%NStepWave-1,InitInp%NWaveElevGrid), STAT=ErrStatTmp ); if (Failed0('PWaveVel0HxiPz0 ')) return; + ALLOCATE ( PWaveVel0HyiPz0 (0:WaveField%NStepWave-1,InitInp%NWaveElevGrid), STAT=ErrStatTmp ); if (Failed0('PWaveVel0HyiPz0 ')) return; + ALLOCATE ( PWaveVel0VPz0 (0:WaveField%NStepWave-1,InitInp%NWaveElevGrid), STAT=ErrStatTmp ); if (Failed0('PWaveVel0VPz0 ')) return; + ALLOCATE ( PWaveAcc0HxiPz0 (0:WaveField%NStepWave-1,InitInp%NWaveElevGrid), STAT=ErrStatTmp ); if (Failed0('PWaveAcc0HxiPz0 ')) return; + ALLOCATE ( PWaveAcc0HyiPz0 (0:WaveField%NStepWave-1,InitInp%NWaveElevGrid), STAT=ErrStatTmp ); if (Failed0('PWaveAcc0HyiPz0 ')) return; + ALLOCATE ( PWaveAcc0VPz0 (0:WaveField%NStepWave-1,InitInp%NWaveElevGrid), STAT=ErrStatTmp ); if (Failed0('PWaveAcc0VPz0 ')) return; + ALLOCATE ( WaveField%PWaveDynP0 (0:WaveField%NStepWave,InitInp%NGrid(1),InitInp%NGrid(2) ), STAT=ErrStatTmp ); if (Failed0('WaveField%PWaveDynP0')) return; + ALLOCATE ( WaveField%PWaveVel0 (0:WaveField%NStepWave,InitInp%NGrid(1),InitInp%NGrid(2),3), STAT=ErrStatTmp ); if (Failed0('WaveField%PWaveVel0 ')) return; + ALLOCATE ( WaveField%PWaveAcc0 (0:WaveField%NStepWave,InitInp%NGrid(1),InitInp%NGrid(2),3), STAT=ErrStatTmp ); if (Failed0('WaveField%PWaveAcc0 ')) return; + IF (WaveField%MCFD > 0.0_ReKi) THEN ! MacCamy-Fuchs model + ALLOCATE ( PWaveAccC0HxiMCFPz0 (0:WaveField%NStepWave2 ,InitInp%NWaveElevGrid), STAT=ErrStatTmp ); if (Failed0('PWaveAccC0HxiMCFPz0')) return; + ALLOCATE ( PWaveAccC0HyiMCFPz0 (0:WaveField%NStepWave2 ,InitInp%NWaveElevGrid), STAT=ErrStatTmp ); if (Failed0('PWaveAccC0HyiMCFPz0')) return; + ALLOCATE ( PWaveAccC0VMCFPz0 (0:WaveField%NStepWave2 ,InitInp%NWaveElevGrid), STAT=ErrStatTmp ); if (Failed0('PWaveAccC0VMCFPz0 ')) return; + ALLOCATE ( PWaveAcc0HxiMCFPz0 (0:WaveField%NStepWave-1,InitInp%NWaveElevGrid), STAT=ErrStatTmp ); if (Failed0('PWaveAcc0HxiMCFPz0 ')) return; + ALLOCATE ( PWaveAcc0HyiMCFPz0 (0:WaveField%NStepWave-1,InitInp%NWaveElevGrid), STAT=ErrStatTmp ); if (Failed0('PWaveAcc0HyiMCFPz0 ')) return; + ALLOCATE ( PWaveAcc0VMCFPz0 (0:WaveField%NStepWave-1,InitInp%NWaveElevGrid), STAT=ErrStatTmp ); if (Failed0('PWaveAcc0VMCFPz0 ')) return; + ALLOCATE ( WaveField%PWaveAccMCF0 (0:WaveField%NStepWave,InitInp%NGrid(1),InitInp%NGrid(2),3), STAT=ErrStatTmp ); if (Failed0('WaveField%PWaveAccMCF0')) return; + END IF + END IF + + + + ! Arrays for the Sin and Cos of the wave direction for each frequency. Used in calculating wave elevation, velocity, acceleration etc. + ALLOCATE ( CosWaveDir( 0:WaveField%NStepWave2 ), STAT=ErrStatTmp ); if (Failed0('CosWaveDir')) return; + ALLOCATE ( SinWaveDir( 0:WaveField%NStepWave2 ), STAT=ErrStatTmp ); if (Failed0('SinWaveDir')) return; + ALLOCATE ( OmegaArr( 0:WaveField%NStepWave2 ), STAT=ErrStatTmp ); if (Failed0('OmegaArr ')) return; + + ! Arrays for the constrained wave + ALLOCATE ( WaveS1SddArr( 0:WaveField%NStepWave2 ), STAT=ErrStatTmp ); if (Failed0('WaveS1SddArr')) return; + + ! Now check if all the allocations worked properly + IF ( ErrStat >= AbortErrLev ) THEN + CALL CleanUp() + RETURN + END IF + + + + ! Compute the positive-frequency components (including zero) of the discrete + ! Fourier transforms of the wave kinematics: + DO I = 0,WaveField%NStepWave2 ! Loop through the positive frequency components (including zero) of the discrete Fourier transforms + OmegaArr(I) = I*WaveField%WaveDOmega + END DO + + call Get_1Spsd_and_WaveElevC0(InitInp, InitOut, WaveField, OmegaArr, WaveS1SddArr) + + + !> # Multi Directional Waves + call CalculateWaveDirection(InitInp, InitOut, WaveField, ErrStatTmp, ErrMsgTmp); if (Failed()) return; + + ! Store the minimum and maximum wave directions + WaveField%WaveDirMin = MINVAL(WaveField%WaveDirArr) + WaveField%WaveDirMax = MAXVAL(WaveField%WaveDirArr) + + + ! Set the CosWaveDir and SinWaveDir arrays + CosWaveDir=COS(D2R*WaveField%WaveDirArr) + SinWaveDir=SIN(D2R*WaveField%WaveDirArr) + + + ! make sure this is called before calling ConstrainedNewWaves + CALL InitFFT ( WaveField%NStepWave, FFT_Data, .TRUE., ErrStatTmp ) + CALL SetErrStat(ErrStatTmp,'Error occured while initializing the FFT.',ErrStat,ErrMsg,RoutineName) + IF ( ErrStat >= AbortErrLev ) THEN + CALL CleanUp() + RETURN + END IF + + !-------------------------------------------------------------------------------- + !=== Constrained New Waves === + ! Modify the wave components to implement the constrained wave + ! Only do this if WaveMod = 2 (JONSWAP/Pierson-Moskowitz Spectrum) and ConstWaveMod /= ConstWaveMod_None + IF ( WaveField%WaveMod == WaveMod_JONSWAP .AND. InitInp%ConstWaveMod /= ConstWaveMod_None ) THEN + ! adjust InitOut%WaveElevC0 for constrained wave: + call ConstrainedNewWaves(InitInp, InitOut, WaveField, OmegaArr, WaveS1SddArr, CosWaveDir, SinWaveDir, FFT_Data, ErrStatTmp, ErrMsgTmp) + call SetErrStat(ErrStatTmp,ErrMsgTmp, ErrStat,ErrMsg,RoutineName) + if (ErrStat >= AbortErrLev) then + call cleanup() + return + end if + ENDIF + ! End of Constrained Wave + + !-------------------------------------------------------------------------------- + !> ## Phase shift the discrete Fourier transform of wave elevations at the WRP + !> This changes the phasing of all wave kinematics and loads to reflect the turbine's + !! location in the larger farm, in the case of FAST.Farm simulations, based on + !! specified PtfmLocationX and PtfmLocationY. + + IF (InitInp%WaveFieldMod == 2) THEN ! case 2: adjust wave phases based on turbine offsets from farm origin + + CALL WrScr ( ' Adjusting incident wave kinematics for turbine offset from array origin.' ) + + DO I = 0,WaveField%NStepWave2 + + tmpComplex = CMPLX( WaveField%WaveElevC0(1,I), WaveField%WaveElevC0(2,I)) + + ! some redundant calculations with later, but insignificant + WaveNmbr = WaveNumber ( OmegaArr(I), InitInp%Gravity, WaveField%EffWtrDpth ) + + ! apply the phase shift + tmpComplex = tmpComplex * EXP( -ImagNmbr*WaveNmbr*( InitInp%PtfmLocationX*CosWaveDir(I) + InitInp%PtfmLocationY*SinWaveDir(I) )) + + ! put shifted complex amplitudes back into the array for use in the remainder of this module and other modules (Waves2, WAMIT, WAMIT2) + WaveField%WaveElevC0 (1,I) = REAL( tmpComplex) + WaveField%WaveElevC0 (2,I) = AIMAG(tmpComplex) + + END DO + END IF + + + !-------------------------------------------------------------------------------- + !> ## Compute IFFTs + !> Compute the discrete Fourier transform of the instantaneous elevation of + !! incident waves at each desired point on the still water level plane + !! where it can be output: + + DO I = 0,WaveField%NStepWave2 ! Loop through the positive frequency components (including zero) of the discrete Fourier transforms + ! Set tmpComplex to the Ith element of the WAveElevC0 array + tmpComplex = CMPLX( WaveField%WaveElevC0(1,I), WaveField%WaveElevC0(2,I)) + + ! Compute the frequency of this component and its imaginary value: + ImagOmega = ImagNmbr*OmegaArr(I) + + ! Compute the wavenumber: + WaveNmbr = WaveNumber ( OmegaArr(I), InitInp%Gravity, WaveField%EffWtrDpth ) + + ! Wavenumber-dependent acceleration scaling for MacCamy-Fuchs model + MCFC = 0.0_ReKi + IF (WaveField%MCFD > 0.0_SiKi .AND. I>0_IntKi) THEN + ka = 0.5_ReKi * WaveNmbr * WaveField%MCFD + JPrime = BESSEL_JN(1,ka) / ka - BESSEL_JN(2,ka) + YPrime = BESSEL_YN(1,ka) / ka - BESSEL_YN(2,ka) + HPrime = SQRT(JPrime*JPrime + YPrime*YPrime) + MCFC = 4.0_ReKi/( PI * ka * ka * HPrime ) + END IF + + ! Compute the discrete Fourier transform of the incident wave kinematics + ! before applying stretching at the zi-coordinates for the WAMIT reference point, and all + ! points where are Morison loads will be calculated. + + DO J = 1,NWaveKin0Prime ! Loop through all points where the incident wave kinematics will be computed without stretching + + WaveElevxiPrime0 = EXP( -ImagNmbr*WaveNmbr*( InitInp%WaveKinGridxi(WaveKinPrimeMap(J))*CosWaveDir(I) + & + InitInp%WaveKinGridyi(WaveKinPrimeMap(J))*SinWaveDir(I) )) + + WaveDynPC0 (I,J) = WaveField%RhoXg*tmpComplex*WaveElevxiPrime0 * COSHNumOvrCOSHDen ( WaveNmbr, WaveField%EffWtrDpth, WaveKinzi0Prime(J) ) + + WaveVelC0Hxi (I,J) = CosWaveDir(I)*OmegaArr(I)*tmpComplex* WaveElevxiPrime0 * COSHNumOvrSINHDen ( WaveNmbr, WaveField%EffWtrDpth, WaveKinzi0Prime(J) ) + WaveVelC0Hyi (I,J) = SinWaveDir(I)*OmegaArr(I)*tmpComplex* WaveElevxiPrime0 * COSHNumOvrSINHDen ( WaveNmbr, WaveField%EffWtrDpth, WaveKinzi0Prime(J) ) + + WaveVelC0V (I,J) = ImagOmega*tmpComplex* WaveElevxiPrime0 * SINHNumOvrSINHDen ( WaveNmbr, WaveField%EffWtrDpth, WaveKinzi0Prime(J) ) + WaveAccC0Hxi (I,J) = ImagOmega* WaveVelC0Hxi (I,J) + + WaveAccC0Hyi (I,J) = ImagOmega* WaveVelC0Hyi (I,J) + WaveAccC0V (I,J) = ImagOmega* WaveVelC0V (I,J) + + IF (WaveField%MCFD > 0.0_SiKi) THEN + WaveAccC0HxiMCF(I,J) = WaveAccC0Hxi(I,J) * MCFC + WaveAccC0HyiMCF(I,J) = WaveAccC0Hyi(I,J) * MCFC + WaveAccC0VMCF(I,J) = WaveAccC0V(I,J) * MCFC + END IF + END DO ! J - All points where the incident wave kinematics will be computed without stretching + + IF (WaveField%WaveStMod .EQ. 2_IntKi) THEN ! Extrapolation wave stretching + DO J = 1,InitInp%NWaveElevGrid ! Loop through all points on the SWL + WaveElevxiPrime0 = EXP( -ImagNmbr*WaveNmbr*( InitInp%WaveKinGridxi(J)*CosWaveDir(I) + & + InitInp%WaveKinGridyi(J)*SinWaveDir(I) )) + ! Partial derivatives at zi = 0 + PWaveDynPC0BPz0 (I,J) = WaveField%RhoXg* tmpComplex*WaveElevxiPrime0*WaveNmbr*TANH ( WaveNmbr*WaveField%EffWtrDpth ) + PWaveVelC0HxiPz0(I,J) = CosWaveDir(I)*OmegaArr(I)*tmpComplex*WaveElevxiPrime0*WaveNmbr + PWaveVelC0HyiPz0(I,J) = SinWaveDir(I)*OmegaArr(I)*tmpComplex*WaveElevxiPrime0*WaveNmbr + + IF (I == 0_IntKi) THEN ! Zero frequency component - Need to avoid division by zero. + PWaveVelC0VPz0 (I,J) = 0.0_ReKi + ELSE + PWaveVelC0VPz0 (I,J) = ImagOmega*tmpComplex*WaveElevxiPrime0*WaveNmbr/TANH ( WaveNmbr*WaveField%EffWtrDpth ) + END IF + + PWaveAccC0HxiPz0(I,J) = ImagOmega*PWaveVelC0HxiPz0(I,J) + PWaveAccC0HyiPz0(I,J) = ImagOmega*PWaveVelC0HyiPz0(I,J) + PWaveAccC0VPz0 (I,J) = ImagOmega*PWaveVelC0VPz0 (I,J) + + + IF (WaveField%MCFD > 0.0_SiKi) THEN + PWaveAccC0HxiMCFPz0(I,J) = PWaveAccC0HxiPz0(I,J) * MCFC + PWaveAccC0HyiMCFPz0(I,J) = PWaveAccC0HyiPz0(I,J) * MCFC + PWaveAccC0VMCFPz0(I,J) = PWaveAccC0VPz0(I,J) * MCFC + END IF + + END DO ! J - All points where the incident wave kinematics will be computed without stretching + END IF + + END DO ! I - The positive frequency components (including zero) of the discrete Fourier transforms + + ! Calculate the array of simulation times at which the instantaneous + ! elevation of, velocity of, acceleration of, and loads associated with + ! the incident waves are to be determined: + DO I = 0,WaveField%NStepWave ! Loop through all time steps + WaveField%WaveTime(I) = I*REAL(InitInp%WaveDT,SiKi) + END DO ! I - All time steps + + + DO I = 0,WaveField%NStepWave2 ! Loop through the positive frequency components (including zero) of the discrete Fourier transform + tmpComplexArr(I) = CMPLX(WaveField%WaveElevC0(1,I), WaveField%WaveElevC0(2,I)) + END DO + + ! Compute the inverse discrete Fourier transforms to find the time-domain + ! representations of the wave kinematics without stretcing: + + CALL ApplyFFT_cx ( WaveField%WaveElev0 (0:WaveField%NStepWave-1), tmpComplexArr (: ), FFT_Data, ErrStatTmp ) + if (FailedFFT('WaveField%WaveElev0' )) return; +!NOTE: For all grid points + DO k = 1,InitInp%NWaveElevGrid ! Loop through all points where the incident wave elevations are to be computed (normally all the XY grid points) + ! This subroutine call applies the FFT at the correct location. + i = mod(k-1, InitInp%NGrid(1)) + 1 + j = (k-1) / InitInp%NGrid(1) + 1 + + ! note that this subroutine resets tmpComplexArr + CALL WaveElevTimeSeriesAtXY( InitInp%WaveKinGridxi(k), InitInp%WaveKinGridyi(k), WaveField%WaveElev1(:,i,j), WaveField%WaveElevC(:,:,k), tmpComplexArr, ErrStatTmp, ErrMsgTmp ) ! Note this sets tmpComplexArr + if (FailedFFT('WaveField%WaveElev1' )) return; + END DO ! J - All points where the incident wave elevations can be output + + + + + ! User requested data points -- Do all the FFT calls first, then return if something failed. + DO J = 1,NWaveKin0Prime ! Loop through all points where the incident wave kinematics will be computed without stretching + CALL ApplyFFT_cx ( WaveDynP0B (:,J), WaveDynPC0 (:,J), FFT_Data, ErrStatTmp ); if (FailedFFT('WaveDynPC0 ')) return; + CALL ApplyFFT_cx ( WaveVel0Hxi (:,J), WaveVelC0Hxi (:,J), FFT_Data, ErrStatTmp ); if (FailedFFT('WaveVelC0Hxi')) return; + CALL ApplyFFT_cx ( WaveVel0Hyi (:,J), WaveVelC0Hyi (:,J), FFT_Data, ErrStatTmp ); if (FailedFFT('WaveVelC0Hyi')) return; + CALL ApplyFFT_cx ( WaveVel0V (:,J), WaveVelC0V (:,J), FFT_Data, ErrStatTmp ); if (FailedFFT('WaveVelC0V ')) return; + CALL ApplyFFT_cx ( WaveAcc0Hxi (:,J), WaveAccC0Hxi (:,J), FFT_Data, ErrStatTmp ); if (FailedFFT('WaveAccC0Hxi')) return; + CALL ApplyFFT_cx ( WaveAcc0Hyi (:,J), WaveAccC0Hyi (:,J), FFT_Data, ErrStatTmp ); if (FailedFFT('WaveAccC0Hyi')) return; + CALL ApplyFFT_cx ( WaveAcc0V (:,J), WaveAccC0V (:,J), FFT_Data, ErrStatTmp ); if (FailedFFT('WaveAccC0V ')) return; + END DO ! J - All points where the incident wave kinematics will be computed without stretching + + IF (WaveField%MCFD > 0.0_SiKi) THEN + DO J = 1,NWaveKin0Prime ! Loop through all points where the incident wave kinematics will be computed without stretching + CALL ApplyFFT_cx ( WaveAcc0HxiMCF (:,J), WaveAccC0HxiMCF (:,J), FFT_Data, ErrStatTmp ); if (FailedFFT('WaveAcc0HxiMCF')) return; + CALL ApplyFFT_cx ( WaveAcc0HyiMCF (:,J), WaveAccC0HyiMCF (:,J), FFT_Data, ErrStatTmp ); if (FailedFFT('WaveAcc0HyiMCF')) return; + CALL ApplyFFT_cx ( WaveAcc0VMCF (:,J), WaveAccC0VMCF (:,J), FFT_Data, ErrStatTmp ); if (FailedFFT('WaveAcc0VMCF ')) return; + END DO + END IF + + IF (WaveField%WaveStMod .EQ. 2_IntKi) THEN ! Extrapolation Wave Stretching + DO J = 1,InitInp%NWaveElevGrid ! Loop through all points on the SWL where z-partial derivatives will be computed for extrapolated stretching + ! FFT's of the partial derivatives + CALL ApplyFFT_cx ( PWaveDynP0BPz0(:,J ), PWaveDynPC0BPz0(:,J ), FFT_Data, ErrStatTmp ); if (FailedFFT('PWaveDynP0BPz0 ')) return; + CALL ApplyFFT_cx ( PWaveVel0HxiPz0 (:,J ), PWaveVelC0HxiPz0( :,J ),FFT_Data, ErrStatTmp ); if (FailedFFT('PWaveVel0HxiPz0')) return; + CALL ApplyFFT_cx ( PWaveVel0HyiPz0 (:,J ), PWaveVelC0HyiPz0( :,J ),FFT_Data, ErrStatTmp ); if (FailedFFT('PWaveVel0HyiPz0')) return; + CALL ApplyFFT_cx ( PWaveVel0VPz0 (:,J ), PWaveVelC0VPz0 (:,J ), FFT_Data, ErrStatTmp ); if (FailedFFT('PWaveVel0VPz0 ')) return; + CALL ApplyFFT_cx ( PWaveAcc0HxiPz0 (:,J ), PWaveAccC0HxiPz0(:,J ),FFT_Data, ErrStatTmp ); if (FailedFFT('PWaveAcc0HxiPz0')) return; + CALL ApplyFFT_cx ( PWaveAcc0HyiPz0 (:,J ), PWaveAccC0HyiPz0(:,J ),FFT_Data, ErrStatTmp ); if (FailedFFT('PWaveAcc0HyiPz0')) return; + CALL ApplyFFT_cx ( PWaveAcc0VPz0 (:,J ), PWaveAccC0VPz0( :,J ), FFT_Data, ErrStatTmp ); if (FailedFFT('PWaveAcc0VPz0 ')) return; + END DO ! J - All points where the incident wave kinematics will be computed without stretching + + IF (WaveField%MCFD > 0.0_SiKi) THEN ! MacCamy-Fuchs scaled acceleration field + DO J = 1,InitInp%NWaveElevGrid + CALL ApplyFFT_cx ( PWaveAcc0HxiMCFPz0 (:,J ), PWaveAccC0HxiMCFPz0(:,J ),FFT_Data, ErrStatTmp ); if (FailedFFT('PWaveAcc0HxiMCFPz0')) return; + CALL ApplyFFT_cx ( PWaveAcc0HyiMCFPz0 (:,J ), PWaveAccC0HyiMCFPz0(:,J ),FFT_Data, ErrStatTmp ); if (FailedFFT('PWaveAcc0HyiMCFPz0')) return; + CALL ApplyFFT_cx ( PWaveAcc0VMCFPz0 (:,J ), PWaveAccC0VMCFPz0( :,J ), FFT_Data, ErrStatTmp ); if (FailedFFT('PWaveAcc0VMCFPz0 ')) return; + END DO + END IF + + END IF + + CALL ExitFFT(FFT_Data, ErrStatTmp) + CALL SetErrStat(ErrStatTmp,'Error occured while cleaning up after the FFTs.', ErrStat,ErrMsg,RoutineName) + IF ( ErrStat >= AbortErrLev ) THEN + CALL CleanUp() + RETURN + END IF + + + + ! Add the current velocities to the wave velocities: + ! NOTE: Both the horizontal velocities and the partial derivative of the + ! horizontal velocities with respect to zi at zi = 0 are found here. + ! + ! NOTE: The current module must be called prior to the waves module. If that was not done, then we + ! don't have a current to add to the wave velocity. So, check if the current velocity components + ! exist. + + + ! If there is a current, we need to add that (the current module was called prior to calling this module + + IF(ALLOCATED(InitInp%CurrVxi)) THEN + + DO J = 1,NWaveKin0Prime ! Loop through all points where the incident wave kinematics will be computed without stretching + + WaveVel0Hxi (:,J) = WaveVel0Hxi (:,J) + InitInp%CurrVxi(WaveKinPrimeMap(J)) ! xi-direction + WaveVel0Hyi (:,J) = WaveVel0Hyi (:,J) + InitInp%CurrVyi(WaveKinPrimeMap(J)) ! yi-direction + + END DO ! J - All points where the incident wave kinematics will be computed without stretching + + ! Commented out - We do not extrapolate the current profile with extrapolated wave stretching + !PWaveVel0HxiPz0(: ) = PWaveVel0HxiPz0(: ) + InitInp%PCurrVxiPz0 ! xi-direction + !PWaveVel0HyiPz0(: ) = PWaveVel0HyiPz0(: ) + InitInp%PCurrVyiPz0 ! yi-direction + + ENDIF + + + ! Apply stretching to obtain the wave kinematics, WaveDynP0, WaveVel0, and + ! WaveAcc0, at the desired locations from the wave kinematics at + ! alternative locations, WaveDynP0B, WaveVel0Hxi, WaveVel0Hyi, WaveVel0V, + ! WaveAcc0Hxi, WaveAcc0Hyi, WaveAcc0V, if the elevation of the point defined by + ! WaveKinGridzi(J) lies between the seabed and the instantaneous free + ! surface, else set WaveDynP0, WaveVel0, and WaveAcc0 to zero. This + ! depends on which incident wave kinematics stretching method is being + ! used: + + ! SELECT CASE ( InitInp%WaveStMod ) ! Which model are we using to extrapolate the incident wave kinematics to the instantaneous free surface? + ! CASE ( 0 ) ! None=no stretching. + + + ! Since we have no stretching, the wave kinematics between the seabed and + ! the mean sea level are left unchanged; below the seabed or above the + ! mean sea level, the wave kinematics are zero: + + ! InitOut%PWaveDynP0(:,:,:,:) = 0.0 + + primeCount = 1 + count = 1 + !DO J = 1,InitInp%NWaveKinGrid ! Loop through all points where the incident wave kinematics will be computed + do k = 1, InitInp%NGrid(3) + do j = 1, InitInp%NGrid(2) + do i = 1, InitInp%NGrid(1) + + ! ii = mod(count-1, InitInp%NGrid(1)) + 1 + ! jj = mod( (count-1) /InitInp%NGrid(1), InitInp%NGrid(2) ) + 1 + ! kk = (count-1) / (InitInp%NGrid(1)*InitInp%NGrid(2)) + 1 + + IF ( ( InitInp%WaveKinGridzi(count) < -WaveField%EffWtrDpth ) .OR. ( InitInp%WaveKinGridzi(count) > 0.0 ) ) THEN + ! .TRUE. if the elevation of the point defined by WaveKinGridzi(J) lies below the seabed or above mean sea level (exclusive) + ! NOTE: We test to 0 instead of MSL2SWL because the locations of WaveKinGridzi and EffWtrDpth have already been adjusted using MSL2SWL + + WaveField%WaveDynP(:,i,j,k ) = 0.0 + WaveField%WaveVel (:,i,j,k,:) = 0.0 + WaveField%WaveAcc (:,i,j,k,:) = 0.0 + + ELSE + ! The elevation of the point defined by WaveKinGridzi(J) must lie between the seabed and the mean sea level (inclusive) + + WaveField%WaveDynP(0:WaveField%NStepWave-1,i,j,k ) = WaveDynP0B( 0:WaveField%NStepWave-1,primeCount) + WaveField%WaveVel (0:WaveField%NStepWave-1,i,j,k,1) = WaveVel0Hxi(0:WaveField%NStepWave-1,primeCount) + WaveField%WaveVel (0:WaveField%NStepWave-1,i,j,k,2) = WaveVel0Hyi(0:WaveField%NStepWave-1,primeCount) + WaveField%WaveVel (0:WaveField%NStepWave-1,i,j,k,3) = WaveVel0V( 0:WaveField%NStepWave-1,primeCount) + WaveField%WaveAcc (0:WaveField%NStepWave-1,i,j,k,1) = WaveAcc0Hxi(0:WaveField%NStepWave-1,primeCount) + WaveField%WaveAcc (0:WaveField%NStepWave-1,i,j,k,2) = WaveAcc0Hyi(0:WaveField%NStepWave-1,primeCount) + WaveField%WaveAcc (0:WaveField%NStepWave-1,i,j,k,3) = WaveAcc0V( 0:WaveField%NStepWave-1,primeCount) + primeCount = primeCount + 1 + END IF + count = count + 1 + end do + end do + end do + + ! MacCamy-Fuchs scaled fluid acceleration + IF (WaveField%MCFD > 0.0_SiKi) THEN + primeCount = 1 + count = 1 + do k = 1, InitInp%NGrid(3) + do j = 1, InitInp%NGrid(2) + do i = 1, InitInp%NGrid(1) + IF ( ( InitInp%WaveKinGridzi(count) < -WaveField%EffWtrDpth ) .OR. ( InitInp%WaveKinGridzi(count) > 0.0 ) ) THEN + ! .TRUE. if the elevation of the point defined by WaveKinGridzi(J) lies below the seabed or above mean sea level (exclusive) + ! NOTE: We test to 0 instead of MSL2SWL because the locations of WaveKinGridzi and EffWtrDpth have already been adjusted using MSL2SWL + WaveField%WaveAccMCF(:,i,j,k,:) = 0.0 + ELSE + ! The elevation of the point defined by WaveKinGridzi(J) must lie between the seabed and the mean sea level (inclusive) + WaveField%WaveAccMCF (0:WaveField%NStepWave-1,i,j,k,1) = WaveAcc0HxiMCF(0:WaveField%NStepWave-1,primeCount) + WaveField%WaveAccMCF (0:WaveField%NStepWave-1,i,j,k,2) = WaveAcc0HyiMCF(0:WaveField%NStepWave-1,primeCount) + WaveField%WaveAccMCF (0:WaveField%NStepWave-1,i,j,k,3) = WaveAcc0VMCF( 0:WaveField%NStepWave-1,primeCount) + primeCount = primeCount + 1 + END IF + count = count + 1 + end do + end do + end do + END IF + + IF (WaveField%WaveStMod .EQ. 2_IntKi) THEN ! Extrapolation Wave Stretching + + primeCount = 1 + DO j = 1, InitInp%NGrid(2) ! Loop through all points on the SWL where partial derivatives about z were computed + DO i = 1, InitInp%NGrid(1) + WaveField%PWaveDynP0(0:WaveField%NStepWave-1,i,j ) = PWaveDynP0BPz0( 0:WaveField%NStepWave-1,primeCount) + WaveField%PWaveVel0 (0:WaveField%NStepWave-1,i,j,1) = PWaveVel0HxiPz0(0:WaveField%NStepWave-1,primeCount) + WaveField%PWaveVel0 (0:WaveField%NStepWave-1,i,j,2) = PWaveVel0HyiPz0(0:WaveField%NStepWave-1,primeCount) + WaveField%PWaveVel0 (0:WaveField%NStepWave-1,i,j,3) = PWaveVel0VPz0( 0:WaveField%NStepWave-1,primeCount) + WaveField%PWaveAcc0 (0:WaveField%NStepWave-1,i,j,1) = pWaveAcc0HxiPz0(0:WaveField%NStepWave-1,primeCount) + WaveField%PWaveAcc0 (0:WaveField%NStepWave-1,i,j,2) = pWaveAcc0HyiPz0(0:WaveField%NStepWave-1,primeCount) + WaveField%PWaveAcc0 (0:WaveField%NStepWave-1,i,j,3) = PWaveAcc0VPz0( 0:WaveField%NStepWave-1,primeCount) + primeCount = primeCount + 1 + END DO + END DO + + IF (WaveField%MCFD > 0.0_SiKi) THEN + primeCount = 1 + DO j = 1, InitInp%NGrid(2) ! Loop through all points on the SWL where partial derivatives about z were computed + DO i = 1, InitInp%NGrid(1) + WaveField%PWaveAccMCF0 (0:WaveField%NStepWave-1,i,j,1) = pWaveAcc0HxiMCFPz0(0:WaveField%NStepWave-1,primeCount) + WaveField%PWaveAccMCF0 (0:WaveField%NStepWave-1,i,j,2) = pWaveAcc0HyiMCFPz0(0:WaveField%NStepWave-1,primeCount) + WaveField%PWaveAccMCF0 (0:WaveField%NStepWave-1,i,j,3) = PWaveAcc0VMCFPz0( 0:WaveField%NStepWave-1,primeCount) + primeCount = primeCount + 1 + END DO + END DO + END IF + + END IF + + + + ! CASE ( 1 ) ! Vertical stretching. + ! Vertical stretching says that the wave kinematics above the mean sea level + ! equal the wave kinematics at the mean sea level. The wave kinematics + ! below the mean sea level are left unchanged: + + ! CASE ( 2 ) ! Extrapolation stretching. + ! Extrapolation stretching uses a linear Taylor expansion of the wave + ! kinematics (and their partial derivatives with respect to z) at the mean + ! sea level to find the wave kinematics above the mean sea level. The + ! wave kinematics below the mean sea level are left unchanged: + + ! CASE ( 3 ) ! Wheeler stretching. + ! Wheeler stretching says that wave kinematics calculated using Airy theory + ! at the mean sea level should actually be applied at the instantaneous + ! free surface and that Airy wave kinematics computed at locations between + ! the seabed and the mean sea level should be shifted vertically to new + ! locations in proportion to their elevation above the seabed. + ! + ! Computing the wave kinematics with Wheeler stretching requires that first + ! say that the wave kinematics we computed at the elevations defined by + ! the WaveKinzi0Prime(:) array are actual applied at the elevations found + ! by stretching the elevations in the WaveKinzi0Prime(:) array using the + ! instantaneous wave elevation--these new elevations are stored in the + ! WaveKinzi0St(:) array. Next, we interpolate the wave kinematics + ! computed without stretching to the desired elevations (defined in the + ! WaveKinGridzi(:) array) using the WaveKinzi0St(:) array: + + ! ENDSELECT + + ! Set the ending timestep to the same as the first timestep + WaveField%WaveElev0 (WaveField%NStepWave) = WaveField%WaveElev0 (0 ) + WaveField%WaveDynP (WaveField%NStepWave,:,:,: ) = WaveField%WaveDynP (0,:,:,: ) + WaveField%WaveVel (WaveField%NStepWave,:,:,:,:) = WaveField%WaveVel (0,:,:,:,:) + WaveField%WaveAcc (WaveField%NStepWave,:,:,:,:) = WaveField%WaveAcc (0,:,:,:,:) + IF (WaveField%MCFD > 0.0_SiKi) THEN + WaveField%WaveAccMCF (WaveField%NStepWave,:,:,:,:) = WaveField%WaveAccMCF(0,:,:,:,:) + END IF + + IF (WaveField%WaveStMod .EQ. 2_IntKi) THEN ! Extrapolation Wave Stretching + WaveField%PWaveDynP0(WaveField%NStepWave,:,: ) = WaveField%PWaveDynP0(0,:,: ) + WaveField%PWaveVel0 (WaveField%NStepWave,:,:,:) = WaveField%PWaveVel0 (0,:,:,:) + WaveField%PWaveAcc0 (WaveField%NStepWave,:,:,:) = WaveField%PWaveAcc0 (0,:,:,:) + IF (WaveField%MCFD > 0.0_SiKi) THEN + WaveField%PWaveAccMCF0 (WaveField%NStepWave,:,:,:) = WaveField%PWaveAccMCF0(0,:,:,:) + END IF + END IF + + CALL CleanUp ( ) + + +CONTAINS + logical function Failed() + CALL SetErrStat( ErrStatTmp, ErrMsgTmp, ErrStat, ErrMsg, RoutineName ) + Failed = ErrStat >= AbortErrLev + if (Failed) CALL Cleanup() + end function + logical function Failed0(TmpName) + character(*), intent(in) :: TmpName + if (ErrStatTmp /= 0) then + ErrStatTmp = ErrID_Fatal + CALL SetErrStat( ErrStatTmp, 'Error while allocating '//trim(TmpName), ErrStat, ErrMsg, RoutineName ) + endif + Failed0 = ErrStat >= AbortErrLev + if (Failed0) CALL Cleanup() + end function + logical function FailedFFT(TmpName) + character(*), intent(in) :: TmpName + CALL SetErrStat( ErrStatTmp, 'Error occured while applying the FFT to '//trim(TmpName), ErrStat, ErrMsg, RoutineName ) + FailedFFT = ErrStat >= AbortErrLev + if (FailedFFT) CALL Cleanup() + end function +!-------------------------------------------------------------------------------- + SUBROUTINE WaveElevTimeSeriesAtXY(Xcoord,Ycoord, WaveElevAtXY, WaveElevCAtXY, tmpComplexArr, ErrStatLcl, ErrMsgLcl ) + + REAL(SiKi), INTENT(IN ) :: Xcoord + REAL(SiKi), INTENT(IN ) :: Ycoord + REAL(SiKi), INTENT( OUT) :: WaveElevAtXY(0:WaveField%NStepWave) + real(SiKi), INTENT( OUT) :: WaveElevCAtXY(2,0:WaveField%NStepWave2) + COMPLEX(SiKi), INTENT(INOUT) :: tmpComplexArr(0:WaveField%NStepWave2) ! A temporary array (0:NStepWave2-1) for FFT use. + INTEGER(IntKi), INTENT( OUT) :: ErrStatLcl + CHARACTER(*), INTENT( OUT) :: ErrMsgLcl + + integer :: i + REAL(SiKi) :: WaveNmbr ! Wavenumber of the current frequency component (1/meter) + INTEGER(IntKi) :: ErrStatLcl2 + + ! note that InitOut, InitInp, FFT_Data, CosWaveDir and SinWaveDir are used here, but their values are not changed + ErrStatLcl = ErrID_None + ErrMsgLcl = "" + + ! Zero out the temporary array. + tmpComplexArr = CMPLX(0.0_SiKi,0.0_SiKi) + + ! Loop through the positive frequency components (including zero). + DO I = 0,WaveField%NStepWave2 + + WaveNmbr = WaveNumber ( OmegaArr(I), InitInp%Gravity, WaveField%EffWtrDpth ) + tmpComplexArr(I) = CMPLX( WaveField%WaveElevC0(1,I), WaveField%WaveElevC0(2,I)) * & + EXP( -ImagNmbr*WaveNmbr*( Xcoord*CosWaveDir(I)+ & + Ycoord*SinWaveDir(I) ) ) + ENDDO + + CALL ApplyFFT_cx ( WaveElevAtXY(0:WaveField%NStepWave-1), tmpComplexArr, FFT_Data, ErrStatLcl2 ) + CALL SetErrStat(ErrStatLcl2,'Error occured while applying the FFT.',ErrStatLcl,ErrMsgLcl,'WaveElevTimeSeriesAtXY') + + WaveElevCAtXY( 1,: ) = REAL(tmpComplexArr(:)) + WaveElevCAtXY( 2,: ) = AIMAG(tmpComplexArr(:)) + + ! Append first datpoint as the last as aid for repeated wave data + WaveElevAtXY(WaveField%NStepWave) = WaveElevAtXY(0) + + END SUBROUTINE WaveElevTimeSeriesAtXY + +!-------------------------------------------------------------------------------- + SUBROUTINE CleanUp( ) + + IF (ALLOCATED( WaveKinPrimeMap )) DEALLOCATE( WaveKinPrimeMap, STAT=ErrStatTmp) + IF (ALLOCATED( WaveKinzi0Prime )) DEALLOCATE( WaveKinzi0Prime, STAT=ErrStatTmp) + IF (ALLOCATED( GHWaveAcc )) DEALLOCATE( GHWaveAcc, STAT=ErrStatTmp) + IF (ALLOCATED( GHWaveDynP )) DEALLOCATE( GHWaveDynP, STAT=ErrStatTmp) + IF (ALLOCATED( GHWaveVel )) DEALLOCATE( GHWaveVel, STAT=ErrStatTmp) + IF (ALLOCATED( GHWvDpth )) DEALLOCATE( GHWvDpth, STAT=ErrStatTmp) + IF (ALLOCATED( PWaveAcc0HxiPz0 )) DEALLOCATE( PWaveAcc0HxiPz0, STAT=ErrStatTmp) + IF (ALLOCATED( PWaveAcc0HyiPz0 )) DEALLOCATE( PWaveAcc0HyiPz0, STAT=ErrStatTmp) + IF (ALLOCATED( PWaveAcc0VPz0 )) DEALLOCATE( PWaveAcc0VPz0, STAT=ErrStatTmp) + IF (ALLOCATED( PWaveAccC0HxiPz0 )) DEALLOCATE( PWaveAccC0HxiPz0, STAT=ErrStatTmp) + IF (ALLOCATED( PWaveAccC0HyiPz0 )) DEALLOCATE( PWaveAccC0HyiPz0, STAT=ErrStatTmp) + IF (ALLOCATED( PWaveAccC0VPz0 )) DEALLOCATE( PWaveAccC0VPz0, STAT=ErrStatTmp) + IF (ALLOCATED( PWaveDynP0BPz0 )) DEALLOCATE( PWaveDynP0BPz0, STAT=ErrStatTmp) + IF (ALLOCATED( PWaveDynPC0BPz0 )) DEALLOCATE( PWaveDynPC0BPz0, STAT=ErrStatTmp) + IF (ALLOCATED( PWaveVel0HxiPz0 )) DEALLOCATE( PWaveVel0HxiPz0, STAT=ErrStatTmp) + IF (ALLOCATED( PWaveVel0HyiPz0 )) DEALLOCATE( PWaveVel0HyiPz0, STAT=ErrStatTmp) + IF (ALLOCATED( PWaveVel0VPz0 )) DEALLOCATE( PWaveVel0VPz0, STAT=ErrStatTmp) + IF (ALLOCATED( PWaveVelC0HxiPz0 )) DEALLOCATE( PWaveVelC0HxiPz0, STAT=ErrStatTmp) + IF (ALLOCATED( PWaveVelC0HyiPz0 )) DEALLOCATE( PWaveVelC0HyiPz0, STAT=ErrStatTmp) + IF (ALLOCATED( PWaveVelC0VPz0 )) DEALLOCATE( PWaveVelC0VPz0, STAT=ErrStatTmp) + IF (ALLOCATED( WaveAcc0Hxi )) DEALLOCATE( WaveAcc0Hxi, STAT=ErrStatTmp) + IF (ALLOCATED( WaveAcc0Hyi )) DEALLOCATE( WaveAcc0Hyi, STAT=ErrStatTmp) + IF (ALLOCATED( WaveAcc0V )) DEALLOCATE( WaveAcc0V, STAT=ErrStatTmp) + IF (ALLOCATED( WaveAccC0Hxi )) DEALLOCATE( WaveAccC0Hxi, STAT=ErrStatTmp) + IF (ALLOCATED( WaveAccC0Hyi )) DEALLOCATE( WaveAccC0Hyi, STAT=ErrStatTmp) + IF (ALLOCATED( WaveAccC0V )) DEALLOCATE( WaveAccC0V, STAT=ErrStatTmp) + IF (ALLOCATED( WaveDynP0B )) DEALLOCATE( WaveDynP0B, STAT=ErrStatTmp) + IF (ALLOCATED( WaveDynPC0 )) DEALLOCATE( WaveDynPC0, STAT=ErrStatTmp) + IF (ALLOCATED( WaveVel0Hxi )) DEALLOCATE( WaveVel0Hxi, STAT=ErrStatTmp) + IF (ALLOCATED( WaveVel0Hyi )) DEALLOCATE( WaveVel0Hyi, STAT=ErrStatTmp) + IF (ALLOCATED( WaveVel0V )) DEALLOCATE( WaveVel0V, STAT=ErrStatTmp) + IF (ALLOCATED( WaveVelC0Hxi )) DEALLOCATE( WaveVelC0Hxi, STAT=ErrStatTmp) + IF (ALLOCATED( WaveVelC0Hyi )) DEALLOCATE( WaveVelC0Hyi, STAT=ErrStatTmp) + IF (ALLOCATED( WaveVelC0V )) DEALLOCATE( WaveVelC0V, STAT=ErrStatTmp) + IF (ALLOCATED( tmpComplexArr )) DEALLOCATE( tmpComplexArr, STAT=ErrStatTmp) + + IF (ALLOCATED( WaveS1SddArr )) DEALLOCATE( WaveS1SddArr, STAT=ErrStatTmp) + IF (ALLOCATED( OmegaArr )) DEALLOCATE( OmegaArr, STAT=ErrStatTmp) + + IF (ALLOCATED( WaveAccC0HxiMCF )) DEALLOCATE( WaveAccC0HxiMCF, STAT=ErrStatTmp) + IF (ALLOCATED( WaveAccC0HyiMCF )) DEALLOCATE( WaveAccC0HyiMCF, STAT=ErrStatTmp) + IF (ALLOCATED( WaveAccC0VMCF )) DEALLOCATE( WaveAccC0VMCF, STAT=ErrStatTmp) + IF (ALLOCATED( WaveAcc0HxiMCF )) DEALLOCATE( WaveAcc0HxiMCF, STAT=ErrStatTmp) + IF (ALLOCATED( WaveAcc0HyiMCF )) DEALLOCATE( WaveAcc0HyiMCF, STAT=ErrStatTmp) + IF (ALLOCATED( WaveAcc0VMCF )) DEALLOCATE( WaveAcc0VMCF, STAT=ErrStatTmp) + IF (ALLOCATED( PWaveAccC0HxiMCFPz0 )) DEALLOCATE( PWaveAccC0HxiMCFPz0, STAT=ErrStatTmp) + IF (ALLOCATED( PWaveAccC0HyiMCFPz0 )) DEALLOCATE( PWaveAccC0HyiMCFPz0, STAT=ErrStatTmp) + IF (ALLOCATED( PWaveAccC0VMCFPz0 )) DEALLOCATE( PWaveAccC0VMCFPz0, STAT=ErrStatTmp) + IF (ALLOCATED( PWaveAcc0HxiMCFPz0 )) DEALLOCATE( PWaveAcc0HxiMCFPz0, STAT=ErrStatTmp) + IF (ALLOCATED( PWaveAcc0HyiMCFPz0 )) DEALLOCATE( PWaveAcc0HyiMCFPz0, STAT=ErrStatTmp) + IF (ALLOCATED( PWaveAcc0VMCFPz0 )) DEALLOCATE( PWaveAcc0VMCFPz0, STAT=ErrStatTmp) + + + RETURN + + END SUBROUTINE CleanUp + + +END SUBROUTINE VariousWaves_Init + + + + +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine is called at the start of the simulation to perform initialization steps. +!! The initial states and initial guess for the input are defined. +SUBROUTINE Waves_Init( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) + TYPE(Waves_InitInputType), INTENT(INOUT) :: InitInp !< Input data for initialization routine !NOTE: We are making this INOUT because UserWaveComponents_Init changes the value of InitInp%WaveDT + TYPE(Waves_InitOutputType), INTENT( OUT) :: InitOut !< Output for initialization routine + TYPE(SeaSt_WaveFieldType), INTENT(INOUT) :: WaveField ! SeaState wave field type containing the wave field data + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + ! Local Variables: + INTEGER(IntKi) :: ErrStatTmp ! Temporary error status for processing + CHARACTER(ErrMsgLen) :: ErrMsgTmp ! Temporary error message for procesing + + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrStatTmp = ErrID_None + ErrMsg = "" + ErrMsgTmp = "" + + + ! Initialize the pRNG + CALL RandNum_Init(InitInp%RNG, ErrStat, ErrMsg) + IF ( ErrStat >= AbortErrLev ) RETURN + + + ! Initialize the variables associated with the incident wave: + SELECT CASE ( WaveField%WaveMod ) ! Which incident wave kinematics model are we using? + + + CASE ( WaveMod_None ) ! None=still water. + + CALL StillWaterWaves_Init( InitInp, InitOut, WaveField, ErrStatTmp, ErrMsgTmp ) + CALL SetErrStat(ErrStatTmp,ErrMsgTmp,ErrStat,ErrMsg,'Waves_Init') + IF ( ErrStat >= AbortErrLev ) RETURN + + + + CASE ( WaveMod_Regular, WaveMod_JONSWAP, WaveMod_WhiteNoise, WaveMod_UserSpctrm, WaveMod_RegularUsrPh ) ! 1, 10: Plane progressive (regular) wave, 2: JONSWAP/Pierson-Moskowitz spectrum (irregular) wave, 3: white-noise, or 4: user-defined spectrum (irregular) wave. + + ! Now call the init with all the zi locations for the Morrison member nodes + CALL VariousWaves_Init( InitInp, InitOut, WaveField, ErrStatTmp, ErrMsgTmp ) + CALL SetErrStat(ErrStatTmp,ErrMsgTmp,ErrStat,ErrMsg,'Waves_Init') + IF ( ErrStat >= AbortErrLev ) RETURN + + + CASE ( WaveMod_ExtElev ) ! User-supplied wave elevation time history; HD derives full wave kinematics from this elevation time series data. + + ! Get the wave frequency information from the file (by FFT of the elevation) + CALL UserWaveElevations_Init( InitInp, InitOut, WaveField, ErrStatTmp, ErrMsgTmp ) + CALL SetErrStat(ErrStatTmp,ErrMsgTmp,ErrStat,ErrMsg,'Waves_Init') + IF ( ErrStat >= AbortErrLev ) RETURN + + ! Now call VariousWaves to continue using the wave elevation and derived frequency information from the file + CALL VariousWaves_Init( InitInp, InitOut, WaveField, ErrStatTmp, ErrMsgTmp ) + CALL SetErrStat(ErrStatTmp,ErrMsgTmp,ErrStat,ErrMsg,'Waves_Init') + IF ( ErrStat >= AbortErrLev ) RETURN + + + CASE ( WaveMod_ExtFull ) ! User-supplied wave kinematics data. + + CALL UserWaves_Init( InitInp, InitOut, WaveField, ErrStatTmp, ErrMsgTmp ) + CALL SetErrStat(ErrStatTmp,ErrMsgTmp,ErrStat,ErrMsg,'Waves_Init') + IF ( ErrStat >= AbortErrLev ) RETURN + + CASE ( WaveMod_UserFreq ) + + ! Get the wave frequency information from the file (by reading in wave frequency components) + CALL UserWaveComponents_Init( InitInp, InitOut, WaveField, ErrStatTmp, ErrMsgTmp ) + CALL SetErrStat(ErrStatTmp,ErrMsgTmp,ErrStat,ErrMsg,'Waves_Init') + IF ( ErrStat >= AbortErrLev ) RETURN + + ! Now call VariousWaves to continue using the wave frequency information from the file + CALL VariousWaves_Init( InitInp, InitOut, WaveField, ErrStatTmp, ErrMsgTmp ) + CALL SetErrStat(ErrStatTmp,ErrMsgTmp,ErrStat,ErrMsg,'Waves_Init') + IF ( ErrStat >= AbortErrLev ) RETURN + + ENDSELECT + +END SUBROUTINE Waves_Init + + + +!======================================================================= +FUNCTION WheelerStretching ( zOrzPrime, Zeta, h, ForwardOrBackward, ErrStat, ErrMsg ) + + + ! This FUNCTION applies the principle of Wheeler stretching to + ! (1-Forward) find the elevation where the wave kinematics are to + ! be applied using Wheeler stretching or (2-Backword) find the + ! elevation where the wave kinematics are computed before applying + ! Wheeler stretching. Wheeler stretching says that wave + ! kinematics calculated using Airy theory at the mean sea level + ! should actually be applied at the instantaneous free surface and + ! that Airy wave kinematics computed at locations between the + ! seabed and the mean sea level should be shifted vertically to + ! new locations in proportion to their elevation above the seabed + ! as follows: + ! + ! Forward: z(zPrime,Zeta,h) = ( 1 + Zeta/h )*zPrime + Zeta + ! + ! or equivalently: + ! + ! Backword: zPrime(z,Zeta,h) = ( z - Zeta )/( 1 + Zeta/h ) + ! + ! where, + ! Zeta = instantaneous elevation of incident waves + ! h = water depth + ! z = elevations where the wave kinematics are to be + ! applied using Wheeler stretching + ! zPrime = elevations where the wave kinematics are computed + ! before applying Wheeler stretching + + + + IMPLICIT NONE + + + ! Passed Variables: + + REAL(ReKi), INTENT(IN ) :: h ! Water depth (meters) + REAL(SiKi) :: WheelerStretching ! This function = zPrime [forward] or z [backward] (meters) + REAL(SiKi), INTENT(IN ) :: Zeta ! Instantaneous elevation of incident waves (meters) + REAL(SiKi), INTENT(IN ) :: zOrzPrime ! Elevations where the wave kinematics are to be applied using Wheeler stretching, z, [forward] or elevations where the wave kinematics are computed before applying Wheeler stretching, zPrime, [backward] (meters) + CHARACTER(1), INTENT(IN ) :: ForwardOrBackWard ! A string holding the direction ('F'=Forward, 'B'=Backward) for applying Wheeler stretching. + 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 = "" + + ! Apply Wheeler stretching, depending on the direction: + + SELECT CASE ( ForwardOrBackWard ) + + CASE ( 'F' ) ! Forward + + WheelerStretching = ( 1.0 + Zeta/REAL(h,SiKi) )*zOrzPrime + Zeta + + + CASE ( 'B' ) ! Backward + + WheelerStretching = ( zOrzPrime - Zeta )/( 1.0 + Zeta/REAL(h,SiKi) ) + + + CASE DEFAULT + + WheelerStretching = 0.0_SiKi + + ErrMsg = 'The last argument in routine WheelerStretching() must be ''F'' or ''B''.' + ErrStat = ErrID_Fatal + RETURN + + + END SELECT + + + + RETURN +END FUNCTION WheelerStretching + +!------------------------------------------------------------------------------------------------------------------------ +SUBROUTINE CalculateWaveNDir(InitInp, InitOut, WaveField, ErrStat, ErrMsg) + TYPE(Waves_InitInputType), INTENT(IN ) :: InitInp ! Input data for initialization routine + TYPE(Waves_InitOutputType), INTENT(INOUT) :: InitOut ! Output data + TYPE(SeaSt_WaveFieldType), INTENT(INOUT) :: WaveField + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + + INTEGER(IntKi) :: I ! loop counter + INTEGER(IntKi) :: WaveNDirMax !< Maximum value we can change WaveNDir to (relative to original value passed in). Used in finding new WaveNDir value. + + INTEGER(IntKi) :: ErrStatTmp !< Temporary error status + CHARACTER(ErrMsgLen) :: ErrMsgTmp !< Temporary error message + character(*), parameter :: RoutineName = 'CalculateWaveNDir' + + + ! Initialize ErrStat + + ErrStat = ErrID_None + ErrMsg = "" + + + WaveNDirMax = CEILING(InitInp%WaveNDir*1.25_SiKi) ! Value we allow WaveNDir to reach before aborting + InitOut%WaveNDir = InitInp%WaveNDir + + ! Check that the number of wave directions is a positive odd number. In theory this has been + ! done before the Waves module was called. We repeat it here in the event that the Waves module + ! gets used in some other code. + ! -> If it is less than 0, error out. + ! -> If it is even, we will increment it by 1. + IF ( InitOut%WaveNDir <= 0_IntKi ) THEN + CALL SetErrStat(ErrID_Fatal,'WaveNDir must be an odd number greater than 0.',ErrStat,ErrMsg,RoutineName) + RETURN + END IF + + IF ( MODULO( InitOut%WaveNDir, 2_IntKi) == 0_IntKi ) THEN + InitOut%WaveNDir = InitOut%WaveNDir + 1 + CALL SetErrStat(ErrID_Warn,'WaveNDir must be odd. Changing the value to '//TRIM(Num2LStr(InitOut%WaveNDir)),ErrStat,ErrMsg,RoutineName) + END IF + + + ErrStatTmp = ErrID_None + ErrMsgTmp = "" + + DO WHILE ( .NOT. EqualRealNos( REAL(WaveField%NStepWave2/InitOut%WaveNDir), REAL(WaveField%NStepWave2)/REAL(InitOut%WaveNDir) )) + + IF (InitOut%WaveNDir > WaveNDirMax ) THEN + ErrMsgTmp = 'Could not find value for WaveNDir between '//TRIM(Num2LStr(InitInp%WaveNDir))//' and '// & + TRIM(Num2LStr(WaveNDirMax))//' such that an equal number of frequencies are assigned to each direction.' + ErrStatTmp = ErrID_Fatal + EXIT + ELSE + InitOut%WaveNDir = InitOut%WaveNDir + 2 + ErrMsgTmp = 'Changed WaveNDir from '//TRIM(Num2LStr(InitInp%WaveNDir))//' to '// TRIM(Num2LStr(InitOut%WaveNDir))// & + ' so that an equal number of frequencies are assigned to each direction.' + ErrStatTmp = ErrID_Warn + END IF + + END DO + + CALL SetErrStat(ErrStatTmp, ErrMsgTmp, ErrStat, ErrMsg, RoutineName) + + + IF (ErrStat == ErrID_Fatal) THEN + + ! If we exited because we hit a limit (in which case the condition is not satisfied), then we cannot continue. + ! We warn the user that a value for WaveNDir was not found, and that they should try a different value, or try + ! a different value for WaveTMax. The reason for suggesting the latter is that NStepWave is derived from + ! WaveTMax and adjusted until it is a product of smallish numbers (most likely even, but not necessarily so). + ! So, there is a very small possibility then that NStepWave2 is a prime number, in which case we won't find a + ! value for WaveNDir, so we suggest that the user change WaveTMax. To make this a little easier for the user, + ! we will report the first 5 possible values for WaveNDir between their requested value and 1/4 of NStepWave2, + ! if there are any. + + + ! Now check for the possible values of WaveNDir (up to I=5) so that we can tell the user about it. + I = 0 + ErrMsgTmp = 'The next values of WaveNDir that work with the selected values for WaveTMax and WaveDT:' + DO WHILE ( InitOut%WaveNDir <= INT(WaveField%NStepWave2/4.0) ) + IF ( EqualRealNos(REAL(WaveField%NStepWave2/InitOut%WaveNDir), & + REAL(WaveField%NStepWave2)/REAL(InitOut%WaveNDir) )) THEN + ErrMsgTmp = TRIM(ErrMsgTmp)//" "//TRIM(Num2LStr(InitOut%WaveNDir)) + I = I + 1 + IF (I >= 5) EXIT ! limit the number of choices for WaveNDir that are printed + END IF + + InitOut%WaveNDir = InitOut%WaveNDir + 2 + END DO + + ! If there were no additional values for WaveNDir found, I will be 0, so we rewrite the error message. + IF ( I == 0 ) THEN + ErrMsgTmp = 'There are no values for WaveNDir between '//TRIM(Num2LStr(WaveNDirMax))//' and '// & + TRIM(Num2LStr(INT(WaveField%NStepWave2/4.0)))//' (4 frequencies per wave direction)'// & + ' that will work with the selected values for WaveTMax ('//TRIM(Num2Lstr(InitOut%WaveTMax))// & + ') and WaveDT ('//TRIM(Num2LStr(InitInp%WaveDT))//'). Change either WaveTMax or WaveDT.' + ELSE + ErrMsgTmp = TRIM(ErrMsgTmp)//'.' + ENDIF + + ! Append the message about the possible values for WaveNDir (if any were found) and set the error status before + ! returning to the calling program. + CALL SetErrStat(ErrID_Fatal,ErrMsgTmp,ErrStat,ErrMsg,RoutineName) + RETURN + END IF + +END SUBROUTINE CalculateWaveNDir +!------------------------------------------------------------------------------------------------------------------------ +SUBROUTINE CalculateWaveDirection(InitInp, InitOut, WaveField, ErrStat, ErrMsg ) +! Compute the wave direction array, InitOut%WaveDirArr +!---------------------------------------------------------------------------------------------------------------------------------- + + TYPE(Waves_InitInputType), INTENT(IN ) :: InitInp ! Input data for initialization routine + TYPE(Waves_InitOutputType), INTENT(INOUT) :: InitOut ! Output data + TYPE(SeaSt_WaveFieldType), INTENT(INOUT) :: WaveField + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + + ! Local Variables + REAL(SiKi), ALLOCATABLE :: WvTheta(:) !< Final set of wave directions (degrees) + REAL(SiKi), ALLOCATABLE :: WvSpreadThetaIdx(:) !< Indices for wave directions + INTEGER(IntKi) :: WvSpreadFreqPerDir !< Number of wave frequencies per direction + INTEGER :: I ! Generic index + INTEGER :: J ! Generic index + INTEGER :: K ! Generic index + INTEGER :: LastInd ! Index into the arrays saved from the last call as a starting point for this call + + ! Variables for error handling + INTEGER(IntKi) :: ErrStatTmp !< Temporary error status + CHARACTER(ErrMsgLen) :: ErrMsgTmp !< Temporary error message + character(*), parameter :: RoutineName = 'CalculateWaveDirection' + + + ! Initialize ErrStat + + ErrStat = ErrID_None + ErrMsg = "" + + + IF (WaveField%WaveMod == WaveMod_UserFreq) THEN ! wavemod 0 (WaveMod_None) and 6 (WaveMod_ExtFull) aren't called from this routine, but they fall into this case, too + + RETURN + !InitOut%WaveDirArr set in UserWaveComponents_Init for WaveMod 7 + !InitOut%WaveDirArr = 0, set in Initial_InitOut_Arrays for WaveMod 0 and 6 (WaveMod_ExtFull) + + ELSEIF(.not. WaveField%WaveMultiDir .or. InitInp%WaveNDir <= 1) THEN ! we have a single wave direction + + WaveField%WaveDirArr = WaveField%WaveDir + + ELSE ! multi directional waves + + !-------------------------------------------------------------------------------- + !> # Multi Directional Waves + !> ## Adjust WaveNDir + !! + !! If multi-directional waves will be used, the value of WaveNDir may need to be adjusted. The reason is that + !! for the equal energy approach used here, the following condition must be met: + !! + !! CONDITION: (NStepWave2) / WaveNDir must be an integer + !! + !! If this is true, then an equal number of frequencies is assigned to each of the WaveNDir directions which + !! gives the proper wave direction distribution function. Otherwise, the energy distribution by direction + !! will not be correct. + !! + !! _WaveNDir_ could not be adjusted before _NStepWave2_ was finalized above. + !! + !! @note Use the value of WaveNDir stored in InitOut since InitInp cannot be changed. + !! + !! @note Originally, the criteria had been that (NStepWave2 - 1) / WaveNDir is an integer. This criteria + !! was relaxed by setting the direction for OmegaArr(I) = 0 (which has no amplitude) since it was found that + !! (NStepWave2 - 1) is often a prime number due to how NStepWave is calculated above to be a product + !! of smallish numbers. + + ! this sets InitOut%WaveNDir: + call CalculateWaveNDir(InitInp, InitOut, WaveField, ErrStatTmp, ErrMsgTmp) + call SetErrStat(ErrStatTmp,ErrMsgTmp,ErrStat,ErrMsg,RoutineName) + if (ErrStat >= AbortErrLev) then + call Cleanup() + return + end if + + + ! This allocates and sets WvTheta: + call CalculateWaveSpreading(InitInp, InitOut, WaveField, WvTheta, ErrStatTmp, ErrMsgTmp) + call SetErrStat(ErrStatTmp,ErrMsgTmp,ErrStat,ErrMsg,RoutineName) + if (ErrStat >= AbortErrLev) then + call Cleanup() + return + end if + + + !> ## Assign Wave directions + !! For the equal energy approach to the multi-directional waves, we need to use the random number generator to + !! select which direction each wave frequency is assigned to. We also require that the phase and amplitudes + !! assigned to each frequency are the same regardless of whether or not multiple directions are used, we must + !! first finish assigning all the amplitudes and phases before using the random number generator again. For this + !! reason, the above do loop is completed, the multiple wave directions are computed, and then we run through the + !! all wave frequencies again to set up the remaining pieces. If we did not do this, we would change the seed + !! used by the random number generator before selecting the next amplitude and phase pair. + !! + !! The wave directions are assigned in groups of _WaveNDir_ frequencies such that each frequency is assigned to + !! one of the _WaveNDir_ unique wave directions. Each wave direction is used only once within each group of + !! frequencies. + !! + + + ! Allocate the index array for each group of frequencies. This array is used to randomize the directions + ! within each WaveNDir sized group of frequencies. This is a REAL array used to hold the random numbers. + ALLOCATE( WvSpreadThetaIdx(1:InitOut%WaveNDir), STAT=ErrStatTmp ) + IF (ErrStatTmp /= 0) THEN + CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WvSpreadThetaIdx while assigning wave directions.',ErrStat,ErrMsg,RoutineName) + CALL CleanUp() + RETURN + END IF + + + ! K should be exactly NStepWave2 when done assigning directions. The the Omega = 0 has + ! no amplitude, but gets a direction anyhow (to simplify the calculation of WaveNDir). + WvSpreadFreqPerDir = (WaveField%NStepWave2)/InitOut%WaveNDir + K = 0 + ! Work through the frequencies in groups of directions. + DO I = 1,WvSpreadFreqPerDir + + ! Populate the array with random numbers + CALL UniformRandomNumbers(InitInp%RNG%pRNG, WvSpreadThetaIdx) + + DO J = 1, InitOut%WaveNDir + + ! Find the index lowest value in the WvSpreadThetaIdx array. This is the index to + ! use for this wave direction. + LastInd = MINLOC( WvSpreadThetaIdx, DIM=1 ) + + ! Assign the direction for this frequency piece to the LastInd value. + WaveField%WaveDirArr(K) = WvTheta( LastInd ) + + ! Now make that element in the WvSpreadThetaIdx really big so we don't pick it again + WvSpreadThetaIdx( LastInd ) = HUGE(1.0_SiKi) + + K = K + 1 ! Increment the frequency index + + ENDDO + ENDDO + + ! Filling last value since it is not reached by the loop above + CALL UniformRandomNumbers(InitInp%RNG%pRNG, WvSpreadThetaIdx) + LastInd = MINLOC( WvSpreadThetaIdx, DIM=1 ) + WaveField%WaveDirArr(K) = WvTheta( LastInd ) + + ! Perform a quick sanity check. We should have assigned all wave frequencies a direction, so K should be + ! K = NStepWave2 (K is incrimented afterwards). + IF ( K /= (WaveField%NStepWave2 ) ) THEN + CALL SetErrStat(ErrID_Fatal, 'Something went wrong while assigning wave directions.',ErrStat,ErrMsg,RoutineName) + CALL CleanUp() + RETURN + END IF + + ENDIF ! Multi-directional waves in use. + + + CALL Cleanup() + +CONTAINS + SUBROUTINE Cleanup() + + IF(ALLOCATED( WvSpreadThetaIdx )) DEALLOCATE( WvSpreadThetaIdx ) + IF(ALLOCATED( WvTheta )) DEALLOCATE( WvTheta ) + + END SUBROUTINE Cleanup + +END SUBROUTINE CalculateWaveDirection +!------------------------------------------------------------------------------------------------------------------------ +SUBROUTINE CalculateWaveSpreading(InitInp, InitOut, WaveField, WvTheta, ErrStat, ErrMsg ) +! Compute the wave direction array +!---------------------------------------------------------------------------------------------------------------------------------- + + TYPE(Waves_InitInputType), INTENT(IN ) :: InitInp !< Input data for initialization routine + TYPE(Waves_InitOutputType), INTENT(INOUT) :: InitOut !< Output data + TYPE(SeaSt_WaveFieldType), INTENT(INOUT) :: WaveField + REAL(SiKi), ALLOCATABLE, INTENT( OUT) :: WvTheta(:) !< Final set of wave directions (degrees) + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + INTEGER(IntKi) :: i !< loop counter + INTEGER(IntKi) :: LastInd !< last index found (for faster finding of next index) + INTEGER(IntKi) :: WvSpreadNDir !< Number of wave spreading directions for intermediate calculations. Set later to be MAX(15*InitOut%WaveNDir,1000) + REAL(SiKi), ALLOCATABLE :: WvSpreadCos2SArr(:) !< Wave spreading function results array. Used in equal energy wave spreading function. + REAL(SiKi) :: WvSpreadCos2SConst !< Normalization constant for wave spreading function. + REAL(SiKi), ALLOCATABLE :: WvSpreadIntegral(:) !< Cumulative integral of the wave spreading function. Used in finding equal energy wave directions. + REAL(SiKi) :: WvSpreadDTheta !< Wave direction step size for intermediate calculations. Used in finding equal energy wave directions. + REAL(SiKi), ALLOCATABLE :: WvSpreadThetas(:) !< Wave direction used in calculations and interpolations + REAL(SiKi) :: WvSpreadIntegralTmp !< Temporary variable for the interpolation + + ! Variables for error handling + INTEGER(IntKi) :: ErrStatTmp !< Temporary error status + character(*), parameter :: RoutineName = 'CalculateWaveSpreading' + + + ErrStat = ErrID_None + ErrMsg = "" + + !> ## Calculate the wave directions based on an equal energy approach. + !! + !! All the angles are supplied in degrees and are converted as needed. For the cosine function, + !! we could convert degrees to radians, but the conversion constant cancels out. + !! + !! | Variable | Fortran Name | Location | Units | Description | + !! | :----------------: | :-------------------: | :-------: | :--------: | :----------------------------------------------------- | + !! | \f$\bar\theta\f$ | _WaveDir_ | _InitInp_ | (degrees) | Mean direction heading (_WaveDir_) | + !! | \f$\Theta\f$ | _WaveNDir_ | _InitOut_ | (-) | Number of wave directions | + !! | \f$\delta\theta\f$ | _WaveDirRange_ | _InitInp_ | (degrees) | Full range of spreading function | + !! | \f$S\f$ | _WaveDirSpread_ | _InitInp_ | (-) | The spreading coefficient | + !! | | _WvSpreadNDir_ | local | (-) | Number of angles discretizing the spreading function | + !! | \f$C\f$ | _WvSpreadCos2SConst_ | local | (1/degrees) | The normalization coefficient | + !! | | _WvTheta_ | local | (degrees) | The interpolated wave directions to assign to | + !! | \f$\theta_i\f$ | _WvSpreadThetas_ | local | (degrees) | Array of wave directions associated with _WvSpreadIntegral_ | + !! | | _D2R_ | global | (rad/degree) | Constant from library to convert degrees to radians | + !! + !! The equal energy approach is used to set the wave directions such that each direction has the same + !! number of frequencies. To ensure that direction spreading function (Cosine^2S in this case) has + !! the correct overal energy distribution shape, the wave directions are adjusted. The spacing between + !! directions is closer near the central direction than in the tails of the spreading function. The + !! method distributes the wave directions so that the energy integral between wave directions is kept + !! constant. The following steps are taken: + !! + !! 1. Discretize the spreading function over the range _InitInp%WaveDirRange_ into _WvSpreadNDir_. + !! + !! 2. Calculate the spreading function, _WvSpreadCos2SArr_, in the range.\n + !! \f$ D(\theta) = C \left| \cos\left(\frac{\pi (\theta-\bar\theta)}{\delta\theta}\right)\right|^{2S} \f$\n + !! where\n + !! \f$ C = \frac{\sqrt{\pi} \: \Gamma(S+1)}{\delta\theta \: \Gamma(S+1/2)} \f$, + !! and + !! \f$ \Gamma \f$ is the gamma function. + !! + !! 3. Calculate the integral of WvSpreadCos2SArr up to the current angle, and save it as + !! WvSpreadIntegral. The integral can be written as:\n + !! \f$P(\theta) = \int\limits^{\theta}_{\bar\theta - \delta\theta/2} D(\theta') \: \mathrm{d}\theta'\f$ + !! + !! 4. Do a sanity check on the result of \f$P(\theta)\f$ over the range. + !! + !! 5. Divide the integrated area of _WvSpreadCos2SArr_ into _InitOut%WaveNDir_ directions (the final number + !! of wave directions that was solved for above). To do this, simply find the _1/WaveNDir_ values + !! of the integral and interpolate to find the values of the _WvSpreadThetas_ that match. These are the + !! new wave directions to use. These results are stored in the array _WvTheta_. + !! + !! 6. Cleanup + !! + + !> ### Code Implementation order + !! 1. Discretize the spreading function range and calculate the values of the wave spreading function + + ! Now that we have the value for _WaveNDir_ found above, we set the value of _WvSpreadNDir_ to be 15x as + ! large, or 1000 (whichever is larger). WvSpreadNDir is used only in discretization for later + ! interpolation of actual wave directions. + WvSpreadNDir = MAX(15*InitOut%WaveNDir,1000) + WvSpreadDTheta = InitInp%WaveDirRange/REAL(WvSpreadNDir,SiKi) + + ! Calculate the normalization constant for the wave spreading. + IF ( InitInp%WaveDirSpread < 25.0_SiKi ) THEN ! Use exact expression + WvSpreadCos2SConst = sqrt(Pi) * (NWTC_GAMMA(InitInp%WaveDirSpread + 1.0_SiKi))/(InitInp%WaveDirRange * NWTC_GAMMA(InitInp%WaveDirSpread + 0.5_SiKi)) + ELSE ! Use asymptotic approximation for large argument + WvSpreadCos2SConst = sqrt(Pi*InitInp%WaveDirSpread)*(1.0_SiKi+0.125_SiKi/InitInp%WaveDirSpread)/InitInp%WaveDirRange + ENDIF + + ! Allocate arrays to use for storing the intermediate values + ALLOCATE( WvSpreadCos2SArr(0:WvSpreadNDir), STAT=ErrStatTmp ); IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WvSpreadCos2SArr.', ErrStat,ErrMsg,RoutineName) + ALLOCATE( WvSpreadIntegral(0:WvSpreadNDir), STAT=ErrStatTmp ); IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WvSpreadIntegral.', ErrStat,ErrMsg,RoutineName) + ALLOCATE( WvSpreadThetas( 0:WvSpreadNDir), STAT=ErrStatTmp ); IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WvSpreadThetas.', ErrStat,ErrMsg,RoutineName) + ALLOCATE( WvTheta(1:InitOut%WaveNDir), STAT=ErrStatTmp ); IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WvTheta.', ErrStat,ErrMsg,RoutineName) + + IF ( ErrStat >= AbortErrLev ) THEN + CALL CleanUp() + RETURN + END IF + + !> 2. Calculate the spreading function as a function of angle. Step through all _WvSpreadNDir_ steps. + DO I=0,WvSpreadNDir + ! The current angle as we step through the range + WvSpreadThetas(I) = I*WvSpreadDTheta + WaveField%WaveDir - InitInp%WaveDirRange/(2.0_SiKi) + + ! Calculate the wave spreading for the current value of WvSpreadThetas + WvSpreadCos2SArr(I) = WvSpreadCos2SConst*abs( cos(Pi*(WvSpreadThetas(I)-WaveField%WaveDir)/InitInp%WaveDirRange) ) **(2*InitInp%WaveDirSpread) + + !> 3. Calculate the integral of the spreading function up to the current angle and save it. + ! Remember that the first element can't refer to one before it. + IF (I == 0) THEN + WvSpreadIntegral(I) = WvSpreadCos2SArr(I) * WvSpreadDTheta + ELSE + WvSpreadIntegral(I) = WvSpreadCos2SArr(I) * WvSpreadDTheta + WvSpreadIntegral(I-1) + END IF + ENDDO + + + !> 4. Perform a quick sanity check. The last value of the integral table should be 1.0 exactly. + !! We will allow for a 1% deviation. If for some reason an error occurs, it may be due to the + !! GAMMA function calculation for the normalization constant, _WvSpreadCos2SConst_. + IF ( WvSpreadIntegral(WvSpreadNDir) < 0.99_SiKi .OR. WvSpreadIntegral(WvSpreadNDir) > 1.01_SiKi ) THEN + CALL SetErrStat(ErrID_Fatal,' Something went wrong in evaluating the multidirectional wave spreading function. '// & + 'Integral is '//TRIM(Num2LStr(WvSpreadIntegral(WvSpreadNDir))),ErrStat,ErrMsg,RoutineName) + call Cleanup() + RETURN + END IF + + + !> 5. Set the wave directions using the results from the integral. + ! We will use the variable LastInd as a simple index for figuring out where in the array we are. First set to 0 + LastInd = 0_IntKi + DO I=1,InitOut%WaveNDir + WvSpreadIntegralTmp = (REAL(I)-0.5_SiKi)/REAL(InitOut%WaveNDir) + WvTheta(I) = InterpStp( WvSpreadIntegralTmp, WvSpreadIntegral, WvSpreadThetas, LastInd, WvSpreadNDir ) + ENDDO ! I=1,InitOut%WaveNDir + + + !> 6. Done with equal energy wavedirection calculations. Deallocate the arrays used during calculations. + + CALL CleanUp() + + +contains + subroutine Cleanup() + IF(ALLOCATED( WvSpreadCos2SArr )) DEALLOCATE( WvSpreadCos2SArr, STAT=ErrStatTmp ) + IF(ALLOCATED( WvSpreadIntegral )) DEALLOCATE( WvSpreadIntegral, STAT=ErrStatTmp ) + IF(ALLOCATED( WvSpreadThetas )) DEALLOCATE( WvSpreadThetas, STAT=ErrStatTmp ) + end subroutine Cleanup + +END SUBROUTINE CalculateWaveSpreading +!------------------------------------------------------------------------------------------------------------------------ +!> sets WaveS1SddArr(:) and InitOut%WaveElevC0 +SUBROUTINE Get_1Spsd_and_WaveElevC0(InitInp, InitOut, WaveField, OmegaArr, WaveS1SddArr) + + TYPE(Waves_InitInputType), INTENT(IN ) :: InitInp ! Input data for initialization routine + TYPE(Waves_InitOutputType), INTENT(INOUT) :: InitOut ! Output data + TYPE(SeaSt_WaveFieldType), INTENT(INOUT) :: WaveField + REAL(SiKi), INTENT(IN ) :: OmegaArr(0:WaveField%NStepWave2) !< Array of all non-negative angular frequencies (rad/s) + REAL(SiKi), INTENT( OUT) :: WaveS1SddArr(0:WaveField%NStepWave2) !< One-sided power spectral density of the wave spectrum at all non-negative frequencies (m^2/(rad/s)) + + COMPLEX(SiKi) :: WGNC(0:WaveField%NStepWave2) ! Discrete Fourier transform of the realization of a White Gaussian Noise (WGN) time series process with unit variance for the current frequency component (-) + INTEGER :: I ! Loop counter + INTEGER :: I_WaveTp ! The index of the frequency component nearest to WaveTp + REAL(SiKi) :: SQRTNStepWave2 ! SQRT( NStepWave/2 ) + COMPLEX(SiKi) :: tmpComplex ! A temporary varible to hold the complex value of the wave elevation before storing it into a REAL array + REAL(SiKi) :: WaveS2Sdd ! Two-sided power spectral density of the wave spectrum per unit time for the current frequency component (m^2/(rad/s)) + + + IF ( WaveField%WaveMod == WaveMod_ExtElev .OR. WaveField%WaveMod == WaveMod_UserFreq) THEN ! Wave elevation or frequency component data read in (5 or 7) + + DO I = 0,WaveField%NStepWave2 + + ! Apply limits to the existing WaveElevC0 arrays if outside frequency range + IF ( OmegaArr(I) < WaveField%WvLowCOff .OR. OmegaArr(I) > WaveField%WvHiCOff ) THEN + WaveField%WaveElevC0(:,I) = 0.0_SiKi + ENDIF + + END DO + + WaveS1SddArr = 0 ! unused here + RETURN + + END IF + + + I_WaveTp = NINT ( TwoPi/(WaveField%WaveDOmega*InitInp%WaveTp) ) ! Compute the index of the frequency component nearest to WaveTp. Note, we don't check if it's a valid index into the arrays + + ! Compute the discrete Fourier transform of the realization of a White + ! Gaussian Noise (WGN) time series process with unit variance: + + ! --------------------------------- + ! Set White Gaussian Noise with unit variance + ! + ! NOTE: For the time series process to be real with zero mean, the values at + ! OmegaArr(I) == 0.0 and OmegaArr(I) == NStepWave2*WaveDOmega (= WaveOmegaMax) + ! must be zero. + !--------------------------------- + ! I == 1 or WaveField%NStepWave2 if ( OmegaArr(I) == 0.0 ) or ( OmegaArr(I) == NStepWave2*WaveDOmega (= WaveOmegaMax) ) + WGNC(1) = (0.0,0.0) + WGNC(WaveField%NStepWave2) = (0.0,0.0) + + IF ( WaveField%WaveMod == WaveMod_RegularUsrPh ) THEN ! .TRUE. for plane progressive (regular) waves with a specified phase + DO I = 0,WaveField%NStepWave2-1 ! Loop through the positive frequency components (including zero) of the discrete Fourier transforms + IF (I==1) CYCLE + + WGNC(I) = BoxMuller ( InitInp%RNG%pRNG, InitInp%WaveNDAmp, InitInp%WavePhase ) + END DO + ELSE ! All other OmegaArr(I) + DO I = 0,WaveField%NStepWave2-1 ! Loop through the positive frequency components (including zero) of the discrete Fourier transforms + IF (I==1) CYCLE + + WGNC(I) = BoxMuller ( InitInp%RNG%pRNG, InitInp%WaveNDAmp ) + END DO + END IF + + !------------------------------------ + ! For (WaveMod=1 plane progressive (regular); and WaveMod=10 plane progressive (regular) waves with a specified phase) + ! adjust WGNC and set PSD at specified frequency + !------------------------------------ + IF (WaveField%WaveMod == WaveMod_RegularUsrPh .or. WaveField%WaveMod == WaveMod_Regular) THEN !10 or 1 + WaveS1SddArr = 0.0 + + IF (I_WaveTp < WaveField%NStepWave2 .and. (I_WaveTp > 1 .or. I_WaveTp == 0) ) THEN + + ! This scaling of WGNC is used to ensure that the Box-Muller method is only providing a random phase, + ! not a magnitude change, at the frequency of the plane progressive wave. The SQRT(2.0) is used to + ! ensure that the time series WGN process has unit variance (i.e. sinusoidal with amplitude SQRT(2.0)). + ! + ! NOTE: the denominator here will never equal zero since U1 cannot equal 1.0, and thus, C1 cannot be 0.0 in the Box-Muller method. + + WGNC(I_WaveTp) = WGNC(I_WaveTp) * ( SQRT(2.0_SiKi) / ABS(WGNC(I_WaveTp)) ) + + ! Plane progressive (regular) wave; the wave spectrum is an impulse function centered on frequency component closest to WaveTp. + WaveS1SddArr(I_WaveTp) = 0.5_SiKi * (InitInp%WaveHs/2.0_SiKi)**2 / WaveField%WaveDOmega + + END IF + ELSE + + DO I = 0,WaveField%NStepWave2 + + IF ( OmegaArr(I) < WaveField%WvLowCOff .OR. OmegaArr(I) > WaveField%WvHiCOff ) THEN ! .TRUE. if OmegaArr(I) is above or below the cut-off frequency + ! Zero-out the wave spectrum above the cut-off frequency. We must cut-off the frequency in order to + ! void nonphysical wave forces. Waves that have wavelengths much smaller than the platform diameter + ! (high frequency) do not contribute to the net force because regions of positive and negative + ! velocity/acceleration are experienced by the platform at the same time and cancel out. + + WaveS1SddArr(I) = 0.0 + + ELSE + + SELECT CASE ( WaveField%WaveMod ) ! Which incident wave kinematics model are we using? + CASE ( WaveMod_JONSWAP ) ! JONSWAP/Pierson-Moskowitz spectrum (irregular) wave. + WaveS1SddArr(I) = JONSWAP ( OmegaArr(I), InitInp%WaveHs, InitInp%WaveTp, InitInp%WavePkShp ) + CASE ( WaveMod_WhiteNoise ) ! White-noise + WaveS1SddArr(I) = InitInp%WaveHs * InitInp%WaveHs / ( 16.0 * (WaveField%WvHiCOff - WaveField%WvLowCOff) ) + CASE ( WaveMod_UserSpctrm ) ! User-defined spectrum (irregular) wave. + CALL UserWaveSpctrm ( OmegaArr(I), WaveField%WaveDir, InitInp%DirRoot, WaveS1SddArr(I) ) + ENDSELECT + + END IF + + END DO + + + END IF + + + ! --------------------------------- + ! Compute the one-sided power spectral density of the wave spectrum per unit + ! time; zero-out the wave spectrum above the cut-off frequency: + !--------------------------------- + SQRTNStepWave2 = SQRT( REAL( WaveField%NStepWave2, SiKi ) ) ! Compute SQRT( NStepWave/2 ). + + DO I = 0,WaveField%NStepWave2 + ! Compute the two-sided power spectral density of the wave spectrum per unit + ! time: + + WaveS2Sdd = 0.5_SiKi*WaveS1SddArr(I) + + ! Compute the discrete Fourier transform of the instantaneous elevation of + ! incident waves at the WAMIT reference point: + tmpComplex = SQRTNStepWave2 * WGNC(I) *SQRT( TwoPi_R4 * WaveS2Sdd / REAL(InitInp%WaveDT,SiKi) ) + WaveField%WaveElevC0 (1,I) = REAL( tmpComplex) + WaveField%WaveElevC0 (2,I) = AIMAG(tmpComplex) + + END DO ! I - The positive frequency components (including zero) of the discrete Fourier transforms + +END SUBROUTINE Get_1Spsd_and_WaveElevC0 +!------------------------------------------------------------------------------------------------------------------------ +!> update WaveField%WaveElevC0; call InitFFT before calling this routine! +SUBROUTINE ConstrainedNewWaves(InitInp, InitOut, WaveField, OmegaArr, WaveS1SddArr, CosWaveDir, SinWaveDir, FFT_Data, ErrStat, ErrMsg) + + TYPE(Waves_InitInputType), INTENT(IN ) :: InitInp ! Input data for initialization routine + TYPE(Waves_InitOutputType), INTENT(INOUT) :: InitOut ! Output data + TYPE(SeaSt_WaveFieldType), INTENT(INOUT) :: WaveField + REAL(SiKi), INTENT(IN ) :: OmegaArr(0:WaveField%NStepWave2) !< Array of all non-negative angular frequencies (rad/s) + REAL(SiKi), INTENT(IN ) :: WaveS1SddArr(0:WaveField%NStepWave2) !< One-sided power spectral density of the wave spectrum at all non-negative frequencies (m^2/(rad/s)) + REAL(SiKi), INTENT(IN ) :: CosWaveDir(0:WaveField%NStepWave2) !< COS( WaveDirArr(I) ) -- Each wave frequency has a unique wave direction + REAL(SiKi), INTENT(IN ) :: SinWaveDir(0:WaveField%NStepWave2) !< SIN( WaveDirArr(I) ) -- Each wave frequency has a unique wave direction + TYPE(FFT_DataType), INTENT(IN ) :: FFT_Data !< data for FFT computations, already initialized + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< error level/status + CHARACTER(ErrMsgLen), INTENT( OUT) :: ErrMsg !< error message + + + REAL(SiKi) :: WaveNmbr ! Wavenumber of the current frequency component (1/meter) + INTEGER :: I ! Generic index + + ! Variables for constrained wave + REAL(SiKi) :: WaveElevC0ReSum !< Sum of the wave DFT amplitudes (real part) across all frequencies (m) + REAL(SiKi) :: WaveElevC0ImOmegaSum !< Sum of the wave DFT amplitudes (imaginary part) times the angular frequency across all frequencies (m(rad/s)) + REAL(SiKi) :: Crest !< Crest elevation measured from SWL (m) + REAL(SiKi) :: CrestHeight !< Crest height measured from the crest to the preceding or following trough (m) + REAL(SiKi) :: CrestHeight1 !< Crest height with purturbed crest elevation (m) + REAL(SiKi) :: CrestHeightError !< Error in crest height relative to the specified crest height (m) + REAL(SiKi) :: ConstWavePhase !< Phase adjustment to wave DFT amplitudes due to constrained wave (m) + REAL(SiKi) :: Trough !< The trough preceding or following the crest, whichever is lower (m) + REAL(SiKi) :: m0 !< Zeroth spectral moment of the wave spectrum (m^2) + REAL(SiKi) :: m2 !< First spectral moment of the wave spectrum (m^2(rad/s)^2) + REAL(SiKi) :: CrestHeightTol = 1.0E-3 !< Relative tolerance for the crest height when ConstWaveMod = ConstWaveMod_Peak2Trough (2) + INTEGER(IntKi) :: NStepTp !< Number of time steps per peak period when waveMod = 2 (-) + INTEGER(IntKi) :: Iter !< Number of iterations when trying to meet the prescribed crest height (-) + INTEGER(IntKi) :: MaxCrestIter = 20 !< Maximum number of iterations when trying to meet the prescribed crest height (-) + + REAL(SiKi) :: tmpArr(0:WaveField%NStepWave2) !< A temporary array of real numbers of constrained wave (-) + COMPLEX(SiKi) :: tmpComplexArr(0:WaveField%NStepWave2) !< A temporary array for FFT use + + COMPLEX(SiKi) :: tmpComplex ! A temporary varible to hold the complex value of the wave elevation before storing it into a REAL array + + INTEGER(IntKi) :: ErrStatTmp !< error level/status +! CHARACTER(ErrMsgLen) :: ErrMsgTmp !< error message + CHARACTER(*), PARAMETER :: RoutineName = 'ConstrainedNewWaves' + + + ErrStat = ErrID_None + ErrMsg = "" + + !=== Constrained New Waves === + ! Modify the wave components to implement the constrained wave + + ! Compute the relevant sums + m0 = WaveField%WaveDOmega * SUM(WaveS1SddArr) + m2 = WaveField%WaveDOmega * SUM(WaveS1SddArr*OmegaArr*OmegaArr) + WaveElevC0ReSum = SUM(WaveField%WaveElevC0(1,:))/m0 + WaveElevC0ImOmegaSum = SUM(WaveField%WaveElevC0(2,:) * OmegaArr)/m2 + ! Apply the part of the modification that is independent from the crest elevation + WaveField%WaveElevC0(1,:) = WaveField%WaveElevC0(1,:) - WaveElevC0ReSum * WaveS1SddArr * WaveField%WaveDOmega + WaveField%WaveElevC0(2,:) = WaveField%WaveElevC0(2,:) - WaveElevC0ImOmegaSum * OmegaArr * WaveS1SddArr * WaveField%WaveDOmega + + Crest = 0.5_SiKi * InitInp%CrestHmax ! Set crest elevation to half of crest height + tmpArr = WaveField%NStepWave2/m0 * WaveField%WaveDOmega * WaveS1SddArr + + IF (InitInp%ConstWaveMod == ConstWaveMod_CrestElev) THEN ! Crest elevation prescribed + + ! Apply the remaining part of the modification proportional to crest elevation + WaveField%WaveElevC0(1,:) = WaveField%WaveElevC0(1,:) + Crest * tmpArr + + ELSE IF (InitInp%ConstWaveMod == ConstWaveMod_Peak2Trough) THEN ! Crest height prescribed - Need to interate + + NStepTp = CEILING(InitInp%WaveTp/InitInp%WaveDT) + + Iter = 0 + CrestHeightError = InitInp%CrestHmax + DO WHILE(CrestHeightError>CrestHeightTol .AND. Iter<=MaxCrestIter) + Iter = Iter + 1 + + ! Compute the crest height based on the current guess of crest elevation + tmpComplexArr = CMPLX( WaveField%WaveElevC0(1,:) + Crest * tmpArr, & + WaveField%WaveElevC0(2,:)) + CALL ApplyFFT_cx ( WaveField%WaveElev0 (0:WaveField%NStepWave-1), tmpComplexArr (: ), FFT_Data, ErrStatTmp ) + CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT to WaveElev0.',ErrStat,ErrMsg,RoutineName) + IF ( ErrStat >= AbortErrLev ) RETURN + + ! Find the preceding or following trough, whichever is lower + Trough = MIN(MINVAL(WaveField%WaveElev0(1:MIN(NStepTp,WaveField%NStepWave-1))), & + MINVAL(WaveField%WaveElev0(MAX(WaveField%NStepWave-NStepTp,0):WaveField%NStepWave-1))) + CrestHeight = Crest-Trough + CrestHeightError = ABS(CrestHeight - InitInp%CrestHmax) + ! print *, CrestHeight + + If (CrestHeightError>CrestHeightTol) THEN ! If crest height tolerance is not satisfied + ! Compute the crest height based on a slightly nudged crest elevation + tmpComplexArr = CMPLX( WaveField%WaveElevC0(1,:) + (Crest+CrestHeightTol) * tmpArr, & + WaveField%WaveElevC0(2,:)) + CALL ApplyFFT_cx ( WaveField%WaveElev0 (0:WaveField%NStepWave-1), tmpComplexArr (: ), FFT_Data, ErrStatTmp ) + CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT to WaveElev0.',ErrStat,ErrMsg,RoutineName) + IF ( ErrStat >= AbortErrLev ) RETURN + + + ! Find the preceding or following trough, whichever is lower + Trough = MIN(MINVAL(WaveField%WaveElev0(1:MIN(NStepTp,WaveField%NStepWave-1))), & + MINVAL(WaveField%WaveElev0(MAX(WaveField%NStepWave-NStepTp,0):WaveField%NStepWave-1))) + CrestHeight1 = Crest+CrestHeightTol-Trough + ! Update crest elevation with Newton-Raphson Method + Crest = Crest - (CrestHeight-InitInp%CrestHmax)*CrestHeightTol/(CrestHeight1-CrestHeight) + ENDIF + END DO + + ! Apply the remaining part of the modification based on the final crest elevation + WaveField%WaveElevC0(1,:) = WaveField%WaveElevC0(1,:) + Crest * tmpArr + ENDIF + + ! Modify the wave phase so that the crest shows up at the right place and the right time + DO I = 1,WaveField%NStepWave2-1 + WaveNmbr = WaveNumber ( OmegaArr(I), InitInp%Gravity, WaveField%EffWtrDpth ) + ConstWavePhase = WaveNmbr*(CosWaveDir(I)*InitInp%CrestXi + & + SinWaveDir(I)*InitInp%CrestYi) - & + OmegaArr(I)*InitInp%CrestTime + tmpComplex = CMPLX( WaveField%WaveElevC0(1,I) , WaveField%WaveElevC0(2,I) ) + tmpComplex = tmpComplex * CMPLX( cos(ConstWavePhase), sin(ConstWavePhase) ) + WaveField%WaveElevC0(1,I) = REAL(tmpComplex) + WaveField%WaveElevC0(2,I) = AIMAG(tmpComplex) + END DO + +END SUBROUTINE ConstrainedNewWaves +!------------------------------------------------------------------------------------------------------------------------ +END MODULE Waves +!********************************************************************************************************************************** diff --git a/modules/seastate/src/Waves.txt b/modules/seastate/src/Waves.txt new file mode 100644 index 0000000000..262c5dc74c --- /dev/null +++ b/modules/seastate/src/Waves.txt @@ -0,0 +1,59 @@ +################################################################################################################################### +# Registry for Waves in the FAST Modularization Framework +# This Registry file is used to create MODULE Waves_Types which contains all of the user-defined types needed in Waves. +# It also contains copy, destroy, pack, and unpack routines associated with each defined data types. +# See 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) ............................................................................ +# make sure that the file name does not have any trailing white spaces! +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 Waves/Waves InitInputType CHARACTER(1024) InputFile - - - "Name of the input file" - +typedef ^ ^ CHARACTER(1024) DirRoot - - - "The name of the root file including the full path. 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." - +typedef ^ ^ CHARACTER(1024) WvKinFile - - - "The root name of user input wave kinematics files" - +typedef ^ ^ ReKi Gravity - - - "Gravitational acceleration" (m/s^2) +typedef ^ ^ integer nGrid 3 - - "Grid dimensions" +typedef ^ ^ INTEGER WaveNDir - - - "Number of wave directions [only used if WaveDirMod = 1] [Must be an odd number -- will be adjusted within the waves module]" (-) +typedef ^ ^ SiKi WaveDirSpread - - - "Spreading coefficient [WaveMod=2,3,4 and WaveDirMod=1]" - +typedef ^ ^ SiKi WaveDirRange - - - "Range of wave directions (full range: WaveDir +/- WaveDirRange/2) [only used if WaveMod=6]" (degrees) +typedef ^ ^ DbKi WaveDT - - - "Time step for incident wave calculations" (sec) +typedef ^ ^ SiKi WaveHs - - - "Significant wave height of incident waves" (meters) +typedef ^ ^ LOGICAL WaveNDAmp - - - "Flag for normally-distributed amplitudes in incident waves spectrum [flag]" - +typedef ^ ^ SiKi WavePhase - - - "Specified phase for regular waves" (radians) +typedef ^ ^ SiKi WavePkShp - - - "Peak shape parameter of incident wave spectrum [1.0 for Pierson-Moskowitz]" - +typedef ^ ^ DbKi WaveTMax - - - "Analysis time for incident wave calculations; the actual analysis time may be larger than this value in order for the maintain an effecient FFT" (sec) +typedef ^ ^ SiKi WaveTp - - - "Peak spectral period of incident waves" (sec) +typedef ^ ^ INTEGER NWaveElevGrid - - - "Number of grid points where the incident wave elevations are computed (the XY grid point locations)" - +typedef ^ ^ INTEGER NWaveKinGrid - - - "Number of grid points where the incident wave kinematics will be computed" - +typedef ^ ^ SiKi WaveKinGridxi {:} - - "xi-coordinates for grid points where the incident wave kinematics will be computed (grid points); these are relative to the mean sea level" (meters) +typedef ^ ^ SiKi WaveKinGridyi {:} - - "yi-coordinates for grid points where the incident wave kinematics will be computed (grid points); these are relative to the mean sea level" (meters) +typedef ^ ^ SiKi WaveKinGridzi {:} - - "zi-coordinates for grid points where the incident wave kinematics will be computed (grid points); these are relative to the mean sea level" (meters) +typedef ^ ^ SiKi CurrVxi {:} - - "xi-component of the current velocity at elevation i" (m/s) +typedef ^ ^ SiKi CurrVyi {:} - - "yi-component of the current velocity at elevation i" (m/s) +typedef ^ ^ SiKi PCurrVxiPz0 - - - "xi-component of the partial derivative of the current velocity at elevation near mean sea level" (m/s) +typedef ^ ^ SiKi PCurrVyiPz0 - - - "yi-component of the partial derivative of the current velocity at elevation near mean sea level" (m/s) +typedef ^ ^ NWTC_RandomNumber_ParameterType RNG - - - "Parameters for the pseudo random number generator" - +typedef ^ ^ INTEGER ConstWaveMod - - - "Mode of the constrained wave" - +typedef ^ ^ SiKi CrestHmax - - - "crest height or double the crest elevation" m +typedef ^ ^ SiKi CrestTime - - - "time of the wave crest" sec +typedef ^ ^ SiKi CrestXi - - - "xi-coordinate for the wave crest" m +typedef ^ ^ SiKi CrestYi - - - "yi-coordinate for the wave crest" m +typedef ^ ^ INTEGER WaveFieldMod - - - "Wave field handling (-) (switch) 0: use individual SeaState inputs without adjustment, 1: adjust wave phases based on turbine offsets from farm origin" - +typedef ^ ^ ReKi PtfmLocationX - - - "Supplied by Driver: X coordinate of platform location in the wave field" "m" +typedef ^ ^ ReKi PtfmLocationY - - - "Supplied by Driver: Y coordinate of platform location in the wave field" "m" + +# Define outputs from the initialization routine here: +# +typedef ^ InitOutputType INTEGER WaveNDir - - - "Number of wave directions [only used if WaveDirMod = 1] [Must be an odd number -- will be adjusted within the waves module]" (-) +typedef ^ InitOutputType DbKi WaveTMax - - - "Analysis time for incident wave calculations; the actual analysis time may be larger than this value in order for the maintain an effecient FFT" (sec) + diff --git a/modules/hydrodyn/src/Waves2.f90 b/modules/seastate/src/Waves2.f90 similarity index 69% rename from modules/hydrodyn/src/Waves2.f90 rename to modules/seastate/src/Waves2.f90 index 743e87708f..f7edb77883 100644 --- a/modules/hydrodyn/src/Waves2.f90 +++ b/modules/seastate/src/Waves2.f90 @@ -33,11 +33,10 @@ MODULE Waves2 !! USE Waves2_Types -! USE WAMIT_Interp - USE Waves2_Output USE NWTC_Library USE NWTC_FFTPACK - USE Waves, ONLY : WaveNumber + USE Waves, ONLY : WaveNumber, ImagNmbr + USE SeaSt_WaveField_Types IMPLICIT NONE @@ -53,15 +52,6 @@ MODULE Waves2 ! ..... Public Subroutines ................................................................................................... PUBLIC :: Waves2_Init !< Initialization routine - PUBLIC :: Waves2_End !< Ending routine (includes clean up) - - PUBLIC :: Waves2_UpdateStates !< Loose coupling routine for solving for constraint states, integrating - !! continuous states, and updating discrete states - PUBLIC :: Waves2_CalcOutput !< Routine for computing outputs - - PUBLIC :: Waves2_CalcConstrStateResidual !< Tight coupling routine for returning the constraint state residual - PUBLIC :: Waves2_CalcContStateDeriv !< Tight coupling routine for computing derivatives of continuous states - PUBLIC :: Waves2_UpdateDiscState !< Tight coupling routine for updating discrete states CONTAINS @@ -69,30 +59,20 @@ MODULE Waves2 !> @brief !! This routine is called at the start of the simulation to perform initialization steps. !! The parameters that are set here are not changed during the simulation. -!! The initial states and initial guess for the input are defined. -SUBROUTINE Waves2_Init( InitInp, u, p, x, xd, z, OtherState, y, misc, Interval, InitOut, ErrStat, ErrMsg ) +SUBROUTINE Waves2_Init( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) !.................................................................................................................................. TYPE(Waves2_InitInputType), INTENT(IN ) :: InitInp !< Input data for initialization routine - TYPE(Waves2_InputType), INTENT( OUT) :: u !< An initial guess for the input; input mesh must be defined - TYPE(Waves2_ParameterType), INTENT( OUT) :: p !< Parameters - TYPE(Waves2_ContinuousStateType), INTENT( OUT) :: x !< Initial continuous states - TYPE(Waves2_DiscreteStateType), INTENT( OUT) :: xd !< Initial discrete states - TYPE(Waves2_ConstraintStateType), INTENT( OUT) :: z !< Initial guess of the constraint states - TYPE(Waves2_OtherStateType), INTENT( OUT) :: OtherState !< Initial other states - TYPE(Waves2_OutputType), INTENT( OUT) :: y !< Initial system outputs (outputs are not calculated; only the output mesh is initialized) - TYPE(Waves2_MiscVarType), INTENT( OUT) :: misc !< Misc/optimization variables - REAL(DbKi), INTENT(INOUT) :: Interval !< Coupling interval in seconds: don't change it from the glue code provided value. TYPE(Waves2_InitOutputType), INTENT( OUT) :: InitOut !< Output for initialization routine + TYPE(SeaSt_WaveFieldType), INTENT(INOUT) :: WaveField !< WaveFieldType INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None ! Local Variables - COMPLEX(SiKi) :: ImagNmbr = (0.0,1.0) !< The imaginary number, \f$ \sqrt{-1.0} \f$ - - INTEGER(IntKi) :: I !< Generic counter - INTEGER(IntKi) :: J !< Generic counter + INTEGER(IntKi) :: I,ii !< Generic counters + INTEGER(IntKi) :: J, jj,k,kk !< Generic counters + integer(IntKi) :: masterCount !< Counter from 1 to NWaveKinGrid INTEGER(IntKi) :: n !< Generic counter for calculations INTEGER(IntKi) :: m !< Generic counter for calculations INTEGER(IntKi) :: mu_minus !< Generic counter for difference kinematics calculations @@ -204,7 +184,7 @@ SUBROUTINE Waves2_Init( InitInp, u, p, x, xd, z, OtherState, y, misc, Interval, ! Temporary error trapping variables INTEGER(IntKi) :: ErrStatTmp !< Temporary variable for holding the error status returned from a CALL statement CHARACTER(2048) :: ErrMsgTmp !< Temporary variable for holding the error message returned from a CALL statement - + character(*), parameter :: RoutineName = 'Waves2_Init' ! Subroutine contents @@ -215,55 +195,6 @@ SUBROUTINE Waves2_Init( InitInp, u, p, x, xd, z, OtherState, y, misc, Interval, ErrMsg = "" ErrMsgTmp = "" - ! Initialize the data storage - misc%LastIndWave = 1_IntKi - - ! Initialize the NWTC Subroutine Library and display the information about this module. - - CALL NWTC_Init( ) - - - !----------------------------------------------------------------------------- - !> Before attempting to do any real calculations, we first check what was - !! passed in through _InitInp_ to make sure it makes sense. That routine will - !! then copy over the relevant information that should be kept in parameters - !! (_p_). - !! - !! _InitInp_ will also check the flags, existence of files, and set flags - !! accordingly. - !----------------------------------------------------------------------------- - - - !-------------------------------------------------------------------------------- - ! Check the Min and Max frequencies for the full QTF cases - ! -- these checks are performed based on the DiffQTFF and SumQTFF flags - !-------------------------------------------------------------------------------- - - ! 1. Check that the min / max diff frequencies make sense if using DiffQTF - - IF ( InitInp%WvDiffQTFF .eqv. .TRUE. ) THEN - IF ( ( InitInp%WvHiCOffD < InitInp%WvLowCOffD ) .OR. ( InitInp%WvLowCOffD < 0.0 ) ) THEN - CALL SetErrStat( ErrID_Fatal, ' Programming Error in call to Waves2_Init: '//NewLine// & - ' WvHiCOffD must be larger than WvLowCOffD. Both must be positive.'// & - ' --> This should have been checked by the calling program.', ErrStat, ErrMsg, 'Waves2_Init') - CALL CleanUp - RETURN - END IF - END IF - - - ! 2. Check that the min / max diff frequencies make sense if using SumQTF - - IF ( InitInp%WvSumQTFF .eqv. .TRUE. ) THEN - IF ( ( InitInp%WvHiCOffS < InitInp%WvLowCOffS ) .OR. ( InitInp%WvLowCOffS < 0.0 ) ) THEN - CALL SetErrStat( ErrID_Fatal, ' Programming Error in call to Waves2_Init: '//NewLine// & - ' WvHiCOffS must be larger than WvLowCOffS. Both must be positive.'// & - ' --> This should have been checked by the calling program.', ErrStat, ErrMsg, 'Waves2_Init') - CALL CleanUp - RETURN - END IF - END IF - !-------------------------------------------------------------------------------- @@ -273,12 +204,12 @@ SUBROUTINE Waves2_Init( InitInp, u, p, x, xd, z, OtherState, y, misc, Interval, ! Check that WaveElevC0 is a 2x(NStepWave2+1) sized array (0 index start) - IF ( SIZE( InitInp%WaveElevC0, DIM=2 ) /= (InitInp%NStepWave2 + 1) ) THEN ! Expect a 2x(0:NStepWave2) array + IF ( SIZE( WaveField%WaveElevC0, DIM=2 ) /= (WaveField%NStepWave2 + 1) ) THEN ! Expect a 2x(0:NStepWave2) array CALL SetErrStat( ErrID_Fatal, ' Programming error in call to Waves2_Init:'//NewLine// & - ' --> Expected array for WaveElevC0 to be of size 2x'//TRIM(Num2LStr(InitInp%NStepWave2 + 1))// & + ' --> Expected array for WaveElevC0 to be of size 2x'//TRIM(Num2LStr(WaveField%NStepWave2 + 1))// & ' (2x(NStepWave2+1)), but instead received array of size '// & - TRIM(Num2LStr(SIZE(InitInp%WaveElevC0,1)))//'x'//TRIM(Num2LStr(SIZE(InitInp%WaveElevC0,2)))//'.', & - ErrStat, ErrMsg, 'Waves2_Init') + TRIM(Num2LStr(SIZE(WaveField%WaveElevC0,1)))//'x'//TRIM(Num2LStr(SIZE(WaveField%WaveElevC0,2)))//'.', & + ErrStat, ErrMsg, RoutineName) CALL CleanUp RETURN END IF @@ -286,64 +217,31 @@ SUBROUTINE Waves2_Init( InitInp, u, p, x, xd, z, OtherState, y, misc, Interval, ! Check that WaveTime is of size (NStepWave+1) - IF ( SIZE( InitInp%WaveTime ) /= (InitInp%NStepWave + 1) ) THEN ! Expect a 2x(0:NStepWave2) array + IF ( SIZE( WaveField%WaveTime ) /= (WaveField%NStepWave + 1) ) THEN ! Expect a 2x(0:NStepWave2) array CALL SetErrStat( ErrID_Fatal, ' Programming error in call to Waves2_Init:'//NewLine// & - ' --> Expected array for WaveTime to be of size '//TRIM(Num2LStr(InitInp%NStepWave + 1))// & + ' --> Expected array for WaveTime to be of size '//TRIM(Num2LStr(WaveField%NStepWave + 1))// & ' (NStepWave+1), but instead received array of size '// & - TRIM(Num2LStr(SIZE(InitInp%WaveTime)))//'.', & - ErrStat, ErrMsg, 'Waves2_Init') + TRIM(Num2LStr(SIZE(WaveField%WaveTime)))//'.', & + ErrStat, ErrMsg, RoutineName) CALL CleanUp RETURN END IF !-------------------------------------------------------------------------------- - ! Now copy over things to parameters... + ! !-------------------------------------------------------------------------------- - ! Wave information we need to keep - - p%NWaveElev = InitInp%NWaveElev - p%NStepWave = InitInp%NStepWave - p%NStepWave2 = InitInp%NStepWave2 - - - ! Time related information - - p%DT = Interval ! Timestep from calling program - - - ! Allocate array for the WaveTime information -- array of times to generate output for. NOTE: can't use MOVE_ALLOC since InitInp is intent in. - CALL AllocAry( p%WaveTime, SIZE(InitInp%WaveTime,DIM=1), 'array to hold WaveTime', ErrStatTmp, ErrMsgTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveTime.',ErrStat,ErrMsg,'Waves2_Init') - p%WaveTime = InitInp%WaveTime - - ! Difference QTF - p%WvDiffQTFF = InitInp%WvDiffQTFF ! Flag for calculation - - ! Summation QTF - p%WvSumQTFF = InitInp%WvSumQTFF ! Flag for calculation - - - ! Initialize the channel outputs - p%NumOuts = InitInp%NumOuts - p%NumOutAll = InitInp%NumOutAll - - CALL Wvs2OUT_Init( InitInp, y, p, InitOut, ErrStatTmp, ErrMsgTmp ) - CALL SetErrStat( ErrStatTmp, ErrMsgTmp, ErrStat, ErrMsg, 'Waves2_Init') - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp + ! The wave elevation information in frequency space -- we need to normalize this by NStepWave2 + ALLOCATE ( WaveElevC0Norm(0:WaveField%NStepWave2) , STAT=ErrStatTmp ) + IF (ErrStatTmp /= 0) then + CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveElevC0Norm.',ErrStat,ErrMsg,RoutineName) + CALL CleanUp() RETURN END IF - - - ! The wave elevation information in frequency space -- we need to normalize this by NStepWave2 - ALLOCATE ( WaveElevC0Norm(0:InitInp%NStepWave2) , STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveElevC0Norm.',ErrStat,ErrMsg,'Waves2_Init') - - DO I=0,InitInp%NStepWave2 - WaveElevC0Norm(I) = CMPLX( InitInp%WaveElevC0(1,I), InitInp%WaveElevC0(2,I), SiKi ) / REAL(InitInp%NStepWave2,SiKi) + DO I=0,WaveField%NStepWave2 + WaveElevC0Norm(I) = CMPLX( WaveField%WaveElevC0(1,I), WaveField%WaveElevC0(2,I), SiKi ) / REAL(WaveField%NStepWave2,SiKi) ENDDO !-------------------------------------------------------------------------------- @@ -367,14 +265,14 @@ SUBROUTINE Waves2_Init( InitInp, u, p, x, xd, z, OtherState, y, misc, Interval, ! Since we have no stretching, NWaveKin0Prime and WaveKinzi0Prime(:) are ! equal to the number of, and the zi-coordinates for, the points in the - ! WaveKinzi(:) array between, and including, -WtrDpth and 0.0. + ! WaveKinGridzi(:) array between, and including, -EffWtrDpth and 0.0. ! Determine NWaveKin0Prime here: NWaveKin0Prime = 0 - DO J = 1,InitInp%NWaveKin ! Loop through all mesh points where the incident wave kinematics will be computed - ! NOTE: We test to 0 instead of MSL2SWL because the locations of WaveKinzi and WtrDpth have already been adjusted using MSL2SWL - IF ( InitInp%WaveKinzi(J) >= -InitInp%WtrDpth .AND. InitInp%WaveKinzi(J) <= 0 ) THEN + DO J = 1,InitInp%NWaveKinGrid ! Loop through all mesh points where the incident wave kinematics will be computed + ! NOTE: We test to 0 instead of MSL2SWL because the locations of WaveKinGridzi and EffWtrDpth have already been adjusted using MSL2SWL + IF ( InitInp%WaveKinGridzi(J) >= -WaveField%EffWtrDpth .AND. InitInp%WaveKinGridzi(J) <= 0 ) THEN NWaveKin0Prime = NWaveKin0Prime + 1 END IF END DO ! J - All Morison nodes where the incident wave kinematics will be computed @@ -384,10 +282,10 @@ SUBROUTINE Waves2_Init( InitInp, u, p, x, xd, z, OtherState, y, misc, Interval, ! ALLOCATE the WaveKinzi0Prime(:) array and compute its elements here: ALLOCATE ( WaveKinzi0Prime(NWaveKin0Prime) , STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveKinzi0Prime.',ErrStat,ErrMsg,'Waves2_Init') + IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveKinzi0Prime.',ErrStat,ErrMsg,RoutineName) ALLOCATE ( WaveKinPrimeMap(NWaveKin0Prime) , STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveKinPrimeMap.',ErrStat,ErrMsg,'Waves2_Init') + IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveKinPrimeMap.',ErrStat,ErrMsg,RoutineName) IF ( ErrStat >= AbortErrLev ) THEN CALL CleanUp() @@ -397,11 +295,11 @@ SUBROUTINE Waves2_Init( InitInp, u, p, x, xd, z, OtherState, y, misc, Interval, I = 1 - DO J = 1,InitInp%NWaveKin ! Loop through all points where the incident wave kinematics will be computed without stretching - ! NOTE: We test to 0 instead of MSL2SWL because the locations of WaveKinzi and WtrDpth have already been adjusted using MSL2SWL - IF ( InitInp%WaveKinzi(J) >= -InitInp%WtrDpth .AND. InitInp%WaveKinzi(J) <= 0 ) THEN + DO J = 1,InitInp%NWaveKinGrid ! Loop through all points where the incident wave kinematics will be computed without stretching + ! NOTE: We test to 0 instead of MSL2SWL because the locations of WaveKinGridzi and EffWtrDpth have already been adjusted using MSL2SWL + IF ( InitInp%WaveKinGridzi(J) >= -WaveField%EffWtrDpth .AND. InitInp%WaveKinGridzi(J) <= 0 ) THEN - WaveKinzi0Prime(I) = InitInp%WaveKinzi(J) + WaveKinzi0Prime(I) = InitInp%WaveKinGridzi(J) WaveKinPrimeMap(I) = J I = I + 1 @@ -412,14 +310,14 @@ SUBROUTINE Waves2_Init( InitInp, u, p, x, xd, z, OtherState, y, misc, Interval, !CASE ( 1, 2 ) ! Vertical stretching or extrapolation stretching. - ! CALL SetErrStat(ErrID_Fatal,' Vertical and extrapolation stretching not supported in second order calculations.',ErrStat,ErrMsg,'Waves2_Init') + ! CALL SetErrStat(ErrID_Fatal,' Vertical and extrapolation stretching not supported in second order calculations.',ErrStat,ErrMsg,RoutineName) ! ! !CASE ( 3 ) ! Wheeler stretching. - ! CALL SetErrStat(ErrID_Fatal,' Wheeler stretching not supported in second order calculations.',ErrStat,ErrMsg,'Waves2_Init') + ! CALL SetErrStat(ErrID_Fatal,' Wheeler stretching not supported in second order calculations.',ErrStat,ErrMsg,RoutineName) ! !CASE DEFAULT - ! CALL SetErrStat(ErrID_Fatal,' Stretching is not supported in the second order waves kinematics calculations.',ErrStat,ErrMsg,'Waves2_Init') + ! CALL SetErrStat(ErrID_Fatal,' Stretching is not supported in the second order waves kinematics calculations.',ErrStat,ErrMsg,RoutineName) ! ! !ENDSELECT @@ -436,28 +334,26 @@ SUBROUTINE Waves2_Init( InitInp, u, p, x, xd, z, OtherState, y, misc, Interval, !-------------------------------------------------------------------------------- ! Setup the output arrays !-------------------------------------------------------------------------------- - - - ALLOCATE ( p%WaveElev2 (0:InitInp%NStepWave,InitInp%NWaveElev ), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array p%WaveElev2.', ErrStat,ErrMsg,'Waves2_Init') - - ALLOCATE ( InitOut%WaveVel2D (0:InitInp%NStepWave,InitInp%NWaveKin,3), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array InitOut%WaveVel2D.', ErrStat,ErrMsg,'Waves2_Init') - - ALLOCATE ( InitOut%WaveAcc2D (0:InitInp%NStepWave,InitInp%NWaveKin,3), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array InitOut%WaveAcc2D.', ErrStat,ErrMsg,'Waves2_Init') - - ALLOCATE ( InitOut%WaveDynP2D (0:InitInp%NStepWave,InitInp%NWaveKin ), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array InitOut%WaveDynP2D.', ErrStat,ErrMsg,'Waves2_Init') - - ALLOCATE ( InitOut%WaveVel2S (0:InitInp%NStepWave,InitInp%NWaveKin,3), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array InitOut%WaveVel2S.', ErrStat,ErrMsg,'Waves2_Init') - - ALLOCATE ( InitOut%WaveAcc2S (0:InitInp%NStepWave,InitInp%NWaveKin,3), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array InitOut%WaveAcc2S.', ErrStat,ErrMsg,'Waves2_Init') - - ALLOCATE ( InitOut%WaveDynP2S (0:InitInp%NStepWave,InitInp%NWaveKin ), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array InitOut%WaveDynP2S.', ErrStat,ErrMsg,'Waves2_Init') + ALLOCATE ( WaveField%WaveElev2 (0:WaveField%NStepWave,InitInp%NGrid(1),InitInp%NGrid(2) ) , STAT=ErrStatTmp ) + IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveField%WaveElev2.', ErrStat,ErrMsg,RoutineName) + + ALLOCATE ( InitOut%WaveVel2D (0:WaveField%NStepWave,InitInp%NGrid(1),InitInp%NGrid(2),InitInp%NGrid(3),3), STAT=ErrStatTmp ) + IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array InitOut%WaveVel2D.', ErrStat,ErrMsg,RoutineName) + + ALLOCATE ( InitOut%WaveAcc2D (0:WaveField%NStepWave,InitInp%NGrid(1),InitInp%NGrid(2),InitInp%NGrid(3),3), STAT=ErrStatTmp ) + IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array InitOut%WaveAcc2D.', ErrStat,ErrMsg,RoutineName) + + ALLOCATE ( InitOut%WaveDynP2D (0:WaveField%NStepWave,InitInp%NGrid(1),InitInp%NGrid(2),InitInp%NGrid(3) ), STAT=ErrStatTmp ) + IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array InitOut%WaveDynP2D.', ErrStat,ErrMsg,RoutineName) + + ALLOCATE ( InitOut%WaveVel2S (0:WaveField%NStepWave,InitInp%NGrid(1),InitInp%NGrid(2),InitInp%NGrid(3),3), STAT=ErrStatTmp ) + IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array InitOut%WaveVel2S.', ErrStat,ErrMsg,RoutineName) + + ALLOCATE ( InitOut%WaveAcc2S (0:WaveField%NStepWave,InitInp%NGrid(1),InitInp%NGrid(2),InitInp%NGrid(3),3), STAT=ErrStatTmp ) + IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array InitOut%WaveAcc2S.', ErrStat,ErrMsg,RoutineName) + + ALLOCATE ( InitOut%WaveDynP2S (0:WaveField%NStepWave,InitInp%NGrid(1),InitInp%NGrid(2),InitInp%NGrid(3) ), STAT=ErrStatTmp ) + IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array InitOut%WaveDynP2S.', ErrStat,ErrMsg,RoutineName) ! Now check if all the allocations worked properly IF ( ErrStat >= AbortErrLev ) THEN @@ -465,51 +361,41 @@ SUBROUTINE Waves2_Init( InitInp, u, p, x, xd, z, OtherState, y, misc, Interval, RETURN END IF - !Initialize the output arrays to zero. We will only fill it in for the points we calculate. - p%WaveElev2 = 0.0_SiKi + WaveField%WaveElev2 = 0.0_SiKi InitOut%WaveVel2D = 0.0_SiKi InitOut%WaveAcc2D = 0.0_SiKi InitOut%WaveDynP2D = 0.0_SiKi - InitOut%WaveVel2S = 0.0_SiKi - InitOut%WaveAcc2S = 0.0_SiKi - InitOut%WaveDynP2S = 0.0_SiKi - + InitOut%WaveVel2S = 0.0_SiKi + InitOut%WaveAcc2S = 0.0_SiKi + InitOut%WaveDynP2S = 0.0_SiKi - ! For creating animations of the sea surface, the WaveElevXY array is passed in with a series of x,y coordinates - ! (index 1). The second index corresponds to the number of points passed in. A two dimensional time series - ! is created with the first index corresponding to the timestep, and second index corresponding to the second - ! index of the WaveElevXY array. - IF ( ALLOCATED(InitInp%WaveElevXY)) THEN - ALLOCATE ( InitOut%WaveElevSeries2 (0:InitInp%NStepWave, 1:SIZE(InitInp%WaveElevXY, DIM=2)) , STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) THEN - CALL SetErrStat(ErrID_Fatal,'Cannot allocate array InitOut%WaveElevSeries2.',ErrStat,ErrMsg,'Waves2_Init') - CALL CleanUp() - RETURN - END IF - ENDIF ! For calculating the 2nd-order wave elevation corrections, we need a temporary array to hold the information. - ALLOCATE ( TmpTimeSeries(0:InitInp%NStepWave), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array TmpTimeSeries.', ErrStat,ErrMsg,'Waves2_Init') - ALLOCATE ( TmpTimeSeries2(0:InitInp%NStepWave), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array TmpTimeSeries2.', ErrStat,ErrMsg,'Waves2_Init') - - ALLOCATE ( TmpFreqSeries(0:InitInp%NStepWave2), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array TmpFreqSeries.', ErrStat,ErrMsg,'Waves2_Init') - ALLOCATE ( TmpFreqSeries2(0:InitInp%NStepWave2), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array TmpFreqSeries2.', ErrStat,ErrMsg,'Waves2_Init') + ALLOCATE ( TmpTimeSeries(0:WaveField%NStepWave), STAT=ErrStatTmp ) + IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array TmpTimeSeries.', ErrStat,ErrMsg,RoutineName) + ALLOCATE ( TmpTimeSeries2(0:WaveField%NStepWave), STAT=ErrStatTmp ) + IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array TmpTimeSeries2.', ErrStat,ErrMsg,RoutineName) + ALLOCATE ( TmpFreqSeries(0:WaveField%NStepWave2), STAT=ErrStatTmp ) + IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array TmpFreqSeries.', ErrStat,ErrMsg,RoutineName) + ALLOCATE ( TmpFreqSeries2(0:WaveField%NStepWave2), STAT=ErrStatTmp ) + IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array TmpFreqSeries2.', ErrStat,ErrMsg,RoutineName) + ! Now check if all the allocations worked properly + IF ( ErrStat >= AbortErrLev ) THEN + CALL CleanUp() + RETURN + END IF !-------------------------------------------------------------------------------- ! Setup the FFT working arrays !-------------------------------------------------------------------------------- - CALL InitFFT ( InitInp%NStepWave, FFT_Data, .FALSE., ErrStatTmp ) - CALL SetErrStat(ErrStatTmp,'Error occured while initializing the FFT.',ErrStat,ErrMsg,'Waves2_Init') + CALL InitFFT ( WaveField%NStepWave, FFT_Data, .FALSE., ErrStatTmp ) + CALL SetErrStat(ErrStatTmp,'Error occured while initializing the FFT.',ErrStat,ErrMsg,RoutineName) IF ( ErrStat >= AbortErrLev ) THEN CALL CleanUp() RETURN @@ -532,7 +418,7 @@ SUBROUTINE Waves2_Init( InitInp, u, p, x, xd, z, OtherState, y, misc, Interval, !-------------------------------------------------------------------------------- - IF(p%WvDiffQTFF) THEN + IF(InitInp%WvDiffQTFF) THEN ! Tell our nice users what is about to happen that may take a while: CALL WrScr ( ' Calculating second order difference frequency wave kinematics.' ) @@ -544,22 +430,22 @@ SUBROUTINE Waves2_Init( InitInp, u, p, x, xd, z, OtherState, y, misc, Interval, ! Frequency space arrays: - ALLOCATE ( WaveVel2xCDiff (0:InitInp%NStepWave2), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveVel2xCDiff.', ErrStat,ErrMsg,'Waves2_Init') - ALLOCATE ( WaveVel2yCDiff (0:InitInp%NStepWave2), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveVel2yCDiff.', ErrStat,ErrMsg,'Waves2_Init') - ALLOCATE ( WaveVel2zCDiff (0:InitInp%NStepWave2), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveVel2zCDiff.', ErrStat,ErrMsg,'Waves2_Init') + ALLOCATE ( WaveVel2xCDiff (0:WaveField%NStepWave2), STAT=ErrStatTmp ) + IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveVel2xCDiff.', ErrStat,ErrMsg,RoutineName) + ALLOCATE ( WaveVel2yCDiff (0:WaveField%NStepWave2), STAT=ErrStatTmp ) + IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveVel2yCDiff.', ErrStat,ErrMsg,RoutineName) + ALLOCATE ( WaveVel2zCDiff (0:WaveField%NStepWave2), STAT=ErrStatTmp ) + IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveVel2zCDiff.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( WaveAcc2xCDiff (0:InitInp%NStepWave2), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAcc2xCDiff.', ErrStat,ErrMsg,'Waves2_Init') - ALLOCATE ( WaveAcc2yCDiff (0:InitInp%NStepWave2), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAcc2yCDiff.', ErrStat,ErrMsg,'Waves2_Init') - ALLOCATE ( WaveAcc2zCDiff (0:InitInp%NStepWave2), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAcc2zCDiff.', ErrStat,ErrMsg,'Waves2_Init') + ALLOCATE ( WaveAcc2xCDiff (0:WaveField%NStepWave2), STAT=ErrStatTmp ) + IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAcc2xCDiff.', ErrStat,ErrMsg,RoutineName) + ALLOCATE ( WaveAcc2yCDiff (0:WaveField%NStepWave2), STAT=ErrStatTmp ) + IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAcc2yCDiff.', ErrStat,ErrMsg,RoutineName) + ALLOCATE ( WaveAcc2zCDiff (0:WaveField%NStepWave2), STAT=ErrStatTmp ) + IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAcc2zCDiff.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( WaveDynP2CDiff (0:InitInp%NStepWave2), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveDynP2CDiff.', ErrStat,ErrMsg,'Waves2_Init') + ALLOCATE ( WaveDynP2CDiff (0:WaveField%NStepWave2), STAT=ErrStatTmp ) + IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveDynP2CDiff.', ErrStat,ErrMsg,RoutineName) ! Now check if all the allocations worked properly IF ( ErrStat >= AbortErrLev ) THEN @@ -569,22 +455,22 @@ SUBROUTINE Waves2_Init( InitInp, u, p, x, xd, z, OtherState, y, misc, Interval, ! Time domain arrays: - ALLOCATE ( WaveVel2xDiff (0:InitInp%NStepWave), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveVel2xDiff.', ErrStat,ErrMsg,'Waves2_Init') - ALLOCATE ( WaveVel2yDiff (0:InitInp%NStepWave), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveVel2yDiff.', ErrStat,ErrMsg,'Waves2_Init') - ALLOCATE ( WaveVel2zDiff (0:InitInp%NStepWave), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveVel2zDiff.', ErrStat,ErrMsg,'Waves2_Init') - - ALLOCATE ( WaveAcc2xDiff (0:InitInp%NStepWave), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAcc2xDiff.', ErrStat,ErrMsg,'Waves2_Init') - ALLOCATE ( WaveAcc2yDiff (0:InitInp%NStepWave), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAcc2yDiff.', ErrStat,ErrMsg,'Waves2_Init') - ALLOCATE ( WaveAcc2zDiff (0:InitInp%NStepWave), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAcc2zDiff.', ErrStat,ErrMsg,'Waves2_Init') - - ALLOCATE ( WaveDynP2Diff (0:InitInp%NStepWave), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveDynP2Diff.', ErrStat,ErrMsg,'Waves2_Init') + ALLOCATE ( WaveVel2xDiff (0:WaveField%NStepWave), STAT=ErrStatTmp ) + IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveVel2xDiff.', ErrStat,ErrMsg,RoutineName) + ALLOCATE ( WaveVel2yDiff (0:WaveField%NStepWave), STAT=ErrStatTmp ) + IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveVel2yDiff.', ErrStat,ErrMsg,RoutineName) + ALLOCATE ( WaveVel2zDiff (0:WaveField%NStepWave), STAT=ErrStatTmp ) + IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveVel2zDiff.', ErrStat,ErrMsg,RoutineName) + + ALLOCATE ( WaveAcc2xDiff (0:WaveField%NStepWave), STAT=ErrStatTmp ) + IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAcc2xDiff.', ErrStat,ErrMsg,RoutineName) + ALLOCATE ( WaveAcc2yDiff (0:WaveField%NStepWave), STAT=ErrStatTmp ) + IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAcc2yDiff.', ErrStat,ErrMsg,RoutineName) + ALLOCATE ( WaveAcc2zDiff (0:WaveField%NStepWave), STAT=ErrStatTmp ) + IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAcc2zDiff.', ErrStat,ErrMsg,RoutineName) + + ALLOCATE ( WaveDynP2Diff (0:WaveField%NStepWave), STAT=ErrStatTmp ) + IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveDynP2Diff.', ErrStat,ErrMsg,RoutineName) ! Now check if all the allocations worked properly IF ( ErrStat >= AbortErrLev ) THEN @@ -597,40 +483,27 @@ SUBROUTINE Waves2_Init( InitInp, u, p, x, xd, z, OtherState, y, misc, Interval, !-------------------------------------------------------------------------------- !> ## Calculate the surface elevation corrections ## !! - !! For each (x,y) coordinate that a wave elevation is requested at (both from the - !! (WaveElevxi,WaveElevyi) pairs, and the WaveElevXY pairs), a call is made to the + !! For each (x,y) coordinate that a wave elevation is requested at, a call is made to the !! subroutine waves2::waveelevtimeseriesatxy_diff to calculate the full time series for !! that point. The results are added to the wave elevation results from the sum !! frequency calculations later in the code. !-------------------------------------------------------------------------------- ! Step through the requested points - DO I=1,InitInp%NWaveElev - CALL WaveElevTimeSeriesAtXY_Diff(InitInp%WaveElevxi(I), InitInp%WaveElevyi(I), TmpTimeSeries, ErrStatTmp, ErrMsgTmp ) - CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT to InitOut%WaveElev.',ErrStat,ErrMsg,'Waves2_Init') + DO k = 1,InitInp%NWaveElevGrid ! Loop through all points where the incident wave elevations are to be computed (normally all the XY grid points) + ! This subroutine call applies the FFT at the correct location. + i = mod(k-1, InitInp%NGrid(1)) + 1 + j = (k-1) / InitInp%NGrid(1) + 1 + CALL WaveElevTimeSeriesAtXY_Diff(InitInp%WaveKinGridxi(k), InitInp%WaveKinGridyi(k), TmpTimeSeries, ErrStatTmp, ErrMsgTmp ) + CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT to WaveField%WaveElev2.',ErrStat,ErrMsg,RoutineName) IF ( ErrStat >= AbortErrLev ) THEN CALL CleanUp() RETURN END IF - p%WaveElev2(:,I) = TmpTimeSeries(:) + WaveField%WaveElev2(:,I,J) = TmpTimeSeries(:) ENDDO ! Wave elevation points requested - ! Calculate the wave elevation at all points requested in the array WaveElevXY - IF ( ALLOCATED(InitInp%WaveElevXY) ) THEN - DO I = 1,SIZE(InitInp%WaveElevXY, DIM=2) - ! This subroutine call applies the FFT at the correct location. - CALL WaveElevTimeSeriesAtXY_Diff( InitInp%WaveElevXY(1,I), InitInp%WaveElevXY(2,I), TmpTimeSeries, ErrStatTmp, ErrMsgTmp ) - CALL SetErrStat(ErrStatTmp,ErrMsgTmp,ErrStat,ErrMsg,'Waves2_Init') - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp() - RETURN - END IF - InitOut%WaveElevSeries2(:,I) = TmpTimeSeries(:) - ENDDO - ENDIF - - !-------------------------------------------------------------------------------- !> ## Calculate the second order velocity, acceleration, and pressure corrections for all joints below surface. ## @@ -639,7 +512,7 @@ SUBROUTINE Waves2_Init( InitInp, u, p, x, xd, z, OtherState, y, misc, Interval, ! NWaveKin0Prime loop start DO I=1,NWaveKin0Prime - + masterCount = WaveKinPrimeMap(I) ! Reset the \f$ H_{\mu^-} \f$ terms to zero before calculating. WaveVel2xCDiff = CMPLX(0.0_SiKi, 0.0_SiKi, SiKi) @@ -653,22 +526,22 @@ SUBROUTINE Waves2_Init( InitInp, u, p, x, xd, z, OtherState, y, misc, Interval, ! \f$ \mu^- \f$ loop. This loop is used to construct the full set of \f$ H_{\mu^-} \f$ terms used in the IFFT to find the timeseries. !> * \f$ \mu^- = n -m \f$ - DO mu_minus=1,InitInp%NStepWave2-1 + DO mu_minus=1,WaveField%NStepWave2-1 ! The frequency we are dealing with !> * \f$ \omega^- = \mu^- \Delta \omega \f$ - Omega_minus = mu_minus * InitInp%WaveDOmega + Omega_minus = mu_minus * WaveField%WaveDOmega - IF ( Omega_minus >= InitInp%WvLowCOffD .AND. Omega_minus <= InitInp%WvHiCOffD ) THEN + IF ( Omega_minus >= WaveField%WvLowCOffD .AND. Omega_minus <= WaveField%WvHiCOffD ) THEN ! The inner \f$ m \f$ loop for calculating the \f$ H_{\mu^-} \f$ terms at each frequency. - DO m=1,InitInp%NStepWave2-mu_minus + DO m=1,WaveField%NStepWave2-mu_minus ! Calculate the value of the n index from \f$ \mu^- = n - m \f$. Calculate corresponding wavenumbers and frequencies. n = mu_minus + m - Omega_n = n * InitInp%WaveDOmega - Omega_m = m * InitInp%WaveDOmega - k_n = WaveNumber( Omega_n, InitInp%Gravity, InitInp%WtrDpth ) - k_m = WaveNumber( Omega_m, InitInp%Gravity, InitInp%WtrDpth ) + Omega_n = n * WaveField%WaveDOmega + Omega_m = m * WaveField%WaveDOmega + k_n = WaveNumber( Omega_n, InitInp%Gravity, WaveField%EffWtrDpth ) + k_m = WaveNumber( Omega_m, InitInp%Gravity, WaveField%EffWtrDpth ) k_nm = k_nm_minus( n, m, k_n, k_m ) @@ -683,8 +556,8 @@ SUBROUTINE Waves2_Init( InitInp, u, p, x, xd, z, OtherState, y, misc, Interval, !! + \left( |\vec{k_n}| \sin \theta_n - |\vec{k_m}| sin \theta_m \right) ~ y \right] \right) \f$ WaveElevxyPrime0 = exp( - ImagNmbr & - * ( ( k_n * COS( D2R_S*InitInp%WaveDirArr(n) ) - k_m * COS( D2R_S*InitInp%WaveDirArr(m) ) ) * InitInp%WaveKinxi(WaveKinPrimeMap(I)) & - + ( k_n * SIN( D2R_S*InitInp%WaveDirArr(n) ) - k_m * SIN( D2R_S*InitInp%WaveDirArr(m) ) ) * InitInp%WaveKinyi(WaveKinPrimeMap(I)) )) + * ( ( k_n * COS( D2R_S*WaveField%WaveDirArr(n) ) - k_m * COS( D2R_S*WaveField%WaveDirArr(m) ) ) * InitInp%WaveKinGridxi(masterCount) & + + ( k_n * SIN( D2R_S*WaveField%WaveDirArr(n) ) - k_m * SIN( D2R_S*WaveField%WaveDirArr(m) ) ) * InitInp%WaveKinGridyi(masterCount) )) ! Get value for \f$ B^- \f$ for the n,m index pair @@ -692,15 +565,15 @@ SUBROUTINE Waves2_Init( InitInp, u, p, x, xd, z, OtherState, y, misc, Interval, !> Calculate \f$ U^- \f$ terms for the velocity calculations (\f$B^-\f$ provided by waves2::transfuncb_minus) - ! NOTE: InitInp%WtrDpth + WaveKinzi0Prime(I) is the height above the ocean floor + ! NOTE: WaveField%EffWtrDpth + WaveKinzi0Prime(I) is the height above the ocean floor !> * \f$ _x{U}_{nm}^- = B_{nm}^- \left(k_n \cos \theta_n - k_m \cos \theta_m \right) \f$ - Ux_nm_minus = B_minus * ( k_n * COS( D2R_S*InitInp%WaveDirArr(n) ) - k_m * COS( D2R_S*InitInp%WaveDirArr(m) ) ) + Ux_nm_minus = B_minus * ( k_n * COS( D2R_S*WaveField%WaveDirArr(n) ) - k_m * COS( D2R_S*WaveField%WaveDirArr(m) ) ) !> * \f$ _y{U}_{nm}^- = B_{nm}^- \left(k_n \sin \theta_n - k_m \sin \theta_m \right) \f$ - Uy_nm_minus = B_minus * ( k_n * SIN( D2R_S*InitInp%WaveDirArr(n) ) - k_m * SIN( D2R_S*InitInp%WaveDirArr(m) ) ) + Uy_nm_minus = B_minus * ( k_n * SIN( D2R_S*WaveField%WaveDirArr(n) ) - k_m * SIN( D2R_S*WaveField%WaveDirArr(m) ) ) !> * \f$ _z{U}_{nm}^- = \imath B_{nm}^- k_{nm} \tanh \left( k_{nm} ( h + z ) \right) \f$ - Uz_nm_minus = ImagNmbr * B_minus * k_nm * tanh( k_nm * ( InitInp%WtrDpth + WaveKinzi0Prime(I) ) ) + Uz_nm_minus = ImagNmbr * B_minus * k_nm * tanh( k_nm * ( WaveField%EffWtrDpth + WaveKinzi0Prime(I) ) ) !> Acceleration calculations @@ -711,7 +584,7 @@ SUBROUTINE Waves2_Init( InitInp, u, p, x, xd, z, OtherState, y, misc, Interval, !> Dynamic pressure !> * \f$ P_{nm}^- = \rho_\mathrm{w} B_{nm}^- \omega_{\mu^-} \f$ - DynP_nm_minus = REAL(InitInp%WtrDens,SiKi) * B_minus * Omega_minus + DynP_nm_minus = REAL(WaveField%WtrDens,SiKi) * B_minus * Omega_minus @@ -766,21 +639,21 @@ SUBROUTINE Waves2_Init( InitInp, u, p, x, xd, z, OtherState, y, misc, Interval, !> ### Apply the inverse FFT to each of the components to get the time domain result ### !> * \f$ V(t) = 2 \operatorname{IFFT}\left[H^-\right] \f$ CALL ApplyFFT_cx( WaveVel2xDiff(:), WaveVel2xCDiff(:), FFT_Data, ErrStatTmp ) - CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT on V_x.',ErrStat,ErrMsg,'Waves2_Init') + CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT on V_x.',ErrStat,ErrMsg,RoutineName) CALL ApplyFFT_cx( WaveVel2yDiff(:), WaveVel2yCDiff(:), FFT_Data, ErrStatTmp ) - CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT on V_y.',ErrStat,ErrMsg,'Waves2_Init') + CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT on V_y.',ErrStat,ErrMsg,RoutineName) CALL ApplyFFT_cx( WaveVel2zDiff(:), WaveVel2zCDiff(:), FFT_Data, ErrStatTmp ) - CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT on V_z.',ErrStat,ErrMsg,'Waves2_Init') + CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT on V_z.',ErrStat,ErrMsg,RoutineName) CALL ApplyFFT_cx( WaveAcc2xDiff(:), WaveAcc2xCDiff(:), FFT_Data, ErrStatTmp ) - CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT on Acc_x.',ErrStat,ErrMsg,'Waves2_Init') + CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT on Acc_x.',ErrStat,ErrMsg,RoutineName) CALL ApplyFFT_cx( WaveAcc2yDiff(:), WaveAcc2yCDiff(:), FFT_Data, ErrStatTmp ) - CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT on Acc_y.',ErrStat,ErrMsg,'Waves2_Init') + CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT on Acc_y.',ErrStat,ErrMsg,RoutineName) CALL ApplyFFT_cx( WaveAcc2zDiff(:), WaveAcc2zCDiff(:), FFT_Data, ErrStatTmp ) - CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT on Acc_z.',ErrStat,ErrMsg,'Waves2_Init') + CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT on Acc_z.',ErrStat,ErrMsg,RoutineName) CALL ApplyFFT_cx( WaveDynP2Diff(:), WaveDynP2CDiff(:), FFT_Data, ErrStatTmp ) - CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT on DynP2.',ErrStat,ErrMsg,'Waves2_Init') + CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT on DynP2.',ErrStat,ErrMsg,RoutineName) @@ -791,32 +664,37 @@ SUBROUTINE Waves2_Init( InitInp, u, p, x, xd, z, OtherState, y, misc, Interval, ! Copy the results to the output - InitOut%WaveVel2D(:,WaveKinPrimeMap(I),1) = 2.0_SiKi * WaveVel2xDiff(:) ! x-component of velocity - InitOut%WaveVel2D(:,WaveKinPrimeMap(I),2) = 2.0_SiKi * WaveVel2yDiff(:) ! y-component of velocity - InitOut%WaveVel2D(:,WaveKinPrimeMap(I),3) = 2.0_SiKi * WaveVel2zDiff(:) ! z-component of velocity + ii = mod(masterCount-1, InitInp%NGrid(1)) + 1 + jj = mod( (masterCount-1) /InitInp%NGrid(1), InitInp%NGrid(2) ) + 1 + kk = (masterCount-1) / (InitInp%NGrid(1)*InitInp%NGrid(2)) + 1 + + InitOut%WaveVel2D(:,ii,jj,kk,1) = 2.0_SiKi * WaveVel2xDiff(:) ! x-component of velocity + InitOut%WaveVel2D(:,ii,jj,kk,2) = 2.0_SiKi * WaveVel2yDiff(:) ! y-component of velocity + InitOut%WaveVel2D(:,ii,jj,kk,3) = 2.0_SiKi * WaveVel2zDiff(:) ! z-component of velocity - InitOut%WaveAcc2D(:,WaveKinPrimeMap(I),1) = 2.0_SiKi * WaveAcc2xDiff(:) ! x-component of acceleration - InitOut%WaveAcc2D(:,WaveKinPrimeMap(I),2) = 2.0_SiKi * WaveAcc2yDiff(:) ! y-component of acceleration - InitOut%WaveAcc2D(:,WaveKinPrimeMap(I),3) = 2.0_SiKi * WaveAcc2zDiff(:) ! z-component of acceleration + InitOut%WaveAcc2D(:,ii,jj,kk,1) = 2.0_SiKi * WaveAcc2xDiff(:) ! x-component of acceleration + InitOut%WaveAcc2D(:,ii,jj,kk,2) = 2.0_SiKi * WaveAcc2yDiff(:) ! y-component of acceleration + InitOut%WaveAcc2D(:,ii,jj,kk,3) = 2.0_SiKi * WaveAcc2zDiff(:) ! z-component of acceleration - InitOut%WaveDynP2D(:,WaveKinPrimeMap(I)) = 2.0_SiKi * WaveDynP2Diff(:) ! Dynamic pressure + InitOut%WaveDynP2D(:,ii,jj,kk) = 2.0_SiKi * WaveDynP2Diff(:) ! Dynamic pressure ! Copy the first point to the last to make it easier. - InitOut%WaveVel2D(InitInp%NStepWave,WaveKinPrimeMap(I),1) = WaveVel2xDiff(0) - InitOut%WaveVel2D(InitInp%NStepWave,WaveKinPrimeMap(I),2) = WaveVel2yDiff(0) - InitOut%WaveVel2D(InitInp%NStepWave,WaveKinPrimeMap(I),3) = WaveVel2zDiff(0) + ! TODO: Why don't these have the 2.0 multipler?? GJH 9/8/21 + InitOut%WaveVel2D(WaveField%NStepWave,ii,jj,kk,1) = WaveVel2xDiff(0) + InitOut%WaveVel2D(WaveField%NStepWave,ii,jj,kk,2) = WaveVel2yDiff(0) + InitOut%WaveVel2D(WaveField%NStepWave,ii,jj,kk,3) = WaveVel2zDiff(0) - InitOut%WaveAcc2D(InitInp%NStepWave,WaveKinPrimeMap(I),1) = WaveAcc2xDiff(0) - InitOut%WaveAcc2D(InitInp%NStepWave,WaveKinPrimeMap(I),2) = WaveAcc2yDiff(0) - InitOut%WaveAcc2D(InitInp%NStepWave,WaveKinPrimeMap(I),3) = WaveAcc2zDiff(0) + InitOut%WaveAcc2D(WaveField%NStepWave,ii,jj,kk,1) = WaveAcc2xDiff(0) + InitOut%WaveAcc2D(WaveField%NStepWave,ii,jj,kk,2) = WaveAcc2yDiff(0) + InitOut%WaveAcc2D(WaveField%NStepWave,ii,jj,kk,3) = WaveAcc2zDiff(0) - InitOut%WaveDynP2D(InitInp%NStepWave,WaveKinPrimeMap(I)) = WaveDynP2Diff(0) + InitOut%WaveDynP2D(WaveField%NStepWave,ii,jj,kk) = WaveDynP2Diff(0) ENDDO ! I=1,NWaveKin0Prime loop end - + ! Deallocate working arrays. IF (ALLOCATED(WaveVel2xCDiff)) DEALLOCATE(WaveVel2xCDiff, STAT=ErrStatTmp) IF (ALLOCATED(WaveVel2yCDiff)) DEALLOCATE(WaveVel2yCDiff, STAT=ErrStatTmp) @@ -840,7 +718,7 @@ SUBROUTINE Waves2_Init( InitInp, u, p, x, xd, z, OtherState, y, misc, Interval, END IF - ENDIF ! p%WvDiffQTFF + ENDIF ! WvDiffQTFF @@ -865,7 +743,7 @@ SUBROUTINE Waves2_Init( InitInp, u, p, x, xd, z, OtherState, y, misc, Interval, !-------------------------------------------------------------------------------- - IF(p%WvSumQTFF) THEN + IF(InitInp%WvSumQTFF) THEN ! Tell our nice users what is about to happen that may take a while: CALL WrScr ( ' Calculating second order sum frequency wave kinematics.' ) @@ -877,40 +755,40 @@ SUBROUTINE Waves2_Init( InitInp, u, p, x, xd, z, OtherState, y, misc, Interval, ! Frequency space arrays: Term 1 (n=m term) - ALLOCATE ( WaveVel2xCSumT1 (0:InitInp%NStepWave2), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveVel2xCSumT1.', ErrStat,ErrMsg,'Waves2_Init') - ALLOCATE ( WaveVel2yCSumT1 (0:InitInp%NStepWave2), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveVel2yCSumT1.', ErrStat,ErrMsg,'Waves2_Init') - ALLOCATE ( WaveVel2zCSumT1 (0:InitInp%NStepWave2), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveVel2zCSumT1.', ErrStat,ErrMsg,'Waves2_Init') + ALLOCATE ( WaveVel2xCSumT1 (0:WaveField%NStepWave2), STAT=ErrStatTmp ) + IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveVel2xCSumT1.', ErrStat,ErrMsg,RoutineName) + ALLOCATE ( WaveVel2yCSumT1 (0:WaveField%NStepWave2), STAT=ErrStatTmp ) + IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveVel2yCSumT1.', ErrStat,ErrMsg,RoutineName) + ALLOCATE ( WaveVel2zCSumT1 (0:WaveField%NStepWave2), STAT=ErrStatTmp ) + IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveVel2zCSumT1.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( WaveAcc2xCSumT1 (0:InitInp%NStepWave2), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAcc2xCSumT1.', ErrStat,ErrMsg,'Waves2_Init') - ALLOCATE ( WaveAcc2yCSumT1 (0:InitInp%NStepWave2), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAcc2yCSumT1.', ErrStat,ErrMsg,'Waves2_Init') - ALLOCATE ( WaveAcc2zCSumT1 (0:InitInp%NStepWave2), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAcc2zCSumT1.', ErrStat,ErrMsg,'Waves2_Init') + ALLOCATE ( WaveAcc2xCSumT1 (0:WaveField%NStepWave2), STAT=ErrStatTmp ) + IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAcc2xCSumT1.', ErrStat,ErrMsg,RoutineName) + ALLOCATE ( WaveAcc2yCSumT1 (0:WaveField%NStepWave2), STAT=ErrStatTmp ) + IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAcc2yCSumT1.', ErrStat,ErrMsg,RoutineName) + ALLOCATE ( WaveAcc2zCSumT1 (0:WaveField%NStepWave2), STAT=ErrStatTmp ) + IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAcc2zCSumT1.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( WaveDynP2CSumT1 (0:InitInp%NStepWave2), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveDynP2CSumT1.', ErrStat,ErrMsg,'Waves2_Init') + ALLOCATE ( WaveDynP2CSumT1 (0:WaveField%NStepWave2), STAT=ErrStatTmp ) + IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveDynP2CSumT1.', ErrStat,ErrMsg,RoutineName) ! Term 2 (n/=m term) - ALLOCATE ( WaveVel2xCSumT2 (0:InitInp%NStepWave2), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveVel2xCSumT2.', ErrStat,ErrMsg,'Waves2_Init') - ALLOCATE ( WaveVel2yCSumT2 (0:InitInp%NStepWave2), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveVel2yCSumT2.', ErrStat,ErrMsg,'Waves2_Init') - ALLOCATE ( WaveVel2zCSumT2 (0:InitInp%NStepWave2), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveVel2zCSumT2.', ErrStat,ErrMsg,'Waves2_Init') - - ALLOCATE ( WaveAcc2xCSumT2 (0:InitInp%NStepWave2), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAcc2xCSumT2.', ErrStat,ErrMsg,'Waves2_Init') - ALLOCATE ( WaveAcc2yCSumT2 (0:InitInp%NStepWave2), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAcc2yCSumT2.', ErrStat,ErrMsg,'Waves2_Init') - ALLOCATE ( WaveAcc2zCSumT2 (0:InitInp%NStepWave2), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAcc2zCSumT2.', ErrStat,ErrMsg,'Waves2_Init') - - ALLOCATE ( WaveDynP2CSumT2 (0:InitInp%NStepWave2), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveDynP2CSumT2.', ErrStat,ErrMsg,'Waves2_Init') + ALLOCATE ( WaveVel2xCSumT2 (0:WaveField%NStepWave2), STAT=ErrStatTmp ) + IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveVel2xCSumT2.', ErrStat,ErrMsg,RoutineName) + ALLOCATE ( WaveVel2yCSumT2 (0:WaveField%NStepWave2), STAT=ErrStatTmp ) + IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveVel2yCSumT2.', ErrStat,ErrMsg,RoutineName) + ALLOCATE ( WaveVel2zCSumT2 (0:WaveField%NStepWave2), STAT=ErrStatTmp ) + IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveVel2zCSumT2.', ErrStat,ErrMsg,RoutineName) + + ALLOCATE ( WaveAcc2xCSumT2 (0:WaveField%NStepWave2), STAT=ErrStatTmp ) + IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAcc2xCSumT2.', ErrStat,ErrMsg,RoutineName) + ALLOCATE ( WaveAcc2yCSumT2 (0:WaveField%NStepWave2), STAT=ErrStatTmp ) + IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAcc2yCSumT2.', ErrStat,ErrMsg,RoutineName) + ALLOCATE ( WaveAcc2zCSumT2 (0:WaveField%NStepWave2), STAT=ErrStatTmp ) + IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAcc2zCSumT2.', ErrStat,ErrMsg,RoutineName) + + ALLOCATE ( WaveDynP2CSumT2 (0:WaveField%NStepWave2), STAT=ErrStatTmp ) + IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveDynP2CSumT2.', ErrStat,ErrMsg,RoutineName) ! Now check if all the allocations worked properly IF ( ErrStat >= AbortErrLev ) THEN @@ -921,40 +799,40 @@ SUBROUTINE Waves2_Init( InitInp, u, p, x, xd, z, OtherState, y, misc, Interval, ! Time domain arrays: Term 1 (n=m term) - ALLOCATE ( WaveVel2xSumT1 (0:InitInp%NStepWave), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveVel2xSumT1.', ErrStat,ErrMsg,'Waves2_Init') - ALLOCATE ( WaveVel2ySumT1 (0:InitInp%NStepWave), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveVel2ySumT1.', ErrStat,ErrMsg,'Waves2_Init') - ALLOCATE ( WaveVel2zSumT1 (0:InitInp%NStepWave), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveVel2zSumT1.', ErrStat,ErrMsg,'Waves2_Init') + ALLOCATE ( WaveVel2xSumT1 (0:WaveField%NStepWave), STAT=ErrStatTmp ) + IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveVel2xSumT1.', ErrStat,ErrMsg,RoutineName) + ALLOCATE ( WaveVel2ySumT1 (0:WaveField%NStepWave), STAT=ErrStatTmp ) + IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveVel2ySumT1.', ErrStat,ErrMsg,RoutineName) + ALLOCATE ( WaveVel2zSumT1 (0:WaveField%NStepWave), STAT=ErrStatTmp ) + IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveVel2zSumT1.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( WaveAcc2xSumT1 (0:InitInp%NStepWave), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAcc2xSumT1.', ErrStat,ErrMsg,'Waves2_Init') - ALLOCATE ( WaveAcc2ySumT1 (0:InitInp%NStepWave), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAcc2ySumT1.', ErrStat,ErrMsg,'Waves2_Init') - ALLOCATE ( WaveAcc2zSumT1 (0:InitInp%NStepWave), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAcc2zSumT1.', ErrStat,ErrMsg,'Waves2_Init') + ALLOCATE ( WaveAcc2xSumT1 (0:WaveField%NStepWave), STAT=ErrStatTmp ) + IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAcc2xSumT1.', ErrStat,ErrMsg,RoutineName) + ALLOCATE ( WaveAcc2ySumT1 (0:WaveField%NStepWave), STAT=ErrStatTmp ) + IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAcc2ySumT1.', ErrStat,ErrMsg,RoutineName) + ALLOCATE ( WaveAcc2zSumT1 (0:WaveField%NStepWave), STAT=ErrStatTmp ) + IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAcc2zSumT1.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( WaveDynP2SumT1 (0:InitInp%NStepWave), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveDynP2SumT1.', ErrStat,ErrMsg,'Waves2_Init') + ALLOCATE ( WaveDynP2SumT1 (0:WaveField%NStepWave), STAT=ErrStatTmp ) + IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveDynP2SumT1.', ErrStat,ErrMsg,RoutineName) ! Term 2 (n/=m term) - ALLOCATE ( WaveVel2xSumT2 (0:InitInp%NStepWave), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveVel2xSumT2.', ErrStat,ErrMsg,'Waves2_Init') - ALLOCATE ( WaveVel2ySumT2 (0:InitInp%NStepWave), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveVel2ySumT2.', ErrStat,ErrMsg,'Waves2_Init') - ALLOCATE ( WaveVel2zSumT2 (0:InitInp%NStepWave), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveVel2zSumT2.', ErrStat,ErrMsg,'Waves2_Init') - - ALLOCATE ( WaveAcc2xSumT2 (0:InitInp%NStepWave), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAcc2xSumT2.', ErrStat,ErrMsg,'Waves2_Init') - ALLOCATE ( WaveAcc2ySumT2 (0:InitInp%NStepWave), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAcc2ySumT2.', ErrStat,ErrMsg,'Waves2_Init') - ALLOCATE ( WaveAcc2zSumT2 (0:InitInp%NStepWave), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAcc2zSumT2.', ErrStat,ErrMsg,'Waves2_Init') - - ALLOCATE ( WaveDynP2SumT2 (0:InitInp%NStepWave), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveDynP2SumT2.', ErrStat,ErrMsg,'Waves2_Init') + ALLOCATE ( WaveVel2xSumT2 (0:WaveField%NStepWave), STAT=ErrStatTmp ) + IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveVel2xSumT2.', ErrStat,ErrMsg,RoutineName) + ALLOCATE ( WaveVel2ySumT2 (0:WaveField%NStepWave), STAT=ErrStatTmp ) + IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveVel2ySumT2.', ErrStat,ErrMsg,RoutineName) + ALLOCATE ( WaveVel2zSumT2 (0:WaveField%NStepWave), STAT=ErrStatTmp ) + IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveVel2zSumT2.', ErrStat,ErrMsg,RoutineName) + + ALLOCATE ( WaveAcc2xSumT2 (0:WaveField%NStepWave), STAT=ErrStatTmp ) + IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAcc2xSumT2.', ErrStat,ErrMsg,RoutineName) + ALLOCATE ( WaveAcc2ySumT2 (0:WaveField%NStepWave), STAT=ErrStatTmp ) + IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAcc2ySumT2.', ErrStat,ErrMsg,RoutineName) + ALLOCATE ( WaveAcc2zSumT2 (0:WaveField%NStepWave), STAT=ErrStatTmp ) + IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAcc2zSumT2.', ErrStat,ErrMsg,RoutineName) + + ALLOCATE ( WaveDynP2SumT2 (0:WaveField%NStepWave), STAT=ErrStatTmp ) + IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveDynP2SumT2.', ErrStat,ErrMsg,RoutineName) ! Now check if all the allocations worked properly IF ( ErrStat >= AbortErrLev ) THEN @@ -968,49 +846,33 @@ SUBROUTINE Waves2_Init( InitInp, u, p, x, xd, z, OtherState, y, misc, Interval, !-------------------------------------------------------------------------------- !> ## Calculate the surface elevation corrections ## !! - !! For each (x,y) coordinate that a wave elevation is requested at (both from the - !! (WaveElevxi,WaveElevyi) pairs, and the WaveElevXY pairs), a call is made to the + !! For each (x,y) coordinate that a wave elevation is requested at, a call is made to the !! subroutine waves2::waveelevtimeseriesatxy_sum to calculate the full time series for !! that point. The results are added to the wave elevation results from the diff !! frequency calculations earlier in the code. !-------------------------------------------------------------------------------- - +!NOTE: This is all grid points ! Step through the requested points - DO I=1,InitInp%NWaveElev - CALL WaveElevTimeSeriesAtXY_Sum(InitInp%WaveElevxi(I), InitInp%WaveElevyi(I), TmpTimeSeries, ErrStatTmp, ErrMsgTmp ) - CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT to InitOut%WaveElev.',ErrStat,ErrMsg,'Waves2_Init') + DO k = 1,InitInp%NWaveElevGrid ! Loop through all points where the incident wave elevations are to be computed (normally all the XY grid points) + ! This subroutine call applies the FFT at the correct location. + i = mod(k-1, InitInp%NGrid(1)) + 1 + j = (k-1) / InitInp%NGrid(1) + 1 + CALL WaveElevTimeSeriesAtXY_Sum(InitInp%WaveKinGridxi(k), InitInp%WaveKinGridyi(k), TmpTimeSeries, ErrStatTmp, ErrMsgTmp ) + CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT to WaveField%WaveElev2.',ErrStat,ErrMsg,RoutineName) IF ( ErrStat >= AbortErrLev ) THEN CALL CleanUp() RETURN END IF ! Add to the series since the difference is already included - p%WaveElev2(:,I) = p%WaveElev2(:,I) + TmpTimeSeries(:) + WaveField%WaveElev2(:,I,J) = WaveField%WaveElev2(:,I,J) + TmpTimeSeries(:) ENDDO ! Wave elevation points requested - - ! Calculate the wave elevation at all points requested in the array WaveElevXY - IF ( ALLOCATED(InitInp%WaveElevXY) ) THEN - DO I = 1,SIZE(InitInp%WaveElevXY, DIM=2) - ! This subroutine call applies the FFT at the correct location. - CALL WaveElevTimeSeriesAtXY_Sum( InitInp%WaveElevXY(1,I), InitInp%WaveElevXY(2,I), TmpTimeSeries, ErrStatTmp, ErrMsgTmp ) - CALL SetErrStat(ErrStatTmp,ErrMsgTmp,ErrStat,ErrMsg,'Waves2_Init') - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp() - RETURN - END IF - ! Add to the series since the difference is already included - InitOut%WaveElevSeries2(:,I) = InitOut%WaveElevSeries2(:,I) + TmpTimeSeries(:) - ENDDO - ENDIF - - - !-------------------------------------------------------------------------------- !> ## Calculate the second order velocity, acceleration, and pressure corrections for all joints below surface. ## !-------------------------------------------------------------------------------- ! NWaveKin0Prime loop start DO I=1,NWaveKin0Prime - + masterCount = WaveKinPrimeMap(I) ! Reset the \f$ H_{\mu^+} \f$ terms to zero before calculating. WaveVel2xCSumT1 = CMPLX(0.0_SiKi, 0.0_SiKi, SiKi) @@ -1044,17 +906,17 @@ SUBROUTINE Waves2_Init( InitInp, u, p, x, xd, z, OtherState, y, misc, Interval, ! The limits look a little funny. But remember we are placing the value in the 2*J location, ! so we cannot overun the end of the array. The floor function is just in case NStepWave2 is ! an odd number - DO n=1,FLOOR( REAL(InitInp%NStepWave2-1) / 2.0_SiKi ) ! Only + DO n=1,FLOOR( REAL(WaveField%NStepWave2-1) / 2.0_SiKi ) ! Only - Omega_n = n * InitInp%WaveDOmega + Omega_n = n * WaveField%WaveDOmega ! The frequency we are dealing with !> * \f$ \omega^+ = \mu^+ \Delta \omega = 2 \omega_n \f$ mu_plus = 2 * n Omega_plus = 2.0_SiKi * Omega_n - IF ( Omega_plus >= InitInp%WvLowCOffS .AND. Omega_plus <= InitInp%WvHiCOffS ) THEN - k_n = WaveNumber( Omega_n, InitInp%Gravity, InitInp%WtrDpth ) + IF ( Omega_plus >= WaveField%WvLowCOffS .AND. Omega_plus <= WaveField%WvHiCOffS ) THEN + k_n = WaveNumber( Omega_n, InitInp%Gravity, WaveField%EffWtrDpth ) k_nm = k_nm_plus( n, n, k_n, k_n ) @@ -1069,8 +931,8 @@ SUBROUTINE Waves2_Init( InitInp, u, p, x, xd, z, OtherState, y, misc, Interval, !! + |\vec{k_n}| \sin \theta_n ~ y \right] \right) \f$ WaveElevxyPrime0 = exp( - ImagNmbr & - * ( 2.0_SiKi * k_n * COS( D2R_S*InitInp%WaveDirArr(n) ) * InitInp%WaveKinxi(WaveKinPrimeMap(I)) & - + 2.0_SiKi * k_n * SIN( D2R_S*InitInp%WaveDirArr(n) ) * InitInp%WaveKinyi(WaveKinPrimeMap(I)) )) + * ( 2.0_SiKi * k_n * COS( D2R_S*WaveField%WaveDirArr(n) ) * InitInp%WaveKinGridxi(masterCount) & + + 2.0_SiKi * k_n * SIN( D2R_S*WaveField%WaveDirArr(n) ) * InitInp%WaveKinGridyi(masterCount) )) ! Get value for \f$ B+ \f$ for the n,m index pair @@ -1078,15 +940,15 @@ SUBROUTINE Waves2_Init( InitInp, u, p, x, xd, z, OtherState, y, misc, Interval, !> Calculate \f$ U^+ \f$ terms for the velocity calculations (\f$B^+\f$ provided by waves2::transfuncb_plus) - ! NOTE: InitInp%WtrDpth + WaveKinzi0Prime(I) is the height above the ocean floor + ! NOTE: WaveField%EffWtrDpth + WaveKinzi0Prime(I) is the height above the ocean floor !> * \f$ _x{U}_{nn}^+ = B_{nn}^+ 2 k_n \cos \theta_n \f$ - Ux_nm_plus = B_plus * 2.0_SiKi * k_n * COS( D2R_S*InitInp%WaveDirArr(n) ) + Ux_nm_plus = B_plus * 2.0_SiKi * k_n * COS( D2R_S*WaveField%WaveDirArr(n) ) !> * \f$ _y{U}_{nn}^+ = B_{nn}^+ 2 k_n \sin \theta_n \f$ - Uy_nm_plus = B_plus * 2.0_SiKi * k_n * SIN( D2R_S*InitInp%WaveDirArr(n) ) + Uy_nm_plus = B_plus * 2.0_SiKi * k_n * SIN( D2R_S*WaveField%WaveDirArr(n) ) !> * \f$ _z{U}_{nn}^+ = \imath B_{nn}^+ k_{nn} \tanh \left( k_{nn} ( h + z ) \right) \f$ - Uz_nm_plus = ImagNmbr * B_plus * k_nm * tanh( k_nm * ( InitInp%WtrDpth + WaveKinzi0Prime(I) ) ) + Uz_nm_plus = ImagNmbr * B_plus * k_nm * tanh( k_nm * ( WaveField%EffWtrDpth + WaveKinzi0Prime(I) ) ) !> Acceleration calculations @@ -1097,7 +959,7 @@ SUBROUTINE Waves2_Init( InitInp, u, p, x, xd, z, OtherState, y, misc, Interval, !> Dynamic pressure !> * \f$ P_{nn}^+ = \rho_\mathrm{w} B_{nn}^+ \omega_{\mu^+} \f$ - DynP_nm_plus = REAL(InitInp%WtrDens, SiKi) * B_plus * Omega_plus + DynP_nm_plus = REAL(WaveField%WtrDens, SiKi) * B_plus * Omega_plus @@ -1142,21 +1004,21 @@ SUBROUTINE Waves2_Init( InitInp, u, p, x, xd, z, OtherState, y, misc, Interval, ! \f$ \mu^+ \f$ loop. This loop is used to construct the full set of \f$ H_{\mu^+} \f$ terms used in the IFFT to find the timeseries. !> * \f$ \mu^+ = n + m \f$ - DO mu_plus=2,InitInp%NStepWave2-1 + DO mu_plus=2,WaveField%NStepWave2-1 ! The frequency we are dealing with !> * \f$ \omega^+ = \mu^+ \Delta \omega \f$ - Omega_plus = mu_plus * InitInp%WaveDOmega + Omega_plus = mu_plus * WaveField%WaveDOmega - IF ( Omega_plus >= InitInp%WvLowCOffS .AND. Omega_plus <= InitInp%WvHiCOffS ) THEN + IF ( Omega_plus >= WaveField%WvLowCOffS .AND. Omega_plus <= WaveField%WvHiCOffS ) THEN ! The inner \f$ m \f$ loop for calculating the \f$ H_{\mu^+} \f$ terms at each frequency. DO m=1,FLOOR( REAL(mu_plus - 1) / 2.0_SiKi ) ! Calculate the value of the n index from \f$ \mu^+ = n + m \f$. Calculate corresponding wavenumbers and frequencies. n = mu_plus - m - Omega_n = n * InitInp%WaveDOmega - Omega_m = m * InitInp%WaveDOmega - k_n = WaveNumber( Omega_n, InitInp%Gravity, InitInp%WtrDpth ) - k_m = WaveNumber( Omega_m, InitInp%Gravity, InitInp%WtrDpth ) + Omega_n = n * WaveField%WaveDOmega + Omega_m = m * WaveField%WaveDOmega + k_n = WaveNumber( Omega_n, InitInp%Gravity, WaveField%EffWtrDpth ) + k_m = WaveNumber( Omega_m, InitInp%Gravity, WaveField%EffWtrDpth ) k_nm = k_nm_plus( n, m, k_n, k_m ) @@ -1171,8 +1033,8 @@ SUBROUTINE Waves2_Init( InitInp, u, p, x, xd, z, OtherState, y, misc, Interval, !! + \left( |\vec{k_n}| \sin \theta_n + |\vec{k_m}| sin \theta_m \right) ~ y \right] \right) \f$ WaveElevxyPrime0 = exp( - ImagNmbr & - * ( ( k_n * COS( D2R_S*InitInp%WaveDirArr(n) ) + k_m * COS( D2R_S*InitInp%WaveDirArr(m) ) ) * InitInp%WaveKinxi(WaveKinPrimeMap(I)) & - + ( k_n * SIN( D2R_S*InitInp%WaveDirArr(n) ) + k_m * SIN( D2R_S*InitInp%WaveDirArr(m) ) ) * InitInp%WaveKinyi(WaveKinPrimeMap(I)) )) + * ( ( k_n * COS( D2R_S*WaveField%WaveDirArr(n) ) + k_m * COS( D2R_S*WaveField%WaveDirArr(m) ) ) * InitInp%WaveKinGridxi(masterCount) & + + ( k_n * SIN( D2R_S*WaveField%WaveDirArr(n) ) + k_m * SIN( D2R_S*WaveField%WaveDirArr(m) ) ) * InitInp%WaveKinGridyi(masterCount) )) ! Get value for \f$ B+ \f$ for the n,m index pair @@ -1180,15 +1042,15 @@ SUBROUTINE Waves2_Init( InitInp, u, p, x, xd, z, OtherState, y, misc, Interval, !> Calculate \f$ U^+ \f$ terms for the velocity calculations (\f$B^+\f$ provided by waves2::transfuncb_plus) - ! NOTE: InitInp%WtrDpth + WaveKinzi0Prime(I) is the height above the ocean floor + ! NOTE: WaveField%EffWtrDpth + WaveKinzi0Prime(I) is the height above the ocean floor !> * \f$ _x{U}_{nm}^+ = B_{nm}^+ \left(k_n \cos \theta_n + k_m \cos \theta_m \right) \f$ - Ux_nm_plus = B_plus * ( k_n * COS( D2R_S*InitInp%WaveDirArr(n) ) + k_m * COS( D2R_S*InitInp%WaveDirArr(m) ) ) + Ux_nm_plus = B_plus * ( k_n * COS( D2R_S*WaveField%WaveDirArr(n) ) + k_m * COS( D2R_S*WaveField%WaveDirArr(m) ) ) !> * \f$ _y{U}_{nm}^+ = B_{nm}^+ \left(k_n \sin \theta_n + k_m \sin \theta_m \right) \f$ - Uy_nm_plus = B_plus * ( k_n * SIN( D2R_S*InitInp%WaveDirArr(n) ) + k_m * SIN( D2R_S*InitInp%WaveDirArr(m) ) ) + Uy_nm_plus = B_plus * ( k_n * SIN( D2R_S*WaveField%WaveDirArr(n) ) + k_m * SIN( D2R_S*WaveField%WaveDirArr(m) ) ) !> * \f$ _z{U}_{nm}^+ = \imath B_{nm}^+ k_{nm} \tanh \left( k_{nm} ( h + z ) \right) \f$ - Uz_nm_plus = ImagNmbr * B_plus * k_nm * tanh( k_nm * ( InitInp%WtrDpth + WaveKinzi0Prime(I) ) ) + Uz_nm_plus = ImagNmbr * B_plus * k_nm * tanh( k_nm * ( WaveField%EffWtrDpth + WaveKinzi0Prime(I) ) ) !> Acceleration calculations @@ -1199,7 +1061,7 @@ SUBROUTINE Waves2_Init( InitInp, u, p, x, xd, z, OtherState, y, misc, Interval, !> Dynamic pressure !> * \f$ P_{nm}^+ = \rho_\mathrm{w} B_{nm}^+ \omega_{\mu^+} \f$ - DynP_nm_plus = REAL(InitInp%WtrDens,SiKi) * B_plus * Omega_plus + DynP_nm_plus = REAL(WaveField%WtrDens,SiKi) * B_plus * Omega_plus @@ -1262,38 +1124,38 @@ SUBROUTINE Waves2_Init( InitInp, u, p, x, xd, z, OtherState, y, misc, Interval, !> * \f$ V^{(2)+}(t) = \operatorname{IFFT}\left[K^+\right] !! + 2\operatorname{IFFT}\left[H^+\right] \f$ CALL ApplyFFT_cx( WaveVel2xSumT1(:), WaveVel2xCSumT1(:), FFT_Data, ErrStatTmp ) - CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT on V_x.',ErrStat,ErrMsg,'Waves2_Init') + CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT on V_x.',ErrStat,ErrMsg,RoutineName) CALL ApplyFFT_cx( WaveVel2ySumT1(:), WaveVel2yCSumT1(:), FFT_Data, ErrStatTmp ) - CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT on V_y.',ErrStat,ErrMsg,'Waves2_Init') + CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT on V_y.',ErrStat,ErrMsg,RoutineName) CALL ApplyFFT_cx( WaveVel2zSumT1(:), WaveVel2zCSumT1(:), FFT_Data, ErrStatTmp ) - CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT on V_z.',ErrStat,ErrMsg,'Waves2_Init') + CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT on V_z.',ErrStat,ErrMsg,RoutineName) CALL ApplyFFT_cx( WaveAcc2xSumT1(:), WaveAcc2xCSumT1(:), FFT_Data, ErrStatTmp ) - CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT on Acc_x.',ErrStat,ErrMsg,'Waves2_Init') + CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT on Acc_x.',ErrStat,ErrMsg,RoutineName) CALL ApplyFFT_cx( WaveAcc2ySumT1(:), WaveAcc2yCSumT1(:), FFT_Data, ErrStatTmp ) - CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT on Acc_y.',ErrStat,ErrMsg,'Waves2_Init') + CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT on Acc_y.',ErrStat,ErrMsg,RoutineName) CALL ApplyFFT_cx( WaveAcc2zSumT1(:), WaveAcc2zCSumT1(:), FFT_Data, ErrStatTmp ) - CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT on Acc_z.',ErrStat,ErrMsg,'Waves2_Init') + CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT on Acc_z.',ErrStat,ErrMsg,RoutineName) CALL ApplyFFT_cx( WaveDynP2SumT1(:), WaveDynP2CSumT1(:), FFT_Data, ErrStatTmp ) - CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT on DynP2.',ErrStat,ErrMsg,'Waves2_Init') + CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT on DynP2.',ErrStat,ErrMsg,RoutineName) CALL ApplyFFT_cx( WaveVel2xSumT2(:), WaveVel2xCSumT2(:), FFT_Data, ErrStatTmp ) - CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT on V_x.',ErrStat,ErrMsg,'Waves2_Init') + CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT on V_x.',ErrStat,ErrMsg,RoutineName) CALL ApplyFFT_cx( WaveVel2ySumT2(:), WaveVel2yCSumT2(:), FFT_Data, ErrStatTmp ) - CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT on V_y.',ErrStat,ErrMsg,'Waves2_Init') + CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT on V_y.',ErrStat,ErrMsg,RoutineName) CALL ApplyFFT_cx( WaveVel2zSumT2(:), WaveVel2zCSumT2(:), FFT_Data, ErrStatTmp ) - CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT on V_z.',ErrStat,ErrMsg,'Waves2_Init') + CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT on V_z.',ErrStat,ErrMsg,RoutineName) CALL ApplyFFT_cx( WaveAcc2xSumT2(:), WaveAcc2xCSumT2(:), FFT_Data, ErrStatTmp ) - CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT on Acc_x.',ErrStat,ErrMsg,'Waves2_Init') + CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT on Acc_x.',ErrStat,ErrMsg,RoutineName) CALL ApplyFFT_cx( WaveAcc2ySumT2(:), WaveAcc2yCSumT2(:), FFT_Data, ErrStatTmp ) - CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT on Acc_y.',ErrStat,ErrMsg,'Waves2_Init') + CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT on Acc_y.',ErrStat,ErrMsg,RoutineName) CALL ApplyFFT_cx( WaveAcc2zSumT2(:), WaveAcc2zCSumT2(:), FFT_Data, ErrStatTmp ) - CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT on Acc_z.',ErrStat,ErrMsg,'Waves2_Init') + CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT on Acc_z.',ErrStat,ErrMsg,RoutineName) CALL ApplyFFT_cx( WaveDynP2SumT2(:), WaveDynP2CSumT2(:), FFT_Data, ErrStatTmp ) - CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT on DynP2.',ErrStat,ErrMsg,'Waves2_Init') + CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT on DynP2.',ErrStat,ErrMsg,RoutineName) IF ( ErrStat >= AbortErrLev ) THEN CALL CleanUp() @@ -1302,21 +1164,25 @@ SUBROUTINE Waves2_Init( InitInp, u, p, x, xd, z, OtherState, y, misc, Interval, ! Add the results to the output - InitOut%WaveVel2S(:,WaveKinPrimeMap(I),1) = WaveVel2xSumT1(:) + 2.0_SiKi * WaveVel2xSumT2(:) ! x-component of velocity - InitOut%WaveVel2S(:,WaveKinPrimeMap(I),2) = WaveVel2ySumT1(:) + 2.0_SiKi * WaveVel2ySumT2(:) ! y-component of velocity - InitOut%WaveVel2S(:,WaveKinPrimeMap(I),3) = WaveVel2zSumT1(:) + 2.0_SiKi * WaveVel2zSumT2(:) ! z-component of velocity + ii = mod(masterCount-1, InitInp%NGrid(1)) + 1 + jj = mod( (masterCount-1) /InitInp%NGrid(1), InitInp%NGrid(2) ) + 1 + kk = (masterCount-1) / (InitInp%NGrid(1)*InitInp%NGrid(2)) + 1 + + InitOut%WaveVel2S(:,ii,jj,kk,1) = WaveVel2xSumT1(:) + 2.0_SiKi * WaveVel2xSumT2(:) ! x-component of velocity + InitOut%WaveVel2S(:,ii,jj,kk,2) = WaveVel2ySumT1(:) + 2.0_SiKi * WaveVel2ySumT2(:) ! y-component of velocity + InitOut%WaveVel2S(:,ii,jj,kk,3) = WaveVel2zSumT1(:) + 2.0_SiKi * WaveVel2zSumT2(:) ! z-component of velocity - InitOut%WaveAcc2S(:,WaveKinPrimeMap(I),1) = WaveAcc2xSumT1(:) + 2.0_SiKi * WaveAcc2xSumT2(:) ! x-component of acceleration - InitOut%WaveAcc2S(:,WaveKinPrimeMap(I),2) = WaveAcc2ySumT1(:) + 2.0_SiKi * WaveAcc2ySumT2(:) ! y-component of acceleration - InitOut%WaveAcc2S(:,WaveKinPrimeMap(I),3) = WaveAcc2zSumT1(:) + 2.0_SiKi * WaveAcc2zSumT2(:) ! z-component of acceleration + InitOut%WaveAcc2S(:,ii,jj,kk,1) = WaveAcc2xSumT1(:) + 2.0_SiKi * WaveAcc2xSumT2(:) ! x-component of acceleration + InitOut%WaveAcc2S(:,ii,jj,kk,2) = WaveAcc2ySumT1(:) + 2.0_SiKi * WaveAcc2ySumT2(:) ! y-component of acceleration + InitOut%WaveAcc2S(:,ii,jj,kk,3) = WaveAcc2zSumT1(:) + 2.0_SiKi * WaveAcc2zSumT2(:) ! z-component of acceleration - InitOut%WaveDynP2S(:,WaveKinPrimeMap(I)) = WaveDynP2SumT1(:) + 2.0_SiKi * WaveDynP2SumT2(:) ! Dynamic pressure + InitOut%WaveDynP2S(:,ii,jj,kk) = WaveDynP2SumT1(:) + 2.0_SiKi * WaveDynP2SumT2(:) ! Dynamic pressure ! Copy the first point to the last to make it easier. - InitOut%WaveVel2S(InitInp%NStepWave,WaveKinPrimeMap(I),:) = InitOut%WaveVel2S(0,WaveKinPrimeMap(I),:) - InitOut%WaveAcc2S(InitInp%NStepWave,WaveKinPrimeMap(I),:) = InitOut%WaveAcc2S(0,WaveKinPrimeMap(I),:) - InitOut%WaveDynP2S(InitInp%NStepWave,WaveKinPrimeMap(I)) = InitOut%WaveDynP2S(0,WaveKinPrimeMap(I)) + InitOut%WaveVel2S(WaveField%NStepWave,ii,jj,kk,:) = InitOut%WaveVel2S(0,ii,jj,kk,:) + InitOut%WaveAcc2S(WaveField%NStepWave,ii,jj,kk,:) = InitOut%WaveAcc2S(0,ii,jj,kk,:) + InitOut%WaveDynP2S(WaveField%NStepWave,ii,jj,kk) = InitOut%WaveDynP2S(0,ii,jj,kk) ENDDO ! I=1,NWaveKin0Prime loop end @@ -1362,7 +1228,7 @@ SUBROUTINE Waves2_Init( InitInp, u, p, x, xd, z, OtherState, y, misc, Interval, - ENDIF ! p%WvSumQTFF + ENDIF ! WvSumQTFF @@ -1370,7 +1236,7 @@ SUBROUTINE Waves2_Init( InitInp, u, p, x, xd, z, OtherState, y, misc, Interval, CALL ExitFFT(FFT_Data, ErrStatTmp) - CALL SetErrStat(ErrStatTmp,'Error occured while cleaning up after the FFTs.', ErrStat,ErrMsg,'Waves2_Init') + CALL SetErrStat(ErrStatTmp,'Error occured while cleaning up after the FFTs.', ErrStat,ErrMsg,RoutineName) IF ( ErrStat >= AbortErrLev ) THEN CALL CleanUp() RETURN @@ -1383,14 +1249,6 @@ SUBROUTINE Waves2_Init( InitInp, u, p, x, xd, z, OtherState, y, misc, Interval, IF (ALLOCATED(TmpFreqSeries)) DEALLOCATE(TmpFreqSeries, STAT=ErrStatTmp) IF (ALLOCATED(TmpFreqSeries2)) DEALLOCATE(TmpFreqSeries2, STAT=ErrStatTmp) - - ! initialize dummy variables for the framework, so that compilers don't complain that the INTENT(OUT) variables have not been set: - u%DummyInput = 0.0_SiKi - x%DummyContState = 0.0_SiKi - xd%DummyDiscState = 0.0_SiKi - z%DummyConstrState = 0.0_SiKi - OtherState%DummyOtherState = 0_IntKi - RETURN @@ -1416,7 +1274,7 @@ SUBROUTINE WaveElevTimeSeriesAtXY_Diff(Xcoord,Ycoord, WaveElevSeriesAtXY, ErrSta REAL(SiKi), INTENT(IN ) :: Xcoord REAL(SiKi), INTENT(IN ) :: Ycoord - REAL(SiKi), INTENT( OUT) :: WaveElevSeriesAtXY(0:InitInp%NStepWave) + REAL(SiKi), INTENT( OUT) :: WaveElevSeriesAtXY(0:WaveField%NStepWave) INTEGER(IntKi), INTENT( OUT) :: ErrStatLcl INTEGER(IntKi) :: ErrStatLcl2 CHARACTER(*), INTENT( OUT) :: ErrMsgLcl @@ -1444,24 +1302,24 @@ SUBROUTINE WaveElevTimeSeriesAtXY_Diff(Xcoord,Ycoord, WaveElevSeriesAtXY, ErrSta ! \f$ \mu^- \f$ loop. This loop is used to construct the full set of \f$ H_{\mu^-} \f$ terms used in the IFFT to find the timeseries. !> * \f$ \mu^- = n -m \f$ - DO mu_minus=1,InitInp%NStepWave2-1 + DO mu_minus=1,WaveField%NStepWave2-1 ! The frequency we are dealing with !> * \f$ \omega^- = \mu^- \Delta \omega \f$ - Omega_minus = mu_minus * InitInp%WaveDOmega + Omega_minus = mu_minus * WaveField%WaveDOmega - IF ( Omega_minus >= InitInp%WvLowCOffD .AND. Omega_minus <= InitInp%WvHiCOffD ) THEN + IF ( Omega_minus >= WaveField%WvLowCOffD .AND. Omega_minus <= WaveField%WvHiCOffD ) THEN ! The inner \f$ m \f$ loop for calculating the \f$ H_{\mu^-} \f$ terms at each frequency. - DO m=1,InitInp%NStepWave2-mu_minus + DO m=1,WaveField%NStepWave2-mu_minus ! Calculate the value of the n index from \f$ \mu^- = n - m \f$. Calculate corresponding wavenumbers and frequencies. n = mu_minus + m - Omega_n = n * InitInp%WaveDOmega - Omega_m = m * InitInp%WaveDOmega - k_n = WaveNumber( Omega_n, InitInp%Gravity, InitInp%WtrDpth ) - k_m = WaveNumber( Omega_m, InitInp%Gravity, InitInp%WtrDpth ) - R_n = k_n * tanh( k_n * InitInp%WtrDpth ) - R_m = k_m * tanh( k_m * InitInp%WtrDpth ) + Omega_n = n * WaveField%WaveDOmega + Omega_m = m * WaveField%WaveDOmega + k_n = WaveNumber( Omega_n, InitInp%Gravity, WaveField%EffWtrDpth ) + k_m = WaveNumber( Omega_m, InitInp%Gravity, WaveField%EffWtrDpth ) + R_n = k_n * tanh( k_n * WaveField%EffWtrDpth ) + R_m = k_m * tanh( k_m * WaveField%EffWtrDpth ) D_minus = TransFuncD_minus(n,m,k_n,k_m,R_n,R_m) !> Calculate the value of @@ -1471,7 +1329,7 @@ SUBROUTINE WaveElevTimeSeriesAtXY_Diff(Xcoord,Ycoord, WaveElevSeriesAtXY, ErrSta !! !! The value of \f$ D^-_{nm} \f$ is found from by the ::TransFuncD_minus routine. - L_minus = (( D_minus - k_n * k_m * COS(D2R_S*InitInp%WaveDirArr(n) - D2R_S*InitInp%WaveDirArr(m)) - R_n * R_m )/SQRT( R_n * R_m ) + R_n + R_m) / 4.0_SiKi !4.0_SiKi + L_minus = (( D_minus - k_n * k_m * COS(D2R_S*WaveField%WaveDirArr(n) - D2R_S*WaveField%WaveDirArr(m)) - R_n * R_m )/SQRT( R_n * R_m ) + R_n + R_m) / 4.0_SiKi !4.0_SiKi ! Calculate the terms \f$ n,m \f$ necessary for calculations @@ -1485,8 +1343,8 @@ SUBROUTINE WaveElevTimeSeriesAtXY_Diff(Xcoord,Ycoord, WaveElevSeriesAtXY, ErrSta !! + \left( |\vec{k_n}| \sin \theta_n - |\vec{k_m}| sin \theta_m \right) ~ y \right] \right) \f$ WaveElevxyPrime0 = exp( - ImagNmbr & - * ( ( k_n * COS( D2R_S*InitInp%WaveDirArr(n) ) - k_m * COS( D2R_S*InitInp%WaveDirArr(m) ) ) * XCoord & - + ( k_n * SIN( D2R_S*InitInp%WaveDirArr(n) ) - k_m * SIN( D2R_S*InitInp%WaveDirArr(m) ) ) * YCoord )) + * ( ( k_n * COS( D2R_S*WaveField%WaveDirArr(n) ) - k_m * COS( D2R_S*WaveField%WaveDirArr(m) ) ) * XCoord & + + ( k_n * SIN( D2R_S*WaveField%WaveDirArr(n) ) - k_m * SIN( D2R_S*WaveField%WaveDirArr(m) ) ) * YCoord )) !> ### Calculate the inner summation \f$ H^-(\omega_{\mu^-}) \f$ terms for the velocity, acceleration, and pressure. ### @@ -1521,7 +1379,7 @@ SUBROUTINE WaveElevTimeSeriesAtXY_Diff(Xcoord,Ycoord, WaveElevSeriesAtXY, ErrSta CALL SetErrStat(ErrStatLcl2,'Error occured while applying the FFT on WaveElevSeriesAtXY.',ErrStatLcl,ErrMsgLcl,'WaveElevSeriesAtXY_Diff') ! Append first datapoint as the last as aid for repeated wave data - WaveElevSeriesAtXY(InitInp%NStepWave) = WaveElevSeriesAtXY(0) + WaveElevSeriesAtXY(WaveField%NStepWave) = WaveElevSeriesAtXY(0) END SUBROUTINE WaveElevTimeSeriesAtXY_Diff @@ -1543,7 +1401,7 @@ SUBROUTINE WaveElevTimeSeriesAtXY_Sum(Xcoord,Ycoord, WaveElevSeriesAtXY, ErrStat REAL(SiKi), INTENT(IN ) :: Xcoord REAL(SiKi), INTENT(IN ) :: Ycoord - REAL(SiKi), INTENT( OUT) :: WaveElevSeriesAtXY(0:InitInp%NStepWave) + REAL(SiKi), INTENT( OUT) :: WaveElevSeriesAtXY(0:WaveField%NStepWave) INTEGER(IntKi), INTENT( OUT) :: ErrStatLcl INTEGER(IntKi) :: ErrStatLcl2 CHARACTER(*), INTENT( OUT) :: ErrMsgLcl @@ -1575,18 +1433,18 @@ SUBROUTINE WaveElevTimeSeriesAtXY_Sum(Xcoord,Ycoord, WaveElevSeriesAtXY, ErrStat !> ## First term ## ! First term results are stored in TmpFreqSeries. - DO n=1,FLOOR( REAL(InitInp%NStepWave2-1) / 2.0_SiKi ) ! Only + DO n=1,FLOOR( REAL(WaveField%NStepWave2-1) / 2.0_SiKi ) ! Only - Omega_n = n * InitInp%WaveDOmega + Omega_n = n * WaveField%WaveDOmega ! The frequency we are dealing with !> * \f$ \omega^+ = \mu^+ \Delta \omega = 2 \omega_n \f$ mu_plus = 2 * n Omega_plus = 2.0_SiKi * Omega_n - IF ( Omega_plus >= InitInp%WvLowCOffS .AND. Omega_plus <= InitInp%WvHiCOffS ) THEN - k_n = WaveNumber( Omega_n, InitInp%Gravity, InitInp%WtrDpth ) - R_n = k_n * tanh( k_n * InitInp%WtrDpth ) + IF ( Omega_plus >= WaveField%WvLowCOffS .AND. Omega_plus <= WaveField%WvHiCOffS ) THEN + k_n = WaveNumber( Omega_n, InitInp%Gravity, WaveField%EffWtrDpth ) + R_n = k_n * tanh( k_n * WaveField%EffWtrDpth ) D_plus = TransFuncD_plus(n,n,k_n,k_n,R_n,R_n) !> Calculate the value of @@ -1607,8 +1465,8 @@ SUBROUTINE WaveElevTimeSeriesAtXY_Sum(Xcoord,Ycoord, WaveElevSeriesAtXY, ErrStat !! + |\vec{k_n}| \sin \theta_n ~ y \right] \right) \f$ WaveElevxyPrime0 = exp( - ImagNmbr & - * ( 2.0_SiKi * k_n * COS( D2R_S*InitInp%WaveDirArr(n) ) * XCoord & - + 2.0_SiKi * k_n * SIN( D2R_S*InitInp%WaveDirArr(n) ) * YCoord )) + * ( 2.0_SiKi * k_n * COS( D2R_S*WaveField%WaveDirArr(n) ) * XCoord & + + 2.0_SiKi * k_n * SIN( D2R_S*WaveField%WaveDirArr(n) ) * YCoord )) ! First get the wave amplitude -- must be reconstructed from the WaveElevC0 array. First index is the real (1) or ! imaginary (2) part. Divide by NStepWave2 to remove the built in normalization in WaveElevC0. Note that the phase @@ -1637,24 +1495,24 @@ SUBROUTINE WaveElevTimeSeriesAtXY_Sum(Xcoord,Ycoord, WaveElevSeriesAtXY, ErrStat ! \f$ \mu^+ \f$ loop. This loop is used to construct the full set of \f$ H_{\mu^+} \f$ terms used in the IFFT to find the timeseries. !> * \f$ \mu^+ = n + m \f$ - DO mu_plus=2,InitInp%NStepWave2-1 + DO mu_plus=2,WaveField%NStepWave2-1 ! The frequency we are dealing with !> * \f$ \omega^+ = \mu^+ \Delta \omega \f$ - Omega_plus = mu_plus * InitInp%WaveDOmega + Omega_plus = mu_plus * WaveField%WaveDOmega - IF ( Omega_plus >= InitInp%WvLowCOffS .AND. Omega_plus <= InitInp%WvHiCOffS ) THEN + IF ( Omega_plus >= WaveField%WvLowCOffS .AND. Omega_plus <= WaveField%WvHiCOffS ) THEN ! The inner \f$ m \f$ loop for calculating the \f$ H_{\mu^+} \f$ terms at each frequency. DO m=1,FLOOR( REAL(mu_plus - 1) / 2.0_SiKi ) ! Calculate the value of the n index from \f$ \mu^+ = n + m \f$. Calculate corresponding wavenumbers and frequencies. n = mu_plus - m - Omega_n = n * InitInp%WaveDOmega - Omega_m = m * InitInp%WaveDOmega - k_n = WaveNumber( Omega_n, InitInp%Gravity, InitInp%WtrDpth ) - k_m = WaveNumber( Omega_m, InitInp%Gravity, InitInp%WtrDpth ) - R_n = k_n * tanh( k_n * InitInp%WtrDpth ) - R_m = k_m * tanh( k_m * InitInp%WtrDpth ) + Omega_n = n * WaveField%WaveDOmega + Omega_m = m * WaveField%WaveDOmega + k_n = WaveNumber( Omega_n, InitInp%Gravity, WaveField%EffWtrDpth ) + k_m = WaveNumber( Omega_m, InitInp%Gravity, WaveField%EffWtrDpth ) + R_n = k_n * tanh( k_n * WaveField%EffWtrDpth ) + R_m = k_m * tanh( k_m * WaveField%EffWtrDpth ) D_plus = TransFuncD_plus(n,m,k_n,k_m,R_n,R_m) !> Calculate the value of @@ -1663,7 +1521,7 @@ SUBROUTINE WaveElevTimeSeriesAtXY_Sum(Xcoord,Ycoord, WaveElevSeriesAtXY, ErrStat !! + (R_n+R_m) \right] \f$ !! !! The value of \f$ D^-_{nm} \f$ is found from by the ::TransFuncD_plus routine. - L_plus = (( D_plus - k_n * k_m * COS(D2R_S*InitInp%WaveDirArr(n) - D2R_S*InitInp%WaveDirArr(m)) + R_n * R_m )/SQRT( R_n * R_m ) + R_n + R_m) / 4.0_SiKi + L_plus = (( D_plus - k_n * k_m * COS(D2R_S*WaveField%WaveDirArr(n) - D2R_S*WaveField%WaveDirArr(m)) + R_n * R_m )/SQRT( R_n * R_m ) + R_n + R_m) / 4.0_SiKi !> Calculate the dot product of the wavenumbers with the (x,y) location !! This is given by: @@ -1674,8 +1532,8 @@ SUBROUTINE WaveElevTimeSeriesAtXY_Sum(Xcoord,Ycoord, WaveElevSeriesAtXY, ErrStat !! + \left( |\vec{k_n}| \sin \theta_n + |\vec{k_m}| sin \theta_m \right) ~ y \right] \right) \f$ WaveElevxyPrime0 = exp( - ImagNmbr & - * ( ( k_n * COS( D2R_S*InitInp%WaveDirArr(n) ) + k_m * COS( D2R_S*InitInp%WaveDirArr(m) ) ) * XCoord & - + ( k_n * SIN( D2R_S*InitInp%WaveDirArr(n) ) + k_m * SIN( D2R_S*InitInp%WaveDirArr(m) ) ) * YCoord )) + * ( ( k_n * COS( D2R_S*WaveField%WaveDirArr(n) ) + k_m * COS( D2R_S*WaveField%WaveDirArr(m) ) ) * XCoord & + + ( k_n * SIN( D2R_S*WaveField%WaveDirArr(n) ) + k_m * SIN( D2R_S*WaveField%WaveDirArr(m) ) ) * YCoord )) @@ -1710,12 +1568,12 @@ SUBROUTINE WaveElevTimeSeriesAtXY_Sum(Xcoord,Ycoord, WaveElevSeriesAtXY, ErrStat CALL SetErrStat(ErrStatLcl2,'Error occured while applying the FFT on WaveElevSeriesAtXY.',ErrStatLcl,ErrMsgLcl,'WaveElevSeriesAtXY_Sum') ! Add the two terms together - DO Ctr=0,InitInp%NStepWave + DO Ctr=0,WaveField%NStepWave WaveElevSeriesAtXY(Ctr) = WaveElevSeriesAtXY(Ctr) + 2.0_SiKi * TmpTimeSeries2(Ctr) ENDDO ! Append first datapoint as the last as aid for repeated wave data - WaveElevSeriesAtXY(InitInp%NStepWave) = WaveElevSeriesAtXY(0) + WaveElevSeriesAtXY(WaveField%NStepWave) = WaveElevSeriesAtXY(0) END SUBROUTINE WaveElevTimeSeriesAtXY_Sum @@ -1763,15 +1621,15 @@ FUNCTION TransFuncB_minus(n,m,k_n,k_m,z) ELSE ! Frequencies - Omega_n = n * InitInp%WaveDOmega - Omega_m = m * InitInp%WaveDOmega + Omega_n = n * WaveField%WaveDOmega + Omega_m = m * WaveField%WaveDOmega ! Wavenumbers k_nm = k_nm_minus( n,m,k_n,k_m ) ! Effect of depth scaling - R_n = k_n * tanh( k_n * InitInp%WtrDpth ) - R_m = k_m * tanh( k_m * InitInp%WtrDpth ) + R_n = k_n * tanh( k_n * WaveField%EffWtrDpth ) + R_m = k_m * tanh( k_m * WaveField%EffWtrDpth ) ! Transfer function D_minus D_minus = TransFuncD_minus(n,m,k_n,k_m,R_n,R_m) @@ -1779,7 +1637,7 @@ FUNCTION TransFuncB_minus(n,m,k_n,k_m,z) ! Calculation of B_minus TransFuncB_minus = REAL(InitInp%Gravity*InitInp%Gravity,SiKi) / ( 4.0_SiKi * Omega_n * Omega_m ) & - * COSHNumOvrCOSHDen(k_nm, REAL(InitInp%WtrDpth,SiKi), z) * D_minus / ( Omega_n - Omega_m ) + * COSHNumOvrCOSHDen(k_nm, REAL(WaveField%EffWtrDpth,SiKi), z) * D_minus / ( Omega_n - Omega_m ) ENDIF @@ -1825,22 +1683,22 @@ FUNCTION TransFuncB_plus(n,m,k_n,k_m,z) ELSE ! Frequencies - Omega_n = n * InitInp%WaveDOmega - Omega_m = m * InitInp%WaveDOmega + Omega_n = n * WaveField%WaveDOmega + Omega_m = m * WaveField%WaveDOmega ! Wavenumbers k_nm = k_nm_plus( n,m,k_n,k_m ) ! Effect of depth scaling - R_n = k_n * tanh( k_n * InitInp%WtrDpth ) - R_m = k_m * tanh( k_m * InitInp%WtrDpth ) + R_n = k_n * tanh( k_n * WaveField%EffWtrDpth ) + R_m = k_m * tanh( k_m * WaveField%EffWtrDpth ) ! Transfer function D_plus D_plus = TransFuncD_plus(n,m,k_n,k_m,R_n,R_m) ! Calculation of B_plus TransFuncB_plus = REAL(InitInp%Gravity*InitInp%Gravity,SiKi) / ( 4.0_SiKi * Omega_n * Omega_m ) & - * COSHNumOvrCOSHDen(k_nm, REAL(InitInp%WtrDpth,SiKi), z) * D_plus / ( Omega_n + Omega_m ) + * COSHNumOvrCOSHDen(k_nm, REAL(WaveField%EffWtrDpth,SiKi), z) * D_plus / ( Omega_n + Omega_m ) ENDIF @@ -1955,10 +1813,10 @@ FUNCTION TransFuncD_minus(n,m,k_n,k_m,R_n,R_m) ! Calculate the two pieces of the numerator Num1 = SqrtRnMinusRm * ( SQRT(R_m) * ( k_n*k_n - R_n*R_n ) - SQRT(R_n) * ( k_m*k_m - R_m*R_m ) ) - Num2 = 2*SqrtRnMinusRm*SqrtRnMinusRm*( k_n * k_m * COS( D2R_S*InitInp%WaveDirArr(n) - D2R_S*InitInp%WaveDirArr(m) ) + R_n*R_m ) + Num2 = 2*SqrtRnMinusRm*SqrtRnMinusRm*( k_n * k_m * COS( D2R_S*WaveField%WaveDirArr(n) - D2R_S*WaveField%WaveDirArr(m) ) + R_n*R_m ) ! Calculate the denominator - Den = SqrtRnMinusRm*SqrtRnMinusRm - k_nm * tanh( k_nm * InitInp%WtrDpth ) + Den = SqrtRnMinusRm*SqrtRnMinusRm - k_nm * tanh( k_nm * WaveField%EffWtrDpth ) TransFuncD_minus = (Num1+Num2) / Den @@ -2019,10 +1877,10 @@ FUNCTION TransFuncD_plus(n,m,k_n,k_m,R_n,R_m) ! Calculate the two pieces of the numerator Num1 = SqrtRnPlusRm * ( SQRT(R_m) * ( k_n*k_n - R_n*R_n ) + SQRT(R_n) * ( k_m*k_m - R_m*R_m ) ) - Num2 = 2*SqrtRnPlusRm*SqrtRnPlusRm*( k_n * k_m * COS( D2R_S*InitInp%WaveDirArr(n) - D2R_S*InitInp%WaveDirArr(m) ) - R_n*R_m ) + Num2 = 2*SqrtRnPlusRm*SqrtRnPlusRm*( k_n * k_m * COS( D2R_S*WaveField%WaveDirArr(n) - D2R_S*WaveField%WaveDirArr(m) ) - R_n*R_m ) ! Calculate the denominator - Den = SqrtRnPlusRm*SqrtRnPlusRm - k_nm * tanh( k_nm * InitInp%WtrDpth ) + Den = SqrtRnPlusRm*SqrtRnPlusRm - k_nm * tanh( k_nm * WaveField%EffWtrDpth ) TransFuncD_plus = (Num1+Num2) / Den @@ -2053,7 +1911,7 @@ FUNCTION k_nm_minus(n,m,k_n,k_m) k_nm_minus = 0.0_SiKi ! This is just to eliminate any numerical error ELSE !bjj: added abs() because we were getting very small negative numbers here (which should be 0). - k_nm_minus = sqrt( abs( k_n * k_n + k_m * k_m - 2 * k_n * k_m * cos( D2R_S*InitInp%WaveDirArr(n) - D2R_S*InitINp%WaveDirArr(m) ) ) ) + k_nm_minus = sqrt( abs( k_n * k_n + k_m * k_m - 2 * k_n * k_m * cos( D2R_S*WaveField%WaveDirArr(n) - D2R_S*WaveField%WaveDirArr(m) ) ) ) ENDIF END FUNCTION k_nm_minus @@ -2078,7 +1936,7 @@ FUNCTION k_nm_plus(n,m,k_n,k_m) IF (n == m ) THEN k_nm_plus = 2.0_SiKi * k_n ! This is just to eliminate any numerical error. ELSE - k_nm_plus = sqrt( k_n * k_n + k_m * k_m + 2_SiKi * k_n * k_m * cos( D2R_S*InitInp%WaveDirArr(n) - D2R_S*InitINp%WaveDirArr(m) ) ) + k_nm_plus = sqrt( k_n * k_n + k_m * k_m + 2_SiKi * k_n * k_m * cos( D2R_S*WaveField%WaveDirArr(n) - D2R_S*WaveField%WaveDirArr(m) ) ) ENDIF END FUNCTION k_nm_plus @@ -2151,282 +2009,6 @@ END SUBROUTINE Waves2_Init - - -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine is called at the end of the simulation. The purpose of this routine is to destroy any data that is leftover. If -!! we don't do this, we may leave memory tied up after the simulation ends. -!! To destroy the data, we call several routines that are generated by the FAST registry, so any issues with the destroy routines -!! should be addressed by the registry.exe which generates the Waves2_Types.f90 file. -!! -SUBROUTINE Waves2_End( u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) -!.................................................................................................................................. - - TYPE(Waves2_InputType), INTENT(INOUT) :: u !< System inputs - TYPE(Waves2_ParameterType), INTENT(INOUT) :: p !< Parameters - TYPE(Waves2_ContinuousStateType), INTENT(INOUT) :: x !< Continuous states - TYPE(Waves2_DiscreteStateType), INTENT(INOUT) :: xd !< Discrete states - TYPE(Waves2_ConstraintStateType), INTENT(INOUT) :: z !< Constraint states - TYPE(Waves2_OtherStateType), INTENT(INOUT) :: OtherState !< Other states - TYPE(Waves2_OutputType), INTENT(INOUT) :: y !< System outputs - TYPE(Waves2_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. For Waves2, most calculations all performed - !! during the initialization, so there are no final calculations that need to be performed. - - - ! Close files here. The Waves2 module does not open any files, so there should be nothing to close. - - - !> Destroy the input data: - - CALL Waves2_DestroyInput( u, ErrStat, ErrMsg ) - - - !> Destroy the parameter data: - - CALL Waves2_DestroyParam( p, ErrStat, ErrMsg ) - - - !> Destroy the state data: - - CALL Waves2_DestroyContState( x, ErrStat, ErrMsg ) - CALL Waves2_DestroyDiscState( xd, ErrStat, ErrMsg ) - CALL Waves2_DestroyConstrState( z, ErrStat, ErrMsg ) - CALL Waves2_DestroyOtherState( OtherState, ErrStat, ErrMsg ) - - - !> Destroy the output data: - - CALL Waves2_DestroyOutput( y, ErrStat, ErrMsg ) - - -END SUBROUTINE Waves2_End - - - -!---------------------------------------------------------------------------------------------------------------------------------- -!> Loose coupling routine for solving constraint states, integrating continuous states, and updating discrete states. -!> Continuous, constraint, discrete, and other states are updated to values at t + Interval. -SUBROUTINE Waves2_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(Waves2_InputType), INTENT(IN ) :: Inputs(:) !< Inputs at InputTimes - REAL(DbKi), INTENT(IN ) :: InputTimes(:) !< Times in seconds associated with Inputs - TYPE(Waves2_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(Waves2_ContinuousStateType), INTENT(INOUT) :: x !< Input: Continuous states at t; - !!Output: Continuous states at t + Interval - TYPE(Waves2_DiscreteStateType), INTENT(INOUT) :: xd !< Input: Discrete states at t; - !!Output: Discrete states at t + Interval - TYPE(Waves2_ConstraintStateType), INTENT(INOUT) :: z !< Input: Constraint states at t; - !!Output: Constraint states at t + Interval - TYPE(Waves2_OtherStateType), INTENT(INOUT) :: OtherState !< Input: Other states at t; - !!Output: Other states at t + Interval - TYPE(Waves2_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 = "Warning: No States to update in Waves2 module. *Waves2_UpdateStates was called*" - - -END SUBROUTINE Waves2_UpdateStates - - - -!---------------------------------------------------------------------------------------------------------------------------------- -!> Routine for computing outputs, used in both loose and tight coupling. -!! The Waves2 module second order wave kinematic corrections are processed at initialization and passed to other modules (such as -!! Morrison) for processing. As a result, there is nothing that needs to be calculated by the CalcOutput routine other than the -!! WriteOutput values at each timestep. -SUBROUTINE Waves2_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) -!.................................................................................................................................. - - REAL(DbKi), INTENT(IN ) :: Time !< Current simulation time in seconds - TYPE(Waves2_InputType), INTENT(IN ) :: u !< Inputs at Time - TYPE(Waves2_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(Waves2_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at Time - TYPE(Waves2_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at Time - TYPE(Waves2_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at Time - TYPE(Waves2_OtherStateType), INTENT(IN ) :: OtherState !< Other states at Time - TYPE(Waves2_OutputType), INTENT(INOUT) :: y !< Outputs computed at Time (Input only so that mesh - !! connectivity information does not have to be recalculated) - TYPE(Waves2_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) :: I ! Generic index - REAL(SiKi) :: WaveElev2Temp(p%NWaveElev) - REAL(ReKi) :: AllOuts(MaxWaves2Outputs) - - - - ! Initialize ErrStat - - ErrStat = ErrID_None - ErrMsg = "" - - - - - ! Abort if the Waves2 module did not calculate anything - - IF ( .NOT. ALLOCATED ( p%WaveElev2 ) ) RETURN - IF ( p%NumOuts < 1 ) RETURN - - - DO I=1,p%NWaveElev - WaveElev2Temp(I) = InterpWrappedStpReal ( REAL(Time, SiKi), p%WaveTime(:), p%WaveElev2(:,I), & - m%LastIndWave, p%NStepWave + 1 ) - ENDDO - - ! Map the calculated results into the AllOuts Array - CALL Wvs2Out_MapOutputs(Time, y, p%NWaveElev, WaveElev2Temp, AllOuts, ErrStat, ErrMsg) - - - - ! Put the output data in the OutData array - DO I = 1,p%NumOuts - y%WriteOutput(I) = p%OutParam(I)%SignM * AllOuts( p%OutParam(I)%Indx ) - END DO - - - -END SUBROUTINE Waves2_CalcOutput - - - - -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine is required for the FAST framework, but is not actually needed for this module. -!! In the framework, this routine calculates the derivative of the continuous states. -!! As this routine is not necessary in the Waves2 module, it simply issues a warning and returns. -!! @note A few values will be set so that compilers are happy, but nothing of value is done. -SUBROUTINE Waves2_CalcContStateDeriv( Time, u, p, x, xd, z, OtherState, m, dxdt, ErrStat, ErrMsg ) -!.................................................................................................................................. - - REAL(DbKi), INTENT(IN ) :: Time !< Current simulation time in seconds - TYPE(Waves2_InputType), INTENT(IN ) :: u !< Inputs at Time - TYPE(Waves2_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(Waves2_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at Time - TYPE(Waves2_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at Time - TYPE(Waves2_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at Time - TYPE(Waves2_OtherStateType), INTENT(IN ) :: OtherState !< Other states at Time - TYPE(Waves2_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables - TYPE(Waves2_ContinuousStateType), INTENT( OUT) :: dxdt !< Continuous state derivatives at Time - 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 = "Warning: No States to take derivative of in Waves2 module. *Waves2::CalcContStateDeriv was called. It "// & - "is not necessary in the Waves2 module, so it does nothing.*" - - - ! Compute the first time derivatives of the continuous states here: None to calculate, so no code here. - - ! Dummy output value for dxdt -- this is only here to prevent the compiler from complaining. - dxdt%DummyContState = 0.0_SiKi - - -END SUBROUTINE Waves2_CalcContStateDeriv - - - - -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine is required for the FAST framework, but is not actually needed for this module. -!! In the framework, this routine is used to update discrete states, by -!! So, this routine will simply issue a warning and return. -SUBROUTINE Waves2_UpdateDiscState( Time, n, u, p, x, xd, z, OtherState, m, ErrStat, ErrMsg ) -!.................................................................................................................................. - - REAL(DbKi), INTENT(IN ) :: Time !< Current simulation time in seconds - INTEGER(IntKi), INTENT(IN ) :: n !< Current step of the simulation: t = n*Interval - TYPE(Waves2_InputType), INTENT(IN ) :: u !< Inputs at Time - TYPE(Waves2_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(Waves2_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at Time - TYPE(Waves2_DiscreteStateType), INTENT(INOUT) :: xd !< Input: Discrete states at Time; - !! Output: Discrete states at Time + Interval - TYPE(Waves2_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at Time - TYPE(Waves2_OtherStateType), INTENT(IN ) :: OtherState !< Other states at Time - TYPE(Waves2_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 = "Warning: No Discrete States to update in Waves2 module. *Waves2::UpdateDiscState was called. It is not "// & - "necessary in the Waves2 module, so it does nothing.*" - - ! Code to update the discrete states would live here, but there are no discrete states to update, hence no code. - - -END SUBROUTINE Waves2_UpdateDiscState - - - - -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine is required for the FAST framework, but is not actually needed for this module. -!! In the framework, this is a tight coupling routine for solving for the residual of the constraint state equations -!! So, this routine will simply issue a warning and return. -!! @note A few values will be set so that compilers are happy, but nothing of value is done. -SUBROUTINE Waves2_CalcConstrStateResidual( Time, u, p, x, xd, z, OtherState, m, z_residual, ErrStat, ErrMsg ) -!.................................................................................................................................. - - REAL(DbKi), INTENT(IN ) :: Time !< Current simulation time in seconds - TYPE(Waves2_InputType), INTENT(IN ) :: u !< Inputs at Time - TYPE(Waves2_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(Waves2_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at Time - TYPE(Waves2_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at Time - TYPE(Waves2_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at Time (possibly a guess) - TYPE(Waves2_OtherStateType), INTENT(IN ) :: OtherState !< Other states at Time - TYPE(Waves2_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables - TYPE(Waves2_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 - - - ! Initialize ErrStat - - ErrStat = ErrID_None - ErrMsg = "Warning: No States in Waves2 module. *Waves2::CalcConstrStateResidual was called. It is not needed in "//& - "the Waves2 module, so it does nothing useful." - - - - ! Solve for the constraint states here: Since there are no constraint states to solve for in Waves2, there is no code here. - - z_residual%DummyConstrState = 0.0_SiKi ! This exists just so that we can make the compiler happy. - -END SUBROUTINE Waves2_CalcConstrStateResidual - - - !---------------------------------------------------------------------------------------------------------------------------------- END MODULE Waves2 diff --git a/modules/seastate/src/Waves2.txt b/modules/seastate/src/Waves2.txt new file mode 100644 index 0000000000..0437fbe7f2 --- /dev/null +++ b/modules/seastate/src/Waves2.txt @@ -0,0 +1,42 @@ +################################################################################################################################### +# Registry for Waves2 in the FAST Modularization Framework +# This Registry file is used to create MODULE Waves2_Types which contains all of the user-defined types needed in Waves2. +# It also contains copy, destroy, pack, and unpack routines associated with each defined data types. +# See 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) ............................................................................ +# make sure that the file name does not have any trailing white spaces! +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 Waves2/Waves2 InitInputType ReKi Gravity - - - "Gravitational acceleration" (m/s^2) +typedef ^ ^ integer nGrid 3 - - "Grid dimensions" +typedef ^ ^ INTEGER NWaveElevGrid - - - "Number of grid points where the incident wave elevations can be output" - +typedef ^ ^ INTEGER NWaveKinGrid - - - "Number of grid points where the incident wave kinematics will be computed" - +typedef ^ ^ SiKi WaveKinGridxi {:} - - "xi-coordinates for grid points where the incident wave kinematics will be computed; these are relative to the mean sea level" (meters) +typedef ^ ^ SiKi WaveKinGridyi {:} - - "yi-coordinates for grid points where the incident wave kinematics will be computed; these are relative to the mean sea level" (meters) +typedef ^ ^ SiKi WaveKinGridzi {:} - - "zi-coordinates for grid points where the incident wave kinematics will be computed; these are relative to the mean sea level" (meters) + +typedef ^ ^ LOGICAL WvDiffQTFF - - - "Full difference QTF second order forces flag" (-) +typedef ^ ^ LOGICAL WvSumQTFF - - - "Full sum QTF second order forces flag" (-) + + +# Define outputs from the initialization routine here: +# +typedef ^ InitOutputType SiKi WaveAcc2D {:}{:}{:}{:}{:} - - "Instantaneous 2nd-order difference frequency correction for the acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, at each of the NWaveKinGrid points where the incident wave kinematics will be computed" (m/s^2) +typedef ^ ^ SiKi WaveDynP2D {:}{:}{:}{:} - - "Instantaneous 2nd-order difference frequency correction for the dynamic pressure of incident waves , at each of the NWaveKinGrid points where the incident wave kinematics will be computed" (N/m^2) +typedef ^ ^ SiKi WaveAcc2S {:}{:}{:}{:}{:} - - "Instantaneous 2nd-order sum frequency correction for the acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, at each of the NWaveKinGrid points where the incident wave kinematics will be computed" (m/s^2) +typedef ^ ^ SiKi WaveDynP2S {:}{:}{:}{:} - - "Instantaneous 2nd-order sum frequency correction for the dynamic pressure of incident waves , at each of the NWaveKinGrid points where the incident wave kinematics will be computed" (N/m^2) +typedef ^ ^ SiKi WaveVel2D {:}{:}{:}{:}{:} - - "Instantaneous 2nd-order difference frequency correction for the velocity of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, at each of the NWaveKinGrid points where the incident wave kinematics will be computed (The values include both the velocity of incident waves and the velocity of current.)" (m/s) +typedef ^ ^ SiKi WaveVel2S {:}{:}{:}{:}{:} - - "Instantaneous 2nd-order sum frequency correction for the velocity of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, at each of the NWaveKinGrid points where the incident wave kinematics will be computed (The values include both the velocity of incident waves and the velocity of current.)" (m/s) + + diff --git a/modules/seastate/src/Waves2_Types.f90 b/modules/seastate/src/Waves2_Types.f90 new file mode 100644 index 0000000000..02a2606df1 --- /dev/null +++ b/modules/seastate/src/Waves2_Types.f90 @@ -0,0 +1,312 @@ +!STARTOFREGISTRYGENERATEDFILE 'Waves2_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 +!********************************************************************************************************************************* +! Waves2_Types +!................................................................................................................................. +! This file is part of Waves2. +! +! 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 Waves2. 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 Waves2_Types +!--------------------------------------------------------------------------------------------------------------------------------- +USE NWTC_Library +IMPLICIT NONE +! ========= Waves2_InitInputType ======= + TYPE, PUBLIC :: Waves2_InitInputType + REAL(ReKi) :: Gravity = 0.0_ReKi !< Gravitational acceleration [(m/s^2)] + INTEGER(IntKi) , DIMENSION(1:3) :: nGrid = 0_IntKi !< Grid dimensions [-] + INTEGER(IntKi) :: NWaveElevGrid = 0_IntKi !< Number of grid points where the incident wave elevations can be output [-] + INTEGER(IntKi) :: NWaveKinGrid = 0_IntKi !< Number of grid points where the incident wave kinematics will be computed [-] + REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveKinGridxi !< xi-coordinates for grid points where the incident wave kinematics will be computed; these are relative to the mean sea level [(meters)] + REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveKinGridyi !< yi-coordinates for grid points where the incident wave kinematics will be computed; these are relative to the mean sea level [(meters)] + REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveKinGridzi !< zi-coordinates for grid points where the incident wave kinematics will be computed; these are relative to the mean sea level [(meters)] + LOGICAL :: WvDiffQTFF = .false. !< Full difference QTF second order forces flag [(-)] + LOGICAL :: WvSumQTFF = .false. !< Full sum QTF second order forces flag [(-)] + END TYPE Waves2_InitInputType +! ======================= +! ========= Waves2_InitOutputType ======= + TYPE, PUBLIC :: Waves2_InitOutputType + REAL(SiKi) , DIMENSION(:,:,:,:,:), ALLOCATABLE :: WaveAcc2D !< Instantaneous 2nd-order difference frequency correction for the acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, at each of the NWaveKinGrid points where the incident wave kinematics will be computed [(m/s^2)] + REAL(SiKi) , DIMENSION(:,:,:,:), ALLOCATABLE :: WaveDynP2D !< Instantaneous 2nd-order difference frequency correction for the dynamic pressure of incident waves , at each of the NWaveKinGrid points where the incident wave kinematics will be computed [(N/m^2)] + REAL(SiKi) , DIMENSION(:,:,:,:,:), ALLOCATABLE :: WaveAcc2S !< Instantaneous 2nd-order sum frequency correction for the acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, at each of the NWaveKinGrid points where the incident wave kinematics will be computed [(m/s^2)] + REAL(SiKi) , DIMENSION(:,:,:,:), ALLOCATABLE :: WaveDynP2S !< Instantaneous 2nd-order sum frequency correction for the dynamic pressure of incident waves , at each of the NWaveKinGrid points where the incident wave kinematics will be computed [(N/m^2)] + REAL(SiKi) , DIMENSION(:,:,:,:,:), ALLOCATABLE :: WaveVel2D !< Instantaneous 2nd-order difference frequency correction for the velocity of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, at each of the NWaveKinGrid points where the incident wave kinematics will be computed (The values include both the velocity of incident waves and the velocity of current.) [(m/s)] + REAL(SiKi) , DIMENSION(:,:,:,:,:), ALLOCATABLE :: WaveVel2S !< Instantaneous 2nd-order sum frequency correction for the velocity of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, at each of the NWaveKinGrid points where the incident wave kinematics will be computed (The values include both the velocity of incident waves and the velocity of current.) [(m/s)] + END TYPE Waves2_InitOutputType +! ======================= +CONTAINS + +subroutine Waves2_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) + type(Waves2_InitInputType), intent(in) :: SrcInitInputData + type(Waves2_InitInputType), intent(inout) :: DstInitInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'Waves2_CopyInitInput' + ErrStat = ErrID_None + ErrMsg = '' + DstInitInputData%Gravity = SrcInitInputData%Gravity + DstInitInputData%nGrid = SrcInitInputData%nGrid + DstInitInputData%NWaveElevGrid = SrcInitInputData%NWaveElevGrid + DstInitInputData%NWaveKinGrid = SrcInitInputData%NWaveKinGrid + if (allocated(SrcInitInputData%WaveKinGridxi)) then + LB(1:1) = lbound(SrcInitInputData%WaveKinGridxi) + UB(1:1) = ubound(SrcInitInputData%WaveKinGridxi) + if (.not. allocated(DstInitInputData%WaveKinGridxi)) then + allocate(DstInitInputData%WaveKinGridxi(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveKinGridxi.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%WaveKinGridxi = SrcInitInputData%WaveKinGridxi + end if + if (allocated(SrcInitInputData%WaveKinGridyi)) then + LB(1:1) = lbound(SrcInitInputData%WaveKinGridyi) + UB(1:1) = ubound(SrcInitInputData%WaveKinGridyi) + if (.not. allocated(DstInitInputData%WaveKinGridyi)) then + allocate(DstInitInputData%WaveKinGridyi(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveKinGridyi.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%WaveKinGridyi = SrcInitInputData%WaveKinGridyi + end if + if (allocated(SrcInitInputData%WaveKinGridzi)) then + LB(1:1) = lbound(SrcInitInputData%WaveKinGridzi) + UB(1:1) = ubound(SrcInitInputData%WaveKinGridzi) + if (.not. allocated(DstInitInputData%WaveKinGridzi)) then + allocate(DstInitInputData%WaveKinGridzi(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveKinGridzi.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%WaveKinGridzi = SrcInitInputData%WaveKinGridzi + end if + DstInitInputData%WvDiffQTFF = SrcInitInputData%WvDiffQTFF + DstInitInputData%WvSumQTFF = SrcInitInputData%WvSumQTFF +end subroutine + +subroutine Waves2_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(Waves2_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Waves2_DestroyInitInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InitInputData%WaveKinGridxi)) then + deallocate(InitInputData%WaveKinGridxi) + end if + if (allocated(InitInputData%WaveKinGridyi)) then + deallocate(InitInputData%WaveKinGridyi) + end if + if (allocated(InitInputData%WaveKinGridzi)) then + deallocate(InitInputData%WaveKinGridzi) + end if +end subroutine + +subroutine Waves2_PackInitInput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Waves2_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Waves2_PackInitInput' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%Gravity) + call RegPack(RF, InData%nGrid) + call RegPack(RF, InData%NWaveElevGrid) + call RegPack(RF, InData%NWaveKinGrid) + call RegPackAlloc(RF, InData%WaveKinGridxi) + call RegPackAlloc(RF, InData%WaveKinGridyi) + call RegPackAlloc(RF, InData%WaveKinGridzi) + call RegPack(RF, InData%WvDiffQTFF) + call RegPack(RF, InData%WvSumQTFF) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Waves2_UnPackInitInput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Waves2_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Waves2_UnPackInitInput' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%Gravity); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nGrid); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NWaveElevGrid); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NWaveKinGrid); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WaveKinGridxi); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WaveKinGridyi); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WaveKinGridzi); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WvDiffQTFF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WvSumQTFF); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Waves2_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) + type(Waves2_InitOutputType), intent(in) :: SrcInitOutputData + type(Waves2_InitOutputType), intent(inout) :: DstInitOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(5), UB(5) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'Waves2_CopyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcInitOutputData%WaveAcc2D)) then + LB(1:5) = lbound(SrcInitOutputData%WaveAcc2D) + UB(1:5) = ubound(SrcInitOutputData%WaveAcc2D) + if (.not. allocated(DstInitOutputData%WaveAcc2D)) then + allocate(DstInitOutputData%WaveAcc2D(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveAcc2D.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%WaveAcc2D = SrcInitOutputData%WaveAcc2D + end if + if (allocated(SrcInitOutputData%WaveDynP2D)) then + LB(1:4) = lbound(SrcInitOutputData%WaveDynP2D) + UB(1:4) = ubound(SrcInitOutputData%WaveDynP2D) + if (.not. allocated(DstInitOutputData%WaveDynP2D)) then + allocate(DstInitOutputData%WaveDynP2D(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveDynP2D.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%WaveDynP2D = SrcInitOutputData%WaveDynP2D + end if + if (allocated(SrcInitOutputData%WaveAcc2S)) then + LB(1:5) = lbound(SrcInitOutputData%WaveAcc2S) + UB(1:5) = ubound(SrcInitOutputData%WaveAcc2S) + if (.not. allocated(DstInitOutputData%WaveAcc2S)) then + allocate(DstInitOutputData%WaveAcc2S(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveAcc2S.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%WaveAcc2S = SrcInitOutputData%WaveAcc2S + end if + if (allocated(SrcInitOutputData%WaveDynP2S)) then + LB(1:4) = lbound(SrcInitOutputData%WaveDynP2S) + UB(1:4) = ubound(SrcInitOutputData%WaveDynP2S) + if (.not. allocated(DstInitOutputData%WaveDynP2S)) then + allocate(DstInitOutputData%WaveDynP2S(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveDynP2S.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%WaveDynP2S = SrcInitOutputData%WaveDynP2S + end if + if (allocated(SrcInitOutputData%WaveVel2D)) then + LB(1:5) = lbound(SrcInitOutputData%WaveVel2D) + UB(1:5) = ubound(SrcInitOutputData%WaveVel2D) + if (.not. allocated(DstInitOutputData%WaveVel2D)) then + allocate(DstInitOutputData%WaveVel2D(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveVel2D.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%WaveVel2D = SrcInitOutputData%WaveVel2D + end if + if (allocated(SrcInitOutputData%WaveVel2S)) then + LB(1:5) = lbound(SrcInitOutputData%WaveVel2S) + UB(1:5) = ubound(SrcInitOutputData%WaveVel2S) + if (.not. allocated(DstInitOutputData%WaveVel2S)) then + allocate(DstInitOutputData%WaveVel2S(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveVel2S.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%WaveVel2S = SrcInitOutputData%WaveVel2S + end if +end subroutine + +subroutine Waves2_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(Waves2_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Waves2_DestroyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InitOutputData%WaveAcc2D)) then + deallocate(InitOutputData%WaveAcc2D) + end if + if (allocated(InitOutputData%WaveDynP2D)) then + deallocate(InitOutputData%WaveDynP2D) + end if + if (allocated(InitOutputData%WaveAcc2S)) then + deallocate(InitOutputData%WaveAcc2S) + end if + if (allocated(InitOutputData%WaveDynP2S)) then + deallocate(InitOutputData%WaveDynP2S) + end if + if (allocated(InitOutputData%WaveVel2D)) then + deallocate(InitOutputData%WaveVel2D) + end if + if (allocated(InitOutputData%WaveVel2S)) then + deallocate(InitOutputData%WaveVel2S) + end if +end subroutine + +subroutine Waves2_PackInitOutput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Waves2_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Waves2_PackInitOutput' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%WaveAcc2D) + call RegPackAlloc(RF, InData%WaveDynP2D) + call RegPackAlloc(RF, InData%WaveAcc2S) + call RegPackAlloc(RF, InData%WaveDynP2S) + call RegPackAlloc(RF, InData%WaveVel2D) + call RegPackAlloc(RF, InData%WaveVel2S) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Waves2_UnPackInitOutput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Waves2_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Waves2_UnPackInitOutput' + integer(B4Ki) :: LB(5), UB(5) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%WaveAcc2D); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WaveDynP2D); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WaveAcc2S); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WaveDynP2S); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WaveVel2D); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WaveVel2S); if (RegCheckErr(RF, RoutineName)) return +end subroutine +END MODULE Waves2_Types +!ENDOFREGISTRYGENERATEDFILE diff --git a/modules/seastate/src/Waves_Types.f90 b/modules/seastate/src/Waves_Types.f90 new file mode 100644 index 0000000000..0c3e3c9f99 --- /dev/null +++ b/modules/seastate/src/Waves_Types.f90 @@ -0,0 +1,338 @@ +!STARTOFREGISTRYGENERATEDFILE 'Waves_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 +!********************************************************************************************************************************* +! Waves_Types +!................................................................................................................................. +! This file is part of Waves. +! +! 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 Waves. 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 Waves_Types +!--------------------------------------------------------------------------------------------------------------------------------- +USE NWTC_Library +IMPLICIT NONE +! ========= Waves_InitInputType ======= + TYPE, PUBLIC :: Waves_InitInputType + CHARACTER(1024) :: InputFile !< Name of the input file [-] + CHARACTER(1024) :: DirRoot !< The name of the root file including the full path. 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. [-] + CHARACTER(1024) :: WvKinFile !< The root name of user input wave kinematics files [-] + REAL(ReKi) :: Gravity = 0.0_ReKi !< Gravitational acceleration [(m/s^2)] + INTEGER(IntKi) , DIMENSION(1:3) :: nGrid = 0_IntKi !< Grid dimensions [-] + INTEGER(IntKi) :: WaveNDir = 0_IntKi !< Number of wave directions [only used if WaveDirMod = 1] [Must be an odd number -- will be adjusted within the waves module] [(-)] + REAL(SiKi) :: WaveDirSpread = 0.0_R4Ki !< Spreading coefficient [WaveMod=2,3,4 and WaveDirMod=1] [-] + REAL(SiKi) :: WaveDirRange = 0.0_R4Ki !< Range of wave directions (full range: WaveDir +/- WaveDirRange/2) [only used if WaveMod=6] [(degrees)] + REAL(DbKi) :: WaveDT = 0.0_R8Ki !< Time step for incident wave calculations [(sec)] + REAL(SiKi) :: WaveHs = 0.0_R4Ki !< Significant wave height of incident waves [(meters)] + LOGICAL :: WaveNDAmp = .false. !< Flag for normally-distributed amplitudes in incident waves spectrum [flag] [-] + REAL(SiKi) :: WavePhase = 0.0_R4Ki !< Specified phase for regular waves [(radians)] + REAL(SiKi) :: WavePkShp = 0.0_R4Ki !< Peak shape parameter of incident wave spectrum [1.0 for Pierson-Moskowitz] [-] + REAL(DbKi) :: WaveTMax = 0.0_R8Ki !< Analysis time for incident wave calculations; the actual analysis time may be larger than this value in order for the maintain an effecient FFT [(sec)] + REAL(SiKi) :: WaveTp = 0.0_R4Ki !< Peak spectral period of incident waves [(sec)] + INTEGER(IntKi) :: NWaveElevGrid = 0_IntKi !< Number of grid points where the incident wave elevations are computed (the XY grid point locations) [-] + INTEGER(IntKi) :: NWaveKinGrid = 0_IntKi !< Number of grid points where the incident wave kinematics will be computed [-] + REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveKinGridxi !< xi-coordinates for grid points where the incident wave kinematics will be computed (grid points); these are relative to the mean sea level [(meters)] + REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveKinGridyi !< yi-coordinates for grid points where the incident wave kinematics will be computed (grid points); these are relative to the mean sea level [(meters)] + REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveKinGridzi !< zi-coordinates for grid points where the incident wave kinematics will be computed (grid points); these are relative to the mean sea level [(meters)] + REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: CurrVxi !< xi-component of the current velocity at elevation i [(m/s)] + REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: CurrVyi !< yi-component of the current velocity at elevation i [(m/s)] + REAL(SiKi) :: PCurrVxiPz0 = 0.0_R4Ki !< xi-component of the partial derivative of the current velocity at elevation near mean sea level [(m/s)] + REAL(SiKi) :: PCurrVyiPz0 = 0.0_R4Ki !< yi-component of the partial derivative of the current velocity at elevation near mean sea level [(m/s)] + TYPE(NWTC_RandomNumber_ParameterType) :: RNG !< Parameters for the pseudo random number generator [-] + INTEGER(IntKi) :: ConstWaveMod = 0_IntKi !< Mode of the constrained wave [-] + REAL(SiKi) :: CrestHmax = 0.0_R4Ki !< crest height or double the crest elevation [m] + REAL(SiKi) :: CrestTime = 0.0_R4Ki !< time of the wave crest [sec] + REAL(SiKi) :: CrestXi = 0.0_R4Ki !< xi-coordinate for the wave crest [m] + REAL(SiKi) :: CrestYi = 0.0_R4Ki !< yi-coordinate for the wave crest [m] + INTEGER(IntKi) :: WaveFieldMod = 0_IntKi !< Wave field handling (-) (switch) 0: use individual SeaState inputs without adjustment, 1: adjust wave phases based on turbine offsets from farm origin [-] + REAL(ReKi) :: PtfmLocationX = 0.0_ReKi !< Supplied by Driver: X coordinate of platform location in the wave field [m] + REAL(ReKi) :: PtfmLocationY = 0.0_ReKi !< Supplied by Driver: Y coordinate of platform location in the wave field [m] + END TYPE Waves_InitInputType +! ======================= +! ========= Waves_InitOutputType ======= + TYPE, PUBLIC :: Waves_InitOutputType + INTEGER(IntKi) :: WaveNDir = 0_IntKi !< Number of wave directions [only used if WaveDirMod = 1] [Must be an odd number -- will be adjusted within the waves module] [(-)] + REAL(DbKi) :: WaveTMax = 0.0_R8Ki !< Analysis time for incident wave calculations; the actual analysis time may be larger than this value in order for the maintain an effecient FFT [(sec)] + END TYPE Waves_InitOutputType +! ======================= +CONTAINS + +subroutine Waves_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) + type(Waves_InitInputType), intent(in) :: SrcInitInputData + type(Waves_InitInputType), intent(inout) :: DstInitInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Waves_CopyInitInput' + ErrStat = ErrID_None + ErrMsg = '' + DstInitInputData%InputFile = SrcInitInputData%InputFile + DstInitInputData%DirRoot = SrcInitInputData%DirRoot + DstInitInputData%WvKinFile = SrcInitInputData%WvKinFile + DstInitInputData%Gravity = SrcInitInputData%Gravity + DstInitInputData%nGrid = SrcInitInputData%nGrid + DstInitInputData%WaveNDir = SrcInitInputData%WaveNDir + DstInitInputData%WaveDirSpread = SrcInitInputData%WaveDirSpread + DstInitInputData%WaveDirRange = SrcInitInputData%WaveDirRange + DstInitInputData%WaveDT = SrcInitInputData%WaveDT + DstInitInputData%WaveHs = SrcInitInputData%WaveHs + DstInitInputData%WaveNDAmp = SrcInitInputData%WaveNDAmp + DstInitInputData%WavePhase = SrcInitInputData%WavePhase + DstInitInputData%WavePkShp = SrcInitInputData%WavePkShp + DstInitInputData%WaveTMax = SrcInitInputData%WaveTMax + DstInitInputData%WaveTp = SrcInitInputData%WaveTp + DstInitInputData%NWaveElevGrid = SrcInitInputData%NWaveElevGrid + DstInitInputData%NWaveKinGrid = SrcInitInputData%NWaveKinGrid + if (allocated(SrcInitInputData%WaveKinGridxi)) then + LB(1:1) = lbound(SrcInitInputData%WaveKinGridxi) + UB(1:1) = ubound(SrcInitInputData%WaveKinGridxi) + if (.not. allocated(DstInitInputData%WaveKinGridxi)) then + allocate(DstInitInputData%WaveKinGridxi(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveKinGridxi.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%WaveKinGridxi = SrcInitInputData%WaveKinGridxi + end if + if (allocated(SrcInitInputData%WaveKinGridyi)) then + LB(1:1) = lbound(SrcInitInputData%WaveKinGridyi) + UB(1:1) = ubound(SrcInitInputData%WaveKinGridyi) + if (.not. allocated(DstInitInputData%WaveKinGridyi)) then + allocate(DstInitInputData%WaveKinGridyi(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveKinGridyi.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%WaveKinGridyi = SrcInitInputData%WaveKinGridyi + end if + if (allocated(SrcInitInputData%WaveKinGridzi)) then + LB(1:1) = lbound(SrcInitInputData%WaveKinGridzi) + UB(1:1) = ubound(SrcInitInputData%WaveKinGridzi) + if (.not. allocated(DstInitInputData%WaveKinGridzi)) then + allocate(DstInitInputData%WaveKinGridzi(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveKinGridzi.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%WaveKinGridzi = SrcInitInputData%WaveKinGridzi + end if + if (allocated(SrcInitInputData%CurrVxi)) then + LB(1:1) = lbound(SrcInitInputData%CurrVxi) + UB(1:1) = ubound(SrcInitInputData%CurrVxi) + if (.not. allocated(DstInitInputData%CurrVxi)) then + allocate(DstInitInputData%CurrVxi(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%CurrVxi.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%CurrVxi = SrcInitInputData%CurrVxi + end if + if (allocated(SrcInitInputData%CurrVyi)) then + LB(1:1) = lbound(SrcInitInputData%CurrVyi) + UB(1:1) = ubound(SrcInitInputData%CurrVyi) + if (.not. allocated(DstInitInputData%CurrVyi)) then + allocate(DstInitInputData%CurrVyi(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%CurrVyi.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%CurrVyi = SrcInitInputData%CurrVyi + end if + DstInitInputData%PCurrVxiPz0 = SrcInitInputData%PCurrVxiPz0 + DstInitInputData%PCurrVyiPz0 = SrcInitInputData%PCurrVyiPz0 + call NWTC_Library_CopyNWTC_RandomNumber_ParameterType(SrcInitInputData%RNG, DstInitInputData%RNG, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstInitInputData%ConstWaveMod = SrcInitInputData%ConstWaveMod + DstInitInputData%CrestHmax = SrcInitInputData%CrestHmax + DstInitInputData%CrestTime = SrcInitInputData%CrestTime + DstInitInputData%CrestXi = SrcInitInputData%CrestXi + DstInitInputData%CrestYi = SrcInitInputData%CrestYi + DstInitInputData%WaveFieldMod = SrcInitInputData%WaveFieldMod + DstInitInputData%PtfmLocationX = SrcInitInputData%PtfmLocationX + DstInitInputData%PtfmLocationY = SrcInitInputData%PtfmLocationY +end subroutine + +subroutine Waves_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(Waves_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Waves_DestroyInitInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InitInputData%WaveKinGridxi)) then + deallocate(InitInputData%WaveKinGridxi) + end if + if (allocated(InitInputData%WaveKinGridyi)) then + deallocate(InitInputData%WaveKinGridyi) + end if + if (allocated(InitInputData%WaveKinGridzi)) then + deallocate(InitInputData%WaveKinGridzi) + end if + if (allocated(InitInputData%CurrVxi)) then + deallocate(InitInputData%CurrVxi) + end if + if (allocated(InitInputData%CurrVyi)) then + deallocate(InitInputData%CurrVyi) + end if + call NWTC_Library_DestroyNWTC_RandomNumber_ParameterType(InitInputData%RNG, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine Waves_PackInitInput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Waves_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Waves_PackInitInput' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%InputFile) + call RegPack(RF, InData%DirRoot) + call RegPack(RF, InData%WvKinFile) + call RegPack(RF, InData%Gravity) + call RegPack(RF, InData%nGrid) + call RegPack(RF, InData%WaveNDir) + call RegPack(RF, InData%WaveDirSpread) + call RegPack(RF, InData%WaveDirRange) + call RegPack(RF, InData%WaveDT) + call RegPack(RF, InData%WaveHs) + call RegPack(RF, InData%WaveNDAmp) + call RegPack(RF, InData%WavePhase) + call RegPack(RF, InData%WavePkShp) + call RegPack(RF, InData%WaveTMax) + call RegPack(RF, InData%WaveTp) + call RegPack(RF, InData%NWaveElevGrid) + call RegPack(RF, InData%NWaveKinGrid) + call RegPackAlloc(RF, InData%WaveKinGridxi) + call RegPackAlloc(RF, InData%WaveKinGridyi) + call RegPackAlloc(RF, InData%WaveKinGridzi) + call RegPackAlloc(RF, InData%CurrVxi) + call RegPackAlloc(RF, InData%CurrVyi) + call RegPack(RF, InData%PCurrVxiPz0) + call RegPack(RF, InData%PCurrVyiPz0) + call NWTC_Library_PackNWTC_RandomNumber_ParameterType(RF, InData%RNG) + call RegPack(RF, InData%ConstWaveMod) + call RegPack(RF, InData%CrestHmax) + call RegPack(RF, InData%CrestTime) + call RegPack(RF, InData%CrestXi) + call RegPack(RF, InData%CrestYi) + call RegPack(RF, InData%WaveFieldMod) + call RegPack(RF, InData%PtfmLocationX) + call RegPack(RF, InData%PtfmLocationY) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Waves_UnPackInitInput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Waves_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Waves_UnPackInitInput' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%InputFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DirRoot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WvKinFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Gravity); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nGrid); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WaveNDir); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WaveDirSpread); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WaveDirRange); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WaveDT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WaveHs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WaveNDAmp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WavePhase); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WavePkShp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WaveTMax); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WaveTp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NWaveElevGrid); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NWaveKinGrid); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WaveKinGridxi); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WaveKinGridyi); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WaveKinGridzi); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%CurrVxi); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%CurrVyi); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PCurrVxiPz0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PCurrVyiPz0); if (RegCheckErr(RF, RoutineName)) return + call NWTC_Library_UnpackNWTC_RandomNumber_ParameterType(RF, OutData%RNG) ! RNG + call RegUnpack(RF, OutData%ConstWaveMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CrestHmax); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CrestTime); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CrestXi); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CrestYi); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WaveFieldMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PtfmLocationX); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PtfmLocationY); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Waves_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) + type(Waves_InitOutputType), intent(in) :: SrcInitOutputData + type(Waves_InitOutputType), intent(inout) :: DstInitOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Waves_CopyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + DstInitOutputData%WaveNDir = SrcInitOutputData%WaveNDir + DstInitOutputData%WaveTMax = SrcInitOutputData%WaveTMax +end subroutine + +subroutine Waves_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(Waves_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Waves_DestroyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine Waves_PackInitOutput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Waves_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Waves_PackInitOutput' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%WaveNDir) + call RegPack(RF, InData%WaveTMax) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Waves_UnPackInitOutput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Waves_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Waves_UnPackInitOutput' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%WaveNDir); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WaveTMax); if (RegCheckErr(RF, RoutineName)) return +end subroutine +END MODULE Waves_Types +!ENDOFREGISTRYGENERATEDFILE diff --git a/modules/servodyn/CMakeLists.txt b/modules/servodyn/CMakeLists.txt index 361e3eb712..a4fe70175d 100644 --- a/modules/servodyn/CMakeLists.txt +++ b/modules/servodyn/CMakeLists.txt @@ -32,7 +32,9 @@ set(SERVODYN_SRCS src/ServoDyn_Types.f90 ) -add_library(servodynlib ${SERVODYN_SRCS}) +add_library(servodynlib STATIC + ${SERVODYN_SRCS} +) target_link_libraries(servodynlib nwtclibs) # Driver diff --git a/modules/servodyn/src/ServoDyn.f90 b/modules/servodyn/src/ServoDyn.f90 index 7fa4b05678..6866cd3241 100644 --- a/modules/servodyn/src/ServoDyn.f90 +++ b/modules/servodyn/src/ServoDyn.f90 @@ -3324,7 +3324,7 @@ subroutine SrvD_Perturb_u( p, n, perturb_sign, u, du ) case (13) ! TranslationDisp = 1; u%TStCMotionMesh(instance)%TranslationDisp(fieldIndx,1) = u%TStCMotionMesh(instance)%TranslationDisp(fieldIndx,1) + du * perturb_sign case (14) ! Orientation = 2; - CALL PerturbOrientationMatrix( u%TStCMotionMesh(instance)%Orientation(:,:,1), du * perturb_sign, fieldIndx, UseSmlAngle=.true. ) + CALL PerturbOrientationMatrix( u%TStCMotionMesh(instance)%Orientation(:,:,1), du * perturb_sign, fieldIndx, UseSmlAngle=.false. ) case (15) ! TranslationVel = 3; u%TStCMotionMesh(instance)%TranslationVel( fieldIndx,1) = u%TStCMotionMesh(instance)%TranslationVel( fieldIndx,1) + du * perturb_sign case (16) ! RotationVel = 4; @@ -3338,7 +3338,7 @@ subroutine SrvD_Perturb_u( p, n, perturb_sign, u, du ) case (19) ! TranslationDisp = 1; u%SStCMotionMesh(instance)%TranslationDisp(fieldIndx,1) = u%SStCMotionMesh(instance)%TranslationDisp(fieldIndx,1) + du * perturb_sign case (20) ! Orientation = 2; - CALL PerturbOrientationMatrix( u%SStCMotionMesh(instance)%Orientation(:,:,1), du * perturb_sign, fieldIndx, UseSmlAngle=.true. ) + CALL PerturbOrientationMatrix( u%SStCMotionMesh(instance)%Orientation(:,:,1), du * perturb_sign, fieldIndx, UseSmlAngle=.false. ) case (21) ! TranslationVel = 3; u%SStCMotionMesh(instance)%TranslationVel( fieldIndx,1) = u%SStCMotionMesh(instance)%TranslationVel( fieldIndx,1) + du * perturb_sign case (22) ! RotationVel = 4; @@ -5201,6 +5201,10 @@ SUBROUTINE Yaw_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg - p%YawDamp*( u%YawRate - YawRateCom ) ! {-f(qd,q,t)}DampYaw; + ! Return the commands directly from the controller (used by SED module) + y%YawPosCom = YawPosCom + y%YawRateCom = YawRateCom + !................................................................... ! Apply trim case for linearization: ! prescribed yaw will be wrong in this case..... diff --git a/modules/servodyn/src/ServoDyn_Registry.txt b/modules/servodyn/src/ServoDyn_Registry.txt index 30013c593f..240fee5260 100644 --- a/modules/servodyn/src/ServoDyn_Registry.txt +++ b/modules/servodyn/src/ServoDyn_Registry.txt @@ -540,7 +540,7 @@ typedef ^ InputType ReKi LSShftFys - - - "Nonrotating low-speed shaft force y" N typedef ^ InputType ReKi LSShftFzs - - - "Nonrotating low-speed shaft force z" N 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" - +#typedef ^ InputType SiKi Lidar {:} - - "A swap array: used to pass input data to the DLL controller from the Lidar" - typedef ^ InputType MeshType PtfmMotionMesh - - - "Platform motion mesh at platform reference point" - typedef ^ InputType MeshType BStCMotionMesh {:}{:} - - "StC module blade input motion mesh" - typedef ^ InputType MeshType NStCMotionMesh {:} - - "StC module nacelle input motion mesh" - @@ -560,11 +560,13 @@ typedef ^ OutputType ReKi WriteOutput {:} - - "Data to be written to an output f 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 YawPosCom - - - "Yaw command from controller (for SED module)" rad +typedef ^ OutputType ReKi YawRateCom - - - "Yaw rate command from controller (for SED module)" rad/s 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 SiKi Lidar {:} - - "A swap array: used to pass output data from the DLL controller to the Lidar" - +#typedef ^ OutputType SiKi Lidar {:} - - "A swap array: used to pass output data from the DLL controller to the Lidar" - typedef ^ OutputType ReKi CableDeltaL {:} - - "Cable control -- Length change request (passed to MD or SD)" m typedef ^ OutputType ReKi CableDeltaLdot {:} - - "Cable control -- Length change rate request (passed to MD or SD)" m/s typedef ^ OutputType MeshType BStCLoadMesh {:}{:} - - "StC module blade output load mesh (NumBl,NumBStC)" - diff --git a/modules/servodyn/src/ServoDyn_Types.f90 b/modules/servodyn/src/ServoDyn_Types.f90 index e070fe77d7..d8b6eb4b44 100644 --- a/modules/servodyn/src/ServoDyn_Types.f90 +++ b/modules/servodyn/src/ServoDyn_Types.f90 @@ -38,51 +38,51 @@ MODULE ServoDyn_Types 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 [-] + INTEGER(IntKi) :: NumBl = 0_IntKi !< 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) :: NacRefPos !< nacelle origin for setting up mesh [m] - REAL(R8Ki) , DIMENSION(1:3) :: NacTransDisp !< nacelle displacement from origin at init for setting up mesh [m] - REAL(R8Ki) , DIMENSION(1:3,1:3) :: NacOrient !< nacelle orientation for setting up mesh [-] - REAL(R8Ki) , DIMENSION(1:3,1:3) :: NacRefOrient !< nacelle reference orientation for setting up mesh [-] - REAL(ReKi) , DIMENSION(1:3) :: TwrBaseRefPos !< tower base origin for setting up mesh [m] - REAL(R8Ki) , DIMENSION(1:3) :: TwrBaseTransDisp !< tower base translation from origin at init for setting up mesh [m] - REAL(R8Ki) , DIMENSION(1:3,1:3) :: TwrBaseOrient !< tower base orientation for setting up mesh [m] - REAL(R8Ki) , DIMENSION(1:3,1:3) :: TwrBaseRefOrient !< tower reference orientation for setting up mesh [m] - REAL(ReKi) , DIMENSION(1:3) :: PtfmRefPos !< platform origin for setting up mesh [m] - REAL(R8Ki) , DIMENSION(1:3) :: PtfmTransDisp !< platform displacement from origin for setting up mesh [m] - REAL(R8Ki) , DIMENSION(1:3,1:3) :: PtfmOrient !< platform orientation for setting up mesh [m] - REAL(R8Ki) , DIMENSION(1:3,1:3) :: PtfmRefOrient !< platform reference 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(1:3) :: Gravity = 0.0_ReKi !< Gravitational acceleration vector [m/s^2] + REAL(ReKi) , DIMENSION(1:3) :: NacRefPos = 0.0_ReKi !< nacelle origin for setting up mesh [m] + REAL(R8Ki) , DIMENSION(1:3) :: NacTransDisp = 0.0_R8Ki !< nacelle displacement from origin at init for setting up mesh [m] + REAL(R8Ki) , DIMENSION(1:3,1:3) :: NacOrient = 0.0_R8Ki !< nacelle orientation for setting up mesh [-] + REAL(R8Ki) , DIMENSION(1:3,1:3) :: NacRefOrient = 0.0_R8Ki !< nacelle reference orientation for setting up mesh [-] + REAL(ReKi) , DIMENSION(1:3) :: TwrBaseRefPos = 0.0_ReKi !< tower base origin for setting up mesh [m] + REAL(R8Ki) , DIMENSION(1:3) :: TwrBaseTransDisp = 0.0_R8Ki !< tower base translation from origin at init for setting up mesh [m] + REAL(R8Ki) , DIMENSION(1:3,1:3) :: TwrBaseOrient = 0.0_R8Ki !< tower base orientation for setting up mesh [m] + REAL(R8Ki) , DIMENSION(1:3,1:3) :: TwrBaseRefOrient = 0.0_R8Ki !< tower reference orientation for setting up mesh [m] + REAL(ReKi) , DIMENSION(1:3) :: PtfmRefPos = 0.0_ReKi !< platform origin for setting up mesh [m] + REAL(R8Ki) , DIMENSION(1:3) :: PtfmTransDisp = 0.0_R8Ki !< platform displacement from origin for setting up mesh [m] + REAL(R8Ki) , DIMENSION(1:3,1:3) :: PtfmOrient = 0.0_R8Ki !< platform orientation for setting up mesh [m] + REAL(R8Ki) , DIMENSION(1:3,1:3) :: PtfmRefOrient = 0.0_R8Ki !< platform reference orientation for setting up mesh [m] + REAL(DbKi) :: Tmax = 0.0_R8Ki !< max time from glue code [s] + REAL(ReKi) :: AvgWindSpeed = 0.0_ReKi !< average wind speed for the simulation [m/s] + REAL(ReKi) :: AirDens = 0.0_ReKi !< air density [kg/m^3] + INTEGER(IntKi) :: NumSC2CtrlGlob = 0_IntKi !< number of global controller inputs [from supercontroller] [-] + INTEGER(IntKi) :: NumSC2Ctrl = 0_IntKi !< number of turbine specific controller inputs [from supercontroller] [-] + INTEGER(IntKi) :: NumCtrl2SC = 0_IntKi !< number of controller outputs [to supercontroller] [-] + INTEGER(IntKi) :: TrimCase = 0_IntKi !< Controller parameter to be trimmed {1:yaw; 2:torque; 3:pitch} [used only if CalcSteady=True] [-] + REAL(ReKi) :: TrimGain = 0.0_ReKi !< 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 = 0.0_ReKi !< Reference rotor speed [rad/s] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BladeRootRefPos !< X-Y-Z reference position of each blade root (3 x NumBlades) [m] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: BladeRootTransDisp !< X-Y-Z translation from reference position at init of each blade root (3 x NumBlades) [m] REAL(R8Ki) , DIMENSION(:,:,:), ALLOCATABLE :: BladeRootOrient !< DCM reference orientation of blade roots (3x3 x NumBlades) [-] REAL(R8Ki) , DIMENSION(:,:,:), ALLOCATABLE :: BladeRootRefOrient !< 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) [-] - INTEGER(IntKi) :: NumCableControl !< Number of cable control channels requested [-] + INTEGER(IntKi) :: NumCableControl = 0_IntKi !< Number of cable control channels requested [-] CHARACTER(64) , DIMENSION(:), ALLOCATABLE :: CableControlRequestor !< Array with text info about which module requested the cable control channel (size of NumCableControl). This is just for diagnostics. [-] - INTEGER(IntKi) :: InterpOrder !< Interpolation order from glue code -- required to set m%u_xStC sizes [-] + INTEGER(IntKi) :: InterpOrder = 0_IntKi !< Interpolation order from glue code -- required to set m%u_xStC sizes [-] 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] [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: LidSpeed !< Number of Lidar measurement distances [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: MsrPositionsX !< Lidar X direction measurement points [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: MsrPositionsY !< Lidar Y direction measurement points [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: MsrPositionsZ !< Lidar Z direction measurement points [m] - INTEGER(IntKi) :: SensorType !< Lidar sensor type [-] - INTEGER(IntKi) :: NumBeam !< Number of beams [-] - INTEGER(IntKi) :: NumPulseGate !< Number of pulse gates [-] - REAL(ReKi) :: PulseSpacing !< Distance between range gates [-] - REAL(ReKi) :: URefLid !< Reference average wind speed for the lidar [m/s] + INTEGER(IntKi) :: SensorType = 0_IntKi !< Lidar sensor type [-] + INTEGER(IntKi) :: NumBeam = 0_IntKi !< Number of beams [-] + INTEGER(IntKi) :: NumPulseGate = 0_IntKi !< Number of pulse gates [-] + REAL(ReKi) :: PulseSpacing = 0.0_ReKi !< Distance between range gates [-] + REAL(ReKi) :: URefLid = 0.0_ReKi !< Reference average wind speed for the lidar [m/s] END TYPE SrvD_InitInputType ! ======================= ! ========= SrvD_InitOutputType ======= @@ -90,8 +90,8 @@ MODULE ServoDyn_Types 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) [-] + INTEGER(IntKi) :: CouplingScheme = 0_IntKi !< Switch that indicates if a particular coupling scheme is required [-] + LOGICAL :: UseHSSBrake = .false. !< 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_x !< Names of the states used in linearization [-] CHARACTER(LinChanLen) , DIMENSION(:), ALLOCATABLE :: LinNames_u !< Names of the inputs used in linearization [-] @@ -104,178 +104,178 @@ MODULE ServoDyn_Types ! ======================= ! ========= 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? [-] + REAL(DbKi) :: DT = 0.0_R8Ki !< Communication interval for controllers [s] + LOGICAL :: Echo = .false. !< Echo the input file out [-] + INTEGER(IntKi) :: PCMode = 0_IntKi !< Pitch control mode [-] + REAL(DbKi) :: TPCOn = 0.0_R8Ki !< Time to enable active pitch control [unused when PCMode=0] [s] + REAL(DbKi) , DIMENSION(1:3) :: TPitManS = 0.0_R8Ki !< Time to start override pitch maneuver for blade (K) and end standard pitch control [s] + REAL(ReKi) , DIMENSION(1:3) :: PitManRat = 0.0_ReKi !< Pitch rates at which override pitch maneuvers head toward final pitch angles [rad/s] + REAL(ReKi) , DIMENSION(1:3) :: BlPitchF = 0.0_ReKi !< Blade (K) final pitch for pitch maneuvers [radians] + INTEGER(IntKi) :: VSContrl = 0_IntKi !< Variable-speed control mode [-] + INTEGER(IntKi) :: GenModel = 0_IntKi !< Generator model [used only when VSContrl=0] [-] + REAL(ReKi) :: GenEff = 0.0_ReKi !< Generator efficiency [ignored by the Thevenin and user-defined generator models] [-] + LOGICAL :: GenTiStr = .false. !< Method to start the generator {T: timed using TimGenOn, F: generator speed using SpdGenOn} [-] + LOGICAL :: GenTiStp = .false. !< Method to stop the generator {T: timed using TimGenOf, F: when generator power = 0} [-] + REAL(ReKi) :: SpdGenOn = 0.0_ReKi !< Generator speed to turn on the generator for a startup (HSS speed) [used only when GenTiStr=False] [rad/s] + REAL(DbKi) :: TimGenOn = 0.0_R8Ki !< Time to turn on the generator for a startup [used only when GenTiStr=True] [s] + REAL(DbKi) :: TimGenOf = 0.0_R8Ki !< Time to turn off the generator [used only when GenTiStp=True] [s] + REAL(ReKi) :: VS_RtGnSp = 0.0_ReKi !< Rated generator speed for simple variable-speed generator control (HSS side) [used only when VSContrl=1] [rad/s] + REAL(ReKi) :: VS_RtTq = 0.0_ReKi !< 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 = 0.0_ReKi !< 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 = 0.0_ReKi !< Rated generator slip percentage in Region 2 1/2 for simple variable-speed generator control [used only when VSContrl=1] [-] + REAL(ReKi) :: SIG_SlPc = 0.0_ReKi !< Rated generator slip percentage [used only when VSContrl=0 and GenModel=1] [-] + REAL(ReKi) :: SIG_SySp = 0.0_ReKi !< Synchronous (zero-torque) generator speed [used only when VSContrl=0 and GenModel=1] [rad/s] + REAL(ReKi) :: SIG_RtTq = 0.0_ReKi !< Rated torque [used only when VSContrl=0 and GenModel=1] [N-m] + REAL(ReKi) :: SIG_PORt = 0.0_ReKi !< Pull-out ratio (Tpullout/Trated) [used only when VSContrl=0 and GenModel=1] [-] + REAL(ReKi) :: TEC_Freq = 0.0_ReKi !< Line frequency [50 or 60] [used only when VSContrl=0 and GenModel=2] [Hz] + INTEGER(IntKi) :: TEC_NPol = 0_IntKi !< Number of poles [even integer > 0] [used only when VSContrl=0 and GenModel=2] [-] + REAL(ReKi) :: TEC_SRes = 0.0_ReKi !< Stator resistance [used only when VSContrl=0 and GenModel=2] [ohms] + REAL(ReKi) :: TEC_RRes = 0.0_ReKi !< Rotor resistance [used only when VSContrl=0 and GenModel=2] [ohms] + REAL(ReKi) :: TEC_VLL = 0.0_ReKi !< Line-to-line RMS voltage [used only when VSContrl=0 and GenModel=2] [volts] + REAL(ReKi) :: TEC_SLR = 0.0_ReKi !< Stator leakage reactance [used only when VSContrl=0 and GenModel=2] [ohms] + REAL(ReKi) :: TEC_RLR = 0.0_ReKi !< Rotor leakage reactance [used only when VSContrl=0 and GenModel=2] [ohms] + REAL(ReKi) :: TEC_MR = 0.0_ReKi !< Magnetizing reactance [used only when VSContrl=0 and GenModel=2] [ohms] + INTEGER(IntKi) :: HSSBrMode = 0_IntKi !< HSS brake model [-] + REAL(DbKi) :: THSSBrDp = 0.0_R8Ki !< Time to initiate deployment of the HSS brake [s] + REAL(DbKi) :: HSSBrDT = 0.0_R8Ki !< Time for HSS-brake to reach full deployment once initiated [used only when HSSBrMode=1] [s] + REAL(ReKi) :: HSSBrTqF = 0.0_ReKi !< Fully deployed HSS-brake torque [N-m] + INTEGER(IntKi) :: YCMode = 0_IntKi !< Yaw control mode [-] + REAL(DbKi) :: TYCOn = 0.0_R8Ki !< Time to enable active yaw control [unused when YCMode=0] [s] + REAL(ReKi) :: YawNeut = 0.0_ReKi !< Neutral yaw position--yaw spring force is zero at this yaw [radians] + REAL(ReKi) :: YawSpr = 0.0_ReKi !< Nacelle-yaw spring constant [N-m/rad] + REAL(ReKi) :: YawDamp = 0.0_ReKi !< Nacelle-yaw constant [N-m/(rad/s)] + REAL(DbKi) :: TYawManS = 0.0_R8Ki !< Time to start override yaw maneuver and end standard yaw control [s] + REAL(ReKi) :: YawManRat = 0.0_ReKi !< Yaw maneuver rate (in absolute value) [rad/s] + REAL(ReKi) :: NacYawF = 0.0_ReKi !< Final yaw angle for override yaw maneuvers [radians] + LOGICAL :: SumPrint = .false. !< Print summary data to .sum [-] + INTEGER(IntKi) :: OutFile = 0_IntKi !< 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 = .false. !< 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) [-] + REAL(DbKi) :: Tstart = 0.0_R8Ki !< Time to start module's tabular output [s] + INTEGER(IntKi) :: NumOuts = 0_IntKi !< 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(DbKi) :: DLL_DT = 0.0_R8Ki !< interval for calling DLL (must be integer multiple number of DT steps) [s] + LOGICAL :: DLL_Ramp = .false. !< 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 = 0.0_ReKi !< The cutoff frequency for the blade pitch low-pass filter. Large values => no filter. [Hz] + REAL(ReKi) :: NacYaw_North = 0.0_ReKi !< Reference yaw angle of the nacelle when the upwind end points due North [used only with DLL Interface] [radians] + INTEGER(IntKi) :: Ptch_Cntrl = 0_IntKi !< Record 28: Use individual pitch control {0: collective pitch; 1: individual pitch control} [used only with DLL Interface] [-] + REAL(ReKi) :: Ptch_SetPnt = 0.0_ReKi !< Record 5: Below-rated pitch angle set-point [used only with DLL Interface] [radians] + REAL(ReKi) :: Ptch_Min = 0.0_ReKi !< Record 6: Minimum pitch angle [used only with DLL Interface] [radians] + REAL(ReKi) :: Ptch_Max = 0.0_ReKi !< Record 7: Maximum pitch angle [used only with DLL Interface] [radians] + REAL(ReKi) :: PtchRate_Min = 0.0_ReKi !< Record 8: Minimum pitch rate (most negative value allowed) [used only with DLL Interface] [rad/s] + REAL(ReKi) :: PtchRate_Max = 0.0_ReKi !< Record 9: Maximum pitch rate [used only with DLL Interface] [rad/s] + REAL(ReKi) :: Gain_OM = 0.0_ReKi !< Record 16: Optimal mode gain [used only with DLL Interface] [Nm/(rad/s)^2] + REAL(ReKi) :: GenSpd_MinOM = 0.0_ReKi !< Record 17: Minimum generator speed [used only with DLL Interface] [rad/s] + REAL(ReKi) :: GenSpd_MaxOM = 0.0_ReKi !< Record 18: Optimal mode maximum speed [used only with DLL Interface] [rad/s] + REAL(ReKi) :: GenSpd_Dem = 0.0_ReKi !< Record 19: Demanded generator speed above rated [used only with DLL Interface] [rad/s] + REAL(ReKi) :: GenTrq_Dem = 0.0_ReKi !< Record 22: Demanded generator torque above rated [used only with DLL Interface] [Nm] + REAL(ReKi) :: GenPwr_Dem = 0.0_ReKi !< Record 13: Demanded power [used only with DLL Interface] [W] + INTEGER(IntKi) :: DLL_NumTrq = 0_IntKi !< 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) [-] + LOGICAL :: UseLegacyInterface = .false. !< Flag that determines if the legacy Bladed interface is (legacy=DISCON with avrSWAP instead of CONTROLLER) [-] + INTEGER(IntKi) :: NumBStC = 0_IntKi !< 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) [-] + INTEGER(IntKi) :: NumNStC = 0_IntKi !< 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) [-] + INTEGER(IntKi) :: NumTStC = 0_IntKi !< 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) [-] + INTEGER(IntKi) :: NumSStC = 0_IntKi !< 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] [-] - INTEGER(IntKi) :: AfCmode !< Airfoil control mode {0: none, 1: sine wave cycle, 4: user-defined from Simulink/Labview, 5: user-defined from Bladed-style DLL} [-] - REAL(ReKi) :: AfC_Mean !< Mean level for cosine cycling or steady value [used only with AfCmode==1] [-] - REAL(ReKi) :: AfC_Amp !< Amplitude for for cosine cycling of flap signal (-) [used only with AfCmode==1] [-] - REAL(ReKi) :: AfC_Phase !< Phase relative to the blade azimuth (0 is vertical) for for cosine cycling of flap signal (deg) [used only with AfCmode==1] [deg] - INTEGER(IntKi) :: CCmode !< Cable control control mode {0: none, 4: user-defined from Simulink/Labview, 5: user-defined from Bladed-style DLL} [-] - LOGICAL :: EXavrSWAP !< Use extendend AVR swap [-] + INTEGER(IntKi) :: AfCmode = 0_IntKi !< Airfoil control mode {0: none, 1: sine wave cycle, 4: user-defined from Simulink/Labview, 5: user-defined from Bladed-style DLL} [-] + REAL(ReKi) :: AfC_Mean = 0.0_ReKi !< Mean level for cosine cycling or steady value [used only with AfCmode==1] [-] + REAL(ReKi) :: AfC_Amp = 0.0_ReKi !< Amplitude for for cosine cycling of flap signal (-) [used only with AfCmode==1] [-] + REAL(ReKi) :: AfC_Phase = 0.0_ReKi !< Phase relative to the blade azimuth (0 is vertical) for for cosine cycling of flap signal (deg) [used only with AfCmode==1] [deg] + INTEGER(IntKi) :: CCmode = 0_IntKi !< Cable control control mode {0: none, 4: user-defined from Simulink/Labview, 5: user-defined from Bladed-style DLL} [-] + LOGICAL :: EXavrSWAP = .false. !< Use extendend AVR swap [-] 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) , DIMENSION(1:3) :: PrevBlAirfoilCom !< Previously 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(ReKi) :: HSSBrTrqDemand = 0.0_ReKi !< Demanded braking torque - from Bladed DLL [-] + REAL(ReKi) :: YawRateCom = 0.0_ReKi !< Nacelle yaw rate demanded from Bladed DLL [rad/s] + REAL(ReKi) :: GenTrq = 0.0_ReKi !< Electrical generator torque from Bladed DLL [N-m] + INTEGER(IntKi) :: GenState = 0_IntKi !< Generator state from Bladed DLL [-] + REAL(ReKi) , DIMENSION(1:3) :: BlPitchCom = 0.0_ReKi !< Commanded blade pitch angles [radians] + REAL(ReKi) , DIMENSION(1:3) :: PrevBlPitch = 0.0_ReKi !< Previously commanded blade pitch angles [radians] + REAL(ReKi) , DIMENSION(1:3) :: BlAirfoilCom = 0.0_ReKi !< Commanded Airfoil UserProp for blade. Passed to AD15 for airfoil interpolation (must be same units as given in AD15 airfoil tables) [-] + REAL(ReKi) , DIMENSION(1:3) :: PrevBlAirfoilCom = 0.0_ReKi !< Previously 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 = 0.0_ReKi !< Electrical power (from previous step), sent to Bladed DLL [W] + REAL(ReKi) :: GenTrq_prev = 0.0_ReKi !< 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 [-] + LOGICAL :: initialized = .false. !< flag that determines if DLL has been called (for difference between CalcOutput and UpdateStates) [-] + INTEGER(IntKi) :: NumLogChannels = 0_IntKi !< 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 [-] + INTEGER(IntKi) :: ErrStat = 0_IntKi !< 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(R8Ki) :: CurrentTime = 0.0_R8Ki !< Current Simulation Time [s] + INTEGER(IntKi) :: SimStatus = 0_IntKi !< 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 = 0_IntKi !< 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 = .false. !< Whether the HSS brake has been deployed [-] + REAL(R8Ki) :: TimeHSSBrFullyDeployed = 0.0_R8Ki !< Time at which the controller high-speed shaft is fully deployed [s] + REAL(R8Ki) :: TimeHSSBrDeployed = 0.0_R8Ki !< Time at which the controller high-speed shaft is first deployed [s] + LOGICAL :: OverrideYawRateWithTorque = .false. !< acts similiar to Yaw_Cntrl [-] + REAL(ReKi) :: YawTorqueDemand = 0.0_ReKi !< 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(ReKi) :: LSShftFxa !< Rotating low-speed shaft force x [N] - REAL(ReKi) :: LSShftFys !< Nonrotating low-speed shaft force y [N] - REAL(ReKi) :: LSShftFzs !< Nonrotating low-speed shaft force z [N] + REAL(ReKi) :: YawAngleFromNorth = 0.0_ReKi !< Yaw angle of the nacelle relative to North (see NacYaw_North) [rad] + REAL(ReKi) :: HorWindV = 0.0_ReKi !< Horizontal hub-height wind velocity magnitude [m/s] + REAL(ReKi) :: HSS_Spd = 0.0_ReKi !< High-speed shaft (HSS) speed [rad/s] + REAL(ReKi) :: YawErr = 0.0_ReKi !< Yaw error [radians] + REAL(ReKi) :: RotSpeed = 0.0_ReKi !< Rotor azimuth angular speed [rad/s] + REAL(ReKi) :: YawBrTAxp = 0.0_ReKi !< Tower-top / yaw bearing fore-aft (translational) acceleration (absolute) [m/s^2] + REAL(ReKi) :: YawBrTAyp = 0.0_ReKi !< Tower-top / yaw bearing side-to-side (translational) acceleration (absolute) [m/s^2] + REAL(ReKi) :: LSSTipMys = 0.0_ReKi !< 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 = 0.0_ReKi !< 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 = 0.0_ReKi !< 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 = 0.0_ReKi !< 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 = 0.0_ReKi !< Rotor azimuth angle (position) [radians] + REAL(ReKi) :: Yaw = 0.0_ReKi !< Current nacelle yaw [radians] + REAL(ReKi) :: YawRate = 0.0_ReKi !< Current nacelle yaw rate [rad/s] + REAL(ReKi) :: YawBrMyn = 0.0_ReKi !< Rotating (with nacelle) tower-top / yaw bearing pitch moment [N-m] + REAL(ReKi) :: YawBrMzn = 0.0_ReKi !< Tower-top / yaw bearing yaw moment [N-m] + REAL(ReKi) :: NcIMURAxs = 0.0_ReKi !< Nacelle inertial measurement unit angular (rotational) acceleration (absolute) [rad/s^2] + REAL(ReKi) :: NcIMURAys = 0.0_ReKi !< Nacelle inertial measurement unit angular (rotational) acceleration (absolute) [rad/s^2] + REAL(ReKi) :: NcIMURAzs = 0.0_ReKi !< Nacelle inertial measurement unit angular (rotational) acceleration (absolute) [rad/s^2] + REAL(ReKi) :: RotPwr = 0.0_ReKi !< Rotor power (this is equivalent to the low-speed shaft power) [W] + REAL(ReKi) :: LSSTipMxa = 0.0_ReKi !< 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 = 0.0_ReKi !< 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 = 0.0_ReKi !< In-plane moment (i.e., the moment caused by in-plane forces) at the blade root [N-m] + REAL(ReKi) :: LSShftFxa = 0.0_ReKi !< Rotating low-speed shaft force x [N] + REAL(ReKi) :: LSShftFys = 0.0_ReKi !< Nonrotating low-speed shaft force y [N] + REAL(ReKi) :: LSShftFzs = 0.0_ReKi !< Nonrotating low-speed shaft force z [N] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: LidSpeed !< Lidar measured wind speed [m/s] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: MsrPositionsX !< Lidar X direction measurement points [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: MsrPositionsY !< Lidar Y direction measurement points [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: MsrPositionsZ !< Lidar Z direction measurement points [m] - INTEGER(IntKi) :: SensorType !< Lidar sensor type [-] - INTEGER(IntKi) :: NumBeam !< Number of beams [-] - INTEGER(IntKi) :: NumPulseGate !< Number of pulse gates [-] - INTEGER(IntKi) :: PulseSpacing !< Distance between range gates [-] - INTEGER(IntKi) :: URefLid !< Reference average wind speed for the lidar [m/s] - REAL(DbKi) :: DLL_DT !< interval for calling DLL (integer multiple number of DT) [s] + INTEGER(IntKi) :: SensorType = 0_IntKi !< Lidar sensor type [-] + INTEGER(IntKi) :: NumBeam = 0_IntKi !< Number of beams [-] + INTEGER(IntKi) :: NumPulseGate = 0_IntKi !< Number of pulse gates [-] + INTEGER(IntKi) :: PulseSpacing = 0_IntKi !< Distance between range gates [-] + INTEGER(IntKi) :: URefLid = 0_IntKi !< Reference average wind speed for the lidar [m/s] + REAL(DbKi) :: DLL_DT = 0.0_R8Ki !< 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) :: GenTrq_Dem = 0.0_ReKi !< Demanded generator torque above rated [Nm] + REAL(ReKi) :: GenSpd_Dem = 0.0_ReKi !< Demanded generator speed above rated [rad/s] + REAL(ReKi) :: Ptch_Max = 0.0_ReKi !< Maximum pitch angle [rad] + REAL(ReKi) :: Ptch_Min = 0.0_ReKi !< Minimum pitch angle [rad] + REAL(ReKi) :: Ptch_SetPnt = 0.0_ReKi !< Below-rated pitch angle set-point [rad] + REAL(ReKi) :: PtchRate_Max = 0.0_ReKi !< Maximum pitch rate [rad/s] + REAL(ReKi) :: PtchRate_Min = 0.0_ReKi !< Minimum pitch rate (most negative value allowed) [rad/s] + REAL(ReKi) :: GenPwr_Dem = 0.0_ReKi !< Demanded power (This is not valid for variable-speed, pitch-regulated controllers.) [W] + REAL(ReKi) :: Gain_OM = 0.0_ReKi !< Optimal mode gain [Nm/(rad/s)^2] + REAL(ReKi) :: GenSpd_MaxOM = 0.0_ReKi !< Optimal mode maximum speed [rad/s] + REAL(ReKi) :: GenSpd_MinOM = 0.0_ReKi !< Minimum generator speed [rad/s] + INTEGER(IntKi) :: Ptch_Cntrl = 0_IntKi !< Pitch control: 0 = collective; 1 = individual [-] + INTEGER(IntKi) :: DLL_NumTrq = 0_IntKi !< 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 [-] + INTEGER(IntKi) :: Yaw_Cntrl = 0_IntKi !< Yaw control: 0 = rate; 1 = torque [-] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: PrevCableDeltaL !< Previous value for ramping for cable tensioning DeltaL using extended avrSWAP [see EXavrSWAP documentation in BladededInterface_EX] [m] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: PrevCableDeltaLdot !< Previous value for ramping for cable tensioning DeltaLdot using extended avrSWAP [see EXavrSWAP documentation in BladededInterface_EX] [m/s] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: CableDeltaL !< The swap array: used to pass data from the DLL controller for cable tensioning DeltaL using extended avrSWAP [see EXavrSWAP documentation in BladededInterface_EX] [m] @@ -294,7 +294,7 @@ MODULE ServoDyn_Types ! ======================= ! ========= SrvD_ContinuousStateType ======= TYPE, PUBLIC :: SrvD_ContinuousStateType - REAL(ReKi) :: DummyContState !< Remove this variable if you have continuous states [-] + REAL(ReKi) :: DummyContState = 0.0_ReKi !< 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 [-] @@ -303,7 +303,7 @@ MODULE ServoDyn_Types ! ======================= ! ========= SrvD_DiscreteStateType ======= TYPE, PUBLIC :: SrvD_DiscreteStateType - REAL(ReKi) :: CtrlOffset !< Controller offset parameter [N-m] + REAL(ReKi) :: CtrlOffset = 0.0_ReKi !< 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 [-] @@ -312,7 +312,7 @@ MODULE ServoDyn_Types ! ======================= ! ========= SrvD_ConstraintStateType ======= TYPE, PUBLIC :: SrvD_ConstraintStateType - REAL(ReKi) :: DummyConstrState !< Remove this variable if you have constraint states [-] + REAL(ReKi) :: DummyConstrState = 0.0_ReKi !< 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 [-] @@ -324,15 +324,15 @@ MODULE ServoDyn_Types 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 :: BegYawMan = .false. !< Whether the yaw maneuver actually began [-] + REAL(ReKi) :: NacYawI = 0.0_ReKi !< Initial yaw angle at the start of the override yaw maneuver [radians] + REAL(DbKi) :: TYawManE = 0.0_R8Ki !< Time to end override yaw maneuver [s] + REAL(ReKi) :: YawPosComInt = 0.0_ReKi !< 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? [-] + LOGICAL :: Off4Good = .false. !< Is the generator offline for rest of simulation? [-] + LOGICAL :: GenOnLine = .false. !< 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 [-] @@ -353,10 +353,10 @@ MODULE ServoDyn_Types ! ======================= ! ========= SrvD_MiscVarType ======= TYPE, PUBLIC :: SrvD_MiscVarType - REAL(DbKi) :: LastTimeCalled !< last time the CalcOutput/Bladed DLL was called [s] + REAL(DbKi) :: LastTimeCalled = 0.0_R8Ki !< 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] + LOGICAL :: FirstWarn = .false. !< Whether or not this is the first warning about the DLL being called without Explicit-Loose coupling. [-] + REAL(DbKi) :: LastTimeFiltered = 0.0_R8Ki !< 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 [-] @@ -376,113 +376,113 @@ MODULE ServoDyn_Types ! ======================= ! ========= 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(DbKi) :: DT = 0.0_R8Ki !< Time step for continuous state integration & discrete state update [seconds] + REAL(DbKi) :: HSSBrDT = 0.0_R8Ki !< Time it takes for HSS brake to reach full deployment once deployed [seconds] + REAL(ReKi) :: HSSBrTqF = 0.0_ReKi !< Fully deployed HSS brake torque [-] + REAL(ReKi) :: SIG_POSl = 0.0_ReKi !< Pullout slip [-] + REAL(ReKi) :: SIG_POTq = 0.0_ReKi !< Pullout torque [-] + REAL(ReKi) :: SIG_SlPc = 0.0_ReKi !< Rated generator slip percentage [-] + REAL(ReKi) :: SIG_Slop = 0.0_ReKi !< Torque/Speed slope for simple induction generator [-] + REAL(ReKi) :: SIG_SySp = 0.0_ReKi !< Synchronous (zero-torque) generator speed [rad/s] + REAL(ReKi) :: TEC_A0 = 0.0_ReKi !< A0 term for Thevenin-equivalent circuit [-] + REAL(ReKi) :: TEC_C0 = 0.0_ReKi !< C0 term for Thevenin-equivalent circuit [-] + REAL(ReKi) :: TEC_C1 = 0.0_ReKi !< C1 term for Thevenin-equivalent circuit [-] + REAL(ReKi) :: TEC_C2 = 0.0_ReKi !< C2 term for Thevenin-equivalent circuit [-] + REAL(ReKi) :: TEC_K2 = 0.0_ReKi !< K2 term for Thevenin-equivalent circuit [-] + REAL(ReKi) :: TEC_MR = 0.0_ReKi !< Magnetizing reactance for Thevenin-equivalent circuit [ohms] + REAL(ReKi) :: TEC_Re1 = 0.0_ReKi !< Thevenin's equivalent stator resistance (ohms) [ohms] + REAL(ReKi) :: TEC_RLR = 0.0_ReKi !< Rotor leakage reactance for Thevenin-equivalent circuit [-] + REAL(ReKi) :: TEC_RRes = 0.0_ReKi !< Rotor resistance for Thevenin-equivalent circuit [-] + REAL(ReKi) :: TEC_SRes = 0.0_ReKi !< Stator resistance for Thevenin-equivalent circuit [-] + REAL(ReKi) :: TEC_SySp = 0.0_ReKi !< Synchronous speed for Thevenin-equivalent circuit [-] + REAL(ReKi) :: TEC_V1a = 0.0_ReKi !< Source voltage for Thevenin-equivalent circuit [-] + REAL(ReKi) :: TEC_VLL = 0.0_ReKi !< Line-to-line RMS voltage for Thevenin-equivalent circuit [-] + REAL(ReKi) :: TEC_Xe1 = 0.0_ReKi !< Thevenin's equivalent stator leakage reactance (ohms) [ohms] + REAL(ReKi) :: GenEff = 0.0_ReKi !< 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(ReKi) :: YawManRat = 0.0_ReKi !< Yaw rate at which override yaw maneuver head toward for final yaw angle (does not include sign) [rad/s] + REAL(ReKi) :: NacYawF = 0.0_ReKi !< Final yaw angle after override yaw maneuver [-] + REAL(ReKi) :: SpdGenOn = 0.0_ReKi !< Generator speed to turn on the generator for a startup [-] + REAL(DbKi) :: THSSBrDp = 0.0_R8Ki !< Time to initiate deployment of the shaft brake [s] + REAL(DbKi) :: THSSBrFl = 0.0_R8Ki !< Time at which shaft brake is fully deployed [s] + REAL(DbKi) :: TimGenOf = 0.0_R8Ki !< Time to turn off generator for braking or modeling a run-away [s] + REAL(DbKi) :: TimGenOn = 0.0_R8Ki !< Time to turn on generator for startup [s] + REAL(DbKi) :: TPCOn = 0.0_R8Ki !< 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(DbKi) :: TYawManS = 0.0_R8Ki !< Time to start override yaw maneuver [s] + REAL(DbKi) :: TYCOn = 0.0_R8Ki !< Time to enable active yaw control [s] + REAL(ReKi) :: VS_RtGnSp = 0.0_ReKi !< Rated generator speed (HSS side) [rad/s] + REAL(ReKi) :: VS_RtTq = 0.0_ReKi !< Rated generator torque/constant generator torque in Region 3 (HSS side) [N-m] + REAL(ReKi) :: VS_Slope = 0.0_ReKi !< Torque/speed slope of region 2 1/2 induction generator [-] + REAL(ReKi) :: VS_SlPc = 0.0_ReKi !< Rated generator slip percentage in Region 2 1/2 [-] + REAL(ReKi) :: VS_SySp = 0.0_ReKi !< Synchronous speed of region 2 1/2 induction generator [-] + REAL(ReKi) :: VS_TrGnSp = 0.0_ReKi !< Transitional generator speed between regions 2 and 2 1/2 [-] + REAL(ReKi) :: YawPosCom = 0.0_ReKi !< Commanded yaw angle from user-defined routines [rad] + REAL(ReKi) :: YawRateCom = 0.0_ReKi !< Commanded yaw rate from user-defined routines [rad/s] + INTEGER(IntKi) :: GenModel = 0_IntKi !< Generator model [-] + INTEGER(IntKi) :: HSSBrMode = 0_IntKi !< HSS brake model [-] + INTEGER(IntKi) :: PCMode = 0_IntKi !< Pitch control mode [-] + INTEGER(IntKi) :: VSContrl = 0_IntKi !< Variable-speed-generator control switch [-] + INTEGER(IntKi) :: YCMode = 0_IntKi !< Yaw control mode [-] + LOGICAL :: GenTiStp = .false. !< Stop generator based upon T: time or F: generator power = 0 [-] + LOGICAL :: GenTiStr = .false. !< Start generator based upon T: time or F: generator speed [-] + REAL(ReKi) :: VS_Rgn2K = 0.0_ReKi !< 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 = 0.0_ReKi !< Neutral yaw position--yaw spring force is zero at this yaw [radians] + REAL(ReKi) :: YawSpr = 0.0_ReKi !< Nacelle-yaw spring constant [N-m/rad] + REAL(ReKi) :: YawDamp = 0.0_ReKi !< Nacelle-yaw constant [N-m/(rad/s)] + REAL(DbKi) :: TpBrDT = 0.0_R8Ki !< 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) :: AfCmode !< Airfoil control mode {0: none, 1: sine wave cycle, 4: user-defined from Simulink/Labview, 5: user-defined from Bladed-style DLL} [-] - REAL(ReKi) :: AfC_Mean !< Mean level for cosine cycling or steady value [used only with AfCmode==1] [-] - REAL(ReKi) :: AfC_Amp !< Amplitude for for cosine cycling of flap signal (-) [used only with AfCmode==1] [-] - REAL(ReKi) :: AfC_Phase !< Phase relative to the blade azimuth (0 is vertical) for for cosine cycling of flap signal (deg) [used only with AfCmode==1] [deg] - INTEGER(IntKi) :: CCmode !< Cable control control mode {0: none, 4: user-defined from Simulink/Labview, 5: user-defined from Bladed-style DLL} [-] - INTEGER(IntKi) :: StCCmode !< Structural control control mode {0: none, 4: user-defined from Simulink/Labview, 5: user-defined from Bladed-style DLL} [-] - 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) [-] + REAL(ReKi) :: TBDrConN = 0.0_ReKi !< Tip-brake drag constant during normal operation, Cd*Area [-] + REAL(ReKi) :: TBDrConD = 0.0_ReKi !< Tip-brake drag constant during fully-deployed operation, Cd*Area [-] + INTEGER(IntKi) :: NumBl = 0_IntKi !< Number of blades on the turbine [-] + INTEGER(IntKi) :: NumBStC = 0_IntKi !< Number of blade structural controllers (integer) [-] + INTEGER(IntKi) :: NumNStC = 0_IntKi !< Number of nacelle structural controllers (integer) [-] + INTEGER(IntKi) :: NumTStC = 0_IntKi !< Number of tower structural controllers (integer) [-] + INTEGER(IntKi) :: NumSStC = 0_IntKi !< Number of substructure structural controllers (integer) [-] + INTEGER(IntKi) :: AfCmode = 0_IntKi !< Airfoil control mode {0: none, 1: sine wave cycle, 4: user-defined from Simulink/Labview, 5: user-defined from Bladed-style DLL} [-] + REAL(ReKi) :: AfC_Mean = 0.0_ReKi !< Mean level for cosine cycling or steady value [used only with AfCmode==1] [-] + REAL(ReKi) :: AfC_Amp = 0.0_ReKi !< Amplitude for for cosine cycling of flap signal (-) [used only with AfCmode==1] [-] + REAL(ReKi) :: AfC_Phase = 0.0_ReKi !< Phase relative to the blade azimuth (0 is vertical) for for cosine cycling of flap signal (deg) [used only with AfCmode==1] [deg] + INTEGER(IntKi) :: CCmode = 0_IntKi !< Cable control control mode {0: none, 4: user-defined from Simulink/Labview, 5: user-defined from Bladed-style DLL} [-] + INTEGER(IntKi) :: StCCmode = 0_IntKi !< Structural control control mode {0: none, 4: user-defined from Simulink/Labview, 5: user-defined from Bladed-style DLL} [-] + INTEGER(IntKi) :: NumOuts = 0_IntKi !< Number of parameters in the output list (number of outputs requested) [-] + INTEGER(IntKi) :: NumOuts_DLL = 0_IntKi !< Number of logging channels output from the DLL (set at initialization) [-] CHARACTER(1024) :: RootName !< RootName for writing output files [-] CHARACTER(1024) :: PriPath !< Path of the primary SrvD input file [-] 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) [-] + LOGICAL :: UseBladedInterface = .false. !< Flag that determines if BladedInterface was used [-] + LOGICAL :: UseLegacyInterface = .false. !< 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] + LOGICAL :: DLL_Ramp = .false. !< determines if there is a DLL_DT-ramp time delay (true only when DLL_DT /= DT) [-] + REAL(ReKi) :: BlAlpha = 0.0_ReKi !< parameter for low-pass filter of blade pitch commands from the controller DLL [-] + INTEGER(IntKi) :: DLL_n = 0_IntKi !< number of steps between the controller being called and SrvD being called [-] + INTEGER(IntKi) :: avcOUTNAME_LEN = 0_IntKi !< Length of the avcOUTNAME character array passed to/from the DLL [-] + REAL(ReKi) :: NacYaw_North = 0.0_ReKi !< Reference yaw angle of the nacelle when the upwind end points due North [rad] + REAL(ReKi) :: AvgWindSpeed = 0.0_ReKi !< average wind speed for the simulation [m/s] + REAL(ReKi) :: AirDens = 0.0_ReKi !< air density [kg/m^3] + INTEGER(IntKi) :: TrimCase = 0_IntKi !< Controller parameter to be trimmed {1:yaw; 2:torque; 3:pitch} [used only if CalcSteady=True] [-] + REAL(ReKi) :: TrimGain = 0.0_ReKi !< 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 = 0.0_ReKi !< 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 [-] - INTEGER(IntKi) :: InterpOrder !< Interpolation order from glue code -- required to set m%u_xStC sizes [-] - LOGICAL :: EXavrSWAP !< Use extendend avr SWAP [-] - INTEGER(IntKi) :: NumCableControl !< Number of cable control channels requested [-] - INTEGER(IntKi) :: NumStC_Control !< Number of cable StC channels requested [-] + INTEGER(IntKi) :: InterpOrder = 0_IntKi !< Interpolation order from glue code -- required to set m%u_xStC sizes [-] + LOGICAL :: EXavrSWAP = .false. !< Use extendend avr SWAP [-] + INTEGER(IntKi) :: NumCableControl = 0_IntKi !< Number of cable control channels requested [-] + INTEGER(IntKi) :: NumStC_Control = 0_IntKi !< Number of cable StC channels requested [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: StCMeasNumPerChan !< Number of cable StC channel to average on each control channel sent to DLL [-] - LOGICAL :: UseSC !< Supercontroller on/off flag [-] + LOGICAL :: UseSC = .false. !< Supercontroller on/off flag [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: Jac_u_indx !< matrix to help fill/pack the u vector in computing the jacobian [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: Jac_x_indx !< matrix to help fill/pack the x vector in computing the jacobian [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: du !< vector that determines size of perturbation for u (inputs) [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: dx !< vector that determines size of perturbation for x (continuous states) [-] - INTEGER(IntKi) :: Jac_nu !< number of inputs in jacobian matrix [-] - INTEGER(IntKi) :: Jac_ny !< number of outputs in jacobian matrix [-] - INTEGER(IntKi) :: Jac_nx !< the number of continuous states in jacobian matrix [-] + INTEGER(IntKi) :: Jac_nu = 0_IntKi !< number of inputs in jacobian matrix [-] + INTEGER(IntKi) :: Jac_ny = 0_IntKi !< number of outputs in jacobian matrix [-] + INTEGER(IntKi) :: Jac_nx = 0_IntKi !< the number of continuous states in jacobian matrix [-] INTEGER(IntKi) , DIMENSION(:,:,:), ALLOCATABLE :: Jac_Idx_BStC_u !< the start and end indices of blade StC u jacobian [ start/end, blade, instance ] [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: Jac_Idx_NStC_u !< the start and end indices of nacelle StC u jacobian [ start/end, instance ] [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: Jac_Idx_TStC_u !< the start and end indices of tower StC u jacobian [ start/end, instance ] [-] @@ -495,57 +495,56 @@ MODULE ServoDyn_Types INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: Jac_Idx_NStC_y !< the start and end indices of nacelle StC y jacobian [ start/end, instance ] [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: Jac_Idx_TStC_y !< the start and end indices of tower StC y jacobian [ start/end, instance ] [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: Jac_Idx_SStC_y !< the start and end indices of substructure StC y jacobian [ start/end, instance ] [-] - INTEGER(IntKi) :: SensorType !< Lidar sensor type [-] - INTEGER(IntKi) :: NumBeam !< Number of beams [-] - INTEGER(IntKi) :: NumPulseGate !< Number of pulse gates [-] - REAL(ReKi) :: PulseSpacing !< Distance between range gates [m] - REAL(ReKi) :: URefLid !< Reference average wind speed for the lidar [m/s] + INTEGER(IntKi) :: SensorType = 0_IntKi !< Lidar sensor type [-] + INTEGER(IntKi) :: NumBeam = 0_IntKi !< Number of beams [-] + INTEGER(IntKi) :: NumPulseGate = 0_IntKi !< Number of pulse gates [-] + REAL(ReKi) :: PulseSpacing = 0.0_ReKi !< Distance between range gates [m] + REAL(ReKi) :: URefLid = 0.0_ReKi !< Reference average wind speed for the lidar [m/s] 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) :: Yaw = 0.0_ReKi !< Current nacelle yaw [radians] + REAL(ReKi) :: YawRate = 0.0_ReKi !< Current nacelle yaw rate [rad/s] + REAL(ReKi) :: LSS_Spd = 0.0_ReKi !< Low-speed shaft (LSS) speed at entrance to gearbox [rad/s] + REAL(ReKi) :: HSS_Spd = 0.0_ReKi !< High-speed shaft (HSS) speed [rad/s] + REAL(ReKi) :: RotSpeed = 0.0_ReKi !< Rotor azimuth angular speed [rad/s] + REAL(ReKi) :: ExternalYawPosCom = 0.0_ReKi !< Commanded nacelle yaw position from Simulink or Labview [radians] + REAL(ReKi) :: ExternalYawRateCom = 0.0_ReKi !< 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) :: ExternalGenTrq = 0.0_ReKi !< Electrical generator torque from Simulink or LabVIEW [N-m] + REAL(ReKi) :: ExternalElecPwr = 0.0_ReKi !< Electrical power from Simulink or LabVIEW [W] + REAL(ReKi) :: ExternalHSSBrFrac = 0.0_ReKi !< Fraction of full braking torque: 0 (off) <= HSSBrFrac <= 1 (full) from Simulink or LabVIEW [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: ExternalBlAirfoilCom !< Commanded Airfoil UserProp for blade. Passed to AD15 for airfoil interpolation (must be same units as given in AD15 airfoil tables) [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: ExternalCableDeltaL !< Commanded Cable controlo DeltaL [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: ExternalCableDeltaLdot !< Commanded Cable controlo DeltaLdot [m/s] - 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] - REAL(ReKi) :: LSShftFxa !< Rotating low-speed shaft force x [N] - REAL(ReKi) :: LSShftFys !< Nonrotating low-speed shaft force y [N] - REAL(ReKi) :: LSShftFzs !< Nonrotating low-speed shaft force z [N] + REAL(ReKi) :: TwrAccel = 0.0_ReKi !< Tower acceleration for tower feedback control (user routine only) [m/s^2] + REAL(ReKi) :: YawErr = 0.0_ReKi !< Yaw error [radians] + REAL(ReKi) :: WindDir = 0.0_ReKi !< Wind direction [radians] + REAL(ReKi) , DIMENSION(1:3) :: RootMyc = 0.0_ReKi !< 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 = 0.0_ReKi !< Tower-top / yaw bearing fore-aft (translational) acceleration (absolute) [m/s^2] + REAL(ReKi) :: YawBrTAyp = 0.0_ReKi !< Tower-top / yaw bearing side-to-side (translational) acceleration (absolute) [m/s^2] + REAL(ReKi) :: LSSTipPxa = 0.0_ReKi !< Rotor azimuth angle (position) [radians] + REAL(ReKi) , DIMENSION(1:3) :: RootMxc = 0.0_ReKi !< In-plane moment (i.e., the moment caused by in-plane forces) at the blade root [N-m] + REAL(ReKi) :: LSSTipMxa = 0.0_ReKi !< 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 = 0.0_ReKi !< 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 = 0.0_ReKi !< 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 = 0.0_ReKi !< 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 = 0.0_ReKi !< 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 = 0.0_ReKi !< Rotating (with nacelle) tower-top / yaw bearing pitch moment [N-m] + REAL(ReKi) :: YawBrMzn = 0.0_ReKi !< Tower-top / yaw bearing yaw moment [N-m] + REAL(ReKi) :: NcIMURAxs = 0.0_ReKi !< Nacelle inertial measurement unit angular (rotational) acceleration (absolute) [rad/s^2] + REAL(ReKi) :: NcIMURAys = 0.0_ReKi !< Nacelle inertial measurement unit angular (rotational) acceleration (absolute) [rad/s^2] + REAL(ReKi) :: NcIMURAzs = 0.0_ReKi !< Nacelle inertial measurement unit angular (rotational) acceleration (absolute) [rad/s^2] + REAL(ReKi) :: RotPwr = 0.0_ReKi !< Rotor power (this is equivalent to the low-speed shaft power) [W] + REAL(ReKi) :: HorWindV = 0.0_ReKi !< Horizontal hub-height wind velocity magnitude [m/s] + REAL(ReKi) :: YawAngle = 0.0_ReKi !< Estimate of yaw (nacelle + platform) [radians] + REAL(ReKi) :: LSShftFxa = 0.0_ReKi !< Rotating low-speed shaft force x [N] + REAL(ReKi) :: LSShftFys = 0.0_ReKi !< Nonrotating low-speed shaft force y [N] + REAL(ReKi) :: LSShftFzs = 0.0_ReKi !< Nonrotating low-speed shaft force z [N] 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 [-] TYPE(MeshType) :: PtfmMotionMesh !< Platform motion mesh at platform reference point [-] TYPE(MeshType) , DIMENSION(:,:), ALLOCATABLE :: BStCMotionMesh !< StC module blade input motion mesh [-] TYPE(MeshType) , DIMENSION(:), ALLOCATABLE :: NStCMotionMesh !< StC module nacelle input motion mesh [-] @@ -562,12 +561,13 @@ MODULE ServoDyn_Types 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) :: YawMom = 0.0_ReKi !< Torque transmitted through the yaw bearing [N-m] + REAL(ReKi) :: YawPosCom = 0.0_ReKi !< Yaw command from controller (for SED module) [rad] + REAL(ReKi) :: YawRateCom = 0.0_ReKi !< Yaw rate command from controller (for SED module) [rad/s] + REAL(ReKi) :: GenTrq = 0.0_ReKi !< Electrical generator torque [N-m] + REAL(ReKi) :: HSSBrTrqC = 0.0_ReKi !< Commanded HSS brake torque [N-m] + REAL(ReKi) :: ElecPwr = 0.0_ReKi !< Electrical power [W] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TBDrCon !< Instantaneous tip-brake drag constant, Cd*Area [-] - REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: Lidar !< A swap array: used to pass output data from the DLL controller to the Lidar [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: CableDeltaL !< Cable control -- Length change request (passed to MD or SD) [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: CableDeltaLdot !< Cable control -- Length change rate request (passed to MD or SD) [m/s] TYPE(MeshType) , DIMENSION(:,:), ALLOCATABLE :: BStCLoadMesh !< StC module blade output load mesh (NumBl,NumBStC) [-] @@ -578,17722 +578,5835 @@ MODULE ServoDyn_Types 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%NacRefPos = SrcInitInputData%NacRefPos - DstInitInputData%NacTransDisp = SrcInitInputData%NacTransDisp - DstInitInputData%NacOrient = SrcInitInputData%NacOrient - DstInitInputData%NacRefOrient = SrcInitInputData%NacRefOrient - DstInitInputData%TwrBaseRefPos = SrcInitInputData%TwrBaseRefPos - DstInitInputData%TwrBaseTransDisp = SrcInitInputData%TwrBaseTransDisp - DstInitInputData%TwrBaseOrient = SrcInitInputData%TwrBaseOrient - DstInitInputData%TwrBaseRefOrient = SrcInitInputData%TwrBaseRefOrient - DstInitInputData%PtfmRefPos = SrcInitInputData%PtfmRefPos - DstInitInputData%PtfmTransDisp = SrcInitInputData%PtfmTransDisp - DstInitInputData%PtfmOrient = SrcInitInputData%PtfmOrient - DstInitInputData%PtfmRefOrient = SrcInitInputData%PtfmRefOrient - 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%BladeRootRefPos)) THEN - i1_l = LBOUND(SrcInitInputData%BladeRootRefPos,1) - i1_u = UBOUND(SrcInitInputData%BladeRootRefPos,1) - i2_l = LBOUND(SrcInitInputData%BladeRootRefPos,2) - i2_u = UBOUND(SrcInitInputData%BladeRootRefPos,2) - IF (.NOT. ALLOCATED(DstInitInputData%BladeRootRefPos)) THEN - ALLOCATE(DstInitInputData%BladeRootRefPos(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%BladeRootRefPos.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%BladeRootRefPos = SrcInitInputData%BladeRootRefPos -ENDIF -IF (ALLOCATED(SrcInitInputData%BladeRootTransDisp)) THEN - i1_l = LBOUND(SrcInitInputData%BladeRootTransDisp,1) - i1_u = UBOUND(SrcInitInputData%BladeRootTransDisp,1) - i2_l = LBOUND(SrcInitInputData%BladeRootTransDisp,2) - i2_u = UBOUND(SrcInitInputData%BladeRootTransDisp,2) - IF (.NOT. ALLOCATED(DstInitInputData%BladeRootTransDisp)) THEN - ALLOCATE(DstInitInputData%BladeRootTransDisp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%BladeRootTransDisp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%BladeRootTransDisp = SrcInitInputData%BladeRootTransDisp -ENDIF -IF (ALLOCATED(SrcInitInputData%BladeRootOrient)) THEN - i1_l = LBOUND(SrcInitInputData%BladeRootOrient,1) - i1_u = UBOUND(SrcInitInputData%BladeRootOrient,1) - i2_l = LBOUND(SrcInitInputData%BladeRootOrient,2) - i2_u = UBOUND(SrcInitInputData%BladeRootOrient,2) - i3_l = LBOUND(SrcInitInputData%BladeRootOrient,3) - i3_u = UBOUND(SrcInitInputData%BladeRootOrient,3) - IF (.NOT. ALLOCATED(DstInitInputData%BladeRootOrient)) THEN - ALLOCATE(DstInitInputData%BladeRootOrient(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%BladeRootOrient.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%BladeRootOrient = SrcInitInputData%BladeRootOrient -ENDIF -IF (ALLOCATED(SrcInitInputData%BladeRootRefOrient)) THEN - i1_l = LBOUND(SrcInitInputData%BladeRootRefOrient,1) - i1_u = UBOUND(SrcInitInputData%BladeRootRefOrient,1) - i2_l = LBOUND(SrcInitInputData%BladeRootRefOrient,2) - i2_u = UBOUND(SrcInitInputData%BladeRootRefOrient,2) - i3_l = LBOUND(SrcInitInputData%BladeRootRefOrient,3) - i3_u = UBOUND(SrcInitInputData%BladeRootRefOrient,3) - IF (.NOT. ALLOCATED(DstInitInputData%BladeRootRefOrient)) THEN - ALLOCATE(DstInitInputData%BladeRootRefOrient(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%BladeRootRefOrient.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%BladeRootRefOrient = SrcInitInputData%BladeRootRefOrient -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%NumCableControl = SrcInitInputData%NumCableControl -IF (ALLOCATED(SrcInitInputData%CableControlRequestor)) THEN - i1_l = LBOUND(SrcInitInputData%CableControlRequestor,1) - i1_u = UBOUND(SrcInitInputData%CableControlRequestor,1) - IF (.NOT. ALLOCATED(DstInitInputData%CableControlRequestor)) THEN - ALLOCATE(DstInitInputData%CableControlRequestor(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%CableControlRequestor.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%CableControlRequestor = SrcInitInputData%CableControlRequestor -ENDIF - DstInitInputData%InterpOrder = SrcInitInputData%InterpOrder -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 -IF (ALLOCATED(SrcInitInputData%LidSpeed)) THEN - i1_l = LBOUND(SrcInitInputData%LidSpeed,1) - i1_u = UBOUND(SrcInitInputData%LidSpeed,1) - IF (.NOT. ALLOCATED(DstInitInputData%LidSpeed)) THEN - ALLOCATE(DstInitInputData%LidSpeed(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%LidSpeed.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%LidSpeed = SrcInitInputData%LidSpeed -ENDIF -IF (ALLOCATED(SrcInitInputData%MsrPositionsX)) THEN - i1_l = LBOUND(SrcInitInputData%MsrPositionsX,1) - i1_u = UBOUND(SrcInitInputData%MsrPositionsX,1) - IF (.NOT. ALLOCATED(DstInitInputData%MsrPositionsX)) THEN - ALLOCATE(DstInitInputData%MsrPositionsX(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%MsrPositionsX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%MsrPositionsX = SrcInitInputData%MsrPositionsX -ENDIF -IF (ALLOCATED(SrcInitInputData%MsrPositionsY)) THEN - i1_l = LBOUND(SrcInitInputData%MsrPositionsY,1) - i1_u = UBOUND(SrcInitInputData%MsrPositionsY,1) - IF (.NOT. ALLOCATED(DstInitInputData%MsrPositionsY)) THEN - ALLOCATE(DstInitInputData%MsrPositionsY(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%MsrPositionsY.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%MsrPositionsY = SrcInitInputData%MsrPositionsY -ENDIF -IF (ALLOCATED(SrcInitInputData%MsrPositionsZ)) THEN - i1_l = LBOUND(SrcInitInputData%MsrPositionsZ,1) - i1_u = UBOUND(SrcInitInputData%MsrPositionsZ,1) - IF (.NOT. ALLOCATED(DstInitInputData%MsrPositionsZ)) THEN - ALLOCATE(DstInitInputData%MsrPositionsZ(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%MsrPositionsZ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%MsrPositionsZ = SrcInitInputData%MsrPositionsZ -ENDIF - DstInitInputData%SensorType = SrcInitInputData%SensorType - DstInitInputData%NumBeam = SrcInitInputData%NumBeam - DstInitInputData%NumPulseGate = SrcInitInputData%NumPulseGate - DstInitInputData%PulseSpacing = SrcInitInputData%PulseSpacing - DstInitInputData%URefLid = SrcInitInputData%URefLid - END SUBROUTINE SrvD_CopyInitInput - - SUBROUTINE SrvD_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(SrvD_InitInputType), INTENT(INOUT) :: InitInputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_DestroyInitInput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(InitInputData%BlPitchInit)) THEN - DEALLOCATE(InitInputData%BlPitchInit) -ENDIF -IF (ALLOCATED(InitInputData%BladeRootRefPos)) THEN - DEALLOCATE(InitInputData%BladeRootRefPos) -ENDIF -IF (ALLOCATED(InitInputData%BladeRootTransDisp)) THEN - DEALLOCATE(InitInputData%BladeRootTransDisp) -ENDIF -IF (ALLOCATED(InitInputData%BladeRootOrient)) THEN - DEALLOCATE(InitInputData%BladeRootOrient) -ENDIF -IF (ALLOCATED(InitInputData%BladeRootRefOrient)) THEN - DEALLOCATE(InitInputData%BladeRootRefOrient) -ENDIF - CALL NWTC_Library_Destroyfileinfotype( InitInputData%PassedPrimaryInputData, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(InitInputData%CableControlRequestor)) THEN - DEALLOCATE(InitInputData%CableControlRequestor) -ENDIF -IF (ALLOCATED(InitInputData%fromSCGlob)) THEN - DEALLOCATE(InitInputData%fromSCGlob) -ENDIF -IF (ALLOCATED(InitInputData%fromSC)) THEN - DEALLOCATE(InitInputData%fromSC) -ENDIF -IF (ALLOCATED(InitInputData%LidSpeed)) THEN - DEALLOCATE(InitInputData%LidSpeed) -ENDIF -IF (ALLOCATED(InitInputData%MsrPositionsX)) THEN - DEALLOCATE(InitInputData%MsrPositionsX) -ENDIF -IF (ALLOCATED(InitInputData%MsrPositionsY)) THEN - DEALLOCATE(InitInputData%MsrPositionsY) -ENDIF -IF (ALLOCATED(InitInputData%MsrPositionsZ)) THEN - DEALLOCATE(InitInputData%MsrPositionsZ) -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%NacRefPos) ! NacRefPos - Db_BufSz = Db_BufSz + SIZE(InData%NacTransDisp) ! NacTransDisp - Db_BufSz = Db_BufSz + SIZE(InData%NacOrient) ! NacOrient - Db_BufSz = Db_BufSz + SIZE(InData%NacRefOrient) ! NacRefOrient - Re_BufSz = Re_BufSz + SIZE(InData%TwrBaseRefPos) ! TwrBaseRefPos - Db_BufSz = Db_BufSz + SIZE(InData%TwrBaseTransDisp) ! TwrBaseTransDisp - Db_BufSz = Db_BufSz + SIZE(InData%TwrBaseOrient) ! TwrBaseOrient - Db_BufSz = Db_BufSz + SIZE(InData%TwrBaseRefOrient) ! TwrBaseRefOrient - Re_BufSz = Re_BufSz + SIZE(InData%PtfmRefPos) ! PtfmRefPos - Db_BufSz = Db_BufSz + SIZE(InData%PtfmTransDisp) ! PtfmTransDisp - Db_BufSz = Db_BufSz + SIZE(InData%PtfmOrient) ! PtfmOrient - Db_BufSz = Db_BufSz + SIZE(InData%PtfmRefOrient) ! PtfmRefOrient - 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 ! BladeRootRefPos allocated yes/no - IF ( ALLOCATED(InData%BladeRootRefPos) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BladeRootRefPos upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BladeRootRefPos) ! BladeRootRefPos - END IF - Int_BufSz = Int_BufSz + 1 ! BladeRootTransDisp allocated yes/no - IF ( ALLOCATED(InData%BladeRootTransDisp) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BladeRootTransDisp upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%BladeRootTransDisp) ! BladeRootTransDisp - END IF - Int_BufSz = Int_BufSz + 1 ! BladeRootOrient allocated yes/no - IF ( ALLOCATED(InData%BladeRootOrient) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! BladeRootOrient upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%BladeRootOrient) ! BladeRootOrient - END IF - Int_BufSz = Int_BufSz + 1 ! BladeRootRefOrient allocated yes/no - IF ( ALLOCATED(InData%BladeRootRefOrient) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! BladeRootRefOrient upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%BladeRootRefOrient) ! BladeRootRefOrient - 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 ! NumCableControl - Int_BufSz = Int_BufSz + 1 ! CableControlRequestor allocated yes/no - IF ( ALLOCATED(InData%CableControlRequestor) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! CableControlRequestor upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%CableControlRequestor)*LEN(InData%CableControlRequestor) ! CableControlRequestor - END IF - Int_BufSz = Int_BufSz + 1 ! InterpOrder - 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 - Int_BufSz = Int_BufSz + 1 ! LidSpeed allocated yes/no - IF ( ALLOCATED(InData%LidSpeed) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LidSpeed upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%LidSpeed) ! LidSpeed - END IF - Int_BufSz = Int_BufSz + 1 ! MsrPositionsX allocated yes/no - IF ( ALLOCATED(InData%MsrPositionsX) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! MsrPositionsX upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%MsrPositionsX) ! MsrPositionsX - END IF - Int_BufSz = Int_BufSz + 1 ! MsrPositionsY allocated yes/no - IF ( ALLOCATED(InData%MsrPositionsY) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! MsrPositionsY upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%MsrPositionsY) ! MsrPositionsY - END IF - Int_BufSz = Int_BufSz + 1 ! MsrPositionsZ allocated yes/no - IF ( ALLOCATED(InData%MsrPositionsZ) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! MsrPositionsZ upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%MsrPositionsZ) ! MsrPositionsZ - END IF - Int_BufSz = Int_BufSz + 1 ! SensorType - Int_BufSz = Int_BufSz + 1 ! NumBeam - Int_BufSz = Int_BufSz + 1 ! NumPulseGate - Re_BufSz = Re_BufSz + 1 ! PulseSpacing - Re_BufSz = Re_BufSz + 1 ! URefLid - 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%NacRefPos,1), UBOUND(InData%NacRefPos,1) - ReKiBuf(Re_Xferred) = InData%NacRefPos(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%NacTransDisp,1), UBOUND(InData%NacTransDisp,1) - DbKiBuf(Db_Xferred) = InData%NacTransDisp(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i2 = LBOUND(InData%NacOrient,2), UBOUND(InData%NacOrient,2) - DO i1 = LBOUND(InData%NacOrient,1), UBOUND(InData%NacOrient,1) - DbKiBuf(Db_Xferred) = InData%NacOrient(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - DO i2 = LBOUND(InData%NacRefOrient,2), UBOUND(InData%NacRefOrient,2) - DO i1 = LBOUND(InData%NacRefOrient,1), UBOUND(InData%NacRefOrient,1) - DbKiBuf(Db_Xferred) = InData%NacRefOrient(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - DO i1 = LBOUND(InData%TwrBaseRefPos,1), UBOUND(InData%TwrBaseRefPos,1) - ReKiBuf(Re_Xferred) = InData%TwrBaseRefPos(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%TwrBaseTransDisp,1), UBOUND(InData%TwrBaseTransDisp,1) - DbKiBuf(Db_Xferred) = InData%TwrBaseTransDisp(i1) - Db_Xferred = Db_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 i2 = LBOUND(InData%TwrBaseRefOrient,2), UBOUND(InData%TwrBaseRefOrient,2) - DO i1 = LBOUND(InData%TwrBaseRefOrient,1), UBOUND(InData%TwrBaseRefOrient,1) - DbKiBuf(Db_Xferred) = InData%TwrBaseRefOrient(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - DO i1 = LBOUND(InData%PtfmRefPos,1), UBOUND(InData%PtfmRefPos,1) - ReKiBuf(Re_Xferred) = InData%PtfmRefPos(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%PtfmTransDisp,1), UBOUND(InData%PtfmTransDisp,1) - DbKiBuf(Db_Xferred) = InData%PtfmTransDisp(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i2 = LBOUND(InData%PtfmOrient,2), UBOUND(InData%PtfmOrient,2) - DO i1 = LBOUND(InData%PtfmOrient,1), UBOUND(InData%PtfmOrient,1) - DbKiBuf(Db_Xferred) = InData%PtfmOrient(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - DO i2 = LBOUND(InData%PtfmRefOrient,2), UBOUND(InData%PtfmRefOrient,2) - DO i1 = LBOUND(InData%PtfmRefOrient,1), UBOUND(InData%PtfmRefOrient,1) - DbKiBuf(Db_Xferred) = InData%PtfmRefOrient(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%BladeRootRefPos) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BladeRootRefPos,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BladeRootRefPos,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BladeRootRefPos,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BladeRootRefPos,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%BladeRootRefPos,2), UBOUND(InData%BladeRootRefPos,2) - DO i1 = LBOUND(InData%BladeRootRefPos,1), UBOUND(InData%BladeRootRefPos,1) - ReKiBuf(Re_Xferred) = InData%BladeRootRefPos(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BladeRootTransDisp) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BladeRootTransDisp,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BladeRootTransDisp,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BladeRootTransDisp,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BladeRootTransDisp,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%BladeRootTransDisp,2), UBOUND(InData%BladeRootTransDisp,2) - DO i1 = LBOUND(InData%BladeRootTransDisp,1), UBOUND(InData%BladeRootTransDisp,1) - DbKiBuf(Db_Xferred) = InData%BladeRootTransDisp(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BladeRootOrient) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BladeRootOrient,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BladeRootOrient,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BladeRootOrient,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BladeRootOrient,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BladeRootOrient,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BladeRootOrient,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%BladeRootOrient,3), UBOUND(InData%BladeRootOrient,3) - DO i2 = LBOUND(InData%BladeRootOrient,2), UBOUND(InData%BladeRootOrient,2) - DO i1 = LBOUND(InData%BladeRootOrient,1), UBOUND(InData%BladeRootOrient,1) - DbKiBuf(Db_Xferred) = InData%BladeRootOrient(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BladeRootRefOrient) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BladeRootRefOrient,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BladeRootRefOrient,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BladeRootRefOrient,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BladeRootRefOrient,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BladeRootRefOrient,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BladeRootRefOrient,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%BladeRootRefOrient,3), UBOUND(InData%BladeRootRefOrient,3) - DO i2 = LBOUND(InData%BladeRootRefOrient,2), UBOUND(InData%BladeRootRefOrient,2) - DO i1 = LBOUND(InData%BladeRootRefOrient,1), UBOUND(InData%BladeRootRefOrient,1) - DbKiBuf(Db_Xferred) = InData%BladeRootRefOrient(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) = InData%NumCableControl - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%CableControlRequestor) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CableControlRequestor,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CableControlRequestor,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%CableControlRequestor,1), UBOUND(InData%CableControlRequestor,1) - DO I = 1, LEN(InData%CableControlRequestor) - IntKiBuf(Int_Xferred) = ICHAR(InData%CableControlRequestor(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IntKiBuf(Int_Xferred) = InData%InterpOrder - Int_Xferred = Int_Xferred + 1 - 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 - IF ( .NOT. ALLOCATED(InData%LidSpeed) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LidSpeed,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LidSpeed,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LidSpeed,1), UBOUND(InData%LidSpeed,1) - ReKiBuf(Re_Xferred) = InData%LidSpeed(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%MsrPositionsX) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MsrPositionsX,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MsrPositionsX,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%MsrPositionsX,1), UBOUND(InData%MsrPositionsX,1) - ReKiBuf(Re_Xferred) = InData%MsrPositionsX(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%MsrPositionsY) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MsrPositionsY,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MsrPositionsY,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%MsrPositionsY,1), UBOUND(InData%MsrPositionsY,1) - ReKiBuf(Re_Xferred) = InData%MsrPositionsY(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%MsrPositionsZ) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MsrPositionsZ,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MsrPositionsZ,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%MsrPositionsZ,1), UBOUND(InData%MsrPositionsZ,1) - ReKiBuf(Re_Xferred) = InData%MsrPositionsZ(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%SensorType - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumBeam - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumPulseGate - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PulseSpacing - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%URefLid - Re_Xferred = Re_Xferred + 1 - 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%NacRefPos,1) - i1_u = UBOUND(OutData%NacRefPos,1) - DO i1 = LBOUND(OutData%NacRefPos,1), UBOUND(OutData%NacRefPos,1) - OutData%NacRefPos(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%NacTransDisp,1) - i1_u = UBOUND(OutData%NacTransDisp,1) - DO i1 = LBOUND(OutData%NacTransDisp,1), UBOUND(OutData%NacTransDisp,1) - OutData%NacTransDisp(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%NacOrient,1) - i1_u = UBOUND(OutData%NacOrient,1) - i2_l = LBOUND(OutData%NacOrient,2) - i2_u = UBOUND(OutData%NacOrient,2) - DO i2 = LBOUND(OutData%NacOrient,2), UBOUND(OutData%NacOrient,2) - DO i1 = LBOUND(OutData%NacOrient,1), UBOUND(OutData%NacOrient,1) - OutData%NacOrient(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%NacRefOrient,1) - i1_u = UBOUND(OutData%NacRefOrient,1) - i2_l = LBOUND(OutData%NacRefOrient,2) - i2_u = UBOUND(OutData%NacRefOrient,2) - DO i2 = LBOUND(OutData%NacRefOrient,2), UBOUND(OutData%NacRefOrient,2) - DO i1 = LBOUND(OutData%NacRefOrient,1), UBOUND(OutData%NacRefOrient,1) - OutData%NacRefOrient(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%TwrBaseRefPos,1) - i1_u = UBOUND(OutData%TwrBaseRefPos,1) - DO i1 = LBOUND(OutData%TwrBaseRefPos,1), UBOUND(OutData%TwrBaseRefPos,1) - OutData%TwrBaseRefPos(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%TwrBaseTransDisp,1) - i1_u = UBOUND(OutData%TwrBaseTransDisp,1) - DO i1 = LBOUND(OutData%TwrBaseTransDisp,1), UBOUND(OutData%TwrBaseTransDisp,1) - OutData%TwrBaseTransDisp(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_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%TwrBaseRefOrient,1) - i1_u = UBOUND(OutData%TwrBaseRefOrient,1) - i2_l = LBOUND(OutData%TwrBaseRefOrient,2) - i2_u = UBOUND(OutData%TwrBaseRefOrient,2) - DO i2 = LBOUND(OutData%TwrBaseRefOrient,2), UBOUND(OutData%TwrBaseRefOrient,2) - DO i1 = LBOUND(OutData%TwrBaseRefOrient,1), UBOUND(OutData%TwrBaseRefOrient,1) - OutData%TwrBaseRefOrient(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%PtfmRefPos,1) - i1_u = UBOUND(OutData%PtfmRefPos,1) - DO i1 = LBOUND(OutData%PtfmRefPos,1), UBOUND(OutData%PtfmRefPos,1) - OutData%PtfmRefPos(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%PtfmTransDisp,1) - i1_u = UBOUND(OutData%PtfmTransDisp,1) - DO i1 = LBOUND(OutData%PtfmTransDisp,1), UBOUND(OutData%PtfmTransDisp,1) - OutData%PtfmTransDisp(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%PtfmOrient,1) - i1_u = UBOUND(OutData%PtfmOrient,1) - i2_l = LBOUND(OutData%PtfmOrient,2) - i2_u = UBOUND(OutData%PtfmOrient,2) - DO i2 = LBOUND(OutData%PtfmOrient,2), UBOUND(OutData%PtfmOrient,2) - DO i1 = LBOUND(OutData%PtfmOrient,1), UBOUND(OutData%PtfmOrient,1) - OutData%PtfmOrient(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%PtfmRefOrient,1) - i1_u = UBOUND(OutData%PtfmRefOrient,1) - i2_l = LBOUND(OutData%PtfmRefOrient,2) - i2_u = UBOUND(OutData%PtfmRefOrient,2) - DO i2 = LBOUND(OutData%PtfmRefOrient,2), UBOUND(OutData%PtfmRefOrient,2) - DO i1 = LBOUND(OutData%PtfmRefOrient,1), UBOUND(OutData%PtfmRefOrient,1) - OutData%PtfmRefOrient(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 ! BladeRootRefPos not allocated - Int_Xferred = Int_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%BladeRootRefPos)) DEALLOCATE(OutData%BladeRootRefPos) - ALLOCATE(OutData%BladeRootRefPos(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeRootRefPos.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%BladeRootRefPos,2), UBOUND(OutData%BladeRootRefPos,2) - DO i1 = LBOUND(OutData%BladeRootRefPos,1), UBOUND(OutData%BladeRootRefPos,1) - OutData%BladeRootRefPos(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BladeRootTransDisp not allocated - Int_Xferred = Int_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%BladeRootTransDisp)) DEALLOCATE(OutData%BladeRootTransDisp) - ALLOCATE(OutData%BladeRootTransDisp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeRootTransDisp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%BladeRootTransDisp,2), UBOUND(OutData%BladeRootTransDisp,2) - DO i1 = LBOUND(OutData%BladeRootTransDisp,1), UBOUND(OutData%BladeRootTransDisp,1) - OutData%BladeRootTransDisp(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BladeRootOrient not allocated - Int_Xferred = Int_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%BladeRootOrient)) DEALLOCATE(OutData%BladeRootOrient) - ALLOCATE(OutData%BladeRootOrient(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%BladeRootOrient.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%BladeRootOrient,3), UBOUND(OutData%BladeRootOrient,3) - DO i2 = LBOUND(OutData%BladeRootOrient,2), UBOUND(OutData%BladeRootOrient,2) - DO i1 = LBOUND(OutData%BladeRootOrient,1), UBOUND(OutData%BladeRootOrient,1) - OutData%BladeRootOrient(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BladeRootRefOrient not allocated - Int_Xferred = Int_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%BladeRootRefOrient)) DEALLOCATE(OutData%BladeRootRefOrient) - ALLOCATE(OutData%BladeRootRefOrient(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%BladeRootRefOrient.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%BladeRootRefOrient,3), UBOUND(OutData%BladeRootRefOrient,3) - DO i2 = LBOUND(OutData%BladeRootRefOrient,2), UBOUND(OutData%BladeRootRefOrient,2) - DO i1 = LBOUND(OutData%BladeRootRefOrient,1), UBOUND(OutData%BladeRootRefOrient,1) - OutData%BladeRootRefOrient(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%NumCableControl = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CableControlRequestor not allocated - Int_Xferred = Int_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%CableControlRequestor)) DEALLOCATE(OutData%CableControlRequestor) - ALLOCATE(OutData%CableControlRequestor(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CableControlRequestor.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%CableControlRequestor,1), UBOUND(OutData%CableControlRequestor,1) - DO I = 1, LEN(OutData%CableControlRequestor) - OutData%CableControlRequestor(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - OutData%InterpOrder = IntKiBuf(Int_Xferred) - Int_Xferred = 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 (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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LidSpeed not allocated - Int_Xferred = Int_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%LidSpeed)) DEALLOCATE(OutData%LidSpeed) - ALLOCATE(OutData%LidSpeed(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LidSpeed.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LidSpeed,1), UBOUND(OutData%LidSpeed,1) - OutData%LidSpeed(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MsrPositionsX not allocated - Int_Xferred = Int_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%MsrPositionsX)) DEALLOCATE(OutData%MsrPositionsX) - ALLOCATE(OutData%MsrPositionsX(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MsrPositionsX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%MsrPositionsX,1), UBOUND(OutData%MsrPositionsX,1) - OutData%MsrPositionsX(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MsrPositionsY not allocated - Int_Xferred = Int_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%MsrPositionsY)) DEALLOCATE(OutData%MsrPositionsY) - ALLOCATE(OutData%MsrPositionsY(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MsrPositionsY.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%MsrPositionsY,1), UBOUND(OutData%MsrPositionsY,1) - OutData%MsrPositionsY(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MsrPositionsZ not allocated - Int_Xferred = Int_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%MsrPositionsZ)) DEALLOCATE(OutData%MsrPositionsZ) - ALLOCATE(OutData%MsrPositionsZ(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MsrPositionsZ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%MsrPositionsZ,1), UBOUND(OutData%MsrPositionsZ,1) - OutData%MsrPositionsZ(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%SensorType = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumBeam = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumPulseGate = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%PulseSpacing = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%URefLid = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - 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_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 SrvD_CopyInitOutput - - SUBROUTINE SrvD_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(SrvD_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_DestroyInitOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(InitOutputData%WriteOutputHdr)) THEN - DEALLOCATE(InitOutputData%WriteOutputHdr) -ENDIF -IF (ALLOCATED(InitOutputData%WriteOutputUnt)) THEN - DEALLOCATE(InitOutputData%WriteOutputUnt) -ENDIF - CALL NWTC_Library_Destroyprogdesc( InitOutputData%Ver, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -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 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_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 - 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_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 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_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 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 - DstInputFileData%AfCmode = SrcInputFileData%AfCmode - DstInputFileData%AfC_Mean = SrcInputFileData%AfC_Mean - DstInputFileData%AfC_Amp = SrcInputFileData%AfC_Amp - DstInputFileData%AfC_Phase = SrcInputFileData%AfC_Phase - DstInputFileData%CCmode = SrcInputFileData%CCmode - DstInputFileData%EXavrSWAP = SrcInputFileData%EXavrSWAP - END SUBROUTINE SrvD_CopyInputFile - - SUBROUTINE SrvD_DestroyInputFile( InputFileData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(SrvD_InputFile), INTENT(INOUT) :: InputFileData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_DestroyInputFile' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -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 - Int_BufSz = Int_BufSz + 1 ! AfCmode - Re_BufSz = Re_BufSz + 1 ! AfC_Mean - Re_BufSz = Re_BufSz + 1 ! AfC_Amp - Re_BufSz = Re_BufSz + 1 ! AfC_Phase - Int_BufSz = Int_BufSz + 1 ! CCmode - Int_BufSz = Int_BufSz + 1 ! EXavrSWAP - 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 - IntKiBuf(Int_Xferred) = InData%AfCmode - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%AfC_Mean - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%AfC_Amp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%AfC_Phase - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%CCmode - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%EXavrSWAP, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - 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 - OutData%AfCmode = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%AfC_Mean = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%AfC_Amp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%AfC_Phase = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%CCmode = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%EXavrSWAP = TRANSFER(IntKiBuf(Int_Xferred), OutData%EXavrSWAP) - Int_Xferred = Int_Xferred + 1 - 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) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - 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%PrevBlAirfoilCom = SrcBladedDLLTypeData%PrevBlAirfoilCom - 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%LSShftFxa = SrcBladedDLLTypeData%LSShftFxa - DstBladedDLLTypeData%LSShftFys = SrcBladedDLLTypeData%LSShftFys - DstBladedDLLTypeData%LSShftFzs = SrcBladedDLLTypeData%LSShftFzs -IF (ALLOCATED(SrcBladedDLLTypeData%LidSpeed)) THEN - i1_l = LBOUND(SrcBladedDLLTypeData%LidSpeed,1) - i1_u = UBOUND(SrcBladedDLLTypeData%LidSpeed,1) - IF (.NOT. ALLOCATED(DstBladedDLLTypeData%LidSpeed)) THEN - ALLOCATE(DstBladedDLLTypeData%LidSpeed(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%LidSpeed.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladedDLLTypeData%LidSpeed = SrcBladedDLLTypeData%LidSpeed -ENDIF -IF (ALLOCATED(SrcBladedDLLTypeData%MsrPositionsX)) THEN - i1_l = LBOUND(SrcBladedDLLTypeData%MsrPositionsX,1) - i1_u = UBOUND(SrcBladedDLLTypeData%MsrPositionsX,1) - IF (.NOT. ALLOCATED(DstBladedDLLTypeData%MsrPositionsX)) THEN - ALLOCATE(DstBladedDLLTypeData%MsrPositionsX(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%MsrPositionsX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladedDLLTypeData%MsrPositionsX = SrcBladedDLLTypeData%MsrPositionsX -ENDIF -IF (ALLOCATED(SrcBladedDLLTypeData%MsrPositionsY)) THEN - i1_l = LBOUND(SrcBladedDLLTypeData%MsrPositionsY,1) - i1_u = UBOUND(SrcBladedDLLTypeData%MsrPositionsY,1) - IF (.NOT. ALLOCATED(DstBladedDLLTypeData%MsrPositionsY)) THEN - ALLOCATE(DstBladedDLLTypeData%MsrPositionsY(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%MsrPositionsY.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladedDLLTypeData%MsrPositionsY = SrcBladedDLLTypeData%MsrPositionsY -ENDIF -IF (ALLOCATED(SrcBladedDLLTypeData%MsrPositionsZ)) THEN - i1_l = LBOUND(SrcBladedDLLTypeData%MsrPositionsZ,1) - i1_u = UBOUND(SrcBladedDLLTypeData%MsrPositionsZ,1) - IF (.NOT. ALLOCATED(DstBladedDLLTypeData%MsrPositionsZ)) THEN - ALLOCATE(DstBladedDLLTypeData%MsrPositionsZ(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%MsrPositionsZ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladedDLLTypeData%MsrPositionsZ = SrcBladedDLLTypeData%MsrPositionsZ -ENDIF - DstBladedDLLTypeData%SensorType = SrcBladedDLLTypeData%SensorType - DstBladedDLLTypeData%NumBeam = SrcBladedDLLTypeData%NumBeam - DstBladedDLLTypeData%NumPulseGate = SrcBladedDLLTypeData%NumPulseGate - DstBladedDLLTypeData%PulseSpacing = SrcBladedDLLTypeData%PulseSpacing - DstBladedDLLTypeData%URefLid = SrcBladedDLLTypeData%URefLid - 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 -IF (ALLOCATED(SrcBladedDLLTypeData%PrevCableDeltaL)) THEN - i1_l = LBOUND(SrcBladedDLLTypeData%PrevCableDeltaL,1) - i1_u = UBOUND(SrcBladedDLLTypeData%PrevCableDeltaL,1) - IF (.NOT. ALLOCATED(DstBladedDLLTypeData%PrevCableDeltaL)) THEN - ALLOCATE(DstBladedDLLTypeData%PrevCableDeltaL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%PrevCableDeltaL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladedDLLTypeData%PrevCableDeltaL = SrcBladedDLLTypeData%PrevCableDeltaL -ENDIF -IF (ALLOCATED(SrcBladedDLLTypeData%PrevCableDeltaLdot)) THEN - i1_l = LBOUND(SrcBladedDLLTypeData%PrevCableDeltaLdot,1) - i1_u = UBOUND(SrcBladedDLLTypeData%PrevCableDeltaLdot,1) - IF (.NOT. ALLOCATED(DstBladedDLLTypeData%PrevCableDeltaLdot)) THEN - ALLOCATE(DstBladedDLLTypeData%PrevCableDeltaLdot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%PrevCableDeltaLdot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladedDLLTypeData%PrevCableDeltaLdot = SrcBladedDLLTypeData%PrevCableDeltaLdot -ENDIF -IF (ALLOCATED(SrcBladedDLLTypeData%CableDeltaL)) THEN - i1_l = LBOUND(SrcBladedDLLTypeData%CableDeltaL,1) - i1_u = UBOUND(SrcBladedDLLTypeData%CableDeltaL,1) - IF (.NOT. ALLOCATED(DstBladedDLLTypeData%CableDeltaL)) THEN - ALLOCATE(DstBladedDLLTypeData%CableDeltaL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%CableDeltaL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladedDLLTypeData%CableDeltaL = SrcBladedDLLTypeData%CableDeltaL -ENDIF -IF (ALLOCATED(SrcBladedDLLTypeData%CableDeltaLdot)) THEN - i1_l = LBOUND(SrcBladedDLLTypeData%CableDeltaLdot,1) - i1_u = UBOUND(SrcBladedDLLTypeData%CableDeltaLdot,1) - IF (.NOT. ALLOCATED(DstBladedDLLTypeData%CableDeltaLdot)) THEN - ALLOCATE(DstBladedDLLTypeData%CableDeltaLdot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%CableDeltaLdot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladedDLLTypeData%CableDeltaLdot = SrcBladedDLLTypeData%CableDeltaLdot -ENDIF -IF (ALLOCATED(SrcBladedDLLTypeData%PrevStCCmdStiff)) THEN - i1_l = LBOUND(SrcBladedDLLTypeData%PrevStCCmdStiff,1) - i1_u = UBOUND(SrcBladedDLLTypeData%PrevStCCmdStiff,1) - i2_l = LBOUND(SrcBladedDLLTypeData%PrevStCCmdStiff,2) - i2_u = UBOUND(SrcBladedDLLTypeData%PrevStCCmdStiff,2) - IF (.NOT. ALLOCATED(DstBladedDLLTypeData%PrevStCCmdStiff)) THEN - ALLOCATE(DstBladedDLLTypeData%PrevStCCmdStiff(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%PrevStCCmdStiff.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladedDLLTypeData%PrevStCCmdStiff = SrcBladedDLLTypeData%PrevStCCmdStiff -ENDIF -IF (ALLOCATED(SrcBladedDLLTypeData%PrevStCCmdDamp)) THEN - i1_l = LBOUND(SrcBladedDLLTypeData%PrevStCCmdDamp,1) - i1_u = UBOUND(SrcBladedDLLTypeData%PrevStCCmdDamp,1) - i2_l = LBOUND(SrcBladedDLLTypeData%PrevStCCmdDamp,2) - i2_u = UBOUND(SrcBladedDLLTypeData%PrevStCCmdDamp,2) - IF (.NOT. ALLOCATED(DstBladedDLLTypeData%PrevStCCmdDamp)) THEN - ALLOCATE(DstBladedDLLTypeData%PrevStCCmdDamp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%PrevStCCmdDamp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladedDLLTypeData%PrevStCCmdDamp = SrcBladedDLLTypeData%PrevStCCmdDamp -ENDIF -IF (ALLOCATED(SrcBladedDLLTypeData%PrevStCCmdBrake)) THEN - i1_l = LBOUND(SrcBladedDLLTypeData%PrevStCCmdBrake,1) - i1_u = UBOUND(SrcBladedDLLTypeData%PrevStCCmdBrake,1) - i2_l = LBOUND(SrcBladedDLLTypeData%PrevStCCmdBrake,2) - i2_u = UBOUND(SrcBladedDLLTypeData%PrevStCCmdBrake,2) - IF (.NOT. ALLOCATED(DstBladedDLLTypeData%PrevStCCmdBrake)) THEN - ALLOCATE(DstBladedDLLTypeData%PrevStCCmdBrake(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%PrevStCCmdBrake.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladedDLLTypeData%PrevStCCmdBrake = SrcBladedDLLTypeData%PrevStCCmdBrake -ENDIF -IF (ALLOCATED(SrcBladedDLLTypeData%PrevStCCmdForce)) THEN - i1_l = LBOUND(SrcBladedDLLTypeData%PrevStCCmdForce,1) - i1_u = UBOUND(SrcBladedDLLTypeData%PrevStCCmdForce,1) - i2_l = LBOUND(SrcBladedDLLTypeData%PrevStCCmdForce,2) - i2_u = UBOUND(SrcBladedDLLTypeData%PrevStCCmdForce,2) - IF (.NOT. ALLOCATED(DstBladedDLLTypeData%PrevStCCmdForce)) THEN - ALLOCATE(DstBladedDLLTypeData%PrevStCCmdForce(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%PrevStCCmdForce.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladedDLLTypeData%PrevStCCmdForce = SrcBladedDLLTypeData%PrevStCCmdForce -ENDIF -IF (ALLOCATED(SrcBladedDLLTypeData%StCCmdStiff)) THEN - i1_l = LBOUND(SrcBladedDLLTypeData%StCCmdStiff,1) - i1_u = UBOUND(SrcBladedDLLTypeData%StCCmdStiff,1) - i2_l = LBOUND(SrcBladedDLLTypeData%StCCmdStiff,2) - i2_u = UBOUND(SrcBladedDLLTypeData%StCCmdStiff,2) - IF (.NOT. ALLOCATED(DstBladedDLLTypeData%StCCmdStiff)) THEN - ALLOCATE(DstBladedDLLTypeData%StCCmdStiff(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%StCCmdStiff.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladedDLLTypeData%StCCmdStiff = SrcBladedDLLTypeData%StCCmdStiff -ENDIF -IF (ALLOCATED(SrcBladedDLLTypeData%StCCmdDamp)) THEN - i1_l = LBOUND(SrcBladedDLLTypeData%StCCmdDamp,1) - i1_u = UBOUND(SrcBladedDLLTypeData%StCCmdDamp,1) - i2_l = LBOUND(SrcBladedDLLTypeData%StCCmdDamp,2) - i2_u = UBOUND(SrcBladedDLLTypeData%StCCmdDamp,2) - IF (.NOT. ALLOCATED(DstBladedDLLTypeData%StCCmdDamp)) THEN - ALLOCATE(DstBladedDLLTypeData%StCCmdDamp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%StCCmdDamp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladedDLLTypeData%StCCmdDamp = SrcBladedDLLTypeData%StCCmdDamp -ENDIF -IF (ALLOCATED(SrcBladedDLLTypeData%StCCmdBrake)) THEN - i1_l = LBOUND(SrcBladedDLLTypeData%StCCmdBrake,1) - i1_u = UBOUND(SrcBladedDLLTypeData%StCCmdBrake,1) - i2_l = LBOUND(SrcBladedDLLTypeData%StCCmdBrake,2) - i2_u = UBOUND(SrcBladedDLLTypeData%StCCmdBrake,2) - IF (.NOT. ALLOCATED(DstBladedDLLTypeData%StCCmdBrake)) THEN - ALLOCATE(DstBladedDLLTypeData%StCCmdBrake(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%StCCmdBrake.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladedDLLTypeData%StCCmdBrake = SrcBladedDLLTypeData%StCCmdBrake -ENDIF -IF (ALLOCATED(SrcBladedDLLTypeData%StCCmdForce)) THEN - i1_l = LBOUND(SrcBladedDLLTypeData%StCCmdForce,1) - i1_u = UBOUND(SrcBladedDLLTypeData%StCCmdForce,1) - i2_l = LBOUND(SrcBladedDLLTypeData%StCCmdForce,2) - i2_u = UBOUND(SrcBladedDLLTypeData%StCCmdForce,2) - IF (.NOT. ALLOCATED(DstBladedDLLTypeData%StCCmdForce)) THEN - ALLOCATE(DstBladedDLLTypeData%StCCmdForce(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%StCCmdForce.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladedDLLTypeData%StCCmdForce = SrcBladedDLLTypeData%StCCmdForce -ENDIF -IF (ALLOCATED(SrcBladedDLLTypeData%StCMeasDisp)) THEN - i1_l = LBOUND(SrcBladedDLLTypeData%StCMeasDisp,1) - i1_u = UBOUND(SrcBladedDLLTypeData%StCMeasDisp,1) - i2_l = LBOUND(SrcBladedDLLTypeData%StCMeasDisp,2) - i2_u = UBOUND(SrcBladedDLLTypeData%StCMeasDisp,2) - IF (.NOT. ALLOCATED(DstBladedDLLTypeData%StCMeasDisp)) THEN - ALLOCATE(DstBladedDLLTypeData%StCMeasDisp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%StCMeasDisp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladedDLLTypeData%StCMeasDisp = SrcBladedDLLTypeData%StCMeasDisp -ENDIF -IF (ALLOCATED(SrcBladedDLLTypeData%StCMeasVel)) THEN - i1_l = LBOUND(SrcBladedDLLTypeData%StCMeasVel,1) - i1_u = UBOUND(SrcBladedDLLTypeData%StCMeasVel,1) - i2_l = LBOUND(SrcBladedDLLTypeData%StCMeasVel,2) - i2_u = UBOUND(SrcBladedDLLTypeData%StCMeasVel,2) - IF (.NOT. ALLOCATED(DstBladedDLLTypeData%StCMeasVel)) THEN - ALLOCATE(DstBladedDLLTypeData%StCMeasVel(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%StCMeasVel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladedDLLTypeData%StCMeasVel = SrcBladedDLLTypeData%StCMeasVel -ENDIF - END SUBROUTINE SrvD_CopyBladedDLLType - - SUBROUTINE SrvD_DestroyBladedDLLType( BladedDLLTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(BladedDLLType), INTENT(INOUT) :: BladedDLLTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_DestroyBladedDLLType' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -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), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -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%LidSpeed)) THEN - DEALLOCATE(BladedDLLTypeData%LidSpeed) -ENDIF -IF (ALLOCATED(BladedDLLTypeData%MsrPositionsX)) THEN - DEALLOCATE(BladedDLLTypeData%MsrPositionsX) -ENDIF -IF (ALLOCATED(BladedDLLTypeData%MsrPositionsY)) THEN - DEALLOCATE(BladedDLLTypeData%MsrPositionsY) -ENDIF -IF (ALLOCATED(BladedDLLTypeData%MsrPositionsZ)) THEN - DEALLOCATE(BladedDLLTypeData%MsrPositionsZ) -ENDIF -IF (ALLOCATED(BladedDLLTypeData%GenSpd_TLU)) THEN - DEALLOCATE(BladedDLLTypeData%GenSpd_TLU) -ENDIF -IF (ALLOCATED(BladedDLLTypeData%GenTrq_TLU)) THEN - DEALLOCATE(BladedDLLTypeData%GenTrq_TLU) -ENDIF -IF (ALLOCATED(BladedDLLTypeData%PrevCableDeltaL)) THEN - DEALLOCATE(BladedDLLTypeData%PrevCableDeltaL) -ENDIF -IF (ALLOCATED(BladedDLLTypeData%PrevCableDeltaLdot)) THEN - DEALLOCATE(BladedDLLTypeData%PrevCableDeltaLdot) -ENDIF -IF (ALLOCATED(BladedDLLTypeData%CableDeltaL)) THEN - DEALLOCATE(BladedDLLTypeData%CableDeltaL) -ENDIF -IF (ALLOCATED(BladedDLLTypeData%CableDeltaLdot)) THEN - DEALLOCATE(BladedDLLTypeData%CableDeltaLdot) -ENDIF -IF (ALLOCATED(BladedDLLTypeData%PrevStCCmdStiff)) THEN - DEALLOCATE(BladedDLLTypeData%PrevStCCmdStiff) -ENDIF -IF (ALLOCATED(BladedDLLTypeData%PrevStCCmdDamp)) THEN - DEALLOCATE(BladedDLLTypeData%PrevStCCmdDamp) -ENDIF -IF (ALLOCATED(BladedDLLTypeData%PrevStCCmdBrake)) THEN - DEALLOCATE(BladedDLLTypeData%PrevStCCmdBrake) -ENDIF -IF (ALLOCATED(BladedDLLTypeData%PrevStCCmdForce)) THEN - DEALLOCATE(BladedDLLTypeData%PrevStCCmdForce) -ENDIF -IF (ALLOCATED(BladedDLLTypeData%StCCmdStiff)) THEN - DEALLOCATE(BladedDLLTypeData%StCCmdStiff) -ENDIF -IF (ALLOCATED(BladedDLLTypeData%StCCmdDamp)) THEN - DEALLOCATE(BladedDLLTypeData%StCCmdDamp) -ENDIF -IF (ALLOCATED(BladedDLLTypeData%StCCmdBrake)) THEN - DEALLOCATE(BladedDLLTypeData%StCCmdBrake) -ENDIF -IF (ALLOCATED(BladedDLLTypeData%StCCmdForce)) THEN - DEALLOCATE(BladedDLLTypeData%StCCmdForce) -ENDIF -IF (ALLOCATED(BladedDLLTypeData%StCMeasDisp)) THEN - DEALLOCATE(BladedDLLTypeData%StCMeasDisp) -ENDIF -IF (ALLOCATED(BladedDLLTypeData%StCMeasVel)) THEN - DEALLOCATE(BladedDLLTypeData%StCMeasVel) -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 + SIZE(InData%PrevBlAirfoilCom) ! PrevBlAirfoilCom - 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 - Re_BufSz = Re_BufSz + 1 ! LSShftFxa - Re_BufSz = Re_BufSz + 1 ! LSShftFys - Re_BufSz = Re_BufSz + 1 ! LSShftFzs - Int_BufSz = Int_BufSz + 1 ! LidSpeed allocated yes/no - IF ( ALLOCATED(InData%LidSpeed) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LidSpeed upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%LidSpeed) ! LidSpeed - END IF - Int_BufSz = Int_BufSz + 1 ! MsrPositionsX allocated yes/no - IF ( ALLOCATED(InData%MsrPositionsX) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! MsrPositionsX upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%MsrPositionsX) ! MsrPositionsX - END IF - Int_BufSz = Int_BufSz + 1 ! MsrPositionsY allocated yes/no - IF ( ALLOCATED(InData%MsrPositionsY) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! MsrPositionsY upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%MsrPositionsY) ! MsrPositionsY - END IF - Int_BufSz = Int_BufSz + 1 ! MsrPositionsZ allocated yes/no - IF ( ALLOCATED(InData%MsrPositionsZ) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! MsrPositionsZ upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%MsrPositionsZ) ! MsrPositionsZ - END IF - Int_BufSz = Int_BufSz + 1 ! SensorType - Int_BufSz = Int_BufSz + 1 ! NumBeam - Int_BufSz = Int_BufSz + 1 ! NumPulseGate - Int_BufSz = Int_BufSz + 1 ! PulseSpacing - Int_BufSz = Int_BufSz + 1 ! URefLid - 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 - Int_BufSz = Int_BufSz + 1 ! PrevCableDeltaL allocated yes/no - IF ( ALLOCATED(InData%PrevCableDeltaL) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PrevCableDeltaL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PrevCableDeltaL) ! PrevCableDeltaL - END IF - Int_BufSz = Int_BufSz + 1 ! PrevCableDeltaLdot allocated yes/no - IF ( ALLOCATED(InData%PrevCableDeltaLdot) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PrevCableDeltaLdot upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PrevCableDeltaLdot) ! PrevCableDeltaLdot - 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 - Int_BufSz = Int_BufSz + 1 ! CableDeltaLdot allocated yes/no - IF ( ALLOCATED(InData%CableDeltaLdot) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! CableDeltaLdot upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CableDeltaLdot) ! CableDeltaLdot - END IF - Int_BufSz = Int_BufSz + 1 ! PrevStCCmdStiff allocated yes/no - IF ( ALLOCATED(InData%PrevStCCmdStiff) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PrevStCCmdStiff upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PrevStCCmdStiff) ! PrevStCCmdStiff - END IF - Int_BufSz = Int_BufSz + 1 ! PrevStCCmdDamp allocated yes/no - IF ( ALLOCATED(InData%PrevStCCmdDamp) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PrevStCCmdDamp upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PrevStCCmdDamp) ! PrevStCCmdDamp - END IF - Int_BufSz = Int_BufSz + 1 ! PrevStCCmdBrake allocated yes/no - IF ( ALLOCATED(InData%PrevStCCmdBrake) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PrevStCCmdBrake upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PrevStCCmdBrake) ! PrevStCCmdBrake - END IF - Int_BufSz = Int_BufSz + 1 ! PrevStCCmdForce allocated yes/no - IF ( ALLOCATED(InData%PrevStCCmdForce) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PrevStCCmdForce upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PrevStCCmdForce) ! PrevStCCmdForce - END IF - Int_BufSz = Int_BufSz + 1 ! StCCmdStiff allocated yes/no - IF ( ALLOCATED(InData%StCCmdStiff) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! StCCmdStiff upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%StCCmdStiff) ! StCCmdStiff - END IF - Int_BufSz = Int_BufSz + 1 ! StCCmdDamp allocated yes/no - IF ( ALLOCATED(InData%StCCmdDamp) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! StCCmdDamp upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%StCCmdDamp) ! StCCmdDamp - END IF - Int_BufSz = Int_BufSz + 1 ! StCCmdBrake allocated yes/no - IF ( ALLOCATED(InData%StCCmdBrake) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! StCCmdBrake upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%StCCmdBrake) ! StCCmdBrake - END IF - Int_BufSz = Int_BufSz + 1 ! StCCmdForce allocated yes/no - IF ( ALLOCATED(InData%StCCmdForce) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! StCCmdForce upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%StCCmdForce) ! StCCmdForce - END IF - Int_BufSz = Int_BufSz + 1 ! StCMeasDisp allocated yes/no - IF ( ALLOCATED(InData%StCMeasDisp) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! StCMeasDisp upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%StCMeasDisp) ! StCMeasDisp - END IF - Int_BufSz = Int_BufSz + 1 ! StCMeasVel allocated yes/no - IF ( ALLOCATED(InData%StCMeasVel) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! StCMeasVel upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%StCMeasVel) ! StCMeasVel - 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%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 - DO i1 = LBOUND(InData%PrevBlAirfoilCom,1), UBOUND(InData%PrevBlAirfoilCom,1) - ReKiBuf(Re_Xferred) = InData%PrevBlAirfoilCom(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 - ReKiBuf(Re_Xferred) = InData%LSShftFxa - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%LSShftFys - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%LSShftFzs - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%LidSpeed) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LidSpeed,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LidSpeed,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LidSpeed,1), UBOUND(InData%LidSpeed,1) - ReKiBuf(Re_Xferred) = InData%LidSpeed(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%MsrPositionsX) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MsrPositionsX,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MsrPositionsX,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%MsrPositionsX,1), UBOUND(InData%MsrPositionsX,1) - ReKiBuf(Re_Xferred) = InData%MsrPositionsX(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%MsrPositionsY) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MsrPositionsY,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MsrPositionsY,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%MsrPositionsY,1), UBOUND(InData%MsrPositionsY,1) - ReKiBuf(Re_Xferred) = InData%MsrPositionsY(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%MsrPositionsZ) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MsrPositionsZ,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MsrPositionsZ,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%MsrPositionsZ,1), UBOUND(InData%MsrPositionsZ,1) - ReKiBuf(Re_Xferred) = InData%MsrPositionsZ(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%SensorType - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumBeam - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumPulseGate - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%PulseSpacing - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%URefLid - Int_Xferred = Int_Xferred + 1 - 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 - IF ( .NOT. ALLOCATED(InData%PrevCableDeltaL) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PrevCableDeltaL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PrevCableDeltaL,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PrevCableDeltaL,1), UBOUND(InData%PrevCableDeltaL,1) - ReKiBuf(Re_Xferred) = InData%PrevCableDeltaL(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PrevCableDeltaLdot) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PrevCableDeltaLdot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PrevCableDeltaLdot,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PrevCableDeltaLdot,1), UBOUND(InData%PrevCableDeltaLdot,1) - ReKiBuf(Re_Xferred) = InData%PrevCableDeltaLdot(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - 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 - IF ( .NOT. ALLOCATED(InData%CableDeltaLdot) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CableDeltaLdot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CableDeltaLdot,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%CableDeltaLdot,1), UBOUND(InData%CableDeltaLdot,1) - ReKiBuf(Re_Xferred) = InData%CableDeltaLdot(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PrevStCCmdStiff) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PrevStCCmdStiff,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PrevStCCmdStiff,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PrevStCCmdStiff,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PrevStCCmdStiff,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PrevStCCmdStiff,2), UBOUND(InData%PrevStCCmdStiff,2) - DO i1 = LBOUND(InData%PrevStCCmdStiff,1), UBOUND(InData%PrevStCCmdStiff,1) - ReKiBuf(Re_Xferred) = InData%PrevStCCmdStiff(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PrevStCCmdDamp) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PrevStCCmdDamp,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PrevStCCmdDamp,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PrevStCCmdDamp,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PrevStCCmdDamp,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PrevStCCmdDamp,2), UBOUND(InData%PrevStCCmdDamp,2) - DO i1 = LBOUND(InData%PrevStCCmdDamp,1), UBOUND(InData%PrevStCCmdDamp,1) - ReKiBuf(Re_Xferred) = InData%PrevStCCmdDamp(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PrevStCCmdBrake) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PrevStCCmdBrake,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PrevStCCmdBrake,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PrevStCCmdBrake,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PrevStCCmdBrake,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PrevStCCmdBrake,2), UBOUND(InData%PrevStCCmdBrake,2) - DO i1 = LBOUND(InData%PrevStCCmdBrake,1), UBOUND(InData%PrevStCCmdBrake,1) - ReKiBuf(Re_Xferred) = InData%PrevStCCmdBrake(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PrevStCCmdForce) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PrevStCCmdForce,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PrevStCCmdForce,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PrevStCCmdForce,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PrevStCCmdForce,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PrevStCCmdForce,2), UBOUND(InData%PrevStCCmdForce,2) - DO i1 = LBOUND(InData%PrevStCCmdForce,1), UBOUND(InData%PrevStCCmdForce,1) - ReKiBuf(Re_Xferred) = InData%PrevStCCmdForce(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%StCCmdStiff) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StCCmdStiff,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StCCmdStiff,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StCCmdStiff,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StCCmdStiff,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%StCCmdStiff,2), UBOUND(InData%StCCmdStiff,2) - DO i1 = LBOUND(InData%StCCmdStiff,1), UBOUND(InData%StCCmdStiff,1) - ReKiBuf(Re_Xferred) = InData%StCCmdStiff(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%StCCmdDamp) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StCCmdDamp,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StCCmdDamp,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StCCmdDamp,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StCCmdDamp,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%StCCmdDamp,2), UBOUND(InData%StCCmdDamp,2) - DO i1 = LBOUND(InData%StCCmdDamp,1), UBOUND(InData%StCCmdDamp,1) - ReKiBuf(Re_Xferred) = InData%StCCmdDamp(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%StCCmdBrake) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StCCmdBrake,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StCCmdBrake,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StCCmdBrake,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StCCmdBrake,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%StCCmdBrake,2), UBOUND(InData%StCCmdBrake,2) - DO i1 = LBOUND(InData%StCCmdBrake,1), UBOUND(InData%StCCmdBrake,1) - ReKiBuf(Re_Xferred) = InData%StCCmdBrake(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%StCCmdForce) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StCCmdForce,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StCCmdForce,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StCCmdForce,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StCCmdForce,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%StCCmdForce,2), UBOUND(InData%StCCmdForce,2) - DO i1 = LBOUND(InData%StCCmdForce,1), UBOUND(InData%StCCmdForce,1) - ReKiBuf(Re_Xferred) = InData%StCCmdForce(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%StCMeasDisp) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StCMeasDisp,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StCMeasDisp,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StCMeasDisp,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StCMeasDisp,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%StCMeasDisp,2), UBOUND(InData%StCMeasDisp,2) - DO i1 = LBOUND(InData%StCMeasDisp,1), UBOUND(InData%StCMeasDisp,1) - ReKiBuf(Re_Xferred) = InData%StCMeasDisp(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%StCMeasVel) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StCMeasVel,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StCMeasVel,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StCMeasVel,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StCMeasVel,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%StCMeasVel,2), UBOUND(InData%StCMeasVel,2) - DO i1 = LBOUND(InData%StCMeasVel,1), UBOUND(InData%StCMeasVel,1) - ReKiBuf(Re_Xferred) = InData%StCMeasVel(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - 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) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - 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 - i1_l = LBOUND(OutData%PrevBlAirfoilCom,1) - i1_u = UBOUND(OutData%PrevBlAirfoilCom,1) - DO i1 = LBOUND(OutData%PrevBlAirfoilCom,1), UBOUND(OutData%PrevBlAirfoilCom,1) - OutData%PrevBlAirfoilCom(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%LSShftFxa = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%LSShftFys = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%LSShftFzs = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LidSpeed not allocated - Int_Xferred = Int_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%LidSpeed)) DEALLOCATE(OutData%LidSpeed) - ALLOCATE(OutData%LidSpeed(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LidSpeed.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LidSpeed,1), UBOUND(OutData%LidSpeed,1) - OutData%LidSpeed(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MsrPositionsX not allocated - Int_Xferred = Int_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%MsrPositionsX)) DEALLOCATE(OutData%MsrPositionsX) - ALLOCATE(OutData%MsrPositionsX(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MsrPositionsX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%MsrPositionsX,1), UBOUND(OutData%MsrPositionsX,1) - OutData%MsrPositionsX(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MsrPositionsY not allocated - Int_Xferred = Int_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%MsrPositionsY)) DEALLOCATE(OutData%MsrPositionsY) - ALLOCATE(OutData%MsrPositionsY(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MsrPositionsY.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%MsrPositionsY,1), UBOUND(OutData%MsrPositionsY,1) - OutData%MsrPositionsY(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MsrPositionsZ not allocated - Int_Xferred = Int_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%MsrPositionsZ)) DEALLOCATE(OutData%MsrPositionsZ) - ALLOCATE(OutData%MsrPositionsZ(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MsrPositionsZ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%MsrPositionsZ,1), UBOUND(OutData%MsrPositionsZ,1) - OutData%MsrPositionsZ(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%SensorType = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumBeam = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumPulseGate = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%PulseSpacing = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%URefLid = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - 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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PrevCableDeltaL not allocated - Int_Xferred = Int_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%PrevCableDeltaL)) DEALLOCATE(OutData%PrevCableDeltaL) - ALLOCATE(OutData%PrevCableDeltaL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PrevCableDeltaL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PrevCableDeltaL,1), UBOUND(OutData%PrevCableDeltaL,1) - OutData%PrevCableDeltaL(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PrevCableDeltaLdot not allocated - Int_Xferred = Int_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%PrevCableDeltaLdot)) DEALLOCATE(OutData%PrevCableDeltaLdot) - ALLOCATE(OutData%PrevCableDeltaLdot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PrevCableDeltaLdot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PrevCableDeltaLdot,1), UBOUND(OutData%PrevCableDeltaLdot,1) - OutData%PrevCableDeltaLdot(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - 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) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CableDeltaLdot not allocated - Int_Xferred = Int_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%CableDeltaLdot)) DEALLOCATE(OutData%CableDeltaLdot) - ALLOCATE(OutData%CableDeltaLdot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CableDeltaLdot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%CableDeltaLdot,1), UBOUND(OutData%CableDeltaLdot,1) - OutData%CableDeltaLdot(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PrevStCCmdStiff not allocated - Int_Xferred = Int_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%PrevStCCmdStiff)) DEALLOCATE(OutData%PrevStCCmdStiff) - ALLOCATE(OutData%PrevStCCmdStiff(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PrevStCCmdStiff.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PrevStCCmdStiff,2), UBOUND(OutData%PrevStCCmdStiff,2) - DO i1 = LBOUND(OutData%PrevStCCmdStiff,1), UBOUND(OutData%PrevStCCmdStiff,1) - OutData%PrevStCCmdStiff(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PrevStCCmdDamp not allocated - Int_Xferred = Int_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%PrevStCCmdDamp)) DEALLOCATE(OutData%PrevStCCmdDamp) - ALLOCATE(OutData%PrevStCCmdDamp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PrevStCCmdDamp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PrevStCCmdDamp,2), UBOUND(OutData%PrevStCCmdDamp,2) - DO i1 = LBOUND(OutData%PrevStCCmdDamp,1), UBOUND(OutData%PrevStCCmdDamp,1) - OutData%PrevStCCmdDamp(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PrevStCCmdBrake not allocated - Int_Xferred = Int_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%PrevStCCmdBrake)) DEALLOCATE(OutData%PrevStCCmdBrake) - ALLOCATE(OutData%PrevStCCmdBrake(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PrevStCCmdBrake.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PrevStCCmdBrake,2), UBOUND(OutData%PrevStCCmdBrake,2) - DO i1 = LBOUND(OutData%PrevStCCmdBrake,1), UBOUND(OutData%PrevStCCmdBrake,1) - OutData%PrevStCCmdBrake(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PrevStCCmdForce not allocated - Int_Xferred = Int_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%PrevStCCmdForce)) DEALLOCATE(OutData%PrevStCCmdForce) - ALLOCATE(OutData%PrevStCCmdForce(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PrevStCCmdForce.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PrevStCCmdForce,2), UBOUND(OutData%PrevStCCmdForce,2) - DO i1 = LBOUND(OutData%PrevStCCmdForce,1), UBOUND(OutData%PrevStCCmdForce,1) - OutData%PrevStCCmdForce(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StCCmdStiff not allocated - Int_Xferred = Int_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%StCCmdStiff)) DEALLOCATE(OutData%StCCmdStiff) - ALLOCATE(OutData%StCCmdStiff(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StCCmdStiff.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%StCCmdStiff,2), UBOUND(OutData%StCCmdStiff,2) - DO i1 = LBOUND(OutData%StCCmdStiff,1), UBOUND(OutData%StCCmdStiff,1) - OutData%StCCmdStiff(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StCCmdDamp not allocated - Int_Xferred = Int_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%StCCmdDamp)) DEALLOCATE(OutData%StCCmdDamp) - ALLOCATE(OutData%StCCmdDamp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StCCmdDamp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%StCCmdDamp,2), UBOUND(OutData%StCCmdDamp,2) - DO i1 = LBOUND(OutData%StCCmdDamp,1), UBOUND(OutData%StCCmdDamp,1) - OutData%StCCmdDamp(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StCCmdBrake not allocated - Int_Xferred = Int_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%StCCmdBrake)) DEALLOCATE(OutData%StCCmdBrake) - ALLOCATE(OutData%StCCmdBrake(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StCCmdBrake.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%StCCmdBrake,2), UBOUND(OutData%StCCmdBrake,2) - DO i1 = LBOUND(OutData%StCCmdBrake,1), UBOUND(OutData%StCCmdBrake,1) - OutData%StCCmdBrake(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StCCmdForce not allocated - Int_Xferred = Int_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%StCCmdForce)) DEALLOCATE(OutData%StCCmdForce) - ALLOCATE(OutData%StCCmdForce(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StCCmdForce.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%StCCmdForce,2), UBOUND(OutData%StCCmdForce,2) - DO i1 = LBOUND(OutData%StCCmdForce,1), UBOUND(OutData%StCCmdForce,1) - OutData%StCCmdForce(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StCMeasDisp not allocated - Int_Xferred = Int_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%StCMeasDisp)) DEALLOCATE(OutData%StCMeasDisp) - ALLOCATE(OutData%StCMeasDisp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StCMeasDisp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%StCMeasDisp,2), UBOUND(OutData%StCMeasDisp,2) - DO i1 = LBOUND(OutData%StCMeasDisp,1), UBOUND(OutData%StCMeasDisp,1) - OutData%StCMeasDisp(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StCMeasVel not allocated - Int_Xferred = Int_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%StCMeasVel)) DEALLOCATE(OutData%StCMeasVel) - ALLOCATE(OutData%StCMeasVel(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StCMeasVel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%StCMeasVel,2), UBOUND(OutData%StCMeasVel,2) - DO i1 = LBOUND(OutData%StCMeasVel,1), UBOUND(OutData%StCMeasVel,1) - OutData%StCMeasVel(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - 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, DEALLOCATEpointers ) - TYPE(SrvD_ContinuousStateType), INTENT(INOUT) :: ContStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_DestroyContState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(ContStateData%BStC)) THEN -DO i1 = LBOUND(ContStateData%BStC,1), UBOUND(ContStateData%BStC,1) - CALL StC_DestroyContState( ContStateData%BStC(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -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), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -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), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -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), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -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, DEALLOCATEpointers ) - TYPE(SrvD_DiscreteStateType), INTENT(INOUT) :: DiscStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_DestroyDiscState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(DiscStateData%BStC)) THEN -DO i1 = LBOUND(DiscStateData%BStC,1), UBOUND(DiscStateData%BStC,1) - CALL StC_DestroyDiscState( DiscStateData%BStC(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -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), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -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), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -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), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -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, DEALLOCATEpointers ) - TYPE(SrvD_ConstraintStateType), INTENT(INOUT) :: ConstrStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_DestroyConstrState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(ConstrStateData%BStC)) THEN -DO i1 = LBOUND(ConstrStateData%BStC,1), UBOUND(ConstrStateData%BStC,1) - CALL StC_DestroyConstrState( ConstrStateData%BStC(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -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), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -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), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -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), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -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, DEALLOCATEpointers ) - TYPE(SrvD_OtherStateType), INTENT(INOUT) :: OtherStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_DestroyOtherState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -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), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -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), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -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), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -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), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -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_CopyModuleMapType( SrcModuleMapTypeData, DstModuleMapTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SrvD_ModuleMapType), INTENT(INOUT) :: SrcModuleMapTypeData - TYPE(SrvD_ModuleMapType), INTENT(INOUT) :: DstModuleMapTypeData - 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 = 'SrvD_CopyModuleMapType' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcModuleMapTypeData%u_BStC_Mot2_BStC)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%u_BStC_Mot2_BStC,1) - i1_u = UBOUND(SrcModuleMapTypeData%u_BStC_Mot2_BStC,1) - i2_l = LBOUND(SrcModuleMapTypeData%u_BStC_Mot2_BStC,2) - i2_u = UBOUND(SrcModuleMapTypeData%u_BStC_Mot2_BStC,2) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%u_BStC_Mot2_BStC)) THEN - ALLOCATE(DstModuleMapTypeData%u_BStC_Mot2_BStC(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%u_BStC_Mot2_BStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcModuleMapTypeData%u_BStC_Mot2_BStC,2), UBOUND(SrcModuleMapTypeData%u_BStC_Mot2_BStC,2) - DO i1 = LBOUND(SrcModuleMapTypeData%u_BStC_Mot2_BStC,1), UBOUND(SrcModuleMapTypeData%u_BStC_Mot2_BStC,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%u_BStC_Mot2_BStC(i1,i2), DstModuleMapTypeData%u_BStC_Mot2_BStC(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcModuleMapTypeData%u_NStC_Mot2_NStC)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%u_NStC_Mot2_NStC,1) - i1_u = UBOUND(SrcModuleMapTypeData%u_NStC_Mot2_NStC,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%u_NStC_Mot2_NStC)) THEN - ALLOCATE(DstModuleMapTypeData%u_NStC_Mot2_NStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%u_NStC_Mot2_NStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcModuleMapTypeData%u_NStC_Mot2_NStC,1), UBOUND(SrcModuleMapTypeData%u_NStC_Mot2_NStC,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%u_NStC_Mot2_NStC(i1), DstModuleMapTypeData%u_NStC_Mot2_NStC(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcModuleMapTypeData%u_TStC_Mot2_TStC)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%u_TStC_Mot2_TStC,1) - i1_u = UBOUND(SrcModuleMapTypeData%u_TStC_Mot2_TStC,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%u_TStC_Mot2_TStC)) THEN - ALLOCATE(DstModuleMapTypeData%u_TStC_Mot2_TStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%u_TStC_Mot2_TStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcModuleMapTypeData%u_TStC_Mot2_TStC,1), UBOUND(SrcModuleMapTypeData%u_TStC_Mot2_TStC,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%u_TStC_Mot2_TStC(i1), DstModuleMapTypeData%u_TStC_Mot2_TStC(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcModuleMapTypeData%u_SStC_Mot2_SStC)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%u_SStC_Mot2_SStC,1) - i1_u = UBOUND(SrcModuleMapTypeData%u_SStC_Mot2_SStC,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%u_SStC_Mot2_SStC)) THEN - ALLOCATE(DstModuleMapTypeData%u_SStC_Mot2_SStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%u_SStC_Mot2_SStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcModuleMapTypeData%u_SStC_Mot2_SStC,1), UBOUND(SrcModuleMapTypeData%u_SStC_Mot2_SStC,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%u_SStC_Mot2_SStC(i1), DstModuleMapTypeData%u_SStC_Mot2_SStC(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcModuleMapTypeData%BStC_Frc2_y_BStC)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%BStC_Frc2_y_BStC,1) - i1_u = UBOUND(SrcModuleMapTypeData%BStC_Frc2_y_BStC,1) - i2_l = LBOUND(SrcModuleMapTypeData%BStC_Frc2_y_BStC,2) - i2_u = UBOUND(SrcModuleMapTypeData%BStC_Frc2_y_BStC,2) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%BStC_Frc2_y_BStC)) THEN - ALLOCATE(DstModuleMapTypeData%BStC_Frc2_y_BStC(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%BStC_Frc2_y_BStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcModuleMapTypeData%BStC_Frc2_y_BStC,2), UBOUND(SrcModuleMapTypeData%BStC_Frc2_y_BStC,2) - DO i1 = LBOUND(SrcModuleMapTypeData%BStC_Frc2_y_BStC,1), UBOUND(SrcModuleMapTypeData%BStC_Frc2_y_BStC,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%BStC_Frc2_y_BStC(i1,i2), DstModuleMapTypeData%BStC_Frc2_y_BStC(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcModuleMapTypeData%NStC_Frc2_y_NStC)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%NStC_Frc2_y_NStC,1) - i1_u = UBOUND(SrcModuleMapTypeData%NStC_Frc2_y_NStC,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%NStC_Frc2_y_NStC)) THEN - ALLOCATE(DstModuleMapTypeData%NStC_Frc2_y_NStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%NStC_Frc2_y_NStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcModuleMapTypeData%NStC_Frc2_y_NStC,1), UBOUND(SrcModuleMapTypeData%NStC_Frc2_y_NStC,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%NStC_Frc2_y_NStC(i1), DstModuleMapTypeData%NStC_Frc2_y_NStC(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcModuleMapTypeData%TStC_Frc2_y_TStC)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%TStC_Frc2_y_TStC,1) - i1_u = UBOUND(SrcModuleMapTypeData%TStC_Frc2_y_TStC,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%TStC_Frc2_y_TStC)) THEN - ALLOCATE(DstModuleMapTypeData%TStC_Frc2_y_TStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%TStC_Frc2_y_TStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcModuleMapTypeData%TStC_Frc2_y_TStC,1), UBOUND(SrcModuleMapTypeData%TStC_Frc2_y_TStC,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%TStC_Frc2_y_TStC(i1), DstModuleMapTypeData%TStC_Frc2_y_TStC(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcModuleMapTypeData%SStC_Frc2_y_SStC)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%SStC_Frc2_y_SStC,1) - i1_u = UBOUND(SrcModuleMapTypeData%SStC_Frc2_y_SStC,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%SStC_Frc2_y_SStC)) THEN - ALLOCATE(DstModuleMapTypeData%SStC_Frc2_y_SStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%SStC_Frc2_y_SStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcModuleMapTypeData%SStC_Frc2_y_SStC,1), UBOUND(SrcModuleMapTypeData%SStC_Frc2_y_SStC,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%SStC_Frc2_y_SStC(i1), DstModuleMapTypeData%SStC_Frc2_y_SStC(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - END SUBROUTINE SrvD_CopyModuleMapType - - SUBROUTINE SrvD_DestroyModuleMapType( ModuleMapTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(SrvD_ModuleMapType), INTENT(INOUT) :: ModuleMapTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_DestroyModuleMapType' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(ModuleMapTypeData%u_BStC_Mot2_BStC)) THEN -DO i2 = LBOUND(ModuleMapTypeData%u_BStC_Mot2_BStC,2), UBOUND(ModuleMapTypeData%u_BStC_Mot2_BStC,2) -DO i1 = LBOUND(ModuleMapTypeData%u_BStC_Mot2_BStC,1), UBOUND(ModuleMapTypeData%u_BStC_Mot2_BStC,1) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%u_BStC_Mot2_BStC(i1,i2), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO - DEALLOCATE(ModuleMapTypeData%u_BStC_Mot2_BStC) -ENDIF -IF (ALLOCATED(ModuleMapTypeData%u_NStC_Mot2_NStC)) THEN -DO i1 = LBOUND(ModuleMapTypeData%u_NStC_Mot2_NStC,1), UBOUND(ModuleMapTypeData%u_NStC_Mot2_NStC,1) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%u_NStC_Mot2_NStC(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ModuleMapTypeData%u_NStC_Mot2_NStC) -ENDIF -IF (ALLOCATED(ModuleMapTypeData%u_TStC_Mot2_TStC)) THEN -DO i1 = LBOUND(ModuleMapTypeData%u_TStC_Mot2_TStC,1), UBOUND(ModuleMapTypeData%u_TStC_Mot2_TStC,1) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%u_TStC_Mot2_TStC(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ModuleMapTypeData%u_TStC_Mot2_TStC) -ENDIF -IF (ALLOCATED(ModuleMapTypeData%u_SStC_Mot2_SStC)) THEN -DO i1 = LBOUND(ModuleMapTypeData%u_SStC_Mot2_SStC,1), UBOUND(ModuleMapTypeData%u_SStC_Mot2_SStC,1) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%u_SStC_Mot2_SStC(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ModuleMapTypeData%u_SStC_Mot2_SStC) -ENDIF -IF (ALLOCATED(ModuleMapTypeData%BStC_Frc2_y_BStC)) THEN -DO i2 = LBOUND(ModuleMapTypeData%BStC_Frc2_y_BStC,2), UBOUND(ModuleMapTypeData%BStC_Frc2_y_BStC,2) -DO i1 = LBOUND(ModuleMapTypeData%BStC_Frc2_y_BStC,1), UBOUND(ModuleMapTypeData%BStC_Frc2_y_BStC,1) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%BStC_Frc2_y_BStC(i1,i2), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO - DEALLOCATE(ModuleMapTypeData%BStC_Frc2_y_BStC) -ENDIF -IF (ALLOCATED(ModuleMapTypeData%NStC_Frc2_y_NStC)) THEN -DO i1 = LBOUND(ModuleMapTypeData%NStC_Frc2_y_NStC,1), UBOUND(ModuleMapTypeData%NStC_Frc2_y_NStC,1) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%NStC_Frc2_y_NStC(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ModuleMapTypeData%NStC_Frc2_y_NStC) -ENDIF -IF (ALLOCATED(ModuleMapTypeData%TStC_Frc2_y_TStC)) THEN -DO i1 = LBOUND(ModuleMapTypeData%TStC_Frc2_y_TStC,1), UBOUND(ModuleMapTypeData%TStC_Frc2_y_TStC,1) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%TStC_Frc2_y_TStC(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ModuleMapTypeData%TStC_Frc2_y_TStC) -ENDIF -IF (ALLOCATED(ModuleMapTypeData%SStC_Frc2_y_SStC)) THEN -DO i1 = LBOUND(ModuleMapTypeData%SStC_Frc2_y_SStC,1), UBOUND(ModuleMapTypeData%SStC_Frc2_y_SStC,1) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%SStC_Frc2_y_SStC(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ModuleMapTypeData%SStC_Frc2_y_SStC) -ENDIF - END SUBROUTINE SrvD_DestroyModuleMapType - - SUBROUTINE SrvD_PackModuleMapType( 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_ModuleMapType), 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_PackModuleMapType' - ! 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_BStC_Mot2_BStC allocated yes/no - IF ( ALLOCATED(InData%u_BStC_Mot2_BStC) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! u_BStC_Mot2_BStC upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i2 = LBOUND(InData%u_BStC_Mot2_BStC,2), UBOUND(InData%u_BStC_Mot2_BStC,2) - DO i1 = LBOUND(InData%u_BStC_Mot2_BStC,1), UBOUND(InData%u_BStC_Mot2_BStC,1) - Int_BufSz = Int_BufSz + 3 ! u_BStC_Mot2_BStC: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%u_BStC_Mot2_BStC(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! u_BStC_Mot2_BStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_BStC_Mot2_BStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_BStC_Mot2_BStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_BStC_Mot2_BStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! u_NStC_Mot2_NStC allocated yes/no - IF ( ALLOCATED(InData%u_NStC_Mot2_NStC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! u_NStC_Mot2_NStC upper/lower bounds for each dimension - DO i1 = LBOUND(InData%u_NStC_Mot2_NStC,1), UBOUND(InData%u_NStC_Mot2_NStC,1) - Int_BufSz = Int_BufSz + 3 ! u_NStC_Mot2_NStC: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%u_NStC_Mot2_NStC(i1), ErrStat2, ErrMsg2, .TRUE. ) ! u_NStC_Mot2_NStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_NStC_Mot2_NStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_NStC_Mot2_NStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_NStC_Mot2_NStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! u_TStC_Mot2_TStC allocated yes/no - IF ( ALLOCATED(InData%u_TStC_Mot2_TStC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! u_TStC_Mot2_TStC upper/lower bounds for each dimension - DO i1 = LBOUND(InData%u_TStC_Mot2_TStC,1), UBOUND(InData%u_TStC_Mot2_TStC,1) - Int_BufSz = Int_BufSz + 3 ! u_TStC_Mot2_TStC: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%u_TStC_Mot2_TStC(i1), ErrStat2, ErrMsg2, .TRUE. ) ! u_TStC_Mot2_TStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_TStC_Mot2_TStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_TStC_Mot2_TStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_TStC_Mot2_TStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! u_SStC_Mot2_SStC allocated yes/no - IF ( ALLOCATED(InData%u_SStC_Mot2_SStC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! u_SStC_Mot2_SStC upper/lower bounds for each dimension - DO i1 = LBOUND(InData%u_SStC_Mot2_SStC,1), UBOUND(InData%u_SStC_Mot2_SStC,1) - Int_BufSz = Int_BufSz + 3 ! u_SStC_Mot2_SStC: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%u_SStC_Mot2_SStC(i1), ErrStat2, ErrMsg2, .TRUE. ) ! u_SStC_Mot2_SStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_SStC_Mot2_SStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_SStC_Mot2_SStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_SStC_Mot2_SStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! BStC_Frc2_y_BStC allocated yes/no - IF ( ALLOCATED(InData%BStC_Frc2_y_BStC) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BStC_Frc2_y_BStC upper/lower bounds for each dimension - DO i2 = LBOUND(InData%BStC_Frc2_y_BStC,2), UBOUND(InData%BStC_Frc2_y_BStC,2) - DO i1 = LBOUND(InData%BStC_Frc2_y_BStC,1), UBOUND(InData%BStC_Frc2_y_BStC,1) - Int_BufSz = Int_BufSz + 3 ! BStC_Frc2_y_BStC: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%BStC_Frc2_y_BStC(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! BStC_Frc2_y_BStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BStC_Frc2_y_BStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BStC_Frc2_y_BStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BStC_Frc2_y_BStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! NStC_Frc2_y_NStC allocated yes/no - IF ( ALLOCATED(InData%NStC_Frc2_y_NStC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! NStC_Frc2_y_NStC upper/lower bounds for each dimension - DO i1 = LBOUND(InData%NStC_Frc2_y_NStC,1), UBOUND(InData%NStC_Frc2_y_NStC,1) - Int_BufSz = Int_BufSz + 3 ! NStC_Frc2_y_NStC: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%NStC_Frc2_y_NStC(i1), ErrStat2, ErrMsg2, .TRUE. ) ! NStC_Frc2_y_NStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! NStC_Frc2_y_NStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! NStC_Frc2_y_NStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! NStC_Frc2_y_NStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! TStC_Frc2_y_TStC allocated yes/no - IF ( ALLOCATED(InData%TStC_Frc2_y_TStC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TStC_Frc2_y_TStC upper/lower bounds for each dimension - DO i1 = LBOUND(InData%TStC_Frc2_y_TStC,1), UBOUND(InData%TStC_Frc2_y_TStC,1) - Int_BufSz = Int_BufSz + 3 ! TStC_Frc2_y_TStC: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%TStC_Frc2_y_TStC(i1), ErrStat2, ErrMsg2, .TRUE. ) ! TStC_Frc2_y_TStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! TStC_Frc2_y_TStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! TStC_Frc2_y_TStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! TStC_Frc2_y_TStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! SStC_Frc2_y_SStC allocated yes/no - IF ( ALLOCATED(InData%SStC_Frc2_y_SStC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! SStC_Frc2_y_SStC upper/lower bounds for each dimension - DO i1 = LBOUND(InData%SStC_Frc2_y_SStC,1), UBOUND(InData%SStC_Frc2_y_SStC,1) - Int_BufSz = Int_BufSz + 3 ! SStC_Frc2_y_SStC: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%SStC_Frc2_y_SStC(i1), ErrStat2, ErrMsg2, .TRUE. ) ! SStC_Frc2_y_SStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SStC_Frc2_y_SStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SStC_Frc2_y_SStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SStC_Frc2_y_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%u_BStC_Mot2_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%u_BStC_Mot2_BStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_BStC_Mot2_BStC,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%u_BStC_Mot2_BStC,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_BStC_Mot2_BStC,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%u_BStC_Mot2_BStC,2), UBOUND(InData%u_BStC_Mot2_BStC,2) - DO i1 = LBOUND(InData%u_BStC_Mot2_BStC,1), UBOUND(InData%u_BStC_Mot2_BStC,1) - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%u_BStC_Mot2_BStC(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! u_BStC_Mot2_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 DO - END IF - IF ( .NOT. ALLOCATED(InData%u_NStC_Mot2_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%u_NStC_Mot2_NStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_NStC_Mot2_NStC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%u_NStC_Mot2_NStC,1), UBOUND(InData%u_NStC_Mot2_NStC,1) - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%u_NStC_Mot2_NStC(i1), ErrStat2, ErrMsg2, OnlySize ) ! u_NStC_Mot2_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%u_TStC_Mot2_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%u_TStC_Mot2_TStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_TStC_Mot2_TStC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%u_TStC_Mot2_TStC,1), UBOUND(InData%u_TStC_Mot2_TStC,1) - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%u_TStC_Mot2_TStC(i1), ErrStat2, ErrMsg2, OnlySize ) ! u_TStC_Mot2_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%u_SStC_Mot2_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%u_SStC_Mot2_SStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_SStC_Mot2_SStC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%u_SStC_Mot2_SStC,1), UBOUND(InData%u_SStC_Mot2_SStC,1) - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%u_SStC_Mot2_SStC(i1), ErrStat2, ErrMsg2, OnlySize ) ! u_SStC_Mot2_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%BStC_Frc2_y_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_Frc2_y_BStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BStC_Frc2_y_BStC,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BStC_Frc2_y_BStC,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BStC_Frc2_y_BStC,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%BStC_Frc2_y_BStC,2), UBOUND(InData%BStC_Frc2_y_BStC,2) - DO i1 = LBOUND(InData%BStC_Frc2_y_BStC,1), UBOUND(InData%BStC_Frc2_y_BStC,1) - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%BStC_Frc2_y_BStC(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! BStC_Frc2_y_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 DO - END IF - IF ( .NOT. ALLOCATED(InData%NStC_Frc2_y_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_Frc2_y_NStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NStC_Frc2_y_NStC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%NStC_Frc2_y_NStC,1), UBOUND(InData%NStC_Frc2_y_NStC,1) - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%NStC_Frc2_y_NStC(i1), ErrStat2, ErrMsg2, OnlySize ) ! NStC_Frc2_y_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_Frc2_y_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_Frc2_y_TStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TStC_Frc2_y_TStC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TStC_Frc2_y_TStC,1), UBOUND(InData%TStC_Frc2_y_TStC,1) - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%TStC_Frc2_y_TStC(i1), ErrStat2, ErrMsg2, OnlySize ) ! TStC_Frc2_y_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_Frc2_y_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_Frc2_y_SStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SStC_Frc2_y_SStC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%SStC_Frc2_y_SStC,1), UBOUND(InData%SStC_Frc2_y_SStC,1) - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%SStC_Frc2_y_SStC(i1), ErrStat2, ErrMsg2, OnlySize ) ! SStC_Frc2_y_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_PackModuleMapType - - SUBROUTINE SrvD_UnPackModuleMapType( 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_ModuleMapType), 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 = 'SrvD_UnPackModuleMapType' - ! 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_BStC_Mot2_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 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%u_BStC_Mot2_BStC)) DEALLOCATE(OutData%u_BStC_Mot2_BStC) - ALLOCATE(OutData%u_BStC_Mot2_BStC(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_BStC_Mot2_BStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%u_BStC_Mot2_BStC,2), UBOUND(OutData%u_BStC_Mot2_BStC,2) - DO i1 = LBOUND(OutData%u_BStC_Mot2_BStC,1), UBOUND(OutData%u_BStC_Mot2_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 NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%u_BStC_Mot2_BStC(i1,i2), ErrStat2, ErrMsg2 ) ! u_BStC_Mot2_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 DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! u_NStC_Mot2_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%u_NStC_Mot2_NStC)) DEALLOCATE(OutData%u_NStC_Mot2_NStC) - ALLOCATE(OutData%u_NStC_Mot2_NStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_NStC_Mot2_NStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%u_NStC_Mot2_NStC,1), UBOUND(OutData%u_NStC_Mot2_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 NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%u_NStC_Mot2_NStC(i1), ErrStat2, ErrMsg2 ) ! u_NStC_Mot2_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 ! u_TStC_Mot2_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%u_TStC_Mot2_TStC)) DEALLOCATE(OutData%u_TStC_Mot2_TStC) - ALLOCATE(OutData%u_TStC_Mot2_TStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_TStC_Mot2_TStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%u_TStC_Mot2_TStC,1), UBOUND(OutData%u_TStC_Mot2_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 NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%u_TStC_Mot2_TStC(i1), ErrStat2, ErrMsg2 ) ! u_TStC_Mot2_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 ! u_SStC_Mot2_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%u_SStC_Mot2_SStC)) DEALLOCATE(OutData%u_SStC_Mot2_SStC) - ALLOCATE(OutData%u_SStC_Mot2_SStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_SStC_Mot2_SStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%u_SStC_Mot2_SStC,1), UBOUND(OutData%u_SStC_Mot2_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 NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%u_SStC_Mot2_SStC(i1), ErrStat2, ErrMsg2 ) ! u_SStC_Mot2_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 ! BStC_Frc2_y_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 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BStC_Frc2_y_BStC)) DEALLOCATE(OutData%BStC_Frc2_y_BStC) - ALLOCATE(OutData%BStC_Frc2_y_BStC(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BStC_Frc2_y_BStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%BStC_Frc2_y_BStC,2), UBOUND(OutData%BStC_Frc2_y_BStC,2) - DO i1 = LBOUND(OutData%BStC_Frc2_y_BStC,1), UBOUND(OutData%BStC_Frc2_y_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 NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%BStC_Frc2_y_BStC(i1,i2), ErrStat2, ErrMsg2 ) ! BStC_Frc2_y_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 DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NStC_Frc2_y_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_Frc2_y_NStC)) DEALLOCATE(OutData%NStC_Frc2_y_NStC) - ALLOCATE(OutData%NStC_Frc2_y_NStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NStC_Frc2_y_NStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%NStC_Frc2_y_NStC,1), UBOUND(OutData%NStC_Frc2_y_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 NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%NStC_Frc2_y_NStC(i1), ErrStat2, ErrMsg2 ) ! NStC_Frc2_y_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_Frc2_y_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_Frc2_y_TStC)) DEALLOCATE(OutData%TStC_Frc2_y_TStC) - ALLOCATE(OutData%TStC_Frc2_y_TStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TStC_Frc2_y_TStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TStC_Frc2_y_TStC,1), UBOUND(OutData%TStC_Frc2_y_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 NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%TStC_Frc2_y_TStC(i1), ErrStat2, ErrMsg2 ) ! TStC_Frc2_y_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_Frc2_y_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_Frc2_y_SStC)) DEALLOCATE(OutData%SStC_Frc2_y_SStC) - ALLOCATE(OutData%SStC_Frc2_y_SStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SStC_Frc2_y_SStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%SStC_Frc2_y_SStC,1), UBOUND(OutData%SStC_Frc2_y_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 NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%SStC_Frc2_y_SStC(i1), ErrStat2, ErrMsg2 ) ! SStC_Frc2_y_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_UnPackModuleMapType - - SUBROUTINE SrvD_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SrvD_MiscVarType), INTENT(INOUT) :: 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) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - 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 -IF (ALLOCATED(SrcMiscData%u_BStC)) THEN - i1_l = LBOUND(SrcMiscData%u_BStC,1) - i1_u = UBOUND(SrcMiscData%u_BStC,1) - i2_l = LBOUND(SrcMiscData%u_BStC,2) - i2_u = UBOUND(SrcMiscData%u_BStC,2) - IF (.NOT. ALLOCATED(DstMiscData%u_BStC)) THEN - ALLOCATE(DstMiscData%u_BStC(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%u_BStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcMiscData%u_BStC,2), UBOUND(SrcMiscData%u_BStC,2) - DO i1 = LBOUND(SrcMiscData%u_BStC,1), UBOUND(SrcMiscData%u_BStC,1) - CALL StC_CopyInput( SrcMiscData%u_BStC(i1,i2), DstMiscData%u_BStC(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcMiscData%u_NStC)) THEN - i1_l = LBOUND(SrcMiscData%u_NStC,1) - i1_u = UBOUND(SrcMiscData%u_NStC,1) - i2_l = LBOUND(SrcMiscData%u_NStC,2) - i2_u = UBOUND(SrcMiscData%u_NStC,2) - IF (.NOT. ALLOCATED(DstMiscData%u_NStC)) THEN - ALLOCATE(DstMiscData%u_NStC(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%u_NStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcMiscData%u_NStC,2), UBOUND(SrcMiscData%u_NStC,2) - DO i1 = LBOUND(SrcMiscData%u_NStC,1), UBOUND(SrcMiscData%u_NStC,1) - CALL StC_CopyInput( SrcMiscData%u_NStC(i1,i2), DstMiscData%u_NStC(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcMiscData%u_TStC)) THEN - i1_l = LBOUND(SrcMiscData%u_TStC,1) - i1_u = UBOUND(SrcMiscData%u_TStC,1) - i2_l = LBOUND(SrcMiscData%u_TStC,2) - i2_u = UBOUND(SrcMiscData%u_TStC,2) - IF (.NOT. ALLOCATED(DstMiscData%u_TStC)) THEN - ALLOCATE(DstMiscData%u_TStC(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%u_TStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcMiscData%u_TStC,2), UBOUND(SrcMiscData%u_TStC,2) - DO i1 = LBOUND(SrcMiscData%u_TStC,1), UBOUND(SrcMiscData%u_TStC,1) - CALL StC_CopyInput( SrcMiscData%u_TStC(i1,i2), DstMiscData%u_TStC(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcMiscData%u_SStC)) THEN - i1_l = LBOUND(SrcMiscData%u_SStC,1) - i1_u = UBOUND(SrcMiscData%u_SStC,1) - i2_l = LBOUND(SrcMiscData%u_SStC,2) - i2_u = UBOUND(SrcMiscData%u_SStC,2) - IF (.NOT. ALLOCATED(DstMiscData%u_SStC)) THEN - ALLOCATE(DstMiscData%u_SStC(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%u_SStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcMiscData%u_SStC,2), UBOUND(SrcMiscData%u_SStC,2) - DO i1 = LBOUND(SrcMiscData%u_SStC,1), UBOUND(SrcMiscData%u_SStC,1) - CALL StC_CopyInput( SrcMiscData%u_SStC(i1,i2), DstMiscData%u_SStC(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcMiscData%y_BStC)) THEN - i1_l = LBOUND(SrcMiscData%y_BStC,1) - i1_u = UBOUND(SrcMiscData%y_BStC,1) - IF (.NOT. ALLOCATED(DstMiscData%y_BStC)) THEN - ALLOCATE(DstMiscData%y_BStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%y_BStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%y_BStC,1), UBOUND(SrcMiscData%y_BStC,1) - CALL StC_CopyOutput( SrcMiscData%y_BStC(i1), DstMiscData%y_BStC(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcMiscData%y_NStC)) THEN - i1_l = LBOUND(SrcMiscData%y_NStC,1) - i1_u = UBOUND(SrcMiscData%y_NStC,1) - IF (.NOT. ALLOCATED(DstMiscData%y_NStC)) THEN - ALLOCATE(DstMiscData%y_NStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%y_NStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%y_NStC,1), UBOUND(SrcMiscData%y_NStC,1) - CALL StC_CopyOutput( SrcMiscData%y_NStC(i1), DstMiscData%y_NStC(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcMiscData%y_TStC)) THEN - i1_l = LBOUND(SrcMiscData%y_TStC,1) - i1_u = UBOUND(SrcMiscData%y_TStC,1) - IF (.NOT. ALLOCATED(DstMiscData%y_TStC)) THEN - ALLOCATE(DstMiscData%y_TStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%y_TStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%y_TStC,1), UBOUND(SrcMiscData%y_TStC,1) - CALL StC_CopyOutput( SrcMiscData%y_TStC(i1), DstMiscData%y_TStC(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcMiscData%y_SStC)) THEN - i1_l = LBOUND(SrcMiscData%y_SStC,1) - i1_u = UBOUND(SrcMiscData%y_SStC,1) - IF (.NOT. ALLOCATED(DstMiscData%y_SStC)) THEN - ALLOCATE(DstMiscData%y_SStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%y_SStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%y_SStC,1), UBOUND(SrcMiscData%y_SStC,1) - CALL StC_CopyOutput( SrcMiscData%y_SStC(i1), DstMiscData%y_SStC(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL SrvD_Copymodulemaptype( SrcMiscData%SrvD_MeshMap, DstMiscData%SrvD_MeshMap, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstMiscData%PrevTstepNcall = SrcMiscData%PrevTstepNcall - END SUBROUTINE SrvD_CopyMisc - - SUBROUTINE SrvD_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(SrvD_MiscVarType), INTENT(INOUT) :: MiscData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_DestroyMisc' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL SrvD_Destroybladeddlltype( MiscData%dll_data, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -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), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -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), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -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), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -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), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MiscData%SStC) -ENDIF -IF (ALLOCATED(MiscData%u_BStC)) THEN -DO i2 = LBOUND(MiscData%u_BStC,2), UBOUND(MiscData%u_BStC,2) -DO i1 = LBOUND(MiscData%u_BStC,1), UBOUND(MiscData%u_BStC,1) - CALL StC_DestroyInput( MiscData%u_BStC(i1,i2), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO - DEALLOCATE(MiscData%u_BStC) -ENDIF -IF (ALLOCATED(MiscData%u_NStC)) THEN -DO i2 = LBOUND(MiscData%u_NStC,2), UBOUND(MiscData%u_NStC,2) -DO i1 = LBOUND(MiscData%u_NStC,1), UBOUND(MiscData%u_NStC,1) - CALL StC_DestroyInput( MiscData%u_NStC(i1,i2), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO - DEALLOCATE(MiscData%u_NStC) -ENDIF -IF (ALLOCATED(MiscData%u_TStC)) THEN -DO i2 = LBOUND(MiscData%u_TStC,2), UBOUND(MiscData%u_TStC,2) -DO i1 = LBOUND(MiscData%u_TStC,1), UBOUND(MiscData%u_TStC,1) - CALL StC_DestroyInput( MiscData%u_TStC(i1,i2), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO - DEALLOCATE(MiscData%u_TStC) -ENDIF -IF (ALLOCATED(MiscData%u_SStC)) THEN -DO i2 = LBOUND(MiscData%u_SStC,2), UBOUND(MiscData%u_SStC,2) -DO i1 = LBOUND(MiscData%u_SStC,1), UBOUND(MiscData%u_SStC,1) - CALL StC_DestroyInput( MiscData%u_SStC(i1,i2), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO - DEALLOCATE(MiscData%u_SStC) -ENDIF -IF (ALLOCATED(MiscData%y_BStC)) THEN -DO i1 = LBOUND(MiscData%y_BStC,1), UBOUND(MiscData%y_BStC,1) - CALL StC_DestroyOutput( MiscData%y_BStC(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MiscData%y_BStC) -ENDIF -IF (ALLOCATED(MiscData%y_NStC)) THEN -DO i1 = LBOUND(MiscData%y_NStC,1), UBOUND(MiscData%y_NStC,1) - CALL StC_DestroyOutput( MiscData%y_NStC(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MiscData%y_NStC) -ENDIF -IF (ALLOCATED(MiscData%y_TStC)) THEN -DO i1 = LBOUND(MiscData%y_TStC,1), UBOUND(MiscData%y_TStC,1) - CALL StC_DestroyOutput( MiscData%y_TStC(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MiscData%y_TStC) -ENDIF -IF (ALLOCATED(MiscData%y_SStC)) THEN -DO i1 = LBOUND(MiscData%y_SStC,1), UBOUND(MiscData%y_SStC,1) - CALL StC_DestroyOutput( MiscData%y_SStC(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MiscData%y_SStC) -ENDIF - CALL SrvD_Destroymodulemaptype( MiscData%SrvD_MeshMap, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - 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 - Int_BufSz = Int_BufSz + 1 ! u_BStC allocated yes/no - IF ( ALLOCATED(InData%u_BStC) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! u_BStC upper/lower bounds for each dimension - DO i2 = LBOUND(InData%u_BStC,2), UBOUND(InData%u_BStC,2) - DO i1 = LBOUND(InData%u_BStC,1), UBOUND(InData%u_BStC,1) - Int_BufSz = Int_BufSz + 3 ! u_BStC: size of buffers for each call to pack subtype - CALL StC_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_BStC(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! u_BStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_BStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_BStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_BStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! u_NStC allocated yes/no - IF ( ALLOCATED(InData%u_NStC) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! u_NStC upper/lower bounds for each dimension - DO i2 = LBOUND(InData%u_NStC,2), UBOUND(InData%u_NStC,2) - DO i1 = LBOUND(InData%u_NStC,1), UBOUND(InData%u_NStC,1) - Int_BufSz = Int_BufSz + 3 ! u_NStC: size of buffers for each call to pack subtype - CALL StC_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_NStC(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! u_NStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_NStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_NStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_NStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! u_TStC allocated yes/no - IF ( ALLOCATED(InData%u_TStC) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! u_TStC upper/lower bounds for each dimension - DO i2 = LBOUND(InData%u_TStC,2), UBOUND(InData%u_TStC,2) - DO i1 = LBOUND(InData%u_TStC,1), UBOUND(InData%u_TStC,1) - Int_BufSz = Int_BufSz + 3 ! u_TStC: size of buffers for each call to pack subtype - CALL StC_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_TStC(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! u_TStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_TStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_TStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_TStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! u_SStC allocated yes/no - IF ( ALLOCATED(InData%u_SStC) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! u_SStC upper/lower bounds for each dimension - DO i2 = LBOUND(InData%u_SStC,2), UBOUND(InData%u_SStC,2) - DO i1 = LBOUND(InData%u_SStC,1), UBOUND(InData%u_SStC,1) - Int_BufSz = Int_BufSz + 3 ! u_SStC: size of buffers for each call to pack subtype - CALL StC_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_SStC(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! u_SStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_SStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_SStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_SStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! y_BStC allocated yes/no - IF ( ALLOCATED(InData%y_BStC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! y_BStC upper/lower bounds for each dimension - DO i1 = LBOUND(InData%y_BStC,1), UBOUND(InData%y_BStC,1) - Int_BufSz = Int_BufSz + 3 ! y_BStC: size of buffers for each call to pack subtype - CALL StC_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_BStC(i1), ErrStat2, ErrMsg2, .TRUE. ) ! y_BStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y_BStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y_BStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y_BStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! y_NStC allocated yes/no - IF ( ALLOCATED(InData%y_NStC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! y_NStC upper/lower bounds for each dimension - DO i1 = LBOUND(InData%y_NStC,1), UBOUND(InData%y_NStC,1) - Int_BufSz = Int_BufSz + 3 ! y_NStC: size of buffers for each call to pack subtype - CALL StC_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_NStC(i1), ErrStat2, ErrMsg2, .TRUE. ) ! y_NStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y_NStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y_NStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y_NStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! y_TStC allocated yes/no - IF ( ALLOCATED(InData%y_TStC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! y_TStC upper/lower bounds for each dimension - DO i1 = LBOUND(InData%y_TStC,1), UBOUND(InData%y_TStC,1) - Int_BufSz = Int_BufSz + 3 ! y_TStC: size of buffers for each call to pack subtype - CALL StC_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_TStC(i1), ErrStat2, ErrMsg2, .TRUE. ) ! y_TStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y_TStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y_TStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y_TStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! y_SStC allocated yes/no - IF ( ALLOCATED(InData%y_SStC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! y_SStC upper/lower bounds for each dimension - DO i1 = LBOUND(InData%y_SStC,1), UBOUND(InData%y_SStC,1) - Int_BufSz = Int_BufSz + 3 ! y_SStC: size of buffers for each call to pack subtype - CALL StC_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_SStC(i1), ErrStat2, ErrMsg2, .TRUE. ) ! y_SStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y_SStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y_SStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y_SStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! SrvD_MeshMap: size of buffers for each call to pack subtype - CALL SrvD_Packmodulemaptype( Re_Buf, Db_Buf, Int_Buf, InData%SrvD_MeshMap, ErrStat2, ErrMsg2, .TRUE. ) ! SrvD_MeshMap - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SrvD_MeshMap - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SrvD_MeshMap - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SrvD_MeshMap - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! PrevTstepNcall - 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 - IF ( .NOT. ALLOCATED(InData%u_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%u_BStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_BStC,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%u_BStC,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_BStC,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%u_BStC,2), UBOUND(InData%u_BStC,2) - DO i1 = LBOUND(InData%u_BStC,1), UBOUND(InData%u_BStC,1) - CALL StC_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_BStC(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! u_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 DO - END IF - IF ( .NOT. ALLOCATED(InData%u_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%u_NStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_NStC,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%u_NStC,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_NStC,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%u_NStC,2), UBOUND(InData%u_NStC,2) - DO i1 = LBOUND(InData%u_NStC,1), UBOUND(InData%u_NStC,1) - CALL StC_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_NStC(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! u_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 DO - END IF - IF ( .NOT. ALLOCATED(InData%u_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%u_TStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_TStC,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%u_TStC,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_TStC,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%u_TStC,2), UBOUND(InData%u_TStC,2) - DO i1 = LBOUND(InData%u_TStC,1), UBOUND(InData%u_TStC,1) - CALL StC_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_TStC(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! u_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 DO - END IF - IF ( .NOT. ALLOCATED(InData%u_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%u_SStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_SStC,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%u_SStC,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_SStC,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%u_SStC,2), UBOUND(InData%u_SStC,2) - DO i1 = LBOUND(InData%u_SStC,1), UBOUND(InData%u_SStC,1) - CALL StC_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_SStC(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! u_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 DO - END IF - IF ( .NOT. ALLOCATED(InData%y_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%y_BStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%y_BStC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%y_BStC,1), UBOUND(InData%y_BStC,1) - CALL StC_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_BStC(i1), ErrStat2, ErrMsg2, OnlySize ) ! y_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%y_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%y_NStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%y_NStC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%y_NStC,1), UBOUND(InData%y_NStC,1) - CALL StC_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_NStC(i1), ErrStat2, ErrMsg2, OnlySize ) ! y_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%y_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%y_TStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%y_TStC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%y_TStC,1), UBOUND(InData%y_TStC,1) - CALL StC_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_TStC(i1), ErrStat2, ErrMsg2, OnlySize ) ! y_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%y_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%y_SStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%y_SStC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%y_SStC,1), UBOUND(InData%y_SStC,1) - CALL StC_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_SStC(i1), ErrStat2, ErrMsg2, OnlySize ) ! y_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 - CALL SrvD_Packmodulemaptype( Re_Buf, Db_Buf, Int_Buf, InData%SrvD_MeshMap, ErrStat2, ErrMsg2, OnlySize ) ! SrvD_MeshMap - 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%PrevTstepNcall - Int_Xferred = Int_Xferred + 1 - 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) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - 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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! u_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 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%u_BStC)) DEALLOCATE(OutData%u_BStC) - ALLOCATE(OutData%u_BStC(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_BStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%u_BStC,2), UBOUND(OutData%u_BStC,2) - DO i1 = LBOUND(OutData%u_BStC,1), UBOUND(OutData%u_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%u_BStC(i1,i2), ErrStat2, ErrMsg2 ) ! u_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 DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! u_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 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%u_NStC)) DEALLOCATE(OutData%u_NStC) - ALLOCATE(OutData%u_NStC(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_NStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%u_NStC,2), UBOUND(OutData%u_NStC,2) - DO i1 = LBOUND(OutData%u_NStC,1), UBOUND(OutData%u_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%u_NStC(i1,i2), ErrStat2, ErrMsg2 ) ! u_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 DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! u_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 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%u_TStC)) DEALLOCATE(OutData%u_TStC) - ALLOCATE(OutData%u_TStC(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_TStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%u_TStC,2), UBOUND(OutData%u_TStC,2) - DO i1 = LBOUND(OutData%u_TStC,1), UBOUND(OutData%u_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%u_TStC(i1,i2), ErrStat2, ErrMsg2 ) ! u_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 DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! u_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 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%u_SStC)) DEALLOCATE(OutData%u_SStC) - ALLOCATE(OutData%u_SStC(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_SStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%u_SStC,2), UBOUND(OutData%u_SStC,2) - DO i1 = LBOUND(OutData%u_SStC,1), UBOUND(OutData%u_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%u_SStC(i1,i2), ErrStat2, ErrMsg2 ) ! u_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 DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! y_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%y_BStC)) DEALLOCATE(OutData%y_BStC) - ALLOCATE(OutData%y_BStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%y_BStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%y_BStC,1), UBOUND(OutData%y_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%y_BStC(i1), ErrStat2, ErrMsg2 ) ! y_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 ! y_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%y_NStC)) DEALLOCATE(OutData%y_NStC) - ALLOCATE(OutData%y_NStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%y_NStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%y_NStC,1), UBOUND(OutData%y_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%y_NStC(i1), ErrStat2, ErrMsg2 ) ! y_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 ! y_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%y_TStC)) DEALLOCATE(OutData%y_TStC) - ALLOCATE(OutData%y_TStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%y_TStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%y_TStC,1), UBOUND(OutData%y_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%y_TStC(i1), ErrStat2, ErrMsg2 ) ! y_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 ! y_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%y_SStC)) DEALLOCATE(OutData%y_SStC) - ALLOCATE(OutData%y_SStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%y_SStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%y_SStC,1), UBOUND(OutData%y_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%y_SStC(i1), ErrStat2, ErrMsg2 ) ! y_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 - 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_Unpackmodulemaptype( Re_Buf, Db_Buf, Int_Buf, OutData%SrvD_MeshMap, ErrStat2, ErrMsg2 ) ! SrvD_MeshMap - 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%PrevTstepNcall = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - 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) :: 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_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%AfCmode = SrcParamData%AfCmode - DstParamData%AfC_Mean = SrcParamData%AfC_Mean - DstParamData%AfC_Amp = SrcParamData%AfC_Amp - DstParamData%AfC_Phase = SrcParamData%AfC_Phase - DstParamData%CCmode = SrcParamData%CCmode - DstParamData%StCCmode = SrcParamData%StCCmode - DstParamData%NumOuts = SrcParamData%NumOuts - DstParamData%NumOuts_DLL = SrcParamData%NumOuts_DLL - DstParamData%RootName = SrcParamData%RootName - DstParamData%PriPath = SrcParamData%PriPath -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%InterpOrder = SrcParamData%InterpOrder - DstParamData%EXavrSWAP = SrcParamData%EXavrSWAP - DstParamData%NumCableControl = SrcParamData%NumCableControl - DstParamData%NumStC_Control = SrcParamData%NumStC_Control -IF (ALLOCATED(SrcParamData%StCMeasNumPerChan)) THEN - i1_l = LBOUND(SrcParamData%StCMeasNumPerChan,1) - i1_u = UBOUND(SrcParamData%StCMeasNumPerChan,1) - IF (.NOT. ALLOCATED(DstParamData%StCMeasNumPerChan)) THEN - ALLOCATE(DstParamData%StCMeasNumPerChan(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%StCMeasNumPerChan.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%StCMeasNumPerChan = SrcParamData%StCMeasNumPerChan -ENDIF - DstParamData%UseSC = SrcParamData%UseSC -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%Jac_x_indx)) THEN - i1_l = LBOUND(SrcParamData%Jac_x_indx,1) - i1_u = UBOUND(SrcParamData%Jac_x_indx,1) - i2_l = LBOUND(SrcParamData%Jac_x_indx,2) - i2_u = UBOUND(SrcParamData%Jac_x_indx,2) - IF (.NOT. ALLOCATED(DstParamData%Jac_x_indx)) THEN - ALLOCATE(DstParamData%Jac_x_indx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_x_indx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Jac_x_indx = SrcParamData%Jac_x_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 -IF (ALLOCATED(SrcParamData%dx)) THEN - i1_l = LBOUND(SrcParamData%dx,1) - i1_u = UBOUND(SrcParamData%dx,1) - IF (.NOT. ALLOCATED(DstParamData%dx)) THEN - ALLOCATE(DstParamData%dx(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%dx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%dx = SrcParamData%dx -ENDIF - DstParamData%Jac_nu = SrcParamData%Jac_nu - DstParamData%Jac_ny = SrcParamData%Jac_ny - DstParamData%Jac_nx = SrcParamData%Jac_nx -IF (ALLOCATED(SrcParamData%Jac_Idx_BStC_u)) THEN - i1_l = LBOUND(SrcParamData%Jac_Idx_BStC_u,1) - i1_u = UBOUND(SrcParamData%Jac_Idx_BStC_u,1) - i2_l = LBOUND(SrcParamData%Jac_Idx_BStC_u,2) - i2_u = UBOUND(SrcParamData%Jac_Idx_BStC_u,2) - i3_l = LBOUND(SrcParamData%Jac_Idx_BStC_u,3) - i3_u = UBOUND(SrcParamData%Jac_Idx_BStC_u,3) - IF (.NOT. ALLOCATED(DstParamData%Jac_Idx_BStC_u)) THEN - ALLOCATE(DstParamData%Jac_Idx_BStC_u(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_BStC_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Jac_Idx_BStC_u = SrcParamData%Jac_Idx_BStC_u -ENDIF -IF (ALLOCATED(SrcParamData%Jac_Idx_NStC_u)) THEN - i1_l = LBOUND(SrcParamData%Jac_Idx_NStC_u,1) - i1_u = UBOUND(SrcParamData%Jac_Idx_NStC_u,1) - i2_l = LBOUND(SrcParamData%Jac_Idx_NStC_u,2) - i2_u = UBOUND(SrcParamData%Jac_Idx_NStC_u,2) - IF (.NOT. ALLOCATED(DstParamData%Jac_Idx_NStC_u)) THEN - ALLOCATE(DstParamData%Jac_Idx_NStC_u(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_NStC_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Jac_Idx_NStC_u = SrcParamData%Jac_Idx_NStC_u -ENDIF -IF (ALLOCATED(SrcParamData%Jac_Idx_TStC_u)) THEN - i1_l = LBOUND(SrcParamData%Jac_Idx_TStC_u,1) - i1_u = UBOUND(SrcParamData%Jac_Idx_TStC_u,1) - i2_l = LBOUND(SrcParamData%Jac_Idx_TStC_u,2) - i2_u = UBOUND(SrcParamData%Jac_Idx_TStC_u,2) - IF (.NOT. ALLOCATED(DstParamData%Jac_Idx_TStC_u)) THEN - ALLOCATE(DstParamData%Jac_Idx_TStC_u(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_TStC_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Jac_Idx_TStC_u = SrcParamData%Jac_Idx_TStC_u -ENDIF -IF (ALLOCATED(SrcParamData%Jac_Idx_SStC_u)) THEN - i1_l = LBOUND(SrcParamData%Jac_Idx_SStC_u,1) - i1_u = UBOUND(SrcParamData%Jac_Idx_SStC_u,1) - i2_l = LBOUND(SrcParamData%Jac_Idx_SStC_u,2) - i2_u = UBOUND(SrcParamData%Jac_Idx_SStC_u,2) - IF (.NOT. ALLOCATED(DstParamData%Jac_Idx_SStC_u)) THEN - ALLOCATE(DstParamData%Jac_Idx_SStC_u(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_SStC_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Jac_Idx_SStC_u = SrcParamData%Jac_Idx_SStC_u -ENDIF -IF (ALLOCATED(SrcParamData%Jac_Idx_BStC_x)) THEN - i1_l = LBOUND(SrcParamData%Jac_Idx_BStC_x,1) - i1_u = UBOUND(SrcParamData%Jac_Idx_BStC_x,1) - i2_l = LBOUND(SrcParamData%Jac_Idx_BStC_x,2) - i2_u = UBOUND(SrcParamData%Jac_Idx_BStC_x,2) - i3_l = LBOUND(SrcParamData%Jac_Idx_BStC_x,3) - i3_u = UBOUND(SrcParamData%Jac_Idx_BStC_x,3) - IF (.NOT. ALLOCATED(DstParamData%Jac_Idx_BStC_x)) THEN - ALLOCATE(DstParamData%Jac_Idx_BStC_x(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_BStC_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Jac_Idx_BStC_x = SrcParamData%Jac_Idx_BStC_x -ENDIF -IF (ALLOCATED(SrcParamData%Jac_Idx_NStC_x)) THEN - i1_l = LBOUND(SrcParamData%Jac_Idx_NStC_x,1) - i1_u = UBOUND(SrcParamData%Jac_Idx_NStC_x,1) - i2_l = LBOUND(SrcParamData%Jac_Idx_NStC_x,2) - i2_u = UBOUND(SrcParamData%Jac_Idx_NStC_x,2) - IF (.NOT. ALLOCATED(DstParamData%Jac_Idx_NStC_x)) THEN - ALLOCATE(DstParamData%Jac_Idx_NStC_x(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_NStC_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Jac_Idx_NStC_x = SrcParamData%Jac_Idx_NStC_x -ENDIF -IF (ALLOCATED(SrcParamData%Jac_Idx_TStC_x)) THEN - i1_l = LBOUND(SrcParamData%Jac_Idx_TStC_x,1) - i1_u = UBOUND(SrcParamData%Jac_Idx_TStC_x,1) - i2_l = LBOUND(SrcParamData%Jac_Idx_TStC_x,2) - i2_u = UBOUND(SrcParamData%Jac_Idx_TStC_x,2) - IF (.NOT. ALLOCATED(DstParamData%Jac_Idx_TStC_x)) THEN - ALLOCATE(DstParamData%Jac_Idx_TStC_x(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_TStC_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Jac_Idx_TStC_x = SrcParamData%Jac_Idx_TStC_x -ENDIF -IF (ALLOCATED(SrcParamData%Jac_Idx_SStC_x)) THEN - i1_l = LBOUND(SrcParamData%Jac_Idx_SStC_x,1) - i1_u = UBOUND(SrcParamData%Jac_Idx_SStC_x,1) - i2_l = LBOUND(SrcParamData%Jac_Idx_SStC_x,2) - i2_u = UBOUND(SrcParamData%Jac_Idx_SStC_x,2) - IF (.NOT. ALLOCATED(DstParamData%Jac_Idx_SStC_x)) THEN - ALLOCATE(DstParamData%Jac_Idx_SStC_x(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_SStC_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Jac_Idx_SStC_x = SrcParamData%Jac_Idx_SStC_x -ENDIF -IF (ALLOCATED(SrcParamData%Jac_Idx_BStC_y)) THEN - i1_l = LBOUND(SrcParamData%Jac_Idx_BStC_y,1) - i1_u = UBOUND(SrcParamData%Jac_Idx_BStC_y,1) - i2_l = LBOUND(SrcParamData%Jac_Idx_BStC_y,2) - i2_u = UBOUND(SrcParamData%Jac_Idx_BStC_y,2) - i3_l = LBOUND(SrcParamData%Jac_Idx_BStC_y,3) - i3_u = UBOUND(SrcParamData%Jac_Idx_BStC_y,3) - IF (.NOT. ALLOCATED(DstParamData%Jac_Idx_BStC_y)) THEN - ALLOCATE(DstParamData%Jac_Idx_BStC_y(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_BStC_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Jac_Idx_BStC_y = SrcParamData%Jac_Idx_BStC_y -ENDIF -IF (ALLOCATED(SrcParamData%Jac_Idx_NStC_y)) THEN - i1_l = LBOUND(SrcParamData%Jac_Idx_NStC_y,1) - i1_u = UBOUND(SrcParamData%Jac_Idx_NStC_y,1) - i2_l = LBOUND(SrcParamData%Jac_Idx_NStC_y,2) - i2_u = UBOUND(SrcParamData%Jac_Idx_NStC_y,2) - IF (.NOT. ALLOCATED(DstParamData%Jac_Idx_NStC_y)) THEN - ALLOCATE(DstParamData%Jac_Idx_NStC_y(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_NStC_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Jac_Idx_NStC_y = SrcParamData%Jac_Idx_NStC_y -ENDIF -IF (ALLOCATED(SrcParamData%Jac_Idx_TStC_y)) THEN - i1_l = LBOUND(SrcParamData%Jac_Idx_TStC_y,1) - i1_u = UBOUND(SrcParamData%Jac_Idx_TStC_y,1) - i2_l = LBOUND(SrcParamData%Jac_Idx_TStC_y,2) - i2_u = UBOUND(SrcParamData%Jac_Idx_TStC_y,2) - IF (.NOT. ALLOCATED(DstParamData%Jac_Idx_TStC_y)) THEN - ALLOCATE(DstParamData%Jac_Idx_TStC_y(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_TStC_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Jac_Idx_TStC_y = SrcParamData%Jac_Idx_TStC_y -ENDIF -IF (ALLOCATED(SrcParamData%Jac_Idx_SStC_y)) THEN - i1_l = LBOUND(SrcParamData%Jac_Idx_SStC_y,1) - i1_u = UBOUND(SrcParamData%Jac_Idx_SStC_y,1) - i2_l = LBOUND(SrcParamData%Jac_Idx_SStC_y,2) - i2_u = UBOUND(SrcParamData%Jac_Idx_SStC_y,2) - IF (.NOT. ALLOCATED(DstParamData%Jac_Idx_SStC_y)) THEN - ALLOCATE(DstParamData%Jac_Idx_SStC_y(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_SStC_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Jac_Idx_SStC_y = SrcParamData%Jac_Idx_SStC_y -ENDIF - DstParamData%SensorType = SrcParamData%SensorType - DstParamData%NumBeam = SrcParamData%NumBeam - DstParamData%NumPulseGate = SrcParamData%NumPulseGate - DstParamData%PulseSpacing = SrcParamData%PulseSpacing - DstParamData%URefLid = SrcParamData%URefLid - END SUBROUTINE SrvD_CopyParam - - SUBROUTINE SrvD_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(SrvD_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -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), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ParamData%OutParam) -ENDIF - CALL FreeDynamicLib( ParamData%DLL_Trgt, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(ParamData%BStC)) THEN -DO i1 = LBOUND(ParamData%BStC,1), UBOUND(ParamData%BStC,1) - CALL StC_DestroyParam( ParamData%BStC(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -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), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -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), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -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), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ParamData%SStC) -ENDIF -IF (ALLOCATED(ParamData%StCMeasNumPerChan)) THEN - DEALLOCATE(ParamData%StCMeasNumPerChan) -ENDIF -IF (ALLOCATED(ParamData%Jac_u_indx)) THEN - DEALLOCATE(ParamData%Jac_u_indx) -ENDIF -IF (ALLOCATED(ParamData%Jac_x_indx)) THEN - DEALLOCATE(ParamData%Jac_x_indx) -ENDIF -IF (ALLOCATED(ParamData%du)) THEN - DEALLOCATE(ParamData%du) -ENDIF -IF (ALLOCATED(ParamData%dx)) THEN - DEALLOCATE(ParamData%dx) -ENDIF -IF (ALLOCATED(ParamData%Jac_Idx_BStC_u)) THEN - DEALLOCATE(ParamData%Jac_Idx_BStC_u) -ENDIF -IF (ALLOCATED(ParamData%Jac_Idx_NStC_u)) THEN - DEALLOCATE(ParamData%Jac_Idx_NStC_u) -ENDIF -IF (ALLOCATED(ParamData%Jac_Idx_TStC_u)) THEN - DEALLOCATE(ParamData%Jac_Idx_TStC_u) -ENDIF -IF (ALLOCATED(ParamData%Jac_Idx_SStC_u)) THEN - DEALLOCATE(ParamData%Jac_Idx_SStC_u) -ENDIF -IF (ALLOCATED(ParamData%Jac_Idx_BStC_x)) THEN - DEALLOCATE(ParamData%Jac_Idx_BStC_x) -ENDIF -IF (ALLOCATED(ParamData%Jac_Idx_NStC_x)) THEN - DEALLOCATE(ParamData%Jac_Idx_NStC_x) -ENDIF -IF (ALLOCATED(ParamData%Jac_Idx_TStC_x)) THEN - DEALLOCATE(ParamData%Jac_Idx_TStC_x) -ENDIF -IF (ALLOCATED(ParamData%Jac_Idx_SStC_x)) THEN - DEALLOCATE(ParamData%Jac_Idx_SStC_x) -ENDIF -IF (ALLOCATED(ParamData%Jac_Idx_BStC_y)) THEN - DEALLOCATE(ParamData%Jac_Idx_BStC_y) -ENDIF -IF (ALLOCATED(ParamData%Jac_Idx_NStC_y)) THEN - DEALLOCATE(ParamData%Jac_Idx_NStC_y) -ENDIF -IF (ALLOCATED(ParamData%Jac_Idx_TStC_y)) THEN - DEALLOCATE(ParamData%Jac_Idx_TStC_y) -ENDIF -IF (ALLOCATED(ParamData%Jac_Idx_SStC_y)) THEN - DEALLOCATE(ParamData%Jac_Idx_SStC_y) -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 ! AfCmode - Re_BufSz = Re_BufSz + 1 ! AfC_Mean - Re_BufSz = Re_BufSz + 1 ! AfC_Amp - Re_BufSz = Re_BufSz + 1 ! AfC_Phase - Int_BufSz = Int_BufSz + 1 ! CCmode - Int_BufSz = Int_BufSz + 1 ! StCCmode - 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*LEN(InData%PriPath) ! PriPath - 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 ! InterpOrder - Int_BufSz = Int_BufSz + 1 ! EXavrSWAP - Int_BufSz = Int_BufSz + 1 ! NumCableControl - Int_BufSz = Int_BufSz + 1 ! NumStC_Control - Int_BufSz = Int_BufSz + 1 ! StCMeasNumPerChan allocated yes/no - IF ( ALLOCATED(InData%StCMeasNumPerChan) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! StCMeasNumPerChan upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%StCMeasNumPerChan) ! StCMeasNumPerChan - END IF - Int_BufSz = Int_BufSz + 1 ! UseSC - 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 ! Jac_x_indx allocated yes/no - IF ( ALLOCATED(InData%Jac_x_indx) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Jac_x_indx upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Jac_x_indx) ! Jac_x_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 - Int_BufSz = Int_BufSz + 1 ! dx allocated yes/no - IF ( ALLOCATED(InData%dx) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! dx upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%dx) ! dx - END IF - Int_BufSz = Int_BufSz + 1 ! Jac_nu - Int_BufSz = Int_BufSz + 1 ! Jac_ny - Int_BufSz = Int_BufSz + 1 ! Jac_nx - Int_BufSz = Int_BufSz + 1 ! Jac_Idx_BStC_u allocated yes/no - IF ( ALLOCATED(InData%Jac_Idx_BStC_u) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Jac_Idx_BStC_u upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Jac_Idx_BStC_u) ! Jac_Idx_BStC_u - END IF - Int_BufSz = Int_BufSz + 1 ! Jac_Idx_NStC_u allocated yes/no - IF ( ALLOCATED(InData%Jac_Idx_NStC_u) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Jac_Idx_NStC_u upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Jac_Idx_NStC_u) ! Jac_Idx_NStC_u - END IF - Int_BufSz = Int_BufSz + 1 ! Jac_Idx_TStC_u allocated yes/no - IF ( ALLOCATED(InData%Jac_Idx_TStC_u) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Jac_Idx_TStC_u upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Jac_Idx_TStC_u) ! Jac_Idx_TStC_u - END IF - Int_BufSz = Int_BufSz + 1 ! Jac_Idx_SStC_u allocated yes/no - IF ( ALLOCATED(InData%Jac_Idx_SStC_u) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Jac_Idx_SStC_u upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Jac_Idx_SStC_u) ! Jac_Idx_SStC_u - END IF - Int_BufSz = Int_BufSz + 1 ! Jac_Idx_BStC_x allocated yes/no - IF ( ALLOCATED(InData%Jac_Idx_BStC_x) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Jac_Idx_BStC_x upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Jac_Idx_BStC_x) ! Jac_Idx_BStC_x - END IF - Int_BufSz = Int_BufSz + 1 ! Jac_Idx_NStC_x allocated yes/no - IF ( ALLOCATED(InData%Jac_Idx_NStC_x) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Jac_Idx_NStC_x upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Jac_Idx_NStC_x) ! Jac_Idx_NStC_x - END IF - Int_BufSz = Int_BufSz + 1 ! Jac_Idx_TStC_x allocated yes/no - IF ( ALLOCATED(InData%Jac_Idx_TStC_x) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Jac_Idx_TStC_x upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Jac_Idx_TStC_x) ! Jac_Idx_TStC_x - END IF - Int_BufSz = Int_BufSz + 1 ! Jac_Idx_SStC_x allocated yes/no - IF ( ALLOCATED(InData%Jac_Idx_SStC_x) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Jac_Idx_SStC_x upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Jac_Idx_SStC_x) ! Jac_Idx_SStC_x - END IF - Int_BufSz = Int_BufSz + 1 ! Jac_Idx_BStC_y allocated yes/no - IF ( ALLOCATED(InData%Jac_Idx_BStC_y) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Jac_Idx_BStC_y upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Jac_Idx_BStC_y) ! Jac_Idx_BStC_y - END IF - Int_BufSz = Int_BufSz + 1 ! Jac_Idx_NStC_y allocated yes/no - IF ( ALLOCATED(InData%Jac_Idx_NStC_y) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Jac_Idx_NStC_y upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Jac_Idx_NStC_y) ! Jac_Idx_NStC_y - END IF - Int_BufSz = Int_BufSz + 1 ! Jac_Idx_TStC_y allocated yes/no - IF ( ALLOCATED(InData%Jac_Idx_TStC_y) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Jac_Idx_TStC_y upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Jac_Idx_TStC_y) ! Jac_Idx_TStC_y - END IF - Int_BufSz = Int_BufSz + 1 ! Jac_Idx_SStC_y allocated yes/no - IF ( ALLOCATED(InData%Jac_Idx_SStC_y) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Jac_Idx_SStC_y upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Jac_Idx_SStC_y) ! Jac_Idx_SStC_y - END IF - Int_BufSz = Int_BufSz + 1 ! SensorType - Int_BufSz = Int_BufSz + 1 ! NumBeam - Int_BufSz = Int_BufSz + 1 ! NumPulseGate - Re_BufSz = Re_BufSz + 1 ! PulseSpacing - Re_BufSz = Re_BufSz + 1 ! URefLid - 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%AfCmode - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%AfC_Mean - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%AfC_Amp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%AfC_Phase - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%CCmode - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%StCCmode - 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 - DO I = 1, LEN(InData%PriPath) - IntKiBuf(Int_Xferred) = ICHAR(InData%PriPath(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) = InData%InterpOrder - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%EXavrSWAP, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumCableControl - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumStC_Control - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%StCMeasNumPerChan) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StCMeasNumPerChan,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StCMeasNumPerChan,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%StCMeasNumPerChan,1), UBOUND(InData%StCMeasNumPerChan,1) - IntKiBuf(Int_Xferred) = InData%StCMeasNumPerChan(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = TRANSFER(InData%UseSC, IntKiBuf(1)) - 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%Jac_x_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_x_indx,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_x_indx,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Jac_x_indx,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_x_indx,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Jac_x_indx,2), UBOUND(InData%Jac_x_indx,2) - DO i1 = LBOUND(InData%Jac_x_indx,1), UBOUND(InData%Jac_x_indx,1) - IntKiBuf(Int_Xferred) = InData%Jac_x_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 - IF ( .NOT. ALLOCATED(InData%dx) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%dx,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dx,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%dx,1), UBOUND(InData%dx,1) - ReKiBuf(Re_Xferred) = InData%dx(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%Jac_nu - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%Jac_ny - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%Jac_nx - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%Jac_Idx_BStC_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%Jac_Idx_BStC_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_Idx_BStC_u,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Jac_Idx_BStC_u,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_Idx_BStC_u,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Jac_Idx_BStC_u,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_Idx_BStC_u,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Jac_Idx_BStC_u,3), UBOUND(InData%Jac_Idx_BStC_u,3) - DO i2 = LBOUND(InData%Jac_Idx_BStC_u,2), UBOUND(InData%Jac_Idx_BStC_u,2) - DO i1 = LBOUND(InData%Jac_Idx_BStC_u,1), UBOUND(InData%Jac_Idx_BStC_u,1) - IntKiBuf(Int_Xferred) = InData%Jac_Idx_BStC_u(i1,i2,i3) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Jac_Idx_NStC_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%Jac_Idx_NStC_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_Idx_NStC_u,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Jac_Idx_NStC_u,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_Idx_NStC_u,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Jac_Idx_NStC_u,2), UBOUND(InData%Jac_Idx_NStC_u,2) - DO i1 = LBOUND(InData%Jac_Idx_NStC_u,1), UBOUND(InData%Jac_Idx_NStC_u,1) - IntKiBuf(Int_Xferred) = InData%Jac_Idx_NStC_u(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Jac_Idx_TStC_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%Jac_Idx_TStC_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_Idx_TStC_u,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Jac_Idx_TStC_u,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_Idx_TStC_u,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Jac_Idx_TStC_u,2), UBOUND(InData%Jac_Idx_TStC_u,2) - DO i1 = LBOUND(InData%Jac_Idx_TStC_u,1), UBOUND(InData%Jac_Idx_TStC_u,1) - IntKiBuf(Int_Xferred) = InData%Jac_Idx_TStC_u(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Jac_Idx_SStC_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%Jac_Idx_SStC_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_Idx_SStC_u,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Jac_Idx_SStC_u,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_Idx_SStC_u,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Jac_Idx_SStC_u,2), UBOUND(InData%Jac_Idx_SStC_u,2) - DO i1 = LBOUND(InData%Jac_Idx_SStC_u,1), UBOUND(InData%Jac_Idx_SStC_u,1) - IntKiBuf(Int_Xferred) = InData%Jac_Idx_SStC_u(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Jac_Idx_BStC_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%Jac_Idx_BStC_x,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_Idx_BStC_x,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Jac_Idx_BStC_x,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_Idx_BStC_x,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Jac_Idx_BStC_x,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_Idx_BStC_x,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Jac_Idx_BStC_x,3), UBOUND(InData%Jac_Idx_BStC_x,3) - DO i2 = LBOUND(InData%Jac_Idx_BStC_x,2), UBOUND(InData%Jac_Idx_BStC_x,2) - DO i1 = LBOUND(InData%Jac_Idx_BStC_x,1), UBOUND(InData%Jac_Idx_BStC_x,1) - IntKiBuf(Int_Xferred) = InData%Jac_Idx_BStC_x(i1,i2,i3) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Jac_Idx_NStC_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%Jac_Idx_NStC_x,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_Idx_NStC_x,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Jac_Idx_NStC_x,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_Idx_NStC_x,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Jac_Idx_NStC_x,2), UBOUND(InData%Jac_Idx_NStC_x,2) - DO i1 = LBOUND(InData%Jac_Idx_NStC_x,1), UBOUND(InData%Jac_Idx_NStC_x,1) - IntKiBuf(Int_Xferred) = InData%Jac_Idx_NStC_x(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Jac_Idx_TStC_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%Jac_Idx_TStC_x,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_Idx_TStC_x,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Jac_Idx_TStC_x,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_Idx_TStC_x,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Jac_Idx_TStC_x,2), UBOUND(InData%Jac_Idx_TStC_x,2) - DO i1 = LBOUND(InData%Jac_Idx_TStC_x,1), UBOUND(InData%Jac_Idx_TStC_x,1) - IntKiBuf(Int_Xferred) = InData%Jac_Idx_TStC_x(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Jac_Idx_SStC_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%Jac_Idx_SStC_x,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_Idx_SStC_x,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Jac_Idx_SStC_x,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_Idx_SStC_x,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Jac_Idx_SStC_x,2), UBOUND(InData%Jac_Idx_SStC_x,2) - DO i1 = LBOUND(InData%Jac_Idx_SStC_x,1), UBOUND(InData%Jac_Idx_SStC_x,1) - IntKiBuf(Int_Xferred) = InData%Jac_Idx_SStC_x(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Jac_Idx_BStC_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%Jac_Idx_BStC_y,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_Idx_BStC_y,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Jac_Idx_BStC_y,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_Idx_BStC_y,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Jac_Idx_BStC_y,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_Idx_BStC_y,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Jac_Idx_BStC_y,3), UBOUND(InData%Jac_Idx_BStC_y,3) - DO i2 = LBOUND(InData%Jac_Idx_BStC_y,2), UBOUND(InData%Jac_Idx_BStC_y,2) - DO i1 = LBOUND(InData%Jac_Idx_BStC_y,1), UBOUND(InData%Jac_Idx_BStC_y,1) - IntKiBuf(Int_Xferred) = InData%Jac_Idx_BStC_y(i1,i2,i3) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Jac_Idx_NStC_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%Jac_Idx_NStC_y,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_Idx_NStC_y,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Jac_Idx_NStC_y,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_Idx_NStC_y,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Jac_Idx_NStC_y,2), UBOUND(InData%Jac_Idx_NStC_y,2) - DO i1 = LBOUND(InData%Jac_Idx_NStC_y,1), UBOUND(InData%Jac_Idx_NStC_y,1) - IntKiBuf(Int_Xferred) = InData%Jac_Idx_NStC_y(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Jac_Idx_TStC_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%Jac_Idx_TStC_y,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_Idx_TStC_y,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Jac_Idx_TStC_y,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_Idx_TStC_y,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Jac_Idx_TStC_y,2), UBOUND(InData%Jac_Idx_TStC_y,2) - DO i1 = LBOUND(InData%Jac_Idx_TStC_y,1), UBOUND(InData%Jac_Idx_TStC_y,1) - IntKiBuf(Int_Xferred) = InData%Jac_Idx_TStC_y(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Jac_Idx_SStC_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%Jac_Idx_SStC_y,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_Idx_SStC_y,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Jac_Idx_SStC_y,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_Idx_SStC_y,2) - Int_Xferred = Int_Xferred + 2 - DO i2 = LBOUND(InData%Jac_Idx_SStC_y,2), UBOUND(InData%Jac_Idx_SStC_y,2) - DO i1 = LBOUND(InData%Jac_Idx_SStC_y,1), UBOUND(InData%Jac_Idx_SStC_y,1) - IntKiBuf(Int_Xferred) = InData%Jac_Idx_SStC_y(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%SensorType - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumBeam - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumPulseGate - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PulseSpacing - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%URefLid - Re_Xferred = Re_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) :: 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_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%AfCmode = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%AfC_Mean = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%AfC_Amp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%AfC_Phase = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%CCmode = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%StCCmode = 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 - DO I = 1, LEN(OutData%PriPath) - OutData%PriPath(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%InterpOrder = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%EXavrSWAP = TRANSFER(IntKiBuf(Int_Xferred), OutData%EXavrSWAP) - Int_Xferred = Int_Xferred + 1 - OutData%NumCableControl = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumStC_Control = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StCMeasNumPerChan not allocated - Int_Xferred = Int_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%StCMeasNumPerChan)) DEALLOCATE(OutData%StCMeasNumPerChan) - ALLOCATE(OutData%StCMeasNumPerChan(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StCMeasNumPerChan.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%StCMeasNumPerChan,1), UBOUND(OutData%StCMeasNumPerChan,1) - OutData%StCMeasNumPerChan(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - OutData%UseSC = TRANSFER(IntKiBuf(Int_Xferred), OutData%UseSC) - 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 ! Jac_x_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_x_indx)) DEALLOCATE(OutData%Jac_x_indx) - ALLOCATE(OutData%Jac_x_indx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_x_indx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Jac_x_indx,2), UBOUND(OutData%Jac_x_indx,2) - DO i1 = LBOUND(OutData%Jac_x_indx,1), UBOUND(OutData%Jac_x_indx,1) - OutData%Jac_x_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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! dx not allocated - Int_Xferred = Int_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%dx)) DEALLOCATE(OutData%dx) - ALLOCATE(OutData%dx(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%dx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%dx,1), UBOUND(OutData%dx,1) - OutData%dx(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%Jac_nu = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%Jac_ny = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%Jac_nx = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Jac_Idx_BStC_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 - 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%Jac_Idx_BStC_u)) DEALLOCATE(OutData%Jac_Idx_BStC_u) - ALLOCATE(OutData%Jac_Idx_BStC_u(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%Jac_Idx_BStC_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Jac_Idx_BStC_u,3), UBOUND(OutData%Jac_Idx_BStC_u,3) - DO i2 = LBOUND(OutData%Jac_Idx_BStC_u,2), UBOUND(OutData%Jac_Idx_BStC_u,2) - DO i1 = LBOUND(OutData%Jac_Idx_BStC_u,1), UBOUND(OutData%Jac_Idx_BStC_u,1) - OutData%Jac_Idx_BStC_u(i1,i2,i3) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Jac_Idx_NStC_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 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Jac_Idx_NStC_u)) DEALLOCATE(OutData%Jac_Idx_NStC_u) - ALLOCATE(OutData%Jac_Idx_NStC_u(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_Idx_NStC_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Jac_Idx_NStC_u,2), UBOUND(OutData%Jac_Idx_NStC_u,2) - DO i1 = LBOUND(OutData%Jac_Idx_NStC_u,1), UBOUND(OutData%Jac_Idx_NStC_u,1) - OutData%Jac_Idx_NStC_u(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Jac_Idx_TStC_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 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Jac_Idx_TStC_u)) DEALLOCATE(OutData%Jac_Idx_TStC_u) - ALLOCATE(OutData%Jac_Idx_TStC_u(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_Idx_TStC_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Jac_Idx_TStC_u,2), UBOUND(OutData%Jac_Idx_TStC_u,2) - DO i1 = LBOUND(OutData%Jac_Idx_TStC_u,1), UBOUND(OutData%Jac_Idx_TStC_u,1) - OutData%Jac_Idx_TStC_u(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Jac_Idx_SStC_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 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Jac_Idx_SStC_u)) DEALLOCATE(OutData%Jac_Idx_SStC_u) - ALLOCATE(OutData%Jac_Idx_SStC_u(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_Idx_SStC_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Jac_Idx_SStC_u,2), UBOUND(OutData%Jac_Idx_SStC_u,2) - DO i1 = LBOUND(OutData%Jac_Idx_SStC_u,1), UBOUND(OutData%Jac_Idx_SStC_u,1) - OutData%Jac_Idx_SStC_u(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Jac_Idx_BStC_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 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Jac_Idx_BStC_x)) DEALLOCATE(OutData%Jac_Idx_BStC_x) - ALLOCATE(OutData%Jac_Idx_BStC_x(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%Jac_Idx_BStC_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Jac_Idx_BStC_x,3), UBOUND(OutData%Jac_Idx_BStC_x,3) - DO i2 = LBOUND(OutData%Jac_Idx_BStC_x,2), UBOUND(OutData%Jac_Idx_BStC_x,2) - DO i1 = LBOUND(OutData%Jac_Idx_BStC_x,1), UBOUND(OutData%Jac_Idx_BStC_x,1) - OutData%Jac_Idx_BStC_x(i1,i2,i3) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Jac_Idx_NStC_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%Jac_Idx_NStC_x)) DEALLOCATE(OutData%Jac_Idx_NStC_x) - ALLOCATE(OutData%Jac_Idx_NStC_x(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_Idx_NStC_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Jac_Idx_NStC_x,2), UBOUND(OutData%Jac_Idx_NStC_x,2) - DO i1 = LBOUND(OutData%Jac_Idx_NStC_x,1), UBOUND(OutData%Jac_Idx_NStC_x,1) - OutData%Jac_Idx_NStC_x(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Jac_Idx_TStC_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%Jac_Idx_TStC_x)) DEALLOCATE(OutData%Jac_Idx_TStC_x) - ALLOCATE(OutData%Jac_Idx_TStC_x(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_Idx_TStC_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Jac_Idx_TStC_x,2), UBOUND(OutData%Jac_Idx_TStC_x,2) - DO i1 = LBOUND(OutData%Jac_Idx_TStC_x,1), UBOUND(OutData%Jac_Idx_TStC_x,1) - OutData%Jac_Idx_TStC_x(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Jac_Idx_SStC_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%Jac_Idx_SStC_x)) DEALLOCATE(OutData%Jac_Idx_SStC_x) - ALLOCATE(OutData%Jac_Idx_SStC_x(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_Idx_SStC_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Jac_Idx_SStC_x,2), UBOUND(OutData%Jac_Idx_SStC_x,2) - DO i1 = LBOUND(OutData%Jac_Idx_SStC_x,1), UBOUND(OutData%Jac_Idx_SStC_x,1) - OutData%Jac_Idx_SStC_x(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Jac_Idx_BStC_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 - 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%Jac_Idx_BStC_y)) DEALLOCATE(OutData%Jac_Idx_BStC_y) - ALLOCATE(OutData%Jac_Idx_BStC_y(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%Jac_Idx_BStC_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Jac_Idx_BStC_y,3), UBOUND(OutData%Jac_Idx_BStC_y,3) - DO i2 = LBOUND(OutData%Jac_Idx_BStC_y,2), UBOUND(OutData%Jac_Idx_BStC_y,2) - DO i1 = LBOUND(OutData%Jac_Idx_BStC_y,1), UBOUND(OutData%Jac_Idx_BStC_y,1) - OutData%Jac_Idx_BStC_y(i1,i2,i3) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Jac_Idx_NStC_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 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Jac_Idx_NStC_y)) DEALLOCATE(OutData%Jac_Idx_NStC_y) - ALLOCATE(OutData%Jac_Idx_NStC_y(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_Idx_NStC_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Jac_Idx_NStC_y,2), UBOUND(OutData%Jac_Idx_NStC_y,2) - DO i1 = LBOUND(OutData%Jac_Idx_NStC_y,1), UBOUND(OutData%Jac_Idx_NStC_y,1) - OutData%Jac_Idx_NStC_y(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Jac_Idx_TStC_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 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Jac_Idx_TStC_y)) DEALLOCATE(OutData%Jac_Idx_TStC_y) - ALLOCATE(OutData%Jac_Idx_TStC_y(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_Idx_TStC_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Jac_Idx_TStC_y,2), UBOUND(OutData%Jac_Idx_TStC_y,2) - DO i1 = LBOUND(OutData%Jac_Idx_TStC_y,1), UBOUND(OutData%Jac_Idx_TStC_y,1) - OutData%Jac_Idx_TStC_y(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Jac_Idx_SStC_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 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Jac_Idx_SStC_y)) DEALLOCATE(OutData%Jac_Idx_SStC_y) - ALLOCATE(OutData%Jac_Idx_SStC_y(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_Idx_SStC_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Jac_Idx_SStC_y,2), UBOUND(OutData%Jac_Idx_SStC_y,2) - DO i1 = LBOUND(OutData%Jac_Idx_SStC_y,1), UBOUND(OutData%Jac_Idx_SStC_y,1) - OutData%Jac_Idx_SStC_y(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - OutData%SensorType = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumBeam = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumPulseGate = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%PulseSpacing = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%URefLid = ReKiBuf(Re_Xferred) - Re_Xferred = Re_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) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_CopyInput' -! +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 + integer(B4Ki) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SrvD_CopyInitInput' 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 -IF (ALLOCATED(SrcInputData%ExternalBlAirfoilCom)) THEN - i1_l = LBOUND(SrcInputData%ExternalBlAirfoilCom,1) - i1_u = UBOUND(SrcInputData%ExternalBlAirfoilCom,1) - IF (.NOT. ALLOCATED(DstInputData%ExternalBlAirfoilCom)) THEN - ALLOCATE(DstInputData%ExternalBlAirfoilCom(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%ExternalBlAirfoilCom.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%ExternalBlAirfoilCom = SrcInputData%ExternalBlAirfoilCom -ENDIF -IF (ALLOCATED(SrcInputData%ExternalCableDeltaL)) THEN - i1_l = LBOUND(SrcInputData%ExternalCableDeltaL,1) - i1_u = UBOUND(SrcInputData%ExternalCableDeltaL,1) - IF (.NOT. ALLOCATED(DstInputData%ExternalCableDeltaL)) THEN - ALLOCATE(DstInputData%ExternalCableDeltaL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%ExternalCableDeltaL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%ExternalCableDeltaL = SrcInputData%ExternalCableDeltaL -ENDIF -IF (ALLOCATED(SrcInputData%ExternalCableDeltaLdot)) THEN - i1_l = LBOUND(SrcInputData%ExternalCableDeltaLdot,1) - i1_u = UBOUND(SrcInputData%ExternalCableDeltaLdot,1) - IF (.NOT. ALLOCATED(DstInputData%ExternalCableDeltaLdot)) THEN - ALLOCATE(DstInputData%ExternalCableDeltaLdot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%ExternalCableDeltaLdot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%ExternalCableDeltaLdot = SrcInputData%ExternalCableDeltaLdot -ENDIF - 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 - DstInputData%LSShftFxa = SrcInputData%LSShftFxa - DstInputData%LSShftFys = SrcInputData%LSShftFys - DstInputData%LSShftFzs = SrcInputData%LSShftFzs -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 - CALL MeshCopy( SrcInputData%PtfmMotionMesh, DstInputData%PtfmMotionMesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcInputData%BStCMotionMesh)) THEN - i1_l = LBOUND(SrcInputData%BStCMotionMesh,1) - i1_u = UBOUND(SrcInputData%BStCMotionMesh,1) - i2_l = LBOUND(SrcInputData%BStCMotionMesh,2) - i2_u = UBOUND(SrcInputData%BStCMotionMesh,2) - IF (.NOT. ALLOCATED(DstInputData%BStCMotionMesh)) THEN - ALLOCATE(DstInputData%BStCMotionMesh(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%BStCMotionMesh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcInputData%BStCMotionMesh,2), UBOUND(SrcInputData%BStCMotionMesh,2) - DO i1 = LBOUND(SrcInputData%BStCMotionMesh,1), UBOUND(SrcInputData%BStCMotionMesh,1) - CALL MeshCopy( SrcInputData%BStCMotionMesh(i1,i2), DstInputData%BStCMotionMesh(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcInputData%NStCMotionMesh)) THEN - i1_l = LBOUND(SrcInputData%NStCMotionMesh,1) - i1_u = UBOUND(SrcInputData%NStCMotionMesh,1) - IF (.NOT. ALLOCATED(DstInputData%NStCMotionMesh)) THEN - ALLOCATE(DstInputData%NStCMotionMesh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%NStCMotionMesh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcInputData%NStCMotionMesh,1), UBOUND(SrcInputData%NStCMotionMesh,1) - CALL MeshCopy( SrcInputData%NStCMotionMesh(i1), DstInputData%NStCMotionMesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcInputData%TStCMotionMesh)) THEN - i1_l = LBOUND(SrcInputData%TStCMotionMesh,1) - i1_u = UBOUND(SrcInputData%TStCMotionMesh,1) - IF (.NOT. ALLOCATED(DstInputData%TStCMotionMesh)) THEN - ALLOCATE(DstInputData%TStCMotionMesh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%TStCMotionMesh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcInputData%TStCMotionMesh,1), UBOUND(SrcInputData%TStCMotionMesh,1) - CALL MeshCopy( SrcInputData%TStCMotionMesh(i1), DstInputData%TStCMotionMesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcInputData%SStCMotionMesh)) THEN - i1_l = LBOUND(SrcInputData%SStCMotionMesh,1) - i1_u = UBOUND(SrcInputData%SStCMotionMesh,1) - IF (.NOT. ALLOCATED(DstInputData%SStCMotionMesh)) THEN - ALLOCATE(DstInputData%SStCMotionMesh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%SStCMotionMesh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcInputData%SStCMotionMesh,1), UBOUND(SrcInputData%SStCMotionMesh,1) - CALL MeshCopy( SrcInputData%SStCMotionMesh(i1), DstInputData%SStCMotionMesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcInputData%LidSpeed)) THEN - i1_l = LBOUND(SrcInputData%LidSpeed,1) - i1_u = UBOUND(SrcInputData%LidSpeed,1) - IF (.NOT. ALLOCATED(DstInputData%LidSpeed)) THEN - ALLOCATE(DstInputData%LidSpeed(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%LidSpeed.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%LidSpeed = SrcInputData%LidSpeed -ENDIF -IF (ALLOCATED(SrcInputData%MsrPositionsX)) THEN - i1_l = LBOUND(SrcInputData%MsrPositionsX,1) - i1_u = UBOUND(SrcInputData%MsrPositionsX,1) - IF (.NOT. ALLOCATED(DstInputData%MsrPositionsX)) THEN - ALLOCATE(DstInputData%MsrPositionsX(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%MsrPositionsX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%MsrPositionsX = SrcInputData%MsrPositionsX -ENDIF -IF (ALLOCATED(SrcInputData%MsrPositionsY)) THEN - i1_l = LBOUND(SrcInputData%MsrPositionsY,1) - i1_u = UBOUND(SrcInputData%MsrPositionsY,1) - IF (.NOT. ALLOCATED(DstInputData%MsrPositionsY)) THEN - ALLOCATE(DstInputData%MsrPositionsY(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%MsrPositionsY.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%MsrPositionsY = SrcInputData%MsrPositionsY -ENDIF -IF (ALLOCATED(SrcInputData%MsrPositionsZ)) THEN - i1_l = LBOUND(SrcInputData%MsrPositionsZ,1) - i1_u = UBOUND(SrcInputData%MsrPositionsZ,1) - IF (.NOT. ALLOCATED(DstInputData%MsrPositionsZ)) THEN - ALLOCATE(DstInputData%MsrPositionsZ(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%MsrPositionsZ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%MsrPositionsZ = SrcInputData%MsrPositionsZ -ENDIF - END SUBROUTINE SrvD_CopyInput - - SUBROUTINE SrvD_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(SrvD_InputType), INTENT(INOUT) :: InputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_DestroyInput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(InputData%BlPitch)) THEN - DEALLOCATE(InputData%BlPitch) -ENDIF -IF (ALLOCATED(InputData%ExternalBlPitchCom)) THEN - DEALLOCATE(InputData%ExternalBlPitchCom) -ENDIF -IF (ALLOCATED(InputData%ExternalBlAirfoilCom)) THEN - DEALLOCATE(InputData%ExternalBlAirfoilCom) -ENDIF -IF (ALLOCATED(InputData%ExternalCableDeltaL)) THEN - DEALLOCATE(InputData%ExternalCableDeltaL) -ENDIF -IF (ALLOCATED(InputData%ExternalCableDeltaLdot)) THEN - DEALLOCATE(InputData%ExternalCableDeltaLdot) -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 - CALL MeshDestroy( InputData%PtfmMotionMesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(InputData%BStCMotionMesh)) THEN -DO i2 = LBOUND(InputData%BStCMotionMesh,2), UBOUND(InputData%BStCMotionMesh,2) -DO i1 = LBOUND(InputData%BStCMotionMesh,1), UBOUND(InputData%BStCMotionMesh,1) - CALL MeshDestroy( InputData%BStCMotionMesh(i1,i2), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO - DEALLOCATE(InputData%BStCMotionMesh) -ENDIF -IF (ALLOCATED(InputData%NStCMotionMesh)) THEN -DO i1 = LBOUND(InputData%NStCMotionMesh,1), UBOUND(InputData%NStCMotionMesh,1) - CALL MeshDestroy( InputData%NStCMotionMesh(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(InputData%NStCMotionMesh) -ENDIF -IF (ALLOCATED(InputData%TStCMotionMesh)) THEN -DO i1 = LBOUND(InputData%TStCMotionMesh,1), UBOUND(InputData%TStCMotionMesh,1) - CALL MeshDestroy( InputData%TStCMotionMesh(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(InputData%TStCMotionMesh) -ENDIF -IF (ALLOCATED(InputData%SStCMotionMesh)) THEN -DO i1 = LBOUND(InputData%SStCMotionMesh,1), UBOUND(InputData%SStCMotionMesh,1) - CALL MeshDestroy( InputData%SStCMotionMesh(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(InputData%SStCMotionMesh) -ENDIF -IF (ALLOCATED(InputData%LidSpeed)) THEN - DEALLOCATE(InputData%LidSpeed) -ENDIF -IF (ALLOCATED(InputData%MsrPositionsX)) THEN - DEALLOCATE(InputData%MsrPositionsX) -ENDIF -IF (ALLOCATED(InputData%MsrPositionsY)) THEN - DEALLOCATE(InputData%MsrPositionsY) -ENDIF -IF (ALLOCATED(InputData%MsrPositionsZ)) THEN - DEALLOCATE(InputData%MsrPositionsZ) -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 - Int_BufSz = Int_BufSz + 1 ! ExternalBlAirfoilCom allocated yes/no - IF ( ALLOCATED(InData%ExternalBlAirfoilCom) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ExternalBlAirfoilCom upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%ExternalBlAirfoilCom) ! ExternalBlAirfoilCom - END IF - Int_BufSz = Int_BufSz + 1 ! ExternalCableDeltaL allocated yes/no - IF ( ALLOCATED(InData%ExternalCableDeltaL) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ExternalCableDeltaL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%ExternalCableDeltaL) ! ExternalCableDeltaL - END IF - Int_BufSz = Int_BufSz + 1 ! ExternalCableDeltaLdot allocated yes/no - IF ( ALLOCATED(InData%ExternalCableDeltaLdot) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ExternalCableDeltaLdot upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%ExternalCableDeltaLdot) ! ExternalCableDeltaLdot - END IF - 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 - Re_BufSz = Re_BufSz + 1 ! LSShftFxa - Re_BufSz = Re_BufSz + 1 ! LSShftFys - Re_BufSz = Re_BufSz + 1 ! LSShftFzs - 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 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! PtfmMotionMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%PtfmMotionMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! PtfmMotionMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! PtfmMotionMesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! PtfmMotionMesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! PtfmMotionMesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! BStCMotionMesh allocated yes/no - IF ( ALLOCATED(InData%BStCMotionMesh) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BStCMotionMesh upper/lower bounds for each dimension - DO i2 = LBOUND(InData%BStCMotionMesh,2), UBOUND(InData%BStCMotionMesh,2) - DO i1 = LBOUND(InData%BStCMotionMesh,1), UBOUND(InData%BStCMotionMesh,1) - Int_BufSz = Int_BufSz + 3 ! BStCMotionMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%BStCMotionMesh(i1,i2), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! BStCMotionMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BStCMotionMesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BStCMotionMesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BStCMotionMesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! NStCMotionMesh allocated yes/no - IF ( ALLOCATED(InData%NStCMotionMesh) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! NStCMotionMesh upper/lower bounds for each dimension - DO i1 = LBOUND(InData%NStCMotionMesh,1), UBOUND(InData%NStCMotionMesh,1) - Int_BufSz = Int_BufSz + 3 ! NStCMotionMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%NStCMotionMesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! NStCMotionMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! NStCMotionMesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! NStCMotionMesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! NStCMotionMesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! TStCMotionMesh allocated yes/no - IF ( ALLOCATED(InData%TStCMotionMesh) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TStCMotionMesh upper/lower bounds for each dimension - DO i1 = LBOUND(InData%TStCMotionMesh,1), UBOUND(InData%TStCMotionMesh,1) - Int_BufSz = Int_BufSz + 3 ! TStCMotionMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%TStCMotionMesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! TStCMotionMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! TStCMotionMesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! TStCMotionMesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! TStCMotionMesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! SStCMotionMesh allocated yes/no - IF ( ALLOCATED(InData%SStCMotionMesh) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! SStCMotionMesh upper/lower bounds for each dimension - DO i1 = LBOUND(InData%SStCMotionMesh,1), UBOUND(InData%SStCMotionMesh,1) - Int_BufSz = Int_BufSz + 3 ! SStCMotionMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%SStCMotionMesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! SStCMotionMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SStCMotionMesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SStCMotionMesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SStCMotionMesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! LidSpeed allocated yes/no - IF ( ALLOCATED(InData%LidSpeed) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LidSpeed upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%LidSpeed) ! LidSpeed - END IF - Int_BufSz = Int_BufSz + 1 ! MsrPositionsX allocated yes/no - IF ( ALLOCATED(InData%MsrPositionsX) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! MsrPositionsX upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%MsrPositionsX) ! MsrPositionsX - END IF - Int_BufSz = Int_BufSz + 1 ! MsrPositionsY allocated yes/no - IF ( ALLOCATED(InData%MsrPositionsY) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! MsrPositionsY upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%MsrPositionsY) ! MsrPositionsY - END IF - Int_BufSz = Int_BufSz + 1 ! MsrPositionsZ allocated yes/no - IF ( ALLOCATED(InData%MsrPositionsZ) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! MsrPositionsZ upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%MsrPositionsZ) ! MsrPositionsZ - 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 - IF ( .NOT. ALLOCATED(InData%ExternalBlAirfoilCom) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ExternalBlAirfoilCom,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ExternalBlAirfoilCom,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ExternalBlAirfoilCom,1), UBOUND(InData%ExternalBlAirfoilCom,1) - ReKiBuf(Re_Xferred) = InData%ExternalBlAirfoilCom(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ExternalCableDeltaL) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ExternalCableDeltaL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ExternalCableDeltaL,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ExternalCableDeltaL,1), UBOUND(InData%ExternalCableDeltaL,1) - ReKiBuf(Re_Xferred) = InData%ExternalCableDeltaL(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ExternalCableDeltaLdot) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ExternalCableDeltaLdot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ExternalCableDeltaLdot,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ExternalCableDeltaLdot,1), UBOUND(InData%ExternalCableDeltaLdot,1) - ReKiBuf(Re_Xferred) = InData%ExternalCableDeltaLdot(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - 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 - ReKiBuf(Re_Xferred) = InData%LSShftFxa - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%LSShftFys - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%LSShftFzs - Re_Xferred = Re_Xferred + 1 - 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 - CALL MeshPack( InData%PtfmMotionMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! PtfmMotionMesh - 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%BStCMotionMesh) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BStCMotionMesh,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BStCMotionMesh,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BStCMotionMesh,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BStCMotionMesh,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%BStCMotionMesh,2), UBOUND(InData%BStCMotionMesh,2) - DO i1 = LBOUND(InData%BStCMotionMesh,1), UBOUND(InData%BStCMotionMesh,1) - CALL MeshPack( InData%BStCMotionMesh(i1,i2), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! BStCMotionMesh - 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 DO - END IF - IF ( .NOT. ALLOCATED(InData%NStCMotionMesh) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%NStCMotionMesh,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NStCMotionMesh,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%NStCMotionMesh,1), UBOUND(InData%NStCMotionMesh,1) - CALL MeshPack( InData%NStCMotionMesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! NStCMotionMesh - 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%TStCMotionMesh) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TStCMotionMesh,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TStCMotionMesh,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TStCMotionMesh,1), UBOUND(InData%TStCMotionMesh,1) - CALL MeshPack( InData%TStCMotionMesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! TStCMotionMesh - 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%SStCMotionMesh) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SStCMotionMesh,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SStCMotionMesh,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%SStCMotionMesh,1), UBOUND(InData%SStCMotionMesh,1) - CALL MeshPack( InData%SStCMotionMesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! SStCMotionMesh - 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%LidSpeed) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LidSpeed,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LidSpeed,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LidSpeed,1), UBOUND(InData%LidSpeed,1) - ReKiBuf(Re_Xferred) = InData%LidSpeed(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%MsrPositionsX) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MsrPositionsX,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MsrPositionsX,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%MsrPositionsX,1), UBOUND(InData%MsrPositionsX,1) - ReKiBuf(Re_Xferred) = InData%MsrPositionsX(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%MsrPositionsY) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MsrPositionsY,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MsrPositionsY,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%MsrPositionsY,1), UBOUND(InData%MsrPositionsY,1) - ReKiBuf(Re_Xferred) = InData%MsrPositionsY(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%MsrPositionsZ) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MsrPositionsZ,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MsrPositionsZ,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%MsrPositionsZ,1), UBOUND(InData%MsrPositionsZ,1) - ReKiBuf(Re_Xferred) = InData%MsrPositionsZ(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) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - 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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ExternalBlAirfoilCom not allocated - Int_Xferred = Int_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%ExternalBlAirfoilCom)) DEALLOCATE(OutData%ExternalBlAirfoilCom) - ALLOCATE(OutData%ExternalBlAirfoilCom(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ExternalBlAirfoilCom.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ExternalBlAirfoilCom,1), UBOUND(OutData%ExternalBlAirfoilCom,1) - OutData%ExternalBlAirfoilCom(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ExternalCableDeltaL not allocated - Int_Xferred = Int_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%ExternalCableDeltaL)) DEALLOCATE(OutData%ExternalCableDeltaL) - ALLOCATE(OutData%ExternalCableDeltaL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ExternalCableDeltaL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ExternalCableDeltaL,1), UBOUND(OutData%ExternalCableDeltaL,1) - OutData%ExternalCableDeltaL(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ExternalCableDeltaLdot not allocated - Int_Xferred = Int_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%ExternalCableDeltaLdot)) DEALLOCATE(OutData%ExternalCableDeltaLdot) - ALLOCATE(OutData%ExternalCableDeltaLdot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ExternalCableDeltaLdot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ExternalCableDeltaLdot,1), UBOUND(OutData%ExternalCableDeltaLdot,1) - OutData%ExternalCableDeltaLdot(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - 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 - OutData%LSShftFxa = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%LSShftFys = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%LSShftFzs = ReKiBuf(Re_Xferred) - Re_Xferred = Re_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 (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 - 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%PtfmMotionMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! PtfmMotionMesh - 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 ! BStCMotionMesh not allocated - Int_Xferred = Int_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%BStCMotionMesh)) DEALLOCATE(OutData%BStCMotionMesh) - ALLOCATE(OutData%BStCMotionMesh(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BStCMotionMesh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%BStCMotionMesh,2), UBOUND(OutData%BStCMotionMesh,2) - DO i1 = LBOUND(OutData%BStCMotionMesh,1), UBOUND(OutData%BStCMotionMesh,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%BStCMotionMesh(i1,i2), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! BStCMotionMesh - 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 DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NStCMotionMesh not allocated - Int_Xferred = Int_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%NStCMotionMesh)) DEALLOCATE(OutData%NStCMotionMesh) - ALLOCATE(OutData%NStCMotionMesh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NStCMotionMesh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%NStCMotionMesh,1), UBOUND(OutData%NStCMotionMesh,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%NStCMotionMesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! NStCMotionMesh - 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 ! TStCMotionMesh not allocated - Int_Xferred = Int_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%TStCMotionMesh)) DEALLOCATE(OutData%TStCMotionMesh) - ALLOCATE(OutData%TStCMotionMesh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TStCMotionMesh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TStCMotionMesh,1), UBOUND(OutData%TStCMotionMesh,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%TStCMotionMesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! TStCMotionMesh - 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 ! SStCMotionMesh not allocated - Int_Xferred = Int_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%SStCMotionMesh)) DEALLOCATE(OutData%SStCMotionMesh) - ALLOCATE(OutData%SStCMotionMesh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SStCMotionMesh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%SStCMotionMesh,1), UBOUND(OutData%SStCMotionMesh,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%SStCMotionMesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! SStCMotionMesh - 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 ! LidSpeed not allocated - Int_Xferred = Int_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%LidSpeed)) DEALLOCATE(OutData%LidSpeed) - ALLOCATE(OutData%LidSpeed(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LidSpeed.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LidSpeed,1), UBOUND(OutData%LidSpeed,1) - OutData%LidSpeed(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MsrPositionsX not allocated - Int_Xferred = Int_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%MsrPositionsX)) DEALLOCATE(OutData%MsrPositionsX) - ALLOCATE(OutData%MsrPositionsX(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MsrPositionsX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%MsrPositionsX,1), UBOUND(OutData%MsrPositionsX,1) - OutData%MsrPositionsX(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MsrPositionsY not allocated - Int_Xferred = Int_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%MsrPositionsY)) DEALLOCATE(OutData%MsrPositionsY) - ALLOCATE(OutData%MsrPositionsY(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MsrPositionsY.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%MsrPositionsY,1), UBOUND(OutData%MsrPositionsY,1) - OutData%MsrPositionsY(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MsrPositionsZ not allocated - Int_Xferred = Int_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%MsrPositionsZ)) DEALLOCATE(OutData%MsrPositionsZ) - ALLOCATE(OutData%MsrPositionsZ(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MsrPositionsZ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%MsrPositionsZ,1), UBOUND(OutData%MsrPositionsZ,1) - OutData%MsrPositionsZ(i1) = ReKiBuf(Re_Xferred) - 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) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_CopyOutput' -! + ErrMsg = '' + DstInitInputData%InputFile = SrcInitInputData%InputFile + DstInitInputData%Linearize = SrcInitInputData%Linearize + DstInitInputData%NumBl = SrcInitInputData%NumBl + DstInitInputData%RootName = SrcInitInputData%RootName + if (allocated(SrcInitInputData%BlPitchInit)) then + LB(1:1) = lbound(SrcInitInputData%BlPitchInit) + UB(1:1) = ubound(SrcInitInputData%BlPitchInit) + if (.not. allocated(DstInitInputData%BlPitchInit)) then + allocate(DstInitInputData%BlPitchInit(LB(1):UB(1)), 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 + end if + DstInitInputData%Gravity = SrcInitInputData%Gravity + DstInitInputData%NacRefPos = SrcInitInputData%NacRefPos + DstInitInputData%NacTransDisp = SrcInitInputData%NacTransDisp + DstInitInputData%NacOrient = SrcInitInputData%NacOrient + DstInitInputData%NacRefOrient = SrcInitInputData%NacRefOrient + DstInitInputData%TwrBaseRefPos = SrcInitInputData%TwrBaseRefPos + DstInitInputData%TwrBaseTransDisp = SrcInitInputData%TwrBaseTransDisp + DstInitInputData%TwrBaseOrient = SrcInitInputData%TwrBaseOrient + DstInitInputData%TwrBaseRefOrient = SrcInitInputData%TwrBaseRefOrient + DstInitInputData%PtfmRefPos = SrcInitInputData%PtfmRefPos + DstInitInputData%PtfmTransDisp = SrcInitInputData%PtfmTransDisp + DstInitInputData%PtfmOrient = SrcInitInputData%PtfmOrient + DstInitInputData%PtfmRefOrient = SrcInitInputData%PtfmRefOrient + 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%BladeRootRefPos)) then + LB(1:2) = lbound(SrcInitInputData%BladeRootRefPos) + UB(1:2) = ubound(SrcInitInputData%BladeRootRefPos) + if (.not. allocated(DstInitInputData%BladeRootRefPos)) then + allocate(DstInitInputData%BladeRootRefPos(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%BladeRootRefPos.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%BladeRootRefPos = SrcInitInputData%BladeRootRefPos + end if + if (allocated(SrcInitInputData%BladeRootTransDisp)) then + LB(1:2) = lbound(SrcInitInputData%BladeRootTransDisp) + UB(1:2) = ubound(SrcInitInputData%BladeRootTransDisp) + if (.not. allocated(DstInitInputData%BladeRootTransDisp)) then + allocate(DstInitInputData%BladeRootTransDisp(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%BladeRootTransDisp.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%BladeRootTransDisp = SrcInitInputData%BladeRootTransDisp + end if + if (allocated(SrcInitInputData%BladeRootOrient)) then + LB(1:3) = lbound(SrcInitInputData%BladeRootOrient) + UB(1:3) = ubound(SrcInitInputData%BladeRootOrient) + if (.not. allocated(DstInitInputData%BladeRootOrient)) then + allocate(DstInitInputData%BladeRootOrient(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%BladeRootOrient.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%BladeRootOrient = SrcInitInputData%BladeRootOrient + end if + if (allocated(SrcInitInputData%BladeRootRefOrient)) then + LB(1:3) = lbound(SrcInitInputData%BladeRootRefOrient) + UB(1:3) = ubound(SrcInitInputData%BladeRootRefOrient) + if (.not. allocated(DstInitInputData%BladeRootRefOrient)) then + allocate(DstInitInputData%BladeRootRefOrient(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%BladeRootRefOrient.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%BladeRootRefOrient = SrcInitInputData%BladeRootRefOrient + end if + 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%NumCableControl = SrcInitInputData%NumCableControl + if (allocated(SrcInitInputData%CableControlRequestor)) then + LB(1:1) = lbound(SrcInitInputData%CableControlRequestor) + UB(1:1) = ubound(SrcInitInputData%CableControlRequestor) + if (.not. allocated(DstInitInputData%CableControlRequestor)) then + allocate(DstInitInputData%CableControlRequestor(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%CableControlRequestor.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%CableControlRequestor = SrcInitInputData%CableControlRequestor + end if + DstInitInputData%InterpOrder = SrcInitInputData%InterpOrder + if (allocated(SrcInitInputData%fromSCGlob)) then + LB(1:1) = lbound(SrcInitInputData%fromSCGlob) + UB(1:1) = ubound(SrcInitInputData%fromSCGlob) + if (.not. allocated(DstInitInputData%fromSCGlob)) then + allocate(DstInitInputData%fromSCGlob(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitInputData%fromSC)) then + LB(1:1) = lbound(SrcInitInputData%fromSC) + UB(1:1) = ubound(SrcInitInputData%fromSC) + if (.not. allocated(DstInitInputData%fromSC)) then + allocate(DstInitInputData%fromSC(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitInputData%LidSpeed)) then + LB(1:1) = lbound(SrcInitInputData%LidSpeed) + UB(1:1) = ubound(SrcInitInputData%LidSpeed) + if (.not. allocated(DstInitInputData%LidSpeed)) then + allocate(DstInitInputData%LidSpeed(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%LidSpeed.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%LidSpeed = SrcInitInputData%LidSpeed + end if + if (allocated(SrcInitInputData%MsrPositionsX)) then + LB(1:1) = lbound(SrcInitInputData%MsrPositionsX) + UB(1:1) = ubound(SrcInitInputData%MsrPositionsX) + if (.not. allocated(DstInitInputData%MsrPositionsX)) then + allocate(DstInitInputData%MsrPositionsX(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%MsrPositionsX.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%MsrPositionsX = SrcInitInputData%MsrPositionsX + end if + if (allocated(SrcInitInputData%MsrPositionsY)) then + LB(1:1) = lbound(SrcInitInputData%MsrPositionsY) + UB(1:1) = ubound(SrcInitInputData%MsrPositionsY) + if (.not. allocated(DstInitInputData%MsrPositionsY)) then + allocate(DstInitInputData%MsrPositionsY(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%MsrPositionsY.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%MsrPositionsY = SrcInitInputData%MsrPositionsY + end if + if (allocated(SrcInitInputData%MsrPositionsZ)) then + LB(1:1) = lbound(SrcInitInputData%MsrPositionsZ) + UB(1:1) = ubound(SrcInitInputData%MsrPositionsZ) + if (.not. allocated(DstInitInputData%MsrPositionsZ)) then + allocate(DstInitInputData%MsrPositionsZ(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%MsrPositionsZ.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%MsrPositionsZ = SrcInitInputData%MsrPositionsZ + end if + DstInitInputData%SensorType = SrcInitInputData%SensorType + DstInitInputData%NumBeam = SrcInitInputData%NumBeam + DstInitInputData%NumPulseGate = SrcInitInputData%NumPulseGate + DstInitInputData%PulseSpacing = SrcInitInputData%PulseSpacing + DstInitInputData%URefLid = SrcInitInputData%URefLid +end subroutine + +subroutine SrvD_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(SrvD_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SrvD_DestroyInitInput' 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%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 -IF (ALLOCATED(SrcOutputData%CableDeltaL)) THEN - i1_l = LBOUND(SrcOutputData%CableDeltaL,1) - i1_u = UBOUND(SrcOutputData%CableDeltaL,1) - IF (.NOT. ALLOCATED(DstOutputData%CableDeltaL)) THEN - ALLOCATE(DstOutputData%CableDeltaL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%CableDeltaL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%CableDeltaL = SrcOutputData%CableDeltaL -ENDIF -IF (ALLOCATED(SrcOutputData%CableDeltaLdot)) THEN - i1_l = LBOUND(SrcOutputData%CableDeltaLdot,1) - i1_u = UBOUND(SrcOutputData%CableDeltaLdot,1) - IF (.NOT. ALLOCATED(DstOutputData%CableDeltaLdot)) THEN - ALLOCATE(DstOutputData%CableDeltaLdot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%CableDeltaLdot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%CableDeltaLdot = SrcOutputData%CableDeltaLdot -ENDIF -IF (ALLOCATED(SrcOutputData%BStCLoadMesh)) THEN - i1_l = LBOUND(SrcOutputData%BStCLoadMesh,1) - i1_u = UBOUND(SrcOutputData%BStCLoadMesh,1) - i2_l = LBOUND(SrcOutputData%BStCLoadMesh,2) - i2_u = UBOUND(SrcOutputData%BStCLoadMesh,2) - IF (.NOT. ALLOCATED(DstOutputData%BStCLoadMesh)) THEN - ALLOCATE(DstOutputData%BStCLoadMesh(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%BStCLoadMesh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcOutputData%BStCLoadMesh,2), UBOUND(SrcOutputData%BStCLoadMesh,2) - DO i1 = LBOUND(SrcOutputData%BStCLoadMesh,1), UBOUND(SrcOutputData%BStCLoadMesh,1) - CALL MeshCopy( SrcOutputData%BStCLoadMesh(i1,i2), DstOutputData%BStCLoadMesh(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcOutputData%NStCLoadMesh)) THEN - i1_l = LBOUND(SrcOutputData%NStCLoadMesh,1) - i1_u = UBOUND(SrcOutputData%NStCLoadMesh,1) - IF (.NOT. ALLOCATED(DstOutputData%NStCLoadMesh)) THEN - ALLOCATE(DstOutputData%NStCLoadMesh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%NStCLoadMesh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcOutputData%NStCLoadMesh,1), UBOUND(SrcOutputData%NStCLoadMesh,1) - CALL MeshCopy( SrcOutputData%NStCLoadMesh(i1), DstOutputData%NStCLoadMesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcOutputData%TStCLoadMesh)) THEN - i1_l = LBOUND(SrcOutputData%TStCLoadMesh,1) - i1_u = UBOUND(SrcOutputData%TStCLoadMesh,1) - IF (.NOT. ALLOCATED(DstOutputData%TStCLoadMesh)) THEN - ALLOCATE(DstOutputData%TStCLoadMesh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%TStCLoadMesh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcOutputData%TStCLoadMesh,1), UBOUND(SrcOutputData%TStCLoadMesh,1) - CALL MeshCopy( SrcOutputData%TStCLoadMesh(i1), DstOutputData%TStCLoadMesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcOutputData%SStCLoadMesh)) THEN - i1_l = LBOUND(SrcOutputData%SStCLoadMesh,1) - i1_u = UBOUND(SrcOutputData%SStCLoadMesh,1) - IF (.NOT. ALLOCATED(DstOutputData%SStCLoadMesh)) THEN - ALLOCATE(DstOutputData%SStCLoadMesh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%SStCLoadMesh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcOutputData%SStCLoadMesh,1), UBOUND(SrcOutputData%SStCLoadMesh,1) - CALL MeshCopy( SrcOutputData%SStCLoadMesh(i1), DstOutputData%SStCLoadMesh(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 - END SUBROUTINE SrvD_CopyOutput - - SUBROUTINE SrvD_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(SrvD_OutputType), INTENT(INOUT) :: OutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_DestroyOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -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%Lidar)) THEN - DEALLOCATE(OutputData%Lidar) -ENDIF -IF (ALLOCATED(OutputData%CableDeltaL)) THEN - DEALLOCATE(OutputData%CableDeltaL) -ENDIF -IF (ALLOCATED(OutputData%CableDeltaLdot)) THEN - DEALLOCATE(OutputData%CableDeltaLdot) -ENDIF -IF (ALLOCATED(OutputData%BStCLoadMesh)) THEN -DO i2 = LBOUND(OutputData%BStCLoadMesh,2), UBOUND(OutputData%BStCLoadMesh,2) -DO i1 = LBOUND(OutputData%BStCLoadMesh,1), UBOUND(OutputData%BStCLoadMesh,1) - CALL MeshDestroy( OutputData%BStCLoadMesh(i1,i2), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO - DEALLOCATE(OutputData%BStCLoadMesh) -ENDIF -IF (ALLOCATED(OutputData%NStCLoadMesh)) THEN -DO i1 = LBOUND(OutputData%NStCLoadMesh,1), UBOUND(OutputData%NStCLoadMesh,1) - CALL MeshDestroy( OutputData%NStCLoadMesh(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(OutputData%NStCLoadMesh) -ENDIF -IF (ALLOCATED(OutputData%TStCLoadMesh)) THEN -DO i1 = LBOUND(OutputData%TStCLoadMesh,1), UBOUND(OutputData%TStCLoadMesh,1) - CALL MeshDestroy( OutputData%TStCLoadMesh(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(OutputData%TStCLoadMesh) -ENDIF -IF (ALLOCATED(OutputData%SStCLoadMesh)) THEN -DO i1 = LBOUND(OutputData%SStCLoadMesh,1), UBOUND(OutputData%SStCLoadMesh,1) - CALL MeshDestroy( OutputData%SStCLoadMesh(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(OutputData%SStCLoadMesh) -ENDIF -IF (ALLOCATED(OutputData%toSC)) THEN - DEALLOCATE(OutputData%toSC) -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 ! 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 - 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 - Int_BufSz = Int_BufSz + 1 ! CableDeltaLdot allocated yes/no - IF ( ALLOCATED(InData%CableDeltaLdot) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! CableDeltaLdot upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CableDeltaLdot) ! CableDeltaLdot - END IF - Int_BufSz = Int_BufSz + 1 ! BStCLoadMesh allocated yes/no - IF ( ALLOCATED(InData%BStCLoadMesh) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BStCLoadMesh upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i2 = LBOUND(InData%BStCLoadMesh,2), UBOUND(InData%BStCLoadMesh,2) - DO i1 = LBOUND(InData%BStCLoadMesh,1), UBOUND(InData%BStCLoadMesh,1) - Int_BufSz = Int_BufSz + 3 ! BStCLoadMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%BStCLoadMesh(i1,i2), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! BStCLoadMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BStCLoadMesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BStCLoadMesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BStCLoadMesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! NStCLoadMesh allocated yes/no - IF ( ALLOCATED(InData%NStCLoadMesh) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! NStCLoadMesh upper/lower bounds for each dimension - DO i1 = LBOUND(InData%NStCLoadMesh,1), UBOUND(InData%NStCLoadMesh,1) - Int_BufSz = Int_BufSz + 3 ! NStCLoadMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%NStCLoadMesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! NStCLoadMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! NStCLoadMesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! NStCLoadMesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! NStCLoadMesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! TStCLoadMesh allocated yes/no - IF ( ALLOCATED(InData%TStCLoadMesh) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TStCLoadMesh upper/lower bounds for each dimension - DO i1 = LBOUND(InData%TStCLoadMesh,1), UBOUND(InData%TStCLoadMesh,1) - Int_BufSz = Int_BufSz + 3 ! TStCLoadMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%TStCLoadMesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! TStCLoadMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! TStCLoadMesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! TStCLoadMesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! TStCLoadMesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! SStCLoadMesh allocated yes/no - IF ( ALLOCATED(InData%SStCLoadMesh) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! SStCLoadMesh upper/lower bounds for each dimension - DO i1 = LBOUND(InData%SStCLoadMesh,1), UBOUND(InData%SStCLoadMesh,1) - Int_BufSz = Int_BufSz + 3 ! SStCLoadMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%SStCLoadMesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! SStCLoadMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SStCLoadMesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SStCLoadMesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SStCLoadMesh - 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 - 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%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 - 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 - IF ( .NOT. ALLOCATED(InData%CableDeltaLdot) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CableDeltaLdot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CableDeltaLdot,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%CableDeltaLdot,1), UBOUND(InData%CableDeltaLdot,1) - ReKiBuf(Re_Xferred) = InData%CableDeltaLdot(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BStCLoadMesh) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BStCLoadMesh,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BStCLoadMesh,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BStCLoadMesh,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BStCLoadMesh,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%BStCLoadMesh,2), UBOUND(InData%BStCLoadMesh,2) - DO i1 = LBOUND(InData%BStCLoadMesh,1), UBOUND(InData%BStCLoadMesh,1) - CALL MeshPack( InData%BStCLoadMesh(i1,i2), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! BStCLoadMesh - 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 DO - END IF - IF ( .NOT. ALLOCATED(InData%NStCLoadMesh) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%NStCLoadMesh,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NStCLoadMesh,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%NStCLoadMesh,1), UBOUND(InData%NStCLoadMesh,1) - CALL MeshPack( InData%NStCLoadMesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! NStCLoadMesh - 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%TStCLoadMesh) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TStCLoadMesh,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TStCLoadMesh,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TStCLoadMesh,1), UBOUND(InData%TStCLoadMesh,1) - CALL MeshPack( InData%TStCLoadMesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! TStCLoadMesh - 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%SStCLoadMesh) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SStCLoadMesh,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SStCLoadMesh,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%SStCLoadMesh,1), UBOUND(InData%SStCLoadMesh,1) - CALL MeshPack( InData%SStCLoadMesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! SStCLoadMesh - 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 - 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) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - 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 ! 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 - 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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CableDeltaLdot not allocated - Int_Xferred = Int_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%CableDeltaLdot)) DEALLOCATE(OutData%CableDeltaLdot) - ALLOCATE(OutData%CableDeltaLdot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CableDeltaLdot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%CableDeltaLdot,1), UBOUND(OutData%CableDeltaLdot,1) - OutData%CableDeltaLdot(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BStCLoadMesh not allocated - Int_Xferred = Int_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%BStCLoadMesh)) DEALLOCATE(OutData%BStCLoadMesh) - ALLOCATE(OutData%BStCLoadMesh(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BStCLoadMesh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%BStCLoadMesh,2), UBOUND(OutData%BStCLoadMesh,2) - DO i1 = LBOUND(OutData%BStCLoadMesh,1), UBOUND(OutData%BStCLoadMesh,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%BStCLoadMesh(i1,i2), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! BStCLoadMesh - 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 DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NStCLoadMesh not allocated - Int_Xferred = Int_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%NStCLoadMesh)) DEALLOCATE(OutData%NStCLoadMesh) - ALLOCATE(OutData%NStCLoadMesh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NStCLoadMesh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%NStCLoadMesh,1), UBOUND(OutData%NStCLoadMesh,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%NStCLoadMesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! NStCLoadMesh - 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 ! TStCLoadMesh not allocated - Int_Xferred = Int_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%TStCLoadMesh)) DEALLOCATE(OutData%TStCLoadMesh) - ALLOCATE(OutData%TStCLoadMesh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TStCLoadMesh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TStCLoadMesh,1), UBOUND(OutData%TStCLoadMesh,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%TStCLoadMesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! TStCLoadMesh - 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 ! SStCLoadMesh not allocated - Int_Xferred = Int_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%SStCLoadMesh)) DEALLOCATE(OutData%SStCLoadMesh) - ALLOCATE(OutData%SStCLoadMesh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SStCLoadMesh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%SStCLoadMesh,1), UBOUND(OutData%SStCLoadMesh,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%SStCLoadMesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! SStCLoadMesh - 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 - 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 + ErrMsg = '' + if (allocated(InitInputData%BlPitchInit)) then + deallocate(InitInputData%BlPitchInit) + end if + if (allocated(InitInputData%BladeRootRefPos)) then + deallocate(InitInputData%BladeRootRefPos) + end if + if (allocated(InitInputData%BladeRootTransDisp)) then + deallocate(InitInputData%BladeRootTransDisp) + end if + if (allocated(InitInputData%BladeRootOrient)) then + deallocate(InitInputData%BladeRootOrient) + end if + if (allocated(InitInputData%BladeRootRefOrient)) then + deallocate(InitInputData%BladeRootRefOrient) + end if + call NWTC_Library_DestroyFileInfoType(InitInputData%PassedPrimaryInputData, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(InitInputData%CableControlRequestor)) then + deallocate(InitInputData%CableControlRequestor) + end if + if (allocated(InitInputData%fromSCGlob)) then + deallocate(InitInputData%fromSCGlob) + end if + if (allocated(InitInputData%fromSC)) then + deallocate(InitInputData%fromSC) + end if + if (allocated(InitInputData%LidSpeed)) then + deallocate(InitInputData%LidSpeed) + end if + if (allocated(InitInputData%MsrPositionsX)) then + deallocate(InitInputData%MsrPositionsX) + end if + if (allocated(InitInputData%MsrPositionsY)) then + deallocate(InitInputData%MsrPositionsY) + end if + if (allocated(InitInputData%MsrPositionsZ)) then + deallocate(InitInputData%MsrPositionsZ) + end if +end subroutine + +subroutine SrvD_PackInitInput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SrvD_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SrvD_PackInitInput' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%InputFile) + call RegPack(RF, InData%Linearize) + call RegPack(RF, InData%NumBl) + call RegPack(RF, InData%RootName) + call RegPackAlloc(RF, InData%BlPitchInit) + call RegPack(RF, InData%Gravity) + call RegPack(RF, InData%NacRefPos) + call RegPack(RF, InData%NacTransDisp) + call RegPack(RF, InData%NacOrient) + call RegPack(RF, InData%NacRefOrient) + call RegPack(RF, InData%TwrBaseRefPos) + call RegPack(RF, InData%TwrBaseTransDisp) + call RegPack(RF, InData%TwrBaseOrient) + call RegPack(RF, InData%TwrBaseRefOrient) + call RegPack(RF, InData%PtfmRefPos) + call RegPack(RF, InData%PtfmTransDisp) + call RegPack(RF, InData%PtfmOrient) + call RegPack(RF, InData%PtfmRefOrient) + call RegPack(RF, InData%Tmax) + call RegPack(RF, InData%AvgWindSpeed) + call RegPack(RF, InData%AirDens) + call RegPack(RF, InData%NumSC2CtrlGlob) + call RegPack(RF, InData%NumSC2Ctrl) + call RegPack(RF, InData%NumCtrl2SC) + call RegPack(RF, InData%TrimCase) + call RegPack(RF, InData%TrimGain) + call RegPack(RF, InData%RotSpeedRef) + call RegPackAlloc(RF, InData%BladeRootRefPos) + call RegPackAlloc(RF, InData%BladeRootTransDisp) + call RegPackAlloc(RF, InData%BladeRootOrient) + call RegPackAlloc(RF, InData%BladeRootRefOrient) + call RegPack(RF, InData%UseInputFile) + call NWTC_Library_PackFileInfoType(RF, InData%PassedPrimaryInputData) + call RegPack(RF, InData%NumCableControl) + call RegPackAlloc(RF, InData%CableControlRequestor) + call RegPack(RF, InData%InterpOrder) + call RegPackAlloc(RF, InData%fromSCGlob) + call RegPackAlloc(RF, InData%fromSC) + call RegPackAlloc(RF, InData%LidSpeed) + call RegPackAlloc(RF, InData%MsrPositionsX) + call RegPackAlloc(RF, InData%MsrPositionsY) + call RegPackAlloc(RF, InData%MsrPositionsZ) + call RegPack(RF, InData%SensorType) + call RegPack(RF, InData%NumBeam) + call RegPack(RF, InData%NumPulseGate) + call RegPack(RF, InData%PulseSpacing) + call RegPack(RF, InData%URefLid) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SrvD_UnPackInitInput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SrvD_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SrvD_UnPackInitInput' + integer(B4Ki) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%InputFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Linearize); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumBl); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RootName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BlPitchInit); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Gravity); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NacRefPos); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NacTransDisp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NacOrient); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NacRefOrient); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TwrBaseRefPos); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TwrBaseTransDisp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TwrBaseOrient); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TwrBaseRefOrient); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PtfmRefPos); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PtfmTransDisp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PtfmOrient); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PtfmRefOrient); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Tmax); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AvgWindSpeed); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AirDens); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumSC2CtrlGlob); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumSC2Ctrl); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumCtrl2SC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TrimCase); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TrimGain); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RotSpeedRef); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BladeRootRefPos); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BladeRootTransDisp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BladeRootOrient); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BladeRootRefOrient); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UseInputFile); if (RegCheckErr(RF, RoutineName)) return + call NWTC_Library_UnpackFileInfoType(RF, OutData%PassedPrimaryInputData) ! PassedPrimaryInputData + call RegUnpack(RF, OutData%NumCableControl); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%CableControlRequestor); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%InterpOrder); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%fromSCGlob); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%fromSC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LidSpeed); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%MsrPositionsX); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%MsrPositionsY); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%MsrPositionsZ); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SensorType); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumBeam); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumPulseGate); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PulseSpacing); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%URefLid); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +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 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SrvD_CopyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcInitOutputData%WriteOutputHdr)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) + if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then + allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitOutputData%WriteOutputUnt)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) + if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then + allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), 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 + end if + 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 + LB(1:1) = lbound(SrcInitOutputData%LinNames_y) + UB(1:1) = ubound(SrcInitOutputData%LinNames_y) + if (.not. allocated(DstInitOutputData%LinNames_y)) then + allocate(DstInitOutputData%LinNames_y(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitOutputData%LinNames_x)) then + LB(1:1) = lbound(SrcInitOutputData%LinNames_x) + UB(1:1) = ubound(SrcInitOutputData%LinNames_x) + if (.not. allocated(DstInitOutputData%LinNames_x)) then + allocate(DstInitOutputData%LinNames_x(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitOutputData%LinNames_u)) then + LB(1:1) = lbound(SrcInitOutputData%LinNames_u) + UB(1:1) = ubound(SrcInitOutputData%LinNames_u) + if (.not. allocated(DstInitOutputData%LinNames_u)) then + allocate(DstInitOutputData%LinNames_u(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitOutputData%RotFrame_y)) then + LB(1:1) = lbound(SrcInitOutputData%RotFrame_y) + UB(1:1) = ubound(SrcInitOutputData%RotFrame_y) + if (.not. allocated(DstInitOutputData%RotFrame_y)) then + allocate(DstInitOutputData%RotFrame_y(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitOutputData%RotFrame_x)) then + LB(1:1) = lbound(SrcInitOutputData%RotFrame_x) + UB(1:1) = ubound(SrcInitOutputData%RotFrame_x) + if (.not. allocated(DstInitOutputData%RotFrame_x)) then + allocate(DstInitOutputData%RotFrame_x(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitOutputData%RotFrame_u)) then + LB(1:1) = lbound(SrcInitOutputData%RotFrame_u) + UB(1:1) = ubound(SrcInitOutputData%RotFrame_u) + if (.not. allocated(DstInitOutputData%RotFrame_u)) then + allocate(DstInitOutputData%RotFrame_u(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitOutputData%IsLoad_u)) then + LB(1:1) = lbound(SrcInitOutputData%IsLoad_u) + UB(1:1) = ubound(SrcInitOutputData%IsLoad_u) + if (.not. allocated(DstInitOutputData%IsLoad_u)) then + allocate(DstInitOutputData%IsLoad_u(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitOutputData%DerivOrder_x)) then + LB(1:1) = lbound(SrcInitOutputData%DerivOrder_x) + UB(1:1) = ubound(SrcInitOutputData%DerivOrder_x) + if (.not. allocated(DstInitOutputData%DerivOrder_x)) then + allocate(DstInitOutputData%DerivOrder_x(LB(1):UB(1)), 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 + end if +end subroutine + +subroutine SrvD_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(SrvD_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SrvD_DestroyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InitOutputData%WriteOutputHdr)) then + deallocate(InitOutputData%WriteOutputHdr) + end if + if (allocated(InitOutputData%WriteOutputUnt)) then + deallocate(InitOutputData%WriteOutputUnt) + end if + call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(InitOutputData%LinNames_y)) then + deallocate(InitOutputData%LinNames_y) + end if + if (allocated(InitOutputData%LinNames_x)) then + deallocate(InitOutputData%LinNames_x) + end if + if (allocated(InitOutputData%LinNames_u)) then + deallocate(InitOutputData%LinNames_u) + end if + if (allocated(InitOutputData%RotFrame_y)) then + deallocate(InitOutputData%RotFrame_y) + end if + if (allocated(InitOutputData%RotFrame_x)) then + deallocate(InitOutputData%RotFrame_x) + end if + if (allocated(InitOutputData%RotFrame_u)) then + deallocate(InitOutputData%RotFrame_u) + end if + if (allocated(InitOutputData%IsLoad_u)) then + deallocate(InitOutputData%IsLoad_u) + end if + if (allocated(InitOutputData%DerivOrder_x)) then + deallocate(InitOutputData%DerivOrder_x) + end if +end subroutine + +subroutine SrvD_PackInitOutput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SrvD_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SrvD_PackInitOutput' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%WriteOutputHdr) + call RegPackAlloc(RF, InData%WriteOutputUnt) + call NWTC_Library_PackProgDesc(RF, InData%Ver) + call RegPack(RF, InData%CouplingScheme) + call RegPack(RF, InData%UseHSSBrake) + call RegPackAlloc(RF, InData%LinNames_y) + call RegPackAlloc(RF, InData%LinNames_x) + call RegPackAlloc(RF, InData%LinNames_u) + call RegPackAlloc(RF, InData%RotFrame_y) + call RegPackAlloc(RF, InData%RotFrame_x) + call RegPackAlloc(RF, InData%RotFrame_u) + call RegPackAlloc(RF, InData%IsLoad_u) + call RegPackAlloc(RF, InData%DerivOrder_x) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SrvD_UnPackInitOutput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SrvD_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SrvD_UnPackInitOutput' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%WriteOutputHdr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WriteOutputUnt); if (RegCheckErr(RF, RoutineName)) return + call NWTC_Library_UnpackProgDesc(RF, OutData%Ver) ! Ver + call RegUnpack(RF, OutData%CouplingScheme); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UseHSSBrake); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LinNames_y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LinNames_x); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LinNames_u); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%RotFrame_y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%RotFrame_x); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%RotFrame_u); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%IsLoad_u); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%DerivOrder_x); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +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 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + 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 + LB(1:1) = lbound(SrcInputFileData%OutList) + UB(1:1) = ubound(SrcInputFileData%OutList) + if (.not. allocated(DstInputFileData%OutList)) then + allocate(DstInputFileData%OutList(LB(1):UB(1)), 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 + end if + 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 + LB(1:1) = lbound(SrcInputFileData%GenSpd_TLU) + UB(1:1) = ubound(SrcInputFileData%GenSpd_TLU) + if (.not. allocated(DstInputFileData%GenSpd_TLU)) then + allocate(DstInputFileData%GenSpd_TLU(LB(1):UB(1)), 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 + end if + if (allocated(SrcInputFileData%GenTrq_TLU)) then + LB(1:1) = lbound(SrcInputFileData%GenTrq_TLU) + UB(1:1) = ubound(SrcInputFileData%GenTrq_TLU) + if (.not. allocated(DstInputFileData%GenTrq_TLU)) then + allocate(DstInputFileData%GenTrq_TLU(LB(1):UB(1)), 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 + end if + DstInputFileData%UseLegacyInterface = SrcInputFileData%UseLegacyInterface + DstInputFileData%NumBStC = SrcInputFileData%NumBStC + if (allocated(SrcInputFileData%BStCfiles)) then + LB(1:1) = lbound(SrcInputFileData%BStCfiles) + UB(1:1) = ubound(SrcInputFileData%BStCfiles) + if (.not. allocated(DstInputFileData%BStCfiles)) then + allocate(DstInputFileData%BStCfiles(LB(1):UB(1)), 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 + end if + DstInputFileData%NumNStC = SrcInputFileData%NumNStC + if (allocated(SrcInputFileData%NStCfiles)) then + LB(1:1) = lbound(SrcInputFileData%NStCfiles) + UB(1:1) = ubound(SrcInputFileData%NStCfiles) + if (.not. allocated(DstInputFileData%NStCfiles)) then + allocate(DstInputFileData%NStCfiles(LB(1):UB(1)), 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 + end if + DstInputFileData%NumTStC = SrcInputFileData%NumTStC + if (allocated(SrcInputFileData%TStCfiles)) then + LB(1:1) = lbound(SrcInputFileData%TStCfiles) + UB(1:1) = ubound(SrcInputFileData%TStCfiles) + if (.not. allocated(DstInputFileData%TStCfiles)) then + allocate(DstInputFileData%TStCfiles(LB(1):UB(1)), 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 + end if + DstInputFileData%NumSStC = SrcInputFileData%NumSStC + if (allocated(SrcInputFileData%SStCfiles)) then + LB(1:1) = lbound(SrcInputFileData%SStCfiles) + UB(1:1) = ubound(SrcInputFileData%SStCfiles) + if (.not. allocated(DstInputFileData%SStCfiles)) then + allocate(DstInputFileData%SStCfiles(LB(1):UB(1)), 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 + end if + DstInputFileData%AfCmode = SrcInputFileData%AfCmode + DstInputFileData%AfC_Mean = SrcInputFileData%AfC_Mean + DstInputFileData%AfC_Amp = SrcInputFileData%AfC_Amp + DstInputFileData%AfC_Phase = SrcInputFileData%AfC_Phase + DstInputFileData%CCmode = SrcInputFileData%CCmode + DstInputFileData%EXavrSWAP = SrcInputFileData%EXavrSWAP +end subroutine + +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' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InputFileData%OutList)) then + deallocate(InputFileData%OutList) + end if + if (allocated(InputFileData%GenSpd_TLU)) then + deallocate(InputFileData%GenSpd_TLU) + end if + if (allocated(InputFileData%GenTrq_TLU)) then + deallocate(InputFileData%GenTrq_TLU) + end if + if (allocated(InputFileData%BStCfiles)) then + deallocate(InputFileData%BStCfiles) + end if + if (allocated(InputFileData%NStCfiles)) then + deallocate(InputFileData%NStCfiles) + end if + if (allocated(InputFileData%TStCfiles)) then + deallocate(InputFileData%TStCfiles) + end if + if (allocated(InputFileData%SStCfiles)) then + deallocate(InputFileData%SStCfiles) + end if +end subroutine + +subroutine SrvD_PackInputFile(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SrvD_InputFile), intent(in) :: InData + character(*), parameter :: RoutineName = 'SrvD_PackInputFile' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DT) + call RegPack(RF, InData%Echo) + call RegPack(RF, InData%PCMode) + call RegPack(RF, InData%TPCOn) + call RegPack(RF, InData%TPitManS) + call RegPack(RF, InData%PitManRat) + call RegPack(RF, InData%BlPitchF) + call RegPack(RF, InData%VSContrl) + call RegPack(RF, InData%GenModel) + call RegPack(RF, InData%GenEff) + call RegPack(RF, InData%GenTiStr) + call RegPack(RF, InData%GenTiStp) + call RegPack(RF, InData%SpdGenOn) + call RegPack(RF, InData%TimGenOn) + call RegPack(RF, InData%TimGenOf) + call RegPack(RF, InData%VS_RtGnSp) + call RegPack(RF, InData%VS_RtTq) + call RegPack(RF, InData%VS_Rgn2K) + call RegPack(RF, InData%VS_SlPc) + call RegPack(RF, InData%SIG_SlPc) + call RegPack(RF, InData%SIG_SySp) + call RegPack(RF, InData%SIG_RtTq) + call RegPack(RF, InData%SIG_PORt) + call RegPack(RF, InData%TEC_Freq) + call RegPack(RF, InData%TEC_NPol) + call RegPack(RF, InData%TEC_SRes) + call RegPack(RF, InData%TEC_RRes) + call RegPack(RF, InData%TEC_VLL) + call RegPack(RF, InData%TEC_SLR) + call RegPack(RF, InData%TEC_RLR) + call RegPack(RF, InData%TEC_MR) + call RegPack(RF, InData%HSSBrMode) + call RegPack(RF, InData%THSSBrDp) + call RegPack(RF, InData%HSSBrDT) + call RegPack(RF, InData%HSSBrTqF) + call RegPack(RF, InData%YCMode) + call RegPack(RF, InData%TYCOn) + call RegPack(RF, InData%YawNeut) + call RegPack(RF, InData%YawSpr) + call RegPack(RF, InData%YawDamp) + call RegPack(RF, InData%TYawManS) + call RegPack(RF, InData%YawManRat) + call RegPack(RF, InData%NacYawF) + call RegPack(RF, InData%SumPrint) + call RegPack(RF, InData%OutFile) + call RegPack(RF, InData%TabDelim) + call RegPack(RF, InData%OutFmt) + call RegPack(RF, InData%Tstart) + call RegPack(RF, InData%NumOuts) + call RegPackAlloc(RF, InData%OutList) + call RegPack(RF, InData%DLL_FileName) + call RegPack(RF, InData%DLL_ProcName) + call RegPack(RF, InData%DLL_InFile) + call RegPack(RF, InData%DLL_DT) + call RegPack(RF, InData%DLL_Ramp) + call RegPack(RF, InData%BPCutoff) + call RegPack(RF, InData%NacYaw_North) + call RegPack(RF, InData%Ptch_Cntrl) + call RegPack(RF, InData%Ptch_SetPnt) + call RegPack(RF, InData%Ptch_Min) + call RegPack(RF, InData%Ptch_Max) + call RegPack(RF, InData%PtchRate_Min) + call RegPack(RF, InData%PtchRate_Max) + call RegPack(RF, InData%Gain_OM) + call RegPack(RF, InData%GenSpd_MinOM) + call RegPack(RF, InData%GenSpd_MaxOM) + call RegPack(RF, InData%GenSpd_Dem) + call RegPack(RF, InData%GenTrq_Dem) + call RegPack(RF, InData%GenPwr_Dem) + call RegPack(RF, InData%DLL_NumTrq) + call RegPackAlloc(RF, InData%GenSpd_TLU) + call RegPackAlloc(RF, InData%GenTrq_TLU) + call RegPack(RF, InData%UseLegacyInterface) + call RegPack(RF, InData%NumBStC) + call RegPackAlloc(RF, InData%BStCfiles) + call RegPack(RF, InData%NumNStC) + call RegPackAlloc(RF, InData%NStCfiles) + call RegPack(RF, InData%NumTStC) + call RegPackAlloc(RF, InData%TStCfiles) + call RegPack(RF, InData%NumSStC) + call RegPackAlloc(RF, InData%SStCfiles) + call RegPack(RF, InData%AfCmode) + call RegPack(RF, InData%AfC_Mean) + call RegPack(RF, InData%AfC_Amp) + call RegPack(RF, InData%AfC_Phase) + call RegPack(RF, InData%CCmode) + call RegPack(RF, InData%EXavrSWAP) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SrvD_UnPackInputFile(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SrvD_InputFile), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SrvD_UnPackInputFile' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Echo); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PCMode); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TPCOn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TPitManS); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PitManRat); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BlPitchF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VSContrl); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GenModel); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GenEff); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GenTiStr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GenTiStp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SpdGenOn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TimGenOn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TimGenOf); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VS_RtGnSp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VS_RtTq); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VS_Rgn2K); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VS_SlPc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SIG_SlPc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SIG_SySp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SIG_RtTq); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SIG_PORt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TEC_Freq); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TEC_NPol); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TEC_SRes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TEC_RRes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TEC_VLL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TEC_SLR); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TEC_RLR); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TEC_MR); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HSSBrMode); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%THSSBrDp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HSSBrDT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HSSBrTqF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YCMode); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TYCOn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawNeut); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawSpr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawDamp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TYawManS); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawManRat); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NacYawF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SumPrint); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TabDelim); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutFmt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Tstart); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumOuts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%OutList); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DLL_FileName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DLL_ProcName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DLL_InFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DLL_DT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DLL_Ramp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BPCutoff); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NacYaw_North); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Ptch_Cntrl); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Ptch_SetPnt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Ptch_Min); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Ptch_Max); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PtchRate_Min); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PtchRate_Max); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Gain_OM); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GenSpd_MinOM); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GenSpd_MaxOM); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GenSpd_Dem); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GenTrq_Dem); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GenPwr_Dem); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DLL_NumTrq); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%GenSpd_TLU); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%GenTrq_TLU); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UseLegacyInterface); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumBStC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BStCfiles); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumNStC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%NStCfiles); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumTStC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TStCfiles); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumSStC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%SStCfiles); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AfCmode); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AfC_Mean); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AfC_Amp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AfC_Phase); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CCmode); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%EXavrSWAP); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +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 + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SrvD_CopyBladedDLLType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcBladedDLLTypeData%avrSWAP)) then + LB(1:1) = lbound(SrcBladedDLLTypeData%avrSWAP) + UB(1:1) = ubound(SrcBladedDLLTypeData%avrSWAP) + if (.not. allocated(DstBladedDLLTypeData%avrSWAP)) then + allocate(DstBladedDLLTypeData%avrSWAP(LB(1):UB(1)), 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 + end if + 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%PrevBlAirfoilCom = SrcBladedDLLTypeData%PrevBlAirfoilCom + DstBladedDLLTypeData%ElecPwr_prev = SrcBladedDLLTypeData%ElecPwr_prev + DstBladedDLLTypeData%GenTrq_prev = SrcBladedDLLTypeData%GenTrq_prev + if (allocated(SrcBladedDLLTypeData%toSC)) then + LB(1:1) = lbound(SrcBladedDLLTypeData%toSC) + UB(1:1) = ubound(SrcBladedDLLTypeData%toSC) + if (.not. allocated(DstBladedDLLTypeData%toSC)) then + allocate(DstBladedDLLTypeData%toSC(LB(1):UB(1)), 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 + end if + DstBladedDLLTypeData%initialized = SrcBladedDLLTypeData%initialized + DstBladedDLLTypeData%NumLogChannels = SrcBladedDLLTypeData%NumLogChannels + if (allocated(SrcBladedDLLTypeData%LogChannels_OutParam)) then + LB(1:1) = lbound(SrcBladedDLLTypeData%LogChannels_OutParam) + UB(1:1) = ubound(SrcBladedDLLTypeData%LogChannels_OutParam) + if (.not. allocated(DstBladedDLLTypeData%LogChannels_OutParam)) then + allocate(DstBladedDLLTypeData%LogChannels_OutParam(LB(1):UB(1)), 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 = LB(1), UB(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 + end do + end if + if (allocated(SrcBladedDLLTypeData%LogChannels)) then + LB(1:1) = lbound(SrcBladedDLLTypeData%LogChannels) + UB(1:1) = ubound(SrcBladedDLLTypeData%LogChannels) + if (.not. allocated(DstBladedDLLTypeData%LogChannels)) then + allocate(DstBladedDLLTypeData%LogChannels(LB(1):UB(1)), 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 + end if + 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 + LB(1:1) = lbound(SrcBladedDLLTypeData%BlPitchInput) + UB(1:1) = ubound(SrcBladedDLLTypeData%BlPitchInput) + if (.not. allocated(DstBladedDLLTypeData%BlPitchInput)) then + allocate(DstBladedDLLTypeData%BlPitchInput(LB(1):UB(1)), 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 + end if + 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%LSShftFxa = SrcBladedDLLTypeData%LSShftFxa + DstBladedDLLTypeData%LSShftFys = SrcBladedDLLTypeData%LSShftFys + DstBladedDLLTypeData%LSShftFzs = SrcBladedDLLTypeData%LSShftFzs + if (allocated(SrcBladedDLLTypeData%LidSpeed)) then + LB(1:1) = lbound(SrcBladedDLLTypeData%LidSpeed) + UB(1:1) = ubound(SrcBladedDLLTypeData%LidSpeed) + if (.not. allocated(DstBladedDLLTypeData%LidSpeed)) then + allocate(DstBladedDLLTypeData%LidSpeed(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%LidSpeed.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladedDLLTypeData%LidSpeed = SrcBladedDLLTypeData%LidSpeed + end if + if (allocated(SrcBladedDLLTypeData%MsrPositionsX)) then + LB(1:1) = lbound(SrcBladedDLLTypeData%MsrPositionsX) + UB(1:1) = ubound(SrcBladedDLLTypeData%MsrPositionsX) + if (.not. allocated(DstBladedDLLTypeData%MsrPositionsX)) then + allocate(DstBladedDLLTypeData%MsrPositionsX(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%MsrPositionsX.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladedDLLTypeData%MsrPositionsX = SrcBladedDLLTypeData%MsrPositionsX + end if + if (allocated(SrcBladedDLLTypeData%MsrPositionsY)) then + LB(1:1) = lbound(SrcBladedDLLTypeData%MsrPositionsY) + UB(1:1) = ubound(SrcBladedDLLTypeData%MsrPositionsY) + if (.not. allocated(DstBladedDLLTypeData%MsrPositionsY)) then + allocate(DstBladedDLLTypeData%MsrPositionsY(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%MsrPositionsY.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladedDLLTypeData%MsrPositionsY = SrcBladedDLLTypeData%MsrPositionsY + end if + if (allocated(SrcBladedDLLTypeData%MsrPositionsZ)) then + LB(1:1) = lbound(SrcBladedDLLTypeData%MsrPositionsZ) + UB(1:1) = ubound(SrcBladedDLLTypeData%MsrPositionsZ) + if (.not. allocated(DstBladedDLLTypeData%MsrPositionsZ)) then + allocate(DstBladedDLLTypeData%MsrPositionsZ(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%MsrPositionsZ.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladedDLLTypeData%MsrPositionsZ = SrcBladedDLLTypeData%MsrPositionsZ + end if + DstBladedDLLTypeData%SensorType = SrcBladedDLLTypeData%SensorType + DstBladedDLLTypeData%NumBeam = SrcBladedDLLTypeData%NumBeam + DstBladedDLLTypeData%NumPulseGate = SrcBladedDLLTypeData%NumPulseGate + DstBladedDLLTypeData%PulseSpacing = SrcBladedDLLTypeData%PulseSpacing + DstBladedDLLTypeData%URefLid = SrcBladedDLLTypeData%URefLid + 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 + LB(1:1) = lbound(SrcBladedDLLTypeData%GenSpd_TLU) + UB(1:1) = ubound(SrcBladedDLLTypeData%GenSpd_TLU) + if (.not. allocated(DstBladedDLLTypeData%GenSpd_TLU)) then + allocate(DstBladedDLLTypeData%GenSpd_TLU(LB(1):UB(1)), 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 + end if + if (allocated(SrcBladedDLLTypeData%GenTrq_TLU)) then + LB(1:1) = lbound(SrcBladedDLLTypeData%GenTrq_TLU) + UB(1:1) = ubound(SrcBladedDLLTypeData%GenTrq_TLU) + if (.not. allocated(DstBladedDLLTypeData%GenTrq_TLU)) then + allocate(DstBladedDLLTypeData%GenTrq_TLU(LB(1):UB(1)), 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 + end if + DstBladedDLLTypeData%Yaw_Cntrl = SrcBladedDLLTypeData%Yaw_Cntrl + if (allocated(SrcBladedDLLTypeData%PrevCableDeltaL)) then + LB(1:1) = lbound(SrcBladedDLLTypeData%PrevCableDeltaL) + UB(1:1) = ubound(SrcBladedDLLTypeData%PrevCableDeltaL) + if (.not. allocated(DstBladedDLLTypeData%PrevCableDeltaL)) then + allocate(DstBladedDLLTypeData%PrevCableDeltaL(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%PrevCableDeltaL.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladedDLLTypeData%PrevCableDeltaL = SrcBladedDLLTypeData%PrevCableDeltaL + end if + if (allocated(SrcBladedDLLTypeData%PrevCableDeltaLdot)) then + LB(1:1) = lbound(SrcBladedDLLTypeData%PrevCableDeltaLdot) + UB(1:1) = ubound(SrcBladedDLLTypeData%PrevCableDeltaLdot) + if (.not. allocated(DstBladedDLLTypeData%PrevCableDeltaLdot)) then + allocate(DstBladedDLLTypeData%PrevCableDeltaLdot(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%PrevCableDeltaLdot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladedDLLTypeData%PrevCableDeltaLdot = SrcBladedDLLTypeData%PrevCableDeltaLdot + end if + if (allocated(SrcBladedDLLTypeData%CableDeltaL)) then + LB(1:1) = lbound(SrcBladedDLLTypeData%CableDeltaL) + UB(1:1) = ubound(SrcBladedDLLTypeData%CableDeltaL) + if (.not. allocated(DstBladedDLLTypeData%CableDeltaL)) then + allocate(DstBladedDLLTypeData%CableDeltaL(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%CableDeltaL.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladedDLLTypeData%CableDeltaL = SrcBladedDLLTypeData%CableDeltaL + end if + if (allocated(SrcBladedDLLTypeData%CableDeltaLdot)) then + LB(1:1) = lbound(SrcBladedDLLTypeData%CableDeltaLdot) + UB(1:1) = ubound(SrcBladedDLLTypeData%CableDeltaLdot) + if (.not. allocated(DstBladedDLLTypeData%CableDeltaLdot)) then + allocate(DstBladedDLLTypeData%CableDeltaLdot(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%CableDeltaLdot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladedDLLTypeData%CableDeltaLdot = SrcBladedDLLTypeData%CableDeltaLdot + end if + if (allocated(SrcBladedDLLTypeData%PrevStCCmdStiff)) then + LB(1:2) = lbound(SrcBladedDLLTypeData%PrevStCCmdStiff) + UB(1:2) = ubound(SrcBladedDLLTypeData%PrevStCCmdStiff) + if (.not. allocated(DstBladedDLLTypeData%PrevStCCmdStiff)) then + allocate(DstBladedDLLTypeData%PrevStCCmdStiff(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%PrevStCCmdStiff.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladedDLLTypeData%PrevStCCmdStiff = SrcBladedDLLTypeData%PrevStCCmdStiff + end if + if (allocated(SrcBladedDLLTypeData%PrevStCCmdDamp)) then + LB(1:2) = lbound(SrcBladedDLLTypeData%PrevStCCmdDamp) + UB(1:2) = ubound(SrcBladedDLLTypeData%PrevStCCmdDamp) + if (.not. allocated(DstBladedDLLTypeData%PrevStCCmdDamp)) then + allocate(DstBladedDLLTypeData%PrevStCCmdDamp(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%PrevStCCmdDamp.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladedDLLTypeData%PrevStCCmdDamp = SrcBladedDLLTypeData%PrevStCCmdDamp + end if + if (allocated(SrcBladedDLLTypeData%PrevStCCmdBrake)) then + LB(1:2) = lbound(SrcBladedDLLTypeData%PrevStCCmdBrake) + UB(1:2) = ubound(SrcBladedDLLTypeData%PrevStCCmdBrake) + if (.not. allocated(DstBladedDLLTypeData%PrevStCCmdBrake)) then + allocate(DstBladedDLLTypeData%PrevStCCmdBrake(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%PrevStCCmdBrake.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladedDLLTypeData%PrevStCCmdBrake = SrcBladedDLLTypeData%PrevStCCmdBrake + end if + if (allocated(SrcBladedDLLTypeData%PrevStCCmdForce)) then + LB(1:2) = lbound(SrcBladedDLLTypeData%PrevStCCmdForce) + UB(1:2) = ubound(SrcBladedDLLTypeData%PrevStCCmdForce) + if (.not. allocated(DstBladedDLLTypeData%PrevStCCmdForce)) then + allocate(DstBladedDLLTypeData%PrevStCCmdForce(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%PrevStCCmdForce.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladedDLLTypeData%PrevStCCmdForce = SrcBladedDLLTypeData%PrevStCCmdForce + end if + if (allocated(SrcBladedDLLTypeData%StCCmdStiff)) then + LB(1:2) = lbound(SrcBladedDLLTypeData%StCCmdStiff) + UB(1:2) = ubound(SrcBladedDLLTypeData%StCCmdStiff) + if (.not. allocated(DstBladedDLLTypeData%StCCmdStiff)) then + allocate(DstBladedDLLTypeData%StCCmdStiff(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%StCCmdStiff.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladedDLLTypeData%StCCmdStiff = SrcBladedDLLTypeData%StCCmdStiff + end if + if (allocated(SrcBladedDLLTypeData%StCCmdDamp)) then + LB(1:2) = lbound(SrcBladedDLLTypeData%StCCmdDamp) + UB(1:2) = ubound(SrcBladedDLLTypeData%StCCmdDamp) + if (.not. allocated(DstBladedDLLTypeData%StCCmdDamp)) then + allocate(DstBladedDLLTypeData%StCCmdDamp(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%StCCmdDamp.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladedDLLTypeData%StCCmdDamp = SrcBladedDLLTypeData%StCCmdDamp + end if + if (allocated(SrcBladedDLLTypeData%StCCmdBrake)) then + LB(1:2) = lbound(SrcBladedDLLTypeData%StCCmdBrake) + UB(1:2) = ubound(SrcBladedDLLTypeData%StCCmdBrake) + if (.not. allocated(DstBladedDLLTypeData%StCCmdBrake)) then + allocate(DstBladedDLLTypeData%StCCmdBrake(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%StCCmdBrake.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladedDLLTypeData%StCCmdBrake = SrcBladedDLLTypeData%StCCmdBrake + end if + if (allocated(SrcBladedDLLTypeData%StCCmdForce)) then + LB(1:2) = lbound(SrcBladedDLLTypeData%StCCmdForce) + UB(1:2) = ubound(SrcBladedDLLTypeData%StCCmdForce) + if (.not. allocated(DstBladedDLLTypeData%StCCmdForce)) then + allocate(DstBladedDLLTypeData%StCCmdForce(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%StCCmdForce.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladedDLLTypeData%StCCmdForce = SrcBladedDLLTypeData%StCCmdForce + end if + if (allocated(SrcBladedDLLTypeData%StCMeasDisp)) then + LB(1:2) = lbound(SrcBladedDLLTypeData%StCMeasDisp) + UB(1:2) = ubound(SrcBladedDLLTypeData%StCMeasDisp) + if (.not. allocated(DstBladedDLLTypeData%StCMeasDisp)) then + allocate(DstBladedDLLTypeData%StCMeasDisp(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%StCMeasDisp.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladedDLLTypeData%StCMeasDisp = SrcBladedDLLTypeData%StCMeasDisp + end if + if (allocated(SrcBladedDLLTypeData%StCMeasVel)) then + LB(1:2) = lbound(SrcBladedDLLTypeData%StCMeasVel) + UB(1:2) = ubound(SrcBladedDLLTypeData%StCMeasVel) + if (.not. allocated(DstBladedDLLTypeData%StCMeasVel)) then + allocate(DstBladedDLLTypeData%StCMeasVel(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%StCMeasVel.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladedDLLTypeData%StCMeasVel = SrcBladedDLLTypeData%StCMeasVel + end if +end subroutine + +subroutine SrvD_DestroyBladedDLLType(BladedDLLTypeData, ErrStat, ErrMsg) + type(BladedDLLType), intent(inout) :: BladedDLLTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SrvD_DestroyBladedDLLType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(BladedDLLTypeData%avrSWAP)) then + deallocate(BladedDLLTypeData%avrSWAP) + end if + if (allocated(BladedDLLTypeData%toSC)) then + deallocate(BladedDLLTypeData%toSC) + end if + if (allocated(BladedDLLTypeData%LogChannels_OutParam)) then + LB(1:1) = lbound(BladedDLLTypeData%LogChannels_OutParam) + UB(1:1) = ubound(BladedDLLTypeData%LogChannels_OutParam) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyOutParmType(BladedDLLTypeData%LogChannels_OutParam(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(BladedDLLTypeData%LogChannels_OutParam) + end if + if (allocated(BladedDLLTypeData%LogChannels)) then + deallocate(BladedDLLTypeData%LogChannels) + end if + if (allocated(BladedDLLTypeData%BlPitchInput)) then + deallocate(BladedDLLTypeData%BlPitchInput) + end if + if (allocated(BladedDLLTypeData%LidSpeed)) then + deallocate(BladedDLLTypeData%LidSpeed) + end if + if (allocated(BladedDLLTypeData%MsrPositionsX)) then + deallocate(BladedDLLTypeData%MsrPositionsX) + end if + if (allocated(BladedDLLTypeData%MsrPositionsY)) then + deallocate(BladedDLLTypeData%MsrPositionsY) + end if + if (allocated(BladedDLLTypeData%MsrPositionsZ)) then + deallocate(BladedDLLTypeData%MsrPositionsZ) + end if + if (allocated(BladedDLLTypeData%GenSpd_TLU)) then + deallocate(BladedDLLTypeData%GenSpd_TLU) + end if + if (allocated(BladedDLLTypeData%GenTrq_TLU)) then + deallocate(BladedDLLTypeData%GenTrq_TLU) + end if + if (allocated(BladedDLLTypeData%PrevCableDeltaL)) then + deallocate(BladedDLLTypeData%PrevCableDeltaL) + end if + if (allocated(BladedDLLTypeData%PrevCableDeltaLdot)) then + deallocate(BladedDLLTypeData%PrevCableDeltaLdot) + end if + if (allocated(BladedDLLTypeData%CableDeltaL)) then + deallocate(BladedDLLTypeData%CableDeltaL) + end if + if (allocated(BladedDLLTypeData%CableDeltaLdot)) then + deallocate(BladedDLLTypeData%CableDeltaLdot) + end if + if (allocated(BladedDLLTypeData%PrevStCCmdStiff)) then + deallocate(BladedDLLTypeData%PrevStCCmdStiff) + end if + if (allocated(BladedDLLTypeData%PrevStCCmdDamp)) then + deallocate(BladedDLLTypeData%PrevStCCmdDamp) + end if + if (allocated(BladedDLLTypeData%PrevStCCmdBrake)) then + deallocate(BladedDLLTypeData%PrevStCCmdBrake) + end if + if (allocated(BladedDLLTypeData%PrevStCCmdForce)) then + deallocate(BladedDLLTypeData%PrevStCCmdForce) + end if + if (allocated(BladedDLLTypeData%StCCmdStiff)) then + deallocate(BladedDLLTypeData%StCCmdStiff) + end if + if (allocated(BladedDLLTypeData%StCCmdDamp)) then + deallocate(BladedDLLTypeData%StCCmdDamp) + end if + if (allocated(BladedDLLTypeData%StCCmdBrake)) then + deallocate(BladedDLLTypeData%StCCmdBrake) + end if + if (allocated(BladedDLLTypeData%StCCmdForce)) then + deallocate(BladedDLLTypeData%StCCmdForce) + end if + if (allocated(BladedDLLTypeData%StCMeasDisp)) then + deallocate(BladedDLLTypeData%StCMeasDisp) + end if + if (allocated(BladedDLLTypeData%StCMeasVel)) then + deallocate(BladedDLLTypeData%StCMeasVel) + end if +end subroutine + +subroutine SrvD_PackBladedDLLType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(BladedDLLType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SrvD_PackBladedDLLType' + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%avrSWAP) + call RegPack(RF, InData%HSSBrTrqDemand) + call RegPack(RF, InData%YawRateCom) + call RegPack(RF, InData%GenTrq) + call RegPack(RF, InData%GenState) + call RegPack(RF, InData%BlPitchCom) + call RegPack(RF, InData%PrevBlPitch) + call RegPack(RF, InData%BlAirfoilCom) + call RegPack(RF, InData%PrevBlAirfoilCom) + call RegPack(RF, InData%ElecPwr_prev) + call RegPack(RF, InData%GenTrq_prev) + call RegPackAlloc(RF, InData%toSC) + call RegPack(RF, InData%initialized) + call RegPack(RF, InData%NumLogChannels) + call RegPack(RF, allocated(InData%LogChannels_OutParam)) + if (allocated(InData%LogChannels_OutParam)) then + call RegPackBounds(RF, 1, lbound(InData%LogChannels_OutParam), ubound(InData%LogChannels_OutParam)) + LB(1:1) = lbound(InData%LogChannels_OutParam) + UB(1:1) = ubound(InData%LogChannels_OutParam) + do i1 = LB(1), UB(1) + call NWTC_Library_PackOutParmType(RF, InData%LogChannels_OutParam(i1)) + end do + end if + call RegPackAlloc(RF, InData%LogChannels) + call RegPack(RF, InData%ErrStat) + call RegPack(RF, InData%ErrMsg) + call RegPack(RF, InData%CurrentTime) + call RegPack(RF, InData%SimStatus) + call RegPack(RF, InData%ShaftBrakeStatusBinaryFlag) + call RegPack(RF, InData%HSSBrDeployed) + call RegPack(RF, InData%TimeHSSBrFullyDeployed) + call RegPack(RF, InData%TimeHSSBrDeployed) + call RegPack(RF, InData%OverrideYawRateWithTorque) + call RegPack(RF, InData%YawTorqueDemand) + call RegPackAlloc(RF, InData%BlPitchInput) + call RegPack(RF, InData%YawAngleFromNorth) + call RegPack(RF, InData%HorWindV) + call RegPack(RF, InData%HSS_Spd) + call RegPack(RF, InData%YawErr) + call RegPack(RF, InData%RotSpeed) + call RegPack(RF, InData%YawBrTAxp) + call RegPack(RF, InData%YawBrTAyp) + call RegPack(RF, InData%LSSTipMys) + call RegPack(RF, InData%LSSTipMzs) + call RegPack(RF, InData%LSSTipMya) + call RegPack(RF, InData%LSSTipMza) + call RegPack(RF, InData%LSSTipPxa) + call RegPack(RF, InData%Yaw) + call RegPack(RF, InData%YawRate) + call RegPack(RF, InData%YawBrMyn) + call RegPack(RF, InData%YawBrMzn) + call RegPack(RF, InData%NcIMURAxs) + call RegPack(RF, InData%NcIMURAys) + call RegPack(RF, InData%NcIMURAzs) + call RegPack(RF, InData%RotPwr) + call RegPack(RF, InData%LSSTipMxa) + call RegPack(RF, InData%RootMyc) + call RegPack(RF, InData%RootMxc) + call RegPack(RF, InData%LSShftFxa) + call RegPack(RF, InData%LSShftFys) + call RegPack(RF, InData%LSShftFzs) + call RegPackAlloc(RF, InData%LidSpeed) + call RegPackAlloc(RF, InData%MsrPositionsX) + call RegPackAlloc(RF, InData%MsrPositionsY) + call RegPackAlloc(RF, InData%MsrPositionsZ) + call RegPack(RF, InData%SensorType) + call RegPack(RF, InData%NumBeam) + call RegPack(RF, InData%NumPulseGate) + call RegPack(RF, InData%PulseSpacing) + call RegPack(RF, InData%URefLid) + call RegPack(RF, InData%DLL_DT) + call RegPack(RF, InData%DLL_InFile) + call RegPack(RF, InData%RootName) + call RegPack(RF, InData%GenTrq_Dem) + call RegPack(RF, InData%GenSpd_Dem) + call RegPack(RF, InData%Ptch_Max) + call RegPack(RF, InData%Ptch_Min) + call RegPack(RF, InData%Ptch_SetPnt) + call RegPack(RF, InData%PtchRate_Max) + call RegPack(RF, InData%PtchRate_Min) + call RegPack(RF, InData%GenPwr_Dem) + call RegPack(RF, InData%Gain_OM) + call RegPack(RF, InData%GenSpd_MaxOM) + call RegPack(RF, InData%GenSpd_MinOM) + call RegPack(RF, InData%Ptch_Cntrl) + call RegPack(RF, InData%DLL_NumTrq) + call RegPackAlloc(RF, InData%GenSpd_TLU) + call RegPackAlloc(RF, InData%GenTrq_TLU) + call RegPack(RF, InData%Yaw_Cntrl) + call RegPackAlloc(RF, InData%PrevCableDeltaL) + call RegPackAlloc(RF, InData%PrevCableDeltaLdot) + call RegPackAlloc(RF, InData%CableDeltaL) + call RegPackAlloc(RF, InData%CableDeltaLdot) + call RegPackAlloc(RF, InData%PrevStCCmdStiff) + call RegPackAlloc(RF, InData%PrevStCCmdDamp) + call RegPackAlloc(RF, InData%PrevStCCmdBrake) + call RegPackAlloc(RF, InData%PrevStCCmdForce) + call RegPackAlloc(RF, InData%StCCmdStiff) + call RegPackAlloc(RF, InData%StCCmdDamp) + call RegPackAlloc(RF, InData%StCCmdBrake) + call RegPackAlloc(RF, InData%StCCmdForce) + call RegPackAlloc(RF, InData%StCMeasDisp) + call RegPackAlloc(RF, InData%StCMeasVel) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SrvD_UnPackBladedDLLType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(BladedDLLType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SrvD_UnPackBladedDLLType' + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%avrSWAP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HSSBrTrqDemand); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawRateCom); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GenTrq); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GenState); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BlPitchCom); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PrevBlPitch); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BlAirfoilCom); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PrevBlAirfoilCom); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ElecPwr_prev); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GenTrq_prev); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%toSC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%initialized); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumLogChannels); if (RegCheckErr(RF, RoutineName)) return + if (allocated(OutData%LogChannels_OutParam)) deallocate(OutData%LogChannels_OutParam) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%LogChannels_OutParam(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LogChannels_OutParam.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackOutParmType(RF, OutData%LogChannels_OutParam(i1)) ! LogChannels_OutParam + end do + end if + call RegUnpackAlloc(RF, OutData%LogChannels); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ErrStat); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ErrMsg); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CurrentTime); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SimStatus); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ShaftBrakeStatusBinaryFlag); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HSSBrDeployed); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TimeHSSBrFullyDeployed); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TimeHSSBrDeployed); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OverrideYawRateWithTorque); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawTorqueDemand); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BlPitchInput); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawAngleFromNorth); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HorWindV); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HSS_Spd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawErr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RotSpeed); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawBrTAxp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawBrTAyp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LSSTipMys); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LSSTipMzs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LSSTipMya); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LSSTipMza); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LSSTipPxa); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Yaw); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawRate); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawBrMyn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawBrMzn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NcIMURAxs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NcIMURAys); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NcIMURAzs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RotPwr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LSSTipMxa); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RootMyc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RootMxc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LSShftFxa); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LSShftFys); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LSShftFzs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LidSpeed); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%MsrPositionsX); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%MsrPositionsY); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%MsrPositionsZ); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SensorType); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumBeam); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumPulseGate); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PulseSpacing); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%URefLid); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DLL_DT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DLL_InFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RootName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GenTrq_Dem); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GenSpd_Dem); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Ptch_Max); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Ptch_Min); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Ptch_SetPnt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PtchRate_Max); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PtchRate_Min); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GenPwr_Dem); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Gain_OM); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GenSpd_MaxOM); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GenSpd_MinOM); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Ptch_Cntrl); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DLL_NumTrq); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%GenSpd_TLU); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%GenTrq_TLU); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Yaw_Cntrl); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PrevCableDeltaL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PrevCableDeltaLdot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%CableDeltaL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%CableDeltaLdot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PrevStCCmdStiff); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PrevStCCmdDamp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PrevStCCmdBrake); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PrevStCCmdForce); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%StCCmdStiff); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%StCCmdDamp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%StCCmdBrake); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%StCCmdForce); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%StCMeasDisp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%StCMeasVel); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +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 + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(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 + LB(1:1) = lbound(SrcContStateData%BStC) + UB(1:1) = ubound(SrcContStateData%BStC) + if (.not. allocated(DstContStateData%BStC)) then + allocate(DstContStateData%BStC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%BStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call StC_CopyContState(SrcContStateData%BStC(i1), DstContStateData%BStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcContStateData%NStC)) then + LB(1:1) = lbound(SrcContStateData%NStC) + UB(1:1) = ubound(SrcContStateData%NStC) + if (.not. allocated(DstContStateData%NStC)) then + allocate(DstContStateData%NStC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%NStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call StC_CopyContState(SrcContStateData%NStC(i1), DstContStateData%NStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcContStateData%TStC)) then + LB(1:1) = lbound(SrcContStateData%TStC) + UB(1:1) = ubound(SrcContStateData%TStC) + if (.not. allocated(DstContStateData%TStC)) then + allocate(DstContStateData%TStC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%TStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call StC_CopyContState(SrcContStateData%TStC(i1), DstContStateData%TStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcContStateData%SStC)) then + LB(1:1) = lbound(SrcContStateData%SStC) + UB(1:1) = ubound(SrcContStateData%SStC) + if (.not. allocated(DstContStateData%SStC)) then + allocate(DstContStateData%SStC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%SStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call StC_CopyContState(SrcContStateData%SStC(i1), DstContStateData%SStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if +end subroutine + +subroutine SrvD_DestroyContState(ContStateData, ErrStat, ErrMsg) + type(SrvD_ContinuousStateType), intent(inout) :: ContStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SrvD_DestroyContState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ContStateData%BStC)) then + LB(1:1) = lbound(ContStateData%BStC) + UB(1:1) = ubound(ContStateData%BStC) + do i1 = LB(1), UB(1) + call StC_DestroyContState(ContStateData%BStC(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ContStateData%BStC) + end if + if (allocated(ContStateData%NStC)) then + LB(1:1) = lbound(ContStateData%NStC) + UB(1:1) = ubound(ContStateData%NStC) + do i1 = LB(1), UB(1) + call StC_DestroyContState(ContStateData%NStC(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ContStateData%NStC) + end if + if (allocated(ContStateData%TStC)) then + LB(1:1) = lbound(ContStateData%TStC) + UB(1:1) = ubound(ContStateData%TStC) + do i1 = LB(1), UB(1) + call StC_DestroyContState(ContStateData%TStC(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ContStateData%TStC) + end if + if (allocated(ContStateData%SStC)) then + LB(1:1) = lbound(ContStateData%SStC) + UB(1:1) = ubound(ContStateData%SStC) + do i1 = LB(1), UB(1) + call StC_DestroyContState(ContStateData%SStC(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ContStateData%SStC) + end if +end subroutine + +subroutine SrvD_PackContState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SrvD_ContinuousStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SrvD_PackContState' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyContState) + call RegPack(RF, allocated(InData%BStC)) + if (allocated(InData%BStC)) then + call RegPackBounds(RF, 1, lbound(InData%BStC), ubound(InData%BStC)) + LB(1:1) = lbound(InData%BStC) + UB(1:1) = ubound(InData%BStC) + do i1 = LB(1), UB(1) + call StC_PackContState(RF, InData%BStC(i1)) + end do + end if + call RegPack(RF, allocated(InData%NStC)) + if (allocated(InData%NStC)) then + call RegPackBounds(RF, 1, lbound(InData%NStC), ubound(InData%NStC)) + LB(1:1) = lbound(InData%NStC) + UB(1:1) = ubound(InData%NStC) + do i1 = LB(1), UB(1) + call StC_PackContState(RF, InData%NStC(i1)) + end do + end if + call RegPack(RF, allocated(InData%TStC)) + if (allocated(InData%TStC)) then + call RegPackBounds(RF, 1, lbound(InData%TStC), ubound(InData%TStC)) + LB(1:1) = lbound(InData%TStC) + UB(1:1) = ubound(InData%TStC) + do i1 = LB(1), UB(1) + call StC_PackContState(RF, InData%TStC(i1)) + end do + end if + call RegPack(RF, allocated(InData%SStC)) + if (allocated(InData%SStC)) then + call RegPackBounds(RF, 1, lbound(InData%SStC), ubound(InData%SStC)) + LB(1:1) = lbound(InData%SStC) + UB(1:1) = ubound(InData%SStC) + do i1 = LB(1), UB(1) + call StC_PackContState(RF, InData%SStC(i1)) + end do + end if + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SrvD_UnPackContState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SrvD_ContinuousStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SrvD_UnPackContState' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyContState); if (RegCheckErr(RF, RoutineName)) return + if (allocated(OutData%BStC)) deallocate(OutData%BStC) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%BStC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BStC.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call StC_UnpackContState(RF, OutData%BStC(i1)) ! BStC + end do + end if + if (allocated(OutData%NStC)) deallocate(OutData%NStC) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%NStC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NStC.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call StC_UnpackContState(RF, OutData%NStC(i1)) ! NStC + end do + end if + if (allocated(OutData%TStC)) deallocate(OutData%TStC) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%TStC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TStC.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call StC_UnpackContState(RF, OutData%TStC(i1)) ! TStC + end do + end if + if (allocated(OutData%SStC)) deallocate(OutData%SStC) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%SStC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SStC.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call StC_UnpackContState(RF, OutData%SStC(i1)) ! SStC + end do + end if +end subroutine + +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 + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(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 + LB(1:1) = lbound(SrcDiscStateData%BStC) + UB(1:1) = ubound(SrcDiscStateData%BStC) + if (.not. allocated(DstDiscStateData%BStC)) then + allocate(DstDiscStateData%BStC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%BStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call StC_CopyDiscState(SrcDiscStateData%BStC(i1), DstDiscStateData%BStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcDiscStateData%NStC)) then + LB(1:1) = lbound(SrcDiscStateData%NStC) + UB(1:1) = ubound(SrcDiscStateData%NStC) + if (.not. allocated(DstDiscStateData%NStC)) then + allocate(DstDiscStateData%NStC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%NStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call StC_CopyDiscState(SrcDiscStateData%NStC(i1), DstDiscStateData%NStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcDiscStateData%TStC)) then + LB(1:1) = lbound(SrcDiscStateData%TStC) + UB(1:1) = ubound(SrcDiscStateData%TStC) + if (.not. allocated(DstDiscStateData%TStC)) then + allocate(DstDiscStateData%TStC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%TStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call StC_CopyDiscState(SrcDiscStateData%TStC(i1), DstDiscStateData%TStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcDiscStateData%SStC)) then + LB(1:1) = lbound(SrcDiscStateData%SStC) + UB(1:1) = ubound(SrcDiscStateData%SStC) + if (.not. allocated(DstDiscStateData%SStC)) then + allocate(DstDiscStateData%SStC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%SStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call StC_CopyDiscState(SrcDiscStateData%SStC(i1), DstDiscStateData%SStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if +end subroutine + +subroutine SrvD_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) + type(SrvD_DiscreteStateType), intent(inout) :: DiscStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SrvD_DestroyDiscState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(DiscStateData%BStC)) then + LB(1:1) = lbound(DiscStateData%BStC) + UB(1:1) = ubound(DiscStateData%BStC) + do i1 = LB(1), UB(1) + call StC_DestroyDiscState(DiscStateData%BStC(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(DiscStateData%BStC) + end if + if (allocated(DiscStateData%NStC)) then + LB(1:1) = lbound(DiscStateData%NStC) + UB(1:1) = ubound(DiscStateData%NStC) + do i1 = LB(1), UB(1) + call StC_DestroyDiscState(DiscStateData%NStC(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(DiscStateData%NStC) + end if + if (allocated(DiscStateData%TStC)) then + LB(1:1) = lbound(DiscStateData%TStC) + UB(1:1) = ubound(DiscStateData%TStC) + do i1 = LB(1), UB(1) + call StC_DestroyDiscState(DiscStateData%TStC(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(DiscStateData%TStC) + end if + if (allocated(DiscStateData%SStC)) then + LB(1:1) = lbound(DiscStateData%SStC) + UB(1:1) = ubound(DiscStateData%SStC) + do i1 = LB(1), UB(1) + call StC_DestroyDiscState(DiscStateData%SStC(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(DiscStateData%SStC) + end if +end subroutine + +subroutine SrvD_PackDiscState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SrvD_DiscreteStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SrvD_PackDiscState' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%CtrlOffset) + call RegPack(RF, allocated(InData%BStC)) + if (allocated(InData%BStC)) then + call RegPackBounds(RF, 1, lbound(InData%BStC), ubound(InData%BStC)) + LB(1:1) = lbound(InData%BStC) + UB(1:1) = ubound(InData%BStC) + do i1 = LB(1), UB(1) + call StC_PackDiscState(RF, InData%BStC(i1)) + end do + end if + call RegPack(RF, allocated(InData%NStC)) + if (allocated(InData%NStC)) then + call RegPackBounds(RF, 1, lbound(InData%NStC), ubound(InData%NStC)) + LB(1:1) = lbound(InData%NStC) + UB(1:1) = ubound(InData%NStC) + do i1 = LB(1), UB(1) + call StC_PackDiscState(RF, InData%NStC(i1)) + end do + end if + call RegPack(RF, allocated(InData%TStC)) + if (allocated(InData%TStC)) then + call RegPackBounds(RF, 1, lbound(InData%TStC), ubound(InData%TStC)) + LB(1:1) = lbound(InData%TStC) + UB(1:1) = ubound(InData%TStC) + do i1 = LB(1), UB(1) + call StC_PackDiscState(RF, InData%TStC(i1)) + end do + end if + call RegPack(RF, allocated(InData%SStC)) + if (allocated(InData%SStC)) then + call RegPackBounds(RF, 1, lbound(InData%SStC), ubound(InData%SStC)) + LB(1:1) = lbound(InData%SStC) + UB(1:1) = ubound(InData%SStC) + do i1 = LB(1), UB(1) + call StC_PackDiscState(RF, InData%SStC(i1)) + end do + end if + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SrvD_UnPackDiscState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SrvD_DiscreteStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SrvD_UnPackDiscState' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%CtrlOffset); if (RegCheckErr(RF, RoutineName)) return + if (allocated(OutData%BStC)) deallocate(OutData%BStC) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%BStC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BStC.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call StC_UnpackDiscState(RF, OutData%BStC(i1)) ! BStC + end do + end if + if (allocated(OutData%NStC)) deallocate(OutData%NStC) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%NStC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NStC.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call StC_UnpackDiscState(RF, OutData%NStC(i1)) ! NStC + end do + end if + if (allocated(OutData%TStC)) deallocate(OutData%TStC) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%TStC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TStC.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call StC_UnpackDiscState(RF, OutData%TStC(i1)) ! TStC + end do + end if + if (allocated(OutData%SStC)) deallocate(OutData%SStC) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%SStC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SStC.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call StC_UnpackDiscState(RF, OutData%SStC(i1)) ! SStC + end do + end if +end subroutine + +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 + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(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 + LB(1:1) = lbound(SrcConstrStateData%BStC) + UB(1:1) = ubound(SrcConstrStateData%BStC) + if (.not. allocated(DstConstrStateData%BStC)) then + allocate(DstConstrStateData%BStC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstConstrStateData%BStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call StC_CopyConstrState(SrcConstrStateData%BStC(i1), DstConstrStateData%BStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcConstrStateData%NStC)) then + LB(1:1) = lbound(SrcConstrStateData%NStC) + UB(1:1) = ubound(SrcConstrStateData%NStC) + if (.not. allocated(DstConstrStateData%NStC)) then + allocate(DstConstrStateData%NStC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstConstrStateData%NStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call StC_CopyConstrState(SrcConstrStateData%NStC(i1), DstConstrStateData%NStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcConstrStateData%TStC)) then + LB(1:1) = lbound(SrcConstrStateData%TStC) + UB(1:1) = ubound(SrcConstrStateData%TStC) + if (.not. allocated(DstConstrStateData%TStC)) then + allocate(DstConstrStateData%TStC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstConstrStateData%TStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call StC_CopyConstrState(SrcConstrStateData%TStC(i1), DstConstrStateData%TStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcConstrStateData%SStC)) then + LB(1:1) = lbound(SrcConstrStateData%SStC) + UB(1:1) = ubound(SrcConstrStateData%SStC) + if (.not. allocated(DstConstrStateData%SStC)) then + allocate(DstConstrStateData%SStC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstConstrStateData%SStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call StC_CopyConstrState(SrcConstrStateData%SStC(i1), DstConstrStateData%SStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if +end subroutine + +subroutine SrvD_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) + type(SrvD_ConstraintStateType), intent(inout) :: ConstrStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SrvD_DestroyConstrState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ConstrStateData%BStC)) then + LB(1:1) = lbound(ConstrStateData%BStC) + UB(1:1) = ubound(ConstrStateData%BStC) + do i1 = LB(1), UB(1) + call StC_DestroyConstrState(ConstrStateData%BStC(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ConstrStateData%BStC) + end if + if (allocated(ConstrStateData%NStC)) then + LB(1:1) = lbound(ConstrStateData%NStC) + UB(1:1) = ubound(ConstrStateData%NStC) + do i1 = LB(1), UB(1) + call StC_DestroyConstrState(ConstrStateData%NStC(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ConstrStateData%NStC) + end if + if (allocated(ConstrStateData%TStC)) then + LB(1:1) = lbound(ConstrStateData%TStC) + UB(1:1) = ubound(ConstrStateData%TStC) + do i1 = LB(1), UB(1) + call StC_DestroyConstrState(ConstrStateData%TStC(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ConstrStateData%TStC) + end if + if (allocated(ConstrStateData%SStC)) then + LB(1:1) = lbound(ConstrStateData%SStC) + UB(1:1) = ubound(ConstrStateData%SStC) + do i1 = LB(1), UB(1) + call StC_DestroyConstrState(ConstrStateData%SStC(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ConstrStateData%SStC) + end if +end subroutine + +subroutine SrvD_PackConstrState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SrvD_ConstraintStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SrvD_PackConstrState' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyConstrState) + call RegPack(RF, allocated(InData%BStC)) + if (allocated(InData%BStC)) then + call RegPackBounds(RF, 1, lbound(InData%BStC), ubound(InData%BStC)) + LB(1:1) = lbound(InData%BStC) + UB(1:1) = ubound(InData%BStC) + do i1 = LB(1), UB(1) + call StC_PackConstrState(RF, InData%BStC(i1)) + end do + end if + call RegPack(RF, allocated(InData%NStC)) + if (allocated(InData%NStC)) then + call RegPackBounds(RF, 1, lbound(InData%NStC), ubound(InData%NStC)) + LB(1:1) = lbound(InData%NStC) + UB(1:1) = ubound(InData%NStC) + do i1 = LB(1), UB(1) + call StC_PackConstrState(RF, InData%NStC(i1)) + end do + end if + call RegPack(RF, allocated(InData%TStC)) + if (allocated(InData%TStC)) then + call RegPackBounds(RF, 1, lbound(InData%TStC), ubound(InData%TStC)) + LB(1:1) = lbound(InData%TStC) + UB(1:1) = ubound(InData%TStC) + do i1 = LB(1), UB(1) + call StC_PackConstrState(RF, InData%TStC(i1)) + end do + end if + call RegPack(RF, allocated(InData%SStC)) + if (allocated(InData%SStC)) then + call RegPackBounds(RF, 1, lbound(InData%SStC), ubound(InData%SStC)) + LB(1:1) = lbound(InData%SStC) + UB(1:1) = ubound(InData%SStC) + do i1 = LB(1), UB(1) + call StC_PackConstrState(RF, InData%SStC(i1)) + end do + end if + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SrvD_UnPackConstrState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SrvD_ConstraintStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SrvD_UnPackConstrState' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyConstrState); if (RegCheckErr(RF, RoutineName)) return + if (allocated(OutData%BStC)) deallocate(OutData%BStC) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%BStC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BStC.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call StC_UnpackConstrState(RF, OutData%BStC(i1)) ! BStC + end do + end if + if (allocated(OutData%NStC)) deallocate(OutData%NStC) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%NStC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NStC.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call StC_UnpackConstrState(RF, OutData%NStC(i1)) ! NStC + end do + end if + if (allocated(OutData%TStC)) deallocate(OutData%TStC) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%TStC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TStC.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call StC_UnpackConstrState(RF, OutData%TStC(i1)) ! TStC + end do + end if + if (allocated(OutData%SStC)) deallocate(OutData%SStC) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%SStC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SStC.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call StC_UnpackConstrState(RF, OutData%SStC(i1)) ! SStC + end do + end if +end subroutine + +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 + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SrvD_CopyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcOtherStateData%BegPitMan)) then + LB(1:1) = lbound(SrcOtherStateData%BegPitMan) + UB(1:1) = ubound(SrcOtherStateData%BegPitMan) + if (.not. allocated(DstOtherStateData%BegPitMan)) then + allocate(DstOtherStateData%BegPitMan(LB(1):UB(1)), 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 + end if + if (allocated(SrcOtherStateData%BlPitchI)) then + LB(1:1) = lbound(SrcOtherStateData%BlPitchI) + UB(1:1) = ubound(SrcOtherStateData%BlPitchI) + if (.not. allocated(DstOtherStateData%BlPitchI)) then + allocate(DstOtherStateData%BlPitchI(LB(1):UB(1)), 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 + end if + if (allocated(SrcOtherStateData%TPitManE)) then + LB(1:1) = lbound(SrcOtherStateData%TPitManE) + UB(1:1) = ubound(SrcOtherStateData%TPitManE) + if (.not. allocated(DstOtherStateData%TPitManE)) then + allocate(DstOtherStateData%TPitManE(LB(1):UB(1)), 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 + end if + DstOtherStateData%BegYawMan = SrcOtherStateData%BegYawMan + DstOtherStateData%NacYawI = SrcOtherStateData%NacYawI + DstOtherStateData%TYawManE = SrcOtherStateData%TYawManE + DstOtherStateData%YawPosComInt = SrcOtherStateData%YawPosComInt + if (allocated(SrcOtherStateData%BegTpBr)) then + LB(1:1) = lbound(SrcOtherStateData%BegTpBr) + UB(1:1) = ubound(SrcOtherStateData%BegTpBr) + if (.not. allocated(DstOtherStateData%BegTpBr)) then + allocate(DstOtherStateData%BegTpBr(LB(1):UB(1)), 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 + end if + if (allocated(SrcOtherStateData%TTpBrDp)) then + LB(1:1) = lbound(SrcOtherStateData%TTpBrDp) + UB(1:1) = ubound(SrcOtherStateData%TTpBrDp) + if (.not. allocated(DstOtherStateData%TTpBrDp)) then + allocate(DstOtherStateData%TTpBrDp(LB(1):UB(1)), 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 + end if + if (allocated(SrcOtherStateData%TTpBrFl)) then + LB(1:1) = lbound(SrcOtherStateData%TTpBrFl) + UB(1:1) = ubound(SrcOtherStateData%TTpBrFl) + if (.not. allocated(DstOtherStateData%TTpBrFl)) then + allocate(DstOtherStateData%TTpBrFl(LB(1):UB(1)), 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 + end if + DstOtherStateData%Off4Good = SrcOtherStateData%Off4Good + DstOtherStateData%GenOnLine = SrcOtherStateData%GenOnLine + if (allocated(SrcOtherStateData%BStC)) then + LB(1:1) = lbound(SrcOtherStateData%BStC) + UB(1:1) = ubound(SrcOtherStateData%BStC) + if (.not. allocated(DstOtherStateData%BStC)) then + allocate(DstOtherStateData%BStC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%BStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call StC_CopyOtherState(SrcOtherStateData%BStC(i1), DstOtherStateData%BStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcOtherStateData%NStC)) then + LB(1:1) = lbound(SrcOtherStateData%NStC) + UB(1:1) = ubound(SrcOtherStateData%NStC) + if (.not. allocated(DstOtherStateData%NStC)) then + allocate(DstOtherStateData%NStC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%NStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call StC_CopyOtherState(SrcOtherStateData%NStC(i1), DstOtherStateData%NStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcOtherStateData%TStC)) then + LB(1:1) = lbound(SrcOtherStateData%TStC) + UB(1:1) = ubound(SrcOtherStateData%TStC) + if (.not. allocated(DstOtherStateData%TStC)) then + allocate(DstOtherStateData%TStC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%TStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call StC_CopyOtherState(SrcOtherStateData%TStC(i1), DstOtherStateData%TStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcOtherStateData%SStC)) then + LB(1:1) = lbound(SrcOtherStateData%SStC) + UB(1:1) = ubound(SrcOtherStateData%SStC) + if (.not. allocated(DstOtherStateData%SStC)) then + allocate(DstOtherStateData%SStC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%SStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call StC_CopyOtherState(SrcOtherStateData%SStC(i1), DstOtherStateData%SStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if +end subroutine + +subroutine SrvD_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) + type(SrvD_OtherStateType), intent(inout) :: OtherStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SrvD_DestroyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OtherStateData%BegPitMan)) then + deallocate(OtherStateData%BegPitMan) + end if + if (allocated(OtherStateData%BlPitchI)) then + deallocate(OtherStateData%BlPitchI) + end if + if (allocated(OtherStateData%TPitManE)) then + deallocate(OtherStateData%TPitManE) + end if + if (allocated(OtherStateData%BegTpBr)) then + deallocate(OtherStateData%BegTpBr) + end if + if (allocated(OtherStateData%TTpBrDp)) then + deallocate(OtherStateData%TTpBrDp) + end if + if (allocated(OtherStateData%TTpBrFl)) then + deallocate(OtherStateData%TTpBrFl) + end if + if (allocated(OtherStateData%BStC)) then + LB(1:1) = lbound(OtherStateData%BStC) + UB(1:1) = ubound(OtherStateData%BStC) + do i1 = LB(1), UB(1) + call StC_DestroyOtherState(OtherStateData%BStC(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(OtherStateData%BStC) + end if + if (allocated(OtherStateData%NStC)) then + LB(1:1) = lbound(OtherStateData%NStC) + UB(1:1) = ubound(OtherStateData%NStC) + do i1 = LB(1), UB(1) + call StC_DestroyOtherState(OtherStateData%NStC(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(OtherStateData%NStC) + end if + if (allocated(OtherStateData%TStC)) then + LB(1:1) = lbound(OtherStateData%TStC) + UB(1:1) = ubound(OtherStateData%TStC) + do i1 = LB(1), UB(1) + call StC_DestroyOtherState(OtherStateData%TStC(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(OtherStateData%TStC) + end if + if (allocated(OtherStateData%SStC)) then + LB(1:1) = lbound(OtherStateData%SStC) + UB(1:1) = ubound(OtherStateData%SStC) + do i1 = LB(1), UB(1) + call StC_DestroyOtherState(OtherStateData%SStC(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(OtherStateData%SStC) + end if +end subroutine + +subroutine SrvD_PackOtherState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SrvD_OtherStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SrvD_PackOtherState' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%BegPitMan) + call RegPackAlloc(RF, InData%BlPitchI) + call RegPackAlloc(RF, InData%TPitManE) + call RegPack(RF, InData%BegYawMan) + call RegPack(RF, InData%NacYawI) + call RegPack(RF, InData%TYawManE) + call RegPack(RF, InData%YawPosComInt) + call RegPackAlloc(RF, InData%BegTpBr) + call RegPackAlloc(RF, InData%TTpBrDp) + call RegPackAlloc(RF, InData%TTpBrFl) + call RegPack(RF, InData%Off4Good) + call RegPack(RF, InData%GenOnLine) + call RegPack(RF, allocated(InData%BStC)) + if (allocated(InData%BStC)) then + call RegPackBounds(RF, 1, lbound(InData%BStC), ubound(InData%BStC)) + LB(1:1) = lbound(InData%BStC) + UB(1:1) = ubound(InData%BStC) + do i1 = LB(1), UB(1) + call StC_PackOtherState(RF, InData%BStC(i1)) + end do + end if + call RegPack(RF, allocated(InData%NStC)) + if (allocated(InData%NStC)) then + call RegPackBounds(RF, 1, lbound(InData%NStC), ubound(InData%NStC)) + LB(1:1) = lbound(InData%NStC) + UB(1:1) = ubound(InData%NStC) + do i1 = LB(1), UB(1) + call StC_PackOtherState(RF, InData%NStC(i1)) + end do + end if + call RegPack(RF, allocated(InData%TStC)) + if (allocated(InData%TStC)) then + call RegPackBounds(RF, 1, lbound(InData%TStC), ubound(InData%TStC)) + LB(1:1) = lbound(InData%TStC) + UB(1:1) = ubound(InData%TStC) + do i1 = LB(1), UB(1) + call StC_PackOtherState(RF, InData%TStC(i1)) + end do + end if + call RegPack(RF, allocated(InData%SStC)) + if (allocated(InData%SStC)) then + call RegPackBounds(RF, 1, lbound(InData%SStC), ubound(InData%SStC)) + LB(1:1) = lbound(InData%SStC) + UB(1:1) = ubound(InData%SStC) + do i1 = LB(1), UB(1) + call StC_PackOtherState(RF, InData%SStC(i1)) + end do + end if + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SrvD_UnPackOtherState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SrvD_OtherStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SrvD_UnPackOtherState' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%BegPitMan); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BlPitchI); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TPitManE); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BegYawMan); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NacYawI); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TYawManE); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawPosComInt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BegTpBr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TTpBrDp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TTpBrFl); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Off4Good); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GenOnLine); if (RegCheckErr(RF, RoutineName)) return + if (allocated(OutData%BStC)) deallocate(OutData%BStC) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%BStC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BStC.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call StC_UnpackOtherState(RF, OutData%BStC(i1)) ! BStC + end do + end if + if (allocated(OutData%NStC)) deallocate(OutData%NStC) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%NStC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NStC.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call StC_UnpackOtherState(RF, OutData%NStC(i1)) ! NStC + end do + end if + if (allocated(OutData%TStC)) deallocate(OutData%TStC) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%TStC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TStC.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call StC_UnpackOtherState(RF, OutData%TStC(i1)) ! TStC + end do + end if + if (allocated(OutData%SStC)) deallocate(OutData%SStC) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%SStC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SStC.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call StC_UnpackOtherState(RF, OutData%SStC(i1)) ! SStC + end do + end if +end subroutine + +subroutine SrvD_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, CtrlCode, ErrStat, ErrMsg) + type(SrvD_ModuleMapType), intent(inout) :: SrcModuleMapTypeData + type(SrvD_ModuleMapType), intent(inout) :: DstModuleMapTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SrvD_CopyModuleMapType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcModuleMapTypeData%u_BStC_Mot2_BStC)) then + LB(1:2) = lbound(SrcModuleMapTypeData%u_BStC_Mot2_BStC) + UB(1:2) = ubound(SrcModuleMapTypeData%u_BStC_Mot2_BStC) + if (.not. allocated(DstModuleMapTypeData%u_BStC_Mot2_BStC)) then + allocate(DstModuleMapTypeData%u_BStC_Mot2_BStC(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%u_BStC_Mot2_BStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%u_BStC_Mot2_BStC(i1,i2), DstModuleMapTypeData%u_BStC_Mot2_BStC(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do + end if + if (allocated(SrcModuleMapTypeData%u_NStC_Mot2_NStC)) then + LB(1:1) = lbound(SrcModuleMapTypeData%u_NStC_Mot2_NStC) + UB(1:1) = ubound(SrcModuleMapTypeData%u_NStC_Mot2_NStC) + if (.not. allocated(DstModuleMapTypeData%u_NStC_Mot2_NStC)) then + allocate(DstModuleMapTypeData%u_NStC_Mot2_NStC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%u_NStC_Mot2_NStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%u_NStC_Mot2_NStC(i1), DstModuleMapTypeData%u_NStC_Mot2_NStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcModuleMapTypeData%u_TStC_Mot2_TStC)) then + LB(1:1) = lbound(SrcModuleMapTypeData%u_TStC_Mot2_TStC) + UB(1:1) = ubound(SrcModuleMapTypeData%u_TStC_Mot2_TStC) + if (.not. allocated(DstModuleMapTypeData%u_TStC_Mot2_TStC)) then + allocate(DstModuleMapTypeData%u_TStC_Mot2_TStC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%u_TStC_Mot2_TStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%u_TStC_Mot2_TStC(i1), DstModuleMapTypeData%u_TStC_Mot2_TStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcModuleMapTypeData%u_SStC_Mot2_SStC)) then + LB(1:1) = lbound(SrcModuleMapTypeData%u_SStC_Mot2_SStC) + UB(1:1) = ubound(SrcModuleMapTypeData%u_SStC_Mot2_SStC) + if (.not. allocated(DstModuleMapTypeData%u_SStC_Mot2_SStC)) then + allocate(DstModuleMapTypeData%u_SStC_Mot2_SStC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%u_SStC_Mot2_SStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%u_SStC_Mot2_SStC(i1), DstModuleMapTypeData%u_SStC_Mot2_SStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcModuleMapTypeData%BStC_Frc2_y_BStC)) then + LB(1:2) = lbound(SrcModuleMapTypeData%BStC_Frc2_y_BStC) + UB(1:2) = ubound(SrcModuleMapTypeData%BStC_Frc2_y_BStC) + if (.not. allocated(DstModuleMapTypeData%BStC_Frc2_y_BStC)) then + allocate(DstModuleMapTypeData%BStC_Frc2_y_BStC(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%BStC_Frc2_y_BStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%BStC_Frc2_y_BStC(i1,i2), DstModuleMapTypeData%BStC_Frc2_y_BStC(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do + end if + if (allocated(SrcModuleMapTypeData%NStC_Frc2_y_NStC)) then + LB(1:1) = lbound(SrcModuleMapTypeData%NStC_Frc2_y_NStC) + UB(1:1) = ubound(SrcModuleMapTypeData%NStC_Frc2_y_NStC) + if (.not. allocated(DstModuleMapTypeData%NStC_Frc2_y_NStC)) then + allocate(DstModuleMapTypeData%NStC_Frc2_y_NStC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%NStC_Frc2_y_NStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%NStC_Frc2_y_NStC(i1), DstModuleMapTypeData%NStC_Frc2_y_NStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcModuleMapTypeData%TStC_Frc2_y_TStC)) then + LB(1:1) = lbound(SrcModuleMapTypeData%TStC_Frc2_y_TStC) + UB(1:1) = ubound(SrcModuleMapTypeData%TStC_Frc2_y_TStC) + if (.not. allocated(DstModuleMapTypeData%TStC_Frc2_y_TStC)) then + allocate(DstModuleMapTypeData%TStC_Frc2_y_TStC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%TStC_Frc2_y_TStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%TStC_Frc2_y_TStC(i1), DstModuleMapTypeData%TStC_Frc2_y_TStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcModuleMapTypeData%SStC_Frc2_y_SStC)) then + LB(1:1) = lbound(SrcModuleMapTypeData%SStC_Frc2_y_SStC) + UB(1:1) = ubound(SrcModuleMapTypeData%SStC_Frc2_y_SStC) + if (.not. allocated(DstModuleMapTypeData%SStC_Frc2_y_SStC)) then + allocate(DstModuleMapTypeData%SStC_Frc2_y_SStC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%SStC_Frc2_y_SStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%SStC_Frc2_y_SStC(i1), DstModuleMapTypeData%SStC_Frc2_y_SStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if +end subroutine + +subroutine SrvD_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) + type(SrvD_ModuleMapType), intent(inout) :: ModuleMapTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SrvD_DestroyModuleMapType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ModuleMapTypeData%u_BStC_Mot2_BStC)) then + LB(1:2) = lbound(ModuleMapTypeData%u_BStC_Mot2_BStC) + UB(1:2) = ubound(ModuleMapTypeData%u_BStC_Mot2_BStC) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%u_BStC_Mot2_BStC(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + deallocate(ModuleMapTypeData%u_BStC_Mot2_BStC) + end if + if (allocated(ModuleMapTypeData%u_NStC_Mot2_NStC)) then + LB(1:1) = lbound(ModuleMapTypeData%u_NStC_Mot2_NStC) + UB(1:1) = ubound(ModuleMapTypeData%u_NStC_Mot2_NStC) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%u_NStC_Mot2_NStC(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ModuleMapTypeData%u_NStC_Mot2_NStC) + end if + if (allocated(ModuleMapTypeData%u_TStC_Mot2_TStC)) then + LB(1:1) = lbound(ModuleMapTypeData%u_TStC_Mot2_TStC) + UB(1:1) = ubound(ModuleMapTypeData%u_TStC_Mot2_TStC) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%u_TStC_Mot2_TStC(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ModuleMapTypeData%u_TStC_Mot2_TStC) + end if + if (allocated(ModuleMapTypeData%u_SStC_Mot2_SStC)) then + LB(1:1) = lbound(ModuleMapTypeData%u_SStC_Mot2_SStC) + UB(1:1) = ubound(ModuleMapTypeData%u_SStC_Mot2_SStC) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%u_SStC_Mot2_SStC(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ModuleMapTypeData%u_SStC_Mot2_SStC) + end if + if (allocated(ModuleMapTypeData%BStC_Frc2_y_BStC)) then + LB(1:2) = lbound(ModuleMapTypeData%BStC_Frc2_y_BStC) + UB(1:2) = ubound(ModuleMapTypeData%BStC_Frc2_y_BStC) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%BStC_Frc2_y_BStC(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + deallocate(ModuleMapTypeData%BStC_Frc2_y_BStC) + end if + if (allocated(ModuleMapTypeData%NStC_Frc2_y_NStC)) then + LB(1:1) = lbound(ModuleMapTypeData%NStC_Frc2_y_NStC) + UB(1:1) = ubound(ModuleMapTypeData%NStC_Frc2_y_NStC) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%NStC_Frc2_y_NStC(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ModuleMapTypeData%NStC_Frc2_y_NStC) + end if + if (allocated(ModuleMapTypeData%TStC_Frc2_y_TStC)) then + LB(1:1) = lbound(ModuleMapTypeData%TStC_Frc2_y_TStC) + UB(1:1) = ubound(ModuleMapTypeData%TStC_Frc2_y_TStC) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%TStC_Frc2_y_TStC(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ModuleMapTypeData%TStC_Frc2_y_TStC) + end if + if (allocated(ModuleMapTypeData%SStC_Frc2_y_SStC)) then + LB(1:1) = lbound(ModuleMapTypeData%SStC_Frc2_y_SStC) + UB(1:1) = ubound(ModuleMapTypeData%SStC_Frc2_y_SStC) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%SStC_Frc2_y_SStC(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ModuleMapTypeData%SStC_Frc2_y_SStC) + end if +end subroutine + +subroutine SrvD_PackModuleMapType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SrvD_ModuleMapType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SrvD_PackModuleMapType' + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%u_BStC_Mot2_BStC)) + if (allocated(InData%u_BStC_Mot2_BStC)) then + call RegPackBounds(RF, 2, lbound(InData%u_BStC_Mot2_BStC), ubound(InData%u_BStC_Mot2_BStC)) + LB(1:2) = lbound(InData%u_BStC_Mot2_BStC) + UB(1:2) = ubound(InData%u_BStC_Mot2_BStC) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(RF, InData%u_BStC_Mot2_BStC(i1,i2)) + end do + end do + end if + call RegPack(RF, allocated(InData%u_NStC_Mot2_NStC)) + if (allocated(InData%u_NStC_Mot2_NStC)) then + call RegPackBounds(RF, 1, lbound(InData%u_NStC_Mot2_NStC), ubound(InData%u_NStC_Mot2_NStC)) + LB(1:1) = lbound(InData%u_NStC_Mot2_NStC) + UB(1:1) = ubound(InData%u_NStC_Mot2_NStC) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(RF, InData%u_NStC_Mot2_NStC(i1)) + end do + end if + call RegPack(RF, allocated(InData%u_TStC_Mot2_TStC)) + if (allocated(InData%u_TStC_Mot2_TStC)) then + call RegPackBounds(RF, 1, lbound(InData%u_TStC_Mot2_TStC), ubound(InData%u_TStC_Mot2_TStC)) + LB(1:1) = lbound(InData%u_TStC_Mot2_TStC) + UB(1:1) = ubound(InData%u_TStC_Mot2_TStC) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(RF, InData%u_TStC_Mot2_TStC(i1)) + end do + end if + call RegPack(RF, allocated(InData%u_SStC_Mot2_SStC)) + if (allocated(InData%u_SStC_Mot2_SStC)) then + call RegPackBounds(RF, 1, lbound(InData%u_SStC_Mot2_SStC), ubound(InData%u_SStC_Mot2_SStC)) + LB(1:1) = lbound(InData%u_SStC_Mot2_SStC) + UB(1:1) = ubound(InData%u_SStC_Mot2_SStC) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(RF, InData%u_SStC_Mot2_SStC(i1)) + end do + end if + call RegPack(RF, allocated(InData%BStC_Frc2_y_BStC)) + if (allocated(InData%BStC_Frc2_y_BStC)) then + call RegPackBounds(RF, 2, lbound(InData%BStC_Frc2_y_BStC), ubound(InData%BStC_Frc2_y_BStC)) + LB(1:2) = lbound(InData%BStC_Frc2_y_BStC) + UB(1:2) = ubound(InData%BStC_Frc2_y_BStC) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(RF, InData%BStC_Frc2_y_BStC(i1,i2)) + end do + end do + end if + call RegPack(RF, allocated(InData%NStC_Frc2_y_NStC)) + if (allocated(InData%NStC_Frc2_y_NStC)) then + call RegPackBounds(RF, 1, lbound(InData%NStC_Frc2_y_NStC), ubound(InData%NStC_Frc2_y_NStC)) + LB(1:1) = lbound(InData%NStC_Frc2_y_NStC) + UB(1:1) = ubound(InData%NStC_Frc2_y_NStC) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(RF, InData%NStC_Frc2_y_NStC(i1)) + end do + end if + call RegPack(RF, allocated(InData%TStC_Frc2_y_TStC)) + if (allocated(InData%TStC_Frc2_y_TStC)) then + call RegPackBounds(RF, 1, lbound(InData%TStC_Frc2_y_TStC), ubound(InData%TStC_Frc2_y_TStC)) + LB(1:1) = lbound(InData%TStC_Frc2_y_TStC) + UB(1:1) = ubound(InData%TStC_Frc2_y_TStC) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(RF, InData%TStC_Frc2_y_TStC(i1)) + end do + end if + call RegPack(RF, allocated(InData%SStC_Frc2_y_SStC)) + if (allocated(InData%SStC_Frc2_y_SStC)) then + call RegPackBounds(RF, 1, lbound(InData%SStC_Frc2_y_SStC), ubound(InData%SStC_Frc2_y_SStC)) + LB(1:1) = lbound(InData%SStC_Frc2_y_SStC) + UB(1:1) = ubound(InData%SStC_Frc2_y_SStC) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(RF, InData%SStC_Frc2_y_SStC(i1)) + end do + end if + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SrvD_UnPackModuleMapType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SrvD_ModuleMapType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SrvD_UnPackModuleMapType' + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + if (allocated(OutData%u_BStC_Mot2_BStC)) deallocate(OutData%u_BStC_Mot2_BStC) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%u_BStC_Mot2_BStC(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_BStC_Mot2_BStC.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(RF, OutData%u_BStC_Mot2_BStC(i1,i2)) ! u_BStC_Mot2_BStC + end do + end do + end if + if (allocated(OutData%u_NStC_Mot2_NStC)) deallocate(OutData%u_NStC_Mot2_NStC) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%u_NStC_Mot2_NStC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_NStC_Mot2_NStC.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(RF, OutData%u_NStC_Mot2_NStC(i1)) ! u_NStC_Mot2_NStC + end do + end if + if (allocated(OutData%u_TStC_Mot2_TStC)) deallocate(OutData%u_TStC_Mot2_TStC) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%u_TStC_Mot2_TStC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_TStC_Mot2_TStC.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(RF, OutData%u_TStC_Mot2_TStC(i1)) ! u_TStC_Mot2_TStC + end do + end if + if (allocated(OutData%u_SStC_Mot2_SStC)) deallocate(OutData%u_SStC_Mot2_SStC) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%u_SStC_Mot2_SStC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_SStC_Mot2_SStC.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(RF, OutData%u_SStC_Mot2_SStC(i1)) ! u_SStC_Mot2_SStC + end do + end if + if (allocated(OutData%BStC_Frc2_y_BStC)) deallocate(OutData%BStC_Frc2_y_BStC) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%BStC_Frc2_y_BStC(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BStC_Frc2_y_BStC.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(RF, OutData%BStC_Frc2_y_BStC(i1,i2)) ! BStC_Frc2_y_BStC + end do + end do + end if + if (allocated(OutData%NStC_Frc2_y_NStC)) deallocate(OutData%NStC_Frc2_y_NStC) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%NStC_Frc2_y_NStC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NStC_Frc2_y_NStC.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(RF, OutData%NStC_Frc2_y_NStC(i1)) ! NStC_Frc2_y_NStC + end do + end if + if (allocated(OutData%TStC_Frc2_y_TStC)) deallocate(OutData%TStC_Frc2_y_TStC) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%TStC_Frc2_y_TStC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TStC_Frc2_y_TStC.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(RF, OutData%TStC_Frc2_y_TStC(i1)) ! TStC_Frc2_y_TStC + end do + end if + if (allocated(OutData%SStC_Frc2_y_SStC)) deallocate(OutData%SStC_Frc2_y_SStC) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%SStC_Frc2_y_SStC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SStC_Frc2_y_SStC.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(RF, OutData%SStC_Frc2_y_SStC(i1)) ! SStC_Frc2_y_SStC + end do + end if +end subroutine + +subroutine SrvD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(SrvD_MiscVarType), intent(inout) :: SrcMiscData + type(SrvD_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = '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 + LB(1:1) = lbound(SrcMiscData%xd_BlPitchFilter) + UB(1:1) = ubound(SrcMiscData%xd_BlPitchFilter) + if (.not. allocated(DstMiscData%xd_BlPitchFilter)) then + allocate(DstMiscData%xd_BlPitchFilter(LB(1):UB(1)), 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 + end if + if (allocated(SrcMiscData%BStC)) then + LB(1:1) = lbound(SrcMiscData%BStC) + UB(1:1) = ubound(SrcMiscData%BStC) + if (.not. allocated(DstMiscData%BStC)) then + allocate(DstMiscData%BStC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call StC_CopyMisc(SrcMiscData%BStC(i1), DstMiscData%BStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcMiscData%NStC)) then + LB(1:1) = lbound(SrcMiscData%NStC) + UB(1:1) = ubound(SrcMiscData%NStC) + if (.not. allocated(DstMiscData%NStC)) then + allocate(DstMiscData%NStC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%NStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call StC_CopyMisc(SrcMiscData%NStC(i1), DstMiscData%NStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcMiscData%TStC)) then + LB(1:1) = lbound(SrcMiscData%TStC) + UB(1:1) = ubound(SrcMiscData%TStC) + if (.not. allocated(DstMiscData%TStC)) then + allocate(DstMiscData%TStC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%TStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call StC_CopyMisc(SrcMiscData%TStC(i1), DstMiscData%TStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcMiscData%SStC)) then + LB(1:1) = lbound(SrcMiscData%SStC) + UB(1:1) = ubound(SrcMiscData%SStC) + if (.not. allocated(DstMiscData%SStC)) then + allocate(DstMiscData%SStC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call StC_CopyMisc(SrcMiscData%SStC(i1), DstMiscData%SStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcMiscData%u_BStC)) then + LB(1:2) = lbound(SrcMiscData%u_BStC) + UB(1:2) = ubound(SrcMiscData%u_BStC) + if (.not. allocated(DstMiscData%u_BStC)) then + allocate(DstMiscData%u_BStC(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%u_BStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call StC_CopyInput(SrcMiscData%u_BStC(i1,i2), DstMiscData%u_BStC(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do + end if + if (allocated(SrcMiscData%u_NStC)) then + LB(1:2) = lbound(SrcMiscData%u_NStC) + UB(1:2) = ubound(SrcMiscData%u_NStC) + if (.not. allocated(DstMiscData%u_NStC)) then + allocate(DstMiscData%u_NStC(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%u_NStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call StC_CopyInput(SrcMiscData%u_NStC(i1,i2), DstMiscData%u_NStC(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do + end if + if (allocated(SrcMiscData%u_TStC)) then + LB(1:2) = lbound(SrcMiscData%u_TStC) + UB(1:2) = ubound(SrcMiscData%u_TStC) + if (.not. allocated(DstMiscData%u_TStC)) then + allocate(DstMiscData%u_TStC(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%u_TStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call StC_CopyInput(SrcMiscData%u_TStC(i1,i2), DstMiscData%u_TStC(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do + end if + if (allocated(SrcMiscData%u_SStC)) then + LB(1:2) = lbound(SrcMiscData%u_SStC) + UB(1:2) = ubound(SrcMiscData%u_SStC) + if (.not. allocated(DstMiscData%u_SStC)) then + allocate(DstMiscData%u_SStC(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%u_SStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call StC_CopyInput(SrcMiscData%u_SStC(i1,i2), DstMiscData%u_SStC(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do + end if + if (allocated(SrcMiscData%y_BStC)) then + LB(1:1) = lbound(SrcMiscData%y_BStC) + UB(1:1) = ubound(SrcMiscData%y_BStC) + if (.not. allocated(DstMiscData%y_BStC)) then + allocate(DstMiscData%y_BStC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%y_BStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call StC_CopyOutput(SrcMiscData%y_BStC(i1), DstMiscData%y_BStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcMiscData%y_NStC)) then + LB(1:1) = lbound(SrcMiscData%y_NStC) + UB(1:1) = ubound(SrcMiscData%y_NStC) + if (.not. allocated(DstMiscData%y_NStC)) then + allocate(DstMiscData%y_NStC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%y_NStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call StC_CopyOutput(SrcMiscData%y_NStC(i1), DstMiscData%y_NStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcMiscData%y_TStC)) then + LB(1:1) = lbound(SrcMiscData%y_TStC) + UB(1:1) = ubound(SrcMiscData%y_TStC) + if (.not. allocated(DstMiscData%y_TStC)) then + allocate(DstMiscData%y_TStC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%y_TStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call StC_CopyOutput(SrcMiscData%y_TStC(i1), DstMiscData%y_TStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcMiscData%y_SStC)) then + LB(1:1) = lbound(SrcMiscData%y_SStC) + UB(1:1) = ubound(SrcMiscData%y_SStC) + if (.not. allocated(DstMiscData%y_SStC)) then + allocate(DstMiscData%y_SStC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%y_SStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call StC_CopyOutput(SrcMiscData%y_SStC(i1), DstMiscData%y_SStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call SrvD_CopyModuleMapType(SrcMiscData%SrvD_MeshMap, DstMiscData%SrvD_MeshMap, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstMiscData%PrevTstepNcall = SrcMiscData%PrevTstepNcall +end subroutine + +subroutine SrvD_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(SrvD_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SrvD_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' + call SrvD_DestroyBladedDLLType(MiscData%dll_data, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(MiscData%xd_BlPitchFilter)) then + deallocate(MiscData%xd_BlPitchFilter) + end if + if (allocated(MiscData%BStC)) then + LB(1:1) = lbound(MiscData%BStC) + UB(1:1) = ubound(MiscData%BStC) + do i1 = LB(1), UB(1) + call StC_DestroyMisc(MiscData%BStC(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%BStC) + end if + if (allocated(MiscData%NStC)) then + LB(1:1) = lbound(MiscData%NStC) + UB(1:1) = ubound(MiscData%NStC) + do i1 = LB(1), UB(1) + call StC_DestroyMisc(MiscData%NStC(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%NStC) + end if + if (allocated(MiscData%TStC)) then + LB(1:1) = lbound(MiscData%TStC) + UB(1:1) = ubound(MiscData%TStC) + do i1 = LB(1), UB(1) + call StC_DestroyMisc(MiscData%TStC(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%TStC) + end if + if (allocated(MiscData%SStC)) then + LB(1:1) = lbound(MiscData%SStC) + UB(1:1) = ubound(MiscData%SStC) + do i1 = LB(1), UB(1) + call StC_DestroyMisc(MiscData%SStC(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%SStC) + end if + if (allocated(MiscData%u_BStC)) then + LB(1:2) = lbound(MiscData%u_BStC) + UB(1:2) = ubound(MiscData%u_BStC) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call StC_DestroyInput(MiscData%u_BStC(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + deallocate(MiscData%u_BStC) + end if + if (allocated(MiscData%u_NStC)) then + LB(1:2) = lbound(MiscData%u_NStC) + UB(1:2) = ubound(MiscData%u_NStC) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call StC_DestroyInput(MiscData%u_NStC(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + deallocate(MiscData%u_NStC) + end if + if (allocated(MiscData%u_TStC)) then + LB(1:2) = lbound(MiscData%u_TStC) + UB(1:2) = ubound(MiscData%u_TStC) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call StC_DestroyInput(MiscData%u_TStC(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + deallocate(MiscData%u_TStC) + end if + if (allocated(MiscData%u_SStC)) then + LB(1:2) = lbound(MiscData%u_SStC) + UB(1:2) = ubound(MiscData%u_SStC) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call StC_DestroyInput(MiscData%u_SStC(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + deallocate(MiscData%u_SStC) + end if + if (allocated(MiscData%y_BStC)) then + LB(1:1) = lbound(MiscData%y_BStC) + UB(1:1) = ubound(MiscData%y_BStC) + do i1 = LB(1), UB(1) + call StC_DestroyOutput(MiscData%y_BStC(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%y_BStC) + end if + if (allocated(MiscData%y_NStC)) then + LB(1:1) = lbound(MiscData%y_NStC) + UB(1:1) = ubound(MiscData%y_NStC) + do i1 = LB(1), UB(1) + call StC_DestroyOutput(MiscData%y_NStC(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%y_NStC) + end if + if (allocated(MiscData%y_TStC)) then + LB(1:1) = lbound(MiscData%y_TStC) + UB(1:1) = ubound(MiscData%y_TStC) + do i1 = LB(1), UB(1) + call StC_DestroyOutput(MiscData%y_TStC(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%y_TStC) + end if + if (allocated(MiscData%y_SStC)) then + LB(1:1) = lbound(MiscData%y_SStC) + UB(1:1) = ubound(MiscData%y_SStC) + do i1 = LB(1), UB(1) + call StC_DestroyOutput(MiscData%y_SStC(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%y_SStC) + end if + call SrvD_DestroyModuleMapType(MiscData%SrvD_MeshMap, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine SrvD_PackMisc(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SrvD_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SrvD_PackMisc' + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%LastTimeCalled) + call SrvD_PackBladedDLLType(RF, InData%dll_data) + call RegPack(RF, InData%FirstWarn) + call RegPack(RF, InData%LastTimeFiltered) + call RegPackAlloc(RF, InData%xd_BlPitchFilter) + call RegPack(RF, allocated(InData%BStC)) + if (allocated(InData%BStC)) then + call RegPackBounds(RF, 1, lbound(InData%BStC), ubound(InData%BStC)) + LB(1:1) = lbound(InData%BStC) + UB(1:1) = ubound(InData%BStC) + do i1 = LB(1), UB(1) + call StC_PackMisc(RF, InData%BStC(i1)) + end do + end if + call RegPack(RF, allocated(InData%NStC)) + if (allocated(InData%NStC)) then + call RegPackBounds(RF, 1, lbound(InData%NStC), ubound(InData%NStC)) + LB(1:1) = lbound(InData%NStC) + UB(1:1) = ubound(InData%NStC) + do i1 = LB(1), UB(1) + call StC_PackMisc(RF, InData%NStC(i1)) + end do + end if + call RegPack(RF, allocated(InData%TStC)) + if (allocated(InData%TStC)) then + call RegPackBounds(RF, 1, lbound(InData%TStC), ubound(InData%TStC)) + LB(1:1) = lbound(InData%TStC) + UB(1:1) = ubound(InData%TStC) + do i1 = LB(1), UB(1) + call StC_PackMisc(RF, InData%TStC(i1)) + end do + end if + call RegPack(RF, allocated(InData%SStC)) + if (allocated(InData%SStC)) then + call RegPackBounds(RF, 1, lbound(InData%SStC), ubound(InData%SStC)) + LB(1:1) = lbound(InData%SStC) + UB(1:1) = ubound(InData%SStC) + do i1 = LB(1), UB(1) + call StC_PackMisc(RF, InData%SStC(i1)) + end do + end if + call RegPack(RF, allocated(InData%u_BStC)) + if (allocated(InData%u_BStC)) then + call RegPackBounds(RF, 2, lbound(InData%u_BStC), ubound(InData%u_BStC)) + LB(1:2) = lbound(InData%u_BStC) + UB(1:2) = ubound(InData%u_BStC) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call StC_PackInput(RF, InData%u_BStC(i1,i2)) + end do + end do + end if + call RegPack(RF, allocated(InData%u_NStC)) + if (allocated(InData%u_NStC)) then + call RegPackBounds(RF, 2, lbound(InData%u_NStC), ubound(InData%u_NStC)) + LB(1:2) = lbound(InData%u_NStC) + UB(1:2) = ubound(InData%u_NStC) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call StC_PackInput(RF, InData%u_NStC(i1,i2)) + end do + end do + end if + call RegPack(RF, allocated(InData%u_TStC)) + if (allocated(InData%u_TStC)) then + call RegPackBounds(RF, 2, lbound(InData%u_TStC), ubound(InData%u_TStC)) + LB(1:2) = lbound(InData%u_TStC) + UB(1:2) = ubound(InData%u_TStC) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call StC_PackInput(RF, InData%u_TStC(i1,i2)) + end do + end do + end if + call RegPack(RF, allocated(InData%u_SStC)) + if (allocated(InData%u_SStC)) then + call RegPackBounds(RF, 2, lbound(InData%u_SStC), ubound(InData%u_SStC)) + LB(1:2) = lbound(InData%u_SStC) + UB(1:2) = ubound(InData%u_SStC) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call StC_PackInput(RF, InData%u_SStC(i1,i2)) + end do + end do + end if + call RegPack(RF, allocated(InData%y_BStC)) + if (allocated(InData%y_BStC)) then + call RegPackBounds(RF, 1, lbound(InData%y_BStC), ubound(InData%y_BStC)) + LB(1:1) = lbound(InData%y_BStC) + UB(1:1) = ubound(InData%y_BStC) + do i1 = LB(1), UB(1) + call StC_PackOutput(RF, InData%y_BStC(i1)) + end do + end if + call RegPack(RF, allocated(InData%y_NStC)) + if (allocated(InData%y_NStC)) then + call RegPackBounds(RF, 1, lbound(InData%y_NStC), ubound(InData%y_NStC)) + LB(1:1) = lbound(InData%y_NStC) + UB(1:1) = ubound(InData%y_NStC) + do i1 = LB(1), UB(1) + call StC_PackOutput(RF, InData%y_NStC(i1)) + end do + end if + call RegPack(RF, allocated(InData%y_TStC)) + if (allocated(InData%y_TStC)) then + call RegPackBounds(RF, 1, lbound(InData%y_TStC), ubound(InData%y_TStC)) + LB(1:1) = lbound(InData%y_TStC) + UB(1:1) = ubound(InData%y_TStC) + do i1 = LB(1), UB(1) + call StC_PackOutput(RF, InData%y_TStC(i1)) + end do + end if + call RegPack(RF, allocated(InData%y_SStC)) + if (allocated(InData%y_SStC)) then + call RegPackBounds(RF, 1, lbound(InData%y_SStC), ubound(InData%y_SStC)) + LB(1:1) = lbound(InData%y_SStC) + UB(1:1) = ubound(InData%y_SStC) + do i1 = LB(1), UB(1) + call StC_PackOutput(RF, InData%y_SStC(i1)) + end do + end if + call SrvD_PackModuleMapType(RF, InData%SrvD_MeshMap) + call RegPack(RF, InData%PrevTstepNcall) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SrvD_UnPackMisc(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SrvD_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SrvD_UnPackMisc' + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%LastTimeCalled); if (RegCheckErr(RF, RoutineName)) return + call SrvD_UnpackBladedDLLType(RF, OutData%dll_data) ! dll_data + call RegUnpack(RF, OutData%FirstWarn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LastTimeFiltered); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%xd_BlPitchFilter); if (RegCheckErr(RF, RoutineName)) return + if (allocated(OutData%BStC)) deallocate(OutData%BStC) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%BStC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BStC.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call StC_UnpackMisc(RF, OutData%BStC(i1)) ! BStC + end do + end if + if (allocated(OutData%NStC)) deallocate(OutData%NStC) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%NStC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NStC.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call StC_UnpackMisc(RF, OutData%NStC(i1)) ! NStC + end do + end if + if (allocated(OutData%TStC)) deallocate(OutData%TStC) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%TStC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TStC.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call StC_UnpackMisc(RF, OutData%TStC(i1)) ! TStC + end do + end if + if (allocated(OutData%SStC)) deallocate(OutData%SStC) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%SStC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SStC.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call StC_UnpackMisc(RF, OutData%SStC(i1)) ! SStC + end do + end if + if (allocated(OutData%u_BStC)) deallocate(OutData%u_BStC) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%u_BStC(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_BStC.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call StC_UnpackInput(RF, OutData%u_BStC(i1,i2)) ! u_BStC + end do + end do + end if + if (allocated(OutData%u_NStC)) deallocate(OutData%u_NStC) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%u_NStC(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_NStC.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call StC_UnpackInput(RF, OutData%u_NStC(i1,i2)) ! u_NStC + end do + end do + end if + if (allocated(OutData%u_TStC)) deallocate(OutData%u_TStC) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%u_TStC(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_TStC.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call StC_UnpackInput(RF, OutData%u_TStC(i1,i2)) ! u_TStC + end do + end do + end if + if (allocated(OutData%u_SStC)) deallocate(OutData%u_SStC) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%u_SStC(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_SStC.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call StC_UnpackInput(RF, OutData%u_SStC(i1,i2)) ! u_SStC + end do + end do + end if + if (allocated(OutData%y_BStC)) deallocate(OutData%y_BStC) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%y_BStC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%y_BStC.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call StC_UnpackOutput(RF, OutData%y_BStC(i1)) ! y_BStC + end do + end if + if (allocated(OutData%y_NStC)) deallocate(OutData%y_NStC) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%y_NStC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%y_NStC.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call StC_UnpackOutput(RF, OutData%y_NStC(i1)) ! y_NStC + end do + end if + if (allocated(OutData%y_TStC)) deallocate(OutData%y_TStC) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%y_TStC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%y_TStC.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call StC_UnpackOutput(RF, OutData%y_TStC(i1)) ! y_TStC + end do + end if + if (allocated(OutData%y_SStC)) deallocate(OutData%y_SStC) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%y_SStC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%y_SStC.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call StC_UnpackOutput(RF, OutData%y_SStC(i1)) ! y_SStC + end do + end if + call SrvD_UnpackModuleMapType(RF, OutData%SrvD_MeshMap) ! SrvD_MeshMap + call RegUnpack(RF, OutData%PrevTstepNcall); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +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 + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) + 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 + LB(1:1) = lbound(SrcParamData%BlPitchInit) + UB(1:1) = ubound(SrcParamData%BlPitchInit) + if (.not. allocated(DstParamData%BlPitchInit)) then + allocate(DstParamData%BlPitchInit(LB(1):UB(1)), 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 + end if + if (allocated(SrcParamData%BlPitchF)) then + LB(1:1) = lbound(SrcParamData%BlPitchF) + UB(1:1) = ubound(SrcParamData%BlPitchF) + if (.not. allocated(DstParamData%BlPitchF)) then + allocate(DstParamData%BlPitchF(LB(1):UB(1)), 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 + end if + if (allocated(SrcParamData%PitManRat)) then + LB(1:1) = lbound(SrcParamData%PitManRat) + UB(1:1) = ubound(SrcParamData%PitManRat) + if (.not. allocated(DstParamData%PitManRat)) then + allocate(DstParamData%PitManRat(LB(1):UB(1)), 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 + end if + 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 + LB(1:1) = lbound(SrcParamData%TPitManS) + UB(1:1) = ubound(SrcParamData%TPitManS) + if (.not. allocated(DstParamData%TPitManS)) then + allocate(DstParamData%TPitManS(LB(1):UB(1)), 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 + end if + 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 + LB(1:1) = lbound(SrcParamData%TBDepISp) + UB(1:1) = ubound(SrcParamData%TBDepISp) + if (.not. allocated(DstParamData%TBDepISp)) then + allocate(DstParamData%TBDepISp(LB(1):UB(1)), 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 + end if + 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%AfCmode = SrcParamData%AfCmode + DstParamData%AfC_Mean = SrcParamData%AfC_Mean + DstParamData%AfC_Amp = SrcParamData%AfC_Amp + DstParamData%AfC_Phase = SrcParamData%AfC_Phase + DstParamData%CCmode = SrcParamData%CCmode + DstParamData%StCCmode = SrcParamData%StCCmode + DstParamData%NumOuts = SrcParamData%NumOuts + DstParamData%NumOuts_DLL = SrcParamData%NumOuts_DLL + DstParamData%RootName = SrcParamData%RootName + DstParamData%PriPath = SrcParamData%PriPath + if (allocated(SrcParamData%OutParam)) then + LB(1:1) = lbound(SrcParamData%OutParam) + UB(1:1) = ubound(SrcParamData%OutParam) + if (.not. allocated(DstParamData%OutParam)) then + allocate(DstParamData%OutParam(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutParam.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyOutParmType(SrcParamData%OutParam(i1), DstParamData%OutParam(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + 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 + LB(1:1) = lbound(SrcParamData%BStC) + UB(1:1) = ubound(SrcParamData%BStC) + if (.not. allocated(DstParamData%BStC)) then + allocate(DstParamData%BStC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call StC_CopyParam(SrcParamData%BStC(i1), DstParamData%BStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcParamData%NStC)) then + LB(1:1) = lbound(SrcParamData%NStC) + UB(1:1) = ubound(SrcParamData%NStC) + if (.not. allocated(DstParamData%NStC)) then + allocate(DstParamData%NStC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%NStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call StC_CopyParam(SrcParamData%NStC(i1), DstParamData%NStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcParamData%TStC)) then + LB(1:1) = lbound(SrcParamData%TStC) + UB(1:1) = ubound(SrcParamData%TStC) + if (.not. allocated(DstParamData%TStC)) then + allocate(DstParamData%TStC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call StC_CopyParam(SrcParamData%TStC(i1), DstParamData%TStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcParamData%SStC)) then + LB(1:1) = lbound(SrcParamData%SStC) + UB(1:1) = ubound(SrcParamData%SStC) + if (.not. allocated(DstParamData%SStC)) then + allocate(DstParamData%SStC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%SStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call StC_CopyParam(SrcParamData%SStC(i1), DstParamData%SStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + DstParamData%InterpOrder = SrcParamData%InterpOrder + DstParamData%EXavrSWAP = SrcParamData%EXavrSWAP + DstParamData%NumCableControl = SrcParamData%NumCableControl + DstParamData%NumStC_Control = SrcParamData%NumStC_Control + if (allocated(SrcParamData%StCMeasNumPerChan)) then + LB(1:1) = lbound(SrcParamData%StCMeasNumPerChan) + UB(1:1) = ubound(SrcParamData%StCMeasNumPerChan) + if (.not. allocated(DstParamData%StCMeasNumPerChan)) then + allocate(DstParamData%StCMeasNumPerChan(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%StCMeasNumPerChan.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%StCMeasNumPerChan = SrcParamData%StCMeasNumPerChan + end if + DstParamData%UseSC = SrcParamData%UseSC + if (allocated(SrcParamData%Jac_u_indx)) then + LB(1:2) = lbound(SrcParamData%Jac_u_indx) + UB(1:2) = ubound(SrcParamData%Jac_u_indx) + if (.not. allocated(DstParamData%Jac_u_indx)) then + allocate(DstParamData%Jac_u_indx(LB(1):UB(1),LB(2):UB(2)), 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 + end if + if (allocated(SrcParamData%Jac_x_indx)) then + LB(1:2) = lbound(SrcParamData%Jac_x_indx) + UB(1:2) = ubound(SrcParamData%Jac_x_indx) + if (.not. allocated(DstParamData%Jac_x_indx)) then + allocate(DstParamData%Jac_x_indx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_x_indx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Jac_x_indx = SrcParamData%Jac_x_indx + end if + if (allocated(SrcParamData%du)) then + LB(1:1) = lbound(SrcParamData%du) + UB(1:1) = ubound(SrcParamData%du) + if (.not. allocated(DstParamData%du)) then + allocate(DstParamData%du(LB(1):UB(1)), 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 + end if + if (allocated(SrcParamData%dx)) then + LB(1:1) = lbound(SrcParamData%dx) + UB(1:1) = ubound(SrcParamData%dx) + if (.not. allocated(DstParamData%dx)) then + allocate(DstParamData%dx(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%dx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%dx = SrcParamData%dx + end if + DstParamData%Jac_nu = SrcParamData%Jac_nu + DstParamData%Jac_ny = SrcParamData%Jac_ny + DstParamData%Jac_nx = SrcParamData%Jac_nx + if (allocated(SrcParamData%Jac_Idx_BStC_u)) then + LB(1:3) = lbound(SrcParamData%Jac_Idx_BStC_u) + UB(1:3) = ubound(SrcParamData%Jac_Idx_BStC_u) + if (.not. allocated(DstParamData%Jac_Idx_BStC_u)) then + allocate(DstParamData%Jac_Idx_BStC_u(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_BStC_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Jac_Idx_BStC_u = SrcParamData%Jac_Idx_BStC_u + end if + if (allocated(SrcParamData%Jac_Idx_NStC_u)) then + LB(1:2) = lbound(SrcParamData%Jac_Idx_NStC_u) + UB(1:2) = ubound(SrcParamData%Jac_Idx_NStC_u) + if (.not. allocated(DstParamData%Jac_Idx_NStC_u)) then + allocate(DstParamData%Jac_Idx_NStC_u(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_NStC_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Jac_Idx_NStC_u = SrcParamData%Jac_Idx_NStC_u + end if + if (allocated(SrcParamData%Jac_Idx_TStC_u)) then + LB(1:2) = lbound(SrcParamData%Jac_Idx_TStC_u) + UB(1:2) = ubound(SrcParamData%Jac_Idx_TStC_u) + if (.not. allocated(DstParamData%Jac_Idx_TStC_u)) then + allocate(DstParamData%Jac_Idx_TStC_u(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_TStC_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Jac_Idx_TStC_u = SrcParamData%Jac_Idx_TStC_u + end if + if (allocated(SrcParamData%Jac_Idx_SStC_u)) then + LB(1:2) = lbound(SrcParamData%Jac_Idx_SStC_u) + UB(1:2) = ubound(SrcParamData%Jac_Idx_SStC_u) + if (.not. allocated(DstParamData%Jac_Idx_SStC_u)) then + allocate(DstParamData%Jac_Idx_SStC_u(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_SStC_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Jac_Idx_SStC_u = SrcParamData%Jac_Idx_SStC_u + end if + if (allocated(SrcParamData%Jac_Idx_BStC_x)) then + LB(1:3) = lbound(SrcParamData%Jac_Idx_BStC_x) + UB(1:3) = ubound(SrcParamData%Jac_Idx_BStC_x) + if (.not. allocated(DstParamData%Jac_Idx_BStC_x)) then + allocate(DstParamData%Jac_Idx_BStC_x(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_BStC_x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Jac_Idx_BStC_x = SrcParamData%Jac_Idx_BStC_x + end if + if (allocated(SrcParamData%Jac_Idx_NStC_x)) then + LB(1:2) = lbound(SrcParamData%Jac_Idx_NStC_x) + UB(1:2) = ubound(SrcParamData%Jac_Idx_NStC_x) + if (.not. allocated(DstParamData%Jac_Idx_NStC_x)) then + allocate(DstParamData%Jac_Idx_NStC_x(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_NStC_x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Jac_Idx_NStC_x = SrcParamData%Jac_Idx_NStC_x + end if + if (allocated(SrcParamData%Jac_Idx_TStC_x)) then + LB(1:2) = lbound(SrcParamData%Jac_Idx_TStC_x) + UB(1:2) = ubound(SrcParamData%Jac_Idx_TStC_x) + if (.not. allocated(DstParamData%Jac_Idx_TStC_x)) then + allocate(DstParamData%Jac_Idx_TStC_x(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_TStC_x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Jac_Idx_TStC_x = SrcParamData%Jac_Idx_TStC_x + end if + if (allocated(SrcParamData%Jac_Idx_SStC_x)) then + LB(1:2) = lbound(SrcParamData%Jac_Idx_SStC_x) + UB(1:2) = ubound(SrcParamData%Jac_Idx_SStC_x) + if (.not. allocated(DstParamData%Jac_Idx_SStC_x)) then + allocate(DstParamData%Jac_Idx_SStC_x(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_SStC_x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Jac_Idx_SStC_x = SrcParamData%Jac_Idx_SStC_x + end if + if (allocated(SrcParamData%Jac_Idx_BStC_y)) then + LB(1:3) = lbound(SrcParamData%Jac_Idx_BStC_y) + UB(1:3) = ubound(SrcParamData%Jac_Idx_BStC_y) + if (.not. allocated(DstParamData%Jac_Idx_BStC_y)) then + allocate(DstParamData%Jac_Idx_BStC_y(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_BStC_y.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Jac_Idx_BStC_y = SrcParamData%Jac_Idx_BStC_y + end if + if (allocated(SrcParamData%Jac_Idx_NStC_y)) then + LB(1:2) = lbound(SrcParamData%Jac_Idx_NStC_y) + UB(1:2) = ubound(SrcParamData%Jac_Idx_NStC_y) + if (.not. allocated(DstParamData%Jac_Idx_NStC_y)) then + allocate(DstParamData%Jac_Idx_NStC_y(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_NStC_y.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Jac_Idx_NStC_y = SrcParamData%Jac_Idx_NStC_y + end if + if (allocated(SrcParamData%Jac_Idx_TStC_y)) then + LB(1:2) = lbound(SrcParamData%Jac_Idx_TStC_y) + UB(1:2) = ubound(SrcParamData%Jac_Idx_TStC_y) + if (.not. allocated(DstParamData%Jac_Idx_TStC_y)) then + allocate(DstParamData%Jac_Idx_TStC_y(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_TStC_y.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Jac_Idx_TStC_y = SrcParamData%Jac_Idx_TStC_y + end if + if (allocated(SrcParamData%Jac_Idx_SStC_y)) then + LB(1:2) = lbound(SrcParamData%Jac_Idx_SStC_y) + UB(1:2) = ubound(SrcParamData%Jac_Idx_SStC_y) + if (.not. allocated(DstParamData%Jac_Idx_SStC_y)) then + allocate(DstParamData%Jac_Idx_SStC_y(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_SStC_y.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Jac_Idx_SStC_y = SrcParamData%Jac_Idx_SStC_y + end if + DstParamData%SensorType = SrcParamData%SensorType + DstParamData%NumBeam = SrcParamData%NumBeam + DstParamData%NumPulseGate = SrcParamData%NumPulseGate + DstParamData%PulseSpacing = SrcParamData%PulseSpacing + DstParamData%URefLid = SrcParamData%URefLid +end subroutine + +subroutine SrvD_DestroyParam(ParamData, ErrStat, ErrMsg) + type(SrvD_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SrvD_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ParamData%BlPitchInit)) then + deallocate(ParamData%BlPitchInit) + end if + if (allocated(ParamData%BlPitchF)) then + deallocate(ParamData%BlPitchF) + end if + if (allocated(ParamData%PitManRat)) then + deallocate(ParamData%PitManRat) + end if + if (allocated(ParamData%TPitManS)) then + deallocate(ParamData%TPitManS) + end if + if (allocated(ParamData%TBDepISp)) then + deallocate(ParamData%TBDepISp) + end if + if (allocated(ParamData%OutParam)) then + LB(1:1) = lbound(ParamData%OutParam) + UB(1:1) = ubound(ParamData%OutParam) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyOutParmType(ParamData%OutParam(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%OutParam) + end if + call FreeDynamicLib( ParamData%DLL_Trgt, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(ParamData%BStC)) then + LB(1:1) = lbound(ParamData%BStC) + UB(1:1) = ubound(ParamData%BStC) + do i1 = LB(1), UB(1) + call StC_DestroyParam(ParamData%BStC(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%BStC) + end if + if (allocated(ParamData%NStC)) then + LB(1:1) = lbound(ParamData%NStC) + UB(1:1) = ubound(ParamData%NStC) + do i1 = LB(1), UB(1) + call StC_DestroyParam(ParamData%NStC(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%NStC) + end if + if (allocated(ParamData%TStC)) then + LB(1:1) = lbound(ParamData%TStC) + UB(1:1) = ubound(ParamData%TStC) + do i1 = LB(1), UB(1) + call StC_DestroyParam(ParamData%TStC(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%TStC) + end if + if (allocated(ParamData%SStC)) then + LB(1:1) = lbound(ParamData%SStC) + UB(1:1) = ubound(ParamData%SStC) + do i1 = LB(1), UB(1) + call StC_DestroyParam(ParamData%SStC(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%SStC) + end if + if (allocated(ParamData%StCMeasNumPerChan)) then + deallocate(ParamData%StCMeasNumPerChan) + end if + if (allocated(ParamData%Jac_u_indx)) then + deallocate(ParamData%Jac_u_indx) + end if + if (allocated(ParamData%Jac_x_indx)) then + deallocate(ParamData%Jac_x_indx) + end if + if (allocated(ParamData%du)) then + deallocate(ParamData%du) + end if + if (allocated(ParamData%dx)) then + deallocate(ParamData%dx) + end if + if (allocated(ParamData%Jac_Idx_BStC_u)) then + deallocate(ParamData%Jac_Idx_BStC_u) + end if + if (allocated(ParamData%Jac_Idx_NStC_u)) then + deallocate(ParamData%Jac_Idx_NStC_u) + end if + if (allocated(ParamData%Jac_Idx_TStC_u)) then + deallocate(ParamData%Jac_Idx_TStC_u) + end if + if (allocated(ParamData%Jac_Idx_SStC_u)) then + deallocate(ParamData%Jac_Idx_SStC_u) + end if + if (allocated(ParamData%Jac_Idx_BStC_x)) then + deallocate(ParamData%Jac_Idx_BStC_x) + end if + if (allocated(ParamData%Jac_Idx_NStC_x)) then + deallocate(ParamData%Jac_Idx_NStC_x) + end if + if (allocated(ParamData%Jac_Idx_TStC_x)) then + deallocate(ParamData%Jac_Idx_TStC_x) + end if + if (allocated(ParamData%Jac_Idx_SStC_x)) then + deallocate(ParamData%Jac_Idx_SStC_x) + end if + if (allocated(ParamData%Jac_Idx_BStC_y)) then + deallocate(ParamData%Jac_Idx_BStC_y) + end if + if (allocated(ParamData%Jac_Idx_NStC_y)) then + deallocate(ParamData%Jac_Idx_NStC_y) + end if + if (allocated(ParamData%Jac_Idx_TStC_y)) then + deallocate(ParamData%Jac_Idx_TStC_y) + end if + if (allocated(ParamData%Jac_Idx_SStC_y)) then + deallocate(ParamData%Jac_Idx_SStC_y) + end if +end subroutine + +subroutine SrvD_PackParam(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SrvD_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SrvD_PackParam' + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DT) + call RegPack(RF, InData%HSSBrDT) + call RegPack(RF, InData%HSSBrTqF) + call RegPack(RF, InData%SIG_POSl) + call RegPack(RF, InData%SIG_POTq) + call RegPack(RF, InData%SIG_SlPc) + call RegPack(RF, InData%SIG_Slop) + call RegPack(RF, InData%SIG_SySp) + call RegPack(RF, InData%TEC_A0) + call RegPack(RF, InData%TEC_C0) + call RegPack(RF, InData%TEC_C1) + call RegPack(RF, InData%TEC_C2) + call RegPack(RF, InData%TEC_K2) + call RegPack(RF, InData%TEC_MR) + call RegPack(RF, InData%TEC_Re1) + call RegPack(RF, InData%TEC_RLR) + call RegPack(RF, InData%TEC_RRes) + call RegPack(RF, InData%TEC_SRes) + call RegPack(RF, InData%TEC_SySp) + call RegPack(RF, InData%TEC_V1a) + call RegPack(RF, InData%TEC_VLL) + call RegPack(RF, InData%TEC_Xe1) + call RegPack(RF, InData%GenEff) + call RegPackAlloc(RF, InData%BlPitchInit) + call RegPackAlloc(RF, InData%BlPitchF) + call RegPackAlloc(RF, InData%PitManRat) + call RegPack(RF, InData%YawManRat) + call RegPack(RF, InData%NacYawF) + call RegPack(RF, InData%SpdGenOn) + call RegPack(RF, InData%THSSBrDp) + call RegPack(RF, InData%THSSBrFl) + call RegPack(RF, InData%TimGenOf) + call RegPack(RF, InData%TimGenOn) + call RegPack(RF, InData%TPCOn) + call RegPackAlloc(RF, InData%TPitManS) + call RegPack(RF, InData%TYawManS) + call RegPack(RF, InData%TYCOn) + call RegPack(RF, InData%VS_RtGnSp) + call RegPack(RF, InData%VS_RtTq) + call RegPack(RF, InData%VS_Slope) + call RegPack(RF, InData%VS_SlPc) + call RegPack(RF, InData%VS_SySp) + call RegPack(RF, InData%VS_TrGnSp) + call RegPack(RF, InData%YawPosCom) + call RegPack(RF, InData%YawRateCom) + call RegPack(RF, InData%GenModel) + call RegPack(RF, InData%HSSBrMode) + call RegPack(RF, InData%PCMode) + call RegPack(RF, InData%VSContrl) + call RegPack(RF, InData%YCMode) + call RegPack(RF, InData%GenTiStp) + call RegPack(RF, InData%GenTiStr) + call RegPack(RF, InData%VS_Rgn2K) + call RegPack(RF, InData%YawNeut) + call RegPack(RF, InData%YawSpr) + call RegPack(RF, InData%YawDamp) + call RegPack(RF, InData%TpBrDT) + call RegPackAlloc(RF, InData%TBDepISp) + call RegPack(RF, InData%TBDrConN) + call RegPack(RF, InData%TBDrConD) + call RegPack(RF, InData%NumBl) + call RegPack(RF, InData%NumBStC) + call RegPack(RF, InData%NumNStC) + call RegPack(RF, InData%NumTStC) + call RegPack(RF, InData%NumSStC) + call RegPack(RF, InData%AfCmode) + call RegPack(RF, InData%AfC_Mean) + call RegPack(RF, InData%AfC_Amp) + call RegPack(RF, InData%AfC_Phase) + call RegPack(RF, InData%CCmode) + call RegPack(RF, InData%StCCmode) + call RegPack(RF, InData%NumOuts) + call RegPack(RF, InData%NumOuts_DLL) + call RegPack(RF, InData%RootName) + call RegPack(RF, InData%PriPath) + call RegPack(RF, allocated(InData%OutParam)) + if (allocated(InData%OutParam)) then + call RegPackBounds(RF, 1, lbound(InData%OutParam), ubound(InData%OutParam)) + LB(1:1) = lbound(InData%OutParam) + UB(1:1) = ubound(InData%OutParam) + do i1 = LB(1), UB(1) + call NWTC_Library_PackOutParmType(RF, InData%OutParam(i1)) + end do + end if + call RegPack(RF, InData%Delim) + call RegPack(RF, InData%UseBladedInterface) + call RegPack(RF, InData%UseLegacyInterface) + call DLLTypePack(RF, InData%DLL_Trgt) + call RegPack(RF, InData%DLL_Ramp) + call RegPack(RF, InData%BlAlpha) + call RegPack(RF, InData%DLL_n) + call RegPack(RF, InData%avcOUTNAME_LEN) + call RegPack(RF, InData%NacYaw_North) + call RegPack(RF, InData%AvgWindSpeed) + call RegPack(RF, InData%AirDens) + call RegPack(RF, InData%TrimCase) + call RegPack(RF, InData%TrimGain) + call RegPack(RF, InData%RotSpeedRef) + call RegPack(RF, allocated(InData%BStC)) + if (allocated(InData%BStC)) then + call RegPackBounds(RF, 1, lbound(InData%BStC), ubound(InData%BStC)) + LB(1:1) = lbound(InData%BStC) + UB(1:1) = ubound(InData%BStC) + do i1 = LB(1), UB(1) + call StC_PackParam(RF, InData%BStC(i1)) + end do + end if + call RegPack(RF, allocated(InData%NStC)) + if (allocated(InData%NStC)) then + call RegPackBounds(RF, 1, lbound(InData%NStC), ubound(InData%NStC)) + LB(1:1) = lbound(InData%NStC) + UB(1:1) = ubound(InData%NStC) + do i1 = LB(1), UB(1) + call StC_PackParam(RF, InData%NStC(i1)) + end do + end if + call RegPack(RF, allocated(InData%TStC)) + if (allocated(InData%TStC)) then + call RegPackBounds(RF, 1, lbound(InData%TStC), ubound(InData%TStC)) + LB(1:1) = lbound(InData%TStC) + UB(1:1) = ubound(InData%TStC) + do i1 = LB(1), UB(1) + call StC_PackParam(RF, InData%TStC(i1)) + end do + end if + call RegPack(RF, allocated(InData%SStC)) + if (allocated(InData%SStC)) then + call RegPackBounds(RF, 1, lbound(InData%SStC), ubound(InData%SStC)) + LB(1:1) = lbound(InData%SStC) + UB(1:1) = ubound(InData%SStC) + do i1 = LB(1), UB(1) + call StC_PackParam(RF, InData%SStC(i1)) + end do + end if + call RegPack(RF, InData%InterpOrder) + call RegPack(RF, InData%EXavrSWAP) + call RegPack(RF, InData%NumCableControl) + call RegPack(RF, InData%NumStC_Control) + call RegPackAlloc(RF, InData%StCMeasNumPerChan) + call RegPack(RF, InData%UseSC) + call RegPackAlloc(RF, InData%Jac_u_indx) + call RegPackAlloc(RF, InData%Jac_x_indx) + call RegPackAlloc(RF, InData%du) + call RegPackAlloc(RF, InData%dx) + call RegPack(RF, InData%Jac_nu) + call RegPack(RF, InData%Jac_ny) + call RegPack(RF, InData%Jac_nx) + call RegPackAlloc(RF, InData%Jac_Idx_BStC_u) + call RegPackAlloc(RF, InData%Jac_Idx_NStC_u) + call RegPackAlloc(RF, InData%Jac_Idx_TStC_u) + call RegPackAlloc(RF, InData%Jac_Idx_SStC_u) + call RegPackAlloc(RF, InData%Jac_Idx_BStC_x) + call RegPackAlloc(RF, InData%Jac_Idx_NStC_x) + call RegPackAlloc(RF, InData%Jac_Idx_TStC_x) + call RegPackAlloc(RF, InData%Jac_Idx_SStC_x) + call RegPackAlloc(RF, InData%Jac_Idx_BStC_y) + call RegPackAlloc(RF, InData%Jac_Idx_NStC_y) + call RegPackAlloc(RF, InData%Jac_Idx_TStC_y) + call RegPackAlloc(RF, InData%Jac_Idx_SStC_y) + call RegPack(RF, InData%SensorType) + call RegPack(RF, InData%NumBeam) + call RegPack(RF, InData%NumPulseGate) + call RegPack(RF, InData%PulseSpacing) + call RegPack(RF, InData%URefLid) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SrvD_UnPackParam(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SrvD_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SrvD_UnPackParam' + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HSSBrDT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HSSBrTqF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SIG_POSl); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SIG_POTq); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SIG_SlPc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SIG_Slop); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SIG_SySp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TEC_A0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TEC_C0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TEC_C1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TEC_C2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TEC_K2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TEC_MR); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TEC_Re1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TEC_RLR); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TEC_RRes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TEC_SRes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TEC_SySp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TEC_V1a); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TEC_VLL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TEC_Xe1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GenEff); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BlPitchInit); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BlPitchF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PitManRat); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawManRat); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NacYawF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SpdGenOn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%THSSBrDp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%THSSBrFl); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TimGenOf); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TimGenOn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TPCOn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TPitManS); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TYawManS); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TYCOn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VS_RtGnSp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VS_RtTq); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VS_Slope); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VS_SlPc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VS_SySp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VS_TrGnSp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawPosCom); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawRateCom); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GenModel); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HSSBrMode); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PCMode); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VSContrl); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YCMode); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GenTiStp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GenTiStr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VS_Rgn2K); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawNeut); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawSpr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawDamp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TpBrDT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TBDepISp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TBDrConN); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TBDrConD); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumBl); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumBStC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumNStC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumTStC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumSStC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AfCmode); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AfC_Mean); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AfC_Amp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AfC_Phase); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CCmode); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StCCmode); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumOuts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumOuts_DLL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RootName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PriPath); if (RegCheckErr(RF, RoutineName)) return + if (allocated(OutData%OutParam)) deallocate(OutData%OutParam) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%OutParam(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackOutParmType(RF, OutData%OutParam(i1)) ! OutParam + end do + end if + call RegUnpack(RF, OutData%Delim); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UseBladedInterface); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UseLegacyInterface); if (RegCheckErr(RF, RoutineName)) return + call DLLTypeUnpack(RF, OutData%DLL_Trgt) ! DLL_Trgt + call RegUnpack(RF, OutData%DLL_Ramp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BlAlpha); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DLL_n); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%avcOUTNAME_LEN); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NacYaw_North); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AvgWindSpeed); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AirDens); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TrimCase); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TrimGain); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RotSpeedRef); if (RegCheckErr(RF, RoutineName)) return + if (allocated(OutData%BStC)) deallocate(OutData%BStC) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%BStC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BStC.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call StC_UnpackParam(RF, OutData%BStC(i1)) ! BStC + end do + end if + if (allocated(OutData%NStC)) deallocate(OutData%NStC) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%NStC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NStC.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call StC_UnpackParam(RF, OutData%NStC(i1)) ! NStC + end do + end if + if (allocated(OutData%TStC)) deallocate(OutData%TStC) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%TStC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TStC.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call StC_UnpackParam(RF, OutData%TStC(i1)) ! TStC + end do + end if + if (allocated(OutData%SStC)) deallocate(OutData%SStC) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%SStC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SStC.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call StC_UnpackParam(RF, OutData%SStC(i1)) ! SStC + end do + end if + call RegUnpack(RF, OutData%InterpOrder); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%EXavrSWAP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumCableControl); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumStC_Control); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%StCMeasNumPerChan); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UseSC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Jac_u_indx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Jac_x_indx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%du); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Jac_nu); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Jac_ny); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Jac_nx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Jac_Idx_BStC_u); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Jac_Idx_NStC_u); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Jac_Idx_TStC_u); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Jac_Idx_SStC_u); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Jac_Idx_BStC_x); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Jac_Idx_NStC_x); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Jac_Idx_TStC_x); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Jac_Idx_SStC_x); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Jac_Idx_BStC_y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Jac_Idx_NStC_y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Jac_Idx_TStC_y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Jac_Idx_SStC_y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SensorType); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumBeam); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumPulseGate); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PulseSpacing); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%URefLid); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +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 + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SrvD_CopyInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcInputData%BlPitch)) then + LB(1:1) = lbound(SrcInputData%BlPitch) + UB(1:1) = ubound(SrcInputData%BlPitch) + if (.not. allocated(DstInputData%BlPitch)) then + allocate(DstInputData%BlPitch(LB(1):UB(1)), 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 + end if + 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 + LB(1:1) = lbound(SrcInputData%ExternalBlPitchCom) + UB(1:1) = ubound(SrcInputData%ExternalBlPitchCom) + if (.not. allocated(DstInputData%ExternalBlPitchCom)) then + allocate(DstInputData%ExternalBlPitchCom(LB(1):UB(1)), 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 + end if + DstInputData%ExternalGenTrq = SrcInputData%ExternalGenTrq + DstInputData%ExternalElecPwr = SrcInputData%ExternalElecPwr + DstInputData%ExternalHSSBrFrac = SrcInputData%ExternalHSSBrFrac + if (allocated(SrcInputData%ExternalBlAirfoilCom)) then + LB(1:1) = lbound(SrcInputData%ExternalBlAirfoilCom) + UB(1:1) = ubound(SrcInputData%ExternalBlAirfoilCom) + if (.not. allocated(DstInputData%ExternalBlAirfoilCom)) then + allocate(DstInputData%ExternalBlAirfoilCom(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%ExternalBlAirfoilCom.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%ExternalBlAirfoilCom = SrcInputData%ExternalBlAirfoilCom + end if + if (allocated(SrcInputData%ExternalCableDeltaL)) then + LB(1:1) = lbound(SrcInputData%ExternalCableDeltaL) + UB(1:1) = ubound(SrcInputData%ExternalCableDeltaL) + if (.not. allocated(DstInputData%ExternalCableDeltaL)) then + allocate(DstInputData%ExternalCableDeltaL(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%ExternalCableDeltaL.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%ExternalCableDeltaL = SrcInputData%ExternalCableDeltaL + end if + if (allocated(SrcInputData%ExternalCableDeltaLdot)) then + LB(1:1) = lbound(SrcInputData%ExternalCableDeltaLdot) + UB(1:1) = ubound(SrcInputData%ExternalCableDeltaLdot) + if (.not. allocated(DstInputData%ExternalCableDeltaLdot)) then + allocate(DstInputData%ExternalCableDeltaLdot(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%ExternalCableDeltaLdot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%ExternalCableDeltaLdot = SrcInputData%ExternalCableDeltaLdot + end if + 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 + DstInputData%LSShftFxa = SrcInputData%LSShftFxa + DstInputData%LSShftFys = SrcInputData%LSShftFys + DstInputData%LSShftFzs = SrcInputData%LSShftFzs + if (allocated(SrcInputData%fromSC)) then + LB(1:1) = lbound(SrcInputData%fromSC) + UB(1:1) = ubound(SrcInputData%fromSC) + if (.not. allocated(DstInputData%fromSC)) then + allocate(DstInputData%fromSC(LB(1):UB(1)), 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 + end if + if (allocated(SrcInputData%fromSCglob)) then + LB(1:1) = lbound(SrcInputData%fromSCglob) + UB(1:1) = ubound(SrcInputData%fromSCglob) + if (.not. allocated(DstInputData%fromSCglob)) then + allocate(DstInputData%fromSCglob(LB(1):UB(1)), 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 + end if + call MeshCopy(SrcInputData%PtfmMotionMesh, DstInputData%PtfmMotionMesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcInputData%BStCMotionMesh)) then + LB(1:2) = lbound(SrcInputData%BStCMotionMesh) + UB(1:2) = ubound(SrcInputData%BStCMotionMesh) + if (.not. allocated(DstInputData%BStCMotionMesh)) then + allocate(DstInputData%BStCMotionMesh(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%BStCMotionMesh.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call MeshCopy(SrcInputData%BStCMotionMesh(i1,i2), DstInputData%BStCMotionMesh(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do + end if + if (allocated(SrcInputData%NStCMotionMesh)) then + LB(1:1) = lbound(SrcInputData%NStCMotionMesh) + UB(1:1) = ubound(SrcInputData%NStCMotionMesh) + if (.not. allocated(DstInputData%NStCMotionMesh)) then + allocate(DstInputData%NStCMotionMesh(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%NStCMotionMesh.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MeshCopy(SrcInputData%NStCMotionMesh(i1), DstInputData%NStCMotionMesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcInputData%TStCMotionMesh)) then + LB(1:1) = lbound(SrcInputData%TStCMotionMesh) + UB(1:1) = ubound(SrcInputData%TStCMotionMesh) + if (.not. allocated(DstInputData%TStCMotionMesh)) then + allocate(DstInputData%TStCMotionMesh(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%TStCMotionMesh.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MeshCopy(SrcInputData%TStCMotionMesh(i1), DstInputData%TStCMotionMesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcInputData%SStCMotionMesh)) then + LB(1:1) = lbound(SrcInputData%SStCMotionMesh) + UB(1:1) = ubound(SrcInputData%SStCMotionMesh) + if (.not. allocated(DstInputData%SStCMotionMesh)) then + allocate(DstInputData%SStCMotionMesh(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%SStCMotionMesh.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MeshCopy(SrcInputData%SStCMotionMesh(i1), DstInputData%SStCMotionMesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcInputData%LidSpeed)) then + LB(1:1) = lbound(SrcInputData%LidSpeed) + UB(1:1) = ubound(SrcInputData%LidSpeed) + if (.not. allocated(DstInputData%LidSpeed)) then + allocate(DstInputData%LidSpeed(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%LidSpeed.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%LidSpeed = SrcInputData%LidSpeed + end if + if (allocated(SrcInputData%MsrPositionsX)) then + LB(1:1) = lbound(SrcInputData%MsrPositionsX) + UB(1:1) = ubound(SrcInputData%MsrPositionsX) + if (.not. allocated(DstInputData%MsrPositionsX)) then + allocate(DstInputData%MsrPositionsX(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%MsrPositionsX.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%MsrPositionsX = SrcInputData%MsrPositionsX + end if + if (allocated(SrcInputData%MsrPositionsY)) then + LB(1:1) = lbound(SrcInputData%MsrPositionsY) + UB(1:1) = ubound(SrcInputData%MsrPositionsY) + if (.not. allocated(DstInputData%MsrPositionsY)) then + allocate(DstInputData%MsrPositionsY(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%MsrPositionsY.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%MsrPositionsY = SrcInputData%MsrPositionsY + end if + if (allocated(SrcInputData%MsrPositionsZ)) then + LB(1:1) = lbound(SrcInputData%MsrPositionsZ) + UB(1:1) = ubound(SrcInputData%MsrPositionsZ) + if (.not. allocated(DstInputData%MsrPositionsZ)) then + allocate(DstInputData%MsrPositionsZ(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%MsrPositionsZ.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%MsrPositionsZ = SrcInputData%MsrPositionsZ + end if +end subroutine + +subroutine SrvD_DestroyInput(InputData, ErrStat, ErrMsg) + type(SrvD_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SrvD_DestroyInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InputData%BlPitch)) then + deallocate(InputData%BlPitch) + end if + if (allocated(InputData%ExternalBlPitchCom)) then + deallocate(InputData%ExternalBlPitchCom) + end if + if (allocated(InputData%ExternalBlAirfoilCom)) then + deallocate(InputData%ExternalBlAirfoilCom) + end if + if (allocated(InputData%ExternalCableDeltaL)) then + deallocate(InputData%ExternalCableDeltaL) + end if + if (allocated(InputData%ExternalCableDeltaLdot)) then + deallocate(InputData%ExternalCableDeltaLdot) + end if + if (allocated(InputData%fromSC)) then + deallocate(InputData%fromSC) + end if + if (allocated(InputData%fromSCglob)) then + deallocate(InputData%fromSCglob) + end if + call MeshDestroy( InputData%PtfmMotionMesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(InputData%BStCMotionMesh)) then + LB(1:2) = lbound(InputData%BStCMotionMesh) + UB(1:2) = ubound(InputData%BStCMotionMesh) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call MeshDestroy( InputData%BStCMotionMesh(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + deallocate(InputData%BStCMotionMesh) + end if + if (allocated(InputData%NStCMotionMesh)) then + LB(1:1) = lbound(InputData%NStCMotionMesh) + UB(1:1) = ubound(InputData%NStCMotionMesh) + do i1 = LB(1), UB(1) + call MeshDestroy( InputData%NStCMotionMesh(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InputData%NStCMotionMesh) + end if + if (allocated(InputData%TStCMotionMesh)) then + LB(1:1) = lbound(InputData%TStCMotionMesh) + UB(1:1) = ubound(InputData%TStCMotionMesh) + do i1 = LB(1), UB(1) + call MeshDestroy( InputData%TStCMotionMesh(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InputData%TStCMotionMesh) + end if + if (allocated(InputData%SStCMotionMesh)) then + LB(1:1) = lbound(InputData%SStCMotionMesh) + UB(1:1) = ubound(InputData%SStCMotionMesh) + do i1 = LB(1), UB(1) + call MeshDestroy( InputData%SStCMotionMesh(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InputData%SStCMotionMesh) + end if + if (allocated(InputData%LidSpeed)) then + deallocate(InputData%LidSpeed) + end if + if (allocated(InputData%MsrPositionsX)) then + deallocate(InputData%MsrPositionsX) + end if + if (allocated(InputData%MsrPositionsY)) then + deallocate(InputData%MsrPositionsY) + end if + if (allocated(InputData%MsrPositionsZ)) then + deallocate(InputData%MsrPositionsZ) + end if +end subroutine + +subroutine SrvD_PackInput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SrvD_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SrvD_PackInput' + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%BlPitch) + call RegPack(RF, InData%Yaw) + call RegPack(RF, InData%YawRate) + call RegPack(RF, InData%LSS_Spd) + call RegPack(RF, InData%HSS_Spd) + call RegPack(RF, InData%RotSpeed) + call RegPack(RF, InData%ExternalYawPosCom) + call RegPack(RF, InData%ExternalYawRateCom) + call RegPackAlloc(RF, InData%ExternalBlPitchCom) + call RegPack(RF, InData%ExternalGenTrq) + call RegPack(RF, InData%ExternalElecPwr) + call RegPack(RF, InData%ExternalHSSBrFrac) + call RegPackAlloc(RF, InData%ExternalBlAirfoilCom) + call RegPackAlloc(RF, InData%ExternalCableDeltaL) + call RegPackAlloc(RF, InData%ExternalCableDeltaLdot) + call RegPack(RF, InData%TwrAccel) + call RegPack(RF, InData%YawErr) + call RegPack(RF, InData%WindDir) + call RegPack(RF, InData%RootMyc) + call RegPack(RF, InData%YawBrTAxp) + call RegPack(RF, InData%YawBrTAyp) + call RegPack(RF, InData%LSSTipPxa) + call RegPack(RF, InData%RootMxc) + call RegPack(RF, InData%LSSTipMxa) + call RegPack(RF, InData%LSSTipMya) + call RegPack(RF, InData%LSSTipMza) + call RegPack(RF, InData%LSSTipMys) + call RegPack(RF, InData%LSSTipMzs) + call RegPack(RF, InData%YawBrMyn) + call RegPack(RF, InData%YawBrMzn) + call RegPack(RF, InData%NcIMURAxs) + call RegPack(RF, InData%NcIMURAys) + call RegPack(RF, InData%NcIMURAzs) + call RegPack(RF, InData%RotPwr) + call RegPack(RF, InData%HorWindV) + call RegPack(RF, InData%YawAngle) + call RegPack(RF, InData%LSShftFxa) + call RegPack(RF, InData%LSShftFys) + call RegPack(RF, InData%LSShftFzs) + call RegPackAlloc(RF, InData%fromSC) + call RegPackAlloc(RF, InData%fromSCglob) + call MeshPack(RF, InData%PtfmMotionMesh) + call RegPack(RF, allocated(InData%BStCMotionMesh)) + if (allocated(InData%BStCMotionMesh)) then + call RegPackBounds(RF, 2, lbound(InData%BStCMotionMesh), ubound(InData%BStCMotionMesh)) + LB(1:2) = lbound(InData%BStCMotionMesh) + UB(1:2) = ubound(InData%BStCMotionMesh) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call MeshPack(RF, InData%BStCMotionMesh(i1,i2)) + end do + end do + end if + call RegPack(RF, allocated(InData%NStCMotionMesh)) + if (allocated(InData%NStCMotionMesh)) then + call RegPackBounds(RF, 1, lbound(InData%NStCMotionMesh), ubound(InData%NStCMotionMesh)) + LB(1:1) = lbound(InData%NStCMotionMesh) + UB(1:1) = ubound(InData%NStCMotionMesh) + do i1 = LB(1), UB(1) + call MeshPack(RF, InData%NStCMotionMesh(i1)) + end do + end if + call RegPack(RF, allocated(InData%TStCMotionMesh)) + if (allocated(InData%TStCMotionMesh)) then + call RegPackBounds(RF, 1, lbound(InData%TStCMotionMesh), ubound(InData%TStCMotionMesh)) + LB(1:1) = lbound(InData%TStCMotionMesh) + UB(1:1) = ubound(InData%TStCMotionMesh) + do i1 = LB(1), UB(1) + call MeshPack(RF, InData%TStCMotionMesh(i1)) + end do + end if + call RegPack(RF, allocated(InData%SStCMotionMesh)) + if (allocated(InData%SStCMotionMesh)) then + call RegPackBounds(RF, 1, lbound(InData%SStCMotionMesh), ubound(InData%SStCMotionMesh)) + LB(1:1) = lbound(InData%SStCMotionMesh) + UB(1:1) = ubound(InData%SStCMotionMesh) + do i1 = LB(1), UB(1) + call MeshPack(RF, InData%SStCMotionMesh(i1)) + end do + end if + call RegPackAlloc(RF, InData%LidSpeed) + call RegPackAlloc(RF, InData%MsrPositionsX) + call RegPackAlloc(RF, InData%MsrPositionsY) + call RegPackAlloc(RF, InData%MsrPositionsZ) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SrvD_UnPackInput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SrvD_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SrvD_UnPackInput' + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%BlPitch); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Yaw); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawRate); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LSS_Spd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HSS_Spd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RotSpeed); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ExternalYawPosCom); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ExternalYawRateCom); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ExternalBlPitchCom); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ExternalGenTrq); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ExternalElecPwr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ExternalHSSBrFrac); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ExternalBlAirfoilCom); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ExternalCableDeltaL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ExternalCableDeltaLdot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TwrAccel); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawErr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WindDir); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RootMyc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawBrTAxp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawBrTAyp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LSSTipPxa); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RootMxc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LSSTipMxa); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LSSTipMya); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LSSTipMza); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LSSTipMys); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LSSTipMzs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawBrMyn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawBrMzn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NcIMURAxs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NcIMURAys); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NcIMURAzs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RotPwr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HorWindV); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawAngle); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LSShftFxa); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LSShftFys); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LSShftFzs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%fromSC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%fromSCglob); if (RegCheckErr(RF, RoutineName)) return + call MeshUnpack(RF, OutData%PtfmMotionMesh) ! PtfmMotionMesh + if (allocated(OutData%BStCMotionMesh)) deallocate(OutData%BStCMotionMesh) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%BStCMotionMesh(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BStCMotionMesh.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call MeshUnpack(RF, OutData%BStCMotionMesh(i1,i2)) ! BStCMotionMesh + end do + end do + end if + if (allocated(OutData%NStCMotionMesh)) deallocate(OutData%NStCMotionMesh) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%NStCMotionMesh(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NStCMotionMesh.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(RF, OutData%NStCMotionMesh(i1)) ! NStCMotionMesh + end do + end if + if (allocated(OutData%TStCMotionMesh)) deallocate(OutData%TStCMotionMesh) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%TStCMotionMesh(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TStCMotionMesh.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(RF, OutData%TStCMotionMesh(i1)) ! TStCMotionMesh + end do + end if + if (allocated(OutData%SStCMotionMesh)) deallocate(OutData%SStCMotionMesh) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%SStCMotionMesh(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SStCMotionMesh.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(RF, OutData%SStCMotionMesh(i1)) ! SStCMotionMesh + end do + end if + call RegUnpackAlloc(RF, OutData%LidSpeed); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%MsrPositionsX); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%MsrPositionsY); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%MsrPositionsZ); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +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 + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SrvD_CopyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcOutputData%WriteOutput)) then + LB(1:1) = lbound(SrcOutputData%WriteOutput) + UB(1:1) = ubound(SrcOutputData%WriteOutput) + if (.not. allocated(DstOutputData%WriteOutput)) then + allocate(DstOutputData%WriteOutput(LB(1):UB(1)), 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 + end if + if (allocated(SrcOutputData%BlPitchCom)) then + LB(1:1) = lbound(SrcOutputData%BlPitchCom) + UB(1:1) = ubound(SrcOutputData%BlPitchCom) + if (.not. allocated(DstOutputData%BlPitchCom)) then + allocate(DstOutputData%BlPitchCom(LB(1):UB(1)), 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 + end if + if (allocated(SrcOutputData%BlAirfoilCom)) then + LB(1:1) = lbound(SrcOutputData%BlAirfoilCom) + UB(1:1) = ubound(SrcOutputData%BlAirfoilCom) + if (.not. allocated(DstOutputData%BlAirfoilCom)) then + allocate(DstOutputData%BlAirfoilCom(LB(1):UB(1)), 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 + end if + DstOutputData%YawMom = SrcOutputData%YawMom + DstOutputData%YawPosCom = SrcOutputData%YawPosCom + DstOutputData%YawRateCom = SrcOutputData%YawRateCom + DstOutputData%GenTrq = SrcOutputData%GenTrq + DstOutputData%HSSBrTrqC = SrcOutputData%HSSBrTrqC + DstOutputData%ElecPwr = SrcOutputData%ElecPwr + if (allocated(SrcOutputData%TBDrCon)) then + LB(1:1) = lbound(SrcOutputData%TBDrCon) + UB(1:1) = ubound(SrcOutputData%TBDrCon) + if (.not. allocated(DstOutputData%TBDrCon)) then + allocate(DstOutputData%TBDrCon(LB(1):UB(1)), 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 + end if + if (allocated(SrcOutputData%CableDeltaL)) then + LB(1:1) = lbound(SrcOutputData%CableDeltaL) + UB(1:1) = ubound(SrcOutputData%CableDeltaL) + if (.not. allocated(DstOutputData%CableDeltaL)) then + allocate(DstOutputData%CableDeltaL(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%CableDeltaL.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%CableDeltaL = SrcOutputData%CableDeltaL + end if + if (allocated(SrcOutputData%CableDeltaLdot)) then + LB(1:1) = lbound(SrcOutputData%CableDeltaLdot) + UB(1:1) = ubound(SrcOutputData%CableDeltaLdot) + if (.not. allocated(DstOutputData%CableDeltaLdot)) then + allocate(DstOutputData%CableDeltaLdot(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%CableDeltaLdot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%CableDeltaLdot = SrcOutputData%CableDeltaLdot + end if + if (allocated(SrcOutputData%BStCLoadMesh)) then + LB(1:2) = lbound(SrcOutputData%BStCLoadMesh) + UB(1:2) = ubound(SrcOutputData%BStCLoadMesh) + if (.not. allocated(DstOutputData%BStCLoadMesh)) then + allocate(DstOutputData%BStCLoadMesh(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%BStCLoadMesh.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call MeshCopy(SrcOutputData%BStCLoadMesh(i1,i2), DstOutputData%BStCLoadMesh(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do + end if + if (allocated(SrcOutputData%NStCLoadMesh)) then + LB(1:1) = lbound(SrcOutputData%NStCLoadMesh) + UB(1:1) = ubound(SrcOutputData%NStCLoadMesh) + if (.not. allocated(DstOutputData%NStCLoadMesh)) then + allocate(DstOutputData%NStCLoadMesh(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%NStCLoadMesh.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MeshCopy(SrcOutputData%NStCLoadMesh(i1), DstOutputData%NStCLoadMesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcOutputData%TStCLoadMesh)) then + LB(1:1) = lbound(SrcOutputData%TStCLoadMesh) + UB(1:1) = ubound(SrcOutputData%TStCLoadMesh) + if (.not. allocated(DstOutputData%TStCLoadMesh)) then + allocate(DstOutputData%TStCLoadMesh(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%TStCLoadMesh.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MeshCopy(SrcOutputData%TStCLoadMesh(i1), DstOutputData%TStCLoadMesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcOutputData%SStCLoadMesh)) then + LB(1:1) = lbound(SrcOutputData%SStCLoadMesh) + UB(1:1) = ubound(SrcOutputData%SStCLoadMesh) + if (.not. allocated(DstOutputData%SStCLoadMesh)) then + allocate(DstOutputData%SStCLoadMesh(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%SStCLoadMesh.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MeshCopy(SrcOutputData%SStCLoadMesh(i1), DstOutputData%SStCLoadMesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcOutputData%toSC)) then + LB(1:1) = lbound(SrcOutputData%toSC) + UB(1:1) = ubound(SrcOutputData%toSC) + if (.not. allocated(DstOutputData%toSC)) then + allocate(DstOutputData%toSC(LB(1):UB(1)), 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 + end if +end subroutine + +subroutine SrvD_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(SrvD_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SrvD_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OutputData%WriteOutput)) then + deallocate(OutputData%WriteOutput) + end if + if (allocated(OutputData%BlPitchCom)) then + deallocate(OutputData%BlPitchCom) + end if + if (allocated(OutputData%BlAirfoilCom)) then + deallocate(OutputData%BlAirfoilCom) + end if + if (allocated(OutputData%TBDrCon)) then + deallocate(OutputData%TBDrCon) + end if + if (allocated(OutputData%CableDeltaL)) then + deallocate(OutputData%CableDeltaL) + end if + if (allocated(OutputData%CableDeltaLdot)) then + deallocate(OutputData%CableDeltaLdot) + end if + if (allocated(OutputData%BStCLoadMesh)) then + LB(1:2) = lbound(OutputData%BStCLoadMesh) + UB(1:2) = ubound(OutputData%BStCLoadMesh) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call MeshDestroy( OutputData%BStCLoadMesh(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + deallocate(OutputData%BStCLoadMesh) + end if + if (allocated(OutputData%NStCLoadMesh)) then + LB(1:1) = lbound(OutputData%NStCLoadMesh) + UB(1:1) = ubound(OutputData%NStCLoadMesh) + do i1 = LB(1), UB(1) + call MeshDestroy( OutputData%NStCLoadMesh(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(OutputData%NStCLoadMesh) + end if + if (allocated(OutputData%TStCLoadMesh)) then + LB(1:1) = lbound(OutputData%TStCLoadMesh) + UB(1:1) = ubound(OutputData%TStCLoadMesh) + do i1 = LB(1), UB(1) + call MeshDestroy( OutputData%TStCLoadMesh(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(OutputData%TStCLoadMesh) + end if + if (allocated(OutputData%SStCLoadMesh)) then + LB(1:1) = lbound(OutputData%SStCLoadMesh) + UB(1:1) = ubound(OutputData%SStCLoadMesh) + do i1 = LB(1), UB(1) + call MeshDestroy( OutputData%SStCLoadMesh(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(OutputData%SStCLoadMesh) + end if + if (allocated(OutputData%toSC)) then + deallocate(OutputData%toSC) + end if +end subroutine + +subroutine SrvD_PackOutput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SrvD_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SrvD_PackOutput' + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%WriteOutput) + call RegPackAlloc(RF, InData%BlPitchCom) + call RegPackAlloc(RF, InData%BlAirfoilCom) + call RegPack(RF, InData%YawMom) + call RegPack(RF, InData%YawPosCom) + call RegPack(RF, InData%YawRateCom) + call RegPack(RF, InData%GenTrq) + call RegPack(RF, InData%HSSBrTrqC) + call RegPack(RF, InData%ElecPwr) + call RegPackAlloc(RF, InData%TBDrCon) + call RegPackAlloc(RF, InData%CableDeltaL) + call RegPackAlloc(RF, InData%CableDeltaLdot) + call RegPack(RF, allocated(InData%BStCLoadMesh)) + if (allocated(InData%BStCLoadMesh)) then + call RegPackBounds(RF, 2, lbound(InData%BStCLoadMesh), ubound(InData%BStCLoadMesh)) + LB(1:2) = lbound(InData%BStCLoadMesh) + UB(1:2) = ubound(InData%BStCLoadMesh) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call MeshPack(RF, InData%BStCLoadMesh(i1,i2)) + end do + end do + end if + call RegPack(RF, allocated(InData%NStCLoadMesh)) + if (allocated(InData%NStCLoadMesh)) then + call RegPackBounds(RF, 1, lbound(InData%NStCLoadMesh), ubound(InData%NStCLoadMesh)) + LB(1:1) = lbound(InData%NStCLoadMesh) + UB(1:1) = ubound(InData%NStCLoadMesh) + do i1 = LB(1), UB(1) + call MeshPack(RF, InData%NStCLoadMesh(i1)) + end do + end if + call RegPack(RF, allocated(InData%TStCLoadMesh)) + if (allocated(InData%TStCLoadMesh)) then + call RegPackBounds(RF, 1, lbound(InData%TStCLoadMesh), ubound(InData%TStCLoadMesh)) + LB(1:1) = lbound(InData%TStCLoadMesh) + UB(1:1) = ubound(InData%TStCLoadMesh) + do i1 = LB(1), UB(1) + call MeshPack(RF, InData%TStCLoadMesh(i1)) + end do + end if + call RegPack(RF, allocated(InData%SStCLoadMesh)) + if (allocated(InData%SStCLoadMesh)) then + call RegPackBounds(RF, 1, lbound(InData%SStCLoadMesh), ubound(InData%SStCLoadMesh)) + LB(1:1) = lbound(InData%SStCLoadMesh) + UB(1:1) = ubound(InData%SStCLoadMesh) + do i1 = LB(1), UB(1) + call MeshPack(RF, InData%SStCLoadMesh(i1)) + end do + end if + call RegPackAlloc(RF, InData%toSC) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SrvD_UnPackOutput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SrvD_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SrvD_UnPackOutput' + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%WriteOutput); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BlPitchCom); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BlAirfoilCom); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawMom); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawPosCom); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawRateCom); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GenTrq); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HSSBrTrqC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ElecPwr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TBDrCon); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%CableDeltaL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%CableDeltaLdot); if (RegCheckErr(RF, RoutineName)) return + if (allocated(OutData%BStCLoadMesh)) deallocate(OutData%BStCLoadMesh) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%BStCLoadMesh(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BStCLoadMesh.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call MeshUnpack(RF, OutData%BStCLoadMesh(i1,i2)) ! BStCLoadMesh + end do + end do + end if + if (allocated(OutData%NStCLoadMesh)) deallocate(OutData%NStCLoadMesh) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%NStCLoadMesh(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NStCLoadMesh.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(RF, OutData%NStCLoadMesh(i1)) ! NStCLoadMesh + end do + end if + if (allocated(OutData%TStCLoadMesh)) deallocate(OutData%TStCLoadMesh) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%TStCLoadMesh(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TStCLoadMesh.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(RF, OutData%TStCLoadMesh(i1)) ! TStCLoadMesh + end do + end if + if (allocated(OutData%SStCLoadMesh)) deallocate(OutData%SStCLoadMesh) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%SStCLoadMesh(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SStCLoadMesh.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(RF, OutData%SStCLoadMesh(i1)) ! SStCLoadMesh + end do + end if + call RegUnpackAlloc(RF, OutData%toSC); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +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 ) + 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) /= size(u)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(u)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(u) - 1 + select case (order) + case (0) + call SrvD_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call SrvD_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call SrvD_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(u) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +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. @@ -18305,208 +6418,143 @@ SUBROUTINE SrvD_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ! !.................................................................................................................................. - 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 + 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 :: i02 ! dim2 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - INTEGER :: i2 ! dim2 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 + 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) :: a1, a2 ! 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 :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 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 -IF (ALLOCATED(u_out%ExternalBlAirfoilCom) .AND. ALLOCATED(u1%ExternalBlAirfoilCom)) THEN - DO i1 = LBOUND(u_out%ExternalBlAirfoilCom,1),UBOUND(u_out%ExternalBlAirfoilCom,1) - b = -(u1%ExternalBlAirfoilCom(i1) - u2%ExternalBlAirfoilCom(i1)) - u_out%ExternalBlAirfoilCom(i1) = u1%ExternalBlAirfoilCom(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%ExternalCableDeltaL) .AND. ALLOCATED(u1%ExternalCableDeltaL)) THEN - DO i1 = LBOUND(u_out%ExternalCableDeltaL,1),UBOUND(u_out%ExternalCableDeltaL,1) - b = -(u1%ExternalCableDeltaL(i1) - u2%ExternalCableDeltaL(i1)) - u_out%ExternalCableDeltaL(i1) = u1%ExternalCableDeltaL(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%ExternalCableDeltaLdot) .AND. ALLOCATED(u1%ExternalCableDeltaLdot)) THEN - DO i1 = LBOUND(u_out%ExternalCableDeltaLdot,1),UBOUND(u_out%ExternalCableDeltaLdot,1) - b = -(u1%ExternalCableDeltaLdot(i1) - u2%ExternalCableDeltaLdot(i1)) - u_out%ExternalCableDeltaLdot(i1) = u1%ExternalCableDeltaLdot(i1) + b * ScaleFactor - END DO -END IF ! check if allocated - 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 ) - b = -(u1%LSShftFxa - u2%LSShftFxa) - u_out%LSShftFxa = u1%LSShftFxa + b * ScaleFactor - b = -(u1%LSShftFys - u2%LSShftFys) - u_out%LSShftFys = u1%LSShftFys + b * ScaleFactor - b = -(u1%LSShftFzs - u2%LSShftFzs) - u_out%LSShftFzs = u1%LSShftFzs + b * ScaleFactor -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 - CALL MeshExtrapInterp1(u1%PtfmMotionMesh, u2%PtfmMotionMesh, tin, u_out%PtfmMotionMesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) -IF (ALLOCATED(u_out%BStCMotionMesh) .AND. ALLOCATED(u1%BStCMotionMesh)) THEN - DO i2 = LBOUND(u_out%BStCMotionMesh,2),UBOUND(u_out%BStCMotionMesh,2) - DO i1 = LBOUND(u_out%BStCMotionMesh,1),UBOUND(u_out%BStCMotionMesh,1) - CALL MeshExtrapInterp1(u1%BStCMotionMesh(i1,i2), u2%BStCMotionMesh(i1,i2), tin, u_out%BStCMotionMesh(i1,i2), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO - ENDDO -END IF ! check if allocated -IF (ALLOCATED(u_out%NStCMotionMesh) .AND. ALLOCATED(u1%NStCMotionMesh)) THEN - DO i1 = LBOUND(u_out%NStCMotionMesh,1),UBOUND(u_out%NStCMotionMesh,1) - CALL MeshExtrapInterp1(u1%NStCMotionMesh(i1), u2%NStCMotionMesh(i1), tin, u_out%NStCMotionMesh(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated -IF (ALLOCATED(u_out%TStCMotionMesh) .AND. ALLOCATED(u1%TStCMotionMesh)) THEN - DO i1 = LBOUND(u_out%TStCMotionMesh,1),UBOUND(u_out%TStCMotionMesh,1) - CALL MeshExtrapInterp1(u1%TStCMotionMesh(i1), u2%TStCMotionMesh(i1), tin, u_out%TStCMotionMesh(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated -IF (ALLOCATED(u_out%SStCMotionMesh) .AND. ALLOCATED(u1%SStCMotionMesh)) THEN - DO i1 = LBOUND(u_out%SStCMotionMesh,1),UBOUND(u_out%SStCMotionMesh,1) - CALL MeshExtrapInterp1(u1%SStCMotionMesh(i1), u2%SStCMotionMesh(i1), tin, u_out%SStCMotionMesh(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated -IF (ALLOCATED(u_out%LidSpeed) .AND. ALLOCATED(u1%LidSpeed)) THEN - DO i1 = LBOUND(u_out%LidSpeed,1),UBOUND(u_out%LidSpeed,1) - b = -(u1%LidSpeed(i1) - u2%LidSpeed(i1)) - u_out%LidSpeed(i1) = u1%LidSpeed(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%MsrPositionsX) .AND. ALLOCATED(u1%MsrPositionsX)) THEN - DO i1 = LBOUND(u_out%MsrPositionsX,1),UBOUND(u_out%MsrPositionsX,1) - b = -(u1%MsrPositionsX(i1) - u2%MsrPositionsX(i1)) - u_out%MsrPositionsX(i1) = u1%MsrPositionsX(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%MsrPositionsY) .AND. ALLOCATED(u1%MsrPositionsY)) THEN - DO i1 = LBOUND(u_out%MsrPositionsY,1),UBOUND(u_out%MsrPositionsY,1) - b = -(u1%MsrPositionsY(i1) - u2%MsrPositionsY(i1)) - u_out%MsrPositionsY(i1) = u1%MsrPositionsY(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%MsrPositionsZ) .AND. ALLOCATED(u1%MsrPositionsZ)) THEN - DO i1 = LBOUND(u_out%MsrPositionsZ,1),UBOUND(u_out%MsrPositionsZ,1) - b = -(u1%MsrPositionsZ(i1) - u2%MsrPositionsZ(i1)) - u_out%MsrPositionsZ(i1) = u1%MsrPositionsZ(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 ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = 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 ) + u_out%YawRate = a1*u1%YawRate + a2*u2%YawRate + u_out%LSS_Spd = a1*u1%LSS_Spd + a2*u2%LSS_Spd + u_out%HSS_Spd = a1*u1%HSS_Spd + a2*u2%HSS_Spd + u_out%RotSpeed = a1*u1%RotSpeed + a2*u2%RotSpeed + CALL Angles_ExtrapInterp( u1%ExternalYawPosCom, u2%ExternalYawPosCom, tin, u_out%ExternalYawPosCom, tin_out ) + u_out%ExternalYawRateCom = a1*u1%ExternalYawRateCom + a2*u2%ExternalYawRateCom + 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 + u_out%ExternalGenTrq = a1*u1%ExternalGenTrq + a2*u2%ExternalGenTrq + u_out%ExternalElecPwr = a1*u1%ExternalElecPwr + a2*u2%ExternalElecPwr + u_out%ExternalHSSBrFrac = a1*u1%ExternalHSSBrFrac + a2*u2%ExternalHSSBrFrac + IF (ALLOCATED(u_out%ExternalBlAirfoilCom) .AND. ALLOCATED(u1%ExternalBlAirfoilCom)) THEN + u_out%ExternalBlAirfoilCom = a1*u1%ExternalBlAirfoilCom + a2*u2%ExternalBlAirfoilCom + END IF ! check if allocated + IF (ALLOCATED(u_out%ExternalCableDeltaL) .AND. ALLOCATED(u1%ExternalCableDeltaL)) THEN + u_out%ExternalCableDeltaL = a1*u1%ExternalCableDeltaL + a2*u2%ExternalCableDeltaL + END IF ! check if allocated + IF (ALLOCATED(u_out%ExternalCableDeltaLdot) .AND. ALLOCATED(u1%ExternalCableDeltaLdot)) THEN + u_out%ExternalCableDeltaLdot = a1*u1%ExternalCableDeltaLdot + a2*u2%ExternalCableDeltaLdot + END IF ! check if allocated + u_out%TwrAccel = a1*u1%TwrAccel + a2*u2%TwrAccel + 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 ) + u_out%RootMyc = a1*u1%RootMyc + a2*u2%RootMyc + u_out%YawBrTAxp = a1*u1%YawBrTAxp + a2*u2%YawBrTAxp + u_out%YawBrTAyp = a1*u1%YawBrTAyp + a2*u2%YawBrTAyp + u_out%LSSTipPxa = a1*u1%LSSTipPxa + a2*u2%LSSTipPxa + u_out%RootMxc = a1*u1%RootMxc + a2*u2%RootMxc + u_out%LSSTipMxa = a1*u1%LSSTipMxa + a2*u2%LSSTipMxa + u_out%LSSTipMya = a1*u1%LSSTipMya + a2*u2%LSSTipMya + u_out%LSSTipMza = a1*u1%LSSTipMza + a2*u2%LSSTipMza + u_out%LSSTipMys = a1*u1%LSSTipMys + a2*u2%LSSTipMys + u_out%LSSTipMzs = a1*u1%LSSTipMzs + a2*u2%LSSTipMzs + u_out%YawBrMyn = a1*u1%YawBrMyn + a2*u2%YawBrMyn + u_out%YawBrMzn = a1*u1%YawBrMzn + a2*u2%YawBrMzn + u_out%NcIMURAxs = a1*u1%NcIMURAxs + a2*u2%NcIMURAxs + u_out%NcIMURAys = a1*u1%NcIMURAys + a2*u2%NcIMURAys + u_out%NcIMURAzs = a1*u1%NcIMURAzs + a2*u2%NcIMURAzs + u_out%RotPwr = a1*u1%RotPwr + a2*u2%RotPwr + u_out%HorWindV = a1*u1%HorWindV + a2*u2%HorWindV + CALL Angles_ExtrapInterp( u1%YawAngle, u2%YawAngle, tin, u_out%YawAngle, tin_out ) + u_out%LSShftFxa = a1*u1%LSShftFxa + a2*u2%LSShftFxa + u_out%LSShftFys = a1*u1%LSShftFys + a2*u2%LSShftFys + u_out%LSShftFzs = a1*u1%LSShftFzs + a2*u2%LSShftFzs + IF (ALLOCATED(u_out%fromSC) .AND. ALLOCATED(u1%fromSC)) THEN + u_out%fromSC = a1*u1%fromSC + a2*u2%fromSC + END IF ! check if allocated + IF (ALLOCATED(u_out%fromSCglob) .AND. ALLOCATED(u1%fromSCglob)) THEN + u_out%fromSCglob = a1*u1%fromSCglob + a2*u2%fromSCglob + END IF ! check if allocated + CALL MeshExtrapInterp1(u1%PtfmMotionMesh, u2%PtfmMotionMesh, tin, u_out%PtfmMotionMesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ALLOCATED(u_out%BStCMotionMesh) .AND. ALLOCATED(u1%BStCMotionMesh)) THEN + do i2 = lbound(u_out%BStCMotionMesh,2),ubound(u_out%BStCMotionMesh,2) + do i1 = lbound(u_out%BStCMotionMesh,1),ubound(u_out%BStCMotionMesh,1) + CALL MeshExtrapInterp1(u1%BStCMotionMesh(i1,i2), u2%BStCMotionMesh(i1,i2), tin, u_out%BStCMotionMesh(i1,i2), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END DO + END IF ! check if allocated + IF (ALLOCATED(u_out%NStCMotionMesh) .AND. ALLOCATED(u1%NStCMotionMesh)) THEN + do i1 = lbound(u_out%NStCMotionMesh,1),ubound(u_out%NStCMotionMesh,1) + CALL MeshExtrapInterp1(u1%NStCMotionMesh(i1), u2%NStCMotionMesh(i1), tin, u_out%NStCMotionMesh(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + IF (ALLOCATED(u_out%TStCMotionMesh) .AND. ALLOCATED(u1%TStCMotionMesh)) THEN + do i1 = lbound(u_out%TStCMotionMesh,1),ubound(u_out%TStCMotionMesh,1) + CALL MeshExtrapInterp1(u1%TStCMotionMesh(i1), u2%TStCMotionMesh(i1), tin, u_out%TStCMotionMesh(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + IF (ALLOCATED(u_out%SStCMotionMesh) .AND. ALLOCATED(u1%SStCMotionMesh)) THEN + do i1 = lbound(u_out%SStCMotionMesh,1),ubound(u_out%SStCMotionMesh,1) + CALL MeshExtrapInterp1(u1%SStCMotionMesh(i1), u2%SStCMotionMesh(i1), tin, u_out%SStCMotionMesh(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + IF (ALLOCATED(u_out%LidSpeed) .AND. ALLOCATED(u1%LidSpeed)) THEN + u_out%LidSpeed = a1*u1%LidSpeed + a2*u2%LidSpeed + END IF ! check if allocated + IF (ALLOCATED(u_out%MsrPositionsX) .AND. ALLOCATED(u1%MsrPositionsX)) THEN + u_out%MsrPositionsX = a1*u1%MsrPositionsX + a2*u2%MsrPositionsX + END IF ! check if allocated + IF (ALLOCATED(u_out%MsrPositionsY) .AND. ALLOCATED(u1%MsrPositionsY)) THEN + u_out%MsrPositionsY = a1*u1%MsrPositionsY + a2*u2%MsrPositionsY + END IF ! check if allocated + IF (ALLOCATED(u_out%MsrPositionsZ) .AND. ALLOCATED(u1%MsrPositionsZ)) THEN + u_out%MsrPositionsZ = a1*u1%MsrPositionsZ + a2*u2%MsrPositionsZ + END IF ! check if allocated +END SUBROUTINE + +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. @@ -18520,307 +6568,203 @@ SUBROUTINE SrvD_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Er ! !.................................................................................................................................. - 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 + 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 :: i02 ! dim2 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - INTEGER :: i2 ! dim2 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) - + 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) :: a1,a2,a3 ! 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 :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 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 + 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 + 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 + 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 -IF (ALLOCATED(u_out%ExternalBlAirfoilCom) .AND. ALLOCATED(u1%ExternalBlAirfoilCom)) THEN - DO i1 = LBOUND(u_out%ExternalBlAirfoilCom,1),UBOUND(u_out%ExternalBlAirfoilCom,1) - b = (t(3)**2*(u1%ExternalBlAirfoilCom(i1) - u2%ExternalBlAirfoilCom(i1)) + t(2)**2*(-u1%ExternalBlAirfoilCom(i1) + u3%ExternalBlAirfoilCom(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%ExternalBlAirfoilCom(i1) + t(3)*u2%ExternalBlAirfoilCom(i1) - t(2)*u3%ExternalBlAirfoilCom(i1) ) * scaleFactor - u_out%ExternalBlAirfoilCom(i1) = u1%ExternalBlAirfoilCom(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%ExternalCableDeltaL) .AND. ALLOCATED(u1%ExternalCableDeltaL)) THEN - DO i1 = LBOUND(u_out%ExternalCableDeltaL,1),UBOUND(u_out%ExternalCableDeltaL,1) - b = (t(3)**2*(u1%ExternalCableDeltaL(i1) - u2%ExternalCableDeltaL(i1)) + t(2)**2*(-u1%ExternalCableDeltaL(i1) + u3%ExternalCableDeltaL(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%ExternalCableDeltaL(i1) + t(3)*u2%ExternalCableDeltaL(i1) - t(2)*u3%ExternalCableDeltaL(i1) ) * scaleFactor - u_out%ExternalCableDeltaL(i1) = u1%ExternalCableDeltaL(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%ExternalCableDeltaLdot) .AND. ALLOCATED(u1%ExternalCableDeltaLdot)) THEN - DO i1 = LBOUND(u_out%ExternalCableDeltaLdot,1),UBOUND(u_out%ExternalCableDeltaLdot,1) - b = (t(3)**2*(u1%ExternalCableDeltaLdot(i1) - u2%ExternalCableDeltaLdot(i1)) + t(2)**2*(-u1%ExternalCableDeltaLdot(i1) + u3%ExternalCableDeltaLdot(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%ExternalCableDeltaLdot(i1) + t(3)*u2%ExternalCableDeltaLdot(i1) - t(2)*u3%ExternalCableDeltaLdot(i1) ) * scaleFactor - u_out%ExternalCableDeltaLdot(i1) = u1%ExternalCableDeltaLdot(i1) + b + c * t_out - END DO -END IF ! check if allocated - 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 ) - b = (t(3)**2*(u1%LSShftFxa - u2%LSShftFxa) + t(2)**2*(-u1%LSShftFxa + u3%LSShftFxa))* scaleFactor - c = ( (t(2)-t(3))*u1%LSShftFxa + t(3)*u2%LSShftFxa - t(2)*u3%LSShftFxa ) * scaleFactor - u_out%LSShftFxa = u1%LSShftFxa + b + c * t_out - b = (t(3)**2*(u1%LSShftFys - u2%LSShftFys) + t(2)**2*(-u1%LSShftFys + u3%LSShftFys))* scaleFactor - c = ( (t(2)-t(3))*u1%LSShftFys + t(3)*u2%LSShftFys - t(2)*u3%LSShftFys ) * scaleFactor - u_out%LSShftFys = u1%LSShftFys + b + c * t_out - b = (t(3)**2*(u1%LSShftFzs - u2%LSShftFzs) + t(2)**2*(-u1%LSShftFzs + u3%LSShftFzs))* scaleFactor - c = ( (t(2)-t(3))*u1%LSShftFzs + t(3)*u2%LSShftFzs - t(2)*u3%LSShftFzs ) * scaleFactor - u_out%LSShftFzs = u1%LSShftFzs + b + c * t_out -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 - CALL MeshExtrapInterp2(u1%PtfmMotionMesh, u2%PtfmMotionMesh, u3%PtfmMotionMesh, tin, u_out%PtfmMotionMesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) -IF (ALLOCATED(u_out%BStCMotionMesh) .AND. ALLOCATED(u1%BStCMotionMesh)) THEN - DO i2 = LBOUND(u_out%BStCMotionMesh,2),UBOUND(u_out%BStCMotionMesh,2) - DO i1 = LBOUND(u_out%BStCMotionMesh,1),UBOUND(u_out%BStCMotionMesh,1) - CALL MeshExtrapInterp2(u1%BStCMotionMesh(i1,i2), u2%BStCMotionMesh(i1,i2), u3%BStCMotionMesh(i1,i2), tin, u_out%BStCMotionMesh(i1,i2), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO - ENDDO -END IF ! check if allocated -IF (ALLOCATED(u_out%NStCMotionMesh) .AND. ALLOCATED(u1%NStCMotionMesh)) THEN - DO i1 = LBOUND(u_out%NStCMotionMesh,1),UBOUND(u_out%NStCMotionMesh,1) - CALL MeshExtrapInterp2(u1%NStCMotionMesh(i1), u2%NStCMotionMesh(i1), u3%NStCMotionMesh(i1), tin, u_out%NStCMotionMesh(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated -IF (ALLOCATED(u_out%TStCMotionMesh) .AND. ALLOCATED(u1%TStCMotionMesh)) THEN - DO i1 = LBOUND(u_out%TStCMotionMesh,1),UBOUND(u_out%TStCMotionMesh,1) - CALL MeshExtrapInterp2(u1%TStCMotionMesh(i1), u2%TStCMotionMesh(i1), u3%TStCMotionMesh(i1), tin, u_out%TStCMotionMesh(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated -IF (ALLOCATED(u_out%SStCMotionMesh) .AND. ALLOCATED(u1%SStCMotionMesh)) THEN - DO i1 = LBOUND(u_out%SStCMotionMesh,1),UBOUND(u_out%SStCMotionMesh,1) - CALL MeshExtrapInterp2(u1%SStCMotionMesh(i1), u2%SStCMotionMesh(i1), u3%SStCMotionMesh(i1), tin, u_out%SStCMotionMesh(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated -IF (ALLOCATED(u_out%LidSpeed) .AND. ALLOCATED(u1%LidSpeed)) THEN - DO i1 = LBOUND(u_out%LidSpeed,1),UBOUND(u_out%LidSpeed,1) - b = (t(3)**2*(u1%LidSpeed(i1) - u2%LidSpeed(i1)) + t(2)**2*(-u1%LidSpeed(i1) + u3%LidSpeed(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%LidSpeed(i1) + t(3)*u2%LidSpeed(i1) - t(2)*u3%LidSpeed(i1) ) * scaleFactor - u_out%LidSpeed(i1) = u1%LidSpeed(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%MsrPositionsX) .AND. ALLOCATED(u1%MsrPositionsX)) THEN - DO i1 = LBOUND(u_out%MsrPositionsX,1),UBOUND(u_out%MsrPositionsX,1) - b = (t(3)**2*(u1%MsrPositionsX(i1) - u2%MsrPositionsX(i1)) + t(2)**2*(-u1%MsrPositionsX(i1) + u3%MsrPositionsX(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%MsrPositionsX(i1) + t(3)*u2%MsrPositionsX(i1) - t(2)*u3%MsrPositionsX(i1) ) * scaleFactor - u_out%MsrPositionsX(i1) = u1%MsrPositionsX(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%MsrPositionsY) .AND. ALLOCATED(u1%MsrPositionsY)) THEN - DO i1 = LBOUND(u_out%MsrPositionsY,1),UBOUND(u_out%MsrPositionsY,1) - b = (t(3)**2*(u1%MsrPositionsY(i1) - u2%MsrPositionsY(i1)) + t(2)**2*(-u1%MsrPositionsY(i1) + u3%MsrPositionsY(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%MsrPositionsY(i1) + t(3)*u2%MsrPositionsY(i1) - t(2)*u3%MsrPositionsY(i1) ) * scaleFactor - u_out%MsrPositionsY(i1) = u1%MsrPositionsY(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%MsrPositionsZ) .AND. ALLOCATED(u1%MsrPositionsZ)) THEN - DO i1 = LBOUND(u_out%MsrPositionsZ,1),UBOUND(u_out%MsrPositionsZ,1) - b = (t(3)**2*(u1%MsrPositionsZ(i1) - u2%MsrPositionsZ(i1)) + t(2)**2*(-u1%MsrPositionsZ(i1) + u3%MsrPositionsZ(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%MsrPositionsZ(i1) + t(3)*u2%MsrPositionsZ(i1) - t(2)*u3%MsrPositionsZ(i1) ) * scaleFactor - u_out%MsrPositionsZ(i1) = u1%MsrPositionsZ(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 + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - 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), 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 ) + u_out%YawRate = a1*u1%YawRate + a2*u2%YawRate + a3*u3%YawRate + u_out%LSS_Spd = a1*u1%LSS_Spd + a2*u2%LSS_Spd + a3*u3%LSS_Spd + u_out%HSS_Spd = a1*u1%HSS_Spd + a2*u2%HSS_Spd + a3*u3%HSS_Spd + u_out%RotSpeed = a1*u1%RotSpeed + a2*u2%RotSpeed + a3*u3%RotSpeed + CALL Angles_ExtrapInterp( u1%ExternalYawPosCom, u2%ExternalYawPosCom, u3%ExternalYawPosCom, tin, u_out%ExternalYawPosCom, tin_out ) + u_out%ExternalYawRateCom = a1*u1%ExternalYawRateCom + a2*u2%ExternalYawRateCom + a3*u3%ExternalYawRateCom + 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 + u_out%ExternalGenTrq = a1*u1%ExternalGenTrq + a2*u2%ExternalGenTrq + a3*u3%ExternalGenTrq + u_out%ExternalElecPwr = a1*u1%ExternalElecPwr + a2*u2%ExternalElecPwr + a3*u3%ExternalElecPwr + u_out%ExternalHSSBrFrac = a1*u1%ExternalHSSBrFrac + a2*u2%ExternalHSSBrFrac + a3*u3%ExternalHSSBrFrac + IF (ALLOCATED(u_out%ExternalBlAirfoilCom) .AND. ALLOCATED(u1%ExternalBlAirfoilCom)) THEN + u_out%ExternalBlAirfoilCom = a1*u1%ExternalBlAirfoilCom + a2*u2%ExternalBlAirfoilCom + a3*u3%ExternalBlAirfoilCom + END IF ! check if allocated + IF (ALLOCATED(u_out%ExternalCableDeltaL) .AND. ALLOCATED(u1%ExternalCableDeltaL)) THEN + u_out%ExternalCableDeltaL = a1*u1%ExternalCableDeltaL + a2*u2%ExternalCableDeltaL + a3*u3%ExternalCableDeltaL + END IF ! check if allocated + IF (ALLOCATED(u_out%ExternalCableDeltaLdot) .AND. ALLOCATED(u1%ExternalCableDeltaLdot)) THEN + u_out%ExternalCableDeltaLdot = a1*u1%ExternalCableDeltaLdot + a2*u2%ExternalCableDeltaLdot + a3*u3%ExternalCableDeltaLdot + END IF ! check if allocated + u_out%TwrAccel = a1*u1%TwrAccel + a2*u2%TwrAccel + a3*u3%TwrAccel + 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 ) + u_out%RootMyc = a1*u1%RootMyc + a2*u2%RootMyc + a3*u3%RootMyc + u_out%YawBrTAxp = a1*u1%YawBrTAxp + a2*u2%YawBrTAxp + a3*u3%YawBrTAxp + u_out%YawBrTAyp = a1*u1%YawBrTAyp + a2*u2%YawBrTAyp + a3*u3%YawBrTAyp + u_out%LSSTipPxa = a1*u1%LSSTipPxa + a2*u2%LSSTipPxa + a3*u3%LSSTipPxa + u_out%RootMxc = a1*u1%RootMxc + a2*u2%RootMxc + a3*u3%RootMxc + u_out%LSSTipMxa = a1*u1%LSSTipMxa + a2*u2%LSSTipMxa + a3*u3%LSSTipMxa + u_out%LSSTipMya = a1*u1%LSSTipMya + a2*u2%LSSTipMya + a3*u3%LSSTipMya + u_out%LSSTipMza = a1*u1%LSSTipMza + a2*u2%LSSTipMza + a3*u3%LSSTipMza + u_out%LSSTipMys = a1*u1%LSSTipMys + a2*u2%LSSTipMys + a3*u3%LSSTipMys + u_out%LSSTipMzs = a1*u1%LSSTipMzs + a2*u2%LSSTipMzs + a3*u3%LSSTipMzs + u_out%YawBrMyn = a1*u1%YawBrMyn + a2*u2%YawBrMyn + a3*u3%YawBrMyn + u_out%YawBrMzn = a1*u1%YawBrMzn + a2*u2%YawBrMzn + a3*u3%YawBrMzn + u_out%NcIMURAxs = a1*u1%NcIMURAxs + a2*u2%NcIMURAxs + a3*u3%NcIMURAxs + u_out%NcIMURAys = a1*u1%NcIMURAys + a2*u2%NcIMURAys + a3*u3%NcIMURAys + u_out%NcIMURAzs = a1*u1%NcIMURAzs + a2*u2%NcIMURAzs + a3*u3%NcIMURAzs + u_out%RotPwr = a1*u1%RotPwr + a2*u2%RotPwr + a3*u3%RotPwr + u_out%HorWindV = a1*u1%HorWindV + a2*u2%HorWindV + a3*u3%HorWindV + CALL Angles_ExtrapInterp( u1%YawAngle, u2%YawAngle, u3%YawAngle, tin, u_out%YawAngle, tin_out ) + u_out%LSShftFxa = a1*u1%LSShftFxa + a2*u2%LSShftFxa + a3*u3%LSShftFxa + u_out%LSShftFys = a1*u1%LSShftFys + a2*u2%LSShftFys + a3*u3%LSShftFys + u_out%LSShftFzs = a1*u1%LSShftFzs + a2*u2%LSShftFzs + a3*u3%LSShftFzs + IF (ALLOCATED(u_out%fromSC) .AND. ALLOCATED(u1%fromSC)) THEN + u_out%fromSC = a1*u1%fromSC + a2*u2%fromSC + a3*u3%fromSC + END IF ! check if allocated + IF (ALLOCATED(u_out%fromSCglob) .AND. ALLOCATED(u1%fromSCglob)) THEN + u_out%fromSCglob = a1*u1%fromSCglob + a2*u2%fromSCglob + a3*u3%fromSCglob + END IF ! check if allocated + CALL MeshExtrapInterp2(u1%PtfmMotionMesh, u2%PtfmMotionMesh, u3%PtfmMotionMesh, tin, u_out%PtfmMotionMesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ALLOCATED(u_out%BStCMotionMesh) .AND. ALLOCATED(u1%BStCMotionMesh)) THEN + do i2 = lbound(u_out%BStCMotionMesh,2),ubound(u_out%BStCMotionMesh,2) + do i1 = lbound(u_out%BStCMotionMesh,1),ubound(u_out%BStCMotionMesh,1) + CALL MeshExtrapInterp2(u1%BStCMotionMesh(i1,i2), u2%BStCMotionMesh(i1,i2), u3%BStCMotionMesh(i1,i2), tin, u_out%BStCMotionMesh(i1,i2), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END DO + END IF ! check if allocated + IF (ALLOCATED(u_out%NStCMotionMesh) .AND. ALLOCATED(u1%NStCMotionMesh)) THEN + do i1 = lbound(u_out%NStCMotionMesh,1),ubound(u_out%NStCMotionMesh,1) + CALL MeshExtrapInterp2(u1%NStCMotionMesh(i1), u2%NStCMotionMesh(i1), u3%NStCMotionMesh(i1), tin, u_out%NStCMotionMesh(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + IF (ALLOCATED(u_out%TStCMotionMesh) .AND. ALLOCATED(u1%TStCMotionMesh)) THEN + do i1 = lbound(u_out%TStCMotionMesh,1),ubound(u_out%TStCMotionMesh,1) + CALL MeshExtrapInterp2(u1%TStCMotionMesh(i1), u2%TStCMotionMesh(i1), u3%TStCMotionMesh(i1), tin, u_out%TStCMotionMesh(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + IF (ALLOCATED(u_out%SStCMotionMesh) .AND. ALLOCATED(u1%SStCMotionMesh)) THEN + do i1 = lbound(u_out%SStCMotionMesh,1),ubound(u_out%SStCMotionMesh,1) + CALL MeshExtrapInterp2(u1%SStCMotionMesh(i1), u2%SStCMotionMesh(i1), u3%SStCMotionMesh(i1), tin, u_out%SStCMotionMesh(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + IF (ALLOCATED(u_out%LidSpeed) .AND. ALLOCATED(u1%LidSpeed)) THEN + u_out%LidSpeed = a1*u1%LidSpeed + a2*u2%LidSpeed + a3*u3%LidSpeed + END IF ! check if allocated + IF (ALLOCATED(u_out%MsrPositionsX) .AND. ALLOCATED(u1%MsrPositionsX)) THEN + u_out%MsrPositionsX = a1*u1%MsrPositionsX + a2*u2%MsrPositionsX + a3*u3%MsrPositionsX + END IF ! check if allocated + IF (ALLOCATED(u_out%MsrPositionsY) .AND. ALLOCATED(u1%MsrPositionsY)) THEN + u_out%MsrPositionsY = a1*u1%MsrPositionsY + a2*u2%MsrPositionsY + a3*u3%MsrPositionsY + END IF ! check if allocated + IF (ALLOCATED(u_out%MsrPositionsZ) .AND. ALLOCATED(u1%MsrPositionsZ)) THEN + u_out%MsrPositionsZ = a1*u1%MsrPositionsZ + a2*u2%MsrPositionsZ + a3*u3%MsrPositionsZ + END IF ! check if allocated +END SUBROUTINE + +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 ) + 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) /= size(y)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(y)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(y) - 1 + select case (order) + case (0) + call SrvD_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call SrvD_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call SrvD_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(y) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +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. @@ -18832,124 +6776,99 @@ SUBROUTINE SrvD_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMs ! !.................................................................................................................................. - 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 + 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 :: i02 ! dim2 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - INTEGER :: i2 ! dim2 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 + 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) :: a1, a2 ! 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 :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 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%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 -IF (ALLOCATED(y_out%CableDeltaL) .AND. ALLOCATED(y1%CableDeltaL)) THEN - DO i1 = LBOUND(y_out%CableDeltaL,1),UBOUND(y_out%CableDeltaL,1) - b = -(y1%CableDeltaL(i1) - y2%CableDeltaL(i1)) - y_out%CableDeltaL(i1) = y1%CableDeltaL(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%CableDeltaLdot) .AND. ALLOCATED(y1%CableDeltaLdot)) THEN - DO i1 = LBOUND(y_out%CableDeltaLdot,1),UBOUND(y_out%CableDeltaLdot,1) - b = -(y1%CableDeltaLdot(i1) - y2%CableDeltaLdot(i1)) - y_out%CableDeltaLdot(i1) = y1%CableDeltaLdot(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%BStCLoadMesh) .AND. ALLOCATED(y1%BStCLoadMesh)) THEN - DO i2 = LBOUND(y_out%BStCLoadMesh,2),UBOUND(y_out%BStCLoadMesh,2) - DO i1 = LBOUND(y_out%BStCLoadMesh,1),UBOUND(y_out%BStCLoadMesh,1) - CALL MeshExtrapInterp1(y1%BStCLoadMesh(i1,i2), y2%BStCLoadMesh(i1,i2), tin, y_out%BStCLoadMesh(i1,i2), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO - ENDDO -END IF ! check if allocated -IF (ALLOCATED(y_out%NStCLoadMesh) .AND. ALLOCATED(y1%NStCLoadMesh)) THEN - DO i1 = LBOUND(y_out%NStCLoadMesh,1),UBOUND(y_out%NStCLoadMesh,1) - CALL MeshExtrapInterp1(y1%NStCLoadMesh(i1), y2%NStCLoadMesh(i1), tin, y_out%NStCLoadMesh(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated -IF (ALLOCATED(y_out%TStCLoadMesh) .AND. ALLOCATED(y1%TStCLoadMesh)) THEN - DO i1 = LBOUND(y_out%TStCLoadMesh,1),UBOUND(y_out%TStCLoadMesh,1) - CALL MeshExtrapInterp1(y1%TStCLoadMesh(i1), y2%TStCLoadMesh(i1), tin, y_out%TStCLoadMesh(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated -IF (ALLOCATED(y_out%SStCLoadMesh) .AND. ALLOCATED(y1%SStCLoadMesh)) THEN - DO i1 = LBOUND(y_out%SStCLoadMesh,1),UBOUND(y_out%SStCLoadMesh,1) - CALL MeshExtrapInterp1(y1%SStCLoadMesh(i1), y2%SStCLoadMesh(i1), tin, y_out%SStCLoadMesh(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 - END SUBROUTINE SrvD_Output_ExtrapInterp1 - - - SUBROUTINE SrvD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + 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 + y_out%BlAirfoilCom = a1*y1%BlAirfoilCom + a2*y2%BlAirfoilCom + END IF ! check if allocated + y_out%YawMom = a1*y1%YawMom + a2*y2%YawMom + y_out%YawPosCom = a1*y1%YawPosCom + a2*y2%YawPosCom + y_out%YawRateCom = a1*y1%YawRateCom + a2*y2%YawRateCom + y_out%GenTrq = a1*y1%GenTrq + a2*y2%GenTrq + y_out%HSSBrTrqC = a1*y1%HSSBrTrqC + a2*y2%HSSBrTrqC + y_out%ElecPwr = a1*y1%ElecPwr + a2*y2%ElecPwr + IF (ALLOCATED(y_out%TBDrCon) .AND. ALLOCATED(y1%TBDrCon)) THEN + y_out%TBDrCon = a1*y1%TBDrCon + a2*y2%TBDrCon + END IF ! check if allocated + IF (ALLOCATED(y_out%CableDeltaL) .AND. ALLOCATED(y1%CableDeltaL)) THEN + y_out%CableDeltaL = a1*y1%CableDeltaL + a2*y2%CableDeltaL + END IF ! check if allocated + IF (ALLOCATED(y_out%CableDeltaLdot) .AND. ALLOCATED(y1%CableDeltaLdot)) THEN + y_out%CableDeltaLdot = a1*y1%CableDeltaLdot + a2*y2%CableDeltaLdot + END IF ! check if allocated + IF (ALLOCATED(y_out%BStCLoadMesh) .AND. ALLOCATED(y1%BStCLoadMesh)) THEN + do i2 = lbound(y_out%BStCLoadMesh,2),ubound(y_out%BStCLoadMesh,2) + do i1 = lbound(y_out%BStCLoadMesh,1),ubound(y_out%BStCLoadMesh,1) + CALL MeshExtrapInterp1(y1%BStCLoadMesh(i1,i2), y2%BStCLoadMesh(i1,i2), tin, y_out%BStCLoadMesh(i1,i2), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END DO + END IF ! check if allocated + IF (ALLOCATED(y_out%NStCLoadMesh) .AND. ALLOCATED(y1%NStCLoadMesh)) THEN + do i1 = lbound(y_out%NStCLoadMesh,1),ubound(y_out%NStCLoadMesh,1) + CALL MeshExtrapInterp1(y1%NStCLoadMesh(i1), y2%NStCLoadMesh(i1), tin, y_out%NStCLoadMesh(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + IF (ALLOCATED(y_out%TStCLoadMesh) .AND. ALLOCATED(y1%TStCLoadMesh)) THEN + do i1 = lbound(y_out%TStCLoadMesh,1),ubound(y_out%TStCLoadMesh,1) + CALL MeshExtrapInterp1(y1%TStCLoadMesh(i1), y2%TStCLoadMesh(i1), tin, y_out%TStCLoadMesh(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + IF (ALLOCATED(y_out%SStCLoadMesh) .AND. ALLOCATED(y1%SStCLoadMesh)) THEN + do i1 = lbound(y_out%SStCLoadMesh,1),ubound(y_out%SStCLoadMesh,1) + CALL MeshExtrapInterp1(y1%SStCLoadMesh(i1), y2%SStCLoadMesh(i1), tin, y_out%SStCLoadMesh(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + IF (ALLOCATED(y_out%toSC) .AND. ALLOCATED(y1%toSC)) THEN + y_out%toSC = a1*y1%toSC + a2*y2%toSC + END IF ! check if allocated +END SUBROUTINE + +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. @@ -18963,141 +6882,104 @@ SUBROUTINE SrvD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, E ! !.................................................................................................................................. - 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 + 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 :: i02 ! dim2 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - INTEGER :: i2 ! dim2 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) - + 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) :: a1,a2,a3 ! 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 :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 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 + 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 + 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 + 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%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 -IF (ALLOCATED(y_out%CableDeltaL) .AND. ALLOCATED(y1%CableDeltaL)) THEN - DO i1 = LBOUND(y_out%CableDeltaL,1),UBOUND(y_out%CableDeltaL,1) - b = (t(3)**2*(y1%CableDeltaL(i1) - y2%CableDeltaL(i1)) + t(2)**2*(-y1%CableDeltaL(i1) + y3%CableDeltaL(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%CableDeltaL(i1) + t(3)*y2%CableDeltaL(i1) - t(2)*y3%CableDeltaL(i1) ) * scaleFactor - y_out%CableDeltaL(i1) = y1%CableDeltaL(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%CableDeltaLdot) .AND. ALLOCATED(y1%CableDeltaLdot)) THEN - DO i1 = LBOUND(y_out%CableDeltaLdot,1),UBOUND(y_out%CableDeltaLdot,1) - b = (t(3)**2*(y1%CableDeltaLdot(i1) - y2%CableDeltaLdot(i1)) + t(2)**2*(-y1%CableDeltaLdot(i1) + y3%CableDeltaLdot(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%CableDeltaLdot(i1) + t(3)*y2%CableDeltaLdot(i1) - t(2)*y3%CableDeltaLdot(i1) ) * scaleFactor - y_out%CableDeltaLdot(i1) = y1%CableDeltaLdot(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%BStCLoadMesh) .AND. ALLOCATED(y1%BStCLoadMesh)) THEN - DO i2 = LBOUND(y_out%BStCLoadMesh,2),UBOUND(y_out%BStCLoadMesh,2) - DO i1 = LBOUND(y_out%BStCLoadMesh,1),UBOUND(y_out%BStCLoadMesh,1) - CALL MeshExtrapInterp2(y1%BStCLoadMesh(i1,i2), y2%BStCLoadMesh(i1,i2), y3%BStCLoadMesh(i1,i2), tin, y_out%BStCLoadMesh(i1,i2), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO - ENDDO -END IF ! check if allocated -IF (ALLOCATED(y_out%NStCLoadMesh) .AND. ALLOCATED(y1%NStCLoadMesh)) THEN - DO i1 = LBOUND(y_out%NStCLoadMesh,1),UBOUND(y_out%NStCLoadMesh,1) - CALL MeshExtrapInterp2(y1%NStCLoadMesh(i1), y2%NStCLoadMesh(i1), y3%NStCLoadMesh(i1), tin, y_out%NStCLoadMesh(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated -IF (ALLOCATED(y_out%TStCLoadMesh) .AND. ALLOCATED(y1%TStCLoadMesh)) THEN - DO i1 = LBOUND(y_out%TStCLoadMesh,1),UBOUND(y_out%TStCLoadMesh,1) - CALL MeshExtrapInterp2(y1%TStCLoadMesh(i1), y2%TStCLoadMesh(i1), y3%TStCLoadMesh(i1), tin, y_out%TStCLoadMesh(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated -IF (ALLOCATED(y_out%SStCLoadMesh) .AND. ALLOCATED(y1%SStCLoadMesh)) THEN - DO i1 = LBOUND(y_out%SStCLoadMesh,1),UBOUND(y_out%SStCLoadMesh,1) - CALL MeshExtrapInterp2(y1%SStCLoadMesh(i1), y2%SStCLoadMesh(i1), y3%SStCLoadMesh(i1), tin, y_out%SStCLoadMesh(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 - END SUBROUTINE SrvD_Output_ExtrapInterp2 - + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + a3*y3%WriteOutput + 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 + y_out%BlAirfoilCom = a1*y1%BlAirfoilCom + a2*y2%BlAirfoilCom + a3*y3%BlAirfoilCom + END IF ! check if allocated + y_out%YawMom = a1*y1%YawMom + a2*y2%YawMom + a3*y3%YawMom + y_out%YawPosCom = a1*y1%YawPosCom + a2*y2%YawPosCom + a3*y3%YawPosCom + y_out%YawRateCom = a1*y1%YawRateCom + a2*y2%YawRateCom + a3*y3%YawRateCom + y_out%GenTrq = a1*y1%GenTrq + a2*y2%GenTrq + a3*y3%GenTrq + y_out%HSSBrTrqC = a1*y1%HSSBrTrqC + a2*y2%HSSBrTrqC + a3*y3%HSSBrTrqC + y_out%ElecPwr = a1*y1%ElecPwr + a2*y2%ElecPwr + a3*y3%ElecPwr + IF (ALLOCATED(y_out%TBDrCon) .AND. ALLOCATED(y1%TBDrCon)) THEN + y_out%TBDrCon = a1*y1%TBDrCon + a2*y2%TBDrCon + a3*y3%TBDrCon + END IF ! check if allocated + IF (ALLOCATED(y_out%CableDeltaL) .AND. ALLOCATED(y1%CableDeltaL)) THEN + y_out%CableDeltaL = a1*y1%CableDeltaL + a2*y2%CableDeltaL + a3*y3%CableDeltaL + END IF ! check if allocated + IF (ALLOCATED(y_out%CableDeltaLdot) .AND. ALLOCATED(y1%CableDeltaLdot)) THEN + y_out%CableDeltaLdot = a1*y1%CableDeltaLdot + a2*y2%CableDeltaLdot + a3*y3%CableDeltaLdot + END IF ! check if allocated + IF (ALLOCATED(y_out%BStCLoadMesh) .AND. ALLOCATED(y1%BStCLoadMesh)) THEN + do i2 = lbound(y_out%BStCLoadMesh,2),ubound(y_out%BStCLoadMesh,2) + do i1 = lbound(y_out%BStCLoadMesh,1),ubound(y_out%BStCLoadMesh,1) + CALL MeshExtrapInterp2(y1%BStCLoadMesh(i1,i2), y2%BStCLoadMesh(i1,i2), y3%BStCLoadMesh(i1,i2), tin, y_out%BStCLoadMesh(i1,i2), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END DO + END IF ! check if allocated + IF (ALLOCATED(y_out%NStCLoadMesh) .AND. ALLOCATED(y1%NStCLoadMesh)) THEN + do i1 = lbound(y_out%NStCLoadMesh,1),ubound(y_out%NStCLoadMesh,1) + CALL MeshExtrapInterp2(y1%NStCLoadMesh(i1), y2%NStCLoadMesh(i1), y3%NStCLoadMesh(i1), tin, y_out%NStCLoadMesh(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + IF (ALLOCATED(y_out%TStCLoadMesh) .AND. ALLOCATED(y1%TStCLoadMesh)) THEN + do i1 = lbound(y_out%TStCLoadMesh,1),ubound(y_out%TStCLoadMesh,1) + CALL MeshExtrapInterp2(y1%TStCLoadMesh(i1), y2%TStCLoadMesh(i1), y3%TStCLoadMesh(i1), tin, y_out%TStCLoadMesh(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + IF (ALLOCATED(y_out%SStCLoadMesh) .AND. ALLOCATED(y1%SStCLoadMesh)) THEN + do i1 = lbound(y_out%SStCLoadMesh,1),ubound(y_out%SStCLoadMesh,1) + CALL MeshExtrapInterp2(y1%SStCLoadMesh(i1), y2%SStCLoadMesh(i1), y3%SStCLoadMesh(i1), tin, y_out%SStCLoadMesh(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + IF (ALLOCATED(y_out%toSC) .AND. ALLOCATED(y1%toSC)) THEN + y_out%toSC = a1*y1%toSC + a2*y2%toSC + a3*y3%toSC + END IF ! check if allocated +END SUBROUTINE END MODULE ServoDyn_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/servodyn/src/StrucCtrl_Types.f90 b/modules/servodyn/src/StrucCtrl_Types.f90 index 3f5dd2582c..105e73d1ac 100644 --- a/modules/servodyn/src/StrucCtrl_Types.f90 +++ b/modules/servodyn/src/StrucCtrl_Types.f90 @@ -36,68 +36,68 @@ MODULE StrucCtrl_Types ! ========= 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] + LOGICAL :: Echo = .false. !< Echo input file to echo file [-] + INTEGER(IntKi) :: StC_CMODE = 0_IntKi !< control mode {0:none; 1: Semi-Active Control Mode; 2: Active Control Mode;} [-] + INTEGER(IntKi) :: StC_SA_MODE = 0_IntKi !< 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 = 0_IntKi !< 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 = .false. !< DOF on or off [-] + LOGICAL :: StC_Y_DOF = .false. !< DOF on or off [-] + LOGICAL :: StC_Z_DOF = .false. !< DOF on or off [-] + REAL(ReKi) :: StC_X_DSP = 0.0_ReKi !< StC_X initial displacement [m] + REAL(ReKi) :: StC_Y_DSP = 0.0_ReKi !< StC_Y initial displacement [m] + REAL(ReKi) :: StC_Z_DSP = 0.0_ReKi !< StC_Z initial displacement [m] Character(10) :: StC_Z_PreLdC !< StC_Z spring preload [N] - 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 [-] + REAL(ReKi) :: StC_X_M = 0.0_ReKi !< StC X mass [kg] + REAL(ReKi) :: StC_Y_M = 0.0_ReKi !< StC Y mass [kg] + REAL(ReKi) :: StC_Z_M = 0.0_ReKi !< StC Z mass [kg] + REAL(ReKi) :: StC_XY_M = 0.0_ReKi !< StC XY mass [kg] + REAL(ReKi) :: StC_X_K = 0.0_ReKi !< StC X stiffness [N/m] + REAL(ReKi) :: StC_Y_K = 0.0_ReKi !< StC Y stiffness [N/m] + REAL(ReKi) :: StC_Z_K = 0.0_ReKi !< StC Y stiffness [N/m] + REAL(ReKi) :: StC_X_C = 0.0_ReKi !< StC X damping [N/(m/s)] + REAL(ReKi) :: StC_Y_C = 0.0_ReKi !< StC Y damping [N/(m/s)] + REAL(ReKi) :: StC_Z_C = 0.0_ReKi !< StC Z damping [N/(m/s)] + REAL(ReKi) :: StC_X_PSP = 0.0_ReKi !< Positive stop position (maximum X mass displacement) [m] + REAL(ReKi) :: StC_X_NSP = 0.0_ReKi !< Negative stop position (minimum X mass displacement) [m] + REAL(ReKi) :: StC_Y_PSP = 0.0_ReKi !< Positive stop position (maximum Y mass displacement) [m] + REAL(ReKi) :: StC_Y_NSP = 0.0_ReKi !< Negative stop position (minimum Y mass displacement) [m] + REAL(ReKi) :: StC_Z_PSP = 0.0_ReKi !< Positive stop position (maximum Z mass displacement) [m] + REAL(ReKi) :: StC_Z_NSP = 0.0_ReKi !< Negative stop position (minimum Z mass displacement) [m] + REAL(ReKi) :: StC_X_KS = 0.0_ReKi !< Stop spring X stiffness [N/m] + REAL(ReKi) :: StC_X_CS = 0.0_ReKi !< Stop spring X damping [N/(m/s)] + REAL(ReKi) :: StC_Y_KS = 0.0_ReKi !< Stop spring Y stiffness [N/m] + REAL(ReKi) :: StC_Y_CS = 0.0_ReKi !< Stop spring Y damping [N/(m/s)] + REAL(ReKi) :: StC_Z_KS = 0.0_ReKi !< Stop spring Z stiffness [used only when StC_DOF_MODE=1 and StC_Z_DOF=TRUE] [N/m] + REAL(ReKi) :: StC_Z_CS = 0.0_ReKi !< Stop spring Z damping [used only when StC_DOF_MODE=1 and StC_Z_DOF=TRUE] [N/(m/s)] + REAL(ReKi) :: StC_P_X = 0.0_ReKi !< StC X initial displacement (m) [relative to at rest position] [m] + REAL(ReKi) :: StC_P_Y = 0.0_ReKi !< StC Y initial displacement (m) [relative to at rest position] [m] + REAL(ReKi) :: StC_P_Z = 0.0_ReKi !< 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 = 0.0_ReKi !< StC X high damping for ground hook control [N/(m/s)] + REAL(ReKi) :: StC_X_C_LOW = 0.0_ReKi !< StC X low damping for ground hook control [N/(m/s)] + REAL(ReKi) :: StC_Y_C_HIGH = 0.0_ReKi !< StC Y high damping for ground hook control [N/(m/s)] + REAL(ReKi) :: StC_Y_C_LOW = 0.0_ReKi !< StC Y low damping for ground hook control [N/(m/s)] + REAL(ReKi) :: StC_Z_C_HIGH = 0.0_ReKi !< StC Z high damping for ground hook control [N/(m/s)] + REAL(ReKi) :: StC_Z_C_LOW = 0.0_ReKi !< StC Z low damping for ground hook control [N/(m/s)] + REAL(ReKi) :: StC_X_C_BRAKE = 0.0_ReKi !< StC X high damping for braking the StC [N/(m/s)] + REAL(ReKi) :: StC_Y_C_BRAKE = 0.0_ReKi !< StC Y high damping for braking the StC [N/(m/s)] + REAL(ReKi) :: StC_Z_C_BRAKE = 0.0_ReKi !< StC Z high damping for braking the StC [N/(m/s)] + REAL(ReKi) :: L_X = 0.0_ReKi !< X TLCD total length [m] + REAL(ReKi) :: B_X = 0.0_ReKi !< X TLCD horizontal length [m] + REAL(ReKi) :: area_X = 0.0_ReKi !< X TLCD cross-sectional area of vertical column [m^2] + REAL(ReKi) :: area_ratio_X = 0.0_ReKi !< X TLCD cross-sectional area ratio (vertical column area divided by horizontal column area) [-] + REAL(ReKi) :: headLossCoeff_X = 0.0_ReKi !< X TLCD head loss coeff [-] + REAL(ReKi) :: rho_X = 0.0_ReKi !< X TLCD liquid density [kg/m^3] + REAL(ReKi) :: L_Y = 0.0_ReKi !< Y TLCD total length [m] + REAL(ReKi) :: B_Y = 0.0_ReKi !< Y TLCD horizontal length [m] + REAL(ReKi) :: area_Y = 0.0_ReKi !< Side-Side TLCD cross-sectional area of vertical column [m] + REAL(ReKi) :: area_ratio_Y = 0.0_ReKi !< Side-Side TLCD cross-sectional area ratio (vertical column area divided by horizontal column area) [-] + REAL(ReKi) :: headLossCoeff_Y = 0.0_ReKi !< Side-Side TLCD head loss coeff [-] + REAL(ReKi) :: rho_Y = 0.0_ReKi !< Side-Side TLCD liquid density [kg/m^3] + LOGICAL :: USE_F_TBL = .false. !< use spring force from user-defined table (flag) [-] + INTEGER(IntKi) :: NKInpSt = 0_IntKi !< 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} [-] + INTEGER(IntKi) :: PrescribedForcesCoordSys = 0_IntKi !< 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)] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: StC_CChan !< StC control chan to use -- one per instance [-] @@ -107,8 +107,8 @@ MODULE StrucCtrl_Types 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(1:3) :: Gravity = 0.0_ReKi !< Gravitational acceleration vector [m/s^2] + INTEGER(IntKi) :: NumMeshPts = 0_IntKi !< Number of mesh points [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: InitRefPos !< X-Y-Z reference position of point: i.e. each blade root (3 x NumBlades) [m] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: InitTransDisp !< X-Y-Z displacement from position of point at init: i.e. each blade root (3 x NumBlades) [m] REAL(R8Ki) , DIMENSION(:,:,:), ALLOCATABLE :: InitOrient !< DCM orientation of point at init: i.e. each blade root (3x3 x NumBlades) [-] @@ -142,17 +142,17 @@ MODULE StrucCtrl_Types ! ======================= ! ========= StC_DiscreteStateType ======= TYPE, PUBLIC :: StC_DiscreteStateType - REAL(ReKi) :: DummyDiscState !< Remove this variable if you have discrete states [-] + REAL(ReKi) :: DummyDiscState = 0.0_ReKi !< 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 [-] + REAL(ReKi) :: DummyConstrState = 0.0_ReKi !< 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 [-] + REAL(ReKi) :: DummyOtherState = 0.0_ReKi !< Remove this variable if you have other/logical states [-] END TYPE StC_OtherStateType ! ======================= ! ========= StC_MiscVarType ======= @@ -174,60 +174,60 @@ MODULE StrucCtrl_Types 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 [-] + INTEGER(IntKi) :: PrescribedInterpIdx = 0_IntKi !< 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] + REAL(DbKi) :: DT = 0.0_R8Ki !< 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) :: StC_Z_PreLd !< StC_Z spring preload [N] - 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; 4: Active Control Mode through Simulink (not available); 5: Active Control Mode through Bladed interface} [-] - 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) [-] + INTEGER(IntKi) :: StC_DOF_MODE = 0_IntKi !< 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 = .false. !< DOF on or off [-] + LOGICAL :: StC_Y_DOF = .false. !< DOF on or off [-] + LOGICAL :: StC_Z_DOF = .false. !< DOF on or off [-] + REAL(ReKi) :: StC_Z_PreLd = 0.0_ReKi !< StC_Z spring preload [N] + REAL(ReKi) :: M_X = 0.0_ReKi !< StC mass [kg] + REAL(ReKi) :: M_Y = 0.0_ReKi !< StC mass [kg] + REAL(ReKi) :: M_Z = 0.0_ReKi !< StC mass [kg] + REAL(ReKi) :: M_XY = 0.0_ReKi !< StCXY mass [kg] + REAL(ReKi) :: K_X = 0.0_ReKi !< StC stiffness [N/m] + REAL(ReKi) :: K_Y = 0.0_ReKi !< StC stiffness [N/m] + REAL(ReKi) :: K_Z = 0.0_ReKi !< StC stiffness [N/m] + REAL(ReKi) :: C_X = 0.0_ReKi !< StC damping [N/(m/s)] + REAL(ReKi) :: C_Y = 0.0_ReKi !< StC damping [N/(m/s)] + REAL(ReKi) :: C_Z = 0.0_ReKi !< StC damping [N/(m/s)] + REAL(ReKi) , DIMENSION(1:3) :: K_S = 0.0_ReKi !< StC stop stiffness [N/m] + REAL(ReKi) , DIMENSION(1:3) :: C_S = 0.0_ReKi !< StC stop damping [N/(m/s)] + REAL(ReKi) , DIMENSION(1:3) :: P_SP = 0.0_ReKi !< Positive stop position (maximum mass displacement) [m] + REAL(ReKi) , DIMENSION(1:3) :: N_SP = 0.0_ReKi !< Negative stop position (minimum X mass displacement) [m] + REAL(ReKi) , DIMENSION(1:3) :: Gravity = 0.0_ReKi !< Gravitational acceleration vector [m/s^2] + INTEGER(IntKi) :: StC_CMODE = 0_IntKi !< control mode {0:none; 1: Semi-Active Control Mode; 4: Active Control Mode through Simulink (not available); 5: Active Control Mode through Bladed interface} [-] + INTEGER(IntKi) :: StC_SA_MODE = 0_IntKi !< 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 = 0.0_ReKi !< StC X high damping for ground hook control [N/(m/s)] + REAL(ReKi) :: StC_X_C_LOW = 0.0_ReKi !< StC X low damping for ground hook control [N/(m/s)] + REAL(ReKi) :: StC_Y_C_HIGH = 0.0_ReKi !< StC Y high damping for ground hook control [N/(m/s)] + REAL(ReKi) :: StC_Y_C_LOW = 0.0_ReKi !< StC Y low damping for ground hook control [N/(m/s)] + REAL(ReKi) :: StC_Z_C_HIGH = 0.0_ReKi !< StC Z high damping for ground hook control [N/(m/s)] + REAL(ReKi) :: StC_Z_C_LOW = 0.0_ReKi !< StC Z low damping for ground hook control [N/(m/s)] + REAL(ReKi) :: StC_X_C_BRAKE = 0.0_ReKi !< StC X high damping for braking the StC [N/(m/s)] + REAL(ReKi) :: StC_Y_C_BRAKE = 0.0_ReKi !< StC Y high damping for braking the StC [N/(m/s)] + REAL(ReKi) :: StC_Z_C_BRAKE = 0.0_ReKi !< StC Y high damping for braking the StC [N/(m/s)] + REAL(ReKi) :: L_X = 0.0_ReKi !< X TLCD total length [m] + REAL(ReKi) :: B_X = 0.0_ReKi !< X TLCD horizontal length [m] + REAL(ReKi) :: area_X = 0.0_ReKi !< X TLCD cross-sectional area of vertical column [m^2] + REAL(ReKi) :: area_ratio_X = 0.0_ReKi !< X TLCD cross-sectional area ratio (vertical column area divided by horizontal column area) [-] + REAL(ReKi) :: headLossCoeff_X = 0.0_ReKi !< X TLCD head loss coeff [-] + REAL(ReKi) :: rho_X = 0.0_ReKi !< X TLCD liquid density [kg/m^3] + REAL(ReKi) :: L_Y = 0.0_ReKi !< Y TLCD total length [m] + REAL(ReKi) :: B_Y = 0.0_ReKi !< Y TLCD horizontal length [m] + REAL(ReKi) :: area_Y = 0.0_ReKi !< Side-Side TLCD cross-sectional area of vertical column [m] + REAL(ReKi) :: area_ratio_Y = 0.0_ReKi !< Side-Side TLCD cross-sectional area ratio (vertical column area divided by horizontal column area) [-] + REAL(ReKi) :: headLossCoeff_Y = 0.0_ReKi !< Side-Side TLCD head loss coeff [-] + REAL(ReKi) :: rho_Y = 0.0_ReKi !< Side-Side TLCD liquid density [kg/m^3] + LOGICAL :: Use_F_TBL = .false. !< 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} [-] + INTEGER(IntKi) :: NumMeshPts = 0_IntKi !< Number of mesh points [-] + INTEGER(IntKi) :: PrescribedForcesCoordSys = 0_IntKi !< Prescribed forces coordinate system {0: global; 1: local} [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: StC_PrescribedForce !< StC prescribed force time-series info [(s,N,N-m)] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: StC_CChan !< StC control chan to use [-] END TYPE StC_ParameterType @@ -249,5652 +249,1731 @@ MODULE StrucCtrl_Types 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_Z_PreLdC = SrcInputFileData%StC_Z_PreLdC - 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 -IF (ALLOCATED(SrcInputFileData%StC_CChan)) THEN - i1_l = LBOUND(SrcInputFileData%StC_CChan,1) - i1_u = UBOUND(SrcInputFileData%StC_CChan,1) - IF (.NOT. ALLOCATED(DstInputFileData%StC_CChan)) THEN - ALLOCATE(DstInputFileData%StC_CChan(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%StC_CChan.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%StC_CChan = SrcInputFileData%StC_CChan -ENDIF - END SUBROUTINE StC_CopyInputFile - - SUBROUTINE StC_DestroyInputFile( InputFileData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(StC_InputFile), INTENT(INOUT) :: InputFileData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'StC_DestroyInputFile' - - ErrStat = ErrID_None - ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(InputFileData%F_TBL)) THEN - DEALLOCATE(InputFileData%F_TBL) -ENDIF -IF (ALLOCATED(InputFileData%StC_PrescribedForce)) THEN - DEALLOCATE(InputFileData%StC_PrescribedForce) -ENDIF -IF (ALLOCATED(InputFileData%StC_CChan)) THEN - DEALLOCATE(InputFileData%StC_CChan) -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 - Int_BufSz = Int_BufSz + 1*LEN(InData%StC_Z_PreLdC) ! StC_Z_PreLdC - 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 - Int_BufSz = Int_BufSz + 1 ! StC_CChan allocated yes/no - IF ( ALLOCATED(InData%StC_CChan) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! StC_CChan upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%StC_CChan) ! StC_CChan - 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 - DO I = 1, LEN(InData%StC_Z_PreLdC) - IntKiBuf(Int_Xferred) = ICHAR(InData%StC_Z_PreLdC(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - 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 - IF ( .NOT. ALLOCATED(InData%StC_CChan) ) THEN - 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_CChan,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StC_CChan,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%StC_CChan,1), UBOUND(InData%StC_CChan,1) - IntKiBuf(Int_Xferred) = InData%StC_CChan(i1) - Int_Xferred = Int_Xferred + 1 - 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 - DO I = 1, LEN(OutData%StC_Z_PreLdC) - OutData%StC_Z_PreLdC(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - 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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StC_CChan not allocated - Int_Xferred = Int_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%StC_CChan)) DEALLOCATE(OutData%StC_CChan) - ALLOCATE(OutData%StC_CChan(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StC_CChan.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%StC_CChan,1), UBOUND(OutData%StC_CChan,1) - OutData%StC_CChan(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - 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' -! +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 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'StC_CopyInputFile' ErrStat = ErrID_None - ErrMsg = "" - DstInitInputData%InputFile = SrcInitInputData%InputFile - DstInitInputData%RootName = SrcInitInputData%RootName - DstInitInputData%Gravity = SrcInitInputData%Gravity - DstInitInputData%NumMeshPts = SrcInitInputData%NumMeshPts -IF (ALLOCATED(SrcInitInputData%InitRefPos)) THEN - i1_l = LBOUND(SrcInitInputData%InitRefPos,1) - i1_u = UBOUND(SrcInitInputData%InitRefPos,1) - i2_l = LBOUND(SrcInitInputData%InitRefPos,2) - i2_u = UBOUND(SrcInitInputData%InitRefPos,2) - IF (.NOT. ALLOCATED(DstInitInputData%InitRefPos)) THEN - ALLOCATE(DstInitInputData%InitRefPos(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%InitRefPos.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%InitRefPos = SrcInitInputData%InitRefPos -ENDIF -IF (ALLOCATED(SrcInitInputData%InitTransDisp)) THEN - i1_l = LBOUND(SrcInitInputData%InitTransDisp,1) - i1_u = UBOUND(SrcInitInputData%InitTransDisp,1) - i2_l = LBOUND(SrcInitInputData%InitTransDisp,2) - i2_u = UBOUND(SrcInitInputData%InitTransDisp,2) - IF (.NOT. ALLOCATED(DstInitInputData%InitTransDisp)) THEN - ALLOCATE(DstInitInputData%InitTransDisp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%InitTransDisp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%InitTransDisp = SrcInitInputData%InitTransDisp -ENDIF -IF (ALLOCATED(SrcInitInputData%InitOrient)) THEN - i1_l = LBOUND(SrcInitInputData%InitOrient,1) - i1_u = UBOUND(SrcInitInputData%InitOrient,1) - i2_l = LBOUND(SrcInitInputData%InitOrient,2) - i2_u = UBOUND(SrcInitInputData%InitOrient,2) - i3_l = LBOUND(SrcInitInputData%InitOrient,3) - i3_u = UBOUND(SrcInitInputData%InitOrient,3) - IF (.NOT. ALLOCATED(DstInitInputData%InitOrient)) THEN - ALLOCATE(DstInitInputData%InitOrient(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%InitOrient.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%InitOrient = SrcInitInputData%InitOrient -ENDIF -IF (ALLOCATED(SrcInitInputData%InitRefOrient)) THEN - i1_l = LBOUND(SrcInitInputData%InitRefOrient,1) - i1_u = UBOUND(SrcInitInputData%InitRefOrient,1) - i2_l = LBOUND(SrcInitInputData%InitRefOrient,2) - i2_u = UBOUND(SrcInitInputData%InitRefOrient,2) - i3_l = LBOUND(SrcInitInputData%InitRefOrient,3) - i3_u = UBOUND(SrcInitInputData%InitRefOrient,3) - IF (.NOT. ALLOCATED(DstInitInputData%InitRefOrient)) THEN - ALLOCATE(DstInitInputData%InitRefOrient(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%InitRefOrient.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%InitRefOrient = SrcInitInputData%InitRefOrient -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, DEALLOCATEpointers ) - TYPE(StC_InitInputType), INTENT(INOUT) :: InitInputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'StC_DestroyInitInput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(InitInputData%InitRefPos)) THEN - DEALLOCATE(InitInputData%InitRefPos) -ENDIF -IF (ALLOCATED(InitInputData%InitTransDisp)) THEN - DEALLOCATE(InitInputData%InitTransDisp) -ENDIF -IF (ALLOCATED(InitInputData%InitOrient)) THEN - DEALLOCATE(InitInputData%InitOrient) -ENDIF -IF (ALLOCATED(InitInputData%InitRefOrient)) THEN - DEALLOCATE(InitInputData%InitRefOrient) -ENDIF - CALL NWTC_Library_Destroyfileinfotype( InitInputData%PassedPrimaryInputData, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL NWTC_Library_Destroyfileinfotype( InitInputData%PassedPrescribeFrcData, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - 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 ! InitRefPos allocated yes/no - IF ( ALLOCATED(InData%InitRefPos) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! InitRefPos upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%InitRefPos) ! InitRefPos - END IF - Int_BufSz = Int_BufSz + 1 ! InitTransDisp allocated yes/no - IF ( ALLOCATED(InData%InitTransDisp) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! InitTransDisp upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%InitTransDisp) ! InitTransDisp - END IF - Int_BufSz = Int_BufSz + 1 ! InitOrient allocated yes/no - IF ( ALLOCATED(InData%InitOrient) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! InitOrient upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%InitOrient) ! InitOrient - END IF - Int_BufSz = Int_BufSz + 1 ! InitRefOrient allocated yes/no - IF ( ALLOCATED(InData%InitRefOrient) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! InitRefOrient upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%InitRefOrient) ! InitRefOrient - 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%InitRefPos) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InitRefPos,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InitRefPos,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InitRefPos,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InitRefPos,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%InitRefPos,2), UBOUND(InData%InitRefPos,2) - DO i1 = LBOUND(InData%InitRefPos,1), UBOUND(InData%InitRefPos,1) - ReKiBuf(Re_Xferred) = InData%InitRefPos(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%InitTransDisp) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InitTransDisp,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InitTransDisp,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InitTransDisp,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InitTransDisp,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%InitTransDisp,2), UBOUND(InData%InitTransDisp,2) - DO i1 = LBOUND(InData%InitTransDisp,1), UBOUND(InData%InitTransDisp,1) - DbKiBuf(Db_Xferred) = InData%InitTransDisp(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%InitOrient) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InitOrient,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InitOrient,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InitOrient,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InitOrient,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InitOrient,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InitOrient,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%InitOrient,3), UBOUND(InData%InitOrient,3) - DO i2 = LBOUND(InData%InitOrient,2), UBOUND(InData%InitOrient,2) - DO i1 = LBOUND(InData%InitOrient,1), UBOUND(InData%InitOrient,1) - DbKiBuf(Db_Xferred) = InData%InitOrient(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%InitRefOrient) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InitRefOrient,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InitRefOrient,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InitRefOrient,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InitRefOrient,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InitRefOrient,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InitRefOrient,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%InitRefOrient,3), UBOUND(InData%InitRefOrient,3) - DO i2 = LBOUND(InData%InitRefOrient,2), UBOUND(InData%InitRefOrient,2) - DO i1 = LBOUND(InData%InitRefOrient,1), UBOUND(InData%InitRefOrient,1) - DbKiBuf(Db_Xferred) = InData%InitRefOrient(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 ! InitRefPos not allocated - Int_Xferred = Int_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%InitRefPos)) DEALLOCATE(OutData%InitRefPos) - ALLOCATE(OutData%InitRefPos(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InitRefPos.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%InitRefPos,2), UBOUND(OutData%InitRefPos,2) - DO i1 = LBOUND(OutData%InitRefPos,1), UBOUND(OutData%InitRefPos,1) - OutData%InitRefPos(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InitTransDisp not allocated - Int_Xferred = Int_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%InitTransDisp)) DEALLOCATE(OutData%InitTransDisp) - ALLOCATE(OutData%InitTransDisp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InitTransDisp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%InitTransDisp,2), UBOUND(OutData%InitTransDisp,2) - DO i1 = LBOUND(OutData%InitTransDisp,1), UBOUND(OutData%InitTransDisp,1) - OutData%InitTransDisp(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InitOrient not allocated - Int_Xferred = Int_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%InitOrient)) DEALLOCATE(OutData%InitOrient) - ALLOCATE(OutData%InitOrient(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%InitOrient.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%InitOrient,3), UBOUND(OutData%InitOrient,3) - DO i2 = LBOUND(OutData%InitOrient,2), UBOUND(OutData%InitOrient,2) - DO i1 = LBOUND(OutData%InitOrient,1), UBOUND(OutData%InitOrient,1) - OutData%InitOrient(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InitRefOrient not allocated - Int_Xferred = Int_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%InitRefOrient)) DEALLOCATE(OutData%InitRefOrient) - ALLOCATE(OutData%InitRefOrient(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%InitRefOrient.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%InitRefOrient,3), UBOUND(OutData%InitRefOrient,3) - DO i2 = LBOUND(OutData%InitRefOrient,2), UBOUND(OutData%InitRefOrient,2) - DO i1 = LBOUND(OutData%InitRefOrient,1), UBOUND(OutData%InitRefOrient,1) - OutData%InitRefOrient(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_CopyCtrlChanInitInfoType( SrcCtrlChanInitInfoTypeData, DstCtrlChanInitInfoTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(StC_CtrlChanInitInfoType), INTENT(IN) :: SrcCtrlChanInitInfoTypeData - TYPE(StC_CtrlChanInitInfoType), INTENT(INOUT) :: DstCtrlChanInitInfoTypeData - 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_CopyCtrlChanInitInfoType' -! + 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_Z_PreLdC = SrcInputFileData%StC_Z_PreLdC + 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 + LB(1:2) = lbound(SrcInputFileData%F_TBL) + UB(1:2) = ubound(SrcInputFileData%F_TBL) + if (.not. allocated(DstInputFileData%F_TBL)) then + allocate(DstInputFileData%F_TBL(LB(1):UB(1),LB(2):UB(2)), 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 + end if + DstInputFileData%PrescribedForcesCoordSys = SrcInputFileData%PrescribedForcesCoordSys + DstInputFileData%PrescribedForcesFile = SrcInputFileData%PrescribedForcesFile + if (allocated(SrcInputFileData%StC_PrescribedForce)) then + LB(1:2) = lbound(SrcInputFileData%StC_PrescribedForce) + UB(1:2) = ubound(SrcInputFileData%StC_PrescribedForce) + if (.not. allocated(DstInputFileData%StC_PrescribedForce)) then + allocate(DstInputFileData%StC_PrescribedForce(LB(1):UB(1),LB(2):UB(2)), 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 + end if + if (allocated(SrcInputFileData%StC_CChan)) then + LB(1:1) = lbound(SrcInputFileData%StC_CChan) + UB(1:1) = ubound(SrcInputFileData%StC_CChan) + if (.not. allocated(DstInputFileData%StC_CChan)) then + allocate(DstInputFileData%StC_CChan(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%StC_CChan.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%StC_CChan = SrcInputFileData%StC_CChan + end if +end subroutine + +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' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcCtrlChanInitInfoTypeData%Requestor)) THEN - i1_l = LBOUND(SrcCtrlChanInitInfoTypeData%Requestor,1) - i1_u = UBOUND(SrcCtrlChanInitInfoTypeData%Requestor,1) - IF (.NOT. ALLOCATED(DstCtrlChanInitInfoTypeData%Requestor)) THEN - ALLOCATE(DstCtrlChanInitInfoTypeData%Requestor(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstCtrlChanInitInfoTypeData%Requestor.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstCtrlChanInitInfoTypeData%Requestor = SrcCtrlChanInitInfoTypeData%Requestor -ENDIF -IF (ALLOCATED(SrcCtrlChanInitInfoTypeData%InitStiff)) THEN - i1_l = LBOUND(SrcCtrlChanInitInfoTypeData%InitStiff,1) - i1_u = UBOUND(SrcCtrlChanInitInfoTypeData%InitStiff,1) - i2_l = LBOUND(SrcCtrlChanInitInfoTypeData%InitStiff,2) - i2_u = UBOUND(SrcCtrlChanInitInfoTypeData%InitStiff,2) - IF (.NOT. ALLOCATED(DstCtrlChanInitInfoTypeData%InitStiff)) THEN - ALLOCATE(DstCtrlChanInitInfoTypeData%InitStiff(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstCtrlChanInitInfoTypeData%InitStiff.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstCtrlChanInitInfoTypeData%InitStiff = SrcCtrlChanInitInfoTypeData%InitStiff -ENDIF -IF (ALLOCATED(SrcCtrlChanInitInfoTypeData%InitDamp)) THEN - i1_l = LBOUND(SrcCtrlChanInitInfoTypeData%InitDamp,1) - i1_u = UBOUND(SrcCtrlChanInitInfoTypeData%InitDamp,1) - i2_l = LBOUND(SrcCtrlChanInitInfoTypeData%InitDamp,2) - i2_u = UBOUND(SrcCtrlChanInitInfoTypeData%InitDamp,2) - IF (.NOT. ALLOCATED(DstCtrlChanInitInfoTypeData%InitDamp)) THEN - ALLOCATE(DstCtrlChanInitInfoTypeData%InitDamp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstCtrlChanInitInfoTypeData%InitDamp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstCtrlChanInitInfoTypeData%InitDamp = SrcCtrlChanInitInfoTypeData%InitDamp -ENDIF -IF (ALLOCATED(SrcCtrlChanInitInfoTypeData%InitBrake)) THEN - i1_l = LBOUND(SrcCtrlChanInitInfoTypeData%InitBrake,1) - i1_u = UBOUND(SrcCtrlChanInitInfoTypeData%InitBrake,1) - i2_l = LBOUND(SrcCtrlChanInitInfoTypeData%InitBrake,2) - i2_u = UBOUND(SrcCtrlChanInitInfoTypeData%InitBrake,2) - IF (.NOT. ALLOCATED(DstCtrlChanInitInfoTypeData%InitBrake)) THEN - ALLOCATE(DstCtrlChanInitInfoTypeData%InitBrake(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstCtrlChanInitInfoTypeData%InitBrake.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstCtrlChanInitInfoTypeData%InitBrake = SrcCtrlChanInitInfoTypeData%InitBrake -ENDIF -IF (ALLOCATED(SrcCtrlChanInitInfoTypeData%InitForce)) THEN - i1_l = LBOUND(SrcCtrlChanInitInfoTypeData%InitForce,1) - i1_u = UBOUND(SrcCtrlChanInitInfoTypeData%InitForce,1) - i2_l = LBOUND(SrcCtrlChanInitInfoTypeData%InitForce,2) - i2_u = UBOUND(SrcCtrlChanInitInfoTypeData%InitForce,2) - IF (.NOT. ALLOCATED(DstCtrlChanInitInfoTypeData%InitForce)) THEN - ALLOCATE(DstCtrlChanInitInfoTypeData%InitForce(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstCtrlChanInitInfoTypeData%InitForce.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstCtrlChanInitInfoTypeData%InitForce = SrcCtrlChanInitInfoTypeData%InitForce -ENDIF -IF (ALLOCATED(SrcCtrlChanInitInfoTypeData%InitMeasDisp)) THEN - i1_l = LBOUND(SrcCtrlChanInitInfoTypeData%InitMeasDisp,1) - i1_u = UBOUND(SrcCtrlChanInitInfoTypeData%InitMeasDisp,1) - i2_l = LBOUND(SrcCtrlChanInitInfoTypeData%InitMeasDisp,2) - i2_u = UBOUND(SrcCtrlChanInitInfoTypeData%InitMeasDisp,2) - IF (.NOT. ALLOCATED(DstCtrlChanInitInfoTypeData%InitMeasDisp)) THEN - ALLOCATE(DstCtrlChanInitInfoTypeData%InitMeasDisp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstCtrlChanInitInfoTypeData%InitMeasDisp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstCtrlChanInitInfoTypeData%InitMeasDisp = SrcCtrlChanInitInfoTypeData%InitMeasDisp -ENDIF -IF (ALLOCATED(SrcCtrlChanInitInfoTypeData%InitMeasVel)) THEN - i1_l = LBOUND(SrcCtrlChanInitInfoTypeData%InitMeasVel,1) - i1_u = UBOUND(SrcCtrlChanInitInfoTypeData%InitMeasVel,1) - i2_l = LBOUND(SrcCtrlChanInitInfoTypeData%InitMeasVel,2) - i2_u = UBOUND(SrcCtrlChanInitInfoTypeData%InitMeasVel,2) - IF (.NOT. ALLOCATED(DstCtrlChanInitInfoTypeData%InitMeasVel)) THEN - ALLOCATE(DstCtrlChanInitInfoTypeData%InitMeasVel(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstCtrlChanInitInfoTypeData%InitMeasVel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstCtrlChanInitInfoTypeData%InitMeasVel = SrcCtrlChanInitInfoTypeData%InitMeasVel -ENDIF - END SUBROUTINE StC_CopyCtrlChanInitInfoType - - SUBROUTINE StC_DestroyCtrlChanInitInfoType( CtrlChanInitInfoTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(StC_CtrlChanInitInfoType), INTENT(INOUT) :: CtrlChanInitInfoTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'StC_DestroyCtrlChanInitInfoType' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(CtrlChanInitInfoTypeData%Requestor)) THEN - DEALLOCATE(CtrlChanInitInfoTypeData%Requestor) -ENDIF -IF (ALLOCATED(CtrlChanInitInfoTypeData%InitStiff)) THEN - DEALLOCATE(CtrlChanInitInfoTypeData%InitStiff) -ENDIF -IF (ALLOCATED(CtrlChanInitInfoTypeData%InitDamp)) THEN - DEALLOCATE(CtrlChanInitInfoTypeData%InitDamp) -ENDIF -IF (ALLOCATED(CtrlChanInitInfoTypeData%InitBrake)) THEN - DEALLOCATE(CtrlChanInitInfoTypeData%InitBrake) -ENDIF -IF (ALLOCATED(CtrlChanInitInfoTypeData%InitForce)) THEN - DEALLOCATE(CtrlChanInitInfoTypeData%InitForce) -ENDIF -IF (ALLOCATED(CtrlChanInitInfoTypeData%InitMeasDisp)) THEN - DEALLOCATE(CtrlChanInitInfoTypeData%InitMeasDisp) -ENDIF -IF (ALLOCATED(CtrlChanInitInfoTypeData%InitMeasVel)) THEN - DEALLOCATE(CtrlChanInitInfoTypeData%InitMeasVel) -ENDIF - END SUBROUTINE StC_DestroyCtrlChanInitInfoType - - SUBROUTINE StC_PackCtrlChanInitInfoType( 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_CtrlChanInitInfoType), 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_PackCtrlChanInitInfoType' - ! 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 ! Requestor allocated yes/no - IF ( ALLOCATED(InData%Requestor) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Requestor upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Requestor)*LEN(InData%Requestor) ! Requestor - END IF - Int_BufSz = Int_BufSz + 1 ! InitStiff allocated yes/no - IF ( ALLOCATED(InData%InitStiff) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! InitStiff upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%InitStiff) ! InitStiff - END IF - Int_BufSz = Int_BufSz + 1 ! InitDamp allocated yes/no - IF ( ALLOCATED(InData%InitDamp) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! InitDamp upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%InitDamp) ! InitDamp - END IF - Int_BufSz = Int_BufSz + 1 ! InitBrake allocated yes/no - IF ( ALLOCATED(InData%InitBrake) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! InitBrake upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%InitBrake) ! InitBrake - END IF - Int_BufSz = Int_BufSz + 1 ! InitForce allocated yes/no - IF ( ALLOCATED(InData%InitForce) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! InitForce upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%InitForce) ! InitForce - END IF - Int_BufSz = Int_BufSz + 1 ! InitMeasDisp allocated yes/no - IF ( ALLOCATED(InData%InitMeasDisp) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! InitMeasDisp upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%InitMeasDisp) ! InitMeasDisp - END IF - Int_BufSz = Int_BufSz + 1 ! InitMeasVel allocated yes/no - IF ( ALLOCATED(InData%InitMeasVel) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! InitMeasVel upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%InitMeasVel) ! InitMeasVel - 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%Requestor) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Requestor,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Requestor,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Requestor,1), UBOUND(InData%Requestor,1) - DO I = 1, LEN(InData%Requestor) - IntKiBuf(Int_Xferred) = ICHAR(InData%Requestor(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%InitStiff) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InitStiff,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InitStiff,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InitStiff,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InitStiff,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%InitStiff,2), UBOUND(InData%InitStiff,2) - DO i1 = LBOUND(InData%InitStiff,1), UBOUND(InData%InitStiff,1) - ReKiBuf(Re_Xferred) = InData%InitStiff(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%InitDamp) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InitDamp,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InitDamp,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InitDamp,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InitDamp,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%InitDamp,2), UBOUND(InData%InitDamp,2) - DO i1 = LBOUND(InData%InitDamp,1), UBOUND(InData%InitDamp,1) - ReKiBuf(Re_Xferred) = InData%InitDamp(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%InitBrake) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InitBrake,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InitBrake,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InitBrake,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InitBrake,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%InitBrake,2), UBOUND(InData%InitBrake,2) - DO i1 = LBOUND(InData%InitBrake,1), UBOUND(InData%InitBrake,1) - ReKiBuf(Re_Xferred) = InData%InitBrake(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%InitForce) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InitForce,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InitForce,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InitForce,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InitForce,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%InitForce,2), UBOUND(InData%InitForce,2) - DO i1 = LBOUND(InData%InitForce,1), UBOUND(InData%InitForce,1) - ReKiBuf(Re_Xferred) = InData%InitForce(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%InitMeasDisp) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InitMeasDisp,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InitMeasDisp,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InitMeasDisp,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InitMeasDisp,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%InitMeasDisp,2), UBOUND(InData%InitMeasDisp,2) - DO i1 = LBOUND(InData%InitMeasDisp,1), UBOUND(InData%InitMeasDisp,1) - ReKiBuf(Re_Xferred) = InData%InitMeasDisp(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%InitMeasVel) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InitMeasVel,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InitMeasVel,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InitMeasVel,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InitMeasVel,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%InitMeasVel,2), UBOUND(InData%InitMeasVel,2) - DO i1 = LBOUND(InData%InitMeasVel,1), UBOUND(InData%InitMeasVel,1) - ReKiBuf(Re_Xferred) = InData%InitMeasVel(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE StC_PackCtrlChanInitInfoType - - SUBROUTINE StC_UnPackCtrlChanInitInfoType( 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_CtrlChanInitInfoType), 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_UnPackCtrlChanInitInfoType' - ! 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 ! Requestor not allocated - Int_Xferred = Int_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%Requestor)) DEALLOCATE(OutData%Requestor) - ALLOCATE(OutData%Requestor(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Requestor.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Requestor,1), UBOUND(OutData%Requestor,1) - DO I = 1, LEN(OutData%Requestor) - OutData%Requestor(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 ! InitStiff not allocated - Int_Xferred = Int_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%InitStiff)) DEALLOCATE(OutData%InitStiff) - ALLOCATE(OutData%InitStiff(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InitStiff.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%InitStiff,2), UBOUND(OutData%InitStiff,2) - DO i1 = LBOUND(OutData%InitStiff,1), UBOUND(OutData%InitStiff,1) - OutData%InitStiff(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InitDamp not allocated - Int_Xferred = Int_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%InitDamp)) DEALLOCATE(OutData%InitDamp) - ALLOCATE(OutData%InitDamp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InitDamp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%InitDamp,2), UBOUND(OutData%InitDamp,2) - DO i1 = LBOUND(OutData%InitDamp,1), UBOUND(OutData%InitDamp,1) - OutData%InitDamp(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InitBrake not allocated - Int_Xferred = Int_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%InitBrake)) DEALLOCATE(OutData%InitBrake) - ALLOCATE(OutData%InitBrake(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InitBrake.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%InitBrake,2), UBOUND(OutData%InitBrake,2) - DO i1 = LBOUND(OutData%InitBrake,1), UBOUND(OutData%InitBrake,1) - OutData%InitBrake(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InitForce not allocated - Int_Xferred = Int_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%InitForce)) DEALLOCATE(OutData%InitForce) - ALLOCATE(OutData%InitForce(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InitForce.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%InitForce,2), UBOUND(OutData%InitForce,2) - DO i1 = LBOUND(OutData%InitForce,1), UBOUND(OutData%InitForce,1) - OutData%InitForce(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InitMeasDisp not allocated - Int_Xferred = Int_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%InitMeasDisp)) DEALLOCATE(OutData%InitMeasDisp) - ALLOCATE(OutData%InitMeasDisp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InitMeasDisp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%InitMeasDisp,2), UBOUND(OutData%InitMeasDisp,2) - DO i1 = LBOUND(OutData%InitMeasDisp,1), UBOUND(OutData%InitMeasDisp,1) - OutData%InitMeasDisp(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InitMeasVel not allocated - Int_Xferred = Int_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%InitMeasVel)) DEALLOCATE(OutData%InitMeasVel) - ALLOCATE(OutData%InitMeasVel(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InitMeasVel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%InitMeasVel,2), UBOUND(OutData%InitMeasVel,2) - DO i1 = LBOUND(OutData%InitMeasVel,1), UBOUND(OutData%InitMeasVel,1) - OutData%InitMeasVel(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE StC_UnPackCtrlChanInitInfoType - - 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) :: 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_CopyInitOutput' -! + ErrMsg = '' + if (allocated(InputFileData%F_TBL)) then + deallocate(InputFileData%F_TBL) + end if + if (allocated(InputFileData%StC_PrescribedForce)) then + deallocate(InputFileData%StC_PrescribedForce) + end if + if (allocated(InputFileData%StC_CChan)) then + deallocate(InputFileData%StC_CChan) + end if +end subroutine + +subroutine StC_PackInputFile(RF, Indata) + type(RegFile), intent(inout) :: RF + type(StC_InputFile), intent(in) :: InData + character(*), parameter :: RoutineName = 'StC_PackInputFile' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%StCFileName) + call RegPack(RF, InData%Echo) + call RegPack(RF, InData%StC_CMODE) + call RegPack(RF, InData%StC_SA_MODE) + call RegPack(RF, InData%StC_DOF_MODE) + call RegPack(RF, InData%StC_X_DOF) + call RegPack(RF, InData%StC_Y_DOF) + call RegPack(RF, InData%StC_Z_DOF) + call RegPack(RF, InData%StC_X_DSP) + call RegPack(RF, InData%StC_Y_DSP) + call RegPack(RF, InData%StC_Z_DSP) + call RegPack(RF, InData%StC_Z_PreLdC) + call RegPack(RF, InData%StC_X_M) + call RegPack(RF, InData%StC_Y_M) + call RegPack(RF, InData%StC_Z_M) + call RegPack(RF, InData%StC_XY_M) + call RegPack(RF, InData%StC_X_K) + call RegPack(RF, InData%StC_Y_K) + call RegPack(RF, InData%StC_Z_K) + call RegPack(RF, InData%StC_X_C) + call RegPack(RF, InData%StC_Y_C) + call RegPack(RF, InData%StC_Z_C) + call RegPack(RF, InData%StC_X_PSP) + call RegPack(RF, InData%StC_X_NSP) + call RegPack(RF, InData%StC_Y_PSP) + call RegPack(RF, InData%StC_Y_NSP) + call RegPack(RF, InData%StC_Z_PSP) + call RegPack(RF, InData%StC_Z_NSP) + call RegPack(RF, InData%StC_X_KS) + call RegPack(RF, InData%StC_X_CS) + call RegPack(RF, InData%StC_Y_KS) + call RegPack(RF, InData%StC_Y_CS) + call RegPack(RF, InData%StC_Z_KS) + call RegPack(RF, InData%StC_Z_CS) + call RegPack(RF, InData%StC_P_X) + call RegPack(RF, InData%StC_P_Y) + call RegPack(RF, InData%StC_P_Z) + call RegPack(RF, InData%StC_X_C_HIGH) + call RegPack(RF, InData%StC_X_C_LOW) + call RegPack(RF, InData%StC_Y_C_HIGH) + call RegPack(RF, InData%StC_Y_C_LOW) + call RegPack(RF, InData%StC_Z_C_HIGH) + call RegPack(RF, InData%StC_Z_C_LOW) + call RegPack(RF, InData%StC_X_C_BRAKE) + call RegPack(RF, InData%StC_Y_C_BRAKE) + call RegPack(RF, InData%StC_Z_C_BRAKE) + call RegPack(RF, InData%L_X) + call RegPack(RF, InData%B_X) + call RegPack(RF, InData%area_X) + call RegPack(RF, InData%area_ratio_X) + call RegPack(RF, InData%headLossCoeff_X) + call RegPack(RF, InData%rho_X) + call RegPack(RF, InData%L_Y) + call RegPack(RF, InData%B_Y) + call RegPack(RF, InData%area_Y) + call RegPack(RF, InData%area_ratio_Y) + call RegPack(RF, InData%headLossCoeff_Y) + call RegPack(RF, InData%rho_Y) + call RegPack(RF, InData%USE_F_TBL) + call RegPack(RF, InData%NKInpSt) + call RegPack(RF, InData%StC_F_TBL_FILE) + call RegPackAlloc(RF, InData%F_TBL) + call RegPack(RF, InData%PrescribedForcesCoordSys) + call RegPack(RF, InData%PrescribedForcesFile) + call RegPackAlloc(RF, InData%StC_PrescribedForce) + call RegPackAlloc(RF, InData%StC_CChan) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine StC_UnPackInputFile(RF, OutData) + type(RegFile), intent(inout) :: RF + type(StC_InputFile), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'StC_UnPackInputFile' + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%StCFileName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Echo); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_CMODE); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_SA_MODE); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_DOF_MODE); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_X_DOF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_Y_DOF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_Z_DOF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_X_DSP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_Y_DSP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_Z_DSP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_Z_PreLdC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_X_M); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_Y_M); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_Z_M); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_XY_M); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_X_K); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_Y_K); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_Z_K); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_X_C); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_Y_C); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_Z_C); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_X_PSP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_X_NSP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_Y_PSP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_Y_NSP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_Z_PSP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_Z_NSP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_X_KS); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_X_CS); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_Y_KS); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_Y_CS); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_Z_KS); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_Z_CS); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_P_X); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_P_Y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_P_Z); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_X_C_HIGH); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_X_C_LOW); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_Y_C_HIGH); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_Y_C_LOW); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_Z_C_HIGH); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_Z_C_LOW); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_X_C_BRAKE); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_Y_C_BRAKE); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_Z_C_BRAKE); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%L_X); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%B_X); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%area_X); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%area_ratio_X); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%headLossCoeff_X); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rho_X); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%L_Y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%B_Y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%area_Y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%area_ratio_Y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%headLossCoeff_Y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rho_Y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%USE_F_TBL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NKInpSt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_F_TBL_FILE); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%F_TBL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PrescribedForcesCoordSys); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PrescribedForcesFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%StC_PrescribedForce); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%StC_CChan); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +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 + integer(B4Ki) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'StC_CopyInitInput' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcInitOutputData%RelPosition)) THEN - i1_l = LBOUND(SrcInitOutputData%RelPosition,1) - i1_u = UBOUND(SrcInitOutputData%RelPosition,1) - i2_l = LBOUND(SrcInitOutputData%RelPosition,2) - i2_u = UBOUND(SrcInitOutputData%RelPosition,2) - IF (.NOT. ALLOCATED(DstInitOutputData%RelPosition)) THEN - ALLOCATE(DstInitOutputData%RelPosition(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%RelPosition.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%RelPosition = SrcInitOutputData%RelPosition -ENDIF - END SUBROUTINE StC_CopyInitOutput - - SUBROUTINE StC_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(StC_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'StC_DestroyInitOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(InitOutputData%RelPosition)) THEN - DEALLOCATE(InitOutputData%RelPosition) -ENDIF - 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 - Int_BufSz = Int_BufSz + 1 ! RelPosition allocated yes/no - IF ( ALLOCATED(InData%RelPosition) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! RelPosition upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%RelPosition) ! RelPosition - 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%RelPosition) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RelPosition,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RelPosition,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RelPosition,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RelPosition,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%RelPosition,2), UBOUND(InData%RelPosition,2) - DO i1 = LBOUND(InData%RelPosition,1), UBOUND(InData%RelPosition,1) - ReKiBuf(Re_Xferred) = InData%RelPosition(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - 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) :: 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_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 ! RelPosition not allocated - Int_Xferred = Int_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%RelPosition)) DEALLOCATE(OutData%RelPosition) - ALLOCATE(OutData%RelPosition(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RelPosition.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%RelPosition,2), UBOUND(OutData%RelPosition,2) - DO i1 = LBOUND(OutData%RelPosition,1), UBOUND(OutData%RelPosition,1) - OutData%RelPosition(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - 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' -! + ErrMsg = '' + DstInitInputData%InputFile = SrcInitInputData%InputFile + DstInitInputData%RootName = SrcInitInputData%RootName + DstInitInputData%Gravity = SrcInitInputData%Gravity + DstInitInputData%NumMeshPts = SrcInitInputData%NumMeshPts + if (allocated(SrcInitInputData%InitRefPos)) then + LB(1:2) = lbound(SrcInitInputData%InitRefPos) + UB(1:2) = ubound(SrcInitInputData%InitRefPos) + if (.not. allocated(DstInitInputData%InitRefPos)) then + allocate(DstInitInputData%InitRefPos(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%InitRefPos.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%InitRefPos = SrcInitInputData%InitRefPos + end if + if (allocated(SrcInitInputData%InitTransDisp)) then + LB(1:2) = lbound(SrcInitInputData%InitTransDisp) + UB(1:2) = ubound(SrcInitInputData%InitTransDisp) + if (.not. allocated(DstInitInputData%InitTransDisp)) then + allocate(DstInitInputData%InitTransDisp(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%InitTransDisp.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%InitTransDisp = SrcInitInputData%InitTransDisp + end if + if (allocated(SrcInitInputData%InitOrient)) then + LB(1:3) = lbound(SrcInitInputData%InitOrient) + UB(1:3) = ubound(SrcInitInputData%InitOrient) + if (.not. allocated(DstInitInputData%InitOrient)) then + allocate(DstInitInputData%InitOrient(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%InitOrient.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%InitOrient = SrcInitInputData%InitOrient + end if + if (allocated(SrcInitInputData%InitRefOrient)) then + LB(1:3) = lbound(SrcInitInputData%InitRefOrient) + UB(1:3) = ubound(SrcInitInputData%InitRefOrient) + if (.not. allocated(DstInitInputData%InitRefOrient)) then + allocate(DstInitInputData%InitRefOrient(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%InitRefOrient.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%InitRefOrient = SrcInitInputData%InitRefOrient + end if + 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 + +subroutine StC_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(StC_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'StC_DestroyInitInput' ErrStat = ErrID_None - ErrMsg = "" -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 - END SUBROUTINE StC_CopyContState - - SUBROUTINE StC_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(StC_ContinuousStateType), INTENT(INOUT) :: ContStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'StC_DestroyContState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(ContStateData%StC_x)) THEN - DEALLOCATE(ContStateData%StC_x) -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 - 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 - 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%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 - 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 - 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 - 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' -! + ErrMsg = '' + if (allocated(InitInputData%InitRefPos)) then + deallocate(InitInputData%InitRefPos) + end if + if (allocated(InitInputData%InitTransDisp)) then + deallocate(InitInputData%InitTransDisp) + end if + if (allocated(InitInputData%InitOrient)) then + deallocate(InitInputData%InitOrient) + end if + if (allocated(InitInputData%InitRefOrient)) then + deallocate(InitInputData%InitRefOrient) + end if + call NWTC_Library_DestroyFileInfoType(InitInputData%PassedPrimaryInputData, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call NWTC_Library_DestroyFileInfoType(InitInputData%PassedPrescribeFrcData, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine StC_PackInitInput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(StC_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'StC_PackInitInput' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%InputFile) + call RegPack(RF, InData%RootName) + call RegPack(RF, InData%Gravity) + call RegPack(RF, InData%NumMeshPts) + call RegPackAlloc(RF, InData%InitRefPos) + call RegPackAlloc(RF, InData%InitTransDisp) + call RegPackAlloc(RF, InData%InitOrient) + call RegPackAlloc(RF, InData%InitRefOrient) + call RegPack(RF, InData%UseInputFile) + call NWTC_Library_PackFileInfoType(RF, InData%PassedPrimaryInputData) + call RegPack(RF, InData%UseInputFile_PrescribeFrc) + call NWTC_Library_PackFileInfoType(RF, InData%PassedPrescribeFrcData) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine StC_UnPackInitInput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(StC_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'StC_UnPackInitInput' + integer(B4Ki) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%InputFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RootName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Gravity); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumMeshPts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%InitRefPos); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%InitTransDisp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%InitOrient); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%InitRefOrient); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UseInputFile); if (RegCheckErr(RF, RoutineName)) return + call NWTC_Library_UnpackFileInfoType(RF, OutData%PassedPrimaryInputData) ! PassedPrimaryInputData + call RegUnpack(RF, OutData%UseInputFile_PrescribeFrc); if (RegCheckErr(RF, RoutineName)) return + call NWTC_Library_UnpackFileInfoType(RF, OutData%PassedPrescribeFrcData) ! PassedPrescribeFrcData +end subroutine + +subroutine StC_CopyCtrlChanInitInfoType(SrcCtrlChanInitInfoTypeData, DstCtrlChanInitInfoTypeData, CtrlCode, ErrStat, ErrMsg) + type(StC_CtrlChanInitInfoType), intent(in) :: SrcCtrlChanInitInfoTypeData + type(StC_CtrlChanInitInfoType), intent(inout) :: DstCtrlChanInitInfoTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'StC_CopyCtrlChanInitInfoType' ErrStat = ErrID_None - ErrMsg = "" - DstDiscStateData%DummyDiscState = SrcDiscStateData%DummyDiscState - END SUBROUTINE StC_CopyDiscState - - SUBROUTINE StC_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(StC_DiscreteStateType), INTENT(INOUT) :: DiscStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'StC_DestroyDiscState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - 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' -! + ErrMsg = '' + if (allocated(SrcCtrlChanInitInfoTypeData%Requestor)) then + LB(1:1) = lbound(SrcCtrlChanInitInfoTypeData%Requestor) + UB(1:1) = ubound(SrcCtrlChanInitInfoTypeData%Requestor) + if (.not. allocated(DstCtrlChanInitInfoTypeData%Requestor)) then + allocate(DstCtrlChanInitInfoTypeData%Requestor(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstCtrlChanInitInfoTypeData%Requestor.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstCtrlChanInitInfoTypeData%Requestor = SrcCtrlChanInitInfoTypeData%Requestor + end if + if (allocated(SrcCtrlChanInitInfoTypeData%InitStiff)) then + LB(1:2) = lbound(SrcCtrlChanInitInfoTypeData%InitStiff) + UB(1:2) = ubound(SrcCtrlChanInitInfoTypeData%InitStiff) + if (.not. allocated(DstCtrlChanInitInfoTypeData%InitStiff)) then + allocate(DstCtrlChanInitInfoTypeData%InitStiff(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstCtrlChanInitInfoTypeData%InitStiff.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstCtrlChanInitInfoTypeData%InitStiff = SrcCtrlChanInitInfoTypeData%InitStiff + end if + if (allocated(SrcCtrlChanInitInfoTypeData%InitDamp)) then + LB(1:2) = lbound(SrcCtrlChanInitInfoTypeData%InitDamp) + UB(1:2) = ubound(SrcCtrlChanInitInfoTypeData%InitDamp) + if (.not. allocated(DstCtrlChanInitInfoTypeData%InitDamp)) then + allocate(DstCtrlChanInitInfoTypeData%InitDamp(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstCtrlChanInitInfoTypeData%InitDamp.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstCtrlChanInitInfoTypeData%InitDamp = SrcCtrlChanInitInfoTypeData%InitDamp + end if + if (allocated(SrcCtrlChanInitInfoTypeData%InitBrake)) then + LB(1:2) = lbound(SrcCtrlChanInitInfoTypeData%InitBrake) + UB(1:2) = ubound(SrcCtrlChanInitInfoTypeData%InitBrake) + if (.not. allocated(DstCtrlChanInitInfoTypeData%InitBrake)) then + allocate(DstCtrlChanInitInfoTypeData%InitBrake(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstCtrlChanInitInfoTypeData%InitBrake.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstCtrlChanInitInfoTypeData%InitBrake = SrcCtrlChanInitInfoTypeData%InitBrake + end if + if (allocated(SrcCtrlChanInitInfoTypeData%InitForce)) then + LB(1:2) = lbound(SrcCtrlChanInitInfoTypeData%InitForce) + UB(1:2) = ubound(SrcCtrlChanInitInfoTypeData%InitForce) + if (.not. allocated(DstCtrlChanInitInfoTypeData%InitForce)) then + allocate(DstCtrlChanInitInfoTypeData%InitForce(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstCtrlChanInitInfoTypeData%InitForce.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstCtrlChanInitInfoTypeData%InitForce = SrcCtrlChanInitInfoTypeData%InitForce + end if + if (allocated(SrcCtrlChanInitInfoTypeData%InitMeasDisp)) then + LB(1:2) = lbound(SrcCtrlChanInitInfoTypeData%InitMeasDisp) + UB(1:2) = ubound(SrcCtrlChanInitInfoTypeData%InitMeasDisp) + if (.not. allocated(DstCtrlChanInitInfoTypeData%InitMeasDisp)) then + allocate(DstCtrlChanInitInfoTypeData%InitMeasDisp(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstCtrlChanInitInfoTypeData%InitMeasDisp.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstCtrlChanInitInfoTypeData%InitMeasDisp = SrcCtrlChanInitInfoTypeData%InitMeasDisp + end if + if (allocated(SrcCtrlChanInitInfoTypeData%InitMeasVel)) then + LB(1:2) = lbound(SrcCtrlChanInitInfoTypeData%InitMeasVel) + UB(1:2) = ubound(SrcCtrlChanInitInfoTypeData%InitMeasVel) + if (.not. allocated(DstCtrlChanInitInfoTypeData%InitMeasVel)) then + allocate(DstCtrlChanInitInfoTypeData%InitMeasVel(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstCtrlChanInitInfoTypeData%InitMeasVel.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstCtrlChanInitInfoTypeData%InitMeasVel = SrcCtrlChanInitInfoTypeData%InitMeasVel + end if +end subroutine + +subroutine StC_DestroyCtrlChanInitInfoType(CtrlChanInitInfoTypeData, ErrStat, ErrMsg) + type(StC_CtrlChanInitInfoType), intent(inout) :: CtrlChanInitInfoTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'StC_DestroyCtrlChanInitInfoType' ErrStat = ErrID_None - ErrMsg = "" - DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState - END SUBROUTINE StC_CopyConstrState - - SUBROUTINE StC_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(StC_ConstraintStateType), INTENT(INOUT) :: ConstrStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'StC_DestroyConstrState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - 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' -! + ErrMsg = '' + if (allocated(CtrlChanInitInfoTypeData%Requestor)) then + deallocate(CtrlChanInitInfoTypeData%Requestor) + end if + if (allocated(CtrlChanInitInfoTypeData%InitStiff)) then + deallocate(CtrlChanInitInfoTypeData%InitStiff) + end if + if (allocated(CtrlChanInitInfoTypeData%InitDamp)) then + deallocate(CtrlChanInitInfoTypeData%InitDamp) + end if + if (allocated(CtrlChanInitInfoTypeData%InitBrake)) then + deallocate(CtrlChanInitInfoTypeData%InitBrake) + end if + if (allocated(CtrlChanInitInfoTypeData%InitForce)) then + deallocate(CtrlChanInitInfoTypeData%InitForce) + end if + if (allocated(CtrlChanInitInfoTypeData%InitMeasDisp)) then + deallocate(CtrlChanInitInfoTypeData%InitMeasDisp) + end if + if (allocated(CtrlChanInitInfoTypeData%InitMeasVel)) then + deallocate(CtrlChanInitInfoTypeData%InitMeasVel) + end if +end subroutine + +subroutine StC_PackCtrlChanInitInfoType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(StC_CtrlChanInitInfoType), intent(in) :: InData + character(*), parameter :: RoutineName = 'StC_PackCtrlChanInitInfoType' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%Requestor) + call RegPackAlloc(RF, InData%InitStiff) + call RegPackAlloc(RF, InData%InitDamp) + call RegPackAlloc(RF, InData%InitBrake) + call RegPackAlloc(RF, InData%InitForce) + call RegPackAlloc(RF, InData%InitMeasDisp) + call RegPackAlloc(RF, InData%InitMeasVel) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine StC_UnPackCtrlChanInitInfoType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(StC_CtrlChanInitInfoType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'StC_UnPackCtrlChanInitInfoType' + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%Requestor); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%InitStiff); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%InitDamp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%InitBrake); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%InitForce); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%InitMeasDisp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%InitMeasVel); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +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 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'StC_CopyInitOutput' ErrStat = ErrID_None - ErrMsg = "" - DstOtherStateData%DummyOtherState = SrcOtherStateData%DummyOtherState - END SUBROUTINE StC_CopyOtherState - - SUBROUTINE StC_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(StC_OtherStateType), INTENT(INOUT) :: OtherStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'StC_DestroyOtherState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - 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' -! + ErrMsg = '' + if (allocated(SrcInitOutputData%RelPosition)) then + LB(1:2) = lbound(SrcInitOutputData%RelPosition) + UB(1:2) = ubound(SrcInitOutputData%RelPosition) + if (.not. allocated(DstInitOutputData%RelPosition)) then + allocate(DstInitOutputData%RelPosition(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%RelPosition.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%RelPosition = SrcInitOutputData%RelPosition + end if +end subroutine + +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' 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%K)) THEN - i1_l = LBOUND(SrcMiscData%K,1) - i1_u = UBOUND(SrcMiscData%K,1) - i2_l = LBOUND(SrcMiscData%K,2) - i2_u = UBOUND(SrcMiscData%K,2) - IF (.NOT. ALLOCATED(DstMiscData%K)) THEN - ALLOCATE(DstMiscData%K(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%K.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%K = SrcMiscData%K -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, DEALLOCATEpointers ) - TYPE(StC_MiscVarType), INTENT(INOUT) :: MiscData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'StC_DestroyMisc' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -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%K)) THEN - DEALLOCATE(MiscData%K) -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 ! K allocated yes/no - IF ( ALLOCATED(InData%K) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! K upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%K) ! K - 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%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) - ReKiBuf(Re_Xferred) = InData%K(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 ! 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) = 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' -! + ErrMsg = '' + if (allocated(InitOutputData%RelPosition)) then + deallocate(InitOutputData%RelPosition) + end if +end subroutine + +subroutine StC_PackInitOutput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(StC_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'StC_PackInitOutput' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%RelPosition) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine StC_UnPackInitOutput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(StC_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'StC_UnPackInitOutput' + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%RelPosition); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +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 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'StC_CopyContState' 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%StC_Z_PreLd = SrcParamData%StC_Z_PreLd - 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 -IF (ALLOCATED(SrcParamData%StC_CChan)) THEN - i1_l = LBOUND(SrcParamData%StC_CChan,1) - i1_u = UBOUND(SrcParamData%StC_CChan,1) - IF (.NOT. ALLOCATED(DstParamData%StC_CChan)) THEN - ALLOCATE(DstParamData%StC_CChan(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%StC_CChan.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%StC_CChan = SrcParamData%StC_CChan -ENDIF - END SUBROUTINE StC_CopyParam - - SUBROUTINE StC_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(StC_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'StC_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(ParamData%F_TBL)) THEN - DEALLOCATE(ParamData%F_TBL) -ENDIF -IF (ALLOCATED(ParamData%StC_PrescribedForce)) THEN - DEALLOCATE(ParamData%StC_PrescribedForce) -ENDIF -IF (ALLOCATED(ParamData%StC_CChan)) THEN - DEALLOCATE(ParamData%StC_CChan) -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 ! StC_Z_PreLd - 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 - Int_BufSz = Int_BufSz + 1 ! StC_CChan allocated yes/no - IF ( ALLOCATED(InData%StC_CChan) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! StC_CChan upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%StC_CChan) ! StC_CChan - 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%StC_Z_PreLd - Re_Xferred = Re_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 - IF ( .NOT. ALLOCATED(InData%StC_CChan) ) THEN - 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_CChan,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StC_CChan,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%StC_CChan,1), UBOUND(InData%StC_CChan,1) - IntKiBuf(Int_Xferred) = InData%StC_CChan(i1) - Int_Xferred = Int_Xferred + 1 - 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%StC_Z_PreLd = ReKiBuf(Re_Xferred) - Re_Xferred = Re_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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StC_CChan not allocated - Int_Xferred = Int_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%StC_CChan)) DEALLOCATE(OutData%StC_CChan) - ALLOCATE(OutData%StC_CChan(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StC_CChan.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%StC_CChan,1), UBOUND(OutData%StC_CChan,1) - OutData%StC_CChan(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - 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) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'StC_CopyInput' -! + ErrMsg = '' + if (allocated(SrcContStateData%StC_x)) then + LB(1:2) = lbound(SrcContStateData%StC_x) + UB(1:2) = ubound(SrcContStateData%StC_x) + if (.not. allocated(DstContStateData%StC_x)) then + allocate(DstContStateData%StC_x(LB(1):UB(1),LB(2):UB(2)), 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 + end if +end subroutine + +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' 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 -IF (ALLOCATED(SrcInputData%CmdStiff)) THEN - i1_l = LBOUND(SrcInputData%CmdStiff,1) - i1_u = UBOUND(SrcInputData%CmdStiff,1) - i2_l = LBOUND(SrcInputData%CmdStiff,2) - i2_u = UBOUND(SrcInputData%CmdStiff,2) - IF (.NOT. ALLOCATED(DstInputData%CmdStiff)) THEN - ALLOCATE(DstInputData%CmdStiff(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%CmdStiff.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%CmdStiff = SrcInputData%CmdStiff -ENDIF -IF (ALLOCATED(SrcInputData%CmdDamp)) THEN - i1_l = LBOUND(SrcInputData%CmdDamp,1) - i1_u = UBOUND(SrcInputData%CmdDamp,1) - i2_l = LBOUND(SrcInputData%CmdDamp,2) - i2_u = UBOUND(SrcInputData%CmdDamp,2) - IF (.NOT. ALLOCATED(DstInputData%CmdDamp)) THEN - ALLOCATE(DstInputData%CmdDamp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%CmdDamp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%CmdDamp = SrcInputData%CmdDamp -ENDIF -IF (ALLOCATED(SrcInputData%CmdBrake)) THEN - i1_l = LBOUND(SrcInputData%CmdBrake,1) - i1_u = UBOUND(SrcInputData%CmdBrake,1) - i2_l = LBOUND(SrcInputData%CmdBrake,2) - i2_u = UBOUND(SrcInputData%CmdBrake,2) - IF (.NOT. ALLOCATED(DstInputData%CmdBrake)) THEN - ALLOCATE(DstInputData%CmdBrake(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%CmdBrake.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%CmdBrake = SrcInputData%CmdBrake -ENDIF -IF (ALLOCATED(SrcInputData%CmdForce)) THEN - i1_l = LBOUND(SrcInputData%CmdForce,1) - i1_u = UBOUND(SrcInputData%CmdForce,1) - i2_l = LBOUND(SrcInputData%CmdForce,2) - i2_u = UBOUND(SrcInputData%CmdForce,2) - IF (.NOT. ALLOCATED(DstInputData%CmdForce)) THEN - ALLOCATE(DstInputData%CmdForce(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%CmdForce.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%CmdForce = SrcInputData%CmdForce -ENDIF - END SUBROUTINE StC_CopyInput - - SUBROUTINE StC_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(StC_InputType), INTENT(INOUT) :: InputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'StC_DestroyInput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(InputData%Mesh)) THEN -DO i1 = LBOUND(InputData%Mesh,1), UBOUND(InputData%Mesh,1) - CALL MeshDestroy( InputData%Mesh(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(InputData%Mesh) -ENDIF -IF (ALLOCATED(InputData%CmdStiff)) THEN - DEALLOCATE(InputData%CmdStiff) -ENDIF -IF (ALLOCATED(InputData%CmdDamp)) THEN - DEALLOCATE(InputData%CmdDamp) -ENDIF -IF (ALLOCATED(InputData%CmdBrake)) THEN - DEALLOCATE(InputData%CmdBrake) -ENDIF -IF (ALLOCATED(InputData%CmdForce)) THEN - DEALLOCATE(InputData%CmdForce) -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 - Int_BufSz = Int_BufSz + 1 ! CmdStiff allocated yes/no - IF ( ALLOCATED(InData%CmdStiff) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! CmdStiff upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CmdStiff) ! CmdStiff - END IF - Int_BufSz = Int_BufSz + 1 ! CmdDamp allocated yes/no - IF ( ALLOCATED(InData%CmdDamp) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! CmdDamp upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CmdDamp) ! CmdDamp - END IF - Int_BufSz = Int_BufSz + 1 ! CmdBrake allocated yes/no - IF ( ALLOCATED(InData%CmdBrake) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! CmdBrake upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CmdBrake) ! CmdBrake - END IF - Int_BufSz = Int_BufSz + 1 ! CmdForce allocated yes/no - IF ( ALLOCATED(InData%CmdForce) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! CmdForce upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CmdForce) ! CmdForce - 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 - IF ( .NOT. ALLOCATED(InData%CmdStiff) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CmdStiff,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CmdStiff,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CmdStiff,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CmdStiff,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%CmdStiff,2), UBOUND(InData%CmdStiff,2) - DO i1 = LBOUND(InData%CmdStiff,1), UBOUND(InData%CmdStiff,1) - ReKiBuf(Re_Xferred) = InData%CmdStiff(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CmdDamp) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CmdDamp,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CmdDamp,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CmdDamp,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CmdDamp,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%CmdDamp,2), UBOUND(InData%CmdDamp,2) - DO i1 = LBOUND(InData%CmdDamp,1), UBOUND(InData%CmdDamp,1) - ReKiBuf(Re_Xferred) = InData%CmdDamp(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CmdBrake) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CmdBrake,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CmdBrake,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CmdBrake,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CmdBrake,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%CmdBrake,2), UBOUND(InData%CmdBrake,2) - DO i1 = LBOUND(InData%CmdBrake,1), UBOUND(InData%CmdBrake,1) - ReKiBuf(Re_Xferred) = InData%CmdBrake(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CmdForce) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CmdForce,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CmdForce,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CmdForce,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CmdForce,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%CmdForce,2), UBOUND(InData%CmdForce,2) - DO i1 = LBOUND(InData%CmdForce,1), UBOUND(InData%CmdForce,1) - ReKiBuf(Re_Xferred) = InData%CmdForce(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - 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) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - 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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CmdStiff not allocated - Int_Xferred = Int_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%CmdStiff)) DEALLOCATE(OutData%CmdStiff) - ALLOCATE(OutData%CmdStiff(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CmdStiff.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%CmdStiff,2), UBOUND(OutData%CmdStiff,2) - DO i1 = LBOUND(OutData%CmdStiff,1), UBOUND(OutData%CmdStiff,1) - OutData%CmdStiff(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CmdDamp not allocated - Int_Xferred = Int_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%CmdDamp)) DEALLOCATE(OutData%CmdDamp) - ALLOCATE(OutData%CmdDamp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CmdDamp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%CmdDamp,2), UBOUND(OutData%CmdDamp,2) - DO i1 = LBOUND(OutData%CmdDamp,1), UBOUND(OutData%CmdDamp,1) - OutData%CmdDamp(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CmdBrake not allocated - Int_Xferred = Int_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%CmdBrake)) DEALLOCATE(OutData%CmdBrake) - ALLOCATE(OutData%CmdBrake(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CmdBrake.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%CmdBrake,2), UBOUND(OutData%CmdBrake,2) - DO i1 = LBOUND(OutData%CmdBrake,1), UBOUND(OutData%CmdBrake,1) - OutData%CmdBrake(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CmdForce not allocated - Int_Xferred = Int_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%CmdForce)) DEALLOCATE(OutData%CmdForce) - ALLOCATE(OutData%CmdForce(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CmdForce.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%CmdForce,2), UBOUND(OutData%CmdForce,2) - DO i1 = LBOUND(OutData%CmdForce,1), UBOUND(OutData%CmdForce,1) - OutData%CmdForce(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - 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) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'StC_CopyOutput' -! + ErrMsg = '' + if (allocated(ContStateData%StC_x)) then + deallocate(ContStateData%StC_x) + end if +end subroutine + +subroutine StC_PackContState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(StC_ContinuousStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'StC_PackContState' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%StC_x) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine StC_UnPackContState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(StC_ContinuousStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'StC_UnPackContState' + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%StC_x); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +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 + character(*), parameter :: RoutineName = 'StC_CopyDiscState' 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 -IF (ALLOCATED(SrcOutputData%MeasDisp)) THEN - i1_l = LBOUND(SrcOutputData%MeasDisp,1) - i1_u = UBOUND(SrcOutputData%MeasDisp,1) - i2_l = LBOUND(SrcOutputData%MeasDisp,2) - i2_u = UBOUND(SrcOutputData%MeasDisp,2) - IF (.NOT. ALLOCATED(DstOutputData%MeasDisp)) THEN - ALLOCATE(DstOutputData%MeasDisp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%MeasDisp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%MeasDisp = SrcOutputData%MeasDisp -ENDIF -IF (ALLOCATED(SrcOutputData%MeasVel)) THEN - i1_l = LBOUND(SrcOutputData%MeasVel,1) - i1_u = UBOUND(SrcOutputData%MeasVel,1) - i2_l = LBOUND(SrcOutputData%MeasVel,2) - i2_u = UBOUND(SrcOutputData%MeasVel,2) - IF (.NOT. ALLOCATED(DstOutputData%MeasVel)) THEN - ALLOCATE(DstOutputData%MeasVel(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%MeasVel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%MeasVel = SrcOutputData%MeasVel -ENDIF - END SUBROUTINE StC_CopyOutput - - SUBROUTINE StC_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(StC_OutputType), INTENT(INOUT) :: OutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'StC_DestroyOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(OutputData%Mesh)) THEN -DO i1 = LBOUND(OutputData%Mesh,1), UBOUND(OutputData%Mesh,1) - CALL MeshDestroy( OutputData%Mesh(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(OutputData%Mesh) -ENDIF -IF (ALLOCATED(OutputData%MeasDisp)) THEN - DEALLOCATE(OutputData%MeasDisp) -ENDIF -IF (ALLOCATED(OutputData%MeasVel)) THEN - DEALLOCATE(OutputData%MeasVel) -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 - Int_BufSz = Int_BufSz + 1 ! MeasDisp allocated yes/no - IF ( ALLOCATED(InData%MeasDisp) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! MeasDisp upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%MeasDisp) ! MeasDisp - END IF - Int_BufSz = Int_BufSz + 1 ! MeasVel allocated yes/no - IF ( ALLOCATED(InData%MeasVel) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! MeasVel upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%MeasVel) ! MeasVel - 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 - IF ( .NOT. ALLOCATED(InData%MeasDisp) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MeasDisp,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MeasDisp,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MeasDisp,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MeasDisp,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%MeasDisp,2), UBOUND(InData%MeasDisp,2) - DO i1 = LBOUND(InData%MeasDisp,1), UBOUND(InData%MeasDisp,1) - ReKiBuf(Re_Xferred) = InData%MeasDisp(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%MeasVel) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MeasVel,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MeasVel,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MeasVel,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MeasVel,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%MeasVel,2), UBOUND(InData%MeasVel,2) - DO i1 = LBOUND(InData%MeasVel,1), UBOUND(InData%MeasVel,1) - ReKiBuf(Re_Xferred) = InData%MeasVel(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - 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) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - 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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MeasDisp not allocated - Int_Xferred = Int_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%MeasDisp)) DEALLOCATE(OutData%MeasDisp) - ALLOCATE(OutData%MeasDisp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MeasDisp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%MeasDisp,2), UBOUND(OutData%MeasDisp,2) - DO i1 = LBOUND(OutData%MeasDisp,1), UBOUND(OutData%MeasDisp,1) - OutData%MeasDisp(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MeasVel not allocated - Int_Xferred = Int_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%MeasVel)) DEALLOCATE(OutData%MeasVel) - ALLOCATE(OutData%MeasVel(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MeasVel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%MeasVel,2), UBOUND(OutData%MeasVel,2) - DO i1 = LBOUND(OutData%MeasVel,1), UBOUND(OutData%MeasVel,1) - OutData%MeasVel(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - 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 + ErrMsg = '' + DstDiscStateData%DummyDiscState = SrcDiscStateData%DummyDiscState +end subroutine + +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' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine StC_PackDiscState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(StC_DiscreteStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'StC_PackDiscState' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyDiscState) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine StC_UnPackDiscState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(StC_DiscreteStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'StC_UnPackDiscState' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyDiscState); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +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 + character(*), parameter :: RoutineName = 'StC_CopyConstrState' + ErrStat = ErrID_None + ErrMsg = '' + DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState +end subroutine + +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' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine StC_PackConstrState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(StC_ConstraintStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'StC_PackConstrState' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyConstrState) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine StC_UnPackConstrState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(StC_ConstraintStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'StC_UnPackConstrState' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyConstrState); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +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 + character(*), parameter :: RoutineName = 'StC_CopyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + DstOtherStateData%DummyOtherState = SrcOtherStateData%DummyOtherState +end subroutine + +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' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine StC_PackOtherState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(StC_OtherStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'StC_PackOtherState' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyOtherState) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine StC_UnPackOtherState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(StC_OtherStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'StC_UnPackOtherState' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyOtherState); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +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 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'StC_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcMiscData%F_stop)) then + LB(1:2) = lbound(SrcMiscData%F_stop) + UB(1:2) = ubound(SrcMiscData%F_stop) + if (.not. allocated(DstMiscData%F_stop)) then + allocate(DstMiscData%F_stop(LB(1):UB(1),LB(2):UB(2)), 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 + end if + if (allocated(SrcMiscData%F_ext)) then + LB(1:2) = lbound(SrcMiscData%F_ext) + UB(1:2) = ubound(SrcMiscData%F_ext) + if (.not. allocated(DstMiscData%F_ext)) then + allocate(DstMiscData%F_ext(LB(1):UB(1),LB(2):UB(2)), 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 + end if + if (allocated(SrcMiscData%F_fr)) then + LB(1:2) = lbound(SrcMiscData%F_fr) + UB(1:2) = ubound(SrcMiscData%F_fr) + if (.not. allocated(DstMiscData%F_fr)) then + allocate(DstMiscData%F_fr(LB(1):UB(1),LB(2):UB(2)), 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 + end if + if (allocated(SrcMiscData%K)) then + LB(1:2) = lbound(SrcMiscData%K) + UB(1:2) = ubound(SrcMiscData%K) + if (.not. allocated(DstMiscData%K)) then + allocate(DstMiscData%K(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%K.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%K = SrcMiscData%K + end if + if (allocated(SrcMiscData%C_ctrl)) then + LB(1:2) = lbound(SrcMiscData%C_ctrl) + UB(1:2) = ubound(SrcMiscData%C_ctrl) + if (.not. allocated(DstMiscData%C_ctrl)) then + allocate(DstMiscData%C_ctrl(LB(1):UB(1),LB(2):UB(2)), 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 + end if + if (allocated(SrcMiscData%C_Brake)) then + LB(1:2) = lbound(SrcMiscData%C_Brake) + UB(1:2) = ubound(SrcMiscData%C_Brake) + if (.not. allocated(DstMiscData%C_Brake)) then + allocate(DstMiscData%C_Brake(LB(1):UB(1),LB(2):UB(2)), 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 + end if + if (allocated(SrcMiscData%F_table)) then + LB(1:2) = lbound(SrcMiscData%F_table) + UB(1:2) = ubound(SrcMiscData%F_table) + if (.not. allocated(DstMiscData%F_table)) then + allocate(DstMiscData%F_table(LB(1):UB(1),LB(2):UB(2)), 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 + end if + if (allocated(SrcMiscData%F_k)) then + LB(1:2) = lbound(SrcMiscData%F_k) + UB(1:2) = ubound(SrcMiscData%F_k) + if (.not. allocated(DstMiscData%F_k)) then + allocate(DstMiscData%F_k(LB(1):UB(1),LB(2):UB(2)), 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 + end if + if (allocated(SrcMiscData%a_G)) then + LB(1:2) = lbound(SrcMiscData%a_G) + UB(1:2) = ubound(SrcMiscData%a_G) + if (.not. allocated(DstMiscData%a_G)) then + allocate(DstMiscData%a_G(LB(1):UB(1),LB(2):UB(2)), 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 + end if + if (allocated(SrcMiscData%rdisp_P)) then + LB(1:2) = lbound(SrcMiscData%rdisp_P) + UB(1:2) = ubound(SrcMiscData%rdisp_P) + if (.not. allocated(DstMiscData%rdisp_P)) then + allocate(DstMiscData%rdisp_P(LB(1):UB(1),LB(2):UB(2)), 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 + end if + if (allocated(SrcMiscData%rdot_P)) then + LB(1:2) = lbound(SrcMiscData%rdot_P) + UB(1:2) = ubound(SrcMiscData%rdot_P) + if (.not. allocated(DstMiscData%rdot_P)) then + allocate(DstMiscData%rdot_P(LB(1):UB(1),LB(2):UB(2)), 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 + end if + if (allocated(SrcMiscData%rddot_P)) then + LB(1:2) = lbound(SrcMiscData%rddot_P) + UB(1:2) = ubound(SrcMiscData%rddot_P) + if (.not. allocated(DstMiscData%rddot_P)) then + allocate(DstMiscData%rddot_P(LB(1):UB(1),LB(2):UB(2)), 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 + end if + if (allocated(SrcMiscData%omega_P)) then + LB(1:2) = lbound(SrcMiscData%omega_P) + UB(1:2) = ubound(SrcMiscData%omega_P) + if (.not. allocated(DstMiscData%omega_P)) then + allocate(DstMiscData%omega_P(LB(1):UB(1),LB(2):UB(2)), 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 + end if + if (allocated(SrcMiscData%alpha_P)) then + LB(1:2) = lbound(SrcMiscData%alpha_P) + UB(1:2) = ubound(SrcMiscData%alpha_P) + if (.not. allocated(DstMiscData%alpha_P)) then + allocate(DstMiscData%alpha_P(LB(1):UB(1),LB(2):UB(2)), 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 + end if + if (allocated(SrcMiscData%F_P)) then + LB(1:2) = lbound(SrcMiscData%F_P) + UB(1:2) = ubound(SrcMiscData%F_P) + if (.not. allocated(DstMiscData%F_P)) then + allocate(DstMiscData%F_P(LB(1):UB(1),LB(2):UB(2)), 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 + end if + if (allocated(SrcMiscData%M_P)) then + LB(1:2) = lbound(SrcMiscData%M_P) + UB(1:2) = ubound(SrcMiscData%M_P) + if (.not. allocated(DstMiscData%M_P)) then + allocate(DstMiscData%M_P(LB(1):UB(1),LB(2):UB(2)), 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 + end if + if (allocated(SrcMiscData%Acc)) then + LB(1:2) = lbound(SrcMiscData%Acc) + UB(1:2) = ubound(SrcMiscData%Acc) + if (.not. allocated(DstMiscData%Acc)) then + allocate(DstMiscData%Acc(LB(1):UB(1),LB(2):UB(2)), 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 + end if + DstMiscData%PrescribedInterpIdx = SrcMiscData%PrescribedInterpIdx +end subroutine + +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' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(MiscData%F_stop)) then + deallocate(MiscData%F_stop) + end if + if (allocated(MiscData%F_ext)) then + deallocate(MiscData%F_ext) + end if + if (allocated(MiscData%F_fr)) then + deallocate(MiscData%F_fr) + end if + if (allocated(MiscData%K)) then + deallocate(MiscData%K) + end if + if (allocated(MiscData%C_ctrl)) then + deallocate(MiscData%C_ctrl) + end if + if (allocated(MiscData%C_Brake)) then + deallocate(MiscData%C_Brake) + end if + if (allocated(MiscData%F_table)) then + deallocate(MiscData%F_table) + end if + if (allocated(MiscData%F_k)) then + deallocate(MiscData%F_k) + end if + if (allocated(MiscData%a_G)) then + deallocate(MiscData%a_G) + end if + if (allocated(MiscData%rdisp_P)) then + deallocate(MiscData%rdisp_P) + end if + if (allocated(MiscData%rdot_P)) then + deallocate(MiscData%rdot_P) + end if + if (allocated(MiscData%rddot_P)) then + deallocate(MiscData%rddot_P) + end if + if (allocated(MiscData%omega_P)) then + deallocate(MiscData%omega_P) + end if + if (allocated(MiscData%alpha_P)) then + deallocate(MiscData%alpha_P) + end if + if (allocated(MiscData%F_P)) then + deallocate(MiscData%F_P) + end if + if (allocated(MiscData%M_P)) then + deallocate(MiscData%M_P) + end if + if (allocated(MiscData%Acc)) then + deallocate(MiscData%Acc) + end if +end subroutine + +subroutine StC_PackMisc(RF, Indata) + type(RegFile), intent(inout) :: RF + type(StC_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'StC_PackMisc' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%F_stop) + call RegPackAlloc(RF, InData%F_ext) + call RegPackAlloc(RF, InData%F_fr) + call RegPackAlloc(RF, InData%K) + call RegPackAlloc(RF, InData%C_ctrl) + call RegPackAlloc(RF, InData%C_Brake) + call RegPackAlloc(RF, InData%F_table) + call RegPackAlloc(RF, InData%F_k) + call RegPackAlloc(RF, InData%a_G) + call RegPackAlloc(RF, InData%rdisp_P) + call RegPackAlloc(RF, InData%rdot_P) + call RegPackAlloc(RF, InData%rddot_P) + call RegPackAlloc(RF, InData%omega_P) + call RegPackAlloc(RF, InData%alpha_P) + call RegPackAlloc(RF, InData%F_P) + call RegPackAlloc(RF, InData%M_P) + call RegPackAlloc(RF, InData%Acc) + call RegPack(RF, InData%PrescribedInterpIdx) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine StC_UnPackMisc(RF, OutData) + type(RegFile), intent(inout) :: RF + type(StC_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'StC_UnPackMisc' + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%F_stop); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%F_ext); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%F_fr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%K); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%C_ctrl); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%C_Brake); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%F_table); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%F_k); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%a_G); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%rdisp_P); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%rdot_P); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%rddot_P); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%omega_P); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%alpha_P); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%F_P); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%M_P); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Acc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PrescribedInterpIdx); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +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 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + 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%StC_Z_PreLd = SrcParamData%StC_Z_PreLd + 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 + LB(1:2) = lbound(SrcParamData%F_TBL) + UB(1:2) = ubound(SrcParamData%F_TBL) + if (.not. allocated(DstParamData%F_TBL)) then + allocate(DstParamData%F_TBL(LB(1):UB(1),LB(2):UB(2)), 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 + end if + DstParamData%NumMeshPts = SrcParamData%NumMeshPts + DstParamData%PrescribedForcesCoordSys = SrcParamData%PrescribedForcesCoordSys + if (allocated(SrcParamData%StC_PrescribedForce)) then + LB(1:2) = lbound(SrcParamData%StC_PrescribedForce) + UB(1:2) = ubound(SrcParamData%StC_PrescribedForce) + if (.not. allocated(DstParamData%StC_PrescribedForce)) then + allocate(DstParamData%StC_PrescribedForce(LB(1):UB(1),LB(2):UB(2)), 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 + end if + if (allocated(SrcParamData%StC_CChan)) then + LB(1:1) = lbound(SrcParamData%StC_CChan) + UB(1:1) = ubound(SrcParamData%StC_CChan) + if (.not. allocated(DstParamData%StC_CChan)) then + allocate(DstParamData%StC_CChan(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%StC_CChan.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%StC_CChan = SrcParamData%StC_CChan + end if +end subroutine + +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' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ParamData%F_TBL)) then + deallocate(ParamData%F_TBL) + end if + if (allocated(ParamData%StC_PrescribedForce)) then + deallocate(ParamData%StC_PrescribedForce) + end if + if (allocated(ParamData%StC_CChan)) then + deallocate(ParamData%StC_CChan) + end if +end subroutine + +subroutine StC_PackParam(RF, Indata) + type(RegFile), intent(inout) :: RF + type(StC_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'StC_PackParam' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DT) + call RegPack(RF, InData%RootName) + call RegPack(RF, InData%StC_DOF_MODE) + call RegPack(RF, InData%StC_X_DOF) + call RegPack(RF, InData%StC_Y_DOF) + call RegPack(RF, InData%StC_Z_DOF) + call RegPack(RF, InData%StC_Z_PreLd) + call RegPack(RF, InData%M_X) + call RegPack(RF, InData%M_Y) + call RegPack(RF, InData%M_Z) + call RegPack(RF, InData%M_XY) + call RegPack(RF, InData%K_X) + call RegPack(RF, InData%K_Y) + call RegPack(RF, InData%K_Z) + call RegPack(RF, InData%C_X) + call RegPack(RF, InData%C_Y) + call RegPack(RF, InData%C_Z) + call RegPack(RF, InData%K_S) + call RegPack(RF, InData%C_S) + call RegPack(RF, InData%P_SP) + call RegPack(RF, InData%N_SP) + call RegPack(RF, InData%Gravity) + call RegPack(RF, InData%StC_CMODE) + call RegPack(RF, InData%StC_SA_MODE) + call RegPack(RF, InData%StC_X_C_HIGH) + call RegPack(RF, InData%StC_X_C_LOW) + call RegPack(RF, InData%StC_Y_C_HIGH) + call RegPack(RF, InData%StC_Y_C_LOW) + call RegPack(RF, InData%StC_Z_C_HIGH) + call RegPack(RF, InData%StC_Z_C_LOW) + call RegPack(RF, InData%StC_X_C_BRAKE) + call RegPack(RF, InData%StC_Y_C_BRAKE) + call RegPack(RF, InData%StC_Z_C_BRAKE) + call RegPack(RF, InData%L_X) + call RegPack(RF, InData%B_X) + call RegPack(RF, InData%area_X) + call RegPack(RF, InData%area_ratio_X) + call RegPack(RF, InData%headLossCoeff_X) + call RegPack(RF, InData%rho_X) + call RegPack(RF, InData%L_Y) + call RegPack(RF, InData%B_Y) + call RegPack(RF, InData%area_Y) + call RegPack(RF, InData%area_ratio_Y) + call RegPack(RF, InData%headLossCoeff_Y) + call RegPack(RF, InData%rho_Y) + call RegPack(RF, InData%Use_F_TBL) + call RegPackAlloc(RF, InData%F_TBL) + call RegPack(RF, InData%NumMeshPts) + call RegPack(RF, InData%PrescribedForcesCoordSys) + call RegPackAlloc(RF, InData%StC_PrescribedForce) + call RegPackAlloc(RF, InData%StC_CChan) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine StC_UnPackParam(RF, OutData) + type(RegFile), intent(inout) :: RF + type(StC_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'StC_UnPackParam' + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RootName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_DOF_MODE); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_X_DOF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_Y_DOF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_Z_DOF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_Z_PreLd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%M_X); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%M_Y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%M_Z); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%M_XY); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%K_X); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%K_Y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%K_Z); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%C_X); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%C_Y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%C_Z); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%K_S); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%C_S); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%P_SP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%N_SP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Gravity); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_CMODE); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_SA_MODE); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_X_C_HIGH); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_X_C_LOW); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_Y_C_HIGH); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_Y_C_LOW); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_Z_C_HIGH); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_Z_C_LOW); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_X_C_BRAKE); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_Y_C_BRAKE); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_Z_C_BRAKE); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%L_X); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%B_X); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%area_X); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%area_ratio_X); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%headLossCoeff_X); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rho_X); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%L_Y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%B_Y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%area_Y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%area_ratio_Y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%headLossCoeff_Y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rho_Y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Use_F_TBL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%F_TBL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumMeshPts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PrescribedForcesCoordSys); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%StC_PrescribedForce); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%StC_CChan); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +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 + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'StC_CopyInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcInputData%Mesh)) then + LB(1:1) = lbound(SrcInputData%Mesh) + UB(1:1) = ubound(SrcInputData%Mesh) + if (.not. allocated(DstInputData%Mesh)) then + allocate(DstInputData%Mesh(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%Mesh.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MeshCopy(SrcInputData%Mesh(i1), DstInputData%Mesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcInputData%CmdStiff)) then + LB(1:2) = lbound(SrcInputData%CmdStiff) + UB(1:2) = ubound(SrcInputData%CmdStiff) + if (.not. allocated(DstInputData%CmdStiff)) then + allocate(DstInputData%CmdStiff(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%CmdStiff.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%CmdStiff = SrcInputData%CmdStiff + end if + if (allocated(SrcInputData%CmdDamp)) then + LB(1:2) = lbound(SrcInputData%CmdDamp) + UB(1:2) = ubound(SrcInputData%CmdDamp) + if (.not. allocated(DstInputData%CmdDamp)) then + allocate(DstInputData%CmdDamp(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%CmdDamp.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%CmdDamp = SrcInputData%CmdDamp + end if + if (allocated(SrcInputData%CmdBrake)) then + LB(1:2) = lbound(SrcInputData%CmdBrake) + UB(1:2) = ubound(SrcInputData%CmdBrake) + if (.not. allocated(DstInputData%CmdBrake)) then + allocate(DstInputData%CmdBrake(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%CmdBrake.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%CmdBrake = SrcInputData%CmdBrake + end if + if (allocated(SrcInputData%CmdForce)) then + LB(1:2) = lbound(SrcInputData%CmdForce) + UB(1:2) = ubound(SrcInputData%CmdForce) + if (.not. allocated(DstInputData%CmdForce)) then + allocate(DstInputData%CmdForce(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%CmdForce.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%CmdForce = SrcInputData%CmdForce + end if +end subroutine + +subroutine StC_DestroyInput(InputData, ErrStat, ErrMsg) + type(StC_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'StC_DestroyInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InputData%Mesh)) then + LB(1:1) = lbound(InputData%Mesh) + UB(1:1) = ubound(InputData%Mesh) + do i1 = LB(1), UB(1) + call MeshDestroy( InputData%Mesh(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InputData%Mesh) + end if + if (allocated(InputData%CmdStiff)) then + deallocate(InputData%CmdStiff) + end if + if (allocated(InputData%CmdDamp)) then + deallocate(InputData%CmdDamp) + end if + if (allocated(InputData%CmdBrake)) then + deallocate(InputData%CmdBrake) + end if + if (allocated(InputData%CmdForce)) then + deallocate(InputData%CmdForce) + end if +end subroutine + +subroutine StC_PackInput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(StC_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'StC_PackInput' + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%Mesh)) + if (allocated(InData%Mesh)) then + call RegPackBounds(RF, 1, lbound(InData%Mesh), ubound(InData%Mesh)) + LB(1:1) = lbound(InData%Mesh) + UB(1:1) = ubound(InData%Mesh) + do i1 = LB(1), UB(1) + call MeshPack(RF, InData%Mesh(i1)) + end do + end if + call RegPackAlloc(RF, InData%CmdStiff) + call RegPackAlloc(RF, InData%CmdDamp) + call RegPackAlloc(RF, InData%CmdBrake) + call RegPackAlloc(RF, InData%CmdForce) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine StC_UnPackInput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(StC_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'StC_UnPackInput' + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + if (allocated(OutData%Mesh)) deallocate(OutData%Mesh) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%Mesh(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Mesh.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(RF, OutData%Mesh(i1)) ! Mesh + end do + end if + call RegUnpackAlloc(RF, OutData%CmdStiff); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%CmdDamp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%CmdBrake); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%CmdForce); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +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 + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'StC_CopyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcOutputData%Mesh)) then + LB(1:1) = lbound(SrcOutputData%Mesh) + UB(1:1) = ubound(SrcOutputData%Mesh) + if (.not. allocated(DstOutputData%Mesh)) then + allocate(DstOutputData%Mesh(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Mesh.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MeshCopy(SrcOutputData%Mesh(i1), DstOutputData%Mesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcOutputData%MeasDisp)) then + LB(1:2) = lbound(SrcOutputData%MeasDisp) + UB(1:2) = ubound(SrcOutputData%MeasDisp) + if (.not. allocated(DstOutputData%MeasDisp)) then + allocate(DstOutputData%MeasDisp(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%MeasDisp.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%MeasDisp = SrcOutputData%MeasDisp + end if + if (allocated(SrcOutputData%MeasVel)) then + LB(1:2) = lbound(SrcOutputData%MeasVel) + UB(1:2) = ubound(SrcOutputData%MeasVel) + if (.not. allocated(DstOutputData%MeasVel)) then + allocate(DstOutputData%MeasVel(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%MeasVel.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%MeasVel = SrcOutputData%MeasVel + end if +end subroutine + +subroutine StC_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(StC_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'StC_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OutputData%Mesh)) then + LB(1:1) = lbound(OutputData%Mesh) + UB(1:1) = ubound(OutputData%Mesh) + do i1 = LB(1), UB(1) + call MeshDestroy( OutputData%Mesh(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(OutputData%Mesh) + end if + if (allocated(OutputData%MeasDisp)) then + deallocate(OutputData%MeasDisp) + end if + if (allocated(OutputData%MeasVel)) then + deallocate(OutputData%MeasVel) + end if +end subroutine + +subroutine StC_PackOutput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(StC_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'StC_PackOutput' + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%Mesh)) + if (allocated(InData%Mesh)) then + call RegPackBounds(RF, 1, lbound(InData%Mesh), ubound(InData%Mesh)) + LB(1:1) = lbound(InData%Mesh) + UB(1:1) = ubound(InData%Mesh) + do i1 = LB(1), UB(1) + call MeshPack(RF, InData%Mesh(i1)) + end do + end if + call RegPackAlloc(RF, InData%MeasDisp) + call RegPackAlloc(RF, InData%MeasVel) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine StC_UnPackOutput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(StC_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'StC_UnPackOutput' + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + if (allocated(OutData%Mesh)) deallocate(OutData%Mesh) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%Mesh(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Mesh.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(RF, OutData%Mesh(i1)) ! Mesh + end do + end if + call RegUnpackAlloc(RF, OutData%MeasDisp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%MeasVel); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +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 ) + 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) /= size(u)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(u)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(u) - 1 + select case (order) + case (0) + call StC_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call StC_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call StC_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(u) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +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. @@ -5906,81 +1985,62 @@ SUBROUTINE StC_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ! !.................................................................................................................................. - 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 + 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 :: i02 ! dim2 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - INTEGER :: i2 ! dim2 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 + 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) :: a1, a2 ! 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 :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 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 -IF (ALLOCATED(u_out%CmdStiff) .AND. ALLOCATED(u1%CmdStiff)) THEN - DO i2 = LBOUND(u_out%CmdStiff,2),UBOUND(u_out%CmdStiff,2) - DO i1 = LBOUND(u_out%CmdStiff,1),UBOUND(u_out%CmdStiff,1) - b = -(u1%CmdStiff(i1,i2) - u2%CmdStiff(i1,i2)) - u_out%CmdStiff(i1,i2) = u1%CmdStiff(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%CmdDamp) .AND. ALLOCATED(u1%CmdDamp)) THEN - DO i2 = LBOUND(u_out%CmdDamp,2),UBOUND(u_out%CmdDamp,2) - DO i1 = LBOUND(u_out%CmdDamp,1),UBOUND(u_out%CmdDamp,1) - b = -(u1%CmdDamp(i1,i2) - u2%CmdDamp(i1,i2)) - u_out%CmdDamp(i1,i2) = u1%CmdDamp(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%CmdBrake) .AND. ALLOCATED(u1%CmdBrake)) THEN - DO i2 = LBOUND(u_out%CmdBrake,2),UBOUND(u_out%CmdBrake,2) - DO i1 = LBOUND(u_out%CmdBrake,1),UBOUND(u_out%CmdBrake,1) - b = -(u1%CmdBrake(i1,i2) - u2%CmdBrake(i1,i2)) - u_out%CmdBrake(i1,i2) = u1%CmdBrake(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%CmdForce) .AND. ALLOCATED(u1%CmdForce)) THEN - DO i2 = LBOUND(u_out%CmdForce,2),UBOUND(u_out%CmdForce,2) - DO i1 = LBOUND(u_out%CmdForce,1),UBOUND(u_out%CmdForce,1) - b = -(u1%CmdForce(i1,i2) - u2%CmdForce(i1,i2)) - u_out%CmdForce(i1,i2) = u1%CmdForce(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated - END SUBROUTINE StC_Input_ExtrapInterp1 - - - SUBROUTINE StC_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = 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) + END DO + END IF ! check if allocated + IF (ALLOCATED(u_out%CmdStiff) .AND. ALLOCATED(u1%CmdStiff)) THEN + u_out%CmdStiff = a1*u1%CmdStiff + a2*u2%CmdStiff + END IF ! check if allocated + IF (ALLOCATED(u_out%CmdDamp) .AND. ALLOCATED(u1%CmdDamp)) THEN + u_out%CmdDamp = a1*u1%CmdDamp + a2*u2%CmdDamp + END IF ! check if allocated + IF (ALLOCATED(u_out%CmdBrake) .AND. ALLOCATED(u1%CmdBrake)) THEN + u_out%CmdBrake = a1*u1%CmdBrake + a2*u2%CmdBrake + END IF ! check if allocated + IF (ALLOCATED(u_out%CmdForce) .AND. ALLOCATED(u1%CmdForce)) THEN + u_out%CmdForce = a1*u1%CmdForce + a2*u2%CmdForce + END IF ! check if allocated +END SUBROUTINE + +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. @@ -5994,145 +2054,122 @@ SUBROUTINE StC_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Err ! !.................................................................................................................................. - 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 + 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 :: i02 ! dim2 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - INTEGER :: i2 ! dim2 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) - + 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) :: a1,a2,a3 ! 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 :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 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 + 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 + 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 + 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 -IF (ALLOCATED(u_out%CmdStiff) .AND. ALLOCATED(u1%CmdStiff)) THEN - DO i2 = LBOUND(u_out%CmdStiff,2),UBOUND(u_out%CmdStiff,2) - DO i1 = LBOUND(u_out%CmdStiff,1),UBOUND(u_out%CmdStiff,1) - b = (t(3)**2*(u1%CmdStiff(i1,i2) - u2%CmdStiff(i1,i2)) + t(2)**2*(-u1%CmdStiff(i1,i2) + u3%CmdStiff(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*u1%CmdStiff(i1,i2) + t(3)*u2%CmdStiff(i1,i2) - t(2)*u3%CmdStiff(i1,i2) ) * scaleFactor - u_out%CmdStiff(i1,i2) = u1%CmdStiff(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%CmdDamp) .AND. ALLOCATED(u1%CmdDamp)) THEN - DO i2 = LBOUND(u_out%CmdDamp,2),UBOUND(u_out%CmdDamp,2) - DO i1 = LBOUND(u_out%CmdDamp,1),UBOUND(u_out%CmdDamp,1) - b = (t(3)**2*(u1%CmdDamp(i1,i2) - u2%CmdDamp(i1,i2)) + t(2)**2*(-u1%CmdDamp(i1,i2) + u3%CmdDamp(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*u1%CmdDamp(i1,i2) + t(3)*u2%CmdDamp(i1,i2) - t(2)*u3%CmdDamp(i1,i2) ) * scaleFactor - u_out%CmdDamp(i1,i2) = u1%CmdDamp(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%CmdBrake) .AND. ALLOCATED(u1%CmdBrake)) THEN - DO i2 = LBOUND(u_out%CmdBrake,2),UBOUND(u_out%CmdBrake,2) - DO i1 = LBOUND(u_out%CmdBrake,1),UBOUND(u_out%CmdBrake,1) - b = (t(3)**2*(u1%CmdBrake(i1,i2) - u2%CmdBrake(i1,i2)) + t(2)**2*(-u1%CmdBrake(i1,i2) + u3%CmdBrake(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*u1%CmdBrake(i1,i2) + t(3)*u2%CmdBrake(i1,i2) - t(2)*u3%CmdBrake(i1,i2) ) * scaleFactor - u_out%CmdBrake(i1,i2) = u1%CmdBrake(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%CmdForce) .AND. ALLOCATED(u1%CmdForce)) THEN - DO i2 = LBOUND(u_out%CmdForce,2),UBOUND(u_out%CmdForce,2) - DO i1 = LBOUND(u_out%CmdForce,1),UBOUND(u_out%CmdForce,1) - b = (t(3)**2*(u1%CmdForce(i1,i2) - u2%CmdForce(i1,i2)) + t(2)**2*(-u1%CmdForce(i1,i2) + u3%CmdForce(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*u1%CmdForce(i1,i2) + t(3)*u2%CmdForce(i1,i2) - t(2)*u3%CmdForce(i1,i2) ) * scaleFactor - u_out%CmdForce(i1,i2) = u1%CmdForce(i1,i2) + b + c * t_out - END DO - END DO -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 + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - 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 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) + END DO + END IF ! check if allocated + IF (ALLOCATED(u_out%CmdStiff) .AND. ALLOCATED(u1%CmdStiff)) THEN + u_out%CmdStiff = a1*u1%CmdStiff + a2*u2%CmdStiff + a3*u3%CmdStiff + END IF ! check if allocated + IF (ALLOCATED(u_out%CmdDamp) .AND. ALLOCATED(u1%CmdDamp)) THEN + u_out%CmdDamp = a1*u1%CmdDamp + a2*u2%CmdDamp + a3*u3%CmdDamp + END IF ! check if allocated + IF (ALLOCATED(u_out%CmdBrake) .AND. ALLOCATED(u1%CmdBrake)) THEN + u_out%CmdBrake = a1*u1%CmdBrake + a2*u2%CmdBrake + a3*u3%CmdBrake + END IF ! check if allocated + IF (ALLOCATED(u_out%CmdForce) .AND. ALLOCATED(u1%CmdForce)) THEN + u_out%CmdForce = a1*u1%CmdForce + a2*u2%CmdForce + a3*u3%CmdForce + END IF ! check if allocated +END SUBROUTINE + +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 ) + 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) /= size(y)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(y)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(y) - 1 + select case (order) + case (0) + call StC_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call StC_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call StC_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(y) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +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. @@ -6144,65 +2181,56 @@ SUBROUTINE StC_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ! !.................................................................................................................................. - 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 + 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 :: i02 ! dim2 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - INTEGER :: i2 ! dim2 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 + 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) :: a1, a2 ! 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 :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 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 -IF (ALLOCATED(y_out%MeasDisp) .AND. ALLOCATED(y1%MeasDisp)) THEN - DO i2 = LBOUND(y_out%MeasDisp,2),UBOUND(y_out%MeasDisp,2) - DO i1 = LBOUND(y_out%MeasDisp,1),UBOUND(y_out%MeasDisp,1) - b = -(y1%MeasDisp(i1,i2) - y2%MeasDisp(i1,i2)) - y_out%MeasDisp(i1,i2) = y1%MeasDisp(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%MeasVel) .AND. ALLOCATED(y1%MeasVel)) THEN - DO i2 = LBOUND(y_out%MeasVel,2),UBOUND(y_out%MeasVel,2) - DO i1 = LBOUND(y_out%MeasVel,1),UBOUND(y_out%MeasVel,1) - b = -(y1%MeasVel(i1,i2) - y2%MeasVel(i1,i2)) - y_out%MeasVel(i1,i2) = y1%MeasVel(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated - END SUBROUTINE StC_Output_ExtrapInterp1 - - - SUBROUTINE StC_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = 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) + END DO + END IF ! check if allocated + IF (ALLOCATED(y_out%MeasDisp) .AND. ALLOCATED(y1%MeasDisp)) THEN + y_out%MeasDisp = a1*y1%MeasDisp + a2*y2%MeasDisp + END IF ! check if allocated + IF (ALLOCATED(y_out%MeasVel) .AND. ALLOCATED(y1%MeasVel)) THEN + y_out%MeasVel = a1*y1%MeasVel + a2*y2%MeasVel + END IF ! check if allocated +END SUBROUTINE + +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. @@ -6216,73 +2244,61 @@ SUBROUTINE StC_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Er ! !.................................................................................................................................. - 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 + 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 :: i02 ! dim2 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - INTEGER :: i2 ! dim2 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) - + 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) :: a1,a2,a3 ! 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 :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 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 + 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 + 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 + 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 -IF (ALLOCATED(y_out%MeasDisp) .AND. ALLOCATED(y1%MeasDisp)) THEN - DO i2 = LBOUND(y_out%MeasDisp,2),UBOUND(y_out%MeasDisp,2) - DO i1 = LBOUND(y_out%MeasDisp,1),UBOUND(y_out%MeasDisp,1) - b = (t(3)**2*(y1%MeasDisp(i1,i2) - y2%MeasDisp(i1,i2)) + t(2)**2*(-y1%MeasDisp(i1,i2) + y3%MeasDisp(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*y1%MeasDisp(i1,i2) + t(3)*y2%MeasDisp(i1,i2) - t(2)*y3%MeasDisp(i1,i2) ) * scaleFactor - y_out%MeasDisp(i1,i2) = y1%MeasDisp(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%MeasVel) .AND. ALLOCATED(y1%MeasVel)) THEN - DO i2 = LBOUND(y_out%MeasVel,2),UBOUND(y_out%MeasVel,2) - DO i1 = LBOUND(y_out%MeasVel,1),UBOUND(y_out%MeasVel,1) - b = (t(3)**2*(y1%MeasVel(i1,i2) - y2%MeasVel(i1,i2)) + t(2)**2*(-y1%MeasVel(i1,i2) + y3%MeasVel(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*y1%MeasVel(i1,i2) + t(3)*y2%MeasVel(i1,i2) - t(2)*y3%MeasVel(i1,i2) ) * scaleFactor - y_out%MeasVel(i1,i2) = y1%MeasVel(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated - END SUBROUTINE StC_Output_ExtrapInterp2 - + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - 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 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) + END DO + END IF ! check if allocated + IF (ALLOCATED(y_out%MeasDisp) .AND. ALLOCATED(y1%MeasDisp)) THEN + y_out%MeasDisp = a1*y1%MeasDisp + a2*y2%MeasDisp + a3*y3%MeasDisp + END IF ! check if allocated + IF (ALLOCATED(y_out%MeasVel) .AND. ALLOCATED(y1%MeasVel)) THEN + y_out%MeasVel = a1*y1%MeasVel + a2*y2%MeasVel + a3*y3%MeasVel + END IF ! check if allocated +END SUBROUTINE END MODULE StrucCtrl_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/simple-elastodyn/CMakeLists.txt b/modules/simple-elastodyn/CMakeLists.txt new file mode 100644 index 0000000000..ee5b439649 --- /dev/null +++ b/modules/simple-elastodyn/CMakeLists.txt @@ -0,0 +1,41 @@ +# +# Copyright 2024 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/SED_Registry.txt ${CMAKE_CURRENT_LIST_DIR}/src/SED_Types.f90) +endif() + +add_library(sedlib + src/SED_Types.f90 + src/SED_Output_Params.f90 + src/SED_IO.f90 + src/SED.f90 +) +target_link_libraries(sedlib nwtclibs) + +add_executable(sed_driver + src/driver/SED_Driver_Types.f90 + src/driver/SED_Driver_Subs.f90 + src/driver/SED_Driver.f90 +) +target_link_libraries(sed_driver sedlib versioninfolib ${CMAKE_DL_LIBS}) + +install(TARGETS sedlib sed_driver + EXPORT "${CMAKE_PROJECT_NAME}Libraries" + RUNTIME DESTINATION bin + LIBRARY DESTINATION lib + ARCHIVE DESTINATION lib +) diff --git a/modules/simple-elastodyn/src/SED.f90 b/modules/simple-elastodyn/src/SED.f90 new file mode 100644 index 0000000000..e1b433356a --- /dev/null +++ b/modules/simple-elastodyn/src/SED.f90 @@ -0,0 +1,1380 @@ +!********************************************************************************************************************************** +!> ## SED +!! The SED module solves a quasi-steady actuator disk representation of the rotor to calculate the 3 forces and 3 moments of +!! the rotor dependent on the tip-speed ratio (TSR), rotor speed (RotSpeed), relative wind velocity vector (VRel), and the rotor- +!! collective blade-pitch (BlPitch). +!! +! .................................................................................................................................. +!! ## LICENSING +!! Copyright (C) 2024 National Renewable Energy Laboratory +!! +!! This file is part of SED. +!! +!! 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 SED + + USE SED_Types + USE SED_IO + USE NWTC_Library + + implicit none + private + type(ProgDesc), parameter :: SED_Ver = ProgDesc( 'SED', '', '' ) + + public :: SED_Init + public :: SED_End + public :: SED_UpdateStates + public :: SED_CalcOutput + public :: SED_CalcContStateDeriv + + ! Linearization is not supported by this module, so the following routines are omitted + !public :: SED_CalcConstrStateResidual + !public :: SED_UpdateDiscState + !public :: SED_JacobianPInput + !public :: SED_JacobianPContState + !public :: SED_JacobianPDiscState + !public :: SED_JacobianPConstrState + !public :: SED_GetOP + +CONTAINS + + +!---------------------------------------------------------------------------------------------------------------------------------- +!> Initialize the SED module: +!! - load settings (passed or from file) +!! - setup meshes +!! - initialize outputs and other data storage +SUBROUTINE SED_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut, ErrStat, ErrMsg ) + type(SED_InitInputType), intent(in ) :: InitInp !< Input data for initialization routine + type(SED_InputType), intent( out) :: u !< An initial guess for the input; input mesh must be defined + type(SED_ParameterType), intent( out) :: p !< Parameters + type(SED_ContinuousStateType), intent( out) :: x !< Initial continuous states + type(SED_DiscreteStateType), intent( out) :: xd !< Initial discrete states + type(SED_ConstraintStateType), intent( out) :: z !< Initial guess of the constraint states + type(SED_OtherStateType), intent( out) :: OtherState !< Initial other states (logical, etc) + type(SED_OutputType), intent( out) :: y !< Initial system outputs (outputs are not calculated) + type(SED_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 + type(SED_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(SED_InputFile) :: InputFileData !< Data from input file as a string array + type(FileInfoType) :: FileInfo_In !< The derived type for holding the full input file for parsing -- we may pass this in the future + integer(IntKi) :: UnEc ! unit number for the echo file (-1 for not in use) + integer(IntKi) :: ErrStat2 ! local error status + character(ErrMsgLen) :: ErrMsg2 ! local error message + character(*), parameter :: RoutineName = 'SED_Init' + + ! Initialize variables + ErrStat = ErrID_None + ErrMsg = "" + + ! Initialize the NWTC Subroutine Library + call NWTC_Init( ) + + ! Display the module information + call DispNVD( SED_Ver ) + + + ! set rootname + p%RootName = trim(InitInp%RootName) + + ! Get primary input file + if ( InitInp%UseInputFile ) then + CALL ProcessComFile( InitInp%InputFile, FileInfo_In, ErrStat2, ErrMsg2 ) + else + CALL NWTC_Library_CopyFileInfoType( InitInp%PassedFileData, 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 all SED-related input and populate the InputFileData structure + call SED_ParsePrimaryFileData( InitInp, p%RootName, Interval, FileInfo_In, InputFileData, UnEc, ErrStat2, ErrMsg2 ) + if (Failed()) return; + + ! Verify all the necessary initialization and input file data + CALL SEDInput_ValidateInput( InitInp, InputFileData, ErrStat2, ErrMsg2 ) + if (Failed()) return; + + ! This should be caught by glue code. Check it here after validation so we can + ! provide something meaningful in error messages about the input file + if (InitInp%Linearize) then + ErrStat2 = ErrID_Fatal + ErrMsg2 = 'SED cannot perform linearization analysis.' + if (Failed()) return + end if + + ! Set parameters + CALL SED_SetParameters(ErrStat2,ErrMsg2); if (Failed()) return; + + ! Set States + call Init_States(ErrStat2,ErrMsg2); if (Failed()) return + + ! Set inputs + call Init_U(ErrStat2,ErrMsg2); if (Failed()) return + + ! Set Meshes + call Init_Mesh(ErrStat2,ErrMsg2); if (Failed()) return + + ! Set miscvars (mesh mappings in here) + call Init_Misc(ErrStat2,ErrMsg2); if (Failed()) return + + ! Set outputs + call Init_Y(ErrStat2,ErrMsg2); if (Failed()) return + + ! Set InitOutputs + call Init_InitY(ErrStat2,ErrMsg2); if (Failed()) return + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + !if (Failed) call CleanUp() + end function Failed + + !> Store parameters + subroutine SED_SetParameters(ErrStat3,ErrMsg3) + integer(IntKi), intent( out) :: ErrStat3 + character(*), intent( out) :: ErrMsg3 + ! Set parameters + p%RootName = InitInp%RootName + p%DT = InputFileData%DT + Interval = p%DT ! Tell glue code what we want for DT + p%DT24 = p%DT/24.0_DbKi ! Time-step parameter needed for Solver(). + p%numOuts = InputFileData%NumOuts + p%IntMethod = InputFileData%IntMethod + p%GenDOF = InputFileData%GenDOF + p%YawDOF = InputFileData%YawDOF + p%InitYaw = InputFileData%NacYaw + p%InitAzimuth = InputFileData%Azimuth + + ! geometry + p%NumBl = InputFileData%NumBl + p%TipRad = InputFileData%TipRad + p%HubRad = InputFileData%HubRad + p%PreCone = InputFileData%PreCone + p%OverHang = InputFileData%OverHang + p%ShftTilt = InputFileData%ShftTilt + p%Twr2Shft = InputFileData%Twr2Shft + p%TowerHt = InputFileData%TowerHt + p%PtfmPitch = InputFileData%PtfmPitch + p%HubHt = p%TowerHt + p%Twr2Shft + p%OverHang*sin(p%ShftTilt) + !FIXME: Do we need to account for cone???? ED does not + p%BladeLength = p%TipRad - p%HubRad + + ! inertia / drivetrain + p%RotIner = InputFileData%RotIner + p%GenIner = InputFileData%GenIner + ! NOTE: since we do not calculate gearbox or tower top reaction loads, we don't care about the sign of the gearbox ratio (this simplifies our math) + p%GBoxRatio = abs(InputFileData%GBoxRatio) + + ! system inertia + p%J_DT = p%RotIner + p%GBoxRatio**2_IntKi * p%GenIner + + ! Set the outputs + call SetOutParam(InputFileData%OutList, p, ErrStat3, ErrMsg3 ) + end subroutine SED_SetParameters + + !> Initialize states + subroutine Init_States(ErrStat3,ErrMsg3) + integer(IntKi), intent( out) :: ErrStat3 + character(*), intent( out) :: ErrMsg3 + integer(IntKi) :: I + ErrStat3 = ErrID_None + ErrMsg3 = "" + + ! Allocate states (only two states -- azimuth and rotor speed) + call AllocAry( x%QT, 1, 'x%QT', ErrStat3, ErrMsg3); if (ErrStat3 >= AbortErrLev) return + call AllocAry( x%QDT, 1, 'x%QDT', ErrStat3, ErrMsg3); if (ErrStat3 >= AbortErrLev) return + + ! Set initial conditions + x%QT( DOF_Az) = InputFileData%Azimuth + x%QDT(DOF_Az) = InputFileData%RotSpeed + + ! Unused states + xd%DummyDiscreteState = 0.0_ReKi + z%DummyConstrState = 0.0_ReKi + + ! Other states (for HSS brake) + OtherState%HSSBrTrq = 0.0_ReKi + OtherState%HSSBrTrqC = 0.0_ReKi + OtherState%SgnPrvLSTQ = 1 + OtherState%SgnLSTQ = 1 + OtherState%n = -1 ! we haven't updated OtherState%xdot, yet + + ! Now initialize the IC array = (/NMX, NMX-1, ... , 1 /) + ! this keeps track of the position in the array of continuous states (stored in other states) + OtherState%IC(1) = SED_NMX + do I = 2,SED_NMX + OtherState%IC(I) = OtherState%IC(I-1) - 1 + enddo + do i = lbound(OtherState%xdot,1), ubound(OtherState%xdot,1) + call SED_CopyContState( x, OtherState%xdot(i), MESH_NEWCOPY, ErrStat3, ErrMsg3) + if ( ErrStat3 >= AbortErrLev ) return + OtherState%xdot(i)%QT( DOF_Az) = x%QDT(DOF_Az) ! first derivative of azimuth state is rotor speed + OtherState%xdot(i)%QDT(DOF_Az) = 0.0_R8Ki ! assume no acceleration at start (brake torque not known) + enddo + end subroutine Init_States + + !> Initialize the meshes + subroutine Init_Mesh(ErrStat3,ErrMSg3) + integer(IntKi), intent( out) :: ErrStat3 + character(*), intent( out) :: ErrMsg3 + real(ReKi) :: Pos(3) + real(ReKi) :: Vec(3) + real(R8Ki) :: VecR8(3) + real(R8Ki) :: R33(3,3) + real(R8Ki) :: R33b(3,3) + real(R8Ki) :: R33c(3,3) + real(R8Ki) :: Orient(3,3) + real(R8Ki) :: RootAz + integer(IntKi) :: i + + !------------------------- + ! Set output platform mesh + call MeshCreate ( BlankMesh = y%PlatformPtMesh & + ,IOS = COMPONENT_OUTPUT & + ,Nnodes = 1 & + ,ErrStat = ErrStat3 & + ,ErrMess = ErrMsg3 & + ,Orientation = .true. & + ,TranslationDisp = .true. & + ,RotationVel = .false. & + ,TranslationVel = .false. & + ,RotationAcc = .false. & + ,TranslationAcc = .false. & + ) + if (errStat3 >= AbortErrLev) return + + ! Position/orientation of ref + Pos = (/ 0.0_ReKi, 0.0_ReKi, 0.0_ReKi /) + call Eye(Orient, ErrStat3, ErrMsg3); if (errStat3 >= AbortErrLev) return + call MeshPositionNode(y%PlatformPtMesh, 1, Pos, errStat3, errMsg3, Orient); if (errStat3 >= AbortErrLev) return + + ! Construct/commit + call MeshConstructElement( y%PlatformPtMesh, ELEMENT_POINT, errStat3, errMsg3, p1=1 ); if (errStat3 >= AbortErrLev) return + call MeshCommit(y%PlatformPtMesh, errStat3, errMsg3 ); if (errStat3 >= AbortErrLev) return + + + !----------------- + ! Set TowerLn2Mesh + call MeshCreate ( BlankMesh = y%TowerLn2Mesh & + ,IOS = COMPONENT_OUTPUT & + ,Nnodes = 2 & + ,ErrStat = ErrStat3 & + ,ErrMess = ErrMsg3 & + ,Orientation = .true. & + ,TranslationDisp = .true. & + ,RotationVel = .false. & + ,TranslationVel = .false. & + ,RotationAcc = .false. & + ,TranslationAcc = .false. & + ) + if (errStat3 >= AbortErrLev) return + + ! Position/orientation of tower base ref + Pos = (/ 0.0_ReKi, 0.0_ReKi, 0.0_ReKi /) + call Eye(Orient, ErrStat3, ErrMsg3); if (errStat3 >= AbortErrLev) return + call MeshPositionNode(y%TowerLn2Mesh, 1, Pos, errStat3, errMsg3, Orient); if (errStat3 >= AbortErrLev) return + + ! Position/orientation of tower top ref + Pos = (/ 0.0_ReKi, 0.0_ReKi, p%TowerHt /) + call Eye(Orient, ErrStat3, ErrMsg3); if (errStat3 >= AbortErrLev) return + call MeshPositionNode(y%TowerLn2Mesh, 2, Pos, errStat3, errMsg3, Orient); if (errStat3 >= AbortErrLev) return + + ! Construct/commit + call MeshConstructElement( y%TowerLn2Mesh, ELEMENT_LINE2, errStat3, errMsg3, p1=1, p2=2 ); if (errStat3 >= AbortErrLev) return + call MeshCommit(y%TowerLn2Mesh, errStat3, errMsg3 ); if (errStat3 >= AbortErrLev) return + + + !------------------------ + ! Set output nacelle mesh -- nacelle yaw dof exists, but no tower top motion + call MeshCreate ( BlankMesh = y%NacelleMotion & + ,IOS = COMPONENT_OUTPUT & + ,Nnodes = 1 & + ,ErrStat = ErrStat3 & + ,ErrMess = ErrMsg3 & + ,Orientation = .true. & + ,TranslationDisp = .true. & + ,RotationVel = .true. & + ,TranslationVel = .false. & + ,RotationAcc = .false. & + ,TranslationAcc = .false. & + ) + if (errStat3 >= AbortErrLev) return + + ! Position/orientation of ref + Pos = y%TowerLn2Mesh%Position(1:3,2) ! tower top + call Eye(Orient, ErrStat3, ErrMsg3); if (errStat3 >= AbortErrLev) return + call MeshPositionNode(y%NacelleMotion, 1, Pos, errStat3, errMsg3, Orient); if (errStat3 >= AbortErrLev) return + + ! Construct/commit + call MeshConstructElement( y%NacelleMotion, ELEMENT_POINT, errStat3, errMsg3, p1=1 ); if (errStat3 >= AbortErrLev) return + call MeshCommit(y%NacelleMotion, errStat3, errMsg3 ); if (errStat3 >= AbortErrLev) return + + + !-------------------------- + ! Set hub point motion mesh + call MeshCreate ( BlankMesh = y%HubPtMotion & + ,IOS = COMPONENT_OUTPUT & + ,Nnodes = 1 & + ,ErrStat = ErrStat3 & + ,ErrMess = ErrMsg3 & + ,Orientation = .true. & + ,TranslationDisp = .true. & + ,RotationVel = .true. & + ,TranslationVel = .true. & + ,RotationAcc = .true. & + ,TranslationAcc = .true. & ! gets set automatically + ) + if (errStat3 >= AbortErrLev) return + + ! Position/orientation of ref + Pos = y%NacelleMotion%Position(1:3,1) + (/ cos(p%ShftTilt) * p%OverHang, 0.0_ReKi, p%Twr2Shft + sin(p%ShftTilt) * p%OverHang/) + Orient = EulerConstruct( (/ 0.0_R8Ki, -real(p%ShftTilt,R8Ki), 0.0_R8Ki /) ) + call MeshPositionNode(y%HubPtMotion, 1, Pos, errStat3, errMsg3, Orient); if (errStat3 >= AbortErrLev) return + + ! Construct/commit + call MeshConstructElement( y%HubPtMotion, ELEMENT_POINT, errStat3, errMsg3, p1=1 ); if (errStat3 >= AbortErrLev) return + call MeshCommit(y%HubPtMotion, errStat3, errMsg3 ); if (errStat3 >= AbortErrLev) return + + + !-------------------- + ! Set BladeRootMotion + allocate( y%BladeRootMotion(p%NumBl), Stat=ErrStat3 ) + if (ErrStat3 /=0) then + ErrStat3 = ErrID_Fatal + ErrMsg3 = "Could not allocate y%BladeRootMotion mesh" + return + endif + do i=1,p%NumBl + call MeshCreate ( BlankMesh = y%BladeRootMotion(i) & + ,IOS = COMPONENT_OUTPUT & + ,Nnodes = 1 & + ,ErrStat = ErrStat3 & + ,ErrMess = ErrMsg3 & + ,Orientation = .true. & + ,TranslationDisp = .true. & + ,RotationVel = .true. & + ,TranslationVel = .true. & + ,RotationAcc = .true. & + ,TranslationAcc = .true. & + ) + if (errStat3 >= AbortErrLev) return + + ! For blade 1, the reference orientation is the hub reference orientation + ! tilted about the hub y axis by the precone angle. Using the Rodrigues + ! formula for rotating about the hub y + R33(1:3,1:3) = SkewSymMat( y%HubPtMotion%RefOrientation(2,1:3,1) ) ! y axis + call Eye(R33b,ErrStat3,ErrMsg3); if (errStat3 >= AbortErrLev) return + ! Rodrigues formula for rotation about a vector + R33b = R33b + sin(real(p%PreCone,R8Ki)) * R33 + (1-cos(real(p%PreCone,R8Ki))) * matmul(R33,R33) + ! apply to ref orientation of hub + Orient = matmul(y%HubPtMotion%RefOrientation(1:3,1:3,1),transpose(R33b)) + + ! now apply azimuth rotation about hub X + RootAz = real((i-1),R8Ki) * TwoPi_R8 / real(p%NumBl,R8Ki) + R33c(1:3,1:3) = SkewSymMat( y%HubPtMotion%RefOrientation(1,1:3,1) ) ! x axis + call Eye(R33b,ErrStat3,ErrMsg3); if (errStat3 >= AbortErrLev) return + ! Rodrigues formula for rotation about a vector + R33b = R33b + sin(RootAz) * R33c + (1-cos(RootAz)) * matmul(R33c,R33c) + ! apply to orientation with cone + Orient = matmul(Orient,transpose(R33b)) + + ! for position, just locate along the Z axis + Pos = y%HubPtMotion%Position(1:3,1) + p%HubRad * real(Orient(3,1:3), ReKi) + + ! no blade pitch in the reference + call MeshPositionNode(y%BladeRootMotion(i), 1, Pos, errStat3, errMsg3, Orient); if (errStat3 >= AbortErrLev) return + ! Construct/commit + call MeshConstructElement( y%BladeRootMotion(i), ELEMENT_POINT, errStat3, errMsg3, p1=1 ); if (errStat3 >= AbortErrLev) return + call MeshCommit(y%BladeRootMotion(i), errStat3, errMsg3 ); if (errStat3 >= AbortErrLev) return + enddo + + ! set hub load input mesh + call MeshCopy ( SrcMesh = y%HubPtMotion & + , DestMesh = u%HubPtLoad & + , CtrlCode = MESH_SIBLING & + , IOS = COMPONENT_INPUT & + , Force = .TRUE. & + , Moment = .TRUE. & + , ErrStat = ErrStat3 & + , ErrMess = ErrMsg3 ) + if (ErrStat3 >= AbortErrLev) return + end subroutine Init_Mesh + + !> Initialize the inputs in u + subroutine Init_U(ErrStat3,ErrMsg3) + integer(IntKi), intent( out) :: ErrStat3 + character(*), intent( out) :: ErrMsg3 + + u%GenTrq = 0.0_ReKi + call AllocAry( u%BlPitchCom, p%NumBl, 'u%BlPitchCom', ErrStat3, ErrMsg3 ); if (errStat3 >= AbortErrLev) return + u%BlPitchCom= InputFileData%BlPitch + u%YawPosCom = InputFileData%NacYaw + u%YawRateCom= 0.0_ReKi + + return + end subroutine Init_U + + !> Initialize miscvars + subroutine Init_Misc(ErrStat3,ErRMsg3) + integer(IntKi), intent( out) :: ErrStat3 + character(*), intent( out) :: ErrMsg3 + integer(IntKi) :: i + ErrStat3 = ErrID_None + ErrMsg3 = "" + + !-------------- + ! Mesh mappings + ! These mesh mappings are only valid for the reference frames. During CalcOutput, we will use this mapping + ! to update the fields on the next connected mesh, then manually add values like yaw or pitch. Mapping to + ! the next connection point will propogate these changes forward. + + ! map platform to tower + ! NOTE: this mesh is never needed since Platform Pitch is constant + !call MeshMapCreate( y%PlatformPtMesh, y%TowerLn2Mesh, m%mapPtf2Twr, Errstat3, ErrMsg3 ); if (errStat3 >= AbortErrLev) return + + ! map Tower to nacelle (does not account for yaw rotation, add manually at calcoutput) + ! NOTE: this mesh mapping is not actually needed since constant platform pitch and no tower flexibility + !call MeshMapCreate( y%TowerLn2Mesh, y%NacelleMotion, m%mapTwr2Nac, Errstat3, ErrMsg3 ); if (errStat3 >= AbortErrLev) return + + ! map nacelle to hub (does not account for hub rotation, add manually at calcoutput) + call MeshMapCreate( y%NacelleMotion, y%HubPtMotion, m%mapNac2Hub, Errstat3, ErrMsg3 ); if (errStat3 >= AbortErrLev) return + + ! map hub to blade roots (does not account for blade pitch, add manually at calcoutput) + allocate(m%mapHub2Root(p%NumBl),STAT=ErrStat3) + if (ErrStat3 /= 0) then + ErrStat3 = ErrID_Fatal + ErrMsg3 = "Cannot allocate m%mapHub2Root" + return + endif + do i=1,p%NumBl + call MeshMapCreate( y%HubPtMotion, y%BladeRootMotion(i), m%mapHub2Root(i), Errstat3, ErrMsg3 ); if (errStat3 >= AbortErrLev) return + enddo + + ! outputs + if (allocated(m%AllOuts)) deallocate(m%AllOuts) + allocate(m%AllOuts(0:MaxOutPts),STAT=ErrStat3) + if (ErrStat3 /= 0) then + ErrStat3 = ErrID_Fatal + ErrMsg3 = "Cannot allocate m%AllOuts" + return + endif + m%AllOuts = 0.0_SiKi + + ! 2nd derivative (acceleration matrix) -- used only in HSS Brake + call AllocAry( m%QD2T, 1, 'm%QD2T', ErrStat3, ErrMsg3); if (ErrStat3 >= AbortErrLev) return + m%QD2T = 0.0_R8Ki + end subroutine Init_Misc + + !> Initialize the InitOutput + subroutine Init_InitY(ErrStat3,ErrMsg3) + integer(IntKi), intent( out) :: ErrStat3 + character(*), intent( out) :: ErrMsg3 + real(R8Ki) :: theta(3) + integer(IntKi) :: i + call AllocAry(InitOut%WriteOutputHdr,p%NumOuts,'WriteOutputHdr',ErrStat3,ErrMsg3); if (errStat3 >= AbortErrLev) return + call AllocAry(InitOut%WriteOutputUnt,p%NumOuts,'WriteOutputUnt',ErrStat3,ErrMsg3); if (errStat3 >= AbortErrLev) return + do i=1,p%NumOuts + InitOut%WriteOutputHdr(i) = p%OutParam(i)%Name + InitOut%WriteOutputUnt(i) = p%OutParam(i)%Units + end do + ! Version + InitOut%Ver = SED_Ver + ! Turbine config + InitOut%NumBl = p%NumBl + InitOut%BladeLength = p%BladeLength + InitOut%TowerHt = p%TowerHt + InitOut%HubHt = p%HubHt + InitOut%HubRad = p%HubRad + InitOut%GenDOF = p%GenDOF + + call AllocAry( InitOut%BlPitch, p%NumBl, 'InitOut%BlPitch', ErrStat3, ErrMsg3 ); if (errStat3 >= AbortErrLev) return + InitOut%BlPitch = InputFileData%BlPitch + InitOut%RotSpeed = x%QDT(DOF_Az) + InitOut%PlatformPos(1:3) = real(y%PlatformPtMesh%Position(1:3,1), ReKi) + real(y%PlatformPtMesh%TranslationDisp(1:3,1), ReKi) + theta(1:3) = GetSmllRotAngs(y%PlatformPtMesh%Orientation(1:3,1:3,1), ErrStat3, ErrMsg3); if (errStat3 >= AbortErrLev) return + InitOut%PlatformPos(4:6) = real(theta, ReKi) + end subroutine Init_InitY + + !> Initialize the outputs in Y + subroutine Init_Y(ErrStat3,ErrMSg3) + integer(IntKi), intent( out) :: ErrStat3 + character(*), intent( out) :: ErrMsg3 + !-------- + call AllocAry( y%BlPitch, p%NumBl, 'y%BlPitch', ErrStat3, ErrMsg3 ); if (errStat3 >= AbortErrLev) return + + !-------- + ! Outputs + call AllocAry(y%WriteOutput,p%NumOuts,'WriteOutput',Errstat3,ErrMsg3); if (ErrStat3 >= AbortErrLev) return + y%WriteOutput = 0.0_ReKi + + ! Set the meshes with initial conditions + call SED_CalcOutput( 0.0_DbKi, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) + end subroutine Init_Y + +END SUBROUTINE SED_Init + + +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine is called at the end of the simulation. +SUBROUTINE SED_End( u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) + type(SED_InputType), intent(inout) :: u !< System inputs + type(SED_ParameterType), intent(inout) :: p !< Parameters + type(SED_ContinuousStateType), intent(inout) :: x !< Continuous states + type(SED_DiscreteStateType), intent(inout) :: xd !< Discrete states + type(SED_ConstraintStateType), intent(inout) :: z !< Constraint states + type(SED_OtherStateType), intent(inout) :: OtherState !< Other states + type(SED_OutputType), intent(inout) :: y !< System outputs + type(SED_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 = 'SED_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 SED_DestroyInput( u, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + ! Destroy the parameter data: + call SED_DestroyParam( p, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + ! Destroy the state data: + call SED_DestroyContState( x, ErrStat2,ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + call SED_DestroyDiscState( xd, ErrStat2,ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + call SED_DestroyConstrState( z, ErrStat2,ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + call SED_DestroyOtherState( OtherState, ErrStat2,ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + ! Destroy the output data: + call SED_DestroyOutput( y, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + ! Destroy the misc data: + call SED_DestroyMisc( m, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) +END SUBROUTINE SED_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 SED_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 step of the simulation: t = n*Interval + type(SED_InputType), intent(inout) :: u(:) !< Inputs at InputTimes (output for mesh connect) + real(DbKi), intent(in ) :: uTimes(:) !< Times in seconds associated with Inputs + type(SED_ParameterType), intent(in ) :: p !< Parameters + type(SED_ContinuousStateType), intent(inout) :: x !< Input: Continuous states at t; + type(SED_DiscreteStateType), intent(inout) :: xd !< Input: Discrete states at t; + type(SED_ConstraintStateType), intent(inout) :: z !< Input: Constraint states at t; + type(SED_OtherStateType), intent(inout) :: OtherState !< Other states: Other states at t; + type(SED_MiscVarType), intent(inout) :: m !< Misc variables for optimization + 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 = 'SED_UpdateStates' + + ! Initialize variables + ErrStat = ErrID_None ! no error has occurred + ErrMsg = "" + + ! Simple case of constant RPM + if (.not. p%GenDOF) then + + ! Azimuth angle -- step from n to n+1 + x%QT( DOF_Az) = p%InitAzimuth + x%QDT(DOF_Az) * real(n+1,R8Ki) * p%DT + ! Rotor speed: constant in this case + !x%QDT(DOF_Az) = x%QDT(DOF_Az) + + else + + select case (p%IntMethod) + case (Method_RK4) + call SED_RK4( t, n, u, utimes, p, x, xd, z, OtherState, m, ErrStat2, ErrMsg2 ) + case (Method_AB4) + call SED_AB4( t, n, u, utimes, p, x, xd, z, OtherState, m, ErrStat2, ErrMsg2 ) + case (Method_ABM4) + call SED_ABM4( t, n, u, utimes, p, x, xd, z, OtherState, m, ErrStat2, ErrMsg2 ) + case default + ErrStat = ErrID_Fatal + ErrMsg = ' Error in SED_UpdateStates: p%method must be 1 (RK4), 2 (AB4), or 3 (ABM4)' + return + end select + + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + endif +end subroutine SED_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 SED_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(SED_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(SED_ParameterType), intent(in ) :: p !< Parameters + type(SED_ContinuousStateType), intent(inout) :: x !< Continuous states at t on input at t + dt on output + type(SED_DiscreteStateType), intent(in ) :: xd !< Discrete states at t + type(SED_ConstraintStateType), intent(in ) :: z !< Constraint states at t (possibly a guess) + type(SED_OtherStateType), intent(inout) :: OtherState !< Other states + type(SED_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(SED_ContinuousStateType) :: xdot ! time derivatives of continuous states + type(SED_ContinuousStateType) :: k1 ! RK4 constant; see above + type(SED_ContinuousStateType) :: k2 ! RK4 constant; see above + type(SED_ContinuousStateType) :: k3 ! RK4 constant; see above + type(SED_ContinuousStateType) :: k4 ! RK4 constant; see above + type(SED_ContinuousStateType) :: x_tmp ! Holds temporary modification to x + type(SED_InputType) :: u_interp ! interpolated value of inputs + integer(IntKi) :: ErrStat2 ! local error status + character(ErrMsgLen) :: ErrMsg2 ! local error message (ErrMsg) + character(*), parameter :: RoutineName = 'RK4' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" + + call SED_CopyContState( x, k1, MESH_NEWCOPY, ErrStat2, ErrMsg2 ); if (Failed()) return + call SED_CopyContState( x, k2, MESH_NEWCOPY, ErrStat2, ErrMsg2 ); if (Failed()) return + call SED_CopyContState( x, k3, MESH_NEWCOPY, ErrStat2, ErrMsg2 ); if (Failed()) return + call SED_CopyContState( x, k4, MESH_NEWCOPY, ErrStat2, ErrMsg2 ); if (Failed()) return + call SED_CopyContState( x, x_tmp, MESH_NEWCOPY, ErrStat2, ErrMsg2 ); if (Failed()) return + call SED_CopyInput( u(1), u_interp, MESH_NEWCOPY, ErrStat2, ErrMsg2 ); if (Failed()) return + + ! interpolate u to find u_interp = u(t) + call SED_Input_ExtrapInterp( u, utimes, u_interp, t, ErrStat2, ErrMsg2 ); if (Failed()) return + OtherState%HSSBrTrq = u_interp%HSSBrTrqC + + ! find xdot at t + call SED_CalcContStateDeriv( t, u_interp, p, x, xd, z, OtherState, m, xdot, ErrStat2, ErrMsg2 ) + if (Failed()) return + k1%qt = p%dt * xdot%qt + k1%qdt = p%dt * xdot%qdt + + x_tmp%qt = x%qt + 0.5 * k1%qt + x_tmp%qdt = x%qdt + 0.5 * k1%qdt + + ! interpolate u to find u_interp = u(t + dt/2) + call SED_Input_ExtrapInterp(u, utimes, u_interp, t+0.5*p%dt, ErrStat2, ErrMsg2) + if (Failed()) return + + ! find xdot at t + dt/2 + call SED_CalcContStateDeriv( t + 0.5*p%dt, u_interp, p, x_tmp, xd, z, OtherState, m, xdot, ErrStat2, ErrMsg2 ) + if (Failed()) return + + k2%qt = p%dt * xdot%qt + k2%qdt = p%dt * xdot%qdt + + x_tmp%qt = x%qt + 0.5 * k2%qt + x_tmp%qdt = x%qdt + 0.5 * k2%qdt + + ! find xdot at t + dt/2 + call SED_CalcContStateDeriv( t + 0.5*p%dt, u_interp, p, x_tmp, xd, z, OtherState, m, xdot, ErrStat2, ErrMsg2 ) + if (Failed()) return + + k3%qt = p%dt * xdot%qt + k3%qdt = p%dt * xdot%qdt + + x_tmp%qt = x%qt + k3%qt + x_tmp%qdt = x%qdt + k3%qdt + + ! interpolate u to find u_interp = u(t + dt) + CALL SED_Input_ExtrapInterp(u, utimes, u_interp, t + p%dt, ErrStat2, ErrMsg2) + if (Failed()) return + + ! find xdot at t + dt + call SED_CalcContStateDeriv( t + p%dt, u_interp, p, x_tmp, xd, z, OtherState, m, xdot, ErrStat2, ErrMsg2 ) + if (Failed()) return + + k4%qt = p%dt * xdot%qt + k4%qdt = p%dt * xdot%qdt + + x%qt = x%qt + ( k1%qt + 2. * k2%qt + 2. * k3%qt + k4%qt ) / 6. + x%qdt = x%qdt + ( k1%qdt + 2. * k2%qdt + 2. * k3%qdt + k4%qdt ) / 6. + + 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() + integer(IntKi) :: ErrStat3 ! The error identifier (ErrStat) + character(ErrMsgLen) :: ErrMsg3 ! The error message (ErrMsg) + call SED_DestroyContState( xdot, ErrStat3, ErrMsg3 ) + call SED_DestroyContState( k1, ErrStat3, ErrMsg3 ) + call SED_DestroyContState( k2, ErrStat3, ErrMsg3 ) + call SED_DestroyContState( k3, ErrStat3, ErrMsg3 ) + call SED_DestroyContState( k4, ErrStat3, ErrMsg3 ) + call SED_DestroyContState( x_tmp, ErrStat3, ErrMsg3 ) + call SED_DestroyInput( u_interp, ErrStat3, ErrMsg3 ) + end subroutine CleanUp +end subroutine SED_RK4 + + +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine is used to adjust the HSSBrTrq value if the absolute +!! magnitudue of the HSS brake torque was strong enough to reverse +!! the direction of the HSS, which is a physically impossible +!! situation. The problem arises since we are integrating in +!! discrete time, not continuous time. +subroutine FixHSSBrTq ( Integrator, u, p, x, OtherState, m, ErrStat, ErrMsg ) + type(SED_InputType), intent(in ) :: u !< Inputs at t + type(SED_ParameterType), intent(in ) :: p !< Parameters of the structural dynamics module + type(SED_OtherStateType), intent(inout) :: OtherState !< Other states of the structural dynamics module + type(SED_MiscVarType), intent(inout) :: m !< misc (optimization) variables + type(SED_ContinuousStateType), intent(inout) :: x !< Continuous states of the structural dynamics module at n+1 + character(1), intent(in ) :: Integrator !< A string holding the current integrator being used. + integer(IntKi), intent( out) :: ErrStat !< Error status of the operation + character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + real(ReKi) :: RqdFrcAz ! The force term required to produce RqdQD2Az. + real(ReKi) :: RqdQD2Az ! The required QD2T(DOF_Az) to cause the HSS to stop rotating. + real(ReKi) :: GenTrqLSS ! Generator torque, expressed on LSS + real(ReKi) :: BrkTrqLSS ! HSS brake torque, expressed on LSS + real(ReKi) :: AeroTrq ! AeroDynamic torque -- passed in on HubPt + integer :: I ! Loops through all DOFs. + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FixHSSBrTq' + + ErrStat = ErrID_None + ErrMsg = "" + + if ( (.not. p%GenDOF) .OR. EqualRealNos(OtherState%HSSBrTrqC, 0.0_ReKi ) ) return + + ! The absolute magnitude of the HSS brake must have been too great + ! that the HSS direction was reversed. What should have happened + ! is that the HSS should have stopped rotating. In other words, + ! QD(DOF_Az,IC(NMX)) should equal zero! Determining what + ! QD2T(DOF_Az) will make QD(DOF_Az,IC(NMX)) = 0, depends on + ! which integrator we are using. + select case (Integrator) + case ('C') ! Corrector + ! Find the required QD2T(DOF_Az) to cause the HSS to stop rotating (RqdQD2Az). + ! This is found by solving the corrector formula for QD2(DOF_Az,IC(NMX)) + ! when QD(DOF_Az,IC(NMX)) equals zero. + RqdQD2Az = ( - OtherState%xdot(OtherState%IC(1))%qt (DOF_Az)/ p%DT24 & + - 19.0*OtherState%xdot(OtherState%IC(1))%qdt(DOF_Az) & + + 5.0*OtherState%xdot(OtherState%IC(2))%qdt(DOF_Az) & + - OtherState%xdot(OtherState%IC(3))%qdt(DOF_Az) ) / 9.0 + + case ('P') ! Predictor + ! Find the required QD2T(DOF_Az) to cause the HSS to stop rotating (RqdQD2Az). + ! This is found by solving the predictor formula for QD2(DOF_Az,IC(1)) + ! when QD(DOF_Az,IC(NMX)) equals zero. + + RqdQD2Az = ( - OtherState%xdot(OtherState%IC(1))%qt( DOF_Az) / p%DT24 & + + 59.0*OtherState%xdot(OtherState%IC(2))%qdt(DOF_Az) & + - 37.0*OtherState%xdot(OtherState%IC(3))%qdt(DOF_Az) & + + 9.0*OtherState%xdot(OtherState%IC(4))%qdt(DOF_Az) )/55.0 + end select + + ! Rearrange the equations of motion to account + ! for the known acceleration of the azimuth DOF. To + ! do this, make the known inertia like an applied force to the + ! system. + !! + !! \f$ F = Q_a - \ddot{\psi} J_\text{DT} - Q_g - Q_b \f$ + !! + !! where + !! - \f$F\f$ is the additional force required to make the rotor stop + !! - \f$J_\text{DT}\f$ is the system inertia + !! - \f$Q_g = n_g Q_{g,\text{HSS}}\f$ is the generator torque projected to the LSS + !! - \f$Q_b = n_g Q_{b,\text{HSS}}\f$ is the HSS brake torque projected to the LSS + !! + + ! Find the force required to produce RqdQD2Az from the equations of + ! motion using the new accelerations: + GenTrqLSS = p%GBoxRatio * u%GenTrq + BrkTrqLSS = p%GBoxRatio * OtherState%HSSBrTrqC + AeroTrq = dot_product(u%HubPtLoad%Moment(:,1), m%HubPt_X(1:3)) ! torque about hub X + RqdFrcAz = RqdQD2Az * p%J_DT - AeroTrq + GenTrqLSS + BrkTrqLSS + + ! Find the HSSBrTrq necessary to bring about this force: + OtherState%HSSBrTrq = OtherState%HSSBrTrqC - RqdFrcAz/ABS(p%GBoxRatio) + + ! Make sure this new HSSBrTrq isn't larger in absolute magnitude than + ! the original HSSBrTrq. Indeed, the new HSSBrTrq can't be larger than + ! the old HSSBrTrq, since the old HSSBrTrq was found solely as a + ! function of time--and is thus the maximum possible at the current + ! time. If the new HSSBrTrq is larger, then the reversal in direction + ! was caused by factors other than the HSS brake--thus the original HSS + ! brake torque values were OK to begin with. Thus, restore the + ! variables changed by this subroutine, back to their original values: + if ( abs( OtherState%HSSBrTrq ) > abs( OtherState%HSSBrTrqC ) ) then + OtherState%HSSBrTrq = OtherState%HSSBrTrqC !OtherState%HSSBrTrqC = SIGN( u%HSSBrTrqC, x%QDT(DOF_Az) ) + else + ! overwrite QD2T with the new values + m%QD2T(DOF_Az) = RqdQD2Az + + ! Use the new accelerations to update the DOF values. Again, this + ! depends on the integrator type: + SELECT CASE (Integrator) + case ('C') ! Corrector + ! Update QD and QD2 with the new accelerations using the corrector. + ! This will make QD(DOF_Az,IC(NMX)) equal to zero and adjust all + ! of the other QDs as necessary. + ! The Q's are unnaffected by this change. + x%qdt = OtherState%xdot(OtherState%IC(1))%qt & ! qd at n + + p%DT24 * ( 9. * m%QD2T & ! the value we just changed + + 19. * OtherState%xdot(OtherState%IC(1))%qdt & + - 5. * OtherState%xdot(OtherState%IC(2))%qdt & + + 1. * OtherState%xdot(OtherState%IC(3))%qdt ) + case ('P') ! Predictor + ! Update QD and QD2 with the new accelerations using predictor. + x%qdt = OtherState%xdot(OtherState%IC(1))%qt + & ! qd at n + p%DT24 * ( 55.*m%QD2T & ! the value we just changed + - 59.*OtherState%xdot(OtherState%IC(2))%qdt & + + 37.*OtherState%xdot(OtherState%IC(3))%qdt & + - 9.*OtherState%xdot(OtherState%IC(4))%qdt ) + + OtherState%xdot ( OtherState%IC(1) )%qdt = m%QD2T ! fix the history + end select + endif + return +end subroutine FixHSSBrTq + + +!---------------------------------------------------------------------------------------------------------------------------------- +!> This function calculates the sign (+/-1) of the low-speed shaft torque for +!! this time step. MomLPRot is the moment on the +!! low-speed shaft at the teeter pin caused by the rotor. +function SignLSSTrq( u, p, m ) + type(SED_InputType), intent(in) :: u !< Inputs at t (out only for mesh record-keeping in ExtrapInterp routine) + type(SED_ParameterType), intent(in) :: p !< Parameters + type(SED_MiscVarType), intent(in) :: m !< Misc variables + integer(IntKi) :: SignLSSTrq !< The sign of the LSS_Trq, output from this function + real(ReKi) :: MomLPRot ! The total moment on the low-speed shaft at point P caused by the rotor. + real(ReKi) :: GenTrqLSS ! Generator torque, expressed on LSS + real(ReKi) :: BrkTrqLSS ! HSS brake torque, expressed on LSS + real(ReKi) :: AeroTrq ! AeroDynamic torque -- passed in on HubPt + + GenTrqLSS = p%GBoxRatio * u%GenTrq + BrkTrqLSS = p%GBoxRatio * u%HSSBrTrqC + AeroTrq = dot_product(u%HubPtLoad%Moment(:,1), m%HubPt_X(1:3)) ! torque about hub X + MomLPRot = AeroTrq - GenTrqLSS - BrkTrqLSS + + ! MomLProt has now been found. Now dot this with e1 to get the + ! low-speed shaft torque and take the SIGN of the result: + SignLSSTrq = nint( sign( 1.0_ReKi,MomLPRot )) +end function SignLSSTrq + + +!---------------------------------------------------------------------------------------------------------------------------------- +!> This subroutine implements the fourth-order Adams-Bashforth Method (AB4) 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 +!! +!! or +!! +!! K. E. Atkinson, "An Introduction to Numerical Analysis", 1989, John Wiley & Sons, Inc, Second Edition. +subroutine SED_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(SED_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(SED_ParameterType), intent(in ) :: p !< Parameters + type(SED_ContinuousStateType), intent(inout) :: x !< Continuous states at t on input at t + dt on output + type(SED_DiscreteStateType), intent(in ) :: xd !< Discrete states at t + type(SED_ConstraintStateType), intent(in ) :: z !< Constraint states at t (possibly a guess) + type(SED_OtherStateType), intent(inout) :: OtherState !< Other states + type(SED_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(SED_InputType) :: u_interp + type(SED_ContinuousStateType) :: xdot + integer(IntKi) :: ErrStat2 ! local error status + character(ErrMsgLen) :: ErrMsg2 ! local error message (ErrMsg) + character(*), parameter :: RoutineName = 'AB4' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" + + if (OtherState%n .lt. n) then + OtherState%n = n + ! Update IC() index so IC(1) is the location of xdot values at n. + ! (this allows us to shift the indices into the array, not copy all of the values) + OtherState%IC = CSHIFT( OtherState%IC, -1 ) ! circular shift of all values to the right + elseif (OtherState%n .gt. n) then + ErrStat2 = ErrID_Fatal + ErrMsg2 = ' Backing up in time is not supported with a multistep method.' + if (Failed()) return + endif + + ! Allocate the input arrays + call SED_CopyInput( u(1), u_interp, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) + if (Failed()) return + + ! need xdot at t + call SED_Input_ExtrapInterp(u, utimes, u_interp, t, ErrStat2, ErrMsg2) + if (Failed()) return + + if (EqualRealNos( x%qdt(DOF_Az) ,0.0_R8Ki ) ) then + OtherState%HSSBrTrqC = u_interp%HSSBrTrqC + else + OtherState%HSSBrTrqC = SIGN( u_interp%HSSBrTrqC, real(x%qdt(DOF_Az),ReKi) ) ! hack for HSS brake (need correct sign) + endif + OtherState%HSSBrTrq = OtherState%HSSBrTrqC + OtherState%SgnPrvLSTQ = OtherState%SgnLSTQ(OtherState%IC(2)) + + call SED_CalcContStateDeriv( t, u_interp, p, x, xd, z, OtherState, m, xdot, ErrStat2, ErrMsg2 ) + if (Failed()) return + + call SED_CopyContState(xdot, OtherState%xdot ( OtherState%IC(1) ), MESH_NEWCOPY, ErrStat2, ErrMsg2) + if (Failed()) return + + if (n .le. 3) then ! to fully populate through IC(4), must use RK4 three times + call SED_RK4(t, n, u, utimes, p, x, xd, z, OtherState, m, ErrStat2, ErrMsg2 ) + if (Failed()) return + else + x%qt = x%qt + p%DT24 * ( 55.*OtherState%xdot(OtherState%IC(1))%qt - 59.*OtherState%xdot(OtherState%IC(2))%qt & + + 37.*OtherState%xdot(OtherState%IC(3))%qt - 9.*OtherState%xdot(OtherState%IC(4))%qt ) + + x%qdt = x%qdt + p%DT24 * ( 55.*OtherState%xdot(OtherState%IC(1))%qdt - 59.*OtherState%xdot(OtherState%IC(2))%qdt & + + 37.*OtherState%xdot(OtherState%IC(3))%qdt - 9.*OtherState%xdot(OtherState%IC(4))%qdt ) + + ! Make sure the HSS brake will not reverse the direction of the HSS + ! for the next time step. Do this by computing the predicted value + ! of x%qt(); QD(DOF_Az,IC(NMX)) as will be done during the next time step. + ! Only do this after the first few time steps since it doesn't work + ! for the Runga-Kutta integration scheme. + call FixHSSBrTq ( 'P', u_interp, p, x, OtherState, m, ErrStat2, ErrMsg2 ) + if (Failed()) return + endif + + OtherState%SgnPrvLSTQ = SignLSSTrq(u_interp, p, m) + OtherState%SgnLSTQ(OtherState%IC(1)) = OtherState%SgnPrvLSTQ + + 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() + integer(IntKi) :: ErrStat3 ! The error identifier (ErrStat) + character(ErrMsgLen) :: ErrMsg3 ! The error message (ErrMsg) + call SED_DestroyInput( u_interp, ErrStat3, ErrMsg3 ) + call SED_DestroyContState( xdot, ErrStat2, ErrMsg3 ) + end subroutine CleanUp +end subroutine SED_AB4 + + +!---------------------------------------------------------------------------------------------------------------------------------- +!> This subroutine implements the fourth-order Adams-Bashforth-Moulton Method (ABM4) for numerically integrating ordinary +!! differential equations: +!! +!! Let f(t, x) = xdot denote the time (t) derivative of the continuous states (x). +!! +!! Adams-Bashforth Predictor: \n +!! 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: \n +!! 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 +!! +!! or +!! +!! K. E. Atkinson, "An Introduction to Numerical Analysis", 1989, John Wiley & Sons, Inc, Second Edition. +subroutine SED_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(SED_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(SED_ParameterType), intent(in ) :: p !< Parameters + type(SED_ContinuousStateType), intent(inout) :: x !< Continuous states at t on input at t + dt on output + type(SED_DiscreteStateType), intent(in ) :: xd !< Discrete states at t + type(SED_ConstraintStateType), intent(in ) :: z !< Constraint states at t (possibly a guess) + type(SED_OtherStateType), intent(inout) :: OtherState !< Other states + type(SED_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(SED_InputType) :: u_interp ! Inputs at t + type(SED_ContinuousStateType) :: x_pred ! Continuous states at t + type(SED_ContinuousStateType) :: xdot_pred ! Derivative of continuous states at t + integer(IntKi) :: ErrStat2 ! local error status + character(ErrMsgLen) :: ErrMsg2 ! local error message (ErrMsg) + character(*), parameter :: RoutineName = 'ABM4' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" + + ! Predict: + call SED_CopyContState(x, x_pred, MESH_NEWCOPY, ErrStat2, ErrMsg2) + if (Failed()) return + + call SED_AB4( t, n, u, utimes, p, x_pred, xd, z, OtherState, m, ErrStat2, ErrMsg2 ) + if (Failed()) return + + ! Correct: + if (n .gt. 2_IntKi) then + ! allocate the arrays in u_interp + call SED_CopyInput( u(1), u_interp, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) + if (Failed()) return + + call SED_Input_ExtrapInterp(u, utimes, u_interp, t + p%dt, ErrStat2, ErrMsg2) + if (Failed()) return + + u_interp%HSSBrTrqC = max(0.0_ReKi, min(u_interp%HSSBrTrqC, ABS( OtherState%HSSBrTrqC) )) ! hack for extrapolation of limits (OtherState%HSSBrTrqC is HSSBrTrqC at t) + if (EqualRealNos( x_pred%qdt(DOF_Az) ,0.0_R8Ki ) ) then + OtherState%HSSBrTrqC = u_interp%HSSBrTrqC + else + OtherState%HSSBrTrqC = SIGN( u_interp%HSSBrTrqC, real(x_pred%qdt(DOF_Az),ReKi) ) ! hack for HSS brake (need correct sign) + endif + OtherState%HSSBrTrq = OtherState%HSSBrTrqC + + call SED_CalcContStateDeriv(t + p%dt, u_interp, p, x_pred, xd, z, OtherState, m, xdot_pred, ErrStat2, ErrMsg2 ) + if (Failed()) return + + x%qt = x%qt + p%DT24 * ( 9. * xdot_pred%qt + 19. * OtherState%xdot(OtherState%IC(1))%qt & + - 5. * OtherState%xdot(OtherState%IC(2))%qt & + + 1. * OtherState%xdot(OtherState%IC(3))%qt ) + + x%qdt = x%qdt + p%DT24 * ( 9. * xdot_pred%qdt + 19. * OtherState%xdot(OtherState%IC(1))%qdt & + - 5. * OtherState%xdot(OtherState%IC(2))%qdt & + + 1. * OtherState%xdot(OtherState%IC(3))%qdt ) + + ! Make sure the HSS brake has not reversed the direction of the HSS: + call FixHSSBrTq ( 'C', u_interp, p, x, OtherState, m, ErrStat2, ErrMsg2 ) + if (Failed()) return; + OtherState%SgnPrvLSTQ = SignLSSTrq(u_interp, p, m) + OtherState%SgnLSTQ(OtherState%IC(1)) = OtherState%SgnPrvLSTQ + else + x%qt = x_pred%qt + x%qdt = x_pred%qdt + endif + + call Cleanup() + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + if (Failed) call CleanUp() + end function Failed + subroutine CleanUp() + integer(IntKi) :: ErrStat3 ! The error identifier (ErrStat) + character(ErrMsgLen) :: ErrMsg3 ! The error message (ErrMsg) + call SED_DestroyContState( xdot_pred, ErrStat3, ErrMsg3 ) + call SED_DestroyContState( x_pred, ErrStat3, ErrMsg3 ) + call SED_DestroyInput( u_interp, ErrStat3, ErrMsg3 ) + end subroutine CleanUp +end subroutine SED_ABM4 + + +!---------------------------------------------------------------------------------------------------------------------------------- +!> This is a routine for computing outputs, used in both loose and tight coupling. +SUBROUTINE SED_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, NeedWriteOutput ) + real(DbKi), intent(in ) :: t !< Current simulation time in seconds + type(SED_InputType), intent(in ) :: u !< Inputs at t + type(SED_ParameterType), intent(in ) :: p !< Parameters + type(SED_ContinuousStateType), intent(in ) :: x !< Continuous states at t + type(SED_DiscreteStateType), intent(in ) :: xd !< Discrete states at t + type(SED_ConstraintStateType), intent(in ) :: z !< Constraint states at t + type(SED_OtherStateType), intent(in ) :: OtherState !< Other states at t + type(SED_MiscVarType), intent(inout) :: m !< Misc variables for optimization (not copied in glue code) + type(SED_OutputType), intent(inout) :: y !< Outputs computed at t (Input only for mesh) + integer(IntKi), intent( out) :: ErrStat !< Error status of the operation + character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + logical, optional, intent(in ) :: NeedWriteOutput !< Flag to determine if WriteOutput values need to be calculated in this call + + ! local variables + integer(IntKi) :: ErrStat2 ! local error status + character(ErrMsgLen) :: ErrMsg2 ! local error message + character(*), parameter :: RoutineName = 'SED_CalcOutput' + real(ReKi) :: Pos(3) + real(R8Ki) :: tmpR8(3) + real(R8Ki) :: R33(3,3) + real(R8Ki) :: R33b(3,3) + real(R8Ki) :: Orient(3,3) + real(ReKi) :: YawRotVel(3) + real(ReKi) :: YawAng + real(ReKi) :: AzRotVel(3) + integer(IntKi) :: i !< Generic counter + logical :: CalcWriteOutput + type(SED_ContinuousStateType) :: dxdt !< Derivatives of continuous states at t + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" + m%AllOuts = 0.0_SiKi + + if (present(NeedWriteOutput)) then + CalcWriteOutput = NeedWriteOutput + else + CalcWriteOutput = .true. ! by default, calculate WriteOutput unless told that we do not need it + end if + + + !--------------------------------------------------------------------------- + ! Meshes + ! The mesh fields will be set explicitely here using the state and input information + + !------------------------- + ! Platform mesh (stionary) + y%PlatformPtMesh%TranslationDisp(1:3,1) = (/ 0.0_R8Ki, 0.0_R8Ki, 0.0_R8Ki /) + + ! Initial orientations + call SmllRotTrans( 'platform displacement (SED)', 0.0_R8Ki, real(p%PtfmPitch,R8Ki), 0.0_R8Ki, & + y%PlatformPtMesh%Orientation(:,:,1), errstat=ErrStat2, errmsg=ErrMsg2 ) + if (Failed()) return; + + + !------------------------- + ! TowerLn2Mesh mesh (stationary also) + ! The lower node stays at the PlatformPtMesh position, + ! Upper node is stationary, but we set it here just in case we later add this DOF + y%TowerLn2Mesh%TranslationDisp(1:3,1) = y%PlatformPtMesh%TranslationDisp(1:3,1) + Pos(1) = sin(p%PtfmPitch)*p%TowerHt + Pos(2) = 0.0_ReKi + Pos(3) = cos(p%PtfmPitch)*p%TowerHt + Pos = Pos - y%TowerLn2Mesh%Position(1:3,2) + y%TowerLn2Mesh%TranslationDisp(1:3,2) = real(Pos,R8Ki) + + ! Initial node orientations (same as ptfm) + y%TowerLn2Mesh%Orientation(:,:,1) = y%PlatformPtMesh%Orientation(:,:,1) + y%TowerLn2Mesh%Orientation(:,:,2) = y%PlatformPtMesh%Orientation(:,:,1) + + + !------------------------- + ! Nacelle mesh position + ! Yaw DOF will enable this to rotate + ! NOTE: we do not make any checks for consistency on the input for YawRate!!!! + y%NacelleMotion%TranslationDisp(1:3,1) = y%TowerLn2Mesh%TranslationDisp(1:3,2) + + if (p%YawDOF) then + YawAng = u%YawPosCom + YawRotVel = (/ 0.0_ReKi, 0.0_ReKi, u%YawRateCom /) ! Nacelle coordinate frame + else + YawAng = p%InitYaw + YawRotVel = (/ 0.0_ReKi, 0.0_ReKi, 0.0_Reki /) + endif + + ! Orientation (rotate about tower top (pitched position) + Orient = EulerConstruct( (/ 0.0_R8Ki, 0.0_R8Ki, real(YawAng,R8Ki) /) ) + y%NacelleMotion%Orientation(:,:,1) = matmul(Orient, y%TowerLn2Mesh%Orientation(:,:,2)) + + ! Nacelle motions + y%NacelleMotion%RotationVel(:,1) = matmul(YawRotVel,real(y%NacelleMotion%Orientation(:,:,1),ReKi)) + + + !-------------------------- + ! Hub point motion mesh + ! Transfer nacelle motions (does not include the hub rotation) + call Transfer_Point_to_Point( y%NacelleMotion, y%HubPtMotion, m%mapNac2Hub, ErrStat2, ErrMsg2 ); if (Failed()) return; + + ! include azimuth -- rotate about Hub_X + R33(1:3,1:3) = SkewSymMat( y%HubPtMotion%Orientation(1,1:3,1) ) ! hub x-axis + call Eye(Orient,ErrStat2,ErrMsg2); if (Failed()) return; + ! Rodrigues formula for rotation about a vector + Orient = Orient + sin(real(x%QT(DOF_Az),R8Ki)) * R33 + (1-cos(real(x%QT(DOF_Az),R8Ki))) * matmul(R33,R33) + y%HubPtMotion%Orientation(1:3,1:3,1) = matmul(y%HubPtMotion%Orientation(1:3,1:3,1),transpose(Orient)) + m%HubPt_X = real(y%HubPtMotion%Orientation(1,1:3,1),ReKi) ! Bit of hack, but storing this for use in FixHSSBrTq + + ! Now include the velocity terms from rotor rotation + AzRotVel = (/ real(x%QDT(DOF_Az),ReKi), 0.0_ReKi, 0.0_ReKi /) ! Hub coordinate frame + y%HubPtMotion%RotationVel(1:3,1) = y%HubPtMotion%RotationVel(1:3,1) + matmul(AzRotVel, real(y%HubPtMotion%Orientation(1:3,1:3,1),ReKi)) + + + !-------------------- + ! Set BladeRootMotion + do i=1,p%NumBl + ! Transfer hub motions (does not include the blade pitch) + call Transfer_Point_to_Point( y%HubPtMotion, y%BladeRootMotion(i), m%mapHub2Root(i), ErrStat2, ErrMsg2 ); if (Failed()) return; + + ! include blade pitch -- rotate about Blade_Z + R33(1:3,1:3) = SkewSymMat( y%BladeRootMotion(i)%Orientation(3,1:3,1) ) ! blade z-axis + call Eye(Orient,ErrStat2,ErrMsg2); if (Failed()) return; + ! Rodrigues formula for rotation about a vector (NOTE: BlPitch does not follow right hand rule) + Orient = Orient + sin(real(-u%BlPitchCom(i),R8Ki)) * R33 + (1-cos(real(-u%BlPitchCom(i),R8Ki))) * matmul(R33,R33) + y%BladeRootMotion(i)%Orientation(1:3,1:3,1) = matmul(y%BladeRootMotion(i)%Orientation(1:3,1:3,1),transpose(Orient)) + + ! We don't have a blade pitching rate, so we will not include it here + enddo + + !-------------------- + ! Get derivative of continuous states (need for RotTrq) + call SED_CalcContStateDeriv( t, u, p, x, xd, z, OtherState, m, dxdt, ErrStat2, ErrMsg2 ); if (Failed()) return; + + !-------------------- + ! Other outputs + y%LSSTipPxa = x%QT( DOF_Az) + call Zero2TwoPi(y%LSSTipPxa) ! Modulo + y%RotSpeed = x%QDT(DOF_Az) + y%HSS_Spd = x%QDT(DOF_Az) * p%GBoxRatio + ! Rotor torque is the torque applied to the LSS shaft by the rotor. + ! NOTE: this is equivalent to the reactionary torque of the generator due to its torque and inertia. + y%RotTrq = p%GBoxRatio * u%GenTrq + dxdt%QDT(DOF_Az) * RPS2RPM * p%GBoxRatio * p%GenIner + p%GBoxRatio * OtherState%HSSBrTrq + ! y%RotTrq = dot_product(u%HubPtLoad%Moment(:,1), m%HubPt_X(1:3)) - dxdt%QDT(DOF_Az) * RPS2RPM * p%RotIner ! this equation is somehow wrong. + y%RotPwr = x%QDT(DOF_Az) * y%RotTrq + + ! Simply pass the yaw cammend through as the current yaw + y%Yaw = u%YawPosCom + y%YawRate = u%YawRateCom + y%BlPitch = u%BlPitchCom + + !--------------------------------------------------------------------------- + ! Compute outputs: + if (CalcWriteOutput) then + ! Set the outputs + call Calc_WriteOutput( u, p, x, dxdt, y, m, ErrStat2, ErrMsg2, CalcWriteOutput ); if (Failed()) return; + ! Place the selected output channels into the WriteOutput(:) + do i = 1,p%NumOuts ! Loop through all selected output channels + y%WriteOutput(i) = p%OutParam(i)%SignM * m%AllOuts( p%OutParam(i)%Indx ) + end do + endif + + return; +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + if (Failed) call CleanUp() + end function Failed + subroutine CleanUp() + y%WriteOutput = 0.0_ReKi ! clear any jibberish in outputs since they are not set + end subroutine CleanUp +END SUBROUTINE SED_CalcOutput + + +!---------------------------------------------------------------------------------------------------------------------------------- +!> This is a tight coupling routine for computing derivatives of continuous states. +SUBROUTINE SED_CalcContStateDeriv( t, u, p, x, xd, z, OtherState, m, dxdt, ErrStat, ErrMsg ) + real(DbKi), intent(in ) :: t !< Current simulation time in seconds + type(SED_InputType), intent(in ) :: u !< Inputs at t + type(SED_ParameterType), intent(in ) :: p !< Parameters + type(SED_ContinuousStateType), intent(in ) :: x !< Continuous states at t + type(SED_DiscreteStateType), intent(in ) :: xd !< Discrete states at t + type(SED_ConstraintStateType), intent(in ) :: z !< Constraint states at t + type(SED_OtherStateType), intent(in ) :: OtherState !< Other states at t + type(SED_MiscVarType), intent(inout) :: m !< Misc variables for optimization (not copied in glue code) + type(SED_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 + + ! local variables + integer(IntKi) :: ErrStat2 ! local error status + character(ErrMsgLen) :: ErrMsg2 ! local error message + character(*), parameter :: RoutineName = 'SED_CalcContStateDeriv' + real(ReKi) :: GenTrqLSS ! Generator torque, expressed on LSS + real(ReKi) :: BrkTrqLSS ! HSS brake torque, expressed on LSS + real(ReKi) :: AeroTrq ! AeroDynamic torque -- passed in on HubPt + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" + + ! Compute the first time derivatives of the continuous states here: + if (.not. allocated(dxdt%QT) ) then + call AllocAry( dxdt%QT, size(x%qt), 'dxdt%QT', ErrStat2, ErrMsg2 ) + if (Failed()) return; + dxdt%QT = 0.0_R8Ki + endif + + if (.not. allocated(dxdt%QDT) ) then + call AllocAry( dxdt%QDT, size(x%QDT), 'dxdt%QDT', ErrStat2, ErrMsg2 ) + if (Failed()) return; + dxdt%QDT = 0.0_R8Ki + endif + + + ! First derivative of azimuth is rotor speed, so copy over + dxdt%QT( DOF_Az) = x%QDT(DOF_Az) + + !> rotor acceleration -- only if Generator DOF is on + !! + !! \f$ \ddot{\psi} = \frac{1}{J_\text{DT}} \left( Q_a - Q_g - Q_b \right) \f$ + !! + !! where + !! - \f$J_\text{DT}\f$ is the system inertia + !! - \f$Q_g = n_g Q_{g,\text{HSS}}\f$ is the generator torque projected to the LSS + !! - \f$Q_b = n_g Q_{b,\text{HSS}}\f$ is the HSS brake torque projected to the LSS + !! + if (p%GenDOF) then + GenTrqLSS = p%GBoxRatio * u%GenTrq + BrkTrqLSS = p%GBoxRatio * OtherState%HSSBrTrq + AeroTrq = dot_product(u%HubPtLoad%Moment(:,1), m%HubPt_X(1:3)) ! torque about hub X + dxdt%QDT(DOF_Az) = real((AeroTrq - GenTrqLSS - BrkTrqLSS)/p%J_DT, R8Ki) + else + dxdt%QDT(DOF_Az) = 0.0_R8Ki + endif + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + !if (Failed) call CleanUp() + end function Failed +END SUBROUTINE SED_CalcContStateDeriv + + +END MODULE SED +!********************************************************************************************************************************** diff --git a/modules/simple-elastodyn/src/SED_IO.f90 b/modules/simple-elastodyn/src/SED_IO.f90 new file mode 100644 index 0000000000..083de3e903 --- /dev/null +++ b/modules/simple-elastodyn/src/SED_IO.f90 @@ -0,0 +1,483 @@ +!********************************************************************************************************************************** +! LICENSING +! Copyright (C) 2024 National Renewable Energy Laboratory +! +! This file is part of Simplified-ElastoDyn (SED) +! +! 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 SED_IO + + USE SED_Types + USE SED_Output_Params + USE NWTC_Library + + implicit none + + integer(IntKi), parameter :: Method_RK4 = 1 + integer(IntKi), parameter :: Method_AB4 = 2 + integer(IntKi), parameter :: Method_ABM4 = 3 + + + real(ReKi), parameter :: SmallAngleLimit_Deg = 15.0 ! Largest input angle considered "small" (used as a check on input data), degrees + integer(IntKi), parameter :: MaxBl = 3 ! Maximum number of blades allowed in simulation + + integer(IntKi), parameter :: DOF_Az = 1 ! Rotor azimuth + + + +contains + +!--------------------------------------------------------------- +!> Parse the input in the InFileInfo (FileInfo_Type data structure): +subroutine SED_ParsePrimaryFileData( InitInp, RootName, interval, FileInfo_In, InputFileData, UnEc, ErrStat, ErrMsg ) + type(SED_InitInputType), intent(in ) :: InitInp !< Input data for initialization routine + character(1024), intent(in ) :: RootName !< root name for summary file + real(DBKi), intent(in ) :: interval !< timestep + type(FileInfoType), intent(in ) :: FileInfo_In !< The input file stored in a data structure + type(SED_InputFile), intent(inout) :: InputFileData !< The data for initialization + integer(IntKi), intent( out) :: UnEc !< The local unit number for this module's echo file + integer(IntKi), intent( out) :: ErrStat !< Error status from this subroutine + character(*), intent( out) :: ErrMsg !< Error message from this subroutine + + ! local vars + integer(IntKi) :: CurLine !< current entry in FileInfo_In%Lines array + integer(IntKi) :: i !< generic counter + real(SiKi) :: TmpRe(10) !< temporary 10 number array for reading values in from table + integer(IntKi) :: ErrStat2 !< Temporary error status for subroutine and function calls + character(ErrMsgLen) :: ErrMsg2 !< Temporary error message for subroutine and function calls + character(*), parameter :: RoutineName="SED_ParsePrimaryFileData" + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" + UnEc = -1 ! No file + + + CALL AllocAry( InputFileData%OutList, MaxOutPts, "Outlist", ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + !====== Simulation control ========================================================================= + 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 ( UnEc, TRIM(RootName)//'.ech', ErrStat2, ErrMsg2 ) + if (Failed()) return; + WRITE(UnEc, '(A)') 'Echo file for AeroDisk primary input file: '//trim(InitInp%InputFile) + ! Write the first three lines into the echo file + WRITE(UnEc, '(A)') FileInfo_In%Lines(1) + WRITE(UnEc, '(A)') FileInfo_In%Lines(2) + WRITE(UnEc, '(A)') FileInfo_In%Lines(3) + + CurLine = 4 + call ParseVar( FileInfo_In, CurLine, 'Echo', InputFileData%Echo, ErrStat2, ErrMsg2, UnEc ) + if (Failed()) return + endif + + ! IntMethod - Integration method: {1: RK4, 2: AB4, or 3: ABM4} (-): + call ParseVar ( FileInfo_In, CurLine, "IntMethod", InputFileData%IntMethod, ErrStat2, ErrMsg2, UnEc ) + if (Failed()) return + + ! DT - Time interval for aerodynamic calculations {or default} (s): + call ParseVarWDefault ( FileInfo_In, CurLine, "DT", InputFileData%DT, interval, ErrStat2, ErrMsg2, UnEc ) + if (Failed()) return + + + !====== Degrees of Freedom ========================================================================= + if ( InputFileData%Echo ) WRITE(UnEc, '(A)') FileInfo_In%Lines(CurLine) ! Write section break to echo + CurLine = CurLine + 1 + ! GenDOF - Generator DOF (flag) + call ParseVar( FileInfo_In, CurLine, "GenDOF", InputFileData%GenDOF, ErrStat2, ErrMsg2, UnEc ) + if (Failed()) return + + ! YawDOF - Yaw DOF (flag) + call ParseVar( FileInfo_In, CurLine, "YawDOF", InputFileData%YawDOF, ErrStat2, ErrMsg2, UnEc ) + if (Failed()) return + + + !====== Iniital Conditions ========================================================================= + if ( InputFileData%Echo ) WRITE(UnEc, '(A)') FileInfo_In%Lines(CurLine) ! Write section break to echo + CurLine = CurLine + 1 + + ! Azimuth - Initial azimuth angle for blades (degrees) + call ParseVar( FileInfo_In, CurLine, "Azimuth", InputFileData%Azimuth, ErrStat2, ErrMsg2, UnEc ) + if (Failed()) return + InputFileData%Azimuth = InputFileData%Azimuth * D2R + + ! BlPitch - Blades initial pitch (degrees) + call ParseVar( FileInfo_In, CurLine, "BlPitch", InputFileData%BlPitch, ErrStat2, ErrMsg2, UnEc ) + if (Failed()) return + InputFileData%BlPitch = InputFileData%BlPitch * D2R + + ! RotSpeed - Initial or fixed rotor speed (rpm) + call ParseVar( FileInfo_In, CurLine, "RotSpeed", InputFileData%RotSpeed, ErrStat2, ErrMsg2, UnEc ) + if (Failed()) return + InputFileData%RotSpeed = InputFileData%RotSpeed * RPM2RPS + + ! NacYaw - Initial or fixed nacelle-yaw angle (degrees) + call ParseVar( FileInfo_In, CurLine, "NacYaw", InputFileData%NacYaw, ErrStat2, ErrMsg2, UnEc ) + if (Failed()) return + InputFileData%NacYaw = InputFileData%NacYaw * D2R + + ! PtfmPitch - Fixed pitch tilt rotational displacement of platform (degrees) + call ParseVar( FileInfo_In, CurLine, "PtfmPitch", InputFileData%PtfmPitch, ErrStat2, ErrMsg2, UnEc ) + if (Failed()) return + InputFileData%PtfmPitch = InputFileData%PtfmPitch * D2R + + + !====== Turbine Configuration ====================================================================== + if ( InputFileData%Echo ) WRITE(UnEc, '(A)') FileInfo_In%Lines(CurLine) ! Write section break to echo + CurLine = CurLine + 1 + + ! NumBl - Number of blades (-) + call ParseVar( FileInfo_In, CurLine, "NumBl", InputFileData%NumBl, ErrStat2, ErrMsg2, UnEc ) + if (Failed()) return + + ! TipRad - The distance from the rotor apex to the blade tip (meters) + call ParseVar( FileInfo_In, CurLine, "TipRad", InputFileData%TipRad, ErrStat2, ErrMsg2, UnEc ) + if (Failed()) return + + ! HubRad - The distance from the rotor apex to the blade root (meters) + call ParseVar( FileInfo_In, CurLine, "HubRad", InputFileData%HubRad, ErrStat2, ErrMsg2, UnEc ) + if (Failed()) return + + ! PreCone - Blades cone angle (degrees) + call ParseVar( FileInfo_In, CurLine, "PreCone", InputFileData%PreCone, ErrStat2, ErrMsg2, UnEc ) + if (Failed()) return + InputFileData%PreCone = InputFileData%PreCone * D2R + + ! OverHang - Distance from yaw axis to rotor apex [3 blades] or teeter pin [2 blades] (meters) + call ParseVar( FileInfo_In, CurLine, "OverHang", InputFileData%OverHang, ErrStat2, ErrMsg2, UnEc ) + if (Failed()) return + + ! ShftTilt - Rotor shaft tilt angle (degrees) + call ParseVar( FileInfo_In, CurLine, "ShftTilt", InputFileData%ShftTilt, ErrStat2, ErrMsg2, UnEc ) + if (Failed()) return + InputFileData%ShftTilt = InputFileData%ShftTilt * D2R + + ! Twr2Shft - Vertical distance from the tower-top to the rotor shaft (meters) + call ParseVar( FileInfo_In, CurLine, "Twr2Shft", InputFileData%Twr2Shft, ErrStat2, ErrMsg2, UnEc ) + if (Failed()) return + + ! TowerHt - Height of tower above ground level [onshore] or MSL [offshore] (meters) + call ParseVar( FileInfo_In, CurLine, "TowerHt", InputFileData%TowerHt, ErrStat2, ErrMsg2, UnEc ) + if (Failed()) return + + + !====== Mass and Inertia =========================================================================== + if ( InputFileData%Echo ) WRITE(UnEc, '(A)') FileInfo_In%Lines(CurLine) ! Write section break to echo + CurLine = CurLine + 1 + + ! RotIner - Rot inertia about rotor axis [blades + hub] (kg m^2) + call ParseVar( FileInfo_In, CurLine, "RotIner", InputFileData%RotIner, ErrStat2, ErrMsg2, UnEc ) + if (Failed()) return + + ! GenIner - Generator inertia about HSS (kg m^2) + call ParseVar( FileInfo_In, CurLine, "GenIner", InputFileData%GenIner, ErrStat2, ErrMsg2, UnEc ) + if (Failed()) return + + + !====== Drivetrain ================================================================================= + if ( InputFileData%Echo ) WRITE(UnEc, '(A)') FileInfo_In%Lines(CurLine) ! Write section break to echo + CurLine = CurLine + 1 + + ! GBoxRatio - Gearbox ratio (-) + call ParseVar( FileInfo_In, CurLine, "GBoxRatio", InputFileData%GBoxRatio, ErrStat2, ErrMsg2, UnEc ) + if (Failed()) return + + + !====== Outputs ==================================================================================== + if ( InputFileData%Echo ) WRITE(UnEc, '(A)') FileInfo_In%Lines(CurLine) ! Write section break to echo + CurLine = CurLine + 1 +! ! SumPrint - Generate a summary file listing input options and interpolated properties to ".AD.sum"? (flag) +! call ParseVar( FileInfo_In, CurLine, "SumPrint", InputFileData%SumPrint, ErrStat2, ErrMsg2, UnEc ) +! if (Failed()) return + + if ( InputFileData%Echo ) WRITE(UnEc, '(A)') FileInfo_In%Lines(CurLine) ! Write section break to echo + CurLine = CurLine + 1 + call ReadOutputListFromFileInfo( FileInfo_In, CurLine, InputFileData%OutList, & + InputFileData%NumOuts, ErrStat2, ErrMsg2, UnEc ) + if (Failed()) return; +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + if (Failed) call CleanUp() + end function Failed + subroutine Cleanup() + ! Only do this on a fault. Leave open for calling routine in case we want to write anything else. + if (UnEc > 0_IntKi) close(UnEc) + end subroutine Cleanup +end subroutine SED_ParsePrimaryFileData + + +!> Check inputdata +subroutine SEDInput_ValidateInput( InitInp, InputFileData, ErrStat, ErrMsg ) + type(SED_InitInputType), intent(in ) :: InitInp !< Input data for initialization + type(SED_InputFile), intent(in ) :: InputFileData !< The data for initialization + integer(IntKi), intent( out) :: ErrStat !< Error status from this subroutine + character(*), intent( out) :: ErrMsg !< Error message from this subroutine + character(*), parameter :: RoutineName="SEDInput_ValidateInput" + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" + + ! InitInput checks + if (InitInp%Linearize) call SetErrStat(ErrID_Fatal,'AeroDisk cannot perform linearization analysis.',ErrStat,ErrMsg,RoutineName) + if (InputFileData%DT <= 0.0_DbKi) call SetErrStat(ErrID_Fatal,'DT must not be negative.', ErrStat,ErrMsg,RoutineName) + if ((InputFileData%IntMethod /= Method_RK4) .and. (InputFileData%IntMethod /= Method_AB4) .and. (InputFileData%IntMethod /= Method_ABM4)) & + call SetErrStat(ErrID_Fatal,'IntMethod must be '//trim(Num2LStr(Method_RK4))//': RK4, '//trim(Num2LStr(Method_AB4))//': AB4, or '//trim(Num2LStr(Method_ABM4))//': ABM4', ErrStat,ErrMsg,RoutineName) + + ! initial settings check + if (abs(InputFileData%Azimuth) > TwoPi) & + call SetErrStat(ErrID_Fatal,'Starting Azimuth must be between -360 and 360 degrees.', ErrStat,ErrMsg,RoutineName) + if ((InputFileData%BlPitch <= -pi ) .or. (InputFileData%BlPitch > pi)) & + call SetErrStat( ErrID_Fatal, 'BlPitch must be greater than -pi radians and '// & + 'less than or equal to pi radians (i.e., in the range (-180, 180] degrees).',ErrStat,ErrMsg,RoutineName) + if (InputFileData%RotSpeed < 0_ReKi) call SetErrStat(ErrID_Fatal,'RotSpeed must not be negative', ErrStat,ErrMsg,RoutineName) + IF ((InputFileData%NacYaw <= -pi) .or. (InputFileData%NacYaw > pi)) & + call SetErrStat( ErrID_Fatal, 'NacYaw must be in the range (-pi, pi] radians (i.e., (-180, 180] degrees).',ErrStat,ErrMsg,RoutineName) + if ( ABS( InputFileData%PtfmPitch ) > SmallAngleLimit_Deg*D2R ) & + call SetErrStat( ErrID_Fatal, 'PtfmPitch must be between -'//TRIM(Num2LStr(SmallAngleLimit_Deg))//' and ' & + //TRIM(Num2LStr(SmallAngleLimit_Deg))//' degrees.',ErrStat,ErrMsg,RoutineName) + + ! turbine configuration + if ((InputFileData%NumBl < 1) .or. (InputFileData%NumBl > MaxBl)) & + call SetErrStat( ErrID_Fatal, 'NumBl must be 1, 2, or 3.',ErrStat,ErrMsg,RoutineName) + if (InputFileData%TipRad < 0.0_ReKi) call SetErrStat(ErrID_Fatal,'TipRad must not be negative.',ErrStat,ErrMsg,RoutineName) + if (InputFileData%HubRad < 0.0_ReKi) call SetErrStat(ErrID_Fatal,'HubRad must not be negative.',ErrStat,ErrMsg,RoutineName) + if (abs(InputFileData%PreCone) >= PiBy2) & + call SetErrStat( ErrID_Fatal, 'PreCone must be in the range (-pi/2, pi/2) '//& + 'radians (i.e., (-90, 90) degrees).',ErrStat,ErrMsg,RoutineName) + if (abs(InputFileData%OverHang) > InputFileData%TipRad) & + call SetErrStat( ErrID_Fatal, 'Overhang larger than tip-radius. Does your model make sense?',ErrStat,ErrMsg,RoutineName) + if (abs(InputFileData%ShftTilt) > PiBy2) & + call SetErrStat(ErrID_Fatal,'ShftTilt must be between -pi/2 and pi/2 radians (i.e., in the range [-90, 90] degrees).',ErrStat,ErrMsg,RoutineName) + if (InputFileData%Twr2Shft < 0.0_ReKi) call SetErrStat(ErrID_Fatal,'Twr2Shft must not be negative.',ErrStat,ErrMsg,RoutineName) + if ( InputFileData%TowerHt <= 0.0_ReKi) call SetErrStat( ErrID_Fatal, 'TowerHt must be greater than zero.',ErrStat,ErrMsg,RoutineName ) + + if ( InputFileData%TowerHt + InputFileData%Twr2Shft + InputFileData%OverHang*SIN(InputFileData%ShftTilt) <= InputFileData%TipRad ) & + call SetErrStat( ErrID_Fatal, 'TowerHt + Twr2Shft + OverHang*SIN(ShftTilt) must be greater than TipRad.',ErrStat,ErrMsg,RoutineName) + + ! inertias + if (InputFileData%RotIner < 0.0_ReKi) call SetErrStat(ErrID_Fatal,'RotIner must not be negative.',ErrStat,ErrMsg,RoutineName) + if (InputFileData%GenIner < 0.0_ReKi) call SetErrStat(ErrID_Fatal,'GenIner must not be negative.',ErrStat,ErrMsg,RoutineName) + + !GBRatio -- no sanity checks on this +end subroutine SEDInput_ValidateInput + + +!---------------------------------------------------------------------------------------------------------------------------------- +!> this routine fills the AllOuts array, which is used to send data to the glue code to be written to an output file. +!! NOTE: AllOuts is ReKi, but most calculations in this module are in single precision. This requires a bunch of conversions at this +!! stage. +subroutine Calc_WriteOutput( u, p, x, dxdt, y, m, ErrStat, ErrMsg, CalcWriteOutput ) + type(SED_InputType), intent(in ) :: u !< The inputs at time T + type(SED_ParameterType), intent(in ) :: p !< The module parameters + type(SED_ContinuousStateType),intent(in ) :: x !< Continuous states at t + type(SED_ContinuousStateType),intent(in ) :: dxdt !< Derivative of continuous states at t + type(SED_OutputType), intent(in ) :: y !< outputs + type(SED_MiscVarType), intent(inout) :: m !< misc/optimization variables (for computing mesh transfers) + integer(IntKi), intent( out) :: ErrStat !< The error status code + character(*), intent( out) :: ErrMsg !< The error message, if an error occurred + logical, intent(in ) :: CalcWriteOutput !< flag that determines if we need to compute AllOuts (or just the reaction loads that get returned to ServoDyn) + ! local variables + character(*), parameter :: RoutineName = 'Calc_WriteOutput' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + real(ReKi) :: Tmp3(3) + real(ReKi) :: Rxyz(3,3) !< rotation matrix for x,y,z of local coordinates + + ! Initialize + ErrStat = ErrID_None + ErrMsg = "" + + ! return if we are not providing outputs + if (.not. CalcWriteOutput) return + + ! Azimuth + m%AllOuts( Azimuth ) = x%QT( DOF_Az) + call Zero2TwoPi(m%AllOuts( Azimuth )) ! modulo + m%AllOuts( Azimuth ) = m%AllOuts( Azimuth ) * R2D + + ! speed + m%AllOuts( RotSpeed ) = x%QDT(DOF_Az) * RPS2RPM + m%AllOuts( GenSpeed ) = x%QDT(DOF_Az) * RPS2RPM * p%GBoxRatio + + ! accel + m%AllOuts( RotAcc ) = dxdt%QDT(DOF_Az) * RPS2RPM + m%AllOuts( GenAcc ) = dxdt%QDT(DOF_Az) * RPS2RPM * p%GBoxRatio + + ! Yaw commands + m%AllOuts( Yaw ) = y%Yaw * R2D + m%AllOuts( YawRate ) = y%YawRate * R2D + + ! BlPitch1 + m%AllOuts( BlPitch1 ) = u%BlPitchCom(1) * R2D + if (p%NumBl > 1) m%AllOuts( BlPitch2 ) = u%BlPitchCom(2) * R2D + if (p%NumBl > 2) m%AllOuts( BlPitch3 ) = u%BlPitchCom(3) * R2D + + ! LLS torqque and power + m%AllOuts( RotTorq ) = y%RotTrq * 0.001_ReKi ! LSShftTq (kN-m) + m%AllOuts( RotPwr ) = y%RotPwr * 0.001_ReKi ! LSShftPwr (kN-m) +end subroutine Calc_WriteOutput + + +!********************************************************************************************************************************** +! 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 10-Aug-2022 08:44:32. +SUBROUTINE SetOutParam(OutList, p, ErrStat, ErrMsg ) +!.................................................................................................................................. + + IMPLICIT NONE + + ! Passed variables + + CHARACTER(ChanLen), INTENT(IN) :: OutList(:) !< The list out user-requested outputs + TYPE(SED_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(25) = (/ & ! This lists the names of the allowed parameters, which must be sorted alphabetically + "AZIMUTH ","BLDPITCH1","BLDPITCH2","BLDPITCH3","BLPITCH1 ","BLPITCH2 ","BLPITCH3 ","GENACC ", & + "GENSPEED ","HSSHFTA ","HSSHFTV ","LSSHFTPWR","LSSHFTTQ ","LSSTIPA ","LSSTIPAXA","LSSTIPAXS", & + "LSSTIPV ","LSSTIPVXA","LSSTIPVXS","ROTACC ","ROTPWR ","ROTSPEED ","ROTTORQ ","YAW ", & + "YAWRATE "/) + INTEGER(IntKi), PARAMETER :: ParamIndxAry(25) = (/ & ! This lists the index into AllOuts(:) of the allowed parameters ValidParamAry(:) + Azimuth , BlPitch1 , BlPitch2 , BlPitch3 , BlPitch1 , BlPitch2 , BlPitch3 , GenAcc , & + GenSpeed , GenAcc , GenSpeed , RotPwr , RotTorq , RotAcc , RotAcc , RotAcc , & + RotSpeed , RotSpeed , RotSpeed , RotAcc , RotPwr , RotSpeed , RotTorq , Yaw , & + YawRate /) + CHARACTER(ChanLen), PARAMETER :: ParamUnitsAry(25) = (/ & ! This lists the units corresponding to the allowed parameters + "(deg) ","(deg) ","(deg) ","(deg) ","(deg) ","(deg) ","(deg) ","(deg/s^2)", & + "(rpm) ","(deg/s^2)","(rpm) ","(kW) ","(kN-m) ","(deg/s^2)","(deg/s^2)","(deg/s^2)", & + "(rpm) ","(rpm) ","(rpm) ","(deg/s^2)","(kW) ","(rpm) ","(kN-m) ","(deg) ", & + "(deg/s) "/) + + + ! Initialize values + ErrStat = ErrID_None + ErrMsg = "" + InvalidOutput = .FALSE. + + if (p%NumBl < 3) InvalidOutput( BlPitch3 ) = .true. + if (p%NumBl < 2) InvalidOutput( BlPitch2 ) = .true. + + !------------------------------------------------------------------------------------------------- + ! 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 SimpleElastoDyn 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 SED_IO diff --git a/modules/simple-elastodyn/src/SED_Output_Params.f90 b/modules/simple-elastodyn/src/SED_Output_Params.f90 new file mode 100644 index 0000000000..7d64c07ea0 --- /dev/null +++ b/modules/simple-elastodyn/src/SED_Output_Params.f90 @@ -0,0 +1,52 @@ +!> The parameters in this code are from the MATLAB autogeneration scripts. Do not manually edit unless also editing the OutListParamters.xls SED tab. +module SED_Output_Params + use NWTC_Library + +! =================================================================================================== +! 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 10-Aug-2022 08:44:32. + + + ! 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 + + + ! Outputs: + + INTEGER(IntKi), PARAMETER :: Azimuth = 1 + INTEGER(IntKi), PARAMETER :: RotSpeed = 2 + INTEGER(IntKi), PARAMETER :: RotAcc = 3 + INTEGER(IntKi), PARAMETER :: GenSpeed = 4 + INTEGER(IntKi), PARAMETER :: GenAcc = 5 + INTEGER(IntKi), PARAMETER :: Yaw = 6 + INTEGER(IntKi), PARAMETER :: YawRate = 7 + + + ! Blade Pitch Motions: + + INTEGER(IntKi), PARAMETER :: BlPitch1 = 8 + INTEGER(IntKi), PARAMETER :: BlPitch2 = 9 + INTEGER(IntKi), PARAMETER :: BlPitch3 = 10 + + + ! Hub and Rotor Loads: + + INTEGER(IntKi), PARAMETER :: RotTorq = 11 + INTEGER(IntKi), PARAMETER :: RotPwr = 12 + + + ! The maximum number of output channels which can be output by the code. + INTEGER(IntKi), PARAMETER :: MaxOutPts = 12 + +!End of code generated by Matlab script +! =================================================================================================== +end module SED_Output_Params diff --git a/modules/simple-elastodyn/src/SED_Registry.txt b/modules/simple-elastodyn/src/SED_Registry.txt new file mode 100644 index 0000000000..5f52f1ea70 --- /dev/null +++ b/modules/simple-elastodyn/src/SED_Registry.txt @@ -0,0 +1,157 @@ +################################################################################################################################### +# Registry for Simplified ElastoDyn in the FAST Modularization Framework +# This Registry file is used to create MODULE SED_Types which contains all of the user-defined types needed in Simplified ElastoDyn. +# 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 + +param SED/SED - IntKi SED_NMX - 4 - "Used in updating predictor-corrector values (size of state history)" - + +# ..... Initialization data ....................................................................................................... +# SED input file +typedef SED/SED SED_InputFile LOGICAL Echo - - - "Echo the input file" - +typedef ^ SED_InputFile DBKi DT - - - "Time step for module time integration" s +typedef ^ SED_InputFile IntKi IntMethod - - - "Integration method {1: RK4, 2: AB4, or 3: ABM4}" - +typedef ^ SED_InputFile LOGICAL GenDOF - - - "whether the generator is fixed or free" - +typedef ^ SED_InputFile LOGICAL YawDOF - - - "Yaw controlled by controller, or fixed" - +typedef ^ SED_InputFile R8Ki Azimuth - - - "Initial azimuth angle for blade 1" deg +typedef ^ SED_InputFile ReKi BlPitch - - - "Initial blade pitch angles" radians +typedef ^ SED_InputFile ReKi RotSpeed - - - "Initial or fixed rotor speed" RPM +typedef ^ SED_InputFile ReKi NacYaw - - - "Initial or fixed nacelle yaw" deg +typedef ^ SED_InputFile ReKi PtfmPitch - - - "Fixed pitch tilt rotational displacement of platform" deg +typedef ^ SED_InputFile IntKi NumBl - - - "Number of blades on the turbine" - +typedef ^ SED_InputFile ReKi TipRad - - - "Preconed blade-tip radius (distance from the rotor apex to the blade tip)" m +typedef ^ SED_InputFile ReKi HubRad - - - "Preconed hub radius (distance from the rotor apex to the blade root)" m +typedef ^ SED_InputFile ReKi PreCone - - - "Rotor precone angles" deg +typedef ^ SED_InputFile ReKi OverHang - - - "Distance from yaw axis to rotor apex or teeter pin" m +typedef ^ SED_InputFile ReKi ShftTilt - - - "Rotor shaft tilt angle" deg +typedef ^ SED_InputFile ReKi Twr2Shft - - - "Vertical distance from the tower-top to the rotor shaft" m +typedef ^ SED_InputFile ReKi TowerHt - - - "Height of tower above ground level [onshore] or MSL [offshore]" m +typedef ^ SED_InputFile ReKi RotIner - - - "Hub inertia about teeter axis (2-blader) or rotor axis (3-blader)" "kg m^2" +typedef ^ SED_InputFile ReKi GenIner - - - "Generator inertia about HSS" "kg m^2" +typedef ^ SED_InputFile ReKi GBoxRatio - - - "Gearbox ratio" - +typedef ^ SED_InputFile LOGICAL SumPrint - - - "Print summary data to .sum" - +typedef ^ SED_InputFile IntKi NumOuts - - - "Number of outputs" - +typedef ^ SED_InputFile CHARACTER(ChanLen) OutList : - - "List of user-requested output channels" - + + +# ..... Initialization data ....................................................................................................... +# inputs for initialization: +typedef SED/SED InitInputType CHARACTER(1024) InputFile - - - "Name of the input file" - +typedef ^ InitInputType CHARACTER(1024) RootName - - - "RootName for writing output files" - +typedef ^ InitInputType LOGICAL Linearize - .false. - "this module cannot be linearized at present" - +typedef ^ InitInputType LOGICAL UseInputFile - .TRUE. - "Supplied by Driver: .TRUE. if using a input file, .FALSE. if all inputs are being passed in by the caller" - +typedef ^ InitInputType FileInfoType PassedFileData - - - "If we don't use the input file, pass everything through this" - + + +# outputs from initialization: +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 NumBl - - - "Number of blades on the turbine" - +typedef ^ InitOutputType ReKi BlPitch {:} - - "Initial blade pitch angles" radians +typedef ^ InitOutputType ReKi BladeLength - - - "Blade length (for AeroDsk)" meters +typedef ^ InitOutputType ReKi TowerHt - - - "Tower Height" meters +typedef ^ InitOutputType ReKi HubHt - - - "Height of the hub" meters +typedef ^ InitOutputType ReKi PlatformPos {6} - - "Initial platform position (6 DOFs)" +typedef ^ InitOutputType ReKi HubRad - - - "Preconed hub radius (distance from the rotor apex to the blade root)" m +typedef ^ InitOutputType ReKi RotSpeed - - - "Initial or fixed rotor speed" rad/s +typedef ^ InitOutputType LOGICAL GenDOF - - - "whether the generator DOF is on (true) or off (false)" - + + +# ..... Inputs .................................................................................................................... +# inputs on meshes: +typedef ^ InputType MeshType HubPtLoad - - - "AeroDyn/AeroDisk maps load to hub" - +# inputs not on meshes: +typedef ^ InputType ReKi HSSBrTrqC - - - "Commanded HSS brake torque" N-m +typedef ^ InputType ReKi GenTrq - - - "Electrical generator torque" N-m +typedef ^ InputType ReKi BlPitchCom {:} - 2pi "Commanded blade pitch angles" radians +typedef ^ InputType ReKi YawPosCom - - - "Yaw angle commanded" rad +typedef ^ InputType ReKi YawRateCom - - - "Yaw rate commanded" rad/s + + +# ..... Outputs ................................................................................................................... +# outputs on meshes: +typedef ^ OutputType MeshType BladeRootMotion {:} - - "For AeroDyn: motions at the blade roots" - +typedef ^ OutputType MeshType HubPtMotion - - - "For AeroDyn/AeroDisk: motions of the hub" - +typedef ^ OutputType MeshType NacelleMotion - - - "For AeroDyn: for aero effects in AD (aero nacelle loads ignored)" - +typedef ^ OutputType MeshType TowerLn2Mesh - - - "Tower line2 mesh for visualization / Aero tower effects" - +typedef ^ OutputType MeshType PlatformPtMesh - - - "Platform reference point for visualization" - +#TODO: any mesh for visualization of blades/rotor disk? +# outputs not on meshes: +typedef ^ OutputType ReKi LSSTipPxa - - 2pi "Rotor azimuth angle (position)" radians +typedef ^ OutputType ReKi RotSpeed - - - "Rotor azimuth angular speed" rad/s +typedef ^ OutputType ReKi RotPwr - - - "Rotor power" W +typedef ^ OutputType ReKi RotTrq - - - "Rotor torque" N-m +typedef ^ OutputType ReKi HSS_Spd - - - "High-speed shaft (HSS) speed" rad/s +# This is a feed through -- SrvD requires knowledge of current actual yaw +typedef ^ OutputType ReKi Yaw - - - "Yaw angle" rad +typedef ^ OutputType ReKi YawRate - - - "Yaw rate" rad/s +typedef ^ OutputType ReKi BlPitch {:} - 2pi "Actual blade pitch" radians +typedef ^ OutputType ReKi WriteOutput {:} - - "Data to be written to an output file: see WriteOutputHdr for names of each variable" "see WriteOutputUnt" + + +# ..... States .................................................................................................................... +# continuous (differentiable) states: +typedef ^ ContinuousStateType R8Ki QT {:} - - "Current estimate of Q (displacement matrix) for each degree of freedom" - +typedef ^ ContinuousStateType ^ QDT {:} - - "Current estimate of QD (velocity matrix) for each degree of freedom" + +# Define discrete (nondifferentiable) states here: +typedef ^ DiscreteStateType ReKi DummyDiscreteState - - - "" - + +# Define constraint states here: +typedef ^ ConstraintStateType ReKi DummyConstrState - - - "" - + +# any other states +typedef ^ OtherStateType IntKi n - - - "tracks time step for which OtherState was updated" - +typedef ^ OtherStateType SED_ContinuousStateType xdot {SED_NMX} - - "previous state deriv for multi-step" - +typedef ^ OtherStateType IntKi IC {SED_NMX} - - "Array which stores pointers to predictor-corrector results" - +typedef ^ OtherStateType ReKi HSSBrTrq - - - "HSSBrTrq from update states; a hack to get this working with a single integrator" - +typedef ^ OtherStateType ReKi HSSBrTrqC - - - "Commanded HSS brake torque (adjusted for sign)" N-m +typedef ^ OtherStateType IntKi SgnPrvLSTQ - - - "The sign of the low-speed shaft torque from the previous call to RtHS(). NOTE: The low-speed shaft torque is assumed to be positive at the beginning of the run!" - +typedef ^ OtherStateType IntKi SgnLSTQ {SED_NMX} - - "history of sign of LSTQ (for HSS brake)" + + + +# ..... Parameters................................................................................................................. +# unchanging parameters: +typedef ^ ParameterType CHARACTER(1024) RootName - - - "RootName for writing output files" - +typedef ^ ParameterType LOGICAL GenDOF - - - "whether the generator DOF is on (free) or off (fixed)" - +typedef ^ ParameterType LOGICAL YawDOF - - - "Yaw controlled by controller, or fixed" - +typedef ^ ParameterType DbKi DT - - - "Time step for module time integration" s +typedef ^ ParameterType DbKi DT24 - - - "Time step for solver" s +typedef ^ ParameterType IntKi IntMethod - - - "Integration method {1: RK4, 2: AB4, or 3: ABM4}" - +typedef ^ ParameterType ReKi J_DT - - - "Drivetrain inertia (blades+hub+shaft+generator)" "kgm^2" +typedef ^ ParameterType ReKi PtfmPitch - - - "Static platform tilt angle" rad +typedef ^ ParameterType ReKi InitYaw - - - "Initial or fixed nacelle yaw -- store in case YawDOF is off" deg +typedef ^ ParameterType R8Ki InitAzimuth - - - "Initial azimuth angle for blade 1" deg +typedef ^ ParameterType ReKi RotIner - - - "Hub inertia about teeter axis (2-blader) or rotor axis (3-blader)" "kg m^2" +typedef ^ ParameterType ReKi GenIner - - - "Generator inertia about HSS" "kg m^2" +typedef ^ ParameterType ReKi GBoxRatio - - - "Gearbox ratio" - +typedef ^ ParameterType IntKi NumBl - - - "Number of blades on the turbine" - +typedef ^ ParameterType ReKi TipRad - - - "Preconed blade-tip radius (distance from the rotor apex to the blade tip)" m +typedef ^ ParameterType ReKi HubRad - - - "Preconed hub radius (distance from the rotor apex to the blade root)" m +typedef ^ ParameterType ReKi BladeLength - - - "Length of blades" m +typedef ^ ParameterType ReKi PreCone - - - "Rotor precone angles" deg +typedef ^ ParameterType ReKi OverHang - - - "Distance from yaw axis to rotor apex or teeter pin" m +typedef ^ ParameterType ReKi ShftTilt - - - "Rotor shaft tilt angle" deg +typedef ^ ParameterType ReKi Twr2Shft - - - "Vertical distance from the tower-top to the rotor shaft" m +typedef ^ ParameterType ReKi TowerHt - - - "Height of tower above ground level [onshore] or MSL [offshore]" m +typedef ^ ParameterType ReKi HubHt - - - "Height of hub center above ground level [onshore] or MSL [offshore]" m +typedef ^ ParameterType IntKi NumOuts - - - "Number of outputs" - +typedef ^ ParameterType OutParmType OutParam {:} - - "Names and units (and other characteristics) of all requested output parameters" - + +# ..... Misc/Optimization variables................................................................................................. +typedef ^ MiscVarType ReKi AllOuts {:} - - "Array of all outputs" - +typedef ^ MiscVarType MeshMapType mapNac2Hub - - - "Mesh mapping from Nacelle to Hub (hub rotation overwritten in calc)" - +typedef ^ MiscVarType MeshMapType mapHub2Root {:} - - "Mesh mapping from Hub to BladeRootMotion (blade pitch overwritten in calc)" - +typedef ^ MiscVarType R8Ki QD2T {:} - - "Current estimate of first derivative of QD (acceleration matrix) for each degree of freedom" +typedef ^ MiscVarType ReKi HubPt_X {3} - - "X orientation of hub calculated in CalcOutput -- saving so we don't recalculate a bunch of things to get it in UpdateStates" + diff --git a/modules/simple-elastodyn/src/SED_Types.f90 b/modules/simple-elastodyn/src/SED_Types.f90 new file mode 100644 index 0000000000..e5b3e3ddf1 --- /dev/null +++ b/modules/simple-elastodyn/src/SED_Types.f90 @@ -0,0 +1,1690 @@ +!STARTOFREGISTRYGENERATEDFILE 'SED_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 +!********************************************************************************************************************************* +! SED_Types +!................................................................................................................................. +! This file is part of SED. +! +! 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 SED. 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 SED_Types +!--------------------------------------------------------------------------------------------------------------------------------- +USE NWTC_Library +IMPLICIT NONE + INTEGER(IntKi), PUBLIC, PARAMETER :: SED_NMX = 4 ! Used in updating predictor-corrector values (size of state history) [-] +! ========= SED_InputFile ======= + TYPE, PUBLIC :: SED_InputFile + LOGICAL :: Echo = .false. !< Echo the input file [-] + REAL(DbKi) :: DT = 0.0_R8Ki !< Time step for module time integration [s] + INTEGER(IntKi) :: IntMethod = 0_IntKi !< Integration method {1: RK4, 2: AB4, or 3: ABM4} [-] + LOGICAL :: GenDOF = .false. !< whether the generator is fixed or free [-] + LOGICAL :: YawDOF = .false. !< Yaw controlled by controller, or fixed [-] + REAL(R8Ki) :: Azimuth = 0.0_R8Ki !< Initial azimuth angle for blade 1 [deg] + REAL(ReKi) :: BlPitch = 0.0_ReKi !< Initial blade pitch angles [radians] + REAL(ReKi) :: RotSpeed = 0.0_ReKi !< Initial or fixed rotor speed [RPM] + REAL(ReKi) :: NacYaw = 0.0_ReKi !< Initial or fixed nacelle yaw [deg] + REAL(ReKi) :: PtfmPitch = 0.0_ReKi !< Fixed pitch tilt rotational displacement of platform [deg] + INTEGER(IntKi) :: NumBl = 0_IntKi !< Number of blades on the turbine [-] + REAL(ReKi) :: TipRad = 0.0_ReKi !< Preconed blade-tip radius (distance from the rotor apex to the blade tip) [m] + REAL(ReKi) :: HubRad = 0.0_ReKi !< Preconed hub radius (distance from the rotor apex to the blade root) [m] + REAL(ReKi) :: PreCone = 0.0_ReKi !< Rotor precone angles [deg] + REAL(ReKi) :: OverHang = 0.0_ReKi !< Distance from yaw axis to rotor apex or teeter pin [m] + REAL(ReKi) :: ShftTilt = 0.0_ReKi !< Rotor shaft tilt angle [deg] + REAL(ReKi) :: Twr2Shft = 0.0_ReKi !< Vertical distance from the tower-top to the rotor shaft [m] + REAL(ReKi) :: TowerHt = 0.0_ReKi !< Height of tower above ground level [onshore] or MSL [offshore] [m] + REAL(ReKi) :: RotIner = 0.0_ReKi !< Hub inertia about teeter axis (2-blader) or rotor axis (3-blader) [kg m^2] + REAL(ReKi) :: GenIner = 0.0_ReKi !< Generator inertia about HSS [kg m^2] + REAL(ReKi) :: GBoxRatio = 0.0_ReKi !< Gearbox ratio [-] + LOGICAL :: SumPrint = .false. !< Print summary data to .sum [-] + INTEGER(IntKi) :: NumOuts = 0_IntKi !< Number of outputs [-] + CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: OutList !< List of user-requested output channels [-] + END TYPE SED_InputFile +! ======================= +! ========= SED_InitInputType ======= + TYPE, PUBLIC :: SED_InitInputType + CHARACTER(1024) :: InputFile !< Name of the input file [-] + CHARACTER(1024) :: RootName !< RootName for writing output files [-] + LOGICAL :: Linearize = .false. !< this module cannot be linearized at present [-] + LOGICAL :: UseInputFile = .TRUE. !< Supplied by Driver: .TRUE. if using a input file, .FALSE. if all inputs are being passed in by the caller [-] + TYPE(FileInfoType) :: PassedFileData !< If we don't use the input file, pass everything through this [-] + END TYPE SED_InitInputType +! ======================= +! ========= SED_InitOutputType ======= + TYPE, PUBLIC :: SED_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) :: NumBl = 0_IntKi !< Number of blades on the turbine [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BlPitch !< Initial blade pitch angles [radians] + REAL(ReKi) :: BladeLength = 0.0_ReKi !< Blade length (for AeroDsk) [meters] + REAL(ReKi) :: TowerHt = 0.0_ReKi !< Tower Height [meters] + REAL(ReKi) :: HubHt = 0.0_ReKi !< Height of the hub [meters] + REAL(ReKi) , DIMENSION(1:6) :: PlatformPos = 0.0_ReKi !< Initial platform position (6 DOFs) [-] + REAL(ReKi) :: HubRad = 0.0_ReKi !< Preconed hub radius (distance from the rotor apex to the blade root) [m] + REAL(ReKi) :: RotSpeed = 0.0_ReKi !< Initial or fixed rotor speed [rad/s] + LOGICAL :: GenDOF = .false. !< whether the generator DOF is on (true) or off (false) [-] + END TYPE SED_InitOutputType +! ======================= +! ========= SED_InputType ======= + TYPE, PUBLIC :: SED_InputType + TYPE(MeshType) :: HubPtLoad !< AeroDyn/AeroDisk maps load to hub [-] + REAL(ReKi) :: HSSBrTrqC = 0.0_ReKi !< Commanded HSS brake torque [N-m] + REAL(ReKi) :: GenTrq = 0.0_ReKi !< Electrical generator torque [N-m] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BlPitchCom !< Commanded blade pitch angles [radians] + REAL(ReKi) :: YawPosCom = 0.0_ReKi !< Yaw angle commanded [rad] + REAL(ReKi) :: YawRateCom = 0.0_ReKi !< Yaw rate commanded [rad/s] + END TYPE SED_InputType +! ======================= +! ========= SED_OutputType ======= + TYPE, PUBLIC :: SED_OutputType + TYPE(MeshType) , DIMENSION(:), ALLOCATABLE :: BladeRootMotion !< For AeroDyn: motions at the blade roots [-] + TYPE(MeshType) :: HubPtMotion !< For AeroDyn/AeroDisk: motions of the hub [-] + TYPE(MeshType) :: NacelleMotion !< For AeroDyn: for aero effects in AD (aero nacelle loads ignored) [-] + TYPE(MeshType) :: TowerLn2Mesh !< Tower line2 mesh for visualization / Aero tower effects [-] + TYPE(MeshType) :: PlatformPtMesh !< Platform reference point for visualization [-] + REAL(ReKi) :: LSSTipPxa = 0.0_ReKi !< Rotor azimuth angle (position) [radians] + REAL(ReKi) :: RotSpeed = 0.0_ReKi !< Rotor azimuth angular speed [rad/s] + REAL(ReKi) :: RotPwr = 0.0_ReKi !< Rotor power [W] + REAL(ReKi) :: RotTrq = 0.0_ReKi !< Rotor torque [N-m] + REAL(ReKi) :: HSS_Spd = 0.0_ReKi !< High-speed shaft (HSS) speed [rad/s] + REAL(ReKi) :: Yaw = 0.0_ReKi !< Yaw angle [rad] + REAL(ReKi) :: YawRate = 0.0_ReKi !< Yaw rate [rad/s] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BlPitch !< Actual blade pitch [radians] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: WriteOutput !< Data to be written to an output file: see WriteOutputHdr for names of each variable [see WriteOutputUnt] + END TYPE SED_OutputType +! ======================= +! ========= SED_ContinuousStateType ======= + TYPE, PUBLIC :: SED_ContinuousStateType + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: QT !< Current estimate of Q (displacement matrix) for each degree of freedom [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: QDT !< Current estimate of QD (velocity matrix) for each degree of freedom [-] + END TYPE SED_ContinuousStateType +! ======================= +! ========= SED_DiscreteStateType ======= + TYPE, PUBLIC :: SED_DiscreteStateType + REAL(ReKi) :: DummyDiscreteState = 0.0_ReKi !< [-] + END TYPE SED_DiscreteStateType +! ======================= +! ========= SED_ConstraintStateType ======= + TYPE, PUBLIC :: SED_ConstraintStateType + REAL(ReKi) :: DummyConstrState = 0.0_ReKi !< [-] + END TYPE SED_ConstraintStateType +! ======================= +! ========= SED_OtherStateType ======= + TYPE, PUBLIC :: SED_OtherStateType + INTEGER(IntKi) :: n = 0_IntKi !< tracks time step for which OtherState was updated [-] + TYPE(SED_ContinuousStateType) , DIMENSION(1:SED_NMX) :: xdot !< previous state deriv for multi-step [-] + INTEGER(IntKi) , DIMENSION(1:SED_NMX) :: IC = 0_IntKi !< Array which stores pointers to predictor-corrector results [-] + REAL(ReKi) :: HSSBrTrq = 0.0_ReKi !< HSSBrTrq from update states; a hack to get this working with a single integrator [-] + REAL(ReKi) :: HSSBrTrqC = 0.0_ReKi !< Commanded HSS brake torque (adjusted for sign) [N-m] + INTEGER(IntKi) :: SgnPrvLSTQ = 0_IntKi !< The sign of the low-speed shaft torque from the previous call to RtHS(). NOTE: The low-speed shaft torque is assumed to be positive at the beginning of the run! [-] + INTEGER(IntKi) , DIMENSION(1:SED_NMX) :: SgnLSTQ = 0_IntKi !< history of sign of LSTQ (for HSS brake) [-] + END TYPE SED_OtherStateType +! ======================= +! ========= SED_ParameterType ======= + TYPE, PUBLIC :: SED_ParameterType + CHARACTER(1024) :: RootName !< RootName for writing output files [-] + LOGICAL :: GenDOF = .false. !< whether the generator DOF is on (free) or off (fixed) [-] + LOGICAL :: YawDOF = .false. !< Yaw controlled by controller, or fixed [-] + REAL(DbKi) :: DT = 0.0_R8Ki !< Time step for module time integration [s] + REAL(DbKi) :: DT24 = 0.0_R8Ki !< Time step for solver [s] + INTEGER(IntKi) :: IntMethod = 0_IntKi !< Integration method {1: RK4, 2: AB4, or 3: ABM4} [-] + REAL(ReKi) :: J_DT = 0.0_ReKi !< Drivetrain inertia (blades+hub+shaft+generator) [kgm^2] + REAL(ReKi) :: PtfmPitch = 0.0_ReKi !< Static platform tilt angle [rad] + REAL(ReKi) :: InitYaw = 0.0_ReKi !< Initial or fixed nacelle yaw -- store in case YawDOF is off [deg] + REAL(R8Ki) :: InitAzimuth = 0.0_R8Ki !< Initial azimuth angle for blade 1 [deg] + REAL(ReKi) :: RotIner = 0.0_ReKi !< Hub inertia about teeter axis (2-blader) or rotor axis (3-blader) [kg m^2] + REAL(ReKi) :: GenIner = 0.0_ReKi !< Generator inertia about HSS [kg m^2] + REAL(ReKi) :: GBoxRatio = 0.0_ReKi !< Gearbox ratio [-] + INTEGER(IntKi) :: NumBl = 0_IntKi !< Number of blades on the turbine [-] + REAL(ReKi) :: TipRad = 0.0_ReKi !< Preconed blade-tip radius (distance from the rotor apex to the blade tip) [m] + REAL(ReKi) :: HubRad = 0.0_ReKi !< Preconed hub radius (distance from the rotor apex to the blade root) [m] + REAL(ReKi) :: BladeLength = 0.0_ReKi !< Length of blades [m] + REAL(ReKi) :: PreCone = 0.0_ReKi !< Rotor precone angles [deg] + REAL(ReKi) :: OverHang = 0.0_ReKi !< Distance from yaw axis to rotor apex or teeter pin [m] + REAL(ReKi) :: ShftTilt = 0.0_ReKi !< Rotor shaft tilt angle [deg] + REAL(ReKi) :: Twr2Shft = 0.0_ReKi !< Vertical distance from the tower-top to the rotor shaft [m] + REAL(ReKi) :: TowerHt = 0.0_ReKi !< Height of tower above ground level [onshore] or MSL [offshore] [m] + REAL(ReKi) :: HubHt = 0.0_ReKi !< Height of hub center above ground level [onshore] or MSL [offshore] [m] + INTEGER(IntKi) :: NumOuts = 0_IntKi !< Number of outputs [-] + TYPE(OutParmType) , DIMENSION(:), ALLOCATABLE :: OutParam !< Names and units (and other characteristics) of all requested output parameters [-] + END TYPE SED_ParameterType +! ======================= +! ========= SED_MiscVarType ======= + TYPE, PUBLIC :: SED_MiscVarType + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: AllOuts !< Array of all outputs [-] + TYPE(MeshMapType) :: mapNac2Hub !< Mesh mapping from Nacelle to Hub (hub rotation overwritten in calc) [-] + TYPE(MeshMapType) , DIMENSION(:), ALLOCATABLE :: mapHub2Root !< Mesh mapping from Hub to BladeRootMotion (blade pitch overwritten in calc) [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: QD2T !< Current estimate of first derivative of QD (acceleration matrix) for each degree of freedom [-] + REAL(ReKi) , DIMENSION(1:3) :: HubPt_X = 0.0_ReKi !< X orientation of hub calculated in CalcOutput -- saving so we don't recalculate a bunch of things to get it in UpdateStates [-] + END TYPE SED_MiscVarType +! ======================= +CONTAINS + +subroutine SED_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg) + type(SED_InputFile), intent(in) :: SrcInputFileData + type(SED_InputFile), intent(inout) :: DstInputFileData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'SED_CopyInputFile' + ErrStat = ErrID_None + ErrMsg = '' + DstInputFileData%Echo = SrcInputFileData%Echo + DstInputFileData%DT = SrcInputFileData%DT + DstInputFileData%IntMethod = SrcInputFileData%IntMethod + DstInputFileData%GenDOF = SrcInputFileData%GenDOF + DstInputFileData%YawDOF = SrcInputFileData%YawDOF + DstInputFileData%Azimuth = SrcInputFileData%Azimuth + DstInputFileData%BlPitch = SrcInputFileData%BlPitch + DstInputFileData%RotSpeed = SrcInputFileData%RotSpeed + DstInputFileData%NacYaw = SrcInputFileData%NacYaw + DstInputFileData%PtfmPitch = SrcInputFileData%PtfmPitch + DstInputFileData%NumBl = SrcInputFileData%NumBl + DstInputFileData%TipRad = SrcInputFileData%TipRad + DstInputFileData%HubRad = SrcInputFileData%HubRad + DstInputFileData%PreCone = SrcInputFileData%PreCone + DstInputFileData%OverHang = SrcInputFileData%OverHang + DstInputFileData%ShftTilt = SrcInputFileData%ShftTilt + DstInputFileData%Twr2Shft = SrcInputFileData%Twr2Shft + DstInputFileData%TowerHt = SrcInputFileData%TowerHt + DstInputFileData%RotIner = SrcInputFileData%RotIner + DstInputFileData%GenIner = SrcInputFileData%GenIner + DstInputFileData%GBoxRatio = SrcInputFileData%GBoxRatio + DstInputFileData%SumPrint = SrcInputFileData%SumPrint + DstInputFileData%NumOuts = SrcInputFileData%NumOuts + if (allocated(SrcInputFileData%OutList)) then + LB(1:1) = lbound(SrcInputFileData%OutList) + UB(1:1) = ubound(SrcInputFileData%OutList) + if (.not. allocated(DstInputFileData%OutList)) then + allocate(DstInputFileData%OutList(LB(1):UB(1)), 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 + end if +end subroutine + +subroutine SED_DestroyInputFile(InputFileData, ErrStat, ErrMsg) + type(SED_InputFile), intent(inout) :: InputFileData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SED_DestroyInputFile' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InputFileData%OutList)) then + deallocate(InputFileData%OutList) + end if +end subroutine + +subroutine SED_PackInputFile(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SED_InputFile), intent(in) :: InData + character(*), parameter :: RoutineName = 'SED_PackInputFile' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%Echo) + call RegPack(RF, InData%DT) + call RegPack(RF, InData%IntMethod) + call RegPack(RF, InData%GenDOF) + call RegPack(RF, InData%YawDOF) + call RegPack(RF, InData%Azimuth) + call RegPack(RF, InData%BlPitch) + call RegPack(RF, InData%RotSpeed) + call RegPack(RF, InData%NacYaw) + call RegPack(RF, InData%PtfmPitch) + call RegPack(RF, InData%NumBl) + call RegPack(RF, InData%TipRad) + call RegPack(RF, InData%HubRad) + call RegPack(RF, InData%PreCone) + call RegPack(RF, InData%OverHang) + call RegPack(RF, InData%ShftTilt) + call RegPack(RF, InData%Twr2Shft) + call RegPack(RF, InData%TowerHt) + call RegPack(RF, InData%RotIner) + call RegPack(RF, InData%GenIner) + call RegPack(RF, InData%GBoxRatio) + call RegPack(RF, InData%SumPrint) + call RegPack(RF, InData%NumOuts) + call RegPackAlloc(RF, InData%OutList) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SED_UnPackInputFile(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SED_InputFile), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SED_UnPackInputFile' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%Echo); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%IntMethod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GenDOF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawDOF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Azimuth); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BlPitch); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RotSpeed); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NacYaw); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PtfmPitch); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumBl); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TipRad); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HubRad); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PreCone); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OverHang); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ShftTilt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Twr2Shft); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TowerHt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RotIner); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GenIner); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GBoxRatio); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SumPrint); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumOuts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%OutList); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SED_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) + type(SED_InitInputType), intent(in) :: SrcInitInputData + type(SED_InitInputType), intent(inout) :: DstInitInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SED_CopyInitInput' + ErrStat = ErrID_None + ErrMsg = '' + DstInitInputData%InputFile = SrcInitInputData%InputFile + DstInitInputData%RootName = SrcInitInputData%RootName + DstInitInputData%Linearize = SrcInitInputData%Linearize + DstInitInputData%UseInputFile = SrcInitInputData%UseInputFile + call NWTC_Library_CopyFileInfoType(SrcInitInputData%PassedFileData, DstInitInputData%PassedFileData, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine SED_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(SED_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SED_DestroyInitInput' + ErrStat = ErrID_None + ErrMsg = '' + call NWTC_Library_DestroyFileInfoType(InitInputData%PassedFileData, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine SED_PackInitInput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SED_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SED_PackInitInput' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%InputFile) + call RegPack(RF, InData%RootName) + call RegPack(RF, InData%Linearize) + call RegPack(RF, InData%UseInputFile) + call NWTC_Library_PackFileInfoType(RF, InData%PassedFileData) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SED_UnPackInitInput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SED_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SED_UnPackInitInput' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%InputFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RootName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Linearize); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UseInputFile); if (RegCheckErr(RF, RoutineName)) return + call NWTC_Library_UnpackFileInfoType(RF, OutData%PassedFileData) ! PassedFileData +end subroutine + +subroutine SED_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) + type(SED_InitOutputType), intent(in) :: SrcInitOutputData + type(SED_InitOutputType), intent(inout) :: DstInitOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SED_CopyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcInitOutputData%WriteOutputHdr)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) + if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then + allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitOutputData%WriteOutputUnt)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) + if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then + allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), 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 + end if + call NWTC_Library_CopyProgDesc(SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstInitOutputData%NumBl = SrcInitOutputData%NumBl + if (allocated(SrcInitOutputData%BlPitch)) then + LB(1:1) = lbound(SrcInitOutputData%BlPitch) + UB(1:1) = ubound(SrcInitOutputData%BlPitch) + if (.not. allocated(DstInitOutputData%BlPitch)) then + allocate(DstInitOutputData%BlPitch(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%BlPitch.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%BlPitch = SrcInitOutputData%BlPitch + end if + DstInitOutputData%BladeLength = SrcInitOutputData%BladeLength + DstInitOutputData%TowerHt = SrcInitOutputData%TowerHt + DstInitOutputData%HubHt = SrcInitOutputData%HubHt + DstInitOutputData%PlatformPos = SrcInitOutputData%PlatformPos + DstInitOutputData%HubRad = SrcInitOutputData%HubRad + DstInitOutputData%RotSpeed = SrcInitOutputData%RotSpeed + DstInitOutputData%GenDOF = SrcInitOutputData%GenDOF +end subroutine + +subroutine SED_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(SED_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SED_DestroyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InitOutputData%WriteOutputHdr)) then + deallocate(InitOutputData%WriteOutputHdr) + end if + if (allocated(InitOutputData%WriteOutputUnt)) then + deallocate(InitOutputData%WriteOutputUnt) + end if + call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(InitOutputData%BlPitch)) then + deallocate(InitOutputData%BlPitch) + end if +end subroutine + +subroutine SED_PackInitOutput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SED_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SED_PackInitOutput' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%WriteOutputHdr) + call RegPackAlloc(RF, InData%WriteOutputUnt) + call NWTC_Library_PackProgDesc(RF, InData%Ver) + call RegPack(RF, InData%NumBl) + call RegPackAlloc(RF, InData%BlPitch) + call RegPack(RF, InData%BladeLength) + call RegPack(RF, InData%TowerHt) + call RegPack(RF, InData%HubHt) + call RegPack(RF, InData%PlatformPos) + call RegPack(RF, InData%HubRad) + call RegPack(RF, InData%RotSpeed) + call RegPack(RF, InData%GenDOF) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SED_UnPackInitOutput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SED_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SED_UnPackInitOutput' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%WriteOutputHdr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WriteOutputUnt); if (RegCheckErr(RF, RoutineName)) return + call NWTC_Library_UnpackProgDesc(RF, OutData%Ver) ! Ver + call RegUnpack(RF, OutData%NumBl); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BlPitch); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BladeLength); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TowerHt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HubHt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PlatformPos); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HubRad); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RotSpeed); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GenDOF); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SED_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) + type(SED_InputType), intent(inout) :: SrcInputData + type(SED_InputType), intent(inout) :: DstInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SED_CopyInput' + ErrStat = ErrID_None + ErrMsg = '' + call MeshCopy(SrcInputData%HubPtLoad, DstInputData%HubPtLoad, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstInputData%HSSBrTrqC = SrcInputData%HSSBrTrqC + DstInputData%GenTrq = SrcInputData%GenTrq + if (allocated(SrcInputData%BlPitchCom)) then + LB(1:1) = lbound(SrcInputData%BlPitchCom) + UB(1:1) = ubound(SrcInputData%BlPitchCom) + if (.not. allocated(DstInputData%BlPitchCom)) then + allocate(DstInputData%BlPitchCom(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%BlPitchCom.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%BlPitchCom = SrcInputData%BlPitchCom + end if + DstInputData%YawPosCom = SrcInputData%YawPosCom + DstInputData%YawRateCom = SrcInputData%YawRateCom +end subroutine + +subroutine SED_DestroyInput(InputData, ErrStat, ErrMsg) + type(SED_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SED_DestroyInput' + ErrStat = ErrID_None + ErrMsg = '' + call MeshDestroy( InputData%HubPtLoad, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(InputData%BlPitchCom)) then + deallocate(InputData%BlPitchCom) + end if +end subroutine + +subroutine SED_PackInput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SED_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SED_PackInput' + if (RF%ErrStat >= AbortErrLev) return + call MeshPack(RF, InData%HubPtLoad) + call RegPack(RF, InData%HSSBrTrqC) + call RegPack(RF, InData%GenTrq) + call RegPackAlloc(RF, InData%BlPitchCom) + call RegPack(RF, InData%YawPosCom) + call RegPack(RF, InData%YawRateCom) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SED_UnPackInput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SED_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SED_UnPackInput' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call MeshUnpack(RF, OutData%HubPtLoad) ! HubPtLoad + call RegUnpack(RF, OutData%HSSBrTrqC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GenTrq); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BlPitchCom); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawPosCom); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawRateCom); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SED_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(SED_OutputType), intent(inout) :: SrcOutputData + type(SED_OutputType), intent(inout) :: DstOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SED_CopyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcOutputData%BladeRootMotion)) then + LB(1:1) = lbound(SrcOutputData%BladeRootMotion) + UB(1:1) = ubound(SrcOutputData%BladeRootMotion) + if (.not. allocated(DstOutputData%BladeRootMotion)) then + allocate(DstOutputData%BladeRootMotion(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%BladeRootMotion.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MeshCopy(SrcOutputData%BladeRootMotion(i1), DstOutputData%BladeRootMotion(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call MeshCopy(SrcOutputData%HubPtMotion, DstOutputData%HubPtMotion, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcOutputData%NacelleMotion, DstOutputData%NacelleMotion, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcOutputData%TowerLn2Mesh, DstOutputData%TowerLn2Mesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcOutputData%PlatformPtMesh, DstOutputData%PlatformPtMesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstOutputData%LSSTipPxa = SrcOutputData%LSSTipPxa + DstOutputData%RotSpeed = SrcOutputData%RotSpeed + DstOutputData%RotPwr = SrcOutputData%RotPwr + DstOutputData%RotTrq = SrcOutputData%RotTrq + DstOutputData%HSS_Spd = SrcOutputData%HSS_Spd + DstOutputData%Yaw = SrcOutputData%Yaw + DstOutputData%YawRate = SrcOutputData%YawRate + if (allocated(SrcOutputData%BlPitch)) then + LB(1:1) = lbound(SrcOutputData%BlPitch) + UB(1:1) = ubound(SrcOutputData%BlPitch) + if (.not. allocated(DstOutputData%BlPitch)) then + allocate(DstOutputData%BlPitch(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%BlPitch.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%BlPitch = SrcOutputData%BlPitch + end if + if (allocated(SrcOutputData%WriteOutput)) then + LB(1:1) = lbound(SrcOutputData%WriteOutput) + UB(1:1) = ubound(SrcOutputData%WriteOutput) + if (.not. allocated(DstOutputData%WriteOutput)) then + allocate(DstOutputData%WriteOutput(LB(1):UB(1)), 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 + end if +end subroutine + +subroutine SED_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(SED_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SED_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OutputData%BladeRootMotion)) then + LB(1:1) = lbound(OutputData%BladeRootMotion) + UB(1:1) = ubound(OutputData%BladeRootMotion) + do i1 = LB(1), UB(1) + call MeshDestroy( OutputData%BladeRootMotion(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(OutputData%BladeRootMotion) + end if + call MeshDestroy( OutputData%HubPtMotion, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( OutputData%NacelleMotion, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( OutputData%TowerLn2Mesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( OutputData%PlatformPtMesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(OutputData%BlPitch)) then + deallocate(OutputData%BlPitch) + end if + if (allocated(OutputData%WriteOutput)) then + deallocate(OutputData%WriteOutput) + end if +end subroutine + +subroutine SED_PackOutput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SED_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SED_PackOutput' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%BladeRootMotion)) + if (allocated(InData%BladeRootMotion)) then + call RegPackBounds(RF, 1, lbound(InData%BladeRootMotion), ubound(InData%BladeRootMotion)) + LB(1:1) = lbound(InData%BladeRootMotion) + UB(1:1) = ubound(InData%BladeRootMotion) + do i1 = LB(1), UB(1) + call MeshPack(RF, InData%BladeRootMotion(i1)) + end do + end if + call MeshPack(RF, InData%HubPtMotion) + call MeshPack(RF, InData%NacelleMotion) + call MeshPack(RF, InData%TowerLn2Mesh) + call MeshPack(RF, InData%PlatformPtMesh) + call RegPack(RF, InData%LSSTipPxa) + call RegPack(RF, InData%RotSpeed) + call RegPack(RF, InData%RotPwr) + call RegPack(RF, InData%RotTrq) + call RegPack(RF, InData%HSS_Spd) + call RegPack(RF, InData%Yaw) + call RegPack(RF, InData%YawRate) + call RegPackAlloc(RF, InData%BlPitch) + call RegPackAlloc(RF, InData%WriteOutput) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SED_UnPackOutput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SED_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SED_UnPackOutput' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + if (allocated(OutData%BladeRootMotion)) deallocate(OutData%BladeRootMotion) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%BladeRootMotion(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeRootMotion.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(RF, OutData%BladeRootMotion(i1)) ! BladeRootMotion + end do + end if + call MeshUnpack(RF, OutData%HubPtMotion) ! HubPtMotion + call MeshUnpack(RF, OutData%NacelleMotion) ! NacelleMotion + call MeshUnpack(RF, OutData%TowerLn2Mesh) ! TowerLn2Mesh + call MeshUnpack(RF, OutData%PlatformPtMesh) ! PlatformPtMesh + call RegUnpack(RF, OutData%LSSTipPxa); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RotSpeed); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RotPwr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RotTrq); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HSS_Spd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Yaw); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawRate); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BlPitch); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WriteOutput); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SED_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) + type(SED_ContinuousStateType), intent(in) :: SrcContStateData + type(SED_ContinuousStateType), intent(inout) :: DstContStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'SED_CopyContState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcContStateData%QT)) then + LB(1:1) = lbound(SrcContStateData%QT) + UB(1:1) = ubound(SrcContStateData%QT) + if (.not. allocated(DstContStateData%QT)) then + allocate(DstContStateData%QT(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%QT.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstContStateData%QT = SrcContStateData%QT + end if + if (allocated(SrcContStateData%QDT)) then + LB(1:1) = lbound(SrcContStateData%QDT) + UB(1:1) = ubound(SrcContStateData%QDT) + if (.not. allocated(DstContStateData%QDT)) then + allocate(DstContStateData%QDT(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%QDT.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstContStateData%QDT = SrcContStateData%QDT + end if +end subroutine + +subroutine SED_DestroyContState(ContStateData, ErrStat, ErrMsg) + type(SED_ContinuousStateType), intent(inout) :: ContStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SED_DestroyContState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ContStateData%QT)) then + deallocate(ContStateData%QT) + end if + if (allocated(ContStateData%QDT)) then + deallocate(ContStateData%QDT) + end if +end subroutine + +subroutine SED_PackContState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SED_ContinuousStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SED_PackContState' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%QT) + call RegPackAlloc(RF, InData%QDT) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SED_UnPackContState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SED_ContinuousStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SED_UnPackContState' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%QT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%QDT); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SED_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) + type(SED_DiscreteStateType), intent(in) :: SrcDiscStateData + type(SED_DiscreteStateType), intent(inout) :: DstDiscStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SED_CopyDiscState' + ErrStat = ErrID_None + ErrMsg = '' + DstDiscStateData%DummyDiscreteState = SrcDiscStateData%DummyDiscreteState +end subroutine + +subroutine SED_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) + type(SED_DiscreteStateType), intent(inout) :: DiscStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SED_DestroyDiscState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine SED_PackDiscState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SED_DiscreteStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SED_PackDiscState' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyDiscreteState) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SED_UnPackDiscState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SED_DiscreteStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SED_UnPackDiscState' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyDiscreteState); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SED_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) + type(SED_ConstraintStateType), intent(in) :: SrcConstrStateData + type(SED_ConstraintStateType), intent(inout) :: DstConstrStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SED_CopyConstrState' + ErrStat = ErrID_None + ErrMsg = '' + DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState +end subroutine + +subroutine SED_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) + type(SED_ConstraintStateType), intent(inout) :: ConstrStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SED_DestroyConstrState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine SED_PackConstrState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SED_ConstraintStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SED_PackConstrState' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyConstrState) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SED_UnPackConstrState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SED_ConstraintStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SED_UnPackConstrState' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyConstrState); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SED_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) + type(SED_OtherStateType), intent(in) :: SrcOtherStateData + type(SED_OtherStateType), intent(inout) :: DstOtherStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SED_CopyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + DstOtherStateData%n = SrcOtherStateData%n + LB(1:1) = lbound(SrcOtherStateData%xdot) + UB(1:1) = ubound(SrcOtherStateData%xdot) + do i1 = LB(1), UB(1) + call SED_CopyContState(SrcOtherStateData%xdot(i1), DstOtherStateData%xdot(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + DstOtherStateData%IC = SrcOtherStateData%IC + DstOtherStateData%HSSBrTrq = SrcOtherStateData%HSSBrTrq + DstOtherStateData%HSSBrTrqC = SrcOtherStateData%HSSBrTrqC + DstOtherStateData%SgnPrvLSTQ = SrcOtherStateData%SgnPrvLSTQ + DstOtherStateData%SgnLSTQ = SrcOtherStateData%SgnLSTQ +end subroutine + +subroutine SED_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) + type(SED_OtherStateType), intent(inout) :: OtherStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SED_DestroyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + LB(1:1) = lbound(OtherStateData%xdot) + UB(1:1) = ubound(OtherStateData%xdot) + do i1 = LB(1), UB(1) + call SED_DestroyContState(OtherStateData%xdot(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do +end subroutine + +subroutine SED_PackOtherState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SED_OtherStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SED_PackOtherState' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%n) + LB(1:1) = lbound(InData%xdot) + UB(1:1) = ubound(InData%xdot) + do i1 = LB(1), UB(1) + call SED_PackContState(RF, InData%xdot(i1)) + end do + call RegPack(RF, InData%IC) + call RegPack(RF, InData%HSSBrTrq) + call RegPack(RF, InData%HSSBrTrqC) + call RegPack(RF, InData%SgnPrvLSTQ) + call RegPack(RF, InData%SgnLSTQ) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SED_UnPackOtherState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SED_OtherStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SED_UnPackOtherState' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%n); if (RegCheckErr(RF, RoutineName)) return + LB(1:1) = lbound(OutData%xdot) + UB(1:1) = ubound(OutData%xdot) + do i1 = LB(1), UB(1) + call SED_UnpackContState(RF, OutData%xdot(i1)) ! xdot + end do + call RegUnpack(RF, OutData%IC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HSSBrTrq); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HSSBrTrqC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SgnPrvLSTQ); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SgnLSTQ); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(SED_ParameterType), intent(in) :: SrcParamData + type(SED_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SED_CopyParam' + ErrStat = ErrID_None + ErrMsg = '' + DstParamData%RootName = SrcParamData%RootName + DstParamData%GenDOF = SrcParamData%GenDOF + DstParamData%YawDOF = SrcParamData%YawDOF + DstParamData%DT = SrcParamData%DT + DstParamData%DT24 = SrcParamData%DT24 + DstParamData%IntMethod = SrcParamData%IntMethod + DstParamData%J_DT = SrcParamData%J_DT + DstParamData%PtfmPitch = SrcParamData%PtfmPitch + DstParamData%InitYaw = SrcParamData%InitYaw + DstParamData%InitAzimuth = SrcParamData%InitAzimuth + DstParamData%RotIner = SrcParamData%RotIner + DstParamData%GenIner = SrcParamData%GenIner + DstParamData%GBoxRatio = SrcParamData%GBoxRatio + DstParamData%NumBl = SrcParamData%NumBl + DstParamData%TipRad = SrcParamData%TipRad + DstParamData%HubRad = SrcParamData%HubRad + DstParamData%BladeLength = SrcParamData%BladeLength + DstParamData%PreCone = SrcParamData%PreCone + DstParamData%OverHang = SrcParamData%OverHang + DstParamData%ShftTilt = SrcParamData%ShftTilt + DstParamData%Twr2Shft = SrcParamData%Twr2Shft + DstParamData%TowerHt = SrcParamData%TowerHt + DstParamData%HubHt = SrcParamData%HubHt + DstParamData%NumOuts = SrcParamData%NumOuts + if (allocated(SrcParamData%OutParam)) then + LB(1:1) = lbound(SrcParamData%OutParam) + UB(1:1) = ubound(SrcParamData%OutParam) + if (.not. allocated(DstParamData%OutParam)) then + allocate(DstParamData%OutParam(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutParam.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyOutParmType(SrcParamData%OutParam(i1), DstParamData%OutParam(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if +end subroutine + +subroutine SED_DestroyParam(ParamData, ErrStat, ErrMsg) + type(SED_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SED_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ParamData%OutParam)) then + LB(1:1) = lbound(ParamData%OutParam) + UB(1:1) = ubound(ParamData%OutParam) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyOutParmType(ParamData%OutParam(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%OutParam) + end if +end subroutine + +subroutine SED_PackParam(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SED_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SED_PackParam' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%RootName) + call RegPack(RF, InData%GenDOF) + call RegPack(RF, InData%YawDOF) + call RegPack(RF, InData%DT) + call RegPack(RF, InData%DT24) + call RegPack(RF, InData%IntMethod) + call RegPack(RF, InData%J_DT) + call RegPack(RF, InData%PtfmPitch) + call RegPack(RF, InData%InitYaw) + call RegPack(RF, InData%InitAzimuth) + call RegPack(RF, InData%RotIner) + call RegPack(RF, InData%GenIner) + call RegPack(RF, InData%GBoxRatio) + call RegPack(RF, InData%NumBl) + call RegPack(RF, InData%TipRad) + call RegPack(RF, InData%HubRad) + call RegPack(RF, InData%BladeLength) + call RegPack(RF, InData%PreCone) + call RegPack(RF, InData%OverHang) + call RegPack(RF, InData%ShftTilt) + call RegPack(RF, InData%Twr2Shft) + call RegPack(RF, InData%TowerHt) + call RegPack(RF, InData%HubHt) + call RegPack(RF, InData%NumOuts) + call RegPack(RF, allocated(InData%OutParam)) + if (allocated(InData%OutParam)) then + call RegPackBounds(RF, 1, lbound(InData%OutParam), ubound(InData%OutParam)) + LB(1:1) = lbound(InData%OutParam) + UB(1:1) = ubound(InData%OutParam) + do i1 = LB(1), UB(1) + call NWTC_Library_PackOutParmType(RF, InData%OutParam(i1)) + end do + end if + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SED_UnPackParam(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SED_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SED_UnPackParam' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%RootName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GenDOF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawDOF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DT24); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%IntMethod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%J_DT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PtfmPitch); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%InitYaw); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%InitAzimuth); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RotIner); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GenIner); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GBoxRatio); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumBl); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TipRad); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HubRad); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BladeLength); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PreCone); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OverHang); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ShftTilt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Twr2Shft); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TowerHt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HubHt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumOuts); if (RegCheckErr(RF, RoutineName)) return + if (allocated(OutData%OutParam)) deallocate(OutData%OutParam) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%OutParam(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackOutParmType(RF, OutData%OutParam(i1)) ! OutParam + end do + end if +end subroutine + +subroutine SED_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(SED_MiscVarType), intent(inout) :: SrcMiscData + type(SED_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SED_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcMiscData%AllOuts)) then + LB(1:1) = lbound(SrcMiscData%AllOuts) + UB(1:1) = ubound(SrcMiscData%AllOuts) + if (.not. allocated(DstMiscData%AllOuts)) then + allocate(DstMiscData%AllOuts(LB(1):UB(1)), 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 + end if + call NWTC_Library_CopyMeshMapType(SrcMiscData%mapNac2Hub, DstMiscData%mapNac2Hub, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcMiscData%mapHub2Root)) then + LB(1:1) = lbound(SrcMiscData%mapHub2Root) + UB(1:1) = ubound(SrcMiscData%mapHub2Root) + if (.not. allocated(DstMiscData%mapHub2Root)) then + allocate(DstMiscData%mapHub2Root(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%mapHub2Root.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcMiscData%mapHub2Root(i1), DstMiscData%mapHub2Root(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcMiscData%QD2T)) then + LB(1:1) = lbound(SrcMiscData%QD2T) + UB(1:1) = ubound(SrcMiscData%QD2T) + if (.not. allocated(DstMiscData%QD2T)) then + allocate(DstMiscData%QD2T(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%QD2T.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%QD2T = SrcMiscData%QD2T + end if + DstMiscData%HubPt_X = SrcMiscData%HubPt_X +end subroutine + +subroutine SED_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(SED_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SED_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(MiscData%AllOuts)) then + deallocate(MiscData%AllOuts) + end if + call NWTC_Library_DestroyMeshMapType(MiscData%mapNac2Hub, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(MiscData%mapHub2Root)) then + LB(1:1) = lbound(MiscData%mapHub2Root) + UB(1:1) = ubound(MiscData%mapHub2Root) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(MiscData%mapHub2Root(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%mapHub2Root) + end if + if (allocated(MiscData%QD2T)) then + deallocate(MiscData%QD2T) + end if +end subroutine + +subroutine SED_PackMisc(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SED_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SED_PackMisc' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%AllOuts) + call NWTC_Library_PackMeshMapType(RF, InData%mapNac2Hub) + call RegPack(RF, allocated(InData%mapHub2Root)) + if (allocated(InData%mapHub2Root)) then + call RegPackBounds(RF, 1, lbound(InData%mapHub2Root), ubound(InData%mapHub2Root)) + LB(1:1) = lbound(InData%mapHub2Root) + UB(1:1) = ubound(InData%mapHub2Root) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(RF, InData%mapHub2Root(i1)) + end do + end if + call RegPackAlloc(RF, InData%QD2T) + call RegPack(RF, InData%HubPt_X) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SED_UnPackMisc(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SED_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SED_UnPackMisc' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%AllOuts); if (RegCheckErr(RF, RoutineName)) return + call NWTC_Library_UnpackMeshMapType(RF, OutData%mapNac2Hub) ! mapNac2Hub + if (allocated(OutData%mapHub2Root)) deallocate(OutData%mapHub2Root) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%mapHub2Root(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%mapHub2Root.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(RF, OutData%mapHub2Root(i1)) ! mapHub2Root + end do + end if + call RegUnpackAlloc(RF, OutData%QD2T); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HubPt_X); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SED_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(SED_InputType), intent(inout) :: u(:) ! Input at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Inputs + type(SED_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 = 'SED_Input_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(u)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(u)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(u) - 1 + select case (order) + case (0) + call SED_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call SED_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call SED_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(u) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE SED_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(SED_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 + TYPE(SED_InputType), INTENT(INOUT) :: u2 ! Input at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs + TYPE(SED_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 = 'SED_Input_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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 + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + CALL MeshExtrapInterp1(u1%HubPtLoad, u2%HubPtLoad, tin, u_out%HubPtLoad, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + u_out%HSSBrTrqC = a1*u1%HSSBrTrqC + a2*u2%HSSBrTrqC + u_out%GenTrq = a1*u1%GenTrq + a2*u2%GenTrq + IF (ALLOCATED(u_out%BlPitchCom) .AND. ALLOCATED(u1%BlPitchCom)) THEN + do i1 = lbound(u_out%BlPitchCom,1),ubound(u_out%BlPitchCom,1) + CALL Angles_ExtrapInterp( u1%BlPitchCom(i1), u2%BlPitchCom(i1), tin, u_out%BlPitchCom(i1), tin_out ) + END DO + END IF ! check if allocated + u_out%YawPosCom = a1*u1%YawPosCom + a2*u2%YawPosCom + u_out%YawRateCom = a1*u1%YawRateCom + a2*u2%YawRateCom +END SUBROUTINE + +SUBROUTINE SED_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(SED_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 > t3 + TYPE(SED_InputType), INTENT(INOUT) :: u2 ! Input at t2 > t3 + TYPE(SED_InputType), INTENT(INOUT) :: u3 ! Input at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs + TYPE(SED_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) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'SED_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 + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + CALL MeshExtrapInterp2(u1%HubPtLoad, u2%HubPtLoad, u3%HubPtLoad, tin, u_out%HubPtLoad, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + u_out%HSSBrTrqC = a1*u1%HSSBrTrqC + a2*u2%HSSBrTrqC + a3*u3%HSSBrTrqC + u_out%GenTrq = a1*u1%GenTrq + a2*u2%GenTrq + a3*u3%GenTrq + IF (ALLOCATED(u_out%BlPitchCom) .AND. ALLOCATED(u1%BlPitchCom)) THEN + do i1 = lbound(u_out%BlPitchCom,1),ubound(u_out%BlPitchCom,1) + CALL Angles_ExtrapInterp( u1%BlPitchCom(i1), u2%BlPitchCom(i1), u3%BlPitchCom(i1), tin, u_out%BlPitchCom(i1), tin_out ) + END DO + END IF ! check if allocated + u_out%YawPosCom = a1*u1%YawPosCom + a2*u2%YawPosCom + a3*u3%YawPosCom + u_out%YawRateCom = a1*u1%YawRateCom + a2*u2%YawRateCom + a3*u3%YawRateCom +END SUBROUTINE + +subroutine SED_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(SED_OutputType), intent(inout) :: y(:) ! Output at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Outputs + type(SED_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 = 'SED_Output_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(y)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(y)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(y) - 1 + select case (order) + case (0) + call SED_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call SED_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call SED_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(y) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE SED_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(SED_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 + TYPE(SED_OutputType), INTENT(INOUT) :: y2 ! Output at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs + TYPE(SED_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 = 'SED_Output_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! 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 + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + IF (ALLOCATED(y_out%BladeRootMotion) .AND. ALLOCATED(y1%BladeRootMotion)) THEN + do i1 = lbound(y_out%BladeRootMotion,1),ubound(y_out%BladeRootMotion,1) + CALL MeshExtrapInterp1(y1%BladeRootMotion(i1), y2%BladeRootMotion(i1), tin, y_out%BladeRootMotion(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + CALL MeshExtrapInterp1(y1%HubPtMotion, y2%HubPtMotion, tin, y_out%HubPtMotion, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp1(y1%NacelleMotion, y2%NacelleMotion, tin, y_out%NacelleMotion, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp1(y1%TowerLn2Mesh, y2%TowerLn2Mesh, tin, y_out%TowerLn2Mesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp1(y1%PlatformPtMesh, y2%PlatformPtMesh, tin, y_out%PlatformPtMesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL Angles_ExtrapInterp( y1%LSSTipPxa, y2%LSSTipPxa, tin, y_out%LSSTipPxa, tin_out ) + y_out%RotSpeed = a1*y1%RotSpeed + a2*y2%RotSpeed + y_out%RotPwr = a1*y1%RotPwr + a2*y2%RotPwr + y_out%RotTrq = a1*y1%RotTrq + a2*y2%RotTrq + y_out%HSS_Spd = a1*y1%HSS_Spd + a2*y2%HSS_Spd + y_out%Yaw = a1*y1%Yaw + a2*y2%Yaw + y_out%YawRate = a1*y1%YawRate + a2*y2%YawRate + IF (ALLOCATED(y_out%BlPitch) .AND. ALLOCATED(y1%BlPitch)) THEN + do i1 = lbound(y_out%BlPitch,1),ubound(y_out%BlPitch,1) + CALL Angles_ExtrapInterp( y1%BlPitch(i1), y2%BlPitch(i1), tin, y_out%BlPitch(i1), tin_out ) + END DO + END IF ! check if allocated + IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + END IF ! check if allocated +END SUBROUTINE + +SUBROUTINE SED_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(SED_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 > t3 + TYPE(SED_OutputType), INTENT(INOUT) :: y2 ! Output at t2 > t3 + TYPE(SED_OutputType), INTENT(INOUT) :: y3 ! Output at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs + TYPE(SED_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) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'SED_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 + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + IF (ALLOCATED(y_out%BladeRootMotion) .AND. ALLOCATED(y1%BladeRootMotion)) THEN + do i1 = lbound(y_out%BladeRootMotion,1),ubound(y_out%BladeRootMotion,1) + CALL MeshExtrapInterp2(y1%BladeRootMotion(i1), y2%BladeRootMotion(i1), y3%BladeRootMotion(i1), tin, y_out%BladeRootMotion(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + CALL MeshExtrapInterp2(y1%HubPtMotion, y2%HubPtMotion, y3%HubPtMotion, tin, y_out%HubPtMotion, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp2(y1%NacelleMotion, y2%NacelleMotion, y3%NacelleMotion, tin, y_out%NacelleMotion, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp2(y1%TowerLn2Mesh, y2%TowerLn2Mesh, y3%TowerLn2Mesh, tin, y_out%TowerLn2Mesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp2(y1%PlatformPtMesh, y2%PlatformPtMesh, y3%PlatformPtMesh, tin, y_out%PlatformPtMesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL Angles_ExtrapInterp( y1%LSSTipPxa, y2%LSSTipPxa, y3%LSSTipPxa, tin, y_out%LSSTipPxa, tin_out ) + y_out%RotSpeed = a1*y1%RotSpeed + a2*y2%RotSpeed + a3*y3%RotSpeed + y_out%RotPwr = a1*y1%RotPwr + a2*y2%RotPwr + a3*y3%RotPwr + y_out%RotTrq = a1*y1%RotTrq + a2*y2%RotTrq + a3*y3%RotTrq + y_out%HSS_Spd = a1*y1%HSS_Spd + a2*y2%HSS_Spd + a3*y3%HSS_Spd + y_out%Yaw = a1*y1%Yaw + a2*y2%Yaw + a3*y3%Yaw + y_out%YawRate = a1*y1%YawRate + a2*y2%YawRate + a3*y3%YawRate + IF (ALLOCATED(y_out%BlPitch) .AND. ALLOCATED(y1%BlPitch)) THEN + do i1 = lbound(y_out%BlPitch,1),ubound(y_out%BlPitch,1) + CALL Angles_ExtrapInterp( y1%BlPitch(i1), y2%BlPitch(i1), y3%BlPitch(i1), tin, y_out%BlPitch(i1), tin_out ) + END DO + END IF ! check if allocated + IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + a3*y3%WriteOutput + END IF ! check if allocated +END SUBROUTINE +END MODULE SED_Types +!ENDOFREGISTRYGENERATEDFILE diff --git a/modules/simple-elastodyn/src/driver/SED_Driver.f90 b/modules/simple-elastodyn/src/driver/SED_Driver.f90 new file mode 100644 index 0000000000..900c7ea938 --- /dev/null +++ b/modules/simple-elastodyn/src/driver/SED_Driver.f90 @@ -0,0 +1,373 @@ +!********************************************************************************************************************************** +!> ## SED_DriverCode: This code tests the SED module +!!.................................................................................................................................. +!! LICENSING +!! Copyright (C) 2024 National Renewable Energy Laboratory +!! +!! This file is part of SED. +!! +!! 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 SED_Driver + + USE NWTC_Library + USE VersionInfo + USE SED + USE SED_IO + USE SED_Types + USE SED_Driver_Subs + USE SED_Driver_Types + + IMPLICIT NONE + + TYPE( ProgDesc ), PARAMETER :: ProgInfo = ProgDesc("SED_Driver","","") + INTEGER(IntKi) :: SEDDriver_Verbose = 5 ! Verbose level. 0 = none, 5 = some, 10 = lots + + + + integer(IntKi), parameter :: NumInp = 3 !< Number of inputs sent to SED_UpdateStates (InterpOrder+1) + + ! Program variables + real(DbKi) :: T !< Variable for storing time, in seconds + real(DbKi) :: TimeInterval !< Interval between time steps, in seconds + real(DbKi) :: TStart !< Time to start + real(DbKi) :: TMax !< Maximum time if found by default + integer(IntKi) :: NumTSteps !< number of timesteps + logical :: TimeIntervalFound !< Interval between time steps, in seconds + real(DbKi) :: uTimes(NumInp) !< Variable for storing time associated with inputs, in seconds + real(DbKi), allocatable :: CaseTime(:) !< Timestamps for the case data + real(ReKi), allocatable :: CaseData(:,:) !< Data for the case. Corresponds to CaseTime + + type(SED_InitInputType) :: InitInData !< Input data for initialization + type(SED_InitOutputType) :: InitOutData !< Output data from initialization + + type(SED_ContinuousStateType) :: x !< Continuous states + type(SED_DiscreteStateType) :: xd !< Discrete states + type(SED_ConstraintStateType) :: z !< Constraint states + type(SED_ConstraintStateType) :: Z_residual !< Residual of the constraint state functions (Z) + type(SED_OtherStateType) :: OtherState !< Other states + type(SED_MiscVarType) :: misc !< Optimization variables + + type(SED_ParameterType) :: p !< Parameters + type(SED_InputType) :: u(NumInp) !< System inputs + type(SED_OutputType) :: y !< System outputs + + ! Local variables for this code + TYPE(SEDDriver_Flags) :: CLSettingsFlags ! Flags indicating which command line arguments were specified + TYPE(SEDDriver_Settings) :: CLSettings ! Command line arguments passed in + TYPE(SEDDriver_Flags) :: SettingsFlags ! Flags indicating which settings were specified (includes CL and ipt file) + TYPE(SEDDriver_Settings) :: Settings ! Driver settings + REAL(DbKi) :: Timer(1:2) ! Keep track of how long this takes to run + type(FileInfoType) :: DvrFileInfo ! Input file stored in FileInfoType structure + + + ! Data transfer + real(ReKi) :: AeroTrq !< AeroTrq read from table -- must be put onto mesh for passing + + INTEGER(IntKi) :: n !< Loop counter (for time step) + integer(IntKi) :: i !< generic loop counter + integer(IntKi) :: DimIdx !< Index of current dimension + integer(IntKi) :: TmpIdx !< Index of last point accessed by dimension + INTEGER(IntKi) :: ErrStat !< Status of error message + CHARACTER(ErrMsgLen) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + CHARACTER(200) :: git_commit ! String containing the current git commit hash + TYPE(ProgDesc), PARAMETER :: version = ProgDesc( 'SED Driver', '', '' ) ! The version number of this program. + integer(IntKi) :: DvrOut + character(1024) :: OutputFileRootName + + + ! initialize library + call NWTC_Init + call DispNVD(ProgInfo) + DvrOut=-1 ! Set output unit to negative + + ! 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 '//GetNVD( version )//' a part of OpenFAST - '//TRIM(git_Commit)//NewLine//' linked with '//TRIM( GetNVD( NWTC_Ver ))//NewLine ) + + ! Start the timer + call CPU_TIME( Timer(1) ) + + ! Initialize the driver settings to their default values (same as the CL -- command line -- values) + call InitSettingsFlags( ProgInfo, CLSettings, CLSettingsFlags ) + Settings = CLSettings + SettingsFlags = CLSettingsFlags + + ! Parse the input line + call RetrieveArgs( CLSettings, CLSettingsFlags, ErrStat, ErrMsg ) + call CheckErr('') + + ! Check if we are doing verbose error reporting + IF ( CLSettingsFlags%VVerbose ) SEDDriver_Verbose = 10_IntKi + IF ( CLSettingsFlags%Verbose ) SEDDriver_Verbose = 7_IntKi + + ! Verbose error reporting + IF ( SEDDriver_Verbose >= 10_IntKi ) THEN + CALL WrScr('--- Settings from the command line: ---') + CALL printSettings( CLSettingsFlags, CLSettings ) + CALL WrSCr(NewLine) + ENDIF + + ! Verbose error reporting + IF ( SEDDriver_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%SEDIptFile = CLSettingsFlags%SEDIptFile + Settings%SEDIptFileName = CLSettings%SEDIptFileName + ENDIF + + ! If the filename given was not the SED 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 ProcessComFile( CLSettings%DvrIptFileName, DvrFileInfo, ErrStat, ErrMsg ) + call CheckErr('') + + ! For diagnostic purposes, the following can be used to display the contents + ! of the DvrFileInfo data structure. + ! call Print_FileInfo_Struct( CU, DvrFileInfo ) ! CU is the screen -- different number on different systems. + + ! Parse the input file + CALL ParseDvrIptFile( CLSettings%DvrIptFileName, DvrFileInfo, SettingsFlags, Settings, ProgInfo, CaseTime, CaseData, ErrStat, ErrMsg ) + call CheckErr('') + + ! VVerbose error reporting + IF ( SEDDriver_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 ( SEDDriver_Verbose >= 10_IntKi ) CALL WrScr('Updating driver settings with command line arguments') + + ELSE + + ! VVerbose error reporting + IF ( SEDDriver_Verbose >= 10_IntKi ) CALL WrScr('No driver input file used. Updating driver settings with command line arguments') + + ENDIF + + ! 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 SettingsFlags%DvrIptFile is a flag indicating + ! if the driver input file read. + CALL UpdateSettingsWithCL( SettingsFlags, Settings, CLSettingsFlags, CLSettings, SettingsFlags%DvrIptFile, ErrStat, ErrMsg ) + call CheckErr('') + + ! Verbose error reporting + IF ( SEDDriver_Verbose >= 10_IntKi ) THEN + CALL WrScr(NewLine//'--- Driver settings after copying over CL settings: ---') + CALL printSettings( SettingsFlags, Settings ) + CALL WrScr(NewLine) + ENDIF + + + + !------------------------------------------ + ! Logic for timestep and total time for sim. + !------------------------------------------ + if ( SettingsFlags%TStart ) then + TStart = Settings%TStart + else + TStart = 0.0_DbKi + ! TODO: if using the input file, could start at the initial time given there (set the TStart with a "default" input option) + endif + + + TimeIntervalFound=.true. ! If specified or default value set + ! DT - timestep. If default was specified, then calculate default level. + if ( SettingsFlags%DTdefault ) then + ! Set a value to start with (something larger than any expected DT). + TimeIntervalFound=.false. + TimeInterval=1000.0_DbKi + ! Step through all lines to get smallest DT + do n=min(2,size(CaseTime)),size(CaseTime) ! Start at 2nd point (min to avoid stepping over end for single line files) + TimeInterval=min(TimeInterval, real(CaseTime(n)-CaseTime(n-1), DbKi)) + TimeIntervalFound=.true. + enddo + if (TimeIntervalFound) then + call WrScr('Using smallest DT from data file: '//trim(Num2LStr(TimeInterval))//' seconds.') + else + call WrScr('No time timesteps found in input displacement file. Using only one timestep.') + endif + endif + + + ! TMax and NumTSteps from input file or from the value specified (specified overrides) + if ( SettingsFlags%NumTimeStepsDefault ) then + TMax = CaseTime(size(CaseTime)) + NumTSteps = ceiling( TMax / TimeInterval ) + elseif ( SettingsFlags%NumTimeSteps ) then ! Override with number of timesteps + TMax = TimeInterval * Settings%NumTimeSteps + TStart + NumTSteps = Settings%NumTimeSteps + else + NumTSteps = 1_IntKi + TMax = TimeInterval * NumTSteps + endif + Settings%NumTimeSteps = NumTSteps + + + ! Routines called in initialization + !............................................................................................................................... + + InitInData%InputFile = Settings%SEDIptFileName + InitInData%RootName = Settings%OutRootName + + ! Initialize the module + CALL SED_Init( InitInData, u(1), p, x, xd, z, OtherState, y, misc, TimeInterval, InitOutData, ErrStat, ErrMsg ) + call CheckErr('After Init: '); + + ! Make sure don't use a High-speed brake with RK4 method + if (.not. EqualRealNos( maxval(abs(CaseData(2,:))), 0.0_ReKi)) then + if (p%IntMethod == Method_RK4) then ! only works with AB4 or ABM4 + ErrStat = ErrID_Fatal + ErrMsg = 'Simplified-ElastoDyn (SED) must use the AB4 or ABM4 integration method to implement high-speed shaft braking.' + call CheckErr('') + endif + endif + + do i = 2, NumInp + call SED_CopyInput(u(1),u(i),MESH_NEWCOPY, ErrStat, ErrMsg) + call CheckErr('CopyInput') + enddo + + ! Set the output file + call GetRoot(Settings%OutRootName,OutputFileRootName) + call Dvr_InitializeOutputFile(DvrOut, InitOutData, OutputFileRootName, ErrStat, ErrMsg) + call CheckErr('Setting output file'); + + ! Destroy initialization data + CALL SED_DestroyInitInput( InitInData, ErrStat, ErrMsg ) + CALL SED_DestroyInitOutput( InitOutData, ErrStat, ErrMsg ) + + n = 0 + if (Settings%WrVTK > 0_IntKi) then + call WrVTK_refMeshes(Settings, p, y, ErrStat,ErrMsg) + call CheckErr('After WrVTK_refMeshes: '); + endif + + + ! Routines called in loose coupling -- the glue code may implement this in various ways + !............................................................................................................................... + + + T = TStart + + ! Get values from table + do i = 1, NumInp-1 !u(NumInp) is overwritten in time-sim loop, so no need to init here + AeroTrq = InterpStp( real(T,ReKi), real(CaseTime(:),ReKi), CaseData(1,:), TmpIdx, size(CaseTime) ) + u(i)%HubPtLoad%Moment(1:3,1) = y%HubPtMotion%Orientation(1,1:3,1) * AeroTrq + u(i)%HSSBrTrqC = InterpStp( real(T,ReKi), real(CaseTime(:),ReKi), CaseData(2,:), TmpIdx, size(CaseTime) ) + u(i)%GenTrq = InterpStp( real(T,ReKi), real(CaseTime(:),ReKi), CaseData(3,:), TmpIdx, size(CaseTime) ) + u(i)%BlPitchCom = InterpStp( real(T,ReKi), real(CaseTime(:),ReKi), CaseData(4,:), TmpIdx, size(CaseTime) ) + u(i)%YawPosCom = InterpStp( real(T,ReKi), real(CaseTime(:),ReKi), CaseData(5,:), TmpIdx, size(CaseTime) ) + u(i)%YawRateCom = InterpStp( real(T,ReKi), real(CaseTime(:),ReKi), CaseData(6,:), TmpIdx, size(CaseTime) ) + uTimes(i) = TStart - real((i-1),R8Ki) * TimeInterval + enddo + + + + + ! Calculate outputs at TStart + CALL SED_CalcOutput( T, u(1), p, x, xd, z, OtherState, y, misc, ErrStat, ErrMsg ); + call CheckErr('After CalcOutput: '); + + if (Settings%WrVTK > 1_IntKi) then + call WrVTK_Meshes(Settings, p, y, n, ErrStat,ErrMsg) + call CheckErr('Time: '//trim(Num2LStr(T))//'After WrVTK_Meshes: '); + endif + + call Dvr_WriteOutputLine(TStart,DvrOut,"ES20.12E2",y) + + TmpIdx = 0_IntKi + DO n = 1,NumTSteps + ! Step the states back one step + do i = NumInp-1, 1, -1 + u( i+1) = u( i) + uTimes(i+1) = uTimes(i) + enddo + + uTimes(1) = n*TimeInterval+TStart + + ! InterpStpReal( T, Tary, Vary, TmpIdx, size) + AeroTrq = InterpStp( real(T+TimeInterval,ReKi), real(CaseTime(:),ReKi), CaseData(1,:), TmpIdx, size(CaseTime) ) + u(1)%HubPtLoad%Moment(1:3,1) = y%HubPtMotion%Orientation(1,1:3,1) * AeroTrq + u(1)%HSSBrTrqC = InterpStp( real(T+TimeInterval,ReKi), real(CaseTime(:),ReKi), CaseData(2,:), TmpIdx, size(CaseTime) ) + u(1)%GenTrq = InterpStp( real(T+TimeInterval,ReKi), real(CaseTime(:),ReKi), CaseData(3,:), TmpIdx, size(CaseTime) ) + u(1)%BlPitchCom = InterpStp( real(T+TimeInterval,ReKi), real(CaseTime(:),ReKi), CaseData(4,:), TmpIdx, size(CaseTime) ) + u(1)%YawPosCom = InterpStp( real(T+TimeInterval,ReKi), real(CaseTime(:),ReKi), CaseData(5,:), TmpIdx, size(CaseTime) ) + u(1)%YawRateCom = InterpStp( real(T+TimeInterval,ReKi), real(CaseTime(:),ReKi), CaseData(6,:), TmpIdx, size(CaseTime) ) + + ! There are no states to update in SED, but for completeness we add this. + ! Get state variables at next step: INPUT at step n, OUTPUT at step n + 1 + CALL SED_UpdateStates( uTimes(2), n, u, uTimes, p, x, xd, z, OtherState, misc, ErrStat, ErrMsg ); + call CheckErr(''); + + ! Calculate outputs at n + CALL SED_CalcOutput( uTimes(1), u(1), p, x, xd, z, OtherState, y, misc, ErrStat, ErrMsg ); + call CheckErr('After CalcOutput: '); + + if (Settings%WrVTK > 1_IntKi) then + call WrVTK_Meshes(Settings, p, y, n, ErrStat,ErrMsg) + call CheckErr('Time: '//trim(Num2LStr(uTimes(1)))//'After WrVTK_Meshes: '); + endif + + call Dvr_WriteOutputLine(uTimes(1),DvrOut,"ES20.12E2",y) + END DO + + + + + !............................................................................................................................... + ! Routine to terminate program execution + !............................................................................................................................... + if (DvrOut>0) close(DvrOut) + CALL SED_End( u(1), p, x, xd, z, OtherState, y, misc, ErrStat, ErrMsg ) + + IF ( ErrStat /= ErrID_None ) THEN + CALL WrScr( 'After End: '//ErrMsg ) + ELSE + call WrSCr( 'Simple-ElastoDyn completed' ) + END IF + +CONTAINS + subroutine CheckErr(Text) + character(*), intent(in) :: Text + IF ( ErrStat /= ErrID_None ) THEN ! Check if there was an error and do something about it if necessary + CALL WrScr( Text//trim(ErrMsg) ) + if ( ErrStat >= AbortErrLev ) call ProgEnd() + END IF + end subroutine CheckErr + subroutine ProgEnd() + ! Placeholder for moment + if (DvrOut>0) close(DvrOut) + CALL SED_End( u(1), p, x, xd, z, OtherState, y, misc, ErrStat, ErrMsg ) + Call ProgAbort('Fatal error encountered. Ending.') + end subroutine ProgEnd +END PROGRAM SED_Driver diff --git a/modules/simple-elastodyn/src/driver/SED_Driver_Subs.f90 b/modules/simple-elastodyn/src/driver/SED_Driver_Subs.f90 new file mode 100644 index 0000000000..554526d1ff --- /dev/null +++ b/modules/simple-elastodyn/src/driver/SED_Driver_Subs.f90 @@ -0,0 +1,850 @@ +!********************************************************************************************************************************** +! +! MODULE: SED_Driver_Subs - This module contains subroutines used by the SED Driver program +! +!********************************************************************************************************************************** +!********************************************************************************************************************************** +! LICENSING +! Copyright (C) 2020 National Renewable Energy Laboratory +! +! This file is part of SED. +! +! 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 SED_Driver_Subs + + USE NWTC_Library + USE SED_Driver_Types + IMPLICIT NONE + +! NOTE: This is loosely based on the InflowWind driver code. + + +CONTAINS +!-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- +!> Print out help information +SUBROUTINE DispHelpText() + ! Statement about usage + CALL WrScr("") + CALL WrScr(" Syntax: SED_Driver [options]") + CALL WrScr("") + CALL WrScr(" where: -- Name of driver input file to use") + CALL WrScr(" options: "//SWChar//"sed -- treat as name of SED input file") + CALL WrScr(" (no driver input file)") + CALL WrScr("") + CALL WrScr(" The following options will overwrite values in the driver input file:") + CALL WrScr(" "//SwChar//"DT[#] -- timestep ") + CALL WrScr(" "//SwChar//"TStart[#] -- start time ") + CALL WrScr(" "//SwChar//"TSteps[#] -- number of timesteps ") + CALL WrScr(" "//SwChar//"v -- verbose output ") + CALL WrScr(" "//SwChar//"vv -- very verbose output ") + CALL WrScr(" "//SwChar//"NonLinear -- only return non-linear portion of reaction force") + CALL WrScr(" "//SwChar//"help -- print this help menu and exit") + CALL WrScr("") + CALL WrScr(" Notes:") + CALL WrScr(" -- Options are not case sensitive.") + CALL WrScr("") +!FIXME: update this +END SUBROUTINE DispHelpText + + +subroutine InitSettingsFlags( ProgInfo, CLSettings, CLFlags ) + implicit none + ! Storing the arguments + type( ProgDesc ), intent(in ) :: ProgInfo + type( SEDDriver_Settings ), intent( out) :: CLSettings !< Command line arguments passed in + type( SEDDriver_Flags ), intent( out) :: CLFlags !< Flags indicating which command line arguments were specified + + ! Set some CLSettings to null/default values + CLSettings%DvrIptFileName = "" ! No input name name until set + CLSettings%SEDIptFileName = "" ! No SED input file name until set + CLSettings%NumTimeSteps = 0_IntKi + CLSettings%DT = 0.0_DbKi + CLSettings%TStart = 0.0_ReKi + CLSettings%ProgInfo = ProgInfo ! Driver info + + ! Set some CLFlags to null/default values + CLFlags%DvrIptFile = .FALSE. ! Driver input filename given as command line argument + CLFlags%SEDIptFile = .FALSE. ! SED input filename given as command line argument + CLFlags%TStart = .FALSE. ! specified time to start at + CLFlags%NumTimeSteps = .FALSE. ! specified a number of timesteps + CLFlags%NumTimeStepsDefault = .FALSE. ! specified 'DEFAULT' for number of timesteps + CLFlags%DT = .FALSE. ! specified a resolution in time + CLFlags%DTDefault = .FALSE. ! specified 'DEFAULT' for resolution in time + CLFlags%Verbose = .FALSE. ! Turn on verbose error reporting? + CLFlags%VVerbose = .FALSE. ! Turn on very verbose error reporting? + +end subroutine InitSettingsFlags + +!-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- +!> This subroutine retrieves the command line arguments and passes them to the +!! SED_driver_subs::parsearg routine for processing. +SUBROUTINE RetrieveArgs( CLSettings, CLFlags, ErrStat, ErrMsg ) + ! Storing the arguments + type( SEDDriver_Flags ), intent( out) :: CLFlags !< Flags indicating which command line arguments were specified + type( SEDDriver_Settings ), intent( out) :: CLSettings !< Command line arguments passed in + 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 :: sedFlag !< The -sed 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) + + ! initialize some things + CLFlags%DvrIptFile = .FALSE. + ErrStat = ErrID_None + ErrStatTmp = ErrID_None + ErrMsg = '' + ErrMsgTmp = '' + sedFlag = .FALSE. + 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,'RetrieveArgs') + 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() + 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:), sedFlag, ErrStatTmp, ErrMsgTmp ) + CALL SetErrStat(ErrStatTmp,ErrMsgTmp,ErrStat,ErrMsg,'RetrieveArgs') + 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,'RetrieveArgs') + 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, 'RetrieveArgs' ) + RETURN + ENDIF + + ! Was the -sed flag set? If so, the filename is the SED input file. Otherwise + ! it is the driver input file. + IF ( sedFlag ) THEN + CLSettings%SEDIptFileName = TRIM(FileName) + CLFlags%SEDIptFile = .TRUE. + call GetRoot( CLSettings%SEDIptFileName, CLSettings%OutRootName ) + CLFlags%OutRootName = .TRUE. + ELSE + CLSettings%DvrIptFileName = TRIM(FileName) + CLFlags%DvrIptFile = .TRUE. + ENDIF + + + + !------------------------------------------------------------------------------- + !------------------------------------------------------------------------------- + CONTAINS + + + !------------------------------------------------------------------------------- + !> Convert a string to a real number + FUNCTION StringToReal( StringIn, ErrStat ) + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT(IN ) :: StringIn + + REAL(ReKi) :: StringToReal + 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, sedFlagSet, ErrStat, ErrMsg ) + !-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-! + ! Parse and store the input argument ! + !-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-! + + USE NWTC_Library + USE SED_Driver_Types + USE SED_Types + + IMPLICIT NONE + + ! Storing the arguments + TYPE( SEDDriver_Flags ), INTENT(INOUT) :: CLFlags ! Flags indicating which arguments were specified + TYPE( SEDDriver_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) :: sedFlagSet ! Was the -sed 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 + REAL(ReKi) :: TempReal ! temp variable to hold a real + + INTEGER(IntKi) :: ErrStatTmp ! Temporary error status for calls + + + + ! 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,'ParseArg') + 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,'ParseArg') + 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 SED input file + IF ( ThisArgUC(1:4) == "SED" ) THEN + sedFlagSet = .TRUE. ! More logic in the routine that calls this one to set things. + 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,'ParseArg') + ENDIF + + ENDIF + + + ! "DT[#]" + IF( ThisArgUC(1:Delim1) == "DT[" ) THEN + TempReal = StringToReal( ThisArgUC(Delim1+1:Delim2-1), ErrStat ) + IF ( ErrStat == ErrID_None ) THEN + CLFlags%Dt = .TRUE. + CLSettings%DT = abs(TempReal) + ELSE + CLFlags%Dt = .FALSE. + IF ( ErrStat == ErrID_Warn ) THEN + CALL SetErrStat(ErrStatTmp," Invalid number in option '"//SwChar//TRIM(ThisArg)//"'. Ignoring.", & + ErrStat,ErrMsg,'ParseArgs') + ELSE + CALL SetErrStat( ErrID_Fatal," Something failed in parsing option '"//SwChar//TRIM(ThisArg)//"'.", & + ErrStat, ErrMsg, 'ParseArg') + ENDIF + RETURN + ENDIF + + + ! "TSTEPS[#]" + ELSEIF( ThisArgUC(1:Delim1) == "TSTEPS[" ) THEN + TempReal = StringToReal( ThisArgUC(Delim1+1:Delim2-1), ErrStat ) + IF ( ErrStat == ErrID_None ) THEN + CLFlags%NumTimeSteps = .TRUE. + CLSettings%NumTimeSteps = nint(abs(TempReal)) + ELSE + CLFlags%NumTimeSteps = .FALSE. + CLSettings%NumTimeSteps = 1_IntKi + IF ( ErrStat == ErrID_Warn ) THEN + CALL SetErrStat(ErrStatTmp," Invalid number in option '"//SwChar//TRIM(ThisArg)//"'. Ignoring.", & + ErrStat,ErrMsg,'ParseArgs') + ELSE + CALL SetErrStat( ErrID_Fatal," Something failed in parsing option '"//SwChar//TRIM(ThisArg)//"'.", & + ErrStat, ErrMsg, 'ParseArg') + ENDIF + RETURN + ENDIF + + + + ! "TSTART[#]" + ELSEIF( ThisArgUC(1:Delim1) == "TSTART[" ) THEN + TempReal = StringToReal( ThisArgUC(Delim1+1:Delim2-1), ErrStat ) + IF ( ErrStat == ErrID_None ) THEN + CLFlags%TStart = .TRUE. + CLSettings%TStart = abs(TempReal) + ELSE + CLFlags%TStart = .FALSE. + IF ( ErrStat == ErrID_Warn ) THEN + CALL SetErrStat(ErrStatTmp," Invalid number in option '"//SwChar//TRIM(ThisArg)//"'. Ignoring.", & + ErrStat,ErrMsg,'ParseArgs') + ELSE + CALL SetErrStat( ErrID_Fatal," Something failed in parsing option '"//SwChar//TRIM(ThisArg)//"'.", & + ErrStat, ErrMsg, 'ParseArg') + ENDIF + RETURN + ENDIF +!FIXME: add in the other inputs here. + + 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 ParseDvrIptFile( DvrFileName, DvrFileInfo, DvrFlags, DvrSettings, ProgInfo, CaseTime, CaseData, ErrStat, ErrMsg ) + + CHARACTER(1024), INTENT(IN ) :: DvrFileName + type(FileInfoType), INTENT(IN ) :: DvrFileInfo ! Input file stored in FileInfoType structure + TYPE(SEDDriver_Flags), INTENT(INOUT) :: DvrFlags + TYPE(SEDDriver_Settings), INTENT(INOUT) :: DvrSettings + TYPE(ProgDesc), INTENT(IN ) :: ProgInfo + real(DbKi), allocatable, intent( out) :: CaseTime(:) + real(ReKi), allocatable, intent( out) :: CaseData(:,:) + 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) :: CurLine ! Current line in parsing + INTEGER(IntKi) :: TabLines ! Number of lines in the table + integer(IntKi) :: i !< generic loop counter + real(DbKi) :: TmpDb7(7) !< temporary real array + CHARACTER(1024) :: RootName ! Root name of AeroDisk driver input file + + ! Input file echoing + LOGICAL :: EchoFileContents ! Do we echo the driver file out or not? + INTEGER(IntKi) :: UnEc ! The local unit number for this module's echo file + CHARACTER(1024) :: EchoFileName ! Name of SED driver echo file + + ! Time steps + CHARACTER(1024) :: InputChr ! Character string for timesteps and input file names (to handle DEFAULT or NONE value) + + ! Local error handling + INTEGER(IntKi) :: ios !< I/O status + INTEGER(IntKi) :: ErrStatTmp !< Temporary error status for calls + CHARACTER(1024) :: ErrMsgTmp !< Temporary error messages for calls + + + ! Initialize the echo file unit to -1 which is the default to prevent echoing, we will alter this based on user input + UnEc = -1 + + call GetRoot( DvrFileName, RootName ) + + !====== General ==================================================================================== + CurLine = 4 ! Skip the first three lines as they are known to be header lines and separators + call ParseVar( DvrFileInfo, CurLine, 'Echo', EchoFileContents, ErrStatTmp, ErrMsgTmp ) + if (Failed()) return; + + if ( EchoFileContents ) then + CALL OpenEcho ( UnEc, TRIM(RootName)//'.ech', ErrStatTmp, ErrMsgTmp ) + if (Failed()) return; + WRITE(UnEc, '(A)') 'Echo file for AeroDisk driver input file: '//trim(DvrFileName) + ! Write the first three lines into the echo file + WRITE(UnEc, '(A)') DvrFileInfo%Lines(1) + WRITE(UnEc, '(A)') DvrFileInfo%Lines(2) + WRITE(UnEc, '(A)') DvrFileInfo%Lines(3) + + CurLine = 4 + call ParseVar( DvrFileInfo, CurLine, 'Echo', EchoFileContents, ErrStatTmp, ErrMsgTmp, UnEc ) + if (Failed()) return + endif + + !====== Primary file and rootname ================================================================== + if ( EchoFileContents ) WRITE(UnEc, '(A)') DvrFileInfo%Lines(CurLine) ! Write section break to echo + CurLine = CurLine + 1 + + ! AeroDisk input file + call ParseVar( DvrFileInfo, CurLine, "SEDIptFile", DvrSettings%SEDIptFileName, ErrStatTmp, ErrMsgTmp, UnEc ) + if (Failed()) return + DvrFlags%SEDIptFile = .TRUE. + + ! AeroDisk output root name + call ParseVar( DvrFileInfo, CurLine, "OutRootName", DvrSettings%OutRootName, ErrStatTmp, ErrMsgTmp, UnEc ) + if (Failed()) return + DvrFlags%OutRootName = .TRUE. + + + !====== Output ====================================================================================== + if ( EchoFileContents ) WRITE(UnEc, '(A)') DvrFileInfo%Lines(CurLine) ! Write section break to echo + CurLine = CurLine + 1 + + ! WrVTK -- writing VTK visualization files must be [0: none, 1: init only, 2: animation] + call ParseVar( DvrFileInfo, CurLine, "WrVTK", DvrSettings%WrVTK, ErrStatTmp, ErrMsgTmp, UnEc ) + + + !====== Case analysis =============================================================================== + if ( EchoFileContents ) WRITE(UnEc, '(A)') DvrFileInfo%Lines(CurLine) ! Write section break to echo + CurLine = CurLine + 1 + + ! TStart -- start time + call ParseVar( DvrFileInfo, CurLine, "TStart", DvrSettings%TStart, ErrStatTmp, ErrMsgTmp, UnEc ) + if (Failed()) return + DvrFlags%TStart = .TRUE. + + + ! DT -- Timestep size for the driver to take (or DEFAULT for what the file contains) + call ParseVar( DvrFileInfo, CurLine, "DT", InputChr, ErrStatTmp, ErrMsgTmp, UnEc ) + if (Failed()) return + + ! Check if we asked for the DEFAULT (use what is in the file) + CALL Conv2UC( InputChr ) + IF ( TRIM(InputChr) == '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 (InputChr,*,IOSTAT=IOS) DvrSettings%DT + IF ( IOS /= 0 ) THEN ! problem in the read, so parse the error. + CALL CheckIOS ( IOS, '', 'DT',NumType, ErrStatTmp, ErrMsgTmp ) + if (Failed()) return + ELSE ! Was ok, so set the flags + DvrFlags%DT = .TRUE. + DvrFlags%DTDefault = .FALSE. + ENDIF + ENDIF + + + ! Number of timesteps + call ParseVar( DvrFileInfo, CurLine, "NumTimeSteps", InputChr, ErrStatTmp, ErrMsgTmp, UnEc ) + if (Failed()) return + + ! Check if we asked for the DEFAULT (use what is in the file) + CALL Conv2UC( InputChr ) + IF ( TRIM(InputChr) == 'DEFAULT' ) THEN ! we asked for the default value + DvrFlags%NumTimeSteps = .FALSE. + DvrFlags%NumTimeStepsDefault = .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 (InputChr,*,IOSTAT=IOS) DvrSettings%NumTimeSteps + IF ( IOS /= 0 ) THEN ! problem in the read, so parse the error. + CALL CheckIOS ( IOS, '', 'NumTimeSteps',NumType, ErrStatTmp, ErrMsgTmp ) + if (Failed()) return + ELSE ! Was ok, so set the flags + DvrFlags%NumTimeSteps = .TRUE. + DvrFlags%NumTimeStepsDefault = .FALSE. + ENDIF + ENDIF + + + ! Column headers + if ( EchoFileContents ) WRITE(UnEc, '(A)') DvrFileInfo%Lines(CurLine) + CurLine = CurLine + 1 + if ( EchoFileContents ) WRITE(UnEc, '(A)') DvrFileInfo%Lines(CurLine) + CurLine = CurLine + 1 + + + ! Last line of table is assumed to be last line in file (or included file) + TabLines = DvrFileInfo%NumLines - CurLine + 1 + call AllocAry( CaseTime, TabLines, 'CaseTime', ErrStatTmp, ErrMsgTmp ); if (Failed()) return; + call AllocAry( CaseData, 6, TabLines, 'CaseData', ErrStatTmp, ErrMsgTmp ); if (Failed()) return; + do i=1,Tablines + call ParseAry ( DvrFileInfo, CurLine, 'Coordinates', TmpDb7, 7, ErrStatTmp, ErrMsgTmp, UnEc ) + if (Failed()) return; + ! Set Time_(s) + CaseTime(i) = TmpDb7(1) + ! Set AerTrq_(N-m) HSSBrTrqC_(N-m) GenTrq_(N-m) + CaseData(1,i) = real(TmpDb7(2),ReKi) + CaseData(2,i) = abs(real(TmpDb7(3),ReKi)) ! HSSBrTrqC should be positive vlaued + CaseData(3,i) = real(TmpDb7(4),ReKi) + ! Set BlPitchCom (deg -> rad) + CaseData(4,i) = real(TmpDb7(5),ReKi) * D2R + ! Set Yaw (deg -> rad) + CaseData(5,i) = real(TmpDb7(6),ReKi) * D2R + ! Set YawRate (deg/s -> rad/s) + CaseData(6,i) = real(TmpDb7(7),ReKi) * D2R + enddo + + + ! Close the echo and input file + CALL CleanupEchoFile( EchoFileContents, UnEc ) + + +CONTAINS + + !> Set error status, close stuff, and return + logical function Failed() + CALL SetErrStat(ErrStatTmp,ErrMsgTmp,ErrStat,ErrMsg,'ParseDvrIptFile') + if (ErrStat >= AbortErrLev) then + CALL CleanupEchoFile( EchoFileContents, UnEc ) + endif + Failed = ErrStat >= AbortErrLev + end function Failed + + !> Clean up the module echo file + 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 ParseDvrIptFile + + +!> 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(SEDDriver_Flags), INTENT(INOUT) :: DvrFlags + TYPE(SEDDriver_Settings), INTENT(INOUT) :: DvrSettings + TYPE(SEDDriver_Flags), INTENT(IN ) :: CLFlags + TYPE(SEDDriver_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 + LOGICAL :: WindGridModify !< Did we modify any of the WindGrid related settings? + character(*), parameter :: RoutineName = 'UpdateSettingsWithCL' + + ! Initialization + WindGridModify = .FALSE. + + ! Initialize the error handling + ErrStat = ErrID_None + ErrMsg = '' + ErrStatTmp = ErrID_None + ErrMsgTmp = '' + + + !-------------------------------------------- + ! Did we change any time information? + !-------------------------------------------- + + ! Check TStart + IF ( CLFlags%TStart ) THEN + IF ( DvrFlags%TStart .AND. ( .NOT. EqualRealNos(DvrSettings%TStart, CLSettings%TStart) ) ) THEN + CALL SetErrStat( ErrID_Warn, ' Overriding driver input value for TStart with '//TRIM(Num2LStr(CLSettings%TStart))//'.', & + ErrStat,ErrMsg,RoutineName) + ELSE + DvrFlags%TStart = .TRUE. + ENDIF + DvrSettings%TStart = CLSettings%TStart + ENDIF + + ! 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 + DvrFlags%DTDefault = .FALSE. + ENDIF + + ! Check NumTimeSteps + IF ( CLFlags%NumTimeSteps ) THEN + IF ( DvrFlags%NumTimeSteps .AND. ( DvrSettings%NumTimeSteps /= CLSettings%NumTimeSteps ) ) THEN + CALL SetErrStat( ErrID_Warn, ' Overriding driver input value for NumTimeSteps with '// & + TRIM(Num2LStr(CLSettings%NumTimeSteps))//'.',& + ErrStat,ErrMsg,RoutineName) + ELSE + DvrFlags%NumTimeSteps = .TRUE. + ENDIF + DvrSettings%NumTimeSteps = CLSettings%NumTimeSteps + DvrFlags%NumTimeStepsDefault = .FALSE. + ENDIF + + ! Make sure there is at least one timestep + DvrSettings%NumTimeSteps = MAX(DvrSettings%NumTimeSteps,1_IntKi) + + + !-------------------------------------------- + ! If there was no driver input file, we need to set a few things. + !-------------------------------------------- + + IF ( .NOT. DVRIPT ) THEN + + ! Do we need to set the NumTimeStepsDefault flag? + IF ( .NOT. DvrFlags%NumTimeSteps ) THEN + DvrFlags%NumTimeStepsDefault = .TRUE. + CALL SetErrStat( ErrID_Info,' The number of timesteps is not specified. Defaulting to what is in the input series file.', & + ErrStat,ErrMsg,RoutineName) + ENDIF + ENDIF + + +!FIXME: remove this after parsing rest of input file. + ! If no DT value has been set (DEFAULT requested), we need to set a default to pass into SED + IF ( .NOT. DvrFlags%DT ) THEN + DvrSettings%DT = 0.025_DbKi ! This value gets passed into the SED_Init routine, so something must be set. + ENDIF + + +END SUBROUTINE UpdateSettingsWithCL + + + +!> 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( SEDDriver_Flags ), INTENT(IN ) :: DvrFlags !< Flags indicating which settings were set + TYPE( SEDDriver_Settings ), INTENT(IN ) :: DvrSettings !< Stored settings + + CALL WrsCr(TRIM(GetNVD(DvrSettings%ProgInfo))) + CALL WrScr(' DvrIptFile: '//FLAG(DvrFlags%DvrIptFile)// ' '//TRIM(DvrSettings%DvrIptFileName)) + CALL WrScr(' SEDIptFile: '//FLAG(DvrFlags%SEDIptFile)// ' '//TRIM(DvrSettings%SEDIptFileName)) + CALL WrScr(' TStart: '//FLAG(DvrFlags%TStart)// ' '//TRIM(Num2LStr(DvrSettings%TStart))) + 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%NumTimeStepsDefault) THEN + CALL WrScr(' NumTimeSteps: '//FLAG(DvrFlags%NumTimeSteps)// ' DEFAULT') + ELSE + CALL WrScr(' NumTimeSteps: '//FLAG(DvrFlags%NumTimeSteps)// ' '//TRIM(Num2LStr(DvrSettings%NumTimeSteps))) + ENDIF + CALL WrScr(' Verbose: '//FLAG(DvrFlags%Verbose)) + CALL WrScr(' VVerbose: '//FLAG(DvrFlags%VVerbose)) + 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 + + +SUBROUTINE Dvr_InitializeOutputFile(OutUnit,IntOutput,RootName,ErrStat,ErrMsg) + integer(IntKi), intent( out):: OutUnit + type(SED_InitOutputType), intent(in ):: IntOutput ! Output for initialization routine + integer(IntKi), intent( out):: ErrStat ! Error status of the operation + character(*), intent( out):: ErrMsg ! Error message if ErrStat /= ErrID_None + character(*), intent(in ):: RootName + integer(IntKi) :: i + integer(IntKi) :: numOuts + integer(IntKi) :: ErrStat2 ! Temporary Error status + character(ErrMsgLen) :: ErrMsg2 ! Temporary Error message + character(*), parameter :: RoutineName = 'Dvr_InitializeOutputFile' + character(ChanLen) :: TmpChar + + ErrStat = ErrID_none + ErrMsg = "" + + CALL GetNewUnit(OutUnit,ErrStat2,ErrMsg2) + CALL OpenFOutFile ( OutUnit, trim(RootName)//'.out', ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + if (ErrStat >= AbortErrLev) return + + write (OutUnit,'(/,A)') 'Predictions were generated on '//CurDate()//' at '//CurTime()//' using '//trim(GetNVD(IntOutput%Ver)) + write (OutUnit,'()' ) !print a blank line + + numOuts = size(IntOutput%WriteOutputHdr) + !...................................................... + ! Write the names of the output parameters on one line: + !...................................................... + + write (OutUnit,'()') + write (OutUnit,'()') + write (OutUnit,'()') + + TmpChar = 'Time' + call WrFileNR ( OutUnit, TmpChar ) + + do i=1,NumOuts + call WrFileNR ( OutUnit, tab//IntOutput%WriteOutputHdr(i) ) + end do ! i + + write (OutUnit,'()') + + !...................................................... + ! Write the units of the output parameters on one line: + !...................................................... + + TmpChar = '(s)' + call WrFileNR ( OutUnit, TmpChar ) + + do i=1,NumOuts + call WrFileNR ( Outunit, tab//IntOutput%WriteOutputUnt(i) ) + end do ! i + + write (OutUnit,'()') + + +END SUBROUTINE Dvr_InitializeOutputFile + +!---------------------------------------------------------------------------------------------------------------------------------- +SUBROUTINE Dvr_WriteOutputLine(t,OutUnit, OutFmt, Output) + real(DbKi) , intent(in ) :: t ! simulation time (s) + integer(IntKi) , intent(in ) :: OutUnit ! Status of error message + character(*) , intent(in ) :: OutFmt + type(SED_OutputType), intent(in ) :: Output + integer(IntKi) :: errStat ! Status of error message (we're going to ignore errors in writing to the file) + character(ErrMsgLen) :: errMsg ! Error message if ErrStat /= ErrID_None + character(200) :: frmt ! A string to hold a format specifier + character(15) :: tmpStr ! temporary string to print the time output as text + + frmt = '"'//tab//'"'//trim(OutFmt) ! format for array elements from individual modules + + ! time + write( tmpStr, '(F15.6)' ) t + call WrFileNR( OutUnit, tmpStr ) + call WrNumAryFileNR ( OutUnit, Output%WriteOutput, frmt, errStat, errMsg ) + + ! write a new line (advance to the next line) + write (OutUnit,'()') +end subroutine Dvr_WriteOutputLine + + +!---------------------------------------------------------------------------------------------------------------------------------- +!> Write VTK reference meshes and setup directory if needed. +subroutine WrVTK_refMeshes(DvrSettings, p, y, ErrStat,ErrMsg) + type( SEDDriver_Settings ), intent(inout) :: DvrSettings !< Stored settings + type(SED_ParameterType), intent(in ) :: p !< System parameters + type(SED_OutputType), intent(in ) :: y !< System outputs + integer(IntKi), intent( out) :: ErrStat !< error status + character(ErrMsgLen), intent( out) :: ErrMsg !< error message + integer(IntKi) :: i + character(1024) :: TmpFileName + + ! get the name of the output directory for vtk files (in a subdirectory called "vtk" of the output directory), and + ! create the VTK directory if it does not exist + call GetPath ( DvrSettings%OutRootName, DvrSettings%VTK_OutFileRoot, TmpFileName ) ! the returned VTK_OutFileRoot includes a file separator character at the end + DvrSettings%VTK_OutFileRoot = trim(DvrSettings%VTK_OutFileRoot) // 'vtk-SED' + call MKDIR( trim(DvrSettings%VTK_OutFileRoot) ) + DvrSettings%VTK_OutFileRoot = trim( DvrSettings%VTK_OutFileRoot ) // PathSep // trim(TmpFileName) + + ! calculate the number of digits in 'y_FAST%NOutSteps' (Maximum number of output steps to be written) + ! this will be used to pad the write-out step in the VTK filename with zeros in calls to MeshWrVTK() + DvrSettings%VTK_tWidth = CEILING( log10( real(DvrSettings%NumTimeSteps+1,ReKi) ) ) + 1 + + ! Write reference meshes + call MeshWrVTKreference((/0.0_SiKi,0.0_SiKi,0.0_SiKi/), y%PlatformPtMesh, trim(DvrSettings%VTK_OutFileRoot)//'.PlatformPtMesh', ErrStat, ErrMsg) + if (ErrStat >= AbortErrLev) return + call MeshWrVTKreference((/0.0_SiKi,0.0_SiKi,0.0_SiKi/), y%TowerLn2Mesh, trim(DvrSettings%VTK_OutFileRoot)//'.TowerLn2Mesh', ErrStat, ErrMsg) + if (ErrStat >= AbortErrLev) return + call MeshWrVTKreference((/0.0_SiKi,0.0_SiKi,0.0_SiKi/), y%NacelleMotion, trim(DvrSettings%VTK_OutFileRoot)//'.NacelleMotion', ErrStat, ErrMsg) + if (ErrStat >= AbortErrLev) return + call MeshWrVTKreference((/0.0_SiKi,0.0_SiKi,0.0_SiKi/), y%HubPtMotion, trim(DvrSettings%VTK_OutFileRoot)//'.HubPtMotion', ErrStat, ErrMsg) + if (ErrStat >= AbortErrLev) return + do i=1,p%NumBl + call MeshWrVTKreference((/0.0_SiKi,0.0_SiKi,0.0_SiKi/), y%BladeRootMotion(i), trim(DvrSettings%VTK_OutFileRoot)//'.BladeRootMotion'//trim(Num2LStr(i)), ErrStat, ErrMsg) + if (ErrStat >= AbortErrLev) return + enddo +end subroutine WrVTK_refMeshes + +!---------------------------------------------------------------------------------------------------------------------------------- +!> Write VTK reference meshes and setup directory if needed. +subroutine WrVTK_Meshes(DvrSettings, p, y, N_Global, ErrStat,ErrMsg) + type( SEDDriver_Settings ), intent(inout) :: DvrSettings !< Stored settings + type(SED_ParameterType), intent(in ) :: p !< System parameters + type(SED_OutputType), intent(in ) :: y !< System outputs + integer(IntKi), intent(in ) :: N_Global !< System timestep number + integer(IntKi), intent( out) :: ErrStat !< error status + character(ErrMsgLen), intent( out) :: ErrMsg !< error message + integer(IntKi) :: i + character(1024) :: TmpFileName + + ! Write meshes + call MeshWrVTK((/0.0_SiKi,0.0_SiKi,0.0_SiKi/), y%PlatformPtMesh, trim(DvrSettings%VTK_OutFileRoot)//'.PlatformPtMesh', N_Global, .true., ErrStat, ErrMsg, DvrSettings%VTK_tWidth) + if (ErrStat >= AbortErrLev) return + call MeshWrVTK((/0.0_SiKi,0.0_SiKi,0.0_SiKi/), y%TowerLn2Mesh, trim(DvrSettings%VTK_OutFileRoot)//'.TowerLn2Mesh', N_Global, .true., ErrStat, ErrMsg, DvrSettings%VTK_tWidth) + if (ErrStat >= AbortErrLev) return + call MeshWrVTK((/0.0_SiKi,0.0_SiKi,0.0_SiKi/), y%NacelleMotion, trim(DvrSettings%VTK_OutFileRoot)//'.NacelleMotion', N_Global, .true., ErrStat, ErrMsg, DvrSettings%VTK_tWidth) + if (ErrStat >= AbortErrLev) return + call MeshWrVTK((/0.0_SiKi,0.0_SiKi,0.0_SiKi/), y%HubPtMotion, trim(DvrSettings%VTK_OutFileRoot)//'.HubPtMotion', N_Global, .true., ErrStat, ErrMsg, DvrSettings%VTK_tWidth) + if (ErrStat >= AbortErrLev) return + do i=1,p%NumBl + call MeshWrVTK((/0.0_SiKi,0.0_SiKi,0.0_SiKi/), y%BladeRootMotion(i), trim(DvrSettings%VTK_OutFileRoot)//'.BladeRootMotion'//trim(Num2LStr(i)), N_Global, .true., ErrStat, ErrMsg, DvrSettings%VTK_tWidth) + if (ErrStat >= AbortErrLev) return + enddo +end subroutine WrVTK_Meshes + +END MODULE SED_Driver_Subs diff --git a/modules/simple-elastodyn/src/driver/SED_Driver_Types.f90 b/modules/simple-elastodyn/src/driver/SED_Driver_Types.f90 new file mode 100644 index 0000000000..65b6ed4167 --- /dev/null +++ b/modules/simple-elastodyn/src/driver/SED_Driver_Types.f90 @@ -0,0 +1,73 @@ +!********************************************************************************************************************************** +! +! MODULE: SED_Driver_Types - This module contains types used by the SED Driver program to store arguments passed in +! +! The types listed here are used within the SED 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 SED. +! +! SED 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 SED. +! If not, see . +! +!********************************************************************************************************************************** +module SED_Driver_Types + + use NWTC_Library + use SED_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 SED input file. + type :: SEDDriver_Flags + logical :: DvrIptFile = .FALSE. !< Was an input file name given on the command line? + logical :: SEDIptFile = .FALSE. !< Was an SED input file requested? + logical :: OutRootName = .FALSE. !< Was an AeroDisk output rootname + logical :: TStart = .FALSE. !< specified a start time + logical :: NumTimeSteps = .FALSE. !< specified a number of timesteps to process + logical :: NumTimeStepsDefault = .FALSE. !< specified a 'DEFAULT' for number of timesteps to process + logical :: DT = .FALSE. !< specified a resolution in time + logical :: DTDefault = .FALSE. !< specified a 'DEFAULT' for the time resolution + logical :: Verbose = .FALSE. !< Verbose error reporting + logical :: VVerbose = .FALSE. !< Very Verbose error reporting + end type SEDDriver_Flags + + + ! This contains all the settings (possible passed in arguments). + type :: SEDDriver_Settings + character(1024) :: DvrIptFileName !< Driver input file name + character(1024) :: SEDIptFileName !< Filename of SED input file to read (if no driver input file) + character(1024) :: OutRootName !< Output root name + + real(DbKi) :: TStart !< Start time + integer(IntKi) :: NumTimeSteps !< Number of timesteps + real(DbKi) :: DT !< resolution of time + + type(ProgDesc) :: ProgInfo !< Program info + type(ProgDesc) :: SEDProgInfo !< Program info for SED + + integer(IntKi) :: WrVTK !< Write VTK outputs [0: none, 1: init only, 2: animation] + integer(IntKi) :: VTK_tWidth !< width of the time field in the VTK + character(1024) :: VTK_OutFileRoot !< Output root name for VTK + end type SEDDriver_Settings + + +end module SED_Driver_Types diff --git a/modules/subdyn/CMakeLists.txt b/modules/subdyn/CMakeLists.txt index fd81ca64ac..dcc82bc86a 100644 --- a/modules/subdyn/CMakeLists.txt +++ b/modules/subdyn/CMakeLists.txt @@ -18,7 +18,7 @@ if (GENERATE_TYPES) generate_f90_types(src/SubDyn_Registry.txt ${CMAKE_CURRENT_LIST_DIR}/src/SubDyn_Types.f90) endif() -add_library(subdynlib +add_library(subdynlib STATIC src/SubDyn.f90 src/FEM.f90 src/SD_FEM.f90 diff --git a/modules/subdyn/src/FEM.f90 b/modules/subdyn/src/FEM.f90 index 0fe0376f29..d193d421f8 100644 --- a/modules/subdyn/src/FEM.f90 +++ b/modules/subdyn/src/FEM.f90 @@ -951,8 +951,9 @@ END SUBROUTINE GetRigidTransformation !! !! 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) +SUBROUTINE GetDirCos(P1, P2, eType, 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 + INTEGER(IntKi), INTENT(IN ) :: eType ! element type (1:beam circ., 2:cable, 3:rigid, 4:beam arb., 5:spring) 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 @@ -966,9 +967,16 @@ SUBROUTINE GetDirCos(P1, P2, DirCos, L_out, ErrStat, ErrMsg) Dz=P2(3)-P1(3) Dxy = sqrt( Dx**2 + Dy**2 ) L = sqrt( Dx**2 + Dy**2 + Dz**2) + + ! The spring element should have the same starting and ending location. P1 and P2 must be coincident (L must be 0). + IF ( .not. EqualRealNos(L, 0.0_FEKi) .and. eType == 5) THEN + ErrMsg = ' Spring(s) must be defined with the same starting and ending locations in the element.' + ErrStat = ErrID_Fatal + RETURN + ENDIF - IF ( EqualRealNos(L, 0.0_FEKi) ) THEN - ErrMsg = ' Same starting and ending location in the element.' + IF ( EqualRealNos(L, 0.0_FEKi) .and. eType/= 5) THEN + ErrMsg = ' Same starting and ending location in a beam, cable or rigid element.' ErrStat = ErrID_Fatal RETURN ENDIF @@ -1131,20 +1139,21 @@ SUBROUTINE ElemK_Cable(A, L, E, T0, DirCos, K) 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 + ! Comment out geometric stiffness from pre-tension to avoid unphysical results + ! K(1,1)= EE + ! K(2,2)= EE K(3,3)= EAL0 - K(1,7)= -EE - K(2,8)= -EE + ! K(1,7)= -EE + ! K(2,8)= -EE K(3,9)= -EAL0 - K(7,1)= -EE - K(8,2)= -EE + ! K(7,1)= -EE + ! K(8,2)= -EE K(9,3)= -EAL0 - K(7,7)= EE - K(8,8)= EE + ! K(7,7)= EE + ! K(8,8)= EE K(9,9)= EAL0 @@ -1157,6 +1166,159 @@ SUBROUTINE ElemK_Cable(A, L, E, T0, DirCos, K) K = MATMUL( MATMUL(DC, K), TRANSPOSE(DC) ) ! TODO: change me if DirCos convention is transposed END SUBROUTINE ElemK_Cable !------------------------------------------------------------------------------------------------------ +!> Element stiffness matrix for spring +!! The spring element can include diagnal and cross-coupling positions. +!! Assuming that the stiffness is symmetric (21 stiffness coefficients). The stiffness matrix could also be non-symmetric, if desired. +SUBROUTINE ElemK_Spring(k11, k12, k13, k14, k15, k16, k22, k23, k24, k25, k26, k33, k34, k35, k36, k44, k45, k46, k55, k56, k66, DirCos, K) + REAL(ReKi), INTENT( IN) :: k11, k12, k13, k14, k15, k16, k22, k23, k24, k25, k26, k33, k34, k35, k36, k44, k45, k46, k55, k56, k66 + 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) :: DC(12, 12) + + K(1:12,1:12) = 0.0_FEKi + + K( 1, 1) = k11 + K( 1, 7) = -K(1,1) + K( 7, 1) = -K(1,1) + K( 7, 7) = K(1,1) + + K( 1, 2) = k12 + K( 1, 8) = -K(1,2) + K( 7, 2) = -K(1,2) + K( 7, 8) = K(1,2) + + K( 1, 3) = k13 + K( 1, 9) = -K(1,3) + K( 7, 3) = -K(1,3) + K( 7, 9) = K(1,3) + + K( 1, 4) = k14 + K( 1, 10) = -K(1,4) + K( 7, 4) = -K(1,4) + K( 7, 10) = K(1,4) + + K( 1, 5) = k15 + K( 1, 11) = -K(1,5) + K( 7, 5) = -K(1,5) + K( 7, 11) = K(1,5) + + K( 1, 6) = k16 + K( 1, 12) = -K(1,6) + K( 7, 6) = -K(1,6) + K( 7, 12) = K(1,6) + + K( 2, 2) = k22 + K( 2, 8) = -K(2,2) + K( 8, 2) = -K(2,2) + K( 8, 8) = K(2,2) + + K( 2, 3) = k23 + K( 2, 9) = -K(2,3) + K( 8, 3) = -K(2,3) + K( 8, 9) = K(2,3) + + K( 2, 4) = k24 + K( 2, 10) = -K(2,4) + K( 8, 4) = -K(2,4) + K( 8, 10) = K(2,4) + + K( 2, 5) = k25 + K( 2, 11) = -K(2,5) + K( 8, 5) = -K(2,5) + K( 8, 11) = K(2,5) + + K( 2, 6) = k26 + K( 2, 12) = -K(2,6) + K( 8, 6) = -K(2,6) + K( 8, 12) = K(2,6) + + K( 3, 3) = k33 + K( 3, 9) = -K(3,3) + K( 9, 3) = -K(3,3) + K( 9, 9) = K(3,3) + + K( 3, 4) = k34 + K( 3, 10) = -K(3,4) + K( 9, 4) = -K(3,4) + K( 9, 10) = K(3,4) + + K( 3, 5) = k35 + K( 3, 11) = -K(3,5) + K( 9, 5) = -K(3,5) + K( 9, 11) = K(3,5) + + K( 3, 6) = k36 + K( 3, 12) = -K(3,6) + K( 9, 6) = -K(3,6) + K( 9, 12) = K(3,6) + + K( 4, 4) = k44 + K( 4, 10) = -K(4,4) + K(10, 4) = -K(4,4) + K(10, 10) = K(4,4) + + K( 4, 5) = k45 + K( 4, 11) = -K(4,5) + K(10, 5) = -K(4,5) + K(10, 11) = K(4,5) + + K( 4, 6) = k46 + K( 4, 12) = -K(4,6) + K(10, 6) = -K(4,6) + K(10, 12) = K(4,6) + + K( 5, 5) = k55 + K( 5, 11) = -K(5,5) + K(11, 5) = -K(5,5) + K(11, 11) = K(5,5) + + K( 5, 6) = k56 + K( 5, 12) = -K(5,6) + K(11, 6) = -K(5,6) + K(11, 12) = K(5,6) + + K( 6, 6) = k66 + K( 6, 12) = -K(6,6) + K(12, 6) = -K(6,6) + K(12, 12) = K(6,6) + + ! Stiffness matrix symmetry: + K(2:6, 1) = K(1,2:6) + K(2:6, 7) = K(1,8:12) + K(8:12, 1) = K(7,2:6) + K(8:12, 7) = K(7,8:12) + + K(3:6, 2) = K(2,3:6) + K(3:6, 8) = K(2,9:12) + K(9:12, 2) = K(8,3:6) + K(9:12, 8) = K(8,9:12) + + K(4:6, 3) = K(3,4:6) + K(4:6, 9) = K(3,10:12) + K(10:12, 3) = K(9,4:6) + K(10:12, 9) = K(9,10:12) + + K(5:6, 4) = K(4,5:6) + K(5:6, 10) = K(4,11:12) + K(11:12, 4) = K(10,5:6) + K(11:12, 10) = K(10,11:12) + + K(6, 5) = K(5,6) + K(6, 11) = K(5,12) + K(12, 5) = K(11,6) + K(12, 11) = K(11,12) + + 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_Spring +!------------------------------------------------------------------------------------------------------ !> 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 diff --git a/modules/subdyn/src/SD_FEM.f90 b/modules/subdyn/src/SD_FEM.f90 index 7d300e83bb..27e72964b0 100644 --- a/modules/subdyn/src/SD_FEM.f90 +++ b/modules/subdyn/src/SD_FEM.f90 @@ -37,6 +37,7 @@ MODULE SD_FEM 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 :: PropSetsSCol = 22 ! Number of columns in SpringPropSet (PropSetID, k11, k12, k13, k14, k15, k16, k22, k23, k24, k25, k26, k33, k34, k35, k36, k44, k45, k46, k55, k56, k66) 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 @@ -60,6 +61,7 @@ MODULE SD_FEM INTEGER(IntKi), PARAMETER :: idMemberCable = 2 INTEGER(IntKi), PARAMETER :: idMemberRigid = 3 INTEGER(IntKi), PARAMETER :: idMemberBeamArb = 4 + INTEGER(IntKi), PARAMETER :: idMemberSpring = 5 ! Types of Boundary Conditions INTEGER(IntKi), PARAMETER :: idBC_Fixed = 11 ! Fixed BC @@ -374,7 +376,7 @@ SUBROUTINE SD_ReIndex_CreateNodesAndElems(Init,p, ErrStat, ErrMsg) ! Check that rigid links are not connected to the interface iInterf = FINDLOCI(p%Nodes_I(:,1), iJoint ) if (iInterf>=1) then - CALL WrScr('[WARNING] There might be a bug when rigid links are connected to the interface nodes (mostly if cables are involved). The problematic member is MemberID='//TRIM(Num2LStr(mID))//' (which is a rigid link) involving joint JointID='// TRIM(Num2LStr(JointID))// ' (which is in an interface joint).') + CALL WrScr('[WARNING] There might be a bug when one beam and one rigid link are connected to the interface nodes. The problematic member might be MemberID='//TRIM(Num2LStr(mID))//' (which is a rigid link) involving joint JointID='// TRIM(Num2LStr(JointID))// ' (which is in an interface joint).') endif endif enddo @@ -394,6 +396,9 @@ SUBROUTINE SD_ReIndex_CreateNodesAndElems(Init,p, ErrStat, ErrMsg) else if (mType==idMemberBeamArb) then sType='Member arbitrary cross-section property' p%Elems(iMem,n) = FINDLOCI(Init%PropSetsX(:,1), Init%Members(iMem, n) ) + else if (mType==idMemberSpring) then + sType='Spring property' + p%Elems(iMem,n) = FINDLOCI(Init%PropSetsS(:,1), Init%Members(iMem, n) ) else ! Should not happen print*,'Element type unknown',mType @@ -403,7 +408,7 @@ SUBROUTINE SD_ReIndex_CreateNodesAndElems(Init,p, ErrStat, ErrMsg) if (mType/=idMemberBeamCirc) then if (Init%Members(iMem, iMProp)/=Init%Members(iMem, iMProp+1)) then ! NOTE: for non circular beams, we could just check that E, rho, G are the same for both properties - call Fatal('Property IDs should be the same at both joints for arbitrary beams, rigid links, and cables. Check member with ID: '//TRIM(Num2LStr(Init%Members(iMem,1)))) + call Fatal('Property IDs should be the same at both joints for arbitrary beams, rigid links, cables, and springs. Check member with ID: '//TRIM(Num2LStr(Init%Members(iMem,1)))) return endif endif @@ -454,7 +459,7 @@ SUBROUTINE SD_Discrt(Init,p, ErrStat, ErrMsg) INTEGER :: iDirCos REAL(ReKi) :: x1, y1, z1, x2, y2, z2, dx, dy, dz, dd, dt, d1, d2, t1, t2 LOGICAL :: CreateNewProp - INTEGER(IntKi) :: nMemberCable, nMemberRigid, nMemberBeamCirc, nMemberBeamArb !< Number of memebers per type + INTEGER(IntKi) :: nMemberCable, nMemberRigid, nMemberSpring, nMemberBeamCirc, nMemberBeamArb !< Number of members per type INTEGER(IntKi) :: eType !< Element Type INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -473,9 +478,10 @@ SUBROUTINE SD_Discrt(Init,p, ErrStat, ErrMsg) nMemberCable = count(Init%Members(:,iMType) == idMemberCable) nMemberRigid = count(Init%Members(:,iMType) == idMemberRigid) nMemberBeamArb = count(Init%Members(:,iMType) == idMemberBeamArb) - Init%NElem = (nMemberBeamCirc + nMemberBeamArb)*Init%NDiv + nMemberCable + nMemberRigid ! NOTE: only Beams are divided - IF ( (nMemberBeamCirc+nMemberRigid+nMemberCable+nMemberBeamArb) /= size(Init%Members,1)) then - CALL Fatal(' Member list contains an element which is not a beam, a cable or a rigid link'); return + nMemberSpring = count(Init%Members(:,iMType) == idMemberSpring) + Init%NElem = (nMemberBeamCirc + nMemberBeamArb)*Init%NDiv + nMemberCable + nMemberRigid + nMemberSpring ! NOTE: only Beams are divided + IF ( (nMemberBeamCirc+nMemberRigid+nMemberCable+nMemberBeamArb+nMemberSpring) /= size(Init%Members,1)) then + CALL Fatal(' Member list contains an element which is not a beam, a cable, a rigid link or a spring'); return ENDIF ! Total number of nodes - Depends on division and number of nodes per element @@ -569,8 +575,8 @@ SUBROUTINE SD_Discrt(Init,p, ErrStat, ErrMsg) eType = TempMembers(I, iMType ) iDirCos = TempMembers(I, iMDirCosID) - if (eType==idMemberRigid .OR. eType==idMemberCable) then - ! --- Cables and rigid links are not subdivided and have same prop at nodes + if (eType==idMemberRigid .OR. eType==idMemberCable .OR. eType==idMemberSpring) then + ! --- Cables, rigid links and springs 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 @@ -681,13 +687,16 @@ SUBROUTINE SD_Discrt(Init,p, ErrStat, ErrMsg) 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) + ! --- Cables, rigid link and spring properties (these cannot be subdivided, so direct copy of inputs) Init%NPropC = Init%NPropSetsC Init%NPropR = Init%NPropSetsR + Init%NPropS = Init%NPropSetsS 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 + CALL AllocAry(Init%PropsS, Init%NPropS, PropSetsSCol, 'Init%PropsSpring', 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) + Init%PropsS(1:Init%NPropS, 1:PropSetsSCol) = Init%PropSetsS(1:Init%NPropS, 1:PropSetsSCol) CALL CleanUp_Discrt() @@ -818,6 +827,7 @@ SUBROUTINE SetElementProperties(Init, p, ErrStat, ErrMsg) 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, kappa_x, kappa_y, nu, ratioSq, D_inner, D_outer + REAL(ReKi) :: k11, k12, k13, k14, k15, k16, k22, k23, k24, k25, k26, k33, k34, k35, k36, k44, k45, k46, k55, k56, k66 LOGICAL :: shear INTEGER(IntKi) :: eType !< Member type REAL(ReKi) :: Point1(3), Point2(3) ! (x,y,z) positions of two nodes making up an element @@ -844,7 +854,7 @@ SUBROUTINE SetElementProperties(Init, p, ErrStat, ErrMsg) Point2 = Init%Nodes(N2,2:4) if (iDirCos/=-1) then - CALL GetDirCos(Point1, Point2, DirCos, L, ErrStat2, ErrMsg2); if(Failed()) return ! sets L + CALL GetDirCos(Point1, Point2, eType, DirCos, L, ErrStat2, ErrMsg2); if(Failed()) return ! sets L ! overwrites direction cosines DirCos(1, 1) = Init%COSMs(iDirCos, 2) @@ -858,7 +868,7 @@ SUBROUTINE SetElementProperties(Init, p, ErrStat, ErrMsg) DirCos(3, 3) = Init%COSMs(iDirCos, 10) else - CALL GetDirCos(Point1, Point2, DirCos, L, ErrStat2, ErrMsg2); if(Failed()) return ! L and DirCos + CALL GetDirCos(Point1, Point2, eType, DirCos, L, ErrStat2, ErrMsg2); if(Failed()) return ! L and DirCos endif @@ -878,7 +888,28 @@ SUBROUTINE SetElementProperties(Init, p, ErrStat, ErrMsg) p%ElemProps(i)%Area = -9.99e+36 p%ElemProps(i)%Rho = -9.99e+36 p%ElemProps(i)%T0 = -9.99e+36 - + p%ElemProps(i)%k11 = -9.99e+36 + p%ElemProps(i)%k12 = -9.99e+36 + p%ElemProps(i)%k13 = -9.99e+36 + p%ElemProps(i)%k14 = -9.99e+36 + p%ElemProps(i)%k15 = -9.99e+36 + p%ElemProps(i)%k16 = -9.99e+36 + p%ElemProps(i)%k22 = -9.99e+36 + p%ElemProps(i)%k23 = -9.99e+36 + p%ElemProps(i)%k24 = -9.99e+36 + p%ElemProps(i)%k25 = -9.99e+36 + p%ElemProps(i)%k26 = -9.99e+36 + p%ElemProps(i)%k33 = -9.99e+36 + p%ElemProps(i)%k34 = -9.99e+36 + p%ElemProps(i)%k35 = -9.99e+36 + p%ElemProps(i)%k36 = -9.99e+36 + p%ElemProps(i)%k44 = -9.99e+36 + p%ElemProps(i)%k45 = -9.99e+36 + p%ElemProps(i)%k46 = -9.99e+36 + p%ElemProps(i)%k55 = -9.99e+36 + p%ElemProps(i)%k56 = -9.99e+36 + p%ElemProps(i)%k66 = -9.99e+36 + ! --- Properties that are specific to some elements if (eType==idMemberBeamCirc) then E = Init%PropsB(P1, 2) ! TODO E2 @@ -972,7 +1003,7 @@ SUBROUTINE SetElementProperties(Init, p, ErrStat, ErrMsg) 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] - p%ElemProps(i)%D = min(sqrt(1/Pi)*4, L*0.05) ! For plotting only + p%ElemProps(i)%D = min(sqrt(1/Pi)*4, L*0.05_ReKi) ! For plotting only else if (eType==idMemberRigid) then if (DEV_VERSION) then @@ -980,8 +1011,36 @@ SUBROUTINE SetElementProperties(Init, p, ErrStat, ErrMsg) endif p%ElemProps(i)%Area = 1 ! Arbitrary set to 1 p%ElemProps(i)%Rho = Init%PropsR(P1, 2) - p%ElemProps(i)%D = min(sqrt(1/Pi)*4, L*0.05) ! For plotting only + p%ElemProps(i)%D = min(sqrt(1/Pi)*4, L*0.05_ReKi) ! For plotting only + else if (eType==idMemberSpring) then + if (DEV_VERSION) then + print*,'Member',I,'is a spring element' + endif + p%ElemProps(i)%Area = 0 ! Spring elements have no area + p%ElemProps(i)%Rho = 0 ! Spring elements have no mass + p%ElemProps(i)%k11 = Init%PropsS(P1, 2) + p%ElemProps(i)%k12 = Init%PropsS(P1, 3) + p%ElemProps(i)%k13 = Init%PropsS(P1, 4) + p%ElemProps(i)%k14 = Init%PropsS(P1, 5) + p%ElemProps(i)%k15 = Init%PropsS(P1, 6) + p%ElemProps(i)%k16 = Init%PropsS(P1, 7) + p%ElemProps(i)%k22 = Init%PropsS(P1, 8) + p%ElemProps(i)%k23 = Init%PropsS(P1, 9) + p%ElemProps(i)%k24 = Init%PropsS(P1,10) + p%ElemProps(i)%k25 = Init%PropsS(P1,11) + p%ElemProps(i)%k26 = Init%PropsS(P1,12) + p%ElemProps(i)%k33 = Init%PropsS(P1,13) + p%ElemProps(i)%k34 = Init%PropsS(P1,14) + p%ElemProps(i)%k35 = Init%PropsS(P1,15) + p%ElemProps(i)%k36 = Init%PropsS(P1,16) + p%ElemProps(i)%k44 = Init%PropsS(P1,17) + p%ElemProps(i)%k45 = Init%PropsS(P1,18) + p%ElemProps(i)%k46 = Init%PropsS(P1,19) + p%ElemProps(i)%k55 = Init%PropsS(P1,20) + p%ElemProps(i)%k56 = Init%PropsS(P1,21) + p%ElemProps(i)%k66 = Init%PropsS(P1,22) + else ! Should not happen print*,'Element type unknown',eType @@ -1167,10 +1226,12 @@ SUBROUTINE AssembleKM(Init, p, ErrStat, ErrMsg) 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 + CALL AllocAry( p%FG, p%nDOF, 'p%FG' , ErrStat2, ErrMsg2); if(Failed()) return; ! system gravity force vector with line pretension + CALL AllocAry( p%FC, p%nDOF, 'p%FC' , ErrStat2, ErrMsg2); if(Failed()) return; ! line pretension only Init%K = 0.0_FEKi Init%M = 0.0_FEKi p%FG = 0.0_FEKi + p%FC = 0.0_FEKi ! loop over all elements, compute element matrices and assemble into global matrices DO i = 1, Init%NElem @@ -1181,12 +1242,16 @@ SUBROUTINE AssembleKM(Init, p, ErrStat, ErrMsg) ! --- 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 + p%FC ( IDOF ) = p%FC( IDOF ) + FCe(1:12) ! Note: Pretension cable forces only + p%FG ( IDOF ) = p%FG( IDOF ) + FGe(1:12) ! Note: Gravity forces only 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 + CALL AllocAry( p%CMassNode, Init%nCMass, 'p%CMassNode', ErrStat2, ErrMsg2); if(Failed()) return; + CALL AllocAry( p%CMassWeight, Init%nCMass, 'p%CMassWeight', ErrStat2, ErrMsg2); if(Failed()) return; + CALL AllocAry( p%CMassOffset, Init%nCMass, 3, 'p%CMassOffset', ErrStat2, ErrMsg2); if(Failed()) return; 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) @@ -1209,14 +1274,20 @@ SUBROUTINE AssembleKM(Init, p, ErrStat, ErrMsg) 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 + ! Add concentrated mass contribution to gravity force and moment + iGlob = p%NodesDOF(iNode)%List(3); p%FG(iGlob) = p%FG(iGlob) - m*Init%g ! uz: -mg + iGlob = p%NodesDOF(iNode)%List(4); p%FG(iGlob) = p%FG(iGlob) - m*Init%g * y ! tx: -mgy + iGlob = p%NodesDOF(iNode)%List(5); p%FG(iGlob) = p%FG(iGlob) + m*Init%g * x ! ty: mgx + + ! Save concentrated mass information for GuyanLoadCorrection + p%CMassNode(I) = iNode + p%CMassWeight(I) = m*Init%g + p%CMassOffset(I,1) = x + p%CMassOffset(I,2) = y + p%CMassOffset(I,3) = z + + ENDDO ! Loop on concentrated mass CALL CleanUp_AssembleKM() @@ -2283,7 +2354,11 @@ SUBROUTINE ElemM(ep, Me) CALL ElemM_Cable(ep%Area, real(ep%Length,FEKi), ep%rho, ep%DirCos, Me) !CALL ElemM_(A, L, rho, DirCos, Me) endif - endif + + else if (ep%eType==idMemberSpring) then + Me=0.0_FEKi ! Spring element has no mass associated. Consider using a lumped mass at JointID, if desired. + endif + END SUBROUTINE ElemM SUBROUTINE ElemK(ep, Ke) @@ -2298,6 +2373,10 @@ SUBROUTINE ElemK(ep, Ke) else if (ep%eType==idMemberRigid) then Ke = 0.0_FEKi + + else if (ep%eType==idMemberSpring) then + CALL ElemK_Spring(eP%k11, eP%k12, eP%k13, eP%k14, eP%k15, eP%k16, eP%k22, eP%k23, eP%k24, eP%k25, eP%k26, eP%k33, eP%k34, eP%k35, eP%k36, eP%k44, eP%k45, eP%k46, eP%k55, eP%k56, eP%k66, eP%DirCos, Ke) + endif END SUBROUTINE ElemK @@ -2312,6 +2391,8 @@ SUBROUTINE ElemF(ep, gravity, Fg, Fo) CALL ElemF_Cable(ep%T0, ep%DirCos, Fo) else if (ep%eType==idMemberRigid) then Fo(1:12)=0.0_FEKi + else if (ep%eType==idMemberSpring) then + Fo(1:12)=0.0_FEKi endif CALL ElemG( eP%Area, eP%Length, eP%rho, eP%DirCos, Fg, gravity ) END SUBROUTINE ElemF diff --git a/modules/subdyn/src/SubDyn.f90 b/modules/subdyn/src/SubDyn.f90 index e2f7bc7e8d..c9c62ed92c 100644 --- a/modules/subdyn/src/SubDyn.f90 +++ b/modules/subdyn/src/SubDyn.f90 @@ -192,6 +192,12 @@ SUBROUTINE SD_Init( InitInput, u, p, x, xd, z, OtherState, y, m, Interval, InitO real(FEKi), dimension(:) , allocatable :: Omega real(FEKi), dimension(:) , allocatable :: Omega_Gy ! Frequencies of Guyan modes logical, allocatable :: bDOF(:) ! Mask for DOF to keep (True), or reduce (False) + + REAL(ReKi) :: rOG(3) ! Vector from origin to G + REAL(ReKi) :: M_O(6,6) ! Rigid-body inertia matrix + REAL(FEKi),allocatable :: MBB(:,:) ! Leader DOFs mass matrix + REAL(ReKi), dimension(:,:), allocatable :: TI2 ! For Equivalent mass matrix + INTEGER(IntKi) :: ErrStat2 ! Error status of the operation CHARACTER(ErrMsgLen) :: ErrMsg2 ! Error message if ErrStat /= ErrID_None @@ -222,7 +228,7 @@ SUBROUTINE SD_Init( InitInput, u, p, x, xd, z, OtherState, y, m, Interval, InitO ! %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 + ! Note: F = -kx where 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); @@ -237,7 +243,8 @@ SUBROUTINE SD_Init( InitInput, u, p, x, xd, z, OtherState, y, m, Interval, InitO !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.' ) - + p%g = Init%g + ! 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 @@ -347,6 +354,29 @@ SUBROUTINE SD_Init( InitInput, u, p, x, xd, z, OtherState, y, m, Interval, InitO ! 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, y%Y3Mesh, ErrStat2, ErrMsg2 ); if(Failed()) return + ! If floating, compute the vector from the reference point to the rigid-body CoG in Guyan frame + IF (p%Floating) THEN + ! Compute the vector from reference point P to rigid-body CoG for floating structures + ! 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 + M_O=matmul(TRANSPOSE(TI2),matmul(MBB,TI2)) !Equivalent mass matrix of the rigid body + else + M_O=matmul(TRANSPOSE(TI2),matmul(CBparams%MBB,TI2)) !Equivalent mass matrix of the rigid body + endif + deallocate(TI2) + ! Clean up for values that ought to be 0 + M_O(1,2:4)= 0.0_ReKi; + M_O(2,1 )= 0.0_ReKi; M_O(2,3 )= 0.0_ReKi; M_O(2,5 )= 0.0_ReKi; + M_O(3,1:2)= 0.0_ReKi; M_O(3,6 )= 0.0_ReKi + M_O(4,1 )= 0.0_ReKi; M_O(5,2 )= 0.0_ReKi; M_O(6,3 )= 0.0_ReKi; + CALL rigidBodyMassMatrixCOG(M_O, rOG); + p%rPG = rOG-InitInput%TP_RefPoint + END IF + ! --- Eigen values of full system (for summary file output only) IF ( Init%SSSum .or. p%OutFEMModes>idOutputFormatNone) THEN ! M and K are reduced matrices, but Boundary conditions are not applied, so @@ -481,6 +511,7 @@ SUBROUTINE SD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) REAL(ReKi) :: udotdot_TP(6) INTEGER(IntKi), pointer :: DOFList(:) REAL(ReKi) :: DCM(3,3) + REAL(ReKi) :: MBB(6,6), CBB(6,6) ! Guyan mode inertia and damping matrices transformed to earth-fixed frame of reference 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 Guyan rigid body motion @@ -493,7 +524,7 @@ SUBROUTINE SD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) 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 + real(R8Ki), dimension(6,6) :: RRb2g ! Rotation matrix body 2 global 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 @@ -501,17 +532,23 @@ SUBROUTINE SD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) 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 + ! Compute the roll, pitch, and yaw angles given the input direction cosine matrix + IF ( p%Floating ) THEN + ! Only needed for outputs when floating + rotations = EulerExtractZYX(u%TPMesh%Orientation(:,:,1)) + ELSE + ! Need to be small angles due to the Guyan stiffness terms + rotations = GetSmllRotAngs(u%TPMesh%Orientation(:,:,1), ErrStat2, ErrMsg2); if(Failed()) return + END IF 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(:,:) = 0.0_R8Ki RRb2g(1:3,1:3) = Rb2g RRb2g(4:6,4:6) = Rb2g - + ! -------------------------------------------------------------------------------- ! --- Output Meshes 2&3 ! -------------------------------------------------------------------------------- @@ -576,7 +613,7 @@ SUBROUTINE SD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) ! Storing elastic motion (full motion for fixed bottom, CB motion+SIM 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) @@ -596,9 +633,11 @@ SUBROUTINE SD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) ! Full displacements CB-rotated + Guyan (KEEP ME) >>> Rotate All if (p%GuyanLoadCorrection) then m%U_full_NS (DOFList(1:3)) = matmul(Rb2g, m%U_full_NS (DOFList(1:3))) + duP(1:3) - m%U_full_NS (DOFList(4:6)) = matmul(Rb2g, m%U_full_NS (DOFList(4:6))) + rotations(1:3) + CALL SmllRotTrans('Nodal rotation',m%U_full_NS(DOFList(4)),m%U_full_NS(DOFList(5)),m%U_full_NS(DOFList(6)),DCM,'',ErrStat2,ErrMsg2); if(Failed()) return + m%U_full_NS (DOFList(4:6)) = EulerExtractZYX( matmul(DCM,Rg2b) ) 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) + CALL SmllRotTrans('Nodal rotation',m%U_full(DOFList(4)),m%U_full(DOFList(5)),m%U_full(DOFList(6)),DCM,'',ErrStat2,ErrMsg2); if(Failed()) return + m%U_full (DOFList(4:6)) = EulerExtractZYX( matmul(DCM,Rg2b) ) 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) @@ -615,15 +654,10 @@ SUBROUTINE SD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) endif ! --- Rigid body displacements for hydrodyn - ! Construct the direction cosine matrix given the output angles - call SmllRotTrans( 'UR_bar input angles Guyan', 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%Orientation (:,:,iSDNode) = u%TPMesh%Orientation(:,:,1) y%Y2mesh%TranslationDisp (:,iSDNode) = duP(1:3) ! Y2: NOTE: only the Guyan displacements for floating ! --- Full elastic displacements for others (moordyn) - call SmllRotTrans( 'Nodal rotation', m%U_full_NS(DOFList(4)), m%U_full_NS(DOFList(5)), m%U_full_NS(DOFList(6)), DCM, '', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'SD_CalcOutput') - y%Y3mesh%Orientation (:,:,iSDNode) = DCM + y%Y3mesh%Orientation (:,:,iSDNode) = EulerConstructZYX(m%U_full_NS(DOFList(4:6))) y%Y3mesh%TranslationDisp (:,iSDNode) = m%U_full_NS (DOFList(1:3)) ! Y3: Guyan+CB (but no SIM) displacements ! --- Elastic velocities and accelerations y%Y2mesh%TranslationVel (:,iSDNode) = m%U_full_dot (DOFList(1:3)) @@ -637,8 +671,7 @@ SUBROUTINE SD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) 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_NS(DOFList(4)), m%U_full_NS(DOFList(5)), m%U_full_NS(DOFList(6)), DCM, '', ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'SD_CalcOutput') + CALL SmllRotTrans( 'UR_bar input angles', m%U_full_NS(DOFList(4)), m%U_full_NS(DOFList(5)), m%U_full_NS(DOFList(6)), DCM, '', ErrStat2, ErrMsg2); if(Failed()) return y%Y2mesh%Orientation (:,:,iSDNode) = DCM y%Y2mesh%TranslationDisp (:,iSDNode) = m%U_full_NS (DOFList(1:3)) !Y2: Guyan+CB (but no SIM) displacements y%Y2mesh%TranslationVel (:,iSDNode) = m%U_full_dot (DOFList(1:3)) @@ -670,41 +703,76 @@ SUBROUTINE SD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) else Y1_CB = 0.0_ReKi endif + ! print *, 'Y1_CB: ', Y1_CB + + ! Contribution from U_TP, Udot_TP, Uddot_TP, Reaction/coupling force at TP + if (p%GuyanLoadCorrection.and.p%Floating) then + ! Transform the body-frame Guyan mode (rigid-body) inertia and damping matrix to global frame + MBB = matmul(RRb2g, matmul(p%MBB,transpose(RRb2g))) + CBB = matmul(RRb2g, matmul(p%CBB,transpose(RRb2g))) + ! Y1_Utp = - (matmul(p%KBB, m%u_TP) + matmul(p%CBB, m%udot_TP) + matmul(MBB,m%udotdot_TP) ) + Y1_Utp = - ( matmul(CBB,m%udot_TP) + matmul(MBB,m%udotdot_TP) ) + ! Add back the nonlinear terms of the Guyan mode equation of motion + Y1_Utp(1:3) = Y1_Utp(1:3) - MBB(1,1)*cross_product(m%udot_TP(4:6),cross_product(m%udot_TP(4:6),matmul(Rb2g,p%rPG))) + Y1_Utp(4:6) = Y1_Utp(4:6) - cross_product(m%udot_TP(4:6),matmul(MBB(4:6,4:6),m%udot_TP(4:6))) + else + Y1_Utp = - (matmul(p%KBB, m%u_TP) + matmul(p%CBB, m%udot_TP) + matmul(p%MBB,m%udotdot_TP) ) + end if - ! Contribution from U_TP, Udot_TP, Uddot_TP, 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 + if (p%GuyanLoadCorrection.and.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 - ! --- Special case for floating with extramoment, we use "rotated loads" m%F_L previously computed if (p%GuyanLoadCorrection.and.p%Floating) then - Y1_CB_L = - (matmul(p%D1_141, m%F_L)) ! = - (M_Bm . Phi_m^T) "F_L", where "F_L"=Rg2b F_L are rotated loads - Y1_CB_L = matmul(RRb2g, Y1_CB_L) ! = - Rb2g (M_Bm . Phi_m^T) Rg2b F_L + ! --- Special case for floating with extra moment, we use "rotated loads" m%F_L previously computed + ! Contributions from external forces - Note: T_I is in the rotated frame + call GetExtForceOnInterfaceDOF(p, m%Fext, F_I) + Y1_Guy_R = matmul( F_I, p%TI ) ! = - [-T_I.^T] F_R = [T_I.^T] F_R =~ F_R T_I (~: FORTRAN convention) + Y1_Guy_R = matmul(RRb2g, Y1_Guy_R) + Y1_Guy_L = - matmul(p%D1_142, m%F_L) ! = - (- T_I^T . Phi_Rb^T) F_L, rotated loads + Y1_Guy_L = matmul(RRb2g, Y1_Guy_L) + Y1_CB_L = - matmul(p%D1_141, m%F_L) ! = - (M_Bm . Phi_m^T) "F_L", where "F_L"=Rg2b F_L are rotated loads + Y1_CB_L = matmul(RRb2g, Y1_CB_L) ! = - Rb2g (M_Bm . Phi_m^T) Rg2b F_L + else ! .not.(p%GuyanLoadCorrection.and.p%Floating) + ! Compute "non-rotated" 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) + ! Contributions from external forces + Y1_Guy_R = matmul( F_I, p%TI ) ! = - [-T_I.^T] F_R = [T_I.^T] F_R =~ F_R T_I (~: FORTRAN convention) + Y1_Guy_L = - matmul(p%D1_142, m%F_L) ! = - (- T_I^T . Phi_Rb^T) F_L, non-rotated loads + Y1_CB_L = - matmul(p%D1_141, m%F_L) ! = - (M_Bm . Phi_m^T) F_L, non-rotated loads endif - ! Compute "non-rotated" 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) - - ! Contributions from external forces - Y1_Guy_R = matmul( F_I, p%TI ) ! = - [-T_I.^T] F_R = [T_I.^T] F_R =~ F_R T_I (~: FORTRAN convention) - Y1_Guy_L = - matmul(p%D1_142, m%F_L) ! = - (- T_I^T . Phi_Rb^T) F_L, non-rotated loads - - if (.not.(p%GuyanLoadCorrection.and.p%Floating)) then - Y1_CB_L = - (matmul(p%D1_141, m%F_L)) ! = - (M_Bm . Phi_m^T) F_L, non-rotated loads - endif + ! Old implementation below + ! ! --- Special case for floating with extramoment, we use "rotated loads" m%F_L previously computed + ! if (p%GuyanLoadCorrection.and.p%Floating) then + ! Y1_CB_L = - (matmul(p%D1_141, m%F_L)) ! = - (M_Bm . Phi_m^T) "F_L", where "F_L"=Rg2b F_L are rotated loads + ! Y1_CB_L = matmul(RRb2g, Y1_CB_L) ! = - Rb2g (M_Bm . Phi_m^T) Rg2b F_L + ! endif + ! + ! ! Compute "non-rotated" 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) + ! + ! ! Contributions from external forces + ! Y1_Guy_R = matmul( F_I, p%TI ) ! = - [-T_I.^T] F_R = [T_I.^T] F_R =~ F_R T_I (~: FORTRAN convention) + ! Y1_Guy_L = - matmul(p%D1_142, m%F_L) ! = - (- T_I^T . Phi_Rb^T) F_L, non-rotated loads + ! + ! if (.not.(p%GuyanLoadCorrection.and.p%Floating)) then + ! Y1_CB_L = - (matmul(p%D1_141, m%F_L)) ! = - (M_Bm . Phi_m^T) F_L, non-rotated loads + ! endif ! Total contribution 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) & @@ -749,8 +817,8 @@ SUBROUTINE SD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) 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)/) + 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 @@ -846,7 +914,7 @@ SUBROUTINE SD_Input(SDInputFile, Init, p, ErrStat,ErrMsg) CHARACTER(64), ALLOCATABLE :: StrArray(:) ! Array of strings, for better control of table inputs LOGICAL :: Echo LOGICAL :: LegacyFormat -LOGICAL :: bNumeric, bInteger +LOGICAL :: bNumeric, bInteger, bCableHasPretension INTEGER(IntKi) :: UnIn INTEGER(IntKi) :: nColumns, nColValid, nColNumeric INTEGER(IntKi) :: IOS @@ -932,20 +1000,23 @@ SUBROUTINE SD_Input(SDInputFile, Init, p, ErrStat,ErrMsg) 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 +! 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 + +! GuyanLoadCorrection will always be set to true. The corresponding user input is commented out above. +p%GuyanLoadCorrection=.True. !-------------------- FEA and CRAIG-BAMPTON PARAMETERS--------------------------- +CALL ReadCom ( UnIn, SDInputFile, ' FEA and CRAIG-BAMPTON PARAMETERS ', ErrStat2, ErrMsg2, UnEc ); if(Failed()) return 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 @@ -953,13 +1024,15 @@ SUBROUTINE SD_Input(SDInputFile, Init, p, ErrStat,ErrMsg) 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 +! Nmodes - Number of internal modes to retain. Retain all modes if Nmodes<0. +CALL ReadIVar ( UnIn, SDInputFile, p%nDOFM, 'Nmodes', 'Number of internal modes',ErrStat2, ErrMsg2, UnEc ); if(Failed()) return +IF ( p%nDOFM >= 0 ) THEN + Init%CBMod = .TRUE. +ELSE + Init%CBMod = .FALSE. +ENDIF 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 + 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 @@ -984,12 +1057,9 @@ SUBROUTINE SD_Input(SDInputFile, Init, p, ErrStat,ErrMsg) 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 @@ -1175,7 +1245,7 @@ SUBROUTINE SD_Input(SDInputFile, Init, p, ErrStat,ErrMsg) CALL ReadCAryFromStr ( Line, StrArray, nColumns, 'Members', 'First line of members array', ErrStat2, ErrMsg2 ); if(Failed()) return call LegacyWarning('Member table contains 6 columns instead of 7, using default member directional cosines ID (-1) for all members. & &The directional cosines will be computed based on the member nodes for all members.') - Init%Members(:,7) = -1 + Init%Members(:,7) = -1 ! For the spring element, we need the direction cosine from the user. Both JointIDs are coincident, the direction cosine cannot be determined. endif ! Extract fields from first line DO I = 1, nColumns @@ -1229,6 +1299,7 @@ SUBROUTINE SD_Input(SDInputFile, Init, p, ErrStat,ErrMsg) 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 + bCableHasPretension = .false. 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 @@ -1241,7 +1312,18 @@ SUBROUTINE SD_Input(SDInputFile, Init, p, ErrStat,ErrMsg) 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 + if (Init%PropSetsC(I,4)>0.0) then + bCableHasPretension = .true. + end if ENDDO + if (bCableHasPretension) then + call WrScr('!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!') + call WrScr('Warning: Cable with non-zero pretension specified.') + call WrScr(' SubDyn currently does not account for geometric stiffness from pretension.' ) + call WrScr(' Avoid non-zero cable pretension if possible.' ) + call WrScr('!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!') + end if + !----------------------- 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 @@ -1252,11 +1334,29 @@ SUBROUTINE SD_Input(SDInputFile, Init, p, ErrStat,ErrMsg) 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 + !----------------------- SPRING ELEMENT PROPERTIES -------------------------------- + CALL ReadCom ( UnIn, SDInputFile, 'Spring element properties' ,ErrStat2, ErrMsg2, UnEc ); if(Failed()) return + CALL ReadIVar ( UnIn, SDInputFile, Init%NPropSetsS, 'NPropSetsS', 'Number of spring properties' ,ErrStat2, ErrMsg2, UnEc ); if(Failed()) return + CALL ReadCom ( UnIn, SDInputFile, 'Spring element properties Header' ,ErrStat2, ErrMsg2, UnEc ); if(Failed()) return + CALL ReadCom ( UnIn, SDInputFile, 'Spring element properties Unit ' ,ErrStat2, ErrMsg2, UnEc ); if(Failed()) return + IF (Check( Init%NPropSetsS < 0, 'NPropSetsSpring must be >=0')) return + CALL AllocAry(Init%PropSetsS, Init%NPropSetsS, PropSetsSCol, 'PropSetsS', ErrStat2, ErrMsg2); if(Failed()) return + DO I = 1, Init%NPropSetsS + READ(UnIn, FMT='(A)', IOSTAT=ErrStat2) Line; ErrMsg2='Error reading spring property line'; if (Failed()) return + call ReadFAryFromStr(Line, Init%PropSetsS(I,:), PropSetsSCol, nColValid, nColNumeric); + if ((nColValid/=nColNumeric).or.((nColNumeric/=22).and.(nColNumeric/=PropSetsSCol)) ) then + CALL Fatal(' Error in file "'//TRIM(SDInputFile)//'": Spring property line must consist of 22 numerical values. Problematic line: "'//trim(Line)//'"') + return + endif + ENDDO + else Init%NPropSetsC=0 Init%NPropSetsR=0 + Init%NPropSetsS=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 + CALL AllocAry(Init%PropSetsS, Init%NPropSetsS, PropSetsSCol, 'PropSetsS', ErrStat2, ErrMsg2); if(Failed()) return endif !---------------------- MEMBER COSINE MATRICES COSM(i,j) ------------------------ @@ -2794,6 +2894,7 @@ SUBROUTINE AllocMiscVars(p, Misc, ErrStat, ErrMsg) 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') + CALL AllocAry( Misc%FG, p%nDOF , 'm%FG ', ErrStat2, ErrMsg2 );CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'AllocMiscVars') END SUBROUTINE AllocMiscVars @@ -3098,13 +3199,11 @@ SUBROUTINE LeverArm(u, p, x, m, DU_full, bGuyan, bElastic) 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 + real(ReKi), dimension(3,3) :: DCM 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/) - + ! --- 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 ) @@ -3113,6 +3212,9 @@ SUBROUTINE LeverArm(u, p, x, m, DU_full, bGuyan, bElastic) end if ! --- Adding Guyan contribution to R and L DOFs if (bGuyan .and. .not.p%Floating) then + ! 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/) m%UR_bar = matmul( p%TI , m%u_TP ) m%UL = m%UL + matmul( p%PhiRb_TI, m%u_TP ) else @@ -3134,8 +3236,9 @@ SUBROUTINE LeverArm(u, p, x, m, DU_full, bGuyan, bElastic) 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) + DU_full(DOFList(1:3)) = matmul(Rb2g, DU_full(DOFList(1:3))) + duP(1:3) + CALL SmllRotTrans('Nodal rotation',DU_full(DOFList(4)),DU_full(DOFList(5)),DU_full(DOFList(6)),DCM,'',ErrStat2,ErrMsg2); + DU_full(DOFList(4:6)) = EulerExtractZYX( matmul(DCM,transpose(Rb2g)) ) 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) @@ -3166,14 +3269,22 @@ SUBROUTINE GetExtForceOnInternalDOF(u, p, x, m, F_L, ErrStat, ErrMsg, GuyanLoadC real(ReKi) :: CableTension ! Controllable Cable force real(ReKi) :: DeltaL ! Change of length real(ReKi) :: rotations(3) - real(ReKi) :: du(3), Moment(3), Force(3) + real(ReKi) :: du(3), Moment(3), Force(3), CMassOffset(3), CMassWeight(3) real(ReKi) :: u_TP(6) + real(FEKi) :: FGe(12) ! element gravity force vector ! 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), dimension(3,3) :: orientation ! Nodal orientation matrix + + INTEGER(IntKi) :: ErrStat2 ! Error status of the operation + CHARACTER(ErrMsgLen) :: ErrMsg2 ! Error message if ErrStat /= ErrID_None + + ErrStat = ErrID_None + ErrMsg = "" if (GuyanLoadCorrection) then ! Compute node displacements "DU_full" for lever arm @@ -3194,11 +3305,11 @@ SUBROUTINE GetExtForceOnInternalDOF(u, p, x, m, F_L, ErrStat, ErrMsg, GuyanLoadC 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))) + m%Fext( p%NodesDOF(iNode)%List(1:3) ) = matmul(Rg2b, u%LMesh%Force(:,iNode) + p%FG(p%NodesDOF(iNode)%List(1:3)) ) + p%FC(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)) + m%Fext( p%NodesDOF(iNode)%List(1:3) ) = u%LMesh%Force(:,iNode) + p%FG(p%NodesDOF(iNode)%List(1:3)) + p%FC(p%NodesDOF(iNode)%List(1:3)) enddo endif @@ -3232,19 +3343,56 @@ SUBROUTINE GetExtForceOnInternalDOF(u, p, x, m, F_L, ErrStat, ErrMsg, GuyanLoadC endif ! --- Build vector of external moment + ! For floating structure with potentially large Guyan (rigid-body) rotation, nodal self-weight needs to be recomputed based on the current rigid-body orientation + m%FG = 0.0_R8Ki + if ( RotateLoads ) then ! if and only if floating + Rb2g = transpose(Rg2b) ! Body (Guyan) to global + do i = 1, size(p%ElemProps) ! Loop through all elements + ! --- Element Fg in the earth-fixed frame + CALL ElemG(p%ElemProps(i)%Area, p%ElemProps(i)%Length, p%ElemProps(i)%Rho, matmul(Rb2g,p%ElemProps(i)%DirCos), FGe, p%g) + ! --- Element Fg in the Guyan rigid-body frame + FGe( 1: 3) = matmul(Rg2b,FGe( 1: 3)) ! Node 1 force + FGe( 4: 6) = matmul(Rg2b,FGe( 4: 6)) ! Node 1 moment + FGe( 7: 9) = matmul(Rg2b,FGe( 7: 9)) ! Node 2 force + FGe(10:12) = matmul(Rg2b,FGe(10:12)) ! Node 2 moment + ! --- Assembly in global unconstrained system + IDOF = p%ElemsDOF(1:12,i) + m%FG( IDOF ) = m%FG( IDOF ) + FGe(1:12) + end do + do i = 1,size(p%CMassNode) ! Loop through all concentrated masses + iNode = p%CMassNode(i) + IDOF(1:6) = p%NodesDOF(iNode)%List(1:6) + CMassOffset = p%CMassOffset(i,:) + CMassWeight = matmul(Rg2b, (/0.0,0.0,-p%CMassWeight(i)/) ) + m%FG(IDOF(1:3)) = m%FG(IDOF(1:3)) + CMassWeight + m%FG(IDOF(4:6)) = m%FG(IDOF(4:6)) + cross_product(CMassOffset,CMassWeight) + end do + end if + + if (GuyanLoadCorrection) then ! if and only if fixed-bottom + ! Additional GuyanLoadCorrection coming from the weight of concentrated masses with CoG offset + do i = 1,size(p%CMassNode) ! Loop through all concentrated masses + iNode = p%CMassNode(i) + IDOF(4:6) = p%NodesDOF(iNode)%List(4:6) + call SmllRotTrans('Nodal rotation',m%DU_full(IDOF(4)),m%DU_full(IDOF(5)),m%DU_full(IDOF(6)),orientation,'',ErrStat2,ErrMsg2); if(Failed()) return + CMassOffset = matmul(p%CMassOffset(i,:),orientation) + m%Fext(IDOF(4:6)) = m%Fext(IDOF(4:6)) + cross_product( CMassOffset-p%CMassOffset(i,:), (/0.0,0.0,-p%CMassWeight(i)/) ) + end do + end if + do iNode = 1,p%nNodes Force(1:3) = m%Fext(p%NodesDOF(iNode)%List(1:3) ) ! Controllable cable + External Forces on LMesh Moment(1:3) = m%Fext(p%NodesDOF(iNode)%List(4:6) ) ! Controllable cable - ! Moment ext + gravity + ! Moment ext + gravity (Cable pretension has no moment contribution) if (RotateLoads) then ! In body coordinates - Moment(1:3) = matmul(Rg2b, Moment(1:3)+ u%LMesh%Moment(1:3,iNode) + p%FG(p%NodesDOF(iNode)%List(4:6))) + Moment(1:3) = matmul(Rg2b, Moment(1:3)+ u%LMesh%Moment(1:3,iNode) ) + m%FG(p%NodesDOF(iNode)%List(4:6)) ! Use updated m%FG instead of p%FG else - Moment(1:3) = Moment(1:3)+ u%LMesh%Moment(1:3,iNode) + p%FG(p%NodesDOF(iNode)%List(4:6)) + Moment(1:3) = 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 + if (GuyanLoadCorrection) then ! if and only if fixed-bottom 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) @@ -3269,8 +3417,14 @@ SUBROUTINE GetExtForceOnInternalDOF(u, p, x, m, F_L, ErrStat, ErrMsg, GuyanLoadC contains subroutine Fatal(ErrMsg_in) character(len=*), intent(in) :: ErrMsg_in - call SetErrStat(ErrID_Fatal, ErrMsg_in, ErrStat, ErrMsg, 'GetExtForce'); + call SetErrStat(ErrID_Fatal, ErrMsg_in, ErrStat, ErrMsg, 'GetExtForceOnInternalDOF'); end subroutine Fatal + + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'GetExtForceOnInternalDOF') + Failed = ErrStat >= AbortErrLev + end function Failed + END SUBROUTINE GetExtForceOnInternalDOF !------------------------------------------------------------------------------------------------------ @@ -3554,6 +3708,7 @@ SUBROUTINE OutSummary(Init, p, m, InitInput, CBparams, Modes, Omega, Omega_Gy, E INTEGER(IntKi) :: i, j, k, propIDs(2), Iprop(2) !counter and temporary holders INTEGER(IntKi) :: iNode1, iNode2 ! Node indices INTEGER(IntKi) :: mType ! Member Type + INTEGER :: iDirCos REAL(ReKi) :: mMass, mLength ! Member mass and length REAL(ReKi) :: M_O(6,6) ! Equivalent mass matrix at origin REAL(ReKi) :: M_P(6,6) ! Equivalent mass matrix at P (ref point) @@ -3770,11 +3925,13 @@ SUBROUTINE OutSummary(Init, p, m, InitInput, CBparams, Modes, Omega, Omega_Gy, E 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 + !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) + if (Init%Members(I, iMType)/=idMemberSpring) then ! This check only applies for members different than springs (springs have no mass and no length) + mLength=MemberLength(Init%Members(i,1),Init,ErrStat,ErrMsg) ! TODO double check mass and length + endif + IF (ErrStat .EQ. ErrID_None) THEN mType = Init%Members(I, iMType) ! if (mType==idMemberBeamCirc) then iProp(1) = FINDLOCI(Init%PropSetsB(:,1), propIDs(1)) @@ -3794,6 +3951,12 @@ SUBROUTINE OutSummary(Init, p, m, InitInput, CBparams, Modes, Omega, Omega_Gy, E 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 if (mType==idMemberSpring) then + iProp(1) = FINDLOCI(Init%PropSetsS(:,1), propIDs(1)) + mMass= 0.0 ! Spring element has no mass + mLength = 0.0 ! Spring element has no length. Both JointIDs must be coincident. + 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), ' # Spring element' else if (mType==idMemberBeamArb) then iProp(1) = FINDLOCI(Init%PropSetsX(:,1), propIDs(1)) iProp(2) = FINDLOCI(Init%PropSetsX(:,1), propIDs(2)) @@ -3803,9 +3966,9 @@ SUBROUTINE OutSummary(Init, p, m, InitInput, CBparams, Modes, Omega, Omega_Gy, E else WRITE(UnSum, '(A)') '#TODO, member unknown' endif - ELSE - RETURN - ENDIF + ELSE + RETURN + ENDIF ENDDO !------------------------------------------------------------------------------------------------------------- ! write Cosine matrix for all members to a txt file @@ -3814,11 +3977,25 @@ SUBROUTINE OutSummary(Init, p, m, InitInput, CBparams, Modes, Omega, Omega_Gy, E 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 + mType = Init%Members(I, iMType) 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) + if ((mType == idMemberSpring) .or. (mType == idMemberBeamArb)) then ! The direction cosine for these member types must be provided by the user + iDirCos = p%Elems(i, iMDirCosID) + DirCos(1, 1) = Init%COSMs(iDirCos, 2) + DirCos(2, 1) = Init%COSMs(iDirCos, 3) + DirCos(3, 1) = Init%COSMs(iDirCos, 4) + DirCos(1, 2) = Init%COSMs(iDirCos, 5) + DirCos(2, 2) = Init%COSMs(iDirCos, 6) + DirCos(3, 2) = Init%COSMs(iDirCos, 7) + DirCos(1, 3) = Init%COSMs(iDirCos, 8) + DirCos(2, 3) = Init%COSMs(iDirCos, 9) + DirCos(3, 3) = Init%COSMs(iDirCos, 10) + else + CALL GetDirCos(XYZ1(1:3), XYZ2(1:3), mType, DirCos, mLength, ErrStat, ErrMsg) + endif DirCos=TRANSPOSE(DirCos) !This is now global to local WRITE(UnSum, '("#",I9,9(ES28.18E2))') Init%Members(i,1), ((DirCos(k,j),j=1,3),k=1,3) ENDDO @@ -4089,7 +4266,7 @@ FUNCTION MemberLength(MemberID,Init,ErrStat,ErrMsg) 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 + 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 @@ -4175,44 +4352,6 @@ SUBROUTINE SymMatDebug(M,MAT) 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_integer(string, x) - IMPLICIT NONE - CHARACTER(len=*), INTENT(IN) :: string - INTEGER(IntKi), INTENT(OUT) :: x - LOGICAL :: is_integer - INTEGER :: e, n - x = 0 - n=LEN_TRIM(string) - READ(string,*,IOSTAT=e) x - is_integer = e == 0 -END FUNCTION is_integer - -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 diff --git a/modules/subdyn/src/SubDyn_Driver.f90 b/modules/subdyn/src/SubDyn_Driver.f90 index de2bb6e880..85337d738f 100644 --- a/modules/subdyn/src/SubDyn_Driver.f90 +++ b/modules/subdyn/src/SubDyn_Driver.f90 @@ -490,20 +490,6 @@ end subroutine LegacyWarning ! -------------------------------------------------------------------------------- ! --- Generic routines (also present in other modules, e.g. OLAF, AD Driver) ! -------------------------------------------------------------------------------- - 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_int(string, x) implicit none character(len=*), intent(in) :: string @@ -517,111 +503,5 @@ function is_int(string, x) read(string,fmt,iostat=e) x is_int = e == 0 end function is_int - - !> Read a delimited file with one line of header - subroutine ReadDelimFile(Filename, nCol, Array, errStat, errMsg, nHeaderLines, priPath) - character(len=*), intent(in) :: Filename - integer, intent(in) :: nCol - real(ReKi), dimension(:,:), allocatable, intent(out) :: Array - integer(IntKi) , intent(out) :: errStat ! Status of error message - character(*) , intent(out) :: errMsg ! Error message if ErrStat /= ErrID_None - integer(IntKi), optional, intent(in ) :: nHeaderLines - character(*) , optional, intent(in ) :: priPath ! Primary path, to use if filename is not absolute - integer :: UnIn, i, j, nLine, nHead - character(len= 2048) :: line - integer(IntKi) :: errStat2 ! local status of error message - character(ErrMsgLen) :: errMsg2 ! temporary Error message - character(len=2048) :: Filename_Loc ! filename local to this function - ErrStat = ErrID_None - ErrMsg = "" - - Filename_Loc = Filename - if (present(priPath)) then - if (PathIsRelative(Filename_Loc)) Filename_Loc = trim(PriPath)//trim(Filename) - endif - - - ! Open file - call GetNewUnit(UnIn) - call OpenFInpFile(UnIn, Filename_Loc, errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, 'ReadDelimFile') - if (errStat >= AbortErrLev) return - ! Count number of lines - nLine = line_count(UnIn) - allocate(Array(nLine-1, nCol), stat=errStat2); errMsg2='allocation failed'; call SetErrStat(errStat2, errMsg2, errStat, errMsg, 'ReadDelimFile') - if (errStat >= AbortErrLev) return - ! Read header - nHead=1 - if (present(nHeaderLines)) nHead = nHeaderLines - do i=1,nHead - read(UnIn, *, IOSTAT=errStat2) line - errMsg2 = ' Error reading line '//trim(Num2LStr(1))//' of file: '//trim(Filename_Loc) - call SetErrStat(errStat2, errMsg2, errStat, errMsg, 'ReadDelimFile') - if (errStat >= AbortErrLev) return - enddo - ! Read data - do I = 1,nLine-1 - read (UnIn,*,IOSTAT=errStat2) (Array(I,J), J=1,nCol) - errMsg2 = ' Error reading line '//trim(Num2LStr(I+1))//' of file: '//trim(Filename_Loc) - call SetErrStat(errStat2, errMsg2, errStat, errMsg, 'ReadDelimFile') - if (errStat >= AbortErrLev) return - end do - close(UnIn) - end subroutine ReadDelimFile - - !> Counts number of lines in a file - integer function line_count(iunit) - integer, intent(in) :: iunit - character(len=2048) :: line - ! safety for infinite loop.. - integer :: i - integer, parameter :: nline_max=100000000 ! 100 M - line_count=0 - do i=1,nline_max - line='' - read(iunit,'(A)',END=100)line - line_count=line_count+1 - enddo - if (line_count==nline_max) then - print*,'Error: maximum number of line exceeded for line_count' - STOP - endif - 100 if(len(trim(line))>0) then - line_count=line_count+1 - endif - rewind(iunit) - return - end function - !> Perform linear interpolation of an array, where first column is assumed to be ascending time values - !! First value is used for times before, and last value is used for time beyond - subroutine interpTimeValue(array, time, iLast, values) - real(ReKi), dimension(:,:), intent(in) :: array !< vector of time steps - real(DbKi), intent(in) :: time !< time - integer, intent(inout) :: iLast - real(ReKi), dimension(:), intent(out) :: values !< vector of values at given time - integer :: i - real(ReKi) :: alpha - if (array(iLast,1)> time) then - values = array(iLast,2:) - elseif (iLast == size(array,1)) then - values = array(iLast,2:) - else - ! Look for index - do i=iLast,size(array,1) - if (array(i,1)<=time) then - iLast=i - else - exit - endif - enddo - if (iLast==size(array,1)) then - values = array(iLast,2:) - else - ! Linear interpolation - alpha = (array(iLast+1,1)-time)/(array(iLast+1,1)-array(iLast,1)) - values = array(iLast,2:)*alpha + array(iLast+1,2:)*(1-alpha) - !print*,'time', array(iLast,1), '<=', time,'<', array(iLast+1,1), 'fact', alpha - endif - endif - end subroutine interpTimeValue !---------------------------------------------------------------------------------------------------------------------------------- END PROGRAM diff --git a/modules/subdyn/src/SubDyn_Output.f90 b/modules/subdyn/src/SubDyn_Output.f90 index 769caf5ec0..76d470711c 100644 --- a/modules/subdyn/src/SubDyn_Output.f90 +++ b/modules/subdyn/src/SubDyn_Output.f90 @@ -285,9 +285,25 @@ SUBROUTINE SDOut_MapOutputs(u,p,x, y, m, AllOuts, ErrStat, ErrMsg ) 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) + real(R8Ki), dimension(3,3) :: Rg2b ! Rotation matrix global 2 body (Guyan) coordinates + real(R8Ki), dimension(6,6) :: RRg2b ! Rotation matrix global 2 body (Guyan) coordinates, acts on a 6-vector + INTEGER(IntKi) :: ErrStat2 ! Error status of the operation + CHARACTER(ErrMsgLen) :: ErrMsg2 ! Error message if ErrStat /= ErrID_None + ErrStat = ErrID_None ErrMsg = "" - + + if ( p%Floating ) then + ! For floating, m%U_full_dotdot is currently in the earth-fixed frame. + ! Need to transform back to the Guyan frame when computing MαNβFMxe, MαNβFMye, MαNβFMze, MαNβMMxe, MαNβMMye, MαNβMMze. + Rg2b = u%TPMesh%Orientation(:,:,1) ! global 2 body coordinates + else + call Eye(Rg2b, ErrStat2, ErrMsg2) + end if + RRg2b = 0.0_R8Ki + RRg2b(1:3,1:3) = Rg2b + RRg2b(4:6,4:6) = Rg2b + AllOuts = 0.0_ReKi ! initialize for those outputs that aren't valid (and thus aren't set in this routine) ! -------------------------------------------------------------------------------- @@ -322,14 +338,14 @@ SUBROUTINE SDOut_MapOutputs(u,p,x, y, m, AllOuts, ErrStat, ErrMsg ) ! 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 + ! Displacement- Rotational - need direction cosine matrix to tranform rotations - In Local reference Element Ref Sys <- Need to rethink this for large platform rotation + ! "MαNβRDxe, MαNβRDye, MαNβRDze" + AllOuts(MNRDe (:,iiNode,iMemberOutput)) = matmul(DIRCOS,m%U_full_elast(DOFList(4:6))) ! Element elastic rotation only in Guyan frame for floating. Full motion for fixed-bottom. ! 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 + AllOuts(MNTRAe (1:3,iiNode,iMemberOutput)) = matmul(DIRCOS,matmul(Rg2b,m%U_full_dotdot(DOFList(1:3)))) ! translational accel local ref + AllOuts(MNTRAe (4:6,iiNode,iMemberOutput)) = matmul(DIRCOS,matmul(Rg2b,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 @@ -435,10 +451,10 @@ subroutine ElementForce(pLst, iiNode, JJ, FM_elm, FK_elm, sgn, DIRCOS, bUseInput 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)) + X_e(1:6) = m%U_full_elast (p%NodesDOF(ElemNodes(1))%List(1:6)) ! For floating, m%U_full_elast is the CB+SIM elastic deformation only in the Guyan (rigid-body) frame + X_e(7:12) = m%U_full_elast (p%NodesDOF(ElemNodes(2))%List(1:6)) ! No additional transformation required + Xdd_e(1:6) = matmul(RRg2b,m%U_full_dotdot(p%NodesDOF(ElemNodes(1))%List(1:6))) ! Transform acceleration to be back in the Guyan frame + Xdd_e(7:12) = matmul(RRg2b,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 @@ -984,7 +1000,7 @@ SUBROUTINE SD_Perturb_u( p, n, perturb_sign, u, du ) 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, UseSmlAngle=.true. ) + CALL PerturbOrientationMatrix( u%TPMesh%Orientation(:,:,node), du * perturb_sign, fieldIndx, UseSmlAngle=.false. ) 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; @@ -1013,8 +1029,8 @@ SUBROUTINE SD_Compute_dY(p, y_p, y_m, delta, dY) 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, UseSmlAngle=.true.) ! all 6 motion fields - call PackMotionMesh_dY(y_p%Y3Mesh, y_m%Y3Mesh, dY, indx_first, UseSmlAngle=.true.) ! all 6 motion fields + call PackMotionMesh_dY(y_p%Y2Mesh, y_m%Y2Mesh, dY, indx_first, UseSmlAngle=.false.) ! all 6 motion fields + call PackMotionMesh_dY(y_p%Y3Mesh, y_m%Y3Mesh, dY, indx_first, UseSmlAngle=.false.) ! all 6 motion fields do i=1,p%NumOuts dY(i+indx_first-1) = y_p%WriteOutput(i) - y_m%WriteOutput(i) end do diff --git a/modules/subdyn/src/SubDyn_Registry.txt b/modules/subdyn/src/SubDyn_Registry.txt index 0287f2ab96..80af480766 100644 --- a/modules/subdyn/src/SubDyn_Registry.txt +++ b/modules/subdyn/src/SubDyn_Registry.txt @@ -42,6 +42,27 @@ typedef ^ ElemPropType ReKi D {2} - - "Diameter at node 1 and 2, f 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 ReKi k11 - - - "Spring translational stiffness" N/m +typedef ^ ElemPropType ReKi k12 - - - "Spring cross-coupling stiffness" N/m +typedef ^ ElemPropType ReKi k13 - - - "Spring cross-coupling stiffness" N/m +typedef ^ ElemPropType ReKi k14 - - - "Spring cross-coupling stiffness" N/rad +typedef ^ ElemPropType ReKi k15 - - - "Spring cross-coupling stiffness" N/rad +typedef ^ ElemPropType ReKi k16 - - - "Spring cross-coupling stiffness" N/rad +typedef ^ ElemPropType ReKi k22 - - - "Spring translational stiffness" N/m +typedef ^ ElemPropType ReKi k23 - - - "Spring cross-coupling stiffness" N/m +typedef ^ ElemPropType ReKi k24 - - - "Spring cross-coupling stiffness" N/rad +typedef ^ ElemPropType ReKi k25 - - - "Spring cross-coupling stiffness" N/rad +typedef ^ ElemPropType ReKi k26 - - - "Spring cross-coupling stiffness" N/rad +typedef ^ ElemPropType ReKi k33 - - - "Spring translational stiffness" N/m +typedef ^ ElemPropType ReKi k34 - - - "Spring cross-coupling stiffness" N/rad +typedef ^ ElemPropType ReKi k35 - - - "Spring cross-coupling stiffness" N/rad +typedef ^ ElemPropType ReKi k36 - - - "Spring cross-coupling stiffness" N/rad +typedef ^ ElemPropType ReKi k44 - - - "Spring rotational stiffness" Nm/rad +typedef ^ ElemPropType ReKi k45 - - - "Spring cross-coupling stiffness" Nm/rad +typedef ^ ElemPropType ReKi k46 - - - "Spring cross-coupling stiffness" Nm/rad +typedef ^ ElemPropType ReKi k55 - - - "Spring rotational stiffness" Nm/rad +typedef ^ ElemPropType ReKi k56 - - - "Spring cross-coupling stiffness" Nm/rad +typedef ^ ElemPropType ReKi k66 - - - "Spring rotational stiffness" Nm/rad typedef ^ ElemPropType R8Ki DirCos {3}{3} - - "Element direction cosine matrix" # ============================== Input Initialization (from glue code) ============================================================================================================================================ @@ -74,13 +95,14 @@ typedef ^ ^ LOGICAL CableCChanRqst {:} .FALSE. 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 ReKi g - - - "Gravity acceleration" m/s^2 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 NPropSetsS - - - "Number of property sets for spring elements" 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" @@ -90,6 +112,7 @@ typedef ^ SD_InitType ReKi Joints {:}{:} - - "Joints nu 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 PropSetsS {:}{:} - - "Property ID and values for spring element" typedef ^ SD_InitType ReKi PropSetsX {:}{:} - - "Extended property sets" typedef ^ SD_InitType R8Ki COSMs {:}{:} - - "Independent direction cosine matrices" typedef ^ SD_InitType ReKi CMass {:}{:} - - "Concentrated mass information" @@ -111,10 +134,12 @@ typedef ^ SD_InitType INTEGER NElem - - - "Total num 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 INTEGER NPropS - - - "Total number of property sets for Spring" 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 ReKi PropsS {:}{:} - - "Property sets and values for Spring " 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) )" @@ -164,6 +189,7 @@ typedef ^ MiscVarType DbKi LastOutTime - - - "The time of 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" "-" +typedef ^ MiscVarType R8Ki FG {:} - - "Gravity force vector (without initial cable force T0) based on the instantaneous platform orientation, not reduced (floating only)" N # SIM typedef ^ MiscVarType ReKi UL_SIM {:} - - "UL for SIM = PhiL qL0- PhiM qm0, size nL" typedef ^ MiscVarType ReKi UL_0m {:} - - "Intermediate UL term for SIM = PhiM qm0, size nL" @@ -171,6 +197,7 @@ typedef ^ MiscVarType ReKi UL_0m {:} - - "Intermedia # ============================== Parameters ============================================================================================================================================ # --- Parameters - Algo +typedef ^ ParameterType ReKi g - - - "Gravity acceleration" m/s^2 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 @@ -179,9 +206,14 @@ typedef ^ ParameterType INTEGER nDOF_red - - - "Total degree 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 R8Ki FC {:} - - "Initial cable force T0, not reduced" N +typedef ^ ParameterType R8Ki FG {:} - - "Gravity force vector, not reduced" N typedef ^ ParameterType ReKi DP0 {:}{:} - - "Vector from TP to a Node at t=0, used for Floating Rigid Body motion" m +typedef ^ ParameterType ReKi rPG {:} - - "Vector from TP to rigid-body CoG in the Guyan (rigid-body) frame, used for Floating Rigid Body Motion" m typedef ^ ParameterType IntKi NodeID2JointID {:} - - "Store Joint ID for each NodeID since SubDyn re-label nodes (and add more nodes)" "-" +typedef ^ ParameterType IntKi CMassNode {:} - - "Node indices for concentrated masses" +typedef ^ ParameterType ReKi CMassWeight {:} - - "Weight of concentrated masses" N +typedef ^ ParameterType ReKi CMassOffset {:}{:} - - "Concentrated mass CoG offset from attached nodes" 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" "-" diff --git a/modules/subdyn/src/SubDyn_Tests.f90 b/modules/subdyn/src/SubDyn_Tests.f90 index 138435f85f..6576a77c05 100644 --- a/modules/subdyn/src/SubDyn_Tests.f90 +++ b/modules/subdyn/src/SubDyn_Tests.f90 @@ -323,6 +323,7 @@ subroutine Test_Transformations(ErrStat,ErrMsg) character(ErrMsgLen), intent(out) :: ErrMsg real(ReKi), dimension(3) :: P1, P2, e1, e2, e3 + integer(IntKi) :: eType real(FEKi), dimension(3,3) :: DirCos, Ref real(ReKi), dimension(6,6) :: T, Tref real(ReKi) :: L @@ -332,7 +333,7 @@ subroutine Test_Transformations(ErrStat,ErrMsg) ! --- DirCos P1=(/0,0,0/) P2=(/2,0,0/) - call GetDirCos(P1, P2, DirCos, L, ErrStat, ErrMsg) + call GetDirCos(P1, P2, eType, 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.) diff --git a/modules/subdyn/src/SubDyn_Types.f90 b/modules/subdyn/src/SubDyn_Types.f90 index b6dfcc095e..6a539f1ab2 100644 --- a/modules/subdyn/src/SubDyn_Types.f90 +++ b/modules/subdyn/src/SubDyn_Types.f90 @@ -40,8 +40,8 @@ MODULE SubDyn_Types ! ======================= ! ========= MeshAuxDataType ======= TYPE, PUBLIC :: MeshAuxDataType - INTEGER(IntKi) :: MemberID !< Member ID for Output [-] - INTEGER(IntKi) :: NOutCnt !< Number of Nodes for the output member [-] + INTEGER(IntKi) :: MemberID = 0_IntKi !< Member ID for Output [-] + INTEGER(IntKi) :: NOutCnt = 0_IntKi !< 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 [-] @@ -63,31 +63,52 @@ MODULE SubDyn_Types ! ======================= ! ========= 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_x !< Shear coefficient [-] - REAL(ReKi) :: Kappa_y !< Shear coefficient [-] - REAL(ReKi) :: YoungE !< Young's modulus [-] - REAL(ReKi) :: ShearG !< Shear modulus [N/m^2] - REAL(ReKi) , DIMENSION(1:2) :: D !< Diameter at node 1 and 2, for visualization only [m] - 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 [-] + INTEGER(IntKi) :: eType = 0_IntKi !< Element Type [-] + REAL(ReKi) :: Length = 0.0_ReKi !< Length of an element [-] + REAL(ReKi) :: Ixx = 0.0_ReKi !< Moment of inertia of an element [-] + REAL(ReKi) :: Iyy = 0.0_ReKi !< Moment of inertia of an element [-] + REAL(ReKi) :: Jzz = 0.0_ReKi !< Moment of inertia of an element [-] + LOGICAL :: Shear = .false. !< Use timoshenko (true) E-B (false) [-] + REAL(ReKi) :: Kappa_x = 0.0_ReKi !< Shear coefficient [-] + REAL(ReKi) :: Kappa_y = 0.0_ReKi !< Shear coefficient [-] + REAL(ReKi) :: YoungE = 0.0_ReKi !< Young's modulus [-] + REAL(ReKi) :: ShearG = 0.0_ReKi !< Shear modulus [N/m^2] + REAL(ReKi) , DIMENSION(1:2) :: D = 0.0_ReKi !< Diameter at node 1 and 2, for visualization only [m] + REAL(ReKi) :: Area = 0.0_ReKi !< Area of an element [m^2] + REAL(ReKi) :: Rho = 0.0_ReKi !< Density [kg/m^3] + REAL(ReKi) :: T0 = 0.0_ReKi !< Pretension [N] + REAL(ReKi) :: k11 = 0.0_ReKi !< Spring translational stiffness [N/m] + REAL(ReKi) :: k12 = 0.0_ReKi !< Spring cross-coupling stiffness [N/m] + REAL(ReKi) :: k13 = 0.0_ReKi !< Spring cross-coupling stiffness [N/m] + REAL(ReKi) :: k14 = 0.0_ReKi !< Spring cross-coupling stiffness [N/rad] + REAL(ReKi) :: k15 = 0.0_ReKi !< Spring cross-coupling stiffness [N/rad] + REAL(ReKi) :: k16 = 0.0_ReKi !< Spring cross-coupling stiffness [N/rad] + REAL(ReKi) :: k22 = 0.0_ReKi !< Spring translational stiffness [N/m] + REAL(ReKi) :: k23 = 0.0_ReKi !< Spring cross-coupling stiffness [N/m] + REAL(ReKi) :: k24 = 0.0_ReKi !< Spring cross-coupling stiffness [N/rad] + REAL(ReKi) :: k25 = 0.0_ReKi !< Spring cross-coupling stiffness [N/rad] + REAL(ReKi) :: k26 = 0.0_ReKi !< Spring cross-coupling stiffness [N/rad] + REAL(ReKi) :: k33 = 0.0_ReKi !< Spring translational stiffness [N/m] + REAL(ReKi) :: k34 = 0.0_ReKi !< Spring cross-coupling stiffness [N/rad] + REAL(ReKi) :: k35 = 0.0_ReKi !< Spring cross-coupling stiffness [N/rad] + REAL(ReKi) :: k36 = 0.0_ReKi !< Spring cross-coupling stiffness [N/rad] + REAL(ReKi) :: k44 = 0.0_ReKi !< Spring rotational stiffness [Nm/rad] + REAL(ReKi) :: k45 = 0.0_ReKi !< Spring cross-coupling stiffness [Nm/rad] + REAL(ReKi) :: k46 = 0.0_ReKi !< Spring cross-coupling stiffness [Nm/rad] + REAL(ReKi) :: k55 = 0.0_ReKi !< Spring rotational stiffness [Nm/rad] + REAL(ReKi) :: k56 = 0.0_ReKi !< Spring cross-coupling stiffness [Nm/rad] + REAL(ReKi) :: k66 = 0.0_ReKi !< Spring rotational stiffness [Nm/rad] + REAL(R8Ki) , DIMENSION(1:3,1:3) :: DirCos = 0.0_R8Ki !< 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) :: g = 0.0_ReKi !< Gravity acceleration [-] + REAL(ReKi) :: WtrDpth = 0.0_ReKi !< Water Depth (positive valued) [-] + REAL(ReKi) , DIMENSION(1:3) :: TP_RefPoint = 0.0_ReKi !< global position of transition piece reference point (could also be defined in SubDyn itself) [-] + REAL(ReKi) :: SubRotateZ = 0.0_ReKi !< 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. [-] @@ -112,56 +133,60 @@ MODULE SubDyn_Types ! ========= 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(1:3) :: TP_RefPoint = 0.0_ReKi !< global position of transition piece reference point (could also be defined in SubDyn itself) [-] + REAL(ReKi) :: SubRotateZ = 0.0_ReKi !< Rotation angle in degrees about global Z [-] + REAL(ReKi) :: g = 0.0_ReKi !< Gravity acceleration [m/s^2] + REAL(DbKi) :: DT = 0.0_R8Ki !< Time step from Glue Code [seconds] + INTEGER(IntKi) :: NJoints = 0_IntKi !< Number of joints of the sub structure [-] + INTEGER(IntKi) :: NPropSetsX = 0_IntKi !< Number of extended property sets [-] + INTEGER(IntKi) :: NPropSetsB = 0_IntKi !< Number of property sets for beams [-] + INTEGER(IntKi) :: NPropSetsC = 0_IntKi !< Number of property sets for cables [-] + INTEGER(IntKi) :: NPropSetsR = 0_IntKi !< Number of property sets for rigid links [-] + INTEGER(IntKi) :: NPropSetsS = 0_IntKi !< Number of property sets for spring elements [-] + INTEGER(IntKi) :: NCMass = 0_IntKi !< Number of joints with concentrated mass [-] + INTEGER(IntKi) :: NCOSMs = 0_IntKi !< Number of independent cosine matrices [-] + INTEGER(IntKi) :: FEMMod = 0_IntKi !< FEM switch element model in the FEM [-] + INTEGER(IntKi) :: NDiv = 0_IntKi !< Number of divisions for each member [-] + LOGICAL :: CBMod = .false. !< 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 :: PropSetsS !< Property ID and values for spring element [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PropSetsX !< Extended property sets [-] REAL(R8Ki) , 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) :: GuyanDampMod = 0_IntKi !< Guyan damping [0=none, 1=Rayleigh Damping, 2= user specified 6x6 matrix] [-] + REAL(ReKi) , DIMENSION(1:2) :: RayleighDamp = 0.0_ReKi !< Mass and stiffness proportional damping coefficients (Rayleigh Damping) [only if GuyanDampMod=1] [-] + REAL(ReKi) , DIMENSION(1:6,1:6) :: GuyanDampMat = 0.0_ReKi !< 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 [-] + LOGICAL :: OutCOSM = .false. !< Output Cos-matrices Flag [-] + LOGICAL :: TabDelim = .false. !< 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 [-] + INTEGER(IntKi) :: NElem = 0_IntKi !< Total number of elements [-] + INTEGER(IntKi) :: NPropB = 0_IntKi !< Total number of property sets for Beams [-] + INTEGER(IntKi) :: NPropC = 0_IntKi !< Total number of property sets for Cable [-] + INTEGER(IntKi) :: NPropR = 0_IntKi !< Total number of property sets for Rigid [-] + INTEGER(IntKi) :: NPropS = 0_IntKi !< Total number of property sets for Spring [-] 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(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PropsS !< Property sets and values for Spring [-] 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 [-] + LOGICAL :: SSSum = .false. !< SubDyn Summary File Flag [-] END TYPE SD_InitType ! ======================= ! ========= SD_ContinuousStateType ======= @@ -172,26 +197,26 @@ MODULE SubDyn_Types ! ======================= ! ========= SD_DiscreteStateType ======= TYPE, PUBLIC :: SD_DiscreteStateType - REAL(ReKi) :: DummyDiscState !< Remove this variable if you have discrete states [-] + REAL(ReKi) :: DummyDiscState = 0.0_ReKi !< 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 [-] + REAL(ReKi) :: DummyConstrState = 0.0_ReKi !< 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 [-] + INTEGER(IntKi) :: n = 0_IntKi !< 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(1:6) :: u_TP = 0.0_ReKi + REAL(ReKi) , DIMENSION(1:6) :: udot_TP = 0.0_ReKi + REAL(ReKi) , DIMENSION(1:6) :: udotdot_TP = 0.0_ReKi REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: F_L !< Loads on internal DOF, size nL [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: F_L2 !< Loads on internal DOF, size nL, used for SIM and ADM4 [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: UR_bar @@ -211,27 +236,34 @@ MODULE SubDyn_Types 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(ReKi) , DIMENSION(:), ALLOCATABLE :: AllOuts !< Data for output file [-] - REAL(DbKi) :: LastOutTime !< The time of the most recent stored output data [s] - INTEGER(IntKi) :: Decimat !< Current output decimation counter [-] + REAL(DbKi) :: LastOutTime = 0.0_R8Ki !< The time of the most recent stored output data [s] + INTEGER(IntKi) :: Decimat = 0_IntKi !< 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 [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: FG !< Gravity force vector (without initial cable force T0) based on the instantaneous platform orientation, not reduced (floating only) [N] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: UL_SIM !< UL for SIM = PhiL qL0- PhiM qm0, size nL [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: UL_0m !< Intermediate UL term for SIM = PhiM qm0, size nL [-] 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 [-] + REAL(ReKi) :: g = 0.0_ReKi !< Gravity acceleration [m/s^2] + REAL(DbKi) :: SDDeltaT = 0.0_R8Ki !< Time step (for integration of continuous states) [seconds] + INTEGER(IntKi) :: IntMethod = 0_IntKi !< Integration Method (1/2/3)Length of y2 array [-] + INTEGER(IntKi) :: nDOF = 0_IntKi !< Total degree of freedom [-] + INTEGER(IntKi) :: nDOF_red = 0_IntKi !< Total degree of freedom after constraint reduction [-] + INTEGER(IntKi) :: Nmembers = 0_IntKi !< 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(R8Ki) , DIMENSION(:), ALLOCATABLE :: FC !< Initial cable force T0, not reduced [N] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: FG !< Gravity force vector, not reduced [N] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: DP0 !< Vector from TP to a Node at t=0, used for Floating Rigid Body motion [m] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: rPG !< Vector from TP to rigid-body CoG in the Guyan (rigid-body) frame, used for Floating Rigid Body Motion [m] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: NodeID2JointID !< Store Joint ID for each NodeID since SubDyn re-label nodes (and add more nodes) [-] - LOGICAL :: reduced !< True if system has been reduced to account for constraints [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: CMassNode !< Node indices for concentrated masses [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: CMassWeight !< Weight of concentrated masses [N] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: CMassOffset !< Concentrated mass CoG offset from attached nodes [m] + LOGICAL :: reduced = .false. !< 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 [-] @@ -239,10 +271,10 @@ MODULE SubDyn_Types 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) [-] + INTEGER(IntKi) :: nDOFM = 0_IntKi !< retained degrees of freedom (modes) [-] + INTEGER(IntKi) :: SttcSolve = 0_IntKi !< Solve dynamics about static equilibrium point (flag) [-] + LOGICAL :: GuyanLoadCorrection = .false. !< Add Extra lever arm contribution to interface reaction outputs [-] + LOGICAL :: Floating = .false. !< 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 [-] @@ -269,25 +301,25 @@ MODULE SubDyn_Types 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) :: nNodes = 0_IntKi !< Total number of nodes [-] + INTEGER(IntKi) :: nNodes_I = 0_IntKi !< Number of Interface nodes [-] + INTEGER(IntKi) :: nNodes_L = 0_IntKi !< Number of Internal nodes [-] + INTEGER(IntKi) :: nNodes_C = 0_IntKi !< 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) :: nDOFI__ = 0_IntKi !< Size of IDI__ [-] + INTEGER(IntKi) :: nDOFI_Rb = 0_IntKi !< Size of IDI_Rb [-] + INTEGER(IntKi) :: nDOFI_F = 0_IntKi !< Size of IDI_F [-] + INTEGER(IntKi) :: nDOFL_L = 0_IntKi !< Size of IDL_L [-] + INTEGER(IntKi) :: nDOFC__ = 0_IntKi !< Size of IDC__ [-] + INTEGER(IntKi) :: nDOFC_Rb = 0_IntKi !< Size of IDC_Rb [-] + INTEGER(IntKi) :: nDOFC_L = 0_IntKi !< Size of IDC_L [-] + INTEGER(IntKi) :: nDOFC_F = 0_IntKi !< Size of IDC_F [-] + INTEGER(IntKi) :: nDOFR__ = 0_IntKi !< Size of IDR__ [-] + INTEGER(IntKi) :: nDOF__Rb = 0_IntKi !< Size of ID__Rb [-] + INTEGER(IntKi) :: nDOF__L = 0_IntKi !< Size of ID__L [-] + INTEGER(IntKi) :: nDOF__F = 0_IntKi !< 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 [-] @@ -300,30 +332,30 @@ MODULE SubDyn_Types 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 [-] + INTEGER(IntKi) :: NMOutputs = 0_IntKi !< Number of members whose output is written [-] + INTEGER(IntKi) :: NumOuts = 0_IntKi !< Number of output channels read from input file [-] + INTEGER(IntKi) :: OutSwtch = 0_IntKi !< Output Requested Channels to local or global output file [1/2/3] [-] + INTEGER(IntKi) :: UnJckF = 0_IntKi !< 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 [-] - INTEGER(IntKi) :: OutCBModes !< Flag to output CB and Guyan modes to a given format [-] - INTEGER(IntKi) :: OutFEMModes !< Flag to output FEM modes to a given format [-] - 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 [-] + TYPE(OutParmType) , DIMENSION(:), ALLOCATABLE :: OutParam !< An array holding names, units, and indices of all of the selected output channels. # logical [-] + LOGICAL :: OutAll = .false. !< Flag to output or not all joint forces [-] + INTEGER(IntKi) :: OutCBModes = 0_IntKi !< Flag to output CB and Guyan modes to a given format [-] + INTEGER(IntKi) :: OutFEMModes = 0_IntKi !< Flag to output FEM modes to a given format [-] + LOGICAL :: OutReact = .false. !< Flag to check whether reactions are requested [-] + INTEGER(IntKi) :: OutAllInt = 0_IntKi !< Integer version of OutAll [-] + INTEGER(IntKi) :: OutAllDims = 0_IntKi !< Integer version of OutAll [-] + INTEGER(IntKi) :: OutDec = 0_IntKi !< 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) [-] + REAL(R8Ki) , DIMENSION(1:2) :: dx = 0.0_R8Ki !< vector that determines size of perturbation for x (continuous states) [-] + INTEGER(IntKi) :: Jac_ny = 0_IntKi !< number of outputs in jacobian matrix [-] + INTEGER(IntKi) :: Jac_nx = 0_IntKi !< half the number of continuous states in jacobian matrix [-] + LOGICAL :: RotStates = .false. !< Orient states in rotating frame during linearization? (flag) [-] END TYPE SD_ParameterType ! ======================= ! ========= SD_InputType ======= @@ -342,12470 +374,3855 @@ MODULE SubDyn_Types 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, DEALLOCATEpointers ) - TYPE(IList), INTENT(INOUT) :: IListData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_DestroyIList' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -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, DEALLOCATEpointers ) - TYPE(MeshAuxDataType), INTENT(INOUT) :: MeshAuxDataTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_DestroyMeshAuxDataType' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -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, DEALLOCATEpointers ) - TYPE(CB_MatArrays), INTENT(INOUT) :: CB_MatArraysData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_DestroyCB_MatArrays' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -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_x = SrcElemPropTypeData%Kappa_x - DstElemPropTypeData%Kappa_y = SrcElemPropTypeData%Kappa_y - DstElemPropTypeData%YoungE = SrcElemPropTypeData%YoungE - DstElemPropTypeData%ShearG = SrcElemPropTypeData%ShearG - DstElemPropTypeData%D = SrcElemPropTypeData%D - 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, DEALLOCATEpointers ) - TYPE(ElemPropType), INTENT(INOUT) :: ElemPropTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_DestroyElemPropType' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - 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_x - Re_BufSz = Re_BufSz + 1 ! Kappa_y - Re_BufSz = Re_BufSz + 1 ! YoungE - Re_BufSz = Re_BufSz + 1 ! ShearG - Re_BufSz = Re_BufSz + SIZE(InData%D) ! D - 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_x - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Kappa_y - 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 - DO i1 = LBOUND(InData%D,1), UBOUND(InData%D,1) - ReKiBuf(Re_Xferred) = InData%D(i1) - Re_Xferred = Re_Xferred + 1 - END DO - 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_x = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Kappa_y = 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 - i1_l = LBOUND(OutData%D,1) - i1_u = UBOUND(OutData%D,1) - DO i1 = LBOUND(OutData%D,1), UBOUND(OutData%D,1) - OutData%D(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - 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, DEALLOCATEpointers ) - TYPE(SD_InitInputType), INTENT(INOUT) :: InitInputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_DestroyInitInput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(InitInputData%SoilStiffness)) THEN - DEALLOCATE(InitInputData%SoilStiffness) -ENDIF - CALL MeshDestroy( InitInputData%SoilMesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - 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 -IF (ALLOCATED(SrcInitOutputData%CableCChanRqst)) THEN - i1_l = LBOUND(SrcInitOutputData%CableCChanRqst,1) - i1_u = UBOUND(SrcInitOutputData%CableCChanRqst,1) - IF (.NOT. ALLOCATED(DstInitOutputData%CableCChanRqst)) THEN - ALLOCATE(DstInitOutputData%CableCChanRqst(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%CableCChanRqst.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%CableCChanRqst = SrcInitOutputData%CableCChanRqst -ENDIF - END SUBROUTINE SD_CopyInitOutput - - SUBROUTINE SD_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(SD_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_DestroyInitOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(InitOutputData%WriteOutputHdr)) THEN - DEALLOCATE(InitOutputData%WriteOutputHdr) -ENDIF -IF (ALLOCATED(InitOutputData%WriteOutputUnt)) THEN - DEALLOCATE(InitOutputData%WriteOutputUnt) -ENDIF - CALL NWTC_Library_Destroyprogdesc( InitOutputData%Ver, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -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 -IF (ALLOCATED(InitOutputData%CableCChanRqst)) THEN - DEALLOCATE(InitOutputData%CableCChanRqst) -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 - Int_BufSz = Int_BufSz + 1 ! CableCChanRqst allocated yes/no - IF ( ALLOCATED(InData%CableCChanRqst) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! CableCChanRqst upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%CableCChanRqst) ! CableCChanRqst - 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 - IF ( .NOT. ALLOCATED(InData%CableCChanRqst) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CableCChanRqst,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CableCChanRqst,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%CableCChanRqst,1), UBOUND(InData%CableCChanRqst,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%CableCChanRqst(i1), IntKiBuf(1)) - 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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CableCChanRqst not allocated - Int_Xferred = Int_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%CableCChanRqst)) DEALLOCATE(OutData%CableCChanRqst) - ALLOCATE(OutData%CableCChanRqst(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CableCChanRqst.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%CableCChanRqst,1), UBOUND(OutData%CableCChanRqst,1) - OutData%CableCChanRqst(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%CableCChanRqst(i1)) - 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, DEALLOCATEpointers ) - TYPE(SD_InitType), INTENT(INOUT) :: InitTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_DestroyInitType' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -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 - Db_BufSz = Db_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) - DbKiBuf(Db_Xferred) = InData%COSMs(i1,i2) - Db_Xferred = Db_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) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_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, DEALLOCATEpointers ) - TYPE(SD_ContinuousStateType), INTENT(INOUT) :: ContStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_DestroyContState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -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, DEALLOCATEpointers ) - TYPE(SD_DiscreteStateType), INTENT(INOUT) :: DiscStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_DestroyDiscState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - 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, DEALLOCATEpointers ) - TYPE(SD_ConstraintStateType), INTENT(INOUT) :: ConstrStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_DestroyConstrState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - 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, DEALLOCATEpointers ) - TYPE(SD_OtherStateType), INTENT(INOUT) :: OtherStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_DestroyOtherState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(OtherStateData%xdot)) THEN -DO i1 = LBOUND(OtherStateData%xdot,1), UBOUND(OtherStateData%xdot,1) - CALL SD_DestroyContState( OtherStateData%xdot(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -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%F_L2)) THEN - i1_l = LBOUND(SrcMiscData%F_L2,1) - i1_u = UBOUND(SrcMiscData%F_L2,1) - IF (.NOT. ALLOCATED(DstMiscData%F_L2)) THEN - ALLOCATE(DstMiscData%F_L2(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_L2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%F_L2 = SrcMiscData%F_L2 -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_NS)) THEN - i1_l = LBOUND(SrcMiscData%UL_NS,1) - i1_u = UBOUND(SrcMiscData%UL_NS,1) - IF (.NOT. ALLOCATED(DstMiscData%UL_NS)) THEN - ALLOCATE(DstMiscData%UL_NS(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%UL_NS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%UL_NS = SrcMiscData%UL_NS -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_NS)) THEN - i1_l = LBOUND(SrcMiscData%U_full_NS,1) - i1_u = UBOUND(SrcMiscData%U_full_NS,1) - IF (.NOT. ALLOCATED(DstMiscData%U_full_NS)) THEN - ALLOCATE(DstMiscData%U_full_NS(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%U_full_NS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%U_full_NS = SrcMiscData%U_full_NS -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%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 -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%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 -IF (ALLOCATED(SrcMiscData%UL_SIM)) THEN - i1_l = LBOUND(SrcMiscData%UL_SIM,1) - i1_u = UBOUND(SrcMiscData%UL_SIM,1) - IF (.NOT. ALLOCATED(DstMiscData%UL_SIM)) THEN - ALLOCATE(DstMiscData%UL_SIM(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%UL_SIM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%UL_SIM = SrcMiscData%UL_SIM -ENDIF -IF (ALLOCATED(SrcMiscData%UL_0m)) THEN - i1_l = LBOUND(SrcMiscData%UL_0m,1) - i1_u = UBOUND(SrcMiscData%UL_0m,1) - IF (.NOT. ALLOCATED(DstMiscData%UL_0m)) THEN - ALLOCATE(DstMiscData%UL_0m(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%UL_0m.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%UL_0m = SrcMiscData%UL_0m -ENDIF - END SUBROUTINE SD_CopyMisc - - SUBROUTINE SD_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(SD_MiscVarType), INTENT(INOUT) :: MiscData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_DestroyMisc' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(MiscData%qmdotdot)) THEN - DEALLOCATE(MiscData%qmdotdot) -ENDIF -IF (ALLOCATED(MiscData%F_L)) THEN - DEALLOCATE(MiscData%F_L) -ENDIF -IF (ALLOCATED(MiscData%F_L2)) THEN - DEALLOCATE(MiscData%F_L2) -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_NS)) THEN - DEALLOCATE(MiscData%UL_NS) -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_NS)) THEN - DEALLOCATE(MiscData%U_full_NS) -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%FC_unit)) THEN - DEALLOCATE(MiscData%FC_unit) -ENDIF -IF (ALLOCATED(MiscData%SDWrOutput)) THEN - DEALLOCATE(MiscData%SDWrOutput) -ENDIF -IF (ALLOCATED(MiscData%AllOuts)) THEN - DEALLOCATE(MiscData%AllOuts) -ENDIF -IF (ALLOCATED(MiscData%Fext)) THEN - DEALLOCATE(MiscData%Fext) -ENDIF -IF (ALLOCATED(MiscData%Fext_red)) THEN - DEALLOCATE(MiscData%Fext_red) -ENDIF -IF (ALLOCATED(MiscData%UL_SIM)) THEN - DEALLOCATE(MiscData%UL_SIM) -ENDIF -IF (ALLOCATED(MiscData%UL_0m)) THEN - DEALLOCATE(MiscData%UL_0m) -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 ! F_L2 allocated yes/no - IF ( ALLOCATED(InData%F_L2) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! F_L2 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_L2) ! F_L2 - 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_NS allocated yes/no - IF ( ALLOCATED(InData%UL_NS) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! UL_NS upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%UL_NS) ! UL_NS - 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_NS allocated yes/no - IF ( ALLOCATED(InData%U_full_NS) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! U_full_NS upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%U_full_NS) ! U_full_NS - 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 ! 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 - 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 ! 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 - Int_BufSz = Int_BufSz + 1 ! UL_SIM allocated yes/no - IF ( ALLOCATED(InData%UL_SIM) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! UL_SIM upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%UL_SIM) ! UL_SIM - END IF - Int_BufSz = Int_BufSz + 1 ! UL_0m allocated yes/no - IF ( ALLOCATED(InData%UL_0m) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! UL_0m upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%UL_0m) ! UL_0m - 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%F_L2) ) THEN - 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_L2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_L2,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%F_L2,1), UBOUND(InData%F_L2,1) - ReKiBuf(Re_Xferred) = InData%F_L2(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_NS) ) THEN - 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_NS,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UL_NS,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%UL_NS,1), UBOUND(InData%UL_NS,1) - ReKiBuf(Re_Xferred) = InData%UL_NS(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_NS) ) THEN - 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_NS,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%U_full_NS,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%U_full_NS,1), UBOUND(InData%U_full_NS,1) - ReKiBuf(Re_Xferred) = InData%U_full_NS(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%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 - 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%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 - IF ( .NOT. ALLOCATED(InData%UL_SIM) ) THEN - 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_SIM,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UL_SIM,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%UL_SIM,1), UBOUND(InData%UL_SIM,1) - ReKiBuf(Re_Xferred) = InData%UL_SIM(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%UL_0m) ) THEN - 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_0m,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UL_0m,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%UL_0m,1), UBOUND(InData%UL_0m,1) - ReKiBuf(Re_Xferred) = InData%UL_0m(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 ! F_L2 not allocated - Int_Xferred = Int_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_L2)) DEALLOCATE(OutData%F_L2) - ALLOCATE(OutData%F_L2(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_L2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%F_L2,1), UBOUND(OutData%F_L2,1) - OutData%F_L2(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_NS not allocated - Int_Xferred = Int_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_NS)) DEALLOCATE(OutData%UL_NS) - ALLOCATE(OutData%UL_NS(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%UL_NS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%UL_NS,1), UBOUND(OutData%UL_NS,1) - OutData%UL_NS(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_NS not allocated - Int_Xferred = Int_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_NS)) DEALLOCATE(OutData%U_full_NS) - ALLOCATE(OutData%U_full_NS(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%U_full_NS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%U_full_NS,1), UBOUND(OutData%U_full_NS,1) - OutData%U_full_NS(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 ! 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 - 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%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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! UL_SIM not allocated - Int_Xferred = Int_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_SIM)) DEALLOCATE(OutData%UL_SIM) - ALLOCATE(OutData%UL_SIM(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%UL_SIM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%UL_SIM,1), UBOUND(OutData%UL_SIM,1) - OutData%UL_SIM(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! UL_0m not allocated - Int_Xferred = Int_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_0m)) DEALLOCATE(OutData%UL_0m) - ALLOCATE(OutData%UL_0m(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%UL_0m.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%UL_0m,1), UBOUND(OutData%UL_0m,1) - OutData%UL_0m(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 -IF (ALLOCATED(SrcParamData%NodeID2JointID)) THEN - i1_l = LBOUND(SrcParamData%NodeID2JointID,1) - i1_u = UBOUND(SrcParamData%NodeID2JointID,1) - IF (.NOT. ALLOCATED(DstParamData%NodeID2JointID)) THEN - ALLOCATE(DstParamData%NodeID2JointID(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%NodeID2JointID.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%NodeID2JointID = SrcParamData%NodeID2JointID -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%OutCBModes = SrcParamData%OutCBModes - DstParamData%OutFEMModes = SrcParamData%OutFEMModes - 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, DEALLOCATEpointers ) - TYPE(SD_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -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), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -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%NodeID2JointID)) THEN - DEALLOCATE(ParamData%NodeID2JointID) -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), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -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), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -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), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -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), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -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), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -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), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -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 ! NodeID2JointID allocated yes/no - IF ( ALLOCATED(InData%NodeID2JointID) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! NodeID2JointID upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%NodeID2JointID) ! NodeID2JointID - 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 ! OutCBModes - Int_BufSz = Int_BufSz + 1 ! OutFEMModes - 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 - IF ( .NOT. ALLOCATED(InData%NodeID2JointID) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%NodeID2JointID,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NodeID2JointID,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%NodeID2JointID,1), UBOUND(InData%NodeID2JointID,1) - IntKiBuf(Int_Xferred) = InData%NodeID2JointID(i1) - Int_Xferred = Int_Xferred + 1 - 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) = InData%OutCBModes - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%OutFEMModes - 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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NodeID2JointID not allocated - Int_Xferred = Int_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%NodeID2JointID)) DEALLOCATE(OutData%NodeID2JointID) - ALLOCATE(OutData%NodeID2JointID(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NodeID2JointID.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%NodeID2JointID,1), UBOUND(OutData%NodeID2JointID,1) - OutData%NodeID2JointID(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - 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%OutCBModes = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%OutFEMModes = IntKiBuf(Int_Xferred) - 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' -! +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 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'SD_CopyIList' 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, DEALLOCATEpointers ) - TYPE(SD_InputType), INTENT(INOUT) :: InputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_DestroyInput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL MeshDestroy( InputData%TPMesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( InputData%LMesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -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' -! + ErrMsg = '' + if (allocated(SrcIListData%List)) then + LB(1:1) = lbound(SrcIListData%List) + UB(1:1) = ubound(SrcIListData%List) + if (.not. allocated(DstIListData%List)) then + allocate(DstIListData%List(LB(1):UB(1)), 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 + end if +end subroutine + +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' 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 - CALL MeshCopy( SrcOutputData%Y3Mesh, DstOutputData%Y3Mesh, 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, DEALLOCATEpointers ) - TYPE(SD_OutputType), INTENT(INOUT) :: OutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_DestroyOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL MeshDestroy( OutputData%Y1Mesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( OutputData%Y2Mesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( OutputData%Y3Mesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -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 + 3 ! Y3Mesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%Y3Mesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! Y3Mesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Y3Mesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Y3Mesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Y3Mesh - 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 - CALL MeshPack( InData%Y3Mesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! Y3Mesh - 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) - 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%Y3Mesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! Y3Mesh - 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 + ErrMsg = '' + if (allocated(IListData%List)) then + deallocate(IListData%List) + end if +end subroutine + +subroutine SD_PackIList(RF, Indata) + type(RegFile), intent(inout) :: RF + type(IList), intent(in) :: InData + character(*), parameter :: RoutineName = 'SD_PackIList' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%List) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SD_UnPackIList(RF, OutData) + type(RegFile), intent(inout) :: RF + type(IList), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SD_UnPackIList' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%List); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +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 + integer(B4Ki) :: LB(4), UB(4) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'SD_CopyMeshAuxDataType' + ErrStat = ErrID_None + ErrMsg = '' + DstMeshAuxDataTypeData%MemberID = SrcMeshAuxDataTypeData%MemberID + DstMeshAuxDataTypeData%NOutCnt = SrcMeshAuxDataTypeData%NOutCnt + if (allocated(SrcMeshAuxDataTypeData%NodeCnt)) then + LB(1:1) = lbound(SrcMeshAuxDataTypeData%NodeCnt) + UB(1:1) = ubound(SrcMeshAuxDataTypeData%NodeCnt) + if (.not. allocated(DstMeshAuxDataTypeData%NodeCnt)) then + allocate(DstMeshAuxDataTypeData%NodeCnt(LB(1):UB(1)), 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 + end if + if (allocated(SrcMeshAuxDataTypeData%NodeIDs)) then + LB(1:1) = lbound(SrcMeshAuxDataTypeData%NodeIDs) + UB(1:1) = ubound(SrcMeshAuxDataTypeData%NodeIDs) + if (.not. allocated(DstMeshAuxDataTypeData%NodeIDs)) then + allocate(DstMeshAuxDataTypeData%NodeIDs(LB(1):UB(1)), 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 + end if + if (allocated(SrcMeshAuxDataTypeData%ElmIDs)) then + LB(1:2) = lbound(SrcMeshAuxDataTypeData%ElmIDs) + UB(1:2) = ubound(SrcMeshAuxDataTypeData%ElmIDs) + if (.not. allocated(DstMeshAuxDataTypeData%ElmIDs)) then + allocate(DstMeshAuxDataTypeData%ElmIDs(LB(1):UB(1),LB(2):UB(2)), 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 + end if + if (allocated(SrcMeshAuxDataTypeData%ElmNds)) then + LB(1:2) = lbound(SrcMeshAuxDataTypeData%ElmNds) + UB(1:2) = ubound(SrcMeshAuxDataTypeData%ElmNds) + if (.not. allocated(DstMeshAuxDataTypeData%ElmNds)) then + allocate(DstMeshAuxDataTypeData%ElmNds(LB(1):UB(1),LB(2):UB(2)), 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 + end if + if (allocated(SrcMeshAuxDataTypeData%Me)) then + LB(1:4) = lbound(SrcMeshAuxDataTypeData%Me) + UB(1:4) = ubound(SrcMeshAuxDataTypeData%Me) + if (.not. allocated(DstMeshAuxDataTypeData%Me)) then + allocate(DstMeshAuxDataTypeData%Me(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMeshAuxDataTypeData%Me.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMeshAuxDataTypeData%Me = SrcMeshAuxDataTypeData%Me + end if + if (allocated(SrcMeshAuxDataTypeData%Ke)) then + LB(1:4) = lbound(SrcMeshAuxDataTypeData%Ke) + UB(1:4) = ubound(SrcMeshAuxDataTypeData%Ke) + if (.not. allocated(DstMeshAuxDataTypeData%Ke)) then + allocate(DstMeshAuxDataTypeData%Ke(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMeshAuxDataTypeData%Ke.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMeshAuxDataTypeData%Ke = SrcMeshAuxDataTypeData%Ke + end if + if (allocated(SrcMeshAuxDataTypeData%Fg)) then + LB(1:3) = lbound(SrcMeshAuxDataTypeData%Fg) + UB(1:3) = ubound(SrcMeshAuxDataTypeData%Fg) + if (.not. allocated(DstMeshAuxDataTypeData%Fg)) then + allocate(DstMeshAuxDataTypeData%Fg(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), 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 + end if +end subroutine + +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' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(MeshAuxDataTypeData%NodeCnt)) then + deallocate(MeshAuxDataTypeData%NodeCnt) + end if + if (allocated(MeshAuxDataTypeData%NodeIDs)) then + deallocate(MeshAuxDataTypeData%NodeIDs) + end if + if (allocated(MeshAuxDataTypeData%ElmIDs)) then + deallocate(MeshAuxDataTypeData%ElmIDs) + end if + if (allocated(MeshAuxDataTypeData%ElmNds)) then + deallocate(MeshAuxDataTypeData%ElmNds) + end if + if (allocated(MeshAuxDataTypeData%Me)) then + deallocate(MeshAuxDataTypeData%Me) + end if + if (allocated(MeshAuxDataTypeData%Ke)) then + deallocate(MeshAuxDataTypeData%Ke) + end if + if (allocated(MeshAuxDataTypeData%Fg)) then + deallocate(MeshAuxDataTypeData%Fg) + end if +end subroutine + +subroutine SD_PackMeshAuxDataType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(MeshAuxDataType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SD_PackMeshAuxDataType' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%MemberID) + call RegPack(RF, InData%NOutCnt) + call RegPackAlloc(RF, InData%NodeCnt) + call RegPackAlloc(RF, InData%NodeIDs) + call RegPackAlloc(RF, InData%ElmIDs) + call RegPackAlloc(RF, InData%ElmNds) + call RegPackAlloc(RF, InData%Me) + call RegPackAlloc(RF, InData%Ke) + call RegPackAlloc(RF, InData%Fg) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SD_UnPackMeshAuxDataType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(MeshAuxDataType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SD_UnPackMeshAuxDataType' + integer(B4Ki) :: LB(4), UB(4) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%MemberID); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NOutCnt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%NodeCnt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%NodeIDs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ElmIDs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ElmNds); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Me); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Ke); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Fg); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +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 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'SD_CopyCB_MatArrays' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcCB_MatArraysData%MBB)) then + LB(1:2) = lbound(SrcCB_MatArraysData%MBB) + UB(1:2) = ubound(SrcCB_MatArraysData%MBB) + if (.not. allocated(DstCB_MatArraysData%MBB)) then + allocate(DstCB_MatArraysData%MBB(LB(1):UB(1),LB(2):UB(2)), 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 + end if + if (allocated(SrcCB_MatArraysData%MBM)) then + LB(1:2) = lbound(SrcCB_MatArraysData%MBM) + UB(1:2) = ubound(SrcCB_MatArraysData%MBM) + if (.not. allocated(DstCB_MatArraysData%MBM)) then + allocate(DstCB_MatArraysData%MBM(LB(1):UB(1),LB(2):UB(2)), 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 + end if + if (allocated(SrcCB_MatArraysData%KBB)) then + LB(1:2) = lbound(SrcCB_MatArraysData%KBB) + UB(1:2) = ubound(SrcCB_MatArraysData%KBB) + if (.not. allocated(DstCB_MatArraysData%KBB)) then + allocate(DstCB_MatArraysData%KBB(LB(1):UB(1),LB(2):UB(2)), 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 + end if + if (allocated(SrcCB_MatArraysData%PhiL)) then + LB(1:2) = lbound(SrcCB_MatArraysData%PhiL) + UB(1:2) = ubound(SrcCB_MatArraysData%PhiL) + if (.not. allocated(DstCB_MatArraysData%PhiL)) then + allocate(DstCB_MatArraysData%PhiL(LB(1):UB(1),LB(2):UB(2)), 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 + end if + if (allocated(SrcCB_MatArraysData%PhiR)) then + LB(1:2) = lbound(SrcCB_MatArraysData%PhiR) + UB(1:2) = ubound(SrcCB_MatArraysData%PhiR) + if (.not. allocated(DstCB_MatArraysData%PhiR)) then + allocate(DstCB_MatArraysData%PhiR(LB(1):UB(1),LB(2):UB(2)), 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 + end if + if (allocated(SrcCB_MatArraysData%OmegaL)) then + LB(1:1) = lbound(SrcCB_MatArraysData%OmegaL) + UB(1:1) = ubound(SrcCB_MatArraysData%OmegaL) + if (.not. allocated(DstCB_MatArraysData%OmegaL)) then + allocate(DstCB_MatArraysData%OmegaL(LB(1):UB(1)), 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 + end if +end subroutine + +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' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(CB_MatArraysData%MBB)) then + deallocate(CB_MatArraysData%MBB) + end if + if (allocated(CB_MatArraysData%MBM)) then + deallocate(CB_MatArraysData%MBM) + end if + if (allocated(CB_MatArraysData%KBB)) then + deallocate(CB_MatArraysData%KBB) + end if + if (allocated(CB_MatArraysData%PhiL)) then + deallocate(CB_MatArraysData%PhiL) + end if + if (allocated(CB_MatArraysData%PhiR)) then + deallocate(CB_MatArraysData%PhiR) + end if + if (allocated(CB_MatArraysData%OmegaL)) then + deallocate(CB_MatArraysData%OmegaL) + end if +end subroutine + +subroutine SD_PackCB_MatArrays(RF, Indata) + type(RegFile), intent(inout) :: RF + type(CB_MatArrays), intent(in) :: InData + character(*), parameter :: RoutineName = 'SD_PackCB_MatArrays' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%MBB) + call RegPackAlloc(RF, InData%MBM) + call RegPackAlloc(RF, InData%KBB) + call RegPackAlloc(RF, InData%PhiL) + call RegPackAlloc(RF, InData%PhiR) + call RegPackAlloc(RF, InData%OmegaL) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SD_UnPackCB_MatArrays(RF, OutData) + type(RegFile), intent(inout) :: RF + type(CB_MatArrays), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SD_UnPackCB_MatArrays' + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%MBB); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%MBM); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%KBB); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PhiL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PhiR); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%OmegaL); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +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 + 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_x = SrcElemPropTypeData%Kappa_x + DstElemPropTypeData%Kappa_y = SrcElemPropTypeData%Kappa_y + DstElemPropTypeData%YoungE = SrcElemPropTypeData%YoungE + DstElemPropTypeData%ShearG = SrcElemPropTypeData%ShearG + DstElemPropTypeData%D = SrcElemPropTypeData%D + DstElemPropTypeData%Area = SrcElemPropTypeData%Area + DstElemPropTypeData%Rho = SrcElemPropTypeData%Rho + DstElemPropTypeData%T0 = SrcElemPropTypeData%T0 + DstElemPropTypeData%k11 = SrcElemPropTypeData%k11 + DstElemPropTypeData%k12 = SrcElemPropTypeData%k12 + DstElemPropTypeData%k13 = SrcElemPropTypeData%k13 + DstElemPropTypeData%k14 = SrcElemPropTypeData%k14 + DstElemPropTypeData%k15 = SrcElemPropTypeData%k15 + DstElemPropTypeData%k16 = SrcElemPropTypeData%k16 + DstElemPropTypeData%k22 = SrcElemPropTypeData%k22 + DstElemPropTypeData%k23 = SrcElemPropTypeData%k23 + DstElemPropTypeData%k24 = SrcElemPropTypeData%k24 + DstElemPropTypeData%k25 = SrcElemPropTypeData%k25 + DstElemPropTypeData%k26 = SrcElemPropTypeData%k26 + DstElemPropTypeData%k33 = SrcElemPropTypeData%k33 + DstElemPropTypeData%k34 = SrcElemPropTypeData%k34 + DstElemPropTypeData%k35 = SrcElemPropTypeData%k35 + DstElemPropTypeData%k36 = SrcElemPropTypeData%k36 + DstElemPropTypeData%k44 = SrcElemPropTypeData%k44 + DstElemPropTypeData%k45 = SrcElemPropTypeData%k45 + DstElemPropTypeData%k46 = SrcElemPropTypeData%k46 + DstElemPropTypeData%k55 = SrcElemPropTypeData%k55 + DstElemPropTypeData%k56 = SrcElemPropTypeData%k56 + DstElemPropTypeData%k66 = SrcElemPropTypeData%k66 + DstElemPropTypeData%DirCos = SrcElemPropTypeData%DirCos +end subroutine + +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' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine SD_PackElemPropType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(ElemPropType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SD_PackElemPropType' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%eType) + call RegPack(RF, InData%Length) + call RegPack(RF, InData%Ixx) + call RegPack(RF, InData%Iyy) + call RegPack(RF, InData%Jzz) + call RegPack(RF, InData%Shear) + call RegPack(RF, InData%Kappa_x) + call RegPack(RF, InData%Kappa_y) + call RegPack(RF, InData%YoungE) + call RegPack(RF, InData%ShearG) + call RegPack(RF, InData%D) + call RegPack(RF, InData%Area) + call RegPack(RF, InData%Rho) + call RegPack(RF, InData%T0) + call RegPack(RF, InData%k11) + call RegPack(RF, InData%k12) + call RegPack(RF, InData%k13) + call RegPack(RF, InData%k14) + call RegPack(RF, InData%k15) + call RegPack(RF, InData%k16) + call RegPack(RF, InData%k22) + call RegPack(RF, InData%k23) + call RegPack(RF, InData%k24) + call RegPack(RF, InData%k25) + call RegPack(RF, InData%k26) + call RegPack(RF, InData%k33) + call RegPack(RF, InData%k34) + call RegPack(RF, InData%k35) + call RegPack(RF, InData%k36) + call RegPack(RF, InData%k44) + call RegPack(RF, InData%k45) + call RegPack(RF, InData%k46) + call RegPack(RF, InData%k55) + call RegPack(RF, InData%k56) + call RegPack(RF, InData%k66) + call RegPack(RF, InData%DirCos) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SD_UnPackElemPropType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(ElemPropType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SD_UnPackElemPropType' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%eType); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Length); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Ixx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Iyy); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Jzz); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Shear); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Kappa_x); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Kappa_y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YoungE); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ShearG); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%D); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Area); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Rho); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%T0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%k11); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%k12); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%k13); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%k14); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%k15); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%k16); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%k22); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%k23); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%k24); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%k25); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%k26); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%k33); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%k34); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%k35); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%k36); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%k44); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%k45); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%k46); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%k55); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%k56); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%k66); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DirCos); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +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 + integer(B4Ki) :: LB(3), UB(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 + LB(1:3) = lbound(SrcInitInputData%SoilStiffness) + UB(1:3) = ubound(SrcInitInputData%SoilStiffness) + if (.not. allocated(DstInitInputData%SoilStiffness)) then + allocate(DstInitInputData%SoilStiffness(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), 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 + end if + 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 + +subroutine SD_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(SD_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SD_DestroyInitInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InitInputData%SoilStiffness)) then + deallocate(InitInputData%SoilStiffness) + end if + call MeshDestroy( InitInputData%SoilMesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine SD_PackInitInput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SD_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SD_PackInitInput' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%SDInputFile) + call RegPack(RF, InData%RootName) + call RegPack(RF, InData%g) + call RegPack(RF, InData%WtrDpth) + call RegPack(RF, InData%TP_RefPoint) + call RegPack(RF, InData%SubRotateZ) + call RegPackAlloc(RF, InData%SoilStiffness) + call MeshPack(RF, InData%SoilMesh) + call RegPack(RF, InData%Linearize) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SD_UnPackInitInput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SD_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SD_UnPackInitInput' + integer(B4Ki) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%SDInputFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RootName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%g); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WtrDpth); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TP_RefPoint); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SubRotateZ); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%SoilStiffness); if (RegCheckErr(RF, RoutineName)) return + call MeshUnpack(RF, OutData%SoilMesh) ! SoilMesh + call RegUnpack(RF, OutData%Linearize); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +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 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SD_CopyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcInitOutputData%WriteOutputHdr)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) + if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then + allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitOutputData%WriteOutputUnt)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) + if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then + allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), 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 + end if + 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 + LB(1:1) = lbound(SrcInitOutputData%LinNames_y) + UB(1:1) = ubound(SrcInitOutputData%LinNames_y) + if (.not. allocated(DstInitOutputData%LinNames_y)) then + allocate(DstInitOutputData%LinNames_y(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitOutputData%LinNames_x)) then + LB(1:1) = lbound(SrcInitOutputData%LinNames_x) + UB(1:1) = ubound(SrcInitOutputData%LinNames_x) + if (.not. allocated(DstInitOutputData%LinNames_x)) then + allocate(DstInitOutputData%LinNames_x(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitOutputData%LinNames_u)) then + LB(1:1) = lbound(SrcInitOutputData%LinNames_u) + UB(1:1) = ubound(SrcInitOutputData%LinNames_u) + if (.not. allocated(DstInitOutputData%LinNames_u)) then + allocate(DstInitOutputData%LinNames_u(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitOutputData%RotFrame_y)) then + LB(1:1) = lbound(SrcInitOutputData%RotFrame_y) + UB(1:1) = ubound(SrcInitOutputData%RotFrame_y) + if (.not. allocated(DstInitOutputData%RotFrame_y)) then + allocate(DstInitOutputData%RotFrame_y(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitOutputData%RotFrame_x)) then + LB(1:1) = lbound(SrcInitOutputData%RotFrame_x) + UB(1:1) = ubound(SrcInitOutputData%RotFrame_x) + if (.not. allocated(DstInitOutputData%RotFrame_x)) then + allocate(DstInitOutputData%RotFrame_x(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitOutputData%RotFrame_u)) then + LB(1:1) = lbound(SrcInitOutputData%RotFrame_u) + UB(1:1) = ubound(SrcInitOutputData%RotFrame_u) + if (.not. allocated(DstInitOutputData%RotFrame_u)) then + allocate(DstInitOutputData%RotFrame_u(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitOutputData%IsLoad_u)) then + LB(1:1) = lbound(SrcInitOutputData%IsLoad_u) + UB(1:1) = ubound(SrcInitOutputData%IsLoad_u) + if (.not. allocated(DstInitOutputData%IsLoad_u)) then + allocate(DstInitOutputData%IsLoad_u(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitOutputData%DerivOrder_x)) then + LB(1:1) = lbound(SrcInitOutputData%DerivOrder_x) + UB(1:1) = ubound(SrcInitOutputData%DerivOrder_x) + if (.not. allocated(DstInitOutputData%DerivOrder_x)) then + allocate(DstInitOutputData%DerivOrder_x(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitOutputData%CableCChanRqst)) then + LB(1:1) = lbound(SrcInitOutputData%CableCChanRqst) + UB(1:1) = ubound(SrcInitOutputData%CableCChanRqst) + if (.not. allocated(DstInitOutputData%CableCChanRqst)) then + allocate(DstInitOutputData%CableCChanRqst(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%CableCChanRqst.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%CableCChanRqst = SrcInitOutputData%CableCChanRqst + end if +end subroutine + +subroutine SD_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(SD_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SD_DestroyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InitOutputData%WriteOutputHdr)) then + deallocate(InitOutputData%WriteOutputHdr) + end if + if (allocated(InitOutputData%WriteOutputUnt)) then + deallocate(InitOutputData%WriteOutputUnt) + end if + call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(InitOutputData%LinNames_y)) then + deallocate(InitOutputData%LinNames_y) + end if + if (allocated(InitOutputData%LinNames_x)) then + deallocate(InitOutputData%LinNames_x) + end if + if (allocated(InitOutputData%LinNames_u)) then + deallocate(InitOutputData%LinNames_u) + end if + if (allocated(InitOutputData%RotFrame_y)) then + deallocate(InitOutputData%RotFrame_y) + end if + if (allocated(InitOutputData%RotFrame_x)) then + deallocate(InitOutputData%RotFrame_x) + end if + if (allocated(InitOutputData%RotFrame_u)) then + deallocate(InitOutputData%RotFrame_u) + end if + if (allocated(InitOutputData%IsLoad_u)) then + deallocate(InitOutputData%IsLoad_u) + end if + if (allocated(InitOutputData%DerivOrder_x)) then + deallocate(InitOutputData%DerivOrder_x) + end if + if (allocated(InitOutputData%CableCChanRqst)) then + deallocate(InitOutputData%CableCChanRqst) + end if +end subroutine + +subroutine SD_PackInitOutput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SD_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SD_PackInitOutput' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%WriteOutputHdr) + call RegPackAlloc(RF, InData%WriteOutputUnt) + call NWTC_Library_PackProgDesc(RF, InData%Ver) + call RegPackAlloc(RF, InData%LinNames_y) + call RegPackAlloc(RF, InData%LinNames_x) + call RegPackAlloc(RF, InData%LinNames_u) + call RegPackAlloc(RF, InData%RotFrame_y) + call RegPackAlloc(RF, InData%RotFrame_x) + call RegPackAlloc(RF, InData%RotFrame_u) + call RegPackAlloc(RF, InData%IsLoad_u) + call RegPackAlloc(RF, InData%DerivOrder_x) + call RegPackAlloc(RF, InData%CableCChanRqst) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SD_UnPackInitOutput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SD_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SD_UnPackInitOutput' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%WriteOutputHdr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WriteOutputUnt); if (RegCheckErr(RF, RoutineName)) return + call NWTC_Library_UnpackProgDesc(RF, OutData%Ver) ! Ver + call RegUnpackAlloc(RF, OutData%LinNames_y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LinNames_x); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LinNames_u); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%RotFrame_y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%RotFrame_x); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%RotFrame_u); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%IsLoad_u); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%DerivOrder_x); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%CableCChanRqst); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +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 + integer(B4Ki) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + 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%NPropSetsS = SrcInitTypeData%NPropSetsS + 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 + LB(1:2) = lbound(SrcInitTypeData%Joints) + UB(1:2) = ubound(SrcInitTypeData%Joints) + if (.not. allocated(DstInitTypeData%Joints)) then + allocate(DstInitTypeData%Joints(LB(1):UB(1),LB(2):UB(2)), 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 + end if + if (allocated(SrcInitTypeData%PropSetsB)) then + LB(1:2) = lbound(SrcInitTypeData%PropSetsB) + UB(1:2) = ubound(SrcInitTypeData%PropSetsB) + if (.not. allocated(DstInitTypeData%PropSetsB)) then + allocate(DstInitTypeData%PropSetsB(LB(1):UB(1),LB(2):UB(2)), 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 + end if + if (allocated(SrcInitTypeData%PropSetsC)) then + LB(1:2) = lbound(SrcInitTypeData%PropSetsC) + UB(1:2) = ubound(SrcInitTypeData%PropSetsC) + if (.not. allocated(DstInitTypeData%PropSetsC)) then + allocate(DstInitTypeData%PropSetsC(LB(1):UB(1),LB(2):UB(2)), 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 + end if + if (allocated(SrcInitTypeData%PropSetsR)) then + LB(1:2) = lbound(SrcInitTypeData%PropSetsR) + UB(1:2) = ubound(SrcInitTypeData%PropSetsR) + if (.not. allocated(DstInitTypeData%PropSetsR)) then + allocate(DstInitTypeData%PropSetsR(LB(1):UB(1),LB(2):UB(2)), 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 + end if + if (allocated(SrcInitTypeData%PropSetsS)) then + LB(1:2) = lbound(SrcInitTypeData%PropSetsS) + UB(1:2) = ubound(SrcInitTypeData%PropSetsS) + if (.not. allocated(DstInitTypeData%PropSetsS)) then + allocate(DstInitTypeData%PropSetsS(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%PropSetsS.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitTypeData%PropSetsS = SrcInitTypeData%PropSetsS + end if + if (allocated(SrcInitTypeData%PropSetsX)) then + LB(1:2) = lbound(SrcInitTypeData%PropSetsX) + UB(1:2) = ubound(SrcInitTypeData%PropSetsX) + if (.not. allocated(DstInitTypeData%PropSetsX)) then + allocate(DstInitTypeData%PropSetsX(LB(1):UB(1),LB(2):UB(2)), 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 + end if + if (allocated(SrcInitTypeData%COSMs)) then + LB(1:2) = lbound(SrcInitTypeData%COSMs) + UB(1:2) = ubound(SrcInitTypeData%COSMs) + if (.not. allocated(DstInitTypeData%COSMs)) then + allocate(DstInitTypeData%COSMs(LB(1):UB(1),LB(2):UB(2)), 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 + end if + if (allocated(SrcInitTypeData%CMass)) then + LB(1:2) = lbound(SrcInitTypeData%CMass) + UB(1:2) = ubound(SrcInitTypeData%CMass) + if (.not. allocated(DstInitTypeData%CMass)) then + allocate(DstInitTypeData%CMass(LB(1):UB(1),LB(2):UB(2)), 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 + end if + if (allocated(SrcInitTypeData%JDampings)) then + LB(1:1) = lbound(SrcInitTypeData%JDampings) + UB(1:1) = ubound(SrcInitTypeData%JDampings) + if (.not. allocated(DstInitTypeData%JDampings)) then + allocate(DstInitTypeData%JDampings(LB(1):UB(1)), 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 + end if + DstInitTypeData%GuyanDampMod = SrcInitTypeData%GuyanDampMod + DstInitTypeData%RayleighDamp = SrcInitTypeData%RayleighDamp + DstInitTypeData%GuyanDampMat = SrcInitTypeData%GuyanDampMat + if (allocated(SrcInitTypeData%Members)) then + LB(1:2) = lbound(SrcInitTypeData%Members) + UB(1:2) = ubound(SrcInitTypeData%Members) + if (.not. allocated(DstInitTypeData%Members)) then + allocate(DstInitTypeData%Members(LB(1):UB(1),LB(2):UB(2)), 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 + end if + if (allocated(SrcInitTypeData%SSOutList)) then + LB(1:1) = lbound(SrcInitTypeData%SSOutList) + UB(1:1) = ubound(SrcInitTypeData%SSOutList) + if (.not. allocated(DstInitTypeData%SSOutList)) then + allocate(DstInitTypeData%SSOutList(LB(1):UB(1)), 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 + end if + DstInitTypeData%OutCOSM = SrcInitTypeData%OutCOSM + DstInitTypeData%TabDelim = SrcInitTypeData%TabDelim + if (allocated(SrcInitTypeData%SSIK)) then + LB(1:2) = lbound(SrcInitTypeData%SSIK) + UB(1:2) = ubound(SrcInitTypeData%SSIK) + if (.not. allocated(DstInitTypeData%SSIK)) then + allocate(DstInitTypeData%SSIK(LB(1):UB(1),LB(2):UB(2)), 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 + end if + if (allocated(SrcInitTypeData%SSIM)) then + LB(1:2) = lbound(SrcInitTypeData%SSIM) + UB(1:2) = ubound(SrcInitTypeData%SSIM) + if (.not. allocated(DstInitTypeData%SSIM)) then + allocate(DstInitTypeData%SSIM(LB(1):UB(1),LB(2):UB(2)), 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 + end if + if (allocated(SrcInitTypeData%SSIfile)) then + LB(1:1) = lbound(SrcInitTypeData%SSIfile) + UB(1:1) = ubound(SrcInitTypeData%SSIfile) + if (.not. allocated(DstInitTypeData%SSIfile)) then + allocate(DstInitTypeData%SSIfile(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitTypeData%Soil_K)) then + LB(1:3) = lbound(SrcInitTypeData%Soil_K) + UB(1:3) = ubound(SrcInitTypeData%Soil_K) + if (.not. allocated(DstInitTypeData%Soil_K)) then + allocate(DstInitTypeData%Soil_K(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), 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 + end if + if (allocated(SrcInitTypeData%Soil_Points)) then + LB(1:2) = lbound(SrcInitTypeData%Soil_Points) + UB(1:2) = ubound(SrcInitTypeData%Soil_Points) + if (.not. allocated(DstInitTypeData%Soil_Points)) then + allocate(DstInitTypeData%Soil_Points(LB(1):UB(1),LB(2):UB(2)), 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 + end if + if (allocated(SrcInitTypeData%Soil_Nodes)) then + LB(1:1) = lbound(SrcInitTypeData%Soil_Nodes) + UB(1:1) = ubound(SrcInitTypeData%Soil_Nodes) + if (.not. allocated(DstInitTypeData%Soil_Nodes)) then + allocate(DstInitTypeData%Soil_Nodes(LB(1):UB(1)), 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 + end if + DstInitTypeData%NElem = SrcInitTypeData%NElem + DstInitTypeData%NPropB = SrcInitTypeData%NPropB + DstInitTypeData%NPropC = SrcInitTypeData%NPropC + DstInitTypeData%NPropR = SrcInitTypeData%NPropR + DstInitTypeData%NPropS = SrcInitTypeData%NPropS + if (allocated(SrcInitTypeData%Nodes)) then + LB(1:2) = lbound(SrcInitTypeData%Nodes) + UB(1:2) = ubound(SrcInitTypeData%Nodes) + if (.not. allocated(DstInitTypeData%Nodes)) then + allocate(DstInitTypeData%Nodes(LB(1):UB(1),LB(2):UB(2)), 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 + end if + if (allocated(SrcInitTypeData%PropsB)) then + LB(1:2) = lbound(SrcInitTypeData%PropsB) + UB(1:2) = ubound(SrcInitTypeData%PropsB) + if (.not. allocated(DstInitTypeData%PropsB)) then + allocate(DstInitTypeData%PropsB(LB(1):UB(1),LB(2):UB(2)), 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 + end if + if (allocated(SrcInitTypeData%PropsC)) then + LB(1:2) = lbound(SrcInitTypeData%PropsC) + UB(1:2) = ubound(SrcInitTypeData%PropsC) + if (.not. allocated(DstInitTypeData%PropsC)) then + allocate(DstInitTypeData%PropsC(LB(1):UB(1),LB(2):UB(2)), 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 + end if + if (allocated(SrcInitTypeData%PropsR)) then + LB(1:2) = lbound(SrcInitTypeData%PropsR) + UB(1:2) = ubound(SrcInitTypeData%PropsR) + if (.not. allocated(DstInitTypeData%PropsR)) then + allocate(DstInitTypeData%PropsR(LB(1):UB(1),LB(2):UB(2)), 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 + end if + if (allocated(SrcInitTypeData%PropsS)) then + LB(1:2) = lbound(SrcInitTypeData%PropsS) + UB(1:2) = ubound(SrcInitTypeData%PropsS) + if (.not. allocated(DstInitTypeData%PropsS)) then + allocate(DstInitTypeData%PropsS(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%PropsS.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitTypeData%PropsS = SrcInitTypeData%PropsS + end if + if (allocated(SrcInitTypeData%K)) then + LB(1:2) = lbound(SrcInitTypeData%K) + UB(1:2) = ubound(SrcInitTypeData%K) + if (.not. allocated(DstInitTypeData%K)) then + allocate(DstInitTypeData%K(LB(1):UB(1),LB(2):UB(2)), 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 + end if + if (allocated(SrcInitTypeData%M)) then + LB(1:2) = lbound(SrcInitTypeData%M) + UB(1:2) = ubound(SrcInitTypeData%M) + if (.not. allocated(DstInitTypeData%M)) then + allocate(DstInitTypeData%M(LB(1):UB(1),LB(2):UB(2)), 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 + end if + if (allocated(SrcInitTypeData%ElemProps)) then + LB(1:2) = lbound(SrcInitTypeData%ElemProps) + UB(1:2) = ubound(SrcInitTypeData%ElemProps) + if (.not. allocated(DstInitTypeData%ElemProps)) then + allocate(DstInitTypeData%ElemProps(LB(1):UB(1),LB(2):UB(2)), 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 + end if + if (allocated(SrcInitTypeData%MemberNodes)) then + LB(1:2) = lbound(SrcInitTypeData%MemberNodes) + UB(1:2) = ubound(SrcInitTypeData%MemberNodes) + if (.not. allocated(DstInitTypeData%MemberNodes)) then + allocate(DstInitTypeData%MemberNodes(LB(1):UB(1),LB(2):UB(2)), 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 + end if + if (allocated(SrcInitTypeData%NodesConnN)) then + LB(1:2) = lbound(SrcInitTypeData%NodesConnN) + UB(1:2) = ubound(SrcInitTypeData%NodesConnN) + if (.not. allocated(DstInitTypeData%NodesConnN)) then + allocate(DstInitTypeData%NodesConnN(LB(1):UB(1),LB(2):UB(2)), 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 + end if + if (allocated(SrcInitTypeData%NodesConnE)) then + LB(1:2) = lbound(SrcInitTypeData%NodesConnE) + UB(1:2) = ubound(SrcInitTypeData%NodesConnE) + if (.not. allocated(DstInitTypeData%NodesConnE)) then + allocate(DstInitTypeData%NodesConnE(LB(1):UB(1),LB(2):UB(2)), 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 + end if + DstInitTypeData%SSSum = SrcInitTypeData%SSSum +end subroutine + +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' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InitTypeData%Joints)) then + deallocate(InitTypeData%Joints) + end if + if (allocated(InitTypeData%PropSetsB)) then + deallocate(InitTypeData%PropSetsB) + end if + if (allocated(InitTypeData%PropSetsC)) then + deallocate(InitTypeData%PropSetsC) + end if + if (allocated(InitTypeData%PropSetsR)) then + deallocate(InitTypeData%PropSetsR) + end if + if (allocated(InitTypeData%PropSetsS)) then + deallocate(InitTypeData%PropSetsS) + end if + if (allocated(InitTypeData%PropSetsX)) then + deallocate(InitTypeData%PropSetsX) + end if + if (allocated(InitTypeData%COSMs)) then + deallocate(InitTypeData%COSMs) + end if + if (allocated(InitTypeData%CMass)) then + deallocate(InitTypeData%CMass) + end if + if (allocated(InitTypeData%JDampings)) then + deallocate(InitTypeData%JDampings) + end if + if (allocated(InitTypeData%Members)) then + deallocate(InitTypeData%Members) + end if + if (allocated(InitTypeData%SSOutList)) then + deallocate(InitTypeData%SSOutList) + end if + if (allocated(InitTypeData%SSIK)) then + deallocate(InitTypeData%SSIK) + end if + if (allocated(InitTypeData%SSIM)) then + deallocate(InitTypeData%SSIM) + end if + if (allocated(InitTypeData%SSIfile)) then + deallocate(InitTypeData%SSIfile) + end if + if (allocated(InitTypeData%Soil_K)) then + deallocate(InitTypeData%Soil_K) + end if + if (allocated(InitTypeData%Soil_Points)) then + deallocate(InitTypeData%Soil_Points) + end if + if (allocated(InitTypeData%Soil_Nodes)) then + deallocate(InitTypeData%Soil_Nodes) + end if + if (allocated(InitTypeData%Nodes)) then + deallocate(InitTypeData%Nodes) + end if + if (allocated(InitTypeData%PropsB)) then + deallocate(InitTypeData%PropsB) + end if + if (allocated(InitTypeData%PropsC)) then + deallocate(InitTypeData%PropsC) + end if + if (allocated(InitTypeData%PropsR)) then + deallocate(InitTypeData%PropsR) + end if + if (allocated(InitTypeData%PropsS)) then + deallocate(InitTypeData%PropsS) + end if + if (allocated(InitTypeData%K)) then + deallocate(InitTypeData%K) + end if + if (allocated(InitTypeData%M)) then + deallocate(InitTypeData%M) + end if + if (allocated(InitTypeData%ElemProps)) then + deallocate(InitTypeData%ElemProps) + end if + if (allocated(InitTypeData%MemberNodes)) then + deallocate(InitTypeData%MemberNodes) + end if + if (allocated(InitTypeData%NodesConnN)) then + deallocate(InitTypeData%NodesConnN) + end if + if (allocated(InitTypeData%NodesConnE)) then + deallocate(InitTypeData%NodesConnE) + end if +end subroutine + +subroutine SD_PackInitType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SD_InitType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SD_PackInitType' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%RootName) + call RegPack(RF, InData%TP_RefPoint) + call RegPack(RF, InData%SubRotateZ) + call RegPack(RF, InData%g) + call RegPack(RF, InData%DT) + call RegPack(RF, InData%NJoints) + call RegPack(RF, InData%NPropSetsX) + call RegPack(RF, InData%NPropSetsB) + call RegPack(RF, InData%NPropSetsC) + call RegPack(RF, InData%NPropSetsR) + call RegPack(RF, InData%NPropSetsS) + call RegPack(RF, InData%NCMass) + call RegPack(RF, InData%NCOSMs) + call RegPack(RF, InData%FEMMod) + call RegPack(RF, InData%NDiv) + call RegPack(RF, InData%CBMod) + call RegPackAlloc(RF, InData%Joints) + call RegPackAlloc(RF, InData%PropSetsB) + call RegPackAlloc(RF, InData%PropSetsC) + call RegPackAlloc(RF, InData%PropSetsR) + call RegPackAlloc(RF, InData%PropSetsS) + call RegPackAlloc(RF, InData%PropSetsX) + call RegPackAlloc(RF, InData%COSMs) + call RegPackAlloc(RF, InData%CMass) + call RegPackAlloc(RF, InData%JDampings) + call RegPack(RF, InData%GuyanDampMod) + call RegPack(RF, InData%RayleighDamp) + call RegPack(RF, InData%GuyanDampMat) + call RegPackAlloc(RF, InData%Members) + call RegPackAlloc(RF, InData%SSOutList) + call RegPack(RF, InData%OutCOSM) + call RegPack(RF, InData%TabDelim) + call RegPackAlloc(RF, InData%SSIK) + call RegPackAlloc(RF, InData%SSIM) + call RegPackAlloc(RF, InData%SSIfile) + call RegPackAlloc(RF, InData%Soil_K) + call RegPackAlloc(RF, InData%Soil_Points) + call RegPackAlloc(RF, InData%Soil_Nodes) + call RegPack(RF, InData%NElem) + call RegPack(RF, InData%NPropB) + call RegPack(RF, InData%NPropC) + call RegPack(RF, InData%NPropR) + call RegPack(RF, InData%NPropS) + call RegPackAlloc(RF, InData%Nodes) + call RegPackAlloc(RF, InData%PropsB) + call RegPackAlloc(RF, InData%PropsC) + call RegPackAlloc(RF, InData%PropsR) + call RegPackAlloc(RF, InData%PropsS) + call RegPackAlloc(RF, InData%K) + call RegPackAlloc(RF, InData%M) + call RegPackAlloc(RF, InData%ElemProps) + call RegPackAlloc(RF, InData%MemberNodes) + call RegPackAlloc(RF, InData%NodesConnN) + call RegPackAlloc(RF, InData%NodesConnE) + call RegPack(RF, InData%SSSum) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SD_UnPackInitType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SD_InitType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SD_UnPackInitType' + integer(B4Ki) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%RootName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TP_RefPoint); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SubRotateZ); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%g); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NJoints); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NPropSetsX); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NPropSetsB); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NPropSetsC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NPropSetsR); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NPropSetsS); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NCMass); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NCOSMs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FEMMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NDiv); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CBMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Joints); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PropSetsB); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PropSetsC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PropSetsR); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PropSetsS); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PropSetsX); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%COSMs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%CMass); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%JDampings); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GuyanDampMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RayleighDamp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GuyanDampMat); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Members); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%SSOutList); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutCOSM); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TabDelim); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%SSIK); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%SSIM); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%SSIfile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Soil_K); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Soil_Points); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Soil_Nodes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NElem); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NPropB); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NPropC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NPropR); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NPropS); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Nodes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PropsB); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PropsC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PropsR); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PropsS); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%K); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%M); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ElemProps); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%MemberNodes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%NodesConnN); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%NodesConnE); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SSSum); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +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 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'SD_CopyContState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcContStateData%qm)) then + LB(1:1) = lbound(SrcContStateData%qm) + UB(1:1) = ubound(SrcContStateData%qm) + if (.not. allocated(DstContStateData%qm)) then + allocate(DstContStateData%qm(LB(1):UB(1)), 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 + end if + if (allocated(SrcContStateData%qmdot)) then + LB(1:1) = lbound(SrcContStateData%qmdot) + UB(1:1) = ubound(SrcContStateData%qmdot) + if (.not. allocated(DstContStateData%qmdot)) then + allocate(DstContStateData%qmdot(LB(1):UB(1)), 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 + end if +end subroutine + +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' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ContStateData%qm)) then + deallocate(ContStateData%qm) + end if + if (allocated(ContStateData%qmdot)) then + deallocate(ContStateData%qmdot) + end if +end subroutine + +subroutine SD_PackContState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SD_ContinuousStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SD_PackContState' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%qm) + call RegPackAlloc(RF, InData%qmdot) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SD_UnPackContState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SD_ContinuousStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SD_UnPackContState' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%qm); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%qmdot); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +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 + character(*), parameter :: RoutineName = 'SD_CopyDiscState' + ErrStat = ErrID_None + ErrMsg = '' + DstDiscStateData%DummyDiscState = SrcDiscStateData%DummyDiscState +end subroutine + +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' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine SD_PackDiscState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SD_DiscreteStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SD_PackDiscState' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyDiscState) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SD_UnPackDiscState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SD_DiscreteStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SD_UnPackDiscState' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyDiscState); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +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 + character(*), parameter :: RoutineName = 'SD_CopyConstrState' + ErrStat = ErrID_None + ErrMsg = '' + DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState +end subroutine + +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' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine SD_PackConstrState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SD_ConstraintStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SD_PackConstrState' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyConstrState) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SD_UnPackConstrState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SD_ConstraintStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SD_UnPackConstrState' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyConstrState); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +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 + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SD_CopyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcOtherStateData%xdot)) then + LB(1:1) = lbound(SrcOtherStateData%xdot) + UB(1:1) = ubound(SrcOtherStateData%xdot) + if (.not. allocated(DstOtherStateData%xdot)) then + allocate(DstOtherStateData%xdot(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%xdot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call SD_CopyContState(SrcOtherStateData%xdot(i1), DstOtherStateData%xdot(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + DstOtherStateData%n = SrcOtherStateData%n +end subroutine + +subroutine SD_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) + type(SD_OtherStateType), intent(inout) :: OtherStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SD_DestroyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OtherStateData%xdot)) then + LB(1:1) = lbound(OtherStateData%xdot) + UB(1:1) = ubound(OtherStateData%xdot) + do i1 = LB(1), UB(1) + call SD_DestroyContState(OtherStateData%xdot(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(OtherStateData%xdot) + end if +end subroutine + +subroutine SD_PackOtherState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SD_OtherStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SD_PackOtherState' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%xdot)) + if (allocated(InData%xdot)) then + call RegPackBounds(RF, 1, lbound(InData%xdot), ubound(InData%xdot)) + LB(1:1) = lbound(InData%xdot) + UB(1:1) = ubound(InData%xdot) + do i1 = LB(1), UB(1) + call SD_PackContState(RF, InData%xdot(i1)) + end do + end if + call RegPack(RF, InData%n) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SD_UnPackOtherState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SD_OtherStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SD_UnPackOtherState' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + if (allocated(OutData%xdot)) deallocate(OutData%xdot) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%xdot(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xdot.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SD_UnpackContState(RF, OutData%xdot(i1)) ! xdot + end do + end if + call RegUnpack(RF, OutData%n); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +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 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'SD_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcMiscData%qmdotdot)) then + LB(1:1) = lbound(SrcMiscData%qmdotdot) + UB(1:1) = ubound(SrcMiscData%qmdotdot) + if (.not. allocated(DstMiscData%qmdotdot)) then + allocate(DstMiscData%qmdotdot(LB(1):UB(1)), 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 + end if + DstMiscData%u_TP = SrcMiscData%u_TP + DstMiscData%udot_TP = SrcMiscData%udot_TP + DstMiscData%udotdot_TP = SrcMiscData%udotdot_TP + if (allocated(SrcMiscData%F_L)) then + LB(1:1) = lbound(SrcMiscData%F_L) + UB(1:1) = ubound(SrcMiscData%F_L) + if (.not. allocated(DstMiscData%F_L)) then + allocate(DstMiscData%F_L(LB(1):UB(1)), 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 + end if + if (allocated(SrcMiscData%F_L2)) then + LB(1:1) = lbound(SrcMiscData%F_L2) + UB(1:1) = ubound(SrcMiscData%F_L2) + if (.not. allocated(DstMiscData%F_L2)) then + allocate(DstMiscData%F_L2(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_L2.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%F_L2 = SrcMiscData%F_L2 + end if + if (allocated(SrcMiscData%UR_bar)) then + LB(1:1) = lbound(SrcMiscData%UR_bar) + UB(1:1) = ubound(SrcMiscData%UR_bar) + if (.not. allocated(DstMiscData%UR_bar)) then + allocate(DstMiscData%UR_bar(LB(1):UB(1)), 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 + end if + if (allocated(SrcMiscData%UR_bar_dot)) then + LB(1:1) = lbound(SrcMiscData%UR_bar_dot) + UB(1:1) = ubound(SrcMiscData%UR_bar_dot) + if (.not. allocated(DstMiscData%UR_bar_dot)) then + allocate(DstMiscData%UR_bar_dot(LB(1):UB(1)), 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 + end if + if (allocated(SrcMiscData%UR_bar_dotdot)) then + LB(1:1) = lbound(SrcMiscData%UR_bar_dotdot) + UB(1:1) = ubound(SrcMiscData%UR_bar_dotdot) + if (.not. allocated(DstMiscData%UR_bar_dotdot)) then + allocate(DstMiscData%UR_bar_dotdot(LB(1):UB(1)), 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 + end if + if (allocated(SrcMiscData%UL)) then + LB(1:1) = lbound(SrcMiscData%UL) + UB(1:1) = ubound(SrcMiscData%UL) + if (.not. allocated(DstMiscData%UL)) then + allocate(DstMiscData%UL(LB(1):UB(1)), 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 + end if + if (allocated(SrcMiscData%UL_NS)) then + LB(1:1) = lbound(SrcMiscData%UL_NS) + UB(1:1) = ubound(SrcMiscData%UL_NS) + if (.not. allocated(DstMiscData%UL_NS)) then + allocate(DstMiscData%UL_NS(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%UL_NS.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%UL_NS = SrcMiscData%UL_NS + end if + if (allocated(SrcMiscData%UL_dot)) then + LB(1:1) = lbound(SrcMiscData%UL_dot) + UB(1:1) = ubound(SrcMiscData%UL_dot) + if (.not. allocated(DstMiscData%UL_dot)) then + allocate(DstMiscData%UL_dot(LB(1):UB(1)), 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 + end if + if (allocated(SrcMiscData%UL_dotdot)) then + LB(1:1) = lbound(SrcMiscData%UL_dotdot) + UB(1:1) = ubound(SrcMiscData%UL_dotdot) + if (.not. allocated(DstMiscData%UL_dotdot)) then + allocate(DstMiscData%UL_dotdot(LB(1):UB(1)), 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 + end if + if (allocated(SrcMiscData%DU_full)) then + LB(1:1) = lbound(SrcMiscData%DU_full) + UB(1:1) = ubound(SrcMiscData%DU_full) + if (.not. allocated(DstMiscData%DU_full)) then + allocate(DstMiscData%DU_full(LB(1):UB(1)), 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 + end if + if (allocated(SrcMiscData%U_full)) then + LB(1:1) = lbound(SrcMiscData%U_full) + UB(1:1) = ubound(SrcMiscData%U_full) + if (.not. allocated(DstMiscData%U_full)) then + allocate(DstMiscData%U_full(LB(1):UB(1)), 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 + end if + if (allocated(SrcMiscData%U_full_NS)) then + LB(1:1) = lbound(SrcMiscData%U_full_NS) + UB(1:1) = ubound(SrcMiscData%U_full_NS) + if (.not. allocated(DstMiscData%U_full_NS)) then + allocate(DstMiscData%U_full_NS(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%U_full_NS.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%U_full_NS = SrcMiscData%U_full_NS + end if + if (allocated(SrcMiscData%U_full_dot)) then + LB(1:1) = lbound(SrcMiscData%U_full_dot) + UB(1:1) = ubound(SrcMiscData%U_full_dot) + if (.not. allocated(DstMiscData%U_full_dot)) then + allocate(DstMiscData%U_full_dot(LB(1):UB(1)), 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 + end if + if (allocated(SrcMiscData%U_full_dotdot)) then + LB(1:1) = lbound(SrcMiscData%U_full_dotdot) + UB(1:1) = ubound(SrcMiscData%U_full_dotdot) + if (.not. allocated(DstMiscData%U_full_dotdot)) then + allocate(DstMiscData%U_full_dotdot(LB(1):UB(1)), 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 + end if + if (allocated(SrcMiscData%U_full_elast)) then + LB(1:1) = lbound(SrcMiscData%U_full_elast) + UB(1:1) = ubound(SrcMiscData%U_full_elast) + if (.not. allocated(DstMiscData%U_full_elast)) then + allocate(DstMiscData%U_full_elast(LB(1):UB(1)), 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 + end if + if (allocated(SrcMiscData%U_red)) then + LB(1:1) = lbound(SrcMiscData%U_red) + UB(1:1) = ubound(SrcMiscData%U_red) + if (.not. allocated(DstMiscData%U_red)) then + allocate(DstMiscData%U_red(LB(1):UB(1)), 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 + end if + if (allocated(SrcMiscData%FC_unit)) then + LB(1:1) = lbound(SrcMiscData%FC_unit) + UB(1:1) = ubound(SrcMiscData%FC_unit) + if (.not. allocated(DstMiscData%FC_unit)) then + allocate(DstMiscData%FC_unit(LB(1):UB(1)), 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 + end if + if (allocated(SrcMiscData%SDWrOutput)) then + LB(1:1) = lbound(SrcMiscData%SDWrOutput) + UB(1:1) = ubound(SrcMiscData%SDWrOutput) + if (.not. allocated(DstMiscData%SDWrOutput)) then + allocate(DstMiscData%SDWrOutput(LB(1):UB(1)), 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 + end if + if (allocated(SrcMiscData%AllOuts)) then + LB(1:1) = lbound(SrcMiscData%AllOuts) + UB(1:1) = ubound(SrcMiscData%AllOuts) + if (.not. allocated(DstMiscData%AllOuts)) then + allocate(DstMiscData%AllOuts(LB(1):UB(1)), 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 + end if + DstMiscData%LastOutTime = SrcMiscData%LastOutTime + DstMiscData%Decimat = SrcMiscData%Decimat + if (allocated(SrcMiscData%Fext)) then + LB(1:1) = lbound(SrcMiscData%Fext) + UB(1:1) = ubound(SrcMiscData%Fext) + if (.not. allocated(DstMiscData%Fext)) then + allocate(DstMiscData%Fext(LB(1):UB(1)), 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 + end if + if (allocated(SrcMiscData%Fext_red)) then + LB(1:1) = lbound(SrcMiscData%Fext_red) + UB(1:1) = ubound(SrcMiscData%Fext_red) + if (.not. allocated(DstMiscData%Fext_red)) then + allocate(DstMiscData%Fext_red(LB(1):UB(1)), 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 + end if + if (allocated(SrcMiscData%FG)) then + LB(1:1) = lbound(SrcMiscData%FG) + UB(1:1) = ubound(SrcMiscData%FG) + if (.not. allocated(DstMiscData%FG)) then + allocate(DstMiscData%FG(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FG.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%FG = SrcMiscData%FG + end if + if (allocated(SrcMiscData%UL_SIM)) then + LB(1:1) = lbound(SrcMiscData%UL_SIM) + UB(1:1) = ubound(SrcMiscData%UL_SIM) + if (.not. allocated(DstMiscData%UL_SIM)) then + allocate(DstMiscData%UL_SIM(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%UL_SIM.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%UL_SIM = SrcMiscData%UL_SIM + end if + if (allocated(SrcMiscData%UL_0m)) then + LB(1:1) = lbound(SrcMiscData%UL_0m) + UB(1:1) = ubound(SrcMiscData%UL_0m) + if (.not. allocated(DstMiscData%UL_0m)) then + allocate(DstMiscData%UL_0m(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%UL_0m.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%UL_0m = SrcMiscData%UL_0m + end if +end subroutine + +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' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(MiscData%qmdotdot)) then + deallocate(MiscData%qmdotdot) + end if + if (allocated(MiscData%F_L)) then + deallocate(MiscData%F_L) + end if + if (allocated(MiscData%F_L2)) then + deallocate(MiscData%F_L2) + end if + if (allocated(MiscData%UR_bar)) then + deallocate(MiscData%UR_bar) + end if + if (allocated(MiscData%UR_bar_dot)) then + deallocate(MiscData%UR_bar_dot) + end if + if (allocated(MiscData%UR_bar_dotdot)) then + deallocate(MiscData%UR_bar_dotdot) + end if + if (allocated(MiscData%UL)) then + deallocate(MiscData%UL) + end if + if (allocated(MiscData%UL_NS)) then + deallocate(MiscData%UL_NS) + end if + if (allocated(MiscData%UL_dot)) then + deallocate(MiscData%UL_dot) + end if + if (allocated(MiscData%UL_dotdot)) then + deallocate(MiscData%UL_dotdot) + end if + if (allocated(MiscData%DU_full)) then + deallocate(MiscData%DU_full) + end if + if (allocated(MiscData%U_full)) then + deallocate(MiscData%U_full) + end if + if (allocated(MiscData%U_full_NS)) then + deallocate(MiscData%U_full_NS) + end if + if (allocated(MiscData%U_full_dot)) then + deallocate(MiscData%U_full_dot) + end if + if (allocated(MiscData%U_full_dotdot)) then + deallocate(MiscData%U_full_dotdot) + end if + if (allocated(MiscData%U_full_elast)) then + deallocate(MiscData%U_full_elast) + end if + if (allocated(MiscData%U_red)) then + deallocate(MiscData%U_red) + end if + if (allocated(MiscData%FC_unit)) then + deallocate(MiscData%FC_unit) + end if + if (allocated(MiscData%SDWrOutput)) then + deallocate(MiscData%SDWrOutput) + end if + if (allocated(MiscData%AllOuts)) then + deallocate(MiscData%AllOuts) + end if + if (allocated(MiscData%Fext)) then + deallocate(MiscData%Fext) + end if + if (allocated(MiscData%Fext_red)) then + deallocate(MiscData%Fext_red) + end if + if (allocated(MiscData%FG)) then + deallocate(MiscData%FG) + end if + if (allocated(MiscData%UL_SIM)) then + deallocate(MiscData%UL_SIM) + end if + if (allocated(MiscData%UL_0m)) then + deallocate(MiscData%UL_0m) + end if +end subroutine + +subroutine SD_PackMisc(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SD_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SD_PackMisc' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%qmdotdot) + call RegPack(RF, InData%u_TP) + call RegPack(RF, InData%udot_TP) + call RegPack(RF, InData%udotdot_TP) + call RegPackAlloc(RF, InData%F_L) + call RegPackAlloc(RF, InData%F_L2) + call RegPackAlloc(RF, InData%UR_bar) + call RegPackAlloc(RF, InData%UR_bar_dot) + call RegPackAlloc(RF, InData%UR_bar_dotdot) + call RegPackAlloc(RF, InData%UL) + call RegPackAlloc(RF, InData%UL_NS) + call RegPackAlloc(RF, InData%UL_dot) + call RegPackAlloc(RF, InData%UL_dotdot) + call RegPackAlloc(RF, InData%DU_full) + call RegPackAlloc(RF, InData%U_full) + call RegPackAlloc(RF, InData%U_full_NS) + call RegPackAlloc(RF, InData%U_full_dot) + call RegPackAlloc(RF, InData%U_full_dotdot) + call RegPackAlloc(RF, InData%U_full_elast) + call RegPackAlloc(RF, InData%U_red) + call RegPackAlloc(RF, InData%FC_unit) + call RegPackAlloc(RF, InData%SDWrOutput) + call RegPackAlloc(RF, InData%AllOuts) + call RegPack(RF, InData%LastOutTime) + call RegPack(RF, InData%Decimat) + call RegPackAlloc(RF, InData%Fext) + call RegPackAlloc(RF, InData%Fext_red) + call RegPackAlloc(RF, InData%FG) + call RegPackAlloc(RF, InData%UL_SIM) + call RegPackAlloc(RF, InData%UL_0m) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SD_UnPackMisc(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SD_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SD_UnPackMisc' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%qmdotdot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%u_TP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%udot_TP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%udotdot_TP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%F_L); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%F_L2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%UR_bar); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%UR_bar_dot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%UR_bar_dotdot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%UL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%UL_NS); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%UL_dot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%UL_dotdot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%DU_full); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%U_full); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%U_full_NS); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%U_full_dot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%U_full_dotdot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%U_full_elast); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%U_red); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%FC_unit); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%SDWrOutput); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AllOuts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LastOutTime); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Decimat); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Fext); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Fext_red); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%FG); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%UL_SIM); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%UL_0m); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +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 + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SD_CopyParam' + ErrStat = ErrID_None + ErrMsg = '' + DstParamData%g = SrcParamData%g + 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 + LB(1:2) = lbound(SrcParamData%Elems) + UB(1:2) = ubound(SrcParamData%Elems) + if (.not. allocated(DstParamData%Elems)) then + allocate(DstParamData%Elems(LB(1):UB(1),LB(2):UB(2)), 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 + end if + if (allocated(SrcParamData%ElemProps)) then + LB(1:1) = lbound(SrcParamData%ElemProps) + UB(1:1) = ubound(SrcParamData%ElemProps) + if (.not. allocated(DstParamData%ElemProps)) then + allocate(DstParamData%ElemProps(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ElemProps.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call SD_CopyElemPropType(SrcParamData%ElemProps(i1), DstParamData%ElemProps(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcParamData%FC)) then + LB(1:1) = lbound(SrcParamData%FC) + UB(1:1) = ubound(SrcParamData%FC) + if (.not. allocated(DstParamData%FC)) then + allocate(DstParamData%FC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%FC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%FC = SrcParamData%FC + end if + if (allocated(SrcParamData%FG)) then + LB(1:1) = lbound(SrcParamData%FG) + UB(1:1) = ubound(SrcParamData%FG) + if (.not. allocated(DstParamData%FG)) then + allocate(DstParamData%FG(LB(1):UB(1)), 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 + end if + if (allocated(SrcParamData%DP0)) then + LB(1:2) = lbound(SrcParamData%DP0) + UB(1:2) = ubound(SrcParamData%DP0) + if (.not. allocated(DstParamData%DP0)) then + allocate(DstParamData%DP0(LB(1):UB(1),LB(2):UB(2)), 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 + end if + if (allocated(SrcParamData%rPG)) then + LB(1:1) = lbound(SrcParamData%rPG) + UB(1:1) = ubound(SrcParamData%rPG) + if (.not. allocated(DstParamData%rPG)) then + allocate(DstParamData%rPG(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rPG.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%rPG = SrcParamData%rPG + end if + if (allocated(SrcParamData%NodeID2JointID)) then + LB(1:1) = lbound(SrcParamData%NodeID2JointID) + UB(1:1) = ubound(SrcParamData%NodeID2JointID) + if (.not. allocated(DstParamData%NodeID2JointID)) then + allocate(DstParamData%NodeID2JointID(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%NodeID2JointID.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%NodeID2JointID = SrcParamData%NodeID2JointID + end if + if (allocated(SrcParamData%CMassNode)) then + LB(1:1) = lbound(SrcParamData%CMassNode) + UB(1:1) = ubound(SrcParamData%CMassNode) + if (.not. allocated(DstParamData%CMassNode)) then + allocate(DstParamData%CMassNode(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CMassNode.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%CMassNode = SrcParamData%CMassNode + end if + if (allocated(SrcParamData%CMassWeight)) then + LB(1:1) = lbound(SrcParamData%CMassWeight) + UB(1:1) = ubound(SrcParamData%CMassWeight) + if (.not. allocated(DstParamData%CMassWeight)) then + allocate(DstParamData%CMassWeight(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CMassWeight.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%CMassWeight = SrcParamData%CMassWeight + end if + if (allocated(SrcParamData%CMassOffset)) then + LB(1:2) = lbound(SrcParamData%CMassOffset) + UB(1:2) = ubound(SrcParamData%CMassOffset) + if (.not. allocated(DstParamData%CMassOffset)) then + allocate(DstParamData%CMassOffset(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CMassOffset.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%CMassOffset = SrcParamData%CMassOffset + end if + DstParamData%reduced = SrcParamData%reduced + if (allocated(SrcParamData%T_red)) then + LB(1:2) = lbound(SrcParamData%T_red) + UB(1:2) = ubound(SrcParamData%T_red) + if (.not. allocated(DstParamData%T_red)) then + allocate(DstParamData%T_red(LB(1):UB(1),LB(2):UB(2)), 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 + end if + if (allocated(SrcParamData%T_red_T)) then + LB(1:2) = lbound(SrcParamData%T_red_T) + UB(1:2) = ubound(SrcParamData%T_red_T) + if (.not. allocated(DstParamData%T_red_T)) then + allocate(DstParamData%T_red_T(LB(1):UB(1),LB(2):UB(2)), 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 + end if + if (allocated(SrcParamData%NodesDOF)) then + LB(1:1) = lbound(SrcParamData%NodesDOF) + UB(1:1) = ubound(SrcParamData%NodesDOF) + if (.not. allocated(DstParamData%NodesDOF)) then + allocate(DstParamData%NodesDOF(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%NodesDOF.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call SD_CopyIList(SrcParamData%NodesDOF(i1), DstParamData%NodesDOF(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcParamData%NodesDOFred)) then + LB(1:1) = lbound(SrcParamData%NodesDOFred) + UB(1:1) = ubound(SrcParamData%NodesDOFred) + if (.not. allocated(DstParamData%NodesDOFred)) then + allocate(DstParamData%NodesDOFred(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%NodesDOFred.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call SD_CopyIList(SrcParamData%NodesDOFred(i1), DstParamData%NodesDOFred(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcParamData%ElemsDOF)) then + LB(1:2) = lbound(SrcParamData%ElemsDOF) + UB(1:2) = ubound(SrcParamData%ElemsDOF) + if (.not. allocated(DstParamData%ElemsDOF)) then + allocate(DstParamData%ElemsDOF(LB(1):UB(1),LB(2):UB(2)), 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 + end if + if (allocated(SrcParamData%DOFred2Nodes)) then + LB(1:2) = lbound(SrcParamData%DOFred2Nodes) + UB(1:2) = ubound(SrcParamData%DOFred2Nodes) + if (.not. allocated(DstParamData%DOFred2Nodes)) then + allocate(DstParamData%DOFred2Nodes(LB(1):UB(1),LB(2):UB(2)), 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 + end if + if (allocated(SrcParamData%CtrlElem2Channel)) then + LB(1:2) = lbound(SrcParamData%CtrlElem2Channel) + UB(1:2) = ubound(SrcParamData%CtrlElem2Channel) + if (.not. allocated(DstParamData%CtrlElem2Channel)) then + allocate(DstParamData%CtrlElem2Channel(LB(1):UB(1),LB(2):UB(2)), 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 + end if + DstParamData%nDOFM = SrcParamData%nDOFM + DstParamData%SttcSolve = SrcParamData%SttcSolve + DstParamData%GuyanLoadCorrection = SrcParamData%GuyanLoadCorrection + DstParamData%Floating = SrcParamData%Floating + if (allocated(SrcParamData%KMMDiag)) then + LB(1:1) = lbound(SrcParamData%KMMDiag) + UB(1:1) = ubound(SrcParamData%KMMDiag) + if (.not. allocated(DstParamData%KMMDiag)) then + allocate(DstParamData%KMMDiag(LB(1):UB(1)), 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 + end if + if (allocated(SrcParamData%CMMDiag)) then + LB(1:1) = lbound(SrcParamData%CMMDiag) + UB(1:1) = ubound(SrcParamData%CMMDiag) + if (.not. allocated(DstParamData%CMMDiag)) then + allocate(DstParamData%CMMDiag(LB(1):UB(1)), 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 + end if + if (allocated(SrcParamData%MMB)) then + LB(1:2) = lbound(SrcParamData%MMB) + UB(1:2) = ubound(SrcParamData%MMB) + if (.not. allocated(DstParamData%MMB)) then + allocate(DstParamData%MMB(LB(1):UB(1),LB(2):UB(2)), 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 + end if + if (allocated(SrcParamData%MBmmB)) then + LB(1:2) = lbound(SrcParamData%MBmmB) + UB(1:2) = ubound(SrcParamData%MBmmB) + if (.not. allocated(DstParamData%MBmmB)) then + allocate(DstParamData%MBmmB(LB(1):UB(1),LB(2):UB(2)), 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 + end if + if (allocated(SrcParamData%C1_11)) then + LB(1:2) = lbound(SrcParamData%C1_11) + UB(1:2) = ubound(SrcParamData%C1_11) + if (.not. allocated(DstParamData%C1_11)) then + allocate(DstParamData%C1_11(LB(1):UB(1),LB(2):UB(2)), 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 + end if + if (allocated(SrcParamData%C1_12)) then + LB(1:2) = lbound(SrcParamData%C1_12) + UB(1:2) = ubound(SrcParamData%C1_12) + if (.not. allocated(DstParamData%C1_12)) then + allocate(DstParamData%C1_12(LB(1):UB(1),LB(2):UB(2)), 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 + end if + if (allocated(SrcParamData%D1_141)) then + LB(1:2) = lbound(SrcParamData%D1_141) + UB(1:2) = ubound(SrcParamData%D1_141) + if (.not. allocated(DstParamData%D1_141)) then + allocate(DstParamData%D1_141(LB(1):UB(1),LB(2):UB(2)), 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 + end if + if (allocated(SrcParamData%D1_142)) then + LB(1:2) = lbound(SrcParamData%D1_142) + UB(1:2) = ubound(SrcParamData%D1_142) + if (.not. allocated(DstParamData%D1_142)) then + allocate(DstParamData%D1_142(LB(1):UB(1),LB(2):UB(2)), 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 + end if + if (allocated(SrcParamData%PhiM)) then + LB(1:2) = lbound(SrcParamData%PhiM) + UB(1:2) = ubound(SrcParamData%PhiM) + if (.not. allocated(DstParamData%PhiM)) then + allocate(DstParamData%PhiM(LB(1):UB(1),LB(2):UB(2)), 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 + end if + if (allocated(SrcParamData%C2_61)) then + LB(1:2) = lbound(SrcParamData%C2_61) + UB(1:2) = ubound(SrcParamData%C2_61) + if (.not. allocated(DstParamData%C2_61)) then + allocate(DstParamData%C2_61(LB(1):UB(1),LB(2):UB(2)), 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 + end if + if (allocated(SrcParamData%C2_62)) then + LB(1:2) = lbound(SrcParamData%C2_62) + UB(1:2) = ubound(SrcParamData%C2_62) + if (.not. allocated(DstParamData%C2_62)) then + allocate(DstParamData%C2_62(LB(1):UB(1),LB(2):UB(2)), 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 + end if + if (allocated(SrcParamData%PhiRb_TI)) then + LB(1:2) = lbound(SrcParamData%PhiRb_TI) + UB(1:2) = ubound(SrcParamData%PhiRb_TI) + if (.not. allocated(DstParamData%PhiRb_TI)) then + allocate(DstParamData%PhiRb_TI(LB(1):UB(1),LB(2):UB(2)), 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 + end if + if (allocated(SrcParamData%D2_63)) then + LB(1:2) = lbound(SrcParamData%D2_63) + UB(1:2) = ubound(SrcParamData%D2_63) + if (.not. allocated(DstParamData%D2_63)) then + allocate(DstParamData%D2_63(LB(1):UB(1),LB(2):UB(2)), 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 + end if + if (allocated(SrcParamData%D2_64)) then + LB(1:2) = lbound(SrcParamData%D2_64) + UB(1:2) = ubound(SrcParamData%D2_64) + if (.not. allocated(DstParamData%D2_64)) then + allocate(DstParamData%D2_64(LB(1):UB(1),LB(2):UB(2)), 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 + end if + if (allocated(SrcParamData%MBB)) then + LB(1:2) = lbound(SrcParamData%MBB) + UB(1:2) = ubound(SrcParamData%MBB) + if (.not. allocated(DstParamData%MBB)) then + allocate(DstParamData%MBB(LB(1):UB(1),LB(2):UB(2)), 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 + end if + if (allocated(SrcParamData%KBB)) then + LB(1:2) = lbound(SrcParamData%KBB) + UB(1:2) = ubound(SrcParamData%KBB) + if (.not. allocated(DstParamData%KBB)) then + allocate(DstParamData%KBB(LB(1):UB(1),LB(2):UB(2)), 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 + end if + if (allocated(SrcParamData%CBB)) then + LB(1:2) = lbound(SrcParamData%CBB) + UB(1:2) = ubound(SrcParamData%CBB) + if (.not. allocated(DstParamData%CBB)) then + allocate(DstParamData%CBB(LB(1):UB(1),LB(2):UB(2)), 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 + end if + if (allocated(SrcParamData%CMM)) then + LB(1:2) = lbound(SrcParamData%CMM) + UB(1:2) = ubound(SrcParamData%CMM) + if (.not. allocated(DstParamData%CMM)) then + allocate(DstParamData%CMM(LB(1):UB(1),LB(2):UB(2)), 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 + end if + if (allocated(SrcParamData%MBM)) then + LB(1:2) = lbound(SrcParamData%MBM) + UB(1:2) = ubound(SrcParamData%MBM) + if (.not. allocated(DstParamData%MBM)) then + allocate(DstParamData%MBM(LB(1):UB(1),LB(2):UB(2)), 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 + end if + if (allocated(SrcParamData%PhiL_T)) then + LB(1:2) = lbound(SrcParamData%PhiL_T) + UB(1:2) = ubound(SrcParamData%PhiL_T) + if (.not. allocated(DstParamData%PhiL_T)) then + allocate(DstParamData%PhiL_T(LB(1):UB(1),LB(2):UB(2)), 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 + end if + if (allocated(SrcParamData%PhiLInvOmgL2)) then + LB(1:2) = lbound(SrcParamData%PhiLInvOmgL2) + UB(1:2) = ubound(SrcParamData%PhiLInvOmgL2) + if (.not. allocated(DstParamData%PhiLInvOmgL2)) then + allocate(DstParamData%PhiLInvOmgL2(LB(1):UB(1),LB(2):UB(2)), 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 + end if + if (allocated(SrcParamData%KLLm1)) then + LB(1:2) = lbound(SrcParamData%KLLm1) + UB(1:2) = ubound(SrcParamData%KLLm1) + if (.not. allocated(DstParamData%KLLm1)) then + allocate(DstParamData%KLLm1(LB(1):UB(1),LB(2):UB(2)), 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 + end if + if (allocated(SrcParamData%AM2Jac)) then + LB(1:2) = lbound(SrcParamData%AM2Jac) + UB(1:2) = ubound(SrcParamData%AM2Jac) + if (.not. allocated(DstParamData%AM2Jac)) then + allocate(DstParamData%AM2Jac(LB(1):UB(1),LB(2):UB(2)), 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 + end if + if (allocated(SrcParamData%AM2JacPiv)) then + LB(1:1) = lbound(SrcParamData%AM2JacPiv) + UB(1:1) = ubound(SrcParamData%AM2JacPiv) + if (.not. allocated(DstParamData%AM2JacPiv)) then + allocate(DstParamData%AM2JacPiv(LB(1):UB(1)), 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 + end if + if (allocated(SrcParamData%TI)) then + LB(1:2) = lbound(SrcParamData%TI) + UB(1:2) = ubound(SrcParamData%TI) + if (.not. allocated(DstParamData%TI)) then + allocate(DstParamData%TI(LB(1):UB(1),LB(2):UB(2)), 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 + end if + if (allocated(SrcParamData%TIreact)) then + LB(1:2) = lbound(SrcParamData%TIreact) + UB(1:2) = ubound(SrcParamData%TIreact) + if (.not. allocated(DstParamData%TIreact)) then + allocate(DstParamData%TIreact(LB(1):UB(1),LB(2):UB(2)), 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 + end if + 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 + LB(1:2) = lbound(SrcParamData%Nodes_I) + UB(1:2) = ubound(SrcParamData%Nodes_I) + if (.not. allocated(DstParamData%Nodes_I)) then + allocate(DstParamData%Nodes_I(LB(1):UB(1),LB(2):UB(2)), 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 + end if + if (allocated(SrcParamData%Nodes_L)) then + LB(1:2) = lbound(SrcParamData%Nodes_L) + UB(1:2) = ubound(SrcParamData%Nodes_L) + if (.not. allocated(DstParamData%Nodes_L)) then + allocate(DstParamData%Nodes_L(LB(1):UB(1),LB(2):UB(2)), 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 + end if + if (allocated(SrcParamData%Nodes_C)) then + LB(1:2) = lbound(SrcParamData%Nodes_C) + UB(1:2) = ubound(SrcParamData%Nodes_C) + if (.not. allocated(DstParamData%Nodes_C)) then + allocate(DstParamData%Nodes_C(LB(1):UB(1),LB(2):UB(2)), 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 + end if + 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 + LB(1:1) = lbound(SrcParamData%IDI__) + UB(1:1) = ubound(SrcParamData%IDI__) + if (.not. allocated(DstParamData%IDI__)) then + allocate(DstParamData%IDI__(LB(1):UB(1)), 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__ + end if + if (allocated(SrcParamData%IDI_Rb)) then + LB(1:1) = lbound(SrcParamData%IDI_Rb) + UB(1:1) = ubound(SrcParamData%IDI_Rb) + if (.not. allocated(DstParamData%IDI_Rb)) then + allocate(DstParamData%IDI_Rb(LB(1):UB(1)), 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 + end if + if (allocated(SrcParamData%IDI_F)) then + LB(1:1) = lbound(SrcParamData%IDI_F) + UB(1:1) = ubound(SrcParamData%IDI_F) + if (.not. allocated(DstParamData%IDI_F)) then + allocate(DstParamData%IDI_F(LB(1):UB(1)), 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 + end if + if (allocated(SrcParamData%IDL_L)) then + LB(1:1) = lbound(SrcParamData%IDL_L) + UB(1:1) = ubound(SrcParamData%IDL_L) + if (.not. allocated(DstParamData%IDL_L)) then + allocate(DstParamData%IDL_L(LB(1):UB(1)), 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 + end if + if (allocated(SrcParamData%IDC__)) then + LB(1:1) = lbound(SrcParamData%IDC__) + UB(1:1) = ubound(SrcParamData%IDC__) + if (.not. allocated(DstParamData%IDC__)) then + allocate(DstParamData%IDC__(LB(1):UB(1)), 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__ + end if + if (allocated(SrcParamData%IDC_Rb)) then + LB(1:1) = lbound(SrcParamData%IDC_Rb) + UB(1:1) = ubound(SrcParamData%IDC_Rb) + if (.not. allocated(DstParamData%IDC_Rb)) then + allocate(DstParamData%IDC_Rb(LB(1):UB(1)), 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 + end if + if (allocated(SrcParamData%IDC_L)) then + LB(1:1) = lbound(SrcParamData%IDC_L) + UB(1:1) = ubound(SrcParamData%IDC_L) + if (.not. allocated(DstParamData%IDC_L)) then + allocate(DstParamData%IDC_L(LB(1):UB(1)), 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 + end if + if (allocated(SrcParamData%IDC_F)) then + LB(1:1) = lbound(SrcParamData%IDC_F) + UB(1:1) = ubound(SrcParamData%IDC_F) + if (.not. allocated(DstParamData%IDC_F)) then + allocate(DstParamData%IDC_F(LB(1):UB(1)), 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 + end if + if (allocated(SrcParamData%IDR__)) then + LB(1:1) = lbound(SrcParamData%IDR__) + UB(1:1) = ubound(SrcParamData%IDR__) + if (.not. allocated(DstParamData%IDR__)) then + allocate(DstParamData%IDR__(LB(1):UB(1)), 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__ + end if + if (allocated(SrcParamData%ID__Rb)) then + LB(1:1) = lbound(SrcParamData%ID__Rb) + UB(1:1) = ubound(SrcParamData%ID__Rb) + if (.not. allocated(DstParamData%ID__Rb)) then + allocate(DstParamData%ID__Rb(LB(1):UB(1)), 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 + end if + if (allocated(SrcParamData%ID__L)) then + LB(1:1) = lbound(SrcParamData%ID__L) + UB(1:1) = ubound(SrcParamData%ID__L) + if (.not. allocated(DstParamData%ID__L)) then + allocate(DstParamData%ID__L(LB(1):UB(1)), 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 + end if + if (allocated(SrcParamData%ID__F)) then + LB(1:1) = lbound(SrcParamData%ID__F) + UB(1:1) = ubound(SrcParamData%ID__F) + if (.not. allocated(DstParamData%ID__F)) then + allocate(DstParamData%ID__F(LB(1):UB(1)), 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 + end if + 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 + LB(1:1) = lbound(SrcParamData%MoutLst) + UB(1:1) = ubound(SrcParamData%MoutLst) + if (.not. allocated(DstParamData%MoutLst)) then + allocate(DstParamData%MoutLst(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%MoutLst.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call SD_CopyMeshAuxDataType(SrcParamData%MoutLst(i1), DstParamData%MoutLst(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcParamData%MoutLst2)) then + LB(1:1) = lbound(SrcParamData%MoutLst2) + UB(1:1) = ubound(SrcParamData%MoutLst2) + if (.not. allocated(DstParamData%MoutLst2)) then + allocate(DstParamData%MoutLst2(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%MoutLst2.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call SD_CopyMeshAuxDataType(SrcParamData%MoutLst2(i1), DstParamData%MoutLst2(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcParamData%MoutLst3)) then + LB(1:1) = lbound(SrcParamData%MoutLst3) + UB(1:1) = ubound(SrcParamData%MoutLst3) + if (.not. allocated(DstParamData%MoutLst3)) then + allocate(DstParamData%MoutLst3(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%MoutLst3.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call SD_CopyMeshAuxDataType(SrcParamData%MoutLst3(i1), DstParamData%MoutLst3(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcParamData%OutParam)) then + LB(1:1) = lbound(SrcParamData%OutParam) + UB(1:1) = ubound(SrcParamData%OutParam) + if (.not. allocated(DstParamData%OutParam)) then + allocate(DstParamData%OutParam(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutParam.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyOutParmType(SrcParamData%OutParam(i1), DstParamData%OutParam(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + DstParamData%OutAll = SrcParamData%OutAll + DstParamData%OutCBModes = SrcParamData%OutCBModes + DstParamData%OutFEMModes = SrcParamData%OutFEMModes + DstParamData%OutReact = SrcParamData%OutReact + DstParamData%OutAllInt = SrcParamData%OutAllInt + DstParamData%OutAllDims = SrcParamData%OutAllDims + DstParamData%OutDec = SrcParamData%OutDec + if (allocated(SrcParamData%Jac_u_indx)) then + LB(1:2) = lbound(SrcParamData%Jac_u_indx) + UB(1:2) = ubound(SrcParamData%Jac_u_indx) + if (.not. allocated(DstParamData%Jac_u_indx)) then + allocate(DstParamData%Jac_u_indx(LB(1):UB(1),LB(2):UB(2)), 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 + end if + if (allocated(SrcParamData%du)) then + LB(1:1) = lbound(SrcParamData%du) + UB(1:1) = ubound(SrcParamData%du) + if (.not. allocated(DstParamData%du)) then + allocate(DstParamData%du(LB(1):UB(1)), 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 + end if + DstParamData%dx = SrcParamData%dx + DstParamData%Jac_ny = SrcParamData%Jac_ny + DstParamData%Jac_nx = SrcParamData%Jac_nx + DstParamData%RotStates = SrcParamData%RotStates +end subroutine + +subroutine SD_DestroyParam(ParamData, ErrStat, ErrMsg) + type(SD_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SD_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ParamData%Elems)) then + deallocate(ParamData%Elems) + end if + if (allocated(ParamData%ElemProps)) then + LB(1:1) = lbound(ParamData%ElemProps) + UB(1:1) = ubound(ParamData%ElemProps) + do i1 = LB(1), UB(1) + call SD_DestroyElemPropType(ParamData%ElemProps(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%ElemProps) + end if + if (allocated(ParamData%FC)) then + deallocate(ParamData%FC) + end if + if (allocated(ParamData%FG)) then + deallocate(ParamData%FG) + end if + if (allocated(ParamData%DP0)) then + deallocate(ParamData%DP0) + end if + if (allocated(ParamData%rPG)) then + deallocate(ParamData%rPG) + end if + if (allocated(ParamData%NodeID2JointID)) then + deallocate(ParamData%NodeID2JointID) + end if + if (allocated(ParamData%CMassNode)) then + deallocate(ParamData%CMassNode) + end if + if (allocated(ParamData%CMassWeight)) then + deallocate(ParamData%CMassWeight) + end if + if (allocated(ParamData%CMassOffset)) then + deallocate(ParamData%CMassOffset) + end if + if (allocated(ParamData%T_red)) then + deallocate(ParamData%T_red) + end if + if (allocated(ParamData%T_red_T)) then + deallocate(ParamData%T_red_T) + end if + if (allocated(ParamData%NodesDOF)) then + LB(1:1) = lbound(ParamData%NodesDOF) + UB(1:1) = ubound(ParamData%NodesDOF) + do i1 = LB(1), UB(1) + call SD_DestroyIList(ParamData%NodesDOF(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%NodesDOF) + end if + if (allocated(ParamData%NodesDOFred)) then + LB(1:1) = lbound(ParamData%NodesDOFred) + UB(1:1) = ubound(ParamData%NodesDOFred) + do i1 = LB(1), UB(1) + call SD_DestroyIList(ParamData%NodesDOFred(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%NodesDOFred) + end if + if (allocated(ParamData%ElemsDOF)) then + deallocate(ParamData%ElemsDOF) + end if + if (allocated(ParamData%DOFred2Nodes)) then + deallocate(ParamData%DOFred2Nodes) + end if + if (allocated(ParamData%CtrlElem2Channel)) then + deallocate(ParamData%CtrlElem2Channel) + end if + if (allocated(ParamData%KMMDiag)) then + deallocate(ParamData%KMMDiag) + end if + if (allocated(ParamData%CMMDiag)) then + deallocate(ParamData%CMMDiag) + end if + if (allocated(ParamData%MMB)) then + deallocate(ParamData%MMB) + end if + if (allocated(ParamData%MBmmB)) then + deallocate(ParamData%MBmmB) + end if + if (allocated(ParamData%C1_11)) then + deallocate(ParamData%C1_11) + end if + if (allocated(ParamData%C1_12)) then + deallocate(ParamData%C1_12) + end if + if (allocated(ParamData%D1_141)) then + deallocate(ParamData%D1_141) + end if + if (allocated(ParamData%D1_142)) then + deallocate(ParamData%D1_142) + end if + if (allocated(ParamData%PhiM)) then + deallocate(ParamData%PhiM) + end if + if (allocated(ParamData%C2_61)) then + deallocate(ParamData%C2_61) + end if + if (allocated(ParamData%C2_62)) then + deallocate(ParamData%C2_62) + end if + if (allocated(ParamData%PhiRb_TI)) then + deallocate(ParamData%PhiRb_TI) + end if + if (allocated(ParamData%D2_63)) then + deallocate(ParamData%D2_63) + end if + if (allocated(ParamData%D2_64)) then + deallocate(ParamData%D2_64) + end if + if (allocated(ParamData%MBB)) then + deallocate(ParamData%MBB) + end if + if (allocated(ParamData%KBB)) then + deallocate(ParamData%KBB) + end if + if (allocated(ParamData%CBB)) then + deallocate(ParamData%CBB) + end if + if (allocated(ParamData%CMM)) then + deallocate(ParamData%CMM) + end if + if (allocated(ParamData%MBM)) then + deallocate(ParamData%MBM) + end if + if (allocated(ParamData%PhiL_T)) then + deallocate(ParamData%PhiL_T) + end if + if (allocated(ParamData%PhiLInvOmgL2)) then + deallocate(ParamData%PhiLInvOmgL2) + end if + if (allocated(ParamData%KLLm1)) then + deallocate(ParamData%KLLm1) + end if + if (allocated(ParamData%AM2Jac)) then + deallocate(ParamData%AM2Jac) + end if + if (allocated(ParamData%AM2JacPiv)) then + deallocate(ParamData%AM2JacPiv) + end if + if (allocated(ParamData%TI)) then + deallocate(ParamData%TI) + end if + if (allocated(ParamData%TIreact)) then + deallocate(ParamData%TIreact) + end if + if (allocated(ParamData%Nodes_I)) then + deallocate(ParamData%Nodes_I) + end if + if (allocated(ParamData%Nodes_L)) then + deallocate(ParamData%Nodes_L) + end if + if (allocated(ParamData%Nodes_C)) then + deallocate(ParamData%Nodes_C) + end if + if (allocated(ParamData%IDI__)) then + deallocate(ParamData%IDI__) + end if + if (allocated(ParamData%IDI_Rb)) then + deallocate(ParamData%IDI_Rb) + end if + if (allocated(ParamData%IDI_F)) then + deallocate(ParamData%IDI_F) + end if + if (allocated(ParamData%IDL_L)) then + deallocate(ParamData%IDL_L) + end if + if (allocated(ParamData%IDC__)) then + deallocate(ParamData%IDC__) + end if + if (allocated(ParamData%IDC_Rb)) then + deallocate(ParamData%IDC_Rb) + end if + if (allocated(ParamData%IDC_L)) then + deallocate(ParamData%IDC_L) + end if + if (allocated(ParamData%IDC_F)) then + deallocate(ParamData%IDC_F) + end if + if (allocated(ParamData%IDR__)) then + deallocate(ParamData%IDR__) + end if + if (allocated(ParamData%ID__Rb)) then + deallocate(ParamData%ID__Rb) + end if + if (allocated(ParamData%ID__L)) then + deallocate(ParamData%ID__L) + end if + if (allocated(ParamData%ID__F)) then + deallocate(ParamData%ID__F) + end if + if (allocated(ParamData%MoutLst)) then + LB(1:1) = lbound(ParamData%MoutLst) + UB(1:1) = ubound(ParamData%MoutLst) + do i1 = LB(1), UB(1) + call SD_DestroyMeshAuxDataType(ParamData%MoutLst(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%MoutLst) + end if + if (allocated(ParamData%MoutLst2)) then + LB(1:1) = lbound(ParamData%MoutLst2) + UB(1:1) = ubound(ParamData%MoutLst2) + do i1 = LB(1), UB(1) + call SD_DestroyMeshAuxDataType(ParamData%MoutLst2(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%MoutLst2) + end if + if (allocated(ParamData%MoutLst3)) then + LB(1:1) = lbound(ParamData%MoutLst3) + UB(1:1) = ubound(ParamData%MoutLst3) + do i1 = LB(1), UB(1) + call SD_DestroyMeshAuxDataType(ParamData%MoutLst3(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%MoutLst3) + end if + if (allocated(ParamData%OutParam)) then + LB(1:1) = lbound(ParamData%OutParam) + UB(1:1) = ubound(ParamData%OutParam) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyOutParmType(ParamData%OutParam(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%OutParam) + end if + if (allocated(ParamData%Jac_u_indx)) then + deallocate(ParamData%Jac_u_indx) + end if + if (allocated(ParamData%du)) then + deallocate(ParamData%du) + end if +end subroutine + +subroutine SD_PackParam(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SD_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SD_PackParam' + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%g) + call RegPack(RF, InData%SDDeltaT) + call RegPack(RF, InData%IntMethod) + call RegPack(RF, InData%nDOF) + call RegPack(RF, InData%nDOF_red) + call RegPack(RF, InData%Nmembers) + call RegPackAlloc(RF, InData%Elems) + call RegPack(RF, allocated(InData%ElemProps)) + if (allocated(InData%ElemProps)) then + call RegPackBounds(RF, 1, lbound(InData%ElemProps), ubound(InData%ElemProps)) + LB(1:1) = lbound(InData%ElemProps) + UB(1:1) = ubound(InData%ElemProps) + do i1 = LB(1), UB(1) + call SD_PackElemPropType(RF, InData%ElemProps(i1)) + end do + end if + call RegPackAlloc(RF, InData%FC) + call RegPackAlloc(RF, InData%FG) + call RegPackAlloc(RF, InData%DP0) + call RegPackAlloc(RF, InData%rPG) + call RegPackAlloc(RF, InData%NodeID2JointID) + call RegPackAlloc(RF, InData%CMassNode) + call RegPackAlloc(RF, InData%CMassWeight) + call RegPackAlloc(RF, InData%CMassOffset) + call RegPack(RF, InData%reduced) + call RegPackAlloc(RF, InData%T_red) + call RegPackAlloc(RF, InData%T_red_T) + call RegPack(RF, allocated(InData%NodesDOF)) + if (allocated(InData%NodesDOF)) then + call RegPackBounds(RF, 1, lbound(InData%NodesDOF), ubound(InData%NodesDOF)) + LB(1:1) = lbound(InData%NodesDOF) + UB(1:1) = ubound(InData%NodesDOF) + do i1 = LB(1), UB(1) + call SD_PackIList(RF, InData%NodesDOF(i1)) + end do + end if + call RegPack(RF, allocated(InData%NodesDOFred)) + if (allocated(InData%NodesDOFred)) then + call RegPackBounds(RF, 1, lbound(InData%NodesDOFred), ubound(InData%NodesDOFred)) + LB(1:1) = lbound(InData%NodesDOFred) + UB(1:1) = ubound(InData%NodesDOFred) + do i1 = LB(1), UB(1) + call SD_PackIList(RF, InData%NodesDOFred(i1)) + end do + end if + call RegPackAlloc(RF, InData%ElemsDOF) + call RegPackAlloc(RF, InData%DOFred2Nodes) + call RegPackAlloc(RF, InData%CtrlElem2Channel) + call RegPack(RF, InData%nDOFM) + call RegPack(RF, InData%SttcSolve) + call RegPack(RF, InData%GuyanLoadCorrection) + call RegPack(RF, InData%Floating) + call RegPackAlloc(RF, InData%KMMDiag) + call RegPackAlloc(RF, InData%CMMDiag) + call RegPackAlloc(RF, InData%MMB) + call RegPackAlloc(RF, InData%MBmmB) + call RegPackAlloc(RF, InData%C1_11) + call RegPackAlloc(RF, InData%C1_12) + call RegPackAlloc(RF, InData%D1_141) + call RegPackAlloc(RF, InData%D1_142) + call RegPackAlloc(RF, InData%PhiM) + call RegPackAlloc(RF, InData%C2_61) + call RegPackAlloc(RF, InData%C2_62) + call RegPackAlloc(RF, InData%PhiRb_TI) + call RegPackAlloc(RF, InData%D2_63) + call RegPackAlloc(RF, InData%D2_64) + call RegPackAlloc(RF, InData%MBB) + call RegPackAlloc(RF, InData%KBB) + call RegPackAlloc(RF, InData%CBB) + call RegPackAlloc(RF, InData%CMM) + call RegPackAlloc(RF, InData%MBM) + call RegPackAlloc(RF, InData%PhiL_T) + call RegPackAlloc(RF, InData%PhiLInvOmgL2) + call RegPackAlloc(RF, InData%KLLm1) + call RegPackAlloc(RF, InData%AM2Jac) + call RegPackAlloc(RF, InData%AM2JacPiv) + call RegPackAlloc(RF, InData%TI) + call RegPackAlloc(RF, InData%TIreact) + call RegPack(RF, InData%nNodes) + call RegPack(RF, InData%nNodes_I) + call RegPack(RF, InData%nNodes_L) + call RegPack(RF, InData%nNodes_C) + call RegPackAlloc(RF, InData%Nodes_I) + call RegPackAlloc(RF, InData%Nodes_L) + call RegPackAlloc(RF, InData%Nodes_C) + call RegPack(RF, InData%nDOFI__) + call RegPack(RF, InData%nDOFI_Rb) + call RegPack(RF, InData%nDOFI_F) + call RegPack(RF, InData%nDOFL_L) + call RegPack(RF, InData%nDOFC__) + call RegPack(RF, InData%nDOFC_Rb) + call RegPack(RF, InData%nDOFC_L) + call RegPack(RF, InData%nDOFC_F) + call RegPack(RF, InData%nDOFR__) + call RegPack(RF, InData%nDOF__Rb) + call RegPack(RF, InData%nDOF__L) + call RegPack(RF, InData%nDOF__F) + call RegPackAlloc(RF, InData%IDI__) + call RegPackAlloc(RF, InData%IDI_Rb) + call RegPackAlloc(RF, InData%IDI_F) + call RegPackAlloc(RF, InData%IDL_L) + call RegPackAlloc(RF, InData%IDC__) + call RegPackAlloc(RF, InData%IDC_Rb) + call RegPackAlloc(RF, InData%IDC_L) + call RegPackAlloc(RF, InData%IDC_F) + call RegPackAlloc(RF, InData%IDR__) + call RegPackAlloc(RF, InData%ID__Rb) + call RegPackAlloc(RF, InData%ID__L) + call RegPackAlloc(RF, InData%ID__F) + call RegPack(RF, InData%NMOutputs) + call RegPack(RF, InData%NumOuts) + call RegPack(RF, InData%OutSwtch) + call RegPack(RF, InData%UnJckF) + call RegPack(RF, InData%Delim) + call RegPack(RF, InData%OutFmt) + call RegPack(RF, InData%OutSFmt) + call RegPack(RF, allocated(InData%MoutLst)) + if (allocated(InData%MoutLst)) then + call RegPackBounds(RF, 1, lbound(InData%MoutLst), ubound(InData%MoutLst)) + LB(1:1) = lbound(InData%MoutLst) + UB(1:1) = ubound(InData%MoutLst) + do i1 = LB(1), UB(1) + call SD_PackMeshAuxDataType(RF, InData%MoutLst(i1)) + end do + end if + call RegPack(RF, allocated(InData%MoutLst2)) + if (allocated(InData%MoutLst2)) then + call RegPackBounds(RF, 1, lbound(InData%MoutLst2), ubound(InData%MoutLst2)) + LB(1:1) = lbound(InData%MoutLst2) + UB(1:1) = ubound(InData%MoutLst2) + do i1 = LB(1), UB(1) + call SD_PackMeshAuxDataType(RF, InData%MoutLst2(i1)) + end do + end if + call RegPack(RF, allocated(InData%MoutLst3)) + if (allocated(InData%MoutLst3)) then + call RegPackBounds(RF, 1, lbound(InData%MoutLst3), ubound(InData%MoutLst3)) + LB(1:1) = lbound(InData%MoutLst3) + UB(1:1) = ubound(InData%MoutLst3) + do i1 = LB(1), UB(1) + call SD_PackMeshAuxDataType(RF, InData%MoutLst3(i1)) + end do + end if + call RegPack(RF, allocated(InData%OutParam)) + if (allocated(InData%OutParam)) then + call RegPackBounds(RF, 1, lbound(InData%OutParam), ubound(InData%OutParam)) + LB(1:1) = lbound(InData%OutParam) + UB(1:1) = ubound(InData%OutParam) + do i1 = LB(1), UB(1) + call NWTC_Library_PackOutParmType(RF, InData%OutParam(i1)) + end do + end if + call RegPack(RF, InData%OutAll) + call RegPack(RF, InData%OutCBModes) + call RegPack(RF, InData%OutFEMModes) + call RegPack(RF, InData%OutReact) + call RegPack(RF, InData%OutAllInt) + call RegPack(RF, InData%OutAllDims) + call RegPack(RF, InData%OutDec) + call RegPackAlloc(RF, InData%Jac_u_indx) + call RegPackAlloc(RF, InData%du) + call RegPack(RF, InData%dx) + call RegPack(RF, InData%Jac_ny) + call RegPack(RF, InData%Jac_nx) + call RegPack(RF, InData%RotStates) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SD_UnPackParam(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SD_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SD_UnPackParam' + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%g); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SDDeltaT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%IntMethod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nDOF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nDOF_red); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Nmembers); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Elems); if (RegCheckErr(RF, RoutineName)) return + if (allocated(OutData%ElemProps)) deallocate(OutData%ElemProps) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%ElemProps(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ElemProps.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SD_UnpackElemPropType(RF, OutData%ElemProps(i1)) ! ElemProps + end do + end if + call RegUnpackAlloc(RF, OutData%FC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%FG); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%DP0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%rPG); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%NodeID2JointID); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%CMassNode); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%CMassWeight); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%CMassOffset); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%reduced); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%T_red); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%T_red_T); if (RegCheckErr(RF, RoutineName)) return + if (allocated(OutData%NodesDOF)) deallocate(OutData%NodesDOF) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%NodesDOF(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NodesDOF.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SD_UnpackIList(RF, OutData%NodesDOF(i1)) ! NodesDOF + end do + end if + if (allocated(OutData%NodesDOFred)) deallocate(OutData%NodesDOFred) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%NodesDOFred(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NodesDOFred.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SD_UnpackIList(RF, OutData%NodesDOFred(i1)) ! NodesDOFred + end do + end if + call RegUnpackAlloc(RF, OutData%ElemsDOF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%DOFred2Nodes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%CtrlElem2Channel); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nDOFM); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SttcSolve); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GuyanLoadCorrection); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Floating); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%KMMDiag); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%CMMDiag); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%MMB); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%MBmmB); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%C1_11); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%C1_12); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%D1_141); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%D1_142); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PhiM); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%C2_61); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%C2_62); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PhiRb_TI); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%D2_63); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%D2_64); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%MBB); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%KBB); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%CBB); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%CMM); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%MBM); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PhiL_T); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PhiLInvOmgL2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%KLLm1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AM2Jac); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AM2JacPiv); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TI); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TIreact); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nNodes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nNodes_I); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nNodes_L); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nNodes_C); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Nodes_I); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Nodes_L); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Nodes_C); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nDOFI__); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nDOFI_Rb); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nDOFI_F); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nDOFL_L); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nDOFC__); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nDOFC_Rb); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nDOFC_L); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nDOFC_F); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nDOFR__); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nDOF__Rb); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nDOF__L); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nDOF__F); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%IDI__); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%IDI_Rb); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%IDI_F); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%IDL_L); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%IDC__); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%IDC_Rb); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%IDC_L); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%IDC_F); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%IDR__); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ID__Rb); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ID__L); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ID__F); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NMOutputs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumOuts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutSwtch); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UnJckF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Delim); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutFmt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutSFmt); if (RegCheckErr(RF, RoutineName)) return + if (allocated(OutData%MoutLst)) deallocate(OutData%MoutLst) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%MoutLst(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MoutLst.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SD_UnpackMeshAuxDataType(RF, OutData%MoutLst(i1)) ! MoutLst + end do + end if + if (allocated(OutData%MoutLst2)) deallocate(OutData%MoutLst2) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%MoutLst2(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MoutLst2.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SD_UnpackMeshAuxDataType(RF, OutData%MoutLst2(i1)) ! MoutLst2 + end do + end if + if (allocated(OutData%MoutLst3)) deallocate(OutData%MoutLst3) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%MoutLst3(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MoutLst3.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SD_UnpackMeshAuxDataType(RF, OutData%MoutLst3(i1)) ! MoutLst3 + end do + end if + if (allocated(OutData%OutParam)) deallocate(OutData%OutParam) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%OutParam(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackOutParmType(RF, OutData%OutParam(i1)) ! OutParam + end do + end if + call RegUnpack(RF, OutData%OutAll); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutCBModes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutFEMModes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutReact); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutAllInt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutAllDims); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutDec); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Jac_u_indx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%du); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%dx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Jac_ny); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Jac_nx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RotStates); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +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 + integer(B4Ki) :: LB(1), UB(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 + LB(1:1) = lbound(SrcInputData%CableDeltaL) + UB(1:1) = ubound(SrcInputData%CableDeltaL) + if (.not. allocated(DstInputData%CableDeltaL)) then + allocate(DstInputData%CableDeltaL(LB(1):UB(1)), 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 + end if +end subroutine + +subroutine SD_DestroyInput(InputData, ErrStat, ErrMsg) + type(SD_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SD_DestroyInput' + ErrStat = ErrID_None + ErrMsg = '' + call MeshDestroy( InputData%TPMesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( InputData%LMesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(InputData%CableDeltaL)) then + deallocate(InputData%CableDeltaL) + end if +end subroutine + +subroutine SD_PackInput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SD_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SD_PackInput' + if (RF%ErrStat >= AbortErrLev) return + call MeshPack(RF, InData%TPMesh) + call MeshPack(RF, InData%LMesh) + call RegPackAlloc(RF, InData%CableDeltaL) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SD_UnPackInput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SD_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SD_UnPackInput' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call MeshUnpack(RF, OutData%TPMesh) ! TPMesh + call MeshUnpack(RF, OutData%LMesh) ! LMesh + call RegUnpackAlloc(RF, OutData%CableDeltaL); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +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 + integer(B4Ki) :: LB(1), UB(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 + call MeshCopy(SrcOutputData%Y3Mesh, DstOutputData%Y3Mesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcOutputData%WriteOutput)) then + LB(1:1) = lbound(SrcOutputData%WriteOutput) + UB(1:1) = ubound(SrcOutputData%WriteOutput) + if (.not. allocated(DstOutputData%WriteOutput)) then + allocate(DstOutputData%WriteOutput(LB(1):UB(1)), 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 + end if +end subroutine + +subroutine SD_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(SD_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SD_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' + call MeshDestroy( OutputData%Y1Mesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( OutputData%Y2Mesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( OutputData%Y3Mesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(OutputData%WriteOutput)) then + deallocate(OutputData%WriteOutput) + end if +end subroutine + +subroutine SD_PackOutput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SD_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SD_PackOutput' + if (RF%ErrStat >= AbortErrLev) return + call MeshPack(RF, InData%Y1Mesh) + call MeshPack(RF, InData%Y2Mesh) + call MeshPack(RF, InData%Y3Mesh) + call RegPackAlloc(RF, InData%WriteOutput) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SD_UnPackOutput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SD_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SD_UnPackOutput' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call MeshUnpack(RF, OutData%Y1Mesh) ! Y1Mesh + call MeshUnpack(RF, OutData%Y2Mesh) ! Y2Mesh + call MeshUnpack(RF, OutData%Y3Mesh) ! Y3Mesh + call RegUnpackAlloc(RF, OutData%WriteOutput); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +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 ) + 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) /= size(u)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(u)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(u) - 1 + select case (order) + case (0) + call SD_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call SD_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call SD_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(u) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +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. @@ -12817,51 +4234,49 @@ SUBROUTINE SD_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) ! !.................................................................................................................................. - 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 + 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 + 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) :: a1, a2 ! 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 ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = 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 + u_out%CableDeltaL = a1*u1%CableDeltaL + a2*u2%CableDeltaL + END IF ! check if allocated +END SUBROUTINE + +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. @@ -12875,112 +4290,109 @@ SUBROUTINE SD_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrM ! !.................................................................................................................................. - 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 + 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) - + 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) :: a1,a2,a3 ! 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 + 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 + 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 + 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 + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + 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 + u_out%CableDeltaL = a1*u1%CableDeltaL + a2*u2%CableDeltaL + a3*u3%CableDeltaL + END IF ! check if allocated +END SUBROUTINE + +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 ) + 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) /= size(y)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(y)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(y) - 1 + select case (order) + case (0) + call SD_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call SD_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call SD_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(y) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +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. @@ -12992,53 +4404,51 @@ SUBROUTINE SD_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ! !.................................................................................................................................. - 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 + 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 + 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) :: a1, a2 ! 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) - CALL MeshExtrapInterp1(y1%Y3Mesh, y2%Y3Mesh, tin, y_out%Y3Mesh, 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 ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = 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) + CALL MeshExtrapInterp1(y1%Y3Mesh, y2%Y3Mesh, tin, y_out%Y3Mesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + END IF ! check if allocated +END SUBROUTINE + +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. @@ -13052,60 +4462,56 @@ SUBROUTINE SD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Err ! !.................................................................................................................................. - 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 + 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) - + 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) :: a1,a2,a3 ! 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 + 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 + 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 + 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) - CALL MeshExtrapInterp2(y1%Y3Mesh, y2%Y3Mesh, y3%Y3Mesh, tin, y_out%Y3Mesh, 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 - + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + 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) + CALL MeshExtrapInterp2(y1%Y3Mesh, y2%Y3Mesh, y3%Y3Mesh, tin, y_out%Y3Mesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + a3*y3%WriteOutput + END IF ! check if allocated +END SUBROUTINE END MODULE SubDyn_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/supercontroller/CMakeLists.txt b/modules/supercontroller/CMakeLists.txt index 6c9323af6d..4d81ea6695 100644 --- a/modules/supercontroller/CMakeLists.txt +++ b/modules/supercontroller/CMakeLists.txt @@ -19,12 +19,12 @@ if (GENERATE_TYPES) generate_f90_types(src/SC_DataEx_Registry.txt ${CMAKE_CURRENT_LIST_DIR}/src/SCDataEx_Types.f90 -ccode -noextrap) endif() -add_library(sctypeslib +add_library(sctypeslib STATIC src/SCDataEx_Types.f90 ) target_link_libraries(sctypeslib nwtclibs) -add_library(scfastlib +add_library(scfastlib STATIC src/SC_DataEx.f90 src/SuperController_Types.f90 src/SuperController.f90 diff --git a/modules/supercontroller/src/SCDataEx_Types.f90 b/modules/supercontroller/src/SCDataEx_Types.f90 index 2a44f59489..cd6da16d1f 100644 --- a/modules/supercontroller/src/SCDataEx_Types.f90 +++ b/modules/supercontroller/src/SCDataEx_Types.f90 @@ -31,7 +31,6 @@ !! 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 ======= @@ -43,9 +42,9 @@ MODULE SCDataEx_Types 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] [-] + INTEGER(IntKi) :: NumSC2Ctrl = 0_IntKi !< number of turbine specific controller inputs [from supercontroller] [-] + INTEGER(IntKi) :: NumSC2CtrlGlob = 0_IntKi !< number of global controller inputs [from supercontroller] [-] + INTEGER(IntKi) :: NumCtrl2SC = 0_IntKi !< number of controller outputs [to supercontroller] [-] END TYPE SC_DX_InitInputType ! ======================= ! ========= SC_DX_InitOutputType_C ======= @@ -93,1229 +92,569 @@ MODULE SCDataEx_Types 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 + +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 + 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 + +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' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine SC_DX_PackInitInput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SC_DX_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SC_DX_PackInitInput' + if (RF%ErrStat >= AbortErrLev) return + if (c_associated(InData%C_obj%object)) then + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + call RegPack(RF, InData%NumSC2Ctrl) + call RegPack(RF, InData%NumSC2CtrlGlob) + call RegPack(RF, InData%NumCtrl2SC) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SC_DX_UnPackInitInput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SC_DX_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SC_DX_UnPackInitInput' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%NumSC2Ctrl); if (RegCheckErr(RF, RoutineName)) return + OutData%C_obj%NumSC2Ctrl = OutData%NumSC2Ctrl + call RegUnpack(RF, OutData%NumSC2CtrlGlob); if (RegCheckErr(RF, RoutineName)) return + OutData%C_obj%NumSC2CtrlGlob = OutData%NumSC2CtrlGlob + call RegUnpack(RF, OutData%NumCtrl2SC); if (RegCheckErr(RF, RoutineName)) return + OutData%C_obj%NumCtrl2SC = OutData%NumCtrl2SC +end subroutine + +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 -! 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' -! + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local 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, DEALLOCATEpointers ) - TYPE(SC_DX_InitInputType), INTENT(INOUT) :: InitInputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_DX_DestroyInitInput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - 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 + + 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 + +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 + +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 + 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 + +subroutine SC_DX_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(SC_DX_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SC_DX_DestroyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine SC_DX_PackInitOutput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SC_DX_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SC_DX_PackInitOutput' + if (RF%ErrStat >= AbortErrLev) return + if (c_associated(InData%C_obj%object)) then + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + call NWTC_Library_PackProgDesc(RF, InData%Ver) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SC_DX_UnPackInitOutput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SC_DX_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SC_DX_UnPackInitOutput' + if (RF%ErrStat /= ErrID_None) return + call NWTC_Library_UnpackProgDesc(RF, OutData%Ver) ! Ver +end subroutine + +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 -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_DX_CopyInitOutput' -! + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local 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, DEALLOCATEpointers ) - TYPE(SC_DX_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_DX_DestroyInitOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL NWTC_Library_Destroyprogdesc( InitOutputData%Ver, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - 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 + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF +END SUBROUTINE + +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 -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_DX_CopyParam' -! + 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 + +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 + character(*), parameter :: RoutineName = 'SC_DX_CopyParam' + ErrStat = ErrID_None + ErrMsg = '' + DstParamData%useSC = SrcParamData%useSC + DstParamData%C_obj%useSC = SrcParamData%C_obj%useSC +end subroutine + +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' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine SC_DX_PackParam(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SC_DX_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SC_DX_PackParam' + if (RF%ErrStat >= AbortErrLev) return + if (c_associated(InData%C_obj%object)) then + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + call RegPack(RF, InData%useSC) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SC_DX_UnPackParam(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SC_DX_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SC_DX_UnPackParam' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%useSC); if (RegCheckErr(RF, RoutineName)) return + OutData%C_obj%useSC = OutData%useSC +end subroutine + +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 = "" - DstParamData%useSC = SrcParamData%useSC - DstParamData%C_obj%useSC = SrcParamData%C_obj%useSC - END SUBROUTINE SC_DX_CopyParam - - SUBROUTINE SC_DX_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(SC_DX_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_DX_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - 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 + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + ParamData%useSC = ParamData%C_obj%useSC +END SUBROUTINE + +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 + +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 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'SC_DX_CopyInput' + ErrStat = ErrID_None + ErrMsg = '' + if (associated(SrcInputData%toSC)) then + LB(1:1) = lbound(SrcInputData%toSC) + UB(1:1) = ubound(SrcInputData%toSC) + if (.not. associated(DstInputData%toSC)) then + allocate(DstInputData%toSC(LB(1):UB(1)), 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(LB(1))) + end if + DstInputData%toSC = SrcInputData%toSC + end if +end subroutine + +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' + 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 + end if +end subroutine + +subroutine SC_DX_PackInput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SC_DX_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SC_DX_PackInput' + logical :: PtrInIndex + if (RF%ErrStat >= AbortErrLev) return + if (c_associated(InData%C_obj%object)) then + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + call RegPackPtr(RF, InData%toSC) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SC_DX_UnPackInput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SC_DX_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SC_DX_UnPackInput' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(B8Ki) :: PtrIdx + type(c_ptr) :: Ptr + if (RF%ErrStat /= ErrID_None) return + call RegUnpackPtr(RF, OutData%toSC, LB, UB); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%toSC)) then + OutData%C_obj%toSC_Len = size(OutData%toSC) + if (OutData%C_obj%toSC_Len > 0) OutData%C_obj%toSC = c_loc(OutData%toSC(LB(1))) + end if +end subroutine + +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 -! 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' -! + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local 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, DEALLOCATEpointers ) - TYPE(SC_DX_InputType), INTENT(INOUT) :: InputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_DX_DestroyInput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ASSOCIATED(InputData%toSC)) THEN - IF (DEALLOCATEpointers_local) & - 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 + + 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 - 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 +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 -! 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' -! + 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 + +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 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'SC_DX_CopyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (associated(SrcOutputData%fromSC)) then + LB(1:1) = lbound(SrcOutputData%fromSC) + UB(1:1) = ubound(SrcOutputData%fromSC) + if (.not. associated(DstOutputData%fromSC)) then + allocate(DstOutputData%fromSC(LB(1):UB(1)), 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(LB(1))) + end if + DstOutputData%fromSC = SrcOutputData%fromSC + end if + if (associated(SrcOutputData%fromSCglob)) then + LB(1:1) = lbound(SrcOutputData%fromSCglob) + UB(1:1) = ubound(SrcOutputData%fromSCglob) + if (.not. associated(DstOutputData%fromSCglob)) then + allocate(DstOutputData%fromSCglob(LB(1):UB(1)), 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(LB(1))) + end if + DstOutputData%fromSCglob = SrcOutputData%fromSCglob + end if +end subroutine + +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' + 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 + end if + if (associated(OutputData%fromSCglob)) then + deallocate(OutputData%fromSCglob) + OutputData%fromSCglob => null() + OutputData%C_obj%fromSCglob = c_null_ptr + OutputData%C_obj%fromSCglob_Len = 0 + end if +end subroutine + +subroutine SC_DX_PackOutput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SC_DX_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SC_DX_PackOutput' + logical :: PtrInIndex + if (RF%ErrStat >= AbortErrLev) return + if (c_associated(InData%C_obj%object)) then + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + call RegPackPtr(RF, InData%fromSC) + call RegPackPtr(RF, InData%fromSCglob) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SC_DX_UnPackOutput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SC_DX_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SC_DX_UnPackOutput' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(B8Ki) :: PtrIdx + type(c_ptr) :: Ptr + if (RF%ErrStat /= ErrID_None) return + call RegUnpackPtr(RF, OutData%fromSC, LB, UB); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%fromSC)) then + OutData%C_obj%fromSC_Len = size(OutData%fromSC) + if (OutData%C_obj%fromSC_Len > 0) OutData%C_obj%fromSC = c_loc(OutData%fromSC(LB(1))) + end if + call RegUnpackPtr(RF, OutData%fromSCglob, LB, UB); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%fromSCglob)) then + OutData%C_obj%fromSCglob_Len = size(OutData%fromSCglob) + if (OutData%C_obj%fromSCglob_Len > 0) OutData%C_obj%fromSCglob = c_loc(OutData%fromSCglob(LB(1))) + end if +end subroutine + +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 (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, DEALLOCATEpointers ) - TYPE(SC_DX_OutputType), INTENT(INOUT) :: OutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_DX_DestroyOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ASSOCIATED(OutputData%fromSC)) THEN - IF (DEALLOCATEpointers_local) & - 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 - IF (DEALLOCATEpointers_local) & - 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 + + 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 +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 END MODULE SCDataEx_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/supercontroller/src/SCDataEx_Types.h b/modules/supercontroller/src/SCDataEx_Types.h index 8be949b34c..fc9335b345 100644 --- a/modules/supercontroller/src/SCDataEx_Types.h +++ b/modules/supercontroller/src/SCDataEx_Types.h @@ -7,51 +7,52 @@ #ifndef _SCDataEx_TYPES_H #define _SCDataEx_TYPES_H - #ifdef _WIN32 //define something for Windows (32-bit) -# include "stdbool.h" -# define CALL __declspec( dllexport ) + #include "stdbool.h" + #define CALL __declspec(dllexport) #elif _WIN64 //define something for Windows (64-bit) -# include "stdbool.h" -# define CALL __declspec( dllexport ) + #include "stdbool.h" + #define CALL __declspec(dllexport) #else -# include -# define CALL + #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 ; +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/modules/supercontroller/src/SuperController_Types.f90 b/modules/supercontroller/src/SuperController_Types.f90 index 10ae1505c9..b811ad3465 100644 --- a/modules/supercontroller/src/SuperController_Types.f90 +++ b/modules/supercontroller/src/SuperController_Types.f90 @@ -31,7 +31,6 @@ !! 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 ======= @@ -42,7 +41,7 @@ MODULE SuperController_Types END TYPE SC_InitInputType_C TYPE, PUBLIC :: SC_InitInputType TYPE( SC_InitInputType_C ) :: C_obj - INTEGER(IntKi) :: nTurbines !< Number of turbines in the simulation [-] + INTEGER(IntKi) :: nTurbines = 0_IntKi !< Number of turbines in the simulation [-] CHARACTER(1024) :: DLL_FileName !< Name of the shared library which the super controller logic [-] END TYPE SC_InitInputType ! ======================= @@ -57,10 +56,10 @@ MODULE SuperController_Types 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] [-] + INTEGER(IntKi) :: NumCtrl2SC = 0_IntKi !< Number of turbine controller outputs [to supercontroller] [-] + INTEGER(IntKi) :: nInpGlobal = 0_IntKi !< Number of global inputs to SC [-] + INTEGER(IntKi) :: NumSC2Ctrl = 0_IntKi !< Number of turbine specific controller inputs [from supercontroller] [-] + INTEGER(IntKi) :: NumSC2CtrlGlob = 0_IntKi !< Number of global controller inputs [from supercontroller] [-] END TYPE SC_InitOutputType ! ======================= ! ========= SC_ParameterType_C ======= @@ -83,16 +82,16 @@ MODULE SuperController_Types 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(DbKi) :: DT = 0.0_R8Ki !< Time step for continuous state integration & discrete state update [secondstypedef] + INTEGER(IntKi) :: nTurbines = 0_IntKi !< Number of turbines in the simulation [-] + INTEGER(IntKi) :: NumCtrl2SC = 0_IntKi !< Number of turbine controller outputs [to supercontroller] [-] + INTEGER(IntKi) :: nInpGlobal = 0_IntKi !< Number of global inputs [-] + INTEGER(IntKi) :: NumSC2Ctrl = 0_IntKi !< Number of turbine specific controller inputs [from supercontroller] [-] + INTEGER(IntKi) :: NumSC2CtrlGlob = 0_IntKi !< Number of global controller inputs [from supercontroller] [-] + INTEGER(IntKi) :: NumStatesGlobal = 0_IntKi !< Number of global states [-] + INTEGER(IntKi) :: NumStatesTurbine = 0_IntKi !< Number of states per turbine [-] + INTEGER(IntKi) :: NumParamGlobal = 0_IntKi !< Number of global parameters [-] + INTEGER(IntKi) :: NumParamTurbine = 0_IntKi !< 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 [-] @@ -119,7 +118,7 @@ MODULE SuperController_Types 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 [-] + REAL(SiKi) :: Dummy = 0.0_R4Ki !< Remove this variable if you have continuous states [-] END TYPE SC_ContinuousStateType ! ======================= ! ========= SC_ConstraintStateType_C ======= @@ -129,7 +128,7 @@ MODULE SuperController_Types 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 [-] + REAL(SiKi) :: Dummy = 0.0_R4Ki !< Remove this variable if you have constraint states [-] END TYPE SC_ConstraintStateType ! ======================= ! ========= SC_MiscVarType_C ======= @@ -139,7 +138,7 @@ MODULE SuperController_Types 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 [-] + REAL(SiKi) :: Dummy = 0.0_R4Ki !< Remove this variable if you have misc vars [-] END TYPE SC_MiscVarType ! ======================= ! ========= SC_OtherStateType_C ======= @@ -149,7 +148,7 @@ MODULE SuperController_Types END TYPE SC_OtherStateType_C TYPE, PUBLIC :: SC_OtherStateType TYPE( SC_OtherStateType_C ) :: C_obj - INTEGER(IntKi) :: Dummy !< Dummy Other State [-] + INTEGER(IntKi) :: Dummy = 0_IntKi !< Dummy Other State [-] END TYPE SC_OtherStateType ! ======================= ! ========= SC_InputType_C ======= @@ -181,2795 +180,1365 @@ MODULE SuperController_Types 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 + +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 + 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 + +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' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine SC_PackInitInput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SC_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SC_PackInitInput' + if (RF%ErrStat >= AbortErrLev) return + if (c_associated(InData%C_obj%object)) then + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + call RegPack(RF, InData%nTurbines) + call RegPack(RF, InData%DLL_FileName) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SC_UnPackInitInput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SC_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SC_UnPackInitInput' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%nTurbines); if (RegCheckErr(RF, RoutineName)) return + OutData%C_obj%nTurbines = OutData%nTurbines + call RegUnpack(RF, OutData%DLL_FileName); if (RegCheckErr(RF, RoutineName)) return + OutData%C_obj%DLL_FileName = transfer(OutData%DLL_FileName, OutData%C_obj%DLL_FileName ) +end subroutine + +SUBROUTINE SC_C2Fary_CopyInitInput(InitInputData, ErrStat, ErrMsg, SkipPointers) + TYPE(SC_InitInputType), INTENT(INOUT) :: InitInputData 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' -! + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local 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, DEALLOCATEpointers ) - TYPE(SC_InitInputType), INTENT(INOUT) :: InitInputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_DestroyInitInput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - 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 + + 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 + +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 + +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 + 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 + +subroutine SC_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(SC_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SC_DestroyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine SC_PackInitOutput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SC_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SC_PackInitOutput' + if (RF%ErrStat >= AbortErrLev) return + if (c_associated(InData%C_obj%object)) then + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + call NWTC_Library_PackProgDesc(RF, InData%Ver) + call RegPack(RF, InData%NumCtrl2SC) + call RegPack(RF, InData%nInpGlobal) + call RegPack(RF, InData%NumSC2Ctrl) + call RegPack(RF, InData%NumSC2CtrlGlob) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SC_UnPackInitOutput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SC_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SC_UnPackInitOutput' + if (RF%ErrStat /= ErrID_None) return + call NWTC_Library_UnpackProgDesc(RF, OutData%Ver) ! Ver + call RegUnpack(RF, OutData%NumCtrl2SC); if (RegCheckErr(RF, RoutineName)) return + OutData%C_obj%NumCtrl2SC = OutData%NumCtrl2SC + call RegUnpack(RF, OutData%nInpGlobal); if (RegCheckErr(RF, RoutineName)) return + OutData%C_obj%nInpGlobal = OutData%nInpGlobal + call RegUnpack(RF, OutData%NumSC2Ctrl); if (RegCheckErr(RF, RoutineName)) return + OutData%C_obj%NumSC2Ctrl = OutData%NumSC2Ctrl + call RegUnpack(RF, OutData%NumSC2CtrlGlob); if (RegCheckErr(RF, RoutineName)) return + OutData%C_obj%NumSC2CtrlGlob = OutData%NumSC2CtrlGlob +end subroutine + +SUBROUTINE SC_C2Fary_CopyInitOutput(InitOutputData, ErrStat, ErrMsg, SkipPointers) + TYPE(SC_InitOutputType), INTENT(INOUT) :: InitOutputData 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' -! + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local 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, DEALLOCATEpointers ) - TYPE(SC_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_DestroyInitOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL NWTC_Library_Destroyprogdesc( InitOutputData%Ver, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - 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) + + 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 + +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 + +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 + integer(B4Ki) :: LB(1), UB(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 + LB(1:1) = lbound(SrcParamData%ParamGlobal) + UB(1:1) = ubound(SrcParamData%ParamGlobal) + if (.not. associated(DstParamData%ParamGlobal)) then + allocate(DstParamData%ParamGlobal(LB(1):UB(1)), 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(LB(1))) + end if + DstParamData%ParamGlobal = SrcParamData%ParamGlobal + end if + if (associated(SrcParamData%ParamTurbine)) then + LB(1:1) = lbound(SrcParamData%ParamTurbine) + UB(1:1) = ubound(SrcParamData%ParamTurbine) + if (.not. associated(DstParamData%ParamTurbine)) then + allocate(DstParamData%ParamTurbine(LB(1):UB(1)), 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(LB(1))) + end if + DstParamData%ParamTurbine = SrcParamData%ParamTurbine + end if + DstParamData%DLL_Trgt = SrcParamData%DLL_Trgt +end subroutine + +subroutine SC_DestroyParam(ParamData, ErrStat, ErrMsg) + type(SC_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SC_DestroyParam' + 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 + end if + if (associated(ParamData%ParamTurbine)) then + deallocate(ParamData%ParamTurbine) + ParamData%ParamTurbine => null() + ParamData%C_obj%ParamTurbine = c_null_ptr + ParamData%C_obj%ParamTurbine_Len = 0 + end if + call FreeDynamicLib( ParamData%DLL_Trgt, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine SC_PackParam(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SC_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SC_PackParam' + logical :: PtrInIndex + if (RF%ErrStat >= AbortErrLev) return + if (c_associated(InData%C_obj%object)) then + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + call RegPack(RF, InData%DT) + call RegPack(RF, InData%nTurbines) + call RegPack(RF, InData%NumCtrl2SC) + call RegPack(RF, InData%nInpGlobal) + call RegPack(RF, InData%NumSC2Ctrl) + call RegPack(RF, InData%NumSC2CtrlGlob) + call RegPack(RF, InData%NumStatesGlobal) + call RegPack(RF, InData%NumStatesTurbine) + call RegPack(RF, InData%NumParamGlobal) + call RegPack(RF, InData%NumParamTurbine) + call RegPackPtr(RF, InData%ParamGlobal) + call RegPackPtr(RF, InData%ParamTurbine) + call DLLTypePack(RF, InData%DLL_Trgt) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SC_UnPackParam(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SC_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SC_UnPackParam' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(B8Ki) :: PtrIdx + type(c_ptr) :: Ptr + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DT); if (RegCheckErr(RF, RoutineName)) return + OutData%C_obj%DT = OutData%DT + call RegUnpack(RF, OutData%nTurbines); if (RegCheckErr(RF, RoutineName)) return + OutData%C_obj%nTurbines = OutData%nTurbines + call RegUnpack(RF, OutData%NumCtrl2SC); if (RegCheckErr(RF, RoutineName)) return + OutData%C_obj%NumCtrl2SC = OutData%NumCtrl2SC + call RegUnpack(RF, OutData%nInpGlobal); if (RegCheckErr(RF, RoutineName)) return + OutData%C_obj%nInpGlobal = OutData%nInpGlobal + call RegUnpack(RF, OutData%NumSC2Ctrl); if (RegCheckErr(RF, RoutineName)) return + OutData%C_obj%NumSC2Ctrl = OutData%NumSC2Ctrl + call RegUnpack(RF, OutData%NumSC2CtrlGlob); if (RegCheckErr(RF, RoutineName)) return + OutData%C_obj%NumSC2CtrlGlob = OutData%NumSC2CtrlGlob + call RegUnpack(RF, OutData%NumStatesGlobal); if (RegCheckErr(RF, RoutineName)) return + OutData%C_obj%NumStatesGlobal = OutData%NumStatesGlobal + call RegUnpack(RF, OutData%NumStatesTurbine); if (RegCheckErr(RF, RoutineName)) return + OutData%C_obj%NumStatesTurbine = OutData%NumStatesTurbine + call RegUnpack(RF, OutData%NumParamGlobal); if (RegCheckErr(RF, RoutineName)) return + OutData%C_obj%NumParamGlobal = OutData%NumParamGlobal + call RegUnpack(RF, OutData%NumParamTurbine); if (RegCheckErr(RF, RoutineName)) return + OutData%C_obj%NumParamTurbine = OutData%NumParamTurbine + call RegUnpackPtr(RF, OutData%ParamGlobal, LB, UB); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%ParamGlobal)) then + OutData%C_obj%ParamGlobal_Len = size(OutData%ParamGlobal) + if (OutData%C_obj%ParamGlobal_Len > 0) OutData%C_obj%ParamGlobal = c_loc(OutData%ParamGlobal(LB(1))) + end if + call RegUnpackPtr(RF, OutData%ParamTurbine, LB, UB); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%ParamTurbine)) then + OutData%C_obj%ParamTurbine_Len = size(OutData%ParamTurbine) + if (OutData%C_obj%ParamTurbine_Len > 0) OutData%C_obj%ParamTurbine = c_loc(OutData%ParamTurbine(LB(1))) + end if + call DLLTypeUnpack(RF, OutData%DLL_Trgt) ! DLL_Trgt +end subroutine + +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 - 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) + 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 - 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 + CALL C_F_POINTER(ParamData%C_obj%ParamTurbine, ParamData%ParamTurbine, [ParamData%C_obj%ParamTurbine_Len]) 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 +END SUBROUTINE + +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 - 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 + + ! -- 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 - 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 + END IF +END SUBROUTINE + +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 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'SC_CopyDiscState' + ErrStat = ErrID_None + ErrMsg = '' + if (associated(SrcDiscStateData%Global)) then + LB(1:1) = lbound(SrcDiscStateData%Global) + UB(1:1) = ubound(SrcDiscStateData%Global) + if (.not. associated(DstDiscStateData%Global)) then + allocate(DstDiscStateData%Global(LB(1):UB(1)), 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(LB(1))) + end if + DstDiscStateData%Global = SrcDiscStateData%Global + end if + if (associated(SrcDiscStateData%Turbine)) then + LB(1:1) = lbound(SrcDiscStateData%Turbine) + UB(1:1) = ubound(SrcDiscStateData%Turbine) + if (.not. associated(DstDiscStateData%Turbine)) then + allocate(DstDiscStateData%Turbine(LB(1):UB(1)), 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(LB(1))) + end if + DstDiscStateData%Turbine = SrcDiscStateData%Turbine + end if +end subroutine + +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' + 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 + end if + if (associated(DiscStateData%Turbine)) then + deallocate(DiscStateData%Turbine) + DiscStateData%Turbine => null() + DiscStateData%C_obj%Turbine = c_null_ptr + DiscStateData%C_obj%Turbine_Len = 0 + end if +end subroutine + +subroutine SC_PackDiscState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SC_DiscreteStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SC_PackDiscState' + logical :: PtrInIndex + if (RF%ErrStat >= AbortErrLev) return + if (c_associated(InData%C_obj%object)) then + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + call RegPackPtr(RF, InData%Global) + call RegPackPtr(RF, InData%Turbine) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SC_UnPackDiscState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SC_DiscreteStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SC_UnPackDiscState' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(B8Ki) :: PtrIdx + type(c_ptr) :: Ptr + if (RF%ErrStat /= ErrID_None) return + call RegUnpackPtr(RF, OutData%Global, LB, UB); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%Global)) then + OutData%C_obj%Global_Len = size(OutData%Global) + if (OutData%C_obj%Global_Len > 0) OutData%C_obj%Global = c_loc(OutData%Global(LB(1))) + end if + call RegUnpackPtr(RF, OutData%Turbine, LB, UB); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%Turbine)) then + OutData%C_obj%Turbine_Len = size(OutData%Turbine) + if (OutData%C_obj%Turbine_Len > 0) OutData%C_obj%Turbine = c_loc(OutData%Turbine(LB(1))) + end if +end subroutine + +SUBROUTINE SC_C2Fary_CopyDiscState(DiscStateData, ErrStat, ErrMsg, SkipPointers) + TYPE(SC_DiscreteStateType), INTENT(INOUT) :: DiscStateData 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' -! + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local 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, DEALLOCATEpointers ) - TYPE(SC_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ASSOCIATED(ParamData%ParamGlobal)) THEN - IF (DEALLOCATEpointers_local) & - 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 - IF (DEALLOCATEpointers_local) & - 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, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - 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) + + 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 - 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) + 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 - 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 + CALL C_F_POINTER(DiscStateData%C_obj%Turbine, DiscStateData%Turbine, [DiscStateData%C_obj%Turbine_Len]) 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 +END SUBROUTINE + +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 - 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 + + ! -- 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 - 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 + END IF +END SUBROUTINE + +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 + character(*), parameter :: RoutineName = 'SC_CopyContState' + ErrStat = ErrID_None + ErrMsg = '' + DstContStateData%Dummy = SrcContStateData%Dummy + DstContStateData%C_obj%Dummy = SrcContStateData%C_obj%Dummy +end subroutine + +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' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine SC_PackContState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SC_ContinuousStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SC_PackContState' + if (RF%ErrStat >= AbortErrLev) return + if (c_associated(InData%C_obj%object)) then + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + call RegPack(RF, InData%Dummy) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SC_UnPackContState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SC_ContinuousStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SC_UnPackContState' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%Dummy); if (RegCheckErr(RF, RoutineName)) return + OutData%C_obj%Dummy = OutData%Dummy +end subroutine + +SUBROUTINE SC_C2Fary_CopyContState(ContStateData, ErrStat, ErrMsg, SkipPointers) + TYPE(SC_ContinuousStateType), INTENT(INOUT) :: ContStateData 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' -! + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local 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, DEALLOCATEpointers ) - TYPE(SC_DiscreteStateType), INTENT(INOUT) :: DiscStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_DestroyDiscState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ASSOCIATED(DiscStateData%Global)) THEN - IF (DEALLOCATEpointers_local) & - 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 - IF (DEALLOCATEpointers_local) & - 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 + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + ContStateData%Dummy = ContStateData%C_obj%Dummy +END SUBROUTINE + +SUBROUTINE SC_F2C_CopyContState( ContStateData, ErrStat, ErrMsg, SkipPointers ) + TYPE(SC_ContinuousStateType), INTENT(INOUT) :: ContStateData 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' -! + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local 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, DEALLOCATEpointers ) - TYPE(SC_ContinuousStateType), INTENT(INOUT) :: ContStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_DestroyContState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - 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 + ErrMsg = '' + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + ContStateData%C_obj%Dummy = ContStateData%Dummy +END SUBROUTINE + +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 + character(*), parameter :: RoutineName = 'SC_CopyConstrState' + ErrStat = ErrID_None + ErrMsg = '' + DstConstrStateData%Dummy = SrcConstrStateData%Dummy + DstConstrStateData%C_obj%Dummy = SrcConstrStateData%C_obj%Dummy +end subroutine + +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' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine SC_PackConstrState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SC_ConstraintStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SC_PackConstrState' + if (RF%ErrStat >= AbortErrLev) return + if (c_associated(InData%C_obj%object)) then + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + call RegPack(RF, InData%Dummy) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SC_UnPackConstrState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SC_ConstraintStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SC_UnPackConstrState' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%Dummy); if (RegCheckErr(RF, RoutineName)) return + OutData%C_obj%Dummy = OutData%Dummy +end subroutine + +SUBROUTINE SC_C2Fary_CopyConstrState(ConstrStateData, ErrStat, ErrMsg, SkipPointers) + TYPE(SC_ConstraintStateType), INTENT(INOUT) :: ConstrStateData 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' -! + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local 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, DEALLOCATEpointers ) - TYPE(SC_ConstraintStateType), INTENT(INOUT) :: ConstrStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_DestroyConstrState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - 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 + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + ConstrStateData%Dummy = ConstrStateData%C_obj%Dummy +END SUBROUTINE + +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 + +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 + character(*), parameter :: RoutineName = 'SC_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + DstMiscData%Dummy = SrcMiscData%Dummy + DstMiscData%C_obj%Dummy = SrcMiscData%C_obj%Dummy +end subroutine + +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' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine SC_PackMisc(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SC_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SC_PackMisc' + if (RF%ErrStat >= AbortErrLev) return + if (c_associated(InData%C_obj%object)) then + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + call RegPack(RF, InData%Dummy) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SC_UnPackMisc(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SC_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SC_UnPackMisc' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%Dummy); if (RegCheckErr(RF, RoutineName)) return + OutData%C_obj%Dummy = OutData%Dummy +end subroutine + +SUBROUTINE SC_C2Fary_CopyMisc(MiscData, ErrStat, ErrMsg, SkipPointers) + TYPE(SC_MiscVarType), INTENT(INOUT) :: MiscData 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' -! + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local 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, DEALLOCATEpointers ) - TYPE(SC_MiscVarType), INTENT(INOUT) :: MiscData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_DestroyMisc' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - 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 + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + MiscData%Dummy = MiscData%C_obj%Dummy +END SUBROUTINE + +SUBROUTINE SC_F2C_CopyMisc( MiscData, ErrStat, ErrMsg, SkipPointers ) + TYPE(SC_MiscVarType), INTENT(INOUT) :: MiscData 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' -! + 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 + +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 + character(*), parameter :: RoutineName = 'SC_CopyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + DstOtherStateData%Dummy = SrcOtherStateData%Dummy + DstOtherStateData%C_obj%Dummy = SrcOtherStateData%C_obj%Dummy +end subroutine + +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' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine SC_PackOtherState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SC_OtherStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SC_PackOtherState' + if (RF%ErrStat >= AbortErrLev) return + if (c_associated(InData%C_obj%object)) then + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + call RegPack(RF, InData%Dummy) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SC_UnPackOtherState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SC_OtherStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SC_UnPackOtherState' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%Dummy); if (RegCheckErr(RF, RoutineName)) return + OutData%C_obj%Dummy = OutData%Dummy +end subroutine + +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 = "" - DstOtherStateData%Dummy = SrcOtherStateData%Dummy - DstOtherStateData%C_obj%Dummy = SrcOtherStateData%C_obj%Dummy - END SUBROUTINE SC_CopyOtherState - - SUBROUTINE SC_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(SC_OtherStateType), INTENT(INOUT) :: OtherStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_DestroyOtherState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - 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 + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + OtherStateData%Dummy = OtherStateData%C_obj%Dummy +END SUBROUTINE + +SUBROUTINE SC_F2C_CopyOtherState( OtherStateData, ErrStat, ErrMsg, SkipPointers ) + TYPE(SC_OtherStateType), INTENT(INOUT) :: OtherStateData 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' -! + 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 + +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 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'SC_CopyInput' + ErrStat = ErrID_None + ErrMsg = '' + if (associated(SrcInputData%toSCglob)) then + LB(1:1) = lbound(SrcInputData%toSCglob) + UB(1:1) = ubound(SrcInputData%toSCglob) + if (.not. associated(DstInputData%toSCglob)) then + allocate(DstInputData%toSCglob(LB(1):UB(1)), 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(LB(1))) + end if + DstInputData%toSCglob = SrcInputData%toSCglob + end if + if (associated(SrcInputData%toSC)) then + LB(1:1) = lbound(SrcInputData%toSC) + UB(1:1) = ubound(SrcInputData%toSC) + if (.not. associated(DstInputData%toSC)) then + allocate(DstInputData%toSC(LB(1):UB(1)), 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(LB(1))) + end if + DstInputData%toSC = SrcInputData%toSC + end if +end subroutine + +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' + 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 + end if + if (associated(InputData%toSC)) then + deallocate(InputData%toSC) + InputData%toSC => null() + InputData%C_obj%toSC = c_null_ptr + InputData%C_obj%toSC_Len = 0 + end if +end subroutine + +subroutine SC_PackInput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SC_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SC_PackInput' + logical :: PtrInIndex + if (RF%ErrStat >= AbortErrLev) return + if (c_associated(InData%C_obj%object)) then + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + call RegPackPtr(RF, InData%toSCglob) + call RegPackPtr(RF, InData%toSC) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SC_UnPackInput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SC_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SC_UnPackInput' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(B8Ki) :: PtrIdx + type(c_ptr) :: Ptr + if (RF%ErrStat /= ErrID_None) return + call RegUnpackPtr(RF, OutData%toSCglob, LB, UB); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%toSCglob)) then + OutData%C_obj%toSCglob_Len = size(OutData%toSCglob) + if (OutData%C_obj%toSCglob_Len > 0) OutData%C_obj%toSCglob = c_loc(OutData%toSCglob(LB(1))) + end if + call RegUnpackPtr(RF, OutData%toSC, LB, UB); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%toSC)) then + OutData%C_obj%toSC_Len = size(OutData%toSC) + if (OutData%C_obj%toSC_Len > 0) OutData%C_obj%toSC = c_loc(OutData%toSC(LB(1))) + end if +end subroutine + +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 (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, DEALLOCATEpointers ) - TYPE(SC_InputType), INTENT(INOUT) :: InputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_DestroyInput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ASSOCIATED(InputData%toSCglob)) THEN - IF (DEALLOCATEpointers_local) & - 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 - IF (DEALLOCATEpointers_local) & - 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 + + 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 + +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 + +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 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'SC_CopyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (associated(SrcOutputData%fromSCglob)) then + LB(1:1) = lbound(SrcOutputData%fromSCglob) + UB(1:1) = ubound(SrcOutputData%fromSCglob) + if (.not. associated(DstOutputData%fromSCglob)) then + allocate(DstOutputData%fromSCglob(LB(1):UB(1)), 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(LB(1))) + end if + DstOutputData%fromSCglob = SrcOutputData%fromSCglob + end if + if (associated(SrcOutputData%fromSC)) then + LB(1:1) = lbound(SrcOutputData%fromSC) + UB(1:1) = ubound(SrcOutputData%fromSC) + if (.not. associated(DstOutputData%fromSC)) then + allocate(DstOutputData%fromSC(LB(1):UB(1)), 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(LB(1))) + end if + DstOutputData%fromSC = SrcOutputData%fromSC + end if +end subroutine + +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' + 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 + end if + if (associated(OutputData%fromSC)) then + deallocate(OutputData%fromSC) + OutputData%fromSC => null() + OutputData%C_obj%fromSC = c_null_ptr + OutputData%C_obj%fromSC_Len = 0 + end if +end subroutine + +subroutine SC_PackOutput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SC_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SC_PackOutput' + logical :: PtrInIndex + if (RF%ErrStat >= AbortErrLev) return + if (c_associated(InData%C_obj%object)) then + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + call RegPackPtr(RF, InData%fromSCglob) + call RegPackPtr(RF, InData%fromSC) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SC_UnPackOutput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SC_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SC_UnPackOutput' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(B8Ki) :: PtrIdx + type(c_ptr) :: Ptr + if (RF%ErrStat /= ErrID_None) return + call RegUnpackPtr(RF, OutData%fromSCglob, LB, UB); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%fromSCglob)) then + OutData%C_obj%fromSCglob_Len = size(OutData%fromSCglob) + if (OutData%C_obj%fromSCglob_Len > 0) OutData%C_obj%fromSCglob = c_loc(OutData%fromSCglob(LB(1))) + end if + call RegUnpackPtr(RF, OutData%fromSC, LB, UB); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%fromSC)) then + OutData%C_obj%fromSC_Len = size(OutData%fromSC) + if (OutData%C_obj%fromSC_Len > 0) OutData%C_obj%fromSC = c_loc(OutData%fromSC(LB(1))) + end if +end subroutine + +SUBROUTINE SC_C2Fary_CopyOutput(OutputData, ErrStat, ErrMsg, SkipPointers) + TYPE(SC_OutputType), INTENT(INOUT) :: OutputData 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' -! + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local 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, DEALLOCATEpointers ) - TYPE(SC_OutputType), INTENT(INOUT) :: OutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_DestroyOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ASSOCIATED(OutputData%fromSCglob)) THEN - IF (DEALLOCATEpointers_local) & - 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 - IF (DEALLOCATEpointers_local) & - 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) -! -!.................................................................................................................................. + + 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 - 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 +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 + +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 ) + 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) /= size(u)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(u)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(u) - 1 + select case (order) + case (0) + call SC_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call SC_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call SC_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(u) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +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. @@ -2981,53 +1550,48 @@ SUBROUTINE SC_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) ! !.................................................................................................................................. - 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 + 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 + 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) :: a1, a2 ! 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 ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + IF (ASSOCIATED(u_out%toSCglob) .AND. ASSOCIATED(u1%toSCglob)) THEN + u_out%toSCglob = a1*u1%toSCglob + a2*u2%toSCglob + END IF ! check if allocated + IF (ASSOCIATED(u_out%toSC) .AND. ASSOCIATED(u1%toSC)) THEN + u_out%toSC = a1*u1%toSC + a2*u2%toSC + END IF ! check if allocated +END SUBROUTINE + +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. @@ -3041,115 +1605,108 @@ SUBROUTINE SC_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrM ! !.................................................................................................................................. - 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 + 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) - + 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) :: a1,a2,a3 ! 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 + 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 + 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 + 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 + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + IF (ASSOCIATED(u_out%toSCglob) .AND. ASSOCIATED(u1%toSCglob)) THEN + u_out%toSCglob = a1*u1%toSCglob + a2*u2%toSCglob + a3*u3%toSCglob + END IF ! check if allocated + IF (ASSOCIATED(u_out%toSC) .AND. ASSOCIATED(u1%toSC)) THEN + u_out%toSC = a1*u1%toSC + a2*u2%toSC + a3*u3%toSC + END IF ! check if allocated +END SUBROUTINE + +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 ) + 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) /= size(y)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(y)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(y) - 1 + select case (order) + case (0) + call SC_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call SC_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call SC_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(y) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +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. @@ -3161,53 +1718,48 @@ SUBROUTINE SC_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ! !.................................................................................................................................. - 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 + 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 + 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) :: a1, a2 ! 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 ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + IF (ASSOCIATED(y_out%fromSCglob) .AND. ASSOCIATED(y1%fromSCglob)) THEN + y_out%fromSCglob = a1*y1%fromSCglob + a2*y2%fromSCglob + END IF ! check if allocated + IF (ASSOCIATED(y_out%fromSC) .AND. ASSOCIATED(y1%fromSC)) THEN + y_out%fromSC = a1*y1%fromSC + a2*y2%fromSC + END IF ! check if allocated +END SUBROUTINE + +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. @@ -3221,61 +1773,53 @@ SUBROUTINE SC_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Err ! !.................................................................................................................................. - 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 + 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) - + 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) :: a1,a2,a3 ! 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 + 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 + 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 + 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 - + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + IF (ASSOCIATED(y_out%fromSCglob) .AND. ASSOCIATED(y1%fromSCglob)) THEN + y_out%fromSCglob = a1*y1%fromSCglob + a2*y2%fromSCglob + a3*y3%fromSCglob + END IF ! check if allocated + IF (ASSOCIATED(y_out%fromSC) .AND. ASSOCIATED(y1%fromSC)) THEN + y_out%fromSC = a1*y1%fromSC + a2*y2%fromSC + a3*y3%fromSC + END IF ! check if allocated +END SUBROUTINE END MODULE SuperController_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/supercontroller/src/SuperController_Types.h b/modules/supercontroller/src/SuperController_Types.h index 365cc9d1ae..b4ec96dc17 100644 --- a/modules/supercontroller/src/SuperController_Types.h +++ b/modules/supercontroller/src/SuperController_Types.h @@ -7,93 +7,98 @@ #ifndef _SuperController_TYPES_H #define _SuperController_TYPES_H - #ifdef _WIN32 //define something for Windows (32-bit) -# include "stdbool.h" -# define CALL __declspec( dllexport ) + #include "stdbool.h" + #define CALL __declspec(dllexport) #elif _WIN64 //define something for Windows (64-bit) -# include "stdbool.h" -# define CALL __declspec( dllexport ) + #include "stdbool.h" + #define CALL __declspec(dllexport) #else -# include -# define CALL + #include + #define CALL #endif +typedef struct SC_InitInputType { + void *object; + int nTurbines; + char DLL_FileName[1024]; +} SC_InitInputType_t; - typedef struct SC_InitInputType { - void * object ; - int nTurbines ; - char DLL_FileName[1024] ; - } SC_InitInputType_t ; - typedef struct SC_InitOutputType { - void * object ; +typedef struct SC_InitOutputType { + void *object; + int NumCtrl2SC; + int nInpGlobal; + int NumSC2Ctrl; + int NumSC2CtrlGlob; +} SC_InitOutputType_t; - 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 ; +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; - } 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 ; +typedef struct SC_DiscreteStateType { + void *object; + float *Global; int Global_Len; + float *Turbine; int Turbine_Len; +} SC_DiscreteStateType_t; -#endif // _SuperController_TYPES_H +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/modules/version/CMakeLists.txt b/modules/version/CMakeLists.txt index 1af85e5e68..1c714c3685 100644 --- a/modules/version/CMakeLists.txt +++ b/modules/version/CMakeLists.txt @@ -27,7 +27,9 @@ else() endif() add_definitions(-DGIT_VERSION_INFO="${GIT_DESCRIBE}") -add_library(versioninfolib src/VersionInfo.f90) +add_library(versioninfolib STATIC + src/VersionInfo.f90 +) target_link_libraries(versioninfolib nwtclibs) install(TARGETS versioninfolib diff --git a/modules/version/src/VersionInfo.f90 b/modules/version/src/VersionInfo.f90 index 1f03e97a90..8f5ba66e10 100644 --- a/modules/version/src/VersionInfo.f90 +++ b/modules/version/src/VersionInfo.f90 @@ -57,7 +57,7 @@ FUNCTION GetVersion(ThisProgVer, Cmpl4SFun, Cmpl4LV) CHARACTER(200) :: git_commit - GetVersion = TRIM(GetNVD(ThisProgVer))//', compiled' + GetVersion = TRIM(GetNVD(ThisProgVer))//', compiled on '//__DATE__//' at '//__TIME__ if (present(Cmpl4SFun)) then IF ( Cmpl4SFun ) THEN ! FAST has been compiled as an S-Function for Simulink @@ -267,6 +267,16 @@ SUBROUTINE CheckArgs ( Arg1, ErrStat, Arg2, Flag, InputArgArray ) RETURN END IF + CASE ('STEADYSTATE') + IF ( SecondArgumentSet .AND. .NOT. FirstArgumentSet ) THEN + Arg1 = Arg2 + END IF + IF ( .NOT. FirstArgumentSet .AND. .NOT. SecondArgumentSet ) THEN + CALL INVALID_SYNTAX( 'the steady-state capability requires at least one argument: -steadystate' ) + CALL CLEANUP() + RETURN + END IF + CASE DEFAULT CALL INVALID_SYNTAX( 'unknown command-line argument given: '//TRIM(FlagIter) ) CALL CLEANUP() @@ -303,7 +313,7 @@ SUBROUTINE INVALID_SYNTAX(ErrorMessage) SUBROUTINE GET_COMMAND_LINE_ARG(ArgIndex, ArgGiven) INTEGER, INTENT(IN) :: ArgIndex !< Index location of the argument to get. - CHARACTER(1024), INTENT(OUT) :: ArgGiven !< The gotten command-line argument. + CHARACTER(*), INTENT(OUT) :: ArgGiven !< The gotten command-line argument. INTEGER :: Error !< Indicates if there was an error getting an argument. CALL GET_COMMAND_ARGUMENT( ArgIndex, ArgGiven, STATUS=Error ) diff --git a/modules/version/tests/test_VersionInfo_CheckArgs.F90 b/modules/version/tests/test_VersionInfo_CheckArgs.F90 index 78e0b7722b..6d709fcc5a 100644 --- a/modules/version/tests/test_VersionInfo_CheckArgs.F90 +++ b/modules/version/tests/test_VersionInfo_CheckArgs.F90 @@ -1,378 +1,368 @@ module test_VersionInfo_CheckArgs - use pFUnit_mod - use VersionInfo - use versioninfo_test_tools - - implicit none - - contains - - ! PASSING CASES - - ! ************************************************************************ - ! To read the input file, a default may be provided and a user-specified - ! input file may be used instead. - - @test - subroutine test_input_file_user_specified() - - ! executable.exe FileName - - character(1024) :: filename, second_argument, flag - integer(IntKi) :: error_status - character(16), dimension(:), allocatable :: argument_array - - filename = "" - allocate(argument_array(1)) - argument_array = (/ & - "first_arg.txt " & - /) - call hide_terminal_output() - call CheckArgs( filename, error_status, second_argument, flag, argument_array ) - call show_terminal_output() - @assertEqual( "first_arg.txt", filename ) - @assertEqual( 0, error_status ) - @assertEqual( "", second_argument ) - @assertEqual( "", flag ) - deallocate(argument_array) - end subroutine - - @test - subroutine test_input_file_default() - - ! executable.exe - - character(1024) :: filename, second_argument, flag - integer(IntKi) :: error_status - character(16), dimension(:), allocatable :: argument_array - - filename = "default.txt" - allocate(argument_array(0)) - call hide_terminal_output() - call CheckArgs( filename, error_status, second_argument, flag, argument_array ) - call show_terminal_output() - @assertEqual( "default.txt", filename ) - @assertEqual( 0, error_status ) - @assertEqual( "", second_argument ) - @assertEqual( "", flag ) - deallocate(argument_array) - end subroutine - - @test - subroutine test_input_file_default_user_specified() - - character(1024) :: filename, second_argument, flag - integer(IntKi) :: error_status - character(16), dimension(:), allocatable :: argument_array - - filename = "default.txt" - allocate(argument_array(1)) - argument_array = (/ & - "first_arg.txt " & - /) - call hide_terminal_output() - call CheckArgs( filename, error_status, second_argument, flag, argument_array ) - call show_terminal_output() - @assertEqual( "first_arg.txt", filename ) - @assertEqual( 0, error_status ) - @assertEqual( "", second_argument ) - @assertEqual( "", flag ) - deallocate(argument_array) - end subroutine - - ! ************************************************************************ - ! Given a restart flag, the flag should be parsed along with the input - ! file and second argument regardless of the position of the flag. - ! The first argument is optional in this case. - - @test - subroutine test_restart_flag1() - - ! executable.exe -Flag FileName Arg2 - - character(1024) :: filename, second_argument, flag - integer(IntKi) :: error_status - character(16), dimension(:), allocatable :: argument_array - - filename = "" - allocate(argument_array(3)) - argument_array = (/ & - "-restart ", & - "first_arg.txt ", & - "second_arg " & - /) - call hide_terminal_output() - call CheckArgs( filename, error_status, second_argument, flag, argument_array ) - call show_terminal_output() - @assertEqual( "first_arg.txt", filename ) - @assertEqual( 0, error_status ) - @assertEqual( "second_arg", second_argument ) - @assertEqual( "RESTART", flag ) - deallocate(argument_array) - end subroutine - - @test - subroutine test_restart_flag2() - - ! executable.exe FileName -Flag Arg2 - - character(1024) :: filename, second_argument, flag - integer(IntKi) :: error_status - character(16), dimension(:), allocatable :: argument_array - - filename = "" - allocate(argument_array(3)) - argument_array = (/ & - "first_arg.txt ", & - "-restart ", & - "second_arg " & - /) - call hide_terminal_output() - call CheckArgs( filename, error_status, second_argument, flag, argument_array ) - call show_terminal_output() - @assertEqual( "first_arg.txt", filename ) - @assertEqual( 0, error_status ) - @assertEqual( "second_arg", second_argument ) - @assertEqual( "RESTART", flag ) - deallocate(argument_array) - end subroutine - - @test - subroutine test_restart_flag3() - - ! executable.exe -restart Arg1 - - character(1024) :: filename, second_argument, flag - integer(IntKi) :: error_status - character(16), dimension(:), allocatable :: argument_array - - filename = "" - allocate(argument_array(2)) - argument_array = (/ & - "-restart ", & - "first_arg.txt " & - /) - call hide_terminal_output() - call CheckArgs( filename, error_status, second_argument, flag, argument_array ) - call show_terminal_output() - @assertEqual( "", filename ) - @assertEqual( 0, error_status ) - @assertEqual( "first_arg.txt", second_argument ) - @assertEqual( "RESTART", flag ) - deallocate(argument_array) - end subroutine - - ! ************************************************************************ - ! The second argument should be returned when provided even outside - ! of the restart functionality. - - @test - subroutine test_second_argument() - - ! executable.exe FileName Arg2 - - character(1024) :: filename, second_argument, flag - integer(IntKi) :: error_status - character(16), dimension(:), allocatable :: argument_array - - filename = "" - allocate(argument_array(2)) - argument_array = (/ & - "first_arg.txt ", & - "second_arg " & - /) - call hide_terminal_output() - call CheckArgs( filename, error_status, second_argument, flag, argument_array ) - call show_terminal_output() - @assertEqual( "first_arg.txt", filename ) - @assertEqual( 0, error_status ) - @assertEqual( "second_arg", second_argument ) - @assertEqual( "", flag ) - deallocate(argument_array) - end subroutine - - ! ************************************************************************ - ! The help flag in any position should show the help prompt and exit - ! normally. - - @test - subroutine test_help1() - - ! executable.exe -Flag FileName - - character(1024) :: filename, second_argument, flag - integer(IntKi) :: error_status - character(16), dimension(:), allocatable :: argument_array - - filename = "" - allocate(argument_array(2)) - argument_array = (/ & - "-h ", & - "first_arg.txt " & - /) - call hide_terminal_output() - call CheckArgs( filename, error_status, second_argument, flag, argument_array ) - call show_terminal_output() - @assertEqual( "first_arg.txt", filename ) - @assertEqual( 0, error_status ) - @assertEqual( "", second_argument ) - @assertEqual( "H", flag ) - deallocate(argument_array) - end subroutine - - @test - subroutine test_help2() - - ! executable.exe FileName -Flag - - character(1024) :: filename, second_argument, flag - integer(IntKi) :: error_status - character(16), dimension(:), allocatable :: argument_array - - filename = "" - allocate(argument_array(2)) - argument_array = (/ & - "first_arg.txt ", & - "-h " & - /) - call hide_terminal_output() - call CheckArgs( filename, error_status, second_argument, flag, argument_array ) - call show_terminal_output() - @assertEqual( "first_arg.txt", filename ) - @assertEqual( 0, error_status ) - @assertEqual( "", second_argument ) - @assertEqual( "H", flag ) - deallocate(argument_array) - end subroutine - - ! ************************************************************************ - ! The version flag in any position should show the version info and exit - ! normally. - - @test - subroutine test_version1() - - ! executable.exe -v FileName - - character(1024) :: filename, second_argument, flag - integer(IntKi) :: error_status - character(16), dimension(:), allocatable :: argument_array - - filename = "" - allocate(argument_array(2)) - argument_array = (/ & - "-v ", & - "first_arg.txt " & - /) - call hide_terminal_output() - call CheckArgs( filename, error_status, second_argument, flag, argument_array ) - call show_terminal_output() - @assertEqual( "first_arg.txt", filename ) - @assertEqual( 0, error_status ) - @assertEqual( "", second_argument ) - @assertEqual( "V", flag ) - deallocate(argument_array) - end subroutine - - @test - subroutine test_version2() - - ! executable.exe FileName -VERSION - - character(1024) :: filename, second_argument, flag - integer(IntKi) :: error_status - character(16), dimension(:), allocatable :: argument_array - - filename = "" - allocate(argument_array(2)) - argument_array = (/ & - "first_arg.txt ", & - "-VERSION " & - /) - call hide_terminal_output() - call CheckArgs( filename, error_status, second_argument, flag, argument_array ) - call show_terminal_output() - @assertEqual( "first_arg.txt", filename ) - @assertEqual( 0, error_status ) - @assertEqual( "", second_argument ) - @assertEqual( "VERSION", flag ) - deallocate(argument_array) - end subroutine - - ! FAILING CASES - - ! ************************************************************************ - ! No arguments and no default input file should exit with an error - - @test - subroutine test_no_args_no_default() - - character(1024) :: filename, second_argument, flag - integer(IntKi) :: error_status - character(16), dimension(:), allocatable :: argument_array - - filename = "" - allocate(argument_array(0)) - call hide_terminal_output() - call CheckArgs( filename, error_status, second_argument, flag, argument_array ) - call show_terminal_output() - @assertEqual( "", filename ) - @assertEqual( 4, error_status ) - @assertEqual( "", second_argument ) - @assertEqual( "", flag ) - deallocate(argument_array) - end subroutine - - ! ************************************************************************ - ! An unsupported flag should exit with an error - - @test - subroutine test_unsupported_flag() - - character(1024) :: filename, second_argument, flag - integer(IntKi) :: error_status - character(16), dimension(:), allocatable :: argument_array - - filename = "" - allocate(argument_array(2)) - argument_array = (/ & - "first_arg.txt ", & - "-flag " & - /) - call hide_terminal_output() - call CheckArgs( filename, error_status, second_argument, flag, argument_array ) - call show_terminal_output() - @assertEqual( "first_arg.txt", filename ) - @assertEqual( 4, error_status ) - @assertEqual( "", second_argument ) - @assertEqual( "FLAG", flag ) - deallocate(argument_array) - end subroutine - - ! ************************************************************************ - ! The restart flag requires at least one additional argument - - @test - subroutine test_restart_bad_syntax() - - character(1024) :: filename, second_argument, flag - integer(IntKi) :: error_status - character(16), dimension(:), allocatable :: argument_array - - filename = "" - allocate(argument_array(1)) - argument_array = (/ & - "-restart " & - /) - call hide_terminal_output() - call CheckArgs( filename, error_status, second_argument, flag, argument_array ) - call show_terminal_output() - @assertEqual( "", filename ) - @assertEqual( 4, error_status ) - @assertEqual( "", second_argument ) - @assertEqual( "RESTART", flag ) - deallocate(argument_array) - end subroutine +use testdrive, only: new_unittest, unittest_type, error_type, check +use VersionInfo +use versioninfo_test_tools + +implicit none + +private +public :: test_VersionInfo_CheckArgs_suite + +contains + +!> Collect all exported unit tests +subroutine test_VersionInfo_CheckArgs_suite(testsuite) + type(unittest_type), allocatable, intent(out) :: testsuite(:) + testsuite = [new_unittest("test_input_file_user_specified", test_input_file_user_specified), & + new_unittest("test_input_file_default", test_input_file_default), & + new_unittest("test_input_file_default_user_specified", test_input_file_default_user_specified), & + new_unittest("test_restart_flag1", test_restart_flag1), & + new_unittest("test_restart_flag2", test_restart_flag2), & + new_unittest("test_restart_flag3", test_restart_flag3), & + new_unittest("test_second_argument", test_second_argument), & + new_unittest("test_help1", test_help1), & + new_unittest("test_help2", test_help2), & + new_unittest("test_version1", test_version1), & + new_unittest("test_version2", test_version2), & + new_unittest("test_no_args_no_default", test_no_args_no_default), & + new_unittest("test_unsupported_flag", test_unsupported_flag), & + new_unittest("test_restart_bad_syntax", test_restart_bad_syntax) & + ] +end subroutine + +! PASSING CASES + +! ************************************************************************ +! To read the input file, a default may be provided and a user-specified +! input file may be used instead. + +subroutine test_input_file_user_specified(error) + type(error_type), allocatable, intent(out) :: error + + ! executable.exe FileName + + character(1024) :: filename, second_argument, flag + integer(IntKi) :: error_status + character(16), dimension(:), allocatable :: argument_array + + filename = "" + allocate (argument_array(1)) + argument_array = ["first_arg.txt "] + call hide_terminal_output() + call CheckArgs(filename, error_status, second_argument, flag, argument_array) + call show_terminal_output() + call check(error, "first_arg.txt", filename); if (allocated(error)) return + call check(error, 0, error_status); if (allocated(error)) return + call check(error, "", second_argument); if (allocated(error)) return + call check(error, "", flag); if (allocated(error)) return + deallocate (argument_array) +end subroutine + +subroutine test_input_file_default(error) + type(error_type), allocatable, intent(out) :: error + + ! executable.exe + + character(1024) :: filename, second_argument, flag + integer(IntKi) :: error_status + character(16), dimension(:), allocatable :: argument_array + + filename = "default.txt" + allocate (argument_array(0)) + call hide_terminal_output() + call CheckArgs(filename, error_status, second_argument, flag, argument_array) + call show_terminal_output() + call check(error, "default.txt", filename); if (allocated(error)) return + call check(error, 0, error_status); if (allocated(error)) return + call check(error, "", second_argument); if (allocated(error)) return + call check(error, "", flag); if (allocated(error)) return + deallocate (argument_array) +end subroutine + +subroutine test_input_file_default_user_specified(error) + type(error_type), allocatable, intent(out) :: error + + character(1024) :: filename, second_argument, flag + integer(IntKi) :: error_status + character(16), dimension(:), allocatable :: argument_array + + filename = "default.txt" + allocate (argument_array(1)) + argument_array = ["first_arg.txt "] + call hide_terminal_output() + call CheckArgs(filename, error_status, second_argument, flag, argument_array) + call show_terminal_output() + call check(error, "first_arg.txt", filename); if (allocated(error)) return + call check(error, 0, error_status); if (allocated(error)) return + call check(error, "", second_argument); if (allocated(error)) return + call check(error, "", flag); if (allocated(error)) return + deallocate (argument_array) +end subroutine + +! ************************************************************************ +! Given a restart flag, the flag should be parsed along with the input +! file and second argument regardless of the position of the flag. +! The first argument is optional in this case. + +subroutine test_restart_flag1(error) + type(error_type), allocatable, intent(out) :: error + + ! executable.exe -Flag FileName Arg2 + + character(1024) :: filename, second_argument, flag + integer(IntKi) :: error_status + character(16), dimension(:), allocatable :: argument_array + + filename = "" + allocate (argument_array(3)) + argument_array = ["-restart ", & + "first_arg.txt ", & + "second_arg "] + call hide_terminal_output() + call CheckArgs(filename, error_status, second_argument, flag, argument_array) + call show_terminal_output() + call check(error, "first_arg.txt", filename); if (allocated(error)) return + call check(error, 0, error_status); if (allocated(error)) return + call check(error, "second_arg", second_argument); if (allocated(error)) return + call check(error, "RESTART", flag); if (allocated(error)) return + deallocate (argument_array) +end subroutine + +subroutine test_restart_flag2(error) + type(error_type), allocatable, intent(out) :: error + + ! executable.exe FileName -Flag Arg2 + + character(1024) :: filename, second_argument, flag + integer(IntKi) :: error_status + character(16), dimension(:), allocatable :: argument_array + + filename = "" + allocate (argument_array(3)) + argument_array = ["first_arg.txt ", "-restart ", "second_arg "] + call hide_terminal_output() + call CheckArgs(filename, error_status, second_argument, flag, argument_array) + call show_terminal_output() + call check(error, "first_arg.txt", filename); if (allocated(error)) return + call check(error, 0, error_status); if (allocated(error)) return + call check(error, "second_arg", second_argument); if (allocated(error)) return + call check(error, "RESTART", flag); if (allocated(error)) return + deallocate (argument_array) +end subroutine + +subroutine test_restart_flag3(error) + type(error_type), allocatable, intent(out) :: error + + ! executable.exe -restart Arg1 + + character(1024) :: filename, second_argument, flag + integer(IntKi) :: error_status + character(16), dimension(:), allocatable :: argument_array + + filename = "" + allocate (argument_array(2)) + argument_array = ["-restart ", "first_arg.txt "] + call hide_terminal_output() + call CheckArgs(filename, error_status, second_argument, flag, argument_array) + call show_terminal_output() + call check(error, "", filename); if (allocated(error)) return + call check(error, 0, error_status); if (allocated(error)) return + call check(error, "first_arg.txt", second_argument); if (allocated(error)) return + call check(error, "RESTART", flag); if (allocated(error)) return + deallocate (argument_array) +end subroutine + +! ************************************************************************ +! The second argument should be returned when provided even outside +! of the restart functionality. + +subroutine test_second_argument(error) + type(error_type), allocatable, intent(out) :: error + + ! executable.exe FileName Arg2 + + character(1024) :: filename, second_argument, flag + integer(IntKi) :: error_status + character(16), dimension(:), allocatable :: argument_array + + filename = "" + allocate (argument_array(2)) + argument_array = ["first_arg.txt ", "second_arg "] + call hide_terminal_output() + call CheckArgs(filename, error_status, second_argument, flag, argument_array) + call show_terminal_output() + call check(error, "first_arg.txt", filename); if (allocated(error)) return + call check(error, 0, error_status); if (allocated(error)) return + call check(error, "second_arg", second_argument); if (allocated(error)) return + call check(error, "", flag); if (allocated(error)) return + deallocate (argument_array) +end subroutine + +! ************************************************************************ +! The help flag in any position should show the help prompt and exit +! normally. + +subroutine test_help1(error) + type(error_type), allocatable, intent(out) :: error + + ! executable.exe -Flag FileName + + character(1024) :: filename, second_argument, flag + integer(IntKi) :: error_status + character(16), dimension(:), allocatable :: argument_array + + filename = "" + allocate (argument_array(2)) + argument_array = ["-h ", "first_arg.txt "] + call hide_terminal_output() + call CheckArgs(filename, error_status, second_argument, flag, argument_array) + call show_terminal_output() + call check(error, "first_arg.txt", filename); if (allocated(error)) return + call check(error, 0, error_status); if (allocated(error)) return + call check(error, "", second_argument); if (allocated(error)) return + call check(error, "H", flag); if (allocated(error)) return + deallocate (argument_array) +end subroutine + +subroutine test_help2(error) + type(error_type), allocatable, intent(out) :: error + + ! executable.exe FileName -Flag + + character(1024) :: filename, second_argument, flag + integer(IntKi) :: error_status + character(16), dimension(:), allocatable :: argument_array + + filename = "" + allocate (argument_array(2)) + argument_array = ["first_arg.txt ", "-h "] + call hide_terminal_output() + call CheckArgs(filename, error_status, second_argument, flag, argument_array) + call show_terminal_output() + call check(error, "first_arg.txt", filename); if (allocated(error)) return + call check(error, 0, error_status); if (allocated(error)) return + call check(error, "", second_argument); if (allocated(error)) return + call check(error, "H", flag); if (allocated(error)) return + deallocate (argument_array) +end subroutine + +! ************************************************************************ +! The version flag in any position should show the version info and exit +! normally. + +subroutine test_version1(error) + type(error_type), allocatable, intent(out) :: error + + ! executable.exe -v FileName + + character(1024) :: filename, second_argument, flag + integer(IntKi) :: error_status + character(16), dimension(:), allocatable :: argument_array + + filename = "" + allocate (argument_array(2)) + argument_array = ["-v ", "first_arg.txt "] + call hide_terminal_output() + call CheckArgs(filename, error_status, second_argument, flag, argument_array) + call show_terminal_output() + call check(error, "first_arg.txt", filename); if (allocated(error)) return + call check(error, 0, error_status); if (allocated(error)) return + call check(error, "", second_argument); if (allocated(error)) return + call check(error, "V", flag); if (allocated(error)) return + deallocate (argument_array) +end subroutine + +subroutine test_version2(error) + type(error_type), allocatable, intent(out) :: error + + ! executable.exe FileName -VERSION + + character(1024) :: filename, second_argument, flag + integer(IntKi) :: error_status + character(16), dimension(:), allocatable :: argument_array + + filename = "" + allocate (argument_array(2)) + argument_array = ["first_arg.txt ", "-VERSION "] + call hide_terminal_output() + call CheckArgs(filename, error_status, second_argument, flag, argument_array) + call show_terminal_output() + call check(error, "first_arg.txt", filename); if (allocated(error)) return + call check(error, 0, error_status); if (allocated(error)) return + call check(error, "", second_argument); if (allocated(error)) return + call check(error, "VERSION", flag); if (allocated(error)) return + deallocate (argument_array) +end subroutine + +! FAILING CASES + +! ************************************************************************ +! No arguments and no default input file should exit with an error + +subroutine test_no_args_no_default(error) + type(error_type), allocatable, intent(out) :: error + + character(1024) :: filename, second_argument, flag + integer(IntKi) :: error_status + character(16), dimension(:), allocatable :: argument_array + + filename = "" + allocate (argument_array(0)) + call hide_terminal_output() + call CheckArgs(filename, error_status, second_argument, flag, argument_array) + call show_terminal_output() + call check(error, "", filename); if (allocated(error)) return + call check(error, 4, error_status); if (allocated(error)) return + call check(error, "", second_argument); if (allocated(error)) return + call check(error, "", flag); if (allocated(error)) return + deallocate (argument_array) +end subroutine + +! ************************************************************************ +! An unsupported flag should exit with an error + +subroutine test_unsupported_flag(error) + type(error_type), allocatable, intent(out) :: error + + character(1024) :: filename, second_argument, flag + integer(IntKi) :: error_status + character(16), dimension(:), allocatable :: argument_array + + filename = "" + allocate (argument_array(2)) + argument_array = ["first_arg.txt ", "-flag "] + call hide_terminal_output() + call CheckArgs(filename, error_status, second_argument, flag, argument_array) + call show_terminal_output() + call check(error, "first_arg.txt", filename); if (allocated(error)) return + call check(error, 4, error_status); if (allocated(error)) return + call check(error, "", second_argument); if (allocated(error)) return + call check(error, "FLAG", flag); if (allocated(error)) return + deallocate (argument_array) +end subroutine + +! ************************************************************************ +! The restart flag requires at least one additional argument + +subroutine test_restart_bad_syntax(error) + type(error_type), allocatable, intent(out) :: error + + character(1024) :: filename, second_argument, flag + integer(IntKi) :: error_status + character(16), dimension(:), allocatable :: argument_array + + filename = "" + allocate (argument_array(1)) + argument_array = ["-restart "] + call hide_terminal_output() + call CheckArgs(filename, error_status, second_argument, flag, argument_array) + call show_terminal_output() + call check(error, "", filename); if (allocated(error)) return + call check(error, 4, error_status); if (allocated(error)) return + call check(error, "", second_argument); if (allocated(error)) return + call check(error, "RESTART", flag); if (allocated(error)) return + deallocate (argument_array) +end subroutine end module diff --git a/modules/version/tests/versioninfo_utest.F90 b/modules/version/tests/versioninfo_utest.F90 new file mode 100644 index 0000000000..c58ba55614 --- /dev/null +++ b/modules/version/tests/versioninfo_utest.F90 @@ -0,0 +1,33 @@ +program versioninfo_utest +use, intrinsic :: iso_fortran_env, only: error_unit +use testdrive, only: run_testsuite, new_testsuite, testsuite_type + +use test_VersionInfo_CheckArgs, only: test_VersionInfo_CheckArgs_suite +use NWTC_Num + +implicit none +integer :: stat, is +type(testsuite_type), allocatable :: testsuites(:) +character(len=*), parameter :: fmt = '("#", *(1x, a))' + +stat = 0 + +call SetConstants() + +testsuites = [ & + new_testsuite("test_VersionInfo_CheckArgs", test_VersionInfo_CheckArgs_suite) & + ] + +do is = 1, size(testsuites) + write (error_unit, fmt) "Testing:", testsuites(is)%name + call run_testsuite(testsuites(is)%collect, error_unit, stat) +end do + +if (stat > 0) then + write (error_unit, '(i0, 1x, a)') stat, "test(s) failed!" + error stop +end if + +write (error_unit, fmt) "All tests PASSED" + +end program diff --git a/modules/wakedynamics/CMakeLists.txt b/modules/wakedynamics/CMakeLists.txt index bab32ba8d0..aad8811799 100644 --- a/modules/wakedynamics/CMakeLists.txt +++ b/modules/wakedynamics/CMakeLists.txt @@ -17,7 +17,7 @@ if (GENERATE_TYPES) generate_f90_types(src/WakeDynamics_Registry.txt ${CMAKE_CURRENT_LIST_DIR}/src/WakeDynamics_Types.f90 -noextrap) endif() -add_library(wdlib +add_library(wdlib STATIC src/WakeDynamics.f90 #src/WakeDynamics_IO.f90 src/WakeDynamics_Types.f90 diff --git a/modules/wakedynamics/src/WakeDynamics.f90 b/modules/wakedynamics/src/WakeDynamics.f90 index 017d2e00e7..d8819d3950 100644 --- a/modules/wakedynamics/src/WakeDynamics.f90 +++ b/modules/wakedynamics/src/WakeDynamics.f90 @@ -380,8 +380,6 @@ end subroutine ThomasAlgorithm !! 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 @@ -420,9 +418,7 @@ subroutine WD_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut 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 + call ValidateInitInputData( interval, InitInp, InitInp%InputFileData, ErrStat2, ErrMsg2 ); if (Failed()) return; !............................................................................................ ! Define parameters @@ -439,16 +435,16 @@ subroutine WD_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut 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%k_vAmb = InitInp%InputFileData%k_vAmb + p%C_vAmb_FMin = InitInp%InputFileData%C_vAmb_FMin 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%k_vShr = InitInp%InputFileData%k_vShr + p%C_vShr_FMin = InitInp%InputFileData%C_vShr_FMin 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 ! Curl variables @@ -460,15 +456,22 @@ subroutine WD_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut p%k_vCurl = InitInp%InputFileData%k_vCurl p%OutAllPlanes = InitInp%InputFileData%OutAllPlanes ! Wake-Added Turbulence (WAT) variables - p%WAT = InitInp%InputFileData%WAT - p%WAT_k_Def = InitInp%InputFileData%WAT_k_Def - p%WAT_k_Grad = InitInp%InputFileData%WAT_k_Grad - + p%WAT = InitInp%InputFileData%WAT + p%WAT_k_Def_k_c = InitInp%InputFileData%WAT_k_Def_k_c + p%WAT_k_Def_FMin = InitInp%InputFileData%WAT_k_Def_FMin + p%WAT_k_Def_DMin = InitInp%InputFileData%WAT_k_Def_DMin + p%WAT_k_Def_DMax = InitInp%InputFileData%WAT_k_Def_DMax + p%WAT_k_Def_Exp = InitInp%InputFileData%WAT_k_Def_Exp + p%WAT_k_Grad_k_c = InitInp%InputFileData%WAT_k_Grad_k_c + p%WAT_k_Grad_FMin = InitInp%InputFileData%WAT_k_Grad_FMin + p%WAT_k_Grad_DMin = InitInp%InputFileData%WAT_k_Grad_DMin + p%WAT_k_Grad_DMax = InitInp%InputFileData%WAT_k_Grad_DMax + p%WAT_k_Grad_Exp = InitInp%InputFileData%WAT_k_Grad_Exp + ! Finite difference grid coordinates r, y, z - allocate( p%r(0:p%NumRadii-1),stat=errStat2) - if (errStat2 /= 0) call SetErrStat ( ErrID_Fatal, 'Could not allocate memory for p%r.', errStat, errMsg, RoutineName ) - allocate(p%y(-p%NumRadii+1:p%NumRadii-1), stat=errStat2); if (errStat2 /= 0) call SetErrStat ( ErrID_Fatal, 'Could not allocate memory for p%y.', errStat, errMsg, RoutineName ) - allocate(p%z(-p%NumRadii+1:p%NumRadii-1), stat=errStat2); if (errStat2 /= 0) call SetErrStat ( ErrID_Fatal, 'Could not allocate memory for p%z.', errStat, errMsg, RoutineName ) + allocate(p%r(0:p%NumRadii-1), stat=errStat2); if (Failed0('p%r.')) return; + allocate(p%y(-p%NumRadii+1:p%NumRadii-1), stat=errStat2); if (Failed0('p%y.')) return; + allocate(p%z(-p%NumRadii+1:p%NumRadii-1), stat=errStat2); if (Failed0('p%z.')) return; if (errStat /= ErrID_None) return do i = 0,p%NumRadii-1 p%r(i) = p%dr*i @@ -489,12 +492,9 @@ subroutine WD_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut ! 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 ) - allocate( u%Cq_azavg ( 0:p%NumRadii-1 ),stat=errStat2) - if (errStat2 /= 0) call SetErrStat ( ErrID_Fatal, 'Could not allocate memory for u%Cq_azavg.', errStat, errMsg, RoutineName ) + allocate( u%V_plane (3,0:p%NumPlanes-1),stat=errStat2); if (Failed0('u%V_plane.' )) return; + allocate( u%Ct_azavg ( 0:p%NumRadii-1 ),stat=errStat2); if (Failed0('u%Ct_azavg.')) return; + allocate( u%Cq_azavg ( 0:p%NumRadii-1 ),stat=errStat2); if (Failed0('u%Cq_azavg.')) return; if (errStat /= ErrID_None) return @@ -515,35 +515,23 @@ subroutine WD_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut x%DummyContState = 0.0_ReKi z%DummyConstrState = 0.0_ReKi - 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%Cq_azavg_filt (0:p%NumRadii-1) , STAT=ErrStat2 ) - if (errStat2 /= 0) call SetErrStat ( ErrID_Fatal, 'Could not allocate memory for xd%Cq_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 ) - allocate ( xd%Vx_wake2 (-p%NumRadii+1:p%NumRadii-1,-p%NumRadii+1: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 ) - if (errStat /= ErrID_None) return + allocate ( xd%xhat_plane (3, 0:p%NumPlanes-1), STAT=ErrStat2 ); if (Failed0('xd%xhat_plane.' )) return; + allocate ( xd%p_plane (3, 0:p%NumPlanes-1), STAT=ErrStat2 ); if (Failed0('xd%p_plane.' )) return; + allocate ( xd%V_plane_filt (3, 0:p%NumPlanes-1), STAT=ErrStat2 ); if (Failed0('xd%V_plane_filt.' )) return; + allocate ( xd%Vx_wind_disk_filt( 0:p%NumPlanes-1), STAT=ErrStat2 ); if (Failed0('xd%Vx_wind_disk_filt.')) return; + allocate ( xd%x_plane ( 0:p%NumPlanes-1), STAT=ErrStat2 ); if (Failed0('xd%x_plane.' )) return; + allocate ( xd%YawErr_filt ( 0:p%NumPlanes-1), STAT=ErrStat2 ); if (Failed0('xd%YawErr_filt.' )) return; + allocate ( xd%TI_amb_filt ( 0:p%NumPlanes-1), STAT=ErrStat2 ); if (Failed0('xd%TI_amb_filt.' )) return; + allocate ( xd%D_rotor_filt ( 0:p%NumPlanes-1), STAT=ErrStat2 ); if (Failed0('xd%D_rotor_filt.' )) return; + allocate ( xd%Ct_azavg_filt ( 0:p%NumRadii-1 ), STAT=ErrStat2 ); if (Failed0('xd%Ct_azavg_filt.' )) return; + allocate ( xd%Cq_azavg_filt ( 0:p%NumRadii-1 ), STAT=ErrStat2 ); if (Failed0('xd%Cq_azavg_filt.' )) return; + allocate ( xd%Vx_wake (0:p%NumRadii-1,0:p%NumPlanes-1), STAT=ErrStat2 ); if (Failed0('xd%Vx_wake.' )) return; + allocate ( xd%Vr_wake (0:p%NumRadii-1,0:p%NumPlanes-1), STAT=ErrStat2 ); if (Failed0('xd%Vr_wake.' )) return; + allocate ( xd%Vx_wake2 (-p%NumRadii+1:p%NumRadii-1,-p%NumRadii+1:p%NumRadii-1,0:p%NumPlanes-1), STAT=ErrStat2 ); if (Failed0('xd%Vx_wake.')) return; ! Curl - allocate ( xd%Vy_wake2 (-p%NumRadii+1:p%NumRadii-1,-p%NumRadii+1:p%NumRadii-1,0:p%NumPlanes-1), STAT=ErrStat2 ); if (errStat2 /= 0) call SetErrStat ( ErrID_Fatal, 'Could not allocate memory for xd%Vy_wake.', errStat, errMsg, RoutineName ) - allocate ( xd%Vz_wake2 (-p%NumRadii+1:p%NumRadii-1,-p%NumRadii+1:p%NumRadii-1,0:p%NumPlanes-1), STAT=ErrStat2 ); if (errStat2 /= 0) call SetErrStat ( ErrID_Fatal, 'Could not allocate memory for xd%Vz_wake.', errStat, errMsg, RoutineName ) - if (errStat /= ErrID_None) return + allocate ( xd%Vy_wake2 (-p%NumRadii+1:p%NumRadii-1,-p%NumRadii+1:p%NumRadii-1,0:p%NumPlanes-1), STAT=ErrStat2 ); if (Failed0('xd%Vy_wake.')) return; + allocate ( xd%Vz_wake2 (-p%NumRadii+1:p%NumRadii-1,-p%NumRadii+1:p%NumRadii-1,0:p%NumPlanes-1), STAT=ErrStat2 ); if (Failed0('xd%Vz_wake.')) return; xd%YawErr_filt = 0.0_ReKi !NOTE: initialized in InitStatesWithInputs xd%psi_skew_filt = 0.0_ReKi !NOTE: initialized in InitStatesWithInputs @@ -562,32 +550,31 @@ subroutine WD_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut xd%Vx_rel_disk_filt = 0.0_ReKi xd%Ct_azavg_filt = 0.0_ReKi xd%Cq_azavg_filt = 0.0_ReKi - OtherState%firstPass = .true. + OtherState%firstPass = .true. ! miscvars to avoid the allocation per timestep ! Cartesian eddy viscosity (allocated even for polar if plane outputs are requested) - allocate ( m%vt_tot2(-p%NumRadii+1:p%NumRadii-1,-p%NumRadii+1:p%NumRadii-1,0:p%NumPlanes-1), STAT=ErrStat2 ); if (errStat2 /= 0) call SetErrStat ( ErrID_Fatal, 'Could not allocate memory for m%vt_tot2.', errStat, errMsg, RoutineName ) - allocate ( m%vt_amb2(-p%NumRadii+1:p%NumRadii-1,-p%NumRadii+1:p%NumRadii-1,0:p%NumPlanes-1), STAT=ErrStat2 ); if (errStat2 /= 0) call SetErrStat ( ErrID_Fatal, 'Could not allocate memory for m%vt_amb2.', errStat, errMsg, RoutineName ) - allocate ( m%vt_shr2(-p%NumRadii+1:p%NumRadii-1,-p%NumRadii+1:p%NumRadii-1,0:p%NumPlanes-1), STAT=ErrStat2 ); if (errStat2 /= 0) call SetErrStat ( ErrID_Fatal, 'Could not allocate memory for m%vt_shr2.', errStat, errMsg, RoutineName ) - if (errStat /= ErrID_None) return + allocate ( m%vt_tot2(-p%NumRadii+1:p%NumRadii-1,-p%NumRadii+1:p%NumRadii-1,0:p%NumPlanes-1), STAT=ErrStat2 ); if (Failed0('m%vt_tot2.')) return; + allocate ( m%vt_amb2(-p%NumRadii+1:p%NumRadii-1,-p%NumRadii+1:p%NumRadii-1,0:p%NumPlanes-1), STAT=ErrStat2 ); if (Failed0('m%vt_amb2.')) return; + allocate ( m%vt_shr2(-p%NumRadii+1:p%NumRadii-1,-p%NumRadii+1:p%NumRadii-1,0:p%NumPlanes-1), STAT=ErrStat2 ); if (Failed0('m%vt_shr2.')) return; + allocate ( m%dvx_dy (-p%NumRadii+1:p%NumRadii-1,-p%NumRadii+1:p%NumRadii-1,0:p%NumPlanes-1), STAT=ErrStat2 ); if (Failed0('m%dvx_dy.')) return; + allocate ( m%dvx_dz (-p%NumRadii+1:p%NumRadii-1,-p%NumRadii+1:p%NumRadii-1,0:p%NumPlanes-1), STAT=ErrStat2 ); if (Failed0('m%dvx_dz.')) return; m%vt_tot2 = 0.0_ReKi m%vt_amb2 = 0.0_ReKi m%vt_shr2 = 0.0_ReKi + m%dvx_dy = 0.0_ReKi + m%dvx_dz = 0.0_ReKi if (p%Mod_Wake == Mod_Wake_Polar) then - 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%dvtdr (0:p%NumRadii-1 ) , STAT=ErrStat2 ); if (Failed0('m%dvtdr.')) return; + allocate ( m%vt_tot (0:p%NumRadii-1,0:p%NumPlanes-1 ) , STAT=ErrStat2 ); if (Failed0('m%vt_tot.')) return; + allocate ( m%vt_amb (0:p%NumRadii-1,0:p%NumPlanes-1 ) , STAT=ErrStat2 ); if (Failed0('m%vt_amb.')) return; + allocate ( m%vt_shr (0:p%NumRadii-1,0:p%NumPlanes-1 ) , STAT=ErrStat2 ); if (Failed0('m%vt_shr.')) return; else if (p%Mod_Wake == Mod_Wake_Cartesian .or. p%Mod_Wake == Mod_Wake_Curl) then - allocate ( m%dvx_dy (-p%NumRadii+1:p%NumRadii-1,-p%NumRadii+1:p%NumRadii-1,0:p%NumPlanes-1), STAT=ErrStat2 ); if (errStat2 /= 0) call SetErrStat ( ErrID_Fatal, 'Could not allocate memory for m%dvx_dy.', errStat, errMsg, RoutineName ) - allocate ( m%dvx_dz (-p%NumRadii+1:p%NumRadii-1,-p%NumRadii+1:p%NumRadii-1,0:p%NumPlanes-1), STAT=ErrStat2 ); if (errStat2 /= 0) call SetErrStat ( ErrID_Fatal, 'Could not allocate memory for m%dvx_dz.', errStat, errMsg, RoutineName ) - allocate ( m%nu_dvx_dy(-p%NumRadii+1:p%NumRadii-1,-p%NumRadii+1:p%NumRadii-1), STAT=ErrStat2 ); if (errStat2 /= 0) call SetErrStat ( ErrID_Fatal, 'Could not allocate memory for m%nu_dvx_dy.', errStat, errMsg, RoutineName ) - allocate ( m%nu_dvx_dz(-p%NumRadii+1:p%NumRadii-1,-p%NumRadii+1:p%NumRadii-1), STAT=ErrStat2 ); if (errStat2 /= 0) call SetErrStat ( ErrID_Fatal, 'Could not allocate memory for m%nu_dvx_dz.', errStat, errMsg, RoutineName ) - allocate ( m%dnuvx_dy (-p%NumRadii+1:p%NumRadii-1,-p%NumRadii+1:p%NumRadii-1), STAT=ErrStat2 ); if (errStat2 /= 0) call SetErrStat ( ErrID_Fatal, 'Could not allocate memory for m%dnuvx_dy.', errStat, errMsg, RoutineName ) - allocate ( m%dnuvx_dz (-p%NumRadii+1:p%NumRadii-1,-p%NumRadii+1:p%NumRadii-1), STAT=ErrStat2 ); if (errStat2 /= 0) call SetErrStat ( ErrID_Fatal, 'Could not allocate memory for m%dnuvx_dz.', errStat, errMsg, RoutineName ) + allocate ( m%nu_dvx_dy(-p%NumRadii+1:p%NumRadii-1,-p%NumRadii+1:p%NumRadii-1), STAT=ErrStat2 ); if (Failed0('m%nu_dvx_dy.')) return; + allocate ( m%nu_dvx_dz(-p%NumRadii+1:p%NumRadii-1,-p%NumRadii+1:p%NumRadii-1), STAT=ErrStat2 ); if (Failed0('m%nu_dvx_dz.')) return; + allocate ( m%dnuvx_dy (-p%NumRadii+1:p%NumRadii-1,-p%NumRadii+1:p%NumRadii-1), STAT=ErrStat2 ); if (Failed0('m%dnuvx_dy.' )) return; + allocate ( m%dnuvx_dz (-p%NumRadii+1:p%NumRadii-1,-p%NumRadii+1:p%NumRadii-1), STAT=ErrStat2 ); if (Failed0('m%dnuvx_dz.' )) return; if (errStat /= ErrID_None) return - m%dvx_dy = 0.0_ReKi - m%dvx_dz = 0.0_ReKi m%nu_dvx_dy = 0.0_ReKi m%nu_dvx_dz = 0.0_ReKi m%dnuvx_dy = 0.0_ReKi @@ -597,23 +584,14 @@ subroutine WD_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut endif - 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 ) - allocate ( m%Vt_wake(0:p%NumRadii-1 ) , STAT=ErrStat2 ) - if (errStat2 /= 0) call SetErrStat ( ErrID_Fatal, 'Could not allocate memory for m%Vx_high.', errStat, errMsg, RoutineName ) - allocate ( m%Vx_polar(0:p%NumRadii-1 ) , STAT=ErrStat2 ) - if (errStat2 /= 0) call SetErrStat ( ErrID_Fatal, 'Could not allocate memory for m%Vx_polar.', errStat, errMsg, RoutineName ) - if (errStat /= ErrID_None) return + allocate ( m%a(0:p%NumRadii-1 ), STAT=ErrStat2 ); if (Failed0('m%a.')) return; + allocate ( m%b(0:p%NumRadii-1 ), STAT=ErrStat2 ); if (Failed0('m%b.')) return; + allocate ( m%c(0:p%NumRadii-1 ), STAT=ErrStat2 ); if (Failed0('m%c.')) return; + allocate ( m%d(0:p%NumRadii-1 ), STAT=ErrStat2 ); if (Failed0('m%d.')) return; + allocate ( m%r_wake(0:p%NumRadii-1 ), STAT=ErrStat2 ); if (Failed0('m%r_wake.' )) return; + allocate ( m%Vx_high(0:p%NumRadii-1 ), STAT=ErrStat2 ); if (Failed0('m%Vx_high.' )) return; + allocate ( m%Vt_wake(0:p%NumRadii-1 ), STAT=ErrStat2 ); if (Failed0('m%Vx_high.' )) return; + allocate ( m%Vx_polar(0:p%NumRadii-1 ), STAT=ErrStat2 ); if (Failed0('m%Vx_polar.')) return; m%Vx_polar = 0.0_ReKi m%Vt_wake = 0.0_ReKi !............................................................................................ @@ -622,26 +600,18 @@ subroutine WD_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut 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%Vx_wake2 (-p%NumRadii+1:p%NumRadii-1,-p%NumRadii+1: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%Vy_wake2 (-p%NumRadii+1:p%NumRadii-1,-p%NumRadii+1:p%NumRadii-1,0:p%NumPlanes-1), STAT=ErrStat2 ); if (errStat2 /= 0) call SetErrStat ( ErrID_Fatal, 'Could not allocate memory for y%Vy_wake.', errStat, errMsg, RoutineName ) - allocate ( y%Vz_wake2 (-p%NumRadii+1:p%NumRadii-1,-p%NumRadii+1:p%NumRadii-1,0:p%NumPlanes-1), STAT=ErrStat2 ); if (errStat2 /= 0) call SetErrStat ( ErrID_Fatal, 'Could not allocate memory for y%Vz_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 ) - allocate ( y%WAT_k_mt (-p%NumRadii+1:p%NumRadii-1,-p%NumRadii+1:p%NumRadii-1,0:p%NumPlanes-1), STAT=ErrStat2 ) - if (errStat2 /= 0) call SetErrStat ( ErrID_Fatal, 'Could not allocate memory for y%WAT_k_mt.', errStat, errMsg, RoutineName ) - if (errStat /= ErrID_None) return + allocate ( y%xhat_plane(3,0:p%NumPlanes-1), STAT=ErrStat2 ); if (Failed0('y%xhat_plane.')) return; + allocate ( y%p_plane (3,0:p%NumPlanes-1), STAT=ErrStat2 ); if (Failed0('y%p_plane.' )) return; + allocate ( y%Vx_wake (0:p%NumRadii-1,0:p%NumPlanes-1), STAT=ErrStat2 ); if (Failed0('y%Vx_wake.' )) return; + allocate ( y%Vr_wake (0:p%NumRadii-1,0:p%NumPlanes-1), STAT=ErrStat2 ); if (Failed0('y%Vr_wake.' )) return; + + allocate ( y%Vx_wake2 (-p%NumRadii+1:p%NumRadii-1,-p%NumRadii+1:p%NumRadii-1,0:p%NumPlanes-1), STAT=ErrStat2 ); if (Failed0('y%Vx_wake.')) return; + allocate ( y%Vy_wake2 (-p%NumRadii+1:p%NumRadii-1,-p%NumRadii+1:p%NumRadii-1,0:p%NumPlanes-1), STAT=ErrStat2 ); if (Failed0('y%Vy_wake.')) return; + allocate ( y%Vz_wake2 (-p%NumRadii+1:p%NumRadii-1,-p%NumRadii+1:p%NumRadii-1,0:p%NumPlanes-1), STAT=ErrStat2 ); if (Failed0('y%Vz_wake.')) return; + + allocate ( y%D_wake (0:p%NumPlanes-1), STAT=ErrStat2 ); if (Failed0('y%D_wake.' )) return; + allocate ( y%x_plane (0:p%NumPlanes-1), STAT=ErrStat2 ); if (Failed0('y%x_plane.')) return; + allocate ( y%WAT_k (-p%NumRadii+1:p%NumRadii-1,-p%NumRadii+1:p%NumRadii-1,0:p%NumPlanes-1), STAT=ErrStat2 ); if (Failed0('y%WAT_k.')) return; y%xhat_plane = 0.0_Reki y%p_plane = 0.0_Reki @@ -652,15 +622,29 @@ subroutine WD_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut y%Vz_wake2 = 0.0_Reki y%D_wake = 0.0_Reki y%x_plane = 0.0_Reki - y%WAT_k_mt = 0.0_Reki - + y%WAT_k = 0.0_Reki + +contains + logical function Failed() + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function Failed + + ! check for failed where /= 0 is fatal + logical function Failed0(txt) + character(*), intent(in) :: txt + if (errStat /= 0) then + ErrStat2 = ErrID_Fatal + ErrMsg2 = "Could not allocate memory for "//trim(txt) + call SetErrStat(errStat2, errMsg2, errStat, errMsg, RoutineName) + endif + Failed0 = errStat >= AbortErrLev + end function Failed0 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 @@ -672,33 +656,17 @@ subroutine WD_End( u, p, x, xd, z, OtherState, y, m, errStat, errMsg ) 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 ) @@ -706,12 +674,7 @@ subroutine WD_End( u, p, x, xd, z, OtherState, y, m, 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. @@ -1431,6 +1394,23 @@ subroutine FilterVx(Vx, nf) end subroutine FilterVx +!> Compute exp(k*x) avoiding underflow and overflow +!! Note: the small and large limits were set arbitrarily.. +!! exp(-20) = 2.0e-9 +!! exp( 20) = 4.9e8 +function exp_safe(x) + real(ReKi) :: exp_safe + real(ReKi), intent(in) :: x + real(ReKi) :: exp_term + if (x<-20) then + exp_safe = 0.0_ReKi + elseif (x>20) then + exp_safe = exp(20._ReKi) + else + exp_safe = exp(x) + endif +end function exp_safe + subroutine WD_TEST_Axi2Cart() real(ReKi) :: r(4)=(/0.,1.,2.,3./) ! real(ReKi) :: y(4)=(/-1.,0.,1.5,2./) @@ -1476,8 +1456,6 @@ subroutine WD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, errStat, errMsg ) ! 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. !.................................................................................................................................. - use VTK ! - 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 @@ -1490,9 +1468,7 @@ subroutine WD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, errStat, errMsg ) 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(intKi) :: n, i, iy, iz, maxPln + integer(intKi) :: n, i, iy, iz, maxPln, j integer(intKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'WD_CalcOutput' @@ -1558,11 +1534,19 @@ subroutine WD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, errStat, errMsg ) end do end if + ! --- Velocity deficits on Cartesian grid if (p%Mod_Wake == Mod_Wake_Polar) then ! Convert to Cartesian do i = 0, maxPln call Axisymmetric2CartesianVel(y%Vx_wake(:,i), y%Vr_wake(:,i), p%r, p%y, p%z, y%Vx_wake2(:,:,i), y%Vy_wake2(:,:,i), y%Vz_wake2(:,:,i)) enddo + if ( p%WAT ) then + ! Compute gradients of dVx/dy and dVx/dz on Cartesian grid + do i = 0, maxPln + call gradient_y(y%Vx_wake2(:,:,i), p%dr, m%dvx_dy(:,:,i)) + call gradient_z(y%Vx_wake2(:,:,i), p%dr, m%dvx_dz(:,:,i)) + end do + endif if (p%OutAllPlanes) then do i = 0, maxPln call Axisymmetric2Cartesian(m%vt_amb(:,i), p%r, p%y, p%z, m%vt_amb2(:,:,i)) @@ -1580,11 +1564,29 @@ subroutine WD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, errStat, errMsg ) ! --- WAT - Compute k_mt and add turbulence if ( p%WAT ) then + call Calc_k_WAT() + end if + +contains + subroutine Calc_k_WAT() + integer(intKi) :: i, iy, iz + real(ReKi) :: C, S, dvdr, dvdtheta_r, R, r_tmp + real(ReKi) :: x_over_D, U0, k_Def, k_Grad + character(1024):: tmpStr + logical, parameter :: verbose =.False. + + ! We use the same method for all Mod_Wake (everything on the Cartesian grid) R = u%D_Rotor /2 - do i = 1,maxPln - if ( EqualRealNos( xd%Vx_wind_disk_filt(i), 0.0_ReKi ) ) then - y%WAT_k_mt(:,:,i) = 0.0_ReKi + do i = 0,maxPln + U0 = xd%Vx_wind_disk_filt(i) + if ( EqualRealNos( U0, 0.0_ReKi ) ) then + y%WAT_k(:,:,i) = 0.0_ReKi + if(verbose) write(tmpStr,'(A,I3,A)') 'Plane:',i,' Velocity zero' + if(verbose) call WrScr(trim(tmpStr)) else + ! calculate k_Def and k_Grad with EddyFilter (see Torque 2024, E. Branlard for derivation) + k_Def = p%WAT_k_Def_k_c * EddyFilter(xd%x_plane(i), u%D_rotor, p%WAT_k_Def_Dmin, p%WAT_k_Def_Dmax, p%WAT_k_Def_Fmin, p%WAT_k_Def_Exp ) + k_Grad = p%WAT_k_Grad_k_c * EddyFilter(xd%x_plane(i), u%D_rotor, p%WAT_k_Grad_Dmin, p%WAT_k_Grad_Dmax, p%WAT_k_Grad_Fmin, p%WAT_k_Grad_Exp ) do iz = -p%NumRadii+1, p%NumRadii-1 do iy = -p%NumRadii+1, p%NumRadii-1 ! Polar gradients @@ -1594,20 +1596,23 @@ subroutine WD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, errStat, errMsg ) C = 0.0_ReKi dvdtheta_r = 0.0_ReKi else - S=p%z(iz)/r_tmp ! Sine - C=p%y(iy)/r_tmp ! Cosine + S = p%z(iz)/r_tmp ! Sine + C = p%y(iy)/r_tmp ! Cosine dvdtheta_r = (m%dvx_dy(iy,iz,i) * (-p%z(iz)) + m%dvx_dz(iy,iz,i) * p%y(iy)) / r_tmp endif dvdr = m%dvx_dy(iy,iz,i) * C + m%dvx_dz(iy,iz,i) * S - ! Calculate scaling factor k_mt for wake-added Turbulence - y%WAT_k_mt(iy,iz,i) = p%WAT_k_Def * abs(1 - ((xd%Vx_wind_disk_filt(i)+y%Vx_wake2(iy,iz,i))/xd%Vx_wind_disk_filt(i)) ) & - + p%WAT_k_Grad/xd%Vx_wind_disk_filt(i) * R * ( abs(dvdr) + abs(dvdtheta_r) ) + ! Calculate scaling factor k_mt for wake-added Turbulence (equation 16) + y%WAT_k(iy,iz,i) = (k_Def /U0 * abs(y%Vx_wake2(iy,iz,i)) & + & + k_Grad/U0 * R * ( abs(dvdr) + abs(dvdtheta_r) )) end do ! iy end do ! iz + if(verbose) write(tmpStr,'(A,I3,A,F6.2,A,F6.3,A,F6.3,A,F8.3)') 'Plane:',i,' x/D:',xd%x_plane(i)/u%D_rotor,' kmax:',maxval(y%WAT_k(:,:,i)), ' velmax:',maxval(abs(y%Vx_wake2(:,:,i))) + if(verbose) call WrScr(trim(tmpStr)) endif - end do ! i, plane + end do !i, planes +! print*,'kmax ', maxval(y%WAT_k(:,:,0)), maxval(y%WAT_k(:,:,1)) , maxval(y%WAT_k(:,:,maxPln-1)), maxval(y%WAT_k(:,:,maxPln)) - end if + end subroutine Calc_k_WAT end subroutine WD_CalcOutput @@ -1641,9 +1646,9 @@ subroutine WD_WritePlaneOutputs( t, u, p, x, xd, z, OtherState, y, m, errStat, e n = nint(t/p%DT_low) ! --- VTK outputs per plane if (p%OutAllPlanes) then - call vtk_misc_init(mvtk) - call set_vtk_binary_format(.false., mvtk) - do i = 0, min(n-1,p%NumPlanes-1), 1 + call vtk_misc_init(mvtk) + call set_vtk_binary_format(.false., mvtk) + do i = 0, min(n-1,p%NumPlanes-1), 1 ! if (EqualRealNos(t,0.0_DbKi) ) then ! write(Filename,'(A,I4.4,A)') trim(p%OutFileVTKDir)//'/PlaneOutputsAtPlane_',i,'_Init.vtk' ! else @@ -1661,37 +1666,37 @@ subroutine WD_WritePlaneOutputs( t, u, p, x, xd, z, OtherState, y, m, errStat, e ! call vtk_close_file(mvtk) ! endif - ! --- Output Plane "per time" - write(Filename,'(A,I9.9,A,I4.4,A)') trim(p%OutFileVTKDir)// PathSep //trim(p%OutFileRoot)//'.WT'//trim(num2lstr(p%TurbNum))//'.PlaneAtTime_',int(t*100),'_Plane_',i,'.vtk' - if ( vtk_new_ascii_file(trim(filename),'vel',mvtk) ) then - dx(1) = 0.0 - dx(2) = p%dr - dx(3) = p%dr - x0(1) = xd%p_plane(1,i) - x0(2) = xd%p_plane(2,i) - p%dr*p%NumRadii - x0(3) = xd%p_plane(3,i) - p%dr*p%NumRadii - call vtk_dataset_structured_points(x0, dx, (/1,p%NumRadii*2-1,p%NumRadii*2-1/),mvtk) - call vtk_point_data_init(mvtk) - call vtk_point_data_scalar(y%Vx_wake2(:,:,i),'Vx',mvtk) - call vtk_point_data_scalar(y%Vy_wake2(:,:,i),'Vy',mvtk) - call vtk_point_data_scalar(y%Vz_wake2(:,:,i),'Vz',mvtk) - call vtk_point_data_scalar(m%vt_amb2(:,:,i),'vt_amb2', mvtk) - call vtk_point_data_scalar(m%vt_shr2(:,:,i),'vt_shr2', mvtk) - call vtk_point_data_scalar(m%vt_tot2(:,:,i),'vt_tot2', mvtk) - - if (p%Mod_Wake == Mod_Wake_Cartesian .or. p%Mod_Wake == Mod_Wake_Curl) then - call vtk_point_data_scalar(m%dvx_dy(:,:,i),'dvx_dy', mvtk) - call vtk_point_data_scalar(m%dvx_dz(:,:,i),'dvx_dz', mvtk) - endif - if (p%WAT) then - call vtk_point_data_scalar(y%WAT_k_mt(:,:,i),'k_mt', mvtk) - endif - call vtk_close_file(mvtk) - else - call SetErrStat(ErrID_Fatal, '[INFO] Failed to write: '//trim(filename), errStat, errMsg, RoutineName) - endif - enddo ! loop on planes - endif + ! --- Output Plane "per time" + write(Filename,'(A,I9.9,A,I4.4,A)') trim(p%OutFileVTKDir)// PathSep //trim(p%OutFileRoot)//'.WT'//trim(num2lstr(p%TurbNum))//'.PlaneAtTime_',int(t*100),'_Plane_',i,'.vtk' + if ( vtk_new_ascii_file(trim(filename),'vel',mvtk) ) then + dx(1) = 0.0 + dx(2) = p%dr + dx(3) = p%dr + x0(1) = xd%p_plane(1,i) + x0(2) = xd%p_plane(2,i) - p%dr*p%NumRadii + x0(3) = xd%p_plane(3,i) - p%dr*p%NumRadii + call vtk_dataset_structured_points(x0, dx, (/1,p%NumRadii*2-1,p%NumRadii*2-1/),mvtk) + call vtk_point_data_init(mvtk) + call vtk_point_data_scalar(y%Vx_wake2(:,:,i),'Vx',mvtk) + call vtk_point_data_scalar(y%Vy_wake2(:,:,i),'Vy',mvtk) + call vtk_point_data_scalar(y%Vz_wake2(:,:,i),'Vz',mvtk) + call vtk_point_data_scalar(m%vt_amb2(:,:,i),'vt_amb2', mvtk) + call vtk_point_data_scalar(m%vt_shr2(:,:,i),'vt_shr2', mvtk) + call vtk_point_data_scalar(m%vt_tot2(:,:,i),'vt_tot2', mvtk) + + if (p%Mod_Wake == Mod_Wake_Cartesian .or. p%Mod_Wake == Mod_Wake_Curl) then + call vtk_point_data_scalar(m%dvx_dy(:,:,i),'dvx_dy', mvtk) + call vtk_point_data_scalar(m%dvx_dz(:,:,i),'dvx_dz', mvtk) + endif + if ( p%WAT ) then + call vtk_point_data_scalar(y%WAT_k(:,:,i),'WAT_k', mvtk) + endif + call vtk_close_file(mvtk) + else + call SetErrStat(ErrID_Fatal, '[INFO] Failed to write: '//trim(filename), errStat, errMsg, RoutineName) + endif + enddo ! loop on planes + endif end subroutine WD_WritePlaneOutputs @@ -1699,8 +1704,6 @@ end subroutine WD_WritePlaneOutputs !---------------------------------------------------------------------------------------------------------------------------------- !> 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 @@ -1714,26 +1717,17 @@ subroutine WD_CalcConstrStateResidual( Time, u, p, x, xd, z, OtherState, m, z_re 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 @@ -1794,15 +1788,11 @@ 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 character(*), parameter :: RoutineName = 'ValidateInitInputData' @@ -1810,7 +1800,6 @@ SUBROUTINE ValidateInitInputData( DT_low, InitInp, InputFileData, errStat, errMs 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 ) diff --git a/modules/wakedynamics/src/WakeDynamics_Registry.txt b/modules/wakedynamics/src/WakeDynamics_Registry.txt index c43ed68667..0116e82cb1 100644 --- a/modules/wakedynamics/src/WakeDynamics_Registry.txt +++ b/modules/wakedynamics/src/WakeDynamics_Registry.txt @@ -14,13 +14,13 @@ 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" - -param ^ - INTEGER Mod_Wake_Polar - 1 - "Wake model" - -param ^ - INTEGER Mod_Wake_Curl - 2 - "Wake model" - -param ^ - INTEGER Mod_Wake_Cartesian - 3 - "Wake model" - +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" - +param ^ - INTEGER Mod_Wake_Polar - 1 - "Wake model" - +param ^ - INTEGER Mod_Wake_Curl - 2 - "Wake model" - +param ^ - INTEGER Mod_Wake_Cartesian - 3 - "Wake model" - # ..... InputFile Data ....................................................................................................... typedef ^ WD_InputFileType ReKi dr - - - "Radial increment of radial finite-difference grid [>0.0]" m @@ -34,14 +34,14 @@ typedef ^ WD_InputFileType ReKi C_HWkDfl_x - - 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_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_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 k_vShr - - - "Calibrated parameter for the influence of the shear layer in the eddy viscosity [>=0.0]" - +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_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]" - @@ -54,10 +54,19 @@ typedef ^ WD_InputFileType IntKi FilterInit - - typedef ^ WD_InputFileType ReKi k_vCurl - - - "Calibrated parameter for the eddy viscosity in curled-wake model [>=0.0]" - typedef ^ WD_InputFileType Logical OutAllPlanes - - - "Output all planes" - # wake added turbulence (WAT) inputs -typedef ^ WD_InputFileType LOGICAL WAT - - - "Switch for turning on and off wake-added turbulence" - -typedef ^ WD_InputFileType ReKi WAT_k_Def - - - "Calibrated parameter for the influence of the wake deficit in the wake-added Turbulence (-) [>=0.0] or DEFAULT [DEFAULT=0.6]" - -typedef ^ WD_InputFileType ReKi WAT_k_Grad - - - "Calibrated parameter for the influence of the radial velocity gradient of the wake deficit in the wake-added Turbulence (-) [>=0.0] or DEFAULT [DEFAULT=0.35]" - - +typedef ^ WD_InputFileType Logical WAT - - - "Switch for turning on and off wake-added turbulence" - +#typedef ^ WD_InputFileType ReKi WAT_k_Def {5} - - "Calibrated parameters for the influence of the maximum wake deficit on wake-added turbulence (set of 5 parameters: k_Def , FMin, DMin, DMax, Exp) (-) [>=0.0, >=0.0 and <=1.0, >=0.0, >DMin, >0.0] or DEFAULT [DEFAULT=[0.6, 0.0, 0.0, 2.0, 1.0 ]]" - +typedef ^ WD_InputFileType ReKi WAT_k_Def_k_c - - - "Calibrated parameter for the influence of the maximum wake deficit on wake-added turblence (-) [>=0] or DEFAULT [DEFAULT=0.6]" - +typedef ^ WD_InputFileType ReKi WAT_k_Def_FMin - - - "Calibrated parameter in the eddy viscosity filter function for the WAT maximum wake deficit defining the value in the minimum region [>=0.0 and <=1.0] or DEFAULT [DEFAULT=0.0]" - +typedef ^ WD_InputFileType ReKi WAT_k_Def_DMin - - - "Calibrated parameter in the eddy viscosity filter function for the WAT maximum wake deficit defining the transitional diameter fraction between the minimum and exponential regions [>=0.0] or DEFAULT [DEFAULT=0.0]" - +typedef ^ WD_InputFileType ReKi WAT_k_Def_DMax - - - "Calibrated parameter in the eddy viscosity filter function for the WAT maximum wake deficit defining the transitional diameter fraction between the exponential and maximum regions [> WAT_k_Def_DMin] or DEFAULT [DEFAULT=2.0]" - +typedef ^ WD_InputFileType ReKi WAT_k_Def_Exp - - - "Calibrated parameter in the eddy viscosity filter function for the WAT maximum wake deficit defining the exponent in the exponential region [> 0.0] or DEFAULT [DEFAULT=1.0]" - +#typedef ^ WD_InputFileType ReKi WAT_k_Grad {5} - - ""Calibrated parameters for the influence of the radial velocity gradient of the wake deficit on wake-added turbulence (set of 5 parameters: k_Grad, FMin, DMin, DMax, Exp) (-) [>=0.0, >=0.0 and <=1.0, >=0.0, >DMin, >=0.0] or DEFAULT [DEFAULT=[3.0, 0.0, 0.0, 12.0, 0.65]"" - +typedef ^ WD_InputFileType ReKi WAT_k_Grad_k_c - - - "Calibrated parameter for the influence of the radial velocity gradient of the wake deficit on wake-added turblence (-) [>=0] or DEFAULT [DEFAULT=3.0]" - +typedef ^ WD_InputFileType ReKi WAT_k_Grad_FMin - - - "Calibrated parameter in the eddy viscosity filter function for the WAT radial velocity gradient of the wake deficit defining the value in the minimum region [>=0.0 and <=1.0] or DEFAULT [DEFAULT=0.0]" - +typedef ^ WD_InputFileType ReKi WAT_k_Grad_DMin - - - "Calibrated parameter in the eddy viscosity filter function for the WAT radial velocity gradient of the wake deficit defining the transitional diameter fraction between the minimum and exponential regions [>=0.0] or DEFAULT [DEFAULT=0.0]" - +typedef ^ WD_InputFileType ReKi WAT_k_Grad_DMax - - - "Calibrated parameter in the eddy viscosity filter function for the WAT radial velocity gradient of the wake deficit defining the transitional diameter fraction between the exponential and maximum regions [> WAT_k_Grad_DMin] or DEFAULT [DEFAULT=12.0]" - +typedef ^ WD_InputFileType ReKi WAT_k_Grad_Exp - - - "Calibrated parameter in the eddy viscosity filter function for the WAT radial velocity gradient of the wake deficit defining the exponent in the exponential region [> 0.0] or DEFAULT [DEFAULT=0.65]" - # ..... Initialization data ....................................................................................................... # Define inputs that the initialization routine may need here: @@ -154,16 +163,16 @@ typedef ^ ParameterType ReKi C_HWkDfl_OY - - - "Calibrated pa 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 k_vAmb - - - "Calibrated parameter for the influence of ambient turbulence in the eddy viscosity" - 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 k_vShr - - - "Calibrated parameter for the influence of the shear layer in the eddy viscosity" - 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" - typedef ^ ParameterType IntKi FilterInit - - - "Switch to filter the initial wake plane deficit and select the number of grid points for the filter {0: no filter, 1: filter of size 1} or DEFAULT [DEFAULT=0: if Mod_Wake is 1 or 3, or DEFAULT=2: if Mod_Wwake is 2] (switch)" @@ -173,9 +182,19 @@ typedef ^ ParameterType CHARACTER(1024) OutFileRoot - - - "The root name typedef ^ ParameterType CHARACTER(1024) OutFileVTKDir - - - "The parent directory for all VTK files written by WD" - typedef ^ ParameterType IntKi TurbNum - 0 - "Turbine ID number (start with 1; end with number of turbines)" - # wake added turbulence (WAT) parameters -typedef ^ ParameterType LOGICAL WAT - - - "Switch for turning on and off wake-added turbulence" - -typedef ^ ParameterType ReKi WAT_k_Def - - - "Calibrated parameter for the influence of the wake deficit in the wake-added Turbulence (-) [>=0.0] or DEFAULT [DEFAULT=0.6]" - -typedef ^ ParameterType ReKi WAT_k_Grad - - - "Calibrated parameter for the influence of the radial velocity gradient of the wake deficit in the wake-added Turbulence (-) [>=0.0] or DEFAULT [DEFAULT=0.35]" - +typedef ^ ParameterType Logical WAT - - - "Switch for turning on and off wake-added turbulence" - +#typedef ^ ParameterType ReKi WAT_k_Def {5} - - "Calibrated parameters for the influence of the maximum wake deficit on wake-added turbulence (set of 5 parameters: k_Def , FMin, DMin, DMax, Exp) (-) [>=0.0, >=0.0 and <=1.0, >=0.0, >DMin, >0.0] or DEFAULT [DEFAULT=[0.6, 0.0, 0.0, 2.0, 1.0 ]]" - +typedef ^ ParameterType ReKi WAT_k_Def_k_c - - - "Calibrated parameter for the influence of the maximum wake deficit on wake-added turblence (-) [>=0] or DEFAULT [DEFAULT=0.6]" - +typedef ^ ParameterType ReKi WAT_k_Def_FMin - - - "Calibrated parameter in the eddy viscosity filter function for the WAT maximum wake deficit defining the value in the minimum region [>=0.0 and <=1.0] or DEFAULT [DEFAULT=0.0]" - +typedef ^ ParameterType ReKi WAT_k_Def_DMin - - - "Calibrated parameter in the eddy viscosity filter function for the WAT maximum wake deficit defining the transitional diameter fraction between the minimum and exponential regions [>=0.0] or DEFAULT [DEFAULT=0.0]" - +typedef ^ ParameterType ReKi WAT_k_Def_DMax - - - "Calibrated parameter in the eddy viscosity filter function for the WAT maximum wake deficit defining the transitional diameter fraction between the exponential and maximum regions [> WAT_k_Def_DMin] or DEFAULT [DEFAULT=2.0]" - +typedef ^ ParameterType ReKi WAT_k_Def_Exp - - - "Calibrated parameter in the eddy viscosity filter function for the WAT maximum wake deficit defining the exponent in the exponential region [> 0.0] or DEFAULT [DEFAULT=1.0]" - +#typedef ^ ParameterType ReKi WAT_k_Grad {5} - - ""Calibrated parameters for the influence of the radial velocity gradient of the wake deficit on wake-added turbulence (set of 5 parameters: k_Grad, FMin, DMin, DMax, Exp) (-) [>=0.0, >=0.0 and <=1.0, >=0.0, >DMin, >=0.0] or DEFAULT [DEFAULT=[3.0, 0.0, 0.0, 12.0, 0.65]"" - +typedef ^ ParameterType ReKi WAT_k_Grad_k_c - - - "Calibrated parameter for the influence of the radial velocity gradient of the wake deficit on wake-added turblence (-) [>=0] or DEFAULT [DEFAULT=3.0]" - +typedef ^ ParameterType ReKi WAT_k_Grad_FMin - - - "Calibrated parameter in the eddy viscosity filter function for the WAT radial velocity gradient of the wake deficit defining the value in the minimum region [>=0.0 and <=1.0] or DEFAULT [DEFAULT=0.0]" - +typedef ^ ParameterType ReKi WAT_k_Grad_DMin - - - "Calibrated parameter in the eddy viscosity filter function for the WAT radial velocity gradient of the wake deficit defining the transitional diameter fraction between the minimum and exponential regions [>=0.0] or DEFAULT [DEFAULT=0.0]" - +typedef ^ ParameterType ReKi WAT_k_Grad_DMax - - - "Calibrated parameter in the eddy viscosity filter function for the WAT radial velocity gradient of the wake deficit defining the transitional diameter fraction between the exponential and maximum regions [> WAT_k_Grad_DMin] or DEFAULT [DEFAULT=12.0]" - +typedef ^ ParameterType ReKi WAT_k_Grad_Exp - - - "Calibrated parameter in the eddy viscosity filter function for the WAT radial velocity gradient of the wake deficit defining the exponent in the exponential region [> 0.0] or DEFAULT [DEFAULT=0.65]" - # ..... Inputs .................................................................................................................... # Define inputs that are contained on the mesh here: typedef ^ InputType ReKi xhat_disk {3} - - "Orientation of rotor centerline, normal to disk" - @@ -203,5 +222,5 @@ typedef ^ OutputType ReKi Vy_wake2 {:}{:}{:} typedef ^ OutputType ReKi Vz_wake2 {:}{:}{:} - - "Transverse nominally vertical wake velocity deficit at wake planes, distributed across the plane" 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 -typedef ^ OutputType ReKi WAT_k_mt {:}{:}{:} - - "Scaling factor k_mt(iP,y,z) for wake-added turbulence" - +typedef ^ OutputType ReKi WAT_k {:}{:}{:} - - "Scaling factor k_mt(iP,y,z) for wake-added turbulence" - diff --git a/modules/wakedynamics/src/WakeDynamics_Types.f90 b/modules/wakedynamics/src/WakeDynamics_Types.f90 index 72d92c9089..289e7e42b8 100644 --- a/modules/wakedynamics/src/WakeDynamics_Types.f90 +++ b/modules/wakedynamics/src/WakeDynamics_Types.f90 @@ -42,38 +42,46 @@ MODULE WakeDynamics_Types INTEGER(IntKi), PUBLIC, PARAMETER :: Mod_Wake_Cartesian = 3 ! Wake model [-] ! ========= 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] [-] - INTEGER(IntKi) :: Mod_Wake !< Switch between wake formulations 1=Polar, 2=Cartesian, 3=Curl [-] - 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] [-] - LOGICAL :: Swirl !< Switch to add swirl [only used if Mod_Wake=2 or 2] [-] - REAL(ReKi) :: k_VortexDecay !< Vortex decay constant for curl [-] - REAL(ReKi) :: sigma_D !< The width of the Gaussian vortices used for the curled wake model divided by diameter [-] - INTEGER(IntKi) :: NumVortices !< The number of vortices used for the curled wake model [-] - INTEGER(IntKi) :: FilterInit !< Switch to filter the initial wake plane deficit and select the number of grid points for the filter {0: no filter, 1: filter of size 1} or DEFAULT [DEFAULT=0: if Mod_Wake is 1 or 3, or DEFAULT=2: if Mod_Wwake is 2] (switch) [-] - REAL(ReKi) :: k_vCurl !< Calibrated parameter for the eddy viscosity in curled-wake model [>=0.0] [-] - LOGICAL :: OutAllPlanes !< Output all planes [-] - LOGICAL :: WAT !< Switch for turning on and off wake-added turbulence [-] - REAL(ReKi) :: WAT_k_Def !< Calibrated parameter for the influence of the wake deficit in the wake-added Turbulence (-) [>=0.0] or DEFAULT [DEFAULT=0.6] [-] - REAL(ReKi) :: WAT_k_Grad !< Calibrated parameter for the influence of the radial velocity gradient of the wake deficit in the wake-added Turbulence (-) [>=0.0] or DEFAULT [DEFAULT=0.35] [-] + REAL(ReKi) :: dr = 0.0_ReKi !< Radial increment of radial finite-difference grid [>0.0] [m] + INTEGER(IntKi) :: NumRadii = 0_IntKi !< Number of radii in the radial finite-difference grid [>=2] [-] + INTEGER(IntKi) :: NumPlanes = 0_IntKi !< Number of wake planes [>=2] [-] + INTEGER(IntKi) :: Mod_Wake = 0_IntKi !< Switch between wake formulations 1=Polar, 2=Cartesian, 3=Curl [-] + REAL(ReKi) :: f_c = 0.0_ReKi !< 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 = 0.0_ReKi !< Calibrated parameter in the correction for wake deflection defining the horizontal offset at the rotor [m] + REAL(ReKi) :: C_HWkDfl_OY = 0.0_ReKi !< 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 = 0.0_ReKi !< Calibrated parameter in the correction for wake deflection defining the horizontal offset scaled with downstream distance [-] + REAL(ReKi) :: C_HWkDfl_xY = 0.0_ReKi !< 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 = 0.0_ReKi !< Calibrated parameter for the near-wake correction [>-1.0] [-] + REAL(ReKi) :: k_vAmb = 0.0_ReKi !< Calibrated parameter for the influence of ambient turbulence in the eddy viscosity [>=0.0] [-] + REAL(ReKi) :: C_vAmb_FMin = 0.0_ReKi !< 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_DMin = 0.0_ReKi !< 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 = 0.0_ReKi !< 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_Exp = 0.0_ReKi !< Calibrated parameter in the eddy viscosity filter function for ambient turbulence defining the exponent in the exponential region [> 0.0] [-] + REAL(ReKi) :: k_vShr = 0.0_ReKi !< Calibrated parameter for the influence of the shear layer in the eddy viscosity [>=0.0] [-] + REAL(ReKi) :: C_vShr_FMin = 0.0_ReKi !< 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_DMin = 0.0_ReKi !< 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 = 0.0_ReKi !< 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_Exp = 0.0_ReKi !< 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 = 0_IntKi !< Wake diameter calculation model {1: rotor diameter, 2: velocity-based, 3: mass-flux based, 4: momentum-flux based} [DEFAULT=1] [-] + REAL(ReKi) :: C_WakeDiam = 0.0_ReKi !< Calibrated parameter for wake diameter calculation [>0.0 and <1.0] [unused for Mod_WakeDiam=1] [-] + LOGICAL :: Swirl = .false. !< Switch to add swirl [only used if Mod_Wake=2 or 2] [-] + REAL(ReKi) :: k_VortexDecay = 0.0_ReKi !< Vortex decay constant for curl [-] + REAL(ReKi) :: sigma_D = 0.0_ReKi !< The width of the Gaussian vortices used for the curled wake model divided by diameter [-] + INTEGER(IntKi) :: NumVortices = 0_IntKi !< The number of vortices used for the curled wake model [-] + INTEGER(IntKi) :: FilterInit = 0_IntKi !< Switch to filter the initial wake plane deficit and select the number of grid points for the filter {0: no filter, 1: filter of size 1} or DEFAULT [DEFAULT=0: if Mod_Wake is 1 or 3, or DEFAULT=2: if Mod_Wwake is 2] (switch) [-] + REAL(ReKi) :: k_vCurl = 0.0_ReKi !< Calibrated parameter for the eddy viscosity in curled-wake model [>=0.0] [-] + LOGICAL :: OutAllPlanes = .false. !< Output all planes [-] + LOGICAL :: WAT = .false. !< Switch for turning on and off wake-added turbulence [-] + REAL(ReKi) :: WAT_k_Def_k_c = 0.0_ReKi !< Calibrated parameter for the influence of the maximum wake deficit on wake-added turblence (-) [>=0] or DEFAULT [DEFAULT=0.6] [-] + REAL(ReKi) :: WAT_k_Def_FMin = 0.0_ReKi !< Calibrated parameter in the eddy viscosity filter function for the WAT maximum wake deficit defining the value in the minimum region [>=0.0 and <=1.0] or DEFAULT [DEFAULT=0.0] [-] + REAL(ReKi) :: WAT_k_Def_DMin = 0.0_ReKi !< Calibrated parameter in the eddy viscosity filter function for the WAT maximum wake deficit defining the transitional diameter fraction between the minimum and exponential regions [>=0.0] or DEFAULT [DEFAULT=0.0] [-] + REAL(ReKi) :: WAT_k_Def_DMax = 0.0_ReKi !< Calibrated parameter in the eddy viscosity filter function for the WAT maximum wake deficit defining the transitional diameter fraction between the exponential and maximum regions [> WAT_k_Def_DMin] or DEFAULT [DEFAULT=2.0] [-] + REAL(ReKi) :: WAT_k_Def_Exp = 0.0_ReKi !< Calibrated parameter in the eddy viscosity filter function for the WAT maximum wake deficit defining the exponent in the exponential region [> 0.0] or DEFAULT [DEFAULT=1.0] [-] + REAL(ReKi) :: WAT_k_Grad_k_c = 0.0_ReKi !< Calibrated parameter for the influence of the radial velocity gradient of the wake deficit on wake-added turblence (-) [>=0] or DEFAULT [DEFAULT=3.0] [-] + REAL(ReKi) :: WAT_k_Grad_FMin = 0.0_ReKi !< Calibrated parameter in the eddy viscosity filter function for the WAT radial velocity gradient of the wake deficit defining the value in the minimum region [>=0.0 and <=1.0] or DEFAULT [DEFAULT=0.0] [-] + REAL(ReKi) :: WAT_k_Grad_DMin = 0.0_ReKi !< Calibrated parameter in the eddy viscosity filter function for the WAT radial velocity gradient of the wake deficit defining the transitional diameter fraction between the minimum and exponential regions [>=0.0] or DEFAULT [DEFAULT=0.0] [-] + REAL(ReKi) :: WAT_k_Grad_DMax = 0.0_ReKi !< Calibrated parameter in the eddy viscosity filter function for the WAT radial velocity gradient of the wake deficit defining the transitional diameter fraction between the exponential and maximum regions [> WAT_k_Grad_DMin] or DEFAULT [DEFAULT=12.0] [-] + REAL(ReKi) :: WAT_k_Grad_Exp = 0.0_ReKi !< Calibrated parameter in the eddy viscosity filter function for the WAT radial velocity gradient of the wake deficit defining the exponent in the exponential region [> 0.0] or DEFAULT [DEFAULT=0.65] [-] END TYPE WD_InputFileType ! ======================= ! ========= WD_InitInputType ======= @@ -92,15 +100,15 @@ MODULE WakeDynamics_Types ! ======================= ! ========= WD_ContinuousStateType ======= TYPE, PUBLIC :: WD_ContinuousStateType - REAL(ReKi) :: DummyContState !< Remove this variable if you have continuous states [-] + REAL(ReKi) :: DummyContState = 0.0_ReKi !< 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 :: YawErr_filt !< Time-filtered nacelle-yaw error at the wake planes [rad] - REAL(ReKi) :: psi_skew_filt !< Time-filtered azimuth angle from skew vertical axis [rad] - REAL(ReKi) :: chi_skew_filt !< Time-filtered inflow skew angle [rad] + REAL(ReKi) :: psi_skew_filt = 0.0_ReKi !< Time-filtered azimuth angle from skew vertical axis [rad] + REAL(ReKi) :: chi_skew_filt = 0.0_ReKi !< Time-filtered inflow skew angle [rad] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: V_plane_filt !< Time-filtered advection, deflection, and meandering velocity of wake planes [m/s] 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] @@ -112,19 +120,19 @@ MODULE WakeDynamics_Types 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) :: Vx_rel_disk_filt = 0.0_ReKi !< 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 :: Cq_azavg_filt !< Time-filtered azimuthally averaged torque coefficient (normal to disk), distributed radially [-] END TYPE WD_DiscreteStateType ! ======================= ! ========= WD_ConstraintStateType ======= TYPE, PUBLIC :: WD_ConstraintStateType - REAL(ReKi) :: DummyConstrState !< Remove this variable if you have constraint states [-] + REAL(ReKi) :: DummyConstrState = 0.0_ReKi !< 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 [-] + LOGICAL :: firstPass = .false. !< Flag indicating whether or not the states have been initialized with proper inputs [-] END TYPE WD_OtherStateType ! ======================= ! ========= WD_MiscVarType ======= @@ -150,66 +158,74 @@ MODULE WakeDynamics_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Vx_high !< [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Vx_polar !< Vx as function of r for Cartesian implementation [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Vt_wake !< Vr as function of r for Cartesian implementation [-] - REAL(ReKi) :: GammaCurl !< Circulation used in Curled wake model [-] - REAL(ReKi) :: Ct_avg !< Circulation used in Curled wake model [-] + REAL(ReKi) :: GammaCurl = 0.0_ReKi !< Circulation used in Curled wake model [-] + REAL(ReKi) :: Ct_avg = 0.0_ReKi !< Circulation used in Curled wake model [-] 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(DbKi) :: dt_low = 0.0_R8Ki !< Time interval for wake dynamics calculations {or default} [s] + INTEGER(IntKi) :: NumPlanes = 0_IntKi !< Number of wake planes [-] + INTEGER(IntKi) :: NumRadii = 0_IntKi !< Number of radii in the radial finite-difference grid [-] + REAL(ReKi) :: dr = 0.0_ReKi !< Radial increment of radial finite-difference grid [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: r !< Discretization of radial finite-difference grid [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: y !< Horizontal discretization of each wake plane (size ny=2nr-1) [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: z !< Nomically-vertical discretization of each wake plane (size nz=2nr-1) [m] - INTEGER(IntKi) :: Mod_Wake !< Switch between wake formulations 1=Polar, 2=Curl, 3=Cartesian [-] - LOGICAL :: Swirl !< Switch to add swirl [only used if Mod_Wake=2 or 2] [-] - REAL(ReKi) :: k_VortexDecay !< Vortex decay constant for curl [-] - REAL(ReKi) :: sigma_D !< The width of the Gaussian vortices used for the curled wake model divided by diameter [-] - INTEGER(IntKi) :: NumVortices !< The number of vortices used for the curled wake model [-] - 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 [-] - INTEGER(IntKi) :: FilterInit !< Switch to filter the initial wake plane deficit and select the number of grid points for the filter {0: no filter, 1: filter of size 1} or DEFAULT [DEFAULT=0: if Mod_Wake is 1 or 3, or DEFAULT=2: if Mod_Wwake is 2] (switch) [-] - REAL(ReKi) :: k_vCurl !< Calibrated parameter for the eddy viscosity in curled-wake model [>=0.0] [-] - LOGICAL :: OutAllPlanes !< Output all planes [-] + INTEGER(IntKi) :: Mod_Wake = 0_IntKi !< Switch between wake formulations 1=Polar, 2=Curl, 3=Cartesian [-] + LOGICAL :: Swirl = .false. !< Switch to add swirl [only used if Mod_Wake=2 or 2] [-] + REAL(ReKi) :: k_VortexDecay = 0.0_ReKi !< Vortex decay constant for curl [-] + REAL(ReKi) :: sigma_D = 0.0_ReKi !< The width of the Gaussian vortices used for the curled wake model divided by diameter [-] + INTEGER(IntKi) :: NumVortices = 0_IntKi !< The number of vortices used for the curled wake model [-] + REAL(ReKi) :: filtParam = 0.0_ReKi !< Low-pass time-filter parameter, with a value between 0 (minimum filtering) and 1 (maximum filtering) (exclusive) [-] + REAL(ReKi) :: oneMinusFiltParam = 0.0_ReKi !< 1.0 - filtParam [-] + REAL(ReKi) :: C_HWkDfl_O = 0.0_ReKi !< Calibrated parameter in the correction for wake deflection defining the horizontal offset at the rotor [m] + REAL(ReKi) :: C_HWkDfl_OY = 0.0_ReKi !< 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 = 0.0_ReKi !< Calibrated parameter in the correction for wake deflection defining the horizontal offset scaled with downstream distance [-] + REAL(ReKi) :: C_HWkDfl_xY = 0.0_ReKi !< 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 = 0.0_ReKi !< Calibrated parameter for near-wake correction [-] + REAL(ReKi) :: k_vAmb = 0.0_ReKi !< Calibrated parameter for the influence of ambient turbulence in the eddy viscosity [-] + REAL(ReKi) :: C_vAmb_DMin = 0.0_ReKi !< 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 = 0.0_ReKi !< 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 = 0.0_ReKi !< Calibrated parameter in the eddy viscosity filter function for ambient turbulence defining the functional value in the minimum region [-] + REAL(ReKi) :: C_vAmb_Exp = 0.0_ReKi !< Calibrated parameter in the eddy viscosity filter function for ambient turbulence defining the exponent in the exponential region [-] + REAL(ReKi) :: k_vShr = 0.0_ReKi !< Calibrated parameter for the influence of the shear layer in the eddy viscosity [-] + REAL(ReKi) :: C_vShr_DMin = 0.0_ReKi !< 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 = 0.0_ReKi !< 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 = 0.0_ReKi !< 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 = 0.0_ReKi !< Calibrated parameter in the eddy viscosity filter function for the shear layer defining the exponent in the exponential region [-] + INTEGER(IntKi) :: Mod_WakeDiam = 0_IntKi !< Wake diameter calculation model [-] + REAL(ReKi) :: C_WakeDiam = 0.0_ReKi !< Calibrated parameter for wake diameter calculation [-] + INTEGER(IntKi) :: FilterInit = 0_IntKi !< Switch to filter the initial wake plane deficit and select the number of grid points for the filter {0: no filter, 1: filter of size 1} or DEFAULT [DEFAULT=0: if Mod_Wake is 1 or 3, or DEFAULT=2: if Mod_Wwake is 2] (switch) [-] + REAL(ReKi) :: k_vCurl = 0.0_ReKi !< Calibrated parameter for the eddy viscosity in curled-wake model [>=0.0] [-] + LOGICAL :: OutAllPlanes = .false. !< Output all planes [-] CHARACTER(1024) :: OutFileRoot !< The root name derived from the primary FAST.Farm input file [-] CHARACTER(1024) :: OutFileVTKDir !< The parent directory for all VTK files written by WD [-] INTEGER(IntKi) :: TurbNum = 0 !< Turbine ID number (start with 1; end with number of turbines) [-] - LOGICAL :: WAT !< Switch for turning on and off wake-added turbulence [-] - REAL(ReKi) :: WAT_k_Def !< Calibrated parameter for the influence of the wake deficit in the wake-added Turbulence (-) [>=0.0] or DEFAULT [DEFAULT=0.6] [-] - REAL(ReKi) :: WAT_k_Grad !< Calibrated parameter for the influence of the radial velocity gradient of the wake deficit in the wake-added Turbulence (-) [>=0.0] or DEFAULT [DEFAULT=0.35] [-] + LOGICAL :: WAT = .false. !< Switch for turning on and off wake-added turbulence [-] + REAL(ReKi) :: WAT_k_Def_k_c = 0.0_ReKi !< Calibrated parameter for the influence of the maximum wake deficit on wake-added turblence (-) [>=0] or DEFAULT [DEFAULT=0.6] [-] + REAL(ReKi) :: WAT_k_Def_FMin = 0.0_ReKi !< Calibrated parameter in the eddy viscosity filter function for the WAT maximum wake deficit defining the value in the minimum region [>=0.0 and <=1.0] or DEFAULT [DEFAULT=0.0] [-] + REAL(ReKi) :: WAT_k_Def_DMin = 0.0_ReKi !< Calibrated parameter in the eddy viscosity filter function for the WAT maximum wake deficit defining the transitional diameter fraction between the minimum and exponential regions [>=0.0] or DEFAULT [DEFAULT=0.0] [-] + REAL(ReKi) :: WAT_k_Def_DMax = 0.0_ReKi !< Calibrated parameter in the eddy viscosity filter function for the WAT maximum wake deficit defining the transitional diameter fraction between the exponential and maximum regions [> WAT_k_Def_DMin] or DEFAULT [DEFAULT=2.0] [-] + REAL(ReKi) :: WAT_k_Def_Exp = 0.0_ReKi !< Calibrated parameter in the eddy viscosity filter function for the WAT maximum wake deficit defining the exponent in the exponential region [> 0.0] or DEFAULT [DEFAULT=1.0] [-] + REAL(ReKi) :: WAT_k_Grad_k_c = 0.0_ReKi !< Calibrated parameter for the influence of the radial velocity gradient of the wake deficit on wake-added turblence (-) [>=0] or DEFAULT [DEFAULT=3.0] [-] + REAL(ReKi) :: WAT_k_Grad_FMin = 0.0_ReKi !< Calibrated parameter in the eddy viscosity filter function for the WAT radial velocity gradient of the wake deficit defining the value in the minimum region [>=0.0 and <=1.0] or DEFAULT [DEFAULT=0.0] [-] + REAL(ReKi) :: WAT_k_Grad_DMin = 0.0_ReKi !< Calibrated parameter in the eddy viscosity filter function for the WAT radial velocity gradient of the wake deficit defining the transitional diameter fraction between the minimum and exponential regions [>=0.0] or DEFAULT [DEFAULT=0.0] [-] + REAL(ReKi) :: WAT_k_Grad_DMax = 0.0_ReKi !< Calibrated parameter in the eddy viscosity filter function for the WAT radial velocity gradient of the wake deficit defining the transitional diameter fraction between the exponential and maximum regions [> WAT_k_Grad_DMin] or DEFAULT [DEFAULT=12.0] [-] + REAL(ReKi) :: WAT_k_Grad_Exp = 0.0_ReKi !< Calibrated parameter in the eddy viscosity filter function for the WAT radial velocity gradient of the wake deficit defining the exponent in the exponential region [> 0.0] or DEFAULT [DEFAULT=0.65] [-] 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) :: YawErr !< Nacelle-yaw error at the wake planes [rad] - REAL(ReKi) :: psi_skew !< Azimuth angle from the nominally vertical axis in the disk plane to the vector about which the inflow skew angle is defined [rad] - REAL(ReKi) :: chi_skew !< Inflow skew angle [rad] - REAL(ReKi) , DIMENSION(1:3) :: p_hub !< Center position of hub [m] + REAL(ReKi) , DIMENSION(1:3) :: xhat_disk = 0.0_ReKi !< Orientation of rotor centerline, normal to disk [-] + REAL(ReKi) :: YawErr = 0.0_ReKi !< Nacelle-yaw error at the wake planes [rad] + REAL(ReKi) :: psi_skew = 0.0_ReKi !< Azimuth angle from the nominally vertical axis in the disk plane to the vector about which the inflow skew angle is defined [rad] + REAL(ReKi) :: chi_skew = 0.0_ReKi !< Inflow skew angle [rad] + REAL(ReKi) , DIMENSION(1:3) :: p_hub = 0.0_ReKi !< 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) :: Vx_wind_disk = 0.0_ReKi !< Rotor-disk-averaged ambient wind speed, normal to planes [m/s] + REAL(ReKi) :: TI_amb = 0.0_ReKi !< Ambient turbulence intensity of wind at rotor disk [-] + REAL(ReKi) :: D_rotor = 0.0_ReKi !< Rotor diameter [m] + REAL(ReKi) :: Vx_rel_disk = 0.0_ReKi !< 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) , DIMENSION(:), ALLOCATABLE :: Cq_azavg !< Azimuthally averaged torque coefficient (normal to disk), distributed radially [-] END TYPE WD_InputType @@ -225,5578 +241,1675 @@ MODULE WakeDynamics_Types REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: Vz_wake2 !< Transverse nominally vertical wake velocity deficit at wake planes, distributed across the plane [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] - REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: WAT_k_mt !< Scaling factor k_mt(iP,y,z) for wake-added turbulence [-] + REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: WAT_k !< Scaling factor k_mt(iP,y,z) for wake-added turbulence [-] 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) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - 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%Mod_Wake = SrcInputFileTypeData%Mod_Wake - 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 - DstInputFileTypeData%Swirl = SrcInputFileTypeData%Swirl - DstInputFileTypeData%k_VortexDecay = SrcInputFileTypeData%k_VortexDecay - DstInputFileTypeData%sigma_D = SrcInputFileTypeData%sigma_D - DstInputFileTypeData%NumVortices = SrcInputFileTypeData%NumVortices - DstInputFileTypeData%FilterInit = SrcInputFileTypeData%FilterInit - DstInputFileTypeData%k_vCurl = SrcInputFileTypeData%k_vCurl - DstInputFileTypeData%OutAllPlanes = SrcInputFileTypeData%OutAllPlanes - DstInputFileTypeData%WAT = SrcInputFileTypeData%WAT - DstInputFileTypeData%WAT_k_Def = SrcInputFileTypeData%WAT_k_Def - DstInputFileTypeData%WAT_k_Grad = SrcInputFileTypeData%WAT_k_Grad - END SUBROUTINE WD_CopyInputFileType - - SUBROUTINE WD_DestroyInputFileType( InputFileTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(WD_InputFileType), INTENT(INOUT) :: InputFileTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WD_DestroyInputFileType' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - 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 - Int_BufSz = Int_BufSz + 1 ! Mod_Wake - 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 - Int_BufSz = Int_BufSz + 1 ! Swirl - Re_BufSz = Re_BufSz + 1 ! k_VortexDecay - Re_BufSz = Re_BufSz + 1 ! sigma_D - Int_BufSz = Int_BufSz + 1 ! NumVortices - Int_BufSz = Int_BufSz + 1 ! FilterInit - Re_BufSz = Re_BufSz + 1 ! k_vCurl - Int_BufSz = Int_BufSz + 1 ! OutAllPlanes - Int_BufSz = Int_BufSz + 1 ! WAT - Re_BufSz = Re_BufSz + 1 ! WAT_k_Def - Re_BufSz = Re_BufSz + 1 ! WAT_k_Grad - 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 - IntKiBuf(Int_Xferred) = InData%Mod_Wake - 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 - IntKiBuf(Int_Xferred) = TRANSFER(InData%Swirl, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%k_VortexDecay - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%sigma_D - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumVortices - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%FilterInit - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%k_vCurl - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%OutAllPlanes, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%WAT, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WAT_k_Def - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WAT_k_Grad - 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) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - 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%Mod_Wake = 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 - OutData%Swirl = TRANSFER(IntKiBuf(Int_Xferred), OutData%Swirl) - Int_Xferred = Int_Xferred + 1 - OutData%k_VortexDecay = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%sigma_D = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NumVortices = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%FilterInit = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%k_vCurl = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%OutAllPlanes = TRANSFER(IntKiBuf(Int_Xferred), OutData%OutAllPlanes) - Int_Xferred = Int_Xferred + 1 - OutData%WAT = TRANSFER(IntKiBuf(Int_Xferred), OutData%WAT) - Int_Xferred = Int_Xferred + 1 - OutData%WAT_k_Def = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%WAT_k_Grad = 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' -! +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 + character(*), parameter :: RoutineName = 'WD_CopyInputFileType' 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 - DstInitInputData%OutFileRoot = SrcInitInputData%OutFileRoot - END SUBROUTINE WD_CopyInitInput - - SUBROUTINE WD_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(WD_InitInputType), INTENT(INOUT) :: InitInputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WD_DestroyInitInput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL WD_Destroyinputfiletype( InitInputData%InputFileData, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - 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 - Int_BufSz = Int_BufSz + 1*LEN(InData%OutFileRoot) ! OutFileRoot - 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 - DO I = 1, LEN(InData%OutFileRoot) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutFileRoot(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - 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 - DO I = 1, LEN(OutData%OutFileRoot) - OutData%OutFileRoot(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - 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' -! + ErrMsg = '' + DstInputFileTypeData%dr = SrcInputFileTypeData%dr + DstInputFileTypeData%NumRadii = SrcInputFileTypeData%NumRadii + DstInputFileTypeData%NumPlanes = SrcInputFileTypeData%NumPlanes + DstInputFileTypeData%Mod_Wake = SrcInputFileTypeData%Mod_Wake + 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%C_vAmb_FMin = SrcInputFileTypeData%C_vAmb_FMin + DstInputFileTypeData%C_vAmb_DMin = SrcInputFileTypeData%C_vAmb_DMin + DstInputFileTypeData%C_vAmb_DMax = SrcInputFileTypeData%C_vAmb_DMax + DstInputFileTypeData%C_vAmb_Exp = SrcInputFileTypeData%C_vAmb_Exp + DstInputFileTypeData%k_vShr = SrcInputFileTypeData%k_vShr + DstInputFileTypeData%C_vShr_FMin = SrcInputFileTypeData%C_vShr_FMin + DstInputFileTypeData%C_vShr_DMin = SrcInputFileTypeData%C_vShr_DMin + DstInputFileTypeData%C_vShr_DMax = SrcInputFileTypeData%C_vShr_DMax + DstInputFileTypeData%C_vShr_Exp = SrcInputFileTypeData%C_vShr_Exp + DstInputFileTypeData%Mod_WakeDiam = SrcInputFileTypeData%Mod_WakeDiam + DstInputFileTypeData%C_WakeDiam = SrcInputFileTypeData%C_WakeDiam + DstInputFileTypeData%Swirl = SrcInputFileTypeData%Swirl + DstInputFileTypeData%k_VortexDecay = SrcInputFileTypeData%k_VortexDecay + DstInputFileTypeData%sigma_D = SrcInputFileTypeData%sigma_D + DstInputFileTypeData%NumVortices = SrcInputFileTypeData%NumVortices + DstInputFileTypeData%FilterInit = SrcInputFileTypeData%FilterInit + DstInputFileTypeData%k_vCurl = SrcInputFileTypeData%k_vCurl + DstInputFileTypeData%OutAllPlanes = SrcInputFileTypeData%OutAllPlanes + DstInputFileTypeData%WAT = SrcInputFileTypeData%WAT + DstInputFileTypeData%WAT_k_Def_k_c = SrcInputFileTypeData%WAT_k_Def_k_c + DstInputFileTypeData%WAT_k_Def_FMin = SrcInputFileTypeData%WAT_k_Def_FMin + DstInputFileTypeData%WAT_k_Def_DMin = SrcInputFileTypeData%WAT_k_Def_DMin + DstInputFileTypeData%WAT_k_Def_DMax = SrcInputFileTypeData%WAT_k_Def_DMax + DstInputFileTypeData%WAT_k_Def_Exp = SrcInputFileTypeData%WAT_k_Def_Exp + DstInputFileTypeData%WAT_k_Grad_k_c = SrcInputFileTypeData%WAT_k_Grad_k_c + DstInputFileTypeData%WAT_k_Grad_FMin = SrcInputFileTypeData%WAT_k_Grad_FMin + DstInputFileTypeData%WAT_k_Grad_DMin = SrcInputFileTypeData%WAT_k_Grad_DMin + DstInputFileTypeData%WAT_k_Grad_DMax = SrcInputFileTypeData%WAT_k_Grad_DMax + DstInputFileTypeData%WAT_k_Grad_Exp = SrcInputFileTypeData%WAT_k_Grad_Exp +end subroutine + +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' 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, DEALLOCATEpointers ) - TYPE(WD_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WD_DestroyInitOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(InitOutputData%WriteOutputHdr)) THEN - DEALLOCATE(InitOutputData%WriteOutputHdr) -ENDIF -IF (ALLOCATED(InitOutputData%WriteOutputUnt)) THEN - DEALLOCATE(InitOutputData%WriteOutputUnt) -ENDIF - CALL NWTC_Library_Destroyprogdesc( InitOutputData%Ver, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - 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' -! + ErrMsg = '' +end subroutine + +subroutine WD_PackInputFileType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(WD_InputFileType), intent(in) :: InData + character(*), parameter :: RoutineName = 'WD_PackInputFileType' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%dr) + call RegPack(RF, InData%NumRadii) + call RegPack(RF, InData%NumPlanes) + call RegPack(RF, InData%Mod_Wake) + call RegPack(RF, InData%f_c) + call RegPack(RF, InData%C_HWkDfl_O) + call RegPack(RF, InData%C_HWkDfl_OY) + call RegPack(RF, InData%C_HWkDfl_x) + call RegPack(RF, InData%C_HWkDfl_xY) + call RegPack(RF, InData%C_NearWake) + call RegPack(RF, InData%k_vAmb) + call RegPack(RF, InData%C_vAmb_FMin) + call RegPack(RF, InData%C_vAmb_DMin) + call RegPack(RF, InData%C_vAmb_DMax) + call RegPack(RF, InData%C_vAmb_Exp) + call RegPack(RF, InData%k_vShr) + call RegPack(RF, InData%C_vShr_FMin) + call RegPack(RF, InData%C_vShr_DMin) + call RegPack(RF, InData%C_vShr_DMax) + call RegPack(RF, InData%C_vShr_Exp) + call RegPack(RF, InData%Mod_WakeDiam) + call RegPack(RF, InData%C_WakeDiam) + call RegPack(RF, InData%Swirl) + call RegPack(RF, InData%k_VortexDecay) + call RegPack(RF, InData%sigma_D) + call RegPack(RF, InData%NumVortices) + call RegPack(RF, InData%FilterInit) + call RegPack(RF, InData%k_vCurl) + call RegPack(RF, InData%OutAllPlanes) + call RegPack(RF, InData%WAT) + call RegPack(RF, InData%WAT_k_Def_k_c) + call RegPack(RF, InData%WAT_k_Def_FMin) + call RegPack(RF, InData%WAT_k_Def_DMin) + call RegPack(RF, InData%WAT_k_Def_DMax) + call RegPack(RF, InData%WAT_k_Def_Exp) + call RegPack(RF, InData%WAT_k_Grad_k_c) + call RegPack(RF, InData%WAT_k_Grad_FMin) + call RegPack(RF, InData%WAT_k_Grad_DMin) + call RegPack(RF, InData%WAT_k_Grad_DMax) + call RegPack(RF, InData%WAT_k_Grad_Exp) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine WD_UnPackInputFileType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(WD_InputFileType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'WD_UnPackInputFileType' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%dr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumRadii); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumPlanes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Mod_Wake); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%f_c); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%C_HWkDfl_O); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%C_HWkDfl_OY); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%C_HWkDfl_x); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%C_HWkDfl_xY); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%C_NearWake); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%k_vAmb); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%C_vAmb_FMin); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%C_vAmb_DMin); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%C_vAmb_DMax); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%C_vAmb_Exp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%k_vShr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%C_vShr_FMin); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%C_vShr_DMin); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%C_vShr_DMax); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%C_vShr_Exp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Mod_WakeDiam); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%C_WakeDiam); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Swirl); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%k_VortexDecay); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%sigma_D); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumVortices); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FilterInit); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%k_vCurl); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutAllPlanes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WAT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WAT_k_Def_k_c); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WAT_k_Def_FMin); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WAT_k_Def_DMin); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WAT_k_Def_DMax); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WAT_k_Def_Exp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WAT_k_Grad_k_c); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WAT_k_Grad_FMin); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WAT_k_Grad_DMin); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WAT_k_Grad_DMax); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WAT_k_Grad_Exp); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +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 + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'WD_CopyInitInput' ErrStat = ErrID_None - ErrMsg = "" - DstContStateData%DummyContState = SrcContStateData%DummyContState - END SUBROUTINE WD_CopyContState - - SUBROUTINE WD_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(WD_ContinuousStateType), INTENT(INOUT) :: ContStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WD_DestroyContState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - 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) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WD_CopyDiscState' -! + 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 + DstInitInputData%OutFileRoot = SrcInitInputData%OutFileRoot +end subroutine + +subroutine WD_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(WD_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'WD_DestroyInitInput' 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%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 - DstDiscStateData%psi_skew_filt = SrcDiscStateData%psi_skew_filt - DstDiscStateData%chi_skew_filt = SrcDiscStateData%chi_skew_filt -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%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%Vx_wake2)) THEN - i1_l = LBOUND(SrcDiscStateData%Vx_wake2,1) - i1_u = UBOUND(SrcDiscStateData%Vx_wake2,1) - i2_l = LBOUND(SrcDiscStateData%Vx_wake2,2) - i2_u = UBOUND(SrcDiscStateData%Vx_wake2,2) - i3_l = LBOUND(SrcDiscStateData%Vx_wake2,3) - i3_u = UBOUND(SrcDiscStateData%Vx_wake2,3) - IF (.NOT. ALLOCATED(DstDiscStateData%Vx_wake2)) THEN - ALLOCATE(DstDiscStateData%Vx_wake2(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Vx_wake2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%Vx_wake2 = SrcDiscStateData%Vx_wake2 -ENDIF -IF (ALLOCATED(SrcDiscStateData%Vy_wake2)) THEN - i1_l = LBOUND(SrcDiscStateData%Vy_wake2,1) - i1_u = UBOUND(SrcDiscStateData%Vy_wake2,1) - i2_l = LBOUND(SrcDiscStateData%Vy_wake2,2) - i2_u = UBOUND(SrcDiscStateData%Vy_wake2,2) - i3_l = LBOUND(SrcDiscStateData%Vy_wake2,3) - i3_u = UBOUND(SrcDiscStateData%Vy_wake2,3) - IF (.NOT. ALLOCATED(DstDiscStateData%Vy_wake2)) THEN - ALLOCATE(DstDiscStateData%Vy_wake2(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Vy_wake2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%Vy_wake2 = SrcDiscStateData%Vy_wake2 -ENDIF -IF (ALLOCATED(SrcDiscStateData%Vz_wake2)) THEN - i1_l = LBOUND(SrcDiscStateData%Vz_wake2,1) - i1_u = UBOUND(SrcDiscStateData%Vz_wake2,1) - i2_l = LBOUND(SrcDiscStateData%Vz_wake2,2) - i2_u = UBOUND(SrcDiscStateData%Vz_wake2,2) - i3_l = LBOUND(SrcDiscStateData%Vz_wake2,3) - i3_u = UBOUND(SrcDiscStateData%Vz_wake2,3) - IF (.NOT. ALLOCATED(DstDiscStateData%Vz_wake2)) THEN - ALLOCATE(DstDiscStateData%Vz_wake2(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Vz_wake2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%Vz_wake2 = SrcDiscStateData%Vz_wake2 -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%Cq_azavg_filt)) THEN - i1_l = LBOUND(SrcDiscStateData%Cq_azavg_filt,1) - i1_u = UBOUND(SrcDiscStateData%Cq_azavg_filt,1) - IF (.NOT. ALLOCATED(DstDiscStateData%Cq_azavg_filt)) THEN - ALLOCATE(DstDiscStateData%Cq_azavg_filt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Cq_azavg_filt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%Cq_azavg_filt = SrcDiscStateData%Cq_azavg_filt -ENDIF - END SUBROUTINE WD_CopyDiscState - - SUBROUTINE WD_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(WD_DiscreteStateType), INTENT(INOUT) :: DiscStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WD_DestroyDiscState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(DiscStateData%xhat_plane)) THEN - DEALLOCATE(DiscStateData%xhat_plane) -ENDIF -IF (ALLOCATED(DiscStateData%YawErr_filt)) THEN - DEALLOCATE(DiscStateData%YawErr_filt) -ENDIF -IF (ALLOCATED(DiscStateData%V_plane_filt)) THEN - DEALLOCATE(DiscStateData%V_plane_filt) -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%Vx_wake2)) THEN - DEALLOCATE(DiscStateData%Vx_wake2) -ENDIF -IF (ALLOCATED(DiscStateData%Vy_wake2)) THEN - DEALLOCATE(DiscStateData%Vy_wake2) -ENDIF -IF (ALLOCATED(DiscStateData%Vz_wake2)) THEN - DEALLOCATE(DiscStateData%Vz_wake2) -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%Cq_azavg_filt)) THEN - DEALLOCATE(DiscStateData%Cq_azavg_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 ! 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 - Re_BufSz = Re_BufSz + 1 ! psi_skew_filt - Re_BufSz = Re_BufSz + 1 ! chi_skew_filt - 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 ! 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 ! Vx_wake2 allocated yes/no - IF ( ALLOCATED(InData%Vx_wake2) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Vx_wake2 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vx_wake2) ! Vx_wake2 - END IF - Int_BufSz = Int_BufSz + 1 ! Vy_wake2 allocated yes/no - IF ( ALLOCATED(InData%Vy_wake2) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Vy_wake2 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vy_wake2) ! Vy_wake2 - END IF - Int_BufSz = Int_BufSz + 1 ! Vz_wake2 allocated yes/no - IF ( ALLOCATED(InData%Vz_wake2) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Vz_wake2 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vz_wake2) ! Vz_wake2 - 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 ! Cq_azavg_filt allocated yes/no - IF ( ALLOCATED(InData%Cq_azavg_filt) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Cq_azavg_filt upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Cq_azavg_filt) ! Cq_azavg_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%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 - ReKiBuf(Re_Xferred) = InData%psi_skew_filt - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%chi_skew_filt - Re_Xferred = Re_Xferred + 1 - 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%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%Vx_wake2) ) THEN - 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_wake2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vx_wake2,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vx_wake2,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vx_wake2,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vx_wake2,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vx_wake2,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Vx_wake2,3), UBOUND(InData%Vx_wake2,3) - DO i2 = LBOUND(InData%Vx_wake2,2), UBOUND(InData%Vx_wake2,2) - DO i1 = LBOUND(InData%Vx_wake2,1), UBOUND(InData%Vx_wake2,1) - ReKiBuf(Re_Xferred) = InData%Vx_wake2(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Vy_wake2) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vy_wake2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vy_wake2,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vy_wake2,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vy_wake2,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vy_wake2,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vy_wake2,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Vy_wake2,3), UBOUND(InData%Vy_wake2,3) - DO i2 = LBOUND(InData%Vy_wake2,2), UBOUND(InData%Vy_wake2,2) - DO i1 = LBOUND(InData%Vy_wake2,1), UBOUND(InData%Vy_wake2,1) - ReKiBuf(Re_Xferred) = InData%Vy_wake2(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Vz_wake2) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vz_wake2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vz_wake2,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vz_wake2,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vz_wake2,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vz_wake2,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vz_wake2,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Vz_wake2,3), UBOUND(InData%Vz_wake2,3) - DO i2 = LBOUND(InData%Vz_wake2,2), UBOUND(InData%Vz_wake2,2) - DO i1 = LBOUND(InData%Vz_wake2,1), UBOUND(InData%Vz_wake2,1) - ReKiBuf(Re_Xferred) = InData%Vz_wake2(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - 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%Cq_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%Cq_azavg_filt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cq_azavg_filt,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Cq_azavg_filt,1), UBOUND(InData%Cq_azavg_filt,1) - ReKiBuf(Re_Xferred) = InData%Cq_azavg_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) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - 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 ! 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 - OutData%psi_skew_filt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%chi_skew_filt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - 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 ! 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 ! Vx_wake2 not allocated - Int_Xferred = Int_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%Vx_wake2)) DEALLOCATE(OutData%Vx_wake2) - ALLOCATE(OutData%Vx_wake2(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%Vx_wake2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Vx_wake2,3), UBOUND(OutData%Vx_wake2,3) - DO i2 = LBOUND(OutData%Vx_wake2,2), UBOUND(OutData%Vx_wake2,2) - DO i1 = LBOUND(OutData%Vx_wake2,1), UBOUND(OutData%Vx_wake2,1) - OutData%Vx_wake2(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 ! Vy_wake2 not allocated - Int_Xferred = Int_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%Vy_wake2)) DEALLOCATE(OutData%Vy_wake2) - ALLOCATE(OutData%Vy_wake2(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%Vy_wake2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Vy_wake2,3), UBOUND(OutData%Vy_wake2,3) - DO i2 = LBOUND(OutData%Vy_wake2,2), UBOUND(OutData%Vy_wake2,2) - DO i1 = LBOUND(OutData%Vy_wake2,1), UBOUND(OutData%Vy_wake2,1) - OutData%Vy_wake2(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 ! Vz_wake2 not allocated - Int_Xferred = Int_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%Vz_wake2)) DEALLOCATE(OutData%Vz_wake2) - ALLOCATE(OutData%Vz_wake2(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%Vz_wake2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Vz_wake2,3), UBOUND(OutData%Vz_wake2,3) - DO i2 = LBOUND(OutData%Vz_wake2,2), UBOUND(OutData%Vz_wake2,2) - DO i1 = LBOUND(OutData%Vz_wake2,1), UBOUND(OutData%Vz_wake2,1) - OutData%Vz_wake2(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 ! 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 ! Cq_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%Cq_azavg_filt)) DEALLOCATE(OutData%Cq_azavg_filt) - ALLOCATE(OutData%Cq_azavg_filt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cq_azavg_filt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Cq_azavg_filt,1), UBOUND(OutData%Cq_azavg_filt,1) - OutData%Cq_azavg_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' -! + ErrMsg = '' + call WD_DestroyInputFileType(InitInputData%InputFileData, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine WD_PackInitInput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(WD_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'WD_PackInitInput' + if (RF%ErrStat >= AbortErrLev) return + call WD_PackInputFileType(RF, InData%InputFileData) + call RegPack(RF, InData%TurbNum) + call RegPack(RF, InData%OutFileRoot) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine WD_UnPackInitInput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(WD_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'WD_UnPackInitInput' + if (RF%ErrStat /= ErrID_None) return + call WD_UnpackInputFileType(RF, OutData%InputFileData) ! InputFileData + call RegUnpack(RF, OutData%TurbNum); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutFileRoot); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +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 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'WD_CopyInitOutput' ErrStat = ErrID_None - ErrMsg = "" - DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState - END SUBROUTINE WD_CopyConstrState - - SUBROUTINE WD_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(WD_ConstraintStateType), INTENT(INOUT) :: ConstrStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WD_DestroyConstrState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - 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' -! + ErrMsg = '' + if (allocated(SrcInitOutputData%WriteOutputHdr)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) + if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then + allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), 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 + end if + if (allocated(SrcInitOutputData%WriteOutputUnt)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) + if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then + allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), 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 + end if + call NWTC_Library_CopyProgDesc(SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine WD_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(WD_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'WD_DestroyInitOutput' ErrStat = ErrID_None - ErrMsg = "" - DstOtherStateData%firstPass = SrcOtherStateData%firstPass - END SUBROUTINE WD_CopyOtherState - - SUBROUTINE WD_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(WD_OtherStateType), INTENT(INOUT) :: OtherStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WD_DestroyOtherState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - 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) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WD_CopyMisc' -! + ErrMsg = '' + if (allocated(InitOutputData%WriteOutputHdr)) then + deallocate(InitOutputData%WriteOutputHdr) + end if + if (allocated(InitOutputData%WriteOutputUnt)) then + deallocate(InitOutputData%WriteOutputUnt) + end if + call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine WD_PackInitOutput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(WD_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'WD_PackInitOutput' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%WriteOutputHdr) + call RegPackAlloc(RF, InData%WriteOutputUnt) + call NWTC_Library_PackProgDesc(RF, InData%Ver) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine WD_UnPackInitOutput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(WD_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'WD_UnPackInitOutput' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%WriteOutputHdr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WriteOutputUnt); if (RegCheckErr(RF, RoutineName)) return + call NWTC_Library_UnpackProgDesc(RF, OutData%Ver) ! Ver +end subroutine + +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 + character(*), parameter :: RoutineName = 'WD_CopyContState' ErrStat = ErrID_None - ErrMsg = "" -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%vt_tot2)) THEN - i1_l = LBOUND(SrcMiscData%vt_tot2,1) - i1_u = UBOUND(SrcMiscData%vt_tot2,1) - i2_l = LBOUND(SrcMiscData%vt_tot2,2) - i2_u = UBOUND(SrcMiscData%vt_tot2,2) - i3_l = LBOUND(SrcMiscData%vt_tot2,3) - i3_u = UBOUND(SrcMiscData%vt_tot2,3) - IF (.NOT. ALLOCATED(DstMiscData%vt_tot2)) THEN - ALLOCATE(DstMiscData%vt_tot2(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%vt_tot2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%vt_tot2 = SrcMiscData%vt_tot2 -ENDIF -IF (ALLOCATED(SrcMiscData%vt_amb2)) THEN - i1_l = LBOUND(SrcMiscData%vt_amb2,1) - i1_u = UBOUND(SrcMiscData%vt_amb2,1) - i2_l = LBOUND(SrcMiscData%vt_amb2,2) - i2_u = UBOUND(SrcMiscData%vt_amb2,2) - i3_l = LBOUND(SrcMiscData%vt_amb2,3) - i3_u = UBOUND(SrcMiscData%vt_amb2,3) - IF (.NOT. ALLOCATED(DstMiscData%vt_amb2)) THEN - ALLOCATE(DstMiscData%vt_amb2(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%vt_amb2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%vt_amb2 = SrcMiscData%vt_amb2 -ENDIF -IF (ALLOCATED(SrcMiscData%vt_shr2)) THEN - i1_l = LBOUND(SrcMiscData%vt_shr2,1) - i1_u = UBOUND(SrcMiscData%vt_shr2,1) - i2_l = LBOUND(SrcMiscData%vt_shr2,2) - i2_u = UBOUND(SrcMiscData%vt_shr2,2) - i3_l = LBOUND(SrcMiscData%vt_shr2,3) - i3_u = UBOUND(SrcMiscData%vt_shr2,3) - IF (.NOT. ALLOCATED(DstMiscData%vt_shr2)) THEN - ALLOCATE(DstMiscData%vt_shr2(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%vt_shr2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%vt_shr2 = SrcMiscData%vt_shr2 -ENDIF -IF (ALLOCATED(SrcMiscData%dvx_dy)) THEN - i1_l = LBOUND(SrcMiscData%dvx_dy,1) - i1_u = UBOUND(SrcMiscData%dvx_dy,1) - i2_l = LBOUND(SrcMiscData%dvx_dy,2) - i2_u = UBOUND(SrcMiscData%dvx_dy,2) - i3_l = LBOUND(SrcMiscData%dvx_dy,3) - i3_u = UBOUND(SrcMiscData%dvx_dy,3) - IF (.NOT. ALLOCATED(DstMiscData%dvx_dy)) THEN - ALLOCATE(DstMiscData%dvx_dy(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%dvx_dy.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%dvx_dy = SrcMiscData%dvx_dy -ENDIF -IF (ALLOCATED(SrcMiscData%dvx_dz)) THEN - i1_l = LBOUND(SrcMiscData%dvx_dz,1) - i1_u = UBOUND(SrcMiscData%dvx_dz,1) - i2_l = LBOUND(SrcMiscData%dvx_dz,2) - i2_u = UBOUND(SrcMiscData%dvx_dz,2) - i3_l = LBOUND(SrcMiscData%dvx_dz,3) - i3_u = UBOUND(SrcMiscData%dvx_dz,3) - IF (.NOT. ALLOCATED(DstMiscData%dvx_dz)) THEN - ALLOCATE(DstMiscData%dvx_dz(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%dvx_dz.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%dvx_dz = SrcMiscData%dvx_dz -ENDIF -IF (ALLOCATED(SrcMiscData%nu_dvx_dy)) THEN - i1_l = LBOUND(SrcMiscData%nu_dvx_dy,1) - i1_u = UBOUND(SrcMiscData%nu_dvx_dy,1) - i2_l = LBOUND(SrcMiscData%nu_dvx_dy,2) - i2_u = UBOUND(SrcMiscData%nu_dvx_dy,2) - IF (.NOT. ALLOCATED(DstMiscData%nu_dvx_dy)) THEN - ALLOCATE(DstMiscData%nu_dvx_dy(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%nu_dvx_dy.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%nu_dvx_dy = SrcMiscData%nu_dvx_dy -ENDIF -IF (ALLOCATED(SrcMiscData%nu_dvx_dz)) THEN - i1_l = LBOUND(SrcMiscData%nu_dvx_dz,1) - i1_u = UBOUND(SrcMiscData%nu_dvx_dz,1) - i2_l = LBOUND(SrcMiscData%nu_dvx_dz,2) - i2_u = UBOUND(SrcMiscData%nu_dvx_dz,2) - IF (.NOT. ALLOCATED(DstMiscData%nu_dvx_dz)) THEN - ALLOCATE(DstMiscData%nu_dvx_dz(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%nu_dvx_dz.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%nu_dvx_dz = SrcMiscData%nu_dvx_dz -ENDIF -IF (ALLOCATED(SrcMiscData%dnuvx_dy)) THEN - i1_l = LBOUND(SrcMiscData%dnuvx_dy,1) - i1_u = UBOUND(SrcMiscData%dnuvx_dy,1) - i2_l = LBOUND(SrcMiscData%dnuvx_dy,2) - i2_u = UBOUND(SrcMiscData%dnuvx_dy,2) - IF (.NOT. ALLOCATED(DstMiscData%dnuvx_dy)) THEN - ALLOCATE(DstMiscData%dnuvx_dy(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%dnuvx_dy.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%dnuvx_dy = SrcMiscData%dnuvx_dy -ENDIF -IF (ALLOCATED(SrcMiscData%dnuvx_dz)) THEN - i1_l = LBOUND(SrcMiscData%dnuvx_dz,1) - i1_u = UBOUND(SrcMiscData%dnuvx_dz,1) - i2_l = LBOUND(SrcMiscData%dnuvx_dz,2) - i2_u = UBOUND(SrcMiscData%dnuvx_dz,2) - IF (.NOT. ALLOCATED(DstMiscData%dnuvx_dz)) THEN - ALLOCATE(DstMiscData%dnuvx_dz(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%dnuvx_dz.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%dnuvx_dz = SrcMiscData%dnuvx_dz -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 -IF (ALLOCATED(SrcMiscData%Vx_polar)) THEN - i1_l = LBOUND(SrcMiscData%Vx_polar,1) - i1_u = UBOUND(SrcMiscData%Vx_polar,1) - IF (.NOT. ALLOCATED(DstMiscData%Vx_polar)) THEN - ALLOCATE(DstMiscData%Vx_polar(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Vx_polar.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%Vx_polar = SrcMiscData%Vx_polar -ENDIF -IF (ALLOCATED(SrcMiscData%Vt_wake)) THEN - i1_l = LBOUND(SrcMiscData%Vt_wake,1) - i1_u = UBOUND(SrcMiscData%Vt_wake,1) - IF (.NOT. ALLOCATED(DstMiscData%Vt_wake)) THEN - ALLOCATE(DstMiscData%Vt_wake(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Vt_wake.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%Vt_wake = SrcMiscData%Vt_wake -ENDIF - DstMiscData%GammaCurl = SrcMiscData%GammaCurl - DstMiscData%Ct_avg = SrcMiscData%Ct_avg - END SUBROUTINE WD_CopyMisc - - SUBROUTINE WD_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(WD_MiscVarType), INTENT(INOUT) :: MiscData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WD_DestroyMisc' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -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%vt_tot2)) THEN - DEALLOCATE(MiscData%vt_tot2) -ENDIF -IF (ALLOCATED(MiscData%vt_amb2)) THEN - DEALLOCATE(MiscData%vt_amb2) -ENDIF -IF (ALLOCATED(MiscData%vt_shr2)) THEN - DEALLOCATE(MiscData%vt_shr2) -ENDIF -IF (ALLOCATED(MiscData%dvx_dy)) THEN - DEALLOCATE(MiscData%dvx_dy) -ENDIF -IF (ALLOCATED(MiscData%dvx_dz)) THEN - DEALLOCATE(MiscData%dvx_dz) -ENDIF -IF (ALLOCATED(MiscData%nu_dvx_dy)) THEN - DEALLOCATE(MiscData%nu_dvx_dy) -ENDIF -IF (ALLOCATED(MiscData%nu_dvx_dz)) THEN - DEALLOCATE(MiscData%nu_dvx_dz) -ENDIF -IF (ALLOCATED(MiscData%dnuvx_dy)) THEN - DEALLOCATE(MiscData%dnuvx_dy) -ENDIF -IF (ALLOCATED(MiscData%dnuvx_dz)) THEN - DEALLOCATE(MiscData%dnuvx_dz) -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 -IF (ALLOCATED(MiscData%Vx_polar)) THEN - DEALLOCATE(MiscData%Vx_polar) -ENDIF -IF (ALLOCATED(MiscData%Vt_wake)) THEN - DEALLOCATE(MiscData%Vt_wake) -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 ! 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 ! vt_tot2 allocated yes/no - IF ( ALLOCATED(InData%vt_tot2) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! vt_tot2 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%vt_tot2) ! vt_tot2 - END IF - Int_BufSz = Int_BufSz + 1 ! vt_amb2 allocated yes/no - IF ( ALLOCATED(InData%vt_amb2) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! vt_amb2 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%vt_amb2) ! vt_amb2 - END IF - Int_BufSz = Int_BufSz + 1 ! vt_shr2 allocated yes/no - IF ( ALLOCATED(InData%vt_shr2) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! vt_shr2 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%vt_shr2) ! vt_shr2 - END IF - Int_BufSz = Int_BufSz + 1 ! dvx_dy allocated yes/no - IF ( ALLOCATED(InData%dvx_dy) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! dvx_dy upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%dvx_dy) ! dvx_dy - END IF - Int_BufSz = Int_BufSz + 1 ! dvx_dz allocated yes/no - IF ( ALLOCATED(InData%dvx_dz) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! dvx_dz upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%dvx_dz) ! dvx_dz - END IF - Int_BufSz = Int_BufSz + 1 ! nu_dvx_dy allocated yes/no - IF ( ALLOCATED(InData%nu_dvx_dy) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! nu_dvx_dy upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%nu_dvx_dy) ! nu_dvx_dy - END IF - Int_BufSz = Int_BufSz + 1 ! nu_dvx_dz allocated yes/no - IF ( ALLOCATED(InData%nu_dvx_dz) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! nu_dvx_dz upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%nu_dvx_dz) ! nu_dvx_dz - END IF - Int_BufSz = Int_BufSz + 1 ! dnuvx_dy allocated yes/no - IF ( ALLOCATED(InData%dnuvx_dy) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! dnuvx_dy upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%dnuvx_dy) ! dnuvx_dy - END IF - Int_BufSz = Int_BufSz + 1 ! dnuvx_dz allocated yes/no - IF ( ALLOCATED(InData%dnuvx_dz) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! dnuvx_dz upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%dnuvx_dz) ! dnuvx_dz - 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 - Int_BufSz = Int_BufSz + 1 ! Vx_polar allocated yes/no - IF ( ALLOCATED(InData%Vx_polar) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Vx_polar upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vx_polar) ! Vx_polar - END IF - Int_BufSz = Int_BufSz + 1 ! Vt_wake allocated yes/no - IF ( ALLOCATED(InData%Vt_wake) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Vt_wake upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vt_wake) ! Vt_wake - END IF - Re_BufSz = Re_BufSz + 1 ! GammaCurl - Re_BufSz = Re_BufSz + 1 ! Ct_avg - 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%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%vt_tot2) ) THEN - 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_tot2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%vt_tot2,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%vt_tot2,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%vt_tot2,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%vt_tot2,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%vt_tot2,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%vt_tot2,3), UBOUND(InData%vt_tot2,3) - DO i2 = LBOUND(InData%vt_tot2,2), UBOUND(InData%vt_tot2,2) - DO i1 = LBOUND(InData%vt_tot2,1), UBOUND(InData%vt_tot2,1) - ReKiBuf(Re_Xferred) = InData%vt_tot2(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%vt_amb2) ) THEN - 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_amb2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%vt_amb2,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%vt_amb2,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%vt_amb2,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%vt_amb2,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%vt_amb2,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%vt_amb2,3), UBOUND(InData%vt_amb2,3) - DO i2 = LBOUND(InData%vt_amb2,2), UBOUND(InData%vt_amb2,2) - DO i1 = LBOUND(InData%vt_amb2,1), UBOUND(InData%vt_amb2,1) - ReKiBuf(Re_Xferred) = InData%vt_amb2(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%vt_shr2) ) THEN - 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_shr2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%vt_shr2,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%vt_shr2,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%vt_shr2,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%vt_shr2,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%vt_shr2,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%vt_shr2,3), UBOUND(InData%vt_shr2,3) - DO i2 = LBOUND(InData%vt_shr2,2), UBOUND(InData%vt_shr2,2) - DO i1 = LBOUND(InData%vt_shr2,1), UBOUND(InData%vt_shr2,1) - ReKiBuf(Re_Xferred) = InData%vt_shr2(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%dvx_dy) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%dvx_dy,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dvx_dy,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%dvx_dy,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dvx_dy,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%dvx_dy,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dvx_dy,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%dvx_dy,3), UBOUND(InData%dvx_dy,3) - DO i2 = LBOUND(InData%dvx_dy,2), UBOUND(InData%dvx_dy,2) - DO i1 = LBOUND(InData%dvx_dy,1), UBOUND(InData%dvx_dy,1) - ReKiBuf(Re_Xferred) = InData%dvx_dy(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%dvx_dz) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%dvx_dz,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dvx_dz,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%dvx_dz,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dvx_dz,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%dvx_dz,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dvx_dz,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%dvx_dz,3), UBOUND(InData%dvx_dz,3) - DO i2 = LBOUND(InData%dvx_dz,2), UBOUND(InData%dvx_dz,2) - DO i1 = LBOUND(InData%dvx_dz,1), UBOUND(InData%dvx_dz,1) - ReKiBuf(Re_Xferred) = InData%dvx_dz(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%nu_dvx_dy) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%nu_dvx_dy,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%nu_dvx_dy,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%nu_dvx_dy,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%nu_dvx_dy,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%nu_dvx_dy,2), UBOUND(InData%nu_dvx_dy,2) - DO i1 = LBOUND(InData%nu_dvx_dy,1), UBOUND(InData%nu_dvx_dy,1) - ReKiBuf(Re_Xferred) = InData%nu_dvx_dy(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%nu_dvx_dz) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%nu_dvx_dz,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%nu_dvx_dz,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%nu_dvx_dz,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%nu_dvx_dz,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%nu_dvx_dz,2), UBOUND(InData%nu_dvx_dz,2) - DO i1 = LBOUND(InData%nu_dvx_dz,1), UBOUND(InData%nu_dvx_dz,1) - ReKiBuf(Re_Xferred) = InData%nu_dvx_dz(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%dnuvx_dy) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%dnuvx_dy,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dnuvx_dy,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%dnuvx_dy,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dnuvx_dy,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%dnuvx_dy,2), UBOUND(InData%dnuvx_dy,2) - DO i1 = LBOUND(InData%dnuvx_dy,1), UBOUND(InData%dnuvx_dy,1) - ReKiBuf(Re_Xferred) = InData%dnuvx_dy(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%dnuvx_dz) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%dnuvx_dz,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dnuvx_dz,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%dnuvx_dz,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dnuvx_dz,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%dnuvx_dz,2), UBOUND(InData%dnuvx_dz,2) - DO i1 = LBOUND(InData%dnuvx_dz,1), UBOUND(InData%dnuvx_dz,1) - ReKiBuf(Re_Xferred) = InData%dnuvx_dz(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 - IF ( .NOT. ALLOCATED(InData%Vx_polar) ) THEN - 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_polar,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vx_polar,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Vx_polar,1), UBOUND(InData%Vx_polar,1) - ReKiBuf(Re_Xferred) = InData%Vx_polar(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Vt_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%Vt_wake,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vt_wake,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Vt_wake,1), UBOUND(InData%Vt_wake,1) - ReKiBuf(Re_Xferred) = InData%Vt_wake(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%GammaCurl - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Ct_avg - Re_Xferred = Re_Xferred + 1 - 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) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - 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 ! 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 ! vt_tot2 not allocated - Int_Xferred = Int_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%vt_tot2)) DEALLOCATE(OutData%vt_tot2) - ALLOCATE(OutData%vt_tot2(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%vt_tot2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%vt_tot2,3), UBOUND(OutData%vt_tot2,3) - DO i2 = LBOUND(OutData%vt_tot2,2), UBOUND(OutData%vt_tot2,2) - DO i1 = LBOUND(OutData%vt_tot2,1), UBOUND(OutData%vt_tot2,1) - OutData%vt_tot2(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 ! vt_amb2 not allocated - Int_Xferred = Int_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%vt_amb2)) DEALLOCATE(OutData%vt_amb2) - ALLOCATE(OutData%vt_amb2(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%vt_amb2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%vt_amb2,3), UBOUND(OutData%vt_amb2,3) - DO i2 = LBOUND(OutData%vt_amb2,2), UBOUND(OutData%vt_amb2,2) - DO i1 = LBOUND(OutData%vt_amb2,1), UBOUND(OutData%vt_amb2,1) - OutData%vt_amb2(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 ! vt_shr2 not allocated - Int_Xferred = Int_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%vt_shr2)) DEALLOCATE(OutData%vt_shr2) - ALLOCATE(OutData%vt_shr2(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%vt_shr2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%vt_shr2,3), UBOUND(OutData%vt_shr2,3) - DO i2 = LBOUND(OutData%vt_shr2,2), UBOUND(OutData%vt_shr2,2) - DO i1 = LBOUND(OutData%vt_shr2,1), UBOUND(OutData%vt_shr2,1) - OutData%vt_shr2(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 ! dvx_dy not allocated - Int_Xferred = Int_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%dvx_dy)) DEALLOCATE(OutData%dvx_dy) - ALLOCATE(OutData%dvx_dy(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%dvx_dy.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%dvx_dy,3), UBOUND(OutData%dvx_dy,3) - DO i2 = LBOUND(OutData%dvx_dy,2), UBOUND(OutData%dvx_dy,2) - DO i1 = LBOUND(OutData%dvx_dy,1), UBOUND(OutData%dvx_dy,1) - OutData%dvx_dy(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 ! dvx_dz not allocated - Int_Xferred = Int_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%dvx_dz)) DEALLOCATE(OutData%dvx_dz) - ALLOCATE(OutData%dvx_dz(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%dvx_dz.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%dvx_dz,3), UBOUND(OutData%dvx_dz,3) - DO i2 = LBOUND(OutData%dvx_dz,2), UBOUND(OutData%dvx_dz,2) - DO i1 = LBOUND(OutData%dvx_dz,1), UBOUND(OutData%dvx_dz,1) - OutData%dvx_dz(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 ! nu_dvx_dy not allocated - Int_Xferred = Int_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%nu_dvx_dy)) DEALLOCATE(OutData%nu_dvx_dy) - ALLOCATE(OutData%nu_dvx_dy(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%nu_dvx_dy.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%nu_dvx_dy,2), UBOUND(OutData%nu_dvx_dy,2) - DO i1 = LBOUND(OutData%nu_dvx_dy,1), UBOUND(OutData%nu_dvx_dy,1) - OutData%nu_dvx_dy(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! nu_dvx_dz not allocated - Int_Xferred = Int_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%nu_dvx_dz)) DEALLOCATE(OutData%nu_dvx_dz) - ALLOCATE(OutData%nu_dvx_dz(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%nu_dvx_dz.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%nu_dvx_dz,2), UBOUND(OutData%nu_dvx_dz,2) - DO i1 = LBOUND(OutData%nu_dvx_dz,1), UBOUND(OutData%nu_dvx_dz,1) - OutData%nu_dvx_dz(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! dnuvx_dy not allocated - Int_Xferred = Int_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%dnuvx_dy)) DEALLOCATE(OutData%dnuvx_dy) - ALLOCATE(OutData%dnuvx_dy(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%dnuvx_dy.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%dnuvx_dy,2), UBOUND(OutData%dnuvx_dy,2) - DO i1 = LBOUND(OutData%dnuvx_dy,1), UBOUND(OutData%dnuvx_dy,1) - OutData%dnuvx_dy(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! dnuvx_dz not allocated - Int_Xferred = Int_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%dnuvx_dz)) DEALLOCATE(OutData%dnuvx_dz) - ALLOCATE(OutData%dnuvx_dz(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%dnuvx_dz.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%dnuvx_dz,2), UBOUND(OutData%dnuvx_dz,2) - DO i1 = LBOUND(OutData%dnuvx_dz,1), UBOUND(OutData%dnuvx_dz,1) - OutData%dnuvx_dz(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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vx_polar not allocated - Int_Xferred = Int_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_polar)) DEALLOCATE(OutData%Vx_polar) - ALLOCATE(OutData%Vx_polar(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vx_polar.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Vx_polar,1), UBOUND(OutData%Vx_polar,1) - OutData%Vx_polar(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vt_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%Vt_wake)) DEALLOCATE(OutData%Vt_wake) - ALLOCATE(OutData%Vt_wake(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vt_wake.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Vt_wake,1), UBOUND(OutData%Vt_wake,1) - OutData%Vt_wake(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%GammaCurl = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Ct_avg = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - 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' -! + ErrMsg = '' + DstContStateData%DummyContState = SrcContStateData%DummyContState +end subroutine + +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' 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 -IF (ALLOCATED(SrcParamData%y)) THEN - i1_l = LBOUND(SrcParamData%y,1) - i1_u = UBOUND(SrcParamData%y,1) - IF (.NOT. ALLOCATED(DstParamData%y)) THEN - ALLOCATE(DstParamData%y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%y = SrcParamData%y -ENDIF -IF (ALLOCATED(SrcParamData%z)) THEN - i1_l = LBOUND(SrcParamData%z,1) - i1_u = UBOUND(SrcParamData%z,1) - IF (.NOT. ALLOCATED(DstParamData%z)) THEN - ALLOCATE(DstParamData%z(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%z.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%z = SrcParamData%z -ENDIF - DstParamData%Mod_Wake = SrcParamData%Mod_Wake - DstParamData%Swirl = SrcParamData%Swirl - DstParamData%k_VortexDecay = SrcParamData%k_VortexDecay - DstParamData%sigma_D = SrcParamData%sigma_D - DstParamData%NumVortices = SrcParamData%NumVortices - 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 - DstParamData%FilterInit = SrcParamData%FilterInit - DstParamData%k_vCurl = SrcParamData%k_vCurl - DstParamData%OutAllPlanes = SrcParamData%OutAllPlanes - DstParamData%OutFileRoot = SrcParamData%OutFileRoot - DstParamData%OutFileVTKDir = SrcParamData%OutFileVTKDir - DstParamData%TurbNum = SrcParamData%TurbNum - DstParamData%WAT = SrcParamData%WAT - DstParamData%WAT_k_Def = SrcParamData%WAT_k_Def - DstParamData%WAT_k_Grad = SrcParamData%WAT_k_Grad - END SUBROUTINE WD_CopyParam - - SUBROUTINE WD_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(WD_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WD_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(ParamData%r)) THEN - DEALLOCATE(ParamData%r) -ENDIF -IF (ALLOCATED(ParamData%y)) THEN - DEALLOCATE(ParamData%y) -ENDIF -IF (ALLOCATED(ParamData%z)) THEN - DEALLOCATE(ParamData%z) -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 - Int_BufSz = Int_BufSz + 1 ! y allocated yes/no - IF ( ALLOCATED(InData%y) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! y upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%y) ! y - END IF - Int_BufSz = Int_BufSz + 1 ! z allocated yes/no - IF ( ALLOCATED(InData%z) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! z upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%z) ! z - END IF - Int_BufSz = Int_BufSz + 1 ! Mod_Wake - Int_BufSz = Int_BufSz + 1 ! Swirl - Re_BufSz = Re_BufSz + 1 ! k_VortexDecay - Re_BufSz = Re_BufSz + 1 ! sigma_D - Int_BufSz = Int_BufSz + 1 ! NumVortices - 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 - Int_BufSz = Int_BufSz + 1 ! FilterInit - Re_BufSz = Re_BufSz + 1 ! k_vCurl - Int_BufSz = Int_BufSz + 1 ! OutAllPlanes - Int_BufSz = Int_BufSz + 1*LEN(InData%OutFileRoot) ! OutFileRoot - Int_BufSz = Int_BufSz + 1*LEN(InData%OutFileVTKDir) ! OutFileVTKDir - Int_BufSz = Int_BufSz + 1 ! TurbNum - Int_BufSz = Int_BufSz + 1 ! WAT - Re_BufSz = Re_BufSz + 1 ! WAT_k_Def - Re_BufSz = Re_BufSz + 1 ! WAT_k_Grad - 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 - IF ( .NOT. ALLOCATED(InData%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%y,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%y,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%y,1), UBOUND(InData%y,1) - ReKiBuf(Re_Xferred) = InData%y(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%z) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%z,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - ReKiBuf(Re_Xferred) = InData%z(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%Mod_Wake - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%Swirl, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%k_VortexDecay - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%sigma_D - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumVortices - Int_Xferred = Int_Xferred + 1 - 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 - IntKiBuf(Int_Xferred) = InData%FilterInit - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%k_vCurl - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%OutAllPlanes, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%OutFileRoot) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutFileRoot(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%OutFileVTKDir) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutFileVTKDir(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = InData%TurbNum - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%WAT, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WAT_k_Def - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WAT_k_Grad - 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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! 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%y)) DEALLOCATE(OutData%y) - ALLOCATE(OutData%y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%y,1), UBOUND(OutData%y,1) - OutData%y(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! z not allocated - Int_Xferred = Int_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%z)) DEALLOCATE(OutData%z) - ALLOCATE(OutData%z(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%z.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,1) - OutData%z(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%Mod_Wake = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%Swirl = TRANSFER(IntKiBuf(Int_Xferred), OutData%Swirl) - Int_Xferred = Int_Xferred + 1 - OutData%k_VortexDecay = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%sigma_D = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NumVortices = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - 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 - OutData%FilterInit = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%k_vCurl = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%OutAllPlanes = TRANSFER(IntKiBuf(Int_Xferred), OutData%OutAllPlanes) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%OutFileRoot) - OutData%OutFileRoot(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%OutFileVTKDir) - OutData%OutFileVTKDir(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%TurbNum = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WAT = TRANSFER(IntKiBuf(Int_Xferred), OutData%WAT) - Int_Xferred = Int_Xferred + 1 - OutData%WAT_k_Def = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%WAT_k_Grad = 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' -! + ErrMsg = '' +end subroutine + +subroutine WD_PackContState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(WD_ContinuousStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'WD_PackContState' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyContState) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine WD_UnPackContState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(WD_ContinuousStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'WD_UnPackContState' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyContState); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +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 + integer(B4Ki) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'WD_CopyDiscState' ErrStat = ErrID_None - ErrMsg = "" - DstInputData%xhat_disk = SrcInputData%xhat_disk - DstInputData%YawErr = SrcInputData%YawErr - DstInputData%psi_skew = SrcInputData%psi_skew - DstInputData%chi_skew = SrcInputData%chi_skew - 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 -IF (ALLOCATED(SrcInputData%Cq_azavg)) THEN - i1_l = LBOUND(SrcInputData%Cq_azavg,1) - i1_u = UBOUND(SrcInputData%Cq_azavg,1) - IF (.NOT. ALLOCATED(DstInputData%Cq_azavg)) THEN - ALLOCATE(DstInputData%Cq_azavg(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%Cq_azavg.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%Cq_azavg = SrcInputData%Cq_azavg -ENDIF - END SUBROUTINE WD_CopyInput - - SUBROUTINE WD_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(WD_InputType), INTENT(INOUT) :: InputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WD_DestroyInput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(InputData%V_plane)) THEN - DEALLOCATE(InputData%V_plane) -ENDIF -IF (ALLOCATED(InputData%Ct_azavg)) THEN - DEALLOCATE(InputData%Ct_azavg) -ENDIF -IF (ALLOCATED(InputData%Cq_azavg)) THEN - DEALLOCATE(InputData%Cq_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 + 1 ! YawErr - Re_BufSz = Re_BufSz + 1 ! psi_skew - Re_BufSz = Re_BufSz + 1 ! chi_skew - 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 - Int_BufSz = Int_BufSz + 1 ! Cq_azavg allocated yes/no - IF ( ALLOCATED(InData%Cq_azavg) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Cq_azavg upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Cq_azavg) ! Cq_azavg - 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 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 - ReKiBuf(Re_Xferred) = InData%YawErr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%psi_skew - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%chi_skew - Re_Xferred = Re_Xferred + 1 - 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 - IF ( .NOT. ALLOCATED(InData%Cq_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%Cq_azavg,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cq_azavg,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Cq_azavg,1), UBOUND(InData%Cq_azavg,1) - ReKiBuf(Re_Xferred) = InData%Cq_azavg(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - 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 - OutData%YawErr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%psi_skew = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%chi_skew = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - 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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Cq_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%Cq_azavg)) DEALLOCATE(OutData%Cq_azavg) - ALLOCATE(OutData%Cq_azavg(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cq_azavg.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Cq_azavg,1), UBOUND(OutData%Cq_azavg,1) - OutData%Cq_azavg(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - 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) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WD_CopyOutput' -! + ErrMsg = '' + if (allocated(SrcDiscStateData%xhat_plane)) then + LB(1:2) = lbound(SrcDiscStateData%xhat_plane) + UB(1:2) = ubound(SrcDiscStateData%xhat_plane) + if (.not. allocated(DstDiscStateData%xhat_plane)) then + allocate(DstDiscStateData%xhat_plane(LB(1):UB(1),LB(2):UB(2)), 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 + end if + if (allocated(SrcDiscStateData%YawErr_filt)) then + LB(1:1) = lbound(SrcDiscStateData%YawErr_filt) + UB(1:1) = ubound(SrcDiscStateData%YawErr_filt) + if (.not. allocated(DstDiscStateData%YawErr_filt)) then + allocate(DstDiscStateData%YawErr_filt(LB(1):UB(1)), 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 + end if + DstDiscStateData%psi_skew_filt = SrcDiscStateData%psi_skew_filt + DstDiscStateData%chi_skew_filt = SrcDiscStateData%chi_skew_filt + if (allocated(SrcDiscStateData%V_plane_filt)) then + LB(1:2) = lbound(SrcDiscStateData%V_plane_filt) + UB(1:2) = ubound(SrcDiscStateData%V_plane_filt) + if (.not. allocated(DstDiscStateData%V_plane_filt)) then + allocate(DstDiscStateData%V_plane_filt(LB(1):UB(1),LB(2):UB(2)), 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 + end if + if (allocated(SrcDiscStateData%p_plane)) then + LB(1:2) = lbound(SrcDiscStateData%p_plane) + UB(1:2) = ubound(SrcDiscStateData%p_plane) + if (.not. allocated(DstDiscStateData%p_plane)) then + allocate(DstDiscStateData%p_plane(LB(1):UB(1),LB(2):UB(2)), 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 + end if + if (allocated(SrcDiscStateData%x_plane)) then + LB(1:1) = lbound(SrcDiscStateData%x_plane) + UB(1:1) = ubound(SrcDiscStateData%x_plane) + if (.not. allocated(DstDiscStateData%x_plane)) then + allocate(DstDiscStateData%x_plane(LB(1):UB(1)), 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 + end if + if (allocated(SrcDiscStateData%Vx_wake)) then + LB(1:2) = lbound(SrcDiscStateData%Vx_wake) + UB(1:2) = ubound(SrcDiscStateData%Vx_wake) + if (.not. allocated(DstDiscStateData%Vx_wake)) then + allocate(DstDiscStateData%Vx_wake(LB(1):UB(1),LB(2):UB(2)), 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 + end if + if (allocated(SrcDiscStateData%Vr_wake)) then + LB(1:2) = lbound(SrcDiscStateData%Vr_wake) + UB(1:2) = ubound(SrcDiscStateData%Vr_wake) + if (.not. allocated(DstDiscStateData%Vr_wake)) then + allocate(DstDiscStateData%Vr_wake(LB(1):UB(1),LB(2):UB(2)), 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 + end if + if (allocated(SrcDiscStateData%Vx_wake2)) then + LB(1:3) = lbound(SrcDiscStateData%Vx_wake2) + UB(1:3) = ubound(SrcDiscStateData%Vx_wake2) + if (.not. allocated(DstDiscStateData%Vx_wake2)) then + allocate(DstDiscStateData%Vx_wake2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Vx_wake2.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%Vx_wake2 = SrcDiscStateData%Vx_wake2 + end if + if (allocated(SrcDiscStateData%Vy_wake2)) then + LB(1:3) = lbound(SrcDiscStateData%Vy_wake2) + UB(1:3) = ubound(SrcDiscStateData%Vy_wake2) + if (.not. allocated(DstDiscStateData%Vy_wake2)) then + allocate(DstDiscStateData%Vy_wake2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Vy_wake2.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%Vy_wake2 = SrcDiscStateData%Vy_wake2 + end if + if (allocated(SrcDiscStateData%Vz_wake2)) then + LB(1:3) = lbound(SrcDiscStateData%Vz_wake2) + UB(1:3) = ubound(SrcDiscStateData%Vz_wake2) + if (.not. allocated(DstDiscStateData%Vz_wake2)) then + allocate(DstDiscStateData%Vz_wake2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Vz_wake2.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%Vz_wake2 = SrcDiscStateData%Vz_wake2 + end if + if (allocated(SrcDiscStateData%Vx_wind_disk_filt)) then + LB(1:1) = lbound(SrcDiscStateData%Vx_wind_disk_filt) + UB(1:1) = ubound(SrcDiscStateData%Vx_wind_disk_filt) + if (.not. allocated(DstDiscStateData%Vx_wind_disk_filt)) then + allocate(DstDiscStateData%Vx_wind_disk_filt(LB(1):UB(1)), 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 + end if + if (allocated(SrcDiscStateData%TI_amb_filt)) then + LB(1:1) = lbound(SrcDiscStateData%TI_amb_filt) + UB(1:1) = ubound(SrcDiscStateData%TI_amb_filt) + if (.not. allocated(DstDiscStateData%TI_amb_filt)) then + allocate(DstDiscStateData%TI_amb_filt(LB(1):UB(1)), 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 + end if + if (allocated(SrcDiscStateData%D_rotor_filt)) then + LB(1:1) = lbound(SrcDiscStateData%D_rotor_filt) + UB(1:1) = ubound(SrcDiscStateData%D_rotor_filt) + if (.not. allocated(DstDiscStateData%D_rotor_filt)) then + allocate(DstDiscStateData%D_rotor_filt(LB(1):UB(1)), 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 + end if + DstDiscStateData%Vx_rel_disk_filt = SrcDiscStateData%Vx_rel_disk_filt + if (allocated(SrcDiscStateData%Ct_azavg_filt)) then + LB(1:1) = lbound(SrcDiscStateData%Ct_azavg_filt) + UB(1:1) = ubound(SrcDiscStateData%Ct_azavg_filt) + if (.not. allocated(DstDiscStateData%Ct_azavg_filt)) then + allocate(DstDiscStateData%Ct_azavg_filt(LB(1):UB(1)), 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 + end if + if (allocated(SrcDiscStateData%Cq_azavg_filt)) then + LB(1:1) = lbound(SrcDiscStateData%Cq_azavg_filt) + UB(1:1) = ubound(SrcDiscStateData%Cq_azavg_filt) + if (.not. allocated(DstDiscStateData%Cq_azavg_filt)) then + allocate(DstDiscStateData%Cq_azavg_filt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Cq_azavg_filt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%Cq_azavg_filt = SrcDiscStateData%Cq_azavg_filt + end if +end subroutine + +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' 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%Vx_wake2)) THEN - i1_l = LBOUND(SrcOutputData%Vx_wake2,1) - i1_u = UBOUND(SrcOutputData%Vx_wake2,1) - i2_l = LBOUND(SrcOutputData%Vx_wake2,2) - i2_u = UBOUND(SrcOutputData%Vx_wake2,2) - i3_l = LBOUND(SrcOutputData%Vx_wake2,3) - i3_u = UBOUND(SrcOutputData%Vx_wake2,3) - IF (.NOT. ALLOCATED(DstOutputData%Vx_wake2)) THEN - ALLOCATE(DstOutputData%Vx_wake2(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Vx_wake2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%Vx_wake2 = SrcOutputData%Vx_wake2 -ENDIF -IF (ALLOCATED(SrcOutputData%Vy_wake2)) THEN - i1_l = LBOUND(SrcOutputData%Vy_wake2,1) - i1_u = UBOUND(SrcOutputData%Vy_wake2,1) - i2_l = LBOUND(SrcOutputData%Vy_wake2,2) - i2_u = UBOUND(SrcOutputData%Vy_wake2,2) - i3_l = LBOUND(SrcOutputData%Vy_wake2,3) - i3_u = UBOUND(SrcOutputData%Vy_wake2,3) - IF (.NOT. ALLOCATED(DstOutputData%Vy_wake2)) THEN - ALLOCATE(DstOutputData%Vy_wake2(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Vy_wake2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%Vy_wake2 = SrcOutputData%Vy_wake2 -ENDIF -IF (ALLOCATED(SrcOutputData%Vz_wake2)) THEN - i1_l = LBOUND(SrcOutputData%Vz_wake2,1) - i1_u = UBOUND(SrcOutputData%Vz_wake2,1) - i2_l = LBOUND(SrcOutputData%Vz_wake2,2) - i2_u = UBOUND(SrcOutputData%Vz_wake2,2) - i3_l = LBOUND(SrcOutputData%Vz_wake2,3) - i3_u = UBOUND(SrcOutputData%Vz_wake2,3) - IF (.NOT. ALLOCATED(DstOutputData%Vz_wake2)) THEN - ALLOCATE(DstOutputData%Vz_wake2(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Vz_wake2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%Vz_wake2 = SrcOutputData%Vz_wake2 -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 -IF (ALLOCATED(SrcOutputData%WAT_k_mt)) THEN - i1_l = LBOUND(SrcOutputData%WAT_k_mt,1) - i1_u = UBOUND(SrcOutputData%WAT_k_mt,1) - i2_l = LBOUND(SrcOutputData%WAT_k_mt,2) - i2_u = UBOUND(SrcOutputData%WAT_k_mt,2) - i3_l = LBOUND(SrcOutputData%WAT_k_mt,3) - i3_u = UBOUND(SrcOutputData%WAT_k_mt,3) - IF (.NOT. ALLOCATED(DstOutputData%WAT_k_mt)) THEN - ALLOCATE(DstOutputData%WAT_k_mt(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WAT_k_mt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%WAT_k_mt = SrcOutputData%WAT_k_mt -ENDIF - END SUBROUTINE WD_CopyOutput - - SUBROUTINE WD_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(WD_OutputType), INTENT(INOUT) :: OutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WD_DestroyOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -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%Vx_wake2)) THEN - DEALLOCATE(OutputData%Vx_wake2) -ENDIF -IF (ALLOCATED(OutputData%Vy_wake2)) THEN - DEALLOCATE(OutputData%Vy_wake2) -ENDIF -IF (ALLOCATED(OutputData%Vz_wake2)) THEN - DEALLOCATE(OutputData%Vz_wake2) -ENDIF -IF (ALLOCATED(OutputData%D_wake)) THEN - DEALLOCATE(OutputData%D_wake) -ENDIF -IF (ALLOCATED(OutputData%x_plane)) THEN - DEALLOCATE(OutputData%x_plane) -ENDIF -IF (ALLOCATED(OutputData%WAT_k_mt)) THEN - DEALLOCATE(OutputData%WAT_k_mt) -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 ! Vx_wake2 allocated yes/no - IF ( ALLOCATED(InData%Vx_wake2) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Vx_wake2 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vx_wake2) ! Vx_wake2 - END IF - Int_BufSz = Int_BufSz + 1 ! Vy_wake2 allocated yes/no - IF ( ALLOCATED(InData%Vy_wake2) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Vy_wake2 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vy_wake2) ! Vy_wake2 - END IF - Int_BufSz = Int_BufSz + 1 ! Vz_wake2 allocated yes/no - IF ( ALLOCATED(InData%Vz_wake2) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Vz_wake2 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vz_wake2) ! Vz_wake2 - 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 - Int_BufSz = Int_BufSz + 1 ! WAT_k_mt allocated yes/no - IF ( ALLOCATED(InData%WAT_k_mt) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! WAT_k_mt upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WAT_k_mt) ! WAT_k_mt - 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%Vx_wake2) ) THEN - 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_wake2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vx_wake2,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vx_wake2,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vx_wake2,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vx_wake2,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vx_wake2,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Vx_wake2,3), UBOUND(InData%Vx_wake2,3) - DO i2 = LBOUND(InData%Vx_wake2,2), UBOUND(InData%Vx_wake2,2) - DO i1 = LBOUND(InData%Vx_wake2,1), UBOUND(InData%Vx_wake2,1) - ReKiBuf(Re_Xferred) = InData%Vx_wake2(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Vy_wake2) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vy_wake2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vy_wake2,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vy_wake2,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vy_wake2,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vy_wake2,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vy_wake2,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Vy_wake2,3), UBOUND(InData%Vy_wake2,3) - DO i2 = LBOUND(InData%Vy_wake2,2), UBOUND(InData%Vy_wake2,2) - DO i1 = LBOUND(InData%Vy_wake2,1), UBOUND(InData%Vy_wake2,1) - ReKiBuf(Re_Xferred) = InData%Vy_wake2(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Vz_wake2) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vz_wake2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vz_wake2,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vz_wake2,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vz_wake2,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vz_wake2,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vz_wake2,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Vz_wake2,3), UBOUND(InData%Vz_wake2,3) - DO i2 = LBOUND(InData%Vz_wake2,2), UBOUND(InData%Vz_wake2,2) - DO i1 = LBOUND(InData%Vz_wake2,1), UBOUND(InData%Vz_wake2,1) - ReKiBuf(Re_Xferred) = InData%Vz_wake2(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - 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 - IF ( .NOT. ALLOCATED(InData%WAT_k_mt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WAT_k_mt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WAT_k_mt,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WAT_k_mt,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WAT_k_mt,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WAT_k_mt,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WAT_k_mt,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%WAT_k_mt,3), UBOUND(InData%WAT_k_mt,3) - DO i2 = LBOUND(InData%WAT_k_mt,2), UBOUND(InData%WAT_k_mt,2) - DO i1 = LBOUND(InData%WAT_k_mt,1), UBOUND(InData%WAT_k_mt,1) - ReKiBuf(Re_Xferred) = InData%WAT_k_mt(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - 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) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - 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 ! Vx_wake2 not allocated - Int_Xferred = Int_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%Vx_wake2)) DEALLOCATE(OutData%Vx_wake2) - ALLOCATE(OutData%Vx_wake2(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%Vx_wake2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Vx_wake2,3), UBOUND(OutData%Vx_wake2,3) - DO i2 = LBOUND(OutData%Vx_wake2,2), UBOUND(OutData%Vx_wake2,2) - DO i1 = LBOUND(OutData%Vx_wake2,1), UBOUND(OutData%Vx_wake2,1) - OutData%Vx_wake2(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 ! Vy_wake2 not allocated - Int_Xferred = Int_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%Vy_wake2)) DEALLOCATE(OutData%Vy_wake2) - ALLOCATE(OutData%Vy_wake2(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%Vy_wake2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Vy_wake2,3), UBOUND(OutData%Vy_wake2,3) - DO i2 = LBOUND(OutData%Vy_wake2,2), UBOUND(OutData%Vy_wake2,2) - DO i1 = LBOUND(OutData%Vy_wake2,1), UBOUND(OutData%Vy_wake2,1) - OutData%Vy_wake2(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 ! Vz_wake2 not allocated - Int_Xferred = Int_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%Vz_wake2)) DEALLOCATE(OutData%Vz_wake2) - ALLOCATE(OutData%Vz_wake2(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%Vz_wake2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Vz_wake2,3), UBOUND(OutData%Vz_wake2,3) - DO i2 = LBOUND(OutData%Vz_wake2,2), UBOUND(OutData%Vz_wake2,2) - DO i1 = LBOUND(OutData%Vz_wake2,1), UBOUND(OutData%Vz_wake2,1) - OutData%Vz_wake2(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 ! 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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WAT_k_mt not allocated - Int_Xferred = Int_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%WAT_k_mt)) DEALLOCATE(OutData%WAT_k_mt) - ALLOCATE(OutData%WAT_k_mt(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%WAT_k_mt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%WAT_k_mt,3), UBOUND(OutData%WAT_k_mt,3) - DO i2 = LBOUND(OutData%WAT_k_mt,2), UBOUND(OutData%WAT_k_mt,2) - DO i1 = LBOUND(OutData%WAT_k_mt,1), UBOUND(OutData%WAT_k_mt,1) - OutData%WAT_k_mt(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - END SUBROUTINE WD_UnPackOutput - + ErrMsg = '' + if (allocated(DiscStateData%xhat_plane)) then + deallocate(DiscStateData%xhat_plane) + end if + if (allocated(DiscStateData%YawErr_filt)) then + deallocate(DiscStateData%YawErr_filt) + end if + if (allocated(DiscStateData%V_plane_filt)) then + deallocate(DiscStateData%V_plane_filt) + end if + if (allocated(DiscStateData%p_plane)) then + deallocate(DiscStateData%p_plane) + end if + if (allocated(DiscStateData%x_plane)) then + deallocate(DiscStateData%x_plane) + end if + if (allocated(DiscStateData%Vx_wake)) then + deallocate(DiscStateData%Vx_wake) + end if + if (allocated(DiscStateData%Vr_wake)) then + deallocate(DiscStateData%Vr_wake) + end if + if (allocated(DiscStateData%Vx_wake2)) then + deallocate(DiscStateData%Vx_wake2) + end if + if (allocated(DiscStateData%Vy_wake2)) then + deallocate(DiscStateData%Vy_wake2) + end if + if (allocated(DiscStateData%Vz_wake2)) then + deallocate(DiscStateData%Vz_wake2) + end if + if (allocated(DiscStateData%Vx_wind_disk_filt)) then + deallocate(DiscStateData%Vx_wind_disk_filt) + end if + if (allocated(DiscStateData%TI_amb_filt)) then + deallocate(DiscStateData%TI_amb_filt) + end if + if (allocated(DiscStateData%D_rotor_filt)) then + deallocate(DiscStateData%D_rotor_filt) + end if + if (allocated(DiscStateData%Ct_azavg_filt)) then + deallocate(DiscStateData%Ct_azavg_filt) + end if + if (allocated(DiscStateData%Cq_azavg_filt)) then + deallocate(DiscStateData%Cq_azavg_filt) + end if +end subroutine + +subroutine WD_PackDiscState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(WD_DiscreteStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'WD_PackDiscState' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%xhat_plane) + call RegPackAlloc(RF, InData%YawErr_filt) + call RegPack(RF, InData%psi_skew_filt) + call RegPack(RF, InData%chi_skew_filt) + call RegPackAlloc(RF, InData%V_plane_filt) + call RegPackAlloc(RF, InData%p_plane) + call RegPackAlloc(RF, InData%x_plane) + call RegPackAlloc(RF, InData%Vx_wake) + call RegPackAlloc(RF, InData%Vr_wake) + call RegPackAlloc(RF, InData%Vx_wake2) + call RegPackAlloc(RF, InData%Vy_wake2) + call RegPackAlloc(RF, InData%Vz_wake2) + call RegPackAlloc(RF, InData%Vx_wind_disk_filt) + call RegPackAlloc(RF, InData%TI_amb_filt) + call RegPackAlloc(RF, InData%D_rotor_filt) + call RegPack(RF, InData%Vx_rel_disk_filt) + call RegPackAlloc(RF, InData%Ct_azavg_filt) + call RegPackAlloc(RF, InData%Cq_azavg_filt) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine WD_UnPackDiscState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(WD_DiscreteStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'WD_UnPackDiscState' + integer(B4Ki) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%xhat_plane); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%YawErr_filt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%psi_skew_filt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%chi_skew_filt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%V_plane_filt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%p_plane); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%x_plane); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Vx_wake); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Vr_wake); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Vx_wake2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Vy_wake2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Vz_wake2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Vx_wind_disk_filt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TI_amb_filt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%D_rotor_filt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Vx_rel_disk_filt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Ct_azavg_filt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Cq_azavg_filt); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +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 + character(*), parameter :: RoutineName = 'WD_CopyConstrState' + ErrStat = ErrID_None + ErrMsg = '' + DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState +end subroutine + +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' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine WD_PackConstrState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(WD_ConstraintStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'WD_PackConstrState' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyConstrState) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine WD_UnPackConstrState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(WD_ConstraintStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'WD_UnPackConstrState' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyConstrState); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +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 + character(*), parameter :: RoutineName = 'WD_CopyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + DstOtherStateData%firstPass = SrcOtherStateData%firstPass +end subroutine + +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' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine WD_PackOtherState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(WD_OtherStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'WD_PackOtherState' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%firstPass) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine WD_UnPackOtherState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(WD_OtherStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'WD_UnPackOtherState' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%firstPass); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +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 + integer(B4Ki) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'WD_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcMiscData%dvtdr)) then + LB(1:1) = lbound(SrcMiscData%dvtdr) + UB(1:1) = ubound(SrcMiscData%dvtdr) + if (.not. allocated(DstMiscData%dvtdr)) then + allocate(DstMiscData%dvtdr(LB(1):UB(1)), 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 + end if + if (allocated(SrcMiscData%vt_tot)) then + LB(1:2) = lbound(SrcMiscData%vt_tot) + UB(1:2) = ubound(SrcMiscData%vt_tot) + if (.not. allocated(DstMiscData%vt_tot)) then + allocate(DstMiscData%vt_tot(LB(1):UB(1),LB(2):UB(2)), 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 + end if + if (allocated(SrcMiscData%vt_amb)) then + LB(1:2) = lbound(SrcMiscData%vt_amb) + UB(1:2) = ubound(SrcMiscData%vt_amb) + if (.not. allocated(DstMiscData%vt_amb)) then + allocate(DstMiscData%vt_amb(LB(1):UB(1),LB(2):UB(2)), 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 + end if + if (allocated(SrcMiscData%vt_shr)) then + LB(1:2) = lbound(SrcMiscData%vt_shr) + UB(1:2) = ubound(SrcMiscData%vt_shr) + if (.not. allocated(DstMiscData%vt_shr)) then + allocate(DstMiscData%vt_shr(LB(1):UB(1),LB(2):UB(2)), 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 + end if + if (allocated(SrcMiscData%vt_tot2)) then + LB(1:3) = lbound(SrcMiscData%vt_tot2) + UB(1:3) = ubound(SrcMiscData%vt_tot2) + if (.not. allocated(DstMiscData%vt_tot2)) then + allocate(DstMiscData%vt_tot2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%vt_tot2.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%vt_tot2 = SrcMiscData%vt_tot2 + end if + if (allocated(SrcMiscData%vt_amb2)) then + LB(1:3) = lbound(SrcMiscData%vt_amb2) + UB(1:3) = ubound(SrcMiscData%vt_amb2) + if (.not. allocated(DstMiscData%vt_amb2)) then + allocate(DstMiscData%vt_amb2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%vt_amb2.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%vt_amb2 = SrcMiscData%vt_amb2 + end if + if (allocated(SrcMiscData%vt_shr2)) then + LB(1:3) = lbound(SrcMiscData%vt_shr2) + UB(1:3) = ubound(SrcMiscData%vt_shr2) + if (.not. allocated(DstMiscData%vt_shr2)) then + allocate(DstMiscData%vt_shr2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%vt_shr2.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%vt_shr2 = SrcMiscData%vt_shr2 + end if + if (allocated(SrcMiscData%dvx_dy)) then + LB(1:3) = lbound(SrcMiscData%dvx_dy) + UB(1:3) = ubound(SrcMiscData%dvx_dy) + if (.not. allocated(DstMiscData%dvx_dy)) then + allocate(DstMiscData%dvx_dy(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%dvx_dy.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%dvx_dy = SrcMiscData%dvx_dy + end if + if (allocated(SrcMiscData%dvx_dz)) then + LB(1:3) = lbound(SrcMiscData%dvx_dz) + UB(1:3) = ubound(SrcMiscData%dvx_dz) + if (.not. allocated(DstMiscData%dvx_dz)) then + allocate(DstMiscData%dvx_dz(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%dvx_dz.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%dvx_dz = SrcMiscData%dvx_dz + end if + if (allocated(SrcMiscData%nu_dvx_dy)) then + LB(1:2) = lbound(SrcMiscData%nu_dvx_dy) + UB(1:2) = ubound(SrcMiscData%nu_dvx_dy) + if (.not. allocated(DstMiscData%nu_dvx_dy)) then + allocate(DstMiscData%nu_dvx_dy(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%nu_dvx_dy.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%nu_dvx_dy = SrcMiscData%nu_dvx_dy + end if + if (allocated(SrcMiscData%nu_dvx_dz)) then + LB(1:2) = lbound(SrcMiscData%nu_dvx_dz) + UB(1:2) = ubound(SrcMiscData%nu_dvx_dz) + if (.not. allocated(DstMiscData%nu_dvx_dz)) then + allocate(DstMiscData%nu_dvx_dz(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%nu_dvx_dz.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%nu_dvx_dz = SrcMiscData%nu_dvx_dz + end if + if (allocated(SrcMiscData%dnuvx_dy)) then + LB(1:2) = lbound(SrcMiscData%dnuvx_dy) + UB(1:2) = ubound(SrcMiscData%dnuvx_dy) + if (.not. allocated(DstMiscData%dnuvx_dy)) then + allocate(DstMiscData%dnuvx_dy(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%dnuvx_dy.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%dnuvx_dy = SrcMiscData%dnuvx_dy + end if + if (allocated(SrcMiscData%dnuvx_dz)) then + LB(1:2) = lbound(SrcMiscData%dnuvx_dz) + UB(1:2) = ubound(SrcMiscData%dnuvx_dz) + if (.not. allocated(DstMiscData%dnuvx_dz)) then + allocate(DstMiscData%dnuvx_dz(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%dnuvx_dz.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%dnuvx_dz = SrcMiscData%dnuvx_dz + end if + if (allocated(SrcMiscData%a)) then + LB(1:1) = lbound(SrcMiscData%a) + UB(1:1) = ubound(SrcMiscData%a) + if (.not. allocated(DstMiscData%a)) then + allocate(DstMiscData%a(LB(1):UB(1)), 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 + end if + if (allocated(SrcMiscData%b)) then + LB(1:1) = lbound(SrcMiscData%b) + UB(1:1) = ubound(SrcMiscData%b) + if (.not. allocated(DstMiscData%b)) then + allocate(DstMiscData%b(LB(1):UB(1)), 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 + end if + if (allocated(SrcMiscData%c)) then + LB(1:1) = lbound(SrcMiscData%c) + UB(1:1) = ubound(SrcMiscData%c) + if (.not. allocated(DstMiscData%c)) then + allocate(DstMiscData%c(LB(1):UB(1)), 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 + end if + if (allocated(SrcMiscData%d)) then + LB(1:1) = lbound(SrcMiscData%d) + UB(1:1) = ubound(SrcMiscData%d) + if (.not. allocated(DstMiscData%d)) then + allocate(DstMiscData%d(LB(1):UB(1)), 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 + end if + if (allocated(SrcMiscData%r_wake)) then + LB(1:1) = lbound(SrcMiscData%r_wake) + UB(1:1) = ubound(SrcMiscData%r_wake) + if (.not. allocated(DstMiscData%r_wake)) then + allocate(DstMiscData%r_wake(LB(1):UB(1)), 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 + end if + if (allocated(SrcMiscData%Vx_high)) then + LB(1:1) = lbound(SrcMiscData%Vx_high) + UB(1:1) = ubound(SrcMiscData%Vx_high) + if (.not. allocated(DstMiscData%Vx_high)) then + allocate(DstMiscData%Vx_high(LB(1):UB(1)), 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 + end if + if (allocated(SrcMiscData%Vx_polar)) then + LB(1:1) = lbound(SrcMiscData%Vx_polar) + UB(1:1) = ubound(SrcMiscData%Vx_polar) + if (.not. allocated(DstMiscData%Vx_polar)) then + allocate(DstMiscData%Vx_polar(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Vx_polar.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%Vx_polar = SrcMiscData%Vx_polar + end if + if (allocated(SrcMiscData%Vt_wake)) then + LB(1:1) = lbound(SrcMiscData%Vt_wake) + UB(1:1) = ubound(SrcMiscData%Vt_wake) + if (.not. allocated(DstMiscData%Vt_wake)) then + allocate(DstMiscData%Vt_wake(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Vt_wake.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%Vt_wake = SrcMiscData%Vt_wake + end if + DstMiscData%GammaCurl = SrcMiscData%GammaCurl + DstMiscData%Ct_avg = SrcMiscData%Ct_avg +end subroutine + +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' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(MiscData%dvtdr)) then + deallocate(MiscData%dvtdr) + end if + if (allocated(MiscData%vt_tot)) then + deallocate(MiscData%vt_tot) + end if + if (allocated(MiscData%vt_amb)) then + deallocate(MiscData%vt_amb) + end if + if (allocated(MiscData%vt_shr)) then + deallocate(MiscData%vt_shr) + end if + if (allocated(MiscData%vt_tot2)) then + deallocate(MiscData%vt_tot2) + end if + if (allocated(MiscData%vt_amb2)) then + deallocate(MiscData%vt_amb2) + end if + if (allocated(MiscData%vt_shr2)) then + deallocate(MiscData%vt_shr2) + end if + if (allocated(MiscData%dvx_dy)) then + deallocate(MiscData%dvx_dy) + end if + if (allocated(MiscData%dvx_dz)) then + deallocate(MiscData%dvx_dz) + end if + if (allocated(MiscData%nu_dvx_dy)) then + deallocate(MiscData%nu_dvx_dy) + end if + if (allocated(MiscData%nu_dvx_dz)) then + deallocate(MiscData%nu_dvx_dz) + end if + if (allocated(MiscData%dnuvx_dy)) then + deallocate(MiscData%dnuvx_dy) + end if + if (allocated(MiscData%dnuvx_dz)) then + deallocate(MiscData%dnuvx_dz) + end if + if (allocated(MiscData%a)) then + deallocate(MiscData%a) + end if + if (allocated(MiscData%b)) then + deallocate(MiscData%b) + end if + if (allocated(MiscData%c)) then + deallocate(MiscData%c) + end if + if (allocated(MiscData%d)) then + deallocate(MiscData%d) + end if + if (allocated(MiscData%r_wake)) then + deallocate(MiscData%r_wake) + end if + if (allocated(MiscData%Vx_high)) then + deallocate(MiscData%Vx_high) + end if + if (allocated(MiscData%Vx_polar)) then + deallocate(MiscData%Vx_polar) + end if + if (allocated(MiscData%Vt_wake)) then + deallocate(MiscData%Vt_wake) + end if +end subroutine + +subroutine WD_PackMisc(RF, Indata) + type(RegFile), intent(inout) :: RF + type(WD_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'WD_PackMisc' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%dvtdr) + call RegPackAlloc(RF, InData%vt_tot) + call RegPackAlloc(RF, InData%vt_amb) + call RegPackAlloc(RF, InData%vt_shr) + call RegPackAlloc(RF, InData%vt_tot2) + call RegPackAlloc(RF, InData%vt_amb2) + call RegPackAlloc(RF, InData%vt_shr2) + call RegPackAlloc(RF, InData%dvx_dy) + call RegPackAlloc(RF, InData%dvx_dz) + call RegPackAlloc(RF, InData%nu_dvx_dy) + call RegPackAlloc(RF, InData%nu_dvx_dz) + call RegPackAlloc(RF, InData%dnuvx_dy) + call RegPackAlloc(RF, InData%dnuvx_dz) + call RegPackAlloc(RF, InData%a) + call RegPackAlloc(RF, InData%b) + call RegPackAlloc(RF, InData%c) + call RegPackAlloc(RF, InData%d) + call RegPackAlloc(RF, InData%r_wake) + call RegPackAlloc(RF, InData%Vx_high) + call RegPackAlloc(RF, InData%Vx_polar) + call RegPackAlloc(RF, InData%Vt_wake) + call RegPack(RF, InData%GammaCurl) + call RegPack(RF, InData%Ct_avg) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine WD_UnPackMisc(RF, OutData) + type(RegFile), intent(inout) :: RF + type(WD_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'WD_UnPackMisc' + integer(B4Ki) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%dvtdr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%vt_tot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%vt_amb); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%vt_shr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%vt_tot2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%vt_amb2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%vt_shr2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dvx_dy); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dvx_dz); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%nu_dvx_dy); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%nu_dvx_dz); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dnuvx_dy); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dnuvx_dz); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%a); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%b); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%c); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%d); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%r_wake); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Vx_high); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Vx_polar); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Vt_wake); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GammaCurl); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Ct_avg); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +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 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + 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 + LB(1:1) = lbound(SrcParamData%r) + UB(1:1) = ubound(SrcParamData%r) + if (.not. allocated(DstParamData%r)) then + allocate(DstParamData%r(LB(1):UB(1)), 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 + end if + if (allocated(SrcParamData%y)) then + LB(1:1) = lbound(SrcParamData%y) + UB(1:1) = ubound(SrcParamData%y) + if (.not. allocated(DstParamData%y)) then + allocate(DstParamData%y(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%y.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%y = SrcParamData%y + end if + if (allocated(SrcParamData%z)) then + LB(1:1) = lbound(SrcParamData%z) + UB(1:1) = ubound(SrcParamData%z) + if (.not. allocated(DstParamData%z)) then + allocate(DstParamData%z(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%z.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%z = SrcParamData%z + end if + DstParamData%Mod_Wake = SrcParamData%Mod_Wake + DstParamData%Swirl = SrcParamData%Swirl + DstParamData%k_VortexDecay = SrcParamData%k_VortexDecay + DstParamData%sigma_D = SrcParamData%sigma_D + DstParamData%NumVortices = SrcParamData%NumVortices + 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%k_vAmb = SrcParamData%k_vAmb + 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%k_vShr = SrcParamData%k_vShr + 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%Mod_WakeDiam = SrcParamData%Mod_WakeDiam + DstParamData%C_WakeDiam = SrcParamData%C_WakeDiam + DstParamData%FilterInit = SrcParamData%FilterInit + DstParamData%k_vCurl = SrcParamData%k_vCurl + DstParamData%OutAllPlanes = SrcParamData%OutAllPlanes + DstParamData%OutFileRoot = SrcParamData%OutFileRoot + DstParamData%OutFileVTKDir = SrcParamData%OutFileVTKDir + DstParamData%TurbNum = SrcParamData%TurbNum + DstParamData%WAT = SrcParamData%WAT + DstParamData%WAT_k_Def_k_c = SrcParamData%WAT_k_Def_k_c + DstParamData%WAT_k_Def_FMin = SrcParamData%WAT_k_Def_FMin + DstParamData%WAT_k_Def_DMin = SrcParamData%WAT_k_Def_DMin + DstParamData%WAT_k_Def_DMax = SrcParamData%WAT_k_Def_DMax + DstParamData%WAT_k_Def_Exp = SrcParamData%WAT_k_Def_Exp + DstParamData%WAT_k_Grad_k_c = SrcParamData%WAT_k_Grad_k_c + DstParamData%WAT_k_Grad_FMin = SrcParamData%WAT_k_Grad_FMin + DstParamData%WAT_k_Grad_DMin = SrcParamData%WAT_k_Grad_DMin + DstParamData%WAT_k_Grad_DMax = SrcParamData%WAT_k_Grad_DMax + DstParamData%WAT_k_Grad_Exp = SrcParamData%WAT_k_Grad_Exp +end subroutine + +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' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ParamData%r)) then + deallocate(ParamData%r) + end if + if (allocated(ParamData%y)) then + deallocate(ParamData%y) + end if + if (allocated(ParamData%z)) then + deallocate(ParamData%z) + end if +end subroutine + +subroutine WD_PackParam(RF, Indata) + type(RegFile), intent(inout) :: RF + type(WD_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'WD_PackParam' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%dt_low) + call RegPack(RF, InData%NumPlanes) + call RegPack(RF, InData%NumRadii) + call RegPack(RF, InData%dr) + call RegPackAlloc(RF, InData%r) + call RegPackAlloc(RF, InData%y) + call RegPackAlloc(RF, InData%z) + call RegPack(RF, InData%Mod_Wake) + call RegPack(RF, InData%Swirl) + call RegPack(RF, InData%k_VortexDecay) + call RegPack(RF, InData%sigma_D) + call RegPack(RF, InData%NumVortices) + call RegPack(RF, InData%filtParam) + call RegPack(RF, InData%oneMinusFiltParam) + call RegPack(RF, InData%C_HWkDfl_O) + call RegPack(RF, InData%C_HWkDfl_OY) + call RegPack(RF, InData%C_HWkDfl_x) + call RegPack(RF, InData%C_HWkDfl_xY) + call RegPack(RF, InData%C_NearWake) + call RegPack(RF, InData%k_vAmb) + call RegPack(RF, InData%C_vAmb_DMin) + call RegPack(RF, InData%C_vAmb_DMax) + call RegPack(RF, InData%C_vAmb_FMin) + call RegPack(RF, InData%C_vAmb_Exp) + call RegPack(RF, InData%k_vShr) + call RegPack(RF, InData%C_vShr_DMin) + call RegPack(RF, InData%C_vShr_DMax) + call RegPack(RF, InData%C_vShr_FMin) + call RegPack(RF, InData%C_vShr_Exp) + call RegPack(RF, InData%Mod_WakeDiam) + call RegPack(RF, InData%C_WakeDiam) + call RegPack(RF, InData%FilterInit) + call RegPack(RF, InData%k_vCurl) + call RegPack(RF, InData%OutAllPlanes) + call RegPack(RF, InData%OutFileRoot) + call RegPack(RF, InData%OutFileVTKDir) + call RegPack(RF, InData%TurbNum) + call RegPack(RF, InData%WAT) + call RegPack(RF, InData%WAT_k_Def_k_c) + call RegPack(RF, InData%WAT_k_Def_FMin) + call RegPack(RF, InData%WAT_k_Def_DMin) + call RegPack(RF, InData%WAT_k_Def_DMax) + call RegPack(RF, InData%WAT_k_Def_Exp) + call RegPack(RF, InData%WAT_k_Grad_k_c) + call RegPack(RF, InData%WAT_k_Grad_FMin) + call RegPack(RF, InData%WAT_k_Grad_DMin) + call RegPack(RF, InData%WAT_k_Grad_DMax) + call RegPack(RF, InData%WAT_k_Grad_Exp) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine WD_UnPackParam(RF, OutData) + type(RegFile), intent(inout) :: RF + type(WD_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'WD_UnPackParam' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%dt_low); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumPlanes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumRadii); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%dr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%r); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%z); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Mod_Wake); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Swirl); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%k_VortexDecay); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%sigma_D); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumVortices); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%filtParam); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%oneMinusFiltParam); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%C_HWkDfl_O); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%C_HWkDfl_OY); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%C_HWkDfl_x); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%C_HWkDfl_xY); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%C_NearWake); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%k_vAmb); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%C_vAmb_DMin); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%C_vAmb_DMax); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%C_vAmb_FMin); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%C_vAmb_Exp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%k_vShr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%C_vShr_DMin); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%C_vShr_DMax); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%C_vShr_FMin); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%C_vShr_Exp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Mod_WakeDiam); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%C_WakeDiam); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FilterInit); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%k_vCurl); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutAllPlanes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutFileRoot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutFileVTKDir); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TurbNum); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WAT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WAT_k_Def_k_c); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WAT_k_Def_FMin); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WAT_k_Def_DMin); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WAT_k_Def_DMax); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WAT_k_Def_Exp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WAT_k_Grad_k_c); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WAT_k_Grad_FMin); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WAT_k_Grad_DMin); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WAT_k_Grad_DMax); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WAT_k_Grad_Exp); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +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 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'WD_CopyInput' + ErrStat = ErrID_None + ErrMsg = '' + DstInputData%xhat_disk = SrcInputData%xhat_disk + DstInputData%YawErr = SrcInputData%YawErr + DstInputData%psi_skew = SrcInputData%psi_skew + DstInputData%chi_skew = SrcInputData%chi_skew + DstInputData%p_hub = SrcInputData%p_hub + if (allocated(SrcInputData%V_plane)) then + LB(1:2) = lbound(SrcInputData%V_plane) + UB(1:2) = ubound(SrcInputData%V_plane) + if (.not. allocated(DstInputData%V_plane)) then + allocate(DstInputData%V_plane(LB(1):UB(1),LB(2):UB(2)), 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 + end if + 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 + LB(1:1) = lbound(SrcInputData%Ct_azavg) + UB(1:1) = ubound(SrcInputData%Ct_azavg) + if (.not. allocated(DstInputData%Ct_azavg)) then + allocate(DstInputData%Ct_azavg(LB(1):UB(1)), 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 + end if + if (allocated(SrcInputData%Cq_azavg)) then + LB(1:1) = lbound(SrcInputData%Cq_azavg) + UB(1:1) = ubound(SrcInputData%Cq_azavg) + if (.not. allocated(DstInputData%Cq_azavg)) then + allocate(DstInputData%Cq_azavg(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%Cq_azavg.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%Cq_azavg = SrcInputData%Cq_azavg + end if +end subroutine + +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' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InputData%V_plane)) then + deallocate(InputData%V_plane) + end if + if (allocated(InputData%Ct_azavg)) then + deallocate(InputData%Ct_azavg) + end if + if (allocated(InputData%Cq_azavg)) then + deallocate(InputData%Cq_azavg) + end if +end subroutine + +subroutine WD_PackInput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(WD_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'WD_PackInput' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%xhat_disk) + call RegPack(RF, InData%YawErr) + call RegPack(RF, InData%psi_skew) + call RegPack(RF, InData%chi_skew) + call RegPack(RF, InData%p_hub) + call RegPackAlloc(RF, InData%V_plane) + call RegPack(RF, InData%Vx_wind_disk) + call RegPack(RF, InData%TI_amb) + call RegPack(RF, InData%D_rotor) + call RegPack(RF, InData%Vx_rel_disk) + call RegPackAlloc(RF, InData%Ct_azavg) + call RegPackAlloc(RF, InData%Cq_azavg) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine WD_UnPackInput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(WD_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'WD_UnPackInput' + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%xhat_disk); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawErr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%psi_skew); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%chi_skew); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%p_hub); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%V_plane); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Vx_wind_disk); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TI_amb); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%D_rotor); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Vx_rel_disk); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Ct_azavg); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Cq_azavg); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +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 + integer(B4Ki) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'WD_CopyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcOutputData%xhat_plane)) then + LB(1:2) = lbound(SrcOutputData%xhat_plane) + UB(1:2) = ubound(SrcOutputData%xhat_plane) + if (.not. allocated(DstOutputData%xhat_plane)) then + allocate(DstOutputData%xhat_plane(LB(1):UB(1),LB(2):UB(2)), 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 + end if + if (allocated(SrcOutputData%p_plane)) then + LB(1:2) = lbound(SrcOutputData%p_plane) + UB(1:2) = ubound(SrcOutputData%p_plane) + if (.not. allocated(DstOutputData%p_plane)) then + allocate(DstOutputData%p_plane(LB(1):UB(1),LB(2):UB(2)), 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 + end if + if (allocated(SrcOutputData%Vx_wake)) then + LB(1:2) = lbound(SrcOutputData%Vx_wake) + UB(1:2) = ubound(SrcOutputData%Vx_wake) + if (.not. allocated(DstOutputData%Vx_wake)) then + allocate(DstOutputData%Vx_wake(LB(1):UB(1),LB(2):UB(2)), 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 + end if + if (allocated(SrcOutputData%Vr_wake)) then + LB(1:2) = lbound(SrcOutputData%Vr_wake) + UB(1:2) = ubound(SrcOutputData%Vr_wake) + if (.not. allocated(DstOutputData%Vr_wake)) then + allocate(DstOutputData%Vr_wake(LB(1):UB(1),LB(2):UB(2)), 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 + end if + if (allocated(SrcOutputData%Vx_wake2)) then + LB(1:3) = lbound(SrcOutputData%Vx_wake2) + UB(1:3) = ubound(SrcOutputData%Vx_wake2) + if (.not. allocated(DstOutputData%Vx_wake2)) then + allocate(DstOutputData%Vx_wake2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Vx_wake2.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%Vx_wake2 = SrcOutputData%Vx_wake2 + end if + if (allocated(SrcOutputData%Vy_wake2)) then + LB(1:3) = lbound(SrcOutputData%Vy_wake2) + UB(1:3) = ubound(SrcOutputData%Vy_wake2) + if (.not. allocated(DstOutputData%Vy_wake2)) then + allocate(DstOutputData%Vy_wake2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Vy_wake2.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%Vy_wake2 = SrcOutputData%Vy_wake2 + end if + if (allocated(SrcOutputData%Vz_wake2)) then + LB(1:3) = lbound(SrcOutputData%Vz_wake2) + UB(1:3) = ubound(SrcOutputData%Vz_wake2) + if (.not. allocated(DstOutputData%Vz_wake2)) then + allocate(DstOutputData%Vz_wake2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Vz_wake2.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%Vz_wake2 = SrcOutputData%Vz_wake2 + end if + if (allocated(SrcOutputData%D_wake)) then + LB(1:1) = lbound(SrcOutputData%D_wake) + UB(1:1) = ubound(SrcOutputData%D_wake) + if (.not. allocated(DstOutputData%D_wake)) then + allocate(DstOutputData%D_wake(LB(1):UB(1)), 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 + end if + if (allocated(SrcOutputData%x_plane)) then + LB(1:1) = lbound(SrcOutputData%x_plane) + UB(1:1) = ubound(SrcOutputData%x_plane) + if (.not. allocated(DstOutputData%x_plane)) then + allocate(DstOutputData%x_plane(LB(1):UB(1)), 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 + end if + if (allocated(SrcOutputData%WAT_k)) then + LB(1:3) = lbound(SrcOutputData%WAT_k) + UB(1:3) = ubound(SrcOutputData%WAT_k) + if (.not. allocated(DstOutputData%WAT_k)) then + allocate(DstOutputData%WAT_k(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WAT_k.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%WAT_k = SrcOutputData%WAT_k + end if +end subroutine + +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' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OutputData%xhat_plane)) then + deallocate(OutputData%xhat_plane) + end if + if (allocated(OutputData%p_plane)) then + deallocate(OutputData%p_plane) + end if + if (allocated(OutputData%Vx_wake)) then + deallocate(OutputData%Vx_wake) + end if + if (allocated(OutputData%Vr_wake)) then + deallocate(OutputData%Vr_wake) + end if + if (allocated(OutputData%Vx_wake2)) then + deallocate(OutputData%Vx_wake2) + end if + if (allocated(OutputData%Vy_wake2)) then + deallocate(OutputData%Vy_wake2) + end if + if (allocated(OutputData%Vz_wake2)) then + deallocate(OutputData%Vz_wake2) + end if + if (allocated(OutputData%D_wake)) then + deallocate(OutputData%D_wake) + end if + if (allocated(OutputData%x_plane)) then + deallocate(OutputData%x_plane) + end if + if (allocated(OutputData%WAT_k)) then + deallocate(OutputData%WAT_k) + end if +end subroutine + +subroutine WD_PackOutput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(WD_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'WD_PackOutput' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%xhat_plane) + call RegPackAlloc(RF, InData%p_plane) + call RegPackAlloc(RF, InData%Vx_wake) + call RegPackAlloc(RF, InData%Vr_wake) + call RegPackAlloc(RF, InData%Vx_wake2) + call RegPackAlloc(RF, InData%Vy_wake2) + call RegPackAlloc(RF, InData%Vz_wake2) + call RegPackAlloc(RF, InData%D_wake) + call RegPackAlloc(RF, InData%x_plane) + call RegPackAlloc(RF, InData%WAT_k) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine WD_UnPackOutput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(WD_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'WD_UnPackOutput' + integer(B4Ki) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%xhat_plane); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%p_plane); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Vx_wake); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Vr_wake); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Vx_wake2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Vy_wake2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Vz_wake2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%D_wake); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%x_plane); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WAT_k); if (RegCheckErr(RF, RoutineName)) return +end subroutine END MODULE WakeDynamics_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/openfast_io/README.md b/openfast_io/README.md new file mode 100644 index 0000000000..4d1d77dfda --- /dev/null +++ b/openfast_io/README.md @@ -0,0 +1,51 @@ +# OpenFAST python readers/writers + +This package is a python wrapper comprising readers and writers for converting OpenFAST files to/from python objects. It +was originally written for [WEIS](https://github.com/WISDEM/WEIS/tree/77a878d7989b8c1d07d2244135ccd308a193a924/weis/aeroelasticse) and has been ported over to OpenFAST to make it more widely accessible. + +## Installation +Installation with [Anaconda](https://www.anaconda.com) is the recommended approach because of the ability to create self-contained environments suitable for testing and analysis. + +### Installation as a "library" + +To use `openfast_io` as a library for incorporation into other scripts or tools, it is available via (assuming that you have already setup your python environment): + +```shell +pip install openfast_io +``` + +### Installation as an editable library + +These instructions are for interaction directly with the `openfast_io` source code. + +0. Follow this step only if you have not cloned the OpenFAST repo. + ```shell + git clone https://github.com/OpenFAST/OpenFAST.git + cd OpenFAST + ``` + +1. Assuming you are within the OpenFAST directory. + ```shell + cd openfast_io + pip install -e . + ``` + +2. To test `openfast_io`, OpenFAST must be compiled within the build folder, then run: + + ```shell + cd tests + pytest test_of_io_pytest.py + ``` + +### Extra options +[ROSCO](https://github.com/NREL/ROSCO) can be installed as an optional dependency. Run either +```shell +pip install openfast_io[rosco] +``` + +## Development and testing +To contribute to the development of `openfast_io`, install additioal depemndancies using: + +```shell +pip install -e ".[all]" +``` diff --git a/openfast_python/openfast_io/FAST_linearization_reader.py b/openfast_io/openfast_io/FAST_linearization_reader.py similarity index 100% rename from openfast_python/openfast_io/FAST_linearization_reader.py rename to openfast_io/openfast_io/FAST_linearization_reader.py diff --git a/openfast_python/openfast_io/FAST_output_reader.py b/openfast_io/openfast_io/FAST_output_reader.py similarity index 89% rename from openfast_python/openfast_io/FAST_output_reader.py rename to openfast_io/openfast_io/FAST_output_reader.py index aba9328393..d81ba97989 100644 --- a/openfast_python/openfast_io/FAST_output_reader.py +++ b/openfast_io/openfast_io/FAST_output_reader.py @@ -103,15 +103,15 @@ def toDataFrame(self): return df -def load_ascii_output(filename): +def load_ascii_output(filename, headerLines = 8, descriptionLine = 4, attributeLine = 6, unitLine = 7, delimiter = None): 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=float) + header = [f.readline() for _ in range(headerLines)] + info['description'] = header[descriptionLine].strip() + info['attribute_names'] = header[attributeLine].strip().split(delimiter) + info['attribute_units'] = [unit[1:-1] for unit in header[unitLine].strip().split(delimiter)] #removing "()" + data = np.array([line.split(delimiter) for line in f.readlines()], dtype=float) return data, info def load_binary_output(filename): @@ -211,16 +211,20 @@ def fread(fid, n, type): 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) }))) + from openfast_io.FileTools import check_rtest_cloned + + parent_dir = os.path.dirname( os.path.dirname( os.path.dirname( os.path.realpath(__file__) ) ) ) + os.sep + + of_outputfile = os.path.join(parent_dir, 'reg_tests', 'r-test', 'glue-codes', + 'openfast', '5MW_Land_BD_DLL_WTurb', '5MW_Land_BD_DLL_WTurb.outb') + check_rtest_cloned(of_outputfile) + + d,i,p = load_binary_output(of_outputfile) + + print(tuple(i['attribute_names'])) + print(type(d)) print(i) print(len(i['attribute_names'])) print(np.shape(d)) diff --git a/openfast_python/openfast_io/FAST_post.py b/openfast_io/openfast_io/FAST_post.py similarity index 100% rename from openfast_python/openfast_io/FAST_post.py rename to openfast_io/openfast_io/FAST_post.py diff --git a/openfast_python/openfast_io/FAST_reader.py b/openfast_io/openfast_io/FAST_reader.py similarity index 59% rename from openfast_python/openfast_io/FAST_reader.py rename to openfast_io/openfast_io/FAST_reader.py index f9e909d726..72bf38087e 100644 --- a/openfast_python/openfast_io/FAST_reader.py +++ b/openfast_io/openfast_io/FAST_reader.py @@ -3,6 +3,7 @@ from functools import reduce import operator from openfast_io.FAST_vars_out import FstOutput +from openfast_io.FAST_output_reader import load_ascii_output try: from rosco.toolbox.utilities import read_DISCON, load_from_txt @@ -13,28 +14,54 @@ def readline_filterComments(f): - read = True - while read: - line = f.readline().strip() - if len(line)>0: - if line[0] != '!': - read = False - return line + """ + Filter out comments and empty lines from a file + + Args: + f: file handle + + Returns: + line: next line in the file that is not a comment or empty + """ + read = True + while read: + line = f.readline().strip() + if len(line)>0: + if line[0] != '!': + read = False + return line + +def read_array(f,len,split_val=None,array_type=str): + """ + Read an array of values from a line in a file + + Args: + f: file handle + len: number of values to read + split_val: value to stop reading at + array_type: type of values to return + + Returns: + arr: list of values read from the file line with the specified type + """ -def fix_path(name): - """ split a path, then reconstruct it using os.path.join """ - name = re.split("\\\|/", name) - new = name[0] - for i in range(1,len(name)): - new = os.path.join(new, name[i]) - return new -def read_array(f,len,array_type=str): strings = re.split(',| ',f.readline().strip()) while '' in strings: # remove empties strings.remove('') - arr = strings[:len] # select len strings + if len is None and split_val is None: + raise Exception('Must have len or split_val to use read_array') + + if len is not None: + arr = strings[:len] # select len strings + else: + arr = [] + for s in strings: + if s != split_val: + arr.append(s) + else: + break if array_type==str: arr = [ar.replace('"','') for ar in arr] # remove quotes and commas @@ -49,8 +76,32 @@ def read_array(f,len,array_type=str): return arr +def fix_path(name): + """ + split a path, then reconstruct it using os.path.join + + Args: + name: path to fix + + Returns: + new: reconstructed path + """ + name = re.split("\\|/", name) + new = name[0] + for i in range(1,len(name)): + new = os.path.join(new, name[i]) + return new + def bool_read(text): - # convert true/false strings to boolean + """ + Read a boolean value from a string + + Args: + text: string to read + + Returns: + True if the string is 'true', False otherwise + """ if 'default' in text.lower(): return str(text) else: @@ -60,7 +111,15 @@ def bool_read(text): return False def float_read(text): - # return float with error handing for "default" values + """ + Read a float value from a string, with error handling for 'default' values + + Args: + text: string to read + + Returns: + float value if the string can be converted, string otherwise + """ if 'default' in text.lower(): return str(text) else: @@ -70,7 +129,15 @@ def float_read(text): return str(text) def int_read(text): - # return int with error handing for "default" values + """ + Read an integer value from a string, with error handling for 'default' values + + Args: + text: string to read + + Returns: + int value if the string can be converted, string otherwise + """ if 'default' in text.lower(): return str(text) else: @@ -79,6 +146,24 @@ def int_read(text): except: return str(text) +def quoted_read(text): + """ + Read a quoted value from a string (i.e. a value between quotes) + + Args: + text: string to read + + Returns: + quoted value if the string is quoted, unquoted value otherwise + + """ + if '"' in text: + return text.split('"')[1] + elif "'" in text: + return text.split("'")[1] + else: + return text + class InputReader_OpenFAST(object): """ OpenFAST input file reader """ @@ -91,22 +176,25 @@ def __init__(self): self.fst_vt['Fst'] = {} self.fst_vt['outlist'] = FstOutput self.fst_vt['ElastoDyn'] = {} + self.fst_vt['SimpleElastoDyn'] = {} self.fst_vt['ElastoDynBlade'] = {} self.fst_vt['ElastoDynTower'] = {} self.fst_vt['InflowWind'] = {} - self.fst_vt['AeroDyn15'] = {} - self.fst_vt['AeroDyn14'] = {} + self.fst_vt['AeroDyn'] = {} + self.fst_vt['AeroDisk'] = {} self.fst_vt['AeroDynBlade'] = {} - self.fst_vt['AeroDynTower'] = {} self.fst_vt['AeroDynPolar'] = {} self.fst_vt['ServoDyn'] = {} self.fst_vt['DISCON_in'] = {} self.fst_vt['HydroDyn'] = {} + self.fst_vt['SeaState'] = {} self.fst_vt['MoorDyn'] = {} self.fst_vt['SubDyn'] = {} + self.fst_vt['ExtPtfm'] = {} self.fst_vt['MAP'] = {} self.fst_vt['BeamDyn'] = {} self.fst_vt['BeamDynBlade'] = {} + self.fst_vt['WaterKin'] = {} def set_outlist(self, vartree_head, channel_list): """ Loop through a list of output channel names, recursively set them to True in the nested outlist dict """ @@ -133,6 +221,46 @@ def loop_dict(vartree, search_var, branch): var = var.replace(' ', '') loop_dict(vartree_head, var, []) + def read_outlist_freeForm(self,f,module): + ''' + Replacement for set_outlist that doesn't care about whether the channel is in the outlist vartree + Easier, but riskier because OpenFAST can crash + + Inputs: f - file handle + module - of OpenFAST, e.g. SubDyn, SeaState (these modules use this) + ''' + data = f.readline() + while data.split()[0] != 'END': + pattern = r'"?(.*?)"?' # grab only the text between quotes + data = re.findall(pattern, data)[0] + channels = data.split(',') # split on commas + channels = [c.strip() for c in channels] # strip whitespace + for c in channels: + self.fst_vt['outlist'][module][c] = True + data = f.readline() + + def read_outlist(self,f,module): + ''' + Read the outlist section of the FAST input file, genralized for most modules + + Inputs: f - file handle + module - of OpenFAST, e.g. ElastoDyn, ServoDyn, AeroDyn, AeroDisk, etc. + + ''' + data = f.readline().split()[0] # to counter if we dont have any quotes + while data != 'END': + if data.find('"')>=0: + channels = data.split('"') + channel_list = channels[1].split(',') + else: + row_string = data.split(',') + if len(row_string)==1: + channel_list = [row_string[0].split('\n')[0]] + else: + channel_list = row_string + self.set_outlist(self.fst_vt['outlist'][module], channel_list) + data = f.readline().split()[0] # to counter if we dont have any quotes + def read_MainInput(self): # Main FAST v8.16-v8.17 Input File # Currently no differences between FASTv8.16 and OpenFAST. @@ -146,7 +274,7 @@ def read_MainInput(self): # Simulation Control (fst_sim_ctrl) f.readline() self.fst_vt['Fst']['Echo'] = bool_read(f.readline().split()[0]) - self.fst_vt['Fst']['AbortLevel'] = f.readline().split()[0][1:-1] + self.fst_vt['Fst']['AbortLevel'] = quoted_read(f.readline().split()[0]) self.fst_vt['Fst']['TMax'] = float_read(f.readline().split()[0]) self.fst_vt['Fst']['DT'] = float_read(f.readline().split()[0]) self.fst_vt['Fst']['InterpOrder'] = int(f.readline().split()[0]) @@ -160,6 +288,7 @@ def read_MainInput(self): self.fst_vt['Fst']['CompInflow'] = int(f.readline().split()[0]) self.fst_vt['Fst']['CompAero'] = int(f.readline().split()[0]) self.fst_vt['Fst']['CompServo'] = int(f.readline().split()[0]) + self.fst_vt['Fst']['CompSeaSt'] = int(f.readline().split()[0]) self.fst_vt['Fst']['CompHydro'] = int(f.readline().split()[0]) self.fst_vt['Fst']['CompSub'] = int(f.readline().split()[0]) self.fst_vt['Fst']['CompMooring'] = int(f.readline().split()[0]) @@ -180,17 +309,18 @@ def read_MainInput(self): # Input Files (input_files) f.readline() - self.fst_vt['Fst']['EDFile'] = f.readline().split()[0][1:-1] - self.fst_vt['Fst']['BDBldFile(1)'] = f.readline().split()[0][1:-1] - self.fst_vt['Fst']['BDBldFile(2)'] = f.readline().split()[0][1:-1] - self.fst_vt['Fst']['BDBldFile(3)'] = f.readline().split()[0][1:-1] - self.fst_vt['Fst']['InflowFile'] = f.readline().split()[0][1:-1] - self.fst_vt['Fst']['AeroFile'] = f.readline().split()[0][1:-1] - self.fst_vt['Fst']['ServoFile'] = f.readline().split()[0][1:-1] - self.fst_vt['Fst']['HydroFile'] = f.readline().split()[0][1:-1] - self.fst_vt['Fst']['SubFile'] = f.readline().split()[0][1:-1] - self.fst_vt['Fst']['MooringFile'] = f.readline().split()[0][1:-1] - self.fst_vt['Fst']['IceFile'] = f.readline().split()[0][1:-1] + self.fst_vt['Fst']['EDFile'] = quoted_read(f.readline().split()[0]) + self.fst_vt['Fst']['BDBldFile(1)'] = quoted_read(f.readline().split()[0]) + self.fst_vt['Fst']['BDBldFile(2)'] = quoted_read(f.readline().split()[0]) + self.fst_vt['Fst']['BDBldFile(3)'] = quoted_read(f.readline().split()[0]) + self.fst_vt['Fst']['InflowFile'] = quoted_read(f.readline().split()[0]) + self.fst_vt['Fst']['AeroFile'] = quoted_read(f.readline().split()[0]) + self.fst_vt['Fst']['ServoFile'] = quoted_read(f.readline().split()[0]) + self.fst_vt['Fst']['SeaStFile'] = quoted_read(f.readline().split()[0]) + self.fst_vt['Fst']['HydroFile'] = quoted_read(f.readline().split()[0]) + self.fst_vt['Fst']['SubFile'] = quoted_read(f.readline().split()[0]) + self.fst_vt['Fst']['MooringFile'] = quoted_read(f.readline().split()[0]) + self.fst_vt['Fst']['IceFile'] = quoted_read(f.readline().split()[0]) # FAST Output Parameters (fst_output_params) f.readline() @@ -201,7 +331,7 @@ def read_MainInput(self): self.fst_vt['Fst']['TStart'] = float_read(f.readline().split()[0]) self.fst_vt['Fst']['OutFileFmt'] = int(f.readline().split()[0]) self.fst_vt['Fst']['TabDelim'] = bool_read(f.readline().split()[0]) - self.fst_vt['Fst']['OutFmt'] = f.readline().split()[0][1:-1] + self.fst_vt['Fst']['OutFmt'] = quoted_read(f.readline().split()[0]) # Fst f.readline() @@ -212,8 +342,8 @@ def read_MainInput(self): self.fst_vt['Fst']['TrimGain'] = f.readline().split()[0] self.fst_vt['Fst']['Twr_Kdmp'] = f.readline().split()[0] self.fst_vt['Fst']['Bld_Kdmp'] = f.readline().split()[0] - self.fst_vt['Fst']['NLinTimes'] = f.readline().split()[0] - self.fst_vt['Fst']['LinTimes'] = re.findall(r'[^,\s]+', f.readline())[0:2] + self.fst_vt['Fst']['NLinTimes'] = int(f.readline().split()[0]) + self.fst_vt['Fst']['LinTimes'] = read_array(f, self.fst_vt['Fst']['NLinTimes'], array_type=float) self.fst_vt['Fst']['LinInputs'] = f.readline().split()[0] self.fst_vt['Fst']['LinOutputs'] = f.readline().split()[0] self.fst_vt['Fst']['LinOutJac'] = f.readline().split()[0] @@ -341,13 +471,16 @@ def read_ElastoDyn(self, ed_file): self.fst_vt['ElastoDyn']['PtfmRIner'] = float_read(f.readline().split()[0]) self.fst_vt['ElastoDyn']['PtfmPIner'] = float_read(f.readline().split()[0]) self.fst_vt['ElastoDyn']['PtfmYIner'] = float_read(f.readline().split()[0]) + self.fst_vt['ElastoDyn']['PtfmXYIner'] = float_read(f.readline().split()[0]) + self.fst_vt['ElastoDyn']['PtfmYZIner'] = float_read(f.readline().split()[0]) + self.fst_vt['ElastoDyn']['PtfmXZIner'] = float_read(f.readline().split()[0]) # ElastoDyn Blade (blade_struc) f.readline() self.fst_vt['ElastoDyn']['BldNodes'] = int(f.readline().split()[0]) - self.fst_vt['ElastoDyn']['BldFile1'] = f.readline().split()[0][1:-1] - self.fst_vt['ElastoDyn']['BldFile2'] = f.readline().split()[0][1:-1] - self.fst_vt['ElastoDyn']['BldFile3'] = f.readline().split()[0][1:-1] + self.fst_vt['ElastoDyn']['BldFile1'] = quoted_read(f.readline().split()[0]) + self.fst_vt['ElastoDyn']['BldFile2'] = quoted_read(f.readline().split()[0]) + self.fst_vt['ElastoDyn']['BldFile3'] = quoted_read(f.readline().split()[0]) # Rotor-Teeter (rotor_teeter) f.readline() @@ -360,6 +493,19 @@ def read_ElastoDyn(self, ed_file): self.fst_vt['ElastoDyn']['TeetSSSp'] = float_read(f.readline().split()[0]) self.fst_vt['ElastoDyn']['TeetHSSp'] = float_read(f.readline().split()[0]) + # Yaw friction + f.readline() + self.fst_vt['ElastoDyn']['YawFrctMod'] = int(f.readline().split()[0]) + self.fst_vt['ElastoDyn']['M_CSmax'] = float_read(f.readline().split()[0]) + self.fst_vt['ElastoDyn']['M_FCSmax'] = float_read(f.readline().split()[0]) + self.fst_vt['ElastoDyn']['M_MCSmax'] = float_read(f.readline().split()[0]) + self.fst_vt['ElastoDyn']['M_CD'] = float_read(f.readline().split()[0]) + self.fst_vt['ElastoDyn']['M_FCD'] = float_read(f.readline().split()[0]) + self.fst_vt['ElastoDyn']['M_MCD'] = float_read(f.readline().split()[0]) + self.fst_vt['ElastoDyn']['sig_v'] = float_read(f.readline().split()[0]) + self.fst_vt['ElastoDyn']['sig_v2'] = float_read(f.readline().split()[0]) + self.fst_vt['ElastoDyn']['OmgCut'] = float_read(f.readline().split()[0]) + # Drivetrain (drivetrain) f.readline() self.fst_vt['ElastoDyn']['GBoxEff'] = float_read(f.readline().split()[0]) @@ -370,34 +516,30 @@ def read_ElastoDyn(self, ed_file): # Furling (furling) f.readline() self.fst_vt['ElastoDyn']['Furling'] = bool_read(f.readline().split()[0]) - self.fst_vt['ElastoDyn']['FurlFile'] = f.readline().split()[0][1:-1] + self.fst_vt['ElastoDyn']['FurlFile'] = os.path.join(self.FAST_directory, quoted_read(f.readline().split()[0])) # TODO: add furl file data to fst_vt, pointing to absolute path for now # Tower (tower) f.readline() self.fst_vt['ElastoDyn']['TwrNodes'] = int(f.readline().split()[0]) - self.fst_vt['ElastoDyn']['TwrFile'] = f.readline().split()[0][1:-1] + self.fst_vt['ElastoDyn']['TwrFile'] = quoted_read(f.readline().split()[0]) # ED Output Parameters (ed_out_params) f.readline() self.fst_vt['ElastoDyn']['SumPrint'] = bool_read(f.readline().split()[0]) self.fst_vt['ElastoDyn']['OutFile'] = int(f.readline().split()[0]) self.fst_vt['ElastoDyn']['TabDelim'] = bool_read(f.readline().split()[0]) - self.fst_vt['ElastoDyn']['OutFmt'] = f.readline().split()[0][1:-1] + self.fst_vt['ElastoDyn']['OutFmt'] = quoted_read(f.readline().split()[0]) self.fst_vt['ElastoDyn']['TStart'] = float_read(f.readline().split()[0]) self.fst_vt['ElastoDyn']['DecFact'] = int(f.readline().split()[0]) self.fst_vt['ElastoDyn']['NTwGages'] = int(f.readline().split()[0]) if self.fst_vt['ElastoDyn']['NTwGages'] != 0: #loop over elements if there are gauges to be added, otherwise assign directly - self.fst_vt['ElastoDyn']['TwrGagNd'] = f.readline().strip().split()[:self.fst_vt['ElastoDyn']['NTwGages']] - for i, bldgag in enumerate(self.fst_vt['ElastoDyn']['TwrGagNd']): - self.fst_vt['ElastoDyn']['TwrGagNd'][i] = int(bldgag.strip(',')) + self.fst_vt['ElastoDyn']['TwrGagNd'] = read_array(f,self.fst_vt['ElastoDyn']['NTwGages'], array_type=int) else: self.fst_vt['ElastoDyn']['TwrGagNd'] = 0 f.readline() self.fst_vt['ElastoDyn']['NBlGages'] = int(f.readline().split()[0]) if self.fst_vt['ElastoDyn']['NBlGages'] != 0: - self.fst_vt['ElastoDyn']['BldGagNd'] = f.readline().strip().split()[:self.fst_vt['ElastoDyn']['NBlGages']] - for i, bldgag in enumerate(self.fst_vt['ElastoDyn']['BldGagNd']): - self.fst_vt['ElastoDyn']['BldGagNd'][i] = int(bldgag.strip(',')) + self.fst_vt['ElastoDyn']['BldGagNd'] = read_array(f,self.fst_vt['ElastoDyn']['NBlGages'], array_type=int) else: self.fst_vt['ElastoDyn']['BldGagNd'] = 0 f.readline() @@ -405,14 +547,34 @@ def read_ElastoDyn(self, ed_file): # Loop through output channel lines f.readline() data = f.readline() - if data != '': - while data.split()[0] != 'END': + # if data != '': + # while data.split()[0] != 'END': + # channels = data.split('"') + # channel_list = channels[1].split(',') + # self.set_outlist(self.fst_vt['outlist']['ElastoDyn'], channel_list) + + # data = f.readline() + # else: + # # there is a blank line between the outlist and the END of the file + # f.readline() + + # Handle the case if there are blank lines before the END statement, check if blank line + while data.split().__len__() == 0: + data = f.readline() + + while data.split()[0] != 'END': + if data.find('"')>=0: channels = data.split('"') channel_list = channels[1].split(',') - self.set_outlist(self.fst_vt['outlist']['ElastoDyn'], channel_list) + else: + row_string = data.split(',') + if len(row_string)==1: + channel_list = row_string[0].split('\n')[0] + else: + channel_list = row_string + self.set_outlist(self.fst_vt['outlist']['ElastoDyn'], channel_list) + data = f.readline() - data = f.readline() - # ElastoDyn optional outlist try: f.readline() @@ -439,6 +601,60 @@ def read_ElastoDyn(self, ed_file): f.close() + def read_SimpleElastoDyn(self, sed_file): + # Read the Simplified ElastoDyn input file + f = open(sed_file) + + f.readline() + f.readline() + f.readline() + self.fst_vt['SimpleElastoDyn']['Echo'] = bool_read(f.readline().split()[0]) + self.fst_vt['SimpleElastoDyn']['IntMethod'] = int_read(f.readline().split()[0]) + self.fst_vt['SimpleElastoDyn']['DT'] = float_read(f.readline().split()[0]) + + # Degrees of Freedom + f.readline() + self.fst_vt['SimpleElastoDyn']['GenDOF'] = bool_read(f.readline().split()[0]) + self.fst_vt['SimpleElastoDyn']['YawDOF'] = bool_read(f.readline().split()[0]) + + # Initial Conditions + f.readline() + self.fst_vt['SimpleElastoDyn']['Azimuth'] = float_read(f.readline().split()[0]) + self.fst_vt['SimpleElastoDyn']['BlPitch'] = float_read(f.readline().split()[0]) + self.fst_vt['SimpleElastoDyn']['RotSpeed'] = float_read(f.readline().split()[0]) + self.fst_vt['SimpleElastoDyn']['NacYaw'] = float_read(f.readline().split()[0]) + self.fst_vt['SimpleElastoDyn']['PtfmPitch'] = float_read(f.readline().split()[0]) + + # Turbine Configuration + f.readline() + self.fst_vt['SimpleElastoDyn']['NumBl'] = int_read(f.readline().split()[0]) + self.fst_vt['SimpleElastoDyn']['TipRad'] = float_read(f.readline().split()[0]) + self.fst_vt['SimpleElastoDyn']['HubRad'] = float_read(f.readline().split()[0]) + self.fst_vt['SimpleElastoDyn']['PreCone'] = float_read(f.readline().split()[0]) + self.fst_vt['SimpleElastoDyn']['OverHang'] = float_read(f.readline().split()[0]) + self.fst_vt['SimpleElastoDyn']['ShftTilt'] = float_read(f.readline().split()[0]) + self.fst_vt['SimpleElastoDyn']['Twr2Shft'] = float_read(f.readline().split()[0]) + self.fst_vt['SimpleElastoDyn']['TowerHt'] = float_read(f.readline().split()[0]) + + # Mass and Inertia + f.readline() + self.fst_vt['SimpleElastoDyn']['RotIner'] = float_read(f.readline().split()[0]) + self.fst_vt['SimpleElastoDyn']['GenIner'] = float_read(f.readline().split()[0]) + + # Drivetrain + f.readline() + self.fst_vt['SimpleElastoDyn']['GBoxRatio'] = float_read(f.readline().split()[0]) + + # Output + f.readline() + f.readline() + + self.read_outlist(f,'SimpleElastoDyn') + + f.close() + + + def read_ElastoDynBlade(self, blade_file): # ElastoDyn v1.00 Blade Input File # Currently no differences between FASTv8.16 and OpenFAST. @@ -617,9 +833,9 @@ def read_BeamDyn(self, bd_file): #---------------------- OUTPUTS ------------------------------------------------- f.readline() self.fst_vt['BeamDyn']['SumPrint'] = bool_read(f.readline().split()[0]) - self.fst_vt['BeamDyn']['OutFmt'] = f.readline().split()[0][1:-1] + self.fst_vt['BeamDyn']['OutFmt'] = quoted_read(f.readline().split()[0]) self.fst_vt['BeamDyn']['NNodeOuts'] = int_read(f.readline().split()[0]) - self.fst_vt['BeamDyn']['OutNd'] = [idx.strip() for idx in f.readline().split('NNodeOuts')[0].split(',')] + self.fst_vt['BeamDyn']['OutNd'] = [idx.strip() for idx in f.readline().split('OutNd')[0].split(',')] # BeamDyn Outlist f.readline() data = f.readline() @@ -714,35 +930,35 @@ def read_InflowWind(self): self.fst_vt['InflowWind']['VFlowAng'] = float_read(f.readline().split()[0]) self.fst_vt['InflowWind']['VelInterpCubic'] = bool_read(f.readline().split()[0]) self.fst_vt['InflowWind']['NWindVel'] = int(f.readline().split()[0]) - self.fst_vt['InflowWind']['WindVxiList'] = float_read(f.readline().split()[0]) - self.fst_vt['InflowWind']['WindVyiList'] = float_read(f.readline().split()[0]) - self.fst_vt['InflowWind']['WindVziList'] = float_read(f.readline().split()[0]) + self.fst_vt['InflowWind']['WindVxiList'] = [idx.strip() for idx in f.readline().split('WindVxiList')[0].split(',')] + self.fst_vt['InflowWind']['WindVyiList'] = [idx.strip() for idx in f.readline().split('WindVyiList')[0].split(',')] + self.fst_vt['InflowWind']['WindVziList'] = [idx.strip() for idx in f.readline().split('WindVziList')[0].split(',')] # Parameters for Steady Wind Conditions [used only for WindType = 1] (steady_wind_params) f.readline() self.fst_vt['InflowWind']['HWindSpeed'] = float_read(f.readline().split()[0]) self.fst_vt['InflowWind']['RefHt'] = float_read(f.readline().split()[0]) - self.fst_vt['InflowWind']['PLexp'] = float_read(f.readline().split()[0]) + self.fst_vt['InflowWind']['PLExp'] = float_read(f.readline().split()[0]) # Parameters for Uniform wind file [used only for WindType = 2] (uniform_wind_params) f.readline() - self.fst_vt['InflowWind']['Filename_Uni'] = os.path.join(os.path.split(inflow_file)[0], f.readline().split()[0][1:-1]) + self.fst_vt['InflowWind']['FileName_Uni'] = os.path.join(os.path.split(inflow_file)[0], quoted_read(f.readline().split()[0])) self.fst_vt['InflowWind']['RefHt_Uni'] = float_read(f.readline().split()[0]) self.fst_vt['InflowWind']['RefLength'] = float_read(f.readline().split()[0]) # Parameters for Binary TurbSim Full-Field files [used only for WindType = 3] (turbsim_wind_params) f.readline() - self.fst_vt['InflowWind']['FileName_BTS'] = os.path.join(os.path.split(inflow_file)[0], f.readline().split()[0][1:-1]) + self.fst_vt['InflowWind']['FileName_BTS'] = os.path.join(os.path.split(inflow_file)[0], quoted_read(f.readline().split()[0])) # Parameters for Binary Bladed-style Full-Field files [used only for WindType = 4] (bladed_wind_params) f.readline() - self.fst_vt['InflowWind']['FilenameRoot'] = f.readline().split()[0][1:-1] + self.fst_vt['InflowWind']['FileNameRoot'] = os.path.join(os.path.split(inflow_file)[0], quoted_read(f.readline().split()[0])) self.fst_vt['InflowWind']['TowerFile'] = bool_read(f.readline().split()[0]) # Parameters for HAWC-format binary files [Only used with WindType = 5] (hawc_wind_params) f.readline() - self.fst_vt['InflowWind']['FileName_u'] = os.path.normpath(os.path.join(os.path.split(inflow_file)[0], f.readline().split()[0][1:-1])) - self.fst_vt['InflowWind']['FileName_v'] = os.path.normpath(os.path.join(os.path.split(inflow_file)[0], f.readline().split()[0][1:-1])) - self.fst_vt['InflowWind']['FileName_w'] = os.path.normpath(os.path.join(os.path.split(inflow_file)[0], f.readline().split()[0][1:-1])) + self.fst_vt['InflowWind']['FileName_u'] = os.path.normpath(os.path.join(os.path.split(inflow_file)[0], quoted_read(f.readline().split()[0]))) + self.fst_vt['InflowWind']['FileName_v'] = os.path.normpath(os.path.join(os.path.split(inflow_file)[0], quoted_read(f.readline().split()[0]))) + self.fst_vt['InflowWind']['FileName_w'] = os.path.normpath(os.path.join(os.path.split(inflow_file)[0], quoted_read(f.readline().split()[0]))) self.fst_vt['InflowWind']['nx'] = int(f.readline().split()[0]) self.fst_vt['InflowWind']['ny'] = int(f.readline().split()[0]) self.fst_vt['InflowWind']['nz'] = int(f.readline().split()[0]) @@ -775,9 +991,9 @@ def read_InflowWind(self): self.fst_vt['InflowWind']['NumPulseGate'] = int(f.readline().split()[0]) self.fst_vt['InflowWind']['PulseSpacing'] = float_read(f.readline().split()[0]) self.fst_vt['InflowWind']['NumBeam'] = int(f.readline().split()[0]) - self.fst_vt['InflowWind']['FocalDistanceX'] = float_read(f.readline().split()[0]) - self.fst_vt['InflowWind']['FocalDistanceY'] = float_read(f.readline().split()[0]) - self.fst_vt['InflowWind']['FocalDistanceZ'] = float_read(f.readline().split()[0]) + self.fst_vt['InflowWind']['FocalDistanceX'] = [idx.strip() for idx in f.readline().split('FocalDistanceX')[0].split(',')] + self.fst_vt['InflowWind']['FocalDistanceY'] = [idx.strip() for idx in f.readline().split('FocalDistanceY')[0].split(',')] + self.fst_vt['InflowWind']['FocalDistanceZ'] = [idx.strip() for idx in f.readline().split('FocalDistanceZ')[0].split(',')] self.fst_vt['InflowWind']['RotorApexOffsetPos'] = [idx.strip() for idx in f.readline().split('RotorApexOffsetPos')[0].split(',')] self.fst_vt['InflowWind']['URefLid'] = float_read(f.readline().split()[0]) self.fst_vt['InflowWind']['MeasurementInterval'] = float_read(f.readline().split()[0]) @@ -806,7 +1022,7 @@ def read_InflowWind(self): f.close() - def read_AeroDyn15(self): + def read_AeroDyn(self): # AeroDyn v15.03 ad_file = os.path.join(self.FAST_directory, self.fst_vt['Fst']['AeroFile']) @@ -816,133 +1032,156 @@ def read_AeroDyn15(self): f.readline() f.readline() f.readline() - self.fst_vt['AeroDyn15']['Echo'] = bool_read(f.readline().split()[0]) - self.fst_vt['AeroDyn15']['DTAero'] = float_read(f.readline().split()[0]) - self.fst_vt['AeroDyn15']['WakeMod'] = int(f.readline().split()[0]) - self.fst_vt['AeroDyn15']['AFAeroMod'] = int(f.readline().split()[0]) - self.fst_vt['AeroDyn15']['TwrPotent'] = int(f.readline().split()[0]) - self.fst_vt['AeroDyn15']['TwrShadow'] = int(f.readline().split()[0]) - self.fst_vt['AeroDyn15']['TwrAero'] = bool_read(f.readline().split()[0]) - self.fst_vt['AeroDyn15']['FrozenWake'] = bool_read(f.readline().split()[0]) - self.fst_vt['AeroDyn15']['CavitCheck'] = bool_read(f.readline().split()[0]) - self.fst_vt['AeroDyn15']['Buoyancy'] = bool_read(f.readline().split()[0]) - self.fst_vt['AeroDyn15']['CompAA'] = bool_read(f.readline().split()[0]) - self.fst_vt['AeroDyn15']['AA_InputFile'] = f.readline().split()[0] + self.fst_vt['AeroDyn']['Echo'] = bool_read(f.readline().split()[0]) + self.fst_vt['AeroDyn']['DTAero'] = float_read(f.readline().split()[0]) + self.fst_vt['AeroDyn']['Wake_Mod'] = int(f.readline().split()[0]) + self.fst_vt['AeroDyn']['TwrPotent'] = int(f.readline().split()[0]) + self.fst_vt['AeroDyn']['TwrShadow'] = int(f.readline().split()[0]) + self.fst_vt['AeroDyn']['TwrAero'] = bool_read(f.readline().split()[0]) + self.fst_vt['AeroDyn']['CavitCheck'] = bool_read(f.readline().split()[0]) + self.fst_vt['AeroDyn']['Buoyancy'] = bool_read(f.readline().split()[0]) + self.fst_vt['AeroDyn']['NacelleDrag'] = bool_read(f.readline().split()[0]) + self.fst_vt['AeroDyn']['CompAA'] = bool_read(f.readline().split()[0]) + self.fst_vt['AeroDyn']['AA_InputFile'] = f.readline().split()[0] # Environmental Conditions f.readline() - self.fst_vt['AeroDyn15']['AirDens'] = float_read(f.readline().split()[0]) - self.fst_vt['AeroDyn15']['KinVisc'] = float_read(f.readline().split()[0]) - self.fst_vt['AeroDyn15']['SpdSound'] = float_read(f.readline().split()[0]) - self.fst_vt['AeroDyn15']['Patm'] = float_read(f.readline().split()[0]) - self.fst_vt['AeroDyn15']['Pvap'] = float_read(f.readline().split()[0]) - #self.fst_vt['AeroDyn15']['FluidDepth'] = float_read(f.readline().split()[0]) + self.fst_vt['AeroDyn']['AirDens'] = float_read(f.readline().split()[0]) + self.fst_vt['AeroDyn']['KinVisc'] = float_read(f.readline().split()[0]) + self.fst_vt['AeroDyn']['SpdSound'] = float_read(f.readline().split()[0]) + self.fst_vt['AeroDyn']['Patm'] = float_read(f.readline().split()[0]) + self.fst_vt['AeroDyn']['Pvap'] = float_read(f.readline().split()[0]) + #self.fst_vt['AeroDyn']['FluidDepth'] = float_read(f.readline().split()[0]) + + f.readline() + self.fst_vt['AeroDyn']['BEM_Mod'] = int(f.readline().split()[0]) # Blade-Element/Momentum Theory Options f.readline() - self.fst_vt['AeroDyn15']['SkewMod'] = int_read(f.readline().split()[0]) - self.fst_vt['AeroDyn15']['SkewModFactor'] = float_read(f.readline().split()[0]) - self.fst_vt['AeroDyn15']['TipLoss'] = bool_read(f.readline().split()[0]) - self.fst_vt['AeroDyn15']['HubLoss'] = bool_read(f.readline().split()[0]) - self.fst_vt['AeroDyn15']['TanInd'] = bool_read(f.readline().split()[0]) - self.fst_vt['AeroDyn15']['AIDrag'] = bool_read(f.readline().split()[0]) - self.fst_vt['AeroDyn15']['TIDrag'] = bool_read(f.readline().split()[0]) - self.fst_vt['AeroDyn15']['IndToler'] = float_read(f.readline().split()[0]) - self.fst_vt['AeroDyn15']['MaxIter'] = int(f.readline().split()[0]) + self.fst_vt['AeroDyn']['Skew_Mod'] = int_read(f.readline().split()[0]) + self.fst_vt['AeroDyn']['SkewMomCorr'] = bool_read(f.readline().split()[0]) + self.fst_vt['AeroDyn']['SkewRedistr_Mod'] = int_read(f.readline().split()[0]) + self.fst_vt['AeroDyn']['SkewRedistrFactor'] = float_read(f.readline().split()[0]) + f.readline() + self.fst_vt['AeroDyn']['TipLoss'] = bool_read(f.readline().split()[0]) + self.fst_vt['AeroDyn']['HubLoss'] = bool_read(f.readline().split()[0]) + self.fst_vt['AeroDyn']['TanInd'] = bool_read(f.readline().split()[0]) + self.fst_vt['AeroDyn']['AIDrag'] = bool_read(f.readline().split()[0]) + self.fst_vt['AeroDyn']['TIDrag'] = bool_read(f.readline().split()[0]) + self.fst_vt['AeroDyn']['IndToler'] = float_read(f.readline().split()[0]) + self.fst_vt['AeroDyn']['MaxIter'] = int(f.readline().split()[0]) + f.readline() + self.fst_vt['AeroDyn']['SectAvg'] = bool_read(f.readline().split()[0]) + self.fst_vt['AeroDyn']['SectAvgWeighting'] = int_read(f.readline().split()[0]) + self.fst_vt['AeroDyn']['SectAvgNPoints'] = int_read(f.readline().split()[0]) + self.fst_vt['AeroDyn']['SectAvgPsiBwd'] = float_read(f.readline().split()[0]) + self.fst_vt['AeroDyn']['SectAvgPsiFwd'] = float_read(f.readline().split()[0]) # Dynamic Blade-Element/Momentum Theory Options f.readline() - self.fst_vt['AeroDyn15']['DBEMT_Mod'] = int(f.readline().split()[0]) - self.fst_vt['AeroDyn15']['tau1_const'] = float_read(f.readline().split()[0]) + self.fst_vt['AeroDyn']['DBEMT_Mod'] = int(f.readline().split()[0]) + self.fst_vt['AeroDyn']['tau1_const'] = float_read(f.readline().split()[0]) # Olaf -- cOnvecting LAgrangian Filaments (Free Vortex Wake) Theory Options f.readline() - self.fst_vt['AeroDyn15']['OLAFInputFileName'] = f.readline().split()[0] + self.fst_vt['AeroDyn']['OLAFInputFileName'] = quoted_read(f.readline().split()[0]) - # Beddoes-Leishman Unsteady Airfoil Aerodynamics Options + # Unsteady Airfoil Aerodynamics Options f.readline() - self.fst_vt['AeroDyn15']['UAMod'] = int(f.readline().split()[0]) - self.fst_vt['AeroDyn15']['FLookup'] = bool_read(f.readline().split()[0]) + self.fst_vt['AeroDyn']['AoA34'] = bool_read(f.readline().split()[0]) + self.fst_vt['AeroDyn']['UA_Mod'] = int(f.readline().split()[0]) + self.fst_vt['AeroDyn']['FLookup'] = bool_read(f.readline().split()[0]) + self.fst_vt['AeroDyn']['IntegrationMethod'] = int(f.readline().split()[0]) file_pos = f.tell() line = f.readline() if 'UAStartRad' in line: - self.fst_vt['AeroDyn15']['UAStartRad'] = float_read(line.split()[0]) + self.fst_vt['AeroDyn']['UAStartRad'] = float_read(line.split()[0]) else: f.seek(file_pos) file_pos = f.tell() line = f.readline() if 'UAEndRad' in line: - self.fst_vt['AeroDyn15']['UAEndRad'] = float_read(line.split()[0]) + self.fst_vt['AeroDyn']['UAEndRad'] = float_read(line.split()[0]) else: f.seek(file_pos) # Airfoil Information f.readline() - self.fst_vt['AeroDyn15']['AFTabMod'] = int(f.readline().split()[0]) - self.fst_vt['AeroDyn15']['InCol_Alfa'] = int(f.readline().split()[0]) - self.fst_vt['AeroDyn15']['InCol_Cl'] = int(f.readline().split()[0]) - self.fst_vt['AeroDyn15']['InCol_Cd'] = int(f.readline().split()[0]) - self.fst_vt['AeroDyn15']['InCol_Cm'] = int(f.readline().split()[0]) - self.fst_vt['AeroDyn15']['InCol_Cpmin'] = int(f.readline().split()[0]) - self.fst_vt['AeroDyn15']['NumAFfiles'] = int(f.readline().split()[0]) - self.fst_vt['AeroDyn15']['AFNames'] = [None] * self.fst_vt['AeroDyn15']['NumAFfiles'] - for i in range(self.fst_vt['AeroDyn15']['NumAFfiles']): + self.fst_vt['AeroDyn']['AFTabMod'] = int(f.readline().split()[0]) + self.fst_vt['AeroDyn']['InCol_Alfa'] = int(f.readline().split()[0]) + self.fst_vt['AeroDyn']['InCol_Cl'] = int(f.readline().split()[0]) + self.fst_vt['AeroDyn']['InCol_Cd'] = int(f.readline().split()[0]) + self.fst_vt['AeroDyn']['InCol_Cm'] = int(f.readline().split()[0]) + self.fst_vt['AeroDyn']['InCol_Cpmin'] = int(f.readline().split()[0]) + self.fst_vt['AeroDyn']['NumAFfiles'] = int(f.readline().split()[0]) + self.fst_vt['AeroDyn']['AFNames'] = [None] * self.fst_vt['AeroDyn']['NumAFfiles'] + for i in range(self.fst_vt['AeroDyn']['NumAFfiles']): af_filename = fix_path(f.readline().split()[0])[1:-1] - self.fst_vt['AeroDyn15']['AFNames'][i] = os.path.abspath(os.path.join(self.FAST_directory, self.fst_vt['Fst']['AeroFile_path'], af_filename)) + self.fst_vt['AeroDyn']['AFNames'][i] = os.path.abspath(os.path.join(self.FAST_directory, self.fst_vt['Fst']['AeroFile_path'], af_filename)) # Rotor/Blade Properties f.readline() - self.fst_vt['AeroDyn15']['UseBlCm'] = bool_read(f.readline().split()[0]) - self.fst_vt['AeroDyn15']['ADBlFile1'] = f.readline().split()[0][1:-1] - self.fst_vt['AeroDyn15']['ADBlFile2'] = f.readline().split()[0][1:-1] - self.fst_vt['AeroDyn15']['ADBlFile3'] = f.readline().split()[0][1:-1] + self.fst_vt['AeroDyn']['UseBlCm'] = bool_read(f.readline().split()[0]) + self.fst_vt['AeroDyn']['ADBlFile1'] = quoted_read(f.readline().split()[0]) + self.fst_vt['AeroDyn']['ADBlFile2'] = quoted_read(f.readline().split()[0]) + self.fst_vt['AeroDyn']['ADBlFile3'] = quoted_read(f.readline().split()[0]) # Hub, nacelle, and tail fin aerodynamics f.readline() - self.fst_vt['AeroDyn15']['VolHub'] = float_read(f.readline().split()[0]) - self.fst_vt['AeroDyn15']['HubCenBx'] = float_read(f.readline().split()[0]) + self.fst_vt['AeroDyn']['VolHub'] = float_read(f.readline().split()[0]) + self.fst_vt['AeroDyn']['HubCenBx'] = float_read(f.readline().split()[0]) f.readline() - self.fst_vt['AeroDyn15']['VolNac'] = float_read(f.readline().split()[0]) + self.fst_vt['AeroDyn']['VolNac'] = float_read(f.readline().split()[0]) # data = [float(val) for val in f.readline().split(',')] - self.fst_vt['AeroDyn15']['NacCenB'] = [idx.strip() for idx in f.readline().split('NacCenB')[0].split(',')] + self.fst_vt['AeroDyn']['NacCenB'] = [idx.strip() for idx in f.readline().split('NacCenB')[0].split(',')] + + self.fst_vt['AeroDyn']['NacArea'] = [idx.strip() for idx in f.readline().split('NacArea')[0].split(',')] + self.fst_vt['AeroDyn']['NacCd'] = [idx.strip() for idx in f.readline().split('NacCd')[0].split(',')] + self.fst_vt['AeroDyn']['NacDragAC'] = [idx.strip() for idx in f.readline().split('NacDragAC')[0].split(',')] f.readline() - self.fst_vt['AeroDyn15']['TFinAero'] = bool_read(f.readline().split()[0]) + self.fst_vt['AeroDyn']['TFinAero'] = bool_read(f.readline().split()[0]) tfa_filename = fix_path(f.readline().split()[0])[1:-1] - self.fst_vt['AeroDyn15']['TFinFile'] = os.path.abspath(os.path.join(self.FAST_directory, tfa_filename)) + self.fst_vt['AeroDyn']['TFinFile'] = os.path.abspath(os.path.join(self.FAST_directory, tfa_filename)) # Tower Influence and Aerodynamics f.readline() - self.fst_vt['AeroDyn15']['NumTwrNds'] = int(f.readline().split()[0]) + self.fst_vt['AeroDyn']['NumTwrNds'] = int(f.readline().split()[0]) f.readline() f.readline() - self.fst_vt['AeroDyn15']['TwrElev'] = [None]*self.fst_vt['AeroDyn15']['NumTwrNds'] - self.fst_vt['AeroDyn15']['TwrDiam'] = [None]*self.fst_vt['AeroDyn15']['NumTwrNds'] - self.fst_vt['AeroDyn15']['TwrCd'] = [None]*self.fst_vt['AeroDyn15']['NumTwrNds'] - self.fst_vt['AeroDyn15']['TwrTI'] = [None]*self.fst_vt['AeroDyn15']['NumTwrNds'] - self.fst_vt['AeroDyn15']['TwrCb'] = [None]*self.fst_vt['AeroDyn15']['NumTwrNds'] - for i in range(self.fst_vt['AeroDyn15']['NumTwrNds']): + self.fst_vt['AeroDyn']['TwrElev'] = [None]*self.fst_vt['AeroDyn']['NumTwrNds'] + self.fst_vt['AeroDyn']['TwrDiam'] = [None]*self.fst_vt['AeroDyn']['NumTwrNds'] + self.fst_vt['AeroDyn']['TwrCd'] = [None]*self.fst_vt['AeroDyn']['NumTwrNds'] + self.fst_vt['AeroDyn']['TwrTI'] = [None]*self.fst_vt['AeroDyn']['NumTwrNds'] + self.fst_vt['AeroDyn']['TwrCb'] = [None]*self.fst_vt['AeroDyn']['NumTwrNds'] + for i in range(self.fst_vt['AeroDyn']['NumTwrNds']): data = [float(val) for val in f.readline().split()] - self.fst_vt['AeroDyn15']['TwrElev'][i] = data[0] - self.fst_vt['AeroDyn15']['TwrDiam'][i] = data[1] - self.fst_vt['AeroDyn15']['TwrCd'][i] = data[2] - self.fst_vt['AeroDyn15']['TwrTI'][i] = data[3] - self.fst_vt['AeroDyn15']['TwrCb'][i] = data[4] + self.fst_vt['AeroDyn']['TwrElev'][i] = data[0] + self.fst_vt['AeroDyn']['TwrDiam'][i] = data[1] + self.fst_vt['AeroDyn']['TwrCd'][i] = data[2] + self.fst_vt['AeroDyn']['TwrTI'][i] = data[3] + self.fst_vt['AeroDyn']['TwrCb'][i] = data[4] # Outputs f.readline() - self.fst_vt['AeroDyn15']['SumPrint'] = bool_read(f.readline().split()[0]) - self.fst_vt['AeroDyn15']['NBlOuts'] = int(f.readline().split()[0]) - self.fst_vt['AeroDyn15']['BlOutNd'] = [idx.strip() for idx in f.readline().split('BlOutNd')[0].split(',')] - self.fst_vt['AeroDyn15']['NTwOuts'] = int(f.readline().split()[0]) - self.fst_vt['AeroDyn15']['TwOutNd'] = [idx.strip() for idx in f.readline().split('TwOutNd')[0].split(',')] + self.fst_vt['AeroDyn']['SumPrint'] = bool_read(f.readline().split()[0]) + self.fst_vt['AeroDyn']['NBlOuts'] = int(f.readline().split()[0]) + self.fst_vt['AeroDyn']['BlOutNd'] = [idx.strip() for idx in f.readline().split('BlOutNd')[0].split(',')] + self.fst_vt['AeroDyn']['NTwOuts'] = int(f.readline().split()[0]) + self.fst_vt['AeroDyn']['TwOutNd'] = [idx.strip() for idx in f.readline().split('TwOutNd')[0].split(',')] - # AeroDyn15 Outlist + # AeroDyn Outlist f.readline() data = f.readline() + + # Handle the case if there are blank lines before the END statement, check if blank line + while data.split().__len__() == 0: + data = f.readline() + + while data.split()[0] != 'END': if data.find('"')>=0: channels = data.split('"') @@ -956,11 +1195,11 @@ def read_AeroDyn15(self): self.set_outlist(self.fst_vt['outlist']['AeroDyn'], channel_list) data = f.readline() - # AeroDyn15 optional outlist + # AeroDyn optional outlist try: f.readline() - self.fst_vt['AeroDyn15']['BldNd_BladesOut'] = int(f.readline().split()[0]) - self.fst_vt['AeroDyn15']['BldNd_BlOutNd'] = f.readline().split()[0] + self.fst_vt['AeroDyn']['BldNd_BladesOut'] = int(f.readline().split()[0]) + self.fst_vt['AeroDyn']['BldNd_BlOutNd'] = f.readline().split()[0] f.readline() data = f.readline() @@ -982,17 +1221,17 @@ def read_AeroDyn15(self): f.close() - self.read_AeroDyn15Blade() - self.read_AeroDyn15Polar() - self.read_AeroDyn15Coord() - olaf_filename = os.path.join(self.FAST_directory, self.fst_vt['AeroDyn15']['OLAFInputFileName']) + self.read_AeroDynBlade() + self.read_AeroDynPolar() + self.read_AeroDynCoord() + olaf_filename = os.path.join(self.FAST_directory, self.fst_vt['AeroDyn']['OLAFInputFileName']) if os.path.isfile(olaf_filename): - self.read_AeroDyn15OLAF(olaf_filename) + self.read_AeroDynOLAF(olaf_filename) - def read_AeroDyn15Blade(self): + def read_AeroDynBlade(self): # AeroDyn v5.00 Blade Definition File - ad_blade_file = os.path.join(self.FAST_directory, self.fst_vt['Fst']['AeroFile_path'], self.fst_vt['AeroDyn15']['ADBlFile1']) + ad_blade_file = os.path.join(self.FAST_directory, self.fst_vt['Fst']['AeroFile_path'], self.fst_vt['AeroDyn']['ADBlFile1']) f = open(ad_blade_file) f.readline() @@ -1009,6 +1248,9 @@ def read_AeroDyn15Blade(self): self.fst_vt['AeroDynBlade']['BlTwist'] = [None]*self.fst_vt['AeroDynBlade']['NumBlNds'] self.fst_vt['AeroDynBlade']['BlChord'] = [None]*self.fst_vt['AeroDynBlade']['NumBlNds'] self.fst_vt['AeroDynBlade']['BlAFID'] = [None]*self.fst_vt['AeroDynBlade']['NumBlNds'] + self.fst_vt['AeroDynBlade']['BlCb'] = [None]*self.fst_vt['AeroDynBlade']['NumBlNds'] + self.fst_vt['AeroDynBlade']['BlCenBn'] = [None]*self.fst_vt['AeroDynBlade']['NumBlNds'] + self.fst_vt['AeroDynBlade']['BlCenBt'] = [None]*self.fst_vt['AeroDynBlade']['NumBlNds'] for i in range(self.fst_vt['AeroDynBlade']['NumBlNds']): data = [float(val) for val in f.readline().split()] self.fst_vt['AeroDynBlade']['BlSpn'][i] = data[0] @@ -1018,31 +1260,46 @@ def read_AeroDyn15Blade(self): self.fst_vt['AeroDynBlade']['BlTwist'][i] = data[4] self.fst_vt['AeroDynBlade']['BlChord'][i] = data[5] self.fst_vt['AeroDynBlade']['BlAFID'][i] = data[6] + if len(data) == 9: + self.fst_vt['AeroDynBlade']['BlCb'][i] = data[7] + self.fst_vt['AeroDynBlade']['BlCenBn'][i] = data[8] + self.fst_vt['AeroDynBlade']['BlCenBt'][i] = data[9] + else: + self.fst_vt['AeroDynBlade']['BlCb'][i] = 0.0 + self.fst_vt['AeroDynBlade']['BlCenBn'][i] = 0.0 + self.fst_vt['AeroDynBlade']['BlCenBt'][i] = 0.0 + f.close() - def read_AeroDyn15Polar(self): + def read_AeroDynPolar(self): # AirfoilInfo v1.01 - self.fst_vt['AeroDyn15']['af_data'] = [None]*self.fst_vt['AeroDyn15']['NumAFfiles'] + self.fst_vt['AeroDyn']['af_data'] = [None]*self.fst_vt['AeroDyn']['NumAFfiles'] - for afi, af_filename in enumerate(self.fst_vt['AeroDyn15']['AFNames']): + for afi, af_filename in enumerate(self.fst_vt['AeroDyn']['AFNames']): f = open(af_filename) # print af_filename polar = {} polar['InterpOrd'] = int_read(readline_filterComments(f).split()[0]) - polar['NonDimArea'] = float_read(readline_filterComments(f).split()[0]) + temp = readline_filterComments(f).split() + if temp[1] == "RelThickness": + polar['RelThickness'] = float_read(temp[0]) + polar['NonDimArea'] = float_read(readline_filterComments(f).split()[0]) + else: + polar['NonDimArea'] = float_read(temp[0]) + # polar['NonDimArea'] = float_read(readline_filterComments(f).split()[0]) polar['NumCoords'] = readline_filterComments(f).split()[0] polar['BL_file'] = readline_filterComments(f).split()[0] polar['NumTabs'] = int_read(readline_filterComments(f).split()[0]) - self.fst_vt['AeroDyn15']['af_data'][afi] = [None]*polar['NumTabs'] + self.fst_vt['AeroDyn']['af_data'][afi] = [None]*polar['NumTabs'] for tab in range(polar['NumTabs']): # For multiple tables polar['Re'] = float_read(readline_filterComments(f).split()[0]) * 1.e+6 - polar['Ctrl'] = int_read(readline_filterComments(f).split()[0]) + polar['UserProp'] = int_read(readline_filterComments(f).split()[0]) polar['InclUAdata'] = bool_read(readline_filterComments(f).split()[0]) # Unsteady Aero Data @@ -1091,271 +1348,153 @@ def read_AeroDyn15Polar(self): polar['Cpmin'] = [None]*polar['NumAlf'] for i in range(polar['NumAlf']): data = [float(val) for val in readline_filterComments(f).split()] - if self.fst_vt['AeroDyn15']['InCol_Alfa'] > 0: - polar['Alpha'][i] = data[self.fst_vt['AeroDyn15']['InCol_Alfa']-1] - if self.fst_vt['AeroDyn15']['InCol_Cl'] > 0: - polar['Cl'][i] = data[self.fst_vt['AeroDyn15']['InCol_Cl']-1] - if self.fst_vt['AeroDyn15']['InCol_Cd'] > 0: - polar['Cd'][i] = data[self.fst_vt['AeroDyn15']['InCol_Cd']-1] - if self.fst_vt['AeroDyn15']['InCol_Cm'] > 0: - polar['Cm'][i] = data[self.fst_vt['AeroDyn15']['InCol_Cm']-1] - if self.fst_vt['AeroDyn15']['InCol_Cpmin'] > 0: - polar['Cpmin'][i] = data[self.fst_vt['AeroDyn15']['InCol_Cpmin']-1] - - self.fst_vt['AeroDyn15']['af_data'][afi][tab] = copy.copy(polar) # For multiple tables + if self.fst_vt['AeroDyn']['InCol_Alfa'] > 0: + polar['Alpha'][i] = data[self.fst_vt['AeroDyn']['InCol_Alfa']-1] + if self.fst_vt['AeroDyn']['InCol_Cl'] > 0: + polar['Cl'][i] = data[self.fst_vt['AeroDyn']['InCol_Cl']-1] + if self.fst_vt['AeroDyn']['InCol_Cd'] > 0: + polar['Cd'][i] = data[self.fst_vt['AeroDyn']['InCol_Cd']-1] + if self.fst_vt['AeroDyn']['InCol_Cm'] > 0: + polar['Cm'][i] = data[self.fst_vt['AeroDyn']['InCol_Cm']-1] + if self.fst_vt['AeroDyn']['InCol_Cpmin'] > 0: + polar['Cpmin'][i] = data[self.fst_vt['AeroDyn']['InCol_Cpmin']-1] + + self.fst_vt['AeroDyn']['af_data'][afi][tab] = copy.copy(polar) # For multiple tables f.close() - def read_AeroDyn15Coord(self): + def read_AeroDynCoord(self): - self.fst_vt['AeroDyn15']['af_coord'] = [] - self.fst_vt['AeroDyn15']['ac'] = np.zeros(len(self.fst_vt['AeroDyn15']['AFNames'])) + self.fst_vt['AeroDyn']['af_coord'] = [] + self.fst_vt['AeroDyn']['ac'] = np.zeros(len(self.fst_vt['AeroDyn']['AFNames'])) + + for afi, af_filename in enumerate(self.fst_vt['AeroDyn']['AFNames']): + self.fst_vt['AeroDyn']['af_coord'].append({}) + if not (self.fst_vt['AeroDyn']['af_data'][afi][0]['NumCoords'] == 0 or self.fst_vt['AeroDyn']['af_data'][afi][0]['NumCoords'] == '0'): + coord_filename = af_filename[0:af_filename.rfind(os.sep)] + os.sep + self.fst_vt['AeroDyn']['af_data'][afi][0]['NumCoords'][2:-1] - for afi, af_filename in enumerate(self.fst_vt['AeroDyn15']['AFNames']): - self.fst_vt['AeroDyn15']['af_coord'].append({}) - if not (self.fst_vt['AeroDyn15']['af_data'][afi][0]['NumCoords'] == 0 or self.fst_vt['AeroDyn15']['af_data'][afi][0]['NumCoords'] == '0'): - coord_filename = af_filename[0:af_filename.rfind(os.sep)] + os.sep + self.fst_vt['AeroDyn15']['af_data'][afi][0]['NumCoords'][2:-1] f = open(coord_filename) - n_coords = int_read(readline_filterComments(f).split()[0]) - x = np.zeros(n_coords) - y = np.zeros(n_coords) - f.readline() - f.readline() - f.readline() - self.fst_vt['AeroDyn15']['ac'][afi] = float(f.readline().split()[0]) - f.readline() - f.readline() - f.readline() - for j in range(n_coords - 1): - x[j], y[j] = f.readline().split() + lines = f.readlines() + f.close() + lines = [line for line in lines if not line.strip().startswith('!')] + n_coords = int(lines[0].split()[0]) - self.fst_vt['AeroDyn15']['af_coord'][afi]['x'] = x - self.fst_vt['AeroDyn15']['af_coord'][afi]['y'] = y + x = np.zeros(n_coords-1) + y = np.zeros(n_coords-1) + + self.fst_vt['AeroDyn']['ac'][afi] = float(lines[1].split()[0]) + + for j in range(2, n_coords+1): + x[j - 2], y[j - 2] = map(float, lines[j].split()) + + self.fst_vt['AeroDyn']['af_coord'][afi]['x'] = x + self.fst_vt['AeroDyn']['af_coord'][afi]['y'] = y - f.close() - def read_AeroDyn15OLAF(self, olaf_filename): + def read_AeroDynOLAF(self, olaf_filename): - self.fst_vt['AeroDyn15']['OLAF'] = {} + self.fst_vt['AeroDyn']['OLAF'] = {} f = open(olaf_filename) f.readline() f.readline() f.readline() - self.fst_vt['AeroDyn15']['OLAF']['IntMethod'] = int_read(f.readline().split()[0]) - self.fst_vt['AeroDyn15']['OLAF']['DTfvw'] = float_read(f.readline().split()[0]) - self.fst_vt['AeroDyn15']['OLAF']['FreeWakeStart'] = float_read(f.readline().split()[0]) - self.fst_vt['AeroDyn15']['OLAF']['FullCircStart'] = float_read(f.readline().split()[0]) + self.fst_vt['AeroDyn']['OLAF']['IntMethod'] = int_read(f.readline().split()[0]) + self.fst_vt['AeroDyn']['OLAF']['DTfvw'] = float_read(f.readline().split()[0]) + self.fst_vt['AeroDyn']['OLAF']['FreeWakeStart'] = float_read(f.readline().split()[0]) + self.fst_vt['AeroDyn']['OLAF']['FullCircStart'] = float_read(f.readline().split()[0]) f.readline() - self.fst_vt['AeroDyn15']['OLAF']['CircSolvMethod'] = int_read(f.readline().split()[0]) - self.fst_vt['AeroDyn15']['OLAF']['CircSolvConvCrit'] = float_read(f.readline().split()[0]) - self.fst_vt['AeroDyn15']['OLAF']['CircSolvRelaxation'] = float_read(f.readline().split()[0]) - self.fst_vt['AeroDyn15']['OLAF']['CircSolvMaxIter'] = int_read(f.readline().split()[0]) - self.fst_vt['AeroDyn15']['OLAF']['PrescribedCircFile'] = f.readline().split()[0] + self.fst_vt['AeroDyn']['OLAF']['CircSolvMethod'] = int_read(f.readline().split()[0]) + self.fst_vt['AeroDyn']['OLAF']['CircSolvConvCrit'] = float_read(f.readline().split()[0]) + self.fst_vt['AeroDyn']['OLAF']['CircSolvRelaxation'] = float_read(f.readline().split()[0]) + self.fst_vt['AeroDyn']['OLAF']['CircSolvMaxIter'] = int_read(f.readline().split()[0]) + self.fst_vt['AeroDyn']['OLAF']['PrescribedCircFile'] = os.path.join(self.FAST_directory, quoted_read(f.readline().split()[0])) # unmodified by this script, hence pointing to absolute location f.readline() f.readline() f.readline() - self.fst_vt['AeroDyn15']['OLAF']['nNWPanels'] = int_read(f.readline().split()[0]) - self.fst_vt['AeroDyn15']['OLAF']['nNWPanelsFree'] = int_read(f.readline().split()[0]) - self.fst_vt['AeroDyn15']['OLAF']['nFWPanels'] = int_read(f.readline().split()[0]) - self.fst_vt['AeroDyn15']['OLAF']['nFWPanelsFree'] = int_read(f.readline().split()[0]) - self.fst_vt['AeroDyn15']['OLAF']['FWShedVorticity'] = bool_read(f.readline().split()[0]) + self.fst_vt['AeroDyn']['OLAF']['nNWPanels'] = int_read(f.readline().split()[0]) + self.fst_vt['AeroDyn']['OLAF']['nNWPanelsFree'] = int_read(f.readline().split()[0]) + self.fst_vt['AeroDyn']['OLAF']['nFWPanels'] = int_read(f.readline().split()[0]) + self.fst_vt['AeroDyn']['OLAF']['nFWPanelsFree'] = int_read(f.readline().split()[0]) + self.fst_vt['AeroDyn']['OLAF']['FWShedVorticity'] = bool_read(f.readline().split()[0]) f.readline() - self.fst_vt['AeroDyn15']['OLAF']['DiffusionMethod'] = int_read(f.readline().split()[0]) - self.fst_vt['AeroDyn15']['OLAF']['RegDeterMethod'] = int_read(f.readline().split()[0]) - self.fst_vt['AeroDyn15']['OLAF']['RegFunction'] = int_read(f.readline().split()[0]) - self.fst_vt['AeroDyn15']['OLAF']['WakeRegMethod'] = int_read(f.readline().split()[0]) - self.fst_vt['AeroDyn15']['OLAF']['WakeRegFactor'] = float(f.readline().split()[0]) - self.fst_vt['AeroDyn15']['OLAF']['WingRegFactor'] = float(f.readline().split()[0]) - self.fst_vt['AeroDyn15']['OLAF']['CoreSpreadEddyVisc'] = int(f.readline().split()[0]) + self.fst_vt['AeroDyn']['OLAF']['DiffusionMethod'] = int_read(f.readline().split()[0]) + self.fst_vt['AeroDyn']['OLAF']['RegDeterMethod'] = int_read(f.readline().split()[0]) + self.fst_vt['AeroDyn']['OLAF']['RegFunction'] = int_read(f.readline().split()[0]) + self.fst_vt['AeroDyn']['OLAF']['WakeRegMethod'] = int_read(f.readline().split()[0]) + self.fst_vt['AeroDyn']['OLAF']['WakeRegFactor'] = float(f.readline().split()[0]) + self.fst_vt['AeroDyn']['OLAF']['WingRegFactor'] = float(f.readline().split()[0]) + self.fst_vt['AeroDyn']['OLAF']['CoreSpreadEddyVisc'] = int(f.readline().split()[0]) f.readline() - self.fst_vt['AeroDyn15']['OLAF']['TwrShadowOnWake'] = bool_read(f.readline().split()[0]) - self.fst_vt['AeroDyn15']['OLAF']['ShearModel'] = int_read(f.readline().split()[0]) + self.fst_vt['AeroDyn']['OLAF']['TwrShadowOnWake'] = bool_read(f.readline().split()[0]) + self.fst_vt['AeroDyn']['OLAF']['ShearModel'] = int_read(f.readline().split()[0]) f.readline() - self.fst_vt['AeroDyn15']['OLAF']['VelocityMethod'] = int_read(f.readline().split()[0]) - self.fst_vt['AeroDyn15']['OLAF']['TreeBranchFactor']= float_read(f.readline().split()[0]) - self.fst_vt['AeroDyn15']['OLAF']['PartPerSegment'] = int_read(f.readline().split()[0]) + self.fst_vt['AeroDyn']['OLAF']['VelocityMethod'] = int_read(f.readline().split()[0]) + self.fst_vt['AeroDyn']['OLAF']['TreeBranchFactor']= float_read(f.readline().split()[0]) + self.fst_vt['AeroDyn']['OLAF']['PartPerSegment'] = int_read(f.readline().split()[0]) f.readline() f.readline() - self.fst_vt['AeroDyn15']['OLAF']['WrVTk'] = int_read(f.readline().split()[0]) - self.fst_vt['AeroDyn15']['OLAF']['nVTKBlades'] = int_read(f.readline().split()[0]) - self.fst_vt['AeroDyn15']['OLAF']['VTKCoord'] = int_read(f.readline().split()[0]) - self.fst_vt['AeroDyn15']['OLAF']['VTK_fps'] = float_read(f.readline().split()[0]) - self.fst_vt['AeroDyn15']['OLAF']['nGridOut'] = int_read(f.readline().split()[0]) + self.fst_vt['AeroDyn']['OLAF']['WrVTk'] = int_read(f.readline().split()[0]) + self.fst_vt['AeroDyn']['OLAF']['nVTKBlades'] = int_read(f.readline().split()[0]) + self.fst_vt['AeroDyn']['OLAF']['VTKCoord'] = int_read(f.readline().split()[0]) + self.fst_vt['AeroDyn']['OLAF']['VTK_fps'] = float_read(f.readline().split()[0]) + self.fst_vt['AeroDyn']['OLAF']['nGridOut'] = int_read(f.readline().split()[0]) f.readline() f.close() - def read_AeroDyn14(self): - # AeroDyn v14.04 - - ad_file = os.path.join(self.FAST_directory, self.fst_vt['Fst']['AeroFile']) - f = open(ad_file) - # AeroDyn file header (aerodyn) - f.readline() - f.readline() - self.fst_vt['AeroDyn14']['StallMod'] = f.readline().split()[0] - self.fst_vt['AeroDyn14']['UseCm'] = f.readline().split()[0] - self.fst_vt['AeroDyn14']['InfModel'] = f.readline().split()[0] - self.fst_vt['AeroDyn14']['IndModel'] = f.readline().split()[0] - self.fst_vt['AeroDyn14']['AToler'] = float_read(f.readline().split()[0]) - self.fst_vt['AeroDyn14']['TLModel'] = f.readline().split()[0] - self.fst_vt['AeroDyn14']['HLModel'] = f.readline().split()[0] - self.fst_vt['AeroDyn14']['TwrShad'] = int(f.readline().split()[0]) - if self.fst_vt['AeroDyn14']['TwrShad'] > 0: - self.fst_vt['AeroDyn14']['TwrPotent'] = bool_read(f.readline().split()[0]) - self.fst_vt['AeroDyn14']['TwrShadow'] = bool_read(f.readline().split()[0]) - self.fst_vt['AeroDyn14']['TwrFile'] = f.readline().split()[0].replace('"','').replace("'",'') - self.fst_vt['AeroDyn14']['CalcTwrAero'] = bool_read(f.readline().split()[0]) - else: - self.fst_vt['AeroDyn14']['ShadHWid'] = float_read(f.readline().split()[0]) - self.fst_vt['AeroDyn14']['T_Shad_Refpt'] = float_read(f.readline().split()[0]) - self.fst_vt['AeroDyn14']['AirDens'] = float_read(f.readline().split()[0]) - self.fst_vt['AeroDyn14']['KinVisc'] = float_read(f.readline().split()[0]) - self.fst_vt['AeroDyn14']['DTAero'] = float_read(f.readline().split()[0]) - - # AeroDyn Blade Properties (blade_aero) - self.fst_vt['AeroDyn14']['NumFoil'] = int(f.readline().split()[0]) - self.fst_vt['AeroDyn14']['FoilNm'] = [None] * self.fst_vt['AeroDyn14']['NumFoil'] - for i in range(self.fst_vt['AeroDyn14']['NumFoil']): - af_filename = f.readline().split()[0] - af_filename = fix_path(af_filename) - self.fst_vt['AeroDyn14']['FoilNm'][i] = af_filename[1:-1] - - self.fst_vt['AeroDynBlade']['BldNodes'] = int(f.readline().split()[0]) - f.readline() - self.fst_vt['AeroDynBlade']['RNodes'] = [None] * self.fst_vt['AeroDynBlade']['BldNodes'] - self.fst_vt['AeroDynBlade']['AeroTwst'] = [None] * self.fst_vt['AeroDynBlade']['BldNodes'] - self.fst_vt['AeroDynBlade']['DRNodes'] = [None] * self.fst_vt['AeroDynBlade']['BldNodes'] - self.fst_vt['AeroDynBlade']['Chord'] = [None] * self.fst_vt['AeroDynBlade']['BldNodes'] - self.fst_vt['AeroDynBlade']['NFoil'] = [None] * self.fst_vt['AeroDynBlade']['BldNodes'] - self.fst_vt['AeroDynBlade']['PrnElm'] = [None] * self.fst_vt['AeroDynBlade']['BldNodes'] - for i in range(self.fst_vt['AeroDynBlade']['BldNodes']): - data = f.readline().split() - self.fst_vt['AeroDynBlade']['RNodes'][i] = float_read(data[0]) - self.fst_vt['AeroDynBlade']['AeroTwst'][i] = float_read(data[1]) - self.fst_vt['AeroDynBlade']['DRNodes'][i] = float_read(data[2]) - self.fst_vt['AeroDynBlade']['Chord'][i] = float_read(data[3]) - self.fst_vt['AeroDynBlade']['NFoil'][i] = int(data[4]) - self.fst_vt['AeroDynBlade']['PrnElm'][i] = data[5] - - f.close() - - # create airfoil objects - self.fst_vt['AeroDynBlade']['af_data'] = [] - for i in range(self.fst_vt['AeroDyn14']['NumFoil']): - self.fst_vt['AeroDynBlade']['af_data'].append(self.read_AeroDyn14Polar(os.path.join(self.FAST_directory,self.fst_vt['AeroDyn14']['FoilNm'][i]))) - - # tower - if self.fst_vt['AeroDyn14']['TwrShad'] > 0: - self.read_AeroDyn14Tower() - - def read_AeroDyn14Tower(self): - # AeroDyn v14.04 Tower - - ad_tower_file = os.path.join(self.FAST_directory, self.fst_vt['AeroDyn14']['TwrFile']) - f = open(ad_tower_file) + def read_AeroDisk(self): + '''' + Reading the AeroDisk input file. + ''' + aDisk_file = os.path.join(self.FAST_directory, self.fst_vt['Fst']['AeroFile']) + f = open(aDisk_file) f.readline() - f.readline() - self.fst_vt['AeroDynTower']['NTwrHt'] = int(f.readline().split()[0]) - self.fst_vt['AeroDynTower']['NTwrRe'] = int(f.readline().split()[0]) - self.fst_vt['AeroDynTower']['NTwrCD'] = int(f.readline().split()[0]) - self.fst_vt['AeroDynTower']['Tower_Wake_Constant'] = float_read(f.readline().split()[0]) - f.readline() f.readline() - self.fst_vt['AeroDynTower']['TwrHtFr'] = [None]*self.fst_vt['AeroDynTower']['NTwrHt'] - self.fst_vt['AeroDynTower']['TwrWid'] = [None]*self.fst_vt['AeroDynTower']['NTwrHt'] - self.fst_vt['AeroDynTower']['NTwrCDCol'] = [None]*self.fst_vt['AeroDynTower']['NTwrHt'] - for i in range(self.fst_vt['AeroDynTower']['NTwrHt']): - data = [float(val) for val in f.readline().split()] - self.fst_vt['AeroDynTower']['TwrHtFr'][i] = data[0] - self.fst_vt['AeroDynTower']['TwrWid'][i] = data[1] - self.fst_vt['AeroDynTower']['NTwrCDCol'][i] = data[2] - f.readline() - f.readline() - self.fst_vt['AeroDynTower']['TwrRe'] = [None]*self.fst_vt['AeroDynTower']['NTwrRe'] - self.fst_vt['AeroDynTower']['TwrCD'] = np.zeros((self.fst_vt['AeroDynTower']['NTwrRe'], self.fst_vt['AeroDynTower']['NTwrCD'])) - for i in range(self.fst_vt['AeroDynTower']['NTwrRe']): - data = [float(val) for val in f.readline().split()] - self.fst_vt['AeroDynTower']['TwrRe'][i] = data[0] - self.fst_vt['AeroDynTower']['TwrCD'][i,:] = data[1:] + # Simulation Control + self.fst_vt['AeroDisk']['Echo'] = bool_read(f.readline().split()[0]) + self.fst_vt['AeroDisk']['DT'] = float_read(f.readline().split()[0]) - f.close() + # Environmental Conditions + f.readline() + self.fst_vt['AeroDisk']['AirDens'] = float_read(f.readline().split()[0]) - def read_AeroDyn14Polar(self, aerodynFile): - # AeroDyn v14 Airfoil Polar Input File + # Actuator Disk Properties + f.readline() + self.fst_vt['AeroDisk']['RotorRad'] = float_read(f.readline().split()[0]) + + # read InColNames - Input column headers (string) {may include a combination of "TSR, RtSpd, VRel, Pitch, Skew"} (up to 4 columns) + # Read between the quotes + self.fst_vt['AeroDisk']['InColNames'] = [x.strip() for x in quoted_read(f.readline().split('InColNames')[0]).split(',')] - # open aerodyn file - f = open(aerodynFile, 'r') - - airfoil = copy.copy(self.fst_vt['AeroDynPolar']) + # read InColDims - Number of unique values in each column (-) (must have same number of columns as InColName) [each >=2] + self.fst_vt['AeroDisk']['InColDims'] = [int(x) for x in f.readline().split('InColDims')[0].split(',')] - # skip through header - airfoil['description'] = f.readline().rstrip() # remove newline - f.readline() - airfoil['number_tables'] = int(f.readline().split()[0]) + # read the contents table of the CSV file referenced next + # if the next line starts with an @, then it is a file reference + line = f.readline() + if line[0] == '@': + self.fst_vt['AeroDisk']['actuatorDiskFile'] = os.path.join(self.FAST_directory, line[1:].strip()) + + # using the load_ascii_output function to read the CSV file, ;) + data, info = load_ascii_output(self.fst_vt['AeroDisk']['actuatorDiskFile'], headerLines=3, + descriptionLine=0, attributeLine=1, unitLine=2, delimiter = ',') + self.fst_vt['AeroDisk']['actuatorDiskTable'] = {'dsc': info['description'], + 'attr': info['attribute_names'], + 'units': info['attribute_units'], + 'data': data} + else: + raise Exception('Expecting a file reference to the actuator disk CSV file') - IDParam = [float_read(val) for val in f.readline().split()[0:airfoil['number_tables']]] - StallAngle = [float_read(val) for val in f.readline().split()[0:airfoil['number_tables']]] - f.readline() + # read the output list f.readline() f.readline() - ZeroCn = [float_read(val) for val in f.readline().split()[0:airfoil['number_tables']]] - CnSlope = [float_read(val) for val in f.readline().split()[0:airfoil['number_tables']]] - CnPosStall = [float_read(val) for val in f.readline().split()[0:airfoil['number_tables']]] - CnNegStall = [float_read(val) for val in f.readline().split()[0:airfoil['number_tables']]] - alphaCdMin = [float_read(val) for val in f.readline().split()[0:airfoil['number_tables']]] - CdMin = [float_read(val) for val in f.readline().split()[0:airfoil['number_tables']]] - data = [] - airfoil['af_tables'] = [] - while True: - line = f.readline() - if 'EOT' in line: - break - line = [float_read(s) for s in line.split()] - if len(line) < 1: - break - data.append(line) - - # loop through tables - for i in range(airfoil['number_tables']): - polar = {} - polar['IDParam'] = IDParam[i] - polar['StallAngle'] = StallAngle[i] - polar['ZeroCn'] = ZeroCn[i] - polar['CnSlope'] = CnSlope[i] - polar['CnPosStall'] = CnPosStall[i] - polar['CnNegStall'] = CnNegStall[i] - polar['alphaCdMin'] = alphaCdMin[i] - polar['CdMin'] = CdMin[i] - - alpha = [] - cl = [] - cd = [] - cm = [] - # read polar information line by line - for datai in data: - if len(datai) == airfoil['number_tables']*3+1: - alpha.append(datai[0]) - cl.append(datai[1 + 3*i]) - cd.append(datai[2 + 3*i]) - cm.append(datai[3 + 3*i]) - elif len(datai) == airfoil['number_tables']*2+1: - alpha.append(datai[0]) - cl.append(datai[1 + 2*i]) - cd.append(datai[2 + 2*i]) - - polar['alpha'] = alpha - polar['cl'] = cl - polar['cd'] = cd - polar['cm'] = cm - airfoil['af_tables'].append(polar) + self.read_outlist(f,'AeroDisk') f.close() - return airfoil def read_ServoDyn(self): # ServoDyn v1.05 Input File @@ -1451,13 +1590,13 @@ def read_ServoDyn(self): # Structural Control f.readline() self.fst_vt['ServoDyn']['NumBStC'] = int(f.readline().split()[0]) - self.fst_vt['ServoDyn']['BStCfiles'] = read_array(f,self.fst_vt['ServoDyn']['NumBStC'],str) + self.fst_vt['ServoDyn']['BStCfiles'] = read_array(f,self.fst_vt['ServoDyn']['NumBStC'], array_type=str) self.fst_vt['ServoDyn']['NumNStC'] = int(f.readline().split()[0]) - self.fst_vt['ServoDyn']['NStCfiles'] = read_array(f,self.fst_vt['ServoDyn']['NumNStC'],str) + self.fst_vt['ServoDyn']['NStCfiles'] = read_array(f,self.fst_vt['ServoDyn']['NumNStC'], array_type=str) self.fst_vt['ServoDyn']['NumTStC'] = int(f.readline().split()[0]) - self.fst_vt['ServoDyn']['TStCfiles'] = read_array(f,self.fst_vt['ServoDyn']['NumTStC'],str) + self.fst_vt['ServoDyn']['TStCfiles'] = read_array(f,self.fst_vt['ServoDyn']['NumTStC'], array_type=str) self.fst_vt['ServoDyn']['NumSStC'] = int(f.readline().split()[0]) - self.fst_vt['ServoDyn']['SStCfiles'] = read_array(f,self.fst_vt['ServoDyn']['NumSStC'],str) + self.fst_vt['ServoDyn']['SStCfiles'] = read_array(f,self.fst_vt['ServoDyn']['NumSStC'], array_type=str) # Initialize Struct Control trees self.fst_vt['BStC'] = [] * self.fst_vt['ServoDyn']['NumBStC'] @@ -1472,12 +1611,12 @@ def read_ServoDyn(self): # Bladed Interface and Torque-Speed Look-Up Table (bladed_interface) f.readline() if self.path2dll == '' or self.path2dll == None: - self.fst_vt['ServoDyn']['DLL_FileName'] = os.path.abspath(os.path.normpath(os.path.join(os.path.split(sd_file)[0], f.readline().split()[0][1:-1]))) + self.fst_vt['ServoDyn']['DLL_FileName'] = os.path.abspath(os.path.normpath(os.path.join(os.path.split(sd_file)[0], quoted_read(f.readline().split()[0])))) else: f.readline() self.fst_vt['ServoDyn']['DLL_FileName'] = self.path2dll - self.fst_vt['ServoDyn']['DLL_InFile'] = os.path.abspath(os.path.normpath(os.path.join(os.path.split(sd_file)[0], f.readline().split()[0][1:-1]))) - self.fst_vt['ServoDyn']['DLL_ProcName'] = f.readline().split()[0][1:-1] + self.fst_vt['ServoDyn']['DLL_InFile'] = os.path.abspath(os.path.normpath(os.path.join(os.path.split(sd_file)[0], quoted_read(f.readline().split()[0])))) + self.fst_vt['ServoDyn']['DLL_ProcName'] = quoted_read(f.readline().split()[0]) dll_dt_line = f.readline().split()[0] try: self.fst_vt['ServoDyn']['DLL_DT'] = float_read(dll_dt_line) @@ -1516,7 +1655,7 @@ def read_ServoDyn(self): self.fst_vt['ServoDyn']['SumPrint'] = bool_read(f.readline().split()[0]) self.fst_vt['ServoDyn']['OutFile'] = int(f.readline().split()[0]) self.fst_vt['ServoDyn']['TabDelim'] = bool_read(f.readline().split()[0]) - self.fst_vt['ServoDyn']['OutFmt'] = f.readline().split()[0][1:-1] + self.fst_vt['ServoDyn']['OutFmt'] = quoted_read(f.readline().split()[0]) self.fst_vt['ServoDyn']['TStart'] = float_read(f.readline().split()[0]) # ServoDyn Outlist @@ -1557,8 +1696,8 @@ def read_StC(self,filename): StC_vt['StC_Z_DSP'] = float_read(f.readline().split()[0]) # 0 StC_Z_DSP - StC Z initial displacement (m) [relative to at rest position; used only when StC_DOF_MODE=1 and StC_Z_DOF=TRUE] StC_vt['StC_Z_PreLd'] = f.readline().split()[0] # "none" StC_Z_PreLd - StC Z prefloat_read(f.readline().split()[0]) #-load (N) {"gravity" to offset for gravity load; "none" or 0 to turn off} [used only when StC_DOF_MODE=1 and StC_Z_DOF=TRUE] f.readline() # StC CONFIGURATION - StC_vt['StC_X_NSP'] = float_read(f.readline().split()[0]) # 0 StC_X_NSP - Negative stop position (minimum X mass displacement) (m) - StC_vt['StC_X_PSP'] = float_read(f.readline().split()[0]) # 0 StC_X_PSP - Positive stop position (maximum X mass displacement) (m) + StC_vt['StC_X_PSP'] = float_read(f.readline().split()[0]) # 0 StC_X_PSP - Positive stop position (minimum X mass displacement) (m) + StC_vt['StC_X_NSP'] = float_read(f.readline().split()[0]) # 0 StC_X_NSP - Negative stop position (maximum X mass displacement) (m) StC_vt['StC_Y_PSP'] = float_read(f.readline().split()[0]) # 0 StC_Y_PSP - Positive stop position (maximum Y mass displacement) (m) StC_vt['StC_Y_NSP'] = float_read(f.readline().split()[0]) # 0 StC_Y_NSP - Negative stop position (minimum Y mass displacement) (m) StC_vt['StC_Z_PSP'] = float_read(f.readline().split()[0]) # 0 StC_Z_PSP - Positive stop position (maximum Z mass displacement) (m) [used only when StC_DOF_MODE=1 and StC_Z_DOF=TRUE] @@ -1640,13 +1779,14 @@ def read_StC(self,filename): StC_vt['rho_Y'] = float_read(f.readline().split()[0]) # 1000 rho_Y - Y TLCD liquid density (kg/m^3) f.readline() # PRESCRIBED TIME SERIES StC_vt['PrescribedForcesCoord'] = int_read(f.readline().split()[0]) # 2 PrescribedForcesCoord- Prescribed forces are in global or local coordinates (switch) {1: global; 2: local} - StC_vt['PrescribedForcesFile'] = f.readline().split()[0] # "Bld-TimeForceSeries.dat" PrescribedForcesFile - Time series force and moment (7 columns of time, FX, FY, FZ, MX, MY, MZ) + # TODO: read in prescribed force time series, for now we just point to absolute path of input file + StC_vt['PrescribedForcesFile'] = os.path.join(self.FAST_directory, quoted_read(f.readline().split()[0])) # "Bld-TimeForceSeries.dat" PrescribedForcesFile - Time series force and moment (7 columns of time, FX, FY, FZ, MX, MY, MZ) f.readline() return StC_vt def read_DISCON_in(self): - # Read the Bladed style Interface controller input file, intended for ROSCO https://github.com/NREL/rosco.toolbox + # Read the Bladed style Interface controller input file, intended for ROSCO https://github.com/NREL/ROSCO_toolbox discon_in_file = os.path.normpath(os.path.join(self.FAST_directory, self.fst_vt['ServoDyn']['DLL_InFile'])) @@ -1656,7 +1796,8 @@ def read_DISCON_in(self): self.fst_vt['DISCON_in'] = read_DISCON(discon_in_file) # Some additional filename parsing - self.fst_vt['DISCON_in']['PerfFileName'] = os.path.abspath(os.path.join(self.FAST_directory, self.fst_vt['DISCON_in']['PerfFileName'])) + discon_dir = os.path.dirname(discon_in_file) + self.fst_vt['DISCON_in']['PerfFileName'] = os.path.abspath(os.path.join(discon_dir, self.fst_vt['DISCON_in']['PerfFileName'])) # Try to read rotor performance data if it is available try: @@ -1684,6 +1825,27 @@ def read_DISCON_in(self): else: del self.fst_vt['DISCON_in'] + def read_spd_trq(self, file): + ''' + read the speed-torque curve data to the fst_vt + ''' + spd_trq = {} + + f = open(os.path.normpath(os.path.join(self.FAST_directory, file))) + + spd_trq['header'] = f.readline() + + # handle arbritraty number of rows and two columns: RPM and Torque + data = f.readlines() + spd_trq['RPM'] = [float(line.split()[0]) for line in data] + spd_trq['Torque'] = [float(line.split()[1]) for line in data] + f.close() + + self.fst_vt['spd_trq'] = spd_trq + + + + def read_HydroDyn(self, hd_file): f = open(hd_file) @@ -1692,74 +1854,35 @@ def read_HydroDyn(self, hd_file): f.readline() self.fst_vt['HydroDyn']['Echo'] = bool_read(f.readline().split()[0]) - # ENVIRONMENTAL CONDITIONS - f.readline() - self.fst_vt['HydroDyn']['WtrDens'] = float_read(f.readline().split()[0]) - self.fst_vt['HydroDyn']['WtrDpth'] = float_read(f.readline().split()[0]) - self.fst_vt['HydroDyn']['MSL2SWL'] = float_read(f.readline().split()[0]) - - # WAVES - f.readline() - self.fst_vt['HydroDyn']['WaveMod'] = int_read(f.readline().split()[0]) - self.fst_vt['HydroDyn']['WaveStMod'] = int_read(f.readline().split()[0]) - self.fst_vt['HydroDyn']['WaveTMax'] = float_read(f.readline().split()[0]) - self.fst_vt['HydroDyn']['WaveDT'] = float_read(f.readline().split()[0]) - self.fst_vt['HydroDyn']['WaveHs'] = float_read(f.readline().split()[0]) - self.fst_vt['HydroDyn']['WaveTp'] = float_read(f.readline().split()[0]) - self.fst_vt['HydroDyn']['WavePkShp'] = float_read(f.readline().split()[0]) # default - self.fst_vt['HydroDyn']['WvLowCOff'] = float_read(f.readline().split()[0]) - self.fst_vt['HydroDyn']['WvHiCOff'] = float_read(f.readline().split()[0]) - self.fst_vt['HydroDyn']['WaveDir'] = float_read(f.readline().split()[0]) - self.fst_vt['HydroDyn']['WaveDirMod'] = int_read(f.readline().split()[0]) - self.fst_vt['HydroDyn']['WaveDirSpread'] = float_read(f.readline().split()[0]) - self.fst_vt['HydroDyn']['WaveNDir'] = int_read(f.readline().split()[0]) - self.fst_vt['HydroDyn']['WaveDirRange'] = float_read(f.readline().split()[0]) - self.fst_vt['HydroDyn']['WaveSeed1'] = int_read(f.readline().split()[0]) - self.fst_vt['HydroDyn']['WaveSeed2'] = int_read(f.readline().split()[0]) - self.fst_vt['HydroDyn']['WaveNDAmp'] = bool_read(f.readline().split()[0]) - self.fst_vt['HydroDyn']['WvKinFile'] = f.readline().split()[0][1:-1] - self.fst_vt['HydroDyn']['NWaveElev'] = int_read(f.readline().split()[0]) - self.fst_vt['HydroDyn']['WaveElevxi'] = [idx.strip() for idx in f.readline().split('WaveElevxi')[0].split(',')] - self.fst_vt['HydroDyn']['WaveElevyi'] = [idx.strip() for idx in f.readline().split('WaveElevyi')[0].split(',')] - - # 2ND-ORDER WAVES - f.readline() - self.fst_vt['HydroDyn']['WvDiffQTF'] = bool_read(f.readline().split()[0]) - self.fst_vt['HydroDyn']['WvSumQTF'] = bool_read(f.readline().split()[0]) - self.fst_vt['HydroDyn']['WvLowCOffD'] = float_read(f.readline().split()[0]) - self.fst_vt['HydroDyn']['WvHiCOffD'] = float_read(f.readline().split()[0]) - self.fst_vt['HydroDyn']['WvLowCOffS'] = float_read(f.readline().split()[0]) - self.fst_vt['HydroDyn']['WvHiCOffS'] = float_read(f.readline().split()[0]) - - # CURRENT - f.readline() - self.fst_vt['HydroDyn']['CurrMod'] = int_read(f.readline().split()[0]) - self.fst_vt['HydroDyn']['CurrSSV0'] = float_read(f.readline().split()[0]) - self.fst_vt['HydroDyn']['CurrSSDir'] = float_read(f.readline().split()[0]) - self.fst_vt['HydroDyn']['CurrNSRef'] = float_read(f.readline().split()[0]) - self.fst_vt['HydroDyn']['CurrNSV0'] = float_read(f.readline().split()[0]) - self.fst_vt['HydroDyn']['CurrNSDir'] = float_read(f.readline().split()[0]) - self.fst_vt['HydroDyn']['CurrDIV'] = float_read(f.readline().split()[0]) - self.fst_vt['HydroDyn']['CurrDIDir'] = float_read(f.readline().split()[0]) # FLOATING PLATFORM f.readline() self.fst_vt['HydroDyn']['PotMod'] = int_read(f.readline().split()[0]) self.fst_vt['HydroDyn']['ExctnMod'] = int_read(f.readline().split()[0]) + self.fst_vt['HydroDyn']['ExctnDisp'] = int_read(f.readline().split()[0]) + self.fst_vt['HydroDyn']['ExctnCutOff'] = int_read(f.readline().split()[0]) + self.fst_vt['HydroDyn']['PtfmYMod'] = int_read(f.readline().split()[0]) + self.fst_vt['HydroDyn']['PtfmRefY'] = float_read(f.readline().split()[0]) + self.fst_vt['HydroDyn']['PtfmYCutOff'] = float_read(f.readline().split()[0]) + self.fst_vt['HydroDyn']['NExctnHdg'] = int_read(f.readline().split()[0]) self.fst_vt['HydroDyn']['RdtnMod'] = int_read(f.readline().split()[0]) self.fst_vt['HydroDyn']['RdtnTMax'] = float_read(f.readline().split()[0]) self.fst_vt['HydroDyn']['RdtnDT'] = float_read(f.readline().split()[0]) self.fst_vt['HydroDyn']['NBody'] = int_read(f.readline().split()[0]) self.fst_vt['HydroDyn']['NBodyMod'] = int_read(f.readline().split()[0]) - self.fst_vt['HydroDyn']['PotFile'] = os.path.normpath(os.path.join(os.path.split(hd_file)[0], f.readline().split()[0][1:-1])) - self.fst_vt['HydroDyn']['WAMITULEN'] = float_read(f.readline().split()[0]) - self.fst_vt['HydroDyn']['PtfmRefxt'] = float_read(f.readline().split()[0]) - self.fst_vt['HydroDyn']['PtfmRefyt'] = float_read(f.readline().split()[0]) - self.fst_vt['HydroDyn']['PtfmRefzt'] = float_read(f.readline().split()[0]) - self.fst_vt['HydroDyn']['PtfmRefztRot'] = float_read(f.readline().split()[0]) - self.fst_vt['HydroDyn']['PtfmVol0'] = float_read(f.readline().split()[0]) - self.fst_vt['HydroDyn']['PtfmCOBxt'] = float_read(f.readline().split()[0]) - self.fst_vt['HydroDyn']['PtfmCOByt'] = float_read(f.readline().split()[0]) + + # Get multiple potential files + pot_strings = read_array(f,self.fst_vt['HydroDyn']['NBody'],str) #re.split(',| ',f.readline().strip()) + pot_strings = [os.path.normpath(os.path.join(os.path.split(hd_file)[0],ps)) for ps in pot_strings] # make relative to hd_file + self.fst_vt['HydroDyn']['PotFile'] = pot_strings + self.fst_vt['HydroDyn']['WAMITULEN'] = read_array(f,self.fst_vt['HydroDyn']['NBody'], array_type=float) + self.fst_vt['HydroDyn']['PtfmRefxt'] = read_array(f,self.fst_vt['HydroDyn']['NBody'], array_type=float) + self.fst_vt['HydroDyn']['PtfmRefyt'] = read_array(f,self.fst_vt['HydroDyn']['NBody'], array_type=float) + self.fst_vt['HydroDyn']['PtfmRefzt'] = read_array(f,self.fst_vt['HydroDyn']['NBody'], array_type=float) + self.fst_vt['HydroDyn']['PtfmRefztRot'] = read_array(f,self.fst_vt['HydroDyn']['NBody'], array_type=float) + self.fst_vt['HydroDyn']['PtfmVol0'] = read_array(f,self.fst_vt['HydroDyn']['NBody'], array_type=float) + self.fst_vt['HydroDyn']['PtfmCOBxt'] = read_array(f,self.fst_vt['HydroDyn']['NBody'], array_type=float) + self.fst_vt['HydroDyn']['PtfmCOByt'] = read_array(f,self.fst_vt['HydroDyn']['NBody'], array_type=float) # 2ND-ORDER FLOATING PLATFORM FORCES f.readline() @@ -1779,9 +1902,14 @@ def read_HydroDyn(self, hd_file): else: raise Exception("Invalid value for fst_vt['HydroDyn']['NBodyMod']") - self.fst_vt['HydroDyn']['AddCLin'] = np.array([[float(idx) for idx in f.readline().strip().split()[:6]] for i in range(6)]) - self.fst_vt['HydroDyn']['AddBLin'] = np.array([[float(idx) for idx in f.readline().strip().split()[:6]] for i in range(6)]) - self.fst_vt['HydroDyn']['AddBQuad'] = np.array([[float(idx) for idx in f.readline().strip().split()[:6]] for i in range(6)]) + self.fst_vt['HydroDyn']['AddCLin'] = np.array([[float(idx) for idx in f.readline().strip().split()[:6*NBody]] for i in range(6)]) + self.fst_vt['HydroDyn']['AddBLin'] = np.array([[float(idx) for idx in f.readline().strip().split()[:6*NBody]] for i in range(6)]) + self.fst_vt['HydroDyn']['AddBQuad'] = np.array([[float(idx) for idx in f.readline().strip().split()[:6*NBody]] for i in range(6)]) + + #STRIP THEORY OPTIONS + f.readline() + self.fst_vt['HydroDyn']['WaveDisp'] = int_read(f.readline().split()[0]) + self.fst_vt['HydroDyn']['AMMod'] = int_read(f.readline().split()[0]) #AXIAL COEFFICIENTS f.readline() @@ -1790,14 +1918,20 @@ def read_HydroDyn(self, hd_file): self.fst_vt['HydroDyn']['AxCd'] = [None]*self.fst_vt['HydroDyn']['NAxCoef'] self.fst_vt['HydroDyn']['AxCa'] = [None]*self.fst_vt['HydroDyn']['NAxCoef'] self.fst_vt['HydroDyn']['AxCp'] = [None]*self.fst_vt['HydroDyn']['NAxCoef'] + self.fst_vt['HydroDyn']['AxFDMod'] = [None]*self.fst_vt['HydroDyn']['NAxCoef'] + self.fst_vt['HydroDyn']['AxVnCOff'] = [None]*self.fst_vt['HydroDyn']['NAxCoef'] + self.fst_vt['HydroDyn']['AxFDLoFSc'] = [None]*self.fst_vt['HydroDyn']['NAxCoef'] ln = f.readline().split() ln = f.readline().split() for i in range(self.fst_vt['HydroDyn']['NAxCoef']): ln = f.readline().split() - self.fst_vt['HydroDyn']['AxCoefID'][i] = int(ln[0]) - self.fst_vt['HydroDyn']['AxCd'][i] = float(ln[1]) - self.fst_vt['HydroDyn']['AxCa'][i] = float(ln[2]) - self.fst_vt['HydroDyn']['AxCp'][i] = float(ln[3]) + self.fst_vt['HydroDyn']['AxCoefID'][i] = int(ln[0]) + self.fst_vt['HydroDyn']['AxCd'][i] = float_read(ln[1]) + self.fst_vt['HydroDyn']['AxCa'][i] = float_read(ln[2]) + self.fst_vt['HydroDyn']['AxCp'][i] = float_read(ln[3]) + self.fst_vt['HydroDyn']['AxFDMod'][i] = float_read(ln[4]) + self.fst_vt['HydroDyn']['AxVnCOff'][i] = float_read(ln[5]) + self.fst_vt['HydroDyn']['AxFDLoFSc'][i] = float_read(ln[6]) #MEMBER JOINTS f.readline() @@ -1838,18 +1972,20 @@ def read_HydroDyn(self, hd_file): f.readline() f.readline() ln = f.readline().split() - self.fst_vt['HydroDyn']['SimplCd'] = float(ln[0]) - self.fst_vt['HydroDyn']['SimplCdMG'] = float(ln[1]) - self.fst_vt['HydroDyn']['SimplCa'] = float(ln[2]) - self.fst_vt['HydroDyn']['SimplCaMG'] = float(ln[3]) - self.fst_vt['HydroDyn']['SimplCp'] = float(ln[4]) - self.fst_vt['HydroDyn']['SimplCpMG'] = float(ln[5]) - self.fst_vt['HydroDyn']['SimplAxCd'] = float(ln[6]) - self.fst_vt['HydroDyn']['SimplAxCdMG'] = float(ln[7]) - self.fst_vt['HydroDyn']['SimplAxCa'] = float(ln[8]) - self.fst_vt['HydroDyn']['SimplAxCaMG'] = float(ln[9]) - self.fst_vt['HydroDyn']['SimplAxCp'] = float(ln[10]) - self.fst_vt['HydroDyn']['SimplAxCpMG'] = float(ln[11]) + self.fst_vt['HydroDyn']['SimplCd'] = float_read(ln[0]) + self.fst_vt['HydroDyn']['SimplCdMG'] = float_read(ln[1]) + self.fst_vt['HydroDyn']['SimplCa'] = float_read(ln[2]) + self.fst_vt['HydroDyn']['SimplCaMG'] = float_read(ln[3]) + self.fst_vt['HydroDyn']['SimplCp'] = float_read(ln[4]) + self.fst_vt['HydroDyn']['SimplCpMG'] = float_read(ln[5]) + self.fst_vt['HydroDyn']['SimplAxCd'] = float_read(ln[6]) + self.fst_vt['HydroDyn']['SimplAxCdMG'] = float_read(ln[7]) + self.fst_vt['HydroDyn']['SimplAxCa'] = float_read(ln[8]) + self.fst_vt['HydroDyn']['SimplAxCaMG'] = float_read(ln[9]) + self.fst_vt['HydroDyn']['SimplAxCp'] = float_read(ln[10]) + self.fst_vt['HydroDyn']['SimplAxCpMG'] = float_read(ln[11]) + self.fst_vt['HydroDyn']['SimplCb'] = float_read(ln[12]) + self.fst_vt['HydroDyn']['SimplCbMG'] = float_read(ln[13]) #DEPTH-BASED HYDRODYNAMIC COEFFICIENTS f.readline() @@ -1867,23 +2003,27 @@ def read_HydroDyn(self, hd_file): self.fst_vt['HydroDyn']['DpthAxCaMG'] = [None]*self.fst_vt['HydroDyn']['NCoefDpth'] self.fst_vt['HydroDyn']['DpthAxCp'] = [None]*self.fst_vt['HydroDyn']['NCoefDpth'] self.fst_vt['HydroDyn']['DpthAxCpMG'] = [None]*self.fst_vt['HydroDyn']['NCoefDpth'] + self.fst_vt['HydroDyn']['DpthCb'] = [None]*self.fst_vt['HydroDyn']['NCoefDpth'] + self.fst_vt['HydroDyn']['DpthCbMG'] = [None]*self.fst_vt['HydroDyn']['NCoefDpth'] ln = f.readline().split() ln = f.readline().split() for i in range(self.fst_vt['HydroDyn']['NCoefDpth']): ln = f.readline().split() - self.fst_vt['HydroDyn']['Dpth'][i] = float(ln[0]) - self.fst_vt['HydroDyn']['DpthCd'][i] = float(ln[1]) - self.fst_vt['HydroDyn']['DpthCdMG'][i] = float(ln[2]) - self.fst_vt['HydroDyn']['DpthCa'][i] = float(ln[3]) - self.fst_vt['HydroDyn']['DpthCaMG'][i] = float(ln[4]) - self.fst_vt['HydroDyn']['DpthCp'][i] = float(ln[5]) - self.fst_vt['HydroDyn']['DpthCpMG'][i] = float(ln[6]) - self.fst_vt['HydroDyn']['DpthAxCd'][i] = float(ln[7]) - self.fst_vt['HydroDyn']['DpthAxCdMG'][i] = float(ln[8]) - self.fst_vt['HydroDyn']['DpthAxCa'][i] = float(ln[9]) - self.fst_vt['HydroDyn']['DpthAxCaMG'][i] = float(ln[10]) - self.fst_vt['HydroDyn']['DpthAxCp'][i] = float(ln[11]) - self.fst_vt['HydroDyn']['DpthAxCpMG'][i] = float(ln[12]) + self.fst_vt['HydroDyn']['Dpth'][i] = float_read(ln[0]) + self.fst_vt['HydroDyn']['DpthCd'][i] = float_read(ln[1]) + self.fst_vt['HydroDyn']['DpthCdMG'][i] = float_read(ln[2]) + self.fst_vt['HydroDyn']['DpthCa'][i] = float_read(ln[3]) + self.fst_vt['HydroDyn']['DpthCaMG'][i] = float_read(ln[4]) + self.fst_vt['HydroDyn']['DpthCp'][i] = float_read(ln[5]) + self.fst_vt['HydroDyn']['DpthCpMG'][i] = float_read(ln[6]) + self.fst_vt['HydroDyn']['DpthAxCd'][i] = float_read(ln[7]) + self.fst_vt['HydroDyn']['DpthAxCdMG'][i] = float_read(ln[8]) + self.fst_vt['HydroDyn']['DpthAxCa'][i] = float_read(ln[9]) + self.fst_vt['HydroDyn']['DpthAxCaMG'][i] = float_read(ln[10]) + self.fst_vt['HydroDyn']['DpthAxCp'][i] = float_read(ln[11]) + self.fst_vt['HydroDyn']['DpthAxCpMG'][i] = float_read(ln[12]) + self.fst_vt['HydroDyn']['DpthCb'][i] = float_read(ln[13]) + self.fst_vt['HydroDyn']['DpthCbMG'][i] = float_read(ln[14]) #MEMBER-BASED HYDRODYNAMIC COEFFICIENTS f.readline() @@ -1913,36 +2053,44 @@ def read_HydroDyn(self, hd_file): self.fst_vt['HydroDyn']['MemberAxCp2'] = [None]*self.fst_vt['HydroDyn']['NCoefMembers'] self.fst_vt['HydroDyn']['MemberAxCpMG1'] = [None]*self.fst_vt['HydroDyn']['NCoefMembers'] self.fst_vt['HydroDyn']['MemberAxCpMG2'] = [None]*self.fst_vt['HydroDyn']['NCoefMembers'] + self.fst_vt['HydroDyn']['MemberCb1'] = [None]*self.fst_vt['HydroDyn']['NCoefMembers'] + self.fst_vt['HydroDyn']['MemberCb2'] = [None]*self.fst_vt['HydroDyn']['NCoefMembers'] + self.fst_vt['HydroDyn']['MemberCbMG1'] = [None]*self.fst_vt['HydroDyn']['NCoefMembers'] + self.fst_vt['HydroDyn']['MemberCbMG2'] = [None]*self.fst_vt['HydroDyn']['NCoefMembers'] f.readline() f.readline() for i in range(self.fst_vt['HydroDyn']['NCoefMembers']): ln = f.readline().split() self.fst_vt['HydroDyn']['MemberID_HydC'][i] = int(ln[0]) - self.fst_vt['HydroDyn']['MemberCd1'][i] = float(ln[1]) - self.fst_vt['HydroDyn']['MemberCd2'][i] = float(ln[2]) - self.fst_vt['HydroDyn']['MemberCdMG1'][i] = float(ln[3]) - self.fst_vt['HydroDyn']['MemberCdMG2'][i] = float(ln[4]) - self.fst_vt['HydroDyn']['MemberCa1'][i] = float(ln[5]) - self.fst_vt['HydroDyn']['MemberCa2'][i] = float(ln[6]) - self.fst_vt['HydroDyn']['MemberCaMG1'][i] = float(ln[7]) - self.fst_vt['HydroDyn']['MemberCaMG2'][i] = float(ln[8]) - self.fst_vt['HydroDyn']['MemberCp1'][i] = float(ln[9]) - self.fst_vt['HydroDyn']['MemberCp2'][i] = float(ln[10]) - self.fst_vt['HydroDyn']['MemberCpMG1'][i] = float(ln[11]) - self.fst_vt['HydroDyn']['MemberCpMG2'][i] = float(ln[12]) - self.fst_vt['HydroDyn']['MemberAxCd1'][i] = float(ln[13]) - self.fst_vt['HydroDyn']['MemberAxCd2'][i] = float(ln[14]) - self.fst_vt['HydroDyn']['MemberAxCdMG1'][i] = float(ln[15]) - self.fst_vt['HydroDyn']['MemberAxCdMG2'][i] = float(ln[16]) - self.fst_vt['HydroDyn']['MemberAxCa1'][i] = float(ln[17]) - self.fst_vt['HydroDyn']['MemberAxCa2'][i] = float(ln[18]) - self.fst_vt['HydroDyn']['MemberAxCaMG1'][i] = float(ln[19]) - self.fst_vt['HydroDyn']['MemberAxCaMG2'][i] = float(ln[20]) - self.fst_vt['HydroDyn']['MemberAxCp1'][i] = float(ln[21]) - self.fst_vt['HydroDyn']['MemberAxCp2'][i] = float(ln[22]) - self.fst_vt['HydroDyn']['MemberAxCpMG1'][i] = float(ln[23]) - self.fst_vt['HydroDyn']['MemberAxCpMG2'][i] = float(ln[24]) + self.fst_vt['HydroDyn']['MemberCd1'][i] = float_read(ln[1]) + self.fst_vt['HydroDyn']['MemberCd2'][i] = float_read(ln[2]) + self.fst_vt['HydroDyn']['MemberCdMG1'][i] = float_read(ln[3]) + self.fst_vt['HydroDyn']['MemberCdMG2'][i] = float_read(ln[4]) + self.fst_vt['HydroDyn']['MemberCa1'][i] = float_read(ln[5]) + self.fst_vt['HydroDyn']['MemberCa2'][i] = float_read(ln[6]) + self.fst_vt['HydroDyn']['MemberCaMG1'][i] = float_read(ln[7]) + self.fst_vt['HydroDyn']['MemberCaMG2'][i] = float_read(ln[8]) + self.fst_vt['HydroDyn']['MemberCp1'][i] = float_read(ln[9]) + self.fst_vt['HydroDyn']['MemberCp2'][i] = float_read(ln[10]) + self.fst_vt['HydroDyn']['MemberCpMG1'][i] = float_read(ln[11]) + self.fst_vt['HydroDyn']['MemberCpMG2'][i] = float_read(ln[12]) + self.fst_vt['HydroDyn']['MemberAxCd1'][i] = float_read(ln[13]) + self.fst_vt['HydroDyn']['MemberAxCd2'][i] = float_read(ln[14]) + self.fst_vt['HydroDyn']['MemberAxCdMG1'][i] = float_read(ln[15]) + self.fst_vt['HydroDyn']['MemberAxCdMG2'][i] = float_read(ln[16]) + self.fst_vt['HydroDyn']['MemberAxCa1'][i] = float_read(ln[17]) + self.fst_vt['HydroDyn']['MemberAxCa2'][i] = float_read(ln[18]) + self.fst_vt['HydroDyn']['MemberAxCaMG1'][i] = float_read(ln[19]) + self.fst_vt['HydroDyn']['MemberAxCaMG2'][i] = float_read(ln[20]) + self.fst_vt['HydroDyn']['MemberAxCp1'][i] = float_read(ln[21]) + self.fst_vt['HydroDyn']['MemberAxCp2'][i] = float_read(ln[22]) + self.fst_vt['HydroDyn']['MemberAxCpMG1'][i] = float_read(ln[23]) + self.fst_vt['HydroDyn']['MemberAxCpMG2'][i] = float_read(ln[24]) + self.fst_vt['HydroDyn']['MemberCb1'][i] = float_read(ln[25]) + self.fst_vt['HydroDyn']['MemberCb2'][i] = float_read(ln[26]) + self.fst_vt['HydroDyn']['MemberCbMG1'][i] = float_read(ln[27]) + self.fst_vt['HydroDyn']['MemberCbMG2'][i] = float_read(ln[28]) #MEMBERS f.readline() @@ -1954,6 +2102,7 @@ def read_HydroDyn(self, hd_file): self.fst_vt['HydroDyn']['MPropSetID2'] = [None]*self.fst_vt['HydroDyn']['NMembers'] self.fst_vt['HydroDyn']['MDivSize'] = [None]*self.fst_vt['HydroDyn']['NMembers'] self.fst_vt['HydroDyn']['MCoefMod'] = [None]*self.fst_vt['HydroDyn']['NMembers'] + self.fst_vt['HydroDyn']['MHstLMod'] = [None]*self.fst_vt['HydroDyn']['NMembers'] self.fst_vt['HydroDyn']['PropPot'] = [None]*self.fst_vt['HydroDyn']['NMembers'] ln = f.readline().split() ln = f.readline().split() @@ -1966,7 +2115,8 @@ def read_HydroDyn(self, hd_file): self.fst_vt['HydroDyn']['MPropSetID2'][i] = int(ln[4]) self.fst_vt['HydroDyn']['MDivSize'][i] = float(ln[5]) self.fst_vt['HydroDyn']['MCoefMod'][i] = int(ln[6]) - self.fst_vt['HydroDyn']['PropPot'][i] = bool_read(ln[7]) + self.fst_vt['HydroDyn']['MHstLMod'][i] = int(ln[7]) + self.fst_vt['HydroDyn']['PropPot'][i] = bool_read(ln[8]) #FILLED MEMBERS f.readline() @@ -1979,10 +2129,14 @@ def read_HydroDyn(self, hd_file): ln = f.readline().split() for i in range(self.fst_vt['HydroDyn']['NFillGroups']): ln = f.readline().split() - self.fst_vt['HydroDyn']['FillNumM'][i] = int(ln[0]) - self.fst_vt['HydroDyn']['FillMList'][i] = [int(j) for j in ln[1:-2]] - self.fst_vt['HydroDyn']['FillFSLoc'][i] = float(ln[-2]) - self.fst_vt['HydroDyn']['FillDens'][i] = float(ln[-1]) + n_fill = int(ln[0]) + self.fst_vt['HydroDyn']['FillNumM'][i] = n_fill + self.fst_vt['HydroDyn']['FillMList'][i] = [int(j) for j in ln[1:1+n_fill]] + self.fst_vt['HydroDyn']['FillFSLoc'][i] = float(ln[n_fill+1]) + if ln[n_fill+2] == 'DEFAULT': + self.fst_vt['HydroDyn']['FillDens'][i] = 'DEFAULT' + else: + self.fst_vt['HydroDyn']['FillDens'][i] = float(ln[n_fill+2]) #MARINE GROWTH f.readline() @@ -2026,26 +2180,133 @@ def read_HydroDyn(self, hd_file): self.fst_vt['HydroDyn']['HDSum'] = bool_read(f.readline().split()[0]) self.fst_vt['HydroDyn']['OutAll'] = bool_read(f.readline().split()[0]) self.fst_vt['HydroDyn']['OutSwtch'] = int_read(f.readline().split()[0]) - self.fst_vt['HydroDyn']['OutFmt'] = str(f.readline().split()[0]) - self.fst_vt['HydroDyn']['OutSFmt'] = str(f.readline().split()[0]) - - self.fst_vt['HydroDyn']['HDSum'] - self.fst_vt['HydroDyn']['OutAll'] - self.fst_vt['HydroDyn']['OutSwtch'] - self.fst_vt['HydroDyn']['OutFmt'] - self.fst_vt['HydroDyn']['OutSFmt'] + self.fst_vt['HydroDyn']['OutFmt'] = quoted_read(f.readline().split()[0]) + self.fst_vt['HydroDyn']['OutSFmt'] = quoted_read(f.readline().split()[0]) # HydroDyn Outlist f.readline() data = f.readline() while data.split()[0] != 'END': - channels = data.split('"') - channel_list = channels[1].split(',') - self.set_outlist(self.fst_vt['outlist']['HydroDyn'], channel_list) + if data.find('"')>=0: + channels = data.split('"') + channel_list = channels[1].split(',') + else: + row_string = data.split(',') + if len(row_string)==1: + channel_list = row_string[0].split('\n')[0] + else: + channel_list = row_string + self.set_outlist(self.fst_vt['outlist']['AeroDyn'], channel_list) data = f.readline() f.close() + def read_SeaState(self, ss_file): + + f = open(ss_file) + + f.readline() + f.readline() + + self.fst_vt['SeaState']['Echo'] = bool_read(f.readline().split()[0]) + # ENVIRONMENTAL CONDITIONS + f.readline() + self.fst_vt['SeaState']['WtrDens'] = float_read(f.readline().split()[0]) + self.fst_vt['SeaState']['WtrDpth'] = float_read(f.readline().split()[0]) + self.fst_vt['SeaState']['MSL2SWL'] = float_read(f.readline().split()[0]) + + # SPATIAL DISCRETIZATION + f.readline() + self.fst_vt['SeaState']['X_HalfWidth'] = float_read(f.readline().split()[0]) + self.fst_vt['SeaState']['Y_HalfWidth'] = float_read(f.readline().split()[0]) + self.fst_vt['SeaState']['Z_Depth'] = float_read(f.readline().split()[0]) + self.fst_vt['SeaState']['NX'] = int_read(f.readline().split()[0]) + self.fst_vt['SeaState']['NY'] = int_read(f.readline().split()[0]) + self.fst_vt['SeaState']['NZ'] = int_read(f.readline().split()[0]) + + # WAVES + f.readline() + self.fst_vt['SeaState']['WaveMod'] = int_read(f.readline().split()[0]) + self.fst_vt['SeaState']['WaveStMod'] = int_read(f.readline().split()[0]) + self.fst_vt['SeaState']['WaveTMax'] = float_read(f.readline().split()[0]) + self.fst_vt['SeaState']['WaveDT'] = float_read(f.readline().split()[0]) + self.fst_vt['SeaState']['WaveHs'] = float_read(f.readline().split()[0]) + self.fst_vt['SeaState']['WaveTp'] = float_read(f.readline().split()[0]) + self.fst_vt['SeaState']['WavePkShp'] = float_read(f.readline().split()[0]) # default + self.fst_vt['SeaState']['WvLowCOff'] = float_read(f.readline().split()[0]) + self.fst_vt['SeaState']['WvHiCOff'] = float_read(f.readline().split()[0]) + self.fst_vt['SeaState']['WaveDir'] = float_read(f.readline().split()[0]) + self.fst_vt['SeaState']['WaveDirMod'] = int_read(f.readline().split()[0]) + self.fst_vt['SeaState']['WaveDirSpread'] = float_read(f.readline().split()[0]) + self.fst_vt['SeaState']['WaveNDir'] = int_read(f.readline().split()[0]) + self.fst_vt['SeaState']['WaveDirRange'] = float_read(f.readline().split()[0]) + self.fst_vt['SeaState']['WaveSeed1'] = int_read(f.readline().split()[0]) + self.fst_vt['SeaState']['WaveSeed2'] = int_read(f.readline().split()[0]) + self.fst_vt['SeaState']['WaveNDAmp'] = bool_read(f.readline().split()[0]) + self.fst_vt['SeaState']['WvKinFile'] = quoted_read(f.readline().split()[0]) + + # 2ND-ORDER WAVES + f.readline() + self.fst_vt['SeaState']['WvDiffQTF'] = bool_read(f.readline().split()[0]) + self.fst_vt['SeaState']['WvSumQTF'] = bool_read(f.readline().split()[0]) + self.fst_vt['SeaState']['WvLowCOffD'] = float_read(f.readline().split()[0]) + self.fst_vt['SeaState']['WvHiCOffD'] = float_read(f.readline().split()[0]) + self.fst_vt['SeaState']['WvLowCOffS'] = float_read(f.readline().split()[0]) + self.fst_vt['SeaState']['WvHiCOffS'] = float_read(f.readline().split()[0]) + + # CONSTRAINED WAVE + f.readline() + self.fst_vt['SeaState']['ConstWaveMod'] = int_read(f.readline().split()[0]) + self.fst_vt['SeaState']['CrestHmax'] = float_read(f.readline().split()[0]) + self.fst_vt['SeaState']['CrestTime'] = float_read(f.readline().split()[0]) + self.fst_vt['SeaState']['CrestXi'] = float_read(f.readline().split()[0]) + self.fst_vt['SeaState']['CrestYi'] = float_read(f.readline().split()[0]) + + # CURRENT + f.readline() + self.fst_vt['SeaState']['CurrMod'] = int_read(f.readline().split()[0]) + self.fst_vt['SeaState']['CurrSSV0'] = float_read(f.readline().split()[0]) + self.fst_vt['SeaState']['CurrSSDir'] = float_read(f.readline().split()[0]) + self.fst_vt['SeaState']['CurrNSRef'] = float_read(f.readline().split()[0]) + self.fst_vt['SeaState']['CurrNSV0'] = float_read(f.readline().split()[0]) + self.fst_vt['SeaState']['CurrNSDir'] = float_read(f.readline().split()[0]) + self.fst_vt['SeaState']['CurrDIV'] = float_read(f.readline().split()[0]) + self.fst_vt['SeaState']['CurrDIDir'] = float_read(f.readline().split()[0]) + + # MacCamy-Fuchs Diffraction Model + f.readline() + self.fst_vt['SeaState']['MCFD'] = float_read(f.readline().split()[0]) + + # OUTPUT + f.readline() + self.fst_vt['SeaState']['SeaStSum'] = bool_read(f.readline().split()[0]) + self.fst_vt['SeaState']['OutSwtch'] = int_read(f.readline().split()[0]) + self.fst_vt['SeaState']['OutFmt'] = quoted_read(f.readline().split()[0]) + self.fst_vt['SeaState']['OutSFmt'] = quoted_read(f.readline().split()[0]) + self.fst_vt['SeaState']['NWaveElev'] = int_read(f.readline().split()[0]) + self.fst_vt['SeaState']['WaveElevxi'] = [float_read(idx.strip()) for idx in f.readline().split('WaveElevxi')[0].replace(',',' ').split()] + self.fst_vt['SeaState']['WaveElevyi'] = [float_read(idx.strip()) for idx in f.readline().split('WaveElevyi')[0].replace(',',' ').split()] + self.fst_vt['SeaState']['NWaveKin'] = int_read(f.readline().split()[0]) + NWaveKin = self.fst_vt['SeaState']['NWaveKin'] + if NWaveKin: + self.fst_vt['SeaState']['WaveKinxi'] = [float_read(idx.strip()) for idx in f.readline().split('WaveKinxi')[0].replace(',',' ').split()] + self.fst_vt['SeaState']['WaveKinyi'] = [float_read(idx.strip()) for idx in f.readline().split('WaveKinyi')[0].replace(',',' ').split()] + self.fst_vt['SeaState']['WaveKinzi'] = [float_read(idx.strip()) for idx in f.readline().split('WaveKinzi')[0].replace(',',' ').split()] + else: + [f.readline() for i in range(3)] + # Unused, filled with dummy location + self.fst_vt['SeaState']['WaveKinxi'] = [0] + self.fst_vt['SeaState']['WaveKinyi'] = [0] + self.fst_vt['SeaState']['WaveKinzi'] = [0] + + + # SeaState Outlist + f.readline() + self.read_outlist_freeForm(f,'SeaState') + + f.close() + + def read_SubDyn(self, sd_file): f = open(sd_file) @@ -2057,12 +2318,12 @@ def read_SubDyn(self, sd_file): self.fst_vt['SubDyn']['SDdeltaT'] = float_read(f.readline().split()[0]) self.fst_vt['SubDyn']['IntMethod'] = int_read(f.readline().split()[0]) self.fst_vt['SubDyn']['SttcSolve'] = bool_read(f.readline().split()[0]) - self.fst_vt['SubDyn']['GuyanLoadCorrection'] = bool_read(f.readline().split()[0]) + # self.fst_vt['SubDyn']['GuyanLoadCorrection'] = bool_read(f.readline().split()[0]) f.readline() # FEA and CRAIG-BAMPTON PARAMETERS self.fst_vt['SubDyn']['FEMMod'] = int_read(f.readline().split()[0]) self.fst_vt['SubDyn']['NDiv'] = int_read(f.readline().split()[0]) - self.fst_vt['SubDyn']['CBMod'] = bool_read(f.readline().split()[0]) + # self.fst_vt['SubDyn']['CBMod'] = bool_read(f.readline().split()[0]) self.fst_vt['SubDyn']['Nmodes'] = int_read(f.readline().split()[0]) self.fst_vt['SubDyn']['JDampings'] = float_read(f.readline().split()[0]) self.fst_vt['SubDyn']['GuyanDampMod'] = int_read(f.readline().split()[0]) @@ -2150,7 +2411,7 @@ def read_SubDyn(self, sd_file): self.fst_vt['SubDyn']['MPropSetID1'] = [None]*self.fst_vt['SubDyn']['NMembers'] self.fst_vt['SubDyn']['MPropSetID2'] = [None]*self.fst_vt['SubDyn']['NMembers'] self.fst_vt['SubDyn']['MType'] = [None]*self.fst_vt['SubDyn']['NMembers'] - self.fst_vt['SubDyn']['COSMID'] = [None]*self.fst_vt['SubDyn']['NMembers'] + self.fst_vt['SubDyn']['M_COSMID'] = [None]*self.fst_vt['SubDyn']['NMembers'] ln = f.readline().split() ln = f.readline().split() for i in range(self.fst_vt['SubDyn']['NMembers']): @@ -2162,7 +2423,7 @@ def read_SubDyn(self, sd_file): self.fst_vt['SubDyn']['MPropSetID2'][i] = int(ln[4]) self.fst_vt['SubDyn']['MType'][i] = int(ln[5]) if len(ln) > 6: - self.fst_vt['SubDyn']['COSMID'][i] = int(ln[6]) + self.fst_vt['SubDyn']['M_COSMID'][i] = int(ln[6]) f.readline() # MEMBER X-SECTION PROPERTY data 1/2 self.fst_vt['SubDyn']['NPropSets'] = int_read(f.readline().split()[0]) @@ -2222,8 +2483,8 @@ def read_SubDyn(self, sd_file): ln = f.readline().split() self.fst_vt['SubDyn']['CablePropSetID'][i] = int(ln[0]) self.fst_vt['SubDyn']['CableEA'][i] = float(ln[1]) - self.fst_vt['SubDyn']['CableMatDens'][i] = float(ln[1]) - self.fst_vt['SubDyn']['CableT0'][i] = float(ln[1]) + self.fst_vt['SubDyn']['CableMatDens'][i] = float(ln[2]) + self.fst_vt['SubDyn']['CableT0'][i] = float(ln[3]) # RIGID LINK PROPERTIES f.readline() self.fst_vt['SubDyn']['NRigidPropSets'] = int_read(f.readline().split()[0]) @@ -2235,6 +2496,26 @@ def read_SubDyn(self, sd_file): ln = f.readline().split() self.fst_vt['SubDyn']['RigidPropSetID'][i] = int(ln[0]) self.fst_vt['SubDyn']['RigidMatDens'][i] = float(ln[1]) + # SPRING ELEMENT PROPERTIES + f.readline() + self.fst_vt['SubDyn']['NSpringPropSets'] = int_read(f.readline().split()[0]) + self.fst_vt['SubDyn']['SpringPropSetID'] = [None]*self.fst_vt['SubDyn']['NSpringPropSets'] + spring_list = ['k11','k12','k13','k14','k15','k16', + 'k22','k23','k24','k25','k26', + 'k33','k34','k35','k36', + 'k44','k45','k46', + 'k55','k56', + 'k66'] + for sl in spring_list: # init list + self.fst_vt['SubDyn'][sl] = [None]*self.fst_vt['SubDyn']['NSpringPropSets'] + f.readline() + f.readline() + for i in range(self.fst_vt['SubDyn']['NSpringPropSets']): + ln = f.readline().split() + self.fst_vt['SubDyn']['SpringPropSetID'][i] = int(ln[0]) + for j, sl in enumerate(spring_list): + self.fst_vt['SubDyn'][sl][i] = ln[j+1] + # MEMBER COSINE MATRICES f.readline() self.fst_vt['SubDyn']['NCOSMs'] = int_read(f.readline().split()[0]) @@ -2294,64 +2575,232 @@ def read_SubDyn(self, sd_file): f.readline() # OUTPUT self.fst_vt['SubDyn']['SumPrint'] = bool_read(f.readline().split()[0]) + file_pos = f.tell() + line = f.readline() + if 'OutCBModes' in line: + self.fst_vt['SubDyn']['OutCBModes'] = int_read(line.split()[0]) + else: + f.seek(file_pos) + file_pos = f.tell() + line = f.readline() + if 'OutFEMModes' in line: + self.fst_vt['SubDyn']['OutFEMModes'] = int_read(line.split()[0]) + else: + f.seek(file_pos) self.fst_vt['SubDyn']['OutCOSM'] = bool_read(f.readline().split()[0]) self.fst_vt['SubDyn']['OutAll'] = bool_read(f.readline().split()[0]) self.fst_vt['SubDyn']['OutSwtch'] = int_read(f.readline().split()[0]) self.fst_vt['SubDyn']['TabDelim'] = bool_read(f.readline().split()[0]) self.fst_vt['SubDyn']['OutDec'] = int_read(f.readline().split()[0]) - self.fst_vt['SubDyn']['OutFmt'] = f.readline().split()[0] - self.fst_vt['SubDyn']['OutSFmt'] = f.readline().split()[0] + self.fst_vt['SubDyn']['OutFmt'] = quoted_read(f.readline().split()[0]) + self.fst_vt['SubDyn']['OutSFmt'] = quoted_read(f.readline().split()[0]) f.readline() # MEMBER OUTPUT LIST self.fst_vt['SubDyn']['NMOutputs'] = int_read(f.readline().split()[0]) self.fst_vt['SubDyn']['MemberID_out'] = [None]*self.fst_vt['SubDyn']['NMOutputs'] self.fst_vt['SubDyn']['NOutCnt'] = [None]*self.fst_vt['SubDyn']['NMOutputs'] - self.fst_vt['SubDyn']['NodeCnt'] = [None]*self.fst_vt['SubDyn']['NMOutputs'] + self.fst_vt['SubDyn']['NodeCnt'] = [[None]]*self.fst_vt['SubDyn']['NMOutputs'] ln = f.readline().split() ln = f.readline().split() for i in range(self.fst_vt['SubDyn']['NMOutputs']): - ln = f.readline().split() + ln = f.readline().split('!')[0].split() # allows for comments self.fst_vt['SubDyn']['MemberID_out'][i] = int(ln[0]) self.fst_vt['SubDyn']['NOutCnt'][i] = int(ln[1]) - self.fst_vt['SubDyn']['NodeCnt'][i] = int(ln[2]) + self.fst_vt['SubDyn']['NodeCnt'][i] = [int(node) for node in ln[2:]] f.readline() # SSOutList + self.read_outlist_freeForm(f,'SubDyn') + + f.close() + + f.close() + + + def read_ExtPtfm(self, ep_file): + # ExtPtfm file based on documentation here: https://openfast.readthedocs.io/en/main/source/user/extptfm/input_files.html + + f = open(ep_file) + f.readline() + f.readline() + f.readline() + + # Simulation Control + self.fst_vt['ExtPtfm']['Echo'] = bool_read(f.readline().split()[0]) + self.fst_vt['ExtPtfm']['DT'] = float_read(f.readline().split()[0]) + self.fst_vt['ExtPtfm']['IntMethod'] = int_read(f.readline().split()[0]) + f.readline() + + # Reduction inputs + self.fst_vt['ExtPtfm']['FileFormat'] = int_read(f.readline().split()[0]) + self.fst_vt['ExtPtfm']['Red_FileName'] = os.path.join(os.path.dirname(ep_file), quoted_read(f.readline().split()[0])) + self.fst_vt['ExtPtfm']['RedCst_FileName'] = os.path.join(os.path.dirname(ep_file), quoted_read(f.readline().split()[0])) + self.fst_vt['ExtPtfm']['NActiveDOFList'] = int_read(f.readline().split()[0]) + self.fst_vt['ExtPtfm']['ActiveDOFList'] = read_array(f,None,split_val='ActiveDOFList',array_type=int) + self.fst_vt['ExtPtfm']['NInitPosList'] = int_read(f.readline().split()[0]) + self.fst_vt['ExtPtfm']['InitPosList'] = read_array(f,None,split_val='InitPosList',array_type=float) + self.fst_vt['ExtPtfm']['NInitVelList'] = int_read(f.readline().split()[0]) + self.fst_vt['ExtPtfm']['InitVelList'] = read_array(f,None,split_val='InitVelList',array_type=float) + f.readline() + + # Output + self.fst_vt['ExtPtfm']['SumPrint'] = bool_read(f.readline().split()[0]) + self.fst_vt['ExtPtfm']['OutFile'] = int_read(f.readline().split()[0]) + self.fst_vt['ExtPtfm']['TabDelim'] = bool_read(f.readline().split()[0]) + self.fst_vt['ExtPtfm']['OutFmt'] = quoted_read(f.readline().split()[0]) + self.fst_vt['ExtPtfm']['TStart'] = float_read(f.readline().split()[0]) + + # Loop through output channel lines + f.readline() data = f.readline() + + # Handle the case if there are blank lines before the END statement, check if blank line + while data.split().__len__() == 0: + data = f.readline() + while data.split()[0] != 'END': - channels = data.split('"') - channel_list = channels[1].split(',') - self.set_outlist(self.fst_vt['outlist']['SubDyn'], channel_list) + if data.find('"')>=0: + channels = data.split('"') + channel_list = channels[1].split(',') + else: + row_string = data.split(',') + if len(row_string)==1: + channel_list = row_string[0].split('\n')[0] + else: + channel_list = row_string + self.set_outlist(self.fst_vt['outlist']['ExtPtfm'], channel_list) # TODO: Need to figure this out as we dont have a full outlist for now, similar to MoorDyn data = f.readline() - + + if self.fst_vt['ExtPtfm']['FileFormat'] == 0: + self.fst_vt['ExtPtfm']['Guyan'] = {} + # self.read_Guyan(f) # TODO: need to impliment this. An example file not found to test + elif self.fst_vt['ExtPtfm']['FileFormat'] == 1: + self.fst_vt['ExtPtfm']['FlexASCII'] = {} + self.read_Superelement(self.fst_vt['ExtPtfm']['Red_FileName']) + f.close() + + def read_Superelement(self, superelement_file): + + + def detectAndReadExtPtfmSE(lines): + # Function based on https://github.com/OpenFAST/openfast_toolbox/blob/353643ed917d113ec8dfd765813fef7d09752757/openfast_toolbox/io/fast_input_file.py#L1932 + # Developed by Emmanuel Branlard (https://github.com/ebranlard) + + def readmat(n,m,lines,iStart): + M=np.zeros((n,m)) + for j in np.arange(n): + i=iStart+j + M[j,:]=np.array(lines[i].split()).astype(float) + return M + + if len(lines)<10: + return False + if not (lines[0][0]=='!' and lines[1][0]=='!'): + return False + if lines[1].lower().find('flex')<0: + return + if lines[2].lower().find('!dimension')<0: + return + + # --- At this stage we assume it's in the proper format + nDOFCommon = -1 + i=2 + try: + while i0: + if l[0]=='!': + if l.find('!dimension')==0: + self.fst_vt['ExtPtfm']['FlexASCII']['nDOF'] = int(l.split(':')[1]) + nDOFCommon = self.fst_vt['ExtPtfm']['FlexASCII']['nDOF'] + elif l.find('!time increment')==0: + self.fst_vt['ExtPtfm']['FlexASCII']['dt'] = float(l.split(':')[1]) + elif l.find('!total simulation time')==0: + self.fst_vt['ExtPtfm']['FlexASCII']['T'] = float(l.split(':')[1]) + elif len(l.strip())==0: + pass + else: + raise NameError('Unexcepted content found on line {}'.format(i)) + i+=1 + except NameError as e: + raise e + except: + raise + + return True + + + f = open(superelement_file) + lines=f.read().splitlines() + if not detectAndReadExtPtfmSE(lines): + raise NameError('Could not read Superelement file') f.close() def read_MAP(self, map_file): # MAP++ - # TODO: this is likely not robust enough, only tested on the Hywind Spar - # additional lines in these tables are likely - f = open(map_file) f.readline() f.readline() f.readline() + + # Init line dictionary + line_dict = ['LineType', 'Diam', 'MassDenInAir', 'EA', 'CB', 'CIntDamp', 'Ca', 'Cdn', 'Cdt'] + for ld in line_dict: + self.fst_vt['MAP'][ld] = [] + data_line = f.readline().strip().split() - self.fst_vt['MAP']['LineType'] = str(data_line[0]) - self.fst_vt['MAP']['Diam'] = float(data_line[1]) - self.fst_vt['MAP']['MassDenInAir'] = float(data_line[2]) - self.fst_vt['MAP']['EA'] = float(data_line[3]) - self.fst_vt['MAP']['CB'] = float(data_line[4]) - self.fst_vt['MAP']['CIntDamp'] = float(data_line[5]) - self.fst_vt['MAP']['Ca'] = float(data_line[6]) - self.fst_vt['MAP']['Cdn'] = float(data_line[7]) - self.fst_vt['MAP']['Cdt'] = float(data_line[8]) - f.readline() + while data_line[0] and data_line[0][:3] != '---': # OpenFAST searches for ---, so we'll do the same + self.fst_vt['MAP']['LineType'].append( str(data_line[0])) + self.fst_vt['MAP']['Diam'].append( float_read(data_line[1])) + self.fst_vt['MAP']['MassDenInAir'].append( float_read(data_line[2])) + self.fst_vt['MAP']['EA'].append( float_read(data_line[3])) + self.fst_vt['MAP']['CB'].append( float_read(data_line[4])) + self.fst_vt['MAP']['CIntDamp'].append( float_read(data_line[5])) + self.fst_vt['MAP']['Ca'].append( float_read(data_line[6])) + self.fst_vt['MAP']['Cdn'].append( float_read(data_line[7])) + self.fst_vt['MAP']['Cdt'].append( float_read(data_line[8])) + data_line = f.readline().strip().split() + #f.readline() f.readline() f.readline() - for i in range(2): - data_node = f.readline().strip().split() + + # Init map nodes + node_types = ['Node','Type','X','Y','Z','M','B','FX','FY','FZ'] + for nt in node_types: + self.fst_vt['MAP'][nt] = [] + + data_node = f.readline().strip().split() + while data_node[0] and data_node[0][:3] != '---': # OpenFAST searches for ---, so we'll do the same self.fst_vt['MAP']['Node'].append(int(data_node[0])) self.fst_vt['MAP']['Type'].append(str(data_node[1])) self.fst_vt['MAP']['X'].append(float_read(data_node[2])) @@ -2362,157 +2811,347 @@ def read_MAP(self, map_file): self.fst_vt['MAP']['FX'].append(float_read(data_node[7])) self.fst_vt['MAP']['FY'].append(float_read(data_node[8])) self.fst_vt['MAP']['FZ'].append(float_read(data_node[9])) + data_node = f.readline().strip().split() + data_node = ''.join(data_node) # re-join for reading next section uniformly + # f.readline() f.readline() f.readline() - f.readline() + + # Init line properties + line_prop = ['Line', 'LineType', 'UnstrLen', 'NodeAnch', 'NodeFair', 'Flags'] + for lp in line_prop: + self.fst_vt['MAP'][lp] = [] + data_line_prop = f.readline().strip().split() - self.fst_vt['MAP']['Line'] = int(data_line_prop[0]) - self.fst_vt['MAP']['LineType'] = str(data_line_prop[1]) - self.fst_vt['MAP']['UnstrLen'] = float(data_line_prop[2]) - self.fst_vt['MAP']['NodeAnch'] = int(data_line_prop[3]) - self.fst_vt['MAP']['NodeFair'] = int(data_line_prop[4]) - self.fst_vt['MAP']['Flags'] = [str(val) for val in data_line_prop[5:]] - f.readline() - f.readline() - f.readline() - self.fst_vt['MAP']['Option'] = [str(val) for val in f.readline().strip().split()] + while data_line_prop[0] and data_line_prop[0][:3] != '---': # OpenFAST searches for ---, so we'll do the same + self.fst_vt['MAP']['Line'] .append( int(data_line_prop[0])) + self.fst_vt['MAP']['LineType'].append( str(data_line_prop[1])) + self.fst_vt['MAP']['UnstrLen'].append( float_read(data_line_prop[2])) + self.fst_vt['MAP']['NodeAnch'].append( int(data_line_prop[3])) + self.fst_vt['MAP']['NodeFair'].append( int(data_line_prop[4])) + self.fst_vt['MAP']['Flags'] .append( [str(val) for val in data_line_prop[5:]] ) + data_line_prop = f.readline().strip().split() + data_line_prop = ''.join(data_line_prop) # re-join for reading next section uniformly + # f.readline() + f.readline() + f.readline() + + self.fst_vt['MAP']['Option'] = [] # Solver options + # need to check for EOF here since we can have any number of solver options + data_solver = f.readline().strip().split() # Solver options + while len(data_solver) > 0: # stopping if we hit blank lines + self.fst_vt['MAP']['Option'].append([str(val) for val in data_solver]) + data_solver = f.readline().strip().split() + # self.fst_vt['MAP']['Option'] = [str(val) for val in f.readline().strip().split()] f.close() def read_MoorDyn(self, moordyn_file): f = open(moordyn_file) + # Init optional headers so they exist for writer, even if not read + self.fst_vt['MoorDyn']['Rod_Name'] = [] + self.fst_vt['MoorDyn']['Body_ID'] = [] + self.fst_vt['MoorDyn']['Rod_ID'] = [] + self.fst_vt['MoorDyn']['ChannelID'] = [] + + # MoorDyn f.readline() f.readline() self.fst_vt['MoorDyn']['Echo'] = bool_read(f.readline().split()[0]) - f.readline() - f.readline() - f.readline() - self.fst_vt['MoorDyn']['Name'] = [] - self.fst_vt['MoorDyn']['Diam'] = [] - self.fst_vt['MoorDyn']['MassDen'] = [] - self.fst_vt['MoorDyn']['EA'] = [] - self.fst_vt['MoorDyn']['BA_zeta'] = [] - self.fst_vt['MoorDyn']['EI'] = [] - self.fst_vt['MoorDyn']['Cd'] = [] - self.fst_vt['MoorDyn']['Ca'] = [] - self.fst_vt['MoorDyn']['CdAx'] = [] - self.fst_vt['MoorDyn']['CaAx'] = [] - data_line = f.readline().strip().split() - while data_line[0][:3] != '---': # OpenFAST searches for ---, so we'll do the same - self.fst_vt['MoorDyn']['Name'].append(str(data_line[0])) - self.fst_vt['MoorDyn']['Diam'].append(float(data_line[1])) - self.fst_vt['MoorDyn']['MassDen'].append(float(data_line[2])) - self.fst_vt['MoorDyn']['EA'].append(float(data_line[3])) - self.fst_vt['MoorDyn']['BA_zeta'].append(float(data_line[4])) - self.fst_vt['MoorDyn']['EI'].append(float(data_line[5])) - self.fst_vt['MoorDyn']['Cd'].append(float(data_line[6])) - self.fst_vt['MoorDyn']['Ca'].append(float(data_line[7])) - self.fst_vt['MoorDyn']['CdAx'].append(float(data_line[8])) - self.fst_vt['MoorDyn']['CaAx'].append(float(data_line[9])) - data_line = f.readline().strip().split() - f.readline() - f.readline() - self.fst_vt['MoorDyn']['Point_ID'] = [] - self.fst_vt['MoorDyn']['Attachment'] = [] - self.fst_vt['MoorDyn']['X'] = [] - self.fst_vt['MoorDyn']['Y'] = [] - self.fst_vt['MoorDyn']['Z'] = [] - self.fst_vt['MoorDyn']['M'] = [] - self.fst_vt['MoorDyn']['V'] = [] - self.fst_vt['MoorDyn']['CdA'] = [] - self.fst_vt['MoorDyn']['CA'] = [] - data_line = f.readline().strip().split() - while data_line[0][:3] != '---': # OpenFAST searches for ---, so we'll do the same - self.fst_vt['MoorDyn']['Point_ID'].append(int(data_line[0])) - self.fst_vt['MoorDyn']['Attachment'].append(str(data_line[1])) - self.fst_vt['MoorDyn']['X'].append(float(data_line[2])) - self.fst_vt['MoorDyn']['Y'].append(float(data_line[3])) - self.fst_vt['MoorDyn']['Z'].append(float(data_line[4])) - self.fst_vt['MoorDyn']['M'].append(float(data_line[5])) - self.fst_vt['MoorDyn']['V'].append(float(data_line[6])) - self.fst_vt['MoorDyn']['CdA'].append(float(data_line[7])) - self.fst_vt['MoorDyn']['CA'].append(float(data_line[8])) - data_line = f.readline().strip().split() - f.readline() - f.readline() - self.fst_vt['MoorDyn']['Line_ID'] = [] - self.fst_vt['MoorDyn']['LineType'] = [] - self.fst_vt['MoorDyn']['AttachA'] = [] - self.fst_vt['MoorDyn']['AttachB'] = [] - self.fst_vt['MoorDyn']['UnstrLen'] = [] - self.fst_vt['MoorDyn']['NumSegs'] = [] - self.fst_vt['MoorDyn']['Outputs'] = [] - data_line = f.readline().strip().split() - while data_line[0][:3] != '---': # OpenFAST searches for ---, so we'll do the same - self.fst_vt['MoorDyn']['Line_ID'].append(int(data_line[0])) - self.fst_vt['MoorDyn']['LineType'].append(str(data_line[1])) - self.fst_vt['MoorDyn']['AttachA'].append(int(data_line[2])) - self.fst_vt['MoorDyn']['AttachB'].append(int(data_line[3])) - self.fst_vt['MoorDyn']['UnstrLen'].append(float(data_line[4])) - self.fst_vt['MoorDyn']['NumSegs'].append(int(data_line[5])) - self.fst_vt['MoorDyn']['Outputs'].append(str(data_line[6])) - data_line = f.readline().strip().split() + data_line = f.readline() + while data_line: - # read optional control inputs, there are other optional MoorDyn sections/inputs - self.fst_vt['MoorDyn']['ChannelID'] = [] - self.fst_vt['MoorDyn']['Lines_Control'] = [] - if 'CONTROL' in [dl.upper() for dl in data_line]: - f.readline() - f.readline() - data_line = f.readline().strip().split() - while data_line[0][:3] != '---': # OpenFAST searches for ---, so we'll do the same - self.fst_vt['MoorDyn']['ChannelID'].append(int(data_line[0])) - # Line(s) is a list of mooring lines, spaces are allowed between commas - control_lines = [] - for lines in data_line[1:]: - for line in lines.split(','): - control_lines.append(line.strip(',')) - - # Spaces show up in control_lines as '', remove them all - while '' in control_lines: - control_lines.remove('') - - self.fst_vt['MoorDyn']['Lines_Control'].append(control_lines) + # Split and join so all headers are same when detecting next section + data_line = data_line.strip().split() + data_line = ''.join(data_line).lower() + + # Line Types + if 'linetypes' in data_line or 'linedictionary' in data_line: + f.readline() + f.readline() + + # Line types + self.fst_vt['MoorDyn']['Name'] = [] + self.fst_vt['MoorDyn']['Diam'] = [] + self.fst_vt['MoorDyn']['MassDen'] = [] + self.fst_vt['MoorDyn']['EA'] = [] + self.fst_vt['MoorDyn']['BA_zeta'] = [] + self.fst_vt['MoorDyn']['EI'] = [] + self.fst_vt['MoorDyn']['Cd'] = [] + self.fst_vt['MoorDyn']['Ca'] = [] + self.fst_vt['MoorDyn']['CdAx'] = [] + self.fst_vt['MoorDyn']['CaAx'] = [] data_line = f.readline().strip().split() + while data_line[0] and data_line[0][:3] != '---': # OpenFAST searches for ---, so we'll do the same + self.fst_vt['MoorDyn']['Name'].append(str(data_line[0])) + self.fst_vt['MoorDyn']['Diam'].append(float(data_line[1])) + self.fst_vt['MoorDyn']['MassDen'].append(float(data_line[2])) + self.fst_vt['MoorDyn']['EA'].append(float(data_line[3])) + self.fst_vt['MoorDyn']['BA_zeta'].append(float(data_line[4])) + self.fst_vt['MoorDyn']['EI'].append(float(data_line[5])) + self.fst_vt['MoorDyn']['Cd'].append(float(data_line[6])) + self.fst_vt['MoorDyn']['Ca'].append(float(data_line[7])) + self.fst_vt['MoorDyn']['CdAx'].append(float(data_line[8])) + self.fst_vt['MoorDyn']['CaAx'].append(float(data_line[9])) + data_line = f.readline().strip().split() + data_line = ''.join(data_line) # re-join + + elif 'rodtypes' in data_line or 'roddictionary' in data_line: + data_line = f.readline() + data_line = f.readline() + + self.fst_vt['MoorDyn']['Rod_Diam'] = [] + self.fst_vt['MoorDyn']['Rod_MassDen'] = [] + self.fst_vt['MoorDyn']['Rod_Cd'] = [] + self.fst_vt['MoorDyn']['Rod_Ca'] = [] + self.fst_vt['MoorDyn']['Rod_CdEnd'] = [] + self.fst_vt['MoorDyn']['Rod_CaEnd'] = [] - # Solver options, there are a few more optional MoorDyn inputs that can be added line 'CONTROL' - self.fst_vt['MoorDyn']['dtM'] = float_read(f.readline().split()[0]) - self.fst_vt['MoorDyn']['kbot'] = float_read(f.readline().split()[0]) - self.fst_vt['MoorDyn']['cbot'] = float_read(f.readline().split()[0]) - self.fst_vt['MoorDyn']['dtIC'] = float_read(f.readline().split()[0]) - self.fst_vt['MoorDyn']['TmaxIC'] = float_read(f.readline().split()[0]) - self.fst_vt['MoorDyn']['CdScaleIC'] = float_read(f.readline().split()[0]) - self.fst_vt['MoorDyn']['threshIC'] = float_read(f.readline().split()[0]) - f.readline() + data_line = f.readline().strip().split() + while data_line[0] and data_line[0][:3] != '---': # OpenFAST searches for ---, so we'll do the same + self.fst_vt['MoorDyn']['Rod_Name'].append(data_line[0]) + self.fst_vt['MoorDyn']['Rod_Diam'].append(float(data_line[1])) + self.fst_vt['MoorDyn']['Rod_MassDen'].append(float(data_line[2])) + self.fst_vt['MoorDyn']['Rod_Cd'].append(float(data_line[3])) + self.fst_vt['MoorDyn']['Rod_Ca'].append(float(data_line[4])) + self.fst_vt['MoorDyn']['Rod_CdEnd'].append(float(data_line[5])) + self.fst_vt['MoorDyn']['Rod_CaEnd'].append(float(data_line[6])) + data_line = f.readline().strip().split() + data_line = ''.join(data_line) # re-join for reading next section uniformly - data = f.readline() - while data.split()[0] != 'END': - channels = data.strip().strip('"').strip("'") - channel_list = channels.split(',') - self.set_outlist(self.fst_vt['outlist']['MoorDyn'], channel_list) - data = f.readline() + + elif 'bodies' in data_line or 'bodylist' in data_line or 'bodyproperties' in data_line: + + f.readline() + f.readline() + self.fst_vt['MoorDyn']['Body_ID'] = [] + self.fst_vt['MoorDyn']['Body_Attachment'] = [] + self.fst_vt['MoorDyn']['X0'] = [] + self.fst_vt['MoorDyn']['Y0'] = [] + self.fst_vt['MoorDyn']['Z0'] = [] + self.fst_vt['MoorDyn']['r0'] = [] + self.fst_vt['MoorDyn']['p0'] = [] + self.fst_vt['MoorDyn']['y0'] = [] + self.fst_vt['MoorDyn']['Body_Mass'] = [] + self.fst_vt['MoorDyn']['Body_CG'] = [] + self.fst_vt['MoorDyn']['Body_I'] = [] + self.fst_vt['MoorDyn']['Body_Volume'] = [] + self.fst_vt['MoorDyn']['Body_CdA'] = [] + self.fst_vt['MoorDyn']['Body_Ca'] = [] + + data_line = f.readline().strip().split() + while data_line[0] and data_line[0][:3] != '---': # OpenFAST searches for ---, so we'll do the same + self.fst_vt['MoorDyn']['Body_ID'].append(int(data_line[0])) + self.fst_vt['MoorDyn']['Body_Attachment'].append(data_line[1]) + self.fst_vt['MoorDyn']['X0'].append(float(data_line[2])) + self.fst_vt['MoorDyn']['Y0'].append(float(data_line[3])) + self.fst_vt['MoorDyn']['Z0'].append(float(data_line[4])) + self.fst_vt['MoorDyn']['r0'].append(float(data_line[5])) + self.fst_vt['MoorDyn']['p0'].append(float(data_line[6])) + self.fst_vt['MoorDyn']['y0'].append(float(data_line[7])) + self.fst_vt['MoorDyn']['Body_Mass'].append(float(data_line[8])) + self.fst_vt['MoorDyn']['Body_CG'].append([float(dl) for dl in data_line[9].split('|')]) + self.fst_vt['MoorDyn']['Body_I'].append([float(dl) for dl in data_line[10].split('|')]) + self.fst_vt['MoorDyn']['Body_Volume'].append(float(data_line[11])) + self.fst_vt['MoorDyn']['Body_CdA'].append([float(dl) for dl in data_line[12].split('|')]) + self.fst_vt['MoorDyn']['Body_Ca'].append([float(dl) for dl in data_line[13].split('|')]) + data_line = f.readline().strip().split() + data_line = ''.join(data_line) # re-join for reading next section uniformly + + + elif 'rods' in data_line or 'rodlist' in data_line or 'rodproperties' in data_line: + f.readline() + f.readline() + self.fst_vt['MoorDyn']['Rod_ID'] = [] + self.fst_vt['MoorDyn']['Rod_Type'] = [] + self.fst_vt['MoorDyn']['Rod_Attachment'] = [] + self.fst_vt['MoorDyn']['Xa'] = [] + self.fst_vt['MoorDyn']['Ya'] = [] + self.fst_vt['MoorDyn']['Za'] = [] + self.fst_vt['MoorDyn']['Xb'] = [] + self.fst_vt['MoorDyn']['Yb'] = [] + self.fst_vt['MoorDyn']['Zb'] = [] + self.fst_vt['MoorDyn']['Rod_NumSegs'] = [] + self.fst_vt['MoorDyn']['RodOutputs'] = [] + + data_line = f.readline().strip().split() + while data_line[0] and data_line[0][:3] != '---': # OpenFAST searches for ---, so we'll do the same + self.fst_vt['MoorDyn']['Rod_ID'].append(data_line[0]) + self.fst_vt['MoorDyn']['Rod_Type'].append(data_line[1]) + self.fst_vt['MoorDyn']['Rod_Attachment'].append(data_line[2]) + self.fst_vt['MoorDyn']['Xa'].append(float(data_line[3])) + self.fst_vt['MoorDyn']['Ya'].append(float(data_line[4])) + self.fst_vt['MoorDyn']['Za'].append(float(data_line[5])) + self.fst_vt['MoorDyn']['Xb'].append(float(data_line[6])) + self.fst_vt['MoorDyn']['Yb'].append(float(data_line[7])) + self.fst_vt['MoorDyn']['Zb'].append(float(data_line[8])) + self.fst_vt['MoorDyn']['Rod_NumSegs'].append(int(data_line[9])) + self.fst_vt['MoorDyn']['RodOutputs'].append(data_line[10]) + data_line = f.readline().strip().split() + data_line = ''.join(data_line) # re-join for reading next section uniformly + + elif 'points' in data_line or 'connectionproperties' in data_line or \ + 'nodeproperties' in data_line or 'pointproperties' in data_line or \ + 'pointlist' in data_line: + + f.readline() + f.readline() + self.fst_vt['MoorDyn']['Point_ID'] = [] + self.fst_vt['MoorDyn']['Attachment'] = [] + self.fst_vt['MoorDyn']['X'] = [] + self.fst_vt['MoorDyn']['Y'] = [] + self.fst_vt['MoorDyn']['Z'] = [] + self.fst_vt['MoorDyn']['M'] = [] + self.fst_vt['MoorDyn']['V'] = [] + self.fst_vt['MoorDyn']['CdA'] = [] + self.fst_vt['MoorDyn']['CA'] = [] + data_line = f.readline().strip().split() + while data_line[0] and data_line[0][:3] != '---': # OpenFAST searches for ---, so we'll do the same + self.fst_vt['MoorDyn']['Point_ID'].append(int(data_line[0])) + self.fst_vt['MoorDyn']['Attachment'].append(str(data_line[1])) + self.fst_vt['MoorDyn']['X'].append(float(data_line[2])) + self.fst_vt['MoorDyn']['Y'].append(float(data_line[3])) + self.fst_vt['MoorDyn']['Z'].append(float(data_line[4])) + self.fst_vt['MoorDyn']['M'].append(float(data_line[5])) + self.fst_vt['MoorDyn']['V'].append(float(data_line[6])) + self.fst_vt['MoorDyn']['CdA'].append(float(data_line[7])) + self.fst_vt['MoorDyn']['CA'].append(float(data_line[8])) + data_line = f.readline().strip().split() + data_line = ''.join(data_line) # re-join for reading next section uniformly + + elif 'lines' in data_line or 'lineproperties' in data_line or 'linelist' in data_line: + f.readline() + f.readline() + + # Lines + self.fst_vt['MoorDyn']['Line_ID'] = [] + self.fst_vt['MoorDyn']['LineType'] = [] + self.fst_vt['MoorDyn']['AttachA'] = [] + self.fst_vt['MoorDyn']['AttachB'] = [] + self.fst_vt['MoorDyn']['UnstrLen'] = [] + self.fst_vt['MoorDyn']['NumSegs'] = [] + self.fst_vt['MoorDyn']['Outputs'] = [] + data_line = f.readline().strip().split() + while data_line[0] and data_line[0][:3] != '---': # OpenFAST searches for ---, so we'll do the same + self.fst_vt['MoorDyn']['Line_ID'].append(int(data_line[0])) + self.fst_vt['MoorDyn']['LineType'].append(str(data_line[1])) + self.fst_vt['MoorDyn']['AttachA'].append(str(data_line[2])) + self.fst_vt['MoorDyn']['AttachB'].append(str(data_line[3])) + self.fst_vt['MoorDyn']['UnstrLen'].append(float(data_line[4])) + self.fst_vt['MoorDyn']['NumSegs'].append(int(data_line[5])) + self.fst_vt['MoorDyn']['Outputs'].append(str(data_line[6])) + data_line = f.readline().strip().split() + data_line = ''.join(data_line) # re-join for reading next section uniformly + + elif 'control' in data_line.lower(): + f.readline() + f.readline() + + # read optional control inputs, there are other optional MoorDyn sections/inputs + self.fst_vt['MoorDyn']['ChannelID'] = [] + self.fst_vt['MoorDyn']['Lines_Control'] = [] + + data_line = f.readline().strip().split() + while data_line[0] and data_line[0][:3] != '---': # OpenFAST searches for ---, so we'll do the same + self.fst_vt['MoorDyn']['ChannelID'].append(int(data_line[0])) + # Line(s) is a list of mooring lines, spaces are allowed between commas + control_lines = [] + for lines in data_line[1:]: + for line in lines.split(','): + control_lines.append(line.strip(',')) + + # Spaces show up in control_lines as '', remove them all + while '' in control_lines: + control_lines.remove('') + + self.fst_vt['MoorDyn']['Lines_Control'].append(control_lines) + data_line = f.readline().strip().split() + data_line = ''.join(data_line) # re-join for reading next section uniformly + + + elif 'options' in data_line: + + # MoorDyn lets options be written in any order + # Solver options + self.fst_vt['MoorDyn']['options'] = [] # keep list of MoorDyn options + + string_options = ['WaterKin'] + data_line = f.readline().strip().split() + while data_line[0] and data_line[0][:3] != '---': # OpenFAST searches for ---, so we'll do the same + + raw_value = data_line[0] + option_name = data_line[1] + + self.fst_vt['MoorDyn']['options'].append(option_name) + if option_name in string_options: + self.fst_vt['MoorDyn'][option_name] = raw_value.strip('"') + else: + self.fst_vt['MoorDyn'][option_name] = float(raw_value) + + data_line = f.readline().strip().split() + data_line = ''.join(data_line) # re-join for reading next section uniformly + + elif 'outputs' in data_line: + + self.read_outlist_freeForm(f,'MoorDyn') + + f.close() + break + + if 'WaterKin' in self.fst_vt['MoorDyn']['options']: + WaterKin_file = os.path.normpath(os.path.join(os.path.dirname(moordyn_file), self.fst_vt['MoorDyn']['WaterKin'])) + self.read_WaterKin(WaterKin_file) + + def read_WaterKin(self,WaterKin_file): + print('here') + + f = open(WaterKin_file) + f.readline() + f.readline() + f.readline() + + self.fst_vt['WaterKin']['WaveKinMod'] = int_read(f.readline().split()[0]) + self.fst_vt['WaterKin']['WaveKinFile'] = f.readline().split()[0] # Will want to update this somehow with wave elevation + self.fst_vt['WaterKin']['dtWave'] = float_read(f.readline().split()[0]) + self.fst_vt['WaterKin']['WaveDir'] = float_read(f.readline().split()[0]) + self.fst_vt['WaterKin']['X_Type'] = int_read(f.readline().split()[0]) + self.fst_vt['WaterKin']['X_Grid'] = read_array(f,None,split_val='-',array_type=float) + # re.split(',| ',f.readline().strip()) + self.fst_vt['WaterKin']['Y_Type'] = int_read(f.readline().split()[0]) + self.fst_vt['WaterKin']['Y_Grid'] = read_array(f,None,split_val='-',array_type=float) + self.fst_vt['WaterKin']['Z_Type'] = int_read(f.readline().split()[0]) + self.fst_vt['WaterKin']['Z_Grid'] = read_array(f,None,split_val='-',array_type=float) + f.readline() + self.fst_vt['WaterKin']['CurrentMod'] = int_read(f.readline().split()[0]) f.close() def execute(self): self.read_MainInput() ed_file = os.path.join(self.FAST_directory, self.fst_vt['Fst']['EDFile']) - self.read_ElastoDyn(ed_file) - if not os.path.isabs(self.fst_vt['ElastoDyn']['BldFile1']): - ed_blade_file = os.path.join(os.path.dirname(ed_file), self.fst_vt['ElastoDyn']['BldFile1']) - self.read_ElastoDynBlade(ed_blade_file) - if not os.path.isabs(self.fst_vt['ElastoDyn']['TwrFile']): - ed_tower_file = os.path.join(os.path.dirname(ed_file), self.fst_vt['ElastoDyn']['TwrFile']) - self.read_ElastoDynTower(ed_tower_file) - self.read_InflowWind() + + if self.fst_vt['Fst']['CompElast'] == 3: # SimpleElastoDyn + self.read_SimpleElastoDyn(ed_file) + else: + self.read_ElastoDyn(ed_file) + if not os.path.isabs(self.fst_vt['ElastoDyn']['BldFile1']): + ed_blade_file = os.path.join(os.path.dirname(ed_file), self.fst_vt['ElastoDyn']['BldFile1']) + if self.fst_vt['Fst']['CompElast'] == 1 or os.path.isfile(ed_blade_file): # If elastodyn blade is being used OR if the blade file exists + self.read_ElastoDynBlade(ed_blade_file) + if not os.path.isabs(self.fst_vt['ElastoDyn']['TwrFile']): + ed_tower_file = os.path.join(os.path.dirname(ed_file), self.fst_vt['ElastoDyn']['TwrFile']) + self.read_ElastoDynTower(ed_tower_file) + + if self.fst_vt['Fst']['CompInflow'] == 1: + self.read_InflowWind() # AeroDyn version selection if self.fst_vt['Fst']['CompAero'] == 1: - self.read_AeroDyn14() + self.read_AeroDisk() elif self.fst_vt['Fst']['CompAero'] == 2: - self.read_AeroDyn15() + self.read_AeroDyn() if self.fst_vt['Fst']['CompServo'] == 1: self.read_ServoDyn() @@ -2527,12 +3166,20 @@ def execute(self): self.fst_vt['SStC'].append(self.read_StC(StC_file)) if ROSCO: self.read_DISCON_in() + if self.fst_vt['ServoDyn']['VSContrl'] == 3: # user-defined from routine UserVSCont refered + self.read_spd_trq('spd_trq.dat') hd_file = os.path.normpath(os.path.join(self.FAST_directory, self.fst_vt['Fst']['HydroFile'])) if os.path.isfile(hd_file): self.read_HydroDyn(hd_file) + ss_file = os.path.normpath(os.path.join(self.FAST_directory, self.fst_vt['Fst']['SeaStFile'])) + if os.path.isfile(ss_file): + self.read_SeaState(ss_file) sd_file = os.path.normpath(os.path.join(self.FAST_directory, self.fst_vt['Fst']['SubFile'])) if os.path.isfile(sd_file): - self.read_SubDyn(sd_file) + if self.fst_vt['Fst']['CompSub'] == 1: + self.read_SubDyn(sd_file) + elif self.fst_vt['Fst']['CompSub'] == 2: + self.read_ExtPtfm(sd_file) if self.fst_vt['Fst']['CompMooring'] == 1: # only MAP++ implemented for mooring models map_file = os.path.normpath(os.path.join(self.FAST_directory, self.fst_vt['Fst']['MooringFile'])) if os.path.isfile(map_file): @@ -2546,12 +3193,17 @@ def execute(self): self.read_BeamDyn(bd_file) if __name__=="__main__": + from openfast_io.FileTools import check_rtest_cloned - examples_dir = os.path.dirname( os.path.dirname( os.path.dirname( os.path.realpath(__file__) ) ) ) + os.sep + parent_dir = os.path.dirname( os.path.dirname( os.path.dirname( os.path.realpath(__file__) ) ) ) + os.sep + # Read the model fast = InputReader_OpenFAST() - fast.FAST_InputFile = 'IEA-15-240-RWT-UMaineSemi.fst' # FAST input file (ext=.fst) - fast.FAST_directory = os.path.join(examples_dir, 'examples', '01_aeroelasticse', - 'OpenFAST_models', 'IEA-15-240-RWT', - 'IEA-15-240-RWT-UMaineSemi') # Path to fst directory files - fast.execute() + fast.FAST_InputFile = '5MW_Land_BD_DLL_WTurb.fst' # FAST input file (ext=.fst) + fast.FAST_directory = os.path.join(parent_dir, 'reg_tests', 'r-test', + 'glue-codes', 'openfast', + '5MW_Land_BD_DLL_WTurb') # Path to fst directory files + + check_rtest_cloned(os.path.join(fast.FAST_directory)) + + fast.execute() \ No newline at end of file diff --git a/openfast_python/openfast_io/FAST_vars_out.py b/openfast_io/openfast_io/FAST_vars_out.py similarity index 71% rename from openfast_python/openfast_io/FAST_vars_out.py rename to openfast_io/openfast_io/FAST_vars_out.py index 196ca88bed..8b3ac85686 100644 --- a/openfast_python/openfast_io/FAST_vars_out.py +++ b/openfast_io/openfast_io/FAST_vars_out.py @@ -1,2139 +1,284 @@ """ Generated from FAST OutListParameters.xlsx files with AeroelasticSE/src/AeroelasticSE/Util/create_output_vars.py """ -""" ElastoDyn """ -ElastoDyn = {} - -# Blade 1 Tip Motions -ElastoDyn['TipDxc1'] = True # (m); Blade 1 out-of-plane tip deflection (relative to the undeflected position); Directed along the xc1-axis -ElastoDyn['OoPDefl1'] = False # (m); Blade 1 out-of-plane tip deflection (relative to the undeflected position); Directed along the xc1-axis -ElastoDyn['TipDyc1'] = True # (m); Blade 1 in-plane tip deflection (relative to the undeflected position); Directed along the yc1-axis -ElastoDyn['IPDefl1'] = False # (m); Blade 1 in-plane tip deflection (relative to the undeflected position); Directed along the yc1-axis -ElastoDyn['TipDzc1'] = True # (m); Blade 1 axial tip deflection (relative to the undeflected position); Directed along the zc1- and zb1-axes -ElastoDyn['TipDzb1'] = True # (m); Blade 1 axial tip deflection (relative to the undeflected position); Directed along the zc1- and zb1-axes -ElastoDyn['TipDxb1'] = True # (m); Blade 1 flapwise tip deflection (relative to the undeflected position); Directed along the xb1-axis -ElastoDyn['TipDyb1'] = True # (m); Blade 1 edgewise tip deflection (relative to the undeflected position); Directed along the yb1-axis -ElastoDyn['TipALxb1'] = False # (m/s^2); Blade 1 local flapwise tip acceleration (absolute); Directed along the local xb1-axis -ElastoDyn['TipALyb1'] = False # (m/s^2); Blade 1 local edgewise tip acceleration (absolute); Directed along the local yb1-axis -ElastoDyn['TipALzb1'] = False # (m/s^2); Blade 1 local axial tip acceleration (absolute); Directed along the local zb1-axis -ElastoDyn['TipRDxb1'] = False # (deg); Blade 1 roll (angular/rotational) tip deflection (relative to the undeflected position). In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the xb1-axis -ElastoDyn['RollDefl1'] = False # (deg); Blade 1 roll (angular/rotational) tip deflection (relative to the undeflected position). In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the xb1-axis -ElastoDyn['TipRDyb1'] = False # (deg); Blade 1 pitch (angular/rotational) tip deflection (relative to the undeflected position). In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the yb1-axis -ElastoDyn['PtchDefl1'] = False # (deg); Blade 1 pitch (angular/rotational) tip deflection (relative to the undeflected position). In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the yb1-axis -ElastoDyn['TipRDzc1'] = False # (deg); Blade 1 torsional tip deflection (relative to the undeflected position). This output will always be zero for FAST simulation results. Use it for examining blade torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. Please note that this output uses the opposite of the sign convention used for blade pitch angles.; About the zc1- and zb1-axes -ElastoDyn['TipRDzb1'] = False # (deg); Blade 1 torsional tip deflection (relative to the undeflected position). This output will always be zero for FAST simulation results. Use it for examining blade torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. Please note that this output uses the opposite of the sign convention used for blade pitch angles.; About the zc1- and zb1-axes -ElastoDyn['TwstDefl1'] = False # (deg); Blade 1 torsional tip deflection (relative to the undeflected position). This output will always be zero for FAST simulation results. Use it for examining blade torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. Please note that this output uses the opposite of the sign convention used for blade pitch angles.; About the zc1- and zb1-axes -ElastoDyn['TipClrnc1'] = False # (m); Blade 1 tip-to-tower clearance estimate. This is computed as the perpendicular distance from the yaw axis to the tip of blade 1 when the blade tip is below the yaw bearing. When the tip of blade 1 is above the yaw bearing, it is computed as the absolute distance from the yaw bearing to the blade tip. Please note that you should reduce this value by the tower radius to obtain the actual tower clearance.; N/A -ElastoDyn['TwrClrnc1'] = False # (m); Blade 1 tip-to-tower clearance estimate. This is computed as the perpendicular distance from the yaw axis to the tip of blade 1 when the blade tip is below the yaw bearing. When the tip of blade 1 is above the yaw bearing, it is computed as the absolute distance from the yaw bearing to the blade tip. Please note that you should reduce this value by the tower radius to obtain the actual tower clearance.; N/A -ElastoDyn['Tip2Twr1'] = False # (m); Blade 1 tip-to-tower clearance estimate. This is computed as the perpendicular distance from the yaw axis to the tip of blade 1 when the blade tip is below the yaw bearing. When the tip of blade 1 is above the yaw bearing, it is computed as the absolute distance from the yaw bearing to the blade tip. Please note that you should reduce this value by the tower radius to obtain the actual tower clearance.; N/A +""" AeroDyn """ +AeroDyn = {} -# Blade 2 Tip Motions -ElastoDyn['TipDxc2'] = True # (m); Blade 2 out-of-plane tip deflection (relative to the pitch axis); Directed along the xc2-axis -ElastoDyn['OoPDefl2'] = False # (m); Blade 2 out-of-plane tip deflection (relative to the pitch axis); Directed along the xc2-axis -ElastoDyn['TipDyc2'] = True # (m); Blade 2 in-plane tip deflection (relative to the pitch axis); Directed along the yc2-axis -ElastoDyn['IPDefl2'] = False # (m); Blade 2 in-plane tip deflection (relative to the pitch axis); Directed along the yc2-axis -ElastoDyn['TipDzc2'] = True # (m); Blade 2 axial tip deflection (relative to the pitch axis); Directed along the zc2- and zb2-axes -ElastoDyn['TipDzb2'] = True # (m); Blade 2 axial tip deflection (relative to the pitch axis); Directed along the zc2- and zb2-axes -ElastoDyn['TipDxb2'] = True # (m); Blade 2 flapwise tip deflection (relative to the pitch axis); Directed along the xb2-axis -ElastoDyn['TipDyb2'] = True # (m); Blade 2 edgewise tip deflection (relative to the pitch axis); Directed along the yb2-axis -ElastoDyn['TipALxb2'] = False # (m/s^2); Blade 2 local flapwise tip acceleration (absolute); Directed along the local xb2-axis -ElastoDyn['TipALyb2'] = False # (m/s^2); Blade 2 local edgewise tip acceleration (absolute); Directed along the local yb2-axis -ElastoDyn['TipALzb2'] = False # (m/s^2); Blade 2 local axial tip acceleration (absolute); Directed along the local zb2-axis -ElastoDyn['TipRDxb2'] = False # (deg); Blade 2 roll (angular/rotational) tip deflection (relative to the undeflected position). In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the xb2-axis -ElastoDyn['RollDefl2'] = False # (deg); Blade 2 roll (angular/rotational) tip deflection (relative to the undeflected position). In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the xb2-axis -ElastoDyn['TipRDyb2'] = False # (deg); Blade 2 pitch (angular/rotational) tip deflection (relative to the undeflected position). In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the yb2-axis -ElastoDyn['PtchDefl2'] = False # (deg); Blade 2 pitch (angular/rotational) tip deflection (relative to the undeflected position). In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the yb2-axis -ElastoDyn['TipRDzc2'] = False # (deg); Blade 2 torsional (angular/rotational) tip deflection (relative to the undeflected position). This output will always be zero for FAST simulation results. Use it for examining blade torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. Please note that this output uses the opposite of the sign convention used for blade pitch angles.; About the zc2- and zb2-axes -ElastoDyn['TipRDzb2'] = False # (deg); Blade 2 torsional (angular/rotational) tip deflection (relative to the undeflected position). This output will always be zero for FAST simulation results. Use it for examining blade torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. Please note that this output uses the opposite of the sign convention used for blade pitch angles.; About the zc2- and zb2-axes -ElastoDyn['TwstDefl2'] = False # (deg); Blade 2 torsional (angular/rotational) tip deflection (relative to the undeflected position). This output will always be zero for FAST simulation results. Use it for examining blade torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. Please note that this output uses the opposite of the sign convention used for blade pitch angles.; About the zc2- and zb2-axes -ElastoDyn['TipClrnc2'] = False # (m); Blade 2 tip-to-tower clearance estimate. This is computed as the perpendicular distance from the yaw axis to the tip of blade 1 when the blade tip is below the yaw bearing. When the tip of blade 1 is above the yaw bearing, it is computed as the absolute distance from the yaw bearing to the blade tip. Please note that you should reduce this value by the tower radius to obtain the actual tower clearance.; N/A -ElastoDyn['TwrClrnc2'] = False # (m); Blade 2 tip-to-tower clearance estimate. This is computed as the perpendicular distance from the yaw axis to the tip of blade 1 when the blade tip is below the yaw bearing. When the tip of blade 1 is above the yaw bearing, it is computed as the absolute distance from the yaw bearing to the blade tip. Please note that you should reduce this value by the tower radius to obtain the actual tower clearance.; N/A -ElastoDyn['Tip2Twr2'] = False # (m); Blade 2 tip-to-tower clearance estimate. This is computed as the perpendicular distance from the yaw axis to the tip of blade 1 when the blade tip is below the yaw bearing. When the tip of blade 1 is above the yaw bearing, it is computed as the absolute distance from the yaw bearing to the blade tip. Please note that you should reduce this value by the tower radius to obtain the actual tower clearance.; N/A +# Tower +AeroDyn['TwN1VUndx'] = False # (m/s); Undisturbed x-component wind velocity at Tw node 1; local tower coordinate system +AeroDyn['TwN1VUndy'] = False # (m/s); Undisturbed y-component wind velocity at Tw node 1; local tower coordinate system +AeroDyn['TwN1VUndz'] = False # (m/s); Undisturbed z-component wind velocity at Tw node 1; local tower coordinate system +AeroDyn['TwN2VUndx'] = False # (m/s); Undisturbed x-component wind velocity at Tw node 2; local tower coordinate system +AeroDyn['TwN2VUndy'] = False # (m/s); Undisturbed y-component wind velocity at Tw node 2; local tower coordinate system +AeroDyn['TwN2VUndz'] = False # (m/s); Undisturbed z-component wind velocity at Tw node 2; local tower coordinate system +AeroDyn['TwN3VUndx'] = False # (m/s); Undisturbed x-component wind velocity at Tw node 3; local tower coordinate system +AeroDyn['TwN3VUndy'] = False # (m/s); Undisturbed y-component wind velocity at Tw node 3; local tower coordinate system +AeroDyn['TwN3VUndz'] = False # (m/s); Undisturbed z-component wind velocity at Tw node 3; local tower coordinate system +AeroDyn['TwN4VUndx'] = False # (m/s); Undisturbed x-component wind velocity at Tw node 4; local tower coordinate system +AeroDyn['TwN4VUndy'] = False # (m/s); Undisturbed y-component wind velocity at Tw node 4; local tower coordinate system +AeroDyn['TwN4VUndz'] = False # (m/s); Undisturbed z-component wind velocity at Tw node 4; local tower coordinate system +AeroDyn['TwN5VUndx'] = False # (m/s); Undisturbed x-component wind velocity at Tw node 5; local tower coordinate system +AeroDyn['TwN5VUndy'] = False # (m/s); Undisturbed y-component wind velocity at Tw node 5; local tower coordinate system +AeroDyn['TwN5VUndz'] = False # (m/s); Undisturbed z-component wind velocity at Tw node 5; local tower coordinate system +AeroDyn['TwN6VUndx'] = False # (m/s); Undisturbed x-component wind velocity at Tw node 6; local tower coordinate system +AeroDyn['TwN6VUndy'] = False # (m/s); Undisturbed y-component wind velocity at Tw node 6; local tower coordinate system +AeroDyn['TwN6VUndz'] = False # (m/s); Undisturbed z-component wind velocity at Tw node 6; local tower coordinate system +AeroDyn['TwN7VUndx'] = False # (m/s); Undisturbed x-component wind velocity at Tw node 7; local tower coordinate system +AeroDyn['TwN7VUndy'] = False # (m/s); Undisturbed y-component wind velocity at Tw node 7; local tower coordinate system +AeroDyn['TwN7VUndz'] = False # (m/s); Undisturbed z-component wind velocity at Tw node 7; local tower coordinate system +AeroDyn['TwN8VUndx'] = False # (m/s); Undisturbed x-component wind velocity at Tw node 8; local tower coordinate system +AeroDyn['TwN8VUndy'] = False # (m/s); Undisturbed y-component wind velocity at Tw node 8; local tower coordinate system +AeroDyn['TwN8VUndz'] = False # (m/s); Undisturbed z-component wind velocity at Tw node 8; local tower coordinate system +AeroDyn['TwN9VUndx'] = False # (m/s); Undisturbed x-component wind velocity at Tw node 9; local tower coordinate system +AeroDyn['TwN9VUndy'] = False # (m/s); Undisturbed y-component wind velocity at Tw node 9; local tower coordinate system +AeroDyn['TwN9VUndz'] = False # (m/s); Undisturbed z-component wind velocity at Tw node 9; local tower coordinate system +AeroDyn['TwN1STVx'] = False # (m/s); Structural translational velocity x-component at Tw node 1; local tower coordinate system +AeroDyn['TwN1STVy'] = False # (m/s); Structural translational velocity y-component at Tw node 1; local tower coordinate system +AeroDyn['TwN1STVz'] = False # (m/s); Structural translational velocity z-component at Tw node 1; local tower coordinate system +AeroDyn['TwN2STVx'] = False # (m/s); Structural translational velocity x-component at Tw node 2; local tower coordinate system +AeroDyn['TwN2STVy'] = False # (m/s); Structural translational velocity y-component at Tw node 2; local tower coordinate system +AeroDyn['TwN2STVz'] = False # (m/s); Structural translational velocity z-component at Tw node 2; local tower coordinate system +AeroDyn['TwN3STVx'] = False # (m/s); Structural translational velocity x-component at Tw node 3; local tower coordinate system +AeroDyn['TwN3STVy'] = False # (m/s); Structural translational velocity y-component at Tw node 3; local tower coordinate system +AeroDyn['TwN3STVz'] = False # (m/s); Structural translational velocity z-component at Tw node 3; local tower coordinate system +AeroDyn['TwN4STVx'] = False # (m/s); Structural translational velocity x-component at Tw node 4; local tower coordinate system +AeroDyn['TwN4STVy'] = False # (m/s); Structural translational velocity y-component at Tw node 4; local tower coordinate system +AeroDyn['TwN4STVz'] = False # (m/s); Structural translational velocity z-component at Tw node 4; local tower coordinate system +AeroDyn['TwN5STVx'] = False # (m/s); Structural translational velocity x-component at Tw node 5; local tower coordinate system +AeroDyn['TwN5STVy'] = False # (m/s); Structural translational velocity y-component at Tw node 5; local tower coordinate system +AeroDyn['TwN5STVz'] = False # (m/s); Structural translational velocity z-component at Tw node 5; local tower coordinate system +AeroDyn['TwN6STVx'] = False # (m/s); Structural translational velocity x-component at Tw node 6; local tower coordinate system +AeroDyn['TwN6STVy'] = False # (m/s); Structural translational velocity y-component at Tw node 6; local tower coordinate system +AeroDyn['TwN6STVz'] = False # (m/s); Structural translational velocity z-component at Tw node 6; local tower coordinate system +AeroDyn['TwN7STVx'] = False # (m/s); Structural translational velocity x-component at Tw node 7; local tower coordinate system +AeroDyn['TwN7STVy'] = False # (m/s); Structural translational velocity y-component at Tw node 7; local tower coordinate system +AeroDyn['TwN7STVz'] = False # (m/s); Structural translational velocity z-component at Tw node 7; local tower coordinate system +AeroDyn['TwN8STVx'] = False # (m/s); Structural translational velocity x-component at Tw node 8; local tower coordinate system +AeroDyn['TwN8STVy'] = False # (m/s); Structural translational velocity y-component at Tw node 8; local tower coordinate system +AeroDyn['TwN8STVz'] = False # (m/s); Structural translational velocity z-component at Tw node 8; local tower coordinate system +AeroDyn['TwN9STVx'] = False # (m/s); Structural translational velocity x-component at Tw node 9; local tower coordinate system +AeroDyn['TwN9STVy'] = False # (m/s); Structural translational velocity y-component at Tw node 9; local tower coordinate system +AeroDyn['TwN9STVz'] = False # (m/s); Structural translational velocity z-component at Tw node 9; local tower coordinate system +AeroDyn['TwN1Vrel'] = False # (m/s); Relative wind speed at Tw node 1; +AeroDyn['TwN2Vrel'] = False # (m/s); Relative wind speed at Tw node 2; +AeroDyn['TwN3Vrel'] = False # (m/s); Relative wind speed at Tw node 3; +AeroDyn['TwN4Vrel'] = False # (m/s); Relative wind speed at Tw node 4; +AeroDyn['TwN5Vrel'] = False # (m/s); Relative wind speed at Tw node 5; +AeroDyn['TwN6Vrel'] = False # (m/s); Relative wind speed at Tw node 6; +AeroDyn['TwN7Vrel'] = False # (m/s); Relative wind speed at Tw node 7; +AeroDyn['TwN8Vrel'] = False # (m/s); Relative wind speed at Tw node 8; +AeroDyn['TwN9Vrel'] = False # (m/s); Relative wind speed at Tw node 9; +AeroDyn['TwN1DynP'] = False # (Pa); Dynamic Pressure at Tw node 1; +AeroDyn['TwN2DynP'] = False # (Pa); Dynamic Pressure at Tw node 2; +AeroDyn['TwN3DynP'] = False # (Pa); Dynamic Pressure at Tw node 3; +AeroDyn['TwN4DynP'] = False # (Pa); Dynamic Pressure at Tw node 4; +AeroDyn['TwN5DynP'] = False # (Pa); Dynamic Pressure at Tw node 5; +AeroDyn['TwN6DynP'] = False # (Pa); Dynamic Pressure at Tw node 6; +AeroDyn['TwN7DynP'] = False # (Pa); Dynamic Pressure at Tw node 7; +AeroDyn['TwN8DynP'] = False # (Pa); Dynamic Pressure at Tw node 8; +AeroDyn['TwN9DynP'] = False # (Pa); Dynamic Pressure at Tw node 9; +AeroDyn['TwN1Re'] = False # (-); Reynolds number (in millions) at Tw node 1; +AeroDyn['TwN2Re'] = False # (-); Reynolds number (in millions) at Tw node 2; +AeroDyn['TwN3Re'] = False # (-); Reynolds number (in millions) at Tw node 3; +AeroDyn['TwN4Re'] = False # (-); Reynolds number (in millions) at Tw node 4; +AeroDyn['TwN5Re'] = False # (-); Reynolds number (in millions) at Tw node 5; +AeroDyn['TwN6Re'] = False # (-); Reynolds number (in millions) at Tw node 6; +AeroDyn['TwN7Re'] = False # (-); Reynolds number (in millions) at Tw node 7; +AeroDyn['TwN8Re'] = False # (-); Reynolds number (in millions) at Tw node 8; +AeroDyn['TwN9Re'] = False # (-); Reynolds number (in millions) at Tw node 9; +AeroDyn['TwN1M'] = False # (-); Mach number at Tw node 1; +AeroDyn['TwN2M'] = False # (-); Mach number at Tw node 2; +AeroDyn['TwN3M'] = False # (-); Mach number at Tw node 3; +AeroDyn['TwN4M'] = False # (-); Mach number at Tw node 4; +AeroDyn['TwN5M'] = False # (-); Mach number at Tw node 5; +AeroDyn['TwN6M'] = False # (-); Mach number at Tw node 6; +AeroDyn['TwN7M'] = False # (-); Mach number at Tw node 7; +AeroDyn['TwN8M'] = False # (-); Mach number at Tw node 8; +AeroDyn['TwN9M'] = False # (-); Mach number at Tw node 9; +AeroDyn['TwN1Fdx'] = False # (N/m); x-component of drag force per unit length at Tw node 1; local tower coordinate system +AeroDyn['TwN2Fdx'] = False # (N/m); x-component of drag force per unit length at Tw node 2; local tower coordinate system +AeroDyn['TwN3Fdx'] = False # (N/m); x-component of drag force per unit length at Tw node 3; local tower coordinate system +AeroDyn['TwN4Fdx'] = False # (N/m); x-component of drag force per unit length at Tw node 4; local tower coordinate system +AeroDyn['TwN5Fdx'] = False # (N/m); x-component of drag force per unit length at Tw node 5; local tower coordinate system +AeroDyn['TwN6Fdx'] = False # (N/m); x-component of drag force per unit length at Tw node 6; local tower coordinate system +AeroDyn['TwN7Fdx'] = False # (N/m); x-component of drag force per unit length at Tw node 7; local tower coordinate system +AeroDyn['TwN8Fdx'] = False # (N/m); x-component of drag force per unit length at Tw node 8; local tower coordinate system +AeroDyn['TwN9Fdx'] = False # (N/m); x-component of drag force per unit length at Tw node 9; local tower coordinate system +AeroDyn['TwN1Fdy'] = False # (N/m); y-component of drag force per unit length at Tw node 1; local tower coordinate system +AeroDyn['TwN2Fdy'] = False # (N/m); y-component of drag force per unit length at Tw node 2; local tower coordinate system +AeroDyn['TwN3Fdy'] = False # (N/m); y-component of drag force per unit length at Tw node 3; local tower coordinate system +AeroDyn['TwN4Fdy'] = False # (N/m); y-component of drag force per unit length at Tw node 4; local tower coordinate system +AeroDyn['TwN5Fdy'] = False # (N/m); y-component of drag force per unit length at Tw node 5; local tower coordinate system +AeroDyn['TwN6Fdy'] = False # (N/m); y-component of drag force per unit length at Tw node 6; local tower coordinate system +AeroDyn['TwN7Fdy'] = False # (N/m); y-component of drag force per unit length at Tw node 7; local tower coordinate system +AeroDyn['TwN8Fdy'] = False # (N/m); y-component of drag force per unit length at Tw node 8; local tower coordinate system +AeroDyn['TwN9Fdy'] = False # (N/m); y-component of drag force per unit length at Tw node 9; local tower coordinate system +AeroDyn['TwN1Fbx'] = False # (N/m); x-component of buoyant force per unit length at Tw node 1; local tower coordinate system +AeroDyn['TwN2Fbx'] = False # (N/m); x-component of buoyant force per unit length at Tw node 2; local tower coordinate system +AeroDyn['TwN3Fbx'] = False # (N/m); x-component of buoyant force per unit length at Tw node 3; local tower coordinate system +AeroDyn['TwN4Fbx'] = False # (N/m); x-component of buoyant force per unit length at Tw node 4; local tower coordinate system +AeroDyn['TwN5Fbx'] = False # (N/m); x-component of buoyant force per unit length at Tw node 5; local tower coordinate system +AeroDyn['TwN6Fbx'] = False # (N/m); x-component of buoyant force per unit length at Tw node 6; local tower coordinate system +AeroDyn['TwN7Fbx'] = False # (N/m); x-component of buoyant force per unit length at Tw node 7; local tower coordinate system +AeroDyn['TwN8Fbx'] = False # (N/m); x-component of buoyant force per unit length at Tw node 8; local tower coordinate system +AeroDyn['TwN9Fbx'] = False # (N/m); x-component of buoyant force per unit length at Tw node 9; local tower coordinate system +AeroDyn['TwN1Fby'] = False # (N/m); y-component of buoyant force per unit length at Tw node 1; local tower coordinate system +AeroDyn['TwN2Fby'] = False # (N/m); y-component of buoyant force per unit length at Tw node 2; local tower coordinate system +AeroDyn['TwN3Fby'] = False # (N/m); y-component of buoyant force per unit length at Tw node 3; local tower coordinate system +AeroDyn['TwN4Fby'] = False # (N/m); y-component of buoyant force per unit length at Tw node 4; local tower coordinate system +AeroDyn['TwN5Fby'] = False # (N/m); y-component of buoyant force per unit length at Tw node 5; local tower coordinate system +AeroDyn['TwN6Fby'] = False # (N/m); y-component of buoyant force per unit length at Tw node 6; local tower coordinate system +AeroDyn['TwN7Fby'] = False # (N/m); y-component of buoyant force per unit length at Tw node 7; local tower coordinate system +AeroDyn['TwN8Fby'] = False # (N/m); y-component of buoyant force per unit length at Tw node 8; local tower coordinate system +AeroDyn['TwN9Fby'] = False # (N/m); y-component of buoyant force per unit length at Tw node 9; local tower coordinate system +AeroDyn['TwN1Fbz'] = False # (N/m); z-component of buoyant force per unit length at Tw node 1; local tower coordinate system +AeroDyn['TwN2Fbz'] = False # (N/m); z-component of buoyant force per unit length at Tw node 2; local tower coordinate system +AeroDyn['TwN3Fbz'] = False # (N/m); z-component of buoyant force per unit length at Tw node 3; local tower coordinate system +AeroDyn['TwN4Fbz'] = False # (N/m); z-component of buoyant force per unit length at Tw node 4; local tower coordinate system +AeroDyn['TwN5Fbz'] = False # (N/m); z-component of buoyant force per unit length at Tw node 5; local tower coordinate system +AeroDyn['TwN6Fbz'] = False # (N/m); z-component of buoyant force per unit length at Tw node 6; local tower coordinate system +AeroDyn['TwN7Fbz'] = False # (N/m); z-component of buoyant force per unit length at Tw node 7; local tower coordinate system +AeroDyn['TwN8Fbz'] = False # (N/m); z-component of buoyant force per unit length at Tw node 8; local tower coordinate system +AeroDyn['TwN9Fbz'] = False # (N/m); z-component of buoyant force per unit length at Tw node 9; local tower coordinate system +AeroDyn['TwN1Mbx'] = False # (N-m/m); x-component of buoyant moment per unit length at Tw node 1; local tower coordinate system +AeroDyn['TwN2Mbx'] = False # (N-m/m); x-component of buoyant moment per unit length at Tw node 2; local tower coordinate system +AeroDyn['TwN3Mbx'] = False # (N-m/m); x-component of buoyant moment per unit length at Tw node 3; local tower coordinate system +AeroDyn['TwN4Mbx'] = False # (N-m/m); x-component of buoyant moment per unit length at Tw node 4; local tower coordinate system +AeroDyn['TwN5Mbx'] = False # (N-m/m); x-component of buoyant moment per unit length at Tw node 5; local tower coordinate system +AeroDyn['TwN6Mbx'] = False # (N-m/m); x-component of buoyant moment per unit length at Tw node 6; local tower coordinate system +AeroDyn['TwN7Mbx'] = False # (N-m/m); x-component of buoyant moment per unit length at Tw node 7; local tower coordinate system +AeroDyn['TwN8Mbx'] = False # (N-m/m); x-component of buoyant moment per unit length at Tw node 8; local tower coordinate system +AeroDyn['TwN9Mbx'] = False # (N-m/m); x-component of buoyant moment per unit length at Tw node 9; local tower coordinate system +AeroDyn['TwN1Mby'] = False # (N-m/m); y-component of buoyant moment per unit length at Tw node 1; local tower coordinate system +AeroDyn['TwN2Mby'] = False # (N-m/m); y-component of buoyant moment per unit length at Tw node 2; local tower coordinate system +AeroDyn['TwN3Mby'] = False # (N-m/m); y-component of buoyant moment per unit length at Tw node 3; local tower coordinate system +AeroDyn['TwN4Mby'] = False # (N-m/m); y-component of buoyant moment per unit length at Tw node 4; local tower coordinate system +AeroDyn['TwN5Mby'] = False # (N-m/m); y-component of buoyant moment per unit length at Tw node 5; local tower coordinate system +AeroDyn['TwN6Mby'] = False # (N-m/m); y-component of buoyant moment per unit length at Tw node 6; local tower coordinate system +AeroDyn['TwN7Mby'] = False # (N-m/m); y-component of buoyant moment per unit length at Tw node 7; local tower coordinate system +AeroDyn['TwN8Mby'] = False # (N-m/m); y-component of buoyant moment per unit length at Tw node 8; local tower coordinate system +AeroDyn['TwN9Mby'] = False # (N-m/m); y-component of buoyant moment per unit length at Tw node 9; local tower coordinate system +AeroDyn['TwN1Mbz'] = False # (N-m/m); z-component of buoyant moment per unit length at Tw node 1; local tower coordinate system +AeroDyn['TwN2Mbz'] = False # (N-m/m); z-component of buoyant moment per unit length at Tw node 2; local tower coordinate system +AeroDyn['TwN3Mbz'] = False # (N-m/m); z-component of buoyant moment per unit length at Tw node 3; local tower coordinate system +AeroDyn['TwN4Mbz'] = False # (N-m/m); z-component of buoyant moment per unit length at Tw node 4; local tower coordinate system +AeroDyn['TwN5Mbz'] = False # (N-m/m); z-component of buoyant moment per unit length at Tw node 5; local tower coordinate system +AeroDyn['TwN6Mbz'] = False # (N-m/m); z-component of buoyant moment per unit length at Tw node 6; local tower coordinate system +AeroDyn['TwN7Mbz'] = False # (N-m/m); z-component of buoyant moment per unit length at Tw node 7; local tower coordinate system +AeroDyn['TwN8Mbz'] = False # (N-m/m); z-component of buoyant moment per unit length at Tw node 8; local tower coordinate system +AeroDyn['TwN9Mbz'] = False # (N-m/m); z-component of buoyant moment per unit length at Tw node 9; local tower coordinate system -# Blade 3 Tip Motions -ElastoDyn['TipDxc3'] = True # (m); Blade 3 out-of-plane tip deflection (relative to the pitch axis); Directed along the xc3-axis -ElastoDyn['OoPDefl3'] = False # (m); Blade 3 out-of-plane tip deflection (relative to the pitch axis); Directed along the xc3-axis -ElastoDyn['TipDyc3'] = True # (m); Blade 3 in-plane tip deflection (relative to the pitch axis); Directed along the yc3-axis -ElastoDyn['IPDefl3'] = False # (m); Blade 3 in-plane tip deflection (relative to the pitch axis); Directed along the yc3-axis -ElastoDyn['TipDzc3'] = True # (m); Blade 3 axial tip deflection (relative to the pitch axis); Directed along the zc3- and zb3-axes -ElastoDyn['TipDzb3'] = True # (m); Blade 3 axial tip deflection (relative to the pitch axis); Directed along the zc3- and zb3-axes -ElastoDyn['TipDxb3'] = True # (m); Blade 3 flapwise tip deflection (relative to the pitch axis); Directed along the xb3-axis -ElastoDyn['TipDyb3'] = True # (m); Blade 3 edgewise tip deflection (relative to the pitch axis); Directed along the yb3-axis -ElastoDyn['TipALxb3'] = False # (m/s^2); Blade 3 local flapwise tip acceleration (absolute); Directed along the local xb3-axis -ElastoDyn['TipALyb3'] = False # (m/s^2); Blade 3 local edgewise tip acceleration (absolute); Directed along the local yb3-axis -ElastoDyn['TipALzb3'] = False # (m/s^2); Blade 3 local axial tip acceleration (absolute); Directed along the local zb3-axis -ElastoDyn['TipRDxb3'] = False # (deg); Blade 3 roll (angular/rotational) tip deflection (relative to the undeflected position). In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the xb3-axis -ElastoDyn['RollDefl3'] = False # (deg); Blade 3 roll (angular/rotational) tip deflection (relative to the undeflected position). In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the xb3-axis -ElastoDyn['TipRDyb3'] = False # (deg); Blade 3 pitch (angular/rotational) tip deflection (relative to the undeflected position). In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the yb3-axis -ElastoDyn['PtchDefl3'] = False # (deg); Blade 3 pitch (angular/rotational) tip deflection (relative to the undeflected position). In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the yb3-axis -ElastoDyn['TipRDzc3'] = False # (deg); Blade 3 torsional tip deflection (relative to the undeflected position). This output will always be zero for FAST simulation results. Use it for examining blade torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. Please note that this output uses the opposite of the sign convention used for blade pitch angles.; About the zc3- and zb3-axes -ElastoDyn['TipRDzb3'] = False # (deg); Blade 3 torsional tip deflection (relative to the undeflected position). This output will always be zero for FAST simulation results. Use it for examining blade torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. Please note that this output uses the opposite of the sign convention used for blade pitch angles.; About the zc3- and zb3-axes -ElastoDyn['TwstDefl3'] = False # (deg); Blade 3 torsional tip deflection (relative to the undeflected position). This output will always be zero for FAST simulation results. Use it for examining blade torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. Please note that this output uses the opposite of the sign convention used for blade pitch angles.; About the zc3- and zb3-axes -ElastoDyn['TipClrnc3'] = False # (m); Blade 3 tip-to-tower clearance estimate. This is computed as the perpendicular distance from the yaw axis to the tip of blade 1 when the blade tip is below the yaw bearing. When the tip of blade 1 is above the yaw bearing, it is computed as the absolute distance from the yaw bearing to the blade tip. Please note that you should reduce this value by the tower radius to obtain the actual tower clearance.; N/A -ElastoDyn['TwrClrnc3'] = False # (m); Blade 3 tip-to-tower clearance estimate. This is computed as the perpendicular distance from the yaw axis to the tip of blade 1 when the blade tip is below the yaw bearing. When the tip of blade 1 is above the yaw bearing, it is computed as the absolute distance from the yaw bearing to the blade tip. Please note that you should reduce this value by the tower radius to obtain the actual tower clearance.; N/A -ElastoDyn['Tip2Twr3'] = False # (m); Blade 3 tip-to-tower clearance estimate. This is computed as the perpendicular distance from the yaw axis to the tip of blade 1 when the blade tip is below the yaw bearing. When the tip of blade 1 is above the yaw bearing, it is computed as the absolute distance from the yaw bearing to the blade tip. Please note that you should reduce this value by the tower radius to obtain the actual tower clearance.; N/A - -# Blade 1 Local Span Motions -ElastoDyn['Spn1ALxb1'] = False # (m/s^2); Blade 1 local flapwise acceleration (absolute) of span station 1; Directed along the local xb1-axis -ElastoDyn['Spn1ALyb1'] = False # (m/s^2); Blade 1 local edgewise acceleration (absolute) of span station 1; Directed along the local yb1-axis -ElastoDyn['Spn1ALzb1'] = False # (m/s^2); Blade 1 local axial acceleration (absolute) of span station 1; Directed along the local zb1-axis -ElastoDyn['Spn2ALxb1'] = False # (m/s^2); Blade 1 local flapwise acceleration (absolute) of span station 2; Directed along the local xb1-axis -ElastoDyn['Spn2ALyb1'] = False # (m/s^2); Blade 1 local edgewise acceleration (absolute) of span station 2; Directed along the local yb1-axis -ElastoDyn['Spn2ALzb1'] = False # (m/s^2); Blade 1 local axial acceleration (absolute) of span station 2; Directed along the local zb1-axis -ElastoDyn['Spn3ALxb1'] = False # (m/s^2); Blade 1 local flapwise acceleration (absolute) of span station 3; Directed along the local xb1-axis -ElastoDyn['Spn3ALyb1'] = False # (m/s^2); Blade 1 local edgewise acceleration (absolute) of span station 3; Directed along the local yb1-axis -ElastoDyn['Spn3ALzb1'] = False # (m/s^2); Blade 1 local axial acceleration (absolute) of span station 3; Directed along the local zb1-axis -ElastoDyn['Spn4ALxb1'] = False # (m/s^2); Blade 1 local flapwise acceleration (absolute) of span station 4; Directed along the local xb1-axis -ElastoDyn['Spn4ALyb1'] = False # (m/s^2); Blade 1 local edgewise acceleration (absolute) of span station 4; Directed along the local yb1-axis -ElastoDyn['Spn4ALzb1'] = False # (m/s^2); Blade 1 local axial acceleration (absolute) of span station 4; Directed along the local zb1-axis -ElastoDyn['Spn5ALxb1'] = False # (m/s^2); Blade 1 local flapwise acceleration (absolute) of span station 5; Directed along the local xb1-axis -ElastoDyn['Spn5ALyb1'] = False # (m/s^2); Blade 1 local edgewise acceleration (absolute) of span station 5; Directed along the local yb1-axis -ElastoDyn['Spn5ALzb1'] = False # (m/s^2); Blade 1 local axial acceleration (absolute) of span station 5; Directed along the local zb1-axis -ElastoDyn['Spn6ALxb1'] = False # (m/s^2); Blade 1 local flapwise acceleration (absolute) of span station 6; Directed along the local xb1-axis -ElastoDyn['Spn6ALyb1'] = False # (m/s^2); Blade 1 local edgewise acceleration (absolute) of span station 6; Directed along the local yb1-axis -ElastoDyn['Spn6ALzb1'] = False # (m/s^2); Blade 1 local axial acceleration (absolute) of span station 6; Directed along the local zb1-axis -ElastoDyn['Spn7ALxb1'] = False # (m/s^2); Blade 1 local flapwise acceleration (absolute) of span station 7; Directed along the local xb1-axis -ElastoDyn['Spn7ALyb1'] = False # (m/s^2); Blade 1 local edgewise acceleration (absolute) of span station 7; Directed along the local yb1-axis -ElastoDyn['Spn7ALzb1'] = False # (m/s^2); Blade 1 local axial acceleration (absolute) of span station 7; Directed along the local zb1-axis -ElastoDyn['Spn8ALxb1'] = False # (m/s^2); Blade 1 local flapwise acceleration (absolute) of span station 8; Directed along the local xb1-axis -ElastoDyn['Spn8ALyb1'] = False # (m/s^2); Blade 1 local edgewise acceleration (absolute) of span station 8; Directed along the local yb1-axis -ElastoDyn['Spn8ALzb1'] = False # (m/s^2); Blade 1 local axial acceleration (absolute) of span station 8; Directed along the local zb1-axis -ElastoDyn['Spn9ALxb1'] = False # (m/s^2); Blade 1 local flapwise acceleration (absolute) of span station 9; Directed along the local xb1-axis -ElastoDyn['Spn9ALyb1'] = False # (m/s^2); Blade 1 local edgewise acceleration (absolute) of span station 9; Directed along the local yb1-axis -ElastoDyn['Spn9ALzb1'] = False # (m/s^2); Blade 1 local axial acceleration (absolute) of span station 9; Directed along the local zb1-axis -ElastoDyn['Spn1TDxb1'] = False # (m); Blade 1 local flapwise (translational) deflection (relative to the undeflected position) of span station 1; Directed along the xb1-axis -ElastoDyn['Spn1TDyb1'] = False # (m); Blade 1 local edgewise (translational) deflection (relative to the undeflected position) of span station 1; Directed along the yb1-axis -ElastoDyn['Spn1TDzb1'] = False # (m); Blade 1 local axial (translational) deflection (relative to the undeflected position) of span station 1; Directed along the zb1-axis -ElastoDyn['Spn2TDxb1'] = False # (m); Blade 1 local flapwise (translational) deflection (relative to the undeflected position) of span station 2; Directed along the xb1-axis -ElastoDyn['Spn2TDyb1'] = False # (m); Blade 1 local edgewise (translational) deflection (relative to the undeflected position) of span station 2; Directed along the yb1-axis -ElastoDyn['Spn2TDzb1'] = False # (m); Blade 1 local axial (translational) deflection (relative to the undeflected position) of span station 2; Directed along the zb1-axis -ElastoDyn['Spn3TDxb1'] = False # (m); Blade 1 local flapwise (translational) deflection (relative to the undeflected position) of span station 3; Directed along the xb1-axis -ElastoDyn['Spn3TDyb1'] = False # (m); Blade 1 local edgewise (translational) deflection (relative to the undeflected position) of span station 3; Directed along the yb1-axis -ElastoDyn['Spn3TDzb1'] = False # (m); Blade 1 local axial (translational) deflection (relative to the undeflected position) of span station 3; Directed along the zb1-axis -ElastoDyn['Spn4TDxb1'] = False # (m); Blade 1 local flapwise (translational) deflection (relative to the undeflected position) of span station 4; Directed along the xb1-axis -ElastoDyn['Spn4TDyb1'] = False # (m); Blade 1 local edgewise (translational) deflection (relative to the undeflected position) of span station 4; Directed along the yb1-axis -ElastoDyn['Spn4TDzb1'] = False # (m); Blade 1 local axial (translational) deflection (relative to the undeflected position) of span station 4; Directed along the zb1-axis -ElastoDyn['Spn5TDxb1'] = False # (m); Blade 1 local flapwise (translational) deflection (relative to the undeflected position) of span station 5; Directed along the xb1-axis -ElastoDyn['Spn5TDyb1'] = False # (m); Blade 1 local edgewise (translational) deflection (relative to the undeflected position) of span station 5; Directed along the yb1-axis -ElastoDyn['Spn5TDzb1'] = False # (m); Blade 1 local axial (translational) deflection (relative to the undeflected position) of span station 5; Directed along the zb1-axis -ElastoDyn['Spn6TDxb1'] = False # (m); Blade 1 local flapwise (translational) deflection (relative to the undeflected position) of span station 6; Directed along the xb1-axis -ElastoDyn['Spn6TDyb1'] = False # (m); Blade 1 local edgewise (translational) deflection (relative to the undeflected position) of span station 6; Directed along the yb1-axis -ElastoDyn['Spn6TDzb1'] = False # (m); Blade 1 local axial (translational) deflection (relative to the undeflected position) of span station 6; Directed along the zb1-axis -ElastoDyn['Spn7TDxb1'] = False # (m); Blade 1 local flapwise (translational) deflection (relative to the undeflected position) of span station 7; Directed along the xb1-axis -ElastoDyn['Spn7TDyb1'] = False # (m); Blade 1 local edgewise (translational) deflection (relative to the undeflected position) of span station 7; Directed along the yb1-axis -ElastoDyn['Spn7TDzb1'] = False # (m); Blade 1 local axial (translational) deflection (relative to the undeflected position) of span station 7; Directed along the zb1-axis -ElastoDyn['Spn8TDxb1'] = False # (m); Blade 1 local flapwise (translational) deflection (relative to the undeflected position) of span station 8; Directed along the xb1-axis -ElastoDyn['Spn8TDyb1'] = False # (m); Blade 1 local edgewise (translational) deflection (relative to the undeflected position) of span station 8; Directed along the yb1-axis -ElastoDyn['Spn8TDzb1'] = False # (m); Blade 1 local axial (translational) deflection (relative to the undeflected position) of span station 8; Directed along the zb1-axis -ElastoDyn['Spn9TDxb1'] = False # (m); Blade 1 local flapwise (translational) deflection (relative to the undeflected position) of span station 9; Directed along the xb1-axis -ElastoDyn['Spn9TDyb1'] = False # (m); Blade 1 local edgewise (translational) deflection (relative to the undeflected position) of span station 9; Directed along the yb1-axis -ElastoDyn['Spn9TDzb1'] = False # (m); Blade 1 local axial (translational) deflection (relative to the undeflected position) of span station 9; Directed along the zb1-axis -ElastoDyn['Spn1RDxb1'] = False # (deg); Blade 1 local roll (angular/rotational) deflection (relative to the undeflected position) of span station 1. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local xb1-axis -ElastoDyn['Spn1RDyb1'] = False # (deg); Blade 1 local pitch (angular/rotational) deflection (relative to the undeflected position) of span station 1. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local yb1-axis -ElastoDyn['Spn1RDzb1'] = False # (deg); Blade 1 local torsional (angular/rotational) deflection (relative to the undeflected position) of span station 1. This output will always be zero for FAST simulation results. Use it for examining blade torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. Please note that this output uses the opposite of the sign convention used for blade pitch angles.; About the local zb1-axis -ElastoDyn['Spn2RDxb1'] = False # (deg); Blade 1 local roll (angular/rotational) deflection (relative to the undeflected position) of span station 2. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local xb1-axis -ElastoDyn['Spn2RDyb1'] = False # (deg); Blade 1 local pitch (angular/rotational) deflection (relative to the undeflected position) of span station 2. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local yb1-axis -ElastoDyn['Spn2RDzb1'] = False # (deg); Blade 1 local torsional (angular/rotational) deflection (relative to the undeflected position) of span station 2. This output will always be zero for FAST simulation results. Use it for examining blade torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. Please note that this output uses the opposite of the sign convention used for blade pitch angles.; About the local zb1-axis -ElastoDyn['Spn3RDxb1'] = False # (deg); Blade 1 local roll (angular/rotational) deflection (relative to the undeflected position) of span station 3. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local xb1-axis -ElastoDyn['Spn3RDyb1'] = False # (deg); Blade 1 local pitch (angular/rotational) deflection (relative to the undeflected position) of span station 3. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local yb1-axis -ElastoDyn['Spn3RDzb1'] = False # (deg); Blade 1 local torsional (angular/rotational) deflection (relative to the undeflected position) of span station 3. This output will always be zero for FAST simulation results. Use it for examining blade torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. Please note that this output uses the opposite of the sign convention used for blade pitch angles.; About the local zb1-axis -ElastoDyn['Spn4RDxb1'] = False # (deg); Blade 1 local roll (angular/rotational) deflection (relative to the undeflected position) of span station 4. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local xb1-axis -ElastoDyn['Spn4RDyb1'] = False # (deg); Blade 1 local pitch (angular/rotational) deflection (relative to the undeflected position) of span station 4. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local yb1-axis -ElastoDyn['Spn4RDzb1'] = False # (deg); Blade 1 local torsional (angular/rotational) deflection (relative to the undeflected position) of span station 4. This output will always be zero for FAST simulation results. Use it for examining blade torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. Please note that this output uses the opposite of the sign convention used for blade pitch angles.; About the local zb1-axis -ElastoDyn['Spn5RDxb1'] = False # (deg); Blade 1 local roll (angular/rotational) deflection (relative to the undeflected position) of span station 5. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local xb1-axis -ElastoDyn['Spn5RDyb1'] = False # (deg); Blade 1 local pitch (angular/rotational) deflection (relative to the undeflected position) of span station 5. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local yb1-axis -ElastoDyn['Spn5RDzb1'] = False # (deg); Blade 1 local torsional (angular/rotational) deflection (relative to the undeflected position) of span station 5. This output will always be zero for FAST simulation results. Use it for examining blade torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. Please note that this output uses the opposite of the sign convention used for blade pitch angles.; About the local zb1-axis -ElastoDyn['Spn6RDxb1'] = False # (deg); Blade 1 local roll (angular/rotational) deflection (relative to the undeflected position) of span station 6. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local xb1-axis -ElastoDyn['Spn6RDyb1'] = False # (deg); Blade 1 local pitch (angular/rotational) deflection (relative to the undeflected position) of span station 6. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local yb1-axis -ElastoDyn['Spn6RDzb1'] = False # (deg); Blade 1 local torsional (angular/rotational) deflection (relative to the undeflected position) of span station 6. This output will always be zero for FAST simulation results. Use it for examining blade torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. Please note that this output uses the opposite of the sign convention used for blade pitch angles.; About the local zb1-axis -ElastoDyn['Spn7RDxb1'] = False # (deg); Blade 1 local roll (angular/rotational) deflection (relative to the undeflected position) of span station 7. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local xb1-axis -ElastoDyn['Spn7RDyb1'] = False # (deg); Blade 1 local pitch (angular/rotational) deflection (relative to the undeflected position) of span station 7. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local yb1-axis -ElastoDyn['Spn7RDzb1'] = False # (deg); Blade 1 local torsional (angular/rotational) deflection (relative to the undeflected position) of span station 7. This output will always be zero for FAST simulation results. Use it for examining blade torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. Please note that this output uses the opposite of the sign convention used for blade pitch angles.; About the local zb1-axis -ElastoDyn['Spn8RDxb1'] = False # (deg); Blade 1 local roll (angular/rotational) deflection (relative to the undeflected position) of span station 8. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local xb1-axis -ElastoDyn['Spn8RDyb1'] = False # (deg); Blade 1 local pitch (angular/rotational) deflection (relative to the undeflected position) of span station 8. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local yb1-axis -ElastoDyn['Spn8RDzb1'] = False # (deg); Blade 1 local torsional (angular/rotational) deflection (relative to the undeflected position) of span station 8. This output will always be zero for FAST simulation results. Use it for examining blade torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. Please note that this output uses the opposite of the sign convention used for blade pitch angles.; About the local zb1-axis -ElastoDyn['Spn9RDxb1'] = False # (deg); Blade 1 local roll (angular/rotational) deflection (relative to the undeflected position) of span station 9. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local xb1-axis -ElastoDyn['Spn9RDyb1'] = False # (deg); Blade 1 local pitch (angular/rotational) deflection (relative to the undeflected position) of span station 9. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local yb1-axis -ElastoDyn['Spn9RDzb1'] = False # (deg); Blade 1 local torsional (angular/rotational) deflection (relative to the undeflected position) of span station 9. This output will always be zero for FAST simulation results. Use it for examining blade torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. Please note that this output uses the opposite of the sign convention used for blade pitch angles.; About the local zb1-axis - -# Blade 2 Local Span Motions -ElastoDyn['Spn1ALxb2'] = False # (m/s^2); Blade 2 local flapwise acceleration (absolute) of span station 1; Directed along the local xb2-axis -ElastoDyn['Spn1ALyb2'] = False # (m/s^2); Blade 2 local edgewise acceleration (absolute) of span station 1; Directed along the local yb2-axis -ElastoDyn['Spn1ALzb2'] = False # (m/s^2); Blade 2 local axial acceleration (absolute) of span station 1; Directed along the local zb2-axis -ElastoDyn['Spn2ALxb2'] = False # (m/s^2); Blade 2 local flapwise acceleration (absolute) of span station 2; Directed along the local xb2-axis -ElastoDyn['Spn2ALyb2'] = False # (m/s^2); Blade 2 local edgewise acceleration (absolute) of span station 2; Directed along the local yb2-axis -ElastoDyn['Spn2ALzb2'] = False # (m/s^2); Blade 2 local axial acceleration (absolute) of span station 2; Directed along the local zb2-axis -ElastoDyn['Spn3ALxb2'] = False # (m/s^2); Blade 2 local flapwise acceleration (absolute) of span station 3; Directed along the local xb2-axis -ElastoDyn['Spn3ALyb2'] = False # (m/s^2); Blade 2 local edgewise acceleration (absolute) of span station 3; Directed along the local yb2-axis -ElastoDyn['Spn3ALzb2'] = False # (m/s^2); Blade 2 local axial acceleration (absolute) of span station 3; Directed along the local zb2-axis -ElastoDyn['Spn4ALxb2'] = False # (m/s^2); Blade 2 local flapwise acceleration (absolute) of span station 4; Directed along the local xb2-axis -ElastoDyn['Spn4ALyb2'] = False # (m/s^2); Blade 2 local edgewise acceleration (absolute) of span station 4; Directed along the local yb2-axis -ElastoDyn['Spn4ALzb2'] = False # (m/s^2); Blade 2 local axial acceleration (absolute) of span station 4; Directed along the local zb2-axis -ElastoDyn['Spn5ALxb2'] = False # (m/s^2); Blade 2 local flapwise acceleration (absolute) of span station 5; Directed along the local xb2-axis -ElastoDyn['Spn5ALyb2'] = False # (m/s^2); Blade 2 local edgewise acceleration (absolute) of span station 5; Directed along the local yb2-axis -ElastoDyn['Spn5ALzb2'] = False # (m/s^2); Blade 2 local axial acceleration (absolute) of span station 5; Directed along the local zb2-axis -ElastoDyn['Spn6ALxb2'] = False # (m/s^2); Blade 2 local flapwise acceleration (absolute) of span station 6; Directed along the local xb2-axis -ElastoDyn['Spn6ALyb2'] = False # (m/s^2); Blade 2 local edgewise acceleration (absolute) of span station 6; Directed along the local yb2-axis -ElastoDyn['Spn6ALzb2'] = False # (m/s^2); Blade 2 local axial acceleration (absolute) of span station 6; Directed along the local zb2-axis -ElastoDyn['Spn7ALxb2'] = False # (m/s^2); Blade 2 local flapwise acceleration (absolute) of span station 7; Directed along the local xb2-axis -ElastoDyn['Spn7ALyb2'] = False # (m/s^2); Blade 2 local edgewise acceleration (absolute) of span station 7; Directed along the local yb2-axis -ElastoDyn['Spn7ALzb2'] = False # (m/s^2); Blade 2 local axial acceleration (absolute) of span station 7; Directed along the local zb2-axis -ElastoDyn['Spn8ALxb2'] = False # (m/s^2); Blade 2 local flapwise acceleration (absolute) of span station 8; Directed along the local xb2-axis -ElastoDyn['Spn8ALyb2'] = False # (m/s^2); Blade 2 local edgewise acceleration (absolute) of span station 8; Directed along the local yb2-axis -ElastoDyn['Spn8ALzb2'] = False # (m/s^2); Blade 2 local axial acceleration (absolute) of span station 8; Directed along the local zb2-axis -ElastoDyn['Spn9ALxb2'] = False # (m/s^2); Blade 2 local flapwise acceleration (absolute) of span station 9; Directed along the local xb2-axis -ElastoDyn['Spn9ALyb2'] = False # (m/s^2); Blade 2 local edgewise acceleration (absolute) of span station 9; Directed along the local yb2-axis -ElastoDyn['Spn9ALzb2'] = False # (m/s^2); Blade 2 local axial acceleration (absolute) of span station 9; Directed along the local zb2-axis -ElastoDyn['Spn1TDxb2'] = False # (m); Blade 2 local flapwise (translational) deflection (relative to the undeflected position) of span station 1; Directed along the xb2-axis -ElastoDyn['Spn1TDyb2'] = False # (m); Blade 2 local edgewise (translational) deflection (relative to the undeflected position) of span station 1; Directed along the yb2-axis -ElastoDyn['Spn1TDzb2'] = False # (m); Blade 2 local axial (translational) deflection (relative to the undeflected position) of span station 1; Directed along the zb2-axis -ElastoDyn['Spn2TDxb2'] = False # (m); Blade 2 local flapwise (translational) deflection (relative to the undeflected position) of span station 2; Directed along the xb2-axis -ElastoDyn['Spn2TDyb2'] = False # (m); Blade 2 local edgewise (translational) deflection (relative to the undeflected position) of span station 2; Directed along the yb2-axis -ElastoDyn['Spn2TDzb2'] = False # (m); Blade 2 local axial (translational) deflection (relative to the undeflected position) of span station 2; Directed along the zb2-axis -ElastoDyn['Spn3TDxb2'] = False # (m); Blade 2 local flapwise (translational) deflection (relative to the undeflected position) of span station 3; Directed along the xb2-axis -ElastoDyn['Spn3TDyb2'] = False # (m); Blade 2 local edgewise (translational) deflection (relative to the undeflected position) of span station 3; Directed along the yb2-axis -ElastoDyn['Spn3TDzb2'] = False # (m); Blade 2 local axial (translational) deflection (relative to the undeflected position) of span station 3; Directed along the zb2-axis -ElastoDyn['Spn4TDxb2'] = False # (m); Blade 2 local flapwise (translational) deflection (relative to the undeflected position) of span station 4; Directed along the xb2-axis -ElastoDyn['Spn4TDyb2'] = False # (m); Blade 2 local edgewise (translational) deflection (relative to the undeflected position) of span station 4; Directed along the yb2-axis -ElastoDyn['Spn4TDzb2'] = False # (m); Blade 2 local axial (translational) deflection (relative to the undeflected position) of span station 4; Directed along the zb2-axis -ElastoDyn['Spn5TDxb2'] = False # (m); Blade 2 local flapwise (translational) deflection (relative to the undeflected position) of span station 5; Directed along the xb2-axis -ElastoDyn['Spn5TDyb2'] = False # (m); Blade 2 local edgewise (translational) deflection (relative to the undeflected position) of span station 5; Directed along the yb2-axis -ElastoDyn['Spn5TDzb2'] = False # (m); Blade 2 local axial (translational) deflection (relative to the undeflected position) of span station 5; Directed along the zb2-axis -ElastoDyn['Spn6TDxb2'] = False # (m); Blade 2 local flapwise (translational) deflection (relative to the undeflected position) of span station 6; Directed along the xb2-axis -ElastoDyn['Spn6TDyb2'] = False # (m); Blade 2 local edgewise (translational) deflection (relative to the undeflected position) of span station 6; Directed along the yb2-axis -ElastoDyn['Spn6TDzb2'] = False # (m); Blade 2 local axial (translational) deflection (relative to the undeflected position) of span station 6; Directed along the zb2-axis -ElastoDyn['Spn7TDxb2'] = False # (m); Blade 2 local flapwise (translational) deflection (relative to the undeflected position) of span station 7; Directed along the xb2-axis -ElastoDyn['Spn7TDyb2'] = False # (m); Blade 2 local edgewise (translational) deflection (relative to the undeflected position) of span station 7; Directed along the yb2-axis -ElastoDyn['Spn7TDzb2'] = False # (m); Blade 2 local axial (translational) deflection (relative to the undeflected position) of span station 7; Directed along the zb2-axis -ElastoDyn['Spn8TDxb2'] = False # (m); Blade 2 local flapwise (translational) deflection (relative to the undeflected position) of span station 8; Directed along the xb2-axis -ElastoDyn['Spn8TDyb2'] = False # (m); Blade 2 local edgewise (translational) deflection (relative to the undeflected position) of span station 8; Directed along the yb2-axis -ElastoDyn['Spn8TDzb2'] = False # (m); Blade 2 local axial (translational) deflection (relative to the undeflected position) of span station 8; Directed along the zb2-axis -ElastoDyn['Spn9TDxb2'] = False # (m); Blade 2 local flapwise (translational) deflection (relative to the undeflected position) of span station 9; Directed along the xb2-axis -ElastoDyn['Spn9TDyb2'] = False # (m); Blade 2 local edgewise (translational) deflection (relative to the undeflected position) of span station 9; Directed along the yb2-axis -ElastoDyn['Spn9TDzb2'] = False # (m); Blade 2 local axial (translational) deflection (relative to the undeflected position) of span station 9; Directed along the zb2-axis -ElastoDyn['Spn1RDxb2'] = False # (deg); Blade 2 local roll (angular/rotational) deflection (relative to the undeflected position) of span station 1. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local xb2-axis -ElastoDyn['Spn1RDyb2'] = False # (deg); Blade 2 local pitch (angular/rotational) deflection (relative to the undeflected position) of span station 1. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local yb2-axis -ElastoDyn['Spn1RDzb2'] = False # (deg); Blade 2 local torsional (angular/rotational) deflection (relative to the undeflected position) of span station 1. This output will always be zero for FAST simulation results. Use it for examining blade torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. Please note that this output uses the opposite of the sign convention used for blade pitch angles.; About the local zb2-axis -ElastoDyn['Spn2RDxb2'] = False # (deg); Blade 2 local roll (angular/rotational) deflection (relative to the undeflected position) of span station 2. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local xb2-axis -ElastoDyn['Spn2RDyb2'] = False # (deg); Blade 2 local pitch (angular/rotational) deflection (relative to the undeflected position) of span station 2. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local yb2-axis -ElastoDyn['Spn2RDzb2'] = False # (deg); Blade 2 local torsional (angular/rotational) deflection (relative to the undeflected position) of span station 2. This output will always be zero for FAST simulation results. Use it for examining blade torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. Please note that this output uses the opposite of the sign convention used for blade pitch angles.; About the local zb2-axis -ElastoDyn['Spn3RDxb2'] = False # (deg); Blade 2 local roll (angular/rotational) deflection (relative to the undeflected position) of span station 3. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local xb2-axis -ElastoDyn['Spn3RDyb2'] = False # (deg); Blade 2 local pitch (angular/rotational) deflection (relative to the undeflected position) of span station 3. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local yb2-axis -ElastoDyn['Spn3RDzb2'] = False # (deg); Blade 2 local torsional (angular/rotational) deflection (relative to the undeflected position) of span station 3. This output will always be zero for FAST simulation results. Use it for examining blade torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. Please note that this output uses the opposite of the sign convention used for blade pitch angles.; About the local zb2-axis -ElastoDyn['Spn4RDxb2'] = False # (deg); Blade 2 local roll (angular/rotational) deflection (relative to the undeflected position) of span station 4. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local xb2-axis -ElastoDyn['Spn4RDyb2'] = False # (deg); Blade 2 local pitch (angular/rotational) deflection (relative to the undeflected position) of span station 4. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local yb2-axis -ElastoDyn['Spn4RDzb2'] = False # (deg); Blade 2 local torsional (angular/rotational) deflection (relative to the undeflected position) of span station 4. This output will always be zero for FAST simulation results. Use it for examining blade torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. Please note that this output uses the opposite of the sign convention used for blade pitch angles.; About the local zb2-axis -ElastoDyn['Spn5RDxb2'] = False # (deg); Blade 2 local roll (angular/rotational) deflection (relative to the undeflected position) of span station 5. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local xb2-axis -ElastoDyn['Spn5RDyb2'] = False # (deg); Blade 2 local pitch (angular/rotational) deflection (relative to the undeflected position) of span station 5. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local yb2-axis -ElastoDyn['Spn5RDzb2'] = False # (deg); Blade 2 local torsional (angular/rotational) deflection (relative to the undeflected position) of span station 5. This output will always be zero for FAST simulation results. Use it for examining blade torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. Please note that this output uses the opposite of the sign convention used for blade pitch angles.; About the local zb2-axis -ElastoDyn['Spn6RDxb2'] = False # (deg); Blade 2 local roll (angular/rotational) deflection (relative to the undeflected position) of span station 6. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local xb2-axis -ElastoDyn['Spn6RDyb2'] = False # (deg); Blade 2 local pitch (angular/rotational) deflection (relative to the undeflected position) of span station 6. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local yb2-axis -ElastoDyn['Spn6RDzb2'] = False # (deg); Blade 2 local torsional (angular/rotational) deflection (relative to the undeflected position) of span station 6. This output will always be zero for FAST simulation results. Use it for examining blade torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. Please note that this output uses the opposite of the sign convention used for blade pitch angles.; About the local zb2-axis -ElastoDyn['Spn7RDxb2'] = False # (deg); Blade 2 local roll (angular/rotational) deflection (relative to the undeflected position) of span station 7. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local xb2-axis -ElastoDyn['Spn7RDyb2'] = False # (deg); Blade 2 local pitch (angular/rotational) deflection (relative to the undeflected position) of span station 7. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local yb2-axis -ElastoDyn['Spn7RDzb2'] = False # (deg); Blade 2 local torsional (angular/rotational) deflection (relative to the undeflected position) of span station 7. This output will always be zero for FAST simulation results. Use it for examining blade torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. Please note that this output uses the opposite of the sign convention used for blade pitch angles.; About the local zb2-axis -ElastoDyn['Spn8RDxb2'] = False # (deg); Blade 2 local roll (angular/rotational) deflection (relative to the undeflected position) of span station 8. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local xb2-axis -ElastoDyn['Spn8RDyb2'] = False # (deg); Blade 2 local pitch (angular/rotational) deflection (relative to the undeflected position) of span station 8. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local yb2-axis -ElastoDyn['Spn8RDzb2'] = False # (deg); Blade 2 local torsional (angular/rotational) deflection (relative to the undeflected position) of span station 8. This output will always be zero for FAST simulation results. Use it for examining blade torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. Please note that this output uses the opposite of the sign convention used for blade pitch angles.; About the local zb2-axis -ElastoDyn['Spn9RDxb2'] = False # (deg); Blade 2 local roll (angular/rotational) deflection (relative to the undeflected position) of span station 9. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local xb2-axis -ElastoDyn['Spn9RDyb2'] = False # (deg); Blade 2 local pitch (angular/rotational) deflection (relative to the undeflected position) of span station 9. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local yb2-axis -ElastoDyn['Spn9RDzb2'] = False # (deg); Blade 2 local torsional (angular/rotational) deflection (relative to the undeflected position) of span station 9. This output will always be zero for FAST simulation results. Use it for examining blade torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. Please note that this output uses the opposite of the sign convention used for blade pitch angles.; About the local zb2-axis - -# Blade 3 Local Span Motions -ElastoDyn['Spn1ALxb3'] = False # (m/s^2); Blade 3 local flapwise acceleration (absolute) of span station 1; Directed along the local xb3-axis -ElastoDyn['Spn1ALyb3'] = False # (m/s^2); Blade 3 local edgewise acceleration (absolute) of span station 1; Directed along the local yb3-axis -ElastoDyn['Spn1ALzb3'] = False # (m/s^2); Blade 3 local axial acceleration (absolute) of span station 1; Directed along the local zb3-axis -ElastoDyn['Spn2ALxb3'] = False # (m/s^2); Blade 3 local flapwise acceleration (absolute) of span station 2; Directed along the local xb3-axis -ElastoDyn['Spn2ALyb3'] = False # (m/s^2); Blade 3 local edgewise acceleration (absolute) of span station 2; Directed along the local yb3-axis -ElastoDyn['Spn2ALzb3'] = False # (m/s^2); Blade 3 local axial acceleration (absolute) of span station 2; Directed along the local zb3-axis -ElastoDyn['Spn3ALxb3'] = False # (m/s^2); Blade 3 local flapwise acceleration (absolute) of span station 3; Directed along the local xb3-axis -ElastoDyn['Spn3ALyb3'] = False # (m/s^2); Blade 3 local edgewise acceleration (absolute) of span station 3; Directed along the local yb3-axis -ElastoDyn['Spn3ALzb3'] = False # (m/s^2); Blade 3 local axial acceleration (absolute) of span station 3; Directed along the local zb3-axis -ElastoDyn['Spn4ALxb3'] = False # (m/s^2); Blade 3 local flapwise acceleration (absolute) of span station 4; Directed along the local xb3-axis -ElastoDyn['Spn4ALyb3'] = False # (m/s^2); Blade 3 local edgewise acceleration (absolute) of span station 4; Directed along the local yb3-axis -ElastoDyn['Spn4ALzb3'] = False # (m/s^2); Blade 3 local axial acceleration (absolute) of span station 4; Directed along the local zb3-axis -ElastoDyn['Spn5ALxb3'] = False # (m/s^2); Blade 3 local flapwise acceleration (absolute) of span station 5; Directed along the local xb3-axis -ElastoDyn['Spn5ALyb3'] = False # (m/s^2); Blade 3 local edgewise acceleration (absolute) of span station 5; Directed along the local yb3-axis -ElastoDyn['Spn5ALzb3'] = False # (m/s^2); Blade 3 local axial acceleration (absolute) of span station 5; Directed along the local zb3-axis -ElastoDyn['Spn6ALxb3'] = False # (m/s^2); Blade 3 local flapwise acceleration (absolute) of span station 6; Directed along the local xb3-axis -ElastoDyn['Spn6ALyb3'] = False # (m/s^2); Blade 3 local edgewise acceleration (absolute) of span station 6; Directed along the local yb3-axis -ElastoDyn['Spn6ALzb3'] = False # (m/s^2); Blade 3 local axial acceleration (absolute) of span station 6; Directed along the local zb3-axis -ElastoDyn['Spn7ALxb3'] = False # (m/s^2); Blade 3 local flapwise acceleration (absolute) of span station 7; Directed along the local xb3-axis -ElastoDyn['Spn7ALyb3'] = False # (m/s^2); Blade 3 local edgewise acceleration (absolute) of span station 7; Directed along the local yb3-axis -ElastoDyn['Spn7ALzb3'] = False # (m/s^2); Blade 3 local axial acceleration (absolute) of span station 7; Directed along the local zb3-axis -ElastoDyn['Spn8ALxb3'] = False # (m/s^2); Blade 3 local flapwise acceleration (absolute) of span station 8; Directed along the local xb3-axis -ElastoDyn['Spn8ALyb3'] = False # (m/s^2); Blade 3 local edgewise acceleration (absolute) of span station 8; Directed along the local yb3-axis -ElastoDyn['Spn8ALzb3'] = False # (m/s^2); Blade 3 local axial acceleration (absolute) of span station 8; Directed along the local zb3-axis -ElastoDyn['Spn9ALxb3'] = False # (m/s^2); Blade 3 local flapwise acceleration (absolute) of span station 9; Directed along the local xb3-axis -ElastoDyn['Spn9ALyb3'] = False # (m/s^2); Blade 3 local edgewise acceleration (absolute) of span station 9; Directed along the local yb3-axis -ElastoDyn['Spn9ALzb3'] = False # (m/s^2); Blade 3 local axial acceleration (absolute) of span station 9; Directed along the local zb3-axis -ElastoDyn['Spn1TDxb3'] = False # (m); Blade 3 local flapwise (translational) deflection (relative to the undeflected position) of span station 1; Directed along the xb3-axis -ElastoDyn['Spn1TDyb3'] = False # (m); Blade 3 local edgewise (translational) deflection (relative to the undeflected position) of span station 1; Directed along the yb3-axis -ElastoDyn['Spn1TDzb3'] = False # (m); Blade 3 local axial (translational) deflection (relative to the undeflected position) of span station 1; Directed along the zb3-axis -ElastoDyn['Spn2TDxb3'] = False # (m); Blade 3 local flapwise (translational) deflection (relative to the undeflected position) of span station 2; Directed along the xb3-axis -ElastoDyn['Spn2TDyb3'] = False # (m); Blade 3 local edgewise (translational) deflection (relative to the undeflected position) of span station 2; Directed along the yb3-axis -ElastoDyn['Spn2TDzb3'] = False # (m); Blade 3 local axial (translational) deflection (relative to the undeflected position) of span station 2; Directed along the zb3-axis -ElastoDyn['Spn3TDxb3'] = False # (m); Blade 3 local flapwise (translational) deflection (relative to the undeflected position) of span station 3; Directed along the xb3-axis -ElastoDyn['Spn3TDyb3'] = False # (m); Blade 3 local edgewise (translational) deflection (relative to the undeflected position) of span station 3; Directed along the yb3-axis -ElastoDyn['Spn3TDzb3'] = False # (m); Blade 3 local axial (translational) deflection (relative to the undeflected position) of span station 3; Directed along the zb3-axis -ElastoDyn['Spn4TDxb3'] = False # (m); Blade 3 local flapwise (translational) deflection (relative to the undeflected position) of span station 4; Directed along the xb3-axis -ElastoDyn['Spn4TDyb3'] = False # (m); Blade 3 local edgewise (translational) deflection (relative to the undeflected position) of span station 4; Directed along the yb3-axis -ElastoDyn['Spn4TDzb3'] = False # (m); Blade 3 local axial (translational) deflection (relative to the undeflected position) of span station 4; Directed along the zb3-axis -ElastoDyn['Spn5TDxb3'] = False # (m); Blade 3 local flapwise (translational) deflection (relative to the undeflected position) of span station 5; Directed along the xb3-axis -ElastoDyn['Spn5TDyb3'] = False # (m); Blade 3 local edgewise (translational) deflection (relative to the undeflected position) of span station 5; Directed along the yb3-axis -ElastoDyn['Spn5TDzb3'] = False # (m); Blade 3 local axial (translational) deflection (relative to the undeflected position) of span station 5; Directed along the zb3-axis -ElastoDyn['Spn6TDxb3'] = False # (m); Blade 3 local flapwise (translational) deflection (relative to the undeflected position) of span station 6; Directed along the xb3-axis -ElastoDyn['Spn6TDyb3'] = False # (m); Blade 3 local edgewise (translational) deflection (relative to the undeflected position) of span station 6; Directed along the yb3-axis -ElastoDyn['Spn6TDzb3'] = False # (m); Blade 3 local axial (translational) deflection (relative to the undeflected position) of span station 6; Directed along the zb3-axis -ElastoDyn['Spn7TDxb3'] = False # (m); Blade 3 local flapwise (translational) deflection (relative to the undeflected position) of span station 7; Directed along the xb3-axis -ElastoDyn['Spn7TDyb3'] = False # (m); Blade 3 local edgewise (translational) deflection (relative to the undeflected position) of span station 7; Directed along the yb3-axis -ElastoDyn['Spn7TDzb3'] = False # (m); Blade 3 local axial (translational) deflection (relative to the undeflected position) of span station 7; Directed along the zb3-axis -ElastoDyn['Spn8TDxb3'] = False # (m); Blade 3 local flapwise (translational) deflection (relative to the undeflected position) of span station 8; Directed along the xb3-axis -ElastoDyn['Spn8TDyb3'] = False # (m); Blade 3 local edgewise (translational) deflection (relative to the undeflected position) of span station 8; Directed along the yb3-axis -ElastoDyn['Spn8TDzb3'] = False # (m); Blade 3 local axial (translational) deflection (relative to the undeflected position) of span station 8; Directed along the zb3-axis -ElastoDyn['Spn9TDxb3'] = False # (m); Blade 3 local flapwise (translational) deflection (relative to the undeflected position) of span station 9; Directed along the xb3-axis -ElastoDyn['Spn9TDyb3'] = False # (m); Blade 3 local edgewise (translational) deflection (relative to the undeflected position) of span station 9; Directed along the yb3-axis -ElastoDyn['Spn9TDzb3'] = False # (m); Blade 3 local axial (translational) deflection (relative to the undeflected position) of span station 9; Directed along the zb3-axis -ElastoDyn['Spn1RDxb3'] = False # (deg); Blade 3 local roll (angular/rotational) deflection (relative to the undeflected position) of span station 1. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local xb3-axis -ElastoDyn['Spn1RDyb3'] = False # (deg); Blade 3 local pitch (angular/rotational) deflection (relative to the undeflected position) of span station 1. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local yb3-axis -ElastoDyn['Spn1RDzb3'] = False # (deg); Blade 3 local torsional (angular/rotational) deflection (relative to the undeflected position) of span station 1. This output will always be zero for FAST simulation results. Use it for examining blade torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. Please note that this output uses the opposite of the sign convention used for blade pitch angles.; About the local zb3-axis -ElastoDyn['Spn2RDxb3'] = False # (deg); Blade 3 local roll (angular/rotational) deflection (relative to the undeflected position) of span station 2. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local xb3-axis -ElastoDyn['Spn2RDyb3'] = False # (deg); Blade 3 local pitch (angular/rotational) deflection (relative to the undeflected position) of span station 2. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local yb3-axis -ElastoDyn['Spn2RDzb3'] = False # (deg); Blade 3 local torsional (angular/rotational) deflection (relative to the undeflected position) of span station 2. This output will always be zero for FAST simulation results. Use it for examining blade torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. Please note that this output uses the opposite of the sign convention used for blade pitch angles.; About the local zb3-axis -ElastoDyn['Spn3RDxb3'] = False # (deg); Blade 3 local roll (angular/rotational) deflection (relative to the undeflected position) of span station 3. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local xb3-axis -ElastoDyn['Spn3RDyb3'] = False # (deg); Blade 3 local pitch (angular/rotational) deflection (relative to the undeflected position) of span station 3. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local yb3-axis -ElastoDyn['Spn3RDzb3'] = False # (deg); Blade 3 local torsional (angular/rotational) deflection (relative to the undeflected position) of span station 3. This output will always be zero for FAST simulation results. Use it for examining blade torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. Please note that this output uses the opposite of the sign convention used for blade pitch angles.; About the local zb3-axis -ElastoDyn['Spn4RDxb3'] = False # (deg); Blade 3 local roll (angular/rotational) deflection (relative to the undeflected position) of span station 4. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local xb3-axis -ElastoDyn['Spn4RDyb3'] = False # (deg); Blade 3 local pitch (angular/rotational) deflection (relative to the undeflected position) of span station 4. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local yb3-axis -ElastoDyn['Spn4RDzb3'] = False # (deg); Blade 3 local torsional (angular/rotational) deflection (relative to the undeflected position) of span station 4. This output will always be zero for FAST simulation results. Use it for examining blade torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. Please note that this output uses the opposite of the sign convention used for blade pitch angles.; About the local zb3-axis -ElastoDyn['Spn5RDxb3'] = False # (deg); Blade 3 local roll (angular/rotational) deflection (relative to the undeflected position) of span station 5. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local xb3-axis -ElastoDyn['Spn5RDyb3'] = False # (deg); Blade 3 local pitch (angular/rotational) deflection (relative to the undeflected position) of span station 5. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local yb3-axis -ElastoDyn['Spn5RDzb3'] = False # (deg); Blade 3 local torsional (angular/rotational) deflection (relative to the undeflected position) of span station 5. This output will always be zero for FAST simulation results. Use it for examining blade torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. Please note that this output uses the opposite of the sign convention used for blade pitch angles.; About the local zb3-axis -ElastoDyn['Spn6RDxb3'] = False # (deg); Blade 3 local roll (angular/rotational) deflection (relative to the undeflected position) of span station 6. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local xb3-axis -ElastoDyn['Spn6RDyb3'] = False # (deg); Blade 3 local pitch (angular/rotational) deflection (relative to the undeflected position) of span station 6. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local yb3-axis -ElastoDyn['Spn6RDzb3'] = False # (deg); Blade 3 local torsional (angular/rotational) deflection (relative to the undeflected position) of span station 6. This output will always be zero for FAST simulation results. Use it for examining blade torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. Please note that this output uses the opposite of the sign convention used for blade pitch angles.; About the local zb3-axis -ElastoDyn['Spn7RDxb3'] = False # (deg); Blade 3 local roll (angular/rotational) deflection (relative to the undeflected position) of span station 7. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local xb3-axis -ElastoDyn['Spn7RDyb3'] = False # (deg); Blade 3 local pitch (angular/rotational) deflection (relative to the undeflected position) of span station 7. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local yb3-axis -ElastoDyn['Spn7RDzb3'] = False # (deg); Blade 3 local torsional (angular/rotational) deflection (relative to the undeflected position) of span station 7. This output will always be zero for FAST simulation results. Use it for examining blade torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. Please note that this output uses the opposite of the sign convention used for blade pitch angles.; About the local zb3-axis -ElastoDyn['Spn8RDxb3'] = False # (deg); Blade 3 local roll (angular/rotational) deflection (relative to the undeflected position) of span station 8. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local xb3-axis -ElastoDyn['Spn8RDyb3'] = False # (deg); Blade 3 local pitch (angular/rotational) deflection (relative to the undeflected position) of span station 8. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local yb3-axis -ElastoDyn['Spn8RDzb3'] = False # (deg); Blade 3 local torsional (angular/rotational) deflection (relative to the undeflected position) of span station 8. This output will always be zero for FAST simulation results. Use it for examining blade torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. Please note that this output uses the opposite of the sign convention used for blade pitch angles.; About the local zb3-axis -ElastoDyn['Spn9RDxb3'] = False # (deg); Blade 3 local roll (angular/rotational) deflection (relative to the undeflected position) of span station 9. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local xb3-axis -ElastoDyn['Spn9RDyb3'] = False # (deg); Blade 3 local pitch (angular/rotational) deflection (relative to the undeflected position) of span station 9. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local yb3-axis -ElastoDyn['Spn9RDzb3'] = False # (deg); Blade 3 local torsional (angular/rotational) deflection (relative to the undeflected position) of span station 9. This output will always be zero for FAST simulation results. Use it for examining blade torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. Please note that this output uses the opposite of the sign convention used for blade pitch angles.; About the local zb3-axis - -# Blade Pitch Motions -ElastoDyn['PtchPMzc1'] = False # (deg); Blade 1 pitch angle (position); Positive towards feather about the minus zc1- and minus zb1-axes -ElastoDyn['PtchPMzb1'] = False # (deg); Blade 1 pitch angle (position); Positive towards feather about the minus zc1- and minus zb1-axes -ElastoDyn['BldPitch1'] = False # (deg); Blade 1 pitch angle (position); Positive towards feather about the minus zc1- and minus zb1-axes -ElastoDyn['BlPitch1'] = False # (deg); Blade 1 pitch angle (position); Positive towards feather about the minus zc1- and minus zb1-axes -ElastoDyn['PtchPMzc2'] = False # (deg); Blade 2 pitch angle (position); Positive towards feather about the minus zc2- and minus zb2-axes -ElastoDyn['PtchPMzb2'] = False # (deg); Blade 2 pitch angle (position); Positive towards feather about the minus zc2- and minus zb2-axes -ElastoDyn['BldPitch2'] = False # (deg); Blade 2 pitch angle (position); Positive towards feather about the minus zc2- and minus zb2-axes -ElastoDyn['BlPitch2'] = False # (deg); Blade 2 pitch angle (position); Positive towards feather about the minus zc2- and minus zb2-axes -ElastoDyn['PtchPMzc3'] = False # (deg); Blade 3 pitch angle (position); Positive towards feather about the minus zc3- and minus zb3-axes -ElastoDyn['PtchPMzb3'] = False # (deg); Blade 3 pitch angle (position); Positive towards feather about the minus zc3- and minus zb3-axes -ElastoDyn['BldPitch3'] = False # (deg); Blade 3 pitch angle (position); Positive towards feather about the minus zc3- and minus zb3-axes -ElastoDyn['BlPitch3'] = False # (deg); Blade 3 pitch angle (position); Positive towards feather about the minus zc3- and minus zb3-axes - -# Teeter Motions -ElastoDyn['TeetPya'] = False # (deg); Rotor teeter angle (position); About the ya-axis -ElastoDyn['RotTeetP'] = False # (deg); Rotor teeter angle (position); About the ya-axis -ElastoDyn['TeetDefl'] = False # (deg); Rotor teeter angle (position); About the ya-axis -ElastoDyn['TeetVya'] = False # (deg/s); Rotor teeter angular velocity; About the ya-axis -ElastoDyn['RotTeetV'] = False # (deg/s); Rotor teeter angular velocity; About the ya-axis -ElastoDyn['TeetAya'] = False # (deg/s^2); Rotor teeter angular acceleration; About the ya-axis -ElastoDyn['RotTeetA'] = False # (deg/s^2); Rotor teeter angular acceleration; About the ya-axis - -# Shaft Motions -ElastoDyn['LSSTipPxa'] = False # (deg); Rotor azimuth angle (position); About the xa- and xs-axes -ElastoDyn['LSSTipPxs'] = False # (deg); Rotor azimuth angle (position); About the xa- and xs-axes -ElastoDyn['LSSTipP'] = False # (deg); Rotor azimuth angle (position); About the xa- and xs-axes -ElastoDyn['Azimuth'] = False # (deg); Rotor azimuth angle (position); About the xa- and xs-axes -ElastoDyn['LSSTipVxa'] = False # (rpm); Rotor azimuth angular speed; About the xa- and xs-axes -ElastoDyn['LSSTipVxs'] = False # (rpm); Rotor azimuth angular speed; About the xa- and xs-axes -ElastoDyn['LSSTipV'] = False # (rpm); Rotor azimuth angular speed; About the xa- and xs-axes -ElastoDyn['RotSpeed'] = False # (rpm); Rotor azimuth angular speed; About the xa- and xs-axes -ElastoDyn['LSSTipAxa'] = False # (deg/s^2); Rotor azimuth angular acceleration; About the xa- and xs-axes -ElastoDyn['LSSTipAxs'] = False # (deg/s^2); Rotor azimuth angular acceleration; About the xa- and xs-axes -ElastoDyn['LSSTipA'] = False # (deg/s^2); Rotor azimuth angular acceleration; About the xa- and xs-axes -ElastoDyn['RotAccel'] = False # (deg/s^2); Rotor azimuth angular acceleration; About the xa- and xs-axes -ElastoDyn['LSSGagPxa'] = False # (deg); Low-speed shaft strain gage azimuth angle (position) (on the gearbox side of the low-speed shaft); About the xa- and xs-axes -ElastoDyn['LSSGagPxs'] = False # (deg); Low-speed shaft strain gage azimuth angle (position) (on the gearbox side of the low-speed shaft); About the xa- and xs-axes -ElastoDyn['LSSGagP'] = False # (deg); Low-speed shaft strain gage azimuth angle (position) (on the gearbox side of the low-speed shaft); About the xa- and xs-axes -ElastoDyn['LSSGagVxa'] = False # (rpm); Low-speed shaft strain gage angular speed (on the gearbox side of the low-speed shaft); About the xa- and xs-axes -ElastoDyn['LSSGagVxs'] = False # (rpm); Low-speed shaft strain gage angular speed (on the gearbox side of the low-speed shaft); About the xa- and xs-axes -ElastoDyn['LSSGagV'] = False # (rpm); Low-speed shaft strain gage angular speed (on the gearbox side of the low-speed shaft); About the xa- and xs-axes -ElastoDyn['LSSGagAxa'] = False # (deg/s^2); Low-speed shaft strain gage angular acceleration (on the gearbox side of the low-speed shaft); About the xa- and xs-axes -ElastoDyn['LSSGagAxs'] = False # (deg/s^2); Low-speed shaft strain gage angular acceleration (on the gearbox side of the low-speed shaft); About the xa- and xs-axes -ElastoDyn['LSSGagA'] = False # (deg/s^2); Low-speed shaft strain gage angular acceleration (on the gearbox side of the low-speed shaft); About the xa- and xs-axes -ElastoDyn['HSShftV'] = False # (rpm); Angular speed of the high-speed shaft and generator; Same sign as LSSGagVxa / LSSGagVxs / LSSGagV -ElastoDyn['GenSpeed'] = False # (rpm); Angular speed of the high-speed shaft and generator; Same sign as LSSGagVxa / LSSGagVxs / LSSGagV -ElastoDyn['HSShftA'] = False # (deg/s^2); Angular acceleration of the high-speed shaft and generator; Same sign as LSSGagAxa / LSSGagAxs / LSSGagA -ElastoDyn['GenAccel'] = False # (deg/s^2); Angular acceleration of the high-speed shaft and generator; Same sign as LSSGagAxa / LSSGagAxs / LSSGagA - -# Nacelle IMU Motions -ElastoDyn['NcIMUTVxs'] = False # (m/s); Nacelle inertial measurement unit translational velocity (absolute); Directed along the xs-axis -ElastoDyn['NcIMUTVys'] = False # (m/s); Nacelle inertial measurement unit translational velocity (absolute); Directed along the ys-axis -ElastoDyn['NcIMUTVzs'] = False # (m/s); Nacelle inertial measurement unit translational velocity (absolute); Directed along the zs-axis -ElastoDyn['NcIMUTAxs'] = False # (m/s^2); Nacelle inertial measurement unit translational acceleration (absolute); Directed along the xs-axis -ElastoDyn['NcIMUTAys'] = False # (m/s^2); Nacelle inertial measurement unit translational acceleration (absolute); Directed along the ys-axis -ElastoDyn['NcIMUTAzs'] = False # (m/s^2); Nacelle inertial measurement unit translational acceleration (absolute); Directed along the zs-axis -ElastoDyn['NcIMURVxs'] = False # (deg/s); Nacelle inertial measurement unit angular (rotational) velocity (absolute); About the xs-axis -ElastoDyn['NcIMURVys'] = False # (deg/s); Nacelle inertial measurement unit angular (rotational) velocity (absolute); About the ys-axis -ElastoDyn['NcIMURVzs'] = False # (deg/s); Nacelle inertial measurement unit angular (rotational) velocity (absolute); About the zs-axis -ElastoDyn['NcIMURAxs'] = False # (deg/s^2); Nacelle inertial measurement unit angular (rotational) acceleration (absolute); About the xs-axis -ElastoDyn['NcIMURAys'] = False # (deg/s^2); Nacelle inertial measurement unit angular (rotational) acceleration (absolute); About the ys-axis -ElastoDyn['NcIMURAzs'] = False # (deg/s^2); Nacelle inertial measurement unit angular (rotational) acceleration (absolute); About the zs-axis - -# Rotor-Furl Motions -ElastoDyn['RotFurlP'] = False # (deg); Rotor-furl angle (position); About the rotor-furl axis -ElastoDyn['RotFurl'] = False # (deg); Rotor-furl angle (position); About the rotor-furl axis -ElastoDyn['RotFurlV'] = False # (deg/s); Rotor-furl angular velocity; About the rotor-furl axis -ElastoDyn['RotFurlA'] = False # (deg/s^2); Rotor-furl angular acceleration; About the rotor-furl axis - -# Tail-Furl Motions -ElastoDyn['TailFurlP'] = False # (deg); Tail-furl angle (position); About the tail-furl axis -ElastoDyn['TailFurl'] = False # (deg); Tail-furl angle (position); About the tail-furl axis -ElastoDyn['TailFurlV'] = False # (deg/s); Tail-furl angular velocity; About the tail-furl axis -ElastoDyn['TailFurlA'] = False # (deg/s^2); Tail-furl angular acceleration; About the tail-furl axis - -# Nacelle Yaw Motions -ElastoDyn['YawPzn'] = False # (deg); Nacelle yaw angle (position); About the zn- and zp-axes -ElastoDyn['YawPzp'] = False # (deg); Nacelle yaw angle (position); About the zn- and zp-axes -ElastoDyn['NacYawP'] = False # (deg); Nacelle yaw angle (position); About the zn- and zp-axes -ElastoDyn['NacYaw'] = False # (deg); Nacelle yaw angle (position); About the zn- and zp-axes -ElastoDyn['YawPos'] = False # (deg); Nacelle yaw angle (position); About the zn- and zp-axes -ElastoDyn['YawVzn'] = False # (deg/s); Nacelle yaw angular velocity; About the zn- and zp-axes -ElastoDyn['YawVzp'] = False # (deg/s); Nacelle yaw angular velocity; About the zn- and zp-axes -ElastoDyn['NacYawV'] = False # (deg/s); Nacelle yaw angular velocity; About the zn- and zp-axes -ElastoDyn['YawRate'] = False # (deg/s); Nacelle yaw angular velocity; About the zn- and zp-axes -ElastoDyn['YawAzn'] = False # (deg/s^2); Nacelle yaw angular acceleration; About the zn- and zp-axes -ElastoDyn['YawAzp'] = False # (deg/s^2); Nacelle yaw angular acceleration; About the zn- and zp-axes -ElastoDyn['NacYawA'] = False # (deg/s^2); Nacelle yaw angular acceleration; About the zn- and zp-axes -ElastoDyn['YawAccel'] = False # (deg/s^2); Nacelle yaw angular acceleration; About the zn- and zp-axes - -# Tower-Top / Yaw Bearing Motions -ElastoDyn['TwrTpTDxi'] = False # (m); Tower-top / yaw bearing fore-aft (translational) deflection (relative to the undeflected position) including all platform motions; Directed along the xi-axis -ElastoDyn['YawBrTDxi'] = False # (m); Tower-top / yaw bearing fore-aft (translational) deflection (relative to the undeflected position) including all platform motions; Directed along the xi-axis -ElastoDyn['TwrTpTDyi'] = False # (m); Tower-top / yaw bearing side-to-side (translational) deflection (relative to the undeflected position) including all platform motions; Directed along the yi-axis -ElastoDyn['YawBrTDyi'] = False # (m); Tower-top / yaw bearing side-to-side (translational) deflection (relative to the undeflected position) including all platform motions; Directed along the yi-axis -ElastoDyn['TwrTpTDzi'] = False # (m); Tower-top / yaw bearing axial (translational) deflection (relative to the undeflected position) including all platform motions; Directed along the zi-axis -ElastoDyn['YawBrTDzi'] = False # (m); Tower-top / yaw bearing axial (translational) deflection (relative to the undeflected position) including all platform motions; Directed along the zi-axis -ElastoDyn['YawBrTDxp'] = False # (m); Tower-top / yaw bearing fore-aft (translational) deflection (relative to the undeflected position); Directed along the xp-axis -ElastoDyn['YawBrTDyp'] = False # (m); Tower-top / yaw bearing side-to-side (translational) deflection (relative to the undeflected position); Directed along the yp-axis -ElastoDyn['YawBrTDzp'] = False # (m); Tower-top / yaw bearing axial (translational) deflection (relative to the undeflected position); Directed along the zp-axis -ElastoDyn['YawBrTDxt'] = False # (m); Tower-top / yaw bearing fore-aft (translational) deflection (relative to the undeflected position); Directed along the xt-axis -ElastoDyn['TTDspFA'] = False # (m); Tower-top / yaw bearing fore-aft (translational) deflection (relative to the undeflected position); Directed along the xt-axis -ElastoDyn['YawBrTDyt'] = False # (m); Tower-top / yaw bearing side-to-side (translation) deflection (relative to the undeflected position); Directed along the yt-axis -ElastoDyn['TTDspSS'] = False # (m); Tower-top / yaw bearing side-to-side (translation) deflection (relative to the undeflected position); Directed along the yt-axis -ElastoDyn['YawBrTDzt'] = False # (m); Tower-top / yaw bearing axial (translational) deflection (relative to the undeflected position); Directed along the zt-axis -ElastoDyn['TTDspAx'] = False # (m); Tower-top / yaw bearing axial (translational) deflection (relative to the undeflected position); Directed along the zt-axis -ElastoDyn['YawBrTVxp'] = False # (m/s); Tower-top / yaw bearing fore-aft (translational) velocity (absolute); Directed along the xp-axis -ElastoDyn['YawBrTVyp'] = False # (m/s); Tower-top / yaw bearing side-to-side (translational) velocity (absolute); Directed along the yp-axis -ElastoDyn['YawBrTVzp'] = False # (m/s); Tower-top / yaw bearing axial (translational) velocity (absolute); Directed along the zp-axis -ElastoDyn['YawBrTAxp'] = False # (m/s^2); Tower-top / yaw bearing fore-aft (translational) acceleration (absolute); Directed along the xp-axis -ElastoDyn['YawBrTAyp'] = False # (m/s^2); Tower-top / yaw bearing side-to-side (translational) acceleration (absolute); Directed along the yp-axis -ElastoDyn['YawBrTAzp'] = False # (m/s^2); Tower-top / yaw bearing axial (translational) acceleration (absolute); Directed along the zp-axis -ElastoDyn['YawBrRDxt'] = False # (deg); Tower-top / yaw bearing angular (rotational) roll deflection (relative to the undeflected position). In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower deflections, so that the rotation sequence does not matter.; About the xt-axis -ElastoDyn['TTDspRoll'] = False # (deg); Tower-top / yaw bearing angular (rotational) roll deflection (relative to the undeflected position). In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower deflections, so that the rotation sequence does not matter.; About the xt-axis -ElastoDyn['YawBrRDyt'] = False # (deg); Tower-top / yaw bearing angular (rotational) pitch deflection (relative to the undeflected position). In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower deflections, so that the rotation sequence does not matter.; About the yt-axis -ElastoDyn['TTDspPtch'] = False # (deg); Tower-top / yaw bearing angular (rotational) pitch deflection (relative to the undeflected position). In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower deflections, so that the rotation sequence does not matter.; About the yt-axis -ElastoDyn['YawBrRDzt'] = False # (deg); Tower-top / yaw bearing angular (rotational) torsion deflection (relative to the undeflected position). This output will always be zero for FAST simulation results. Use it for examining tower torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence.; About the zt-axis -ElastoDyn['TTDspTwst'] = False # (deg); Tower-top / yaw bearing angular (rotational) torsion deflection (relative to the undeflected position). This output will always be zero for FAST simulation results. Use it for examining tower torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence.; About the zt-axis -ElastoDyn['YawBrRVxp'] = False # (deg/s); Tower-top / yaw bearing angular (rotational) roll velocity (absolute); About the xp-axis -ElastoDyn['YawBrRVyp'] = False # (deg/s); Tower-top / yaw bearing angular (rotational) pitch velocity (absolute); About the yp-axis -ElastoDyn['YawBrRVzp'] = False # (deg/s); Tower-top / yaw bearing angular (rotational) torsion velocity. This output will always be very close to zero for FAST simulation results. Use it for examining tower torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. (absolute); About the zp-axis -ElastoDyn['YawBrRAxp'] = False # (deg/s^2); Tower-top / yaw bearing angular (rotational) roll acceleration (absolute); About the xp-axis -ElastoDyn['YawBrRAyp'] = False # (deg/s^2); Tower-top / yaw bearing angular (rotational) pitch acceleration (absolute); About the yp-axis -ElastoDyn['YawBrRAzp'] = False # (deg/s^2); Tower-top / yaw bearing angular (rotational) torsion acceleration. This output will always be very close to zero for FAST simulation results. Use it for examining tower torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. (absolute); About the zp-axis - -# Local Tower Motions -ElastoDyn['TwHt1ALxt'] = False # (m/s^2); Local tower fore-aft (translational) acceleration (absolute) of tower gage 1 ; Directed along the local xt-axis -ElastoDyn['TwHt1ALyt'] = False # (m/s^2); Local tower side-to-side (translational) acceleration (absolute) of tower gage 1 ; Directed along the local yt-axis -ElastoDyn['TwHt1ALzt'] = False # (m/s^2); Local tower axial (translational) acceleration (absolute) of tower gage 1 ; Directed along the local zt-axis -ElastoDyn['TwHt2ALxt'] = False # (m/s^2); Local tower fore-aft (translational) acceleration (absolute) of tower gage 2; Directed along the local xt-axis -ElastoDyn['TwHt2ALyt'] = False # (m/s^2); Local tower side-to-side (translational) acceleration (absolute) of tower gage 2; Directed along the local yt-axis -ElastoDyn['TwHt2ALzt'] = False # (m/s^2); Local tower axial (translational) acceleration (absolute) of tower gage 2; Directed along the local zt-axis -ElastoDyn['TwHt3ALxt'] = False # (m/s^2); Local tower fore-aft (translational) acceleration (absolute) of tower gage 3; Directed along the local xt-axis -ElastoDyn['TwHt3ALyt'] = False # (m/s^2); Local tower side-to-side (translational) acceleration (absolute) of tower gage 3; Directed along the local yt-axis -ElastoDyn['TwHt3ALzt'] = False # (m/s^2); Local tower axial (translational) acceleration (absolute) of tower gage 3; Directed along the local zt-axis -ElastoDyn['TwHt4ALxt'] = False # (m/s^2); Local tower fore-aft (translational) acceleration (absolute) of tower gage 4; Directed along the local xt-axis -ElastoDyn['TwHt4ALyt'] = False # (m/s^2); Local tower side-to-side (translational) acceleration (absolute) of tower gage 4; Directed along the local yt-axis -ElastoDyn['TwHt4ALzt'] = False # (m/s^2); Local tower axial (translational) acceleration (absolute) of tower gage 4; Directed along the local zt-axis -ElastoDyn['TwHt5ALxt'] = False # (m/s^2); Local tower fore-aft (translational) acceleration (absolute) of tower gage 5; Directed along the local xt-axis -ElastoDyn['TwHt5ALyt'] = False # (m/s^2); Local tower side-to-side (translational) acceleration (absolute) of tower gage 5; Directed along the local yt-axis -ElastoDyn['TwHt5ALzt'] = False # (m/s^2); Local tower axial (translational) acceleration (absolute) of tower gage 5; Directed along the local zt-axis -ElastoDyn['TwHt6ALxt'] = False # (m/s^2); Local tower fore-aft (translational) acceleration (absolute) of tower gage 6; Directed along the local xt-axis -ElastoDyn['TwHt6ALyt'] = False # (m/s^2); Local tower side-to-side (translational) acceleration (absolute) of tower gage 6; Directed along the local yt-axis -ElastoDyn['TwHt6ALzt'] = False # (m/s^2); Local tower axial (translational) acceleration (absolute) of tower gage 6; Directed along the local zt-axis -ElastoDyn['TwHt7ALxt'] = False # (m/s^2); Local tower fore-aft (translational) acceleration (absolute) of tower gage 7; Directed along the local xt-axis -ElastoDyn['TwHt7ALyt'] = False # (m/s^2); Local tower side-to-side (translational) acceleration (absolute) of tower gage 7; Directed along the local yt-axis -ElastoDyn['TwHt7ALzt'] = False # (m/s^2); Local tower axial (translational) acceleration (absolute) of tower gage 7; Directed along the local zt-axis -ElastoDyn['TwHt8ALxt'] = False # (m/s^2); Local tower fore-aft (translational) acceleration (absolute) of tower gage 8; Directed along the local xt-axis -ElastoDyn['TwHt8ALyt'] = False # (m/s^2); Local tower side-to-side (translational) acceleration (absolute) of tower gage 8; Directed along the local yt-axis -ElastoDyn['TwHt8ALzt'] = False # (m/s^2); Local tower axial (translational) acceleration (absolute) of tower gage 8; Directed along the local zt-axis -ElastoDyn['TwHt9ALxt'] = False # (m/s^2); Local tower fore-aft (translational) acceleration (absolute) of tower gage 9; Directed along the local xt-axis -ElastoDyn['TwHt9ALyt'] = False # (m/s^2); Local tower side-to-side (translational) acceleration (absolute) of tower gage 9; Directed along the local yt-axis -ElastoDyn['TwHt9ALzt'] = False # (m/s^2); Local tower axial (translational) acceleration (absolute) of tower gage 9; Directed along the local zt-axis -ElastoDyn['TwHt1TDxt'] = False # (m); Local tower fore-aft (translational) deflection (relative to the undeflected position) of tower gage 1; Directed along the local xt-axis -ElastoDyn['TwHt1TDyt'] = False # (m); Local tower side-to-side (translational) deflection (relative to the undeflected position) of tower gage 1; Directed along the local yt-axis -ElastoDyn['TwHt1TDzt'] = False # (m); Local tower axial (translational) deflection (relative to the undeflected position) of tower gage 1; Directed along the local zt-axis -ElastoDyn['TwHt2TDxt'] = False # (m); Local tower fore-aft (translational) deflection (relative to the undeflected position) of tower gage 2; Directed along the local xt-axis -ElastoDyn['TwHt2TDyt'] = False # (m); Local tower side-to-side (translational) deflection (relative to the undeflected position) of tower gage 2; Directed along the local yt-axis -ElastoDyn['TwHt2TDzt'] = False # (m); Local tower axial (translational) deflection (relative to the undeflected position) of tower gage 2; Directed along the local zt-axis -ElastoDyn['TwHt3TDxt'] = False # (m); Local tower fore-aft (translational) deflection (relative to the undeflected position) of tower gage 3; Directed along the local xt-axis -ElastoDyn['TwHt3TDyt'] = False # (m); Local tower side-to-side (translational) deflection (relative to the undeflected position) of tower gage 3; Directed along the local yt-axis -ElastoDyn['TwHt3TDzt'] = False # (m); Local tower axial (translational) deflection (relative to the undeflected position) of tower gage 3; Directed along the local zt-axis -ElastoDyn['TwHt4TDxt'] = False # (m); Local tower fore-aft (translational) deflection (relative to the undeflected position) of tower gage 4; Directed along the local xt-axis -ElastoDyn['TwHt4TDyt'] = False # (m); Local tower side-to-side (translational) deflection (relative to the undeflected position) of tower gage 4; Directed along the local yt-axis -ElastoDyn['TwHt4TDzt'] = False # (m); Local tower axial (translational) deflection (relative to the undeflected position) of tower gage 4; Directed along the local zt-axis -ElastoDyn['TwHt5TDxt'] = False # (m); Local tower fore-aft (translational) deflection (relative to the undeflected position) of tower gage 5; Directed along the local xt-axis -ElastoDyn['TwHt5TDyt'] = False # (m); Local tower side-to-side (translational) deflection (relative to the undeflected position) of tower gage 5; Directed along the local yt-axis -ElastoDyn['TwHt5TDzt'] = False # (m); Local tower axial (translational) deflection (relative to the undeflected position) of tower gage 5; Directed along the local zt-axis -ElastoDyn['TwHt6TDxt'] = False # (m); Local tower fore-aft (translational) deflection (relative to the undeflected position) of tower gage 6; Directed along the local xt-axis -ElastoDyn['TwHt6TDyt'] = False # (m); Local tower side-to-side (translational) deflection (relative to the undeflected position) of tower gage 6; Directed along the local yt-axis -ElastoDyn['TwHt6TDzt'] = False # (m); Local tower axial (translational) deflection (relative to the undeflected position) of tower gage 6; Directed along the local zt-axis -ElastoDyn['TwHt7TDxt'] = False # (m); Local tower fore-aft (translational) deflection (relative to the undeflected position) of tower gage 7; Directed along the local xt-axis -ElastoDyn['TwHt7TDyt'] = False # (m); Local tower side-to-side (translational) deflection (relative to the undeflected position) of tower gage 7; Directed along the local yt-axis -ElastoDyn['TwHt7TDzt'] = False # (m); Local tower axial (translational) deflection (relative to the undeflected position) of tower gage 7; Directed along the local zt-axis -ElastoDyn['TwHt8TDxt'] = False # (m); Local tower fore-aft (translational) deflection (relative to the undeflected position) of tower gage 8; Directed along the local xt-axis -ElastoDyn['TwHt8TDyt'] = False # (m); Local tower side-to-side (translational) deflection (relative to the undeflected position) of tower gage 8; Directed along the local yt-axis -ElastoDyn['TwHt8TDzt'] = False # (m); Local tower axial (translational) deflection (relative to the undeflected position) of tower gage 8; Directed along the local zt-axis -ElastoDyn['TwHt9TDxt'] = False # (m); Local tower fore-aft (translational) deflection (relative to the undeflected position) of tower gage 9; Directed along the local xt-axis -ElastoDyn['TwHt9TDyt'] = False # (m); Local tower side-to-side (translational) deflection (relative to the undeflected position) of tower gage 9; Directed along the local yt-axis -ElastoDyn['TwHt9TDzt'] = False # (m); Local tower axial (translational) deflection (relative to the undeflected position) of tower gage 9; Directed along the local zt-axis -ElastoDyn['TwHt1RDxt'] = False # (deg); Local tower angular (rotational) roll deflection (relative to the undeflected position) of tower gage 1. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower deflections, so that the rotation sequence does not matter.; About the local xt-axis -ElastoDyn['TwHt1RDyt'] = False # (deg); Local tower angular (rotational) pitch deflection (relative to the undeflected position) of tower gage 1. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower deflections, so that the rotation sequence does not matter.; About the local yt-axis -ElastoDyn['TwHt1RDzt'] = False # (deg); Local tower angular (rotational) torsion deflection (relative to the undeflected position) of tower gage 1. This output will always be zero for FAST simulation results. Use it for examining tower torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence.; About the local zt-axis -ElastoDyn['TwHt2RDxt'] = False # (deg); Local tower angular (rotational) roll deflection (relative to the undeflected position) of tower gage 2. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower deflections, so that the rotation sequence does not matter.; About the local xt-axis -ElastoDyn['TwHt2RDyt'] = False # (deg); Local tower angular (rotational) pitch deflection (relative to the undeflected position) of tower gage 2. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower deflections, so that the rotation sequence does not matter.; About the local yt-axis -ElastoDyn['TwHt2RDzt'] = False # (deg); Local tower angular (rotational) torsion deflection (relative to the undeflected position) of tower gage 2. This output will always be zero for FAST simulation results. Use it for examining tower torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence.; About the local zt-axis -ElastoDyn['TwHt3RDxt'] = False # (deg); Local tower angular (rotational) roll deflection (relative to the undeflected position) of tower gage 3. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower deflections, so that the rotation sequence does not matter.; About the local xt-axis -ElastoDyn['TwHt3RDyt'] = False # (deg); Local tower angular (rotational) pitch deflection (relative to the undeflected position) of tower gage 3. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower deflections, so that the rotation sequence does not matter.; About the local yt-axis -ElastoDyn['TwHt3RDzt'] = False # (deg); Local tower angular (rotational) torsion deflection (relative to the undeflected position) of tower gage 3. This output will always be zero for FAST simulation results. Use it for examining tower torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence.; About the local zt-axis -ElastoDyn['TwHt4RDxt'] = False # (deg); Local tower angular (rotational) roll deflection (relative to the undeflected position) of tower gage 4. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower deflections, so that the rotation sequence does not matter.; About the local xt-axis -ElastoDyn['TwHt4RDyt'] = False # (deg); Local tower angular (rotational) pitch deflection (relative to the undeflected position) of tower gage 4. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower deflections, so that the rotation sequence does not matter.; About the local yt-axis -ElastoDyn['TwHt4RDzt'] = False # (deg); Local tower angular (rotational) torsion deflection (relative to the undeflected position) of tower gage 4. This output will always be zero for FAST simulation results. Use it for examining tower torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence.; About the local zt-axis -ElastoDyn['TwHt5RDxt'] = False # (deg); Local tower angular (rotational) roll deflection (relative to the undeflected position) of tower gage 5. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower deflections, so that the rotation sequence does not matter.; About the local xt-axis -ElastoDyn['TwHt5RDyt'] = False # (deg); Local tower angular (rotational) pitch deflection (relative to the undeflected position) of tower gage 5. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower deflections, so that the rotation sequence does not matter.; About the local yt-axis -ElastoDyn['TwHt5RDzt'] = False # (deg); Local tower angular (rotational) torsion deflection (relative to the undeflected position) of tower gage 5. This output will always be zero for FAST simulation results. Use it for examining tower torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence.; About the local zt-axis -ElastoDyn['TwHt6RDxt'] = False # (deg); Local tower angular (rotational) roll deflection (relative to the undeflected position) of tower gage 6. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower deflections, so that the rotation sequence does not matter.; About the local xt-axis -ElastoDyn['TwHt6RDyt'] = False # (deg); Local tower angular (rotational) pitch deflection (relative to the undeflected position) of tower gage 6. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower deflections, so that the rotation sequence does not matter.; About the local yt-axis -ElastoDyn['TwHt6RDzt'] = False # (deg); Local tower angular (rotational) torsion deflection (relative to the undeflected position) of tower gage 6. This output will always be zero for FAST simulation results. Use it for examining tower torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence.; About the local zt-axis -ElastoDyn['TwHt7RDxt'] = False # (deg); Local tower angular (rotational) roll deflection (relative to the undeflected position) of tower gage 7. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower deflections, so that the rotation sequence does not matter.; About the local xt-axis -ElastoDyn['TwHt7RDyt'] = False # (deg); Local tower angular (rotational) pitch deflection (relative to the undeflected position) of tower gage 7. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower deflections, so that the rotation sequence does not matter.; About the local yt-axis -ElastoDyn['TwHt7RDzt'] = False # (deg); Local tower angular (rotational) torsion deflection (relative to the undeflected position) of tower gage 7. This output will always be zero for FAST simulation results. Use it for examining tower torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence.; About the local zt-axis -ElastoDyn['TwHt8RDxt'] = False # (deg); Local tower angular (rotational) roll deflection (relative to the undeflected position) of tower gage 8. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower deflections, so that the rotation sequence does not matter.; About the local xt-axis -ElastoDyn['TwHt8RDyt'] = False # (deg); Local tower angular (rotational) pitch deflection (relative to the undeflected position) of tower gage 8. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower deflections, so that the rotation sequence does not matter.; About the local yt-axis -ElastoDyn['TwHt8RDzt'] = False # (deg); Local tower angular (rotational) torsion deflection (relative to the undeflected position) of tower gage 8. This output will always be zero for FAST simulation results. Use it for examining tower torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence.; About the local zt-axis -ElastoDyn['TwHt9RDxt'] = False # (deg); Local tower angular (rotational) roll deflection (relative to the undeflected position) of tower gage 9. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower deflections, so that the rotation sequence does not matter.; About the local xt-axis -ElastoDyn['TwHt9RDyt'] = False # (deg); Local tower angular (rotational) pitch deflection (relative to the undeflected position) of tower gage 9. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower deflections, so that the rotation sequence does not matter.; About the local yt-axis -ElastoDyn['TwHt9RDzt'] = False # (deg); Local tower angular (rotational) torsion deflection (relative to the undeflected position) of tower gage 9. This output will always be zero for FAST simulation results. Use it for examining tower torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence.; About the local zt-axis -ElastoDyn['TwHt1TPxi'] = False # (m); xi-component of the translational position (relative to the inertia frame) of tower gage 1; Directed along the local xi-axis -ElastoDyn['TwHt1TPyi'] = False # (m); yi-component of the translational position (relative to the inertia frame) of tower gage 1; Directed along the local yi-axis -ElastoDyn['TwHt1TPzi'] = False # (m); zi-component of the translational position (relative to ground level [onshore] or MSL [offshore]) of tower gage 1; Directed along the local zi-axis -ElastoDyn['TwHt2TPxi'] = False # (m); xi-component of the translational position (relative to the inertia frame) of tower gage 2; Directed along the local xi-axis -ElastoDyn['TwHt2TPyi'] = False # (m); yi-component of the translational position (relative to the inertia frame) of tower gage 2; Directed along the local yi-axis -ElastoDyn['TwHt2TPzi'] = False # (m); zi-component of the translational position (relative to ground level [onshore] or MSL [offshore]) of tower gage 2; Directed along the local zi-axis -ElastoDyn['TwHt3TPxi'] = False # (m); xi-component of the translational position (relative to the inertia frame) of tower gage 3; Directed along the local xi-axis -ElastoDyn['TwHt3TPyi'] = False # (m); yi-component of the translational position (relative to the inertia frame) of tower gage 3; Directed along the local yi-axis -ElastoDyn['TwHt3TPzi'] = False # (m); zi-component of the translational position (relative to ground level [onshore] or MSL [offshore]) of tower gage 3; Directed along the local zi-axis -ElastoDyn['TwHt4TPxi'] = False # (m); xi-component of the translational position (relative to the inertia frame) of tower gage 4; Directed along the local xi-axis -ElastoDyn['TwHt4TPyi'] = False # (m); yi-component of the translational position (relative to the inertia frame) of tower gage 4; Directed along the local yi-axis -ElastoDyn['TwHt4TPzi'] = False # (m); zi-component of the translational position (relative to ground level [onshore] or MSL [offshore]) of tower gage 4; Directed along the local zi-axis -ElastoDyn['TwHt5TPxi'] = False # (m); xi-component of the translational position (relative to the inertia frame) of tower gage 5; Directed along the local xi-axis -ElastoDyn['TwHt5TPyi'] = False # (m); yi-component of the translational position (relative to the inertia frame) of tower gage 5; Directed along the local yi-axis -ElastoDyn['TwHt5TPzi'] = False # (m); zi-component of the translational position (relative to ground level [onshore] or MSL [offshore]) of tower gage 5; Directed along the local zi-axis -ElastoDyn['TwHt6TPxi'] = False # (m); xi-component of the translational position (relative to the inertia frame) of tower gage 6; Directed along the local xi-axis -ElastoDyn['TwHt6TPyi'] = False # (m); yi-component of the translational position (relative to the inertia frame) of tower gage 6; Directed along the local yi-axis -ElastoDyn['TwHt6TPzi'] = False # (m); zi-component of the translational position (relative to ground level [onshore] or MSL [offshore]) of tower gage 6; Directed along the local zi-axis -ElastoDyn['TwHt7TPxi'] = False # (m); xi-component of the translational position (relative to the inertia frame) of tower gage 7; Directed along the local xi-axis -ElastoDyn['TwHt7TPyi'] = False # (m); yi-component of the translational position (relative to the inertia frame) of tower gage 7; Directed along the local yi-axis -ElastoDyn['TwHt7TPzi'] = False # (m); zi-component of the translational position (relative to ground level [onshore] or MSL [offshore]) of tower gage 7; Directed along the local zi-axis -ElastoDyn['TwHt8TPxi'] = False # (m); xi-component of the translational position (relative to the inertia frame) of tower gage 8; Directed along the local xi-axis -ElastoDyn['TwHt8TPyi'] = False # (m); yi-component of the translational position (relative to the inertia frame) of tower gage 8; Directed along the local yi-axis -ElastoDyn['TwHt8TPzi'] = False # (m); zi-component of the translational position (relative to ground level [onshore] or MSL [offshore]) of tower gage 8; Directed along the local zi-axis -ElastoDyn['TwHt9TPxi'] = False # (m); xi-component of the translational position (relative to the inertia frame) of tower gage 9; Directed along the local xi-axis -ElastoDyn['TwHt9TPyi'] = False # (m); yi-component of the translational position (relative to the inertia frame) of tower gage 9; Directed along the local yi-axis -ElastoDyn['TwHt9TPzi'] = False # (m); zi-component of the translational position (relative to ground level [onshore] or MSL [offshore]) of tower gage 9; Directed along the local zi-axis -ElastoDyn['TwHt1RPxi'] = False # (deg); xi-component of the rotational position (relative to the inertia frame) of tower gage 1. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower and platform rotational deflections, so that the rotation sequence does not matter.; About the local xi-axis -ElastoDyn['TwHt1RPyi'] = False # (deg); yi-component of the rotational position (relative to the inertia frame) of tower gage 1. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower and platform rotational deflections, so that the rotation sequence does not matter.; About the local yi-axis -ElastoDyn['TwHt1RPzi'] = False # (deg); zi-component of the rotational position (relative to the inertia frame) of tower gage 1. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower and platform rotational deflections, so that the rotation sequence does not matter.; About the local zi-axis -ElastoDyn['TwHt2RPxi'] = False # (deg); xi-component of the rotational position (relative to the inertia frame) of tower gage 2. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower and platform rotational deflections, so that the rotation sequence does not matter.; About the local xi-axis -ElastoDyn['TwHt2RPyi'] = False # (deg); yi-component of the rotational position (relative to the inertia frame) of tower gage 2. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower and platform rotational deflections, so that the rotation sequence does not matter.; About the local yi-axis -ElastoDyn['TwHt2RPzi'] = False # (deg); zi-component of the rotational position (relative to the inertia frame) of tower gage 2. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower and platform rotational deflections, so that the rotation sequence does not matter.; About the local zi-axis -ElastoDyn['TwHt3RPxi'] = False # (deg); xi-component of the rotational position (relative to the inertia frame) of tower gage 3. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower and platform rotational deflections, so that the rotation sequence does not matter.; About the local xi-axis -ElastoDyn['TwHt3RPyi'] = False # (deg); yi-component of the rotational position (relative to the inertia frame) of tower gage 3. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower and platform rotational deflections, so that the rotation sequence does not matter.; About the local yi-axis -ElastoDyn['TwHt3RPzi'] = False # (deg); zi-component of the rotational position (relative to the inertia frame) of tower gage 3. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower and platform rotational deflections, so that the rotation sequence does not matter.; About the local zi-axis -ElastoDyn['TwHt4RPxi'] = False # (deg); xi-component of the rotational position (relative to the inertia frame) of tower gage 4. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower and platform rotational deflections, so that the rotation sequence does not matter.; About the local xi-axis -ElastoDyn['TwHt4RPyi'] = False # (deg); yi-component of the rotational position (relative to the inertia frame) of tower gage 4. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower and platform rotational deflections, so that the rotation sequence does not matter.; About the local yi-axis -ElastoDyn['TwHt4RPzi'] = False # (deg); zi-component of the rotational position (relative to the inertia frame) of tower gage 4. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower and platform rotational deflections, so that the rotation sequence does not matter.; About the local zi-axis -ElastoDyn['TwHt5RPxi'] = False # (deg); xi-component of the rotational position (relative to the inertia frame) of tower gage 5. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower and platform rotational deflections, so that the rotation sequence does not matter.; About the local xi-axis -ElastoDyn['TwHt5RPyi'] = False # (deg); yi-component of the rotational position (relative to the inertia frame) of tower gage 5. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower and platform rotational deflections, so that the rotation sequence does not matter.; About the local yi-axis -ElastoDyn['TwHt5RPzi'] = False # (deg); zi-component of the rotational position (relative to the inertia frame) of tower gage 5. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower and platform rotational deflections, so that the rotation sequence does not matter.; About the local zi-axis -ElastoDyn['TwHt6RPxi'] = False # (deg); xi-component of the rotational position (relative to the inertia frame) of tower gage 6. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower and platform rotational deflections, so that the rotation sequence does not matter.; About the local xi-axis -ElastoDyn['TwHt6RPyi'] = False # (deg); yi-component of the rotational position (relative to the inertia frame) of tower gage 6. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower and platform rotational deflections, so that the rotation sequence does not matter.; About the local yi-axis -ElastoDyn['TwHt6RPzi'] = False # (deg); zi-component of the rotational position (relative to the inertia frame) of tower gage 6. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower and platform rotational deflections, so that the rotation sequence does not matter.; About the local zi-axis -ElastoDyn['TwHt7RPxi'] = False # (deg); xi-component of the rotational position (relative to the inertia frame) of tower gage 7. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower and platform rotational deflections, so that the rotation sequence does not matter.; About the local xi-axis -ElastoDyn['TwHt7RPyi'] = False # (deg); yi-component of the rotational position (relative to the inertia frame) of tower gage 7. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower and platform rotational deflections, so that the rotation sequence does not matter.; About the local yi-axis -ElastoDyn['TwHt7RPzi'] = False # (deg); zi-component of the rotational position (relative to the inertia frame) of tower gage 7. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower and platform rotational deflections, so that the rotation sequence does not matter.; About the local zi-axis -ElastoDyn['TwHt8RPxi'] = False # (deg); xi-component of the rotational position (relative to the inertia frame) of tower gage 8. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower and platform rotational deflections, so that the rotation sequence does not matter.; About the local xi-axis -ElastoDyn['TwHt8RPyi'] = False # (deg); yi-component of the rotational position (relative to the inertia frame) of tower gage 8. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower and platform rotational deflections, so that the rotation sequence does not matter.; About the local yi-axis -ElastoDyn['TwHt8RPzi'] = False # (deg); zi-component of the rotational position (relative to the inertia frame) of tower gage 8. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower and platform rotational deflections, so that the rotation sequence does not matter.; About the local zi-axis -ElastoDyn['TwHt9RPxi'] = False # (deg); xi-component of the rotational position (relative to the inertia frame) of tower gage 9. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower and platform rotational deflections, so that the rotation sequence does not matter.; About the local xi-axis -ElastoDyn['TwHt9RPyi'] = False # (deg); yi-component of the rotational position (relative to the inertia frame) of tower gage 9. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower and platform rotational deflections, so that the rotation sequence does not matter.; About the local yi-axis -ElastoDyn['TwHt9RPzi'] = False # (deg); zi-component of the rotational position (relative to the inertia frame) of tower gage 9. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower and platform rotational deflections, so that the rotation sequence does not matter.; About the local zi-axis - -# Platform Motions -ElastoDyn['PtfmTDxt'] = False # (m); Platform horizontal surge (translational) displacement; Directed along the xt-axis -ElastoDyn['PtfmTDyt'] = False # (m); Platform horizontal sway (translational) displacement; Directed along the yt-axis -ElastoDyn['PtfmTDzt'] = False # (m); Platform vertical heave (translational) displacement; Directed along the zt-axis -ElastoDyn['PtfmTDxi'] = False # (m); Platform horizontal surge (translational) displacement; Directed along the xi-axis -ElastoDyn['PtfmSurge'] = False # (m); Platform horizontal surge (translational) displacement; Directed along the xi-axis -ElastoDyn['PtfmTDyi'] = False # (m); Platform horizontal sway (translational) displacement; Directed along the yi-axis -ElastoDyn['PtfmSway'] = False # (m); Platform horizontal sway (translational) displacement; Directed along the yi-axis -ElastoDyn['PtfmTDzi'] = False # (m); Platform vertical heave (translational) displacement; Directed along the zi-axis -ElastoDyn['PtfmHeave'] = False # (m); Platform vertical heave (translational) displacement; Directed along the zi-axis -ElastoDyn['PtfmTVxt'] = False # (m/s); Platform horizontal surge (translational) velocity; Directed along the xt-axis -ElastoDyn['PtfmTVyt'] = False # (m/s); Platform horizontal sway (translational) velocity; Directed along the yt-axis -ElastoDyn['PtfmTVzt'] = False # (m/s); Platform vertical heave (translational) velocity; Directed along the zt-axis -ElastoDyn['PtfmTVxi'] = False # (m/s); Platform horizontal surge (translational) velocity; Directed along the xi-axis -ElastoDyn['PtfmTVyi'] = False # (m/s); Platform horizontal sway (translational) velocity; Directed along the yi-axis -ElastoDyn['PtfmTVzi'] = False # (m/s); Platform vertical heave (translational) velocity; Directed along the zi-axis -ElastoDyn['PtfmTAxt'] = False # (m/s^2); Platform horizontal surge (translational) acceleration; Directed along the xt-axis -ElastoDyn['PtfmTAyt'] = False # (m/s^2); Platform horizontal sway (translational) acceleration; Directed along the yt-axis -ElastoDyn['PtfmTAzt'] = False # (m/s^2); Platform vertical heave (translational) acceleration; Directed along the zt-axis -ElastoDyn['PtfmTAxi'] = False # (m/s^2); Platform horizontal surge (translational) acceleration; Directed along the xi-axis -ElastoDyn['PtfmTAyi'] = False # (m/s^2); Platform horizontal sway (translational) acceleration; Directed along the yi-axis -ElastoDyn['PtfmTAzi'] = False # (m/s^2); Platform vertical heave (translational) acceleration; Directed along the zi-axis -ElastoDyn['PtfmRDxi'] = False # (deg); Platform roll tilt angular (rotational) displacement. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small rotational platform displacements, so that the rotation sequence does not matter.; About the xi-axis -ElastoDyn['PtfmRoll'] = False # (deg); Platform roll tilt angular (rotational) displacement. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small rotational platform displacements, so that the rotation sequence does not matter.; About the xi-axis -ElastoDyn['PtfmRDyi'] = False # (deg); Platform pitch tilt angular (rotational) displacement. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small rotational platform displacements, so that the rotation sequence does not matter.; About the yi-axis -ElastoDyn['PtfmPitch'] = False # (deg); Platform pitch tilt angular (rotational) displacement. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small rotational platform displacements, so that the rotation sequence does not matter.; About the yi-axis -ElastoDyn['PtfmRDzi'] = False # (deg); Platform yaw angular (rotational) displacement. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small rotational platform displacements, so that the rotation sequence does not matter.; About the zi-axis -ElastoDyn['PtfmYaw'] = False # (deg); Platform yaw angular (rotational) displacement. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small rotational platform displacements, so that the rotation sequence does not matter.; About the zi-axis -ElastoDyn['PtfmRVxt'] = False # (deg/s); Platform roll tilt angular (rotational) velocity; About the xt-axis -ElastoDyn['PtfmRVyt'] = False # (deg/s); Platform pitch tilt angular (rotational) velocity; About the yt-axis -ElastoDyn['PtfmRVzt'] = False # (deg/s); Platform yaw angular (rotational) velocity; About the zt-axis -ElastoDyn['PtfmRVxi'] = False # (deg/s); Platform roll tilt angular (rotational) velocity; About the xi-axis -ElastoDyn['PtfmRVyi'] = False # (deg/s); Platform pitch tilt angular (rotational) velocity; About the yi-axis -ElastoDyn['PtfmRVzi'] = False # (deg/s); Platform yaw angular (rotational) velocity; About the zi-axis -ElastoDyn['PtfmRAxt'] = False # (deg/s^2); Platform roll tilt angular (rotational) acceleration; About the xt-axis -ElastoDyn['PtfmRAyt'] = False # (deg/s^2); Platform pitch tilt angular (rotational) acceleration; About the yt-axis -ElastoDyn['PtfmRAzt'] = False # (deg/s^2); Platform yaw angular (rotational) acceleration; About the zt-axis -ElastoDyn['PtfmRAxi'] = False # (deg/s^2); Platform roll tilt angular (rotational) acceleration; About the xi-axis -ElastoDyn['PtfmRAyi'] = False # (deg/s^2); Platform pitch tilt angular (rotational) acceleration; About the yi-axis -ElastoDyn['PtfmRAzi'] = False # (deg/s^2); Platform yaw angular (rotational) acceleration; About the zi-axis - -# Blade 1 Root Loads -ElastoDyn['RootFxc1'] = False # (kN); Blade 1 out-of-plane shear force at the blade root; Directed along the xc1-axis -ElastoDyn['RootFyc1'] = False # (kN); Blade 1 in-plane shear force at the blade root; Directed along the yc1-axis -ElastoDyn['RootFzc1'] = False # (kN); Blade 1 axial force at the blade root; Directed along the zc1- and zb1-axes -ElastoDyn['RootFzb1'] = False # (kN); Blade 1 axial force at the blade root; Directed along the zc1- and zb1-axes -ElastoDyn['RootFxb1'] = False # (kN); Blade 1 flapwise shear force at the blade root; Directed along the xb1-axis -ElastoDyn['RootFyb1'] = False # (kN); Blade 1 edgewise shear force at the blade root; Directed along the yb1-axis -ElastoDyn['RootMxc1'] = False # (kN-m); Blade 1 in-plane moment (i.e., the moment caused by in-plane forces) at the blade root; About the xc1-axis -ElastoDyn['RootMIP1'] = False # (kN-m); Blade 1 in-plane moment (i.e., the moment caused by in-plane forces) at the blade root; About the xc1-axis -ElastoDyn['RootMyc1'] = False # (kN-m); Blade 1 out-of-plane moment (i.e., the moment caused by out-of-plane forces) at the blade root; About the yc1-axis -ElastoDyn['RootMOoP1'] = False # (kN-m); Blade 1 out-of-plane moment (i.e., the moment caused by out-of-plane forces) at the blade root; About the yc1-axis -ElastoDyn['RootMzc1'] = False # (kN-m); Blade 1 pitching moment at the blade root; About the zc1- and zb1-axes -ElastoDyn['RootMzb1'] = False # (kN-m); Blade 1 pitching moment at the blade root; About the zc1- and zb1-axes -ElastoDyn['RootMxb1'] = False # (kN-m); Blade 1 edgewise moment (i.e., the moment caused by edgewise forces) at the blade root; About the xb1-axis -ElastoDyn['RootMEdg1'] = False # (kN-m); Blade 1 edgewise moment (i.e., the moment caused by edgewise forces) at the blade root; About the xb1-axis -ElastoDyn['RootMyb1'] = True # (kN-m); Blade 1 flapwise moment (i.e., the moment caused by flapwise forces) at the blade root; About the yb1-axis -ElastoDyn['RootMFlp1'] = False # (kN-m); Blade 1 flapwise moment (i.e., the moment caused by flapwise forces) at the blade root; About the yb1-axis - -# Blade 2 Root Loads -ElastoDyn['RootFxc2'] = False # (kN); Blade 2 out-of-plane shear force at the blade root; Directed along the xc2-axis -ElastoDyn['RootFyc2'] = False # (kN); Blade 2 in-plane shear force at the blade root; Directed along the yc2-axis -ElastoDyn['RootFzc2'] = False # (kN); Blade 2 axial force at the blade root; Directed along the zc2- and zb2-axes -ElastoDyn['RootFzb2'] = False # (kN); Blade 2 axial force at the blade root; Directed along the zc2- and zb2-axes -ElastoDyn['RootFxb2'] = False # (kN); Blade 2 flapwise shear force at the blade root; Directed along the xb2-axis -ElastoDyn['RootFyb2'] = False # (kN); Blade 2 edgewise shear force at the blade root; Directed along the yb2-axis -ElastoDyn['RootMxc2'] = False # (kN-m); Blade 2 in-plane moment (i.e., the moment caused by in-plane forces) at the blade root; About the xc2-axis -ElastoDyn['RootMIP2'] = False # (kN-m); Blade 2 in-plane moment (i.e., the moment caused by in-plane forces) at the blade root; About the xc2-axis -ElastoDyn['RootMyc2'] = False # (kN-m); Blade 2 out-of-plane moment (i.e., the moment caused by out-of-plane forces) at the blade root; About the yc2-axis -ElastoDyn['RootMOoP2'] = False # (kN-m); Blade 2 out-of-plane moment (i.e., the moment caused by out-of-plane forces) at the blade root; About the yc2-axis -ElastoDyn['RootMzc2'] = False # (kN-m); Blade 2 pitching moment at the blade root; About the zc2- and zb2-axes -ElastoDyn['RootMzb2'] = False # (kN-m); Blade 2 pitching moment at the blade root; About the zc2- and zb2-axes -ElastoDyn['RootMxb2'] = False # (kN-m); Blade 2 edgewise moment (i.e., the moment caused by edgewise forces) at the blade root; About the xb2-axis -ElastoDyn['RootMEdg2'] = False # (kN-m); Blade 2 edgewise moment (i.e., the moment caused by edgewise forces) at the blade root; About the xb2-axis -ElastoDyn['RootMyb2'] = True # (kN-m); Blade 2 flapwise moment (i.e., the moment caused by flapwise forces) at the blade root; About the yb2-axis -ElastoDyn['RootMFlp2'] = False # (kN-m); Blade 2 flapwise moment (i.e., the moment caused by flapwise forces) at the blade root; About the yb2-axis - -# Blade 3 Root Loads -ElastoDyn['RootFxc3'] = False # (kN); Blade 3 out-of-plane shear force at the blade root; Directed along the xc3-axis -ElastoDyn['RootFyc3'] = False # (kN); Blade 3 in-plane shear force at the blade root; Directed along the yc3-axis -ElastoDyn['RootFzc3'] = False # (kN); Blade 3 axial force at the blade root; Directed along the zc3- and zb3-axes -ElastoDyn['RootFzb3'] = False # (kN); Blade 3 axial force at the blade root; Directed along the zc3- and zb3-axes -ElastoDyn['RootFxb3'] = False # (kN); Blade 3 flapwise shear force at the blade root; Directed along the xb3-axis -ElastoDyn['RootFyb3'] = False # (kN); Blade 3 edgewise shear force at the blade root; Directed along the yb3-axis -ElastoDyn['RootMxc3'] = False # (kN-m); Blade 3 in-plane moment (i.e., the moment caused by in-plane forces) at the blade root; About the xc3-axis -ElastoDyn['RootMIP3'] = False # (kN-m); Blade 3 in-plane moment (i.e., the moment caused by in-plane forces) at the blade root; About the xc3-axis -ElastoDyn['RootMyc3'] = False # (kN-m); Blade 3 out-of-plane moment (i.e., the moment caused by out-of-plane forces) at the blade root; About the yc3-axis -ElastoDyn['RootMOoP3'] = False # (kN-m); Blade 3 out-of-plane moment (i.e., the moment caused by out-of-plane forces) at the blade root; About the yc3-axis -ElastoDyn['RootMzc3'] = False # (kN-m); Blade 3 pitching moment at the blade root; About the zc3- and zb3-axes -ElastoDyn['RootMzb3'] = False # (kN-m); Blade 3 pitching moment at the blade root; About the zc3- and zb3-axes -ElastoDyn['RootMxb3'] = False # (kN-m); Blade 3 edgewise moment (i.e., the moment caused by edgewise forces) at the blade root; About the xb3-axis -ElastoDyn['RootMEdg3'] = False # (kN-m); Blade 3 edgewise moment (i.e., the moment caused by edgewise forces) at the blade root; About the xb3-axis -ElastoDyn['RootMyb3'] = True # (kN-m); Blade 3 flapwise moment (i.e., the moment caused by flapwise forces) at the blade root; About the yb3-axis -ElastoDyn['RootMFlp3'] = False # (kN-m); Blade 3 flapwise moment (i.e., the moment caused by flapwise forces) at the blade root; About the yb3-axis - -# Blade 1 Local Span Loads -ElastoDyn['Spn1MLxb1'] = False # (kN-m); Blade 1 local edgewise moment at span station 1; About the local xb1-axis -ElastoDyn['Spn1MLyb1'] = False # (kN-m); Blade 1 local flapwise moment at span station 1; About the local yb1-axis -ElastoDyn['Spn1MLzb1'] = False # (kN-m); Blade 1 local pitching moment at span station 1; About the local zb1-axis -ElastoDyn['Spn2MLxb1'] = False # (kN-m); Blade 1 local edgewise moment at span station 2; About the local xb1-axis -ElastoDyn['Spn2MLyb1'] = False # (kN-m); Blade 1 local flapwise moment at span station 2; About the local yb1-axis -ElastoDyn['Spn2MLzb1'] = False # (kN-m); Blade 1 local pitching moment at span station 2; About the local zb1-axis -ElastoDyn['Spn3MLxb1'] = False # (kN-m); Blade 1 local edgewise moment at span station 3; About the local xb1-axis -ElastoDyn['Spn3MLyb1'] = False # (kN-m); Blade 1 local flapwise moment at span station 3; About the local yb1-axis -ElastoDyn['Spn3MLzb1'] = False # (kN-m); Blade 1 local pitching moment at span station 3; About the local zb1-axis -ElastoDyn['Spn4MLxb1'] = False # (kN-m); Blade 1 local edgewise moment at span station 4; About the local xb1-axis -ElastoDyn['Spn4MLyb1'] = False # (kN-m); Blade 1 local flapwise moment at span station 4; About the local yb1-axis -ElastoDyn['Spn4MLzb1'] = False # (kN-m); Blade 1 local pitching moment at span station 4; About the local zb1-axis -ElastoDyn['Spn5MLxb1'] = False # (kN-m); Blade 1 local edgewise moment at span station 5; About the local xb1-axis -ElastoDyn['Spn5MLyb1'] = False # (kN-m); Blade 1 local flapwise moment at span station 5; About the local yb1-axis -ElastoDyn['Spn5MLzb1'] = False # (kN-m); Blade 1 local pitching moment at span station 5; About the local zb1-axis -ElastoDyn['Spn6MLxb1'] = False # (kN-m); Blade 1 local edgewise moment at span station 6; About the local xb1-axis -ElastoDyn['Spn6MLyb1'] = False # (kN-m); Blade 1 local flapwise moment at span station 6; About the local yb1-axis -ElastoDyn['Spn6MLzb1'] = False # (kN-m); Blade 1 local pitching moment at span station 6; About the local zb1-axis -ElastoDyn['Spn7MLxb1'] = False # (kN-m); Blade 1 local edgewise moment at span station 7; About the local xb1-axis -ElastoDyn['Spn7MLyb1'] = False # (kN-m); Blade 1 local flapwise moment at span station 7; About the local yb1-axis -ElastoDyn['Spn7MLzb1'] = False # (kN-m); Blade 1 local pitching moment at span station 7; About the local zb1-axis -ElastoDyn['Spn8MLxb1'] = False # (kN-m); Blade 1 local edgewise moment at span station 8; About the local xb1-axis -ElastoDyn['Spn8MLyb1'] = False # (kN-m); Blade 1 local flapwise moment at span station 8; About the local yb1-axis -ElastoDyn['Spn8MLzb1'] = False # (kN-m); Blade 1 local pitching moment at span station 8; About the local zb1-axis -ElastoDyn['Spn9MLxb1'] = False # (kN-m); Blade 1 local edgewise moment at span station 9; About the local xb1-axis -ElastoDyn['Spn9MLyb1'] = False # (kN-m); Blade 1 local flapwise moment at span station 9; About the local yb1-axis -ElastoDyn['Spn9MLzb1'] = False # (kN-m); Blade 1 local pitching moment at span station 9; About the local zb1-axis -ElastoDyn['Spn1FLxb1'] = False # (kN); Blade 1 local flapwise shear force at span station 1; Directed along the local xb1-axis -ElastoDyn['Spn1FLyb1'] = False # (kN); Blade 1 local edgewise shear force at span station 1; Directed along the local yb1-axis -ElastoDyn['Spn1FLzb1'] = False # (kN); Blade 1 local axial force at span station 1; Directed along the local zb1-axis -ElastoDyn['Spn2FLxb1'] = False # (kN); Blade 1 local flapwise shear force at span station 2; Directed along the local xb1-axis -ElastoDyn['Spn2FLyb1'] = False # (kN); Blade 1 local edgewise shear force at span station 2; Directed along the local yb1-axis -ElastoDyn['Spn2FLzb1'] = False # (kN); Blade 1 local axial force at span station 2; Directed along the local zb1-axis -ElastoDyn['Spn3FLxb1'] = False # (kN); Blade 1 local flapwise shear force at span station 3; Directed along the local xb1-axis -ElastoDyn['Spn3FLyb1'] = False # (kN); Blade 1 local edgewise shear force at span station 3; Directed along the local yb1-axis -ElastoDyn['Spn3FLzb1'] = False # (kN); Blade 1 local axial force at span station 3; Directed along the local zb1-axis -ElastoDyn['Spn4FLxb1'] = False # (kN); Blade 1 local flapwise shear force at span station 4; Directed along the local xb1-axis -ElastoDyn['Spn4FLyb1'] = False # (kN); Blade 1 local edgewise shear force at span station 4; Directed along the local yb1-axis -ElastoDyn['Spn4FLzb1'] = False # (kN); Blade 1 local axial force at span station 4; Directed along the local zb1-axis -ElastoDyn['Spn5FLxb1'] = False # (kN); Blade 1 local flapwise shear force at span station 5; Directed along the local xb1-axis -ElastoDyn['Spn5FLyb1'] = False # (kN); Blade 1 local edgewise shear force at span station 5; Directed along the local yb1-axis -ElastoDyn['Spn5FLzb1'] = False # (kN); Blade 1 local axial force at span station 5; Directed along the local zb1-axis -ElastoDyn['Spn6FLxb1'] = False # (kN); Blade 1 local flapwise shear force at span station 6; Directed along the local xb1-axis -ElastoDyn['Spn6FLyb1'] = False # (kN); Blade 1 local edgewise shear force at span station 6; Directed along the local yb1-axis -ElastoDyn['Spn6FLzb1'] = False # (kN); Blade 1 local axial force at span station 6; Directed along the local zb1-axis -ElastoDyn['Spn7FLxb1'] = False # (kN); Blade 1 local flapwise shear force at span station 7; Directed along the local xb1-axis -ElastoDyn['Spn7FLyb1'] = False # (kN); Blade 1 local edgewise shear force at span station 7; Directed along the local yb1-axis -ElastoDyn['Spn7FLzb1'] = False # (kN); Blade 1 local axial force at span station 7; Directed along the local zb1-axis -ElastoDyn['Spn8FLxb1'] = False # (kN); Blade 1 local flapwise shear force at span station 8; Directed along the local xb1-axis -ElastoDyn['Spn8FLyb1'] = False # (kN); Blade 1 local edgewise shear force at span station 8; Directed along the local yb1-axis -ElastoDyn['Spn8FLzb1'] = False # (kN); Blade 1 local axial force at span station 8; Directed along the local zb1-axis -ElastoDyn['Spn9FLxb1'] = False # (kN); Blade 1 local flapwise shear force at span station 9; Directed along the local xb1-axis -ElastoDyn['Spn9FLyb1'] = False # (kN); Blade 1 local edgewise shear force at span station 9; Directed along the local yb1-axis -ElastoDyn['Spn9FLzb1'] = False # (kN); Blade 1 local axial force at span station 9; Directed along the local zb1-axis - -# Blade 2 Local Span Loads -ElastoDyn['Spn1MLxb2'] = False # (kN-m); Blade 2 local edgewise moment at span station 1; About the local xb2-axis -ElastoDyn['Spn1MLyb2'] = False # (kN-m); Blade 2 local flapwise moment at span station 1; About the local yb2-axis -ElastoDyn['Spn1MLzb2'] = False # (kN-m); Blade 2 local pitching moment at span station 1; About the local zb2-axis -ElastoDyn['Spn2MLxb2'] = False # (kN-m); Blade 2 local edgewise moment at span station 2; About the local xb2-axis -ElastoDyn['Spn2MLyb2'] = False # (kN-m); Blade 2 local flapwise moment at span station 2; About the local yb2-axis -ElastoDyn['Spn2MLzb2'] = False # (kN-m); Blade 2 local pitching moment at span station 2; About the local zb2-axis -ElastoDyn['Spn3MLxb2'] = False # (kN-m); Blade 2 local edgewise moment at span station 3; About the local xb2-axis -ElastoDyn['Spn3MLyb2'] = False # (kN-m); Blade 2 local flapwise moment at span station 3; About the local yb2-axis -ElastoDyn['Spn3MLzb2'] = False # (kN-m); Blade 2 local pitching moment at span station 3; About the local zb2-axis -ElastoDyn['Spn4MLxb2'] = False # (kN-m); Blade 2 local edgewise moment at span station 4; About the local xb2-axis -ElastoDyn['Spn4MLyb2'] = False # (kN-m); Blade 2 local flapwise moment at span station 4; About the local yb2-axis -ElastoDyn['Spn4MLzb2'] = False # (kN-m); Blade 2 local pitching moment at span station 4; About the local zb2-axis -ElastoDyn['Spn5MLxb2'] = False # (kN-m); Blade 2 local edgewise moment at span station 5; About the local xb2-axis -ElastoDyn['Spn5MLyb2'] = False # (kN-m); Blade 2 local flapwise moment at span station 5; About the local yb2-axis -ElastoDyn['Spn5MLzb2'] = False # (kN-m); Blade 2 local pitching moment at span station 5; About the local zb2-axis -ElastoDyn['Spn6MLxb2'] = False # (kN-m); Blade 2 local edgewise moment at span station 6; About the local xb2-axis -ElastoDyn['Spn6MLyb2'] = False # (kN-m); Blade 2 local flapwise moment at span station 6; About the local yb2-axis -ElastoDyn['Spn6MLzb2'] = False # (kN-m); Blade 2 local pitching moment at span station 6; About the local zb2-axis -ElastoDyn['Spn7MLxb2'] = False # (kN-m); Blade 2 local edgewise moment at span station 7; About the local xb2-axis -ElastoDyn['Spn7MLyb2'] = False # (kN-m); Blade 2 local flapwise moment at span station 7; About the local yb2-axis -ElastoDyn['Spn7MLzb2'] = False # (kN-m); Blade 2 local pitching moment at span station 7; About the local zb2-axis -ElastoDyn['Spn8MLxb2'] = False # (kN-m); Blade 2 local edgewise moment at span station 8; About the local xb2-axis -ElastoDyn['Spn8MLyb2'] = False # (kN-m); Blade 2 local flapwise moment at span station 8; About the local yb2-axis -ElastoDyn['Spn8MLzb2'] = False # (kN-m); Blade 2 local pitching moment at span station 8; About the local zb2-axis -ElastoDyn['Spn9MLxb2'] = False # (kN-m); Blade 2 local edgewise moment at span station 9; About the local xb2-axis -ElastoDyn['Spn9MLyb2'] = False # (kN-m); Blade 2 local flapwise moment at span station 9; About the local yb2-axis -ElastoDyn['Spn9MLzb2'] = False # (kN-m); Blade 2 local pitching moment at span station 9; About the local zb2-axis -ElastoDyn['Spn1FLxb2'] = False # (kN); Blade 2 local flapwise shear force at span station 1; Directed along the local xb2-axis -ElastoDyn['Spn1FLyb2'] = False # (kN); Blade 2 local edgewise shear force at span station 1; Directed along the local yb2-axis -ElastoDyn['Spn1FLzb2'] = False # (kN); Blade 2 local axial force at span station 1; Directed along the local zb2-axis -ElastoDyn['Spn2FLxb2'] = False # (kN); Blade 2 local flapwise shear force at span station 2; Directed along the local xb2-axis -ElastoDyn['Spn2FLyb2'] = False # (kN); Blade 2 local edgewise shear force at span station 2; Directed along the local yb2-axis -ElastoDyn['Spn2FLzb2'] = False # (kN); Blade 2 local axial force at span station 2; Directed along the local zb2-axis -ElastoDyn['Spn3FLxb2'] = False # (kN); Blade 2 local flapwise shear force at span station 3; Directed along the local xb2-axis -ElastoDyn['Spn3FLyb2'] = False # (kN); Blade 2 local edgewise shear force at span station 3; Directed along the local yb2-axis -ElastoDyn['Spn3FLzb2'] = False # (kN); Blade 2 local axial force at span station 3; Directed along the local zb2-axis -ElastoDyn['Spn4FLxb2'] = False # (kN); Blade 2 local flapwise shear force at span station 4; Directed along the local xb2-axis -ElastoDyn['Spn4FLyb2'] = False # (kN); Blade 2 local edgewise shear force at span station 4; Directed along the local yb2-axis -ElastoDyn['Spn4FLzb2'] = False # (kN); Blade 2 local axial force at span station 4; Directed along the local zb2-axis -ElastoDyn['Spn5FLxb2'] = False # (kN); Blade 2 local flapwise shear force at span station 5; Directed along the local xb2-axis -ElastoDyn['Spn5FLyb2'] = False # (kN); Blade 2 local edgewise shear force at span station 5; Directed along the local yb2-axis -ElastoDyn['Spn5FLzb2'] = False # (kN); Blade 2 local axial force at span station 5; Directed along the local zb2-axis -ElastoDyn['Spn6FLxb2'] = False # (kN); Blade 2 local flapwise shear force at span station 6; Directed along the local xb2-axis -ElastoDyn['Spn6FLyb2'] = False # (kN); Blade 2 local edgewise shear force at span station 6; Directed along the local yb2-axis -ElastoDyn['Spn6FLzb2'] = False # (kN); Blade 2 local axial force at span station 6; Directed along the local zb2-axis -ElastoDyn['Spn7FLxb2'] = False # (kN); Blade 2 local flapwise shear force at span station 7; Directed along the local xb2-axis -ElastoDyn['Spn7FLyb2'] = False # (kN); Blade 2 local edgewise shear force at span station 7; Directed along the local yb2-axis -ElastoDyn['Spn7FLzb2'] = False # (kN); Blade 2 local axial force at span station 7; Directed along the local zb2-axis -ElastoDyn['Spn8FLxb2'] = False # (kN); Blade 2 local flapwise shear force at span station 8; Directed along the local xb2-axis -ElastoDyn['Spn8FLyb2'] = False # (kN); Blade 2 local edgewise shear force at span station 8; Directed along the local yb2-axis -ElastoDyn['Spn8FLzb2'] = False # (kN); Blade 2 local axial force at span station 8; Directed along the local zb2-axis -ElastoDyn['Spn9FLxb2'] = False # (kN); Blade 2 local flapwise shear force at span station 9; Directed along the local xb2-axis -ElastoDyn['Spn9FLyb2'] = False # (kN); Blade 2 local edgewise shear force at span station 9; Directed along the local yb2-axis -ElastoDyn['Spn9FLzb2'] = False # (kN); Blade 2 local axial force at span station 9; Directed along the local zb2-axis - -# Blade 3 Local Span Loads -ElastoDyn['Spn1MLxb3'] = False # (kN-m); Blade 3 local edgewise moment at span station 1; About the local xb3-axis -ElastoDyn['Spn1MLyb3'] = False # (kN-m); Blade 3 local flapwise moment at span station 1; About the local yb3-axis -ElastoDyn['Spn1MLzb3'] = False # (kN-m); Blade 3 local pitching moment at span station 1; About the local zb3-axis -ElastoDyn['Spn2MLxb3'] = False # (kN-m); Blade 3 local edgewise moment at span station 2; About the local xb3-axis -ElastoDyn['Spn2MLyb3'] = False # (kN-m); Blade 3 local flapwise moment at span station 2; About the local yb3-axis -ElastoDyn['Spn2MLzb3'] = False # (kN-m); Blade 3 local pitching moment at span station 2; About the local zb3-axis -ElastoDyn['Spn3MLxb3'] = False # (kN-m); Blade 3 local edgewise moment at span station 3; About the local xb3-axis -ElastoDyn['Spn3MLyb3'] = False # (kN-m); Blade 3 local flapwise moment at span station 3; About the local yb3-axis -ElastoDyn['Spn3MLzb3'] = False # (kN-m); Blade 3 local pitching moment at span station 3; About the local zb3-axis -ElastoDyn['Spn4MLxb3'] = False # (kN-m); Blade 3 local edgewise moment at span station 4; About the local xb3-axis -ElastoDyn['Spn4MLyb3'] = False # (kN-m); Blade 3 local flapwise moment at span station 4; About the local yb3-axis -ElastoDyn['Spn4MLzb3'] = False # (kN-m); Blade 3 local pitching moment at span station 4; About the local zb3-axis -ElastoDyn['Spn5MLxb3'] = False # (kN-m); Blade 3 local edgewise moment at span station 5; About the local xb3-axis -ElastoDyn['Spn5MLyb3'] = False # (kN-m); Blade 3 local flapwise moment at span station 5; About the local yb3-axis -ElastoDyn['Spn5MLzb3'] = False # (kN-m); Blade 3 local pitching moment at span station 5; About the local zb3-axis -ElastoDyn['Spn6MLxb3'] = False # (kN-m); Blade 3 local edgewise moment at span station 6; About the local xb3-axis -ElastoDyn['Spn6MLyb3'] = False # (kN-m); Blade 3 local flapwise moment at span station 6; About the local yb3-axis -ElastoDyn['Spn6MLzb3'] = False # (kN-m); Blade 3 local pitching moment at span station 6; About the local zb3-axis -ElastoDyn['Spn7MLxb3'] = False # (kN-m); Blade 3 local edgewise moment at span station 7; About the local xb3-axis -ElastoDyn['Spn7MLyb3'] = False # (kN-m); Blade 3 local flapwise moment at span station 7; About the local yb3-axis -ElastoDyn['Spn7MLzb3'] = False # (kN-m); Blade 3 local pitching moment at span station 7; About the local zb3-axis -ElastoDyn['Spn8MLxb3'] = False # (kN-m); Blade 3 local edgewise moment at span station 8; About the local xb3-axis -ElastoDyn['Spn8MLyb3'] = False # (kN-m); Blade 3 local flapwise moment at span station 8; About the local yb3-axis -ElastoDyn['Spn8MLzb3'] = False # (kN-m); Blade 3 local pitching moment at span station 8; About the local zb3-axis -ElastoDyn['Spn9MLxb3'] = False # (kN-m); Blade 3 local edgewise moment at span station 9; About the local xb3-axis -ElastoDyn['Spn9MLyb3'] = False # (kN-m); Blade 3 local flapwise moment at span station 9; About the local yb3-axis -ElastoDyn['Spn9MLzb3'] = False # (kN-m); Blade 3 local pitching moment at span station 9; About the local zb3-axis -ElastoDyn['Spn1FLxb3'] = False # (kN); Blade 3 local flapwise shear force at span station 1; Directed along the local xb3-axis -ElastoDyn['Spn1FLyb3'] = False # (kN); Blade 3 local edgewise shear force at span station 1; Directed along the local yb3-axis -ElastoDyn['Spn1FLzb3'] = False # (kN); Blade 3 local axial force at span station 1; Directed along the local zb3-axis -ElastoDyn['Spn2FLxb3'] = False # (kN); Blade 3 local flapwise shear force at span station 2; Directed along the local xb3-axis -ElastoDyn['Spn2FLyb3'] = False # (kN); Blade 3 local edgewise shear force at span station 2; Directed along the local yb3-axis -ElastoDyn['Spn2FLzb3'] = False # (kN); Blade 3 local axial force at span station 2; Directed along the local zb3-axis -ElastoDyn['Spn3FLxb3'] = False # (kN); Blade 3 local flapwise shear force at span station 3; Directed along the local xb3-axis -ElastoDyn['Spn3FLyb3'] = False # (kN); Blade 3 local edgewise shear force at span station 3; Directed along the local yb3-axis -ElastoDyn['Spn3FLzb3'] = False # (kN); Blade 3 local axial force at span station 3; Directed along the local zb3-axis -ElastoDyn['Spn4FLxb3'] = False # (kN); Blade 3 local flapwise shear force at span station 4; Directed along the local xb3-axis -ElastoDyn['Spn4FLyb3'] = False # (kN); Blade 3 local edgewise shear force at span station 4; Directed along the local yb3-axis -ElastoDyn['Spn4FLzb3'] = False # (kN); Blade 3 local axial force at span station 4; Directed along the local zb3-axis -ElastoDyn['Spn5FLxb3'] = False # (kN); Blade 3 local flapwise shear force at span station 5; Directed along the local xb3-axis -ElastoDyn['Spn5FLyb3'] = False # (kN); Blade 3 local edgewise shear force at span station 5; Directed along the local yb3-axis -ElastoDyn['Spn5FLzb3'] = False # (kN); Blade 3 local axial force at span station 5; Directed along the local zb3-axis -ElastoDyn['Spn6FLxb3'] = False # (kN); Blade 3 local flapwise shear force at span station 6; Directed along the local xb3-axis -ElastoDyn['Spn6FLyb3'] = False # (kN); Blade 3 local edgewise shear force at span station 6; Directed along the local yb3-axis -ElastoDyn['Spn6FLzb3'] = False # (kN); Blade 3 local axial force at span station 6; Directed along the local zb3-axis -ElastoDyn['Spn7FLxb3'] = False # (kN); Blade 3 local flapwise shear force at span station 7; Directed along the local xb3-axis -ElastoDyn['Spn7FLyb3'] = False # (kN); Blade 3 local edgewise shear force at span station 7; Directed along the local yb3-axis -ElastoDyn['Spn7FLzb3'] = False # (kN); Blade 3 local axial force at span station 7; Directed along the local zb3-axis -ElastoDyn['Spn8FLxb3'] = False # (kN); Blade 3 local flapwise shear force at span station 8; Directed along the local xb3-axis -ElastoDyn['Spn8FLyb3'] = False # (kN); Blade 3 local edgewise shear force at span station 8; Directed along the local yb3-axis -ElastoDyn['Spn8FLzb3'] = False # (kN); Blade 3 local axial force at span station 8; Directed along the local zb3-axis -ElastoDyn['Spn9FLxb3'] = False # (kN); Blade 3 local flapwise shear force at span station 9; Directed along the local xb3-axis -ElastoDyn['Spn9FLyb3'] = False # (kN); Blade 3 local edgewise shear force at span station 9; Directed along the local yb3-axis -ElastoDyn['Spn9FLzb3'] = False # (kN); Blade 3 local axial force at span station 9; Directed along the local zb3-axis - -# Hub and Rotor Loads -ElastoDyn['LSShftFxa'] = False # (kN); Low-speed shaft thrust force (this is constant along the shaft and is equivalent to the rotor thrust force); Directed along the xa- and xs-axes -ElastoDyn['LSShftFxs'] = False # (kN); Low-speed shaft thrust force (this is constant along the shaft and is equivalent to the rotor thrust force); Directed along the xa- and xs-axes -ElastoDyn['LSSGagFxa'] = False # (kN); Low-speed shaft thrust force (this is constant along the shaft and is equivalent to the rotor thrust force); Directed along the xa- and xs-axes -ElastoDyn['LSSGagFxs'] = False # (kN); Low-speed shaft thrust force (this is constant along the shaft and is equivalent to the rotor thrust force); Directed along the xa- and xs-axes -ElastoDyn['RotThrust'] = False # (kN); Low-speed shaft thrust force (this is constant along the shaft and is equivalent to the rotor thrust force); Directed along the xa- and xs-axes -ElastoDyn['LSShftFya'] = False # (kN); Rotating low-speed shaft shear force (this is constant along the shaft); Directed along the ya-axis -ElastoDyn['LSSGagFya'] = False # (kN); Rotating low-speed shaft shear force (this is constant along the shaft); Directed along the ya-axis -ElastoDyn['LSShftFza'] = False # (kN); Rotating low-speed shaft shear force (this is constant along the shaft); Directed along the za-axis -ElastoDyn['LSSGagFza'] = False # (kN); Rotating low-speed shaft shear force (this is constant along the shaft); Directed along the za-axis -ElastoDyn['LSShftFys'] = True # (kN); Nonrotating low-speed shaft shear force (this is constant along the shaft); Directed along the ys-axis -ElastoDyn['LSSGagFys'] = False # (kN); Nonrotating low-speed shaft shear force (this is constant along the shaft); Directed along the ys-axis -ElastoDyn['LSShftFzs'] = True # (kN); Nonrotating low-speed shaft shear force (this is constant along the shaft); Directed along the zs-axis -ElastoDyn['LSSGagFzs'] = False # (kN); Nonrotating low-speed shaft shear force (this is constant along the shaft); Directed along the zs-axis -ElastoDyn['LSShftMxa'] = False # (kN-m); Low-speed shaft torque (this is constant along the shaft and is equivalent to the rotor torque); About the xa- and xs-axes -ElastoDyn['LSShftMxs'] = False # (kN-m); Low-speed shaft torque (this is constant along the shaft and is equivalent to the rotor torque); About the xa- and xs-axes -ElastoDyn['LSSGagMxa'] = False # (kN-m); Low-speed shaft torque (this is constant along the shaft and is equivalent to the rotor torque); About the xa- and xs-axes -ElastoDyn['LSSGagMxs'] = False # (kN-m); Low-speed shaft torque (this is constant along the shaft and is equivalent to the rotor torque); About the xa- and xs-axes -ElastoDyn['RotTorq'] = False # (kN-m); Low-speed shaft torque (this is constant along the shaft and is equivalent to the rotor torque); About the xa- and xs-axes -ElastoDyn['LSShftTq'] = False # (kN-m); Low-speed shaft torque (this is constant along the shaft and is equivalent to the rotor torque); About the xa- and xs-axes -ElastoDyn['LSSTipMya'] = False # (kN-m); Rotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader); About the ya-axis -ElastoDyn['LSSTipMza'] = False # (kN-m); Rotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader); About the za-axis -ElastoDyn['LSSTipMys'] = True # (kN-m); Nonrotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader); About the ys-axis -ElastoDyn['LSSTipMzs'] = True # (kN-m); Nonrotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader); About the zs-axis -ElastoDyn['RotPwr'] = False # (kW); Rotor power (this is equivalent to the low-speed shaft power); N/A -ElastoDyn['LSShftPwr'] = False # (kW); Rotor power (this is equivalent to the low-speed shaft power); N/A - -# Shaft Strain Gage Loads -ElastoDyn['LSSGagMya'] = False # (kN-m); Rotating low-speed shaft bending moment at the shaft's strain gage (shaft strain gage located by input ShftGagL); About the ya-axis -ElastoDyn['LSSGagMza'] = False # (kN-m); Rotating low-speed shaft bending moment at the shaft's strain gage (shaft strain gage located by input ShftGagL); About the za-axis -ElastoDyn['LSSGagMys'] = False # (kN-m); Nonrotating low-speed shaft bending moment at the shaft's strain gage (shaft strain gage located by input ShftGagL); About the ys-axis -ElastoDyn['LSSGagMzs'] = False # (kN-m); Nonrotating low-speed shaft bending moment at the shaft's strain gage (shaft strain gage located by input ShftGagL); About the zs-axis - -# High-Speed Shaft Loads -ElastoDyn['HSShftTq'] = False # (kN-m); High-speed shaft torque (this is constant along the shaft); Same sign as LSShftTq / RotTorq / LSShftMxa / LSShftMxs / LSSGagMxa / LSSGagMxs -ElastoDyn['HSSBrTq'] = False # (kN-m); High-speed shaft brake torque (i.e., the actual moment applied to the high-speed shaft by the brake); Always positive (indicating dissipation of power) -ElastoDyn['HSShftPwr'] = False # (kW); High-speed shaft power; Same sign as HSShftTq - -# Rotor-Furl Bearing Loads -ElastoDyn['RFrlBrM'] = False # (kN-m); Rotor-furl bearing moment; About the rotor-furl axis - -# Tail-Furl Bearing Loads -ElastoDyn['TFrlBrM'] = False # (kN-m); Tail-furl bearing moment; About the tail-furl axis - -# Tower-Top / Yaw Bearing Loads -ElastoDyn['YawBrFxn'] = False # (kN); Rotating (with nacelle) tower-top / yaw bearing shear force; Directed along the xn-axis -ElastoDyn['YawBrFyn'] = False # (kN); Rotating (with nacelle) tower-top / yaw bearing shear force; Directed along the yn-axis -ElastoDyn['YawBrFzn'] = False # (kN); Tower-top / yaw bearing axial force; Directed along the zn- and zp-axes -ElastoDyn['YawBrFzp'] = False # (kN); Tower-top / yaw bearing axial force; Directed along the zn- and zp-axes -ElastoDyn['YawBrFxp'] = False # (kN); Tower-top / yaw bearing fore-aft (nonrotating) shear force; Directed along the xp-axis -ElastoDyn['YawBrFyp'] = False # (kN); Tower-top / yaw bearing side-to-side (nonrotating) shear force; Directed along the yp-axis -ElastoDyn['YawBrMxn'] = False # (kN-m); Rotating (with nacelle) tower-top / yaw bearing roll moment; About the xn-axis -ElastoDyn['YawBrMyn'] = False # (kN-m); Rotating (with nacelle) tower-top / yaw bearing pitch moment; About the yn-axis -ElastoDyn['YawBrMzn'] = False # (kN-m); Tower-top / yaw bearing yaw moment; About the zn- and zp-axes -ElastoDyn['YawBrMzp'] = False # (kN-m); Tower-top / yaw bearing yaw moment; About the zn- and zp-axes -ElastoDyn['YawBrMxp'] = False # (kN-m); Nonrotating tower-top / yaw bearing roll moment; About the xp-axis -ElastoDyn['YawBrMyp'] = False # (kN-m); Nonrotating tower-top / yaw bearing pitch moment; About the yp-axis - -# Tower Base Loads -ElastoDyn['TwrBsFxt'] = False # (kN); Tower base fore-aft shear force; Directed along the xt-axis -ElastoDyn['TwrBsFyt'] = False # (kN); Tower base side-to-side shear force; Directed along the yt-axis -ElastoDyn['TwrBsFzt'] = False # (kN); Tower base axial force; Directed along the zt-axis -ElastoDyn['TwrBsMxt'] = False # (kN-m); Tower base roll (or side-to-side) moment (i.e., the moment caused by side-to-side forces); About the xt-axis -ElastoDyn['TwrBsMyt'] = True # (kN-m); Tower base pitching (or fore-aft) moment (i.e., the moment caused by fore-aft forces); About the yt-axis -ElastoDyn['TwrBsMzt'] = False # (kN-m); Tower base yaw (or torsional) moment; About the zt-axis - -# Local Tower Loads -ElastoDyn['TwHt1MLxt'] = False # (kN-m); Local tower roll (or side-to-side) moment of tower gage 1; About the local xt-axis -ElastoDyn['TwHt1MLyt'] = False # (kN-m); Local tower pitching (or fore-aft) moment of tower gage 1; About the local yt-axis -ElastoDyn['TwHt1MLzt'] = False # (kN-m); Local tower yaw (or torsional) moment of tower gage 1; About the local zt-axis -ElastoDyn['TwHt2MLxt'] = False # (kN-m); Local tower roll (or side-to-side) moment of tower gage 2; About the local xt-axis -ElastoDyn['TwHt2MLyt'] = False # (kN-m); Local tower pitching (or fore-aft) moment of tower gage 2; About the local yt-axis -ElastoDyn['TwHt2MLzt'] = False # (kN-m); Local tower yaw (or torsional) moment of tower gage 2; About the local zt-axis -ElastoDyn['TwHt3MLxt'] = False # (kN-m); Local tower roll (or side-to-side) moment of tower gage 3; About the local xt-axis -ElastoDyn['TwHt3MLyt'] = False # (kN-m); Local tower pitching (or fore-aft) moment of tower gage 3; About the local yt-axis -ElastoDyn['TwHt3MLzt'] = False # (kN-m); Local tower yaw (or torsional) moment of tower gage 3; About the local zt-axis -ElastoDyn['TwHt4MLxt'] = False # (kN-m); Local tower roll (or side-to-side) moment of tower gage 4; About the local xt-axis -ElastoDyn['TwHt4MLyt'] = False # (kN-m); Local tower pitching (or fore-aft) moment of tower gage 4; About the local yt-axis -ElastoDyn['TwHt4MLzt'] = False # (kN-m); Local tower yaw (or torsional) moment of tower gage 4; About the local zt-axis -ElastoDyn['TwHt5MLxt'] = False # (kN-m); Local tower roll (or side-to-side) moment of tower gage 5; About the local xt-axis -ElastoDyn['TwHt5MLyt'] = False # (kN-m); Local tower pitching (or fore-aft) moment of tower gage 5; About the local yt-axis -ElastoDyn['TwHt5MLzt'] = False # (kN-m); Local tower yaw (or torsional) moment of tower gage 5; About the local zt-axis -ElastoDyn['TwHt6MLxt'] = False # (kN-m); Local tower roll (or side-to-side) moment of tower gage 6; About the local xt-axis -ElastoDyn['TwHt6MLyt'] = False # (kN-m); Local tower pitching (or fore-aft) moment of tower gage 6; About the local yt-axis -ElastoDyn['TwHt6MLzt'] = False # (kN-m); Local tower yaw (or torsional) moment of tower gage 6; About the local zt-axis -ElastoDyn['TwHt7MLxt'] = False # (kN-m); Local tower roll (or side-to-side) moment of tower gage 7; About the local xt-axis -ElastoDyn['TwHt7MLyt'] = False # (kN-m); Local tower pitching (or fore-aft) moment of tower gage 7; About the local yt-axis -ElastoDyn['TwHt7MLzt'] = False # (kN-m); Local tower yaw (or torsional) moment of tower gage 7; About the local zt-axis -ElastoDyn['TwHt8MLxt'] = False # (kN-m); Local tower roll (or side-to-side) moment of tower gage 8; About the local xt-axis -ElastoDyn['TwHt8MLyt'] = False # (kN-m); Local tower pitching (or fore-aft) moment of tower gage 8; About the local yt-axis -ElastoDyn['TwHt8MLzt'] = False # (kN-m); Local tower yaw (or torsional) moment of tower gage 8; About the local zt-axis -ElastoDyn['TwHt9MLxt'] = False # (kN-m); Local tower roll (or side-to-side) moment of tower gage 9; About the local xt-axis -ElastoDyn['TwHt9MLyt'] = False # (kN-m); Local tower pitching (or fore-aft) moment of tower gage 9; About the local yt-axis -ElastoDyn['TwHt9MLzt'] = False # (kN-m); Local tower yaw (or torsional) moment of tower gage 9; About the local zt-axis -ElastoDyn['TwHt1FLxt'] = False # (kN); Local tower roll (or side-to-side) force of tower gage 1; About the local xt-axis -ElastoDyn['TwHt1FLyt'] = False # (kN); Local tower pitching (or fore-aft) force of tower gage 1; About the local yt-axis -ElastoDyn['TwHt1FLzt'] = False # (kN); Local tower yaw (or torsional) force of tower gage 1; About the local zt-axis -ElastoDyn['TwHt2FLxt'] = False # (kN); Local tower roll (or side-to-side) force of tower gage 2; About the local xt-axis -ElastoDyn['TwHt2FLyt'] = False # (kN); Local tower pitching (or fore-aft) force of tower gage 2; About the local yt-axis -ElastoDyn['TwHt2FLzt'] = False # (kN); Local tower yaw (or torsional) force of tower gage 2; About the local zt-axis -ElastoDyn['TwHt3FLxt'] = False # (kN); Local tower roll (or side-to-side) force of tower gage 3; About the local xt-axis -ElastoDyn['TwHt3FLyt'] = False # (kN); Local tower pitching (or fore-aft) force of tower gage 3; About the local yt-axis -ElastoDyn['TwHt3FLzt'] = False # (kN); Local tower yaw (or torsional) force of tower gage 3; About the local zt-axis -ElastoDyn['TwHt4FLxt'] = False # (kN); Local tower roll (or side-to-side) force of tower gage 4; About the local xt-axis -ElastoDyn['TwHt4FLyt'] = False # (kN); Local tower pitching (or fore-aft) force of tower gage 4; About the local yt-axis -ElastoDyn['TwHt4FLzt'] = False # (kN); Local tower yaw (or torsional) force of tower gage 4; About the local zt-axis -ElastoDyn['TwHt5FLxt'] = False # (kN); Local tower roll (or side-to-side) force of tower gage 5; About the local xt-axis -ElastoDyn['TwHt5FLyt'] = False # (kN); Local tower pitching (or fore-aft) force of tower gage 5; About the local yt-axis -ElastoDyn['TwHt5FLzt'] = False # (kN); Local tower yaw (or torsional) force of tower gage 5; About the local zt-axis -ElastoDyn['TwHt6FLxt'] = False # (kN); Local tower roll (or side-to-side) force of tower gage 6; About the local xt-axis -ElastoDyn['TwHt6FLyt'] = False # (kN); Local tower pitching (or fore-aft) force of tower gage 6; About the local yt-axis -ElastoDyn['TwHt6FLzt'] = False # (kN); Local tower yaw (or torsional) force of tower gage 6; About the local zt-axis -ElastoDyn['TwHt7FLxt'] = False # (kN); Local tower roll (or side-to-side) force of tower gage 7; About the local xt-axis -ElastoDyn['TwHt7FLyt'] = False # (kN); Local tower pitching (or fore-aft) force of tower gage 7; About the local yt-axis -ElastoDyn['TwHt7FLzt'] = False # (kN); Local tower yaw (or torsional) force of tower gage 7; About the local zt-axis -ElastoDyn['TwHt8FLxt'] = False # (kN); Local tower roll (or side-to-side) force of tower gage 8; About the local xt-axis -ElastoDyn['TwHt8FLyt'] = False # (kN); Local tower pitching (or fore-aft) force of tower gage 8; About the local yt-axis -ElastoDyn['TwHt8FLzt'] = False # (kN); Local tower yaw (or torsional) force of tower gage 8; About the local zt-axis -ElastoDyn['TwHt9FLxt'] = False # (kN); Local tower roll (or side-to-side) force of tower gage 9; About the local xt-axis -ElastoDyn['TwHt9FLyt'] = False # (kN); Local tower pitching (or fore-aft) force of tower gage 9; About the local yt-axis -ElastoDyn['TwHt9FLzt'] = False # (kN); Local tower yaw (or torsional) force of tower gage 9; About the local zt-axis - -# Internal Degrees of Freedom -ElastoDyn['Q_B1E1'] = False # (m); Displacement of 1st edgewise bending-mode DOF of blade 1; -ElastoDyn['Q_B2E1'] = False # (m); Displacement of 1st edgewise bending-mode DOF of blade 2; -ElastoDyn['Q_B3E1'] = False # (m); Displacement of 1st edgewise bending-mode DOF of blade 3; -ElastoDyn['Q_B1F1'] = False # (m); Displacement of 1st flapwise bending-mode DOF of blade 1; -ElastoDyn['Q_B2F1'] = False # (m); Displacement of 1st flapwise bending-mode DOF of blade 2; -ElastoDyn['Q_B3F1'] = False # (m); Displacement of 1st flapwise bending-mode DOF of blade 3; -ElastoDyn['Q_B1F2'] = False # (m); Displacement of 2nd flapwise bending-mode DOF of blade 1; -ElastoDyn['Q_B2F2'] = False # (m); Displacement of 2nd flapwise bending-mode DOF of blade 2; -ElastoDyn['Q_B3F2'] = False # (m); Displacement of 2nd flapwise bending-mode DOF of blade 3; -ElastoDyn['Q_Teet'] = False # (rad); Displacement of hub teetering DOF; -ElastoDyn['Q_DrTr'] = False # (rad); Displacement of drivetrain rotational-flexibility DOF; -ElastoDyn['Q_GeAz'] = False # (rad); Displacement of variable speed generator DOF; -ElastoDyn['Q_RFrl'] = False # (rad); Displacement of rotor-furl DOF; -ElastoDyn['Q_TFrl'] = False # (rad); Displacement of tail-furl DOF; -ElastoDyn['Q_Yaw'] = False # (rad); Displacement of nacelle yaw DOF; -ElastoDyn['Q_TFA1'] = False # (m); Displacement of 1st tower fore-aft bending mode DOF; -ElastoDyn['Q_TSS1'] = False # (m); Displacement of 1st tower side-to-side bending mode DOF; -ElastoDyn['Q_TFA2'] = False # (m); Displacement of 2nd tower fore-aft bending mode DOF; -ElastoDyn['Q_TSS2'] = False # (m); Displacement of 2nd tower side-to-side bending mode DOF; -ElastoDyn['Q_Sg'] = False # (m); Displacement of platform horizontal surge translation DOF; -ElastoDyn['Q_Sw'] = False # (m); Displacement of platform horizontal sway translation DOF; -ElastoDyn['Q_Hv'] = False # (m); Displacement of platform vertical heave translation DOF; -ElastoDyn['Q_R'] = False # (rad); Displacement of platform roll tilt rotation DOF; -ElastoDyn['Q_P'] = False # (rad); Displacement of platform pitch tilt rotation DOF; -ElastoDyn['Q_Y'] = False # (rad); Displacement of platform yaw rotation DOF; -ElastoDyn['QD_B1E1'] = False # (m/s); Velocity of 1st edgewise bending-mode DOF of blade 1; -ElastoDyn['QD_B2E1'] = False # (m/s); Velocity of 1st edgewise bending-mode DOF of blade 2; -ElastoDyn['QD_B3E1'] = False # (m/s); Velocity of 1st edgewise bending-mode DOF of blade 3; -ElastoDyn['QD_B1F1'] = False # (m/s); Velocity of 1st flapwise bending-mode DOF of blade 1; -ElastoDyn['QD_B2F1'] = False # (m/s); Velocity of 1st flapwise bending-mode DOF of blade 2; -ElastoDyn['QD_B3F1'] = False # (m/s); Velocity of 1st flapwise bending-mode DOF of blade 3; -ElastoDyn['QD_B1F2'] = False # (m/s); Velocity of 2nd flapwise bending-mode DOF of blade 1; -ElastoDyn['QD_B2F2'] = False # (m/s); Velocity of 2nd flapwise bending-mode DOF of blade 2; -ElastoDyn['QD_B3F2'] = False # (m/s); Velocity of 2nd flapwise bending-mode DOF of blade 3; -ElastoDyn['QD_Teet'] = False # (rad/s); Velocity of hub teetering DOF; -ElastoDyn['QD_DrTr'] = False # (rad/s); Velocity of drivetrain rotational-flexibility DOF; -ElastoDyn['QD_GeAz'] = False # (rad/s); Velocity of variable speed generator DOF; -ElastoDyn['QD_RFrl'] = False # (rad/s); Velocity of rotor-furl DOF; -ElastoDyn['QD_TFrl'] = False # (rad/s); Velocity of tail-furl DOF; -ElastoDyn['QD_Yaw'] = False # (rad/s); Velocity of nacelle yaw DOF; -ElastoDyn['QD_TFA1'] = False # (m/s); Velocity of 1st tower fore-aft bending mode DOF; -ElastoDyn['QD_TSS1'] = False # (m/s); Velocity of 1st tower side-to-side bending mode DOF; -ElastoDyn['QD_TFA2'] = False # (m/s); Velocity of 2nd tower fore-aft bending mode DOF; -ElastoDyn['QD_TSS2'] = False # (m/s); Velocity of 2nd tower side-to-side bending mode DOF; -ElastoDyn['QD_Sg'] = False # (m/s); Velocity of platform horizontal surge translation DOF; -ElastoDyn['QD_Sw'] = False # (m/s); Velocity of platform horizontal sway translation DOF; -ElastoDyn['QD_Hv'] = False # (m/s); Velocity of platform vertical heave translation DOF; -ElastoDyn['QD_R'] = False # (rad/s); Velocity of platform roll tilt rotation DOF; -ElastoDyn['QD_P'] = False # (rad/s); Velocity of platform pitch tilt rotation DOF; -ElastoDyn['QD_Y'] = False # (rad/s); Velocity of platform yaw rotation DOF; -ElastoDyn['QD2_B1E1'] = False # (m/s^2); Acceleration of 1st edgewise bending-mode DOF of blade 1; -ElastoDyn['QD2_B2E1'] = False # (m/s^2); Acceleration of 1st edgewise bending-mode DOF of blade 2; -ElastoDyn['QD2_B3E1'] = False # (m/s^2); Acceleration of 1st edgewise bending-mode DOF of blade 3; -ElastoDyn['QD2_B1F1'] = False # (m/s^2); Acceleration of 1st flapwise bending-mode DOF of blade 1; -ElastoDyn['QD2_B2F1'] = False # (m/s^2); Acceleration of 1st flapwise bending-mode DOF of blade 2; -ElastoDyn['QD2_B3F1'] = False # (m/s^2); Acceleration of 1st flapwise bending-mode DOF of blade 3; -ElastoDyn['QD2_B1F2'] = False # (m/s^2); Acceleration of 2nd flapwise bending-mode DOF of blade 1; -ElastoDyn['QD2_B2F2'] = False # (m/s^2); Acceleration of 2nd flapwise bending-mode DOF of blade 2; -ElastoDyn['QD2_B3F2'] = False # (m/s^2); Acceleration of 2nd flapwise bending-mode DOF of blade 3; -ElastoDyn['QD2_Teet'] = False # (rad/s^2); Acceleration of hub teetering DOF; -ElastoDyn['QD2_DrTr'] = False # (rad/s^2); Acceleration of drivetrain rotational-flexibility DOF; -ElastoDyn['QD2_GeAz'] = False # (rad/s^2); Acceleration of variable speed generator DOF; -ElastoDyn['QD2_RFrl'] = False # (rad/s^2); Acceleration of rotor-furl DOF; -ElastoDyn['QD2_TFrl'] = False # (rad/s^2); Acceleration of tail-furl DOF; -ElastoDyn['QD2_Yaw'] = False # (rad/s^2); Acceleration of nacelle yaw DOF; -ElastoDyn['QD2_TFA1'] = False # (m/s^2); Acceleration of 1st tower fore-aft bending mode DOF; -ElastoDyn['QD2_TSS1'] = False # (m/s^2); Acceleration of 1st tower side-to-side bending mode DOF; -ElastoDyn['QD2_TFA2'] = False # (m/s^2); Acceleration of 2nd tower fore-aft bending mode DOF; -ElastoDyn['QD2_TSS2'] = False # (m/s^2); Acceleration of 2nd tower side-to-side bending mode DOF; -ElastoDyn['QD2_Sg'] = False # (m/s^2); Acceleration of platform horizontal surge translation DOF; -ElastoDyn['QD2_Sw'] = False # (m/s^2); Acceleration of platform horizontal sway translation DOF; -ElastoDyn['QD2_Hv'] = False # (m/s^2); Acceleration of platform vertical heave translation DOF; -ElastoDyn['QD2_R'] = False # (rad/s^2); Acceleration of platform roll tilt rotation DOF; -ElastoDyn['QD2_P'] = False # (rad/s^2); Acceleration of platform pitch tilt rotation DOF; -ElastoDyn['QD2_Y'] = False # (rad/s^2); Acceleration of platform yaw rotation DOF; - - -""" BeamDyn """ -BeamDyn = {} - -# Reaction Loads -BeamDyn['RootFxr'] = False # (N); x-component of the root reaction force expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system -BeamDyn['RootFyr'] = False # (N); y-component of the root reaction force expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system -BeamDyn['RootFzr'] = False # (N); z-component of the root reaction force expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system -BeamDyn['RootMxr'] = False # (N-m); x-component of the root reaction moment expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system -BeamDyn['RootMyr'] = False # (N-m); y-component of the root reaction moment expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system -BeamDyn['RootMzr'] = False # (N-m); z-component of the root reaction moment expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system - -# Tip Motions -BeamDyn['TipTDxr'] = False # (m); Tip translational deflection (relative to the undeflected position) expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system -BeamDyn['TipTDyr'] = False # (m); Tip translational deflection (relative to the undeflected position) expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system -BeamDyn['TipTDzr'] = False # (m); Tip translational deflection (relative to the undeflected position) expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system -BeamDyn['TipRDxr'] = False # (-); Tip angular/rotational deflection Wiener-Milenkovi parameter (relative to the undeflected orientation) expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system -BeamDyn['TipRDyr'] = False # (-); Tip angular/rotational deflection Wiener-Milenkovi parameter (relative to the undeflected orientation) expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system -BeamDyn['TipRDzr'] = False # (-); Tip angular/rotational deflection Wiener-Milenkovi parameter (relative to the undeflected orientation) expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system -BeamDyn['TipTVXg'] = False # (m/s); Tip translational velocities (absolute) expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system -BeamDyn['TipTVYg'] = False # (m/s); Tip translational velocities (absolute) expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system -BeamDyn['TipTVZg'] = False # (m/s); Tip translational velocities (absolute) expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system -BeamDyn['TipRVXg'] = False # (deg/s); Tip angular/rotational velocities (absolute) expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system -BeamDyn['TipRVYg'] = False # (deg/s); Tip angular/rotational velocities (absolute) expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system -BeamDyn['TipRVZg'] = False # (deg/s); Tip angular/rotational velocities (absolute) expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system -BeamDyn['TipTAXl'] = False # (m/s^2); Tip translational accelerations (absolute) expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['TipTAYl'] = False # (m/s^2); Tip translational accelerations (absolute) expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['TipTAZl'] = False # (m/s^2); Tip translational accelerations (absolute) expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['TipRAXl'] = False # (deg/s^2); Tip angular/rotational accelerations (absolute) expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['TipRAYl'] = False # (deg/s^2); Tip angular/rotational accelerations (absolute) expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['TipRAZl'] = False # (deg/s^2); Tip angular/rotational accelerations (absolute) expressed in l; l: a floating coordinate system local to the deflected beam - -# Sectional Loads -BeamDyn['N1Fxl'] = False # (N); Sectional force resultants at Node 1 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N1Fyl'] = False # (N); Sectional force resultants at Node 1 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N1Fzl'] = False # (N); Sectional force resultants at Node 1 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N2Fxl'] = False # (N); Sectional force resultants at Node 2 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N2Fyl'] = False # (N); Sectional force resultants at Node 2 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N2Fzl'] = False # (N); Sectional force resultants at Node 2 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N3Fxl'] = False # (N); Sectional force resultants at Node 3 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N3Fyl'] = False # (N); Sectional force resultants at Node 3 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N3Fzl'] = False # (N); Sectional force resultants at Node 3 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N4Fxl'] = False # (N); Sectional force resultants at Node 4 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N4Fyl'] = False # (N); Sectional force resultants at Node 4 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N4Fzl'] = False # (N); Sectional force resultants at Node 4 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N5Fxl'] = False # (N); Sectional force resultants at Node 5 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N5Fyl'] = False # (N); Sectional force resultants at Node 5 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N5Fzl'] = False # (N); Sectional force resultants at Node 5 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N6Fxl'] = False # (N); Sectional force resultants at Node 6 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N6Fyl'] = False # (N); Sectional force resultants at Node 6 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N6Fzl'] = False # (N); Sectional force resultants at Node 6 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N7Fxl'] = False # (N); Sectional force resultants at Node 7 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N7Fyl'] = False # (N); Sectional force resultants at Node 7 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N7Fzl'] = False # (N); Sectional force resultants at Node 7 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N8Fxl'] = False # (N); Sectional force resultants at Node 8 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N8Fyl'] = False # (N); Sectional force resultants at Node 8 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N8Fzl'] = False # (N); Sectional force resultants at Node 8 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N9Fxl'] = False # (N); Sectional force resultants at Node 9 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N9Fyl'] = False # (N); Sectional force resultants at Node 9 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N9Fzl'] = False # (N); Sectional force resultants at Node 9 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N1Mxl'] = False # (N-m); Sectional moment resultants at Node 1 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N1Myl'] = False # (N-m); Sectional moment resultants at Node 1 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N1Mzl'] = False # (N-m); Sectional moment resultants at Node 1 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N2Mxl'] = False # (N-m); Sectional moment resultants at Node 2 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N2Myl'] = False # (N-m); Sectional moment resultants at Node 2 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N2Mzl'] = False # (N-m); Sectional moment resultants at Node 2 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N3Mxl'] = False # (N-m); Sectional moment resultants at Node 3 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N3Myl'] = False # (N-m); Sectional moment resultants at Node 3 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N3Mzl'] = False # (N-m); Sectional moment resultants at Node 3 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N4Mxl'] = False # (N-m); Sectional moment resultants at Node 4 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N4Myl'] = False # (N-m); Sectional moment resultants at Node 4 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N4Mzl'] = False # (N-m); Sectional moment resultants at Node 4 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N5Mxl'] = False # (N-m); Sectional moment resultants at Node 5 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N5Myl'] = False # (N-m); Sectional moment resultants at Node 5 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N5Mzl'] = False # (N-m); Sectional moment resultants at Node 5 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N6Mxl'] = False # (N-m); Sectional moment resultants at Node 6 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N6Myl'] = False # (N-m); Sectional moment resultants at Node 6 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N6Mzl'] = False # (N-m); Sectional moment resultants at Node 6 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N7Mxl'] = False # (N-m); Sectional moment resultants at Node 7 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N7Myl'] = False # (N-m); Sectional moment resultants at Node 7 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N7Mzl'] = False # (N-m); Sectional moment resultants at Node 7 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N8Mxl'] = False # (N-m); Sectional moment resultants at Node 8 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N8Myl'] = False # (N-m); Sectional moment resultants at Node 8 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N8Mzl'] = False # (N-m); Sectional moment resultants at Node 8 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N9Mxl'] = False # (N-m); Sectional moment resultants at Node 9 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N9Myl'] = False # (N-m); Sectional moment resultants at Node 9 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N9Mzl'] = False # (N-m); Sectional moment resultants at Node 9 expressed in l; l: a floating coordinate system local to the deflected beam - -# Sectional Motions -BeamDyn['N1TDxr'] = False # (m); Sectional translational deflection (relative to the undeflected position) at Node 1 expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system -BeamDyn['N1TDyr'] = False # (m); Sectional translational deflection (relative to the undeflected position) at Node 1 expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system -BeamDyn['N1TDzr'] = False # (m); Sectional translational deflection (relative to the undeflected position) at Node 1 expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system -BeamDyn['N2TDxr'] = False # (m); Sectional translational deflection (relative to the undeflected position) at Node 2 expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system -BeamDyn['N2TDyr'] = False # (m); Sectional translational deflection (relative to the undeflected position) at Node 2 expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system -BeamDyn['N2TDzr'] = False # (m); Sectional translational deflection (relative to the undeflected position) at Node 2 expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system -BeamDyn['N3TDxr'] = False # (m); Sectional translational deflection (relative to the undeflected position) at Node 3 expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system -BeamDyn['N3TDyr'] = False # (m); Sectional translational deflection (relative to the undeflected position) at Node 3 expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system -BeamDyn['N3TDzr'] = False # (m); Sectional translational deflection (relative to the undeflected position) at Node 3 expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system -BeamDyn['N4TDxr'] = False # (m); Sectional translational deflection (relative to the undeflected position) at Node 4 expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system -BeamDyn['N4TDyr'] = False # (m); Sectional translational deflection (relative to the undeflected position) at Node 4 expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system -BeamDyn['N4TDzr'] = False # (m); Sectional translational deflection (relative to the undeflected position) at Node 4 expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system -BeamDyn['N5TDxr'] = False # (m); Sectional translational deflection (relative to the undeflected position) at Node 5 expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system -BeamDyn['N5TDyr'] = False # (m); Sectional translational deflection (relative to the undeflected position) at Node 5 expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system -BeamDyn['N5TDzr'] = False # (m); Sectional translational deflection (relative to the undeflected position) at Node 5 expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system -BeamDyn['N6TDxr'] = False # (m); Sectional translational deflection (relative to the undeflected position) at Node 6 expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system -BeamDyn['N6TDyr'] = False # (m); Sectional translational deflection (relative to the undeflected position) at Node 6 expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system -BeamDyn['N6TDzr'] = False # (m); Sectional translational deflection (relative to the undeflected position) at Node 6 expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system -BeamDyn['N7TDxr'] = False # (m); Sectional translational deflection (relative to the undeflected position) at Node 7 expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system -BeamDyn['N7TDyr'] = False # (m); Sectional translational deflection (relative to the undeflected position) at Node 7 expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system -BeamDyn['N7TDzr'] = False # (m); Sectional translational deflection (relative to the undeflected position) at Node 7 expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system -BeamDyn['N8TDxr'] = False # (m); Sectional translational deflection (relative to the undeflected position) at Node 8 expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system -BeamDyn['N8TDyr'] = False # (m); Sectional translational deflection (relative to the undeflected position) at Node 8 expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system -BeamDyn['N8TDzr'] = False # (m); Sectional translational deflection (relative to the undeflected position) at Node 8 expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system -BeamDyn['N9TDxr'] = False # (m); Sectional translational deflection (relative to the undeflected position) at Node 9 expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system -BeamDyn['N9TDyr'] = False # (m); Sectional translational deflection (relative to the undeflected position) at Node 9 expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system -BeamDyn['N9TDzr'] = False # (m); Sectional translational deflection (relative to the undeflected position) at Node 9 expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system -BeamDyn['N1RDxr'] = False # (-); Sectional angular/rotational deflection Wiener-Milenkovic parameter (relative to the undeflected orientation) at Node 1 expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system -BeamDyn['N1RDyr'] = False # (-); Sectional angular/rotational deflection Wiener-Milenkovic parameter (relative to the undeflected orientation) at Node 1 expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system -BeamDyn['N1RDzr'] = False # (-); Sectional angular/rotational deflection Wiener-Milenkovic parameter (relative to the undeflected orientation) at Node 1 expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system -BeamDyn['N2RDxr'] = False # (-); Sectional angular/rotational deflection Wiener-Milenkovic parameter (relative to the undeflected orientation) at Node 2 expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system -BeamDyn['N2RDyr'] = False # (-); Sectional angular/rotational deflection Wiener-Milenkovic parameter (relative to the undeflected orientation) at Node 2 expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system -BeamDyn['N2RDzr'] = False # (-); Sectional angular/rotational deflection Wiener-Milenkovic parameter (relative to the undeflected orientation) at Node 2 expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system -BeamDyn['N3RDxr'] = False # (-); Sectional angular/rotational deflection Wiener-Milenkovic parameter (relative to the undeflected orientation) at Node 3 expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system -BeamDyn['N3RDyr'] = False # (-); Sectional angular/rotational deflection Wiener-Milenkovic parameter (relative to the undeflected orientation) at Node 3 expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system -BeamDyn['N3RDzr'] = False # (-); Sectional angular/rotational deflection Wiener-Milenkovic parameter (relative to the undeflected orientation) at Node 3 expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system -BeamDyn['N4RDxr'] = False # (-); Sectional angular/rotational deflection Wiener-Milenkovic parameter (relative to the undeflected orientation) at Node 4 expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system -BeamDyn['N4RDyr'] = False # (-); Sectional angular/rotational deflection Wiener-Milenkovic parameter (relative to the undeflected orientation) at Node 4 expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system -BeamDyn['N4RDzr'] = False # (-); Sectional angular/rotational deflection Wiener-Milenkovic parameter (relative to the undeflected orientation) at Node 4 expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system -BeamDyn['N5RDxr'] = False # (-); Sectional angular/rotational deflection Wiener-Milenkovic parameter (relative to the undeflected orientation) at Node 5 expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system -BeamDyn['N5RDyr'] = False # (-); Sectional angular/rotational deflection Wiener-Milenkovic parameter (relative to the undeflected orientation) at Node 5 expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system -BeamDyn['N5RDzr'] = False # (-); Sectional angular/rotational deflection Wiener-Milenkovic parameter (relative to the undeflected orientation) at Node 5 expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system -BeamDyn['N6RDxr'] = False # (-); Sectional angular/rotational deflection Wiener-Milenkovic parameter (relative to the undeflected orientation) at Node 6 expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system -BeamDyn['N6RDyr'] = False # (-); Sectional angular/rotational deflection Wiener-Milenkovic parameter (relative to the undeflected orientation) at Node 6 expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system -BeamDyn['N6RDzr'] = False # (-); Sectional angular/rotational deflection Wiener-Milenkovic parameter (relative to the undeflected orientation) at Node 6 expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system -BeamDyn['N7RDxr'] = False # (-); Sectional angular/rotational deflection Wiener-Milenkovic parameter (relative to the undeflected orientation) at Node 7 expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system -BeamDyn['N7RDyr'] = False # (-); Sectional angular/rotational deflection Wiener-Milenkovic parameter (relative to the undeflected orientation) at Node 7 expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system -BeamDyn['N7RDzr'] = False # (-); Sectional angular/rotational deflection Wiener-Milenkovic parameter (relative to the undeflected orientation) at Node 7 expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system -BeamDyn['N8RDxr'] = False # (-); Sectional angular/rotational deflection Wiener-Milenkovic parameter (relative to the undeflected orientation) at Node 8 expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system -BeamDyn['N8RDyr'] = False # (-); Sectional angular/rotational deflection Wiener-Milenkovic parameter (relative to the undeflected orientation) at Node 8 expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system -BeamDyn['N8RDzr'] = False # (-); Sectional angular/rotational deflection Wiener-Milenkovic parameter (relative to the undeflected orientation) at Node 8 expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system -BeamDyn['N9RDxr'] = False # (-); Sectional angular/rotational deflection Wiener-Milenkovic parameter (relative to the undeflected orientation) at Node 9 expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system -BeamDyn['N9RDyr'] = False # (-); Sectional angular/rotational deflection Wiener-Milenkovic parameter (relative to the undeflected orientation) at Node 9 expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system -BeamDyn['N9RDzr'] = False # (-); Sectional angular/rotational deflection Wiener-Milenkovic parameter (relative to the undeflected orientation) at Node 9 expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system -BeamDyn['N1TVXg'] = False # (m/s); Sectional translational velocities (absolute) at Node 1 expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system -BeamDyn['N1TVYg'] = False # (m/s); Sectional translational velocities (absolute) at Node 1 expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system -BeamDyn['N1TVZg'] = False # (m/s); Sectional translational velocities (absolute) at Node 1 expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system -BeamDyn['N2TVXg'] = False # (m/s); Sectional translational velocities (absolute) at Node 2 expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system -BeamDyn['N2TVYg'] = False # (m/s); Sectional translational velocities (absolute) at Node 2 expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system -BeamDyn['N2TVZg'] = False # (m/s); Sectional translational velocities (absolute) at Node 2 expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system -BeamDyn['N3TVXg'] = False # (m/s); Sectional translational velocities (absolute) at Node 3 expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system -BeamDyn['N3TVYg'] = False # (m/s); Sectional translational velocities (absolute) at Node 3 expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system -BeamDyn['N3TVZg'] = False # (m/s); Sectional translational velocities (absolute) at Node 3 expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system -BeamDyn['N4TVXg'] = False # (m/s); Sectional translational velocities (absolute) at Node 4 expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system -BeamDyn['N4TVYg'] = False # (m/s); Sectional translational velocities (absolute) at Node 4 expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system -BeamDyn['N4TVZg'] = False # (m/s); Sectional translational velocities (absolute) at Node 4 expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system -BeamDyn['N5TVXg'] = False # (m/s); Sectional translational velocities (absolute) at Node 5 expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system -BeamDyn['N5TVYg'] = False # (m/s); Sectional translational velocities (absolute) at Node 5 expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system -BeamDyn['N5TVZg'] = False # (m/s); Sectional translational velocities (absolute) at Node 5 expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system -BeamDyn['N6TVXg'] = False # (m/s); Sectional translational velocities (absolute) at Node 6 expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system -BeamDyn['N6TVYg'] = False # (m/s); Sectional translational velocities (absolute) at Node 6 expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system -BeamDyn['N6TVZg'] = False # (m/s); Sectional translational velocities (absolute) at Node 6 expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system -BeamDyn['N7TVXg'] = False # (m/s); Sectional translational velocities (absolute) at Node 7 expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system -BeamDyn['N7TVYg'] = False # (m/s); Sectional translational velocities (absolute) at Node 7 expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system -BeamDyn['N7TVZg'] = False # (m/s); Sectional translational velocities (absolute) at Node 7 expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system -BeamDyn['N8TVXg'] = False # (m/s); Sectional translational velocities (absolute) at Node 8 expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system -BeamDyn['N8TVYg'] = False # (m/s); Sectional translational velocities (absolute) at Node 8 expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system -BeamDyn['N8TVZg'] = False # (m/s); Sectional translational velocities (absolute) at Node 8 expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system -BeamDyn['N9TVXg'] = False # (m/s); Sectional translational velocities (absolute) at Node 9 expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system -BeamDyn['N9TVYg'] = False # (m/s); Sectional translational velocities (absolute) at Node 9 expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system -BeamDyn['N9TVZg'] = False # (m/s); Sectional translational velocities (absolute) at Node 9 expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system -BeamDyn['N1RVXg'] = False # (deg/s); Sectional angular/rotational velocities (absolute) at Node 1 expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system -BeamDyn['N1RVYg'] = False # (deg/s); Sectional angular/rotational velocities (absolute) at Node 1 expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system -BeamDyn['N1RVZg'] = False # (deg/s); Sectional angular/rotational velocities (absolute) at Node 1 expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system -BeamDyn['N2RVXg'] = False # (deg/s); Sectional angular/rotational velocities (absolute) at Node 2 expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system -BeamDyn['N2RVYg'] = False # (deg/s); Sectional angular/rotational velocities (absolute) at Node 2 expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system -BeamDyn['N2RVZg'] = False # (deg/s); Sectional angular/rotational velocities (absolute) at Node 2 expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system -BeamDyn['N3RVXg'] = False # (deg/s); Sectional angular/rotational velocities (absolute) at Node 3 expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system -BeamDyn['N3RVYg'] = False # (deg/s); Sectional angular/rotational velocities (absolute) at Node 3 expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system -BeamDyn['N3RVZg'] = False # (deg/s); Sectional angular/rotational velocities (absolute) at Node 3 expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system -BeamDyn['N4RVXg'] = False # (deg/s); Sectional angular/rotational velocities (absolute) at Node 4 expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system -BeamDyn['N4RVYg'] = False # (deg/s); Sectional angular/rotational velocities (absolute) at Node 4 expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system -BeamDyn['N4RVZg'] = False # (deg/s); Sectional angular/rotational velocities (absolute) at Node 4 expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system -BeamDyn['N5RVXg'] = False # (deg/s); Sectional angular/rotational velocities (absolute) at Node 5 expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system -BeamDyn['N5RVYg'] = False # (deg/s); Sectional angular/rotational velocities (absolute) at Node 5 expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system -BeamDyn['N5RVZg'] = False # (deg/s); Sectional angular/rotational velocities (absolute) at Node 5 expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system -BeamDyn['N6RVXg'] = False # (deg/s); Sectional angular/rotational velocities (absolute) at Node 6 expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system -BeamDyn['N6RVYg'] = False # (deg/s); Sectional angular/rotational velocities (absolute) at Node 6 expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system -BeamDyn['N6RVZg'] = False # (deg/s); Sectional angular/rotational velocities (absolute) at Node 6 expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system -BeamDyn['N7RVXg'] = False # (deg/s); Sectional angular/rotational velocities (absolute) at Node 7 expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system -BeamDyn['N7RVYg'] = False # (deg/s); Sectional angular/rotational velocities (absolute) at Node 7 expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system -BeamDyn['N7RVZg'] = False # (deg/s); Sectional angular/rotational velocities (absolute) at Node 7 expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system -BeamDyn['N8RVXg'] = False # (deg/s); Sectional angular/rotational velocities (absolute) at Node 8 expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system -BeamDyn['N8RVYg'] = False # (deg/s); Sectional angular/rotational velocities (absolute) at Node 8 expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system -BeamDyn['N8RVZg'] = False # (deg/s); Sectional angular/rotational velocities (absolute) at Node 8 expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system -BeamDyn['N9RVXg'] = False # (deg/s); Sectional angular/rotational velocities (absolute) at Node 9 expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system -BeamDyn['N9RVYg'] = False # (deg/s); Sectional angular/rotational velocities (absolute) at Node 9 expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system -BeamDyn['N9RVZg'] = False # (deg/s); Sectional angular/rotational velocities (absolute) at Node 9 expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system -BeamDyn['N1TAXl'] = False # (m/s^2); Sectional translational accelerations (absolute) at Node 1 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N1TAYl'] = False # (m/s^2); Sectional translational accelerations (absolute) at Node 1 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N1TAZl'] = False # (m/s^2); Sectional translational accelerations (absolute) at Node 1 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N2TAXl'] = False # (m/s^2); Sectional translational accelerations (absolute) at Node 2 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N2TAYl'] = False # (m/s^2); Sectional translational accelerations (absolute) at Node 2 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N2TAZl'] = False # (m/s^2); Sectional translational accelerations (absolute) at Node 2 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N3TAXl'] = False # (m/s^2); Sectional translational accelerations (absolute) at Node 3 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N3TAYl'] = False # (m/s^2); Sectional translational accelerations (absolute) at Node 3 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N3TAZl'] = False # (m/s^2); Sectional translational accelerations (absolute) at Node 3 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N4TAXl'] = False # (m/s^2); Sectional translational accelerations (absolute) at Node 4 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N4TAYl'] = False # (m/s^2); Sectional translational accelerations (absolute) at Node 4 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N4TAZl'] = False # (m/s^2); Sectional translational accelerations (absolute) at Node 4 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N5TAXl'] = False # (m/s^2); Sectional translational accelerations (absolute) at Node 5 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N5TAYl'] = False # (m/s^2); Sectional translational accelerations (absolute) at Node 5 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N5TAZl'] = False # (m/s^2); Sectional translational accelerations (absolute) at Node 5 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N6TAXl'] = False # (m/s^2); Sectional translational accelerations (absolute) at Node 6 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N6TAYl'] = False # (m/s^2); Sectional translational accelerations (absolute) at Node 6 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N6TAZl'] = False # (m/s^2); Sectional translational accelerations (absolute) at Node 6 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N7TAXl'] = False # (m/s^2); Sectional translational accelerations (absolute) at Node 7 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N7TAYl'] = False # (m/s^2); Sectional translational accelerations (absolute) at Node 7 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N7TAZl'] = False # (m/s^2); Sectional translational accelerations (absolute) at Node 7 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N8TAXl'] = False # (m/s^2); Sectional translational accelerations (absolute) at Node 8 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N8TAYl'] = False # (m/s^2); Sectional translational accelerations (absolute) at Node 8 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N8TAZl'] = False # (m/s^2); Sectional translational accelerations (absolute) at Node 8 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N9TAXl'] = False # (m/s^2); Sectional translational accelerations (absolute) at Node 9 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N9TAYl'] = False # (m/s^2); Sectional translational accelerations (absolute) at Node 9 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N9TAZl'] = False # (m/s^2); Sectional translational accelerations (absolute) at Node 9 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N1RAXl'] = False # (deg/s^2); Sectional angular/rotational accelerations (absolute) at Node 1 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N1RAYl'] = False # (deg/s^2); Sectional angular/rotational accelerations (absolute) at Node 1 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N1RAZl'] = False # (deg/s^2); Sectional angular/rotational accelerations (absolute) at Node 1 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N2RAXl'] = False # (deg/s^2); Sectional angular/rotational accelerations (absolute) at Node 2 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N2RAYl'] = False # (deg/s^2); Sectional angular/rotational accelerations (absolute) at Node 2 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N2RAZl'] = False # (deg/s^2); Sectional angular/rotational accelerations (absolute) at Node 2 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N3RAXl'] = False # (deg/s^2); Sectional angular/rotational accelerations (absolute) at Node 3 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N3RAYl'] = False # (deg/s^2); Sectional angular/rotational accelerations (absolute) at Node 3 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N3RAZl'] = False # (deg/s^2); Sectional angular/rotational accelerations (absolute) at Node 3 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N4RAXl'] = False # (deg/s^2); Sectional angular/rotational accelerations (absolute) at Node 4 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N4RAYl'] = False # (deg/s^2); Sectional angular/rotational accelerations (absolute) at Node 4 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N4RAZl'] = False # (deg/s^2); Sectional angular/rotational accelerations (absolute) at Node 4 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N5RAXl'] = False # (deg/s^2); Sectional angular/rotational accelerations (absolute) at Node 5 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N5RAYl'] = False # (deg/s^2); Sectional angular/rotational accelerations (absolute) at Node 5 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N5RAZl'] = False # (deg/s^2); Sectional angular/rotational accelerations (absolute) at Node 5 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N6RAXl'] = False # (deg/s^2); Sectional angular/rotational accelerations (absolute) at Node 6 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N6RAYl'] = False # (deg/s^2); Sectional angular/rotational accelerations (absolute) at Node 6 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N6RAZl'] = False # (deg/s^2); Sectional angular/rotational accelerations (absolute) at Node 6 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N7RAXl'] = False # (deg/s^2); Sectional angular/rotational accelerations (absolute) at Node 7 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N7RAYl'] = False # (deg/s^2); Sectional angular/rotational accelerations (absolute) at Node 7 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N7RAZl'] = False # (deg/s^2); Sectional angular/rotational accelerations (absolute) at Node 7 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N8RAXl'] = False # (deg/s^2); Sectional angular/rotational accelerations (absolute) at Node 8 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N8RAYl'] = False # (deg/s^2); Sectional angular/rotational accelerations (absolute) at Node 8 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N8RAZl'] = False # (deg/s^2); Sectional angular/rotational accelerations (absolute) at Node 8 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N9RAXl'] = False # (deg/s^2); Sectional angular/rotational accelerations (absolute) at Node 9 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N9RAYl'] = False # (deg/s^2); Sectional angular/rotational accelerations (absolute) at Node 9 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N9RAZl'] = False # (deg/s^2); Sectional angular/rotational accelerations (absolute) at Node 9 expressed in l; l: a floating coordinate system local to the deflected beam - -# Applied Loads -BeamDyn['N1PFxl'] = False # (N); Applied point forces at Node 1 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N1PFyl'] = False # (N); Applied point forces at Node 1 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N1PFzl'] = False # (N); Applied point forces at Node 1 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N2PFxl'] = False # (N); Applied point forces at Node 2 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N2PFyl'] = False # (N); Applied point forces at Node 2 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N2PFzl'] = False # (N); Applied point forces at Node 2 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N3PFxl'] = False # (N); Applied point forces at Node 3 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N3PFyl'] = False # (N); Applied point forces at Node 3 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N3PFzl'] = False # (N); Applied point forces at Node 3 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N4PFxl'] = False # (N); Applied point forces at Node 4 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N4PFyl'] = False # (N); Applied point forces at Node 4 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N4PFzl'] = False # (N); Applied point forces at Node 4 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N5PFxl'] = False # (N); Applied point forces at Node 5 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N5PFyl'] = False # (N); Applied point forces at Node 5 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N5PFzl'] = False # (N); Applied point forces at Node 5 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N6PFxl'] = False # (N); Applied point forces at Node 6 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N6PFyl'] = False # (N); Applied point forces at Node 6 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N6PFzl'] = False # (N); Applied point forces at Node 6 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N7PFxl'] = False # (N); Applied point forces at Node 7 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N7PFyl'] = False # (N); Applied point forces at Node 7 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N7PFzl'] = False # (N); Applied point forces at Node 7 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N8PFxl'] = False # (N); Applied point forces at Node 8 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N8PFyl'] = False # (N); Applied point forces at Node 8 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N8PFzl'] = False # (N); Applied point forces at Node 8 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N9PFxl'] = False # (N); Applied point forces at Node 9 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N9PFyl'] = False # (N); Applied point forces at Node 9 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N9PFzl'] = False # (N); Applied point forces at Node 9 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N1PMxl'] = False # (N-m); Applied point moments at Node 1 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N1PMyl'] = False # (N-m); Applied point moments at Node 1 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N1PMzl'] = False # (N-m); Applied point moments at Node 1 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N2PMxl'] = False # (N-m); Applied point moments at Node 2 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N2PMyl'] = False # (N-m); Applied point moments at Node 2 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N2PMzl'] = False # (N-m); Applied point moments at Node 2 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N3PMxl'] = False # (N-m); Applied point moments at Node 3 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N3PMyl'] = False # (N-m); Applied point moments at Node 3 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N3PMzl'] = False # (N-m); Applied point moments at Node 3 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N4PMxl'] = False # (N-m); Applied point moments at Node 4 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N4PMyl'] = False # (N-m); Applied point moments at Node 4 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N4PMzl'] = False # (N-m); Applied point moments at Node 4 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N5PMxl'] = False # (N-m); Applied point moments at Node 5 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N5PMyl'] = False # (N-m); Applied point moments at Node 5 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N5PMzl'] = False # (N-m); Applied point moments at Node 5 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N6PMxl'] = False # (N-m); Applied point moments at Node 6 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N6PMyl'] = False # (N-m); Applied point moments at Node 6 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N6PMzl'] = False # (N-m); Applied point moments at Node 6 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N7PMxl'] = False # (N-m); Applied point moments at Node 7 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N7PMyl'] = False # (N-m); Applied point moments at Node 7 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N7PMzl'] = False # (N-m); Applied point moments at Node 7 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N8PMxl'] = False # (N-m); Applied point moments at Node 8 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N8PMyl'] = False # (N-m); Applied point moments at Node 8 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N8PMzl'] = False # (N-m); Applied point moments at Node 8 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N9PMxl'] = False # (N-m); Applied point moments at Node 9 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N9PMyl'] = False # (N-m); Applied point moments at Node 9 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N9PMzl'] = False # (N-m); Applied point moments at Node 9 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N1DFxl'] = False # (N/m); Applied distributed forces at Node 1 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N1DFyl'] = False # (N/m); Applied distributed forces at Node 1 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N1DFzl'] = False # (N/m); Applied distributed forces at Node 1 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N2DFxl'] = False # (N/m); Applied distributed forces at Node 2 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N2DFyl'] = False # (N/m); Applied distributed forces at Node 2 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N2DFzl'] = False # (N/m); Applied distributed forces at Node 2 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N3DFxl'] = False # (N/m); Applied distributed forces at Node 3 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N3DFyl'] = False # (N/m); Applied distributed forces at Node 3 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N3DFzl'] = False # (N/m); Applied distributed forces at Node 3 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N4DFxl'] = False # (N/m); Applied distributed forces at Node 4 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N4DFyl'] = False # (N/m); Applied distributed forces at Node 4 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N4DFzl'] = False # (N/m); Applied distributed forces at Node 4 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N5DFxl'] = False # (N/m); Applied distributed forces at Node 5 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N5DFyl'] = False # (N/m); Applied distributed forces at Node 5 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N5DFzl'] = False # (N/m); Applied distributed forces at Node 5 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N6DFxl'] = False # (N/m); Applied distributed forces at Node 6 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N6DFyl'] = False # (N/m); Applied distributed forces at Node 6 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N6DFzl'] = False # (N/m); Applied distributed forces at Node 6 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N7DFxl'] = False # (N/m); Applied distributed forces at Node 7 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N7DFyl'] = False # (N/m); Applied distributed forces at Node 7 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N7DFzl'] = False # (N/m); Applied distributed forces at Node 7 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N8DFxl'] = False # (N/m); Applied distributed forces at Node 8 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N8DFyl'] = False # (N/m); Applied distributed forces at Node 8 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N8DFzl'] = False # (N/m); Applied distributed forces at Node 8 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N9DFxl'] = False # (N/m); Applied distributed forces at Node 9 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N9DFyl'] = False # (N/m); Applied distributed forces at Node 9 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N9DFzl'] = False # (N/m); Applied distributed forces at Node 9 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N1DMxl'] = False # (N-m/m); Applied distributed moments at Node 1 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N1DMyl'] = False # (N-m/m); Applied distributed moments at Node 1 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N1DMzl'] = False # (N-m/m); Applied distributed moments at Node 1 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N2DMxl'] = False # (N-m/m); Applied distributed moments at Node 2 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N2DMyl'] = False # (N-m/m); Applied distributed moments at Node 2 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N2DMzl'] = False # (N-m/m); Applied distributed moments at Node 2 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N3DMxl'] = False # (N-m/m); Applied distributed moments at Node 3 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N3DMyl'] = False # (N-m/m); Applied distributed moments at Node 3 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N3DMzl'] = False # (N-m/m); Applied distributed moments at Node 3 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N4DMxl'] = False # (N-m/m); Applied distributed moments at Node 4 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N4DMyl'] = False # (N-m/m); Applied distributed moments at Node 4 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N4DMzl'] = False # (N-m/m); Applied distributed moments at Node 4 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N5DMxl'] = False # (N-m/m); Applied distributed moments at Node 5 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N5DMyl'] = False # (N-m/m); Applied distributed moments at Node 5 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N5DMzl'] = False # (N-m/m); Applied distributed moments at Node 5 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N6DMxl'] = False # (N-m/m); Applied distributed moments at Node 6 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N6DMyl'] = False # (N-m/m); Applied distributed moments at Node 6 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N6DMzl'] = False # (N-m/m); Applied distributed moments at Node 6 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N7DMxl'] = False # (N-m/m); Applied distributed moments at Node 7 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N7DMyl'] = False # (N-m/m); Applied distributed moments at Node 7 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N7DMzl'] = False # (N-m/m); Applied distributed moments at Node 7 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N8DMxl'] = False # (N-m/m); Applied distributed moments at Node 8 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N8DMyl'] = False # (N-m/m); Applied distributed moments at Node 8 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N8DMzl'] = False # (N-m/m); Applied distributed moments at Node 8 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N9DMxl'] = False # (N-m/m); Applied distributed moments at Node 9 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N9DMyl'] = False # (N-m/m); Applied distributed moments at Node 9 expressed in l; l: a floating coordinate system local to the deflected beam -BeamDyn['N9DMzl'] = False # (N-m/m); Applied distributed moments at Node 9 expressed in l; l: a floating coordinate system local to the deflected beam - -# Pitch Actuator -BeamDyn['PAngInp'] = False # (deg); Pitch angle input; -BeamDyn['PAngAct'] = False # (deg); Actual pitch angle ; -BeamDyn['PRatAct'] = False # (deg/s); Actual pitch rate; -BeamDyn['PAccAct'] = False # (deg/s^2); Actual pitch acceleration; - - -""" ServoDyn """ -ServoDyn = {} - -# Airfoil control -ServoDyn['BlAirFlC1'] = False # (-); Blade 1 airfoil control command; Same units as provided in airfoil tables of AD15 (UserProp) -ServoDyn['BlFlap1'] = False # (-); Blade 1 airfoil control command; Same units as provided in airfoil tables of AD15 (UserProp) -ServoDyn['BlAirFlC2'] = False # (-); Blade 2 airfoil control command; Same units as provided in airfoil tables of AD15 (UserProp) -ServoDyn['BlFlap2'] = False # (-); Blade 2 airfoil control command; Same units as provided in airfoil tables of AD15 (UserProp) -ServoDyn['BlAirFlC3'] = False # (-); Blade 3 airfoil control command; Same units as provided in airfoil tables of AD15 (UserProp) -ServoDyn['BlFlap3'] = False # (-); Blade 3 airfoil control command; Same units as provided in airfoil tables of AD15 (UserProp) - -# Pitch Control -ServoDyn['BlPitchC1'] = False # (deg); Blade 1 pitch angle command; Positive towards feather about the minus zc1- and minus zb1-axes -ServoDyn['BlPitchC2'] = False # (deg); Blade 2 pitch angle command; Positive towards feather about the minus zc2- and minus zb2-axes -ServoDyn['BlPitchC3'] = False # (deg); Blade 3 pitch angle command; Positive towards feather about the minus zc3- and minus zb3-axes - -# Generator and Torque Control -ServoDyn['GenTq'] = False # (kN-m); Electrical generator torque; Positive reflects power extracted and negative represents a motoring-up situation (power input) -ServoDyn['GenPwr'] = False # (kW); Electrical generator power; Same sign as GenTq - -# High Speed Shaft Brake -ServoDyn['HSSBrTqC'] = False # (kN-m); High-speed shaft brake torque command (i.e., the commanded moment applied to the high-speed shaft by the brake); Always positive (indicating dissipation of power) - -# Nacelle Yaw Control -ServoDyn['YawMomCom'] = False # (kN-m); Nacelle yaw moment command; About the zl- and zp-axes -ServoDyn['YawMom'] = False # (kN-m); Nacelle yaw moment command; About the zl- and zp-axes - -# Nacelle Structural Control (StC) -ServoDyn['NStC1_XQ'] = False # (m); Nacelle StC #1 -- X position (displacement); Relative to rest position in StC reference frame -ServoDyn['NStC1_XQD'] = False # (m/s); Nacelle StC #1 -- X velocity; Relative to nacelle in StC reference frame -ServoDyn['NStC1_YQ'] = False # (m); Nacelle StC #1 -- Y position (displacement); Relative to rest position in StC reference frame -ServoDyn['NStC1_YQD'] = False # (m/s); Nacelle StC #1 -- Y velocity; Relative to nacelle in StC reference frame -ServoDyn['NStC1_ZQ'] = False # (m); Nacelle StC #1 -- Z position (displacement); Relative to rest position in StC reference frame -ServoDyn['NStC1_ZQD'] = False # (m/s); Nacelle StC #1 -- Z velocity; Relative to nacelle in StC reference frame -ServoDyn['NStC1_Fxi'] = False # (kN); Nacelle StC #1 -- X resulting force; Inertial (global) coordinates -ServoDyn['NStC1_Fyi'] = False # (kN); Nacelle StC #1 -- Y resulting force; Inertial (global) coordinates -ServoDyn['NStC1_Fzi'] = False # (kN); Nacelle StC #1 -- Z resulting force; Inertial (global) coordinates -ServoDyn['NStC1_Mxi'] = False # (kN-m); Nacelle StC #1 -- X resulting moment; Inertial (global) coordinates -ServoDyn['NStC1_Myi'] = False # (kN-m); Nacelle StC #1 -- Y resulting moment; Inertial (global) coordinates -ServoDyn['NStC1_Mzi'] = False # (kN-m); Nacelle StC #1 -- Z resulting moment; Inertial (global) coordinates -ServoDyn['NStC1_Fxl'] = False # (kN); Nacelle StC #1 -- X resulting force; Local StC coordinates -ServoDyn['NStC1_Fyl'] = False # (kN); Nacelle StC #1 -- Y resulting force; Local StC coordinates -ServoDyn['NStC1_Fzl'] = False # (kN); Nacelle StC #1 -- Z resulting force; Local StC coordinates -ServoDyn['NStC1_Mxl'] = False # (kN-m); Nacelle StC #1 -- X resulting moment; Local StC coordinates -ServoDyn['NStC1_Myl'] = False # (kN-m); Nacelle StC #1 -- Y resulting moment; Local StC coordinates -ServoDyn['NStC1_Mzl'] = False # (kN-m); Nacelle StC #1 -- Z resulting moment; Local StC coordinates -ServoDyn['NStC2_XQ'] = False # (m); Nacelle StC #2 -- X position (displacement); Relative to rest position in StC reference frame -ServoDyn['NStC2_XQD'] = False # (m/s); Nacelle StC #2 -- X velocity; Relative to nacelle in StC reference frame -ServoDyn['NStC2_YQ'] = False # (m); Nacelle StC #2 -- Y position (displacement); Relative to rest position in StC reference frame -ServoDyn['NStC2_YQD'] = False # (m/s); Nacelle StC #2 -- Y velocity; Relative to nacelle in StC reference frame -ServoDyn['NStC2_ZQ'] = False # (m); Nacelle StC #2 -- Z position (displacement); Relative to rest position in StC reference frame -ServoDyn['NStC2_ZQD'] = False # (m/s); Nacelle StC #2 -- Z velocity; Relative to nacelle in StC reference frame -ServoDyn['NStC2_Fxi'] = False # (kN); Nacelle StC #2 -- X resulting force; Inertial (global) coordinates -ServoDyn['NStC2_Fyi'] = False # (kN); Nacelle StC #2 -- Y resulting force; Inertial (global) coordinates -ServoDyn['NStC2_Fzi'] = False # (kN); Nacelle StC #2 -- Z resulting force; Inertial (global) coordinates -ServoDyn['NStC2_Mxi'] = False # (kN-m); Nacelle StC #2 -- X resulting moment; Inertial (global) coordinates -ServoDyn['NStC2_Myi'] = False # (kN-m); Nacelle StC #2 -- Y resulting moment; Inertial (global) coordinates -ServoDyn['NStC2_Mzi'] = False # (kN-m); Nacelle StC #2 -- Z resulting moment; Inertial (global) coordinates -ServoDyn['NStC2_Fxl'] = False # (kN); Nacelle StC #2 -- X resulting force; Local StC coordinates -ServoDyn['NStC2_Fyl'] = False # (kN); Nacelle StC #2 -- Y resulting force; Local StC coordinates -ServoDyn['NStC2_Fzl'] = False # (kN); Nacelle StC #2 -- Z resulting force; Local StC coordinates -ServoDyn['NStC2_Mxl'] = False # (kN-m); Nacelle StC #2 -- X resulting moment; Local StC coordinates -ServoDyn['NStC2_Myl'] = False # (kN-m); Nacelle StC #2 -- Y resulting moment; Local StC coordinates -ServoDyn['NStC2_Mzl'] = False # (kN-m); Nacelle StC #2 -- Z resulting moment; Local StC coordinates -ServoDyn['NStC3_XQ'] = False # (m); Nacelle StC #3 -- X position (displacement); Relative to rest position in StC reference frame -ServoDyn['NStC3_XQD'] = False # (m/s); Nacelle StC #3 -- X velocity; Relative to nacelle in StC reference frame -ServoDyn['NStC3_YQ'] = False # (m); Nacelle StC #3 -- Y position (displacement); Relative to rest position in StC reference frame -ServoDyn['NStC3_YQD'] = False # (m/s); Nacelle StC #3 -- Y velocity; Relative to nacelle in StC reference frame -ServoDyn['NStC3_ZQ'] = False # (m); Nacelle StC #3 -- Z position (displacement); Relative to rest position in StC reference frame -ServoDyn['NStC3_ZQD'] = False # (m/s); Nacelle StC #3 -- Z velocity; Relative to nacelle in StC reference frame -ServoDyn['NStC3_Fxi'] = False # (kN); Nacelle StC #3 -- X resulting force; Inertial (global) coordinates -ServoDyn['NStC3_Fyi'] = False # (kN); Nacelle StC #3 -- Y resulting force; Inertial (global) coordinates -ServoDyn['NStC3_Fzi'] = False # (kN); Nacelle StC #3 -- Z resulting force; Inertial (global) coordinates -ServoDyn['NStC3_Mxi'] = False # (kN-m); Nacelle StC #3 -- X resulting moment; Inertial (global) coordinates -ServoDyn['NStC3_Myi'] = False # (kN-m); Nacelle StC #3 -- Y resulting moment; Inertial (global) coordinates -ServoDyn['NStC3_Mzi'] = False # (kN-m); Nacelle StC #3 -- Z resulting moment; Inertial (global) coordinates -ServoDyn['NStC3_Fxl'] = False # (kN); Nacelle StC #3 -- X resulting force; Local StC coordinates -ServoDyn['NStC3_Fyl'] = False # (kN); Nacelle StC #3 -- Y resulting force; Local StC coordinates -ServoDyn['NStC3_Fzl'] = False # (kN); Nacelle StC #3 -- Z resulting force; Local StC coordinates -ServoDyn['NStC3_Mxl'] = False # (kN-m); Nacelle StC #3 -- X resulting moment; Local StC coordinates -ServoDyn['NStC3_Myl'] = False # (kN-m); Nacelle StC #3 -- Y resulting moment; Local StC coordinates -ServoDyn['NStC3_Mzl'] = False # (kN-m); Nacelle StC #3 -- Z resulting moment; Local StC coordinates -ServoDyn['NStC4_XQ'] = False # (m); Nacelle StC #4 -- X position (displacement); Relative to rest position in StC reference frame -ServoDyn['NStC4_XQD'] = False # (m/s); Nacelle StC #4 -- X velocity; Relative to nacelle in StC reference frame -ServoDyn['NStC4_YQ'] = False # (m); Nacelle StC #4 -- Y position (displacement); Relative to rest position in StC reference frame -ServoDyn['NStC4_YQD'] = False # (m/s); Nacelle StC #4 -- Y velocity; Relative to nacelle in StC reference frame -ServoDyn['NStC4_ZQ'] = False # (m); Nacelle StC #4 -- Z position (displacement); Relative to rest position in StC reference frame -ServoDyn['NStC4_ZQD'] = False # (m/s); Nacelle StC #4 -- Z velocity; Relative to nacelle in StC reference frame -ServoDyn['NStC4_Fxi'] = False # (kN); Nacelle StC #4 -- X resulting force; Inertial (global) coordinates -ServoDyn['NStC4_Fyi'] = False # (kN); Nacelle StC #4 -- Y resulting force; Inertial (global) coordinates -ServoDyn['NStC4_Fzi'] = False # (kN); Nacelle StC #4 -- Z resulting force; Inertial (global) coordinates -ServoDyn['NStC4_Mxi'] = False # (kN-m); Nacelle StC #4 -- X resulting moment; Inertial (global) coordinates -ServoDyn['NStC4_Myi'] = False # (kN-m); Nacelle StC #4 -- Y resulting moment; Inertial (global) coordinates -ServoDyn['NStC4_Mzi'] = False # (kN-m); Nacelle StC #4 -- Z resulting moment; Inertial (global) coordinates -ServoDyn['NStC4_Fxl'] = False # (kN); Nacelle StC #4 -- X resulting force; Local StC coordinates -ServoDyn['NStC4_Fyl'] = False # (kN); Nacelle StC #4 -- Y resulting force; Local StC coordinates -ServoDyn['NStC4_Fzl'] = False # (kN); Nacelle StC #4 -- Z resulting force; Local StC coordinates -ServoDyn['NStC4_Mxl'] = False # (kN-m); Nacelle StC #4 -- X resulting moment; Local StC coordinates -ServoDyn['NStC4_Myl'] = False # (kN-m); Nacelle StC #4 -- Y resulting moment; Local StC coordinates -ServoDyn['NStC4_Mzl'] = False # (kN-m); Nacelle StC #4 -- Z resulting moment; Local StC coordinates - -# Tower Structural Control (StC) -ServoDyn['TStC1_XQ'] = False # (m); Tower StC #1 -- X position (displacement); Relative to rest position in StC reference frame -ServoDyn['TStC1_XQD'] = False # (m/s); Tower StC #1 -- X velocity; Relative to nacelle in StC reference frame -ServoDyn['TStC1_YQ'] = False # (m); Tower StC #1 -- Y position (displacement); Relative to rest position in StC reference frame -ServoDyn['TStC1_YQD'] = False # (m/s); Tower StC #1 -- Y velocity; Relative to nacelle in StC reference frame -ServoDyn['TStC1_ZQ'] = False # (m); Tower StC #1 -- Z position (displacement); Relative to rest position in StC reference frame -ServoDyn['TStC1_ZQD'] = False # (m/s); Tower StC #1 -- Z velocity; Relative to nacelle in StC reference frame -ServoDyn['TStC1_Fxi'] = False # (kN); Tower StC #1 -- X resulting force; Inertial (global) coordinates -ServoDyn['TStC1_Fyi'] = False # (kN); Tower StC #1 -- Y resulting force; Inertial (global) coordinates -ServoDyn['TStC1_Fzi'] = False # (kN); Tower StC #1 -- Z resulting force; Inertial (global) coordinates -ServoDyn['TStC1_Mxi'] = False # (kN-m); Tower StC #1 -- X resulting moment; Inertial (global) coordinates -ServoDyn['TStC1_Myi'] = False # (kN-m); Tower StC #1 -- Y resulting moment; Inertial (global) coordinates -ServoDyn['TStC1_Mzi'] = False # (kN-m); Tower StC #1 -- Z resulting moment; Inertial (global) coordinates -ServoDyn['TStC1_Fxl'] = False # (kN); Tower StC #1 -- X resulting force; Local StC coordinates -ServoDyn['TStC1_Fyl'] = False # (kN); Tower StC #1 -- Y resulting force; Local StC coordinates -ServoDyn['TStC1_Fzl'] = False # (kN); Tower StC #1 -- Z resulting force; Local StC coordinates -ServoDyn['TStC1_Mxl'] = False # (kN-m); Tower StC #1 -- X resulting moment; Local StC coordinates -ServoDyn['TStC1_Myl'] = False # (kN-m); Tower StC #1 -- Y resulting moment; Local StC coordinates -ServoDyn['TStC1_Mzl'] = False # (kN-m); Tower StC #1 -- Z resulting moment; Local StC coordinates -ServoDyn['TStC2_XQ'] = False # (m); Tower StC #2 -- X position (displacement); Relative to rest position in StC reference frame -ServoDyn['TStC2_XQD'] = False # (m/s); Tower StC #2 -- X velocity; Relative to nacelle in StC reference frame -ServoDyn['TStC2_YQ'] = False # (m); Tower StC #2 -- Y position (displacement); Relative to rest position in StC reference frame -ServoDyn['TStC2_YQD'] = False # (m/s); Tower StC #2 -- Y velocity; Relative to nacelle in StC reference frame -ServoDyn['TStC2_ZQ'] = False # (m); Tower StC #2 -- Z position (displacement); Relative to rest position in StC reference frame -ServoDyn['TStC2_ZQD'] = False # (m/s); Tower StC #2 -- Z velocity; Relative to nacelle in StC reference frame -ServoDyn['TStC2_Fxi'] = False # (kN); Tower StC #2 -- X resulting force; Inertial (global) coordinates -ServoDyn['TStC2_Fyi'] = False # (kN); Tower StC #2 -- Y resulting force; Inertial (global) coordinates -ServoDyn['TStC2_Fzi'] = False # (kN); Tower StC #2 -- Z resulting force; Inertial (global) coordinates -ServoDyn['TStC2_Mxi'] = False # (kN-m); Tower StC #2 -- X resulting moment; Inertial (global) coordinates -ServoDyn['TStC2_Myi'] = False # (kN-m); Tower StC #2 -- Y resulting moment; Inertial (global) coordinates -ServoDyn['TStC2_Mzi'] = False # (kN-m); Tower StC #2 -- Z resulting moment; Inertial (global) coordinates -ServoDyn['TStC2_Fxl'] = False # (kN); Tower StC #2 -- X resulting force; Local StC coordinates -ServoDyn['TStC2_Fyl'] = False # (kN); Tower StC #2 -- Y resulting force; Local StC coordinates -ServoDyn['TStC2_Fzl'] = False # (kN); Tower StC #2 -- Z resulting force; Local StC coordinates -ServoDyn['TStC2_Mxl'] = False # (kN-m); Tower StC #2 -- X resulting moment; Local StC coordinates -ServoDyn['TStC2_Myl'] = False # (kN-m); Tower StC #2 -- Y resulting moment; Local StC coordinates -ServoDyn['TStC2_Mzl'] = False # (kN-m); Tower StC #2 -- Z resulting moment; Local StC coordinates -ServoDyn['TStC3_XQ'] = False # (m); Tower StC #3 -- X position (displacement); Relative to rest position in StC reference frame -ServoDyn['TStC3_XQD'] = False # (m/s); Tower StC #3 -- X velocity; Relative to nacelle in StC reference frame -ServoDyn['TStC3_YQ'] = False # (m); Tower StC #3 -- Y position (displacement); Relative to rest position in StC reference frame -ServoDyn['TStC3_YQD'] = False # (m/s); Tower StC #3 -- Y velocity; Relative to nacelle in StC reference frame -ServoDyn['TStC3_ZQ'] = False # (m); Tower StC #3 -- Z position (displacement); Relative to rest position in StC reference frame -ServoDyn['TStC3_ZQD'] = False # (m/s); Tower StC #3 -- Z velocity; Relative to nacelle in StC reference frame -ServoDyn['TStC3_Fxi'] = False # (kN); Tower StC #3 -- X resulting force; Inertial (global) coordinates -ServoDyn['TStC3_Fyi'] = False # (kN); Tower StC #3 -- Y resulting force; Inertial (global) coordinates -ServoDyn['TStC3_Fzi'] = False # (kN); Tower StC #3 -- Z resulting force; Inertial (global) coordinates -ServoDyn['TStC3_Mxi'] = False # (kN-m); Tower StC #3 -- X resulting moment; Inertial (global) coordinates -ServoDyn['TStC3_Myi'] = False # (kN-m); Tower StC #3 -- Y resulting moment; Inertial (global) coordinates -ServoDyn['TStC3_Mzi'] = False # (kN-m); Tower StC #3 -- Z resulting moment; Inertial (global) coordinates -ServoDyn['TStC3_Fxl'] = False # (kN); Tower StC #3 -- X resulting force; Local StC coordinates -ServoDyn['TStC3_Fyl'] = False # (kN); Tower StC #3 -- Y resulting force; Local StC coordinates -ServoDyn['TStC3_Fzl'] = False # (kN); Tower StC #3 -- Z resulting force; Local StC coordinates -ServoDyn['TStC3_Mxl'] = False # (kN-m); Tower StC #3 -- X resulting moment; Local StC coordinates -ServoDyn['TStC3_Myl'] = False # (kN-m); Tower StC #3 -- Y resulting moment; Local StC coordinates -ServoDyn['TStC3_Mzl'] = False # (kN-m); Tower StC #3 -- Z resulting moment; Local StC coordinates -ServoDyn['TStC4_XQ'] = False # (m); Tower StC #4 -- X position (displacement); Relative to rest position in StC reference frame -ServoDyn['TStC4_XQD'] = False # (m/s); Tower StC #4 -- X velocity; Relative to nacelle in StC reference frame -ServoDyn['TStC4_YQ'] = False # (m); Tower StC #4 -- Y position (displacement); Relative to rest position in StC reference frame -ServoDyn['TStC4_YQD'] = False # (m/s); Tower StC #4 -- Y velocity; Relative to nacelle in StC reference frame -ServoDyn['TStC4_ZQ'] = False # (m); Tower StC #4 -- Z position (displacement); Relative to rest position in StC reference frame -ServoDyn['TStC4_ZQD'] = False # (m/s); Tower StC #4 -- Z velocity; Relative to nacelle in StC reference frame -ServoDyn['TStC4_Fxi'] = False # (kN); Tower StC #4 -- X resulting force; Inertial (global) coordinates -ServoDyn['TStC4_Fyi'] = False # (kN); Tower StC #4 -- Y resulting force; Inertial (global) coordinates -ServoDyn['TStC4_Fzi'] = False # (kN); Tower StC #4 -- Z resulting force; Inertial (global) coordinates -ServoDyn['TStC4_Mxi'] = False # (kN-m); Tower StC #4 -- X resulting moment; Inertial (global) coordinates -ServoDyn['TStC4_Myi'] = False # (kN-m); Tower StC #4 -- Y resulting moment; Inertial (global) coordinates -ServoDyn['TStC4_Mzi'] = False # (kN-m); Tower StC #4 -- Z resulting moment; Inertial (global) coordinates -ServoDyn['TStC4_Fxl'] = False # (kN); Tower StC #4 -- X resulting force; Local StC coordinates -ServoDyn['TStC4_Fyl'] = False # (kN); Tower StC #4 -- Y resulting force; Local StC coordinates -ServoDyn['TStC4_Fzl'] = False # (kN); Tower StC #4 -- Z resulting force; Local StC coordinates -ServoDyn['TStC4_Mxl'] = False # (kN-m); Tower StC #4 -- X resulting moment; Local StC coordinates -ServoDyn['TStC4_Myl'] = False # (kN-m); Tower StC #4 -- Y resulting moment; Local StC coordinates -ServoDyn['TStC4_Mzl'] = False # (kN-m); Tower StC #4 -- Z resulting moment; Local StC coordinates - -# Blade Structural Control (StC) -ServoDyn['BStC1_B1_XQ'] = False # (m); Blade StC #1 Blade #1 -- X position (displacement); Relative to rest position in StC reference frame -ServoDyn['BStC1_B1_XQD'] = False # (m/s); Blade StC #1 Blade #1 -- X velocity; Relative to nacelle in StC reference frame -ServoDyn['BStC1_B1_YQ'] = False # (m); Blade StC #1 Blade #1 -- Y position (displacement); Relative to rest position in StC reference frame -ServoDyn['BStC1_B1_YQD'] = False # (m/s); Blade StC #1 Blade #1 -- Y velocity; Relative to nacelle in StC reference frame -ServoDyn['BStC1_B1_ZQ'] = False # (m); Blade StC #1 Blade #1 -- Z position (displacement); Relative to rest position in StC reference frame -ServoDyn['BStC1_B1_ZQD'] = False # (m/s); Blade StC #1 Blade #1 -- Z velocity; Relative to nacelle in StC reference frame -ServoDyn['BStC1_B1_Fxi'] = False # (kN); Blade StC #1 Blade #1 -- X resulting force; Inertial (global) coordinates -ServoDyn['BStC1_B1_Fyi'] = False # (kN); Blade StC #1 Blade #1 -- Y resulting force; Inertial (global) coordinates -ServoDyn['BStC1_B1_Fzi'] = False # (kN); Blade StC #1 Blade #1 -- Z resulting force; Inertial (global) coordinates -ServoDyn['BStC1_B1_Mxi'] = False # (kN-m); Blade StC #1 Blade #1 -- X resulting moment; Inertial (global) coordinates -ServoDyn['BStC1_B1_Myi'] = False # (kN-m); Blade StC #1 Blade #1 -- Y resulting moment; Inertial (global) coordinates -ServoDyn['BStC1_B1_Mzi'] = False # (kN-m); Blade StC #1 Blade #1 -- Z resulting moment; Inertial (global) coordinates -ServoDyn['BStC1_B1_Fxl'] = False # (kN); Blade StC #1 Blade #1 -- X resulting force; Local StC coordinates -ServoDyn['BStC1_B1_Fyl'] = False # (kN); Blade StC #1 Blade #1 -- Y resulting force; Local StC coordinates -ServoDyn['BStC1_B1_Fzl'] = False # (kN); Blade StC #1 Blade #1 -- Z resulting force; Local StC coordinates -ServoDyn['BStC1_B1_Mxl'] = False # (kN-m); Blade StC #1 Blade #1 -- X resulting moment; Local StC coordinates -ServoDyn['BStC1_B1_Myl'] = False # (kN-m); Blade StC #1 Blade #1 -- Y resulting moment; Local StC coordinates -ServoDyn['BStC1_B1_Mzl'] = False # (kN-m); Blade StC #1 Blade #1 -- Z resulting moment; Local StC coordinates -ServoDyn['BStC2_B1_XQ'] = False # (m); Blade StC #2 Blade #1 -- X position (displacement); Relative to rest position in StC reference frame -ServoDyn['BStC2_B1_XQD'] = False # (m/s); Blade StC #2 Blade #1 -- X velocity; Relative to nacelle in StC reference frame -ServoDyn['BStC2_B1_YQ'] = False # (m); Blade StC #2 Blade #1 -- Y position (displacement); Relative to rest position in StC reference frame -ServoDyn['BStC2_B1_YQD'] = False # (m/s); Blade StC #2 Blade #1 -- Y velocity; Relative to nacelle in StC reference frame -ServoDyn['BStC2_B1_ZQ'] = False # (m); Blade StC #2 Blade #1 -- Z position (displacement); Relative to rest position in StC reference frame -ServoDyn['BStC2_B1_ZQD'] = False # (m/s); Blade StC #2 Blade #1 -- Z velocity; Relative to nacelle in StC reference frame -ServoDyn['BStC2_B1_Fxi'] = False # (kN); Blade StC #2 Blade #1 -- X resulting force; Inertial (global) coordinates -ServoDyn['BStC2_B1_Fyi'] = False # (kN); Blade StC #2 Blade #1 -- Y resulting force; Inertial (global) coordinates -ServoDyn['BStC2_B1_Fzi'] = False # (kN); Blade StC #2 Blade #1 -- Z resulting force; Inertial (global) coordinates -ServoDyn['BStC2_B1_Mxi'] = False # (kN-m); Blade StC #2 Blade #1 -- X resulting moment; Inertial (global) coordinates -ServoDyn['BStC2_B1_Myi'] = False # (kN-m); Blade StC #2 Blade #1 -- Y resulting moment; Inertial (global) coordinates -ServoDyn['BStC2_B1_Mzi'] = False # (kN-m); Blade StC #2 Blade #1 -- Z resulting moment; Inertial (global) coordinates -ServoDyn['BStC2_B1_Fxl'] = False # (kN); Blade StC #2 Blade #1 -- X resulting force; Local StC coordinates -ServoDyn['BStC2_B1_Fyl'] = False # (kN); Blade StC #2 Blade #1 -- Y resulting force; Local StC coordinates -ServoDyn['BStC2_B1_Fzl'] = False # (kN); Blade StC #2 Blade #1 -- Z resulting force; Local StC coordinates -ServoDyn['BStC2_B1_Mxl'] = False # (kN-m); Blade StC #2 Blade #1 -- X resulting moment; Local StC coordinates -ServoDyn['BStC2_B1_Myl'] = False # (kN-m); Blade StC #2 Blade #1 -- Y resulting moment; Local StC coordinates -ServoDyn['BStC2_B1_Mzl'] = False # (kN-m); Blade StC #2 Blade #1 -- Z resulting moment; Local StC coordinates -ServoDyn['BStC3_B1_XQ'] = False # (m); Blade StC #3 Blade #1 -- X position (displacement); Relative to rest position in StC reference frame -ServoDyn['BStC3_B1_XQD'] = False # (m/s); Blade StC #3 Blade #1 -- X velocity; Relative to nacelle in StC reference frame -ServoDyn['BStC3_B1_YQ'] = False # (m); Blade StC #3 Blade #1 -- Y position (displacement); Relative to rest position in StC reference frame -ServoDyn['BStC3_B1_YQD'] = False # (m/s); Blade StC #3 Blade #1 -- Y velocity; Relative to nacelle in StC reference frame -ServoDyn['BStC3_B1_ZQ'] = False # (m); Blade StC #3 Blade #1 -- Z position (displacement); Relative to rest position in StC reference frame -ServoDyn['BStC3_B1_ZQD'] = False # (m/s); Blade StC #3 Blade #1 -- Z velocity; Relative to nacelle in StC reference frame -ServoDyn['BStC3_B1_Fxi'] = False # (kN); Blade StC #3 Blade #1 -- X resulting force; Inertial (global) coordinates -ServoDyn['BStC3_B1_Fyi'] = False # (kN); Blade StC #3 Blade #1 -- Y resulting force; Inertial (global) coordinates -ServoDyn['BStC3_B1_Fzi'] = False # (kN); Blade StC #3 Blade #1 -- Z resulting force; Inertial (global) coordinates -ServoDyn['BStC3_B1_Mxi'] = False # (kN-m); Blade StC #3 Blade #1 -- X resulting moment; Inertial (global) coordinates -ServoDyn['BStC3_B1_Myi'] = False # (kN-m); Blade StC #3 Blade #1 -- Y resulting moment; Inertial (global) coordinates -ServoDyn['BStC3_B1_Mzi'] = False # (kN-m); Blade StC #3 Blade #1 -- Z resulting moment; Inertial (global) coordinates -ServoDyn['BStC3_B1_Fxl'] = False # (kN); Blade StC #3 Blade #1 -- X resulting force; Local StC coordinates -ServoDyn['BStC3_B1_Fyl'] = False # (kN); Blade StC #3 Blade #1 -- Y resulting force; Local StC coordinates -ServoDyn['BStC3_B1_Fzl'] = False # (kN); Blade StC #3 Blade #1 -- Z resulting force; Local StC coordinates -ServoDyn['BStC3_B1_Mxl'] = False # (kN-m); Blade StC #3 Blade #1 -- X resulting moment; Local StC coordinates -ServoDyn['BStC3_B1_Myl'] = False # (kN-m); Blade StC #3 Blade #1 -- Y resulting moment; Local StC coordinates -ServoDyn['BStC3_B1_Mzl'] = False # (kN-m); Blade StC #3 Blade #1 -- Z resulting moment; Local StC coordinates -ServoDyn['BStC4_B1_XQ'] = False # (m); Blade StC #4 Blade #1 -- X position (displacement); Relative to rest position in StC reference frame -ServoDyn['BStC4_B1_XQD'] = False # (m/s); Blade StC #4 Blade #1 -- X velocity; Relative to nacelle in StC reference frame -ServoDyn['BStC4_B1_YQ'] = False # (m); Blade StC #4 Blade #1 -- Y position (displacement); Relative to rest position in StC reference frame -ServoDyn['BStC4_B1_YQD'] = False # (m/s); Blade StC #4 Blade #1 -- Y velocity; Relative to nacelle in StC reference frame -ServoDyn['BStC4_B1_ZQ'] = False # (m); Blade StC #4 Blade #1 -- Z position (displacement); Relative to rest position in StC reference frame -ServoDyn['BStC4_B1_ZQD'] = False # (m/s); Blade StC #4 Blade #1 -- Z velocity; Relative to nacelle in StC reference frame -ServoDyn['BStC4_B1_Fxi'] = False # (kN); Blade StC #4 Blade #1 -- X resulting force; Inertial (global) coordinates -ServoDyn['BStC4_B1_Fyi'] = False # (kN); Blade StC #4 Blade #1 -- Y resulting force; Inertial (global) coordinates -ServoDyn['BStC4_B1_Fzi'] = False # (kN); Blade StC #4 Blade #1 -- Z resulting force; Inertial (global) coordinates -ServoDyn['BStC4_B1_Mxi'] = False # (kN-m); Blade StC #4 Blade #1 -- X resulting moment; Inertial (global) coordinates -ServoDyn['BStC4_B1_Myi'] = False # (kN-m); Blade StC #4 Blade #1 -- Y resulting moment; Inertial (global) coordinates -ServoDyn['BStC4_B1_Mzi'] = False # (kN-m); Blade StC #4 Blade #1 -- Z resulting moment; Inertial (global) coordinates -ServoDyn['BStC4_B1_Fxl'] = False # (kN); Blade StC #4 Blade #1 -- X resulting force; Local StC coordinates -ServoDyn['BStC4_B1_Fyl'] = False # (kN); Blade StC #4 Blade #1 -- Y resulting force; Local StC coordinates -ServoDyn['BStC4_B1_Fzl'] = False # (kN); Blade StC #4 Blade #1 -- Z resulting force; Local StC coordinates -ServoDyn['BStC4_B1_Mxl'] = False # (kN-m); Blade StC #4 Blade #1 -- X resulting moment; Local StC coordinates -ServoDyn['BStC4_B1_Myl'] = False # (kN-m); Blade StC #4 Blade #1 -- Y resulting moment; Local StC coordinates -ServoDyn['BStC4_B1_Mzl'] = False # (kN-m); Blade StC #4 Blade #1 -- Z resulting moment; Local StC coordinates -ServoDyn['BStC1_B2_XQ'] = False # (m); Blade StC #1 Blade #2 -- X position (displacement); Relative to rest position in StC reference frame -ServoDyn['BStC1_B2_XQD'] = False # (m/s); Blade StC #1 Blade #2 -- X velocity; Relative to nacelle in StC reference frame -ServoDyn['BStC1_B2_YQ'] = False # (m); Blade StC #1 Blade #2 -- Y position (displacement); Relative to rest position in StC reference frame -ServoDyn['BStC1_B2_YQD'] = False # (m/s); Blade StC #1 Blade #2 -- Y velocity; Relative to nacelle in StC reference frame -ServoDyn['BStC1_B2_ZQ'] = False # (m); Blade StC #1 Blade #2 -- Z position (displacement); Relative to rest position in StC reference frame -ServoDyn['BStC1_B2_ZQD'] = False # (m/s); Blade StC #1 Blade #2 -- Z velocity; Relative to nacelle in StC reference frame -ServoDyn['BStC1_B2_Fxi'] = False # (kN); Blade StC #1 Blade #2 -- X resulting force; Inertial (global) coordinates -ServoDyn['BStC1_B2_Fyi'] = False # (kN); Blade StC #1 Blade #2 -- Y resulting force; Inertial (global) coordinates -ServoDyn['BStC1_B2_Fzi'] = False # (kN); Blade StC #1 Blade #2 -- Z resulting force; Inertial (global) coordinates -ServoDyn['BStC1_B2_Mxi'] = False # (kN-m); Blade StC #1 Blade #2 -- X resulting moment; Inertial (global) coordinates -ServoDyn['BStC1_B2_Myi'] = False # (kN-m); Blade StC #1 Blade #2 -- Y resulting moment; Inertial (global) coordinates -ServoDyn['BStC1_B2_Mzi'] = False # (kN-m); Blade StC #1 Blade #2 -- Z resulting moment; Inertial (global) coordinates -ServoDyn['BStC1_B2_Fxl'] = False # (kN); Blade StC #1 Blade #2 -- X resulting force; Local StC coordinates -ServoDyn['BStC1_B2_Fyl'] = False # (kN); Blade StC #1 Blade #2 -- Y resulting force; Local StC coordinates -ServoDyn['BStC1_B2_Fzl'] = False # (kN); Blade StC #1 Blade #2 -- Z resulting force; Local StC coordinates -ServoDyn['BStC1_B2_Mxl'] = False # (kN-m); Blade StC #1 Blade #2 -- X resulting moment; Local StC coordinates -ServoDyn['BStC1_B2_Myl'] = False # (kN-m); Blade StC #1 Blade #2 -- Y resulting moment; Local StC coordinates -ServoDyn['BStC1_B2_Mzl'] = False # (kN-m); Blade StC #1 Blade #2 -- Z resulting moment; Local StC coordinates -ServoDyn['BStC2_B2_XQ'] = False # (m); Blade StC #2 Blade #2 -- X position (displacement); Relative to rest position in StC reference frame -ServoDyn['BStC2_B2_XQD'] = False # (m/s); Blade StC #2 Blade #2 -- X velocity; Relative to nacelle in StC reference frame -ServoDyn['BStC2_B2_YQ'] = False # (m); Blade StC #2 Blade #2 -- Y position (displacement); Relative to rest position in StC reference frame -ServoDyn['BStC2_B2_YQD'] = False # (m/s); Blade StC #2 Blade #2 -- Y velocity; Relative to nacelle in StC reference frame -ServoDyn['BStC2_B2_ZQ'] = False # (m); Blade StC #2 Blade #2 -- Z position (displacement); Relative to rest position in StC reference frame -ServoDyn['BStC2_B2_ZQD'] = False # (m/s); Blade StC #2 Blade #2 -- Z velocity; Relative to nacelle in StC reference frame -ServoDyn['BStC2_B2_Fxi'] = False # (kN); Blade StC #2 Blade #2 -- X resulting force; Inertial (global) coordinates -ServoDyn['BStC2_B2_Fyi'] = False # (kN); Blade StC #2 Blade #2 -- Y resulting force; Inertial (global) coordinates -ServoDyn['BStC2_B2_Fzi'] = False # (kN); Blade StC #2 Blade #2 -- Z resulting force; Inertial (global) coordinates -ServoDyn['BStC2_B2_Mxi'] = False # (kN-m); Blade StC #2 Blade #2 -- X resulting moment; Inertial (global) coordinates -ServoDyn['BStC2_B2_Myi'] = False # (kN-m); Blade StC #2 Blade #2 -- Y resulting moment; Inertial (global) coordinates -ServoDyn['BStC2_B2_Mzi'] = False # (kN-m); Blade StC #2 Blade #2 -- Z resulting moment; Inertial (global) coordinates -ServoDyn['BStC2_B2_Fxl'] = False # (kN); Blade StC #2 Blade #2 -- X resulting force; Local StC coordinates -ServoDyn['BStC2_B2_Fyl'] = False # (kN); Blade StC #2 Blade #2 -- Y resulting force; Local StC coordinates -ServoDyn['BStC2_B2_Fzl'] = False # (kN); Blade StC #2 Blade #2 -- Z resulting force; Local StC coordinates -ServoDyn['BStC2_B2_Mxl'] = False # (kN-m); Blade StC #2 Blade #2 -- X resulting moment; Local StC coordinates -ServoDyn['BStC2_B2_Myl'] = False # (kN-m); Blade StC #2 Blade #2 -- Y resulting moment; Local StC coordinates -ServoDyn['BStC2_B2_Mzl'] = False # (kN-m); Blade StC #2 Blade #2 -- Z resulting moment; Local StC coordinates -ServoDyn['BStC3_B2_XQ'] = False # (m); Blade StC #3 Blade #2 -- X position (displacement); Relative to rest position in StC reference frame -ServoDyn['BStC3_B2_XQD'] = False # (m/s); Blade StC #3 Blade #2 -- X velocity; Relative to nacelle in StC reference frame -ServoDyn['BStC3_B2_YQ'] = False # (m); Blade StC #3 Blade #2 -- Y position (displacement); Relative to rest position in StC reference frame -ServoDyn['BStC3_B2_YQD'] = False # (m/s); Blade StC #3 Blade #2 -- Y velocity; Relative to nacelle in StC reference frame -ServoDyn['BStC3_B2_ZQ'] = False # (m); Blade StC #3 Blade #2 -- Z position (displacement); Relative to rest position in StC reference frame -ServoDyn['BStC3_B2_ZQD'] = False # (m/s); Blade StC #3 Blade #2 -- Z velocity; Relative to nacelle in StC reference frame -ServoDyn['BStC3_B2_Fxi'] = False # (kN); Blade StC #3 Blade #2 -- X resulting force; Inertial (global) coordinates -ServoDyn['BStC3_B2_Fyi'] = False # (kN); Blade StC #3 Blade #2 -- Y resulting force; Inertial (global) coordinates -ServoDyn['BStC3_B2_Fzi'] = False # (kN); Blade StC #3 Blade #2 -- Z resulting force; Inertial (global) coordinates -ServoDyn['BStC3_B2_Mxi'] = False # (kN-m); Blade StC #3 Blade #2 -- X resulting moment; Inertial (global) coordinates -ServoDyn['BStC3_B2_Myi'] = False # (kN-m); Blade StC #3 Blade #2 -- Y resulting moment; Inertial (global) coordinates -ServoDyn['BStC3_B2_Mzi'] = False # (kN-m); Blade StC #3 Blade #2 -- Z resulting moment; Inertial (global) coordinates -ServoDyn['BStC3_B2_Fxl'] = False # (kN); Blade StC #3 Blade #2 -- X resulting force; Local StC coordinates -ServoDyn['BStC3_B2_Fyl'] = False # (kN); Blade StC #3 Blade #2 -- Y resulting force; Local StC coordinates -ServoDyn['BStC3_B2_Fzl'] = False # (kN); Blade StC #3 Blade #2 -- Z resulting force; Local StC coordinates -ServoDyn['BStC3_B2_Mxl'] = False # (kN-m); Blade StC #3 Blade #2 -- X resulting moment; Local StC coordinates -ServoDyn['BStC3_B2_Myl'] = False # (kN-m); Blade StC #3 Blade #2 -- Y resulting moment; Local StC coordinates -ServoDyn['BStC3_B2_Mzl'] = False # (kN-m); Blade StC #3 Blade #2 -- Z resulting moment; Local StC coordinates -ServoDyn['BStC4_B2_XQ'] = False # (m); Blade StC #4 Blade #2 -- X position (displacement); Relative to rest position in StC reference frame -ServoDyn['BStC4_B2_XQD'] = False # (m/s); Blade StC #4 Blade #2 -- X velocity; Relative to nacelle in StC reference frame -ServoDyn['BStC4_B2_YQ'] = False # (m); Blade StC #4 Blade #2 -- Y position (displacement); Relative to rest position in StC reference frame -ServoDyn['BStC4_B2_YQD'] = False # (m/s); Blade StC #4 Blade #2 -- Y velocity; Relative to nacelle in StC reference frame -ServoDyn['BStC4_B2_ZQ'] = False # (m); Blade StC #4 Blade #2 -- Z position (displacement); Relative to rest position in StC reference frame -ServoDyn['BStC4_B2_ZQD'] = False # (m/s); Blade StC #4 Blade #2 -- Z velocity; Relative to nacelle in StC reference frame -ServoDyn['BStC4_B2_Fxi'] = False # (kN); Blade StC #4 Blade #2 -- X resulting force; Inertial (global) coordinates -ServoDyn['BStC4_B2_Fyi'] = False # (kN); Blade StC #4 Blade #2 -- Y resulting force; Inertial (global) coordinates -ServoDyn['BStC4_B2_Fzi'] = False # (kN); Blade StC #4 Blade #2 -- Z resulting force; Inertial (global) coordinates -ServoDyn['BStC4_B2_Mxi'] = False # (kN-m); Blade StC #4 Blade #2 -- X resulting moment; Inertial (global) coordinates -ServoDyn['BStC4_B2_Myi'] = False # (kN-m); Blade StC #4 Blade #2 -- Y resulting moment; Inertial (global) coordinates -ServoDyn['BStC4_B2_Mzi'] = False # (kN-m); Blade StC #4 Blade #2 -- Z resulting moment; Inertial (global) coordinates -ServoDyn['BStC4_B2_Fxl'] = False # (kN); Blade StC #4 Blade #2 -- X resulting force; Local StC coordinates -ServoDyn['BStC4_B2_Fyl'] = False # (kN); Blade StC #4 Blade #2 -- Y resulting force; Local StC coordinates -ServoDyn['BStC4_B2_Fzl'] = False # (kN); Blade StC #4 Blade #2 -- Z resulting force; Local StC coordinates -ServoDyn['BStC4_B2_Mxl'] = False # (kN-m); Blade StC #4 Blade #2 -- X resulting moment; Local StC coordinates -ServoDyn['BStC4_B2_Myl'] = False # (kN-m); Blade StC #4 Blade #2 -- Y resulting moment; Local StC coordinates -ServoDyn['BStC4_B2_Mzl'] = False # (kN-m); Blade StC #4 Blade #2 -- Z resulting moment; Local StC coordinates -ServoDyn['BStC1_B3_XQ'] = False # (m); Blade StC #1 Blade #3 -- X position (displacement); Relative to rest position in StC reference frame -ServoDyn['BStC1_B3_XQD'] = False # (m/s); Blade StC #1 Blade #3 -- X velocity; Relative to nacelle in StC reference frame -ServoDyn['BStC1_B3_YQ'] = False # (m); Blade StC #1 Blade #3 -- Y position (displacement); Relative to rest position in StC reference frame -ServoDyn['BStC1_B3_YQD'] = False # (m/s); Blade StC #1 Blade #3 -- Y velocity; Relative to nacelle in StC reference frame -ServoDyn['BStC1_B3_ZQ'] = False # (m); Blade StC #1 Blade #3 -- Z position (displacement); Relative to rest position in StC reference frame -ServoDyn['BStC1_B3_ZQD'] = False # (m/s); Blade StC #1 Blade #3 -- Z velocity; Relative to nacelle in StC reference frame -ServoDyn['BStC1_B3_Fxi'] = False # (kN); Blade StC #1 Blade #3 -- X resulting force; Inertial (global) coordinates -ServoDyn['BStC1_B3_Fyi'] = False # (kN); Blade StC #1 Blade #3 -- Y resulting force; Inertial (global) coordinates -ServoDyn['BStC1_B3_Fzi'] = False # (kN); Blade StC #1 Blade #3 -- Z resulting force; Inertial (global) coordinates -ServoDyn['BStC1_B3_Mxi'] = False # (kN-m); Blade StC #1 Blade #3 -- X resulting moment; Inertial (global) coordinates -ServoDyn['BStC1_B3_Myi'] = False # (kN-m); Blade StC #1 Blade #3 -- Y resulting moment; Inertial (global) coordinates -ServoDyn['BStC1_B3_Mzi'] = False # (kN-m); Blade StC #1 Blade #3 -- Z resulting moment; Inertial (global) coordinates -ServoDyn['BStC1_B3_Fxl'] = False # (kN); Blade StC #1 Blade #3 -- X resulting force; Local StC coordinates -ServoDyn['BStC1_B3_Fyl'] = False # (kN); Blade StC #1 Blade #3 -- Y resulting force; Local StC coordinates -ServoDyn['BStC1_B3_Fzl'] = False # (kN); Blade StC #1 Blade #3 -- Z resulting force; Local StC coordinates -ServoDyn['BStC1_B3_Mxl'] = False # (kN-m); Blade StC #1 Blade #3 -- X resulting moment; Local StC coordinates -ServoDyn['BStC1_B3_Myl'] = False # (kN-m); Blade StC #1 Blade #3 -- Y resulting moment; Local StC coordinates -ServoDyn['BStC1_B3_Mzl'] = False # (kN-m); Blade StC #1 Blade #3 -- Z resulting moment; Local StC coordinates -ServoDyn['BStC2_B3_XQ'] = False # (m); Blade StC #2 Blade #3 -- X position (displacement); Relative to rest position in StC reference frame -ServoDyn['BStC2_B3_XQD'] = False # (m/s); Blade StC #2 Blade #3 -- X velocity; Relative to nacelle in StC reference frame -ServoDyn['BStC2_B3_YQ'] = False # (m); Blade StC #2 Blade #3 -- Y position (displacement); Relative to rest position in StC reference frame -ServoDyn['BStC2_B3_YQD'] = False # (m/s); Blade StC #2 Blade #3 -- Y velocity; Relative to nacelle in StC reference frame -ServoDyn['BStC2_B3_ZQ'] = False # (m); Blade StC #2 Blade #3 -- Z position (displacement); Relative to rest position in StC reference frame -ServoDyn['BStC2_B3_ZQD'] = False # (m/s); Blade StC #2 Blade #3 -- Z velocity; Relative to nacelle in StC reference frame -ServoDyn['BStC2_B3_Fxi'] = False # (kN); Blade StC #2 Blade #3 -- X resulting force; Inertial (global) coordinates -ServoDyn['BStC2_B3_Fyi'] = False # (kN); Blade StC #2 Blade #3 -- Y resulting force; Inertial (global) coordinates -ServoDyn['BStC2_B3_Fzi'] = False # (kN); Blade StC #2 Blade #3 -- Z resulting force; Inertial (global) coordinates -ServoDyn['BStC2_B3_Mxi'] = False # (kN-m); Blade StC #2 Blade #3 -- X resulting moment; Inertial (global) coordinates -ServoDyn['BStC2_B3_Myi'] = False # (kN-m); Blade StC #2 Blade #3 -- Y resulting moment; Inertial (global) coordinates -ServoDyn['BStC2_B3_Mzi'] = False # (kN-m); Blade StC #2 Blade #3 -- Z resulting moment; Inertial (global) coordinates -ServoDyn['BStC2_B3_Fxl'] = False # (kN); Blade StC #2 Blade #3 -- X resulting force; Local StC coordinates -ServoDyn['BStC2_B3_Fyl'] = False # (kN); Blade StC #2 Blade #3 -- Y resulting force; Local StC coordinates -ServoDyn['BStC2_B3_Fzl'] = False # (kN); Blade StC #2 Blade #3 -- Z resulting force; Local StC coordinates -ServoDyn['BStC2_B3_Mxl'] = False # (kN-m); Blade StC #2 Blade #3 -- X resulting moment; Local StC coordinates -ServoDyn['BStC2_B3_Myl'] = False # (kN-m); Blade StC #2 Blade #3 -- Y resulting moment; Local StC coordinates -ServoDyn['BStC2_B3_Mzl'] = False # (kN-m); Blade StC #2 Blade #3 -- Z resulting moment; Local StC coordinates -ServoDyn['BStC3_B3_XQ'] = False # (m); Blade StC #3 Blade #3 -- X position (displacement); Relative to rest position in StC reference frame -ServoDyn['BStC3_B3_XQD'] = False # (m/s); Blade StC #3 Blade #3 -- X velocity; Relative to nacelle in StC reference frame -ServoDyn['BStC3_B3_YQ'] = False # (m); Blade StC #3 Blade #3 -- Y position (displacement); Relative to rest position in StC reference frame -ServoDyn['BStC3_B3_YQD'] = False # (m/s); Blade StC #3 Blade #3 -- Y velocity; Relative to nacelle in StC reference frame -ServoDyn['BStC3_B3_ZQ'] = False # (m); Blade StC #3 Blade #3 -- Z position (displacement); Relative to rest position in StC reference frame -ServoDyn['BStC3_B3_ZQD'] = False # (m/s); Blade StC #3 Blade #3 -- Z velocity; Relative to nacelle in StC reference frame -ServoDyn['BStC3_B3_Fxi'] = False # (kN); Blade StC #3 Blade #3 -- X resulting force; Inertial (global) coordinates -ServoDyn['BStC3_B3_Fyi'] = False # (kN); Blade StC #3 Blade #3 -- Y resulting force; Inertial (global) coordinates -ServoDyn['BStC3_B3_Fzi'] = False # (kN); Blade StC #3 Blade #3 -- Z resulting force; Inertial (global) coordinates -ServoDyn['BStC3_B3_Mxi'] = False # (kN-m); Blade StC #3 Blade #3 -- X resulting moment; Inertial (global) coordinates -ServoDyn['BStC3_B3_Myi'] = False # (kN-m); Blade StC #3 Blade #3 -- Y resulting moment; Inertial (global) coordinates -ServoDyn['BStC3_B3_Mzi'] = False # (kN-m); Blade StC #3 Blade #3 -- Z resulting moment; Inertial (global) coordinates -ServoDyn['BStC3_B3_Fxl'] = False # (kN); Blade StC #3 Blade #3 -- X resulting force; Local StC coordinates -ServoDyn['BStC3_B3_Fyl'] = False # (kN); Blade StC #3 Blade #3 -- Y resulting force; Local StC coordinates -ServoDyn['BStC3_B3_Fzl'] = False # (kN); Blade StC #3 Blade #3 -- Z resulting force; Local StC coordinates -ServoDyn['BStC3_B3_Mxl'] = False # (kN-m); Blade StC #3 Blade #3 -- X resulting moment; Local StC coordinates -ServoDyn['BStC3_B3_Myl'] = False # (kN-m); Blade StC #3 Blade #3 -- Y resulting moment; Local StC coordinates -ServoDyn['BStC3_B3_Mzl'] = False # (kN-m); Blade StC #3 Blade #3 -- Z resulting moment; Local StC coordinates -ServoDyn['BStC4_B3_XQ'] = False # (m); Blade StC #4 Blade #3 -- X position (displacement); Relative to rest position in StC reference frame -ServoDyn['BStC4_B3_XQD'] = False # (m/s); Blade StC #4 Blade #3 -- X velocity; Relative to nacelle in StC reference frame -ServoDyn['BStC4_B3_YQ'] = False # (m); Blade StC #4 Blade #3 -- Y position (displacement); Relative to rest position in StC reference frame -ServoDyn['BStC4_B3_YQD'] = False # (m/s); Blade StC #4 Blade #3 -- Y velocity; Relative to nacelle in StC reference frame -ServoDyn['BStC4_B3_ZQ'] = False # (m); Blade StC #4 Blade #3 -- Z position (displacement); Relative to rest position in StC reference frame -ServoDyn['BStC4_B3_ZQD'] = False # (m/s); Blade StC #4 Blade #3 -- Z velocity; Relative to nacelle in StC reference frame -ServoDyn['BStC4_B3_Fxi'] = False # (kN); Blade StC #4 Blade #3 -- X resulting force; Inertial (global) coordinates -ServoDyn['BStC4_B3_Fyi'] = False # (kN); Blade StC #4 Blade #3 -- Y resulting force; Inertial (global) coordinates -ServoDyn['BStC4_B3_Fzi'] = False # (kN); Blade StC #4 Blade #3 -- Z resulting force; Inertial (global) coordinates -ServoDyn['BStC4_B3_Mxi'] = False # (kN-m); Blade StC #4 Blade #3 -- X resulting moment; Inertial (global) coordinates -ServoDyn['BStC4_B3_Myi'] = False # (kN-m); Blade StC #4 Blade #3 -- Y resulting moment; Inertial (global) coordinates -ServoDyn['BStC4_B3_Mzi'] = False # (kN-m); Blade StC #4 Blade #3 -- Z resulting moment; Inertial (global) coordinates -ServoDyn['BStC4_B3_Fxl'] = False # (kN); Blade StC #4 Blade #3 -- X resulting force; Local StC coordinates -ServoDyn['BStC4_B3_Fyl'] = False # (kN); Blade StC #4 Blade #3 -- Y resulting force; Local StC coordinates -ServoDyn['BStC4_B3_Fzl'] = False # (kN); Blade StC #4 Blade #3 -- Z resulting force; Local StC coordinates -ServoDyn['BStC4_B3_Mxl'] = False # (kN-m); Blade StC #4 Blade #3 -- X resulting moment; Local StC coordinates -ServoDyn['BStC4_B3_Myl'] = False # (kN-m); Blade StC #4 Blade #3 -- Y resulting moment; Local StC coordinates -ServoDyn['BStC4_B3_Mzl'] = False # (kN-m); Blade StC #4 Blade #3 -- Z resulting moment; Local StC coordinates -ServoDyn['BStC1_B4_XQ'] = False # (m); Blade StC #1 Blade #4 -- X position (displacement); Relative to rest position in StC reference frame -ServoDyn['BStC1_B4_XQD'] = False # (m/s); Blade StC #1 Blade #4 -- X velocity; Relative to nacelle in StC reference frame -ServoDyn['BStC1_B4_YQ'] = False # (m); Blade StC #1 Blade #4 -- Y position (displacement); Relative to rest position in StC reference frame -ServoDyn['BStC1_B4_YQD'] = False # (m/s); Blade StC #1 Blade #4 -- Y velocity; Relative to nacelle in StC reference frame -ServoDyn['BStC1_B4_ZQ'] = False # (m); Blade StC #1 Blade #4 -- Z position (displacement); Relative to rest position in StC reference frame -ServoDyn['BStC1_B4_ZQD'] = False # (m/s); Blade StC #1 Blade #4 -- Z velocity; Relative to nacelle in StC reference frame -ServoDyn['BStC1_B4_Fxi'] = False # (kN); Blade StC #1 Blade #4 -- X resulting force; Inertial (global) coordinates -ServoDyn['BStC1_B4_Fyi'] = False # (kN); Blade StC #1 Blade #4 -- Y resulting force; Inertial (global) coordinates -ServoDyn['BStC1_B4_Fzi'] = False # (kN); Blade StC #1 Blade #4 -- Z resulting force; Inertial (global) coordinates -ServoDyn['BStC1_B4_Mxi'] = False # (kN-m); Blade StC #1 Blade #4 -- X resulting moment; Inertial (global) coordinates -ServoDyn['BStC1_B4_Myi'] = False # (kN-m); Blade StC #1 Blade #4 -- Y resulting moment; Inertial (global) coordinates -ServoDyn['BStC1_B4_Mzi'] = False # (kN-m); Blade StC #1 Blade #4 -- Z resulting moment; Inertial (global) coordinates -ServoDyn['BStC1_B4_Fxl'] = False # (kN); Blade StC #1 Blade #4 -- X resulting force; Local StC coordinates -ServoDyn['BStC1_B4_Fyl'] = False # (kN); Blade StC #1 Blade #4 -- Y resulting force; Local StC coordinates -ServoDyn['BStC1_B4_Fzl'] = False # (kN); Blade StC #1 Blade #4 -- Z resulting force; Local StC coordinates -ServoDyn['BStC1_B4_Mxl'] = False # (kN-m); Blade StC #1 Blade #4 -- X resulting moment; Local StC coordinates -ServoDyn['BStC1_B4_Myl'] = False # (kN-m); Blade StC #1 Blade #4 -- Y resulting moment; Local StC coordinates -ServoDyn['BStC1_B4_Mzl'] = False # (kN-m); Blade StC #1 Blade #4 -- Z resulting moment; Local StC coordinates -ServoDyn['BStC2_B4_XQ'] = False # (m); Blade StC #2 Blade #4 -- X position (displacement); Relative to rest position in StC reference frame -ServoDyn['BStC2_B4_XQD'] = False # (m/s); Blade StC #2 Blade #4 -- X velocity; Relative to nacelle in StC reference frame -ServoDyn['BStC2_B4_YQ'] = False # (m); Blade StC #2 Blade #4 -- Y position (displacement); Relative to rest position in StC reference frame -ServoDyn['BStC2_B4_YQD'] = False # (m/s); Blade StC #2 Blade #4 -- Y velocity; Relative to nacelle in StC reference frame -ServoDyn['BStC2_B4_ZQ'] = False # (m); Blade StC #2 Blade #4 -- Z position (displacement); Relative to rest position in StC reference frame -ServoDyn['BStC2_B4_ZQD'] = False # (m/s); Blade StC #2 Blade #4 -- Z velocity; Relative to nacelle in StC reference frame -ServoDyn['BStC2_B4_Fxi'] = False # (kN); Blade StC #2 Blade #4 -- X resulting force; Inertial (global) coordinates -ServoDyn['BStC2_B4_Fyi'] = False # (kN); Blade StC #2 Blade #4 -- Y resulting force; Inertial (global) coordinates -ServoDyn['BStC2_B4_Fzi'] = False # (kN); Blade StC #2 Blade #4 -- Z resulting force; Inertial (global) coordinates -ServoDyn['BStC2_B4_Mxi'] = False # (kN-m); Blade StC #2 Blade #4 -- X resulting moment; Inertial (global) coordinates -ServoDyn['BStC2_B4_Myi'] = False # (kN-m); Blade StC #2 Blade #4 -- Y resulting moment; Inertial (global) coordinates -ServoDyn['BStC2_B4_Mzi'] = False # (kN-m); Blade StC #2 Blade #4 -- Z resulting moment; Inertial (global) coordinates -ServoDyn['BStC2_B4_Fxl'] = False # (kN); Blade StC #2 Blade #4 -- X resulting force; Local StC coordinates -ServoDyn['BStC2_B4_Fyl'] = False # (kN); Blade StC #2 Blade #4 -- Y resulting force; Local StC coordinates -ServoDyn['BStC2_B4_Fzl'] = False # (kN); Blade StC #2 Blade #4 -- Z resulting force; Local StC coordinates -ServoDyn['BStC2_B4_Mxl'] = False # (kN-m); Blade StC #2 Blade #4 -- X resulting moment; Local StC coordinates -ServoDyn['BStC2_B4_Myl'] = False # (kN-m); Blade StC #2 Blade #4 -- Y resulting moment; Local StC coordinates -ServoDyn['BStC2_B4_Mzl'] = False # (kN-m); Blade StC #2 Blade #4 -- Z resulting moment; Local StC coordinates -ServoDyn['BStC3_B4_XQ'] = False # (m); Blade StC #3 Blade #4 -- X position (displacement); Relative to rest position in StC reference frame -ServoDyn['BStC3_B4_XQD'] = False # (m/s); Blade StC #3 Blade #4 -- X velocity; Relative to nacelle in StC reference frame -ServoDyn['BStC3_B4_YQ'] = False # (m); Blade StC #3 Blade #4 -- Y position (displacement); Relative to rest position in StC reference frame -ServoDyn['BStC3_B4_YQD'] = False # (m/s); Blade StC #3 Blade #4 -- Y velocity; Relative to nacelle in StC reference frame -ServoDyn['BStC3_B4_ZQ'] = False # (m); Blade StC #3 Blade #4 -- Z position (displacement); Relative to rest position in StC reference frame -ServoDyn['BStC3_B4_ZQD'] = False # (m/s); Blade StC #3 Blade #4 -- Z velocity; Relative to nacelle in StC reference frame -ServoDyn['BStC3_B4_Fxi'] = False # (kN); Blade StC #3 Blade #4 -- X resulting force; Inertial (global) coordinates -ServoDyn['BStC3_B4_Fyi'] = False # (kN); Blade StC #3 Blade #4 -- Y resulting force; Inertial (global) coordinates -ServoDyn['BStC3_B4_Fzi'] = False # (kN); Blade StC #3 Blade #4 -- Z resulting force; Inertial (global) coordinates -ServoDyn['BStC3_B4_Mxi'] = False # (kN-m); Blade StC #3 Blade #4 -- X resulting moment; Inertial (global) coordinates -ServoDyn['BStC3_B4_Myi'] = False # (kN-m); Blade StC #3 Blade #4 -- Y resulting moment; Inertial (global) coordinates -ServoDyn['BStC3_B4_Mzi'] = False # (kN-m); Blade StC #3 Blade #4 -- Z resulting moment; Inertial (global) coordinates -ServoDyn['BStC3_B4_Fxl'] = False # (kN); Blade StC #3 Blade #4 -- X resulting force; Local StC coordinates -ServoDyn['BStC3_B4_Fyl'] = False # (kN); Blade StC #3 Blade #4 -- Y resulting force; Local StC coordinates -ServoDyn['BStC3_B4_Fzl'] = False # (kN); Blade StC #3 Blade #4 -- Z resulting force; Local StC coordinates -ServoDyn['BStC3_B4_Mxl'] = False # (kN-m); Blade StC #3 Blade #4 -- X resulting moment; Local StC coordinates -ServoDyn['BStC3_B4_Myl'] = False # (kN-m); Blade StC #3 Blade #4 -- Y resulting moment; Local StC coordinates -ServoDyn['BStC3_B4_Mzl'] = False # (kN-m); Blade StC #3 Blade #4 -- Z resulting moment; Local StC coordinates -ServoDyn['BStC4_B4_XQ'] = False # (m); Blade StC #4 Blade #4 -- X position (displacement); Relative to rest position in StC reference frame -ServoDyn['BStC4_B4_XQD'] = False # (m/s); Blade StC #4 Blade #4 -- X velocity; Relative to nacelle in StC reference frame -ServoDyn['BStC4_B4_YQ'] = False # (m); Blade StC #4 Blade #4 -- Y position (displacement); Relative to rest position in StC reference frame -ServoDyn['BStC4_B4_YQD'] = False # (m/s); Blade StC #4 Blade #4 -- Y velocity; Relative to nacelle in StC reference frame -ServoDyn['BStC4_B4_ZQ'] = False # (m); Blade StC #4 Blade #4 -- Z position (displacement); Relative to rest position in StC reference frame -ServoDyn['BStC4_B4_ZQD'] = False # (m/s); Blade StC #4 Blade #4 -- Z velocity; Relative to nacelle in StC reference frame -ServoDyn['BStC4_B4_Fxi'] = False # (kN); Blade StC #4 Blade #4 -- X resulting force; Inertial (global) coordinates -ServoDyn['BStC4_B4_Fyi'] = False # (kN); Blade StC #4 Blade #4 -- Y resulting force; Inertial (global) coordinates -ServoDyn['BStC4_B4_Fzi'] = False # (kN); Blade StC #4 Blade #4 -- Z resulting force; Inertial (global) coordinates -ServoDyn['BStC4_B4_Mxi'] = False # (kN-m); Blade StC #4 Blade #4 -- X resulting moment; Inertial (global) coordinates -ServoDyn['BStC4_B4_Myi'] = False # (kN-m); Blade StC #4 Blade #4 -- Y resulting moment; Inertial (global) coordinates -ServoDyn['BStC4_B4_Mzi'] = False # (kN-m); Blade StC #4 Blade #4 -- Z resulting moment; Inertial (global) coordinates -ServoDyn['BStC4_B4_Fxl'] = False # (kN); Blade StC #4 Blade #4 -- X resulting force; Local StC coordinates -ServoDyn['BStC4_B4_Fyl'] = False # (kN); Blade StC #4 Blade #4 -- Y resulting force; Local StC coordinates -ServoDyn['BStC4_B4_Fzl'] = False # (kN); Blade StC #4 Blade #4 -- Z resulting force; Local StC coordinates -ServoDyn['BStC4_B4_Mxl'] = False # (kN-m); Blade StC #4 Blade #4 -- X resulting moment; Local StC coordinates -ServoDyn['BStC4_B4_Myl'] = False # (kN-m); Blade StC #4 Blade #4 -- Y resulting moment; Local StC coordinates -ServoDyn['BStC4_B4_Mzl'] = False # (kN-m); Blade StC #4 Blade #4 -- Z resulting moment; Local StC coordinates - -# Substructure Structural Control (StC) -ServoDyn['SStC1_XQ'] = False # (m); Substructure StC #1 -- X position (displacement); Relative to rest position in StC reference frame -ServoDyn['SStC1_XQD'] = False # (m/s); Substructure StC #1 -- X velocity; Relative to nacelle in StC reference frame -ServoDyn['SStC1_YQ'] = False # (m); Substructure StC #1 -- Y position (displacement); Relative to rest position in StC reference frame -ServoDyn['SStC1_YQD'] = False # (m/s); Substructure StC #1 -- Y velocity; Relative to nacelle in StC reference frame -ServoDyn['SStC1_ZQ'] = False # (m); Substructure StC #1 -- Z position (displacement); Relative to rest position in StC reference frame -ServoDyn['SStC1_ZQD'] = False # (m/s); Substructure StC #1 -- Z velocity; Relative to nacelle in StC reference frame -ServoDyn['SStC1_Fxi'] = False # (kN); Substructure StC #1 -- X resulting force; Inertial (global) coordinates -ServoDyn['SStC1_Fyi'] = False # (kN); Substructure StC #1 -- Y resulting force; Inertial (global) coordinates -ServoDyn['SStC1_Fzi'] = False # (kN); Substructure StC #1 -- Z resulting force; Inertial (global) coordinates -ServoDyn['SStC1_Mxi'] = False # (kN-m); Substructure StC #1 -- X resulting moment; Inertial (global) coordinates -ServoDyn['SStC1_Myi'] = False # (kN-m); Substructure StC #1 -- Y resulting moment; Inertial (global) coordinates -ServoDyn['SStC1_Mzi'] = False # (kN-m); Substructure StC #1 -- Z resulting moment; Inertial (global) coordinates -ServoDyn['SStC1_Fxl'] = False # (kN); Substructure StC #1 -- X resulting force; Local StC coordinates -ServoDyn['SStC1_Fyl'] = False # (kN); Substructure StC #1 -- Y resulting force; Local StC coordinates -ServoDyn['SStC1_Fzl'] = False # (kN); Substructure StC #1 -- Z resulting force; Local StC coordinates -ServoDyn['SStC1_Mxl'] = False # (kN-m); Substructure StC #1 -- X resulting moment; Local StC coordinates -ServoDyn['SStC1_Myl'] = False # (kN-m); Substructure StC #1 -- Y resulting moment; Local StC coordinates -ServoDyn['SStC1_Mzl'] = False # (kN-m); Substructure StC #1 -- Z resulting moment; Local StC coordinates -ServoDyn['SStC2_XQ'] = False # (m); Substructure StC #2 -- X position (displacement); Relative to rest position in StC reference frame -ServoDyn['SStC2_XQD'] = False # (m/s); Substructure StC #2 -- X velocity; Relative to nacelle in StC reference frame -ServoDyn['SStC2_YQ'] = False # (m); Substructure StC #2 -- Y position (displacement); Relative to rest position in StC reference frame -ServoDyn['SStC2_YQD'] = False # (m/s); Substructure StC #2 -- Y velocity; Relative to nacelle in StC reference frame -ServoDyn['SStC2_ZQ'] = False # (m); Substructure StC #2 -- Z position (displacement); Relative to rest position in StC reference frame -ServoDyn['SStC2_ZQD'] = False # (m/s); Substructure StC #2 -- Z velocity; Relative to nacelle in StC reference frame -ServoDyn['SStC2_Fxi'] = False # (kN); Substructure StC #2 -- X resulting force; Inertial (global) coordinates -ServoDyn['SStC2_Fyi'] = False # (kN); Substructure StC #2 -- Y resulting force; Inertial (global) coordinates -ServoDyn['SStC2_Fzi'] = False # (kN); Substructure StC #2 -- Z resulting force; Inertial (global) coordinates -ServoDyn['SStC2_Mxi'] = False # (kN-m); Substructure StC #2 -- X resulting moment; Inertial (global) coordinates -ServoDyn['SStC2_Myi'] = False # (kN-m); Substructure StC #2 -- Y resulting moment; Inertial (global) coordinates -ServoDyn['SStC2_Mzi'] = False # (kN-m); Substructure StC #2 -- Z resulting moment; Inertial (global) coordinates -ServoDyn['SStC2_Fxl'] = False # (kN); Substructure StC #2 -- X resulting force; Local StC coordinates -ServoDyn['SStC2_Fyl'] = False # (kN); Substructure StC #2 -- Y resulting force; Local StC coordinates -ServoDyn['SStC2_Fzl'] = False # (kN); Substructure StC #2 -- Z resulting force; Local StC coordinates -ServoDyn['SStC2_Mxl'] = False # (kN-m); Substructure StC #2 -- X resulting moment; Local StC coordinates -ServoDyn['SStC2_Myl'] = False # (kN-m); Substructure StC #2 -- Y resulting moment; Local StC coordinates -ServoDyn['SStC2_Mzl'] = False # (kN-m); Substructure StC #2 -- Z resulting moment; Local StC coordinates -ServoDyn['SStC3_XQ'] = False # (m); Substructure StC #3 -- X position (displacement); Relative to rest position in StC reference frame -ServoDyn['SStC3_XQD'] = False # (m/s); Substructure StC #3 -- X velocity; Relative to nacelle in StC reference frame -ServoDyn['SStC3_YQ'] = False # (m); Substructure StC #3 -- Y position (displacement); Relative to rest position in StC reference frame -ServoDyn['SStC3_YQD'] = False # (m/s); Substructure StC #3 -- Y velocity; Relative to nacelle in StC reference frame -ServoDyn['SStC3_ZQ'] = False # (m); Substructure StC #3 -- Z position (displacement); Relative to rest position in StC reference frame -ServoDyn['SStC3_ZQD'] = False # (m/s); Substructure StC #3 -- Z velocity; Relative to nacelle in StC reference frame -ServoDyn['SStC3_Fxi'] = False # (kN); Substructure StC #3 -- X resulting force; Inertial (global) coordinates -ServoDyn['SStC3_Fyi'] = False # (kN); Substructure StC #3 -- Y resulting force; Inertial (global) coordinates -ServoDyn['SStC3_Fzi'] = False # (kN); Substructure StC #3 -- Z resulting force; Inertial (global) coordinates -ServoDyn['SStC3_Mxi'] = False # (kN-m); Substructure StC #3 -- X resulting moment; Inertial (global) coordinates -ServoDyn['SStC3_Myi'] = False # (kN-m); Substructure StC #3 -- Y resulting moment; Inertial (global) coordinates -ServoDyn['SStC3_Mzi'] = False # (kN-m); Substructure StC #3 -- Z resulting moment; Inertial (global) coordinates -ServoDyn['SStC3_Fxl'] = False # (kN); Substructure StC #3 -- X resulting force; Local StC coordinates -ServoDyn['SStC3_Fyl'] = False # (kN); Substructure StC #3 -- Y resulting force; Local StC coordinates -ServoDyn['SStC3_Fzl'] = False # (kN); Substructure StC #3 -- Z resulting force; Local StC coordinates -ServoDyn['SStC3_Mxl'] = False # (kN-m); Substructure StC #3 -- X resulting moment; Local StC coordinates -ServoDyn['SStC3_Myl'] = False # (kN-m); Substructure StC #3 -- Y resulting moment; Local StC coordinates -ServoDyn['SStC3_Mzl'] = False # (kN-m); Substructure StC #3 -- Z resulting moment; Local StC coordinates -ServoDyn['SStC4_XQ'] = False # (m); Substructure StC #4 -- X position (displacement); Relative to rest position in StC reference frame -ServoDyn['SStC4_XQD'] = False # (m/s); Substructure StC #4 -- X velocity; Relative to nacelle in StC reference frame -ServoDyn['SStC4_YQ'] = False # (m); Substructure StC #4 -- Y position (displacement); Relative to rest position in StC reference frame -ServoDyn['SStC4_YQD'] = False # (m/s); Substructure StC #4 -- Y velocity; Relative to nacelle in StC reference frame -ServoDyn['SStC4_ZQ'] = False # (m); Substructure StC #4 -- Z position (displacement); Relative to rest position in StC reference frame -ServoDyn['SStC4_ZQD'] = False # (m/s); Substructure StC #4 -- Z velocity; Relative to nacelle in StC reference frame -ServoDyn['SStC4_Fxi'] = False # (kN); Substructure StC #4 -- X resulting force; Inertial (global) coordinates -ServoDyn['SStC4_Fyi'] = False # (kN); Substructure StC #4 -- Y resulting force; Inertial (global) coordinates -ServoDyn['SStC4_Fzi'] = False # (kN); Substructure StC #4 -- Z resulting force; Inertial (global) coordinates -ServoDyn['SStC4_Mxi'] = False # (kN-m); Substructure StC #4 -- X resulting moment; Inertial (global) coordinates -ServoDyn['SStC4_Myi'] = False # (kN-m); Substructure StC #4 -- Y resulting moment; Inertial (global) coordinates -ServoDyn['SStC4_Mzi'] = False # (kN-m); Substructure StC #4 -- Z resulting moment; Inertial (global) coordinates -ServoDyn['SStC4_Fxl'] = False # (kN); Substructure StC #4 -- X resulting force; Local StC coordinates -ServoDyn['SStC4_Fyl'] = False # (kN); Substructure StC #4 -- Y resulting force; Local StC coordinates -ServoDyn['SStC4_Fzl'] = False # (kN); Substructure StC #4 -- Z resulting force; Local StC coordinates -ServoDyn['SStC4_Mxl'] = False # (kN-m); Substructure StC #4 -- X resulting moment; Local StC coordinates -ServoDyn['SStC4_Myl'] = False # (kN-m); Substructure StC #4 -- Y resulting moment; Local StC coordinates -ServoDyn['SStC4_Mzl'] = False # (kN-m); Substructure StC #4 -- Z resulting moment; Local StC coordinates - - - -# Flap outputs -ServoDyn['BLFLAP1'] = False # (m/s); Tower Y TMD velocity; Relative to tower -ServoDyn['BLFLAP2'] = False # (m/s); Tower Y TMD velocity; Relative to tower -ServoDyn['BLFLAP3'] = False # (m/s); Tower Y TMD velocity; Relative to tower - -""" AeroDyn """ -AeroDyn = {} - -# Tower -AeroDyn['TwN1VUndx'] = False # (m/s); Undisturbed x-component wind velocity at Tw node 1; local tower coordinate system -AeroDyn['TwN1VUndy'] = False # (m/s); Undisturbed y-component wind velocity at Tw node 1; local tower coordinate system -AeroDyn['TwN1VUndz'] = False # (m/s); Undisturbed z-component wind velocity at Tw node 1; local tower coordinate system -AeroDyn['TwN2VUndx'] = False # (m/s); Undisturbed x-component wind velocity at Tw node 2; local tower coordinate system -AeroDyn['TwN2VUndy'] = False # (m/s); Undisturbed y-component wind velocity at Tw node 2; local tower coordinate system -AeroDyn['TwN2VUndz'] = False # (m/s); Undisturbed z-component wind velocity at Tw node 2; local tower coordinate system -AeroDyn['TwN3VUndx'] = False # (m/s); Undisturbed x-component wind velocity at Tw node 3; local tower coordinate system -AeroDyn['TwN3VUndy'] = False # (m/s); Undisturbed y-component wind velocity at Tw node 3; local tower coordinate system -AeroDyn['TwN3VUndz'] = False # (m/s); Undisturbed z-component wind velocity at Tw node 3; local tower coordinate system -AeroDyn['TwN4VUndx'] = False # (m/s); Undisturbed x-component wind velocity at Tw node 4; local tower coordinate system -AeroDyn['TwN4VUndy'] = False # (m/s); Undisturbed y-component wind velocity at Tw node 4; local tower coordinate system -AeroDyn['TwN4VUndz'] = False # (m/s); Undisturbed z-component wind velocity at Tw node 4; local tower coordinate system -AeroDyn['TwN5VUndx'] = False # (m/s); Undisturbed x-component wind velocity at Tw node 5; local tower coordinate system -AeroDyn['TwN5VUndy'] = False # (m/s); Undisturbed y-component wind velocity at Tw node 5; local tower coordinate system -AeroDyn['TwN5VUndz'] = False # (m/s); Undisturbed z-component wind velocity at Tw node 5; local tower coordinate system -AeroDyn['TwN6VUndx'] = False # (m/s); Undisturbed x-component wind velocity at Tw node 6; local tower coordinate system -AeroDyn['TwN6VUndy'] = False # (m/s); Undisturbed y-component wind velocity at Tw node 6; local tower coordinate system -AeroDyn['TwN6VUndz'] = False # (m/s); Undisturbed z-component wind velocity at Tw node 6; local tower coordinate system -AeroDyn['TwN7VUndx'] = False # (m/s); Undisturbed x-component wind velocity at Tw node 7; local tower coordinate system -AeroDyn['TwN7VUndy'] = False # (m/s); Undisturbed y-component wind velocity at Tw node 7; local tower coordinate system -AeroDyn['TwN7VUndz'] = False # (m/s); Undisturbed z-component wind velocity at Tw node 7; local tower coordinate system -AeroDyn['TwN8VUndx'] = False # (m/s); Undisturbed x-component wind velocity at Tw node 8; local tower coordinate system -AeroDyn['TwN8VUndy'] = False # (m/s); Undisturbed y-component wind velocity at Tw node 8; local tower coordinate system -AeroDyn['TwN8VUndz'] = False # (m/s); Undisturbed z-component wind velocity at Tw node 8; local tower coordinate system -AeroDyn['TwN9VUndx'] = False # (m/s); Undisturbed x-component wind velocity at Tw node 9; local tower coordinate system -AeroDyn['TwN9VUndy'] = False # (m/s); Undisturbed y-component wind velocity at Tw node 9; local tower coordinate system -AeroDyn['TwN9VUndz'] = False # (m/s); Undisturbed z-component wind velocity at Tw node 9; local tower coordinate system -AeroDyn['TwN1STVx'] = False # (m/s); Structural translational velocity x-component at Tw node 1; local tower coordinate system -AeroDyn['TwN1STVy'] = False # (m/s); Structural translational velocity y-component at Tw node 1; local tower coordinate system -AeroDyn['TwN1STVz'] = False # (m/s); Structural translational velocity z-component at Tw node 1; local tower coordinate system -AeroDyn['TwN2STVx'] = False # (m/s); Structural translational velocity x-component at Tw node 2; local tower coordinate system -AeroDyn['TwN2STVy'] = False # (m/s); Structural translational velocity y-component at Tw node 2; local tower coordinate system -AeroDyn['TwN2STVz'] = False # (m/s); Structural translational velocity z-component at Tw node 2; local tower coordinate system -AeroDyn['TwN3STVx'] = False # (m/s); Structural translational velocity x-component at Tw node 3; local tower coordinate system -AeroDyn['TwN3STVy'] = False # (m/s); Structural translational velocity y-component at Tw node 3; local tower coordinate system -AeroDyn['TwN3STVz'] = False # (m/s); Structural translational velocity z-component at Tw node 3; local tower coordinate system -AeroDyn['TwN4STVx'] = False # (m/s); Structural translational velocity x-component at Tw node 4; local tower coordinate system -AeroDyn['TwN4STVy'] = False # (m/s); Structural translational velocity y-component at Tw node 4; local tower coordinate system -AeroDyn['TwN4STVz'] = False # (m/s); Structural translational velocity z-component at Tw node 4; local tower coordinate system -AeroDyn['TwN5STVx'] = False # (m/s); Structural translational velocity x-component at Tw node 5; local tower coordinate system -AeroDyn['TwN5STVy'] = False # (m/s); Structural translational velocity y-component at Tw node 5; local tower coordinate system -AeroDyn['TwN5STVz'] = False # (m/s); Structural translational velocity z-component at Tw node 5; local tower coordinate system -AeroDyn['TwN6STVx'] = False # (m/s); Structural translational velocity x-component at Tw node 6; local tower coordinate system -AeroDyn['TwN6STVy'] = False # (m/s); Structural translational velocity y-component at Tw node 6; local tower coordinate system -AeroDyn['TwN6STVz'] = False # (m/s); Structural translational velocity z-component at Tw node 6; local tower coordinate system -AeroDyn['TwN7STVx'] = False # (m/s); Structural translational velocity x-component at Tw node 7; local tower coordinate system -AeroDyn['TwN7STVy'] = False # (m/s); Structural translational velocity y-component at Tw node 7; local tower coordinate system -AeroDyn['TwN7STVz'] = False # (m/s); Structural translational velocity z-component at Tw node 7; local tower coordinate system -AeroDyn['TwN8STVx'] = False # (m/s); Structural translational velocity x-component at Tw node 8; local tower coordinate system -AeroDyn['TwN8STVy'] = False # (m/s); Structural translational velocity y-component at Tw node 8; local tower coordinate system -AeroDyn['TwN8STVz'] = False # (m/s); Structural translational velocity z-component at Tw node 8; local tower coordinate system -AeroDyn['TwN9STVx'] = False # (m/s); Structural translational velocity x-component at Tw node 9; local tower coordinate system -AeroDyn['TwN9STVy'] = False # (m/s); Structural translational velocity y-component at Tw node 9; local tower coordinate system -AeroDyn['TwN9STVz'] = False # (m/s); Structural translational velocity z-component at Tw node 9; local tower coordinate system -AeroDyn['TwN1Vrel'] = False # (m/s); Relative wind speed at Tw node 1; -AeroDyn['TwN2Vrel'] = False # (m/s); Relative wind speed at Tw node 2; -AeroDyn['TwN3Vrel'] = False # (m/s); Relative wind speed at Tw node 3; -AeroDyn['TwN4Vrel'] = False # (m/s); Relative wind speed at Tw node 4; -AeroDyn['TwN5Vrel'] = False # (m/s); Relative wind speed at Tw node 5; -AeroDyn['TwN6Vrel'] = False # (m/s); Relative wind speed at Tw node 6; -AeroDyn['TwN7Vrel'] = False # (m/s); Relative wind speed at Tw node 7; -AeroDyn['TwN8Vrel'] = False # (m/s); Relative wind speed at Tw node 8; -AeroDyn['TwN9Vrel'] = False # (m/s); Relative wind speed at Tw node 9; -AeroDyn['TwN1DynP'] = False # (Pa); Dynamic Pressure at Tw node 1; -AeroDyn['TwN2DynP'] = False # (Pa); Dynamic Pressure at Tw node 2; -AeroDyn['TwN3DynP'] = False # (Pa); Dynamic Pressure at Tw node 3; -AeroDyn['TwN4DynP'] = False # (Pa); Dynamic Pressure at Tw node 4; -AeroDyn['TwN5DynP'] = False # (Pa); Dynamic Pressure at Tw node 5; -AeroDyn['TwN6DynP'] = False # (Pa); Dynamic Pressure at Tw node 6; -AeroDyn['TwN7DynP'] = False # (Pa); Dynamic Pressure at Tw node 7; -AeroDyn['TwN8DynP'] = False # (Pa); Dynamic Pressure at Tw node 8; -AeroDyn['TwN9DynP'] = False # (Pa); Dynamic Pressure at Tw node 9; -AeroDyn['TwN1Re'] = False # (-); Reynolds number (in millions) at Tw node 1; -AeroDyn['TwN2Re'] = False # (-); Reynolds number (in millions) at Tw node 2; -AeroDyn['TwN3Re'] = False # (-); Reynolds number (in millions) at Tw node 3; -AeroDyn['TwN4Re'] = False # (-); Reynolds number (in millions) at Tw node 4; -AeroDyn['TwN5Re'] = False # (-); Reynolds number (in millions) at Tw node 5; -AeroDyn['TwN6Re'] = False # (-); Reynolds number (in millions) at Tw node 6; -AeroDyn['TwN7Re'] = False # (-); Reynolds number (in millions) at Tw node 7; -AeroDyn['TwN8Re'] = False # (-); Reynolds number (in millions) at Tw node 8; -AeroDyn['TwN9Re'] = False # (-); Reynolds number (in millions) at Tw node 9; -AeroDyn['TwN1M'] = False # (-); Mach number at Tw node 1; -AeroDyn['TwN2M'] = False # (-); Mach number at Tw node 2; -AeroDyn['TwN3M'] = False # (-); Mach number at Tw node 3; -AeroDyn['TwN4M'] = False # (-); Mach number at Tw node 4; -AeroDyn['TwN5M'] = False # (-); Mach number at Tw node 5; -AeroDyn['TwN6M'] = False # (-); Mach number at Tw node 6; -AeroDyn['TwN7M'] = False # (-); Mach number at Tw node 7; -AeroDyn['TwN8M'] = False # (-); Mach number at Tw node 8; -AeroDyn['TwN9M'] = False # (-); Mach number at Tw node 9; -AeroDyn['TwN1Fdx'] = False # (N/m); x-component of drag force per unit length at Tw node 1; local tower coordinate system -AeroDyn['TwN2Fdx'] = False # (N/m); x-component of drag force per unit length at Tw node 2; local tower coordinate system -AeroDyn['TwN3Fdx'] = False # (N/m); x-component of drag force per unit length at Tw node 3; local tower coordinate system -AeroDyn['TwN4Fdx'] = False # (N/m); x-component of drag force per unit length at Tw node 4; local tower coordinate system -AeroDyn['TwN5Fdx'] = False # (N/m); x-component of drag force per unit length at Tw node 5; local tower coordinate system -AeroDyn['TwN6Fdx'] = False # (N/m); x-component of drag force per unit length at Tw node 6; local tower coordinate system -AeroDyn['TwN7Fdx'] = False # (N/m); x-component of drag force per unit length at Tw node 7; local tower coordinate system -AeroDyn['TwN8Fdx'] = False # (N/m); x-component of drag force per unit length at Tw node 8; local tower coordinate system -AeroDyn['TwN9Fdx'] = False # (N/m); x-component of drag force per unit length at Tw node 9; local tower coordinate system -AeroDyn['TwN1Fdy'] = False # (N/m); y-component of drag force per unit length at Tw node 1; local tower coordinate system -AeroDyn['TwN2Fdy'] = False # (N/m); y-component of drag force per unit length at Tw node 2; local tower coordinate system -AeroDyn['TwN3Fdy'] = False # (N/m); y-component of drag force per unit length at Tw node 3; local tower coordinate system -AeroDyn['TwN4Fdy'] = False # (N/m); y-component of drag force per unit length at Tw node 4; local tower coordinate system -AeroDyn['TwN5Fdy'] = False # (N/m); y-component of drag force per unit length at Tw node 5; local tower coordinate system -AeroDyn['TwN6Fdy'] = False # (N/m); y-component of drag force per unit length at Tw node 6; local tower coordinate system -AeroDyn['TwN7Fdy'] = False # (N/m); y-component of drag force per unit length at Tw node 7; local tower coordinate system -AeroDyn['TwN8Fdy'] = False # (N/m); y-component of drag force per unit length at Tw node 8; local tower coordinate system -AeroDyn['TwN9Fdy'] = False # (N/m); y-component of drag force per unit length at Tw node 9; local tower coordinate system - -# Blade -AeroDyn['B1Azimuth'] = False # (deg); Azimuth angle of blade 1; -AeroDyn['B2Azimuth'] = False # (deg); Azimuth angle of blade 2; -AeroDyn['B3Azimuth'] = False # (deg); Azimuth angle of blade 3; -AeroDyn['B1Pitch'] = False # (deg); Pitch angle of blade 1; -AeroDyn['B2Pitch'] = False # (deg); Pitch angle of blade 2; -AeroDyn['B3Pitch'] = False # (deg); Pitch angle of blade 3; -AeroDyn['B1AeroFx'] = False # (N); Total blade aerodynamic load for blade 1 (force in x-direction); blade root coordinate system -AeroDyn['B1AeroFy'] = False # (N); Total blade aerodynamic load for blade 1 (force in y-direction); blade root coordinate system -AeroDyn['B1AeroFz'] = False # (N); Total blade aerodynamic load for blade 1 (force in z-direction); blade root coordinate system -AeroDyn['B1AeroMx'] = False # (N-m); Total blade aerodynamic load for blade 1 (moment in x-direction); blade root coordinate system -AeroDyn['B1AeroMy'] = False # (N-m); Total blade aerodynamic load for blade 1 (moment in y-direction); blade root coordinate system -AeroDyn['B1AeroMz'] = False # (N-m); Total blade aerodynamic load for blade 1 (moment in z-direction); blade root coordinate system -AeroDyn['B1AeroPwr'] = False # (W); Total aerodynamic power from blade 1; -AeroDyn['B2AeroFx'] = False # (N); Total blade aerodynamic load for blade 2 (force in x-direction); blade root coordinate system -AeroDyn['B2AeroFy'] = False # (N); Total blade aerodynamic load for blade 2 (force in y-direction); blade root coordinate system -AeroDyn['B2AeroFz'] = False # (N); Total blade aerodynamic load for blade 2 (force in z-direction); blade root coordinate system -AeroDyn['B2AeroMx'] = False # (N-m); Total blade aerodynamic load for blade 2 (moment in x-direction); blade root coordinate system -AeroDyn['B2AeroMy'] = False # (N-m); Total blade aerodynamic load for blade 2 (moment in y-direction); blade root coordinate system -AeroDyn['B2AeroMz'] = False # (N-m); Total blade aerodynamic load for blade 2 (moment in z-direction); blade root coordinate system -AeroDyn['B2AeroPwr'] = False # (W); Total aerodynamic power from blade 2; -AeroDyn['B3AeroFx'] = False # (N); Total blade aerodynamic load for blade 3 (force in x-direction); blade root coordinate system -AeroDyn['B3AeroFy'] = False # (N); Total blade aerodynamic load for blade 3 (force in y-direction); blade root coordinate system -AeroDyn['B3AeroFz'] = False # (N); Total blade aerodynamic load for blade 3 (force in z-direction); blade root coordinate system -AeroDyn['B3AeroMx'] = False # (N-m); Total blade aerodynamic load for blade 3 (moment in x-direction); blade root coordinate system -AeroDyn['B3AeroMy'] = False # (N-m); Total blade aerodynamic load for blade 3 (moment in y-direction); blade root coordinate system -AeroDyn['B3AeroMz'] = False # (N-m); Total blade aerodynamic load for blade 3 (moment in z-direction); blade root coordinate system -AeroDyn['B3AeroPwr'] = False # (W); Total aerodynamic power from blade 3; -AeroDyn['B4AeroFx'] = False # (N); Total blade aerodynamic load for blade 4 (force in x-direction); blade root coordinate system -AeroDyn['B4AeroFy'] = False # (N); Total blade aerodynamic load for blade 4 (force in y-direction); blade root coordinate system -AeroDyn['B4AeroFz'] = False # (N); Total blade aerodynamic load for blade 4 (force in z-direction); blade root coordinate system -AeroDyn['B4AeroMx'] = False # (N-m); Total blade aerodynamic load for blade 4 (moment in x-direction); blade root coordinate system -AeroDyn['B4AeroMy'] = False # (N-m); Total blade aerodynamic load for blade 4 (moment in y-direction); blade root coordinate system -AeroDyn['B4AeroMz'] = False # (N-m); Total blade aerodynamic load for blade 4 (moment in z-direction); blade root coordinate system -AeroDyn['B4AeroPwr'] = False # (W); Total aerodynamic power from blade 4; -AeroDyn['B1AeroFxg'] = False # (N); Total blade aerodynamic load for blade 1 (force in x-direction); global coordinate system -AeroDyn['B1AeroFyg'] = False # (N); Total blade aerodynamic load for blade 1 (force in y-direction); global coordinate system -AeroDyn['B1AeroFzg'] = False # (N); Total blade aerodynamic load for blade 1 (force in z-direction); global coordinate system -AeroDyn['B1AeroMxg'] = False # (N-m); Total blade aerodynamic load for blade 1 (moment in x-direction); global coordinate system -AeroDyn['B1AeroMyg'] = False # (N-m); Total blade aerodynamic load for blade 1 (moment in y-direction); global coordinate system -AeroDyn['B1AeroMzg'] = False # (N-m); Total blade aerodynamic load for blade 1 (moment in z-direction); global coordinate system -AeroDyn['B2AeroFxg'] = False # (N); Total blade aerodynamic load for blade 2 (force in x-direction); global coordinate system -AeroDyn['B2AeroFyg'] = False # (N); Total blade aerodynamic load for blade 2 (force in y-direction); global coordinate system -AeroDyn['B2AeroFzg'] = False # (N); Total blade aerodynamic load for blade 2 (force in z-direction); global coordinate system -AeroDyn['B2AeroMxg'] = False # (N-m); Total blade aerodynamic load for blade 2 (moment in x-direction); global coordinate system -AeroDyn['B2AeroMyg'] = False # (N-m); Total blade aerodynamic load for blade 2 (moment in y-direction); global coordinate system -AeroDyn['B2AeroMzg'] = False # (N-m); Total blade aerodynamic load for blade 2 (moment in z-direction); global coordinate system -AeroDyn['B3AeroFxg'] = False # (N); Total blade aerodynamic load for blade 3 (force in x-direction); global coordinate system -AeroDyn['B3AeroFyg'] = False # (N); Total blade aerodynamic load for blade 3 (force in y-direction); global coordinate system -AeroDyn['B3AeroFzg'] = False # (N); Total blade aerodynamic load for blade 3 (force in z-direction); global coordinate system -AeroDyn['B3AeroMxg'] = False # (N-m); Total blade aerodynamic load for blade 3 (moment in x-direction); global coordinate system -AeroDyn['B3AeroMyg'] = False # (N-m); Total blade aerodynamic load for blade 3 (moment in y-direction); global coordinate system -AeroDyn['B3AeroMzg'] = False # (N-m); Total blade aerodynamic load for blade 3 (moment in z-direction); global coordinate system -AeroDyn['B4AeroFxg'] = False # (N); Total blade aerodynamic load for blade 4 (force in x-direction); global coordinate system -AeroDyn['B4AeroFyg'] = False # (N); Total blade aerodynamic load for blade 4 (force in y-direction); global coordinate system -AeroDyn['B4AeroFzg'] = False # (N); Total blade aerodynamic load for blade 4 (force in z-direction); global coordinate system -AeroDyn['B4AeroMxg'] = False # (N-m); Total blade aerodynamic load for blade 4 (moment in x-direction); global coordinate system -AeroDyn['B4AeroMyg'] = False # (N-m); Total blade aerodynamic load for blade 4 (moment in y-direction); global coordinate system -AeroDyn['B4AeroMzg'] = False # (N-m); Total blade aerodynamic load for blade 4 (moment in z-direction); global coordinate system +# Blade +AeroDyn['B1Azimuth'] = False # (deg); Azimuth angle of blade 1; +AeroDyn['B2Azimuth'] = False # (deg); Azimuth angle of blade 2; +AeroDyn['B3Azimuth'] = False # (deg); Azimuth angle of blade 3; +AeroDyn['B1Pitch'] = False # (deg); Pitch angle of blade 1; +AeroDyn['B2Pitch'] = False # (deg); Pitch angle of blade 2; +AeroDyn['B3Pitch'] = False # (deg); Pitch angle of blade 3; +AeroDyn['B1AeroFx'] = False # (N); Total blade aerodynamic/hydrodynamic load for blade 1 (force in x-direction); blade root coordinate system +AeroDyn['B1FldFx'] = False # (N); Total blade aerodynamic/hydrodynamic load for blade 1 (force in x-direction); blade root coordinate system +AeroDyn['B1AeroFy'] = False # (N); Total blade aerodynamic/hydrodynamic load for blade 1 (force in y-direction); blade root coordinate system +AeroDyn['B1FldFy'] = False # (N); Total blade aerodynamic/hydrodynamic load for blade 1 (force in y-direction); blade root coordinate system +AeroDyn['B1AeroFz'] = False # (N); Total blade aerodynamic/hydrodynamic load for blade 1 (force in z-direction); blade root coordinate system +AeroDyn['B1FldFz'] = False # (N); Total blade aerodynamic/hydrodynamic load for blade 1 (force in z-direction); blade root coordinate system +AeroDyn['B1AeroMx'] = False # (N-m); Total blade aerodynamic/hydrodynamic load for blade 1 (moment in x-direction); blade root coordinate system +AeroDyn['B1FldMx'] = False # (N-m); Total blade aerodynamic/hydrodynamic load for blade 1 (moment in x-direction); blade root coordinate system +AeroDyn['B1AeroMy'] = False # (N-m); Total blade aerodynamic/hydrodynamic load for blade 1 (moment in y-direction); blade root coordinate system +AeroDyn['B1FldMy'] = False # (N-m); Total blade aerodynamic/hydrodynamic load for blade 1 (moment in y-direction); blade root coordinate system +AeroDyn['B1AeroMz'] = False # (N-m); Total blade aerodynamic/hydrodynamic load for blade 1 (moment in z-direction); blade root coordinate system +AeroDyn['B1FldMz'] = False # (N-m); Total blade aerodynamic/hydrodynamic load for blade 1 (moment in z-direction); blade root coordinate system +AeroDyn['B1AeroPwr'] = False # (W); Total aerodynamic/hydrodynamic power from blade 1; +AeroDyn['B1FldPwr'] = False # (W); Total aerodynamic/hydrodynamic power from blade 1; +AeroDyn['B2AeroFx'] = False # (N); Total blade aerodynamic/hydrodynamic load for blade 2 (force in x-direction); blade root coordinate system +AeroDyn['B2FldFx'] = False # (N); Total blade aerodynamic/hydrodynamic load for blade 2 (force in x-direction); blade root coordinate system +AeroDyn['B2AeroFy'] = False # (N); Total blade aerodynamic/hydrodynamic load for blade 2 (force in y-direction); blade root coordinate system +AeroDyn['B2FldFy'] = False # (N); Total blade aerodynamic/hydrodynamic load for blade 2 (force in y-direction); blade root coordinate system +AeroDyn['B2AeroFz'] = False # (N); Total blade aerodynamic/hydrodynamic load for blade 2 (force in z-direction); blade root coordinate system +AeroDyn['B2FldFz'] = False # (N); Total blade aerodynamic/hydrodynamic load for blade 2 (force in z-direction); blade root coordinate system +AeroDyn['B2AeroMx'] = False # (N-m); Total blade aerodynamic/hydrodynamic load for blade 2 (moment in x-direction); blade root coordinate system +AeroDyn['B2FldMx'] = False # (N-m); Total blade aerodynamic/hydrodynamic load for blade 2 (moment in x-direction); blade root coordinate system +AeroDyn['B2AeroMy'] = False # (N-m); Total blade aerodynamic/hydrodynamic load for blade 2 (moment in y-direction); blade root coordinate system +AeroDyn['B2FldMy'] = False # (N-m); Total blade aerodynamic/hydrodynamic load for blade 2 (moment in y-direction); blade root coordinate system +AeroDyn['B2AeroMz'] = False # (N-m); Total blade aerodynamic/hydrodynamic load for blade 2 (moment in z-direction); blade root coordinate system +AeroDyn['B2FldMz'] = False # (N-m); Total blade aerodynamic/hydrodynamic load for blade 2 (moment in z-direction); blade root coordinate system +AeroDyn['B2AeroPwr'] = False # (W); Total aerodynamic/hydrodynamic power from blade 2; +AeroDyn['B2FldPwr'] = False # (W); Total aerodynamic/hydrodynamic power from blade 2; +AeroDyn['B3AeroFx'] = False # (N); Total blade aerodynamic/hydrodynamic load for blade 3 (force in x-direction); blade root coordinate system +AeroDyn['B3FldFx'] = False # (N); Total blade aerodynamic/hydrodynamic load for blade 3 (force in x-direction); blade root coordinate system +AeroDyn['B3AeroFy'] = False # (N); Total blade aerodynamic/hydrodynamic load for blade 3 (force in y-direction); blade root coordinate system +AeroDyn['B3FldFy'] = False # (N); Total blade aerodynamic/hydrodynamic load for blade 3 (force in y-direction); blade root coordinate system +AeroDyn['B3AeroFz'] = False # (N); Total blade aerodynamic/hydrodynamic load for blade 3 (force in z-direction); blade root coordinate system +AeroDyn['B3FldFz'] = False # (N); Total blade aerodynamic/hydrodynamic load for blade 3 (force in z-direction); blade root coordinate system +AeroDyn['B3AeroMx'] = False # (N-m); Total blade aerodynamic/hydrodynamic load for blade 3 (moment in x-direction); blade root coordinate system +AeroDyn['B3FldMx'] = False # (N-m); Total blade aerodynamic/hydrodynamic load for blade 3 (moment in x-direction); blade root coordinate system +AeroDyn['B3AeroMy'] = False # (N-m); Total blade aerodynamic/hydrodynamic load for blade 3 (moment in y-direction); blade root coordinate system +AeroDyn['B3FldMy'] = False # (N-m); Total blade aerodynamic/hydrodynamic load for blade 3 (moment in y-direction); blade root coordinate system +AeroDyn['B3AeroMz'] = False # (N-m); Total blade aerodynamic/hydrodynamic load for blade 3 (moment in z-direction); blade root coordinate system +AeroDyn['B3FldMz'] = False # (N-m); Total blade aerodynamic/hydrodynamic load for blade 3 (moment in z-direction); blade root coordinate system +AeroDyn['B3AeroPwr'] = False # (W); Total aerodynamic/hydrodynamic power from blade 3; +AeroDyn['B3FldPwr'] = False # (W); Total aerodynamic/hydrodynamic power from blade 3; +AeroDyn['B4AeroFx'] = False # (N); Total blade aerodynamic/hydrodynamic load for blade 4 (force in x-direction); blade root coordinate system +AeroDyn['B4FldFx'] = False # (N); Total blade aerodynamic/hydrodynamic load for blade 4 (force in x-direction); blade root coordinate system +AeroDyn['B4AeroFy'] = False # (N); Total blade aerodynamic/hydrodynamic load for blade 4 (force in y-direction); blade root coordinate system +AeroDyn['B4FldFy'] = False # (N); Total blade aerodynamic/hydrodynamic load for blade 4 (force in y-direction); blade root coordinate system +AeroDyn['B4AeroFz'] = False # (N); Total blade aerodynamic/hydrodynamic load for blade 4 (force in z-direction); blade root coordinate system +AeroDyn['B4FldFz'] = False # (N); Total blade aerodynamic/hydrodynamic load for blade 4 (force in z-direction); blade root coordinate system +AeroDyn['B4AeroMx'] = False # (N-m); Total blade aerodynamic/hydrodynamic load for blade 4 (moment in x-direction); blade root coordinate system +AeroDyn['B4FldMx'] = False # (N-m); Total blade aerodynamic/hydrodynamic load for blade 4 (moment in x-direction); blade root coordinate system +AeroDyn['B4AeroMy'] = False # (N-m); Total blade aerodynamic/hydrodynamic load for blade 4 (moment in y-direction); blade root coordinate system +AeroDyn['B4FldMy'] = False # (N-m); Total blade aerodynamic/hydrodynamic load for blade 4 (moment in y-direction); blade root coordinate system +AeroDyn['B4AeroMz'] = False # (N-m); Total blade aerodynamic/hydrodynamic load for blade 4 (moment in z-direction); blade root coordinate system +AeroDyn['B4FldMz'] = False # (N-m); Total blade aerodynamic/hydrodynamic load for blade 4 (moment in z-direction); blade root coordinate system +AeroDyn['B4AeroPwr'] = False # (W); Total aerodynamic/hydrodynamic power from blade 4; +AeroDyn['B4FldPwr'] = False # (W); Total aerodynamic/hydrodynamic power from blade 4; +AeroDyn['B1AeroFxi'] = False # (N); Total blade aerodynamic/hydrodynamic load for blade 1 (force in x-direction); global coordinate system +AeroDyn['B1FldFxi'] = False # (N); Total blade aerodynamic/hydrodynamic load for blade 1 (force in x-direction); global coordinate system +AeroDyn['B1AeroFyi'] = False # (N); Total blade aerodynamic/hydrodynamic load for blade 1 (force in y-direction); global coordinate system +AeroDyn['B1FldFyi'] = False # (N); Total blade aerodynamic/hydrodynamic load for blade 1 (force in y-direction); global coordinate system +AeroDyn['B1AeroFzi'] = False # (N); Total blade aerodynamic/hydrodynamic load for blade 1 (force in z-direction); global coordinate system +AeroDyn['B1FldFzi'] = False # (N); Total blade aerodynamic/hydrodynamic load for blade 1 (force in z-direction); global coordinate system +AeroDyn['B1AeroMxi'] = False # (N-m); Total blade aerodynamic/hydrodynamic load for blade 1 (moment in x-direction); global coordinate system +AeroDyn['B1FldMxi'] = False # (N-m); Total blade aerodynamic/hydrodynamic load for blade 1 (moment in x-direction); global coordinate system +AeroDyn['B1AeroMyi'] = False # (N-m); Total blade aerodynamic/hydrodynamic load for blade 1 (moment in y-direction); global coordinate system +AeroDyn['B1FldMyi'] = False # (N-m); Total blade aerodynamic/hydrodynamic load for blade 1 (moment in y-direction); global coordinate system +AeroDyn['B1AeroMzi'] = False # (N-m); Total blade aerodynamic/hydrodynamic load for blade 1 (moment in z-direction); global coordinate system +AeroDyn['B1FldMzi'] = False # (N-m); Total blade aerodynamic/hydrodynamic load for blade 1 (moment in z-direction); global coordinate system +AeroDyn['B2AeroFxi'] = False # (N); Total blade aerodynamic/hydrodynamic load for blade 2 (force in x-direction); global coordinate system +AeroDyn['B2FldFxi'] = False # (N); Total blade aerodynamic/hydrodynamic load for blade 2 (force in x-direction); global coordinate system +AeroDyn['B2AeroFyi'] = False # (N); Total blade aerodynamic/hydrodynamic load for blade 2 (force in y-direction); global coordinate system +AeroDyn['B2FldFyi'] = False # (N); Total blade aerodynamic/hydrodynamic load for blade 2 (force in y-direction); global coordinate system +AeroDyn['B2AeroFzi'] = False # (N); Total blade aerodynamic/hydrodynamic load for blade 2 (force in z-direction); global coordinate system +AeroDyn['B2FldFzi'] = False # (N); Total blade aerodynamic/hydrodynamic load for blade 2 (force in z-direction); global coordinate system +AeroDyn['B2AeroMxi'] = False # (N-m); Total blade aerodynamic/hydrodynamic load for blade 2 (moment in x-direction); global coordinate system +AeroDyn['B2FldMxi'] = False # (N-m); Total blade aerodynamic/hydrodynamic load for blade 2 (moment in x-direction); global coordinate system +AeroDyn['B2AeroMyi'] = False # (N-m); Total blade aerodynamic/hydrodynamic load for blade 2 (moment in y-direction); global coordinate system +AeroDyn['B2FldMyi'] = False # (N-m); Total blade aerodynamic/hydrodynamic load for blade 2 (moment in y-direction); global coordinate system +AeroDyn['B2AeroMzi'] = False # (N-m); Total blade aerodynamic/hydrodynamic load for blade 2 (moment in z-direction); global coordinate system +AeroDyn['B2FldMzi'] = False # (N-m); Total blade aerodynamic/hydrodynamic load for blade 2 (moment in z-direction); global coordinate system +AeroDyn['B3AeroFxi'] = False # (N); Total blade aerodynamic/hydrodynamic load for blade 3 (force in x-direction); global coordinate system +AeroDyn['B3FldFxi'] = False # (N); Total blade aerodynamic/hydrodynamic load for blade 3 (force in x-direction); global coordinate system +AeroDyn['B3AeroFyi'] = False # (N); Total blade aerodynamic/hydrodynamic load for blade 3 (force in y-direction); global coordinate system +AeroDyn['B3FldFyi'] = False # (N); Total blade aerodynamic/hydrodynamic load for blade 3 (force in y-direction); global coordinate system +AeroDyn['B3AeroFzi'] = False # (N); Total blade aerodynamic/hydrodynamic load for blade 3 (force in z-direction); global coordinate system +AeroDyn['B3FldFzi'] = False # (N); Total blade aerodynamic/hydrodynamic load for blade 3 (force in z-direction); global coordinate system +AeroDyn['B3AeroMxi'] = False # (N-m); Total blade aerodynamic/hydrodynamic load for blade 3 (moment in x-direction); global coordinate system +AeroDyn['B3FldMxi'] = False # (N-m); Total blade aerodynamic/hydrodynamic load for blade 3 (moment in x-direction); global coordinate system +AeroDyn['B3AeroMyi'] = False # (N-m); Total blade aerodynamic/hydrodynamic load for blade 3 (moment in y-direction); global coordinate system +AeroDyn['B3FldMyi'] = False # (N-m); Total blade aerodynamic/hydrodynamic load for blade 3 (moment in y-direction); global coordinate system +AeroDyn['B3AeroMzi'] = False # (N-m); Total blade aerodynamic/hydrodynamic load for blade 3 (moment in z-direction); global coordinate system +AeroDyn['B3FldMzi'] = False # (N-m); Total blade aerodynamic/hydrodynamic load for blade 3 (moment in z-direction); global coordinate system +AeroDyn['B4AeroFxi'] = False # (N); Total blade aerodynamic/hydrodynamic load for blade 4 (force in x-direction); global coordinate system +AeroDyn['B4FldFxi'] = False # (N); Total blade aerodynamic/hydrodynamic load for blade 4 (force in x-direction); global coordinate system +AeroDyn['B4AeroFyi'] = False # (N); Total blade aerodynamic/hydrodynamic load for blade 4 (force in y-direction); global coordinate system +AeroDyn['B4FldFyi'] = False # (N); Total blade aerodynamic/hydrodynamic load for blade 4 (force in y-direction); global coordinate system +AeroDyn['B4AeroFzi'] = False # (N); Total blade aerodynamic/hydrodynamic load for blade 4 (force in z-direction); global coordinate system +AeroDyn['B4FldFzi'] = False # (N); Total blade aerodynamic/hydrodynamic load for blade 4 (force in z-direction); global coordinate system +AeroDyn['B4AeroMxi'] = False # (N-m); Total blade aerodynamic/hydrodynamic load for blade 4 (moment in x-direction); global coordinate system +AeroDyn['B4FldMxi'] = False # (N-m); Total blade aerodynamic/hydrodynamic load for blade 4 (moment in x-direction); global coordinate system +AeroDyn['B4AeroMyi'] = False # (N-m); Total blade aerodynamic/hydrodynamic load for blade 4 (moment in y-direction); global coordinate system +AeroDyn['B4FldMyi'] = False # (N-m); Total blade aerodynamic/hydrodynamic load for blade 4 (moment in y-direction); global coordinate system +AeroDyn['B4AeroMzi'] = False # (N-m); Total blade aerodynamic/hydrodynamic load for blade 4 (moment in z-direction); global coordinate system +AeroDyn['B4FldMzi'] = False # (N-m); Total blade aerodynamic/hydrodynamic load for blade 4 (moment in z-direction); global coordinate system # Blade Nodal outputs AeroDyn['B1N1VUndx'] = False # (m/s); x-component of undisturbed wind velocity at Blade 1, Node 1; local blade coordinate system @@ -3216,25 +1361,1807 @@ AeroDyn['B3N7Gam'] = False # (m^2/s); Circulation on blade 3 at node 7; AeroDyn['B3N8Gam'] = False # (m^2/s); Circulation on blade 3 at node 8; AeroDyn['B3N9Gam'] = False # (m^2/s); Circulation on blade 3 at node 9; +AeroDyn['B1N1Fbn'] = False # (N/m); Buoyant force normal to chord per unit length at blade 1 node 1; +AeroDyn['B1N2Fbn'] = False # (N/m); Buoyant force normal to chord per unit length at blade 1 node 2; +AeroDyn['B1N3Fbn'] = False # (N/m); Buoyant force normal to chord per unit length at blade 1 node 3; +AeroDyn['B1N4Fbn'] = False # (N/m); Buoyant force normal to chord per unit length at blade 1 node 4; +AeroDyn['B1N5Fbn'] = False # (N/m); Buoyant force normal to chord per unit length at blade 1 node 5; +AeroDyn['B1N6Fbn'] = False # (N/m); Buoyant force normal to chord per unit length at blade 1 node 6; +AeroDyn['B1N7Fbn'] = False # (N/m); Buoyant force normal to chord per unit length at blade 1 node 7; +AeroDyn['B1N8Fbn'] = False # (N/m); Buoyant force normal to chord per unit length at blade 1 node 8; +AeroDyn['B1N9Fbn'] = False # (N/m); Buoyant force normal to chord per unit length at blade 1 node 9; +AeroDyn['B2N1Fbn'] = False # (N/m); Buoyant force normal to chord per unit length at blade 2 node 1; +AeroDyn['B2N2Fbn'] = False # (N/m); Buoyant force normal to chord per unit length at blade 2 node 2; +AeroDyn['B2N3Fbn'] = False # (N/m); Buoyant force normal to chord per unit length at blade 2 node 3; +AeroDyn['B2N4Fbn'] = False # (N/m); Buoyant force normal to chord per unit length at blade 2 node 4; +AeroDyn['B2N5Fbn'] = False # (N/m); Buoyant force normal to chord per unit length at blade 2 node 5; +AeroDyn['B2N6Fbn'] = False # (N/m); Buoyant force normal to chord per unit length at blade 2 node 6; +AeroDyn['B2N7Fbn'] = False # (N/m); Buoyant force normal to chord per unit length at blade 2 node 7; +AeroDyn['B2N8Fbn'] = False # (N/m); Buoyant force normal to chord per unit length at blade 2 node 8; +AeroDyn['B2N9Fbn'] = False # (N/m); Buoyant force normal to chord per unit length at blade 2 node 9; +AeroDyn['B3N1Fbn'] = False # (N/m); Buoyant force normal to chord per unit length at blade 3 node 1; +AeroDyn['B3N2Fbn'] = False # (N/m); Buoyant force normal to chord per unit length at blade 3 node 2; +AeroDyn['B3N3Fbn'] = False # (N/m); Buoyant force normal to chord per unit length at blade 3 node 3; +AeroDyn['B3N4Fbn'] = False # (N/m); Buoyant force normal to chord per unit length at blade 3 node 4; +AeroDyn['B3N5Fbn'] = False # (N/m); Buoyant force normal to chord per unit length at blade 3 node 5; +AeroDyn['B3N6Fbn'] = False # (N/m); Buoyant force normal to chord per unit length at blade 3 node 6; +AeroDyn['B3N7Fbn'] = False # (N/m); Buoyant force normal to chord per unit length at blade 3 node 7; +AeroDyn['B3N8Fbn'] = False # (N/m); Buoyant force normal to chord per unit length at blade 3 node 8; +AeroDyn['B3N9Fbn'] = False # (N/m); Buoyant force normal to chord per unit length at blade 3 node 9; +AeroDyn['B1N1Fbt'] = False # (N/m); Buoyant force tangential to chord per unit length at blade 1 node 1; +AeroDyn['B1N2Fbt'] = False # (N/m); Buoyant force tangential to chord per unit length at blade 1 node 2; +AeroDyn['B1N3Fbt'] = False # (N/m); Buoyant force tangential to chord per unit length at blade 1 node 3; +AeroDyn['B1N4Fbt'] = False # (N/m); Buoyant force tangential to chord per unit length at blade 1 node 4; +AeroDyn['B1N5Fbt'] = False # (N/m); Buoyant force tangential to chord per unit length at blade 1 node 5; +AeroDyn['B1N6Fbt'] = False # (N/m); Buoyant force tangential to chord per unit length at blade 1 node 6; +AeroDyn['B1N7Fbt'] = False # (N/m); Buoyant force tangential to chord per unit length at blade 1 node 7; +AeroDyn['B1N8Fbt'] = False # (N/m); Buoyant force tangential to chord per unit length at blade 1 node 8; +AeroDyn['B1N9Fbt'] = False # (N/m); Buoyant force tangential to chord per unit length at blade 1 node 9; +AeroDyn['B2N1Fbt'] = False # (N/m); Buoyant force tangential to chord per unit length at blade 2 node 1; +AeroDyn['B2N2Fbt'] = False # (N/m); Buoyant force tangential to chord per unit length at blade 2 node 2; +AeroDyn['B2N3Fbt'] = False # (N/m); Buoyant force tangential to chord per unit length at blade 2 node 3; +AeroDyn['B2N4Fbt'] = False # (N/m); Buoyant force tangential to chord per unit length at blade 2 node 4; +AeroDyn['B2N5Fbt'] = False # (N/m); Buoyant force tangential to chord per unit length at blade 2 node 5; +AeroDyn['B2N6Fbt'] = False # (N/m); Buoyant force tangential to chord per unit length at blade 2 node 6; +AeroDyn['B2N7Fbt'] = False # (N/m); Buoyant force tangential to chord per unit length at blade 2 node 7; +AeroDyn['B2N8Fbt'] = False # (N/m); Buoyant force tangential to chord per unit length at blade 2 node 8; +AeroDyn['B2N9Fbt'] = False # (N/m); Buoyant force tangential to chord per unit length at blade 2 node 9; +AeroDyn['B3N1Fbt'] = False # (N/m); Buoyant force tangential to chord per unit length at blade 3 node 1; +AeroDyn['B3N2Fbt'] = False # (N/m); Buoyant force tangential to chord per unit length at blade 3 node 2; +AeroDyn['B3N3Fbt'] = False # (N/m); Buoyant force tangential to chord per unit length at blade 3 node 3; +AeroDyn['B3N4Fbt'] = False # (N/m); Buoyant force tangential to chord per unit length at blade 3 node 4; +AeroDyn['B3N5Fbt'] = False # (N/m); Buoyant force tangential to chord per unit length at blade 3 node 5; +AeroDyn['B3N6Fbt'] = False # (N/m); Buoyant force tangential to chord per unit length at blade 3 node 6; +AeroDyn['B3N7Fbt'] = False # (N/m); Buoyant force tangential to chord per unit length at blade 3 node 7; +AeroDyn['B3N8Fbt'] = False # (N/m); Buoyant force tangential to chord per unit length at blade 3 node 8; +AeroDyn['B3N9Fbt'] = False # (N/m); Buoyant force tangential to chord per unit length at blade 3 node 9; +AeroDyn['B1N1Fbs'] = False # (N/m); Buoyant spanwise force per unit length at blade 1 node 1; +AeroDyn['B1N2Fbs'] = False # (N/m); Buoyant spanwise force per unit length at blade 1 node 2; +AeroDyn['B1N3Fbs'] = False # (N/m); Buoyant spanwise force per unit length at blade 1 node 3; +AeroDyn['B1N4Fbs'] = False # (N/m); Buoyant spanwise force per unit length at blade 1 node 4; +AeroDyn['B1N5Fbs'] = False # (N/m); Buoyant spanwise force per unit length at blade 1 node 5; +AeroDyn['B1N6Fbs'] = False # (N/m); Buoyant spanwise force per unit length at blade 1 node 6; +AeroDyn['B1N7Fbs'] = False # (N/m); Buoyant spanwise force per unit length at blade 1 node 7; +AeroDyn['B1N8Fbs'] = False # (N/m); Buoyant spanwise force per unit length at blade 1 node 8; +AeroDyn['B1N9Fbs'] = False # (N/m); Buoyant spanwise force per unit length at blade 1 node 9; +AeroDyn['B2N1Fbs'] = False # (N/m); Buoyant spanwise force per unit length at blade 2 node 1; +AeroDyn['B2N2Fbs'] = False # (N/m); Buoyant spanwise force per unit length at blade 2 node 2; +AeroDyn['B2N3Fbs'] = False # (N/m); Buoyant spanwise force per unit length at blade 2 node 3; +AeroDyn['B2N4Fbs'] = False # (N/m); Buoyant spanwise force per unit length at blade 2 node 4; +AeroDyn['B2N5Fbs'] = False # (N/m); Buoyant spanwise force per unit length at blade 2 node 5; +AeroDyn['B2N6Fbs'] = False # (N/m); Buoyant spanwise force per unit length at blade 2 node 6; +AeroDyn['B2N7Fbs'] = False # (N/m); Buoyant spanwise force per unit length at blade 2 node 7; +AeroDyn['B2N8Fbs'] = False # (N/m); Buoyant spanwise force per unit length at blade 2 node 8; +AeroDyn['B2N9Fbs'] = False # (N/m); Buoyant spanwise force per unit length at blade 2 node 9; +AeroDyn['B3N1Fbs'] = False # (N/m); Buoyant spanwise force per unit length at blade 3 node 1; +AeroDyn['B3N2Fbs'] = False # (N/m); Buoyant spanwise force per unit length at blade 3 node 2; +AeroDyn['B3N3Fbs'] = False # (N/m); Buoyant spanwise force per unit length at blade 3 node 3; +AeroDyn['B3N4Fbs'] = False # (N/m); Buoyant spanwise force per unit length at blade 3 node 4; +AeroDyn['B3N5Fbs'] = False # (N/m); Buoyant spanwise force per unit length at blade 3 node 5; +AeroDyn['B3N6Fbs'] = False # (N/m); Buoyant spanwise force per unit length at blade 3 node 6; +AeroDyn['B3N7Fbs'] = False # (N/m); Buoyant spanwise force per unit length at blade 3 node 7; +AeroDyn['B3N8Fbs'] = False # (N/m); Buoyant spanwise force per unit length at blade 3 node 8; +AeroDyn['B3N9Fbs'] = False # (N/m); Buoyant spanwise force per unit length at blade 3 node 9; +AeroDyn['B1N1Mbn'] = False # (N-m/m); Buoyant moment normal to chord per unit length at blade 1 node 1; +AeroDyn['B1N2Mbn'] = False # (N-m/m); Buoyant moment normal to chord per unit length at blade 1 node 2; +AeroDyn['B1N3Mbn'] = False # (N-m/m); Buoyant moment normal to chord per unit length at blade 1 node 3; +AeroDyn['B1N4Mbn'] = False # (N-m/m); Buoyant moment normal to chord per unit length at blade 1 node 4; +AeroDyn['B1N5Mbn'] = False # (N-m/m); Buoyant moment normal to chord per unit length at blade 1 node 5; +AeroDyn['B1N6Mbn'] = False # (N-m/m); Buoyant moment normal to chord per unit length at blade 1 node 6; +AeroDyn['B1N7Mbn'] = False # (N-m/m); Buoyant moment normal to chord per unit length at blade 1 node 7; +AeroDyn['B1N8Mbn'] = False # (N-m/m); Buoyant moment normal to chord per unit length at blade 1 node 8; +AeroDyn['B1N9Mbn'] = False # (N-m/m); Buoyant moment normal to chord per unit length at blade 1 node 9; +AeroDyn['B2N1Mbn'] = False # (N-m/m); Buoyant moment normal to chord per unit length at blade 2 node 1; +AeroDyn['B2N2Mbn'] = False # (N-m/m); Buoyant moment normal to chord per unit length at blade 2 node 2; +AeroDyn['B2N3Mbn'] = False # (N-m/m); Buoyant moment normal to chord per unit length at blade 2 node 3; +AeroDyn['B2N4Mbn'] = False # (N-m/m); Buoyant moment normal to chord per unit length at blade 2 node 4; +AeroDyn['B2N5Mbn'] = False # (N-m/m); Buoyant moment normal to chord per unit length at blade 2 node 5; +AeroDyn['B2N6Mbn'] = False # (N-m/m); Buoyant moment normal to chord per unit length at blade 2 node 6; +AeroDyn['B2N7Mbn'] = False # (N-m/m); Buoyant moment normal to chord per unit length at blade 2 node 7; +AeroDyn['B2N8Mbn'] = False # (N-m/m); Buoyant moment normal to chord per unit length at blade 2 node 8; +AeroDyn['B2N9Mbn'] = False # (N-m/m); Buoyant moment normal to chord per unit length at blade 2 node 9; +AeroDyn['B3N1Mbn'] = False # (N-m/m); Buoyant moment normal to chord per unit length at blade 3 node 1; +AeroDyn['B3N2Mbn'] = False # (N-m/m); Buoyant moment normal to chord per unit length at blade 3 node 2; +AeroDyn['B3N3Mbn'] = False # (N-m/m); Buoyant moment normal to chord per unit length at blade 3 node 3; +AeroDyn['B3N4Mbn'] = False # (N-m/m); Buoyant moment normal to chord per unit length at blade 3 node 4; +AeroDyn['B3N5Mbn'] = False # (N-m/m); Buoyant moment normal to chord per unit length at blade 3 node 5; +AeroDyn['B3N6Mbn'] = False # (N-m/m); Buoyant moment normal to chord per unit length at blade 3 node 6; +AeroDyn['B3N7Mbn'] = False # (N-m/m); Buoyant moment normal to chord per unit length at blade 3 node 7; +AeroDyn['B3N8Mbn'] = False # (N-m/m); Buoyant moment normal to chord per unit length at blade 3 node 8; +AeroDyn['B3N9Mbn'] = False # (N-m/m); Buoyant moment normal to chord per unit length at blade 3 node 9; +AeroDyn['B1N1Mbt'] = False # (N-m/m); Buoyant moment tangential to chord per unit length at blade 1 node 1; +AeroDyn['B1N2Mbt'] = False # (N-m/m); Buoyant moment tangential to chord per unit length at blade 1 node 2; +AeroDyn['B1N3Mbt'] = False # (N-m/m); Buoyant moment tangential to chord per unit length at blade 1 node 3; +AeroDyn['B1N4Mbt'] = False # (N-m/m); Buoyant moment tangential to chord per unit length at blade 1 node 4; +AeroDyn['B1N5Mbt'] = False # (N-m/m); Buoyant moment tangential to chord per unit length at blade 1 node 5; +AeroDyn['B1N6Mbt'] = False # (N-m/m); Buoyant moment tangential to chord per unit length at blade 1 node 6; +AeroDyn['B1N7Mbt'] = False # (N-m/m); Buoyant moment tangential to chord per unit length at blade 1 node 7; +AeroDyn['B1N8Mbt'] = False # (N-m/m); Buoyant moment tangential to chord per unit length at blade 1 node 8; +AeroDyn['B1N9Mbt'] = False # (N-m/m); Buoyant moment tangential to chord per unit length at blade 1 node 9; +AeroDyn['B2N1Mbt'] = False # (N-m/m); Buoyant moment tangential to chord per unit length at blade 2 node 1; +AeroDyn['B2N2Mbt'] = False # (N-m/m); Buoyant moment tangential to chord per unit length at blade 2 node 2; +AeroDyn['B2N3Mbt'] = False # (N-m/m); Buoyant moment tangential to chord per unit length at blade 2 node 3; +AeroDyn['B2N4Mbt'] = False # (N-m/m); Buoyant moment tangential to chord per unit length at blade 2 node 4; +AeroDyn['B2N5Mbt'] = False # (N-m/m); Buoyant moment tangential to chord per unit length at blade 2 node 5; +AeroDyn['B2N6Mbt'] = False # (N-m/m); Buoyant moment tangential to chord per unit length at blade 2 node 6; +AeroDyn['B2N7Mbt'] = False # (N-m/m); Buoyant moment tangential to chord per unit length at blade 2 node 7; +AeroDyn['B2N8Mbt'] = False # (N-m/m); Buoyant moment tangential to chord per unit length at blade 2 node 8; +AeroDyn['B2N9Mbt'] = False # (N-m/m); Buoyant moment tangential to chord per unit length at blade 2 node 9; +AeroDyn['B3N1Mbt'] = False # (N-m/m); Buoyant moment tangential to chord per unit length at blade 3 node 1; +AeroDyn['B3N2Mbt'] = False # (N-m/m); Buoyant moment tangential to chord per unit length at blade 3 node 2; +AeroDyn['B3N3Mbt'] = False # (N-m/m); Buoyant moment tangential to chord per unit length at blade 3 node 3; +AeroDyn['B3N4Mbt'] = False # (N-m/m); Buoyant moment tangential to chord per unit length at blade 3 node 4; +AeroDyn['B3N5Mbt'] = False # (N-m/m); Buoyant moment tangential to chord per unit length at blade 3 node 5; +AeroDyn['B3N6Mbt'] = False # (N-m/m); Buoyant moment tangential to chord per unit length at blade 3 node 6; +AeroDyn['B3N7Mbt'] = False # (N-m/m); Buoyant moment tangential to chord per unit length at blade 3 node 7; +AeroDyn['B3N8Mbt'] = False # (N-m/m); Buoyant moment tangential to chord per unit length at blade 3 node 8; +AeroDyn['B3N9Mbt'] = False # (N-m/m); Buoyant moment tangential to chord per unit length at blade 3 node 9; +AeroDyn['B1N1Mbs'] = False # (N-m/m); Buoyant spanwise moment per unit length at blade 1 node 1; +AeroDyn['B1N2Mbs'] = False # (N-m/m); Buoyant spanwise moment per unit length at blade 1 node 2; +AeroDyn['B1N3Mbs'] = False # (N-m/m); Buoyant spanwise moment per unit length at blade 1 node 3; +AeroDyn['B1N4Mbs'] = False # (N-m/m); Buoyant spanwise moment per unit length at blade 1 node 4; +AeroDyn['B1N5Mbs'] = False # (N-m/m); Buoyant spanwise moment per unit length at blade 1 node 5; +AeroDyn['B1N6Mbs'] = False # (N-m/m); Buoyant spanwise moment per unit length at blade 1 node 6; +AeroDyn['B1N7Mbs'] = False # (N-m/m); Buoyant spanwise moment per unit length at blade 1 node 7; +AeroDyn['B1N8Mbs'] = False # (N-m/m); Buoyant spanwise moment per unit length at blade 1 node 8; +AeroDyn['B1N9Mbs'] = False # (N-m/m); Buoyant spanwise moment per unit length at blade 1 node 9; +AeroDyn['B2N1Mbs'] = False # (N-m/m); Buoyant spanwise moment per unit length at blade 2 node 1; +AeroDyn['B2N2Mbs'] = False # (N-m/m); Buoyant spanwise moment per unit length at blade 2 node 2; +AeroDyn['B2N3Mbs'] = False # (N-m/m); Buoyant spanwise moment per unit length at blade 2 node 3; +AeroDyn['B2N4Mbs'] = False # (N-m/m); Buoyant spanwise moment per unit length at blade 2 node 4; +AeroDyn['B2N5Mbs'] = False # (N-m/m); Buoyant spanwise moment per unit length at blade 2 node 5; +AeroDyn['B2N6Mbs'] = False # (N-m/m); Buoyant spanwise moment per unit length at blade 2 node 6; +AeroDyn['B2N7Mbs'] = False # (N-m/m); Buoyant spanwise moment per unit length at blade 2 node 7; +AeroDyn['B2N8Mbs'] = False # (N-m/m); Buoyant spanwise moment per unit length at blade 2 node 8; +AeroDyn['B2N9Mbs'] = False # (N-m/m); Buoyant spanwise moment per unit length at blade 2 node 9; +AeroDyn['B3N1Mbs'] = False # (N-m/m); Buoyant spanwise moment per unit length at blade 3 node 1; +AeroDyn['B3N2Mbs'] = False # (N-m/m); Buoyant spanwise moment per unit length at blade 3 node 2; +AeroDyn['B3N3Mbs'] = False # (N-m/m); Buoyant spanwise moment per unit length at blade 3 node 3; +AeroDyn['B3N4Mbs'] = False # (N-m/m); Buoyant spanwise moment per unit length at blade 3 node 4; +AeroDyn['B3N5Mbs'] = False # (N-m/m); Buoyant spanwise moment per unit length at blade 3 node 5; +AeroDyn['B3N6Mbs'] = False # (N-m/m); Buoyant spanwise moment per unit length at blade 3 node 6; +AeroDyn['B3N7Mbs'] = False # (N-m/m); Buoyant spanwise moment per unit length at blade 3 node 7; +AeroDyn['B3N8Mbs'] = False # (N-m/m); Buoyant spanwise moment per unit length at blade 3 node 8; +AeroDyn['B3N9Mbs'] = False # (N-m/m); Buoyant spanwise moment per unit length at blade 3 node 9; + +# Rotor +AeroDyn['RtSpeed'] = False # (rpm); Rotor speed; +AeroDyn['RtTSR'] = False # (-); Rotor tip-speed ratio; +AeroDyn['RtVAvgxh'] = False # (m/s); Rotor-disk-averaged relative wind velocity (x-component); the hub coordinate system +AeroDyn['RtVAvgyh'] = False # (m/s); Rotor-disk-averaged relative wind velocity (y-component); the hub coordinate system +AeroDyn['RtVAvgzh'] = False # (m/s); Rotor-disk-averaged relative wind velocity (z-component); the hub coordinate system +AeroDyn['RtSkew'] = False # (deg); Rotor inflow-skew angle; +AeroDyn['RtAeroFxh'] = False # (N); Total rotor aerodynamic/hydrodynamic and buoyant load (force in x direction); the hub coordinate system +AeroDyn['RtFldFxh'] = False # (N); Total rotor aerodynamic/hydrodynamic and buoyant load (force in x direction); the hub coordinate system +AeroDyn['RtAeroFyh'] = False # (N); Total rotor aerodynamic/hydrodynamic and buoyant load (force in y direction); the hub coordinate system +AeroDyn['RtFldFyh'] = False # (N); Total rotor aerodynamic/hydrodynamic and buoyant load (force in y direction); the hub coordinate system +AeroDyn['RtAeroFzh'] = False # (N); Total rotor aerodynamic/hydrodynamic and buoyant load (force in z direction); the hub coordinate system +AeroDyn['RtFldFzh'] = False # (N); Total rotor aerodynamic/hydrodynamic and buoyant load (force in z direction); the hub coordinate system +AeroDyn['RtAeroMxh'] = False # (N-m); Total rotor aerodynamic/hydrodynamic and buoyant load (moment in x direction); the hub coordinate system +AeroDyn['RtFldMxh'] = False # (N-m); Total rotor aerodynamic/hydrodynamic and buoyant load (moment in x direction); the hub coordinate system +AeroDyn['RtAeroMyh'] = False # (N-m); Total rotor aerodynamic/hydrodynamic and buoyant load (moment in y direction); the hub coordinate system +AeroDyn['RtFldMyh'] = False # (N-m); Total rotor aerodynamic/hydrodynamic and buoyant load (moment in y direction); the hub coordinate system +AeroDyn['RtAeroMzh'] = False # (N-m); Total rotor aerodynamic/hydrodynamic and buoyant load (moment in z direction); the hub coordinate system +AeroDyn['RtFldMzh'] = False # (N-m); Total rotor aerodynamic/hydrodynamic and buoyant load (moment in z direction); the hub coordinate system +AeroDyn['RtAeroPwr'] = False # (W); Rotor aerodynamic/hydrodynamic power; +AeroDyn['RtFldPwr'] = False # (W); Rotor aerodynamic/hydrodynamic power; +AeroDyn['RtArea'] = False # (m^2); Rotor swept area; +AeroDyn['RtAeroCp'] = False # (-); Rotor aerodynamic/hydrodynamic power coefficient; +AeroDyn['RtFldCp'] = False # (-); Rotor aerodynamic/hydrodynamic power coefficient; +AeroDyn['RtAeroCq'] = False # (-); Rotor aerodynamic/hydrodynamic torque coefficient; +AeroDyn['RtFldCq'] = False # (-); Rotor aerodynamic/hydrodynamic torque coefficient; +AeroDyn['RtAeroCt'] = False # (-); Rotor aerodynamic/hydrodynamic thrust coefficient; +AeroDyn['RtFldCt'] = False # (-); Rotor aerodynamic/hydrodynamic thrust coefficient; +AeroDyn['DBEMTau1'] = False # (s); time-constant used in DBEMT; +AeroDyn['RtAeroFxi'] = False # (N); Total rotor aerodynamic/hydrodynamic and buoyant load (force in x direction); global coordinate system +AeroDyn['RtFldFxi'] = False # (N); Total rotor aerodynamic/hydrodynamic and buoyant load (force in x direction); global coordinate system +AeroDyn['RtFldFxg'] = False # (N); Total rotor aerodynamic/hydrodynamic and buoyant load (force in x direction); global coordinate system +AeroDyn['RtAeroFyi'] = False # (N); Total rotor aerodynamic/hydrodynamic and buoyant load (force in y direction); global coordinate system +AeroDyn['RtFldFyi'] = False # (N); Total rotor aerodynamic/hydrodynamic and buoyant load (force in y direction); global coordinate system +AeroDyn['RtFldFyg'] = False # (N); Total rotor aerodynamic/hydrodynamic and buoyant load (force in y direction); global coordinate system +AeroDyn['RtAeroFzi'] = False # (N); Total rotor aerodynamic/hydrodynamic and buoyant load (force in z direction); global coordinate system +AeroDyn['RtFldFzi'] = False # (N); Total rotor aerodynamic/hydrodynamic and buoyant load (force in z direction); global coordinate system +AeroDyn['RtFldFzg'] = False # (N); Total rotor aerodynamic/hydrodynamic and buoyant load (force in z direction); global coordinate system +AeroDyn['RtAeroMxi'] = False # (N-m); Total rotor aerodynamic/hydrodynamic and buoyant load (moment in x direction); global coordinate system +AeroDyn['RtFldMxi'] = False # (N-m); Total rotor aerodynamic/hydrodynamic and buoyant load (moment in x direction); global coordinate system +AeroDyn['RtFldMxg'] = False # (N-m); Total rotor aerodynamic/hydrodynamic and buoyant load (moment in x direction); global coordinate system +AeroDyn['RtAeroMyi'] = False # (N-m); Total rotor aerodynamic/hydrodynamic and buoyant load (moment in y direction); global coordinate system +AeroDyn['RtFldMyi'] = False # (N-m); Total rotor aerodynamic/hydrodynamic and buoyant load (moment in y direction); global coordinate system +AeroDyn['RtFldMyg'] = False # (N-m); Total rotor aerodynamic/hydrodynamic and buoyant load (moment in y direction); global coordinate system +AeroDyn['RtAeroMzi'] = False # (N-m); Total rotor aerodynamic/hydrodynamic and buoyant load (moment in z direction); global coordinate system +AeroDyn['RtFldMzi'] = False # (N-m); Total rotor aerodynamic/hydrodynamic and buoyant load (moment in z direction); global coordinate system +AeroDyn['RtFldMzg'] = False # (N-m); Total rotor aerodynamic/hydrodynamic and buoyant load (moment in z direction); global coordinate system + +# Hub +AeroDyn['HbFbx'] = False # (N); x-component of buoyant force at hub node; the hub coordinate system +AeroDyn['HbFby'] = False # (N); y-component of buoyant force at hub node; the hub coordinate system +AeroDyn['HbFbz'] = False # (N); z-component of buoyant force at hub node; the hub coordinate system +AeroDyn['HbMbx'] = False # (N-m); x-component of buoyant moment at hub node; the hub coordinate system +AeroDyn['HbMby'] = False # (N-m); y-component of buoyant moment at hub node; the hub coordinate system +AeroDyn['HbMbz'] = False # (N-m); z-component of buoyant moment at hub node; the hub coordinate system + +# Nacelle +AeroDyn['NcFbx'] = False # (N); x-component of buoyant force at nacelle node; the nacelle coordinate system +AeroDyn['NcFby'] = False # (N); y-component of buoyant force at nacelle node; the nacelle coordinate system +AeroDyn['NcFbz'] = False # (N); z-component of buoyant force at nacelle node; the nacelle coordinate system +AeroDyn['NcMbx'] = False # (N-m); x-component of buoyant moment at nacelle node; the nacelle coordinate system +AeroDyn['NcMby'] = False # (N-m); y-component of buoyant moment at nacelle node; the nacelle coordinate system +AeroDyn['NcMbz'] = False # (N-m); z-component of buoyant moment at nacelle node; the nacelle coordinate system + +# TailFin +AeroDyn['TFAlpha'] = False # (deg); Angle of attack of tailfin; tailfin coordinate system +AeroDyn['TFMach '] = False # (-); Mach number of tailfin flow; tailfin coordinate system +AeroDyn['TFRe '] = False # (-); Reynolds number of tailfin flow; tailfin coordinate system +AeroDyn['TFVrel '] = False # (m/s); Orthogonal relative velocity norm at the tailfin reference point; tailfin coordinate system +AeroDyn['TFVundxi'] = False # (m/s); Undisturbed wind velocity at the tailfin reference point in the inertial system (x-direction); global coordinate system +AeroDyn['TFVundyi'] = False # (m/s); Undisturbed wind velocity at the tailfin reference point in the inertial system (y-direction); global coordinate system +AeroDyn['TFVundzi'] = False # (m/s); Undisturbed wind velocity at the tailfin reference point in the inertial system (z-direction); global coordinate system +AeroDyn['TFVindxi'] = False # (m/s); Induced velocity at the tailfin reference point in the inertial system (x-direction); global coordinate system +AeroDyn['TFVindyi'] = False # (m/s); Induced velocity at the tailfin reference point in the inertial system (y-direction); global coordinate system +AeroDyn['TFVindzi'] = False # (m/s); Induced velocity at the tailfin reference point in the inertial system (z-direction); global coordinate system +AeroDyn['TFVrelxi'] = False # (m/s); Relative velocity at the tailfin reference point in the inertial system (x-direction); global coordinate system +AeroDyn['TFVrelyi'] = False # (m/s); Relative velocity at the tailfin reference point in the inertial system (y-direction); global coordinate system +AeroDyn['TFVrelzi'] = False # (m/s); Relative velocity at the tailfin reference point in the inertial system (z-direction); global coordinate system +AeroDyn['TFSTVxi'] = False # (m/s); Structural velocity at the tailfin reference point in the inertial system (x-direction); global coordinate system +AeroDyn['TFSTVyi'] = False # (m/s); Structural velocity at the tailfin reference point in the inertial system (y-direction); global coordinate system +AeroDyn['TFSTVzi'] = False # (m/s); Structural velocity at the tailfin reference point in the inertial system (z-direction); global coordinate system +AeroDyn['TFFxi'] = False # (N); Force at the tailfin reference point in the inertial system (x-direction); global coordinate system +AeroDyn['TFFyi'] = False # (N); Force at the tailfin reference point in the inertial system (y-direction); global coordinate system +AeroDyn['TFFzi'] = False # (N); Force at the tailfin reference point in the inertial system (z-direction); global coordinate system +AeroDyn['TFMxi'] = False # (N-m); Moment at the tailfin reference point in the inertial system (x-direction); global coordinate system +AeroDyn['TFMyi'] = False # (N-m); Moment at the tailfin reference point in the inertial system (y-direction); global coordinate system +AeroDyn['TFMzi'] = False # (N-m); Moment at the tailfin reference point in the inertial system (z-direction); global coordinate system + + +""" BeamDyn """ +BeamDyn = {} + +# Reaction Loads +BeamDyn['RootFxr'] = False # (N); x-component of the root reaction force expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system +BeamDyn['RootFyr'] = False # (N); y-component of the root reaction force expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system +BeamDyn['RootFzr'] = False # (N); z-component of the root reaction force expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system +BeamDyn['RootMxr'] = False # (N-m); x-component of the root reaction moment expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system +BeamDyn['RootMyr'] = False # (N-m); y-component of the root reaction moment expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system +BeamDyn['RootMzr'] = False # (N-m); z-component of the root reaction moment expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system + +# Tip Motions +BeamDyn['TipTDxr'] = False # (m); Tip translational deflection (relative to the undeflected position) expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system +BeamDyn['TipTDyr'] = False # (m); Tip translational deflection (relative to the undeflected position) expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system +BeamDyn['TipTDzr'] = False # (m); Tip translational deflection (relative to the undeflected position) expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system +BeamDyn['TipRDxr'] = False # (-); Tip angular/rotational deflection Wiener-Milenkovi parameter (relative to the undeflected orientation) expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system +BeamDyn['TipRDyr'] = False # (-); Tip angular/rotational deflection Wiener-Milenkovi parameter (relative to the undeflected orientation) expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system +BeamDyn['TipRDzr'] = False # (-); Tip angular/rotational deflection Wiener-Milenkovi parameter (relative to the undeflected orientation) expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system +BeamDyn['TipTVXg'] = False # (m/s); Tip translational velocities (absolute) expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system +BeamDyn['TipTVYg'] = False # (m/s); Tip translational velocities (absolute) expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system +BeamDyn['TipTVZg'] = False # (m/s); Tip translational velocities (absolute) expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system +BeamDyn['TipRVXg'] = False # (deg/s); Tip angular/rotational velocities (absolute) expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system +BeamDyn['TipRVYg'] = False # (deg/s); Tip angular/rotational velocities (absolute) expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system +BeamDyn['TipRVZg'] = False # (deg/s); Tip angular/rotational velocities (absolute) expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system +BeamDyn['TipTAXl'] = False # (m/s^2); Tip translational accelerations (absolute) expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['TipTAYl'] = False # (m/s^2); Tip translational accelerations (absolute) expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['TipTAZl'] = False # (m/s^2); Tip translational accelerations (absolute) expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['TipRAXl'] = False # (deg/s^2); Tip angular/rotational accelerations (absolute) expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['TipRAYl'] = False # (deg/s^2); Tip angular/rotational accelerations (absolute) expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['TipRAZl'] = False # (deg/s^2); Tip angular/rotational accelerations (absolute) expressed in l; l: a floating coordinate system local to the deflected beam + +# Sectional Loads +BeamDyn['N1Fxl'] = False # (N); Sectional force resultants at Node 1 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N1Fyl'] = False # (N); Sectional force resultants at Node 1 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N1Fzl'] = False # (N); Sectional force resultants at Node 1 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N2Fxl'] = False # (N); Sectional force resultants at Node 2 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N2Fyl'] = False # (N); Sectional force resultants at Node 2 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N2Fzl'] = False # (N); Sectional force resultants at Node 2 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N3Fxl'] = False # (N); Sectional force resultants at Node 3 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N3Fyl'] = False # (N); Sectional force resultants at Node 3 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N3Fzl'] = False # (N); Sectional force resultants at Node 3 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N4Fxl'] = False # (N); Sectional force resultants at Node 4 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N4Fyl'] = False # (N); Sectional force resultants at Node 4 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N4Fzl'] = False # (N); Sectional force resultants at Node 4 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N5Fxl'] = False # (N); Sectional force resultants at Node 5 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N5Fyl'] = False # (N); Sectional force resultants at Node 5 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N5Fzl'] = False # (N); Sectional force resultants at Node 5 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N6Fxl'] = False # (N); Sectional force resultants at Node 6 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N6Fyl'] = False # (N); Sectional force resultants at Node 6 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N6Fzl'] = False # (N); Sectional force resultants at Node 6 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N7Fxl'] = False # (N); Sectional force resultants at Node 7 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N7Fyl'] = False # (N); Sectional force resultants at Node 7 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N7Fzl'] = False # (N); Sectional force resultants at Node 7 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N8Fxl'] = False # (N); Sectional force resultants at Node 8 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N8Fyl'] = False # (N); Sectional force resultants at Node 8 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N8Fzl'] = False # (N); Sectional force resultants at Node 8 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N9Fxl'] = False # (N); Sectional force resultants at Node 9 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N9Fyl'] = False # (N); Sectional force resultants at Node 9 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N9Fzl'] = False # (N); Sectional force resultants at Node 9 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N1Mxl'] = False # (N-m); Sectional moment resultants at Node 1 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N1Myl'] = False # (N-m); Sectional moment resultants at Node 1 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N1Mzl'] = False # (N-m); Sectional moment resultants at Node 1 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N2Mxl'] = False # (N-m); Sectional moment resultants at Node 2 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N2Myl'] = False # (N-m); Sectional moment resultants at Node 2 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N2Mzl'] = False # (N-m); Sectional moment resultants at Node 2 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N3Mxl'] = False # (N-m); Sectional moment resultants at Node 3 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N3Myl'] = False # (N-m); Sectional moment resultants at Node 3 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N3Mzl'] = False # (N-m); Sectional moment resultants at Node 3 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N4Mxl'] = False # (N-m); Sectional moment resultants at Node 4 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N4Myl'] = False # (N-m); Sectional moment resultants at Node 4 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N4Mzl'] = False # (N-m); Sectional moment resultants at Node 4 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N5Mxl'] = False # (N-m); Sectional moment resultants at Node 5 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N5Myl'] = False # (N-m); Sectional moment resultants at Node 5 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N5Mzl'] = False # (N-m); Sectional moment resultants at Node 5 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N6Mxl'] = False # (N-m); Sectional moment resultants at Node 6 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N6Myl'] = False # (N-m); Sectional moment resultants at Node 6 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N6Mzl'] = False # (N-m); Sectional moment resultants at Node 6 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N7Mxl'] = False # (N-m); Sectional moment resultants at Node 7 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N7Myl'] = False # (N-m); Sectional moment resultants at Node 7 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N7Mzl'] = False # (N-m); Sectional moment resultants at Node 7 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N8Mxl'] = False # (N-m); Sectional moment resultants at Node 8 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N8Myl'] = False # (N-m); Sectional moment resultants at Node 8 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N8Mzl'] = False # (N-m); Sectional moment resultants at Node 8 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N9Mxl'] = False # (N-m); Sectional moment resultants at Node 9 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N9Myl'] = False # (N-m); Sectional moment resultants at Node 9 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N9Mzl'] = False # (N-m); Sectional moment resultants at Node 9 expressed in l; l: a floating coordinate system local to the deflected beam + +# Sectional Motions +BeamDyn['N1TDxr'] = False # (m); Sectional translational deflection (relative to the undeflected position) at Node 1 expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system +BeamDyn['N1TDyr'] = False # (m); Sectional translational deflection (relative to the undeflected position) at Node 1 expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system +BeamDyn['N1TDzr'] = False # (m); Sectional translational deflection (relative to the undeflected position) at Node 1 expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system +BeamDyn['N2TDxr'] = False # (m); Sectional translational deflection (relative to the undeflected position) at Node 2 expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system +BeamDyn['N2TDyr'] = False # (m); Sectional translational deflection (relative to the undeflected position) at Node 2 expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system +BeamDyn['N2TDzr'] = False # (m); Sectional translational deflection (relative to the undeflected position) at Node 2 expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system +BeamDyn['N3TDxr'] = False # (m); Sectional translational deflection (relative to the undeflected position) at Node 3 expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system +BeamDyn['N3TDyr'] = False # (m); Sectional translational deflection (relative to the undeflected position) at Node 3 expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system +BeamDyn['N3TDzr'] = False # (m); Sectional translational deflection (relative to the undeflected position) at Node 3 expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system +BeamDyn['N4TDxr'] = False # (m); Sectional translational deflection (relative to the undeflected position) at Node 4 expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system +BeamDyn['N4TDyr'] = False # (m); Sectional translational deflection (relative to the undeflected position) at Node 4 expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system +BeamDyn['N4TDzr'] = False # (m); Sectional translational deflection (relative to the undeflected position) at Node 4 expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system +BeamDyn['N5TDxr'] = False # (m); Sectional translational deflection (relative to the undeflected position) at Node 5 expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system +BeamDyn['N5TDyr'] = False # (m); Sectional translational deflection (relative to the undeflected position) at Node 5 expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system +BeamDyn['N5TDzr'] = False # (m); Sectional translational deflection (relative to the undeflected position) at Node 5 expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system +BeamDyn['N6TDxr'] = False # (m); Sectional translational deflection (relative to the undeflected position) at Node 6 expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system +BeamDyn['N6TDyr'] = False # (m); Sectional translational deflection (relative to the undeflected position) at Node 6 expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system +BeamDyn['N6TDzr'] = False # (m); Sectional translational deflection (relative to the undeflected position) at Node 6 expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system +BeamDyn['N7TDxr'] = False # (m); Sectional translational deflection (relative to the undeflected position) at Node 7 expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system +BeamDyn['N7TDyr'] = False # (m); Sectional translational deflection (relative to the undeflected position) at Node 7 expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system +BeamDyn['N7TDzr'] = False # (m); Sectional translational deflection (relative to the undeflected position) at Node 7 expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system +BeamDyn['N8TDxr'] = False # (m); Sectional translational deflection (relative to the undeflected position) at Node 8 expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system +BeamDyn['N8TDyr'] = False # (m); Sectional translational deflection (relative to the undeflected position) at Node 8 expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system +BeamDyn['N8TDzr'] = False # (m); Sectional translational deflection (relative to the undeflected position) at Node 8 expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system +BeamDyn['N9TDxr'] = False # (m); Sectional translational deflection (relative to the undeflected position) at Node 9 expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system +BeamDyn['N9TDyr'] = False # (m); Sectional translational deflection (relative to the undeflected position) at Node 9 expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system +BeamDyn['N9TDzr'] = False # (m); Sectional translational deflection (relative to the undeflected position) at Node 9 expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system +BeamDyn['N1RDxr'] = False # (-); Sectional angular/rotational deflection Wiener-Milenkovic parameter (relative to the undeflected orientation) at Node 1 expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system +BeamDyn['N1RDyr'] = False # (-); Sectional angular/rotational deflection Wiener-Milenkovic parameter (relative to the undeflected orientation) at Node 1 expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system +BeamDyn['N1RDzr'] = False # (-); Sectional angular/rotational deflection Wiener-Milenkovic parameter (relative to the undeflected orientation) at Node 1 expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system +BeamDyn['N2RDxr'] = False # (-); Sectional angular/rotational deflection Wiener-Milenkovic parameter (relative to the undeflected orientation) at Node 2 expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system +BeamDyn['N2RDyr'] = False # (-); Sectional angular/rotational deflection Wiener-Milenkovic parameter (relative to the undeflected orientation) at Node 2 expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system +BeamDyn['N2RDzr'] = False # (-); Sectional angular/rotational deflection Wiener-Milenkovic parameter (relative to the undeflected orientation) at Node 2 expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system +BeamDyn['N3RDxr'] = False # (-); Sectional angular/rotational deflection Wiener-Milenkovic parameter (relative to the undeflected orientation) at Node 3 expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system +BeamDyn['N3RDyr'] = False # (-); Sectional angular/rotational deflection Wiener-Milenkovic parameter (relative to the undeflected orientation) at Node 3 expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system +BeamDyn['N3RDzr'] = False # (-); Sectional angular/rotational deflection Wiener-Milenkovic parameter (relative to the undeflected orientation) at Node 3 expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system +BeamDyn['N4RDxr'] = False # (-); Sectional angular/rotational deflection Wiener-Milenkovic parameter (relative to the undeflected orientation) at Node 4 expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system +BeamDyn['N4RDyr'] = False # (-); Sectional angular/rotational deflection Wiener-Milenkovic parameter (relative to the undeflected orientation) at Node 4 expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system +BeamDyn['N4RDzr'] = False # (-); Sectional angular/rotational deflection Wiener-Milenkovic parameter (relative to the undeflected orientation) at Node 4 expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system +BeamDyn['N5RDxr'] = False # (-); Sectional angular/rotational deflection Wiener-Milenkovic parameter (relative to the undeflected orientation) at Node 5 expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system +BeamDyn['N5RDyr'] = False # (-); Sectional angular/rotational deflection Wiener-Milenkovic parameter (relative to the undeflected orientation) at Node 5 expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system +BeamDyn['N5RDzr'] = False # (-); Sectional angular/rotational deflection Wiener-Milenkovic parameter (relative to the undeflected orientation) at Node 5 expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system +BeamDyn['N6RDxr'] = False # (-); Sectional angular/rotational deflection Wiener-Milenkovic parameter (relative to the undeflected orientation) at Node 6 expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system +BeamDyn['N6RDyr'] = False # (-); Sectional angular/rotational deflection Wiener-Milenkovic parameter (relative to the undeflected orientation) at Node 6 expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system +BeamDyn['N6RDzr'] = False # (-); Sectional angular/rotational deflection Wiener-Milenkovic parameter (relative to the undeflected orientation) at Node 6 expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system +BeamDyn['N7RDxr'] = False # (-); Sectional angular/rotational deflection Wiener-Milenkovic parameter (relative to the undeflected orientation) at Node 7 expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system +BeamDyn['N7RDyr'] = False # (-); Sectional angular/rotational deflection Wiener-Milenkovic parameter (relative to the undeflected orientation) at Node 7 expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system +BeamDyn['N7RDzr'] = False # (-); Sectional angular/rotational deflection Wiener-Milenkovic parameter (relative to the undeflected orientation) at Node 7 expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system +BeamDyn['N8RDxr'] = False # (-); Sectional angular/rotational deflection Wiener-Milenkovic parameter (relative to the undeflected orientation) at Node 8 expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system +BeamDyn['N8RDyr'] = False # (-); Sectional angular/rotational deflection Wiener-Milenkovic parameter (relative to the undeflected orientation) at Node 8 expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system +BeamDyn['N8RDzr'] = False # (-); Sectional angular/rotational deflection Wiener-Milenkovic parameter (relative to the undeflected orientation) at Node 8 expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system +BeamDyn['N9RDxr'] = False # (-); Sectional angular/rotational deflection Wiener-Milenkovic parameter (relative to the undeflected orientation) at Node 9 expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system +BeamDyn['N9RDyr'] = False # (-); Sectional angular/rotational deflection Wiener-Milenkovic parameter (relative to the undeflected orientation) at Node 9 expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system +BeamDyn['N9RDzr'] = False # (-); Sectional angular/rotational deflection Wiener-Milenkovic parameter (relative to the undeflected orientation) at Node 9 expressed in r; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system +BeamDyn['N1TVXg'] = False # (m/s); Sectional translational velocities (absolute) at Node 1 expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system +BeamDyn['N1TVYg'] = False # (m/s); Sectional translational velocities (absolute) at Node 1 expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system +BeamDyn['N1TVZg'] = False # (m/s); Sectional translational velocities (absolute) at Node 1 expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system +BeamDyn['N2TVXg'] = False # (m/s); Sectional translational velocities (absolute) at Node 2 expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system +BeamDyn['N2TVYg'] = False # (m/s); Sectional translational velocities (absolute) at Node 2 expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system +BeamDyn['N2TVZg'] = False # (m/s); Sectional translational velocities (absolute) at Node 2 expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system +BeamDyn['N3TVXg'] = False # (m/s); Sectional translational velocities (absolute) at Node 3 expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system +BeamDyn['N3TVYg'] = False # (m/s); Sectional translational velocities (absolute) at Node 3 expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system +BeamDyn['N3TVZg'] = False # (m/s); Sectional translational velocities (absolute) at Node 3 expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system +BeamDyn['N4TVXg'] = False # (m/s); Sectional translational velocities (absolute) at Node 4 expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system +BeamDyn['N4TVYg'] = False # (m/s); Sectional translational velocities (absolute) at Node 4 expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system +BeamDyn['N4TVZg'] = False # (m/s); Sectional translational velocities (absolute) at Node 4 expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system +BeamDyn['N5TVXg'] = False # (m/s); Sectional translational velocities (absolute) at Node 5 expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system +BeamDyn['N5TVYg'] = False # (m/s); Sectional translational velocities (absolute) at Node 5 expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system +BeamDyn['N5TVZg'] = False # (m/s); Sectional translational velocities (absolute) at Node 5 expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system +BeamDyn['N6TVXg'] = False # (m/s); Sectional translational velocities (absolute) at Node 6 expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system +BeamDyn['N6TVYg'] = False # (m/s); Sectional translational velocities (absolute) at Node 6 expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system +BeamDyn['N6TVZg'] = False # (m/s); Sectional translational velocities (absolute) at Node 6 expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system +BeamDyn['N7TVXg'] = False # (m/s); Sectional translational velocities (absolute) at Node 7 expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system +BeamDyn['N7TVYg'] = False # (m/s); Sectional translational velocities (absolute) at Node 7 expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system +BeamDyn['N7TVZg'] = False # (m/s); Sectional translational velocities (absolute) at Node 7 expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system +BeamDyn['N8TVXg'] = False # (m/s); Sectional translational velocities (absolute) at Node 8 expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system +BeamDyn['N8TVYg'] = False # (m/s); Sectional translational velocities (absolute) at Node 8 expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system +BeamDyn['N8TVZg'] = False # (m/s); Sectional translational velocities (absolute) at Node 8 expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system +BeamDyn['N9TVXg'] = False # (m/s); Sectional translational velocities (absolute) at Node 9 expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system +BeamDyn['N9TVYg'] = False # (m/s); Sectional translational velocities (absolute) at Node 9 expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system +BeamDyn['N9TVZg'] = False # (m/s); Sectional translational velocities (absolute) at Node 9 expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system +BeamDyn['N1RVXg'] = False # (deg/s); Sectional angular/rotational velocities (absolute) at Node 1 expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system +BeamDyn['N1RVYg'] = False # (deg/s); Sectional angular/rotational velocities (absolute) at Node 1 expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system +BeamDyn['N1RVZg'] = False # (deg/s); Sectional angular/rotational velocities (absolute) at Node 1 expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system +BeamDyn['N2RVXg'] = False # (deg/s); Sectional angular/rotational velocities (absolute) at Node 2 expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system +BeamDyn['N2RVYg'] = False # (deg/s); Sectional angular/rotational velocities (absolute) at Node 2 expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system +BeamDyn['N2RVZg'] = False # (deg/s); Sectional angular/rotational velocities (absolute) at Node 2 expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system +BeamDyn['N3RVXg'] = False # (deg/s); Sectional angular/rotational velocities (absolute) at Node 3 expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system +BeamDyn['N3RVYg'] = False # (deg/s); Sectional angular/rotational velocities (absolute) at Node 3 expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system +BeamDyn['N3RVZg'] = False # (deg/s); Sectional angular/rotational velocities (absolute) at Node 3 expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system +BeamDyn['N4RVXg'] = False # (deg/s); Sectional angular/rotational velocities (absolute) at Node 4 expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system +BeamDyn['N4RVYg'] = False # (deg/s); Sectional angular/rotational velocities (absolute) at Node 4 expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system +BeamDyn['N4RVZg'] = False # (deg/s); Sectional angular/rotational velocities (absolute) at Node 4 expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system +BeamDyn['N5RVXg'] = False # (deg/s); Sectional angular/rotational velocities (absolute) at Node 5 expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system +BeamDyn['N5RVYg'] = False # (deg/s); Sectional angular/rotational velocities (absolute) at Node 5 expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system +BeamDyn['N5RVZg'] = False # (deg/s); Sectional angular/rotational velocities (absolute) at Node 5 expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system +BeamDyn['N6RVXg'] = False # (deg/s); Sectional angular/rotational velocities (absolute) at Node 6 expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system +BeamDyn['N6RVYg'] = False # (deg/s); Sectional angular/rotational velocities (absolute) at Node 6 expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system +BeamDyn['N6RVZg'] = False # (deg/s); Sectional angular/rotational velocities (absolute) at Node 6 expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system +BeamDyn['N7RVXg'] = False # (deg/s); Sectional angular/rotational velocities (absolute) at Node 7 expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system +BeamDyn['N7RVYg'] = False # (deg/s); Sectional angular/rotational velocities (absolute) at Node 7 expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system +BeamDyn['N7RVZg'] = False # (deg/s); Sectional angular/rotational velocities (absolute) at Node 7 expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system +BeamDyn['N8RVXg'] = False # (deg/s); Sectional angular/rotational velocities (absolute) at Node 8 expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system +BeamDyn['N8RVYg'] = False # (deg/s); Sectional angular/rotational velocities (absolute) at Node 8 expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system +BeamDyn['N8RVZg'] = False # (deg/s); Sectional angular/rotational velocities (absolute) at Node 8 expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system +BeamDyn['N9RVXg'] = False # (deg/s); Sectional angular/rotational velocities (absolute) at Node 9 expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system +BeamDyn['N9RVYg'] = False # (deg/s); Sectional angular/rotational velocities (absolute) at Node 9 expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system +BeamDyn['N9RVZg'] = False # (deg/s); Sectional angular/rotational velocities (absolute) at Node 9 expressed in g; g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST s global inertial frame (i) coordinate system +BeamDyn['N1TAXl'] = False # (m/s^2); Sectional translational accelerations (absolute) at Node 1 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N1TAYl'] = False # (m/s^2); Sectional translational accelerations (absolute) at Node 1 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N1TAZl'] = False # (m/s^2); Sectional translational accelerations (absolute) at Node 1 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N2TAXl'] = False # (m/s^2); Sectional translational accelerations (absolute) at Node 2 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N2TAYl'] = False # (m/s^2); Sectional translational accelerations (absolute) at Node 2 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N2TAZl'] = False # (m/s^2); Sectional translational accelerations (absolute) at Node 2 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N3TAXl'] = False # (m/s^2); Sectional translational accelerations (absolute) at Node 3 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N3TAYl'] = False # (m/s^2); Sectional translational accelerations (absolute) at Node 3 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N3TAZl'] = False # (m/s^2); Sectional translational accelerations (absolute) at Node 3 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N4TAXl'] = False # (m/s^2); Sectional translational accelerations (absolute) at Node 4 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N4TAYl'] = False # (m/s^2); Sectional translational accelerations (absolute) at Node 4 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N4TAZl'] = False # (m/s^2); Sectional translational accelerations (absolute) at Node 4 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N5TAXl'] = False # (m/s^2); Sectional translational accelerations (absolute) at Node 5 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N5TAYl'] = False # (m/s^2); Sectional translational accelerations (absolute) at Node 5 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N5TAZl'] = False # (m/s^2); Sectional translational accelerations (absolute) at Node 5 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N6TAXl'] = False # (m/s^2); Sectional translational accelerations (absolute) at Node 6 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N6TAYl'] = False # (m/s^2); Sectional translational accelerations (absolute) at Node 6 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N6TAZl'] = False # (m/s^2); Sectional translational accelerations (absolute) at Node 6 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N7TAXl'] = False # (m/s^2); Sectional translational accelerations (absolute) at Node 7 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N7TAYl'] = False # (m/s^2); Sectional translational accelerations (absolute) at Node 7 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N7TAZl'] = False # (m/s^2); Sectional translational accelerations (absolute) at Node 7 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N8TAXl'] = False # (m/s^2); Sectional translational accelerations (absolute) at Node 8 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N8TAYl'] = False # (m/s^2); Sectional translational accelerations (absolute) at Node 8 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N8TAZl'] = False # (m/s^2); Sectional translational accelerations (absolute) at Node 8 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N9TAXl'] = False # (m/s^2); Sectional translational accelerations (absolute) at Node 9 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N9TAYl'] = False # (m/s^2); Sectional translational accelerations (absolute) at Node 9 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N9TAZl'] = False # (m/s^2); Sectional translational accelerations (absolute) at Node 9 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N1RAXl'] = False # (deg/s^2); Sectional angular/rotational accelerations (absolute) at Node 1 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N1RAYl'] = False # (deg/s^2); Sectional angular/rotational accelerations (absolute) at Node 1 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N1RAZl'] = False # (deg/s^2); Sectional angular/rotational accelerations (absolute) at Node 1 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N2RAXl'] = False # (deg/s^2); Sectional angular/rotational accelerations (absolute) at Node 2 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N2RAYl'] = False # (deg/s^2); Sectional angular/rotational accelerations (absolute) at Node 2 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N2RAZl'] = False # (deg/s^2); Sectional angular/rotational accelerations (absolute) at Node 2 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N3RAXl'] = False # (deg/s^2); Sectional angular/rotational accelerations (absolute) at Node 3 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N3RAYl'] = False # (deg/s^2); Sectional angular/rotational accelerations (absolute) at Node 3 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N3RAZl'] = False # (deg/s^2); Sectional angular/rotational accelerations (absolute) at Node 3 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N4RAXl'] = False # (deg/s^2); Sectional angular/rotational accelerations (absolute) at Node 4 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N4RAYl'] = False # (deg/s^2); Sectional angular/rotational accelerations (absolute) at Node 4 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N4RAZl'] = False # (deg/s^2); Sectional angular/rotational accelerations (absolute) at Node 4 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N5RAXl'] = False # (deg/s^2); Sectional angular/rotational accelerations (absolute) at Node 5 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N5RAYl'] = False # (deg/s^2); Sectional angular/rotational accelerations (absolute) at Node 5 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N5RAZl'] = False # (deg/s^2); Sectional angular/rotational accelerations (absolute) at Node 5 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N6RAXl'] = False # (deg/s^2); Sectional angular/rotational accelerations (absolute) at Node 6 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N6RAYl'] = False # (deg/s^2); Sectional angular/rotational accelerations (absolute) at Node 6 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N6RAZl'] = False # (deg/s^2); Sectional angular/rotational accelerations (absolute) at Node 6 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N7RAXl'] = False # (deg/s^2); Sectional angular/rotational accelerations (absolute) at Node 7 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N7RAYl'] = False # (deg/s^2); Sectional angular/rotational accelerations (absolute) at Node 7 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N7RAZl'] = False # (deg/s^2); Sectional angular/rotational accelerations (absolute) at Node 7 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N8RAXl'] = False # (deg/s^2); Sectional angular/rotational accelerations (absolute) at Node 8 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N8RAYl'] = False # (deg/s^2); Sectional angular/rotational accelerations (absolute) at Node 8 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N8RAZl'] = False # (deg/s^2); Sectional angular/rotational accelerations (absolute) at Node 8 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N9RAXl'] = False # (deg/s^2); Sectional angular/rotational accelerations (absolute) at Node 9 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N9RAYl'] = False # (deg/s^2); Sectional angular/rotational accelerations (absolute) at Node 9 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N9RAZl'] = False # (deg/s^2); Sectional angular/rotational accelerations (absolute) at Node 9 expressed in l; l: a floating coordinate system local to the deflected beam + +# Applied Loads +BeamDyn['N1PFxl'] = False # (N); Applied point forces at Node 1 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N1PFyl'] = False # (N); Applied point forces at Node 1 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N1PFzl'] = False # (N); Applied point forces at Node 1 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N2PFxl'] = False # (N); Applied point forces at Node 2 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N2PFyl'] = False # (N); Applied point forces at Node 2 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N2PFzl'] = False # (N); Applied point forces at Node 2 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N3PFxl'] = False # (N); Applied point forces at Node 3 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N3PFyl'] = False # (N); Applied point forces at Node 3 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N3PFzl'] = False # (N); Applied point forces at Node 3 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N4PFxl'] = False # (N); Applied point forces at Node 4 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N4PFyl'] = False # (N); Applied point forces at Node 4 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N4PFzl'] = False # (N); Applied point forces at Node 4 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N5PFxl'] = False # (N); Applied point forces at Node 5 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N5PFyl'] = False # (N); Applied point forces at Node 5 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N5PFzl'] = False # (N); Applied point forces at Node 5 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N6PFxl'] = False # (N); Applied point forces at Node 6 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N6PFyl'] = False # (N); Applied point forces at Node 6 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N6PFzl'] = False # (N); Applied point forces at Node 6 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N7PFxl'] = False # (N); Applied point forces at Node 7 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N7PFyl'] = False # (N); Applied point forces at Node 7 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N7PFzl'] = False # (N); Applied point forces at Node 7 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N8PFxl'] = False # (N); Applied point forces at Node 8 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N8PFyl'] = False # (N); Applied point forces at Node 8 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N8PFzl'] = False # (N); Applied point forces at Node 8 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N9PFxl'] = False # (N); Applied point forces at Node 9 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N9PFyl'] = False # (N); Applied point forces at Node 9 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N9PFzl'] = False # (N); Applied point forces at Node 9 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N1PMxl'] = False # (N-m); Applied point moments at Node 1 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N1PMyl'] = False # (N-m); Applied point moments at Node 1 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N1PMzl'] = False # (N-m); Applied point moments at Node 1 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N2PMxl'] = False # (N-m); Applied point moments at Node 2 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N2PMyl'] = False # (N-m); Applied point moments at Node 2 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N2PMzl'] = False # (N-m); Applied point moments at Node 2 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N3PMxl'] = False # (N-m); Applied point moments at Node 3 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N3PMyl'] = False # (N-m); Applied point moments at Node 3 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N3PMzl'] = False # (N-m); Applied point moments at Node 3 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N4PMxl'] = False # (N-m); Applied point moments at Node 4 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N4PMyl'] = False # (N-m); Applied point moments at Node 4 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N4PMzl'] = False # (N-m); Applied point moments at Node 4 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N5PMxl'] = False # (N-m); Applied point moments at Node 5 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N5PMyl'] = False # (N-m); Applied point moments at Node 5 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N5PMzl'] = False # (N-m); Applied point moments at Node 5 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N6PMxl'] = False # (N-m); Applied point moments at Node 6 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N6PMyl'] = False # (N-m); Applied point moments at Node 6 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N6PMzl'] = False # (N-m); Applied point moments at Node 6 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N7PMxl'] = False # (N-m); Applied point moments at Node 7 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N7PMyl'] = False # (N-m); Applied point moments at Node 7 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N7PMzl'] = False # (N-m); Applied point moments at Node 7 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N8PMxl'] = False # (N-m); Applied point moments at Node 8 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N8PMyl'] = False # (N-m); Applied point moments at Node 8 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N8PMzl'] = False # (N-m); Applied point moments at Node 8 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N9PMxl'] = False # (N-m); Applied point moments at Node 9 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N9PMyl'] = False # (N-m); Applied point moments at Node 9 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N9PMzl'] = False # (N-m); Applied point moments at Node 9 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N1DFxl'] = False # (N/m); Applied distributed forces at Node 1 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N1DFyl'] = False # (N/m); Applied distributed forces at Node 1 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N1DFzl'] = False # (N/m); Applied distributed forces at Node 1 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N2DFxl'] = False # (N/m); Applied distributed forces at Node 2 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N2DFyl'] = False # (N/m); Applied distributed forces at Node 2 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N2DFzl'] = False # (N/m); Applied distributed forces at Node 2 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N3DFxl'] = False # (N/m); Applied distributed forces at Node 3 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N3DFyl'] = False # (N/m); Applied distributed forces at Node 3 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N3DFzl'] = False # (N/m); Applied distributed forces at Node 3 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N4DFxl'] = False # (N/m); Applied distributed forces at Node 4 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N4DFyl'] = False # (N/m); Applied distributed forces at Node 4 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N4DFzl'] = False # (N/m); Applied distributed forces at Node 4 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N5DFxl'] = False # (N/m); Applied distributed forces at Node 5 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N5DFyl'] = False # (N/m); Applied distributed forces at Node 5 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N5DFzl'] = False # (N/m); Applied distributed forces at Node 5 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N6DFxl'] = False # (N/m); Applied distributed forces at Node 6 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N6DFyl'] = False # (N/m); Applied distributed forces at Node 6 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N6DFzl'] = False # (N/m); Applied distributed forces at Node 6 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N7DFxl'] = False # (N/m); Applied distributed forces at Node 7 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N7DFyl'] = False # (N/m); Applied distributed forces at Node 7 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N7DFzl'] = False # (N/m); Applied distributed forces at Node 7 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N8DFxl'] = False # (N/m); Applied distributed forces at Node 8 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N8DFyl'] = False # (N/m); Applied distributed forces at Node 8 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N8DFzl'] = False # (N/m); Applied distributed forces at Node 8 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N9DFxl'] = False # (N/m); Applied distributed forces at Node 9 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N9DFyl'] = False # (N/m); Applied distributed forces at Node 9 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N9DFzl'] = False # (N/m); Applied distributed forces at Node 9 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N1DMxl'] = False # (N-m/m); Applied distributed moments at Node 1 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N1DMyl'] = False # (N-m/m); Applied distributed moments at Node 1 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N1DMzl'] = False # (N-m/m); Applied distributed moments at Node 1 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N2DMxl'] = False # (N-m/m); Applied distributed moments at Node 2 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N2DMyl'] = False # (N-m/m); Applied distributed moments at Node 2 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N2DMzl'] = False # (N-m/m); Applied distributed moments at Node 2 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N3DMxl'] = False # (N-m/m); Applied distributed moments at Node 3 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N3DMyl'] = False # (N-m/m); Applied distributed moments at Node 3 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N3DMzl'] = False # (N-m/m); Applied distributed moments at Node 3 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N4DMxl'] = False # (N-m/m); Applied distributed moments at Node 4 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N4DMyl'] = False # (N-m/m); Applied distributed moments at Node 4 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N4DMzl'] = False # (N-m/m); Applied distributed moments at Node 4 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N5DMxl'] = False # (N-m/m); Applied distributed moments at Node 5 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N5DMyl'] = False # (N-m/m); Applied distributed moments at Node 5 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N5DMzl'] = False # (N-m/m); Applied distributed moments at Node 5 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N6DMxl'] = False # (N-m/m); Applied distributed moments at Node 6 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N6DMyl'] = False # (N-m/m); Applied distributed moments at Node 6 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N6DMzl'] = False # (N-m/m); Applied distributed moments at Node 6 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N7DMxl'] = False # (N-m/m); Applied distributed moments at Node 7 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N7DMyl'] = False # (N-m/m); Applied distributed moments at Node 7 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N7DMzl'] = False # (N-m/m); Applied distributed moments at Node 7 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N8DMxl'] = False # (N-m/m); Applied distributed moments at Node 8 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N8DMyl'] = False # (N-m/m); Applied distributed moments at Node 8 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N8DMzl'] = False # (N-m/m); Applied distributed moments at Node 8 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N9DMxl'] = False # (N-m/m); Applied distributed moments at Node 9 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N9DMyl'] = False # (N-m/m); Applied distributed moments at Node 9 expressed in l; l: a floating coordinate system local to the deflected beam +BeamDyn['N9DMzl'] = False # (N-m/m); Applied distributed moments at Node 9 expressed in l; l: a floating coordinate system local to the deflected beam + +# Pitch Actuator +BeamDyn['PAngInp'] = False # (deg); Pitch angle input; +BeamDyn['PAngAct'] = False # (deg); Actual pitch angle ; +BeamDyn['PRatAct'] = False # (deg/s); Actual pitch rate; +BeamDyn['PAccAct'] = False # (deg/s^2); Actual pitch acceleration; + + +""" ElastoDyn """ +ElastoDyn = {} + +# Blade 1 Tip Motions +ElastoDyn['TipDxc1'] = True # (m); Blade 1 out-of-plane tip deflection (relative to the undeflected position); Directed along the xc1-axis +ElastoDyn['OoPDefl1'] = False # (m); Blade 1 out-of-plane tip deflection (relative to the undeflected position); Directed along the xc1-axis +ElastoDyn['TipDyc1'] = True # (m); Blade 1 in-plane tip deflection (relative to the undeflected position); Directed along the yc1-axis +ElastoDyn['IPDefl1'] = False # (m); Blade 1 in-plane tip deflection (relative to the undeflected position); Directed along the yc1-axis +ElastoDyn['TipDzc1'] = True # (m); Blade 1 axial tip deflection (relative to the undeflected position); Directed along the zc1- and zb1-axes +ElastoDyn['TipDzb1'] = True # (m); Blade 1 axial tip deflection (relative to the undeflected position); Directed along the zc1- and zb1-axes +ElastoDyn['TipDxb1'] = True # (m); Blade 1 flapwise tip deflection (relative to the undeflected position); Directed along the xb1-axis +ElastoDyn['TipDyb1'] = True # (m); Blade 1 edgewise tip deflection (relative to the undeflected position); Directed along the yb1-axis +ElastoDyn['TipALxb1'] = False # (m/s^2); Blade 1 local flapwise tip acceleration (absolute); Directed along the local xb1-axis +ElastoDyn['TipALyb1'] = False # (m/s^2); Blade 1 local edgewise tip acceleration (absolute); Directed along the local yb1-axis +ElastoDyn['TipALzb1'] = False # (m/s^2); Blade 1 local axial tip acceleration (absolute); Directed along the local zb1-axis +ElastoDyn['TipALgxb1'] = False # (m/s^2); Blade 1 local flapwise tip acceleration (relative to g); Directed along the local xb1-axis +ElastoDyn['TipALgyb1'] = False # (m/s^2); Blade 1 local edgewise tip acceleration (relative to g); Directed along the local yb1-axis +ElastoDyn['TipALgzb1'] = False # (m/s^2); Blade 1 local axial tip acceleration (relative to g); Directed along the local zb1-axis +ElastoDyn['TipRDxb1'] = False # (deg); Blade 1 roll (angular/rotational) tip deflection (relative to the undeflected position). In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the xb1-axis +ElastoDyn['RollDefl1'] = False # (deg); Blade 1 roll (angular/rotational) tip deflection (relative to the undeflected position). In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the xb1-axis +ElastoDyn['TipRDyb1'] = False # (deg); Blade 1 pitch (angular/rotational) tip deflection (relative to the undeflected position). In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the yb1-axis +ElastoDyn['PtchDefl1'] = False # (deg); Blade 1 pitch (angular/rotational) tip deflection (relative to the undeflected position). In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the yb1-axis +ElastoDyn['TipRDzc1'] = False # (deg); Blade 1 torsional tip deflection (relative to the undeflected position). This output will always be zero for FAST simulation results. Use it for examining blade torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. Please note that this output uses the opposite of the sign convention used for blade pitch angles.; About the zc1- and zb1-axes +ElastoDyn['TipRDzb1'] = False # (deg); Blade 1 torsional tip deflection (relative to the undeflected position). This output will always be zero for FAST simulation results. Use it for examining blade torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. Please note that this output uses the opposite of the sign convention used for blade pitch angles.; About the zc1- and zb1-axes +ElastoDyn['TwstDefl1'] = False # (deg); Blade 1 torsional tip deflection (relative to the undeflected position). This output will always be zero for FAST simulation results. Use it for examining blade torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. Please note that this output uses the opposite of the sign convention used for blade pitch angles.; About the zc1- and zb1-axes +ElastoDyn['TipClrnc1'] = False # (m); Blade 1 tip-to-tower clearance estimate. This is computed as the perpendicular distance from the yaw axis to the tip of blade 1 when the blade tip is below the yaw bearing. When the tip of blade 1 is above the yaw bearing, it is computed as the absolute distance from the yaw bearing to the blade tip. Please note that you should reduce this value by the tower radius to obtain the actual tower clearance.; N/A +ElastoDyn['TwrClrnc1'] = False # (m); Blade 1 tip-to-tower clearance estimate. This is computed as the perpendicular distance from the yaw axis to the tip of blade 1 when the blade tip is below the yaw bearing. When the tip of blade 1 is above the yaw bearing, it is computed as the absolute distance from the yaw bearing to the blade tip. Please note that you should reduce this value by the tower radius to obtain the actual tower clearance.; N/A +ElastoDyn['Tip2Twr1'] = False # (m); Blade 1 tip-to-tower clearance estimate. This is computed as the perpendicular distance from the yaw axis to the tip of blade 1 when the blade tip is below the yaw bearing. When the tip of blade 1 is above the yaw bearing, it is computed as the absolute distance from the yaw bearing to the blade tip. Please note that you should reduce this value by the tower radius to obtain the actual tower clearance.; N/A + +# Blade 2 Tip Motions +ElastoDyn['TipDxc2'] = True # (m); Blade 2 out-of-plane tip deflection (relative to the pitch axis); Directed along the xc2-axis +ElastoDyn['OoPDefl2'] = False # (m); Blade 2 out-of-plane tip deflection (relative to the pitch axis); Directed along the xc2-axis +ElastoDyn['TipDyc2'] = True # (m); Blade 2 in-plane tip deflection (relative to the pitch axis); Directed along the yc2-axis +ElastoDyn['IPDefl2'] = False # (m); Blade 2 in-plane tip deflection (relative to the pitch axis); Directed along the yc2-axis +ElastoDyn['TipDzc2'] = True # (m); Blade 2 axial tip deflection (relative to the pitch axis); Directed along the zc2- and zb2-axes +ElastoDyn['TipDzb2'] = True # (m); Blade 2 axial tip deflection (relative to the pitch axis); Directed along the zc2- and zb2-axes +ElastoDyn['TipDxb2'] = True # (m); Blade 2 flapwise tip deflection (relative to the pitch axis); Directed along the xb2-axis +ElastoDyn['TipDyb2'] = True # (m); Blade 2 edgewise tip deflection (relative to the pitch axis); Directed along the yb2-axis +ElastoDyn['TipALxb2'] = False # (m/s^2); Blade 2 local flapwise tip acceleration (absolute); Directed along the local xb2-axis +ElastoDyn['TipALyb2'] = False # (m/s^2); Blade 2 local edgewise tip acceleration (absolute); Directed along the local yb2-axis +ElastoDyn['TipALzb2'] = False # (m/s^2); Blade 2 local axial tip acceleration (absolute); Directed along the local zb2-axis +ElastoDyn['TipALgxb2'] = False # (m/s^2); Blade 2 local flapwise tip acceleration (relative to g); Directed along the local xb2-axis +ElastoDyn['TipALgyb2'] = False # (m/s^2); Blade 2 local edgewise tip acceleration (relative to g); Directed along the local yb2-axis +ElastoDyn['TipALgzb2'] = False # (m/s^2); Blade 2 local axial tip acceleration (relative to g); Directed along the local zb2-axis +ElastoDyn['TipRDxb2'] = False # (deg); Blade 2 roll (angular/rotational) tip deflection (relative to the undeflected position). In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the xb2-axis +ElastoDyn['RollDefl2'] = False # (deg); Blade 2 roll (angular/rotational) tip deflection (relative to the undeflected position). In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the xb2-axis +ElastoDyn['TipRDyb2'] = False # (deg); Blade 2 pitch (angular/rotational) tip deflection (relative to the undeflected position). In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the yb2-axis +ElastoDyn['PtchDefl2'] = False # (deg); Blade 2 pitch (angular/rotational) tip deflection (relative to the undeflected position). In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the yb2-axis +ElastoDyn['TipRDzc2'] = False # (deg); Blade 2 torsional (angular/rotational) tip deflection (relative to the undeflected position). This output will always be zero for FAST simulation results. Use it for examining blade torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. Please note that this output uses the opposite of the sign convention used for blade pitch angles.; About the zc2- and zb2-axes +ElastoDyn['TipRDzb2'] = False # (deg); Blade 2 torsional (angular/rotational) tip deflection (relative to the undeflected position). This output will always be zero for FAST simulation results. Use it for examining blade torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. Please note that this output uses the opposite of the sign convention used for blade pitch angles.; About the zc2- and zb2-axes +ElastoDyn['TwstDefl2'] = False # (deg); Blade 2 torsional (angular/rotational) tip deflection (relative to the undeflected position). This output will always be zero for FAST simulation results. Use it for examining blade torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. Please note that this output uses the opposite of the sign convention used for blade pitch angles.; About the zc2- and zb2-axes +ElastoDyn['TipClrnc2'] = False # (m); Blade 2 tip-to-tower clearance estimate. This is computed as the perpendicular distance from the yaw axis to the tip of blade 1 when the blade tip is below the yaw bearing. When the tip of blade 1 is above the yaw bearing, it is computed as the absolute distance from the yaw bearing to the blade tip. Please note that you should reduce this value by the tower radius to obtain the actual tower clearance.; N/A +ElastoDyn['TwrClrnc2'] = False # (m); Blade 2 tip-to-tower clearance estimate. This is computed as the perpendicular distance from the yaw axis to the tip of blade 1 when the blade tip is below the yaw bearing. When the tip of blade 1 is above the yaw bearing, it is computed as the absolute distance from the yaw bearing to the blade tip. Please note that you should reduce this value by the tower radius to obtain the actual tower clearance.; N/A +ElastoDyn['Tip2Twr2'] = False # (m); Blade 2 tip-to-tower clearance estimate. This is computed as the perpendicular distance from the yaw axis to the tip of blade 1 when the blade tip is below the yaw bearing. When the tip of blade 1 is above the yaw bearing, it is computed as the absolute distance from the yaw bearing to the blade tip. Please note that you should reduce this value by the tower radius to obtain the actual tower clearance.; N/A + +# Blade 3 Tip Motions +ElastoDyn['TipDxc3'] = True # (m); Blade 3 out-of-plane tip deflection (relative to the pitch axis); Directed along the xc3-axis +ElastoDyn['OoPDefl3'] = False # (m); Blade 3 out-of-plane tip deflection (relative to the pitch axis); Directed along the xc3-axis +ElastoDyn['TipDyc3'] = True # (m); Blade 3 in-plane tip deflection (relative to the pitch axis); Directed along the yc3-axis +ElastoDyn['IPDefl3'] = False # (m); Blade 3 in-plane tip deflection (relative to the pitch axis); Directed along the yc3-axis +ElastoDyn['TipDzc3'] = True # (m); Blade 3 axial tip deflection (relative to the pitch axis); Directed along the zc3- and zb3-axes +ElastoDyn['TipDzb3'] = True # (m); Blade 3 axial tip deflection (relative to the pitch axis); Directed along the zc3- and zb3-axes +ElastoDyn['TipDxb3'] = True # (m); Blade 3 flapwise tip deflection (relative to the pitch axis); Directed along the xb3-axis +ElastoDyn['TipDyb3'] = True # (m); Blade 3 edgewise tip deflection (relative to the pitch axis); Directed along the yb3-axis +ElastoDyn['TipALxb3'] = False # (m/s^2); Blade 3 local flapwise tip acceleration (absolute); Directed along the local xb3-axis +ElastoDyn['TipALyb3'] = False # (m/s^2); Blade 3 local edgewise tip acceleration (absolute); Directed along the local yb3-axis +ElastoDyn['TipALzb3'] = False # (m/s^2); Blade 3 local axial tip acceleration (absolute); Directed along the local zb3-axis +ElastoDyn['TipALgxb3'] = False # (m/s^2); Blade 3 local flapwise tip acceleration (relative to g); Directed along the local xb3-axis +ElastoDyn['TipALgyb3'] = False # (m/s^2); Blade 3 local edgewise tip acceleration (relative to g); Directed along the local yb3-axis +ElastoDyn['TipALgzb3'] = False # (m/s^2); Blade 3 local axial tip acceleration (relative to g); Directed along the local zb3-axis +ElastoDyn['TipRDxb3'] = False # (deg); Blade 3 roll (angular/rotational) tip deflection (relative to the undeflected position). In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the xb3-axis +ElastoDyn['RollDefl3'] = False # (deg); Blade 3 roll (angular/rotational) tip deflection (relative to the undeflected position). In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the xb3-axis +ElastoDyn['TipRDyb3'] = False # (deg); Blade 3 pitch (angular/rotational) tip deflection (relative to the undeflected position). In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the yb3-axis +ElastoDyn['PtchDefl3'] = False # (deg); Blade 3 pitch (angular/rotational) tip deflection (relative to the undeflected position). In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the yb3-axis +ElastoDyn['TipRDzc3'] = False # (deg); Blade 3 torsional tip deflection (relative to the undeflected position). This output will always be zero for FAST simulation results. Use it for examining blade torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. Please note that this output uses the opposite of the sign convention used for blade pitch angles.; About the zc3- and zb3-axes +ElastoDyn['TipRDzb3'] = False # (deg); Blade 3 torsional tip deflection (relative to the undeflected position). This output will always be zero for FAST simulation results. Use it for examining blade torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. Please note that this output uses the opposite of the sign convention used for blade pitch angles.; About the zc3- and zb3-axes +ElastoDyn['TwstDefl3'] = False # (deg); Blade 3 torsional tip deflection (relative to the undeflected position). This output will always be zero for FAST simulation results. Use it for examining blade torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. Please note that this output uses the opposite of the sign convention used for blade pitch angles.; About the zc3- and zb3-axes +ElastoDyn['TipClrnc3'] = False # (m); Blade 3 tip-to-tower clearance estimate. This is computed as the perpendicular distance from the yaw axis to the tip of blade 1 when the blade tip is below the yaw bearing. When the tip of blade 1 is above the yaw bearing, it is computed as the absolute distance from the yaw bearing to the blade tip. Please note that you should reduce this value by the tower radius to obtain the actual tower clearance.; N/A +ElastoDyn['TwrClrnc3'] = False # (m); Blade 3 tip-to-tower clearance estimate. This is computed as the perpendicular distance from the yaw axis to the tip of blade 1 when the blade tip is below the yaw bearing. When the tip of blade 1 is above the yaw bearing, it is computed as the absolute distance from the yaw bearing to the blade tip. Please note that you should reduce this value by the tower radius to obtain the actual tower clearance.; N/A +ElastoDyn['Tip2Twr3'] = False # (m); Blade 3 tip-to-tower clearance estimate. This is computed as the perpendicular distance from the yaw axis to the tip of blade 1 when the blade tip is below the yaw bearing. When the tip of blade 1 is above the yaw bearing, it is computed as the absolute distance from the yaw bearing to the blade tip. Please note that you should reduce this value by the tower radius to obtain the actual tower clearance.; N/A + +# Blade 1 Local Span Motions +ElastoDyn['Spn1ALxb1'] = False # (m/s^2); Blade 1 local flapwise acceleration (absolute) of span station 1; Directed along the local xb1-axis +ElastoDyn['Spn1ALyb1'] = False # (m/s^2); Blade 1 local edgewise acceleration (absolute) of span station 1; Directed along the local yb1-axis +ElastoDyn['Spn1ALzb1'] = False # (m/s^2); Blade 1 local axial acceleration (absolute) of span station 1; Directed along the local zb1-axis +ElastoDyn['Spn2ALxb1'] = False # (m/s^2); Blade 1 local flapwise acceleration (absolute) of span station 2; Directed along the local xb1-axis +ElastoDyn['Spn2ALyb1'] = False # (m/s^2); Blade 1 local edgewise acceleration (absolute) of span station 2; Directed along the local yb1-axis +ElastoDyn['Spn2ALzb1'] = False # (m/s^2); Blade 1 local axial acceleration (absolute) of span station 2; Directed along the local zb1-axis +ElastoDyn['Spn3ALxb1'] = False # (m/s^2); Blade 1 local flapwise acceleration (absolute) of span station 3; Directed along the local xb1-axis +ElastoDyn['Spn3ALyb1'] = False # (m/s^2); Blade 1 local edgewise acceleration (absolute) of span station 3; Directed along the local yb1-axis +ElastoDyn['Spn3ALzb1'] = False # (m/s^2); Blade 1 local axial acceleration (absolute) of span station 3; Directed along the local zb1-axis +ElastoDyn['Spn4ALxb1'] = False # (m/s^2); Blade 1 local flapwise acceleration (absolute) of span station 4; Directed along the local xb1-axis +ElastoDyn['Spn4ALyb1'] = False # (m/s^2); Blade 1 local edgewise acceleration (absolute) of span station 4; Directed along the local yb1-axis +ElastoDyn['Spn4ALzb1'] = False # (m/s^2); Blade 1 local axial acceleration (absolute) of span station 4; Directed along the local zb1-axis +ElastoDyn['Spn5ALxb1'] = False # (m/s^2); Blade 1 local flapwise acceleration (absolute) of span station 5; Directed along the local xb1-axis +ElastoDyn['Spn5ALyb1'] = False # (m/s^2); Blade 1 local edgewise acceleration (absolute) of span station 5; Directed along the local yb1-axis +ElastoDyn['Spn5ALzb1'] = False # (m/s^2); Blade 1 local axial acceleration (absolute) of span station 5; Directed along the local zb1-axis +ElastoDyn['Spn6ALxb1'] = False # (m/s^2); Blade 1 local flapwise acceleration (absolute) of span station 6; Directed along the local xb1-axis +ElastoDyn['Spn6ALyb1'] = False # (m/s^2); Blade 1 local edgewise acceleration (absolute) of span station 6; Directed along the local yb1-axis +ElastoDyn['Spn6ALzb1'] = False # (m/s^2); Blade 1 local axial acceleration (absolute) of span station 6; Directed along the local zb1-axis +ElastoDyn['Spn7ALxb1'] = False # (m/s^2); Blade 1 local flapwise acceleration (absolute) of span station 7; Directed along the local xb1-axis +ElastoDyn['Spn7ALyb1'] = False # (m/s^2); Blade 1 local edgewise acceleration (absolute) of span station 7; Directed along the local yb1-axis +ElastoDyn['Spn7ALzb1'] = False # (m/s^2); Blade 1 local axial acceleration (absolute) of span station 7; Directed along the local zb1-axis +ElastoDyn['Spn8ALxb1'] = False # (m/s^2); Blade 1 local flapwise acceleration (absolute) of span station 8; Directed along the local xb1-axis +ElastoDyn['Spn8ALyb1'] = False # (m/s^2); Blade 1 local edgewise acceleration (absolute) of span station 8; Directed along the local yb1-axis +ElastoDyn['Spn8ALzb1'] = False # (m/s^2); Blade 1 local axial acceleration (absolute) of span station 8; Directed along the local zb1-axis +ElastoDyn['Spn9ALxb1'] = False # (m/s^2); Blade 1 local flapwise acceleration (absolute) of span station 9; Directed along the local xb1-axis +ElastoDyn['Spn9ALyb1'] = False # (m/s^2); Blade 1 local edgewise acceleration (absolute) of span station 9; Directed along the local yb1-axis +ElastoDyn['Spn9ALzb1'] = False # (m/s^2); Blade 1 local axial acceleration (absolute) of span station 9; Directed along the local zb1-axis +ElastoDyn['Spn1ALgxb1'] = False # (m/s^2); Blade 1 local flapwise acceleration (relative to g) of span station 1; Directed along the local xb1-axis +ElastoDyn['Spn1ALgyb1'] = False # (m/s^2); Blade 1 local edgewise acceleration (relative to g) of span station 1; Directed along the local yb1-axis +ElastoDyn['Spn1ALgzb1'] = False # (m/s^2); Blade 1 local axial acceleration (relative to g) of span station 1; Directed along the local zb1-axis +ElastoDyn['Spn2ALgxb1'] = False # (m/s^2); Blade 1 local flapwise acceleration (relative to g) of span station 2; Directed along the local xb1-axis +ElastoDyn['Spn2ALgyb1'] = False # (m/s^2); Blade 1 local edgewise acceleration (relative to g) of span station 2; Directed along the local yb1-axis +ElastoDyn['Spn2ALgzb1'] = False # (m/s^2); Blade 1 local axial acceleration (relative to g) of span station 2; Directed along the local zb1-axis +ElastoDyn['Spn3ALgxb1'] = False # (m/s^2); Blade 1 local flapwise acceleration (relative to g) of span station 3; Directed along the local xb1-axis +ElastoDyn['Spn3ALgyb1'] = False # (m/s^2); Blade 1 local edgewise acceleration (relative to g) of span station 3; Directed along the local yb1-axis +ElastoDyn['Spn3ALgzb1'] = False # (m/s^2); Blade 1 local axial acceleration (relative to g) of span station 3; Directed along the local zb1-axis +ElastoDyn['Spn4ALgxb1'] = False # (m/s^2); Blade 1 local flapwise acceleration (relative to g) of span station 4; Directed along the local xb1-axis +ElastoDyn['Spn4ALgyb1'] = False # (m/s^2); Blade 1 local edgewise acceleration (relative to g) of span station 4; Directed along the local yb1-axis +ElastoDyn['Spn4ALgzb1'] = False # (m/s^2); Blade 1 local axial acceleration (relative to g) of span station 4; Directed along the local zb1-axis +ElastoDyn['Spn5ALgxb1'] = False # (m/s^2); Blade 1 local flapwise acceleration (relative to g) of span station 5; Directed along the local xb1-axis +ElastoDyn['Spn5ALgyb1'] = False # (m/s^2); Blade 1 local edgewise acceleration (relative to g) of span station 5; Directed along the local yb1-axis +ElastoDyn['Spn5ALgzb1'] = False # (m/s^2); Blade 1 local axial acceleration (relative to g) of span station 5; Directed along the local zb1-axis +ElastoDyn['Spn6ALgxb1'] = False # (m/s^2); Blade 1 local flapwise acceleration (relative to g) of span station 6; Directed along the local xb1-axis +ElastoDyn['Spn6ALgyb1'] = False # (m/s^2); Blade 1 local edgewise acceleration (relative to g) of span station 6; Directed along the local yb1-axis +ElastoDyn['Spn6ALgzb1'] = False # (m/s^2); Blade 1 local axial acceleration (relative to g) of span station 6; Directed along the local zb1-axis +ElastoDyn['Spn7ALgxb1'] = False # (m/s^2); Blade 1 local flapwise acceleration (relative to g) of span station 7; Directed along the local xb1-axis +ElastoDyn['Spn7ALgyb1'] = False # (m/s^2); Blade 1 local edgewise acceleration (relative to g) of span station 7; Directed along the local yb1-axis +ElastoDyn['Spn7ALgzb1'] = False # (m/s^2); Blade 1 local axial acceleration (relative to g) of span station 7; Directed along the local zb1-axis +ElastoDyn['Spn8ALgxb1'] = False # (m/s^2); Blade 1 local flapwise acceleration (relative to g) of span station 8; Directed along the local xb1-axis +ElastoDyn['Spn8ALgyb1'] = False # (m/s^2); Blade 1 local edgewise acceleration (relative to g) of span station 8; Directed along the local yb1-axis +ElastoDyn['Spn8ALgzb1'] = False # (m/s^2); Blade 1 local axial acceleration (relative to g) of span station 8; Directed along the local zb1-axis +ElastoDyn['Spn9ALgxb1'] = False # (m/s^2); Blade 1 local flapwise acceleration (relative to g) of span station 9; Directed along the local xb1-axis +ElastoDyn['Spn9ALgyb1'] = False # (m/s^2); Blade 1 local edgewise acceleration (relative to g) of span station 9; Directed along the local yb1-axis +ElastoDyn['Spn9ALgzb1'] = False # (m/s^2); Blade 1 local axial acceleration (relative to g) of span station 9; Directed along the local zb1-axis +ElastoDyn['Spn1TDxb1'] = False # (m); Blade 1 local flapwise (translational) deflection (relative to the undeflected position) of span station 1; Directed along the xb1-axis +ElastoDyn['Spn1TDyb1'] = False # (m); Blade 1 local edgewise (translational) deflection (relative to the undeflected position) of span station 1; Directed along the yb1-axis +ElastoDyn['Spn1TDzb1'] = False # (m); Blade 1 local axial (translational) deflection (relative to the undeflected position) of span station 1; Directed along the zb1-axis +ElastoDyn['Spn2TDxb1'] = False # (m); Blade 1 local flapwise (translational) deflection (relative to the undeflected position) of span station 2; Directed along the xb1-axis +ElastoDyn['Spn2TDyb1'] = False # (m); Blade 1 local edgewise (translational) deflection (relative to the undeflected position) of span station 2; Directed along the yb1-axis +ElastoDyn['Spn2TDzb1'] = False # (m); Blade 1 local axial (translational) deflection (relative to the undeflected position) of span station 2; Directed along the zb1-axis +ElastoDyn['Spn3TDxb1'] = False # (m); Blade 1 local flapwise (translational) deflection (relative to the undeflected position) of span station 3; Directed along the xb1-axis +ElastoDyn['Spn3TDyb1'] = False # (m); Blade 1 local edgewise (translational) deflection (relative to the undeflected position) of span station 3; Directed along the yb1-axis +ElastoDyn['Spn3TDzb1'] = False # (m); Blade 1 local axial (translational) deflection (relative to the undeflected position) of span station 3; Directed along the zb1-axis +ElastoDyn['Spn4TDxb1'] = False # (m); Blade 1 local flapwise (translational) deflection (relative to the undeflected position) of span station 4; Directed along the xb1-axis +ElastoDyn['Spn4TDyb1'] = False # (m); Blade 1 local edgewise (translational) deflection (relative to the undeflected position) of span station 4; Directed along the yb1-axis +ElastoDyn['Spn4TDzb1'] = False # (m); Blade 1 local axial (translational) deflection (relative to the undeflected position) of span station 4; Directed along the zb1-axis +ElastoDyn['Spn5TDxb1'] = False # (m); Blade 1 local flapwise (translational) deflection (relative to the undeflected position) of span station 5; Directed along the xb1-axis +ElastoDyn['Spn5TDyb1'] = False # (m); Blade 1 local edgewise (translational) deflection (relative to the undeflected position) of span station 5; Directed along the yb1-axis +ElastoDyn['Spn5TDzb1'] = False # (m); Blade 1 local axial (translational) deflection (relative to the undeflected position) of span station 5; Directed along the zb1-axis +ElastoDyn['Spn6TDxb1'] = False # (m); Blade 1 local flapwise (translational) deflection (relative to the undeflected position) of span station 6; Directed along the xb1-axis +ElastoDyn['Spn6TDyb1'] = False # (m); Blade 1 local edgewise (translational) deflection (relative to the undeflected position) of span station 6; Directed along the yb1-axis +ElastoDyn['Spn6TDzb1'] = False # (m); Blade 1 local axial (translational) deflection (relative to the undeflected position) of span station 6; Directed along the zb1-axis +ElastoDyn['Spn7TDxb1'] = False # (m); Blade 1 local flapwise (translational) deflection (relative to the undeflected position) of span station 7; Directed along the xb1-axis +ElastoDyn['Spn7TDyb1'] = False # (m); Blade 1 local edgewise (translational) deflection (relative to the undeflected position) of span station 7; Directed along the yb1-axis +ElastoDyn['Spn7TDzb1'] = False # (m); Blade 1 local axial (translational) deflection (relative to the undeflected position) of span station 7; Directed along the zb1-axis +ElastoDyn['Spn8TDxb1'] = False # (m); Blade 1 local flapwise (translational) deflection (relative to the undeflected position) of span station 8; Directed along the xb1-axis +ElastoDyn['Spn8TDyb1'] = False # (m); Blade 1 local edgewise (translational) deflection (relative to the undeflected position) of span station 8; Directed along the yb1-axis +ElastoDyn['Spn8TDzb1'] = False # (m); Blade 1 local axial (translational) deflection (relative to the undeflected position) of span station 8; Directed along the zb1-axis +ElastoDyn['Spn9TDxb1'] = False # (m); Blade 1 local flapwise (translational) deflection (relative to the undeflected position) of span station 9; Directed along the xb1-axis +ElastoDyn['Spn9TDyb1'] = False # (m); Blade 1 local edgewise (translational) deflection (relative to the undeflected position) of span station 9; Directed along the yb1-axis +ElastoDyn['Spn9TDzb1'] = False # (m); Blade 1 local axial (translational) deflection (relative to the undeflected position) of span station 9; Directed along the zb1-axis +ElastoDyn['Spn1RDxb1'] = False # (deg); Blade 1 local roll (angular/rotational) deflection (relative to the undeflected position) of span station 1. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local xb1-axis +ElastoDyn['Spn1RDyb1'] = False # (deg); Blade 1 local pitch (angular/rotational) deflection (relative to the undeflected position) of span station 1. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local yb1-axis +ElastoDyn['Spn1RDzb1'] = False # (deg); Blade 1 local torsional (angular/rotational) deflection (relative to the undeflected position) of span station 1. This output will always be zero for FAST simulation results. Use it for examining blade torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. Please note that this output uses the opposite of the sign convention used for blade pitch angles.; About the local zb1-axis +ElastoDyn['Spn2RDxb1'] = False # (deg); Blade 1 local roll (angular/rotational) deflection (relative to the undeflected position) of span station 2. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local xb1-axis +ElastoDyn['Spn2RDyb1'] = False # (deg); Blade 1 local pitch (angular/rotational) deflection (relative to the undeflected position) of span station 2. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local yb1-axis +ElastoDyn['Spn2RDzb1'] = False # (deg); Blade 1 local torsional (angular/rotational) deflection (relative to the undeflected position) of span station 2. This output will always be zero for FAST simulation results. Use it for examining blade torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. Please note that this output uses the opposite of the sign convention used for blade pitch angles.; About the local zb1-axis +ElastoDyn['Spn3RDxb1'] = False # (deg); Blade 1 local roll (angular/rotational) deflection (relative to the undeflected position) of span station 3. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local xb1-axis +ElastoDyn['Spn3RDyb1'] = False # (deg); Blade 1 local pitch (angular/rotational) deflection (relative to the undeflected position) of span station 3. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local yb1-axis +ElastoDyn['Spn3RDzb1'] = False # (deg); Blade 1 local torsional (angular/rotational) deflection (relative to the undeflected position) of span station 3. This output will always be zero for FAST simulation results. Use it for examining blade torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. Please note that this output uses the opposite of the sign convention used for blade pitch angles.; About the local zb1-axis +ElastoDyn['Spn4RDxb1'] = False # (deg); Blade 1 local roll (angular/rotational) deflection (relative to the undeflected position) of span station 4. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local xb1-axis +ElastoDyn['Spn4RDyb1'] = False # (deg); Blade 1 local pitch (angular/rotational) deflection (relative to the undeflected position) of span station 4. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local yb1-axis +ElastoDyn['Spn4RDzb1'] = False # (deg); Blade 1 local torsional (angular/rotational) deflection (relative to the undeflected position) of span station 4. This output will always be zero for FAST simulation results. Use it for examining blade torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. Please note that this output uses the opposite of the sign convention used for blade pitch angles.; About the local zb1-axis +ElastoDyn['Spn5RDxb1'] = False # (deg); Blade 1 local roll (angular/rotational) deflection (relative to the undeflected position) of span station 5. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local xb1-axis +ElastoDyn['Spn5RDyb1'] = False # (deg); Blade 1 local pitch (angular/rotational) deflection (relative to the undeflected position) of span station 5. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local yb1-axis +ElastoDyn['Spn5RDzb1'] = False # (deg); Blade 1 local torsional (angular/rotational) deflection (relative to the undeflected position) of span station 5. This output will always be zero for FAST simulation results. Use it for examining blade torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. Please note that this output uses the opposite of the sign convention used for blade pitch angles.; About the local zb1-axis +ElastoDyn['Spn6RDxb1'] = False # (deg); Blade 1 local roll (angular/rotational) deflection (relative to the undeflected position) of span station 6. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local xb1-axis +ElastoDyn['Spn6RDyb1'] = False # (deg); Blade 1 local pitch (angular/rotational) deflection (relative to the undeflected position) of span station 6. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local yb1-axis +ElastoDyn['Spn6RDzb1'] = False # (deg); Blade 1 local torsional (angular/rotational) deflection (relative to the undeflected position) of span station 6. This output will always be zero for FAST simulation results. Use it for examining blade torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. Please note that this output uses the opposite of the sign convention used for blade pitch angles.; About the local zb1-axis +ElastoDyn['Spn7RDxb1'] = False # (deg); Blade 1 local roll (angular/rotational) deflection (relative to the undeflected position) of span station 7. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local xb1-axis +ElastoDyn['Spn7RDyb1'] = False # (deg); Blade 1 local pitch (angular/rotational) deflection (relative to the undeflected position) of span station 7. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local yb1-axis +ElastoDyn['Spn7RDzb1'] = False # (deg); Blade 1 local torsional (angular/rotational) deflection (relative to the undeflected position) of span station 7. This output will always be zero for FAST simulation results. Use it for examining blade torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. Please note that this output uses the opposite of the sign convention used for blade pitch angles.; About the local zb1-axis +ElastoDyn['Spn8RDxb1'] = False # (deg); Blade 1 local roll (angular/rotational) deflection (relative to the undeflected position) of span station 8. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local xb1-axis +ElastoDyn['Spn8RDyb1'] = False # (deg); Blade 1 local pitch (angular/rotational) deflection (relative to the undeflected position) of span station 8. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local yb1-axis +ElastoDyn['Spn8RDzb1'] = False # (deg); Blade 1 local torsional (angular/rotational) deflection (relative to the undeflected position) of span station 8. This output will always be zero for FAST simulation results. Use it for examining blade torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. Please note that this output uses the opposite of the sign convention used for blade pitch angles.; About the local zb1-axis +ElastoDyn['Spn9RDxb1'] = False # (deg); Blade 1 local roll (angular/rotational) deflection (relative to the undeflected position) of span station 9. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local xb1-axis +ElastoDyn['Spn9RDyb1'] = False # (deg); Blade 1 local pitch (angular/rotational) deflection (relative to the undeflected position) of span station 9. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local yb1-axis +ElastoDyn['Spn9RDzb1'] = False # (deg); Blade 1 local torsional (angular/rotational) deflection (relative to the undeflected position) of span station 9. This output will always be zero for FAST simulation results. Use it for examining blade torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. Please note that this output uses the opposite of the sign convention used for blade pitch angles.; About the local zb1-axis + +# Blade 2 Local Span Motions +ElastoDyn['Spn1ALxb2'] = False # (m/s^2); Blade 2 local flapwise acceleration (absolute) of span station 1; Directed along the local xb2-axis +ElastoDyn['Spn1ALyb2'] = False # (m/s^2); Blade 2 local edgewise acceleration (absolute) of span station 1; Directed along the local yb2-axis +ElastoDyn['Spn1ALzb2'] = False # (m/s^2); Blade 2 local axial acceleration (absolute) of span station 1; Directed along the local zb2-axis +ElastoDyn['Spn2ALxb2'] = False # (m/s^2); Blade 2 local flapwise acceleration (absolute) of span station 2; Directed along the local xb2-axis +ElastoDyn['Spn2ALyb2'] = False # (m/s^2); Blade 2 local edgewise acceleration (absolute) of span station 2; Directed along the local yb2-axis +ElastoDyn['Spn2ALzb2'] = False # (m/s^2); Blade 2 local axial acceleration (absolute) of span station 2; Directed along the local zb2-axis +ElastoDyn['Spn3ALxb2'] = False # (m/s^2); Blade 2 local flapwise acceleration (absolute) of span station 3; Directed along the local xb2-axis +ElastoDyn['Spn3ALyb2'] = False # (m/s^2); Blade 2 local edgewise acceleration (absolute) of span station 3; Directed along the local yb2-axis +ElastoDyn['Spn3ALzb2'] = False # (m/s^2); Blade 2 local axial acceleration (absolute) of span station 3; Directed along the local zb2-axis +ElastoDyn['Spn4ALxb2'] = False # (m/s^2); Blade 2 local flapwise acceleration (absolute) of span station 4; Directed along the local xb2-axis +ElastoDyn['Spn4ALyb2'] = False # (m/s^2); Blade 2 local edgewise acceleration (absolute) of span station 4; Directed along the local yb2-axis +ElastoDyn['Spn4ALzb2'] = False # (m/s^2); Blade 2 local axial acceleration (absolute) of span station 4; Directed along the local zb2-axis +ElastoDyn['Spn5ALxb2'] = False # (m/s^2); Blade 2 local flapwise acceleration (absolute) of span station 5; Directed along the local xb2-axis +ElastoDyn['Spn5ALyb2'] = False # (m/s^2); Blade 2 local edgewise acceleration (absolute) of span station 5; Directed along the local yb2-axis +ElastoDyn['Spn5ALzb2'] = False # (m/s^2); Blade 2 local axial acceleration (absolute) of span station 5; Directed along the local zb2-axis +ElastoDyn['Spn6ALxb2'] = False # (m/s^2); Blade 2 local flapwise acceleration (absolute) of span station 6; Directed along the local xb2-axis +ElastoDyn['Spn6ALyb2'] = False # (m/s^2); Blade 2 local edgewise acceleration (absolute) of span station 6; Directed along the local yb2-axis +ElastoDyn['Spn6ALzb2'] = False # (m/s^2); Blade 2 local axial acceleration (absolute) of span station 6; Directed along the local zb2-axis +ElastoDyn['Spn7ALxb2'] = False # (m/s^2); Blade 2 local flapwise acceleration (absolute) of span station 7; Directed along the local xb2-axis +ElastoDyn['Spn7ALyb2'] = False # (m/s^2); Blade 2 local edgewise acceleration (absolute) of span station 7; Directed along the local yb2-axis +ElastoDyn['Spn7ALzb2'] = False # (m/s^2); Blade 2 local axial acceleration (absolute) of span station 7; Directed along the local zb2-axis +ElastoDyn['Spn8ALxb2'] = False # (m/s^2); Blade 2 local flapwise acceleration (absolute) of span station 8; Directed along the local xb2-axis +ElastoDyn['Spn8ALyb2'] = False # (m/s^2); Blade 2 local edgewise acceleration (absolute) of span station 8; Directed along the local yb2-axis +ElastoDyn['Spn8ALzb2'] = False # (m/s^2); Blade 2 local axial acceleration (absolute) of span station 8; Directed along the local zb2-axis +ElastoDyn['Spn9ALxb2'] = False # (m/s^2); Blade 2 local flapwise acceleration (absolute) of span station 9; Directed along the local xb2-axis +ElastoDyn['Spn9ALyb2'] = False # (m/s^2); Blade 2 local edgewise acceleration (absolute) of span station 9; Directed along the local yb2-axis +ElastoDyn['Spn9ALzb2'] = False # (m/s^2); Blade 2 local axial acceleration (absolute) of span station 9; Directed along the local zb2-axis +ElastoDyn['Spn1ALgxb2'] = False # (m/s^2); Blade 2 local flapwise acceleration (relative to g) of span station 1; Directed along the local xb2-axis +ElastoDyn['Spn1ALgyb2'] = False # (m/s^2); Blade 2 local edgewise acceleration (relative to g) of span station 1; Directed along the local yb2-axis +ElastoDyn['Spn1ALgzb2'] = False # (m/s^2); Blade 2 local axial acceleration (relative to g) of span station 1; Directed along the local zb2-axis +ElastoDyn['Spn2ALgxb2'] = False # (m/s^2); Blade 2 local flapwise acceleration (relative to g) of span station 2; Directed along the local xb2-axis +ElastoDyn['Spn2ALgyb2'] = False # (m/s^2); Blade 2 local edgewise acceleration (relative to g) of span station 2; Directed along the local yb2-axis +ElastoDyn['Spn2ALgzb2'] = False # (m/s^2); Blade 2 local axial acceleration (relative to g) of span station 2; Directed along the local zb2-axis +ElastoDyn['Spn3ALgxb2'] = False # (m/s^2); Blade 2 local flapwise acceleration (relative to g) of span station 3; Directed along the local xb2-axis +ElastoDyn['Spn3ALgyb2'] = False # (m/s^2); Blade 2 local edgewise acceleration (relative to g) of span station 3; Directed along the local yb2-axis +ElastoDyn['Spn3ALgzb2'] = False # (m/s^2); Blade 2 local axial acceleration (relative to g) of span station 3; Directed along the local zb2-axis +ElastoDyn['Spn4ALgxb2'] = False # (m/s^2); Blade 2 local flapwise acceleration (relative to g) of span station 4; Directed along the local xb2-axis +ElastoDyn['Spn4ALgyb2'] = False # (m/s^2); Blade 2 local edgewise acceleration (relative to g) of span station 4; Directed along the local yb2-axis +ElastoDyn['Spn4ALgzb2'] = False # (m/s^2); Blade 2 local axial acceleration (relative to g) of span station 4; Directed along the local zb2-axis +ElastoDyn['Spn5ALgxb2'] = False # (m/s^2); Blade 2 local flapwise acceleration (relative to g) of span station 5; Directed along the local xb2-axis +ElastoDyn['Spn5ALgyb2'] = False # (m/s^2); Blade 2 local edgewise acceleration (relative to g) of span station 5; Directed along the local yb2-axis +ElastoDyn['Spn5ALgzb2'] = False # (m/s^2); Blade 2 local axial acceleration (relative to g) of span station 5; Directed along the local zb2-axis +ElastoDyn['Spn6ALgxb2'] = False # (m/s^2); Blade 2 local flapwise acceleration (relative to g) of span station 6; Directed along the local xb2-axis +ElastoDyn['Spn6ALgyb2'] = False # (m/s^2); Blade 2 local edgewise acceleration (relative to g) of span station 6; Directed along the local yb2-axis +ElastoDyn['Spn6ALgzb2'] = False # (m/s^2); Blade 2 local axial acceleration (relative to g) of span station 6; Directed along the local zb2-axis +ElastoDyn['Spn7ALgxb2'] = False # (m/s^2); Blade 2 local flapwise acceleration (relative to g) of span station 7; Directed along the local xb2-axis +ElastoDyn['Spn7ALgyb2'] = False # (m/s^2); Blade 2 local edgewise acceleration (relative to g) of span station 7; Directed along the local yb2-axis +ElastoDyn['Spn7ALgzb2'] = False # (m/s^2); Blade 2 local axial acceleration (relative to g) of span station 7; Directed along the local zb2-axis +ElastoDyn['Spn8ALgxb2'] = False # (m/s^2); Blade 2 local flapwise acceleration (relative to g) of span station 8; Directed along the local xb2-axis +ElastoDyn['Spn8ALgyb2'] = False # (m/s^2); Blade 2 local edgewise acceleration (relative to g) of span station 8; Directed along the local yb2-axis +ElastoDyn['Spn8ALgzb2'] = False # (m/s^2); Blade 2 local axial acceleration (relative to g) of span station 8; Directed along the local zb2-axis +ElastoDyn['Spn9ALgxb2'] = False # (m/s^2); Blade 2 local flapwise acceleration (relative to g) of span station 9; Directed along the local xb2-axis +ElastoDyn['Spn9ALgyb2'] = False # (m/s^2); Blade 2 local edgewise acceleration (relative to g) of span station 9; Directed along the local yb2-axis +ElastoDyn['Spn9ALgzb2'] = False # (m/s^2); Blade 2 local axial acceleration (relative to g) of span station 9; Directed along the local zb2-axis +ElastoDyn['Spn1TDxb2'] = False # (m); Blade 2 local flapwise (translational) deflection (relative to the undeflected position) of span station 1; Directed along the xb2-axis +ElastoDyn['Spn1TDyb2'] = False # (m); Blade 2 local edgewise (translational) deflection (relative to the undeflected position) of span station 1; Directed along the yb2-axis +ElastoDyn['Spn1TDzb2'] = False # (m); Blade 2 local axial (translational) deflection (relative to the undeflected position) of span station 1; Directed along the zb2-axis +ElastoDyn['Spn2TDxb2'] = False # (m); Blade 2 local flapwise (translational) deflection (relative to the undeflected position) of span station 2; Directed along the xb2-axis +ElastoDyn['Spn2TDyb2'] = False # (m); Blade 2 local edgewise (translational) deflection (relative to the undeflected position) of span station 2; Directed along the yb2-axis +ElastoDyn['Spn2TDzb2'] = False # (m); Blade 2 local axial (translational) deflection (relative to the undeflected position) of span station 2; Directed along the zb2-axis +ElastoDyn['Spn3TDxb2'] = False # (m); Blade 2 local flapwise (translational) deflection (relative to the undeflected position) of span station 3; Directed along the xb2-axis +ElastoDyn['Spn3TDyb2'] = False # (m); Blade 2 local edgewise (translational) deflection (relative to the undeflected position) of span station 3; Directed along the yb2-axis +ElastoDyn['Spn3TDzb2'] = False # (m); Blade 2 local axial (translational) deflection (relative to the undeflected position) of span station 3; Directed along the zb2-axis +ElastoDyn['Spn4TDxb2'] = False # (m); Blade 2 local flapwise (translational) deflection (relative to the undeflected position) of span station 4; Directed along the xb2-axis +ElastoDyn['Spn4TDyb2'] = False # (m); Blade 2 local edgewise (translational) deflection (relative to the undeflected position) of span station 4; Directed along the yb2-axis +ElastoDyn['Spn4TDzb2'] = False # (m); Blade 2 local axial (translational) deflection (relative to the undeflected position) of span station 4; Directed along the zb2-axis +ElastoDyn['Spn5TDxb2'] = False # (m); Blade 2 local flapwise (translational) deflection (relative to the undeflected position) of span station 5; Directed along the xb2-axis +ElastoDyn['Spn5TDyb2'] = False # (m); Blade 2 local edgewise (translational) deflection (relative to the undeflected position) of span station 5; Directed along the yb2-axis +ElastoDyn['Spn5TDzb2'] = False # (m); Blade 2 local axial (translational) deflection (relative to the undeflected position) of span station 5; Directed along the zb2-axis +ElastoDyn['Spn6TDxb2'] = False # (m); Blade 2 local flapwise (translational) deflection (relative to the undeflected position) of span station 6; Directed along the xb2-axis +ElastoDyn['Spn6TDyb2'] = False # (m); Blade 2 local edgewise (translational) deflection (relative to the undeflected position) of span station 6; Directed along the yb2-axis +ElastoDyn['Spn6TDzb2'] = False # (m); Blade 2 local axial (translational) deflection (relative to the undeflected position) of span station 6; Directed along the zb2-axis +ElastoDyn['Spn7TDxb2'] = False # (m); Blade 2 local flapwise (translational) deflection (relative to the undeflected position) of span station 7; Directed along the xb2-axis +ElastoDyn['Spn7TDyb2'] = False # (m); Blade 2 local edgewise (translational) deflection (relative to the undeflected position) of span station 7; Directed along the yb2-axis +ElastoDyn['Spn7TDzb2'] = False # (m); Blade 2 local axial (translational) deflection (relative to the undeflected position) of span station 7; Directed along the zb2-axis +ElastoDyn['Spn8TDxb2'] = False # (m); Blade 2 local flapwise (translational) deflection (relative to the undeflected position) of span station 8; Directed along the xb2-axis +ElastoDyn['Spn8TDyb2'] = False # (m); Blade 2 local edgewise (translational) deflection (relative to the undeflected position) of span station 8; Directed along the yb2-axis +ElastoDyn['Spn8TDzb2'] = False # (m); Blade 2 local axial (translational) deflection (relative to the undeflected position) of span station 8; Directed along the zb2-axis +ElastoDyn['Spn9TDxb2'] = False # (m); Blade 2 local flapwise (translational) deflection (relative to the undeflected position) of span station 9; Directed along the xb2-axis +ElastoDyn['Spn9TDyb2'] = False # (m); Blade 2 local edgewise (translational) deflection (relative to the undeflected position) of span station 9; Directed along the yb2-axis +ElastoDyn['Spn9TDzb2'] = False # (m); Blade 2 local axial (translational) deflection (relative to the undeflected position) of span station 9; Directed along the zb2-axis +ElastoDyn['Spn1RDxb2'] = False # (deg); Blade 2 local roll (angular/rotational) deflection (relative to the undeflected position) of span station 1. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local xb2-axis +ElastoDyn['Spn1RDyb2'] = False # (deg); Blade 2 local pitch (angular/rotational) deflection (relative to the undeflected position) of span station 1. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local yb2-axis +ElastoDyn['Spn1RDzb2'] = False # (deg); Blade 2 local torsional (angular/rotational) deflection (relative to the undeflected position) of span station 1. This output will always be zero for FAST simulation results. Use it for examining blade torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. Please note that this output uses the opposite of the sign convention used for blade pitch angles.; About the local zb2-axis +ElastoDyn['Spn2RDxb2'] = False # (deg); Blade 2 local roll (angular/rotational) deflection (relative to the undeflected position) of span station 2. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local xb2-axis +ElastoDyn['Spn2RDyb2'] = False # (deg); Blade 2 local pitch (angular/rotational) deflection (relative to the undeflected position) of span station 2. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local yb2-axis +ElastoDyn['Spn2RDzb2'] = False # (deg); Blade 2 local torsional (angular/rotational) deflection (relative to the undeflected position) of span station 2. This output will always be zero for FAST simulation results. Use it for examining blade torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. Please note that this output uses the opposite of the sign convention used for blade pitch angles.; About the local zb2-axis +ElastoDyn['Spn3RDxb2'] = False # (deg); Blade 2 local roll (angular/rotational) deflection (relative to the undeflected position) of span station 3. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local xb2-axis +ElastoDyn['Spn3RDyb2'] = False # (deg); Blade 2 local pitch (angular/rotational) deflection (relative to the undeflected position) of span station 3. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local yb2-axis +ElastoDyn['Spn3RDzb2'] = False # (deg); Blade 2 local torsional (angular/rotational) deflection (relative to the undeflected position) of span station 3. This output will always be zero for FAST simulation results. Use it for examining blade torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. Please note that this output uses the opposite of the sign convention used for blade pitch angles.; About the local zb2-axis +ElastoDyn['Spn4RDxb2'] = False # (deg); Blade 2 local roll (angular/rotational) deflection (relative to the undeflected position) of span station 4. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local xb2-axis +ElastoDyn['Spn4RDyb2'] = False # (deg); Blade 2 local pitch (angular/rotational) deflection (relative to the undeflected position) of span station 4. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local yb2-axis +ElastoDyn['Spn4RDzb2'] = False # (deg); Blade 2 local torsional (angular/rotational) deflection (relative to the undeflected position) of span station 4. This output will always be zero for FAST simulation results. Use it for examining blade torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. Please note that this output uses the opposite of the sign convention used for blade pitch angles.; About the local zb2-axis +ElastoDyn['Spn5RDxb2'] = False # (deg); Blade 2 local roll (angular/rotational) deflection (relative to the undeflected position) of span station 5. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local xb2-axis +ElastoDyn['Spn5RDyb2'] = False # (deg); Blade 2 local pitch (angular/rotational) deflection (relative to the undeflected position) of span station 5. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local yb2-axis +ElastoDyn['Spn5RDzb2'] = False # (deg); Blade 2 local torsional (angular/rotational) deflection (relative to the undeflected position) of span station 5. This output will always be zero for FAST simulation results. Use it for examining blade torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. Please note that this output uses the opposite of the sign convention used for blade pitch angles.; About the local zb2-axis +ElastoDyn['Spn6RDxb2'] = False # (deg); Blade 2 local roll (angular/rotational) deflection (relative to the undeflected position) of span station 6. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local xb2-axis +ElastoDyn['Spn6RDyb2'] = False # (deg); Blade 2 local pitch (angular/rotational) deflection (relative to the undeflected position) of span station 6. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local yb2-axis +ElastoDyn['Spn6RDzb2'] = False # (deg); Blade 2 local torsional (angular/rotational) deflection (relative to the undeflected position) of span station 6. This output will always be zero for FAST simulation results. Use it for examining blade torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. Please note that this output uses the opposite of the sign convention used for blade pitch angles.; About the local zb2-axis +ElastoDyn['Spn7RDxb2'] = False # (deg); Blade 2 local roll (angular/rotational) deflection (relative to the undeflected position) of span station 7. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local xb2-axis +ElastoDyn['Spn7RDyb2'] = False # (deg); Blade 2 local pitch (angular/rotational) deflection (relative to the undeflected position) of span station 7. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local yb2-axis +ElastoDyn['Spn7RDzb2'] = False # (deg); Blade 2 local torsional (angular/rotational) deflection (relative to the undeflected position) of span station 7. This output will always be zero for FAST simulation results. Use it for examining blade torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. Please note that this output uses the opposite of the sign convention used for blade pitch angles.; About the local zb2-axis +ElastoDyn['Spn8RDxb2'] = False # (deg); Blade 2 local roll (angular/rotational) deflection (relative to the undeflected position) of span station 8. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local xb2-axis +ElastoDyn['Spn8RDyb2'] = False # (deg); Blade 2 local pitch (angular/rotational) deflection (relative to the undeflected position) of span station 8. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local yb2-axis +ElastoDyn['Spn8RDzb2'] = False # (deg); Blade 2 local torsional (angular/rotational) deflection (relative to the undeflected position) of span station 8. This output will always be zero for FAST simulation results. Use it for examining blade torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. Please note that this output uses the opposite of the sign convention used for blade pitch angles.; About the local zb2-axis +ElastoDyn['Spn9RDxb2'] = False # (deg); Blade 2 local roll (angular/rotational) deflection (relative to the undeflected position) of span station 9. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local xb2-axis +ElastoDyn['Spn9RDyb2'] = False # (deg); Blade 2 local pitch (angular/rotational) deflection (relative to the undeflected position) of span station 9. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local yb2-axis +ElastoDyn['Spn9RDzb2'] = False # (deg); Blade 2 local torsional (angular/rotational) deflection (relative to the undeflected position) of span station 9. This output will always be zero for FAST simulation results. Use it for examining blade torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. Please note that this output uses the opposite of the sign convention used for blade pitch angles.; About the local zb2-axis + +# Blade 3 Local Span Motions +ElastoDyn['Spn1ALxb3'] = False # (m/s^2); Blade 3 local flapwise acceleration (absolute) of span station 1; Directed along the local xb3-axis +ElastoDyn['Spn1ALyb3'] = False # (m/s^2); Blade 3 local edgewise acceleration (absolute) of span station 1; Directed along the local yb3-axis +ElastoDyn['Spn1ALzb3'] = False # (m/s^2); Blade 3 local axial acceleration (absolute) of span station 1; Directed along the local zb3-axis +ElastoDyn['Spn2ALxb3'] = False # (m/s^2); Blade 3 local flapwise acceleration (absolute) of span station 2; Directed along the local xb3-axis +ElastoDyn['Spn2ALyb3'] = False # (m/s^2); Blade 3 local edgewise acceleration (absolute) of span station 2; Directed along the local yb3-axis +ElastoDyn['Spn2ALzb3'] = False # (m/s^2); Blade 3 local axial acceleration (absolute) of span station 2; Directed along the local zb3-axis +ElastoDyn['Spn3ALxb3'] = False # (m/s^2); Blade 3 local flapwise acceleration (absolute) of span station 3; Directed along the local xb3-axis +ElastoDyn['Spn3ALyb3'] = False # (m/s^2); Blade 3 local edgewise acceleration (absolute) of span station 3; Directed along the local yb3-axis +ElastoDyn['Spn3ALzb3'] = False # (m/s^2); Blade 3 local axial acceleration (absolute) of span station 3; Directed along the local zb3-axis +ElastoDyn['Spn4ALxb3'] = False # (m/s^2); Blade 3 local flapwise acceleration (absolute) of span station 4; Directed along the local xb3-axis +ElastoDyn['Spn4ALyb3'] = False # (m/s^2); Blade 3 local edgewise acceleration (absolute) of span station 4; Directed along the local yb3-axis +ElastoDyn['Spn4ALzb3'] = False # (m/s^2); Blade 3 local axial acceleration (absolute) of span station 4; Directed along the local zb3-axis +ElastoDyn['Spn5ALxb3'] = False # (m/s^2); Blade 3 local flapwise acceleration (absolute) of span station 5; Directed along the local xb3-axis +ElastoDyn['Spn5ALyb3'] = False # (m/s^2); Blade 3 local edgewise acceleration (absolute) of span station 5; Directed along the local yb3-axis +ElastoDyn['Spn5ALzb3'] = False # (m/s^2); Blade 3 local axial acceleration (absolute) of span station 5; Directed along the local zb3-axis +ElastoDyn['Spn6ALxb3'] = False # (m/s^2); Blade 3 local flapwise acceleration (absolute) of span station 6; Directed along the local xb3-axis +ElastoDyn['Spn6ALyb3'] = False # (m/s^2); Blade 3 local edgewise acceleration (absolute) of span station 6; Directed along the local yb3-axis +ElastoDyn['Spn6ALzb3'] = False # (m/s^2); Blade 3 local axial acceleration (absolute) of span station 6; Directed along the local zb3-axis +ElastoDyn['Spn7ALxb3'] = False # (m/s^2); Blade 3 local flapwise acceleration (absolute) of span station 7; Directed along the local xb3-axis +ElastoDyn['Spn7ALyb3'] = False # (m/s^2); Blade 3 local edgewise acceleration (absolute) of span station 7; Directed along the local yb3-axis +ElastoDyn['Spn7ALzb3'] = False # (m/s^2); Blade 3 local axial acceleration (absolute) of span station 7; Directed along the local zb3-axis +ElastoDyn['Spn8ALxb3'] = False # (m/s^2); Blade 3 local flapwise acceleration (absolute) of span station 8; Directed along the local xb3-axis +ElastoDyn['Spn8ALyb3'] = False # (m/s^2); Blade 3 local edgewise acceleration (absolute) of span station 8; Directed along the local yb3-axis +ElastoDyn['Spn8ALzb3'] = False # (m/s^2); Blade 3 local axial acceleration (absolute) of span station 8; Directed along the local zb3-axis +ElastoDyn['Spn9ALxb3'] = False # (m/s^2); Blade 3 local flapwise acceleration (absolute) of span station 9; Directed along the local xb3-axis +ElastoDyn['Spn9ALyb3'] = False # (m/s^2); Blade 3 local edgewise acceleration (absolute) of span station 9; Directed along the local yb3-axis +ElastoDyn['Spn9ALzb3'] = False # (m/s^2); Blade 3 local axial acceleration (absolute) of span station 9; Directed along the local zb3-axis +ElastoDyn['Spn1ALgxb3'] = False # (m/s^2); Blade 3 local flapwise acceleration (relative to g) of span station 1; Directed along the local xb3-axis +ElastoDyn['Spn1ALgyb3'] = False # (m/s^2); Blade 3 local edgewise acceleration (relative to g) of span station 1; Directed along the local yb3-axis +ElastoDyn['Spn1ALgzb3'] = False # (m/s^2); Blade 3 local axial acceleration (relative to g) of span station 1; Directed along the local zb3-axis +ElastoDyn['Spn2ALgxb3'] = False # (m/s^2); Blade 3 local flapwise acceleration (relative to g) of span station 2; Directed along the local xb3-axis +ElastoDyn['Spn2ALgyb3'] = False # (m/s^2); Blade 3 local edgewise acceleration (relative to g) of span station 2; Directed along the local yb3-axis +ElastoDyn['Spn2ALgzb3'] = False # (m/s^2); Blade 3 local axial acceleration (relative to g) of span station 2; Directed along the local zb3-axis +ElastoDyn['Spn3ALgxb3'] = False # (m/s^2); Blade 3 local flapwise acceleration (relative to g) of span station 3; Directed along the local xb3-axis +ElastoDyn['Spn3ALgyb3'] = False # (m/s^2); Blade 3 local edgewise acceleration (relative to g) of span station 3; Directed along the local yb3-axis +ElastoDyn['Spn3ALgzb3'] = False # (m/s^2); Blade 3 local axial acceleration (relative to g) of span station 3; Directed along the local zb3-axis +ElastoDyn['Spn4ALgxb3'] = False # (m/s^2); Blade 3 local flapwise acceleration (relative to g) of span station 4; Directed along the local xb3-axis +ElastoDyn['Spn4ALgyb3'] = False # (m/s^2); Blade 3 local edgewise acceleration (relative to g) of span station 4; Directed along the local yb3-axis +ElastoDyn['Spn4ALgzb3'] = False # (m/s^2); Blade 3 local axial acceleration (relative to g) of span station 4; Directed along the local zb3-axis +ElastoDyn['Spn5ALgxb3'] = False # (m/s^2); Blade 3 local flapwise acceleration (relative to g) of span station 5; Directed along the local xb3-axis +ElastoDyn['Spn5ALgyb3'] = False # (m/s^2); Blade 3 local edgewise acceleration (relative to g) of span station 5; Directed along the local yb3-axis +ElastoDyn['Spn5ALgzb3'] = False # (m/s^2); Blade 3 local axial acceleration (relative to g) of span station 5; Directed along the local zb3-axis +ElastoDyn['Spn6ALgxb3'] = False # (m/s^2); Blade 3 local flapwise acceleration (relative to g) of span station 6; Directed along the local xb3-axis +ElastoDyn['Spn6ALgyb3'] = False # (m/s^2); Blade 3 local edgewise acceleration (relative to g) of span station 6; Directed along the local yb3-axis +ElastoDyn['Spn6ALgzb3'] = False # (m/s^2); Blade 3 local axial acceleration (relative to g) of span station 6; Directed along the local zb3-axis +ElastoDyn['Spn7ALgxb3'] = False # (m/s^2); Blade 3 local flapwise acceleration (relative to g) of span station 7; Directed along the local xb3-axis +ElastoDyn['Spn7ALgyb3'] = False # (m/s^2); Blade 3 local edgewise acceleration (relative to g) of span station 7; Directed along the local yb3-axis +ElastoDyn['Spn7ALgzb3'] = False # (m/s^2); Blade 3 local axial acceleration (relative to g) of span station 7; Directed along the local zb3-axis +ElastoDyn['Spn8ALgxb3'] = False # (m/s^2); Blade 3 local flapwise acceleration (relative to g) of span station 8; Directed along the local xb3-axis +ElastoDyn['Spn8ALgyb3'] = False # (m/s^2); Blade 3 local edgewise acceleration (relative to g) of span station 8; Directed along the local yb3-axis +ElastoDyn['Spn8ALgzb3'] = False # (m/s^2); Blade 3 local axial acceleration (relative to g) of span station 8; Directed along the local zb3-axis +ElastoDyn['Spn9ALgxb3'] = False # (m/s^2); Blade 3 local flapwise acceleration (relative to g) of span station 9; Directed along the local xb3-axis +ElastoDyn['Spn9ALgyb3'] = False # (m/s^2); Blade 3 local edgewise acceleration (relative to g) of span station 9; Directed along the local yb3-axis +ElastoDyn['Spn9ALgzb3'] = False # (m/s^2); Blade 3 local axial acceleration (relative to g) of span station 9; Directed along the local zb3-axis +ElastoDyn['Spn1TDxb3'] = False # (m); Blade 3 local flapwise (translational) deflection (relative to the undeflected position) of span station 1; Directed along the xb3-axis +ElastoDyn['Spn1TDyb3'] = False # (m); Blade 3 local edgewise (translational) deflection (relative to the undeflected position) of span station 1; Directed along the yb3-axis +ElastoDyn['Spn1TDzb3'] = False # (m); Blade 3 local axial (translational) deflection (relative to the undeflected position) of span station 1; Directed along the zb3-axis +ElastoDyn['Spn2TDxb3'] = False # (m); Blade 3 local flapwise (translational) deflection (relative to the undeflected position) of span station 2; Directed along the xb3-axis +ElastoDyn['Spn2TDyb3'] = False # (m); Blade 3 local edgewise (translational) deflection (relative to the undeflected position) of span station 2; Directed along the yb3-axis +ElastoDyn['Spn2TDzb3'] = False # (m); Blade 3 local axial (translational) deflection (relative to the undeflected position) of span station 2; Directed along the zb3-axis +ElastoDyn['Spn3TDxb3'] = False # (m); Blade 3 local flapwise (translational) deflection (relative to the undeflected position) of span station 3; Directed along the xb3-axis +ElastoDyn['Spn3TDyb3'] = False # (m); Blade 3 local edgewise (translational) deflection (relative to the undeflected position) of span station 3; Directed along the yb3-axis +ElastoDyn['Spn3TDzb3'] = False # (m); Blade 3 local axial (translational) deflection (relative to the undeflected position) of span station 3; Directed along the zb3-axis +ElastoDyn['Spn4TDxb3'] = False # (m); Blade 3 local flapwise (translational) deflection (relative to the undeflected position) of span station 4; Directed along the xb3-axis +ElastoDyn['Spn4TDyb3'] = False # (m); Blade 3 local edgewise (translational) deflection (relative to the undeflected position) of span station 4; Directed along the yb3-axis +ElastoDyn['Spn4TDzb3'] = False # (m); Blade 3 local axial (translational) deflection (relative to the undeflected position) of span station 4; Directed along the zb3-axis +ElastoDyn['Spn5TDxb3'] = False # (m); Blade 3 local flapwise (translational) deflection (relative to the undeflected position) of span station 5; Directed along the xb3-axis +ElastoDyn['Spn5TDyb3'] = False # (m); Blade 3 local edgewise (translational) deflection (relative to the undeflected position) of span station 5; Directed along the yb3-axis +ElastoDyn['Spn5TDzb3'] = False # (m); Blade 3 local axial (translational) deflection (relative to the undeflected position) of span station 5; Directed along the zb3-axis +ElastoDyn['Spn6TDxb3'] = False # (m); Blade 3 local flapwise (translational) deflection (relative to the undeflected position) of span station 6; Directed along the xb3-axis +ElastoDyn['Spn6TDyb3'] = False # (m); Blade 3 local edgewise (translational) deflection (relative to the undeflected position) of span station 6; Directed along the yb3-axis +ElastoDyn['Spn6TDzb3'] = False # (m); Blade 3 local axial (translational) deflection (relative to the undeflected position) of span station 6; Directed along the zb3-axis +ElastoDyn['Spn7TDxb3'] = False # (m); Blade 3 local flapwise (translational) deflection (relative to the undeflected position) of span station 7; Directed along the xb3-axis +ElastoDyn['Spn7TDyb3'] = False # (m); Blade 3 local edgewise (translational) deflection (relative to the undeflected position) of span station 7; Directed along the yb3-axis +ElastoDyn['Spn7TDzb3'] = False # (m); Blade 3 local axial (translational) deflection (relative to the undeflected position) of span station 7; Directed along the zb3-axis +ElastoDyn['Spn8TDxb3'] = False # (m); Blade 3 local flapwise (translational) deflection (relative to the undeflected position) of span station 8; Directed along the xb3-axis +ElastoDyn['Spn8TDyb3'] = False # (m); Blade 3 local edgewise (translational) deflection (relative to the undeflected position) of span station 8; Directed along the yb3-axis +ElastoDyn['Spn8TDzb3'] = False # (m); Blade 3 local axial (translational) deflection (relative to the undeflected position) of span station 8; Directed along the zb3-axis +ElastoDyn['Spn9TDxb3'] = False # (m); Blade 3 local flapwise (translational) deflection (relative to the undeflected position) of span station 9; Directed along the xb3-axis +ElastoDyn['Spn9TDyb3'] = False # (m); Blade 3 local edgewise (translational) deflection (relative to the undeflected position) of span station 9; Directed along the yb3-axis +ElastoDyn['Spn9TDzb3'] = False # (m); Blade 3 local axial (translational) deflection (relative to the undeflected position) of span station 9; Directed along the zb3-axis +ElastoDyn['Spn1RDxb3'] = False # (deg); Blade 3 local roll (angular/rotational) deflection (relative to the undeflected position) of span station 1. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local xb3-axis +ElastoDyn['Spn1RDyb3'] = False # (deg); Blade 3 local pitch (angular/rotational) deflection (relative to the undeflected position) of span station 1. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local yb3-axis +ElastoDyn['Spn1RDzb3'] = False # (deg); Blade 3 local torsional (angular/rotational) deflection (relative to the undeflected position) of span station 1. This output will always be zero for FAST simulation results. Use it for examining blade torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. Please note that this output uses the opposite of the sign convention used for blade pitch angles.; About the local zb3-axis +ElastoDyn['Spn2RDxb3'] = False # (deg); Blade 3 local roll (angular/rotational) deflection (relative to the undeflected position) of span station 2. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local xb3-axis +ElastoDyn['Spn2RDyb3'] = False # (deg); Blade 3 local pitch (angular/rotational) deflection (relative to the undeflected position) of span station 2. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local yb3-axis +ElastoDyn['Spn2RDzb3'] = False # (deg); Blade 3 local torsional (angular/rotational) deflection (relative to the undeflected position) of span station 2. This output will always be zero for FAST simulation results. Use it for examining blade torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. Please note that this output uses the opposite of the sign convention used for blade pitch angles.; About the local zb3-axis +ElastoDyn['Spn3RDxb3'] = False # (deg); Blade 3 local roll (angular/rotational) deflection (relative to the undeflected position) of span station 3. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local xb3-axis +ElastoDyn['Spn3RDyb3'] = False # (deg); Blade 3 local pitch (angular/rotational) deflection (relative to the undeflected position) of span station 3. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local yb3-axis +ElastoDyn['Spn3RDzb3'] = False # (deg); Blade 3 local torsional (angular/rotational) deflection (relative to the undeflected position) of span station 3. This output will always be zero for FAST simulation results. Use it for examining blade torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. Please note that this output uses the opposite of the sign convention used for blade pitch angles.; About the local zb3-axis +ElastoDyn['Spn4RDxb3'] = False # (deg); Blade 3 local roll (angular/rotational) deflection (relative to the undeflected position) of span station 4. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local xb3-axis +ElastoDyn['Spn4RDyb3'] = False # (deg); Blade 3 local pitch (angular/rotational) deflection (relative to the undeflected position) of span station 4. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local yb3-axis +ElastoDyn['Spn4RDzb3'] = False # (deg); Blade 3 local torsional (angular/rotational) deflection (relative to the undeflected position) of span station 4. This output will always be zero for FAST simulation results. Use it for examining blade torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. Please note that this output uses the opposite of the sign convention used for blade pitch angles.; About the local zb3-axis +ElastoDyn['Spn5RDxb3'] = False # (deg); Blade 3 local roll (angular/rotational) deflection (relative to the undeflected position) of span station 5. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local xb3-axis +ElastoDyn['Spn5RDyb3'] = False # (deg); Blade 3 local pitch (angular/rotational) deflection (relative to the undeflected position) of span station 5. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local yb3-axis +ElastoDyn['Spn5RDzb3'] = False # (deg); Blade 3 local torsional (angular/rotational) deflection (relative to the undeflected position) of span station 5. This output will always be zero for FAST simulation results. Use it for examining blade torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. Please note that this output uses the opposite of the sign convention used for blade pitch angles.; About the local zb3-axis +ElastoDyn['Spn6RDxb3'] = False # (deg); Blade 3 local roll (angular/rotational) deflection (relative to the undeflected position) of span station 6. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local xb3-axis +ElastoDyn['Spn6RDyb3'] = False # (deg); Blade 3 local pitch (angular/rotational) deflection (relative to the undeflected position) of span station 6. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local yb3-axis +ElastoDyn['Spn6RDzb3'] = False # (deg); Blade 3 local torsional (angular/rotational) deflection (relative to the undeflected position) of span station 6. This output will always be zero for FAST simulation results. Use it for examining blade torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. Please note that this output uses the opposite of the sign convention used for blade pitch angles.; About the local zb3-axis +ElastoDyn['Spn7RDxb3'] = False # (deg); Blade 3 local roll (angular/rotational) deflection (relative to the undeflected position) of span station 7. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local xb3-axis +ElastoDyn['Spn7RDyb3'] = False # (deg); Blade 3 local pitch (angular/rotational) deflection (relative to the undeflected position) of span station 7. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local yb3-axis +ElastoDyn['Spn7RDzb3'] = False # (deg); Blade 3 local torsional (angular/rotational) deflection (relative to the undeflected position) of span station 7. This output will always be zero for FAST simulation results. Use it for examining blade torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. Please note that this output uses the opposite of the sign convention used for blade pitch angles.; About the local zb3-axis +ElastoDyn['Spn8RDxb3'] = False # (deg); Blade 3 local roll (angular/rotational) deflection (relative to the undeflected position) of span station 8. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local xb3-axis +ElastoDyn['Spn8RDyb3'] = False # (deg); Blade 3 local pitch (angular/rotational) deflection (relative to the undeflected position) of span station 8. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local yb3-axis +ElastoDyn['Spn8RDzb3'] = False # (deg); Blade 3 local torsional (angular/rotational) deflection (relative to the undeflected position) of span station 8. This output will always be zero for FAST simulation results. Use it for examining blade torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. Please note that this output uses the opposite of the sign convention used for blade pitch angles.; About the local zb3-axis +ElastoDyn['Spn9RDxb3'] = False # (deg); Blade 3 local roll (angular/rotational) deflection (relative to the undeflected position) of span station 9. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local xb3-axis +ElastoDyn['Spn9RDyb3'] = False # (deg); Blade 3 local pitch (angular/rotational) deflection (relative to the undeflected position) of span station 9. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local yb3-axis +ElastoDyn['Spn9RDzb3'] = False # (deg); Blade 3 local torsional (angular/rotational) deflection (relative to the undeflected position) of span station 9. This output will always be zero for FAST simulation results. Use it for examining blade torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. Please note that this output uses the opposite of the sign convention used for blade pitch angles.; About the local zb3-axis + +# Blade Pitch Motions +ElastoDyn['PtchPMzc1'] = False # (deg); Blade 1 pitch angle (position); Positive towards feather about the minus zc1- and minus zb1-axes +ElastoDyn['PtchPMzb1'] = False # (deg); Blade 1 pitch angle (position); Positive towards feather about the minus zc1- and minus zb1-axes +ElastoDyn['BldPitch1'] = False # (deg); Blade 1 pitch angle (position); Positive towards feather about the minus zc1- and minus zb1-axes +ElastoDyn['BlPitch1'] = False # (deg); Blade 1 pitch angle (position); Positive towards feather about the minus zc1- and minus zb1-axes +ElastoDyn['PtchPMzc2'] = False # (deg); Blade 2 pitch angle (position); Positive towards feather about the minus zc2- and minus zb2-axes +ElastoDyn['PtchPMzb2'] = False # (deg); Blade 2 pitch angle (position); Positive towards feather about the minus zc2- and minus zb2-axes +ElastoDyn['BldPitch2'] = False # (deg); Blade 2 pitch angle (position); Positive towards feather about the minus zc2- and minus zb2-axes +ElastoDyn['BlPitch2'] = False # (deg); Blade 2 pitch angle (position); Positive towards feather about the minus zc2- and minus zb2-axes +ElastoDyn['PtchPMzc3'] = False # (deg); Blade 3 pitch angle (position); Positive towards feather about the minus zc3- and minus zb3-axes +ElastoDyn['PtchPMzb3'] = False # (deg); Blade 3 pitch angle (position); Positive towards feather about the minus zc3- and minus zb3-axes +ElastoDyn['BldPitch3'] = False # (deg); Blade 3 pitch angle (position); Positive towards feather about the minus zc3- and minus zb3-axes +ElastoDyn['BlPitch3'] = False # (deg); Blade 3 pitch angle (position); Positive towards feather about the minus zc3- and minus zb3-axes + +# Teeter Motions +ElastoDyn['TeetPya'] = False # (deg); Rotor teeter angle (position); About the ya-axis +ElastoDyn['RotTeetP'] = False # (deg); Rotor teeter angle (position); About the ya-axis +ElastoDyn['TeetDefl'] = False # (deg); Rotor teeter angle (position); About the ya-axis +ElastoDyn['TeetVya'] = False # (deg/s); Rotor teeter angular velocity; About the ya-axis +ElastoDyn['RotTeetV'] = False # (deg/s); Rotor teeter angular velocity; About the ya-axis +ElastoDyn['TeetAya'] = False # (deg/s^2); Rotor teeter angular acceleration; About the ya-axis +ElastoDyn['RotTeetA'] = False # (deg/s^2); Rotor teeter angular acceleration; About the ya-axis + +# Shaft Motions +ElastoDyn['LSSTipPxa'] = False # (deg); Rotor azimuth angle (position); About the xa- and xs-axes +ElastoDyn['LSSTipPxs'] = False # (deg); Rotor azimuth angle (position); About the xa- and xs-axes +ElastoDyn['LSSTipP'] = False # (deg); Rotor azimuth angle (position); About the xa- and xs-axes +ElastoDyn['Azimuth'] = False # (deg); Rotor azimuth angle (position); About the xa- and xs-axes +ElastoDyn['LSSTipVxa'] = False # (rpm); Rotor azimuth angular speed; About the xa- and xs-axes +ElastoDyn['LSSTipVxs'] = False # (rpm); Rotor azimuth angular speed; About the xa- and xs-axes +ElastoDyn['LSSTipV'] = False # (rpm); Rotor azimuth angular speed; About the xa- and xs-axes +ElastoDyn['RotSpeed'] = False # (rpm); Rotor azimuth angular speed; About the xa- and xs-axes +ElastoDyn['LSSTipAxa'] = False # (deg/s^2); Rotor azimuth angular acceleration; About the xa- and xs-axes +ElastoDyn['LSSTipAxs'] = False # (deg/s^2); Rotor azimuth angular acceleration; About the xa- and xs-axes +ElastoDyn['LSSTipA'] = False # (deg/s^2); Rotor azimuth angular acceleration; About the xa- and xs-axes +ElastoDyn['RotAccel'] = False # (deg/s^2); Rotor azimuth angular acceleration; About the xa- and xs-axes +ElastoDyn['LSSGagPxa'] = False # (deg); Low-speed shaft strain gage azimuth angle (position) (on the gearbox side of the low-speed shaft); About the xa- and xs-axes +ElastoDyn['LSSGagPxs'] = False # (deg); Low-speed shaft strain gage azimuth angle (position) (on the gearbox side of the low-speed shaft); About the xa- and xs-axes +ElastoDyn['LSSGagP'] = False # (deg); Low-speed shaft strain gage azimuth angle (position) (on the gearbox side of the low-speed shaft); About the xa- and xs-axes +ElastoDyn['LSSGagVxa'] = False # (rpm); Low-speed shaft strain gage angular speed (on the gearbox side of the low-speed shaft); About the xa- and xs-axes +ElastoDyn['LSSGagVxs'] = False # (rpm); Low-speed shaft strain gage angular speed (on the gearbox side of the low-speed shaft); About the xa- and xs-axes +ElastoDyn['LSSGagV'] = False # (rpm); Low-speed shaft strain gage angular speed (on the gearbox side of the low-speed shaft); About the xa- and xs-axes +ElastoDyn['LSSGagAxa'] = False # (deg/s^2); Low-speed shaft strain gage angular acceleration (on the gearbox side of the low-speed shaft); About the xa- and xs-axes +ElastoDyn['LSSGagAxs'] = False # (deg/s^2); Low-speed shaft strain gage angular acceleration (on the gearbox side of the low-speed shaft); About the xa- and xs-axes +ElastoDyn['LSSGagA'] = False # (deg/s^2); Low-speed shaft strain gage angular acceleration (on the gearbox side of the low-speed shaft); About the xa- and xs-axes +ElastoDyn['HSShftV'] = False # (rpm); Angular speed of the high-speed shaft and generator; Same sign as LSSGagVxa / LSSGagVxs / LSSGagV +ElastoDyn['GenSpeed'] = False # (rpm); Angular speed of the high-speed shaft and generator; Same sign as LSSGagVxa / LSSGagVxs / LSSGagV +ElastoDyn['HSShftA'] = False # (deg/s^2); Angular acceleration of the high-speed shaft and generator; Same sign as LSSGagAxa / LSSGagAxs / LSSGagA +ElastoDyn['GenAccel'] = False # (deg/s^2); Angular acceleration of the high-speed shaft and generator; Same sign as LSSGagAxa / LSSGagAxs / LSSGagA + +# Nacelle IMU Motions +ElastoDyn['NcIMUTVxs'] = False # (m/s); Nacelle inertial measurement unit translational velocity (absolute); Directed along the xs-axis +ElastoDyn['NcIMUTVys'] = False # (m/s); Nacelle inertial measurement unit translational velocity (absolute); Directed along the ys-axis +ElastoDyn['NcIMUTVzs'] = False # (m/s); Nacelle inertial measurement unit translational velocity (absolute); Directed along the zs-axis +ElastoDyn['NcIMUTAxs'] = False # (m/s^2); Nacelle inertial measurement unit translational acceleration (absolute); Directed along the xs-axis +ElastoDyn['NcIMUTAys'] = False # (m/s^2); Nacelle inertial measurement unit translational acceleration (absolute); Directed along the ys-axis +ElastoDyn['NcIMUTAzs'] = False # (m/s^2); Nacelle inertial measurement unit translational acceleration (absolute); Directed along the zs-axis +ElastoDyn['NcIMUTAgxs'] = False # (m/s^2); Nacelle inertial measurement unit translational acceleration (relative to g); Directed along the xs-axis +ElastoDyn['NcIMUTAgys'] = False # (m/s^2); Nacelle inertial measurement unit translational acceleration (relative to g); Directed along the ys-axis +ElastoDyn['NcIMUTAgzs'] = False # (m/s^2); Nacelle inertial measurement unit translational acceleration (relative to g); Directed along the zs-axis +ElastoDyn['NcIMURVxs'] = False # (deg/s); Nacelle inertial measurement unit angular (rotational) velocity (absolute); About the xs-axis +ElastoDyn['NcIMURVys'] = False # (deg/s); Nacelle inertial measurement unit angular (rotational) velocity (absolute); About the ys-axis +ElastoDyn['NcIMURVzs'] = False # (deg/s); Nacelle inertial measurement unit angular (rotational) velocity (absolute); About the zs-axis +ElastoDyn['NcIMURAxs'] = False # (deg/s^2); Nacelle inertial measurement unit angular (rotational) acceleration (absolute); About the xs-axis +ElastoDyn['NcIMURAys'] = False # (deg/s^2); Nacelle inertial measurement unit angular (rotational) acceleration (absolute); About the ys-axis +ElastoDyn['NcIMURAzs'] = False # (deg/s^2); Nacelle inertial measurement unit angular (rotational) acceleration (absolute); About the zs-axis + +# Rotor-Furl Motions +ElastoDyn['RotFurlP'] = False # (deg); Rotor-furl angle (position); About the rotor-furl axis +ElastoDyn['RotFurl'] = False # (deg); Rotor-furl angle (position); About the rotor-furl axis +ElastoDyn['RotFurlV'] = False # (deg/s); Rotor-furl angular velocity; About the rotor-furl axis +ElastoDyn['RotFurlA'] = False # (deg/s^2); Rotor-furl angular acceleration; About the rotor-furl axis + +# Tail-Furl Motions +ElastoDyn['TailFurlP'] = False # (deg); Tail-furl angle (position); About the tail-furl axis +ElastoDyn['TailFurl'] = False # (deg); Tail-furl angle (position); About the tail-furl axis +ElastoDyn['TailFurlV'] = False # (deg/s); Tail-furl angular velocity; About the tail-furl axis +ElastoDyn['TailFurlA'] = False # (deg/s^2); Tail-furl angular acceleration; About the tail-furl axis + +# Nacelle Yaw Motions +ElastoDyn['YawPzn'] = False # (deg); Nacelle yaw angle (position); About the zn- and zp-axes +ElastoDyn['YawPzp'] = False # (deg); Nacelle yaw angle (position); About the zn- and zp-axes +ElastoDyn['NacYawP'] = False # (deg); Nacelle yaw angle (position); About the zn- and zp-axes +ElastoDyn['NacYaw'] = False # (deg); Nacelle yaw angle (position); About the zn- and zp-axes +ElastoDyn['YawPos'] = False # (deg); Nacelle yaw angle (position); About the zn- and zp-axes +ElastoDyn['YawVzn'] = False # (deg/s); Nacelle yaw angular velocity; About the zn- and zp-axes +ElastoDyn['YawVzp'] = False # (deg/s); Nacelle yaw angular velocity; About the zn- and zp-axes +ElastoDyn['NacYawV'] = False # (deg/s); Nacelle yaw angular velocity; About the zn- and zp-axes +ElastoDyn['YawRate'] = False # (deg/s); Nacelle yaw angular velocity; About the zn- and zp-axes +ElastoDyn['YawAzn'] = False # (deg/s^2); Nacelle yaw angular acceleration; About the zn- and zp-axes +ElastoDyn['YawAzp'] = False # (deg/s^2); Nacelle yaw angular acceleration; About the zn- and zp-axes +ElastoDyn['NacYawA'] = False # (deg/s^2); Nacelle yaw angular acceleration; About the zn- and zp-axes +ElastoDyn['YawAccel'] = False # (deg/s^2); Nacelle yaw angular acceleration; About the zn- and zp-axes + +# Tower-Top / Yaw Bearing Motions +ElastoDyn['TwrTpTDxi'] = False # (m); Tower-top / yaw bearing fore-aft (translational) deflection (relative to the undeflected position) including all platform motions; Directed along the xi-axis +ElastoDyn['YawBrTDxi'] = False # (m); Tower-top / yaw bearing fore-aft (translational) deflection (relative to the undeflected position) including all platform motions; Directed along the xi-axis +ElastoDyn['TwrTpTDyi'] = False # (m); Tower-top / yaw bearing side-to-side (translational) deflection (relative to the undeflected position) including all platform motions; Directed along the yi-axis +ElastoDyn['YawBrTDyi'] = False # (m); Tower-top / yaw bearing side-to-side (translational) deflection (relative to the undeflected position) including all platform motions; Directed along the yi-axis +ElastoDyn['TwrTpTDzi'] = False # (m); Tower-top / yaw bearing axial (translational) deflection (relative to the undeflected position) including all platform motions; Directed along the zi-axis +ElastoDyn['YawBrTDzi'] = False # (m); Tower-top / yaw bearing axial (translational) deflection (relative to the undeflected position) including all platform motions; Directed along the zi-axis +ElastoDyn['YawBrTDxp'] = False # (m); Tower-top / yaw bearing fore-aft (translational) deflection (relative to the undeflected position); Directed along the xp-axis +ElastoDyn['YawBrTDyp'] = False # (m); Tower-top / yaw bearing side-to-side (translational) deflection (relative to the undeflected position); Directed along the yp-axis +ElastoDyn['YawBrTDzp'] = False # (m); Tower-top / yaw bearing axial (translational) deflection (relative to the undeflected position); Directed along the zp-axis +ElastoDyn['YawBrTDxt'] = False # (m); Tower-top / yaw bearing fore-aft (translational) deflection (relative to the undeflected position); Directed along the xt-axis +ElastoDyn['TTDspFA'] = False # (m); Tower-top / yaw bearing fore-aft (translational) deflection (relative to the undeflected position); Directed along the xt-axis +ElastoDyn['YawBrTDyt'] = False # (m); Tower-top / yaw bearing side-to-side (translation) deflection (relative to the undeflected position); Directed along the yt-axis +ElastoDyn['TTDspSS'] = False # (m); Tower-top / yaw bearing side-to-side (translation) deflection (relative to the undeflected position); Directed along the yt-axis +ElastoDyn['YawBrTDzt'] = False # (m); Tower-top / yaw bearing axial (translational) deflection (relative to the undeflected position); Directed along the zt-axis +ElastoDyn['TTDspAx'] = False # (m); Tower-top / yaw bearing axial (translational) deflection (relative to the undeflected position); Directed along the zt-axis +ElastoDyn['YawBrTVxp'] = False # (m/s); Tower-top / yaw bearing fore-aft (translational) velocity (absolute); Directed along the xp-axis +ElastoDyn['YawBrTVyp'] = False # (m/s); Tower-top / yaw bearing side-to-side (translational) velocity (absolute); Directed along the yp-axis +ElastoDyn['YawBrTVzp'] = False # (m/s); Tower-top / yaw bearing axial (translational) velocity (absolute); Directed along the zp-axis +ElastoDyn['YawBrTAxp'] = False # (m/s^2); Tower-top / yaw bearing fore-aft (translational) acceleration (absolute); Directed along the xp-axis +ElastoDyn['YawBrTAyp'] = False # (m/s^2); Tower-top / yaw bearing side-to-side (translational) acceleration (absolute); Directed along the yp-axis +ElastoDyn['YawBrTAzp'] = False # (m/s^2); Tower-top / yaw bearing axial (translational) acceleration (absolute); Directed along the zp-axis +ElastoDyn['YawBrTAgxp'] = False # (m/s^2); Tower-top / yaw bearing fore-aft (translational) acceleration (relative to g); Directed along the xp-axis +ElastoDyn['YawBrTAgyp'] = False # (m/s^2); Tower-top / yaw bearing side-to-side (translational) acceleration (relative to g); Directed along the yp-axis +ElastoDyn['YawBrTAgzp'] = False # (m/s^2); Tower-top / yaw bearing axial (translational) acceleration (relative to g); Directed along the zp-axis +ElastoDyn['YawBrRDxt'] = False # (deg); Tower-top / yaw bearing angular (rotational) roll deflection (relative to the undeflected position). In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower deflections, so that the rotation sequence does not matter.; About the xt-axis +ElastoDyn['TTDspRoll'] = False # (deg); Tower-top / yaw bearing angular (rotational) roll deflection (relative to the undeflected position). In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower deflections, so that the rotation sequence does not matter.; About the xt-axis +ElastoDyn['YawBrRDyt'] = False # (deg); Tower-top / yaw bearing angular (rotational) pitch deflection (relative to the undeflected position). In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower deflections, so that the rotation sequence does not matter.; About the yt-axis +ElastoDyn['TTDspPtch'] = False # (deg); Tower-top / yaw bearing angular (rotational) pitch deflection (relative to the undeflected position). In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower deflections, so that the rotation sequence does not matter.; About the yt-axis +ElastoDyn['YawBrRDzt'] = False # (deg); Tower-top / yaw bearing angular (rotational) torsion deflection (relative to the undeflected position). This output will always be zero for FAST simulation results. Use it for examining tower torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence.; About the zt-axis +ElastoDyn['TTDspTwst'] = False # (deg); Tower-top / yaw bearing angular (rotational) torsion deflection (relative to the undeflected position). This output will always be zero for FAST simulation results. Use it for examining tower torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence.; About the zt-axis +ElastoDyn['YawBrRVxp'] = False # (deg/s); Tower-top / yaw bearing angular (rotational) roll velocity (absolute); About the xp-axis +ElastoDyn['YawBrRVyp'] = False # (deg/s); Tower-top / yaw bearing angular (rotational) pitch velocity (absolute); About the yp-axis +ElastoDyn['YawBrRVzp'] = False # (deg/s); Tower-top / yaw bearing angular (rotational) torsion velocity. This output will always be very close to zero for FAST simulation results. Use it for examining tower torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. (absolute); About the zp-axis +ElastoDyn['YawBrRAxp'] = False # (deg/s^2); Tower-top / yaw bearing angular (rotational) roll acceleration (absolute); About the xp-axis +ElastoDyn['YawBrRAyp'] = False # (deg/s^2); Tower-top / yaw bearing angular (rotational) pitch acceleration (absolute); About the yp-axis +ElastoDyn['YawBrRAzp'] = False # (deg/s^2); Tower-top / yaw bearing angular (rotational) torsion acceleration. This output will always be very close to zero for FAST simulation results. Use it for examining tower torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. (absolute); About the zp-axis + +# Local Tower Motions +ElastoDyn['TwHt1ALxt'] = False # (m/s^2); Local tower fore-aft (translational) acceleration (absolute) of tower gage 1 ; Directed along the local xt-axis +ElastoDyn['TwHt1ALyt'] = False # (m/s^2); Local tower side-to-side (translational) acceleration (absolute) of tower gage 1 ; Directed along the local yt-axis +ElastoDyn['TwHt1ALzt'] = False # (m/s^2); Local tower axial (translational) acceleration (absolute) of tower gage 1 ; Directed along the local zt-axis +ElastoDyn['TwHt2ALxt'] = False # (m/s^2); Local tower fore-aft (translational) acceleration (absolute) of tower gage 2; Directed along the local xt-axis +ElastoDyn['TwHt2ALyt'] = False # (m/s^2); Local tower side-to-side (translational) acceleration (absolute) of tower gage 2; Directed along the local yt-axis +ElastoDyn['TwHt2ALzt'] = False # (m/s^2); Local tower axial (translational) acceleration (absolute) of tower gage 2; Directed along the local zt-axis +ElastoDyn['TwHt3ALxt'] = False # (m/s^2); Local tower fore-aft (translational) acceleration (absolute) of tower gage 3; Directed along the local xt-axis +ElastoDyn['TwHt3ALyt'] = False # (m/s^2); Local tower side-to-side (translational) acceleration (absolute) of tower gage 3; Directed along the local yt-axis +ElastoDyn['TwHt3ALzt'] = False # (m/s^2); Local tower axial (translational) acceleration (absolute) of tower gage 3; Directed along the local zt-axis +ElastoDyn['TwHt4ALxt'] = False # (m/s^2); Local tower fore-aft (translational) acceleration (absolute) of tower gage 4; Directed along the local xt-axis +ElastoDyn['TwHt4ALyt'] = False # (m/s^2); Local tower side-to-side (translational) acceleration (absolute) of tower gage 4; Directed along the local yt-axis +ElastoDyn['TwHt4ALzt'] = False # (m/s^2); Local tower axial (translational) acceleration (absolute) of tower gage 4; Directed along the local zt-axis +ElastoDyn['TwHt5ALxt'] = False # (m/s^2); Local tower fore-aft (translational) acceleration (absolute) of tower gage 5; Directed along the local xt-axis +ElastoDyn['TwHt5ALyt'] = False # (m/s^2); Local tower side-to-side (translational) acceleration (absolute) of tower gage 5; Directed along the local yt-axis +ElastoDyn['TwHt5ALzt'] = False # (m/s^2); Local tower axial (translational) acceleration (absolute) of tower gage 5; Directed along the local zt-axis +ElastoDyn['TwHt6ALxt'] = False # (m/s^2); Local tower fore-aft (translational) acceleration (absolute) of tower gage 6; Directed along the local xt-axis +ElastoDyn['TwHt6ALyt'] = False # (m/s^2); Local tower side-to-side (translational) acceleration (absolute) of tower gage 6; Directed along the local yt-axis +ElastoDyn['TwHt6ALzt'] = False # (m/s^2); Local tower axial (translational) acceleration (absolute) of tower gage 6; Directed along the local zt-axis +ElastoDyn['TwHt7ALxt'] = False # (m/s^2); Local tower fore-aft (translational) acceleration (absolute) of tower gage 7; Directed along the local xt-axis +ElastoDyn['TwHt7ALyt'] = False # (m/s^2); Local tower side-to-side (translational) acceleration (absolute) of tower gage 7; Directed along the local yt-axis +ElastoDyn['TwHt7ALzt'] = False # (m/s^2); Local tower axial (translational) acceleration (absolute) of tower gage 7; Directed along the local zt-axis +ElastoDyn['TwHt8ALxt'] = False # (m/s^2); Local tower fore-aft (translational) acceleration (absolute) of tower gage 8; Directed along the local xt-axis +ElastoDyn['TwHt8ALyt'] = False # (m/s^2); Local tower side-to-side (translational) acceleration (absolute) of tower gage 8; Directed along the local yt-axis +ElastoDyn['TwHt8ALzt'] = False # (m/s^2); Local tower axial (translational) acceleration (absolute) of tower gage 8; Directed along the local zt-axis +ElastoDyn['TwHt9ALxt'] = False # (m/s^2); Local tower fore-aft (translational) acceleration (absolute) of tower gage 9; Directed along the local xt-axis +ElastoDyn['TwHt9ALyt'] = False # (m/s^2); Local tower side-to-side (translational) acceleration (absolute) of tower gage 9; Directed along the local yt-axis +ElastoDyn['TwHt9ALzt'] = False # (m/s^2); Local tower axial (translational) acceleration (absolute) of tower gage 9; Directed along the local zt-axis +ElastoDyn['TwHt1ALgxt'] = False # (m/s^2); Local tower fore-aft (translational) acceleration (relative to g) of tower gage 1 ; Directed along the local xt-axis +ElastoDyn['TwHt1ALgyt'] = False # (m/s^2); Local tower side-to-side (translational) acceleration (relative to g) of tower gage 1 ; Directed along the local yt-axis +ElastoDyn['TwHt1ALgzt'] = False # (m/s^2); Local tower axial (translational) acceleration (relative to g) of tower gage 1 ; Directed along the local zt-axis +ElastoDyn['TwHt2ALgxt'] = False # (m/s^2); Local tower fore-aft (translational) acceleration (relative to g) of tower gage 2; Directed along the local xt-axis +ElastoDyn['TwHt2ALgyt'] = False # (m/s^2); Local tower side-to-side (translational) acceleration (relative to g) of tower gage 2; Directed along the local yt-axis +ElastoDyn['TwHt2ALgzt'] = False # (m/s^2); Local tower axial (translational) acceleration (relative to g) of tower gage 2; Directed along the local zt-axis +ElastoDyn['TwHt3ALgxt'] = False # (m/s^2); Local tower fore-aft (translational) acceleration (relative to g) of tower gage 3; Directed along the local xt-axis +ElastoDyn['TwHt3ALgyt'] = False # (m/s^2); Local tower side-to-side (translational) acceleration (relative to g) of tower gage 3; Directed along the local yt-axis +ElastoDyn['TwHt3ALgzt'] = False # (m/s^2); Local tower axial (translational) acceleration (relative to g) of tower gage 3; Directed along the local zt-axis +ElastoDyn['TwHt4ALgxt'] = False # (m/s^2); Local tower fore-aft (translational) acceleration (relative to g) of tower gage 4; Directed along the local xt-axis +ElastoDyn['TwHt4ALgyt'] = False # (m/s^2); Local tower side-to-side (translational) acceleration (relative to g) of tower gage 4; Directed along the local yt-axis +ElastoDyn['TwHt4ALgzt'] = False # (m/s^2); Local tower axial (translational) acceleration (relative to g) of tower gage 4; Directed along the local zt-axis +ElastoDyn['TwHt5ALgxt'] = False # (m/s^2); Local tower fore-aft (translational) acceleration (relative to g) of tower gage 5; Directed along the local xt-axis +ElastoDyn['TwHt5ALgyt'] = False # (m/s^2); Local tower side-to-side (translational) acceleration (relative to g) of tower gage 5; Directed along the local yt-axis +ElastoDyn['TwHt5ALgzt'] = False # (m/s^2); Local tower axial (translational) acceleration (relative to g) of tower gage 5; Directed along the local zt-axis +ElastoDyn['TwHt6ALgxt'] = False # (m/s^2); Local tower fore-aft (translational) acceleration (relative to g) of tower gage 6; Directed along the local xt-axis +ElastoDyn['TwHt6ALgyt'] = False # (m/s^2); Local tower side-to-side (translational) acceleration (relative to g) of tower gage 6; Directed along the local yt-axis +ElastoDyn['TwHt6ALgzt'] = False # (m/s^2); Local tower axial (translational) acceleration (relative to g) of tower gage 6; Directed along the local zt-axis +ElastoDyn['TwHt7ALgxt'] = False # (m/s^2); Local tower fore-aft (translational) acceleration (relative to g) of tower gage 7; Directed along the local xt-axis +ElastoDyn['TwHt7ALgyt'] = False # (m/s^2); Local tower side-to-side (translational) acceleration (relative to g) of tower gage 7; Directed along the local yt-axis +ElastoDyn['TwHt7ALgzt'] = False # (m/s^2); Local tower axial (translational) acceleration (relative to g) of tower gage 7; Directed along the local zt-axis +ElastoDyn['TwHt8ALgxt'] = False # (m/s^2); Local tower fore-aft (translational) acceleration (relative to g) of tower gage 8; Directed along the local xt-axis +ElastoDyn['TwHt8ALgyt'] = False # (m/s^2); Local tower side-to-side (translational) acceleration (relative to g) of tower gage 8; Directed along the local yt-axis +ElastoDyn['TwHt8ALgzt'] = False # (m/s^2); Local tower axial (translational) acceleration (relative to g) of tower gage 8; Directed along the local zt-axis +ElastoDyn['TwHt9ALgxt'] = False # (m/s^2); Local tower fore-aft (translational) acceleration (relative to g) of tower gage 9; Directed along the local xt-axis +ElastoDyn['TwHt9ALgyt'] = False # (m/s^2); Local tower side-to-side (translational) acceleration (relative to g) of tower gage 9; Directed along the local yt-axis +ElastoDyn['TwHt9ALgzt'] = False # (m/s^2); Local tower axial (translational) acceleration (relative to g) of tower gage 9; Directed along the local zt-axis +ElastoDyn['TwHt1TDxt'] = False # (m); Local tower fore-aft (translational) deflection (relative to the undeflected position) of tower gage 1; Directed along the local xt-axis +ElastoDyn['TwHt1TDyt'] = False # (m); Local tower side-to-side (translational) deflection (relative to the undeflected position) of tower gage 1; Directed along the local yt-axis +ElastoDyn['TwHt1TDzt'] = False # (m); Local tower axial (translational) deflection (relative to the undeflected position) of tower gage 1; Directed along the local zt-axis +ElastoDyn['TwHt2TDxt'] = False # (m); Local tower fore-aft (translational) deflection (relative to the undeflected position) of tower gage 2; Directed along the local xt-axis +ElastoDyn['TwHt2TDyt'] = False # (m); Local tower side-to-side (translational) deflection (relative to the undeflected position) of tower gage 2; Directed along the local yt-axis +ElastoDyn['TwHt2TDzt'] = False # (m); Local tower axial (translational) deflection (relative to the undeflected position) of tower gage 2; Directed along the local zt-axis +ElastoDyn['TwHt3TDxt'] = False # (m); Local tower fore-aft (translational) deflection (relative to the undeflected position) of tower gage 3; Directed along the local xt-axis +ElastoDyn['TwHt3TDyt'] = False # (m); Local tower side-to-side (translational) deflection (relative to the undeflected position) of tower gage 3; Directed along the local yt-axis +ElastoDyn['TwHt3TDzt'] = False # (m); Local tower axial (translational) deflection (relative to the undeflected position) of tower gage 3; Directed along the local zt-axis +ElastoDyn['TwHt4TDxt'] = False # (m); Local tower fore-aft (translational) deflection (relative to the undeflected position) of tower gage 4; Directed along the local xt-axis +ElastoDyn['TwHt4TDyt'] = False # (m); Local tower side-to-side (translational) deflection (relative to the undeflected position) of tower gage 4; Directed along the local yt-axis +ElastoDyn['TwHt4TDzt'] = False # (m); Local tower axial (translational) deflection (relative to the undeflected position) of tower gage 4; Directed along the local zt-axis +ElastoDyn['TwHt5TDxt'] = False # (m); Local tower fore-aft (translational) deflection (relative to the undeflected position) of tower gage 5; Directed along the local xt-axis +ElastoDyn['TwHt5TDyt'] = False # (m); Local tower side-to-side (translational) deflection (relative to the undeflected position) of tower gage 5; Directed along the local yt-axis +ElastoDyn['TwHt5TDzt'] = False # (m); Local tower axial (translational) deflection (relative to the undeflected position) of tower gage 5; Directed along the local zt-axis +ElastoDyn['TwHt6TDxt'] = False # (m); Local tower fore-aft (translational) deflection (relative to the undeflected position) of tower gage 6; Directed along the local xt-axis +ElastoDyn['TwHt6TDyt'] = False # (m); Local tower side-to-side (translational) deflection (relative to the undeflected position) of tower gage 6; Directed along the local yt-axis +ElastoDyn['TwHt6TDzt'] = False # (m); Local tower axial (translational) deflection (relative to the undeflected position) of tower gage 6; Directed along the local zt-axis +ElastoDyn['TwHt7TDxt'] = False # (m); Local tower fore-aft (translational) deflection (relative to the undeflected position) of tower gage 7; Directed along the local xt-axis +ElastoDyn['TwHt7TDyt'] = False # (m); Local tower side-to-side (translational) deflection (relative to the undeflected position) of tower gage 7; Directed along the local yt-axis +ElastoDyn['TwHt7TDzt'] = False # (m); Local tower axial (translational) deflection (relative to the undeflected position) of tower gage 7; Directed along the local zt-axis +ElastoDyn['TwHt8TDxt'] = False # (m); Local tower fore-aft (translational) deflection (relative to the undeflected position) of tower gage 8; Directed along the local xt-axis +ElastoDyn['TwHt8TDyt'] = False # (m); Local tower side-to-side (translational) deflection (relative to the undeflected position) of tower gage 8; Directed along the local yt-axis +ElastoDyn['TwHt8TDzt'] = False # (m); Local tower axial (translational) deflection (relative to the undeflected position) of tower gage 8; Directed along the local zt-axis +ElastoDyn['TwHt9TDxt'] = False # (m); Local tower fore-aft (translational) deflection (relative to the undeflected position) of tower gage 9; Directed along the local xt-axis +ElastoDyn['TwHt9TDyt'] = False # (m); Local tower side-to-side (translational) deflection (relative to the undeflected position) of tower gage 9; Directed along the local yt-axis +ElastoDyn['TwHt9TDzt'] = False # (m); Local tower axial (translational) deflection (relative to the undeflected position) of tower gage 9; Directed along the local zt-axis +ElastoDyn['TwHt1RDxt'] = False # (deg); Local tower angular (rotational) roll deflection (relative to the undeflected position) of tower gage 1. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower deflections, so that the rotation sequence does not matter.; About the local xt-axis +ElastoDyn['TwHt1RDyt'] = False # (deg); Local tower angular (rotational) pitch deflection (relative to the undeflected position) of tower gage 1. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower deflections, so that the rotation sequence does not matter.; About the local yt-axis +ElastoDyn['TwHt1RDzt'] = False # (deg); Local tower angular (rotational) torsion deflection (relative to the undeflected position) of tower gage 1. This output will always be zero for FAST simulation results. Use it for examining tower torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence.; About the local zt-axis +ElastoDyn['TwHt2RDxt'] = False # (deg); Local tower angular (rotational) roll deflection (relative to the undeflected position) of tower gage 2. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower deflections, so that the rotation sequence does not matter.; About the local xt-axis +ElastoDyn['TwHt2RDyt'] = False # (deg); Local tower angular (rotational) pitch deflection (relative to the undeflected position) of tower gage 2. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower deflections, so that the rotation sequence does not matter.; About the local yt-axis +ElastoDyn['TwHt2RDzt'] = False # (deg); Local tower angular (rotational) torsion deflection (relative to the undeflected position) of tower gage 2. This output will always be zero for FAST simulation results. Use it for examining tower torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence.; About the local zt-axis +ElastoDyn['TwHt3RDxt'] = False # (deg); Local tower angular (rotational) roll deflection (relative to the undeflected position) of tower gage 3. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower deflections, so that the rotation sequence does not matter.; About the local xt-axis +ElastoDyn['TwHt3RDyt'] = False # (deg); Local tower angular (rotational) pitch deflection (relative to the undeflected position) of tower gage 3. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower deflections, so that the rotation sequence does not matter.; About the local yt-axis +ElastoDyn['TwHt3RDzt'] = False # (deg); Local tower angular (rotational) torsion deflection (relative to the undeflected position) of tower gage 3. This output will always be zero for FAST simulation results. Use it for examining tower torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence.; About the local zt-axis +ElastoDyn['TwHt4RDxt'] = False # (deg); Local tower angular (rotational) roll deflection (relative to the undeflected position) of tower gage 4. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower deflections, so that the rotation sequence does not matter.; About the local xt-axis +ElastoDyn['TwHt4RDyt'] = False # (deg); Local tower angular (rotational) pitch deflection (relative to the undeflected position) of tower gage 4. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower deflections, so that the rotation sequence does not matter.; About the local yt-axis +ElastoDyn['TwHt4RDzt'] = False # (deg); Local tower angular (rotational) torsion deflection (relative to the undeflected position) of tower gage 4. This output will always be zero for FAST simulation results. Use it for examining tower torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence.; About the local zt-axis +ElastoDyn['TwHt5RDxt'] = False # (deg); Local tower angular (rotational) roll deflection (relative to the undeflected position) of tower gage 5. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower deflections, so that the rotation sequence does not matter.; About the local xt-axis +ElastoDyn['TwHt5RDyt'] = False # (deg); Local tower angular (rotational) pitch deflection (relative to the undeflected position) of tower gage 5. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower deflections, so that the rotation sequence does not matter.; About the local yt-axis +ElastoDyn['TwHt5RDzt'] = False # (deg); Local tower angular (rotational) torsion deflection (relative to the undeflected position) of tower gage 5. This output will always be zero for FAST simulation results. Use it for examining tower torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence.; About the local zt-axis +ElastoDyn['TwHt6RDxt'] = False # (deg); Local tower angular (rotational) roll deflection (relative to the undeflected position) of tower gage 6. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower deflections, so that the rotation sequence does not matter.; About the local xt-axis +ElastoDyn['TwHt6RDyt'] = False # (deg); Local tower angular (rotational) pitch deflection (relative to the undeflected position) of tower gage 6. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower deflections, so that the rotation sequence does not matter.; About the local yt-axis +ElastoDyn['TwHt6RDzt'] = False # (deg); Local tower angular (rotational) torsion deflection (relative to the undeflected position) of tower gage 6. This output will always be zero for FAST simulation results. Use it for examining tower torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence.; About the local zt-axis +ElastoDyn['TwHt7RDxt'] = False # (deg); Local tower angular (rotational) roll deflection (relative to the undeflected position) of tower gage 7. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower deflections, so that the rotation sequence does not matter.; About the local xt-axis +ElastoDyn['TwHt7RDyt'] = False # (deg); Local tower angular (rotational) pitch deflection (relative to the undeflected position) of tower gage 7. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower deflections, so that the rotation sequence does not matter.; About the local yt-axis +ElastoDyn['TwHt7RDzt'] = False # (deg); Local tower angular (rotational) torsion deflection (relative to the undeflected position) of tower gage 7. This output will always be zero for FAST simulation results. Use it for examining tower torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence.; About the local zt-axis +ElastoDyn['TwHt8RDxt'] = False # (deg); Local tower angular (rotational) roll deflection (relative to the undeflected position) of tower gage 8. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower deflections, so that the rotation sequence does not matter.; About the local xt-axis +ElastoDyn['TwHt8RDyt'] = False # (deg); Local tower angular (rotational) pitch deflection (relative to the undeflected position) of tower gage 8. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower deflections, so that the rotation sequence does not matter.; About the local yt-axis +ElastoDyn['TwHt8RDzt'] = False # (deg); Local tower angular (rotational) torsion deflection (relative to the undeflected position) of tower gage 8. This output will always be zero for FAST simulation results. Use it for examining tower torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence.; About the local zt-axis +ElastoDyn['TwHt9RDxt'] = False # (deg); Local tower angular (rotational) roll deflection (relative to the undeflected position) of tower gage 9. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower deflections, so that the rotation sequence does not matter.; About the local xt-axis +ElastoDyn['TwHt9RDyt'] = False # (deg); Local tower angular (rotational) pitch deflection (relative to the undeflected position) of tower gage 9. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower deflections, so that the rotation sequence does not matter.; About the local yt-axis +ElastoDyn['TwHt9RDzt'] = False # (deg); Local tower angular (rotational) torsion deflection (relative to the undeflected position) of tower gage 9. This output will always be zero for FAST simulation results. Use it for examining tower torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence.; About the local zt-axis +ElastoDyn['TwHt1TPxi'] = False # (m); xi-component of the translational position (relative to the inertia frame) of tower gage 1; Directed along the local xi-axis +ElastoDyn['TwHt1TPyi'] = False # (m); yi-component of the translational position (relative to the inertia frame) of tower gage 1; Directed along the local yi-axis +ElastoDyn['TwHt1TPzi'] = False # (m); zi-component of the translational position (relative to ground level [onshore] or MSL [offshore]) of tower gage 1; Directed along the local zi-axis +ElastoDyn['TwHt2TPxi'] = False # (m); xi-component of the translational position (relative to the inertia frame) of tower gage 2; Directed along the local xi-axis +ElastoDyn['TwHt2TPyi'] = False # (m); yi-component of the translational position (relative to the inertia frame) of tower gage 2; Directed along the local yi-axis +ElastoDyn['TwHt2TPzi'] = False # (m); zi-component of the translational position (relative to ground level [onshore] or MSL [offshore]) of tower gage 2; Directed along the local zi-axis +ElastoDyn['TwHt3TPxi'] = False # (m); xi-component of the translational position (relative to the inertia frame) of tower gage 3; Directed along the local xi-axis +ElastoDyn['TwHt3TPyi'] = False # (m); yi-component of the translational position (relative to the inertia frame) of tower gage 3; Directed along the local yi-axis +ElastoDyn['TwHt3TPzi'] = False # (m); zi-component of the translational position (relative to ground level [onshore] or MSL [offshore]) of tower gage 3; Directed along the local zi-axis +ElastoDyn['TwHt4TPxi'] = False # (m); xi-component of the translational position (relative to the inertia frame) of tower gage 4; Directed along the local xi-axis +ElastoDyn['TwHt4TPyi'] = False # (m); yi-component of the translational position (relative to the inertia frame) of tower gage 4; Directed along the local yi-axis +ElastoDyn['TwHt4TPzi'] = False # (m); zi-component of the translational position (relative to ground level [onshore] or MSL [offshore]) of tower gage 4; Directed along the local zi-axis +ElastoDyn['TwHt5TPxi'] = False # (m); xi-component of the translational position (relative to the inertia frame) of tower gage 5; Directed along the local xi-axis +ElastoDyn['TwHt5TPyi'] = False # (m); yi-component of the translational position (relative to the inertia frame) of tower gage 5; Directed along the local yi-axis +ElastoDyn['TwHt5TPzi'] = False # (m); zi-component of the translational position (relative to ground level [onshore] or MSL [offshore]) of tower gage 5; Directed along the local zi-axis +ElastoDyn['TwHt6TPxi'] = False # (m); xi-component of the translational position (relative to the inertia frame) of tower gage 6; Directed along the local xi-axis +ElastoDyn['TwHt6TPyi'] = False # (m); yi-component of the translational position (relative to the inertia frame) of tower gage 6; Directed along the local yi-axis +ElastoDyn['TwHt6TPzi'] = False # (m); zi-component of the translational position (relative to ground level [onshore] or MSL [offshore]) of tower gage 6; Directed along the local zi-axis +ElastoDyn['TwHt7TPxi'] = False # (m); xi-component of the translational position (relative to the inertia frame) of tower gage 7; Directed along the local xi-axis +ElastoDyn['TwHt7TPyi'] = False # (m); yi-component of the translational position (relative to the inertia frame) of tower gage 7; Directed along the local yi-axis +ElastoDyn['TwHt7TPzi'] = False # (m); zi-component of the translational position (relative to ground level [onshore] or MSL [offshore]) of tower gage 7; Directed along the local zi-axis +ElastoDyn['TwHt8TPxi'] = False # (m); xi-component of the translational position (relative to the inertia frame) of tower gage 8; Directed along the local xi-axis +ElastoDyn['TwHt8TPyi'] = False # (m); yi-component of the translational position (relative to the inertia frame) of tower gage 8; Directed along the local yi-axis +ElastoDyn['TwHt8TPzi'] = False # (m); zi-component of the translational position (relative to ground level [onshore] or MSL [offshore]) of tower gage 8; Directed along the local zi-axis +ElastoDyn['TwHt9TPxi'] = False # (m); xi-component of the translational position (relative to the inertia frame) of tower gage 9; Directed along the local xi-axis +ElastoDyn['TwHt9TPyi'] = False # (m); yi-component of the translational position (relative to the inertia frame) of tower gage 9; Directed along the local yi-axis +ElastoDyn['TwHt9TPzi'] = False # (m); zi-component of the translational position (relative to ground level [onshore] or MSL [offshore]) of tower gage 9; Directed along the local zi-axis +ElastoDyn['TwHt1RPxi'] = False # (deg); xi-component of the rotational position (relative to the inertia frame) of tower gage 1. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower and platform rotational deflections, so that the rotation sequence does not matter.; About the local xi-axis +ElastoDyn['TwHt1RPyi'] = False # (deg); yi-component of the rotational position (relative to the inertia frame) of tower gage 1. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower and platform rotational deflections, so that the rotation sequence does not matter.; About the local yi-axis +ElastoDyn['TwHt1RPzi'] = False # (deg); zi-component of the rotational position (relative to the inertia frame) of tower gage 1. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower and platform rotational deflections, so that the rotation sequence does not matter.; About the local zi-axis +ElastoDyn['TwHt2RPxi'] = False # (deg); xi-component of the rotational position (relative to the inertia frame) of tower gage 2. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower and platform rotational deflections, so that the rotation sequence does not matter.; About the local xi-axis +ElastoDyn['TwHt2RPyi'] = False # (deg); yi-component of the rotational position (relative to the inertia frame) of tower gage 2. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower and platform rotational deflections, so that the rotation sequence does not matter.; About the local yi-axis +ElastoDyn['TwHt2RPzi'] = False # (deg); zi-component of the rotational position (relative to the inertia frame) of tower gage 2. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower and platform rotational deflections, so that the rotation sequence does not matter.; About the local zi-axis +ElastoDyn['TwHt3RPxi'] = False # (deg); xi-component of the rotational position (relative to the inertia frame) of tower gage 3. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower and platform rotational deflections, so that the rotation sequence does not matter.; About the local xi-axis +ElastoDyn['TwHt3RPyi'] = False # (deg); yi-component of the rotational position (relative to the inertia frame) of tower gage 3. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower and platform rotational deflections, so that the rotation sequence does not matter.; About the local yi-axis +ElastoDyn['TwHt3RPzi'] = False # (deg); zi-component of the rotational position (relative to the inertia frame) of tower gage 3. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower and platform rotational deflections, so that the rotation sequence does not matter.; About the local zi-axis +ElastoDyn['TwHt4RPxi'] = False # (deg); xi-component of the rotational position (relative to the inertia frame) of tower gage 4. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower and platform rotational deflections, so that the rotation sequence does not matter.; About the local xi-axis +ElastoDyn['TwHt4RPyi'] = False # (deg); yi-component of the rotational position (relative to the inertia frame) of tower gage 4. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower and platform rotational deflections, so that the rotation sequence does not matter.; About the local yi-axis +ElastoDyn['TwHt4RPzi'] = False # (deg); zi-component of the rotational position (relative to the inertia frame) of tower gage 4. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower and platform rotational deflections, so that the rotation sequence does not matter.; About the local zi-axis +ElastoDyn['TwHt5RPxi'] = False # (deg); xi-component of the rotational position (relative to the inertia frame) of tower gage 5. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower and platform rotational deflections, so that the rotation sequence does not matter.; About the local xi-axis +ElastoDyn['TwHt5RPyi'] = False # (deg); yi-component of the rotational position (relative to the inertia frame) of tower gage 5. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower and platform rotational deflections, so that the rotation sequence does not matter.; About the local yi-axis +ElastoDyn['TwHt5RPzi'] = False # (deg); zi-component of the rotational position (relative to the inertia frame) of tower gage 5. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower and platform rotational deflections, so that the rotation sequence does not matter.; About the local zi-axis +ElastoDyn['TwHt6RPxi'] = False # (deg); xi-component of the rotational position (relative to the inertia frame) of tower gage 6. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower and platform rotational deflections, so that the rotation sequence does not matter.; About the local xi-axis +ElastoDyn['TwHt6RPyi'] = False # (deg); yi-component of the rotational position (relative to the inertia frame) of tower gage 6. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower and platform rotational deflections, so that the rotation sequence does not matter.; About the local yi-axis +ElastoDyn['TwHt6RPzi'] = False # (deg); zi-component of the rotational position (relative to the inertia frame) of tower gage 6. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower and platform rotational deflections, so that the rotation sequence does not matter.; About the local zi-axis +ElastoDyn['TwHt7RPxi'] = False # (deg); xi-component of the rotational position (relative to the inertia frame) of tower gage 7. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower and platform rotational deflections, so that the rotation sequence does not matter.; About the local xi-axis +ElastoDyn['TwHt7RPyi'] = False # (deg); yi-component of the rotational position (relative to the inertia frame) of tower gage 7. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower and platform rotational deflections, so that the rotation sequence does not matter.; About the local yi-axis +ElastoDyn['TwHt7RPzi'] = False # (deg); zi-component of the rotational position (relative to the inertia frame) of tower gage 7. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower and platform rotational deflections, so that the rotation sequence does not matter.; About the local zi-axis +ElastoDyn['TwHt8RPxi'] = False # (deg); xi-component of the rotational position (relative to the inertia frame) of tower gage 8. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower and platform rotational deflections, so that the rotation sequence does not matter.; About the local xi-axis +ElastoDyn['TwHt8RPyi'] = False # (deg); yi-component of the rotational position (relative to the inertia frame) of tower gage 8. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower and platform rotational deflections, so that the rotation sequence does not matter.; About the local yi-axis +ElastoDyn['TwHt8RPzi'] = False # (deg); zi-component of the rotational position (relative to the inertia frame) of tower gage 8. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower and platform rotational deflections, so that the rotation sequence does not matter.; About the local zi-axis +ElastoDyn['TwHt9RPxi'] = False # (deg); xi-component of the rotational position (relative to the inertia frame) of tower gage 9. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower and platform rotational deflections, so that the rotation sequence does not matter.; About the local xi-axis +ElastoDyn['TwHt9RPyi'] = False # (deg); yi-component of the rotational position (relative to the inertia frame) of tower gage 9. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower and platform rotational deflections, so that the rotation sequence does not matter.; About the local yi-axis +ElastoDyn['TwHt9RPzi'] = False # (deg); zi-component of the rotational position (relative to the inertia frame) of tower gage 9. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower and platform rotational deflections, so that the rotation sequence does not matter.; About the local zi-axis + +# Platform Motions +ElastoDyn['PtfmTDxt'] = False # (m); Platform horizontal surge (translational) displacement; Directed along the xt-axis +ElastoDyn['PtfmTDyt'] = False # (m); Platform horizontal sway (translational) displacement; Directed along the yt-axis +ElastoDyn['PtfmTDzt'] = False # (m); Platform vertical heave (translational) displacement; Directed along the zt-axis +ElastoDyn['PtfmTDxi'] = False # (m); Platform horizontal surge (translational) displacement; Directed along the xi-axis +ElastoDyn['PtfmSurge'] = False # (m); Platform horizontal surge (translational) displacement; Directed along the xi-axis +ElastoDyn['PtfmTDyi'] = False # (m); Platform horizontal sway (translational) displacement; Directed along the yi-axis +ElastoDyn['PtfmSway'] = False # (m); Platform horizontal sway (translational) displacement; Directed along the yi-axis +ElastoDyn['PtfmTDzi'] = False # (m); Platform vertical heave (translational) displacement; Directed along the zi-axis +ElastoDyn['PtfmHeave'] = False # (m); Platform vertical heave (translational) displacement; Directed along the zi-axis +ElastoDyn['PtfmTVxt'] = False # (m/s); Platform horizontal surge (translational) velocity; Directed along the xt-axis +ElastoDyn['PtfmTVyt'] = False # (m/s); Platform horizontal sway (translational) velocity; Directed along the yt-axis +ElastoDyn['PtfmTVzt'] = False # (m/s); Platform vertical heave (translational) velocity; Directed along the zt-axis +ElastoDyn['PtfmTVxi'] = False # (m/s); Platform horizontal surge (translational) velocity; Directed along the xi-axis +ElastoDyn['PtfmTVyi'] = False # (m/s); Platform horizontal sway (translational) velocity; Directed along the yi-axis +ElastoDyn['PtfmTVzi'] = False # (m/s); Platform vertical heave (translational) velocity; Directed along the zi-axis +ElastoDyn['PtfmTAxt'] = False # (m/s^2); Platform horizontal surge (translational) acceleration; Directed along the xt-axis +ElastoDyn['PtfmTAyt'] = False # (m/s^2); Platform horizontal sway (translational) acceleration; Directed along the yt-axis +ElastoDyn['PtfmTAzt'] = False # (m/s^2); Platform vertical heave (translational) acceleration; Directed along the zt-axis +ElastoDyn['PtfmTAgxt'] = False # (m/s^2); Platform horizontal surge (translational) acceleration relative to g; Directed along the xt-axis +ElastoDyn['PtfmTAgyt'] = False # (m/s^2); Platform horizontal sway (translational) acceleration relative to g; Directed along the yt-axis +ElastoDyn['PtfmTAgzt'] = False # (m/s^2); Platform vertical heave (translational) acceleration relative to g; Directed along the zt-axis +ElastoDyn['PtfmTAxi'] = False # (m/s^2); Platform horizontal surge (translational) acceleration; Directed along the xi-axis +ElastoDyn['PtfmTAyi'] = False # (m/s^2); Platform horizontal sway (translational) acceleration; Directed along the yi-axis +ElastoDyn['PtfmTAzi'] = False # (m/s^2); Platform vertical heave (translational) acceleration; Directed along the zi-axis +ElastoDyn['PtfmTAgxi'] = False # (m/s^2); Platform horizontal surge (translational) acceleration relative to g; Directed along the xi-axis +ElastoDyn['PtfmTAgyi'] = False # (m/s^2); Platform horizontal sway (translational) acceleration relative to g; Directed along the yi-axis +ElastoDyn['PtfmTAgzi'] = False # (m/s^2); Platform vertical heave (translational) acceleration relative to g; Directed along the zi-axis +ElastoDyn['PtfmRDxi'] = False # (deg); Platform roll tilt angular (rotational) displacement. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small rotational platform displacements, so that the rotation sequence does not matter.; About the xi-axis +ElastoDyn['PtfmRoll'] = False # (deg); Platform roll tilt angular (rotational) displacement. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small rotational platform displacements, so that the rotation sequence does not matter.; About the xi-axis +ElastoDyn['PtfmRDyi'] = False # (deg); Platform pitch tilt angular (rotational) displacement. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small rotational platform displacements, so that the rotation sequence does not matter.; About the yi-axis +ElastoDyn['PtfmPitch'] = False # (deg); Platform pitch tilt angular (rotational) displacement. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small rotational platform displacements, so that the rotation sequence does not matter.; About the yi-axis +ElastoDyn['PtfmRDzi'] = False # (deg); Platform yaw angular (rotational) displacement. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small rotational platform displacements, so that the rotation sequence does not matter.; About the zi-axis +ElastoDyn['PtfmYaw'] = False # (deg); Platform yaw angular (rotational) displacement. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small rotational platform displacements, so that the rotation sequence does not matter.; About the zi-axis +ElastoDyn['PtfmRVxt'] = False # (deg/s); Platform roll tilt angular (rotational) velocity; About the xt-axis +ElastoDyn['PtfmRVyt'] = False # (deg/s); Platform pitch tilt angular (rotational) velocity; About the yt-axis +ElastoDyn['PtfmRVzt'] = False # (deg/s); Platform yaw angular (rotational) velocity; About the zt-axis +ElastoDyn['PtfmRVxi'] = False # (deg/s); Platform roll tilt angular (rotational) velocity; About the xi-axis +ElastoDyn['PtfmRVyi'] = False # (deg/s); Platform pitch tilt angular (rotational) velocity; About the yi-axis +ElastoDyn['PtfmRVzi'] = False # (deg/s); Platform yaw angular (rotational) velocity; About the zi-axis +ElastoDyn['PtfmRAxt'] = False # (deg/s^2); Platform roll tilt angular (rotational) acceleration; About the xt-axis +ElastoDyn['PtfmRAyt'] = False # (deg/s^2); Platform pitch tilt angular (rotational) acceleration; About the yt-axis +ElastoDyn['PtfmRAzt'] = False # (deg/s^2); Platform yaw angular (rotational) acceleration; About the zt-axis +ElastoDyn['PtfmRAxi'] = False # (deg/s^2); Platform roll tilt angular (rotational) acceleration; About the xi-axis +ElastoDyn['PtfmRAyi'] = False # (deg/s^2); Platform pitch tilt angular (rotational) acceleration; About the yi-axis +ElastoDyn['PtfmRAzi'] = False # (deg/s^2); Platform yaw angular (rotational) acceleration; About the zi-axis + +# Blade 1 Root Loads +ElastoDyn['RootFxc1'] = False # (kN); Blade 1 out-of-plane shear force at the blade root; Directed along the xc1-axis +ElastoDyn['RootFyc1'] = False # (kN); Blade 1 in-plane shear force at the blade root; Directed along the yc1-axis +ElastoDyn['RootFzc1'] = False # (kN); Blade 1 axial force at the blade root; Directed along the zc1- and zb1-axes +ElastoDyn['RootFzb1'] = False # (kN); Blade 1 axial force at the blade root; Directed along the zc1- and zb1-axes +ElastoDyn['RootFxb1'] = False # (kN); Blade 1 flapwise shear force at the blade root; Directed along the xb1-axis +ElastoDyn['RootFyb1'] = False # (kN); Blade 1 edgewise shear force at the blade root; Directed along the yb1-axis +ElastoDyn['RootMxc1'] = False # (kN-m); Blade 1 in-plane moment (i.e., the moment caused by in-plane forces) at the blade root; About the xc1-axis +ElastoDyn['RootMIP1'] = False # (kN-m); Blade 1 in-plane moment (i.e., the moment caused by in-plane forces) at the blade root; About the xc1-axis +ElastoDyn['RootMyc1'] = False # (kN-m); Blade 1 out-of-plane moment (i.e., the moment caused by out-of-plane forces) at the blade root; About the yc1-axis +ElastoDyn['RootMOoP1'] = False # (kN-m); Blade 1 out-of-plane moment (i.e., the moment caused by out-of-plane forces) at the blade root; About the yc1-axis +ElastoDyn['RootMzc1'] = False # (kN-m); Blade 1 pitching moment at the blade root; About the zc1- and zb1-axes +ElastoDyn['RootMzb1'] = False # (kN-m); Blade 1 pitching moment at the blade root; About the zc1- and zb1-axes +ElastoDyn['RootMxb1'] = False # (kN-m); Blade 1 edgewise moment (i.e., the moment caused by edgewise forces) at the blade root; About the xb1-axis +ElastoDyn['RootMEdg1'] = False # (kN-m); Blade 1 edgewise moment (i.e., the moment caused by edgewise forces) at the blade root; About the xb1-axis +ElastoDyn['RootMyb1'] = True # (kN-m); Blade 1 flapwise moment (i.e., the moment caused by flapwise forces) at the blade root; About the yb1-axis +ElastoDyn['RootMFlp1'] = False # (kN-m); Blade 1 flapwise moment (i.e., the moment caused by flapwise forces) at the blade root; About the yb1-axis + +# Blade 2 Root Loads +ElastoDyn['RootFxc2'] = False # (kN); Blade 2 out-of-plane shear force at the blade root; Directed along the xc2-axis +ElastoDyn['RootFyc2'] = False # (kN); Blade 2 in-plane shear force at the blade root; Directed along the yc2-axis +ElastoDyn['RootFzc2'] = False # (kN); Blade 2 axial force at the blade root; Directed along the zc2- and zb2-axes +ElastoDyn['RootFzb2'] = False # (kN); Blade 2 axial force at the blade root; Directed along the zc2- and zb2-axes +ElastoDyn['RootFxb2'] = False # (kN); Blade 2 flapwise shear force at the blade root; Directed along the xb2-axis +ElastoDyn['RootFyb2'] = False # (kN); Blade 2 edgewise shear force at the blade root; Directed along the yb2-axis +ElastoDyn['RootMxc2'] = False # (kN-m); Blade 2 in-plane moment (i.e., the moment caused by in-plane forces) at the blade root; About the xc2-axis +ElastoDyn['RootMIP2'] = False # (kN-m); Blade 2 in-plane moment (i.e., the moment caused by in-plane forces) at the blade root; About the xc2-axis +ElastoDyn['RootMyc2'] = False # (kN-m); Blade 2 out-of-plane moment (i.e., the moment caused by out-of-plane forces) at the blade root; About the yc2-axis +ElastoDyn['RootMOoP2'] = False # (kN-m); Blade 2 out-of-plane moment (i.e., the moment caused by out-of-plane forces) at the blade root; About the yc2-axis +ElastoDyn['RootMzc2'] = False # (kN-m); Blade 2 pitching moment at the blade root; About the zc2- and zb2-axes +ElastoDyn['RootMzb2'] = False # (kN-m); Blade 2 pitching moment at the blade root; About the zc2- and zb2-axes +ElastoDyn['RootMxb2'] = False # (kN-m); Blade 2 edgewise moment (i.e., the moment caused by edgewise forces) at the blade root; About the xb2-axis +ElastoDyn['RootMEdg2'] = False # (kN-m); Blade 2 edgewise moment (i.e., the moment caused by edgewise forces) at the blade root; About the xb2-axis +ElastoDyn['RootMyb2'] = True # (kN-m); Blade 2 flapwise moment (i.e., the moment caused by flapwise forces) at the blade root; About the yb2-axis +ElastoDyn['RootMFlp2'] = False # (kN-m); Blade 2 flapwise moment (i.e., the moment caused by flapwise forces) at the blade root; About the yb2-axis + +# Blade 3 Root Loads +ElastoDyn['RootFxc3'] = False # (kN); Blade 3 out-of-plane shear force at the blade root; Directed along the xc3-axis +ElastoDyn['RootFyc3'] = False # (kN); Blade 3 in-plane shear force at the blade root; Directed along the yc3-axis +ElastoDyn['RootFzc3'] = False # (kN); Blade 3 axial force at the blade root; Directed along the zc3- and zb3-axes +ElastoDyn['RootFzb3'] = False # (kN); Blade 3 axial force at the blade root; Directed along the zc3- and zb3-axes +ElastoDyn['RootFxb3'] = False # (kN); Blade 3 flapwise shear force at the blade root; Directed along the xb3-axis +ElastoDyn['RootFyb3'] = False # (kN); Blade 3 edgewise shear force at the blade root; Directed along the yb3-axis +ElastoDyn['RootMxc3'] = False # (kN-m); Blade 3 in-plane moment (i.e., the moment caused by in-plane forces) at the blade root; About the xc3-axis +ElastoDyn['RootMIP3'] = False # (kN-m); Blade 3 in-plane moment (i.e., the moment caused by in-plane forces) at the blade root; About the xc3-axis +ElastoDyn['RootMyc3'] = False # (kN-m); Blade 3 out-of-plane moment (i.e., the moment caused by out-of-plane forces) at the blade root; About the yc3-axis +ElastoDyn['RootMOoP3'] = False # (kN-m); Blade 3 out-of-plane moment (i.e., the moment caused by out-of-plane forces) at the blade root; About the yc3-axis +ElastoDyn['RootMzc3'] = False # (kN-m); Blade 3 pitching moment at the blade root; About the zc3- and zb3-axes +ElastoDyn['RootMzb3'] = False # (kN-m); Blade 3 pitching moment at the blade root; About the zc3- and zb3-axes +ElastoDyn['RootMxb3'] = False # (kN-m); Blade 3 edgewise moment (i.e., the moment caused by edgewise forces) at the blade root; About the xb3-axis +ElastoDyn['RootMEdg3'] = False # (kN-m); Blade 3 edgewise moment (i.e., the moment caused by edgewise forces) at the blade root; About the xb3-axis +ElastoDyn['RootMyb3'] = True # (kN-m); Blade 3 flapwise moment (i.e., the moment caused by flapwise forces) at the blade root; About the yb3-axis +ElastoDyn['RootMFlp3'] = False # (kN-m); Blade 3 flapwise moment (i.e., the moment caused by flapwise forces) at the blade root; About the yb3-axis + +# Blade 1 Local Span Loads +ElastoDyn['Spn1MLxb1'] = False # (kN-m); Blade 1 local edgewise moment at span station 1; About the local xb1-axis +ElastoDyn['Spn1MLyb1'] = False # (kN-m); Blade 1 local flapwise moment at span station 1; About the local yb1-axis +ElastoDyn['Spn1MLzb1'] = False # (kN-m); Blade 1 local pitching moment at span station 1; About the local zb1-axis +ElastoDyn['Spn2MLxb1'] = False # (kN-m); Blade 1 local edgewise moment at span station 2; About the local xb1-axis +ElastoDyn['Spn2MLyb1'] = False # (kN-m); Blade 1 local flapwise moment at span station 2; About the local yb1-axis +ElastoDyn['Spn2MLzb1'] = False # (kN-m); Blade 1 local pitching moment at span station 2; About the local zb1-axis +ElastoDyn['Spn3MLxb1'] = False # (kN-m); Blade 1 local edgewise moment at span station 3; About the local xb1-axis +ElastoDyn['Spn3MLyb1'] = False # (kN-m); Blade 1 local flapwise moment at span station 3; About the local yb1-axis +ElastoDyn['Spn3MLzb1'] = False # (kN-m); Blade 1 local pitching moment at span station 3; About the local zb1-axis +ElastoDyn['Spn4MLxb1'] = False # (kN-m); Blade 1 local edgewise moment at span station 4; About the local xb1-axis +ElastoDyn['Spn4MLyb1'] = False # (kN-m); Blade 1 local flapwise moment at span station 4; About the local yb1-axis +ElastoDyn['Spn4MLzb1'] = False # (kN-m); Blade 1 local pitching moment at span station 4; About the local zb1-axis +ElastoDyn['Spn5MLxb1'] = False # (kN-m); Blade 1 local edgewise moment at span station 5; About the local xb1-axis +ElastoDyn['Spn5MLyb1'] = False # (kN-m); Blade 1 local flapwise moment at span station 5; About the local yb1-axis +ElastoDyn['Spn5MLzb1'] = False # (kN-m); Blade 1 local pitching moment at span station 5; About the local zb1-axis +ElastoDyn['Spn6MLxb1'] = False # (kN-m); Blade 1 local edgewise moment at span station 6; About the local xb1-axis +ElastoDyn['Spn6MLyb1'] = False # (kN-m); Blade 1 local flapwise moment at span station 6; About the local yb1-axis +ElastoDyn['Spn6MLzb1'] = False # (kN-m); Blade 1 local pitching moment at span station 6; About the local zb1-axis +ElastoDyn['Spn7MLxb1'] = False # (kN-m); Blade 1 local edgewise moment at span station 7; About the local xb1-axis +ElastoDyn['Spn7MLyb1'] = False # (kN-m); Blade 1 local flapwise moment at span station 7; About the local yb1-axis +ElastoDyn['Spn7MLzb1'] = False # (kN-m); Blade 1 local pitching moment at span station 7; About the local zb1-axis +ElastoDyn['Spn8MLxb1'] = False # (kN-m); Blade 1 local edgewise moment at span station 8; About the local xb1-axis +ElastoDyn['Spn8MLyb1'] = False # (kN-m); Blade 1 local flapwise moment at span station 8; About the local yb1-axis +ElastoDyn['Spn8MLzb1'] = False # (kN-m); Blade 1 local pitching moment at span station 8; About the local zb1-axis +ElastoDyn['Spn9MLxb1'] = False # (kN-m); Blade 1 local edgewise moment at span station 9; About the local xb1-axis +ElastoDyn['Spn9MLyb1'] = False # (kN-m); Blade 1 local flapwise moment at span station 9; About the local yb1-axis +ElastoDyn['Spn9MLzb1'] = False # (kN-m); Blade 1 local pitching moment at span station 9; About the local zb1-axis +ElastoDyn['Spn1FLxb1'] = False # (kN); Blade 1 local flapwise shear force at span station 1; Directed along the local xb1-axis +ElastoDyn['Spn1FLyb1'] = False # (kN); Blade 1 local edgewise shear force at span station 1; Directed along the local yb1-axis +ElastoDyn['Spn1FLzb1'] = False # (kN); Blade 1 local axial force at span station 1; Directed along the local zb1-axis +ElastoDyn['Spn2FLxb1'] = False # (kN); Blade 1 local flapwise shear force at span station 2; Directed along the local xb1-axis +ElastoDyn['Spn2FLyb1'] = False # (kN); Blade 1 local edgewise shear force at span station 2; Directed along the local yb1-axis +ElastoDyn['Spn2FLzb1'] = False # (kN); Blade 1 local axial force at span station 2; Directed along the local zb1-axis +ElastoDyn['Spn3FLxb1'] = False # (kN); Blade 1 local flapwise shear force at span station 3; Directed along the local xb1-axis +ElastoDyn['Spn3FLyb1'] = False # (kN); Blade 1 local edgewise shear force at span station 3; Directed along the local yb1-axis +ElastoDyn['Spn3FLzb1'] = False # (kN); Blade 1 local axial force at span station 3; Directed along the local zb1-axis +ElastoDyn['Spn4FLxb1'] = False # (kN); Blade 1 local flapwise shear force at span station 4; Directed along the local xb1-axis +ElastoDyn['Spn4FLyb1'] = False # (kN); Blade 1 local edgewise shear force at span station 4; Directed along the local yb1-axis +ElastoDyn['Spn4FLzb1'] = False # (kN); Blade 1 local axial force at span station 4; Directed along the local zb1-axis +ElastoDyn['Spn5FLxb1'] = False # (kN); Blade 1 local flapwise shear force at span station 5; Directed along the local xb1-axis +ElastoDyn['Spn5FLyb1'] = False # (kN); Blade 1 local edgewise shear force at span station 5; Directed along the local yb1-axis +ElastoDyn['Spn5FLzb1'] = False # (kN); Blade 1 local axial force at span station 5; Directed along the local zb1-axis +ElastoDyn['Spn6FLxb1'] = False # (kN); Blade 1 local flapwise shear force at span station 6; Directed along the local xb1-axis +ElastoDyn['Spn6FLyb1'] = False # (kN); Blade 1 local edgewise shear force at span station 6; Directed along the local yb1-axis +ElastoDyn['Spn6FLzb1'] = False # (kN); Blade 1 local axial force at span station 6; Directed along the local zb1-axis +ElastoDyn['Spn7FLxb1'] = False # (kN); Blade 1 local flapwise shear force at span station 7; Directed along the local xb1-axis +ElastoDyn['Spn7FLyb1'] = False # (kN); Blade 1 local edgewise shear force at span station 7; Directed along the local yb1-axis +ElastoDyn['Spn7FLzb1'] = False # (kN); Blade 1 local axial force at span station 7; Directed along the local zb1-axis +ElastoDyn['Spn8FLxb1'] = False # (kN); Blade 1 local flapwise shear force at span station 8; Directed along the local xb1-axis +ElastoDyn['Spn8FLyb1'] = False # (kN); Blade 1 local edgewise shear force at span station 8; Directed along the local yb1-axis +ElastoDyn['Spn8FLzb1'] = False # (kN); Blade 1 local axial force at span station 8; Directed along the local zb1-axis +ElastoDyn['Spn9FLxb1'] = False # (kN); Blade 1 local flapwise shear force at span station 9; Directed along the local xb1-axis +ElastoDyn['Spn9FLyb1'] = False # (kN); Blade 1 local edgewise shear force at span station 9; Directed along the local yb1-axis +ElastoDyn['Spn9FLzb1'] = False # (kN); Blade 1 local axial force at span station 9; Directed along the local zb1-axis + +# Blade 2 Local Span Loads +ElastoDyn['Spn1MLxb2'] = False # (kN-m); Blade 2 local edgewise moment at span station 1; About the local xb2-axis +ElastoDyn['Spn1MLyb2'] = False # (kN-m); Blade 2 local flapwise moment at span station 1; About the local yb2-axis +ElastoDyn['Spn1MLzb2'] = False # (kN-m); Blade 2 local pitching moment at span station 1; About the local zb2-axis +ElastoDyn['Spn2MLxb2'] = False # (kN-m); Blade 2 local edgewise moment at span station 2; About the local xb2-axis +ElastoDyn['Spn2MLyb2'] = False # (kN-m); Blade 2 local flapwise moment at span station 2; About the local yb2-axis +ElastoDyn['Spn2MLzb2'] = False # (kN-m); Blade 2 local pitching moment at span station 2; About the local zb2-axis +ElastoDyn['Spn3MLxb2'] = False # (kN-m); Blade 2 local edgewise moment at span station 3; About the local xb2-axis +ElastoDyn['Spn3MLyb2'] = False # (kN-m); Blade 2 local flapwise moment at span station 3; About the local yb2-axis +ElastoDyn['Spn3MLzb2'] = False # (kN-m); Blade 2 local pitching moment at span station 3; About the local zb2-axis +ElastoDyn['Spn4MLxb2'] = False # (kN-m); Blade 2 local edgewise moment at span station 4; About the local xb2-axis +ElastoDyn['Spn4MLyb2'] = False # (kN-m); Blade 2 local flapwise moment at span station 4; About the local yb2-axis +ElastoDyn['Spn4MLzb2'] = False # (kN-m); Blade 2 local pitching moment at span station 4; About the local zb2-axis +ElastoDyn['Spn5MLxb2'] = False # (kN-m); Blade 2 local edgewise moment at span station 5; About the local xb2-axis +ElastoDyn['Spn5MLyb2'] = False # (kN-m); Blade 2 local flapwise moment at span station 5; About the local yb2-axis +ElastoDyn['Spn5MLzb2'] = False # (kN-m); Blade 2 local pitching moment at span station 5; About the local zb2-axis +ElastoDyn['Spn6MLxb2'] = False # (kN-m); Blade 2 local edgewise moment at span station 6; About the local xb2-axis +ElastoDyn['Spn6MLyb2'] = False # (kN-m); Blade 2 local flapwise moment at span station 6; About the local yb2-axis +ElastoDyn['Spn6MLzb2'] = False # (kN-m); Blade 2 local pitching moment at span station 6; About the local zb2-axis +ElastoDyn['Spn7MLxb2'] = False # (kN-m); Blade 2 local edgewise moment at span station 7; About the local xb2-axis +ElastoDyn['Spn7MLyb2'] = False # (kN-m); Blade 2 local flapwise moment at span station 7; About the local yb2-axis +ElastoDyn['Spn7MLzb2'] = False # (kN-m); Blade 2 local pitching moment at span station 7; About the local zb2-axis +ElastoDyn['Spn8MLxb2'] = False # (kN-m); Blade 2 local edgewise moment at span station 8; About the local xb2-axis +ElastoDyn['Spn8MLyb2'] = False # (kN-m); Blade 2 local flapwise moment at span station 8; About the local yb2-axis +ElastoDyn['Spn8MLzb2'] = False # (kN-m); Blade 2 local pitching moment at span station 8; About the local zb2-axis +ElastoDyn['Spn9MLxb2'] = False # (kN-m); Blade 2 local edgewise moment at span station 9; About the local xb2-axis +ElastoDyn['Spn9MLyb2'] = False # (kN-m); Blade 2 local flapwise moment at span station 9; About the local yb2-axis +ElastoDyn['Spn9MLzb2'] = False # (kN-m); Blade 2 local pitching moment at span station 9; About the local zb2-axis +ElastoDyn['Spn1FLxb2'] = False # (kN); Blade 2 local flapwise shear force at span station 1; Directed along the local xb2-axis +ElastoDyn['Spn1FLyb2'] = False # (kN); Blade 2 local edgewise shear force at span station 1; Directed along the local yb2-axis +ElastoDyn['Spn1FLzb2'] = False # (kN); Blade 2 local axial force at span station 1; Directed along the local zb2-axis +ElastoDyn['Spn2FLxb2'] = False # (kN); Blade 2 local flapwise shear force at span station 2; Directed along the local xb2-axis +ElastoDyn['Spn2FLyb2'] = False # (kN); Blade 2 local edgewise shear force at span station 2; Directed along the local yb2-axis +ElastoDyn['Spn2FLzb2'] = False # (kN); Blade 2 local axial force at span station 2; Directed along the local zb2-axis +ElastoDyn['Spn3FLxb2'] = False # (kN); Blade 2 local flapwise shear force at span station 3; Directed along the local xb2-axis +ElastoDyn['Spn3FLyb2'] = False # (kN); Blade 2 local edgewise shear force at span station 3; Directed along the local yb2-axis +ElastoDyn['Spn3FLzb2'] = False # (kN); Blade 2 local axial force at span station 3; Directed along the local zb2-axis +ElastoDyn['Spn4FLxb2'] = False # (kN); Blade 2 local flapwise shear force at span station 4; Directed along the local xb2-axis +ElastoDyn['Spn4FLyb2'] = False # (kN); Blade 2 local edgewise shear force at span station 4; Directed along the local yb2-axis +ElastoDyn['Spn4FLzb2'] = False # (kN); Blade 2 local axial force at span station 4; Directed along the local zb2-axis +ElastoDyn['Spn5FLxb2'] = False # (kN); Blade 2 local flapwise shear force at span station 5; Directed along the local xb2-axis +ElastoDyn['Spn5FLyb2'] = False # (kN); Blade 2 local edgewise shear force at span station 5; Directed along the local yb2-axis +ElastoDyn['Spn5FLzb2'] = False # (kN); Blade 2 local axial force at span station 5; Directed along the local zb2-axis +ElastoDyn['Spn6FLxb2'] = False # (kN); Blade 2 local flapwise shear force at span station 6; Directed along the local xb2-axis +ElastoDyn['Spn6FLyb2'] = False # (kN); Blade 2 local edgewise shear force at span station 6; Directed along the local yb2-axis +ElastoDyn['Spn6FLzb2'] = False # (kN); Blade 2 local axial force at span station 6; Directed along the local zb2-axis +ElastoDyn['Spn7FLxb2'] = False # (kN); Blade 2 local flapwise shear force at span station 7; Directed along the local xb2-axis +ElastoDyn['Spn7FLyb2'] = False # (kN); Blade 2 local edgewise shear force at span station 7; Directed along the local yb2-axis +ElastoDyn['Spn7FLzb2'] = False # (kN); Blade 2 local axial force at span station 7; Directed along the local zb2-axis +ElastoDyn['Spn8FLxb2'] = False # (kN); Blade 2 local flapwise shear force at span station 8; Directed along the local xb2-axis +ElastoDyn['Spn8FLyb2'] = False # (kN); Blade 2 local edgewise shear force at span station 8; Directed along the local yb2-axis +ElastoDyn['Spn8FLzb2'] = False # (kN); Blade 2 local axial force at span station 8; Directed along the local zb2-axis +ElastoDyn['Spn9FLxb2'] = False # (kN); Blade 2 local flapwise shear force at span station 9; Directed along the local xb2-axis +ElastoDyn['Spn9FLyb2'] = False # (kN); Blade 2 local edgewise shear force at span station 9; Directed along the local yb2-axis +ElastoDyn['Spn9FLzb2'] = False # (kN); Blade 2 local axial force at span station 9; Directed along the local zb2-axis + +# Blade 3 Local Span Loads +ElastoDyn['Spn1MLxb3'] = False # (kN-m); Blade 3 local edgewise moment at span station 1; About the local xb3-axis +ElastoDyn['Spn1MLyb3'] = False # (kN-m); Blade 3 local flapwise moment at span station 1; About the local yb3-axis +ElastoDyn['Spn1MLzb3'] = False # (kN-m); Blade 3 local pitching moment at span station 1; About the local zb3-axis +ElastoDyn['Spn2MLxb3'] = False # (kN-m); Blade 3 local edgewise moment at span station 2; About the local xb3-axis +ElastoDyn['Spn2MLyb3'] = False # (kN-m); Blade 3 local flapwise moment at span station 2; About the local yb3-axis +ElastoDyn['Spn2MLzb3'] = False # (kN-m); Blade 3 local pitching moment at span station 2; About the local zb3-axis +ElastoDyn['Spn3MLxb3'] = False # (kN-m); Blade 3 local edgewise moment at span station 3; About the local xb3-axis +ElastoDyn['Spn3MLyb3'] = False # (kN-m); Blade 3 local flapwise moment at span station 3; About the local yb3-axis +ElastoDyn['Spn3MLzb3'] = False # (kN-m); Blade 3 local pitching moment at span station 3; About the local zb3-axis +ElastoDyn['Spn4MLxb3'] = False # (kN-m); Blade 3 local edgewise moment at span station 4; About the local xb3-axis +ElastoDyn['Spn4MLyb3'] = False # (kN-m); Blade 3 local flapwise moment at span station 4; About the local yb3-axis +ElastoDyn['Spn4MLzb3'] = False # (kN-m); Blade 3 local pitching moment at span station 4; About the local zb3-axis +ElastoDyn['Spn5MLxb3'] = False # (kN-m); Blade 3 local edgewise moment at span station 5; About the local xb3-axis +ElastoDyn['Spn5MLyb3'] = False # (kN-m); Blade 3 local flapwise moment at span station 5; About the local yb3-axis +ElastoDyn['Spn5MLzb3'] = False # (kN-m); Blade 3 local pitching moment at span station 5; About the local zb3-axis +ElastoDyn['Spn6MLxb3'] = False # (kN-m); Blade 3 local edgewise moment at span station 6; About the local xb3-axis +ElastoDyn['Spn6MLyb3'] = False # (kN-m); Blade 3 local flapwise moment at span station 6; About the local yb3-axis +ElastoDyn['Spn6MLzb3'] = False # (kN-m); Blade 3 local pitching moment at span station 6; About the local zb3-axis +ElastoDyn['Spn7MLxb3'] = False # (kN-m); Blade 3 local edgewise moment at span station 7; About the local xb3-axis +ElastoDyn['Spn7MLyb3'] = False # (kN-m); Blade 3 local flapwise moment at span station 7; About the local yb3-axis +ElastoDyn['Spn7MLzb3'] = False # (kN-m); Blade 3 local pitching moment at span station 7; About the local zb3-axis +ElastoDyn['Spn8MLxb3'] = False # (kN-m); Blade 3 local edgewise moment at span station 8; About the local xb3-axis +ElastoDyn['Spn8MLyb3'] = False # (kN-m); Blade 3 local flapwise moment at span station 8; About the local yb3-axis +ElastoDyn['Spn8MLzb3'] = False # (kN-m); Blade 3 local pitching moment at span station 8; About the local zb3-axis +ElastoDyn['Spn9MLxb3'] = False # (kN-m); Blade 3 local edgewise moment at span station 9; About the local xb3-axis +ElastoDyn['Spn9MLyb3'] = False # (kN-m); Blade 3 local flapwise moment at span station 9; About the local yb3-axis +ElastoDyn['Spn9MLzb3'] = False # (kN-m); Blade 3 local pitching moment at span station 9; About the local zb3-axis +ElastoDyn['Spn1FLxb3'] = False # (kN); Blade 3 local flapwise shear force at span station 1; Directed along the local xb3-axis +ElastoDyn['Spn1FLyb3'] = False # (kN); Blade 3 local edgewise shear force at span station 1; Directed along the local yb3-axis +ElastoDyn['Spn1FLzb3'] = False # (kN); Blade 3 local axial force at span station 1; Directed along the local zb3-axis +ElastoDyn['Spn2FLxb3'] = False # (kN); Blade 3 local flapwise shear force at span station 2; Directed along the local xb3-axis +ElastoDyn['Spn2FLyb3'] = False # (kN); Blade 3 local edgewise shear force at span station 2; Directed along the local yb3-axis +ElastoDyn['Spn2FLzb3'] = False # (kN); Blade 3 local axial force at span station 2; Directed along the local zb3-axis +ElastoDyn['Spn3FLxb3'] = False # (kN); Blade 3 local flapwise shear force at span station 3; Directed along the local xb3-axis +ElastoDyn['Spn3FLyb3'] = False # (kN); Blade 3 local edgewise shear force at span station 3; Directed along the local yb3-axis +ElastoDyn['Spn3FLzb3'] = False # (kN); Blade 3 local axial force at span station 3; Directed along the local zb3-axis +ElastoDyn['Spn4FLxb3'] = False # (kN); Blade 3 local flapwise shear force at span station 4; Directed along the local xb3-axis +ElastoDyn['Spn4FLyb3'] = False # (kN); Blade 3 local edgewise shear force at span station 4; Directed along the local yb3-axis +ElastoDyn['Spn4FLzb3'] = False # (kN); Blade 3 local axial force at span station 4; Directed along the local zb3-axis +ElastoDyn['Spn5FLxb3'] = False # (kN); Blade 3 local flapwise shear force at span station 5; Directed along the local xb3-axis +ElastoDyn['Spn5FLyb3'] = False # (kN); Blade 3 local edgewise shear force at span station 5; Directed along the local yb3-axis +ElastoDyn['Spn5FLzb3'] = False # (kN); Blade 3 local axial force at span station 5; Directed along the local zb3-axis +ElastoDyn['Spn6FLxb3'] = False # (kN); Blade 3 local flapwise shear force at span station 6; Directed along the local xb3-axis +ElastoDyn['Spn6FLyb3'] = False # (kN); Blade 3 local edgewise shear force at span station 6; Directed along the local yb3-axis +ElastoDyn['Spn6FLzb3'] = False # (kN); Blade 3 local axial force at span station 6; Directed along the local zb3-axis +ElastoDyn['Spn7FLxb3'] = False # (kN); Blade 3 local flapwise shear force at span station 7; Directed along the local xb3-axis +ElastoDyn['Spn7FLyb3'] = False # (kN); Blade 3 local edgewise shear force at span station 7; Directed along the local yb3-axis +ElastoDyn['Spn7FLzb3'] = False # (kN); Blade 3 local axial force at span station 7; Directed along the local zb3-axis +ElastoDyn['Spn8FLxb3'] = False # (kN); Blade 3 local flapwise shear force at span station 8; Directed along the local xb3-axis +ElastoDyn['Spn8FLyb3'] = False # (kN); Blade 3 local edgewise shear force at span station 8; Directed along the local yb3-axis +ElastoDyn['Spn8FLzb3'] = False # (kN); Blade 3 local axial force at span station 8; Directed along the local zb3-axis +ElastoDyn['Spn9FLxb3'] = False # (kN); Blade 3 local flapwise shear force at span station 9; Directed along the local xb3-axis +ElastoDyn['Spn9FLyb3'] = False # (kN); Blade 3 local edgewise shear force at span station 9; Directed along the local yb3-axis +ElastoDyn['Spn9FLzb3'] = False # (kN); Blade 3 local axial force at span station 9; Directed along the local zb3-axis + +# Hub and Rotor Loads +ElastoDyn['LSShftFxa'] = False # (kN); Low-speed shaft thrust force (this is constant along the shaft and is equivalent to the rotor thrust force); Directed along the xa- and xs-axes +ElastoDyn['LSShftFxs'] = False # (kN); Low-speed shaft thrust force (this is constant along the shaft and is equivalent to the rotor thrust force); Directed along the xa- and xs-axes +ElastoDyn['LSSGagFxa'] = False # (kN); Low-speed shaft thrust force (this is constant along the shaft and is equivalent to the rotor thrust force); Directed along the xa- and xs-axes +ElastoDyn['LSSGagFxs'] = False # (kN); Low-speed shaft thrust force (this is constant along the shaft and is equivalent to the rotor thrust force); Directed along the xa- and xs-axes +ElastoDyn['RotThrust'] = False # (kN); Low-speed shaft thrust force (this is constant along the shaft and is equivalent to the rotor thrust force); Directed along the xa- and xs-axes +ElastoDyn['LSShftFya'] = False # (kN); Rotating low-speed shaft shear force (this is constant along the shaft); Directed along the ya-axis +ElastoDyn['LSSGagFya'] = False # (kN); Rotating low-speed shaft shear force (this is constant along the shaft); Directed along the ya-axis +ElastoDyn['LSShftFza'] = False # (kN); Rotating low-speed shaft shear force (this is constant along the shaft); Directed along the za-axis +ElastoDyn['LSSGagFza'] = False # (kN); Rotating low-speed shaft shear force (this is constant along the shaft); Directed along the za-axis +ElastoDyn['LSShftFys'] = True # (kN); Nonrotating low-speed shaft shear force (this is constant along the shaft); Directed along the ys-axis +ElastoDyn['LSSGagFys'] = False # (kN); Nonrotating low-speed shaft shear force (this is constant along the shaft); Directed along the ys-axis +ElastoDyn['LSShftFzs'] = True # (kN); Nonrotating low-speed shaft shear force (this is constant along the shaft); Directed along the zs-axis +ElastoDyn['LSSGagFzs'] = False # (kN); Nonrotating low-speed shaft shear force (this is constant along the shaft); Directed along the zs-axis +ElastoDyn['LSShftMxa'] = False # (kN-m); Low-speed shaft torque (this is constant along the shaft and is equivalent to the rotor torque); About the xa- and xs-axes +ElastoDyn['LSShftMxs'] = False # (kN-m); Low-speed shaft torque (this is constant along the shaft and is equivalent to the rotor torque); About the xa- and xs-axes +ElastoDyn['LSSGagMxa'] = False # (kN-m); Low-speed shaft torque (this is constant along the shaft and is equivalent to the rotor torque); About the xa- and xs-axes +ElastoDyn['LSSGagMxs'] = False # (kN-m); Low-speed shaft torque (this is constant along the shaft and is equivalent to the rotor torque); About the xa- and xs-axes +ElastoDyn['RotTorq'] = False # (kN-m); Low-speed shaft torque (this is constant along the shaft and is equivalent to the rotor torque); About the xa- and xs-axes +ElastoDyn['LSShftTq'] = False # (kN-m); Low-speed shaft torque (this is constant along the shaft and is equivalent to the rotor torque); About the xa- and xs-axes +ElastoDyn['LSSTipMya'] = False # (kN-m); Rotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader); About the ya-axis +ElastoDyn['LSSTipMza'] = False # (kN-m); Rotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader); About the za-axis +ElastoDyn['LSSTipMys'] = True # (kN-m); Nonrotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader); About the ys-axis +ElastoDyn['LSSTipMzs'] = True # (kN-m); Nonrotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader); About the zs-axis +ElastoDyn['RotPwr'] = False # (kW); Rotor power (this is equivalent to the low-speed shaft power); N/A +ElastoDyn['LSShftPwr'] = False # (kW); Rotor power (this is equivalent to the low-speed shaft power); N/A + +# Shaft Strain Gage Loads +ElastoDyn['LSSGagMya'] = False # (kN-m); Rotating low-speed shaft bending moment at the shaft's strain gage (shaft strain gage located by input ShftGagL); About the ya-axis +ElastoDyn['LSSGagMza'] = False # (kN-m); Rotating low-speed shaft bending moment at the shaft's strain gage (shaft strain gage located by input ShftGagL); About the za-axis +ElastoDyn['LSSGagMys'] = False # (kN-m); Nonrotating low-speed shaft bending moment at the shaft's strain gage (shaft strain gage located by input ShftGagL); About the ys-axis +ElastoDyn['LSSGagMzs'] = False # (kN-m); Nonrotating low-speed shaft bending moment at the shaft's strain gage (shaft strain gage located by input ShftGagL); About the zs-axis + +# High-Speed Shaft Loads +ElastoDyn['HSShftTq'] = False # (kN-m); High-speed shaft torque (this is constant along the shaft); Same sign as LSShftTq / RotTorq / LSShftMxa / LSShftMxs / LSSGagMxa / LSSGagMxs +ElastoDyn['HSSBrTq'] = False # (kN-m); High-speed shaft brake torque (i.e., the actual moment applied to the high-speed shaft by the brake); Always positive (indicating dissipation of power) +ElastoDyn['HSShftPwr'] = False # (kW); High-speed shaft power; Same sign as HSShftTq + +# Rotor-Furl Bearing Loads +ElastoDyn['RFrlBrM'] = False # (kN-m); Rotor-furl bearing moment; About the rotor-furl axis + +# Tail-Furl Bearing Loads +ElastoDyn['TFrlBrM'] = False # (kN-m); Tail-furl bearing moment; About the tail-furl axis + +# Tower-Top / Yaw Bearing Loads +ElastoDyn['YawBrFxn'] = False # (kN); Rotating (with nacelle) tower-top / yaw bearing shear force; Directed along the xn-axis +ElastoDyn['YawBrFyn'] = False # (kN); Rotating (with nacelle) tower-top / yaw bearing shear force; Directed along the yn-axis +ElastoDyn['YawBrFzn'] = False # (kN); Tower-top / yaw bearing axial force; Directed along the zn- and zp-axes +ElastoDyn['YawBrFzp'] = False # (kN); Tower-top / yaw bearing axial force; Directed along the zn- and zp-axes +ElastoDyn['YawBrFxp'] = False # (kN); Tower-top / yaw bearing fore-aft (nonrotating) shear force; Directed along the xp-axis +ElastoDyn['YawBrFyp'] = False # (kN); Tower-top / yaw bearing side-to-side (nonrotating) shear force; Directed along the yp-axis +ElastoDyn['YawBrMxn'] = False # (kN-m); Rotating (with nacelle) tower-top / yaw bearing roll moment; About the xn-axis +ElastoDyn['YawBrMyn'] = False # (kN-m); Rotating (with nacelle) tower-top / yaw bearing pitch moment; About the yn-axis +ElastoDyn['YawBrMzn'] = False # (kN-m); Tower-top / yaw bearing yaw moment; About the zn- and zp-axes +ElastoDyn['YawBrMzp'] = False # (kN-m); Tower-top / yaw bearing yaw moment; About the zn- and zp-axes +ElastoDyn['YawBrMxp'] = False # (kN-m); Nonrotating tower-top / yaw bearing roll moment; About the xp-axis +ElastoDyn['YawBrMyp'] = False # (kN-m); Nonrotating tower-top / yaw bearing pitch moment; About the yp-axis + +# Yaw Friction +ElastoDyn['YawFriMom'] = False # (kN-m); Calculated and corrected friction torque on yaw bearing; About the zn- and zp-axes +ElastoDyn['YawFriMfp'] = False # (kN-m); Yaw friction torque to bring yaw system to a stop at current time step; About the zn- and zp-axes +ElastoDyn['YawFriMz'] = False # (kN-m); External moment on yaw bearing not including inertial contributions; About the zn- and zp-axes +ElastoDyn['OmegaYF'] = False # (deg/s); Yaw rate used in YawFriMom calculation; Directed along the zn- and zp-axes +ElastoDyn['dOmegaYF'] = False # (deg/s^2); Yaw acceleration used in YawFriMom calculation; Directed along the zn- and zp-axes + +# Tower Base Loads +ElastoDyn['TwrBsFxt'] = False # (kN); Tower base fore-aft shear force; Directed along the xt-axis +ElastoDyn['TwrBsFyt'] = False # (kN); Tower base side-to-side shear force; Directed along the yt-axis +ElastoDyn['TwrBsFzt'] = False # (kN); Tower base axial force; Directed along the zt-axis +ElastoDyn['TwrBsMxt'] = False # (kN-m); Tower base roll (or side-to-side) moment (i.e., the moment caused by side-to-side forces); About the xt-axis +ElastoDyn['TwrBsMyt'] = True # (kN-m); Tower base pitching (or fore-aft) moment (i.e., the moment caused by fore-aft forces); About the yt-axis +ElastoDyn['TwrBsMzt'] = False # (kN-m); Tower base yaw (or torsional) moment; About the zt-axis + +# Local Tower Loads +ElastoDyn['TwHt1MLxt'] = False # (kN-m); Local tower roll (or side-to-side) moment of tower gage 1; About the local xt-axis +ElastoDyn['TwHt1MLyt'] = False # (kN-m); Local tower pitching (or fore-aft) moment of tower gage 1; About the local yt-axis +ElastoDyn['TwHt1MLzt'] = False # (kN-m); Local tower yaw (or torsional) moment of tower gage 1; About the local zt-axis +ElastoDyn['TwHt2MLxt'] = False # (kN-m); Local tower roll (or side-to-side) moment of tower gage 2; About the local xt-axis +ElastoDyn['TwHt2MLyt'] = False # (kN-m); Local tower pitching (or fore-aft) moment of tower gage 2; About the local yt-axis +ElastoDyn['TwHt2MLzt'] = False # (kN-m); Local tower yaw (or torsional) moment of tower gage 2; About the local zt-axis +ElastoDyn['TwHt3MLxt'] = False # (kN-m); Local tower roll (or side-to-side) moment of tower gage 3; About the local xt-axis +ElastoDyn['TwHt3MLyt'] = False # (kN-m); Local tower pitching (or fore-aft) moment of tower gage 3; About the local yt-axis +ElastoDyn['TwHt3MLzt'] = False # (kN-m); Local tower yaw (or torsional) moment of tower gage 3; About the local zt-axis +ElastoDyn['TwHt4MLxt'] = False # (kN-m); Local tower roll (or side-to-side) moment of tower gage 4; About the local xt-axis +ElastoDyn['TwHt4MLyt'] = False # (kN-m); Local tower pitching (or fore-aft) moment of tower gage 4; About the local yt-axis +ElastoDyn['TwHt4MLzt'] = False # (kN-m); Local tower yaw (or torsional) moment of tower gage 4; About the local zt-axis +ElastoDyn['TwHt5MLxt'] = False # (kN-m); Local tower roll (or side-to-side) moment of tower gage 5; About the local xt-axis +ElastoDyn['TwHt5MLyt'] = False # (kN-m); Local tower pitching (or fore-aft) moment of tower gage 5; About the local yt-axis +ElastoDyn['TwHt5MLzt'] = False # (kN-m); Local tower yaw (or torsional) moment of tower gage 5; About the local zt-axis +ElastoDyn['TwHt6MLxt'] = False # (kN-m); Local tower roll (or side-to-side) moment of tower gage 6; About the local xt-axis +ElastoDyn['TwHt6MLyt'] = False # (kN-m); Local tower pitching (or fore-aft) moment of tower gage 6; About the local yt-axis +ElastoDyn['TwHt6MLzt'] = False # (kN-m); Local tower yaw (or torsional) moment of tower gage 6; About the local zt-axis +ElastoDyn['TwHt7MLxt'] = False # (kN-m); Local tower roll (or side-to-side) moment of tower gage 7; About the local xt-axis +ElastoDyn['TwHt7MLyt'] = False # (kN-m); Local tower pitching (or fore-aft) moment of tower gage 7; About the local yt-axis +ElastoDyn['TwHt7MLzt'] = False # (kN-m); Local tower yaw (or torsional) moment of tower gage 7; About the local zt-axis +ElastoDyn['TwHt8MLxt'] = False # (kN-m); Local tower roll (or side-to-side) moment of tower gage 8; About the local xt-axis +ElastoDyn['TwHt8MLyt'] = False # (kN-m); Local tower pitching (or fore-aft) moment of tower gage 8; About the local yt-axis +ElastoDyn['TwHt8MLzt'] = False # (kN-m); Local tower yaw (or torsional) moment of tower gage 8; About the local zt-axis +ElastoDyn['TwHt9MLxt'] = False # (kN-m); Local tower roll (or side-to-side) moment of tower gage 9; About the local xt-axis +ElastoDyn['TwHt9MLyt'] = False # (kN-m); Local tower pitching (or fore-aft) moment of tower gage 9; About the local yt-axis +ElastoDyn['TwHt9MLzt'] = False # (kN-m); Local tower yaw (or torsional) moment of tower gage 9; About the local zt-axis +ElastoDyn['TwHt1FLxt'] = False # (kN); Local tower roll (or side-to-side) force of tower gage 1; About the local xt-axis +ElastoDyn['TwHt1FLyt'] = False # (kN); Local tower pitching (or fore-aft) force of tower gage 1; About the local yt-axis +ElastoDyn['TwHt1FLzt'] = False # (kN); Local tower yaw (or torsional) force of tower gage 1; About the local zt-axis +ElastoDyn['TwHt2FLxt'] = False # (kN); Local tower roll (or side-to-side) force of tower gage 2; About the local xt-axis +ElastoDyn['TwHt2FLyt'] = False # (kN); Local tower pitching (or fore-aft) force of tower gage 2; About the local yt-axis +ElastoDyn['TwHt2FLzt'] = False # (kN); Local tower yaw (or torsional) force of tower gage 2; About the local zt-axis +ElastoDyn['TwHt3FLxt'] = False # (kN); Local tower roll (or side-to-side) force of tower gage 3; About the local xt-axis +ElastoDyn['TwHt3FLyt'] = False # (kN); Local tower pitching (or fore-aft) force of tower gage 3; About the local yt-axis +ElastoDyn['TwHt3FLzt'] = False # (kN); Local tower yaw (or torsional) force of tower gage 3; About the local zt-axis +ElastoDyn['TwHt4FLxt'] = False # (kN); Local tower roll (or side-to-side) force of tower gage 4; About the local xt-axis +ElastoDyn['TwHt4FLyt'] = False # (kN); Local tower pitching (or fore-aft) force of tower gage 4; About the local yt-axis +ElastoDyn['TwHt4FLzt'] = False # (kN); Local tower yaw (or torsional) force of tower gage 4; About the local zt-axis +ElastoDyn['TwHt5FLxt'] = False # (kN); Local tower roll (or side-to-side) force of tower gage 5; About the local xt-axis +ElastoDyn['TwHt5FLyt'] = False # (kN); Local tower pitching (or fore-aft) force of tower gage 5; About the local yt-axis +ElastoDyn['TwHt5FLzt'] = False # (kN); Local tower yaw (or torsional) force of tower gage 5; About the local zt-axis +ElastoDyn['TwHt6FLxt'] = False # (kN); Local tower roll (or side-to-side) force of tower gage 6; About the local xt-axis +ElastoDyn['TwHt6FLyt'] = False # (kN); Local tower pitching (or fore-aft) force of tower gage 6; About the local yt-axis +ElastoDyn['TwHt6FLzt'] = False # (kN); Local tower yaw (or torsional) force of tower gage 6; About the local zt-axis +ElastoDyn['TwHt7FLxt'] = False # (kN); Local tower roll (or side-to-side) force of tower gage 7; About the local xt-axis +ElastoDyn['TwHt7FLyt'] = False # (kN); Local tower pitching (or fore-aft) force of tower gage 7; About the local yt-axis +ElastoDyn['TwHt7FLzt'] = False # (kN); Local tower yaw (or torsional) force of tower gage 7; About the local zt-axis +ElastoDyn['TwHt8FLxt'] = False # (kN); Local tower roll (or side-to-side) force of tower gage 8; About the local xt-axis +ElastoDyn['TwHt8FLyt'] = False # (kN); Local tower pitching (or fore-aft) force of tower gage 8; About the local yt-axis +ElastoDyn['TwHt8FLzt'] = False # (kN); Local tower yaw (or torsional) force of tower gage 8; About the local zt-axis +ElastoDyn['TwHt9FLxt'] = False # (kN); Local tower roll (or side-to-side) force of tower gage 9; About the local xt-axis +ElastoDyn['TwHt9FLyt'] = False # (kN); Local tower pitching (or fore-aft) force of tower gage 9; About the local yt-axis +ElastoDyn['TwHt9FLzt'] = False # (kN); Local tower yaw (or torsional) force of tower gage 9; About the local zt-axis -# Rotor -AeroDyn['RtSpeed'] = False # (rpm); Rotor speed; -AeroDyn['RtTSR'] = False # (-); Rotor tip-speed ratio; -AeroDyn['RtVAvgxh'] = False # (m/s); Rotor-disk-averaged relative wind velocity (x-component); the hub coordinate system -AeroDyn['RtVAvgyh'] = False # (m/s); Rotor-disk-averaged relative wind velocity (y-component); the hub coordinate system -AeroDyn['RtVAvgzh'] = False # (m/s); Rotor-disk-averaged relative wind velocity (z-component); the hub coordinate system -AeroDyn['RtSkew'] = False # (deg); Rotor inflow-skew angle; -AeroDyn['RtFldFxh'] = False # (N); Total rotor aerodynamic load (force in x direction); the hub coordinate system -AeroDyn['RtFldFyh'] = False # (N); Total rotor aerodynamic load (force in y direction); the hub coordinate system -AeroDyn['RtFldFzh'] = False # (N); Total rotor aerodynamic load (force in z direction); the hub coordinate system -AeroDyn['RtFldMxh'] = False # (N m); Total rotor aerodynamic load (moment in x direction); the hub coordinate system -AeroDyn['RtFldMyh'] = False # (N m); Total rotor aerodynamic load (moment in y direction); the hub coordinate system -AeroDyn['RtFldMzh'] = False # (N m); Total rotor aerodynamic load (moment in z direction); the hub coordinate system -AeroDyn['RtFldPwr'] = False # (W); Rotor aerodynamic power; -AeroDyn['RtArea'] = False # (m^2); Rotor swept area; -AeroDyn['RtFldCp'] = False # (-); Rotor aerodynamic power coefficient; -AeroDyn['RtFldCq'] = False # (-); Rotor aerodynamic torque coefficient; -AeroDyn['RtFldCt'] = False # (-); Rotor aerodynamic thrust coefficient; +# Internal Degrees of Freedom +ElastoDyn['Q_B1E1'] = False # (m); Displacement of 1st edgewise bending-mode DOF of blade 1; +ElastoDyn['Q_B2E1'] = False # (m); Displacement of 1st edgewise bending-mode DOF of blade 2; +ElastoDyn['Q_B3E1'] = False # (m); Displacement of 1st edgewise bending-mode DOF of blade 3; +ElastoDyn['Q_B1F1'] = False # (m); Displacement of 1st flapwise bending-mode DOF of blade 1; +ElastoDyn['Q_B2F1'] = False # (m); Displacement of 1st flapwise bending-mode DOF of blade 2; +ElastoDyn['Q_B3F1'] = False # (m); Displacement of 1st flapwise bending-mode DOF of blade 3; +ElastoDyn['Q_B1F2'] = False # (m); Displacement of 2nd flapwise bending-mode DOF of blade 1; +ElastoDyn['Q_B2F2'] = False # (m); Displacement of 2nd flapwise bending-mode DOF of blade 2; +ElastoDyn['Q_B3F2'] = False # (m); Displacement of 2nd flapwise bending-mode DOF of blade 3; +ElastoDyn['Q_Teet'] = False # (rad); Displacement of hub teetering DOF; +ElastoDyn['Q_DrTr'] = False # (rad); Displacement of drivetrain rotational-flexibility DOF; +ElastoDyn['Q_GeAz'] = False # (rad); Displacement of variable speed generator DOF; +ElastoDyn['Q_RFrl'] = False # (rad); Displacement of rotor-furl DOF; +ElastoDyn['Q_TFrl'] = False # (rad); Displacement of tail-furl DOF; +ElastoDyn['Q_Yaw'] = False # (rad); Displacement of nacelle yaw DOF; +ElastoDyn['Q_TFA1'] = False # (m); Displacement of 1st tower fore-aft bending mode DOF; +ElastoDyn['Q_TSS1'] = False # (m); Displacement of 1st tower side-to-side bending mode DOF; +ElastoDyn['Q_TFA2'] = False # (m); Displacement of 2nd tower fore-aft bending mode DOF; +ElastoDyn['Q_TSS2'] = False # (m); Displacement of 2nd tower side-to-side bending mode DOF; +ElastoDyn['Q_Sg'] = False # (m); Displacement of platform horizontal surge translation DOF; +ElastoDyn['Q_Sw'] = False # (m); Displacement of platform horizontal sway translation DOF; +ElastoDyn['Q_Hv'] = False # (m); Displacement of platform vertical heave translation DOF; +ElastoDyn['Q_R'] = False # (rad); Displacement of platform roll tilt rotation DOF; +ElastoDyn['Q_P'] = False # (rad); Displacement of platform pitch tilt rotation DOF; +ElastoDyn['Q_Y'] = False # (rad); Displacement of platform yaw rotation DOF; +ElastoDyn['QD_B1E1'] = False # (m/s); Velocity of 1st edgewise bending-mode DOF of blade 1; +ElastoDyn['QD_B2E1'] = False # (m/s); Velocity of 1st edgewise bending-mode DOF of blade 2; +ElastoDyn['QD_B3E1'] = False # (m/s); Velocity of 1st edgewise bending-mode DOF of blade 3; +ElastoDyn['QD_B1F1'] = False # (m/s); Velocity of 1st flapwise bending-mode DOF of blade 1; +ElastoDyn['QD_B2F1'] = False # (m/s); Velocity of 1st flapwise bending-mode DOF of blade 2; +ElastoDyn['QD_B3F1'] = False # (m/s); Velocity of 1st flapwise bending-mode DOF of blade 3; +ElastoDyn['QD_B1F2'] = False # (m/s); Velocity of 2nd flapwise bending-mode DOF of blade 1; +ElastoDyn['QD_B2F2'] = False # (m/s); Velocity of 2nd flapwise bending-mode DOF of blade 2; +ElastoDyn['QD_B3F2'] = False # (m/s); Velocity of 2nd flapwise bending-mode DOF of blade 3; +ElastoDyn['QD_Teet'] = False # (rad/s); Velocity of hub teetering DOF; +ElastoDyn['QD_DrTr'] = False # (rad/s); Velocity of drivetrain rotational-flexibility DOF; +ElastoDyn['QD_GeAz'] = False # (rad/s); Velocity of variable speed generator DOF; +ElastoDyn['QD_RFrl'] = False # (rad/s); Velocity of rotor-furl DOF; +ElastoDyn['QD_TFrl'] = False # (rad/s); Velocity of tail-furl DOF; +ElastoDyn['QD_Yaw'] = False # (rad/s); Velocity of nacelle yaw DOF; +ElastoDyn['QD_TFA1'] = False # (m/s); Velocity of 1st tower fore-aft bending mode DOF; +ElastoDyn['QD_TSS1'] = False # (m/s); Velocity of 1st tower side-to-side bending mode DOF; +ElastoDyn['QD_TFA2'] = False # (m/s); Velocity of 2nd tower fore-aft bending mode DOF; +ElastoDyn['QD_TSS2'] = False # (m/s); Velocity of 2nd tower side-to-side bending mode DOF; +ElastoDyn['QD_Sg'] = False # (m/s); Velocity of platform horizontal surge translation DOF; +ElastoDyn['QD_Sw'] = False # (m/s); Velocity of platform horizontal sway translation DOF; +ElastoDyn['QD_Hv'] = False # (m/s); Velocity of platform vertical heave translation DOF; +ElastoDyn['QD_R'] = False # (rad/s); Velocity of platform roll tilt rotation DOF; +ElastoDyn['QD_P'] = False # (rad/s); Velocity of platform pitch tilt rotation DOF; +ElastoDyn['QD_Y'] = False # (rad/s); Velocity of platform yaw rotation DOF; +ElastoDyn['QD2_B1E1'] = False # (m/s^2); Acceleration of 1st edgewise bending-mode DOF of blade 1; +ElastoDyn['QD2_B2E1'] = False # (m/s^2); Acceleration of 1st edgewise bending-mode DOF of blade 2; +ElastoDyn['QD2_B3E1'] = False # (m/s^2); Acceleration of 1st edgewise bending-mode DOF of blade 3; +ElastoDyn['QD2_B1F1'] = False # (m/s^2); Acceleration of 1st flapwise bending-mode DOF of blade 1; +ElastoDyn['QD2_B2F1'] = False # (m/s^2); Acceleration of 1st flapwise bending-mode DOF of blade 2; +ElastoDyn['QD2_B3F1'] = False # (m/s^2); Acceleration of 1st flapwise bending-mode DOF of blade 3; +ElastoDyn['QD2_B1F2'] = False # (m/s^2); Acceleration of 2nd flapwise bending-mode DOF of blade 1; +ElastoDyn['QD2_B2F2'] = False # (m/s^2); Acceleration of 2nd flapwise bending-mode DOF of blade 2; +ElastoDyn['QD2_B3F2'] = False # (m/s^2); Acceleration of 2nd flapwise bending-mode DOF of blade 3; +ElastoDyn['QD2_Teet'] = False # (rad/s^2); Acceleration of hub teetering DOF; +ElastoDyn['QD2_DrTr'] = False # (rad/s^2); Acceleration of drivetrain rotational-flexibility DOF; +ElastoDyn['QD2_GeAz'] = False # (rad/s^2); Acceleration of variable speed generator DOF; +ElastoDyn['QD2_RFrl'] = False # (rad/s^2); Acceleration of rotor-furl DOF; +ElastoDyn['QD2_TFrl'] = False # (rad/s^2); Acceleration of tail-furl DOF; +ElastoDyn['QD2_Yaw'] = False # (rad/s^2); Acceleration of nacelle yaw DOF; +ElastoDyn['QD2_TFA1'] = False # (m/s^2); Acceleration of 1st tower fore-aft bending mode DOF; +ElastoDyn['QD2_TSS1'] = False # (m/s^2); Acceleration of 1st tower side-to-side bending mode DOF; +ElastoDyn['QD2_TFA2'] = False # (m/s^2); Acceleration of 2nd tower fore-aft bending mode DOF; +ElastoDyn['QD2_TSS2'] = False # (m/s^2); Acceleration of 2nd tower side-to-side bending mode DOF; +ElastoDyn['QD2_Sg'] = False # (m/s^2); Acceleration of platform horizontal surge translation DOF; +ElastoDyn['QD2_Sw'] = False # (m/s^2); Acceleration of platform horizontal sway translation DOF; +ElastoDyn['QD2_Hv'] = False # (m/s^2); Acceleration of platform vertical heave translation DOF; +ElastoDyn['QD2_R'] = False # (rad/s^2); Acceleration of platform roll tilt rotation DOF; +ElastoDyn['QD2_P'] = False # (rad/s^2); Acceleration of platform pitch tilt rotation DOF; +ElastoDyn['QD2_Y'] = False # (rad/s^2); Acceleration of platform yaw rotation DOF; """ InflowWind """ @@ -3268,6 +3195,41 @@ InflowWind['Wind9VelX'] = False # (m/s); X component of wind at user selected wind point 9; Directed along the xi-axis InflowWind['Wind9VelY'] = False # (m/s); Y component of wind at user selected wind point 9; Directed along the yi-axis InflowWind['Wind9VelZ'] = False # (m/s); Z component of wind at user selected wind point 9; Directed along the zi-axis +InflowWind['WindHubVelX'] = False # (m/s); X component of wind at (moving) hub point; Directed along the xi-axis +InflowWind['WindHubVelY'] = False # (m/s); Y component of wind at (moving) hub point; Directed along the yi-axis +InflowWind['WindHubVelZ'] = False # (m/s); Z component of wind at (moving) hub point; Directed along the zi-axis +InflowWind['WindDiskVelX'] = False # (m/s); Disk-average X component of wind (at 70% span); Directed along the xi-axis +InflowWind['WindDiskVelY'] = False # (m/s); Disk-average Y component of wind (at 70% span); Directed along the yi-axis +InflowWind['WindDiskVelZ'] = False # (m/s); Disk-average Z component of wind (at 70% span); Directed along the zi-axis + +# Wind Accelerations +InflowWind['Wind1AccX'] = False # (m/s); X component of wind at user selected wind point 1; Directed along the xi-axis +InflowWind['Wind1AccY'] = False # (m/s); Y component of wind at user selected wind point 1; Directed along the yi-axis +InflowWind['Wind1AccZ'] = False # (m/s); Z component of wind at user selected wind point 1; Directed along the zi-axis +InflowWind['Wind2AccX'] = False # (m/s); X component of wind at user selected wind point 2; Directed along the xi-axis +InflowWind['Wind2AccY'] = False # (m/s); Y component of wind at user selected wind point 2; Directed along the yi-axis +InflowWind['Wind2AccZ'] = False # (m/s); Z component of wind at user selected wind point 2; Directed along the zi-axis +InflowWind['Wind3AccX'] = False # (m/s); X component of wind at user selected wind point 3; Directed along the xi-axis +InflowWind['Wind3AccY'] = False # (m/s); Y component of wind at user selected wind point 3; Directed along the yi-axis +InflowWind['Wind3AccZ'] = False # (m/s); Z component of wind at user selected wind point 3; Directed along the zi-axis +InflowWind['Wind4AccX'] = False # (m/s); X component of wind at user selected wind point 4; Directed along the xi-axis +InflowWind['Wind4AccY'] = False # (m/s); Y component of wind at user selected wind point 4; Directed along the yi-axis +InflowWind['Wind4AccZ'] = False # (m/s); Z component of wind at user selected wind point 4; Directed along the zi-axis +InflowWind['Wind5AccX'] = False # (m/s); X component of wind at user selected wind point 5; Directed along the xi-axis +InflowWind['Wind5AccY'] = False # (m/s); Y component of wind at user selected wind point 5; Directed along the yi-axis +InflowWind['Wind5AccZ'] = False # (m/s); Z component of wind at user selected wind point 5; Directed along the zi-axis +InflowWind['Wind6AccX'] = False # (m/s); X component of wind at user selected wind point 6; Directed along the xi-axis +InflowWind['Wind6AccY'] = False # (m/s); Y component of wind at user selected wind point 6; Directed along the yi-axis +InflowWind['Wind6AccZ'] = False # (m/s); Z component of wind at user selected wind point 6; Directed along the zi-axis +InflowWind['Wind7AccX'] = False # (m/s); X component of wind at user selected wind point 7; Directed along the xi-axis +InflowWind['Wind7AccY'] = False # (m/s); Y component of wind at user selected wind point 7; Directed along the yi-axis +InflowWind['Wind7AccZ'] = False # (m/s); Z component of wind at user selected wind point 7; Directed along the zi-axis +InflowWind['Wind8AccX'] = False # (m/s); X component of wind at user selected wind point 8; Directed along the xi-axis +InflowWind['Wind8AccY'] = False # (m/s); Y component of wind at user selected wind point 8; Directed along the yi-axis +InflowWind['Wind8AccZ'] = False # (m/s); Z component of wind at user selected wind point 8; Directed along the zi-axis +InflowWind['Wind9AccX'] = False # (m/s); X component of wind at user selected wind point 9; Directed along the xi-axis +InflowWind['Wind9AccY'] = False # (m/s); Y component of wind at user selected wind point 9; Directed along the yi-axis +InflowWind['Wind9AccZ'] = False # (m/s); Z component of wind at user selected wind point 9; Directed along the zi-axis # Wind Magnitude and Direction InflowWind['Wind1VelXY'] = False # (m/s); XY (horizontal) wind magnitude at user selected wind point 1; @@ -3279,6 +3241,8 @@ InflowWind['Wind7VelXY'] = False # (m/s); XY (horizontal) wind magnitude at user selected wind point 7; InflowWind['Wind8VelXY'] = False # (m/s); XY (horizontal) wind magnitude at user selected wind point 8; InflowWind['Wind9VelXY'] = False # (m/s); XY (horizontal) wind magnitude at user selected wind point 9; +InflowWind['WindHubVelXY'] = False # (m/s); XY (horizontal) component of wind at (moving) hub point; +InflowWind['WindDiskVelXY'] = False # (m/s); XY (horizontal) component of disk-average wind (at 70% span); InflowWind['Wind1VelMag'] = False # (m/s); wind magnitude at user selected wind point 1; InflowWind['Wind2VelMag'] = False # (m/s); wind magnitude at user selected wind point 2; InflowWind['Wind3VelMag'] = False # (m/s); wind magnitude at user selected wind point 3; @@ -3288,6 +3252,8 @@ InflowWind['Wind7VelMag'] = False # (m/s); wind magnitude at user selected wind point 7; InflowWind['Wind8VelMag'] = False # (m/s); wind magnitude at user selected wind point 8; InflowWind['Wind9VelMag'] = False # (m/s); wind magnitude at user selected wind point 9; +InflowWind['WindHubVelMag'] = False # (m/s); wind magnitude at (moving) hub point; +InflowWind['WindDiskVelMag'] = False # (m/s); wind magnitude of disk-average wind (at 70% span); InflowWind['Wind1AngXY'] = False # (deg); Angle between X and Y wind velocity components at user selected wind point 1; InflowWind['Wind2AngXY'] = False # (deg); Angle between X and Y wind velocity components at user selected wind point 2; InflowWind['Wind3AngXY'] = False # (deg); Angle between X and Y wind velocity components at user selected wind point 3; @@ -3297,6 +3263,8 @@ InflowWind['Wind7AngXY'] = False # (deg); Angle between X and Y wind velocity components at user selected wind point 7; InflowWind['Wind8AngXY'] = False # (deg); Angle between X and Y wind velocity components at user selected wind point 8; InflowWind['Wind9AngXY'] = False # (deg); Angle between X and Y wind velocity components at user selected wind point 9; +InflowWind['WindHubAngXY'] = False # (deg); Angle between X and Y wind velocity components at (moving) hub point; +InflowWind['WindDiskAngXY'] = False # (deg); Angle between X and Y wind velocity components of disk-average wind (at 70% span); # Wind Sensor Measurements InflowWind['WindMeas1'] = False # (m/s); Wind measurement at sensor 1; Defined by sensor @@ -3306,47 +3274,545 @@ InflowWind['WindMeas5'] = False # (m/s); Wind measurement at sensor 5; Defined by sensor -""" WAMIT """ -WAMIT = {} +""" ServoDyn """ +ServoDyn = {} + +# Airfoil control +ServoDyn['BlAirFlC1'] = False # (-); Blade 1 airfoil control command; Same units as provided in airfoil tables of AD15 (UserProp) +ServoDyn['BlFlap1'] = False # (-); Blade 1 airfoil control command; Same units as provided in airfoil tables of AD15 (UserProp) +ServoDyn['BlAirFlC2'] = False # (-); Blade 2 airfoil control command; Same units as provided in airfoil tables of AD15 (UserProp) +ServoDyn['BlFlap2'] = False # (-); Blade 2 airfoil control command; Same units as provided in airfoil tables of AD15 (UserProp) +ServoDyn['BlAirFlC3'] = False # (-); Blade 3 airfoil control command; Same units as provided in airfoil tables of AD15 (UserProp) +ServoDyn['BlFlap3'] = False # (-); Blade 3 airfoil control command; Same units as provided in airfoil tables of AD15 (UserProp) + +# Pitch Control +ServoDyn['BlPitchC1'] = False # (deg); Blade 1 pitch angle command; Positive towards feather about the minus zc1- and minus zb1-axes +ServoDyn['BlPitchC2'] = False # (deg); Blade 2 pitch angle command; Positive towards feather about the minus zc2- and minus zb2-axes +ServoDyn['BlPitchC3'] = False # (deg); Blade 3 pitch angle command; Positive towards feather about the minus zc3- and minus zb3-axes + +# Generator and Torque Control +ServoDyn['GenTq'] = False # (kN-m); Electrical generator torque; Positive reflects power extracted and negative represents a motoring-up situation (power input) +ServoDyn['GenPwr'] = False # (kW); Electrical generator power; Same sign as GenTq + +# High Speed Shaft Brake +ServoDyn['HSSBrTqC'] = False # (kN-m); High-speed shaft brake torque command (i.e., the commanded moment applied to the high-speed shaft by the brake); Always positive (indicating dissipation of power) + +# Nacelle Yaw Control +ServoDyn['YawMomCom'] = False # (kN-m); Nacelle yaw moment command; About the zl- and zp-axes +ServoDyn['YawMom'] = False # (kN-m); Nacelle yaw moment command; About the zl- and zp-axes + +# Nacelle Structural Control (StC) +ServoDyn['NStC1_XQ'] = False # (m); Nacelle StC #1 -- X position (displacement); Relative to rest position in StC reference frame +ServoDyn['NStC1_XQD'] = False # (m/s); Nacelle StC #1 -- X velocity; Relative to nacelle in StC reference frame +ServoDyn['NStC1_YQ'] = False # (m); Nacelle StC #1 -- Y position (displacement); Relative to rest position in StC reference frame +ServoDyn['NStC1_YQD'] = False # (m/s); Nacelle StC #1 -- Y velocity; Relative to nacelle in StC reference frame +ServoDyn['NStC1_ZQ'] = False # (m); Nacelle StC #1 -- Z position (displacement); Relative to rest position in StC reference frame +ServoDyn['NStC1_ZQD'] = False # (m/s); Nacelle StC #1 -- Z velocity; Relative to nacelle in StC reference frame +ServoDyn['NStC1_Fxi'] = False # (kN); Nacelle StC #1 -- X resulting force; Inertial (global) coordinates +ServoDyn['NStC1_Fyi'] = False # (kN); Nacelle StC #1 -- Y resulting force; Inertial (global) coordinates +ServoDyn['NStC1_Fzi'] = False # (kN); Nacelle StC #1 -- Z resulting force; Inertial (global) coordinates +ServoDyn['NStC1_Mxi'] = False # (kN-m); Nacelle StC #1 -- X resulting moment; Inertial (global) coordinates +ServoDyn['NStC1_Myi'] = False # (kN-m); Nacelle StC #1 -- Y resulting moment; Inertial (global) coordinates +ServoDyn['NStC1_Mzi'] = False # (kN-m); Nacelle StC #1 -- Z resulting moment; Inertial (global) coordinates +ServoDyn['NStC1_Fxl'] = False # (kN); Nacelle StC #1 -- X resulting force; Local StC coordinates +ServoDyn['NStC1_Fyl'] = False # (kN); Nacelle StC #1 -- Y resulting force; Local StC coordinates +ServoDyn['NStC1_Fzl'] = False # (kN); Nacelle StC #1 -- Z resulting force; Local StC coordinates +ServoDyn['NStC1_Mxl'] = False # (kN-m); Nacelle StC #1 -- X resulting moment; Local StC coordinates +ServoDyn['NStC1_Myl'] = False # (kN-m); Nacelle StC #1 -- Y resulting moment; Local StC coordinates +ServoDyn['NStC1_Mzl'] = False # (kN-m); Nacelle StC #1 -- Z resulting moment; Local StC coordinates +ServoDyn['NStC2_XQ'] = False # (m); Nacelle StC #2 -- X position (displacement); Relative to rest position in StC reference frame +ServoDyn['NStC2_XQD'] = False # (m/s); Nacelle StC #2 -- X velocity; Relative to nacelle in StC reference frame +ServoDyn['NStC2_YQ'] = False # (m); Nacelle StC #2 -- Y position (displacement); Relative to rest position in StC reference frame +ServoDyn['NStC2_YQD'] = False # (m/s); Nacelle StC #2 -- Y velocity; Relative to nacelle in StC reference frame +ServoDyn['NStC2_ZQ'] = False # (m); Nacelle StC #2 -- Z position (displacement); Relative to rest position in StC reference frame +ServoDyn['NStC2_ZQD'] = False # (m/s); Nacelle StC #2 -- Z velocity; Relative to nacelle in StC reference frame +ServoDyn['NStC2_Fxi'] = False # (kN); Nacelle StC #2 -- X resulting force; Inertial (global) coordinates +ServoDyn['NStC2_Fyi'] = False # (kN); Nacelle StC #2 -- Y resulting force; Inertial (global) coordinates +ServoDyn['NStC2_Fzi'] = False # (kN); Nacelle StC #2 -- Z resulting force; Inertial (global) coordinates +ServoDyn['NStC2_Mxi'] = False # (kN-m); Nacelle StC #2 -- X resulting moment; Inertial (global) coordinates +ServoDyn['NStC2_Myi'] = False # (kN-m); Nacelle StC #2 -- Y resulting moment; Inertial (global) coordinates +ServoDyn['NStC2_Mzi'] = False # (kN-m); Nacelle StC #2 -- Z resulting moment; Inertial (global) coordinates +ServoDyn['NStC2_Fxl'] = False # (kN); Nacelle StC #2 -- X resulting force; Local StC coordinates +ServoDyn['NStC2_Fyl'] = False # (kN); Nacelle StC #2 -- Y resulting force; Local StC coordinates +ServoDyn['NStC2_Fzl'] = False # (kN); Nacelle StC #2 -- Z resulting force; Local StC coordinates +ServoDyn['NStC2_Mxl'] = False # (kN-m); Nacelle StC #2 -- X resulting moment; Local StC coordinates +ServoDyn['NStC2_Myl'] = False # (kN-m); Nacelle StC #2 -- Y resulting moment; Local StC coordinates +ServoDyn['NStC2_Mzl'] = False # (kN-m); Nacelle StC #2 -- Z resulting moment; Local StC coordinates +ServoDyn['NStC3_XQ'] = False # (m); Nacelle StC #3 -- X position (displacement); Relative to rest position in StC reference frame +ServoDyn['NStC3_XQD'] = False # (m/s); Nacelle StC #3 -- X velocity; Relative to nacelle in StC reference frame +ServoDyn['NStC3_YQ'] = False # (m); Nacelle StC #3 -- Y position (displacement); Relative to rest position in StC reference frame +ServoDyn['NStC3_YQD'] = False # (m/s); Nacelle StC #3 -- Y velocity; Relative to nacelle in StC reference frame +ServoDyn['NStC3_ZQ'] = False # (m); Nacelle StC #3 -- Z position (displacement); Relative to rest position in StC reference frame +ServoDyn['NStC3_ZQD'] = False # (m/s); Nacelle StC #3 -- Z velocity; Relative to nacelle in StC reference frame +ServoDyn['NStC3_Fxi'] = False # (kN); Nacelle StC #3 -- X resulting force; Inertial (global) coordinates +ServoDyn['NStC3_Fyi'] = False # (kN); Nacelle StC #3 -- Y resulting force; Inertial (global) coordinates +ServoDyn['NStC3_Fzi'] = False # (kN); Nacelle StC #3 -- Z resulting force; Inertial (global) coordinates +ServoDyn['NStC3_Mxi'] = False # (kN-m); Nacelle StC #3 -- X resulting moment; Inertial (global) coordinates +ServoDyn['NStC3_Myi'] = False # (kN-m); Nacelle StC #3 -- Y resulting moment; Inertial (global) coordinates +ServoDyn['NStC3_Mzi'] = False # (kN-m); Nacelle StC #3 -- Z resulting moment; Inertial (global) coordinates +ServoDyn['NStC3_Fxl'] = False # (kN); Nacelle StC #3 -- X resulting force; Local StC coordinates +ServoDyn['NStC3_Fyl'] = False # (kN); Nacelle StC #3 -- Y resulting force; Local StC coordinates +ServoDyn['NStC3_Fzl'] = False # (kN); Nacelle StC #3 -- Z resulting force; Local StC coordinates +ServoDyn['NStC3_Mxl'] = False # (kN-m); Nacelle StC #3 -- X resulting moment; Local StC coordinates +ServoDyn['NStC3_Myl'] = False # (kN-m); Nacelle StC #3 -- Y resulting moment; Local StC coordinates +ServoDyn['NStC3_Mzl'] = False # (kN-m); Nacelle StC #3 -- Z resulting moment; Local StC coordinates +ServoDyn['NStC4_XQ'] = False # (m); Nacelle StC #4 -- X position (displacement); Relative to rest position in StC reference frame +ServoDyn['NStC4_XQD'] = False # (m/s); Nacelle StC #4 -- X velocity; Relative to nacelle in StC reference frame +ServoDyn['NStC4_YQ'] = False # (m); Nacelle StC #4 -- Y position (displacement); Relative to rest position in StC reference frame +ServoDyn['NStC4_YQD'] = False # (m/s); Nacelle StC #4 -- Y velocity; Relative to nacelle in StC reference frame +ServoDyn['NStC4_ZQ'] = False # (m); Nacelle StC #4 -- Z position (displacement); Relative to rest position in StC reference frame +ServoDyn['NStC4_ZQD'] = False # (m/s); Nacelle StC #4 -- Z velocity; Relative to nacelle in StC reference frame +ServoDyn['NStC4_Fxi'] = False # (kN); Nacelle StC #4 -- X resulting force; Inertial (global) coordinates +ServoDyn['NStC4_Fyi'] = False # (kN); Nacelle StC #4 -- Y resulting force; Inertial (global) coordinates +ServoDyn['NStC4_Fzi'] = False # (kN); Nacelle StC #4 -- Z resulting force; Inertial (global) coordinates +ServoDyn['NStC4_Mxi'] = False # (kN-m); Nacelle StC #4 -- X resulting moment; Inertial (global) coordinates +ServoDyn['NStC4_Myi'] = False # (kN-m); Nacelle StC #4 -- Y resulting moment; Inertial (global) coordinates +ServoDyn['NStC4_Mzi'] = False # (kN-m); Nacelle StC #4 -- Z resulting moment; Inertial (global) coordinates +ServoDyn['NStC4_Fxl'] = False # (kN); Nacelle StC #4 -- X resulting force; Local StC coordinates +ServoDyn['NStC4_Fyl'] = False # (kN); Nacelle StC #4 -- Y resulting force; Local StC coordinates +ServoDyn['NStC4_Fzl'] = False # (kN); Nacelle StC #4 -- Z resulting force; Local StC coordinates +ServoDyn['NStC4_Mxl'] = False # (kN-m); Nacelle StC #4 -- X resulting moment; Local StC coordinates +ServoDyn['NStC4_Myl'] = False # (kN-m); Nacelle StC #4 -- Y resulting moment; Local StC coordinates +ServoDyn['NStC4_Mzl'] = False # (kN-m); Nacelle StC #4 -- Z resulting moment; Local StC coordinates + +# Tower Structural Control (StC) +ServoDyn['TStC1_XQ'] = False # (m); Tower StC #1 -- X position (displacement); Relative to rest position in StC reference frame +ServoDyn['TStC1_XQD'] = False # (m/s); Tower StC #1 -- X velocity; Relative to nacelle in StC reference frame +ServoDyn['TStC1_YQ'] = False # (m); Tower StC #1 -- Y position (displacement); Relative to rest position in StC reference frame +ServoDyn['TStC1_YQD'] = False # (m/s); Tower StC #1 -- Y velocity; Relative to nacelle in StC reference frame +ServoDyn['TStC1_ZQ'] = False # (m); Tower StC #1 -- Z position (displacement); Relative to rest position in StC reference frame +ServoDyn['TStC1_ZQD'] = False # (m/s); Tower StC #1 -- Z velocity; Relative to nacelle in StC reference frame +ServoDyn['TStC1_Fxi'] = False # (kN); Tower StC #1 -- X resulting force; Inertial (global) coordinates +ServoDyn['TStC1_Fyi'] = False # (kN); Tower StC #1 -- Y resulting force; Inertial (global) coordinates +ServoDyn['TStC1_Fzi'] = False # (kN); Tower StC #1 -- Z resulting force; Inertial (global) coordinates +ServoDyn['TStC1_Mxi'] = False # (kN-m); Tower StC #1 -- X resulting moment; Inertial (global) coordinates +ServoDyn['TStC1_Myi'] = False # (kN-m); Tower StC #1 -- Y resulting moment; Inertial (global) coordinates +ServoDyn['TStC1_Mzi'] = False # (kN-m); Tower StC #1 -- Z resulting moment; Inertial (global) coordinates +ServoDyn['TStC1_Fxl'] = False # (kN); Tower StC #1 -- X resulting force; Local StC coordinates +ServoDyn['TStC1_Fyl'] = False # (kN); Tower StC #1 -- Y resulting force; Local StC coordinates +ServoDyn['TStC1_Fzl'] = False # (kN); Tower StC #1 -- Z resulting force; Local StC coordinates +ServoDyn['TStC1_Mxl'] = False # (kN-m); Tower StC #1 -- X resulting moment; Local StC coordinates +ServoDyn['TStC1_Myl'] = False # (kN-m); Tower StC #1 -- Y resulting moment; Local StC coordinates +ServoDyn['TStC1_Mzl'] = False # (kN-m); Tower StC #1 -- Z resulting moment; Local StC coordinates +ServoDyn['TStC2_XQ'] = False # (m); Tower StC #2 -- X position (displacement); Relative to rest position in StC reference frame +ServoDyn['TStC2_XQD'] = False # (m/s); Tower StC #2 -- X velocity; Relative to nacelle in StC reference frame +ServoDyn['TStC2_YQ'] = False # (m); Tower StC #2 -- Y position (displacement); Relative to rest position in StC reference frame +ServoDyn['TStC2_YQD'] = False # (m/s); Tower StC #2 -- Y velocity; Relative to nacelle in StC reference frame +ServoDyn['TStC2_ZQ'] = False # (m); Tower StC #2 -- Z position (displacement); Relative to rest position in StC reference frame +ServoDyn['TStC2_ZQD'] = False # (m/s); Tower StC #2 -- Z velocity; Relative to nacelle in StC reference frame +ServoDyn['TStC2_Fxi'] = False # (kN); Tower StC #2 -- X resulting force; Inertial (global) coordinates +ServoDyn['TStC2_Fyi'] = False # (kN); Tower StC #2 -- Y resulting force; Inertial (global) coordinates +ServoDyn['TStC2_Fzi'] = False # (kN); Tower StC #2 -- Z resulting force; Inertial (global) coordinates +ServoDyn['TStC2_Mxi'] = False # (kN-m); Tower StC #2 -- X resulting moment; Inertial (global) coordinates +ServoDyn['TStC2_Myi'] = False # (kN-m); Tower StC #2 -- Y resulting moment; Inertial (global) coordinates +ServoDyn['TStC2_Mzi'] = False # (kN-m); Tower StC #2 -- Z resulting moment; Inertial (global) coordinates +ServoDyn['TStC2_Fxl'] = False # (kN); Tower StC #2 -- X resulting force; Local StC coordinates +ServoDyn['TStC2_Fyl'] = False # (kN); Tower StC #2 -- Y resulting force; Local StC coordinates +ServoDyn['TStC2_Fzl'] = False # (kN); Tower StC #2 -- Z resulting force; Local StC coordinates +ServoDyn['TStC2_Mxl'] = False # (kN-m); Tower StC #2 -- X resulting moment; Local StC coordinates +ServoDyn['TStC2_Myl'] = False # (kN-m); Tower StC #2 -- Y resulting moment; Local StC coordinates +ServoDyn['TStC2_Mzl'] = False # (kN-m); Tower StC #2 -- Z resulting moment; Local StC coordinates +ServoDyn['TStC3_XQ'] = False # (m); Tower StC #3 -- X position (displacement); Relative to rest position in StC reference frame +ServoDyn['TStC3_XQD'] = False # (m/s); Tower StC #3 -- X velocity; Relative to nacelle in StC reference frame +ServoDyn['TStC3_YQ'] = False # (m); Tower StC #3 -- Y position (displacement); Relative to rest position in StC reference frame +ServoDyn['TStC3_YQD'] = False # (m/s); Tower StC #3 -- Y velocity; Relative to nacelle in StC reference frame +ServoDyn['TStC3_ZQ'] = False # (m); Tower StC #3 -- Z position (displacement); Relative to rest position in StC reference frame +ServoDyn['TStC3_ZQD'] = False # (m/s); Tower StC #3 -- Z velocity; Relative to nacelle in StC reference frame +ServoDyn['TStC3_Fxi'] = False # (kN); Tower StC #3 -- X resulting force; Inertial (global) coordinates +ServoDyn['TStC3_Fyi'] = False # (kN); Tower StC #3 -- Y resulting force; Inertial (global) coordinates +ServoDyn['TStC3_Fzi'] = False # (kN); Tower StC #3 -- Z resulting force; Inertial (global) coordinates +ServoDyn['TStC3_Mxi'] = False # (kN-m); Tower StC #3 -- X resulting moment; Inertial (global) coordinates +ServoDyn['TStC3_Myi'] = False # (kN-m); Tower StC #3 -- Y resulting moment; Inertial (global) coordinates +ServoDyn['TStC3_Mzi'] = False # (kN-m); Tower StC #3 -- Z resulting moment; Inertial (global) coordinates +ServoDyn['TStC3_Fxl'] = False # (kN); Tower StC #3 -- X resulting force; Local StC coordinates +ServoDyn['TStC3_Fyl'] = False # (kN); Tower StC #3 -- Y resulting force; Local StC coordinates +ServoDyn['TStC3_Fzl'] = False # (kN); Tower StC #3 -- Z resulting force; Local StC coordinates +ServoDyn['TStC3_Mxl'] = False # (kN-m); Tower StC #3 -- X resulting moment; Local StC coordinates +ServoDyn['TStC3_Myl'] = False # (kN-m); Tower StC #3 -- Y resulting moment; Local StC coordinates +ServoDyn['TStC3_Mzl'] = False # (kN-m); Tower StC #3 -- Z resulting moment; Local StC coordinates +ServoDyn['TStC4_XQ'] = False # (m); Tower StC #4 -- X position (displacement); Relative to rest position in StC reference frame +ServoDyn['TStC4_XQD'] = False # (m/s); Tower StC #4 -- X velocity; Relative to nacelle in StC reference frame +ServoDyn['TStC4_YQ'] = False # (m); Tower StC #4 -- Y position (displacement); Relative to rest position in StC reference frame +ServoDyn['TStC4_YQD'] = False # (m/s); Tower StC #4 -- Y velocity; Relative to nacelle in StC reference frame +ServoDyn['TStC4_ZQ'] = False # (m); Tower StC #4 -- Z position (displacement); Relative to rest position in StC reference frame +ServoDyn['TStC4_ZQD'] = False # (m/s); Tower StC #4 -- Z velocity; Relative to nacelle in StC reference frame +ServoDyn['TStC4_Fxi'] = False # (kN); Tower StC #4 -- X resulting force; Inertial (global) coordinates +ServoDyn['TStC4_Fyi'] = False # (kN); Tower StC #4 -- Y resulting force; Inertial (global) coordinates +ServoDyn['TStC4_Fzi'] = False # (kN); Tower StC #4 -- Z resulting force; Inertial (global) coordinates +ServoDyn['TStC4_Mxi'] = False # (kN-m); Tower StC #4 -- X resulting moment; Inertial (global) coordinates +ServoDyn['TStC4_Myi'] = False # (kN-m); Tower StC #4 -- Y resulting moment; Inertial (global) coordinates +ServoDyn['TStC4_Mzi'] = False # (kN-m); Tower StC #4 -- Z resulting moment; Inertial (global) coordinates +ServoDyn['TStC4_Fxl'] = False # (kN); Tower StC #4 -- X resulting force; Local StC coordinates +ServoDyn['TStC4_Fyl'] = False # (kN); Tower StC #4 -- Y resulting force; Local StC coordinates +ServoDyn['TStC4_Fzl'] = False # (kN); Tower StC #4 -- Z resulting force; Local StC coordinates +ServoDyn['TStC4_Mxl'] = False # (kN-m); Tower StC #4 -- X resulting moment; Local StC coordinates +ServoDyn['TStC4_Myl'] = False # (kN-m); Tower StC #4 -- Y resulting moment; Local StC coordinates +ServoDyn['TStC4_Mzl'] = False # (kN-m); Tower StC #4 -- Z resulting moment; Local StC coordinates -# WAMIT Body Forces -WAMIT['Wave1El2'] = False # (m); 2nd order wave elevation correction; -WAMIT['Wave2El2'] = False # (m); 2nd order wave elevation correction; -WAMIT['Wave3El2'] = False # (m); 2nd order wave elevation correction; -WAMIT['Wave4El2'] = False # (m); 2nd order wave elevation correction; -WAMIT['Wave5El2'] = False # (m); 2nd order wave elevation correction; -WAMIT['Wave6El2'] = False # (m); 2nd order wave elevation correction; -WAMIT['Wave7El2'] = False # (m); 2nd order wave elevation correction; -WAMIT['Wave8El2'] = False # (m); 2nd order wave elevation correction; -WAMIT['Wave9El2'] = False # (m); 2nd order wave elevation correction; +# Blade Structural Control (StC) +ServoDyn['BStC1_B1_XQ'] = False # (m); Blade StC #1 Blade #1 -- X position (displacement); Relative to rest position in StC reference frame +ServoDyn['BStC1_B1_XQD'] = False # (m/s); Blade StC #1 Blade #1 -- X velocity; Relative to nacelle in StC reference frame +ServoDyn['BStC1_B1_YQ'] = False # (m); Blade StC #1 Blade #1 -- Y position (displacement); Relative to rest position in StC reference frame +ServoDyn['BStC1_B1_YQD'] = False # (m/s); Blade StC #1 Blade #1 -- Y velocity; Relative to nacelle in StC reference frame +ServoDyn['BStC1_B1_ZQ'] = False # (m); Blade StC #1 Blade #1 -- Z position (displacement); Relative to rest position in StC reference frame +ServoDyn['BStC1_B1_ZQD'] = False # (m/s); Blade StC #1 Blade #1 -- Z velocity; Relative to nacelle in StC reference frame +ServoDyn['BStC1_B1_Fxi'] = False # (kN); Blade StC #1 Blade #1 -- X resulting force; Inertial (global) coordinates +ServoDyn['BStC1_B1_Fyi'] = False # (kN); Blade StC #1 Blade #1 -- Y resulting force; Inertial (global) coordinates +ServoDyn['BStC1_B1_Fzi'] = False # (kN); Blade StC #1 Blade #1 -- Z resulting force; Inertial (global) coordinates +ServoDyn['BStC1_B1_Mxi'] = False # (kN-m); Blade StC #1 Blade #1 -- X resulting moment; Inertial (global) coordinates +ServoDyn['BStC1_B1_Myi'] = False # (kN-m); Blade StC #1 Blade #1 -- Y resulting moment; Inertial (global) coordinates +ServoDyn['BStC1_B1_Mzi'] = False # (kN-m); Blade StC #1 Blade #1 -- Z resulting moment; Inertial (global) coordinates +ServoDyn['BStC1_B1_Fxl'] = False # (kN); Blade StC #1 Blade #1 -- X resulting force; Local StC coordinates +ServoDyn['BStC1_B1_Fyl'] = False # (kN); Blade StC #1 Blade #1 -- Y resulting force; Local StC coordinates +ServoDyn['BStC1_B1_Fzl'] = False # (kN); Blade StC #1 Blade #1 -- Z resulting force; Local StC coordinates +ServoDyn['BStC1_B1_Mxl'] = False # (kN-m); Blade StC #1 Blade #1 -- X resulting moment; Local StC coordinates +ServoDyn['BStC1_B1_Myl'] = False # (kN-m); Blade StC #1 Blade #1 -- Y resulting moment; Local StC coordinates +ServoDyn['BStC1_B1_Mzl'] = False # (kN-m); Blade StC #1 Blade #1 -- Z resulting moment; Local StC coordinates +ServoDyn['BStC2_B1_XQ'] = False # (m); Blade StC #2 Blade #1 -- X position (displacement); Relative to rest position in StC reference frame +ServoDyn['BStC2_B1_XQD'] = False # (m/s); Blade StC #2 Blade #1 -- X velocity; Relative to nacelle in StC reference frame +ServoDyn['BStC2_B1_YQ'] = False # (m); Blade StC #2 Blade #1 -- Y position (displacement); Relative to rest position in StC reference frame +ServoDyn['BStC2_B1_YQD'] = False # (m/s); Blade StC #2 Blade #1 -- Y velocity; Relative to nacelle in StC reference frame +ServoDyn['BStC2_B1_ZQ'] = False # (m); Blade StC #2 Blade #1 -- Z position (displacement); Relative to rest position in StC reference frame +ServoDyn['BStC2_B1_ZQD'] = False # (m/s); Blade StC #2 Blade #1 -- Z velocity; Relative to nacelle in StC reference frame +ServoDyn['BStC2_B1_Fxi'] = False # (kN); Blade StC #2 Blade #1 -- X resulting force; Inertial (global) coordinates +ServoDyn['BStC2_B1_Fyi'] = False # (kN); Blade StC #2 Blade #1 -- Y resulting force; Inertial (global) coordinates +ServoDyn['BStC2_B1_Fzi'] = False # (kN); Blade StC #2 Blade #1 -- Z resulting force; Inertial (global) coordinates +ServoDyn['BStC2_B1_Mxi'] = False # (kN-m); Blade StC #2 Blade #1 -- X resulting moment; Inertial (global) coordinates +ServoDyn['BStC2_B1_Myi'] = False # (kN-m); Blade StC #2 Blade #1 -- Y resulting moment; Inertial (global) coordinates +ServoDyn['BStC2_B1_Mzi'] = False # (kN-m); Blade StC #2 Blade #1 -- Z resulting moment; Inertial (global) coordinates +ServoDyn['BStC2_B1_Fxl'] = False # (kN); Blade StC #2 Blade #1 -- X resulting force; Local StC coordinates +ServoDyn['BStC2_B1_Fyl'] = False # (kN); Blade StC #2 Blade #1 -- Y resulting force; Local StC coordinates +ServoDyn['BStC2_B1_Fzl'] = False # (kN); Blade StC #2 Blade #1 -- Z resulting force; Local StC coordinates +ServoDyn['BStC2_B1_Mxl'] = False # (kN-m); Blade StC #2 Blade #1 -- X resulting moment; Local StC coordinates +ServoDyn['BStC2_B1_Myl'] = False # (kN-m); Blade StC #2 Blade #1 -- Y resulting moment; Local StC coordinates +ServoDyn['BStC2_B1_Mzl'] = False # (kN-m); Blade StC #2 Blade #1 -- Z resulting moment; Local StC coordinates +ServoDyn['BStC3_B1_XQ'] = False # (m); Blade StC #3 Blade #1 -- X position (displacement); Relative to rest position in StC reference frame +ServoDyn['BStC3_B1_XQD'] = False # (m/s); Blade StC #3 Blade #1 -- X velocity; Relative to nacelle in StC reference frame +ServoDyn['BStC3_B1_YQ'] = False # (m); Blade StC #3 Blade #1 -- Y position (displacement); Relative to rest position in StC reference frame +ServoDyn['BStC3_B1_YQD'] = False # (m/s); Blade StC #3 Blade #1 -- Y velocity; Relative to nacelle in StC reference frame +ServoDyn['BStC3_B1_ZQ'] = False # (m); Blade StC #3 Blade #1 -- Z position (displacement); Relative to rest position in StC reference frame +ServoDyn['BStC3_B1_ZQD'] = False # (m/s); Blade StC #3 Blade #1 -- Z velocity; Relative to nacelle in StC reference frame +ServoDyn['BStC3_B1_Fxi'] = False # (kN); Blade StC #3 Blade #1 -- X resulting force; Inertial (global) coordinates +ServoDyn['BStC3_B1_Fyi'] = False # (kN); Blade StC #3 Blade #1 -- Y resulting force; Inertial (global) coordinates +ServoDyn['BStC3_B1_Fzi'] = False # (kN); Blade StC #3 Blade #1 -- Z resulting force; Inertial (global) coordinates +ServoDyn['BStC3_B1_Mxi'] = False # (kN-m); Blade StC #3 Blade #1 -- X resulting moment; Inertial (global) coordinates +ServoDyn['BStC3_B1_Myi'] = False # (kN-m); Blade StC #3 Blade #1 -- Y resulting moment; Inertial (global) coordinates +ServoDyn['BStC3_B1_Mzi'] = False # (kN-m); Blade StC #3 Blade #1 -- Z resulting moment; Inertial (global) coordinates +ServoDyn['BStC3_B1_Fxl'] = False # (kN); Blade StC #3 Blade #1 -- X resulting force; Local StC coordinates +ServoDyn['BStC3_B1_Fyl'] = False # (kN); Blade StC #3 Blade #1 -- Y resulting force; Local StC coordinates +ServoDyn['BStC3_B1_Fzl'] = False # (kN); Blade StC #3 Blade #1 -- Z resulting force; Local StC coordinates +ServoDyn['BStC3_B1_Mxl'] = False # (kN-m); Blade StC #3 Blade #1 -- X resulting moment; Local StC coordinates +ServoDyn['BStC3_B1_Myl'] = False # (kN-m); Blade StC #3 Blade #1 -- Y resulting moment; Local StC coordinates +ServoDyn['BStC3_B1_Mzl'] = False # (kN-m); Blade StC #3 Blade #1 -- Z resulting moment; Local StC coordinates +ServoDyn['BStC4_B1_XQ'] = False # (m); Blade StC #4 Blade #1 -- X position (displacement); Relative to rest position in StC reference frame +ServoDyn['BStC4_B1_XQD'] = False # (m/s); Blade StC #4 Blade #1 -- X velocity; Relative to nacelle in StC reference frame +ServoDyn['BStC4_B1_YQ'] = False # (m); Blade StC #4 Blade #1 -- Y position (displacement); Relative to rest position in StC reference frame +ServoDyn['BStC4_B1_YQD'] = False # (m/s); Blade StC #4 Blade #1 -- Y velocity; Relative to nacelle in StC reference frame +ServoDyn['BStC4_B1_ZQ'] = False # (m); Blade StC #4 Blade #1 -- Z position (displacement); Relative to rest position in StC reference frame +ServoDyn['BStC4_B1_ZQD'] = False # (m/s); Blade StC #4 Blade #1 -- Z velocity; Relative to nacelle in StC reference frame +ServoDyn['BStC4_B1_Fxi'] = False # (kN); Blade StC #4 Blade #1 -- X resulting force; Inertial (global) coordinates +ServoDyn['BStC4_B1_Fyi'] = False # (kN); Blade StC #4 Blade #1 -- Y resulting force; Inertial (global) coordinates +ServoDyn['BStC4_B1_Fzi'] = False # (kN); Blade StC #4 Blade #1 -- Z resulting force; Inertial (global) coordinates +ServoDyn['BStC4_B1_Mxi'] = False # (kN-m); Blade StC #4 Blade #1 -- X resulting moment; Inertial (global) coordinates +ServoDyn['BStC4_B1_Myi'] = False # (kN-m); Blade StC #4 Blade #1 -- Y resulting moment; Inertial (global) coordinates +ServoDyn['BStC4_B1_Mzi'] = False # (kN-m); Blade StC #4 Blade #1 -- Z resulting moment; Inertial (global) coordinates +ServoDyn['BStC4_B1_Fxl'] = False # (kN); Blade StC #4 Blade #1 -- X resulting force; Local StC coordinates +ServoDyn['BStC4_B1_Fyl'] = False # (kN); Blade StC #4 Blade #1 -- Y resulting force; Local StC coordinates +ServoDyn['BStC4_B1_Fzl'] = False # (kN); Blade StC #4 Blade #1 -- Z resulting force; Local StC coordinates +ServoDyn['BStC4_B1_Mxl'] = False # (kN-m); Blade StC #4 Blade #1 -- X resulting moment; Local StC coordinates +ServoDyn['BStC4_B1_Myl'] = False # (kN-m); Blade StC #4 Blade #1 -- Y resulting moment; Local StC coordinates +ServoDyn['BStC4_B1_Mzl'] = False # (kN-m); Blade StC #4 Blade #1 -- Z resulting moment; Local StC coordinates +ServoDyn['BStC1_B2_XQ'] = False # (m); Blade StC #1 Blade #2 -- X position (displacement); Relative to rest position in StC reference frame +ServoDyn['BStC1_B2_XQD'] = False # (m/s); Blade StC #1 Blade #2 -- X velocity; Relative to nacelle in StC reference frame +ServoDyn['BStC1_B2_YQ'] = False # (m); Blade StC #1 Blade #2 -- Y position (displacement); Relative to rest position in StC reference frame +ServoDyn['BStC1_B2_YQD'] = False # (m/s); Blade StC #1 Blade #2 -- Y velocity; Relative to nacelle in StC reference frame +ServoDyn['BStC1_B2_ZQ'] = False # (m); Blade StC #1 Blade #2 -- Z position (displacement); Relative to rest position in StC reference frame +ServoDyn['BStC1_B2_ZQD'] = False # (m/s); Blade StC #1 Blade #2 -- Z velocity; Relative to nacelle in StC reference frame +ServoDyn['BStC1_B2_Fxi'] = False # (kN); Blade StC #1 Blade #2 -- X resulting force; Inertial (global) coordinates +ServoDyn['BStC1_B2_Fyi'] = False # (kN); Blade StC #1 Blade #2 -- Y resulting force; Inertial (global) coordinates +ServoDyn['BStC1_B2_Fzi'] = False # (kN); Blade StC #1 Blade #2 -- Z resulting force; Inertial (global) coordinates +ServoDyn['BStC1_B2_Mxi'] = False # (kN-m); Blade StC #1 Blade #2 -- X resulting moment; Inertial (global) coordinates +ServoDyn['BStC1_B2_Myi'] = False # (kN-m); Blade StC #1 Blade #2 -- Y resulting moment; Inertial (global) coordinates +ServoDyn['BStC1_B2_Mzi'] = False # (kN-m); Blade StC #1 Blade #2 -- Z resulting moment; Inertial (global) coordinates +ServoDyn['BStC1_B2_Fxl'] = False # (kN); Blade StC #1 Blade #2 -- X resulting force; Local StC coordinates +ServoDyn['BStC1_B2_Fyl'] = False # (kN); Blade StC #1 Blade #2 -- Y resulting force; Local StC coordinates +ServoDyn['BStC1_B2_Fzl'] = False # (kN); Blade StC #1 Blade #2 -- Z resulting force; Local StC coordinates +ServoDyn['BStC1_B2_Mxl'] = False # (kN-m); Blade StC #1 Blade #2 -- X resulting moment; Local StC coordinates +ServoDyn['BStC1_B2_Myl'] = False # (kN-m); Blade StC #1 Blade #2 -- Y resulting moment; Local StC coordinates +ServoDyn['BStC1_B2_Mzl'] = False # (kN-m); Blade StC #1 Blade #2 -- Z resulting moment; Local StC coordinates +ServoDyn['BStC2_B2_XQ'] = False # (m); Blade StC #2 Blade #2 -- X position (displacement); Relative to rest position in StC reference frame +ServoDyn['BStC2_B2_XQD'] = False # (m/s); Blade StC #2 Blade #2 -- X velocity; Relative to nacelle in StC reference frame +ServoDyn['BStC2_B2_YQ'] = False # (m); Blade StC #2 Blade #2 -- Y position (displacement); Relative to rest position in StC reference frame +ServoDyn['BStC2_B2_YQD'] = False # (m/s); Blade StC #2 Blade #2 -- Y velocity; Relative to nacelle in StC reference frame +ServoDyn['BStC2_B2_ZQ'] = False # (m); Blade StC #2 Blade #2 -- Z position (displacement); Relative to rest position in StC reference frame +ServoDyn['BStC2_B2_ZQD'] = False # (m/s); Blade StC #2 Blade #2 -- Z velocity; Relative to nacelle in StC reference frame +ServoDyn['BStC2_B2_Fxi'] = False # (kN); Blade StC #2 Blade #2 -- X resulting force; Inertial (global) coordinates +ServoDyn['BStC2_B2_Fyi'] = False # (kN); Blade StC #2 Blade #2 -- Y resulting force; Inertial (global) coordinates +ServoDyn['BStC2_B2_Fzi'] = False # (kN); Blade StC #2 Blade #2 -- Z resulting force; Inertial (global) coordinates +ServoDyn['BStC2_B2_Mxi'] = False # (kN-m); Blade StC #2 Blade #2 -- X resulting moment; Inertial (global) coordinates +ServoDyn['BStC2_B2_Myi'] = False # (kN-m); Blade StC #2 Blade #2 -- Y resulting moment; Inertial (global) coordinates +ServoDyn['BStC2_B2_Mzi'] = False # (kN-m); Blade StC #2 Blade #2 -- Z resulting moment; Inertial (global) coordinates +ServoDyn['BStC2_B2_Fxl'] = False # (kN); Blade StC #2 Blade #2 -- X resulting force; Local StC coordinates +ServoDyn['BStC2_B2_Fyl'] = False # (kN); Blade StC #2 Blade #2 -- Y resulting force; Local StC coordinates +ServoDyn['BStC2_B2_Fzl'] = False # (kN); Blade StC #2 Blade #2 -- Z resulting force; Local StC coordinates +ServoDyn['BStC2_B2_Mxl'] = False # (kN-m); Blade StC #2 Blade #2 -- X resulting moment; Local StC coordinates +ServoDyn['BStC2_B2_Myl'] = False # (kN-m); Blade StC #2 Blade #2 -- Y resulting moment; Local StC coordinates +ServoDyn['BStC2_B2_Mzl'] = False # (kN-m); Blade StC #2 Blade #2 -- Z resulting moment; Local StC coordinates +ServoDyn['BStC3_B2_XQ'] = False # (m); Blade StC #3 Blade #2 -- X position (displacement); Relative to rest position in StC reference frame +ServoDyn['BStC3_B2_XQD'] = False # (m/s); Blade StC #3 Blade #2 -- X velocity; Relative to nacelle in StC reference frame +ServoDyn['BStC3_B2_YQ'] = False # (m); Blade StC #3 Blade #2 -- Y position (displacement); Relative to rest position in StC reference frame +ServoDyn['BStC3_B2_YQD'] = False # (m/s); Blade StC #3 Blade #2 -- Y velocity; Relative to nacelle in StC reference frame +ServoDyn['BStC3_B2_ZQ'] = False # (m); Blade StC #3 Blade #2 -- Z position (displacement); Relative to rest position in StC reference frame +ServoDyn['BStC3_B2_ZQD'] = False # (m/s); Blade StC #3 Blade #2 -- Z velocity; Relative to nacelle in StC reference frame +ServoDyn['BStC3_B2_Fxi'] = False # (kN); Blade StC #3 Blade #2 -- X resulting force; Inertial (global) coordinates +ServoDyn['BStC3_B2_Fyi'] = False # (kN); Blade StC #3 Blade #2 -- Y resulting force; Inertial (global) coordinates +ServoDyn['BStC3_B2_Fzi'] = False # (kN); Blade StC #3 Blade #2 -- Z resulting force; Inertial (global) coordinates +ServoDyn['BStC3_B2_Mxi'] = False # (kN-m); Blade StC #3 Blade #2 -- X resulting moment; Inertial (global) coordinates +ServoDyn['BStC3_B2_Myi'] = False # (kN-m); Blade StC #3 Blade #2 -- Y resulting moment; Inertial (global) coordinates +ServoDyn['BStC3_B2_Mzi'] = False # (kN-m); Blade StC #3 Blade #2 -- Z resulting moment; Inertial (global) coordinates +ServoDyn['BStC3_B2_Fxl'] = False # (kN); Blade StC #3 Blade #2 -- X resulting force; Local StC coordinates +ServoDyn['BStC3_B2_Fyl'] = False # (kN); Blade StC #3 Blade #2 -- Y resulting force; Local StC coordinates +ServoDyn['BStC3_B2_Fzl'] = False # (kN); Blade StC #3 Blade #2 -- Z resulting force; Local StC coordinates +ServoDyn['BStC3_B2_Mxl'] = False # (kN-m); Blade StC #3 Blade #2 -- X resulting moment; Local StC coordinates +ServoDyn['BStC3_B2_Myl'] = False # (kN-m); Blade StC #3 Blade #2 -- Y resulting moment; Local StC coordinates +ServoDyn['BStC3_B2_Mzl'] = False # (kN-m); Blade StC #3 Blade #2 -- Z resulting moment; Local StC coordinates +ServoDyn['BStC4_B2_XQ'] = False # (m); Blade StC #4 Blade #2 -- X position (displacement); Relative to rest position in StC reference frame +ServoDyn['BStC4_B2_XQD'] = False # (m/s); Blade StC #4 Blade #2 -- X velocity; Relative to nacelle in StC reference frame +ServoDyn['BStC4_B2_YQ'] = False # (m); Blade StC #4 Blade #2 -- Y position (displacement); Relative to rest position in StC reference frame +ServoDyn['BStC4_B2_YQD'] = False # (m/s); Blade StC #4 Blade #2 -- Y velocity; Relative to nacelle in StC reference frame +ServoDyn['BStC4_B2_ZQ'] = False # (m); Blade StC #4 Blade #2 -- Z position (displacement); Relative to rest position in StC reference frame +ServoDyn['BStC4_B2_ZQD'] = False # (m/s); Blade StC #4 Blade #2 -- Z velocity; Relative to nacelle in StC reference frame +ServoDyn['BStC4_B2_Fxi'] = False # (kN); Blade StC #4 Blade #2 -- X resulting force; Inertial (global) coordinates +ServoDyn['BStC4_B2_Fyi'] = False # (kN); Blade StC #4 Blade #2 -- Y resulting force; Inertial (global) coordinates +ServoDyn['BStC4_B2_Fzi'] = False # (kN); Blade StC #4 Blade #2 -- Z resulting force; Inertial (global) coordinates +ServoDyn['BStC4_B2_Mxi'] = False # (kN-m); Blade StC #4 Blade #2 -- X resulting moment; Inertial (global) coordinates +ServoDyn['BStC4_B2_Myi'] = False # (kN-m); Blade StC #4 Blade #2 -- Y resulting moment; Inertial (global) coordinates +ServoDyn['BStC4_B2_Mzi'] = False # (kN-m); Blade StC #4 Blade #2 -- Z resulting moment; Inertial (global) coordinates +ServoDyn['BStC4_B2_Fxl'] = False # (kN); Blade StC #4 Blade #2 -- X resulting force; Local StC coordinates +ServoDyn['BStC4_B2_Fyl'] = False # (kN); Blade StC #4 Blade #2 -- Y resulting force; Local StC coordinates +ServoDyn['BStC4_B2_Fzl'] = False # (kN); Blade StC #4 Blade #2 -- Z resulting force; Local StC coordinates +ServoDyn['BStC4_B2_Mxl'] = False # (kN-m); Blade StC #4 Blade #2 -- X resulting moment; Local StC coordinates +ServoDyn['BStC4_B2_Myl'] = False # (kN-m); Blade StC #4 Blade #2 -- Y resulting moment; Local StC coordinates +ServoDyn['BStC4_B2_Mzl'] = False # (kN-m); Blade StC #4 Blade #2 -- Z resulting moment; Local StC coordinates +ServoDyn['BStC1_B3_XQ'] = False # (m); Blade StC #1 Blade #3 -- X position (displacement); Relative to rest position in StC reference frame +ServoDyn['BStC1_B3_XQD'] = False # (m/s); Blade StC #1 Blade #3 -- X velocity; Relative to nacelle in StC reference frame +ServoDyn['BStC1_B3_YQ'] = False # (m); Blade StC #1 Blade #3 -- Y position (displacement); Relative to rest position in StC reference frame +ServoDyn['BStC1_B3_YQD'] = False # (m/s); Blade StC #1 Blade #3 -- Y velocity; Relative to nacelle in StC reference frame +ServoDyn['BStC1_B3_ZQ'] = False # (m); Blade StC #1 Blade #3 -- Z position (displacement); Relative to rest position in StC reference frame +ServoDyn['BStC1_B3_ZQD'] = False # (m/s); Blade StC #1 Blade #3 -- Z velocity; Relative to nacelle in StC reference frame +ServoDyn['BStC1_B3_Fxi'] = False # (kN); Blade StC #1 Blade #3 -- X resulting force; Inertial (global) coordinates +ServoDyn['BStC1_B3_Fyi'] = False # (kN); Blade StC #1 Blade #3 -- Y resulting force; Inertial (global) coordinates +ServoDyn['BStC1_B3_Fzi'] = False # (kN); Blade StC #1 Blade #3 -- Z resulting force; Inertial (global) coordinates +ServoDyn['BStC1_B3_Mxi'] = False # (kN-m); Blade StC #1 Blade #3 -- X resulting moment; Inertial (global) coordinates +ServoDyn['BStC1_B3_Myi'] = False # (kN-m); Blade StC #1 Blade #3 -- Y resulting moment; Inertial (global) coordinates +ServoDyn['BStC1_B3_Mzi'] = False # (kN-m); Blade StC #1 Blade #3 -- Z resulting moment; Inertial (global) coordinates +ServoDyn['BStC1_B3_Fxl'] = False # (kN); Blade StC #1 Blade #3 -- X resulting force; Local StC coordinates +ServoDyn['BStC1_B3_Fyl'] = False # (kN); Blade StC #1 Blade #3 -- Y resulting force; Local StC coordinates +ServoDyn['BStC1_B3_Fzl'] = False # (kN); Blade StC #1 Blade #3 -- Z resulting force; Local StC coordinates +ServoDyn['BStC1_B3_Mxl'] = False # (kN-m); Blade StC #1 Blade #3 -- X resulting moment; Local StC coordinates +ServoDyn['BStC1_B3_Myl'] = False # (kN-m); Blade StC #1 Blade #3 -- Y resulting moment; Local StC coordinates +ServoDyn['BStC1_B3_Mzl'] = False # (kN-m); Blade StC #1 Blade #3 -- Z resulting moment; Local StC coordinates +ServoDyn['BStC2_B3_XQ'] = False # (m); Blade StC #2 Blade #3 -- X position (displacement); Relative to rest position in StC reference frame +ServoDyn['BStC2_B3_XQD'] = False # (m/s); Blade StC #2 Blade #3 -- X velocity; Relative to nacelle in StC reference frame +ServoDyn['BStC2_B3_YQ'] = False # (m); Blade StC #2 Blade #3 -- Y position (displacement); Relative to rest position in StC reference frame +ServoDyn['BStC2_B3_YQD'] = False # (m/s); Blade StC #2 Blade #3 -- Y velocity; Relative to nacelle in StC reference frame +ServoDyn['BStC2_B3_ZQ'] = False # (m); Blade StC #2 Blade #3 -- Z position (displacement); Relative to rest position in StC reference frame +ServoDyn['BStC2_B3_ZQD'] = False # (m/s); Blade StC #2 Blade #3 -- Z velocity; Relative to nacelle in StC reference frame +ServoDyn['BStC2_B3_Fxi'] = False # (kN); Blade StC #2 Blade #3 -- X resulting force; Inertial (global) coordinates +ServoDyn['BStC2_B3_Fyi'] = False # (kN); Blade StC #2 Blade #3 -- Y resulting force; Inertial (global) coordinates +ServoDyn['BStC2_B3_Fzi'] = False # (kN); Blade StC #2 Blade #3 -- Z resulting force; Inertial (global) coordinates +ServoDyn['BStC2_B3_Mxi'] = False # (kN-m); Blade StC #2 Blade #3 -- X resulting moment; Inertial (global) coordinates +ServoDyn['BStC2_B3_Myi'] = False # (kN-m); Blade StC #2 Blade #3 -- Y resulting moment; Inertial (global) coordinates +ServoDyn['BStC2_B3_Mzi'] = False # (kN-m); Blade StC #2 Blade #3 -- Z resulting moment; Inertial (global) coordinates +ServoDyn['BStC2_B3_Fxl'] = False # (kN); Blade StC #2 Blade #3 -- X resulting force; Local StC coordinates +ServoDyn['BStC2_B3_Fyl'] = False # (kN); Blade StC #2 Blade #3 -- Y resulting force; Local StC coordinates +ServoDyn['BStC2_B3_Fzl'] = False # (kN); Blade StC #2 Blade #3 -- Z resulting force; Local StC coordinates +ServoDyn['BStC2_B3_Mxl'] = False # (kN-m); Blade StC #2 Blade #3 -- X resulting moment; Local StC coordinates +ServoDyn['BStC2_B3_Myl'] = False # (kN-m); Blade StC #2 Blade #3 -- Y resulting moment; Local StC coordinates +ServoDyn['BStC2_B3_Mzl'] = False # (kN-m); Blade StC #2 Blade #3 -- Z resulting moment; Local StC coordinates +ServoDyn['BStC3_B3_XQ'] = False # (m); Blade StC #3 Blade #3 -- X position (displacement); Relative to rest position in StC reference frame +ServoDyn['BStC3_B3_XQD'] = False # (m/s); Blade StC #3 Blade #3 -- X velocity; Relative to nacelle in StC reference frame +ServoDyn['BStC3_B3_YQ'] = False # (m); Blade StC #3 Blade #3 -- Y position (displacement); Relative to rest position in StC reference frame +ServoDyn['BStC3_B3_YQD'] = False # (m/s); Blade StC #3 Blade #3 -- Y velocity; Relative to nacelle in StC reference frame +ServoDyn['BStC3_B3_ZQ'] = False # (m); Blade StC #3 Blade #3 -- Z position (displacement); Relative to rest position in StC reference frame +ServoDyn['BStC3_B3_ZQD'] = False # (m/s); Blade StC #3 Blade #3 -- Z velocity; Relative to nacelle in StC reference frame +ServoDyn['BStC3_B3_Fxi'] = False # (kN); Blade StC #3 Blade #3 -- X resulting force; Inertial (global) coordinates +ServoDyn['BStC3_B3_Fyi'] = False # (kN); Blade StC #3 Blade #3 -- Y resulting force; Inertial (global) coordinates +ServoDyn['BStC3_B3_Fzi'] = False # (kN); Blade StC #3 Blade #3 -- Z resulting force; Inertial (global) coordinates +ServoDyn['BStC3_B3_Mxi'] = False # (kN-m); Blade StC #3 Blade #3 -- X resulting moment; Inertial (global) coordinates +ServoDyn['BStC3_B3_Myi'] = False # (kN-m); Blade StC #3 Blade #3 -- Y resulting moment; Inertial (global) coordinates +ServoDyn['BStC3_B3_Mzi'] = False # (kN-m); Blade StC #3 Blade #3 -- Z resulting moment; Inertial (global) coordinates +ServoDyn['BStC3_B3_Fxl'] = False # (kN); Blade StC #3 Blade #3 -- X resulting force; Local StC coordinates +ServoDyn['BStC3_B3_Fyl'] = False # (kN); Blade StC #3 Blade #3 -- Y resulting force; Local StC coordinates +ServoDyn['BStC3_B3_Fzl'] = False # (kN); Blade StC #3 Blade #3 -- Z resulting force; Local StC coordinates +ServoDyn['BStC3_B3_Mxl'] = False # (kN-m); Blade StC #3 Blade #3 -- X resulting moment; Local StC coordinates +ServoDyn['BStC3_B3_Myl'] = False # (kN-m); Blade StC #3 Blade #3 -- Y resulting moment; Local StC coordinates +ServoDyn['BStC3_B3_Mzl'] = False # (kN-m); Blade StC #3 Blade #3 -- Z resulting moment; Local StC coordinates +ServoDyn['BStC4_B3_XQ'] = False # (m); Blade StC #4 Blade #3 -- X position (displacement); Relative to rest position in StC reference frame +ServoDyn['BStC4_B3_XQD'] = False # (m/s); Blade StC #4 Blade #3 -- X velocity; Relative to nacelle in StC reference frame +ServoDyn['BStC4_B3_YQ'] = False # (m); Blade StC #4 Blade #3 -- Y position (displacement); Relative to rest position in StC reference frame +ServoDyn['BStC4_B3_YQD'] = False # (m/s); Blade StC #4 Blade #3 -- Y velocity; Relative to nacelle in StC reference frame +ServoDyn['BStC4_B3_ZQ'] = False # (m); Blade StC #4 Blade #3 -- Z position (displacement); Relative to rest position in StC reference frame +ServoDyn['BStC4_B3_ZQD'] = False # (m/s); Blade StC #4 Blade #3 -- Z velocity; Relative to nacelle in StC reference frame +ServoDyn['BStC4_B3_Fxi'] = False # (kN); Blade StC #4 Blade #3 -- X resulting force; Inertial (global) coordinates +ServoDyn['BStC4_B3_Fyi'] = False # (kN); Blade StC #4 Blade #3 -- Y resulting force; Inertial (global) coordinates +ServoDyn['BStC4_B3_Fzi'] = False # (kN); Blade StC #4 Blade #3 -- Z resulting force; Inertial (global) coordinates +ServoDyn['BStC4_B3_Mxi'] = False # (kN-m); Blade StC #4 Blade #3 -- X resulting moment; Inertial (global) coordinates +ServoDyn['BStC4_B3_Myi'] = False # (kN-m); Blade StC #4 Blade #3 -- Y resulting moment; Inertial (global) coordinates +ServoDyn['BStC4_B3_Mzi'] = False # (kN-m); Blade StC #4 Blade #3 -- Z resulting moment; Inertial (global) coordinates +ServoDyn['BStC4_B3_Fxl'] = False # (kN); Blade StC #4 Blade #3 -- X resulting force; Local StC coordinates +ServoDyn['BStC4_B3_Fyl'] = False # (kN); Blade StC #4 Blade #3 -- Y resulting force; Local StC coordinates +ServoDyn['BStC4_B3_Fzl'] = False # (kN); Blade StC #4 Blade #3 -- Z resulting force; Local StC coordinates +ServoDyn['BStC4_B3_Mxl'] = False # (kN-m); Blade StC #4 Blade #3 -- X resulting moment; Local StC coordinates +ServoDyn['BStC4_B3_Myl'] = False # (kN-m); Blade StC #4 Blade #3 -- Y resulting moment; Local StC coordinates +ServoDyn['BStC4_B3_Mzl'] = False # (kN-m); Blade StC #4 Blade #3 -- Z resulting moment; Local StC coordinates +ServoDyn['BStC1_B4_XQ'] = False # (m); Blade StC #1 Blade #4 -- X position (displacement); Relative to rest position in StC reference frame +ServoDyn['BStC1_B4_XQD'] = False # (m/s); Blade StC #1 Blade #4 -- X velocity; Relative to nacelle in StC reference frame +ServoDyn['BStC1_B4_YQ'] = False # (m); Blade StC #1 Blade #4 -- Y position (displacement); Relative to rest position in StC reference frame +ServoDyn['BStC1_B4_YQD'] = False # (m/s); Blade StC #1 Blade #4 -- Y velocity; Relative to nacelle in StC reference frame +ServoDyn['BStC1_B4_ZQ'] = False # (m); Blade StC #1 Blade #4 -- Z position (displacement); Relative to rest position in StC reference frame +ServoDyn['BStC1_B4_ZQD'] = False # (m/s); Blade StC #1 Blade #4 -- Z velocity; Relative to nacelle in StC reference frame +ServoDyn['BStC1_B4_Fxi'] = False # (kN); Blade StC #1 Blade #4 -- X resulting force; Inertial (global) coordinates +ServoDyn['BStC1_B4_Fyi'] = False # (kN); Blade StC #1 Blade #4 -- Y resulting force; Inertial (global) coordinates +ServoDyn['BStC1_B4_Fzi'] = False # (kN); Blade StC #1 Blade #4 -- Z resulting force; Inertial (global) coordinates +ServoDyn['BStC1_B4_Mxi'] = False # (kN-m); Blade StC #1 Blade #4 -- X resulting moment; Inertial (global) coordinates +ServoDyn['BStC1_B4_Myi'] = False # (kN-m); Blade StC #1 Blade #4 -- Y resulting moment; Inertial (global) coordinates +ServoDyn['BStC1_B4_Mzi'] = False # (kN-m); Blade StC #1 Blade #4 -- Z resulting moment; Inertial (global) coordinates +ServoDyn['BStC1_B4_Fxl'] = False # (kN); Blade StC #1 Blade #4 -- X resulting force; Local StC coordinates +ServoDyn['BStC1_B4_Fyl'] = False # (kN); Blade StC #1 Blade #4 -- Y resulting force; Local StC coordinates +ServoDyn['BStC1_B4_Fzl'] = False # (kN); Blade StC #1 Blade #4 -- Z resulting force; Local StC coordinates +ServoDyn['BStC1_B4_Mxl'] = False # (kN-m); Blade StC #1 Blade #4 -- X resulting moment; Local StC coordinates +ServoDyn['BStC1_B4_Myl'] = False # (kN-m); Blade StC #1 Blade #4 -- Y resulting moment; Local StC coordinates +ServoDyn['BStC1_B4_Mzl'] = False # (kN-m); Blade StC #1 Blade #4 -- Z resulting moment; Local StC coordinates +ServoDyn['BStC2_B4_XQ'] = False # (m); Blade StC #2 Blade #4 -- X position (displacement); Relative to rest position in StC reference frame +ServoDyn['BStC2_B4_XQD'] = False # (m/s); Blade StC #2 Blade #4 -- X velocity; Relative to nacelle in StC reference frame +ServoDyn['BStC2_B4_YQ'] = False # (m); Blade StC #2 Blade #4 -- Y position (displacement); Relative to rest position in StC reference frame +ServoDyn['BStC2_B4_YQD'] = False # (m/s); Blade StC #2 Blade #4 -- Y velocity; Relative to nacelle in StC reference frame +ServoDyn['BStC2_B4_ZQ'] = False # (m); Blade StC #2 Blade #4 -- Z position (displacement); Relative to rest position in StC reference frame +ServoDyn['BStC2_B4_ZQD'] = False # (m/s); Blade StC #2 Blade #4 -- Z velocity; Relative to nacelle in StC reference frame +ServoDyn['BStC2_B4_Fxi'] = False # (kN); Blade StC #2 Blade #4 -- X resulting force; Inertial (global) coordinates +ServoDyn['BStC2_B4_Fyi'] = False # (kN); Blade StC #2 Blade #4 -- Y resulting force; Inertial (global) coordinates +ServoDyn['BStC2_B4_Fzi'] = False # (kN); Blade StC #2 Blade #4 -- Z resulting force; Inertial (global) coordinates +ServoDyn['BStC2_B4_Mxi'] = False # (kN-m); Blade StC #2 Blade #4 -- X resulting moment; Inertial (global) coordinates +ServoDyn['BStC2_B4_Myi'] = False # (kN-m); Blade StC #2 Blade #4 -- Y resulting moment; Inertial (global) coordinates +ServoDyn['BStC2_B4_Mzi'] = False # (kN-m); Blade StC #2 Blade #4 -- Z resulting moment; Inertial (global) coordinates +ServoDyn['BStC2_B4_Fxl'] = False # (kN); Blade StC #2 Blade #4 -- X resulting force; Local StC coordinates +ServoDyn['BStC2_B4_Fyl'] = False # (kN); Blade StC #2 Blade #4 -- Y resulting force; Local StC coordinates +ServoDyn['BStC2_B4_Fzl'] = False # (kN); Blade StC #2 Blade #4 -- Z resulting force; Local StC coordinates +ServoDyn['BStC2_B4_Mxl'] = False # (kN-m); Blade StC #2 Blade #4 -- X resulting moment; Local StC coordinates +ServoDyn['BStC2_B4_Myl'] = False # (kN-m); Blade StC #2 Blade #4 -- Y resulting moment; Local StC coordinates +ServoDyn['BStC2_B4_Mzl'] = False # (kN-m); Blade StC #2 Blade #4 -- Z resulting moment; Local StC coordinates +ServoDyn['BStC3_B4_XQ'] = False # (m); Blade StC #3 Blade #4 -- X position (displacement); Relative to rest position in StC reference frame +ServoDyn['BStC3_B4_XQD'] = False # (m/s); Blade StC #3 Blade #4 -- X velocity; Relative to nacelle in StC reference frame +ServoDyn['BStC3_B4_YQ'] = False # (m); Blade StC #3 Blade #4 -- Y position (displacement); Relative to rest position in StC reference frame +ServoDyn['BStC3_B4_YQD'] = False # (m/s); Blade StC #3 Blade #4 -- Y velocity; Relative to nacelle in StC reference frame +ServoDyn['BStC3_B4_ZQ'] = False # (m); Blade StC #3 Blade #4 -- Z position (displacement); Relative to rest position in StC reference frame +ServoDyn['BStC3_B4_ZQD'] = False # (m/s); Blade StC #3 Blade #4 -- Z velocity; Relative to nacelle in StC reference frame +ServoDyn['BStC3_B4_Fxi'] = False # (kN); Blade StC #3 Blade #4 -- X resulting force; Inertial (global) coordinates +ServoDyn['BStC3_B4_Fyi'] = False # (kN); Blade StC #3 Blade #4 -- Y resulting force; Inertial (global) coordinates +ServoDyn['BStC3_B4_Fzi'] = False # (kN); Blade StC #3 Blade #4 -- Z resulting force; Inertial (global) coordinates +ServoDyn['BStC3_B4_Mxi'] = False # (kN-m); Blade StC #3 Blade #4 -- X resulting moment; Inertial (global) coordinates +ServoDyn['BStC3_B4_Myi'] = False # (kN-m); Blade StC #3 Blade #4 -- Y resulting moment; Inertial (global) coordinates +ServoDyn['BStC3_B4_Mzi'] = False # (kN-m); Blade StC #3 Blade #4 -- Z resulting moment; Inertial (global) coordinates +ServoDyn['BStC3_B4_Fxl'] = False # (kN); Blade StC #3 Blade #4 -- X resulting force; Local StC coordinates +ServoDyn['BStC3_B4_Fyl'] = False # (kN); Blade StC #3 Blade #4 -- Y resulting force; Local StC coordinates +ServoDyn['BStC3_B4_Fzl'] = False # (kN); Blade StC #3 Blade #4 -- Z resulting force; Local StC coordinates +ServoDyn['BStC3_B4_Mxl'] = False # (kN-m); Blade StC #3 Blade #4 -- X resulting moment; Local StC coordinates +ServoDyn['BStC3_B4_Myl'] = False # (kN-m); Blade StC #3 Blade #4 -- Y resulting moment; Local StC coordinates +ServoDyn['BStC3_B4_Mzl'] = False # (kN-m); Blade StC #3 Blade #4 -- Z resulting moment; Local StC coordinates +ServoDyn['BStC4_B4_XQ'] = False # (m); Blade StC #4 Blade #4 -- X position (displacement); Relative to rest position in StC reference frame +ServoDyn['BStC4_B4_XQD'] = False # (m/s); Blade StC #4 Blade #4 -- X velocity; Relative to nacelle in StC reference frame +ServoDyn['BStC4_B4_YQ'] = False # (m); Blade StC #4 Blade #4 -- Y position (displacement); Relative to rest position in StC reference frame +ServoDyn['BStC4_B4_YQD'] = False # (m/s); Blade StC #4 Blade #4 -- Y velocity; Relative to nacelle in StC reference frame +ServoDyn['BStC4_B4_ZQ'] = False # (m); Blade StC #4 Blade #4 -- Z position (displacement); Relative to rest position in StC reference frame +ServoDyn['BStC4_B4_ZQD'] = False # (m/s); Blade StC #4 Blade #4 -- Z velocity; Relative to nacelle in StC reference frame +ServoDyn['BStC4_B4_Fxi'] = False # (kN); Blade StC #4 Blade #4 -- X resulting force; Inertial (global) coordinates +ServoDyn['BStC4_B4_Fyi'] = False # (kN); Blade StC #4 Blade #4 -- Y resulting force; Inertial (global) coordinates +ServoDyn['BStC4_B4_Fzi'] = False # (kN); Blade StC #4 Blade #4 -- Z resulting force; Inertial (global) coordinates +ServoDyn['BStC4_B4_Mxi'] = False # (kN-m); Blade StC #4 Blade #4 -- X resulting moment; Inertial (global) coordinates +ServoDyn['BStC4_B4_Myi'] = False # (kN-m); Blade StC #4 Blade #4 -- Y resulting moment; Inertial (global) coordinates +ServoDyn['BStC4_B4_Mzi'] = False # (kN-m); Blade StC #4 Blade #4 -- Z resulting moment; Inertial (global) coordinates +ServoDyn['BStC4_B4_Fxl'] = False # (kN); Blade StC #4 Blade #4 -- X resulting force; Local StC coordinates +ServoDyn['BStC4_B4_Fyl'] = False # (kN); Blade StC #4 Blade #4 -- Y resulting force; Local StC coordinates +ServoDyn['BStC4_B4_Fzl'] = False # (kN); Blade StC #4 Blade #4 -- Z resulting force; Local StC coordinates +ServoDyn['BStC4_B4_Mxl'] = False # (kN-m); Blade StC #4 Blade #4 -- X resulting moment; Local StC coordinates +ServoDyn['BStC4_B4_Myl'] = False # (kN-m); Blade StC #4 Blade #4 -- Y resulting moment; Local StC coordinates +ServoDyn['BStC4_B4_Mzl'] = False # (kN-m); Blade StC #4 Blade #4 -- Z resulting moment; Local StC coordinates -# WAMIT second order Body Forces -WAMIT['WavesF2xi'] = False # (N); ; -WAMIT['WavesF2yi'] = False # (N); ; -WAMIT['WavesF2zi'] = False # (N); ; -WAMIT['WavesM2xi'] = False # (N m); ; -WAMIT['WavesM2yi'] = False # (N m); ; -WAMIT['WavesM2zi'] = False # (N m); ; +# Substructure Structural Control (StC) +ServoDyn['SStC1_XQ'] = False # (m); Substructure StC #1 -- X position (displacement); Relative to rest position in StC reference frame +ServoDyn['SStC1_XQD'] = False # (m/s); Substructure StC #1 -- X velocity; Relative to nacelle in StC reference frame +ServoDyn['SStC1_YQ'] = False # (m); Substructure StC #1 -- Y position (displacement); Relative to rest position in StC reference frame +ServoDyn['SStC1_YQD'] = False # (m/s); Substructure StC #1 -- Y velocity; Relative to nacelle in StC reference frame +ServoDyn['SStC1_ZQ'] = False # (m); Substructure StC #1 -- Z position (displacement); Relative to rest position in StC reference frame +ServoDyn['SStC1_ZQD'] = False # (m/s); Substructure StC #1 -- Z velocity; Relative to nacelle in StC reference frame +ServoDyn['SStC1_Fxi'] = False # (kN); Substructure StC #1 -- X resulting force; Inertial (global) coordinates +ServoDyn['SStC1_Fyi'] = False # (kN); Substructure StC #1 -- Y resulting force; Inertial (global) coordinates +ServoDyn['SStC1_Fzi'] = False # (kN); Substructure StC #1 -- Z resulting force; Inertial (global) coordinates +ServoDyn['SStC1_Mxi'] = False # (kN-m); Substructure StC #1 -- X resulting moment; Inertial (global) coordinates +ServoDyn['SStC1_Myi'] = False # (kN-m); Substructure StC #1 -- Y resulting moment; Inertial (global) coordinates +ServoDyn['SStC1_Mzi'] = False # (kN-m); Substructure StC #1 -- Z resulting moment; Inertial (global) coordinates +ServoDyn['SStC1_Fxl'] = False # (kN); Substructure StC #1 -- X resulting force; Local StC coordinates +ServoDyn['SStC1_Fyl'] = False # (kN); Substructure StC #1 -- Y resulting force; Local StC coordinates +ServoDyn['SStC1_Fzl'] = False # (kN); Substructure StC #1 -- Z resulting force; Local StC coordinates +ServoDyn['SStC1_Mxl'] = False # (kN-m); Substructure StC #1 -- X resulting moment; Local StC coordinates +ServoDyn['SStC1_Myl'] = False # (kN-m); Substructure StC #1 -- Y resulting moment; Local StC coordinates +ServoDyn['SStC1_Mzl'] = False # (kN-m); Substructure StC #1 -- Z resulting moment; Local StC coordinates +ServoDyn['SStC2_XQ'] = False # (m); Substructure StC #2 -- X position (displacement); Relative to rest position in StC reference frame +ServoDyn['SStC2_XQD'] = False # (m/s); Substructure StC #2 -- X velocity; Relative to nacelle in StC reference frame +ServoDyn['SStC2_YQ'] = False # (m); Substructure StC #2 -- Y position (displacement); Relative to rest position in StC reference frame +ServoDyn['SStC2_YQD'] = False # (m/s); Substructure StC #2 -- Y velocity; Relative to nacelle in StC reference frame +ServoDyn['SStC2_ZQ'] = False # (m); Substructure StC #2 -- Z position (displacement); Relative to rest position in StC reference frame +ServoDyn['SStC2_ZQD'] = False # (m/s); Substructure StC #2 -- Z velocity; Relative to nacelle in StC reference frame +ServoDyn['SStC2_Fxi'] = False # (kN); Substructure StC #2 -- X resulting force; Inertial (global) coordinates +ServoDyn['SStC2_Fyi'] = False # (kN); Substructure StC #2 -- Y resulting force; Inertial (global) coordinates +ServoDyn['SStC2_Fzi'] = False # (kN); Substructure StC #2 -- Z resulting force; Inertial (global) coordinates +ServoDyn['SStC2_Mxi'] = False # (kN-m); Substructure StC #2 -- X resulting moment; Inertial (global) coordinates +ServoDyn['SStC2_Myi'] = False # (kN-m); Substructure StC #2 -- Y resulting moment; Inertial (global) coordinates +ServoDyn['SStC2_Mzi'] = False # (kN-m); Substructure StC #2 -- Z resulting moment; Inertial (global) coordinates +ServoDyn['SStC2_Fxl'] = False # (kN); Substructure StC #2 -- X resulting force; Local StC coordinates +ServoDyn['SStC2_Fyl'] = False # (kN); Substructure StC #2 -- Y resulting force; Local StC coordinates +ServoDyn['SStC2_Fzl'] = False # (kN); Substructure StC #2 -- Z resulting force; Local StC coordinates +ServoDyn['SStC2_Mxl'] = False # (kN-m); Substructure StC #2 -- X resulting moment; Local StC coordinates +ServoDyn['SStC2_Myl'] = False # (kN-m); Substructure StC #2 -- Y resulting moment; Local StC coordinates +ServoDyn['SStC2_Mzl'] = False # (kN-m); Substructure StC #2 -- Z resulting moment; Local StC coordinates +ServoDyn['SStC3_XQ'] = False # (m); Substructure StC #3 -- X position (displacement); Relative to rest position in StC reference frame +ServoDyn['SStC3_XQD'] = False # (m/s); Substructure StC #3 -- X velocity; Relative to nacelle in StC reference frame +ServoDyn['SStC3_YQ'] = False # (m); Substructure StC #3 -- Y position (displacement); Relative to rest position in StC reference frame +ServoDyn['SStC3_YQD'] = False # (m/s); Substructure StC #3 -- Y velocity; Relative to nacelle in StC reference frame +ServoDyn['SStC3_ZQ'] = False # (m); Substructure StC #3 -- Z position (displacement); Relative to rest position in StC reference frame +ServoDyn['SStC3_ZQD'] = False # (m/s); Substructure StC #3 -- Z velocity; Relative to nacelle in StC reference frame +ServoDyn['SStC3_Fxi'] = False # (kN); Substructure StC #3 -- X resulting force; Inertial (global) coordinates +ServoDyn['SStC3_Fyi'] = False # (kN); Substructure StC #3 -- Y resulting force; Inertial (global) coordinates +ServoDyn['SStC3_Fzi'] = False # (kN); Substructure StC #3 -- Z resulting force; Inertial (global) coordinates +ServoDyn['SStC3_Mxi'] = False # (kN-m); Substructure StC #3 -- X resulting moment; Inertial (global) coordinates +ServoDyn['SStC3_Myi'] = False # (kN-m); Substructure StC #3 -- Y resulting moment; Inertial (global) coordinates +ServoDyn['SStC3_Mzi'] = False # (kN-m); Substructure StC #3 -- Z resulting moment; Inertial (global) coordinates +ServoDyn['SStC3_Fxl'] = False # (kN); Substructure StC #3 -- X resulting force; Local StC coordinates +ServoDyn['SStC3_Fyl'] = False # (kN); Substructure StC #3 -- Y resulting force; Local StC coordinates +ServoDyn['SStC3_Fzl'] = False # (kN); Substructure StC #3 -- Z resulting force; Local StC coordinates +ServoDyn['SStC3_Mxl'] = False # (kN-m); Substructure StC #3 -- X resulting moment; Local StC coordinates +ServoDyn['SStC3_Myl'] = False # (kN-m); Substructure StC #3 -- Y resulting moment; Local StC coordinates +ServoDyn['SStC3_Mzl'] = False # (kN-m); Substructure StC #3 -- Z resulting moment; Local StC coordinates +ServoDyn['SStC4_XQ'] = False # (m); Substructure StC #4 -- X position (displacement); Relative to rest position in StC reference frame +ServoDyn['SStC4_XQD'] = False # (m/s); Substructure StC #4 -- X velocity; Relative to nacelle in StC reference frame +ServoDyn['SStC4_YQ'] = False # (m); Substructure StC #4 -- Y position (displacement); Relative to rest position in StC reference frame +ServoDyn['SStC4_YQD'] = False # (m/s); Substructure StC #4 -- Y velocity; Relative to nacelle in StC reference frame +ServoDyn['SStC4_ZQ'] = False # (m); Substructure StC #4 -- Z position (displacement); Relative to rest position in StC reference frame +ServoDyn['SStC4_ZQD'] = False # (m/s); Substructure StC #4 -- Z velocity; Relative to nacelle in StC reference frame +ServoDyn['SStC4_Fxi'] = False # (kN); Substructure StC #4 -- X resulting force; Inertial (global) coordinates +ServoDyn['SStC4_Fyi'] = False # (kN); Substructure StC #4 -- Y resulting force; Inertial (global) coordinates +ServoDyn['SStC4_Fzi'] = False # (kN); Substructure StC #4 -- Z resulting force; Inertial (global) coordinates +ServoDyn['SStC4_Mxi'] = False # (kN-m); Substructure StC #4 -- X resulting moment; Inertial (global) coordinates +ServoDyn['SStC4_Myi'] = False # (kN-m); Substructure StC #4 -- Y resulting moment; Inertial (global) coordinates +ServoDyn['SStC4_Mzi'] = False # (kN-m); Substructure StC #4 -- Z resulting moment; Inertial (global) coordinates +ServoDyn['SStC4_Fxl'] = False # (kN); Substructure StC #4 -- X resulting force; Local StC coordinates +ServoDyn['SStC4_Fyl'] = False # (kN); Substructure StC #4 -- Y resulting force; Local StC coordinates +ServoDyn['SStC4_Fzl'] = False # (kN); Substructure StC #4 -- Z resulting force; Local StC coordinates +ServoDyn['SStC4_Mxl'] = False # (kN-m); Substructure StC #4 -- X resulting moment; Local StC coordinates +ServoDyn['SStC4_Myl'] = False # (kN-m); Substructure StC #4 -- Y resulting moment; Local StC coordinates +ServoDyn['SStC4_Mzl'] = False # (kN-m); Substructure StC #4 -- Z resulting moment; Local StC coordinates -# WAMIT Body Forces -WAMIT['WavesFxi'] = False # (N); ; -WAMIT['WavesFyi'] = False # (N); ; -WAMIT['WavesFzi'] = False # (N); ; -WAMIT['WavesMxi'] = False # (N m); ; -WAMIT['WavesMyi'] = False # (N m); ; -WAMIT['WavesMzi'] = False # (N m); ; -WAMIT['HdrStcFxi'] = False # (N); ; -WAMIT['HdrStcFyi'] = False # (N); ; -WAMIT['HdrStcFzi'] = False # (N); ; -WAMIT['HdrStcMxi'] = False # (N m); ; -WAMIT['HdrStcMyi'] = False # (N m); ; -WAMIT['HdrStcMzi'] = False # (N m); ; -WAMIT['RdtnFxi'] = False # (N); ; -WAMIT['RdtnFyi'] = False # (N); ; -WAMIT['RdtnFzi'] = False # (N); ; -WAMIT['RdtnMxi'] = False # (N m); ; -WAMIT['RdtnMyi'] = False # (N m); ; -WAMIT['RdtnMzi'] = False # (N m); ; """ HydroDyn """ HydroDyn = {} @@ -3869,35 +4335,6 @@ HydroDyn['B9WvsM2yi'] = False # (N-m); Second-order wave-excitation moment at the 9th WAMIT body reference point from diffraction about the global y-axis; HydroDyn['B9WvsM2zi'] = False # (N-m); Second-order wave-excitation moment at the 9th WAMIT body reference point from diffraction about the global z-axis; -# Wave Elevations -HydroDyn['Wave1Elev'] = False # (m); Total (first-order plus second-order) wave elevation (global Z height) at the 1st user-requested location (location is specified in the global coordinate system); -HydroDyn['Wave2Elev'] = False # (m); Total (first-order plus second-order) wave elevation (global Z height) at the 2nd user-requested location (location is specified in the global coordinate system); -HydroDyn['Wave3Elev'] = False # (m); Total (first-order plus second-order) wave elevation (global Z height) at the 3rd user-requested location (location is specified in the global coordinate system); -HydroDyn['Wave4Elev'] = False # (m); Total (first-order plus second-order) wave elevation (global Z height) at the 4th user-requested location (location is specified in the global coordinate system); -HydroDyn['Wave5Elev'] = False # (m); Total (first-order plus second-order) wave elevation (global Z height) at the 5th user-requested location (location is specified in the global coordinate system); -HydroDyn['Wave6Elev'] = False # (m); Total (first-order plus second-order) wave elevation (global Z height) at the 6th user-requested location (location is specified in the global coordinate system); -HydroDyn['Wave7Elev'] = False # (m); Total (first-order plus second-order) wave elevation (global Z height) at the 7th user-requested location (location is specified in the global coordinate system); -HydroDyn['Wave8Elev'] = False # (m); Total (first-order plus second-order) wave elevation (global Z height) at the 8th user-requested location (location is specified in the global coordinate system); -HydroDyn['Wave9Elev'] = False # (m); Total (first-order plus second-order) wave elevation (global Z height) at the 9th user-requested location (location is specified in the global coordinate system); -HydroDyn['Wave1Elv1'] = False # (m); First-order wave elevation (global Z height) at the 1st user-requested location (location is specified in the global coordinate system); -HydroDyn['Wave2Elv1'] = False # (m); First-order wave elevation (global Z height) at the 2nd user-requested location (location is specified in the global coordinate system); -HydroDyn['Wave3Elv1'] = False # (m); First-order wave elevation (global Z height) at the 3rd user-requested location (location is specified in the global coordinate system); -HydroDyn['Wave4Elv1'] = False # (m); First-order wave elevation (global Z height) at the 4th user-requested location (location is specified in the global coordinate system); -HydroDyn['Wave5Elv1'] = False # (m); First-order wave elevation (global Z height) at the 5th user-requested location (location is specified in the global coordinate system); -HydroDyn['Wave6Elv1'] = False # (m); First-order wave elevation (global Z height) at the 6th user-requested location (location is specified in the global coordinate system); -HydroDyn['Wave7Elv1'] = False # (m); First-order wave elevation (global Z height) at the 7th user-requested location (location is specified in the global coordinate system); -HydroDyn['Wave8Elv1'] = False # (m); First-order wave elevation (global Z height) at the 8th user-requested location (location is specified in the global coordinate system); -HydroDyn['Wave9Elv1'] = False # (m); First-order wave elevation (global Z height) at the 9th user-requested location (location is specified in the global coordinate system); -HydroDyn['Wave1Elv2'] = False # (m); Second-order wave elevation (global Z height) at the 1st user-requested location (location is specified in the global coordinate system); -HydroDyn['Wave2Elv2'] = False # (m); Second-order wave elevation (global Z height) at the 2nd user-requested location (location is specified in the global coordinate system); -HydroDyn['Wave3Elv2'] = False # (m); Second-order wave elevation (global Z height) at the 3rd user-requested location (location is specified in the global coordinate system); -HydroDyn['Wave4Elv2'] = False # (m); Second-order wave elevation (global Z height) at the 4th user-requested location (location is specified in the global coordinate system); -HydroDyn['Wave5Elv2'] = False # (m); Second-order wave elevation (global Z height) at the 5th user-requested location (location is specified in the global coordinate system); -HydroDyn['Wave6Elv2'] = False # (m); Second-order wave elevation (global Z height) at the 6th user-requested location (location is specified in the global coordinate system); -HydroDyn['Wave7Elv2'] = False # (m); Second-order wave elevation (global Z height) at the 7th user-requested location (location is specified in the global coordinate system); -HydroDyn['Wave8Elv2'] = False # (m); Second-order wave elevation (global Z height) at the 8th user-requested location (location is specified in the global coordinate system); -HydroDyn['Wave9Elv2'] = False # (m); Second-order wave elevation (global Z height) at the 9th user-requested location (location is specified in the global coordinate system); - """ Morison """ Morison = {} @@ -8182,6 +8619,33 @@ Morison['J7DynP'] = False # (Pa); ; Morison['J8DynP'] = False # (Pa); ; Morison['J9DynP'] = False # (Pa); ; +Morison['J1WaveElev'] = False # (m); total wave elevation at the X,Y location of the joint; +Morison['J2WaveElev'] = False # (m); ; +Morison['J3WaveElev'] = False # (m); ; +Morison['J4WaveElev'] = False # (m); ; +Morison['J5WaveElev'] = False # (m); ; +Morison['J6WaveElev'] = False # (m); ; +Morison['J7WaveElev'] = False # (m); ; +Morison['J8WaveElev'] = False # (m); ; +Morison['J9WaveElev'] = False # (m); ; +Morison['J1WaveElv1'] = False # (m); wave elevation at the X,Y location of the joint due to 1st order effects; +Morison['J2WaveElv1'] = False # (m); ; +Morison['J3WaveElv1'] = False # (m); ; +Morison['J4WaveElv1'] = False # (m); ; +Morison['J5WaveElv1'] = False # (m); ; +Morison['J6WaveElv1'] = False # (m); ; +Morison['J7WaveElv1'] = False # (m); ; +Morison['J8WaveElv1'] = False # (m); ; +Morison['J9WaveElv1'] = False # (m); ; +Morison['J1WaveElv2'] = False # (m); wave elevation at the X,Y location of the joint due to 2nd order effects; +Morison['J2WaveElv2'] = False # (m); ; +Morison['J3WaveElv2'] = False # (m); ; +Morison['J4WaveElv2'] = False # (m); ; +Morison['J5WaveElv2'] = False # (m); ; +Morison['J6WaveElv2'] = False # (m); ; +Morison['J7WaveElv2'] = False # (m); ; +Morison['J8WaveElv2'] = False # (m); ; +Morison['J9WaveElv2'] = False # (m); ; Morison['J1STVxi'] = False # (m/s); structural translational velocity at the joint; Morison['J2STVxi'] = False # (m/s); ; Morison['J3STVxi'] = False # (m/s); ; @@ -8509,2363 +8973,412 @@ Morison['J8FMGzi'] = False # (N); ; Morison['J9FMGzi'] = False # (N); ; -""" SubDyn """ -SubDyn = {} -# Member Forces -SubDyn['M1N1FKxe'] = False # (N); xe component of the shear at Node Nj of member Mi- Local Reference System- Static Component; -SubDyn['M1N2FKxe'] = False # (N); ; -SubDyn['M1N3FKxe'] = False # (N); ; -SubDyn['M1N4FKxe'] = False # (N); ; -SubDyn['M1N5FKxe'] = False # (N); ; -SubDyn['M1N6FKxe'] = False # (N); ; -SubDyn['M1N7FKxe'] = False # (N); ; -SubDyn['M1N8FKxe'] = False # (N); ; -SubDyn['M1N9FKxe'] = False # (N); ; -SubDyn['M2N1FKxe'] = False # (N); ; -SubDyn['M2N2FKxe'] = False # (N); ; -SubDyn['M2N3FKxe'] = False # (N); ; -SubDyn['M2N4FKxe'] = False # (N); ; -SubDyn['M2N5FKxe'] = False # (N); ; -SubDyn['M2N6FKxe'] = False # (N); ; -SubDyn['M2N7FKxe'] = False # (N); ; -SubDyn['M2N8FKxe'] = False # (N); ; -SubDyn['M2N9FKxe'] = False # (N); ; -SubDyn['M3N1FKxe'] = False # (N); ; -SubDyn['M3N2FKxe'] = False # (N); ; -SubDyn['M3N3FKxe'] = False # (N); ; -SubDyn['M3N4FKxe'] = False # (N); ; -SubDyn['M3N5FKxe'] = False # (N); ; -SubDyn['M3N6FKxe'] = False # (N); ; -SubDyn['M3N7FKxe'] = False # (N); ; -SubDyn['M3N8FKxe'] = False # (N); ; -SubDyn['M3N9FKxe'] = False # (N); ; -SubDyn['M4N1FKxe'] = False # (N); ; -SubDyn['M4N2FKxe'] = False # (N); ; -SubDyn['M4N3FKxe'] = False # (N); ; -SubDyn['M4N4FKxe'] = False # (N); ; -SubDyn['M4N5FKxe'] = False # (N); ; -SubDyn['M4N6FKxe'] = False # (N); ; -SubDyn['M4N7FKxe'] = False # (N); ; -SubDyn['M4N8FKxe'] = False # (N); ; -SubDyn['M4N9FKxe'] = False # (N); ; -SubDyn['M5N1FKxe'] = False # (N); ; -SubDyn['M5N2FKxe'] = False # (N); ; -SubDyn['M5N3FKxe'] = False # (N); ; -SubDyn['M5N4FKxe'] = False # (N); ; -SubDyn['M5N5FKxe'] = False # (N); ; -SubDyn['M5N6FKxe'] = False # (N); ; -SubDyn['M5N7FKxe'] = False # (N); ; -SubDyn['M5N8FKxe'] = False # (N); ; -SubDyn['M5N9FKxe'] = False # (N); ; -SubDyn['M6N1FKxe'] = False # (N); ; -SubDyn['M6N2FKxe'] = False # (N); ; -SubDyn['M6N3FKxe'] = False # (N); ; -SubDyn['M6N4FKxe'] = False # (N); ; -SubDyn['M6N5FKxe'] = False # (N); ; -SubDyn['M6N6FKxe'] = False # (N); ; -SubDyn['M6N7FKxe'] = False # (N); ; -SubDyn['M6N8FKxe'] = False # (N); ; -SubDyn['M6N9FKxe'] = False # (N); ; -SubDyn['M7N1FKxe'] = False # (N); ; -SubDyn['M7N2FKxe'] = False # (N); ; -SubDyn['M7N3FKxe'] = False # (N); ; -SubDyn['M7N4FKxe'] = False # (N); ; -SubDyn['M7N5FKxe'] = False # (N); ; -SubDyn['M7N6FKxe'] = False # (N); ; -SubDyn['M7N7FKxe'] = False # (N); ; -SubDyn['M7N8FKxe'] = False # (N); ; -SubDyn['M7N9FKxe'] = False # (N); ; -SubDyn['M8N1FKxe'] = False # (N); ; -SubDyn['M8N2FKxe'] = False # (N); ; -SubDyn['M8N3FKxe'] = False # (N); ; -SubDyn['M8N4FKxe'] = False # (N); ; -SubDyn['M8N5FKxe'] = False # (N); ; -SubDyn['M8N6FKxe'] = False # (N); ; -SubDyn['M8N7FKxe'] = False # (N); ; -SubDyn['M8N8FKxe'] = False # (N); ; -SubDyn['M8N9FKxe'] = False # (N); ; -SubDyn['M9N1FKxe'] = False # (N); ; -SubDyn['M9N2FKxe'] = False # (N); ; -SubDyn['M9N3FKxe'] = False # (N); ; -SubDyn['M9N4FKxe'] = False # (N); ; -SubDyn['M9N5FKxe'] = False # (N); ; -SubDyn['M9N6FKxe'] = False # (N); ; -SubDyn['M9N7FKxe'] = False # (N); ; -SubDyn['M9N8FKxe'] = False # (N); ; -SubDyn['M9N9FKxe'] = False # (N); ; -SubDyn['M1N1FKye'] = False # (N); ye component of the shear at Node Nj of member Mi- Local Reference System- Static Component; -SubDyn['M1N2FKye'] = False # (N); ; -SubDyn['M1N3FKye'] = False # (N); ; -SubDyn['M1N4FKye'] = False # (N); ; -SubDyn['M1N5FKye'] = False # (N); ; -SubDyn['M1N6FKye'] = False # (N); ; -SubDyn['M1N7FKye'] = False # (N); ; -SubDyn['M1N8FKye'] = False # (N); ; -SubDyn['M1N9FKye'] = False # (N); ; -SubDyn['M2N1FKye'] = False # (N); ; -SubDyn['M2N2FKye'] = False # (N); ; -SubDyn['M2N3FKye'] = False # (N); ; -SubDyn['M2N4FKye'] = False # (N); ; -SubDyn['M2N5FKye'] = False # (N); ; -SubDyn['M2N6FKye'] = False # (N); ; -SubDyn['M2N7FKye'] = False # (N); ; -SubDyn['M2N8FKye'] = False # (N); ; -SubDyn['M2N9FKye'] = False # (N); ; -SubDyn['M3N1FKye'] = False # (N); ; -SubDyn['M3N2FKye'] = False # (N); ; -SubDyn['M3N3FKye'] = False # (N); ; -SubDyn['M3N4FKye'] = False # (N); ; -SubDyn['M3N5FKye'] = False # (N); ; -SubDyn['M3N6FKye'] = False # (N); ; -SubDyn['M3N7FKye'] = False # (N); ; -SubDyn['M3N8FKye'] = False # (N); ; -SubDyn['M3N9FKye'] = False # (N); ; -SubDyn['M4N1FKye'] = False # (N); ; -SubDyn['M4N2FKye'] = False # (N); ; -SubDyn['M4N3FKye'] = False # (N); ; -SubDyn['M4N4FKye'] = False # (N); ; -SubDyn['M4N5FKye'] = False # (N); ; -SubDyn['M4N6FKye'] = False # (N); ; -SubDyn['M4N7FKye'] = False # (N); ; -SubDyn['M4N8FKye'] = False # (N); ; -SubDyn['M4N9FKye'] = False # (N); ; -SubDyn['M5N1FKye'] = False # (N); ; -SubDyn['M5N2FKye'] = False # (N); ; -SubDyn['M5N3FKye'] = False # (N); ; -SubDyn['M5N4FKye'] = False # (N); ; -SubDyn['M5N5FKye'] = False # (N); ; -SubDyn['M5N6FKye'] = False # (N); ; -SubDyn['M5N7FKye'] = False # (N); ; -SubDyn['M5N8FKye'] = False # (N); ; -SubDyn['M5N9FKye'] = False # (N); ; -SubDyn['M6N1FKye'] = False # (N); ; -SubDyn['M6N2FKye'] = False # (N); ; -SubDyn['M6N3FKye'] = False # (N); ; -SubDyn['M6N4FKye'] = False # (N); ; -SubDyn['M6N5FKye'] = False # (N); ; -SubDyn['M6N6FKye'] = False # (N); ; -SubDyn['M6N7FKye'] = False # (N); ; -SubDyn['M6N8FKye'] = False # (N); ; -SubDyn['M6N9FKye'] = False # (N); ; -SubDyn['M7N1FKye'] = False # (N); ; -SubDyn['M7N2FKye'] = False # (N); ; -SubDyn['M7N3FKye'] = False # (N); ; -SubDyn['M7N4FKye'] = False # (N); ; -SubDyn['M7N5FKye'] = False # (N); ; -SubDyn['M7N6FKye'] = False # (N); ; -SubDyn['M7N7FKye'] = False # (N); ; -SubDyn['M7N8FKye'] = False # (N); ; -SubDyn['M7N9FKye'] = False # (N); ; -SubDyn['M8N1FKye'] = False # (N); ; -SubDyn['M8N2FKye'] = False # (N); ; -SubDyn['M8N3FKye'] = False # (N); ; -SubDyn['M8N4FKye'] = False # (N); ; -SubDyn['M8N5FKye'] = False # (N); ; -SubDyn['M8N6FKye'] = False # (N); ; -SubDyn['M8N7FKye'] = False # (N); ; -SubDyn['M8N8FKye'] = False # (N); ; -SubDyn['M8N9FKye'] = False # (N); ; -SubDyn['M9N1FKye'] = False # (N); ; -SubDyn['M9N2FKye'] = False # (N); ; -SubDyn['M9N3FKye'] = False # (N); ; -SubDyn['M9N4FKye'] = False # (N); ; -SubDyn['M9N5FKye'] = False # (N); ; -SubDyn['M9N6FKye'] = False # (N); ; -SubDyn['M9N7FKye'] = False # (N); ; -SubDyn['M9N8FKye'] = False # (N); ; -SubDyn['M9N9FKye'] = False # (N); ; -SubDyn['M1N1FKze'] = False # (N); Axial Force at Node Nj of member Mi- Local Reference System- Static Component; -SubDyn['M1N2FKze'] = False # (N); ; -SubDyn['M1N3FKze'] = False # (N); ; -SubDyn['M1N4FKze'] = False # (N); ; -SubDyn['M1N5FKze'] = False # (N); ; -SubDyn['M1N6FKze'] = False # (N); ; -SubDyn['M1N7FKze'] = False # (N); ; -SubDyn['M1N8FKze'] = False # (N); ; -SubDyn['M1N9FKze'] = False # (N); ; -SubDyn['M2N1FKze'] = False # (N); ; -SubDyn['M2N2FKze'] = False # (N); ; -SubDyn['M2N3FKze'] = False # (N); ; -SubDyn['M2N4FKze'] = False # (N); ; -SubDyn['M2N5FKze'] = False # (N); ; -SubDyn['M2N6FKze'] = False # (N); ; -SubDyn['M2N7FKze'] = False # (N); ; -SubDyn['M2N8FKze'] = False # (N); ; -SubDyn['M2N9FKze'] = False # (N); ; -SubDyn['M3N1FKze'] = False # (N); ; -SubDyn['M3N2FKze'] = False # (N); ; -SubDyn['M3N3FKze'] = False # (N); ; -SubDyn['M3N4FKze'] = False # (N); ; -SubDyn['M3N5FKze'] = False # (N); ; -SubDyn['M3N6FKze'] = False # (N); ; -SubDyn['M3N7FKze'] = False # (N); ; -SubDyn['M3N8FKze'] = False # (N); ; -SubDyn['M3N9FKze'] = False # (N); ; -SubDyn['M4N1FKze'] = False # (N); ; -SubDyn['M4N2FKze'] = False # (N); ; -SubDyn['M4N3FKze'] = False # (N); ; -SubDyn['M4N4FKze'] = False # (N); ; -SubDyn['M4N5FKze'] = False # (N); ; -SubDyn['M4N6FKze'] = False # (N); ; -SubDyn['M4N7FKze'] = False # (N); ; -SubDyn['M4N8FKze'] = False # (N); ; -SubDyn['M4N9FKze'] = False # (N); ; -SubDyn['M5N1FKze'] = False # (N); ; -SubDyn['M5N2FKze'] = False # (N); ; -SubDyn['M5N3FKze'] = False # (N); ; -SubDyn['M5N4FKze'] = False # (N); ; -SubDyn['M5N5FKze'] = False # (N); ; -SubDyn['M5N6FKze'] = False # (N); ; -SubDyn['M5N7FKze'] = False # (N); ; -SubDyn['M5N8FKze'] = False # (N); ; -SubDyn['M5N9FKze'] = False # (N); ; -SubDyn['M6N1FKze'] = False # (N); ; -SubDyn['M6N2FKze'] = False # (N); ; -SubDyn['M6N3FKze'] = False # (N); ; -SubDyn['M6N4FKze'] = False # (N); ; -SubDyn['M6N5FKze'] = False # (N); ; -SubDyn['M6N6FKze'] = False # (N); ; -SubDyn['M6N7FKze'] = False # (N); ; -SubDyn['M6N8FKze'] = False # (N); ; -SubDyn['M6N9FKze'] = False # (N); ; -SubDyn['M7N1FKze'] = False # (N); ; -SubDyn['M7N2FKze'] = False # (N); ; -SubDyn['M7N3FKze'] = False # (N); ; -SubDyn['M7N4FKze'] = False # (N); ; -SubDyn['M7N5FKze'] = False # (N); ; -SubDyn['M7N6FKze'] = False # (N); ; -SubDyn['M7N7FKze'] = False # (N); ; -SubDyn['M7N8FKze'] = False # (N); ; -SubDyn['M7N9FKze'] = False # (N); ; -SubDyn['M8N1FKze'] = False # (N); ; -SubDyn['M8N2FKze'] = False # (N); ; -SubDyn['M8N3FKze'] = False # (N); ; -SubDyn['M8N4FKze'] = False # (N); ; -SubDyn['M8N5FKze'] = False # (N); ; -SubDyn['M8N6FKze'] = False # (N); ; -SubDyn['M8N7FKze'] = False # (N); ; -SubDyn['M8N8FKze'] = False # (N); ; -SubDyn['M8N9FKze'] = False # (N); ; -SubDyn['M9N1FKze'] = False # (N); ; -SubDyn['M9N2FKze'] = False # (N); ; -SubDyn['M9N3FKze'] = False # (N); ; -SubDyn['M9N4FKze'] = False # (N); ; -SubDyn['M9N5FKze'] = False # (N); ; -SubDyn['M9N6FKze'] = False # (N); ; -SubDyn['M9N7FKze'] = False # (N); ; -SubDyn['M9N8FKze'] = False # (N); ; -SubDyn['M9N9FKze'] = False # (N); ; -SubDyn['M1N1FMxe'] = False # (N); xe component of the shear at Node Nj of member Mi- Local Reference System- Dynamic Component; -SubDyn['M1N2FMxe'] = False # (N); ; -SubDyn['M1N3FMxe'] = False # (N); ; -SubDyn['M1N4FMxe'] = False # (N); ; -SubDyn['M1N5FMxe'] = False # (N); ; -SubDyn['M1N6FMxe'] = False # (N); ; -SubDyn['M1N7FMxe'] = False # (N); ; -SubDyn['M1N8FMxe'] = False # (N); ; -SubDyn['M1N9FMxe'] = False # (N); ; -SubDyn['M2N1FMxe'] = False # (N); ; -SubDyn['M2N2FMxe'] = False # (N); ; -SubDyn['M2N3FMxe'] = False # (N); ; -SubDyn['M2N4FMxe'] = False # (N); ; -SubDyn['M2N5FMxe'] = False # (N); ; -SubDyn['M2N6FMxe'] = False # (N); ; -SubDyn['M2N7FMxe'] = False # (N); ; -SubDyn['M2N8FMxe'] = False # (N); ; -SubDyn['M2N9FMxe'] = False # (N); ; -SubDyn['M3N1FMxe'] = False # (N); ; -SubDyn['M3N2FMxe'] = False # (N); ; -SubDyn['M3N3FMxe'] = False # (N); ; -SubDyn['M3N4FMxe'] = False # (N); ; -SubDyn['M3N5FMxe'] = False # (N); ; -SubDyn['M3N6FMxe'] = False # (N); ; -SubDyn['M3N7FMxe'] = False # (N); ; -SubDyn['M3N8FMxe'] = False # (N); ; -SubDyn['M3N9FMxe'] = False # (N); ; -SubDyn['M4N1FMxe'] = False # (N); ; -SubDyn['M4N2FMxe'] = False # (N); ; -SubDyn['M4N3FMxe'] = False # (N); ; -SubDyn['M4N4FMxe'] = False # (N); ; -SubDyn['M4N5FMxe'] = False # (N); ; -SubDyn['M4N6FMxe'] = False # (N); ; -SubDyn['M4N7FMxe'] = False # (N); ; -SubDyn['M4N8FMxe'] = False # (N); ; -SubDyn['M4N9FMxe'] = False # (N); ; -SubDyn['M5N1FMxe'] = False # (N); ; -SubDyn['M5N2FMxe'] = False # (N); ; -SubDyn['M5N3FMxe'] = False # (N); ; -SubDyn['M5N4FMxe'] = False # (N); ; -SubDyn['M5N5FMxe'] = False # (N); ; -SubDyn['M5N6FMxe'] = False # (N); ; -SubDyn['M5N7FMxe'] = False # (N); ; -SubDyn['M5N8FMxe'] = False # (N); ; -SubDyn['M5N9FMxe'] = False # (N); ; -SubDyn['M6N1FMxe'] = False # (N); ; -SubDyn['M6N2FMxe'] = False # (N); ; -SubDyn['M6N3FMxe'] = False # (N); ; -SubDyn['M6N4FMxe'] = False # (N); ; -SubDyn['M6N5FMxe'] = False # (N); ; -SubDyn['M6N6FMxe'] = False # (N); ; -SubDyn['M6N7FMxe'] = False # (N); ; -SubDyn['M6N8FMxe'] = False # (N); ; -SubDyn['M6N9FMxe'] = False # (N); ; -SubDyn['M7N1FMxe'] = False # (N); ; -SubDyn['M7N2FMxe'] = False # (N); ; -SubDyn['M7N3FMxe'] = False # (N); ; -SubDyn['M7N4FMxe'] = False # (N); ; -SubDyn['M7N5FMxe'] = False # (N); ; -SubDyn['M7N6FMxe'] = False # (N); ; -SubDyn['M7N7FMxe'] = False # (N); ; -SubDyn['M7N8FMxe'] = False # (N); ; -SubDyn['M7N9FMxe'] = False # (N); ; -SubDyn['M8N1FMxe'] = False # (N); ; -SubDyn['M8N2FMxe'] = False # (N); ; -SubDyn['M8N3FMxe'] = False # (N); ; -SubDyn['M8N4FMxe'] = False # (N); ; -SubDyn['M8N5FMxe'] = False # (N); ; -SubDyn['M8N6FMxe'] = False # (N); ; -SubDyn['M8N7FMxe'] = False # (N); ; -SubDyn['M8N8FMxe'] = False # (N); ; -SubDyn['M8N9FMxe'] = False # (N); ; -SubDyn['M9N1FMxe'] = False # (N); ; -SubDyn['M9N2FMxe'] = False # (N); ; -SubDyn['M9N3FMxe'] = False # (N); ; -SubDyn['M9N4FMxe'] = False # (N); ; -SubDyn['M9N5FMxe'] = False # (N); ; -SubDyn['M9N6FMxe'] = False # (N); ; -SubDyn['M9N7FMxe'] = False # (N); ; -SubDyn['M9N8FMxe'] = False # (N); ; -SubDyn['M9N9FMxe'] = False # (N); ; -SubDyn['M1N1FMye'] = False # (N); ye component of the shear at Node Nj of member Mi- Local Reference System- Dynamic Component; -SubDyn['M1N2FMye'] = False # (N); ; -SubDyn['M1N3FMye'] = False # (N); ; -SubDyn['M1N4FMye'] = False # (N); ; -SubDyn['M1N5FMye'] = False # (N); ; -SubDyn['M1N6FMye'] = False # (N); ; -SubDyn['M1N7FMye'] = False # (N); ; -SubDyn['M1N8FMye'] = False # (N); ; -SubDyn['M1N9FMye'] = False # (N); ; -SubDyn['M2N1FMye'] = False # (N); ; -SubDyn['M2N2FMye'] = False # (N); ; -SubDyn['M2N3FMye'] = False # (N); ; -SubDyn['M2N4FMye'] = False # (N); ; -SubDyn['M2N5FMye'] = False # (N); ; -SubDyn['M2N6FMye'] = False # (N); ; -SubDyn['M2N7FMye'] = False # (N); ; -SubDyn['M2N8FMye'] = False # (N); ; -SubDyn['M2N9FMye'] = False # (N); ; -SubDyn['M3N1FMye'] = False # (N); ; -SubDyn['M3N2FMye'] = False # (N); ; -SubDyn['M3N3FMye'] = False # (N); ; -SubDyn['M3N4FMye'] = False # (N); ; -SubDyn['M3N5FMye'] = False # (N); ; -SubDyn['M3N6FMye'] = False # (N); ; -SubDyn['M3N7FMye'] = False # (N); ; -SubDyn['M3N8FMye'] = False # (N); ; -SubDyn['M3N9FMye'] = False # (N); ; -SubDyn['M4N1FMye'] = False # (N); ; -SubDyn['M4N2FMye'] = False # (N); ; -SubDyn['M4N3FMye'] = False # (N); ; -SubDyn['M4N4FMye'] = False # (N); ; -SubDyn['M4N5FMye'] = False # (N); ; -SubDyn['M4N6FMye'] = False # (N); ; -SubDyn['M4N7FMye'] = False # (N); ; -SubDyn['M4N8FMye'] = False # (N); ; -SubDyn['M4N9FMye'] = False # (N); ; -SubDyn['M5N1FMye'] = False # (N); ; -SubDyn['M5N2FMye'] = False # (N); ; -SubDyn['M5N3FMye'] = False # (N); ; -SubDyn['M5N4FMye'] = False # (N); ; -SubDyn['M5N5FMye'] = False # (N); ; -SubDyn['M5N6FMye'] = False # (N); ; -SubDyn['M5N7FMye'] = False # (N); ; -SubDyn['M5N8FMye'] = False # (N); ; -SubDyn['M5N9FMye'] = False # (N); ; -SubDyn['M6N1FMye'] = False # (N); ; -SubDyn['M6N2FMye'] = False # (N); ; -SubDyn['M6N3FMye'] = False # (N); ; -SubDyn['M6N4FMye'] = False # (N); ; -SubDyn['M6N5FMye'] = False # (N); ; -SubDyn['M6N6FMye'] = False # (N); ; -SubDyn['M6N7FMye'] = False # (N); ; -SubDyn['M6N8FMye'] = False # (N); ; -SubDyn['M6N9FMye'] = False # (N); ; -SubDyn['M7N1FMye'] = False # (N); ; -SubDyn['M7N2FMye'] = False # (N); ; -SubDyn['M7N3FMye'] = False # (N); ; -SubDyn['M7N4FMye'] = False # (N); ; -SubDyn['M7N5FMye'] = False # (N); ; -SubDyn['M7N6FMye'] = False # (N); ; -SubDyn['M7N7FMye'] = False # (N); ; -SubDyn['M7N8FMye'] = False # (N); ; -SubDyn['M7N9FMye'] = False # (N); ; -SubDyn['M8N1FMye'] = False # (N); ; -SubDyn['M8N2FMye'] = False # (N); ; -SubDyn['M8N3FMye'] = False # (N); ; -SubDyn['M8N4FMye'] = False # (N); ; -SubDyn['M8N5FMye'] = False # (N); ; -SubDyn['M8N6FMye'] = False # (N); ; -SubDyn['M8N7FMye'] = False # (N); ; -SubDyn['M8N8FMye'] = False # (N); ; -SubDyn['M8N9FMye'] = False # (N); ; -SubDyn['M9N1FMye'] = False # (N); ; -SubDyn['M9N2FMye'] = False # (N); ; -SubDyn['M9N3FMye'] = False # (N); ; -SubDyn['M9N4FMye'] = False # (N); ; -SubDyn['M9N5FMye'] = False # (N); ; -SubDyn['M9N6FMye'] = False # (N); ; -SubDyn['M9N7FMye'] = False # (N); ; -SubDyn['M9N8FMye'] = False # (N); ; -SubDyn['M9N9FMye'] = False # (N); ; -SubDyn['M1N1FMze'] = False # (N); axial force at Node Nj of member Mi- Local Reference System- Dynamic Component; -SubDyn['M1N2FMze'] = False # (N); ; -SubDyn['M1N3FMze'] = False # (N); ; -SubDyn['M1N4FMze'] = False # (N); ; -SubDyn['M1N5FMze'] = False # (N); ; -SubDyn['M1N6FMze'] = False # (N); ; -SubDyn['M1N7FMze'] = False # (N); ; -SubDyn['M1N8FMze'] = False # (N); ; -SubDyn['M1N9FMze'] = False # (N); ; -SubDyn['M2N1FMze'] = False # (N); ; -SubDyn['M2N2FMze'] = False # (N); ; -SubDyn['M2N3FMze'] = False # (N); ; -SubDyn['M2N4FMze'] = False # (N); ; -SubDyn['M2N5FMze'] = False # (N); ; -SubDyn['M2N6FMze'] = False # (N); ; -SubDyn['M2N7FMze'] = False # (N); ; -SubDyn['M2N8FMze'] = False # (N); ; -SubDyn['M2N9FMze'] = False # (N); ; -SubDyn['M3N1FMze'] = False # (N); ; -SubDyn['M3N2FMze'] = False # (N); ; -SubDyn['M3N3FMze'] = False # (N); ; -SubDyn['M3N4FMze'] = False # (N); ; -SubDyn['M3N5FMze'] = False # (N); ; -SubDyn['M3N6FMze'] = False # (N); ; -SubDyn['M3N7FMze'] = False # (N); ; -SubDyn['M3N8FMze'] = False # (N); ; -SubDyn['M3N9FMze'] = False # (N); ; -SubDyn['M4N1FMze'] = False # (N); ; -SubDyn['M4N2FMze'] = False # (N); ; -SubDyn['M4N3FMze'] = False # (N); ; -SubDyn['M4N4FMze'] = False # (N); ; -SubDyn['M4N5FMze'] = False # (N); ; -SubDyn['M4N6FMze'] = False # (N); ; -SubDyn['M4N7FMze'] = False # (N); ; -SubDyn['M4N8FMze'] = False # (N); ; -SubDyn['M4N9FMze'] = False # (N); ; -SubDyn['M5N1FMze'] = False # (N); ; -SubDyn['M5N2FMze'] = False # (N); ; -SubDyn['M5N3FMze'] = False # (N); ; -SubDyn['M5N4FMze'] = False # (N); ; -SubDyn['M5N5FMze'] = False # (N); ; -SubDyn['M5N6FMze'] = False # (N); ; -SubDyn['M5N7FMze'] = False # (N); ; -SubDyn['M5N8FMze'] = False # (N); ; -SubDyn['M5N9FMze'] = False # (N); ; -SubDyn['M6N1FMze'] = False # (N); ; -SubDyn['M6N2FMze'] = False # (N); ; -SubDyn['M6N3FMze'] = False # (N); ; -SubDyn['M6N4FMze'] = False # (N); ; -SubDyn['M6N5FMze'] = False # (N); ; -SubDyn['M6N6FMze'] = False # (N); ; -SubDyn['M6N7FMze'] = False # (N); ; -SubDyn['M6N8FMze'] = False # (N); ; -SubDyn['M6N9FMze'] = False # (N); ; -SubDyn['M7N1FMze'] = False # (N); ; -SubDyn['M7N2FMze'] = False # (N); ; -SubDyn['M7N3FMze'] = False # (N); ; -SubDyn['M7N4FMze'] = False # (N); ; -SubDyn['M7N5FMze'] = False # (N); ; -SubDyn['M7N6FMze'] = False # (N); ; -SubDyn['M7N7FMze'] = False # (N); ; -SubDyn['M7N8FMze'] = False # (N); ; -SubDyn['M7N9FMze'] = False # (N); ; -SubDyn['M8N1FMze'] = False # (N); ; -SubDyn['M8N2FMze'] = False # (N); ; -SubDyn['M8N3FMze'] = False # (N); ; -SubDyn['M8N4FMze'] = False # (N); ; -SubDyn['M8N5FMze'] = False # (N); ; -SubDyn['M8N6FMze'] = False # (N); ; -SubDyn['M8N7FMze'] = False # (N); ; -SubDyn['M8N8FMze'] = False # (N); ; -SubDyn['M8N9FMze'] = False # (N); ; -SubDyn['M9N1FMze'] = False # (N); ; -SubDyn['M9N2FMze'] = False # (N); ; -SubDyn['M9N3FMze'] = False # (N); ; -SubDyn['M9N4FMze'] = False # (N); ; -SubDyn['M9N5FMze'] = False # (N); ; -SubDyn['M9N6FMze'] = False # (N); ; -SubDyn['M9N7FMze'] = False # (N); ; -SubDyn['M9N8FMze'] = False # (N); ; -SubDyn['M9N9FMze'] = False # (N); ; -SubDyn['M1N1MKxe'] = False # (N*m); xe component of the bending moment at Node Nj of member Mi- Local Reference System- Static Component; -SubDyn['M1N2MKxe'] = False # (N*m); ; -SubDyn['M1N3MKxe'] = False # (N*m); ; -SubDyn['M1N4MKxe'] = False # (N*m); ; -SubDyn['M1N5MKxe'] = False # (N*m); ; -SubDyn['M1N6MKxe'] = False # (N*m); ; -SubDyn['M1N7MKxe'] = False # (N*m); ; -SubDyn['M1N8MKxe'] = False # (N*m); ; -SubDyn['M1N9MKxe'] = False # (N*m); ; -SubDyn['M2N1MKxe'] = False # (N*m); ; -SubDyn['M2N2MKxe'] = False # (N*m); ; -SubDyn['M2N3MKxe'] = False # (N*m); ; -SubDyn['M2N4MKxe'] = False # (N*m); ; -SubDyn['M2N5MKxe'] = False # (N*m); ; -SubDyn['M2N6MKxe'] = False # (N*m); ; -SubDyn['M2N7MKxe'] = False # (N*m); ; -SubDyn['M2N8MKxe'] = False # (N*m); ; -SubDyn['M2N9MKxe'] = False # (N*m); ; -SubDyn['M3N1MKxe'] = False # (N*m); ; -SubDyn['M3N2MKxe'] = False # (N*m); ; -SubDyn['M3N3MKxe'] = False # (N*m); ; -SubDyn['M3N4MKxe'] = False # (N*m); ; -SubDyn['M3N5MKxe'] = False # (N*m); ; -SubDyn['M3N6MKxe'] = False # (N*m); ; -SubDyn['M3N7MKxe'] = False # (N*m); ; -SubDyn['M3N8MKxe'] = False # (N*m); ; -SubDyn['M3N9MKxe'] = False # (N*m); ; -SubDyn['M4N1MKxe'] = False # (N*m); ; -SubDyn['M4N2MKxe'] = False # (N*m); ; -SubDyn['M4N3MKxe'] = False # (N*m); ; -SubDyn['M4N4MKxe'] = False # (N*m); ; -SubDyn['M4N5MKxe'] = False # (N*m); ; -SubDyn['M4N6MKxe'] = False # (N*m); ; -SubDyn['M4N7MKxe'] = False # (N*m); ; -SubDyn['M4N8MKxe'] = False # (N*m); ; -SubDyn['M4N9MKxe'] = False # (N*m); ; -SubDyn['M5N1MKxe'] = False # (N*m); ; -SubDyn['M5N2MKxe'] = False # (N*m); ; -SubDyn['M5N3MKxe'] = False # (N*m); ; -SubDyn['M5N4MKxe'] = False # (N*m); ; -SubDyn['M5N5MKxe'] = False # (N*m); ; -SubDyn['M5N6MKxe'] = False # (N*m); ; -SubDyn['M5N7MKxe'] = False # (N*m); ; -SubDyn['M5N8MKxe'] = False # (N*m); ; -SubDyn['M5N9MKxe'] = False # (N*m); ; -SubDyn['M6N1MKxe'] = False # (N*m); ; -SubDyn['M6N2MKxe'] = False # (N*m); ; -SubDyn['M6N3MKxe'] = False # (N*m); ; -SubDyn['M6N4MKxe'] = False # (N*m); ; -SubDyn['M6N5MKxe'] = False # (N*m); ; -SubDyn['M6N6MKxe'] = False # (N*m); ; -SubDyn['M6N7MKxe'] = False # (N*m); ; -SubDyn['M6N8MKxe'] = False # (N*m); ; -SubDyn['M6N9MKxe'] = False # (N*m); ; -SubDyn['M7N1MKxe'] = False # (N*m); ; -SubDyn['M7N2MKxe'] = False # (N*m); ; -SubDyn['M7N3MKxe'] = False # (N*m); ; -SubDyn['M7N4MKxe'] = False # (N*m); ; -SubDyn['M7N5MKxe'] = False # (N*m); ; -SubDyn['M7N6MKxe'] = False # (N*m); ; -SubDyn['M7N7MKxe'] = False # (N*m); ; -SubDyn['M7N8MKxe'] = False # (N*m); ; -SubDyn['M7N9MKxe'] = False # (N*m); ; -SubDyn['M8N1MKxe'] = False # (N*m); ; -SubDyn['M8N2MKxe'] = False # (N*m); ; -SubDyn['M8N3MKxe'] = False # (N*m); ; -SubDyn['M8N4MKxe'] = False # (N*m); ; -SubDyn['M8N5MKxe'] = False # (N*m); ; -SubDyn['M8N6MKxe'] = False # (N*m); ; -SubDyn['M8N7MKxe'] = False # (N*m); ; -SubDyn['M8N8MKxe'] = False # (N*m); ; -SubDyn['M8N9MKxe'] = False # (N*m); ; -SubDyn['M9N1MKxe'] = False # (N*m); ; -SubDyn['M9N2MKxe'] = False # (N*m); ; -SubDyn['M9N3MKxe'] = False # (N*m); ; -SubDyn['M9N4MKxe'] = False # (N*m); ; -SubDyn['M9N5MKxe'] = False # (N*m); ; -SubDyn['M9N6MKxe'] = False # (N*m); ; -SubDyn['M9N7MKxe'] = False # (N*m); ; -SubDyn['M9N8MKxe'] = False # (N*m); ; -SubDyn['M9N9MKxe'] = False # (N*m); ; -SubDyn['M1N1MKye'] = False # (N*m); ye component of the bending moment at Node Nj of member Mi- Local Reference System- Static Component; -SubDyn['M1N2MKye'] = False # (N*m); ; -SubDyn['M1N3MKye'] = False # (N*m); ; -SubDyn['M1N4MKye'] = False # (N*m); ; -SubDyn['M1N5MKye'] = False # (N*m); ; -SubDyn['M1N6MKye'] = False # (N*m); ; -SubDyn['M1N7MKye'] = False # (N*m); ; -SubDyn['M1N8MKye'] = False # (N*m); ; -SubDyn['M1N9MKye'] = False # (N*m); ; -SubDyn['M2N1MKye'] = False # (N*m); ; -SubDyn['M2N2MKye'] = False # (N*m); ; -SubDyn['M2N3MKye'] = False # (N*m); ; -SubDyn['M2N4MKye'] = False # (N*m); ; -SubDyn['M2N5MKye'] = False # (N*m); ; -SubDyn['M2N6MKye'] = False # (N*m); ; -SubDyn['M2N7MKye'] = False # (N*m); ; -SubDyn['M2N8MKye'] = False # (N*m); ; -SubDyn['M2N9MKye'] = False # (N*m); ; -SubDyn['M3N1MKye'] = False # (N*m); ; -SubDyn['M3N2MKye'] = False # (N*m); ; -SubDyn['M3N3MKye'] = False # (N*m); ; -SubDyn['M3N4MKye'] = False # (N*m); ; -SubDyn['M3N5MKye'] = False # (N*m); ; -SubDyn['M3N6MKye'] = False # (N*m); ; -SubDyn['M3N7MKye'] = False # (N*m); ; -SubDyn['M3N8MKye'] = False # (N*m); ; -SubDyn['M3N9MKye'] = False # (N*m); ; -SubDyn['M4N1MKye'] = False # (N*m); ; -SubDyn['M4N2MKye'] = False # (N*m); ; -SubDyn['M4N3MKye'] = False # (N*m); ; -SubDyn['M4N4MKye'] = False # (N*m); ; -SubDyn['M4N5MKye'] = False # (N*m); ; -SubDyn['M4N6MKye'] = False # (N*m); ; -SubDyn['M4N7MKye'] = False # (N*m); ; -SubDyn['M4N8MKye'] = False # (N*m); ; -SubDyn['M4N9MKye'] = False # (N*m); ; -SubDyn['M5N1MKye'] = False # (N*m); ; -SubDyn['M5N2MKye'] = False # (N*m); ; -SubDyn['M5N3MKye'] = False # (N*m); ; -SubDyn['M5N4MKye'] = False # (N*m); ; -SubDyn['M5N5MKye'] = False # (N*m); ; -SubDyn['M5N6MKye'] = False # (N*m); ; -SubDyn['M5N7MKye'] = False # (N*m); ; -SubDyn['M5N8MKye'] = False # (N*m); ; -SubDyn['M5N9MKye'] = False # (N*m); ; -SubDyn['M6N1MKye'] = False # (N*m); ; -SubDyn['M6N2MKye'] = False # (N*m); ; -SubDyn['M6N3MKye'] = False # (N*m); ; -SubDyn['M6N4MKye'] = False # (N*m); ; -SubDyn['M6N5MKye'] = False # (N*m); ; -SubDyn['M6N6MKye'] = False # (N*m); ; -SubDyn['M6N7MKye'] = False # (N*m); ; -SubDyn['M6N8MKye'] = False # (N*m); ; -SubDyn['M6N9MKye'] = False # (N*m); ; -SubDyn['M7N1MKye'] = False # (N*m); ; -SubDyn['M7N2MKye'] = False # (N*m); ; -SubDyn['M7N3MKye'] = False # (N*m); ; -SubDyn['M7N4MKye'] = False # (N*m); ; -SubDyn['M7N5MKye'] = False # (N*m); ; -SubDyn['M7N6MKye'] = False # (N*m); ; -SubDyn['M7N7MKye'] = False # (N*m); ; -SubDyn['M7N8MKye'] = False # (N*m); ; -SubDyn['M7N9MKye'] = False # (N*m); ; -SubDyn['M8N1MKye'] = False # (N*m); ; -SubDyn['M8N2MKye'] = False # (N*m); ; -SubDyn['M8N3MKye'] = False # (N*m); ; -SubDyn['M8N4MKye'] = False # (N*m); ; -SubDyn['M8N5MKye'] = False # (N*m); ; -SubDyn['M8N6MKye'] = False # (N*m); ; -SubDyn['M8N7MKye'] = False # (N*m); ; -SubDyn['M8N8MKye'] = False # (N*m); ; -SubDyn['M8N9MKye'] = False # (N*m); ; -SubDyn['M9N1MKye'] = False # (N*m); ; -SubDyn['M9N2MKye'] = False # (N*m); ; -SubDyn['M9N3MKye'] = False # (N*m); ; -SubDyn['M9N4MKye'] = False # (N*m); ; -SubDyn['M9N5MKye'] = False # (N*m); ; -SubDyn['M9N6MKye'] = False # (N*m); ; -SubDyn['M9N7MKye'] = False # (N*m); ; -SubDyn['M9N8MKye'] = False # (N*m); ; -SubDyn['M9N9MKye'] = False # (N*m); ; -SubDyn['M1N1MKze'] = False # (N*m); Torsion moment at Node Nj of member Mi- Local Reference System- Static Component; -SubDyn['M1N2MKze'] = False # (N*m); ; -SubDyn['M1N3MKze'] = False # (N*m); ; -SubDyn['M1N4MKze'] = False # (N*m); ; -SubDyn['M1N5MKze'] = False # (N*m); ; -SubDyn['M1N6MKze'] = False # (N*m); ; -SubDyn['M1N7MKze'] = False # (N*m); ; -SubDyn['M1N8MKze'] = False # (N*m); ; -SubDyn['M1N9MKze'] = False # (N*m); ; -SubDyn['M2N1MKze'] = False # (N*m); ; -SubDyn['M2N2MKze'] = False # (N*m); ; -SubDyn['M2N3MKze'] = False # (N*m); ; -SubDyn['M2N4MKze'] = False # (N*m); ; -SubDyn['M2N5MKze'] = False # (N*m); ; -SubDyn['M2N6MKze'] = False # (N*m); ; -SubDyn['M2N7MKze'] = False # (N*m); ; -SubDyn['M2N8MKze'] = False # (N*m); ; -SubDyn['M2N9MKze'] = False # (N*m); ; -SubDyn['M3N1MKze'] = False # (N*m); ; -SubDyn['M3N2MKze'] = False # (N*m); ; -SubDyn['M3N3MKze'] = False # (N*m); ; -SubDyn['M3N4MKze'] = False # (N*m); ; -SubDyn['M3N5MKze'] = False # (N*m); ; -SubDyn['M3N6MKze'] = False # (N*m); ; -SubDyn['M3N7MKze'] = False # (N*m); ; -SubDyn['M3N8MKze'] = False # (N*m); ; -SubDyn['M3N9MKze'] = False # (N*m); ; -SubDyn['M4N1MKze'] = False # (N*m); ; -SubDyn['M4N2MKze'] = False # (N*m); ; -SubDyn['M4N3MKze'] = False # (N*m); ; -SubDyn['M4N4MKze'] = False # (N*m); ; -SubDyn['M4N5MKze'] = False # (N*m); ; -SubDyn['M4N6MKze'] = False # (N*m); ; -SubDyn['M4N7MKze'] = False # (N*m); ; -SubDyn['M4N8MKze'] = False # (N*m); ; -SubDyn['M4N9MKze'] = False # (N*m); ; -SubDyn['M5N1MKze'] = False # (N*m); ; -SubDyn['M5N2MKze'] = False # (N*m); ; -SubDyn['M5N3MKze'] = False # (N*m); ; -SubDyn['M5N4MKze'] = False # (N*m); ; -SubDyn['M5N5MKze'] = False # (N*m); ; -SubDyn['M5N6MKze'] = False # (N*m); ; -SubDyn['M5N7MKze'] = False # (N*m); ; -SubDyn['M5N8MKze'] = False # (N*m); ; -SubDyn['M5N9MKze'] = False # (N*m); ; -SubDyn['M6N1MKze'] = False # (N*m); ; -SubDyn['M6N2MKze'] = False # (N*m); ; -SubDyn['M6N3MKze'] = False # (N*m); ; -SubDyn['M6N4MKze'] = False # (N*m); ; -SubDyn['M6N5MKze'] = False # (N*m); ; -SubDyn['M6N6MKze'] = False # (N*m); ; -SubDyn['M6N7MKze'] = False # (N*m); ; -SubDyn['M6N8MKze'] = False # (N*m); ; -SubDyn['M6N9MKze'] = False # (N*m); ; -SubDyn['M7N1MKze'] = False # (N*m); ; -SubDyn['M7N2MKze'] = False # (N*m); ; -SubDyn['M7N3MKze'] = False # (N*m); ; -SubDyn['M7N4MKze'] = False # (N*m); ; -SubDyn['M7N5MKze'] = False # (N*m); ; -SubDyn['M7N6MKze'] = False # (N*m); ; -SubDyn['M7N7MKze'] = False # (N*m); ; -SubDyn['M7N8MKze'] = False # (N*m); ; -SubDyn['M7N9MKze'] = False # (N*m); ; -SubDyn['M8N1MKze'] = False # (N*m); ; -SubDyn['M8N2MKze'] = False # (N*m); ; -SubDyn['M8N3MKze'] = False # (N*m); ; -SubDyn['M8N4MKze'] = False # (N*m); ; -SubDyn['M8N5MKze'] = False # (N*m); ; -SubDyn['M8N6MKze'] = False # (N*m); ; -SubDyn['M8N7MKze'] = False # (N*m); ; -SubDyn['M8N8MKze'] = False # (N*m); ; -SubDyn['M8N9MKze'] = False # (N*m); ; -SubDyn['M9N1MKze'] = False # (N*m); ; -SubDyn['M9N2MKze'] = False # (N*m); ; -SubDyn['M9N3MKze'] = False # (N*m); ; -SubDyn['M9N4MKze'] = False # (N*m); ; -SubDyn['M9N5MKze'] = False # (N*m); ; -SubDyn['M9N6MKze'] = False # (N*m); ; -SubDyn['M9N7MKze'] = False # (N*m); ; -SubDyn['M9N8MKze'] = False # (N*m); ; -SubDyn['M9N9MKze'] = False # (N*m); ; -SubDyn['M1N1MMxe'] = False # (N*m); xe component of the bending moment at Node Nj of member Mi- Local Reference System- Dynamic Component; -SubDyn['M1N2MMxe'] = False # (N*m); ; -SubDyn['M1N3MMxe'] = False # (N*m); ; -SubDyn['M1N4MMxe'] = False # (N*m); ; -SubDyn['M1N5MMxe'] = False # (N*m); ; -SubDyn['M1N6MMxe'] = False # (N*m); ; -SubDyn['M1N7MMxe'] = False # (N*m); ; -SubDyn['M1N8MMxe'] = False # (N*m); ; -SubDyn['M1N9MMxe'] = False # (N*m); ; -SubDyn['M2N1MMxe'] = False # (N*m); ; -SubDyn['M2N2MMxe'] = False # (N*m); ; -SubDyn['M2N3MMxe'] = False # (N*m); ; -SubDyn['M2N4MMxe'] = False # (N*m); ; -SubDyn['M2N5MMxe'] = False # (N*m); ; -SubDyn['M2N6MMxe'] = False # (N*m); ; -SubDyn['M2N7MMxe'] = False # (N*m); ; -SubDyn['M2N8MMxe'] = False # (N*m); ; -SubDyn['M2N9MMxe'] = False # (N*m); ; -SubDyn['M3N1MMxe'] = False # (N*m); ; -SubDyn['M3N2MMxe'] = False # (N*m); ; -SubDyn['M3N3MMxe'] = False # (N*m); ; -SubDyn['M3N4MMxe'] = False # (N*m); ; -SubDyn['M3N5MMxe'] = False # (N*m); ; -SubDyn['M3N6MMxe'] = False # (N*m); ; -SubDyn['M3N7MMxe'] = False # (N*m); ; -SubDyn['M3N8MMxe'] = False # (N*m); ; -SubDyn['M3N9MMxe'] = False # (N*m); ; -SubDyn['M4N1MMxe'] = False # (N*m); ; -SubDyn['M4N2MMxe'] = False # (N*m); ; -SubDyn['M4N3MMxe'] = False # (N*m); ; -SubDyn['M4N4MMxe'] = False # (N*m); ; -SubDyn['M4N5MMxe'] = False # (N*m); ; -SubDyn['M4N6MMxe'] = False # (N*m); ; -SubDyn['M4N7MMxe'] = False # (N*m); ; -SubDyn['M4N8MMxe'] = False # (N*m); ; -SubDyn['M4N9MMxe'] = False # (N*m); ; -SubDyn['M5N1MMxe'] = False # (N*m); ; -SubDyn['M5N2MMxe'] = False # (N*m); ; -SubDyn['M5N3MMxe'] = False # (N*m); ; -SubDyn['M5N4MMxe'] = False # (N*m); ; -SubDyn['M5N5MMxe'] = False # (N*m); ; -SubDyn['M5N6MMxe'] = False # (N*m); ; -SubDyn['M5N7MMxe'] = False # (N*m); ; -SubDyn['M5N8MMxe'] = False # (N*m); ; -SubDyn['M5N9MMxe'] = False # (N*m); ; -SubDyn['M6N1MMxe'] = False # (N*m); ; -SubDyn['M6N2MMxe'] = False # (N*m); ; -SubDyn['M6N3MMxe'] = False # (N*m); ; -SubDyn['M6N4MMxe'] = False # (N*m); ; -SubDyn['M6N5MMxe'] = False # (N*m); ; -SubDyn['M6N6MMxe'] = False # (N*m); ; -SubDyn['M6N7MMxe'] = False # (N*m); ; -SubDyn['M6N8MMxe'] = False # (N*m); ; -SubDyn['M6N9MMxe'] = False # (N*m); ; -SubDyn['M7N1MMxe'] = False # (N*m); ; -SubDyn['M7N2MMxe'] = False # (N*m); ; -SubDyn['M7N3MMxe'] = False # (N*m); ; -SubDyn['M7N4MMxe'] = False # (N*m); ; -SubDyn['M7N5MMxe'] = False # (N*m); ; -SubDyn['M7N6MMxe'] = False # (N*m); ; -SubDyn['M7N7MMxe'] = False # (N*m); ; -SubDyn['M7N8MMxe'] = False # (N*m); ; -SubDyn['M7N9MMxe'] = False # (N*m); ; -SubDyn['M8N1MMxe'] = False # (N*m); ; -SubDyn['M8N2MMxe'] = False # (N*m); ; -SubDyn['M8N3MMxe'] = False # (N*m); ; -SubDyn['M8N4MMxe'] = False # (N*m); ; -SubDyn['M8N5MMxe'] = False # (N*m); ; -SubDyn['M8N6MMxe'] = False # (N*m); ; -SubDyn['M8N7MMxe'] = False # (N*m); ; -SubDyn['M8N8MMxe'] = False # (N*m); ; -SubDyn['M8N9MMxe'] = False # (N*m); ; -SubDyn['M9N1MMxe'] = False # (N*m); ; -SubDyn['M9N2MMxe'] = False # (N*m); ; -SubDyn['M9N3MMxe'] = False # (N*m); ; -SubDyn['M9N4MMxe'] = False # (N*m); ; -SubDyn['M9N5MMxe'] = False # (N*m); ; -SubDyn['M9N6MMxe'] = False # (N*m); ; -SubDyn['M9N7MMxe'] = False # (N*m); ; -SubDyn['M9N8MMxe'] = False # (N*m); ; -SubDyn['M9N9MMxe'] = False # (N*m); ; -SubDyn['M1N1MMye'] = False # (N*m); ye component of the bending moment at Node Nj of member Mi- Local Reference System- Dynamic Component; -SubDyn['M1N2MMye'] = False # (N*m); ; -SubDyn['M1N3MMye'] = False # (N*m); ; -SubDyn['M1N4MMye'] = False # (N*m); ; -SubDyn['M1N5MMye'] = False # (N*m); ; -SubDyn['M1N6MMye'] = False # (N*m); ; -SubDyn['M1N7MMye'] = False # (N*m); ; -SubDyn['M1N8MMye'] = False # (N*m); ; -SubDyn['M1N9MMye'] = False # (N*m); ; -SubDyn['M2N1MMye'] = False # (N*m); ; -SubDyn['M2N2MMye'] = False # (N*m); ; -SubDyn['M2N3MMye'] = False # (N*m); ; -SubDyn['M2N4MMye'] = False # (N*m); ; -SubDyn['M2N5MMye'] = False # (N*m); ; -SubDyn['M2N6MMye'] = False # (N*m); ; -SubDyn['M2N7MMye'] = False # (N*m); ; -SubDyn['M2N8MMye'] = False # (N*m); ; -SubDyn['M2N9MMye'] = False # (N*m); ; -SubDyn['M3N1MMye'] = False # (N*m); ; -SubDyn['M3N2MMye'] = False # (N*m); ; -SubDyn['M3N3MMye'] = False # (N*m); ; -SubDyn['M3N4MMye'] = False # (N*m); ; -SubDyn['M3N5MMye'] = False # (N*m); ; -SubDyn['M3N6MMye'] = False # (N*m); ; -SubDyn['M3N7MMye'] = False # (N*m); ; -SubDyn['M3N8MMye'] = False # (N*m); ; -SubDyn['M3N9MMye'] = False # (N*m); ; -SubDyn['M4N1MMye'] = False # (N*m); ; -SubDyn['M4N2MMye'] = False # (N*m); ; -SubDyn['M4N3MMye'] = False # (N*m); ; -SubDyn['M4N4MMye'] = False # (N*m); ; -SubDyn['M4N5MMye'] = False # (N*m); ; -SubDyn['M4N6MMye'] = False # (N*m); ; -SubDyn['M4N7MMye'] = False # (N*m); ; -SubDyn['M4N8MMye'] = False # (N*m); ; -SubDyn['M4N9MMye'] = False # (N*m); ; -SubDyn['M5N1MMye'] = False # (N*m); ; -SubDyn['M5N2MMye'] = False # (N*m); ; -SubDyn['M5N3MMye'] = False # (N*m); ; -SubDyn['M5N4MMye'] = False # (N*m); ; -SubDyn['M5N5MMye'] = False # (N*m); ; -SubDyn['M5N6MMye'] = False # (N*m); ; -SubDyn['M5N7MMye'] = False # (N*m); ; -SubDyn['M5N8MMye'] = False # (N*m); ; -SubDyn['M5N9MMye'] = False # (N*m); ; -SubDyn['M6N1MMye'] = False # (N*m); ; -SubDyn['M6N2MMye'] = False # (N*m); ; -SubDyn['M6N3MMye'] = False # (N*m); ; -SubDyn['M6N4MMye'] = False # (N*m); ; -SubDyn['M6N5MMye'] = False # (N*m); ; -SubDyn['M6N6MMye'] = False # (N*m); ; -SubDyn['M6N7MMye'] = False # (N*m); ; -SubDyn['M6N8MMye'] = False # (N*m); ; -SubDyn['M6N9MMye'] = False # (N*m); ; -SubDyn['M7N1MMye'] = False # (N*m); ; -SubDyn['M7N2MMye'] = False # (N*m); ; -SubDyn['M7N3MMye'] = False # (N*m); ; -SubDyn['M7N4MMye'] = False # (N*m); ; -SubDyn['M7N5MMye'] = False # (N*m); ; -SubDyn['M7N6MMye'] = False # (N*m); ; -SubDyn['M7N7MMye'] = False # (N*m); ; -SubDyn['M7N8MMye'] = False # (N*m); ; -SubDyn['M7N9MMye'] = False # (N*m); ; -SubDyn['M8N1MMye'] = False # (N*m); ; -SubDyn['M8N2MMye'] = False # (N*m); ; -SubDyn['M8N3MMye'] = False # (N*m); ; -SubDyn['M8N4MMye'] = False # (N*m); ; -SubDyn['M8N5MMye'] = False # (N*m); ; -SubDyn['M8N6MMye'] = False # (N*m); ; -SubDyn['M8N7MMye'] = False # (N*m); ; -SubDyn['M8N8MMye'] = False # (N*m); ; -SubDyn['M8N9MMye'] = False # (N*m); ; -SubDyn['M9N1MMye'] = False # (N*m); ; -SubDyn['M9N2MMye'] = False # (N*m); ; -SubDyn['M9N3MMye'] = False # (N*m); ; -SubDyn['M9N4MMye'] = False # (N*m); ; -SubDyn['M9N5MMye'] = False # (N*m); ; -SubDyn['M9N6MMye'] = False # (N*m); ; -SubDyn['M9N7MMye'] = False # (N*m); ; -SubDyn['M9N8MMye'] = False # (N*m); ; -SubDyn['M9N9MMye'] = False # (N*m); ; -SubDyn['M1N1MMze'] = False # (N*m); Torsion moment at Node Nj of member Mi- Local Reference System- Dynamic Component; -SubDyn['M1N2MMze'] = False # (N*m); ; -SubDyn['M1N3MMze'] = False # (N*m); ; -SubDyn['M1N4MMze'] = False # (N*m); ; -SubDyn['M1N5MMze'] = False # (N*m); ; -SubDyn['M1N6MMze'] = False # (N*m); ; -SubDyn['M1N7MMze'] = False # (N*m); ; -SubDyn['M1N8MMze'] = False # (N*m); ; -SubDyn['M1N9MMze'] = False # (N*m); ; -SubDyn['M2N1MMze'] = False # (N*m); ; -SubDyn['M2N2MMze'] = False # (N*m); ; -SubDyn['M2N3MMze'] = False # (N*m); ; -SubDyn['M2N4MMze'] = False # (N*m); ; -SubDyn['M2N5MMze'] = False # (N*m); ; -SubDyn['M2N6MMze'] = False # (N*m); ; -SubDyn['M2N7MMze'] = False # (N*m); ; -SubDyn['M2N8MMze'] = False # (N*m); ; -SubDyn['M2N9MMze'] = False # (N*m); ; -SubDyn['M3N1MMze'] = False # (N*m); ; -SubDyn['M3N2MMze'] = False # (N*m); ; -SubDyn['M3N3MMze'] = False # (N*m); ; -SubDyn['M3N4MMze'] = False # (N*m); ; -SubDyn['M3N5MMze'] = False # (N*m); ; -SubDyn['M3N6MMze'] = False # (N*m); ; -SubDyn['M3N7MMze'] = False # (N*m); ; -SubDyn['M3N8MMze'] = False # (N*m); ; -SubDyn['M3N9MMze'] = False # (N*m); ; -SubDyn['M4N1MMze'] = False # (N*m); ; -SubDyn['M4N2MMze'] = False # (N*m); ; -SubDyn['M4N3MMze'] = False # (N*m); ; -SubDyn['M4N4MMze'] = False # (N*m); ; -SubDyn['M4N5MMze'] = False # (N*m); ; -SubDyn['M4N6MMze'] = False # (N*m); ; -SubDyn['M4N7MMze'] = False # (N*m); ; -SubDyn['M4N8MMze'] = False # (N*m); ; -SubDyn['M4N9MMze'] = False # (N*m); ; -SubDyn['M5N1MMze'] = False # (N*m); ; -SubDyn['M5N2MMze'] = False # (N*m); ; -SubDyn['M5N3MMze'] = False # (N*m); ; -SubDyn['M5N4MMze'] = False # (N*m); ; -SubDyn['M5N5MMze'] = False # (N*m); ; -SubDyn['M5N6MMze'] = False # (N*m); ; -SubDyn['M5N7MMze'] = False # (N*m); ; -SubDyn['M5N8MMze'] = False # (N*m); ; -SubDyn['M5N9MMze'] = False # (N*m); ; -SubDyn['M6N1MMze'] = False # (N*m); ; -SubDyn['M6N2MMze'] = False # (N*m); ; -SubDyn['M6N3MMze'] = False # (N*m); ; -SubDyn['M6N4MMze'] = False # (N*m); ; -SubDyn['M6N5MMze'] = False # (N*m); ; -SubDyn['M6N6MMze'] = False # (N*m); ; -SubDyn['M6N7MMze'] = False # (N*m); ; -SubDyn['M6N8MMze'] = False # (N*m); ; -SubDyn['M6N9MMze'] = False # (N*m); ; -SubDyn['M7N1MMze'] = False # (N*m); ; -SubDyn['M7N2MMze'] = False # (N*m); ; -SubDyn['M7N3MMze'] = False # (N*m); ; -SubDyn['M7N4MMze'] = False # (N*m); ; -SubDyn['M7N5MMze'] = False # (N*m); ; -SubDyn['M7N6MMze'] = False # (N*m); ; -SubDyn['M7N7MMze'] = False # (N*m); ; -SubDyn['M7N8MMze'] = False # (N*m); ; -SubDyn['M7N9MMze'] = False # (N*m); ; -SubDyn['M8N1MMze'] = False # (N*m); ; -SubDyn['M8N2MMze'] = False # (N*m); ; -SubDyn['M8N3MMze'] = False # (N*m); ; -SubDyn['M8N4MMze'] = False # (N*m); ; -SubDyn['M8N5MMze'] = False # (N*m); ; -SubDyn['M8N6MMze'] = False # (N*m); ; -SubDyn['M8N7MMze'] = False # (N*m); ; -SubDyn['M8N8MMze'] = False # (N*m); ; -SubDyn['M8N9MMze'] = False # (N*m); ; -SubDyn['M9N1MMze'] = False # (N*m); ; -SubDyn['M9N2MMze'] = False # (N*m); ; -SubDyn['M9N3MMze'] = False # (N*m); ; -SubDyn['M9N4MMze'] = False # (N*m); ; -SubDyn['M9N5MMze'] = False # (N*m); ; -SubDyn['M9N6MMze'] = False # (N*m); ; -SubDyn['M9N7MMze'] = False # (N*m); ; -SubDyn['M9N8MMze'] = False # (N*m); ; -SubDyn['M9N9MMze'] = False # (N*m); ; +""" SeaState """ +SeaState = {} + +# Wave Elevations +SeaState['Wave1Elev'] = False # (m); Total (first-order plus second-order) wave elevation (global Z height) at the 1st user-requested location (location is specified in the global coordinate system); +SeaState['Wave2Elev'] = False # (m); Total (first-order plus second-order) wave elevation (global Z height) at the 2nd user-requested location (location is specified in the global coordinate system); +SeaState['Wave3Elev'] = False # (m); Total (first-order plus second-order) wave elevation (global Z height) at the 3rd user-requested location (location is specified in the global coordinate system); +SeaState['Wave4Elev'] = False # (m); Total (first-order plus second-order) wave elevation (global Z height) at the 4th user-requested location (location is specified in the global coordinate system); +SeaState['Wave5Elev'] = False # (m); Total (first-order plus second-order) wave elevation (global Z height) at the 5th user-requested location (location is specified in the global coordinate system); +SeaState['Wave6Elev'] = False # (m); Total (first-order plus second-order) wave elevation (global Z height) at the 6th user-requested location (location is specified in the global coordinate system); +SeaState['Wave7Elev'] = False # (m); Total (first-order plus second-order) wave elevation (global Z height) at the 7th user-requested location (location is specified in the global coordinate system); +SeaState['Wave8Elev'] = False # (m); Total (first-order plus second-order) wave elevation (global Z height) at the 8th user-requested location (location is specified in the global coordinate system); +SeaState['Wave9Elev'] = False # (m); Total (first-order plus second-order) wave elevation (global Z height) at the 9th user-requested location (location is specified in the global coordinate system); +SeaState['Wave1Elv1'] = False # (m); First-order wave elevation (global Z height) at the 1st user-requested location (location is specified in the global coordinate system); +SeaState['Wave2Elv1'] = False # (m); First-order wave elevation (global Z height) at the 2nd user-requested location (location is specified in the global coordinate system); +SeaState['Wave3Elv1'] = False # (m); First-order wave elevation (global Z height) at the 3rd user-requested location (location is specified in the global coordinate system); +SeaState['Wave4Elv1'] = False # (m); First-order wave elevation (global Z height) at the 4th user-requested location (location is specified in the global coordinate system); +SeaState['Wave5Elv1'] = False # (m); First-order wave elevation (global Z height) at the 5th user-requested location (location is specified in the global coordinate system); +SeaState['Wave6Elv1'] = False # (m); First-order wave elevation (global Z height) at the 6th user-requested location (location is specified in the global coordinate system); +SeaState['Wave7Elv1'] = False # (m); First-order wave elevation (global Z height) at the 7th user-requested location (location is specified in the global coordinate system); +SeaState['Wave8Elv1'] = False # (m); First-order wave elevation (global Z height) at the 8th user-requested location (location is specified in the global coordinate system); +SeaState['Wave9Elv1'] = False # (m); First-order wave elevation (global Z height) at the 9th user-requested location (location is specified in the global coordinate system); +SeaState['Wave1Elv2'] = False # (m); Second-order wave elevation (global Z height) at the 1st user-requested location (location is specified in the global coordinate system); +SeaState['Wave2Elv2'] = False # (m); Second-order wave elevation (global Z height) at the 2nd user-requested location (location is specified in the global coordinate system); +SeaState['Wave3Elv2'] = False # (m); Second-order wave elevation (global Z height) at the 3rd user-requested location (location is specified in the global coordinate system); +SeaState['Wave4Elv2'] = False # (m); Second-order wave elevation (global Z height) at the 4th user-requested location (location is specified in the global coordinate system); +SeaState['Wave5Elv2'] = False # (m); Second-order wave elevation (global Z height) at the 5th user-requested location (location is specified in the global coordinate system); +SeaState['Wave6Elv2'] = False # (m); Second-order wave elevation (global Z height) at the 6th user-requested location (location is specified in the global coordinate system); +SeaState['Wave7Elv2'] = False # (m); Second-order wave elevation (global Z height) at the 7th user-requested location (location is specified in the global coordinate system); +SeaState['Wave8Elv2'] = False # (m); Second-order wave elevation (global Z height) at the 8th user-requested location (location is specified in the global coordinate system); +SeaState['Wave9Elv2'] = False # (m); Second-order wave elevation (global Z height) at the 9th user-requested location (location is specified in the global coordinate system); + +# Wave Kinematics +SeaState['FVel1xi'] = False # (m/s); fluid velocity along the global x-direction at the 1st user-requested location (location is specified in the global coordinate system); +SeaState['FVel2xi'] = False # (m/s); fluid velocity along the global x-direction at the 2nd user-requested location (location is specified in the global coordinate system); +SeaState['FVel3xi'] = False # (m/s); fluid velocity along the global x-direction at the 3rd user-requested location (location is specified in the global coordinate system); +SeaState['FVel4xi'] = False # (m/s); fluid velocity along the global x-direction at the 4th user-requested location (location is specified in the global coordinate system); +SeaState['FVel5xi'] = False # (m/s); fluid velocity along the global x-direction at the 5th user-requested location (location is specified in the global coordinate system); +SeaState['FVel6xi'] = False # (m/s); fluid velocity along the global x-direction at the 6th user-requested location (location is specified in the global coordinate system); +SeaState['FVel7xi'] = False # (m/s); fluid velocity along the global x-direction at the 7th user-requested location (location is specified in the global coordinate system); +SeaState['FVel8xi'] = False # (m/s); fluid velocity along the global x-direction at the 8th user-requested location (location is specified in the global coordinate system); +SeaState['FVel9xi'] = False # (m/s); fluid velocity along the global x-direction at the 9th user-requested location (location is specified in the global coordinate system); +SeaState['FVel1yi'] = False # (m/s); fluid velocity along the global y-direction at the 1st user-requested location (location is specified in the global coordinate system); +SeaState['FVel2yi'] = False # (m/s); fluid velocity along the global y-direction at the 2nd user-requested location (location is specified in the global coordinate system); +SeaState['FVel3yi'] = False # (m/s); fluid velocity along the global y-direction at the 3rd user-requested location (location is specified in the global coordinate system); +SeaState['FVel4yi'] = False # (m/s); fluid velocity along the global y-direction at the 4th user-requested location (location is specified in the global coordinate system); +SeaState['FVel5yi'] = False # (m/s); fluid velocity along the global y-direction at the 5th user-requested location (location is specified in the global coordinate system); +SeaState['FVel6yi'] = False # (m/s); fluid velocity along the global y-direction at the 6th user-requested location (location is specified in the global coordinate system); +SeaState['FVel7yi'] = False # (m/s); fluid velocity along the global y-direction at the 7th user-requested location (location is specified in the global coordinate system); +SeaState['FVel8yi'] = False # (m/s); fluid velocity along the global y-direction at the 8th user-requested location (location is specified in the global coordinate system); +SeaState['FVel9yi'] = False # (m/s); fluid velocity along the global y-direction at the 9th user-requested location (location is specified in the global coordinate system); +SeaState['FVel1zi'] = False # (m/s); fluid velocity along the global z-direction at the 1st user-requested location (location is specified in the global coordinate system); +SeaState['FVel2zi'] = False # (m/s); fluid velocity along the global z-direction at the 2nd user-requested location (location is specified in the global coordinate system); +SeaState['FVel3zi'] = False # (m/s); fluid velocity along the global z-direction at the 3rd user-requested location (location is specified in the global coordinate system); +SeaState['FVel4zi'] = False # (m/s); fluid velocity along the global z-direction at the 4th user-requested location (location is specified in the global coordinate system); +SeaState['FVel5zi'] = False # (m/s); fluid velocity along the global z-direction at the 5th user-requested location (location is specified in the global coordinate system); +SeaState['FVel6zi'] = False # (m/s); fluid velocity along the global z-direction at the 6th user-requested location (location is specified in the global coordinate system); +SeaState['FVel7zi'] = False # (m/s); fluid velocity along the global z-direction at the 7th user-requested location (location is specified in the global coordinate system); +SeaState['FVel8zi'] = False # (m/s); fluid velocity along the global z-direction at the 8th user-requested location (location is specified in the global coordinate system); +SeaState['FVel9zi'] = False # (m/s); fluid velocity along the global z-direction at the 9th user-requested location (location is specified in the global coordinate system); +SeaState['FAcc1xi'] = False # (m/s^2); fluid acceleration along the global x-direction at the 1st user-requested location (location is specified in the global coordinate system); +SeaState['FAcc2xi'] = False # (m/s^2); fluid acceleration along the global x-direction at the 2nd user-requested location (location is specified in the global coordinate system); +SeaState['FAcc3xi'] = False # (m/s^2); fluid acceleration along the global x-direction at the 3rd user-requested location (location is specified in the global coordinate system); +SeaState['FAcc4xi'] = False # (m/s^2); fluid acceleration along the global x-direction at the 4th user-requested location (location is specified in the global coordinate system); +SeaState['FAcc5xi'] = False # (m/s^2); fluid acceleration along the global x-direction at the 5th user-requested location (location is specified in the global coordinate system); +SeaState['FAcc6xi'] = False # (m/s^2); fluid acceleration along the global x-direction at the 6th user-requested location (location is specified in the global coordinate system); +SeaState['FAcc7xi'] = False # (m/s^2); fluid acceleration along the global x-direction at the 7th user-requested location (location is specified in the global coordinate system); +SeaState['FAcc8xi'] = False # (m/s^2); fluid acceleration along the global x-direction at the 8th user-requested location (location is specified in the global coordinate system); +SeaState['FAcc9xi'] = False # (m/s^2); fluid acceleration along the global x-direction at the 9th user-requested location (location is specified in the global coordinate system); +SeaState['FAcc1yi'] = False # (m/s^2); fluid acceleration along the global y-direction at the 1st user-requested location (location is specified in the global coordinate system); +SeaState['FAcc2yi'] = False # (m/s^2); fluid acceleration along the global y-direction at the 2nd user-requested location (location is specified in the global coordinate system); +SeaState['FAcc3yi'] = False # (m/s^2); fluid acceleration along the global y-direction at the 3rd user-requested location (location is specified in the global coordinate system); +SeaState['FAcc4yi'] = False # (m/s^2); fluid acceleration along the global y-direction at the 4th user-requested location (location is specified in the global coordinate system); +SeaState['FAcc5yi'] = False # (m/s^2); fluid acceleration along the global y-direction at the 5th user-requested location (location is specified in the global coordinate system); +SeaState['FAcc6yi'] = False # (m/s^2); fluid acceleration along the global y-direction at the 6th user-requested location (location is specified in the global coordinate system); +SeaState['FAcc7yi'] = False # (m/s^2); fluid acceleration along the global y-direction at the 7th user-requested location (location is specified in the global coordinate system); +SeaState['FAcc8yi'] = False # (m/s^2); fluid acceleration along the global y-direction at the 8th user-requested location (location is specified in the global coordinate system); +SeaState['FAcc9yi'] = False # (m/s^2); fluid acceleration along the global y-direction at the 9th user-requested location (location is specified in the global coordinate system); +SeaState['FAcc1zi'] = False # (m/s^2); fluid acceleration along the global z-direction at the 1st user-requested location (location is specified in the global coordinate system); +SeaState['FAcc2zi'] = False # (m/s^2); fluid acceleration along the global z-direction at the 2nd user-requested location (location is specified in the global coordinate system); +SeaState['FAcc3zi'] = False # (m/s^2); fluid acceleration along the global z-direction at the 3rd user-requested location (location is specified in the global coordinate system); +SeaState['FAcc4zi'] = False # (m/s^2); fluid acceleration along the global z-direction at the 4th user-requested location (location is specified in the global coordinate system); +SeaState['FAcc5zi'] = False # (m/s^2); fluid acceleration along the global z-direction at the 5th user-requested location (location is specified in the global coordinate system); +SeaState['FAcc6zi'] = False # (m/s^2); fluid acceleration along the global z-direction at the 6th user-requested location (location is specified in the global coordinate system); +SeaState['FAcc7zi'] = False # (m/s^2); fluid acceleration along the global z-direction at the 7th user-requested location (location is specified in the global coordinate system); +SeaState['FAcc8zi'] = False # (m/s^2); fluid acceleration along the global z-direction at the 8th user-requested location (location is specified in the global coordinate system); +SeaState['FAcc9zi'] = False # (m/s^2); fluid acceleration along the global z-direction at the 9th user-requested location (location is specified in the global coordinate system); +SeaState['FDynP1'] = False # (Pa); fluid dynamic pressure at the 1st user-requested location (location is specified in the global coordinate system); +SeaState['FDynP2'] = False # (Pa); fluid dynamic pressure at the 2nd user-requested location (location is specified in the global coordinate system); +SeaState['FDynP3'] = False # (Pa); fluid dynamic pressure at the 3rd user-requested location (location is specified in the global coordinate system); +SeaState['FDynP4'] = False # (Pa); fluid dynamic pressure at the 4th user-requested location (location is specified in the global coordinate system); +SeaState['FDynP5'] = False # (Pa); fluid dynamic pressure at the 5th user-requested location (location is specified in the global coordinate system); +SeaState['FDynP6'] = False # (Pa); fluid dynamic pressure at the 6th user-requested location (location is specified in the global coordinate system); +SeaState['FDynP7'] = False # (Pa); fluid dynamic pressure at the 7th user-requested location (location is specified in the global coordinate system); +SeaState['FDynP8'] = False # (Pa); fluid dynamic pressure at the 8th user-requested location (location is specified in the global coordinate system); +SeaState['FDynP9'] = False # (Pa); fluid dynamic pressure at the 9th user-requested location (location is specified in the global coordinate system); +SeaState['FAccMCF1xi'] = False # (m/s^2); fluid acceleration with MCF approximation; +SeaState['FAccMCF2xi'] = False # (m/s^2); fluid acceleration with MCF approximation; +SeaState['FAccMCF3xi'] = False # (m/s^2); fluid acceleration with MCF approximation; +SeaState['FAccMCF4xi'] = False # (m/s^2); fluid acceleration with MCF approximation; +SeaState['FAccMCF5xi'] = False # (m/s^2); fluid acceleration with MCF approximation; +SeaState['FAccMCF6xi'] = False # (m/s^2); fluid acceleration with MCF approximation; +SeaState['FAccMCF7xi'] = False # (m/s^2); fluid acceleration with MCF approximation; +SeaState['FAccMCF8xi'] = False # (m/s^2); fluid acceleration with MCF approximation; +SeaState['FAccMCF9xi'] = False # (m/s^2); fluid acceleration with MCF approximation; +SeaState['FAccMCF1yi'] = False # (m/s^2); fluid acceleration with MCF approximation; +SeaState['FAccMCF2yi'] = False # (m/s^2); fluid acceleration with MCF approximation; +SeaState['FAccMCF3yi'] = False # (m/s^2); fluid acceleration with MCF approximation; +SeaState['FAccMCF4yi'] = False # (m/s^2); fluid acceleration with MCF approximation; +SeaState['FAccMCF5yi'] = False # (m/s^2); fluid acceleration with MCF approximation; +SeaState['FAccMCF6yi'] = False # (m/s^2); fluid acceleration with MCF approximation; +SeaState['FAccMCF7yi'] = False # (m/s^2); fluid acceleration with MCF approximation; +SeaState['FAccMCF8yi'] = False # (m/s^2); fluid acceleration with MCF approximation; +SeaState['FAccMCF9yi'] = False # (m/s^2); fluid acceleration with MCF approximation; +SeaState['FAccMCF1zi'] = False # (m/s^2); fluid acceleration with MCF approximation; +SeaState['FAccMCF2zi'] = False # (m/s^2); fluid acceleration with MCF approximation; +SeaState['FAccMCF3zi'] = False # (m/s^2); fluid acceleration with MCF approximation; +SeaState['FAccMCF4zi'] = False # (m/s^2); fluid acceleration with MCF approximation; +SeaState['FAccMCF5zi'] = False # (m/s^2); fluid acceleration with MCF approximation; +SeaState['FAccMCF6zi'] = False # (m/s^2); fluid acceleration with MCF approximation; +SeaState['FAccMCF7zi'] = False # (m/s^2); fluid acceleration with MCF approximation; +SeaState['FAccMCF8zi'] = False # (m/s^2); fluid acceleration with MCF approximation; +SeaState['FAccMCF9zi'] = False # (m/s^2); fluid acceleration with MCF approximation; + -# Displacements -SubDyn['M1N1TDxss'] = False # (m); xss component of the displacement at Node Nj of member Mi- SS Reference System; -SubDyn['M1N2TDxss'] = False # (m); ; -SubDyn['M1N3TDxss'] = False # (m); ; -SubDyn['M1N4TDxss'] = False # (m); ; -SubDyn['M1N5TDxss'] = False # (m); ; -SubDyn['M1N6TDxss'] = False # (m); ; -SubDyn['M1N7TDxss'] = False # (m); ; -SubDyn['M1N8TDxss'] = False # (m); ; -SubDyn['M1N9TDxss'] = False # (m); ; -SubDyn['M2N1TDxss'] = False # (m); ; -SubDyn['M2N2TDxss'] = False # (m); ; -SubDyn['M2N3TDxss'] = False # (m); ; -SubDyn['M2N4TDxss'] = False # (m); ; -SubDyn['M2N5TDxss'] = False # (m); ; -SubDyn['M2N6TDxss'] = False # (m); ; -SubDyn['M2N7TDxss'] = False # (m); ; -SubDyn['M2N8TDxss'] = False # (m); ; -SubDyn['M2N9TDxss'] = False # (m); ; -SubDyn['M3N1TDxss'] = False # (m); ; -SubDyn['M3N2TDxss'] = False # (m); ; -SubDyn['M3N3TDxss'] = False # (m); ; -SubDyn['M3N4TDxss'] = False # (m); ; -SubDyn['M3N5TDxss'] = False # (m); ; -SubDyn['M3N6TDxss'] = False # (m); ; -SubDyn['M3N7TDxss'] = False # (m); ; -SubDyn['M3N8TDxss'] = False # (m); ; -SubDyn['M3N9TDxss'] = False # (m); ; -SubDyn['M4N1TDxss'] = False # (m); ; -SubDyn['M4N2TDxss'] = False # (m); ; -SubDyn['M4N3TDxss'] = False # (m); ; -SubDyn['M4N4TDxss'] = False # (m); ; -SubDyn['M4N5TDxss'] = False # (m); ; -SubDyn['M4N6TDxss'] = False # (m); ; -SubDyn['M4N7TDxss'] = False # (m); ; -SubDyn['M4N8TDxss'] = False # (m); ; -SubDyn['M4N9TDxss'] = False # (m); ; -SubDyn['M5N1TDxss'] = False # (m); ; -SubDyn['M5N2TDxss'] = False # (m); ; -SubDyn['M5N3TDxss'] = False # (m); ; -SubDyn['M5N4TDxss'] = False # (m); ; -SubDyn['M5N5TDxss'] = False # (m); ; -SubDyn['M5N6TDxss'] = False # (m); ; -SubDyn['M5N7TDxss'] = False # (m); ; -SubDyn['M5N8TDxss'] = False # (m); ; -SubDyn['M5N9TDxss'] = False # (m); ; -SubDyn['M6N1TDxss'] = False # (m); ; -SubDyn['M6N2TDxss'] = False # (m); ; -SubDyn['M6N3TDxss'] = False # (m); ; -SubDyn['M6N4TDxss'] = False # (m); ; -SubDyn['M6N5TDxss'] = False # (m); ; -SubDyn['M6N6TDxss'] = False # (m); ; -SubDyn['M6N7TDxss'] = False # (m); ; -SubDyn['M6N8TDxss'] = False # (m); ; -SubDyn['M6N9TDxss'] = False # (m); ; -SubDyn['M7N1TDxss'] = False # (m); ; -SubDyn['M7N2TDxss'] = False # (m); ; -SubDyn['M7N3TDxss'] = False # (m); ; -SubDyn['M7N4TDxss'] = False # (m); ; -SubDyn['M7N5TDxss'] = False # (m); ; -SubDyn['M7N6TDxss'] = False # (m); ; -SubDyn['M7N7TDxss'] = False # (m); ; -SubDyn['M7N8TDxss'] = False # (m); ; -SubDyn['M7N9TDxss'] = False # (m); ; -SubDyn['M8N1TDxss'] = False # (m); ; -SubDyn['M8N2TDxss'] = False # (m); ; -SubDyn['M8N3TDxss'] = False # (m); ; -SubDyn['M8N4TDxss'] = False # (m); ; -SubDyn['M8N5TDxss'] = False # (m); ; -SubDyn['M8N6TDxss'] = False # (m); ; -SubDyn['M8N7TDxss'] = False # (m); ; -SubDyn['M8N8TDxss'] = False # (m); ; -SubDyn['M8N9TDxss'] = False # (m); ; -SubDyn['M9N1TDxss'] = False # (m); ; -SubDyn['M9N2TDxss'] = False # (m); ; -SubDyn['M9N3TDxss'] = False # (m); ; -SubDyn['M9N4TDxss'] = False # (m); ; -SubDyn['M9N5TDxss'] = False # (m); ; -SubDyn['M9N6TDxss'] = False # (m); ; -SubDyn['M9N7TDxss'] = False # (m); ; -SubDyn['M9N8TDxss'] = False # (m); ; -SubDyn['M9N9TDxss'] = False # (m); ; -SubDyn['M1N1TDyss'] = False # (m); yss component of the displacement at Node Nj of member Mi- SS Reference System; -SubDyn['M1N2TDyss'] = False # (m); ; -SubDyn['M1N3TDyss'] = False # (m); ; -SubDyn['M1N4TDyss'] = False # (m); ; -SubDyn['M1N5TDyss'] = False # (m); ; -SubDyn['M1N6TDyss'] = False # (m); ; -SubDyn['M1N7TDyss'] = False # (m); ; -SubDyn['M1N8TDyss'] = False # (m); ; -SubDyn['M1N9TDyss'] = False # (m); ; -SubDyn['M2N1TDyss'] = False # (m); ; -SubDyn['M2N2TDyss'] = False # (m); ; -SubDyn['M2N3TDyss'] = False # (m); ; -SubDyn['M2N4TDyss'] = False # (m); ; -SubDyn['M2N5TDyss'] = False # (m); ; -SubDyn['M2N6TDyss'] = False # (m); ; -SubDyn['M2N7TDyss'] = False # (m); ; -SubDyn['M2N8TDyss'] = False # (m); ; -SubDyn['M2N9TDyss'] = False # (m); ; -SubDyn['M3N1TDyss'] = False # (m); ; -SubDyn['M3N2TDyss'] = False # (m); ; -SubDyn['M3N3TDyss'] = False # (m); ; -SubDyn['M3N4TDyss'] = False # (m); ; -SubDyn['M3N5TDyss'] = False # (m); ; -SubDyn['M3N6TDyss'] = False # (m); ; -SubDyn['M3N7TDyss'] = False # (m); ; -SubDyn['M3N8TDyss'] = False # (m); ; -SubDyn['M3N9TDyss'] = False # (m); ; -SubDyn['M4N1TDyss'] = False # (m); ; -SubDyn['M4N2TDyss'] = False # (m); ; -SubDyn['M4N3TDyss'] = False # (m); ; -SubDyn['M4N4TDyss'] = False # (m); ; -SubDyn['M4N5TDyss'] = False # (m); ; -SubDyn['M4N6TDyss'] = False # (m); ; -SubDyn['M4N7TDyss'] = False # (m); ; -SubDyn['M4N8TDyss'] = False # (m); ; -SubDyn['M4N9TDyss'] = False # (m); ; -SubDyn['M5N1TDyss'] = False # (m); ; -SubDyn['M5N2TDyss'] = False # (m); ; -SubDyn['M5N3TDyss'] = False # (m); ; -SubDyn['M5N4TDyss'] = False # (m); ; -SubDyn['M5N5TDyss'] = False # (m); ; -SubDyn['M5N6TDyss'] = False # (m); ; -SubDyn['M5N7TDyss'] = False # (m); ; -SubDyn['M5N8TDyss'] = False # (m); ; -SubDyn['M5N9TDyss'] = False # (m); ; -SubDyn['M6N1TDyss'] = False # (m); ; -SubDyn['M6N2TDyss'] = False # (m); ; -SubDyn['M6N3TDyss'] = False # (m); ; -SubDyn['M6N4TDyss'] = False # (m); ; -SubDyn['M6N5TDyss'] = False # (m); ; -SubDyn['M6N6TDyss'] = False # (m); ; -SubDyn['M6N7TDyss'] = False # (m); ; -SubDyn['M6N8TDyss'] = False # (m); ; -SubDyn['M6N9TDyss'] = False # (m); ; -SubDyn['M7N1TDyss'] = False # (m); ; -SubDyn['M7N2TDyss'] = False # (m); ; -SubDyn['M7N3TDyss'] = False # (m); ; -SubDyn['M7N4TDyss'] = False # (m); ; -SubDyn['M7N5TDyss'] = False # (m); ; -SubDyn['M7N6TDyss'] = False # (m); ; -SubDyn['M7N7TDyss'] = False # (m); ; -SubDyn['M7N8TDyss'] = False # (m); ; -SubDyn['M7N9TDyss'] = False # (m); ; -SubDyn['M8N1TDyss'] = False # (m); ; -SubDyn['M8N2TDyss'] = False # (m); ; -SubDyn['M8N3TDyss'] = False # (m); ; -SubDyn['M8N4TDyss'] = False # (m); ; -SubDyn['M8N5TDyss'] = False # (m); ; -SubDyn['M8N6TDyss'] = False # (m); ; -SubDyn['M8N7TDyss'] = False # (m); ; -SubDyn['M8N8TDyss'] = False # (m); ; -SubDyn['M8N9TDyss'] = False # (m); ; -SubDyn['M9N1TDyss'] = False # (m); ; -SubDyn['M9N2TDyss'] = False # (m); ; -SubDyn['M9N3TDyss'] = False # (m); ; -SubDyn['M9N4TDyss'] = False # (m); ; -SubDyn['M9N5TDyss'] = False # (m); ; -SubDyn['M9N6TDyss'] = False # (m); ; -SubDyn['M9N7TDyss'] = False # (m); ; -SubDyn['M9N8TDyss'] = False # (m); ; -SubDyn['M9N9TDyss'] = False # (m); ; -SubDyn['M1N1TDzss'] = False # (m); zss component of the displacement at Node Nj of member Mi- SS Reference System; -SubDyn['M1N2TDzss'] = False # (m); ; -SubDyn['M1N3TDzss'] = False # (m); ; -SubDyn['M1N4TDzss'] = False # (m); ; -SubDyn['M1N5TDzss'] = False # (m); ; -SubDyn['M1N6TDzss'] = False # (m); ; -SubDyn['M1N7TDzss'] = False # (m); ; -SubDyn['M1N8TDzss'] = False # (m); ; -SubDyn['M1N9TDzss'] = False # (m); ; -SubDyn['M2N1TDzss'] = False # (m); ; -SubDyn['M2N2TDzss'] = False # (m); ; -SubDyn['M2N3TDzss'] = False # (m); ; -SubDyn['M2N4TDzss'] = False # (m); ; -SubDyn['M2N5TDzss'] = False # (m); ; -SubDyn['M2N6TDzss'] = False # (m); ; -SubDyn['M2N7TDzss'] = False # (m); ; -SubDyn['M2N8TDzss'] = False # (m); ; -SubDyn['M2N9TDzss'] = False # (m); ; -SubDyn['M3N1TDzss'] = False # (m); ; -SubDyn['M3N2TDzss'] = False # (m); ; -SubDyn['M3N3TDzss'] = False # (m); ; -SubDyn['M3N4TDzss'] = False # (m); ; -SubDyn['M3N5TDzss'] = False # (m); ; -SubDyn['M3N6TDzss'] = False # (m); ; -SubDyn['M3N7TDzss'] = False # (m); ; -SubDyn['M3N8TDzss'] = False # (m); ; -SubDyn['M3N9TDzss'] = False # (m); ; -SubDyn['M4N1TDzss'] = False # (m); ; -SubDyn['M4N2TDzss'] = False # (m); ; -SubDyn['M4N3TDzss'] = False # (m); ; -SubDyn['M4N4TDzss'] = False # (m); ; -SubDyn['M4N5TDzss'] = False # (m); ; -SubDyn['M4N6TDzss'] = False # (m); ; -SubDyn['M4N7TDzss'] = False # (m); ; -SubDyn['M4N8TDzss'] = False # (m); ; -SubDyn['M4N9TDzss'] = False # (m); ; -SubDyn['M5N1TDzss'] = False # (m); ; -SubDyn['M5N2TDzss'] = False # (m); ; -SubDyn['M5N3TDzss'] = False # (m); ; -SubDyn['M5N4TDzss'] = False # (m); ; -SubDyn['M5N5TDzss'] = False # (m); ; -SubDyn['M5N6TDzss'] = False # (m); ; -SubDyn['M5N7TDzss'] = False # (m); ; -SubDyn['M5N8TDzss'] = False # (m); ; -SubDyn['M5N9TDzss'] = False # (m); ; -SubDyn['M6N1TDzss'] = False # (m); ; -SubDyn['M6N2TDzss'] = False # (m); ; -SubDyn['M6N3TDzss'] = False # (m); ; -SubDyn['M6N4TDzss'] = False # (m); ; -SubDyn['M6N5TDzss'] = False # (m); ; -SubDyn['M6N6TDzss'] = False # (m); ; -SubDyn['M6N7TDzss'] = False # (m); ; -SubDyn['M6N8TDzss'] = False # (m); ; -SubDyn['M6N9TDzss'] = False # (m); ; -SubDyn['M7N1TDzss'] = False # (m); ; -SubDyn['M7N2TDzss'] = False # (m); ; -SubDyn['M7N3TDzss'] = False # (m); ; -SubDyn['M7N4TDzss'] = False # (m); ; -SubDyn['M7N5TDzss'] = False # (m); ; -SubDyn['M7N6TDzss'] = False # (m); ; -SubDyn['M7N7TDzss'] = False # (m); ; -SubDyn['M7N8TDzss'] = False # (m); ; -SubDyn['M7N9TDzss'] = False # (m); ; -SubDyn['M8N1TDzss'] = False # (m); ; -SubDyn['M8N2TDzss'] = False # (m); ; -SubDyn['M8N3TDzss'] = False # (m); ; -SubDyn['M8N4TDzss'] = False # (m); ; -SubDyn['M8N5TDzss'] = False # (m); ; -SubDyn['M8N6TDzss'] = False # (m); ; -SubDyn['M8N7TDzss'] = False # (m); ; -SubDyn['M8N8TDzss'] = False # (m); ; -SubDyn['M8N9TDzss'] = False # (m); ; -SubDyn['M9N1TDzss'] = False # (m); ; -SubDyn['M9N2TDzss'] = False # (m); ; -SubDyn['M9N3TDzss'] = False # (m); ; -SubDyn['M9N4TDzss'] = False # (m); ; -SubDyn['M9N5TDzss'] = False # (m); ; -SubDyn['M9N6TDzss'] = False # (m); ; -SubDyn['M9N7TDzss'] = False # (m); ; -SubDyn['M9N8TDzss'] = False # (m); ; -SubDyn['M9N9TDzss'] = False # (m); ; -SubDyn['M1N1RDxe'] = False # (rad); xe component of the rotational displacement at Node Nj of member Mi-Element Reference System; -SubDyn['M1N2RDxe'] = False # (rad); ; -SubDyn['M1N3RDxe'] = False # (rad); ; -SubDyn['M1N4RDxe'] = False # (rad); ; -SubDyn['M1N5RDxe'] = False # (rad); ; -SubDyn['M1N6RDxe'] = False # (rad); ; -SubDyn['M1N7RDxe'] = False # (rad); ; -SubDyn['M1N8RDxe'] = False # (rad); ; -SubDyn['M1N9RDxe'] = False # (rad); ; -SubDyn['M2N1RDxe'] = False # (rad); ; -SubDyn['M2N2RDxe'] = False # (rad); ; -SubDyn['M2N3RDxe'] = False # (rad); ; -SubDyn['M2N4RDxe'] = False # (rad); ; -SubDyn['M2N5RDxe'] = False # (rad); ; -SubDyn['M2N6RDxe'] = False # (rad); ; -SubDyn['M2N7RDxe'] = False # (rad); ; -SubDyn['M2N8RDxe'] = False # (rad); ; -SubDyn['M2N9RDxe'] = False # (rad); ; -SubDyn['M3N1RDxe'] = False # (rad); ; -SubDyn['M3N2RDxe'] = False # (rad); ; -SubDyn['M3N3RDxe'] = False # (rad); ; -SubDyn['M3N4RDxe'] = False # (rad); ; -SubDyn['M3N5RDxe'] = False # (rad); ; -SubDyn['M3N6RDxe'] = False # (rad); ; -SubDyn['M3N7RDxe'] = False # (rad); ; -SubDyn['M3N8RDxe'] = False # (rad); ; -SubDyn['M3N9RDxe'] = False # (rad); ; -SubDyn['M4N1RDxe'] = False # (rad); ; -SubDyn['M4N2RDxe'] = False # (rad); ; -SubDyn['M4N3RDxe'] = False # (rad); ; -SubDyn['M4N4RDxe'] = False # (rad); ; -SubDyn['M4N5RDxe'] = False # (rad); ; -SubDyn['M4N6RDxe'] = False # (rad); ; -SubDyn['M4N7RDxe'] = False # (rad); ; -SubDyn['M4N8RDxe'] = False # (rad); ; -SubDyn['M4N9RDxe'] = False # (rad); ; -SubDyn['M5N1RDxe'] = False # (rad); ; -SubDyn['M5N2RDxe'] = False # (rad); ; -SubDyn['M5N3RDxe'] = False # (rad); ; -SubDyn['M5N4RDxe'] = False # (rad); ; -SubDyn['M5N5RDxe'] = False # (rad); ; -SubDyn['M5N6RDxe'] = False # (rad); ; -SubDyn['M5N7RDxe'] = False # (rad); ; -SubDyn['M5N8RDxe'] = False # (rad); ; -SubDyn['M5N9RDxe'] = False # (rad); ; -SubDyn['M6N1RDxe'] = False # (rad); ; -SubDyn['M6N2RDxe'] = False # (rad); ; -SubDyn['M6N3RDxe'] = False # (rad); ; -SubDyn['M6N4RDxe'] = False # (rad); ; -SubDyn['M6N5RDxe'] = False # (rad); ; -SubDyn['M6N6RDxe'] = False # (rad); ; -SubDyn['M6N7RDxe'] = False # (rad); ; -SubDyn['M6N8RDxe'] = False # (rad); ; -SubDyn['M6N9RDxe'] = False # (rad); ; -SubDyn['M7N1RDxe'] = False # (rad); ; -SubDyn['M7N2RDxe'] = False # (rad); ; -SubDyn['M7N3RDxe'] = False # (rad); ; -SubDyn['M7N4RDxe'] = False # (rad); ; -SubDyn['M7N5RDxe'] = False # (rad); ; -SubDyn['M7N6RDxe'] = False # (rad); ; -SubDyn['M7N7RDxe'] = False # (rad); ; -SubDyn['M7N8RDxe'] = False # (rad); ; -SubDyn['M7N9RDxe'] = False # (rad); ; -SubDyn['M8N1RDxe'] = False # (rad); ; -SubDyn['M8N2RDxe'] = False # (rad); ; -SubDyn['M8N3RDxe'] = False # (rad); ; -SubDyn['M8N4RDxe'] = False # (rad); ; -SubDyn['M8N5RDxe'] = False # (rad); ; -SubDyn['M8N6RDxe'] = False # (rad); ; -SubDyn['M8N7RDxe'] = False # (rad); ; -SubDyn['M8N8RDxe'] = False # (rad); ; -SubDyn['M8N9RDxe'] = False # (rad); ; -SubDyn['M9N1RDxe'] = False # (rad); ; -SubDyn['M9N2RDxe'] = False # (rad); ; -SubDyn['M9N3RDxe'] = False # (rad); ; -SubDyn['M9N4RDxe'] = False # (rad); ; -SubDyn['M9N5RDxe'] = False # (rad); ; -SubDyn['M9N6RDxe'] = False # (rad); ; -SubDyn['M9N7RDxe'] = False # (rad); ; -SubDyn['M9N8RDxe'] = False # (rad); ; -SubDyn['M9N9RDxe'] = False # (rad); ; -SubDyn['M1N1RDye'] = False # (rad); ye component of the rotational displacement at Node Nj of member Mi-Element Reference System; -SubDyn['M1N2RDye'] = False # (rad); ; -SubDyn['M1N3RDye'] = False # (rad); ; -SubDyn['M1N4RDye'] = False # (rad); ; -SubDyn['M1N5RDye'] = False # (rad); ; -SubDyn['M1N6RDye'] = False # (rad); ; -SubDyn['M1N7RDye'] = False # (rad); ; -SubDyn['M1N8RDye'] = False # (rad); ; -SubDyn['M1N9RDye'] = False # (rad); ; -SubDyn['M2N1RDye'] = False # (rad); ; -SubDyn['M2N2RDye'] = False # (rad); ; -SubDyn['M2N3RDye'] = False # (rad); ; -SubDyn['M2N4RDye'] = False # (rad); ; -SubDyn['M2N5RDye'] = False # (rad); ; -SubDyn['M2N6RDye'] = False # (rad); ; -SubDyn['M2N7RDye'] = False # (rad); ; -SubDyn['M2N8RDye'] = False # (rad); ; -SubDyn['M2N9RDye'] = False # (rad); ; -SubDyn['M3N1RDye'] = False # (rad); ; -SubDyn['M3N2RDye'] = False # (rad); ; -SubDyn['M3N3RDye'] = False # (rad); ; -SubDyn['M3N4RDye'] = False # (rad); ; -SubDyn['M3N5RDye'] = False # (rad); ; -SubDyn['M3N6RDye'] = False # (rad); ; -SubDyn['M3N7RDye'] = False # (rad); ; -SubDyn['M3N8RDye'] = False # (rad); ; -SubDyn['M3N9RDye'] = False # (rad); ; -SubDyn['M4N1RDye'] = False # (rad); ; -SubDyn['M4N2RDye'] = False # (rad); ; -SubDyn['M4N3RDye'] = False # (rad); ; -SubDyn['M4N4RDye'] = False # (rad); ; -SubDyn['M4N5RDye'] = False # (rad); ; -SubDyn['M4N6RDye'] = False # (rad); ; -SubDyn['M4N7RDye'] = False # (rad); ; -SubDyn['M4N8RDye'] = False # (rad); ; -SubDyn['M4N9RDye'] = False # (rad); ; -SubDyn['M5N1RDye'] = False # (rad); ; -SubDyn['M5N2RDye'] = False # (rad); ; -SubDyn['M5N3RDye'] = False # (rad); ; -SubDyn['M5N4RDye'] = False # (rad); ; -SubDyn['M5N5RDye'] = False # (rad); ; -SubDyn['M5N6RDye'] = False # (rad); ; -SubDyn['M5N7RDye'] = False # (rad); ; -SubDyn['M5N8RDye'] = False # (rad); ; -SubDyn['M5N9RDye'] = False # (rad); ; -SubDyn['M6N1RDye'] = False # (rad); ; -SubDyn['M6N2RDye'] = False # (rad); ; -SubDyn['M6N3RDye'] = False # (rad); ; -SubDyn['M6N4RDye'] = False # (rad); ; -SubDyn['M6N5RDye'] = False # (rad); ; -SubDyn['M6N6RDye'] = False # (rad); ; -SubDyn['M6N7RDye'] = False # (rad); ; -SubDyn['M6N8RDye'] = False # (rad); ; -SubDyn['M6N9RDye'] = False # (rad); ; -SubDyn['M7N1RDye'] = False # (rad); ; -SubDyn['M7N2RDye'] = False # (rad); ; -SubDyn['M7N3RDye'] = False # (rad); ; -SubDyn['M7N4RDye'] = False # (rad); ; -SubDyn['M7N5RDye'] = False # (rad); ; -SubDyn['M7N6RDye'] = False # (rad); ; -SubDyn['M7N7RDye'] = False # (rad); ; -SubDyn['M7N8RDye'] = False # (rad); ; -SubDyn['M7N9RDye'] = False # (rad); ; -SubDyn['M8N1RDye'] = False # (rad); ; -SubDyn['M8N2RDye'] = False # (rad); ; -SubDyn['M8N3RDye'] = False # (rad); ; -SubDyn['M8N4RDye'] = False # (rad); ; -SubDyn['M8N5RDye'] = False # (rad); ; -SubDyn['M8N6RDye'] = False # (rad); ; -SubDyn['M8N7RDye'] = False # (rad); ; -SubDyn['M8N8RDye'] = False # (rad); ; -SubDyn['M8N9RDye'] = False # (rad); ; -SubDyn['M9N1RDye'] = False # (rad); ; -SubDyn['M9N2RDye'] = False # (rad); ; -SubDyn['M9N3RDye'] = False # (rad); ; -SubDyn['M9N4RDye'] = False # (rad); ; -SubDyn['M9N5RDye'] = False # (rad); ; -SubDyn['M9N6RDye'] = False # (rad); ; -SubDyn['M9N7RDye'] = False # (rad); ; -SubDyn['M9N8RDye'] = False # (rad); ; -SubDyn['M9N9RDye'] = False # (rad); ; -SubDyn['M1N1RDze'] = False # (rad); ze component of the rotational displacement at Node Nj of member Mi-Element Reference System; -SubDyn['M1N2RDze'] = False # (rad); ; -SubDyn['M1N3RDze'] = False # (rad); ; -SubDyn['M1N4RDze'] = False # (rad); ; -SubDyn['M1N5RDze'] = False # (rad); ; -SubDyn['M1N6RDze'] = False # (rad); ; -SubDyn['M1N7RDze'] = False # (rad); ; -SubDyn['M1N8RDze'] = False # (rad); ; -SubDyn['M1N9RDze'] = False # (rad); ; -SubDyn['M2N1RDze'] = False # (rad); ; -SubDyn['M2N2RDze'] = False # (rad); ; -SubDyn['M2N3RDze'] = False # (rad); ; -SubDyn['M2N4RDze'] = False # (rad); ; -SubDyn['M2N5RDze'] = False # (rad); ; -SubDyn['M2N6RDze'] = False # (rad); ; -SubDyn['M2N7RDze'] = False # (rad); ; -SubDyn['M2N8RDze'] = False # (rad); ; -SubDyn['M2N9RDze'] = False # (rad); ; -SubDyn['M3N1RDze'] = False # (rad); ; -SubDyn['M3N2RDze'] = False # (rad); ; -SubDyn['M3N3RDze'] = False # (rad); ; -SubDyn['M3N4RDze'] = False # (rad); ; -SubDyn['M3N5RDze'] = False # (rad); ; -SubDyn['M3N6RDze'] = False # (rad); ; -SubDyn['M3N7RDze'] = False # (rad); ; -SubDyn['M3N8RDze'] = False # (rad); ; -SubDyn['M3N9RDze'] = False # (rad); ; -SubDyn['M4N1RDze'] = False # (rad); ; -SubDyn['M4N2RDze'] = False # (rad); ; -SubDyn['M4N3RDze'] = False # (rad); ; -SubDyn['M4N4RDze'] = False # (rad); ; -SubDyn['M4N5RDze'] = False # (rad); ; -SubDyn['M4N6RDze'] = False # (rad); ; -SubDyn['M4N7RDze'] = False # (rad); ; -SubDyn['M4N8RDze'] = False # (rad); ; -SubDyn['M4N9RDze'] = False # (rad); ; -SubDyn['M5N1RDze'] = False # (rad); ; -SubDyn['M5N2RDze'] = False # (rad); ; -SubDyn['M5N3RDze'] = False # (rad); ; -SubDyn['M5N4RDze'] = False # (rad); ; -SubDyn['M5N5RDze'] = False # (rad); ; -SubDyn['M5N6RDze'] = False # (rad); ; -SubDyn['M5N7RDze'] = False # (rad); ; -SubDyn['M5N8RDze'] = False # (rad); ; -SubDyn['M5N9RDze'] = False # (rad); ; -SubDyn['M6N1RDze'] = False # (rad); ; -SubDyn['M6N2RDze'] = False # (rad); ; -SubDyn['M6N3RDze'] = False # (rad); ; -SubDyn['M6N4RDze'] = False # (rad); ; -SubDyn['M6N5RDze'] = False # (rad); ; -SubDyn['M6N6RDze'] = False # (rad); ; -SubDyn['M6N7RDze'] = False # (rad); ; -SubDyn['M6N8RDze'] = False # (rad); ; -SubDyn['M6N9RDze'] = False # (rad); ; -SubDyn['M7N1RDze'] = False # (rad); ; -SubDyn['M7N2RDze'] = False # (rad); ; -SubDyn['M7N3RDze'] = False # (rad); ; -SubDyn['M7N4RDze'] = False # (rad); ; -SubDyn['M7N5RDze'] = False # (rad); ; -SubDyn['M7N6RDze'] = False # (rad); ; -SubDyn['M7N7RDze'] = False # (rad); ; -SubDyn['M7N8RDze'] = False # (rad); ; -SubDyn['M7N9RDze'] = False # (rad); ; -SubDyn['M8N1RDze'] = False # (rad); ; -SubDyn['M8N2RDze'] = False # (rad); ; -SubDyn['M8N3RDze'] = False # (rad); ; -SubDyn['M8N4RDze'] = False # (rad); ; -SubDyn['M8N5RDze'] = False # (rad); ; -SubDyn['M8N6RDze'] = False # (rad); ; -SubDyn['M8N7RDze'] = False # (rad); ; -SubDyn['M8N8RDze'] = False # (rad); ; -SubDyn['M8N9RDze'] = False # (rad); ; -SubDyn['M9N1RDze'] = False # (rad); ; -SubDyn['M9N2RDze'] = False # (rad); ; -SubDyn['M9N3RDze'] = False # (rad); ; -SubDyn['M9N4RDze'] = False # (rad); ; -SubDyn['M9N5RDze'] = False # (rad); ; -SubDyn['M9N6RDze'] = False # (rad); ; -SubDyn['M9N7RDze'] = False # (rad); ; -SubDyn['M9N8RDze'] = False # (rad); ; -SubDyn['M9N9RDze'] = False # (rad); ; +""" SubDyn """ +SubDyn = {} -# Accelerations -SubDyn['M1N1TAxe'] = False # (m/s^2); xe component of the translational acceleration displacement at Node Nj of member Mi-Element Reference System; -SubDyn['M1N2TAxe'] = False # (m/s^2); ; -SubDyn['M1N3TAxe'] = False # (m/s^2); ; -SubDyn['M1N4TAxe'] = False # (m/s^2); ; -SubDyn['M1N5TAxe'] = False # (m/s^2); ; -SubDyn['M1N6TAxe'] = False # (m/s^2); ; -SubDyn['M1N7TAxe'] = False # (m/s^2); ; -SubDyn['M1N8TAxe'] = False # (m/s^2); ; -SubDyn['M1N9TAxe'] = False # (m/s^2); ; -SubDyn['M2N1TAxe'] = False # (m/s^2); ; -SubDyn['M2N2TAxe'] = False # (m/s^2); ; -SubDyn['M2N3TAxe'] = False # (m/s^2); ; -SubDyn['M2N4TAxe'] = False # (m/s^2); ; -SubDyn['M2N5TAxe'] = False # (m/s^2); ; -SubDyn['M2N6TAxe'] = False # (m/s^2); ; -SubDyn['M2N7TAxe'] = False # (m/s^2); ; -SubDyn['M2N8TAxe'] = False # (m/s^2); ; -SubDyn['M2N9TAxe'] = False # (m/s^2); ; -SubDyn['M3N1TAxe'] = False # (m/s^2); ; -SubDyn['M3N2TAxe'] = False # (m/s^2); ; -SubDyn['M3N3TAxe'] = False # (m/s^2); ; -SubDyn['M3N4TAxe'] = False # (m/s^2); ; -SubDyn['M3N5TAxe'] = False # (m/s^2); ; -SubDyn['M3N6TAxe'] = False # (m/s^2); ; -SubDyn['M3N7TAxe'] = False # (m/s^2); ; -SubDyn['M3N8TAxe'] = False # (m/s^2); ; -SubDyn['M3N9TAxe'] = False # (m/s^2); ; -SubDyn['M4N1TAxe'] = False # (m/s^2); ; -SubDyn['M4N2TAxe'] = False # (m/s^2); ; -SubDyn['M4N3TAxe'] = False # (m/s^2); ; -SubDyn['M4N4TAxe'] = False # (m/s^2); ; -SubDyn['M4N5TAxe'] = False # (m/s^2); ; -SubDyn['M4N6TAxe'] = False # (m/s^2); ; -SubDyn['M4N7TAxe'] = False # (m/s^2); ; -SubDyn['M4N8TAxe'] = False # (m/s^2); ; -SubDyn['M4N9TAxe'] = False # (m/s^2); ; -SubDyn['M5N1TAxe'] = False # (m/s^2); ; -SubDyn['M5N2TAxe'] = False # (m/s^2); ; -SubDyn['M5N3TAxe'] = False # (m/s^2); ; -SubDyn['M5N4TAxe'] = False # (m/s^2); ; -SubDyn['M5N5TAxe'] = False # (m/s^2); ; -SubDyn['M5N6TAxe'] = False # (m/s^2); ; -SubDyn['M5N7TAxe'] = False # (m/s^2); ; -SubDyn['M5N8TAxe'] = False # (m/s^2); ; -SubDyn['M5N9TAxe'] = False # (m/s^2); ; -SubDyn['M6N1TAxe'] = False # (m/s^2); ; -SubDyn['M6N2TAxe'] = False # (m/s^2); ; -SubDyn['M6N3TAxe'] = False # (m/s^2); ; -SubDyn['M6N4TAxe'] = False # (m/s^2); ; -SubDyn['M6N5TAxe'] = False # (m/s^2); ; -SubDyn['M6N6TAxe'] = False # (m/s^2); ; -SubDyn['M6N7TAxe'] = False # (m/s^2); ; -SubDyn['M6N8TAxe'] = False # (m/s^2); ; -SubDyn['M6N9TAxe'] = False # (m/s^2); ; -SubDyn['M7N1TAxe'] = False # (m/s^2); ; -SubDyn['M7N2TAxe'] = False # (m/s^2); ; -SubDyn['M7N3TAxe'] = False # (m/s^2); ; -SubDyn['M7N4TAxe'] = False # (m/s^2); ; -SubDyn['M7N5TAxe'] = False # (m/s^2); ; -SubDyn['M7N6TAxe'] = False # (m/s^2); ; -SubDyn['M7N7TAxe'] = False # (m/s^2); ; -SubDyn['M7N8TAxe'] = False # (m/s^2); ; -SubDyn['M7N9TAxe'] = False # (m/s^2); ; -SubDyn['M8N1TAxe'] = False # (m/s^2); ; -SubDyn['M8N2TAxe'] = False # (m/s^2); ; -SubDyn['M8N3TAxe'] = False # (m/s^2); ; -SubDyn['M8N4TAxe'] = False # (m/s^2); ; -SubDyn['M8N5TAxe'] = False # (m/s^2); ; -SubDyn['M8N6TAxe'] = False # (m/s^2); ; -SubDyn['M8N7TAxe'] = False # (m/s^2); ; -SubDyn['M8N8TAxe'] = False # (m/s^2); ; -SubDyn['M8N9TAxe'] = False # (m/s^2); ; -SubDyn['M9N1TAxe'] = False # (m/s^2); ; -SubDyn['M9N2TAxe'] = False # (m/s^2); ; -SubDyn['M9N3TAxe'] = False # (m/s^2); ; -SubDyn['M9N4TAxe'] = False # (m/s^2); ; -SubDyn['M9N5TAxe'] = False # (m/s^2); ; -SubDyn['M9N6TAxe'] = False # (m/s^2); ; -SubDyn['M9N7TAxe'] = False # (m/s^2); ; -SubDyn['M9N8TAxe'] = False # (m/s^2); ; -SubDyn['M9N9TAxe'] = False # (m/s^2); ; -SubDyn['M1N1TAye'] = False # (m/s^2); ye component of the translational acceleration displacement at Node Nj of member Mi-Element Reference System; -SubDyn['M1N2TAye'] = False # (m/s^2); ; -SubDyn['M1N3TAye'] = False # (m/s^2); ; -SubDyn['M1N4TAye'] = False # (m/s^2); ; -SubDyn['M1N5TAye'] = False # (m/s^2); ; -SubDyn['M1N6TAye'] = False # (m/s^2); ; -SubDyn['M1N7TAye'] = False # (m/s^2); ; -SubDyn['M1N8TAye'] = False # (m/s^2); ; -SubDyn['M1N9TAye'] = False # (m/s^2); ; -SubDyn['M2N1TAye'] = False # (m/s^2); ; -SubDyn['M2N2TAye'] = False # (m/s^2); ; -SubDyn['M2N3TAye'] = False # (m/s^2); ; -SubDyn['M2N4TAye'] = False # (m/s^2); ; -SubDyn['M2N5TAye'] = False # (m/s^2); ; -SubDyn['M2N6TAye'] = False # (m/s^2); ; -SubDyn['M2N7TAye'] = False # (m/s^2); ; -SubDyn['M2N8TAye'] = False # (m/s^2); ; -SubDyn['M2N9TAye'] = False # (m/s^2); ; -SubDyn['M3N1TAye'] = False # (m/s^2); ; -SubDyn['M3N2TAye'] = False # (m/s^2); ; -SubDyn['M3N3TAye'] = False # (m/s^2); ; -SubDyn['M3N4TAye'] = False # (m/s^2); ; -SubDyn['M3N5TAye'] = False # (m/s^2); ; -SubDyn['M3N6TAye'] = False # (m/s^2); ; -SubDyn['M3N7TAye'] = False # (m/s^2); ; -SubDyn['M3N8TAye'] = False # (m/s^2); ; -SubDyn['M3N9TAye'] = False # (m/s^2); ; -SubDyn['M4N1TAye'] = False # (m/s^2); ; -SubDyn['M4N2TAye'] = False # (m/s^2); ; -SubDyn['M4N3TAye'] = False # (m/s^2); ; -SubDyn['M4N4TAye'] = False # (m/s^2); ; -SubDyn['M4N5TAye'] = False # (m/s^2); ; -SubDyn['M4N6TAye'] = False # (m/s^2); ; -SubDyn['M4N7TAye'] = False # (m/s^2); ; -SubDyn['M4N8TAye'] = False # (m/s^2); ; -SubDyn['M4N9TAye'] = False # (m/s^2); ; -SubDyn['M5N1TAye'] = False # (m/s^2); ; -SubDyn['M5N2TAye'] = False # (m/s^2); ; -SubDyn['M5N3TAye'] = False # (m/s^2); ; -SubDyn['M5N4TAye'] = False # (m/s^2); ; -SubDyn['M5N5TAye'] = False # (m/s^2); ; -SubDyn['M5N6TAye'] = False # (m/s^2); ; -SubDyn['M5N7TAye'] = False # (m/s^2); ; -SubDyn['M5N8TAye'] = False # (m/s^2); ; -SubDyn['M5N9TAye'] = False # (m/s^2); ; -SubDyn['M6N1TAye'] = False # (m/s^2); ; -SubDyn['M6N2TAye'] = False # (m/s^2); ; -SubDyn['M6N3TAye'] = False # (m/s^2); ; -SubDyn['M6N4TAye'] = False # (m/s^2); ; -SubDyn['M6N5TAye'] = False # (m/s^2); ; -SubDyn['M6N6TAye'] = False # (m/s^2); ; -SubDyn['M6N7TAye'] = False # (m/s^2); ; -SubDyn['M6N8TAye'] = False # (m/s^2); ; -SubDyn['M6N9TAye'] = False # (m/s^2); ; -SubDyn['M7N1TAye'] = False # (m/s^2); ; -SubDyn['M7N2TAye'] = False # (m/s^2); ; -SubDyn['M7N3TAye'] = False # (m/s^2); ; -SubDyn['M7N4TAye'] = False # (m/s^2); ; -SubDyn['M7N5TAye'] = False # (m/s^2); ; -SubDyn['M7N6TAye'] = False # (m/s^2); ; -SubDyn['M7N7TAye'] = False # (m/s^2); ; -SubDyn['M7N8TAye'] = False # (m/s^2); ; -SubDyn['M7N9TAye'] = False # (m/s^2); ; -SubDyn['M8N1TAye'] = False # (m/s^2); ; -SubDyn['M8N2TAye'] = False # (m/s^2); ; -SubDyn['M8N3TAye'] = False # (m/s^2); ; -SubDyn['M8N4TAye'] = False # (m/s^2); ; -SubDyn['M8N5TAye'] = False # (m/s^2); ; -SubDyn['M8N6TAye'] = False # (m/s^2); ; -SubDyn['M8N7TAye'] = False # (m/s^2); ; -SubDyn['M8N8TAye'] = False # (m/s^2); ; -SubDyn['M8N9TAye'] = False # (m/s^2); ; -SubDyn['M9N1TAye'] = False # (m/s^2); ; -SubDyn['M9N2TAye'] = False # (m/s^2); ; -SubDyn['M9N3TAye'] = False # (m/s^2); ; -SubDyn['M9N4TAye'] = False # (m/s^2); ; -SubDyn['M9N5TAye'] = False # (m/s^2); ; -SubDyn['M9N6TAye'] = False # (m/s^2); ; -SubDyn['M9N7TAye'] = False # (m/s^2); ; -SubDyn['M9N8TAye'] = False # (m/s^2); ; -SubDyn['M9N9TAye'] = False # (m/s^2); ; -SubDyn['M1N1TAze'] = False # (m/s^2); ze component of the translational acceleration displacement at Node Nj of member Mi-Element Reference System; -SubDyn['M1N2TAze'] = False # (m/s^2); ; -SubDyn['M1N3TAze'] = False # (m/s^2); ; -SubDyn['M1N4TAze'] = False # (m/s^2); ; -SubDyn['M1N5TAze'] = False # (m/s^2); ; -SubDyn['M1N6TAze'] = False # (m/s^2); ; -SubDyn['M1N7TAze'] = False # (m/s^2); ; -SubDyn['M1N8TAze'] = False # (m/s^2); ; -SubDyn['M1N9TAze'] = False # (m/s^2); ; -SubDyn['M2N1TAze'] = False # (m/s^2); ; -SubDyn['M2N2TAze'] = False # (m/s^2); ; -SubDyn['M2N3TAze'] = False # (m/s^2); ; -SubDyn['M2N4TAze'] = False # (m/s^2); ; -SubDyn['M2N5TAze'] = False # (m/s^2); ; -SubDyn['M2N6TAze'] = False # (m/s^2); ; -SubDyn['M2N7TAze'] = False # (m/s^2); ; -SubDyn['M2N8TAze'] = False # (m/s^2); ; -SubDyn['M2N9TAze'] = False # (m/s^2); ; -SubDyn['M3N1TAze'] = False # (m/s^2); ; -SubDyn['M3N2TAze'] = False # (m/s^2); ; -SubDyn['M3N3TAze'] = False # (m/s^2); ; -SubDyn['M3N4TAze'] = False # (m/s^2); ; -SubDyn['M3N5TAze'] = False # (m/s^2); ; -SubDyn['M3N6TAze'] = False # (m/s^2); ; -SubDyn['M3N7TAze'] = False # (m/s^2); ; -SubDyn['M3N8TAze'] = False # (m/s^2); ; -SubDyn['M3N9TAze'] = False # (m/s^2); ; -SubDyn['M4N1TAze'] = False # (m/s^2); ; -SubDyn['M4N2TAze'] = False # (m/s^2); ; -SubDyn['M4N3TAze'] = False # (m/s^2); ; -SubDyn['M4N4TAze'] = False # (m/s^2); ; -SubDyn['M4N5TAze'] = False # (m/s^2); ; -SubDyn['M4N6TAze'] = False # (m/s^2); ; -SubDyn['M4N7TAze'] = False # (m/s^2); ; -SubDyn['M4N8TAze'] = False # (m/s^2); ; -SubDyn['M4N9TAze'] = False # (m/s^2); ; -SubDyn['M5N1TAze'] = False # (m/s^2); ; -SubDyn['M5N2TAze'] = False # (m/s^2); ; -SubDyn['M5N3TAze'] = False # (m/s^2); ; -SubDyn['M5N4TAze'] = False # (m/s^2); ; -SubDyn['M5N5TAze'] = False # (m/s^2); ; -SubDyn['M5N6TAze'] = False # (m/s^2); ; -SubDyn['M5N7TAze'] = False # (m/s^2); ; -SubDyn['M5N8TAze'] = False # (m/s^2); ; -SubDyn['M5N9TAze'] = False # (m/s^2); ; -SubDyn['M6N1TAze'] = False # (m/s^2); ; -SubDyn['M6N2TAze'] = False # (m/s^2); ; -SubDyn['M6N3TAze'] = False # (m/s^2); ; -SubDyn['M6N4TAze'] = False # (m/s^2); ; -SubDyn['M6N5TAze'] = False # (m/s^2); ; -SubDyn['M6N6TAze'] = False # (m/s^2); ; -SubDyn['M6N7TAze'] = False # (m/s^2); ; -SubDyn['M6N8TAze'] = False # (m/s^2); ; -SubDyn['M6N9TAze'] = False # (m/s^2); ; -SubDyn['M7N1TAze'] = False # (m/s^2); ; -SubDyn['M7N2TAze'] = False # (m/s^2); ; -SubDyn['M7N3TAze'] = False # (m/s^2); ; -SubDyn['M7N4TAze'] = False # (m/s^2); ; -SubDyn['M7N5TAze'] = False # (m/s^2); ; -SubDyn['M7N6TAze'] = False # (m/s^2); ; -SubDyn['M7N7TAze'] = False # (m/s^2); ; -SubDyn['M7N8TAze'] = False # (m/s^2); ; -SubDyn['M7N9TAze'] = False # (m/s^2); ; -SubDyn['M8N1TAze'] = False # (m/s^2); ; -SubDyn['M8N2TAze'] = False # (m/s^2); ; -SubDyn['M8N3TAze'] = False # (m/s^2); ; -SubDyn['M8N4TAze'] = False # (m/s^2); ; -SubDyn['M8N5TAze'] = False # (m/s^2); ; -SubDyn['M8N6TAze'] = False # (m/s^2); ; -SubDyn['M8N7TAze'] = False # (m/s^2); ; -SubDyn['M8N8TAze'] = False # (m/s^2); ; -SubDyn['M8N9TAze'] = False # (m/s^2); ; -SubDyn['M9N1TAze'] = False # (m/s^2); ; -SubDyn['M9N2TAze'] = False # (m/s^2); ; -SubDyn['M9N3TAze'] = False # (m/s^2); ; -SubDyn['M9N4TAze'] = False # (m/s^2); ; -SubDyn['M9N5TAze'] = False # (m/s^2); ; -SubDyn['M9N6TAze'] = False # (m/s^2); ; -SubDyn['M9N7TAze'] = False # (m/s^2); ; -SubDyn['M9N8TAze'] = False # (m/s^2); ; -SubDyn['M9N9TAze'] = False # (m/s^2); ; -SubDyn['M1N1RAxe'] = False # (rad/s^2); xe component of the rotational acceleration displacement at Node Nj of member Mi-Element Reference System; -SubDyn['M1N2RAxe'] = False # (rad/s^2); ; -SubDyn['M1N3RAxe'] = False # (rad/s^2); ; -SubDyn['M1N4RAxe'] = False # (rad/s^2); ; -SubDyn['M1N5RAxe'] = False # (rad/s^2); ; -SubDyn['M1N6RAxe'] = False # (rad/s^2); ; -SubDyn['M1N7RAxe'] = False # (rad/s^2); ; -SubDyn['M1N8RAxe'] = False # (rad/s^2); ; -SubDyn['M1N9RAxe'] = False # (rad/s^2); ; -SubDyn['M2N1RAxe'] = False # (rad/s^2); ; -SubDyn['M2N2RAxe'] = False # (rad/s^2); ; -SubDyn['M2N3RAxe'] = False # (rad/s^2); ; -SubDyn['M2N4RAxe'] = False # (rad/s^2); ; -SubDyn['M2N5RAxe'] = False # (rad/s^2); ; -SubDyn['M2N6RAxe'] = False # (rad/s^2); ; -SubDyn['M2N7RAxe'] = False # (rad/s^2); ; -SubDyn['M2N8RAxe'] = False # (rad/s^2); ; -SubDyn['M2N9RAxe'] = False # (rad/s^2); ; -SubDyn['M3N1RAxe'] = False # (rad/s^2); ; -SubDyn['M3N2RAxe'] = False # (rad/s^2); ; -SubDyn['M3N3RAxe'] = False # (rad/s^2); ; -SubDyn['M3N4RAxe'] = False # (rad/s^2); ; -SubDyn['M3N5RAxe'] = False # (rad/s^2); ; -SubDyn['M3N6RAxe'] = False # (rad/s^2); ; -SubDyn['M3N7RAxe'] = False # (rad/s^2); ; -SubDyn['M3N8RAxe'] = False # (rad/s^2); ; -SubDyn['M3N9RAxe'] = False # (rad/s^2); ; -SubDyn['M4N1RAxe'] = False # (rad/s^2); ; -SubDyn['M4N2RAxe'] = False # (rad/s^2); ; -SubDyn['M4N3RAxe'] = False # (rad/s^2); ; -SubDyn['M4N4RAxe'] = False # (rad/s^2); ; -SubDyn['M4N5RAxe'] = False # (rad/s^2); ; -SubDyn['M4N6RAxe'] = False # (rad/s^2); ; -SubDyn['M4N7RAxe'] = False # (rad/s^2); ; -SubDyn['M4N8RAxe'] = False # (rad/s^2); ; -SubDyn['M4N9RAxe'] = False # (rad/s^2); ; -SubDyn['M5N1RAxe'] = False # (rad/s^2); ; -SubDyn['M5N2RAxe'] = False # (rad/s^2); ; -SubDyn['M5N3RAxe'] = False # (rad/s^2); ; -SubDyn['M5N4RAxe'] = False # (rad/s^2); ; -SubDyn['M5N5RAxe'] = False # (rad/s^2); ; -SubDyn['M5N6RAxe'] = False # (rad/s^2); ; -SubDyn['M5N7RAxe'] = False # (rad/s^2); ; -SubDyn['M5N8RAxe'] = False # (rad/s^2); ; -SubDyn['M5N9RAxe'] = False # (rad/s^2); ; -SubDyn['M6N1RAxe'] = False # (rad/s^2); ; -SubDyn['M6N2RAxe'] = False # (rad/s^2); ; -SubDyn['M6N3RAxe'] = False # (rad/s^2); ; -SubDyn['M6N4RAxe'] = False # (rad/s^2); ; -SubDyn['M6N5RAxe'] = False # (rad/s^2); ; -SubDyn['M6N6RAxe'] = False # (rad/s^2); ; -SubDyn['M6N7RAxe'] = False # (rad/s^2); ; -SubDyn['M6N8RAxe'] = False # (rad/s^2); ; -SubDyn['M6N9RAxe'] = False # (rad/s^2); ; -SubDyn['M7N1RAxe'] = False # (rad/s^2); ; -SubDyn['M7N2RAxe'] = False # (rad/s^2); ; -SubDyn['M7N3RAxe'] = False # (rad/s^2); ; -SubDyn['M7N4RAxe'] = False # (rad/s^2); ; -SubDyn['M7N5RAxe'] = False # (rad/s^2); ; -SubDyn['M7N6RAxe'] = False # (rad/s^2); ; -SubDyn['M7N7RAxe'] = False # (rad/s^2); ; -SubDyn['M7N8RAxe'] = False # (rad/s^2); ; -SubDyn['M7N9RAxe'] = False # (rad/s^2); ; -SubDyn['M8N1RAxe'] = False # (rad/s^2); ; -SubDyn['M8N2RAxe'] = False # (rad/s^2); ; -SubDyn['M8N3RAxe'] = False # (rad/s^2); ; -SubDyn['M8N4RAxe'] = False # (rad/s^2); ; -SubDyn['M8N5RAxe'] = False # (rad/s^2); ; -SubDyn['M8N6RAxe'] = False # (rad/s^2); ; -SubDyn['M8N7RAxe'] = False # (rad/s^2); ; -SubDyn['M8N8RAxe'] = False # (rad/s^2); ; -SubDyn['M8N9RAxe'] = False # (rad/s^2); ; -SubDyn['M9N1RAxe'] = False # (rad/s^2); ; -SubDyn['M9N2RAxe'] = False # (rad/s^2); ; -SubDyn['M9N3RAxe'] = False # (rad/s^2); ; -SubDyn['M9N4RAxe'] = False # (rad/s^2); ; -SubDyn['M9N5RAxe'] = False # (rad/s^2); ; -SubDyn['M9N6RAxe'] = False # (rad/s^2); ; -SubDyn['M9N7RAxe'] = False # (rad/s^2); ; -SubDyn['M9N8RAxe'] = False # (rad/s^2); ; -SubDyn['M9N9RAxe'] = False # (rad/s^2); ; -SubDyn['M1N1RAye'] = False # (rad/s^2); ye component of the rotational acceleration displacement at Node Nj of member Mi-Element Reference System; -SubDyn['M1N2RAye'] = False # (rad/s^2); ; -SubDyn['M1N3RAye'] = False # (rad/s^2); ; -SubDyn['M1N4RAye'] = False # (rad/s^2); ; -SubDyn['M1N5RAye'] = False # (rad/s^2); ; -SubDyn['M1N6RAye'] = False # (rad/s^2); ; -SubDyn['M1N7RAye'] = False # (rad/s^2); ; -SubDyn['M1N8RAye'] = False # (rad/s^2); ; -SubDyn['M1N9RAye'] = False # (rad/s^2); ; -SubDyn['M2N1RAye'] = False # (rad/s^2); ; -SubDyn['M2N2RAye'] = False # (rad/s^2); ; -SubDyn['M2N3RAye'] = False # (rad/s^2); ; -SubDyn['M2N4RAye'] = False # (rad/s^2); ; -SubDyn['M2N5RAye'] = False # (rad/s^2); ; -SubDyn['M2N6RAye'] = False # (rad/s^2); ; -SubDyn['M2N7RAye'] = False # (rad/s^2); ; -SubDyn['M2N8RAye'] = False # (rad/s^2); ; -SubDyn['M2N9RAye'] = False # (rad/s^2); ; -SubDyn['M3N1RAye'] = False # (rad/s^2); ; -SubDyn['M3N2RAye'] = False # (rad/s^2); ; -SubDyn['M3N3RAye'] = False # (rad/s^2); ; -SubDyn['M3N4RAye'] = False # (rad/s^2); ; -SubDyn['M3N5RAye'] = False # (rad/s^2); ; -SubDyn['M3N6RAye'] = False # (rad/s^2); ; -SubDyn['M3N7RAye'] = False # (rad/s^2); ; -SubDyn['M3N8RAye'] = False # (rad/s^2); ; -SubDyn['M3N9RAye'] = False # (rad/s^2); ; -SubDyn['M4N1RAye'] = False # (rad/s^2); ; -SubDyn['M4N2RAye'] = False # (rad/s^2); ; -SubDyn['M4N3RAye'] = False # (rad/s^2); ; -SubDyn['M4N4RAye'] = False # (rad/s^2); ; -SubDyn['M4N5RAye'] = False # (rad/s^2); ; -SubDyn['M4N6RAye'] = False # (rad/s^2); ; -SubDyn['M4N7RAye'] = False # (rad/s^2); ; -SubDyn['M4N8RAye'] = False # (rad/s^2); ; -SubDyn['M4N9RAye'] = False # (rad/s^2); ; -SubDyn['M5N1RAye'] = False # (rad/s^2); ; -SubDyn['M5N2RAye'] = False # (rad/s^2); ; -SubDyn['M5N3RAye'] = False # (rad/s^2); ; -SubDyn['M5N4RAye'] = False # (rad/s^2); ; -SubDyn['M5N5RAye'] = False # (rad/s^2); ; -SubDyn['M5N6RAye'] = False # (rad/s^2); ; -SubDyn['M5N7RAye'] = False # (rad/s^2); ; -SubDyn['M5N8RAye'] = False # (rad/s^2); ; -SubDyn['M5N9RAye'] = False # (rad/s^2); ; -SubDyn['M6N1RAye'] = False # (rad/s^2); ; -SubDyn['M6N2RAye'] = False # (rad/s^2); ; -SubDyn['M6N3RAye'] = False # (rad/s^2); ; -SubDyn['M6N4RAye'] = False # (rad/s^2); ; -SubDyn['M6N5RAye'] = False # (rad/s^2); ; -SubDyn['M6N6RAye'] = False # (rad/s^2); ; -SubDyn['M6N7RAye'] = False # (rad/s^2); ; -SubDyn['M6N8RAye'] = False # (rad/s^2); ; -SubDyn['M6N9RAye'] = False # (rad/s^2); ; -SubDyn['M7N1RAye'] = False # (rad/s^2); ; -SubDyn['M7N2RAye'] = False # (rad/s^2); ; -SubDyn['M7N3RAye'] = False # (rad/s^2); ; -SubDyn['M7N4RAye'] = False # (rad/s^2); ; -SubDyn['M7N5RAye'] = False # (rad/s^2); ; -SubDyn['M7N6RAye'] = False # (rad/s^2); ; -SubDyn['M7N7RAye'] = False # (rad/s^2); ; -SubDyn['M7N8RAye'] = False # (rad/s^2); ; -SubDyn['M7N9RAye'] = False # (rad/s^2); ; -SubDyn['M8N1RAye'] = False # (rad/s^2); ; -SubDyn['M8N2RAye'] = False # (rad/s^2); ; -SubDyn['M8N3RAye'] = False # (rad/s^2); ; -SubDyn['M8N4RAye'] = False # (rad/s^2); ; -SubDyn['M8N5RAye'] = False # (rad/s^2); ; -SubDyn['M8N6RAye'] = False # (rad/s^2); ; -SubDyn['M8N7RAye'] = False # (rad/s^2); ; -SubDyn['M8N8RAye'] = False # (rad/s^2); ; -SubDyn['M8N9RAye'] = False # (rad/s^2); ; -SubDyn['M9N1RAye'] = False # (rad/s^2); ; -SubDyn['M9N2RAye'] = False # (rad/s^2); ; -SubDyn['M9N3RAye'] = False # (rad/s^2); ; -SubDyn['M9N4RAye'] = False # (rad/s^2); ; -SubDyn['M9N5RAye'] = False # (rad/s^2); ; -SubDyn['M9N6RAye'] = False # (rad/s^2); ; -SubDyn['M9N7RAye'] = False # (rad/s^2); ; -SubDyn['M9N8RAye'] = False # (rad/s^2); ; -SubDyn['M9N9RAye'] = False # (rad/s^2); ; -SubDyn['M1N1RAze'] = False # (rad/s^2); ze component of the rotational acceleration displacement at Node Nj of member Mi-Element Reference System; -SubDyn['M1N2RAze'] = False # (rad/s^2); ; -SubDyn['M1N3RAze'] = False # (rad/s^2); ; -SubDyn['M1N4RAze'] = False # (rad/s^2); ; -SubDyn['M1N5RAze'] = False # (rad/s^2); ; -SubDyn['M1N6RAze'] = False # (rad/s^2); ; -SubDyn['M1N7RAze'] = False # (rad/s^2); ; -SubDyn['M1N8RAze'] = False # (rad/s^2); ; -SubDyn['M1N9RAze'] = False # (rad/s^2); ; -SubDyn['M2N1RAze'] = False # (rad/s^2); ; -SubDyn['M2N2RAze'] = False # (rad/s^2); ; -SubDyn['M2N3RAze'] = False # (rad/s^2); ; -SubDyn['M2N4RAze'] = False # (rad/s^2); ; -SubDyn['M2N5RAze'] = False # (rad/s^2); ; -SubDyn['M2N6RAze'] = False # (rad/s^2); ; -SubDyn['M2N7RAze'] = False # (rad/s^2); ; -SubDyn['M2N8RAze'] = False # (rad/s^2); ; -SubDyn['M2N9RAze'] = False # (rad/s^2); ; -SubDyn['M3N1RAze'] = False # (rad/s^2); ; -SubDyn['M3N2RAze'] = False # (rad/s^2); ; -SubDyn['M3N3RAze'] = False # (rad/s^2); ; -SubDyn['M3N4RAze'] = False # (rad/s^2); ; -SubDyn['M3N5RAze'] = False # (rad/s^2); ; -SubDyn['M3N6RAze'] = False # (rad/s^2); ; -SubDyn['M3N7RAze'] = False # (rad/s^2); ; -SubDyn['M3N8RAze'] = False # (rad/s^2); ; -SubDyn['M3N9RAze'] = False # (rad/s^2); ; -SubDyn['M4N1RAze'] = False # (rad/s^2); ; -SubDyn['M4N2RAze'] = False # (rad/s^2); ; -SubDyn['M4N3RAze'] = False # (rad/s^2); ; -SubDyn['M4N4RAze'] = False # (rad/s^2); ; -SubDyn['M4N5RAze'] = False # (rad/s^2); ; -SubDyn['M4N6RAze'] = False # (rad/s^2); ; -SubDyn['M4N7RAze'] = False # (rad/s^2); ; -SubDyn['M4N8RAze'] = False # (rad/s^2); ; -SubDyn['M4N9RAze'] = False # (rad/s^2); ; -SubDyn['M5N1RAze'] = False # (rad/s^2); ; -SubDyn['M5N2RAze'] = False # (rad/s^2); ; -SubDyn['M5N3RAze'] = False # (rad/s^2); ; -SubDyn['M5N4RAze'] = False # (rad/s^2); ; -SubDyn['M5N5RAze'] = False # (rad/s^2); ; -SubDyn['M5N6RAze'] = False # (rad/s^2); ; -SubDyn['M5N7RAze'] = False # (rad/s^2); ; -SubDyn['M5N8RAze'] = False # (rad/s^2); ; -SubDyn['M5N9RAze'] = False # (rad/s^2); ; -SubDyn['M6N1RAze'] = False # (rad/s^2); ; -SubDyn['M6N2RAze'] = False # (rad/s^2); ; -SubDyn['M6N3RAze'] = False # (rad/s^2); ; -SubDyn['M6N4RAze'] = False # (rad/s^2); ; -SubDyn['M6N5RAze'] = False # (rad/s^2); ; -SubDyn['M6N6RAze'] = False # (rad/s^2); ; -SubDyn['M6N7RAze'] = False # (rad/s^2); ; -SubDyn['M6N8RAze'] = False # (rad/s^2); ; -SubDyn['M6N9RAze'] = False # (rad/s^2); ; -SubDyn['M7N1RAze'] = False # (rad/s^2); ; -SubDyn['M7N2RAze'] = False # (rad/s^2); ; -SubDyn['M7N3RAze'] = False # (rad/s^2); ; -SubDyn['M7N4RAze'] = False # (rad/s^2); ; -SubDyn['M7N5RAze'] = False # (rad/s^2); ; -SubDyn['M7N6RAze'] = False # (rad/s^2); ; -SubDyn['M7N7RAze'] = False # (rad/s^2); ; -SubDyn['M7N8RAze'] = False # (rad/s^2); ; -SubDyn['M7N9RAze'] = False # (rad/s^2); ; -SubDyn['M8N1RAze'] = False # (rad/s^2); ; -SubDyn['M8N2RAze'] = False # (rad/s^2); ; -SubDyn['M8N3RAze'] = False # (rad/s^2); ; -SubDyn['M8N4RAze'] = False # (rad/s^2); ; -SubDyn['M8N5RAze'] = False # (rad/s^2); ; -SubDyn['M8N6RAze'] = False # (rad/s^2); ; -SubDyn['M8N7RAze'] = False # (rad/s^2); ; -SubDyn['M8N8RAze'] = False # (rad/s^2); ; -SubDyn['M8N9RAze'] = False # (rad/s^2); ; -SubDyn['M9N1RAze'] = False # (rad/s^2); ; -SubDyn['M9N2RAze'] = False # (rad/s^2); ; -SubDyn['M9N3RAze'] = False # (rad/s^2); ; -SubDyn['M9N4RAze'] = False # (rad/s^2); ; -SubDyn['M9N5RAze'] = False # (rad/s^2); ; -SubDyn['M9N6RAze'] = False # (rad/s^2); ; -SubDyn['M9N7RAze'] = False # (rad/s^2); ; -SubDyn['M9N8RAze'] = False # (rad/s^2); ; -SubDyn['M9N9RAze'] = False # (rad/s^2); ; +# Member Forces (MxxNxChannelName) +SubDyn['FKxe'] = False # (N); ; +SubDyn['FKye'] = False # (N); ; +SubDyn['FKze'] = False # (N); ; +SubDyn['FMxe'] = False # (N); ; +SubDyn['FMye'] = False # (N); ; +SubDyn['FMze'] = False # (N); ; +SubDyn['MKxe'] = False # (N*m); ; +SubDyn['MKye'] = False # (N*m); ; +SubDyn['MKze'] = False # (N*m); ; +SubDyn['MMxe'] = False # (N*m); ; +SubDyn['MMye'] = False # (N*m); ; +SubDyn['MMze'] = False # (N*m); ; + +# Displacements (MxxNxChannelName) +SubDyn['TDxss'] = False # (m); ; +SubDyn['TDyss'] = False # (m); ; +SubDyn['TDzss'] = False # (m); ; +SubDyn['RDxe'] = False # (rad); ; +SubDyn['RDye'] = False # (rad); ; +SubDyn['RDze'] = False # (rad); ; + +# Accelerations (MxxNxChannelName) +SubDyn['TAxe'] = False # (m/s^2); ; +SubDyn['TAye'] = False # (m/s^2); ; +SubDyn['TAze'] = False # (m/s^2); ; +SubDyn['RAxe'] = False # (rad/s^2); ; +SubDyn['RAye'] = False # (rad/s^2); ; +SubDyn['RAze'] = False # (rad/s^2); ; # Reactions -SubDyn['ReactFXss'] = False # (N); Base Reaction Force along Xss; -SubDyn['ReactFYss'] = False # (N); Base Reaction Force along Yss; -SubDyn['ReactFZss'] = False # (N); Base Reaction Force along Zss; -SubDyn['ReactMXss'] = False # (Nm); Base Reaction Moment along Xss; -SubDyn['ReactMYss'] = False # (Nm); Base Reaction Moment along Yss; -SubDyn['ReactMZss'] = False # (Nm); Base Reaction Moment along Zss; -SubDyn['IntfFXss'] = False # (N); Interface Reaction Force along Xss; -SubDyn['IntfFYss'] = False # (N); Interface Reaction Force along Yss; -SubDyn['IntfFZss'] = False # (N); Interface Reaction Force along Zss; -SubDyn['IntfMXss'] = False # (Nm); Interface Reaction Moment along Xss; -SubDyn['IntfMYss'] = False # (Nm); Interface Reaction Moment along Yss; -SubDyn['IntfMZss'] = False # (Nm); Interface Reaction Moment along Zss; +SubDyn['ReactFXss'] = False # (N); ; +SubDyn['ReactFYss'] = False # (N); ; +SubDyn['ReactFZss'] = False # (N); ; +SubDyn['ReactMXss'] = False # (N*m); ; +SubDyn['ReactMYss'] = False # (N*m); ; +SubDyn['ReactMZss'] = False # (N*m); ; +SubDyn['IntfFXss'] = False # (N); ; +SubDyn['IntfFYss'] = False # (N); ; +SubDyn['IntfFZss'] = False # (N); ; +SubDyn['IntfMXss'] = False # (N*m); ; +SubDyn['IntfMYss'] = False # (N*m); ; +SubDyn['IntfMZss'] = False # (N*m); ; # Interface Deflections -SubDyn['IntfTDXss'] = False # (m); Interface Deflection along Xss; -SubDyn['IntfTDYss'] = False # (m); Interface Deflection along Yss; -SubDyn['IntfTDZss'] = False # (m); Interface Deflection along Zss; -SubDyn['IntfRDXss'] = False # (rad); Interface Angular Deflection along Xss; -SubDyn['IntfRDYss'] = False # (rad); Interface Angular Deflection along Yss; -SubDyn['IntfRDZss'] = False # (rad); Interface Angular Deflection along Zss; +SubDyn['IntfTDXss'] = False # (m); ; +SubDyn['IntfTDYss'] = False # (m); ; +SubDyn['IntfTDZss'] = False # (m); ; +SubDyn['IntfRDXss'] = False # (rad); ; +SubDyn['IntfRDYss'] = False # (rad); ; +SubDyn['IntfRDZss'] = False # (rad); ; # Interface Accelerations -SubDyn['IntfTAXss'] = False # (m/s^2); Interface Acceleration along Xss; -SubDyn['IntfTAYss'] = False # (m/s^2); Interface Acceleration along Yss; -SubDyn['IntfTAZss'] = False # (m/s^2); Interface Acceleration along Zss; -SubDyn['IntfRAXss'] = False # (rad/s^2); Interface Angular Acceleration along Xss; -SubDyn['IntfRAYss'] = False # (rad/s^2); Interface Angular Acceleration along Yss; -SubDyn['IntfRAZss'] = False # (rad/s^2); Interface Angular Acceleration along Zss; - -# Modal Parameters -SubDyn['SSqm01'] = False # (--); Modal Parameter (01-99) values; -SubDyn['SSqm02'] = False # (--); ; -SubDyn['SSqm03'] = False # (--); ; -SubDyn['SSqm04'] = False # (--); ; -SubDyn['SSqm05'] = False # (--); ; -SubDyn['SSqm06'] = False # (--); ; -SubDyn['SSqm07'] = False # (--); ; -SubDyn['SSqm08'] = False # (--); ; -SubDyn['SSqm09'] = False # (--); ; -SubDyn['SSqm10'] = False # (--); ; -SubDyn['SSqm11'] = False # (--); ; -SubDyn['SSqm12'] = False # (--); ; -SubDyn['SSqm13'] = False # (--); ; -SubDyn['SSqm14'] = False # (--); ; -SubDyn['SSqm15'] = False # (--); ; -SubDyn['SSqm16'] = False # (--); ; -SubDyn['SSqm17'] = False # (--); ; -SubDyn['SSqm18'] = False # (--); ; -SubDyn['SSqm19'] = False # (--); ; -SubDyn['SSqm20'] = False # (--); ; -SubDyn['SSqm21'] = False # (--); ; -SubDyn['SSqm22'] = False # (--); ; -SubDyn['SSqm23'] = False # (--); ; -SubDyn['SSqm24'] = False # (--); ; -SubDyn['SSqm25'] = False # (--); ; -SubDyn['SSqm26'] = False # (--); ; -SubDyn['SSqm27'] = False # (--); ; -SubDyn['SSqm28'] = False # (--); ; -SubDyn['SSqm29'] = False # (--); ; -SubDyn['SSqm30'] = False # (--); ; -SubDyn['SSqm31'] = False # (--); ; -SubDyn['SSqm32'] = False # (--); ; -SubDyn['SSqm33'] = False # (--); ; -SubDyn['SSqm34'] = False # (--); ; -SubDyn['SSqm35'] = False # (--); ; -SubDyn['SSqm36'] = False # (--); ; -SubDyn['SSqm37'] = False # (--); ; -SubDyn['SSqm38'] = False # (--); ; -SubDyn['SSqm39'] = False # (--); ; -SubDyn['SSqm40'] = False # (--); ; -SubDyn['SSqm41'] = False # (--); ; -SubDyn['SSqm42'] = False # (--); ; -SubDyn['SSqm43'] = False # (--); ; -SubDyn['SSqm44'] = False # (--); ; -SubDyn['SSqm45'] = False # (--); ; -SubDyn['SSqm46'] = False # (--); ; -SubDyn['SSqm47'] = False # (--); ; -SubDyn['SSqm48'] = False # (--); ; -SubDyn['SSqm49'] = False # (--); ; -SubDyn['SSqm50'] = False # (--); ; -SubDyn['SSqm51'] = False # (--); ; -SubDyn['SSqm52'] = False # (--); ; -SubDyn['SSqm53'] = False # (--); ; -SubDyn['SSqm54'] = False # (--); ; -SubDyn['SSqm55'] = False # (--); ; -SubDyn['SSqm56'] = False # (--); ; -SubDyn['SSqm57'] = False # (--); ; -SubDyn['SSqm58'] = False # (--); ; -SubDyn['SSqm59'] = False # (--); ; -SubDyn['SSqm60'] = False # (--); ; -SubDyn['SSqm61'] = False # (--); ; -SubDyn['SSqm62'] = False # (--); ; -SubDyn['SSqm63'] = False # (--); ; -SubDyn['SSqm64'] = False # (--); ; -SubDyn['SSqm65'] = False # (--); ; -SubDyn['SSqm66'] = False # (--); ; -SubDyn['SSqm67'] = False # (--); ; -SubDyn['SSqm68'] = False # (--); ; -SubDyn['SSqm69'] = False # (--); ; -SubDyn['SSqm70'] = False # (--); ; -SubDyn['SSqm71'] = False # (--); ; -SubDyn['SSqm72'] = False # (--); ; -SubDyn['SSqm73'] = False # (--); ; -SubDyn['SSqm74'] = False # (--); ; -SubDyn['SSqm75'] = False # (--); ; -SubDyn['SSqm76'] = False # (--); ; -SubDyn['SSqm77'] = False # (--); ; -SubDyn['SSqm78'] = False # (--); ; -SubDyn['SSqm79'] = False # (--); ; -SubDyn['SSqm80'] = False # (--); ; -SubDyn['SSqm81'] = False # (--); ; -SubDyn['SSqm82'] = False # (--); ; -SubDyn['SSqm83'] = False # (--); ; -SubDyn['SSqm84'] = False # (--); ; -SubDyn['SSqm85'] = False # (--); ; -SubDyn['SSqm86'] = False # (--); ; -SubDyn['SSqm87'] = False # (--); ; -SubDyn['SSqm88'] = False # (--); ; -SubDyn['SSqm89'] = False # (--); ; -SubDyn['SSqm90'] = False # (--); ; -SubDyn['SSqm91'] = False # (--); ; -SubDyn['SSqm92'] = False # (--); ; -SubDyn['SSqm93'] = False # (--); ; -SubDyn['SSqm94'] = False # (--); ; -SubDyn['SSqm95'] = False # (--); ; -SubDyn['SSqm96'] = False # (--); ; -SubDyn['SSqm97'] = False # (--); ; -SubDyn['SSqm98'] = False # (--); ; -SubDyn['SSqm99'] = False # (--); ; -SubDyn['SSqmd01'] = False # (1/s); Modal Parameter (01-99) time derivatives; -SubDyn['SSqmd02'] = False # (1/s); ; -SubDyn['SSqmd03'] = False # (1/s); ; -SubDyn['SSqmd04'] = False # (1/s); ; -SubDyn['SSqmd05'] = False # (1/s); ; -SubDyn['SSqmd06'] = False # (1/s); ; -SubDyn['SSqmd07'] = False # (1/s); ; -SubDyn['SSqmd08'] = False # (1/s); ; -SubDyn['SSqmd09'] = False # (1/s); ; -SubDyn['SSqmd10'] = False # (1/s); ; -SubDyn['SSqmd11'] = False # (1/s); ; -SubDyn['SSqmd12'] = False # (1/s); ; -SubDyn['SSqmd13'] = False # (1/s); ; -SubDyn['SSqmd14'] = False # (1/s); ; -SubDyn['SSqmd15'] = False # (1/s); ; -SubDyn['SSqmd16'] = False # (1/s); ; -SubDyn['SSqmd17'] = False # (1/s); ; -SubDyn['SSqmd18'] = False # (1/s); ; -SubDyn['SSqmd19'] = False # (1/s); ; -SubDyn['SSqmd20'] = False # (1/s); ; -SubDyn['SSqmd21'] = False # (1/s); ; -SubDyn['SSqmd22'] = False # (1/s); ; -SubDyn['SSqmd23'] = False # (1/s); ; -SubDyn['SSqmd24'] = False # (1/s); ; -SubDyn['SSqmd25'] = False # (1/s); ; -SubDyn['SSqmd26'] = False # (1/s); ; -SubDyn['SSqmd27'] = False # (1/s); ; -SubDyn['SSqmd28'] = False # (1/s); ; -SubDyn['SSqmd29'] = False # (1/s); ; -SubDyn['SSqmd30'] = False # (1/s); ; -SubDyn['SSqmd31'] = False # (1/s); ; -SubDyn['SSqmd32'] = False # (1/s); ; -SubDyn['SSqmd33'] = False # (1/s); ; -SubDyn['SSqmd34'] = False # (1/s); ; -SubDyn['SSqmd35'] = False # (1/s); ; -SubDyn['SSqmd36'] = False # (1/s); ; -SubDyn['SSqmd37'] = False # (1/s); ; -SubDyn['SSqmd38'] = False # (1/s); ; -SubDyn['SSqmd39'] = False # (1/s); ; -SubDyn['SSqmd40'] = False # (1/s); ; -SubDyn['SSqmd41'] = False # (1/s); ; -SubDyn['SSqmd42'] = False # (1/s); ; -SubDyn['SSqmd43'] = False # (1/s); ; -SubDyn['SSqmd44'] = False # (1/s); ; -SubDyn['SSqmd45'] = False # (1/s); ; -SubDyn['SSqmd46'] = False # (1/s); ; -SubDyn['SSqmd47'] = False # (1/s); ; -SubDyn['SSqmd48'] = False # (1/s); ; -SubDyn['SSqmd49'] = False # (1/s); ; -SubDyn['SSqmd50'] = False # (1/s); ; -SubDyn['SSqmd51'] = False # (1/s); ; -SubDyn['SSqmd52'] = False # (1/s); ; -SubDyn['SSqmd53'] = False # (1/s); ; -SubDyn['SSqmd54'] = False # (1/s); ; -SubDyn['SSqmd55'] = False # (1/s); ; -SubDyn['SSqmd56'] = False # (1/s); ; -SubDyn['SSqmd57'] = False # (1/s); ; -SubDyn['SSqmd58'] = False # (1/s); ; -SubDyn['SSqmd59'] = False # (1/s); ; -SubDyn['SSqmd60'] = False # (1/s); ; -SubDyn['SSqmd61'] = False # (1/s); ; -SubDyn['SSqmd62'] = False # (1/s); ; -SubDyn['SSqmd63'] = False # (1/s); ; -SubDyn['SSqmd64'] = False # (1/s); ; -SubDyn['SSqmd65'] = False # (1/s); ; -SubDyn['SSqmd66'] = False # (1/s); ; -SubDyn['SSqmd67'] = False # (1/s); ; -SubDyn['SSqmd68'] = False # (1/s); ; -SubDyn['SSqmd69'] = False # (1/s); ; -SubDyn['SSqmd70'] = False # (1/s); ; -SubDyn['SSqmd71'] = False # (1/s); ; -SubDyn['SSqmd72'] = False # (1/s); ; -SubDyn['SSqmd73'] = False # (1/s); ; -SubDyn['SSqmd74'] = False # (1/s); ; -SubDyn['SSqmd75'] = False # (1/s); ; -SubDyn['SSqmd76'] = False # (1/s); ; -SubDyn['SSqmd77'] = False # (1/s); ; -SubDyn['SSqmd78'] = False # (1/s); ; -SubDyn['SSqmd79'] = False # (1/s); ; -SubDyn['SSqmd80'] = False # (1/s); ; -SubDyn['SSqmd81'] = False # (1/s); ; -SubDyn['SSqmd82'] = False # (1/s); ; -SubDyn['SSqmd83'] = False # (1/s); ; -SubDyn['SSqmd84'] = False # (1/s); ; -SubDyn['SSqmd85'] = False # (1/s); ; -SubDyn['SSqmd86'] = False # (1/s); ; -SubDyn['SSqmd87'] = False # (1/s); ; -SubDyn['SSqmd88'] = False # (1/s); ; -SubDyn['SSqmd89'] = False # (1/s); ; -SubDyn['SSqmd90'] = False # (1/s); ; -SubDyn['SSqmd91'] = False # (1/s); ; -SubDyn['SSqmd92'] = False # (1/s); ; -SubDyn['SSqmd93'] = False # (1/s); ; -SubDyn['SSqmd94'] = False # (1/s); ; -SubDyn['SSqmd95'] = False # (1/s); ; -SubDyn['SSqmd96'] = False # (1/s); ; -SubDyn['SSqmd97'] = False # (1/s); ; -SubDyn['SSqmd98'] = False # (1/s); ; -SubDyn['SSqmd99'] = False # (1/s); ; -SubDyn['SSqmdd01'] = False # (1/s^2); Modal Parameter (01-99) 2nd time derivatives; -SubDyn['SSqmdd02'] = False # (1/s^2); ; -SubDyn['SSqmdd03'] = False # (1/s^2); ; -SubDyn['SSqmdd04'] = False # (1/s^2); ; -SubDyn['SSqmdd05'] = False # (1/s^2); ; -SubDyn['SSqmdd06'] = False # (1/s^2); ; -SubDyn['SSqmdd07'] = False # (1/s^2); ; -SubDyn['SSqmdd08'] = False # (1/s^2); ; -SubDyn['SSqmdd09'] = False # (1/s^2); ; -SubDyn['SSqmdd10'] = False # (1/s^2); ; -SubDyn['SSqmdd11'] = False # (1/s^2); ; -SubDyn['SSqmdd12'] = False # (1/s^2); ; -SubDyn['SSqmdd13'] = False # (1/s^2); ; -SubDyn['SSqmdd14'] = False # (1/s^2); ; -SubDyn['SSqmdd15'] = False # (1/s^2); ; -SubDyn['SSqmdd16'] = False # (1/s^2); ; -SubDyn['SSqmdd17'] = False # (1/s^2); ; -SubDyn['SSqmdd18'] = False # (1/s^2); ; -SubDyn['SSqmdd19'] = False # (1/s^2); ; -SubDyn['SSqmdd20'] = False # (1/s^2); ; -SubDyn['SSqmdd21'] = False # (1/s^2); ; -SubDyn['SSqmdd22'] = False # (1/s^2); ; -SubDyn['SSqmdd23'] = False # (1/s^2); ; -SubDyn['SSqmdd24'] = False # (1/s^2); ; -SubDyn['SSqmdd25'] = False # (1/s^2); ; -SubDyn['SSqmdd26'] = False # (1/s^2); ; -SubDyn['SSqmdd27'] = False # (1/s^2); ; -SubDyn['SSqmdd28'] = False # (1/s^2); ; -SubDyn['SSqmdd29'] = False # (1/s^2); ; -SubDyn['SSqmdd30'] = False # (1/s^2); ; -SubDyn['SSqmdd31'] = False # (1/s^2); ; -SubDyn['SSqmdd32'] = False # (1/s^2); ; -SubDyn['SSqmdd33'] = False # (1/s^2); ; -SubDyn['SSqmdd34'] = False # (1/s^2); ; -SubDyn['SSqmdd35'] = False # (1/s^2); ; -SubDyn['SSqmdd36'] = False # (1/s^2); ; -SubDyn['SSqmdd37'] = False # (1/s^2); ; -SubDyn['SSqmdd38'] = False # (1/s^2); ; -SubDyn['SSqmdd39'] = False # (1/s^2); ; -SubDyn['SSqmdd40'] = False # (1/s^2); ; -SubDyn['SSqmdd41'] = False # (1/s^2); ; -SubDyn['SSqmdd42'] = False # (1/s^2); ; -SubDyn['SSqmdd43'] = False # (1/s^2); ; -SubDyn['SSqmdd44'] = False # (1/s^2); ; -SubDyn['SSqmdd45'] = False # (1/s^2); ; -SubDyn['SSqmdd46'] = False # (1/s^2); ; -SubDyn['SSqmdd47'] = False # (1/s^2); ; -SubDyn['SSqmdd48'] = False # (1/s^2); ; -SubDyn['SSqmdd49'] = False # (1/s^2); ; -SubDyn['SSqmdd50'] = False # (1/s^2); ; -SubDyn['SSqmdd51'] = False # (1/s^2); ; -SubDyn['SSqmdd52'] = False # (1/s^2); ; -SubDyn['SSqmdd53'] = False # (1/s^2); ; -SubDyn['SSqmdd54'] = False # (1/s^2); ; -SubDyn['SSqmdd55'] = False # (1/s^2); ; -SubDyn['SSqmdd56'] = False # (1/s^2); ; -SubDyn['SSqmdd57'] = False # (1/s^2); ; -SubDyn['SSqmdd58'] = False # (1/s^2); ; -SubDyn['SSqmdd59'] = False # (1/s^2); ; -SubDyn['SSqmdd60'] = False # (1/s^2); ; -SubDyn['SSqmdd61'] = False # (1/s^2); ; -SubDyn['SSqmdd62'] = False # (1/s^2); ; -SubDyn['SSqmdd63'] = False # (1/s^2); ; -SubDyn['SSqmdd64'] = False # (1/s^2); ; -SubDyn['SSqmdd65'] = False # (1/s^2); ; -SubDyn['SSqmdd66'] = False # (1/s^2); ; -SubDyn['SSqmdd67'] = False # (1/s^2); ; -SubDyn['SSqmdd68'] = False # (1/s^2); ; -SubDyn['SSqmdd69'] = False # (1/s^2); ; -SubDyn['SSqmdd70'] = False # (1/s^2); ; -SubDyn['SSqmdd71'] = False # (1/s^2); ; -SubDyn['SSqmdd72'] = False # (1/s^2); ; -SubDyn['SSqmdd73'] = False # (1/s^2); ; -SubDyn['SSqmdd74'] = False # (1/s^2); ; -SubDyn['SSqmdd75'] = False # (1/s^2); ; -SubDyn['SSqmdd76'] = False # (1/s^2); ; -SubDyn['SSqmdd77'] = False # (1/s^2); ; -SubDyn['SSqmdd78'] = False # (1/s^2); ; -SubDyn['SSqmdd79'] = False # (1/s^2); ; -SubDyn['SSqmdd80'] = False # (1/s^2); ; -SubDyn['SSqmdd81'] = False # (1/s^2); ; -SubDyn['SSqmdd82'] = False # (1/s^2); ; -SubDyn['SSqmdd83'] = False # (1/s^2); ; -SubDyn['SSqmdd84'] = False # (1/s^2); ; -SubDyn['SSqmdd85'] = False # (1/s^2); ; -SubDyn['SSqmdd86'] = False # (1/s^2); ; -SubDyn['SSqmdd87'] = False # (1/s^2); ; -SubDyn['SSqmdd88'] = False # (1/s^2); ; -SubDyn['SSqmdd89'] = False # (1/s^2); ; -SubDyn['SSqmdd90'] = False # (1/s^2); ; -SubDyn['SSqmdd91'] = False # (1/s^2); ; -SubDyn['SSqmdd92'] = False # (1/s^2); ; -SubDyn['SSqmdd93'] = False # (1/s^2); ; -SubDyn['SSqmdd94'] = False # (1/s^2); ; -SubDyn['SSqmdd95'] = False # (1/s^2); ; -SubDyn['SSqmdd96'] = False # (1/s^2); ; -SubDyn['SSqmdd97'] = False # (1/s^2); ; -SubDyn['SSqmdd98'] = False # (1/s^2); ; -SubDyn['SSqmdd99'] = False # (1/s^2); ; +SubDyn['IntfTAXss'] = False # (m/s^2); ; +SubDyn['IntfTAYss'] = False # (m/s^2); ; +SubDyn['IntfTAZss'] = False # (m/s^2); ; +SubDyn['IntfRAXss'] = False # (rad/s^2); ; +SubDyn['IntfRAYss'] = False # (rad/s^2); ; +SubDyn['IntfRAZss'] = False # (rad/s^2); ; + +# Modal Parameters (NameXX for mode number XX) +SubDyn['SSqm'] = False # (-); ; +SubDyn['SSqmd'] = False # (1/s); ; +SubDyn['SSqmdd'] = False # (1/s^2); ; -""" MoorDyn """ -# THIS IS NOT A COMPLETE LIST! -# the "flexible naming system" discussed on page 7-8 of the documentation is not included -# http://www.matt-hall.ca/files/MoorDyn-Users-Guide-2017-08-16.pdf +""" WAMIT """ +WAMIT = {} -# also assuming that like other OpenFAST variables, it is limited to 9 output locations per veriable, i.e. FairTen1-FairTen9 +# WAMIT Body Forces +WAMIT['Wave1El2'] = False # (m); 2nd order wave elevation correction; +WAMIT['Wave2El2'] = False # (m); 2nd order wave elevation correction; +WAMIT['Wave3El2'] = False # (m); 2nd order wave elevation correction; +WAMIT['Wave4El2'] = False # (m); 2nd order wave elevation correction; +WAMIT['Wave5El2'] = False # (m); 2nd order wave elevation correction; +WAMIT['Wave6El2'] = False # (m); 2nd order wave elevation correction; +WAMIT['Wave7El2'] = False # (m); 2nd order wave elevation correction; +WAMIT['Wave8El2'] = False # (m); 2nd order wave elevation correction; +WAMIT['Wave9El2'] = False # (m); 2nd order wave elevation correction; -MoorDyn = {} -MoorDyn['FairTen1'] = False # (); ; -MoorDyn['FairTen2'] = False # (); ; -MoorDyn['FairTen3'] = False # (); ; -MoorDyn['FairTen4'] = False # (); ; -MoorDyn['FairTen5'] = False # (); ; -MoorDyn['FairTen6'] = False # (); ; -MoorDyn['FairTen7'] = False # (); ; -MoorDyn['FairTen8'] = False # (); ; -MoorDyn['FairTen9'] = False # (); ; -MoorDyn['AnchTen1'] = False # (); ; -MoorDyn['AnchTen2'] = False # (); ; -MoorDyn['AnchTen3'] = False # (); ; -MoorDyn['AnchTen4'] = False # (); ; -MoorDyn['AnchTen5'] = False # (); ; -MoorDyn['AnchTen6'] = False # (); ; -MoorDyn['AnchTen7'] = False # (); ; -MoorDyn['AnchTen8'] = False # (); ; -MoorDyn['AnchTen9'] = False # (); ; +# WAMIT second order Body Forces +WAMIT['WavesF2xi'] = False # (N); ; +WAMIT['WavesF2yi'] = False # (N); ; +WAMIT['WavesF2zi'] = False # (N); ; +WAMIT['WavesM2xi'] = False # (N m); ; +WAMIT['WavesM2yi'] = False # (N m); ; +WAMIT['WavesM2zi'] = False # (N m); ; -""" ElastoDyn_Nodes """ -ElastoDyn_Nodes = {} +# WAMIT Body Forces +WAMIT['WavesFxi'] = False # (N); ; +WAMIT['WavesFyi'] = False # (N); ; +WAMIT['WavesFzi'] = False # (N); ; +WAMIT['WavesMxi'] = False # (N m); ; +WAMIT['WavesMyi'] = False # (N m); ; +WAMIT['WavesMzi'] = False # (N m); ; +WAMIT['HdrStcFxi'] = False # (N); ; +WAMIT['HdrStcFyi'] = False # (N); ; +WAMIT['HdrStcFzi'] = False # (N); ; +WAMIT['HdrStcMxi'] = False # (N m); ; +WAMIT['HdrStcMyi'] = False # (N m); ; +WAMIT['HdrStcMzi'] = False # (N m); ; +WAMIT['RdtnFxi'] = False # (N); ; +WAMIT['RdtnFyi'] = False # (N); ; +WAMIT['RdtnFzi'] = False # (N); ; +WAMIT['RdtnMxi'] = False # (N m); ; +WAMIT['RdtnMyi'] = False # (N m); ; +WAMIT['RdtnMzi'] = False # (N m); ; -# Local Span Motions -ElastoDyn_Nodes['ALx'] = False # (m/s^2); local flapwise acceleration (absolute) of node; Directed along the local xb-axis -ElastoDyn_Nodes['Ax'] = False # (m/s^2); local flapwise acceleration (absolute) of node; Directed along the local xb-axis -ElastoDyn_Nodes['ALy'] = False # (m/s^2); local flapwise acceleration (absolute) of node; Directed along the local yb-axis -ElastoDyn_Nodes['Ay'] = False # (m/s^2); local flapwise acceleration (absolute) of node; Directed along the local yb-axis -ElastoDyn_Nodes['ALz'] = False # (m/s^2); local flapwise acceleration (absolute) of node; Directed along the local zb-axis -ElastoDyn_Nodes['Az'] = False # (m/s^2); local flapwise acceleration (absolute) of node; Directed along the local zb-axis -ElastoDyn_Nodes['TDx'] = False # (m); local flapwise (translational) deflection (relative to the undeflected position) of node; Directed along the xb-axis -ElastoDyn_Nodes['UxB'] = False # (m); local flapwise (translational) deflection (relative to the undeflected position) of node; Directed along the xb-axis -ElastoDyn_Nodes['TDy'] = False # (m); local edgewise (translational) deflection (relative to the undeflected position) of node; Directed along the yb-axis -ElastoDyn_Nodes['UyB'] = False # (m); local edgewise (translational) deflection (relative to the undeflected position) of node; Directed along the yb-axis -ElastoDyn_Nodes['TDz'] = False # (m); local axial (translational) deflection (relative to the undeflected position) of node; Directed along the zb-axis -ElastoDyn_Nodes['UzB'] = False # (m); local axial (translational) deflection (relative to the undeflected position) of node; Directed along the zb-axis -ElastoDyn_Nodes['RDx'] = False # (deg); Local rotational displacement about x-axis (relative to undeflected); About the local xb-axis -ElastoDyn_Nodes['Rx'] = False # (deg); Local rotational displacement about x-axis (relative to undeflected); About the local xb-axis -ElastoDyn_Nodes['RDy'] = False # (deg); Local rotational displacement about y-axis (relative to undeflected); About the local yb-axis -ElastoDyn_Nodes['Ry'] = False # (deg); Local rotational displacement about y-axis (relative to undeflected); About the local yb-axis -ElastoDyn_Nodes['RDz'] = False # (deg); Local rotational displacement about z-axis (relative to undeflected); About the local zb-axis -ElastoDyn_Nodes['Rz'] = False # (deg); Local rotational displacement about z-axis (relative to undeflected); About the local zb-axis +""" AeroDyn_Nodes """ +AeroDyn_Nodes = {} -# Local Span Loads -ElastoDyn_Nodes['MLx'] = False # (kN-m); local edgewise moment at node; About the local xb-axis -ElastoDyn_Nodes['Mx'] = False # (kN-m); local edgewise moment at node; About the local xb-axis -ElastoDyn_Nodes['MLy'] = False # (kN-m); local flapwise moment at node; About the local yb-axis -ElastoDyn_Nodes['My'] = False # (kN-m); local flapwise moment at node; About the local yb-axis -ElastoDyn_Nodes['MLz'] = False # (kN-m); local pitching moment at node; About the local zb-axis -ElastoDyn_Nodes['MLzNT'] = False # (kN-m); local pitching moment at node; About the local zb-axis -ElastoDyn_Nodes['MzL'] = False # (kN-m); local pitching moment at node; About the local zb-axis -ElastoDyn_Nodes['Mz'] = False # (kN-m); local pitching moment at node; About the local zb-axis -ElastoDyn_Nodes['FLx'] = False # (kN); local flapwise shear force at node; Directed along the local xb-axis -ElastoDyn_Nodes['Fx'] = False # (kN); local flapwise shear force at node; Directed along the local xb-axis -ElastoDyn_Nodes['FLy'] = False # (kN); local edgewise shear force at node; Directed along the local yb-axis -ElastoDyn_Nodes['Fy'] = False # (kN); local edgewise shear force at node; Directed along the local yb-axis -ElastoDyn_Nodes['FLz'] = False # (kN); local axial force at node; Directed along the local zb-axis -ElastoDyn_Nodes['FLzNT'] = False # (kN); local axial force at node; Directed along the local zb-axis -ElastoDyn_Nodes['FzL'] = False # (kN); local axial force at node; Directed along the local zb-axis -ElastoDyn_Nodes['Fz'] = False # (kN); local axial force at node; Directed along the local zb-axis -ElastoDyn_Nodes['MLxNT'] = False # (kN-m); Edgewise moment in local coordinate system (initial structural twist removed); About the local xb-axis -ElastoDyn_Nodes['MxL'] = False # (kN-m); Edgewise moment in local coordinate system (initial structural twist removed); About the local xb-axis -ElastoDyn_Nodes['MlyNT'] = False # (kN-m); Flapwise shear moment in local coordinate system (initial structural twist removed); About the local yb-axis -ElastoDyn_Nodes['MyL'] = False # (kN-m); Flapwise shear moment in local coordinate system (initial structural twist removed); About the local yb-axis -ElastoDyn_Nodes['FLxNT'] = False # (kN); Flapwise shear force in local coordinate system (initial structural twist removed); Directed along the local xb-axis -ElastoDyn_Nodes['FxL'] = False # (kN); Flapwise shear force in local coordinate system (initial structural twist removed); Directed along the local xb-axis -ElastoDyn_Nodes['FlyNT'] = False # (kN); Edgewise shear force in local coordinate system (initial structural twist removed); Directed along the local yb-axis -ElastoDyn_Nodes['FyL'] = False # (kN); Edgewise shear force in local coordinate system (initial structural twist removed); Directed along the local yb-axis +# Blade +AeroDyn_Nodes['VUndx'] = False # (m/s); (will be deprecated) x-component of undisturbed wind velocity at each node; ill-defined / implementation specific +AeroDyn_Nodes['VUndy'] = False # (m/s); (will be deprecated) y-component of undisturbed wind velocity at each node; ill-defined / implementation specific +AeroDyn_Nodes['VUndz'] = False # (m/s); (will be deprecated) z-component of undisturbed wind velocity at each node; ill-defined / implementation specific +AeroDyn_Nodes['VUndxi'] = False # (m/s); x-component of undisturbed wind velocity at each node; inertial/global coordinate system +AeroDyn_Nodes['VUndyi'] = False # (m/s); y-component of undisturbed wind velocity at each node; inertial/global coordinate system +AeroDyn_Nodes['VUndzi'] = False # (m/s); z-component of undisturbed wind velocity at each node; inertial/global coordinate system +AeroDyn_Nodes['VUndxp'] = False # (m/s); x-component of undisturbed wind velocity at each node; polar coordinate system +AeroDyn_Nodes['VUndyp'] = False # (m/s); y-component of undisturbed wind velocity at each node; polar coordinate system +AeroDyn_Nodes['VUndzp'] = False # (m/s); z-component of undisturbed wind velocity at each node; polar coordinate system +AeroDyn_Nodes['VUndxl'] = False # (m/s); x-component of undisturbed wind velocity at each node; local-polar coordinate system +AeroDyn_Nodes['VUndyl'] = False # (m/s); y-component of undisturbed wind velocity at each node; local-polar coordinate system +AeroDyn_Nodes['VUndzl'] = False # (m/s); z-component of undisturbed wind velocity at each node; local-polar coordinate system +AeroDyn_Nodes['VUndxa'] = False # (m/s); x-component of undisturbed wind velocity at each node; airfoil coordinate system +AeroDyn_Nodes['VUndya'] = False # (m/s); y-component of undisturbed wind velocity at each node; airfoil coordinate system +AeroDyn_Nodes['VUndza'] = False # (m/s); z-component of undisturbed wind velocity at each node; airfoil coordinate system +AeroDyn_Nodes['VDisx'] = False # (m/s); (will be deprecated) x-component of disturbed wind velocity at each node; ill-defined / implementation specific +AeroDyn_Nodes['VDisy'] = False # (m/s); (will be deprecated) y-component of disturbed wind velocity at each node; ill-defined / implementation specific +AeroDyn_Nodes['VDisz'] = False # (m/s); (will be deprecated) z-component of disturbed wind velocity at each node; ill-defined / implementation specific +AeroDyn_Nodes['VDisxi'] = False # (m/s); x-component of disturbed wind velocity at each node; inertial/global coordinate system +AeroDyn_Nodes['VDisyi'] = False # (m/s); y-component of disturbed wind velocity at each node; inertial/global coordinate system +AeroDyn_Nodes['VDiszi'] = False # (m/s); z-component of disturbed wind velocity at each node; inertial/global coordinate system +AeroDyn_Nodes['VDisxp'] = False # (m/s); x-component of disturbed wind velocity at each node; polar coordinate system +AeroDyn_Nodes['VDisyp'] = False # (m/s); y-component of disturbed wind velocity at each node; polar coordinate system +AeroDyn_Nodes['VDiszp'] = False # (m/s); z-component of disturbed wind velocity at each node; polar coordinate system +AeroDyn_Nodes['VDisxl'] = False # (m/s); x-component of disturbed wind velocity at each node; local-polar coordinate system +AeroDyn_Nodes['VDisyl'] = False # (m/s); y-component of disturbed wind velocity at each node; local-polar coordinate system +AeroDyn_Nodes['VDiszl'] = False # (m/s); z-component of disturbed wind velocity at each node; local-polar coordinate system +AeroDyn_Nodes['VDisxa'] = False # (m/s); x-component of disturbed wind velocity at each node; airfoil coordinate system +AeroDyn_Nodes['VDisya'] = False # (m/s); y-component of disturbed wind velocity at each node; airfoil coordinate system +AeroDyn_Nodes['VDisza'] = False # (m/s); z-component of disturbed wind velocity at each node; airfoil coordinate system +AeroDyn_Nodes['STVx'] = False # (m/s); (will be deprecated) x-component of structural translational velocity at each node; ill-defined / implementation specific +AeroDyn_Nodes['STVy'] = False # (m/s); (will be deprecated) y-component of structural translational velocity at each node; ill-defined / implementation specific +AeroDyn_Nodes['STVz'] = False # (m/s); (will be deprecated) z-component of structural translational velocity at each node; ill-defined / implementation specific +AeroDyn_Nodes['STVxi'] = False # (m/s); x-component of structural translational velocity at each node; inertial/global coordinate system +AeroDyn_Nodes['STVyi'] = False # (m/s); y-component of structural translational velocity at each node; inertial/global coordinate system +AeroDyn_Nodes['STVzi'] = False # (m/s); z-component of structural translational velocity at each node; inertial/global coordinate system +AeroDyn_Nodes['STVxp'] = False # (m/s); x-component of structural translational velocity at each node; polar coordinate system +AeroDyn_Nodes['STVyp'] = False # (m/s); y-component of structural translational velocity at each node; polar coordinate system +AeroDyn_Nodes['STVzp'] = False # (m/s); z-component of structural translational velocity at each node; polar coordinate system +AeroDyn_Nodes['STVxl'] = False # (m/s); x-component of structural translational velocity at each node; local-polar coordinate system +AeroDyn_Nodes['STVyl'] = False # (m/s); y-component of structural translational velocity at each node; local-polar coordinate system +AeroDyn_Nodes['STVzl'] = False # (m/s); z-component of structural translational velocity at each node; local-polar coordinate system +AeroDyn_Nodes['STVxa'] = False # (m/s); x-component of structural translational velocity at each node; airfoil coordinate system +AeroDyn_Nodes['STVya'] = False # (m/s); y-component of structural translational velocity at each node; airfoil coordinate system +AeroDyn_Nodes['STVza'] = False # (m/s); z-component of structural translational velocity at each node; airfoil coordinate system +AeroDyn_Nodes['Vindx'] = False # (m/s); (will be deprecated) Axial induced wind velocity at each node; local blade coordinate system +AeroDyn_Nodes['Vindy'] = False # (m/s); (will be deprecated) Tangential induced wind velocity at each node; local blade coordinate system +AeroDyn_Nodes['Vindxi'] = False # (m/s); x-component of induced velocity at each node ; inertial/global coordinate system +AeroDyn_Nodes['Vindyi'] = False # (m/s); y-component of induced velocity at each node; inertial/global coordinate system +AeroDyn_Nodes['Vindzi'] = False # (m/s); z-component of induced velocity at each node; inertial/global coordinate system +AeroDyn_Nodes['Vindxp'] = False # (m/s); x-component of induced velocity at each node ; polar coordinate system +AeroDyn_Nodes['Uin'] = False # (m/s); x-component of induced velocity at each node ; polar coordinate system +AeroDyn_Nodes['Vindyp'] = False # (m/s); y-component of induced velocity at each node; polar coordinate system +AeroDyn_Nodes['Uit'] = False # (m/s); y-component of induced velocity at each node; polar coordinate system +AeroDyn_Nodes['Vindzp'] = False # (m/s); z-component of induced velocity at each node; polar coordinate system +AeroDyn_Nodes['Uir'] = False # (m/s); z-component of induced velocity at each node; polar coordinate system +AeroDyn_Nodes['Vindxl'] = False # (m/s); x-component of induced velocity at each node ; local-polar coordinate system +AeroDyn_Nodes['Vindyl'] = False # (m/s); y-component of induced velocity at each node; local-polar coordinate system +AeroDyn_Nodes['Vindzl'] = False # (m/s); z-component of induced velocity at each node; local-polar coordinate system +AeroDyn_Nodes['Vindxa'] = False # (m/s); x-component of induced velocity at each node ; airfoil coordinate system +AeroDyn_Nodes['Vindya'] = False # (m/s); y-component of induced velocity at each node; airfoil coordinate system +AeroDyn_Nodes['Vindza'] = False # (m/s); z-component of induced velocity at each node; airfoil coordinate system +AeroDyn_Nodes['Vx'] = False # (m/s); (will be deprecated) Local axial velocity (VDisx - STVx); ill-defined / implementation specific +AeroDyn_Nodes['Vy'] = False # (m/s); (will be deprecated) Local tangential velocity (VDisy - STVy); ill-defined / implementation specific +AeroDyn_Nodes['VRel'] = False # (m/s); Relative wind speed at each node, computed using x-y components in the airfoil system; in xa-ya plane, airfoil coordinate system +AeroDyn_Nodes['DynP'] = False # (Pa); Dynamic pressure at each node; in xa-ya plane, airfoil coordinate system +AeroDyn_Nodes['Re'] = False # (-); Reynolds number (in millions) at each node; in xa-ya plane, airfoil coordinate system +AeroDyn_Nodes['M'] = False # (-); Mach number at each node; in xa-ya plane, airfoil coordinate system +AeroDyn_Nodes['AxInd'] = False # (-); Axial induction factor at each node; implementation specific +AeroDyn_Nodes['TnInd'] = False # (-); Tangential induction factor at each node; implementation specific +AeroDyn_Nodes['AxInd_qs'] = False # (-); Quasi-steady axial induction factor as computed within the quasi-steady BEM algorithm (before DBEMT and skew correction); implementation specific +AeroDyn_Nodes['TnInd_qs'] = False # (-); Quasi-steady tangential induction factor as computed within the quasi-steady BEM algorithm (before DBEMT and skew correction); implementation specific +AeroDyn_Nodes['Alpha'] = False # (deg); Angle of attack at each node; airfoil coordinate system +AeroDyn_Nodes['Phi'] = False # (deg); Inflow angle at each node; ill-defined / implementation specific +AeroDyn_Nodes['Theta'] = False # (deg); Pitch+Twist angle at each node; +AeroDyn_Nodes['Curve'] = False # (deg); Curvature angle at each node; +AeroDyn_Nodes['Toe'] = False # (deg); Toe angle at each node; +AeroDyn_Nodes['Cl'] = False # (-); Lift force coefficient at each node, including unsteady effects; in xa-ya plane, airfoil coordinate system +AeroDyn_Nodes['Cd'] = False # (-); Drag force coefficient at each node, including unsteady effects; in xa-ya plane, airfoil coordinate system +AeroDyn_Nodes['Cm'] = False # (-); Pitching moment coefficient at each node, including unsteady effects; about za, airfoil coordinate system +AeroDyn_Nodes['Cma'] = False # (-); Pitching moment coefficient at each node, including unsteady effects; about za, airfoil coordinate system +AeroDyn_Nodes['Cx'] = False # (-); (will be deprecated) Normal force (to plane) coefficient at each node; ill-defined / implementation specific +AeroDyn_Nodes['Cy'] = False # (-); (will be deprecated) Tangential force (to plane) coefficient at each node; ill-defined / implementation specific +AeroDyn_Nodes['Cn'] = False # (-); Normal force (to chord) coefficient at each node; airfoil coordinate system +AeroDyn_Nodes['Cxa'] = False # (-); Normal force (to chord) coefficient at each node; airfoil coordinate system +AeroDyn_Nodes['Ct'] = False # (-); Tangential force (to chord) coefficient at each node - Negative along ya!; airfoil coordinate system +AeroDyn_Nodes['Fxi'] = False # (N/m); Force per unit length in the x direction; inertial/global coordinate system +AeroDyn_Nodes['Fyi'] = False # (N/m); Force per unit length in the y direction; inertial/global coordinate system +AeroDyn_Nodes['Fzi'] = False # (N/m); Force per unit length in the z direction; inertial/global coordinate system +AeroDyn_Nodes['Mxi'] = False # (N-m/m); Moment per unit length in the x direction; inertial/global coordinate system +AeroDyn_Nodes['Myi'] = False # (N-m/m); Moment per unit length in the y direction; inertial/global coordinate system +AeroDyn_Nodes['Mzi'] = False # (N-m/m); Moment per unit length in the z direction; inertial/global coordinate system +AeroDyn_Nodes['Fxp'] = False # (N/m); Force per unit length in the x direction; polar coordinate system +AeroDyn_Nodes['Fyp'] = False # (N/m); Force per unit length in the y direction; polar coordinate system +AeroDyn_Nodes['Fzp'] = False # (N/m); Force per unit length in the z direction; polar coordinate system +AeroDyn_Nodes['Mxp'] = False # (N-m/m); Moment per unit length in the x direction; polar coordinate system +AeroDyn_Nodes['Myp'] = False # (N-m/m); Moment per unit length in the y direction; polar coordinate system +AeroDyn_Nodes['Mzp'] = False # (N-m/m); Moment per unit length in the z direction; polar coordinate system +AeroDyn_Nodes['Fxl'] = False # (N/m); Force per unit length in the x direction; local-polar coordinate system +AeroDyn_Nodes['Fyl'] = False # (N/m); Force per unit length in the y direction; local-polar coordinate system +AeroDyn_Nodes['Fzl'] = False # (N/m); Force per unit length in the z direction; local-polar coordinate system +AeroDyn_Nodes['Mxl'] = False # (N-m/m); Moment per unit length in the x direction; local-polar coordinate system +AeroDyn_Nodes['Myl'] = False # (N-m/m); Moment per unit length in the y direction; local-polar coordinate system +AeroDyn_Nodes['Mzl'] = False # (N-m/m); Moment per unit length in the z direction; local-polar coordinate system +AeroDyn_Nodes['Fl'] = False # (N/m); Lift force per unit length at each node; in xa-ya plane, airfoil coordinate system +AeroDyn_Nodes['Fd'] = False # (N/m); Drag force per unit length at each node; in xa-ya plane, airfoil coordinate system +AeroDyn_Nodes['Mm'] = False # (N-m/m); Pitching moment per unit length at each node; about za, airfoil coordinate system +AeroDyn_Nodes['Mza'] = False # (N-m/m); Pitching moment per unit length at each node; about za, airfoil coordinate system +AeroDyn_Nodes['Fx'] = False # (N/m); (will be deprecated) Normal force (to plane) per unit length at each node; ill-defined / implementation specific +AeroDyn_Nodes['Fy'] = False # (N/m); (will be deprecated) Tangential force (to plane) per unit length at each node; ill-defined / implementation specific +AeroDyn_Nodes['Fn'] = False # (N/m); Normal force (to chord) per unit length at each node; airfoil coordinate system +AeroDyn_Nodes['Fxa'] = False # (N/m); Normal force (to chord) per unit length at each node; airfoil coordinate system +AeroDyn_Nodes['Ft'] = False # (N/m); Tangential force (to chord) per unit length at each node - Negative along ya!; airfoil coordinate system +AeroDyn_Nodes['Gam'] = False # (m^2/s); Gamma -- circulation on blade; about za, airfoil coordinate system +AeroDyn_Nodes['Clrnc'] = False # (m); Tower clearance at each node (based on the absolute distance to the nearest point in the tower from blade node B#N# minus the local tower radius, in the deflected configuration); please note that this clearance is only approximate because the calculation assumes that the blade is a line with no volume (however, the calculation does use the local tower radius); when blade node B#N# is above the tower top (or below the tower base), the absolute distance to the tower top (or base) minus the local tower radius, in the deflected configuration, is output; +AeroDyn_Nodes['GeomPhi'] = False # (1/0); Geometric phi? If phi was solved using normal BEMT equations, GeomPhi = 1; otherwise, if it was solved geometrically, GeomPhi = 0.; +AeroDyn_Nodes['Chi'] = False # (deg); Skew angle (used in skewed wake correction); +AeroDyn_Nodes['UA_Flag'] = False # (-); Flag indicating if UA is turned on for this node.; +AeroDyn_Nodes['UA_x1'] = False # (rad); time-history of wake vorticity contributing to effective angle of attack; +AeroDyn_Nodes['UA_x2'] = False # (rad); time-history of wake vorticity contributing to effective angle of attack; +AeroDyn_Nodes['UA_x3'] = False # (-); dimension of cl (UAMod4) or cn (UAMod5); lagging the fully-attached coefficient; +AeroDyn_Nodes['UA_x4'] = False # (-); UAMod4 and 5 separation factor; +AeroDyn_Nodes['UA_x5'] = False # (-); UAMod5 vortex term; +AeroDyn_Nodes['Debug1'] = False # (-); Placeholders for debugging channels; +AeroDyn_Nodes['Debug2'] = False # (-); Placeholders for debugging channels; +AeroDyn_Nodes['Debug3'] = False # (-); Placeholders for debugging channels; +AeroDyn_Nodes['CpMin'] = False # (-); Pressure coefficient; +AeroDyn_Nodes['SgCav'] = False # (-); Cavitation number; +AeroDyn_Nodes['SigCr'] = False # (-); Critical cavitation number; +AeroDyn_Nodes['BEM_F_qs'] = False # (-); Tip/hub loss factor in quasi-steady BEM algorithm; +AeroDyn_Nodes['BEM_k_qs'] = False # (-); k factor in quasi-steady BEM algorithm; +AeroDyn_Nodes['BEM_kp_qs'] = False # (-); kp factor in quasi-steady BEM algorithm; +AeroDyn_Nodes['BEM_CT_qs'] = False # (-); Quasi-steady thrust coefficient as computed by the quasi-steady BEM algorithm. ; +AeroDyn_Nodes['Cl_qs'] = False # (-); Static portion of lift force coefficient at each node, without unsteady effects; in xa-ya plane, airfoil coordinate system +AeroDyn_Nodes['Cd_qs'] = False # (-); Static portion of drag force coefficient at each node, without unsteady effects; in xa-ya plane, airfoil coordinate system +AeroDyn_Nodes['Cm_qs'] = False # (-); Static portion of pitching moment coefficient at each node, without unsteady effects; about za, airfoil coordinate system +AeroDyn_Nodes['Fbxi'] = False # (N/m); Buoyancy force per unit length in the x direction; inertial/global coordinate system +AeroDyn_Nodes['Fbyi'] = False # (N/m); Buoyancy force per unit length in the y direction; inertial/global coordinate system +AeroDyn_Nodes['Fbzi'] = False # (N/m); Buoyancy force per unit length in the z direction; inertial/global coordinate system +AeroDyn_Nodes['Mbxi'] = False # (N-m/m); Buoyancy moment per unit length in the x direction; inertial/global coordinate system +AeroDyn_Nodes['Mbyi'] = False # (N-m/m); Buoyancy moment per unit length in the y direction; inertial/global coordinate system +AeroDyn_Nodes['Mbzi'] = False # (N-m/m); Buoyancy moment per unit length in the z direction; inertial/global coordinate system +AeroDyn_Nodes['Fbxp'] = False # (N/m); Buoyancy force per unit length in the x direction; polar coordinate system +AeroDyn_Nodes['Fbyp'] = False # (N/m); Buoyancy force per unit length in the y direction; polar coordinate system +AeroDyn_Nodes['Fbzp'] = False # (N/m); Buoyancy force per unit length in the z direction; polar coordinate system +AeroDyn_Nodes['Mbxp'] = False # (N-m/m); Buoyancy moment per unit length in the x direction; polar coordinate system +AeroDyn_Nodes['Mbyp'] = False # (N-m/m); Buoyancy moment per unit length in the y direction; polar coordinate system +AeroDyn_Nodes['Mbzp'] = False # (N-m/m); Buoyancy moment per unit length in the z direction; polar coordinate system +AeroDyn_Nodes['Fbxl'] = False # (N/m); Buoyancy force per unit length in the x direction; local-polar coordinate system +AeroDyn_Nodes['Fbyl'] = False # (N/m); Buoyancy force per unit length in the y direction; local-polar coordinate system +AeroDyn_Nodes['Fbzl'] = False # (N/m); Buoyancy force per unit length in the z direction; local-polar coordinate system +AeroDyn_Nodes['Mbxl'] = False # (N-m/m); Buoyancy moment per unit length in the x direction; local-polar coordinate system +AeroDyn_Nodes['Mbyl'] = False # (N-m/m); Buoyancy moment per unit length in the y direction; local-polar coordinate system +AeroDyn_Nodes['Mbzl'] = False # (N-m/m); Buoyancy moment per unit length in the z direction; local-polar coordinate system +AeroDyn_Nodes['Fbxa'] = False # (N/m); Buoyancy force per unit length in the x direction; airfoil coordinate system +AeroDyn_Nodes['Fbn'] = False # (N/m); Buoyancy force per unit length in the x direction; airfoil coordinate system +AeroDyn_Nodes['Fbya'] = False # (N/m); Buoyancy force per unit length in the y direction; airfoil coordinate system +AeroDyn_Nodes['Fbt'] = False # (N/m); Buoyancy force per unit length in the y direction; airfoil coordinate system +AeroDyn_Nodes['Fbza'] = False # (N/m); Buoyancy force per unit length in the z direction; airfoil coordinate system +AeroDyn_Nodes['Fbs'] = False # (N/m); Buoyancy force per unit length in the z direction; airfoil coordinate system +AeroDyn_Nodes['Mbxa'] = False # (N-m/m); Buoyancy moment per unit length in the x direction; airfoil coordinate system +AeroDyn_Nodes['Mbn'] = False # (N-m/m); Buoyancy moment per unit length in the x direction; airfoil coordinate system +AeroDyn_Nodes['Mbya'] = False # (N-m/m); Buoyancy moment per unit length in the y direction; airfoil coordinate system +AeroDyn_Nodes['Mbt'] = False # (N-m/m); Buoyancy moment per unit length in the y direction; airfoil coordinate system +AeroDyn_Nodes['Mbza'] = False # (N-m/m); Buoyancy moment per unit length in the z direction; airfoil coordinate system +AeroDyn_Nodes['Mbs'] = False # (N-m/m); Buoyancy moment per unit length in the z direction; airfoil coordinate system """ BeamDyn_Nodes """ @@ -11012,1279 +9525,240 @@ BeamDyn_Nodes['MFizr'] = False # (N-m); Inertial moment about z ; r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system -""" AeroDyn_Nodes """ -AeroDyn_Nodes = {} - -# Blade -AeroDyn_Nodes['VUndx'] = False # (m/s); x-component of undisturbed wind velocity at each node; local blade coordinate system -AeroDyn_Nodes['VUndy'] = False # (m/s); y-component of undisturbed wind velocity at each node; local blade coordinate system -AeroDyn_Nodes['VUndz'] = False # (m/s); z-component of undisturbed wind velocity at each node; local blade coordinate system -AeroDyn_Nodes['Vundxi'] = False # (m/s); x-component of undisturbed wind velocity at each node; inertial/global coordinate system -AeroDyn_Nodes['Vundyi'] = False # (m/s); y-component of undisturbed wind velocity at each node; inertial/global coordinate system -AeroDyn_Nodes['Vundzi'] = False # (m/s); z-component of undisturbed wind velocity at each node; inertial/global coordinate system -AeroDyn_Nodes['VDisx'] = False # (m/s); x-component of disturbed wind velocity at each node; local blade coordinate system -AeroDyn_Nodes['VDisy'] = False # (m/s); y-component of disturbed wind velocity at each node; local blade coordinate system -AeroDyn_Nodes['VDisz'] = False # (m/s); z-component of disturbed wind velocity at each node; local blade coordinate system -AeroDyn_Nodes['STVx'] = False # (m/s); x-component of structural translational velocity at each node; local blade coordinate system -AeroDyn_Nodes['STVy'] = False # (m/s); y-component of structural translational velocity at each node; local blade coordinate system -AeroDyn_Nodes['STVz'] = False # (m/s); z-component of structural translational velocity at each node; local blade coordinate system -AeroDyn_Nodes['VRel'] = False # (m/s); Relvative wind speed at each node; -AeroDyn_Nodes['DynP'] = False # (Pa); Dynamic pressure at each node; -AeroDyn_Nodes['Re'] = False # (-); Reynolds number (in millions) at each node; -AeroDyn_Nodes['M'] = False # (-); Mach number at each node; -AeroDyn_Nodes['Vindx'] = False # (m/s); Axial induced wind velocity at each node; -AeroDyn_Nodes['Vindy'] = False # (m/s); Tangential induced wind velocity at each node; -AeroDyn_Nodes['AxInd'] = False # (-); Axial induction factor at each node; -AeroDyn_Nodes['TnInd'] = False # (-); Tangential induction factor at each node; -AeroDyn_Nodes['Alpha'] = False # (deg); Angle of attack at each node; -AeroDyn_Nodes['Theta'] = False # (deg); Pitch+Twist angle at each node; -AeroDyn_Nodes['Phi'] = False # (deg); Inflow angle at each node; -AeroDyn_Nodes['Curve'] = False # (deg); Curvature angle at each node; -AeroDyn_Nodes['Cl'] = False # (-); Lift force coefficient at each node, including unsteady effects; -AeroDyn_Nodes['Cd'] = False # (-); Drag force coefficient at each node, including unsteady effects; -AeroDyn_Nodes['Cm'] = False # (-); Pitching moment coefficient at each node, including unsteady effects; -AeroDyn_Nodes['Cx'] = False # (-); Normal force (to plane) coefficient at each node; -AeroDyn_Nodes['Cy'] = False # (-); Tangential force (to plane) coefficient at each node; -AeroDyn_Nodes['Cn'] = False # (-); Normal force (to chord) coefficient at each node; -AeroDyn_Nodes['Ct'] = False # (-); Tangential force (to chord) coefficient at each node; -AeroDyn_Nodes['Fl'] = False # (N/m); Lift force per unit length at each node; -AeroDyn_Nodes['Fd'] = False # (N/m); Drag force per unit length at each node; -AeroDyn_Nodes['Mm'] = False # (N-m/m); Pitching moment per unit length at each node; -AeroDyn_Nodes['Fx'] = False # (N/m); Normal force (to plane) per unit length at each node; -AeroDyn_Nodes['Fy'] = False # (N/m); Tangential force (to plane) per unit length at each node; -AeroDyn_Nodes['Fn'] = False # (N/m); Normal force (to chord) per unit length at each node; -AeroDyn_Nodes['Ft'] = False # (N/m); Tangential force (to chord) per unit length at each node; -AeroDyn_Nodes['Clrnc'] = False # (m); Tower clearance at each node (based on the absolute distance to the nearest point in the tower from blade node B#N# minus the local tower radius, in the deflected configuration); please note that this clearance is only approximate because the calculation assumes that the blade is a line with no volume (however, the calculation does use the local tower radius); when blade node B#N# is above the tower top (or below the tower base), the absolute distance to the tower top (or base) minus the local tower radius, in the deflected configuration, is output; -AeroDyn_Nodes['Vx'] = False # (m/s); Local axial velocity; -AeroDyn_Nodes['Vy'] = False # (m/s); Local tangential velocity; -AeroDyn_Nodes['GeomPhi'] = False # (1/0); Geometric phi? If phi was solved using normal BEMT equations, GeomPhi = 1; otherwise, if it was solved geometrically, GeomPhi = 0.; -AeroDyn_Nodes['Chi'] = False # (deg); Skew angle (used in skewed wake correction); -AeroDyn_Nodes['UA_Flag'] = False # (-); Flag indicating if UA is turned on for this node.; -AeroDyn_Nodes['UA_x1'] = False # (rad); time-history of wake vorticity contributing to effective angle of attack; -AeroDyn_Nodes['UA_x2'] = False # (rad); time-history of wake vorticity contributing to effective angle of attack; -AeroDyn_Nodes['UA_x3'] = False # (-); dimension of cl (UAMod4) or cn (UAMod5); lagging the fully-attached coefficient; -AeroDyn_Nodes['UA_x4'] = False # (-); UAMod4 and 5 separation factor; -AeroDyn_Nodes['UA_x5'] = False # (-); UAMod5 vortex term; -AeroDyn_Nodes['Debug1'] = False # (-); Placeholders for debugging channels; -AeroDyn_Nodes['Debug2'] = False # (-); Placeholders for debugging channels; -AeroDyn_Nodes['Debug3'] = False # (-); Placeholders for debugging channels; -AeroDyn_Nodes['CpMin'] = False # (-); Pressure coefficient; -AeroDyn_Nodes['SgCav'] = False # (-); Cavitation number; -AeroDyn_Nodes['SigCr'] = False # (-); Critical cavitation number; -AeroDyn_Nodes['Gam'] = False # (m^2/s); Gamma -- circulation on blade; -AeroDyn_Nodes['Cl_Static'] = False # (-); Static portion of lift force coefficient at each node, without unsteady effects; -AeroDyn_Nodes['Cd_Static'] = False # (-); Static portion of drag force coefficient at each node, without unsteady effects; -AeroDyn_Nodes['Cm_Static'] = False # (-); Static portion of pitching moment coefficient at each node, without unsteady effects; -AeroDyn_Nodes['Uin'] = False # (m/s); Axial induced velocity in rotating hub coordinates. Axial aligned with hub axis.; rotor plane polar hub rotating coordinates -AeroDyn_Nodes['Uit'] = False # (m/s); Tangential induced velocity in rotating hub coordinates. Tangential to the rotation plane. Perpendicular to blade aziumth.; rotor plane polar hub rotating coordinates -AeroDyn_Nodes['Uir'] = False # (m/s); Radial induced velocity in rotating hub coordinates. Radial outwards in rotation plane. Aligned with blade azimuth.; rotor plane polar hub rotating coordinates - - -""" Final Output Dictionary """ -FstOutput = {} -FstOutput['ElastoDyn'] = ElastoDyn -FstOutput['BeamDyn'] = BeamDyn -FstOutput['ServoDyn'] = ServoDyn -FstOutput['AeroDyn'] = AeroDyn -FstOutput['InflowWind'] = InflowWind -FstOutput['WAMIT'] = WAMIT -FstOutput['HydroDyn'] = HydroDyn -FstOutput['Morison'] = Morison -FstOutput['SubDyn'] = SubDyn -FstOutput['MoorDyn'] = MoorDyn -FstOutput['ElastoDyn_Nodes'] = ElastoDyn_Nodes -FstOutput['BeamDyn_Nodes'] = BeamDyn_Nodes -FstOutput['AeroDyn_Nodes'] = AeroDyn_Nodes +""" ElastoDyn_Nodes """ +ElastoDyn_Nodes = {} -""" Generated from FAST OutListParameters.xlsx files with AeroelasticSE/src/AeroelasticSE/Util/create_output_vars.py """ +# Local Span Motions +ElastoDyn_Nodes['ALx'] = False # (m/s^2); local flapwise acceleration (absolute) of node; Directed along the local xb-axis +ElastoDyn_Nodes['Ax'] = False # (m/s^2); local flapwise acceleration (absolute) of node; Directed along the local xb-axis +ElastoDyn_Nodes['ALy'] = False # (m/s^2); local flapwise acceleration (absolute) of node; Directed along the local yb-axis +ElastoDyn_Nodes['Ay'] = False # (m/s^2); local flapwise acceleration (absolute) of node; Directed along the local yb-axis +ElastoDyn_Nodes['ALz'] = False # (m/s^2); local flapwise acceleration (absolute) of node; Directed along the local zb-axis +ElastoDyn_Nodes['Az'] = False # (m/s^2); local flapwise acceleration (absolute) of node; Directed along the local zb-axis +ElastoDyn_Nodes['TDx'] = False # (m); local flapwise (translational) deflection (relative to the undeflected position) of node; Directed along the xb-axis +ElastoDyn_Nodes['UxB'] = False # (m); local flapwise (translational) deflection (relative to the undeflected position) of node; Directed along the xb-axis +ElastoDyn_Nodes['TDy'] = False # (m); local edgewise (translational) deflection (relative to the undeflected position) of node; Directed along the yb-axis +ElastoDyn_Nodes['UyB'] = False # (m); local edgewise (translational) deflection (relative to the undeflected position) of node; Directed along the yb-axis +ElastoDyn_Nodes['TDz'] = False # (m); local axial (translational) deflection (relative to the undeflected position) of node; Directed along the zb-axis +ElastoDyn_Nodes['UzB'] = False # (m); local axial (translational) deflection (relative to the undeflected position) of node; Directed along the zb-axis +ElastoDyn_Nodes['RDx'] = False # (deg); Local rotational displacement about x-axis (relative to undeflected); About the local xb-axis +ElastoDyn_Nodes['Rx'] = False # (deg); Local rotational displacement about x-axis (relative to undeflected); About the local xb-axis +ElastoDyn_Nodes['RDy'] = False # (deg); Local rotational displacement about y-axis (relative to undeflected); About the local yb-axis +ElastoDyn_Nodes['Ry'] = False # (deg); Local rotational displacement about y-axis (relative to undeflected); About the local yb-axis +ElastoDyn_Nodes['RDz'] = False # (deg); Local rotational displacement about z-axis (relative to undeflected); About the local zb-axis +ElastoDyn_Nodes['Rz'] = False # (deg); Local rotational displacement about z-axis (relative to undeflected); About the local zb-axis +# Local Span Loads +ElastoDyn_Nodes['MLx'] = False # (kN-m); local edgewise moment at node; About the local xb-axis +ElastoDyn_Nodes['Mx'] = False # (kN-m); local edgewise moment at node; About the local xb-axis +ElastoDyn_Nodes['MLy'] = False # (kN-m); local flapwise moment at node; About the local yb-axis +ElastoDyn_Nodes['My'] = False # (kN-m); local flapwise moment at node; About the local yb-axis +ElastoDyn_Nodes['MLz'] = False # (kN-m); local pitching moment at node; About the local zb-axis +ElastoDyn_Nodes['MLzNT'] = False # (kN-m); local pitching moment at node; About the local zb-axis +ElastoDyn_Nodes['MzL'] = False # (kN-m); local pitching moment at node; About the local zb-axis +ElastoDyn_Nodes['Mz'] = False # (kN-m); local pitching moment at node; About the local zb-axis +ElastoDyn_Nodes['FLx'] = False # (kN); local flapwise shear force at node; Directed along the local xb-axis +ElastoDyn_Nodes['Fx'] = False # (kN); local flapwise shear force at node; Directed along the local xb-axis +ElastoDyn_Nodes['FLy'] = False # (kN); local edgewise shear force at node; Directed along the local yb-axis +ElastoDyn_Nodes['Fy'] = False # (kN); local edgewise shear force at node; Directed along the local yb-axis +ElastoDyn_Nodes['FLz'] = False # (kN); local axial force at node; Directed along the local zb-axis +ElastoDyn_Nodes['FLzNT'] = False # (kN); local axial force at node; Directed along the local zb-axis +ElastoDyn_Nodes['FzL'] = False # (kN); local axial force at node; Directed along the local zb-axis +ElastoDyn_Nodes['Fz'] = False # (kN); local axial force at node; Directed along the local zb-axis +ElastoDyn_Nodes['MLxNT'] = False # (kN-m); Edgewise moment in local coordinate system (initial structural twist removed); About the local xb-axis +ElastoDyn_Nodes['MxL'] = False # (kN-m); Edgewise moment in local coordinate system (initial structural twist removed); About the local xb-axis +ElastoDyn_Nodes['MlyNT'] = False # (kN-m); Flapwise shear moment in local coordinate system (initial structural twist removed); About the local yb-axis +ElastoDyn_Nodes['MyL'] = False # (kN-m); Flapwise shear moment in local coordinate system (initial structural twist removed); About the local yb-axis +ElastoDyn_Nodes['FLxNT'] = False # (kN); Flapwise shear force in local coordinate system (initial structural twist removed); Directed along the local xb-axis +ElastoDyn_Nodes['FxL'] = False # (kN); Flapwise shear force in local coordinate system (initial structural twist removed); Directed along the local xb-axis +ElastoDyn_Nodes['FlyNT'] = False # (kN); Edgewise shear force in local coordinate system (initial structural twist removed); Directed along the local yb-axis +ElastoDyn_Nodes['FyL'] = False # (kN); Edgewise shear force in local coordinate system (initial structural twist removed); Directed along the local yb-axis -""" OutList """ -OutList = {} +""" MoorDyn """ +# THIS IS NOT A COMPLETE LIST! +# the "flexible naming system" discussed on page 7-8 of the documentation is not included +# http://www.matt-hall.ca/files/MoorDyn-Users-Guide-2017-08-16.pdf -# Wind Motions -OutList['WindVxi'] = False # (m/s); Nominally downwind component of the hub-height wind velocity; Directed along the xi-axis -OutList['uWind'] = False # (m/s); Nominally downwind component of the hub-height wind velocity; Directed along the xi-axis -OutList['WindVyi'] = False # (m/s); Cross-wind component of the hub-height wind velocity; Directed along the yi-axis -OutList['vWind'] = False # (m/s); Cross-wind component of the hub-height wind velocity; Directed along the yi-axis -OutList['WindVzi'] = False # (m/s); Vertical component of the hub-height wind velocity; Directed along the zi-axis -OutList['wWind'] = False # (m/s); Vertical component of the hub-height wind velocity; Directed along the zi-axis -OutList['TotWindV'] = False # (m/s); Total hub-height wind velocity magnitude; N/A -OutList['HorWindV'] = False # (m/s); Horizontal hub-height wind velocity magnitude; In the xi- and yi-plane -OutList['HorWndDir'] = False # (deg); Horizontal hub-height wind direction. Please note that FAST uses the opposite sign convention that AeroDyn uses. Put a "-", "_", "m", or "M" character in front of this variable name if you want to use the AeroDyn convention.; About the zi-axis -OutList['VerWndDir'] = False # (deg); Vertical hub-height wind direction; About an axis orthogonal to the zi-axis and the HorWindV-vector +# also assuming that like other OpenFAST variables, it is limited to 9 output locations per veriable, i.e. FairTen1-FairTen9 +# TODO: Handle the flexible outputs for moordyn. This will require a different approach than the current dictionary structure. -# Blade 1 Tip Motions -OutList['TipDxc1'] = True # (m); Blade 1 out-of-plane tip deflection (relative to the undeflected position); Directed along the xc1-axis -OutList['OoPDefl1'] = False # (m); Blade 1 out-of-plane tip deflection (relative to the undeflected position); Directed along the xc1-axis -OutList['TipDyc1'] = True # (m); Blade 1 in-plane tip deflection (relative to the undeflected position); Directed along the yc1-axis -OutList['IPDefl1'] = False # (m); Blade 1 in-plane tip deflection (relative to the undeflected position); Directed along the yc1-axis -OutList['TipDzc1'] = True # (m); Blade 1 axial tip deflection (relative to the undeflected position); Directed along the zc1- and zb1-axes -OutList['TipDzb1'] = True # (m); Blade 1 axial tip deflection (relative to the undeflected position); Directed along the zc1- and zb1-axes -OutList['TipDxb1'] = True # (m); Blade 1 flapwise tip deflection (relative to the undeflected position); Directed along the xb1-axis -OutList['TipDyb1'] = True # (m); Blade 1 edgewise tip deflection (relative to the undeflected position); Directed along the yb1-axis -OutList['TipALxb1'] = False # (m/s^2); Blade 1 local flapwise tip acceleration (absolute); Directed along the local xb1-axis -OutList['TipALyb1'] = False # (m/s^2); Blade 1 local edgewise tip acceleration (absolute); Directed along the local yb1-axis -OutList['TipALzb1'] = False # (m/s^2); Blade 1 local axial tip acceleration (absolute); Directed along the local zb1-axis -OutList['TipRDxb1'] = False # (deg); Blade 1 roll (angular/rotational) tip deflection (relative to the undeflected position). In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the xb1-axis -OutList['RollDefl1'] = False # (deg); Blade 1 roll (angular/rotational) tip deflection (relative to the undeflected position). In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the xb1-axis -OutList['TipRDyb1'] = False # (deg); Blade 1 pitch (angular/rotational) tip deflection (relative to the undeflected position). In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the yb1-axis -OutList['PtchDefl1'] = False # (deg); Blade 1 pitch (angular/rotational) tip deflection (relative to the undeflected position). In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the yb1-axis -OutList['TipRDzc1'] = False # (deg); Blade 1 torsional tip deflection (relative to the undeflected position). This output will always be zero for FAST simulation results. Use it for examining blade torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. Please note that this output uses the opposite of the sign convention used for blade pitch angles.; About the zc1- and zb1-axes -OutList['TipRDzb1'] = False # (deg); Blade 1 torsional tip deflection (relative to the undeflected position). This output will always be zero for FAST simulation results. Use it for examining blade torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. Please note that this output uses the opposite of the sign convention used for blade pitch angles.; About the zc1- and zb1-axes -OutList['TwstDefl1'] = False # (deg); Blade 1 torsional tip deflection (relative to the undeflected position). This output will always be zero for FAST simulation results. Use it for examining blade torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. Please note that this output uses the opposite of the sign convention used for blade pitch angles.; About the zc1- and zb1-axes -OutList['TipClrnc1'] = False # (m); Blade 1 tip-to-tower clearance estimate. This is computed as the perpendicular distance from the yaw axis to the tip of blade 1 when the blade tip is below the yaw bearing. When the tip of blade 1 is above the yaw bearing, it is computed as the absolute distance from the yaw bearing to the blade tip. Please note that you should reduce this value by the tower radius to obtain the actual tower clearance.; N/A -OutList['TwrClrnc1'] = False # (m); Blade 1 tip-to-tower clearance estimate. This is computed as the perpendicular distance from the yaw axis to the tip of blade 1 when the blade tip is below the yaw bearing. When the tip of blade 1 is above the yaw bearing, it is computed as the absolute distance from the yaw bearing to the blade tip. Please note that you should reduce this value by the tower radius to obtain the actual tower clearance.; N/A -OutList['Tip2Twr1'] = False # (m); Blade 1 tip-to-tower clearance estimate. This is computed as the perpendicular distance from the yaw axis to the tip of blade 1 when the blade tip is below the yaw bearing. When the tip of blade 1 is above the yaw bearing, it is computed as the absolute distance from the yaw bearing to the blade tip. Please note that you should reduce this value by the tower radius to obtain the actual tower clearance.; N/A +MoorDyn = {} +MoorDyn['FairTen1'] = False # (); ; +MoorDyn['FairTen2'] = False # (); ; +MoorDyn['FairTen3'] = False # (); ; +MoorDyn['FairTen4'] = False # (); ; +MoorDyn['FairTen5'] = False # (); ; +MoorDyn['FairTen6'] = False # (); ; +MoorDyn['FairTen7'] = False # (); ; +MoorDyn['FairTen8'] = False # (); ; +MoorDyn['FairTen9'] = False # (); ; +MoorDyn['AnchTen1'] = False # (); ; +MoorDyn['AnchTen2'] = False # (); ; +MoorDyn['AnchTen3'] = False # (); ; +MoorDyn['AnchTen4'] = False # (); ; +MoorDyn['AnchTen5'] = False # (); ; +MoorDyn['AnchTen6'] = False # (); ; +MoorDyn['AnchTen7'] = False # (); ; +MoorDyn['AnchTen8'] = False # (); ; +MoorDyn['AnchTen9'] = False # (); ; -# Blade 2 Tip Motions -OutList['TipDxc2'] = True # (m); Blade 2 out-of-plane tip deflection (relative to the pitch axis); Directed along the xc2-axis -OutList['OoPDefl2'] = False # (m); Blade 2 out-of-plane tip deflection (relative to the pitch axis); Directed along the xc2-axis -OutList['TipDyc2'] = True # (m); Blade 2 in-plane tip deflection (relative to the pitch axis); Directed along the yc2-axis -OutList['IPDefl2'] = False # (m); Blade 2 in-plane tip deflection (relative to the pitch axis); Directed along the yc2-axis -OutList['TipDzc2'] = True # (m); Blade 2 axial tip deflection (relative to the pitch axis); Directed along the zc2- and zb2-axes -OutList['TipDzb2'] = True # (m); Blade 2 axial tip deflection (relative to the pitch axis); Directed along the zc2- and zb2-axes -OutList['TipDxb2'] = True # (m); Blade 2 flapwise tip deflection (relative to the pitch axis); Directed along the xb2-axis -OutList['TipDyb2'] = True # (m); Blade 2 edgewise tip deflection (relative to the pitch axis); Directed along the yb2-axis -OutList['TipALxb2'] = False # (m/s^2); Blade 2 local flapwise tip acceleration (absolute); Directed along the local xb2-axis -OutList['TipALyb2'] = False # (m/s^2); Blade 2 local edgewise tip acceleration (absolute); Directed along the local yb2-axis -OutList['TipALzb2'] = False # (m/s^2); Blade 2 local axial tip acceleration (absolute); Directed along the local zb2-axis -OutList['TipRDxb2'] = False # (deg); Blade 2 roll (angular/rotational) tip deflection (relative to the undeflected position). In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the xb2-axis -OutList['RollDefl2'] = False # (deg); Blade 2 roll (angular/rotational) tip deflection (relative to the undeflected position). In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the xb2-axis -OutList['TipRDyb2'] = False # (deg); Blade 2 pitch (angular/rotational) tip deflection (relative to the undeflected position). In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the yb2-axis -OutList['PtchDefl2'] = False # (deg); Blade 2 pitch (angular/rotational) tip deflection (relative to the undeflected position). In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the yb2-axis -OutList['TipRDzc2'] = False # (deg); Blade 2 torsional (angular/rotational) tip deflection (relative to the undeflected position). This output will always be zero for FAST simulation results. Use it for examining blade torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. Please note that this output uses the opposite of the sign convention used for blade pitch angles.; About the zc2- and zb2-axes -OutList['TipRDzb2'] = False # (deg); Blade 2 torsional (angular/rotational) tip deflection (relative to the undeflected position). This output will always be zero for FAST simulation results. Use it for examining blade torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. Please note that this output uses the opposite of the sign convention used for blade pitch angles.; About the zc2- and zb2-axes -OutList['TwstDefl2'] = False # (deg); Blade 2 torsional (angular/rotational) tip deflection (relative to the undeflected position). This output will always be zero for FAST simulation results. Use it for examining blade torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. Please note that this output uses the opposite of the sign convention used for blade pitch angles.; About the zc2- and zb2-axes -OutList['TipClrnc2'] = False # (m); Blade 2 tip-to-tower clearance estimate. This is computed as the perpendicular distance from the yaw axis to the tip of blade 1 when the blade tip is below the yaw bearing. When the tip of blade 1 is above the yaw bearing, it is computed as the absolute distance from the yaw bearing to the blade tip. Please note that you should reduce this value by the tower radius to obtain the actual tower clearance.; N/A -OutList['TwrClrnc2'] = False # (m); Blade 2 tip-to-tower clearance estimate. This is computed as the perpendicular distance from the yaw axis to the tip of blade 1 when the blade tip is below the yaw bearing. When the tip of blade 1 is above the yaw bearing, it is computed as the absolute distance from the yaw bearing to the blade tip. Please note that you should reduce this value by the tower radius to obtain the actual tower clearance.; N/A -OutList['Tip2Twr2'] = False # (m); Blade 2 tip-to-tower clearance estimate. This is computed as the perpendicular distance from the yaw axis to the tip of blade 1 when the blade tip is below the yaw bearing. When the tip of blade 1 is above the yaw bearing, it is computed as the absolute distance from the yaw bearing to the blade tip. Please note that you should reduce this value by the tower radius to obtain the actual tower clearance.; N/A -# Blade 3 Tip Motions -OutList['TipDxc3'] = True # (m); Blade 3 out-of-plane tip deflection (relative to the pitch axis); Directed along the xc3-axis -OutList['OoPDefl3'] = False # (m); Blade 3 out-of-plane tip deflection (relative to the pitch axis); Directed along the xc3-axis -OutList['TipDyc3'] = True # (m); Blade 3 in-plane tip deflection (relative to the pitch axis); Directed along the yc3-axis -OutList['IPDefl3'] = False # (m); Blade 3 in-plane tip deflection (relative to the pitch axis); Directed along the yc3-axis -OutList['TipDzc3'] = True # (m); Blade 3 axial tip deflection (relative to the pitch axis); Directed along the zc3- and zb3-axes -OutList['TipDzb3'] = True # (m); Blade 3 axial tip deflection (relative to the pitch axis); Directed along the zc3- and zb3-axes -OutList['TipDxb3'] = True # (m); Blade 3 flapwise tip deflection (relative to the pitch axis); Directed along the xb3-axis -OutList['TipDyb3'] = True # (m); Blade 3 edgewise tip deflection (relative to the pitch axis); Directed along the yb3-axis -OutList['TipALxb3'] = False # (m/s^2); Blade 3 local flapwise tip acceleration (absolute); Directed along the local xb3-axis -OutList['TipALyb3'] = False # (m/s^2); Blade 3 local edgewise tip acceleration (absolute); Directed along the local yb3-axis -OutList['TipALzb3'] = False # (m/s^2); Blade 3 local axial tip acceleration (absolute); Directed along the local zb3-axis -OutList['TipRDxb3'] = False # (deg); Blade 3 roll (angular/rotational) tip deflection (relative to the undeflected position). In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the xb3-axis -OutList['RollDefl3'] = False # (deg); Blade 3 roll (angular/rotational) tip deflection (relative to the undeflected position). In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the xb3-axis -OutList['TipRDyb3'] = False # (deg); Blade 3 pitch (angular/rotational) tip deflection (relative to the undeflected position). In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the yb3-axis -OutList['PtchDefl3'] = False # (deg); Blade 3 pitch (angular/rotational) tip deflection (relative to the undeflected position). In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the yb3-axis -OutList['TipRDzc3'] = False # (deg); Blade 3 torsional tip deflection (relative to the undeflected position). This output will always be zero for FAST simulation results. Use it for examining blade torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. Please note that this output uses the opposite of the sign convention used for blade pitch angles.; About the zc3- and zb3-axes -OutList['TipRDzb3'] = False # (deg); Blade 3 torsional tip deflection (relative to the undeflected position). This output will always be zero for FAST simulation results. Use it for examining blade torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. Please note that this output uses the opposite of the sign convention used for blade pitch angles.; About the zc3- and zb3-axes -OutList['TwstDefl3'] = False # (deg); Blade 3 torsional tip deflection (relative to the undeflected position). This output will always be zero for FAST simulation results. Use it for examining blade torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. Please note that this output uses the opposite of the sign convention used for blade pitch angles.; About the zc3- and zb3-axes -OutList['TipClrnc3'] = False # (m); Blade 3 tip-to-tower clearance estimate. This is computed as the perpendicular distance from the yaw axis to the tip of blade 1 when the blade tip is below the yaw bearing. When the tip of blade 1 is above the yaw bearing, it is computed as the absolute distance from the yaw bearing to the blade tip. Please note that you should reduce this value by the tower radius to obtain the actual tower clearance.; N/A -OutList['TwrClrnc3'] = False # (m); Blade 3 tip-to-tower clearance estimate. This is computed as the perpendicular distance from the yaw axis to the tip of blade 1 when the blade tip is below the yaw bearing. When the tip of blade 1 is above the yaw bearing, it is computed as the absolute distance from the yaw bearing to the blade tip. Please note that you should reduce this value by the tower radius to obtain the actual tower clearance.; N/A -OutList['Tip2Twr3'] = False # (m); Blade 3 tip-to-tower clearance estimate. This is computed as the perpendicular distance from the yaw axis to the tip of blade 1 when the blade tip is below the yaw bearing. When the tip of blade 1 is above the yaw bearing, it is computed as the absolute distance from the yaw bearing to the blade tip. Please note that you should reduce this value by the tower radius to obtain the actual tower clearance.; N/A -# Blade 1 Local Span Motions -OutList['Spn1ALxb1'] = False # (m/s^2); Blade 1 local flapwise acceleration (absolute) of span station 1; Directed along the local xb1-axis -OutList['Spn1ALyb1'] = False # (m/s^2); Blade 1 local edgewise acceleration (absolute) of span station 1; Directed along the local yb1-axis -OutList['Spn1ALzb1'] = False # (m/s^2); Blade 1 local axial acceleration (absolute) of span station 1; Directed along the local zb1-axis -OutList['Spn2ALxb1'] = False # (m/s^2); Blade 1 local flapwise acceleration (absolute) of span station 2; Directed along the local xb1-axis -OutList['Spn2ALyb1'] = False # (m/s^2); Blade 1 local edgewise acceleration (absolute) of span station 2; Directed along the local yb1-axis -OutList['Spn2ALzb1'] = False # (m/s^2); Blade 1 local axial acceleration (absolute) of span station 2; Directed along the local zb1-axis -OutList['Spn3ALxb1'] = False # (m/s^2); Blade 1 local flapwise acceleration (absolute) of span station 3; Directed along the local xb1-axis -OutList['Spn3ALyb1'] = False # (m/s^2); Blade 1 local edgewise acceleration (absolute) of span station 3; Directed along the local yb1-axis -OutList['Spn3ALzb1'] = False # (m/s^2); Blade 1 local axial acceleration (absolute) of span station 3; Directed along the local zb1-axis -OutList['Spn4ALxb1'] = False # (m/s^2); Blade 1 local flapwise acceleration (absolute) of span station 4; Directed along the local xb1-axis -OutList['Spn4ALyb1'] = False # (m/s^2); Blade 1 local edgewise acceleration (absolute) of span station 4; Directed along the local yb1-axis -OutList['Spn4ALzb1'] = False # (m/s^2); Blade 1 local axial acceleration (absolute) of span station 4; Directed along the local zb1-axis -OutList['Spn5ALxb1'] = False # (m/s^2); Blade 1 local flapwise acceleration (absolute) of span station 5; Directed along the local xb1-axis -OutList['Spn5ALyb1'] = False # (m/s^2); Blade 1 local edgewise acceleration (absolute) of span station 5; Directed along the local yb1-axis -OutList['Spn5ALzb1'] = False # (m/s^2); Blade 1 local axial acceleration (absolute) of span station 5; Directed along the local zb1-axis -OutList['Spn6ALxb1'] = False # (m/s^2); Blade 1 local flapwise acceleration (absolute) of span station 6; Directed along the local xb1-axis -OutList['Spn6ALyb1'] = False # (m/s^2); Blade 1 local edgewise acceleration (absolute) of span station 6; Directed along the local yb1-axis -OutList['Spn6ALzb1'] = False # (m/s^2); Blade 1 local axial acceleration (absolute) of span station 6; Directed along the local zb1-axis -OutList['Spn7ALxb1'] = False # (m/s^2); Blade 1 local flapwise acceleration (absolute) of span station 7; Directed along the local xb1-axis -OutList['Spn7ALyb1'] = False # (m/s^2); Blade 1 local edgewise acceleration (absolute) of span station 7; Directed along the local yb1-axis -OutList['Spn7ALzb1'] = False # (m/s^2); Blade 1 local axial acceleration (absolute) of span station 7; Directed along the local zb1-axis -OutList['Spn8ALxb1'] = False # (m/s^2); Blade 1 local flapwise acceleration (absolute) of span station 8; Directed along the local xb1-axis -OutList['Spn8ALyb1'] = False # (m/s^2); Blade 1 local edgewise acceleration (absolute) of span station 8; Directed along the local yb1-axis -OutList['Spn8ALzb1'] = False # (m/s^2); Blade 1 local axial acceleration (absolute) of span station 8; Directed along the local zb1-axis -OutList['Spn9ALxb1'] = False # (m/s^2); Blade 1 local flapwise acceleration (absolute) of span station 9; Directed along the local xb1-axis -OutList['Spn9ALyb1'] = False # (m/s^2); Blade 1 local edgewise acceleration (absolute) of span station 9; Directed along the local yb1-axis -OutList['Spn9ALzb1'] = False # (m/s^2); Blade 1 local axial acceleration (absolute) of span station 9; Directed along the local zb1-axis -OutList['Spn1TDxb1'] = False # (m); Blade 1 local flapwise (translational) deflection (relative to the undeflected position) of span station 1; Directed along the xb1-axis -OutList['Spn1TDyb1'] = False # (m); Blade 1 local edgewise (translational) deflection (relative to the undeflected position) of span station 1; Directed along the yb1-axis -OutList['Spn1TDzb1'] = False # (m); Blade 1 local axial (translational) deflection (relative to the undeflected position) of span station 1; Directed along the zb1-axis -OutList['Spn2TDxb1'] = False # (m); Blade 1 local flapwise (translational) deflection (relative to the undeflected position) of span station 2; Directed along the xb1-axis -OutList['Spn2TDyb1'] = False # (m); Blade 1 local edgewise (translational) deflection (relative to the undeflected position) of span station 2; Directed along the yb1-axis -OutList['Spn2TDzb1'] = False # (m); Blade 1 local axial (translational) deflection (relative to the undeflected position) of span station 2; Directed along the zb1-axis -OutList['Spn3TDxb1'] = False # (m); Blade 1 local flapwise (translational) deflection (relative to the undeflected position) of span station 3; Directed along the xb1-axis -OutList['Spn3TDyb1'] = False # (m); Blade 1 local edgewise (translational) deflection (relative to the undeflected position) of span station 3; Directed along the yb1-axis -OutList['Spn3TDzb1'] = False # (m); Blade 1 local axial (translational) deflection (relative to the undeflected position) of span station 3; Directed along the zb1-axis -OutList['Spn4TDxb1'] = False # (m); Blade 1 local flapwise (translational) deflection (relative to the undeflected position) of span station 4; Directed along the xb1-axis -OutList['Spn4TDyb1'] = False # (m); Blade 1 local edgewise (translational) deflection (relative to the undeflected position) of span station 4; Directed along the yb1-axis -OutList['Spn4TDzb1'] = False # (m); Blade 1 local axial (translational) deflection (relative to the undeflected position) of span station 4; Directed along the zb1-axis -OutList['Spn5TDxb1'] = False # (m); Blade 1 local flapwise (translational) deflection (relative to the undeflected position) of span station 5; Directed along the xb1-axis -OutList['Spn5TDyb1'] = False # (m); Blade 1 local edgewise (translational) deflection (relative to the undeflected position) of span station 5; Directed along the yb1-axis -OutList['Spn5TDzb1'] = False # (m); Blade 1 local axial (translational) deflection (relative to the undeflected position) of span station 5; Directed along the zb1-axis -OutList['Spn6TDxb1'] = False # (m); Blade 1 local flapwise (translational) deflection (relative to the undeflected position) of span station 6; Directed along the xb1-axis -OutList['Spn6TDyb1'] = False # (m); Blade 1 local edgewise (translational) deflection (relative to the undeflected position) of span station 6; Directed along the yb1-axis -OutList['Spn6TDzb1'] = False # (m); Blade 1 local axial (translational) deflection (relative to the undeflected position) of span station 6; Directed along the zb1-axis -OutList['Spn7TDxb1'] = False # (m); Blade 1 local flapwise (translational) deflection (relative to the undeflected position) of span station 7; Directed along the xb1-axis -OutList['Spn7TDyb1'] = False # (m); Blade 1 local edgewise (translational) deflection (relative to the undeflected position) of span station 7; Directed along the yb1-axis -OutList['Spn7TDzb1'] = False # (m); Blade 1 local axial (translational) deflection (relative to the undeflected position) of span station 7; Directed along the zb1-axis -OutList['Spn8TDxb1'] = False # (m); Blade 1 local flapwise (translational) deflection (relative to the undeflected position) of span station 8; Directed along the xb1-axis -OutList['Spn8TDyb1'] = False # (m); Blade 1 local edgewise (translational) deflection (relative to the undeflected position) of span station 8; Directed along the yb1-axis -OutList['Spn8TDzb1'] = False # (m); Blade 1 local axial (translational) deflection (relative to the undeflected position) of span station 8; Directed along the zb1-axis -OutList['Spn9TDxb1'] = False # (m); Blade 1 local flapwise (translational) deflection (relative to the undeflected position) of span station 9; Directed along the xb1-axis -OutList['Spn9TDyb1'] = False # (m); Blade 1 local edgewise (translational) deflection (relative to the undeflected position) of span station 9; Directed along the yb1-axis -OutList['Spn9TDzb1'] = False # (m); Blade 1 local axial (translational) deflection (relative to the undeflected position) of span station 9; Directed along the zb1-axis -OutList['Spn1RDxb1'] = False # (deg); Blade 1 local roll (angular/rotational) deflection (relative to the undeflected position) of span station 1. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local xb1-axis -OutList['Spn1RDyb1'] = False # (deg); Blade 1 local pitch (angular/rotational) deflection (relative to the undeflected position) of span station 1. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local yb1-axis -OutList['Spn1RDzb1'] = False # (deg); Blade 1 local torsional (angular/rotational) deflection (relative to the undeflected position) of span station 1. This output will always be zero for FAST simulation results. Use it for examining blade torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. Please note that this output uses the opposite of the sign convention used for blade pitch angles.; About the local zb1-axis -OutList['Spn2RDxb1'] = False # (deg); Blade 1 local roll (angular/rotational) deflection (relative to the undeflected position) of span station 2. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local xb1-axis -OutList['Spn2RDyb1'] = False # (deg); Blade 1 local pitch (angular/rotational) deflection (relative to the undeflected position) of span station 2. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local yb1-axis -OutList['Spn2RDzb1'] = False # (deg); Blade 1 local torsional (angular/rotational) deflection (relative to the undeflected position) of span station 2. This output will always be zero for FAST simulation results. Use it for examining blade torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. Please note that this output uses the opposite of the sign convention used for blade pitch angles.; About the local zb1-axis -OutList['Spn3RDxb1'] = False # (deg); Blade 1 local roll (angular/rotational) deflection (relative to the undeflected position) of span station 3. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local xb1-axis -OutList['Spn3RDyb1'] = False # (deg); Blade 1 local pitch (angular/rotational) deflection (relative to the undeflected position) of span station 3. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local yb1-axis -OutList['Spn3RDzb1'] = False # (deg); Blade 1 local torsional (angular/rotational) deflection (relative to the undeflected position) of span station 3. This output will always be zero for FAST simulation results. Use it for examining blade torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. Please note that this output uses the opposite of the sign convention used for blade pitch angles.; About the local zb1-axis -OutList['Spn4RDxb1'] = False # (deg); Blade 1 local roll (angular/rotational) deflection (relative to the undeflected position) of span station 4. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local xb1-axis -OutList['Spn4RDyb1'] = False # (deg); Blade 1 local pitch (angular/rotational) deflection (relative to the undeflected position) of span station 4. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local yb1-axis -OutList['Spn4RDzb1'] = False # (deg); Blade 1 local torsional (angular/rotational) deflection (relative to the undeflected position) of span station 4. This output will always be zero for FAST simulation results. Use it for examining blade torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. Please note that this output uses the opposite of the sign convention used for blade pitch angles.; About the local zb1-axis -OutList['Spn5RDxb1'] = False # (deg); Blade 1 local roll (angular/rotational) deflection (relative to the undeflected position) of span station 5. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local xb1-axis -OutList['Spn5RDyb1'] = False # (deg); Blade 1 local pitch (angular/rotational) deflection (relative to the undeflected position) of span station 5. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local yb1-axis -OutList['Spn5RDzb1'] = False # (deg); Blade 1 local torsional (angular/rotational) deflection (relative to the undeflected position) of span station 5. This output will always be zero for FAST simulation results. Use it for examining blade torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. Please note that this output uses the opposite of the sign convention used for blade pitch angles.; About the local zb1-axis -OutList['Spn6RDxb1'] = False # (deg); Blade 1 local roll (angular/rotational) deflection (relative to the undeflected position) of span station 6. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local xb1-axis -OutList['Spn6RDyb1'] = False # (deg); Blade 1 local pitch (angular/rotational) deflection (relative to the undeflected position) of span station 6. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local yb1-axis -OutList['Spn6RDzb1'] = False # (deg); Blade 1 local torsional (angular/rotational) deflection (relative to the undeflected position) of span station 6. This output will always be zero for FAST simulation results. Use it for examining blade torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. Please note that this output uses the opposite of the sign convention used for blade pitch angles.; About the local zb1-axis -OutList['Spn7RDxb1'] = False # (deg); Blade 1 local roll (angular/rotational) deflection (relative to the undeflected position) of span station 7. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local xb1-axis -OutList['Spn7RDyb1'] = False # (deg); Blade 1 local pitch (angular/rotational) deflection (relative to the undeflected position) of span station 7. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local yb1-axis -OutList['Spn7RDzb1'] = False # (deg); Blade 1 local torsional (angular/rotational) deflection (relative to the undeflected position) of span station 7. This output will always be zero for FAST simulation results. Use it for examining blade torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. Please note that this output uses the opposite of the sign convention used for blade pitch angles.; About the local zb1-axis -OutList['Spn8RDxb1'] = False # (deg); Blade 1 local roll (angular/rotational) deflection (relative to the undeflected position) of span station 8. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local xb1-axis -OutList['Spn8RDyb1'] = False # (deg); Blade 1 local pitch (angular/rotational) deflection (relative to the undeflected position) of span station 8. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local yb1-axis -OutList['Spn8RDzb1'] = False # (deg); Blade 1 local torsional (angular/rotational) deflection (relative to the undeflected position) of span station 8. This output will always be zero for FAST simulation results. Use it for examining blade torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. Please note that this output uses the opposite of the sign convention used for blade pitch angles.; About the local zb1-axis -OutList['Spn9RDxb1'] = False # (deg); Blade 1 local roll (angular/rotational) deflection (relative to the undeflected position) of span station 9. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local xb1-axis -OutList['Spn9RDyb1'] = False # (deg); Blade 1 local pitch (angular/rotational) deflection (relative to the undeflected position) of span station 9. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local yb1-axis -OutList['Spn9RDzb1'] = False # (deg); Blade 1 local torsional (angular/rotational) deflection (relative to the undeflected position) of span station 9. This output will always be zero for FAST simulation results. Use it for examining blade torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. Please note that this output uses the opposite of the sign convention used for blade pitch angles.; About the local zb1-axis -# Blade 2 Local Span Motions -OutList['Spn1ALxb2'] = False # (m/s^2); Blade 2 local flapwise acceleration (absolute) of span station 1; Directed along the local xb2-axis -OutList['Spn1ALyb2'] = False # (m/s^2); Blade 2 local edgewise acceleration (absolute) of span station 1; Directed along the local yb2-axis -OutList['Spn1ALzb2'] = False # (m/s^2); Blade 2 local axial acceleration (absolute) of span station 1; Directed along the local zb2-axis -OutList['Spn2ALxb2'] = False # (m/s^2); Blade 2 local flapwise acceleration (absolute) of span station 2; Directed along the local xb2-axis -OutList['Spn2ALyb2'] = False # (m/s^2); Blade 2 local edgewise acceleration (absolute) of span station 2; Directed along the local yb2-axis -OutList['Spn2ALzb2'] = False # (m/s^2); Blade 2 local axial acceleration (absolute) of span station 2; Directed along the local zb2-axis -OutList['Spn3ALxb2'] = False # (m/s^2); Blade 2 local flapwise acceleration (absolute) of span station 3; Directed along the local xb2-axis -OutList['Spn3ALyb2'] = False # (m/s^2); Blade 2 local edgewise acceleration (absolute) of span station 3; Directed along the local yb2-axis -OutList['Spn3ALzb2'] = False # (m/s^2); Blade 2 local axial acceleration (absolute) of span station 3; Directed along the local zb2-axis -OutList['Spn4ALxb2'] = False # (m/s^2); Blade 2 local flapwise acceleration (absolute) of span station 4; Directed along the local xb2-axis -OutList['Spn4ALyb2'] = False # (m/s^2); Blade 2 local edgewise acceleration (absolute) of span station 4; Directed along the local yb2-axis -OutList['Spn4ALzb2'] = False # (m/s^2); Blade 2 local axial acceleration (absolute) of span station 4; Directed along the local zb2-axis -OutList['Spn5ALxb2'] = False # (m/s^2); Blade 2 local flapwise acceleration (absolute) of span station 5; Directed along the local xb2-axis -OutList['Spn5ALyb2'] = False # (m/s^2); Blade 2 local edgewise acceleration (absolute) of span station 5; Directed along the local yb2-axis -OutList['Spn5ALzb2'] = False # (m/s^2); Blade 2 local axial acceleration (absolute) of span station 5; Directed along the local zb2-axis -OutList['Spn6ALxb2'] = False # (m/s^2); Blade 2 local flapwise acceleration (absolute) of span station 6; Directed along the local xb2-axis -OutList['Spn6ALyb2'] = False # (m/s^2); Blade 2 local edgewise acceleration (absolute) of span station 6; Directed along the local yb2-axis -OutList['Spn6ALzb2'] = False # (m/s^2); Blade 2 local axial acceleration (absolute) of span station 6; Directed along the local zb2-axis -OutList['Spn7ALxb2'] = False # (m/s^2); Blade 2 local flapwise acceleration (absolute) of span station 7; Directed along the local xb2-axis -OutList['Spn7ALyb2'] = False # (m/s^2); Blade 2 local edgewise acceleration (absolute) of span station 7; Directed along the local yb2-axis -OutList['Spn7ALzb2'] = False # (m/s^2); Blade 2 local axial acceleration (absolute) of span station 7; Directed along the local zb2-axis -OutList['Spn8ALxb2'] = False # (m/s^2); Blade 2 local flapwise acceleration (absolute) of span station 8; Directed along the local xb2-axis -OutList['Spn8ALyb2'] = False # (m/s^2); Blade 2 local edgewise acceleration (absolute) of span station 8; Directed along the local yb2-axis -OutList['Spn8ALzb2'] = False # (m/s^2); Blade 2 local axial acceleration (absolute) of span station 8; Directed along the local zb2-axis -OutList['Spn9ALxb2'] = False # (m/s^2); Blade 2 local flapwise acceleration (absolute) of span station 9; Directed along the local xb2-axis -OutList['Spn9ALyb2'] = False # (m/s^2); Blade 2 local edgewise acceleration (absolute) of span station 9; Directed along the local yb2-axis -OutList['Spn9ALzb2'] = False # (m/s^2); Blade 2 local axial acceleration (absolute) of span station 9; Directed along the local zb2-axis -OutList['Spn1TDxb2'] = False # (m); Blade 2 local flapwise (translational) deflection (relative to the undeflected position) of span station 1; Directed along the xb2-axis -OutList['Spn1TDyb2'] = False # (m); Blade 2 local edgewise (translational) deflection (relative to the undeflected position) of span station 1; Directed along the yb2-axis -OutList['Spn1TDzb2'] = False # (m); Blade 2 local axial (translational) deflection (relative to the undeflected position) of span station 1; Directed along the zb2-axis -OutList['Spn2TDxb2'] = False # (m); Blade 2 local flapwise (translational) deflection (relative to the undeflected position) of span station 2; Directed along the xb2-axis -OutList['Spn2TDyb2'] = False # (m); Blade 2 local edgewise (translational) deflection (relative to the undeflected position) of span station 2; Directed along the yb2-axis -OutList['Spn2TDzb2'] = False # (m); Blade 2 local axial (translational) deflection (relative to the undeflected position) of span station 2; Directed along the zb2-axis -OutList['Spn3TDxb2'] = False # (m); Blade 2 local flapwise (translational) deflection (relative to the undeflected position) of span station 3; Directed along the xb2-axis -OutList['Spn3TDyb2'] = False # (m); Blade 2 local edgewise (translational) deflection (relative to the undeflected position) of span station 3; Directed along the yb2-axis -OutList['Spn3TDzb2'] = False # (m); Blade 2 local axial (translational) deflection (relative to the undeflected position) of span station 3; Directed along the zb2-axis -OutList['Spn4TDxb2'] = False # (m); Blade 2 local flapwise (translational) deflection (relative to the undeflected position) of span station 4; Directed along the xb2-axis -OutList['Spn4TDyb2'] = False # (m); Blade 2 local edgewise (translational) deflection (relative to the undeflected position) of span station 4; Directed along the yb2-axis -OutList['Spn4TDzb2'] = False # (m); Blade 2 local axial (translational) deflection (relative to the undeflected position) of span station 4; Directed along the zb2-axis -OutList['Spn5TDxb2'] = False # (m); Blade 2 local flapwise (translational) deflection (relative to the undeflected position) of span station 5; Directed along the xb2-axis -OutList['Spn5TDyb2'] = False # (m); Blade 2 local edgewise (translational) deflection (relative to the undeflected position) of span station 5; Directed along the yb2-axis -OutList['Spn5TDzb2'] = False # (m); Blade 2 local axial (translational) deflection (relative to the undeflected position) of span station 5; Directed along the zb2-axis -OutList['Spn6TDxb2'] = False # (m); Blade 2 local flapwise (translational) deflection (relative to the undeflected position) of span station 6; Directed along the xb2-axis -OutList['Spn6TDyb2'] = False # (m); Blade 2 local edgewise (translational) deflection (relative to the undeflected position) of span station 6; Directed along the yb2-axis -OutList['Spn6TDzb2'] = False # (m); Blade 2 local axial (translational) deflection (relative to the undeflected position) of span station 6; Directed along the zb2-axis -OutList['Spn7TDxb2'] = False # (m); Blade 2 local flapwise (translational) deflection (relative to the undeflected position) of span station 7; Directed along the xb2-axis -OutList['Spn7TDyb2'] = False # (m); Blade 2 local edgewise (translational) deflection (relative to the undeflected position) of span station 7; Directed along the yb2-axis -OutList['Spn7TDzb2'] = False # (m); Blade 2 local axial (translational) deflection (relative to the undeflected position) of span station 7; Directed along the zb2-axis -OutList['Spn8TDxb2'] = False # (m); Blade 2 local flapwise (translational) deflection (relative to the undeflected position) of span station 8; Directed along the xb2-axis -OutList['Spn8TDyb2'] = False # (m); Blade 2 local edgewise (translational) deflection (relative to the undeflected position) of span station 8; Directed along the yb2-axis -OutList['Spn8TDzb2'] = False # (m); Blade 2 local axial (translational) deflection (relative to the undeflected position) of span station 8; Directed along the zb2-axis -OutList['Spn9TDxb2'] = False # (m); Blade 2 local flapwise (translational) deflection (relative to the undeflected position) of span station 9; Directed along the xb2-axis -OutList['Spn9TDyb2'] = False # (m); Blade 2 local edgewise (translational) deflection (relative to the undeflected position) of span station 9; Directed along the yb2-axis -OutList['Spn9TDzb2'] = False # (m); Blade 2 local axial (translational) deflection (relative to the undeflected position) of span station 9; Directed along the zb2-axis -OutList['Spn1RDxb2'] = False # (deg); Blade 2 local roll (angular/rotational) deflection (relative to the undeflected position) of span station 1. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local xb2-axis -OutList['Spn1RDyb2'] = False # (deg); Blade 2 local pitch (angular/rotational) deflection (relative to the undeflected position) of span station 1. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local yb2-axis -OutList['Spn1RDzb2'] = False # (deg); Blade 2 local torsional (angular/rotational) deflection (relative to the undeflected position) of span station 1. This output will always be zero for FAST simulation results. Use it for examining blade torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. Please note that this output uses the opposite of the sign convention used for blade pitch angles.; About the local zb2-axis -OutList['Spn2RDxb2'] = False # (deg); Blade 2 local roll (angular/rotational) deflection (relative to the undeflected position) of span station 2. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local xb2-axis -OutList['Spn2RDyb2'] = False # (deg); Blade 2 local pitch (angular/rotational) deflection (relative to the undeflected position) of span station 2. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local yb2-axis -OutList['Spn2RDzb2'] = False # (deg); Blade 2 local torsional (angular/rotational) deflection (relative to the undeflected position) of span station 2. This output will always be zero for FAST simulation results. Use it for examining blade torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. Please note that this output uses the opposite of the sign convention used for blade pitch angles.; About the local zb2-axis -OutList['Spn3RDxb2'] = False # (deg); Blade 2 local roll (angular/rotational) deflection (relative to the undeflected position) of span station 3. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local xb2-axis -OutList['Spn3RDyb2'] = False # (deg); Blade 2 local pitch (angular/rotational) deflection (relative to the undeflected position) of span station 3. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local yb2-axis -OutList['Spn3RDzb2'] = False # (deg); Blade 2 local torsional (angular/rotational) deflection (relative to the undeflected position) of span station 3. This output will always be zero for FAST simulation results. Use it for examining blade torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. Please note that this output uses the opposite of the sign convention used for blade pitch angles.; About the local zb2-axis -OutList['Spn4RDxb2'] = False # (deg); Blade 2 local roll (angular/rotational) deflection (relative to the undeflected position) of span station 4. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local xb2-axis -OutList['Spn4RDyb2'] = False # (deg); Blade 2 local pitch (angular/rotational) deflection (relative to the undeflected position) of span station 4. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local yb2-axis -OutList['Spn4RDzb2'] = False # (deg); Blade 2 local torsional (angular/rotational) deflection (relative to the undeflected position) of span station 4. This output will always be zero for FAST simulation results. Use it for examining blade torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. Please note that this output uses the opposite of the sign convention used for blade pitch angles.; About the local zb2-axis -OutList['Spn5RDxb2'] = False # (deg); Blade 2 local roll (angular/rotational) deflection (relative to the undeflected position) of span station 5. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local xb2-axis -OutList['Spn5RDyb2'] = False # (deg); Blade 2 local pitch (angular/rotational) deflection (relative to the undeflected position) of span station 5. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local yb2-axis -OutList['Spn5RDzb2'] = False # (deg); Blade 2 local torsional (angular/rotational) deflection (relative to the undeflected position) of span station 5. This output will always be zero for FAST simulation results. Use it for examining blade torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. Please note that this output uses the opposite of the sign convention used for blade pitch angles.; About the local zb2-axis -OutList['Spn6RDxb2'] = False # (deg); Blade 2 local roll (angular/rotational) deflection (relative to the undeflected position) of span station 6. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local xb2-axis -OutList['Spn6RDyb2'] = False # (deg); Blade 2 local pitch (angular/rotational) deflection (relative to the undeflected position) of span station 6. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local yb2-axis -OutList['Spn6RDzb2'] = False # (deg); Blade 2 local torsional (angular/rotational) deflection (relative to the undeflected position) of span station 6. This output will always be zero for FAST simulation results. Use it for examining blade torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. Please note that this output uses the opposite of the sign convention used for blade pitch angles.; About the local zb2-axis -OutList['Spn7RDxb2'] = False # (deg); Blade 2 local roll (angular/rotational) deflection (relative to the undeflected position) of span station 7. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local xb2-axis -OutList['Spn7RDyb2'] = False # (deg); Blade 2 local pitch (angular/rotational) deflection (relative to the undeflected position) of span station 7. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local yb2-axis -OutList['Spn7RDzb2'] = False # (deg); Blade 2 local torsional (angular/rotational) deflection (relative to the undeflected position) of span station 7. This output will always be zero for FAST simulation results. Use it for examining blade torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. Please note that this output uses the opposite of the sign convention used for blade pitch angles.; About the local zb2-axis -OutList['Spn8RDxb2'] = False # (deg); Blade 2 local roll (angular/rotational) deflection (relative to the undeflected position) of span station 8. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local xb2-axis -OutList['Spn8RDyb2'] = False # (deg); Blade 2 local pitch (angular/rotational) deflection (relative to the undeflected position) of span station 8. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local yb2-axis -OutList['Spn8RDzb2'] = False # (deg); Blade 2 local torsional (angular/rotational) deflection (relative to the undeflected position) of span station 8. This output will always be zero for FAST simulation results. Use it for examining blade torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. Please note that this output uses the opposite of the sign convention used for blade pitch angles.; About the local zb2-axis -OutList['Spn9RDxb2'] = False # (deg); Blade 2 local roll (angular/rotational) deflection (relative to the undeflected position) of span station 9. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local xb2-axis -OutList['Spn9RDyb2'] = False # (deg); Blade 2 local pitch (angular/rotational) deflection (relative to the undeflected position) of span station 9. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local yb2-axis -OutList['Spn9RDzb2'] = False # (deg); Blade 2 local torsional (angular/rotational) deflection (relative to the undeflected position) of span station 9. This output will always be zero for FAST simulation results. Use it for examining blade torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. Please note that this output uses the opposite of the sign convention used for blade pitch angles.; About the local zb2-axis -# Blade 3 Local Span Motions -OutList['Spn1ALxb3'] = False # (m/s^2); Blade 3 local flapwise acceleration (absolute) of span station 1; Directed along the local xb3-axis -OutList['Spn1ALyb3'] = False # (m/s^2); Blade 3 local edgewise acceleration (absolute) of span station 1; Directed along the local yb3-axis -OutList['Spn1ALzb3'] = False # (m/s^2); Blade 3 local axial acceleration (absolute) of span station 1; Directed along the local zb3-axis -OutList['Spn2ALxb3'] = False # (m/s^2); Blade 3 local flapwise acceleration (absolute) of span station 2; Directed along the local xb3-axis -OutList['Spn2ALyb3'] = False # (m/s^2); Blade 3 local edgewise acceleration (absolute) of span station 2; Directed along the local yb3-axis -OutList['Spn2ALzb3'] = False # (m/s^2); Blade 3 local axial acceleration (absolute) of span station 2; Directed along the local zb3-axis -OutList['Spn3ALxb3'] = False # (m/s^2); Blade 3 local flapwise acceleration (absolute) of span station 3; Directed along the local xb3-axis -OutList['Spn3ALyb3'] = False # (m/s^2); Blade 3 local edgewise acceleration (absolute) of span station 3; Directed along the local yb3-axis -OutList['Spn3ALzb3'] = False # (m/s^2); Blade 3 local axial acceleration (absolute) of span station 3; Directed along the local zb3-axis -OutList['Spn4ALxb3'] = False # (m/s^2); Blade 3 local flapwise acceleration (absolute) of span station 4; Directed along the local xb3-axis -OutList['Spn4ALyb3'] = False # (m/s^2); Blade 3 local edgewise acceleration (absolute) of span station 4; Directed along the local yb3-axis -OutList['Spn4ALzb3'] = False # (m/s^2); Blade 3 local axial acceleration (absolute) of span station 4; Directed along the local zb3-axis -OutList['Spn5ALxb3'] = False # (m/s^2); Blade 3 local flapwise acceleration (absolute) of span station 5; Directed along the local xb3-axis -OutList['Spn5ALyb3'] = False # (m/s^2); Blade 3 local edgewise acceleration (absolute) of span station 5; Directed along the local yb3-axis -OutList['Spn5ALzb3'] = False # (m/s^2); Blade 3 local axial acceleration (absolute) of span station 5; Directed along the local zb3-axis -OutList['Spn6ALxb3'] = False # (m/s^2); Blade 3 local flapwise acceleration (absolute) of span station 6; Directed along the local xb3-axis -OutList['Spn6ALyb3'] = False # (m/s^2); Blade 3 local edgewise acceleration (absolute) of span station 6; Directed along the local yb3-axis -OutList['Spn6ALzb3'] = False # (m/s^2); Blade 3 local axial acceleration (absolute) of span station 6; Directed along the local zb3-axis -OutList['Spn7ALxb3'] = False # (m/s^2); Blade 3 local flapwise acceleration (absolute) of span station 7; Directed along the local xb3-axis -OutList['Spn7ALyb3'] = False # (m/s^2); Blade 3 local edgewise acceleration (absolute) of span station 7; Directed along the local yb3-axis -OutList['Spn7ALzb3'] = False # (m/s^2); Blade 3 local axial acceleration (absolute) of span station 7; Directed along the local zb3-axis -OutList['Spn8ALxb3'] = False # (m/s^2); Blade 3 local flapwise acceleration (absolute) of span station 8; Directed along the local xb3-axis -OutList['Spn8ALyb3'] = False # (m/s^2); Blade 3 local edgewise acceleration (absolute) of span station 8; Directed along the local yb3-axis -OutList['Spn8ALzb3'] = False # (m/s^2); Blade 3 local axial acceleration (absolute) of span station 8; Directed along the local zb3-axis -OutList['Spn9ALxb3'] = False # (m/s^2); Blade 3 local flapwise acceleration (absolute) of span station 9; Directed along the local xb3-axis -OutList['Spn9ALyb3'] = False # (m/s^2); Blade 3 local edgewise acceleration (absolute) of span station 9; Directed along the local yb3-axis -OutList['Spn9ALzb3'] = False # (m/s^2); Blade 3 local axial acceleration (absolute) of span station 9; Directed along the local zb3-axis -OutList['Spn1TDxb3'] = False # (m); Blade 3 local flapwise (translational) deflection (relative to the undeflected position) of span station 1; Directed along the xb3-axis -OutList['Spn1TDyb3'] = False # (m); Blade 3 local edgewise (translational) deflection (relative to the undeflected position) of span station 1; Directed along the yb3-axis -OutList['Spn1TDzb3'] = False # (m); Blade 3 local axial (translational) deflection (relative to the undeflected position) of span station 1; Directed along the zb3-axis -OutList['Spn2TDxb3'] = False # (m); Blade 3 local flapwise (translational) deflection (relative to the undeflected position) of span station 2; Directed along the xb3-axis -OutList['Spn2TDyb3'] = False # (m); Blade 3 local edgewise (translational) deflection (relative to the undeflected position) of span station 2; Directed along the yb3-axis -OutList['Spn2TDzb3'] = False # (m); Blade 3 local axial (translational) deflection (relative to the undeflected position) of span station 2; Directed along the zb3-axis -OutList['Spn3TDxb3'] = False # (m); Blade 3 local flapwise (translational) deflection (relative to the undeflected position) of span station 3; Directed along the xb3-axis -OutList['Spn3TDyb3'] = False # (m); Blade 3 local edgewise (translational) deflection (relative to the undeflected position) of span station 3; Directed along the yb3-axis -OutList['Spn3TDzb3'] = False # (m); Blade 3 local axial (translational) deflection (relative to the undeflected position) of span station 3; Directed along the zb3-axis -OutList['Spn4TDxb3'] = False # (m); Blade 3 local flapwise (translational) deflection (relative to the undeflected position) of span station 4; Directed along the xb3-axis -OutList['Spn4TDyb3'] = False # (m); Blade 3 local edgewise (translational) deflection (relative to the undeflected position) of span station 4; Directed along the yb3-axis -OutList['Spn4TDzb3'] = False # (m); Blade 3 local axial (translational) deflection (relative to the undeflected position) of span station 4; Directed along the zb3-axis -OutList['Spn5TDxb3'] = False # (m); Blade 3 local flapwise (translational) deflection (relative to the undeflected position) of span station 5; Directed along the xb3-axis -OutList['Spn5TDyb3'] = False # (m); Blade 3 local edgewise (translational) deflection (relative to the undeflected position) of span station 5; Directed along the yb3-axis -OutList['Spn5TDzb3'] = False # (m); Blade 3 local axial (translational) deflection (relative to the undeflected position) of span station 5; Directed along the zb3-axis -OutList['Spn6TDxb3'] = False # (m); Blade 3 local flapwise (translational) deflection (relative to the undeflected position) of span station 6; Directed along the xb3-axis -OutList['Spn6TDyb3'] = False # (m); Blade 3 local edgewise (translational) deflection (relative to the undeflected position) of span station 6; Directed along the yb3-axis -OutList['Spn6TDzb3'] = False # (m); Blade 3 local axial (translational) deflection (relative to the undeflected position) of span station 6; Directed along the zb3-axis -OutList['Spn7TDxb3'] = False # (m); Blade 3 local flapwise (translational) deflection (relative to the undeflected position) of span station 7; Directed along the xb3-axis -OutList['Spn7TDyb3'] = False # (m); Blade 3 local edgewise (translational) deflection (relative to the undeflected position) of span station 7; Directed along the yb3-axis -OutList['Spn7TDzb3'] = False # (m); Blade 3 local axial (translational) deflection (relative to the undeflected position) of span station 7; Directed along the zb3-axis -OutList['Spn8TDxb3'] = False # (m); Blade 3 local flapwise (translational) deflection (relative to the undeflected position) of span station 8; Directed along the xb3-axis -OutList['Spn8TDyb3'] = False # (m); Blade 3 local edgewise (translational) deflection (relative to the undeflected position) of span station 8; Directed along the yb3-axis -OutList['Spn8TDzb3'] = False # (m); Blade 3 local axial (translational) deflection (relative to the undeflected position) of span station 8; Directed along the zb3-axis -OutList['Spn9TDxb3'] = False # (m); Blade 3 local flapwise (translational) deflection (relative to the undeflected position) of span station 9; Directed along the xb3-axis -OutList['Spn9TDyb3'] = False # (m); Blade 3 local edgewise (translational) deflection (relative to the undeflected position) of span station 9; Directed along the yb3-axis -OutList['Spn9TDzb3'] = False # (m); Blade 3 local axial (translational) deflection (relative to the undeflected position) of span station 9; Directed along the zb3-axis -OutList['Spn1RDxb3'] = False # (deg); Blade 3 local roll (angular/rotational) deflection (relative to the undeflected position) of span station 1. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local xb3-axis -OutList['Spn1RDyb3'] = False # (deg); Blade 3 local pitch (angular/rotational) deflection (relative to the undeflected position) of span station 1. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local yb3-axis -OutList['Spn1RDzb3'] = False # (deg); Blade 3 local torsional (angular/rotational) deflection (relative to the undeflected position) of span station 1. This output will always be zero for FAST simulation results. Use it for examining blade torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. Please note that this output uses the opposite of the sign convention used for blade pitch angles.; About the local zb3-axis -OutList['Spn2RDxb3'] = False # (deg); Blade 3 local roll (angular/rotational) deflection (relative to the undeflected position) of span station 2. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local xb3-axis -OutList['Spn2RDyb3'] = False # (deg); Blade 3 local pitch (angular/rotational) deflection (relative to the undeflected position) of span station 2. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local yb3-axis -OutList['Spn2RDzb3'] = False # (deg); Blade 3 local torsional (angular/rotational) deflection (relative to the undeflected position) of span station 2. This output will always be zero for FAST simulation results. Use it for examining blade torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. Please note that this output uses the opposite of the sign convention used for blade pitch angles.; About the local zb3-axis -OutList['Spn3RDxb3'] = False # (deg); Blade 3 local roll (angular/rotational) deflection (relative to the undeflected position) of span station 3. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local xb3-axis -OutList['Spn3RDyb3'] = False # (deg); Blade 3 local pitch (angular/rotational) deflection (relative to the undeflected position) of span station 3. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local yb3-axis -OutList['Spn3RDzb3'] = False # (deg); Blade 3 local torsional (angular/rotational) deflection (relative to the undeflected position) of span station 3. This output will always be zero for FAST simulation results. Use it for examining blade torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. Please note that this output uses the opposite of the sign convention used for blade pitch angles.; About the local zb3-axis -OutList['Spn4RDxb3'] = False # (deg); Blade 3 local roll (angular/rotational) deflection (relative to the undeflected position) of span station 4. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local xb3-axis -OutList['Spn4RDyb3'] = False # (deg); Blade 3 local pitch (angular/rotational) deflection (relative to the undeflected position) of span station 4. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local yb3-axis -OutList['Spn4RDzb3'] = False # (deg); Blade 3 local torsional (angular/rotational) deflection (relative to the undeflected position) of span station 4. This output will always be zero for FAST simulation results. Use it for examining blade torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. Please note that this output uses the opposite of the sign convention used for blade pitch angles.; About the local zb3-axis -OutList['Spn5RDxb3'] = False # (deg); Blade 3 local roll (angular/rotational) deflection (relative to the undeflected position) of span station 5. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local xb3-axis -OutList['Spn5RDyb3'] = False # (deg); Blade 3 local pitch (angular/rotational) deflection (relative to the undeflected position) of span station 5. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local yb3-axis -OutList['Spn5RDzb3'] = False # (deg); Blade 3 local torsional (angular/rotational) deflection (relative to the undeflected position) of span station 5. This output will always be zero for FAST simulation results. Use it for examining blade torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. Please note that this output uses the opposite of the sign convention used for blade pitch angles.; About the local zb3-axis -OutList['Spn6RDxb3'] = False # (deg); Blade 3 local roll (angular/rotational) deflection (relative to the undeflected position) of span station 6. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local xb3-axis -OutList['Spn6RDyb3'] = False # (deg); Blade 3 local pitch (angular/rotational) deflection (relative to the undeflected position) of span station 6. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local yb3-axis -OutList['Spn6RDzb3'] = False # (deg); Blade 3 local torsional (angular/rotational) deflection (relative to the undeflected position) of span station 6. This output will always be zero for FAST simulation results. Use it for examining blade torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. Please note that this output uses the opposite of the sign convention used for blade pitch angles.; About the local zb3-axis -OutList['Spn7RDxb3'] = False # (deg); Blade 3 local roll (angular/rotational) deflection (relative to the undeflected position) of span station 7. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local xb3-axis -OutList['Spn7RDyb3'] = False # (deg); Blade 3 local pitch (angular/rotational) deflection (relative to the undeflected position) of span station 7. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local yb3-axis -OutList['Spn7RDzb3'] = False # (deg); Blade 3 local torsional (angular/rotational) deflection (relative to the undeflected position) of span station 7. This output will always be zero for FAST simulation results. Use it for examining blade torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. Please note that this output uses the opposite of the sign convention used for blade pitch angles.; About the local zb3-axis -OutList['Spn8RDxb3'] = False # (deg); Blade 3 local roll (angular/rotational) deflection (relative to the undeflected position) of span station 8. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local xb3-axis -OutList['Spn8RDyb3'] = False # (deg); Blade 3 local pitch (angular/rotational) deflection (relative to the undeflected position) of span station 8. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local yb3-axis -OutList['Spn8RDzb3'] = False # (deg); Blade 3 local torsional (angular/rotational) deflection (relative to the undeflected position) of span station 8. This output will always be zero for FAST simulation results. Use it for examining blade torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. Please note that this output uses the opposite of the sign convention used for blade pitch angles.; About the local zb3-axis -OutList['Spn9RDxb3'] = False # (deg); Blade 3 local roll (angular/rotational) deflection (relative to the undeflected position) of span station 9. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local xb3-axis -OutList['Spn9RDyb3'] = False # (deg); Blade 3 local pitch (angular/rotational) deflection (relative to the undeflected position) of span station 9. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small blade deflections, so that the rotation sequence does not matter.; About the local yb3-axis -OutList['Spn9RDzb3'] = False # (deg); Blade 3 local torsional (angular/rotational) deflection (relative to the undeflected position) of span station 9. This output will always be zero for FAST simulation results. Use it for examining blade torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. Please note that this output uses the opposite of the sign convention used for blade pitch angles.; About the local zb3-axis +""" ExtPtfm """ +# THIS IS NOT A COMPLETE LIST! +# Need to handle in different way based on documentaion here: https://openfast.readthedocs.io/en/main/source/user/extptfm/input_files.html#output-channels +# TODO: Handle the flexible outputs for ExtPtfm. This will require a different approach than the current dictionary structure. + +ExtPtfm = {} +ExtPtfm['IntrfFx'] = False # - Platform interface force - Directed along the x-direction (N) +ExtPtfm['IntrfFy'] = False # - Platform interface force - Directed along the y-direction (N) +ExtPtfm['IntrfFz'] = False # - Platform interface force - Directed along the z-direction (N) +ExtPtfm['IntrfMx'] = False # - Platform interface moment - Directed along the x-direction (Nm) +ExtPtfm['IntrfMy'] = False # - Platform interface moment - Directed along the y-direction (Nm) +ExtPtfm['IntrfMz'] = False # - Platform interface moment - Directed along the z-direction (Nm) +ExtPtfm['InpF_Fx'] = False # - Reduced Input force at interface point - Directed along the x-direction (N) +ExtPtfm['InpF_Fy'] = False # - Reduced Input force at interface point - Directed along the y-direction (N) +ExtPtfm['InpF_Fz'] = False # - Reduced Input force at interface point - Directed along the z-direction (N) +ExtPtfm['InpF_Mx'] = False # - Reduced Input moment at interface point - Directed along the x-direction (Nm) +ExtPtfm['InpF_My'] = False # - Reduced Input moment at interface point - Directed along the y-direction (Nm) +ExtPtfm['InpF_Mz'] = False # - Reduced Input moment at interface point - Directed along the z-direction (Nm) +ExtPtfm['CBQ_001'] = False # - Modal displacement of internal Craig-Bampton mode number XXX (-) +ExtPtfm['CBQ_002'] = False # - Modal displacement of internal Craig-Bampton mode number XXX (-) +ExtPtfm['CBQ_003'] = False # - Modal displacement of internal Craig-Bampton mode number XXX (-) +ExtPtfm['CBQ_004'] = False # - Modal displacement of internal Craig-Bampton mode number XXX (-) +ExtPtfm['CBQ_005'] = False # - Modal displacement of internal Craig-Bampton mode number XXX (-) +ExtPtfm['CBQ_006'] = False # - Modal displacement of internal Craig-Bampton mode number XXX (-) +ExtPtfm['CBQ_007'] = False # - Modal displacement of internal Craig-Bampton mode number XXX (-) +ExtPtfm['CBQ_010'] = False # - Modal displacement of internal Craig-Bampton mode number XXX (-) +ExtPtfm['CBQ_011'] = False # - Modal displacement of internal Craig-Bampton mode number XXX (-) +ExtPtfm['CBQ_012'] = False # - Modal displacement of internal Craig-Bampton mode number XXX (-) +ExtPtfm['CBQ_013'] = False # - Modal displacement of internal Craig-Bampton mode number XXX (-) +ExtPtfm['CBQ_014'] = False # - Modal displacement of internal Craig-Bampton mode number XXX (-) +ExtPtfm['CBQ_015'] = False # - Modal displacement of internal Craig-Bampton mode number XXX (-) +ExtPtfm['CBQ_016'] = False # - Modal displacement of internal Craig-Bampton mode number XXX (-) +ExtPtfm['CBQ_017'] = False # - Modal displacement of internal Craig-Bampton mode number XXX (-) +ExtPtfm['CBQ_020'] = False # - Modal displacement of internal Craig-Bampton mode number XXX (-) +ExtPtfm['CBQ_021'] = False # - Modal displacement of internal Craig-Bampton mode number XXX (-) +ExtPtfm['CBQ_022'] = False # - Modal displacement of internal Craig-Bampton mode number XXX (-) +ExtPtfm['CBQ_023'] = False # - Modal displacement of internal Craig-Bampton mode number XXX (-) +ExtPtfm['CBQ_024'] = False # - Modal displacement of internal Craig-Bampton mode number XXX (-) +ExtPtfm['CBQ_025'] = False # - Modal displacement of internal Craig-Bampton mode number XXX (-) +ExtPtfm['CBF_001'] = False # - Modal force on internal Craig-Bampton mode number XXX (-) +ExtPtfm['CBF_002'] = False # - Modal force on internal Craig-Bampton mode number XXX (-) +ExtPtfm['CBF_003'] = False # - Modal force on internal Craig-Bampton mode number XXX (-) +ExtPtfm['CBF_004'] = False # - Modal force on internal Craig-Bampton mode number XXX (-) +ExtPtfm['CBF_005'] = False # - Modal force on internal Craig-Bampton mode number XXX (-) +ExtPtfm['CBF_006'] = False # - Modal force on internal Craig-Bampton mode number XXX (-) +ExtPtfm['CBF_007'] = False # - Modal force on internal Craig-Bampton mode number XXX (-) +ExtPtfm['CBF_010'] = False # - Modal force on internal Craig-Bampton mode number XXX (-) +ExtPtfm['CBF_011'] = False # - Modal force on internal Craig-Bampton mode number XXX (-) +ExtPtfm['CBF_012'] = False # - Modal force on internal Craig-Bampton mode number XXX (-) +ExtPtfm['CBF_013'] = False # - Modal force on internal Craig-Bampton mode number XXX (-) +ExtPtfm['CBF_014'] = False # - Modal force on internal Craig-Bampton mode number XXX (-) +ExtPtfm['CBF_015'] = False # - Modal force on internal Craig-Bampton mode number XXX (-) +ExtPtfm['CBF_016'] = False # - Modal force on internal Craig-Bampton mode number XXX (-) +ExtPtfm['CBF_017'] = False # - Modal force on internal Craig-Bampton mode number XXX (-) +ExtPtfm['CBF_020'] = False # - Modal force on internal Craig-Bampton mode number XXX (-) +ExtPtfm['CBF_021'] = False # - Modal force on internal Craig-Bampton mode number XXX (-) +ExtPtfm['CBF_022'] = False # - Modal force on internal Craig-Bampton mode number XXX (-) +ExtPtfm['CBF_023'] = False # - Modal force on internal Craig-Bampton mode number XXX (-) +ExtPtfm['CBF_024'] = False # - Modal force on internal Craig-Bampton mode number XXX (-) +ExtPtfm['CBF_025'] = False # - Modal force on internal Craig-Bampton mode number XXX (-) +ExtPtfm['WavElev'] = False # - Wave elevation (m) + +""" AeroDisk """ +AeroDisk = {} + +# All channels +AeroDisk['ADSpeed'] = False # (rpm); Actuator disk rotational speed; +AeroDisk['ADTSR'] = False # (-); Actuator disk tip-speed ratio; +AeroDisk['ADPitch'] = False # (deg); Actuator disk collective blade-pitch angle; +AeroDisk['ADVWindx'] = False # (m/s); Actuator-disk-average wind velocity; local coordinate system - X +AeroDisk['ADVWindy'] = False # (m/s); Actuator-disk-average wind velocity; local coordinate system - Y +AeroDisk['ADVWindz'] = False # (m/s); Actuator-disk-average wind velocity; local coordinate system - Z +AeroDisk['ADVWindxi'] = False # (m/s); Actuator-disk-average wind velocity; global (inertial) coordinate system - X +AeroDisk['ADVWindyi'] = False # (m/s); Actuator-disk-average wind velocity; global (inertial) coordinate system - Y +AeroDisk['ADVWindzi'] = False # (m/s); Actuator-disk-average wind velocity; global (inertial) coordinate system - Z +AeroDisk['ADSTVx'] = False # (m/s); Actuator-disk structural translation velocity; local coordinate system - X +AeroDisk['ADSTVy'] = False # (m/s); Actuator-disk structural translation velocity; local coordinate system - Y +AeroDisk['ADSTVz'] = False # (m/s); Actuator-disk structural translation velocity; local coordinate system - Z +AeroDisk['ADSTVxi'] = False # (m/s); Actuator-disk structural translation velocity; global (inertial) coordinate system - X +AeroDisk['ADSTVyi'] = False # (m/s); Actuator-disk structural translation velocity; global (inertial) coordinate system - Y +AeroDisk['ADSTVzi'] = False # (m/s); Actuator-disk structural translation velocity; global (inertial) coordinate system - Z +AeroDisk['ADVRel'] = False # (m/s); Actuator-disk -average relative wind speed; +AeroDisk['ADSkew'] = False # (deg); Actuator-disk inflow-skew angle; +AeroDisk['ADYawErr'] = False # (deg); Actuator-disk yaw-error angle; +AeroDisk['ADCp'] = False # (-); Actuator-disk coeficent of power; +AeroDisk['ADCt'] = False # (-); Actuator-disk coeficent of thrust; +AeroDisk['ADCq'] = False # (-); Actuator-disk coeficent of torque; +AeroDisk['ADFx'] = False # (N); Actuator-disk aerodynamic force; local coordinate system - X +AeroDisk['ADFy'] = False # (N); Actuator-disk aerodynamic force; local coordinate system - Y +AeroDisk['ADFz'] = False # (N); Actuator-disk aerodynamic force; local coordinate system - Z +AeroDisk['ADFxi'] = False # (N); Actuator-disk aerodynamic force; global (inertial) coordinate system - X +AeroDisk['ADFyi'] = False # (N); Actuator-disk aerodynamic force; global (inertial) coordinate system - Y +AeroDisk['ADFzi'] = False # (N); Actuator-disk aerodynamic force; global (inertial) coordinate system - Z +AeroDisk['ADMx'] = False # (N-m); Actuator-disk aerodynamic moment; local coordinate system - X +AeroDisk['ADMy'] = False # (N-m); Actuator-disk aerodynamic moment; local coordinate system - Y +AeroDisk['ADMz'] = False # (N-m); Actuator-disk aerodynamic moment; local coordinate system - Z +AeroDisk['ADMxi'] = False # (N-m); Actuator-disk aerodynamic moment; global (inertial) coordinate system - X +AeroDisk['ADMyi'] = False # (N-m); Actuator-disk aerodynamic moment; global (inertial) coordinate system - Y +AeroDisk['ADMzi'] = False # (N-m); Actuator-disk aerodynamic moment; global (inertial) coordinate system - Z +AeroDisk['ADPower'] = False # (W); Actuator-disk power; + + +""" SimpleElastoDyn """ +SimpleElastoDyn = {} + +# Outputs +SimpleElastoDyn['Azimuth'] = False # (deg); Rotor azimuth angle (position); +SimpleElastoDyn['RotSpeed'] = False # (rpm); Rotor azimuth angular speed; +SimpleElastoDyn['LSSTipVxa'] = False # (rpm); Rotor azimuth angular speed; +SimpleElastoDyn['LSSTipVxs'] = False # (rpm); Rotor azimuth angular speed; +SimpleElastoDyn['LSSTipV'] = False # (rpm); Rotor azimuth angular speed; +SimpleElastoDyn['RotAcc'] = False # (deg/s^2); Rotor azimuth angular acceleration; +SimpleElastoDyn['LSSTipAxs'] = False # (deg/s^2); Rotor azimuth angular acceleration; +SimpleElastoDyn['LSSTipA'] = False # (deg/s^2); Rotor azimuth angular acceleration; +SimpleElastoDyn['LSSTipAxa'] = False # (deg/s^2); Rotor azimuth angular acceleration; +SimpleElastoDyn['GenSpeed'] = False # (rpm); Angular speed of the high-speed shaft and generator; +SimpleElastoDyn['HSShftV'] = False # (rpm); Angular speed of the high-speed shaft and generator; +SimpleElastoDyn['GenAcc'] = False # (deg/s^2); Angular acceleration of the high-speed shaft and generator; +SimpleElastoDyn['HSShftA'] = False # (deg/s^2); Angular acceleration of the high-speed shaft and generator; +SimpleElastoDyn['Yaw'] = False # (deg); Commanded yaw position from controller; +SimpleElastoDyn['YawRate'] = False # (deg/s); commanded yaw rate from controller; # Blade Pitch Motions -OutList['PtchPMzc1'] = False # (deg); Blade 1 pitch angle (position); Positive towards feather about the minus zc1- and minus zb1-axes -OutList['PtchPMzb1'] = False # (deg); Blade 1 pitch angle (position); Positive towards feather about the minus zc1- and minus zb1-axes -OutList['BldPitch1'] = False # (deg); Blade 1 pitch angle (position); Positive towards feather about the minus zc1- and minus zb1-axes -OutList['BlPitch1'] = False # (deg); Blade 1 pitch angle (position); Positive towards feather about the minus zc1- and minus zb1-axes -OutList['PtchPMzc2'] = False # (deg); Blade 2 pitch angle (position); Positive towards feather about the minus zc2- and minus zb2-axes -OutList['PtchPMzb2'] = False # (deg); Blade 2 pitch angle (position); Positive towards feather about the minus zc2- and minus zb2-axes -OutList['BldPitch2'] = False # (deg); Blade 2 pitch angle (position); Positive towards feather about the minus zc2- and minus zb2-axes -OutList['BlPitch2'] = False # (deg); Blade 2 pitch angle (position); Positive towards feather about the minus zc2- and minus zb2-axes -OutList['PtchPMzc3'] = False # (deg); Blade 3 pitch angle (position); Positive towards feather about the minus zc3- and minus zb3-axes -OutList['PtchPMzb3'] = False # (deg); Blade 3 pitch angle (position); Positive towards feather about the minus zc3- and minus zb3-axes -OutList['BldPitch3'] = False # (deg); Blade 3 pitch angle (position); Positive towards feather about the minus zc3- and minus zb3-axes -OutList['BlPitch3'] = False # (deg); Blade 3 pitch angle (position); Positive towards feather about the minus zc3- and minus zb3-axes - -# Teeter Motions -OutList['TeetPya'] = False # (deg); Rotor teeter angle (position); About the ya-axis -OutList['RotTeetP'] = False # (deg); Rotor teeter angle (position); About the ya-axis -OutList['TeetDefl'] = False # (deg); Rotor teeter angle (position); About the ya-axis -OutList['TeetVya'] = False # (deg/s); Rotor teeter angular velocity; About the ya-axis -OutList['RotTeetV'] = False # (deg/s); Rotor teeter angular velocity; About the ya-axis -OutList['TeetAya'] = False # (deg/s^2); Rotor teeter angular acceleration; About the ya-axis -OutList['RotTeetA'] = False # (deg/s^2); Rotor teeter angular acceleration; About the ya-axis - -# Shaft Motions -OutList['LSSTipPxa'] = False # (deg); Rotor azimuth angle (position); About the xa- and xs-axes -OutList['LSSTipPxs'] = False # (deg); Rotor azimuth angle (position); About the xa- and xs-axes -OutList['LSSTipP'] = False # (deg); Rotor azimuth angle (position); About the xa- and xs-axes -OutList['Azimuth'] = False # (deg); Rotor azimuth angle (position); About the xa- and xs-axes -OutList['LSSTipVxa'] = False # (rpm); Rotor azimuth angular speed; About the xa- and xs-axes -OutList['LSSTipVxs'] = False # (rpm); Rotor azimuth angular speed; About the xa- and xs-axes -OutList['LSSTipV'] = False # (rpm); Rotor azimuth angular speed; About the xa- and xs-axes -OutList['RotSpeed'] = False # (rpm); Rotor azimuth angular speed; About the xa- and xs-axes -OutList['LSSTipAxa'] = False # (deg/s^2); Rotor azimuth angular acceleration; About the xa- and xs-axes -OutList['LSSTipAxs'] = False # (deg/s^2); Rotor azimuth angular acceleration; About the xa- and xs-axes -OutList['LSSTipA'] = False # (deg/s^2); Rotor azimuth angular acceleration; About the xa- and xs-axes -OutList['RotAccel'] = False # (deg/s^2); Rotor azimuth angular acceleration; About the xa- and xs-axes -OutList['LSSGagPxa'] = False # (deg); Low-speed shaft strain gage azimuth angle (position) (on the gearbox side of the low-speed shaft); About the xa- and xs-axes -OutList['LSSGagPxs'] = False # (deg); Low-speed shaft strain gage azimuth angle (position) (on the gearbox side of the low-speed shaft); About the xa- and xs-axes -OutList['LSSGagP'] = False # (deg); Low-speed shaft strain gage azimuth angle (position) (on the gearbox side of the low-speed shaft); About the xa- and xs-axes -OutList['LSSGagVxa'] = False # (rpm); Low-speed shaft strain gage angular speed (on the gearbox side of the low-speed shaft); About the xa- and xs-axes -OutList['LSSGagVxs'] = False # (rpm); Low-speed shaft strain gage angular speed (on the gearbox side of the low-speed shaft); About the xa- and xs-axes -OutList['LSSGagV'] = False # (rpm); Low-speed shaft strain gage angular speed (on the gearbox side of the low-speed shaft); About the xa- and xs-axes -OutList['LSSGagAxa'] = False # (deg/s^2); Low-speed shaft strain gage angular acceleration (on the gearbox side of the low-speed shaft); About the xa- and xs-axes -OutList['LSSGagAxs'] = False # (deg/s^2); Low-speed shaft strain gage angular acceleration (on the gearbox side of the low-speed shaft); About the xa- and xs-axes -OutList['LSSGagA'] = False # (deg/s^2); Low-speed shaft strain gage angular acceleration (on the gearbox side of the low-speed shaft); About the xa- and xs-axes -OutList['HSShftV'] = False # (rpm); Angular speed of the high-speed shaft and generator; Same sign as LSSGagVxa / LSSGagVxs / LSSGagV -OutList['GenSpeed'] = False # (rpm); Angular speed of the high-speed shaft and generator; Same sign as LSSGagVxa / LSSGagVxs / LSSGagV -OutList['HSShftA'] = False # (deg/s^2); Angular acceleration of the high-speed shaft and generator; Same sign as LSSGagAxa / LSSGagAxs / LSSGagA -OutList['GenAccel'] = False # (deg/s^2); Angular acceleration of the high-speed shaft and generator; Same sign as LSSGagAxa / LSSGagAxs / LSSGagA -OutList['TipSpdRat'] = False # (-); Rotor blade tip speed ratio; N/A -OutList['TSR'] = False # (-); Rotor blade tip speed ratio; N/A - -# Nacelle IMU Motions -OutList['NcIMUTVxs'] = False # (m/s); Nacelle inertial measurement unit translational velocity (absolute); Directed along the xs-axis -OutList['NcIMUTVys'] = False # (m/s); Nacelle inertial measurement unit translational velocity (absolute); Directed along the ys-axis -OutList['NcIMUTVzs'] = False # (m/s); Nacelle inertial measurement unit translational velocity (absolute); Directed along the zs-axis -OutList['NcIMUTAxs'] = False # (m/s^2); Nacelle inertial measurement unit translational acceleration (absolute); Directed along the xs-axis -OutList['NcIMUTAys'] = False # (m/s^2); Nacelle inertial measurement unit translational acceleration (absolute); Directed along the ys-axis -OutList['NcIMUTAzs'] = False # (m/s^2); Nacelle inertial measurement unit translational acceleration (absolute); Directed along the zs-axis -OutList['NcIMURVxs'] = False # (deg/s); Nacelle inertial measurement unit angular (rotational) velocity (absolute); About the xs-axis -OutList['NcIMURVys'] = False # (deg/s); Nacelle inertial measurement unit angular (rotational) velocity (absolute); About the ys-axis -OutList['NcIMURVzs'] = False # (deg/s); Nacelle inertial measurement unit angular (rotational) velocity (absolute); About the zs-axis -OutList['NcIMURAxs'] = False # (deg/s^2); Nacelle inertial measurement unit angular (rotational) acceleration (absolute); About the xs-axis -OutList['NcIMURAys'] = False # (deg/s^2); Nacelle inertial measurement unit angular (rotational) acceleration (absolute); About the ys-axis -OutList['NcIMURAzs'] = False # (deg/s^2); Nacelle inertial measurement unit angular (rotational) acceleration (absolute); About the zs-axis - -# Rotor-Furl Motions -OutList['RotFurlP'] = False # (deg); Rotor-furl angle (position); About the rotor-furl axis -OutList['RotFurl'] = False # (deg); Rotor-furl angle (position); About the rotor-furl axis -OutList['RotFurlV'] = False # (deg/s); Rotor-furl angular velocity; About the rotor-furl axis -OutList['RotFurlA'] = False # (deg/s^2); Rotor-furl angular acceleration; About the rotor-furl axis - -# Tail-Furl Motions -OutList['TailFurlP'] = False # (deg); Tail-furl angle (position); About the tail-furl axis -OutList['TailFurl'] = False # (deg); Tail-furl angle (position); About the tail-furl axis -OutList['TailFurlV'] = False # (deg/s); Tail-furl angular velocity; About the tail-furl axis -OutList['TailFurlA'] = False # (deg/s^2); Tail-furl angular acceleration; About the tail-furl axis - -# Nacelle Yaw Motions -OutList['YawPzn'] = False # (deg); Nacelle yaw angle (position); About the zn- and zp-axes -OutList['YawPzp'] = False # (deg); Nacelle yaw angle (position); About the zn- and zp-axes -OutList['NacYawP'] = False # (deg); Nacelle yaw angle (position); About the zn- and zp-axes -OutList['NacYaw'] = False # (deg); Nacelle yaw angle (position); About the zn- and zp-axes -OutList['YawPos'] = False # (deg); Nacelle yaw angle (position); About the zn- and zp-axes -OutList['YawVzn'] = False # (deg/s); Nacelle yaw angular velocity; About the zn- and zp-axes -OutList['YawVzp'] = False # (deg/s); Nacelle yaw angular velocity; About the zn- and zp-axes -OutList['NacYawV'] = False # (deg/s); Nacelle yaw angular velocity; About the zn- and zp-axes -OutList['YawRate'] = False # (deg/s); Nacelle yaw angular velocity; About the zn- and zp-axes -OutList['YawAzn'] = False # (deg/s^2); Nacelle yaw angular acceleration; About the zn- and zp-axes -OutList['YawAzp'] = False # (deg/s^2); Nacelle yaw angular acceleration; About the zn- and zp-axes -OutList['NacYawA'] = False # (deg/s^2); Nacelle yaw angular acceleration; About the zn- and zp-axes -OutList['YawAccel'] = False # (deg/s^2); Nacelle yaw angular acceleration; About the zn- and zp-axes -OutList['NacYawErr'] = False # (deg); Nacelle yaw error estimate. This is computed as follows: NacYawErr = HorWndDir - YawPzn - YawBrRDzt - PtfmRDzi. This estimate is not accurate instantaneously in the presence of significant tower deflection or platform angular (rotational) displacement since the angles used in the computation are not all defined about the same axis of rotation. However, the estimate should be useful in a yaw controller if averaged over a time scale long enough to diminish the effects of tower and platform motions (i.e., much longer than the period of oscillation).; About the zi-axis - -# Tower-Top / Yaw Bearing Motions -OutList['YawBrTDxp'] = False # (m); Tower-top / yaw bearing fore-aft (translational) deflection (relative to the undeflected position); Directed along the xp-axis -OutList['YawBrTDyp'] = False # (m); Tower-top / yaw bearing side-to-side (translational) deflection (relative to the undeflected position); Directed along the yp-axis -OutList['YawBrTDzp'] = False # (m); Tower-top / yaw bearing axial (translational) deflection (relative to the undeflected position); Directed along the zp-axis -OutList['YawBrTDxt'] = False # (m); Tower-top / yaw bearing fore-aft (translational) deflection (relative to the undeflected position); Directed along the xt-axis -OutList['TTDspFA'] = False # (m); Tower-top / yaw bearing fore-aft (translational) deflection (relative to the undeflected position); Directed along the xt-axis -OutList['YawBrTDyt'] = False # (m); Tower-top / yaw bearing side-to-side (translation) deflection (relative to the undeflected position); Directed along the yt-axis -OutList['TTDspSS'] = False # (m); Tower-top / yaw bearing side-to-side (translation) deflection (relative to the undeflected position); Directed along the yt-axis -OutList['YawBrTDzt'] = False # (m); Tower-top / yaw bearing axial (translational) deflection (relative to the undeflected position); Directed along the zt-axis -OutList['TTDspAx'] = False # (m); Tower-top / yaw bearing axial (translational) deflection (relative to the undeflected position); Directed along the zt-axis -OutList['YawBrTAxp'] = False # (m/s^2); Tower-top / yaw bearing fore-aft (translational) acceleration (absolute); Directed along the xp-axis -OutList['YawBrTAyp'] = False # (m/s^2); Tower-top / yaw bearing side-to-side (translational) acceleration (absolute); Directed along the yp-axis -OutList['YawBrTAzp'] = False # (m/s^2); Tower-top / yaw bearing axial (translational) acceleration (absolute); Directed along the zp-axis -OutList['YawBrRDxt'] = False # (deg); Tower-top / yaw bearing angular (rotational) roll deflection (relative to the undeflected position). In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower deflections, so that the rotation sequence does not matter.; About the xt-axis -OutList['TTDspRoll'] = False # (deg); Tower-top / yaw bearing angular (rotational) roll deflection (relative to the undeflected position). In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower deflections, so that the rotation sequence does not matter.; About the xt-axis -OutList['YawBrRDyt'] = False # (deg); Tower-top / yaw bearing angular (rotational) pitch deflection (relative to the undeflected position). In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower deflections, so that the rotation sequence does not matter.; About the yt-axis -OutList['TTDspPtch'] = False # (deg); Tower-top / yaw bearing angular (rotational) pitch deflection (relative to the undeflected position). In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower deflections, so that the rotation sequence does not matter.; About the yt-axis -OutList['YawBrRDzt'] = False # (deg); Tower-top / yaw bearing angular (rotational) torsion deflection (relative to the undeflected position). This output will always be zero for FAST simulation results. Use it for examining tower torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence.; About the zt-axis -OutList['TTDspTwst'] = False # (deg); Tower-top / yaw bearing angular (rotational) torsion deflection (relative to the undeflected position). This output will always be zero for FAST simulation results. Use it for examining tower torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence.; About the zt-axis -OutList['YawBrRVxp'] = False # (deg/s); Tower-top / yaw bearing angular (rotational) roll velocity (absolute); About the xp-axis -OutList['YawBrRVyp'] = False # (deg/s); Tower-top / yaw bearing angular (rotational) pitch velocity (absolute); About the yp-axis -OutList['YawBrRVzp'] = False # (deg/s); Tower-top / yaw bearing angular (rotational) torsion velocity. This output will always be very close to zero for FAST simulation results. Use it for examining tower torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. (absolute); About the zp-axis -OutList['YawBrRAxp'] = False # (deg/s^2); Tower-top / yaw bearing angular (rotational) roll acceleration (absolute); About the xp-axis -OutList['YawBrRAyp'] = False # (deg/s^2); Tower-top / yaw bearing angular (rotational) pitch acceleration (absolute); About the yp-axis -OutList['YawBrRAzp'] = False # (deg/s^2); Tower-top / yaw bearing angular (rotational) torsion acceleration. This output will always be very close to zero for FAST simulation results. Use it for examining tower torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. (absolute); About the zp-axis - -# Local Tower Motions -OutList['TwHt1ALxt'] = False # (m/s^2); Local tower fore-aft (translational) acceleration (absolute) of tower gage 1 ; Directed along the local xt-axis -OutList['TwHt1ALyt'] = False # (m/s^2); Local tower side-to-side (translational) acceleration (absolute) of tower gage 1 ; Directed along the local yt-axis -OutList['TwHt1ALzt'] = False # (m/s^2); Local tower axial (translational) acceleration (absolute) of tower gage 1 ; Directed along the local zt-axis -OutList['TwHt2ALxt'] = False # (m/s^2); Local tower fore-aft (translational) acceleration (absolute) of tower gage 2; Directed along the local xt-axis -OutList['TwHt2ALyt'] = False # (m/s^2); Local tower side-to-side (translational) acceleration (absolute) of tower gage 2; Directed along the local yt-axis -OutList['TwHt2ALzt'] = False # (m/s^2); Local tower axial (translational) acceleration (absolute) of tower gage 2; Directed along the local zt-axis -OutList['TwHt3ALxt'] = False # (m/s^2); Local tower fore-aft (translational) acceleration (absolute) of tower gage 3; Directed along the local xt-axis -OutList['TwHt3ALyt'] = False # (m/s^2); Local tower side-to-side (translational) acceleration (absolute) of tower gage 3; Directed along the local yt-axis -OutList['TwHt3ALzt'] = False # (m/s^2); Local tower axial (translational) acceleration (absolute) of tower gage 3; Directed along the local zt-axis -OutList['TwHt4ALxt'] = False # (m/s^2); Local tower fore-aft (translational) acceleration (absolute) of tower gage 4; Directed along the local xt-axis -OutList['TwHt4ALyt'] = False # (m/s^2); Local tower side-to-side (translational) acceleration (absolute) of tower gage 4; Directed along the local yt-axis -OutList['TwHt4ALzt'] = False # (m/s^2); Local tower axial (translational) acceleration (absolute) of tower gage 4; Directed along the local zt-axis -OutList['TwHt5ALxt'] = False # (m/s^2); Local tower fore-aft (translational) acceleration (absolute) of tower gage 5; Directed along the local xt-axis -OutList['TwHt5ALyt'] = False # (m/s^2); Local tower side-to-side (translational) acceleration (absolute) of tower gage 5; Directed along the local yt-axis -OutList['TwHt5ALzt'] = False # (m/s^2); Local tower axial (translational) acceleration (absolute) of tower gage 5; Directed along the local zt-axis -OutList['TwHt6ALxt'] = False # (m/s^2); Local tower fore-aft (translational) acceleration (absolute) of tower gage 6; Directed along the local xt-axis -OutList['TwHt6ALyt'] = False # (m/s^2); Local tower side-to-side (translational) acceleration (absolute) of tower gage 6; Directed along the local yt-axis -OutList['TwHt6ALzt'] = False # (m/s^2); Local tower axial (translational) acceleration (absolute) of tower gage 6; Directed along the local zt-axis -OutList['TwHt7ALxt'] = False # (m/s^2); Local tower fore-aft (translational) acceleration (absolute) of tower gage 7; Directed along the local xt-axis -OutList['TwHt7ALyt'] = False # (m/s^2); Local tower side-to-side (translational) acceleration (absolute) of tower gage 7; Directed along the local yt-axis -OutList['TwHt7ALzt'] = False # (m/s^2); Local tower axial (translational) acceleration (absolute) of tower gage 7; Directed along the local zt-axis -OutList['TwHt8ALxt'] = False # (m/s^2); Local tower fore-aft (translational) acceleration (absolute) of tower gage 8; Directed along the local xt-axis -OutList['TwHt8ALyt'] = False # (m/s^2); Local tower side-to-side (translational) acceleration (absolute) of tower gage 8; Directed along the local yt-axis -OutList['TwHt8ALzt'] = False # (m/s^2); Local tower axial (translational) acceleration (absolute) of tower gage 8; Directed along the local zt-axis -OutList['TwHt9ALxt'] = False # (m/s^2); Local tower fore-aft (translational) acceleration (absolute) of tower gage 9; Directed along the local xt-axis -OutList['TwHt9ALyt'] = False # (m/s^2); Local tower side-to-side (translational) acceleration (absolute) of tower gage 9; Directed along the local yt-axis -OutList['TwHt9ALzt'] = False # (m/s^2); Local tower axial (translational) acceleration (absolute) of tower gage 9; Directed along the local zt-axis -OutList['TwHt1TDxt'] = False # (m); Local tower fore-aft (translational) deflection (relative to the undeflected position) of tower gage 1; Directed along the local xt-axis -OutList['TwHt1TDyt'] = False # (m); Local tower side-to-side (translational) deflection (relative to the undeflected position) of tower gage 1; Directed along the local yt-axis -OutList['TwHt1TDzt'] = False # (m); Local tower axial (translational) deflection (relative to the undeflected position) of tower gage 1; Directed along the local zt-axis -OutList['TwHt2TDxt'] = False # (m); Local tower fore-aft (translational) deflection (relative to the undeflected position) of tower gage 2; Directed along the local xt-axis -OutList['TwHt2TDyt'] = False # (m); Local tower side-to-side (translational) deflection (relative to the undeflected position) of tower gage 2; Directed along the local yt-axis -OutList['TwHt2TDzt'] = False # (m); Local tower axial (translational) deflection (relative to the undeflected position) of tower gage 2; Directed along the local zt-axis -OutList['TwHt3TDxt'] = False # (m); Local tower fore-aft (translational) deflection (relative to the undeflected position) of tower gage 3; Directed along the local xt-axis -OutList['TwHt3TDyt'] = False # (m); Local tower side-to-side (translational) deflection (relative to the undeflected position) of tower gage 3; Directed along the local yt-axis -OutList['TwHt3TDzt'] = False # (m); Local tower axial (translational) deflection (relative to the undeflected position) of tower gage 3; Directed along the local zt-axis -OutList['TwHt4TDxt'] = False # (m); Local tower fore-aft (translational) deflection (relative to the undeflected position) of tower gage 4; Directed along the local xt-axis -OutList['TwHt4TDyt'] = False # (m); Local tower side-to-side (translational) deflection (relative to the undeflected position) of tower gage 4; Directed along the local yt-axis -OutList['TwHt4TDzt'] = False # (m); Local tower axial (translational) deflection (relative to the undeflected position) of tower gage 4; Directed along the local zt-axis -OutList['TwHt5TDxt'] = False # (m); Local tower fore-aft (translational) deflection (relative to the undeflected position) of tower gage 5; Directed along the local xt-axis -OutList['TwHt5TDyt'] = False # (m); Local tower side-to-side (translational) deflection (relative to the undeflected position) of tower gage 5; Directed along the local yt-axis -OutList['TwHt5TDzt'] = False # (m); Local tower axial (translational) deflection (relative to the undeflected position) of tower gage 5; Directed along the local zt-axis -OutList['TwHt6TDxt'] = False # (m); Local tower fore-aft (translational) deflection (relative to the undeflected position) of tower gage 6; Directed along the local xt-axis -OutList['TwHt6TDyt'] = False # (m); Local tower side-to-side (translational) deflection (relative to the undeflected position) of tower gage 6; Directed along the local yt-axis -OutList['TwHt6TDzt'] = False # (m); Local tower axial (translational) deflection (relative to the undeflected position) of tower gage 6; Directed along the local zt-axis -OutList['TwHt7TDxt'] = False # (m); Local tower fore-aft (translational) deflection (relative to the undeflected position) of tower gage 7; Directed along the local xt-axis -OutList['TwHt7TDyt'] = False # (m); Local tower side-to-side (translational) deflection (relative to the undeflected position) of tower gage 7; Directed along the local yt-axis -OutList['TwHt7TDzt'] = False # (m); Local tower axial (translational) deflection (relative to the undeflected position) of tower gage 7; Directed along the local zt-axis -OutList['TwHt8TDxt'] = False # (m); Local tower fore-aft (translational) deflection (relative to the undeflected position) of tower gage 8; Directed along the local xt-axis -OutList['TwHt8TDyt'] = False # (m); Local tower side-to-side (translational) deflection (relative to the undeflected position) of tower gage 8; Directed along the local yt-axis -OutList['TwHt8TDzt'] = False # (m); Local tower axial (translational) deflection (relative to the undeflected position) of tower gage 8; Directed along the local zt-axis -OutList['TwHt9TDxt'] = False # (m); Local tower fore-aft (translational) deflection (relative to the undeflected position) of tower gage 9; Directed along the local xt-axis -OutList['TwHt9TDyt'] = False # (m); Local tower side-to-side (translational) deflection (relative to the undeflected position) of tower gage 9; Directed along the local yt-axis -OutList['TwHt9TDzt'] = False # (m); Local tower axial (translational) deflection (relative to the undeflected position) of tower gage 9; Directed along the local zt-axis -OutList['TwHt1RDxt'] = False # (deg); Local tower angular (rotational) roll deflection (relative to the undeflected position) of tower gage 1. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower deflections, so that the rotation sequence does not matter.; About the local xt-axis -OutList['TwHt1RDyt'] = False # (deg); Local tower angular (rotational) pitch deflection (relative to the undeflected position) of tower gage 1. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower deflections, so that the rotation sequence does not matter.; About the local yt-axis -OutList['TwHt1RDzt'] = False # (deg); Local tower angular (rotational) torsion deflection (relative to the undeflected position) of tower gage 1. This output will always be zero for FAST simulation results. Use it for examining tower torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence.; About the local zt-axis -OutList['TwHt2RDxt'] = False # (deg); Local tower angular (rotational) roll deflection (relative to the undeflected position) of tower gage 2. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower deflections, so that the rotation sequence does not matter.; About the local xt-axis -OutList['TwHt2RDyt'] = False # (deg); Local tower angular (rotational) pitch deflection (relative to the undeflected position) of tower gage 2. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower deflections, so that the rotation sequence does not matter.; About the local yt-axis -OutList['TwHt2RDzt'] = False # (deg); Local tower angular (rotational) torsion deflection (relative to the undeflected position) of tower gage 2. This output will always be zero for FAST simulation results. Use it for examining tower torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence.; About the local zt-axis -OutList['TwHt3RDxt'] = False # (deg); Local tower angular (rotational) roll deflection (relative to the undeflected position) of tower gage 3. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower deflections, so that the rotation sequence does not matter.; About the local xt-axis -OutList['TwHt3RDyt'] = False # (deg); Local tower angular (rotational) pitch deflection (relative to the undeflected position) of tower gage 3. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower deflections, so that the rotation sequence does not matter.; About the local yt-axis -OutList['TwHt3RDzt'] = False # (deg); Local tower angular (rotational) torsion deflection (relative to the undeflected position) of tower gage 3. This output will always be zero for FAST simulation results. Use it for examining tower torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence.; About the local zt-axis -OutList['TwHt4RDxt'] = False # (deg); Local tower angular (rotational) roll deflection (relative to the undeflected position) of tower gage 4. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower deflections, so that the rotation sequence does not matter.; About the local xt-axis -OutList['TwHt4RDyt'] = False # (deg); Local tower angular (rotational) pitch deflection (relative to the undeflected position) of tower gage 4. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower deflections, so that the rotation sequence does not matter.; About the local yt-axis -OutList['TwHt4RDzt'] = False # (deg); Local tower angular (rotational) torsion deflection (relative to the undeflected position) of tower gage 4. This output will always be zero for FAST simulation results. Use it for examining tower torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence.; About the local zt-axis -OutList['TwHt5RDxt'] = False # (deg); Local tower angular (rotational) roll deflection (relative to the undeflected position) of tower gage 5. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower deflections, so that the rotation sequence does not matter.; About the local xt-axis -OutList['TwHt5RDyt'] = False # (deg); Local tower angular (rotational) pitch deflection (relative to the undeflected position) of tower gage 5. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower deflections, so that the rotation sequence does not matter.; About the local yt-axis -OutList['TwHt5RDzt'] = False # (deg); Local tower angular (rotational) torsion deflection (relative to the undeflected position) of tower gage 5. This output will always be zero for FAST simulation results. Use it for examining tower torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence.; About the local zt-axis -OutList['TwHt6RDxt'] = False # (deg); Local tower angular (rotational) roll deflection (relative to the undeflected position) of tower gage 6. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower deflections, so that the rotation sequence does not matter.; About the local xt-axis -OutList['TwHt6RDyt'] = False # (deg); Local tower angular (rotational) pitch deflection (relative to the undeflected position) of tower gage 6. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower deflections, so that the rotation sequence does not matter.; About the local yt-axis -OutList['TwHt6RDzt'] = False # (deg); Local tower angular (rotational) torsion deflection (relative to the undeflected position) of tower gage 6. This output will always be zero for FAST simulation results. Use it for examining tower torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence.; About the local zt-axis -OutList['TwHt7RDxt'] = False # (deg); Local tower angular (rotational) roll deflection (relative to the undeflected position) of tower gage 7. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower deflections, so that the rotation sequence does not matter.; About the local xt-axis -OutList['TwHt7RDyt'] = False # (deg); Local tower angular (rotational) pitch deflection (relative to the undeflected position) of tower gage 7. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower deflections, so that the rotation sequence does not matter.; About the local yt-axis -OutList['TwHt7RDzt'] = False # (deg); Local tower angular (rotational) torsion deflection (relative to the undeflected position) of tower gage 7. This output will always be zero for FAST simulation results. Use it for examining tower torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence.; About the local zt-axis -OutList['TwHt8RDxt'] = False # (deg); Local tower angular (rotational) roll deflection (relative to the undeflected position) of tower gage 8. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower deflections, so that the rotation sequence does not matter.; About the local xt-axis -OutList['TwHt8RDyt'] = False # (deg); Local tower angular (rotational) pitch deflection (relative to the undeflected position) of tower gage 8. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower deflections, so that the rotation sequence does not matter.; About the local yt-axis -OutList['TwHt8RDzt'] = False # (deg); Local tower angular (rotational) torsion deflection (relative to the undeflected position) of tower gage 8. This output will always be zero for FAST simulation results. Use it for examining tower torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence.; About the local zt-axis -OutList['TwHt9RDxt'] = False # (deg); Local tower angular (rotational) roll deflection (relative to the undeflected position) of tower gage 9. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower deflections, so that the rotation sequence does not matter.; About the local xt-axis -OutList['TwHt9RDyt'] = False # (deg); Local tower angular (rotational) pitch deflection (relative to the undeflected position) of tower gage 9. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower deflections, so that the rotation sequence does not matter.; About the local yt-axis -OutList['TwHt9RDzt'] = False # (deg); Local tower angular (rotational) torsion deflection (relative to the undeflected position) of tower gage 9. This output will always be zero for FAST simulation results. Use it for examining tower torsional deflections of ADAMS simulations run using ADAMS datasets created using the FAST-to-ADAMS preprocessor. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence.; About the local zt-axis -OutList['TwHt1TPxi'] = False # (m); xi-component of the translational position (relative to the inertia frame) of tower gage 1; Directed along the local xi-axis -OutList['TwHt1TPyi'] = False # (m); yi-component of the translational position (relative to the inertia frame) of tower gage 1; Directed along the local yi-axis -OutList['TwHt1TPzi'] = False # (m); zi-component of the translational position (relative to ground level [onshore] or MSL [offshore]) of tower gage 1; Directed along the local zi-axis -OutList['TwHt2TPxi'] = False # (m); xi-component of the translational position (relative to the inertia frame) of tower gage 2; Directed along the local xi-axis -OutList['TwHt2TPyi'] = False # (m); yi-component of the translational position (relative to the inertia frame) of tower gage 2; Directed along the local yi-axis -OutList['TwHt2TPzi'] = False # (m); zi-component of the translational position (relative to ground level [onshore] or MSL [offshore]) of tower gage 2; Directed along the local zi-axis -OutList['TwHt3TPxi'] = False # (m); xi-component of the translational position (relative to the inertia frame) of tower gage 3; Directed along the local xi-axis -OutList['TwHt3TPyi'] = False # (m); yi-component of the translational position (relative to the inertia frame) of tower gage 3; Directed along the local yi-axis -OutList['TwHt3TPzi'] = False # (m); zi-component of the translational position (relative to ground level [onshore] or MSL [offshore]) of tower gage 3; Directed along the local zi-axis -OutList['TwHt4TPxi'] = False # (m); xi-component of the translational position (relative to the inertia frame) of tower gage 4; Directed along the local xi-axis -OutList['TwHt4TPyi'] = False # (m); yi-component of the translational position (relative to the inertia frame) of tower gage 4; Directed along the local yi-axis -OutList['TwHt4TPzi'] = False # (m); zi-component of the translational position (relative to ground level [onshore] or MSL [offshore]) of tower gage 4; Directed along the local zi-axis -OutList['TwHt5TPxi'] = False # (m); xi-component of the translational position (relative to the inertia frame) of tower gage 5; Directed along the local xi-axis -OutList['TwHt5TPyi'] = False # (m); yi-component of the translational position (relative to the inertia frame) of tower gage 5; Directed along the local yi-axis -OutList['TwHt5TPzi'] = False # (m); zi-component of the translational position (relative to ground level [onshore] or MSL [offshore]) of tower gage 5; Directed along the local zi-axis -OutList['TwHt6TPxi'] = False # (m); xi-component of the translational position (relative to the inertia frame) of tower gage 6; Directed along the local xi-axis -OutList['TwHt6TPyi'] = False # (m); yi-component of the translational position (relative to the inertia frame) of tower gage 6; Directed along the local yi-axis -OutList['TwHt6TPzi'] = False # (m); zi-component of the translational position (relative to ground level [onshore] or MSL [offshore]) of tower gage 6; Directed along the local zi-axis -OutList['TwHt7TPxi'] = False # (m); xi-component of the translational position (relative to the inertia frame) of tower gage 7; Directed along the local xi-axis -OutList['TwHt7TPyi'] = False # (m); yi-component of the translational position (relative to the inertia frame) of tower gage 7; Directed along the local yi-axis -OutList['TwHt7TPzi'] = False # (m); zi-component of the translational position (relative to ground level [onshore] or MSL [offshore]) of tower gage 7; Directed along the local zi-axis -OutList['TwHt8TPxi'] = False # (m); xi-component of the translational position (relative to the inertia frame) of tower gage 8; Directed along the local xi-axis -OutList['TwHt8TPyi'] = False # (m); yi-component of the translational position (relative to the inertia frame) of tower gage 8; Directed along the local yi-axis -OutList['TwHt8TPzi'] = False # (m); zi-component of the translational position (relative to ground level [onshore] or MSL [offshore]) of tower gage 8; Directed along the local zi-axis -OutList['TwHt9TPxi'] = False # (m); xi-component of the translational position (relative to the inertia frame) of tower gage 9; Directed along the local xi-axis -OutList['TwHt9TPyi'] = False # (m); yi-component of the translational position (relative to the inertia frame) of tower gage 9; Directed along the local yi-axis -OutList['TwHt9TPzi'] = False # (m); zi-component of the translational position (relative to ground level [onshore] or MSL [offshore]) of tower gage 9; Directed along the local zi-axis -OutList['TwHt1RPxi'] = False # (deg); xi-component of the rotational position (relative to the inertia frame) of tower gage 1. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower and platform rotational deflections, so that the rotation sequence does not matter.; About the local xi-axis -OutList['TwHt1RPyi'] = False # (deg); yi-component of the rotational position (relative to the inertia frame) of tower gage 1. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower and platform rotational deflections, so that the rotation sequence does not matter.; About the local yi-axis -OutList['TwHt1RPzi'] = False # (deg); zi-component of the rotational position (relative to the inertia frame) of tower gage 1. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower and platform rotational deflections, so that the rotation sequence does not matter.; About the local zi-axis -OutList['TwHt2RPxi'] = False # (deg); xi-component of the rotational position (relative to the inertia frame) of tower gage 2. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower and platform rotational deflections, so that the rotation sequence does not matter.; About the local xi-axis -OutList['TwHt2RPyi'] = False # (deg); yi-component of the rotational position (relative to the inertia frame) of tower gage 2. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower and platform rotational deflections, so that the rotation sequence does not matter.; About the local yi-axis -OutList['TwHt2RPzi'] = False # (deg); zi-component of the rotational position (relative to the inertia frame) of tower gage 2. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower and platform rotational deflections, so that the rotation sequence does not matter.; About the local zi-axis -OutList['TwHt3RPxi'] = False # (deg); xi-component of the rotational position (relative to the inertia frame) of tower gage 3. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower and platform rotational deflections, so that the rotation sequence does not matter.; About the local xi-axis -OutList['TwHt3RPyi'] = False # (deg); yi-component of the rotational position (relative to the inertia frame) of tower gage 3. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower and platform rotational deflections, so that the rotation sequence does not matter.; About the local yi-axis -OutList['TwHt3RPzi'] = False # (deg); zi-component of the rotational position (relative to the inertia frame) of tower gage 3. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower and platform rotational deflections, so that the rotation sequence does not matter.; About the local zi-axis -OutList['TwHt4RPxi'] = False # (deg); xi-component of the rotational position (relative to the inertia frame) of tower gage 4. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower and platform rotational deflections, so that the rotation sequence does not matter.; About the local xi-axis -OutList['TwHt4RPyi'] = False # (deg); yi-component of the rotational position (relative to the inertia frame) of tower gage 4. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower and platform rotational deflections, so that the rotation sequence does not matter.; About the local yi-axis -OutList['TwHt4RPzi'] = False # (deg); zi-component of the rotational position (relative to the inertia frame) of tower gage 4. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower and platform rotational deflections, so that the rotation sequence does not matter.; About the local zi-axis -OutList['TwHt5RPxi'] = False # (deg); xi-component of the rotational position (relative to the inertia frame) of tower gage 5. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower and platform rotational deflections, so that the rotation sequence does not matter.; About the local xi-axis -OutList['TwHt5RPyi'] = False # (deg); yi-component of the rotational position (relative to the inertia frame) of tower gage 5. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower and platform rotational deflections, so that the rotation sequence does not matter.; About the local yi-axis -OutList['TwHt5RPzi'] = False # (deg); zi-component of the rotational position (relative to the inertia frame) of tower gage 5. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower and platform rotational deflections, so that the rotation sequence does not matter.; About the local zi-axis -OutList['TwHt6RPxi'] = False # (deg); xi-component of the rotational position (relative to the inertia frame) of tower gage 6. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower and platform rotational deflections, so that the rotation sequence does not matter.; About the local xi-axis -OutList['TwHt6RPyi'] = False # (deg); yi-component of the rotational position (relative to the inertia frame) of tower gage 6. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower and platform rotational deflections, so that the rotation sequence does not matter.; About the local yi-axis -OutList['TwHt6RPzi'] = False # (deg); zi-component of the rotational position (relative to the inertia frame) of tower gage 6. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower and platform rotational deflections, so that the rotation sequence does not matter.; About the local zi-axis -OutList['TwHt7RPxi'] = False # (deg); xi-component of the rotational position (relative to the inertia frame) of tower gage 7. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower and platform rotational deflections, so that the rotation sequence does not matter.; About the local xi-axis -OutList['TwHt7RPyi'] = False # (deg); yi-component of the rotational position (relative to the inertia frame) of tower gage 7. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower and platform rotational deflections, so that the rotation sequence does not matter.; About the local yi-axis -OutList['TwHt7RPzi'] = False # (deg); zi-component of the rotational position (relative to the inertia frame) of tower gage 7. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower and platform rotational deflections, so that the rotation sequence does not matter.; About the local zi-axis -OutList['TwHt8RPxi'] = False # (deg); xi-component of the rotational position (relative to the inertia frame) of tower gage 8. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower and platform rotational deflections, so that the rotation sequence does not matter.; About the local xi-axis -OutList['TwHt8RPyi'] = False # (deg); yi-component of the rotational position (relative to the inertia frame) of tower gage 8. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower and platform rotational deflections, so that the rotation sequence does not matter.; About the local yi-axis -OutList['TwHt8RPzi'] = False # (deg); zi-component of the rotational position (relative to the inertia frame) of tower gage 8. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower and platform rotational deflections, so that the rotation sequence does not matter.; About the local zi-axis -OutList['TwHt9RPxi'] = False # (deg); xi-component of the rotational position (relative to the inertia frame) of tower gage 9. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower and platform rotational deflections, so that the rotation sequence does not matter.; About the local xi-axis -OutList['TwHt9RPyi'] = False # (deg); yi-component of the rotational position (relative to the inertia frame) of tower gage 9. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower and platform rotational deflections, so that the rotation sequence does not matter.; About the local yi-axis -OutList['TwHt9RPzi'] = False # (deg); zi-component of the rotational position (relative to the inertia frame) of tower gage 9. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small tower and platform rotational deflections, so that the rotation sequence does not matter.; About the local zi-axis - -# Platform Motions -OutList['PtfmTDxt'] = False # (m); Platform horizontal surge (translational) displacement; Directed along the xt-axis -OutList['PtfmTDyt'] = False # (m); Platform horizontal sway (translational) displacement; Directed along the yt-axis -OutList['PtfmTDzt'] = False # (m); Platform vertical heave (translational) displacement; Directed along the zt-axis -OutList['PtfmTDxi'] = False # (m); Platform horizontal surge (translational) displacement; Directed along the xi-axis -OutList['PtfmSurge'] = False # (m); Platform horizontal surge (translational) displacement; Directed along the xi-axis -OutList['PtfmTDyi'] = False # (m); Platform horizontal sway (translational) displacement; Directed along the yi-axis -OutList['PtfmSway'] = False # (m); Platform horizontal sway (translational) displacement; Directed along the yi-axis -OutList['PtfmTDzi'] = False # (m); Platform vertical heave (translational) displacement; Directed along the zi-axis -OutList['PtfmHeave'] = False # (m); Platform vertical heave (translational) displacement; Directed along the zi-axis -OutList['PtfmTVxt'] = False # (m/s); Platform horizontal surge (translational) velocity; Directed along the xt-axis -OutList['PtfmTVyt'] = False # (m/s); Platform horizontal sway (translational) velocity; Directed along the yt-axis -OutList['PtfmTVzt'] = False # (m/s); Platform vertical heave (translational) velocity; Directed along the zt-axis -OutList['PtfmTVxi'] = False # (m/s); Platform horizontal surge (translational) velocity; Directed along the xi-axis -OutList['PtfmTVyi'] = False # (m/s); Platform horizontal sway (translational) velocity; Directed along the yi-axis -OutList['PtfmTVzi'] = False # (m/s); Platform vertical heave (translational) velocity; Directed along the zi-axis -OutList['PtfmTAxt'] = False # (m/s^2); Platform horizontal surge (translational) acceleration; Directed along the xt-axis -OutList['PtfmTAyt'] = False # (m/s^2); Platform horizontal sway (translational) acceleration; Directed along the yt-axis -OutList['PtfmTAzt'] = False # (m/s^2); Platform vertical heave (translational) acceleration; Directed along the zt-axis -OutList['PtfmTAxi'] = False # (m/s^2); Platform horizontal surge (translational) acceleration; Directed along the xi-axis -OutList['PtfmTAyi'] = False # (m/s^2); Platform horizontal sway (translational) acceleration; Directed along the yi-axis -OutList['PtfmTAzi'] = False # (m/s^2); Platform vertical heave (translational) acceleration; Directed along the zi-axis -OutList['PtfmRDxi'] = False # (deg); Platform roll tilt angular (rotational) displacement. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small rotational platform displacements, so that the rotation sequence does not matter.; About the xi-axis -OutList['PtfmRoll'] = False # (deg); Platform roll tilt angular (rotational) displacement. In ADAMS, it is output as an Euler angle computed as the 3rd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small rotational platform displacements, so that the rotation sequence does not matter.; About the xi-axis -OutList['PtfmRDyi'] = False # (deg); Platform pitch tilt angular (rotational) displacement. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small rotational platform displacements, so that the rotation sequence does not matter.; About the yi-axis -OutList['PtfmPitch'] = False # (deg); Platform pitch tilt angular (rotational) displacement. In ADAMS, it is output as an Euler angle computed as the 2nd rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small rotational platform displacements, so that the rotation sequence does not matter.; About the yi-axis -OutList['PtfmRDzi'] = False # (deg); Platform yaw angular (rotational) displacement. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small rotational platform displacements, so that the rotation sequence does not matter.; About the zi-axis -OutList['PtfmYaw'] = False # (deg); Platform yaw angular (rotational) displacement. In ADAMS, it is output as an Euler angle computed as the 1st rotation in the yaw-pitch-roll rotation sequence. It is not output as an Euler angle in FAST, which assumes small rotational platform displacements, so that the rotation sequence does not matter.; About the zi-axis -OutList['PtfmRVxt'] = False # (deg/s); Platform roll tilt angular (rotational) velocity; About the xt-axis -OutList['PtfmRVyt'] = False # (deg/s); Platform pitch tilt angular (rotational) velocity; About the yt-axis -OutList['PtfmRVzt'] = False # (deg/s); Platform yaw angular (rotational) velocity; About the zt-axis -OutList['PtfmRVxi'] = False # (deg/s); Platform roll tilt angular (rotational) velocity; About the xi-axis -OutList['PtfmRVyi'] = False # (deg/s); Platform pitch tilt angular (rotational) velocity; About the yi-axis -OutList['PtfmRVzi'] = False # (deg/s); Platform yaw angular (rotational) velocity; About the zi-axis -OutList['PtfmRAxt'] = False # (deg/s^2); Platform roll tilt angular (rotational) acceleration; About the xt-axis -OutList['PtfmRAyt'] = False # (deg/s^2); Platform pitch tilt angular (rotational) acceleration; About the yt-axis -OutList['PtfmRAzt'] = False # (deg/s^2); Platform yaw angular (rotational) acceleration; About the zt-axis -OutList['PtfmRAxi'] = False # (deg/s^2); Platform roll tilt angular (rotational) acceleration; About the xi-axis -OutList['PtfmRAyi'] = False # (deg/s^2); Platform pitch tilt angular (rotational) acceleration; About the yi-axis -OutList['PtfmRAzi'] = False # (deg/s^2); Platform yaw angular (rotational) acceleration; About the zi-axis - -# Blade 1 Root Loads -OutList['RootFxc1'] = False # (kN); Blade 1 out-of-plane shear force at the blade root; Directed along the xc1-axis -OutList['RootFyc1'] = False # (kN); Blade 1 in-plane shear force at the blade root; Directed along the yc1-axis -OutList['RootFzc1'] = False # (kN); Blade 1 axial force at the blade root; Directed along the zc1- and zb1-axes -OutList['RootFzb1'] = False # (kN); Blade 1 axial force at the blade root; Directed along the zc1- and zb1-axes -OutList['RootFxb1'] = False # (kN); Blade 1 flapwise shear force at the blade root; Directed along the xb1-axis -OutList['RootFyb1'] = False # (kN); Blade 1 edgewise shear force at the blade root; Directed along the yb1-axis -OutList['RootMxc1'] = False # (kN m); Blade 1 in-plane moment (i.e., the moment caused by in-plane forces) at the blade root; About the xc1-axis -OutList['RootMIP1'] = False # (kN m); Blade 1 in-plane moment (i.e., the moment caused by in-plane forces) at the blade root; About the xc1-axis -OutList['RootMyc1'] = False # (kN m); Blade 1 out-of-plane moment (i.e., the moment caused by out-of-plane forces) at the blade root; About the yc1-axis -OutList['RootMOoP1'] = False # (kN m); Blade 1 out-of-plane moment (i.e., the moment caused by out-of-plane forces) at the blade root; About the yc1-axis -OutList['RootMzc1'] = False # (kN m); Blade 1 pitching moment at the blade root; About the zc1- and zb1-axes -OutList['RootMzb1'] = False # (kN m); Blade 1 pitching moment at the blade root; About the zc1- and zb1-axes -OutList['RootMxb1'] = False # (kN m); Blade 1 edgewise moment (i.e., the moment caused by edgewise forces) at the blade root; About the xb1-axis -OutList['RootMEdg1'] = False # (kN m); Blade 1 edgewise moment (i.e., the moment caused by edgewise forces) at the blade root; About the xb1-axis -OutList['RootMyb1'] = True # (kN m); Blade 1 flapwise moment (i.e., the moment caused by flapwise forces) at the blade root; About the yb1-axis -OutList['RootMFlp1'] = False # (kN m); Blade 1 flapwise moment (i.e., the moment caused by flapwise forces) at the blade root; About the yb1-axis - -# Blade 2 Root Loads -OutList['RootFxc2'] = False # (kN); Blade 2 out-of-plane shear force at the blade root; Directed along the xc2-axis -OutList['RootFyc2'] = False # (kN); Blade 2 in-plane shear force at the blade root; Directed along the yc2-axis -OutList['RootFzc2'] = False # (kN); Blade 2 axial force at the blade root; Directed along the zc2- and zb2-axes -OutList['RootFzb2'] = False # (kN); Blade 2 axial force at the blade root; Directed along the zc2- and zb2-axes -OutList['RootFxb2'] = False # (kN); Blade 2 flapwise shear force at the blade root; Directed along the xb2-axis -OutList['RootFyb2'] = False # (kN); Blade 2 edgewise shear force at the blade root; Directed along the yb2-axis -OutList['RootMxc2'] = False # (kN m); Blade 2 in-plane moment (i.e., the moment caused by in-plane forces) at the blade root; About the xc2-axis -OutList['RootMIP2'] = False # (kN m); Blade 2 in-plane moment (i.e., the moment caused by in-plane forces) at the blade root; About the xc2-axis -OutList['RootMyc2'] = False # (kN m); Blade 2 out-of-plane moment (i.e., the moment caused by out-of-plane forces) at the blade root; About the yc2-axis -OutList['RootMOoP2'] = False # (kN m); Blade 2 out-of-plane moment (i.e., the moment caused by out-of-plane forces) at the blade root; About the yc2-axis -OutList['RootMzc2'] = False # (kN m); Blade 2 pitching moment at the blade root; About the zc2- and zb2-axes -OutList['RootMzb2'] = False # (kN m); Blade 2 pitching moment at the blade root; About the zc2- and zb2-axes -OutList['RootMxb2'] = False # (kN m); Blade 2 edgewise moment (i.e., the moment caused by edgewise forces) at the blade root; About the xb2-axis -OutList['RootMEdg2'] = False # (kN m); Blade 2 edgewise moment (i.e., the moment caused by edgewise forces) at the blade root; About the xb2-axis -OutList['RootMyb2'] = True # (kN m); Blade 2 flapwise moment (i.e., the moment caused by flapwise forces) at the blade root; About the yb2-axis -OutList['RootMFlp2'] = False # (kN m); Blade 2 flapwise moment (i.e., the moment caused by flapwise forces) at the blade root; About the yb2-axis - -# Blade 3 Root Loads -OutList['RootFxc3'] = False # (kN); Blade 3 out-of-plane shear force at the blade root; Directed along the xc3-axis -OutList['RootFyc3'] = False # (kN); Blade 3 in-plane shear force at the blade root; Directed along the yc3-axis -OutList['RootFzc3'] = False # (kN); Blade 3 axial force at the blade root; Directed along the zc3- and zb3-axes -OutList['RootFzb3'] = False # (kN); Blade 3 axial force at the blade root; Directed along the zc3- and zb3-axes -OutList['RootFxb3'] = False # (kN); Blade 3 flapwise shear force at the blade root; Directed along the xb3-axis -OutList['RootFyb3'] = False # (kN); Blade 3 edgewise shear force at the blade root; Directed along the yb3-axis -OutList['RootMxc3'] = False # (kN m); Blade 3 in-plane moment (i.e., the moment caused by in-plane forces) at the blade root; About the xc3-axis -OutList['RootMIP3'] = False # (kN m); Blade 3 in-plane moment (i.e., the moment caused by in-plane forces) at the blade root; About the xc3-axis -OutList['RootMyc3'] = False # (kN m); Blade 3 out-of-plane moment (i.e., the moment caused by out-of-plane forces) at the blade root; About the yc3-axis -OutList['RootMOoP3'] = False # (kN m); Blade 3 out-of-plane moment (i.e., the moment caused by out-of-plane forces) at the blade root; About the yc3-axis -OutList['RootMzc3'] = False # (kN m); Blade 3 pitching moment at the blade root; About the zc3- and zb3-axes -OutList['RootMzb3'] = False # (kN m); Blade 3 pitching moment at the blade root; About the zc3- and zb3-axes -OutList['RootMxb3'] = False # (kN m); Blade 3 edgewise moment (i.e., the moment caused by edgewise forces) at the blade root; About the xb3-axis -OutList['RootMEdg3'] = False # (kN m); Blade 3 edgewise moment (i.e., the moment caused by edgewise forces) at the blade root; About the xb3-axis -OutList['RootMyb3'] = True # (kN m); Blade 3 flapwise moment (i.e., the moment caused by flapwise forces) at the blade root; About the yb3-axis -OutList['RootMFlp3'] = False # (kN m); Blade 3 flapwise moment (i.e., the moment caused by flapwise forces) at the blade root; About the yb3-axis - -# Blade 1 Local Span Loads -OutList['Spn1MLxb1'] = False # (kN m); Blade 1 local edgewise moment at span station 1; About the local xb1-axis -OutList['Spn1MLyb1'] = False # (kN m); Blade 1 local flapwise moment at span station 1; About the local yb1-axis -OutList['Spn1MLzb1'] = False # (kN m); Blade 1 local pitching moment at span station 1; About the local zb1-axis -OutList['Spn2MLxb1'] = False # (kN m); Blade 1 local edgewise moment at span station 2; About the local xb1-axis -OutList['Spn2MLyb1'] = False # (kN m); Blade 1 local flapwise moment at span station 2; About the local yb1-axis -OutList['Spn2MLzb1'] = False # (kN m); Blade 1 local pitching moment at span station 2; About the local zb1-axis -OutList['Spn3MLxb1'] = False # (kN m); Blade 1 local edgewise moment at span station 3; About the local xb1-axis -OutList['Spn3MLyb1'] = False # (kN m); Blade 1 local flapwise moment at span station 3; About the local yb1-axis -OutList['Spn3MLzb1'] = False # (kN m); Blade 1 local pitching moment at span station 3; About the local zb1-axis -OutList['Spn4MLxb1'] = False # (kN m); Blade 1 local edgewise moment at span station 4; About the local xb1-axis -OutList['Spn4MLyb1'] = False # (kN m); Blade 1 local flapwise moment at span station 4; About the local yb1-axis -OutList['Spn4MLzb1'] = False # (kN m); Blade 1 local pitching moment at span station 4; About the local zb1-axis -OutList['Spn5MLxb1'] = False # (kN m); Blade 1 local edgewise moment at span station 5; About the local xb1-axis -OutList['Spn5MLyb1'] = False # (kN m); Blade 1 local flapwise moment at span station 5; About the local yb1-axis -OutList['Spn5MLzb1'] = False # (kN m); Blade 1 local pitching moment at span station 5; About the local zb1-axis -OutList['Spn6MLxb1'] = False # (kN m); Blade 1 local edgewise moment at span station 6; About the local xb1-axis -OutList['Spn6MLyb1'] = False # (kN m); Blade 1 local flapwise moment at span station 6; About the local yb1-axis -OutList['Spn6MLzb1'] = False # (kN m); Blade 1 local pitching moment at span station 6; About the local zb1-axis -OutList['Spn7MLxb1'] = False # (kN m); Blade 1 local edgewise moment at span station 7; About the local xb1-axis -OutList['Spn7MLyb1'] = False # (kN m); Blade 1 local flapwise moment at span station 7; About the local yb1-axis -OutList['Spn7MLzb1'] = False # (kN m); Blade 1 local pitching moment at span station 7; About the local zb1-axis -OutList['Spn8MLxb1'] = False # (kN m); Blade 1 local edgewise moment at span station 8; About the local xb1-axis -OutList['Spn8MLyb1'] = False # (kN m); Blade 1 local flapwise moment at span station 8; About the local yb1-axis -OutList['Spn8MLzb1'] = False # (kN m); Blade 1 local pitching moment at span station 8; About the local zb1-axis -OutList['Spn9MLxb1'] = False # (kN m); Blade 1 local edgewise moment at span station 9; About the local xb1-axis -OutList['Spn9MLyb1'] = False # (kN m); Blade 1 local flapwise moment at span station 9; About the local yb1-axis -OutList['Spn9MLzb1'] = False # (kN m); Blade 1 local pitching moment at span station 9; About the local zb1-axis -OutList['Spn1FLxb1'] = False # (kN); Blade 1 local flapwise shear force at span station 1; Directed along the local xb1-axis -OutList['Spn1FLyb1'] = False # (kN); Blade 1 local edgewise shear force at span station 1; Directed along the local yb1-axis -OutList['Spn1FLzb1'] = False # (kN); Blade 1 local axial force at span station 1; Directed along the local zb1-axis -OutList['Spn2FLxb1'] = False # (kN); Blade 1 local flapwise shear force at span station 2; Directed along the local xb1-axis -OutList['Spn2FLyb1'] = False # (kN); Blade 1 local edgewise shear force at span station 2; Directed along the local yb1-axis -OutList['Spn2FLzb1'] = False # (kN); Blade 1 local axial force at span station 2; Directed along the local zb1-axis -OutList['Spn3FLxb1'] = False # (kN); Blade 1 local flapwise shear force at span station 3; Directed along the local xb1-axis -OutList['Spn3FLyb1'] = False # (kN); Blade 1 local edgewise shear force at span station 3; Directed along the local yb1-axis -OutList['Spn3FLzb1'] = False # (kN); Blade 1 local axial force at span station 3; Directed along the local zb1-axis -OutList['Spn4FLxb1'] = False # (kN); Blade 1 local flapwise shear force at span station 4; Directed along the local xb1-axis -OutList['Spn4FLyb1'] = False # (kN); Blade 1 local edgewise shear force at span station 4; Directed along the local yb1-axis -OutList['Spn4FLzb1'] = False # (kN); Blade 1 local axial force at span station 4; Directed along the local zb1-axis -OutList['Spn5FLxb1'] = False # (kN); Blade 1 local flapwise shear force at span station 5; Directed along the local xb1-axis -OutList['Spn5FLyb1'] = False # (kN); Blade 1 local edgewise shear force at span station 5; Directed along the local yb1-axis -OutList['Spn5FLzb1'] = False # (kN); Blade 1 local axial force at span station 5; Directed along the local zb1-axis -OutList['Spn6FLxb1'] = False # (kN); Blade 1 local flapwise shear force at span station 6; Directed along the local xb1-axis -OutList['Spn6FLyb1'] = False # (kN); Blade 1 local edgewise shear force at span station 6; Directed along the local yb1-axis -OutList['Spn6FLzb1'] = False # (kN); Blade 1 local axial force at span station 6; Directed along the local zb1-axis -OutList['Spn7FLxb1'] = False # (kN); Blade 1 local flapwise shear force at span station 7; Directed along the local xb1-axis -OutList['Spn7FLyb1'] = False # (kN); Blade 1 local edgewise shear force at span station 7; Directed along the local yb1-axis -OutList['Spn7FLzb1'] = False # (kN); Blade 1 local axial force at span station 7; Directed along the local zb1-axis -OutList['Spn8FLxb1'] = False # (kN); Blade 1 local flapwise shear force at span station 8; Directed along the local xb1-axis -OutList['Spn8FLyb1'] = False # (kN); Blade 1 local edgewise shear force at span station 8; Directed along the local yb1-axis -OutList['Spn8FLzb1'] = False # (kN); Blade 1 local axial force at span station 8; Directed along the local zb1-axis -OutList['Spn9FLxb1'] = False # (kN); Blade 1 local flapwise shear force at span station 9; Directed along the local xb1-axis -OutList['Spn9FLyb1'] = False # (kN); Blade 1 local edgewise shear force at span station 9; Directed along the local yb1-axis -OutList['Spn9FLzb1'] = False # (kN); Blade 1 local axial force at span station 9; Directed along the local zb1-axis - -# Blade 2 Local Span Loads -OutList['Spn1MLxb2'] = False # (kN m); Blade 2 local edgewise moment at span station 1; About the local xb2-axis -OutList['Spn1MLyb2'] = False # (kN m); Blade 2 local flapwise moment at span station 1; About the local yb2-axis -OutList['Spn1MLzb2'] = False # (kN m); Blade 2 local pitching moment at span station 1; About the local zb2-axis -OutList['Spn2MLxb2'] = False # (kN m); Blade 2 local edgewise moment at span station 2; About the local xb2-axis -OutList['Spn2MLyb2'] = False # (kN m); Blade 2 local flapwise moment at span station 2; About the local yb2-axis -OutList['Spn2MLzb2'] = False # (kN m); Blade 2 local pitching moment at span station 2; About the local zb2-axis -OutList['Spn3MLxb2'] = False # (kN m); Blade 2 local edgewise moment at span station 3; About the local xb2-axis -OutList['Spn3MLyb2'] = False # (kN m); Blade 2 local flapwise moment at span station 3; About the local yb2-axis -OutList['Spn3MLzb2'] = False # (kN m); Blade 2 local pitching moment at span station 3; About the local zb2-axis -OutList['Spn4MLxb2'] = False # (kN m); Blade 2 local edgewise moment at span station 4; About the local xb2-axis -OutList['Spn4MLyb2'] = False # (kN m); Blade 2 local flapwise moment at span station 4; About the local yb2-axis -OutList['Spn4MLzb2'] = False # (kN m); Blade 2 local pitching moment at span station 4; About the local zb2-axis -OutList['Spn5MLxb2'] = False # (kN m); Blade 2 local edgewise moment at span station 5; About the local xb2-axis -OutList['Spn5MLyb2'] = False # (kN m); Blade 2 local flapwise moment at span station 5; About the local yb2-axis -OutList['Spn5MLzb2'] = False # (kN m); Blade 2 local pitching moment at span station 5; About the local zb2-axis -OutList['Spn6MLxb2'] = False # (kN m); Blade 2 local edgewise moment at span station 6; About the local xb2-axis -OutList['Spn6MLyb2'] = False # (kN m); Blade 2 local flapwise moment at span station 6; About the local yb2-axis -OutList['Spn6MLzb2'] = False # (kN m); Blade 2 local pitching moment at span station 6; About the local zb2-axis -OutList['Spn7MLxb2'] = False # (kN m); Blade 2 local edgewise moment at span station 7; About the local xb2-axis -OutList['Spn7MLyb2'] = False # (kN m); Blade 2 local flapwise moment at span station 7; About the local yb2-axis -OutList['Spn7MLzb2'] = False # (kN m); Blade 2 local pitching moment at span station 7; About the local zb2-axis -OutList['Spn8MLxb2'] = False # (kN m); Blade 2 local edgewise moment at span station 8; About the local xb2-axis -OutList['Spn8MLyb2'] = False # (kN m); Blade 2 local flapwise moment at span station 8; About the local yb2-axis -OutList['Spn8MLzb2'] = False # (kN m); Blade 2 local pitching moment at span station 8; About the local zb2-axis -OutList['Spn9MLxb2'] = False # (kN m); Blade 2 local edgewise moment at span station 9; About the local xb2-axis -OutList['Spn9MLyb2'] = False # (kN m); Blade 2 local flapwise moment at span station 9; About the local yb2-axis -OutList['Spn9MLzb2'] = False # (kN m); Blade 2 local pitching moment at span station 9; About the local zb2-axis -OutList['Spn1FLxb2'] = False # (kN); Blade 2 local flapwise shear force at span station 1; Directed along the local xb2-axis -OutList['Spn1FLyb2'] = False # (kN); Blade 2 local edgewise shear force at span station 1; Directed along the local yb2-axis -OutList['Spn1FLzb2'] = False # (kN); Blade 2 local axial force at span station 1; Directed along the local zb2-axis -OutList['Spn2FLxb2'] = False # (kN); Blade 2 local flapwise shear force at span station 2; Directed along the local xb2-axis -OutList['Spn2FLyb2'] = False # (kN); Blade 2 local edgewise shear force at span station 2; Directed along the local yb2-axis -OutList['Spn2FLzb2'] = False # (kN); Blade 2 local axial force at span station 2; Directed along the local zb2-axis -OutList['Spn3FLxb2'] = False # (kN); Blade 2 local flapwise shear force at span station 3; Directed along the local xb2-axis -OutList['Spn3FLyb2'] = False # (kN); Blade 2 local edgewise shear force at span station 3; Directed along the local yb2-axis -OutList['Spn3FLzb2'] = False # (kN); Blade 2 local axial force at span station 3; Directed along the local zb2-axis -OutList['Spn4FLxb2'] = False # (kN); Blade 2 local flapwise shear force at span station 4; Directed along the local xb2-axis -OutList['Spn4FLyb2'] = False # (kN); Blade 2 local edgewise shear force at span station 4; Directed along the local yb2-axis -OutList['Spn4FLzb2'] = False # (kN); Blade 2 local axial force at span station 4; Directed along the local zb2-axis -OutList['Spn5FLxb2'] = False # (kN); Blade 2 local flapwise shear force at span station 5; Directed along the local xb2-axis -OutList['Spn5FLyb2'] = False # (kN); Blade 2 local edgewise shear force at span station 5; Directed along the local yb2-axis -OutList['Spn5FLzb2'] = False # (kN); Blade 2 local axial force at span station 5; Directed along the local zb2-axis -OutList['Spn6FLxb2'] = False # (kN); Blade 2 local flapwise shear force at span station 6; Directed along the local xb2-axis -OutList['Spn6FLyb2'] = False # (kN); Blade 2 local edgewise shear force at span station 6; Directed along the local yb2-axis -OutList['Spn6FLzb2'] = False # (kN); Blade 2 local axial force at span station 6; Directed along the local zb2-axis -OutList['Spn7FLxb2'] = False # (kN); Blade 2 local flapwise shear force at span station 7; Directed along the local xb2-axis -OutList['Spn7FLyb2'] = False # (kN); Blade 2 local edgewise shear force at span station 7; Directed along the local yb2-axis -OutList['Spn7FLzb2'] = False # (kN); Blade 2 local axial force at span station 7; Directed along the local zb2-axis -OutList['Spn8FLxb2'] = False # (kN); Blade 2 local flapwise shear force at span station 8; Directed along the local xb2-axis -OutList['Spn8FLyb2'] = False # (kN); Blade 2 local edgewise shear force at span station 8; Directed along the local yb2-axis -OutList['Spn8FLzb2'] = False # (kN); Blade 2 local axial force at span station 8; Directed along the local zb2-axis -OutList['Spn9FLxb2'] = False # (kN); Blade 2 local flapwise shear force at span station 9; Directed along the local xb2-axis -OutList['Spn9FLyb2'] = False # (kN); Blade 2 local edgewise shear force at span station 9; Directed along the local yb2-axis -OutList['Spn9FLzb2'] = False # (kN); Blade 2 local axial force at span station 9; Directed along the local zb2-axis - -# Blade 3 Local Span Loads -OutList['Spn1MLxb3'] = False # (kN m); Blade 3 local edgewise moment at span station 1; About the local xb3-axis -OutList['Spn1MLyb3'] = False # (kN m); Blade 3 local flapwise moment at span station 1; About the local yb3-axis -OutList['Spn1MLzb3'] = False # (kN m); Blade 3 local pitching moment at span station 1; About the local zb3-axis -OutList['Spn2MLxb3'] = False # (kN m); Blade 3 local edgewise moment at span station 2; About the local xb3-axis -OutList['Spn2MLyb3'] = False # (kN m); Blade 3 local flapwise moment at span station 2; About the local yb3-axis -OutList['Spn2MLzb3'] = False # (kN m); Blade 3 local pitching moment at span station 2; About the local zb3-axis -OutList['Spn3MLxb3'] = False # (kN m); Blade 3 local edgewise moment at span station 3; About the local xb3-axis -OutList['Spn3MLyb3'] = False # (kN m); Blade 3 local flapwise moment at span station 3; About the local yb3-axis -OutList['Spn3MLzb3'] = False # (kN m); Blade 3 local pitching moment at span station 3; About the local zb3-axis -OutList['Spn4MLxb3'] = False # (kN m); Blade 3 local edgewise moment at span station 4; About the local xb3-axis -OutList['Spn4MLyb3'] = False # (kN m); Blade 3 local flapwise moment at span station 4; About the local yb3-axis -OutList['Spn4MLzb3'] = False # (kN m); Blade 3 local pitching moment at span station 4; About the local zb3-axis -OutList['Spn5MLxb3'] = False # (kN m); Blade 3 local edgewise moment at span station 5; About the local xb3-axis -OutList['Spn5MLyb3'] = False # (kN m); Blade 3 local flapwise moment at span station 5; About the local yb3-axis -OutList['Spn5MLzb3'] = False # (kN m); Blade 3 local pitching moment at span station 5; About the local zb3-axis -OutList['Spn6MLxb3'] = False # (kN m); Blade 3 local edgewise moment at span station 6; About the local xb3-axis -OutList['Spn6MLyb3'] = False # (kN m); Blade 3 local flapwise moment at span station 6; About the local yb3-axis -OutList['Spn6MLzb3'] = False # (kN m); Blade 3 local pitching moment at span station 6; About the local zb3-axis -OutList['Spn7MLxb3'] = False # (kN m); Blade 3 local edgewise moment at span station 7; About the local xb3-axis -OutList['Spn7MLyb3'] = False # (kN m); Blade 3 local flapwise moment at span station 7; About the local yb3-axis -OutList['Spn7MLzb3'] = False # (kN m); Blade 3 local pitching moment at span station 7; About the local zb3-axis -OutList['Spn8MLxb3'] = False # (kN m); Blade 3 local edgewise moment at span station 8; About the local xb3-axis -OutList['Spn8MLyb3'] = False # (kN m); Blade 3 local flapwise moment at span station 8; About the local yb3-axis -OutList['Spn8MLzb3'] = False # (kN m); Blade 3 local pitching moment at span station 8; About the local zb3-axis -OutList['Spn9MLxb3'] = False # (kN m); Blade 3 local edgewise moment at span station 9; About the local xb3-axis -OutList['Spn9MLyb3'] = False # (kN m); Blade 3 local flapwise moment at span station 9; About the local yb3-axis -OutList['Spn9MLzb3'] = False # (kN m); Blade 3 local pitching moment at span station 9; About the local zb3-axis -OutList['Spn1FLxb3'] = False # (kN); Blade 3 local flapwise shear force at span station 1; Directed along the local xb3-axis -OutList['Spn1FLyb3'] = False # (kN); Blade 3 local edgewise shear force at span station 1; Directed along the local yb3-axis -OutList['Spn1FLzb3'] = False # (kN); Blade 3 local axial force at span station 1; Directed along the local zb3-axis -OutList['Spn2FLxb3'] = False # (kN); Blade 3 local flapwise shear force at span station 2; Directed along the local xb3-axis -OutList['Spn2FLyb3'] = False # (kN); Blade 3 local edgewise shear force at span station 2; Directed along the local yb3-axis -OutList['Spn2FLzb3'] = False # (kN); Blade 3 local axial force at span station 2; Directed along the local zb3-axis -OutList['Spn3FLxb3'] = False # (kN); Blade 3 local flapwise shear force at span station 3; Directed along the local xb3-axis -OutList['Spn3FLyb3'] = False # (kN); Blade 3 local edgewise shear force at span station 3; Directed along the local yb3-axis -OutList['Spn3FLzb3'] = False # (kN); Blade 3 local axial force at span station 3; Directed along the local zb3-axis -OutList['Spn4FLxb3'] = False # (kN); Blade 3 local flapwise shear force at span station 4; Directed along the local xb3-axis -OutList['Spn4FLyb3'] = False # (kN); Blade 3 local edgewise shear force at span station 4; Directed along the local yb3-axis -OutList['Spn4FLzb3'] = False # (kN); Blade 3 local axial force at span station 4; Directed along the local zb3-axis -OutList['Spn5FLxb3'] = False # (kN); Blade 3 local flapwise shear force at span station 5; Directed along the local xb3-axis -OutList['Spn5FLyb3'] = False # (kN); Blade 3 local edgewise shear force at span station 5; Directed along the local yb3-axis -OutList['Spn5FLzb3'] = False # (kN); Blade 3 local axial force at span station 5; Directed along the local zb3-axis -OutList['Spn6FLxb3'] = False # (kN); Blade 3 local flapwise shear force at span station 6; Directed along the local xb3-axis -OutList['Spn6FLyb3'] = False # (kN); Blade 3 local edgewise shear force at span station 6; Directed along the local yb3-axis -OutList['Spn6FLzb3'] = False # (kN); Blade 3 local axial force at span station 6; Directed along the local zb3-axis -OutList['Spn7FLxb3'] = False # (kN); Blade 3 local flapwise shear force at span station 7; Directed along the local xb3-axis -OutList['Spn7FLyb3'] = False # (kN); Blade 3 local edgewise shear force at span station 7; Directed along the local yb3-axis -OutList['Spn7FLzb3'] = False # (kN); Blade 3 local axial force at span station 7; Directed along the local zb3-axis -OutList['Spn8FLxb3'] = False # (kN); Blade 3 local flapwise shear force at span station 8; Directed along the local xb3-axis -OutList['Spn8FLyb3'] = False # (kN); Blade 3 local edgewise shear force at span station 8; Directed along the local yb3-axis -OutList['Spn8FLzb3'] = False # (kN); Blade 3 local axial force at span station 8; Directed along the local zb3-axis -OutList['Spn9FLxb3'] = False # (kN); Blade 3 local flapwise shear force at span station 9; Directed along the local xb3-axis -OutList['Spn9FLyb3'] = False # (kN); Blade 3 local edgewise shear force at span station 9; Directed along the local yb3-axis -OutList['Spn9FLzb3'] = False # (kN); Blade 3 local axial force at span station 9; Directed along the local zb3-axis +SimpleElastoDyn['BldPitch1'] = False # (deg); Blade 1 pitch angle (position); Positive towards feather about the minus zc1- and minus zb1-axes +SimpleElastoDyn['BlPitch1'] = False # (deg); Blade 1 pitch angle (position); Positive towards feather about the minus zc1- and minus zb1-axes +SimpleElastoDyn['BldPitch2'] = False # (deg); Blade 2 pitch angle (position); Positive towards feather about the minus zc2- and minus zb2-axes +SimpleElastoDyn['BlPitch2'] = False # (deg); Blade 2 pitch angle (position); Positive towards feather about the minus zc2- and minus zb2-axes +SimpleElastoDyn['BldPitch3'] = False # (deg); Blade 3 pitch angle (position); Positive towards feather about the minus zc3- and minus zb3-axes +SimpleElastoDyn['BlPitch3'] = False # (deg); Blade 3 pitch angle (position); Positive towards feather about the minus zc3- and minus zb3-axes # Hub and Rotor Loads -OutList['LSShftFxa'] = False # (kN); Low-speed shaft thrust force (this is constant along the shaft and is equivalent to the rotor thrust force); Directed along the xa- and xs-axes -OutList['LSShftFxs'] = False # (kN); Low-speed shaft thrust force (this is constant along the shaft and is equivalent to the rotor thrust force); Directed along the xa- and xs-axes -OutList['LSSGagFxa'] = False # (kN); Low-speed shaft thrust force (this is constant along the shaft and is equivalent to the rotor thrust force); Directed along the xa- and xs-axes -OutList['LSSGagFxs'] = False # (kN); Low-speed shaft thrust force (this is constant along the shaft and is equivalent to the rotor thrust force); Directed along the xa- and xs-axes -OutList['RotThrust'] = False # (kN); Low-speed shaft thrust force (this is constant along the shaft and is equivalent to the rotor thrust force); Directed along the xa- and xs-axes -OutList['LSShftFya'] = False # (kN); Rotating low-speed shaft shear force (this is constant along the shaft); Directed along the ya-axis -OutList['LSSGagFya'] = False # (kN); Rotating low-speed shaft shear force (this is constant along the shaft); Directed along the ya-axis -OutList['LSShftFza'] = False # (kN); Rotating low-speed shaft shear force (this is constant along the shaft); Directed along the za-axis -OutList['LSSGagFza'] = False # (kN); Rotating low-speed shaft shear force (this is constant along the shaft); Directed along the za-axis -OutList['LSShftFys'] = True # (kN); Nonrotating low-speed shaft shear force (this is constant along the shaft); Directed along the ys-axis -OutList['LSSGagFys'] = False # (kN); Nonrotating low-speed shaft shear force (this is constant along the shaft); Directed along the ys-axis -OutList['LSShftFzs'] = True # (kN); Nonrotating low-speed shaft shear force (this is constant along the shaft); Directed along the zs-axis -OutList['LSSGagFzs'] = False # (kN); Nonrotating low-speed shaft shear force (this is constant along the shaft); Directed along the zs-axis -OutList['LSShftMxa'] = False # (kN m); Low-speed shaft torque (this is constant along the shaft and is equivalent to the rotor torque); About the xa- and xs-axes -OutList['LSShftMxs'] = False # (kN m); Low-speed shaft torque (this is constant along the shaft and is equivalent to the rotor torque); About the xa- and xs-axes -OutList['LSSGagMxa'] = False # (kN m); Low-speed shaft torque (this is constant along the shaft and is equivalent to the rotor torque); About the xa- and xs-axes -OutList['LSSGagMxs'] = False # (kN m); Low-speed shaft torque (this is constant along the shaft and is equivalent to the rotor torque); About the xa- and xs-axes -OutList['RotTorq'] = False # (kN m); Low-speed shaft torque (this is constant along the shaft and is equivalent to the rotor torque); About the xa- and xs-axes -OutList['LSShftTq'] = False # (kN m); Low-speed shaft torque (this is constant along the shaft and is equivalent to the rotor torque); About the xa- and xs-axes -OutList['LSSTipMya'] = False # (kN m); Rotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader); About the ya-axis -OutList['LSSTipMza'] = False # (kN m); Rotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader); About the za-axis -OutList['LSSTipMys'] = True # (kN m); Nonrotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader); About the ys-axis -OutList['LSSTipMzs'] = True # (kN m); Nonrotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader); About the zs-axis -OutList['CThrstAzm'] = False # (deg); Azimuth location of the center of thrust. This is estimated using values of LSSTipMys, LSSTipMzs, and RotThrust.; About the xa- and xs-axes -OutList['CThrstRad'] = False # (-); Dimensionless radial (arm) location of the center of thrust. This is estimated using values of LSSTipMys, LSSTipMzs, and RotThrust. (nondimensionalized using the undeflected tip radius normal to the shaft and limited to values between 0 and 1 (inclusive)); Always positive (directed radially outboard at azimuth angle CThrstAzm) -OutList['CThrstArm'] = False # (-); Dimensionless radial (arm) location of the center of thrust. This is estimated using values of LSSTipMys, LSSTipMzs, and RotThrust. (nondimensionalized using the undeflected tip radius normal to the shaft and limited to values between 0 and 1 (inclusive)); Always positive (directed radially outboard at azimuth angle CThrstAzm) -OutList['RotPwr'] = False # (kW); Rotor power (this is equivalent to the low-speed shaft power); N/A -OutList['LSShftPwr'] = False # (kW); Rotor power (this is equivalent to the low-speed shaft power); N/A -OutList['RotCq'] = False # (-); Rotor torque coefficient (this is equivalent to the low-speed shaft torque coefficient); N/A -OutList['LSShftCq'] = False # (-); Rotor torque coefficient (this is equivalent to the low-speed shaft torque coefficient); N/A -OutList['RotCp'] = False # (-); Rotor power coefficient (this is equivalent to the low-speed shaft power coefficient); N/A -OutList['LSShftCp'] = False # (-); Rotor power coefficient (this is equivalent to the low-speed shaft power coefficient); N/A -OutList['RotCt'] = False # (-); Rotor thrust coefficient (this is equivalent to the low-speed shaft thrust coefficient); N/A -OutList['LSShftCt'] = False # (-); Rotor thrust coefficient (this is equivalent to the low-speed shaft thrust coefficient); N/A - -# Shaft Strain Gage Loads -OutList['LSSGagMya'] = False # (kN m); Rotating low-speed shaft bending moment at the shaft's strain gage (shaft strain gage located by input ShftGagL); About the ya-axis -OutList['LSSGagMza'] = False # (kN m); Rotating low-speed shaft bending moment at the shaft's strain gage (shaft strain gage located by input ShftGagL); About the za-axis -OutList['LSSGagMys'] = False # (kN m); Nonrotating low-speed shaft bending moment at the shaft's strain gage (shaft strain gage located by input ShftGagL); About the ys-axis -OutList['LSSGagMzs'] = False # (kN m); Nonrotating low-speed shaft bending moment at the shaft's strain gage (shaft strain gage located by input ShftGagL); About the zs-axis - -# Generator and High-Speed Shaft Loads -OutList['HSShftTq'] = False # (kN m); High-speed shaft torque (this is constant along the shaft); Same sign as LSShftTq / RotTorq / LSShftMxa / LSShftMxs / LSSGagMxa / LSSGagMxs -OutList['HSShftPwr'] = False # (kW); High-speed shaft power; Same sign as HSShftTq -OutList['HSShftCq'] = False # (-); High-speed shaft torque coefficient; N/A -OutList['HSShftCp'] = False # (-); High-speed shaft power coefficient; N/A -OutList['GenTq'] = False # (kN m); Electrical generator torque; Positive reflects power extracted and negative represents a motoring-up situation (power input) -OutList['GenPwr'] = False # (kW); Electrical generator power; Same sign as GenTq -OutList['GenCq'] = False # (-); Electrical generator torque coefficient; N/A -OutList['GenCp'] = False # (-); Electrical generator power coefficient; N/A -OutList['HSSBrTq'] = False # (kN m); High-speed shaft brake torque (i.e., the moment applied to the high-speed shaft by the brake); Always positive (indicating dissipation of power) - -# Rotor-Furl Bearing Loads -OutList['RFrlBrM'] = False # (kN m); Rotor-furl bearing moment; About the rotor-furl axis - -# Tail-Furl Bearing Loads -OutList['TFrlBrM'] = False # (kN m); Tail-furl bearing moment; About the tail-furl axis - -# Tail Fin Aerodynamic Loads -OutList['TFinAlpha'] = False # (deg); Tail fin angle of attack. This is the angle between the relative velocity of the wind-inflow at the tail fin center-of-pressure and the tail fin chordline.; About the tail fin z-axis, which is the axis in the tail fin plane normal to the chordline -OutList['TFinCLift'] = False # (-); Tail fin dimensionless lift coefficient; N/A -OutList['TFinCDrag'] = False # (-); Tail fin dimensionless drag coefficient; N/A -OutList['TFinDnPrs'] = False # (Pa); Tail fin dynamic pressure, equal to 1/2*AirDens*Vrel^2 where Vrel is the relative velocity of the wind-inflow at the tail fin center-of-pressure; N/A -OutList['TFinCPFx'] = False # (kN); Tangential aerodynamic force at the tail fin center-of-pressure; Directed along the tail fin x-axis, which is the axis along the chordline, positive towards the trailing edge -OutList['TFinCPFy'] = False # (kN); Normal aerodynamic force at the tail fin center-of-pressure; Directed along the tail fin y-axis, which is orthogonal to the tail fin plane - -# Tower-Top / Yaw Bearing Loads -OutList['YawBrFxn'] = False # (kN); Rotating (with nacelle) tower-top / yaw bearing shear force; Directed along the xn-axis -OutList['YawBrFyn'] = False # (kN); Rotating (with nacelle) tower-top / yaw bearing shear force; Directed along the yn-axis -OutList['YawBrFzn'] = False # (kN); Tower-top / yaw bearing axial force; Directed along the zn- and zp-axes -OutList['YawBrFzp'] = False # (kN); Tower-top / yaw bearing axial force; Directed along the zn- and zp-axes -OutList['YawBrFxp'] = False # (kN); Tower-top / yaw bearing fore-aft (nonrotating) shear force; Directed along the xp-axis -OutList['YawBrFyp'] = False # (kN); Tower-top / yaw bearing side-to-side (nonrotating) shear force; Directed along the yp-axis -OutList['YawBrMxn'] = False # (kN m); Rotating (with nacelle) tower-top / yaw bearing roll moment; About the xn-axis -OutList['YawBrMyn'] = False # (kN m); Rotating (with nacelle) tower-top / yaw bearing pitch moment; About the yn-axis -OutList['YawBrMzn'] = False # (kN m); Tower-top / yaw bearing yaw moment; About the zn- and zp-axes -OutList['YawBrMzp'] = False # (kN m); Tower-top / yaw bearing yaw moment; About the zn- and zp-axes -OutList['YawMom'] = False # (kN m); Tower-top / yaw bearing yaw moment; About the zn- and zp-axes -OutList['YawBrMxp'] = False # (kN m); Nonrotating tower-top / yaw bearing roll moment; About the xp-axis -OutList['YawBrMyp'] = False # (kN m); Nonrotating tower-top / yaw bearing pitch moment; About the yp-axis - -# Tower Base Loads -OutList['TwrBsFxt'] = False # (kN); Tower base fore-aft shear force; Directed along the xt-axis -OutList['TwrBsFyt'] = False # (kN); Tower base side-to-side shear force; Directed along the yt-axis -OutList['TwrBsFzt'] = False # (kN); Tower base axial force; Directed along the zt-axis -OutList['TwrBsMxt'] = False # (kN m); Tower base roll (or side-to-side) moment (i.e., the moment caused by side-to-side forces); About the xt-axis -OutList['TwrBsMyt'] = True # (kN m); Tower base pitching (or fore-aft) moment (i.e., the moment caused by fore-aft forces); About the yt-axis -OutList['TwrBsMzt'] = False # (kN m); Tower base yaw (or torsional) moment; About the zt-axis - -# Local Tower Loads -OutList['TwHt1MLxt'] = False # (kN m); Local tower roll (or side-to-side) moment of tower gage 1; About the local xt-axis -OutList['TwHt1MLyt'] = False # (kN m); Local tower pitching (or fore-aft) moment of tower gage 1; About the local yt-axis -OutList['TwHt1MLzt'] = False # (kN m); Local tower yaw (or torsional) moment of tower gage 1; About the local zt-axis -OutList['TwHt2MLxt'] = False # (kN m); Local tower roll (or side-to-side) moment of tower gage 2; About the local xt-axis -OutList['TwHt2MLyt'] = False # (kN m); Local tower pitching (or fore-aft) moment of tower gage 2; About the local yt-axis -OutList['TwHt2MLzt'] = False # (kN m); Local tower yaw (or torsional) moment of tower gage 2; About the local zt-axis -OutList['TwHt3MLxt'] = False # (kN m); Local tower roll (or side-to-side) moment of tower gage 3; About the local xt-axis -OutList['TwHt3MLyt'] = False # (kN m); Local tower pitching (or fore-aft) moment of tower gage 3; About the local yt-axis -OutList['TwHt3MLzt'] = False # (kN m); Local tower yaw (or torsional) moment of tower gage 3; About the local zt-axis -OutList['TwHt4MLxt'] = False # (kN m); Local tower roll (or side-to-side) moment of tower gage 4; About the local xt-axis -OutList['TwHt4MLyt'] = False # (kN m); Local tower pitching (or fore-aft) moment of tower gage 4; About the local yt-axis -OutList['TwHt4MLzt'] = False # (kN m); Local tower yaw (or torsional) moment of tower gage 4; About the local zt-axis -OutList['TwHt5MLxt'] = False # (kN m); Local tower roll (or side-to-side) moment of tower gage 5; About the local xt-axis -OutList['TwHt5MLyt'] = False # (kN m); Local tower pitching (or fore-aft) moment of tower gage 5; About the local yt-axis -OutList['TwHt5MLzt'] = False # (kN m); Local tower yaw (or torsional) moment of tower gage 5; About the local zt-axis -OutList['TwHt6MLxt'] = False # (kN m); Local tower roll (or side-to-side) moment of tower gage 6; About the local xt-axis -OutList['TwHt6MLyt'] = False # (kN m); Local tower pitching (or fore-aft) moment of tower gage 6; About the local yt-axis -OutList['TwHt6MLzt'] = False # (kN m); Local tower yaw (or torsional) moment of tower gage 6; About the local zt-axis -OutList['TwHt7MLxt'] = False # (kN m); Local tower roll (or side-to-side) moment of tower gage 7; About the local xt-axis -OutList['TwHt7MLyt'] = False # (kN m); Local tower pitching (or fore-aft) moment of tower gage 7; About the local yt-axis -OutList['TwHt7MLzt'] = False # (kN m); Local tower yaw (or torsional) moment of tower gage 7; About the local zt-axis -OutList['TwHt8MLxt'] = False # (kN m); Local tower roll (or side-to-side) moment of tower gage 8; About the local xt-axis -OutList['TwHt8MLyt'] = False # (kN m); Local tower pitching (or fore-aft) moment of tower gage 8; About the local yt-axis -OutList['TwHt8MLzt'] = False # (kN m); Local tower yaw (or torsional) moment of tower gage 8; About the local zt-axis -OutList['TwHt9MLxt'] = False # (kN m); Local tower roll (or side-to-side) moment of tower gage 9; About the local xt-axis -OutList['TwHt9MLyt'] = False # (kN m); Local tower pitching (or fore-aft) moment of tower gage 9; About the local yt-axis -OutList['TwHt9MLzt'] = False # (kN m); Local tower yaw (or torsional) moment of tower gage 9; About the local zt-axis -OutList['TwHt1FLxt'] = False # (kN); Local tower roll (or side-to-side) force of tower gage 1; About the local xt-axis -OutList['TwHt1FLyt'] = False # (kN); Local tower pitching (or fore-aft) force of tower gage 1; About the local yt-axis -OutList['TwHt1FLzt'] = False # (kN); Local tower yaw (or torsional) force of tower gage 1; About the local zt-axis -OutList['TwHt2FLxt'] = False # (kN); Local tower roll (or side-to-side) force of tower gage 2; About the local xt-axis -OutList['TwHt2FLyt'] = False # (kN); Local tower pitching (or fore-aft) force of tower gage 2; About the local yt-axis -OutList['TwHt2FLzt'] = False # (kN); Local tower yaw (or torsional) force of tower gage 2; About the local zt-axis -OutList['TwHt3FLxt'] = False # (kN); Local tower roll (or side-to-side) force of tower gage 3; About the local xt-axis -OutList['TwHt3FLyt'] = False # (kN); Local tower pitching (or fore-aft) force of tower gage 3; About the local yt-axis -OutList['TwHt3FLzt'] = False # (kN); Local tower yaw (or torsional) force of tower gage 3; About the local zt-axis -OutList['TwHt4FLxt'] = False # (kN); Local tower roll (or side-to-side) force of tower gage 4; About the local xt-axis -OutList['TwHt4FLyt'] = False # (kN); Local tower pitching (or fore-aft) force of tower gage 4; About the local yt-axis -OutList['TwHt4FLzt'] = False # (kN); Local tower yaw (or torsional) force of tower gage 4; About the local zt-axis -OutList['TwHt5FLxt'] = False # (kN); Local tower roll (or side-to-side) force of tower gage 5; About the local xt-axis -OutList['TwHt5FLyt'] = False # (kN); Local tower pitching (or fore-aft) force of tower gage 5; About the local yt-axis -OutList['TwHt5FLzt'] = False # (kN); Local tower yaw (or torsional) force of tower gage 5; About the local zt-axis -OutList['TwHt6FLxt'] = False # (kN); Local tower roll (or side-to-side) force of tower gage 6; About the local xt-axis -OutList['TwHt6FLyt'] = False # (kN); Local tower pitching (or fore-aft) force of tower gage 6; About the local yt-axis -OutList['TwHt6FLzt'] = False # (kN); Local tower yaw (or torsional) force of tower gage 6; About the local zt-axis -OutList['TwHt7FLxt'] = False # (kN); Local tower roll (or side-to-side) force of tower gage 7; About the local xt-axis -OutList['TwHt7FLyt'] = False # (kN); Local tower pitching (or fore-aft) force of tower gage 7; About the local yt-axis -OutList['TwHt7FLzt'] = False # (kN); Local tower yaw (or torsional) force of tower gage 7; About the local zt-axis -OutList['TwHt8FLxt'] = False # (kN); Local tower roll (or side-to-side) force of tower gage 8; About the local xt-axis -OutList['TwHt8FLyt'] = False # (kN); Local tower pitching (or fore-aft) force of tower gage 8; About the local yt-axis -OutList['TwHt8FLzt'] = False # (kN); Local tower yaw (or torsional) force of tower gage 8; About the local zt-axis -OutList['TwHt9FLxt'] = False # (kN); Local tower roll (or side-to-side) force of tower gage 9; About the local xt-axis -OutList['TwHt9FLyt'] = False # (kN); Local tower pitching (or fore-aft) force of tower gage 9; About the local yt-axis -OutList['TwHt9FLzt'] = False # (kN); Local tower yaw (or torsional) force of tower gage 9; About the local zt-axis - -# Platform Loads -OutList['PtfmFxt'] = False # (kN); Platform horizontal surge shear force; Directed along the xt-axis -OutList['PtfmFyt'] = False # (kN); Platform horizontal sway shear force; Directed along the yt-axis -OutList['PtfmFzt'] = False # (kN); Platform vertical heave force; Directed along the zt-axis -OutList['PtfmFxi'] = False # (kN); Platform horizontal surge shear force; Directed along the xi-axis -OutList['PtfmFyi'] = False # (kN); Platform horizontal sway shear force; Directed along the yi-axis -OutList['PtfmFzi'] = False # (kN); Platform vertical heave force; Directed along the zi-axis -OutList['PtfmMxt'] = False # (kN m); Platform roll tilt moment; About the xt-axis -OutList['PtfmMyt'] = False # (kN m); Platform pitch tilt moment; About the yt-axis -OutList['PtfmMzt'] = False # (kN m); Platform yaw moment; About the zt-axis -OutList['PtfmMxi'] = False # (kN m); Platform roll tilt moment; About the xi-axis -OutList['PtfmMyi'] = False # (kN m); Platform pitch tilt moment; About the yi-axis -OutList['PtfmMzi'] = False # (kN m); Platform yaw moment; About the zi-axis - -# Mooring Line Loads -OutList['Fair1Ten'] = False # (kN); ; -OutList['Fair1Ang'] = False # (deg); ; -OutList['Anch1Ten'] = False # (kN); ; -OutList['Anch1Ang'] = False # (deg); ; -OutList['Fair2Ten'] = False # (kN); ; -OutList['Fair2Ang'] = False # (deg); ; -OutList['Anch2Ten'] = False # (kN); ; -OutList['Anch2Ang'] = False # (deg); ; -OutList['Fair3Ten'] = False # (kN); ; -OutList['Fair3Ang'] = False # (deg); ; -OutList['Anch3Ten'] = False # (kN); ; -OutList['Anch3Ang'] = False # (deg); ; -OutList['Fair4Ten'] = False # (kN); ; -OutList['Fair4Ang'] = False # (deg); ; -OutList['Anch4Ten'] = False # (kN); ; -OutList['Anch4Ang'] = False # (deg); ; -OutList['Fair5Ten'] = False # (kN); ; -OutList['Fair5Ang'] = False # (deg); ; -OutList['Anch5Ten'] = False # (kN); ; -OutList['Anch5Ang'] = False # (deg); ; -OutList['Fair6Ten'] = False # (kN); ; -OutList['Fair6Ang'] = False # (deg); ; -OutList['Anch6Ten'] = False # (kN); ; -OutList['Anch6Ang'] = False # (deg); ; -OutList['Fair7Ten'] = False # (kN); ; -OutList['Fair7Ang'] = False # (deg); ; -OutList['Anch7Ten'] = False # (kN); ; -OutList['Anch7Ang'] = False # (deg); ; -OutList['Fair8Ten'] = False # (kN); ; -OutList['Fair8Ang'] = False # (deg); ; -OutList['Anch8Ten'] = False # (kN); ; -OutList['Anch8Ang'] = False # (deg); ; -OutList['Fair9Ten'] = False # (kN); ; -OutList['Fair9Ang'] = False # (deg); ; -OutList['Anch9Ten'] = False # (kN); ; -OutList['Anch9Ang'] = False # (deg); ; - -# Wave Motions -OutList['WaveElev'] = False # (m); ; -OutList['Wave1Vxi'] = False # (m/s); ; -OutList['Wave1Vyi'] = False # (m/s); ; -OutList['Wave1Vzi'] = False # (m/s); ; -OutList['Wave1Axi'] = False # (m/s^2); ; -OutList['Wave1Ayi'] = False # (m/s^2); ; -OutList['Wave1Azi'] = False # (m/s^2); ; -OutList['Wave2Vxi'] = False # (m/s); ; -OutList['Wave2Vyi'] = False # (m/s); ; -OutList['Wave2Vzi'] = False # (m/s); ; -OutList['Wave2Axi'] = False # (m/s^2); ; -OutList['Wave2Ayi'] = False # (m/s^2); ; -OutList['Wave2Azi'] = False # (m/s^2); ; -OutList['Wave3Vxi'] = False # (m/s); ; -OutList['Wave3Vyi'] = False # (m/s); ; -OutList['Wave3Vzi'] = False # (m/s); ; -OutList['Wave3Axi'] = False # (m/s^2); ; -OutList['Wave3Ayi'] = False # (m/s^2); ; -OutList['Wave3Azi'] = False # (m/s^2); ; -OutList['Wave4Vxi'] = False # (m/s); ; -OutList['Wave4Vyi'] = False # (m/s); ; -OutList['Wave4Vzi'] = False # (m/s); ; -OutList['Wave4Axi'] = False # (m/s^2); ; -OutList['Wave4Ayi'] = False # (m/s^2); ; -OutList['Wave4Azi'] = False # (m/s^2); ; -OutList['Wave5Vxi'] = False # (m/s); ; -OutList['Wave5Vyi'] = False # (m/s); ; -OutList['Wave5Vzi'] = False # (m/s); ; -OutList['Wave5Axi'] = False # (m/s^2); ; -OutList['Wave5Ayi'] = False # (m/s^2); ; -OutList['Wave5Azi'] = False # (m/s^2); ; -OutList['Wave6Vxi'] = False # (m/s); ; -OutList['Wave6Vyi'] = False # (m/s); ; -OutList['Wave6Vzi'] = False # (m/s); ; -OutList['Wave6Axi'] = False # (m/s^2); ; -OutList['Wave6Ayi'] = False # (m/s^2); ; -OutList['Wave6Azi'] = False # (m/s^2); ; -OutList['Wave7Vxi'] = False # (m/s); ; -OutList['Wave7Vyi'] = False # (m/s); ; -OutList['Wave7Vzi'] = False # (m/s); ; -OutList['Wave7Axi'] = False # (m/s^2); ; -OutList['Wave7Ayi'] = False # (m/s^2); ; -OutList['Wave7Azi'] = False # (m/s^2); ; -OutList['Wave8Vxi'] = False # (m/s); ; -OutList['Wave8Vyi'] = False # (m/s); ; -OutList['Wave8Vzi'] = False # (m/s); ; -OutList['Wave8Axi'] = False # (m/s^2); ; -OutList['Wave8Ayi'] = False # (m/s^2); ; -OutList['Wave8Azi'] = False # (m/s^2); ; -OutList['Wave9Vxi'] = False # (m/s); ; -OutList['Wave9Vyi'] = False # (m/s); ; -OutList['Wave9Vzi'] = False # (m/s); ; -OutList['Wave9Axi'] = False # (m/s^2); ; -OutList['Wave9Ayi'] = False # (m/s^2); ; -OutList['Wave9Azi'] = False # (m/s^2); ; - -# Internal Degrees of Freedom -OutList['Q_B1E1'] = False # (m); Displacement of 1st edgewise bending-mode DOF of blade 1; -OutList['Q_B2E1'] = False # (m); Displacement of 1st edgewise bending-mode DOF of blade 2; -OutList['Q_B3E1'] = False # (m); Displacement of 1st edgewise bending-mode DOF of blade 3; -OutList['Q_B1F1'] = False # (m); Displacement of 1st flapwise bending-mode DOF of blade 1; -OutList['Q_B2F1'] = False # (m); Displacement of 1st flapwise bending-mode DOF of blade 2; -OutList['Q_B3F1'] = False # (m); Displacement of 1st flapwise bending-mode DOF of blade 3; -OutList['Q_B1F2'] = False # (m); Displacement of 2nd flapwise bending-mode DOF of blade 1; -OutList['Q_B2F2'] = False # (m); Displacement of 2nd flapwise bending-mode DOF of blade 2; -OutList['Q_B3F2'] = False # (m); Displacement of 2nd flapwise bending-mode DOF of blade 3; -OutList['Q_Teet'] = False # (rad); Displacement of hub teetering DOF; -OutList['Q_DrTr'] = False # (rad); Displacement of drivetrain rotational-flexibility DOF; -OutList['Q_GeAz'] = False # (rad); Displacement of variable speed generator DOF; -OutList['Q_RFrl'] = False # (rad); Displacement of rotor-furl DOF; -OutList['Q_TFrl'] = False # (rad); Displacement of tail-furl DOF; -OutList['Q_Yaw'] = False # (rad); Displacement of nacelle yaw DOF; -OutList['Q_TFA1'] = False # (m); Displacement of 1st tower fore-aft bending mode DOF; -OutList['Q_TSS1'] = False # (m); Displacement of 1st tower side-to-side bending mode DOF; -OutList['Q_TFA2'] = False # (m); Displacement of 2nd tower fore-aft bending mode DOF; -OutList['Q_TSS2'] = False # (m); Displacement of 2nd tower side-to-side bending mode DOF; -OutList['Q_Sg'] = False # (m); Displacement of platform horizontal surge translation DOF; -OutList['Q_Sw'] = False # (m); Displacement of platform horizontal sway translation DOF; -OutList['Q_Hv'] = False # (m); Displacement of platform vertical heave translation DOF; -OutList['Q_R'] = False # (rad); Displacement of platform roll tilt rotation DOF; -OutList['Q_P'] = False # (rad); Displacement of platform pitch tilt rotation DOF; -OutList['Q_Y'] = False # (rad); Displacement of platform yaw rotation DOF; -OutList['QD_B1E1'] = False # (m/s); Velocity of 1st edgewise bending-mode DOF of blade 1; -OutList['QD_B2E1'] = False # (m/s); Velocity of 1st edgewise bending-mode DOF of blade 2; -OutList['QD_B3E1'] = False # (m/s); Velocity of 1st edgewise bending-mode DOF of blade 3; -OutList['QD_B1F1'] = False # (m/s); Velocity of 1st flapwise bending-mode DOF of blade 1; -OutList['QD_B2F1'] = False # (m/s); Velocity of 1st flapwise bending-mode DOF of blade 2; -OutList['QD_B3F1'] = False # (m/s); Velocity of 1st flapwise bending-mode DOF of blade 3; -OutList['QD_B1F2'] = False # (m/s); Velocity of 2nd flapwise bending-mode DOF of blade 1; -OutList['QD_B2F2'] = False # (m/s); Velocity of 2nd flapwise bending-mode DOF of blade 2; -OutList['QD_B3F2'] = False # (m/s); Velocity of 2nd flapwise bending-mode DOF of blade 3; -OutList['QD_Teet'] = False # (rad/s); Velocity of hub teetering DOF; -OutList['QD_DrTr'] = False # (rad/s); Velocity of drivetrain rotational-flexibility DOF; -OutList['QD_GeAz'] = False # (rad/s); Velocity of variable speed generator DOF; -OutList['QD_RFrl'] = False # (rad/s); Velocity of rotor-furl DOF; -OutList['QD_TFrl'] = False # (rad/s); Velocity of tail-furl DOF; -OutList['QD_Yaw'] = False # (rad/s); Velocity of nacelle yaw DOF; -OutList['QD_TFA1'] = False # (m/s); Velocity of 1st tower fore-aft bending mode DOF; -OutList['QD_TSS1'] = False # (m/s); Velocity of 1st tower side-to-side bending mode DOF; -OutList['QD_TFA2'] = False # (m/s); Velocity of 2nd tower fore-aft bending mode DOF; -OutList['QD_TSS2'] = False # (m/s); Velocity of 2nd tower side-to-side bending mode DOF; -OutList['QD_Sg'] = False # (m/s); Velocity of platform horizontal surge translation DOF; -OutList['QD_Sw'] = False # (m/s); Velocity of platform horizontal sway translation DOF; -OutList['QD_Hv'] = False # (m/s); Velocity of platform vertical heave translation DOF; -OutList['QD_R'] = False # (rad/s); Velocity of platform roll tilt rotation DOF; -OutList['QD_P'] = False # (rad/s); Velocity of platform pitch tilt rotation DOF; -OutList['QD_Y'] = False # (rad/s); Velocity of platform yaw rotation DOF; -OutList['QD2_B1E1'] = False # (m/s^2); Acceleration of 1st edgewise bending-mode DOF of blade 1; -OutList['QD2_B2E1'] = False # (m/s^2); Acceleration of 1st edgewise bending-mode DOF of blade 2; -OutList['QD2_B3E1'] = False # (m/s^2); Acceleration of 1st edgewise bending-mode DOF of blade 3; -OutList['QD2_B1F1'] = False # (m/s^2); Acceleration of 1st flapwise bending-mode DOF of blade 1; -OutList['QD2_B2F1'] = False # (m/s^2); Acceleration of 1st flapwise bending-mode DOF of blade 2; -OutList['QD2_B3F1'] = False # (m/s^2); Acceleration of 1st flapwise bending-mode DOF of blade 3; -OutList['QD2_B1F2'] = False # (m/s^2); Acceleration of 2nd flapwise bending-mode DOF of blade 1; -OutList['QD2_B2F2'] = False # (m/s^2); Acceleration of 2nd flapwise bending-mode DOF of blade 2; -OutList['QD2_B3F2'] = False # (m/s^2); Acceleration of 2nd flapwise bending-mode DOF of blade 3; -OutList['QD2_Teet'] = False # (rad/s^2); Acceleration of hub teetering DOF; -OutList['QD2_DrTr'] = False # (rad/s^2); Acceleration of drivetrain rotational-flexibility DOF; -OutList['QD2_GeAz'] = False # (rad/s^2); Acceleration of variable speed generator DOF; -OutList['QD2_RFrl'] = False # (rad/s^2); Acceleration of rotor-furl DOF; -OutList['QD2_TFrl'] = False # (rad/s^2); Acceleration of tail-furl DOF; -OutList['QD2_Yaw'] = False # (rad/s^2); Acceleration of nacelle yaw DOF; -OutList['QD2_TFA1'] = False # (m/s^2); Acceleration of 1st tower fore-aft bending mode DOF; -OutList['QD2_TSS1'] = False # (m/s^2); Acceleration of 1st tower side-to-side bending mode DOF; -OutList['QD2_TFA2'] = False # (m/s^2); Acceleration of 2nd tower fore-aft bending mode DOF; -OutList['QD2_TSS2'] = False # (m/s^2); Acceleration of 2nd tower side-to-side bending mode DOF; -OutList['QD2_Sg'] = False # (m/s^2); Acceleration of platform horizontal surge translation DOF; -OutList['QD2_Sw'] = False # (m/s^2); Acceleration of platform horizontal sway translation DOF; -OutList['QD2_Hv'] = False # (m/s^2); Acceleration of platform vertical heave translation DOF; -OutList['QD2_R'] = False # (rad/s^2); Acceleration of platform roll tilt rotation DOF; -OutList['QD2_P'] = False # (rad/s^2); Acceleration of platform pitch tilt rotation DOF; -OutList['QD2_Y'] = False # (rad/s^2); Acceleration of platform yaw rotation DOF; +SimpleElastoDyn['RotTorq'] = False # (kN-m); Low-speed shaft torque (this is constant along the shaft and is equivalent to the rotor torque); About the xa- and xs-axes +SimpleElastoDyn['LSShftTq'] = False # (kN-m); Low-speed shaft torque (this is constant along the shaft and is equivalent to the rotor torque); About the xa- and xs-axes +SimpleElastoDyn['RotPwr'] = False # (kW); Rotor power (this is equivalent to the low-speed shaft power); N/A +SimpleElastoDyn['LSShftPwr'] = False # (kW); Rotor power (this is equivalent to the low-speed shaft power); N/A """ Final Output Dictionary """ -Fst7Output = {} -Fst7Output['OutList'] = OutList +FstOutput = {} +FstOutput['AeroDyn'] = AeroDyn +FstOutput['BeamDyn'] = BeamDyn +FstOutput['ElastoDyn'] = ElastoDyn +FstOutput['InflowWind'] = InflowWind +FstOutput['ServoDyn'] = ServoDyn +FstOutput['HydroDyn'] = HydroDyn +FstOutput['Morison'] = Morison +FstOutput['SeaState'] = SeaState +FstOutput['SubDyn'] = SubDyn +FstOutput['WAMIT'] = WAMIT +FstOutput['AeroDyn_Nodes'] = AeroDyn_Nodes +FstOutput['BeamDyn_Nodes'] = BeamDyn_Nodes +FstOutput['ElastoDyn_Nodes'] = ElastoDyn_Nodes +FstOutput['MoorDyn'] = MoorDyn +FstOutput['ExtPtfm'] = ExtPtfm +FstOutput['AeroDisk'] = AeroDisk +FstOutput['SimpleElastoDyn'] = SimpleElastoDyn \ No newline at end of file diff --git a/openfast_python/openfast_io/FAST_writer.py b/openfast_io/openfast_io/FAST_writer.py similarity index 65% rename from openfast_python/openfast_io/FAST_writer.py rename to openfast_io/openfast_io/FAST_writer.py index 928aa68eb2..e993752f1e 100644 --- a/openfast_python/openfast_io/FAST_writer.py +++ b/openfast_io/openfast_io/FAST_writer.py @@ -6,7 +6,6 @@ import numpy as np from functools import reduce -from openfast_io.FAST_reader import InputReader_OpenFAST try: from rosco.toolbox import utilities as ROSCO_utilities @@ -16,7 +15,14 @@ def auto_format(f, var): - # Error handling for variables with 'Default' options + """ + Error handling for variables with 'Default' options + + args: + f: file object + var: variable to write to file + + """ if isinstance(var, str): f.write('{:}\n'.format(var)) elif isinstance(var, int): @@ -25,21 +31,46 @@ def auto_format(f, var): f.write('{: 2.15e}\n'.format(var)) def float_default_out(val): - # formatted float output when 'default' is an option + """ + Formatted float output when 'default' is an option + + args: + val: value to be formatted + + returns: + formatted value + """ if type(val) is float: return '{: 22f}'.format(val) else: return '{:<22}'.format(val) def int_default_out(val): - # formatted int output when 'default' is an option + """ + Formatted int output when 'default' is an option + + args: + val: value to be formatted + + returns: + formatted value + """ if type(val) is float: return '{:<22d}'.format(val) else: return '{:<22}'.format(val) -# given a list of nested dictionary keys, return the dict at that point def get_dict(vartree, branch): + """ + Given a list of nested dictionary keys, return the dictionary at that point + + args: + vartree: dictionary to search + branch: list of keys to search + + returns: + dictionary at the specified branch + """ return reduce(operator.getitem, branch, vartree) class InputWriter_OpenFAST(object): @@ -151,15 +182,22 @@ def execute(self): if not os.path.exists(self.FAST_runDirectory): os.makedirs(self.FAST_runDirectory) - self.write_ElastoDynBlade() - self.write_ElastoDynTower() - self.write_ElastoDyn() + if self.fst_vt['Fst']['CompElast'] == 3: # Simplified ElastoDyn + self.write_SimpleElastoDyn() + else: + # If elastodyn blade is being used OR if the blade file exists + if self.fst_vt['Fst']['CompElast'] == 1 or os.path.isfile(self.fst_vt['ElastoDyn']['BldFile1']): + self.write_ElastoDynBlade() + + self.write_ElastoDynTower() + self.write_ElastoDyn() # self.write_WindWnd() - self.write_InflowWind() + if self.fst_vt['Fst']['CompInflow'] == 1: + self.write_InflowWind() if self.fst_vt['Fst']['CompAero'] == 1: - self.write_AeroDyn14() + self.write_AeroDisk() elif self.fst_vt['Fst']['CompAero'] == 2: - self.write_AeroDyn15() + self.write_AeroDyn() if self.fst_vt['Fst']['CompServo'] == 1: if 'DISCON_in' in self.fst_vt and ROSCO: @@ -173,24 +211,31 @@ def execute(self): self.write_StC(TStC,self.fst_vt['ServoDyn']['TStCfiles'][i_TStC]) for i_SStC, SStC in enumerate(self.fst_vt['SStC']): self.write_StC(SStC,self.fst_vt['ServoDyn']['SStCfiles'][i_SStC]) + if self.fst_vt['ServoDyn']['VSContrl'] == 3: # user-defined from routine UserVSCont refered + self.write_spd_trq() if self.fst_vt['Fst']['CompHydro'] == 1: self.write_HydroDyn() + if self.fst_vt['Fst']['CompSeaSt'] == 1: + self.write_SeaState() if self.fst_vt['Fst']['CompSub'] == 1: self.write_SubDyn() + elif self.fst_vt['Fst']['CompSub'] == 2: + self.write_ExtPtfm() if self.fst_vt['Fst']['CompMooring'] == 1: self.write_MAP() elif self.fst_vt['Fst']['CompMooring'] == 3: self.write_MoorDyn() + if 'WaterKin' in self.fst_vt['MoorDyn']['options']: + self.write_WaterKin(os.path.join(self.FAST_runDirectory,self.fst_vt['MoorDyn']['WaterKin_file'])) - if self.fst_vt['Fst']['CompElast'] == 2: + if self.fst_vt['Fst']['CompElast'] == 2 or 'Echo' in self.fst_vt['BeamDyn']: self.write_BeamDyn() self.write_MainInput() def write_MainInput(self): - # Main FAST v8.16-v8.17 Input File - # Currently no differences between FASTv8.16 and OpenFAST. + # Main FAST Input File self.FAST_InputFileOut = os.path.join(self.FAST_runDirectory, self.FAST_namingOut+'.fst') @@ -211,10 +256,11 @@ def write_MainInput(self): f.write('{:<22} {:<11} {:}'.format(self.fst_vt['Fst']['DT_UJac'], 'DT_UJac', '- Time between calls to get Jacobians (s)\n')) f.write('{:<22} {:<11} {:}'.format(self.fst_vt['Fst']['UJacSclFact'], 'UJacSclFact', '- Scaling factor used in Jacobians (-)\n')) f.write('---------------------- FEATURE SWITCHES AND FLAGS ------------------------------\n') - f.write('{:<22} {:<11} {:}'.format(self.fst_vt['Fst']['CompElast'], 'CompElast', '- Compute structural dynamics (switch) {1=ElastoDyn; 2=ElastoDyn + BeamDyn for blades}\n')) - f.write('{:<22} {:<11} {:}'.format(self.fst_vt['Fst']['CompInflow'], 'CompInflow', '- Compute inflow wind velocities (switch) {0=still air; 1=InflowWind; 2=external from OpenFOAM}\n')) - f.write('{:<22} {:<11} {:}'.format(self.fst_vt['Fst']['CompAero'], 'CompAero', '- Compute aerodynamic loads (switch) {0=None; 1=AeroDyn v14; 2=AeroDyn v15}\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['Fst']['CompElast'], 'CompElast', '- Compute structural dynamics (switch) {1=ElastoDyn; 2=ElastoDyn + BeamDyn for blades; 3=Simplified ElastoDyn}\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['Fst']['CompInflow'], 'CompInflow', '- Compute inflow wind velocities (switch) {0=still air; 1=InflowWind; 2=external from ExtInflow}\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['Fst']['CompAero'], 'CompAero', '- Compute aerodynamic loads (switch) {0=None; 1=AeroDisk; 2=AeroDyn; 3=ExtLoads}\n')) f.write('{:<22} {:<11} {:}'.format(self.fst_vt['Fst']['CompServo'], 'CompServo', '- Compute control and electrical-drive dynamics (switch) {0=None; 1=ServoDyn}\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['Fst']['CompSeaSt'], 'CompSeaSt', '- Compute sea state information (switch) {0=None; 1=SeaState}\n')) f.write('{:<22} {:<11} {:}'.format(self.fst_vt['Fst']['CompHydro'], 'CompHydro', '- Compute hydrodynamic loads (switch) {0=None; 1=HydroDyn}\n')) f.write('{:<22} {:<11} {:}'.format(self.fst_vt['Fst']['CompSub'], 'CompSub', '- Compute sub-structural dynamics (switch) {0=None; 1=SubDyn; 2=External Platform MCKF}\n')) f.write('{:<22} {:<11} {:}'.format(self.fst_vt['Fst']['CompMooring'], 'CompMooring', '- Compute mooring system (switch) {0=None; 1=MAP++; 2=FEAMooring; 3=MoorDyn; 4=OrcaFlex}\n')) @@ -238,6 +284,7 @@ def write_MainInput(self): f.write('{:<22} {:<11} {:}'.format('"'+self.fst_vt['Fst']['InflowFile']+'"', 'InflowFile', '- Name of file containing inflow wind input parameters (quoted string)\n')) f.write('{:<22} {:<11} {:}'.format('"'+self.fst_vt['Fst']['AeroFile']+'"', 'AeroFile', '- Name of file containing aerodynamic input parameters (quoted string)\n')) f.write('{:<22} {:<11} {:}'.format('"'+self.fst_vt['Fst']['ServoFile']+'"', 'ServoFile', '- Name of file containing control and electrical-drive input parameters (quoted string)\n')) + f.write('{:<22} {:<11} {:}'.format('"'+self.fst_vt['Fst']['SeaStFile']+'"', 'SeaStFile', '- Name of file containing sea state input parameters (quoted string)\n')) f.write('{:<22} {:<11} {:}'.format('"'+self.fst_vt['Fst']['HydroFile']+'"', 'HydroFile', '- Name of file containing hydrodynamic input parameters (quoted string)\n')) f.write('{:<22} {:<11} {:}'.format('"'+self.fst_vt['Fst']['SubFile']+'"', 'SubFile', '- Name of file containing sub-structural input parameters (quoted string)\n')) f.write('{:<22} {:<11} {:}'.format('"'+self.fst_vt['Fst']['MooringFile']+'"', 'MooringFile', '- Name of file containing mooring system input parameters (quoted string)\n')) @@ -248,7 +295,7 @@ def write_MainInput(self): f.write('{:<22} {:<11} {:}'.format(self.fst_vt['Fst']['ChkptTime'], 'ChkptTime', '- Amount of time between creating checkpoint files for potential restart (s)\n')) f.write('{:<22} {:<11} {:}'.format(self.fst_vt['Fst']['DT_Out'], 'DT_Out', '- Time step for tabular output (s) (or "default")\n')) f.write('{:<22} {:<11} {:}'.format(self.fst_vt['Fst']['TStart'], 'TStart', '- Time to begin tabular output (s)\n')) - f.write('{:<22} {:<11} {:}'.format(self.fst_vt['Fst']['OutFileFmt'], 'OutFileFmt', '- Format for tabular (time-marching) output file (switch) {1: text file [.out], 2: binary file [.outb], 3: both}\n')) + f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['Fst']['OutFileFmt'], 'OutFileFmt', '- Format for tabular (time-marching) output file (switch) {1: text file [.out], 2: binary file [.outb], 3: both 1 and 2, 4: uncompressed binary [.outb], 5: both 1 and 4}\n')) f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['Fst']['TabDelim'], 'TabDelim', '- Use tab delimiters in text tabular output file? (flag) {uses spaces if false}\n')) f.write('{:<22} {:<11} {:}'.format('"'+self.fst_vt['Fst']['OutFmt']+'"', 'OutFmt', '- Format used for text tabular output, excluding the time channel. Resulting field should be 10 characters. (quoted string)\n')) f.write('---------------------- LINEARIZATION -------------------------------------------\n') @@ -266,10 +313,10 @@ def write_MainInput(self): f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['Fst']['LinOutJac'], 'LinOutJac', '- Include full Jacobians in linearization output (for debug) (flag) [unused if Linearize=False; used only if LinInputs=LinOutputs=2]\n')) f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['Fst']['LinOutMod'], 'LinOutMod', '- Write module-level linearization output files in addition to output for full system? (flag) [unused if Linearize=False]\n')) f.write('---------------------- VISUALIZATION ------------------------------------------\n') - f.write('{:<22} {:<11} {:}'.format(self.fst_vt['Fst']['WrVTK'], 'WrVTK', '- VTK visualization data output: (switch) {0=none; 1=initialization data only; 2=animation}\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['Fst']['WrVTK'], 'WrVTK', '- VTK visualization data output: (switch) {0=none; 1=initialization data only; 2=animation; 3=mode shapes}\n')) f.write('{:<22} {:<11} {:}'.format(self.fst_vt['Fst']['VTK_type'], 'VTK_type', '- Type of VTK visualization data: (switch) {1=surfaces; 2=basic meshes (lines/points); 3=all meshes (debug)} [unused if WrVTK=0]\n')) f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['Fst']['VTK_fields'], 'VTK_fields', '- Write mesh fields to VTK data files? (flag) {true/false} [unused if WrVTK=0]\n')) - f.write('{:<22} {:<11} {:}'.format(self.fst_vt['Fst']['VTK_fps'], 'VTK_fps', '- Frame rate for VTK output (frames per second){will use closest integer multiple of DT} [used only if WrVTK=2]\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['Fst']['VTK_fps'], 'VTK_fps', '-Frame rate for VTK output (frames per second){will use closest integer multiple of DT} [used only if WrVTK=2 or WrVTK=3]\n')) f.flush() os.fsync(f) @@ -281,14 +328,14 @@ def write_ElastoDyn(self): ed_file = os.path.join(self.FAST_runDirectory,self.fst_vt['Fst']['EDFile']) f = open(ed_file, 'w') - f.write('------- ELASTODYN v1.03.* INPUT FILE -------------------------------------------\n') + f.write('------- ELASTODYN INPUT FILE -------------------------------------------\n') f.write('Generated with OpenFAST_IO\n') # ElastoDyn Simulation Control (ed_sim_ctrl) f.write('---------------------- SIMULATION CONTROL --------------------------------------\n') f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['ElastoDyn']['Echo'], 'Echo', '- Echo input data to ".ech" (flag)\n')) f.write('{:<22} {:<11} {:}'.format(self.fst_vt['ElastoDyn']['Method'], 'Method', '- Integration method: {1: RK4, 2: AB4, or 3: ABM4} (-)\n')) - f.write('{:<22} {:<11} {:}'.format(self.fst_vt['ElastoDyn']['DT'], 'DT', 'Integration time step (s)\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['ElastoDyn']['DT'], 'DT', '- Integration time step (s)\n')) f.write('---------------------- DEGREES OF FREEDOM --------------------------------------\n') f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['ElastoDyn']['FlapDOF1'], 'FlapDOF1', '- First flapwise blade mode DOF (flag)\n')) f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['ElastoDyn']['FlapDOF2'], 'FlapDOF2', '- Second flapwise blade mode DOF (flag)\n')) @@ -346,12 +393,12 @@ def write_ElastoDyn(self): f.write('{:<22} {:<11} {:}'.format(self.fst_vt['ElastoDyn']['NcIMUyn'], 'NcIMUyn', '- Lateral distance from the tower-top to the nacelle IMU (meters)\n')) f.write('{:<22} {:<11} {:}'.format(self.fst_vt['ElastoDyn']['NcIMUzn'], 'NcIMUzn', '- Vertical distance from the tower-top to the nacelle IMU (meters)\n')) f.write('{:<22} {:<11} {:}'.format(self.fst_vt['ElastoDyn']['Twr2Shft'], 'Twr2Shft', '- Vertical distance from the tower-top to the rotor shaft (meters)\n')) - f.write('{:<22} {:<11} {:}'.format(self.fst_vt['ElastoDyn']['TowerHt'], 'TowerHt', '- Height of tower above ground level [onshore] or MSL [offshore] (meters)\n')) - f.write('{:<22} {:<11} {:}'.format(self.fst_vt['ElastoDyn']['TowerBsHt'], 'TowerBsHt', '- Height of tower base above ground level [onshore] or MSL [offshore] (meters)\n')) - f.write('{:<22} {:<11} {:}'.format(self.fst_vt['ElastoDyn']['PtfmCMxt'], 'PtfmCMxt', '- Downwind distance from the ground level [onshore] or MSL [offshore] to the platform CM (meters)\n')) - f.write('{:<22} {:<11} {:}'.format(self.fst_vt['ElastoDyn']['PtfmCMyt'], 'PtfmCMyt', '- Lateral distance from the ground level [onshore] or MSL [offshore] to the platform CM (meters)\n')) - f.write('{:<22} {:<11} {:}'.format(self.fst_vt['ElastoDyn']['PtfmCMzt'], 'PtfmCMzt', '- Vertical distance from the ground level [onshore] or MSL [offshore] to the platform CM (meters)\n')) - f.write('{:<22} {:<11} {:}'.format(self.fst_vt['ElastoDyn']['PtfmRefzt'], 'PtfmRefzt', '- Vertical distance from the ground level [onshore] or MSL [offshore] to the platform reference point (meters)\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['ElastoDyn']['TowerHt'], 'TowerHt', '- Height of tower relative to ground level [onshore], MSL [offshore wind or floating MHK], or seabed [fixed MHK] (meters)\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['ElastoDyn']['TowerBsHt'], 'TowerBsHt', '- Height of tower base relative to ground level [onshore], MSL [offshore wind or floating MHK], or seabed [fixed MHK] (meters)\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['ElastoDyn']['PtfmCMxt'], 'PtfmCMxt', '- Downwind distance from the ground level [onshore], MSL [offshore wind or floating MHK], or seabed [fixed MHK] to the platform CM (meters)\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['ElastoDyn']['PtfmCMyt'], 'PtfmCMyt', '- Lateral distance from the ground level [onshore], MSL [offshore wind or floating MHK], or seabed [fixed MHK] to the platform CM (meters)\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['ElastoDyn']['PtfmCMzt'], 'PtfmCMzt', '- Vertical distance from the ground level [onshore], MSL [offshore wind or floating MHK], or seabed [fixed MHK] to the platform CM (meters)\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['ElastoDyn']['PtfmRefzt'], 'PtfmRefzt', '- Vertical distance from the ground level [onshore], MSL [offshore wind or floating MHK], or seabed [fixed MHK] to the platform reference point (meters)\n')) f.write('---------------------- MASS AND INERTIA ----------------------------------------\n') f.write('{:<22} {:<11} {:}'.format(self.fst_vt['ElastoDyn']['TipMass(1)'], 'TipMass(1)', '- Tip-brake mass, blade 1 (kg)\n')) f.write('{:<22} {:<11} {:}'.format(self.fst_vt['ElastoDyn']['TipMass(2)'], 'TipMass(2)', '- Tip-brake mass, blade 2 (kg)\n')) @@ -366,11 +413,14 @@ def write_ElastoDyn(self): f.write('{:<22} {:<11} {:}'.format(self.fst_vt['ElastoDyn']['PtfmRIner'], 'PtfmRIner', '- Platform inertia for roll tilt rotation about the platform CM (kg m^2)\n')) f.write('{:<22} {:<11} {:}'.format(self.fst_vt['ElastoDyn']['PtfmPIner'], 'PtfmPIner', '- Platform inertia for pitch tilt rotation about the platform CM (kg m^2)\n')) f.write('{:<22} {:<11} {:}'.format(self.fst_vt['ElastoDyn']['PtfmYIner'], 'PtfmYIner', '- Platform inertia for yaw rotation about the platform CM (kg m^2)\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['ElastoDyn']['PtfmXYIner'], 'PtfmXYIner', '- Platform xy moment of inertia about the platform CM (=-int(xydm)) (kg m^2)\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['ElastoDyn']['PtfmYZIner'], 'PtfmYZIner', '- Platform yz moment of inertia about the platform CM (=-int(yzdm)) (kg m^2)\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['ElastoDyn']['PtfmXZIner'], 'PtfmXZIner', '- Platform xz moment of inertia about the platform CM (=-int(xzdm)) (kg m^2)\n')) f.write('---------------------- BLADE ---------------------------------------------------\n') f.write('{:<22} {:<11} {:}'.format(self.fst_vt['ElastoDyn']['BldNodes'], 'BldNodes', '- Number of blade nodes (per blade) used for analysis (-)\n')) - f.write('{:<22} {:<11} {:}'.format('"'+self.fst_vt['ElastoDyn']['BldFile1']+'"', 'BldFile1', '- Name of file containing properties for blade 1 (quoted string)\n')) - f.write('{:<22} {:<11} {:}'.format('"'+self.fst_vt['ElastoDyn']['BldFile2']+'"', 'BldFile2', '- Name of file containing properties for blade 2 (quoted string)\n')) - f.write('{:<22} {:<11} {:}'.format('"'+self.fst_vt['ElastoDyn']['BldFile3']+'"', 'BldFile3', '- Name of file containing properties for blade 3 (quoted string) [unused for 2 blades]\n')) + f.write('{:<22} {:<11} {:}'.format('"'+self.fst_vt['ElastoDyn']['BldFile1']+'"', 'BldFile(1)', '- Name of file containing properties for blade 1 (quoted string)\n')) + f.write('{:<22} {:<11} {:}'.format('"'+self.fst_vt['ElastoDyn']['BldFile2']+'"', 'BldFile(2)', '- Name of file containing properties for blade 2 (quoted string)\n')) + f.write('{:<22} {:<11} {:}'.format('"'+self.fst_vt['ElastoDyn']['BldFile3']+'"', 'BldFile(3)', '- Name of file containing properties for blade 3 (quoted string) [unused for 2 blades]\n')) f.write('---------------------- ROTOR-TEETER --------------------------------------------\n') f.write('{:<22} {:<11} {:}'.format(self.fst_vt['ElastoDyn']['TeetMod'], 'TeetMod', '- Rotor-teeter spring/damper model {0: none, 1: standard, 2: user-defined from routine UserTeet} (switch) [unused for 3 blades]\n')) f.write('{:<22} {:<11} {:}'.format(self.fst_vt['ElastoDyn']['TeetDmpP'], 'TeetDmpP', '- Rotor-teeter damper position (degrees) [used only for 2 blades and when TeetMod=1]\n')) @@ -380,6 +430,17 @@ def write_ElastoDyn(self): f.write('{:<22} {:<11} {:}'.format(self.fst_vt['ElastoDyn']['TeetHStP'], 'TeetHStP', '- Rotor-teeter hard-stop position (degrees) [used only for 2 blades and when TeetMod=1]\n')) f.write('{:<22} {:<11} {:}'.format(self.fst_vt['ElastoDyn']['TeetSSSp'], 'TeetSSSp', '- Rotor-teeter soft-stop linear-spring constant (N-m/rad) [used only for 2 blades and when TeetMod=1]\n')) f.write('{:<22} {:<11} {:}'.format(self.fst_vt['ElastoDyn']['TeetHSSp'], 'TeetHSSp', '- Rotor-teeter hard-stop linear-spring constant (N-m/rad) [used only for 2 blades and when TeetMod=1]\n')) + f.write('---------------------- YAW-FRICTION --------------------------------------------\n') + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['ElastoDyn']['YawFrctMod'], 'YawFrctMod', '- Yaw-friction model {0: none, 1: friction independent of yaw-bearing force and bending moment, 2: friction with Coulomb terms depending on yaw-bearing force and bending moment, 3: user defined model} (switch)\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['ElastoDyn']['M_CSmax'], 'M_CSmax', '- Maximum static Coulomb friction torque (N-m) [M_CSmax when YawFrctMod=1; |Fz|*M_CSmax when YawFrctMod=2 and Fz<0]\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['ElastoDyn']['M_FCSmax'], 'M_FCSmax', '- Maximum static Coulomb friction torque proportional to yaw bearing shear force (N-m) [sqrt(Fx^2+Fy^2)*M_FCSmax; only used when YawFrctMod=2]\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['ElastoDyn']['M_MCSmax'], 'M_MCSmax', '- Maximum static Coulomb friction torque proportional to yaw bearing bending moment (N-m) [sqrt(Mx^2+My^2)*M_MCSmax; only used when YawFrctMod=2]\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['ElastoDyn']['M_CD'], 'M_CD', '- Dynamic Coulomb friction moment (N-m) [M_CD when YawFrctMod=1; |Fz|*M_CD when YawFrctMod=2 and Fz<0]\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['ElastoDyn']['M_FCD'], 'M_FCD', '- Dynamic Coulomb friction moment proportional to yaw bearing shear force (N-m) [sqrt(Fx^2+Fy^2)*M_FCD; only used when YawFrctMod=2]\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['ElastoDyn']['M_MCD'], 'M_MCD', '- Dynamic Coulomb friction moment proportional to yaw bearing bending moment (N-m) [sqrt(Mx^2+My^2)*M_MCD; only used when YawFrctMod=2]\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['ElastoDyn']['sig_v'], 'sig_v', '- Linear viscous friction coefficient (N-m/(rad/s))\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['ElastoDyn']['sig_v2'], 'sig_v2', '- Quadratic viscous friction coefficient (N-m/(rad/s)^2)\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['ElastoDyn']['OmgCut'], 'OmgCut', '- Yaw angular velocity cutoff below which viscous friction is linearized (rad/s)\n')) f.write('---------------------- DRIVETRAIN ----------------------------------------------\n') f.write('{:<22} {:<11} {:}'.format(self.fst_vt['ElastoDyn']['GBoxEff'], 'GBoxEff', '- Gearbox efficiency (%)\n')) f.write('{:<22} {:<11} {:}'.format(self.fst_vt['ElastoDyn']['GBRatio'], 'GBRatio', '- Gearbox ratio (-)\n')) @@ -400,12 +461,12 @@ def write_ElastoDyn(self): f.write('{:<22} {:<11} {:}'.format(self.fst_vt['ElastoDyn']['DecFact'], 'DecFact', '- Decimation factor for tabular output {1: output every time step} (-) (currently unused)\n')) f.write('{:<22} {:<11} {:}'.format(self.fst_vt['ElastoDyn']['NTwGages'], 'NTwGages', '- Number of tower nodes that have strain gages for output [0 to 9] (-)\n')) if self.fst_vt['ElastoDyn']['TwrGagNd'] != 0: - f.write('{:<22} {:<11} {:}'.format(', '.join(['%d'%i for i in self.fst_vt['ElastoDyn']['TwrGagNd']]), 'TwrGagNd', '- List of tower nodes that have strain gages [1 to TwrNodes] (-) [unused if NTwGages=0]\n')) + f.write('{:<22} {:<11} {:}'.format(', '.join(['%d'%int(i) for i in self.fst_vt['ElastoDyn']['TwrGagNd']]), 'TwrGagNd', '- List of tower nodes that have strain gages [1 to TwrNodes] (-) [unused if NTwGages=0]\n')) else: f.write('{:<22} {:<11} {:}'.format('', 'TwrGagNd', '- List of tower nodes that have strain gages [1 to TwrNodes] (-) [unused if NTwGages=0]\n')) f.write('{:<22} {:<11} {:}'.format(self.fst_vt['ElastoDyn']['NBlGages'], 'NBlGages', '- Number of blade nodes that have strain gages for output [0 to 9] (-)\n')) if self.fst_vt['ElastoDyn']['BldGagNd'] != 0: - f.write('{:<22} {:<11} {:}'.format(', '.join(['%d'%i for i in self.fst_vt['ElastoDyn']['BldGagNd']]), 'BldGagNd', '- List of blade nodes that have strain gages [1 to BldNodes] (-) [unused if NBlGages=0]\n')) + f.write('{:<22} {:<11} {:}'.format(', '.join(['%d'%int(i) for i in self.fst_vt['ElastoDyn']['BldGagNd']]), 'BldGagNd', '- List of blade nodes that have strain gages [1 to BldNodes] (-) [unused if NBlGages=0]\n')) else: f.write('{:<22} {:<11} {:}'.format('', 'BldGagNd', '- List of blade nodes that have strain gages [1 to BldNodes] (-) [unused if NBlGages=0]\n')) f.write(' OutList - The next line(s) contains a list of output parameters. See OutListParameters.xlsx for a listing of available output channels, (-)\n') @@ -416,11 +477,11 @@ def write_ElastoDyn(self): for i in range(len(channel_list)): f.write('"' + channel_list[i] + '"\n') - f.write('END of input file (the word "END" must appear in the first 3 columns of this last OutList line)\n') + f.write('END of OutList section (the word "END" must appear in the first 3 columns of the last OutList line)\n') # Optional nodal output section if 'BldNd_BladesOut' in self.fst_vt['ElastoDyn']: - f.write('====== Outputs for all blade stations (same ending as above for B1N1.... =========================== [optional section]\n') + f.write('====== Outputs for all blade stations (same ending as above for Spn1.... =========================== [optional section]\n') f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['ElastoDyn']['BldNd_BladesOut'], 'BldNd_BladesOut', '- Number of blades to output all node information at. Up to number of blades on turbine. (-)\n')) f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['ElastoDyn']['BldNd_BlOutNd'], 'BldNd_BlOutNd', '- Future feature will allow selecting a portion of the nodes to output. Not implemented yet. (-)\n')) f.write(' OutList - The next line(s) contains a list of output parameters. See OutListParameters.xlsx, ElastoDyn_Nodes tab for a listing of available output channels, (-)\n') @@ -429,31 +490,82 @@ def write_ElastoDyn(self): for opt_channel_list in opt_outlist: for i in range(len(opt_channel_list)): f.write('"' + opt_channel_list[i] + '"\n') - f.write('END of input file (the word "END" must appear in the first 3 columns of this last OutList line)\n') + f.write('END (the word "END" must appear in the first 3 columns of this last OutList line in the optional nodal output section)\n') f.write('---------------------------------------------------------------------------------------\n') f.flush() os.fsync(f) f.close() + def write_SimpleElastoDyn(self): + # Write the simple ElastoDyn file + + self.fst_vt['Fst']['EDFile'] = self.FAST_namingOut + '_SimpleElastoDyn.dat' + sed_file = os.path.join(self.FAST_runDirectory,self.fst_vt['Fst']['EDFile']) + f = open(sed_file, 'w') + + f.write('------- SIMPLIFIED ELASTODYN INPUT FILE ----------------------------------------\n') + f.write('Generated with OpenFAST_IO\n') + f.write('---------------------- SIMULATION CONTROL --------------------------------------\n') + f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['SimpleElastoDyn']['Echo'], 'Echo', '- Echo input data to ".ech" (flag)\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['SimpleElastoDyn']['IntMethod'], 'IntMethod', '- Integration method: {1: RK4, 2: AB4, or 3: ABM4} (-)\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['SimpleElastoDyn']['DT'], 'DT', '- Integration time step (s)\n')) + f.write('---------------------- DEGREES OF FREEDOM --------------------------------------\n') + f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['SimpleElastoDyn']['GenDOF'], 'GenDOF', '- Generator DOF (flag)\n')) + f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['SimpleElastoDyn']['YawDOF'], 'YawDOF', '- Yaw degree of freedom -- controlled by controller (flag)\n')) + f.write('---------------------- INITIAL CONDITIONS --------------------------------------\n') + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['SimpleElastoDyn']['Azimuth'], 'Azimuth', '- Initial azimuth angle for blades (degrees)\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['SimpleElastoDyn']['BlPitch'], 'BlPitch', '- Blades initial pitch (degrees)\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['SimpleElastoDyn']['RotSpeed'], 'RotSpeed', '- Initial or fixed rotor speed (rpm)\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['SimpleElastoDyn']['NacYaw'], 'NacYaw', '- Initial or fixed nacelle-yaw angle (degrees)\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['SimpleElastoDyn']['PtfmPitch'], 'PtfmPitch', '- Fixed pitch tilt rotational displacement of platform (degrees)\n')) + f.write('---------------------- TURBINE CONFIGURATION -----------------------------------\n') + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['SimpleElastoDyn']['NumBl'], 'NumBl', '- Number of blades (-)\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['SimpleElastoDyn']['TipRad'], 'TipRad', '- The distance from the rotor apex to the blade tip (meters)\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['SimpleElastoDyn']['HubRad'], 'HubRad', '- The distance from the rotor apex to the blade root (meters)\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['SimpleElastoDyn']['PreCone'], 'PreCone', '- Blades cone angle (degrees)\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['SimpleElastoDyn']['OverHang'], 'OverHang', '- Distance from yaw axis to rotor apex [3 blades] or teeter pin [2 blades] (meters)\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['SimpleElastoDyn']['ShftTilt'], 'ShftTilt', '- Rotor shaft tilt angle (degrees)\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['SimpleElastoDyn']['Twr2Shft'], 'Twr2Shft', '- Vertical distance from the tower-top to the rotor shaft (meters)\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['SimpleElastoDyn']['TowerHt'], 'TowerHt', '- Height of tower above ground level [onshore] or MSL [offshore] (meters)\n')) + f.write('---------------------- MASS AND INERTIA ----------------------------------------\n') + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['SimpleElastoDyn']['RotIner'], 'RotIner', '- Rot inertia about rotor axis [blades + hub] (kg m^2)\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['SimpleElastoDyn']['GenIner'], 'GenIner', '- Generator inertia about HSS (kg m^2)\n')) + f.write('---------------------- DRIVETRAIN ----------------------------------------------\n') + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['SimpleElastoDyn']['GBoxRatio'], 'GBoxRatio', '- Gearbox ratio (-)\n')) + f.write('---------------------- OUTPUT --------------------------------------------------\n') + f.write(' OutList - The next line(s) contains a list of output parameters. See OutListParameters.xlsx for a listing of available output channels, (-)\n') + + outlist = self.get_outlist(self.fst_vt['outlist'], ['SimpleElastoDyn']) + for channel_list in outlist: + for i in range(len(channel_list)): + f.write('"' + channel_list[i] + '"\n') + + f.write('END of input file (the word "END" must appear in the first 3 columns of the last OutList line)\n') + f.write('---------------------------------------------------------------------------------------\n') + + f.flush() + os.fsync(f) + f.close() + def write_ElastoDynBlade(self): self.fst_vt['ElastoDyn']['BldFile1'] = self.FAST_namingOut + '_ElastoDyn_blade.dat' - self.fst_vt['ElastoDyn']['BldFile2'] = self.fst_vt['ElastoDyn']['BldFile1'] + self.fst_vt['ElastoDyn']['BldFile2'] = self.fst_vt['ElastoDyn']['BldFile1'] # TODO: have the possibility of different blade files self.fst_vt['ElastoDyn']['BldFile3'] = self.fst_vt['ElastoDyn']['BldFile1'] blade_file = os.path.join(self.FAST_runDirectory,self.fst_vt['ElastoDyn']['BldFile1']) f = open(blade_file, 'w') - f.write('------- ELASTODYN V1.00.* INDIVIDUAL BLADE INPUT FILE --------------------------\n') + f.write('------- ELASTODYN INDIVIDUAL BLADE INPUT FILE --------------------------\n') f.write('Generated with OpenFAST_IO\n') f.write('---------------------- BLADE PARAMETERS ----------------------------------------\n') f.write('{:<22} {:<11} {:}'.format(self.fst_vt['ElastoDynBlade']['NBlInpSt'], 'NBlInpSt', '- Number of blade input stations (-)\n')) - f.write('{:<22} {:<11} {:}'.format(self.fst_vt['ElastoDynBlade']['BldFlDmp1'], 'BldFlDmp1', '- Blade flap mode #1 structural damping in percent of critical (%)\n')) - f.write('{:<22} {:<11} {:}'.format(self.fst_vt['ElastoDynBlade']['BldFlDmp2'], 'BldFlDmp2', '- Blade flap mode #2 structural damping in percent of critical (%)\n')) - f.write('{:<22} {:<11} {:}'.format(self.fst_vt['ElastoDynBlade']['BldEdDmp1'], 'BldEdDmp1', '- Blade edge mode #1 structural damping in percent of critical (%)\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['ElastoDynBlade']['BldFlDmp1'], 'BldFlDmp(1)', '- Blade flap mode #1 structural damping in percent of critical (%)\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['ElastoDynBlade']['BldFlDmp2'], 'BldFlDmp(2)', '- Blade flap mode #2 structural damping in percent of critical (%)\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['ElastoDynBlade']['BldEdDmp1'], 'BldEdDmp(1)', '- Blade edge mode #1 structural damping in percent of critical (%)\n')) f.write('---------------------- BLADE ADJUSTMENT FACTORS --------------------------------\n') - f.write('{:<22} {:<11} {:}'.format(self.fst_vt['ElastoDynBlade']['FlStTunr1'], 'FlStTunr1', '- Blade flapwise modal stiffness tuner, 1st mode (-)\n')) - f.write('{:<22} {:<11} {:}'.format(self.fst_vt['ElastoDynBlade']['FlStTunr2'], 'FlStTunr2', '- Blade flapwise modal stiffness tuner, 2nd mode (-)\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['ElastoDynBlade']['FlStTunr1'], 'FlStTunr(1)', '- Blade flapwise modal stiffness tuner, 1st mode (-)\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['ElastoDynBlade']['FlStTunr2'], 'FlStTunr(2)', '- Blade flapwise modal stiffness tuner, 2nd mode (-)\n')) f.write('{:<22} {:<11} {:}'.format(self.fst_vt['ElastoDynBlade']['AdjBlMs'], 'AdjBlMs', '- Factor to adjust blade mass density (-)\n')) f.write('{:<22} {:<11} {:}'.format(self.fst_vt['ElastoDynBlade']['AdjFlSt'], 'AdjFlSt', '- Factor to adjust blade flap stiffness (-)\n')) f.write('{:<22} {:<11} {:}'.format(self.fst_vt['ElastoDynBlade']['AdjEdSt'], 'AdjEdSt', '- Factor to adjust blade edge stiffness (-)\n')) @@ -495,7 +607,7 @@ def write_ElastoDynTower(self): tower_file = os.path.join(self.FAST_runDirectory,self.fst_vt['ElastoDyn']['TwrFile']) f = open(tower_file, 'w') - f.write('------- ELASTODYN V1.00.* TOWER INPUT FILE -------------------------------------\n') + f.write('------- ELASTODYN TOWER INPUT FILE -------------------------------------\n') f.write('Generated with OpenFAST_IO\n') f.write('---------------------- TOWER PARAMETERS ----------------------------------------\n') f.write('{:<22} {:<11} {:}'.format(self.fst_vt['ElastoDynTower']['NTwInpSt'], 'NTwInpSt', '- Number of input stations to specify tower geometry\n')) @@ -564,19 +676,16 @@ def write_BeamDyn(self): f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['BeamDyn']['QuasiStaticInit'], 'QuasiStaticInit', '- Use quasistatic pre-conditioning with centripetal accelerations in initialization (flag) [dynamic solve only]\n')) f.write('{:<22} {:<11} {:}'.format(self.fst_vt['BeamDyn']['rhoinf'], 'rhoinf', '- Numerical damping parameter for generalized-alpha integrator\n')) f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['BeamDyn']['quadrature'], 'quadrature', '- Quadrature method: 1=Gaussian; 2=Trapezoidal (switch)\n')) - f.write('{:<22} {:<11} {:}'.format(self.fst_vt['BeamDyn']['refine'], 'refine', '- Refinement factor for trapezoidal quadrature (-). DEFAULT = 1 [used only when quadrature=2]\n')) - f.write('{:<22} {:<11} {:}'.format(self.fst_vt['BeamDyn']['n_fact'], 'n_fact', '- Factorization frequency (-). DEFAULT = 5\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['BeamDyn']['refine'], 'refine', '- Refinement factor for trapezoidal quadrature (-) [DEFAULT = 1; used only when quadrature=2]\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['BeamDyn']['n_fact'], 'n_fact', '- Factorization frequency for the Jacobian in N-R iteration(-) [DEFAULT = 5]\n')) f.write(float_default_out(self.fst_vt['BeamDyn']['DTBeam']) + ' {:<11} {:}'.format('DTBeam', '- Time step size (s).\n')) - f.write(int_default_out(self.fst_vt['BeamDyn']['load_retries']) + ' {:<11} {:}'.format('load_retries', '- Number of factored load retries before quitting the aimulation\n')) - f.write(int_default_out(self.fst_vt['BeamDyn']['NRMax']) + ' {:<11} {:}'.format('NRMax', '- Max number of iterations in Newton-Ralphson algorithm (-). DEFAULT = 10\n')) - f.write(float_default_out(self.fst_vt['BeamDyn']['stop_tol']) + ' {:<11} {:}'.format('stop_tol', '- Tolerance for stopping criterion (-)\n')) - print('----------') - print(self.fst_vt['BeamDyn']['tngt_stf_fd'], type(self.fst_vt['BeamDyn']['tngt_stf_fd'])) - - f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['BeamDyn']['tngt_stf_fd'], 'tngt_stf_fd', '- Flag to use finite differenced tangent stiffness matrix (-)\n')) - f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['BeamDyn']['tngt_stf_comp'], 'tngt_stf_comp', '- Flag to compare analytical finite differenced tangent stiffness matrix (-)\n')) - f.write(float_default_out(self.fst_vt['BeamDyn']['tngt_stf_pert']) + ' {:<11} {:}'.format('tngt_stf_pert', '- perturbation size for finite differencing (-)\n')) - f.write(float_default_out(self.fst_vt['BeamDyn']['tngt_stf_difftol']) + ' {:<11} {:}'.format('tngt_stf_difftol', '- Maximum allowable relative difference between analytical and fd tangent stiffness (-)\n')) + f.write(int_default_out(self.fst_vt['BeamDyn']['load_retries']) + ' {:<11} {:}'.format('load_retries', '- Number of factored load retries before quitting the aimulation [DEFAULT = 20]\n')) + f.write(int_default_out(self.fst_vt['BeamDyn']['NRMax']) + ' {:<11} {:}'.format('NRMax', '- Max number of iterations in Newton-Raphson algorithm (-). [DEFAULT = 10]\n')) + f.write(float_default_out(self.fst_vt['BeamDyn']['stop_tol']) + ' {:<11} {:}'.format('stop_tol', '- Tolerance for stopping criterion (-) [DEFAULT = 1E-5]\n')) + f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['BeamDyn']['tngt_stf_fd'], 'tngt_stf_fd', '- Use finite differenced tangent stiffness matrix? (flag)\n')) + f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['BeamDyn']['tngt_stf_comp'], 'tngt_stf_comp', '- Compare analytical finite differenced tangent stiffness matrix? (flag)\n')) + f.write(float_default_out(self.fst_vt['BeamDyn']['tngt_stf_pert']) + ' {:<11} {:}'.format('tngt_stf_pert', '- Perturbation size for finite differencing (-) [DEFAULT = 1E-6]\n')) + f.write(float_default_out(self.fst_vt['BeamDyn']['tngt_stf_difftol']) + ' {:<11} {:}'.format('tngt_stf_difftol', '- Maximum allowable relative difference between analytical and fd tangent stiffness (-); [DEFAULT = 0.1]\n')) f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['BeamDyn']['RotStates'], 'RotStates', '- Orient states in the rotating frame during linearization? (flag) [used only when linearizing]\n')) f.write('---------------------- GEOMETRY PARAMETER --------------------------------------\n') f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['BeamDyn']['member_total'], 'member_total', '- Total number of members (-)\n')) @@ -612,7 +721,7 @@ def write_BeamDyn(self): for channel_list in outlist: for i in range(len(channel_list)): f.write('"' + channel_list[i] + '"\n') - f.write('END of input file (the word "END" must appear in the first 3 columns of this last OutList line)\n') + f.write('END of input file (the word "END" must appear in the first 3 columns of the last OutList line)\n') # Optional nodal output section if 'BldNd_BlOutNd' in self.fst_vt['BeamDyn']: @@ -625,20 +734,13 @@ def write_BeamDyn(self): for opt_channel_list in opt_outlist: for i in range(len(opt_channel_list)): f.write('"' + opt_channel_list[i] + '"\n') - f.write('END of input file (the word "END" must appear in the first 3 columns of this last OutList line)\n') + f.write('END of input file (the word "END" must appear in the first 3 columns of the last OutList line)\n') f.write('---------------------------------------------------------------------------------------') f.flush() os.fsync(f) f.close() - # f.write('{:<22} {:<11} {:}'.format(self.fst_vt['BeamDyn'][''], '', '\n')) - # f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['BeamDyn'][''], '', '\n')) - # f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['BeamDyn'][''], '', '\n')) - # f.write('{: 2.15e} {:<11} {:}'.format(self.fst_vt['BeamDyn'][''], '', '\n')) - # f.write(float_default_out(self.fst_vt['BeamDyn']['']) + ' {:<11} {:}'.format('', '\n')) - # f.write(int_default_out(self.fst_vt['BeamDyn']['']) + ' {:<11} {:}'.format('', '\n')) - def write_BeamDynBlade(self): # bd_blade_file = self.fst_vt['BeamDyn']['BldFile'] @@ -646,7 +748,7 @@ def write_BeamDynBlade(self): bd_blade_file = os.path.abspath(os.path.join(self.FAST_runDirectory, self.fst_vt['BeamDyn']['BldFile'])) f = open(bd_blade_file, 'w') - f.write('------- BEAMDYN V1.00.* INDIVIDUAL BLADE INPUT FILE --------------------------\n') + f.write('------- BEAMDYN INDIVIDUAL BLADE INPUT FILE --------------------------\n') f.write('Generated with OpenFAST_IO\n') f.write('---------------------- BLADE PARAMETERS --------------------------------------\n') f.write('{:<22} {:<11} {:}'.format(self.fst_vt['BeamDynBlade']['station_total'], 'station_total', '- Number of blade input stations (-)\n')) @@ -670,35 +772,35 @@ def write_BeamDynBlade(self): f.write('\n') def write_InflowWind(self): - self.fst_vt['Fst']['InflowFile'] = self.FAST_namingOut + '_InflowFile.dat' + self.fst_vt['Fst']['InflowFile'] = self.FAST_namingOut + '_InflowWind.dat' inflow_file = os.path.join(self.FAST_runDirectory,self.fst_vt['Fst']['InflowFile']) f = open(inflow_file, 'w') - f.write('------- InflowWind v3.01.* INPUT FILE -------------------------------------------------------------------------\n') + f.write('------- InflowWind INPUT FILE -------------------------------------------------------------------------\n') f.write('Generated with OpenFAST_IO\n') f.write('---------------------------------------------------------------------------------------------------------------\n') f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['InflowWind']['Echo'], 'Echo', '- Echo input data to .ech (flag)\n')) f.write('{:<22} {:<11} {:}'.format(self.fst_vt['InflowWind']['WindType'], 'WindType', '- switch for wind file type (1=steady; 2=uniform; 3=binary TurbSim FF; 4=binary Bladed-style FF; 5=HAWC format; 6=User defined; 7=native Bladed FF)\n')) - f.write('{:<22} {:<11} {:}'.format(self.fst_vt['InflowWind']['PropagationDir'], 'PropagationDir', '- Direction of wind propagation (meteoroligical rotation from aligned with X (positive rotates towards -Y) -- degrees)\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['InflowWind']['PropagationDir'], 'PropagationDir', '- Direction of wind propagation (meteoroligical rotation from aligned with X (positive rotates towards -Y) -- degrees) (not used for native Bladed format WindType=7)\n')) f.write('{:<22} {:<11} {:}'.format(self.fst_vt['InflowWind']['VFlowAng'], 'VFlowAng', '- Upflow angle (degrees) (not used for native Bladed format WindType=7)\n')) f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['InflowWind']['VelInterpCubic'], 'VelInterpCubic', '- Use cubic interpolation for velocity in time (false=linear, true=cubic) [Used with WindType=2,3,4,5,7]\n')) f.write('{:<22} {:<11} {:}'.format(self.fst_vt['InflowWind']['NWindVel'], 'NWindVel', '- Number of points to output the wind velocity (0 to 9)\n')) - f.write('{:<22} {:<11} {:}'.format(self.fst_vt['InflowWind']['WindVxiList'], 'WindVxiList', '- List of coordinates in the inertial X direction (m)\n')) - f.write('{:<22} {:<11} {:}'.format(self.fst_vt['InflowWind']['WindVyiList'], 'WindVyiList', '- List of coordinates in the inertial Y direction (m)\n')) - f.write('{:<22} {:<11} {:}'.format(self.fst_vt['InflowWind']['WindVziList'], 'WindVziList', '- List of coordinates in the inertial Z direction (m)\n')) + f.write('{:<22} {:<11} {:}'.format(', '.join(self.fst_vt['InflowWind']['WindVxiList']), 'WindVxiList', '- List of coordinates in the inertial X direction (m)\n')) + f.write('{:<22} {:<11} {:}'.format(', '.join(self.fst_vt['InflowWind']['WindVyiList']), 'WindVyiList', '- List of coordinates in the inertial Y direction (m)\n')) + f.write('{:<22} {:<11} {:}'.format(', '.join(self.fst_vt['InflowWind']['WindVziList']), 'WindVziList', '- List of coordinates in the inertial Z direction (m)\n')) f.write('================== Parameters for Steady Wind Conditions [used only for WindType = 1] =========================\n') - f.write('{:<22} {:<11} {:}'.format(self.fst_vt['InflowWind']['HWindSpeed'], 'HWindSpeed', '- Horizontal windspeed (m/s)\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['InflowWind']['HWindSpeed'], 'HWindSpeed', '- Horizontal wind speed (m/s)\n')) f.write('{:<22} {:<11} {:}'.format(self.fst_vt['InflowWind']['RefHt'], 'RefHt', '- Reference height for horizontal wind speed (m)\n')) - f.write('{:<22} {:<11} {:}'.format(self.fst_vt['InflowWind']['PLexp'], 'PLexp', '- Power law exponent (-)\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['InflowWind']['PLExp'], 'PLExp', '- Power law exponent (-)\n')) f.write('================== Parameters for Uniform wind file [used only for WindType = 2] ============================\n') - f.write('{:<22} {:<11} {:}'.format('"'+self.fst_vt['InflowWind']['Filename_Uni']+'"', 'Filename_Uni', '- Filename of time series data for uniform wind field. (-)\n')) + f.write('{:<22} {:<11} {:}'.format('"'+self.fst_vt['InflowWind']['FileName_Uni']+'"', 'FileName_Uni', '- Filename of time series data for uniform wind field. (-)\n')) f.write('{:<22} {:<11} {:}'.format(self.fst_vt['InflowWind']['RefHt_Uni'], 'RefHt_Uni', '- Reference height for horizontal wind speed (m)\n')) f.write('{:<22} {:<11} {:}'.format(self.fst_vt['InflowWind']['RefLength'], 'RefLength', '- Reference length for linear horizontal and vertical sheer (-)\n')) f.write('================== Parameters for Binary TurbSim Full-Field files [used only for WindType = 3] ==============\n') f.write('{:<22} {:<11} {:}'.format('"'+self.fst_vt['InflowWind']['FileName_BTS']+'"', 'FileName_BTS', '- Name of the Full field wind file to use (.bts)\n')) - f.write('================== Parameters for Binary Bladed-style Full-Field files [used only for WindType = 4] =========\n') - f.write('{:<22} {:<11} {:}'.format('"'+self.fst_vt['InflowWind']['FilenameRoot']+'"', 'FilenameRoot', '- Rootname of the full-field wind file to use (.wnd, .sum)\n')) - f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['InflowWind']['TowerFile'], 'TowerFile', '- Have tower file (.twr) (flag)\n')) + f.write('================== Parameters for Binary Bladed-style Full-Field files [used only for WindType = 4 or WindType = 7] =========\n') + f.write('{:<22} {:<11} {:}'.format('"'+self.fst_vt['InflowWind']['FileNameRoot']+'"', 'FileNameRoot', '- WindType=4: Rootname of the full-field wind file to use (.wnd, .sum); WindType=7: name of the intermediate file with wind scaling values\n')) + f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['InflowWind']['TowerFile'], 'TowerFile', '- Have tower file (.twr) (flag) ignored when WindType = 7\n')) f.write('================== Parameters for HAWC-format binary files [Only used with WindType = 5] =====================\n') f.write('{:<22} {:<11} {:}'.format('"'+self.fst_vt['InflowWind']['FileName_u']+'"', 'FileName_u', '- name of the file containing the u-component fluctuating wind (.bin)\n')) f.write('{:<22} {:<11} {:}'.format('"'+self.fst_vt['InflowWind']['FileName_v']+'"', 'FileName_v', '- name of the file containing the v-component fluctuating wind (.bin)\n')) @@ -729,14 +831,14 @@ def write_InflowWind(self): f.write('{:<22} {:<11} {:}'.format(self.fst_vt['InflowWind']['NumPulseGate'], 'NumPulseGate', '- Number of lidar measurement gates (used when SensorType = 3)\n')) f.write('{:<22} {:<11} {:}'.format(self.fst_vt['InflowWind']['PulseSpacing'], 'PulseSpacing', '- Distance between range gates (m) (used when SensorType = 3)\n')) f.write('{:<22} {:<11} {:}'.format(self.fst_vt['InflowWind']['NumBeam'], 'NumBeam', '- Number of lidar measurement beams (0-5)(used when SensorType = 1)\n')) - f.write('{:<22} {:<11} {:}'.format(self.fst_vt['InflowWind']['FocalDistanceX'], 'FocalDistanceX', '- Focal distance co-ordinates of the lidar beam in the x direction (relative to hub height) (only first coordinate used for SensorType 2 and 3) (m)\n')) - f.write('{:<22} {:<11} {:}'.format(self.fst_vt['InflowWind']['FocalDistanceY'], 'FocalDistanceY', '- Focal distance co-ordinates of the lidar beam in the y direction (relative to hub height) (only first coordinate used for SensorType 2 and 3) (m)\n')) - f.write('{:<22} {:<11} {:}'.format(self.fst_vt['InflowWind']['FocalDistanceZ'], 'FocalDistanceZ', '- Focal distance co-ordinates of the lidar beam in the z direction (relative to hub height) (only first coordinate used for SensorType 2 and 3) (m)\n')) + f.write('{:<22} {:<11} {:}'.format(', '.join(np.array(self.fst_vt['InflowWind']['FocalDistanceX'], dtype=str)), 'FocalDistanceX', '- Focal distance co-ordinates of the lidar beam in the x direction (relative to hub height) (only first coordinate used for SensorType 2 and 3) (m)\n')) + f.write('{:<22} {:<11} {:}'.format(', '.join(np.array(self.fst_vt['InflowWind']['FocalDistanceY'], dtype=str)), 'FocalDistanceY', '- Focal distance co-ordinates of the lidar beam in the y direction (relative to hub height) (only first coordinate used for SensorType 2 and 3) (m)\n')) + f.write('{:<22} {:<11} {:}'.format(', '.join(np.array(self.fst_vt['InflowWind']['FocalDistanceZ'], dtype=str)), 'FocalDistanceZ', '- Focal distance co-ordinates of the lidar beam in the z direction (relative to hub height) (only first coordinate used for SensorType 2 and 3) (m)\n')) f.write('{:<22} {:<11} {:}'.format(', '.join(np.array(self.fst_vt['InflowWind']['RotorApexOffsetPos'], dtype=str)), 'RotorApexOffsetPos', '- Offset of the lidar from hub height (m)\n')) f.write('{:<22} {:<11} {:}'.format(self.fst_vt['InflowWind']['URefLid'], 'URefLid', '- Reference average wind speed for the lidar[m/s]\n')) f.write('{:<22} {:<11} {:}'.format(self.fst_vt['InflowWind']['MeasurementInterval'], 'MeasurementInterval', '- Time between each measurement [s]\n')) - f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['InflowWind']['LidRadialVel'], 'LidRadialVel', '- TRUE => return radial component, FALSE => return x direction estimate\n')) - f.write('{:<22} {:<11} {:}'.format(self.fst_vt['InflowWind']['ConsiderHubMotion'], 'ConsiderHubMotion', '- Flag whether to consider the hub motions impact on Lidar measurements\n')) + f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['InflowWind']['LidRadialVel'], 'LidRadialVel', '- TRUE => return radial component, FALSE => return \'x\' direction estimate\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['InflowWind']['ConsiderHubMotion'], 'ConsiderHubMotion', '- Flag whether to consider the hub motion\'s impact on Lidar measurements\n')) f.write('====================== OUTPUT ==================================================\n') f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['InflowWind']['SumPrint'], 'SumPrint', '- Print summary data to .IfW.sum (flag)\n')) f.write('OutList - The next line(s) contains a list of output parameters. See OutListParameters.xlsx for a listing of available output channels, (-)\n') @@ -746,158 +848,180 @@ def write_InflowWind(self): for i in range(len(channel_list)): f.write('"' + channel_list[i] + '"\n') - f.write('END of input file (the word "END" must appear in the first 3 columns of this last OutList line)\n') + f.write('END of input file (the word "END" must appear in the first 3 columns of the last OutList line)\n') f.write('---------------------------------------------------------------------------------------\n') f.flush() os.fsync(f) f.close() - def write_AeroDyn15(self): + def write_AeroDyn(self): # AeroDyn v15.03 # Generate AeroDyn v15 blade input file - self.write_AeroDyn15Blade() + self.write_AeroDynBlade() # Generate AeroDyn v15 polars - self.write_AeroDyn15Polar() + self.write_AeroDynPolar() # Generate AeroDyn v15 airfoil coordinates - if self.fst_vt['AeroDyn15']['af_data'][1][0]['NumCoords'] != '0': - self.write_AeroDyn15Coord() + # some polars may have airfoil coordinates, need to account for all possible scenarios + if any([self.fst_vt['AeroDyn']['af_data'][i][0]['NumCoords'] != '0' for i in range(len(self.fst_vt['AeroDyn']['af_data']))]): + af_coords = [i for i in range(len(self.fst_vt['AeroDyn']['af_data'])) if self.fst_vt['AeroDyn']['af_data'][i][0]['NumCoords'] != '0'] + self.write_AeroDynCoord(af_coords) - if self.fst_vt['AeroDyn15']['WakeMod'] == 3: - if self.fst_vt['AeroDyn15']['AFAeroMod'] == 2: - raise Exception('OLAF is called with unsteady airfoil aerodynamics, but OLAF currently only supports AFAeroMod == 1') + if self.fst_vt['AeroDyn']['Wake_Mod'] == 3: + if self.fst_vt['AeroDyn']['UA_Mod'] > 0: + raise Exception('OLAF is called with unsteady airfoil aerodynamics, but OLAF currently only supports UA_Mod == 0') #TODO: need to check if this holds true now self.write_OLAF() # Generate AeroDyn v15.03 input file - self.fst_vt['Fst']['AeroFile'] = self.FAST_namingOut + '_AeroDyn15.dat' + self.fst_vt['Fst']['AeroFile'] = self.FAST_namingOut + '_AeroDyn.dat' ad_file = os.path.join(self.FAST_runDirectory, self.fst_vt['Fst']['AeroFile']) f = open(ad_file, 'w') - f.write('------- AERODYN v15.03.* INPUT FILE ------------------------------------------------\n') + f.write('------- AERODYN15 INPUT FILE ------------------------------------------------\n') f.write('Generated with OpenFAST_IO\n') f.write('====== General Options ============================================================================\n') - f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn15']['Echo'], 'Echo', '- Echo the input to ".AD.ech"? (flag)\n')) - f.write('{:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn15']['DTAero'], 'DTAero', '- Time interval for aerodynamic calculations {or "default"} (s)\n')) - f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['AeroDyn15']['WakeMod'], 'WakeMod', '- Type of wake/induction model (switch) {0=none, 1=BEMT, 2=DBEMT, 3=OLAF} [WakeMod cannot be 2 or 3 when linearizing]\n')) - f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['AeroDyn15']['AFAeroMod'], 'AFAeroMod', '- Type of blade airfoil aerodynamics model (switch) {1=steady model, 2=Beddoes-Leishman unsteady model} [AFAeroMod must be 1 when linearizing]\n')) - f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['AeroDyn15']['TwrPotent'], 'TwrPotent', '- Type tower influence on wind based on potential flow around the tower (switch) {0=none, 1=baseline potential flow, 2=potential flow with Bak correction}\n')) - f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['AeroDyn15']['TwrShadow'], 'TwrShadow', '- Calculate tower influence on wind based on downstream tower shadow (switch) {0=none, 1=Powles model, 2=Eames model}\n')) - f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn15']['TwrAero'], 'TwrAero', '- Calculate tower aerodynamic loads? (flag)\n')) - f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn15']['FrozenWake'], 'FrozenWake', '- Assume frozen wake during linearization? (flag) [used only when WakeMod=1 and when linearizing]\n')) - f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn15']['CavitCheck'], 'CavitCheck', '- Perform cavitation check? (flag) [AFAeroMod must be 1 when CavitCheck=true]\n')) - f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn15']['Buoyancy'], 'Buoyancy', '- Include buoyancy effects? (flag)\n')) - f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn15']['CompAA'], 'CompAA', '- Flag to compute AeroAcoustics calculation [only used when WakeMod=1 or 2]\n')) - f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn15']['AA_InputFile'], 'AA_InputFile', '- AeroAcoustics input file [used only when CompAA=true]\n')) + f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn']['Echo'], 'Echo', '- Echo the input to ".AD.ech"? (flag)\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn']['DTAero'], 'DTAero', '- Time interval for aerodynamic calculations {or "default"} (s)\n')) + f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['AeroDyn']['Wake_Mod'], 'Wake_Mod', '- Wake/induction model (switch) {0=none, 1=BEMT, 3=OLAF} [Wake_Mod cannot be 2 or 3 when linearizing]\n')) + f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['AeroDyn']['TwrPotent'], 'TwrPotent', '- Type tower influence on wind based on potential flow around the tower (switch) {0=none, 1=baseline potential flow, 2=potential flow with Bak correction}\n')) + f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['AeroDyn']['TwrShadow'], 'TwrShadow', '- Calculate tower influence on wind based on downstream tower shadow (switch) {0=none, 1=Powles model, 2=Eames model}\n')) + f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn']['TwrAero'], 'TwrAero', '- Calculate tower aerodynamic loads? (flag)\n')) + f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn']['CavitCheck'], 'CavitCheck', '- Perform cavitation check? (flag) [UA_Mod must be 0 when CavitCheck=true]\n')) + f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn']['Buoyancy'], 'Buoyancy', '- Include buoyancy effects? (flag)\n')) + f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn']['NacelleDrag'], 'NacelleDrag', '- Include Nacelle Drag effects? (flag)\n')) + f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn']['CompAA'], 'CompAA', '- Flag to compute AeroAcoustics calculation [used only when Wake_Mod = 1 or 2]\n')) + f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn']['AA_InputFile'], 'AA_InputFile', '- AeroAcoustics input file [used only when CompAA=true]\n')) f.write('====== Environmental Conditions ===================================================================\n') - f.write('{:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn15']['AirDens'], 'AirDens', '- Air density (kg/m^3)\n')) - f.write('{:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn15']['KinVisc'], 'KinVisc', '- Kinematic air viscosity (m^2/s)\n')) - f.write('{:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn15']['SpdSound'], 'SpdSound', '- Speed of sound (m/s)\n')) - f.write('{:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn15']['Patm'], 'Patm', '- Atmospheric pressure (Pa) [used only when CavitCheck=True]\n')) - f.write('{:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn15']['Pvap'], 'Pvap', '- Vapour pressure of fluid (Pa) [used only when CavitCheck=True]\n')) - f.write('====== Blade-Element/Momentum Theory Options ====================================================== [unused when WakeMod=0 or 3]\n') - f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['AeroDyn15']['SkewMod'], 'SkewMod', '- Type of skewed-wake correction model (switch) {1=uncoupled, 2=Pitt/Peters, 3=coupled} [unused when WakeMod=0 or 3]\n')) - f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn15']['SkewModFactor'], 'SkewModFactor', '- Constant used in Pitt/Peters skewed wake model {or "default" is 15/32*pi} (-) [used only when SkewMod=2; unused when WakeMod=0 or 3]\n')) - f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn15']['TipLoss'], 'TipLoss', '- Use the Prandtl tip-loss model? (flag) [unused when WakeMod=0 or 3]\n')) - f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn15']['HubLoss'], 'HubLoss', '- Use the Prandtl hub-loss model? (flag) [unused when WakeMod=0 or 3]\n')) - f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn15']['TanInd'], 'TanInd', '- Include tangential induction in BEMT calculations? (flag) [unused when WakeMod=0 or 3]\n')) - f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn15']['AIDrag'], 'AIDrag', '- Include the drag term in the axial-induction calculation? (flag) [unused when WakeMod=0 or 3]\n')) - f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn15']['TIDrag'], 'TIDrag', '- Include the drag term in the tangential-induction calculation? (flag) [unused when WakeMod=0,3 or TanInd=FALSE]\n')) - f.write('{:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn15']['IndToler'], 'IndToler', '- Convergence tolerance for BEMT nonlinear solve residual equation {or "default"} (-) [unused when WakeMod=0 or 3]\n')) - f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['AeroDyn15']['MaxIter'], 'MaxIter', '- Maximum number of iteration steps (-) [unused when WakeMod=0]\n')) - f.write('====== Dynamic Blade-Element/Momentum Theory Options ====================================================== [used only when WakeMod=2]\n') - f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['AeroDyn15']['DBEMT_Mod'], 'DBEMT_Mod', '- Type of dynamic BEMT (DBEMT) model {1=constant tau1, 2=time-dependent tau1, 3=constant tau1 with continuous formulation} (-) [used only when WakeMod=2]\n')) - f.write('{:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn15']['tau1_const'], 'tau1_const', '- Time constant for DBEMT (s) [used only when WakeMod=2 and DBEMT_Mod=1]\n')) - f.write('====== OLAF -- cOnvecting LAgrangian Filaments (Free Vortex Wake) Theory Options ================== [used only when WakeMod=3]\n') + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn']['AirDens'], 'AirDens', '- Air density (kg/m^3)\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn']['KinVisc'], 'KinVisc', '- Kinematic viscosity of working fluid (m^2/s)\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn']['SpdSound'], 'SpdSound', '- Speed of sound in working fluid (m/s)\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn']['Patm'], 'Patm', '- Atmospheric pressure (Pa) [used only when CavitCheck=True]\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn']['Pvap'], 'Pvap', '- Vapour pressure of working fluid (Pa) [used only when CavitCheck=True]\n')) + f.write('====== Blade-Element/Momentum Theory Options ====================================================== [unused when Wake_Mod=0 or 3, except for BEM_Mod]\n') + f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['AeroDyn']['BEM_Mod'], 'BEM_Mod', '- BEM model {1=legacy NoSweepPitchTwist, 2=polar} (switch) [used for all Wake_Mod to determine output coordinate system]\n')) + f.write('--- Skew correction\n') + f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['AeroDyn']['Skew_Mod'], 'Skew_Mod', '- Skew model {0=No skew model, -1=Remove non-normal component for linearization, 1=skew model active}\n')) + f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn']['SkewMomCorr'], 'SkewMomCorr', '- Turn the skew momentum correction on or off [used only when Skew_Mod=1]\n')) + f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn']['SkewRedistr_Mod'], 'SkewRedistr_Mod', '- Type of skewed-wake correction model (switch) {0=no redistribution, 1=Glauert/Pitt/Peters, default=1} [used only when Skew_Mod=1]\n')) + f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn']['SkewRedistrFactor'], 'SkewRedistrFactor', '- Constant used in Pitt/Peters skewed wake model {or "default" is 15/32*pi} (-) [used only when Skew_Mod=1 and SkewRedistr_Mod=1]\n')) + f.write('--- BEM algorithm\n') + f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn']['TipLoss'], 'TipLoss', '- Use the Prandtl tip-loss model? (flag) [unused when Wake_Mod=0 or 3]\n')) + f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn']['HubLoss'], 'HubLoss', '- Use the Prandtl hub-loss model? (flag) [unused when Wake_Mod=0 or 3]\n')) + f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn']['TanInd'], 'TanInd', '- Include tangential induction in BEMT calculations? (flag) [unused when Wake_Mod=0 or 3]\n')) + f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn']['AIDrag'], 'AIDrag', '- Include the drag term in the axial-induction calculation? (flag) [unused when Wake_Mod=0 or 3]\n')) + f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn']['TIDrag'], 'TIDrag', '- Include the drag term in the tangential-induction calculation? (flag) [unused when Wake_Mod=0,3 or TanInd=FALSE]\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn']['IndToler'], 'IndToler', '- Convergence tolerance for BEMT nonlinear solve residual equation {or "default"} (-) [unused when Wake_Mod=0 or 3]\n')) + f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['AeroDyn']['MaxIter'], 'MaxIter', '- Maximum number of iteration steps (-) [unused when Wake_Mod=0]\n')) + f.write('--- Shear correction\n') + f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn']['SectAvg'], 'SectAvg', '- Use sector averaging (flag)\n')) + f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn']['SectAvgWeighting'], 'SectAvgWeighting', '- Weighting function for sector average {1=Uniform, default=1} within a sector centered on the blade (switch) [used only when SectAvg=True]\n')) + f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn']['SectAvgNPoints'], 'SectAvgNPoints', '- Number of points per sectors (-) {default=5} [used only when SectAvg=True]\n')) + f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn']['SectAvgPsiBwd'], 'SectAvgPsiBwd', '- Backward azimuth relative to blade where the sector starts (<=0) {default=-60} (deg) [used only when SectAvg=True]\n')) + f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn']['SectAvgPsiFwd'], 'SectAvgPsiFwd', '- Forward azimuth relative to blade where the sector ends (>=0) {default=60} (deg) [used only when SectAvg=True]\n')) + + f.write('--- Dynamic wake/inflow\n') + f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['AeroDyn']['DBEMT_Mod'], 'DBEMT_Mod', '- Type of dynamic BEMT (DBEMT) model {0=No Dynamic Wake, -1=Frozen Wake for linearization, 1:constant tau1, 2=time-dependent tau1, 3=constant tau1 with continuous formulation} (-)\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn']['tau1_const'], 'tau1_const', '- Time constant for DBEMT (s) [used only when DBEMT_Mod=1 or 3]\n')) + f.write('====== OLAF -- cOnvecting LAgrangian Filaments (Free Vortex Wake) Theory Options ================== [used only when Wake_Mod=3]\n') olaf_file = self.FAST_namingOut + '_OLAF.dat' - f.write('{!s:<22} {:<11} {:}'.format(olaf_file, 'OLAFInputFileName', '- Input file for OLAF [used only when WakeMod=3]\n')) - f.write('====== Beddoes-Leishman Unsteady Airfoil Aerodynamics Options ===================================== [used only when AFAeroMod=2]\n') - f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['AeroDyn15']['UAMod'], 'UAMod', "- Unsteady Aero Model Switch (switch) {1=Baseline model (Original), 2=Gonzalez's variant (changes in Cn,Cc,Cm), 3=Minnema/Pierce variant (changes in Cc and Cm)} [used only when AFAeroMod=2]\n")) - f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn15']['FLookup'], 'FLookup', "- Flag to indicate whether a lookup for f' will be calculated (TRUE) or whether best-fit exponential equations will be used (FALSE); if FALSE S1-S4 must be provided in airfoil input files (flag) [used only when AFAeroMod=2]\n")) + f.write('{!s:<22} {:<11} {:}'.format(olaf_file, 'OLAFInputFileName', '- Input file for OLAF [used only when Wake_Mod=3]\n')) + f.write('====== Unsteady Airfoil Aerodynamics Options ===================================== \n') + f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn']['AoA34'], 'AoA34', "- Sample the angle of attack (AoA) at the 3/4 chord or the AC point {default=True} [always used]\n")) + f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['AeroDyn']['UA_Mod'], 'UA_Mod', "- Unsteady Aero Model Switch (switch) {0=Quasi-steady (no UA), 2=B-L Gonzalez, 3=B-L Minnema/Pierce, 4=B-L HGM 4-states, 5=B-L HGM+vortex 5 states, 6=Oye, 7=Boeing-Vertol}\n")) + f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn']['FLookup'], 'FLookup', "- Flag to indicate whether a lookup for f' will be calculated (TRUE) or whether best-fit exponential equations will be used (FALSE); if FALSE S1-S4 must be provided in airfoil input files (flag) [used only when UA_Mod>0]\n")) + f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn']['IntegrationMethod'], 'IntegrationMethod', "- Switch to indicate which integration method UA uses (1=RK4, 2=AB4, 3=ABM4, 4=BDF2)\n")) + if 'UAStartRad' in self.fst_vt['AeroDyn'] and 'UAEndRad' in self.fst_vt['AeroDyn']: + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn']['UAStartRad'], 'UAStartRad', '- Starting radius for dynamic stall (fraction of rotor radius [0.0,1.0]) [used only when UA_Mod>0; if line is missing UAStartRad=0]\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn']['UAEndRad'], 'UAEndRad', '- Ending radius for dynamic stall (fraction of rotor radius [0.0,1.0]) [used only when UA_Mod>0; if line is missing UAEndRad=1]\n')) f.write('====== Airfoil Information =========================================================================\n') - f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['AeroDyn15']['AFTabMod'], 'AFTabMod', '- Interpolation method for multiple airfoil tables {1=1D interpolation on AoA (first table only); 2=2D interpolation on AoA and Re; 3=2D interpolation on AoA and UserProp} (-)\n')) - f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['AeroDyn15']['InCol_Alfa'], 'InCol_Alfa', '- The column in the airfoil tables that contains the angle of attack (-)\n')) - f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['AeroDyn15']['InCol_Cl'], 'InCol_Cl', '- The column in the airfoil tables that contains the lift coefficient (-)\n')) - f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['AeroDyn15']['InCol_Cd'], 'InCol_Cd', '- The column in the airfoil tables that contains the drag coefficient (-)\n')) - f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['AeroDyn15']['InCol_Cm'], 'InCol_Cm', '- The column in the airfoil tables that contains the pitching-moment coefficient; use zero if there is no Cm column (-)\n')) - f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['AeroDyn15']['InCol_Cpmin'], 'InCol_Cpmin', '- The column in the airfoil tables that contains the Cpmin coefficient; use zero if there is no Cpmin column (-)\n')) - f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['AeroDyn15']['NumAFfiles'], 'NumAFfiles', '- Number of airfoil files used (-)\n')) - for i in range(self.fst_vt['AeroDyn15']['NumAFfiles']): + f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['AeroDyn']['AFTabMod'], 'AFTabMod', '- Interpolation method for multiple airfoil tables {1=1D interpolation on AoA (first table only); 2=2D interpolation on AoA and Re; 3=2D interpolation on AoA and UserProp} (-)\n')) + f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['AeroDyn']['InCol_Alfa'], 'InCol_Alfa', '- The column in the airfoil tables that contains the angle of attack (-)\n')) + f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['AeroDyn']['InCol_Cl'], 'InCol_Cl', '- The column in the airfoil tables that contains the lift coefficient (-)\n')) + f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['AeroDyn']['InCol_Cd'], 'InCol_Cd', '- The column in the airfoil tables that contains the drag coefficient (-)\n')) + f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['AeroDyn']['InCol_Cm'], 'InCol_Cm', '- The column in the airfoil tables that contains the pitching-moment coefficient; use zero if there is no Cm column (-)\n')) + f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['AeroDyn']['InCol_Cpmin'], 'InCol_Cpmin', '- The column in the airfoil tables that contains the Cpmin coefficient; use zero if there is no Cpmin column (-)\n')) + f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['AeroDyn']['NumAFfiles'], 'NumAFfiles', '- Number of airfoil files used (-)\n')) + for i in range(self.fst_vt['AeroDyn']['NumAFfiles']): if i == 0: - f.write('"' + self.fst_vt['AeroDyn15']['AFNames'][i] + '" AFNames - Airfoil file names (NumAFfiles lines) (quoted strings)\n') + f.write('"' + self.fst_vt['AeroDyn']['AFNames'][i] + '" AFNames - Airfoil file names (NumAFfiles lines) (quoted strings)\n') else: - f.write('"' + self.fst_vt['AeroDyn15']['AFNames'][i] + '"\n') + f.write('"' + self.fst_vt['AeroDyn']['AFNames'][i] + '"\n') f.write('====== Rotor/Blade Properties =====================================================================\n') - f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn15']['UseBlCm'], 'UseBlCm', '- Include aerodynamic pitching moment in calculations? (flag)\n')) - f.write('{:<22} {:<11} {:}'.format('"'+self.fst_vt['AeroDyn15']['ADBlFile1']+'"', 'ADBlFile(1)', '- Name of file containing distributed aerodynamic properties for Blade #1 (-)\n')) - f.write('{:<22} {:<11} {:}'.format('"'+self.fst_vt['AeroDyn15']['ADBlFile2']+'"', 'ADBlFile(2)', '- Name of file containing distributed aerodynamic properties for Blade #2 (-) [unused if NumBl < 2]\n')) - f.write('{:<22} {:<11} {:}'.format('"'+self.fst_vt['AeroDyn15']['ADBlFile3']+'"', 'ADBlFile(3)', '- Name of file containing distributed aerodynamic properties for Blade #3 (-) [unused if NumBl < 3]\n')) + f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn']['UseBlCm'], 'UseBlCm', '- Include aerodynamic pitching moment in calculations? (flag)\n')) + f.write('{:<22} {:<11} {:}'.format('"'+self.fst_vt['AeroDyn']['ADBlFile1']+'"', 'ADBlFile(1)', '- Name of file containing distributed aerodynamic properties for Blade #1 (-)\n')) + f.write('{:<22} {:<11} {:}'.format('"'+self.fst_vt['AeroDyn']['ADBlFile2']+'"', 'ADBlFile(2)', '- Name of file containing distributed aerodynamic properties for Blade #2 (-) [unused if NumBl < 2]\n')) + f.write('{:<22} {:<11} {:}'.format('"'+self.fst_vt['AeroDyn']['ADBlFile3']+'"', 'ADBlFile(3)', '- Name of file containing distributed aerodynamic properties for Blade #3 (-) [unused if NumBl < 3]\n')) f.write('====== Hub Properties ============================================================================== [used only when Buoyancy=True]\n') - f.write('{:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn15']['VolHub'], 'VolHub', '- Hub volume (m^3)\n')) - f.write('{:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn15']['HubCenBx'], 'HubCenBx', '- Hub center of buoyancy x direction offset (m)\n')) - f.write('====== Nacelle Properties ========================================================================== [used only when Buoyancy=True]\n') - f.write('{:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn15']['VolNac'], 'VolNac', '- Nacelle volume (m^3)\n')) - f.write('{:<22} {:<11} {:}'.format(', '.join(np.array(self.fst_vt['AeroDyn15']['NacCenB'], dtype=str)), 'NacCenB', '- Position of nacelle center of buoyancy from yaw bearing in nacelle coordinates (m)\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn']['VolHub'], 'VolHub', '- Hub volume (m^3)\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn']['HubCenBx'], 'HubCenBx', '- Hub center of buoyancy x direction offset (m)\n')) + f.write('====== Nacelle Properties ========================================================================== [used only when Buoyancy=True or NacelleDrag=True]\n') + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn']['VolNac'], 'VolNac', '- Nacelle volume (m^3)\n')) + f.write('{:<22} {:<11} {:}'.format(', '.join(np.array(self.fst_vt['AeroDyn']['NacCenB'], dtype=str)), 'NacCenB', '- Position of nacelle center of buoyancy from yaw bearing in nacelle coordinates (m)\n')) + f.write('{:<22} {:<11} {:}'.format(', '.join(np.array(self.fst_vt['AeroDyn']['NacArea'], dtype=str)), 'NacArea', '- Projected area of the nacelle in X, Y, Z in the nacelle coordinate system (m^2)\n')) + f.write('{:<22} {:<11} {:}'.format(', '.join(np.array(self.fst_vt['AeroDyn']['NacCd'], dtype=str)), 'NacCd', '- Drag coefficient for the nacelle areas defined above (-)\n')) + f.write('{:<22} {:<11} {:}'.format(', '.join(np.array(self.fst_vt['AeroDyn']['NacDragAC'], dtype=str)), 'NacDragAC', '- Position of aerodynamic center of nacelle drag in nacelle coordinates (m)\n')) f.write('====== Tail Fin Aerodynamics ========================================================================\n') - f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn15']['TFinAero'], 'TFinAero', '- Calculate tail fin aerodynamics model (flag)\n')) - f.write('{:<22} {:<11} {:}'.format('"'+self.fst_vt['AeroDyn15']['TFinFile']+'"', 'TFinFile', '- Input file for tail fin aerodynamics [used only when TFinAero=True]\n')) + f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn']['TFinAero'], 'TFinAero', '- Calculate tail fin aerodynamics model (flag)\n')) + f.write('{:<22} {:<11} {:}'.format('"'+self.fst_vt['AeroDyn']['TFinFile']+'"', 'TFinFile', '- Input file for tail fin aerodynamics [used only when TFinAero=True]\n')) f.write('====== Tower Influence and Aerodynamics ============================================================ [used only when TwrPotent/=0, TwrShadow/=0, TwrAero=True, or Buoyancy=True]\n') - f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['AeroDyn15']['NumTwrNds'], 'NumTwrNds', '- Number of tower nodes used in the analysis (-) [used only when TwrPotent/=0, TwrShadow/=0, TwrAero=True, or Buoyancy=True]\n')) - f.write('TwrElev TwrDiam TwrCd TwrTI TwrCb !TwrTI used only with TwrShadow=2, TwrCb used only with Buoyancy=True\n') + f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['AeroDyn']['NumTwrNds'], 'NumTwrNds', '- Number of tower nodes used in the analysis (-) [used only when TwrPotent/=0, TwrShadow/=0, TwrAero=True, or Buoyancy=True]\n')) + f.write('TwrElev TwrDiam TwrCd TwrTI TwrCb !TwrTI used only when TwrShadow=2; TwrCb used only when Buoyancy=True\n') f.write('(m) (m) (-) (-) (-)\n') - for TwrElev, TwrDiam, TwrCd, TwrTI, TwrCb in zip(self.fst_vt['AeroDyn15']['TwrElev'], self.fst_vt['AeroDyn15']['TwrDiam'], self.fst_vt['AeroDyn15']['TwrCd'], self.fst_vt['AeroDyn15']['TwrTI'], self.fst_vt['AeroDyn15']['TwrCb']): + for TwrElev, TwrDiam, TwrCd, TwrTI, TwrCb in zip(self.fst_vt['AeroDyn']['TwrElev'], self.fst_vt['AeroDyn']['TwrDiam'], self.fst_vt['AeroDyn']['TwrCd'], self.fst_vt['AeroDyn']['TwrTI'], self.fst_vt['AeroDyn']['TwrCb']): f.write('{: 2.15e} {: 2.15e} {: 2.15e} {: 2.15e} {: 2.15e} \n'.format(TwrElev, TwrDiam, TwrCd, TwrTI, TwrCb)) f.write('====== Outputs ====================================================================================\n') - f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn15']['SumPrint'], 'SumPrint', '- Generate a summary file listing input options and interpolated properties to ".AD.sum"? (flag)\n')) - f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['AeroDyn15']['NBlOuts'], 'NBlOuts', '- Number of blade node outputs [0 - 9] (-)\n')) - f.write('{:<22} {:<11} {:}'.format(', '.join(self.fst_vt['AeroDyn15']['BlOutNd']), 'BlOutNd', '- Blade nodes whose values will be output (-)\n')) - f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['AeroDyn15']['NTwOuts'], 'NTwOuts', '- Number of tower node outputs [0 - 9] (-)\n')) - if self.fst_vt['AeroDyn15']['NTwOuts'] != 0: - f.write('{:<22} {:<11} {:}'.format(', '.join(self.fst_vt['AeroDyn15']['TwOutNd']), 'TwOutNd', '- Tower nodes whose values will be output (-)\n')) - else: - f.write('{:<22} {:<11} {:}'.format(0, 'TwOutNd', '- Tower nodes whose values will be output (-)\n')) + f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn']['SumPrint'], 'SumPrint', '- Generate a summary file listing input options and interpolated properties to ".AD.sum"? (flag)\n')) + f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['AeroDyn']['NBlOuts'], 'NBlOuts', '- Number of blade node outputs [0 - 9] (-)\n')) + f.write('{:<22} {:<11} {:}'.format(', '.join(self.fst_vt['AeroDyn']['BlOutNd']), 'BlOutNd', '- Blade nodes whose values will be output (-)\n')) + f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['AeroDyn']['NTwOuts'], 'NTwOuts', '- Number of tower node outputs [0 - 9] (-)\n')) + # if self.fst_vt['AeroDyn']['NTwOuts'] != 0: # TODO its weird that tower nodes is treated differently than blade nodes + # f.write('{:<22} {:<11} {:}'.format(', '.join(self.fst_vt['AeroDyn']['TwOutNd']), 'TwOutNd', '- Tower nodes whose values will be output (-)\n')) + # else: + # f.write('{:<22} {:<11} {:}'.format(0, 'TwOutNd', '- Tower nodes whose values will be output (-)\n')) + f.write('{:<22} {:<11} {:}'.format(', '.join(self.fst_vt['AeroDyn']['TwOutNd']), 'TwOutNd', '- Tower nodes whose values will be output (-)\n')) f.write(' OutList - The next line(s) contains a list of output parameters. See OutListParameters.xlsx for a listing of available output channels, (-)\n') outlist = self.get_outlist(self.fst_vt['outlist'], ['AeroDyn']) for channel_list in outlist: for i in range(len(channel_list)): f.write('"' + channel_list[i] + '"\n') - f.write('END of input file (the word "END" must appear in the first 3 columns of this last OutList line)\n') + f.write('END of input file (the word "END" must appear in the first 3 columns of the last OutList line)\n') # Optional nodal output section - if 'BldNd_BladesOut' in self.fst_vt['AeroDyn15']: + if 'BldNd_BladesOut' in self.fst_vt['AeroDyn']: f.write('====== Outputs for all blade stations (same ending as above for B1N1.... =========================== [optional section]\n') - f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['AeroDyn15']['BldNd_BladesOut'], 'BldNd_BladesOut', '- Number of blades to output all node information at. Up to number of blades on turbine. (-)\n')) - f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn15']['BldNd_BlOutNd'], 'BldNd_BlOutNd', '- Future feature will allow selecting a portion of the nodes to output. Not implemented yet. (-)\n')) - f.write(' OutList - The next line(s) contains a list of output parameters. See OutListParameters.xlsx, AeroDyn_Nodes tab for a listing of available output channels, (-)\n') + f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['AeroDyn']['BldNd_BladesOut'], 'BldNd_BladesOut', '- Number of blades to output all node information at. Up to number of blades on turbine. (-)\n')) + f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn']['BldNd_BlOutNd'], 'BldNd_BlOutNd', '- Future feature will allow selecting a portion of the nodes to output. Not implemented yet. (-)\n')) + f.write(' OutList_Nodal - The next line(s) contains a list of output parameters. See OutListParameters.xlsx, AeroDyn_Nodes tab for a listing of available output channels, (-)\n') opt_outlist = self.get_outlist(self.fst_vt['outlist'], ['AeroDyn_Nodes']) for opt_channel_list in opt_outlist: for i in range(len(opt_channel_list)): f.write('"' + opt_channel_list[i] + '"\n') - f.write('END of input file (the word "END" must appear in the first 3 columns of this last OutList line)\n') + f.write('END of input file (the word "END" must appear in the first 3 columns of the last OutList line)\n') f.write('---------------------------------------------------------------------------------------\n') f.flush() os.fsync(f) f.close() - def write_AeroDyn15Blade(self): + def write_AeroDynBlade(self): # AeroDyn v15.00 Blade - self.fst_vt['AeroDyn15']['ADBlFile1'] = self.FAST_namingOut + '_AeroDyn15_blade.dat' - self.fst_vt['AeroDyn15']['ADBlFile2'] = self.fst_vt['AeroDyn15']['ADBlFile1'] - self.fst_vt['AeroDyn15']['ADBlFile3'] = self.fst_vt['AeroDyn15']['ADBlFile1'] - filename = os.path.join(self.FAST_runDirectory, self.fst_vt['AeroDyn15']['ADBlFile1']) + self.fst_vt['AeroDyn']['ADBlFile1'] = self.FAST_namingOut + '_AeroDyn_blade.dat' + self.fst_vt['AeroDyn']['ADBlFile2'] = self.fst_vt['AeroDyn']['ADBlFile1'] + self.fst_vt['AeroDyn']['ADBlFile3'] = self.fst_vt['AeroDyn']['ADBlFile1'] + filename = os.path.join(self.FAST_runDirectory, self.fst_vt['AeroDyn']['ADBlFile1']) f = open(filename, 'w') - f.write('------- AERODYN v15.00.* BLADE DEFINITION INPUT FILE -------------------------------------\n') + f.write('------- AERODYN15 BLADE DEFINITION INPUT FILE -------------------------------------\n') f.write('Generated with OpenFAST_IO\n') f.write('====== Blade Properties =================================================================\n') f.write('{:<11d} {:<11} {:}'.format(self.fst_vt['AeroDynBlade']['NumBlNds'], 'NumBlNds', '- Number of blade nodes used in the analysis (-)\n')) - f.write(' BlSpn BlCrvAC BlSwpAC BlCrvAng BlTwist BlChord BlAFID\n') - f.write(' (m) (m) (m) (deg) (deg) (m) (-)\n') + f.write(' BlSpn BlCrvAC BlSwpAC BlCrvAng BlTwist BlChord BlAFID BlCb BlCenBn BlCenBt\n') + f.write(' (m) (m) (m) (deg) (deg) (m) (-) (-) (m) (m)\n') BlSpn = self.fst_vt['AeroDynBlade']['BlSpn'] BlCrvAC = self.fst_vt['AeroDynBlade']['BlCrvAC'] BlSwpAC = self.fst_vt['AeroDynBlade']['BlSwpAC'] @@ -905,14 +1029,17 @@ def write_AeroDyn15Blade(self): BlTwist = self.fst_vt['AeroDynBlade']['BlTwist'] BlChord = self.fst_vt['AeroDynBlade']['BlChord'] BlAFID = self.fst_vt['AeroDynBlade']['BlAFID'] - for Spn, CrvAC, SwpAC, CrvAng, Twist, Chord, AFID in zip(BlSpn, BlCrvAC, BlSwpAC, BlCrvAng, BlTwist, BlChord, BlAFID): - f.write('{: 2.15e} {: 2.15e} {: 2.15e} {: 2.15e} {: 2.15e} {: 2.15e} {: 8d}\n'.format(Spn, CrvAC, SwpAC, CrvAng, Twist, Chord, int(AFID))) + BlCb = self.fst_vt['AeroDynBlade']['BlCb'] + BlCenBn = self.fst_vt['AeroDynBlade']['BlCenBn'] + BlCenBt = self.fst_vt['AeroDynBlade']['BlCenBt'] + for Spn, CrvAC, SwpAC, CrvAng, Twist, Chord, AFID, BlCb, BlCenBn, BlCenBt in zip(BlSpn, BlCrvAC, BlSwpAC, BlCrvAng, BlTwist, BlChord, BlAFID, BlCb, BlCenBn, BlCenBt): + f.write('{: 2.15e} {: 2.15e} {: 2.15e} {: 2.15e} {: 2.15e} {: 2.15e} {: 8d} {: 2.15e} {: 2.15e} {: 2.15e}\n'.format(Spn, CrvAC, SwpAC, CrvAng, Twist, Chord, int(AFID), BlCb, BlCenBn, BlCenBt)) f.flush() os.fsync(f) f.close() - def write_AeroDyn15Polar(self): + def write_AeroDynPolar(self): # Airfoil Info v1.01 if not os.path.isdir(os.path.join(self.FAST_runDirectory,'Airfoils')): @@ -927,105 +1054,108 @@ def write_AeroDyn15Polar(self): print("Error tring to make '%s'!"%os.path.join(self.FAST_runDirectory,'Airfoils')) - self.fst_vt['AeroDyn15']['NumAFfiles'] = len(self.fst_vt['AeroDyn15']['af_data']) - self.fst_vt['AeroDyn15']['AFNames'] = ['']*self.fst_vt['AeroDyn15']['NumAFfiles'] + self.fst_vt['AeroDyn']['NumAFfiles'] = len(self.fst_vt['AeroDyn']['af_data']) + self.fst_vt['AeroDyn']['AFNames'] = ['']*self.fst_vt['AeroDyn']['NumAFfiles'] - for afi in range(int(self.fst_vt['AeroDyn15']['NumAFfiles'])): + for afi in range(int(self.fst_vt['AeroDyn']['NumAFfiles'])): - self.fst_vt['AeroDyn15']['AFNames'][afi] = os.path.join('Airfoils', self.FAST_namingOut + '_AeroDyn15_Polar_%02d.dat'%afi) - af_file = os.path.join(self.FAST_runDirectory, self.fst_vt['AeroDyn15']['AFNames'][afi]) + self.fst_vt['AeroDyn']['AFNames'][afi] = os.path.join('Airfoils', self.FAST_namingOut + '_AeroDyn_Polar_%02d.dat'%afi) + af_file = os.path.join(self.FAST_runDirectory, self.fst_vt['AeroDyn']['AFNames'][afi]) f = open(af_file, 'w') - f.write('! ------------ AirfoilInfo v1.01.x Input File ----------------------------------\n') + f.write('! ------------ AirfoilInfo Input File ----------------------------------\n') f.write('! Generated with OpenFAST_IO\n') f.write('! line\n') f.write('! line\n') f.write('! ------------------------------------------------------------------------------\n') - f.write('{:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn15']['af_data'][afi][0]['InterpOrd'], 'InterpOrd', '! Interpolation order to use for quasi-steady table lookup {1=linear; 3=cubic spline; "default"} [default=3]\n')) - f.write('{:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn15']['af_data'][afi][0]['NonDimArea'], 'NonDimArea', '! The non-dimensional area of the airfoil (area/chord^2) (set to 1.0 if unsure or unneeded)\n')) - if self.fst_vt['AeroDyn15']['af_data'][afi][0]['NumCoords'] != '0': + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn']['af_data'][afi][0]['InterpOrd'], 'InterpOrd', '! Interpolation order to use for quasi-steady table lookup {1=linear; 3=cubic spline; "default"} [default=3]\n')) + if 'RelThickness' in self.fst_vt['AeroDyn']['af_data'][afi][0]: + f.write('{:<22f} {:<11} {:}'.format(self.fst_vt['AeroDyn']['af_data'][afi][0]['RelThickness'], 'RelThickness', '! The non-dimensional thickness of the airfoil (thickness/chord) [only used if UAMod=7] [default=0.2] (-)\n')) + + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn']['af_data'][afi][0]['NonDimArea'], 'NonDimArea', '! The non-dimensional area of the airfoil (area/chord^2) (set to 1.0 if unsure or unneeded)\n')) + if self.fst_vt['AeroDyn']['af_data'][afi][0]['NumCoords'] != '0': f.write('@"{:}_AF{:02d}_Coords.txt" {:<11} {:}'.format(self.FAST_namingOut, afi, 'NumCoords', '! The number of coordinates in the airfoil shape file. Set to zero if coordinates not included.\n')) else: f.write('{:<22d} {:<11} {:}'.format(0, 'NumCoords', '! The number of coordinates in the airfoil shape file. Set to zero if coordinates not included.\n')) f.write('AF{:02d}_BL.txt {:<11} {:}'.format(afi, 'BL_file', '! The file name including the boundary layer characteristics of the profile. Ignored if the aeroacoustic module is not called.\n')) - # f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['AeroDyn15']['af_data'][afi][0]['NumTabs'], 'NumTabs', '! Number of airfoil tables in this file. Each table must have lines for Re and Ctrl.\n')) + # f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['AeroDyn']['af_data'][afi][0]['NumTabs'], 'NumTabs', '! Number of airfoil tables in this file. Each table must have lines for Re and UserProp.\n')) # Check if we have multiple tables per airfoil # if yes, allocate the number of airfoils to the respective radial stations - if self.fst_vt['AeroDyn15']['AFTabMod'] == 2: - num_tab = len(self.fst_vt['AeroDyn15']['af_data'][afi]) - elif self.fst_vt['AeroDyn15']['AFTabMod'] == 3: - # for tab_orig in range(self.fst_vt['AeroDyn15']['af_data'][afi][0]['NumTabs'] - 1): - if len( self.fst_vt['AeroDyn15']['af_data'][afi]) == 1 or \ - self.fst_vt['AeroDyn15']['af_data'][afi][0]['Ctrl'] == self.fst_vt['AeroDyn15']['af_data'][afi][1]['Ctrl']: - num_tab = 1 # assume that all Ctrl angles of the flaps are identical if the first two are -> no flaps! + if self.fst_vt['AeroDyn']['AFTabMod'] == 2: + num_tab = len(self.fst_vt['AeroDyn']['af_data'][afi]) + elif self.fst_vt['AeroDyn']['AFTabMod'] == 3: + # for tab_orig in range(self.fst_vt['AeroDyn']['af_data'][afi][0]['NumTabs'] - 1): + if len( self.fst_vt['AeroDyn']['af_data'][afi]) == 1 or \ + self.fst_vt['AeroDyn']['af_data'][afi][0]['UserProp'] == self.fst_vt['AeroDyn']['af_data'][afi][1]['UserProp']: + num_tab = 1 # assume that all UserProp angles of the flaps are identical if the first two are -> no flaps! else: - num_tab = self.fst_vt['AeroDyn15']['af_data'][afi][0]['NumTabs'] + num_tab = self.fst_vt['AeroDyn']['af_data'][afi][0]['NumTabs'] else: num_tab = 1 - # f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['AeroDyn15']['af_data'][afi][0]['NumTabs'], 'NumTabs','! Number of airfoil tables in this file. Each table must have lines for Re and Ctrl.\n')) - f.write('{:<22d} {:<11} {:}'.format(num_tab, 'NumTabs','! Number of airfoil tables in this file. Each table must have lines for Re and Ctrl.\n')) + # f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['AeroDyn']['af_data'][afi][0]['NumTabs'], 'NumTabs','! Number of airfoil tables in this file. Each table must have lines for Re and UserProp.\n')) + f.write('{:<22d} {:<11} {:}'.format(num_tab, 'NumTabs','! Number of airfoil tables in this file. Each table must have lines for Re and UserProp.\n')) - # for tab in range(self.fst_vt['AeroDyn15']['af_data'][afi][0]['NumTabs']): # For writing multiple tables (different Re or Ctrl values) - for tab in range(num_tab): # For writing multiple tables (different Re or Ctrl values) + # for tab in range(self.fst_vt['AeroDyn']['af_data'][afi][0]['NumTabs']): # For writing multiple tables (different Re or UserProp values) + for tab in range(num_tab): # For writing multiple tables (different Re or UserProp values) f.write('! ------------------------------------------------------------------------------\n') f.write("! data for table %i \n" % (tab + 1)) f.write('! ------------------------------------------------------------------------------\n') - f.write('{:<22f} {:<11} {:}'.format(self.fst_vt['AeroDyn15']['af_data'][afi][tab]['Re']*1.e-6, 'Re', '! Reynolds number in millions\n')) - f.write('{:<22d} {:<11} {:}'.format(int(self.fst_vt['AeroDyn15']['af_data'][afi][tab]['Ctrl']), 'Ctrl', '! Control setting (must be 0 for current AirfoilInfo)\n')) - f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn15']['af_data'][afi][tab]['InclUAdata'], 'InclUAdata', '! Is unsteady aerodynamics data included in this table? If TRUE, then include 30 UA coefficients below this line\n')) + f.write('{:<22f} {:<11} {:}'.format(self.fst_vt['AeroDyn']['af_data'][afi][tab]['Re']*1.e-6, 'Re', '! Reynolds number in millions\n')) + f.write('{:<22d} {:<11} {:}'.format(int(self.fst_vt['AeroDyn']['af_data'][afi][tab]['UserProp']), 'UserProp', '! User property (control) setting\n')) + f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn']['af_data'][afi][tab]['InclUAdata'], 'InclUAdata', '! Is unsteady aerodynamics data included in this table? If TRUE, then include 30 UA coefficients below this line\n')) f.write('!........................................\n') - if self.fst_vt['AeroDyn15']['af_data'][afi][tab]['InclUAdata']: - f.write('{:<22f} {:<11} {:}'.format(self.fst_vt['AeroDyn15']['af_data'][afi][tab]['alpha0'], 'alpha0', '! 0-lift angle of attack, depends on airfoil.\n')) - f.write('{:<22f} {:<11} {:}'.format(self.fst_vt['AeroDyn15']['af_data'][afi][tab]['alpha1'], 'alpha1', '! Angle of attack at f=0.7, (approximately the stall angle) for AOA>alpha0. (deg)\n')) - f.write('{:<22f} {:<11} {:}'.format(self.fst_vt['AeroDyn15']['af_data'][afi][tab]['alpha2'], 'alpha2', '! Angle of attack at f=0.7, (approximately the stall angle) for AOA1]\n')) - f.write('{:<22f} {:<11} {:}'.format(self.fst_vt['AeroDyn15']['af_data'][afi][tab]['S2'], 'S2', '! Constant in the f curve best-fit for AOA> alpha1; by definition it depends on the airfoil. [ignored if UAMod<>1]\n')) - f.write('{:<22f} {:<11} {:}'.format(self.fst_vt['AeroDyn15']['af_data'][afi][tab]['S3'], 'S3', '! Constant in the f curve best-fit for alpha2<=AOA< alpha0; by definition it depends on the airfoil. [ignored if UAMod<>1]\n')) - f.write('{:<22f} {:<11} {:}'.format(self.fst_vt['AeroDyn15']['af_data'][afi][tab]['S4'], 'S4', '! Constant in the f curve best-fit for AOA< alpha2; by definition it depends on the airfoil. [ignored if UAMod<>1]\n')) - f.write('{:<22f} {:<11} {:}'.format(self.fst_vt['AeroDyn15']['af_data'][afi][tab]['Cn1'], 'Cn1', '! Critical value of C0n at leading edge separation. It should be extracted from airfoil data at a given Mach and Reynolds number. It can be calculated from the static value of Cn at either the break in the pitching moment or the loss of chord force at the onset of stall. It is close to the condition of maximum lift of the airfoil at low Mach numbers.\n')) - f.write('{:<22f} {:<11} {:}'.format(self.fst_vt['AeroDyn15']['af_data'][afi][tab]['Cn2'], 'Cn2', '! As Cn1 for negative AOAs.\n')) - # f.write('{: 22f} {:<11} {:}'.format(self.fst_vt['AeroDyn15']['af_data'][afi]['St_sh'], 'St_sh', "! Strouhal's shedding frequency constant. [default = 0.19]\n")) - f.write(float_default_out(self.fst_vt['AeroDyn15']['af_data'][afi][tab]['St_sh']) + ' {:<11} {:}'.format('St_sh', "! Strouhal's shedding frequency constant. [default = 0.19]\n")) - f.write('{:<22f} {:<11} {:}'.format(self.fst_vt['AeroDyn15']['af_data'][afi][tab]['Cd0'], 'Cd0', '! 2D drag coefficient value at 0-lift.\n')) - f.write('{:<22f} {:<11} {:}'.format(self.fst_vt['AeroDyn15']['af_data'][afi][tab]['Cm0'], 'Cm0', '! 2D pitching moment coefficient about 1/4-chord location, at 0-lift, positive if nose up. [If the aerodynamics coefficients table does not include a column for Cm, this needs to be set to 0.0]\n')) - f.write('{:<22f} {:<11} {:}'.format(self.fst_vt['AeroDyn15']['af_data'][afi][tab]['k0'], 'k0', '! Constant in the \\hat(x)_cp curve best-fit; = (\\hat(x)_AC-0.25). [ignored if UAMod<>1]\n')) - f.write('{:<22f} {:<11} {:}'.format(self.fst_vt['AeroDyn15']['af_data'][afi][tab]['k1'], 'k1', '! Constant in the \\hat(x)_cp curve best-fit. [ignored if UAMod<>1]\n')) - f.write('{:<22f} {:<11} {:}'.format(self.fst_vt['AeroDyn15']['af_data'][afi][tab]['k2'], 'k2', '! Constant in the \\hat(x)_cp curve best-fit. [ignored if UAMod<>1]\n')) - f.write('{:<22f} {:<11} {:}'.format(self.fst_vt['AeroDyn15']['af_data'][afi][tab]['k3'], 'k3', '! Constant in the \\hat(x)_cp curve best-fit. [ignored if UAMod<>1]\n')) - f.write('{:<22f} {:<11} {:}'.format(self.fst_vt['AeroDyn15']['af_data'][afi][tab]['k1_hat'], 'k1_hat', '! Constant in the expression of Cc due to leading edge vortex effects. [ignored if UAMod<>1]\n')) - f.write(float_default_out(self.fst_vt['AeroDyn15']['af_data'][afi][tab]['x_cp_bar']) + ' {:<11} {:}'.format('x_cp_bar', '! Constant in the expression of \\hat(x)_cp^v. [ignored if UAMod<>1, default = 0.2]\n')) - f.write(float_default_out(self.fst_vt['AeroDyn15']['af_data'][afi][tab]['UACutout']) + ' {:<11} {:}'.format('UACutout', '! Angle of attack above which unsteady aerodynamics are disabled (deg). [Specifying the string "Default" sets UACutout to 45 degrees]\n')) - f.write(float_default_out(self.fst_vt['AeroDyn15']['af_data'][afi][tab]['filtCutOff']) + ' {:<11} {:}'.format('filtCutOff', '! Cut-off frequency (-3 dB corner frequency) for low-pass filtering the AoA input to UA, as well as the 1st and 2nd derivatives (Hz) [default = 20]\n')) + if self.fst_vt['AeroDyn']['af_data'][afi][tab]['InclUAdata']: + f.write('{:<22f} {:<11} {:}'.format(self.fst_vt['AeroDyn']['af_data'][afi][tab]['alpha0'], 'alpha0', '! 0-lift angle of attack, depends on airfoil.\n')) + f.write('{:<22f} {:<11} {:}'.format(self.fst_vt['AeroDyn']['af_data'][afi][tab]['alpha1'], 'alpha1', '! Angle of attack at f=0.7, (approximately the stall angle) for AOA>alpha0. (deg)\n')) + f.write('{:<22f} {:<11} {:}'.format(self.fst_vt['AeroDyn']['af_data'][afi][tab]['alpha2'], 'alpha2', '! Angle of attack at f=0.7, (approximately the stall angle) for AOA1]\n')) + f.write('{:<22f} {:<11} {:}'.format(self.fst_vt['AeroDyn']['af_data'][afi][tab]['S2'], 'S2', '! Constant in the f curve best-fit for AOA> alpha1; by definition it depends on the airfoil. [ignored if UA_Mod<>1]\n')) + f.write('{:<22f} {:<11} {:}'.format(self.fst_vt['AeroDyn']['af_data'][afi][tab]['S3'], 'S3', '! Constant in the f curve best-fit for alpha2<=AOA< alpha0; by definition it depends on the airfoil. [ignored if UA_Mod<>1]\n')) + f.write('{:<22f} {:<11} {:}'.format(self.fst_vt['AeroDyn']['af_data'][afi][tab]['S4'], 'S4', '! Constant in the f curve best-fit for AOA< alpha2; by definition it depends on the airfoil. [ignored if UA_Mod<>1]\n')) + f.write('{:<22f} {:<11} {:}'.format(self.fst_vt['AeroDyn']['af_data'][afi][tab]['Cn1'], 'Cn1', '! Critical value of C0n at leading edge separation. It should be extracted from airfoil data at a given Mach and Reynolds number. It can be calculated from the static value of Cn at either the break in the pitching moment or the loss of chord force at the onset of stall. It is close to the condition of maximum lift of the airfoil at low Mach numbers.\n')) + f.write('{:<22f} {:<11} {:}'.format(self.fst_vt['AeroDyn']['af_data'][afi][tab]['Cn2'], 'Cn2', '! As Cn1 for negative AOAs.\n')) + # f.write('{: 22f} {:<11} {:}'.format(self.fst_vt['AeroDyn']['af_data'][afi]['St_sh'], 'St_sh', "! Strouhal's shedding frequency constant. [default = 0.19]\n")) + f.write(float_default_out(self.fst_vt['AeroDyn']['af_data'][afi][tab]['St_sh']) + ' {:<11} {:}'.format('St_sh', "! Strouhal's shedding frequency constant. [default = 0.19]\n")) + f.write('{:<22f} {:<11} {:}'.format(self.fst_vt['AeroDyn']['af_data'][afi][tab]['Cd0'], 'Cd0', '! 2D drag coefficient value at 0-lift.\n')) + f.write('{:<22f} {:<11} {:}'.format(self.fst_vt['AeroDyn']['af_data'][afi][tab]['Cm0'], 'Cm0', '! 2D pitching moment coefficient about 1/4-chord location, at 0-lift, positive if nose up. [If the aerodynamics coefficients table does not include a column for Cm, this needs to be set to 0.0]\n')) + f.write('{:<22f} {:<11} {:}'.format(self.fst_vt['AeroDyn']['af_data'][afi][tab]['k0'], 'k0', '! Constant in the \\hat(x)_cp curve best-fit; = (\\hat(x)_AC-0.25). [ignored if UA_Mod<>1]\n')) + f.write('{:<22f} {:<11} {:}'.format(self.fst_vt['AeroDyn']['af_data'][afi][tab]['k1'], 'k1', '! Constant in the \\hat(x)_cp curve best-fit. [ignored if UA_Mod<>1]\n')) + f.write('{:<22f} {:<11} {:}'.format(self.fst_vt['AeroDyn']['af_data'][afi][tab]['k2'], 'k2', '! Constant in the \\hat(x)_cp curve best-fit. [ignored if UA_Mod<>1]\n')) + f.write('{:<22f} {:<11} {:}'.format(self.fst_vt['AeroDyn']['af_data'][afi][tab]['k3'], 'k3', '! Constant in the \\hat(x)_cp curve best-fit. [ignored if UA_Mod<>1]\n')) + f.write('{:<22f} {:<11} {:}'.format(self.fst_vt['AeroDyn']['af_data'][afi][tab]['k1_hat'], 'k1_hat', '! Constant in the expression of Cc due to leading edge vortex effects. [ignored if UA_Mod<>1]\n')) + f.write(float_default_out(self.fst_vt['AeroDyn']['af_data'][afi][tab]['x_cp_bar']) + ' {:<11} {:}'.format('x_cp_bar', '! Constant in the expression of \\hat(x)_cp^v. [ignored if UA_Mod<>1, default = 0.2]\n')) + f.write(float_default_out(self.fst_vt['AeroDyn']['af_data'][afi][tab]['UACutout']) + ' {:<11} {:}'.format('UACutout', '! Angle of attack above which unsteady aerodynamics are disabled (deg). [Specifying the string "Default" sets UACutout to 45 degrees]\n')) + f.write(float_default_out(self.fst_vt['AeroDyn']['af_data'][afi][tab]['filtCutOff']) + ' {:<11} {:}'.format('filtCutOff', '! Reduced frequency cut-off for low-pass filtering the AoA input to UA, as well as the 1st and 2nd derivatives (-) [default = 0.5]\n')) f.write('!........................................\n') f.write('! Table of aerodynamics coefficients\n') - f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['AeroDyn15']['af_data'][afi][tab]['NumAlf'], 'NumAlf', '! Number of data lines in the following table\n')) + f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['AeroDyn']['af_data'][afi][tab]['NumAlf'], 'NumAlf', '! Number of data lines in the following table\n')) f.write('! Alpha Cl Cd Cm\n') f.write('! (deg) (-) (-) (-)\n') - polar_map = [self.fst_vt['AeroDyn15']['InCol_Alfa'], self.fst_vt['AeroDyn15']['InCol_Cl'], self.fst_vt['AeroDyn15']['InCol_Cd'], self.fst_vt['AeroDyn15']['InCol_Cm'], self.fst_vt['AeroDyn15']['InCol_Cpmin']] + polar_map = [self.fst_vt['AeroDyn']['InCol_Alfa'], self.fst_vt['AeroDyn']['InCol_Cl'], self.fst_vt['AeroDyn']['InCol_Cd'], self.fst_vt['AeroDyn']['InCol_Cm'], self.fst_vt['AeroDyn']['InCol_Cpmin']] polar_map.remove(0) polar_map = [i-1 for i in polar_map] - alpha = np.asarray(self.fst_vt['AeroDyn15']['af_data'][afi][tab]['Alpha']) - cl = np.asarray(self.fst_vt['AeroDyn15']['af_data'][afi][tab]['Cl']) - cd = np.asarray(self.fst_vt['AeroDyn15']['af_data'][afi][tab]['Cd']) - cm = np.asarray(self.fst_vt['AeroDyn15']['af_data'][afi][tab]['Cm']) - cpmin = np.asarray(self.fst_vt['AeroDyn15']['af_data'][afi][tab]['Cpmin']) + alpha = np.asarray(self.fst_vt['AeroDyn']['af_data'][afi][tab]['Alpha']) + cl = np.asarray(self.fst_vt['AeroDyn']['af_data'][afi][tab]['Cl']) + cd = np.asarray(self.fst_vt['AeroDyn']['af_data'][afi][tab]['Cd']) + cm = np.asarray(self.fst_vt['AeroDyn']['af_data'][afi][tab]['Cm']) + cpmin = np.asarray(self.fst_vt['AeroDyn']['af_data'][afi][tab]['Cpmin']) if alpha[0] != -180.: print('Airfoil number ' + str(afi) + ' tab number ' + str(tab) + ' has the min angle of attack different than -180 deg, and equal to ' + str(alpha[0]) + ' deg. This is changed to -180 deg now.') @@ -1043,9 +1173,9 @@ def write_AeroDyn15Polar(self): print('Airfoil number ' + str(afi) + ' tab number ' + str(tab) + ' has the moment coefficient different between +-180 deg. This is changed to be the same now.') cm[0] = cm[-1] - if self.fst_vt['AeroDyn15']['InCol_Cm'] == 0: + if self.fst_vt['AeroDyn']['InCol_Cm'] == 0: cm = np.zeros_like(cl) - if self.fst_vt['AeroDyn15']['InCol_Cpmin'] == 0: + if self.fst_vt['AeroDyn']['InCol_Cpmin'] == 0: cpmin = np.zeros_like(cl) polar = np.column_stack((alpha, cl, cd, cm, cpmin)) polar = polar[:,polar_map] @@ -1058,25 +1188,25 @@ def write_AeroDyn15Polar(self): os.fsync(f) f.close() - def write_AeroDyn15Coord(self): + def write_AeroDynCoord(self, af_coord): - self.fst_vt['AeroDyn15']['AFNames_coord'] = ['']*self.fst_vt['AeroDyn15']['NumAFfiles'] + self.fst_vt['AeroDyn']['AFNames_coord'] = ['']*self.fst_vt['AeroDyn']['NumAFfiles'] - for afi in range(int(self.fst_vt['AeroDyn15']['NumAFfiles'])): - self.fst_vt['AeroDyn15']['AFNames_coord'][afi] = os.path.join('Airfoils', self.FAST_namingOut + '_AF%02d_Coords.txt'%afi) + for afi in af_coord: + self.fst_vt['AeroDyn']['AFNames_coord'][afi] = os.path.join('Airfoils', self.FAST_namingOut + '_AF%02d_Coords.txt'%afi) - x = self.fst_vt['AeroDyn15']['af_coord'][afi]['x'] - y = self.fst_vt['AeroDyn15']['af_coord'][afi]['y'] + x = self.fst_vt['AeroDyn']['af_coord'][afi]['x'] + y = self.fst_vt['AeroDyn']['af_coord'][afi]['y'] coord = np.vstack((x, y)).T - af_file = os.path.join(self.FAST_runDirectory, self.fst_vt['AeroDyn15']['AFNames_coord'][afi]) + af_file = os.path.join(self.FAST_runDirectory, self.fst_vt['AeroDyn']['AFNames_coord'][afi]) f = open(af_file, 'w') f.write('{: 22d} {:<11} {:}'.format(len(x)+1, 'NumCoords', '! The number of coordinates in the airfoil shape file (including an extra coordinate for airfoil reference). Set to zero if coordinates not included.\n')) f.write('! ......... x-y coordinates are next if NumCoords > 0 .............\n') f.write('! x-y coordinate of airfoil reference\n') f.write('! x/c y/c\n') - f.write('{: 5f} 0\n'.format(self.fst_vt['AeroDyn15']['ac'][afi])) + f.write('{: 5f} 0\n'.format(self.fst_vt['AeroDyn']['ac'][afi])) f.write('! coordinates of airfoil shape\n') f.write('! interpolation to 200 points\n') f.write('! x/c y/c\n') @@ -1087,140 +1217,6 @@ def write_AeroDyn15Coord(self): os.fsync(f) f.close() - def write_AeroDyn14(self): - - # ======= Airfoil Files ======== - # make directory for airfoil files - if not os.path.isdir(os.path.join(self.FAST_runDirectory,'AeroData')): - try: - os.mkdir(os.path.join(self.FAST_runDirectory,'AeroData')) - except: - try: - time.sleep(random.random()) - if not os.path.isdir(os.path.join(self.FAST_runDirectory,'AeroData')): - os.mkdir(os.path.join(self.FAST_runDirectory,'AeroData')) - except: - print("Error tring to make '%s'!"%os.path.join(self.FAST_runDirectory,'AeroData')) - - # create write airfoil objects to files - for i in range(self.fst_vt['AeroDyn14']['NumFoil']): - af_name = os.path.join(self.FAST_runDirectory, 'AeroData', 'Airfoil' + str(i) + '.dat') - self.fst_vt['AeroDyn14']['FoilNm'][i] = os.path.join('AeroData', 'Airfoil' + str(i) + '.dat') - self.write_AeroDyn14Polar(af_name, i) - - self.fst_vt['Fst']['AeroFile'] = self.FAST_namingOut + '_AeroDyn14.dat' - ad_file = os.path.join(self.FAST_runDirectory,self.fst_vt['Fst']['AeroFile']) - f = open(ad_file,'w') - - # create Aerodyn Tower - if self.fst_vt['AeroDyn14']['TwrShad'] > 0: - self.write_AeroDyn14Tower() - - # ======= Aerodyn Input File ======== - f.write('AeroDyn v14.04.* INPUT FILE\n\n') - - # f.write('{:}\n'.format(self.fst_vt['aerodyn']['SysUnits'])) - f.write('{:}\n'.format(self.fst_vt['AeroDyn14']['StallMod'])) - - f.write('{:}\n'.format(self.fst_vt['AeroDyn14']['UseCm'])) - f.write('{:}\n'.format(self.fst_vt['AeroDyn14']['InfModel'])) - f.write('{:}\n'.format(self.fst_vt['AeroDyn14']['IndModel'])) - f.write('{: 2.15e}\n'.format(self.fst_vt['AeroDyn14']['AToler'])) - f.write('{:}\n'.format(self.fst_vt['AeroDyn14']['TLModel'])) - f.write('{:}\n'.format(self.fst_vt['AeroDyn14']['HLModel'])) - f.write('{:}\n'.format(self.fst_vt['AeroDyn14']['TwrShad'])) - if self.fst_vt['AeroDyn14']['TwrShad'] > 0: - f.write('{:}\n'.format(self.fst_vt['AeroDyn14']['TwrPotent'])) - f.write('{:}\n'.format(self.fst_vt['AeroDyn14']['TwrShadow'])) - f.write('{:}\n'.format(self.fst_vt['AeroDyn14']['TwrFile'])) - f.write('{:}\n'.format(self.fst_vt['AeroDyn14']['CalcTwrAero'])) - else: - f.write('{: 2.15e}\n'.format(self.fst_vt['AeroDyn14']['ShadHWid'])) - f.write('{: 2.15e}\n'.format(self.fst_vt['AeroDyn14']['T_Shad_Refpt'])) - - f.write('{: 2.15e}\n'.format(self.fst_vt['AeroDyn14']['AirDens'])) - - f.write('{: 2.15e}\n'.format(self.fst_vt['AeroDyn14']['KinVisc'])) - - f.write('{:2}\n'.format(self.fst_vt['AeroDyn14']['DTAero'])) - - - f.write('{:2}\n'.format(self.fst_vt['AeroDyn14']['NumFoil'])) - for i in range (self.fst_vt['AeroDyn14']['NumFoil']): - f.write('"{:}"\n'.format(self.fst_vt['AeroDyn14']['FoilNm'][i])) - - f.write('{:2}\n'.format(self.fst_vt['AeroDynBlade']['BldNodes'])) - rnodes = self.fst_vt['AeroDynBlade']['RNodes'] - twist = self.fst_vt['AeroDynBlade']['AeroTwst'] - drnodes = self.fst_vt['AeroDynBlade']['DRNodes'] - chord = self.fst_vt['AeroDynBlade']['Chord'] - nfoil = self.fst_vt['AeroDynBlade']['NFoil'] - prnelm = self.fst_vt['AeroDynBlade']['PrnElm'] - f.write('Nodal properties\n') - for r, t, dr, c, a, p in zip(rnodes, twist, drnodes, chord, nfoil, prnelm): - f.write('{: 2.15e}\t{: 2.15e}\t{: 2.15e}\t{: 2.15e}\t{:5}\t{:}\n'.format(r, t, dr, c, a, p)) - - f.flush() - os.fsync(f) - f.close() - - def write_AeroDyn14Tower(self): - # AeroDyn v14.04 Tower - self.fst_vt['AeroDyn14']['TwrFile'] = self.FAST_namingOut + '_AeroDyn14_tower.dat' - filename = os.path.join(self.FAST_runDirectory, self.fst_vt['AeroDyn14']['TwrFile']) - f = open(filename, 'w') - - f.write('AeroDyn tower file, Aerodyn v14.04 formatting\n') - f.write('Generated with OpenFAST_IO\n') - f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['AeroDynTower']['NTwrHt'], 'NTwrHt', '- Number of tower input height stations listed (-)\n')) - f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['AeroDynTower']['NTwrRe'], 'NTwrRe', '- Number of tower Re values (-)\n')) - f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['AeroDynTower']['NTwrCD'], 'NTwrCD', '- Number of tower CD columns (-) Note: For current versions, this MUST be 1\n')) - f.write('{: 2.15e} {:<11} {:}'.format(self.fst_vt['AeroDynTower']['Tower_Wake_Constant'], 'Tower_Wake_Constant', '- Tower wake constant (-) {0.0: full potential flow, 0.1: Bak model}\n')) - f.write('---------------------- DISTRIBUTED TOWER PROPERTIES ----------------------------\n') - f.write('TwrHtFr TwrWid NTwrCDCol\n') - for HtFr, Wid, CDId in zip(self.fst_vt['AeroDynTower']['TwrHtFr'], self.fst_vt['AeroDynTower']['TwrWid'], self.fst_vt['AeroDynTower']['NTwrCDCol']): - f.write('{: 2.15e} {: 2.15e} {:d}\n'.format(HtFr, Wid, int(CDId))) - f.write('---------------------- Re v CD PROPERTIES --------------------------------------\n') - f.write('TwrRe '+ ' '.join(['TwrCD%d'%(i+1) for i in range(self.fst_vt['AeroDynTower']['NTwrCD'])]) +'\n') - for Re, CD in zip(self.fst_vt['AeroDynTower']['TwrRe'], self.fst_vt['AeroDynTower']['TwrCD']): - f.write('% 2.15e' %Re + ' '.join(['% 2.15e'%cdi for cdi in CD]) + '\n') - - f.flush() - os.fsync(f) - f.close() - - def write_AeroDyn14Polar(self, filename, a_i): - # AeroDyn v14 Airfoil Polar Input File - - f = open(filename, 'w') - f.write('AeroDyn airfoil file, Aerodyn v14.04 formatting\n') - f.write('Generated with OpenFAST_IO\n') - - f.write('{:9d}\t{:}'.format(self.fst_vt['AeroDynBlade']['af_data'][a_i]['number_tables'], 'Number of airfoil tables in this file\n')) - for i in range(self.fst_vt['AeroDynBlade']['af_data'][a_i]['number_tables']): - param = self.fst_vt['AeroDynBlade']['af_data'][a_i]['af_tables'][i] - f.write('{:9g}\t{:}'.format(i, 'Table ID parameter\n')) - f.write('{: f}\t{:}'.format(param['StallAngle'], 'Stall angle (deg)\n')) - f.write('{: f}\t{:}'.format(0, 'No longer used, enter zero\n')) - f.write('{: f}\t{:}'.format(0, 'No longer used, enter zero\n')) - f.write('{: f}\t{:}'.format(0, 'No longer used, enter zero\n')) - f.write('{: f}\t{:}'.format(param['ZeroCn'], 'Angle of attack for zero Cn for linear Cn curve (deg)\n')) - f.write('{: f}\t{:}'.format(param['CnSlope'], 'Cn slope for zero lift for linear Cn curve (1/rad)\n')) - f.write('{: f}\t{:}'.format(param['CnPosStall'], 'Cn at stall value for positive angle of attack for linear Cn curve\n')) - f.write('{: f}\t{:}'.format(param['CnNegStall'], 'Cn at stall value for negative angle of attack for linear Cn curve\n')) - f.write('{: f}\t{:}'.format(param['alphaCdMin'], 'Angle of attack for minimum CD (deg)\n')) - f.write('{: f}\t{:}'.format(param['CdMin'], 'Minimum CD value\n')) - if param['cm']: - for a, cl, cd, cm in zip(param['alpha'], param['cl'], param['cd'], param['cm']): - f.write('{: 6e} {: 6e} {: 6e} {: 6e}\n'.format(a, cl, cd, cm)) - else: - for a, cl, cd in zip(param['alpha'], param['cl'], param['cd']): - f.write('{: 6e} {: 6e} {: 6e}\n'.format(a, cl, cd)) - - f.flush() - os.fsync(f) - f.close() - def write_OLAF(self): olaf_file = os.path.join(self.FAST_runDirectory, self.FAST_namingOut + '_OLAF.dat') @@ -1229,46 +1225,46 @@ def write_OLAF(self): f.write('--------------------------- OLAF (cOnvecting LAgrangian Filaments) INPUT FILE -----------------\n') f.write('Generated by OpenFAST_IO\n') f.write('--------------------------- GENERAL OPTIONS ---------------------------------------------------\n') - f.write('{:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn15']['OLAF']['IntMethod'], 'IntMethod', '- Integration method {1: RK4, 5: Forward Euler 1st order, default: 5} (switch)\n')) - f.write('{:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn15']['OLAF']['DTfvw'], 'DTfvw', '- Time interval for wake propagation. {default: dtaero} (s)\n')) - f.write('{:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn15']['OLAF']['FreeWakeStart'], 'FreeWakeStart', '- Time when wake is free. (-) value = always free. {default: 0.0} (s)\n')) - f.write('{:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn15']['OLAF']['FullCircStart'], 'FullCircStart', '- Time at which full circulation is reached. {default: 0.0} (s)\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn']['OLAF']['IntMethod'], 'IntMethod', '- Integration method {1: RK4, 5: Forward Euler 1st order, default: 5} (switch)\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn']['OLAF']['DTfvw'], 'DTfvw', '- Time interval for wake propagation. {default: dtaero} (s)\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn']['OLAF']['FreeWakeStart'], 'FreeWakeStart', '- Time when wake is free. (-) value = always free. {default: 0.0} (s)\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn']['OLAF']['FullCircStart'], 'FullCircStart', '- Time at which full circulation is reached. {default: 0.0} (s)\n')) f.write('--------------------------- CIRCULATION SPECIFICATIONS ----------------------------------------\n') - f.write('{:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn15']['OLAF']['CircSolvMethod'], 'CircSolvingMethod', '- Circulation solving method {1: Cl-Based, 2: No-Flow Through, 3: Prescribed, default: 1 }(switch)\n')) - f.write('{:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn15']['OLAF']['CircSolvConvCrit'], 'CircSolvConvCrit', ' - Convergence criteria {default: 0.001} [only if CircSolvMethod=1] (-)\n')) - f.write('{:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn15']['OLAF']['CircSolvRelaxation'], 'CircSolvRelaxation', '- Relaxation factor {default: 0.1} [only if CircSolvMethod=1] (-)\n')) - f.write('{:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn15']['OLAF']['CircSolvMaxIter'], 'CircSolvMaxIter', ' - Maximum number of iterations for circulation solving {default: 30} (-)\n')) - f.write('{:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn15']['OLAF']['PrescribedCircFile'], 'PrescribedCircFile','- File containing prescribed circulation [only if CircSolvMethod=3] (quoted string)\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn']['OLAF']['CircSolvMethod'], 'CircSolvingMethod', '- Circulation solving method {1: Cl-Based, 2: No-Flow Through, 3: Prescribed, default: 1 }(switch)\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn']['OLAF']['CircSolvConvCrit'], 'CircSolvConvCrit', ' - Convergence criteria {default: 0.001} [only if CircSolvMethod=1] (-)\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn']['OLAF']['CircSolvRelaxation'], 'CircSolvRelaxation', '- Relaxation factor {default: 0.1} [only if CircSolvMethod=1] (-)\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn']['OLAF']['CircSolvMaxIter'], 'CircSolvMaxIter', ' - Maximum number of iterations for circulation solving {default: 30} (-)\n')) + f.write('{:<22} {:<11} {:}'.format('"'+self.fst_vt['AeroDyn']['OLAF']['PrescribedCircFile']+'"', 'PrescribedCircFile','- File containing prescribed circulation [only if CircSolvMethod=3] (quoted string)\n')) f.write('===============================================================================================\n') f.write('--------------------------- WAKE OPTIONS ------------------------------------------------------\n') f.write('------------------- WAKE EXTENT AND DISCRETIZATION --------------------------------------------\n') - f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['AeroDyn15']['OLAF']['nNWPanels'], 'nNWPanels','- Number of near-wake panels (-)\n')) - f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['AeroDyn15']['OLAF']['nNWPanelsFree'], 'nNWPanelsFree','- Number of free near-wake panels (-) {default: nNWPanels}\n')) - f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['AeroDyn15']['OLAF']['nFWPanels'], 'nFWPanels','- Number of far-wake panels (-) {default: 0}\n')) - f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['AeroDyn15']['OLAF']['nFWPanelsFree'], 'nFWPanelsFree','- Number of free far-wake panels (-) {default: nFWPanels}\n')) - f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn15']['OLAF']['FWShedVorticity'], 'FWShedVorticity','- Include shed vorticity in the far wake {default: False}\n')) + f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['AeroDyn']['OLAF']['nNWPanels'], 'nNWPanels','- Number of near-wake panels (-)\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn']['OLAF']['nNWPanelsFree'], 'nNWPanelsFree','- Number of free near-wake panels (-) {default: nNWPanels}\n')) + f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['AeroDyn']['OLAF']['nFWPanels'], 'nFWPanels','- Number of far-wake panels (-) {default: 0}\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn']['OLAF']['nFWPanelsFree'], 'nFWPanelsFree','- Number of free far-wake panels (-) {default: nFWPanels}\n')) + f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn']['OLAF']['FWShedVorticity'], 'FWShedVorticity','- Include shed vorticity in the far wake {default: False}\n')) f.write('------------------- WAKE REGULARIZATIONS AND DIFFUSION -----------------------------------------\n') - f.write('{:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn15']['OLAF']['DiffusionMethod'], 'DiffusionMethod','- Diffusion method to account for viscous effects {0: None, 1: Core Spreading, "default": 0}\n')) - f.write('{:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn15']['OLAF']['RegDeterMethod'], 'RegDeterMethod','- Method to determine the regularization parameters {0: Manual, 1: Optimized, 2: Chord, 3: Span, default: 0 }\n')) - f.write('{:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn15']['OLAF']['RegFunction'], 'RegFunction','- Viscous diffusion function {0: None, 1: Rankine, 2: LambOseen, 3: Vatistas, 4: Denominator, "default": 3} (switch)\n')) - f.write('{:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn15']['OLAF']['WakeRegMethod'], 'WakeRegMethod','- Wake regularization method {1: Constant, 2: Stretching, 3: Age, default: 3} (switch)\n')) - f.write('{:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn15']['OLAF']['WakeRegFactor'], 'WakeRegFactor','- Wake regularization factor (m)\n')) - f.write('{:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn15']['OLAF']['WingRegFactor'], 'WingRegFactor','- Wing regularization factor (m)\n')) - f.write('{:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn15']['OLAF']['CoreSpreadEddyVisc'], 'CoreSpreadEddyVisc','- Eddy viscosity in core spreading methods, typical values 1-1000\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn']['OLAF']['DiffusionMethod'], 'DiffusionMethod','- Diffusion method to account for viscous effects {0: None, 1: Core Spreading, "default": 0}\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn']['OLAF']['RegDeterMethod'], 'RegDeterMethod','- Method to determine the regularization parameters {0: Manual, 1: Optimized, 2: Chord, 3: Span, default: 0 }\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn']['OLAF']['RegFunction'], 'RegFunction','- Viscous diffusion function {0: None, 1: Rankine, 2: LambOseen, 3: Vatistas, 4: Denominator, "default": 3} (switch)\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn']['OLAF']['WakeRegMethod'], 'WakeRegMethod','- Wake regularization method {1: Constant, 2: Stretching, 3: Age, default: 3} (switch)\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn']['OLAF']['WakeRegFactor'], 'WakeRegFactor','- Wake regularization factor (m)\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn']['OLAF']['WingRegFactor'], 'WingRegFactor','- Wing regularization factor (m)\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn']['OLAF']['CoreSpreadEddyVisc'], 'CoreSpreadEddyVisc','- Eddy viscosity in core spreading methods, typical values 1-1000\n')) f.write('------------------- WAKE TREATMENT OPTIONS ---------------------------------------------------\n') - f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn15']['OLAF']['TwrShadowOnWake'], 'TwrShadowOnWake','- Include tower flow disturbance effects on wake convection {default:false} [only if TwrPotent or TwrShadow]\n')) - f.write('{:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn15']['OLAF']['ShearModel'], 'ShearModel','- Shear Model {0: No treatment, 1: Mirrored vorticity, default: 0}\n')) + f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn']['OLAF']['TwrShadowOnWake'], 'TwrShadowOnWake','- Include tower flow disturbance effects on wake convection {default:false} [only if TwrPotent or TwrShadow]\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn']['OLAF']['ShearModel'], 'ShearModel','- Shear Model {0: No treatment, 1: Mirrored vorticity, default: 0}\n')) f.write('------------------- SPEEDUP OPTIONS -----------------------------------------------------------\n') - f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['AeroDyn15']['OLAF']['VelocityMethod'], 'VelocityMethod','- Method to determine the velocity {1:Segment N^2, 2:Particle tree, 3:Particle N^2, 4:Segment tree, default: 2}\n')) - f.write('{:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn15']['OLAF']['TreeBranchFactor'], 'TreeBranchFactor','- Branch radius fraction above which a multipole calculation is used {default: 1.5} [only if VelocityMethod=2,4]\n')) - f.write('{:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn15']['OLAF']['PartPerSegment'], 'PartPerSegment','- Number of particles per segment {default: 1} [only if VelocityMethod=2,3]\n')) + f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['AeroDyn']['OLAF']['VelocityMethod'], 'VelocityMethod','- Method to determine the velocity {1:Segment N^2, 2:Particle tree, 3:Particle N^2, 4:Segment tree, default: 2}\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn']['OLAF']['TreeBranchFactor'], 'TreeBranchFactor','- Branch radius fraction above which a multipole calculation is used {default: 1.5} [only if VelocityMethod=2,4]\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn']['OLAF']['PartPerSegment'], 'PartPerSegment','- Number of particles per segment {default: 1} [only if VelocityMethod=2,3]\n')) f.write('===============================================================================================\n') f.write('--------------------------- OUTPUT OPTIONS ---------------------------------------------------\n') - f.write('{:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn15']['OLAF']['WrVTk'], 'WrVTk','- Outputs Visualization Toolkit (VTK) (independent of .fst option) {0: NoVTK, 1: Write VTK at VTK_fps, 2: Write VTK at init and final, default: 0} (flag)\n')) - f.write('{:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn15']['OLAF']['nVTKBlades'], 'nVTKBlades','- Number of blades for which VTK files are exported {0: No VTK per blade, n: VTK for blade 1 to n, default: 0} (-) \n')) - f.write('{:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn15']['OLAF']['VTKCoord'], 'VTKCoord','- Coordinate system used for VTK export. {1: Global, 2: Hub, 3: Both, default: 1} \n')) - f.write('{:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn15']['OLAF']['VTK_fps'], 'VTK_fps','- Frame rate for VTK output (frames per second) {"all" for all glue code timesteps, "default" for all OLAF timesteps} [only if WrVTK=1]\n')) - f.write('{:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn15']['OLAF']['nGridOut'], 'nGridOut','- Number of grid outputs\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn']['OLAF']['WrVTk'], 'WrVTk','- Outputs Visualization Toolkit (VTK) (independent of .fst option) {0: NoVTK, 1: Write VTK at VTK_fps, 2: Write VTK at init and final, default: 0} (flag)\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn']['OLAF']['nVTKBlades'], 'nVTKBlades','- Number of blades for which VTK files are exported {0: No VTK per blade, n: VTK for blade 1 to n, default: 0} (-) \n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn']['OLAF']['VTKCoord'], 'VTKCoord','- Coordinate system used for VTK export. {1: Global, 2: Hub, 3: Both, default: 1} \n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn']['OLAF']['VTK_fps'], 'VTK_fps','- Frame rate for VTK output (frames per second) {"all" for all glue code timesteps, "default" for all OLAF timesteps} [only if WrVTK=1]\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['AeroDyn']['OLAF']['nGridOut'], 'nGridOut','- Number of grid outputs\n')) f.write('GridName GridType TStart TEnd DTGrid XStart XEnd nX YStart YEnd nY ZStart ZEnd nZ\n') f.write('(-) (-) (s) (s) (s) (m) (m) (-) (m) (m) (-) (m) (m) (-)\n') f.write('===============================================================================================\n') @@ -1279,6 +1275,59 @@ def write_OLAF(self): os.fsync(f) f.close() + def write_AeroDisk(self): + # Writing the aeroDisk input file + self.fst_vt['Fst']['AeroFile'] = self.FAST_namingOut + '_AeroDisk.dat' + adisk_file = os.path.join(self.FAST_runDirectory,self.fst_vt['Fst']['AeroFile']) + f = open(adisk_file,'w') + + f.write('--- AERO DISK INPUT FILE -------\n') + f.write('Generated with OpenFAST_IO\n') + f.write('--- SIMULATION CONTROL ---------\n') + f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['AeroDisk']['Echo'], 'Echo', '- Echo input data to ".ADsk.ech" (flag)\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['AeroDisk']['DT'], 'DT', '- Integration time step (s)\n')) + f.write('--- ENVIRONMENTAL CONDITIONS ---\n') + f.write('{:<22f} {:<11} {:}'.format(self.fst_vt['AeroDisk']['AirDens'], 'AirDens', '- Air density (kg/m^3) (or "default")\n')) + f.write('--- ACTUATOR DISK PROPERTIES ---\n') + f.write('{:<22f} {:<11} {:}'.format(self.fst_vt['AeroDisk']['RotorRad'], 'RotorRad', '- Rotor radius (m) (or "default")\n')) + f.write('"{:<22}" {:<11} {:}'.format(', '.join(['%s'%i for i in self.fst_vt['AeroDisk']['InColNames']]), 'InColNames', '- Input column headers (string) {may include a combination of "TSR, RtSpd, VRel, Pitch, Skew"} (up to 4 columns) [choose TSR or RtSpd,VRel; if Skew is absent, Skew is modeled as (COS(Skew))^2]\n')) + f.write('{:<22} {:<11} {:}'.format(', '.join(['%s'%i for i in self.fst_vt['AeroDisk']['InColDims']]), 'InColDims', '- Number of unique values in each column (-) (must have same number of columns as InColName) [each >=2]\n')) + self.write_AeroDiskProp() + f.write('@{:<22} {:}'.format(self.fst_vt['AeroDisk']['actuatorDiskFile'], '\n')) + f.write('--- OUTPUTS --------------------\n') + f.write('{:<22} {:<11} {:}'.format('OutList', 'OutList', '- The next line(s) contains a list of output parameters. See OutListParameters.xlsx for a listing of available output channels, (-)\n')) + + outlist = self.get_outlist(self.fst_vt['outlist'], ['AeroDisk']) + for channel_list in outlist: + for i in range(len(channel_list)): + f.write('"' + channel_list[i] + '"\n') + + f.write('END of input file (the word "END" must appear in the first 3 columns of the last OutList line)\n') + f.write('---------------------------------------------------------------------------------------\n') + + f.flush() + os.fsync(f) + f.close() + + def write_AeroDiskProp(self): + # Writing the aeroDiskProp input file + + self.fst_vt['AeroDisk']['actuatorDiskFile'] = self.FAST_namingOut + '_AeroDiskProp.csv' + adiskprop_file = os.path.join(self.FAST_runDirectory,self.fst_vt['AeroDisk']['actuatorDiskFile']) + f = open(adiskprop_file,'w') + + f.write('{:<22} {:}'.format(self.fst_vt['AeroDisk']['actuatorDiskTable']['dsc'],'\n')) + f.write('{:<22} {:}'.format(', '.join(['%s'%i for i in self.fst_vt['AeroDisk']['actuatorDiskTable']['attr']]), '\n')) + f.write('{:<22} {:}'.format(', '.join(['%s'%i for i in self.fst_vt['AeroDisk']['actuatorDiskTable']['units']]), '\n')) + for idx in range(len(self.fst_vt['AeroDisk']['actuatorDiskTable']['data'])): + f.write('{:<22} {:}'.format(', '.join(['%.6f'%i for i in self.fst_vt['AeroDisk']['actuatorDiskTable']['data'][idx]]), '\n')) + + f.flush() + os.fsync(f) + f.close() + + + def write_ServoDyn(self): # ServoDyn v1.05 Input File @@ -1286,7 +1335,7 @@ def write_ServoDyn(self): sd_file = os.path.join(self.FAST_runDirectory,self.fst_vt['Fst']['ServoFile']) f = open(sd_file,'w') - f.write('------- SERVODYN v1.05.* INPUT FILE --------------------------------------------\n') + f.write('------- SERVODYN INPUT FILE --------------------------------------------\n') f.write('Generated with OpenFAST_IO\n') f.write('---------------------- SIMULATION CONTROL --------------------------------------\n') f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['ServoDyn']['Echo'], 'Echo', '- Echo input data to .ech (flag)\n')) @@ -1346,28 +1395,28 @@ def write_ServoDyn(self): f.write('{:<22} {:<11} {:}'.format(self.fst_vt['ServoDyn']['YawManRat'], 'YawManRat', '- Yaw maneuver rate (in absolute value) (deg/s)\n')) f.write('{:<22} {:<11} {:}'.format(self.fst_vt['ServoDyn']['NacYawF'], 'NacYawF', '- Final yaw angle for override yaw maneuvers (degrees)\n')) f.write('---------------------- Aerodynamic Flow Control -------------------------------------\n') - f.write('{:<22} {:<11} {:}'.format(self.fst_vt['ServoDyn']['AfCmode'], 'AfCmode', '- Airfoil control mode {0- none, 1- cosine wave cycle, 4- user-defined from Simulink/Labview, 5- user-defined from Bladed-style DLL}\n')) - f.write('{:<22} {:<11} {:}'.format(self.fst_vt['ServoDyn']['AfC_Mean'], 'AfC_Mean', '- Mean level for sinusoidal cycling or steady value (-) [used only with AfCmode==1]\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['ServoDyn']['AfCmode'], 'AfCmode', '- Airfoil control mode {0: none, 1: cosine wave cycle, 4: user-defined from Simulink/Labview, 5: user-defined from Bladed-style DLL} (switch)\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['ServoDyn']['AfC_Mean'], 'AfC_Mean', '- Mean level for cosine cycling or steady value (-) [used only with AfCmode==1]\n')) f.write('{:<22} {:<11} {:}'.format(self.fst_vt['ServoDyn']['AfC_Amp'], 'AfC_Amp', '- Amplitude for for cosine cycling of flap signal (AfC = AfC_Amp*cos(Azimuth+phase)+AfC_mean) (-) [used only with AfCmode==1]\n')) f.write('{:<22} {:<11} {:}'.format(self.fst_vt['ServoDyn']['AfC_Phase'], 'AfC_phase', '- Phase relative to the blade azimuth (0 is vertical) for for cosine cycling of flap signal (deg) [used only with AfCmode==1]\n')) f.write('---------------------- STRUCTURAL CONTROL ---------------------------------------\n') f.write('{:<22} {:<11} {:}'.format(self.fst_vt['ServoDyn']['NumBStC'], 'NumBStC', '- Number of blade structural controllers (integer)\n')) - f.write('{!s:<22} {:<11} {:}'.format('"' + '" "'.join(self.fst_vt['ServoDyn']['BStCfiles']) + '"', 'BStCfiles', '- Name of the file for blade tuned mass damper (quoted string) [unused when CompNTMD is false]\n')) + f.write('{!s:<22} {:<11} {:}'.format('"' + '" "'.join(self.fst_vt['ServoDyn']['BStCfiles']) + '"', 'BStCfiles', '- Name of the files for blade structural controllers (quoted strings) [unused when NumBStC==0]\n')) f.write('{:<22} {:<11} {:}'.format(self.fst_vt['ServoDyn']['NumNStC'], 'NumNStC', '- Number of nacelle structural controllers (integer)\n')) - f.write('{!s:<22} {:<11} {:}'.format('"' + '" "'.join(self.fst_vt['ServoDyn']['NStCfiles']) + '"', 'NStCfiles', '- Name of the file for nacelle tuned mass damper (quoted string) [unused when CompNTMD is false]\n')) + f.write('{!s:<22} {:<11} {:}'.format('"' + '" "'.join(self.fst_vt['ServoDyn']['NStCfiles']) + '"', 'NStCfiles', '- Name of the files for nacelle structural controllers (quoted strings) [unused when NumNStC==0]\n')) f.write('{:<22} {:<11} {:}'.format(self.fst_vt['ServoDyn']['NumTStC'], 'NumTStC', '- Number of tower structural controllers (integer)\n')) - f.write('{!s:<22} {:<11} {:}'.format('"' + '" "'.join(self.fst_vt['ServoDyn']['TStCfiles']) + '"', 'TStCfiles', '- Name of the file for tower tuned mass damper (quoted string) [unused when CompNTMD is false]\n')) - f.write('{:<22} {:<11} {:}'.format(self.fst_vt['ServoDyn']['NumSStC'], 'NumSStC', '- Number of sbustructure structural controllers (integer)\n')) - f.write('{!s:<22} {:<11} {:}'.format('"' + '" "'.join(self.fst_vt['ServoDyn']['SStCfiles']) + '"', 'SStCfiles', '- Name of the file for sbustructure tuned mass damper (quoted string) [unused when CompNTMD is false]\n')) + f.write('{!s:<22} {:<11} {:}'.format('"' + '" "'.join(self.fst_vt['ServoDyn']['TStCfiles']) + '"', 'TStCfiles', '- Name of the files for tower structural controllers (quoted strings) [unused when NumTStC==0]\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['ServoDyn']['NumSStC'], 'NumSStC', '- Number of substructure structural controllers (integer)\n')) + f.write('{!s:<22} {:<11} {:}'.format('"' + '" "'.join(self.fst_vt['ServoDyn']['SStCfiles']) + '"', 'SStCfiles', '- Name of the files for substructure structural controllers (quoted strings) [unused when NumSStC==0]\n')) f.write('---------------------- CABLE CONTROL ---------------------------------------- \n') - f.write('{:<22} {:<11} {:}'.format(self.fst_vt['ServoDyn']['CCmode'], 'CCmode', '- Cable control mode {0- none, 4- user-defined from Simulink/Labview, 5- user-defineAfC_phased from Bladed-style DLL}\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['ServoDyn']['CCmode'], 'CCmode', '- Cable control mode {0: none, 4: user-defined from Simulink/Labview, 5: user-defined from Bladed-style DLL} (switch)\n')) f.write('---------------------- BLADED INTERFACE ---------------------------------------- [used only with Bladed Interface]\n') f.write('{:<22} {:<11} {:}'.format('"'+self.fst_vt['ServoDyn']['DLL_FileName']+'"', 'DLL_FileName', '- Name/location of the dynamic library {.dll [Windows] or .so [Linux]} in the Bladed-DLL format (-) [used only with Bladed Interface]\n')) f.write('{:<22} {:<11} {:}'.format('"'+self.fst_vt['ServoDyn']['DLL_InFile']+'"', 'DLL_InFile', '- Name of input file sent to the DLL (-) [used only with Bladed Interface]\n')) f.write('{:<22} {:<11} {:}'.format('"'+self.fst_vt['ServoDyn']['DLL_ProcName']+'"', 'DLL_ProcName', '- Name of procedure in DLL to be called (-) [case sensitive; used only with DLL Interface]\n')) f.write('{:<22} {:<11} {:}'.format(self.fst_vt['ServoDyn']['DLL_DT'], 'DLL_DT', '- Communication interval for dynamic library (s) (or "default") [used only with Bladed Interface]\n')) f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['ServoDyn']['DLL_Ramp'], '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]\n')) - f.write('{:<22} {:<11} {:}'.format(self.fst_vt['ServoDyn']['BPCutoff'], 'BPCutoff', '- Cuttoff frequency for low-pass filter on blade pitch from DLL (Hz) [used only with Bladed Interface]\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['ServoDyn']['BPCutoff'], 'BPCutoff', '- Cutoff frequency for low-pass filter on blade pitch from DLL (Hz) [used only with Bladed Interface]\n')) f.write('{:<22} {:<11} {:}'.format(self.fst_vt['ServoDyn']['NacYaw_North'], 'NacYaw_North', '- Reference yaw angle of the nacelle when the upwind end points due North (deg) [used only with Bladed Interface]\n')) f.write('{:<22} {:<11} {:}'.format(self.fst_vt['ServoDyn']['Ptch_Cntrl'], 'Ptch_Cntrl', '- Record 28: Use individual pitch control {0: collective pitch; 1: individual pitch control} (switch) [used only with Bladed Interface]\n')) f.write('{:<22} {:<11} {:}'.format(self.fst_vt['ServoDyn']['Ptch_SetPnt'], 'Ptch_SetPnt', '- Record 5: Below-rated pitch angle set-point (deg) [used only with Bladed Interface]\n')) @@ -1402,7 +1451,7 @@ def write_ServoDyn(self): for i in range(len(channel_list)): f.write('"' + channel_list[i] + '"\n') - f.write('END of input file (the word "END" must appear in the first 3 columns of this last OutList line)\n') + f.write('END of input file (the word "END" must appear in the first 3 columns of the last OutList line)\n') f.write('---------------------------------------------------------------------------------------\n') f.flush() @@ -1410,7 +1459,7 @@ def write_ServoDyn(self): f.close() def write_DISCON_in(self): - # Generate Bladed style Interface controller input file, intended for ROSCO https://github.com/NREL/rosco.toolbox + # Generate Bladed style Interface controller input file, intended for ROSCO https://github.com/NREL/ROSCO_toolbox # Fill controller and turbine objects for ROSCO # - controller @@ -1450,94 +1499,54 @@ def write_DISCON_in(self): rosco_vt=self.fst_vt['DISCON_in'] ) + def write_spd_trq(self): + # generate the spd_trq.dat file when VSContrl == 3 + spd_trq_file = os.path.join(self.FAST_runDirectory, 'spd_trq.dat') + f = open(spd_trq_file, 'w') + + f.write('{:}'.format(self.fst_vt['spd_trq']['header'], '\n')) + for i in range(len(self.fst_vt['spd_trq']['RPM'])): + f.write('{:<22f} {:<22f} {:}'.format(self.fst_vt['spd_trq']['RPM'][i], self.fst_vt['spd_trq']['Torque'][i], '\n')) + def write_HydroDyn(self): - # Generate HydroDyn v2.03 input file + # Generate HydroDyn input file self.fst_vt['Fst']['HydroFile'] = self.FAST_namingOut + '_HydroDyn.dat' hd_file = os.path.join(self.FAST_runDirectory, self.fst_vt['Fst']['HydroFile']) f = open(hd_file, 'w') - f.write('------- HydroDyn v2.03.* Input File --------------------------------------------\n') + f.write('------- HydroDyn Input File --------------------------------------------\n') f.write('Generated with OpenFAST_IO\n') f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['HydroDyn']['Echo'], 'Echo', '- Echo the input file data (flag)\n')) - f.write('---------------------- ENVIRONMENTAL CONDITIONS --------------------------------\n') - f.write('{:<22} {:<11} {:}'.format(self.fst_vt['HydroDyn']['WtrDens'], 'WtrDens', '- Water density (kg/m^3)\n')) - f.write('{:<22} {:<11} {:}'.format(self.fst_vt['HydroDyn']['WtrDpth'], 'WtrDpth', '- Water depth (meters)\n')) - f.write('{:<22} {:<11} {:}'.format(self.fst_vt['HydroDyn']['MSL2SWL'], 'MSL2SWL', '- Offset between still-water level and mean sea level (meters) [positive upward; unused when WaveMod = 6; must be zero if PotMod=1 or 2]\n')) - f.write('---------------------- WAVES ---------------------------------------------------\n') - f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['HydroDyn']['WaveMod'], 'WaveMod', '- Incident wave kinematics model {0: none=still water, 1: regular (periodic), 1P#: regular with user-specified phase, 2: JONSWAP/Pierson-Moskowitz spectrum (irregular), 3: White noise spectrum (irregular), 4: user-defined spectrum from routine UserWaveSpctrm (irregular), 5: Externally generated wave-elevation time series, 6: Externally generated full wave-kinematics time series [option 6 is invalid for PotMod/=0]} (switch)\n')) - f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['HydroDyn']['WaveStMod'], 'WaveStMod', '- Model for stretching incident wave kinematics to instantaneous free surface {0: none=no stretching, 1: vertical stretching, 2: extrapolation stretching, 3: Wheeler stretching} (switch) [unused when WaveMod=0 or when PotMod/=0]\n')) - f.write('{:<22} {:<11} {:}'.format(self.fst_vt['HydroDyn']['WaveTMax'], 'WaveTMax', '- Analysis time for incident wave calculations (sec) [unused when WaveMod=0; determines WaveDOmega=2Pi/WaveTMax in the IFFT]\n')) - f.write('{:<22} {:<11} {:}'.format(self.fst_vt['HydroDyn']['WaveDT'], 'WaveDT', '- Time step for incident wave calculations (sec) [unused when WaveMod=0; 0.1<=WaveDT<=1.0 recommended; determines WaveOmegaMax=Pi/WaveDT in the IFFT]\n')) - f.write('{:<22} {:<11} {:}'.format(self.fst_vt['HydroDyn']['WaveHs'], 'WaveHs', '- Significant wave height of incident waves (meters) [used only when WaveMod=1, 2, or 3]\n')) - f.write('{:<22} {:<11} {:}'.format(self.fst_vt['HydroDyn']['WaveTp'], 'WaveTp', '- Peak-spectral period of incident waves (sec) [used only when WaveMod=1 or 2]\n')) - if isinstance(self.fst_vt['HydroDyn']['WavePkShp'], float): - if self.fst_vt['HydroDyn']['WavePkShp'] == 0.: - WavePkShp = 'Default' - else: - WavePkShp = self.fst_vt['HydroDyn']['WavePkShp'] - else: - WavePkShp = self.fst_vt['HydroDyn']['WavePkShp'] - f.write('{:<22} {:<11} {:}'.format(WavePkShp, 'WavePkShp', '- Peak-shape parameter of incident wave spectrum (-) or DEFAULT (string) [used only when WaveMod=2; use 1.0 for Pierson-Moskowitz]\n')) - f.write('{:<22} {:<11} {:}'.format(self.fst_vt['HydroDyn']['WvLowCOff'], 'WvLowCOff', '- Low cut-off frequency or lower frequency limit of the wave spectrum beyond which the wave spectrum is zeroed (rad/s) [unused when WaveMod=0, 1, or 6]\n')) - f.write('{:<22} {:<11} {:}'.format(self.fst_vt['HydroDyn']['WvHiCOff'], 'WvHiCOff', '- High cut-off frequency or upper frequency limit of the wave spectrum beyond which the wave spectrum is zeroed (rad/s) [unused when WaveMod=0, 1, or 6]\n')) - f.write('{:<22} {:<11} {:}'.format(self.fst_vt['HydroDyn']['WaveDir'], 'WaveDir', '- Incident wave propagation heading direction (degrees) [unused when WaveMod=0 or 6]\n')) - f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['HydroDyn']['WaveDirMod'], 'WaveDirMod', '- Directional spreading function {0: none, 1: COS2S} (-) [only used when WaveMod=2,3, or 4]\n')) - f.write('{:<22} {:<11} {:}'.format(self.fst_vt['HydroDyn']['WaveDirSpread'], 'WaveDirSpread', '- Wave direction spreading coefficient ( > 0 ) (-) [only used when WaveMod=2,3, or 4 and WaveDirMod=1]\n')) - f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['HydroDyn']['WaveNDir'], 'WaveNDir', '- Number of wave directions (-) [only used when WaveMod=2,3, or 4 and WaveDirMod=1; odd number only]\n')) - f.write('{:<22} {:<11} {:}'.format(self.fst_vt['HydroDyn']['WaveDirRange'], 'WaveDirRange', '- Range of wave directions (full range: WaveDir +/- 1/2*WaveDirRange) (degrees) [only used when WaveMod=2,3,or 4 and WaveDirMod=1]\n')) - f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['HydroDyn']['WaveSeed1'], 'WaveSeed(1)', '- First random seed of incident waves [-2147483648 to 2147483647] (-) [unused when WaveMod=0, 5, or 6]\n')) - - try: - seed2 = int(self.fst_vt['HydroDyn']['WaveSeed2']) - f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['HydroDyn']['WaveSeed2'], 'WaveSeed(2)', '- Second random seed of incident waves [-2147483648 to 2147483647] (-) [unused when WaveMod=0, 5, or 6]\n')) - except ValueError: - f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['HydroDyn']['WaveSeed2'], 'WaveSeed(2)', '- Second random seed of incident waves [-2147483648 to 2147483647] (-) [unused when WaveMod=0, 5, or 6] for intrinsic pRNG, or an alternative pRNG: "RanLux"\n')) - - f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['HydroDyn']['WaveNDAmp'], 'WaveNDAmp', '- Flag for normally distributed amplitudes (flag) [only used when WaveMod=2, 3, or 4]\n')) - f.write('{:<22} {:<11} {:}'.format('"'+self.fst_vt['HydroDyn']['WvKinFile']+'"', 'WvKinFile', '- Root name of externally generated wave data file(s) (quoted string) [used only when WaveMod=5 or 6]\n')) - f.write('{:<22} {:<11} {:}'.format(self.fst_vt['HydroDyn']['NWaveElev'], 'NWaveElev', '- Number of points where the incident wave elevations can be computed (-) [maximum of 9 output locations]\n')) - f.write('{:<22} {:<11} {:}'.format(", ".join(self.fst_vt['HydroDyn']['WaveElevxi']), 'WaveElevxi', '- List of xi-coordinates for points where the incident wave elevations can be output (meters) [NWaveElev points, separated by commas or white space; usused if NWaveElev = 0]\n')) - f.write('{:<22} {:<11} {:}'.format(", ".join(self.fst_vt['HydroDyn']['WaveElevyi']), 'WaveElevyi', '- List of yi-coordinates for points where the incident wave elevations can be output (meters) [NWaveElev points, separated by commas or white space; usused if NWaveElev = 0]\n')) - f.write('---------------------- 2ND-ORDER WAVES ----------------------------------------- [unused with WaveMod=0 or 6]\n') - f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['HydroDyn']['WvDiffQTF'], 'WvDiffQTF', '- Full difference-frequency 2nd-order wave kinematics (flag)\n')) - f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['HydroDyn']['WvSumQTF'], 'WvSumQTF', '- Full summation-frequency 2nd-order wave kinematics (flag)\n')) - f.write('{:<22} {:<11} {:}'.format(self.fst_vt['HydroDyn']['WvLowCOffD'], 'WvLowCOffD', '- Low frequency cutoff used in the difference-frequencies (rad/s) [Only used with a difference-frequency method]\n')) - f.write('{:<22} {:<11} {:}'.format(self.fst_vt['HydroDyn']['WvHiCOffD'], 'WvHiCOffD', '- High frequency cutoff used in the difference-frequencies (rad/s) [Only used with a difference-frequency method]\n')) - f.write('{:<22} {:<11} {:}'.format(self.fst_vt['HydroDyn']['WvLowCOffS'], 'WvLowCOffS', '- Low frequency cutoff used in the summation-frequencies (rad/s) [Only used with a summation-frequency method]\n')) - f.write('{:<22} {:<11} {:}'.format(self.fst_vt['HydroDyn']['WvHiCOffS'], 'WvHiCOffS', '- High frequency cutoff used in the summation-frequencies (rad/s) [Only used with a summation-frequency method]\n')) - f.write('---------------------- CURRENT ------------------------------------------------- [unused with WaveMod=6]\n') - f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['HydroDyn']['CurrMod'], 'CurrMod', '- Current profile model {0: none=no current, 1: standard, 2: user-defined from routine UserCurrent} (switch)\n')) - f.write('{:<22} {:<11} {:}'.format(self.fst_vt['HydroDyn']['CurrSSV0'], 'CurrSSV0', '- Sub-surface current velocity at still water level (m/s) [used only when CurrMod=1]\n')) - f.write('{:<22} {:<11} {:}'.format(self.fst_vt['HydroDyn']['CurrSSDir'], 'CurrSSDir', '- Sub-surface current heading direction (degrees) or DEFAULT (string) [used only when CurrMod=1]\n')) - f.write('{:<22} {:<11} {:}'.format(self.fst_vt['HydroDyn']['CurrNSRef'], 'CurrNSRef', '- Near-surface current reference depth (meters) [used only when CurrMod=1]\n')) - f.write('{:<22} {:<11} {:}'.format(self.fst_vt['HydroDyn']['CurrNSV0'], 'CurrNSV0', '- Near-surface current velocity at still water level (m/s) [used only when CurrMod=1]\n')) - f.write('{:<22} {:<11} {:}'.format(self.fst_vt['HydroDyn']['CurrNSDir'], 'CurrNSDir', '- Near-surface current heading direction (degrees) [used only when CurrMod=1]\n')) - f.write('{:<22} {:<11} {:}'.format(self.fst_vt['HydroDyn']['CurrDIV'], 'CurrDIV', '- Depth-independent current velocity (m/s) [used only when CurrMod=1]\n')) - f.write('{:<22} {:<11} {:}'.format(self.fst_vt['HydroDyn']['CurrDIDir'], 'CurrDIDir', '- Depth-independent current heading direction (degrees) [used only when CurrMod=1]\n')) f.write('---------------------- FLOATING PLATFORM --------------------------------------- [unused with WaveMod=6]\n') f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['HydroDyn']['PotMod'], 'PotMod', '- Potential-flow model {0: none=no potential flow, 1: frequency-to-time-domain transforms based on WAMIT output, 2: fluid-impulse theory (FIT)} (switch)\n')) - f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['HydroDyn']['ExctnMod'], 'ExctnMod', '- Wave Excitation model {0: None, 1: DFT, 2: state-space} (switch) [only used when PotMod=1; STATE-SPACE REQUIRES *.ssexctn INPUT FILE]\n')) + f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['HydroDyn']['ExctnMod'], 'ExctnMod', '- Wave-excitation model {0: no wave-excitation calculation, 1: DFT, 2: state-space} (switch) [only used when PotMod=1; STATE-SPACE REQUIRES *.ssexctn INPUT FILE]\n')) + f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['HydroDyn']['ExctnDisp'], 'ExctnDisp','- Method of computing Wave Excitation {0: use undisplaced position, 1: use displaced position, 2: use low-pass filtered displaced position) [only used when PotMod=1 and ExctnMod>0 and SeaState\'s WaveMod>0]} (switch)\n')) + f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['HydroDyn']['ExctnCutOff'], 'ExctnCutOff','- Cutoff (corner) frequency of the low-pass time-filtered displaced position (Hz) [>0.0] [used only when PotMod=1, ExctnMod>0, and ExctnDisp=2]) [only used when PotMod=1 and ExctnMod>0 and SeaState\'s WaveMod>0]} (switch)\n')) + f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['HydroDyn']['PtfmYMod'], 'PtfmYMod', '- Model for large platform yaw offset {0: Static reference yaw offset based on PtfmRefY, 1: dynamic reference yaw offset based on low-pass filtering the PRP yaw motion with cutoff frequency PtfmYCutOff} (switch)\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['HydroDyn']['PtfmRefY'], 'PtfmRefY', '- Constant (if PtfmYMod=0) or initial (if PtfmYMod=1) platform reference yaw offset (deg)\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['HydroDyn']['PtfmYCutOff'], 'PtfmYCutOff', '- Cutoff frequency for the low-pass filtering of PRP yaw motion when PtfmYMod=1 [unused when PtfmYMod=0] (Hz)\n')) + f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['HydroDyn']['NExctnHdg'], 'NExctnHdg', '- Number of evenly distributed platform yaw/heading angles over the range of [-180, 180) deg for which the wave excitation shall be computed [only used when PtfmYMod=1] (-)\n')) f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['HydroDyn']['RdtnMod'], 'RdtnMod', '- Radiation memory-effect model {0: no memory-effect calculation, 1: convolution, 2: state-space} (switch) [only used when PotMod=1; STATE-SPACE REQUIRES *.ss INPUT FILE]\n')) - f.write('{:<22} {:<11} {:}'.format(self.fst_vt['HydroDyn']['RdtnTMax'], 'RdtnTMax', '- Analysis time for wave radiation kernel calculations (sec) [only used when PotMod=1; determines RdtnDOmega=Pi/RdtnTMax in the cosine transform; MAKE SURE THIS IS LONG ENOUGH FOR THE RADIATION IMPULSE RESPONSE FUNCTIONS TO DECAY TO NEAR-ZERO FOR THE GIVEN PLATFORM!]\n')) - f.write('{:<22} {:<11} {:}'.format(self.fst_vt['HydroDyn']['RdtnDT'], 'RdtnDT', '- Time step for wave radiation kernel calculations (sec) [only used when PotMod=1; DT<=RdtnDT<=0.1 recommended; determines RdtnOmegaMax=Pi/RdtnDT in the cosine transform]\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['HydroDyn']['RdtnTMax'], 'RdtnTMax', '- Analysis time for wave radiation kernel calculations (sec) [only used when PotMod=1 and RdtnMod>0; determines RdtnDOmega=Pi/RdtnTMax in the cosine transform; MAKE SURE THIS IS LONG ENOUGH FOR THE RADIATION IMPULSE RESPONSE FUNCTIONS TO DECAY TO NEAR-ZERO FOR THE GIVEN PLATFORM!]\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['HydroDyn']['RdtnDT'], 'RdtnDT', '- Time step for wave radiation kernel calculations (sec) [only used when PotMod=1 and ExctnMod>0 or RdtnMod>0; DT<=RdtnDT<=0.1 recommended; determines RdtnOmegaMax=Pi/RdtnDT in the cosine transform]\n')) f.write('{:<22} {:<11} {:}'.format(self.fst_vt['HydroDyn']['NBody'], 'NBody', '- Number of WAMIT bodies to be used (-) [>=1; only used when PotMod=1. If NBodyMod=1, the WAMIT data contains a vector of size 6*NBody x 1 and matrices of size 6*NBody x 6*NBody; if NBodyMod>1, there are NBody sets of WAMIT data each with a vector of size 6 x 1 and matrices of size 6 x 6]\n')) f.write('{:<22} {:<11} {:}'.format(self.fst_vt['HydroDyn']['NBodyMod'], 'NBodyMod', '- Body coupling model {1: include coupling terms between each body and NBody in HydroDyn equals NBODY in WAMIT, 2: neglect coupling terms between each body and NBODY=1 with XBODY=0 in WAMIT, 3: Neglect coupling terms between each body and NBODY=1 with XBODY=/0 in WAMIT} (switch) [only used when PotMod=1]\n')) - f.write('{:<22} {:<11} {:}'.format('"'+self.fst_vt['HydroDyn']['PotFile']+'"', 'PotFile', '- Root name of potential-flow model data; WAMIT output files containing the linear, nondimensionalized, hydrostatic restoring matrix (.hst), frequency-dependent hydrodynamic added mass matrix and damping matrix (.1), and frequency- and direction-dependent wave excitation force vector per unit wave amplitude (.3) (quoted string) [MAKE SURE THE FREQUENCIES INHERENT IN THESE WAMIT FILES SPAN THE PHYSICALLY-SIGNIFICANT RANGE OF FREQUENCIES FOR THE GIVEN PLATFORM; THEY MUST CONTAIN THE ZERO- AND INFINITE-FREQUENCY LIMITS!]\n')) - f.write('{:<22} {:<11} {:}'.format(self.fst_vt['HydroDyn']['WAMITULEN'], 'WAMITULEN', '- Characteristic body length scale used to redimensionalize WAMIT output (meters) [only used when PotMod=1]\n')) - f.write('{:<22} {:<11} {:}'.format(self.fst_vt['HydroDyn']['PtfmRefxt'], 'PtfmRefxt', '- The xt offset of the body reference point(s) from (0,0,0) (meters) [1 to NBody] [only used when PotMod=1]\n')) - f.write('{:<22} {:<11} {:}'.format(self.fst_vt['HydroDyn']['PtfmRefyt'], 'PtfmRefyt', '- The yt offset of the body reference point(s) from (0,0,0) (meters) [1 to NBody] [only used when PotMod=1]\n')) - f.write('{:<22} {:<11} {:}'.format(self.fst_vt['HydroDyn']['PtfmRefzt'], 'PtfmRefzt', '- The zt offset of the body reference point(s) from (0,0,0) (meters) [1 to NBody] [only used when PotMod=1. If NBodyMod=2,PtfmRefzt=0.0]\n')) - f.write('{:<22} {:<11} {:}'.format(self.fst_vt['HydroDyn']['PtfmRefztRot'], 'PtfmRefztRot', '- The rotation about zt of the body reference frame(s) from xt/yt (degrees) [1 to NBody] [only used when PotMod=1]\n')) - f.write('{:<22} {:<11} {:}'.format(self.fst_vt['HydroDyn']['PtfmVol0'], 'PtfmVol0', '- Displaced volume of water when the platform is in its undisplaced position (m^3) [only used when PotMod=1; USE THE SAME VALUE COMPUTED BY WAMIT AS OUTPUT IN THE .OUT FILE!]\n')) - f.write('{:<22} {:<11} {:}'.format(self.fst_vt['HydroDyn']['PtfmCOBxt'], 'PtfmCOBxt', '- The xt offset of the center of buoyancy (COB) from the platform reference point (meters) [only used when PotMod=1]\n')) - f.write('{:<22} {:<11} {:}'.format(self.fst_vt['HydroDyn']['PtfmCOByt'], 'PtfmCOByt', '- The yt offset of the center of buoyancy (COB) from the platform reference point (meters) [only used when PotMod=1]\n')) + f.write('{:<22} {:<11} {:}'.format(', '.join([f'"{pf}"' for pf in self.fst_vt['HydroDyn']['PotFile']]), 'PotFile', '- Root name of potential-flow model data; WAMIT output files containing the linear, nondimensionalized, hydrostatic restoring matrix (.hst), frequency-dependent hydrodynamic added mass matrix and damping matrix (.1), and frequency- and direction-dependent wave excitation force vector per unit wave amplitude (.3) (quoted string) [1 to NBody if NBodyMod>1] [MAKE SURE THE FREQUENCIES INHERENT IN THESE WAMIT FILES SPAN THE PHYSICALLY-SIGNIFICANT RANGE OF FREQUENCIES FOR THE GIVEN PLATFORM; THEY MUST CONTAIN THE ZERO- AND INFINITE-FREQUENCY LIMITS!]\n')) + f.write('{:<22} {:<11} {:}'.format(', '.join([f'{val}' for val in self.fst_vt['HydroDyn']['WAMITULEN']]), 'WAMITULEN', '- Characteristic body length scale used to redimensionalize WAMIT output (meters) [1 to NBody if NBodyMod>1] [only used when PotMod=1]\n')) + f.write('{:<22} {:<11} {:}'.format(', '.join([f'{val}' for val in self.fst_vt['HydroDyn']['PtfmRefxt']]), 'PtfmRefxt', '- The xt offset of the body reference point(s) from (0,0,0) (meters) [1 to NBody] [only used when PotMod=1]\n')) + f.write('{:<22} {:<11} {:}'.format(', '.join([f'{val}' for val in self.fst_vt['HydroDyn']['PtfmRefyt']]), 'PtfmRefyt', '- The yt offset of the body reference point(s) from (0,0,0) (meters) [1 to NBody] [only used when PotMod=1]\n')) + f.write('{:<22} {:<11} {:}'.format(', '.join([f'{val}' for val in self.fst_vt['HydroDyn']['PtfmRefzt']]), 'PtfmRefzt', '- The zt offset of the body reference point(s) from (0,0,0) (meters) [1 to NBody] [only used when PotMod=1. If NBodyMod=2,PtfmRefzt=0.0]\n')) + f.write('{:<22} {:<11} {:}'.format(', '.join([f'{val}' for val in self.fst_vt['HydroDyn']['PtfmRefztRot']]), 'PtfmRefztRot', '- The rotation about zt of the body reference frame(s) from xt/yt (degrees) [1 to NBody] [only used when PotMod=1]\n')) + f.write('{:<22} {:<11} {:}'.format(', '.join([f'{val}' for val in self.fst_vt['HydroDyn']['PtfmVol0']]), 'PtfmVol0', '- Displaced volume of water when the body is in its undisplaced position (m^3) [1 to NBody] [only used when PotMod=1; USE THE SAME VALUE COMPUTED BY WAMIT AS OUTPUT IN THE .OUT FILE!]\n')) + f.write('{:<22} {:<11} {:}'.format(', '.join([f'{val}' for val in self.fst_vt['HydroDyn']['PtfmCOBxt']]), 'PtfmCOBxt', '- The xt offset of the center of buoyancy (COB) from (0,0) (meters) [1 to NBody] [only used when PotMod=1]\n')) + f.write('{:<22} {:<11} {:}'.format(', '.join([f'{val}' for val in self.fst_vt['HydroDyn']['PtfmCOByt']]), 'PtfmCOByt', '- The yt offset of the center of buoyancy (COB) from (0,0) (meters) [1 to NBody] [only used when PotMod=1]\n')) f.write('---------------------- 2ND-ORDER FLOATING PLATFORM FORCES ---------------------- [unused with WaveMod=0 or 6, or PotMod=0 or 2]\n') f.write('{:<22} {:<11} {:}'.format(self.fst_vt['HydroDyn']['MnDrift'], 'MnDrift', "- Mean-drift 2nd-order forces computed {0: None; [7, 8, 9, 10, 11, or 12]: WAMIT file to use} [Only one of MnDrift, NewmanApp, or DiffQTF can be non-zero]\n")) f.write('{:<22} {:<11} {:}'.format(self.fst_vt['HydroDyn']['NewmanApp'], 'NewmanApp', "- Mean- and slow-drift 2nd-order forces computed with Newman's approximation {0: None; [7, 8, 9, 10, 11, or 12]: WAMIT file to use} [Only one of MnDrift, NewmanApp, or DiffQTF can be non-zero. Used only when WaveDirMod=0]\n")) f.write('{:<22} {:<11} {:}'.format(self.fst_vt['HydroDyn']['DiffQTF'], 'DiffQTF', "- Full difference-frequency 2nd-order forces computed with full QTF {0: None; [10, 11, or 12]: WAMIT file to use} [Only one of MnDrift, NewmanApp, or DiffQTF can be non-zero]\n")) f.write('{:<22} {:<11} {:}'.format(self.fst_vt['HydroDyn']['SumQTF'], 'SumQTF', "- Full summation -frequency 2nd-order forces computed with full QTF {0: None; [10, 11, or 12]: WAMIT file to use}\n")) - f.write('---------------------- PLATFORM ADDITIONAL STIFFNESS AND DAMPING --------------\n') + f.write('---------------------- PLATFORM ADDITIONAL STIFFNESS AND DAMPING -------------- [unused with PotMod=0 or 2]\n') for j in range(6): if type(self.fst_vt['HydroDyn']['AddF0'][j]) == float: ln = '{:14} '.format(self.fst_vt['HydroDyn']['AddF0'][j]) @@ -1557,7 +1566,7 @@ def write_HydroDyn(self): except: ln = " ".join(['{:14}'.format(i) for i in self.fst_vt['HydroDyn']['AddCLin'][j]]) if j == 0: - ln = ln + " AddCLin - Additional linear stiffness (N/m, N/rad, N-m/m, N-m/rad)\n" + ln = ln + " AddCLin - Additional linear stiffness (N/m, N/rad, N-m/m, N-m/rad) [If NBodyMod=1, one size 6*NBody x 6*NBody matrix; if NBodyMod>1, NBody size 6 x 6 matrices]\n" else: ln = ln + "\n" f.write(ln) @@ -1567,7 +1576,7 @@ def write_HydroDyn(self): except: ln = " ".join(['{:14}'.format(i) for i in self.fst_vt['HydroDyn']['AddBLin'][j]]) if j == 0: - ln = ln + " AddBLin - Additional linear damping(N/(m/s), N/(rad/s), N-m/(m/s), N-m/(rad/s))\n" + ln = ln + " AddBLin - Additional linear damping(N/(m/s), N/(rad/s), N-m/(m/s), N-m/(rad/s)) [If NBodyMod=1, one size 6*NBody x 6*NBody matrix; if NBodyMod>1, NBody size 6 x 6 matrices]\n" else: ln = ln + "\n" f.write(ln) @@ -1577,20 +1586,28 @@ def write_HydroDyn(self): except: ln = " ".join(['{:14}'.format(i) for i in self.fst_vt['HydroDyn']['AddBQuad'][j]]) if j == 0: - ln = ln + " AddBQuad - Additional quadratic drag(N/(m/s)^2, N/(rad/s)^2, N-m(m/s)^2, N-m/(rad/s)^2)\n" + ln = ln + " AddBQuad - Additional quadratic drag(N/(m/s)^2, N/(rad/s)^2, N-m(m/s)^2, N-m/(rad/s)^2) [If NBodyMod=1, one size 6*NBody x 6*NBody matrix; if NBodyMod>1, NBody size 6 x 6 matrices]\n" else: ln = ln + "\n" f.write(ln) + + f.write('---------------------- STRIP THEORY OPTIONS --------------------------------------\n') + f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['HydroDyn']['WaveDisp'], 'WaveDisp', '- Method of computing Wave Kinematics {0: use undisplaced position, 1: use displaced position) } (switch)\n')) + f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['HydroDyn']['AMMod'], 'AMMod', '- Method of computing distributed added-mass force. (0: Only and always on nodes below SWL at the undisplaced position. 2: Up to the instantaneous free surface) [overwrite to 0 when WaveMod = 0 or 6 or when WaveStMod = 0 in SeaState]\n')) + f.write('---------------------- AXIAL COEFFICIENTS --------------------------------------\n') f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['HydroDyn']['NAxCoef'], 'NAxCoef', '- Number of axial coefficients (-)\n')) - f.write(" ".join(['{:^11s}'.format(i) for i in ['AxCoefID', 'AxCd', 'AxCa', 'AxCp']])+'\n') - f.write(" ".join(['{:^11s}'.format(i) for i in ['(-)']*4])+'\n') + f.write(" ".join(['{:^11s}'.format(i) for i in ['AxCoefID', 'AxCd', 'AxCa', 'AxCp', 'AxFDMod', 'AxVnCOff', 'AxFDLoFSc']])+'\n') + f.write(" ".join(['{:^11s}'.format(i) for i in ['(-)']*7])+'\n') for i in range(self.fst_vt['HydroDyn']['NAxCoef']): ln = [] ln.append('{:^11d}'.format(self.fst_vt['HydroDyn']['AxCoefID'][i])) ln.append('{:^11}'.format(self.fst_vt['HydroDyn']['AxCd'][i])) ln.append('{:^11}'.format(self.fst_vt['HydroDyn']['AxCa'][i])) ln.append('{:^11}'.format(self.fst_vt['HydroDyn']['AxCp'][i])) + ln.append('{:^11}'.format(self.fst_vt['HydroDyn']['AxFDMod'][i])) + ln.append('{:^11}'.format(self.fst_vt['HydroDyn']['AxVnCOff'][i])) + ln.append('{:^11}'.format(self.fst_vt['HydroDyn']['AxFDLoFSc'][i])) f.write(" ".join(ln) + '\n') f.write('---------------------- MEMBER JOINTS -------------------------------------------\n') f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['HydroDyn']['NJoints'], 'NJoints', '- Number of joints (-) [must be exactly 0 or at least 2]\n')) @@ -1616,8 +1633,8 @@ def write_HydroDyn(self): ln.append('{:^11}'.format(self.fst_vt['HydroDyn']['PropThck'][i])) f.write(" ".join(ln) + '\n') f.write('---------------------- SIMPLE HYDRODYNAMIC COEFFICIENTS (model 1) --------------\n') - f.write(" ".join(['{:^11s}'.format(i) for i in ['SimplCd', 'SimplCdMG', 'SimplCa', 'SimplCaMG', 'SimplCp', 'SimplCpMG', 'SimplAxCd', 'SimplAxCdMG', 'SimplAxCa', 'SimplAxCaMG', 'SimplAxCp', 'SimplAxCpMG']])+'\n') - f.write(" ".join(['{:^11s}'.format(i) for i in ['(-)']*12])+'\n') + f.write(" ".join(['{:^11s}'.format(i) for i in ['SimplCd', 'SimplCdMG', 'SimplCa', 'SimplCaMG', 'SimplCp', 'SimplCpMG', 'SimplAxCd', 'SimplAxCdMG', 'SimplAxCa', 'SimplAxCaMG', 'SimplAxCp', 'SimplAxCpMG', 'SimplCb', 'SimplCbMG']])+'\n') + f.write(" ".join(['{:^11s}'.format(i) for i in ['(-)']*14])+'\n') ln = [] ln.append('{:^11}'.format(self.fst_vt['HydroDyn']['SimplCd'])) ln.append('{:^11}'.format(self.fst_vt['HydroDyn']['SimplCdMG'])) @@ -1631,10 +1648,12 @@ def write_HydroDyn(self): ln.append('{:^11}'.format(self.fst_vt['HydroDyn']['SimplAxCaMG'])) ln.append('{:^11}'.format(self.fst_vt['HydroDyn']['SimplAxCp'])) ln.append('{:^11}'.format(self.fst_vt['HydroDyn']['SimplAxCpMG'])) + ln.append('{:^11}'.format(self.fst_vt['HydroDyn']['SimplCb'])) + ln.append('{:^11}'.format(self.fst_vt['HydroDyn']['SimplCbMG'])) f.write(" ".join(ln) + '\n') f.write('---------------------- DEPTH-BASED HYDRODYNAMIC COEFFICIENTS (model 2) ---------\n') f.write('{:<11d} {:<11} {:}'.format(self.fst_vt['HydroDyn']['NCoefDpth'], 'NCoefDpth', '- Number of depth-dependent coefficients (-)\n')) - f.write(" ".join(['{:^11s}'.format(i) for i in ['Dpth', 'DpthCd', 'DpthCdMG', 'DpthCa', 'DpthCaMG', 'DpthCp', 'DpthCpMG', 'DpthAxCd', 'DpthAxCdMG', 'DpthAxCa', 'DpthAxCaMG', 'DpthAxCp', 'DpthAxCpMG']])+'\n') + f.write(" ".join(['{:^11s}'.format(i) for i in ['Dpth', 'DpthCd', 'DpthCdMG', 'DpthCa', 'DpthCaMG', 'DpthCp', 'DpthCpMG', 'DpthAxCd', 'DpthAxCdMG', 'DpthAxCa', 'DpthAxCaMG', 'DpthAxCp', 'DpthAxCpMG', 'DpthCb', 'DpthCbMG']])+'\n') f.write(" ".join(['{:^11s}'.format(i) for i in ['(m)', '(-)', '(-)', '(-)', '(-)', '(-)', '(-)', '(-)', '(-)', '(-)', '(-)', '(-)', '(-)']])+'\n') for i in range(self.fst_vt['HydroDyn']['NCoefDpth']): ln = [] @@ -1651,11 +1670,14 @@ def write_HydroDyn(self): ln.append('{:^11}'.format(self.fst_vt['HydroDyn']['DpthAxCaMG'][i])) ln.append('{:^11}'.format(self.fst_vt['HydroDyn']['DpthAxCp'][i])) ln.append('{:^11}'.format(self.fst_vt['HydroDyn']['DpthAxCpMG'][i])) + ln.append('{:^11}'.format(self.fst_vt['HydroDyn']['DpthCb'][i])) + ln.append('{:^11}'.format(self.fst_vt['HydroDyn']['DpthCbMG'][i])) f.write(" ".join(ln) + '\n') f.write('---------------------- MEMBER-BASED HYDRODYNAMIC COEFFICIENTS (model 3) --------\n') f.write('{:<11d} {:<11} {:}'.format(self.fst_vt['HydroDyn']['NCoefMembers'], 'NCoefMembers', '- Number of member-based coefficients (-)\n')) - f.write(" ".join(['{:^11s}'.format(i) for i in ['MemberID_HydC', 'MemberCd1', 'MemberCd2', 'MemberCdMG1', 'MemberCdMG2', 'MemberCa1', 'MemberCa2', 'MemberCaMG1', 'MemberCaMG2', 'MemberCp1', 'MemberCp2', 'MemberCpMG1', 'MemberCpMG2', 'MemberAxCd1', 'MemberAxCd2', 'MemberAxCdMG1', 'MemberAxCdMG2', 'MemberAxCa1', 'MemberAxCa2', 'MemberAxCaMG1', 'MemberAxCaMG2', 'MemberAxCp1', 'MemberAxCp2', 'MemberAxCpMG1', 'MemberAxCpMG2']])+'\n') - f.write(" ".join(['{:^11s}'.format(i) for i in ['(-)']*25])+'\n') + mem_coeff_names = ['MemberID_HydC', 'MemberCd1', 'MemberCd2', 'MemberCdMG1', 'MemberCdMG2', 'MemberCa1', 'MemberCa2', 'MemberCaMG1', 'MemberCaMG2', 'MemberCp1', 'MemberCp2', 'MemberCpMG1', 'MemberCpMG2', 'MemberAxCd1', 'MemberAxCd2', 'MemberAxCdMG1', 'MemberAxCdMG2', 'MemberAxCa1', 'MemberAxCa2', 'MemberAxCaMG1', 'MemberAxCaMG2', 'MemberAxCp1', 'MemberAxCp2', 'MemberAxCpMG1', 'MemberAxCpMG2','MemberCb1','MemberCb2','MemberCbMG1','MemberCbMG2'] + f.write(" ".join(['{:^11s}'.format(i) for i in mem_coeff_names])+'\n') + f.write(" ".join(['{:^11s}'.format(i) for i in ['(-)']*len(mem_coeff_names)])+'\n') for i in range(self.fst_vt['HydroDyn']['NCoefMembers']): ln = [] ln.append('{:^11d}'.format(self.fst_vt['HydroDyn']['MemberID_HydC'][i])) @@ -1683,11 +1705,15 @@ def write_HydroDyn(self): ln.append('{:^11}'.format(self.fst_vt['HydroDyn']['MemberAxCp2'][i])) ln.append('{:^11}'.format(self.fst_vt['HydroDyn']['MemberAxCpMG1'][i])) ln.append('{:^11}'.format(self.fst_vt['HydroDyn']['MemberAxCpMG2'][i])) + ln.append('{:^11}'.format(self.fst_vt['HydroDyn']['MemberCb1'][i])) + ln.append('{:^11}'.format(self.fst_vt['HydroDyn']['MemberCb2'][i])) + ln.append('{:^11}'.format(self.fst_vt['HydroDyn']['MemberCbMG1'][i])) + ln.append('{:^11}'.format(self.fst_vt['HydroDyn']['MemberCbMG2'][i])) f.write(" ".join(ln) + '\n') f.write('-------------------- MEMBERS -------------------------------------------------\n') f.write('{:<11d} {:<11} {:}'.format(self.fst_vt['HydroDyn']['NMembers'], 'NMembers', '- Number of members (-)\n')) - f.write(" ".join(['{:^11s}'.format(i) for i in ['MemberID', 'MJointID1', 'MJointID2', 'MPropSetID1', 'MPropSetID2', 'MDivSize', 'MCoefMod', 'PropPot']])+' ! [MCoefMod=1: use simple coeff table, 2: use depth-based coeff table, 3: use member-based coeff table] [ PropPot/=0 if member is modeled with potential-flow theory]\n') - f.write(" ".join(['{:^11s}'.format(i) for i in ['(-)', '(-)', '(-)', '(-)', '(-)', '(m)', '(switch)', '(flag)']])+'\n') + f.write(" ".join(['{:^11s}'.format(i) for i in ['MemberID', 'MJointID1', 'MJointID2', 'MPropSetID1', 'MPropSetID2', 'MDivSize', 'MCoefMod', 'MHstLMod', 'PropPot']])+' ! [MCoefMod=1: use simple coeff table, 2: use depth-based coeff table, 3: use member-based coeff table] [ PropPot/=0 if member is modeled with potential-flow theory]\n') + f.write(" ".join(['{:^11s}'.format(i) for i in ['(-)', '(-)', '(-)', '(-)', '(-)', '(m)', '(switch)', '(switch)', '(flag)']])+'\n') for i in range(self.fst_vt['HydroDyn']['NMembers']): ln = [] ln.append('{:^11d}'.format(self.fst_vt['HydroDyn']['MemberID'][i])) @@ -1697,6 +1723,7 @@ def write_HydroDyn(self): ln.append('{:^11d}'.format(self.fst_vt['HydroDyn']['MPropSetID2'][i])) ln.append('{:^11}'.format(self.fst_vt['HydroDyn']['MDivSize'][i])) ln.append('{:^11d}'.format(self.fst_vt['HydroDyn']['MCoefMod'][i])) + ln.append('{:^11d}'.format(self.fst_vt['HydroDyn']['MHstLMod'][i])) ln.append('{!s:^11}'.format(self.fst_vt['HydroDyn']['PropPot'][i])) f.write(" ".join(ln) + '\n') f.write("---------------------- FILLED MEMBERS ------------------------------------------\n") @@ -1721,8 +1748,8 @@ def write_HydroDyn(self): ln.append('{:^11}'.format(self.fst_vt['HydroDyn']['MGDens'][i])) f.write(" ".join(ln) + '\n') f.write("---------------------- MEMBER OUTPUT LIST --------------------------------------\n") - f.write('{:<11d} {:<11} {:}'.format(self.fst_vt['HydroDyn']['NMOutputs'], 'NMOutputs', '- Number of member outputs (-) [must be < 10]\n')) - f.write(" ".join(['{:^11s}'.format(i) for i in ['MemberID_out', 'NOutLoc', 'NodeLocs']])+'\n') + f.write('{:<11d} {:<11} {:}'.format(self.fst_vt['HydroDyn']['NMOutputs'], 'NMOutputs', '- Number of member outputs (-) [must be <=99]\n')) + f.write(" ".join(['{:^11s}'.format(i) for i in ['MemberID_out', 'NOutLoc', 'NodeLocs [NOutLoc < 10; node locations are normalized distance from the start of the member, and must be >=0 and <= 1] [unused if NMOutputs=0]']])+'\n') f.write(" ".join(['{:^11s}'.format(i) for i in ['(-)']*3])+'\n') for i in range(self.fst_vt['HydroDyn']['NMOutputs']): ln = [] @@ -1747,30 +1774,137 @@ def write_HydroDyn(self): f.write('END of output channels and end of file. (the word "END" must appear in the first 3 columns of this line)\n') + f.close() - f.flush() - os.fsync(f) + def write_SeaState(self): + + # Generate SeaState input file + self.fst_vt['Fst']['SeaStFile'] = self.FAST_namingOut + '_SeaState.dat' + hd_file = os.path.join(self.FAST_runDirectory, self.fst_vt['Fst']['SeaStFile']) + f = open(hd_file, 'w') + + f.write('------- SeaState Input File --------------------------------------------\n') + f.write('Generated with OpenFAST_IO\n') + f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['SeaState']['Echo'], 'Echo', '- Echo the input file data (flag)\n')) + + f.write('---------------------- ENVIRONMENTAL CONDITIONS --------------------------------\n') + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['SeaState']['WtrDens'],'WtrDens', '- Water density (kg/m^3)\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['SeaState']['WtrDpth'],'WtrDpth', '- Water depth (meters) relative to MSL\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['SeaState']['MSL2SWL'],'MSL2SWL', '- Offset between still-water level and mean sea level (meters) [positive upward; unused when WaveMod = 6; must be zero if PotMod=1 or 2]\n')) + + + f.write('---------------------- SPATIAL DISCRETIZATION ---------------------------------------------------\n') + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['SeaState']['X_HalfWidth'], 'X_HalfWidth', '– Half-width of the domain in the X direction (m) [>0, NOTE: X[nX] = nX*dX, where nX = {-NX+1,-NX+2,…,NX-1} and dX = X_HalfWidth/(NX-1)]\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['SeaState']['Y_HalfWidth'], 'Y_HalfWidth', '– Half-width of the domain in the Y direction (m) [>0, NOTE: Y[nY] = nY*dY, where nY = {-NY+1,-NY+2,…,NY-1} and dY = Y_HalfWidth/(NY-1)]\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['SeaState']['Z_Depth'], 'Z_Depth', '– Depth of the domain the Z direction (m) relative to SWL [0 < Z_Depth <= WtrDpth+MSL2SWL; "default": Z_Depth = WtrDpth+MSL2SWL; Z[nZ] = ( COS( nZ*dthetaZ ) – 1 )*Z_Depth, where nZ = {0,1,…NZ-1} and dthetaZ = pi/( 2*(NZ-1) )]\n')) + f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['SeaState']['NX'], 'NX', '– Number of nodes in half of the X-direction domain (-) [>=2]\n')) + f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['SeaState']['NY'], 'NY', '– Number of nodes in half of the Y-direction domain (-) [>=2]\n')) + f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['SeaState']['NZ'], 'NZ', '– Number of nodes in the Z direction (-) [>=2]\n')) + + f.write('---------------------- WAVES ---------------------------------------------------\n') + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['SeaState']['WaveMod'], 'WaveMod', '- Incident wave kinematics model {0: none=still water, 1: regular (periodic), 1P#: regular with user-specified phase, 2: JONSWAP/Pierson-Moskowitz spectrum (irregular), 3: White noise spectrum (irregular), 4: user-defined spectrum from routine UserWaveSpctrm (irregular), 5: Externally generated wave-elevation time series, 6: Externally generated full wave-kinematics time series [option 6 is invalid for PotMod/=0]} (switch)\n')) + f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['SeaState']['WaveStMod'], 'WaveStMod', '- Model for stretching incident wave kinematics to instantaneous free surface {0: none=no stretching, 1: vertical stretching, 2: extrapolation stretching, 3: Wheeler stretching} (switch) [unused when WaveMod=0 or when PotMod/=0]\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['SeaState']['WaveTMax'], 'WaveTMax', '- Analysis time for incident wave calculations (sec) [unused when WaveMod=0; determines WaveDOmega=2Pi/WaveTMax in the IFFT]\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['SeaState']['WaveDT'], 'WaveDT', '- Time step for incident wave calculations (sec) [unused when WaveMod=0 or 7; 0.1<=WaveDT<=1.0 recommended; determines WaveOmegaMax=Pi/WaveDT in the IFFT]\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['SeaState']['WaveHs'], 'WaveHs', '- Significant wave height of incident waves (meters) [used only when WaveMod=1, 2, or 3]\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['SeaState']['WaveTp'], 'WaveTp', '- Peak-spectral period of incident waves (sec) [used only when WaveMod=1 or 2]\n')) + if isinstance(self.fst_vt['SeaState']['WavePkShp'], float): + if self.fst_vt['SeaState']['WavePkShp'] == 0.: + WavePkShp = 'Default' + else: + WavePkShp = self.fst_vt['SeaState']['WavePkShp'] + else: + WavePkShp = self.fst_vt['SeaState']['WavePkShp'] + f.write('{:<22} {:<11} {:}'.format(WavePkShp, 'WavePkShp', '- Peak-shape parameter of incident wave spectrum (-) or DEFAULT (string) [used only when WaveMod=2; use 1.0 for Pierson-Moskowitz]\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['SeaState']['WvLowCOff'], 'WvLowCOff', '- Low cut-off frequency or lower frequency limit of the wave spectrum beyond which the wave spectrum is zeroed (rad/s) [unused when WaveMod=0, 1, or 6]\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['SeaState']['WvHiCOff'], 'WvHiCOff', '- High cut-off frequency or upper frequency limit of the wave spectrum beyond which the wave spectrum is zeroed (rad/s) [unused when WaveMod=0, 1, or 6]\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['SeaState']['WaveDir'], 'WaveDir', '- Incident wave propagation heading direction (degrees) [unused when WaveMod=0, 6 or 7]\n')) + f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['SeaState']['WaveDirMod'], 'WaveDirMod', '- Directional spreading function {0: none, 1: COS2S} (-) [only used when WaveMod=2,3, or 4]\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['SeaState']['WaveDirSpread'], 'WaveDirSpread', '- Wave direction spreading coefficient ( > 0 ) (-) [only used when WaveMod=2,3, or 4 and WaveDirMod=1]\n')) + f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['SeaState']['WaveNDir'], 'WaveNDir', '- Number of wave directions (-) [only used when WaveMod=2,3, or 4 and WaveDirMod=1; odd number only]\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['SeaState']['WaveDirRange'], 'WaveDirRange', '- Range of wave directions (full range: WaveDir +/- 1/2*WaveDirRange) (degrees) [only used when WaveMod=2,3,or 4 and WaveDirMod=1]\n')) + f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['SeaState']['WaveSeed1'], 'WaveSeed(1)', '- First random seed of incident waves [-2147483648 to 2147483647] (-) [unused when WaveMod=0, 5, or 6]\n')) + + try: + seed2 = int(self.fst_vt['SeaState']['WaveSeed2']) + f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['SeaState']['WaveSeed2'], 'WaveSeed(2)', '- Second random seed of incident waves [-2147483648 to 2147483647] (-) [unused when WaveMod=0, 5, or 6]\n')) + except ValueError: + f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['SeaState']['WaveSeed2'], 'WaveSeed(2)', '- Second random seed of incident waves [-2147483648 to 2147483647] (-) for intrinsic pRNG, or an alternative pRNG: "RanLux" (-) [unused when WaveMod=0, 5, or 6]\n')) + + f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['SeaState']['WaveNDAmp'], 'WaveNDAmp', '- Flag for normally distributed amplitudes (flag) [only used when WaveMod=2, 3, or 4]\n')) + f.write('{:<22} {:<11} {:}'.format('"'+self.fst_vt['SeaState']['WvKinFile']+'"', 'WvKinFile', '- Root name of externally generated wave data file(s) (quoted string) [used only when WaveMod=5, 6 or 7]\n')) + f.write('---------------------- 2ND-ORDER WAVES ----------------------------------------- [unused with WaveMod=0 or 6]\n') + f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['SeaState']['WvDiffQTF'], 'WvDiffQTF', '- Full difference-frequency 2nd-order wave kinematics (flag)\n')) + f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['SeaState']['WvSumQTF'], 'WvSumQTF', '- Full summation-frequency 2nd-order wave kinematics (flag)\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['SeaState']['WvLowCOffD'], 'WvLowCOffD', '- Low frequency cutoff used in the difference-frequencies (rad/s) [Only used with a difference-frequency method]\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['SeaState']['WvHiCOffD'], 'WvHiCOffD', '- High frequency cutoff used in the difference-frequencies (rad/s) [Only used with a difference-frequency method]\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['SeaState']['WvLowCOffS'], 'WvLowCOffS', '- Low frequency cutoff used in the summation-frequencies (rad/s) [Only used with a summation-frequency method]\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['SeaState']['WvHiCOffS'], 'WvHiCOffS', '- High frequency cutoff used in the summation-frequencies (rad/s) [Only used with a summation-frequency method]\n')) + f.write('---------------------- CONSTRAINED WAVES ----------------------------------------\n') + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['SeaState']['ConstWaveMod'], 'ConstWaveMod', '- Constrained wave model: 0=none; 1=Constrained wave with specified crest elevation, alpha; 2=Constrained wave with guaranteed peak-to-trough crest height, HCrest (flag)\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['SeaState']['CrestHmax'], 'CrestHmax', '- Crest height (2*alpha for ConstWaveMod=1 or HCrest for ConstWaveMod=2), must be larger than WaveHs (m) [unused when ConstWaveMod=0]\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['SeaState']['CrestTime'], 'CrestTime', '- Time at which the crest appears (s) [unused when ConstWaveMod=0]\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['SeaState']['CrestXi'], 'CrestXi', '- X-position of the crest. (m) [unused when ConstWaveMod=0]\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['SeaState']['CrestYi'], 'CrestYi', '- Y-position of the crest. (m) [unused when ConstWaveMod=0]\n')) + f.write('---------------------- CURRENT ------------------------------------------------- [unused with WaveMod=6]\n') + f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['SeaState']['CurrMod'], 'CurrMod', '- Current profile model {0: none=no current, 1: standard, 2: user-defined from routine UserCurrent} (switch)\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['SeaState']['CurrSSV0'], 'CurrSSV0', '- Sub-surface current velocity at still water level (m/s) [used only when CurrMod=1]\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['SeaState']['CurrSSDir'], 'CurrSSDir', '- Sub-surface current heading direction (degrees) or DEFAULT (string) [used only when CurrMod=1]\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['SeaState']['CurrNSRef'], 'CurrNSRef', '- Near-surface current reference depth (meters) [used only when CurrMod=1]\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['SeaState']['CurrNSV0'], 'CurrNSV0', '- Near-surface current velocity at still water level (m/s) [used only when CurrMod=1]\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['SeaState']['CurrNSDir'], 'CurrNSDir', '- Near-surface current heading direction (degrees) [used only when CurrMod=1]\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['SeaState']['CurrDIV'], 'CurrDIV', '- Depth-independent current velocity (m/s) [used only when CurrMod=1]\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['SeaState']['CurrDIDir'], 'CurrDIDir', '- Depth-independent current heading direction (degrees) [used only when CurrMod=1]\n')) + f.write('---------------------- MacCamy-Fuchs Diffraction Model -------------------------\n') + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['SeaState']['MCFD'],'MCFD', '- MacCamy-Fuchs member radius (ignored if radius <= 0) [must be 0 when WaveMod 0 or 6] \n')) + f.write('---------------------- OUTPUT --------------------------------------------------\n') + f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['SeaState']['SeaStSum'], 'SeaStSum', '- Output a summary file [flag]\n')) + f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['SeaState']['OutSwtch'], 'OutSwtch','- Output requested channels to: [1=SeaState.out, 2=GlueCode.out, 3=both files]\n')) + f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['SeaState']['OutFmt'], 'OutFmt','- Output format for numerical results (quoted string) [not checked for validity!]\n')) + f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['SeaState']['OutSFmt'], 'OutSFmt','- Output format for header strings (quoted string) [not checked for validity!]\n')) + f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['SeaState']['NWaveElev'], 'NWaveElev','- Number of points where the incident wave elevations can be computed (-) [maximum of 9 output locations]\n')) + f.write('{:<22} {:<11} {:}'.format(", ".join([f'{val:f}' for val in self.fst_vt['SeaState']['WaveElevxi']]), 'WaveElevxi', '- List of xi-coordinates for points where the incident wave elevations can be output (meters) [NWaveElev points, separated by commas or white space; usused if NWaveElev = 0]\n')) + f.write('{:<22} {:<11} {:}'.format(", ".join([f'{val:f}' for val in self.fst_vt['SeaState']['WaveElevyi']]), 'WaveElevyi', '- List of yi-coordinates for points where the incident wave elevations can be output (meters) [NWaveElev points, separated by commas or white space; usused if NWaveElev = 0]\n')) + f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['SeaState']['NWaveKin'], 'NWaveKin','- Number of points where the wave kinematics can be output (-) [maximum of 9 output locations]\n')) + + if self.fst_vt['SeaState']['NWaveKin'] > 0 : + f.write('{:<22} {:<11} {:}'.format(", ".join([f'{val:f}' for val in self.fst_vt['SeaState']['WaveKinxi']]), 'WaveKinxi', '- List of xi-coordinates for points where the wave kinematics can be output (meters) [NWaveKin points, separated by commas or white space; usused if NWaveKin = 0]\n')) + f.write('{:<22} {:<11} {:}'.format(", ".join([f'{val:f}' for val in self.fst_vt['SeaState']['WaveKinyi']]), 'WaveKinyi', '- List of yi-coordinates for points where the wave kinematics can be output (meters) [NWaveKin points, separated by commas or white space; usused if NWaveKin = 0]\n')) + f.write('{:<22} {:<11} {:}'.format(", ".join([f'{val:f}' for val in self.fst_vt['SeaState']['WaveKinzi']]), 'WaveKinzi', '- List of zi-coordinates for points where the wave kinematics can be output (meters) [NWaveKin points, separated by commas or white space; usused if NWaveKin = 0]\n')) + else: + f.write('{:<11} {:}'.format('WaveKinxi', '- List of xi-coordinates for points where the wave kinematics can be output (meters) [NWaveKin points, separated by commas or white space; usused if NWaveKin = 0]\n')) + f.write('{:<11} {:}'.format('WaveKinyi', '- List of yi-coordinates for points where the wave kinematics can be output (meters) [NWaveKin points, separated by commas or white space; usused if NWaveKin = 0]\n')) + f.write('{:<11} {:}'.format('WaveKinzi', '- List of zi-coordinates for points where the wave kinematics can be output (meters) [NWaveKin points, separated by commas or white space; usused if NWaveKin = 0]\n')) + + f.write('---------------------- OUTPUT CHANNELS -----------------------------------------\n') + outlist = self.get_outlist(self.fst_vt['outlist'], ['SeaState']) + for channel_list in outlist: + for i in range(len(channel_list)): + f.write('"' + channel_list[i] + '"\n') + + f.write('END of output channels and end of file. (the word "END" must appear in the first 3 columns of this line)\n') + f.close() def write_SubDyn(self): - # Generate SubDyn v1.1 input file + # Generate SubDyn input file self.fst_vt['Fst']['SubFile'] = self.FAST_namingOut + '_SubDyn.dat' sd_file = os.path.join(self.FAST_runDirectory, self.fst_vt['Fst']['SubFile']) f = open(sd_file, 'w') - f.write('----------- SubDyn v1.01.x MultiMember Support Structure Input File ------------\n') + f.write('----------- SubDyn MultiMember Support Structure Input File ------------\n') f.write('Generated with OpenFAST_IO\n') f.write('-------------------------- SIMULATION CONTROL ---------------------------------\n') f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['SubDyn']['Echo'], 'Echo', '- Echo input data to ".SD.ech" (flag)\n')) f.write('{:<22} {:<11} {:}'.format(self.fst_vt['SubDyn']['SDdeltaT'], 'SDdeltaT', '- Local Integration Step. If "default", the glue-code integration step will be used.\n')) f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['SubDyn']['IntMethod'], 'IntMethod', '- Integration Method [1/2/3/4 = RK4/AB4/ABM4/AM2].\n')) f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['SubDyn']['SttcSolve'], 'SttcSolve', '- Solve dynamics about static equilibrium point\n')) - f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['SubDyn']['GuyanLoadCorrection'], 'GuyanLoadCorrection', '- Include extra moment from lever arm at interface and rotate FEM for floating.\n')) + # f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['SubDyn']['GuyanLoadCorrection'], 'GuyanLoadCorrection', '- Include extra moment from lever arm at interface and rotate FEM for floating.\n')) f.write('-------------------- FEA and CRAIG-BAMPTON PARAMETERS---------------------------\n') f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['SubDyn']['FEMMod'], 'FEMMod', '- FEM switch: element model in the FEM. [1= Euler-Bernoulli(E-B); 2=Tapered E-B (unavailable); 3= 2-node Timoshenko; 4= 2-node tapered Timoshenko (unavailable)]\n')) f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['SubDyn']['NDiv'], 'NDiv', '- Number of sub-elements per member\n')) - f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['SubDyn']['CBMod'], 'CBMod', '- [T/F] If True perform C-B reduction, else full FEM dofs will be retained. If True, select Nmodes to retain in C-B reduced system.\n')) - f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['SubDyn']['Nmodes'], 'Nmodes', '- Number of internal modes to retain (ignored if CBMod=False). If Nmodes=0 --> Guyan Reduction.\n')) + # f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['SubDyn']['CBMod'], 'CBMod', '- [T/F] If True perform C-B reduction, else full FEM dofs will be retained. If True, select Nmodes to retain in C-B reduced system.\n')) + f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['SubDyn']['Nmodes'], 'Nmodes', '- Number of internal modes to retain. If Nmodes=0 --> Guyan Reduction. If Nmodes<0 --> retain all modes.\n')) JDampings = self.fst_vt['SubDyn']['JDampings'] if isinstance(JDampings, float): @@ -1790,7 +1924,7 @@ def write_SubDyn(self): f.write('---- STRUCTURE JOINTS: joints connect structure members (~Hydrodyn Input File)---\n') f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['SubDyn']['NJoints'], 'NJoints', '- Number of joints (-)\n')) - f.write(" ".join(['{:^11s}'.format(i) for i in ['JointID','JointXss','JointYss','JointZss','JointType','JointDirX','JointDirY','JointDirZ','JointStiff']])+'\n') + f.write(" ".join(['{:^11s}'.format(i) for i in ['JointID','JointXss','JointYss','JointZss','JointType','JointDirX','JointDirY','JointDirZ','JointStiff']])+' ![Coordinates of Member joints in SS-Coordinate System][JointType={1:cantilever, 2:universal joint, 3:revolute joint, 4:spherical joint}]\n') f.write(" ".join(['{:^11s}'.format(i) for i in ['(-)','(m)','(m)','(m)','(-)','(-)','(-)','(-)','(Nm/rad)']])+'\n') for i in range(self.fst_vt['SubDyn']['NJoints']): ln = [] @@ -1821,7 +1955,7 @@ def write_SubDyn(self): f.write(" ".join(ln) + '\n') f.write('------- INTERFACE JOINTS: 1/0 for Locked (to the TP)/Free DOF @each Interface Joint (only Locked-to-TP implemented thus far (=rigid TP)) ---------\n') f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['SubDyn']['NInterf'], 'NInterf', '- Number of interface joints locked to the Transition Piece (TP): be sure to remove all rigid motion dofs\n')) - f.write(" ".join(['{:^11s}'.format(i) for i in ['IJointID', 'ItfTDXss', 'ItfTDYss', 'ItfTDZss', 'ItfRDXss', 'ItfRDYss', 'ItfRDZss']])+' ! [Global Coordinate System]\n') + f.write(" ".join(['{:^11s}'.format(i) for i in ['IJointID', 'ItfTDXss', 'ItfTDYss', 'ItfTDZss', 'ItfRDXss', 'ItfRDYss', 'ItfRDZss']])+'\n') f.write(" ".join(['{:^11s}'.format(i) for i in ['(-)', '(flag)', '(flag)', '(flag)', '(flag)', '(flag)', '(flag)']])+'\n') for i in range(self.fst_vt['SubDyn']['NInterf']): ln = [] @@ -1835,7 +1969,7 @@ def write_SubDyn(self): f.write(" ".join(ln) + '\n') f.write('----------------------------------- MEMBERS --------------------------------------\n') f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['SubDyn']['NMembers'], 'NMembers', '- Number of frame members\n')) - f.write(" ".join(['{:^11s}'.format(i) for i in ['MemberID', 'MJointID1', 'MJointID2', 'MPropSetID1', 'MPropSetID2', 'MType', 'COSMID']])+'\n') + f.write(" ".join(['{:^11s}'.format(i) for i in ['MemberID', 'MJointID1', 'MJointID2', 'MPropSetID1', 'MPropSetID2', 'MType', 'COSMID']])+' ![MType={1:beam circ., 2:cable, 3:rigid, 4:beam arb.}. COMSID={-1:none}]\n') f.write(" ".join(['{:^11s}'.format(i) for i in ['(-)','(-)','(-)','(-)','(-)','(-)','(-)']])+'\n') for i in range(self.fst_vt['SubDyn']['NMembers']): ln = [] @@ -1845,11 +1979,12 @@ def write_SubDyn(self): ln.append('{:^11d}'.format(self.fst_vt['SubDyn']['MPropSetID1'][i])) ln.append('{:^11d}'.format(self.fst_vt['SubDyn']['MPropSetID2'][i])) ln.append('{:^11d}'.format(self.fst_vt['SubDyn']['MType'][i])) - if self.fst_vt['SubDyn']['NCOSMs'] > 0: - ln.append('{:^11d}'.format(self.fst_vt['SubDyn']['COSMID'][i])) + # Need to change M_COSMID None elements to -1 + self.fst_vt['SubDyn']['M_COSMID'][i] = -1 if self.fst_vt['SubDyn']['M_COSMID'][i] is None else self.fst_vt['SubDyn']['M_COSMID'][i] + ln.append('{:^11d}'.format(self.fst_vt['SubDyn']['M_COSMID'][i])) f.write(" ".join(ln) + '\n') - f.write('------------------ MEMBER X-SECTION PROPERTY data 1/2 [isotropic material for now: use this table for circular-tubular elements] ------------------------\n') - f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['SubDyn']['NPropSets'], 'NPropSets', '- Number of structurally unique x-sections (i.e. how many groups of X-sectional properties are utilized throughout all of the members)\n')) + f.write('------------------ CIRCULAR BEAM CROSS-SECTION PROPERTIES -----------------------------\n') + f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['SubDyn']['NPropSets'], 'NPropSets', '- Number of structurally unique cross-sections\n')) f.write(" ".join(['{:^11s}'.format(i) for i in ['PropSetID', 'YoungE', 'ShearG1', 'MatDens', 'XsecD', 'XsecT']])+'\n') f.write(" ".join(['{:^11s}'.format(i) for i in ['(-)','(N/m2)','(N/m2)','(kg/m3)','(m)','(m)']])+'\n') for i in range(self.fst_vt['SubDyn']['NPropSets']): @@ -1861,8 +1996,8 @@ def write_SubDyn(self): ln.append('{:^11}'.format(self.fst_vt['SubDyn']['XsecD'][i])) ln.append('{:^11}'.format(self.fst_vt['SubDyn']['XsecT'][i])) f.write(" ".join(ln) + '\n') - f.write('------------------ 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] ------------------------\n') - f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['SubDyn']['NXPropSets'], 'NXPropSets', '- Number of structurally unique non-circular x-sections (if 0 the following table is ignored)\n')) + f.write('----------------- ARBITRARY BEAM CROSS-SECTION PROPERTIES -----------------------------\n') + f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['SubDyn']['NXPropSets'], 'NXPropSets', '- Number of structurally unique non-circular cross-sections (if 0 the following table is ignored)\n')) f.write(" ".join(['{:^11s}'.format(i) for i in ['PropSetID', 'YoungE', 'ShearG2', 'MatDens', 'XsecA', 'XsecAsx', 'XsecAsy', 'XsecJxx', 'XsecJyy', 'XsecJ0']])+'\n') f.write(" ".join(['{:^11s}'.format(i) for i in ['(-)','(N/m2)','(N/m2)','(kg/m3)','(m2)','(m2)','(m2)','(m4)','(m4)','(m4)']])+'\n') for i in range(self.fst_vt['SubDyn']['NXPropSets']): @@ -1898,6 +2033,22 @@ def write_SubDyn(self): ln.append('{:^11d}'.format(self.fst_vt['SubDyn']['RigidPropSetID'][i])) ln.append('{:^11}'.format(self.fst_vt['SubDyn']['RigidMatDens'][i])) f.write(" ".join(ln) + '\n') + f.write('----------------------- SPRING ELEMENT PROPERTIES ------------------------------------\n') + spring_list = ['k11','k12','k13','k14','k15','k16', + 'k22','k23','k24','k25','k26', + 'k33','k34','k35','k36', + 'k44','k45','k46', + 'k55','k56', + 'k66'] + f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['SubDyn']['NSpringPropSets'], 'NSpringPropSets', '- Number of spring properties\n')) + f.write("PropSetID k11 k12 k13 k14 k15 k16 k22 k23 k24 k25 k26 k33 k34 k35 k36 k44 k45 k46 k55 k56 k66 \n") + f.write(" (-) (N/m) (N/m) (N/m) (N/rad) (N/rad) (N/rad) (N/m) (N/m) (N/rad) (N/rad) (N/rad) (N/m) (N/rad) (N/rad) (N/rad) (Nm/rad) (Nm/rad) (Nm/rad) (Nm/rad) (Nm/rad) (Nm/rad) \n") + for i in range(self.fst_vt['SubDyn']['NSpringPropSets']): + ln = [] + ln.append('{:^11d}'.format(self.fst_vt['SubDyn']['SpringPropSetID'][i])) + for sl in spring_list: + ln.append('{:^11}'.format(self.fst_vt['SubDyn'][sl][i])) + f.write(" ".join(ln) + '\n') f.write('---------------------- MEMBER COSINE MATRICES COSM(i,j) ------------------------\n') f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['SubDyn']['NCOSMs'], 'NCOSMs', '- Number of unique cosine matrices (i.e., of unique member alignments including principal axis rotations); ignored if NXPropSets=0 or 9999 in any element below\n')) f.write(" ".join(['{:^11s}'.format(i) for i in ['COSMID', 'COSM11', 'COSM12', 'COSM13', 'COSM21', 'COSM22', 'COSM23', 'COSM31', 'COSM32', 'COSM33']])+'\n') @@ -1935,6 +2086,10 @@ def write_SubDyn(self): f.write(" ".join(ln) + '\n') f.write('---------------------------- OUTPUT: SUMMARY & OUTFILE ------------------------------\n') f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['SubDyn']['SumPrint'], 'SumPrint', '- Output a Summary File (flag).It contains: matrices K,M and C-B reduced M_BB, M-BM, K_BB, K_MM(OMG^2), PHI_R, PHI_L. It can also contain COSMs if requested.\n')) + if 'OutCBModes' in self.fst_vt['SubDyn']: + f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['SubDyn']['OutCBModes'], 'OutCBModes', '- Output Guyan and Craig-Bampton modes {0 No output, 1 JSON output}, (flag)\n')) + if 'OutFEMModes' in self.fst_vt['SubDyn']: + f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['SubDyn']['OutFEMModes'], 'OutFEMModes', '- Output first 30 FEM modes {0 No output, 1 JSON output} (flag)\n')) f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['SubDyn']['OutCOSM'], 'OutCOSM', '- Output cosine matrices with the selected output member forces (flag)\n')) f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['SubDyn']['OutAll'], 'OutAll', "- [T/F] Output all members' end forces\n")) f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['SubDyn']['OutSwtch'], 'OutSwtch', '- [1/2/3] Output requested channels to: 1=.SD.out; 2=.out (generated by FAST); 3=both files.\n')) @@ -1943,14 +2098,14 @@ def write_SubDyn(self): f.write('{:<22} {:<11} {:}'.format(self.fst_vt['SubDyn']['OutFmt'], 'OutFmt', '- Output format for numerical results in the .SD.out file\n')) f.write('{:<22} {:<11} {:}'.format(self.fst_vt['SubDyn']['OutSFmt'], 'OutSFmt', '- Output format for header strings in the .SD.out file\n')) f.write('------------------------- MEMBER OUTPUT LIST ------------------------------------------\n') - f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['SubDyn']['NMOutputs'], 'NMOutputs', '- Number of members whose forces/displacements/velocities/accelerations will be output (-) [Must be <= 9].\n')) + f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['SubDyn']['NMOutputs'], 'NMOutputs', '- Number of members whose forces/displacements/velocities/accelerations will be output (-) [Must be <= 99].\n')) f.write(" ".join(['{:^11s}'.format(i) for i in ['MemberID', 'NOutCnt', 'NodeCnt']])+' ! [NOutCnt=how many nodes to get output for [< 10]; NodeCnt are local ordinal numbers from the start of the member, and must be >=1 and <= NDiv+1] If NMOutputs=0 leave blank as well.\n') f.write(" ".join(['{:^11s}'.format(i) for i in ['(-)','(-)','(-)']])+'\n') for i in range(self.fst_vt['SubDyn']['NMOutputs']): ln = [] ln.append('{:^11d}'.format(self.fst_vt['SubDyn']['MemberID_out'][i])) ln.append('{:^11d}'.format(self.fst_vt['SubDyn']['NOutCnt'][i])) - ln.append('{:^11d}'.format(self.fst_vt['SubDyn']['NodeCnt'][i])) + ln.append(" ".join(['{:^11d}'.format(node) for node in self.fst_vt['SubDyn']['NodeCnt'][i]])) f.write(" ".join(ln) + '\n') f.write('------------------------- SDOutList: The next line(s) contains a list of output parameters that will be output in .SD.out or .out. ------\n') outlist = self.get_outlist(self.fst_vt['outlist'], ['SubDyn']) @@ -1962,6 +2117,96 @@ def write_SubDyn(self): os.fsync(f) f.close() + def write_ExtPtfm(self): + # Generate ExtPtfm input file + + if self.fst_vt['ExtPtfm']['FileFormat'] == 0: + None + # self.write_Guyan() # TODO: need to impliment this. An example file not found to test + elif self.fst_vt['ExtPtfm']['FileFormat'] == 1: + self.write_Superelement() + + + self.fst_vt['Fst']['SubFile'] = self.FAST_namingOut + '_ExtPtfm.dat' + ep_file = os.path.join(self.FAST_runDirectory, self.fst_vt['Fst']['SubFile']) + f = open(ep_file, 'w') + + f.write('---------------------- EXTPTFM INPUT FILE --------------------------------------\n') + f.write('Comment describing the model\n') + f.write('---------------------- SIMULATION CONTROL --------------------------------------\n') + f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['ExtPtfm']['Echo'], 'Echo', '- Echo input data to .ech (flag)\n')) + f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['ExtPtfm']['DT'], 'DT', '- Communication interval for controllers (s) (or "default")\n')) + f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['ExtPtfm']['IntMethod'], 'IntMethod', '- Integration Method {1:RK4; 2:AB4, 3:ABM4} (switch)\n')) + f.write('---------------------- REDUCTION INPUTS ----------------------------------------\n') + f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['ExtPtfm']['FileFormat'], 'FileFormat', '- File Format {0:Guyan; 1:FlexASCII} (switch)\n')) + f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['ExtPtfm']['Red_FileName'], 'Red_FileName', '- Path of the file containing Guyan/Craig-Bampton inputs (-)\n')) + f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['ExtPtfm']['RedCst_FileName'], 'RedCst_FileName', '- Path of the file containing Guyan/Craig-Bampton constant inputs (-) (currently unused)\n')) + f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['ExtPtfm']['NActiveDOFList'], 'NActiveDOFList', '- Number of active CB mode listed in ActiveDOFList, use -1 for all modes (integer)\n')) + f.write('{:<22} {:<11} {:}'.format(', '.join([f'{val}' for val in self.fst_vt['ExtPtfm']['ActiveDOFList']]), 'ActiveDOFList', '- List of CB modes index that are active, [unused if NActiveDOFList<=0]\n')) + f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['ExtPtfm']['NInitPosList'], 'NInitPosList', '- Number of initial positions listed in InitPosList, using 0 implies all DOF initialized to 0 (integer)\n')) + f.write('{:<22} {:<11} {:}'.format(', '.join([f'{val}' for val in self.fst_vt['ExtPtfm']['InitPosList']]), 'InitPosList', '- List of initial positions for the CB modes [unused if NInitPosList<=0 or EquilStart=True]\n')) + f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['ExtPtfm']['NInitVelList'], 'NInitVelList', '- Number of initial positions listed in InitVelList, using 0 implies all DOF initialized to 0 (integer)\n')) + f.write('{:<22} {:<11} {:}'.format(', '.join([f'{val}' for val in self.fst_vt['ExtPtfm']['InitVelList']]), 'InitVelList', '- List of initial velocities for the CB modes [unused if NInitVelPosList<=0 or EquilStart=True]\n')) + + f.write('---------------------- OUTPUT --------------------------------------------------\n') + f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['ExtPtfm']['SumPrint'], 'SumPrint', '- Print summary data to .sum (flag)\n')) + f.write('{:<22d} {:<11} {:}'.format(self.fst_vt['ExtPtfm']['OutFile'], '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)\n')) + f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['ExtPtfm']['TabDelim'], 'TabDelim', '- Use tab delimiters in text tabular output file? (flag) (currently unused)\n')) + f.write('{!s:<22} {:<11} {:}'.format(self.fst_vt['ExtPtfm']['OutFmt'], 'OutFmt', '- Format used for text tabular output (except time). Resulting field should be 10 characters. (quoted string) (currently unused)\n')) + f.write('{:<22f} {:<11} {:}'.format(self.fst_vt['ExtPtfm']['TStart'], 'TStart', '- Time to begin tabular output (s) (currently unused)\n')) + f.write(' OutList - The next line(s) contains a list of output parameters. See OutListParameters.xlsx for a listing of available output channels, (-)\n') + outlist = self.get_outlist(self.fst_vt['outlist'], ['ExtPtfm']) + + for channel_list in outlist: + for i in range(len(channel_list)): + f.write('"' + channel_list[i] + '"\n') + f.write('END of input file (the word "END" must appear in the first 3 columns of the last OutList line)\n') + f.flush() + os.fsync(f) + f.close() + + + + def write_Superelement(self): + + def toString(SuperElement): + # Function based on https://github.com/OpenFAST/openfast_toolbox/blob/353643ed917d113ec8dfd765813fef7d09752757/openfast_toolbox/io/fast_input_file.py#L2034 + # Developed by Emmanuel Branlard (https://github.com/ebranlard) + s='' + s+='!Comment\n' + s+='!Comment Flex 5 Format\n' + s+='!Dimension: {}\n'.format(SuperElement['nDOF']) + s+='!Time increment in simulation: {}\n'.format(SuperElement['dt']) + s+='!Total simulation time in file: {}\n'.format(SuperElement['T']) + + s+='\n!Mass Matrix\n' + s+='!Dimension: {}\n'.format(SuperElement['nDOF']) + s+='\n'.join(''.join('{:16.8e}'.format(x) for x in y) for y in SuperElement['MassMatrix']) + + s+='\n\n!Stiffness Matrix\n' + s+='!Dimension: {}\n'.format(SuperElement['nDOF']) + s+='\n'.join(''.join('{:16.8e}'.format(x) for x in y) for y in SuperElement['StiffnessMatrix']) + + s+='\n\n!Damping Matrix\n' + s+='!Dimension: {}\n'.format(SuperElement['nDOF']) + s+='\n'.join(''.join('{:16.8e}'.format(x) for x in y) for y in SuperElement['DampingMatrix']) + + s+='\n\n!Loading and Wave Elevation\n' + s+='!Dimension: 1 time column - {} force columns\n'.format(SuperElement['nDOF']) + s+='\n'.join(''.join('{:16.8e}'.format(x) for x in y) for y in SuperElement['Loading']) + return s + + # Generate Superelement input file + self.fst_vt['ExtPtfm']['Red_FileName'] = self.FAST_namingOut + '_ExtPtfm_SE.dat' + se_file = os.path.join(self.FAST_runDirectory, self.fst_vt['ExtPtfm']['Red_FileName']) + f = open(se_file, 'w') + + f.write(toString(self.fst_vt['ExtPtfm']['FlexASCII'])) + + f.flush() + os.fsync(f) + f.close() + def write_MAP(self): # Generate MAP++ input file @@ -1973,11 +2218,11 @@ def write_MAP(self): f.write(" ".join(['{:<11s}'.format(i) for i in ['LineType', 'Diam', 'MassDenInAir', 'EA', 'CB', 'CIntDamp', 'Ca', 'Cdn', 'Cdt']])+'\n') f.write(" ".join(['{:<11s}'.format(i) for i in ['(-)', '(m)', '(kg/m)', '(N)', '(-)', '(Pa-s)', '(-)', '(-)', '(-)']])+'\n') ln =[] - for i in range(self.fst_vt['MAP']['NTypes']): + for i in range(1): ln = [] ln.append('{:^11}'.format(self.fst_vt['MAP']['LineType'][i])) ln.append('{:^11}'.format(self.fst_vt['MAP']['Diam'][i])) - ln.append('{:^11}'.format(self.fst_vt['MAP']['MassDen'][i])) + ln.append('{:^11}'.format(self.fst_vt['MAP']['MassDenInAir'][i])) ln.append('{:^11}'.format(self.fst_vt['MAP']['EA'][i])) ln.append('{:<11}'.format(self.fst_vt['MAP']['CB'][i])) ln.append('{:<11}'.format(self.fst_vt['MAP']['CIntDamp'][i])) @@ -2004,7 +2249,7 @@ def write_MAP(self): f.write('---------------------- LINE PROPERTIES ---------------------------------------\n') f.write(" ".join(['{:<11s}'.format(i) for i in ['Line', 'LineType', 'UnstrLen', 'NodeAnch', 'NodeFair', 'Flags']])+'\n') f.write(" ".join(['{:<11s}'.format(i) for i in ['(-)', '(-)', '(m)', '(-)', '(-)', '(-)']])+'\n') - for i in range(self.fst_vt['MAP']['NLines']): + for i in range(len(self.fst_vt['MAP']['Line'])): ln = [] ln.append('{:^11d}'.format(self.fst_vt['MAP']['Line'][i])) ln.append('{:^11}'.format(self.fst_vt['MAP']['LineType'][i])) @@ -2012,15 +2257,18 @@ def write_MAP(self): ln.append('{:^11d}'.format(self.fst_vt['MAP']['NodeAnch'][i])) ln.append('{:^11d}'.format(self.fst_vt['MAP']['NodeFair'][i])) # ln.append('{:^11}'.format(self.fst_vt['MAP']['Outputs'][i])) - # ln.append('{:^11}'.format(self.fst_vt['MAP']['CtrlChan'][i])) - # ln.append('{:<11}'.format(" ".join(self.fst_vt['MAP']['Flags']))) + ln.append('{:<11}'.format(" ".join(self.fst_vt['MAP']['Flags'][i]))) f.write(" ".join(ln) + '\n') ln =[] f.write('---------------------- SOLVER OPTIONS-----------------------------------------\n') f.write('{:<11s}'.format('Option'+'\n')) f.write('{:<11s}'.format('(-)')+'\n') - f.write("\n".join(self.fst_vt['MAP']['Option']).strip() + '\n') - + for i in range(len(self.fst_vt['MAP']['Option'])): + ln = [] + ln.append('{:<11}'.format(" ".join(self.fst_vt['MAP']['Option'][i]))) + f.write("\n".join(ln) + '\n') + ln = [] + f.write('\n') # adding a blank line after all solver options f.flush() os.fsync(f) f.close() @@ -2050,6 +2298,64 @@ def write_MoorDyn(self): ln.append('{:^11.4f}'.format(self.fst_vt['MoorDyn']['CdAx'][i])) ln.append('{:^11.4f}'.format(self.fst_vt['MoorDyn']['CaAx'][i])) f.write(" ".join(ln) + '\n') + if self.fst_vt['MoorDyn']['Rod_Name']: + f.write('----------------------- ROD TYPES ------------------------------------------\n') + f.write(" ".join(['{:^11s}'.format(i) for i in ['TypeName', 'Diam', 'Mass/m', 'Cd', 'Ca', 'CdEnd', 'CaEnd']])+'\n') + f.write(" ".join(['{:^11s}'.format(i) for i in ['(name)', '(m)', '(kg/m)', '(-)', '(-)', '(-)', '(-)']])+'\n') + for i in range(len(self.fst_vt['MoorDyn']['Rod_Name'])): + ln = [] + ln.append('{:^11}'.format(self.fst_vt['MoorDyn']['Rod_Name'][i])) + ln.append('{:^11.4f}'.format(self.fst_vt['MoorDyn']['Rod_Diam'][i])) + ln.append('{:^11.4f}'.format(self.fst_vt['MoorDyn']['Rod_MassDen'][i])) + ln.append('{:^11.4f}'.format(self.fst_vt['MoorDyn']['Rod_Cd'][i])) + ln.append('{:^11.4f}'.format(self.fst_vt['MoorDyn']['Rod_Ca'][i])) + ln.append('{:^11.4f}'.format(self.fst_vt['MoorDyn']['Rod_CdEnd'][i])) + ln.append('{:^11.4f}'.format(self.fst_vt['MoorDyn']['Rod_CaEnd'][i])) + f.write(" ".join(ln) + '\n') + + + if self.fst_vt['MoorDyn']['Body_ID']: + f.write('----------------------- BODIES ------------------------------------------\n') + f.write(" ".join(['{:^11s}'.format(i) for i in ['ID', 'Attachement', 'X0', 'Y0', 'Z0', 'r0', 'p0','y0','Mass','CG*','I*','Volume','CdA*','Ca*']])+'\n') + f.write(" ".join(['{:^11s}'.format(i) for i in ['(#)', '(word)', '(m)', '(m)', '(m)', '(deg)', '(deg)','(deg)','(kg)','(m)','(kg-m^2)','(m^3)','m^2','(kg/m^3)']])+'\n') + for i in range(len(self.fst_vt['MoorDyn']['Body_ID'])): + ln = [] + ln.append('{:^11d}'.format(self.fst_vt['MoorDyn']['Body_ID'][i])) + ln.append('{:^11}'.format(self.fst_vt['MoorDyn']['Body_Attachment'][i])) + ln.append('{:^11.4f}'.format(self.fst_vt['MoorDyn']['X0'][i])) + ln.append('{:^11.4f}'.format(self.fst_vt['MoorDyn']['Y0'][i])) + ln.append('{:^11.4f}'.format(self.fst_vt['MoorDyn']['Z0'][i])) + ln.append('{:^11.4e}'.format(self.fst_vt['MoorDyn']['r0'][i])) + ln.append('{:^11.4e}'.format(self.fst_vt['MoorDyn']['p0'][i])) + ln.append('{:^11.4e}'.format(self.fst_vt['MoorDyn']['y0'][i])) + ln.append('{:^11.4e}'.format(self.fst_vt['MoorDyn']['Body_Mass'][i])) + ln.append('|'.join(['{:^.4f}'.format(a) for a in self.fst_vt['MoorDyn']['Body_CG'][i]])) + ln.append('|'.join(['{:^.4e}'.format(a) for a in self.fst_vt['MoorDyn']['Body_I'][i]])) + ln.append('{:^11.4e}'.format(self.fst_vt['MoorDyn']['Body_Volume'][i])) + ln.append('|'.join(['{:^.4f}'.format(a) for a in self.fst_vt['MoorDyn']['Body_CdA'][i]])) + ln.append('|'.join(['{:^.4f}'.format(a) for a in self.fst_vt['MoorDyn']['Body_Ca'][i]])) + f.write(" ".join(ln) + '\n') + + if self.fst_vt['MoorDyn']['Rod_ID']: + f.write('----------------------- RODS ------------------------------------------\n') + f.write(" ".join(['{:^11s}'.format(i) for i in ['ID', 'RodType', 'Attachment', 'Xa', 'Ya', 'Za', 'Xb','Yb','Zb','NumSegs','RodOutputs']])+'\n') + f.write(" ".join(['{:^11s}'.format(i) for i in ['(#)', '(name)', '(word/ID)', '(m)', '(m)', '(m)', '(m)','(m)','(m)','(-)','(-)']])+'\n') + for i in range(len(self.fst_vt['MoorDyn']['Rod_ID'])): + ln = [] + ln.append('{:^11}'.format(self.fst_vt['MoorDyn']['Rod_ID'][i])) + ln.append('{:^11}'.format(self.fst_vt['MoorDyn']['Rod_Type'][i])) + ln.append('{:^11}'.format(self.fst_vt['MoorDyn']['Rod_Attachment'][i])) + ln.append('{:^11.4f}'.format(self.fst_vt['MoorDyn']['Xa'][i])) + ln.append('{:^11.4f}'.format(self.fst_vt['MoorDyn']['Ya'][i])) + ln.append('{:^11.4f}'.format(self.fst_vt['MoorDyn']['Za'][i])) + ln.append('{:^11.4f}'.format(self.fst_vt['MoorDyn']['Xb'][i])) + ln.append('{:^11.4f}'.format(self.fst_vt['MoorDyn']['Yb'][i])) + ln.append('{:^11.4f}'.format(self.fst_vt['MoorDyn']['Zb'][i])) + ln.append('{:^11d}'.format(self.fst_vt['MoorDyn']['Rod_NumSegs'][i])) + ln.append('{:^11}'.format(self.fst_vt['MoorDyn']['RodOutputs'][i])) + f.write(" ".join(ln) + '\n') + + f.write('---------------------- POINTS --------------------------------\n') f.write(" ".join(['{:^11s}'.format(i) for i in ['ID', 'Attachment', 'X', 'Y', 'Z', 'M', 'V', 'CdA', 'CA']])+'\n') f.write(" ".join(['{:^11s}'.format(i) for i in ['(-)', '(-)', '(m)', '(m)', '(m)', '(kg)', '(m^3)', '(m^2)', '(-)']])+'\n') @@ -2072,8 +2378,8 @@ def write_MoorDyn(self): ln = [] ln.append('{:^11d}'.format(self.fst_vt['MoorDyn']['Line_ID'][i])) ln.append('{:^11}'.format(self.fst_vt['MoorDyn']['LineType'][i])) - ln.append('{:^11d}'.format(self.fst_vt['MoorDyn']['AttachA'][i])) - ln.append('{:^11d}'.format(self.fst_vt['MoorDyn']['AttachB'][i])) + ln.append('{:^11}'.format(self.fst_vt['MoorDyn']['AttachA'][i])) + ln.append('{:^11}'.format(self.fst_vt['MoorDyn']['AttachB'][i])) ln.append('{:^11.4f}'.format(self.fst_vt['MoorDyn']['UnstrLen'][i])) ln.append('{:^11d}'.format(self.fst_vt['MoorDyn']['NumSegs'][i])) ln.append('{:^11}'.format(self.fst_vt['MoorDyn']['Outputs'][i])) @@ -2097,6 +2403,15 @@ def write_MoorDyn(self): f.write('{:<22} {:<11} {:}'.format(self.fst_vt['MoorDyn']['TmaxIC'], 'TmaxIC', '- max time for ic gen (s)\n')) f.write('{:<22} {:<11} {:}'.format(self.fst_vt['MoorDyn']['CdScaleIC'], 'CdScaleIC', '- factor by which to scale drag coefficients during dynamic relaxation (-)\n')) f.write('{:<22} {:<11} {:}'.format(self.fst_vt['MoorDyn']['threshIC'], 'threshIC', '- threshold for IC convergence (-)\n')) + if 'inertialF' in self.fst_vt['MoorDyn']['options']: + f.write('{:<22d} {:<11} {:}'.format(int(self.fst_vt['MoorDyn']['inertialF']), 'inertialF', '- Compute the inertial forces (0: no, 1: yes). Switch to 0 if you get: Warning: extreme pitch moment from body-attached Rod.\n')) + + if 'WaterKin' in self.fst_vt['MoorDyn']['options']: + self.fst_vt['MoorDyn']['WaterKin_file'] = self.FAST_namingOut + '_WaterKin.dat' + f.write('{:<22} {:<11} {:}'.format('"'+self.fst_vt['MoorDyn']['WaterKin_file']+'"', 'WaterKin', '- WaterKin input file\n')) + + + # f.write('{:^11s} {:<11} {:}'.format(self.fst_vt['MoorDyn']['WaterKin'], 'WaterKin', 'Handling of water motion (0=off, 1=on)\n')) f.write('------------------------ OUTPUTS --------------------------------------------\n') outlist = self.get_outlist(self.fst_vt['outlist'], ['MoorDyn']) for channel_list in outlist: @@ -2108,6 +2423,34 @@ def write_MoorDyn(self): f.flush() os.fsync(f) f.close() + + def write_WaterKin(self,WaterKin_file): + f = open(WaterKin_file, 'w') + + f.write('MoorDyn v2 (Feb 2022) Waves and Currents input file set up for USFLOWT\n') + f.write('Wave kinematics that will have an impact over the cans and the mooring lines.\n') + f.write('--------------------------- WAVES -------------------------------------\n') + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['WaterKin']['WaveKinMod'], 'WaveKinMod', '- type of wave input {0 no waves; 3 set up grid of wave data based on time series}\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['WaterKin']['WaveKinFile'], 'WaveKinFile', '- file containing wave elevation time series at 0,0,0\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['WaterKin']['dtWave'], 'dtWave', '- time step to use in setting up wave kinematics grid (s)\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['WaterKin']['WaveDir'], 'WaveDir', '- wave heading (deg)\n')) + f.write('{:<22} {:}'.format(self.fst_vt['WaterKin']['X_Type'], '- X wave input type (0: not used; 1: list values in ascending order; 2: uniform specified by -xlim, xlim, num)\n')) + f.write('{:<22} {:}'.format(', '.join(['{:.3f}'.format(i) for i in self.fst_vt['WaterKin']['X_Grid']]), '- X wave grid point data separated by commas\n')) + f.write('{:<22} {:}'.format(self.fst_vt['WaterKin']['Y_Type'], '- Y wave input type (0: not used; 1: list values in ascending order; 2: uniform specified by -Ylim, Ylim, num)\n')) + f.write('{:<22} {:}'.format(', '.join(['{:.3f}'.format(i) for i in self.fst_vt['WaterKin']['Y_Grid']]), '- Y wave grid point data separated by commas\n')) + f.write('{:<22} {:}'.format(self.fst_vt['WaterKin']['Z_Type'], '- Z wave input type (0: not used; 1: list values in ascending order; 2: uniform specified by -Zlim, Zlim, num)\n')) + f.write('{:<22} {:}'.format(', '.join(['{:.3f}'.format(i) for i in self.fst_vt['WaterKin']['Z_Grid']]), '- Z wave grid point data separated by commas\n')) + f.write('--------------------------- CURRENT -------------------------------------\n') + f.write('0 CurrentMod - type of current input {0 no current; 1 steady current profile described below} \n') + f.write('z-depth x-current y-current\n') + f.write('(m) (m/s) (m/s)\n') + f.write('--------------------- need this line ------------------\n') + + f.flush() + os.fsync(f) + f.close() + + def write_StC(self,StC_vt,StC_filename): @@ -2176,7 +2519,7 @@ def write_StC(self,StC_vt,StC_filename): row = [x, f_x, y, f_y, z, f_z] f.write(' '.join(['{: 2.8e}'.format(val) for val in row])+'\n') - f.write('---------------------- StructCtrl CONTROL -------------------------------------------- [used only when StC_DOF_MODE=1 or 2]\n') + f.write('---------------------- StructUserProp CONTROL -------------------------------------------- [used only when StC_DOF_MODE=1 or 2]\n') f.write('{:<22} {:<11} {:}'.format(StC_vt['StC_CMODE'], 'StC_CMODE', '- Control mode (switch) {0:none; 1: Semi-Active Control Mode; 2: Active Control Mode}\n')) f.write('{:<22} {:<11} {:}'.format(StC_vt['StC_CChan'], 'StC_CChan', '- Control channel group (1:10) for stiffness and damping (StC_[XYZ]_K, StC_[XYZ]_C, and StC_[XYZ]_Brake) (specify additional channels for blade instances of StC active control -- one channel per blade) [used only when StC_DOF_MODE=1 or 2, and StC_CMODE=4 or 5]\n')) f.write('{:<22} {:<11} {:}'.format(StC_vt['StC_SA_MODE'], '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} (-)\n')) @@ -2215,37 +2558,33 @@ def write_StC(self,StC_vt,StC_filename): if __name__=="__main__": + from openfast_io.FAST_reader import InputReader_OpenFAST + from openfast_io.FileTools import check_rtest_cloned + from pathlib import Path + fst_update = {} fst_update['Fst', 'TMax'] = 20. - fst_update['AeroDyn15', 'TwrAero'] = False + fst_update['AeroDyn', 'TwrAero'] = False - examples_dir = os.path.dirname( os.path.dirname( os.path.dirname( os.path.realpath(__file__) ) ) ) + os.sep + parent_dir = os.path.dirname( os.path.dirname( os.path.dirname( os.path.realpath(__file__) ) ) ) + os.sep + build_of_io_dir = os.path.join(parent_dir, 'build_ofio') + Path(build_of_io_dir).mkdir(parents=True, exist_ok=True) # Read the model fast = InputReader_OpenFAST() - fast.FAST_InputFile = 'IEA-15-240-RWT-UMaineSemi.fst' # FAST input file (ext=.fst) - fast.FAST_directory = os.path.join(examples_dir, 'examples', '01_aeroelasticse', - 'OpenFAST_models', 'IEA-15-240-RWT', - 'IEA-15-240-RWT-UMaineSemi') # Path to fst directory files + fast.FAST_InputFile = '5MW_Land_BD_DLL_WTurb.fst' # FAST input file (ext=.fst) + fast.FAST_directory = os.path.join(parent_dir, 'reg_tests', 'r-test', + 'glue-codes', 'openfast', + '5MW_Land_BD_DLL_WTurb') # Path to fst directory files + + check_rtest_cloned(os.path.join(fast.FAST_directory, fast.FAST_InputFile)) + fast.execute() # Write out the model fastout = InputWriter_OpenFAST() fastout.fst_vt = fast.fst_vt - fastout.FAST_runDirectory = 'temp/OpenFAST' - fastout.FAST_namingOut = 'iea15' + fastout.FAST_runDirectory = os.path.join(build_of_io_dir,'fast_write_main_test') + fastout.FAST_namingOut = '5MW_Land_BD_DLL_WTurb_write' fastout.update(fst_update=fst_update) fastout.execute() - - # import pickle - # with open('fst_vt.pkl','rb') as f: - # fst_vt = pickle.load(f) - - # fastout = InputWriter_OpenFAST() - # fastout.FAST_runDirectory = 'none' - - # fst_vt['TStC'][0]['NKInpSt'] = 2 - - # for i_TStC, TStC in enumerate(fst_vt['TStC']): - # fastout.write_StC(TStC,fst_vt['ServoDyn']['TStCfiles'][i_TStC]) - # print('here') diff --git a/openfast_python/openfast_io/FileTools.py b/openfast_io/openfast_io/FileTools.py similarity index 70% rename from openfast_python/openfast_io/FileTools.py rename to openfast_io/openfast_io/FileTools.py index 9477400c47..082497b2a3 100644 --- a/openfast_python/openfast_io/FileTools.py +++ b/openfast_io/openfast_io/FileTools.py @@ -4,6 +4,7 @@ import numpy as np import yaml from functools import reduce +from deepdiff import DeepDiff try: import ruamel_yaml as ry except Exception: @@ -36,7 +37,7 @@ def loop_dict(vartree, branch): if data_type in [np.int_, np.intc, np.intp, np.int8, np.int16, np.int32, np.int64, np.uint8, np.uint16, np.uint32, np.uint64]: get_dict(fst_vt, branch_i[:-1])[branch_i[-1]] = int(get_dict(fst_vt, branch_i[:-1])[branch_i[-1]]) - elif data_type in [np.single, np.double, np.longdouble, np.csingle, np.cdouble, np.float_, np.float16, np.float32, np.float64, np.complex64, np.complex128]: + elif data_type in [np.single, np.double, np.longdouble, np.csingle, np.cdouble, np.float16, np.float32, np.float64, np.complex64, np.complex128]: get_dict(fst_vt, branch_i[:-1])[branch_i[-1]] = float(get_dict(fst_vt, branch_i[:-1])[branch_i[-1]]) elif data_type in [np.bool_]: get_dict(fst_vt, branch_i[:-1])[branch_i[-1]] = bool(get_dict(fst_vt, branch_i[:-1])[branch_i[-1]]) @@ -269,3 +270,93 @@ def get_dlc_label(cases, include_seed=True): def load_file_list(fname_flist): # load list of filenames from file return np.genfromtxt(fname_flist, dtype='str') + +def check_rtest_cloned(rtest_dir): + # check if the rtest directory is cloned + if not os.path.isdir(rtest_dir): + raise FileNotFoundError(f"The directory {rtest_dir} does not exist. Please clone the r-test submodule. Try running `git submodule update --init --recursive`") + + return True + + +def remove_nested_keys(dictionary, keys_to_remove): + for key in keys_to_remove: + if key in dictionary: + del dictionary[key] + + for value in dictionary.values(): + if isinstance(value, dict): + remove_nested_keys(value, keys_to_remove) + + return dictionary + +def cleanup_fstvt(fst_vt, ignoreVars=None, removeFileRef=False, removeArrayProps=False): + # sanitize the dictionaries from numpy data types + fst_vt = remove_numpy(fst_vt) + + if removeFileRef: # not fair to compare file paths + fileVars = ['af_coord', 'Filename_Uni', 'FileName_BTS', 'FileName_u', 'FileName_v', 'FileName_w', # TODO: orgainze these logically + 'AFNames', 'ADBlFile1', 'ADBlFile2', 'ADBlFile3', 'NumCoords', + 'DLL_FileName','DLL_InFile','af_data', + 'PerfFileName', + 'InflowFile', + 'AeroFile', + 'BldFile1', 'BldFile2', 'BldFile3', + 'TwrFile', + 'EDFile', + 'ServoFile', + 'BldFile', + 'SeaStFile', + 'HydroFile', + 'SubFile', + 'MooringFile', + 'Red_FileName', + 'PrescribedForcesFile', + 'actuatorDiskFile', + 'BDBldFile(1)', 'BDBldFile(2)', 'BDBldFile(3)', + 'OLAFInputFileName', + 'EDFile_path', + 'BDBldFile(1_path)', + 'BDBldFile(2_path)', + 'BDBldFile(3_path)', + 'InflowFile_path', + 'AeroFile_path', + 'ServoFile_path', + 'HydroFile_path', + 'SubFile_path', + 'MooringFile_path', + 'IceFile_path', + 'description', + ] + fst_vt = remove_nested_keys(fst_vt, fileVars) + + if removeArrayProps: # we can have different array properties, if run through different tools + arrayVars = ['BlSpn', 'BlCrvAC','BlSwpAC','BlCrvAng','BlTwist','BlChord','BlAFID', + 'ac','PC_GS_KP','PC_GS_KI','WE_FOPoles','beam_stiff','attr','units'] + + fst_vt = remove_nested_keys(fst_vt, arrayVars) + + if ignoreVars is not None: + fst_vt = remove_nested_keys(fst_vt, ignoreVars) + + return fst_vt + +def compare_fst_vt(fst_vt1, fst_vt2, ignoreVars = None, removeFileRef=False, removeArrayProps=False, print_diff=False): + # Compare two FAST variable trees + + # sanitize the dictionaries from numpy data types + fst_vt1 = cleanup_fstvt(fst_vt1, ignoreVars, removeFileRef, removeArrayProps) + fst_vt2 = cleanup_fstvt(fst_vt2, ignoreVars, removeFileRef, removeArrayProps) + + diff = DeepDiff(fst_vt1, fst_vt2, ignore_numeric_type_changes=True, + # ignore_string_case=True, + # verbose_level = 2 + ) + + if diff == {}: + print('No differences found between the two fst_vt.') + + if print_diff: + print(diff.pretty()) + + return diff diff --git a/openfast_python/openfast_io/IEC_CoeherentGusts.py b/openfast_io/openfast_io/IEC_CoeherentGusts.py similarity index 100% rename from openfast_python/openfast_io/IEC_CoeherentGusts.py rename to openfast_io/openfast_io/IEC_CoeherentGusts.py diff --git a/openfast_python/openfast_io/StC_defaults.py b/openfast_io/openfast_io/StC_defaults.py similarity index 100% rename from openfast_python/openfast_io/StC_defaults.py rename to openfast_io/openfast_io/StC_defaults.py diff --git a/openfast_io/openfast_io/__init__.py b/openfast_io/openfast_io/__init__.py new file mode 100644 index 0000000000..3b8cbcc8eb --- /dev/null +++ b/openfast_io/openfast_io/__init__.py @@ -0,0 +1,6 @@ +try: + from ._version import __version__, __version_tuple__ + +except ImportError: + __version__ = "undefined" + __version_tuple__ = None # type: ignore \ No newline at end of file diff --git a/openfast_python/openfast_io/create_output_vars.py b/openfast_io/openfast_io/create_output_vars.py similarity index 81% rename from openfast_python/openfast_io/create_output_vars.py rename to openfast_io/openfast_io/create_output_vars.py index c34f60eb46..9f3d43ea00 100644 --- a/openfast_python/openfast_io/create_output_vars.py +++ b/openfast_io/openfast_io/create_output_vars.py @@ -78,11 +78,25 @@ def GetOutlistParameters(fname_vars_out, xl_files_in, sheet_list, write_mode, fi try: # File Location - root_dir = os.path.dirname( os.path.dirname( ( os.path.realpath(__file__) ) ) ) + os.sep - outlist_fast_lib = os.path.join(root_dir, 'docs', 'OtherSupporting' , 'OutListParameters.xlsx') + root_dir = os.path.dirname(os.path.dirname( os.path.dirname( ( os.path.realpath(__file__) ) ) )) + os.sep + outlist_fast_lib = os.path.join(root_dir, 'docs', 'OtherSupporting' , 'OutListParameters.xls') # Sheets to grab - sheet_list = ['ElastoDyn', 'BeamDyn', 'ServoDyn', 'AeroDyn', 'InflowWind', 'WAMIT', 'HydroDyn', 'Morison', # 'SubDyn' - 'ElastoDyn_Nodes','BeamDyn_Nodes','AeroDyn_Nodes'] + sheet_list = [ + 'AeroDyn', + 'BeamDyn', + 'ElastoDyn', + 'InflowWind', + 'ServoDyn', + 'HydroDyn', + 'Morison', + 'SeaState', + 'SubDyn', + 'AeroDyn_Nodes', + 'BeamDyn_Nodes', + 'ElastoDyn_Nodes', + 'AeroDisk', + 'SimpleElastoDyn', + ] xl_files = [outlist_fast_lib]*len(sheet_list) # Output naming fname_vars_out = 'FAST_vars_out.py' diff --git a/openfast_io/openfast_io/tests/conftest.py b/openfast_io/openfast_io/tests/conftest.py new file mode 100644 index 0000000000..f4421a8519 --- /dev/null +++ b/openfast_io/openfast_io/tests/conftest.py @@ -0,0 +1,24 @@ +import pytest +import os.path as osp +import platform + +# looking up OS for the correct executable extension +mactype = platform.system().lower() +if mactype in ["linux", "linux2", "darwin"]: + exeExt = "" +elif mactype in ["win32", "windows", "cygwin"]: #NOTE: platform.system()='Windows', sys.platform='win32' + libext = '.exe' +else: + raise ValueError('Unknown platform type: '+mactype) + +REPOSITORY_ROOT = osp.dirname(osp.dirname(osp.dirname(osp.dirname(__file__)))) +BUILD_DIR = osp.join(REPOSITORY_ROOT, "build/reg_tests") + +# Path to the OpenFAST executable +OF_PATH = osp.join(REPOSITORY_ROOT,"build/glue-codes/openfast",f"openfast{exeExt}") + +def pytest_addoption(parser): + parser.addoption("--executable", action="store", default=OF_PATH, help="Path to the OpenFAST executable") + parser.addoption("--source_dir", action="store", default=REPOSITORY_ROOT, help="Path to the openfast repository") + parser.addoption("--build_dir", action="store", default=BUILD_DIR, help="Path to the test data directory") + diff --git a/openfast_io/openfast_io/tests/test_of_io_pytest.py b/openfast_io/openfast_io/tests/test_of_io_pytest.py new file mode 100644 index 0000000000..c8ad87742f --- /dev/null +++ b/openfast_io/openfast_io/tests/test_of_io_pytest.py @@ -0,0 +1,337 @@ +import pytest +import os.path as osp +import subprocess, sys + + +from openfast_io.FAST_reader import InputReader_OpenFAST +from openfast_io.FAST_writer import InputWriter_OpenFAST +from openfast_io.FAST_output_reader import FASTOutputFile + +from openfast_io.FileTools import check_rtest_cloned, compare_fst_vt +from pathlib import Path + +from conftest import REPOSITORY_ROOT, BUILD_DIR, OF_PATH + + + +# Exercising the various OpenFAST modules +FOLDERS_TO_RUN = [ + "AWT_YFix_WSt" , # "openfast;elastodyn;aerodyn;servodyn" + "AWT_WSt_StartUp_HighSpShutDown" , # "openfast;elastodyn;aerodyn;servodyn" + "AWT_YFree_WSt" , # "openfast;elastodyn;aerodyn;servodyn" + "AWT_YFree_WTurb" , # "openfast;elastodyn;aerodyn;servodyn" + "AWT_WSt_StartUpShutDown" , # "openfast;elastodyn;aerodyn;servodyn" + "AOC_WSt" , # "openfast;elastodyn;aerodyn;servodyn" + "AOC_YFree_WTurb" , # "openfast;elastodyn;aerodyn;servodyn" + "AOC_YFix_WSt" , # "openfast;elastodyn;aerodyn;servodyn" + "UAE_Dnwind_YRamp_WSt" , # "openfast;elastodyn;aerodyn;servodyn" + "UAE_Upwind_Rigid_WRamp_PwrCurve" , # "openfast;elastodyn;aerodyn;servodyn" + "WP_VSP_WTurb_PitchFail" , # "openfast;elastodyn;aerodyn;servodyn" + "WP_VSP_ECD" , # "openfast;elastodyn;aerodyn;servodyn" + "WP_VSP_WTurb" , # "openfast;elastodyn;aerodyn;servodyn" + "SWRT_YFree_VS_EDG01" , # "openfast;elastodyn;aerodyn;servodyn" + "SWRT_YFree_VS_EDC01" , # "openfast;elastodyn;aerodyn;servodyn" + "SWRT_YFree_VS_WTurb" , # "openfast;elastodyn;aerodyn;servodyn" + "5MW_Land_DLL_WTurb" , # "openfast;elastodyn;aerodyn;servodyn" + "5MW_Land_DLL_WTurb_wNacDrag" , # "openfast;elastodyn;aerodyn;servodyn" + "5MW_OC3Mnpl_DLL_WTurb_WavesIrr" , # "openfast;elastodyn;aerodyn;servodyn;hydrodyn;subdyn;offshore" + "5MW_OC3Mnpl_DLL_WTurb_WavesIrr_Restart" , # "openfast;elastodyn;aerodyn;servodyn;hydrodyn;subdyn;offshore;restart" + "5MW_OC3Trpd_DLL_WSt_WavesReg" , # "openfast;elastodyn;aerodyn;servodyn;hydrodyn;subdyn;offshore" + "5MW_OC4Jckt_DLL_WTurb_WavesIrr_MGrowth" , # "openfast;elastodyn;aerodyn;servodyn;hydrodyn;subdyn;offshore" + "5MW_ITIBarge_DLL_WTurb_WavesIrr" , # "openfast;elastodyn;aerodyn;servodyn;hydrodyn;map;offshore" + "5MW_TLP_DLL_WTurb_WavesIrr_WavesMulti" , # "openfast;elastodyn;aerodyn;servodyn;hydrodyn;map;offshore" + "5MW_OC3Spar_DLL_WTurb_WavesIrr" , # "openfast;elastodyn;aerodyn;servodyn;hydrodyn;map;offshore" + "5MW_OC4Semi_WSt_WavesWN" , # "openfast;elastodyn;aerodyn;servodyn;hydrodyn;moordyn;offshore" + "5MW_Land_BD_DLL_WTurb" , # "openfast;beamdyn;aerodyn;servodyn" + "5MW_Land_BD_Init" , # "openfast;beamdyn;aerodyn;servodyn" + "5MW_OC4Jckt_ExtPtfm" , # "openfast;elastodyn;extptfm" + "HelicalWake_OLAF" , # "openfast;aerodyn;olaf" + "EllipticalWing_OLAF" , # "openfast;aerodyn;olaf" + "StC_test_OC4Semi" , # "openfast;servodyn;hydrodyn;moordyn;offshore;stc" + "MHK_RM1_Fixed" , # "openfast;elastodyn;aerodyn;mhk" + "MHK_RM1_Floating" , # "openfast;elastodyn;aerodyn;hydrodyn;moordyn;mhk" + "MHK_RM1_Floating_wNacDrag" , # "openfast;elastodyn;aerodyn;hydrodyn;moordyn;mhk" + "Tailfin_FreeYaw1DOF_PolarBased" , # "openfast;elastodyn;aerodyn" + "Tailfin_FreeYaw1DOF_Unsteady" , # "openfast;elastodyn;aerodyn" + "5MW_Land_DLL_WTurb_ADsk" , # "openfast;elastodyn;aerodisk" + "5MW_Land_DLL_WTurb_ADsk_SED" , # "openfast;simple-elastodyn;aerodisk" + "5MW_Land_DLL_WTurb_SED" , # "openfast;simple-elastodyn;aerodyn" +] + + + +def getPaths(OF_PATH = OF_PATH, REPOSITORY_ROOT = REPOSITORY_ROOT, BUILD_DIR = BUILD_DIR): + + """ + Function to get the paths for the OpenFAST executable, source directory, build directory, r-test directory, and test data directory + + Args: + OF_PATH (str): Path to the OpenFAST executable + REPOSITORY_ROOT (str): Path to the OpenFAST repository + BUILD_DIR (str): Path to the build directory + + Returns: + dict: Dictionary containing the paths + """ + + return { + "executable": OF_PATH, + "source_dir": REPOSITORY_ROOT, + "build_dir": BUILD_DIR, # Location of the reg_tests directory inside the build directory created by the user + "rtest_dir": osp.join(REPOSITORY_ROOT, "reg_tests", "r-test"), + "test_data_dir": osp.join(REPOSITORY_ROOT, "reg_tests", "r-test", "glue-codes", "openfast"), + "discon_dir": osp.join(BUILD_DIR, "glue-codes", "openfast", "5MW_Baseline", "ServoData"), + } + +def read_action(folder, path_dict = getPaths()): + """ + Function to read the input deck for a given folder + + Args: + folder (str): r-test folder name + path_dict (dict): Dictionary containing the paths. Default is getPaths() + + Returns: + dict: OpenFAST VariableTree + + """ + print(f"Reading from {folder}") + + # Read input deck + fast_reader = InputReader_OpenFAST() + fast_reader.FAST_InputFile = f'{folder}.fst' # FAST input file (ext=.fst) + fast_reader.FAST_directory = osp.join(path_dict['test_data_dir'], folder) # Path to fst directory files + fast_reader.execute() + + return fast_reader.fst_vt + +def write_action(folder, fst_vt, path_dict = getPaths()): + """ + Function to write the input deck for a given folder + + Args: + folder (str): r-test folder name + fst_vt (dict): OpenFAST VariableTree + path_dict (dict): Dictionary containing the paths. Default is getPaths() + + """ + print(f"Writing to {folder}, with TMax = 2.0") + + # check if the folder exists, if not, mostly being called not from cmake, so create it + if not osp.exists(osp.join(path_dict['build_dir'],'openfast_io')): + Path(path_dict['build_dir']).mkdir(parents=True, exist_ok=True) + + fast_writer = InputWriter_OpenFAST() + fast_writer.FAST_runDirectory = osp.join(path_dict['build_dir'],'openfast_io',folder) + Path(fast_writer.FAST_runDirectory).mkdir(parents=True, exist_ok=True) + fast_writer.FAST_namingOut = folder + + fast_writer.fst_vt = dict(fst_vt) + fst_vt = {} + fst_vt['Fst', 'TMax'] = 2. + fst_vt['Fst', 'TStart'] = 0. + fst_vt['Fst','OutFileFmt'] = 3 + # check if the case needs ServoDyn + if 'DLL_FileName' in fast_writer.fst_vt['ServoDyn']: + # Copy the DISCON name and add the path to the build location + fst_vt['ServoDyn', 'DLL_FileName'] = osp.join(path_dict['discon_dir'], osp.basename(fast_writer.fst_vt['ServoDyn']['DLL_FileName'])) + fast_writer.update(fst_update=fst_vt) + fast_writer.execute() + +def run_action(folder, path_dict = getPaths()): + """ + Function to run the simulation for a given folder + + Args: + folder (str): r-test folder name + path_dict (dict): Dictionary containing the paths. Default is getPaths() + + """ + print(f"Running simulation for {folder}") + command = [f"{path_dict['executable']}", f"{osp.join(path_dict['build_dir'],'openfast_io', folder, f'{folder}.fst')}"] + with open(osp.join(path_dict['build_dir'],'openfast_io', folder, f'{folder}.log'), 'w') as f: + subprocess.run(command, check=True, stdout=f, stderr=subprocess.STDOUT) + f.close() + +def check_ascii_out(folder, path_dict = getPaths()): + """ + Function to read the ASCII output for a given folder + + Args: + folder (str): r-test folder name + path_dict (dict): Dictionary containing the paths. Default is getPaths() + """ + print(f"Checking ASCII output for {folder}") + asciiOutput = osp.join(path_dict['build_dir'],'openfast_io', folder, f"{folder}.out") + fast_outout = FASTOutputFile(filename=asciiOutput) + +def check_binary_out(folder, path_dict = getPaths()): + """ + Function to read the binary output for a given folder + + Args: + folder (str): r-test folder name + path_dict (dict): Dictionary containing the paths. Default is getPaths() + """ + print(f"Checking binary output for {folder}") + binaryOutput = osp.join(path_dict['build_dir'],'openfast_io', folder, f"{folder}.outb") + fast_outout = FASTOutputFile(filename=binaryOutput) + +def check_fst_vt_with_source(folder, path_dict = getPaths()): + + """ + Function to check the fst_vt with the source for a given folder + + Args: + folder (str): r-test folder name + path_dict (dict): Dictionary containing the paths. Default is getPaths() + """ + + print(f"Checking the fst_vt with the source for {folder}") + + # creating the two InputReader_OpenFAST objects + fast_reader1 = InputReader_OpenFAST() # for the source + fast_reader1.FAST_InputFile = f'{folder}.fst' # FAST input file (ext=.fst) + fast_reader1.FAST_directory = osp.join(path_dict['test_data_dir'], folder) # Path to fst directory files + fast_reader1.execute() + + fast_reader2 = InputReader_OpenFAST() # for the build + fast_reader2.FAST_InputFile = f'{folder}.fst' # FAST input file (ext=.fst) + fast_reader2.FAST_directory = osp.join(path_dict['build_dir'],'openfast_io',folder) # Path to fst directory files + fast_reader2.execute() + + # List of acceptable differences + acceptable_diff = [ + 'TMax', # TMax is updated in the write_action + 'TStart', # TStart is updated in the write_action + 'OutFileFmt', # OutFileFmt is updated in the write_action + ] + + + # compare the two fst_vt + diff = compare_fst_vt(fast_reader1.fst_vt, fast_reader2.fst_vt, ignoreVars = acceptable_diff, + removeFileRef=True, removeArrayProps=True, print_diff=True) + + if diff: + pytest.fail(f"fst_vt for {folder} is not matching with the source") + + + +# Begining of the test +def test_rtest_cloned(request): + """ + Function to check if the r-tests are cloned properly + + Args: + request (fixture): pytest request + """ + + REPOSITORY_ROOT = osp.join(request.config.getoption("--source_dir")) + path_dict = getPaths(REPOSITORY_ROOT=REPOSITORY_ROOT) + + if check_rtest_cloned(path_dict['test_data_dir']): + assert True, "R-tests cloned properly" + else:# stop the test if the r-tests are not cloned properly + print("R-tests not cloned properly") + sys.exit(1) + +def test_DLLs_exist(request): + """ + Function to check if the DISCON.dll file exists + + Args: + request (fixture): pytest request + """ + + path_dict = getPaths(OF_PATH=osp.join(request.config.getoption("--build_dir"))) + + # Check if the DISCON.dll file exists + DISCON_DLL = osp.join(path_dict['discon_dir'], "DISCON.dll") + if osp.exists(DISCON_DLL): + assert True, f"DISCON.dll found at {DISCON_DLL}" + else: # stop the test if the DISCON.dll is not found + print(f"DISCON.dll not found at {DISCON_DLL}. Please build with ''' make regression_test_controllers ''' and try again.") + sys.exit(1) + +def test_openfast_executable_exists(request): + """ + Function to check if the OpenFAST executable exists + + Args: + request (fixture): pytest request + """ + + path_dict = getPaths(OF_PATH=osp.join(request.config.getoption("--executable"))) + + if osp.exists(path_dict['executable']): + assert True, f"OpenFAST executable found at {path_dict['executable']}" + else: # stop the test if the OpenFAST executable is not found + print(f"OpenFAST executable not found at {path_dict['executable']}. Please build OpenFAST and try again.") + sys.exit(1) + + + +# Parameterize the test function to run for each folder and action +@pytest.mark.parametrize("folder", FOLDERS_TO_RUN) +def test_openfast_io_read_write_run_readOut_verify(folder, request): + """ + Function to test the read, write, run, check ASCII, check binary, and check fst_vt for a given folder + + Args: + folder (str): r-test folder name + request (fixture): pytest request + """ + + path_dict = getPaths(OF_PATH=osp.join(request.config.getoption("--executable")), + REPOSITORY_ROOT=osp.join(request.config.getoption("--source_dir")), + BUILD_DIR=osp.join(request.config.getoption("--build_dir"))) + + + try: + action_name = "read" + fst_vt = read_action(folder, path_dict = path_dict) + + action_name = "write" + write_action(folder, fst_vt, path_dict = path_dict) + + action_name = "run" + run_action(folder, path_dict = path_dict) + + action_name = "check ASCII" + check_ascii_out(folder, path_dict = path_dict) + + action_name = "check binary" + check_binary_out(folder, path_dict = path_dict) + + action_name = "check fst_vt" + check_fst_vt_with_source(folder, path_dict = path_dict) + + except Exception as e: + pytest.fail(f"Action '{action_name}' for folder '{folder}' failed with exception: {e}") + +def main(): + """ + Main function to run the test for all the folders + """ + + # Initialize any necessary setup here + + for folder in FOLDERS_TO_RUN: + print(" ") + print(f"Processing folder: {folder}") + + # Assuming read_action, write_action, run_action, check_ascii_out, check_binary_out, and check_fst_vt_with_source are defined elsewhere + data = read_action(folder) + write_action(folder, data) + run_action(folder) + check_ascii_out(folder) + check_binary_out(folder) + check_fst_vt_with_source(folder) + print(f"Successfully processed folder: {folder}") + +if __name__ == "__main__": + """ + Run the main function if the script is run directly or through VSCode debugger + """ + + main() \ No newline at end of file diff --git a/openfast_python/openfast_io/turbsim_file.py b/openfast_io/openfast_io/turbsim_file.py similarity index 89% rename from openfast_python/openfast_io/turbsim_file.py rename to openfast_io/openfast_io/turbsim_file.py index 2756fff7be..6310363195 100644 --- a/openfast_python/openfast_io/turbsim_file.py +++ b/openfast_io/openfast_io/turbsim_file.py @@ -5,6 +5,7 @@ """ import pandas as pd import numpy as np +import argparse import os import struct import time @@ -16,13 +17,13 @@ File=dict class TurbSimFile(File): - """ + """ Read/write a TurbSim turbulence file (.bts). The object behaves as a dictionary. Main keys --------- - 'u': velocity field, shape (3 x nt x ny x nz) - - 'y', 'z', 't': space and time coordinates + - 'y', 'z', 't': space and time coordinates - 'dt', 'ID', 'info' - 'zTwr', 'uTwr': tower coordinates and field if present (3 x nt x nTwr) - 'zHub', 'uHub': height and velocity at a reference point (usually not hub) @@ -36,7 +37,7 @@ class TurbSimFile(File): ts = TurbSimFile('Turb.bts') print(ts.keys()) - print(ts['u'].shape) + print(ts['u'].shape) """ @@ -55,7 +56,7 @@ def __init__(self,filename=None, **kwargs): self.read(filename, **kwargs) def read(self, filename=None, header_only=False): - """ read BTS file, with field: + """ read BTS file, with field: u (3 x nt x ny x nz) uTwr (3 x nt x nTwr) """ @@ -69,7 +70,7 @@ def read(self, filename=None, header_only=False): raise EmptyFileError('File is empty:',self.filename) scl = np.zeros(3, np.float32); off = np.zeros(3, np.float32) - with open(self.filename, mode='rb') as f: + with open(self.filename, mode='rb') as f: # Reading header info ID, nz, ny, nTwr, nt = struct.unpack('0) @@ -95,7 +96,7 @@ def read(self, filename=None, header_only=False): self['info'] = info self['ID'] = ID self['dt'] = dt - self['y'] = np.arange(ny)*dy + self['y'] = np.arange(ny)*dy self['y'] -= np.mean(self['y']) # y always centered on 0 self['z'] = np.arange(nz)*dz +zBottom self['t'] = np.arange(nt)*dt @@ -104,7 +105,7 @@ def read(self, filename=None, header_only=False): self['uHub'] = uHub def write(self, filename=None): - """ + """ write a BTS file, using the following keys: 'u','z','y','t','uTwr' u (3 x nt x ny x nz) uTwr (3 x nt x nTwr) @@ -127,7 +128,7 @@ def write(self, filename=None): intrng = 65535 off = np.empty((3), dtype = np.float32) scl = np.empty((3), dtype = np.float32) - info = 'Generated by TurbSimFile on {:s}.'.format(time.strftime('%d-%b-%Y at %H:%M:%S', time.localtime())) + info = 'Generated by openfast_io.TurbSimFile on {:s}.'.format(time.strftime('%d-%b-%Y at %H:%M:%S', time.localtime())) # Calculate scaling, offsets and scaling data out = np.empty(ts.shape, dtype=np.int16) outTwr = np.empty(tsTwr.shape, dtype=np.int16) @@ -151,7 +152,7 @@ def write(self, filename=None): # Providing estimates of uHub and zHub even if these fields are not used zHub,uHub, bHub = self.hubValues() - with open(self.filename, mode='wb') as f: + with open(self.filename, mode='wb') as f: f.write(struct.pack('1.0", + "pandas>2.0", + "ruamel_yaml>0.18", + "deepdiff>8.0", + ] + +[project.urls] +homepage = "https://github.com/OpenFAST/openfast" +documentation = "https://openfast.readthedocs.io/en/main/" +repository = "https://github.com/OpenFAST/openfast" +Issues = "https://github.com/OpenFAST/openfast/issues" + + + +[project.optional-dependencies] + +rosco = ["rosco>2.9.2"] +xlrd = ["xlrd>2"] +all = ["rosco>2.9.2", "xlrd>2"] + +[tool.hatch.version] +source = "vcs" + +[tool.hatch.build.hooks.vcs] +version-file = "openfast_io/_version.py" diff --git a/openfast_python/README.md b/openfast_python/README.md deleted file mode 100644 index e7becb7462..0000000000 --- a/openfast_python/README.md +++ /dev/null @@ -1,27 +0,0 @@ -# OpenFAST python readers/writers - -> [!CAUTION] -> The `openfast_io` package on PyPI is currently called `octue-openfast` but will soon be renamed. - -This package is a python wrapper comprising readers and writers for converting OpenFAST files to/from python objects. It -was originally written for [WEIS](https://github.com/WISDEM/WEIS/tree/77a878d7989b8c1d07d2244135ccd308a193a924/weis/aeroelasticse) and has been ported over to OpenFAST to make it more widely accessible. - -## Installation -Run either -```shell -pip install openfast_io -``` -or -```shell -poetry add openfast_io -``` - -### Extra options -[ROSCO](https://github.com/NREL/ROSCO) can be installed as an optional dependency. Run either -```shell -pip install openfast_io[rosco] -``` -or -```shell -poetry add -E rosco openfast_io -``` diff --git a/openfast_python/openfast_io/__init__.py b/openfast_python/openfast_io/__init__.py deleted file mode 100644 index e69de29bb2..0000000000 diff --git a/openfast_python/openfast_io/test/test_OF_utils.py b/openfast_python/openfast_io/test/test_OF_utils.py deleted file mode 100644 index a147cd8541..0000000000 --- a/openfast_python/openfast_io/test/test_OF_utils.py +++ /dev/null @@ -1,94 +0,0 @@ -import unittest -import os.path as osp -import subprocess, sys -import platform - -from openfast_io.FAST_reader import InputReader_OpenFAST -from openfast_io.FAST_writer import InputWriter_OpenFAST -from openfast_io.FAST_output_reader import FASTOutputFile - -REPOSITORY_ROOT = osp.dirname(osp.dirname(osp.dirname(osp.dirname(__file__)))) -RTESTS_DIR = osp.join(REPOSITORY_ROOT, "reg_tests","r-test") -TEST_DATA_DIR = osp.join(RTESTS_DIR, "glue-codes", "openfast", "5MW_Land_DLL_WTurb") - -# looking up OS for the correct executable extension -mactype = platform.system().lower() -if mactype in ["linux", "linux2", "darwin"]: - exeExt = "" -elif mactype in ["win32", "windows", "cygwin"]: #NOTE: platform.system()='Windows', sys.platform='win32' - libext = '.exe' -else: - raise ValueError('Unknown platform type: '+mactype) - -# Path to the OpenFAST executable -of_path = osp.join(REPOSITORY_ROOT,"build/glue-codes/openfast",f"openfast{exeExt}") - -class TestOFutils(unittest.TestCase): - def testOF_Inputs(self): - - # Check if r-tests are available - if not osp.isdir(RTESTS_DIR): - Exception("The test data directory, {}, does not exist. If you haven't already, run `git submodule update --init --recursive`".format(RTESTS_DIR)) - - - # Read input deck - fast_reader = InputReader_OpenFAST() - fast_writer = InputWriter_OpenFAST() - fast_reader.FAST_InputFile = '5MW_Land_DLL_WTurb.fst' # FAST input file (ext=.fst) - fast_reader.FAST_directory = TEST_DATA_DIR # Path to fst directory files - fast_writer.FAST_runDirectory = osp.join('temp','OpenFAST') - fast_writer.FAST_namingOut = 'nrel5mw' - - with self.subTest('Reading', i=0): - try: - fast_reader.execute() - self.assertTrue(True) - except: - self.assertEqual('Reading','Success') - - # Test the OF writer - fast_writer.fst_vt = dict(fast_reader.fst_vt) - fst_vt = {} - fst_vt['Fst', 'TMax'] = 2. - fst_vt['AeroDyn15', 'TwrAero'] = False - fst_vt['Fst','CompMooring'] = 0 - fst_vt['Fst','CompServo'] = 0 - fst_vt['Fst','OutFileFmt'] = 3 - fast_writer.update(fst_update=fst_vt) - - with self.subTest('Writing', i=1): - try: - fast_writer.execute() - self.assertTrue(True) - except: - self.assertEqual('Writing','Success') - - with self.subTest('Running', i=2): - try: - subprocess.run([of_path, str(osp.join(fast_writer.FAST_runDirectory, fast_writer.FAST_namingOut+'.fst'))]) - self.assertTrue(True) - except: - self.assertEqual('Running','Success') - - def testOF_Outputs(self): - # Read output deck - asciiOutput = osp.join('temp','OpenFAST',f'nrel5mw.out') - binaryOutput = osp.join('temp','OpenFAST',f'nrel5mw.outb') - - with self.subTest('Reading ASCII output', i=0): - try: - fast_outout = FASTOutputFile(filename=asciiOutput) - self.assertTrue(True) - except: - self.assertEqual('Writing','Success') - - with self.subTest('Reading Binary output', i=1): - try: - fast_outout = FASTOutputFile(filename=binaryOutput) - self.assertTrue(True) - except: - self.assertEqual('Writing','Success') - - -if __name__ == "__main__": - unittest.main() diff --git a/openfast_python/poetry.lock b/openfast_python/poetry.lock deleted file mode 100644 index 2f75252d22..0000000000 --- a/openfast_python/poetry.lock +++ /dev/null @@ -1,3376 +0,0 @@ -# This file is automatically @generated by Poetry 1.8.2 and should not be changed by hand. - -[[package]] -name = "anyio" -version = "4.3.0" -description = "High level compatibility layer for multiple asynchronous event loop implementations" -optional = true -python-versions = ">=3.8" -files = [ - {file = "anyio-4.3.0-py3-none-any.whl", hash = "sha256:048e05d0f6caeed70d731f3db756d35dcc1f35747c8c403364a8332c630441b8"}, - {file = "anyio-4.3.0.tar.gz", hash = "sha256:f75253795a87df48568485fd18cdd2a3fa5c4f7c5be8e5e36637733fce06fed6"}, -] - -[package.dependencies] -exceptiongroup = {version = ">=1.0.2", markers = "python_version < \"3.11\""} -idna = ">=2.8" -sniffio = ">=1.1" -typing-extensions = {version = ">=4.1", markers = "python_version < \"3.11\""} - -[package.extras] -doc = ["Sphinx (>=7)", "packaging", "sphinx-autodoc-typehints (>=1.2.0)", "sphinx-rtd-theme"] -test = ["anyio[trio]", "coverage[toml] (>=7)", "exceptiongroup (>=1.2.0)", "hypothesis (>=4.0)", "psutil (>=5.9)", "pytest (>=7.0)", "pytest-mock (>=3.6.1)", "trustme", "uvloop (>=0.17)"] -trio = ["trio (>=0.23)"] - -[[package]] -name = "appnope" -version = "0.1.4" -description = "Disable App Nap on macOS >= 10.9" -optional = true -python-versions = ">=3.6" -files = [ - {file = "appnope-0.1.4-py2.py3-none-any.whl", hash = "sha256:502575ee11cd7a28c0205f379b525beefebab9d161b7c964670864014ed7213c"}, - {file = "appnope-0.1.4.tar.gz", hash = "sha256:1de3860566df9caf38f01f86f65e0e13e379af54f9e4bee1e66b48f2efffd1ee"}, -] - -[[package]] -name = "argon2-cffi" -version = "23.1.0" -description = "Argon2 for Python" -optional = true -python-versions = ">=3.7" -files = [ - {file = "argon2_cffi-23.1.0-py3-none-any.whl", hash = "sha256:c670642b78ba29641818ab2e68bd4e6a78ba53b7eff7b4c3815ae16abf91c7ea"}, - {file = "argon2_cffi-23.1.0.tar.gz", hash = "sha256:879c3e79a2729ce768ebb7d36d4609e3a78a4ca2ec3a9f12286ca057e3d0db08"}, -] - -[package.dependencies] -argon2-cffi-bindings = "*" - -[package.extras] -dev = ["argon2-cffi[tests,typing]", "tox (>4)"] -docs = ["furo", "myst-parser", "sphinx", "sphinx-copybutton", "sphinx-notfound-page"] -tests = ["hypothesis", "pytest"] -typing = ["mypy"] - -[[package]] -name = "argon2-cffi-bindings" -version = "21.2.0" -description = "Low-level CFFI bindings for Argon2" -optional = true -python-versions = ">=3.6" -files = [ - {file = "argon2-cffi-bindings-21.2.0.tar.gz", hash = "sha256:bb89ceffa6c791807d1305ceb77dbfacc5aa499891d2c55661c6459651fc39e3"}, - {file = "argon2_cffi_bindings-21.2.0-cp36-abi3-macosx_10_9_x86_64.whl", hash = "sha256:ccb949252cb2ab3a08c02024acb77cfb179492d5701c7cbdbfd776124d4d2367"}, - {file = "argon2_cffi_bindings-21.2.0-cp36-abi3-manylinux_2_17_aarch64.manylinux2014_aarch64.whl", hash = "sha256:9524464572e12979364b7d600abf96181d3541da11e23ddf565a32e70bd4dc0d"}, - {file = "argon2_cffi_bindings-21.2.0-cp36-abi3-manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:b746dba803a79238e925d9046a63aa26bf86ab2a2fe74ce6b009a1c3f5c8f2ae"}, - {file = "argon2_cffi_bindings-21.2.0-cp36-abi3-manylinux_2_5_i686.manylinux1_i686.manylinux_2_17_i686.manylinux2014_i686.whl", hash = "sha256:58ed19212051f49a523abb1dbe954337dc82d947fb6e5a0da60f7c8471a8476c"}, - {file = "argon2_cffi_bindings-21.2.0-cp36-abi3-musllinux_1_1_aarch64.whl", hash = "sha256:bd46088725ef7f58b5a1ef7ca06647ebaf0eb4baff7d1d0d177c6cc8744abd86"}, - {file = "argon2_cffi_bindings-21.2.0-cp36-abi3-musllinux_1_1_i686.whl", hash = "sha256:8cd69c07dd875537a824deec19f978e0f2078fdda07fd5c42ac29668dda5f40f"}, - {file = "argon2_cffi_bindings-21.2.0-cp36-abi3-musllinux_1_1_x86_64.whl", hash = "sha256:f1152ac548bd5b8bcecfb0b0371f082037e47128653df2e8ba6e914d384f3c3e"}, - {file = "argon2_cffi_bindings-21.2.0-cp36-abi3-win32.whl", hash = "sha256:603ca0aba86b1349b147cab91ae970c63118a0f30444d4bc80355937c950c082"}, - {file = "argon2_cffi_bindings-21.2.0-cp36-abi3-win_amd64.whl", hash = "sha256:b2ef1c30440dbbcba7a5dc3e319408b59676e2e039e2ae11a8775ecf482b192f"}, - {file = "argon2_cffi_bindings-21.2.0-cp38-abi3-macosx_10_9_universal2.whl", hash = "sha256:e415e3f62c8d124ee16018e491a009937f8cf7ebf5eb430ffc5de21b900dad93"}, - {file = "argon2_cffi_bindings-21.2.0-pp37-pypy37_pp73-macosx_10_9_x86_64.whl", hash = "sha256:3e385d1c39c520c08b53d63300c3ecc28622f076f4c2b0e6d7e796e9f6502194"}, - {file = "argon2_cffi_bindings-21.2.0-pp37-pypy37_pp73-manylinux_2_17_aarch64.manylinux2014_aarch64.whl", hash = "sha256:2c3e3cc67fdb7d82c4718f19b4e7a87123caf8a93fde7e23cf66ac0337d3cb3f"}, - {file = "argon2_cffi_bindings-21.2.0-pp37-pypy37_pp73-manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:6a22ad9800121b71099d0fb0a65323810a15f2e292f2ba450810a7316e128ee5"}, - {file = "argon2_cffi_bindings-21.2.0-pp37-pypy37_pp73-manylinux_2_5_i686.manylinux1_i686.manylinux_2_17_i686.manylinux2014_i686.whl", hash = "sha256:f9f8b450ed0547e3d473fdc8612083fd08dd2120d6ac8f73828df9b7d45bb351"}, - {file = "argon2_cffi_bindings-21.2.0-pp37-pypy37_pp73-win_amd64.whl", hash = "sha256:93f9bf70084f97245ba10ee36575f0c3f1e7d7724d67d8e5b08e61787c320ed7"}, - {file = "argon2_cffi_bindings-21.2.0-pp38-pypy38_pp73-macosx_10_9_x86_64.whl", hash = "sha256:3b9ef65804859d335dc6b31582cad2c5166f0c3e7975f324d9ffaa34ee7e6583"}, - {file = "argon2_cffi_bindings-21.2.0-pp38-pypy38_pp73-manylinux_2_17_aarch64.manylinux2014_aarch64.whl", hash = "sha256:d4966ef5848d820776f5f562a7d45fdd70c2f330c961d0d745b784034bd9f48d"}, - {file = "argon2_cffi_bindings-21.2.0-pp38-pypy38_pp73-manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:20ef543a89dee4db46a1a6e206cd015360e5a75822f76df533845c3cbaf72670"}, - {file = "argon2_cffi_bindings-21.2.0-pp38-pypy38_pp73-manylinux_2_5_i686.manylinux1_i686.manylinux_2_17_i686.manylinux2014_i686.whl", hash = "sha256:ed2937d286e2ad0cc79a7087d3c272832865f779430e0cc2b4f3718d3159b0cb"}, - {file = "argon2_cffi_bindings-21.2.0-pp38-pypy38_pp73-win_amd64.whl", hash = "sha256:5e00316dabdaea0b2dd82d141cc66889ced0cdcbfa599e8b471cf22c620c329a"}, -] - -[package.dependencies] -cffi = ">=1.0.1" - -[package.extras] -dev = ["cogapp", "pre-commit", "pytest", "wheel"] -tests = ["pytest"] - -[[package]] -name = "arrow" -version = "1.3.0" -description = "Better dates & times for Python" -optional = true -python-versions = ">=3.8" -files = [ - {file = "arrow-1.3.0-py3-none-any.whl", hash = "sha256:c728b120ebc00eb84e01882a6f5e7927a53960aa990ce7dd2b10f39005a67f80"}, - {file = "arrow-1.3.0.tar.gz", hash = "sha256:d4540617648cb5f895730f1ad8c82a65f2dad0166f57b75f3ca54759c4d67a85"}, -] - -[package.dependencies] -python-dateutil = ">=2.7.0" -types-python-dateutil = ">=2.8.10" - -[package.extras] -doc = ["doc8", "sphinx (>=7.0.0)", "sphinx-autobuild", "sphinx-autodoc-typehints", "sphinx_rtd_theme (>=1.3.0)"] -test = ["dateparser (==1.*)", "pre-commit", "pytest", "pytest-cov", "pytest-mock", "pytz (==2021.1)", "simplejson (==3.*)"] - -[[package]] -name = "asttokens" -version = "2.4.1" -description = "Annotate AST trees with source code positions" -optional = true -python-versions = "*" -files = [ - {file = "asttokens-2.4.1-py2.py3-none-any.whl", hash = "sha256:051ed49c3dcae8913ea7cd08e46a606dba30b79993209636c4875bc1d637bc24"}, - {file = "asttokens-2.4.1.tar.gz", hash = "sha256:b03869718ba9a6eb027e134bfdf69f38a236d681c83c160d510768af11254ba0"}, -] - -[package.dependencies] -six = ">=1.12.0" - -[package.extras] -astroid = ["astroid (>=1,<2)", "astroid (>=2,<4)"] -test = ["astroid (>=1,<2)", "astroid (>=2,<4)", "pytest"] - -[[package]] -name = "async-lru" -version = "2.0.4" -description = "Simple LRU cache for asyncio" -optional = true -python-versions = ">=3.8" -files = [ - {file = "async-lru-2.0.4.tar.gz", hash = "sha256:b8a59a5df60805ff63220b2a0c5b5393da5521b113cd5465a44eb037d81a5627"}, - {file = "async_lru-2.0.4-py3-none-any.whl", hash = "sha256:ff02944ce3c288c5be660c42dbcca0742b32c3b279d6dceda655190240b99224"}, -] - -[package.dependencies] -typing-extensions = {version = ">=4.0.0", markers = "python_version < \"3.11\""} - -[[package]] -name = "attrs" -version = "23.2.0" -description = "Classes Without Boilerplate" -optional = true -python-versions = ">=3.7" -files = [ - {file = "attrs-23.2.0-py3-none-any.whl", hash = "sha256:99b87a485a5820b23b879f04c2305b44b951b502fd64be915879d77a7e8fc6f1"}, - {file = "attrs-23.2.0.tar.gz", hash = "sha256:935dc3b529c262f6cf76e50877d35a4bd3c1de194fd41f47a2b7ae8f19971f30"}, -] - -[package.extras] -cov = ["attrs[tests]", "coverage[toml] (>=5.3)"] -dev = ["attrs[tests]", "pre-commit"] -docs = ["furo", "myst-parser", "sphinx", "sphinx-notfound-page", "sphinxcontrib-towncrier", "towncrier", "zope-interface"] -tests = ["attrs[tests-no-zope]", "zope-interface"] -tests-mypy = ["mypy (>=1.6)", "pytest-mypy-plugins"] -tests-no-zope = ["attrs[tests-mypy]", "cloudpickle", "hypothesis", "pympler", "pytest (>=4.3.0)", "pytest-xdist[psutil]"] - -[[package]] -name = "babel" -version = "2.15.0" -description = "Internationalization utilities" -optional = true -python-versions = ">=3.8" -files = [ - {file = "Babel-2.15.0-py3-none-any.whl", hash = "sha256:08706bdad8d0a3413266ab61bd6c34d0c28d6e1e7badf40a2cebe67644e2e1fb"}, - {file = "babel-2.15.0.tar.gz", hash = "sha256:8daf0e265d05768bc6c7a314cf1321e9a123afc328cc635c18622a2f30a04413"}, -] - -[package.extras] -dev = ["freezegun (>=1.0,<2.0)", "pytest (>=6.0)", "pytest-cov"] - -[[package]] -name = "beautifulsoup4" -version = "4.12.3" -description = "Screen-scraping library" -optional = true -python-versions = ">=3.6.0" -files = [ - {file = "beautifulsoup4-4.12.3-py3-none-any.whl", hash = "sha256:b80878c9f40111313e55da8ba20bdba06d8fa3969fc68304167741bbf9e082ed"}, - {file = "beautifulsoup4-4.12.3.tar.gz", hash = "sha256:74e3d1928edc070d21748185c46e3fb33490f22f52a3addee9aee0f4f7781051"}, -] - -[package.dependencies] -soupsieve = ">1.2" - -[package.extras] -cchardet = ["cchardet"] -chardet = ["chardet"] -charset-normalizer = ["charset-normalizer"] -html5lib = ["html5lib"] -lxml = ["lxml"] - -[[package]] -name = "bleach" -version = "6.1.0" -description = "An easy safelist-based HTML-sanitizing tool." -optional = true -python-versions = ">=3.8" -files = [ - {file = "bleach-6.1.0-py3-none-any.whl", hash = "sha256:3225f354cfc436b9789c66c4ee030194bee0568fbf9cbdad3bc8b5c26c5f12b6"}, - {file = "bleach-6.1.0.tar.gz", hash = "sha256:0a31f1837963c41d46bbf1331b8778e1308ea0791db03cc4e7357b97cf42a8fe"}, -] - -[package.dependencies] -six = ">=1.9.0" -webencodings = "*" - -[package.extras] -css = ["tinycss2 (>=1.1.0,<1.3)"] - -[[package]] -name = "certifi" -version = "2024.2.2" -description = "Python package for providing Mozilla's CA Bundle." -optional = true -python-versions = ">=3.6" -files = [ - {file = "certifi-2024.2.2-py3-none-any.whl", hash = "sha256:dc383c07b76109f368f6106eee2b593b04a011ea4d55f652c6ca24a754d1cdd1"}, - {file = "certifi-2024.2.2.tar.gz", hash = "sha256:0569859f95fc761b18b45ef421b1290a0f65f147e92a1e5eb3e635f9a5e4e66f"}, -] - -[[package]] -name = "cffi" -version = "1.16.0" -description = "Foreign Function Interface for Python calling C code." -optional = true -python-versions = ">=3.8" -files = [ - {file = "cffi-1.16.0-cp310-cp310-macosx_10_9_x86_64.whl", hash = "sha256:6b3d6606d369fc1da4fd8c357d026317fbb9c9b75d36dc16e90e84c26854b088"}, - {file = "cffi-1.16.0-cp310-cp310-macosx_11_0_arm64.whl", hash = "sha256:ac0f5edd2360eea2f1daa9e26a41db02dd4b0451b48f7c318e217ee092a213e9"}, - {file = "cffi-1.16.0-cp310-cp310-manylinux_2_12_i686.manylinux2010_i686.manylinux_2_17_i686.manylinux2014_i686.whl", hash = "sha256:7e61e3e4fa664a8588aa25c883eab612a188c725755afff6289454d6362b9673"}, - {file = "cffi-1.16.0-cp310-cp310-manylinux_2_17_aarch64.manylinux2014_aarch64.whl", hash = "sha256:a72e8961a86d19bdb45851d8f1f08b041ea37d2bd8d4fd19903bc3083d80c896"}, - {file = "cffi-1.16.0-cp310-cp310-manylinux_2_17_ppc64le.manylinux2014_ppc64le.whl", hash = "sha256:5b50bf3f55561dac5438f8e70bfcdfd74543fd60df5fa5f62d94e5867deca684"}, - {file = "cffi-1.16.0-cp310-cp310-manylinux_2_17_s390x.manylinux2014_s390x.whl", hash = "sha256:7651c50c8c5ef7bdb41108b7b8c5a83013bfaa8a935590c5d74627c047a583c7"}, - {file = "cffi-1.16.0-cp310-cp310-manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:e4108df7fe9b707191e55f33efbcb2d81928e10cea45527879a4749cbe472614"}, - {file = "cffi-1.16.0-cp310-cp310-musllinux_1_1_i686.whl", hash = "sha256:32c68ef735dbe5857c810328cb2481e24722a59a2003018885514d4c09af9743"}, - {file = "cffi-1.16.0-cp310-cp310-musllinux_1_1_x86_64.whl", hash = "sha256:673739cb539f8cdaa07d92d02efa93c9ccf87e345b9a0b556e3ecc666718468d"}, - {file = "cffi-1.16.0-cp310-cp310-win32.whl", hash = "sha256:9f90389693731ff1f659e55c7d1640e2ec43ff725cc61b04b2f9c6d8d017df6a"}, - {file = "cffi-1.16.0-cp310-cp310-win_amd64.whl", hash = "sha256:e6024675e67af929088fda399b2094574609396b1decb609c55fa58b028a32a1"}, - {file = "cffi-1.16.0-cp311-cp311-macosx_10_9_x86_64.whl", hash = "sha256:b84834d0cf97e7d27dd5b7f3aca7b6e9263c56308ab9dc8aae9784abb774d404"}, - {file = "cffi-1.16.0-cp311-cp311-macosx_11_0_arm64.whl", hash = "sha256:1b8ebc27c014c59692bb2664c7d13ce7a6e9a629be20e54e7271fa696ff2b417"}, - {file = "cffi-1.16.0-cp311-cp311-manylinux_2_12_i686.manylinux2010_i686.manylinux_2_17_i686.manylinux2014_i686.whl", hash = "sha256:ee07e47c12890ef248766a6e55bd38ebfb2bb8edd4142d56db91b21ea68b7627"}, - {file = "cffi-1.16.0-cp311-cp311-manylinux_2_17_aarch64.manylinux2014_aarch64.whl", hash = "sha256:d8a9d3ebe49f084ad71f9269834ceccbf398253c9fac910c4fd7053ff1386936"}, - {file = "cffi-1.16.0-cp311-cp311-manylinux_2_17_ppc64le.manylinux2014_ppc64le.whl", hash = "sha256:e70f54f1796669ef691ca07d046cd81a29cb4deb1e5f942003f401c0c4a2695d"}, - {file = "cffi-1.16.0-cp311-cp311-manylinux_2_17_s390x.manylinux2014_s390x.whl", hash = "sha256:5bf44d66cdf9e893637896c7faa22298baebcd18d1ddb6d2626a6e39793a1d56"}, - {file = "cffi-1.16.0-cp311-cp311-manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:7b78010e7b97fef4bee1e896df8a4bbb6712b7f05b7ef630f9d1da00f6444d2e"}, - {file = "cffi-1.16.0-cp311-cp311-musllinux_1_1_i686.whl", hash = "sha256:c6a164aa47843fb1b01e941d385aab7215563bb8816d80ff3a363a9f8448a8dc"}, - {file = "cffi-1.16.0-cp311-cp311-musllinux_1_1_x86_64.whl", hash = "sha256:e09f3ff613345df5e8c3667da1d918f9149bd623cd9070c983c013792a9a62eb"}, - {file = "cffi-1.16.0-cp311-cp311-win32.whl", hash = "sha256:2c56b361916f390cd758a57f2e16233eb4f64bcbeee88a4881ea90fca14dc6ab"}, - {file = "cffi-1.16.0-cp311-cp311-win_amd64.whl", hash = "sha256:db8e577c19c0fda0beb7e0d4e09e0ba74b1e4c092e0e40bfa12fe05b6f6d75ba"}, - {file = "cffi-1.16.0-cp312-cp312-macosx_10_9_x86_64.whl", hash = "sha256:fa3a0128b152627161ce47201262d3140edb5a5c3da88d73a1b790a959126956"}, - {file = "cffi-1.16.0-cp312-cp312-macosx_11_0_arm64.whl", hash = "sha256:68e7c44931cc171c54ccb702482e9fc723192e88d25a0e133edd7aff8fcd1f6e"}, - {file = "cffi-1.16.0-cp312-cp312-manylinux_2_12_i686.manylinux2010_i686.manylinux_2_17_i686.manylinux2014_i686.whl", hash = "sha256:abd808f9c129ba2beda4cfc53bde801e5bcf9d6e0f22f095e45327c038bfe68e"}, - {file = "cffi-1.16.0-cp312-cp312-manylinux_2_17_aarch64.manylinux2014_aarch64.whl", hash = "sha256:88e2b3c14bdb32e440be531ade29d3c50a1a59cd4e51b1dd8b0865c54ea5d2e2"}, - {file = "cffi-1.16.0-cp312-cp312-manylinux_2_17_ppc64le.manylinux2014_ppc64le.whl", hash = "sha256:fcc8eb6d5902bb1cf6dc4f187ee3ea80a1eba0a89aba40a5cb20a5087d961357"}, - {file = "cffi-1.16.0-cp312-cp312-manylinux_2_17_s390x.manylinux2014_s390x.whl", hash = "sha256:b7be2d771cdba2942e13215c4e340bfd76398e9227ad10402a8767ab1865d2e6"}, - {file = "cffi-1.16.0-cp312-cp312-manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:e715596e683d2ce000574bae5d07bd522c781a822866c20495e52520564f0969"}, - {file = "cffi-1.16.0-cp312-cp312-musllinux_1_1_x86_64.whl", hash = "sha256:2d92b25dbf6cae33f65005baf472d2c245c050b1ce709cc4588cdcdd5495b520"}, - {file = "cffi-1.16.0-cp312-cp312-win32.whl", hash = "sha256:b2ca4e77f9f47c55c194982e10f058db063937845bb2b7a86c84a6cfe0aefa8b"}, - {file = "cffi-1.16.0-cp312-cp312-win_amd64.whl", hash = "sha256:68678abf380b42ce21a5f2abde8efee05c114c2fdb2e9eef2efdb0257fba1235"}, - {file = "cffi-1.16.0-cp38-cp38-macosx_10_9_x86_64.whl", hash = "sha256:0c9ef6ff37e974b73c25eecc13952c55bceed9112be2d9d938ded8e856138bcc"}, - {file = "cffi-1.16.0-cp38-cp38-manylinux_2_12_i686.manylinux2010_i686.manylinux_2_17_i686.manylinux2014_i686.whl", hash = "sha256:a09582f178759ee8128d9270cd1344154fd473bb77d94ce0aeb2a93ebf0feaf0"}, - {file = "cffi-1.16.0-cp38-cp38-manylinux_2_17_aarch64.manylinux2014_aarch64.whl", hash = "sha256:e760191dd42581e023a68b758769e2da259b5d52e3103c6060ddc02c9edb8d7b"}, - {file = "cffi-1.16.0-cp38-cp38-manylinux_2_17_ppc64le.manylinux2014_ppc64le.whl", hash = "sha256:80876338e19c951fdfed6198e70bc88f1c9758b94578d5a7c4c91a87af3cf31c"}, - {file = "cffi-1.16.0-cp38-cp38-manylinux_2_17_s390x.manylinux2014_s390x.whl", hash = "sha256:a6a14b17d7e17fa0d207ac08642c8820f84f25ce17a442fd15e27ea18d67c59b"}, - {file = "cffi-1.16.0-cp38-cp38-manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:6602bc8dc6f3a9e02b6c22c4fc1e47aa50f8f8e6d3f78a5e16ac33ef5fefa324"}, - {file = "cffi-1.16.0-cp38-cp38-win32.whl", hash = "sha256:131fd094d1065b19540c3d72594260f118b231090295d8c34e19a7bbcf2e860a"}, - {file = "cffi-1.16.0-cp38-cp38-win_amd64.whl", hash = "sha256:31d13b0f99e0836b7ff893d37af07366ebc90b678b6664c955b54561fc36ef36"}, - {file = "cffi-1.16.0-cp39-cp39-macosx_10_9_x86_64.whl", hash = "sha256:582215a0e9adbe0e379761260553ba11c58943e4bbe9c36430c4ca6ac74b15ed"}, - {file = "cffi-1.16.0-cp39-cp39-macosx_11_0_arm64.whl", hash = "sha256:b29ebffcf550f9da55bec9e02ad430c992a87e5f512cd63388abb76f1036d8d2"}, - {file = "cffi-1.16.0-cp39-cp39-manylinux_2_12_i686.manylinux2010_i686.manylinux_2_17_i686.manylinux2014_i686.whl", hash = "sha256:dc9b18bf40cc75f66f40a7379f6a9513244fe33c0e8aa72e2d56b0196a7ef872"}, - {file = "cffi-1.16.0-cp39-cp39-manylinux_2_17_aarch64.manylinux2014_aarch64.whl", hash = "sha256:9cb4a35b3642fc5c005a6755a5d17c6c8b6bcb6981baf81cea8bfbc8903e8ba8"}, - {file = "cffi-1.16.0-cp39-cp39-manylinux_2_17_ppc64le.manylinux2014_ppc64le.whl", hash = "sha256:b86851a328eedc692acf81fb05444bdf1891747c25af7529e39ddafaf68a4f3f"}, - {file = "cffi-1.16.0-cp39-cp39-manylinux_2_17_s390x.manylinux2014_s390x.whl", hash = "sha256:c0f31130ebc2d37cdd8e44605fb5fa7ad59049298b3f745c74fa74c62fbfcfc4"}, - {file = "cffi-1.16.0-cp39-cp39-manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:8f8e709127c6c77446a8c0a8c8bf3c8ee706a06cd44b1e827c3e6a2ee6b8c098"}, - {file = "cffi-1.16.0-cp39-cp39-musllinux_1_1_i686.whl", hash = "sha256:748dcd1e3d3d7cd5443ef03ce8685043294ad6bd7c02a38d1bd367cfd968e000"}, - {file = "cffi-1.16.0-cp39-cp39-musllinux_1_1_x86_64.whl", hash = "sha256:8895613bcc094d4a1b2dbe179d88d7fb4a15cee43c052e8885783fac397d91fe"}, - {file = "cffi-1.16.0-cp39-cp39-win32.whl", hash = "sha256:ed86a35631f7bfbb28e108dd96773b9d5a6ce4811cf6ea468bb6a359b256b1e4"}, - {file = "cffi-1.16.0-cp39-cp39-win_amd64.whl", hash = "sha256:3686dffb02459559c74dd3d81748269ffb0eb027c39a6fc99502de37d501faa8"}, - {file = "cffi-1.16.0.tar.gz", hash = "sha256:bcb3ef43e58665bbda2fb198698fcae6776483e0c4a631aa5647806c25e02cc0"}, -] - -[package.dependencies] -pycparser = "*" - -[[package]] -name = "charset-normalizer" -version = "3.3.2" -description = "The Real First Universal Charset Detector. Open, modern and actively maintained alternative to Chardet." -optional = true -python-versions = ">=3.7.0" -files = [ - {file = "charset-normalizer-3.3.2.tar.gz", hash = "sha256:f30c3cb33b24454a82faecaf01b19c18562b1e89558fb6c56de4d9118a032fd5"}, - {file = "charset_normalizer-3.3.2-cp310-cp310-macosx_10_9_universal2.whl", hash = "sha256:25baf083bf6f6b341f4121c2f3c548875ee6f5339300e08be3f2b2ba1721cdd3"}, - {file = "charset_normalizer-3.3.2-cp310-cp310-macosx_10_9_x86_64.whl", hash = "sha256:06435b539f889b1f6f4ac1758871aae42dc3a8c0e24ac9e60c2384973ad73027"}, - {file = "charset_normalizer-3.3.2-cp310-cp310-macosx_11_0_arm64.whl", hash = "sha256:9063e24fdb1e498ab71cb7419e24622516c4a04476b17a2dab57e8baa30d6e03"}, - {file = "charset_normalizer-3.3.2-cp310-cp310-manylinux_2_17_aarch64.manylinux2014_aarch64.whl", hash = "sha256:6897af51655e3691ff853668779c7bad41579facacf5fd7253b0133308cf000d"}, - {file = "charset_normalizer-3.3.2-cp310-cp310-manylinux_2_17_ppc64le.manylinux2014_ppc64le.whl", hash = "sha256:1d3193f4a680c64b4b6a9115943538edb896edc190f0b222e73761716519268e"}, - {file = "charset_normalizer-3.3.2-cp310-cp310-manylinux_2_17_s390x.manylinux2014_s390x.whl", hash = "sha256:cd70574b12bb8a4d2aaa0094515df2463cb429d8536cfb6c7ce983246983e5a6"}, - {file = "charset_normalizer-3.3.2-cp310-cp310-manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:8465322196c8b4d7ab6d1e049e4c5cb460d0394da4a27d23cc242fbf0034b6b5"}, - {file = "charset_normalizer-3.3.2-cp310-cp310-manylinux_2_5_i686.manylinux1_i686.manylinux_2_17_i686.manylinux2014_i686.whl", hash = "sha256:a9a8e9031d613fd2009c182b69c7b2c1ef8239a0efb1df3f7c8da66d5dd3d537"}, - {file = "charset_normalizer-3.3.2-cp310-cp310-musllinux_1_1_aarch64.whl", hash = "sha256:beb58fe5cdb101e3a055192ac291b7a21e3b7ef4f67fa1d74e331a7f2124341c"}, - {file = "charset_normalizer-3.3.2-cp310-cp310-musllinux_1_1_i686.whl", hash = "sha256:e06ed3eb3218bc64786f7db41917d4e686cc4856944f53d5bdf83a6884432e12"}, - {file = "charset_normalizer-3.3.2-cp310-cp310-musllinux_1_1_ppc64le.whl", hash = "sha256:2e81c7b9c8979ce92ed306c249d46894776a909505d8f5a4ba55b14206e3222f"}, - {file = "charset_normalizer-3.3.2-cp310-cp310-musllinux_1_1_s390x.whl", hash = "sha256:572c3763a264ba47b3cf708a44ce965d98555f618ca42c926a9c1616d8f34269"}, - {file = "charset_normalizer-3.3.2-cp310-cp310-musllinux_1_1_x86_64.whl", hash = "sha256:fd1abc0d89e30cc4e02e4064dc67fcc51bd941eb395c502aac3ec19fab46b519"}, - {file = "charset_normalizer-3.3.2-cp310-cp310-win32.whl", hash = "sha256:3d47fa203a7bd9c5b6cee4736ee84ca03b8ef23193c0d1ca99b5089f72645c73"}, - {file = "charset_normalizer-3.3.2-cp310-cp310-win_amd64.whl", hash = "sha256:10955842570876604d404661fbccbc9c7e684caf432c09c715ec38fbae45ae09"}, - {file = "charset_normalizer-3.3.2-cp311-cp311-macosx_10_9_universal2.whl", hash = "sha256:802fe99cca7457642125a8a88a084cef28ff0cf9407060f7b93dca5aa25480db"}, - {file = "charset_normalizer-3.3.2-cp311-cp311-macosx_10_9_x86_64.whl", hash = "sha256:573f6eac48f4769d667c4442081b1794f52919e7edada77495aaed9236d13a96"}, - {file = "charset_normalizer-3.3.2-cp311-cp311-macosx_11_0_arm64.whl", hash = "sha256:549a3a73da901d5bc3ce8d24e0600d1fa85524c10287f6004fbab87672bf3e1e"}, - {file = "charset_normalizer-3.3.2-cp311-cp311-manylinux_2_17_aarch64.manylinux2014_aarch64.whl", hash = "sha256:f27273b60488abe721a075bcca6d7f3964f9f6f067c8c4c605743023d7d3944f"}, - {file = "charset_normalizer-3.3.2-cp311-cp311-manylinux_2_17_ppc64le.manylinux2014_ppc64le.whl", hash = "sha256:1ceae2f17a9c33cb48e3263960dc5fc8005351ee19db217e9b1bb15d28c02574"}, - {file = "charset_normalizer-3.3.2-cp311-cp311-manylinux_2_17_s390x.manylinux2014_s390x.whl", hash = "sha256:65f6f63034100ead094b8744b3b97965785388f308a64cf8d7c34f2f2e5be0c4"}, - {file = "charset_normalizer-3.3.2-cp311-cp311-manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:753f10e867343b4511128c6ed8c82f7bec3bd026875576dfd88483c5c73b2fd8"}, - {file = "charset_normalizer-3.3.2-cp311-cp311-manylinux_2_5_i686.manylinux1_i686.manylinux_2_17_i686.manylinux2014_i686.whl", hash = "sha256:4a78b2b446bd7c934f5dcedc588903fb2f5eec172f3d29e52a9096a43722adfc"}, - {file = "charset_normalizer-3.3.2-cp311-cp311-musllinux_1_1_aarch64.whl", hash = "sha256:e537484df0d8f426ce2afb2d0f8e1c3d0b114b83f8850e5f2fbea0e797bd82ae"}, - {file = "charset_normalizer-3.3.2-cp311-cp311-musllinux_1_1_i686.whl", hash = "sha256:eb6904c354526e758fda7167b33005998fb68c46fbc10e013ca97f21ca5c8887"}, - {file = "charset_normalizer-3.3.2-cp311-cp311-musllinux_1_1_ppc64le.whl", hash = "sha256:deb6be0ac38ece9ba87dea880e438f25ca3eddfac8b002a2ec3d9183a454e8ae"}, - {file = "charset_normalizer-3.3.2-cp311-cp311-musllinux_1_1_s390x.whl", hash = "sha256:4ab2fe47fae9e0f9dee8c04187ce5d09f48eabe611be8259444906793ab7cbce"}, - {file = "charset_normalizer-3.3.2-cp311-cp311-musllinux_1_1_x86_64.whl", hash = "sha256:80402cd6ee291dcb72644d6eac93785fe2c8b9cb30893c1af5b8fdd753b9d40f"}, - {file = "charset_normalizer-3.3.2-cp311-cp311-win32.whl", hash = "sha256:7cd13a2e3ddeed6913a65e66e94b51d80a041145a026c27e6bb76c31a853c6ab"}, - {file = "charset_normalizer-3.3.2-cp311-cp311-win_amd64.whl", hash = "sha256:663946639d296df6a2bb2aa51b60a2454ca1cb29835324c640dafb5ff2131a77"}, - {file = "charset_normalizer-3.3.2-cp312-cp312-macosx_10_9_universal2.whl", hash = "sha256:0b2b64d2bb6d3fb9112bafa732def486049e63de9618b5843bcdd081d8144cd8"}, - {file = "charset_normalizer-3.3.2-cp312-cp312-macosx_10_9_x86_64.whl", hash = "sha256:ddbb2551d7e0102e7252db79ba445cdab71b26640817ab1e3e3648dad515003b"}, - {file = "charset_normalizer-3.3.2-cp312-cp312-macosx_11_0_arm64.whl", hash = "sha256:55086ee1064215781fff39a1af09518bc9255b50d6333f2e4c74ca09fac6a8f6"}, - {file = "charset_normalizer-3.3.2-cp312-cp312-manylinux_2_17_aarch64.manylinux2014_aarch64.whl", hash = "sha256:8f4a014bc36d3c57402e2977dada34f9c12300af536839dc38c0beab8878f38a"}, - {file = "charset_normalizer-3.3.2-cp312-cp312-manylinux_2_17_ppc64le.manylinux2014_ppc64le.whl", hash = "sha256:a10af20b82360ab00827f916a6058451b723b4e65030c5a18577c8b2de5b3389"}, - {file = "charset_normalizer-3.3.2-cp312-cp312-manylinux_2_17_s390x.manylinux2014_s390x.whl", hash = "sha256:8d756e44e94489e49571086ef83b2bb8ce311e730092d2c34ca8f7d925cb20aa"}, - {file = "charset_normalizer-3.3.2-cp312-cp312-manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:90d558489962fd4918143277a773316e56c72da56ec7aa3dc3dbbe20fdfed15b"}, - {file = "charset_normalizer-3.3.2-cp312-cp312-manylinux_2_5_i686.manylinux1_i686.manylinux_2_17_i686.manylinux2014_i686.whl", hash = "sha256:6ac7ffc7ad6d040517be39eb591cac5ff87416c2537df6ba3cba3bae290c0fed"}, - {file = "charset_normalizer-3.3.2-cp312-cp312-musllinux_1_1_aarch64.whl", hash = "sha256:7ed9e526742851e8d5cc9e6cf41427dfc6068d4f5a3bb03659444b4cabf6bc26"}, - {file = "charset_normalizer-3.3.2-cp312-cp312-musllinux_1_1_i686.whl", hash = "sha256:8bdb58ff7ba23002a4c5808d608e4e6c687175724f54a5dade5fa8c67b604e4d"}, - {file = "charset_normalizer-3.3.2-cp312-cp312-musllinux_1_1_ppc64le.whl", hash = "sha256:6b3251890fff30ee142c44144871185dbe13b11bab478a88887a639655be1068"}, - {file = "charset_normalizer-3.3.2-cp312-cp312-musllinux_1_1_s390x.whl", hash = "sha256:b4a23f61ce87adf89be746c8a8974fe1c823c891d8f86eb218bb957c924bb143"}, - {file = "charset_normalizer-3.3.2-cp312-cp312-musllinux_1_1_x86_64.whl", hash = "sha256:efcb3f6676480691518c177e3b465bcddf57cea040302f9f4e6e191af91174d4"}, - {file = "charset_normalizer-3.3.2-cp312-cp312-win32.whl", hash = "sha256:d965bba47ddeec8cd560687584e88cf699fd28f192ceb452d1d7ee807c5597b7"}, - {file = "charset_normalizer-3.3.2-cp312-cp312-win_amd64.whl", hash = "sha256:96b02a3dc4381e5494fad39be677abcb5e6634bf7b4fa83a6dd3112607547001"}, - {file = "charset_normalizer-3.3.2-cp37-cp37m-macosx_10_9_x86_64.whl", hash = "sha256:95f2a5796329323b8f0512e09dbb7a1860c46a39da62ecb2324f116fa8fdc85c"}, - {file = "charset_normalizer-3.3.2-cp37-cp37m-manylinux_2_17_aarch64.manylinux2014_aarch64.whl", hash = "sha256:c002b4ffc0be611f0d9da932eb0f704fe2602a9a949d1f738e4c34c75b0863d5"}, - {file = "charset_normalizer-3.3.2-cp37-cp37m-manylinux_2_17_ppc64le.manylinux2014_ppc64le.whl", hash = "sha256:a981a536974bbc7a512cf44ed14938cf01030a99e9b3a06dd59578882f06f985"}, - {file = "charset_normalizer-3.3.2-cp37-cp37m-manylinux_2_17_s390x.manylinux2014_s390x.whl", hash = "sha256:3287761bc4ee9e33561a7e058c72ac0938c4f57fe49a09eae428fd88aafe7bb6"}, - {file = "charset_normalizer-3.3.2-cp37-cp37m-manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:42cb296636fcc8b0644486d15c12376cb9fa75443e00fb25de0b8602e64c1714"}, - {file = "charset_normalizer-3.3.2-cp37-cp37m-manylinux_2_5_i686.manylinux1_i686.manylinux_2_17_i686.manylinux2014_i686.whl", hash = "sha256:0a55554a2fa0d408816b3b5cedf0045f4b8e1a6065aec45849de2d6f3f8e9786"}, - {file = "charset_normalizer-3.3.2-cp37-cp37m-musllinux_1_1_aarch64.whl", hash = "sha256:c083af607d2515612056a31f0a8d9e0fcb5876b7bfc0abad3ecd275bc4ebc2d5"}, - {file = "charset_normalizer-3.3.2-cp37-cp37m-musllinux_1_1_i686.whl", hash = "sha256:87d1351268731db79e0f8e745d92493ee2841c974128ef629dc518b937d9194c"}, - {file = "charset_normalizer-3.3.2-cp37-cp37m-musllinux_1_1_ppc64le.whl", hash = "sha256:bd8f7df7d12c2db9fab40bdd87a7c09b1530128315d047a086fa3ae3435cb3a8"}, - {file = "charset_normalizer-3.3.2-cp37-cp37m-musllinux_1_1_s390x.whl", hash = "sha256:c180f51afb394e165eafe4ac2936a14bee3eb10debc9d9e4db8958fe36afe711"}, - {file = "charset_normalizer-3.3.2-cp37-cp37m-musllinux_1_1_x86_64.whl", hash = "sha256:8c622a5fe39a48f78944a87d4fb8a53ee07344641b0562c540d840748571b811"}, - {file = "charset_normalizer-3.3.2-cp37-cp37m-win32.whl", hash = "sha256:db364eca23f876da6f9e16c9da0df51aa4f104a972735574842618b8c6d999d4"}, - {file = "charset_normalizer-3.3.2-cp37-cp37m-win_amd64.whl", hash = "sha256:86216b5cee4b06df986d214f664305142d9c76df9b6512be2738aa72a2048f99"}, - {file = "charset_normalizer-3.3.2-cp38-cp38-macosx_10_9_universal2.whl", hash = "sha256:6463effa3186ea09411d50efc7d85360b38d5f09b870c48e4600f63af490e56a"}, - {file = "charset_normalizer-3.3.2-cp38-cp38-macosx_10_9_x86_64.whl", hash = "sha256:6c4caeef8fa63d06bd437cd4bdcf3ffefe6738fb1b25951440d80dc7df8c03ac"}, - {file = "charset_normalizer-3.3.2-cp38-cp38-macosx_11_0_arm64.whl", hash = "sha256:37e55c8e51c236f95b033f6fb391d7d7970ba5fe7ff453dad675e88cf303377a"}, - {file = "charset_normalizer-3.3.2-cp38-cp38-manylinux_2_17_aarch64.manylinux2014_aarch64.whl", hash = "sha256:fb69256e180cb6c8a894fee62b3afebae785babc1ee98b81cdf68bbca1987f33"}, - {file = "charset_normalizer-3.3.2-cp38-cp38-manylinux_2_17_ppc64le.manylinux2014_ppc64le.whl", hash = "sha256:ae5f4161f18c61806f411a13b0310bea87f987c7d2ecdbdaad0e94eb2e404238"}, - {file = "charset_normalizer-3.3.2-cp38-cp38-manylinux_2_17_s390x.manylinux2014_s390x.whl", hash = "sha256:b2b0a0c0517616b6869869f8c581d4eb2dd83a4d79e0ebcb7d373ef9956aeb0a"}, - {file = "charset_normalizer-3.3.2-cp38-cp38-manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:45485e01ff4d3630ec0d9617310448a8702f70e9c01906b0d0118bdf9d124cf2"}, - {file = "charset_normalizer-3.3.2-cp38-cp38-manylinux_2_5_i686.manylinux1_i686.manylinux_2_17_i686.manylinux2014_i686.whl", hash = "sha256:eb00ed941194665c332bf8e078baf037d6c35d7c4f3102ea2d4f16ca94a26dc8"}, - {file = "charset_normalizer-3.3.2-cp38-cp38-musllinux_1_1_aarch64.whl", hash = "sha256:2127566c664442652f024c837091890cb1942c30937add288223dc895793f898"}, - {file = "charset_normalizer-3.3.2-cp38-cp38-musllinux_1_1_i686.whl", hash = "sha256:a50aebfa173e157099939b17f18600f72f84eed3049e743b68ad15bd69b6bf99"}, - {file = "charset_normalizer-3.3.2-cp38-cp38-musllinux_1_1_ppc64le.whl", hash = "sha256:4d0d1650369165a14e14e1e47b372cfcb31d6ab44e6e33cb2d4e57265290044d"}, - {file = "charset_normalizer-3.3.2-cp38-cp38-musllinux_1_1_s390x.whl", hash = "sha256:923c0c831b7cfcb071580d3f46c4baf50f174be571576556269530f4bbd79d04"}, - {file = "charset_normalizer-3.3.2-cp38-cp38-musllinux_1_1_x86_64.whl", hash = "sha256:06a81e93cd441c56a9b65d8e1d043daeb97a3d0856d177d5c90ba85acb3db087"}, - {file = "charset_normalizer-3.3.2-cp38-cp38-win32.whl", hash = "sha256:6ef1d82a3af9d3eecdba2321dc1b3c238245d890843e040e41e470ffa64c3e25"}, - {file = "charset_normalizer-3.3.2-cp38-cp38-win_amd64.whl", hash = "sha256:eb8821e09e916165e160797a6c17edda0679379a4be5c716c260e836e122f54b"}, - {file = "charset_normalizer-3.3.2-cp39-cp39-macosx_10_9_universal2.whl", hash = "sha256:c235ebd9baae02f1b77bcea61bce332cb4331dc3617d254df3323aa01ab47bd4"}, - {file = "charset_normalizer-3.3.2-cp39-cp39-macosx_10_9_x86_64.whl", hash = "sha256:5b4c145409bef602a690e7cfad0a15a55c13320ff7a3ad7ca59c13bb8ba4d45d"}, - {file = "charset_normalizer-3.3.2-cp39-cp39-macosx_11_0_arm64.whl", hash = "sha256:68d1f8a9e9e37c1223b656399be5d6b448dea850bed7d0f87a8311f1ff3dabb0"}, - {file = "charset_normalizer-3.3.2-cp39-cp39-manylinux_2_17_aarch64.manylinux2014_aarch64.whl", hash = "sha256:22afcb9f253dac0696b5a4be4a1c0f8762f8239e21b99680099abd9b2b1b2269"}, - {file = "charset_normalizer-3.3.2-cp39-cp39-manylinux_2_17_ppc64le.manylinux2014_ppc64le.whl", hash = "sha256:e27ad930a842b4c5eb8ac0016b0a54f5aebbe679340c26101df33424142c143c"}, - {file = "charset_normalizer-3.3.2-cp39-cp39-manylinux_2_17_s390x.manylinux2014_s390x.whl", hash = "sha256:1f79682fbe303db92bc2b1136016a38a42e835d932bab5b3b1bfcfbf0640e519"}, - {file = "charset_normalizer-3.3.2-cp39-cp39-manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:b261ccdec7821281dade748d088bb6e9b69e6d15b30652b74cbbac25e280b796"}, - {file = "charset_normalizer-3.3.2-cp39-cp39-manylinux_2_5_i686.manylinux1_i686.manylinux_2_17_i686.manylinux2014_i686.whl", hash = "sha256:122c7fa62b130ed55f8f285bfd56d5f4b4a5b503609d181f9ad85e55c89f4185"}, - {file = "charset_normalizer-3.3.2-cp39-cp39-musllinux_1_1_aarch64.whl", hash = "sha256:d0eccceffcb53201b5bfebb52600a5fb483a20b61da9dbc885f8b103cbe7598c"}, - {file = "charset_normalizer-3.3.2-cp39-cp39-musllinux_1_1_i686.whl", hash = "sha256:9f96df6923e21816da7e0ad3fd47dd8f94b2a5ce594e00677c0013018b813458"}, - {file = "charset_normalizer-3.3.2-cp39-cp39-musllinux_1_1_ppc64le.whl", hash = "sha256:7f04c839ed0b6b98b1a7501a002144b76c18fb1c1850c8b98d458ac269e26ed2"}, - {file = "charset_normalizer-3.3.2-cp39-cp39-musllinux_1_1_s390x.whl", hash = "sha256:34d1c8da1e78d2e001f363791c98a272bb734000fcef47a491c1e3b0505657a8"}, - {file = "charset_normalizer-3.3.2-cp39-cp39-musllinux_1_1_x86_64.whl", hash = "sha256:ff8fa367d09b717b2a17a052544193ad76cd49979c805768879cb63d9ca50561"}, - {file = "charset_normalizer-3.3.2-cp39-cp39-win32.whl", hash = "sha256:aed38f6e4fb3f5d6bf81bfa990a07806be9d83cf7bacef998ab1a9bd660a581f"}, - {file = "charset_normalizer-3.3.2-cp39-cp39-win_amd64.whl", hash = "sha256:b01b88d45a6fcb69667cd6d2f7a9aeb4bf53760d7fc536bf679ec94fe9f3ff3d"}, - {file = "charset_normalizer-3.3.2-py3-none-any.whl", hash = "sha256:3e4d1f6587322d2788836a99c69062fbb091331ec940e02d12d179c1d53e25fc"}, -] - -[[package]] -name = "colorama" -version = "0.4.6" -description = "Cross-platform colored terminal text." -optional = true -python-versions = "!=3.0.*,!=3.1.*,!=3.2.*,!=3.3.*,!=3.4.*,!=3.5.*,!=3.6.*,>=2.7" -files = [ - {file = "colorama-0.4.6-py2.py3-none-any.whl", hash = "sha256:4f1d9991f5acc0ca119f9d443620b77f9d6b33703e51011c16baf57afb285fc6"}, - {file = "colorama-0.4.6.tar.gz", hash = "sha256:08695f5cb7ed6e0531a20572697297273c47b8cae5a63ffc6d6ed5c201be6e44"}, -] - -[[package]] -name = "comm" -version = "0.2.2" -description = "Jupyter Python Comm implementation, for usage in ipykernel, xeus-python etc." -optional = true -python-versions = ">=3.8" -files = [ - {file = "comm-0.2.2-py3-none-any.whl", hash = "sha256:e6fb86cb70ff661ee8c9c14e7d36d6de3b4066f1441be4063df9c5009f0a64d3"}, - {file = "comm-0.2.2.tar.gz", hash = "sha256:3fd7a84065306e07bea1773df6eb8282de51ba82f77c72f9c85716ab11fe980e"}, -] - -[package.dependencies] -traitlets = ">=4" - -[package.extras] -test = ["pytest"] - -[[package]] -name = "contourpy" -version = "1.2.1" -description = "Python library for calculating contours of 2D quadrilateral grids" -optional = true -python-versions = ">=3.9" -files = [ - {file = "contourpy-1.2.1-cp310-cp310-macosx_10_9_x86_64.whl", hash = "sha256:bd7c23df857d488f418439686d3b10ae2fbf9bc256cd045b37a8c16575ea1040"}, - {file = "contourpy-1.2.1-cp310-cp310-macosx_11_0_arm64.whl", hash = "sha256:5b9eb0ca724a241683c9685a484da9d35c872fd42756574a7cfbf58af26677fd"}, - {file = "contourpy-1.2.1-cp310-cp310-manylinux_2_17_aarch64.manylinux2014_aarch64.whl", hash = "sha256:4c75507d0a55378240f781599c30e7776674dbaf883a46d1c90f37e563453480"}, - {file = "contourpy-1.2.1-cp310-cp310-manylinux_2_17_ppc64le.manylinux2014_ppc64le.whl", hash = "sha256:11959f0ce4a6f7b76ec578576a0b61a28bdc0696194b6347ba3f1c53827178b9"}, - {file = "contourpy-1.2.1-cp310-cp310-manylinux_2_17_s390x.manylinux2014_s390x.whl", hash = "sha256:eb3315a8a236ee19b6df481fc5f997436e8ade24a9f03dfdc6bd490fea20c6da"}, - {file = "contourpy-1.2.1-cp310-cp310-manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:39f3ecaf76cd98e802f094e0d4fbc6dc9c45a8d0c4d185f0f6c2234e14e5f75b"}, - {file = "contourpy-1.2.1-cp310-cp310-musllinux_1_1_aarch64.whl", hash = "sha256:94b34f32646ca0414237168d68a9157cb3889f06b096612afdd296003fdd32fd"}, - {file = "contourpy-1.2.1-cp310-cp310-musllinux_1_1_x86_64.whl", hash = "sha256:457499c79fa84593f22454bbd27670227874cd2ff5d6c84e60575c8b50a69619"}, - {file = "contourpy-1.2.1-cp310-cp310-win32.whl", hash = "sha256:ac58bdee53cbeba2ecad824fa8159493f0bf3b8ea4e93feb06c9a465d6c87da8"}, - {file = "contourpy-1.2.1-cp310-cp310-win_amd64.whl", hash = "sha256:9cffe0f850e89d7c0012a1fb8730f75edd4320a0a731ed0c183904fe6ecfc3a9"}, - {file = "contourpy-1.2.1-cp311-cp311-macosx_10_9_x86_64.whl", hash = "sha256:6022cecf8f44e36af10bd9118ca71f371078b4c168b6e0fab43d4a889985dbb5"}, - {file = "contourpy-1.2.1-cp311-cp311-macosx_11_0_arm64.whl", hash = "sha256:ef5adb9a3b1d0c645ff694f9bca7702ec2c70f4d734f9922ea34de02294fdf72"}, - {file = "contourpy-1.2.1-cp311-cp311-manylinux_2_17_aarch64.manylinux2014_aarch64.whl", hash = "sha256:6150ffa5c767bc6332df27157d95442c379b7dce3a38dff89c0f39b63275696f"}, - {file = "contourpy-1.2.1-cp311-cp311-manylinux_2_17_ppc64le.manylinux2014_ppc64le.whl", hash = "sha256:4c863140fafc615c14a4bf4efd0f4425c02230eb8ef02784c9a156461e62c965"}, - {file = "contourpy-1.2.1-cp311-cp311-manylinux_2_17_s390x.manylinux2014_s390x.whl", hash = "sha256:00e5388f71c1a0610e6fe56b5c44ab7ba14165cdd6d695429c5cd94021e390b2"}, - {file = "contourpy-1.2.1-cp311-cp311-manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:d4492d82b3bc7fbb7e3610747b159869468079fe149ec5c4d771fa1f614a14df"}, - {file = "contourpy-1.2.1-cp311-cp311-musllinux_1_1_aarch64.whl", hash = "sha256:49e70d111fee47284d9dd867c9bb9a7058a3c617274900780c43e38d90fe1205"}, - {file = "contourpy-1.2.1-cp311-cp311-musllinux_1_1_x86_64.whl", hash = "sha256:b59c0ffceff8d4d3996a45f2bb6f4c207f94684a96bf3d9728dbb77428dd8cb8"}, - {file = "contourpy-1.2.1-cp311-cp311-win32.whl", hash = "sha256:7b4182299f251060996af5249c286bae9361fa8c6a9cda5efc29fe8bfd6062ec"}, - {file = "contourpy-1.2.1-cp311-cp311-win_amd64.whl", hash = "sha256:2855c8b0b55958265e8b5888d6a615ba02883b225f2227461aa9127c578a4922"}, - {file = "contourpy-1.2.1-cp312-cp312-macosx_10_9_x86_64.whl", hash = "sha256:62828cada4a2b850dbef89c81f5a33741898b305db244904de418cc957ff05dc"}, - {file = "contourpy-1.2.1-cp312-cp312-macosx_11_0_arm64.whl", hash = "sha256:309be79c0a354afff9ff7da4aaed7c3257e77edf6c1b448a779329431ee79d7e"}, - {file = "contourpy-1.2.1-cp312-cp312-manylinux_2_17_aarch64.manylinux2014_aarch64.whl", hash = "sha256:2e785e0f2ef0d567099b9ff92cbfb958d71c2d5b9259981cd9bee81bd194c9a4"}, - {file = "contourpy-1.2.1-cp312-cp312-manylinux_2_17_ppc64le.manylinux2014_ppc64le.whl", hash = "sha256:1cac0a8f71a041aa587410424ad46dfa6a11f6149ceb219ce7dd48f6b02b87a7"}, - {file = "contourpy-1.2.1-cp312-cp312-manylinux_2_17_s390x.manylinux2014_s390x.whl", hash = "sha256:af3f4485884750dddd9c25cb7e3915d83c2db92488b38ccb77dd594eac84c4a0"}, - {file = "contourpy-1.2.1-cp312-cp312-manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:9ce6889abac9a42afd07a562c2d6d4b2b7134f83f18571d859b25624a331c90b"}, - {file = "contourpy-1.2.1-cp312-cp312-musllinux_1_1_aarch64.whl", hash = "sha256:a1eea9aecf761c661d096d39ed9026574de8adb2ae1c5bd7b33558af884fb2ce"}, - {file = "contourpy-1.2.1-cp312-cp312-musllinux_1_1_x86_64.whl", hash = "sha256:187fa1d4c6acc06adb0fae5544c59898ad781409e61a926ac7e84b8f276dcef4"}, - {file = "contourpy-1.2.1-cp312-cp312-win32.whl", hash = "sha256:c2528d60e398c7c4c799d56f907664673a807635b857df18f7ae64d3e6ce2d9f"}, - {file = "contourpy-1.2.1-cp312-cp312-win_amd64.whl", hash = "sha256:1a07fc092a4088ee952ddae19a2b2a85757b923217b7eed584fdf25f53a6e7ce"}, - {file = "contourpy-1.2.1-cp39-cp39-macosx_10_9_x86_64.whl", hash = "sha256:bb6834cbd983b19f06908b45bfc2dad6ac9479ae04abe923a275b5f48f1a186b"}, - {file = "contourpy-1.2.1-cp39-cp39-macosx_11_0_arm64.whl", hash = "sha256:1d59e739ab0e3520e62a26c60707cc3ab0365d2f8fecea74bfe4de72dc56388f"}, - {file = "contourpy-1.2.1-cp39-cp39-manylinux_2_17_aarch64.manylinux2014_aarch64.whl", hash = "sha256:bd3db01f59fdcbce5b22afad19e390260d6d0222f35a1023d9adc5690a889364"}, - {file = "contourpy-1.2.1-cp39-cp39-manylinux_2_17_ppc64le.manylinux2014_ppc64le.whl", hash = "sha256:a12a813949e5066148712a0626895c26b2578874e4cc63160bb007e6df3436fe"}, - {file = "contourpy-1.2.1-cp39-cp39-manylinux_2_17_s390x.manylinux2014_s390x.whl", hash = "sha256:fe0ccca550bb8e5abc22f530ec0466136379c01321fd94f30a22231e8a48d985"}, - {file = "contourpy-1.2.1-cp39-cp39-manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:e1d59258c3c67c865435d8fbeb35f8c59b8bef3d6f46c1f29f6123556af28445"}, - {file = "contourpy-1.2.1-cp39-cp39-musllinux_1_1_aarch64.whl", hash = "sha256:f32c38afb74bd98ce26de7cc74a67b40afb7b05aae7b42924ea990d51e4dac02"}, - {file = "contourpy-1.2.1-cp39-cp39-musllinux_1_1_x86_64.whl", hash = "sha256:d31a63bc6e6d87f77d71e1abbd7387ab817a66733734883d1fc0021ed9bfa083"}, - {file = "contourpy-1.2.1-cp39-cp39-win32.whl", hash = "sha256:ddcb8581510311e13421b1f544403c16e901c4e8f09083c881fab2be80ee31ba"}, - {file = "contourpy-1.2.1-cp39-cp39-win_amd64.whl", hash = "sha256:10a37ae557aabf2509c79715cd20b62e4c7c28b8cd62dd7d99e5ed3ce28c3fd9"}, - {file = "contourpy-1.2.1-pp39-pypy39_pp73-macosx_10_9_x86_64.whl", hash = "sha256:a31f94983fecbac95e58388210427d68cd30fe8a36927980fab9c20062645609"}, - {file = "contourpy-1.2.1-pp39-pypy39_pp73-manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:ef2b055471c0eb466033760a521efb9d8a32b99ab907fc8358481a1dd29e3bd3"}, - {file = "contourpy-1.2.1-pp39-pypy39_pp73-win_amd64.whl", hash = "sha256:b33d2bc4f69caedcd0a275329eb2198f560b325605810895627be5d4b876bf7f"}, - {file = "contourpy-1.2.1.tar.gz", hash = "sha256:4d8908b3bee1c889e547867ca4cdc54e5ab6be6d3e078556814a22457f49423c"}, -] - -[package.dependencies] -numpy = ">=1.20" - -[package.extras] -bokeh = ["bokeh", "selenium"] -docs = ["furo", "sphinx (>=7.2)", "sphinx-copybutton"] -mypy = ["contourpy[bokeh,docs]", "docutils-stubs", "mypy (==1.8.0)", "types-Pillow"] -test = ["Pillow", "contourpy[test-no-images]", "matplotlib"] -test-no-images = ["pytest", "pytest-cov", "pytest-xdist", "wurlitzer"] - -[[package]] -name = "control" -version = "0.9.4" -description = "Python Control Systems Library" -optional = true -python-versions = ">=3.8" -files = [ - {file = "control-0.9.4-py3-none-any.whl", hash = "sha256:ab68980abd8d35ae5015ffa090865cbbd926deea7e66d0b9a41cfd12577e63ff"}, - {file = "control-0.9.4.tar.gz", hash = "sha256:0fa57d2216b7ac4e9339c09eab6827660318a641779335864feee940bd19c9ce"}, -] - -[package.dependencies] -matplotlib = "*" -numpy = "*" -scipy = ">=1.3" - -[package.extras] -cvxopt = ["cvxopt (>=1.2.0)"] -slycot = ["slycot (>=0.4.0)"] -test = ["pytest", "pytest-timeout"] - -[[package]] -name = "cycler" -version = "0.12.1" -description = "Composable style cycles" -optional = true -python-versions = ">=3.8" -files = [ - {file = "cycler-0.12.1-py3-none-any.whl", hash = "sha256:85cef7cff222d8644161529808465972e51340599459b8ac3ccbac5a854e0d30"}, - {file = "cycler-0.12.1.tar.gz", hash = "sha256:88bb128f02ba341da8ef447245a9e138fae777f6a23943da4540077d3601eb1c"}, -] - -[package.extras] -docs = ["ipython", "matplotlib", "numpydoc", "sphinx"] -tests = ["pytest", "pytest-cov", "pytest-xdist"] - -[[package]] -name = "dearpygui" -version = "1.11.1" -description = "DearPyGui: A simple Python GUI Toolkit" -optional = true -python-versions = ">=3.7" -files = [ - {file = "dearpygui-1.11.1-cp310-cp310-macosx_10_6_x86_64.whl", hash = "sha256:b668f28aab63d8ad0b2768add4e689bedb7480e8c3390edcce7a0f5d296fd61f"}, - {file = "dearpygui-1.11.1-cp310-cp310-macosx_13_0_arm64.whl", hash = "sha256:39d099b1ca97fd7d36934a5187fc4cd868d4772e504290a70fc95eda03c5125d"}, - {file = "dearpygui-1.11.1-cp310-cp310-manylinux1_x86_64.whl", hash = "sha256:3ba12334d993b653df2d07fe34c93c4ec65e54c022066ba245cd596a18b43a68"}, - {file = "dearpygui-1.11.1-cp310-cp310-win_amd64.whl", hash = "sha256:6cf4c44db1f016ff3eab367f7bde7f169bad5f2f90b974c202808112a69a2b15"}, - {file = "dearpygui-1.11.1-cp311-cp311-macosx_10_6_x86_64.whl", hash = "sha256:cc15cd13c1aeae2847ed9c4b2201169add3efdedf564eb706f5b5896ddaa5d8a"}, - {file = "dearpygui-1.11.1-cp311-cp311-macosx_13_0_arm64.whl", hash = "sha256:9eb7d581863d39543b213252041ed25856acbfa58c57291e6acb6ccbf0c2727b"}, - {file = "dearpygui-1.11.1-cp311-cp311-manylinux1_x86_64.whl", hash = "sha256:564ff3af657f7becd059b6611e162cc9cd8148befaf8aadb10e4fb76d57df3ef"}, - {file = "dearpygui-1.11.1-cp311-cp311-win_amd64.whl", hash = "sha256:ac6e9bde61dcb3cc253da59e70fe2b743d3c3b5791d415eaa8d307f4517048ca"}, - {file = "dearpygui-1.11.1-cp312-cp312-macosx_10_6_x86_64.whl", hash = "sha256:ccf576117ed2159cd66b419458d060923c9dcebe7fe57c65b4f4c4889287845d"}, - {file = "dearpygui-1.11.1-cp312-cp312-macosx_13_0_arm64.whl", hash = "sha256:1d632e1acdaa986a8c32b57112b84685b92d9a41f18580e14d463d7ed7a52673"}, - {file = "dearpygui-1.11.1-cp312-cp312-manylinux1_x86_64.whl", hash = "sha256:ca4f7ba667f64ee682dfcb3399d9d43df6821b2d962b96b4fa4535de5776f538"}, - {file = "dearpygui-1.11.1-cp312-cp312-win_amd64.whl", hash = "sha256:8ce9881a629de72e05ca8b1ce7cefcdd77b624eb7eba6f7d6629848d84a797f6"}, - {file = "dearpygui-1.11.1-cp38-cp38-macosx_10_6_x86_64.whl", hash = "sha256:39011ccb3a3ecfe3ebccfd8c4211c2c1446abd2865cbe4ccb67dc50a7a812bfb"}, - {file = "dearpygui-1.11.1-cp38-cp38-manylinux1_x86_64.whl", hash = "sha256:e1dde63d20ac062530debee001ad649190a7e09622762601454c4191799f13b8"}, - {file = "dearpygui-1.11.1-cp38-cp38-win_amd64.whl", hash = "sha256:23ce7ce8e5ba24d31bd6468cc43b56f8f257ace4dce3bc5fe449c546c340893a"}, - {file = "dearpygui-1.11.1-cp39-cp39-macosx_10_6_x86_64.whl", hash = "sha256:d22285f9a5f1377d87effd1f27020eec3ae0386f7c15a4893809909b82c62b1b"}, - {file = "dearpygui-1.11.1-cp39-cp39-manylinux1_x86_64.whl", hash = "sha256:f632bd94772e00313d0956bb9f9822c3ebcb7aa93f135f09e2fa187f3b06cea8"}, - {file = "dearpygui-1.11.1-cp39-cp39-win_amd64.whl", hash = "sha256:0c7c4849bc674e825750be69ee480450c3589c7d159955032776aaef5e7fda58"}, -] - -[[package]] -name = "debugpy" -version = "1.8.1" -description = "An implementation of the Debug Adapter Protocol for Python" -optional = true -python-versions = ">=3.8" -files = [ - {file = "debugpy-1.8.1-cp310-cp310-macosx_11_0_x86_64.whl", hash = "sha256:3bda0f1e943d386cc7a0e71bfa59f4137909e2ed947fb3946c506e113000f741"}, - {file = "debugpy-1.8.1-cp310-cp310-manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:dda73bf69ea479c8577a0448f8c707691152e6c4de7f0c4dec5a4bc11dee516e"}, - {file = "debugpy-1.8.1-cp310-cp310-win32.whl", hash = "sha256:3a79c6f62adef994b2dbe9fc2cc9cc3864a23575b6e387339ab739873bea53d0"}, - {file = "debugpy-1.8.1-cp310-cp310-win_amd64.whl", hash = "sha256:7eb7bd2b56ea3bedb009616d9e2f64aab8fc7000d481faec3cd26c98a964bcdd"}, - {file = "debugpy-1.8.1-cp311-cp311-macosx_11_0_universal2.whl", hash = "sha256:016a9fcfc2c6b57f939673c874310d8581d51a0fe0858e7fac4e240c5eb743cb"}, - {file = "debugpy-1.8.1-cp311-cp311-manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:fd97ed11a4c7f6d042d320ce03d83b20c3fb40da892f994bc041bbc415d7a099"}, - {file = "debugpy-1.8.1-cp311-cp311-win32.whl", hash = "sha256:0de56aba8249c28a300bdb0672a9b94785074eb82eb672db66c8144fff673146"}, - {file = "debugpy-1.8.1-cp311-cp311-win_amd64.whl", hash = "sha256:1a9fe0829c2b854757b4fd0a338d93bc17249a3bf69ecf765c61d4c522bb92a8"}, - {file = "debugpy-1.8.1-cp312-cp312-macosx_11_0_universal2.whl", hash = "sha256:3ebb70ba1a6524d19fa7bb122f44b74170c447d5746a503e36adc244a20ac539"}, - {file = "debugpy-1.8.1-cp312-cp312-manylinux_2_5_x86_64.manylinux1_x86_64.manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:a2e658a9630f27534e63922ebf655a6ab60c370f4d2fc5c02a5b19baf4410ace"}, - {file = "debugpy-1.8.1-cp312-cp312-win32.whl", hash = "sha256:caad2846e21188797a1f17fc09c31b84c7c3c23baf2516fed5b40b378515bbf0"}, - {file = "debugpy-1.8.1-cp312-cp312-win_amd64.whl", hash = "sha256:edcc9f58ec0fd121a25bc950d4578df47428d72e1a0d66c07403b04eb93bcf98"}, - {file = "debugpy-1.8.1-cp38-cp38-macosx_11_0_x86_64.whl", hash = "sha256:7a3afa222f6fd3d9dfecd52729bc2e12c93e22a7491405a0ecbf9e1d32d45b39"}, - {file = "debugpy-1.8.1-cp38-cp38-manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:d915a18f0597ef685e88bb35e5d7ab968964b7befefe1aaea1eb5b2640b586c7"}, - {file = "debugpy-1.8.1-cp38-cp38-win32.whl", hash = "sha256:92116039b5500633cc8d44ecc187abe2dfa9b90f7a82bbf81d079fcdd506bae9"}, - {file = "debugpy-1.8.1-cp38-cp38-win_amd64.whl", hash = "sha256:e38beb7992b5afd9d5244e96ad5fa9135e94993b0c551ceebf3fe1a5d9beb234"}, - {file = "debugpy-1.8.1-cp39-cp39-macosx_11_0_x86_64.whl", hash = "sha256:bfb20cb57486c8e4793d41996652e5a6a885b4d9175dd369045dad59eaacea42"}, - {file = "debugpy-1.8.1-cp39-cp39-manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:efd3fdd3f67a7e576dd869c184c5dd71d9aaa36ded271939da352880c012e703"}, - {file = "debugpy-1.8.1-cp39-cp39-win32.whl", hash = "sha256:58911e8521ca0c785ac7a0539f1e77e0ce2df753f786188f382229278b4cdf23"}, - {file = "debugpy-1.8.1-cp39-cp39-win_amd64.whl", hash = "sha256:6df9aa9599eb05ca179fb0b810282255202a66835c6efb1d112d21ecb830ddd3"}, - {file = "debugpy-1.8.1-py2.py3-none-any.whl", hash = "sha256:28acbe2241222b87e255260c76741e1fbf04fdc3b6d094fcf57b6c6f75ce1242"}, - {file = "debugpy-1.8.1.zip", hash = "sha256:f696d6be15be87aef621917585f9bb94b1dc9e8aced570db1b8a6fc14e8f9b42"}, -] - -[[package]] -name = "decorator" -version = "5.1.1" -description = "Decorators for Humans" -optional = true -python-versions = ">=3.5" -files = [ - {file = "decorator-5.1.1-py3-none-any.whl", hash = "sha256:b8c3f85900b9dc423225913c5aace94729fe1fa9763b38939a95226f02d37186"}, - {file = "decorator-5.1.1.tar.gz", hash = "sha256:637996211036b6385ef91435e4fae22989472f9d571faba8927ba8253acbc330"}, -] - -[[package]] -name = "defusedxml" -version = "0.7.1" -description = "XML bomb protection for Python stdlib modules" -optional = true -python-versions = ">=2.7, !=3.0.*, !=3.1.*, !=3.2.*, !=3.3.*, !=3.4.*" -files = [ - {file = "defusedxml-0.7.1-py2.py3-none-any.whl", hash = "sha256:a352e7e428770286cc899e2542b6cdaedb2b4953ff269a210103ec58f6198a61"}, - {file = "defusedxml-0.7.1.tar.gz", hash = "sha256:1bb3032db185915b62d7c6209c5a8792be6a32ab2fedacc84e01b52c51aa3e69"}, -] - -[[package]] -name = "docopt" -version = "0.6.2" -description = "Pythonic argument parser, that will make you smile" -optional = true -python-versions = "*" -files = [ - {file = "docopt-0.6.2.tar.gz", hash = "sha256:49b3a825280bd66b3aa83585ef59c4a8c82f2c8a522dbe754a8bc8d08c85c491"}, -] - -[[package]] -name = "et-xmlfile" -version = "1.1.0" -description = "An implementation of lxml.xmlfile for the standard library" -optional = true -python-versions = ">=3.6" -files = [ - {file = "et_xmlfile-1.1.0-py3-none-any.whl", hash = "sha256:a2ba85d1d6a74ef63837eed693bcb89c3f752169b0e3e7ae5b16ca5e1b3deada"}, - {file = "et_xmlfile-1.1.0.tar.gz", hash = "sha256:8eb9e2bc2f8c97e37a2dc85a09ecdcdec9d8a396530a6d5a33b30b9a92da0c5c"}, -] - -[[package]] -name = "exceptiongroup" -version = "1.2.1" -description = "Backport of PEP 654 (exception groups)" -optional = true -python-versions = ">=3.7" -files = [ - {file = "exceptiongroup-1.2.1-py3-none-any.whl", hash = "sha256:5258b9ed329c5bbdd31a309f53cbfb0b155341807f6ff7606a1e801a891b29ad"}, - {file = "exceptiongroup-1.2.1.tar.gz", hash = "sha256:a4785e48b045528f5bfe627b6ad554ff32def154f42372786903b7abcfe1aa16"}, -] - -[package.extras] -test = ["pytest (>=6)"] - -[[package]] -name = "executing" -version = "2.0.1" -description = "Get the currently executing AST node of a frame, and other information" -optional = true -python-versions = ">=3.5" -files = [ - {file = "executing-2.0.1-py2.py3-none-any.whl", hash = "sha256:eac49ca94516ccc753f9fb5ce82603156e590b27525a8bc32cce8ae302eb61bc"}, - {file = "executing-2.0.1.tar.gz", hash = "sha256:35afe2ce3affba8ee97f2d69927fa823b08b472b7b994e36a52a964b93d16147"}, -] - -[package.extras] -tests = ["asttokens (>=2.1.0)", "coverage", "coverage-enable-subprocess", "ipython", "littleutils", "pytest", "rich"] - -[[package]] -name = "fastjsonschema" -version = "2.19.1" -description = "Fastest Python implementation of JSON schema" -optional = true -python-versions = "*" -files = [ - {file = "fastjsonschema-2.19.1-py3-none-any.whl", hash = "sha256:3672b47bc94178c9f23dbb654bf47440155d4db9df5f7bc47643315f9c405cd0"}, - {file = "fastjsonschema-2.19.1.tar.gz", hash = "sha256:e3126a94bdc4623d3de4485f8d468a12f02a67921315ddc87836d6e456dc789d"}, -] - -[package.extras] -devel = ["colorama", "json-spec", "jsonschema", "pylint", "pytest", "pytest-benchmark", "pytest-cache", "validictory"] - -[[package]] -name = "fonttools" -version = "4.51.0" -description = "Tools to manipulate font files" -optional = true -python-versions = ">=3.8" -files = [ - {file = "fonttools-4.51.0-cp310-cp310-macosx_10_9_universal2.whl", hash = "sha256:84d7751f4468dd8cdd03ddada18b8b0857a5beec80bce9f435742abc9a851a74"}, - {file = "fonttools-4.51.0-cp310-cp310-macosx_10_9_x86_64.whl", hash = "sha256:8b4850fa2ef2cfbc1d1f689bc159ef0f45d8d83298c1425838095bf53ef46308"}, - {file = "fonttools-4.51.0-cp310-cp310-manylinux_2_17_aarch64.manylinux2014_aarch64.whl", hash = "sha256:b5b48a1121117047d82695d276c2af2ee3a24ffe0f502ed581acc2673ecf1037"}, - {file = "fonttools-4.51.0-cp310-cp310-manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:180194c7fe60c989bb627d7ed5011f2bef1c4d36ecf3ec64daec8302f1ae0716"}, - {file = "fonttools-4.51.0-cp310-cp310-musllinux_1_1_aarch64.whl", hash = "sha256:96a48e137c36be55e68845fc4284533bda2980f8d6f835e26bca79d7e2006438"}, - {file = "fonttools-4.51.0-cp310-cp310-musllinux_1_1_x86_64.whl", hash = "sha256:806e7912c32a657fa39d2d6eb1d3012d35f841387c8fc6cf349ed70b7c340039"}, - {file = "fonttools-4.51.0-cp310-cp310-win32.whl", hash = "sha256:32b17504696f605e9e960647c5f64b35704782a502cc26a37b800b4d69ff3c77"}, - {file = "fonttools-4.51.0-cp310-cp310-win_amd64.whl", hash = "sha256:c7e91abdfae1b5c9e3a543f48ce96013f9a08c6c9668f1e6be0beabf0a569c1b"}, - {file = "fonttools-4.51.0-cp311-cp311-macosx_10_9_universal2.whl", hash = "sha256:a8feca65bab31479d795b0d16c9a9852902e3a3c0630678efb0b2b7941ea9c74"}, - {file = "fonttools-4.51.0-cp311-cp311-macosx_10_9_x86_64.whl", hash = "sha256:8ac27f436e8af7779f0bb4d5425aa3535270494d3bc5459ed27de3f03151e4c2"}, - {file = "fonttools-4.51.0-cp311-cp311-manylinux_2_17_aarch64.manylinux2014_aarch64.whl", hash = "sha256:0e19bd9e9964a09cd2433a4b100ca7f34e34731e0758e13ba9a1ed6e5468cc0f"}, - {file = "fonttools-4.51.0-cp311-cp311-manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:b2b92381f37b39ba2fc98c3a45a9d6383bfc9916a87d66ccb6553f7bdd129097"}, - {file = "fonttools-4.51.0-cp311-cp311-musllinux_1_1_aarch64.whl", hash = "sha256:5f6bc991d1610f5c3bbe997b0233cbc234b8e82fa99fc0b2932dc1ca5e5afec0"}, - {file = "fonttools-4.51.0-cp311-cp311-musllinux_1_1_x86_64.whl", hash = "sha256:9696fe9f3f0c32e9a321d5268208a7cc9205a52f99b89479d1b035ed54c923f1"}, - {file = "fonttools-4.51.0-cp311-cp311-win32.whl", hash = "sha256:3bee3f3bd9fa1d5ee616ccfd13b27ca605c2b4270e45715bd2883e9504735034"}, - {file = "fonttools-4.51.0-cp311-cp311-win_amd64.whl", hash = "sha256:0f08c901d3866a8905363619e3741c33f0a83a680d92a9f0e575985c2634fcc1"}, - {file = "fonttools-4.51.0-cp312-cp312-macosx_10_9_universal2.whl", hash = "sha256:4060acc2bfa2d8e98117828a238889f13b6f69d59f4f2d5857eece5277b829ba"}, - {file = "fonttools-4.51.0-cp312-cp312-macosx_10_9_x86_64.whl", hash = "sha256:1250e818b5f8a679ad79660855528120a8f0288f8f30ec88b83db51515411fcc"}, - {file = "fonttools-4.51.0-cp312-cp312-manylinux_2_17_aarch64.manylinux2014_aarch64.whl", hash = "sha256:76f1777d8b3386479ffb4a282e74318e730014d86ce60f016908d9801af9ca2a"}, - {file = "fonttools-4.51.0-cp312-cp312-manylinux_2_5_x86_64.manylinux1_x86_64.manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:8b5ad456813d93b9c4b7ee55302208db2b45324315129d85275c01f5cb7e61a2"}, - {file = "fonttools-4.51.0-cp312-cp312-musllinux_1_1_aarch64.whl", hash = "sha256:68b3fb7775a923be73e739f92f7e8a72725fd333eab24834041365d2278c3671"}, - {file = "fonttools-4.51.0-cp312-cp312-musllinux_1_1_x86_64.whl", hash = "sha256:8e2f1a4499e3b5ee82c19b5ee57f0294673125c65b0a1ff3764ea1f9db2f9ef5"}, - {file = "fonttools-4.51.0-cp312-cp312-win32.whl", hash = "sha256:278e50f6b003c6aed19bae2242b364e575bcb16304b53f2b64f6551b9c000e15"}, - {file = "fonttools-4.51.0-cp312-cp312-win_amd64.whl", hash = "sha256:b3c61423f22165541b9403ee39874dcae84cd57a9078b82e1dce8cb06b07fa2e"}, - {file = "fonttools-4.51.0-cp38-cp38-macosx_10_9_universal2.whl", hash = "sha256:1621ee57da887c17312acc4b0e7ac30d3a4fb0fec6174b2e3754a74c26bbed1e"}, - {file = "fonttools-4.51.0-cp38-cp38-macosx_10_9_x86_64.whl", hash = "sha256:e9d9298be7a05bb4801f558522adbe2feea1b0b103d5294ebf24a92dd49b78e5"}, - {file = "fonttools-4.51.0-cp38-cp38-manylinux_2_17_aarch64.manylinux2014_aarch64.whl", hash = "sha256:ee1af4be1c5afe4c96ca23badd368d8dc75f611887fb0c0dac9f71ee5d6f110e"}, - {file = "fonttools-4.51.0-cp38-cp38-manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:c18b49adc721a7d0b8dfe7c3130c89b8704baf599fb396396d07d4aa69b824a1"}, - {file = "fonttools-4.51.0-cp38-cp38-musllinux_1_1_aarch64.whl", hash = "sha256:de7c29bdbdd35811f14493ffd2534b88f0ce1b9065316433b22d63ca1cd21f14"}, - {file = "fonttools-4.51.0-cp38-cp38-musllinux_1_1_x86_64.whl", hash = "sha256:cadf4e12a608ef1d13e039864f484c8a968840afa0258b0b843a0556497ea9ed"}, - {file = "fonttools-4.51.0-cp38-cp38-win32.whl", hash = "sha256:aefa011207ed36cd280babfaa8510b8176f1a77261833e895a9d96e57e44802f"}, - {file = "fonttools-4.51.0-cp38-cp38-win_amd64.whl", hash = "sha256:865a58b6e60b0938874af0968cd0553bcd88e0b2cb6e588727117bd099eef836"}, - {file = "fonttools-4.51.0-cp39-cp39-macosx_10_9_universal2.whl", hash = "sha256:60a3409c9112aec02d5fb546f557bca6efa773dcb32ac147c6baf5f742e6258b"}, - {file = "fonttools-4.51.0-cp39-cp39-macosx_10_9_x86_64.whl", hash = "sha256:f7e89853d8bea103c8e3514b9f9dc86b5b4120afb4583b57eb10dfa5afbe0936"}, - {file = "fonttools-4.51.0-cp39-cp39-manylinux_2_17_aarch64.manylinux2014_aarch64.whl", hash = "sha256:56fc244f2585d6c00b9bcc59e6593e646cf095a96fe68d62cd4da53dd1287b55"}, - {file = "fonttools-4.51.0-cp39-cp39-manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:0d145976194a5242fdd22df18a1b451481a88071feadf251221af110ca8f00ce"}, - {file = "fonttools-4.51.0-cp39-cp39-musllinux_1_1_aarch64.whl", hash = "sha256:c5b8cab0c137ca229433570151b5c1fc6af212680b58b15abd797dcdd9dd5051"}, - {file = "fonttools-4.51.0-cp39-cp39-musllinux_1_1_x86_64.whl", hash = "sha256:54dcf21a2f2d06ded676e3c3f9f74b2bafded3a8ff12f0983160b13e9f2fb4a7"}, - {file = "fonttools-4.51.0-cp39-cp39-win32.whl", hash = "sha256:0118ef998a0699a96c7b28457f15546815015a2710a1b23a7bf6c1be60c01636"}, - {file = "fonttools-4.51.0-cp39-cp39-win_amd64.whl", hash = "sha256:599bdb75e220241cedc6faebfafedd7670335d2e29620d207dd0378a4e9ccc5a"}, - {file = "fonttools-4.51.0-py3-none-any.whl", hash = "sha256:15c94eeef6b095831067f72c825eb0e2d48bb4cea0647c1b05c981ecba2bf39f"}, - {file = "fonttools-4.51.0.tar.gz", hash = "sha256:dc0673361331566d7a663d7ce0f6fdcbfbdc1f59c6e3ed1165ad7202ca183c68"}, -] - -[package.extras] -all = ["brotli (>=1.0.1)", "brotlicffi (>=0.8.0)", "fs (>=2.2.0,<3)", "lxml (>=4.0)", "lz4 (>=1.7.4.2)", "matplotlib", "munkres", "pycairo", "scipy", "skia-pathops (>=0.5.0)", "sympy", "uharfbuzz (>=0.23.0)", "unicodedata2 (>=15.1.0)", "xattr", "zopfli (>=0.1.4)"] -graphite = ["lz4 (>=1.7.4.2)"] -interpolatable = ["munkres", "pycairo", "scipy"] -lxml = ["lxml (>=4.0)"] -pathops = ["skia-pathops (>=0.5.0)"] -plot = ["matplotlib"] -repacker = ["uharfbuzz (>=0.23.0)"] -symfont = ["sympy"] -type1 = ["xattr"] -ufo = ["fs (>=2.2.0,<3)"] -unicode = ["unicodedata2 (>=15.1.0)"] -woff = ["brotli (>=1.0.1)", "brotlicffi (>=0.8.0)", "zopfli (>=0.1.4)"] - -[[package]] -name = "fqdn" -version = "1.5.1" -description = "Validates fully-qualified domain names against RFC 1123, so that they are acceptable to modern bowsers" -optional = true -python-versions = ">=2.7, !=3.0, !=3.1, !=3.2, !=3.3, !=3.4, <4" -files = [ - {file = "fqdn-1.5.1-py3-none-any.whl", hash = "sha256:3a179af3761e4df6eb2e026ff9e1a3033d3587bf980a0b1b2e1e5d08d7358014"}, - {file = "fqdn-1.5.1.tar.gz", hash = "sha256:105ed3677e767fb5ca086a0c1f4bb66ebc3c100be518f0e0d755d9eae164d89f"}, -] - -[[package]] -name = "h11" -version = "0.14.0" -description = "A pure-Python, bring-your-own-I/O implementation of HTTP/1.1" -optional = true -python-versions = ">=3.7" -files = [ - {file = "h11-0.14.0-py3-none-any.whl", hash = "sha256:e3fe4ac4b851c468cc8363d500db52c2ead036020723024a109d37346efaa761"}, - {file = "h11-0.14.0.tar.gz", hash = "sha256:8f19fbbe99e72420ff35c00b27a34cb9937e902a8b810e2c88300c6f0a3b699d"}, -] - -[[package]] -name = "httpcore" -version = "1.0.5" -description = "A minimal low-level HTTP client." -optional = true -python-versions = ">=3.8" -files = [ - {file = "httpcore-1.0.5-py3-none-any.whl", hash = "sha256:421f18bac248b25d310f3cacd198d55b8e6125c107797b609ff9b7a6ba7991b5"}, - {file = "httpcore-1.0.5.tar.gz", hash = "sha256:34a38e2f9291467ee3b44e89dd52615370e152954ba21721378a87b2960f7a61"}, -] - -[package.dependencies] -certifi = "*" -h11 = ">=0.13,<0.15" - -[package.extras] -asyncio = ["anyio (>=4.0,<5.0)"] -http2 = ["h2 (>=3,<5)"] -socks = ["socksio (==1.*)"] -trio = ["trio (>=0.22.0,<0.26.0)"] - -[[package]] -name = "httpx" -version = "0.27.0" -description = "The next generation HTTP client." -optional = true -python-versions = ">=3.8" -files = [ - {file = "httpx-0.27.0-py3-none-any.whl", hash = "sha256:71d5465162c13681bff01ad59b2cc68dd838ea1f10e51574bac27103f00c91a5"}, - {file = "httpx-0.27.0.tar.gz", hash = "sha256:a0cb88a46f32dc874e04ee956e4c2764aba2aa228f650b06788ba6bda2962ab5"}, -] - -[package.dependencies] -anyio = "*" -certifi = "*" -httpcore = "==1.*" -idna = "*" -sniffio = "*" - -[package.extras] -brotli = ["brotli", "brotlicffi"] -cli = ["click (==8.*)", "pygments (==2.*)", "rich (>=10,<14)"] -http2 = ["h2 (>=3,<5)"] -socks = ["socksio (==1.*)"] - -[[package]] -name = "idna" -version = "3.7" -description = "Internationalized Domain Names in Applications (IDNA)" -optional = true -python-versions = ">=3.5" -files = [ - {file = "idna-3.7-py3-none-any.whl", hash = "sha256:82fee1fc78add43492d3a1898bfa6d8a904cc97d8427f683ed8e798d07761aa0"}, - {file = "idna-3.7.tar.gz", hash = "sha256:028ff3aadf0609c1fd278d8ea3089299412a7a8b9bd005dd08b9f8285bcb5cfc"}, -] - -[[package]] -name = "importlib-metadata" -version = "7.1.0" -description = "Read metadata from Python packages" -optional = true -python-versions = ">=3.8" -files = [ - {file = "importlib_metadata-7.1.0-py3-none-any.whl", hash = "sha256:30962b96c0c223483ed6cc7280e7f0199feb01a0e40cfae4d4450fc6fab1f570"}, - {file = "importlib_metadata-7.1.0.tar.gz", hash = "sha256:b78938b926ee8d5f020fc4772d487045805a55ddbad2ecf21c6d60938dc7fcd2"}, -] - -[package.dependencies] -zipp = ">=0.5" - -[package.extras] -docs = ["furo", "jaraco.packaging (>=9.3)", "jaraco.tidelift (>=1.4)", "rst.linker (>=1.9)", "sphinx (>=3.5)", "sphinx-lint"] -perf = ["ipython"] -testing = ["flufl.flake8", "importlib-resources (>=1.3)", "jaraco.test (>=5.4)", "packaging", "pyfakefs", "pytest (>=6)", "pytest-checkdocs (>=2.4)", "pytest-cov", "pytest-enabler (>=2.2)", "pytest-mypy", "pytest-perf (>=0.9.2)", "pytest-ruff (>=0.2.1)"] - -[[package]] -name = "importlib-resources" -version = "6.4.0" -description = "Read resources from Python packages" -optional = true -python-versions = ">=3.8" -files = [ - {file = "importlib_resources-6.4.0-py3-none-any.whl", hash = "sha256:50d10f043df931902d4194ea07ec57960f66a80449ff867bfe782b4c486ba78c"}, - {file = "importlib_resources-6.4.0.tar.gz", hash = "sha256:cdb2b453b8046ca4e3798eb1d84f3cce1446a0e8e7b5ef4efb600f19fc398145"}, -] - -[package.dependencies] -zipp = {version = ">=3.1.0", markers = "python_version < \"3.10\""} - -[package.extras] -docs = ["furo", "jaraco.packaging (>=9.3)", "jaraco.tidelift (>=1.4)", "rst.linker (>=1.9)", "sphinx (<7.2.5)", "sphinx (>=3.5)", "sphinx-lint"] -testing = ["jaraco.test (>=5.4)", "pytest (>=6)", "pytest-checkdocs (>=2.4)", "pytest-cov", "pytest-enabler (>=2.2)", "pytest-mypy", "pytest-ruff (>=0.2.1)", "zipp (>=3.17)"] - -[[package]] -name = "ipykernel" -version = "6.29.4" -description = "IPython Kernel for Jupyter" -optional = true -python-versions = ">=3.8" -files = [ - {file = "ipykernel-6.29.4-py3-none-any.whl", hash = "sha256:1181e653d95c6808039c509ef8e67c4126b3b3af7781496c7cbfb5ed938a27da"}, - {file = "ipykernel-6.29.4.tar.gz", hash = "sha256:3d44070060f9475ac2092b760123fadf105d2e2493c24848b6691a7c4f42af5c"}, -] - -[package.dependencies] -appnope = {version = "*", markers = "platform_system == \"Darwin\""} -comm = ">=0.1.1" -debugpy = ">=1.6.5" -ipython = ">=7.23.1" -jupyter-client = ">=6.1.12" -jupyter-core = ">=4.12,<5.0.dev0 || >=5.1.dev0" -matplotlib-inline = ">=0.1" -nest-asyncio = "*" -packaging = "*" -psutil = "*" -pyzmq = ">=24" -tornado = ">=6.1" -traitlets = ">=5.4.0" - -[package.extras] -cov = ["coverage[toml]", "curio", "matplotlib", "pytest-cov", "trio"] -docs = ["myst-parser", "pydata-sphinx-theme", "sphinx", "sphinx-autodoc-typehints", "sphinxcontrib-github-alt", "sphinxcontrib-spelling", "trio"] -pyqt5 = ["pyqt5"] -pyside6 = ["pyside6"] -test = ["flaky", "ipyparallel", "pre-commit", "pytest (>=7.0)", "pytest-asyncio (>=0.23.5)", "pytest-cov", "pytest-timeout"] - -[[package]] -name = "ipython" -version = "8.18.1" -description = "IPython: Productive Interactive Computing" -optional = true -python-versions = ">=3.9" -files = [ - {file = "ipython-8.18.1-py3-none-any.whl", hash = "sha256:e8267419d72d81955ec1177f8a29aaa90ac80ad647499201119e2f05e99aa397"}, - {file = "ipython-8.18.1.tar.gz", hash = "sha256:ca6f079bb33457c66e233e4580ebfc4128855b4cf6370dddd73842a9563e8a27"}, -] - -[package.dependencies] -colorama = {version = "*", markers = "sys_platform == \"win32\""} -decorator = "*" -exceptiongroup = {version = "*", markers = "python_version < \"3.11\""} -jedi = ">=0.16" -matplotlib-inline = "*" -pexpect = {version = ">4.3", markers = "sys_platform != \"win32\""} -prompt-toolkit = ">=3.0.41,<3.1.0" -pygments = ">=2.4.0" -stack-data = "*" -traitlets = ">=5" -typing-extensions = {version = "*", markers = "python_version < \"3.10\""} - -[package.extras] -all = ["black", "curio", "docrepr", "exceptiongroup", "ipykernel", "ipyparallel", "ipywidgets", "matplotlib", "matplotlib (!=3.2.0)", "nbconvert", "nbformat", "notebook", "numpy (>=1.22)", "pandas", "pickleshare", "pytest (<7)", "pytest (<7.1)", "pytest-asyncio (<0.22)", "qtconsole", "setuptools (>=18.5)", "sphinx (>=1.3)", "sphinx-rtd-theme", "stack-data", "testpath", "trio", "typing-extensions"] -black = ["black"] -doc = ["docrepr", "exceptiongroup", "ipykernel", "matplotlib", "pickleshare", "pytest (<7)", "pytest (<7.1)", "pytest-asyncio (<0.22)", "setuptools (>=18.5)", "sphinx (>=1.3)", "sphinx-rtd-theme", "stack-data", "testpath", "typing-extensions"] -kernel = ["ipykernel"] -nbconvert = ["nbconvert"] -nbformat = ["nbformat"] -notebook = ["ipywidgets", "notebook"] -parallel = ["ipyparallel"] -qtconsole = ["qtconsole"] -test = ["pickleshare", "pytest (<7.1)", "pytest-asyncio (<0.22)", "testpath"] -test-extra = ["curio", "matplotlib (!=3.2.0)", "nbformat", "numpy (>=1.22)", "pandas", "pickleshare", "pytest (<7.1)", "pytest-asyncio (<0.22)", "testpath", "trio"] - -[[package]] -name = "ipywidgets" -version = "8.1.2" -description = "Jupyter interactive widgets" -optional = true -python-versions = ">=3.7" -files = [ - {file = "ipywidgets-8.1.2-py3-none-any.whl", hash = "sha256:bbe43850d79fb5e906b14801d6c01402857996864d1e5b6fa62dd2ee35559f60"}, - {file = "ipywidgets-8.1.2.tar.gz", hash = "sha256:d0b9b41e49bae926a866e613a39b0f0097745d2b9f1f3dd406641b4a57ec42c9"}, -] - -[package.dependencies] -comm = ">=0.1.3" -ipython = ">=6.1.0" -jupyterlab-widgets = ">=3.0.10,<3.1.0" -traitlets = ">=4.3.1" -widgetsnbextension = ">=4.0.10,<4.1.0" - -[package.extras] -test = ["ipykernel", "jsonschema", "pytest (>=3.6.0)", "pytest-cov", "pytz"] - -[[package]] -name = "isoduration" -version = "20.11.0" -description = "Operations with ISO 8601 durations" -optional = true -python-versions = ">=3.7" -files = [ - {file = "isoduration-20.11.0-py3-none-any.whl", hash = "sha256:b2904c2a4228c3d44f409c8ae8e2370eb21a26f7ac2ec5446df141dde3452042"}, - {file = "isoduration-20.11.0.tar.gz", hash = "sha256:ac2f9015137935279eac671f94f89eb00584f940f5dc49462a0c4ee692ba1bd9"}, -] - -[package.dependencies] -arrow = ">=0.15.0" - -[[package]] -name = "jedi" -version = "0.19.1" -description = "An autocompletion tool for Python that can be used for text editors." -optional = true -python-versions = ">=3.6" -files = [ - {file = "jedi-0.19.1-py2.py3-none-any.whl", hash = "sha256:e983c654fe5c02867aef4cdfce5a2fbb4a50adc0af145f70504238f18ef5e7e0"}, - {file = "jedi-0.19.1.tar.gz", hash = "sha256:cf0496f3651bc65d7174ac1b7d043eff454892c708a87d1b683e57b569927ffd"}, -] - -[package.dependencies] -parso = ">=0.8.3,<0.9.0" - -[package.extras] -docs = ["Jinja2 (==2.11.3)", "MarkupSafe (==1.1.1)", "Pygments (==2.8.1)", "alabaster (==0.7.12)", "babel (==2.9.1)", "chardet (==4.0.0)", "commonmark (==0.8.1)", "docutils (==0.17.1)", "future (==0.18.2)", "idna (==2.10)", "imagesize (==1.2.0)", "mock (==1.0.1)", "packaging (==20.9)", "pyparsing (==2.4.7)", "pytz (==2021.1)", "readthedocs-sphinx-ext (==2.1.4)", "recommonmark (==0.5.0)", "requests (==2.25.1)", "six (==1.15.0)", "snowballstemmer (==2.1.0)", "sphinx (==1.8.5)", "sphinx-rtd-theme (==0.4.3)", "sphinxcontrib-serializinghtml (==1.1.4)", "sphinxcontrib-websupport (==1.2.4)", "urllib3 (==1.26.4)"] -qa = ["flake8 (==5.0.4)", "mypy (==0.971)", "types-setuptools (==67.2.0.1)"] -testing = ["Django", "attrs", "colorama", "docopt", "pytest (<7.0.0)"] - -[[package]] -name = "jinja2" -version = "3.1.4" -description = "A very fast and expressive template engine." -optional = true -python-versions = ">=3.7" -files = [ - {file = "jinja2-3.1.4-py3-none-any.whl", hash = "sha256:bc5dd2abb727a5319567b7a813e6a2e7318c39f4f487cfe6c89c6f9c7d25197d"}, - {file = "jinja2-3.1.4.tar.gz", hash = "sha256:4a3aee7acbbe7303aede8e9648d13b8bf88a429282aa6122a993f0ac800cb369"}, -] - -[package.dependencies] -MarkupSafe = ">=2.0" - -[package.extras] -i18n = ["Babel (>=2.7)"] - -[[package]] -name = "json5" -version = "0.9.25" -description = "A Python implementation of the JSON5 data format." -optional = true -python-versions = ">=3.8" -files = [ - {file = "json5-0.9.25-py3-none-any.whl", hash = "sha256:34ed7d834b1341a86987ed52f3f76cd8ee184394906b6e22a1e0deb9ab294e8f"}, - {file = "json5-0.9.25.tar.gz", hash = "sha256:548e41b9be043f9426776f05df8635a00fe06104ea51ed24b67f908856e151ae"}, -] - -[[package]] -name = "jsonpointer" -version = "2.4" -description = "Identify specific nodes in a JSON document (RFC 6901)" -optional = true -python-versions = ">=2.7, !=3.0.*, !=3.1.*, !=3.2.*, !=3.3.*, !=3.4.*, !=3.5.*, !=3.6.*" -files = [ - {file = "jsonpointer-2.4-py2.py3-none-any.whl", hash = "sha256:15d51bba20eea3165644553647711d150376234112651b4f1811022aecad7d7a"}, - {file = "jsonpointer-2.4.tar.gz", hash = "sha256:585cee82b70211fa9e6043b7bb89db6e1aa49524340dde8ad6b63206ea689d88"}, -] - -[[package]] -name = "jsonschema" -version = "4.22.0" -description = "An implementation of JSON Schema validation for Python" -optional = true -python-versions = ">=3.8" -files = [ - {file = "jsonschema-4.22.0-py3-none-any.whl", hash = "sha256:ff4cfd6b1367a40e7bc6411caec72effadd3db0bbe5017de188f2d6108335802"}, - {file = "jsonschema-4.22.0.tar.gz", hash = "sha256:5b22d434a45935119af990552c862e5d6d564e8f6601206b305a61fdf661a2b7"}, -] - -[package.dependencies] -attrs = ">=22.2.0" -fqdn = {version = "*", optional = true, markers = "extra == \"format-nongpl\""} -idna = {version = "*", optional = true, markers = "extra == \"format-nongpl\""} -isoduration = {version = "*", optional = true, markers = "extra == \"format-nongpl\""} -jsonpointer = {version = ">1.13", optional = true, markers = "extra == \"format-nongpl\""} -jsonschema-specifications = ">=2023.03.6" -referencing = ">=0.28.4" -rfc3339-validator = {version = "*", optional = true, markers = "extra == \"format-nongpl\""} -rfc3986-validator = {version = ">0.1.0", optional = true, markers = "extra == \"format-nongpl\""} -rpds-py = ">=0.7.1" -uri-template = {version = "*", optional = true, markers = "extra == \"format-nongpl\""} -webcolors = {version = ">=1.11", optional = true, markers = "extra == \"format-nongpl\""} - -[package.extras] -format = ["fqdn", "idna", "isoduration", "jsonpointer (>1.13)", "rfc3339-validator", "rfc3987", "uri-template", "webcolors (>=1.11)"] -format-nongpl = ["fqdn", "idna", "isoduration", "jsonpointer (>1.13)", "rfc3339-validator", "rfc3986-validator (>0.1.0)", "uri-template", "webcolors (>=1.11)"] - -[[package]] -name = "jsonschema-specifications" -version = "2023.12.1" -description = "The JSON Schema meta-schemas and vocabularies, exposed as a Registry" -optional = true -python-versions = ">=3.8" -files = [ - {file = "jsonschema_specifications-2023.12.1-py3-none-any.whl", hash = "sha256:87e4fdf3a94858b8a2ba2778d9ba57d8a9cafca7c7489c46ba0d30a8bc6a9c3c"}, - {file = "jsonschema_specifications-2023.12.1.tar.gz", hash = "sha256:48a76787b3e70f5ed53f1160d2b81f586e4ca6d1548c5de7085d1682674764cc"}, -] - -[package.dependencies] -referencing = ">=0.31.0" - -[[package]] -name = "jupyter" -version = "1.0.0" -description = "Jupyter metapackage. Install all the Jupyter components in one go." -optional = true -python-versions = "*" -files = [ - {file = "jupyter-1.0.0-py2.py3-none-any.whl", hash = "sha256:5b290f93b98ffbc21c0c7e749f054b3267782166d72fa5e3ed1ed4eaf34a2b78"}, - {file = "jupyter-1.0.0.tar.gz", hash = "sha256:d9dc4b3318f310e34c82951ea5d6683f67bed7def4b259fafbfe4f1beb1d8e5f"}, - {file = "jupyter-1.0.0.zip", hash = "sha256:3e1f86076bbb7c8c207829390305a2b1fe836d471ed54be66a3b8c41e7f46cc7"}, -] - -[package.dependencies] -ipykernel = "*" -ipywidgets = "*" -jupyter-console = "*" -nbconvert = "*" -notebook = "*" -qtconsole = "*" - -[[package]] -name = "jupyter-client" -version = "8.6.1" -description = "Jupyter protocol implementation and client libraries" -optional = true -python-versions = ">=3.8" -files = [ - {file = "jupyter_client-8.6.1-py3-none-any.whl", hash = "sha256:3b7bd22f058434e3b9a7ea4b1500ed47de2713872288c0d511d19926f99b459f"}, - {file = "jupyter_client-8.6.1.tar.gz", hash = "sha256:e842515e2bab8e19186d89fdfea7abd15e39dd581f94e399f00e2af5a1652d3f"}, -] - -[package.dependencies] -importlib-metadata = {version = ">=4.8.3", markers = "python_version < \"3.10\""} -jupyter-core = ">=4.12,<5.0.dev0 || >=5.1.dev0" -python-dateutil = ">=2.8.2" -pyzmq = ">=23.0" -tornado = ">=6.2" -traitlets = ">=5.3" - -[package.extras] -docs = ["ipykernel", "myst-parser", "pydata-sphinx-theme", "sphinx (>=4)", "sphinx-autodoc-typehints", "sphinxcontrib-github-alt", "sphinxcontrib-spelling"] -test = ["coverage", "ipykernel (>=6.14)", "mypy", "paramiko", "pre-commit", "pytest", "pytest-cov", "pytest-jupyter[client] (>=0.4.1)", "pytest-timeout"] - -[[package]] -name = "jupyter-console" -version = "6.6.3" -description = "Jupyter terminal console" -optional = true -python-versions = ">=3.7" -files = [ - {file = "jupyter_console-6.6.3-py3-none-any.whl", hash = "sha256:309d33409fcc92ffdad25f0bcdf9a4a9daa61b6f341177570fdac03de5352485"}, - {file = "jupyter_console-6.6.3.tar.gz", hash = "sha256:566a4bf31c87adbfadf22cdf846e3069b59a71ed5da71d6ba4d8aaad14a53539"}, -] - -[package.dependencies] -ipykernel = ">=6.14" -ipython = "*" -jupyter-client = ">=7.0.0" -jupyter-core = ">=4.12,<5.0.dev0 || >=5.1.dev0" -prompt-toolkit = ">=3.0.30" -pygments = "*" -pyzmq = ">=17" -traitlets = ">=5.4" - -[package.extras] -test = ["flaky", "pexpect", "pytest"] - -[[package]] -name = "jupyter-core" -version = "5.7.2" -description = "Jupyter core package. A base package on which Jupyter projects rely." -optional = true -python-versions = ">=3.8" -files = [ - {file = "jupyter_core-5.7.2-py3-none-any.whl", hash = "sha256:4f7315d2f6b4bcf2e3e7cb6e46772eba760ae459cd1f59d29eb57b0a01bd7409"}, - {file = "jupyter_core-5.7.2.tar.gz", hash = "sha256:aa5f8d32bbf6b431ac830496da7392035d6f61b4f54872f15c4bd2a9c3f536d9"}, -] - -[package.dependencies] -platformdirs = ">=2.5" -pywin32 = {version = ">=300", markers = "sys_platform == \"win32\" and platform_python_implementation != \"PyPy\""} -traitlets = ">=5.3" - -[package.extras] -docs = ["myst-parser", "pydata-sphinx-theme", "sphinx-autodoc-typehints", "sphinxcontrib-github-alt", "sphinxcontrib-spelling", "traitlets"] -test = ["ipykernel", "pre-commit", "pytest (<8)", "pytest-cov", "pytest-timeout"] - -[[package]] -name = "jupyter-events" -version = "0.10.0" -description = "Jupyter Event System library" -optional = true -python-versions = ">=3.8" -files = [ - {file = "jupyter_events-0.10.0-py3-none-any.whl", hash = "sha256:4b72130875e59d57716d327ea70d3ebc3af1944d3717e5a498b8a06c6c159960"}, - {file = "jupyter_events-0.10.0.tar.gz", hash = "sha256:670b8229d3cc882ec782144ed22e0d29e1c2d639263f92ca8383e66682845e22"}, -] - -[package.dependencies] -jsonschema = {version = ">=4.18.0", extras = ["format-nongpl"]} -python-json-logger = ">=2.0.4" -pyyaml = ">=5.3" -referencing = "*" -rfc3339-validator = "*" -rfc3986-validator = ">=0.1.1" -traitlets = ">=5.3" - -[package.extras] -cli = ["click", "rich"] -docs = ["jupyterlite-sphinx", "myst-parser", "pydata-sphinx-theme", "sphinxcontrib-spelling"] -test = ["click", "pre-commit", "pytest (>=7.0)", "pytest-asyncio (>=0.19.0)", "pytest-console-scripts", "rich"] - -[[package]] -name = "jupyter-lsp" -version = "2.2.5" -description = "Multi-Language Server WebSocket proxy for Jupyter Notebook/Lab server" -optional = true -python-versions = ">=3.8" -files = [ - {file = "jupyter-lsp-2.2.5.tar.gz", hash = "sha256:793147a05ad446f809fd53ef1cd19a9f5256fd0a2d6b7ce943a982cb4f545001"}, - {file = "jupyter_lsp-2.2.5-py3-none-any.whl", hash = "sha256:45fbddbd505f3fbfb0b6cb2f1bc5e15e83ab7c79cd6e89416b248cb3c00c11da"}, -] - -[package.dependencies] -importlib-metadata = {version = ">=4.8.3", markers = "python_version < \"3.10\""} -jupyter-server = ">=1.1.2" - -[[package]] -name = "jupyter-server" -version = "2.14.0" -description = "The backend—i.e. core services, APIs, and REST endpoints—to Jupyter web applications." -optional = true -python-versions = ">=3.8" -files = [ - {file = "jupyter_server-2.14.0-py3-none-any.whl", hash = "sha256:fb6be52c713e80e004fac34b35a0990d6d36ba06fd0a2b2ed82b899143a64210"}, - {file = "jupyter_server-2.14.0.tar.gz", hash = "sha256:659154cea512083434fd7c93b7fe0897af7a2fd0b9dd4749282b42eaac4ae677"}, -] - -[package.dependencies] -anyio = ">=3.1.0" -argon2-cffi = ">=21.1" -jinja2 = ">=3.0.3" -jupyter-client = ">=7.4.4" -jupyter-core = ">=4.12,<5.0.dev0 || >=5.1.dev0" -jupyter-events = ">=0.9.0" -jupyter-server-terminals = ">=0.4.4" -nbconvert = ">=6.4.4" -nbformat = ">=5.3.0" -overrides = ">=5.0" -packaging = ">=22.0" -prometheus-client = ">=0.9" -pywinpty = {version = ">=2.0.1", markers = "os_name == \"nt\""} -pyzmq = ">=24" -send2trash = ">=1.8.2" -terminado = ">=0.8.3" -tornado = ">=6.2.0" -traitlets = ">=5.6.0" -websocket-client = ">=1.7" - -[package.extras] -docs = ["ipykernel", "jinja2", "jupyter-client", "jupyter-server", "myst-parser", "nbformat", "prometheus-client", "pydata-sphinx-theme", "send2trash", "sphinx-autodoc-typehints", "sphinxcontrib-github-alt", "sphinxcontrib-openapi (>=0.8.0)", "sphinxcontrib-spelling", "sphinxemoji", "tornado", "typing-extensions"] -test = ["flaky", "ipykernel", "pre-commit", "pytest (>=7.0,<9)", "pytest-console-scripts", "pytest-jupyter[server] (>=0.7)", "pytest-timeout", "requests"] - -[[package]] -name = "jupyter-server-terminals" -version = "0.5.3" -description = "A Jupyter Server Extension Providing Terminals." -optional = true -python-versions = ">=3.8" -files = [ - {file = "jupyter_server_terminals-0.5.3-py3-none-any.whl", hash = "sha256:41ee0d7dc0ebf2809c668e0fc726dfaf258fcd3e769568996ca731b6194ae9aa"}, - {file = "jupyter_server_terminals-0.5.3.tar.gz", hash = "sha256:5ae0295167220e9ace0edcfdb212afd2b01ee8d179fe6f23c899590e9b8a5269"}, -] - -[package.dependencies] -pywinpty = {version = ">=2.0.3", markers = "os_name == \"nt\""} -terminado = ">=0.8.3" - -[package.extras] -docs = ["jinja2", "jupyter-server", "mistune (<4.0)", "myst-parser", "nbformat", "packaging", "pydata-sphinx-theme", "sphinxcontrib-github-alt", "sphinxcontrib-openapi", "sphinxcontrib-spelling", "sphinxemoji", "tornado"] -test = ["jupyter-server (>=2.0.0)", "pytest (>=7.0)", "pytest-jupyter[server] (>=0.5.3)", "pytest-timeout"] - -[[package]] -name = "jupyterlab" -version = "4.2.0" -description = "JupyterLab computational environment" -optional = true -python-versions = ">=3.8" -files = [ - {file = "jupyterlab-4.2.0-py3-none-any.whl", hash = "sha256:0dfe9278e25a145362289c555d9beb505697d269c10e99909766af7c440ad3cc"}, - {file = "jupyterlab-4.2.0.tar.gz", hash = "sha256:356e9205a6a2ab689c47c8fe4919dba6c076e376d03f26baadc05748c2435dd5"}, -] - -[package.dependencies] -async-lru = ">=1.0.0" -httpx = ">=0.25.0" -importlib-metadata = {version = ">=4.8.3", markers = "python_version < \"3.10\""} -ipykernel = ">=6.5.0" -jinja2 = ">=3.0.3" -jupyter-core = "*" -jupyter-lsp = ">=2.0.0" -jupyter-server = ">=2.4.0,<3" -jupyterlab-server = ">=2.27.1,<3" -notebook-shim = ">=0.2" -packaging = "*" -tomli = {version = ">=1.2.2", markers = "python_version < \"3.11\""} -tornado = ">=6.2.0" -traitlets = "*" - -[package.extras] -dev = ["build", "bump2version", "coverage", "hatch", "pre-commit", "pytest-cov", "ruff (==0.3.5)"] -docs = ["jsx-lexer", "myst-parser", "pydata-sphinx-theme (>=0.13.0)", "pytest", "pytest-check-links", "pytest-jupyter", "sphinx (>=1.8,<7.3.0)", "sphinx-copybutton"] -docs-screenshots = ["altair (==5.3.0)", "ipython (==8.16.1)", "ipywidgets (==8.1.2)", "jupyterlab-geojson (==3.4.0)", "jupyterlab-language-pack-zh-cn (==4.1.post2)", "matplotlib (==3.8.3)", "nbconvert (>=7.0.0)", "pandas (==2.2.1)", "scipy (==1.12.0)", "vega-datasets (==0.9.0)"] -test = ["coverage", "pytest (>=7.0)", "pytest-check-links (>=0.7)", "pytest-console-scripts", "pytest-cov", "pytest-jupyter (>=0.5.3)", "pytest-timeout", "pytest-tornasync", "requests", "requests-cache", "virtualenv"] -upgrade-extension = ["copier (>=8,<10)", "jinja2-time (<0.3)", "pydantic (<2.0)", "pyyaml-include (<2.0)", "tomli-w (<2.0)"] - -[[package]] -name = "jupyterlab-pygments" -version = "0.3.0" -description = "Pygments theme using JupyterLab CSS variables" -optional = true -python-versions = ">=3.8" -files = [ - {file = "jupyterlab_pygments-0.3.0-py3-none-any.whl", hash = "sha256:841a89020971da1d8693f1a99997aefc5dc424bb1b251fd6322462a1b8842780"}, - {file = "jupyterlab_pygments-0.3.0.tar.gz", hash = "sha256:721aca4d9029252b11cfa9d185e5b5af4d54772bb8072f9b7036f4170054d35d"}, -] - -[[package]] -name = "jupyterlab-server" -version = "2.27.1" -description = "A set of server components for JupyterLab and JupyterLab like applications." -optional = true -python-versions = ">=3.8" -files = [ - {file = "jupyterlab_server-2.27.1-py3-none-any.whl", hash = "sha256:f5e26156e5258b24d532c84e7c74cc212e203bff93eb856f81c24c16daeecc75"}, - {file = "jupyterlab_server-2.27.1.tar.gz", hash = "sha256:097b5ac709b676c7284ac9c5e373f11930a561f52cd5a86e4fc7e5a9c8a8631d"}, -] - -[package.dependencies] -babel = ">=2.10" -importlib-metadata = {version = ">=4.8.3", markers = "python_version < \"3.10\""} -jinja2 = ">=3.0.3" -json5 = ">=0.9.0" -jsonschema = ">=4.18.0" -jupyter-server = ">=1.21,<3" -packaging = ">=21.3" -requests = ">=2.31" - -[package.extras] -docs = ["autodoc-traits", "jinja2 (<3.2.0)", "mistune (<4)", "myst-parser", "pydata-sphinx-theme", "sphinx", "sphinx-copybutton", "sphinxcontrib-openapi (>0.8)"] -openapi = ["openapi-core (>=0.18.0,<0.19.0)", "ruamel-yaml"] -test = ["hatch", "ipykernel", "openapi-core (>=0.18.0,<0.19.0)", "openapi-spec-validator (>=0.6.0,<0.8.0)", "pytest (>=7.0,<8)", "pytest-console-scripts", "pytest-cov", "pytest-jupyter[server] (>=0.6.2)", "pytest-timeout", "requests-mock", "ruamel-yaml", "sphinxcontrib-spelling", "strict-rfc3339", "werkzeug"] - -[[package]] -name = "jupyterlab-widgets" -version = "3.0.10" -description = "Jupyter interactive widgets for JupyterLab" -optional = true -python-versions = ">=3.7" -files = [ - {file = "jupyterlab_widgets-3.0.10-py3-none-any.whl", hash = "sha256:dd61f3ae7a5a7f80299e14585ce6cf3d6925a96c9103c978eda293197730cb64"}, - {file = "jupyterlab_widgets-3.0.10.tar.gz", hash = "sha256:04f2ac04976727e4f9d0fa91cdc2f1ab860f965e504c29dbd6a65c882c9d04c0"}, -] - -[[package]] -name = "kiwisolver" -version = "1.4.5" -description = "A fast implementation of the Cassowary constraint solver" -optional = true -python-versions = ">=3.7" -files = [ - {file = "kiwisolver-1.4.5-cp310-cp310-macosx_10_9_universal2.whl", hash = "sha256:05703cf211d585109fcd72207a31bb170a0f22144d68298dc5e61b3c946518af"}, - {file = "kiwisolver-1.4.5-cp310-cp310-macosx_10_9_x86_64.whl", hash = "sha256:146d14bebb7f1dc4d5fbf74f8a6cb15ac42baadee8912eb84ac0b3b2a3dc6ac3"}, - {file = "kiwisolver-1.4.5-cp310-cp310-macosx_11_0_arm64.whl", hash = "sha256:6ef7afcd2d281494c0a9101d5c571970708ad911d028137cd558f02b851c08b4"}, - {file = "kiwisolver-1.4.5-cp310-cp310-manylinux_2_12_i686.manylinux2010_i686.whl", hash = "sha256:9eaa8b117dc8337728e834b9c6e2611f10c79e38f65157c4c38e9400286f5cb1"}, - {file = "kiwisolver-1.4.5-cp310-cp310-manylinux_2_12_x86_64.manylinux2010_x86_64.whl", hash = "sha256:ec20916e7b4cbfb1f12380e46486ec4bcbaa91a9c448b97023fde0d5bbf9e4ff"}, - {file = "kiwisolver-1.4.5-cp310-cp310-manylinux_2_17_aarch64.manylinux2014_aarch64.whl", hash = "sha256:39b42c68602539407884cf70d6a480a469b93b81b7701378ba5e2328660c847a"}, - {file = "kiwisolver-1.4.5-cp310-cp310-manylinux_2_17_ppc64le.manylinux2014_ppc64le.whl", hash = "sha256:aa12042de0171fad672b6c59df69106d20d5596e4f87b5e8f76df757a7c399aa"}, - {file = "kiwisolver-1.4.5-cp310-cp310-manylinux_2_17_s390x.manylinux2014_s390x.whl", hash = "sha256:2a40773c71d7ccdd3798f6489aaac9eee213d566850a9533f8d26332d626b82c"}, - {file = "kiwisolver-1.4.5-cp310-cp310-musllinux_1_1_aarch64.whl", hash = "sha256:19df6e621f6d8b4b9c4d45f40a66839294ff2bb235e64d2178f7522d9170ac5b"}, - {file = "kiwisolver-1.4.5-cp310-cp310-musllinux_1_1_i686.whl", hash = "sha256:83d78376d0d4fd884e2c114d0621624b73d2aba4e2788182d286309ebdeed770"}, - {file = "kiwisolver-1.4.5-cp310-cp310-musllinux_1_1_ppc64le.whl", hash = "sha256:e391b1f0a8a5a10ab3b9bb6afcfd74f2175f24f8975fb87ecae700d1503cdee0"}, - {file = "kiwisolver-1.4.5-cp310-cp310-musllinux_1_1_s390x.whl", hash = "sha256:852542f9481f4a62dbb5dd99e8ab7aedfeb8fb6342349a181d4036877410f525"}, - {file = "kiwisolver-1.4.5-cp310-cp310-musllinux_1_1_x86_64.whl", hash = "sha256:59edc41b24031bc25108e210c0def6f6c2191210492a972d585a06ff246bb79b"}, - {file = "kiwisolver-1.4.5-cp310-cp310-win32.whl", hash = "sha256:a6aa6315319a052b4ee378aa171959c898a6183f15c1e541821c5c59beaa0238"}, - {file = "kiwisolver-1.4.5-cp310-cp310-win_amd64.whl", hash = "sha256:d0ef46024e6a3d79c01ff13801cb19d0cad7fd859b15037aec74315540acc276"}, - {file = "kiwisolver-1.4.5-cp311-cp311-macosx_10_9_universal2.whl", hash = "sha256:11863aa14a51fd6ec28688d76f1735f8f69ab1fabf388851a595d0721af042f5"}, - {file = "kiwisolver-1.4.5-cp311-cp311-macosx_10_9_x86_64.whl", hash = "sha256:8ab3919a9997ab7ef2fbbed0cc99bb28d3c13e6d4b1ad36e97e482558a91be90"}, - {file = "kiwisolver-1.4.5-cp311-cp311-macosx_11_0_arm64.whl", hash = "sha256:fcc700eadbbccbf6bc1bcb9dbe0786b4b1cb91ca0dcda336eef5c2beed37b797"}, - {file = "kiwisolver-1.4.5-cp311-cp311-manylinux_2_12_i686.manylinux2010_i686.manylinux_2_17_i686.manylinux2014_i686.whl", hash = "sha256:dfdd7c0b105af050eb3d64997809dc21da247cf44e63dc73ff0fd20b96be55a9"}, - {file = "kiwisolver-1.4.5-cp311-cp311-manylinux_2_17_aarch64.manylinux2014_aarch64.whl", hash = "sha256:76c6a5964640638cdeaa0c359382e5703e9293030fe730018ca06bc2010c4437"}, - {file = "kiwisolver-1.4.5-cp311-cp311-manylinux_2_17_ppc64le.manylinux2014_ppc64le.whl", hash = "sha256:bbea0db94288e29afcc4c28afbf3a7ccaf2d7e027489c449cf7e8f83c6346eb9"}, - {file = "kiwisolver-1.4.5-cp311-cp311-manylinux_2_17_s390x.manylinux2014_s390x.whl", hash = "sha256:ceec1a6bc6cab1d6ff5d06592a91a692f90ec7505d6463a88a52cc0eb58545da"}, - {file = "kiwisolver-1.4.5-cp311-cp311-manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:040c1aebeda72197ef477a906782b5ab0d387642e93bda547336b8957c61022e"}, - {file = "kiwisolver-1.4.5-cp311-cp311-musllinux_1_1_aarch64.whl", hash = "sha256:f91de7223d4c7b793867797bacd1ee53bfe7359bd70d27b7b58a04efbb9436c8"}, - {file = "kiwisolver-1.4.5-cp311-cp311-musllinux_1_1_i686.whl", hash = "sha256:faae4860798c31530dd184046a900e652c95513796ef51a12bc086710c2eec4d"}, - {file = "kiwisolver-1.4.5-cp311-cp311-musllinux_1_1_ppc64le.whl", hash = "sha256:b0157420efcb803e71d1b28e2c287518b8808b7cf1ab8af36718fd0a2c453eb0"}, - {file = "kiwisolver-1.4.5-cp311-cp311-musllinux_1_1_s390x.whl", hash = "sha256:06f54715b7737c2fecdbf140d1afb11a33d59508a47bf11bb38ecf21dc9ab79f"}, - {file = "kiwisolver-1.4.5-cp311-cp311-musllinux_1_1_x86_64.whl", hash = "sha256:fdb7adb641a0d13bdcd4ef48e062363d8a9ad4a182ac7647ec88f695e719ae9f"}, - {file = "kiwisolver-1.4.5-cp311-cp311-win32.whl", hash = "sha256:bb86433b1cfe686da83ce32a9d3a8dd308e85c76b60896d58f082136f10bffac"}, - {file = "kiwisolver-1.4.5-cp311-cp311-win_amd64.whl", hash = "sha256:6c08e1312a9cf1074d17b17728d3dfce2a5125b2d791527f33ffbe805200a355"}, - {file = "kiwisolver-1.4.5-cp312-cp312-macosx_10_9_universal2.whl", hash = "sha256:32d5cf40c4f7c7b3ca500f8985eb3fb3a7dfc023215e876f207956b5ea26632a"}, - {file = "kiwisolver-1.4.5-cp312-cp312-macosx_10_9_x86_64.whl", hash = "sha256:f846c260f483d1fd217fe5ed7c173fb109efa6b1fc8381c8b7552c5781756192"}, - {file = "kiwisolver-1.4.5-cp312-cp312-macosx_11_0_arm64.whl", hash = "sha256:5ff5cf3571589b6d13bfbfd6bcd7a3f659e42f96b5fd1c4830c4cf21d4f5ef45"}, - {file = "kiwisolver-1.4.5-cp312-cp312-manylinux_2_12_i686.manylinux2010_i686.manylinux_2_17_i686.manylinux2014_i686.whl", hash = "sha256:7269d9e5f1084a653d575c7ec012ff57f0c042258bf5db0954bf551c158466e7"}, - {file = "kiwisolver-1.4.5-cp312-cp312-manylinux_2_17_aarch64.manylinux2014_aarch64.whl", hash = "sha256:da802a19d6e15dffe4b0c24b38b3af68e6c1a68e6e1d8f30148c83864f3881db"}, - {file = "kiwisolver-1.4.5-cp312-cp312-manylinux_2_17_ppc64le.manylinux2014_ppc64le.whl", hash = "sha256:3aba7311af82e335dd1e36ffff68aaca609ca6290c2cb6d821a39aa075d8e3ff"}, - {file = "kiwisolver-1.4.5-cp312-cp312-manylinux_2_17_s390x.manylinux2014_s390x.whl", hash = "sha256:763773d53f07244148ccac5b084da5adb90bfaee39c197554f01b286cf869228"}, - {file = "kiwisolver-1.4.5-cp312-cp312-manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:2270953c0d8cdab5d422bee7d2007f043473f9d2999631c86a223c9db56cbd16"}, - {file = "kiwisolver-1.4.5-cp312-cp312-musllinux_1_1_aarch64.whl", hash = "sha256:d099e745a512f7e3bbe7249ca835f4d357c586d78d79ae8f1dcd4d8adeb9bda9"}, - {file = "kiwisolver-1.4.5-cp312-cp312-musllinux_1_1_i686.whl", hash = "sha256:74db36e14a7d1ce0986fa104f7d5637aea5c82ca6326ed0ec5694280942d1162"}, - {file = "kiwisolver-1.4.5-cp312-cp312-musllinux_1_1_ppc64le.whl", hash = "sha256:7e5bab140c309cb3a6ce373a9e71eb7e4873c70c2dda01df6820474f9889d6d4"}, - {file = "kiwisolver-1.4.5-cp312-cp312-musllinux_1_1_s390x.whl", hash = "sha256:0f114aa76dc1b8f636d077979c0ac22e7cd8f3493abbab152f20eb8d3cda71f3"}, - {file = "kiwisolver-1.4.5-cp312-cp312-musllinux_1_1_x86_64.whl", hash = "sha256:88a2df29d4724b9237fc0c6eaf2a1adae0cdc0b3e9f4d8e7dc54b16812d2d81a"}, - {file = "kiwisolver-1.4.5-cp312-cp312-win32.whl", hash = "sha256:72d40b33e834371fd330fb1472ca19d9b8327acb79a5821d4008391db8e29f20"}, - {file = "kiwisolver-1.4.5-cp312-cp312-win_amd64.whl", hash = "sha256:2c5674c4e74d939b9d91dda0fae10597ac7521768fec9e399c70a1f27e2ea2d9"}, - {file = "kiwisolver-1.4.5-cp37-cp37m-macosx_10_9_x86_64.whl", hash = "sha256:3a2b053a0ab7a3960c98725cfb0bf5b48ba82f64ec95fe06f1d06c99b552e130"}, - {file = "kiwisolver-1.4.5-cp37-cp37m-manylinux_2_17_aarch64.manylinux2014_aarch64.whl", hash = "sha256:3cd32d6c13807e5c66a7cbb79f90b553642f296ae4518a60d8d76243b0ad2898"}, - {file = "kiwisolver-1.4.5-cp37-cp37m-manylinux_2_17_ppc64le.manylinux2014_ppc64le.whl", hash = "sha256:59ec7b7c7e1a61061850d53aaf8e93db63dce0c936db1fda2658b70e4a1be709"}, - {file = "kiwisolver-1.4.5-cp37-cp37m-manylinux_2_17_s390x.manylinux2014_s390x.whl", hash = "sha256:da4cfb373035def307905d05041c1d06d8936452fe89d464743ae7fb8371078b"}, - {file = "kiwisolver-1.4.5-cp37-cp37m-manylinux_2_5_i686.manylinux1_i686.whl", hash = "sha256:2400873bccc260b6ae184b2b8a4fec0e4082d30648eadb7c3d9a13405d861e89"}, - {file = "kiwisolver-1.4.5-cp37-cp37m-manylinux_2_5_x86_64.manylinux1_x86_64.whl", hash = "sha256:1b04139c4236a0f3aff534479b58f6f849a8b351e1314826c2d230849ed48985"}, - {file = "kiwisolver-1.4.5-cp37-cp37m-musllinux_1_1_aarch64.whl", hash = "sha256:4e66e81a5779b65ac21764c295087de82235597a2293d18d943f8e9e32746265"}, - {file = "kiwisolver-1.4.5-cp37-cp37m-musllinux_1_1_i686.whl", hash = "sha256:7931d8f1f67c4be9ba1dd9c451fb0eeca1a25b89e4d3f89e828fe12a519b782a"}, - {file = "kiwisolver-1.4.5-cp37-cp37m-musllinux_1_1_ppc64le.whl", hash = "sha256:b3f7e75f3015df442238cca659f8baa5f42ce2a8582727981cbfa15fee0ee205"}, - {file = "kiwisolver-1.4.5-cp37-cp37m-musllinux_1_1_s390x.whl", hash = "sha256:bbf1d63eef84b2e8c89011b7f2235b1e0bf7dacc11cac9431fc6468e99ac77fb"}, - {file = "kiwisolver-1.4.5-cp37-cp37m-musllinux_1_1_x86_64.whl", hash = "sha256:4c380469bd3f970ef677bf2bcba2b6b0b4d5c75e7a020fb863ef75084efad66f"}, - {file = "kiwisolver-1.4.5-cp37-cp37m-win32.whl", hash = "sha256:9408acf3270c4b6baad483865191e3e582b638b1654a007c62e3efe96f09a9a3"}, - {file = "kiwisolver-1.4.5-cp37-cp37m-win_amd64.whl", hash = "sha256:5b94529f9b2591b7af5f3e0e730a4e0a41ea174af35a4fd067775f9bdfeee01a"}, - {file = "kiwisolver-1.4.5-cp38-cp38-macosx_10_9_universal2.whl", hash = "sha256:11c7de8f692fc99816e8ac50d1d1aef4f75126eefc33ac79aac02c099fd3db71"}, - {file = "kiwisolver-1.4.5-cp38-cp38-macosx_10_9_x86_64.whl", hash = "sha256:53abb58632235cd154176ced1ae8f0d29a6657aa1aa9decf50b899b755bc2b93"}, - {file = "kiwisolver-1.4.5-cp38-cp38-macosx_11_0_arm64.whl", hash = "sha256:88b9f257ca61b838b6f8094a62418421f87ac2a1069f7e896c36a7d86b5d4c29"}, - {file = "kiwisolver-1.4.5-cp38-cp38-manylinux_2_17_aarch64.manylinux2014_aarch64.whl", hash = "sha256:3195782b26fc03aa9c6913d5bad5aeb864bdc372924c093b0f1cebad603dd712"}, - {file = "kiwisolver-1.4.5-cp38-cp38-manylinux_2_17_ppc64le.manylinux2014_ppc64le.whl", hash = "sha256:fc579bf0f502e54926519451b920e875f433aceb4624a3646b3252b5caa9e0b6"}, - {file = "kiwisolver-1.4.5-cp38-cp38-manylinux_2_17_s390x.manylinux2014_s390x.whl", hash = "sha256:5a580c91d686376f0f7c295357595c5a026e6cbc3d77b7c36e290201e7c11ecb"}, - {file = "kiwisolver-1.4.5-cp38-cp38-manylinux_2_5_i686.manylinux1_i686.whl", hash = "sha256:cfe6ab8da05c01ba6fbea630377b5da2cd9bcbc6338510116b01c1bc939a2c18"}, - {file = "kiwisolver-1.4.5-cp38-cp38-manylinux_2_5_x86_64.manylinux1_x86_64.whl", hash = "sha256:d2e5a98f0ec99beb3c10e13b387f8db39106d53993f498b295f0c914328b1333"}, - {file = "kiwisolver-1.4.5-cp38-cp38-musllinux_1_1_aarch64.whl", hash = "sha256:a51a263952b1429e429ff236d2f5a21c5125437861baeed77f5e1cc2d2c7c6da"}, - {file = "kiwisolver-1.4.5-cp38-cp38-musllinux_1_1_i686.whl", hash = "sha256:3edd2fa14e68c9be82c5b16689e8d63d89fe927e56debd6e1dbce7a26a17f81b"}, - {file = "kiwisolver-1.4.5-cp38-cp38-musllinux_1_1_ppc64le.whl", hash = "sha256:74d1b44c6cfc897df648cc9fdaa09bc3e7679926e6f96df05775d4fb3946571c"}, - {file = "kiwisolver-1.4.5-cp38-cp38-musllinux_1_1_s390x.whl", hash = "sha256:76d9289ed3f7501012e05abb8358bbb129149dbd173f1f57a1bf1c22d19ab7cc"}, - {file = "kiwisolver-1.4.5-cp38-cp38-musllinux_1_1_x86_64.whl", hash = "sha256:92dea1ffe3714fa8eb6a314d2b3c773208d865a0e0d35e713ec54eea08a66250"}, - {file = "kiwisolver-1.4.5-cp38-cp38-win32.whl", hash = "sha256:5c90ae8c8d32e472be041e76f9d2f2dbff4d0b0be8bd4041770eddb18cf49a4e"}, - {file = "kiwisolver-1.4.5-cp38-cp38-win_amd64.whl", hash = "sha256:c7940c1dc63eb37a67721b10d703247552416f719c4188c54e04334321351ced"}, - {file = "kiwisolver-1.4.5-cp39-cp39-macosx_10_9_universal2.whl", hash = "sha256:9407b6a5f0d675e8a827ad8742e1d6b49d9c1a1da5d952a67d50ef5f4170b18d"}, - {file = "kiwisolver-1.4.5-cp39-cp39-macosx_10_9_x86_64.whl", hash = "sha256:15568384086b6df3c65353820a4473575dbad192e35010f622c6ce3eebd57af9"}, - {file = "kiwisolver-1.4.5-cp39-cp39-macosx_11_0_arm64.whl", hash = "sha256:0dc9db8e79f0036e8173c466d21ef18e1befc02de8bf8aa8dc0813a6dc8a7046"}, - {file = "kiwisolver-1.4.5-cp39-cp39-manylinux_2_12_i686.manylinux2010_i686.whl", hash = "sha256:cdc8a402aaee9a798b50d8b827d7ecf75edc5fb35ea0f91f213ff927c15f4ff0"}, - {file = "kiwisolver-1.4.5-cp39-cp39-manylinux_2_12_x86_64.manylinux2010_x86_64.whl", hash = "sha256:6c3bd3cde54cafb87d74d8db50b909705c62b17c2099b8f2e25b461882e544ff"}, - {file = "kiwisolver-1.4.5-cp39-cp39-manylinux_2_17_aarch64.manylinux2014_aarch64.whl", hash = "sha256:955e8513d07a283056b1396e9a57ceddbd272d9252c14f154d450d227606eb54"}, - {file = "kiwisolver-1.4.5-cp39-cp39-manylinux_2_17_ppc64le.manylinux2014_ppc64le.whl", hash = "sha256:346f5343b9e3f00b8db8ba359350eb124b98c99efd0b408728ac6ebf38173958"}, - {file = "kiwisolver-1.4.5-cp39-cp39-manylinux_2_17_s390x.manylinux2014_s390x.whl", hash = "sha256:b9098e0049e88c6a24ff64545cdfc50807818ba6c1b739cae221bbbcbc58aad3"}, - {file = "kiwisolver-1.4.5-cp39-cp39-musllinux_1_1_aarch64.whl", hash = "sha256:00bd361b903dc4bbf4eb165f24d1acbee754fce22ded24c3d56eec268658a5cf"}, - {file = "kiwisolver-1.4.5-cp39-cp39-musllinux_1_1_i686.whl", hash = "sha256:7b8b454bac16428b22560d0a1cf0a09875339cab69df61d7805bf48919415901"}, - {file = "kiwisolver-1.4.5-cp39-cp39-musllinux_1_1_ppc64le.whl", hash = "sha256:f1d072c2eb0ad60d4c183f3fb44ac6f73fb7a8f16a2694a91f988275cbf352f9"}, - {file = "kiwisolver-1.4.5-cp39-cp39-musllinux_1_1_s390x.whl", hash = "sha256:31a82d498054cac9f6d0b53d02bb85811185bcb477d4b60144f915f3b3126342"}, - {file = "kiwisolver-1.4.5-cp39-cp39-musllinux_1_1_x86_64.whl", hash = "sha256:6512cb89e334e4700febbffaaa52761b65b4f5a3cf33f960213d5656cea36a77"}, - {file = "kiwisolver-1.4.5-cp39-cp39-win32.whl", hash = "sha256:9db8ea4c388fdb0f780fe91346fd438657ea602d58348753d9fb265ce1bca67f"}, - {file = "kiwisolver-1.4.5-cp39-cp39-win_amd64.whl", hash = "sha256:59415f46a37f7f2efeec758353dd2eae1b07640d8ca0f0c42548ec4125492635"}, - {file = "kiwisolver-1.4.5-pp37-pypy37_pp73-macosx_10_9_x86_64.whl", hash = "sha256:5c7b3b3a728dc6faf3fc372ef24f21d1e3cee2ac3e9596691d746e5a536de920"}, - {file = "kiwisolver-1.4.5-pp37-pypy37_pp73-manylinux_2_12_i686.manylinux2010_i686.whl", hash = "sha256:620ced262a86244e2be10a676b646f29c34537d0d9cc8eb26c08f53d98013390"}, - {file = "kiwisolver-1.4.5-pp37-pypy37_pp73-manylinux_2_12_x86_64.manylinux2010_x86_64.whl", hash = "sha256:378a214a1e3bbf5ac4a8708304318b4f890da88c9e6a07699c4ae7174c09a68d"}, - {file = "kiwisolver-1.4.5-pp37-pypy37_pp73-manylinux_2_17_aarch64.manylinux2014_aarch64.whl", hash = "sha256:aaf7be1207676ac608a50cd08f102f6742dbfc70e8d60c4db1c6897f62f71523"}, - {file = "kiwisolver-1.4.5-pp37-pypy37_pp73-win_amd64.whl", hash = "sha256:ba55dce0a9b8ff59495ddd050a0225d58bd0983d09f87cfe2b6aec4f2c1234e4"}, - {file = "kiwisolver-1.4.5-pp38-pypy38_pp73-macosx_10_9_x86_64.whl", hash = "sha256:fd32ea360bcbb92d28933fc05ed09bffcb1704ba3fc7942e81db0fd4f81a7892"}, - {file = "kiwisolver-1.4.5-pp38-pypy38_pp73-manylinux_2_12_i686.manylinux2010_i686.whl", hash = "sha256:5e7139af55d1688f8b960ee9ad5adafc4ac17c1c473fe07133ac092310d76544"}, - {file = "kiwisolver-1.4.5-pp38-pypy38_pp73-manylinux_2_12_x86_64.manylinux2010_x86_64.whl", hash = "sha256:dced8146011d2bc2e883f9bd68618b8247387f4bbec46d7392b3c3b032640126"}, - {file = "kiwisolver-1.4.5-pp38-pypy38_pp73-manylinux_2_17_aarch64.manylinux2014_aarch64.whl", hash = "sha256:c9bf3325c47b11b2e51bca0824ea217c7cd84491d8ac4eefd1e409705ef092bd"}, - {file = "kiwisolver-1.4.5-pp38-pypy38_pp73-win_amd64.whl", hash = "sha256:5794cf59533bc3f1b1c821f7206a3617999db9fbefc345360aafe2e067514929"}, - {file = "kiwisolver-1.4.5-pp39-pypy39_pp73-macosx_10_9_x86_64.whl", hash = "sha256:e368f200bbc2e4f905b8e71eb38b3c04333bddaa6a2464a6355487b02bb7fb09"}, - {file = "kiwisolver-1.4.5-pp39-pypy39_pp73-manylinux_2_12_i686.manylinux2010_i686.manylinux_2_17_i686.manylinux2014_i686.whl", hash = "sha256:e5d706eba36b4c4d5bc6c6377bb6568098765e990cfc21ee16d13963fab7b3e7"}, - {file = "kiwisolver-1.4.5-pp39-pypy39_pp73-manylinux_2_17_aarch64.manylinux2014_aarch64.whl", hash = "sha256:85267bd1aa8880a9c88a8cb71e18d3d64d2751a790e6ca6c27b8ccc724bcd5ad"}, - {file = "kiwisolver-1.4.5-pp39-pypy39_pp73-manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:210ef2c3a1f03272649aff1ef992df2e724748918c4bc2d5a90352849eb40bea"}, - {file = "kiwisolver-1.4.5-pp39-pypy39_pp73-win_amd64.whl", hash = "sha256:11d011a7574eb3b82bcc9c1a1d35c1d7075677fdd15de527d91b46bd35e935ee"}, - {file = "kiwisolver-1.4.5.tar.gz", hash = "sha256:e57e563a57fb22a142da34f38acc2fc1a5c864bc29ca1517a88abc963e60d6ec"}, -] - -[[package]] -name = "markupsafe" -version = "2.1.5" -description = "Safely add untrusted strings to HTML/XML markup." -optional = true -python-versions = ">=3.7" -files = [ - {file = "MarkupSafe-2.1.5-cp310-cp310-macosx_10_9_universal2.whl", hash = "sha256:a17a92de5231666cfbe003f0e4b9b3a7ae3afb1ec2845aadc2bacc93ff85febc"}, - {file = "MarkupSafe-2.1.5-cp310-cp310-macosx_10_9_x86_64.whl", hash = "sha256:72b6be590cc35924b02c78ef34b467da4ba07e4e0f0454a2c5907f473fc50ce5"}, - {file = "MarkupSafe-2.1.5-cp310-cp310-manylinux_2_17_aarch64.manylinux2014_aarch64.whl", hash = "sha256:e61659ba32cf2cf1481e575d0462554625196a1f2fc06a1c777d3f48e8865d46"}, - {file = "MarkupSafe-2.1.5-cp310-cp310-manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:2174c595a0d73a3080ca3257b40096db99799265e1c27cc5a610743acd86d62f"}, - {file = "MarkupSafe-2.1.5-cp310-cp310-manylinux_2_5_i686.manylinux1_i686.manylinux_2_17_i686.manylinux2014_i686.whl", hash = "sha256:ae2ad8ae6ebee9d2d94b17fb62763125f3f374c25618198f40cbb8b525411900"}, - {file = "MarkupSafe-2.1.5-cp310-cp310-musllinux_1_1_aarch64.whl", hash = "sha256:075202fa5b72c86ad32dc7d0b56024ebdbcf2048c0ba09f1cde31bfdd57bcfff"}, - {file = "MarkupSafe-2.1.5-cp310-cp310-musllinux_1_1_i686.whl", hash = "sha256:598e3276b64aff0e7b3451b72e94fa3c238d452e7ddcd893c3ab324717456bad"}, - {file = "MarkupSafe-2.1.5-cp310-cp310-musllinux_1_1_x86_64.whl", hash = "sha256:fce659a462a1be54d2ffcacea5e3ba2d74daa74f30f5f143fe0c58636e355fdd"}, - {file = "MarkupSafe-2.1.5-cp310-cp310-win32.whl", hash = "sha256:d9fad5155d72433c921b782e58892377c44bd6252b5af2f67f16b194987338a4"}, - {file = "MarkupSafe-2.1.5-cp310-cp310-win_amd64.whl", hash = "sha256:bf50cd79a75d181c9181df03572cdce0fbb75cc353bc350712073108cba98de5"}, - {file = "MarkupSafe-2.1.5-cp311-cp311-macosx_10_9_universal2.whl", hash = "sha256:629ddd2ca402ae6dbedfceeba9c46d5f7b2a61d9749597d4307f943ef198fc1f"}, - {file = "MarkupSafe-2.1.5-cp311-cp311-macosx_10_9_x86_64.whl", hash = "sha256:5b7b716f97b52c5a14bffdf688f971b2d5ef4029127f1ad7a513973cfd818df2"}, - {file = "MarkupSafe-2.1.5-cp311-cp311-manylinux_2_17_aarch64.manylinux2014_aarch64.whl", hash = "sha256:6ec585f69cec0aa07d945b20805be741395e28ac1627333b1c5b0105962ffced"}, - {file = "MarkupSafe-2.1.5-cp311-cp311-manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:b91c037585eba9095565a3556f611e3cbfaa42ca1e865f7b8015fe5c7336d5a5"}, - {file = "MarkupSafe-2.1.5-cp311-cp311-manylinux_2_5_i686.manylinux1_i686.manylinux_2_17_i686.manylinux2014_i686.whl", hash = "sha256:7502934a33b54030eaf1194c21c692a534196063db72176b0c4028e140f8f32c"}, - {file = "MarkupSafe-2.1.5-cp311-cp311-musllinux_1_1_aarch64.whl", hash = "sha256:0e397ac966fdf721b2c528cf028494e86172b4feba51d65f81ffd65c63798f3f"}, - {file = "MarkupSafe-2.1.5-cp311-cp311-musllinux_1_1_i686.whl", hash = "sha256:c061bb86a71b42465156a3ee7bd58c8c2ceacdbeb95d05a99893e08b8467359a"}, - {file = "MarkupSafe-2.1.5-cp311-cp311-musllinux_1_1_x86_64.whl", hash = "sha256:3a57fdd7ce31c7ff06cdfbf31dafa96cc533c21e443d57f5b1ecc6cdc668ec7f"}, - {file = "MarkupSafe-2.1.5-cp311-cp311-win32.whl", hash = "sha256:397081c1a0bfb5124355710fe79478cdbeb39626492b15d399526ae53422b906"}, - {file = "MarkupSafe-2.1.5-cp311-cp311-win_amd64.whl", hash = "sha256:2b7c57a4dfc4f16f7142221afe5ba4e093e09e728ca65c51f5620c9aaeb9a617"}, - {file = "MarkupSafe-2.1.5-cp312-cp312-macosx_10_9_universal2.whl", hash = "sha256:8dec4936e9c3100156f8a2dc89c4b88d5c435175ff03413b443469c7c8c5f4d1"}, - {file = "MarkupSafe-2.1.5-cp312-cp312-macosx_10_9_x86_64.whl", hash = "sha256:3c6b973f22eb18a789b1460b4b91bf04ae3f0c4234a0a6aa6b0a92f6f7b951d4"}, - {file = "MarkupSafe-2.1.5-cp312-cp312-manylinux_2_17_aarch64.manylinux2014_aarch64.whl", hash = "sha256:ac07bad82163452a6884fe8fa0963fb98c2346ba78d779ec06bd7a6262132aee"}, - {file = "MarkupSafe-2.1.5-cp312-cp312-manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:f5dfb42c4604dddc8e4305050aa6deb084540643ed5804d7455b5df8fe16f5e5"}, - {file = "MarkupSafe-2.1.5-cp312-cp312-manylinux_2_5_i686.manylinux1_i686.manylinux_2_17_i686.manylinux2014_i686.whl", hash = "sha256:ea3d8a3d18833cf4304cd2fc9cbb1efe188ca9b5efef2bdac7adc20594a0e46b"}, - {file = "MarkupSafe-2.1.5-cp312-cp312-musllinux_1_1_aarch64.whl", hash = "sha256:d050b3361367a06d752db6ead6e7edeb0009be66bc3bae0ee9d97fb326badc2a"}, - {file = "MarkupSafe-2.1.5-cp312-cp312-musllinux_1_1_i686.whl", hash = "sha256:bec0a414d016ac1a18862a519e54b2fd0fc8bbfd6890376898a6c0891dd82e9f"}, - {file = "MarkupSafe-2.1.5-cp312-cp312-musllinux_1_1_x86_64.whl", hash = "sha256:58c98fee265677f63a4385256a6d7683ab1832f3ddd1e66fe948d5880c21a169"}, - {file = "MarkupSafe-2.1.5-cp312-cp312-win32.whl", hash = "sha256:8590b4ae07a35970728874632fed7bd57b26b0102df2d2b233b6d9d82f6c62ad"}, - {file = "MarkupSafe-2.1.5-cp312-cp312-win_amd64.whl", hash = "sha256:823b65d8706e32ad2df51ed89496147a42a2a6e01c13cfb6ffb8b1e92bc910bb"}, - {file = "MarkupSafe-2.1.5-cp37-cp37m-macosx_10_9_x86_64.whl", hash = "sha256:c8b29db45f8fe46ad280a7294f5c3ec36dbac9491f2d1c17345be8e69cc5928f"}, - {file = "MarkupSafe-2.1.5-cp37-cp37m-manylinux_2_17_aarch64.manylinux2014_aarch64.whl", hash = "sha256:ec6a563cff360b50eed26f13adc43e61bc0c04d94b8be985e6fb24b81f6dcfdf"}, - {file = "MarkupSafe-2.1.5-cp37-cp37m-manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:a549b9c31bec33820e885335b451286e2969a2d9e24879f83fe904a5ce59d70a"}, - {file = "MarkupSafe-2.1.5-cp37-cp37m-manylinux_2_5_i686.manylinux1_i686.manylinux_2_17_i686.manylinux2014_i686.whl", hash = "sha256:4f11aa001c540f62c6166c7726f71f7573b52c68c31f014c25cc7901deea0b52"}, - {file = "MarkupSafe-2.1.5-cp37-cp37m-musllinux_1_1_aarch64.whl", hash = "sha256:7b2e5a267c855eea6b4283940daa6e88a285f5f2a67f2220203786dfa59b37e9"}, - {file = "MarkupSafe-2.1.5-cp37-cp37m-musllinux_1_1_i686.whl", hash = "sha256:2d2d793e36e230fd32babe143b04cec8a8b3eb8a3122d2aceb4a371e6b09b8df"}, - {file = "MarkupSafe-2.1.5-cp37-cp37m-musllinux_1_1_x86_64.whl", hash = "sha256:ce409136744f6521e39fd8e2a24c53fa18ad67aa5bc7c2cf83645cce5b5c4e50"}, - {file = "MarkupSafe-2.1.5-cp37-cp37m-win32.whl", hash = "sha256:4096e9de5c6fdf43fb4f04c26fb114f61ef0bf2e5604b6ee3019d51b69e8c371"}, - {file = "MarkupSafe-2.1.5-cp37-cp37m-win_amd64.whl", hash = "sha256:4275d846e41ecefa46e2015117a9f491e57a71ddd59bbead77e904dc02b1bed2"}, - {file = "MarkupSafe-2.1.5-cp38-cp38-macosx_10_9_universal2.whl", hash = "sha256:656f7526c69fac7f600bd1f400991cc282b417d17539a1b228617081106feb4a"}, - {file = "MarkupSafe-2.1.5-cp38-cp38-macosx_10_9_x86_64.whl", hash = "sha256:97cafb1f3cbcd3fd2b6fbfb99ae11cdb14deea0736fc2b0952ee177f2b813a46"}, - {file = "MarkupSafe-2.1.5-cp38-cp38-manylinux_2_17_aarch64.manylinux2014_aarch64.whl", hash = "sha256:1f3fbcb7ef1f16e48246f704ab79d79da8a46891e2da03f8783a5b6fa41a9532"}, - {file = "MarkupSafe-2.1.5-cp38-cp38-manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:fa9db3f79de01457b03d4f01b34cf91bc0048eb2c3846ff26f66687c2f6d16ab"}, - {file = "MarkupSafe-2.1.5-cp38-cp38-manylinux_2_5_i686.manylinux1_i686.manylinux_2_17_i686.manylinux2014_i686.whl", hash = "sha256:ffee1f21e5ef0d712f9033568f8344d5da8cc2869dbd08d87c84656e6a2d2f68"}, - {file = "MarkupSafe-2.1.5-cp38-cp38-musllinux_1_1_aarch64.whl", hash = "sha256:5dedb4db619ba5a2787a94d877bc8ffc0566f92a01c0ef214865e54ecc9ee5e0"}, - {file = "MarkupSafe-2.1.5-cp38-cp38-musllinux_1_1_i686.whl", hash = "sha256:30b600cf0a7ac9234b2638fbc0fb6158ba5bdcdf46aeb631ead21248b9affbc4"}, - {file = "MarkupSafe-2.1.5-cp38-cp38-musllinux_1_1_x86_64.whl", hash = "sha256:8dd717634f5a044f860435c1d8c16a270ddf0ef8588d4887037c5028b859b0c3"}, - {file = "MarkupSafe-2.1.5-cp38-cp38-win32.whl", hash = "sha256:daa4ee5a243f0f20d528d939d06670a298dd39b1ad5f8a72a4275124a7819eff"}, - {file = "MarkupSafe-2.1.5-cp38-cp38-win_amd64.whl", hash = "sha256:619bc166c4f2de5caa5a633b8b7326fbe98e0ccbfacabd87268a2b15ff73a029"}, - {file = "MarkupSafe-2.1.5-cp39-cp39-macosx_10_9_universal2.whl", hash = "sha256:7a68b554d356a91cce1236aa7682dc01df0edba8d043fd1ce607c49dd3c1edcf"}, - {file = "MarkupSafe-2.1.5-cp39-cp39-macosx_10_9_x86_64.whl", hash = "sha256:db0b55e0f3cc0be60c1f19efdde9a637c32740486004f20d1cff53c3c0ece4d2"}, - {file = "MarkupSafe-2.1.5-cp39-cp39-manylinux_2_17_aarch64.manylinux2014_aarch64.whl", hash = "sha256:3e53af139f8579a6d5f7b76549125f0d94d7e630761a2111bc431fd820e163b8"}, - {file = "MarkupSafe-2.1.5-cp39-cp39-manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:17b950fccb810b3293638215058e432159d2b71005c74371d784862b7e4683f3"}, - {file = "MarkupSafe-2.1.5-cp39-cp39-manylinux_2_5_i686.manylinux1_i686.manylinux_2_17_i686.manylinux2014_i686.whl", hash = "sha256:4c31f53cdae6ecfa91a77820e8b151dba54ab528ba65dfd235c80b086d68a465"}, - {file = "MarkupSafe-2.1.5-cp39-cp39-musllinux_1_1_aarch64.whl", hash = "sha256:bff1b4290a66b490a2f4719358c0cdcd9bafb6b8f061e45c7a2460866bf50c2e"}, - {file = "MarkupSafe-2.1.5-cp39-cp39-musllinux_1_1_i686.whl", hash = "sha256:bc1667f8b83f48511b94671e0e441401371dfd0f0a795c7daa4a3cd1dde55bea"}, - {file = "MarkupSafe-2.1.5-cp39-cp39-musllinux_1_1_x86_64.whl", hash = "sha256:5049256f536511ee3f7e1b3f87d1d1209d327e818e6ae1365e8653d7e3abb6a6"}, - {file = "MarkupSafe-2.1.5-cp39-cp39-win32.whl", hash = "sha256:00e046b6dd71aa03a41079792f8473dc494d564611a8f89bbbd7cb93295ebdcf"}, - {file = "MarkupSafe-2.1.5-cp39-cp39-win_amd64.whl", hash = "sha256:fa173ec60341d6bb97a89f5ea19c85c5643c1e7dedebc22f5181eb73573142c5"}, - {file = "MarkupSafe-2.1.5.tar.gz", hash = "sha256:d283d37a890ba4c1ae73ffadf8046435c76e7bc2247bbb63c00bd1a709c6544b"}, -] - -[[package]] -name = "marmot-agents" -version = "0.2.5" -description = "Agent based processs modeling." -optional = true -python-versions = "*" -files = [ - {file = "marmot-agents-0.2.5.tar.gz", hash = "sha256:d0038c28928681b74352397a357f290da00c86a10c9626219b3ae36899faa915"}, - {file = "marmot_agents-0.2.5-py3-none-any.whl", hash = "sha256:f7678a830593222436396163fb0788d9d113bf84afb956b8854aad465830c2a6"}, -] - -[package.dependencies] -numpy = "*" - -[[package]] -name = "matplotlib" -version = "3.9.0" -description = "Python plotting package" -optional = true -python-versions = ">=3.9" -files = [ - {file = "matplotlib-3.9.0-cp310-cp310-macosx_10_12_x86_64.whl", hash = "sha256:2bcee1dffaf60fe7656183ac2190bd630842ff87b3153afb3e384d966b57fe56"}, - {file = "matplotlib-3.9.0-cp310-cp310-macosx_11_0_arm64.whl", hash = "sha256:3f988bafb0fa39d1074ddd5bacd958c853e11def40800c5824556eb630f94d3b"}, - {file = "matplotlib-3.9.0-cp310-cp310-manylinux_2_17_aarch64.manylinux2014_aarch64.whl", hash = "sha256:fe428e191ea016bb278758c8ee82a8129c51d81d8c4bc0846c09e7e8e9057241"}, - {file = "matplotlib-3.9.0-cp310-cp310-manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:eaf3978060a106fab40c328778b148f590e27f6fa3cd15a19d6892575bce387d"}, - {file = "matplotlib-3.9.0-cp310-cp310-musllinux_1_1_x86_64.whl", hash = "sha256:2e7f03e5cbbfacdd48c8ea394d365d91ee8f3cae7e6ec611409927b5ed997ee4"}, - {file = "matplotlib-3.9.0-cp310-cp310-win_amd64.whl", hash = "sha256:13beb4840317d45ffd4183a778685e215939be7b08616f431c7795276e067463"}, - {file = "matplotlib-3.9.0-cp311-cp311-macosx_10_12_x86_64.whl", hash = "sha256:063af8587fceeac13b0936c42a2b6c732c2ab1c98d38abc3337e430e1ff75e38"}, - {file = "matplotlib-3.9.0-cp311-cp311-macosx_11_0_arm64.whl", hash = "sha256:9a2fa6d899e17ddca6d6526cf6e7ba677738bf2a6a9590d702c277204a7c6152"}, - {file = "matplotlib-3.9.0-cp311-cp311-manylinux_2_17_aarch64.manylinux2014_aarch64.whl", hash = "sha256:550cdda3adbd596078cca7d13ed50b77879104e2e46392dcd7c75259d8f00e85"}, - {file = "matplotlib-3.9.0-cp311-cp311-manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:76cce0f31b351e3551d1f3779420cf8f6ec0d4a8cf9c0237a3b549fd28eb4abb"}, - {file = "matplotlib-3.9.0-cp311-cp311-musllinux_1_1_x86_64.whl", hash = "sha256:c53aeb514ccbbcbab55a27f912d79ea30ab21ee0531ee2c09f13800efb272674"}, - {file = "matplotlib-3.9.0-cp311-cp311-win_amd64.whl", hash = "sha256:a5be985db2596d761cdf0c2eaf52396f26e6a64ab46bd8cd810c48972349d1be"}, - {file = "matplotlib-3.9.0-cp312-cp312-macosx_10_12_x86_64.whl", hash = "sha256:c79f3a585f1368da6049318bdf1f85568d8d04b2e89fc24b7e02cc9b62017382"}, - {file = "matplotlib-3.9.0-cp312-cp312-macosx_11_0_arm64.whl", hash = "sha256:bdd1ecbe268eb3e7653e04f451635f0fb0f77f07fd070242b44c076c9106da84"}, - {file = "matplotlib-3.9.0-cp312-cp312-manylinux_2_17_aarch64.manylinux2014_aarch64.whl", hash = "sha256:d38e85a1a6d732f645f1403ce5e6727fd9418cd4574521d5803d3d94911038e5"}, - {file = "matplotlib-3.9.0-cp312-cp312-manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:0a490715b3b9984fa609116481b22178348c1a220a4499cda79132000a79b4db"}, - {file = "matplotlib-3.9.0-cp312-cp312-musllinux_1_1_x86_64.whl", hash = "sha256:8146ce83cbc5dc71c223a74a1996d446cd35cfb6a04b683e1446b7e6c73603b7"}, - {file = "matplotlib-3.9.0-cp312-cp312-win_amd64.whl", hash = "sha256:d91a4ffc587bacf5c4ce4ecfe4bcd23a4b675e76315f2866e588686cc97fccdf"}, - {file = "matplotlib-3.9.0-cp39-cp39-macosx_10_12_x86_64.whl", hash = "sha256:616fabf4981a3b3c5a15cd95eba359c8489c4e20e03717aea42866d8d0465956"}, - {file = "matplotlib-3.9.0-cp39-cp39-macosx_11_0_arm64.whl", hash = "sha256:cd53c79fd02f1c1808d2cfc87dd3cf4dbc63c5244a58ee7944497107469c8d8a"}, - {file = "matplotlib-3.9.0-cp39-cp39-manylinux_2_17_aarch64.manylinux2014_aarch64.whl", hash = "sha256:06a478f0d67636554fa78558cfbcd7b9dba85b51f5c3b5a0c9be49010cf5f321"}, - {file = "matplotlib-3.9.0-cp39-cp39-manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:81c40af649d19c85f8073e25e5806926986806fa6d54be506fbf02aef47d5a89"}, - {file = "matplotlib-3.9.0-cp39-cp39-musllinux_1_1_x86_64.whl", hash = "sha256:52146fc3bd7813cc784562cb93a15788be0b2875c4655e2cc6ea646bfa30344b"}, - {file = "matplotlib-3.9.0-cp39-cp39-win_amd64.whl", hash = "sha256:0fc51eaa5262553868461c083d9adadb11a6017315f3a757fc45ec6ec5f02888"}, - {file = "matplotlib-3.9.0-pp39-pypy39_pp73-macosx_10_12_x86_64.whl", hash = "sha256:bd4f2831168afac55b881db82a7730992aa41c4f007f1913465fb182d6fb20c0"}, - {file = "matplotlib-3.9.0-pp39-pypy39_pp73-macosx_11_0_arm64.whl", hash = "sha256:290d304e59be2b33ef5c2d768d0237f5bd132986bdcc66f80bc9bcc300066a03"}, - {file = "matplotlib-3.9.0-pp39-pypy39_pp73-manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:7ff2e239c26be4f24bfa45860c20ffccd118d270c5b5d081fa4ea409b5469fcd"}, - {file = "matplotlib-3.9.0-pp39-pypy39_pp73-win_amd64.whl", hash = "sha256:af4001b7cae70f7eaacfb063db605280058246de590fa7874f00f62259f2df7e"}, - {file = "matplotlib-3.9.0.tar.gz", hash = "sha256:e6d29ea6c19e34b30fb7d88b7081f869a03014f66fe06d62cc77d5a6ea88ed7a"}, -] - -[package.dependencies] -contourpy = ">=1.0.1" -cycler = ">=0.10" -fonttools = ">=4.22.0" -importlib-resources = {version = ">=3.2.0", markers = "python_version < \"3.10\""} -kiwisolver = ">=1.3.1" -numpy = ">=1.23" -packaging = ">=20.0" -pillow = ">=8" -pyparsing = ">=2.3.1" -python-dateutil = ">=2.7" - -[package.extras] -dev = ["meson-python (>=0.13.1)", "numpy (>=1.25)", "pybind11 (>=2.6)", "setuptools (>=64)", "setuptools_scm (>=7)"] - -[[package]] -name = "matplotlib-inline" -version = "0.1.7" -description = "Inline Matplotlib backend for Jupyter" -optional = true -python-versions = ">=3.8" -files = [ - {file = "matplotlib_inline-0.1.7-py3-none-any.whl", hash = "sha256:df192d39a4ff8f21b1895d72e6a13f5fcc5099f00fa84384e0ea28c2cc0653ca"}, - {file = "matplotlib_inline-0.1.7.tar.gz", hash = "sha256:8423b23ec666be3d16e16b60bdd8ac4e86e840ebd1dd11a30b9f117f2fa0ab90"}, -] - -[package.dependencies] -traitlets = "*" - -[[package]] -name = "mistune" -version = "3.0.2" -description = "A sane and fast Markdown parser with useful plugins and renderers" -optional = true -python-versions = ">=3.7" -files = [ - {file = "mistune-3.0.2-py3-none-any.whl", hash = "sha256:71481854c30fdbc938963d3605b72501f5c10a9320ecd412c121c163a1c7d205"}, - {file = "mistune-3.0.2.tar.gz", hash = "sha256:fc7f93ded930c92394ef2cb6f04a8aabab4117a91449e72dcc8dfa646a508be8"}, -] - -[[package]] -name = "moorpy" -version = "1.0.2" -description = "A design-oriented mooring system library for Python" -optional = true -python-versions = ">=3.8" -files = [ - {file = "MoorPy-1.0.2-py3-none-any.whl", hash = "sha256:e1cb1746a18678349521655d1a2d4eb703bf8fee0731dc7a920d5229831e3026"}, - {file = "MoorPy-1.0.2.tar.gz", hash = "sha256:29965a0b50bcd2c9d5bfe835b2eff581aeaaf9ccd87087db89054338b92d1847"}, -] - -[package.dependencies] -matplotlib = "*" -numpy = "*" -pyyaml = "*" -scipy = "*" - -[package.extras] -dev = ["pre-commit"] -docs = ["sphinx", "sphinx-rtd-theme"] -test = ["pytest", "pytest-cov", "pytest-xdist"] - -[[package]] -name = "nbclient" -version = "0.10.0" -description = "A client library for executing notebooks. Formerly nbconvert's ExecutePreprocessor." -optional = true -python-versions = ">=3.8.0" -files = [ - {file = "nbclient-0.10.0-py3-none-any.whl", hash = "sha256:f13e3529332a1f1f81d82a53210322476a168bb7090a0289c795fe9cc11c9d3f"}, - {file = "nbclient-0.10.0.tar.gz", hash = "sha256:4b3f1b7dba531e498449c4db4f53da339c91d449dc11e9af3a43b4eb5c5abb09"}, -] - -[package.dependencies] -jupyter-client = ">=6.1.12" -jupyter-core = ">=4.12,<5.0.dev0 || >=5.1.dev0" -nbformat = ">=5.1" -traitlets = ">=5.4" - -[package.extras] -dev = ["pre-commit"] -docs = ["autodoc-traits", "mock", "moto", "myst-parser", "nbclient[test]", "sphinx (>=1.7)", "sphinx-book-theme", "sphinxcontrib-spelling"] -test = ["flaky", "ipykernel (>=6.19.3)", "ipython", "ipywidgets", "nbconvert (>=7.0.0)", "pytest (>=7.0,<8)", "pytest-asyncio", "pytest-cov (>=4.0)", "testpath", "xmltodict"] - -[[package]] -name = "nbconvert" -version = "7.16.4" -description = "Converting Jupyter Notebooks (.ipynb files) to other formats. Output formats include asciidoc, html, latex, markdown, pdf, py, rst, script. nbconvert can be used both as a Python library (`import nbconvert`) or as a command line tool (invoked as `jupyter nbconvert ...`)." -optional = true -python-versions = ">=3.8" -files = [ - {file = "nbconvert-7.16.4-py3-none-any.whl", hash = "sha256:05873c620fe520b6322bf8a5ad562692343fe3452abda5765c7a34b7d1aa3eb3"}, - {file = "nbconvert-7.16.4.tar.gz", hash = "sha256:86ca91ba266b0a448dc96fa6c5b9d98affabde2867b363258703536807f9f7f4"}, -] - -[package.dependencies] -beautifulsoup4 = "*" -bleach = "!=5.0.0" -defusedxml = "*" -importlib-metadata = {version = ">=3.6", markers = "python_version < \"3.10\""} -jinja2 = ">=3.0" -jupyter-core = ">=4.7" -jupyterlab-pygments = "*" -markupsafe = ">=2.0" -mistune = ">=2.0.3,<4" -nbclient = ">=0.5.0" -nbformat = ">=5.7" -packaging = "*" -pandocfilters = ">=1.4.1" -pygments = ">=2.4.1" -tinycss2 = "*" -traitlets = ">=5.1" - -[package.extras] -all = ["flaky", "ipykernel", "ipython", "ipywidgets (>=7.5)", "myst-parser", "nbsphinx (>=0.2.12)", "playwright", "pydata-sphinx-theme", "pyqtwebengine (>=5.15)", "pytest (>=7)", "sphinx (==5.0.2)", "sphinxcontrib-spelling", "tornado (>=6.1)"] -docs = ["ipykernel", "ipython", "myst-parser", "nbsphinx (>=0.2.12)", "pydata-sphinx-theme", "sphinx (==5.0.2)", "sphinxcontrib-spelling"] -qtpdf = ["pyqtwebengine (>=5.15)"] -qtpng = ["pyqtwebengine (>=5.15)"] -serve = ["tornado (>=6.1)"] -test = ["flaky", "ipykernel", "ipywidgets (>=7.5)", "pytest (>=7)"] -webpdf = ["playwright"] - -[[package]] -name = "nbformat" -version = "5.10.4" -description = "The Jupyter Notebook format" -optional = true -python-versions = ">=3.8" -files = [ - {file = "nbformat-5.10.4-py3-none-any.whl", hash = "sha256:3b48d6c8fbca4b299bf3982ea7db1af21580e4fec269ad087b9e81588891200b"}, - {file = "nbformat-5.10.4.tar.gz", hash = "sha256:322168b14f937a5d11362988ecac2a4952d3d8e3a2cbeb2319584631226d5b3a"}, -] - -[package.dependencies] -fastjsonschema = ">=2.15" -jsonschema = ">=2.6" -jupyter-core = ">=4.12,<5.0.dev0 || >=5.1.dev0" -traitlets = ">=5.1" - -[package.extras] -docs = ["myst-parser", "pydata-sphinx-theme", "sphinx", "sphinxcontrib-github-alt", "sphinxcontrib-spelling"] -test = ["pep440", "pre-commit", "pytest", "testpath"] - -[[package]] -name = "nest-asyncio" -version = "1.6.0" -description = "Patch asyncio to allow nested event loops" -optional = true -python-versions = ">=3.5" -files = [ - {file = "nest_asyncio-1.6.0-py3-none-any.whl", hash = "sha256:87af6efd6b5e897c81050477ef65c62e2b2f35d51703cae01aff2905b1852e1c"}, - {file = "nest_asyncio-1.6.0.tar.gz", hash = "sha256:6f172d5449aca15afd6c646851f4e31e02c598d553a667e38cafa997cfec55fe"}, -] - -[[package]] -name = "networkx" -version = "3.2.1" -description = "Python package for creating and manipulating graphs and networks" -optional = true -python-versions = ">=3.9" -files = [ - {file = "networkx-3.2.1-py3-none-any.whl", hash = "sha256:f18c69adc97877c42332c170849c96cefa91881c99a7cb3e95b7c659ebdc1ec2"}, - {file = "networkx-3.2.1.tar.gz", hash = "sha256:9f1bb5cf3409bf324e0a722c20bdb4c20ee39bf1c30ce8ae499c8502b0b5e0c6"}, -] - -[package.extras] -default = ["matplotlib (>=3.5)", "numpy (>=1.22)", "pandas (>=1.4)", "scipy (>=1.9,!=1.11.0,!=1.11.1)"] -developer = ["changelist (==0.4)", "mypy (>=1.1)", "pre-commit (>=3.2)", "rtoml"] -doc = ["nb2plots (>=0.7)", "nbconvert (<7.9)", "numpydoc (>=1.6)", "pillow (>=9.4)", "pydata-sphinx-theme (>=0.14)", "sphinx (>=7)", "sphinx-gallery (>=0.14)", "texext (>=0.6.7)"] -extra = ["lxml (>=4.6)", "pydot (>=1.4.2)", "pygraphviz (>=1.11)", "sympy (>=1.10)"] -test = ["pytest (>=7.2)", "pytest-cov (>=4.0)"] - -[[package]] -name = "notebook" -version = "7.2.0" -description = "Jupyter Notebook - A web-based notebook environment for interactive computing" -optional = true -python-versions = ">=3.8" -files = [ - {file = "notebook-7.2.0-py3-none-any.whl", hash = "sha256:b4752d7407d6c8872fc505df0f00d3cae46e8efb033b822adacbaa3f1f3ce8f5"}, - {file = "notebook-7.2.0.tar.gz", hash = "sha256:34a2ba4b08ad5d19ec930db7484fb79746a1784be9e1a5f8218f9af8656a141f"}, -] - -[package.dependencies] -jupyter-server = ">=2.4.0,<3" -jupyterlab = ">=4.2.0,<4.3" -jupyterlab-server = ">=2.27.1,<3" -notebook-shim = ">=0.2,<0.3" -tornado = ">=6.2.0" - -[package.extras] -dev = ["hatch", "pre-commit"] -docs = ["myst-parser", "nbsphinx", "pydata-sphinx-theme", "sphinx (>=1.3.6)", "sphinxcontrib-github-alt", "sphinxcontrib-spelling"] -test = ["importlib-resources (>=5.0)", "ipykernel", "jupyter-server[test] (>=2.4.0,<3)", "jupyterlab-server[test] (>=2.27.1,<3)", "nbval", "pytest (>=7.0)", "pytest-console-scripts", "pytest-timeout", "pytest-tornasync", "requests"] - -[[package]] -name = "notebook-shim" -version = "0.2.4" -description = "A shim layer for notebook traits and config" -optional = true -python-versions = ">=3.7" -files = [ - {file = "notebook_shim-0.2.4-py3-none-any.whl", hash = "sha256:411a5be4e9dc882a074ccbcae671eda64cceb068767e9a3419096986560e1cef"}, - {file = "notebook_shim-0.2.4.tar.gz", hash = "sha256:b4b2cfa1b65d98307ca24361f5b30fe785b53c3fd07b7a47e89acb5e6ac638cb"}, -] - -[package.dependencies] -jupyter-server = ">=1.8,<3" - -[package.extras] -test = ["pytest", "pytest-console-scripts", "pytest-jupyter", "pytest-tornasync"] - -[[package]] -name = "numpy" -version = "1.26.4" -description = "Fundamental package for array computing in Python" -optional = false -python-versions = ">=3.9" -files = [ - {file = "numpy-1.26.4-cp310-cp310-macosx_10_9_x86_64.whl", hash = "sha256:9ff0f4f29c51e2803569d7a51c2304de5554655a60c5d776e35b4a41413830d0"}, - {file = "numpy-1.26.4-cp310-cp310-macosx_11_0_arm64.whl", hash = "sha256:2e4ee3380d6de9c9ec04745830fd9e2eccb3e6cf790d39d7b98ffd19b0dd754a"}, - {file = "numpy-1.26.4-cp310-cp310-manylinux_2_17_aarch64.manylinux2014_aarch64.whl", hash = "sha256:d209d8969599b27ad20994c8e41936ee0964e6da07478d6c35016bc386b66ad4"}, - {file = "numpy-1.26.4-cp310-cp310-manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:ffa75af20b44f8dba823498024771d5ac50620e6915abac414251bd971b4529f"}, - {file = "numpy-1.26.4-cp310-cp310-musllinux_1_1_aarch64.whl", hash = "sha256:62b8e4b1e28009ef2846b4c7852046736bab361f7aeadeb6a5b89ebec3c7055a"}, - {file = "numpy-1.26.4-cp310-cp310-musllinux_1_1_x86_64.whl", hash = "sha256:a4abb4f9001ad2858e7ac189089c42178fcce737e4169dc61321660f1a96c7d2"}, - {file = "numpy-1.26.4-cp310-cp310-win32.whl", hash = "sha256:bfe25acf8b437eb2a8b2d49d443800a5f18508cd811fea3181723922a8a82b07"}, - {file = "numpy-1.26.4-cp310-cp310-win_amd64.whl", hash = "sha256:b97fe8060236edf3662adfc2c633f56a08ae30560c56310562cb4f95500022d5"}, - {file = "numpy-1.26.4-cp311-cp311-macosx_10_9_x86_64.whl", hash = "sha256:4c66707fabe114439db9068ee468c26bbdf909cac0fb58686a42a24de1760c71"}, - {file = "numpy-1.26.4-cp311-cp311-macosx_11_0_arm64.whl", hash = "sha256:edd8b5fe47dab091176d21bb6de568acdd906d1887a4584a15a9a96a1dca06ef"}, - {file = "numpy-1.26.4-cp311-cp311-manylinux_2_17_aarch64.manylinux2014_aarch64.whl", hash = "sha256:7ab55401287bfec946ced39700c053796e7cc0e3acbef09993a9ad2adba6ca6e"}, - {file = "numpy-1.26.4-cp311-cp311-manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:666dbfb6ec68962c033a450943ded891bed2d54e6755e35e5835d63f4f6931d5"}, - {file = "numpy-1.26.4-cp311-cp311-musllinux_1_1_aarch64.whl", hash = "sha256:96ff0b2ad353d8f990b63294c8986f1ec3cb19d749234014f4e7eb0112ceba5a"}, - {file = "numpy-1.26.4-cp311-cp311-musllinux_1_1_x86_64.whl", hash = "sha256:60dedbb91afcbfdc9bc0b1f3f402804070deed7392c23eb7a7f07fa857868e8a"}, - {file = "numpy-1.26.4-cp311-cp311-win32.whl", hash = "sha256:1af303d6b2210eb850fcf03064d364652b7120803a0b872f5211f5234b399f20"}, - {file = "numpy-1.26.4-cp311-cp311-win_amd64.whl", hash = "sha256:cd25bcecc4974d09257ffcd1f098ee778f7834c3ad767fe5db785be9a4aa9cb2"}, - {file = "numpy-1.26.4-cp312-cp312-macosx_10_9_x86_64.whl", hash = "sha256:b3ce300f3644fb06443ee2222c2201dd3a89ea6040541412b8fa189341847218"}, - {file = "numpy-1.26.4-cp312-cp312-macosx_11_0_arm64.whl", hash = "sha256:03a8c78d01d9781b28a6989f6fa1bb2c4f2d51201cf99d3dd875df6fbd96b23b"}, - {file = "numpy-1.26.4-cp312-cp312-manylinux_2_17_aarch64.manylinux2014_aarch64.whl", hash = "sha256:9fad7dcb1aac3c7f0584a5a8133e3a43eeb2fe127f47e3632d43d677c66c102b"}, - {file = "numpy-1.26.4-cp312-cp312-manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:675d61ffbfa78604709862923189bad94014bef562cc35cf61d3a07bba02a7ed"}, - {file = "numpy-1.26.4-cp312-cp312-musllinux_1_1_aarch64.whl", hash = "sha256:ab47dbe5cc8210f55aa58e4805fe224dac469cde56b9f731a4c098b91917159a"}, - {file = "numpy-1.26.4-cp312-cp312-musllinux_1_1_x86_64.whl", hash = "sha256:1dda2e7b4ec9dd512f84935c5f126c8bd8b9f2fc001e9f54af255e8c5f16b0e0"}, - {file = "numpy-1.26.4-cp312-cp312-win32.whl", hash = "sha256:50193e430acfc1346175fcbdaa28ffec49947a06918b7b92130744e81e640110"}, - {file = "numpy-1.26.4-cp312-cp312-win_amd64.whl", hash = "sha256:08beddf13648eb95f8d867350f6a018a4be2e5ad54c8d8caed89ebca558b2818"}, - {file = "numpy-1.26.4-cp39-cp39-macosx_10_9_x86_64.whl", hash = "sha256:7349ab0fa0c429c82442a27a9673fc802ffdb7c7775fad780226cb234965e53c"}, - {file = "numpy-1.26.4-cp39-cp39-macosx_11_0_arm64.whl", hash = "sha256:52b8b60467cd7dd1e9ed082188b4e6bb35aa5cdd01777621a1658910745b90be"}, - {file = "numpy-1.26.4-cp39-cp39-manylinux_2_17_aarch64.manylinux2014_aarch64.whl", hash = "sha256:d5241e0a80d808d70546c697135da2c613f30e28251ff8307eb72ba696945764"}, - {file = "numpy-1.26.4-cp39-cp39-manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:f870204a840a60da0b12273ef34f7051e98c3b5961b61b0c2c1be6dfd64fbcd3"}, - {file = "numpy-1.26.4-cp39-cp39-musllinux_1_1_aarch64.whl", hash = "sha256:679b0076f67ecc0138fd2ede3a8fd196dddc2ad3254069bcb9faf9a79b1cebcd"}, - {file = "numpy-1.26.4-cp39-cp39-musllinux_1_1_x86_64.whl", hash = "sha256:47711010ad8555514b434df65f7d7b076bb8261df1ca9bb78f53d3b2db02e95c"}, - {file = "numpy-1.26.4-cp39-cp39-win32.whl", hash = "sha256:a354325ee03388678242a4d7ebcd08b5c727033fcff3b2f536aea978e15ee9e6"}, - {file = "numpy-1.26.4-cp39-cp39-win_amd64.whl", hash = "sha256:3373d5d70a5fe74a2c1bb6d2cfd9609ecf686d47a2d7b1d37a8f3b6bf6003aea"}, - {file = "numpy-1.26.4-pp39-pypy39_pp73-macosx_10_9_x86_64.whl", hash = "sha256:afedb719a9dcfc7eaf2287b839d8198e06dcd4cb5d276a3df279231138e83d30"}, - {file = "numpy-1.26.4-pp39-pypy39_pp73-manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:95a7476c59002f2f6c590b9b7b998306fba6a5aa646b1e22ddfeaf8f78c3a29c"}, - {file = "numpy-1.26.4-pp39-pypy39_pp73-win_amd64.whl", hash = "sha256:7e50d0a0cc3189f9cb0aeb3a6a6af18c16f59f004b866cd2be1c14b36134a4a0"}, - {file = "numpy-1.26.4.tar.gz", hash = "sha256:2a02aba9ed12e4ac4eb3ea9421c420301a0c6460d9830d74a9df87efa4912010"}, -] - -[[package]] -name = "openmdao" -version = "3.32.0" -description = "OpenMDAO framework infrastructure" -optional = true -python-versions = ">=3.8" -files = [ - {file = "openmdao-3.32.0.tar.gz", hash = "sha256:324f8d900153cea14114a8c2a83aa3d801f7fd5e172c156a85a8208f45c3be49"}, -] - -[package.dependencies] -networkx = ">=2.0" -numpy = "<2" -packaging = "*" -requests = "*" -scipy = "*" - -[package.extras] -all = ["aiounittest", "bokeh (>=2.4.0)", "colorama", "idna (>=3.7)", "ipympl", "ipyparallel", "jax (>=0.4.0)", "jaxlib (>=0.4.0)", "jupyter-book (==0.14)", "matplotlib", "notebook", "num2words", "numpydoc (>=1.1)", "parameterized", "playwright (>=1.20)", "pycodestyle (>=2.4.0)", "pydocstyle (==2.0.0)", "pydoe3", "sphinx-sitemap", "testflo (>=1.3.6)", "websockets (>8)"] -docs = ["idna (>=3.7)", "ipyparallel", "jupyter-book (==0.14)", "matplotlib", "numpydoc (>=1.1)", "sphinx-sitemap"] -doe = ["pydoe3"] -jax = ["jax (>=0.4.0)", "jaxlib (>=0.4.0)"] -notebooks = ["idna (>=3.7)", "ipympl", "notebook"] -test = ["aiounittest", "num2words", "numpydoc (>=1.1)", "parameterized", "playwright (>=1.20)", "pycodestyle (>=2.4.0)", "pydocstyle (==2.0.0)", "testflo (>=1.3.6)", "websockets (>8)"] -visualization = ["bokeh (>=2.4.0)", "colorama", "matplotlib"] - -[[package]] -name = "openpyxl" -version = "3.1.2" -description = "A Python library to read/write Excel 2010 xlsx/xlsm files" -optional = true -python-versions = ">=3.6" -files = [ - {file = "openpyxl-3.1.2-py2.py3-none-any.whl", hash = "sha256:f91456ead12ab3c6c2e9491cf33ba6d08357d802192379bb482f1033ade496f5"}, - {file = "openpyxl-3.1.2.tar.gz", hash = "sha256:a6f5977418eff3b2d5500d54d9db50c8277a368436f4e4f8ddb1be3422870184"}, -] - -[package.dependencies] -et-xmlfile = "*" - -[[package]] -name = "overrides" -version = "7.7.0" -description = "A decorator to automatically detect mismatch when overriding a method." -optional = true -python-versions = ">=3.6" -files = [ - {file = "overrides-7.7.0-py3-none-any.whl", hash = "sha256:c7ed9d062f78b8e4c1a7b70bd8796b35ead4d9f510227ef9c5dc7626c60d7e49"}, - {file = "overrides-7.7.0.tar.gz", hash = "sha256:55158fa3d93b98cc75299b1e67078ad9003ca27945c76162c1c0766d6f91820a"}, -] - -[[package]] -name = "packaging" -version = "24.0" -description = "Core utilities for Python packages" -optional = true -python-versions = ">=3.7" -files = [ - {file = "packaging-24.0-py3-none-any.whl", hash = "sha256:2ddfb553fdf02fb784c234c7ba6ccc288296ceabec964ad2eae3777778130bc5"}, - {file = "packaging-24.0.tar.gz", hash = "sha256:eb82c5e3e56209074766e6885bb04b8c38a0c015d0a30036ebe7ece34c9989e9"}, -] - -[[package]] -name = "pandas" -version = "2.2.2" -description = "Powerful data structures for data analysis, time series, and statistics" -optional = false -python-versions = ">=3.9" -files = [ - {file = "pandas-2.2.2-cp310-cp310-macosx_10_9_x86_64.whl", hash = "sha256:90c6fca2acf139569e74e8781709dccb6fe25940488755716d1d354d6bc58bce"}, - {file = "pandas-2.2.2-cp310-cp310-manylinux_2_17_aarch64.manylinux2014_aarch64.whl", hash = "sha256:4abfe0be0d7221be4f12552995e58723c7422c80a659da13ca382697de830c08"}, - {file = "pandas-2.2.2-cp310-cp310-manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:8635c16bf3d99040fdf3ca3db669a7250ddf49c55dc4aa8fe0ae0fa8d6dcc1f0"}, - {file = "pandas-2.2.2-cp310-cp310-musllinux_1_1_aarch64.whl", hash = "sha256:40ae1dffb3967a52203105a077415a86044a2bea011b5f321c6aa64b379a3f51"}, - {file = "pandas-2.2.2-cp310-cp310-musllinux_1_1_x86_64.whl", hash = "sha256:8e5a0b00e1e56a842f922e7fae8ae4077aee4af0acb5ae3622bd4b4c30aedf99"}, - {file = "pandas-2.2.2-cp310-cp310-win_amd64.whl", hash = "sha256:ddf818e4e6c7c6f4f7c8a12709696d193976b591cc7dc50588d3d1a6b5dc8772"}, - {file = "pandas-2.2.2-cp311-cp311-macosx_10_9_x86_64.whl", hash = "sha256:696039430f7a562b74fa45f540aca068ea85fa34c244d0deee539cb6d70aa288"}, - {file = "pandas-2.2.2-cp311-cp311-macosx_11_0_arm64.whl", hash = "sha256:8e90497254aacacbc4ea6ae5e7a8cd75629d6ad2b30025a4a8b09aa4faf55151"}, - {file = "pandas-2.2.2-cp311-cp311-manylinux_2_17_aarch64.manylinux2014_aarch64.whl", hash = "sha256:58b84b91b0b9f4bafac2a0ac55002280c094dfc6402402332c0913a59654ab2b"}, - {file = "pandas-2.2.2-cp311-cp311-manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:6d2123dc9ad6a814bcdea0f099885276b31b24f7edf40f6cdbc0912672e22eee"}, - {file = "pandas-2.2.2-cp311-cp311-musllinux_1_1_aarch64.whl", hash = "sha256:2925720037f06e89af896c70bca73459d7e6a4be96f9de79e2d440bd499fe0db"}, - {file = "pandas-2.2.2-cp311-cp311-musllinux_1_1_x86_64.whl", hash = "sha256:0cace394b6ea70c01ca1595f839cf193df35d1575986e484ad35c4aeae7266c1"}, - {file = "pandas-2.2.2-cp311-cp311-win_amd64.whl", hash = "sha256:873d13d177501a28b2756375d59816c365e42ed8417b41665f346289adc68d24"}, - {file = "pandas-2.2.2-cp312-cp312-macosx_10_9_x86_64.whl", hash = "sha256:9dfde2a0ddef507a631dc9dc4af6a9489d5e2e740e226ad426a05cabfbd7c8ef"}, - {file = "pandas-2.2.2-cp312-cp312-manylinux_2_17_aarch64.manylinux2014_aarch64.whl", hash = "sha256:1cb51fe389360f3b5a4d57dbd2848a5f033350336ca3b340d1c53a1fad33bcad"}, - {file = "pandas-2.2.2-cp312-cp312-manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:eee3a87076c0756de40b05c5e9a6069c035ba43e8dd71c379e68cab2c20f16ad"}, - {file = "pandas-2.2.2-cp312-cp312-musllinux_1_1_aarch64.whl", hash = "sha256:3e374f59e440d4ab45ca2fffde54b81ac3834cf5ae2cdfa69c90bc03bde04d76"}, - {file = "pandas-2.2.2-cp312-cp312-musllinux_1_1_x86_64.whl", hash = "sha256:43498c0bdb43d55cb162cdc8c06fac328ccb5d2eabe3cadeb3529ae6f0517c32"}, - {file = "pandas-2.2.2-cp312-cp312-win_amd64.whl", hash = "sha256:d187d355ecec3629624fccb01d104da7d7f391db0311145817525281e2804d23"}, - {file = "pandas-2.2.2-cp39-cp39-macosx_10_9_x86_64.whl", hash = "sha256:0ca6377b8fca51815f382bd0b697a0814c8bda55115678cbc94c30aacbb6eff2"}, - {file = "pandas-2.2.2-cp39-cp39-manylinux_2_17_aarch64.manylinux2014_aarch64.whl", hash = "sha256:001910ad31abc7bf06f49dcc903755d2f7f3a9186c0c040b827e522e9cef0863"}, - {file = "pandas-2.2.2-cp39-cp39-manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:66b479b0bd07204e37583c191535505410daa8df638fd8e75ae1b383851fe921"}, - {file = "pandas-2.2.2-cp39-cp39-musllinux_1_1_aarch64.whl", hash = "sha256:a77e9d1c386196879aa5eb712e77461aaee433e54c68cf253053a73b7e49c33a"}, - {file = "pandas-2.2.2-cp39-cp39-musllinux_1_1_x86_64.whl", hash = "sha256:92fd6b027924a7e178ac202cfbe25e53368db90d56872d20ffae94b96c7acc57"}, - {file = "pandas-2.2.2-cp39-cp39-win_amd64.whl", hash = "sha256:640cef9aa381b60e296db324337a554aeeb883ead99dc8f6c18e81a93942f5f4"}, - {file = "pandas-2.2.2.tar.gz", hash = "sha256:9e79019aba43cb4fda9e4d983f8e88ca0373adbb697ae9c6c43093218de28b54"}, -] - -[package.dependencies] -numpy = [ - {version = ">=1.22.4", markers = "python_version < \"3.11\""}, - {version = ">=1.23.2", markers = "python_version == \"3.11\""}, - {version = ">=1.26.0", markers = "python_version >= \"3.12\""}, -] -python-dateutil = ">=2.8.2" -pytz = ">=2020.1" -tzdata = ">=2022.7" - -[package.extras] -all = ["PyQt5 (>=5.15.9)", "SQLAlchemy (>=2.0.0)", "adbc-driver-postgresql (>=0.8.0)", "adbc-driver-sqlite (>=0.8.0)", "beautifulsoup4 (>=4.11.2)", "bottleneck (>=1.3.6)", "dataframe-api-compat (>=0.1.7)", "fastparquet (>=2022.12.0)", "fsspec (>=2022.11.0)", "gcsfs (>=2022.11.0)", "html5lib (>=1.1)", "hypothesis (>=6.46.1)", "jinja2 (>=3.1.2)", "lxml (>=4.9.2)", "matplotlib (>=3.6.3)", "numba (>=0.56.4)", "numexpr (>=2.8.4)", "odfpy (>=1.4.1)", "openpyxl (>=3.1.0)", "pandas-gbq (>=0.19.0)", "psycopg2 (>=2.9.6)", "pyarrow (>=10.0.1)", "pymysql (>=1.0.2)", "pyreadstat (>=1.2.0)", "pytest (>=7.3.2)", "pytest-xdist (>=2.2.0)", "python-calamine (>=0.1.7)", "pyxlsb (>=1.0.10)", "qtpy (>=2.3.0)", "s3fs (>=2022.11.0)", "scipy (>=1.10.0)", "tables (>=3.8.0)", "tabulate (>=0.9.0)", "xarray (>=2022.12.0)", "xlrd (>=2.0.1)", "xlsxwriter (>=3.0.5)", "zstandard (>=0.19.0)"] -aws = ["s3fs (>=2022.11.0)"] -clipboard = ["PyQt5 (>=5.15.9)", "qtpy (>=2.3.0)"] -compression = ["zstandard (>=0.19.0)"] -computation = ["scipy (>=1.10.0)", "xarray (>=2022.12.0)"] -consortium-standard = ["dataframe-api-compat (>=0.1.7)"] -excel = ["odfpy (>=1.4.1)", "openpyxl (>=3.1.0)", "python-calamine (>=0.1.7)", "pyxlsb (>=1.0.10)", "xlrd (>=2.0.1)", "xlsxwriter (>=3.0.5)"] -feather = ["pyarrow (>=10.0.1)"] -fss = ["fsspec (>=2022.11.0)"] -gcp = ["gcsfs (>=2022.11.0)", "pandas-gbq (>=0.19.0)"] -hdf5 = ["tables (>=3.8.0)"] -html = ["beautifulsoup4 (>=4.11.2)", "html5lib (>=1.1)", "lxml (>=4.9.2)"] -mysql = ["SQLAlchemy (>=2.0.0)", "pymysql (>=1.0.2)"] -output-formatting = ["jinja2 (>=3.1.2)", "tabulate (>=0.9.0)"] -parquet = ["pyarrow (>=10.0.1)"] -performance = ["bottleneck (>=1.3.6)", "numba (>=0.56.4)", "numexpr (>=2.8.4)"] -plot = ["matplotlib (>=3.6.3)"] -postgresql = ["SQLAlchemy (>=2.0.0)", "adbc-driver-postgresql (>=0.8.0)", "psycopg2 (>=2.9.6)"] -pyarrow = ["pyarrow (>=10.0.1)"] -spss = ["pyreadstat (>=1.2.0)"] -sql-other = ["SQLAlchemy (>=2.0.0)", "adbc-driver-postgresql (>=0.8.0)", "adbc-driver-sqlite (>=0.8.0)"] -test = ["hypothesis (>=6.46.1)", "pytest (>=7.3.2)", "pytest-xdist (>=2.2.0)"] -xml = ["lxml (>=4.9.2)"] - -[[package]] -name = "pandocfilters" -version = "1.5.1" -description = "Utilities for writing pandoc filters in python" -optional = true -python-versions = ">=2.7, !=3.0.*, !=3.1.*, !=3.2.*, !=3.3.*" -files = [ - {file = "pandocfilters-1.5.1-py2.py3-none-any.whl", hash = "sha256:93be382804a9cdb0a7267585f157e5d1731bbe5545a85b268d6f5fe6232de2bc"}, - {file = "pandocfilters-1.5.1.tar.gz", hash = "sha256:002b4a555ee4ebc03f8b66307e287fa492e4a77b4ea14d3f934328297bb4939e"}, -] - -[[package]] -name = "parso" -version = "0.8.4" -description = "A Python Parser" -optional = true -python-versions = ">=3.6" -files = [ - {file = "parso-0.8.4-py2.py3-none-any.whl", hash = "sha256:a418670a20291dacd2dddc80c377c5c3791378ee1e8d12bffc35420643d43f18"}, - {file = "parso-0.8.4.tar.gz", hash = "sha256:eb3a7b58240fb99099a345571deecc0f9540ea5f4dd2fe14c2a99d6b281ab92d"}, -] - -[package.extras] -qa = ["flake8 (==5.0.4)", "mypy (==0.971)", "types-setuptools (==67.2.0.1)"] -testing = ["docopt", "pytest"] - -[[package]] -name = "patsy" -version = "0.5.6" -description = "A Python package for describing statistical models and for building design matrices." -optional = true -python-versions = "*" -files = [ - {file = "patsy-0.5.6-py2.py3-none-any.whl", hash = "sha256:19056886fd8fa71863fa32f0eb090267f21fb74be00f19f5c70b2e9d76c883c6"}, - {file = "patsy-0.5.6.tar.gz", hash = "sha256:95c6d47a7222535f84bff7f63d7303f2e297747a598db89cf5c67f0c0c7d2cdb"}, -] - -[package.dependencies] -numpy = ">=1.4" -six = "*" - -[package.extras] -test = ["pytest", "pytest-cov", "scipy"] - -[[package]] -name = "pexpect" -version = "4.9.0" -description = "Pexpect allows easy control of interactive console applications." -optional = true -python-versions = "*" -files = [ - {file = "pexpect-4.9.0-py2.py3-none-any.whl", hash = "sha256:7236d1e080e4936be2dc3e326cec0af72acf9212a7e1d060210e70a47e253523"}, - {file = "pexpect-4.9.0.tar.gz", hash = "sha256:ee7d41123f3c9911050ea2c2dac107568dc43b2d3b0c7557a33212c398ead30f"}, -] - -[package.dependencies] -ptyprocess = ">=0.5" - -[[package]] -name = "pillow" -version = "10.3.0" -description = "Python Imaging Library (Fork)" -optional = true -python-versions = ">=3.8" -files = [ - {file = "pillow-10.3.0-cp310-cp310-macosx_10_10_x86_64.whl", hash = "sha256:90b9e29824800e90c84e4022dd5cc16eb2d9605ee13f05d47641eb183cd73d45"}, - {file = "pillow-10.3.0-cp310-cp310-macosx_11_0_arm64.whl", hash = "sha256:a2c405445c79c3f5a124573a051062300936b0281fee57637e706453e452746c"}, - {file = "pillow-10.3.0-cp310-cp310-manylinux_2_17_aarch64.manylinux2014_aarch64.whl", hash = "sha256:78618cdbccaa74d3f88d0ad6cb8ac3007f1a6fa5c6f19af64b55ca170bfa1edf"}, - {file = "pillow-10.3.0-cp310-cp310-manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:261ddb7ca91fcf71757979534fb4c128448b5b4c55cb6152d280312062f69599"}, - {file = "pillow-10.3.0-cp310-cp310-manylinux_2_28_aarch64.whl", hash = "sha256:ce49c67f4ea0609933d01c0731b34b8695a7a748d6c8d186f95e7d085d2fe475"}, - {file = "pillow-10.3.0-cp310-cp310-manylinux_2_28_x86_64.whl", hash = "sha256:b14f16f94cbc61215115b9b1236f9c18403c15dd3c52cf629072afa9d54c1cbf"}, - {file = "pillow-10.3.0-cp310-cp310-musllinux_1_1_aarch64.whl", hash = "sha256:d33891be6df59d93df4d846640f0e46f1a807339f09e79a8040bc887bdcd7ed3"}, - {file = "pillow-10.3.0-cp310-cp310-musllinux_1_1_x86_64.whl", hash = "sha256:b50811d664d392f02f7761621303eba9d1b056fb1868c8cdf4231279645c25f5"}, - {file = "pillow-10.3.0-cp310-cp310-win32.whl", hash = "sha256:ca2870d5d10d8726a27396d3ca4cf7976cec0f3cb706debe88e3a5bd4610f7d2"}, - {file = "pillow-10.3.0-cp310-cp310-win_amd64.whl", hash = "sha256:f0d0591a0aeaefdaf9a5e545e7485f89910c977087e7de2b6c388aec32011e9f"}, - {file = "pillow-10.3.0-cp310-cp310-win_arm64.whl", hash = "sha256:ccce24b7ad89adb5a1e34a6ba96ac2530046763912806ad4c247356a8f33a67b"}, - {file = "pillow-10.3.0-cp311-cp311-macosx_10_10_x86_64.whl", hash = "sha256:5f77cf66e96ae734717d341c145c5949c63180842a545c47a0ce7ae52ca83795"}, - {file = "pillow-10.3.0-cp311-cp311-macosx_11_0_arm64.whl", hash = "sha256:e4b878386c4bf293578b48fc570b84ecfe477d3b77ba39a6e87150af77f40c57"}, - {file = "pillow-10.3.0-cp311-cp311-manylinux_2_17_aarch64.manylinux2014_aarch64.whl", hash = "sha256:fdcbb4068117dfd9ce0138d068ac512843c52295ed996ae6dd1faf537b6dbc27"}, - {file = "pillow-10.3.0-cp311-cp311-manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:9797a6c8fe16f25749b371c02e2ade0efb51155e767a971c61734b1bf6293994"}, - {file = "pillow-10.3.0-cp311-cp311-manylinux_2_28_aarch64.whl", hash = "sha256:9e91179a242bbc99be65e139e30690e081fe6cb91a8e77faf4c409653de39451"}, - {file = "pillow-10.3.0-cp311-cp311-manylinux_2_28_x86_64.whl", hash = "sha256:1b87bd9d81d179bd8ab871603bd80d8645729939f90b71e62914e816a76fc6bd"}, - {file = "pillow-10.3.0-cp311-cp311-musllinux_1_1_aarch64.whl", hash = "sha256:81d09caa7b27ef4e61cb7d8fbf1714f5aec1c6b6c5270ee53504981e6e9121ad"}, - {file = "pillow-10.3.0-cp311-cp311-musllinux_1_1_x86_64.whl", hash = "sha256:048ad577748b9fa4a99a0548c64f2cb8d672d5bf2e643a739ac8faff1164238c"}, - {file = "pillow-10.3.0-cp311-cp311-win32.whl", hash = "sha256:7161ec49ef0800947dc5570f86568a7bb36fa97dd09e9827dc02b718c5643f09"}, - {file = "pillow-10.3.0-cp311-cp311-win_amd64.whl", hash = "sha256:8eb0908e954d093b02a543dc963984d6e99ad2b5e36503d8a0aaf040505f747d"}, - {file = "pillow-10.3.0-cp311-cp311-win_arm64.whl", hash = "sha256:4e6f7d1c414191c1199f8996d3f2282b9ebea0945693fb67392c75a3a320941f"}, - {file = "pillow-10.3.0-cp312-cp312-macosx_10_10_x86_64.whl", hash = "sha256:e46f38133e5a060d46bd630faa4d9fa0202377495df1f068a8299fd78c84de84"}, - {file = "pillow-10.3.0-cp312-cp312-macosx_11_0_arm64.whl", hash = "sha256:50b8eae8f7334ec826d6eeffaeeb00e36b5e24aa0b9df322c247539714c6df19"}, - {file = "pillow-10.3.0-cp312-cp312-manylinux_2_17_aarch64.manylinux2014_aarch64.whl", hash = "sha256:9d3bea1c75f8c53ee4d505c3e67d8c158ad4df0d83170605b50b64025917f338"}, - {file = "pillow-10.3.0-cp312-cp312-manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:19aeb96d43902f0a783946a0a87dbdad5c84c936025b8419da0a0cd7724356b1"}, - {file = "pillow-10.3.0-cp312-cp312-manylinux_2_28_aarch64.whl", hash = "sha256:74d28c17412d9caa1066f7a31df8403ec23d5268ba46cd0ad2c50fb82ae40462"}, - {file = "pillow-10.3.0-cp312-cp312-manylinux_2_28_x86_64.whl", hash = "sha256:ff61bfd9253c3915e6d41c651d5f962da23eda633cf02262990094a18a55371a"}, - {file = "pillow-10.3.0-cp312-cp312-musllinux_1_1_aarch64.whl", hash = "sha256:d886f5d353333b4771d21267c7ecc75b710f1a73d72d03ca06df49b09015a9ef"}, - {file = "pillow-10.3.0-cp312-cp312-musllinux_1_1_x86_64.whl", hash = "sha256:4b5ec25d8b17217d635f8935dbc1b9aa5907962fae29dff220f2659487891cd3"}, - {file = "pillow-10.3.0-cp312-cp312-win32.whl", hash = "sha256:51243f1ed5161b9945011a7360e997729776f6e5d7005ba0c6879267d4c5139d"}, - {file = "pillow-10.3.0-cp312-cp312-win_amd64.whl", hash = "sha256:412444afb8c4c7a6cc11a47dade32982439925537e483be7c0ae0cf96c4f6a0b"}, - {file = "pillow-10.3.0-cp312-cp312-win_arm64.whl", hash = "sha256:798232c92e7665fe82ac085f9d8e8ca98826f8e27859d9a96b41d519ecd2e49a"}, - {file = "pillow-10.3.0-cp38-cp38-macosx_10_10_x86_64.whl", hash = "sha256:4eaa22f0d22b1a7e93ff0a596d57fdede2e550aecffb5a1ef1106aaece48e96b"}, - {file = "pillow-10.3.0-cp38-cp38-macosx_11_0_arm64.whl", hash = "sha256:cd5e14fbf22a87321b24c88669aad3a51ec052eb145315b3da3b7e3cc105b9a2"}, - {file = "pillow-10.3.0-cp38-cp38-manylinux_2_17_aarch64.manylinux2014_aarch64.whl", hash = "sha256:1530e8f3a4b965eb6a7785cf17a426c779333eb62c9a7d1bbcf3ffd5bf77a4aa"}, - {file = "pillow-10.3.0-cp38-cp38-manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:5d512aafa1d32efa014fa041d38868fda85028e3f930a96f85d49c7d8ddc0383"}, - {file = "pillow-10.3.0-cp38-cp38-manylinux_2_28_aarch64.whl", hash = "sha256:339894035d0ede518b16073bdc2feef4c991ee991a29774b33e515f1d308e08d"}, - {file = "pillow-10.3.0-cp38-cp38-manylinux_2_28_x86_64.whl", hash = "sha256:aa7e402ce11f0885305bfb6afb3434b3cd8f53b563ac065452d9d5654c7b86fd"}, - {file = "pillow-10.3.0-cp38-cp38-musllinux_1_1_aarch64.whl", hash = "sha256:0ea2a783a2bdf2a561808fe4a7a12e9aa3799b701ba305de596bc48b8bdfce9d"}, - {file = "pillow-10.3.0-cp38-cp38-musllinux_1_1_x86_64.whl", hash = "sha256:c78e1b00a87ce43bb37642c0812315b411e856a905d58d597750eb79802aaaa3"}, - {file = "pillow-10.3.0-cp38-cp38-win32.whl", hash = "sha256:72d622d262e463dfb7595202d229f5f3ab4b852289a1cd09650362db23b9eb0b"}, - {file = "pillow-10.3.0-cp38-cp38-win_amd64.whl", hash = "sha256:2034f6759a722da3a3dbd91a81148cf884e91d1b747992ca288ab88c1de15999"}, - {file = "pillow-10.3.0-cp39-cp39-macosx_10_10_x86_64.whl", hash = "sha256:2ed854e716a89b1afcedea551cd85f2eb2a807613752ab997b9974aaa0d56936"}, - {file = "pillow-10.3.0-cp39-cp39-macosx_11_0_arm64.whl", hash = "sha256:dc1a390a82755a8c26c9964d457d4c9cbec5405896cba94cf51f36ea0d855002"}, - {file = "pillow-10.3.0-cp39-cp39-manylinux_2_17_aarch64.manylinux2014_aarch64.whl", hash = "sha256:4203efca580f0dd6f882ca211f923168548f7ba334c189e9eab1178ab840bf60"}, - {file = "pillow-10.3.0-cp39-cp39-manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:3102045a10945173d38336f6e71a8dc71bcaeed55c3123ad4af82c52807b9375"}, - {file = "pillow-10.3.0-cp39-cp39-manylinux_2_28_aarch64.whl", hash = "sha256:6fb1b30043271ec92dc65f6d9f0b7a830c210b8a96423074b15c7bc999975f57"}, - {file = "pillow-10.3.0-cp39-cp39-manylinux_2_28_x86_64.whl", hash = "sha256:1dfc94946bc60ea375cc39cff0b8da6c7e5f8fcdc1d946beb8da5c216156ddd8"}, - {file = "pillow-10.3.0-cp39-cp39-musllinux_1_1_aarch64.whl", hash = "sha256:b09b86b27a064c9624d0a6c54da01c1beaf5b6cadfa609cf63789b1d08a797b9"}, - {file = "pillow-10.3.0-cp39-cp39-musllinux_1_1_x86_64.whl", hash = "sha256:d3b2348a78bc939b4fed6552abfd2e7988e0f81443ef3911a4b8498ca084f6eb"}, - {file = "pillow-10.3.0-cp39-cp39-win32.whl", hash = "sha256:45ebc7b45406febf07fef35d856f0293a92e7417ae7933207e90bf9090b70572"}, - {file = "pillow-10.3.0-cp39-cp39-win_amd64.whl", hash = "sha256:0ba26351b137ca4e0db0342d5d00d2e355eb29372c05afd544ebf47c0956ffeb"}, - {file = "pillow-10.3.0-cp39-cp39-win_arm64.whl", hash = "sha256:50fd3f6b26e3441ae07b7c979309638b72abc1a25da31a81a7fbd9495713ef4f"}, - {file = "pillow-10.3.0-pp310-pypy310_pp73-macosx_10_10_x86_64.whl", hash = "sha256:6b02471b72526ab8a18c39cb7967b72d194ec53c1fd0a70b050565a0f366d355"}, - {file = "pillow-10.3.0-pp310-pypy310_pp73-macosx_11_0_arm64.whl", hash = "sha256:8ab74c06ffdab957d7670c2a5a6e1a70181cd10b727cd788c4dd9005b6a8acd9"}, - {file = "pillow-10.3.0-pp310-pypy310_pp73-manylinux_2_17_aarch64.manylinux2014_aarch64.whl", hash = "sha256:048eeade4c33fdf7e08da40ef402e748df113fd0b4584e32c4af74fe78baaeb2"}, - {file = "pillow-10.3.0-pp310-pypy310_pp73-manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:9e2ec1e921fd07c7cda7962bad283acc2f2a9ccc1b971ee4b216b75fad6f0463"}, - {file = "pillow-10.3.0-pp310-pypy310_pp73-manylinux_2_28_aarch64.whl", hash = "sha256:4c8e73e99da7db1b4cad7f8d682cf6abad7844da39834c288fbfa394a47bbced"}, - {file = "pillow-10.3.0-pp310-pypy310_pp73-manylinux_2_28_x86_64.whl", hash = "sha256:16563993329b79513f59142a6b02055e10514c1a8e86dca8b48a893e33cf91e3"}, - {file = "pillow-10.3.0-pp310-pypy310_pp73-win_amd64.whl", hash = "sha256:dd78700f5788ae180b5ee8902c6aea5a5726bac7c364b202b4b3e3ba2d293170"}, - {file = "pillow-10.3.0-pp39-pypy39_pp73-macosx_10_10_x86_64.whl", hash = "sha256:aff76a55a8aa8364d25400a210a65ff59d0168e0b4285ba6bf2bd83cf675ba32"}, - {file = "pillow-10.3.0-pp39-pypy39_pp73-macosx_11_0_arm64.whl", hash = "sha256:b7bc2176354defba3edc2b9a777744462da2f8e921fbaf61e52acb95bafa9828"}, - {file = "pillow-10.3.0-pp39-pypy39_pp73-manylinux_2_17_aarch64.manylinux2014_aarch64.whl", hash = "sha256:793b4e24db2e8742ca6423d3fde8396db336698c55cd34b660663ee9e45ed37f"}, - {file = "pillow-10.3.0-pp39-pypy39_pp73-manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:d93480005693d247f8346bc8ee28c72a2191bdf1f6b5db469c096c0c867ac015"}, - {file = "pillow-10.3.0-pp39-pypy39_pp73-manylinux_2_28_aarch64.whl", hash = "sha256:c83341b89884e2b2e55886e8fbbf37c3fa5efd6c8907124aeb72f285ae5696e5"}, - {file = "pillow-10.3.0-pp39-pypy39_pp73-manylinux_2_28_x86_64.whl", hash = "sha256:1a1d1915db1a4fdb2754b9de292642a39a7fb28f1736699527bb649484fb966a"}, - {file = "pillow-10.3.0-pp39-pypy39_pp73-win_amd64.whl", hash = "sha256:a0eaa93d054751ee9964afa21c06247779b90440ca41d184aeb5d410f20ff591"}, - {file = "pillow-10.3.0.tar.gz", hash = "sha256:9d2455fbf44c914840c793e89aa82d0e1763a14253a000743719ae5946814b2d"}, -] - -[package.extras] -docs = ["furo", "olefile", "sphinx (>=2.4)", "sphinx-copybutton", "sphinx-inline-tabs", "sphinx-removed-in", "sphinxext-opengraph"] -fpx = ["olefile"] -mic = ["olefile"] -tests = ["check-manifest", "coverage", "defusedxml", "markdown2", "olefile", "packaging", "pyroma", "pytest", "pytest-cov", "pytest-timeout"] -typing = ["typing-extensions"] -xmp = ["defusedxml"] - -[[package]] -name = "platformdirs" -version = "4.2.2" -description = "A small Python package for determining appropriate platform-specific dirs, e.g. a `user data dir`." -optional = true -python-versions = ">=3.8" -files = [ - {file = "platformdirs-4.2.2-py3-none-any.whl", hash = "sha256:2d7a1657e36a80ea911db832a8a6ece5ee53d8de21edd5cc5879af6530b1bfee"}, - {file = "platformdirs-4.2.2.tar.gz", hash = "sha256:38b7b51f512eed9e84a22788b4bce1de17c0adb134d6becb09836e37d8654cd3"}, -] - -[package.extras] -docs = ["furo (>=2023.9.10)", "proselint (>=0.13)", "sphinx (>=7.2.6)", "sphinx-autodoc-typehints (>=1.25.2)"] -test = ["appdirs (==1.4.4)", "covdefaults (>=2.3)", "pytest (>=7.4.3)", "pytest-cov (>=4.1)", "pytest-mock (>=3.12)"] -type = ["mypy (>=1.8)"] - -[[package]] -name = "prometheus-client" -version = "0.20.0" -description = "Python client for the Prometheus monitoring system." -optional = true -python-versions = ">=3.8" -files = [ - {file = "prometheus_client-0.20.0-py3-none-any.whl", hash = "sha256:cde524a85bce83ca359cc837f28b8c0db5cac7aa653a588fd7e84ba061c329e7"}, - {file = "prometheus_client-0.20.0.tar.gz", hash = "sha256:287629d00b147a32dcb2be0b9df905da599b2d82f80377083ec8463309a4bb89"}, -] - -[package.extras] -twisted = ["twisted"] - -[[package]] -name = "prompt-toolkit" -version = "3.0.43" -description = "Library for building powerful interactive command lines in Python" -optional = true -python-versions = ">=3.7.0" -files = [ - {file = "prompt_toolkit-3.0.43-py3-none-any.whl", hash = "sha256:a11a29cb3bf0a28a387fe5122cdb649816a957cd9261dcedf8c9f1fef33eacf6"}, - {file = "prompt_toolkit-3.0.43.tar.gz", hash = "sha256:3527b7af26106cbc65a040bcc84839a3566ec1b051bb0bfe953631e704b0ff7d"}, -] - -[package.dependencies] -wcwidth = "*" - -[[package]] -name = "psutil" -version = "5.9.8" -description = "Cross-platform lib for process and system monitoring in Python." -optional = true -python-versions = ">=2.7, !=3.0.*, !=3.1.*, !=3.2.*, !=3.3.*, !=3.4.*, !=3.5.*" -files = [ - {file = "psutil-5.9.8-cp27-cp27m-macosx_10_9_x86_64.whl", hash = "sha256:26bd09967ae00920df88e0352a91cff1a78f8d69b3ecabbfe733610c0af486c8"}, - {file = "psutil-5.9.8-cp27-cp27m-manylinux2010_i686.whl", hash = "sha256:05806de88103b25903dff19bb6692bd2e714ccf9e668d050d144012055cbca73"}, - {file = "psutil-5.9.8-cp27-cp27m-manylinux2010_x86_64.whl", hash = "sha256:611052c4bc70432ec770d5d54f64206aa7203a101ec273a0cd82418c86503bb7"}, - {file = "psutil-5.9.8-cp27-cp27mu-manylinux2010_i686.whl", hash = "sha256:50187900d73c1381ba1454cf40308c2bf6f34268518b3f36a9b663ca87e65e36"}, - {file = "psutil-5.9.8-cp27-cp27mu-manylinux2010_x86_64.whl", hash = "sha256:02615ed8c5ea222323408ceba16c60e99c3f91639b07da6373fb7e6539abc56d"}, - {file = "psutil-5.9.8-cp27-none-win32.whl", hash = "sha256:36f435891adb138ed3c9e58c6af3e2e6ca9ac2f365efe1f9cfef2794e6c93b4e"}, - {file = "psutil-5.9.8-cp27-none-win_amd64.whl", hash = "sha256:bd1184ceb3f87651a67b2708d4c3338e9b10c5df903f2e3776b62303b26cb631"}, - {file = "psutil-5.9.8-cp36-abi3-macosx_10_9_x86_64.whl", hash = "sha256:aee678c8720623dc456fa20659af736241f575d79429a0e5e9cf88ae0605cc81"}, - {file = "psutil-5.9.8-cp36-abi3-manylinux_2_12_i686.manylinux2010_i686.manylinux_2_17_i686.manylinux2014_i686.whl", hash = "sha256:8cb6403ce6d8e047495a701dc7c5bd788add903f8986d523e3e20b98b733e421"}, - {file = "psutil-5.9.8-cp36-abi3-manylinux_2_12_x86_64.manylinux2010_x86_64.manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:d06016f7f8625a1825ba3732081d77c94589dca78b7a3fc072194851e88461a4"}, - {file = "psutil-5.9.8-cp36-cp36m-win32.whl", hash = "sha256:7d79560ad97af658a0f6adfef8b834b53f64746d45b403f225b85c5c2c140eee"}, - {file = "psutil-5.9.8-cp36-cp36m-win_amd64.whl", hash = "sha256:27cc40c3493bb10de1be4b3f07cae4c010ce715290a5be22b98493509c6299e2"}, - {file = "psutil-5.9.8-cp37-abi3-win32.whl", hash = "sha256:bc56c2a1b0d15aa3eaa5a60c9f3f8e3e565303b465dbf57a1b730e7a2b9844e0"}, - {file = "psutil-5.9.8-cp37-abi3-win_amd64.whl", hash = "sha256:8db4c1b57507eef143a15a6884ca10f7c73876cdf5d51e713151c1236a0e68cf"}, - {file = "psutil-5.9.8-cp38-abi3-macosx_11_0_arm64.whl", hash = "sha256:d16bbddf0693323b8c6123dd804100241da461e41d6e332fb0ba6058f630f8c8"}, - {file = "psutil-5.9.8.tar.gz", hash = "sha256:6be126e3225486dff286a8fb9a06246a5253f4c7c53b475ea5f5ac934e64194c"}, -] - -[package.extras] -test = ["enum34", "ipaddress", "mock", "pywin32", "wmi"] - -[[package]] -name = "ptyprocess" -version = "0.7.0" -description = "Run a subprocess in a pseudo terminal" -optional = true -python-versions = "*" -files = [ - {file = "ptyprocess-0.7.0-py2.py3-none-any.whl", hash = "sha256:4b41f3967fce3af57cc7e94b888626c18bf37a083e3651ca8feeb66d492fef35"}, - {file = "ptyprocess-0.7.0.tar.gz", hash = "sha256:5c5d0a3b48ceee0b48485e0c26037c0acd7d29765ca3fbb5cb3831d347423220"}, -] - -[[package]] -name = "pure-eval" -version = "0.2.2" -description = "Safely evaluate AST nodes without side effects" -optional = true -python-versions = "*" -files = [ - {file = "pure_eval-0.2.2-py3-none-any.whl", hash = "sha256:01eaab343580944bc56080ebe0a674b39ec44a945e6d09ba7db3cb8cec289350"}, - {file = "pure_eval-0.2.2.tar.gz", hash = "sha256:2b45320af6dfaa1750f543d714b6d1c520a1688dec6fd24d339063ce0aaa9ac3"}, -] - -[package.extras] -tests = ["pytest"] - -[[package]] -name = "pycparser" -version = "2.22" -description = "C parser in Python" -optional = true -python-versions = ">=3.8" -files = [ - {file = "pycparser-2.22-py3-none-any.whl", hash = "sha256:c3702b6d3dd8c7abc1afa565d7e63d53a1d0bd86cdc24edd75470f4de499cfcc"}, - {file = "pycparser-2.22.tar.gz", hash = "sha256:491c8be9c040f5390f5bf44a5b07752bd07f56edf992381b05c701439eec10f6"}, -] - -[[package]] -name = "pydoe3" -version = "1.0.2" -description = "Design of experiments for Python" -optional = true -python-versions = "*" -files = [ - {file = "pydoe3-1.0.2-py2.py3-none-any.whl", hash = "sha256:09925e3d445f40aa720ed81bb8c816d77aaae80e2521bb285ed07244e17e54e9"}, - {file = "pydoe3-1.0.2.tar.gz", hash = "sha256:69ffd88aa81ef9df6fdf0cc7b64748ee7eb14895939c50dfd22a0e0e6a718df7"}, -] - -[package.dependencies] -numpy = "*" -scipy = "*" - -[[package]] -name = "pygments" -version = "2.18.0" -description = "Pygments is a syntax highlighting package written in Python." -optional = true -python-versions = ">=3.8" -files = [ - {file = "pygments-2.18.0-py3-none-any.whl", hash = "sha256:b8e6aca0523f3ab76fee51799c488e38782ac06eafcf95e7ba832985c8e7b13a"}, - {file = "pygments-2.18.0.tar.gz", hash = "sha256:786ff802f32e91311bff3889f6e9a86e81505fe99f2735bb6d60ae0c5004f199"}, -] - -[package.extras] -windows-terminal = ["colorama (>=0.4.6)"] - -[[package]] -name = "pyparsing" -version = "3.1.2" -description = "pyparsing module - Classes and methods to define and execute parsing grammars" -optional = true -python-versions = ">=3.6.8" -files = [ - {file = "pyparsing-3.1.2-py3-none-any.whl", hash = "sha256:f9db75911801ed778fe61bb643079ff86601aca99fcae6345aa67292038fb742"}, - {file = "pyparsing-3.1.2.tar.gz", hash = "sha256:a1bac0ce561155ecc3ed78ca94d3c9378656ad4c94c1270de543f621420f94ad"}, -] - -[package.extras] -diagrams = ["jinja2", "railroad-diagrams"] - -[[package]] -name = "python-benedict" -version = "0.33.2" -description = "python-benedict is a dict subclass with keylist/keypath/keyattr support, normalized I/O operations (base64, csv, ini, json, pickle, plist, query-string, toml, xls, xml, yaml) and many utilities... for humans, obviously." -optional = true -python-versions = "*" -files = [ - {file = "python-benedict-0.33.2.tar.gz", hash = "sha256:662de43bffb4e127da2056447f8ddd7f6f5c89b72dd66d289cf9abd1cc2720c8"}, - {file = "python_benedict-0.33.2-py3-none-any.whl", hash = "sha256:50a69b601b34d4ad7b67fe94e3266ec05046bc547a4132fe43fd8fbd41aeefaa"}, -] - -[package.dependencies] -python-fsutil = ">=0.9.3,<1.0.0" -python-slugify = ">=7.0.0,<9.0.0" -requests = ">=2.26.0,<3.0.0" - -[package.extras] -all = ["python-benedict[io,parse,s3]"] -html = ["beautifulsoup4 (>=4.12.0,<5.0.0)", "python-benedict[xml]"] -io = ["python-benedict[html,toml,xls,xml,yaml]"] -parse = ["ftfy (>=6.0.0,<7.0.0)", "mailchecker (>=4.1.0,<7.0.0)", "phonenumbers (>=8.12.0,<9.0.0)", "python-dateutil (>=2.8.0,<3.0.0)"] -s3 = ["boto3 (>=1.24.89,<2.0.0)"] -toml = ["toml (>=0.10.2,<1.0.0)"] -xls = ["openpyxl (>=3.0.0,<4.0.0)", "xlrd (>=2.0.0,<3.0.0)"] -xml = ["xmltodict (>=0.12.0,<1.0.0)"] -yaml = ["pyyaml (>=6.0,<7.0)"] - -[[package]] -name = "python-dateutil" -version = "2.9.0.post0" -description = "Extensions to the standard Python datetime module" -optional = false -python-versions = "!=3.0.*,!=3.1.*,!=3.2.*,>=2.7" -files = [ - {file = "python-dateutil-2.9.0.post0.tar.gz", hash = "sha256:37dd54208da7e1cd875388217d5e00ebd4179249f90fb72437e91a35459a0ad3"}, - {file = "python_dateutil-2.9.0.post0-py2.py3-none-any.whl", hash = "sha256:a8b2bc7bffae282281c8140a97d3aa9c14da0b136dfe83f850eea9a5f7470427"}, -] - -[package.dependencies] -six = ">=1.5" - -[[package]] -name = "python-fsutil" -version = "0.14.1" -description = "high-level file-system operations for lazy devs." -optional = true -python-versions = "*" -files = [ - {file = "python-fsutil-0.14.1.tar.gz", hash = "sha256:8fb204fa8059f37bdeee8a1dc0fff010170202ea47c4225ee71bb3c26f3997be"}, - {file = "python_fsutil-0.14.1-py3-none-any.whl", hash = "sha256:0d45e623f0f4403f674bdd8ae7aa7d24a4b3132ea45c65416bd2865e6b20b035"}, -] - -[[package]] -name = "python-json-logger" -version = "2.0.7" -description = "A python library adding a json log formatter" -optional = true -python-versions = ">=3.6" -files = [ - {file = "python-json-logger-2.0.7.tar.gz", hash = "sha256:23e7ec02d34237c5aa1e29a070193a4ea87583bb4e7f8fd06d3de8264c4b2e1c"}, - {file = "python_json_logger-2.0.7-py3-none-any.whl", hash = "sha256:f380b826a991ebbe3de4d897aeec42760035ac760345e57b812938dc8b35e2bd"}, -] - -[[package]] -name = "python-slugify" -version = "8.0.4" -description = "A Python slugify application that also handles Unicode" -optional = true -python-versions = ">=3.7" -files = [ - {file = "python-slugify-8.0.4.tar.gz", hash = "sha256:59202371d1d05b54a9e7720c5e038f928f45daaffe41dd10822f3907b937c856"}, - {file = "python_slugify-8.0.4-py2.py3-none-any.whl", hash = "sha256:276540b79961052b66b7d116620b36518847f52d5fd9e3a70164fc8c50faa6b8"}, -] - -[package.dependencies] -text-unidecode = ">=1.3" - -[package.extras] -unidecode = ["Unidecode (>=1.1.1)"] - -[[package]] -name = "pytz" -version = "2024.1" -description = "World timezone definitions, modern and historical" -optional = false -python-versions = "*" -files = [ - {file = "pytz-2024.1-py2.py3-none-any.whl", hash = "sha256:328171f4e3623139da4983451950b28e95ac706e13f3f2630a879749e7a8b319"}, - {file = "pytz-2024.1.tar.gz", hash = "sha256:2a29735ea9c18baf14b448846bde5a48030ed267578472d8955cd0e7443a9812"}, -] - -[[package]] -name = "pywin32" -version = "306" -description = "Python for Window Extensions" -optional = true -python-versions = "*" -files = [ - {file = "pywin32-306-cp310-cp310-win32.whl", hash = "sha256:06d3420a5155ba65f0b72f2699b5bacf3109f36acbe8923765c22938a69dfc8d"}, - {file = "pywin32-306-cp310-cp310-win_amd64.whl", hash = "sha256:84f4471dbca1887ea3803d8848a1616429ac94a4a8d05f4bc9c5dcfd42ca99c8"}, - {file = "pywin32-306-cp311-cp311-win32.whl", hash = "sha256:e65028133d15b64d2ed8f06dd9fbc268352478d4f9289e69c190ecd6818b6407"}, - {file = "pywin32-306-cp311-cp311-win_amd64.whl", hash = "sha256:a7639f51c184c0272e93f244eb24dafca9b1855707d94c192d4a0b4c01e1100e"}, - {file = "pywin32-306-cp311-cp311-win_arm64.whl", hash = "sha256:70dba0c913d19f942a2db25217d9a1b726c278f483a919f1abfed79c9cf64d3a"}, - {file = "pywin32-306-cp312-cp312-win32.whl", hash = "sha256:383229d515657f4e3ed1343da8be101000562bf514591ff383ae940cad65458b"}, - {file = "pywin32-306-cp312-cp312-win_amd64.whl", hash = "sha256:37257794c1ad39ee9be652da0462dc2e394c8159dfd913a8a4e8eb6fd346da0e"}, - {file = "pywin32-306-cp312-cp312-win_arm64.whl", hash = "sha256:5821ec52f6d321aa59e2db7e0a35b997de60c201943557d108af9d4ae1ec7040"}, - {file = "pywin32-306-cp37-cp37m-win32.whl", hash = "sha256:1c73ea9a0d2283d889001998059f5eaaba3b6238f767c9cf2833b13e6a685f65"}, - {file = "pywin32-306-cp37-cp37m-win_amd64.whl", hash = "sha256:72c5f621542d7bdd4fdb716227be0dd3f8565c11b280be6315b06ace35487d36"}, - {file = "pywin32-306-cp38-cp38-win32.whl", hash = "sha256:e4c092e2589b5cf0d365849e73e02c391c1349958c5ac3e9d5ccb9a28e017b3a"}, - {file = "pywin32-306-cp38-cp38-win_amd64.whl", hash = "sha256:e8ac1ae3601bee6ca9f7cb4b5363bf1c0badb935ef243c4733ff9a393b1690c0"}, - {file = "pywin32-306-cp39-cp39-win32.whl", hash = "sha256:e25fd5b485b55ac9c057f67d94bc203f3f6595078d1fb3b458c9c28b7153a802"}, - {file = "pywin32-306-cp39-cp39-win_amd64.whl", hash = "sha256:39b61c15272833b5c329a2989999dcae836b1eed650252ab1b7bfbe1d59f30f4"}, -] - -[[package]] -name = "pywinpty" -version = "2.0.13" -description = "Pseudo terminal support for Windows from Python." -optional = true -python-versions = ">=3.8" -files = [ - {file = "pywinpty-2.0.13-cp310-none-win_amd64.whl", hash = "sha256:697bff211fb5a6508fee2dc6ff174ce03f34a9a233df9d8b5fe9c8ce4d5eaf56"}, - {file = "pywinpty-2.0.13-cp311-none-win_amd64.whl", hash = "sha256:b96fb14698db1284db84ca38c79f15b4cfdc3172065b5137383910567591fa99"}, - {file = "pywinpty-2.0.13-cp312-none-win_amd64.whl", hash = "sha256:2fd876b82ca750bb1333236ce98488c1be96b08f4f7647cfdf4129dfad83c2d4"}, - {file = "pywinpty-2.0.13-cp38-none-win_amd64.whl", hash = "sha256:61d420c2116c0212808d31625611b51caf621fe67f8a6377e2e8b617ea1c1f7d"}, - {file = "pywinpty-2.0.13-cp39-none-win_amd64.whl", hash = "sha256:71cb613a9ee24174730ac7ae439fd179ca34ccb8c5349e8d7b72ab5dea2c6f4b"}, - {file = "pywinpty-2.0.13.tar.gz", hash = "sha256:c34e32351a3313ddd0d7da23d27f835c860d32fe4ac814d372a3ea9594f41dde"}, -] - -[[package]] -name = "pyyaml" -version = "6.0.1" -description = "YAML parser and emitter for Python" -optional = true -python-versions = ">=3.6" -files = [ - {file = "PyYAML-6.0.1-cp310-cp310-macosx_10_9_x86_64.whl", hash = "sha256:d858aa552c999bc8a8d57426ed01e40bef403cd8ccdd0fc5f6f04a00414cac2a"}, - {file = "PyYAML-6.0.1-cp310-cp310-macosx_11_0_arm64.whl", hash = "sha256:fd66fc5d0da6d9815ba2cebeb4205f95818ff4b79c3ebe268e75d961704af52f"}, - {file = "PyYAML-6.0.1-cp310-cp310-manylinux_2_17_aarch64.manylinux2014_aarch64.whl", hash = "sha256:69b023b2b4daa7548bcfbd4aa3da05b3a74b772db9e23b982788168117739938"}, - {file = "PyYAML-6.0.1-cp310-cp310-manylinux_2_17_s390x.manylinux2014_s390x.whl", hash = "sha256:81e0b275a9ecc9c0c0c07b4b90ba548307583c125f54d5b6946cfee6360c733d"}, - {file = "PyYAML-6.0.1-cp310-cp310-manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:ba336e390cd8e4d1739f42dfe9bb83a3cc2e80f567d8805e11b46f4a943f5515"}, - {file = "PyYAML-6.0.1-cp310-cp310-musllinux_1_1_x86_64.whl", hash = "sha256:326c013efe8048858a6d312ddd31d56e468118ad4cdeda36c719bf5bb6192290"}, - {file = "PyYAML-6.0.1-cp310-cp310-win32.whl", hash = "sha256:bd4af7373a854424dabd882decdc5579653d7868b8fb26dc7d0e99f823aa5924"}, - {file = "PyYAML-6.0.1-cp310-cp310-win_amd64.whl", hash = "sha256:fd1592b3fdf65fff2ad0004b5e363300ef59ced41c2e6b3a99d4089fa8c5435d"}, - {file = "PyYAML-6.0.1-cp311-cp311-macosx_10_9_x86_64.whl", hash = "sha256:6965a7bc3cf88e5a1c3bd2e0b5c22f8d677dc88a455344035f03399034eb3007"}, - {file = "PyYAML-6.0.1-cp311-cp311-macosx_11_0_arm64.whl", hash = "sha256:f003ed9ad21d6a4713f0a9b5a7a0a79e08dd0f221aff4525a2be4c346ee60aab"}, - {file = "PyYAML-6.0.1-cp311-cp311-manylinux_2_17_aarch64.manylinux2014_aarch64.whl", hash = "sha256:42f8152b8dbc4fe7d96729ec2b99c7097d656dc1213a3229ca5383f973a5ed6d"}, - {file = "PyYAML-6.0.1-cp311-cp311-manylinux_2_17_s390x.manylinux2014_s390x.whl", hash = "sha256:062582fca9fabdd2c8b54a3ef1c978d786e0f6b3a1510e0ac93ef59e0ddae2bc"}, - {file = "PyYAML-6.0.1-cp311-cp311-manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:d2b04aac4d386b172d5b9692e2d2da8de7bfb6c387fa4f801fbf6fb2e6ba4673"}, - {file = "PyYAML-6.0.1-cp311-cp311-musllinux_1_1_x86_64.whl", hash = "sha256:e7d73685e87afe9f3b36c799222440d6cf362062f78be1013661b00c5c6f678b"}, - {file = "PyYAML-6.0.1-cp311-cp311-win32.whl", hash = "sha256:1635fd110e8d85d55237ab316b5b011de701ea0f29d07611174a1b42f1444741"}, - {file = "PyYAML-6.0.1-cp311-cp311-win_amd64.whl", hash = "sha256:bf07ee2fef7014951eeb99f56f39c9bb4af143d8aa3c21b1677805985307da34"}, - {file = "PyYAML-6.0.1-cp312-cp312-macosx_10_9_x86_64.whl", hash = "sha256:855fb52b0dc35af121542a76b9a84f8d1cd886ea97c84703eaa6d88e37a2ad28"}, - {file = "PyYAML-6.0.1-cp312-cp312-macosx_11_0_arm64.whl", hash = "sha256:40df9b996c2b73138957fe23a16a4f0ba614f4c0efce1e9406a184b6d07fa3a9"}, - {file = "PyYAML-6.0.1-cp312-cp312-manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:6c22bec3fbe2524cde73d7ada88f6566758a8f7227bfbf93a408a9d86bcc12a0"}, - {file = "PyYAML-6.0.1-cp312-cp312-musllinux_1_1_x86_64.whl", hash = "sha256:8d4e9c88387b0f5c7d5f281e55304de64cf7f9c0021a3525bd3b1c542da3b0e4"}, - {file = "PyYAML-6.0.1-cp312-cp312-win32.whl", hash = "sha256:d483d2cdf104e7c9fa60c544d92981f12ad66a457afae824d146093b8c294c54"}, - {file = "PyYAML-6.0.1-cp312-cp312-win_amd64.whl", hash = "sha256:0d3304d8c0adc42be59c5f8a4d9e3d7379e6955ad754aa9d6ab7a398b59dd1df"}, - {file = "PyYAML-6.0.1-cp36-cp36m-macosx_10_9_x86_64.whl", hash = "sha256:50550eb667afee136e9a77d6dc71ae76a44df8b3e51e41b77f6de2932bfe0f47"}, - {file = "PyYAML-6.0.1-cp36-cp36m-manylinux_2_17_aarch64.manylinux2014_aarch64.whl", hash = "sha256:1fe35611261b29bd1de0070f0b2f47cb6ff71fa6595c077e42bd0c419fa27b98"}, - {file = "PyYAML-6.0.1-cp36-cp36m-manylinux_2_17_s390x.manylinux2014_s390x.whl", hash = "sha256:704219a11b772aea0d8ecd7058d0082713c3562b4e271b849ad7dc4a5c90c13c"}, - {file = "PyYAML-6.0.1-cp36-cp36m-manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:afd7e57eddb1a54f0f1a974bc4391af8bcce0b444685d936840f125cf046d5bd"}, - {file = "PyYAML-6.0.1-cp36-cp36m-win32.whl", hash = "sha256:fca0e3a251908a499833aa292323f32437106001d436eca0e6e7833256674585"}, - {file = "PyYAML-6.0.1-cp36-cp36m-win_amd64.whl", hash = "sha256:f22ac1c3cac4dbc50079e965eba2c1058622631e526bd9afd45fedd49ba781fa"}, - {file = "PyYAML-6.0.1-cp37-cp37m-macosx_10_9_x86_64.whl", hash = "sha256:b1275ad35a5d18c62a7220633c913e1b42d44b46ee12554e5fd39c70a243d6a3"}, - {file = "PyYAML-6.0.1-cp37-cp37m-manylinux_2_17_aarch64.manylinux2014_aarch64.whl", hash = "sha256:18aeb1bf9a78867dc38b259769503436b7c72f7a1f1f4c93ff9a17de54319b27"}, - {file = "PyYAML-6.0.1-cp37-cp37m-manylinux_2_17_s390x.manylinux2014_s390x.whl", hash = "sha256:596106435fa6ad000c2991a98fa58eeb8656ef2325d7e158344fb33864ed87e3"}, - {file = "PyYAML-6.0.1-cp37-cp37m-manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:baa90d3f661d43131ca170712d903e6295d1f7a0f595074f151c0aed377c9b9c"}, - {file = "PyYAML-6.0.1-cp37-cp37m-win32.whl", hash = "sha256:9046c58c4395dff28dd494285c82ba00b546adfc7ef001486fbf0324bc174fba"}, - {file = "PyYAML-6.0.1-cp37-cp37m-win_amd64.whl", hash = "sha256:4fb147e7a67ef577a588a0e2c17b6db51dda102c71de36f8549b6816a96e1867"}, - {file = "PyYAML-6.0.1-cp38-cp38-macosx_10_9_x86_64.whl", hash = "sha256:1d4c7e777c441b20e32f52bd377e0c409713e8bb1386e1099c2415f26e479595"}, - {file = "PyYAML-6.0.1-cp38-cp38-manylinux_2_17_aarch64.manylinux2014_aarch64.whl", hash = "sha256:a0cd17c15d3bb3fa06978b4e8958dcdc6e0174ccea823003a106c7d4d7899ac5"}, - {file = "PyYAML-6.0.1-cp38-cp38-manylinux_2_17_s390x.manylinux2014_s390x.whl", hash = "sha256:28c119d996beec18c05208a8bd78cbe4007878c6dd15091efb73a30e90539696"}, - {file = "PyYAML-6.0.1-cp38-cp38-manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:7e07cbde391ba96ab58e532ff4803f79c4129397514e1413a7dc761ccd755735"}, - {file = "PyYAML-6.0.1-cp38-cp38-musllinux_1_1_x86_64.whl", hash = "sha256:49a183be227561de579b4a36efbb21b3eab9651dd81b1858589f796549873dd6"}, - {file = "PyYAML-6.0.1-cp38-cp38-win32.whl", hash = "sha256:184c5108a2aca3c5b3d3bf9395d50893a7ab82a38004c8f61c258d4428e80206"}, - {file = "PyYAML-6.0.1-cp38-cp38-win_amd64.whl", hash = "sha256:1e2722cc9fbb45d9b87631ac70924c11d3a401b2d7f410cc0e3bbf249f2dca62"}, - {file = "PyYAML-6.0.1-cp39-cp39-macosx_10_9_x86_64.whl", hash = "sha256:9eb6caa9a297fc2c2fb8862bc5370d0303ddba53ba97e71f08023b6cd73d16a8"}, - {file = "PyYAML-6.0.1-cp39-cp39-macosx_11_0_arm64.whl", hash = "sha256:c8098ddcc2a85b61647b2590f825f3db38891662cfc2fc776415143f599bb859"}, - {file = "PyYAML-6.0.1-cp39-cp39-manylinux_2_17_aarch64.manylinux2014_aarch64.whl", hash = "sha256:5773183b6446b2c99bb77e77595dd486303b4faab2b086e7b17bc6bef28865f6"}, - {file = "PyYAML-6.0.1-cp39-cp39-manylinux_2_17_s390x.manylinux2014_s390x.whl", hash = "sha256:b786eecbdf8499b9ca1d697215862083bd6d2a99965554781d0d8d1ad31e13a0"}, - {file = "PyYAML-6.0.1-cp39-cp39-manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:bc1bf2925a1ecd43da378f4db9e4f799775d6367bdb94671027b73b393a7c42c"}, - {file = "PyYAML-6.0.1-cp39-cp39-musllinux_1_1_x86_64.whl", hash = "sha256:04ac92ad1925b2cff1db0cfebffb6ffc43457495c9b3c39d3fcae417d7125dc5"}, - {file = "PyYAML-6.0.1-cp39-cp39-win32.whl", hash = "sha256:faca3bdcf85b2fc05d06ff3fbc1f83e1391b3e724afa3feba7d13eeab355484c"}, - {file = "PyYAML-6.0.1-cp39-cp39-win_amd64.whl", hash = "sha256:510c9deebc5c0225e8c96813043e62b680ba2f9c50a08d3724c7f28a747d1486"}, - {file = "PyYAML-6.0.1.tar.gz", hash = "sha256:bfdf460b1736c775f2ba9f6a92bca30bc2095067b8a9d77876d1fad6cc3b4a43"}, -] - -[[package]] -name = "pyzmq" -version = "26.0.3" -description = "Python bindings for 0MQ" -optional = true -python-versions = ">=3.7" -files = [ - {file = "pyzmq-26.0.3-cp310-cp310-macosx_10_15_universal2.whl", hash = "sha256:44dd6fc3034f1eaa72ece33588867df9e006a7303725a12d64c3dff92330f625"}, - {file = "pyzmq-26.0.3-cp310-cp310-macosx_10_9_x86_64.whl", hash = "sha256:acb704195a71ac5ea5ecf2811c9ee19ecdc62b91878528302dd0be1b9451cc90"}, - {file = "pyzmq-26.0.3-cp310-cp310-manylinux_2_17_aarch64.manylinux2014_aarch64.whl", hash = "sha256:5dbb9c997932473a27afa93954bb77a9f9b786b4ccf718d903f35da3232317de"}, - {file = "pyzmq-26.0.3-cp310-cp310-manylinux_2_17_i686.manylinux2014_i686.whl", hash = "sha256:6bcb34f869d431799c3ee7d516554797f7760cb2198ecaa89c3f176f72d062be"}, - {file = "pyzmq-26.0.3-cp310-cp310-manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:38ece17ec5f20d7d9b442e5174ae9f020365d01ba7c112205a4d59cf19dc38ee"}, - {file = "pyzmq-26.0.3-cp310-cp310-manylinux_2_28_x86_64.whl", hash = "sha256:ba6e5e6588e49139a0979d03a7deb9c734bde647b9a8808f26acf9c547cab1bf"}, - {file = "pyzmq-26.0.3-cp310-cp310-musllinux_1_1_aarch64.whl", hash = "sha256:3bf8b000a4e2967e6dfdd8656cd0757d18c7e5ce3d16339e550bd462f4857e59"}, - {file = "pyzmq-26.0.3-cp310-cp310-musllinux_1_1_i686.whl", hash = "sha256:2136f64fbb86451dbbf70223635a468272dd20075f988a102bf8a3f194a411dc"}, - {file = "pyzmq-26.0.3-cp310-cp310-musllinux_1_1_x86_64.whl", hash = "sha256:e8918973fbd34e7814f59143c5f600ecd38b8038161239fd1a3d33d5817a38b8"}, - {file = "pyzmq-26.0.3-cp310-cp310-win32.whl", hash = "sha256:0aaf982e68a7ac284377d051c742610220fd06d330dcd4c4dbb4cdd77c22a537"}, - {file = "pyzmq-26.0.3-cp310-cp310-win_amd64.whl", hash = "sha256:f1a9b7d00fdf60b4039f4455afd031fe85ee8305b019334b72dcf73c567edc47"}, - {file = "pyzmq-26.0.3-cp310-cp310-win_arm64.whl", hash = "sha256:80b12f25d805a919d53efc0a5ad7c0c0326f13b4eae981a5d7b7cc343318ebb7"}, - {file = "pyzmq-26.0.3-cp311-cp311-macosx_10_15_universal2.whl", hash = "sha256:a72a84570f84c374b4c287183debc776dc319d3e8ce6b6a0041ce2e400de3f32"}, - {file = "pyzmq-26.0.3-cp311-cp311-macosx_10_9_x86_64.whl", hash = "sha256:7ca684ee649b55fd8f378127ac8462fb6c85f251c2fb027eb3c887e8ee347bcd"}, - {file = "pyzmq-26.0.3-cp311-cp311-manylinux_2_17_aarch64.manylinux2014_aarch64.whl", hash = "sha256:e222562dc0f38571c8b1ffdae9d7adb866363134299264a1958d077800b193b7"}, - {file = "pyzmq-26.0.3-cp311-cp311-manylinux_2_17_i686.manylinux2014_i686.whl", hash = "sha256:f17cde1db0754c35a91ac00b22b25c11da6eec5746431d6e5092f0cd31a3fea9"}, - {file = "pyzmq-26.0.3-cp311-cp311-manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:4b7c0c0b3244bb2275abe255d4a30c050d541c6cb18b870975553f1fb6f37527"}, - {file = "pyzmq-26.0.3-cp311-cp311-manylinux_2_28_x86_64.whl", hash = "sha256:ac97a21de3712afe6a6c071abfad40a6224fd14fa6ff0ff8d0c6e6cd4e2f807a"}, - {file = "pyzmq-26.0.3-cp311-cp311-musllinux_1_1_aarch64.whl", hash = "sha256:88b88282e55fa39dd556d7fc04160bcf39dea015f78e0cecec8ff4f06c1fc2b5"}, - {file = "pyzmq-26.0.3-cp311-cp311-musllinux_1_1_i686.whl", hash = "sha256:72b67f966b57dbd18dcc7efbc1c7fc9f5f983e572db1877081f075004614fcdd"}, - {file = "pyzmq-26.0.3-cp311-cp311-musllinux_1_1_x86_64.whl", hash = "sha256:f4b6cecbbf3b7380f3b61de3a7b93cb721125dc125c854c14ddc91225ba52f83"}, - {file = "pyzmq-26.0.3-cp311-cp311-win32.whl", hash = "sha256:eed56b6a39216d31ff8cd2f1d048b5bf1700e4b32a01b14379c3b6dde9ce3aa3"}, - {file = "pyzmq-26.0.3-cp311-cp311-win_amd64.whl", hash = "sha256:3191d312c73e3cfd0f0afdf51df8405aafeb0bad71e7ed8f68b24b63c4f36500"}, - {file = "pyzmq-26.0.3-cp311-cp311-win_arm64.whl", hash = "sha256:b6907da3017ef55139cf0e417c5123a84c7332520e73a6902ff1f79046cd3b94"}, - {file = "pyzmq-26.0.3-cp312-cp312-macosx_10_15_universal2.whl", hash = "sha256:068ca17214038ae986d68f4a7021f97e187ed278ab6dccb79f837d765a54d753"}, - {file = "pyzmq-26.0.3-cp312-cp312-macosx_10_9_x86_64.whl", hash = "sha256:7821d44fe07335bea256b9f1f41474a642ca55fa671dfd9f00af8d68a920c2d4"}, - {file = "pyzmq-26.0.3-cp312-cp312-manylinux_2_17_aarch64.manylinux2014_aarch64.whl", hash = "sha256:eeb438a26d87c123bb318e5f2b3d86a36060b01f22fbdffd8cf247d52f7c9a2b"}, - {file = "pyzmq-26.0.3-cp312-cp312-manylinux_2_17_i686.manylinux2014_i686.whl", hash = "sha256:69ea9d6d9baa25a4dc9cef5e2b77b8537827b122214f210dd925132e34ae9b12"}, - {file = "pyzmq-26.0.3-cp312-cp312-manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:7daa3e1369355766dea11f1d8ef829905c3b9da886ea3152788dc25ee6079e02"}, - {file = "pyzmq-26.0.3-cp312-cp312-manylinux_2_28_x86_64.whl", hash = "sha256:6ca7a9a06b52d0e38ccf6bca1aeff7be178917893f3883f37b75589d42c4ac20"}, - {file = "pyzmq-26.0.3-cp312-cp312-musllinux_1_1_aarch64.whl", hash = "sha256:1b7d0e124948daa4d9686d421ef5087c0516bc6179fdcf8828b8444f8e461a77"}, - {file = "pyzmq-26.0.3-cp312-cp312-musllinux_1_1_i686.whl", hash = "sha256:e746524418b70f38550f2190eeee834db8850088c834d4c8406fbb9bc1ae10b2"}, - {file = "pyzmq-26.0.3-cp312-cp312-musllinux_1_1_x86_64.whl", hash = "sha256:6b3146f9ae6af82c47a5282ac8803523d381b3b21caeae0327ed2f7ecb718798"}, - {file = "pyzmq-26.0.3-cp312-cp312-win32.whl", hash = "sha256:2b291d1230845871c00c8462c50565a9cd6026fe1228e77ca934470bb7d70ea0"}, - {file = "pyzmq-26.0.3-cp312-cp312-win_amd64.whl", hash = "sha256:926838a535c2c1ea21c903f909a9a54e675c2126728c21381a94ddf37c3cbddf"}, - {file = "pyzmq-26.0.3-cp312-cp312-win_arm64.whl", hash = "sha256:5bf6c237f8c681dfb91b17f8435b2735951f0d1fad10cc5dfd96db110243370b"}, - {file = "pyzmq-26.0.3-cp37-cp37m-macosx_10_9_x86_64.whl", hash = "sha256:0c0991f5a96a8e620f7691e61178cd8f457b49e17b7d9cfa2067e2a0a89fc1d5"}, - {file = "pyzmq-26.0.3-cp37-cp37m-manylinux_2_12_i686.manylinux2010_i686.whl", hash = "sha256:dbf012d8fcb9f2cf0643b65df3b355fdd74fc0035d70bb5c845e9e30a3a4654b"}, - {file = "pyzmq-26.0.3-cp37-cp37m-manylinux_2_12_x86_64.manylinux2010_x86_64.whl", hash = "sha256:01fbfbeb8249a68d257f601deb50c70c929dc2dfe683b754659569e502fbd3aa"}, - {file = "pyzmq-26.0.3-cp37-cp37m-manylinux_2_17_aarch64.manylinux2014_aarch64.whl", hash = "sha256:1c8eb19abe87029c18f226d42b8a2c9efdd139d08f8bf6e085dd9075446db450"}, - {file = "pyzmq-26.0.3-cp37-cp37m-musllinux_1_1_aarch64.whl", hash = "sha256:5344b896e79800af86ad643408ca9aa303a017f6ebff8cee5a3163c1e9aec987"}, - {file = "pyzmq-26.0.3-cp37-cp37m-musllinux_1_1_i686.whl", hash = "sha256:204e0f176fd1d067671157d049466869b3ae1fc51e354708b0dc41cf94e23a3a"}, - {file = "pyzmq-26.0.3-cp37-cp37m-musllinux_1_1_x86_64.whl", hash = "sha256:a42db008d58530efa3b881eeee4991146de0b790e095f7ae43ba5cc612decbc5"}, - {file = "pyzmq-26.0.3-cp37-cp37m-win32.whl", hash = "sha256:8d7a498671ca87e32b54cb47c82a92b40130a26c5197d392720a1bce1b3c77cf"}, - {file = "pyzmq-26.0.3-cp37-cp37m-win_amd64.whl", hash = "sha256:3b4032a96410bdc760061b14ed6a33613ffb7f702181ba999df5d16fb96ba16a"}, - {file = "pyzmq-26.0.3-cp38-cp38-macosx_10_15_universal2.whl", hash = "sha256:2cc4e280098c1b192c42a849de8de2c8e0f3a84086a76ec5b07bfee29bda7d18"}, - {file = "pyzmq-26.0.3-cp38-cp38-macosx_10_9_x86_64.whl", hash = "sha256:5bde86a2ed3ce587fa2b207424ce15b9a83a9fa14422dcc1c5356a13aed3df9d"}, - {file = "pyzmq-26.0.3-cp38-cp38-manylinux_2_12_i686.manylinux2010_i686.whl", hash = "sha256:34106f68e20e6ff253c9f596ea50397dbd8699828d55e8fa18bd4323d8d966e6"}, - {file = "pyzmq-26.0.3-cp38-cp38-manylinux_2_12_x86_64.manylinux2010_x86_64.whl", hash = "sha256:ebbbd0e728af5db9b04e56389e2299a57ea8b9dd15c9759153ee2455b32be6ad"}, - {file = "pyzmq-26.0.3-cp38-cp38-manylinux_2_17_aarch64.manylinux2014_aarch64.whl", hash = "sha256:f6b1d1c631e5940cac5a0b22c5379c86e8df6a4ec277c7a856b714021ab6cfad"}, - {file = "pyzmq-26.0.3-cp38-cp38-musllinux_1_1_aarch64.whl", hash = "sha256:e891ce81edd463b3b4c3b885c5603c00141151dd9c6936d98a680c8c72fe5c67"}, - {file = "pyzmq-26.0.3-cp38-cp38-musllinux_1_1_i686.whl", hash = "sha256:9b273ecfbc590a1b98f014ae41e5cf723932f3b53ba9367cfb676f838038b32c"}, - {file = "pyzmq-26.0.3-cp38-cp38-musllinux_1_1_x86_64.whl", hash = "sha256:b32bff85fb02a75ea0b68f21e2412255b5731f3f389ed9aecc13a6752f58ac97"}, - {file = "pyzmq-26.0.3-cp38-cp38-win32.whl", hash = "sha256:f6c21c00478a7bea93caaaef9e7629145d4153b15a8653e8bb4609d4bc70dbfc"}, - {file = "pyzmq-26.0.3-cp38-cp38-win_amd64.whl", hash = "sha256:3401613148d93ef0fd9aabdbddb212de3db7a4475367f49f590c837355343972"}, - {file = "pyzmq-26.0.3-cp39-cp39-macosx_10_15_universal2.whl", hash = "sha256:2ed8357f4c6e0daa4f3baf31832df8a33334e0fe5b020a61bc8b345a3db7a606"}, - {file = "pyzmq-26.0.3-cp39-cp39-macosx_10_9_x86_64.whl", hash = "sha256:c1c8f2a2ca45292084c75bb6d3a25545cff0ed931ed228d3a1810ae3758f975f"}, - {file = "pyzmq-26.0.3-cp39-cp39-manylinux_2_12_i686.manylinux2010_i686.whl", hash = "sha256:b63731993cdddcc8e087c64e9cf003f909262b359110070183d7f3025d1c56b5"}, - {file = "pyzmq-26.0.3-cp39-cp39-manylinux_2_12_x86_64.manylinux2010_x86_64.whl", hash = "sha256:b3cd31f859b662ac5d7f4226ec7d8bd60384fa037fc02aee6ff0b53ba29a3ba8"}, - {file = "pyzmq-26.0.3-cp39-cp39-manylinux_2_17_aarch64.manylinux2014_aarch64.whl", hash = "sha256:115f8359402fa527cf47708d6f8a0f8234f0e9ca0cab7c18c9c189c194dbf620"}, - {file = "pyzmq-26.0.3-cp39-cp39-musllinux_1_1_aarch64.whl", hash = "sha256:715bdf952b9533ba13dfcf1f431a8f49e63cecc31d91d007bc1deb914f47d0e4"}, - {file = "pyzmq-26.0.3-cp39-cp39-musllinux_1_1_i686.whl", hash = "sha256:e1258c639e00bf5e8a522fec6c3eaa3e30cf1c23a2f21a586be7e04d50c9acab"}, - {file = "pyzmq-26.0.3-cp39-cp39-musllinux_1_1_x86_64.whl", hash = "sha256:15c59e780be8f30a60816a9adab900c12a58d79c1ac742b4a8df044ab2a6d920"}, - {file = "pyzmq-26.0.3-cp39-cp39-win32.whl", hash = "sha256:d0cdde3c78d8ab5b46595054e5def32a755fc028685add5ddc7403e9f6de9879"}, - {file = "pyzmq-26.0.3-cp39-cp39-win_amd64.whl", hash = "sha256:ce828058d482ef860746bf532822842e0ff484e27f540ef5c813d516dd8896d2"}, - {file = "pyzmq-26.0.3-cp39-cp39-win_arm64.whl", hash = "sha256:788f15721c64109cf720791714dc14afd0f449d63f3a5487724f024345067381"}, - {file = "pyzmq-26.0.3-pp310-pypy310_pp73-macosx_10_9_x86_64.whl", hash = "sha256:2c18645ef6294d99b256806e34653e86236eb266278c8ec8112622b61db255de"}, - {file = "pyzmq-26.0.3-pp310-pypy310_pp73-manylinux_2_17_aarch64.manylinux2014_aarch64.whl", hash = "sha256:7e6bc96ebe49604df3ec2c6389cc3876cabe475e6bfc84ced1bf4e630662cb35"}, - {file = "pyzmq-26.0.3-pp310-pypy310_pp73-manylinux_2_17_i686.manylinux2014_i686.whl", hash = "sha256:971e8990c5cc4ddcff26e149398fc7b0f6a042306e82500f5e8db3b10ce69f84"}, - {file = "pyzmq-26.0.3-pp310-pypy310_pp73-manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:d8416c23161abd94cc7da80c734ad7c9f5dbebdadfdaa77dad78244457448223"}, - {file = "pyzmq-26.0.3-pp310-pypy310_pp73-win_amd64.whl", hash = "sha256:082a2988364b60bb5de809373098361cf1dbb239623e39e46cb18bc035ed9c0c"}, - {file = "pyzmq-26.0.3-pp37-pypy37_pp73-macosx_10_9_x86_64.whl", hash = "sha256:d57dfbf9737763b3a60d26e6800e02e04284926329aee8fb01049635e957fe81"}, - {file = "pyzmq-26.0.3-pp37-pypy37_pp73-manylinux_2_12_i686.manylinux2010_i686.whl", hash = "sha256:77a85dca4c2430ac04dc2a2185c2deb3858a34fe7f403d0a946fa56970cf60a1"}, - {file = "pyzmq-26.0.3-pp37-pypy37_pp73-manylinux_2_12_x86_64.manylinux2010_x86_64.whl", hash = "sha256:4c82a6d952a1d555bf4be42b6532927d2a5686dd3c3e280e5f63225ab47ac1f5"}, - {file = "pyzmq-26.0.3-pp37-pypy37_pp73-manylinux_2_17_aarch64.manylinux2014_aarch64.whl", hash = "sha256:4496b1282c70c442809fc1b151977c3d967bfb33e4e17cedbf226d97de18f709"}, - {file = "pyzmq-26.0.3-pp37-pypy37_pp73-win_amd64.whl", hash = "sha256:e4946d6bdb7ba972dfda282f9127e5756d4f299028b1566d1245fa0d438847e6"}, - {file = "pyzmq-26.0.3-pp38-pypy38_pp73-macosx_10_9_x86_64.whl", hash = "sha256:03c0ae165e700364b266876d712acb1ac02693acd920afa67da2ebb91a0b3c09"}, - {file = "pyzmq-26.0.3-pp38-pypy38_pp73-manylinux_2_12_i686.manylinux2010_i686.whl", hash = "sha256:3e3070e680f79887d60feeda051a58d0ac36622e1759f305a41059eff62c6da7"}, - {file = "pyzmq-26.0.3-pp38-pypy38_pp73-manylinux_2_12_x86_64.manylinux2010_x86_64.whl", hash = "sha256:6ca08b840fe95d1c2bd9ab92dac5685f949fc6f9ae820ec16193e5ddf603c3b2"}, - {file = "pyzmq-26.0.3-pp38-pypy38_pp73-manylinux_2_17_aarch64.manylinux2014_aarch64.whl", hash = "sha256:e76654e9dbfb835b3518f9938e565c7806976c07b37c33526b574cc1a1050480"}, - {file = "pyzmq-26.0.3-pp38-pypy38_pp73-win_amd64.whl", hash = "sha256:871587bdadd1075b112e697173e946a07d722459d20716ceb3d1bd6c64bd08ce"}, - {file = "pyzmq-26.0.3-pp39-pypy39_pp73-macosx_10_9_x86_64.whl", hash = "sha256:d0a2d1bd63a4ad79483049b26514e70fa618ce6115220da9efdff63688808b17"}, - {file = "pyzmq-26.0.3-pp39-pypy39_pp73-manylinux_2_17_aarch64.manylinux2014_aarch64.whl", hash = "sha256:0270b49b6847f0d106d64b5086e9ad5dc8a902413b5dbbb15d12b60f9c1747a4"}, - {file = "pyzmq-26.0.3-pp39-pypy39_pp73-manylinux_2_17_i686.manylinux2014_i686.whl", hash = "sha256:703c60b9910488d3d0954ca585c34f541e506a091a41930e663a098d3b794c67"}, - {file = "pyzmq-26.0.3-pp39-pypy39_pp73-manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:74423631b6be371edfbf7eabb02ab995c2563fee60a80a30829176842e71722a"}, - {file = "pyzmq-26.0.3-pp39-pypy39_pp73-manylinux_2_28_x86_64.whl", hash = "sha256:4adfbb5451196842a88fda3612e2c0414134874bffb1c2ce83ab4242ec9e027d"}, - {file = "pyzmq-26.0.3-pp39-pypy39_pp73-win_amd64.whl", hash = "sha256:3516119f4f9b8671083a70b6afaa0a070f5683e431ab3dc26e9215620d7ca1ad"}, - {file = "pyzmq-26.0.3.tar.gz", hash = "sha256:dba7d9f2e047dfa2bca3b01f4f84aa5246725203d6284e3790f2ca15fba6b40a"}, -] - -[package.dependencies] -cffi = {version = "*", markers = "implementation_name == \"pypy\""} - -[[package]] -name = "qtconsole" -version = "5.5.2" -description = "Jupyter Qt console" -optional = true -python-versions = ">=3.8" -files = [ - {file = "qtconsole-5.5.2-py3-none-any.whl", hash = "sha256:42d745f3d05d36240244a04e1e1ec2a86d5d9b6edb16dbdef582ccb629e87e0b"}, - {file = "qtconsole-5.5.2.tar.gz", hash = "sha256:6b5fb11274b297463706af84dcbbd5c92273b1f619e6d25d08874b0a88516989"}, -] - -[package.dependencies] -ipykernel = ">=4.1" -jupyter-client = ">=4.1" -jupyter-core = "*" -packaging = "*" -pygments = "*" -pyzmq = ">=17.1" -qtpy = ">=2.4.0" -traitlets = "<5.2.1 || >5.2.1,<5.2.2 || >5.2.2" - -[package.extras] -doc = ["Sphinx (>=1.3)"] -test = ["flaky", "pytest", "pytest-qt"] - -[[package]] -name = "qtpy" -version = "2.4.1" -description = "Provides an abstraction layer on top of the various Qt bindings (PyQt5/6 and PySide2/6)." -optional = true -python-versions = ">=3.7" -files = [ - {file = "QtPy-2.4.1-py3-none-any.whl", hash = "sha256:1c1d8c4fa2c884ae742b069151b0abe15b3f70491f3972698c683b8e38de839b"}, - {file = "QtPy-2.4.1.tar.gz", hash = "sha256:a5a15ffd519550a1361bdc56ffc07fda56a6af7292f17c7b395d4083af632987"}, -] - -[package.dependencies] -packaging = "*" - -[package.extras] -test = ["pytest (>=6,!=7.0.0,!=7.0.1)", "pytest-cov (>=3.0.0)", "pytest-qt"] - -[[package]] -name = "referencing" -version = "0.35.1" -description = "JSON Referencing + Python" -optional = true -python-versions = ">=3.8" -files = [ - {file = "referencing-0.35.1-py3-none-any.whl", hash = "sha256:eda6d3234d62814d1c64e305c1331c9a3a6132da475ab6382eaa997b21ee75de"}, - {file = "referencing-0.35.1.tar.gz", hash = "sha256:25b42124a6c8b632a425174f24087783efb348a6f1e0008e63cd4466fedf703c"}, -] - -[package.dependencies] -attrs = ">=22.2.0" -rpds-py = ">=0.7.0" - -[[package]] -name = "requests" -version = "2.32.1" -description = "Python HTTP for Humans." -optional = true -python-versions = ">=3.8" -files = [ - {file = "requests-2.32.1-py3-none-any.whl", hash = "sha256:21ac9465cdf8c1650fe1ecde8a71669a93d4e6f147550483a2967d08396a56a5"}, - {file = "requests-2.32.1.tar.gz", hash = "sha256:eb97e87e64c79e64e5b8ac75cee9dd1f97f49e289b083ee6be96268930725685"}, -] - -[package.dependencies] -certifi = ">=2017.4.17" -charset-normalizer = ">=2,<4" -idna = ">=2.5,<4" -urllib3 = ">=1.21.1,<3" - -[package.extras] -socks = ["PySocks (>=1.5.6,!=1.5.7)"] -use-chardet-on-py3 = ["chardet (>=3.0.2,<6)"] - -[[package]] -name = "rfc3339-validator" -version = "0.1.4" -description = "A pure python RFC3339 validator" -optional = true -python-versions = ">=2.7, !=3.0.*, !=3.1.*, !=3.2.*, !=3.3.*, !=3.4.*" -files = [ - {file = "rfc3339_validator-0.1.4-py2.py3-none-any.whl", hash = "sha256:24f6ec1eda14ef823da9e36ec7113124b39c04d50a4d3d3a3c2859577e7791fa"}, - {file = "rfc3339_validator-0.1.4.tar.gz", hash = "sha256:138a2abdf93304ad60530167e51d2dfb9549521a836871b88d7f4695d0022f6b"}, -] - -[package.dependencies] -six = "*" - -[[package]] -name = "rfc3986-validator" -version = "0.1.1" -description = "Pure python rfc3986 validator" -optional = true -python-versions = ">=2.7, !=3.0.*, !=3.1.*, !=3.2.*, !=3.3.*, !=3.4.*" -files = [ - {file = "rfc3986_validator-0.1.1-py2.py3-none-any.whl", hash = "sha256:2f235c432ef459970b4306369336b9d5dbdda31b510ca1e327636e01f528bfa9"}, - {file = "rfc3986_validator-0.1.1.tar.gz", hash = "sha256:3d44bde7921b3b9ec3ae4e3adca370438eccebc676456449b145d533b240d055"}, -] - -[[package]] -name = "rosco" -version = "2.9.2" -description = "A reference open source controller toolset for wind turbine applications." -optional = true -python-versions = ">=3.9" -files = [ - {file = "rosco-2.9.2-cp310-cp310-macosx_10_9_x86_64.whl", hash = "sha256:60c0517592c2aa91b2a9ee07e51e4f0464fc7820728f9eb28bd6a81f1195d7cf"}, - {file = "rosco-2.9.2-cp310-cp310-macosx_11_0_arm64.whl", hash = "sha256:15d02bb5df5ee41f01dae5ed23526b10f95bcb47df822017d732df3cd50aae4c"}, - {file = "rosco-2.9.2-cp310-cp310-manylinux_2_17_i686.manylinux2014_i686.whl", hash = "sha256:3259b7aad8225854168ba9fbde9a4f2b01eadd46230e6366d49dd628476a630a"}, - {file = "rosco-2.9.2-cp310-cp310-manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:4e16d6829d08871503154ad7b8a909a9940456c90b9baf97f7e80f1bfbcbc169"}, - {file = "rosco-2.9.2-cp310-cp310-musllinux_1_1_i686.whl", hash = "sha256:d51b8bf8f75a9ad28d6b971a03ac24db20fb976f9ed8423d952e10e19ea1c98e"}, - {file = "rosco-2.9.2-cp310-cp310-musllinux_1_1_x86_64.whl", hash = "sha256:7b19c1b9ffe1094f008c7865594a60ee84c383c7318b4ec8e003c8b6f32fb4c7"}, - {file = "rosco-2.9.2-cp310-cp310-win_amd64.whl", hash = "sha256:c6516482ffd15d1fdf20ab8fd495ad9e353af7bbc15098162841e1f4bd681469"}, - {file = "rosco-2.9.2-cp311-cp311-macosx_10_9_x86_64.whl", hash = "sha256:d79ea0d2ff5c904734b270e5381867157d28a83dd38c05bee1243ead5cd75259"}, - {file = "rosco-2.9.2-cp311-cp311-macosx_11_0_arm64.whl", hash = "sha256:088bfe893bae96d4f170b9058fa332ceca3d89a16f33f91f0f3003bd67e4f7dc"}, - {file = "rosco-2.9.2-cp311-cp311-manylinux_2_17_i686.manylinux2014_i686.whl", hash = "sha256:622552efb359e12108ae3756eaa5bd29e6c473deb3cc36e99ac75975bf784941"}, - {file = "rosco-2.9.2-cp311-cp311-manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:68fe33db823b140ee1f110338c1bd6863cb0d6c81a5d2a41bf486dece462e87e"}, - {file = "rosco-2.9.2-cp311-cp311-musllinux_1_1_i686.whl", hash = "sha256:39549a110cb3959074d69afb76ee0638256f7b037064d947f088a4776a34b5d7"}, - {file = "rosco-2.9.2-cp311-cp311-musllinux_1_1_x86_64.whl", hash = "sha256:ded6e74bcba36f5229c8ccc7b8e4a7ef1fc151971d0c9a0688abc4766b371cb6"}, - {file = "rosco-2.9.2-cp311-cp311-win_amd64.whl", hash = "sha256:04094e3fec7b8036af6c9946e6571105b3471ba985936d201ff4eaaa95033d43"}, - {file = "rosco-2.9.2-cp312-cp312-macosx_10_9_x86_64.whl", hash = "sha256:266e0686dfa50266232f82dc47d79bfdccc3181276b4e31ccd7fcc7d61155776"}, - {file = "rosco-2.9.2-cp312-cp312-macosx_11_0_arm64.whl", hash = "sha256:7ced257d0b979fb246230cdb273f20cc348606ba6fb7e0f3a760563aa0e9701e"}, - {file = "rosco-2.9.2-cp312-cp312-manylinux_2_17_i686.manylinux2014_i686.whl", hash = "sha256:30d6f2f81e235ea2d7e60be7f850f4917d3cb720670ba7122b8b789a76df873c"}, - {file = "rosco-2.9.2-cp312-cp312-manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:51ec350c68805e3912a465cf2383388455d11111ef89e761e7ff1fedcadf8567"}, - {file = "rosco-2.9.2-cp312-cp312-musllinux_1_1_i686.whl", hash = "sha256:a6ff437c517337b1cf7e0e2fbe240e05c9f3ceb1aa0ab3fb3b984eaa669d4056"}, - {file = "rosco-2.9.2-cp312-cp312-musllinux_1_1_x86_64.whl", hash = "sha256:eff41c9b5e01a53172d10311d8646e6c91a09f7992e7ad7b5bb7bf9ccabc1f42"}, - {file = "rosco-2.9.2-cp312-cp312-win_amd64.whl", hash = "sha256:8d77d3ce031679ff2472c4fbc12ce0f1a6aa7d531b6f6bce7a34550a67b822bd"}, - {file = "rosco-2.9.2-cp39-cp39-macosx_10_9_x86_64.whl", hash = "sha256:4b1dbb3e5c6ae14cc6fbbfe7e1788ee343c14319db44d1a1428e2aaa9d40588b"}, - {file = "rosco-2.9.2-cp39-cp39-macosx_11_0_arm64.whl", hash = "sha256:20a0094dee3eac9ab89289a413a76655829320ed801b4839489c19bbc6f209a6"}, - {file = "rosco-2.9.2-cp39-cp39-manylinux_2_17_i686.manylinux2014_i686.whl", hash = "sha256:df83ad48ee5b7c3b5474b85415fc8bd58454cf7db1eeaeae17cda974fc62eb8f"}, - {file = "rosco-2.9.2-cp39-cp39-manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:5aa15741d31b5c330087ffb548a0a1e9e50cd49b14dddfc214bb9c2e5e502122"}, - {file = "rosco-2.9.2-cp39-cp39-musllinux_1_1_i686.whl", hash = "sha256:32b23a81edec1740f2df2ef77384a907aced6d00f6674acbf38b52198ddd9116"}, - {file = "rosco-2.9.2-cp39-cp39-musllinux_1_1_x86_64.whl", hash = "sha256:79e8fe1d9aef79e22ddd946163e188f6f7852eac319fbfe4276f811353b509f9"}, - {file = "rosco-2.9.2-cp39-cp39-win_amd64.whl", hash = "sha256:2d645a4c226d28a08bf321a89ffd29ada4f1acf747b06cbe87609274bf02fc12"}, - {file = "rosco-2.9.2.tar.gz", hash = "sha256:8acb411038508dfa5c4104b8b7b29a73a76027c40bf2ff2f673a75e0b6aa5b15"}, -] - -[package.dependencies] -control = "*" -matplotlib = "*" -numpy = "*" -pandas = "*" -pyparsing = "*" -pyYAML = "*" -pyzmq = "*" -"ruamel.yaml" = "*" -scipy = "*" -treon = "*" -wisdem = "*" - -[package.extras] -dev = ["cmake"] -test = ["pytest"] - -[[package]] -name = "rpds-py" -version = "0.18.1" -description = "Python bindings to Rust's persistent data structures (rpds)" -optional = true -python-versions = ">=3.8" -files = [ - {file = "rpds_py-0.18.1-cp310-cp310-macosx_10_12_x86_64.whl", hash = "sha256:d31dea506d718693b6b2cffc0648a8929bdc51c70a311b2770f09611caa10d53"}, - {file = "rpds_py-0.18.1-cp310-cp310-macosx_11_0_arm64.whl", hash = "sha256:732672fbc449bab754e0b15356c077cc31566df874964d4801ab14f71951ea80"}, - {file = "rpds_py-0.18.1-cp310-cp310-manylinux_2_17_aarch64.manylinux2014_aarch64.whl", hash = "sha256:4a98a1f0552b5f227a3d6422dbd61bc6f30db170939bd87ed14f3c339aa6c7c9"}, - {file = "rpds_py-0.18.1-cp310-cp310-manylinux_2_17_armv7l.manylinux2014_armv7l.whl", hash = "sha256:7f1944ce16401aad1e3f7d312247b3d5de7981f634dc9dfe90da72b87d37887d"}, - {file = "rpds_py-0.18.1-cp310-cp310-manylinux_2_17_ppc64le.manylinux2014_ppc64le.whl", hash = "sha256:38e14fb4e370885c4ecd734f093a2225ee52dc384b86fa55fe3f74638b2cfb09"}, - {file = "rpds_py-0.18.1-cp310-cp310-manylinux_2_17_s390x.manylinux2014_s390x.whl", hash = "sha256:08d74b184f9ab6289b87b19fe6a6d1a97fbfea84b8a3e745e87a5de3029bf944"}, - {file = "rpds_py-0.18.1-cp310-cp310-manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:d70129cef4a8d979caa37e7fe957202e7eee8ea02c5e16455bc9808a59c6b2f0"}, - {file = "rpds_py-0.18.1-cp310-cp310-manylinux_2_5_i686.manylinux1_i686.whl", hash = "sha256:ce0bb20e3a11bd04461324a6a798af34d503f8d6f1aa3d2aa8901ceaf039176d"}, - {file = "rpds_py-0.18.1-cp310-cp310-musllinux_1_2_aarch64.whl", hash = "sha256:81c5196a790032e0fc2464c0b4ab95f8610f96f1f2fa3d4deacce6a79852da60"}, - {file = "rpds_py-0.18.1-cp310-cp310-musllinux_1_2_i686.whl", hash = "sha256:f3027be483868c99b4985fda802a57a67fdf30c5d9a50338d9db646d590198da"}, - {file = "rpds_py-0.18.1-cp310-cp310-musllinux_1_2_x86_64.whl", hash = "sha256:d44607f98caa2961bab4fa3c4309724b185b464cdc3ba6f3d7340bac3ec97cc1"}, - {file = "rpds_py-0.18.1-cp310-none-win32.whl", hash = "sha256:c273e795e7a0f1fddd46e1e3cb8be15634c29ae8ff31c196debb620e1edb9333"}, - {file = "rpds_py-0.18.1-cp310-none-win_amd64.whl", hash = "sha256:8352f48d511de5f973e4f2f9412736d7dea76c69faa6d36bcf885b50c758ab9a"}, - {file = "rpds_py-0.18.1-cp311-cp311-macosx_10_12_x86_64.whl", hash = "sha256:6b5ff7e1d63a8281654b5e2896d7f08799378e594f09cf3674e832ecaf396ce8"}, - {file = "rpds_py-0.18.1-cp311-cp311-macosx_11_0_arm64.whl", hash = "sha256:8927638a4d4137a289e41d0fd631551e89fa346d6dbcfc31ad627557d03ceb6d"}, - {file = "rpds_py-0.18.1-cp311-cp311-manylinux_2_17_aarch64.manylinux2014_aarch64.whl", hash = "sha256:154bf5c93d79558b44e5b50cc354aa0459e518e83677791e6adb0b039b7aa6a7"}, - {file = "rpds_py-0.18.1-cp311-cp311-manylinux_2_17_armv7l.manylinux2014_armv7l.whl", hash = "sha256:07f2139741e5deb2c5154a7b9629bc5aa48c766b643c1a6750d16f865a82c5fc"}, - {file = "rpds_py-0.18.1-cp311-cp311-manylinux_2_17_ppc64le.manylinux2014_ppc64le.whl", hash = "sha256:8c7672e9fba7425f79019db9945b16e308ed8bc89348c23d955c8c0540da0a07"}, - {file = "rpds_py-0.18.1-cp311-cp311-manylinux_2_17_s390x.manylinux2014_s390x.whl", hash = "sha256:489bdfe1abd0406eba6b3bb4fdc87c7fa40f1031de073d0cfb744634cc8fa261"}, - {file = "rpds_py-0.18.1-cp311-cp311-manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:3c20f05e8e3d4fc76875fc9cb8cf24b90a63f5a1b4c5b9273f0e8225e169b100"}, - {file = "rpds_py-0.18.1-cp311-cp311-manylinux_2_5_i686.manylinux1_i686.whl", hash = "sha256:967342e045564cef76dfcf1edb700b1e20838d83b1aa02ab313e6a497cf923b8"}, - {file = "rpds_py-0.18.1-cp311-cp311-musllinux_1_2_aarch64.whl", hash = "sha256:2cc7c1a47f3a63282ab0f422d90ddac4aa3034e39fc66a559ab93041e6505da7"}, - {file = "rpds_py-0.18.1-cp311-cp311-musllinux_1_2_i686.whl", hash = "sha256:f7afbfee1157e0f9376c00bb232e80a60e59ed716e3211a80cb8506550671e6e"}, - {file = "rpds_py-0.18.1-cp311-cp311-musllinux_1_2_x86_64.whl", hash = "sha256:9e6934d70dc50f9f8ea47081ceafdec09245fd9f6032669c3b45705dea096b88"}, - {file = "rpds_py-0.18.1-cp311-none-win32.whl", hash = "sha256:c69882964516dc143083d3795cb508e806b09fc3800fd0d4cddc1df6c36e76bb"}, - {file = "rpds_py-0.18.1-cp311-none-win_amd64.whl", hash = "sha256:70a838f7754483bcdc830444952fd89645569e7452e3226de4a613a4c1793fb2"}, - {file = "rpds_py-0.18.1-cp312-cp312-macosx_10_12_x86_64.whl", hash = "sha256:3dd3cd86e1db5aadd334e011eba4e29d37a104b403e8ca24dcd6703c68ca55b3"}, - {file = "rpds_py-0.18.1-cp312-cp312-macosx_11_0_arm64.whl", hash = "sha256:05f3d615099bd9b13ecf2fc9cf2d839ad3f20239c678f461c753e93755d629ee"}, - {file = "rpds_py-0.18.1-cp312-cp312-manylinux_2_17_aarch64.manylinux2014_aarch64.whl", hash = "sha256:35b2b771b13eee8729a5049c976197ff58a27a3829c018a04341bcf1ae409b2b"}, - {file = "rpds_py-0.18.1-cp312-cp312-manylinux_2_17_armv7l.manylinux2014_armv7l.whl", hash = "sha256:ee17cd26b97d537af8f33635ef38be873073d516fd425e80559f4585a7b90c43"}, - {file = "rpds_py-0.18.1-cp312-cp312-manylinux_2_17_ppc64le.manylinux2014_ppc64le.whl", hash = "sha256:b646bf655b135ccf4522ed43d6902af37d3f5dbcf0da66c769a2b3938b9d8184"}, - {file = "rpds_py-0.18.1-cp312-cp312-manylinux_2_17_s390x.manylinux2014_s390x.whl", hash = "sha256:19ba472b9606c36716062c023afa2484d1e4220548751bda14f725a7de17b4f6"}, - {file = "rpds_py-0.18.1-cp312-cp312-manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:6e30ac5e329098903262dc5bdd7e2086e0256aa762cc8b744f9e7bf2a427d3f8"}, - {file = "rpds_py-0.18.1-cp312-cp312-manylinux_2_5_i686.manylinux1_i686.whl", hash = "sha256:d58ad6317d188c43750cb76e9deacf6051d0f884d87dc6518e0280438648a9ac"}, - {file = "rpds_py-0.18.1-cp312-cp312-musllinux_1_2_aarch64.whl", hash = "sha256:e1735502458621921cee039c47318cb90b51d532c2766593be6207eec53e5c4c"}, - {file = "rpds_py-0.18.1-cp312-cp312-musllinux_1_2_i686.whl", hash = "sha256:f5bab211605d91db0e2995a17b5c6ee5edec1270e46223e513eaa20da20076ac"}, - {file = "rpds_py-0.18.1-cp312-cp312-musllinux_1_2_x86_64.whl", hash = "sha256:2fc24a329a717f9e2448f8cd1f960f9dac4e45b6224d60734edeb67499bab03a"}, - {file = "rpds_py-0.18.1-cp312-none-win32.whl", hash = "sha256:1805d5901779662d599d0e2e4159d8a82c0b05faa86ef9222bf974572286b2b6"}, - {file = "rpds_py-0.18.1-cp312-none-win_amd64.whl", hash = "sha256:720edcb916df872d80f80a1cc5ea9058300b97721efda8651efcd938a9c70a72"}, - {file = "rpds_py-0.18.1-cp38-cp38-macosx_10_12_x86_64.whl", hash = "sha256:c827576e2fa017a081346dce87d532a5310241648eb3700af9a571a6e9fc7e74"}, - {file = "rpds_py-0.18.1-cp38-cp38-macosx_11_0_arm64.whl", hash = "sha256:aa3679e751408d75a0b4d8d26d6647b6d9326f5e35c00a7ccd82b78ef64f65f8"}, - {file = "rpds_py-0.18.1-cp38-cp38-manylinux_2_17_aarch64.manylinux2014_aarch64.whl", hash = "sha256:0abeee75434e2ee2d142d650d1e54ac1f8b01e6e6abdde8ffd6eeac6e9c38e20"}, - {file = "rpds_py-0.18.1-cp38-cp38-manylinux_2_17_armv7l.manylinux2014_armv7l.whl", hash = "sha256:ed402d6153c5d519a0faf1bb69898e97fb31613b49da27a84a13935ea9164dfc"}, - {file = "rpds_py-0.18.1-cp38-cp38-manylinux_2_17_ppc64le.manylinux2014_ppc64le.whl", hash = "sha256:338dee44b0cef8b70fd2ef54b4e09bb1b97fc6c3a58fea5db6cc083fd9fc2724"}, - {file = "rpds_py-0.18.1-cp38-cp38-manylinux_2_17_s390x.manylinux2014_s390x.whl", hash = "sha256:7750569d9526199c5b97e5a9f8d96a13300950d910cf04a861d96f4273d5b104"}, - {file = "rpds_py-0.18.1-cp38-cp38-manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:607345bd5912aacc0c5a63d45a1f73fef29e697884f7e861094e443187c02be5"}, - {file = "rpds_py-0.18.1-cp38-cp38-manylinux_2_5_i686.manylinux1_i686.whl", hash = "sha256:207c82978115baa1fd8d706d720b4a4d2b0913df1c78c85ba73fe6c5804505f0"}, - {file = "rpds_py-0.18.1-cp38-cp38-musllinux_1_2_aarch64.whl", hash = "sha256:6d1e42d2735d437e7e80bab4d78eb2e459af48c0a46e686ea35f690b93db792d"}, - {file = "rpds_py-0.18.1-cp38-cp38-musllinux_1_2_i686.whl", hash = "sha256:5463c47c08630007dc0fe99fb480ea4f34a89712410592380425a9b4e1611d8e"}, - {file = "rpds_py-0.18.1-cp38-cp38-musllinux_1_2_x86_64.whl", hash = "sha256:06d218939e1bf2ca50e6b0ec700ffe755e5216a8230ab3e87c059ebb4ea06afc"}, - {file = "rpds_py-0.18.1-cp38-none-win32.whl", hash = "sha256:312fe69b4fe1ffbe76520a7676b1e5ac06ddf7826d764cc10265c3b53f96dbe9"}, - {file = "rpds_py-0.18.1-cp38-none-win_amd64.whl", hash = "sha256:9437ca26784120a279f3137ee080b0e717012c42921eb07861b412340f85bae2"}, - {file = "rpds_py-0.18.1-cp39-cp39-macosx_10_12_x86_64.whl", hash = "sha256:19e515b78c3fc1039dd7da0a33c28c3154458f947f4dc198d3c72db2b6b5dc93"}, - {file = "rpds_py-0.18.1-cp39-cp39-macosx_11_0_arm64.whl", hash = "sha256:a7b28c5b066bca9a4eb4e2f2663012debe680f097979d880657f00e1c30875a0"}, - {file = "rpds_py-0.18.1-cp39-cp39-manylinux_2_17_aarch64.manylinux2014_aarch64.whl", hash = "sha256:673fdbbf668dd958eff750e500495ef3f611e2ecc209464f661bc82e9838991e"}, - {file = "rpds_py-0.18.1-cp39-cp39-manylinux_2_17_armv7l.manylinux2014_armv7l.whl", hash = "sha256:d960de62227635d2e61068f42a6cb6aae91a7fe00fca0e3aeed17667c8a34611"}, - {file = "rpds_py-0.18.1-cp39-cp39-manylinux_2_17_ppc64le.manylinux2014_ppc64le.whl", hash = "sha256:352a88dc7892f1da66b6027af06a2e7e5d53fe05924cc2cfc56495b586a10b72"}, - {file = "rpds_py-0.18.1-cp39-cp39-manylinux_2_17_s390x.manylinux2014_s390x.whl", hash = "sha256:4e0ee01ad8260184db21468a6e1c37afa0529acc12c3a697ee498d3c2c4dcaf3"}, - {file = "rpds_py-0.18.1-cp39-cp39-manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:e4c39ad2f512b4041343ea3c7894339e4ca7839ac38ca83d68a832fc8b3748ab"}, - {file = "rpds_py-0.18.1-cp39-cp39-manylinux_2_5_i686.manylinux1_i686.whl", hash = "sha256:aaa71ee43a703c321906813bb252f69524f02aa05bf4eec85f0c41d5d62d0f4c"}, - {file = "rpds_py-0.18.1-cp39-cp39-musllinux_1_2_aarch64.whl", hash = "sha256:6cd8098517c64a85e790657e7b1e509b9fe07487fd358e19431cb120f7d96338"}, - {file = "rpds_py-0.18.1-cp39-cp39-musllinux_1_2_i686.whl", hash = "sha256:4adec039b8e2928983f885c53b7cc4cda8965b62b6596501a0308d2703f8af1b"}, - {file = "rpds_py-0.18.1-cp39-cp39-musllinux_1_2_x86_64.whl", hash = "sha256:32b7daaa3e9389db3695964ce8e566e3413b0c43e3394c05e4b243a4cd7bef26"}, - {file = "rpds_py-0.18.1-cp39-none-win32.whl", hash = "sha256:2625f03b105328729f9450c8badda34d5243231eef6535f80064d57035738360"}, - {file = "rpds_py-0.18.1-cp39-none-win_amd64.whl", hash = "sha256:bf18932d0003c8c4d51a39f244231986ab23ee057d235a12b2684ea26a353590"}, - {file = "rpds_py-0.18.1-pp310-pypy310_pp73-macosx_10_12_x86_64.whl", hash = "sha256:cbfbea39ba64f5e53ae2915de36f130588bba71245b418060ec3330ebf85678e"}, - {file = "rpds_py-0.18.1-pp310-pypy310_pp73-macosx_11_0_arm64.whl", hash = "sha256:a3d456ff2a6a4d2adcdf3c1c960a36f4fd2fec6e3b4902a42a384d17cf4e7a65"}, - {file = "rpds_py-0.18.1-pp310-pypy310_pp73-manylinux_2_17_aarch64.manylinux2014_aarch64.whl", hash = "sha256:7700936ef9d006b7ef605dc53aa364da2de5a3aa65516a1f3ce73bf82ecfc7ae"}, - {file = "rpds_py-0.18.1-pp310-pypy310_pp73-manylinux_2_17_armv7l.manylinux2014_armv7l.whl", hash = "sha256:51584acc5916212e1bf45edd17f3a6b05fe0cbb40482d25e619f824dccb679de"}, - {file = "rpds_py-0.18.1-pp310-pypy310_pp73-manylinux_2_17_ppc64le.manylinux2014_ppc64le.whl", hash = "sha256:942695a206a58d2575033ff1e42b12b2aece98d6003c6bc739fbf33d1773b12f"}, - {file = "rpds_py-0.18.1-pp310-pypy310_pp73-manylinux_2_17_s390x.manylinux2014_s390x.whl", hash = "sha256:b906b5f58892813e5ba5c6056d6a5ad08f358ba49f046d910ad992196ea61397"}, - {file = "rpds_py-0.18.1-pp310-pypy310_pp73-manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:f6f8e3fecca256fefc91bb6765a693d96692459d7d4c644660a9fff32e517843"}, - {file = "rpds_py-0.18.1-pp310-pypy310_pp73-manylinux_2_5_i686.manylinux1_i686.whl", hash = "sha256:7732770412bab81c5a9f6d20aeb60ae943a9b36dcd990d876a773526468e7163"}, - {file = "rpds_py-0.18.1-pp310-pypy310_pp73-musllinux_1_2_aarch64.whl", hash = "sha256:bd1105b50ede37461c1d51b9698c4f4be6e13e69a908ab7751e3807985fc0346"}, - {file = "rpds_py-0.18.1-pp310-pypy310_pp73-musllinux_1_2_i686.whl", hash = "sha256:618916f5535784960f3ecf8111581f4ad31d347c3de66d02e728de460a46303c"}, - {file = "rpds_py-0.18.1-pp310-pypy310_pp73-musllinux_1_2_x86_64.whl", hash = "sha256:17c6d2155e2423f7e79e3bb18151c686d40db42d8645e7977442170c360194d4"}, - {file = "rpds_py-0.18.1-pp38-pypy38_pp73-macosx_10_12_x86_64.whl", hash = "sha256:6c4c4c3f878df21faf5fac86eda32671c27889e13570645a9eea0a1abdd50922"}, - {file = "rpds_py-0.18.1-pp38-pypy38_pp73-macosx_11_0_arm64.whl", hash = "sha256:fab6ce90574645a0d6c58890e9bcaac8d94dff54fb51c69e5522a7358b80ab64"}, - {file = "rpds_py-0.18.1-pp38-pypy38_pp73-manylinux_2_17_aarch64.manylinux2014_aarch64.whl", hash = "sha256:531796fb842b53f2695e94dc338929e9f9dbf473b64710c28af5a160b2a8927d"}, - {file = "rpds_py-0.18.1-pp38-pypy38_pp73-manylinux_2_17_armv7l.manylinux2014_armv7l.whl", hash = "sha256:740884bc62a5e2bbb31e584f5d23b32320fd75d79f916f15a788d527a5e83644"}, - {file = "rpds_py-0.18.1-pp38-pypy38_pp73-manylinux_2_17_ppc64le.manylinux2014_ppc64le.whl", hash = "sha256:998125738de0158f088aef3cb264a34251908dd2e5d9966774fdab7402edfab7"}, - {file = "rpds_py-0.18.1-pp38-pypy38_pp73-manylinux_2_17_s390x.manylinux2014_s390x.whl", hash = "sha256:e2be6e9dd4111d5b31ba3b74d17da54a8319d8168890fbaea4b9e5c3de630ae5"}, - {file = "rpds_py-0.18.1-pp38-pypy38_pp73-manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:d0cee71bc618cd93716f3c1bf56653740d2d13ddbd47673efa8bf41435a60daa"}, - {file = "rpds_py-0.18.1-pp38-pypy38_pp73-manylinux_2_5_i686.manylinux1_i686.whl", hash = "sha256:2c3caec4ec5cd1d18e5dd6ae5194d24ed12785212a90b37f5f7f06b8bedd7139"}, - {file = "rpds_py-0.18.1-pp38-pypy38_pp73-musllinux_1_2_aarch64.whl", hash = "sha256:27bba383e8c5231cd559affe169ca0b96ec78d39909ffd817f28b166d7ddd4d8"}, - {file = "rpds_py-0.18.1-pp38-pypy38_pp73-musllinux_1_2_i686.whl", hash = "sha256:a888e8bdb45916234b99da2d859566f1e8a1d2275a801bb8e4a9644e3c7e7909"}, - {file = "rpds_py-0.18.1-pp38-pypy38_pp73-musllinux_1_2_x86_64.whl", hash = "sha256:6031b25fb1b06327b43d841f33842b383beba399884f8228a6bb3df3088485ff"}, - {file = "rpds_py-0.18.1-pp39-pypy39_pp73-macosx_10_12_x86_64.whl", hash = "sha256:48c2faaa8adfacefcbfdb5f2e2e7bdad081e5ace8d182e5f4ade971f128e6bb3"}, - {file = "rpds_py-0.18.1-pp39-pypy39_pp73-macosx_11_0_arm64.whl", hash = "sha256:d85164315bd68c0806768dc6bb0429c6f95c354f87485ee3593c4f6b14def2bd"}, - {file = "rpds_py-0.18.1-pp39-pypy39_pp73-manylinux_2_17_aarch64.manylinux2014_aarch64.whl", hash = "sha256:6afd80f6c79893cfc0574956f78a0add8c76e3696f2d6a15bca2c66c415cf2d4"}, - {file = "rpds_py-0.18.1-pp39-pypy39_pp73-manylinux_2_17_armv7l.manylinux2014_armv7l.whl", hash = "sha256:fa242ac1ff583e4ec7771141606aafc92b361cd90a05c30d93e343a0c2d82a89"}, - {file = "rpds_py-0.18.1-pp39-pypy39_pp73-manylinux_2_17_ppc64le.manylinux2014_ppc64le.whl", hash = "sha256:d21be4770ff4e08698e1e8e0bce06edb6ea0626e7c8f560bc08222880aca6a6f"}, - {file = "rpds_py-0.18.1-pp39-pypy39_pp73-manylinux_2_17_s390x.manylinux2014_s390x.whl", hash = "sha256:5c45a639e93a0c5d4b788b2613bd637468edd62f8f95ebc6fcc303d58ab3f0a8"}, - {file = "rpds_py-0.18.1-pp39-pypy39_pp73-manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:910e71711d1055b2768181efa0a17537b2622afeb0424116619817007f8a2b10"}, - {file = "rpds_py-0.18.1-pp39-pypy39_pp73-manylinux_2_5_i686.manylinux1_i686.whl", hash = "sha256:b9bb1f182a97880f6078283b3505a707057c42bf55d8fca604f70dedfdc0772a"}, - {file = "rpds_py-0.18.1-pp39-pypy39_pp73-musllinux_1_2_aarch64.whl", hash = "sha256:1d54f74f40b1f7aaa595a02ff42ef38ca654b1469bef7d52867da474243cc633"}, - {file = "rpds_py-0.18.1-pp39-pypy39_pp73-musllinux_1_2_i686.whl", hash = "sha256:8d2e182c9ee01135e11e9676e9a62dfad791a7a467738f06726872374a83db49"}, - {file = "rpds_py-0.18.1-pp39-pypy39_pp73-musllinux_1_2_x86_64.whl", hash = "sha256:636a15acc588f70fda1661234761f9ed9ad79ebed3f2125d44be0862708b666e"}, - {file = "rpds_py-0.18.1.tar.gz", hash = "sha256:dc48b479d540770c811fbd1eb9ba2bb66951863e448efec2e2c102625328e92f"}, -] - -[[package]] -name = "ruamel-yaml" -version = "0.18.6" -description = "ruamel.yaml is a YAML parser/emitter that supports roundtrip preservation of comments, seq/map flow style, and map key order" -optional = false -python-versions = ">=3.7" -files = [ - {file = "ruamel.yaml-0.18.6-py3-none-any.whl", hash = "sha256:57b53ba33def16c4f3d807c0ccbc00f8a6081827e81ba2491691b76882d0c636"}, - {file = "ruamel.yaml-0.18.6.tar.gz", hash = "sha256:8b27e6a217e786c6fbe5634d8f3f11bc63e0f80f6a5890f28863d9c45aac311b"}, -] - -[package.dependencies] -"ruamel.yaml.clib" = {version = ">=0.2.7", markers = "platform_python_implementation == \"CPython\" and python_version < \"3.13\""} - -[package.extras] -docs = ["mercurial (>5.7)", "ryd"] -jinja2 = ["ruamel.yaml.jinja2 (>=0.2)"] - -[[package]] -name = "ruamel-yaml-clib" -version = "0.2.8" -description = "C version of reader, parser and emitter for ruamel.yaml derived from libyaml" -optional = false -python-versions = ">=3.6" -files = [ - {file = "ruamel.yaml.clib-0.2.8-cp310-cp310-macosx_10_9_universal2.whl", hash = "sha256:b42169467c42b692c19cf539c38d4602069d8c1505e97b86387fcf7afb766e1d"}, - {file = "ruamel.yaml.clib-0.2.8-cp310-cp310-macosx_13_0_arm64.whl", hash = "sha256:07238db9cbdf8fc1e9de2489a4f68474e70dffcb32232db7c08fa61ca0c7c462"}, - {file = "ruamel.yaml.clib-0.2.8-cp310-cp310-manylinux_2_17_x86_64.manylinux2014_x86_64.manylinux_2_24_x86_64.whl", hash = "sha256:fff3573c2db359f091e1589c3d7c5fc2f86f5bdb6f24252c2d8e539d4e45f412"}, - {file = "ruamel.yaml.clib-0.2.8-cp310-cp310-manylinux_2_24_aarch64.whl", hash = "sha256:aa2267c6a303eb483de8d02db2871afb5c5fc15618d894300b88958f729ad74f"}, - {file = "ruamel.yaml.clib-0.2.8-cp310-cp310-musllinux_1_1_i686.whl", hash = "sha256:840f0c7f194986a63d2c2465ca63af8ccbbc90ab1c6001b1978f05119b5e7334"}, - {file = "ruamel.yaml.clib-0.2.8-cp310-cp310-musllinux_1_1_x86_64.whl", hash = "sha256:024cfe1fc7c7f4e1aff4a81e718109e13409767e4f871443cbff3dba3578203d"}, - {file = "ruamel.yaml.clib-0.2.8-cp310-cp310-win32.whl", hash = "sha256:c69212f63169ec1cfc9bb44723bf2917cbbd8f6191a00ef3410f5a7fe300722d"}, - {file = "ruamel.yaml.clib-0.2.8-cp310-cp310-win_amd64.whl", hash = "sha256:cabddb8d8ead485e255fe80429f833172b4cadf99274db39abc080e068cbcc31"}, - {file = "ruamel.yaml.clib-0.2.8-cp311-cp311-macosx_10_9_universal2.whl", hash = "sha256:bef08cd86169d9eafb3ccb0a39edb11d8e25f3dae2b28f5c52fd997521133069"}, - {file = "ruamel.yaml.clib-0.2.8-cp311-cp311-macosx_13_0_arm64.whl", hash = "sha256:b16420e621d26fdfa949a8b4b47ade8810c56002f5389970db4ddda51dbff248"}, - {file = "ruamel.yaml.clib-0.2.8-cp311-cp311-manylinux_2_17_x86_64.manylinux2014_x86_64.manylinux_2_24_x86_64.whl", hash = "sha256:25c515e350e5b739842fc3228d662413ef28f295791af5e5110b543cf0b57d9b"}, - {file = "ruamel.yaml.clib-0.2.8-cp311-cp311-manylinux_2_24_aarch64.whl", hash = "sha256:1707814f0d9791df063f8c19bb51b0d1278b8e9a2353abbb676c2f685dee6afe"}, - {file = "ruamel.yaml.clib-0.2.8-cp311-cp311-musllinux_1_1_i686.whl", hash = "sha256:46d378daaac94f454b3a0e3d8d78cafd78a026b1d71443f4966c696b48a6d899"}, - {file = "ruamel.yaml.clib-0.2.8-cp311-cp311-musllinux_1_1_x86_64.whl", hash = "sha256:09b055c05697b38ecacb7ac50bdab2240bfca1a0c4872b0fd309bb07dc9aa3a9"}, - {file = "ruamel.yaml.clib-0.2.8-cp311-cp311-win32.whl", hash = "sha256:53a300ed9cea38cf5a2a9b069058137c2ca1ce658a874b79baceb8f892f915a7"}, - {file = "ruamel.yaml.clib-0.2.8-cp311-cp311-win_amd64.whl", hash = "sha256:c2a72e9109ea74e511e29032f3b670835f8a59bbdc9ce692c5b4ed91ccf1eedb"}, - {file = "ruamel.yaml.clib-0.2.8-cp312-cp312-macosx_10_9_universal2.whl", hash = "sha256:ebc06178e8821efc9692ea7544aa5644217358490145629914d8020042c24aa1"}, - {file = "ruamel.yaml.clib-0.2.8-cp312-cp312-macosx_13_0_arm64.whl", hash = "sha256:edaef1c1200c4b4cb914583150dcaa3bc30e592e907c01117c08b13a07255ec2"}, - {file = "ruamel.yaml.clib-0.2.8-cp312-cp312-manylinux_2_17_x86_64.manylinux2014_x86_64.manylinux_2_28_x86_64.whl", hash = "sha256:d176b57452ab5b7028ac47e7b3cf644bcfdc8cacfecf7e71759f7f51a59e5c92"}, - {file = "ruamel.yaml.clib-0.2.8-cp312-cp312-manylinux_2_24_aarch64.whl", hash = "sha256:1dc67314e7e1086c9fdf2680b7b6c2be1c0d8e3a8279f2e993ca2a7545fecf62"}, - {file = "ruamel.yaml.clib-0.2.8-cp312-cp312-musllinux_1_1_i686.whl", hash = "sha256:3213ece08ea033eb159ac52ae052a4899b56ecc124bb80020d9bbceeb50258e9"}, - {file = "ruamel.yaml.clib-0.2.8-cp312-cp312-musllinux_1_1_x86_64.whl", hash = "sha256:aab7fd643f71d7946f2ee58cc88c9b7bfc97debd71dcc93e03e2d174628e7e2d"}, - {file = "ruamel.yaml.clib-0.2.8-cp312-cp312-win32.whl", hash = "sha256:5c365d91c88390c8d0a8545df0b5857172824b1c604e867161e6b3d59a827eaa"}, - {file = "ruamel.yaml.clib-0.2.8-cp312-cp312-win_amd64.whl", hash = "sha256:1758ce7d8e1a29d23de54a16ae867abd370f01b5a69e1a3ba75223eaa3ca1a1b"}, - {file = "ruamel.yaml.clib-0.2.8-cp36-cp36m-manylinux_2_5_x86_64.manylinux1_x86_64.whl", hash = "sha256:a5aa27bad2bb83670b71683aae140a1f52b0857a2deff56ad3f6c13a017a26ed"}, - {file = "ruamel.yaml.clib-0.2.8-cp37-cp37m-macosx_10_9_x86_64.whl", hash = "sha256:c58ecd827313af6864893e7af0a3bb85fd529f862b6adbefe14643947cfe2942"}, - {file = "ruamel.yaml.clib-0.2.8-cp37-cp37m-macosx_12_0_arm64.whl", hash = "sha256:f481f16baec5290e45aebdc2a5168ebc6d35189ae6fea7a58787613a25f6e875"}, - {file = "ruamel.yaml.clib-0.2.8-cp37-cp37m-manylinux_2_24_aarch64.whl", hash = "sha256:77159f5d5b5c14f7c34073862a6b7d34944075d9f93e681638f6d753606c6ce6"}, - {file = "ruamel.yaml.clib-0.2.8-cp37-cp37m-manylinux_2_5_x86_64.manylinux1_x86_64.whl", hash = "sha256:7f67a1ee819dc4562d444bbafb135832b0b909f81cc90f7aa00260968c9ca1b3"}, - {file = "ruamel.yaml.clib-0.2.8-cp37-cp37m-musllinux_1_1_i686.whl", hash = "sha256:4ecbf9c3e19f9562c7fdd462e8d18dd902a47ca046a2e64dba80699f0b6c09b7"}, - {file = "ruamel.yaml.clib-0.2.8-cp37-cp37m-musllinux_1_1_x86_64.whl", hash = "sha256:87ea5ff66d8064301a154b3933ae406b0863402a799b16e4a1d24d9fbbcbe0d3"}, - {file = "ruamel.yaml.clib-0.2.8-cp37-cp37m-win32.whl", hash = "sha256:75e1ed13e1f9de23c5607fe6bd1aeaae21e523b32d83bb33918245361e9cc51b"}, - {file = "ruamel.yaml.clib-0.2.8-cp37-cp37m-win_amd64.whl", hash = "sha256:3f215c5daf6a9d7bbed4a0a4f760f3113b10e82ff4c5c44bec20a68c8014f675"}, - {file = "ruamel.yaml.clib-0.2.8-cp38-cp38-macosx_10_9_x86_64.whl", hash = "sha256:1b617618914cb00bf5c34d4357c37aa15183fa229b24767259657746c9077615"}, - {file = "ruamel.yaml.clib-0.2.8-cp38-cp38-macosx_12_0_arm64.whl", hash = "sha256:a6a9ffd280b71ad062eae53ac1659ad86a17f59a0fdc7699fd9be40525153337"}, - {file = "ruamel.yaml.clib-0.2.8-cp38-cp38-manylinux_2_24_aarch64.whl", hash = "sha256:305889baa4043a09e5b76f8e2a51d4ffba44259f6b4c72dec8ca56207d9c6fe1"}, - {file = "ruamel.yaml.clib-0.2.8-cp38-cp38-manylinux_2_5_x86_64.manylinux1_x86_64.whl", hash = "sha256:700e4ebb569e59e16a976857c8798aee258dceac7c7d6b50cab63e080058df91"}, - {file = "ruamel.yaml.clib-0.2.8-cp38-cp38-musllinux_1_1_i686.whl", hash = "sha256:e2b4c44b60eadec492926a7270abb100ef9f72798e18743939bdbf037aab8c28"}, - {file = "ruamel.yaml.clib-0.2.8-cp38-cp38-musllinux_1_1_x86_64.whl", hash = "sha256:e79e5db08739731b0ce4850bed599235d601701d5694c36570a99a0c5ca41a9d"}, - {file = "ruamel.yaml.clib-0.2.8-cp38-cp38-win32.whl", hash = "sha256:955eae71ac26c1ab35924203fda6220f84dce57d6d7884f189743e2abe3a9fbe"}, - {file = "ruamel.yaml.clib-0.2.8-cp38-cp38-win_amd64.whl", hash = "sha256:56f4252222c067b4ce51ae12cbac231bce32aee1d33fbfc9d17e5b8d6966c312"}, - {file = "ruamel.yaml.clib-0.2.8-cp39-cp39-macosx_10_9_x86_64.whl", hash = "sha256:03d1162b6d1df1caa3a4bd27aa51ce17c9afc2046c31b0ad60a0a96ec22f8001"}, - {file = "ruamel.yaml.clib-0.2.8-cp39-cp39-macosx_12_0_arm64.whl", hash = "sha256:bba64af9fa9cebe325a62fa398760f5c7206b215201b0ec825005f1b18b9bccf"}, - {file = "ruamel.yaml.clib-0.2.8-cp39-cp39-manylinux_2_24_aarch64.whl", hash = "sha256:a1a45e0bb052edf6a1d3a93baef85319733a888363938e1fc9924cb00c8df24c"}, - {file = "ruamel.yaml.clib-0.2.8-cp39-cp39-manylinux_2_5_x86_64.manylinux1_x86_64.whl", hash = "sha256:da09ad1c359a728e112d60116f626cc9f29730ff3e0e7db72b9a2dbc2e4beed5"}, - {file = "ruamel.yaml.clib-0.2.8-cp39-cp39-musllinux_1_1_i686.whl", hash = "sha256:184565012b60405d93838167f425713180b949e9d8dd0bbc7b49f074407c5a8b"}, - {file = "ruamel.yaml.clib-0.2.8-cp39-cp39-musllinux_1_1_x86_64.whl", hash = "sha256:a75879bacf2c987c003368cf14bed0ffe99e8e85acfa6c0bfffc21a090f16880"}, - {file = "ruamel.yaml.clib-0.2.8-cp39-cp39-win32.whl", hash = "sha256:84b554931e932c46f94ab306913ad7e11bba988104c5cff26d90d03f68258cd5"}, - {file = "ruamel.yaml.clib-0.2.8-cp39-cp39-win_amd64.whl", hash = "sha256:25ac8c08322002b06fa1d49d1646181f0b2c72f5cbc15a85e80b4c30a544bb15"}, - {file = "ruamel.yaml.clib-0.2.8.tar.gz", hash = "sha256:beb2e0404003de9a4cab9753a8805a8fe9320ee6673136ed7f04255fe60bb512"}, -] - -[[package]] -name = "scipy" -version = "1.13.0" -description = "Fundamental algorithms for scientific computing in Python" -optional = true -python-versions = ">=3.9" -files = [ - {file = "scipy-1.13.0-cp310-cp310-macosx_10_9_x86_64.whl", hash = "sha256:ba419578ab343a4e0a77c0ef82f088238a93eef141b2b8017e46149776dfad4d"}, - {file = "scipy-1.13.0-cp310-cp310-macosx_12_0_arm64.whl", hash = "sha256:22789b56a999265431c417d462e5b7f2b487e831ca7bef5edeb56efe4c93f86e"}, - {file = "scipy-1.13.0-cp310-cp310-manylinux_2_17_aarch64.manylinux2014_aarch64.whl", hash = "sha256:05f1432ba070e90d42d7fd836462c50bf98bd08bed0aa616c359eed8a04e3922"}, - {file = "scipy-1.13.0-cp310-cp310-manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:b8434f6f3fa49f631fae84afee424e2483289dfc30a47755b4b4e6b07b2633a4"}, - {file = "scipy-1.13.0-cp310-cp310-musllinux_1_1_x86_64.whl", hash = "sha256:dcbb9ea49b0167de4167c40eeee6e167caeef11effb0670b554d10b1e693a8b9"}, - {file = "scipy-1.13.0-cp310-cp310-win_amd64.whl", hash = "sha256:1d2f7bb14c178f8b13ebae93f67e42b0a6b0fc50eba1cd8021c9b6e08e8fb1cd"}, - {file = "scipy-1.13.0-cp311-cp311-macosx_10_9_x86_64.whl", hash = "sha256:0fbcf8abaf5aa2dc8d6400566c1a727aed338b5fe880cde64907596a89d576fa"}, - {file = "scipy-1.13.0-cp311-cp311-macosx_12_0_arm64.whl", hash = "sha256:5e4a756355522eb60fcd61f8372ac2549073c8788f6114449b37e9e8104f15a5"}, - {file = "scipy-1.13.0-cp311-cp311-manylinux_2_17_aarch64.manylinux2014_aarch64.whl", hash = "sha256:b5acd8e1dbd8dbe38d0004b1497019b2dbbc3d70691e65d69615f8a7292865d7"}, - {file = "scipy-1.13.0-cp311-cp311-manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:9ff7dad5d24a8045d836671e082a490848e8639cabb3dbdacb29f943a678683d"}, - {file = "scipy-1.13.0-cp311-cp311-musllinux_1_1_x86_64.whl", hash = "sha256:4dca18c3ffee287ddd3bc8f1dabaf45f5305c5afc9f8ab9cbfab855e70b2df5c"}, - {file = "scipy-1.13.0-cp311-cp311-win_amd64.whl", hash = "sha256:a2f471de4d01200718b2b8927f7d76b5d9bde18047ea0fa8bd15c5ba3f26a1d6"}, - {file = "scipy-1.13.0-cp312-cp312-macosx_10_9_x86_64.whl", hash = "sha256:d0de696f589681c2802f9090fff730c218f7c51ff49bf252b6a97ec4a5d19e8b"}, - {file = "scipy-1.13.0-cp312-cp312-macosx_12_0_arm64.whl", hash = "sha256:b2a3ff461ec4756b7e8e42e1c681077349a038f0686132d623fa404c0bee2551"}, - {file = "scipy-1.13.0-cp312-cp312-manylinux_2_17_aarch64.manylinux2014_aarch64.whl", hash = "sha256:6bf9fe63e7a4bf01d3645b13ff2aa6dea023d38993f42aaac81a18b1bda7a82a"}, - {file = "scipy-1.13.0-cp312-cp312-manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:1e7626dfd91cdea5714f343ce1176b6c4745155d234f1033584154f60ef1ff42"}, - {file = "scipy-1.13.0-cp312-cp312-musllinux_1_1_x86_64.whl", hash = "sha256:109d391d720fcebf2fbe008621952b08e52907cf4c8c7efc7376822151820820"}, - {file = "scipy-1.13.0-cp312-cp312-win_amd64.whl", hash = "sha256:8930ae3ea371d6b91c203b1032b9600d69c568e537b7988a3073dfe4d4774f21"}, - {file = "scipy-1.13.0-cp39-cp39-macosx_10_9_x86_64.whl", hash = "sha256:5407708195cb38d70fd2d6bb04b1b9dd5c92297d86e9f9daae1576bd9e06f602"}, - {file = "scipy-1.13.0-cp39-cp39-macosx_12_0_arm64.whl", hash = "sha256:ac38c4c92951ac0f729c4c48c9e13eb3675d9986cc0c83943784d7390d540c78"}, - {file = "scipy-1.13.0-cp39-cp39-manylinux_2_17_aarch64.manylinux2014_aarch64.whl", hash = "sha256:09c74543c4fbeb67af6ce457f6a6a28e5d3739a87f62412e4a16e46f164f0ae5"}, - {file = "scipy-1.13.0-cp39-cp39-manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:28e286bf9ac422d6beb559bc61312c348ca9b0f0dae0d7c5afde7f722d6ea13d"}, - {file = "scipy-1.13.0-cp39-cp39-musllinux_1_1_x86_64.whl", hash = "sha256:33fde20efc380bd23a78a4d26d59fc8704e9b5fd9b08841693eb46716ba13d86"}, - {file = "scipy-1.13.0-cp39-cp39-win_amd64.whl", hash = "sha256:45c08bec71d3546d606989ba6e7daa6f0992918171e2a6f7fbedfa7361c2de1e"}, - {file = "scipy-1.13.0.tar.gz", hash = "sha256:58569af537ea29d3f78e5abd18398459f195546bb3be23d16677fb26616cc11e"}, -] - -[package.dependencies] -numpy = ">=1.22.4,<2.3" - -[package.extras] -dev = ["cython-lint (>=0.12.2)", "doit (>=0.36.0)", "mypy", "pycodestyle", "pydevtool", "rich-click", "ruff", "types-psutil", "typing_extensions"] -doc = ["jupyterlite-pyodide-kernel", "jupyterlite-sphinx (>=0.12.0)", "jupytext", "matplotlib (>=3.5)", "myst-nb", "numpydoc", "pooch", "pydata-sphinx-theme (>=0.15.2)", "sphinx (>=5.0.0)", "sphinx-design (>=0.4.0)"] -test = ["array-api-strict", "asv", "gmpy2", "hypothesis (>=6.30)", "mpmath", "pooch", "pytest", "pytest-cov", "pytest-timeout", "pytest-xdist", "scikit-umfpack", "threadpoolctl"] - -[[package]] -name = "send2trash" -version = "1.8.3" -description = "Send file to trash natively under Mac OS X, Windows and Linux" -optional = true -python-versions = "!=3.0.*,!=3.1.*,!=3.2.*,!=3.3.*,!=3.4.*,!=3.5.*,>=2.7" -files = [ - {file = "Send2Trash-1.8.3-py3-none-any.whl", hash = "sha256:0c31227e0bd08961c7665474a3d1ef7193929fedda4233843689baa056be46c9"}, - {file = "Send2Trash-1.8.3.tar.gz", hash = "sha256:b18e7a3966d99871aefeb00cfbcfdced55ce4871194810fc71f4aa484b953abf"}, -] - -[package.extras] -nativelib = ["pyobjc-framework-Cocoa", "pywin32"] -objc = ["pyobjc-framework-Cocoa"] -win32 = ["pywin32"] - -[[package]] -name = "simpy" -version = "4.1.1" -description = "Event discrete, process based simulation for Python." -optional = true -python-versions = ">=3.8" -files = [ - {file = "simpy-4.1.1-py3-none-any.whl", hash = "sha256:7c5ae380240fd2238671160e4830956f8055830a8317edf5c05e495b3823cd88"}, - {file = "simpy-4.1.1.tar.gz", hash = "sha256:06d0750a7884b11e0e8e20ce0bc7c6d4ed5f1743d456695340d13fdff95001a6"}, -] - -[[package]] -name = "six" -version = "1.16.0" -description = "Python 2 and 3 compatibility utilities" -optional = false -python-versions = ">=2.7, !=3.0.*, !=3.1.*, !=3.2.*" -files = [ - {file = "six-1.16.0-py2.py3-none-any.whl", hash = "sha256:8abb2f1d86890a2dfb989f9a77cfcfd3e47c2a354b01111771326f8aa26e0254"}, - {file = "six-1.16.0.tar.gz", hash = "sha256:1e61c37477a1626458e36f7b1d82aa5c9b094fa4802892072e49de9c60c4c926"}, -] - -[[package]] -name = "sniffio" -version = "1.3.1" -description = "Sniff out which async library your code is running under" -optional = true -python-versions = ">=3.7" -files = [ - {file = "sniffio-1.3.1-py3-none-any.whl", hash = "sha256:2f6da418d1f1e0fddd844478f41680e794e6051915791a034ff65e5f100525a2"}, - {file = "sniffio-1.3.1.tar.gz", hash = "sha256:f4324edc670a0f49750a81b895f35c3adb843cca46f0530f79fc1babb23789dc"}, -] - -[[package]] -name = "sortedcontainers" -version = "2.4.0" -description = "Sorted Containers -- Sorted List, Sorted Dict, Sorted Set" -optional = true -python-versions = "*" -files = [ - {file = "sortedcontainers-2.4.0-py2.py3-none-any.whl", hash = "sha256:a163dcaede0f1c021485e957a39245190e74249897e2ae4b2aa38595db237ee0"}, - {file = "sortedcontainers-2.4.0.tar.gz", hash = "sha256:25caa5a06cc30b6b83d11423433f65d1f9d76c4c6a0c90e3379eaa43b9bfdb88"}, -] - -[[package]] -name = "soupsieve" -version = "2.5" -description = "A modern CSS selector implementation for Beautiful Soup." -optional = true -python-versions = ">=3.8" -files = [ - {file = "soupsieve-2.5-py3-none-any.whl", hash = "sha256:eaa337ff55a1579b6549dc679565eac1e3d000563bcb1c8ab0d0fefbc0c2cdc7"}, - {file = "soupsieve-2.5.tar.gz", hash = "sha256:5663d5a7b3bfaeee0bc4372e7fc48f9cff4940b3eec54a6451cc5299f1097690"}, -] - -[[package]] -name = "stack-data" -version = "0.6.3" -description = "Extract data from python stack frames and tracebacks for informative displays" -optional = true -python-versions = "*" -files = [ - {file = "stack_data-0.6.3-py3-none-any.whl", hash = "sha256:d5558e0c25a4cb0853cddad3d77da9891a08cb85dd9f9f91b9f8cd66e511e695"}, - {file = "stack_data-0.6.3.tar.gz", hash = "sha256:836a778de4fec4dcd1dcd89ed8abff8a221f58308462e1c4aa2a3cf30148f0b9"}, -] - -[package.dependencies] -asttokens = ">=2.1.0" -executing = ">=1.2.0" -pure-eval = "*" - -[package.extras] -tests = ["cython", "littleutils", "pygments", "pytest", "typeguard"] - -[[package]] -name = "statsmodels" -version = "0.14.2" -description = "Statistical computations and models for Python" -optional = true -python-versions = ">=3.9" -files = [ - {file = "statsmodels-0.14.2-cp310-cp310-macosx_10_9_x86_64.whl", hash = "sha256:df5d6f95c46f0341da6c79ee7617e025bf2b371e190a8e60af1ae9cabbdb7a97"}, - {file = "statsmodels-0.14.2-cp310-cp310-macosx_11_0_arm64.whl", hash = "sha256:a87ef21fadb445b650f327340dde703f13aec1540f3d497afb66324499dea97a"}, - {file = "statsmodels-0.14.2-cp310-cp310-manylinux_2_17_aarch64.manylinux2014_aarch64.whl", hash = "sha256:5827a12e3ede2b98a784476d61d6bec43011fedb64aa815f2098e0573bece257"}, - {file = "statsmodels-0.14.2-cp310-cp310-manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:10f2b7611a61adb7d596a6d239abdf1a4d5492b931b00d5ed23d32844d40e48e"}, - {file = "statsmodels-0.14.2-cp310-cp310-musllinux_1_1_x86_64.whl", hash = "sha256:c254c66142f1167b4c7d031cf8db55294cc62ff3280e090fc45bd10a7f5fd029"}, - {file = "statsmodels-0.14.2-cp310-cp310-win_amd64.whl", hash = "sha256:0e46e9d59293c1af4cc1f4e5248f17e7e7bc596bfce44d327c789ac27f09111b"}, - {file = "statsmodels-0.14.2-cp311-cp311-macosx_10_9_x86_64.whl", hash = "sha256:50fcb633987779e795142f51ba49fb27648d46e8a1382b32ebe8e503aaabaa9e"}, - {file = "statsmodels-0.14.2-cp311-cp311-macosx_11_0_arm64.whl", hash = "sha256:876794068abfaeed41df71b7887000031ecf44fbfa6b50d53ccb12ebb4ab747a"}, - {file = "statsmodels-0.14.2-cp311-cp311-manylinux_2_17_aarch64.manylinux2014_aarch64.whl", hash = "sha256:7a91f6c4943de13e3ce2e20ee3b5d26d02bd42300616a421becd53756f5deb37"}, - {file = "statsmodels-0.14.2-cp311-cp311-manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:4864a1c4615c5ea5f2e3b078a75bdedc90dd9da210a37e0738e064b419eccee2"}, - {file = "statsmodels-0.14.2-cp311-cp311-musllinux_1_1_x86_64.whl", hash = "sha256:afbd92410e0df06f3d8c4e7c0e2e71f63f4969531f280fb66059e2ecdb6e0415"}, - {file = "statsmodels-0.14.2-cp311-cp311-win_amd64.whl", hash = "sha256:8e004cfad0e46ce73fe3f3812010c746f0d4cfd48e307b45c14e9e360f3d2510"}, - {file = "statsmodels-0.14.2-cp312-cp312-macosx_10_9_x86_64.whl", hash = "sha256:eb0ba1ad3627705f5ae20af6b2982f500546d43892543b36c7bca3e2f87105e7"}, - {file = "statsmodels-0.14.2-cp312-cp312-macosx_11_0_arm64.whl", hash = "sha256:90fd2f0110b73fc3fa5a2f21c3ca99b0e22285cccf38e56b5b8fd8ce28791b0f"}, - {file = "statsmodels-0.14.2-cp312-cp312-manylinux_2_17_aarch64.manylinux2014_aarch64.whl", hash = "sha256:ac780ad9ff552773798829a0b9c46820b0faa10e6454891f5e49a845123758ab"}, - {file = "statsmodels-0.14.2-cp312-cp312-manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:55d1742778400ae67acb04b50a2c7f5804182f8a874bd09ca397d69ed159a751"}, - {file = "statsmodels-0.14.2-cp312-cp312-musllinux_1_1_x86_64.whl", hash = "sha256:f870d14a587ea58a3b596aa994c2ed889cc051f9e450e887d2c83656fc6a64bf"}, - {file = "statsmodels-0.14.2-cp312-cp312-win_amd64.whl", hash = "sha256:f450fcbae214aae66bd9d2b9af48e0f8ba1cb0e8596c6ebb34e6e3f0fec6542c"}, - {file = "statsmodels-0.14.2-cp39-cp39-macosx_10_9_x86_64.whl", hash = "sha256:201c3d00929c4a67cda1fe05b098c8dcf1b1eeefa88e80a8f963a844801ed59f"}, - {file = "statsmodels-0.14.2-cp39-cp39-macosx_11_0_arm64.whl", hash = "sha256:9edefa4ce08e40bc1d67d2f79bc686ee5e238e801312b5a029ee7786448c389a"}, - {file = "statsmodels-0.14.2-cp39-cp39-manylinux_2_17_aarch64.manylinux2014_aarch64.whl", hash = "sha256:29c78a7601fdae1aa32104c5ebff2e0b72c26f33e870e2f94ab1bcfd927ece9b"}, - {file = "statsmodels-0.14.2-cp39-cp39-manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:f36494df7c03d63168fccee5038a62f469469ed6a4dd6eaeb9338abedcd0d5f5"}, - {file = "statsmodels-0.14.2-cp39-cp39-win_amd64.whl", hash = "sha256:8875823bdd41806dc853333cc4e1b7ef9481bad2380a999e66ea42382cf2178d"}, - {file = "statsmodels-0.14.2.tar.gz", hash = "sha256:890550147ad3a81cda24f0ba1a5c4021adc1601080bd00e191ae7cd6feecd6ad"}, -] - -[package.dependencies] -numpy = ">=1.22.3" -packaging = ">=21.3" -pandas = ">=1.4,<2.1.0 || >2.1.0" -patsy = ">=0.5.6" -scipy = ">=1.8,<1.9.2 || >1.9.2" - -[package.extras] -build = ["cython (>=0.29.33)"] -develop = ["colorama", "cython (>=0.29.33)", "cython (>=3.0.10,<4)", "flake8", "isort", "joblib", "matplotlib (>=3)", "pytest (>=7.3.0,<8)", "pytest-cov", "pytest-randomly", "pytest-xdist", "pywinpty", "setuptools-scm[toml] (>=8.0,<9.0)"] -docs = ["ipykernel", "jupyter-client", "matplotlib", "nbconvert", "nbformat", "numpydoc", "pandas-datareader", "sphinx"] - -[[package]] -name = "terminado" -version = "0.18.1" -description = "Tornado websocket backend for the Xterm.js Javascript terminal emulator library." -optional = true -python-versions = ">=3.8" -files = [ - {file = "terminado-0.18.1-py3-none-any.whl", hash = "sha256:a4468e1b37bb318f8a86514f65814e1afc977cf29b3992a4500d9dd305dcceb0"}, - {file = "terminado-0.18.1.tar.gz", hash = "sha256:de09f2c4b85de4765f7714688fff57d3e75bad1f909b589fde880460c753fd2e"}, -] - -[package.dependencies] -ptyprocess = {version = "*", markers = "os_name != \"nt\""} -pywinpty = {version = ">=1.1.0", markers = "os_name == \"nt\""} -tornado = ">=6.1.0" - -[package.extras] -docs = ["myst-parser", "pydata-sphinx-theme", "sphinx"] -test = ["pre-commit", "pytest (>=7.0)", "pytest-timeout"] -typing = ["mypy (>=1.6,<2.0)", "traitlets (>=5.11.1)"] - -[[package]] -name = "text-unidecode" -version = "1.3" -description = "The most basic Text::Unidecode port" -optional = true -python-versions = "*" -files = [ - {file = "text-unidecode-1.3.tar.gz", hash = "sha256:bad6603bb14d279193107714b288be206cac565dfa49aa5b105294dd5c4aab93"}, - {file = "text_unidecode-1.3-py2.py3-none-any.whl", hash = "sha256:1311f10e8b895935241623731c2ba64f4c455287888b18189350b67134a822e8"}, -] - -[[package]] -name = "tinycss2" -version = "1.3.0" -description = "A tiny CSS parser" -optional = true -python-versions = ">=3.8" -files = [ - {file = "tinycss2-1.3.0-py3-none-any.whl", hash = "sha256:54a8dbdffb334d536851be0226030e9505965bb2f30f21a4a82c55fb2a80fae7"}, - {file = "tinycss2-1.3.0.tar.gz", hash = "sha256:152f9acabd296a8375fbca5b84c961ff95971fcfc32e79550c8df8e29118c54d"}, -] - -[package.dependencies] -webencodings = ">=0.4" - -[package.extras] -doc = ["sphinx", "sphinx_rtd_theme"] -test = ["pytest", "ruff"] - -[[package]] -name = "tomli" -version = "2.0.1" -description = "A lil' TOML parser" -optional = true -python-versions = ">=3.7" -files = [ - {file = "tomli-2.0.1-py3-none-any.whl", hash = "sha256:939de3e7a6161af0c887ef91b7d41a53e7c5a1ca976325f429cb46ea9bc30ecc"}, - {file = "tomli-2.0.1.tar.gz", hash = "sha256:de526c12914f0c550d15924c62d72abc48d6fe7364aa87328337a31007fe8a4f"}, -] - -[[package]] -name = "tornado" -version = "6.4" -description = "Tornado is a Python web framework and asynchronous networking library, originally developed at FriendFeed." -optional = true -python-versions = ">= 3.8" -files = [ - {file = "tornado-6.4-cp38-abi3-macosx_10_9_universal2.whl", hash = "sha256:02ccefc7d8211e5a7f9e8bc3f9e5b0ad6262ba2fbb683a6443ecc804e5224ce0"}, - {file = "tornado-6.4-cp38-abi3-macosx_10_9_x86_64.whl", hash = "sha256:27787de946a9cffd63ce5814c33f734c627a87072ec7eed71f7fc4417bb16263"}, - {file = "tornado-6.4-cp38-abi3-manylinux_2_17_aarch64.manylinux2014_aarch64.whl", hash = "sha256:f7894c581ecdcf91666a0912f18ce5e757213999e183ebfc2c3fdbf4d5bd764e"}, - {file = "tornado-6.4-cp38-abi3-manylinux_2_5_i686.manylinux1_i686.manylinux_2_17_i686.manylinux2014_i686.whl", hash = "sha256:e43bc2e5370a6a8e413e1e1cd0c91bedc5bd62a74a532371042a18ef19e10579"}, - {file = "tornado-6.4-cp38-abi3-manylinux_2_5_x86_64.manylinux1_x86_64.manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:f0251554cdd50b4b44362f73ad5ba7126fc5b2c2895cc62b14a1c2d7ea32f212"}, - {file = "tornado-6.4-cp38-abi3-musllinux_1_1_aarch64.whl", hash = "sha256:fd03192e287fbd0899dd8f81c6fb9cbbc69194d2074b38f384cb6fa72b80e9c2"}, - {file = "tornado-6.4-cp38-abi3-musllinux_1_1_i686.whl", hash = "sha256:88b84956273fbd73420e6d4b8d5ccbe913c65d31351b4c004ae362eba06e1f78"}, - {file = "tornado-6.4-cp38-abi3-musllinux_1_1_x86_64.whl", hash = "sha256:71ddfc23a0e03ef2df1c1397d859868d158c8276a0603b96cf86892bff58149f"}, - {file = "tornado-6.4-cp38-abi3-win32.whl", hash = "sha256:6f8a6c77900f5ae93d8b4ae1196472d0ccc2775cc1dfdc9e7727889145c45052"}, - {file = "tornado-6.4-cp38-abi3-win_amd64.whl", hash = "sha256:10aeaa8006333433da48dec9fe417877f8bcc21f48dda8d661ae79da357b2a63"}, - {file = "tornado-6.4.tar.gz", hash = "sha256:72291fa6e6bc84e626589f1c29d90a5a6d593ef5ae68052ee2ef000dfd273dee"}, -] - -[[package]] -name = "traitlets" -version = "5.14.3" -description = "Traitlets Python configuration system" -optional = true -python-versions = ">=3.8" -files = [ - {file = "traitlets-5.14.3-py3-none-any.whl", hash = "sha256:b74e89e397b1ed28cc831db7aea759ba6640cb3de13090ca145426688ff1ac4f"}, - {file = "traitlets-5.14.3.tar.gz", hash = "sha256:9ed0579d3502c94b4b3732ac120375cda96f923114522847de4b3bb98b96b6b7"}, -] - -[package.extras] -docs = ["myst-parser", "pydata-sphinx-theme", "sphinx"] -test = ["argcomplete (>=3.0.3)", "mypy (>=1.7.0)", "pre-commit", "pytest (>=7.0,<8.2)", "pytest-mock", "pytest-mypy-testing"] - -[[package]] -name = "treon" -version = "0.1.4" -description = "Testing framework for Jupyter Notebooks" -optional = true -python-versions = ">=3" -files = [ - {file = "treon-0.1.4-py3-none-any.whl", hash = "sha256:ab7f54c7f45ee38ee27f9022e065a7fc261f09b36dc595f619393a0548d93a17"}, - {file = "treon-0.1.4.tar.gz", hash = "sha256:6c31a1701036ee8a746adcc9ca59640269c01e887ea13ccc675680d39705d4f4"}, -] - -[package.dependencies] -docopt = "*" -jupyter = "*" -jupyter-client = "*" -nbconvert = "*" - -[[package]] -name = "types-python-dateutil" -version = "2.9.0.20240316" -description = "Typing stubs for python-dateutil" -optional = true -python-versions = ">=3.8" -files = [ - {file = "types-python-dateutil-2.9.0.20240316.tar.gz", hash = "sha256:5d2f2e240b86905e40944dd787db6da9263f0deabef1076ddaed797351ec0202"}, - {file = "types_python_dateutil-2.9.0.20240316-py3-none-any.whl", hash = "sha256:6b8cb66d960771ce5ff974e9dd45e38facb81718cc1e208b10b1baccbfdbee3b"}, -] - -[[package]] -name = "typing-extensions" -version = "4.11.0" -description = "Backported and Experimental Type Hints for Python 3.8+" -optional = true -python-versions = ">=3.8" -files = [ - {file = "typing_extensions-4.11.0-py3-none-any.whl", hash = "sha256:c1f94d72897edaf4ce775bb7558d5b79d8126906a14ea5ed1635921406c0387a"}, - {file = "typing_extensions-4.11.0.tar.gz", hash = "sha256:83f085bd5ca59c80295fc2a82ab5dac679cbe02b9f33f7d83af68e241bea51b0"}, -] - -[[package]] -name = "tzdata" -version = "2024.1" -description = "Provider of IANA time zone data" -optional = false -python-versions = ">=2" -files = [ - {file = "tzdata-2024.1-py2.py3-none-any.whl", hash = "sha256:9068bc196136463f5245e51efda838afa15aaeca9903f49050dfa2679db4d252"}, - {file = "tzdata-2024.1.tar.gz", hash = "sha256:2674120f8d891909751c38abcdfd386ac0a5a1127954fbc332af6b5ceae07efd"}, -] - -[[package]] -name = "uri-template" -version = "1.3.0" -description = "RFC 6570 URI Template Processor" -optional = true -python-versions = ">=3.7" -files = [ - {file = "uri-template-1.3.0.tar.gz", hash = "sha256:0e00f8eb65e18c7de20d595a14336e9f337ead580c70934141624b6d1ffdacc7"}, - {file = "uri_template-1.3.0-py3-none-any.whl", hash = "sha256:a44a133ea12d44a0c0f06d7d42a52d71282e77e2f937d8abd5655b8d56fc1363"}, -] - -[package.extras] -dev = ["flake8", "flake8-annotations", "flake8-bandit", "flake8-bugbear", "flake8-commas", "flake8-comprehensions", "flake8-continuation", "flake8-datetimez", "flake8-docstrings", "flake8-import-order", "flake8-literal", "flake8-modern-annotations", "flake8-noqa", "flake8-pyproject", "flake8-requirements", "flake8-typechecking-import", "flake8-use-fstring", "mypy", "pep8-naming", "types-PyYAML"] - -[[package]] -name = "urllib3" -version = "2.2.1" -description = "HTTP library with thread-safe connection pooling, file post, and more." -optional = true -python-versions = ">=3.8" -files = [ - {file = "urllib3-2.2.1-py3-none-any.whl", hash = "sha256:450b20ec296a467077128bff42b73080516e71b56ff59a60a02bef2232c4fa9d"}, - {file = "urllib3-2.2.1.tar.gz", hash = "sha256:d0570876c61ab9e520d776c38acbbb5b05a776d3f9ff98a5c8fd5162a444cf19"}, -] - -[package.extras] -brotli = ["brotli (>=1.0.9)", "brotlicffi (>=0.8.0)"] -h2 = ["h2 (>=4,<5)"] -socks = ["pysocks (>=1.5.6,!=1.5.7,<2.0)"] -zstd = ["zstandard (>=0.18.0)"] - -[[package]] -name = "wcwidth" -version = "0.2.13" -description = "Measures the displayed width of unicode strings in a terminal" -optional = true -python-versions = "*" -files = [ - {file = "wcwidth-0.2.13-py2.py3-none-any.whl", hash = "sha256:3da69048e4540d84af32131829ff948f1e022c1c6bdb8d6102117aac784f6859"}, - {file = "wcwidth-0.2.13.tar.gz", hash = "sha256:72ea0c06399eb286d978fdedb6923a9eb47e1c486ce63e9b4e64fc18303972b5"}, -] - -[[package]] -name = "webcolors" -version = "1.13" -description = "A library for working with the color formats defined by HTML and CSS." -optional = true -python-versions = ">=3.7" -files = [ - {file = "webcolors-1.13-py3-none-any.whl", hash = "sha256:29bc7e8752c0a1bd4a1f03c14d6e6a72e93d82193738fa860cbff59d0fcc11bf"}, - {file = "webcolors-1.13.tar.gz", hash = "sha256:c225b674c83fa923be93d235330ce0300373d02885cef23238813b0d5668304a"}, -] - -[package.extras] -docs = ["furo", "sphinx", "sphinx-copybutton", "sphinx-inline-tabs", "sphinx-notfound-page", "sphinxext-opengraph"] -tests = ["pytest", "pytest-cov"] - -[[package]] -name = "webencodings" -version = "0.5.1" -description = "Character encoding aliases for legacy web content" -optional = true -python-versions = "*" -files = [ - {file = "webencodings-0.5.1-py2.py3-none-any.whl", hash = "sha256:a0af1213f3c2226497a97e2b3aa01a7e4bee4f403f95be16fc9acd2947514a78"}, - {file = "webencodings-0.5.1.tar.gz", hash = "sha256:b36a1c245f2d304965eb4e0a82848379241dc04b865afcc4aab16748587e1923"}, -] - -[[package]] -name = "websocket-client" -version = "1.8.0" -description = "WebSocket client for Python with low level API options" -optional = true -python-versions = ">=3.8" -files = [ - {file = "websocket_client-1.8.0-py3-none-any.whl", hash = "sha256:17b44cc997f5c498e809b22cdf2d9c7a9e71c02c8cc2b6c56e7c2d1239bfa526"}, - {file = "websocket_client-1.8.0.tar.gz", hash = "sha256:3239df9f44da632f96012472805d40a23281a991027ce11d2f45a6f24ac4c3da"}, -] - -[package.extras] -docs = ["Sphinx (>=6.0)", "myst-parser (>=2.0.0)", "sphinx-rtd-theme (>=1.1.0)"] -optional = ["python-socks", "wsaccel"] -test = ["websockets"] - -[[package]] -name = "widgetsnbextension" -version = "4.0.10" -description = "Jupyter interactive widgets for Jupyter Notebook" -optional = true -python-versions = ">=3.7" -files = [ - {file = "widgetsnbextension-4.0.10-py3-none-any.whl", hash = "sha256:d37c3724ec32d8c48400a435ecfa7d3e259995201fbefa37163124a9fcb393cc"}, - {file = "widgetsnbextension-4.0.10.tar.gz", hash = "sha256:64196c5ff3b9a9183a8e699a4227fb0b7002f252c814098e66c4d1cd0644688f"}, -] - -[[package]] -name = "wisdem" -version = "3.15.3" -description = "Wind-Plant Integrated System Design & Engineering Model" -optional = true -python-versions = ">=3.9" -files = [ - {file = "wisdem-3.15.3-cp310-cp310-macosx_10_9_x86_64.whl", hash = "sha256:47ed687a46ea7a09eca81083854d79211a809711778510a357e5be6f38eb664a"}, - {file = "wisdem-3.15.3-cp310-cp310-macosx_11_0_arm64.whl", hash = "sha256:877b5cdf8dfec86adcf86cfea5abafed20a805fcde29e0e0d917aa94781bb6a8"}, - {file = "wisdem-3.15.3-cp310-cp310-manylinux_2_12_i686.manylinux2010_i686.manylinux_2_17_i686.manylinux2014_i686.whl", hash = "sha256:dc1c5bb437723b288eb3abe1e2d5de8cb9bac7df0522ece4516e2cf45ab24813"}, - {file = "wisdem-3.15.3-cp310-cp310-manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:a077b93ae2c13c83411a03060e5e075ac48f65b77c0932f7b3f88a1d87ef247b"}, - {file = "wisdem-3.15.3-cp310-cp310-musllinux_1_1_i686.whl", hash = "sha256:d9d7a592235e3602299780bb2460cc44a50a6cd8df51d5fa64dc5e3f43434a9c"}, - {file = "wisdem-3.15.3-cp310-cp310-musllinux_1_1_x86_64.whl", hash = "sha256:17ba3ef0861f75eefc3d7a0fb3e7ad61dd0b0246346b7e80f73cd330bad20bd0"}, - {file = "wisdem-3.15.3-cp310-cp310-win_amd64.whl", hash = "sha256:6f8da3bb1ea4681f0ca339d78b5718b1ec2ba53b248e4e1a169265ef033c01a1"}, - {file = "wisdem-3.15.3-cp311-cp311-macosx_10_9_x86_64.whl", hash = "sha256:4187c2bb072c306c693153fccf481de3b4666a96b933b10c77222946c34603fc"}, - {file = "wisdem-3.15.3-cp311-cp311-macosx_11_0_arm64.whl", hash = "sha256:15822097ff53bffe18e1bf9fb6479ad709cfca3e18f58ba1240d350082166163"}, - {file = "wisdem-3.15.3-cp311-cp311-manylinux_2_12_i686.manylinux2010_i686.manylinux_2_17_i686.manylinux2014_i686.whl", hash = "sha256:8e59a40df0672799818cce199f6006ac1bda2e78e7be2b13061893179a6f3cbc"}, - {file = "wisdem-3.15.3-cp311-cp311-manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:ac5862cf972a5086bc3774f0f6fb5890421909eddee9947b930a1ef4db859076"}, - {file = "wisdem-3.15.3-cp311-cp311-musllinux_1_1_i686.whl", hash = "sha256:b9d64f8aaddf0c0fca9160fb53111935b85ff49a9fe937f50e4214d85a3bc12c"}, - {file = "wisdem-3.15.3-cp311-cp311-musllinux_1_1_x86_64.whl", hash = "sha256:a40ea5b12206e42771915e22d317de7627ab44a238db0161fd7cf11653f0ee10"}, - {file = "wisdem-3.15.3-cp311-cp311-win_amd64.whl", hash = "sha256:bffccec7be0165cdba60241f0a6c7c420422cab4a608a89ddabf9e1839ccc2a7"}, - {file = "wisdem-3.15.3-cp312-cp312-macosx_10_9_x86_64.whl", hash = "sha256:176a14302b682ff6fddb345b57ff7520af825846b2e33625a9b795fbb03a99aa"}, - {file = "wisdem-3.15.3-cp312-cp312-macosx_11_0_arm64.whl", hash = "sha256:cb1d024ce1ae1c6834381c087977adaf6fa6f9a48fbf1a1510031d369fe854f1"}, - {file = "wisdem-3.15.3-cp312-cp312-manylinux_2_12_i686.manylinux2010_i686.manylinux_2_17_i686.manylinux2014_i686.whl", hash = "sha256:aac4eef9f5dc9115b9a1acc910202c4a9453c70ff93e16a724c1f95caffeac9e"}, - {file = "wisdem-3.15.3-cp312-cp312-manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:1e791a86639a788e697737879f99cfbf0ddd7fb1c1bc105aa4198489d03bb61d"}, - {file = "wisdem-3.15.3-cp312-cp312-musllinux_1_1_i686.whl", hash = "sha256:146dd239f9a8f7b854358b9145ed0cad11c19394a05c76573b8476177c04e138"}, - {file = "wisdem-3.15.3-cp312-cp312-musllinux_1_1_x86_64.whl", hash = "sha256:a2875d38104485fdd034b0d2bb106084f667fe736653d96de7ea64e81f8e3985"}, - {file = "wisdem-3.15.3-cp312-cp312-win_amd64.whl", hash = "sha256:544ce4919225f711148c766b180b7b83a1dfc77101caec29ace800ca38941891"}, - {file = "wisdem-3.15.3-cp39-cp39-macosx_10_9_x86_64.whl", hash = "sha256:19bc8feae082c8fb295685b4f8141118e0ff25492d5697680c530b8fd1993cc6"}, - {file = "wisdem-3.15.3-cp39-cp39-macosx_11_0_arm64.whl", hash = "sha256:22c0afb6235a5068db1850ebd217831ce81f986d5ee6f38affd483ab888d974d"}, - {file = "wisdem-3.15.3-cp39-cp39-manylinux_2_12_i686.manylinux2010_i686.manylinux_2_17_i686.manylinux2014_i686.whl", hash = "sha256:7454d8f56279fe3c1ba179b26f03d225b4360095552b1ccfb4d6b81bc6d042b1"}, - {file = "wisdem-3.15.3-cp39-cp39-manylinux_2_17_x86_64.manylinux2014_x86_64.whl", hash = "sha256:e32deab7e17046a92b0cf47e902045e401a1407fc6d354d3f60e80508e2c7975"}, - {file = "wisdem-3.15.3-cp39-cp39-musllinux_1_1_i686.whl", hash = "sha256:c675da34f2fda489c950f8f9534328928f78da64aea272f536361badfbac33be"}, - {file = "wisdem-3.15.3-cp39-cp39-musllinux_1_1_x86_64.whl", hash = "sha256:c9598e2e1deb51e5f853db93a5b53e40db117a402b23aa176c45bc4f55ed89c2"}, - {file = "wisdem-3.15.3-cp39-cp39-win_amd64.whl", hash = "sha256:afb3492c76efe6d4aeb62ff02c28398a341501534da44e6f6d55e838837d4713"}, - {file = "wisdem-3.15.3.tar.gz", hash = "sha256:9f19b1532fee14ebf14908ed4addaa203715c9d02112f25b37285dd148348a07"}, -] - -[package.dependencies] -dearpygui = "*" -jsonschema = "*" -marmot-agents = ">=0.2.5" -moorpy = "*" -numpy = ">=1.26" -openmdao = ">=3.31" -openpyxl = "*" -pandas = "*" -pydoe3 = "*" -python-benedict = "*" -pyyaml = "*" -"ruamel.yaml" = "*" -scipy = "*" -simpy = "*" -sortedcontainers = "*" -statsmodels = "*" - -[package.extras] -dev = ["meson", "ninja", "swig"] -docs = ["sphinx", "sphinx-jsonschema", "sphinx-rtd-theme (>=1.3)", "sphinxcontrib-bibtex"] -opt = ["nlopt", "pyoptsparse"] -test = ["coveralls", "pytest", "pytest-cov"] - -[[package]] -name = "xlrd" -version = "2.0.1" -description = "Library for developers to extract data from Microsoft Excel (tm) .xls spreadsheet files" -optional = false -python-versions = ">=2.7, !=3.0.*, !=3.1.*, !=3.2.*, !=3.3.*, !=3.4.*, !=3.5.*" -files = [ - {file = "xlrd-2.0.1-py2.py3-none-any.whl", hash = "sha256:6a33ee89877bd9abc1158129f6e94be74e2679636b8a205b43b85206c3f0bbdd"}, - {file = "xlrd-2.0.1.tar.gz", hash = "sha256:f72f148f54442c6b056bf931dbc34f986fd0c3b0b6b5a58d013c9aef274d0c88"}, -] - -[package.extras] -build = ["twine", "wheel"] -docs = ["sphinx"] -test = ["pytest", "pytest-cov"] - -[[package]] -name = "zipp" -version = "3.18.2" -description = "Backport of pathlib-compatible object wrapper for zip files" -optional = true -python-versions = ">=3.8" -files = [ - {file = "zipp-3.18.2-py3-none-any.whl", hash = "sha256:dce197b859eb796242b0622af1b8beb0a722d52aa2f57133ead08edd5bf5374e"}, - {file = "zipp-3.18.2.tar.gz", hash = "sha256:6278d9ddbcfb1f1089a88fde84481528b07b0e10474e09dcfe53dad4069fa059"}, -] - -[package.extras] -docs = ["furo", "jaraco.packaging (>=9.3)", "jaraco.tidelift (>=1.4)", "rst.linker (>=1.9)", "sphinx (>=3.5)", "sphinx-lint"] -testing = ["big-O", "jaraco.functools", "jaraco.itertools", "jaraco.test", "more-itertools", "pytest (>=6,!=8.1.*)", "pytest-checkdocs (>=2.4)", "pytest-cov", "pytest-enabler (>=2.2)", "pytest-ignore-flaky", "pytest-mypy", "pytest-ruff (>=0.2.1)"] - -[extras] -rosco = ["rosco"] - -[metadata] -lock-version = "2.0" -python-versions = "^3.9" -content-hash = "c869eff97c77ac768580e7cc54b0b21b451f721ce307a906c541d0967808baf7" diff --git a/openfast_python/pyproject.toml b/openfast_python/pyproject.toml deleted file mode 100644 index c5da3bb4c2..0000000000 --- a/openfast_python/pyproject.toml +++ /dev/null @@ -1,33 +0,0 @@ -[tool.poetry] -name = "octue-openfast" -version = "3.5.4.beta-1" -description = "Readers and writers for OpenFAST files." -license = "Apache-2.0" -authors = [ - "NREL WISDEM Team ", - "dzalkind", - "Garrett Barter ", - "Pietro Bortolotti ", - "Mayank Chetan", - "John Jasa", -] -readme = "README.md" -packages = [{include = "openfast_io"}] - - -[tool.poetry.dependencies] -python = "^3.9" -numpy = "^1" -pandas = "^2" -xlrd = "^2" -ruamel_yaml = "^0.18" -rosco = {version = "^2.9.2", optional = true} - - -[tool.poetry.extras] -rosco = ["rosco"] - - -[build-system] -requires = ["poetry-core"] -build-backend = "poetry.core.masonry.api" diff --git a/reg_tests/CMakeLists.txt b/reg_tests/CMakeLists.txt index 70cbf67176..b65adf048f 100644 --- a/reg_tests/CMakeLists.txt +++ b/reg_tests/CMakeLists.txt @@ -71,6 +71,16 @@ set(CTEST_INFLOWWIND_EXECUTABLE "${CMAKE_BINARY_DIR}/modules/inflowwind/inflowwi # Set the MoorDyn executable configuration option and default set(CTEST_MOORDYN_EXECUTABLE "${CMAKE_BINARY_DIR}/modules/moordyn/moordyn_driver${CMAKE_EXECUTABLE_SUFFIX}" CACHE FILEPATH "Specify the MoorDyn driver executable to use in testing.") +# Set the SeaState executable configuration option and default +set(CTEST_SEASTATE_EXECUTABLE "${CMAKE_BINARY_DIR}/modules/seastate/seastate_driver" CACHE FILEPATH "Specify the SeaState driver executable to use in testing.") + +# Set the AeroDisk executable configuration option and default +set(CTEST_AERODISK_EXECUTABLE "${CMAKE_BINARY_DIR}/modules/aerodisk/aerodisk_driver" CACHE FILEPATH "Specify the AeroDisk driver executable to use in testing.") + +# Set the SED executable configuration option and default +set(CTEST_SED_EXECUTABLE "${CMAKE_BINARY_DIR}/modules/simple-elastodyn/sed_driver" CACHE FILEPATH "Specify the SED driver executable to use in testing.") + + # Set the testing tolerance set(CTEST_RTEST_RTOL "2" CACHE STRING "Sets the relative orders of magnitude to allow to deviate from the baseline.") set(CTEST_RTEST_ATOL "1.9" CACHE STRING "Set the absolute orders of magnitude to consider as testable values; any deviations smaller than this always pass.") @@ -80,7 +90,7 @@ 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/inflowwind modules/moordyn modules/subdyn) +foreach(regTest glue-codes/openfast glue-codes/openfast-cpp modules/aerodyn modules/beamdyn modules/hydrodyn modules/inflowwind modules/moordyn modules/subdyn openfast_io) file(MAKE_DIRECTORY ${CTEST_BINARY_DIR}/${regTest}) endforeach() @@ -193,5 +203,6 @@ add_custom_target( hydrodyn_driver inflowwind_driver moordyn_driver + seastate_driver subdyn_driver ) diff --git a/reg_tests/CTestList.cmake b/reg_tests/CTestList.cmake index 163fa4f35f..8a67fda02b 100644 --- a/reg_tests/CTestList.cmake +++ b/reg_tests/CTestList.cmake @@ -18,7 +18,7 @@ # Generic test functions #=============================================================================== -function(regression TEST_SCRIPT EXECUTABLE SOURCE_DIRECTORY BUILD_DIRECTORY TESTNAME LABEL) +function(regression TEST_SCRIPT EXECUTABLE SOURCE_DIRECTORY BUILD_DIRECTORY STEADYSTATE_FLAG TESTNAME LABEL OTHER_FLAGS) file(TO_NATIVE_PATH "${EXECUTABLE}" EXECUTABLE) file(TO_NATIVE_PATH "${TEST_SCRIPT}" TEST_SCRIPT) @@ -52,6 +52,14 @@ function(regression TEST_SCRIPT EXECUTABLE SOURCE_DIRECTORY BUILD_DIRECTORY TEST if(CTEST_NO_RUN_FLAG) set(NO_RUN_FLAG "-n") endif() + + if(STEADYSTATE_FLAG STREQUAL " ") + set(STEADYSTATE_FLAG "") + endif() + + if(OTHER_FLAGS STREQUAL " ") + set(OTHER_FLAGS "") + endif() add_test( ${TESTNAME} ${Python_EXECUTABLE} @@ -65,6 +73,8 @@ function(regression TEST_SCRIPT EXECUTABLE SOURCE_DIRECTORY BUILD_DIRECTORY TEST ${PLOT_FLAG} # empty or "-p" ${RUN_VERBOSE_FLAG} # empty or "-v" ${NO_RUN_FLAG} # empty or "-n" + ${STEADYSTATE_FLAG} # empty or "-steadystate" + ${OTHER_FLAGS} ) # limit each test to 90 minutes: 5400s set_tests_properties(${TESTNAME} PROPERTIES TIMEOUT 5400 WORKING_DIRECTORY "${CMAKE_CURRENT_BINARY_DIR}" LABELS "${LABEL}") @@ -80,15 +90,25 @@ function(of_regression TESTNAME LABEL) 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}") + regression(${TEST_SCRIPT} ${OPENFAST_EXECUTABLE} ${SOURCE_DIRECTORY} ${BUILD_DIRECTORY} " " ${TESTNAME} "${LABEL}" " ") endfunction(of_regression) +function(of_aeromap_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") + set(STEADYSTATE_FLAG "-steadystate") + regression(${TEST_SCRIPT} ${OPENFAST_EXECUTABLE} ${SOURCE_DIRECTORY} ${BUILD_DIRECTORY} ${STEADYSTATE_FLAG} ${TESTNAME} "${LABEL}" " ") +endfunction(of_aeromap_regression) + function(of_fastlib_regression TESTNAME LABEL) set(TEST_SCRIPT "${CMAKE_CURRENT_LIST_DIR}/executeOpenfastRegressionCase.py") set(OPENFAST_EXECUTABLE "${CMAKE_BINARY_DIR}/glue-codes/openfast/openfast_lib_driver") 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}_fastlib" "${LABEL}" ${TESTNAME}) + # extra flag in call to "regression" on next line sets the ${TESTDIR} + regression(${TEST_SCRIPT} ${OPENFAST_EXECUTABLE} ${SOURCE_DIRECTORY} ${BUILD_DIRECTORY} " " "${TESTNAME}_fastlib" "${LABEL}" " " ${TESTNAME}) endfunction(of_fastlib_regression) # openfast aeroacoustic @@ -97,25 +117,27 @@ function(of_regression_aeroacoustic TESTNAME LABEL) 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}") + regression(${TEST_SCRIPT} ${OPENFAST_EXECUTABLE} ${SOURCE_DIRECTORY} ${BUILD_DIRECTORY} " " ${TESTNAME} "${LABEL}" " ") endfunction(of_regression_aeroacoustic) # FAST Farm -function(ff_regression TESTNAME LABEL) +function(ff_regression TESTNAME OTHER_FLAGS 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}") + set(OTHER_FLAGS "${OTHER_FLAGS}") # Set name of file to compare, otherwise default + regression(${TEST_SCRIPT} ${FASTFARM_EXECUTABLE} ${SOURCE_DIRECTORY} ${BUILD_DIRECTORY} " " ${TESTNAME} "${LABEL}" "${OTHER_FLAGS}") endfunction(ff_regression) # openfast linearized -function(of_regression_linear TESTNAME LABEL) +function(of_regression_linear TESTNAME OTHER_FLAGS 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}") + set(OTHER_FLAGS "${OTHER_FLAGS}") + regression(${TEST_SCRIPT} ${OPENFAST_EXECUTABLE} ${SOURCE_DIRECTORY} ${BUILD_DIRECTORY} " " ${TESTNAME} "${LABEL}" "${OTHER_FLAGS}") endfunction(of_regression_linear) # openfast C++ interface @@ -124,7 +146,7 @@ function(of_cpp_interface_regression TESTNAME LABEL) 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}") + regression(${TEST_SCRIPT} ${OPENFAST_CPP_EXECUTABLE} ${SOURCE_DIRECTORY} ${BUILD_DIRECTORY} " " ${TESTNAME} "${LABEL}" " ") endfunction(of_cpp_interface_regression) # openfast Python-interface @@ -133,7 +155,7 @@ function(of_regression_py TESTNAME LABEL) 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}") + regression(${TEST_SCRIPT} ${EXECUTABLE} ${SOURCE_DIRECTORY} ${BUILD_DIRECTORY} " " ${TESTNAME} "${LABEL}" " ") endfunction(of_regression_py) # aerodyn @@ -142,7 +164,7 @@ function(ad_regression TESTNAME LABEL) 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}") + regression(${TEST_SCRIPT} ${AERODYN_EXECUTABLE} ${SOURCE_DIRECTORY} ${BUILD_DIRECTORY} " " ${TESTNAME} "${LABEL}" " ") endfunction(ad_regression) # aerodyn-Py @@ -151,7 +173,7 @@ function(py_ad_regression TESTNAME LABEL) set(AERODYN_EXECUTABLE "${Python_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}") + regression(${TEST_SCRIPT} ${AERODYN_EXECUTABLE} ${SOURCE_DIRECTORY} ${BUILD_DIRECTORY} " " ${TESTNAME} "${LABEL}" " ") endfunction(py_ad_regression) @@ -161,7 +183,7 @@ function(ua_regression TESTNAME LABEL) set(AERODYN_EXECUTABLE "${CTEST_UADRIVER_EXECUTABLE}") set(SOURCE_DIRECTORY "${CMAKE_CURRENT_LIST_DIR}/..") set(BUILD_DIRECTORY "${CTEST_BINARY_DIR}/modules/unsteadyaero") - regression(${TEST_SCRIPT} ${AERODYN_EXECUTABLE} ${SOURCE_DIRECTORY} ${BUILD_DIRECTORY} ${TESTNAME} "${LABEL}") + regression(${TEST_SCRIPT} ${AERODYN_EXECUTABLE} ${SOURCE_DIRECTORY} ${BUILD_DIRECTORY} " " ${TESTNAME} "${LABEL}" " ") endfunction(ua_regression) @@ -171,7 +193,7 @@ function(bd_regression TESTNAME LABEL) 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}") + regression(${TEST_SCRIPT} ${BEAMDYN_EXECUTABLE} ${SOURCE_DIRECTORY} ${BUILD_DIRECTORY} " " ${TESTNAME} "${LABEL}" " ") endfunction(bd_regression) # hydrodyn @@ -180,7 +202,7 @@ function(hd_regression TESTNAME LABEL) 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}") + regression(${TEST_SCRIPT} ${HYDRODYN_EXECUTABLE} ${SOURCE_DIRECTORY} ${BUILD_DIRECTORY} " " ${TESTNAME} "${LABEL}" " ") endfunction(hd_regression) # py_hydrodyn @@ -189,7 +211,7 @@ function(py_hd_regression TESTNAME LABEL) set(HYDRODYN_EXECUTABLE "${Python_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}") + regression(${TEST_SCRIPT} ${HYDRODYN_EXECUTABLE} ${SOURCE_DIRECTORY} ${BUILD_DIRECTORY} " " ${TESTNAME} "${LABEL}" " ") endfunction(py_hd_regression) # subdyn @@ -198,7 +220,7 @@ function(sd_regression TESTNAME LABEL) 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}") + regression(${TEST_SCRIPT} ${SUBDYN_EXECUTABLE} ${SOURCE_DIRECTORY} ${BUILD_DIRECTORY} " " ${TESTNAME} "${LABEL}" " ") endfunction(sd_regression) # inflowwind @@ -207,7 +229,7 @@ function(ifw_regression TESTNAME LABEL) set(INFLOWWIND_EXECUTABLE "${CTEST_INFLOWWIND_EXECUTABLE}") set(SOURCE_DIRECTORY "${CMAKE_CURRENT_LIST_DIR}/..") set(BUILD_DIRECTORY "${CTEST_BINARY_DIR}/modules/inflowwind") - regression(${TEST_SCRIPT} ${INFLOWWIND_EXECUTABLE} ${SOURCE_DIRECTORY} ${BUILD_DIRECTORY} ${TESTNAME} "${LABEL}") + regression(${TEST_SCRIPT} ${INFLOWWIND_EXECUTABLE} ${SOURCE_DIRECTORY} ${BUILD_DIRECTORY} " " ${TESTNAME} "${LABEL}" " ") endfunction(ifw_regression) # py_inflowwind @@ -216,16 +238,25 @@ function(py_ifw_regression TESTNAME LABEL) set(INFLOWWIND_EXECUTABLE "${Python_EXECUTABLE}") set(SOURCE_DIRECTORY "${CMAKE_CURRENT_LIST_DIR}/..") set(BUILD_DIRECTORY "${CTEST_BINARY_DIR}/modules/inflowwind") - regression(${TEST_SCRIPT} ${INFLOWWIND_EXECUTABLE} ${SOURCE_DIRECTORY} ${BUILD_DIRECTORY} ${TESTNAME} "${LABEL}") + regression(${TEST_SCRIPT} ${INFLOWWIND_EXECUTABLE} ${SOURCE_DIRECTORY} ${BUILD_DIRECTORY} " " ${TESTNAME} "${LABEL}" " ") endfunction(py_ifw_regression) +# seastate +function(seast_regression TESTNAME LABEL) + set(TEST_SCRIPT "${CMAKE_CURRENT_LIST_DIR}/executeSeaStateRegressionCase.py") + set(SEASTATE_EXECUTABLE "${CTEST_SEASTATE_EXECUTABLE}") + set(SOURCE_DIRECTORY "${CMAKE_CURRENT_LIST_DIR}/..") + set(BUILD_DIRECTORY "${CTEST_BINARY_DIR}/modules/seastate") + regression(${TEST_SCRIPT} ${SEASTATE_EXECUTABLE} ${SOURCE_DIRECTORY} ${BUILD_DIRECTORY} " " ${TESTNAME} "${LABEL}" " ") +endfunction(seast_regression) + # moordyn function(md_regression TESTNAME LABEL) set(TEST_SCRIPT "${CMAKE_CURRENT_LIST_DIR}/executeMoordynRegressionCase.py") set(MOORDYN_EXECUTABLE "${CTEST_MOORDYN_EXECUTABLE}") set(SOURCE_DIRECTORY "${CMAKE_CURRENT_LIST_DIR}/..") set(BUILD_DIRECTORY "${CTEST_BINARY_DIR}/modules/moordyn") - regression(${TEST_SCRIPT} ${MOORDYN_EXECUTABLE} ${SOURCE_DIRECTORY} ${BUILD_DIRECTORY} ${TESTNAME} "${LABEL}") + regression(${TEST_SCRIPT} ${MOORDYN_EXECUTABLE} ${SOURCE_DIRECTORY} ${BUILD_DIRECTORY} " " ${TESTNAME} "${LABEL}" " ") endfunction(md_regression) # py_moordyn c-bindings interface @@ -234,9 +265,27 @@ function(py_md_regression TESTNAME LABEL) set(MOORDYN_EXECUTABLE "${Python_EXECUTABLE}") set(SOURCE_DIRECTORY "${CMAKE_CURRENT_LIST_DIR}/..") set(BUILD_DIRECTORY "${CTEST_BINARY_DIR}/modules/moordyn") - regression(${TEST_SCRIPT} ${MOORDYN_EXECUTABLE} ${SOURCE_DIRECTORY} ${BUILD_DIRECTORY} ${TESTNAME} "${LABEL}") + regression(${TEST_SCRIPT} ${MOORDYN_EXECUTABLE} ${SOURCE_DIRECTORY} ${BUILD_DIRECTORY} " " ${TESTNAME} "${LABEL}" " ") endfunction(py_md_regression) +# aerodisk +function(adsk_regression TESTNAME LABEL) + set(TEST_SCRIPT "${CMAKE_CURRENT_LIST_DIR}/executeAerodiskRegressionCase.py") + set(AERODISK_EXECUTABLE "${CTEST_AERODISK_EXECUTABLE}") + set(SOURCE_DIRECTORY "${CMAKE_CURRENT_LIST_DIR}/..") + set(BUILD_DIRECTORY "${CTEST_BINARY_DIR}/modules/aerodisk") + regression(${TEST_SCRIPT} ${AERODISK_EXECUTABLE} ${SOURCE_DIRECTORY} ${BUILD_DIRECTORY} " " ${TESTNAME} "${LABEL}" " ") +endfunction(adsk_regression) + +# simple-elastodyn +function(sed_regression TESTNAME LABEL) + set(TEST_SCRIPT "${CMAKE_CURRENT_LIST_DIR}/executeSimpleElastodynRegressionCase.py") + set(SED_EXECUTABLE "${CTEST_SED_EXECUTABLE}") + set(SOURCE_DIRECTORY "${CMAKE_CURRENT_LIST_DIR}/..") + set(BUILD_DIRECTORY "${CTEST_BINARY_DIR}/modules/simple-elastodyn") + regression(${TEST_SCRIPT} ${SED_EXECUTABLE} ${SOURCE_DIRECTORY} ${BUILD_DIRECTORY} " " ${TESTNAME} "${LABEL}" " ") +endfunction(sed_regression) + # # Python-based OpenFAST Library tests # function(py_openfast_library_regression TESTNAME LABEL) # set(test_module "${CMAKE_SOURCE_DIR}/modules/openfast-library/tests/test_openfast_library.py") @@ -244,93 +293,120 @@ endfunction(py_md_regression) # add_test(${TESTNAME} ${Python_EXECUTABLE} ${test_module} ${input_file} ) # endfunction(py_openfast_library_regression) +# Python-based OpenFAST IO Library tests +function(py_openfast_io_library_pytest TESTNAME LABEL) + set(module "-m") + set(pytest "pytest") + set(pytestVerbose "--verbose") + set(py_test_file "${CMAKE_CURRENT_LIST_DIR}/../openfast_io/openfast_io/tests/test_of_io_pytest.py") + set(executable "--executable=${CTEST_OPENFAST_EXECUTABLE}") + set(source_dir "--source_dir=${CMAKE_CURRENT_LIST_DIR}/..") + set(build_dir "--build_dir=${CTEST_BINARY_DIR}") + add_test(${TESTNAME} ${Python_EXECUTABLE} ${module} ${pytest} ${pytestVerbose} ${py_test_file} ${executable} ${source_dir} ${build_dir}) + set_tests_properties(${TESTNAME} PROPERTIES TIMEOUT 5400 WORKING_DIRECTORY "${CMAKE_CURRENT_BINARY_DIR}" LABELS "${LABEL}") +endfunction(py_openfast_io_library_pytest) + #=============================================================================== # 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_Land_BD_Init" "openfast;beamdyn;aerodyn15;servodyn") +of_regression("AWT_YFix_WSt" "openfast;elastodyn;aerodyn;servodyn") +of_regression("AWT_WSt_StartUp_HighSpShutDown" "openfast;elastodyn;aerodyn;servodyn") +of_regression("AWT_YFree_WSt" "openfast;elastodyn;aerodyn;servodyn") +of_regression("AWT_YFree_WTurb" "openfast;elastodyn;aerodyn;servodyn") +of_regression("AWT_WSt_StartUpShutDown" "openfast;elastodyn;aerodyn;servodyn") +of_regression("AOC_WSt" "openfast;elastodyn;aerodyn;servodyn") +of_regression("AOC_YFree_WTurb" "openfast;elastodyn;aerodyn;servodyn") +of_regression("AOC_YFix_WSt" "openfast;elastodyn;aerodyn;servodyn") +of_regression("UAE_Dnwind_YRamp_WSt" "openfast;elastodyn;aerodyn;servodyn") +of_regression("UAE_Upwind_Rigid_WRamp_PwrCurve" "openfast;elastodyn;aerodyn;servodyn") +of_regression("WP_VSP_WTurb_PitchFail" "openfast;elastodyn;aerodyn;servodyn") +of_regression("WP_VSP_ECD" "openfast;elastodyn;aerodyn;servodyn") +of_regression("WP_VSP_WTurb" "openfast;elastodyn;aerodyn;servodyn") +of_regression("SWRT_YFree_VS_EDG01" "openfast;elastodyn;aerodyn;servodyn") +of_regression("SWRT_YFree_VS_EDC01" "openfast;elastodyn;aerodyn;servodyn") +of_regression("SWRT_YFree_VS_WTurb" "openfast;elastodyn;aerodyn;servodyn") +of_regression("5MW_Land_DLL_WTurb" "openfast;elastodyn;aerodyn;servodyn") +of_regression("5MW_Land_DLL_WTurb_wNacDrag" "openfast;elastodyn;aerodyn;servodyn") +of_regression("5MW_OC3Mnpl_DLL_WTurb_WavesIrr" "openfast;elastodyn;aerodyn;servodyn;hydrodyn;subdyn;offshore") +of_regression("5MW_OC3Mnpl_DLL_WTurb_WavesIrr_Restart" "openfast;elastodyn;aerodyn;servodyn;hydrodyn;subdyn;offshore;restart") +of_regression("5MW_OC3Trpd_DLL_WSt_WavesReg" "openfast;elastodyn;aerodyn;servodyn;hydrodyn;subdyn;offshore") +of_regression("5MW_OC4Jckt_DLL_WTurb_WavesIrr_MGrowth" "openfast;elastodyn;aerodyn;servodyn;hydrodyn;subdyn;offshore") +of_regression("5MW_ITIBarge_DLL_WTurb_WavesIrr" "openfast;elastodyn;aerodyn;servodyn;hydrodyn;map;offshore") +of_regression("5MW_TLP_DLL_WTurb_WavesIrr_WavesMulti" "openfast;elastodyn;aerodyn;servodyn;hydrodyn;map;offshore") +of_regression("5MW_OC3Spar_DLL_WTurb_WavesIrr" "openfast;elastodyn;aerodyn;servodyn;hydrodyn;map;offshore") +of_regression("5MW_OC4Semi_WSt_WavesWN" "openfast;elastodyn;aerodyn;servodyn;hydrodyn;moordyn;offshore") +of_regression("5MW_Land_BD_DLL_WTurb" "openfast;beamdyn;aerodyn;servodyn") +of_regression("5MW_Land_BD_Init" "openfast;beamdyn;aerodyn;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("HelicalWake_OLAF" "openfast;aerodyn;olaf") +of_regression("EllipticalWing_OLAF" "openfast;aerodyn;olaf") of_regression("StC_test_OC4Semi" "openfast;servodyn;hydrodyn;moordyn;offshore;stc") -of_regression("MHK_RM1_Fixed" "openfast;elastodyn;aerodyn15;mhk") -of_regression("MHK_RM1_Floating" "openfast;elastodyn;aerodyn15;hydrodyn;moordyn;mhk") -of_regression("Tailfin_FreeYaw1DOF_PolarBased" "openfast;elastodyn;aerodyn15") +of_regression("MHK_RM1_Fixed" "openfast;elastodyn;aerodyn;mhk") +of_regression("MHK_RM1_Floating" "openfast;elastodyn;aerodyn;hydrodyn;moordyn;mhk") +of_regression("MHK_RM1_Floating_wNacDrag" "openfast;elastodyn;aerodyn;hydrodyn;moordyn;mhk") +of_regression("Tailfin_FreeYaw1DOF_PolarBased" "openfast;elastodyn;aerodyn") +of_regression("Tailfin_FreeYaw1DOF_Unsteady" "openfast;elastodyn;aerodyn") +of_regression("5MW_Land_DLL_WTurb_ADsk" "openfast;elastodyn;aerodisk") +of_regression("5MW_Land_DLL_WTurb_ADsk_SED" "openfast;simple-elastodyn;aerodisk") +of_regression("5MW_Land_DLL_WTurb_SED" "openfast;simple-elastodyn;aerodyn") + +of_aeromap_regression("5MW_Land_AeroMap" "aeromap;elastodyn;aerodyn") # OpenFAST C++ API test if(BUILD_OPENFAST_CPP_DRIVER) of_cpp_interface_regression("5MW_Land_DLL_WTurb_cpp" "openfast;fastlib;cpp") + of_cpp_interface_regression("5MW_Restart_cpp" "openfast;fastlib;cpp;restart") endif() # OpenFAST Driver test for OpenFAST C++ Library # This tests the FAST Library and FAST_Library.h if(BUILD_OPENFAST_LIB_DRIVER) - of_fastlib_regression("AWT_YFree_WSt" "fastlib;elastodyn;aerodyn15;servodyn") + of_fastlib_regression("AWT_YFree_WSt" "fastlib;elastodyn;aerodyn;servodyn") endif() # OpenFAST Python API test -of_regression_py("5MW_Land_DLL_WTurb_py" "openfast;fastlib;python;elastodyn;aerodyn15;servodyn") -#of_regression_py("5MW_ITIBarge_DLL_WTurb_WavesIrr_py" "openfast;fastlib;python;elastodyn;aerodyn14;servodyn;hydrodyn;map;offshore") -of_regression_py("5MW_TLP_DLL_WTurb_WavesIrr_WavesMulti_py" "openfast;fastlib;python;elastodyn;aerodyn15;servodyn;hydrodyn;map;offshore") -of_regression_py("5MW_OC3Spar_DLL_WTurb_WavesIrr_py" "openfast;fastlib;python;elastodyn;aerodyn15;servodyn;hydrodyn;map;offshore") -of_regression_py("5MW_OC4Semi_WSt_WavesWN_py" "openfast;fastlib;python;elastodyn;aerodyn15;servodyn;hydrodyn;moordyn;offshore") -of_regression_py("5MW_Land_BD_DLL_WTurb_py" "openfast;fastlib;python;beamdyn;aerodyn15;servodyn") -of_regression_py("HelicalWake_OLAF_py" "openfast;fastlib;python;aerodyn15;olaf") -of_regression_py("EllipticalWing_OLAF_py" "openfast;fastlib;python;aerodyn15;olaf") +of_regression_py("5MW_Land_DLL_WTurb_py" "openfast;fastlib;python;elastodyn;aerodyn;servodyn") +of_regression_py("5MW_ITIBarge_DLL_WTurb_WavesIrr_py" "openfast;fastlib;python;elastodyn;aerodyn;servodyn;hydrodyn;map;offshore") +of_regression_py("5MW_TLP_DLL_WTurb_WavesIrr_WavesMulti_py" "openfast;fastlib;python;elastodyn;aerodyn;servodyn;hydrodyn;map;offshore") +of_regression_py("5MW_OC3Spar_DLL_WTurb_WavesIrr_py" "openfast;fastlib;python;elastodyn;aerodyn;servodyn;hydrodyn;map;offshore") +of_regression_py("5MW_OC4Semi_WSt_WavesWN_py" "openfast;fastlib;python;elastodyn;aerodyn;servodyn;hydrodyn;moordyn;offshore") +of_regression_py("5MW_Land_BD_DLL_WTurb_py" "openfast;fastlib;python;beamdyn;aerodyn;servodyn") +of_regression_py("HelicalWake_OLAF_py" "openfast;fastlib;python;aerodyn;olaf") +of_regression_py("EllipticalWing_OLAF_py" "openfast;fastlib;python;aerodyn;olaf") # AeroAcoustic regression test -of_regression_aeroacoustic("IEA_LB_RWT-AeroAcoustics" "openfast;aerodyn15;aeroacoustics") +of_regression_aeroacoustic("IEA_LB_RWT-AeroAcoustics" "openfast;aerodyn;aeroacoustics") # Linearized OpenFAST regression tests -# of_regression_linear("Fake5MW_AeroLin_B1_UA4_DBEMT3" "openfast;linear;elastodyn") #Also: aerodyn -of_regression_linear("Fake5MW_AeroLin_B3_UA6" "openfast;linear;elastodyn") #Also: aerodyn -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_Linear_Aero" "openfast;linear;elastodyn;servodyn;aerodyn") -of_regression_linear("5MW_Land_BD_Linear" "openfast;linear;beamdyn;servodyn") -of_regression_linear("5MW_Land_BD_Linear_Aero" "openfast;linear;beamdyn;servodyn;aerodyn") -of_regression_linear("5MW_OC4Semi_Linear" "openfast;linear;hydrodyn;servodyn;map") -of_regression_linear("5MW_OC4Semi_MD_Linear" "openfast;linear;hydrodyn;servodyn;moordyn") -of_regression_linear("5MW_OC3Mnpl_Linear" "openfast;linear;hydrodyn;servodyn;moordyn") -of_regression_linear("StC_test_OC4Semi_Linear_Nac" "openfast;linear;servodyn;stc") -of_regression_linear("StC_test_OC4Semi_Linear_Tow" "openfast;linear;servodyn;stc") -of_regression_linear("5MW_OC3Spar_Linear" "openfast;linear;map;hydrodyn") +of_regression_linear("Fake5MW_AeroLin_B1_UA4_DBEMT3" "-highpass=0.05" "openfast;linear;elastodyn;aerodyn") +of_regression_linear("Fake5MW_AeroLin_B3_UA6" "-highpass=0.05" "openfast;linear;elastodyn;aerodyn") +of_regression_linear("WP_Stationary_Linear" "" "openfast;linear;elastodyn") +of_regression_linear("Ideal_Beam_Fixed_Free_Linear" "-highpass=0.10" "openfast;linear;beamdyn") +of_regression_linear("Ideal_Beam_Free_Free_Linear" "-highpass=0.10" "openfast;linear;beamdyn") +of_regression_linear("5MW_Land_Linear_Aero" "-highpass=0.25" "openfast;linear;elastodyn;servodyn;aerodyn") +of_regression_linear("5MW_Land_Linear_Aero_CalcSteady" "-highpass=0.25" "openfast;linear;elastodyn;servodyn;aerodyn") +of_regression_linear("5MW_Land_BD_Linear" "" "openfast;linear;beamdyn;servodyn") +of_regression_linear("5MW_Land_BD_Linear_Aero" "-highpass=0.25" "openfast;linear;beamdyn;servodyn;aerodyn") +of_regression_linear("5MW_OC4Semi_Linear" "" "openfast;linear;hydrodyn;servodyn;map") +of_regression_linear("5MW_OC4Semi_MD_Linear" "" "openfast;linear;hydrodyn;servodyn;moordyn") +of_regression_linear("StC_test_OC4Semi_Linear_Nac" "" "openfast;linear;servodyn;stc") +of_regression_linear("StC_test_OC4Semi_Linear_Tow" "" "openfast;linear;servodyn;stc") +of_regression_linear("WP_Stationary_Linear" "" "openfast;linear;elastodyn") +of_regression_linear("5MW_OC3Spar_Linear" "" "openfast;linear;map;hydrodyn") +of_regression_linear("5MW_OC3Mnpl_Linear" "" "openfast;linear;hydrodyn;servodyn;moordyn") # FAST Farm regression tests if(BUILD_FASTFARM) - ff_regression("TSinflow" "fastfarm") - ff_regression("LESinflow" "fastfarm") -# ff_regression("Uninflow_curl" "fastfarm") - ff_regression("TSinflow_curl" "fastfarm") - ff_regression("ModAmb_3" "fastfarm") + ff_regression("TSinflow" "" "fastfarm") + ff_regression("LESinflow" "" "fastfarm") +# ff_regression("Uninflow_curl" "" "fastfarm") + ff_regression("TSinflow_curl" "" "fastfarm") + ff_regression("ModAmb_3" "" "fastfarm") + ff_regression("TSinflowADskSED" "" "fastfarm;aerodisk;simple-elastodyn") + ff_regression("MD_Shared" "-compFile=FAST.Farm.FarmMD.MD" "fastfarm;moordyn") endif() # AeroDyn regression tests @@ -348,7 +424,9 @@ ad_regression("ad_BAR_OLAF" "aerodyn;bem") ad_regression("ad_BAR_SineMotion" "aerodyn;bem") ad_regression("ad_BAR_SineMotion_UA4_DBEMT3" "aerodyn;bem") ad_regression("ad_BAR_RNAMotion" "aerodyn;bem") +ad_regression("ad_B1n2_OLAF" "aerodyn;OLAF") py_ad_regression("py_ad_5MW_OC4Semi_WSt_WavesWN" "aerodyn;bem;python") +py_ad_regression("py_ad_B1n2_OLAF" "aerodyn;OLAF;python") # UnsteadyAero ua_regression("ua_redfreq" "unsteadyaero") @@ -363,17 +441,29 @@ 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_ITIBarge_DLL_WTurb_WavesIrr" "hydrodyn;offshore") hd_regression("hd_5MW_OC3Spar_DLL_WTurb_WavesIrr" "hydrodyn;offshore") -#hd_regression("hd_5MW_OC4Jckt_DLL_WTurb_WavesIrr_MGrowth" "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") hd_regression("hd_NBodyMod1" "hydrodyn;offshore") hd_regression("hd_NBodyMod2" "hydrodyn;offshore") hd_regression("hd_NBodyMod3" "hydrodyn;offshore") - +hd_regression("hd_WaveStMod1" "hydrodyn;offshore") +hd_regression("hd_WaveStMod2" "hydrodyn;offshore") +hd_regression("hd_WaveStMod3" "hydrodyn;offshore") +hd_regression("hd_MHstLMod2" "hydrodyn;offshore") +hd_regression("hd_MHstLMod1_compare" "hydrodyn;offshore") +hd_regression("hd_MHstLMod2_compare" "hydrodyn;offshore") +hd_regression("hd_MCF_WaveStMod0" "hydrodyn;offshore") +hd_regression("hd_MCF_WaveStMod1" "hydrodyn;offshore") +hd_regression("hd_MCF_WaveStMod2" "hydrodyn;offshore") +hd_regression("hd_MCF_WaveStMod3" "hydrodyn;offshore") +hd_regression("hd_ExctnMod1_ExctnDisp1" "hydrodyn;offshore") +hd_regression("hd_ExctnMod1_ExctnDisp2" "hydrodyn;offshore") +hd_regression("hd_ExctnMod1_ExctnDisp2_PtfmYMod1" "hydrodyn;offshore") +hd_regression("hd_5MW_OC4Semi_WSt_WavesWN_PtfmYMod0_LargeYaw" "hydrodyn;offshore") +hd_regression("hd_5MW_OC4Semi_WSt_WavesWN_PtfmYMod1_LargeYaw" "hydrodyn;offshore") # Py-HydroDyn regression tests py_hd_regression("py_hd_5MW_OC4Semi_WSt_WavesWN" "hydrodyn;offshore;python") @@ -386,6 +476,12 @@ sd_regression("SD_SparHanging" "subdyn;offshore") sd_regression("SD_AnsysComp1_PinBeam" "subdyn;offshore") # TODO Issue #855 sd_regression("SD_AnsysComp2_Cable" "subdyn;offshore") sd_regression("SD_AnsysComp3_PinBeamCable" "subdyn;offshore") # TODO Issue #855 +sd_regression("SD_Spring_Case1" "subdyn;offshore") +sd_regression("SD_Spring_Case2" "subdyn;offshore") +sd_regression("SD_Spring_Case3" "subdyn;offshore") +sd_regression("SD_Revolute_Joint" "subdyn;offshore") +sd_regression("SD_2Beam_Spring" "subdyn;offshore") +sd_regression("SD_2Beam_Cantilever" "subdyn;offshore") # TODO test below are bugs, should be added when fixed # sd_regression("SD_Force" "subdyn;offshore") # sd_regression("SD_AnsysComp4_UniversalCableRigid" "subdyn;offshore") @@ -402,10 +498,38 @@ ifw_regression("ifw_HAWC" "inflowwind") # Py-InflowWind regression tests py_ifw_regression("py_ifw_turbsimff" "inflowwind;python") +# SeaState regression tests +seast_regression("seastate_1" "seastate") +seast_regression("seastate_wr_kin1" "seastate") +seast_regression("seastate_CNW1" "seastate") +seast_regression("seastate_CNW2" "seastate") +seast_regression("seastate_WaveMod7_WaveStMod1" "seastate") +seast_regression("seastate_WaveMod7_WaveStMod2" "seastate") +seast_regression("seastate_WaveMod7_WaveStMod3" "seastate") +seast_regression("seastate_wavemod5" "seastate") # place at end since it reads outputs generated by seastate_wr_kin1 + # MoorDyn regression tests md_regression("md_5MW_OC4Semi" "moordyn") -py_md_regression("py_md_5MW_OC4Semi" "moordyn;python") +md_regression("md_lineFail" "moordyn") +md_regression("md_BodiesAndRods" "moordyn") +md_regression("md_bodyDrag" "moordyn") +md_regression("md_cable" "moordyn") +md_regression("md_case2" "moordyn") +md_regression("md_case5" "moordyn") +md_regression("md_float" "moordyn") +md_regression("md_horizontal" "moordyn") +md_regression("md_no_line" "moordyn") +md_regression("md_vertical" "moordyn") +py_md_regression("py_md_5MW_OC4Semi" "moordyn;python") # the following tests are excessively slow in double precision, so skip these in normal testing -#md_regression("md_Node_Check_N20" "moordyn") -#md_regression("md_Node_Check_N40" "moordyn") #md_regression("md_Single_Line_Quasi_Static_Test" "moordyn") + +# OpenFAST IO Library regression tests +py_openfast_io_library_pytest("openfast_io_library" "openfast_io;python") + +# AeroDisk regression tests +adsk_regression("adsk_timeseries_shutdown" "aerodisk") + +# SimplifiedElastoDyn regression tests +sed_regression("sed_test_HSSbrk" "simple-elastodyn") +sed_regression("sed_test_freewheel" "simple-elastodyn") diff --git a/reg_tests/README.md b/reg_tests/README.md index aaa320639b..39e6317ca3 100644 --- a/reg_tests/README.md +++ b/reg_tests/README.md @@ -11,6 +11,7 @@ Dependencies required to run the regression test suite are - Numpy - CMake and CTest - Bokeh 2.4+ (optional) +- Pandas ## 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. diff --git a/reg_tests/executeAerodiskRegressionCase.py b/reg_tests/executeAerodiskRegressionCase.py new file mode 100644 index 0000000000..ae1dcd5eec --- /dev/null +++ b/reg_tests/executeAerodiskRegressionCase.py @@ -0,0 +1,133 @@ +# +# Copyright 2024 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 AeroDisk 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: `executeAeroDiskRegressionCase.py -h` +""" + +import os +import sys +basepath = os.path.dirname(os.path.abspath(__file__)) +sys.path.insert(0, os.path.sep.join([basepath, "lib"])) +import argparse +import numpy as np +import shutil +import glob +import subprocess +import rtestlib as rtl +import openfastDrivers +import pass_fail +from errorPlotting import exportCaseSummary + +##### Main program + +### Store the python executable for future python calls +pythonCommand = sys.executable + +### Verify input arguments +parser = argparse.ArgumentParser(description="Executes 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="AeroDisk-Driver", type=str, nargs=1, help="The path to the AeroDisk driver executable.") +parser.add_argument("sourceDirectory", metavar="path/to/openfast_repo", type=str, nargs=1, help="The path to the OpenFAST repository.") +parser.add_argument("buildDirectory", metavar="path/to/openfast_repo/build", type=str, nargs=1, help="The path to the OpenFAST repository build directory.") +parser.add_argument("rtol", metavar="Relative-Tolerance", type=float, nargs=1, help="Relative tolerance to allow the solution to deviate; expressed as order of magnitudes less than baseline.") +parser.add_argument("atol", metavar="Absolute-Tolerance", type=float, nargs=1, help="Absolute tolerance to allow small values to pass; expressed as order of magnitudes less than baseline.") +parser.add_argument("-p", "-plot", dest="plot", action='store_true', help="bool to include plots in failed cases") +parser.add_argument("-n", "-no-exec", dest="noExec", action='store_true', help="bool to prevent execution of the test cases") +parser.add_argument("-v", "-verbose", dest="verbose", action='store_true', help="bool to include verbose system output") + +args = parser.parse_args() + +caseName = args.caseName[0] +executable = args.executable[0] +sourceDirectory = args.sourceDirectory[0] +buildDirectory = args.buildDirectory[0] +rtol = args.rtol[0] +atol = args.atol[0] +plotError = args.plot +noExec = args.noExec +verbose = args.verbose + +# validate inputs +rtl.validateExeOrExit(executable) +rtl.validateDirOrExit(sourceDirectory) +if not os.path.isdir(buildDirectory): + os.makedirs(buildDirectory, exist_ok = True) + +### Build the filesystem navigation variables for running the test case +regtests = os.path.join(sourceDirectory, "reg_tests") +lib = os.path.join(regtests, "lib") +rtest = os.path.join(regtests, "r-test") +moduleDirectory = os.path.join(rtest, "modules", "aerodisk") +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)) + +rtl.copyTree(inputsDirectory, testBuildDirectory, renameDict={'adsk_driver.outb':'adsk_driver_ref.outb'}) + +### Run aerodisk on the test case +if not noExec: + caseInputFile = os.path.join(testBuildDirectory, "adsk_driver.dvr") + returnCode = openfastDrivers.runAerodiskDriverCase(caseInputFile, executable, verbose=verbose) + if returnCode != 0: + sys.exit(returnCode*10) + +### Build the filesystem navigation variables for running the regression test +localOutFile = os.path.join(testBuildDirectory, "adsk_driver.out") +baselineOutFile = os.path.join(targetOutputDirectory, "adsk_driver.out") +rtl.validateFileOrExit(localOutFile) +rtl.validateFileOrExit(baselineOutFile) + +testData, testInfo, _ = pass_fail.readFASTOut(localOutFile) +baselineData, baselineInfo, _ = pass_fail.readFASTOut(baselineOutFile) + +passing_channels = pass_fail.passing_channels(testData.T, baselineData.T, rtol, atol) +passing_channels = passing_channels.T + +norms = pass_fail.calculateNorms(testData, baselineData) + +# export all case summaries +channel_names = testInfo["attribute_names"] +exportCaseSummary(testBuildDirectory, caseName, channel_names, passing_channels, norms) + +# passing case +if np.all(passing_channels): + sys.exit(0) + +# failing case +if plotError: + from errorPlotting import finalizePlotDirectory, plotOpenfastError + for channel in testInfo["attribute_names"]: + try: + plotOpenfastError(localOutFile, baselineOutFile, channel, rtol, atol) + except: + error = sys.exc_info()[1] + print("Error generating plots: {}".format(error)) + finalizePlotDirectory(localOutFile, testInfo["attribute_names"], caseName) + +sys.exit(1) diff --git a/reg_tests/executeAerodynPyRegressionCase.py b/reg_tests/executeAerodynPyRegressionCase.py index 34dd3f551b..e9de4f3bb0 100644 --- a/reg_tests/executeAerodynPyRegressionCase.py +++ b/reg_tests/executeAerodynPyRegressionCase.py @@ -69,7 +69,7 @@ rtl.validateExeOrExit(executable) rtl.validateDirOrExit(sourceDirectory) if not os.path.isdir(buildDirectory): - os.makedirs(buildDirectory) + os.makedirs(buildDirectory, exist_ok=True) ### Build the filesystem navigation variables for running the test case regtests = os.path.join(sourceDirectory, "reg_tests") diff --git a/reg_tests/executeAerodynRegressionCase.py b/reg_tests/executeAerodynRegressionCase.py index 98cae58380..3c6cbeac8f 100644 --- a/reg_tests/executeAerodynRegressionCase.py +++ b/reg_tests/executeAerodynRegressionCase.py @@ -69,7 +69,7 @@ rtl.validateExeOrExit(executable) rtl.validateDirOrExit(sourceDirectory) if not os.path.isdir(buildDirectory): - os.makedirs(buildDirectory) + os.makedirs(buildDirectory, exist_ok=True) ### Build the filesystem navigation variables for running the test case regtests = os.path.join(sourceDirectory, "reg_tests") diff --git a/reg_tests/executeBeamdynRegressionCase.py b/reg_tests/executeBeamdynRegressionCase.py index aa40c473b6..37ee8e373a 100644 --- a/reg_tests/executeBeamdynRegressionCase.py +++ b/reg_tests/executeBeamdynRegressionCase.py @@ -68,7 +68,7 @@ rtl.validateExeOrExit(executable) rtl.validateDirOrExit(sourceDirectory) if not os.path.isdir(buildDirectory): - os.makedirs(buildDirectory) + os.makedirs(buildDirectory, exist_ok=True) ### Build the filesystem navigation variables for running the test case regtests = os.path.join(sourceDirectory, "reg_tests") diff --git a/reg_tests/executeFASTFarmRegressionCase.py b/reg_tests/executeFASTFarmRegressionCase.py index 9796b2e897..ce092f851d 100644 --- a/reg_tests/executeFASTFarmRegressionCase.py +++ b/reg_tests/executeFASTFarmRegressionCase.py @@ -54,6 +54,7 @@ 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") +parser.add_argument("-compFile", dest="compFile", metavar="comparison-file", type=str, nargs='?', const='arg_was_not_given', help="File to use for comparison (no extension)") args = parser.parse_args() @@ -66,12 +67,19 @@ plotError = args.plot noExec = args.noExec verbose = args.verbose +# file to use for comparison (ending not included) +if args.compFile is None: + compFile = "FAST.Farm" +elif args.compFile == 'arg_was_not_given': + compFile = "FAST.Farm" +else: + compFile = args.compFile # validate inputs rtl.validateExeOrExit(executable) rtl.validateDirOrExit(sourceDirectory) if not os.path.isdir(buildDirectory): - os.makedirs(buildDirectory) + os.makedirs(buildDirectory, exist_ok=True) ### Build the filesystem navigation variables for running openfast on the test case @@ -91,7 +99,7 @@ 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 +# create the local copy of the common files for FAST.Farm cases dst = os.path.join(buildDirectory, "5MW_Baseline") src = os.path.join(moduleDirectory, "5MW_Baseline") if not os.path.isdir(dst): @@ -109,6 +117,13 @@ else: shutil.copy2(srcname, dstname) +# create the local output directory for the turbulence library. +dst = os.path.join(buildDirectory, "WAT_MannBoxDB") +src = os.path.join(moduleDirectory, "WAT_MannBoxDB") +if not os.path.isdir(dst): + rtl.copyTree(src, dst, excludeExt=excludeExt) + +# create the local output directory if it does not already exist if not os.path.isdir(testBuildDirectory): rtl.copyTree(inputsDirectory, testBuildDirectory, excludeExt=excludeExt) @@ -122,8 +137,8 @@ sys.exit(returnCode*10) ### Build the filesystem navigation variables for running the regression test -localOutFile = os.path.join(testBuildDirectory, caseName + ".out") -baselineOutFile = os.path.join(targetOutputDirectory, caseName + ".out") +localOutFile = os.path.join(testBuildDirectory, compFile + ".out") +baselineOutFile = os.path.join(targetOutputDirectory, compFile + ".out") rtl.validateFileOrExit(localOutFile) rtl.validateFileOrExit(baselineOutFile) diff --git a/reg_tests/executeHydrodynPyRegressionCase.py b/reg_tests/executeHydrodynPyRegressionCase.py index 77044846a4..56cf5a8bf3 100644 --- a/reg_tests/executeHydrodynPyRegressionCase.py +++ b/reg_tests/executeHydrodynPyRegressionCase.py @@ -69,7 +69,7 @@ rtl.validateExeOrExit(executable) rtl.validateDirOrExit(sourceDirectory) if not os.path.isdir(buildDirectory): - os.makedirs(buildDirectory) + os.makedirs(buildDirectory, exist_ok=True) ### Build the filesystem navigation variables for running the test case regtests = os.path.join(sourceDirectory, "reg_tests") @@ -88,24 +88,15 @@ if not os.path.isdir(inputsDirectory): rtl.exitWithError("The test data inputs directory, {}, does not exist. Verify your local repository is up to date.".format(inputsDirectory)) -# create the local output directory if it does not already exist -# and initialize it with input files for all test cases -if not os.path.isdir(testBuildDirectory): - os.makedirs(testBuildDirectory) - for file in glob.glob(os.path.join(inputsDirectory,"*py")): - filename = file.split(os.path.sep)[-1] - shutil.copy(os.path.join(inputsDirectory,filename), os.path.join(testBuildDirectory,filename)) - for file in glob.glob(os.path.join(inputsDirectory,"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)) +# create the local output directory and initialize it with input files +rtl.copyTree(inputsDirectory, testBuildDirectory) + # , excludeExt=['.out','.outb']) + ### Run HydroDyn on the test case if not noExec: caseInputFile = os.path.join(testBuildDirectory, "hydrodyn_driver.py") - returnCode = openfastDrivers.runHydrodynDriverCase(caseInputFile, executable) + returnCode = openfastDrivers.runHydrodynDriverCase(caseInputFile, executable, verbose=verbose) if returnCode != 0: sys.exit(returnCode*10) diff --git a/reg_tests/executeHydrodynRegressionCase.py b/reg_tests/executeHydrodynRegressionCase.py index 445c21294b..54d78767e4 100644 --- a/reg_tests/executeHydrodynRegressionCase.py +++ b/reg_tests/executeHydrodynRegressionCase.py @@ -70,7 +70,7 @@ rtl.validateExeOrExit(executable) rtl.validateDirOrExit(sourceDirectory) if not os.path.isdir(buildDirectory): - os.makedirs(buildDirectory) + os.makedirs(buildDirectory, exist_ok=True) ### Build the filesystem navigation variables for running the test case regtests = os.path.join(sourceDirectory, "reg_tests") @@ -108,8 +108,8 @@ sys.exit(returnCode*10) ### 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") +localOutFile = os.path.join(testBuildDirectory, "driver.out") +baselineOutFile = os.path.join(targetOutputDirectory, "driver.out") rtl.validateFileOrExit(localOutFile) rtl.validateFileOrExit(baselineOutFile) diff --git a/reg_tests/executeInflowwindPyRegressionCase.py b/reg_tests/executeInflowwindPyRegressionCase.py index 3981c4f82e..6990257a48 100644 --- a/reg_tests/executeInflowwindPyRegressionCase.py +++ b/reg_tests/executeInflowwindPyRegressionCase.py @@ -69,7 +69,7 @@ rtl.validateExeOrExit(executable) rtl.validateDirOrExit(sourceDirectory) if not os.path.isdir(buildDirectory): - os.makedirs(buildDirectory) + os.makedirs(buildDirectory, exist_ok=True) ### Build the filesystem navigation variables for running the test case regtests = os.path.join(sourceDirectory, "reg_tests") @@ -101,7 +101,7 @@ ### Run inflowwind on the test case if not noExec: - caseInputFile = os.path.join(testBuildDirectory, "inflowWind_testDriver.py") + caseInputFile = os.path.join(testBuildDirectory, "py_ifw_driver.py") returnCode = openfastDrivers.runInflowwindDriverCase(caseInputFile, executable) if returnCode != 0: sys.exit(returnCode*10) diff --git a/reg_tests/executeInflowwindRegressionCase.py b/reg_tests/executeInflowwindRegressionCase.py index fd940feec7..e431cc90f5 100644 --- a/reg_tests/executeInflowwindRegressionCase.py +++ b/reg_tests/executeInflowwindRegressionCase.py @@ -69,7 +69,7 @@ rtl.validateExeOrExit(executable) rtl.validateDirOrExit(sourceDirectory) if not os.path.isdir(buildDirectory): - os.makedirs(buildDirectory) + os.makedirs(buildDirectory, exist_ok=True) ### Build the filesystem navigation variables for running the test case regtests = os.path.join(sourceDirectory, "reg_tests") diff --git a/reg_tests/executeMoordynPyRegressionCase.py b/reg_tests/executeMoordynPyRegressionCase.py index 52a1b89806..0f43de1e66 100644 --- a/reg_tests/executeMoordynPyRegressionCase.py +++ b/reg_tests/executeMoordynPyRegressionCase.py @@ -70,7 +70,7 @@ rtl.validateExeOrExit(executable) rtl.validateDirOrExit(sourceDirectory) if not os.path.isdir(buildDirectory): - os.makedirs(buildDirectory) + os.makedirs(buildDirectory, exist_ok=True) ### Build the filesystem navigation variables for running the test case regtests = os.path.join(sourceDirectory, "reg_tests") diff --git a/reg_tests/executeMoordynRegressionCase.py b/reg_tests/executeMoordynRegressionCase.py index a2d209b767..58aef8df01 100644 --- a/reg_tests/executeMoordynRegressionCase.py +++ b/reg_tests/executeMoordynRegressionCase.py @@ -1,5 +1,5 @@ # -# Copyright 2017 National Renewable Energy Laboratory +# Copyright 2022 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. @@ -70,7 +70,7 @@ rtl.validateExeOrExit(executable) rtl.validateDirOrExit(sourceDirectory) if not os.path.isdir(buildDirectory): - os.makedirs(buildDirectory) + os.makedirs(buildDirectory, exist_ok=True) ### Build the filesystem navigation variables for running the test case regtests = os.path.join(sourceDirectory, "reg_tests") diff --git a/reg_tests/executeOpenfastAeroAcousticRegressionCase.py b/reg_tests/executeOpenfastAeroAcousticRegressionCase.py index 002f21a056..e78bee7ba7 100644 --- a/reg_tests/executeOpenfastAeroAcousticRegressionCase.py +++ b/reg_tests/executeOpenfastAeroAcousticRegressionCase.py @@ -72,7 +72,7 @@ rtl.validateExeOrExit(executable) rtl.validateDirOrExit(sourceDirectory) if not os.path.isdir(buildDirectory): - os.makedirs(buildDirectory) + os.makedirs(buildDirectory, exist_ok=True) ### Build the filesystem navigation variables for running openfast on the test case regtests = os.path.join(sourceDirectory, "reg_tests") diff --git a/reg_tests/executeOpenfastCppRegressionCase.py b/reg_tests/executeOpenfastCppRegressionCase.py index 82a7c248db..7aaae53217 100644 --- a/reg_tests/executeOpenfastCppRegressionCase.py +++ b/reg_tests/executeOpenfastCppRegressionCase.py @@ -26,6 +26,7 @@ import openfastDrivers import pass_fail from errorPlotting import exportCaseSummary +import glob ##### Helper functions excludeExt=['.out','.outb','.ech','.sum','.log'] @@ -63,15 +64,14 @@ rtl.validateExeOrExit(executable) rtl.validateDirOrExit(sourceDirectory) if not os.path.isdir(buildDirectory): - os.makedirs(buildDirectory) - + os.makedirs(buildDirectory, exist_ok=True) ### 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', '')) +targetOutputDirectory = os.path.join(inputsDirectory) testBuildDirectory = os.path.join(buildDirectory, caseName) # verify all the required directories exist @@ -106,16 +106,25 @@ ### Run openfast on the test case if not noExec: cwd = os.getcwd() + caseInputFile = os.path.join(testBuildDirectory, "cDriver.yaml") os.chdir(testBuildDirectory) - caseInputFile = os.path.abspath("cDriver.yaml") returnCode = openfastDrivers.runOpenfastCase(caseInputFile, executable) if returnCode != 0: sys.exit(returnCode*10) os.chdir(cwd) - + + +### If this is a restart test case +if '_Restart' in caseName: + caseInputFile = os.path.join(testBuildDirectory, "cDriverRestart.yaml") + os.chdir(testBuildDirectory) + returnCode = openfastDrivers.runOpenfastCase(caseInputFile, executable) + if returnCode != 0: + sys.exit(returnCode*10) + ### 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") +localOutFile = os.path.join(testBuildDirectory, "5MW_Land_DLL_WTurb_cpp.outb") +baselineOutFile = os.path.join(inputsDirectory, "5MW_Land_DLL_WTurb_cpp.outb.gold") rtl.validateFileOrExit(localOutFile) rtl.validateFileOrExit(baselineOutFile) diff --git a/reg_tests/executeOpenfastLinearRegressionCase.py b/reg_tests/executeOpenfastLinearRegressionCase.py index fbdbe635e3..91f43062b3 100644 --- a/reg_tests/executeOpenfastLinearRegressionCase.py +++ b/reg_tests/executeOpenfastLinearRegressionCase.py @@ -67,6 +67,7 @@ def isclose(a, b, rtol=1e-09, atol=0.0): 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") +parser.add_argument("-highpass", dest='highpass', metavar="LowPass-Filter", type=float, nargs='?', default=0.0, help="high pass filter on linearization frequencies to compare") args = parser.parse_args() @@ -79,6 +80,7 @@ def isclose(a, b, rtol=1e-09, atol=0.0): plotError = args.plot noExec = args.noExec verbose = args.verbose +highpass = args.highpass # --- Tolerances for matrix comparison # Outputs of lin matrices have 3 decimal digits leading to minimum error of 0.001 @@ -86,7 +88,7 @@ def isclose(a, b, rtol=1e-09, atol=0.0): # is between 1e-3 and 1e-4. We allow a bit of margin and use rtol=2e-3 # Lin matrices have a lot of small values, so atol is quite important rtol = 2e-3 -atol = 1e-5 +atol = 5e-4 # --- Tolerances for frequencies # Low frequencies are hard to match, so we use a high atol @@ -98,6 +100,10 @@ def isclose(a, b, rtol=1e-09, atol=0.0): rtol_d=1e-2 atol_d=1e-1 +# --- Filenames for frequency info +fileNameFreqRef="frequencies_ref.txt" +fileNameFreqNew="frequencies_new.txt" + CasePrefix=' Case: {}: '.format(caseName) def exitWithError(msg): @@ -110,7 +116,7 @@ def indent(msg, sindent='\t'): rtl.validateExeOrExit(executable) rtl.validateDirOrExit(sourceDirectory) if not os.path.isdir(buildDirectory): - os.makedirs(buildDirectory) + os.makedirs(buildDirectory, exist_ok=True) ### Build the filesystem navigation variables for running openfast on the test case regtests = os.path.join(sourceDirectory, "reg_tests") @@ -120,6 +126,8 @@ def indent(msg, sindent='\t'): inputsDirectory = os.path.join(moduleDirectory, caseName) targetOutputDirectory = os.path.join(inputsDirectory) testBuildDirectory = os.path.join(buildDirectory, caseName) +fNameFreqRef = os.path.join(testBuildDirectory, fileNameFreqRef) +fNameFreqNew = os.path.join(testBuildDirectory, fileNameFreqNew) # verify all the required directories exist if not os.path.isdir(rtest): @@ -175,124 +183,196 @@ def indent(msg, sindent='\t'): localFiles = os.listdir(testBuildDirectory) localOutFiles = [f for f in localFiles if f in baselineOutFiles] if len(localOutFiles) != len(baselineOutFiles): + print("Number of local files: {}".format(len(localOutFiles))) + print (" {}".format(localOutFiles)) + print("Number of baseline files: {}".format(len(baselineOutFiles))) + print (" {}".format(baselineOutFiles)) exitWithError("An expected local solution file does not exist:") ### test for regression (compare lin files only) -try: - for i, f in enumerate(localOutFiles): - local_file = os.path.join(testBuildDirectory, f) - baseline_file = os.path.join(targetOutputDirectory, f) - # Set a prefix for all errors to identify where it comes from - basename = os.path.splitext(os.path.basename(local_file))[0] - ext2 = os.path.splitext(basename)[1][1:] #+'.lin' # '.1' or '.AD' '.BD' - errPrefix = CasePrefix[:-1]+ext2+': ' +def compareLin(f,file_freq_ref,file_freq_new): + Errors = [] + ElemErrors = [] + + local_file = os.path.join(testBuildDirectory, f) + baseline_file = os.path.join(targetOutputDirectory, f) + local_file2 = local_file # Ellude the long filename + + # Set a prefix for all errors to identify where it comes from + basename = os.path.splitext(os.path.basename(local_file))[0] + ext2 = os.path.splitext(basename)[1][1:] +'.lin' # '.1' or '.AD' '.BD' + errPrefix = CasePrefix[:-1]+ext2+': ' + + if verbose: + print(errPrefix+'file_ref:', baseline_file) + print(errPrefix+'file_new:', local_file) + + def newError(msg): + msg=errPrefix+msg if verbose: - print(errPrefix+'ref:', baseline_file) - print(errPrefix+'new:', local_file) - - # 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: - Err="Local and baseline solutions have different line counts in" - Err+="\n\tFile1:{}".format(local_file) - Err+="\n\tFile2:{}\n\n".format(baseline_file) - raise Exception(Err) - - # open both files - floc = FASTLinearizationFile(local_file) - fbas = FASTLinearizationFile(baseline_file) - - # --- Test that they have the same variables - kloc = floc.keys() - kbas = fbas.keys() - try: - np.testing.assert_equal(kloc, kbas) - except Exception as e: - Err = 'Different keys in local linfile.\n' - Err+= '\tNew:{}\n'.format(kloc) - Err+= '\tRef:{}\n'.format(kbas) - Err+= '\tin linfile: {}.\n'.format(local_file) - raise Exception(Err) - - # --- Compare 10 first frequencies and damping ratios in 'A' matrix - if 'A' in fbas.keys(): - Abas = fbas['A'] - Aloc = floc['A'] - # Note: we could potentially reorder states like MBC does, but no need for freq/damping - _, zeta_bas, _, freq_bas = eigA(Abas, nq=None, nq1=None, sort=True) - _, zeta_loc, _, freq_loc = eigA(Aloc, nq=None, nq1=None, sort=True) - - if len(freq_bas)==0: - # We use complex eigenvalues instead of frequencies/damping - # If this fails often, we should discard this test. - _, Lambda = eig(Abas, sort=False) - v_bas = np.diag(Lambda) - _, Lambda = eig(Aloc, sort=False) - v_loc = np.diag(Lambda) - - if verbose: - print(errPrefix+'val_ref:', v_bas[:7]) - print(errPrefix+'val_new:', v_loc[:7]) - try: - np.testing.assert_allclose(v_bas[:10], v_loc[:10], rtol=rtol_f, atol=atol_f) - except Exception as e: - raise Exception('Failed to compare A-matrix frequencies\n\tLinfile: {}.\n\tException: {}'.format(local_file, indent(e.args[0]))) - else: + print(msg) + Errors.append(msg) + + def ApplyHighPass(freq,zeta): + freqL=np.array([]) + zetaL=np.array([]) + for i in range(len(freq)): + if freq[i]>highpass: + freqL = np.append(freqL,freq[i]) + zetaL = np.append(zetaL,zeta[i]) + return freqL,zetaL + + + + # 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: + Err="Local and baseline solutions have different line counts in" + Err+="\n\tFile1:{}".format(local_file) + Err+="\n\tFile2:{}\n\n".format(baseline_file) + newError(Err) + #raise Exception(Err) + + # open both files + floc = FASTLinearizationFile(local_file) + fbas = FASTLinearizationFile(baseline_file) + + # --- Test that they have the same variables + kloc = floc.keys() + kbas = fbas.keys() + try: + np.testing.assert_equal(kloc, kbas) + except Exception as e: + Err = 'Different keys in local linfile.\n' + Err+= '\tNew:{}\n'.format(kloc) + Err+= '\tRef:{}\n'.format(kbas) + Err+= '\tin linfile: {}.\n'.format(local_file2) + newError(Err) + #raise Exception(Err) + + # --- Compare 10 first frequencies and damping ratios in 'A' matrix + if 'A' in fbas.keys(): + Abas = fbas['A'] + Aloc = floc['A'] + # Note: we could potentially reorder states like MBC does, but no need for freq/damping + _, zeta_bas, _, freq_bas = eigA(Abas, nq=None, nq1=None, sort=True, fullEV=True) + _, zeta_loc, _, freq_loc = eigA(Aloc, nq=None, nq1=None, sort=True, fullEV=True) + + freq_bas, zeta_bas = ApplyHighPass( freq_bas, zeta_bas ) + freq_loc, zeta_loc = ApplyHighPass( freq_loc, zeta_loc ) + + if len(freq_bas)==0: + # We use complex eigenvalues instead of frequencies/damping + # If this fails often, we should discard this test. + _, Lambda = eig(Abas, sort=False) + v_bas = np.diag(Lambda) + _, Lambda = eig(Aloc, sort=False) + v_loc = np.diag(Lambda) - #if verbose: - print(errPrefix+'freq_ref:', np.around(freq_bas[:10] ,5), '[Hz]') - print(errPrefix+'freq_new:', np.around(freq_loc[:10] ,5), '[Hz]') - print(errPrefix+'damp_ref:', np.around(zeta_bas[:10]*100,5), '[%]') - print(errPrefix+'damp_new:', np.around(zeta_loc[:10]*100,5), '[%]') + if verbose: + print(errPrefix+'val_ref:', v_bas[:7]) + print(errPrefix+'val_new:', v_loc[:7]) + try: + np.testing.assert_allclose(v_bas[:10], v_loc[:10], rtol=rtol_f, atol=atol_f) + except Exception as e: + Err='Failed to compare A-matrix frequencies\n\tLinfile: {}.\n\tException: {}'.format(local_file2, indent(e.args[0])) + newError(Err) + else: + #if verbose: + print('\n'+errPrefix+':') + print(' Frequency (Hz) Damping (%)') + print(' ---------------------------- ----------------------------') + print(' Ref New Ref New') + #write frequencies to file + try: + file_freq_ref.write('\n'+errPrefix+':\n') + file_freq_ref.write(' Freq (Hz) Damp (%)\n') + file_freq_new.write('\n'+errPrefix+':\n') + file_freq_new.write(' Freq (Hz) Damp (%)\n') + except Exception: + pass # ignore all writing errors + + + for j in range(min(10,max(len(freq_bas),len(freq_loc)))): + if j0: + Errors += ElemErrorsLoc[:3] # Just a couple of them + +freqFileClose(ff1,ff2) -except Exception as e: - exitWithError(e.args[0]) +if len(Errors)>0: + exitWithError('See errors below: \n'+'\n'.join(Errors)) # passing case sys.exit(0) diff --git a/reg_tests/executeOpenfastRegressionCase.py b/reg_tests/executeOpenfastRegressionCase.py index c4aa6c23a2..ae863d3a46 100644 --- a/reg_tests/executeOpenfastRegressionCase.py +++ b/reg_tests/executeOpenfastRegressionCase.py @@ -29,6 +29,7 @@ import argparse import numpy as np import shutil +import glob import subprocess import rtestlib as rtl import openfastDrivers @@ -54,6 +55,7 @@ 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") +parser.add_argument("-steadystate", dest="steadyState", action='store_true', help="perform steadystate/aeromap analysis" ) args = parser.parse_args() @@ -66,12 +68,13 @@ plotError = args.plot noExec = args.noExec verbose = args.verbose +steadyState = args.steadyState # validate inputs rtl.validateExeOrExit(executable) rtl.validateDirOrExit(sourceDirectory) if not os.path.isdir(buildDirectory): - os.makedirs(buildDirectory) + os.makedirs(buildDirectory, exist_ok=True) ### Build the filesystem navigation variables for running openfast on the test case @@ -121,11 +124,24 @@ ### Run openfast on the test case if not noExec: - caseInputFile = os.path.join(testBuildDirectory, caseName + ".fst") - returnCode = openfastDrivers.runOpenfastCase(caseInputFile, executable) + if steadyState: + caseInputFile = os.path.join(testBuildDirectory, caseName + ".drv") + returnCode = openfastDrivers.runAeromapCase(caseInputFile, executable) + else: + caseInputFile = os.path.join(testBuildDirectory, caseName + ".fst") + returnCode = openfastDrivers.runOpenfastCase(caseInputFile, executable) if returnCode != 0: sys.exit(returnCode*10) - + +### If this is a restart test case +if caseName.endswith('_Restart'): + for caseInputFile in reversed(glob.glob(os.path.join(testBuildDirectory, '*chkp'))): + if not caseInputFile.endswith('dll.chkp'): + break + returnCode = openfastDrivers.runOpenfastCase(caseInputFile, executable, restart=True) + if returnCode != 0: + sys.exit(returnCode*10) + ### Build the filesystem navigation variables for running the regression test localOutFile = os.path.join(testBuildDirectory, caseName + ".outb") baselineOutFile = os.path.join(targetOutputDirectory, caseName + ".outb") diff --git a/reg_tests/executePythonRegressionCase.py b/reg_tests/executePythonRegressionCase.py index 9106c588b2..13ecb5218f 100644 --- a/reg_tests/executePythonRegressionCase.py +++ b/reg_tests/executePythonRegressionCase.py @@ -73,7 +73,7 @@ # validate inputs rtl.validateDirOrExit(sourceDirectory) if not os.path.isdir(buildDirectory): - os.makedirs(buildDirectory) + os.makedirs(buildDirectory, exist_ok=True) ### Build the filesystem navigation variables for running openfast on the test case diff --git a/reg_tests/executeSeaStateRegressionCase.py b/reg_tests/executeSeaStateRegressionCase.py new file mode 100644 index 0000000000..caab272448 --- /dev/null +++ b/reg_tests/executeSeaStateRegressionCase.py @@ -0,0 +1,146 @@ +# +# Copyright 2017 National Renewable Energy Laboratory +# +# Licensed under the Apache License, Version 2.0 (the "License"); +# you may not use this file except in compliance with the License. +# You may obtain a copy of the License at +# +# http://www.apache.org/licenses/LICENSE-2.0 +# +# Unless required by applicable law or agreed to in writing, software +# distributed under the License is distributed on an "AS IS" BASIS, +# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +# See the License for the specific language governing permissions and +# limitations under the License. +# + +""" + This program executes SeaState 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: `executeSeaStateRegressionCase.py -h` +""" + +import os +import sys +basepath = os.path.dirname(os.path.abspath(__file__)) +sys.path.insert(0, os.path.sep.join([basepath, "lib"])) +import argparse +import numpy as np +import shutil +import glob +import subprocess +import rtestlib as rtl +import openfastDrivers +import pass_fail +from errorPlotting import exportCaseSummary + +##### Main program + +### Store the python executable for future python calls +pythonCommand = sys.executable + +### Verify input arguments +parser = argparse.ArgumentParser(description="Executes 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="SeaState-Driver", type=str, nargs=1, help="The path to the SeaStatedriver executable.") +parser.add_argument("sourceDirectory", metavar="path/to/openfast_repo", type=str, nargs=1, help="The path to the OpenFAST repository.") +parser.add_argument("buildDirectory", metavar="path/to/openfast_repo/build", type=str, nargs=1, help="The path to the OpenFAST repository build directory.") +parser.add_argument("rtol", metavar="Relative-Tolerance", type=float, nargs=1, help="Relative tolerance to allow the solution to deviate; expressed as order of magnitudes less than baseline.") +parser.add_argument("atol", metavar="Absolute-Tolerance", type=float, nargs=1, help="Absolute tolerance to allow small values to pass; expressed as order of magnitudes less than baseline.") +parser.add_argument("-p", "-plot", dest="plot", action='store_true', help="bool to include plots in failed cases") +parser.add_argument("-n", "-no-exec", dest="noExec", action='store_true', help="bool to prevent execution of the test cases") +parser.add_argument("-v", "-verbose", dest="verbose", action='store_true', help="bool to include verbose system output") + +args = parser.parse_args() + +caseName = args.caseName[0] +executable = args.executable[0] +sourceDirectory = args.sourceDirectory[0] +buildDirectory = args.buildDirectory[0] +rtol = args.rtol[0] +atol = args.atol[0] +plotError = args.plot +noExec = args.noExec +verbose = args.verbose + +# validate inputs +rtl.validateExeOrExit(executable) +rtl.validateDirOrExit(sourceDirectory) +if not os.path.isdir(buildDirectory): + os.makedirs(buildDirectory, exist_ok=True) + +### Build the filesystem navigation variables for running the test case +regtests = os.path.join(sourceDirectory, "reg_tests") +lib = os.path.join(regtests, "lib") +rtest = os.path.join(regtests, "r-test") +moduleDirectory = os.path.join(rtest, "modules", "seastate") +inputsDirectory = os.path.join(moduleDirectory, caseName) +targetOutputDirectory = os.path.join(inputsDirectory) +testBuildDirectory = os.path.join(buildDirectory, caseName) + +# verify all the required directories exist +if not os.path.isdir(rtest): + rtl.exitWithError("The test data directory, {}, does not exist. If you haven't already, run `git submodule update --init --recursive`".format(rtest)) +if not os.path.isdir(targetOutputDirectory): + rtl.exitWithError("The test data outputs directory, {}, does not exist. Try running `git submodule update`".format(targetOutputDirectory)) +if not os.path.isdir(inputsDirectory): + rtl.exitWithError("The test data inputs directory, {}, does not exist. Verify your local repository is up to date.".format(inputsDirectory)) + +# Special case, copy the seastate_wr_kin1 files first since seastate_wavemod5 requires them +dst = os.path.join(buildDirectory, "seastate_wr_kin1") +src = os.path.join(moduleDirectory, "seastate_wr_kin1") +try: + rtl.copyTree(src, dst) +except: + # This can fail if two processes are copying the file at the same time + print('>>> Copy failed') + import time + time.sleep(1) + +# create the local output directory and initialize it with input files +if not os.path.isdir(testBuildDirectory): + rtl.copyTree(inputsDirectory, testBuildDirectory, renameDict={'seastate.SeaSt.out':'seastate.SeaSt.Ref.out'}) + +### Run seastate on the test case +if not noExec: + caseInputFile = os.path.join(testBuildDirectory, "seastate_driver.inp") + returnCode = openfastDrivers.runSeaStateDriverCase(caseInputFile, executable, verbose=verbose) + if returnCode != 0: + sys.exit(returnCode*10) + +### Build the filesystem navigation variables for running the regression test +localOutFile = os.path.join(testBuildDirectory, "seastate.SeaSt.out") +baselineOutFile = os.path.join(targetOutputDirectory, os.path.basename(localOutFile)) +rtl.validateFileOrExit(localOutFile) +rtl.validateFileOrExit(baselineOutFile) + +testData, testInfo, _ = pass_fail.readFASTOut(localOutFile) +baselineData, baselineInfo, _ = pass_fail.readFASTOut(baselineOutFile) + +passing_channels = pass_fail.passing_channels(testData.T, baselineData.T, rtol, atol) +passing_channels = passing_channels.T + +norms = pass_fail.calculateNorms(testData, baselineData) + +# export all case summaries +channel_names = testInfo["attribute_names"] +exportCaseSummary(testBuildDirectory, caseName, channel_names, passing_channels, norms) + +# passing case +if np.all(passing_channels): + sys.exit(0) + +# failing case +if plotError: + from errorPlotting import finalizePlotDirectory, plotOpenfastError + for channel in testInfo["attribute_names"]: + try: + plotOpenfastError(localOutFile, baselineOutFile, channel, rtol, atol) + except: + error = sys.exc_info()[1] + print("Error generating plots: {}".format(error)) + finalizePlotDirectory(localOutFile, testInfo["attribute_names"], caseName) + +sys.exit(1) diff --git a/reg_tests/executeSimpleElastodynRegressionCase.py b/reg_tests/executeSimpleElastodynRegressionCase.py new file mode 100644 index 0000000000..e271872574 --- /dev/null +++ b/reg_tests/executeSimpleElastodynRegressionCase.py @@ -0,0 +1,133 @@ +# +# Copyright 2024 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 Simple-ElastoDyn 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: `executeSimpleElastoDynRegressionCase.py -h` +""" + +import os +import sys +basepath = os.path.dirname(os.path.abspath(__file__)) +sys.path.insert(0, os.path.sep.join([basepath, "lib"])) +import argparse +import numpy as np +import shutil +import glob +import subprocess +import rtestlib as rtl +import openfastDrivers +import pass_fail +from errorPlotting import exportCaseSummary + +##### Main program + +### Store the python executable for future python calls +pythonCommand = sys.executable + +### Verify input arguments +parser = argparse.ArgumentParser(description="Executes 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="SED-Driver", type=str, nargs=1, help="The path to the SED driver executable.") +parser.add_argument("sourceDirectory", metavar="path/to/openfast_repo", type=str, nargs=1, help="The path to the OpenFAST repository.") +parser.add_argument("buildDirectory", metavar="path/to/openfast_repo/build", type=str, nargs=1, help="The path to the OpenFAST repository build directory.") +parser.add_argument("rtol", metavar="Relative-Tolerance", type=float, nargs=1, help="Relative tolerance to allow the solution to deviate; expressed as order of magnitudes less than baseline.") +parser.add_argument("atol", metavar="Absolute-Tolerance", type=float, nargs=1, help="Absolute tolerance to allow small values to pass; expressed as order of magnitudes less than baseline.") +parser.add_argument("-p", "-plot", dest="plot", action='store_true', help="bool to include plots in failed cases") +parser.add_argument("-n", "-no-exec", dest="noExec", action='store_true', help="bool to prevent execution of the test cases") +parser.add_argument("-v", "-verbose", dest="verbose", action='store_true', help="bool to include verbose system output") + +args = parser.parse_args() + +caseName = args.caseName[0] +executable = args.executable[0] +sourceDirectory = args.sourceDirectory[0] +buildDirectory = args.buildDirectory[0] +rtol = args.rtol[0] +atol = args.atol[0] +plotError = args.plot +noExec = args.noExec +verbose = args.verbose + +# validate inputs +rtl.validateExeOrExit(executable) +rtl.validateDirOrExit(sourceDirectory) +if not os.path.isdir(buildDirectory): + os.makedirs(buildDirectory, exist_ok = True) + +### Build the filesystem navigation variables for running the test case +regtests = os.path.join(sourceDirectory, "reg_tests") +lib = os.path.join(regtests, "lib") +rtest = os.path.join(regtests, "r-test") +moduleDirectory = os.path.join(rtest, "modules", "simple-elastodyn") +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)) + +rtl.copyTree(inputsDirectory, testBuildDirectory, renameDict={'sed_driver.outb':'sed_driver_ref.outb'}) + +### Run SED on the test case +if not noExec: + caseInputFile = os.path.join(testBuildDirectory, "sed_driver.dvr") + returnCode = openfastDrivers.runSimpleElastodynDriverCase(caseInputFile, executable, verbose=verbose) + if returnCode != 0: + rtl.exitWithError("") + +### Build the filesystem navigation variables for running the regression test +localOutFile = os.path.join(testBuildDirectory, "sed_driver.out") +baselineOutFile = os.path.join(targetOutputDirectory, "sed_driver.out") +rtl.validateFileOrExit(localOutFile) +rtl.validateFileOrExit(baselineOutFile) + +testData, testInfo, _ = pass_fail.readFASTOut(localOutFile) +baselineData, baselineInfo, _ = pass_fail.readFASTOut(baselineOutFile) + +passing_channels = pass_fail.passing_channels(testData.T, baselineData.T, rtol, atol) +passing_channels = passing_channels.T + +norms = pass_fail.calculateNorms(testData, baselineData) + +# export all case summaries +channel_names = testInfo["attribute_names"] +exportCaseSummary(testBuildDirectory, caseName, channel_names, passing_channels, norms) + +# passing case +if np.all(passing_channels): + sys.exit(0) + +# failing case +if plotError: + from errorPlotting import finalizePlotDirectory, plotOpenfastError + for channel in testInfo["attribute_names"]: + try: + plotOpenfastError(localOutFile, baselineOutFile, channel, rtol, atol) + except: + error = sys.exc_info()[1] + print("Error generating plots: {}".format(error)) + finalizePlotDirectory(localOutFile, testInfo["attribute_names"], caseName) + +sys.exit(1) diff --git a/reg_tests/executeSubdynRegressionCase.py b/reg_tests/executeSubdynRegressionCase.py index 9a71b167e5..04363472d4 100644 --- a/reg_tests/executeSubdynRegressionCase.py +++ b/reg_tests/executeSubdynRegressionCase.py @@ -69,7 +69,7 @@ rtl.validateExeOrExit(executable) rtl.validateDirOrExit(sourceDirectory) if not os.path.isdir(buildDirectory): - os.makedirs(buildDirectory) + os.makedirs(buildDirectory, exist_ok=True) ### Build the filesystem navigation variables for running the test case regtests = os.path.join(sourceDirectory, "reg_tests") @@ -91,7 +91,7 @@ # create the local output directory and initialize it with input files (overwrite if exists) rtl.copyTree(inputsDirectory, testBuildDirectory, renameExtDict={'.out':'_ref.out'}, includeExt=['.dvr','.dat','.out','.csv']) - + ### Run SubDyn on the test case if not noExec: caseInputFile = os.path.join(testBuildDirectory, caseName+".dvr") diff --git a/reg_tests/executeUnsteadyAeroRegressionCase.py b/reg_tests/executeUnsteadyAeroRegressionCase.py index b8ca227924..2e441c4abc 100644 --- a/reg_tests/executeUnsteadyAeroRegressionCase.py +++ b/reg_tests/executeUnsteadyAeroRegressionCase.py @@ -69,7 +69,7 @@ rtl.validateExeOrExit(executable) rtl.validateDirOrExit(sourceDirectory) if not os.path.isdir(buildDirectory): - os.makedirs(buildDirectory) + os.makedirs(buildDirectory, exist_ok=True) ### Build the filesystem navigation variables for running the test case regtests = os.path.join(sourceDirectory, "reg_tests") @@ -90,7 +90,7 @@ # create the local output directory and initialize it with input files -renameDict={'UA'+str(i)+'.UA.out':'UA'+str(i)+'.UA_ref.out' for i in [2,3,4,5,6,7]} +renameDict={'UA'+str(i)+'.outb':'UA'+str(i)+'_ref.outb' for i in [2,3,4,5,6,7]} rtl.copyTree(inputsDirectory, testBuildDirectory, renameDict=renameDict , excludeExt=['.sum']) @@ -116,8 +116,8 @@ def Error(msg): ### Compare output with for dvrf in dvrFiles: simName = os.path.splitext(os.path.basename(dvrf))[0] - localOutFile = os.path.join(testBuildDirectory, simName + '.UA.out') - baselineOutFile = os.path.join(inputsDirectory, simName + '.UA.out') + localOutFile = os.path.join(testBuildDirectory, simName + '.outb') + baselineOutFile = os.path.join(inputsDirectory, simName + '.outb') # TODO TODO if not os.path.exists(localOutFile): Error('File does not exist: {}'.format(localOutFile)) diff --git a/reg_tests/lib/errorPlotting.py b/reg_tests/lib/errorPlotting.py index c34084f081..7de955b21b 100644 --- a/reg_tests/lib/errorPlotting.py +++ b/reg_tests/lib/errorPlotting.py @@ -102,7 +102,7 @@ def _replace_id_script(html_string, plot): return html_string def _save_plot(script, div, path, attribute): - div_class = ' class=""' + div_class = '' file_name = "_script".join((attribute, ".txt")) with open(os.path.join(path, file_name), 'w') as f: diff --git a/reg_tests/lib/eva.py b/reg_tests/lib/eva.py index 3908729b94..37cd28ad49 100644 --- a/reg_tests/lib/eva.py +++ b/reg_tests/lib/eva.py @@ -158,18 +158,18 @@ def eigA(A, nq=None, nq1=None, fullEV=False, normQ=None, sort=True): if m!=n: raise Exception('Matrix needs to be squared') - if nq is None: - if nq1 is None: - nq1=0 - nq = int((n-nq1)/2) - else: - nq1 = n-2*nq - if n!=2*nq+nq1 or nq1<0: - raise Exception('Number of 1st and second order dofs should match the matrix shape (n= 2*nq + nq1') Q, Lambda = eig(A, sort=False) v = np.diag(Lambda) if not fullEV: + if nq is None: + if nq1 is None: + nq1=0 + nq = int((n-nq1)/2) + else: + nq1 = n-2*nq + if n!=2*nq+nq1 or nq1<0: + raise Exception('Number of 1st and second order dofs should match the matrix shape (n= 2*nq + nq1') Q=np.delete(Q, slice(nq,2*nq), axis=0) # Selecting eigenvalues with positive imaginary part (frequency) diff --git a/reg_tests/lib/openfastDrivers.py b/reg_tests/lib/openfastDrivers.py index 93bba5bbfb..5323ad818b 100644 --- a/reg_tests/lib/openfastDrivers.py +++ b/reg_tests/lib/openfastDrivers.py @@ -27,34 +27,38 @@ import subprocess import rtestlib as rtl -def _runCase(executable, inputFile, logFile, stdout): +def _runCase(executable, inputFile, logFile, stdout, restart=False, ExtraFlags=""): if logFile is None: - command = "{} {}".format(executable, inputFile, logFile) + command = f"{executable} {inputFile} {ExtraFlags}" + elif restart: + command = f"{executable} -restart {os.path.splitext(inputFile)[0]} > {logFile}" else: - command = "{} {} > {}".format(executable, inputFile, logFile) + command = f"{executable} {inputFile} {ExtraFlags} > {logFile}" print(command) return subprocess.call(command, stdout=stdout, shell=True) -def _runGenericCase(inputFile, executable, verbose=False, log=True): +def _runGenericCase(inputFile, executable, verbose=False, restart=False, ExtraFlags=""): stdout = sys.stdout if verbose else open(os.devnull, 'w') rtl.validateFileOrExit(inputFile) rtl.validateExeOrExit(executable) -#bjj, why wouldn't we check if log is true instead of verbose being false to generate a log file??? if verbose: logFile = None else: caseparent = os.path.sep.join(inputFile.split(os.path.sep)[:-1]) casebase = caseparent.split(os.path.sep)[-1] # assumes that the directory structure name is the name of the .log file. (for consistent driver + glue-code names) - logFile = caseparent + os.path.sep + casebase + '.log' + if restart: + logFile = caseparent + os.path.sep + casebase + '_2.log' + else: + logFile = caseparent + os.path.sep + casebase + '.log' - returnCode = _runCase(executable, inputFile, logFile, stdout) + returnCode = _runCase(executable, inputFile, logFile, stdout, restart, ExtraFlags) print("COMPLETE with code {}".format(returnCode), flush=True) return returnCode -def _runUACase(inputFile, executable, verbose=False, log=True): +def _runUACase(inputFile, executable, verbose=False): stdout = sys.stdout if verbose else open(os.devnull, 'w') rtl.validateFileOrExit(inputFile) @@ -71,8 +75,11 @@ def _runUACase(inputFile, executable, verbose=False, log=True): return returnCode -def runOpenfastCase(inputFile, executable, verbose=False): - return _runGenericCase(inputFile, executable, verbose) +def runOpenfastCase(inputFile, executable, verbose=False, restart=False): + return _runGenericCase(inputFile, executable, verbose, restart) + +def runAeromapCase(inputFile, executable, verbose=False): + return _runGenericCase(inputFile, executable, verbose, restart=False, ExtraFlags="-steadystate") def runAerodynDriverCase(inputFile, executable, verbose=False): caseDirectory = os.path.sep.join(inputFile.split(os.path.sep)[:-1]) @@ -90,8 +97,10 @@ def runBeamdynDriverCase(inputFile, executable, verbose=False): 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 runMoordynDriverCase(inputFile, executable, verbose=False): + print("MoorDyn run: {}".format(inputFile)) return _runGenericCase(inputFile, executable, verbose) def runSubdynDriverCase(inputFile, executable, verbose=False): @@ -109,3 +118,17 @@ def runMoordynDriverCase(inputFile, executable, verbose=False): os.chdir(caseDirectory) return _runGenericCase(inputFile, executable, verbose) +def runSeaStateDriverCase(inputFile, executable, verbose=False): + caseDirectory = os.path.sep.join(inputFile.split(os.path.sep)[:-1]) + os.chdir(caseDirectory) + return _runGenericCase(inputFile, executable, verbose) + +def runAerodiskDriverCase(inputFile, executable, verbose=False): + caseDirectory = os.path.sep.join(inputFile.split(os.path.sep)[:-1]) + os.chdir(caseDirectory) + return _runGenericCase(inputFile, executable, verbose) + +def runSimpleElastodynDriverCase(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/reg_tests/lib/pass_fail.py b/reg_tests/lib/pass_fail.py index b9317745ce..1a9e0f1e75 100644 --- a/reg_tests/lib/pass_fail.py +++ b/reg_tests/lib/pass_fail.py @@ -43,9 +43,14 @@ def passing_channels(test, baseline, RTOL_MAGNITUDE, ATOL_MAGNITUDE) -> np.ndarr NUMEPS = 1e-12 ATOL_MIN = 1e-6 - n_channels = np.shape(test)[0] where_close = np.zeros_like(test, dtype=bool) + if test.size != baseline.size: + passing_channels = np.all(where_close, axis=1) # all false + return passing_channels + + n_channels = np.shape(test)[0] + rtol = 10**(-1 * RTOL_MAGNITUDE) for i in range(n_channels): baseline_offset = baseline[i] - np.min(baseline[i]) diff --git a/reg_tests/r-test b/reg_tests/r-test index d9691df033..f78149f374 160000 --- a/reg_tests/r-test +++ b/reg_tests/r-test @@ -1 +1 @@ -Subproject commit d9691df0339bbc718c63e1de8a1aaa642e978398 +Subproject commit f78149f37477c23b5780d0cb52c198713a96330f diff --git a/requirements.txt b/requirements.txt index 21752feaf4..ad406e0555 100644 --- a/requirements.txt +++ b/requirements.txt @@ -1,4 +1,5 @@ # Python dependencies used for testing numpy vtk -Bokeh>=2.4,!=3.0.0,!=3.0.1,!=3.0.2,!=3.0.3 \ No newline at end of file +Bokeh>=2.4,!=3.0.0,!=3.0.1,!=3.0.2,!=3.0.3 +pytest \ No newline at end of file diff --git a/unit_tests/CMakeLists.txt b/unit_tests/CMakeLists.txt index 4a3b7e4d08..47e799e4d1 100644 --- a/unit_tests/CMakeLists.txt +++ b/unit_tests/CMakeLists.txt @@ -18,62 +18,76 @@ # -- OpenFAST Unit Testing # ----------------------------------------------------------- -cmake_minimum_required(VERSION 3.12) -project(OpenFAST_UnitTest Fortran) - include(CTest) -if(NOT ${Python_Interpreter_FOUND}) - message(FATAL_ERROR "CMake did not find a Python interpreter. Python is required for unit tests." ) -endif() -if (${Python_VERSION} VERSION_GREATER_EQUAL "3.12.0") - message(FATAL_ERROR "Unit testing with pfunit not currently possible with Python 3.12 or greater." ) -endif() - +# Test-Drive library +add_library(testdrivelib test-drive/testdrive.F90 test-drive/testdrive_version.f90) +# AeroDyn Unit Tests +add_executable(aerodyn_utest + ${PROJECT_SOURCE_DIR}/modules/aerodyn/tests/aerodyn_utest.F90 + ${PROJECT_SOURCE_DIR}/modules/aerodyn/tests/test_AD_FVW.F90 +) +target_link_libraries(aerodyn_utest aerodynlib versioninfolib testdrivelib) +add_test(NAME aerodyn_utest COMMAND aerodyn_utest) -### pfunit -include(ExternalProject) - -set(PFUNIT_INSTALL ${PROJECT_BINARY_DIR}/pfunit) -set(PFUNIT_LIB_PATH ${PROJECT_BINARY_DIR}/pfunit/lib/${CMAKE_STATIC_LIBRARY_PREFIX}pfunit${CMAKE_STATIC_LIBRARY_SUFFIX}) -set(build_testdirectory ${PROJECT_BINARY_DIR}/tests) -set(source_modulesdirectory ${PROJECT_SOURCE_DIR}/../modules) -set(pfunit_directory ${PFUNIT_INSTALL}) +# BeamDyn Unit Tests +add_executable(beamdyn_utest + ${PROJECT_SOURCE_DIR}/modules/beamdyn/tests/beamdyn_utest.F90 + ${PROJECT_SOURCE_DIR}/modules/beamdyn/tests/test_BD_Crv.F90 + ${PROJECT_SOURCE_DIR}/modules/beamdyn/tests/test_BD_Misc.F90 + ${PROJECT_SOURCE_DIR}/modules/beamdyn/tests/test_BD_diffmtc.F90 + ${PROJECT_SOURCE_DIR}/modules/beamdyn/tests/test_BD_MemberEta.F90 + ${PROJECT_SOURCE_DIR}/modules/beamdyn/tests/test_BD_QuadraturePointData.F90 + ${PROJECT_SOURCE_DIR}/modules/beamdyn/tests/test_BD_ShapeFuncs.F90 + ${PROJECT_SOURCE_DIR}/modules/beamdyn/tests/test_BD_TrapezoidalPointWeight.F90 + ${PROJECT_SOURCE_DIR}/modules/beamdyn/tests/test_BD_InitializeNodalLocations.F90 + ${PROJECT_SOURCE_DIR}/modules/beamdyn/tests/test_tools.F90 +) +target_link_libraries(beamdyn_utest beamdynlib versioninfolib testdrivelib) +add_test(NAME beamdyn_utest COMMAND beamdyn_utest) -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 - -DCMAKE_INSTALL_PREFIX=${PROJECT_BINARY_DIR}/pfunit - -DCMAKE_Fortran_COMPILER=${CMAKE_Fortran_COMPILER} - -DPYTHON_EXECUTABLE=${Python_EXECUTABLE} - -DROBUST=OFF - BUILD_BYPRODUCTS - ${PFUNIT_LIB_PATH} - ${PFUNIT_INSTALL}/include/driver.F90 +# InflowWind Unit Tests +add_executable(inflowwind_utest + ${PROJECT_SOURCE_DIR}/modules/inflowwind/tests/inflowwind_utest.F90 + ${PROJECT_SOURCE_DIR}/modules/inflowwind/tests/test_bladed_wind.F90 + ${PROJECT_SOURCE_DIR}/modules/inflowwind/tests/test_hawc_wind.F90 + ${PROJECT_SOURCE_DIR}/modules/inflowwind/tests/test_outputs.F90 + ${PROJECT_SOURCE_DIR}/modules/inflowwind/tests/test_steady_wind.F90 + ${PROJECT_SOURCE_DIR}/modules/inflowwind/tests/test_turbsim_wind.F90 + ${PROJECT_SOURCE_DIR}/modules/inflowwind/tests/test_uniform_wind.F90 + ${PROJECT_SOURCE_DIR}/modules/inflowwind/tests/ifw_test_tools.F90 ) -add_library(pfunit_lib STATIC IMPORTED) -set_target_properties(pfunit_lib PROPERTIES IMPORTED_LOCATION ${PFUNIT_LIB_PATH}) +target_link_libraries(inflowwind_utest ifwlib versioninfolib testdrivelib) +add_test(NAME inflowwind_utest COMMAND inflowwind_utest) -include_directories( - ${PROJECT_SOURCE_DIR} - ${PROJECT_BINARY_DIR}/pfunit/mod - ${PROJECT_BINARY_DIR}/tests - ${PFUNIT_INSTALL}/mod +# NWTC Library Unit Tests +add_executable(nwtc_library_utest + ${PROJECT_SOURCE_DIR}/modules/nwtc-library/tests/nwtc_library_utest.F90 + ${PROJECT_SOURCE_DIR}/modules/nwtc-library/tests/NWTC_Library_test_tools.F90 + ${PROJECT_SOURCE_DIR}/modules/nwtc-library/tests/test_NWTC_IO_FileInfo.F90 + ${PROJECT_SOURCE_DIR}/modules/nwtc-library/tests/test_NWTC_RandomNumber.F90 ) +target_link_libraries(nwtc_library_utest nwtclibs testdrivelib) + +add_test(NAME nwtc_library_utest COMMAND nwtc_library_utest) -### Add the unit tests here -add_subdirectory("beamdyn") -add_subdirectory("nwtc-library") -add_subdirectory("aerodyn") -add_subdirectory("inflowwind") -add_subdirectory("version") +# Version Info Unit Tests +add_executable(versioninfo_utest + ${PROJECT_SOURCE_DIR}/modules/version/tests/versioninfo_utest.F90 + ${PROJECT_SOURCE_DIR}/modules/version/tests/VersionInfo_test_tools.F90 + ${PROJECT_SOURCE_DIR}/modules/version/tests/test_VersionInfo_CheckArgs.F90 +) +target_link_libraries(versioninfo_utest versioninfolib testdrivelib) +add_test(NAME versioninfo_utest COMMAND versioninfo_utest) +# Custom target combining all the unit tests add_custom_target( unit_tests - DEPENDS beamdyn_utest nwtc_library_utest fvw_utest inflowwind_utest versioninfo_utest -) + DEPENDS + nwtc_library_utest + versioninfo_utest + beamdyn_utest + aerodyn_utest + inflowwind_utest +) \ No newline at end of file diff --git a/unit_tests/README.md b/unit_tests/README.md index 48cc589484..511b8a53bd 100644 --- a/unit_tests/README.md +++ b/unit_tests/README.md @@ -1,14 +1,12 @@ # 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 +- [test-drive](https://github.com/fortran-lang/test-drive), an external framework for Fortran unit testing (commit a78870c, November 24, 2023) - CMake configuration file -- A unit test template file The dependencies for unit testing are: -- Python 3.7+ -- pFUnit +- test-drive - 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 +See [readthedocs](http://openfast.readthedocs.io/en/latest/source/user/testing/unit_test.html) for complete documentation on OpenFAST unit test usage. \ No newline at end of file diff --git a/unit_tests/aerodyn/CMakeLists.txt b/unit_tests/aerodyn/CMakeLists.txt deleted file mode 100644 index 3704d84d3f..0000000000 --- a/unit_tests/aerodyn/CMakeLists.txt +++ /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. -# - -set_source_files_properties(${pfunit_directory}/include/driver.F90 PROPERTIES GENERATED 1) - -set(module_name "fvw") -set(module_directory "aerodyn") -set(module_library "aerodynlib") - -file(MAKE_DIRECTORY ${build_testdirectory}/${module_directory}) -file(WRITE ${build_testdirectory}/${module_directory}/testSuites.inc "") - -include_directories(${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_lib - ${module_library} -) - -add_test( - ${module_name}_utest - ${PROJECT_BINARY_DIR}/${module_directory}/${module_name}_utest -) diff --git a/unit_tests/beamdyn/CMakeLists.txt b/unit_tests/beamdyn/CMakeLists.txt deleted file mode 100644 index 2d35a3d16d..0000000000 --- a/unit_tests/beamdyn/CMakeLists.txt +++ /dev/null @@ -1,76 +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(${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_lib - ${module_library} -) - -add_test( - ${module_name}_utest - ${PROJECT_BINARY_DIR}/${module_directory}/${module_name}_utest -) diff --git a/unit_tests/inflowwind/CMakeLists.txt b/unit_tests/inflowwind/CMakeLists.txt deleted file mode 100644 index 2797e1addc..0000000000 --- a/unit_tests/inflowwind/CMakeLists.txt +++ /dev/null @@ -1,63 +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(${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_lib - ${module_library} -) - -add_test( - ${module_name}_utest - ${PROJECT_BINARY_DIR}/${module_directory}/${module_name}_utest -) diff --git a/unit_tests/nwtc-library/CMakeLists.txt b/unit_tests/nwtc-library/CMakeLists.txt deleted file mode 100644 index 9f59837155..0000000000 --- a/unit_tests/nwtc-library/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. -# - -# 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(${build_testdirectory}/${module_directory}) - -set(testlist - NWTC_Library_test_tools - 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_lib - ${module_library} -) - -add_test( - ${module_name}_utest - ${PROJECT_BINARY_DIR}/${module_directory}/${module_name}_utest -) - diff --git a/unit_tests/pfunit b/unit_tests/pfunit deleted file mode 160000 index a192e82246..0000000000 --- a/unit_tests/pfunit +++ /dev/null @@ -1 +0,0 @@ -Subproject commit a192e82246b44e701446811a9792a530e4f250c7 diff --git a/unit_tests/test-drive/LICENSE-Apache b/unit_tests/test-drive/LICENSE-Apache new file mode 100644 index 0000000000..d645695673 --- /dev/null +++ b/unit_tests/test-drive/LICENSE-Apache @@ -0,0 +1,202 @@ + + 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/unit_tests/test-drive/LICENSE-MIT b/unit_tests/test-drive/LICENSE-MIT new file mode 100644 index 0000000000..058480f520 --- /dev/null +++ b/unit_tests/test-drive/LICENSE-MIT @@ -0,0 +1,21 @@ +MIT License + +Copyright (c) 2020-2021 Sebastian Ehlert + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all +copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +SOFTWARE. diff --git a/unit_tests/test-drive/README.md b/unit_tests/test-drive/README.md new file mode 100644 index 0000000000..dfe0f7e227 --- /dev/null +++ b/unit_tests/test-drive/README.md @@ -0,0 +1,511 @@ +# The simple testing framework + +[![License](https://img.shields.io/badge/license-MIT%7CApache%202.0-blue)](LICENSE-Apache) +[![Latest Version](https://img.shields.io/github/v/release/fortran-lang/test-drive)](https://github.com/fortran-lang/test-drive/releases/latest) +[![CI](https://github.com/fortran-lang/test-drive/workflows/CI/badge.svg)](https://github.com/fortran-lang/test-drive/actions) +[![codecov](https://codecov.io/gh/fortran-lang/test-drive/branch/main/graph/badge.svg)](https://codecov.io/gh/fortran-lang/test-drive) + +This project offers a lightweight, procedural unit testing framework based on nothing but standard Fortran. +Integration with [meson](https://mesonbuild.com), [cmake](https://cmake.org) and [Fortran package manager (fpm)](https://github.com/fortran-lang/fpm) is available. +Alternatively, the [``testdrive.F90``](src/testdrive.F90) source file can be redistributed in the project's testsuite as well. + + +## Usage + +Testsuites are defined by a ``collect_interface`` returning a set of ``unittest_type`` objects. +To create a new test use the ``new_unittest`` constructor, which requires a test identifier and a procedure with a ``test_interface`` compatible signature. +The error status is communicated by the allocation status of an ``error_type``. + +The necessary boilerplate code to setup the test entry point is just + +```fortran +program tester + use, intrinsic :: iso_fortran_env, only : error_unit + use testdrive, only : run_testsuite, new_testsuite, testsuite_type + use test_suite1, only : collect_suite1 + use test_suite2, only : collect_suite2 + implicit none + integer :: stat, is + type(testsuite_type), allocatable :: testsuites(:) + character(len=*), parameter :: fmt = '("#", *(1x, a))' + + stat = 0 + + testsuites = [ & + new_testsuite("suite1", collect_suite1), & + new_testsuite("suite2", collect_suite2) & + ] + + do is = 1, size(testsuites) + write(error_unit, fmt) "Testing:", testsuites(is)%name + call run_testsuite(testsuites(is)%collect, error_unit, stat) + end do + + if (stat > 0) then + write(error_unit, '(i0, 1x, a)') stat, "test(s) failed!" + error stop + end if + +end program tester +``` + +Every test is defined in a separate module using a ``collect`` function, which is exported and added to the ``testsuites`` array in the test runner. +All tests have a simple interface with just an allocatable ``error_type`` as output to provide the test results. + +```fortran +module test_suite1 + use testdrive, only : new_unittest, unittest_type, error_type, check + implicit none + private + + public :: collect_suite1 + +contains + +!> Collect all exported unit tests +subroutine collect_suite1(testsuite) + !> Collection of tests + type(unittest_type), allocatable, intent(out) :: testsuite(:) + + testsuite = [ & + new_unittest("valid", test_valid), & + new_unittest("invalid", test_invalid, should_fail=.true.) & + ] + +end subroutine collect_suite1 + +subroutine test_valid(error) + type(error_type), allocatable, intent(out) :: error + ! ... +end subroutine test_valid + +subroutine test_invalid(error) + type(error_type), allocatable, intent(out) :: error + ! ... +end subroutine test_invalid + +end module test_suite1 +``` + + +### Checking test conditions + +The procedures defining the tests can contain any Fortran code required for checking the correctness of the project. +An easy way to do so is provided by the generic ``check`` function. + +```f90 +subroutine test_valid(error) + type(error_type), allocatable, intent(out) :: error + + call check(error, 1 + 2 == 3) + if (allocated(error)) return + + ! equivalent to the above + call check(error, 1 + 2, 3) + if (allocated(error)) return +end subroutine test_valid +``` + +After each check, the status of the error should be checked. +Uncaught errors will not be silently dropped, instead the error will be caught, its message displayed and the run aborted. +Possible ways to use check are listed below + +| available checks | arguments | +| -------------------- | -------------------------------------------------------------- | +| logical check | *error*, *logical*, ... | +| status check | *error*, *integer*, ... | +| logical comparison | *error*, *logical*, *logical*, ... | +| integer comparison | *error*, *integer*, ... | +| character comparison | *error*, *character*, *character*, ... | +| real comparison | *error*, *real*, *real*, ..., thr=*real*, rel=*logical* | +| real NaN check | *error*, *real*, ... | +| complex comparison | *error*, *complex*, *complex*, ..., thr=*real*, rel=*logical* | +| complex NaN check | *error*, *complex*, ... | + +Each check will generate a meaningful error message based on the available arguments, but can also be provided with a custom error message instead. + +To generate custom checks the ``test_failed`` procedure is available to generate error messages + +```f90 +subroutine test_custom(error) + type(error_type), allocatable, intent(out) :: error + + ! ... + + if (.not.cond) then + call test_failed(error, "Custom check failed") + return + end if + + ! ... + + if (.not.cond) then + call test_failed(error, "Custom check failed", "Additional context") + return + end if + +end subroutine test_custom +``` + +To conditionally skip a test use the ``skip_test`` procedure. +It uses the same signature as ``test_failed``, but will mark the respective test as skipped, this is useful to disable tests based on conditional compilation, *e.g.* by using a preprocessor or a different submodule. +An uncaught skipped test will fail regardless, therefore make sure to not run any other checks afterwards. + + +### Integration in build systems + +Finally, for usage with *fpm* it is beneficial to have a single test driver which can run all tests. +While this brings the disadvantage of always having to run the complete testsuite, the main driver can provide the flexibility to select the suite and also the unit test using the boilerplate code shown here: + +```f90 +!> Driver for unit testing +program tester + use, intrinsic :: iso_fortran_env, only : error_unit + use testdrive, only : run_testsuite, new_testsuite, testsuite_type, & + & select_suite, run_selected, get_argument + use test_suite1, only : collect_suite1 + use test_suite2, only : collect_suite2 + implicit none + integer :: stat, is + character(len=:), allocatable :: suite_name, test_name + type(testsuite_type), allocatable :: testsuites(:) + character(len=*), parameter :: fmt = '("#", *(1x, a))' + + stat = 0 + + testsuites = [ & + new_testsuite("suite1", collect_suite1), & + new_testsuite("suite2", collect_suite2) & + ] + + call get_argument(1, suite_name) + call get_argument(2, test_name) + + if (allocated(suite_name)) then + is = select_suite(testsuites, suite_name) + if (is > 0 .and. is <= size(testsuites)) then + if (allocated(test_name)) then + write(error_unit, fmt) "Suite:", testsuites(is)%name + call run_selected(testsuites(is)%collect, test_name, error_unit, stat) + if (stat < 0) then + error stop 1 + end if + else + write(error_unit, fmt) "Testing:", testsuites(is)%name + call run_testsuite(testsuites(is)%collect, error_unit, stat) + end if + else + write(error_unit, fmt) "Available testsuites" + do is = 1, size(testsuites) + write(error_unit, fmt) "-", testsuites(is)%name + end do + error stop 1 + end if + else + do is = 1, size(testsuites) + write(error_unit, fmt) "Testing:", testsuites(is)%name + call run_testsuite(testsuites(is)%collect, error_unit, stat) + end do + end if + + if (stat > 0) then + write(error_unit, '(i0, 1x, a)') stat, "test(s) failed!" + error stop 1 + end if + +end program tester +``` + +From *fpm* this allows to run all tests using just the *fpm test* command, but also to debug an individual test in a debugger. +For example to run *broken-test* in *large-suite* with ``gdb`` use + +``` +fpm test --runner gdb -- large-suite broken-test +``` + +To make this approach feasible for meson the tests can be created as individual suites. +A usual layout of the test directory like + +``` +test +├── main.f90 +├── meson.build +├── test_suite1.f90 +├── test_suite2.f90 +└── ... +``` + +Can use the following snippet to automatically create individual tests running complete suites inside the driver. +Resolution to the unit tests is possible but usually not desired, because the individual runtime of the tests will be short compared to the overhead to start the actual test. + +```meson +testdrive_dep = dependency('test-drive', fallback: ['test-drive', 'testdrive_dep']) + +tests = [ + 'suite1', + 'suite2', + # ... +] + +test_srcs = files( + 'main.f90', +) +foreach t : tests + test_srcs += files('test_@0@.f90'.format(t.underscorify())) +endforeach + +tester = executable( + 'tester', + sources: test_srcs, + dependencies: [proj_dep, testdrive_dep], +) + +test('all tests', tester) + +foreach t : tests + test(t, tester, args: t) +endforeach +``` + +Similar for a CMake based build the tests can be generated automatically for the layout shown below. + +``` +test +├── CMakeLists.txt +├── main.f90 +├── test_suite1.f90 +├── test_suite2.f90 +└── ... +``` + +The CMake file in the test directory should look similar to the one shown here + +```cmake +if(NOT TARGET "test-drive::test-drive") + find_package("test-drive" REQUIRED) +endif() + +# Unit testing +set( + tests + "suite1" + "suite2" +) +set( + test-srcs + "main.f90" +) +foreach(t IN LISTS tests) + string(MAKE_C_IDENTIFIER ${t} t) + list(APPEND test-srcs "test_${t}.f90") +endforeach() + +add_executable( + "${PROJECT_NAME}-tester" + "${test-srcs}" +) +target_link_libraries( + "${PROJECT_NAME}-tester" + PRIVATE + "${PROJECT_NAME}-lib" + "test-drive::test-drive" +) + +foreach(t IN LISTS tests) + add_test("${PROJECT_NAME}/${t}" "${PROJECT_NAME}-tester" "${t}") +endforeach() +``` + +
+CMake module to find testing framework + +The following module allows to find or fetch an installation of this project in CMake + +```cmake +#[[.rst: +Find test-drive +--------------- + +Makes the test-drive project available. + +Imported Targets +^^^^^^^^^^^^^^^^ + +This module provides the following imported target, if found: + +``test-drive::test-drive`` + The test-drive library + + +Result Variables +^^^^^^^^^^^^^^^^ + +This module will define the following variables: + +``TEST_DRIVE_FOUND`` + True if the test-drive library is available + +``TEST_DRIVE_SOURCE_DIR`` + Path to the source directory of the test-drive project, + only set if the project is included as source. + +``TEST_DRIVE_BINARY_DIR`` + Path to the binary directory of the test-drive project, + only set if the project is included as source. + +Cache variables +^^^^^^^^^^^^^^^ + +The following cache variables may be set to influence the library detection: + +``TEST_DRIVE_FIND_METHOD`` + Methods to find or make the project available. Available methods are + - ``cmake``: Try to find via CMake config file + - ``pkgconf``: Try to find via pkg-config file + - ``subproject``: Use source in subprojects directory + - ``fetch``: Fetch the source from upstream + +``TEST_DRIVE_DIR`` + Used for searching the CMake config file + +``TEST_DRIVE_SUBPROJECT`` + Directory to find the test-drive subproject, relative to the project root + +#]] + +set(_lib "test-drive") +set(_pkg "TEST_DRIVE") +set(_url "https://github.com/fortran-lang/test-drive") + +if(NOT DEFINED "${_pkg}_FIND_METHOD") + if(DEFINED "${PROJECT_NAME}-dependency-method") + set("${_pkg}_FIND_METHOD" "${${PROJECT_NAME}-dependency-method}") + else() + set("${_pkg}_FIND_METHOD" "cmake" "pkgconf" "subproject" "fetch") + endif() + set("_${_pkg}_FIND_METHOD") +endif() + +foreach(method ${${_pkg}_FIND_METHOD}) + if(TARGET "${_lib}::${_lib}") + break() + endif() + + if("${method}" STREQUAL "cmake") + message(STATUS "${_lib}: Find installed package") + if(DEFINED "${_pkg}_DIR") + set("_${_pkg}_DIR") + set("${_lib}_DIR" "${_pkg}_DIR") + endif() + find_package("${_lib}" CONFIG) + if("${_lib}_FOUND") + message(STATUS "${_lib}: Found installed package") + break() + endif() + endif() + + if("${method}" STREQUAL "pkgconf") + find_package(PkgConfig QUIET) + pkg_check_modules("${_pkg}" QUIET "${_lib}") + if("${_pkg}_FOUND") + message(STATUS "Found ${_lib} via pkg-config") + + add_library("${_lib}::${_lib}" INTERFACE IMPORTED) + target_link_libraries( + "${_lib}::${_lib}" + INTERFACE + "${${_pkg}_LINK_LIBRARIES}" + ) + target_include_directories( + "${_lib}::${_lib}" + INTERFACE + "${${_pkg}_INCLUDE_DIRS}" + ) + + break() + endif() + endif() + + if("${method}" STREQUAL "subproject") + if(NOT DEFINED "${_pkg}_SUBPROJECT") + set("_${_pkg}_SUBPROJECT") + set("${_pkg}_SUBPROJECT" "subprojects/${_lib}") + endif() + set("${_pkg}_SOURCE_DIR" "${PROJECT_SOURCE_DIR}/${${_pkg}_SUBPROJECT}") + set("${_pkg}_BINARY_DIR" "${PROJECT_BINARY_DIR}/${${_pkg}_SUBPROJECT}") + if(EXISTS "${${_pkg}_SOURCE_DIR}/CMakeLists.txt") + message(STATUS "Include ${_lib} from ${${_pkg}_SUBPROJECT}") + add_subdirectory( + "${${_pkg}_SOURCE_DIR}" + "${${_pkg}_BINARY_DIR}" + ) + + add_library("${_lib}::${_lib}" INTERFACE IMPORTED) + target_link_libraries("${_lib}::${_lib}" INTERFACE "${_lib}") + + # We need the module directory in the subproject before we finish the configure stage + if(NOT EXISTS "${${_pkg}_BINARY_DIR}/include") + make_directory("${${_pkg}_BINARY_DIR}/include") + endif() + + break() + endif() + endif() + + if("${method}" STREQUAL "fetch") + message(STATUS "Retrieving ${_lib} from ${_url}") + include(FetchContent) + FetchContent_Declare( + "${_lib}" + GIT_REPOSITORY "${_url}" + GIT_TAG "HEAD" + ) + FetchContent_MakeAvailable("${_lib}") + + add_library("${_lib}::${_lib}" INTERFACE IMPORTED) + target_link_libraries("${_lib}::${_lib}" INTERFACE "${_lib}") + + # We need the module directory in the subproject before we finish the configure stage + FetchContent_GetProperties("${_lib}" SOURCE_DIR "${_pkg}_SOURCE_DIR") + FetchContent_GetProperties("${_lib}" BINARY_DIR "${_pkg}_BINARY_DIR") + if(NOT EXISTS "${${_pkg}_BINARY_DIR}/include") + make_directory("${${_pkg}_BINARY_DIR}/include") + endif() + + break() + endif() + +endforeach() + +if(TARGET "${_lib}::${_lib}") + set("${_pkg}_FOUND" TRUE) +else() + set("${_pkg}_FOUND" FALSE) +endif() + +if(DEFINED "_${_pkg}_SUBPROJECT") + unset("${_pkg}_SUBPROJECT") + unset("_${_pkg}_SUBPROJECT") +endif() +if(DEFINED "_${_pkg}_DIR") + unset("${_lib}_DIR") + unset("_${_pkg}_DIR") +endif() +if(DEFINED "_${_pkg}_FIND_METHOD") + unset("${_pkg}_FIND_METHOD") + unset("_${_pkg}_FIND_METHOD") +endif() +unset(_lib) +unset(_pkg) +unset(_url) +``` +
+ + +## License + +This project is free software: you can redistribute it and/or modify it under the terms of the [Apache License, Version 2.0](LICENSE-Apache) or [MIT license](LICENSE-MIT) at your opinion. + +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. + +Unless you explicitly state otherwise, any contribution intentionally submitted for inclusion in this project by you, as defined in the Apache-2.0 license, shall be dual licensed as above, without any additional terms or conditions. diff --git a/unit_tests/test-drive/testdrive.F90 b/unit_tests/test-drive/testdrive.F90 new file mode 100644 index 0000000000..0cd6b83dfb --- /dev/null +++ b/unit_tests/test-drive/testdrive.F90 @@ -0,0 +1,1988 @@ +! This file is part of test-drive. +! SPDX-Identifier: Apache-2.0 OR MIT +! +! Licensed under either of Apache License, Version 2.0 or MIT license +! at your option; you may not use this file except in compliance with +! the License. +! +! 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. + +!# Enable support for quadruple precision +#ifndef WITH_QP +#define WITH_QP 0 +#endif + +!# Enable support for extended double precision +#ifndef WITH_XDP +#define WITH_XDP 0 +#endif + +!> Provides a light-weight procedural testing framework for Fortran projects. +!> +!> Testsuites are defined by a [[collect_interface]] returning a set of +!> [[unittest_type]] objects. To create a new test use the [[new_unittest]] +!> constructor, which requires a test identifier and a procedure with a +!> [[test_interface]] compatible signature. The error status is communicated +!> by the allocation status of an [[error_type]]. +!> +!> The necessary boilerplate code to setup the test entry point is just +!> +!>```fortran +!>program tester +!> use, intrinsic :: iso_fortran_env, only : error_unit +!> use testdrive, only : run_testsuite, new_testsuite, testsuite_type +!> use test_suite1, only : collect_suite1 +!> use test_suite2, only : collect_suite2 +!> implicit none +!> integer :: stat, is +!> type(testsuite_type), allocatable :: testsuites(:) +!> character(len=*), parameter :: fmt = '("#", *(1x, a))' +!> +!> stat = 0 +!> +!> testsuites = [ & +!> new_testsuite("suite1", collect_suite1), & +!> new_testsuite("suite2", collect_suite2) & +!> ] +!> +!> do is = 1, size(testsuites) +!> write(error_unit, fmt) "Testing:", testsuites(is)%name +!> call run_testsuite(testsuites(is)%collect, error_unit, stat) +!> end do +!> +!> if (stat > 0) then +!> write(error_unit, '(i0, 1x, a)') stat, "test(s) failed!" +!> error stop +!> end if +!> +!>end program tester +!>``` +!> +!> Every test is defined in a separate module using a ``collect`` function, which +!> is exported and added to the ``testsuites`` array in the test runner. +!> All test have a simple interface with just an allocatable [[error_type]] as +!> output to provide the test results. +!> +!>```fortran +!>module test_suite1 +!> use testdrive, only : new_unittest, unittest_type, error_type, check +!> implicit none +!> private +!> +!> public :: collect_suite1 +!> +!>contains +!> +!>!> Collect all exported unit tests +!>subroutine collect_suite1(testsuite) +!> !> Collection of tests +!> type(unittest_type), allocatable, intent(out) :: testsuite(:) +!> +!> testsuite = [ & +!> new_unittest("valid", test_valid), & +!> new_unittest("invalid", test_invalid, should_fail=.true.) & +!> ] +!> +!>end subroutine collect_suite1 +!> +!>subroutine test_valid(error) +!> type(error_type), allocatable, intent(out) :: error +!> ! ... +!>end subroutine test_valid +!> +!>subroutine test_invalid(error) +!> type(error_type), allocatable, intent(out) :: error +!> ! ... +!>end subroutine test_invalid +!> +!>end module test_suite1 +!>``` +!> +!> For an example setup checkout the ``test/`` directory in this project. +module testdrive + use, intrinsic :: iso_fortran_env, only : error_unit + implicit none + private + + public :: run_testsuite, run_selected, new_unittest, new_testsuite + public :: select_test, select_suite + public :: unittest_type, testsuite_type, error_type + public :: check, test_failed, skip_test + public :: test_interface, collect_interface + public :: get_argument, get_variable, to_string + + + !> Single precision real numbers + integer, parameter :: sp = selected_real_kind(6) + + !> Double precision real numbers + integer, parameter :: dp = selected_real_kind(15) + +#if WITH_XDP + !> Extended double precision real numbers + integer, parameter :: xdp = selected_real_kind(18) +#endif + +#if WITH_QP + !> Quadruple precision real numbers + integer, parameter :: qp = selected_real_kind(33) +#endif + + !> Char length for integers + integer, parameter :: i1 = selected_int_kind(2) + + !> Short length for integers + integer, parameter :: i2 = selected_int_kind(4) + + !> Length of default integers + integer, parameter :: i4 = selected_int_kind(9) + + !> Long length for integers + integer, parameter :: i8 = selected_int_kind(18) + + !> Error code for success + integer, parameter :: success = 0 + + !> Error code for failure + integer, parameter :: fatal = 1 + + !> Error code for skipped test + integer, parameter :: skipped = 77 + + + !> Error message + type :: error_type + + !> Error code + integer :: stat = success + + !> Payload of the error + character(len=:), allocatable :: message + + contains + + !> Escalate uncaught errors + final :: escalate_error + + end type error_type + + + interface check + module procedure :: check_stat + module procedure :: check_logical + module procedure :: check_float_sp + module procedure :: check_float_dp +#if WITH_XDP + module procedure :: check_float_xdp +#endif +#if WITH_QP + module procedure :: check_float_qp +#endif + module procedure :: check_float_exceptional_sp + module procedure :: check_float_exceptional_dp +#if WITH_XDP + module procedure :: check_float_exceptional_xdp +#endif +#if WITH_QP + module procedure :: check_float_exceptional_qp +#endif + module procedure :: check_complex_sp + module procedure :: check_complex_dp +#if WITH_XDP + module procedure :: check_complex_xdp +#endif +#if WITH_QP + module procedure :: check_complex_qp +#endif + module procedure :: check_complex_exceptional_sp + module procedure :: check_complex_exceptional_dp +#if WITH_XDP + module procedure :: check_complex_exceptional_xdp +#endif +#if WITH_QP + module procedure :: check_complex_exceptional_qp +#endif + module procedure :: check_int_i1 + module procedure :: check_int_i2 + module procedure :: check_int_i4 + module procedure :: check_int_i8 + module procedure :: check_bool + module procedure :: check_string + end interface check + + + interface to_string + module procedure :: integer_i1_to_string + module procedure :: integer_i2_to_string + module procedure :: integer_i4_to_string + module procedure :: integer_i8_to_string + module procedure :: real_sp_to_string + module procedure :: real_dp_to_string +#if WITH_XDP + module procedure :: real_xdp_to_string +#endif +#if WITH_QP + module procedure :: real_qp_to_string +#endif + module procedure :: complex_sp_to_string + module procedure :: complex_dp_to_string +#if WITH_XDP + module procedure :: complex_xdp_to_string +#endif +#if WITH_QP + module procedure :: complex_qp_to_string +#endif + end interface to_string + + + !> Implementation of check for not a number value, in case a compiler does not + !> provide the IEEE intrinsic ``ieee_is_nan`` (currently this is Intel oneAPI on MacOS) + interface is_nan + module procedure :: is_nan_sp + module procedure :: is_nan_dp +#if WITH_XDP + module procedure :: is_nan_xdp +#endif +#if WITH_QP + module procedure :: is_nan_qp +#endif + end interface is_nan + + + abstract interface + !> Entry point for tests + subroutine test_interface(error) + import :: error_type + + !> Error handling + type(error_type), allocatable, intent(out) :: error + + end subroutine test_interface + end interface + + + !> Declaration of a unit test + type :: unittest_type + + !> Name of the test + character(len=:), allocatable :: name + + !> Entry point of the test + procedure(test_interface), pointer, nopass :: test => null() + + !> Whether test is supposed to fail + logical :: should_fail = .false. + + end type unittest_type + + + abstract interface + !> Collect all tests + subroutine collect_interface(testsuite) + import :: unittest_type + + !> Collection of tests + type(unittest_type), allocatable, intent(out) :: testsuite(:) + + end subroutine collect_interface + end interface + + + !> Collection of unit tests + type :: testsuite_type + + !> Name of the testsuite + character(len=:), allocatable :: name + + !> Entry point of the test + procedure(collect_interface), pointer, nopass :: collect => null() + + end type testsuite_type + + + character(len=*), parameter :: fmt = '(1x, *(1x, a))' + + +contains + + + !> Driver for testsuite + recursive subroutine run_testsuite(collect, unit, stat, parallel) + + !> Collect tests + procedure(collect_interface) :: collect + + !> Unit for IO + integer, intent(in) :: unit + + !> Number of failed tests + integer, intent(inout) :: stat + + !> Run the tests in parallel + logical, intent(in), optional :: parallel + + type(unittest_type), allocatable :: testsuite(:) + integer :: it + logical :: parallel_ + + parallel_ = .true. + if(present(parallel)) parallel_ = parallel + + call collect(testsuite) + + !$omp parallel do schedule(dynamic) shared(testsuite, unit) reduction(+:stat) & + !$omp if (parallel_) + do it = 1, size(testsuite) + !$omp critical(testdrive_testsuite) + write(unit, '(1x, 3(1x, a), 1x, "(", i0, "/", i0, ")")') & + & "Starting", testsuite(it)%name, "...", it, size(testsuite) + !$omp end critical(testdrive_testsuite) + call run_unittest(testsuite(it), unit, stat) + end do + + end subroutine run_testsuite + + + !> Driver for selective testing + recursive subroutine run_selected(collect, name, unit, stat) + + !> Collect tests + procedure(collect_interface) :: collect + + !> Name of the selected test + character(len=*), intent(in) :: name + + !> Unit for IO + integer, intent(in) :: unit + + !> Number of failed tests + integer, intent(inout) :: stat + + type(unittest_type), allocatable :: testsuite(:) + integer :: it + + call collect(testsuite) + + it = select_test(testsuite, name) + + if (it > 0 .and. it <= size(testsuite)) then + call run_unittest(testsuite(it), unit, stat) + else + write(unit, fmt) "Available tests:" + do it = 1, size(testsuite) + write(unit, fmt) "-", testsuite(it)%name + end do + stat = -huge(it) + end if + + end subroutine run_selected + + + !> Run a selected unit test + recursive subroutine run_unittest(test, unit, stat) + + !> Unit test + type(unittest_type), intent(in) :: test + + !> Unit for IO + integer, intent(in) :: unit + + !> Number of failed tests + integer, intent(inout) :: stat + + type(error_type), allocatable :: error + character(len=:), allocatable :: message + + call test%test(error) + if (.not.test_skipped(error)) then + if (allocated(error) .neqv. test%should_fail) stat = stat + 1 + end if + call make_output(message, test, error) + !$omp critical(testdrive_testsuite) + write(unit, '(a)') message + !$omp end critical(testdrive_testsuite) + if (allocated(error)) then + call clear_error(error) + end if + + end subroutine run_unittest + + + pure function test_skipped(error) result(is_skipped) + + !> Error handling + type(error_type), intent(in), optional :: error + + !> Test was skipped + logical :: is_skipped + + is_skipped = .false. + if (present(error)) then + is_skipped = error%stat == skipped + end if + + end function test_skipped + + + !> Create output message for test (this procedure is pure and therefore cannot launch tests) + pure subroutine make_output(output, test, error) + + !> Output message for display + character(len=:), allocatable, intent(out) :: output + + !> Unit test + type(unittest_type), intent(in) :: test + + !> Error handling + type(error_type), intent(in), optional :: error + + character(len=:), allocatable :: label + character(len=*), parameter :: indent = repeat(" ", 7) // repeat(".", 3) // " " + + if (test_skipped(error)) then + output = indent // test%name // " [SKIPPED]" & + & // new_line("a") // " Message: " // error%message + return + end if + + if (present(error) .neqv. test%should_fail) then + if (test%should_fail) then + label = " [UNEXPECTED PASS]" + else + label = " [FAILED]" + end if + else + if (test%should_fail) then + label = " [EXPECTED FAIL]" + else + label = " [PASSED]" + end if + end if + output = indent // test%name // label + if (present(error)) then + output = output // new_line("a") // " Message: " // error%message + end if + end subroutine make_output + + + !> Select a unit test from all available tests + function select_test(tests, name) result(pos) + + !> Name identifying the test suite + character(len=*), intent(in) :: name + + !> Available unit tests + type(unittest_type) :: tests(:) + + !> Selected test suite + integer :: pos + + integer :: it + + pos = 0 + do it = 1, size(tests) + if (name == tests(it)%name) then + pos = it + exit + end if + end do + + end function select_test + + + !> Select a test suite from all available suites + function select_suite(suites, name) result(pos) + + !> Name identifying the test suite + character(len=*), intent(in) :: name + + !> Available test suites + type(testsuite_type) :: suites(:) + + !> Selected test suite + integer :: pos + + integer :: it + + pos = 0 + do it = 1, size(suites) + if (name == suites(it)%name) then + pos = it + exit + end if + end do + + end function select_suite + + + !> Register a new unit test + function new_unittest(name, test, should_fail) result(self) + + !> Name of the test + character(len=*), intent(in) :: name + + !> Entry point for the test + procedure(test_interface) :: test + + !> Whether test is supposed to error or not + logical, intent(in), optional :: should_fail + + !> Newly registered test + type(unittest_type) :: self + + self%name = name + self%test => test + if (present(should_fail)) self%should_fail = should_fail + + end function new_unittest + + + !> Register a new testsuite + function new_testsuite(name, collect) result(self) + + !> Name of the testsuite + character(len=*), intent(in) :: name + + !> Entry point to collect tests + procedure(collect_interface) :: collect + + !> Newly registered testsuite + type(testsuite_type) :: self + + self%name = name + self%collect => collect + + end function new_testsuite + + + subroutine check_stat(error, stat, message, more) + + !> Error handling + type(error_type), allocatable, intent(out) :: error + + !> Status of operation + integer, intent(in) :: stat + + !> A detailed message describing the error + character(len=*), intent(in), optional :: message + + !> Another line of error message + character(len=*), intent(in), optional :: more + + if (stat /= success) then + if (present(message)) then + call test_failed(error, message, more) + else + call test_failed(error, "Non-zero exit code encountered", more) + end if + end if + + end subroutine check_stat + + + subroutine check_logical(error, expression, message, more) + + !> Error handling + type(error_type), allocatable, intent(out) :: error + + !> Result of logical operator + logical, intent(in) :: expression + + !> A detailed message describing the error + character(len=*), intent(in), optional :: message + + !> Another line of error message + character(len=*), intent(in), optional :: more + + if (.not.expression) then + if (present(message)) then + call test_failed(error, message, more) + else + call test_failed(error, "Condition not fullfilled", more) + end if + end if + + end subroutine check_logical + + + subroutine check_float_dp(error, actual, expected, message, more, thr, rel) + + !> Error handling + type(error_type), allocatable, intent(out) :: error + + !> Found floating point value + real(dp), intent(in) :: actual + + !> Expected floating point value + real(dp), intent(in) :: expected + + !> A detailed message describing the error + character(len=*), intent(in), optional :: message + + !> Another line of error message + character(len=*), intent(in), optional :: more + + !> Allowed threshold for matching floating point values + real(dp), intent(in), optional :: thr + + !> Check for relative errors instead + logical, intent(in), optional :: rel + + logical :: relative + real(dp) :: diff, threshold + + call check(error, actual, message, more) + if (allocated(error)) return + + if (present(thr)) then + threshold = thr + else + threshold = epsilon(expected) + end if + + if (present(rel)) then + relative = rel + else + relative = .false. + end if + + if (relative) then + diff = abs(actual - expected) / abs(expected) + else + diff = abs(actual - expected) + end if + + if (diff > threshold) then + if (present(message)) then + call test_failed(error, message, more) + else + if (relative) then + call test_failed(error, & + "Floating point value missmatch", & + "expected "//to_string(expected)//" but got "//to_string(actual)//" "//& + "(difference: "//to_string(int(diff*100))//"%)", & + more) + else + call test_failed(error, & + "Floating point value missmatch", & + "expected "//to_string(expected)//" but got "//to_string(actual)//" "//& + "(difference: "//to_string(diff)//")", & + more) + end if + end if + end if + + end subroutine check_float_dp + + + subroutine check_float_exceptional_dp(error, actual, message, more) + + !> Error handling + type(error_type), allocatable, intent(out) :: error + + !> Found floating point value + real(dp), intent(in) :: actual + + !> A detailed message describing the error + character(len=*), intent(in), optional :: message + + !> Another line of error message + character(len=*), intent(in), optional :: more + + if (is_nan(actual)) then + if (present(message)) then + call test_failed(error, message, more) + else + call test_failed(error, "Exceptional value 'not a number' found", more) + end if + end if + + end subroutine check_float_exceptional_dp + + + subroutine check_float_sp(error, actual, expected, message, more, thr, rel) + + !> Error handling + type(error_type), allocatable, intent(out) :: error + + !> Found floating point value + real(sp), intent(in) :: actual + + !> Expected floating point value + real(sp), intent(in) :: expected + + !> A detailed message describing the error + character(len=*), intent(in), optional :: message + + !> Another line of error message + character(len=*), intent(in), optional :: more + + !> Allowed threshold for matching floating point values + real(sp), intent(in), optional :: thr + + !> Check for relative errors instead + logical, intent(in), optional :: rel + + logical :: relative + real(sp) :: diff, threshold + + call check(error, actual, message, more) + if (allocated(error)) return + + if (present(thr)) then + threshold = thr + else + threshold = epsilon(expected) + end if + + if (present(rel)) then + relative = rel + else + relative = .false. + end if + + if (relative) then + diff = abs(actual - expected) / abs(expected) + else + diff = abs(actual - expected) + end if + + if (diff > threshold) then + if (present(message)) then + call test_failed(error, message, more) + else + if (relative) then + call test_failed(error, & + "Floating point value missmatch", & + "expected "//to_string(expected)//" but got "//to_string(actual)//" "//& + "(difference: "//to_string(int(diff*100))//"%)", & + more) + else + call test_failed(error, & + "Floating point value missmatch", & + "expected "//to_string(expected)//" but got "//to_string(actual)//" "//& + "(difference: "//to_string(diff)//")", & + more) + end if + end if + end if + + end subroutine check_float_sp + + + subroutine check_float_exceptional_sp(error, actual, message, more) + + !> Error handling + type(error_type), allocatable, intent(out) :: error + + !> Found floating point value + real(sp), intent(in) :: actual + + !> A detailed message describing the error + character(len=*), intent(in), optional :: message + + !> Another line of error message + character(len=*), intent(in), optional :: more + + if (is_nan(actual)) then + if (present(message)) then + call test_failed(error, message, more) + else + call test_failed(error, "Exceptional value 'not a number' found", more) + end if + end if + + end subroutine check_float_exceptional_sp + + +#if WITH_XDP + subroutine check_float_xdp(error, actual, expected, message, more, thr, rel) + + !> Error handling + type(error_type), allocatable, intent(out) :: error + + !> Found floating point value + real(xdp), intent(in) :: actual + + !> Expected floating point value + real(xdp), intent(in) :: expected + + !> A detailed message describing the error + character(len=*), intent(in), optional :: message + + !> Another line of error message + character(len=*), intent(in), optional :: more + + !> Allowed threshold for matching floating point values + real(xdp), intent(in), optional :: thr + + !> Check for relative errors instead + logical, intent(in), optional :: rel + + logical :: relative + real(xdp) :: diff, threshold + + call check(error, actual, message, more) + if (allocated(error)) return + + if (present(thr)) then + threshold = thr + else + threshold = epsilon(expected) + end if + + if (present(rel)) then + relative = rel + else + relative = .false. + end if + + if (relative) then + diff = abs(actual - expected) / abs(expected) + else + diff = abs(actual - expected) + end if + + if (diff > threshold) then + if (present(message)) then + call test_failed(error, message, more) + else + if (relative) then + call test_failed(error, & + "Floating point value missmatch", & + "expected "//to_string(expected)//" but got "//to_string(actual)//" "//& + "(difference: "//to_string(int(diff*100))//"%)", & + more) + else + call test_failed(error, & + "Floating point value missmatch", & + "expected "//to_string(expected)//" but got "//to_string(actual)//" "//& + "(difference: "//to_string(diff)//")", & + more) + end if + end if + end if + + end subroutine check_float_xdp + + + subroutine check_float_exceptional_xdp(error, actual, message, more) + + !> Error handling + type(error_type), allocatable, intent(out) :: error + + !> Found floating point value + real(xdp), intent(in) :: actual + + !> A detailed message describing the error + character(len=*), intent(in), optional :: message + + !> Another line of error message + character(len=*), intent(in), optional :: more + + if (is_nan(actual)) then + if (present(message)) then + call test_failed(error, message, more) + else + call test_failed(error, "Exceptional value 'not a number' found", more) + end if + end if + + end subroutine check_float_exceptional_xdp +#endif + + +#if WITH_QP + subroutine check_float_qp(error, actual, expected, message, more, thr, rel) + + !> Error handling + type(error_type), allocatable, intent(out) :: error + + !> Found floating point value + real(qp), intent(in) :: actual + + !> Expected floating point value + real(qp), intent(in) :: expected + + !> A detailed message describing the error + character(len=*), intent(in), optional :: message + + !> Another line of error message + character(len=*), intent(in), optional :: more + + !> Allowed threshold for matching floating point values + real(qp), intent(in), optional :: thr + + !> Check for relative errors instead + logical, intent(in), optional :: rel + + logical :: relative + real(qp) :: diff, threshold + + call check(error, actual, message, more) + if (allocated(error)) return + + if (present(thr)) then + threshold = thr + else + threshold = epsilon(expected) + end if + + if (present(rel)) then + relative = rel + else + relative = .false. + end if + + if (relative) then + diff = abs(actual - expected) / abs(expected) + else + diff = abs(actual - expected) + end if + + if (diff > threshold) then + if (present(message)) then + call test_failed(error, message, more) + else + if (relative) then + call test_failed(error, & + "Floating point value missmatch", & + "expected "//to_string(expected)//" but got "//to_string(actual)//" "//& + "(difference: "//to_string(int(diff*100))//"%)", & + more) + else + call test_failed(error, & + "Floating point value missmatch", & + "expected "//to_string(expected)//" but got "//to_string(actual)//" "//& + "(difference: "//to_string(diff)//")", & + more) + end if + end if + end if + + end subroutine check_float_qp + + + subroutine check_float_exceptional_qp(error, actual, message, more) + + !> Error handling + type(error_type), allocatable, intent(out) :: error + + !> Found floating point value + real(qp), intent(in) :: actual + + !> A detailed message describing the error + character(len=*), intent(in), optional :: message + + !> Another line of error message + character(len=*), intent(in), optional :: more + + if (is_nan(actual)) then + if (present(message)) then + call test_failed(error, message, more) + else + call test_failed(error, "Exceptional value 'not a number' found", more) + end if + end if + + end subroutine check_float_exceptional_qp +#endif + + + subroutine check_complex_dp(error, actual, expected, message, more, thr, rel) + + !> Error handling + type(error_type), allocatable, intent(out) :: error + + !> Found floating point value + complex(dp), intent(in) :: actual + + !> Expected floating point value + complex(dp), intent(in) :: expected + + !> A detailed message describing the error + character(len=*), intent(in), optional :: message + + !> Another line of error message + character(len=*), intent(in), optional :: more + + !> Allowed threshold for matching floating point values + real(dp), intent(in), optional :: thr + + !> Check for relative errors instead + logical, intent(in), optional :: rel + + logical :: relative + real(dp) :: diff, threshold + + call check(error, actual, message, more) + if (allocated(error)) return + + if (present(thr)) then + threshold = thr + else + threshold = epsilon(abs(expected)) + end if + + if (present(rel)) then + relative = rel + else + relative = .false. + end if + + if (relative) then + diff = abs(actual - expected) / abs(expected) + else + diff = abs(actual - expected) + end if + + if (diff > threshold) then + if (present(message)) then + call test_failed(error, message, more) + else + if (relative) then + call test_failed(error, & + "Floating point value missmatch", & + "expected "//to_string(expected)//" but got "//to_string(actual)//" "//& + "(difference: "//to_string(int(diff*100))//"%)", & + more) + else + call test_failed(error, & + "Floating point value missmatch", & + "expected "//to_string(expected)//" but got "//to_string(actual)//" "//& + "(difference: "//to_string(diff)//")", & + more) + end if + end if + end if + + end subroutine check_complex_dp + + + subroutine check_complex_exceptional_dp(error, actual, message, more) + + !> Error handling + type(error_type), allocatable, intent(out) :: error + + !> Found floating point value + complex(dp), intent(in) :: actual + + !> A detailed message describing the error + character(len=*), intent(in), optional :: message + + !> Another line of error message + character(len=*), intent(in), optional :: more + + if (is_nan(real(actual)) .or. is_nan(aimag(actual))) then + if (present(message)) then + call test_failed(error, message, more) + else + call test_failed(error, "Exceptional value 'not a number' found", more) + end if + end if + + end subroutine check_complex_exceptional_dp + + + subroutine check_complex_sp(error, actual, expected, message, more, thr, rel) + + !> Error handling + type(error_type), allocatable, intent(out) :: error + + !> Found floating point value + complex(sp), intent(in) :: actual + + !> Expected floating point value + complex(sp), intent(in) :: expected + + !> A detailed message describing the error + character(len=*), intent(in), optional :: message + + !> Another line of error message + character(len=*), intent(in), optional :: more + + !> Allowed threshold for matching floating point values + real(sp), intent(in), optional :: thr + + !> Check for relative errors instead + logical, intent(in), optional :: rel + + logical :: relative + real(sp) :: diff, threshold + + call check(error, actual, message, more) + if (allocated(error)) return + + if (present(thr)) then + threshold = thr + else + threshold = epsilon(abs(expected)) + end if + + if (present(rel)) then + relative = rel + else + relative = .false. + end if + + if (relative) then + diff = abs(actual - expected) / abs(expected) + else + diff = abs(actual - expected) + end if + + if (diff > threshold) then + if (present(message)) then + call test_failed(error, message, more) + else + if (relative) then + call test_failed(error, & + "Floating point value missmatch", & + "expected "//to_string(expected)//" but got "//to_string(actual)//" "//& + "(difference: "//to_string(int(diff*100))//"%)", & + more) + else + call test_failed(error, & + "Floating point value missmatch", & + "expected "//to_string(expected)//" but got "//to_string(actual)//" "//& + "(difference: "//to_string(diff)//")", & + more) + end if + end if + end if + + end subroutine check_complex_sp + + + subroutine check_complex_exceptional_sp(error, actual, message, more) + + !> Error handling + type(error_type), allocatable, intent(out) :: error + + !> Found floating point value + complex(sp), intent(in) :: actual + + !> A detailed message describing the error + character(len=*), intent(in), optional :: message + + !> Another line of error message + character(len=*), intent(in), optional :: more + + if (is_nan(real(actual)) .or. is_nan(aimag(actual))) then + if (present(message)) then + call test_failed(error, message, more) + else + call test_failed(error, "Exceptional value 'not a number' found", more) + end if + end if + + end subroutine check_complex_exceptional_sp + + +#if WITH_XDP + subroutine check_complex_xdp(error, actual, expected, message, more, thr, rel) + + !> Error handling + type(error_type), allocatable, intent(out) :: error + + !> Found floating point value + complex(xdp), intent(in) :: actual + + !> Expected floating point value + complex(xdp), intent(in) :: expected + + !> A detailed message describing the error + character(len=*), intent(in), optional :: message + + !> Another line of error message + character(len=*), intent(in), optional :: more + + !> Allowed threshold for matching floating point values + real(xdp), intent(in), optional :: thr + + !> Check for relative errors instead + logical, intent(in), optional :: rel + + logical :: relative + real(xdp) :: diff, threshold + + call check(error, actual, message, more) + if (allocated(error)) return + + if (present(thr)) then + threshold = thr + else + threshold = epsilon(abs(expected)) + end if + + if (present(rel)) then + relative = rel + else + relative = .false. + end if + + if (relative) then + diff = abs(actual - expected) / abs(expected) + else + diff = abs(actual - expected) + end if + + if (diff > threshold) then + if (present(message)) then + call test_failed(error, message, more) + else + if (relative) then + call test_failed(error, & + "Floating point value missmatch", & + "expected "//to_string(expected)//" but got "//to_string(actual)//" "//& + "(difference: "//to_string(int(diff*100))//"%)", & + more) + else + call test_failed(error, & + "Floating point value missmatch", & + "expected "//to_string(expected)//" but got "//to_string(actual)//" "//& + "(difference: "//to_string(diff)//")", & + more) + end if + end if + end if + + end subroutine check_complex_xdp + + + subroutine check_complex_exceptional_xdp(error, actual, message, more) + + !> Error handling + type(error_type), allocatable, intent(out) :: error + + !> Found floating point value + complex(xdp), intent(in) :: actual + + !> A detailed message describing the error + character(len=*), intent(in), optional :: message + + !> Another line of error message + character(len=*), intent(in), optional :: more + + if (is_nan(real(actual)) .or. is_nan(aimag(actual))) then + if (present(message)) then + call test_failed(error, message, more) + else + call test_failed(error, "Exceptional value 'not a number' found", more) + end if + end if + + end subroutine check_complex_exceptional_xdp +#endif + + +#if WITH_QP + subroutine check_complex_qp(error, actual, expected, message, more, thr, rel) + + !> Error handling + type(error_type), allocatable, intent(out) :: error + + !> Found floating point value + complex(qp), intent(in) :: actual + + !> Expected floating point value + complex(qp), intent(in) :: expected + + !> A detailed message describing the error + character(len=*), intent(in), optional :: message + + !> Another line of error message + character(len=*), intent(in), optional :: more + + !> Allowed threshold for matching floating point values + real(qp), intent(in), optional :: thr + + !> Check for relative errors instead + logical, intent(in), optional :: rel + + logical :: relative + real(qp) :: diff, threshold + + call check(error, actual, message, more) + if (allocated(error)) return + + if (present(thr)) then + threshold = thr + else + threshold = epsilon(abs(expected)) + end if + + if (present(rel)) then + relative = rel + else + relative = .false. + end if + + if (relative) then + diff = abs(actual - expected) / abs(expected) + else + diff = abs(actual - expected) + end if + + if (diff > threshold) then + if (present(message)) then + call test_failed(error, message, more) + else + if (relative) then + call test_failed(error, & + "Floating point value missmatch", & + "expected "//to_string(expected)//" but got "//to_string(actual)//" "//& + "(difference: "//to_string(int(diff*100))//"%)", & + more) + else + call test_failed(error, & + "Floating point value missmatch", & + "expected "//to_string(expected)//" but got "//to_string(actual)//" "//& + "(difference: "//to_string(diff)//")", & + more) + end if + end if + end if + + end subroutine check_complex_qp + + + subroutine check_complex_exceptional_qp(error, actual, message, more) + + !> Error handling + type(error_type), allocatable, intent(out) :: error + + !> Found floating point value + complex(qp), intent(in) :: actual + + !> A detailed message describing the error + character(len=*), intent(in), optional :: message + + !> Another line of error message + character(len=*), intent(in), optional :: more + + if (is_nan(real(actual)) .or. is_nan(aimag(actual))) then + if (present(message)) then + call test_failed(error, message, more) + else + call test_failed(error, "Exceptional value 'not a number' found", more) + end if + end if + + end subroutine check_complex_exceptional_qp +#endif + + + subroutine check_int_i1(error, actual, expected, message, more) + + !> Error handling + type(error_type), allocatable, intent(out) :: error + + !> Found integer value + integer(i1), intent(in) :: actual + + !> Expected integer value + integer(i1), intent(in) :: expected + + !> A detailed message describing the error + character(len=*), intent(in), optional :: message + + !> Another line of error message + character(len=*), intent(in), optional :: more + + if (expected /= actual) then + if (present(message)) then + call test_failed(error, message, more) + else + call test_failed(error, & + "Integer value missmatch", & + "expected "//to_string(expected)//" but got "//to_string(actual), & + more) + end if + end if + + end subroutine check_int_i1 + + + subroutine check_int_i2(error, actual, expected, message, more) + + !> Error handling + type(error_type), allocatable, intent(out) :: error + + !> Found integer value + integer(i2), intent(in) :: actual + + !> Expected integer value + integer(i2), intent(in) :: expected + + !> A detailed message describing the error + character(len=*), intent(in), optional :: message + + !> Another line of error message + character(len=*), intent(in), optional :: more + + if (expected /= actual) then + if (present(message)) then + call test_failed(error, message, more) + else + call test_failed(error, & + "Integer value missmatch", & + "expected "//to_string(expected)//" but got "//to_string(actual), & + more) + end if + end if + + end subroutine check_int_i2 + + + subroutine check_int_i4(error, actual, expected, message, more) + + !> Error handling + type(error_type), allocatable, intent(out) :: error + + !> Found integer value + integer(i4), intent(in) :: actual + + !> Expected integer value + integer(i4), intent(in) :: expected + + !> A detailed message describing the error + character(len=*), intent(in), optional :: message + + !> Another line of error message + character(len=*), intent(in), optional :: more + + if (expected /= actual) then + if (present(message)) then + call test_failed(error, message, more) + else + call test_failed(error, & + "Integer value missmatch", & + "expected "//to_string(expected)//" but got "//to_string(actual), & + more) + end if + end if + + end subroutine check_int_i4 + + + subroutine check_int_i8(error, actual, expected, message, more) + + !> Error handling + type(error_type), allocatable, intent(out) :: error + + !> Found integer value + integer(i8), intent(in) :: actual + + !> Expected integer value + integer(i8), intent(in) :: expected + + !> A detailed message describing the error + character(len=*), intent(in), optional :: message + + !> Another line of error message + character(len=*), intent(in), optional :: more + + if (expected /= actual) then + if (present(message)) then + call test_failed(error, message, more) + else + call test_failed(error, & + "Integer value missmatch", & + "expected "//to_string(expected)//" but got "//to_string(actual), & + more) + end if + end if + + end subroutine check_int_i8 + + + subroutine check_bool(error, actual, expected, message, more) + + !> Error handling + type(error_type), allocatable, intent(out) :: error + + !> Found boolean value + logical, intent(in) :: actual + + !> Expected boolean value + logical, intent(in) :: expected + + !> A detailed message describing the error + character(len=*), intent(in), optional :: message + + !> Another line of error message + character(len=*), intent(in), optional :: more + + if (expected .neqv. actual) then + if (present(message)) then + call test_failed(error, message, more) + else + call test_failed(error, & + "Logical value missmatch", & + "expected "//merge("T", "F", expected)//" but got "//merge("T", "F", actual), & + more) + end if + end if + + end subroutine check_bool + + + subroutine check_string(error, actual, expected, message, more) + + !> Error handling + type(error_type), allocatable, intent(out) :: error + + !> Found boolean value + character(len=*), intent(in) :: actual + + !> Expected boolean value + character(len=*), intent(in) :: expected + + !> A detailed message describing the error + character(len=*), intent(in), optional :: message + + !> Another line of error message + character(len=*), intent(in), optional :: more + + if (expected /= actual) then + if (present(message)) then + call test_failed(error, message, more) + else + call test_failed(error, & + "Character value missmatch", & + "expected '"//expected//"' but got '"//actual//"'", & + more) + end if + end if + + end subroutine check_string + + + subroutine test_failed(error, message, more, and_more) + + !> Error handling + type(error_type), allocatable, intent(out) :: error + + !> A detailed message describing the error + character(len=*), intent(in) :: message + + !> Another line of error message + character(len=*), intent(in), optional :: more + + !> Another line of error message + character(len=*), intent(in), optional :: and_more + + character(len=*), parameter :: skip = new_line("a") // repeat(" ", 11) + + allocate(error) + error%stat = fatal + + error%message = message + if (present(more)) then + error%message = error%message // skip // more + end if + if (present(and_more)) then + error%message = error%message // skip // and_more + end if + + end subroutine test_failed + + + !> A test is skipped because certain requirements are not met to run the actual test + subroutine skip_test(error, message, more, and_more) + + !> Error handling + type(error_type), allocatable, intent(out) :: error + + !> A detailed message describing the error + character(len=*), intent(in) :: message + + !> Another line of error message + character(len=*), intent(in), optional :: more + + !> Another line of error message + character(len=*), intent(in), optional :: and_more + + call test_failed(error, message, more, and_more) + error%stat = skipped + + end subroutine skip_test + + + !> Obtain the command line argument at a given index + subroutine get_argument(idx, arg) + + !> Index of command line argument, range [0:command_argument_count()] + integer, intent(in) :: idx + + !> Command line argument + character(len=:), allocatable, intent(out) :: arg + + integer :: length, stat + + call get_command_argument(idx, length=length, status=stat) + if (stat /= success) return + + allocate(character(len=length) :: arg, stat=stat) + if (stat /= success) return + + if (length > 0) then + call get_command_argument(idx, arg, status=stat) + if (stat /= success) deallocate(arg) + end if + + end subroutine get_argument + + + !> Obtain the value of an environment variable + subroutine get_variable(var, val) + + !> Name of variable + character(len=*), intent(in) :: var + + !> Value of variable + character(len=:), allocatable, intent(out) :: val + + integer :: length, stat + + call get_environment_variable(var, length=length, status=stat) + if (stat /= success) return + + allocate(character(len=length) :: val, stat=stat) + if (stat /= success) return + + if (length > 0) then + call get_environment_variable(var, val, status=stat) + if (stat /= success) deallocate(val) + end if + + end subroutine get_variable + + + pure function integer_i1_to_string(val) result(string) + integer, parameter :: ik = i1 + !> Integer value to create string from + integer(ik), intent(in) :: val + !> String representation of integer + character(len=:), allocatable :: string + + integer, parameter :: buffer_len = range(val)+2 + character(len=buffer_len) :: buffer + integer :: pos + integer(ik) :: n + character(len=1), parameter :: numbers(-9:0) = & + ["9", "8", "7", "6", "5", "4", "3", "2", "1", "0"] + + if (val == 0_ik) then + string = numbers(0) + return + end if + + n = sign(val, -1_ik) + buffer = "" + pos = buffer_len + 1 + do while (n < 0_ik) + pos = pos - 1 + buffer(pos:pos) = numbers(mod(n, 10_ik)) + n = n/10_ik + end do + + if (val < 0_ik) then + pos = pos - 1 + buffer(pos:pos) = '-' + end if + + string = buffer(pos:) + end function integer_i1_to_string + + + pure function integer_i2_to_string(val) result(string) + integer, parameter :: ik = i2 + !> Integer value to create string from + integer(ik), intent(in) :: val + !> String representation of integer + character(len=:), allocatable :: string + + integer, parameter :: buffer_len = range(val)+2 + character(len=buffer_len) :: buffer + integer :: pos + integer(ik) :: n + character(len=1), parameter :: numbers(-9:0) = & + ["9", "8", "7", "6", "5", "4", "3", "2", "1", "0"] + + if (val == 0_ik) then + string = numbers(0) + return + end if + + n = sign(val, -1_ik) + buffer = "" + pos = buffer_len + 1 + do while (n < 0_ik) + pos = pos - 1 + buffer(pos:pos) = numbers(mod(n, 10_ik)) + n = n/10_ik + end do + + if (val < 0_ik) then + pos = pos - 1 + buffer(pos:pos) = '-' + end if + + string = buffer(pos:) + end function integer_i2_to_string + + + pure function integer_i4_to_string(val) result(string) + integer, parameter :: ik = i4 + !> Integer value to create string from + integer(ik), intent(in) :: val + !> String representation of integer + character(len=:), allocatable :: string + + integer, parameter :: buffer_len = range(val)+2 + character(len=buffer_len) :: buffer + integer :: pos + integer(ik) :: n + character(len=1), parameter :: numbers(-9:0) = & + ["9", "8", "7", "6", "5", "4", "3", "2", "1", "0"] + + if (val == 0_ik) then + string = numbers(0) + return + end if + + n = sign(val, -1_ik) + buffer = "" + pos = buffer_len + 1 + do while (n < 0_ik) + pos = pos - 1 + buffer(pos:pos) = numbers(mod(n, 10_ik)) + n = n/10_ik + end do + + if (val < 0_ik) then + pos = pos - 1 + buffer(pos:pos) = '-' + end if + + string = buffer(pos:) + end function integer_i4_to_string + + + pure function integer_i8_to_string(val) result(string) + integer, parameter :: ik = i8 + !> Integer value to create string from + integer(ik), intent(in) :: val + !> String representation of integer + character(len=:), allocatable :: string + + integer, parameter :: buffer_len = range(val)+2 + character(len=buffer_len) :: buffer + integer :: pos + integer(ik) :: n + character(len=1), parameter :: numbers(-9:0) = & + ["9", "8", "7", "6", "5", "4", "3", "2", "1", "0"] + + if (val == 0_ik) then + string = numbers(0) + return + end if + + n = sign(val, -1_ik) + buffer = "" + pos = buffer_len + 1 + do while (n < 0_ik) + pos = pos - 1 + buffer(pos:pos) = numbers(mod(n, 10_ik)) + n = n/10_ik + end do + + if (val < 0_ik) then + pos = pos - 1 + buffer(pos:pos) = '-' + end if + + string = buffer(pos:) + end function integer_i8_to_string + + + pure function real_sp_to_string(val) result(string) + real(sp), intent(in) :: val + character(len=:), allocatable :: string + integer, parameter :: buffer_len = 128 + character(len=buffer_len) :: buffer + + write(buffer, '(g0)') val + string = trim(buffer) + + end function real_sp_to_string + + + pure function real_dp_to_string(val) result(string) + real(dp), intent(in) :: val + character(len=:), allocatable :: string + integer, parameter :: buffer_len = 128 + character(len=buffer_len) :: buffer + + write(buffer, '(g0)') val + string = trim(buffer) + + end function real_dp_to_string + + +#if WITH_XDP + pure function real_xdp_to_string(val) result(string) + real(xdp), intent(in) :: val + character(len=:), allocatable :: string + integer, parameter :: buffer_len = 128 + character(len=buffer_len) :: buffer + + write(buffer, '(g0)') val + string = trim(buffer) + + end function real_xdp_to_string +#endif + + +#if WITH_QP + pure function real_qp_to_string(val) result(string) + real(qp), intent(in) :: val + character(len=:), allocatable :: string + integer, parameter :: buffer_len = 128 + character(len=buffer_len) :: buffer + + write(buffer, '(g0)') val + string = trim(buffer) + + end function real_qp_to_string +#endif + + + pure function complex_sp_to_string(val) result(string) + complex(sp), intent(in) :: val + character(len=:), allocatable :: string + + string = "("//to_string(real(val))//", "//to_string(aimag(val))//")" + + end function complex_sp_to_string + + + pure function complex_dp_to_string(val) result(string) + complex(dp), intent(in) :: val + character(len=:), allocatable :: string + + string = "("//to_string(real(val))//", "//to_string(aimag(val))//")" + + end function complex_dp_to_string + + +#if WITH_XDP + pure function complex_xdp_to_string(val) result(string) + complex(xdp), intent(in) :: val + character(len=:), allocatable :: string + + string = "("//to_string(real(val))//", "//to_string(aimag(val))//")" + + end function complex_xdp_to_string +#endif + + +#if WITH_QP + pure function complex_qp_to_string(val) result(string) + complex(qp), intent(in) :: val + character(len=:), allocatable :: string + + string = "("//to_string(real(val))//", "//to_string(aimag(val))//")" + + end function complex_qp_to_string +#endif + + + !> Clear error type after it has been handled. + subroutine clear_error(error) + + !> Error handling + type(error_type), intent(inout) :: error + + if (error%stat /= success) then + error%stat = success + end if + + if (allocated(error%message)) then + deallocate(error%message) + end if + + end subroutine clear_error + + + !> Finalizer of the error type, in case the error is not correctly cleared it will + !> be escalated at runtime in a fatal way + subroutine escalate_error(error) + + !> Error handling + type(error_type), intent(inout) :: error + + if (error%stat /= success) then + write(error_unit, '(a)') "[Fatal] Uncaught error" + if (allocated(error%message)) then + write(error_unit, '(a, 1x, i0, *(1x, a))') & + "Code:", error%stat, "Message:", error%message + end if + error stop + end if + + end subroutine escalate_error + + + !> Determine whether a value is not a number without requiring IEEE arithmetic support + elemental function is_nan_sp(val) result(is_nan) + !> Value to check + real(sp), intent(in) :: val + !> Value is not a number + logical :: is_nan + + is_nan = .not.((val <= huge(val) .and. val >= -huge(val)) .or. abs(val) > huge(val)) + end function is_nan_sp + + !> Determine whether a value is not a number without requiring IEEE arithmetic support + elemental function is_nan_dp(val) result(is_nan) + !> Value to check + real(dp), intent(in) :: val + !> Value is not a number + logical :: is_nan + + is_nan = .not.((val <= huge(val) .and. val >= -huge(val)) .or. abs(val) > huge(val)) + end function is_nan_dp + +#if WITH_XDP + !> Determine whether a value is not a number without requiring IEEE arithmetic support + elemental function is_nan_xdp(val) result(is_nan) + !> Value to check + real(xdp), intent(in) :: val + !> Value is not a number + logical :: is_nan + + is_nan = .not.((val <= huge(val) .and. val >= -huge(val)) .or. abs(val) > huge(val)) + end function is_nan_xdp +#endif + +#if WITH_QP + !> Determine whether a value is not a number without requiring IEEE arithmetic support + elemental function is_nan_qp(val) result(is_nan) + !> Value to check + real(qp), intent(in) :: val + !> Value is not a number + logical :: is_nan + + is_nan = .not.((val <= huge(val) .and. val >= -huge(val)) .or. abs(val) > huge(val)) + end function is_nan_qp +#endif + + +end module testdrive diff --git a/unit_tests/test-drive/testdrive_version.f90 b/unit_tests/test-drive/testdrive_version.f90 new file mode 100644 index 0000000000..1c6391b969 --- /dev/null +++ b/unit_tests/test-drive/testdrive_version.f90 @@ -0,0 +1,63 @@ +! This file is part of test-drive. +! SPDX-Identifier: Apache-2.0 OR MIT +! +! Licensed under either of Apache License, Version 2.0 or MIT license +! at your option; you may not use this file except in compliance with +! the License. +! +! 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 testdrive_version + implicit none + private + + public :: testdrive_version_string, testdrive_version_compact + public :: get_testdrive_version + + + !> String representation of the test-drive version + character(len=*), parameter :: testdrive_version_string = "0.4.0" + + !> Numeric representation of the test-drive version + integer, parameter :: testdrive_version_compact(3) = [0, 4, 0] + + +contains + + +!> Getter function to retrieve test-drive version +subroutine get_testdrive_version(major, minor, patch, string) + + !> Major version number of the test-drive version + integer, intent(out), optional :: major + + !> Minor version number of the test-drive version + integer, intent(out), optional :: minor + + !> Patch version number of the test-drive version + integer, intent(out), optional :: patch + + !> String representation of the test-drive version + character(len=:), allocatable, intent(out), optional :: string + + if (present(major)) then + major = testdrive_version_compact(1) + end if + if (present(minor)) then + minor = testdrive_version_compact(2) + end if + if (present(patch)) then + patch = testdrive_version_compact(3) + end if + if (present(string)) then + string = testdrive_version_string + end if + +end subroutine get_testdrive_version + + +end module testdrive_version diff --git a/unit_tests/test_SUBROUTINE.F90 b/unit_tests/test_SUBROUTINE.F90 deleted file mode 100644 index 01807ab051..0000000000 --- a/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/unit_tests/version/CMakeLists.txt b/unit_tests/version/CMakeLists.txt deleted file mode 100644 index a974369718..0000000000 --- a/unit_tests/version/CMakeLists.txt +++ /dev/null @@ -1,60 +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 "versioninfo") -set(module_directory "version") -set(module_library "versioninfolib") - -file(MAKE_DIRECTORY ${build_testdirectory}/${module_directory}) -file(WRITE ${build_testdirectory}/${module_directory}/testSuites.inc "") - -include_directories(${build_testdirectory}/${module_directory}) - -set(testlist - VersionInfo_test_tools - test_VersionInfo_CheckArgs -) -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_lib - ${module_library} -) - -add_test( - ${module_name}_utest - ${PROJECT_BINARY_DIR}/${module_directory}/${module_name}_utest -) - diff --git a/vs-build/AeroDisk/AeroDisk_Driver.sln b/vs-build/AeroDisk/AeroDisk_Driver.sln new file mode 100644 index 0000000000..be507fe647 --- /dev/null +++ b/vs-build/AeroDisk/AeroDisk_Driver.sln @@ -0,0 +1,61 @@ + +Microsoft Visual Studio Solution File, Format Version 12.00 +# Visual Studio 2013 +VisualStudioVersion = 12.0.40629.0 +MinimumVisualStudioVersion = 10.0.40219.1 +Project("{38C3D685-B817-4E00-A9A9-F3898DC01990}") = "AeroDisk_Driver", "AeroDisk_Driver.vfproj", "{C5F53AB0-6FE8-405C-A7F6-59BBF5E6D5C2}" + 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 + {C5F53AB0-6FE8-405C-A7F6-59BBF5E6D5C2}.Debug_Double|Win32.ActiveCfg = Debug_Double|Win32 + {C5F53AB0-6FE8-405C-A7F6-59BBF5E6D5C2}.Debug_Double|Win32.Build.0 = Debug_Double|Win32 + {C5F53AB0-6FE8-405C-A7F6-59BBF5E6D5C2}.Debug_Double|x64.ActiveCfg = Debug_Double|x64 + {C5F53AB0-6FE8-405C-A7F6-59BBF5E6D5C2}.Debug_Double|x64.Build.0 = Debug_Double|x64 + {C5F53AB0-6FE8-405C-A7F6-59BBF5E6D5C2}.Debug|Win32.ActiveCfg = Debug|Win32 + {C5F53AB0-6FE8-405C-A7F6-59BBF5E6D5C2}.Debug|Win32.Build.0 = Debug|Win32 + {C5F53AB0-6FE8-405C-A7F6-59BBF5E6D5C2}.Debug|x64.ActiveCfg = Debug|x64 + {C5F53AB0-6FE8-405C-A7F6-59BBF5E6D5C2}.Debug|x64.Build.0 = Debug|x64 + {C5F53AB0-6FE8-405C-A7F6-59BBF5E6D5C2}.Release_Double|Win32.ActiveCfg = Release_Double|Win32 + {C5F53AB0-6FE8-405C-A7F6-59BBF5E6D5C2}.Release_Double|Win32.Build.0 = Release_Double|Win32 + {C5F53AB0-6FE8-405C-A7F6-59BBF5E6D5C2}.Release_Double|x64.ActiveCfg = Release_Double|x64 + {C5F53AB0-6FE8-405C-A7F6-59BBF5E6D5C2}.Release_Double|x64.Build.0 = Release_Double|x64 + {C5F53AB0-6FE8-405C-A7F6-59BBF5E6D5C2}.Release|Win32.ActiveCfg = Release|Win32 + {C5F53AB0-6FE8-405C-A7F6-59BBF5E6D5C2}.Release|Win32.Build.0 = Release|Win32 + {C5F53AB0-6FE8-405C-A7F6-59BBF5E6D5C2}.Release|x64.ActiveCfg = Release|x64 + {C5F53AB0-6FE8-405C-A7F6-59BBF5E6D5C2}.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/vs-build/AeroDisk/AeroDisk_Driver.vfproj b/vs-build/AeroDisk/AeroDisk_Driver.vfproj new file mode 100644 index 0000000000..ec2307e6c8 --- /dev/null +++ b/vs-build/AeroDisk/AeroDisk_Driver.vfproj @@ -0,0 +1,175 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/vs-build/AeroDyn/AeroDyn_Driver.vfproj b/vs-build/AeroDyn/AeroDyn_Driver.vfproj index 238f6b43ff..0e65bf9cfa 100644 --- a/vs-build/AeroDyn/AeroDyn_Driver.vfproj +++ b/vs-build/AeroDyn/AeroDyn_Driver.vfproj @@ -903,13 +903,6 @@ - - - - - - - @@ -919,7 +912,29 @@ + + + + + + + + + + + + + + + + + + + + + + diff --git a/vs-build/AeroDyn_Inflow_c_binding/AeroDyn_Inflow_c_binding.vfproj b/vs-build/AeroDyn_Inflow_c_binding/AeroDyn_Inflow_c_binding.vfproj index e87a05aa6d..6a80b4e660 100644 --- a/vs-build/AeroDyn_Inflow_c_binding/AeroDyn_Inflow_c_binding.vfproj +++ b/vs-build/AeroDyn_Inflow_c_binding/AeroDyn_Inflow_c_binding.vfproj @@ -130,31 +130,19 @@ - - - - - + - - - - - + - + - + - - - + - - - + - + @@ -170,28 +158,28 @@ - - - + - + + + - - - + + + @@ -215,28 +203,28 @@ - - - + - + + + - - - + + + @@ -260,40 +248,31 @@ - - - - - - - - - - - - + - + + + - - - + + + @@ -311,28 +290,28 @@ - - - + - + + + - - - + + + @@ -356,28 +335,28 @@ - - - + - + + + - - - + + + @@ -395,28 +374,28 @@ - - - + - + + + - - - + + + @@ -452,28 +431,28 @@ - - - + - + + + - - - + + + @@ -486,53 +465,53 @@ - - - + - + + + - - - + + + - - - + - + + + - - - + + + @@ -554,28 +533,28 @@ - - - + - + + + - - - + + + @@ -592,411 +571,414 @@ + + + - - - + - + + + - - - + + + - - - + - + + + - - - + + + - - - + - + + + - - - + + + - - - + - + + + - - - + + + - - - + - + + + - - - + + + - - - + - + + + - - - + + + - - - + - + + + - - - + + + - - - + - + + + - - - + + + - - - + - + + + - - - + + + - - - + - + + + - - - + + + - - - + - + + + - - - + + + - - - + - + + + - - - + + + - - - + - + + + - - - + + + - - - + - + + + - - - + + + - - - + - + + + - - - + + + - - - + - + + + - - - + + + @@ -1006,13 +988,6 @@ - - - - - - - @@ -1022,7 +997,25 @@ + + + + + + + + + + + + + + + + + + @@ -1030,28 +1023,28 @@ - - - + - + + + - - - + + + diff --git a/vs-build/BeamDyn/BeamDyn.vfproj b/vs-build/BeamDyn/BeamDyn.vfproj index 97290b0f39..a13f410c99 100644 --- a/vs-build/BeamDyn/BeamDyn.vfproj +++ b/vs-build/BeamDyn/BeamDyn.vfproj @@ -121,175 +121,188 @@ - + + - - + + - - + + - + + + + + + + + + + + - - + + - - + + - + - - + + - - + + - + - - + + - - + + - + + - - + + - - + + - + - - + + - - + + - + - - + + - - + + - - + + - - + + + - - + + - - + + - - + + - - + + diff --git a/vs-build/FASTlib/FASTlib.vfproj b/vs-build/FASTlib/FASTlib.vfproj index 32c624b94e..4d87a023a7 100644 --- a/vs-build/FASTlib/FASTlib.vfproj +++ b/vs-build/FASTlib/FASTlib.vfproj @@ -128,7 +128,7 @@ - + @@ -157,27 +157,27 @@ - - + + - + - - - + - + - + + + @@ -186,36 +186,36 @@ - + - + - - - + - + + + - + - - - - - + - - - - - - - + + + + + - + + + + + + + - - + + @@ -224,36 +224,36 @@ - + - + - - - + - + + + - + - - - - - + - - - - - - - + + + + + - + + + + + + + - - + + @@ -267,27 +267,27 @@ - - + + - + - - - + - + - + + + @@ -305,27 +305,27 @@ - - + + - + - - - + - + - + + + @@ -343,27 +343,27 @@ - - + + - + - - - + - + - + + + @@ -381,27 +381,27 @@ - - + + - + - - - + - + - + + + @@ -419,27 +419,27 @@ - - + + - + - - - + - + - + + + @@ -463,10 +463,9 @@ - - + - + @@ -475,79 +474,77 @@ - - - + - - - + + + + + - + + + - + - - - + - - - - - - - - - + + + - + + + + + + + - - - + + + + + - - - - - - - - - - + - + - + - + - + - + - + + + - + - - - - - + - + + + - + - + - - - - + + + + + + + + + @@ -564,27 +561,27 @@ - - + + - + - - - + - + - + + + @@ -599,27 +596,27 @@ - - + + - + - - - + - + - + + + @@ -636,76 +633,34 @@ - + - + - + - - - + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + - - - + - + - + + + @@ -718,6 +673,9 @@ + + + @@ -729,27 +687,27 @@ - - + + - + - - - + - + - + + + @@ -762,70 +720,32 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + - + - - - + - + - + + + @@ -843,27 +763,27 @@ - - + + - + - - - + - + - + + + @@ -881,27 +801,27 @@ - - + + - + - - - + - + - + + + @@ -919,27 +839,27 @@ - - + + - + - - - + - + - + + + @@ -957,27 +877,27 @@ - - + + - + - - - + - + - + + + @@ -986,27 +906,27 @@ - - + + - + - - - + - + - + + + @@ -1020,82 +940,6 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - @@ -1105,7 +949,6 @@ - @@ -1113,13 +956,10 @@ - - - - + @@ -1137,27 +977,27 @@ - - + + - + - - - + - + - + + + @@ -1169,27 +1009,27 @@ - - + + - + - + - - - + - + + + @@ -1215,6 +1055,48 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + @@ -1222,27 +1104,27 @@ - - + + - + - - - + - + - + + + @@ -1255,32 +1137,61 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - + + - + - - - + - + - + + + @@ -1293,35 +1204,6 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - @@ -1336,27 +1218,27 @@ - - + + - + - - - + - + - + + + @@ -1370,10 +1252,10 @@ - + - + @@ -1382,27 +1264,27 @@ - - + + - + - - - + - + - + + + @@ -1420,33 +1302,33 @@ - + - + - + - + - + - + - + - + - + - + - + - + - + - + @@ -1458,34 +1340,34 @@ - + - + - + - + - + - + - + - + - + - + - + - + - + - - + + @@ -1502,27 +1384,27 @@ - - + + - + - - - + - + - + + + @@ -1549,27 +1431,27 @@ - - + + - + - - - + - + - + + + @@ -1591,27 +1473,27 @@ - - + + - - - - - + - + + + - + + + @@ -1623,27 +1505,27 @@ - - + + - + - - - + - + - + + + @@ -1652,27 +1534,27 @@ - - + + - + - - - + - + - + + + @@ -1682,27 +1564,27 @@ - - + + - + - - - + - + - + + + @@ -1711,27 +1593,27 @@ - - + + - + - - - + - + - + + + @@ -1740,27 +1622,27 @@ - - + + - - - - - + - + + + - + + + @@ -1769,27 +1651,27 @@ - - + + - + - - - + - + - + + + @@ -1798,27 +1680,27 @@ - - + + - + - - - + - + - + + + @@ -1827,27 +1709,27 @@ - - + + - + - - - + - + - + + + @@ -1856,27 +1738,27 @@ - - + + - + - - - + - + - + + + @@ -1885,27 +1767,27 @@ - - + + - - - - - + - + + + - + + + @@ -1914,27 +1796,27 @@ - - + + - + - - - + - + - + + + @@ -1943,27 +1825,27 @@ - - + + - + - - - + - + - + + + @@ -1972,27 +1854,27 @@ - - + + - + - - - + - + - + + + @@ -2001,27 +1883,27 @@ - - + + - + - - - + - + - + + + @@ -2030,27 +1912,27 @@ - - + + - + - - - + - + - + + + @@ -2061,14 +1943,6 @@ - - - - - - - - @@ -2078,59 +1952,228 @@ + + + + + + + + + + + + + + + + + + + + + + + + + - + - + - - - + + + - + - + - + - - - + - + + + - + - + + + + + - + + + + + + + + + + + + + + + + + + - + + + + + + + + + + + + + + - + + + + + - + - + - + - + - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + @@ -2139,7 +2182,14 @@ - + + + + + + + + @@ -2147,27 +2197,27 @@ - - + + - + - - - + - + - + + + @@ -2185,27 +2235,27 @@ - - + + - + - - - + - + - + + + @@ -2226,6 +2276,92 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + @@ -2233,27 +2369,27 @@ - - + + - + - - - + - + - + + + @@ -2272,7 +2408,7 @@ - + @@ -2280,27 +2416,27 @@ - - + + - + - - - + - + - + + + diff --git a/vs-build/HydroDyn/HydroDynDriver.sln b/vs-build/HydroDyn/HydroDynDriver.sln index b4743e108f..17c738b756 100644 --- a/vs-build/HydroDyn/HydroDynDriver.sln +++ b/vs-build/HydroDyn/HydroDynDriver.sln @@ -1,4 +1,4 @@ - + Microsoft Visual Studio Solution File, Format Version 12.00 # Visual Studio 15 VisualStudioVersion = 15.0.28307.902 @@ -11,6 +11,8 @@ Global 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 @@ -23,6 +25,10 @@ Global {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 diff --git a/vs-build/HydroDyn/HydroDynDriver.vfproj b/vs-build/HydroDyn/HydroDynDriver.vfproj index 3702b83922..3b057f9d10 100644 --- a/vs-build/HydroDyn/HydroDynDriver.vfproj +++ b/vs-build/HydroDyn/HydroDynDriver.vfproj @@ -5,7 +5,7 @@ - + @@ -24,8 +24,8 @@ - - + + @@ -44,7 +44,7 @@ - + @@ -54,7 +54,7 @@ - + @@ -93,6 +93,8 @@ + + @@ -101,34 +103,22 @@ + + - - - - - - - - - - - - - - - - - + + + @@ -137,16 +127,22 @@ + + + + + + @@ -155,16 +151,22 @@ + + + + + + @@ -173,12 +175,20 @@ + + - + + + + + + + @@ -187,16 +197,22 @@ + + + + + + @@ -205,11 +221,15 @@ + + + + @@ -218,75 +238,42 @@ + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + - - - - - - + + + @@ -295,14 +282,19 @@ + + - + + + + @@ -311,11 +303,25 @@ + + - + + + + + + + + + + + + + @@ -324,11 +330,15 @@ + + - + + + @@ -337,11 +347,15 @@ + + - + + + @@ -350,11 +364,16 @@ + + - + + + + @@ -363,11 +382,15 @@ + + - + + + @@ -376,11 +399,15 @@ + + - + + + @@ -389,11 +416,15 @@ + + + + @@ -402,11 +433,15 @@ + + + + @@ -415,11 +450,16 @@ + + + + + @@ -428,11 +468,15 @@ + + + + @@ -441,12 +485,16 @@ + + + + @@ -455,8 +503,126 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/vs-build/HydroDyn_c_binding/HydroDyn_c_binding.vfproj b/vs-build/HydroDyn_c_binding/HydroDyn_c_binding.vfproj index 5735fbeb4f..efe02d92b2 100644 --- a/vs-build/HydroDyn_c_binding/HydroDyn_c_binding.vfproj +++ b/vs-build/HydroDyn_c_binding/HydroDyn_c_binding.vfproj @@ -108,24 +108,6 @@ - - - - - - - - - - - - - - - - - - @@ -226,48 +208,11 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - @@ -276,13 +221,10 @@ - - - - + @@ -301,19 +243,144 @@ - + + + + + + + + + + + + - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/vs-build/InflowWind/InflowWind_driver.vfproj b/vs-build/InflowWind/InflowWind_driver.vfproj index 22ac1d67e7..3f4cd8d250 100644 --- a/vs-build/InflowWind/InflowWind_driver.vfproj +++ b/vs-build/InflowWind/InflowWind_driver.vfproj @@ -243,15 +243,26 @@ - + + + + + + + + + + + + - + diff --git a/vs-build/InflowWind_c_binding/InflowWind_c_binding.vfproj b/vs-build/InflowWind_c_binding/InflowWind_c_binding.vfproj index b9d050e14d..f1cd6a33de 100644 --- a/vs-build/InflowWind_c_binding/InflowWind_c_binding.vfproj +++ b/vs-build/InflowWind_c_binding/InflowWind_c_binding.vfproj @@ -93,77 +93,77 @@ - - + + - - + + - + - + + + + + + + + + + + + + + + + + + - - + + - - - - - - - - - - - - - - - - - - - + + - - + + - + @@ -172,7 +172,7 @@ - + @@ -203,15 +203,26 @@ - + + + + + + + + + + + + - + diff --git a/vs-build/MAPlib/MAP_dll.vcxproj b/vs-build/MAPlib/MAP_dll.vcxproj index a6035ed653..4ba5c06d02 100644 --- a/vs-build/MAPlib/MAP_dll.vcxproj +++ b/vs-build/MAPlib/MAP_dll.vcxproj @@ -1,4 +1,4 @@ - + @@ -22,33 +22,34 @@ {BF86702A-CB17-4050-8AE9-078CDC5910D3} Win32Proj MAP_DLL + 10.0 StaticLibrary true - v140 Unicode + v142 StaticLibrary true - v140 Unicode + v142 StaticLibrary false - v140 true Unicode + v142 StaticLibrary false - v140 true Unicode + v142 @@ -75,6 +76,7 @@ MAP_$(PlatformName) true ..\..\build\bin\ + $(PlatformName)\$(ConfigurationName) false @@ -85,6 +87,7 @@ MAP_$(PlatformName) false ..\..\build\bin\ + $(PlatformName)\$(ConfigurationName) @@ -195,22 +198,9 @@ - - 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/vs-build/MoorDyn/MoorDynDriver.vfproj b/vs-build/MoorDyn/MoorDynDriver.vfproj index 40e2ca66b1..7dba18e7fa 100644 --- a/vs-build/MoorDyn/MoorDynDriver.vfproj +++ b/vs-build/MoorDyn/MoorDynDriver.vfproj @@ -109,7 +109,8 @@ - + + @@ -122,7 +123,15 @@ - + + + + + + + + + @@ -135,7 +144,7 @@ - + @@ -148,7 +157,7 @@ - + @@ -161,7 +170,8 @@ - + + @@ -174,7 +184,7 @@ - + @@ -187,7 +197,7 @@ - + @@ -213,6 +223,7 @@ + diff --git a/vs-build/MoorDyn_c_binding/MoorDyn_c_binding.vfproj b/vs-build/MoorDyn_c_binding/MoorDyn_c_binding.vfproj index 0318c645e5..b70d760c32 100644 --- a/vs-build/MoorDyn_c_binding/MoorDyn_c_binding.vfproj +++ b/vs-build/MoorDyn_c_binding/MoorDyn_c_binding.vfproj @@ -129,7 +129,8 @@ - + + @@ -142,7 +143,17 @@ - + + + + + + + + + + + @@ -155,7 +166,7 @@ - + @@ -168,7 +179,7 @@ - + @@ -181,7 +192,8 @@ - + + @@ -194,7 +206,7 @@ - + @@ -207,7 +219,7 @@ - + @@ -233,6 +245,7 @@ + diff --git a/vs-build/ReadMe.md b/vs-build/ReadMe.md index 9753796fe0..ecc933f7c2 100644 --- a/vs-build/ReadMe.md +++ b/vs-build/ReadMe.md @@ -6,9 +6,10 @@ The following solution files are available for code development on Windows using - [FAST.Farm](FAST-farm/FAST-Farm.sln) This contains the build configurations for FAST.Farm. - Module-level drivers: - - AeroDynamics: + - AeroDynamics and HydroDynamics: - [AeroDyn driver](AeroDyn/AeroDyn_Driver.sln) - [UnsteadyAero driver](UnsteadyAero/UnsteadyAero.sln) + - [HydroDyn driver](HydroDyn/HydroDynDriver.sln) - Structural: - [BeamDyn driver](BeamDyn/BeamDyn-w-registry.sln) - [SubDyn driver](SubDyn/SubDyn.sln) @@ -16,7 +17,7 @@ The following solution files are available for code development on Windows using - [TurbSim](TurbSim/TurbSim.sln) Generates wind files - [InflowWind driver](InflowWind/InflowWind_driver.sln) Reads and interpolates existing wind files - [InflowWind c binding](InflowWind/InflowWind_c_binding.sln) Creates a library (DLL/so) of the InflowWind routines that can be called from a C interface. **TO DO: Combine this with InflowWind driver for easier maintenance** - - [HydroDyn driver](HydroDyn/HydroDynDriver.sln) + - [SeaState driver](SeaState/SeaStateDriver.sln) Waves and currents - Other: - [Discon](Discon/Discon.sln) This solution file contains all 3 controllers used in the OpenFAST r-test (with the NREL 5MW model). diff --git a/vs-build/Registry/FAST_Registry.vcxproj b/vs-build/Registry/FAST_Registry.vcxproj index 90fb08b2c6..c6b337e3cc 100644 --- a/vs-build/Registry/FAST_Registry.vcxproj +++ b/vs-build/Registry/FAST_Registry.vcxproj @@ -22,33 +22,34 @@ {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16} Win32Proj FAST_Registry_c + 10.0 Application true Unicode - v140 + v142 Application true Unicode - v140 + v142 Application false true Unicode - v140 + v142 Application false true Unicode - v140 + v142 @@ -155,25 +156,17 @@ - - - - - - - - - - + + + + + - - - - - + + - + \ No newline at end of file diff --git a/vs-build/RunRegistry.bat b/vs-build/RunRegistry.bat index d3dfcbe2f7..db72464a1c 100644 --- a/vs-build/RunRegistry.bat +++ b/vs-build/RunRegistry.bat @@ -25,16 +25,18 @@ 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 SED_Loc=%Modules_Loc%\simple-elastodyn\src SET IfW_Loc=%Modules_Loc%\inflowwind\src SET HD_Loc=%Modules_Loc%\hydrodyn\src +SET SEAST_Loc=%Modules_Loc%\seastate\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 ExtInfw_Loc=%Modules_Loc%\externalinflow\src +SET ExtLoads_Loc=%Modules_Loc%\extloads\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 @@ -42,15 +44,18 @@ 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 ADsk_Loc=%Modules_Loc%\aerodisk\src + +SET LD_Loc=%Modules_Loc%\lindyn\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 ALL_FAST_Includes=-I "%FAST_Loc%" -I "%NWTC_Lib_Loc%" -I "%ED_Loc%" -I "%SED_Loc%" -I^ + "%SrvD_Loc%" -I "%AD_Loc%" -I "%ADsk_Loc%" -I "%BD_Loc%" -I "%SC_Loc%" -I^ + "%IfW_Loc%" -I "%SD_Loc%" -I "%HD_Loc%" -I "%SEAST_Loc%" -I "%MAP_Loc%" -I "%FEAM_Loc%" -I^ + "%IceF_Loc%" -I "%IceD_Loc%" -I "%MD_Loc%" -I "%ExtInfw_Loc%" -I "%Orca_Loc%" -I "%ExtPtfm_Loc%" -I "%ExtLoads_Loc%" SET ModuleName=%1 @@ -60,11 +65,17 @@ GOTO %ModuleName% REM ---------------------------------------------------------------------------- REM ---------------- RUN THE REGISTRY TO AUTO-GENERATE FILES ------------------- REM ---------------------------------------------------------------------------- +:NWTC_Lib +SET CURR_LOC=%NWTC_Lib_Loc% +SET Output_Loc=%CURR_LOC% +%REGISTRY% "%CURR_LOC%\Registry_NWTC_Library_base.txt" -I "%NWTC_Lib_Loc%" -I "%CURR_LOC%" -O "%Output_Loc%" -noextrap +GOTO checkError + :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 +:: %REGISTRY% "%CURR_LOC%\MAP_Fortran_Registry.txt" -I "%NWTC_Lib_Loc%" -I "%CURR_LOC%" -O "%Output_Loc%" -noextrap GOTO checkError :MAP_Fortran @@ -104,6 +115,12 @@ SET Output_Loc=%CURR_LOC% %REGISTRY% "%CURR_LOC%\%ModuleName%_Registry.txt" -I "%NWTC_Lib_Loc%" -O "%Output_Loc%" GOTO checkError +:SimpleElastoDyn +SET CURR_LOC=%SED_Loc% +SET Output_Loc=%CURR_LOC% +%REGISTRY% "%CURR_LOC%\SED_Registry.txt" -I "%NWTC_Lib_Loc%" -O "%Output_Loc%" +GOTO checkError + :StrucCtrl :ServoDyn SET CURR_LOC=%SrvD_Loc% @@ -125,8 +142,26 @@ 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% +:InflowWind_Driver +SET CURR_LOC=%IfW_Loc% +SET Output_Loc=%CURR_LOC% +%REGISTRY% "%CURR_LOC%\%ModuleName%_Registry.txt" -I "%NWTC_Lib_Loc%" -I "%CURR_LOC%" -noextrap -O "%Output_Loc%" +GOTO checkError + +:ExternalInflow +SET CURR_LOC=%ExtInfw_Loc% +SET Output_Loc=%CURR_LOC% +%REGISTRY% "%CURR_LOC%\%ModuleName%_Registry.txt" -I "%NWTC_Lib_Loc%" -I "%IfW_Loc%" -ccode -O "%Output_Loc%" +GOTO checkError + +:ExtLoads +SET CURR_LOC=%ExtLoads_Loc% +SET Output_Loc=%CURR_LOC% +%REGISTRY% "%CURR_LOC%\%ModuleName%_Registry.txt" -I "%NWTC_Lib_Loc%" -I "%CURR_LOC%" -I "%IfW_Loc%" -O "%Output_Loc%" +GOTO checkError + +:ExtLoadsDX +SET CURR_LOC=%ExtLoads_Loc% SET Output_Loc=%CURR_LOC% %REGISTRY% "%CURR_LOC%\%ModuleName%_Registry.txt" -I "%NWTC_Lib_Loc%" -ccode -O "%Output_Loc%" GOTO checkError @@ -136,7 +171,7 @@ GOTO checkError :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%" +%REGISTRY% "%CURR_LOC%\%ModuleName%_Registry.txt" -I "%NWTC_Lib_Loc%" -I "%IfW_Loc%" -I "%CURR_LOC%" -O "%Output_Loc%" GOTO checkError :AeroDyn_Driver @@ -164,6 +199,12 @@ SET Output_Loc=%CURR_LOC% %REGISTRY% "%CURR_LOC%\UnsteadyAero_Registry.txt" -I "%NWTC_Lib_Loc%" -I "%CURR_LOC%" -O "%Output_Loc%" GOTO checkError +:LD +SET CURR_LOC=%LD_Loc% +SET Output_Loc=%CURR_LOC% +%REGISTRY% "%CURR_LOC%\LinDyn_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% @@ -176,22 +217,7 @@ SET Output_Loc=%CURR_LOC% %REGISTRY% "%CURR_LOC%\AeroAcoustics_Registry.txt" -I "%NWTC_Lib_Loc%" -I "%CURR_LOC%" -O "%Output_Loc%" -noextrap 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 @@ -200,7 +226,18 @@ GOTO checkError :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%" +%REGISTRY% "%CURR_LOC%\%ModuleName%.txt" -I "%NWTC_Lib_Loc%" -I "%CURR_LOC%" -I "%SEAST_Loc%" -O "%Output_Loc%" +GOTO checkError + +:SeaState +:Current +:Waves +:Waves2 +:SeaSt_WaveField + +SET CURR_LOC=%SEAST_Loc% +SET Output_Loc=%CURR_LOC% +%REGISTRY% "%CURR_LOC%\%ModuleName%.txt" -I "%NWTC_Lib_Loc%" -I "%CURR_LOC%" -noextrap -O "%Output_Loc%" GOTO checkError :SubDyn @@ -269,6 +306,12 @@ SET Output_Loc=%CURR_LOC% %REGISTRY% "%CURR_LOC%\AWAE_Registry.txt" -I %NWTC_Lib_Loc% -I %IfW_Loc% -noextrap -O "%Output_Loc%" GOTO checkError +:AeroDisk +SET CURR_LOC=%ADsk_Loc% +SET Output_Loc=%CURR_LOC% +%REGISTRY% "%CURR_LOC%\AeroDisk_Registry.txt" -I %NWTC_Lib_Loc% -I %IfW_Loc% -I "%CURR_LOC%" -O "%Output_Loc%" +GOTO checkError + :Version DEL "%Root_Loc%\VersionInfo.obj" "%Root_Loc%\versioninfo.mod" GOTO end @@ -300,8 +343,8 @@ SET FAST_Loc= SET Registry= SET ED_Loc= +SET SED_Loc= SET BD_Loc= -SET AD14_Loc= SET IfW_Loc= SET HD_Loc= SET SD_Loc= @@ -310,11 +353,12 @@ SET FEAM_Loc= SET IceF_Loc= SET IceD_Loc= SET MD_Loc= -SET OpFM_Loc= +SET ExtInfw_Loc= SET Orca_Loc= SET NWTC_Lib_Loc= SET ExtPtfm_Loc= SET AD_Loc= +SET ADsk_Loc= SET SrvD_Loc= SET MAP_Loc= diff --git a/vs-build/SeaState/SeaStateDriver.sln b/vs-build/SeaState/SeaStateDriver.sln new file mode 100644 index 0000000000..ee23e926c1 --- /dev/null +++ b/vs-build/SeaState/SeaStateDriver.sln @@ -0,0 +1,37 @@ + +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-21924BCA7E90}") = "SeaStateDriver", "SeaStateDriver.vfproj", "{815C302F-A93D-4C22-9329-717B4BC113C0}" +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-717B4BC113C0}.Debug_Double|Win32.ActiveCfg = Debug_Double|Win32 + {815C302F-A93D-4C22-9329-717B4BC113C0}.Debug_Double|Win32.Build.0 = Debug_Double|Win32 + {815C302F-A93D-4C22-9329-717B4BC113C0}.Debug_Double|x64.ActiveCfg = Debug_Double|x64 + {815C302F-A93D-4C22-9329-717B4BC113C0}.Debug_Double|x64.Build.0 = Debug_Double|x64 + {815C302F-A93D-4C22-9329-717B4BC113C0}.Debug|Win32.ActiveCfg = Debug|Win32 + {815C302F-A93D-4C22-9329-717B4BC113C0}.Debug|Win32.Build.0 = Debug|Win32 + {815C302F-A93D-4C22-9329-717B4BC113C0}.Debug|x64.ActiveCfg = Debug|x64 + {815C302F-A93D-4C22-9329-717B4BC113C0}.Debug|x64.Build.0 = Debug|x64 + {815C302F-A93D-4C22-9329-717B4BC113C0}.Release|Win32.ActiveCfg = Release|Win32 + {815C302F-A93D-4C22-9329-717B4BC113C0}.Release|Win32.Build.0 = Release|Win32 + {815C302F-A93D-4C22-9329-717B4BC113C0}.Release|x64.ActiveCfg = Release|x64 + {815C302F-A93D-4C22-9329-717B4BC113C0}.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/vs-build/SeaState/SeaStateDriver.vfproj b/vs-build/SeaState/SeaStateDriver.vfproj new file mode 100644 index 0000000000..483c4ab25a --- /dev/null +++ b/vs-build/SeaState/SeaStateDriver.vfproj @@ -0,0 +1,345 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/vs-build/SimpleElastoDyn/SimpleElastoDyn_Driver.sln b/vs-build/SimpleElastoDyn/SimpleElastoDyn_Driver.sln new file mode 100644 index 0000000000..956126eccf --- /dev/null +++ b/vs-build/SimpleElastoDyn/SimpleElastoDyn_Driver.sln @@ -0,0 +1,61 @@ + +Microsoft Visual Studio Solution File, Format Version 12.00 +# Visual Studio 2013 +VisualStudioVersion = 12.0.40629.0 +MinimumVisualStudioVersion = 10.0.40219.1 +Project("{2EF6BE3F-01AD-4236-81A5-69E813EF3897}") = "SimpleElastoDyn_Driver", "SimpleElastoDyn_Driver.vfproj", "{ABF8EC9F-A94B-460C-8AB5-17733D51820B}" + 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 + {ABF8EC9F-A94B-460C-8AB5-17733D51820B}.Debug_Double|Win32.ActiveCfg = Debug_Double|Win32 + {ABF8EC9F-A94B-460C-8AB5-17733D51820B}.Debug_Double|Win32.Build.0 = Debug_Double|Win32 + {ABF8EC9F-A94B-460C-8AB5-17733D51820B}.Debug_Double|x64.ActiveCfg = Debug_Double|x64 + {ABF8EC9F-A94B-460C-8AB5-17733D51820B}.Debug_Double|x64.Build.0 = Debug_Double|x64 + {ABF8EC9F-A94B-460C-8AB5-17733D51820B}.Debug|Win32.ActiveCfg = Debug|Win32 + {ABF8EC9F-A94B-460C-8AB5-17733D51820B}.Debug|Win32.Build.0 = Debug|Win32 + {ABF8EC9F-A94B-460C-8AB5-17733D51820B}.Debug|x64.ActiveCfg = Debug|x64 + {ABF8EC9F-A94B-460C-8AB5-17733D51820B}.Debug|x64.Build.0 = Debug|x64 + {ABF8EC9F-A94B-460C-8AB5-17733D51820B}.Release_Double|Win32.ActiveCfg = Release_Double|Win32 + {ABF8EC9F-A94B-460C-8AB5-17733D51820B}.Release_Double|Win32.Build.0 = Release_Double|Win32 + {ABF8EC9F-A94B-460C-8AB5-17733D51820B}.Release_Double|x64.ActiveCfg = Release_Double|x64 + {ABF8EC9F-A94B-460C-8AB5-17733D51820B}.Release_Double|x64.Build.0 = Release_Double|x64 + {ABF8EC9F-A94B-460C-8AB5-17733D51820B}.Release|Win32.ActiveCfg = Release|Win32 + {ABF8EC9F-A94B-460C-8AB5-17733D51820B}.Release|Win32.Build.0 = Release|Win32 + {ABF8EC9F-A94B-460C-8AB5-17733D51820B}.Release|x64.ActiveCfg = Release|x64 + {ABF8EC9F-A94B-460C-8AB5-17733D51820B}.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/vs-build/SimpleElastoDyn/SimpleElastoDyn_Driver.vfproj b/vs-build/SimpleElastoDyn/SimpleElastoDyn_Driver.vfproj new file mode 100644 index 0000000000..4e3f17a83a --- /dev/null +++ b/vs-build/SimpleElastoDyn/SimpleElastoDyn_Driver.vfproj @@ -0,0 +1,168 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/vs-build/SubDyn/SubDyn.vfproj b/vs-build/SubDyn/SubDyn.vfproj index 2f3257b6aa..fb5db9d8af 100644 --- a/vs-build/SubDyn/SubDyn.vfproj +++ b/vs-build/SubDyn/SubDyn.vfproj @@ -94,54 +94,48 @@ - - + + + + - + + + + + + + + - + - - + + - - - - - - - - - - - - + + + - - - - - - - + @@ -151,7 +145,26 @@ + + + + + + + + + + + + + + + + + + + @@ -161,19 +174,19 @@ - - + + - - + + @@ -181,8 +194,8 @@ - - + + diff --git a/vs-build/TurbSim/TurbSim.vfproj b/vs-build/TurbSim/TurbSim.vfproj index 99c411e229..7b22a12bac 100644 --- a/vs-build/TurbSim/TurbSim.vfproj +++ b/vs-build/TurbSim/TurbSim.vfproj @@ -54,6 +54,7 @@ + @@ -61,6 +62,7 @@ + diff --git a/vs-build/UnsteadyAero/UnsteadyAero.vfproj b/vs-build/UnsteadyAero/UnsteadyAero.vfproj index 321fd8c587..5f23d47eab 100644 --- a/vs-build/UnsteadyAero/UnsteadyAero.vfproj +++ b/vs-build/UnsteadyAero/UnsteadyAero.vfproj @@ -5,7 +5,7 @@ - + @@ -15,7 +15,7 @@ - + @@ -25,7 +25,7 @@ - + @@ -35,7 +35,7 @@ - + @@ -45,7 +45,7 @@ - + @@ -55,7 +55,7 @@ - + @@ -65,7 +65,7 @@ - + @@ -75,7 +75,7 @@ - + @@ -97,19 +97,19 @@ - - + + - - + + @@ -120,178 +120,212 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - + + - - + + - - + + - - + + - - + + - - + + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + + - - + + - - + + - - + + - - + + @@ -299,19 +333,19 @@ - - + + - - + +